[SCM] CERNLIB is a suite of data analysis tools and libraries created for use in physics experiments, but also with applications to other fields such as the biological sciences branch, master, updated. upstream/2006.dfsg.2-31-g14aad6b
Lifeng Sun
lifongsun at gmail.com
Tue Apr 5 23:54:46 UTC 2011
The following commit has been merged in the master branch:
commit 14aad6b3b6d734818ed56d8f02066e43fe46b811
Author: Lifeng Sun <lifongsun at gmail.com>
Date: Wed Apr 6 07:51:29 2011 +0800
Remove src/ directory.
diff --git a/src/Imakefile b/src/Imakefile
deleted file mode 100644
index e4a9e8d..0000000
--- a/src/Imakefile
+++ /dev/null
@@ -1,23 +0,0 @@
-#define IHaveSubdirs
-#define PassCDebugFlags
-
-
-LIBDIRS= packlib pawlib graflib mathlib geant321 mclibs phtools
-
-SUBDIRS= $(LIBDIRS) patchy cfortran
-
-#ifdef CERNLIB_UNIX
-SUBDIRS:= $(SUBDIRS) scripts mgr
-#endif
-
-InstallLibSubdirs($(LIBDIRS))
-
-INCLUDEDIRS= $(LIBDIRS) cfortran
-
-InstallIncludeSubdirs($(INCLUDEDIRS))
-
-DelegateTarget(bin/kuipc,packlib)
-
-DelegateTarget(lib/packlib,packlib)
-DelegateTarget(lib/kernlib,packlib)
-
diff --git a/src/car/fatmen.car b/src/car/fatmen.car
deleted file mode 100644
index 9aa2ad1..0000000
--- a/src/car/fatmen.car
+++ /dev/null
@@ -1,2942 +0,0 @@
-+TITLE.
-FATMEN 1.92/02 970107 09:30 CERN PROGRAM LIBRARY FATMEN=Q123
-+PATCH,REQUIRES,T=DATA,IF=$DOC.
-+DECK,BLANKDEK.
-
-The FATMEN package requires the following other packages to run:
-
-- ZEBRA, KUIP, CSPACK (from CERN Program Library PACKLIB)
-
-- KERNLIB
-
-- FPACK (if the flag FPACK is +USEd)
-
-In addition, the following system specific software is required:
-
-VM/CMS systems
---------------
-
-HEPVM software (EXECs, tape handling software, Tape Management System IF=TMS)
-
-(An interface to VMTAPE and VMBATCH is also provided)
-
-VAX/VMS systems
----------------
-
-- VAXTAP (CERN Program Library) for tape handling
-
-N.B. for server mode staging, a logical name STAGE_QUEUE must be
-defined in the system table. This directory must be world writable.
-The current recommended practice is:
-
-a) Define STAGE_QUEUE to point to the same directory on all nodes
-b) Use batch mode staging on all nodes.
- Batch mode staging is used by default if a batch queue STAGE_xxxxS
- exists, e.g. STAGE_8200S
-
-Unix systems
-------------
-
-SHIFT/CORE software for tape handling, IF=SHIFT
-
-L3 Apollo tape staging, IF=APOLLO and the file l3stage is found
-in the current path.
-
-System dependant information
--=-=-=-=-=-=-=-=-=-=-=-=-=-=
-
-RS6000:
-To compile the CDF file, use the following options on the XLF command:
-
--q ST_SIZE=5000 -q TKQ_SIZE=20000 -q charlen=32000 -q extname
-+PATCH,HISTORY.
-+DECK,BLANKDEK.
-Version 1.92=Make help for MODIFY command correspond to code (-K)
- For import into CVS.
-Version 1.91=FMCLOS: add extra debug
- FMLOOP, FMBACK: correct save statement
- FMKADT, FMADDT: safer handling of VID prefixes
- FATCDES: add definitions for DAT120, NTP
- FMOPEN/FMTAPE: IOPTI - disable -G in calls to SHIFT s/w
- Z=FATGET: ISFGET
- FMTAPE: only specify -U for shift stagein if DDNAME looks like
- a Fortran unit
- FATLOG: log files (FATLOG.yymmdd) now written to fatlogs subdir
- FATSEND: only wait if no files were transferred
- FAINQR,FMVERI,FMURL: fix check on URL
- FMTAPE: impose MAXSTG only on IBM (mainframe) systems
- FATUTIL: save DIRNAM variable (problems diagnosed by Olof Barring)
-Version 1.90=FATSEND: tidy printout, improve time stamping of log messages
- FMRZIN: print IQUEST(1) in case of RZIN errors
- FMRSTG: tidy retry handling
- FAERAS, FAINQR: initialise LCHNFS
- FMCLOS: fix bug in stageclr
- FMINIT, FMTAPE: call sfget only if in current path
- New versions of FATCHK and FMMEDT from FNAL
- - FATCHK increase width in the FORMAT statement
- - FMMEDT move zeroing of NFMTYP and NUMMTP after check that
- FATMEN.MEDTYPES exists;
- FATSEND: skip remote nodes if protocol is afs
- FMFZO: save FILEN. FATSRV: skip kumac files
- FMSSND, FATSEND: increase nodenames and queues to 80 characters
- FMMEDT: mods from D0 - set also NFMTYP, permit also negative
- media types. (This results in a medium of type iabs(itype)
- being defined but not selected).
- FMMEDT: set media types (definitions of characteristics AND
- selection vector) using fatmen.medtypes file.
- FMPKTM: year 99 was not allowed!
- FMDISK/FMTAPE: print warning message concerning conflicting
- logical names on multiple lines (D0)
- FMFIXF: strip trailing / from pathname (if any)
- FMCLOS: update MSRDFA/MERDFA from FZINO
- FMCLASS: define LDEF, FMURL: add Z=FATPARA.
- FMSREQ: improve handling of bad sysreq.conf config file
- FMSHO2: large directories - use I6 for ksn
- Start support for mss commands (e.g. Lachman interface)
- Files stored in Lachman have a URL like:
- osm://[server-node:][/store-name][/storage-group]/bitfileID
- fatmen.storage-classes:
-
- path storage-class [store-name] [storage-server]
- DELPHI DELPHI-conservator at domain
- osm://delphi-conservator@cern.ch/delphi/rawdata/bfid
-
- storage-classes should be experiment independent (e.g. rawdata)
- store-names are experiment specific (e.g. L3DSTS, ALEPHRAW)
-
- mods to: FATCDES,FMDISK,FAINQR,FMVERI,FADARE,FMRZIN
- mssget mssinq ??
- new routines: FMURL, FMCLASS, FMMSS, FMRSLV
-Version 1.89=FMUTIL: add FMETOA/FMATOE (from RB's RZHto/frA) for ebcdic/ascii
- conversion
- FMFIXF: handle multiple .. in path name correctly
- FMATCH: handle *pattern correctly
- FMKMOD: zero NMATCH before FMSELK
- Add DLT definitions (as from TMS), include in CERN selection
- Add RWN/CWN as allowable file formats
- Add fatzero script to check for zero length files in /todo
- Add fatdf script to check /fatmen not too full
- FMSREQ: retry on all errors (after existing error handling)
- FMPSTG: split FATOPTS into FATOPT0/1
- FMPSTG: bug fix for VMS, fix typos
- FMEDIA: debug printout added.
- FMPSTG: new routine to prestage files (from suggestion by
- Guenter Duckeck/OPAL)
- FATCDES: new media type definitions for DESY
- FATSEND: include CZDUMM for VMS
- FMQTMS: protect against invalid media type (-TMS option)
- FMINIT: sleep and retry if catalogue not found
- FMOPEN: option Q for disk files - just return (rather than ignore)
-Version 1.88=FATSRV: protect against input files with no updates!
- FMSTGQ: protect against tape not staged on VM (answer not
- stacked).
- FMRZIN: correct bug in call to FMSTGC
- FMRZIN: accept tape file if already staged (VMS)
- TMS VOLINFO tag: use SYSTEM tag IF=IN2P3
- FMHOST: declare FMHSTC as integer
- FMCLOS: format error
- FMGET(module): change to FMGET GENAM [KSN] [CHOPT] [FILE]
- FMINIT: define 2 DATs for call to FMSETM
- FMCLOS: Return IRC to user in case of problems with STAGE PUT.
- 25/05/94
-Version 1.87=FMCLOS: support options C (clear), D (remove links) and
- P (stageput) for new SHIFT stager
- FMINIT: initialise also DAT tapes (2 varieties)
- FATSCAN2: remove existing log file
- FATCAT: correct bug in handling of # RDR files
- FMTAPE: add NOWAIT option for SHIFT
- FMTAPE: don't call FMFGET(sfget) for new SHIFT stager
- FMFGET: print command if idebfa>=1
- FAFILE: open NEW files CARRIAGECONTROL='LIST' on VMS
- Add FMRKEY: replace existing key vector. Used from FMFZI
- to update existing object in place with new loc.code etc.
- FATBACK: create link to latest good backup file
- Drop bank at end of FMTOUC
- SEARCH/SCAN commands: fix bug for date/time ranges when
- only pathname specified.
- FMTAPE: put filename at end of call to stagein script
- SCRIPT: add fatchk to look for servers that are stopped
- Post 94A
-Version 1.86=Mods from Torbjorn Moa
- FMLCOP: fix bug - eliminate call to FMGTLG before FMXDSK
- FMRZIN: try DECnet access in case of $env/filename syntax
- and file not found.
- Protection in FMFZCP against FZOUT/FZRUN problems.
- Add P=FATLOOP - example 'fast' listing program
- CONVEX flag (FMOPEN)
- FMOPEN:fix bug introduced by C I/O support on Unix w/o SHIFT
- FMKUIP: add dummies to avoid linking FATMEN module with SHIFT
- VIDQQ identification
- FMPUTC: correct check on JL/JR
- Add FMGETA: get first entry matching specific generic name
- FMSTGP: treat group PUBXX like DELPHI (VXCERN reconfig)
- FMDISK, FMTAPE: delete conflicting logical names from LNM$PROCESS
- FATMDI: use RZCDIR rather than FACDIR
- FMDISK: fix faulty call to FMXDSK, set lognam in JOB table (D0)
- FMRSTG, FMRQUI: bug fixes from D0.
- mod fmrqui and fmrstg to avoid waiting for a job to complete
- when the file is already staged and to avoid running out of
- 'lun's (By Steve Glenn)
- Unix systems: exchange mode catalogues only supported
- FMSHOW: show also VOLINFO tag if IOPTQ
- P=FMUTIL,D=FMLTON,FMNTOL, correct filename
- New CMZ file - previous version archived in ADSM
-Version 1.85=Correct IRC in P=FATCAT after rename of remote file
- Reorder statements in FATLIB to satisfy FLOPPY check 39
- FMOPEN: CFOPEN also for non-SHIFT Unix machines
- FMQTMS/FMQVOL: add (GENERIC SHIFT) IF=CERN,IF=SHIFT
- FMVERS: add IF=CERN
- Add P=FMUTIL,D=FMLTON,D=FMNTOL to process locations code file
- Extra protection in FATCAT against network problems
- Print user words also in decimal (FMSHOW)
- V93D 20/10/94 16:20
- Fix backslash problem for QMALPH.
-Version 1.84=TMS return codes: 312-315 all mean roughly the same
- 312 - volume not mountable on system issuing QVOL command
- 313 - if an unknown generic system name is given as a QVOL option
- 314 - if an unknown specific system name is given as a QVOL option
- 315 - if the volume is unmountable on ANY defined operating systems
- FATMEN: reduce PAWC to 1M words
- FMLD: more logical handling of NLEVEL and -R
- FMOPEN: bug fix in options for XYOPEN (Alfonso Lopez)
- FATSEND: protect against NFOUND>MAXFIL
- Check status of LIB$GET_LUNs
- Add STATUS on OPEN in FAFNDF
- Print IOSTAT in FMRZIN if open of TPSERV.CONF file fails
- Rework lib$find_file logic in fatsrv for vms systems
- Add P=FATLOG to process *FATLOG* lines in FATSERV log
- Add P=FATSREQ, to issue SYSREQ command with retry
- Z=FATSYS: add IFMODX to flag exchange mode catalogue
- (mods to FAOPEN, FARINI, FATSRV).
- Add FATBACK to convert RZ file to FZ file.
- ADD FMFIND to issue FIND in one-line. Add FATBACK script
- Add program FATCHK to read all entries from catalogue
- FMFZI: return GENEN correctly also for LOG records
- GENEN is e.g. //CERN/DELPHI/FATLOG (to work with existing names
- files)
- V93C 08/06/93 12:40
-Version 1.83=FMXDSK: perform various checks on each element of search
- list as recommended by Keith Chadwick, FNAL
- Add FMLCOD to load location code definitions from user file
- ADD/DISK|TAPE: support user words
- CLIO support: look for 'vmstage' in current path
- (still needs mods to FMTAPE/FMCLOS)
- FATSRV: add FATLOG to write logging records to FZFILE,IF=FATLOG
- FMFZO: lower FZLOGL for journal file
- FMALLO: use ICDECI to interpret density field
- FMPEEK: add option D to drop bank after unpacking
- Add FMPLOG to print log records
- FMFZI: chvsn & chvid = char*8
- FMCOPY: add DSN to STAGE CHANGE command. STAGE CHANGE uses
- dsn STAGEOUT if the input file was staged without specifying
- the dsn.
- Add FMDDIR: delete directories even with entries
- FMCLOS: Correct handling of IOPTP in case of LBANK=0
- Add Z=FAUST for user statistics
- FMTAPE: treat RECFM=U like RECFM=F for Shift
-Version 1.82=FATKEOPS: use XZMV to rename request file
- FMKMOD: comment field was never updated.
- FMTMS: bug fixes from Steve O'Neale (FMGVID,FMGETP,FMSREQ)
- FATSRV: names file is in DEFAULT(1:LDEF)
- Protection in FMRQUI against network write errors.
- Display error code in FASTGQ in case of unexpected errors.
- Skip active files in FATSEND
- TMS library SMCF_1 changed to 3495_2
- Modify FATSEND to handle multiple groups; add protection
- against errors.
- Mods to FMLOOK, FMCSTG and FMRSTG from D0 (Krzysztof Genser)
- Protection in FMTAPE against unexpected replies from STAGE Q
- Add NeXT flag in FFATMEN and FMHSTC
- 25/02/93 10:20
-Version 1.81=FAFNDF: get short/long wait intervals and retry count from
- logical names (FATMEN_SNETWT etc.) Call FAFNDF from FMQSTG.
- FMTAPE: use FAFNDF to look for existing STAGE Q file
- FATSERV.EXEC: exit 99 if timer expires and we are FMFATCAT
- FMSELK, FMRZIN: protect against wild-cards in generic name
- FAFNDF(VAX). Add longwait interval. Add FMWTO
- FMRACK: protect against network problems.
- FMTAPE, FMRZIN: correct problems reported by DESY.
- FMTAPE: write temp file (IOPTY) in /tmp/<user>.fmstage,
- sys$login:, MAXDSK
- FMSEND: change mv to /bin/mv for Aegis users.
- FMLN: warning message if entry for target already exists
- FMINIT: set media type search order to 1,6,2,3,4,5 IF=CERN
- FATCDES: add definitions for 3490s (media type 6).
- FASEAC: FMISET is an integer function
- FMFILL: blank fields prior to filling also for option O
- FMTAPE: correct call to FMBQUE. FATNEW: clear FATNOD
- FMALLO: retry only if there are more tapes in the current
- library.
- FMFZO: correct CHFNFA handling in journal file header
- Fix warnings from Ruby compilation
- Verify CDF options against code
- Correct handling of status code in FMSEND (VAX)
- Bug fixes to FMVINF (TMS VOLINFO tag manipulation)
- wHole input staging on VM/CMS - take size from VOLINFO
- tag or media capacity.
- Bug fixes in FASEAR/FASEAC: check if any user word selection
- has been made
- Save current directory correctly in LD(FMLD)
-Version 1.80=FX=FFX in FMOPEN (removed in 1.73 for some unknown reason)
- Add +SELF,IF=CSPACK to FMSEND to avoid pulling in
- TCP/IP code unless CSPACK is selected.
- V93A 15/01/93 13:30
-Version 1.78=More mods to CDF for new KUIP (options etc.)
- Add call to INITC in FATMEN
- Modify CDF for use with new KUIP.
- KUIP style -U no longer needed with latest KUIP
- Add KSN parameter to LS command
- 14/12/92 13:20
-Version 1.77=FMFZO, FMSEND, FMUPDT: handle remote updates via CSPACK.
- Program lifetime: modules over 1 year old will print warning
- Add ABEND routine to FATSRV. ABEND prints server statistics
- and then executes fatabend script/command file/exec
- Counters in FATSRV.
- Try to clear out RDR in FATCAT - don't look on remote system
- if there are more than 10 pending files
- Handle remote catalogues correctly on VMS systems
- Bug fix to FATSRV for zz files on Unix
- Correct call to FAOPEN in FARINI
- Bug fix in FMSREQ for return buffer length handling
- Call lib$find_file_end before waiting in FATSRV.
- Option N in rm command. Don't turn on I automatically for
- option A. Reset reply buffer upon retry in FMSREQ.
- Add STRING parameter to SCAN command - options for RM
- Copy NAMEFD to FMNAMF for CSPACK access to remote files
- Wait option in FMSMCF for FMCOPY. Do not add entry to
- catalogue if FMCLOS fails.
- Remote catalogue access via CSPACK
- - FMLOCC, FMNICK, FMACCT, FMACL (use XZOPEN, XZGETL)
- - FMINIT (not yet for VM) , FAOPEN, FARINI
- 01/12/92 12:00
-Version 1.76=Use of VOLINFO TMS tag field for multi-file handling
- (routines FMGVOL, FMGVID and FMVINF)
- Bug fix in FMTOVM for new journal file names
- FMFZI: in case of warning from RZDELK, rebuild bit map
- Speed up FMSELK by only comparing required fields and
- only converting matching keys. (FNAME is converted to Z format)
- Remote access to catalogue via CSPACK, e.g. for group L3:
- FML3=/fatmen/fml3 = local/nfs access
- FML3=fatcat:/fatmen/fml3 = CSPACK access
- .netrc file should contain
- machine fatcat login fml3 password xxxxxx
- Update files are written locally and then transferred with
- XZPUTA. Configuration files (FATMEN.NAMES, .ACCOUNTS, .ACL
- and .UPDATES) read using XZGETL.
- ==> Needs CSPACK 1.28/02 921124 10:30
- Performance improvements in FASEAC, FALS (from FASEAR)
- Bug fix in FMFZO for VM - only open LUFZFA if not already open.
- Add command SCAN. Bug fix in FMRM (FMACNT never called).
- Change FMACL to support ACL files (option A) and UPDATE files
- (option U). Allows FMOPEN style updates to be controlled at
- the path/user/node level without recompiling/linking
- Don't check RC from FMLOCC in FMINIT
- Interface to DESY MVS staging system (input only)
-Version 1.75=Bug fix in FASEAC/FMFILS for re-entry with non-zero context
- pointer.
- Better protection against errors in FATCAT.
- Bug fix to FMSHOW. Print status in FMSEAR.
- Bug fixes to FMKADD (KUGETS rather than KUGETC), FMRAND and
- FMFGET (length for character strings) for DESY
- Process each update directory in turn on fatcat
- FATCAT: drop /* from XZLS call (avoid problem with globbing)
- Define MINBLK in FATSRV - minimum number of blocks left
- before cleanup is triggered (VMS)
- Correct FAFNDF handling on Unix systems
- Revise update handling in FATSRV for VMS systems
- - RMS$_FNF = wait
- - RMS$_NMF = reset context pointer and loop
- - ZZ*.* = loop
- Exploit new RZOUT option 'R' in FATSRV
- - use in case bank & keys match and entry already exists
- - if bank matches but not keys, use old method
- !!! N.B. this requires RZ version 2.00/05 or higher !!!
- RZEBRA 2.00/05 921104 17:30 THE ZEBRA RZ PACKAGE
- 28/10/92 10:00 <<<<<< Install new RZ with this version >>>>>>
- Bug fixes for IBMMVS (FMRZIN,FMCOPQ,FADARE,FMNICK,FMFPAK,FMOPEN).
- FMUSER for non-HEPVM, non-VMBATCH sites (just use IDENTIFY)
- Use RZVERI (FATSRV) to rebuild bit map of used records
- from the file itself if required
-Version 1.74=Blank search strings in FMSEAR before UHTOC calls.
- Fix error return in FMOPEN after reworking of monitoring info.
- Call stageput only for tape datasets
- Prepend CHEOPS error messages with CHEOPS error:
- Save and reset CD in TOUCH. Restore CD also in mv if rm
- failed.
- APOF77 flag: double \ in FMCD, QX_SC selection
- CHEOPSIF: call XYOPEN/CLOS only for disk files.
- Send fatal messages from PROGRAM FATCAT to FATONE
- 14/10/92 16:00
-Version 1.73=Remove treatment of FX like FFX in FMOPEN
- FMOPEN/FMCLOS etc. for links. New routine FMGETL.
- Extra monitoring information - IHOWFA, ITIMFA & CHFNFA
- Support CSPACK access to FX and FFX files, IF=CSPACK.
- Remote files may reside on VMS or Unix systems
- (VM not currently supported)
- Move FMRCOP from FMKUIP to FMINT. +USE,CSPACK to get
- functional version.
- Protect against SS$_UNREACHABLE in LIB$FIND_FILE calls
- Escape characters in 'ls': % for nicknames,
- $ for environment variables
- Server mode VMS staging - see P=REQUIRES
- Use parameters in unpacking MFQNFA
- Nickname processing via the shell
- Add FMRMLN/'rmln' command to remove/find dangling links
- Add routine FMLN and 'ln' command.
- Add routine FMNICK a la DELPHI
- Add routine FMRANK to rank CHFILES by VID & FSEQ
- Use CFIO (via CHANNEL mode) on VAX/VMS systems for FZ files
- Alpha port, bugs in FMCOPC
-Version 1.72=Require at least 2 update tokens left for mv, FMMV
- Support FATMEN.LOCCODES file for location code definitions
- Add SHOW/LOCCODES command
- FMCDF: add R='x,y,z' for all cases of CHOPT for new KUIP
- FMRZIN: check modification date and time of directory
- on entry and exit. If directory has been modified, sleep
- and retry. Add example program using FMPOKE (for SMC)
- FMTAPE: do not issue FMFGET(sfget) in case of IOPTU
- Support for /afs files in FMRZIN
- Ensure LUFZFA is set before calling FMUPDT. Bug fix in FMSTGI/O
- Return stageout return code in FMCLOS chopt=P
- Support UPDATE/FMUPDT on non-VM systems !!! N.B. the server
- must be at level V1.65 or higher !!!
- Extra debug in FMRZIN - print out RZ info for object retrieved
- FMDD2L: handle character lun, e.g. '12'
- Fix bugs in FMCLOS, FMSTGO for CHEOPSIF
- 11/09/92 16:00
-Version 1.71=FMPUTC: blank padding from LEN(STRIM) up to field width
- Option C in TOUCH: clear comment field
- Set LFMODE in FMSTGO before call to FMCLOS
- Add option A in TOUCH: set account field
- FMVERI: check also MHSNFA for disk files
- FMRZIN, FMDISK, FAINQR: DECnet access
- FMTAPE: permit staging of files > max. media capacity
- STAGE PUT support for Shift & VMS (local only) in FMCLOS
- Extra debug in FATCAT
- Use new journal file names in FMTOVM
- Check stage group in FMSTGC only on first entry
- Time FMOPEN/FMDISK/FMTAPE if IDEBFA>=1
- Add user exit FMUVER to FMVERI.
- FMTAPE: check if batch queue STAGE_xxxxS exists - if so,
- perform stage request in batch. Add routine FMBQUE.
-Version 1.70=Improve diagnostics in FMVERI for blanks/unseen characters
- in generic name. Bug fix in FMRMDR in call to FMVERI.
- Bug fix in FMSTGI/O - ensure IRC always returned
- NOWAIT option in FMOPEN - return after call to FMTAPE
- Fix for Cray compiler in FMOPEN (LCHF = 1)
- FMMVC - perform DEL then PUT
- Bug fix in FMOPEN - FX treated as FFX (as in old FMOPEN)
- V92B 20/07/92 10:30
-Version 1.69=Last minute fixes for V92B: move maximum recl and blksize
- to Z=FATFORM.
-Version 1.68=Fix bug in FMTOUC. Use option U in FACDIR call in FMSELK.
- 15/07/92 13:30
- pre-release of V92B(?)
-Version 1.67=Fix bug in FATARE for VAX/VMS systems or -TMS
- Rename *CHEOPS -> *CHEOPS2F etc.
- Support tag :queue in FATSEND - queue directory on remote node
- for current server. If not defined, use subdirectory todo.
- Check that RECFM is entirely alphabetic
- Bug fix in FMCOPY - reset IRC after FMCOMP
- MODIFY command : check that media type does not change
- New Shift Disk Pool Manager (DPM) - do not provide shift
- user or pool name. Old behaviour IF=OLDDPM.
- Protection in FMTAPE against STAGE_RC undefined or in invalid
- format. Add LOCCOD to ADD/DISK, ADD/TAPE
- Bug fix in FMRSTG (check on whether file was already staged)
- Check DCB information for output staging (VM)
- Missing FATBUG in FMFGET, IMODE in FMDISK
- Better processing of >MAXFIL files in FALS.
- Fix bugs in HP/UX version
- 03/07/92 08:45
-Version 1.66=Add location code, media type and copy level to COPY command
- Call FMVERI in FMSTGI/O. Write extra information in FMCOPQ.
- Put density on stage command IF=SHIFT,IF=-TMS
- Add protections in FMCOPY, FMTAPE for CHEOPS
- Add program FATLOOP2 in P=EXAMPLE to FMGETK every entry in the
- catalogue: ZFATAL = problems.
- Permit useful options on shell FIND command.
- Add program FATHEAD to print headers of journal file on unit 1,
- or the file name passed on the command line.
- Add option Y in FMOPEN: write stage command to file on LUN
- but do not execute. Increase size of PAWC in FM shell.
- No check on Zebra e-o-r in VM servers
- Preliminary interface to TAPESYS (UVVM)
-Version 1.65=Modify FATSEND & FATSRV/FMSEND to use new naming convention
- Ditto for program FATCAT
- Increase size of Zebra store in FATSRV
- Protection in directory scan routines against RZPAFF problems
- (!!! mods to RZPAFF - ZEBRA/RZ must be reinstalled !!!)
- Mods to FMFIXF to handle directory names beginning /
- Call FMVERI in case of directory add/remove operations
- Add CHEOPSIF patch. Routines to stage in or out.
- Bank information is passed as arguments to the routines to
- simplify C/Fortran interface
- Use command file SETUP_EXE:STAGE to submit stage command
- in FMTAPE. #bytes read (COPY_FILE only) returned in logical
- names STAGE_filename. (Not yet used)
- Change naming convention for journal files:
- zz92061118040500000499024164.user_node
- Renamed to aa... when update complete
- APOLLO: use WHICHF to determine if 'l3stage' exists in
- current path. If so, activate l3stage specific code (was IF=APOL3)
- (!!! requires WHICHF KERNLIB (kernbit) routine !!!)
- 19/06/92 09:30
-Version 1.64=Mods from KLG for FMRSTG, FMCSTG, STGSERV.
- Bug fix in FATSEND for ICONT/=0
- Modify STGSERV to send jobname ('LOOK')
- Incorporate mods from D0. to FMRSTG, FMCSTG etc.
- FMRSTG/FMCSTG. check before each job inquiry whether file
- is already on disk (and of the correct size - to be done)
- FMCSTG: wait if tape is already in use
- Job inquiry by FMLOOK (from Krzysztof Genser/D0)
- Support usernames up to 12 characters. Look for signal.stop
- files in FATSEND.
- Add option J to FMSHOW. Just the files that are accessible.
- Add MODIFY command
- Extend CP and MV commands to allow keys, fileid, host, vsn,
- vid and fseq to be changed for output file. XVID syntax supported
- Change copy level to data representation. Add new parameter
- offsets. Permit comments in acl/accounts files
- Add option R to LS : show where the data Reside. (need STAGE Q
- for Shift/Cray)
- For disk files: accessible: Y/N method: Y/N
- For tape files: active library: Y/N device: e.g. local staged: Y/N
- Add option E to RM to erase disk file. !! to be tested on SHIFT !!
- Change MV and CP commands to accept input key
- Support search lists in FMRZIN for DFS devices
- 11/05/92 13:00
-Version 1.63=Fix bug in FALS - don't print blank line in case of option V/W
- and no files found in CWD.
- Don't drop disk of server if mode A. (VM)
- Search list handling in FMLCOP.
- FALS: protection for no files found. Bug fixes from D0.
- Correct calls to VAX RTL routines (irc/istat handling).
- Bug fix in FMPEEK for 'A', 'N' options.
- Modify FMSHOW to accept LBANK=-1 (use LADDBK, e.g. from
- novice i/f).
- Protection in FMFZI - require ZEBRA end of run record in
- input file.
- Fix bug in FMTAPE - FSEQ missing from LABELDEF.
- Add program CHEOPS - read .rqid and .rep files generated
- by CHEOPS server and update FATMEN catalogue(s) accordingly
-Version 1.62=Retry 5 times in FMRZIN if keys vector has been given but
- entry not found. (concurrent update problem).
- Add routine FMACCT to check for account aliases.
- Warning messages if SYSREQ is incorrectly installed.
- Use SHIFT RFIO also for tape files (use sfget after stage
- request). Save pathname across FMLDIR calls.
- Add program FATKEOPS, to send updates from VM to
- cheops directory on fatcat.
- CHEOPS interface - routine FMBTOA to write bank in
- ascii format, write update to /fatmen/fmcheops
- or as variable FMCHEOPS. On VM, use gateway machine FMCHEOPS.
- Fix bug in FMCOPC - set media type in keys vector
- Add patch FATRZCHK to protect against corrupt RZ files.
- Add routine FMACL to provide protection on FATMEN paths
- Correct calls to FMCLOS from FMCOPY.
-Version 1.61=Use exchange mode and C I/O on DECS, if the RZ file is
- kept in a directory starting /fatmen (e.g. on fatcat)
- Support search lists in FMSTGP.
- Rewrite FMCFGL using CIGET routines (for character data)
- Print host type and OS for disk files in FMSHOW
- Add support for Physical copy in FMCOPY. This is the
- default. (Use cp/COPY/VMIO to perform the copy)
- Split FMOPEN into separate routines: FMDISK/FMTAPE/FMFOPN
- FPACK files are handled in FMFPAK.
-Version 1.60=v92a March 1992
- Fix bug in FMSELM when CHOPT=' '
- Bug fix in FMOPEN - save IQUEST(10) & (11) over call
- to FMGET
-Version 1.59=Bug fix in FMSTGP. Network retries in FMRSTG.
- Check that SETUP_EXE:TPSERV.CONF exists in FMOPEN, FMRZIN.
- More bug fixes in remote staging.
- Massaging in VAX Stage handling. Add NRFMFA
- Add Motif version, restructuring of CDF file,
- SHOW/CATALOGUES command.
-Version 1.58=Print stage log in FMCSTG, FMRSTG.
- Correct tag definitions for FATMEN directories.
- (loc.code and med.type were swapped).
- Default catalogue name is DESY,IF=DESY, FNAL,IF=FNAL in
- FATMEN shell only. Fix bug in FATSRV, FMOPEN for VMS.
- Move FAFNDF,IF=APOLLO to patch UNREF.
- Bug fixes in remote VAX staging.
- Deassign channel in FMQUOT. Use FORTRAN I/O when reading
- SETUP_EXE:TPSERV.CONF
- Add debug printout for remote staging.
-Version 1.57=Print dsn, host or vsn,vid,fseq if logl>=1 in FMFZI
- Print user & host of originator of update in FMFZI.
- Protect FMQUOT against disks with quotas disabled.
- Bug fix in FMLDIR for [] support.
- Add routines FMRSTG, FMCSTG, FASTGS, FASTGQ for remote
- VAX staging. (Across or within clusters)
- Bug fix in FMLFIL.
- Add support for remote tapes in VMS:
- tpserv device-group host1 [host2]
- Add support for RMS files (RECFM RMS, /RMS on STAGE command,
- use COPY to copy data)
- Permit creation for exchange mode files, via FATMODE in
- FATNEW (setenv FATMODE X or XC)
-Version 1.56=Debug printout in FACOPY.
- Open journal files as recordtype=stream_lf if writing
- over NFS from VMS->Unix.
- Fix bug in FMGLUN.
- Print date and time before going to sleep
- Fix warnings from VSFORT 2.5 compiler (unreachable code
- in routines FMCOPC and FMRZIN. See warnings in these routines)
- Fix bug in FMTAGS (undefined variable)
- Friday, 13th December
- Fix bugs in FMSEND
-Version 1.55=mods to FAINQR and FMRZIN for FPACK files
- If host is not local, then search in .netrc file for nodename
- IBMMVS: userid.PER.NETRC
- VAXVMS: netrc.;
- VM/CMS: DOT NETRC A0
- Unix : $HOME/.netrc
- Update FATNEW for MVS. Resync copy level with FPACK
- FPACK interface: in case of FPACK files, routine FPARM
- is called in FMOPEN & FMCLOS. FPARM handles file open and
- starts server etc as necessary.
- OPEN: CALL FPARM('OPEN logical-name UNIT=lun FILE="fn"'
- CLOSE: CALL FPARM('CLOSE logical-name')
-Version 1.54=Support NFS mounted files (FMRZIN, FAINQR) VAX/VMS, Unix
- Use sequence QFTITLCH to get pam title rather than QFTITLE
- Fix bug in FATSRV for check on /done directory (Unix systems)
- Handle .. characters in FMPAFF and FMFIXF
- Fast match in FALS, FMLOOP (file='*')
- Add ACTION=read/readwrite on OPENs. Modify FMHOST for CMS 7.
- Fix bug in CP command - cwd was not correctly restored.
- Add FATOUCH example program, to touch files or directories.
- Fast count in FMFC, if filename=*. (Uses 1/3 of CP time)
- Changes in FMOPEN for shift - call CFOPEN for
- full shift file name, not fort.n
- Use C I/O and exchange mode for RZ file if
- STREAM_LF (VAX) or in /fatmen (CERN Cray)
- Call FMVERI from FMRM, FMRMC
- Use configuration files to determine device access.
- VAX/VMS,IF=VAXTAP: logical names SETUP_modelS
- IBMVM, IF=HEPVM : nodename RESOURCE P
- SHIFT : /etc/shift.conf, /etc/TPCONFIG
- CRAY : /etc/shift.conf
-Version 1.53=Add routine FMQUOT to P=FMVAX - get current disk quota
- information (from SPACE by JJB). Perform cleanup in FATSRV
- Perform automatic cleanup in FATSERV EXEC
- Update return codes in FMATCH. Return location of
- mismatches in IQUEST. Modify FMSCAN to treat wild-carded
- and non-wild-carded pathnames alike.
- Add routine FMHUNT - hunt for (wild-carded) generic name
- Set IQUEST(10) to number of levels in initial path in FMLOOP
- Common version for CERNVM, CERNVMB & LEPICS
-Version 1.52=Access to SMCF now based on sequence FASMCF.
- Access enabled, however, for SHIFT, CSF, VXCERN, APOL3
- Fixes for CERNVMB
- More examples in P=EXAMPLE.
- Extra protection in VAX, Unix versions if FM symbols
- not defined.
- Rewrite FMLDIR using FMSCAN
- Add support for [] wild-cards.
- Given the following subdirectories:
- Y91V02
- Y91V03
- Y91V04
- Y90V06
- Y91V05
- ld y(90:91)v> will follow Y90V06, but ld y[90:91]v> will
- follow both Y90V06 and Y91V05.
- Call FMACNT on each entry to FMRMC, in case user has reset acct
- Fix bug in FMPOOL when TO specified
- User meeting of 16/10/91 (ship command not yet implemented)
-Version 1.51=Add routine FMSETK - set keys matrix for d/s selection
- Add commands SET/SHOW userwords.
- Add routine FAINQR - inquire with GIME/sfget/env. variable
- expansion.
- Add FMSELM routine - select by keys matrix.
- Add ZOOM command to zoom down directory tree to first
- directory with no subdirectories & at least one file
- FMSCAN now descends specified number of levels below
- wild-carded pathname, and not below path up to last wild-card
- Add option V in FMOPEN - as S but even if file size is ^0
- Fix bugs in FMMANY, FASELP for <> matching.
- Fix bugs in FAT2VM.COM, FMTOVM to not send files back to origin
- Add FACDIR interface routine - reset top directory
- if naming directory is not TOPDIR
- Fix bug in FAEXTR
- Fix bug in FMALLO - use separate buffer for QUERY CONTENTS
- Modify FMLD to use FALD - remove limitations on
- numbers of directories that can be displayed.
-Version 1.50=CNL 204 - 12/09/91 09:00
- Add FMLOOP. As for FMSCAN but for file names
- Add FMMODU - modify user fields
- Use FMSCAN from FC, LS commands and routines
- Add routine FMSCAN & FASELP. FMSCAN provides FMLDIR
- like functionality but avoids the use of local arrays
- by calling user exit. <> are also supported.
- Option Q in FMSHOW also shows TMS tags
- Extra protections in FMINIT
- Add options Q, S, T (A) in CD to list RZ quota, statistics,
- dates & times etc. Add command DIR to issue RZLDIR.
- Add option Y in FMLSC - verify bank contents
- Permit reinit if user typed a bad FM group
- Add utility routine FAEXST
- Add command ALLOCATE to add tape file with volume
- allocated from named pool in specified library.
- Add TREE command to print directory tree
- Use FMOPTC rather than UOPTC - checks on CHOPT case insensitive
- Treat <> like * in FMATCH (with warning if LOGL>=3)
- Change flags for routine names (Lowercase, Underscore etc.)
- Fix bug in FATMDI introduced by move to FATLIB.
- Purge CON files in FATSERV on VM
- Fix bugs in FMXDSK. Add warning in FMOPEN if size > MAXSTG
- Add command MEDIA to set/show media attributes
- Command files for VAX servers - scripts for FATCAT
- Add patch FATSEND to send FATMEN updates to remote
- servers, according to NAMES file. Current version
- is for Unix and VMS systems only.
-Version 1.49=Interface to VMTAPE (FMOPEN/FMFIND/FMMAKE) & FMALLO
- Interface to VMBATCH (for FMUSER, FMACNT, FMJOB)
- Add routine FMEDIA to set default media attributes.
- Call FMUTMS (user exit) from FMQTMS IF=-TMS to allow
- user to override these values for individual volumes.
- Add option G to RM command, to change protection
- group on a volume. Defaults to *None.
- Add routine FMPROT.
- Add command RMTREE, to delete a complete directory tree.
- Modify FMATCH & FMMANY. Pointer now reset after a *
- by looking for a substring, rather than single character
- Only check TMS information in FMVERI if Q option present.
- Add routine FMTAGS, to get, set or delete TMS tags.
- Change default shift staging pool from PUBLIC to shift1
- Add program FAT2SQL - convert entire RZ file to SQL
- Add routine FMVMIO - user hook routine for FZ D/A
- for binary exchange format files on IBMVM.
- Protect against error opening input file in FMFZI
- Option D in SEARCH (FMSHOW really): write KUMAC file
- to remove matching entries
- Use FORTRAN I/O by default for FX, FXN files.
- This is default for Zebra 3.67 and above, unless Y
- specified on FZFILE.
- Fix bugs in FMOPEN for SHIFT. N.B. must use -lsun for
- XY routines. To get debug from XY routines:
- setenv RFIO_TRACE 3
-Version 1.48=Issue QUERY LIBRARY in FMQTMS IF=QVID to determine if
- library is active or not. Libraries beginning with a '*'
- are apparently inactive by definition.
- Issue option X on FZENDx in FMCLOS if C I/O selected in FMOPEN
- Return true RC from SYSREQ in IQUEST(1) (FMQMED)
- 312 = volume unavailable only fatal in FMRZIN when key not
- specified.
- Allow staging disks upto 210 MB IF=CERNVM. Default to
- sequential access for FZ files on disk.
- Support date & time ranges in SEARCH
- Mods for DESY.
-Version 1.47=Add FATPURGE.COM to delete old files in [.DONE]
- Add FATRL.COM - modified RDRLIST.COM to copy files send to
- VAX via SENDFILE to [.TODO] directory
- Add FAT2VAX exec to send updates via Interlink
- Support MVS in FATSRV.
- Add FMUSER for MVS systems (adapted from KPREFI)
- Add /*DECK, $!DECK lines to REXX/DCL patches
-Version 1.46=Fix PREFIX support in FMOPEN, FMFIND, FMMAKE
- Support range of Copy Levels, Media types in FMRZIN, FMLS(C)
-Version 1.45=Fix bug in FATCAT - reset IC after call to XZLS
- Fix bug in RM command for freeing volumes
- Permit use of FMGETV/C/I, FMPUTV/C/I from novice interface
- (LBANK=-1)
- Add example pgm using novice interface in patch EXAMPLE.
- Add example installation procedures
- Perform checks on input parameters in FMINIT, FMSTRT
- Set location code to the value given by a call to FMSETL
- (or set/loc) in FMKADD, FMKADT, FMADDD, FMADDT
-Version 1.44=Add commands SET/COPYLEVEL, MEDIATYPE and SHOW commands
- FZFILE options: T only if read directly from tape.
- Add command SET/LOC
- Check that location code of each candidate is found
- in location code vector specified by user (FMRZIN)
- Modify for use with ORACLE on FATCAT(IBMRT).
- Oracle RTL compiled without -qextname
- Requires trailing _ on ORACLE interface routines,
- Common/FOFILE/ and CLTOU.
-Version 1.43=Check status from stage -o in FMCLOS (APOL3)
- VID prefix support for all calls to FMQTMS.
- Change key allocation in FMALLK: now use maxkey+1
- Change FMACNT to check env variable FMACNT
- FMQTMS, FMGTMS: iquest(1) = -1 if -TMS
- Add routine FMQMED to return media type and mount flag
- Add options AFIU to FMRMC (All,Free,Interactive and Unlock)
- Support search options as for FMSEAR.
- Use C I/O for Zebra FZ if IQUEST(10) = 1
- Look at environmental variable FMHOST (Unix, VAXVMS)
- Use this as nodename, if set.
-Version 1.42=Bug fix in FMNODE for VAXclusters
- Fix bugs in FMTMS patch for SYSREQ retry
- Revert to CART for APOL3 - old stage still on LEPICS
- Fix bugs in FMCOPC, FMRCOP.
- Fix bug in FMFZI - return code from VMCMS undefined.
- Add example EXEC/COM/SCRIPT for running pgm FATNEW.
- Fix INQUIRE bug in FMKUIP routines for VM.
- Fix typo in FMOPEN. Add -h in fmld, fmseac, fmlsc, fmfc.
- Support options -V,-W in FMLD
- IBMMVS version. Current implementation assumes that all files
- are catalogued.
-Version 1.41=Add stage -o for APOL3 in FMCLOS. Reinstall and test on Apollo
- Support non-CERN catalogues: variable FATSYS (server, pgms),
- INIT //fatsys/group (KUIP)
- Modify FC command to support CHOPT: count #file/dir,
- #subdirs/dir.
- Use FMLFIL in FMLSC, FMSEAC
- Fix bugs in FMLDIR. Restore code for NLEVEL in FMTREE, support
- in LD command. Fix bug in SEARCH for NMATCH=n.
- Change CART to CT1 in FMMAKE (this is now returned by the TMS
- for manual 3480s)
- Retry in FMALLO if first tape from Q CONTENTS has been
- allocated away from under us...
- Add protection in FMOTOZ for bad ORACLE information.
- Fix bugs in FMATCH, FMOTOZ, FMLD.
-Version 1.40=CNL201
-Version 1.39=Fix bugs in FMLDIR. Add FMLFIL, FMFILS.
- Add return codes for SYSREQ(TCP)
- Use FMSREQ to perform call to sysreq with retry
- Add calls to L3 stage script in FMOPEN, FMFIND, FMMAKE
- Add FMFILC - like FC in FM shell.
- New calling sequences for GETENVF, SLEEPF.
- Fix bugs in SHIFT version
- Add IBM MACROS (needed for MVS version) to FATCDES.
- Add program FATCAT to send updates to FATCAT upon
- arrival in RDR and poll for new updates at wakeup
- interval.
-Version 1.38=SHIFT code for sfget (DSN is [pool.user]/unix-dsn)
- Add MVS routines from DESY
- Split FMOPEN, FMFIND, FMMAKE
- Add routine FMFNME to generate extended unique file name -
- not suitable for VM systems.
-Version 1.37=Add Patch FATULOK. Example program to unlock FATMEN RZ file.
- Current version will unlock 'CERN.FATRZ' in current directory
- Put large arrays in FMALLK, FMLIST, FMLDIR into commons.
- Add options K (keep) and P (autoput) to FMOPEN
- Modify FMQTMS so that the correct media type (taken from
- bank) is returned if volume unknown or TMS option not
- installed. Media type is passed to FMQTMS via IQUEST(11).
-Version 1.36=Add patches DCL, SCRIPT to contain sample command files/
- scripts to start FATMEN server.
- Add variable FMWAKEUP (FATMEN$WAKEUP on VAX) to define
- FATSRV wakeup interval
- Fix all warnings reported by Apollo compiler.
- Return in FMOPEN for Unix systems without tape support
- (currently only Cray, Shift)
- Extra protection in FMINIT if logical name/env. variable
- pointing to FATMEN catalogue is not defined.
- Fix bug in FMLD for bad pathnames
-Version 1.35=Fix bug in FMRM if non-existant key is specified
- Use XYOPN in FMOPEN for SHIFT disk files
- Add WRTAPE support in FMCOPY for VAX
- Add option MEDIA in ADD/TAPE and FMADDT. (For NA44)
-Version 1.34=Fix bug in FMALLK, extra debug in FMFZI.
- Use stagewrt in FMCOPY for Cray
- Add SHIFT support: use stagein/stageout scripts in FMOPEN.
- All SHIFT files are assumed to be accessed via RFAS routines.
- Current support only for FZ binary files...
- Add routines FMULOK, FMPOOL to unlock (enable write) and
- transfer a tape from one pool to another. Modify FMSHOW
- to display the host on which a disk file resides, rather
- than that from which it was catalogued.
- Add DCB/Generic device support in VAX version
- Move 'fix' for check on robot/manual to FMQTMS
- Add extra print out in FMFZI.
- Fix bug in FMQTMS introduced by VID prefix support.
- Add command SEARCH to allow searches on DSN, HOST, VID and
- USER. Output is piped to FMSHOW.
- Add option Z in FMCOPY - use STAGE OUT for output file
- Add routine FMGBYK (get by key-serial-number).
- Modify FMLS to support options I (sort in Increasing order)
- and 1 (display only one entry per generic name).
- Option W in FMLS - multi-column output
- Modify FMSHOW to call FMSHO2 in case of options B (brief=80 cols.)
- or E (extended=132 cols.) listing. Modify FMOPEN to take
- file size for STAGE request from IQUEST(11) if option O(verride)
- is specified. Fix bug in FMLD for output redirection.
-Version 1.33=Add routines FMSETL, M, C, U to set the list of (<100)
- location codes, media types, copy levels and logical units
- for use in FATMEN selection and for use by FMCOPY etc.
- Add routine FMPUSE to print usage information.
- Add routine FMUNIQ to return a unique list of file names
- in specified directory. Selection may be made under normal
- keys mask, as for FMSELK.
- Add routines FMJULI/FMDATE/FMDAYS to provide conversion to
- and from julian date and delta time.
- New entry point FMDCB - provide DCB or take from 'model DCB'
- Add routine FMFZCP to copy an FZ file from LUNI to LUNO.
- Called by FMCOPY. Logical units required by FMCOPY may
- be set in IQUEST(11-12).
- Change size of RZ file to 65000 records (new protection in RZ)
- Fix bug in FMKEYS/FMSELK.
- Close and reopen RZ file in FATSRV on return from FMFZI.
- This ensures that updates are seen by clients.
-Version 1.32=FMPEEK/FMPOKE routines - return information from FATMEN bank
- in vector/ copy vector to FATMEN bank with optional catalogue
- update.
- Rename FMADDT/FMADDD to FMKADT, FMKADD. Add routines FMADDT,
- FMADDD in patch FATUOUS. Add routine FMSTRT -
- "Novice" initialisation routine which also initialises Zebra
- Suppress call to RZDELK in FMFZI for MOD operations
- Add option L in FMOPEN - override Label information with
- DCB from catalogue or user-supplied bank
- Add routine FMLDIR - provide <> wild-card support plus
- context pointer.
- Support wild-cards in any location in LD command.
- Add routine FMCOPC - command line copy routine. Permit copy
- to named VID, tape allocated from pool, remote copy (via
- CSPACK) or copy according to two existing catalogue entries.
- Add entry point FMGTMS to obtain FATMEN oriented details from TMS
- Change calling sequence of FATUOUS interface to match CERNLIB
- standard. Fix bug in FMLD for -R option, VID-prefix handling
- in FMADDT.
-Version 1.31=Add 2MB to file size on VMSTAGE request, if < 200 MB
- Modify FMPUTC/FMGETC to support VID prefix field
- VMSTAK now also for HPO. Use KERNLIB version of GETENV
- Add ZABEND routine for FATMEN shell - avoid ZPOSTM
- Support VMIO in FMOPEN for DDNAMEs like VM%%F%%%
- Update mode corresponds to FMOPEN option X
- Add pilot patches for CERNVM, LEPICS and FRCPN11 (ugh)
- Add routine FMMANY - match many files, selecting
- according to < or >.
- Add routine FMCHOP - check options against allowed values
- Output to search list on VAX: use disk with most space
- Add routine FMKEYS. As RZKEYS, but with IFIRST,ILAST
- to avoid the use of large arrays.
- Use QUERY VID instead of QVOL (IN2P3 only, temporary!)
- Return immediately after STAGE command in FMOPEN if NOWAIT
- Support output redirection in LS, LD
- Add patch FATUOUS - novice interface
- Add routine FMFILE - as FMOPEN but no LBANK
- Add routine FMPREF to convert VID prefices to/from
- CHARACTER/INTEGER
- Support STRONG TYPING IF=TYPE in PATCHY sequences
- Add call to FMUPRT in FMSHOW, FMUSEL in FMRZIN
- Add PATCH FMTMS for TMS interface routines (FMALLO,
- FMQTMS and FMLOCK)
- Add entry point FMSCAN - FMLIST + FMSORT + FMGET
- Add DA as valid file format: open ACCESS='DIRECT'
- in FMOPEN for format DA or it option X is given.
- Support full wild carding of generic name in FMLS
- Support RZOPEN in FMOPEN, RZEND in FMCLOS
- Provide interface to DUMPTAPE (IBM, Cray)
- Extend FATOPTS to numeric options
-Version 1.30=CNL 200
-Version 1.25=Fix bug in FMCOPY - close both input & output files
- if an error occurs opening the output file
- Fix bug in tape allocation in FMOPEN
- Free tape unit correctly in FMCLOS for output volumes
- Lift bank in FMADDD/T only on first entry. Add FFX
- as valid file format.
- Use FMBOOK in FMSMCF - save address in link area
- FORTRAN version of FAFNDF based on SZLS from CSPACK.
- Use RZOPEN from FAOPEN
- Extend IFLAG in FOPUT: add only if not already present
-Version 1.24=Move FMALLK to patch FATSRV.
- Fix bug in FMCOPY when called from FMSMCF (infinite loop)
- Treat characters following a blank in DSN as a comment.
- Correct FMQTMS, FMALLO for VAX.
- Print DSN stacked in FMOPEN if LOGL >= 0
-Version 1.23=Extra protection in FMFZI for file deletion.
- Fix bug in FMCOPY for VBS files. Remove unecessary
- protection in FMSMCF for unknown VIDs.
- Add TESTFAT KUMAC - example test macro in PATCH FATTEST
-Version 1.22=Try to reduce size of program. Limit number of directories
- that can be displayed in FMLD to 10000, number of
- copies of a file to 1000 (parameter MAXCOP).
-Version 1.21=Ensure that VMOPEN error codes are passed back to user
- Force updating of KEYS vectors from BANKS in FMCOPY
- Option C in FMCOPY - use STAGE CHANGE, option S, using
- STAGE for input file (C implies STAGE for input and output)
- No FORTRAN open in FMOPEN if using IOPACK.
- Add sequence FATPARA in FMEXST.
- Add flag NOSMCF for LEPICS - no TMS or robot access
- Fix bug in FMLIST for call to FMFNMS (no wild cards)
- Increase FORMAT statement for key serial number and loc.code
- Set MAXKEY to 10000. Always put DCB on Cray STAGE
- Use -S sbin option on Cray
-Version 1.20=CNL 199
-Version 1.18=For input tapes, must use 'EXEC STAGE CLEAR' in FMCLOS
- CTRANS, CSQMCH now in KERNFOR.
- Add parameter lengths of character fields
- Fix conversion of LUN to DDNAME in FMOPEN for IOFILEnn
- Attempt reconnect to ORACLE if IRC=3114 or 6065
- Erase FATMEN RDRFILE after successful processing.
- Fast exit in FATSERV EXEC in case unprocessed file exists
- Increase working space to 200K words in FATSRV.
- Save current directory in FMLS for restore at end
- Add routine VMSTAK. Print shortest/longest record in FMCOPY
-Version 1.17=Fix bug in FMSMCF for check on robot/manual.
- Convert TMS density to SETUP/STAGE format
-Version 1.16=Check bank address in FMVERI using MZCHLS
- Add routines FMGETV, FMPUTV, FMGETC and FMPUTC to get and
- put information to/from FATMEN bank.
- Add FATSTACK exec for LABELDEF FID ? in FMOPEN.
- Add routine FMFILL to fill FATMEN bank with default
- values according to CHOPT. Old FMFILL renamed to FAFILL.
- Set MNTTYP to 'R' if TMS unavailable and vid = Innnnn
- Add routine FMEXST to check if entry already exists.
- Ensure that Media type is set (keys and bank) in FMFILL,
- FMALLO, FMCOPY.
- Call EXEC FATSTACK to stack FID for FMOPEN option T
- Fix bug in FMFZI for call to FMCOMP, default density
- in FMQTMS=38K (not 38000).
- Use VMCLOS in FMCLOS for DDNAMEs like VM%%F%%%.
- If STAGE fails, retry using larger disk size up to max.
- CP DETACH tape unit (option D in FMCLOS)
- Use new version of SYSREQ (one line per CHARACTER element)
- Protect in FMVERI against blanks, unseen chars in GENAM.
- Update use count in FMOPEN only for input datasets
- Output datasets require U option in FMCLOS
- Add option E to FMOPEN - issue SETUP (END
- Save vaddr of tape unit used in FMOPEN, free in FMCLOS.
- Save and reset current directory in FMCPC, FMMVC.
- Extend FMCOPY - disk-disk, disk-tape, tape-disk, tape-tape
- via VMIO. Fix bug in FMALLO for curious length TMS replies
- Rewrite FMRM. If more than one match is found, key serial
- number must be specified.
-Version 1.15=Fix bug in FMFZI in call to FMCOMP.
- Set date/time of cataloging, last access and use count
- in FMSMCF. Add -K option on stagein (Cray)
- Add Apollo version of GETENV (FMGENV)
- RC=3 from TMS, use defaults IF=TMSTEST, ELSE sleep
- for 1 minute and then retry.
- Option G in FMALLO - change control group to *None
- to allow GROUP access to the tape allocated.
- FMLIST calls FMFNMS if PATH contains no wildcards
- Labeltype in lower case on Cray
- Add routine FMSMCF to make automatic copy into SMCF
- (FMOPEN option D, CERN specific routine!)
- Add flag TMSTEST (for CERN until all tapes in TMS)
- Modify FATSERV to support FATOWNERS and FATOPERATORS
- lists from NAMES file. Apollo version with local catalogue
-Version 1.14=Add routine FMCOPY - copy dataset from GENAM1 to GENAM2
- using STAGE CHANGE, COPYTAPE, DISKTAPE, TAPEDISK or ZFTP.
- Add option S in FMOPEN - update bank with file size from
- VMSTAGE. Add option N in FMOPEN - do not specify DSN on
- STAGE/LABELDEF command. Stop in FAOPEN if RZ file not found.
-Version 1.13=Add shell command MAKE. Add print out to FMCLOS.
- Add DCB to FILEDEF for VM/CMS disk files. Print use count
- in FMLS/FMSHOW (option P).
- Add OPEN to FMOPEN routine, unless option U(seropen)
- Support C(lear), D(rop), E(nd), F(zstat), P(ut), U(pdate)
- options in FMCLOS. Add routines FML2DD, FMDD2L to convert
- FORTRAN logical unit to corresponding DDNAME.
- Add call to FZFILE in FMOPEN, if option F is chosen.
- Add optional parameters RECFM, LRECL, BLOCK, FSIZE in
- FMADDT/D. Add support for 3420s (media type 3) in FMRZIN
- Use mode 4 for VM VBS disk files.
- Support remote non-Bitnet servers. Pull updates over
- using ZFTP based utility. Polling interval defined by
- remote installation.
-Version 1.12=Fix bug in FMSHOW for user supplied bank.
- Add flags SETUP and STAGE to allow sites to enforce tape
- processing style.
- Add entry FMOPEN - just options RTUW for now
- Use TMS to allocate tapes in FMALLO
- TMS QUERY CONTENTS LIBRARY <lib> user <pool> slot 1
- TMS GETPOOL VID <vid> FROM <pool>
-Version 1.11=Add C routines for Cray to find next file in a directory
- (from Phil Defert). Fix bug in FAT4WARD when no remote
- servers are specified.
- Add exec FAT2CERN to forward updates to CERNVM, unless
- they originated there.
- Activate FAT4WARD if on CERNVM (forward last update to
- remote servers)
- Add routine FMBOOK - create bank with FATMEN format at
- L, LSUP and JBIAS specified by user.
- Fix bug in FMMV - protect bank address in LTDSFA
- Add command VIEW, to edit a local disk file, using KUEDIT.
- Use TMS to determine MNTTYP in FMRZIN. Get labeltype,
- generic device from TMS (FMFIND/MAKE)
- Add interface to TMS (FMLS/FMSHOW) + patchy flag TMS.
- Set warning in FMVERI if VID unknown to TMS.
- Update use count (MUSCFA) and last access date in
- FMFIND/MAKE. Increment in FMFIND, set to 1 in FMMAKE.
- Modify FMTOVM to issue dispose from Cray to CERNVM
- VM: Nick names FATSYS, FATGRP, fatgrp
- VMS: Logical names FATMEN$SYSTEM, FATMEN$GROUP, DISK$fatgrp
- Unix: Variables FATSYS, FATGRP, fatgrp
- Send logging message to server only on CERNVM
- Add interface to TMS via routine FMQTMS. Use flag TMS
- to allow sites without TMS to continue.
- Use variables for UNIX systems to determine location of
- FATMEN RZ file (FMgroup=/u/mf/fml3, for ex.) and
- group for which this server is running (FATMEN)
- Use count stored in MSYWFA+1(=MUSCFA)
-Version 1.10=Enable CONVEX flag. Introduce FFATMEN patch
-Version 1.08=Fix bug in FMALLK when directory is empty.
- Allow VAX server to run under any account.
-Version 1.07=Fix bug in FMVERI for check on user words.
- Fix bugs in 1.06. Bad +SELF in FATMDI. Fix bugs in VAXVMS
- version. FATMEN logical names now in GROUP table.
- Add patch FATNEW (to create new RZ file)
- Ensure that directory is reset in FMFNDC
-Version 1.06=Fix bug in FMVERI - copy level may be 0. Add EXECs to PAM
- Calls to FMONIT in FMFIND/MAKE rather than FMGET
- Add routine FMVERI, return extra information via IQUEST
- in FMLIFT, FMKDIR. Extend FMOPEN/FMCLOS.
- IQUEST(11) = 1 : generic name already exists
- IQUEST(12) = 0 : path name already exists
- IQUEST(12) = 1 : path name does not exist
- Numeric ranges (m:n) supported in FMLIST
-Version 1.05=Add routine FMSORT - call SORTCH (modified from SORTZV)
- Fix problem in FMFZI - allocate next key using FMALLK
- In case of MOD or REP operation, re-use old key.
- Add DCB on STAGE OUT /FILEDEF commands (VM only)
- Add routines FMUPTM/FMPKTM - as DBxxx but with return code
- Use mode 6 for RZ files on VM (unless mode=*)
- Fix bugs in FMATCH. Add routine CSQMCH (squeeze multiple
- characters) Add FMSHOW example print out routine.
- Use DEVTYP SMCF for robot, if VID =Innnnn and MMTPFA=2
- Introduce flag DECS for DEC MIPS. Modify C code to
- use +SELF rather than #IFDEF.
- Add journaling of FZ files. Use AUTOPUT option on
- STAGE OUT command. Tidy LOGL.
-Version 1.04=Retry connect to ORACLE up to 5 times. Reinit RZ if
- error from RZFILE. Add FMALLO on VM systems
- New versions of SQL/DS compatible FOxxx routines.
- Cleanup pilot patches. Modify for AIX. Default for CD is PWD
- Find KEYS(1) using FMSELK,FMCOMP in FMFZI (for
- remote delete to work).
- Allow NOWAIT option in FMFIND, if CHLUN=NOWAIT
- Add routine FMCOMP to compare banks pointed to
- by two generic names.
- Add routine FMLIST - combine FMTREE with FMFNMS and wild
- card support for directory names.
- Add G option to FMLS - list full generic name
- Support VAXclusters and DFS in FATMEN selection.
- VAXclusters treated as a single node, DFS disk
- taken after local disk but before local tape.
- (DFS logical name must be in LNM$SYSTEM_TABLE).
- New routine FMSELB to allow user to perform select on
- contents of FATMEN bank.
-Version 1.03=Fix bug in call to RZIN - don't use 'S' option.
- Server now uses FATLIB.
- Rewrite FMATCH subroutine. Add LOGLEVEL to FMLS
- Bugs fixes and enhancements from DELPHI installation.
- Add debug print to FOPUT. Add patch TAPELOAD.
- Add PROGRAM FATO2F - recover from ORACLE /SQL and send to
- server as FZ file(s).
- Add DSN to STAGE command. Add UPDATE command to CDF.
- Bugs in FMLIFT/FMLINK fixed (IQUEST/IRC uninitialised)
- Fix bug in FMFILL for user-allocated tapes
- Error message in FMRM if key vector cannot be found
- Add routines FMMOD and FMUPDT
- Examine REXX variable FREE_BLOCKS to determine number
- of records to preformat in RZ file (for FATMEN server)
- Modify FMFZI, FMZTOR and FOPUT to support equivalent
- of DISP=NEW, OLD, MOD.
- Add routine FMSELK to allow selection of files on
- basis of keys vector (e.g. media type, copy level etc.)
- Add SIZE qualifier on input STAGE requests. Sizes are
- based on current VMSTAGE disk sizes.
- Selection of best copy (local_disk>robot_tape>manual_tape)
- Improved logging: Level -3 Suppress all log messages
- -2 Error messages
- -1 Terse logging
- 0 Normal (FMINIT, FMEND etc.)
- 1 Log to watch FM calls
- 2 Log to monitor FM decisions
- 3 Debug messages
- Add PATCH FATSTAT, to print statistics on usage
- of FATMEN RZ database. Current version VM only.
-Version 1.02=Bugs reported by CHARM2.
- Conform to CERN Program Library convention for flags
- Preformat RZ file before call to RZMAKE by writing
- 2500 records (fills 85% of a 20 cylinder disk)
-Version 1.01=Coincide with version 1.00 of documentation
- Add IRC to all FM calls, make FMATCH a subroutine
- Use KIPRMT to set KUIP prompt, rather than KUEXEC
-Version 1.00=Meddle meeting of 19/10/89
- and CERN Library release of CNL196
-File and Tape Management Package
- Requires:
- CERN libraries,
- HEPVM (VM/CMS systems),
- VMS 4.6 or greater (VAX/VMS systems),
- Apollo SR10 (Apollo systems),
- Unicos (Cray systems).
-
- Enhancements to external packages:
- Requests from LFATMEN list:
- <> wild-card support (Daniel Lellouch) (done, FMLDIR)
- <n1-n2> in FATMEN selection (fmnext)
- Wild card support in LS, LD (done)
- Output to disk files for LS, LD (done)
- COPY command in FM shell (done for local files)
- Select disk with max. space for output to search lists (VAX) (done)
- To be clarified:
- For FORTRAN 90:
- Hollerith (FMSTRT, FMINIT, FMVERS)
- UCOPY (FMMODU)
-+PATCH,FATFLAGS,IF=$DOC. EXPLANATION OF SOME OF THE PATCHY FLAGS
-+DECK,BLANKDEK.
-+USE,TYPE. To activate 'STRONG TYPING' for patchy sequences
-+USE,TMS. For systems running the HEPVM Tape Management System (TMS)
-+USE,TMSTEST. Use defaults for tapes unknown to TMS
-+USE,PREFIX. For systems supporting VID prefices (FRCPN11)
-+USE,QVID. For systems without the QVOL command (FRCPN11)
-+USE,HEPVM. To activate HEPVM specific code (SETUP, STAGE etc.) (default)
-+USE,SETUP. To force tape access via SETUP
-+USE,STAGE. To force tape access via STAGE
-+USE,SQL. To activate the SQL code (only in server)
-+USE,VMBATCH. If you are running VMBATCH from Systems Center
-+USE,VMTAPE. If you are running VMTAPE from Systems Center
-+USE,VMTMC. If user tapes are catalogue in the VMTAPE TMC
-+USE,CERNVM,IF=CERN,IF=IBMVM.
-+PATCH,FATDOC,IF=$DOC.
-+PATCH,*FATCAT.
-+DECK,BLANKDEK.
-+USE,IBMRT,FATCAT.
-+PATCH,*DSYIBM.
-+DECK,BLANKDEK.
-+USE,FATASM.
-+USE,NEWLIB.
-+USE,DSYIBM.
-+USE,IBMMVS.
-+USE,FPACK.
-+USE,CSPACK.
-+PATCH,*GSIIBM.
-+DECK,BLANKDEK.
-+USE,GSI.
-+USE,IBMMVS.
-+PATCH,*SHIFT.
-+DECK,BLANKDEK.
-+USE,SHIFT.
-+PATCH,*CERNVM.
-+DECK,BLANKDEK.
-+USE,TMS.
-+USE,TMSTEST,T=INHIBIT.
-+USE,CERNVM.
-+USE,CERN.
-+PATCH,*CERNVMB.
-+DECK,BLANKDEK.
-+USE,TMS.
-+USE,CERNVMB.
-+PATCH,*FNAL.
-+DECK,BLANKDEK.
-+USE,FNAL.
-+PATCH,*FRCPN11.
-+DECK,BLANKDEK.
-+USE,TMS.
-+USE,QVID.
-+USE,PREFIX.
-+PATCH,*LEPICS.
-+DECK,BLANKDEK.
-+USE,TMS.
-+USE,LEPICS.
-+PATCH,*UVVM.
-+DECK,BLANKDEK.
-+USE,TAPESYS.
-+PATCH,*APOL3.
-+DECK,BLANKDEK.
-+USE,TMS,T=INHIBIT.
-+USE,TMSTEST,T=INHIBIT.
-+USE,APOL3.
-+PATCH,*VXCERN.
-+DECK,BLANKDEK.
-+USE,VXCERN.
-+PATCH,*FATRZCHK.
-+DECK,BLANKDEK.
-+USE,P=QCDE.
-+USE,P=FATCDES.
-+USE,P=FFATMEN.
-+USE,P=FATRZCHK.
-+PATCH,*FAT2SQL.
-+DECK,FAT2SQL.
-+USE,FAT2SQL,FFATMEN,FATCDES.
-*CMZ : 18/09/91 16.22.40 by Jamie Shiers
-+PATCH,*FATSQL.
-+DECK,BLANKDEK.
-+USE,*FOGET.
-+USE,*FOPUT.
-+USE,*FODEL.
-+USE,FMLOGI.
-+USE,FATCDES.
-+USE,SQLINT.
-*CMZ : 18/09/91 16.22.40 by Jamie Shiers
-+PATCH,*FATUSER.
-+DECK,BLANKDEK.
-+USE,QCDE.
-+USE,FATCDES.
-+USE,FATUSER.
-+USE,FFATMEN.
-+PATCH,*FATO2Z.
-+DECK,BLANKDEK.
-+USE,QCDE.
-+USE,FATCDES.
-+USE,*SQL.
-+USE,FATO2Z.
-+USE,FMOTOZ.
-CUSE,P=FATBODY,D=FATMDI.
-+USE,P=FATSRV,D=FMALLK.
-+PATCH,*FATO2F.
-+DECK,BLANKDEK.
-+USE,QCDE.
-+USE,P=FATCDES.
-+USE,*SQL.
-+USE,FATO2F.
-+USE,FMOTOZ.
-+PATCH,*FATNEW.
-+DECK,BLANKDEK.
-+USE,FATCDES.
-+USE,FFATMEN.
-+USE,FATNEW.
-+PATCH,*FATSRV.
-+DECK,BLANKDEK.
-+USE,P=QCDE.
-+USE,P=FATCDES.
-+USE,P=FATSRV.
-+USE,P=FFATMEN.
-+PATCH,*FATSEND.
-+DECK,FATSEND.
-+USE,P=QCDE.
-+USE,P=FATCDES.
-+USE,P=FFATMEN.
-+USE,P=FATSEND.
-*CMZ : 18/09/91 16.22.40 by Jamie Shiers
-+PATCH,*FMCDF.
-+DECK,BLANKDEK.
-+USE,FMCDF.
-*CMZ : 18/09/91 16.22.40 by Jamie Shiers
-+PATCH,*FATMEN.
-+DECK,BLANKDEK.
-+USE,FFATMEN.
-+USE,FATCDES.
-+USE,FMKUIP.
-+USE,FMCDF.
-+PATCH,*FMKUIP.
-+DECK,BLANKDEK.
-+USE,FFATMEN.
-+USE,FATCDES.
-+USE,FMKUIP.
-+USE,FMCDF.
-+PATCH,*FATLIB.
-+DECK,BLANKDEK.
-+USE,FFATMEN. Flags for FATMEN
-+USE,FATCDES. CDEs for FATMEN
-+USE,FMINT. FATMEN interface
-+USE,FATUTIL. Utility routines - documented
-+USE,FMUTIL. Utility routines - undocumented
-+USE,FATUOUS. Novice user interface
-+USE,FMTMS. FATMEN<->TMS interface routines
-+USE,FATBODY. FATMEN routines for Zebra interface
-+USE,FATUSER. Dummy user selection routines
-+USE,L3UTIL. L3 utility routines - for backward compatibility
-+USE,FMVAX,IF=VAXVMS. VAX specific routines (for interface to STAGE)
-+PATCH,*FMFIND.
-+DECK,blankdek.
-+USE,FFATMEN.
-+USE,FATCDES.
-+USE,FMFIND.
-+PATCH,*FMGET.
-+DECK,blankdek.
-+USE,FFATMEN.
-+USE,FATCDES.
-+USE,FMGET.
-+PATCH,*CHEOPSIF.
-+DECK,BLANKDEK.
-+USE,FFATMEN. Flags for FATMEN
-+USE,FATCDES. CDEs for FATMEN
-+USE,CHEOPSIF. Special interface for CHEOPS
-+PATCH,*CHEOPS2F.
-+DECK,CHEOPS2F.
-+USE,P=CHEOPS2F.
-+USE,P=FFATMEN.
-+USE,P=FATCDES.
-*CMZ : 23/04/92 10.45.49 by Jamie Shiers
-+PATCH,*SQL.
-+DECK,BLANKDEK.
-+USE,SQLCOM.
-+USE,FMZTOR.
-+USE,FFATMEN.
-+PATCH,*FODEL. PILOT PATCH FOR FODEL
-+DECK,BLANKDEK.
-+USE, SQLCOM, FODEL.
-+PATCH,*FOGET. PILOT PATCH FOR FOGET
-+DECK,BLANKDEK.
-+USE, SQLCOM, FOGET.
-+PATCH,*FOPUT. PILOT PATCH FOR FOPUT
-+DECK,BLANKDEK.
-+USE, SQLCOM, FOPUT.
-+PATCH,*FATSCAN2.
-+DECK,BLANKDEK.
-*CMZ : 1.66/06 27/11/91 09.28.33 by Jamie Shiers
-+USE,P=FFATMEN.
-+USE,P=FATCDES.
-+USE,P=EXAMPLE,D=FATSCAN2.
-+PATCH,*FATCHK.
-+DECK,blankdek.
-+USE,FFATMEN.
-+USE,FATCDES.
-+USE,FATCHK.
-+PATCH,*FATBACK.
-+DECK,blankdek.
-+USE,FFATMEN.
-+USE,FATCDES.
-+USE,FATBACK.
-+PATCH,*FATOUCH.
-+DECK,BLANKDEK.
-+USE,FATCDES,FFATMEN.
-+USE,P=EXAMPLE,D=FATOUCH.
-+PATCH,*FATPARA.
-+DECK,BLANKDEK.
-*CMZ : 1.66/06 06/01/92 09.25.51 by Jamie Shiers
-*CMZ : 06/01/92 09.25.51 by Jamie Shiers
-+USE,FATCDES.
-+USE,FATPARA.
-+PATCH,*FATSREQ.
-+DECK,blankdek.
-+USE,FFATMEN.
-+USE,FATCDES.
-+USE,FATSREQ.
-+PATCH,*STGSERV.
-+DECK,STGSERV.
-+USE,STGSERV,IF=VAXVMS.
-+PATCH,FFATMEN.
-+DECK,BLANKDEK.
-+USE, IBM, IF=IBMMVS,IBMVM.
-+USE, UNIX, IF=ALLIANT,APOLLO,CONVEX,CRAY,IBMAIX,UNISYS.
-+USE, UNIX, IF=DECS,GOULD,HPUX,IBMRT,MACMPW,MIPS,SGI,SUN.
-+USE, UNIX, IF=NEXT,QMVAOS.
-+USE, APOL3, IF=APOLLO.
-+USE, FMC, IF=UNIX,IF=*FATLIB.
-+USE, FMH, IF=UNIX,IF=*FATLIB.
-+USE, FATASM, IF=IBMMVS,IF=*FATLIB.
-+USE, VAX, IF=VAXVMS,VAXULX.
-+USE, DOUBLE, IF=IBM, VAX, NORD.
-+USE, DOUBLE, IF=UNIX, IF=-SINGLE.
-+USE, QMIBMXA,IF=IBM.
-+USE, VMCENTER,IF=FERMI,IF=IBMVM.
-+USE, VMBATCH, VMTAPE,IF=VMCENTER.
-+USE, HEPVM, IF=IBMVM,IF=-VMTAPE,IF=-VMBATCH.
-+USE, VAXTAP, IF=VAXVMS.
-+USE, QXCAPT, IF=CRAY.
-+USE, QX_SC, IF=SUN, SGI, DECS, CONVEX, IBMRT, HPUX, AIX370, APOF77.
-+USE, QX_SC, IF=NEXT,QMVAOS.
-+USE, QXNO_SC, IF=APOLLO,IF=-APOF77.
-+USE, BSD, IF=APOLLO, SGI, SUN.
-+USE, SYS5, IF=IBMRT, DECS, HPUX.
-+USE, DCL, IF=VAXVMS,IF=*FATLIB.
-+USE, SCRIPT, IF=UNIX,IF=*FATLIB.
-+USE, REXX, IF=IBMVM,IF=*FATLIB.
-+PATCH,FATHEAD,IF=$DOC.
-+PATCH,FATCDES.
-+DECK,FATCDES.
-+KEEP,FATSTAT.
-*
-* Count number of server operations:
-* Number of different users, nodes, files, commands,
-* PUTs, MODs, DELs, MKDIRs, RMDIRs, OPENs and CLOSEs.
-* NFMUSR and NMFNOD not currently counted
-* Problems:
-* Number of warnings from RZDELK
-* Number of PUTs for existing entries
-* Number of REPs for non-existing entries
-* Number of DELs for non-existing entries
-* Number of BAD (unrecognised) commands
-* Number of logging records
-*
- COMMON/FATSTAT/NFMUSR,NFMNOD,NFMFIL,NFMCOM,NFMPUT,
- + NFMMOD,NFMDEL,NFMMDR,NFMRMD,NFMOPN,
- + NFMCLS,NFMPDK,NFMPRP,NFMPDL,NFMBAD,
- + NFMLOG
-+KEEP,FAUSTO.
- PARAMETER (KOHOLL=0)
- PARAMETER (KLHOLL=70)
-
- PARAMETER (KOREAL=KOHOLL+KLHOLL)
- PARAMETER (KLREAL=20)
-
- PARAMETER (KODATE=KOREAL+KLREAL)
- PARAMETER (KLDATE=10)
-
- PARAMETER (KOCMOD=KODATE+KLDATE)
- PARAMETER (KLCMOD=20)
-
- PARAMETER (KOFILE=KOCMOD+KLCMOD)
- PARAMETER (KLFILE=10)
-
- PARAMETER (KOTMS =KOFILE+KLFILE)
- PARAMETER (KLTMS =20)
-
- PARAMETER (KOCFAT=KOTMS +KLTMS )
- PARAMETER (KLCFAT=20)
-
- PARAMETER (KLINT = KLDATE+KLCMOD+KLFILE+KLTMS+KLCFAT)
-*
-* Hollerith block
-*
- PARAMETER (KFMSYS=KOHOLL+2)
- PARAMETER (KFMGRP=KOHOLL+7)
- PARAMETER (KFMTIT=KOHOLL+12)
- PARAMETER (KFMUSR=KOHOLL+31)
- PARAMETER (KFMHST=KOHOLL+41)
- PARAMETER (KFMTYP=KOHOLL+51)
- PARAMETER (KFMOS =KOHOLL+61)
-*
-* MB counts
-*
- PARAMETER (KFMMBR=KOREAL+1)
- PARAMETER (KFMMBW=KOREAL+2)
- PARAMETER (KFZMBR=KOREAL+3)
- PARAMETER (KFZMBW=KOREAL+4)
- PARAMETER (KFMMBC=KOREAL+5)
- PARAMETER (KFMMBN=KOREAL+6)
- PARAMETER (KFMMBQ=KOREAL+7)
-*
-* Dates and times
-*
- PARAMETER (KFMIDQ=KODATE+1)
- PARAMETER (KFMIDS=KODATE+2)
- PARAMETER (KFMIDE=KODATE+3)
-*
-* Catalogue modifications
-*
- PARAMETER (KFMADD=KOCMOD+1)
- PARAMETER (KFMADL=KOCMOD+2)
- PARAMETER (KFMADT=KOCMOD+3)
- PARAMETER (KFMMDR=KOCMOD+4)
- PARAMETER (KFMRDR=KOCMOD+5)
- PARAMETER (KFMRLN=KOCMOD+6)
- PARAMETER (KFMRTR=KOCMOD+7)
- PARAMETER (KFMRMF=KOCMOD+8)
- PARAMETER (KFMCPF=KOCMOD+9)
- PARAMETER (KFMMVF=KOCMOD+10)
- PARAMETER (KFMMOD=KOCMOD+11)
- PARAMETER (KFMTCH=KOCMOD+12)
-*
-* File accesses (OPENs, CLOSEs, COPYs)
-*
- PARAMETER (KFMOPN=KOFILE+1)
- PARAMETER (KFMCLS=KOFILE+2)
- PARAMETER (KFMCPY=KOFILE+3)
- PARAMETER (KFMCPQ=KOFILE+5)
- PARAMETER (KFMCPN=KOFILE+5)
-*
-* SYSREQ and TMS operations
-*
- PARAMETER (KFMSRQ=KOTMS+1)
- PARAMETER (KFMQVL=KOTMS+2)
- PARAMETER (KFMAVL=KOTMS+3)
- PARAMETER (KFMASP=KOTMS+4)
- PARAMETER (KFMPOL=KOTMS+5)
- PARAMETER (KFMLCK=KOTMS+6)
- PARAMETER (KFMULK=KOTMS+7)
- PARAMETER (KFMDTG=KOTMS+8)
- PARAMETER (KFMGTG=KOTMS+9)
- PARAMETER (KFMSTG=KOTMS+10)
-*
-* Catalogue processing
-*
- PARAMETER (KFMBNK=KOCFAT+1)
- PARAMETER (KFMGET=KOCFAT+2)
- PARAMETER (KFMGTK=KOCFAT+3)
- PARAMETER (KFMSHW=KOCFAT+4)
- PARAMETER (KFMSCN=KOCFAT+5)
- PARAMETER (KFMLOP=KOCFAT+6)
- PARAMETER (KFMLDR=KOCFAT+7)
- PARAMETER (KFMLFL=KOCFAT+8)
- PARAMETER (KFMSRT=KOCFAT+9)
- PARAMETER (KFMRNK=KOCFAT+10)
- PARAMETER (KFMSLK=KOCFAT+11)
- PARAMETER (KFMMTC=KOCFAT+12)
-
-+KEEP,FAUST.
-*
-* FATMEN USer STatistics
-*
-* Adds, MKDIRS, RMDIRS etc.
-*
- INTEGER NFADDD,NFADDL,NFADDT,NFMDIR,NFRDIR,NFRLNK,NFRTRE,
- + NFRMFL,NFCPFL,NFMVFL,NFMODI,NFTOUC
-*
-* OPENs, CLOSEs, COPYs etc.
-*
- INTEGER NFOPEN,NFCLOS,NFCOPY,NFCOPR,NFCOPQ
-*
-* TMS operations
-*
- INTEGER NFSREQ,NFQVOL,NFAVOL,NFASPC,NFPOOL,NFLOCK,NFULOK,
- + NFDTAG,NFGTAG,NFSTAG
-*
-* Catalogue operations
-*
- INTEGER NFBANK,NFGET, NFGETK,NFSHOW,NFSCAN,NFLOOP,NFLDIR,
- + NFLFIL,NFSORT,NFRANK,NFSELK,NFMTCH
-*
-* # MB read/written
-*
- REAL FATMBR,FATMBW,FATMZR,FATMZW,FATMBC,FATMBQ,FATMBN
-*
-* Stuff
-*
- INTEGER NFSTAD,NFSTAT
-
- COMMON/FAUST/NFADDD,NFADDL,NFADDT,NFMDIR,NFRDIR,NFRLNK,NFRTRE,
- + NFRMFL,NFCPFL,NFMVFL,NFMODI,NFTOUC,
- + NFOPEN,NFCLOS,NFCOPY,NFCOPR,NFCOPQ,
- + NFSREQ,NFQVOL,NFAVOL,NFASPC,NFPOOL,NFLOCK,NFULOK,
- + NFDTAG,NFGTAG,NFSTAG,
- + NFBANK,NFGET, NFGETK,NFSHOW,NFSCAN,NFLOOP,NFLDIR,
- + NFLFIL,NFSORT,NFRANK,NFSELK,NFMTCH,
- + NFSTAD,NFSTAT,
- + FATMBR,FATMBW,FATMZR,FATMZW,FATMBC,FATMBQ,FATMBN
-+KEEP,FACARD.
- COMMON/FACARD/IWIDTH,CARD
- CHARACTER*132 CARD
-+KEEP,FATMON.
-*
-* Fatmen monitoring information
-* IHOWFA: how was file accessed?
-* ITIMFA: elapsed time in FMOPEN (in seconds)
-* CHFNFA: fully qualified file name, except VM
-*
- CHARACTER*255 CHFNFA
- COMMON/FATMON/IHOWFA,ITIMFA,CHFNFA
-* Local disk (standard file system)
- PARAMETER (JLOCFA=1)
-* VM shared file system
- PARAMETER (JSFSFA=2)
-* MSCP (VAXcluster)
- PARAMETER (JMSCFA=3)
-* Andrew file system
- PARAMETER (JAFSFA=4)
-* OSF distributed file system
- PARAMETER (JOSFFA=5)
-* DEC DFS
- PARAMETER (JDFSFA=6)
-* Sun NFS
- PARAMETER (JNFSFA=7)
-* DECnet
- PARAMETER (JDECFA=8)
-* CSPACK server
- PARAMETER (JCSPFA=9)
-* FPACK server
- PARAMETER (JFPKFA=10)
-* RFIO
- PARAMETER (JRFIFA=11)
-* Lachman OSM
- PARAMETER (JOSMFA=12)
-* Unitree
- PARAMETER (JUNIFA=13)
-* Adstar ADSM
- PARAMETER (JDSMFA=14)
-* E-MASS
- PARAMETER (JEMSFA=15)
-* Stage required
- PARAMETER (JSTGFA=31)
-* TPMNT (=not staged)
- PARAMETER (JTPMFA=32)
-+KEEP,FATDUMMY.
- IF(IDEBFA.GE.2) PRINT *,CHROUT,'dummy user exit called'
-+KEEP,FATSHIFT.
-*
-* Shift configuration file
-*
- COMMON/FMSHIFT/LSHCONF,LTPCONF,SHCONF,TPCONF
- CHARACTER*255 SHCONF,TPCONF
-+KEEP,FATAPOL3.
- COMMON/FMAPOL3/IAPOL3
-+KEEP,FATCLIO.
- COMMON/FMCLIO/ICLIO
-+KEEP,FATMSS.
- COMMON/FATMSS/IFMMSS
-+KEEP,FATGET.
- COMMON/FATGET/ISFGET
-+KEEP,FATVAXRC.
-* sequence FATVAXRC
- IF(.NOT.ISTAT) THEN
- CALL LIB$SIGNAL(%VAL(ISTAT))
- IRC = 42
- ENDIF
-+KEEP,FMQUED.
- COMMON/FMQUED/LQUED,CHQUED
- CHARACTER*255 CHQUED
-+KEEP,FATSTRUCT,IF=F90.
-*
-* Draft F90 derived data type for mapping to FATMEN bank
-*
- TYPE FATBANK
-*
-* Generic file description
-*
- CHARACTER*256 FILE_NAME
- CHARACTER*8 HOST_NAME
- INTEGER COPY_LEVEL
- INTEGER MEDIA_TYPE
- INTEGER LOCATION_CODE
-*
-* Disk description
-*
- CHARACTER*16 HOST_TYPE
- CHARACTER*12 HOST_SYSTEM
-*
-* Tape description
-*
- CHARACTER*8 VSN
- CHARACTER*8 VID
- INTEGER VID_PREFIX
- INTEGER DENSITY
- INTEGER VOLUME_SEQUENCE_NUMBER
- INTEGER FILE_SEQUENCE_NUMBER
-*
-* File description
-*
- INTEGER START_RECORD
- INTEGER END_RECORD
- INTEGER START_BLOCK
- INTEGER END_BLOCK
-*
-* Physical description
-*
- CHARACTER*4 RECORD_FORMAT
- INTEGER RECORD_LENGTH
- INTEGER BLOCK_LENGTH
- INTEGER FILE_SIZE
- INTEGER USE_COUNT
-*
-* Logical description
-*
- CHARACTER*4 LOGICAL_FORMAT
- CHARACTER*4 USER_FORMAT
-*
-* Dates and times
-*
- INTEGER DATE_CREATED
- INTEGER DATE_CATALOGUED
- INTEGER DATE_ACCESSED
-*
-* Creation information
-*
- CHARACTER*8 CREATED_BY_OWNER
- CHARACTER*8 CREATED_BY_ACCOUNT
- CHARACTER*8 CREATED_ON_NODE
- CHARACTER*8 CREATED_BY_JOB
-*
-* File protection
-*
- INTEGER FILE_PROTECTION_MASK
-*
-* User words
-*
- INTEGER USER_WORDS(10)
-*
-* System words
-*
- INTEGER SYSTEM_WORDS(10)
- END TYPE FATBANK
-+SELF.
-
-+KEEP,CHEOPS.
-*
-* CHEOPS error messages
-*
- PARAMETER (NKEOPS=5)
- CHARACTER*80 MKEOPS(NKEOPS)
- DATA MKEOPS(1)/'Inquire on dataset failed'/,
- + MKEOPS(2)/'Dataset not regular'/,
- + MKEOPS(3)/'Cannot open dataset'/,
- + MKEOPS(4)/'Cannot close dataset'/,
- + MKEOPS(5)/'Transaction expired'/
-*define CC_OK 0
-*define CC_STATONDATASETFAILS 1
-*define CC_DATASETNOTREGULAR 2
-*define CC_CANNOTOPENDATASET 3
-*define CC_CANNOTCLOSEDATASET 4
-*define CC_TRANSACTIONEXPIRED 5
-+KEEP,FMSHFT.
- COMMON/FMSHFT/SHFNAM,SHUNAM,SHPOOL,SHUSER
- CHARACTER*255 SHFNAM,SHUNAM
- CHARACTER*16 SHPOOL,SHUSER
-
-+KEEP,FATLAB0.
- CHARACTER*6 VAXLAB(3)
- CHARACTER*2 IBMLAB(3)
-+KEEP,FATLAB1.
- DATA IBMLAB(1)/'SL'/,IBMLAB(2)/'NL'/IBMLAB(3)/'AL'/
- DATA VAXLAB(1)/'EBCDIC'/,
- + VAXLAB(2)/'NONE '/,
- + VAXLAB(3)/'ASCII '/
-+KEEP,FATLAB.
-+CDE,FATLAB0.
-+CDE,FATLAB1.
-
-+KEEP,FASPAC.
- COMMON/FASPAC/NPRIFA,NSECFA
-+KEEP,FARSTG.
-*
-* Wait time for remote job:
-* IWTNET - time to wait if network is down
-* IWTACK - time for acknowledgement
-* IWTPND - time when entry is pending
-* IWTEXE - time when entry is executing
-*
- COMMON/FARSTG/IWTNET,IWTACK,IWTPND,IWTEXE,MAXNET,MAXACK
-+KEEP,FATRON.
- COMMON/FATRON/LTHR,THRONG
- CHARACTER*8 THRONG
-+KEEP,FSTATE.
- COMMON/FSTATE/MFPHAS
-+KEEP,FATRAN0.
- PARAMETER (NTRANS=3)
- COMMON/FATRAN/ITRANS
- CHARACTER*8 CHTRNS(NTRANS),TRANSP(NTRANS)
-+KEEP,FATRAN1.
- DATA CHTRNS/'T*CPIP','D*ECNET','C*HEOPS'/
- DATA TRANSP/'TCPIP ','DECNET','CHEOPS '/
-+KEEP,FATRAN.
-+CDE,FATRAN0.
-+CDE,FATRAN1.
-+KEEP,CZSOCK.
- COMMON/CZSOCK/LUNCZ,IADTCP,LBUF,ISKIN,ISKOUT,IPROT,
- + JUNIT(99),JSKIN(99),JSKOUT(99),CUNODE,
- + CHNODE(99),CHUSER(99)
- CHARACTER*12 CHNODE,CUNODE,CHUSER
- PARAMETER (LNODE=12)
- PARAMETER (LUSER=12)
- PARAMETER (MAXSOC=99)
-*
-* IPROT: 0 - TCP/IP (TCPAW)
-* 1 - DECnet (included in CZ)
-* CHNODE & CHUSER store the node and user names that correspond
-* to JUNIT
-*
-+KEEP,FATSAT0.
- COMMON/FATSAT/LSRCST,LDSTST,CHSRCE,CHDEST
- CHARACTER*40 CHSRCE,CHDEST
-*
-* CHEOPS sites
-*
- PARAMETER (NSITES=5)
- CHARACTER*8 CHSITE(NSITES)
-+KEEP,FATSAT1.
- DATA CHSITE(1)/'CERN '/,
- + CHSITE(2)/'HELSINKI'/,
- + CHSITE(3)/'LISBON '/,
- + CHSITE(4)/'SARDINIA'/,
- + CHSITE(5)/'ATHENS '/
-+KEEP,FATSAT.
-+CDE,FATSAT0.
-+CDE,FATSAT1.
-
-*
-+KEEP,ERRNO.
-*
-* Extract from /usr/include/sys/errno.h
-* or sys$library:errno.h
-*
-*define ECONNRESET 54 /* Connection reset by peer */
-*define ETIMEDOUT 60 /* Connection timed out */
-*define ECONNREFUSED 61 /* Connection refused */
- IFATRC(1)=54
- IFATRC(2)=60
- IFATRC(3)=61
- IFATRC(4)=3
- IRETRY(1)=60
- IRETRY(2)=5
- IRETRY(3)=5
- IRETRY(4)=60
-+KEEP,ERRSGI.
-*define ECONNRESET 120 /* Connection reset by peer */
-*define ETIMEDOUT 126 /* Connection timed out */
-*define ECONNREFUSED 127 /* Connection refused */
- IFATRC(1)=120
- IFATRC(2)=126
- IFATRC(3)=127
- IFATRC(4)=3
- IRETRY(1)=60
- IRETRY(2)=5
- IRETRY(3)=5
- IRETRY(4)=60
-+KEEP,ERRCRAY.
-*define ECONNRESET 145 /* Connection reset by peer */
-*define ETIMEDOUT 151 /* Connection timed out */
-*define ECONNREFUSED 152 /* Connection refused */
- IFATRC(1)=145
- IFATRC(2)=151
- IFATRC(3)=152
- IFATRC(4)=3
- IRETRY(1)=60
- IRETRY(2)=5
- IRETRY(3)=5
- IRETRY(4)=60
-+KEEP,FATINIT.
- IF(SERNAM(1:4).EQ.'INIT') THEN
- PRINT *,'Error - FATMEN has not been initialised'
- RETURN
- ENDIF
-+KEEP,FATDCB.
- COMMON/FATDCB/TYPE,HDSN,DISP,VOL,LABEL,IDCB,
- + UNIT,ISPACE,IUSED
- INTEGER TYPE,HDSN(14),DISP(3),VOL(2),LABEL(3),IDCB(4),
- + UNIT(2),ISPACE(4),IUSED(5)
- COMMON/FATSPA/CHSPAC
- CHARACTER*4 CHSPAC
-+KEEP,FATNET.
- PARAMETER (NERRS=4)
- DIMENSION IFATRC(NERRS),IRETRY(NERRS)
-+KEEP,SLATE.
- COMMON/SLATE/IS(40)
- INTEGER IS
-+KEEP,SLATEX.
- COMMON/SLATEX_/IS(40)
- INTEGER IS
-+KEEP,FAT.
- PARAMETER (LURCOR=200000)
- COMMON/FAT/IXSTOR,IXDIV,IFENCE(2),LEV,LEVIN,BLVECT(LURCOR)
- DIMENSION LQ(999),IQ(999),Q(999)
- EQUIVALENCE (IQ(1),Q(1),LQ(9)),(LQ(1),LEV)
-+KEEP,FATLNK.
-*
- COMMON/FATLNK/LOPNBK,LCLSBK,LCP1BK,LCP2BK
-+KEEP,FATUSR.
-*
- COMMON /USRLNK/LUSRK1,LUSRBK,LADDBK,LUSRLS
-+KEEP,FMAXCOP.
-*
-* The following statement limits the maximum number of copies
-* of a file that can exist, i.e. the maximum number of entries
-* with the same generic name
-*
- PARAMETER (MAXCOP=100)
-+KEEP,FMNKEYS.
- PARAMETER (LKEYFA=10)
-+KEEP,FATOUT.
- COMMON/FATOUT/OUTPUT,LPIPE
- CHARACTER*80 OUTPUT
-+KEEP,FARNGE.
-* NFRNGE - range count (e.g. [8:10] = 3)
-* IFRNGE - 8,9,10 (in previous example)
- COMMON/FARNGE/NFRNGE(20),IFRNGE(100,20),
- + IFELEM(100,20),IFVAL(100,20)
-+KEEP,FAEXCM. For FMEXTR
- COMMON/FAEXCM/NFILES,NBAD
-+CDE,FATOPTD.
-+KEEP,FAMUCM. For FMMODU
- COMMON/FAMUCM/IOPT,IWORDS(10),CHUCOM,CHUFRM,CHFILE
- CHARACTER*80 CHUCOM
- CHARACTER*4 CHUFRM
- CHARACTER*20 CHFILE
-+CDE,FATOPTD.
-+KEEP,FAHUCM. For FMHUNT
-+CDE,FMNKEYS.
- COMMON/FAHUCM/KEYH(LKEYFA),CHFILE
- CHARACTER*255 CHFILE
-+KEEP,FALNCM. For FMRMLN/FALN
- COMMON/FALNCM/LWRITE,NLINKS,NFILES,IOPTTD,IOPTTF,IOPTTP,IOPTTR
-+KEEP,FASECM. For FMSEAC
- COMMON/FASECM/LWRITE,NFILES,NDIRS,NMATCH,IOPT,
- + LDSN,LHOST,LVID,LUSER,LFORM,LCOMM,LSTR,
- + DSN,HOST,VID,USER,CHFILE,UFORM,COMM,CHSTR
- CHARACTER*255 CHFILE,CHSTR
- CHARACTER*255 HOST,VID,USER
- CHARACTER*255 DSN,UFORM,COMM
-+CDE,FATOPTD.
-+KEEP,FALSCM. For FMLS(C)
- COMMON/FALSCM/LWRITE,NFILES,NFILT,NDIRT,IOPT,CHFILE
- CHARACTER*20 CHFILE
-+CDE,FATOPTD.
-+KEEP,FAFCCM. For FMFC
- COMMON/FAFCCM/LWRITE,IOPTD,IOPTF,IOPTL,IOPTZ,
- + NFOUND,NMATCH,NDIRT,CHFILE
- CHARACTER*20 CHFILE
-+KEEP,FATSEA.
- COMMON/FATSEA/IDCREA,ITCREA,JDCREA,JTCREA,
- + IDCATA,ITCATA,JDCATA,JTCATA,
- + IDLAST,ITLAST,JDLAST,JTLAST,
- + IUSER(2,10)
-+KEEP,FATUWD.
- COMMON/FATUWD/IFUSER(2,10)
-+KEEP,FATKEY.
- COMMON/FATKEY/NUMKEY,MFMKEY(KMXKEY),CHKEY
- CHARACTER*8 CHKEY
-+KEEP,FATLCC.
-*
-* Location code definitions (from FATMEN.LOCCODES)
-*
- PARAMETER (MXLCFA=99)
- CHARACTER*255 CHLOCF
- COMMON/FATLCC/NKLCFA,NLCCFA(MXLCFA),CHLOCF(MXLCFA)
-+KEEP,FATLOC.
- COMMON/FATLOC/NUMLOC,MFMLOC(KMXLOC)
-+KEEP,FATCPL.
- COMMON/FATCPL/NUMCPL,MFMCPL(KMXCPL)
-+KEEP,FATMTP.
- COMMON/FATMTP/NUMMTP,MFMMTP(KMXMTP)
-+KEEP,FATLUN.
- COMMON/FATLUN/NUMLUN,MFMLUN(KMXLUN),MFMLUA(KMXLUN)
-+KEEP,FATSEL.
-*
-* Common to store ranges for KEYS (for FATMEN selection)
-*
- COMMON/FATSEL/MRMTFA(2),MRCLFA(2),MRLCFA(2)
-+KEEP,FATINFO.
-*
-* Common to store FATMEN information per LUN
-* Access method (disk, stage, setup) and filemode (CMS only)
-* Virtual address for tape drive
-* This information is set by FMOPEN/FIND/MAKE and subsequently
-* used by FMCLOS.
-*
-* IFMODE: 0: FZin, 1: FZout, 2: RZ
-* JFMODE: ICFOP from FMOPEN (Fortran, C, package I/O)
-* LFMODE: 1=disk, 2=stage, 3=tape
-*
- COMMON/FATINF/IVADDR(99),IDEV(99), IFMODE(99),
- + JFMODE(99),LFMODE(99),IFPNTR(99),CHMODE(99)
- CHARACTER*1 CHMODE
-+KEEP,FATOSET.
- DO 9999 I=1,36
-9999 IOPT(I) = 1
-+KEEP,FATOPT0.
- DIMENSION IOPT(36)
- EQUIVALENCE (IOPT(1),IOPTA),(IOPT(2),IOPTB),(IOPT(3),IOPTC),
- + (IOPT(4),IOPTD),(IOPT(5),IOPTE),(IOPT(6),IOPTF),
- + (IOPT(7),IOPTG),(IOPT(8),IOPTH),(IOPT(9),IOPTI),
- + (IOPT(10),IOPTJ),(IOPT(11),IOPTK),(IOPT(12),IOPTL),
- + (IOPT(13),IOPTM),(IOPT(14),IOPTN),(IOPT(15),IOPTO),
- + (IOPT(16),IOPTP),(IOPT(17),IOPTQ),(IOPT(18),IOPTR),
- + (IOPT(19),IOPTS),(IOPT(20),IOPTT),(IOPT(21),IOPTU),
- + (IOPT(22),IOPTV),(IOPT(23),IOPTW),(IOPT(24),IOPTX),
- + (IOPT(25),IOPTY),(IOPT(26),IOPTZ),(IOPT(27),IOPT1),
- + (IOPT(28),IOPT2),(IOPT(29),IOPT3),(IOPT(30),IOPT4),
- + (IOPT(31),IOPT5),(IOPT(32),IOPT6),(IOPT(33),IOPT7),
- + (IOPT(31),IOPT5),(IOPT(32),IOPT6),(IOPT(33),IOPT7),
- + (IOPT(34),IOPT8),(IOPT(35),IOPT9),(IOPT(36),IOPT0)
- CHARACTER*36 ALFNUM
-+KEEP,FATOPT1.
- DATA ALFNUM/'ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890'/
-
-+KEEP,FATOPTD.
-+CDE,FATOPT0.
-+CDE,FATOPT1.
-
-+KEEP,FATOPTS.
- CHARACTER*(*) CHOPT
-+CDE,FATOPTD.
- CALL FMOPTC(CHOPT,ALFNUM,IOPT)
-* CALL UOPTC(CHOPT,ALFNUM,IOPT)
-+KEEP,FATOPTC.
- CALL FMOPTC(CHOPT,ALFNUM,IOPT)
-+KEEP,TMSREP.
- PARAMETER (LENREP=20)
- CHARACTER*132 TMSREP(LENREP)
-+KEEP,TMSDEF0.
- CHARACTER*6 DENS
- CHARACTER*8 LIB
- CHARACTER*4 LABTYP
- CHARACTER*1 MNTTYP
- CHARACTER*8 MODEL
- CHARACTER*7 ROBMAN(2)
-+KEEP,TMSDEF1.
- DATA ROBMAN(1)/'-Robot '/,ROBMAN(2)/'-Manual'/
-+KEEP,TMSDEF.
-+CDE,TMSDEF0.
-+CDE,TMSDEF1.
-
-+KEEP,FATVID0.
-*
-* Sequence FATVIDP - table of VID prefices
-*
- CHARACTER*8 PREVID(6)
- INTEGER NTMS
- PARAMETER (NTMS=6)
-+KEEP,FATVID1.
- DATA PREVID(1) /'CERN '/,PREVID(2) /'IN2P3 '/,
- + PREVID(3) /'SACLAY '/,PREVID(4) /'DESY '/,
- + PREVID(5) /'RAL '/,PREVID(6) /'SEFT '/
-
-+KEEP,FATVIDP.
-+CDE,FATVID0.
-+CDE,FATVID1.
-
-+KEEP,FATFORM0.
-*
-* Sequence FATFORM. File format (MFLFFA) and record format (MRFMFA)
-* definitions
-*
- PARAMETER (NFATFM=21)
- CHARACTER*4 FATFRM(NFATFM)
-
- PARAMETER (NRECFM=8)
- CHARACTER*4 FRCFM(NRECFM)
-
- INTEGER FMXBLK,FMXREC
-
-> *
-> * New tapes support block lengths 8 times ANSI standard
-> *
- PARAMETER (FMXBLK=65536)
- PARAMETER (FMXBLK=65536)
-* PARAMETER (FMXREC=8192)
-* PARAMETER (FMXREC=8192)
-+KEEP,FATFORM1.
- DATA FATFRM(1)/'FZ '/,
- + FATFRM(2)/'FA ' /,
- + FATFRM(3)/'FX ' /,
- + FATFRM(4)/'FFX ' /,
- + FATFRM(5)/'RZ ' /,
- + FATFRM(6)/'RX ' /,
- + FATFRM(7)/'EP ' /,
- + FATFRM(8)/'AS ' /,
- + FATFRM(9)/'UN ' /,
- + FATFRM(10)/'DA ' /,
- + FATFRM(11)/'FXN ' /,
- + FATFRM(12)/'FPT ' /,
- + FATFRM(13)/'FPS ' /,
- + FATFRM(14)/'FPD ' /,
- + FATFRM(15)/'FPK ' /,
- + FATFRM(16)/'FPO ' /,
- + FATFRM(17)/'YBB ' /,
- + FATFRM(18)/'YBD ' /,
- + FATFRM(19)/'RWN ' /,
- + FATFRM(20)/'CWN ' /,
- + FATFRM(21)/'EBCD' /
-
- DATA FRCFM(1)/'F '/,
- + FRCFM(2)/'FB '/,
- + FRCFM(3)/'V '/,
- + FRCFM(4)/'VB '/,
- + FRCFM(5)/'VBS '/,
- + FRCFM(6)/'VS '/,
- + FRCFM(7)/'U '/,
- + FRCFM(8)/'RMS '/
-
-+KEEP,FATFORM.
-+CDE,FATFORM0.
-+CDE,FATFORM1.
-
-+KEEP,FATSTG.
-*
-* Sequence FATSTG. Media size and density definitions
-* plus stage path name (first for L3)
-*
- COMMON/FATSTG/ISIZSG,STGPTH
- CHARACTER*255 STGPTH
-
-+KEEP,FATTYP. Media type definitions
- PARAMETER (NMTYP=100)
- COMMON/FATTYP/NFMTYP,CHMTYP,CHMGEN,CHMSIZ,
- + CHMDEN,CHMMNT,CHMLAB,MEDSIZ,
- + MEDDEN,MEDHWM,MEDMFL,MEDMFS
- INTEGER NFMTYP
- INTEGER MEDSIZ(NMTYP),MEDDEN(NMTYP),
- + MEDHWM(NMTYP),MEDMFL(NMTYP),
- + MEDMFS(NMTYP)
- CHARACTER*8 CHMTYP(NMTYP),CHMGEN(NMTYP),
- + CHMSIZ(NMTYP),CHMDEN(NMTYP),
- + CHMMNT(NMTYP),CHMLAB(NMTYP)
-
-+KEEP,FATMED0. Default media attributes
- PARAMETER (NMEDIA=14)
-*
-* FATMEN media type
-*
- DIMENSION MFMMED(NMEDIA)
-*
-* Generic device type
-*
- CHARACTER*8 MFMGEN(NMEDIA)
-*
-* Physical device type
-*
- CHARACTER*8 MFMTYP(NMEDIA)
-*
-* Default density
-*
- CHARACTER*8 MFMDEN(NMEDIA)
-*
-* Media size in Megabytes
-*
- CHARACTER*8 MFMSIZ(NMEDIA)
-*
-* Default mount type
-*
- CHARACTER*1 MFMMNT(NMEDIA)
-*
-* Default label type
-*
- CHARACTER*2 MFMLAB(NMEDIA)
-
-+KEEP,FATMED1.
-* SYSREQ TMS Q DEVTYPES
-* TMS Model
- DATA MFMTYP(1)/'DISK'/,MFMTYP(2)/'3480'/,
- + MFMTYP(3)/'3420'/,MFMTYP(4)/'8200'/,
- + MFMTYP(5)/'8500'/,MFMTYP(6)/'3490'/,
- + MFMTYP(7)/'DAT60'/,MFMTYP(8)/'DAT90'/,
- + MFMTYP(9)/'3490E'/,MFMTYP(10)/'AMPEX'/,
- + MFMTYP(11)/'REDWOOD'/,MFMTYP(12)/'DLT2'/,
- + MFMTYP(13)/'DAT120'/,MFMTYP(14)/'3590'/
-
-* TMS Sort
- DATA MFMGEN(1)/'DISK'/,MFMGEN(2)/'CT1 '/,
- + MFMGEN(3)/'TAPE'/,MFMGEN(4)/'8MM '/,
- + MFMGEN(5)/'8MM '/,MFMGEN(6)/'CT2 '/,
- + MFMGEN(7)/'DAT '/,MFMGEN(8)/'DAT '/,
- + MFMGEN(9)/'CT2E'/,MFMGEN(10)/'DD2 '/,
- + MFMGEN(11)/'DD3 '/,MFMGEN(12)/'DLT '/,
- + MFMGEN(13)/'DAT '/,MFMGEN(14)/'NTP '/
-
-* TMS density code
- DATA MFMDEN(1)/'N/A '/,MFMDEN(2)/'38K '/,
- + MFMDEN(3)/'6250'/,MFMDEN(4)/'43200'/
- + MFMDEN(5)/'86400'/,MFMDEN(6)/'38KDC'/,
- + MFMDEN(7)/'DDSC'/,MFMDEN(8)/'DDSC'/,
- + MFMDEN(9)/'....'/,MFMDEN(10)/'....'/,
- + MFMDEN(11)/'....'/,MFMDEN(12)/'10GC'/,
- + MFMDEN(13)/'DDSC'/,MFMDEN(14)/'10GC'/
-
-* Maximum capacity
- DATA MFMSIZ(1)/'N/A'/, MFMSIZ(2)/'200'/,
- + MFMSIZ(3)/'200'/, MFMSIZ(4)/'2300'/,
- + MFMSIZ(5)/'5000'/,MFMSIZ(6)/'1000'/,
- + MFMSIZ(7)/'2000'/,MFMSIZ(8)/'5000'/,
- + MFMSIZ(9)/'2000'/,MFMSIZ(10)/'25000'/,
- + MFMSIZ(11)/'40000'/,MFMSIZ(12)/'10000'/,
- + MFMSIZ(13)/'4000'/,MFMSIZ(14)/'10000'/
-
-* Default mount type
- DATA MFMMNT(1)/'M'/, MFMMNT(2)/'M'/,
- + MFMMNT(3)/'M'/, MFMMNT(4)/'M'/,
- + MFMMNT(5)/'M'/, MFMMNT(6)/'M'/,
- + MFMMNT(7)/'M'/, MFMMNT(8)/'M'/,
- + MFMMNT(9)/'M'/, MFMMNT(10)/'M'/,
- + MFMMNT(11)/'M'/, MFMMNT(12)/'M'/,
- + MFMMNT(13)/'M'/, MFMMNT(14)/'M'/
-
-* Default label type
- DATA MFMLAB(1)/' '/, MFMLAB(2)/'SL'/,
- + MFMLAB(3)/'SL'/, MFMLAB(4)/'SL'/,
- + MFMLAB(5)/'SL'/, MFMLAB(6)/'SL'/,
- + MFMLAB(7)/'SL'/, MFMLAB(8)/'SL'/,
- + MFMLAB(9)/'SL'/, MFMLAB(10)/'SL'/,
- + MFMLAB(11)/'SL'/, MFMLAB(12)/'SL'/,
- + MFMLAB(13)/'SL'/, MFMLAB(14)/'SL'/
-*
-* Number of media types defined
-*
- DATA NFTYPS/14/
-*
-* TMS density codes
-*
-* Model Density Code P
-* ------ -------- -------- -
-* 3420 1600 1600 Y
-* 3420 6250 6250 Y
-* 3480 38KC 15 Y
-* 3480 38KD 20 Y
-* 3480 38K 38000 N
-* 3480 38000 38000 Y
-* 3490 38KCD 10 N
-* 3490 38KDC 10 Y
-* 8200 8200 8200 Y
-* 8200 8500 8500 Y
-+KEEP,FATMED.
-+CDE,FATMED0.
-+CDE,FATMED1.
-
-+KEEP,FATSHO.
- COMMON/FATSHO/CWDSHO
- CHARACTER*255 CWDSHO
-+KEEP,FATUPD.
- COMMON/FATUPD/MAXDEF,NGRDEF,NUPDT,MAXUPD,NGROUP,MAXVIO,NVIOL
-+KEEP,FMPATH.
- CHARACTER*255 PATH,FILE1,FILE2,CDIR
- COMMON/FMKCOM/LCDIR,CDIR
-*
-+KEEP,FATSYS.
-*
-* Common to store name of service machine (IBM)
-* or default directory (VAX, Unix)
-*
- COMMON/FATSYS/STRMLF,IFMODX,SERNAM,SERMOD,FATNOD,DEFAULT,
- + FATTOP,TOPDIR,LOCALQ
-* Mode at which server disk is accessed (VM)
- CHARACTER*1 SERMOD
-* Name of service machine
- CHARACTER*20 SERNAM
- CHARACTER*64 FATTOP
- CHARACTER*16 TOPDIR
- CHARACTER*80 FATNOD
- CHARACTER*132 LOCALQ
- CHARACTER*132 DEFAULT
- LOGICAL STRMLF
-+KEEP,FTTBUG.
- INTEGER IDEBFA, IDIVFA, IKDRFA, KOFSFA, KOFUFA, LBFXFA
- + , LSAVFA, LTOPFA, LBBKFA, LBGNFA, LTDSFA, LBDSFA
- + , LPRTFA, NTOPFA, LUFZFA, IOUPFA, IOBKFA, IODSFA
- + , LLNLFA, LLNHFA
-+KEEP,FATUSE.
-+SEQ,FTTBUG,IF=TYPE.
- COMMON /FATUSE/ IDEBFA, IDIVFA, IKDRFA, KOFSFA, KOFUFA, LBFXFA
- + , LSAVFA, LTOPFA, LBBKFA, LBGNFA, LTDSFA, LBDSFA
- + , LPRTFA, NTOPFA, LUFZFA, IOUPFA, IOBKFA, IODSFA
- + , LLNLFA, LLNHFA
-+KEEP,FATBUG.
-+SEQ,FTTBUG,IF=TYPE.
- COMMON /FATUSE/ IDEBFA, IDIVFA, IKDRFA, KOFSFA, KOFUFA, LBFXFA
- + , LSAVFA, LTOPFA, LBBKFA, LBGNFA, LTDSFA, LBDSFA
- + , LPRTFA, NTOPFA, LUFZFA, IOUPFA, IOBKFA, IODSFA
- + , LLNLFA, LLNHFA
-+KEEP,FATBANK.
- COMMON /FABANK/FATFEN(22),LQ(9)
- DIMENSION IQ(2), Q(2)
- EQUIVALENCE (IQ(1),Q(1),LQ(9))
-*
- COMMON /QUEST/ IQUEST(100)
-*
- PARAMETER (IKTYFA=33, KNSDFA=23, KLSDFA=26, MAXLFA=128)
-* top directory fan-out bank "UPFA"
- PARAMETER (MNOPFA=1, MLUNFA=2, MFLGFA=3, MTOTFA=4)
- PARAMETER (MCRDFA=5, MINPFA=6, MOUTFA=7, MTOPFA=8)
- PARAMETER (MNCHFA=9, MCHRFA=10, NDUPFA=MCHRFA+31)
- PARAMETER (NSLUFA=2)
-* Book keeping "BKFA"
- PARAMETER (KLBKFA=1)
- PARAMETER (MSTAFA=1,MPNTFA=2,MCGNFA=3)
- PARAMETER (NWBKFA=3)
-* Generic names bank
- PARAMETER (KLGNFA=2)
-*
- COMMON /FATSTO/ LDIRFA, LBOUT, LJNKFA
- COMMON /FATUSE/ IDEBFA, IDIVFA, IKDRFA, KOFSFA, KOFUFA, LBFXFA
- + , LSAVFA, LTOPFA, LBBKFA, LBGNFA, LTDSFA, LBDSFA
- + , LPRTFA, NTOPFA, LUFZFA, IOUPFA, IOBKFA, IODSFA
- + , LLNLFA, LLNHFA
- COMMON /FATSER/ LNEWFA, LOLDFA, LCOMP1, LCOMP2, LBANKR
- COMMON /FATBNK/ LBKLUN(99)
-*
- PARAMETER (MXDMFA=100)
-* COMMON /FATKYS/ IOTYFA(MXDMFA), KEYVFA(MXDMFA), NKEYFA, NWKYFA
- COMMON /FATKYS/ IOTYFA(MXDMFA), KEYVFA(MXDMFA), NWKYFA
-*
-+KEEP, FATBANK%, IF=$DOC.
-+SEQ, FATBANK.
-
- fan-out bank offsets
-
- MNOPFA Number of open files belonging to such "data base"
- MLUNFA logical unit of the RZ-file
- MFLGFA
- MTOTFA
- MCRDFA
- MINPFA
- MOUTFA
- MTOPFA
- MNCHFA number of character of the top directory name
- MCHRFA top directory name
-
- NDUPFA total number of word in the top directory
-
- NSLUFA Number of "system links in "UPFA" bank
-
-
- Book-keeping bank "BKFA"
- KLBKFA link offset in UPFA
- NWBKFA number of word for each "file"
-
- MSTAFA file status
- MPNTFA pointer in the generic names bank
- MCGNFA number of characters used by the gen.name
-
- Generic names bank "GNFA"
- KLGNFA link offset in UPFA
-
- -5 number of word used
-
-
-+KEEP, FTTPARA.
- INTEGER MKSRFA,MKFNFA,MKCLFA,MKMTFA,MKLCFA,MKNBFA,NKDSFA
- INTEGER MFQNFA,MHSNFA,MCPLFA,MMTPFA,MLOCFA,MHSTFA,MHOSFA,
- + MVSNFA,MVIDFA,MVIPFA,MDENFA,MVSQFA,MFSQFA,MSRDFA,
- + MERDFA,MSBLFA,MEBLFA,MRFMFA,MRLNFA,MBLNFA,MFLFFA,
- + MFUTFA,MCRTFA,MCTTFA,MLATFA,MCURFA,MCIDFA,MCNIFA,
- + MCJIFA,MFPRFA,MSYWFA,MUSWFA,MUCMFA,NWDSFA,MFSZFA,
- + MUSCFA,MDRPFA,MKDRFA
-
- INTEGER NFQNFA,NHSNFA,NHSTFA,NHOSFA,NVSNFA,NVIDFA,NFLFFA,
- + NRFMFA,NFUTFA,NCURFA,NCIDFA,NCNIFA,NCJIFA,NUCMFA
-
- INTEGER MFIEEE,MFEEEI,MFIBM, MFCRAY,MFVAX ,MFUNIX,MFULTR
-
- INTEGER KMXLOC,KMXCPL,KMXMTP,KMXLUN
- INTEGER MFMLOC,MFMCPL,MFMMTP,MFMLUN
- INTEGER KMXKEY
-
- INTEGER NCPLFA
- INTEGER NMTPFA
- INTEGER NLOCFA
- INTEGER NVIPFA
- INTEGER NDENFA
- INTEGER NVSQFA
- INTEGER NFSQFA
- INTEGER NSRDFA
- INTEGER NERDFA
- INTEGER NSBLFA
- INTEGER NEBLFA
- INTEGER NRLNFA
- INTEGER NBLNFA
- INTEGER NCRTFA
- INTEGER NCTTFA
- INTEGER NLATFA
- INTEGER NFPRFA
- INTEGER NFSZFA
- INTEGER NUSCFA
- INTEGER NUSWFA
- INTEGER NSYWFA
-
-+KEEP,FATPARA.
-* Start of FATMEN sequence FATPARA
-+SEQ,FTTPARA.
-*
-** *** Data set bank mnemonics
-*
-* Keys
- PARAMETER ( MKSRFA= 1, MKFNFA= 2, MKCLFA=7, MKMTFA=8
- 1 ,MKLCFA= 9, MKNBFA=10, NKDSFA=10,MKDRFA=2)
-*
-** *** Bank offsets
-*
- PARAMETER ( MFQNFA= 1, MHSNFA= 65, MCPLFA= 67, MDRPFA= 67
- 1 ,MMTPFA= 68, MLOCFA= 69, MHSTFA= 70, MHOSFA= 74
- 2 ,MVSNFA= 77, MVIDFA= 79, MVIPFA= 81, MDENFA= 82
- 3 ,MVSQFA= 83, MFSQFA= 84, MSRDFA= 85, MERDFA= 86
- 4 ,MSBLFA= 87, MEBLFA= 88, MRFMFA= 89, MRLNFA= 90
- 5 ,MBLNFA= 91, MFLFFA= 92, MFUTFA= 93, MCRTFA= 94
- 6 ,MCTTFA= 95, MLATFA= 96, MCURFA= 97, MCIDFA= 99
- 7 ,MCNIFA=101, MCJIFA=103, MFPRFA=105, MSYWFA=106
- 8 ,MUSWFA=116, MUCMFA=126, NWDSFA=145
- 9 ,MFSZFA=MSYWFA,MUSCFA=MSYWFA+1)
-
-*
-** *** Lengths of character fields in bytes
-*
- PARAMETER ( NFQNFA = (MHSNFA-MFQNFA)*4,
- + NHSNFA = (MCPLFA-MHSNFA)*4,
- + NHSTFA = (MHOSFA-MHSTFA)*4,
- + NHOSFA = (MVSNFA-MHOSFA)*4,
- + NVSNFA = (MVIDFA-MVSNFA)*4,
- + NVIDFA = (MVIPFA-MVIDFA)*4,
- + NRFMFA = (MRLNFA-MRFMFA)*4,
- + NFLFFA = (MFUTFA-MFLFFA)*4,
- + NFUTFA = (MCRTFA-MFUTFA)*4,
- + NCURFA = (MCIDFA-MCURFA)*4,
- + NCIDFA = (MCNIFA-MCIDFA)*4,
- + NCNIFA = (MCJIFA-MCNIFA)*4,
- + NCJIFA = (MFPRFA-MCJIFA)*4,
- + NUCMFA = (NWDSFA-MUCMFA)*4)
-*
-** *** Lengths of integer fields in words
-*
- PARAMETER ( NCPLFA = 1 )
- PARAMETER ( NMTPFA = 1 )
- PARAMETER ( NLOCFA = 1 )
- PARAMETER ( NVIPFA = 1 )
- PARAMETER ( NDENFA = 1 )
- PARAMETER ( NVSQFA = 1 )
- PARAMETER ( NFSQFA = 1 )
- PARAMETER ( NSRDFA = 1 )
- PARAMETER ( NERDFA = 1 )
- PARAMETER ( NSBLFA = 1 )
- PARAMETER ( NEBLFA = 1 )
- PARAMETER ( NRLNFA = 1 )
- PARAMETER ( NBLNFA = 1 )
- PARAMETER ( NCRTFA = 1 )
- PARAMETER ( NCTTFA = 1 )
- PARAMETER ( NLATFA = 1 )
- PARAMETER ( NFPRFA = 1 )
- PARAMETER ( NFSZFA = 1 )
- PARAMETER ( NUSCFA = 1 )
- PARAMETER ( NUSWFA = 10 )
- PARAMETER ( NSYWFA = 10 )
-*
-* Definitions of 'Copy Level' (i.e. Data representation)
-* These definitions adhere to those used in FPACK
-*
-* PARAMETER (MFIEEE= 1, MFEEEI= 5, MFIBM =2, MFCRAY= 4,
- PARAMETER (MFIEEE= 1, MFEEEI= 4, MFIBM =2, MFCRAY= 5,
- + MFVAX = 3)
-
-*
-* Maximum # of location codes, copy levels, media types and luns
-*
- PARAMETER (KMXLOC=99, KMXCPL=99, KMXMTP=99, KMXLUN=99)
- PARAMETER (KMXKEY=99)
-
- INTEGER IBTYPE(35)
- INTEGER IBOFFS(35)
- INTEGER IBLENG(35)
- CHARACTER*6 CHBANK(35)
-* End of FATMEN sequence FATPARA
-+KEEP,FMDREP.
- PARAMETER (NWFFAT=5)
- COMMON/FMDREP/CHDREP
- CHARACTER*30 CHDREP(NWFFAT)
-+KEEP,FATCHAR.
-*
-** *** Types (1 = integer, 2 = character, 3 = time)
-*
- IBTYPE( 1)=2
- IBTYPE( 2)=2
- IBTYPE( 3)=1
- IBTYPE( 4)=1
- IBTYPE( 5)=1
- IBTYPE( 6)=2
- IBTYPE( 7)=2
- IBTYPE( 8)=2
- IBTYPE( 9)=2
- IBTYPE(10)=1
- IBTYPE(11)=1
- IBTYPE(12)=1
- IBTYPE(13)=1
- IBTYPE(14)=1
- IBTYPE(15)=1
- IBTYPE(16)=1
- IBTYPE(17)=1
- IBTYPE(18)=2
- IBTYPE(19)=1
- IBTYPE(20)=1
- IBTYPE(21)=2
- IBTYPE(22)=2
- IBTYPE(23)=3
- IBTYPE(24)=3
- IBTYPE(25)=3
- IBTYPE(26)=2
- IBTYPE(27)=2
- IBTYPE(28)=2
- IBTYPE(29)=2
- IBTYPE(30)=1
- IBTYPE(31)=1
- IBTYPE(32)=1
- IBTYPE(33)=2
- IBTYPE(34)=1
- IBTYPE(35)=1
-*
-** *** Offsets
-*
- IBOFFS( 1)=MFQNFA
- IBOFFS( 2)=MHSNFA
- IBOFFS( 3)=MCPLFA
- IBOFFS( 4)=MMTPFA
- IBOFFS( 5)=MLOCFA
- IBOFFS( 6)=MHSTFA
- IBOFFS( 7)=MHOSFA
- IBOFFS( 8)=MVSNFA
- IBOFFS( 9)=MVIDFA
- IBOFFS(10)=MVIPFA
- IBOFFS(11)=MDENFA
- IBOFFS(12)=MVSQFA
- IBOFFS(13)=MFSQFA
- IBOFFS(14)=MSRDFA
- IBOFFS(15)=MERDFA
- IBOFFS(16)=MSBLFA
- IBOFFS(17)=MEBLFA
- IBOFFS(18)=MRFMFA
- IBOFFS(19)=MRLNFA
- IBOFFS(20)=MBLNFA
- IBOFFS(21)=MFLFFA
- IBOFFS(22)=MFUTFA
- IBOFFS(23)=MCRTFA
- IBOFFS(24)=MCTTFA
- IBOFFS(25)=MLATFA
- IBOFFS(26)=MCURFA
- IBOFFS(27)=MCIDFA
- IBOFFS(28)=MCNIFA
- IBOFFS(29)=MCJIFA
- IBOFFS(30)=MFPRFA
- IBOFFS(31)=MSYWFA
- IBOFFS(32)=MUSWFA
- IBOFFS(33)=MUCMFA
- IBOFFS(34)=MFSZFA
- IBOFFS(35)=MUSCFA
-*
-** *** Lengths
-*
- IBLENG( 1)=NFQNFA
- IBLENG( 2)=NHSNFA
- IBLENG( 3)=NCPLFA
- IBLENG( 4)=NMTPFA
- IBLENG( 5)=NLOCFA
- IBLENG( 6)=NHSTFA
- IBLENG( 7)=NHOSFA
- IBLENG( 8)=NVSNFA
- IBLENG( 9)=NVIDFA
- IBLENG(10)=NVIPFA
- IBLENG(11)=NDENFA
- IBLENG(12)=NVSQFA
- IBLENG(13)=NFSQFA
- IBLENG(14)=NSRDFA
- IBLENG(15)=NERDFA
- IBLENG(16)=NSBLFA
- IBLENG(17)=NEBLFA
- IBLENG(18)=NRFMFA
- IBLENG(19)=NRLNFA
- IBLENG(20)=NBLNFA
- IBLENG(21)=NFLFFA
- IBLENG(22)=NFUTFA
- IBLENG(23)=NCRTFA
- IBLENG(24)=NCTTFA
- IBLENG(25)=NLATFA
- IBLENG(26)=NCURFA
- IBLENG(27)=NCIDFA
- IBLENG(28)=NCNIFA
- IBLENG(29)=NCJIFA
- IBLENG(30)=NFPRFA
- IBLENG(31)=NSYWFA
- IBLENG(32)=NUSWFA
- IBLENG(33)=NUCMFA
- IBLENG(34)=NFSZFA
- IBLENG(35)=NUSCFA
-*
-** *** Character names of offsets
-*
- CHBANK( 1)='MFQNFA'
- CHBANK( 2)='MHSNFA'
- CHBANK( 3)='MCPLFA'
- CHBANK( 4)='MMTPFA'
- CHBANK( 5)='MLOCFA'
- CHBANK( 6)='MHSTFA'
- CHBANK( 7)='MHOSFA'
- CHBANK( 8)='MVSNFA'
- CHBANK( 9)='MVIDFA'
- CHBANK(10)='MVIPFA'
- CHBANK(11)='MDENFA'
- CHBANK(12)='MVSQFA'
- CHBANK(13)='MFSQFA'
- CHBANK(14)='MSRDFA'
- CHBANK(15)='MERDFA'
- CHBANK(16)='MSBLFA'
- CHBANK(17)='MEBLFA'
- CHBANK(18)='MRFMFA'
- CHBANK(19)='MRLNFA'
- CHBANK(20)='MBLNFA'
- CHBANK(21)='MFLFFA'
- CHBANK(22)='MFUTFA'
- CHBANK(23)='MCRTFA'
- CHBANK(24)='MCTTFA'
- CHBANK(25)='MLATFA'
- CHBANK(26)='MCURFA'
- CHBANK(27)='MCIDFA'
- CHBANK(28)='MCNIFA'
- CHBANK(29)='MCJIFA'
- CHBANK(30)='MFPRFA'
- CHBANK(31)='MSYWFA'
- CHBANK(32)='MUSWFA'
- CHBANK(33)='MUCMFA'
- CHBANK(34)='MFSZFA'
- CHBANK(35)='MUSCFA'
-+KEEP,FABALQ.
- COMMON/FABALQ/NBLOKS
-+KEEP,FATREG,IF=IBMMVS.
- MACRO
- REGISTER
-R0 EQU 0
-R1 EQU 1
-R2 EQU 2
-R3 EQU 3
-R4 EQU 4
-R5 EQU 5
-R6 EQU 6
-R7 EQU 7
-R8 EQU 8
-R9 EQU 9
-R10 EQU 10
-R11 EQU 11
-R12 EQU 12
-R13 EQU 13
-R14 EQU 14
-R15 EQU 15
- MEND
-+KEEP,FATBEG,IF=IBMMVS.
- MACRO
-&NAME BEG &ID,&MODE=REUS,&WKSIZE=0,&SP=0,&BASE=12,&RMODE=24
- GBLC &RMD
-&RMD SETC '&RMODE'
-&NAME CSECT
- AIF ('&RMODE' EQ '24').NOT311
-&NAME RMODE ANY
-&NAME AMODE ANY
-.NOT311 ENTRY &NAME
- USING *,&BASE
- ANF &ID,MODE=&MODE,WKSIZE=&WKSIZE,SP=&SP,BASE=&BASE
- MEND
-+KEEP,FATANF,IF=IBMMVS.
- MACRO
-&NAME ANF &ID,&MODE=REUS,&WKSIZE=0,&SP=0,&BASE=12
- GBLC &DY0ID,&MD
- LCLA &A,&B,&D
- LCLC &E,&F
-&F SETC '&SYSNDX'
-&MD SETC '&MODE'
-* ANF VERSION 2.4 (SUPPORTS PRNT MACRO AND EQUATED WORKSIZE)
-.* DIE VORIGE VERSION HEISST ANF8
- AIF ((T'&WKSIZE NE 'N') AND (T'&WKSIZE NE 'U')).ERROR4
- AIF (T'&SP NE 'N').ERROR5
- AIF (&SP GT 255).ERROR6
- AIF (T'&BASE NE 'N').ERROR7
- AIF ((&BASE GT 12) OR (&BASE LT 4)).ERROR8
- AIF ('&MODE' NE 'REUS').RENT
- AIF ('&ID' EQ '').NULLID
- AIF ('&ID' EQ '*').SPECID
-&D SETA K'&ID
- AIF (&D GT 8).ERROR1
-&A SETA ((K'&ID+4)/4)*4+80
-&E SETC '&ID'
- CNOP 0,4
-&NAME B &A.(0,15) BRANCH AROUND ID AND SA
- DC AL1(&D) LENGTH OF ID
- DC CL&D'&E'
- AGO .CONTA
-.NULLID ANOP
- CNOP 0,4
-&NAME B 80(0,15) BRANCH AROUND SA
- AGO .CONTA
-.SPECID AIF ('&NAME' EQ '').CSECTN
-&E SETC '&NAME'
-&A SETA 1
-.CONTB AIF ('&E'(1,&A) EQ '&E').CONTC
-&A SETA &A+1
- AGO .CONTB
-.CONTC ANOP
- AIF ('&MODE' EQ 'RENT').CONTE
-&B SETA ((&A+4)/4)*4+80
- CNOP 0,4
-&NAME B &B.(0,15) BRANCH AROUND ID AND SA
- DC AL1(&A) LENGTH OF ID
- DC CL&A'&E'
- AGO .CONTA
-.CSECTN AIF ('&SYSECT' EQ '').ERROR2
-&E SETC '&SYSECT'
-&A SETA 1
- AGO .CONTB
-.ERROR2 MNOTE 12,'CSECT NAME NOT SPECIFIED'
- AGO .NULLID
-.CONTA ANOP
-&DY0ID SETC '&SYSNDX'
-SAVE&F DC 19F'0' SAVE AREA
- STM 14,12,12(13) SAVE CALLER'S REGISTER
- LR &BASE,15 LOAD BASE
- LA 3,SAVE&F ADDRESS OF NEW SAVE AREA
- ST 3,8(13) FORWARD CHAIN
- L 3,32(13) RESTORE REG 3
- ST 13,SAVE&F.+4 BACKWARD CHAIN
- LA 13,SAVE&F LOAD SAVE AREA REG
- MEXIT
-.ERROR1 MNOTE 12,'IDENTIFICATION FIELD TOO LONG'
- MEXIT
-.RENT ANOP
- AIF ('&MODE' NE 'RENT').ERROR3
- AIF ('&ID' EQ '').RNULL
- AIF ('&ID' EQ '*').SPECID
-&D SETA K'&ID
- AIF (&D GT 8).ERROR1
-&A SETA ((&D+2)/2)*2+4
-&E SETC '&ID'
-&NAME B &A.(0,15) BRANCH AROUND ID
- DC AL1(&D) LENGTH OF ID
- DC CL&D'&E'
- STM 14,12,12(13) SAVE CALLER'S REGISTER
- AGO .CONTD
-.RNULL ANOP
-&NAME STM 14,12,12(13) SAVE CALLER'S REGISTER
- AGO .CONTD
-.CONTE ANOP
-&B SETA ((&A+2)/2)*2+4
-&NAME B &B.(0,15) BRANCH AROUND ID
- DC AL1(&A) LENGTH OF ID
- DC CL&A'&E'
- STM 14,12,12(13) SAVE CALLER'S REGISTER
-.CONTD ANOP
- LR &BASE,15 LOAD BASE
- CNOP 0,4 ALIGN ON FULL WORD BOUNDARY
- BAL 1,*+8 BRANCH AROUND SUBPOOL AND LENGTH
- DC AL1(&SP) SUBPOOL ID
- DC AL3(&WKSIZE+88) LENGTH VALUE
- L 0,0(0,1) LOAD SP AND LENGTH
- SVC 10 ISSUE GETMAIN SVC
- XC 0(88,1),0(1) CLEAR CHAIN FIELDS AND SAVE AREA
- MVI 8(1),X'FF' INDICATE LAST ON CHAIN
- MVC 12(4,1),*-20 SAVE LENGTH AN SUBPOOL
- MVC 0(4,1),12(13)
- LA 15,FR&F
- ST 15,12(13)
- ST 13,20(1) BACKWARD CHAIN
- LR 15,13 SAVE OLD SAVE AREA POINTER
- LA 13,16(1) LOAD NEW SA REGISTER
- ST 13,8(15) FORWARD CHAIN
- LM 15,1,16(15) RESTORE ALL REGISTER
- B FO&F
-FR&F ST 15,16(13) SAVE RETURN CODE
- LA 0,16 LENGTH OF PREFIX
- L 1,8(13) SAVE OLD SA POINTER
- SR 1,0 POINT TO PREFIX
- MVC 12(4,13),0(1)
- L 14,8(1) LOAD 1-ST CHAIN POINTER
- L 0,12(1) LOAD 1-ST SUBPOOL AND LENGTH
- BALR 10,0
- B 12(10)
- L 14,0(1) LOAD CHAIN POINTER
- L 0,4(1) LOAD SUBPOOL AND LENGTH
- LA 1,0(1) CLEAR HIGH ORDER BYTE
- SVC 10 ISSUE FREEMAIN SVC
- LA 1,0(14) GET CHAIN POINTER
- C 14,36(10) LAST IN CHAIN
- BNZ 4(10) NO, BRANCH
- LM 14,12,12(13) RESTORE REGISTERS AFTER FREEMAIN
- BR 14
- DC X'FF000000'
-FO&F EQU *
- MEXIT
-.ERROR3 MNOTE 12,'MODE=&MODE INVALID'
- MEXIT
-.ERROR4 MNOTE 12,'WKSIZE=&WKSIZE SHOULD BE SELF-DEFINING TERM OR NAME *
- FIELD OF AN ''EQU'''
- MEXIT
-.ERROR5 MNOTE 12,'SP=&SP SHOULD BE A SELF DEFINING TERM'
- MEXIT
-.ERROR6 MNOTE 12,'SP=&SP GREATER 255 SPECIFIED'
- MEXIT
-.ERROR7 MNOTE 12,'BASE=&BASE SHOULD BE A SELF DEFINING TERM'
- MEXIT
-.ERROR8 MNOTE 12,'BASE CAN BE ONLY 4 TO 12'
- MEND
-+KEEP,FATSCHL,IF=IBMMVS.
- MACRO
-&NAME SCHL &RET=,&MODE=
-&NAME L 13,4(13) RELOAD SA-REG
- AIF ('&RET' NE '').RETCODE
- LM 14,12,12(13) RELOAD REGISTERS
- BR 14 RETURN TO CALLER
- MEXIT
-.RETCODE AIF ('&RET'(1,1) EQ '(').REGIST
- AIF (T'&RET NE 'N').ADDRESS
- LA 15,&RET LOAD REG 15 WITH RET CODE
- AGO .FURTHER
-.REGIST AIF ('&RET(1)' EQ '15').FURTHER
- LR 15,&RET(1) LOAD REG 15 WITH SPECIF. REGISTER
- AGO .FURTHER
-.ADDRESS L 15,&RET LOAD REG 15 FROM STORAGE
-.FURTHER LM 0,12,20(13) RESTORE REG 0 TO 12
- L 14,12(13) RESTORE REG 14
- BR 14 RETURN TO CALLER
- MEND
-+KEEP, FATPARA%, IF=$DOC.
-+SEQ, FATPARA.
-
- K E Y S
-
- MKSRFA Key serial number
- MKFNFA File name
- MKCLFA Copy level
- MKMTFA Medium type
- MKLCFA Location type
- MKNBFA Number of bank in the data set linear chain
-
- NKDSFA Number of keys
-
-
- B A N K
-
-words field type length description
- (in words)
-
- --------- generic description -------------
-
-(* = NOT NULL in ORACLE or SQL/DS tables - filled in by FMLIFT)
-
-1-64 * fully qual. name H 64 in case of instance the generi
- name of the corresponding data
- set
- dataset name has format
- <user.addr>fn.ft on VM,
- where '.addr' may be omitted.
-65-66 * host name H 2 in case of tape the nearest
- host to its physical
- location
- (maybe more words to clearly
- state the location (lab.
- bld. etc) would be needed)
-67 * copy level I 1 0 master 1 duplicate
- 2 duplicate from a duplicate etc
-68 * location code I 1 to find the nearest (FATMEN code
-69 * medium type I 1 3=tape, 2=cartridge,
- 4=exabyte, 1=disk
- ...................
- 0=instance
-
-
-
-
- --------- disk description -------------
-
-70-73 host type H 4 only for disk files
-74-76 operating syst. H 3 "
-
- --------- tape description -------------
-
-77-78 * VSN H 2 only for tapes
-79-80 * VID H 2 "
-81 VID prefix I 1 "
-82 Density I 1 "
-83 vol. seq. numb. I 1 "
-84 * file seq. numb. I 1 "
-
- --------- file description -------------
-
-85 start record # I 1
-86 end record # I 1
-87 start block # I 1
-88 end block # I 1
-
- --------- physical description -------------
-
-89 record format H 1
-90 record length I 1 (in words!)
-91 block length I 1 "
-106 file size I 1 (in Megabytes, rounded up
- = SYSWD0 to next integer)
-
- --------- logical description -------------
-
-92 * file format H 1 FATMEN oriented
- FZ=zebra native
- FA=zebra ascii
- FX=zebra exchange
- RZ=zebra RZ
- EP=EPIO
- AS=normal Ascii
- UN=unknown to FATMEN
- ...............
-93 file user type H 1 user oriented and user defined
-
- --------- dates and times -------------
-
-94 creation date I 1
-95 catalog. date I 1
-96 last acc.date I 1
-
- --------- creator identier -------------
-
-97-98 user name creat. H 2 "creator" user name
-99-100 user id. " H 2 user id. UUUGG/UUU$GG
- or NFSID
-101-102 node id. " H 2 node id.
-103-104 job id. " H 2 job id.
- (user defined)
-
- --------- protections -------------
-
-105 file protect. I 1 (maybe just a pointer in a
- ACL definition bank)
-
- --------- user area -------------
-
-106-115 system words I 10 (reserved)
-116-125 user words I 10 (user defined)
-126-145 comment H 20
-
-+PATCH,PAMEND.
-*
diff --git a/src/car/geanh.car b/src/car/geanh.car
deleted file mode 120000
index 6f2697c..0000000
--- a/src/car/geanh.car
+++ /dev/null
@@ -1 +0,0 @@
-geanh321.car
\ No newline at end of file
diff --git a/src/car/geanh321.car b/src/car/geanh321.car
deleted file mode 100644
index e7d107b..0000000
--- a/src/car/geanh321.car
+++ /dev/null
@@ -1,2005 +0,0 @@
-+TITLE.
-C GEANH 3.21/04 21/03/95 18.10.55 CERN PROGRAM LIBRARY GEANT = W5013
-+PATCH,$VERSION.
-+PATCH,//GEANH/$VERSION.
-+DECK,V3_21.
-*CMZ : 3.21/04 21/03/95 18.10.55 by S.Giani
-*-- Author :
-*
-*::> VERSION 3.21/04 21/03/95 18.10.55
-*
-*
-*::> VERSION 3.21/03 17/10/94 15.27.01
-*
-*
-*::> VERSION 3.21/02 25/07/94 15.21.40
-*
-*
-*::> VERSION 3.21/01 28/03/94 16.10.10
-*
-*
-*::> VERSION 3.21/00 28/02/94 17.06.07
-*
-**********************************************************************
-* *
-* G E A N T 3 . 2 1 *
-* *
-* C E R N *
-* *
-* 15/3/94 Geneva CH *
-* *
-**********************************************************************
-+DECK,V3_16.
-*CMZ : 29/03/94 15.41.37 by S.Giani
-*-- Author :
-*
-*::> VERSION 3.16/00 07/12/93 14.35.06
-*
-+DECK,V3_15.
-*CMZ : 29/03/94 15.41.37 by S.Giani
-*-- Author :
-*
-*::> VERSION 3.15/05 920408 13.06
-*
-*
-* ************************************************************
-* * *
-* * *
-* * G E A N T Version 3.15 *
-* * *
-* * O F F I C I A L R E L E A S E *
-* * *
-* * CERN, Geneva, April 7, 1992 *
-* * *
-* * The code contained in this file comes from the *
-* * GHEISHA 8 hadron shower generator program by *
-* * H.Fesefeldt RWTH Aachen. *
-* * *
-* ************************************************************
-*
-*
-*::> VERSION 3.15/04 920331 8.02
-*
-*
-*::> VERSION 3.15/03 920329 15.41
-*
-*
-*::> VERSION 3.15/02 920327 18.51
-*
-*
-*::> VERSION 3.15/01 920316 10.19
-*
-* Prerelease stamping of 3.15
-*
-+DECK,V3_14.
-*CMZ : 29/03/94 15.41.37 by S.Giani
-*-- Author :
-*
-*::> VERSION 3.14/16 901107 15.31
-*
-*
-* See PATCH,HISTORY for the description of version 3.14
-*
-
-+PATCH,HISTORY. *** HISTORY OF UPDATES ***
-+DECK,V_314.
-*CMZ : 3.21/02 29/03/94 15.41.37 by S.Giani
-*-- Author :
-C 09-FEB-1988 NVE CERN GENEVA
-C NUMBER OF SUBSCRIPTS OF ARRAY "PCM" CHANGED FROM 1
-C TO 2 IN EQUIVALENCE STATEMENT IN ROUTINE PHASP.
-C 17-FEB-1988 NVE CERN GENEVA
-C ALL CALLS TO "RN" CHANGED TO "RNDM" AND WITHIN A DO
-C LOOP THE DUMMY ARGUMENT HAS BEEN SET TO THE LOOP
-C INDEX IN ORDER TO ENABLE COMPILATION WITH OPTIMIZATION
-C 25-FEB-1988 NVE CERN GENEVA
-C STATEMENT FUNCTION SEQUENCES "ANPOL" AND "ANPOL" ADDED
-C 25-FEB-1988 NVE CERN GENEVA
-C SEQUENCE "ANPOL" INCLUDED IN "STEEQ" AND "STPAIR"
-C 26-FEB-1988 NVE CERN GENEVA
-C SEQUENCE "LIMITS" ADDED FOR ARGUMENTS OF INT. FUNCTIONS
-C 01-MAR-1988 NVE CERN GENEVA
-C ALL CALLS TO "HSTORY" REMOVED
-C 04-MAR-1988 NVE CERN GENEVA
-C +SELF MATERIAL ADDED TO ENABLE SUBROUTINE TIMING
-C 16-MAR-1988 NVE CERN GENEVA
-C NEW "SAVE" CARD AND INIT. FOR "PMUL" AND "ANORM"
-C IN CASCADE ROUTINES
-C 16-MAR-1988 NVE CERN GENEVA
-C DIMENSION OF "ANORM1" CHANGED FROM (4,60) TO (2,60)
-C IN ROUTINE CASASM
-C 16-MAR-1988 NVE CERN GENEVA
-C "REAL*8" AND "REAL*4" REPLACED BY "DOUBLE PRECISION"
-C AND "REAL" RESP. IN ROUTINE "PHASP"
-C 16-MAR-1988 NVE CERN GENEVA
-C "REAL*8" REMOVED IN ROUTINE "PDK"
-C FOR DOUBLE PRECISION USE "DPDK"
-C 16-MAR-1988 NVE CERN GENEVA
-C "SQRT(A)" REPLACED BY "SQRT(ABS(A))" IN "GENXPT"
-C 18-MAR-1988 NVE CERN GENEVA
-C GHEISHA UTILITIES ADDED IN PATCH "GHUTILS"
-C 18-MAR-1988 NVE CERN GENEVA
-C NEW PATCHES "TIFACE, TATINA, GIFACE AND CASCAD"
-C ADDED TO BE COMPLETED IN FUTURE
-C 29-MAR-1988 NVE CERN GENEVA
-C DECK "VECSUB" CLEANED UP AND ALL "ENTRIES" RE-WRITTEN
-C AND CHANGED TO "SUBROUTINES"
-C 29-MAR-1988 NVE CERN GENEVA
-C "DCOS" "DSIN" AND "DSQRT" CHANGED TO "COS" "SIN"
-C AND "SQRT" RESP. IN ROUTINE "PHASP"
-C 29-MAR-1988 NVE CERN GENEVA
-C "DPDK" "DLPSOR" AND "DOTES2" PUT IN SEPARATE DECKS
-C 29-MAR-1988 NVE CERN GENEVA
-C "REAL*8" CHANGED TO "DOUBLE PRECISION" IN SEQ. /GENIO
-C 30-MAR-1988 NVE CERN GENEVA
-C PROTECTIONS AGAINST "EXP()" LIMITS ADDED IN REMAINING
-C CASCADE ROUTINES
-C 30-MAR-1988 NVE CERN GENEVA
-C PROTECTIONS AGAINST "DIVISION BY ZERO" ADDED IN
-C ROUTINE "TWOCLU"
-C 06-APR-1988 NVE CERN GENEVA
-C "GPGHEI" CHANGED IN ORDER TO MATCH GEANT 3.12
-C 07-APR-1988 NVE CERN GENEVA
-C SPECIFIC FUNCTIONS "AMAX1" AND "ALOG" REPLACED BY
-C THEIR GENERIC EQUIVALENTS AND
-C GEOMETRICAL CROSS-SECTIONS FOR NUCLEAR FRAGMENTS ADDED
-C IN ROUTINE "GHESIG"
-C 11-APR-1988 NVE CERN GENEVA
-C PROTECTIONS AGAINST "EXP()" LIMITS ADDED IN ROUTINE
-C "CINEMA" AND "ALOG" CALLS CHANGED TO CALLS TO
-C GENERIC FUNCTION "LOG"
-C 11-APR-1988 NVE CERN GENEVA
-C PROTECTIONS AGAINST NEGATIVE SQRT ADDED IN
-C ROUTINE "TWOCLU"
-C 14-APR-1988 NVE CERN GENEVA
-C ARGUMENT OF "RNDM" SET TO LOOP INDEX
-C IN ROUTINE "NORMAL"
-C 22-APR-1988 NVE CERN GENEVA
-C ALL CALLS TO "ALOG" "IABS" "DCOS" AND "DEXP"
-C CHANGED TO THE GENERIC EQUIVALENTS
-C 02-MAY-1988 NVE CERN GENEVA
-C ROUTINES "GENXPT" AND "TWOCLU" CORRECTED FOR LOW
-C ENERGY BEHAVIOUR
-C 02-MAY-1988 R. BRUN/NVE CERN GENEVA
-C STMT. "GO TO 38" CHANGED TO "GO TO 30" IN ROUTINE
-C "GENXPT" TO PREVENT INFINITE LOOPING
-C 02-MAY-1988 NVE CERN GENEVA
-C ALL "IPV(..)" STUFF CHANGED TO NORMAL "PV(..)"
-C IN ROUTINE "ADD"
-C 04-MAY-1988 NVE CERN GENEVA
-C FUNCTIONS "RMASS" AND "CHARGE" REPLACED BY ARRAYS
-C "RMASS" AND "RCHARG" RESP. AND PUT INTO COMMON /CONSTS
-C MASSES AND CT VALUES OF PARTICLES UPDATED TO LATEST
-C (= GEANT) VALUES AND INITIALIZED IN ROUTINE "GHEINI"
-C 04-MAY-1988 NVE CERN GENEVA
-C DISTINCTION INTRODUCED BETWEEN P AND N TARGET IN ALL
-C "CAS..." ROUTINES AND S AND RS COMPUTED ACCORDINGLY
-C IN THE ROUTINES THEMSELVES
-C THE SAME HAS BEEN DONE IN ROUTINE "TWOB"
-C 04-MAY-1988 NVE CERN GENEVA
-C CORRECT MASSES INTRODUCED FOR THE VARIOUS PROCESSES
-C IN THE ABSORBTION AND ANNIHILATION ROUTINES
-C 06-MAY-1988 NVE CERN GENEVA
-C EXTRA ARGUMENT "NFL" ADDED IN ROUTINE "CORANH"
-C TO INDICATE TARGET TYPE
-C 10-MAY-1988 NVE CERN GENEVA
-C OLD VERSION (GEANT 3.11) OF "GHESIG" RESTORED AND
-C ONLY SLIGHTLY MODIFIED TO INCLUDE GEOMETRICAL X-SECT.
-C OF LIGHT MASS FRAGMENTS
-C THE NEW VERSION OF GHESIG IS CONTAINED IN DECK "GHESIX"
-C ON THIS PAM IN ORDER TO BE INVESTIGATED
-C 11-MAY-1988 NVE CERN GENEVA
-C K0/K0 BAR CHOICE REMOVED FROM "GHESIG" TO AVOID
-C UNPHYSICAL RESULTS
-C THE K0/K0 BAR CHOICE IS NOW MADE RIGHT AFTER THE
-C CREATION OF THE K0 IN ROUTINE "GHEISH"
-C 11-MAY-1988 NVE CERN GENEVA
-C NUCLEAR MASSES OF D, T AND ALPHA RE-COMPUTED
-C TAKING INTO ACCOUNT BINDING ENERGIES AND NEW VALUES
-C USED IN "GHEINI"
-C THESE NEW VALUES WILL ALSO BE USED IN GEANT AND THEY
-C AGREE WITH PARTICLE DATA 1986
-C 11-MAY-1988 NVE CERN GENEVA
-C FLAG "NUCFLG" INTRODUCED IN ROUTINES "CASFRG" AND
-C "GNSLWD" TO INDICATE ACTION TAKEN BY "NUCREC" CALL
-C 11-MAY-1988 NVE CERN GENEVA
-C CALL TO "COSCAT" ADDED IN ROUTINE "CASFRG" IN CASE
-C THE "NUCREC" CALL DID NOT GIVE ANY ACTION
-C 18-MAY-1988 NVE CERN GENEVA
-C DOUBLE COUNTING OF EDEPS FOR STOPPING PARTICLES
-C FIXED (GHEISH AND GHSTOP) AND NEW STEERING FOR
-C LOW ENERGY NUCLEONS IN "GHEISH"
-C 18-MAY-1988 NVE CERN GENEVA
-C BUGS FIXED FOR LOW MOMENTUM AND CALL TO "ATOMAS"
-C REPLACED BY "RMASS" ASSIGNMENTS FOR P, N, D, T AND
-C ALPHA IN ROUTINE "NUCREC"
-C 19-MAY-1988 NVE CERN GENEVA
-C MORE ACCURATE VALUES OF MASSES OF D AND ALPHA USED
-C IN ROUTINE "ATOMAS"
-C 20-MAY-1988 NVE CERN GENEVA
-C PARTICLE MASSES, CHARGES AND CT VALUES FOR GHEISHA
-C DIRECTLY TAKEN FROM THE GEANT ZEBRA BANKS IN
-C ROUTINE "GHEINI"
-C 25-MAY-1988 NVE CERN GENEVA
-C COMMON "/CSDATC" REMOVED AND SEQUENCES "/CSDIM"
-C AND "/CSDAT" INTRODUCED FOR CROSS SECTION DATA IN
-C ORDER TO SAVE MEMORY SPACE
-C THESE SEQUENCES ARE INCLUDED IN ROUTINES "GHESIG"
-C AND "PCSDAT"
-C 15-JUN-1988 NVE CERN GENEVA
-C SEQUENCES "PCODIM" AND "PCODAT" INTRODUCED FOR
-C CENTRALISED GEANT/GHEISHA PARTICLE CODE CONVERSION
-C THESE SEQUENCES ARE INCLUDED IN ROUTINES "GHESIG"
-C AND "GHEISH"
-C 15-JUN-1988 NVE CERN GENEVA
-C FOLLOWING UNUSED SEQUENCES REMOVED
-C /BEAM /CALSTR /CBRDK /CMUEL /CPADE /CQINT /EQUAT
-C /INPEV /MALARR /MUPAC /PARCOM /SCINT /STEPSI
-C 15-JUN-1988 NVE CERN GENEVA
-C ARRAY "IBAR(33)" REMOVED FROM ROUTINE "GHEISH"
-C 23-JUN-1988 R.BRUN/NVE CERN GENEVA
-C STMT. "KKPART=KPART" ADDED AT THE BEGINNING OF
-C ROUTINE "GHEISH" TO PREVENT INFINITE LOOP FOR
-C PARTICLE OF ZERO MOMENTUM
-C 23-JUN-1988 NVE CERN GENEVA
-C ALL VARIABLES "THENVE" RENAMED TO "RTHNVE" TO MATCH
-C NEW IBM COMPILER (= ANSI STANDARD ?)
-C 29-JUN-1988 NVE CERN GENEVA
-C NAME OF ROUTINE "LENGTH" AND RELATED CALLS CHANGED
-C TO "LENGTX" TO AVOID CLASH WITH INTERNAL ROUTINE
-C ON THE CRAY COMPUTER
-C 12-JUL-1988 NVE CERN GENEVA
-C INELASTICITY FOR HADRONIC INTERACTIONS RE-CALCULATED
-C AND CHANGES MADE IN ROUTINE "CINEMA" ACCORDINGLY
-C 13-JUL-1988 NVE CERN GENEVA
-C IPV(...) STUFF REMOVED AND CALL TO "RNDM" CHANGED
-C TO "RANRES" IN ROUTINE "COSCAT"
-C ALSO PROTECTION FOR "SINT" INCLUDED IN "COSCAT"
-C 13-JUL-1988 NVE CERN GENEVA
-C FUNCTION "RANRES" ADDED TO PATCH "GHEISHA"
-C 01-AUG-1988 NVE CERN GENEVA
-C BUG FIXED IN PARTICLE DISTRIBUTION IN BACKWARD
-C AND FORWARD HEMISPHERE IN ROUTINE "TWOCLU"
-C THIS ALSO AVOIDS INFINITE LOOPING FOR HIGH MULT.
-C 15-AUG-1988 NVE CERN GENEVA
-C SETTING OF MECHANISM "STOP" SUPRESSED IN "GHSTOP"
-C TO AVOID DOUBLE SETTING.
-C 16-JAN-1989 NVE CERN GENEVA
-C CONDITIONAL CALL TO "GHEINI" ADDED IN ROUTINE "GHEISH"
-C TO ENSURE PROPER INITIALIZATION IN ALL CASES.
-C 19-JAN-1989 NVE CERN GENEVA
-C INITIALIZATION OF IPA(...) ARRAY ADDED IN ROUTINES
-C "GHEISH" AND "GNSLWD" BY "CALL VZERO(IPA(1),100)"
-C TO MATCH THE ROUTINE "GENXPT"
-C 31-JAN-1989 NVE CERN GENEVA
-C PRINT STATEMENT IN "EXNU" MADE MORE CLEAR
-C 01-FEB-1989 NVE CERN GENEVA
-C PARTICLE CODES ARRAY "IKPART" EXTENDED
-C TO SIZE (35) IN SEQUENCE "PCODIM"
-C AND OMEGA AND ANTI-OMEGA ADDED TO GHEISHA CODES
-C AT POS. 33 AND 34 RESP. IN SEQUENCE "PCODAT"
-C ALSO ARRAYS "RMASS" AND "RCHARG" EXTENDED IN SIZE
-C IN "/CONSTS"
-C OMEGA AND ANTI-OMEGA PARAMETERS ALSO ADDED IN "GHEINI"
-C 01-FEB-1989 NVE CERN GENEVA
-C ROUTINES "GHESIG", "GHESIX" AND "GHEISH"
-C UPDATED FOR OMEGA AND ANTI-OMEGA PARTICLES
-C ALSO SIZE OF "CSEL" AND "CSIN" ARRAYS EXTENDED
-C IN "/CSDIM" AND "/CSDAT" UPDATED ACCORDINGLY BY
-C CHANGE IN ROUTINE "PCSDAT" OF PATCH "GHUTILS"
-C 02-FEB-1989 NVE CERN GENEVA
-C DECKS "CASXM" "CASX0" "CASOM" "CASAXM" "CASAX0"
-C AND "CASAOM" ADDED TO TREAT THE CASCADES OF
-C XI-, XI0, OMEGA- AND THEIR ANTI-PARTICLES.
-C THE CASCADE ROUTINES FOR THE ANTI-PARTICLES ARE
-C FIXUPS FOR THE MOMENT, BUT CORRECT ROUTINES ARE
-C UNDER DEVELOPMENT.
-C 16-FEB-1989 RB CERN GENEVA
-C ALL "RNDM" STUFF REPLACED BY NEW GEANT RANDOM NUMBER
-C GENERATOR "GRNDM"
-C 13-MAR-1989 NVE CERN GENEVA
-C ALL CHANGES MADE BY RENE BRUN CHECKED AND SOME
-C SERIOUS MISTAKES FIXED
-C 17-MAR-1989 NVE CERN GENEVA
-C CALCULATIONS FOR HADRONIC CROSS SECTIONS RE-DONE
-C AND NEW FUNCTION "GHESIG" ADDED IN PATCH "GIFACE"
-C THE OLD VERSION IS STILL AVAILABLE IN DECK "GHESIX"
-C FOR BACKWARD COMPATIBILITY TESTS
-C 20-MAR-1989 NVE CERN GENEVA
-C CORRECT INTERPOLATIONS AND EXTRAPOLATIONS IN
-C ROUTINES "STEEQ" AND "STPAIR"
-C ALSO ALL "ANPOL" AND "ANPOL2" STUFF REMOVED
-C 31-MAR-1989 NVE CERN GENEVA
-C PARTICLE MASSES FOR PACKAGES OTHER THAN "GEANT" UPDATED
-C ACCORDING TO PART. DATA 1986 IN ROUTINE "GHEINI"
-C 23-MAY-1989 NVE CERN GENEVA
-C "DIMENSION PR(50)" CHANGED TO "DIMENSION PR(*)"
-C IN ROUTINE "ROTES2"
-C 29-MAY-1989 R.Brun
-C Protection of all SQRT against <0
-C GRNDM changed to 2 arguments only
-C 12-JUN-1989 NVE CERN GENEVA
-C "COST" PROTECTION RESTORED IN "GMUNU"
-C 13-JUN-1989 H.FESEFELDT
-C Corrections in GHESIG/GHESIX for ACC40
-C R.B, FCA,F.B
-C Protection in GHESIG for IPART>48
-C 29-JUN-1989 RB/NVE CERN GENEVA
-C MASSES UPDATED IN GHEINI ACCORDING TO PART. DATA APR-1988
-C AND PROTECTION AGAINST PRECISION PROBLEMS OF EK AND EDEP
-C IN GHEISH
-C 29-JUN-1989 NVE CERN GENEVA
-C MASSES TAKEN FROM GEANT PARTICLE DATA BANKS IN
-C GMUNU, GMUNUI AND GMUSIG
-C AND MASSES TAKEN FROM "RMASS" ARRAY IN ATOMAS
-C 29-JUN-1989 RB CERN GENEVA
-C "PDK" AND "DPDK" RENAMED TO "GPDK" AND "GDPDK" RESP.
-C BECAUSE OF CONFLICT WITH NEW CERNLIB ROUTINES
-C AND CALLS IN "PHASP" UPDATED ACCORDINGLY
-C 29-JUN-1989 NVE CERN GENEVA
-C OBSOLETE ROUTINE "GHESIX" REMOVED FROM PATCH "GIFACE"
-C 04-JUL-1989 NVE CERN GENEVA
-C PROTECTION AGAINST ANNIHILATION PROCESSES INTRODUCED
-C IN "STPAIR"
-C 18-AUG-1989 NVE CERN GENEVA
-C PROTECTION FOR NGKINE .GT. 100 ADDED IN "GHEISH"
-C AND ALSO PROTECTIONS ADDED IN "SETTRK"
-C 14-SEP-1989 HF RWTH AACHEN
-C CORRECTED IPARM SETTING IN "CINEMA"
-C 05-MAR-1990 HF RWTH AACHEN
-C DOUBLE PRECISION RESTORED FOR PHASE SPACE PACKAGE
-C AND PHOTO-FISSION AND ABSORBTION PROCESSES MODIFIED
-C 05-MAR-1990 RB CERN GENEVA
-C SOME PROTECTIONS INTRODUCED IN MODIFIED CODE
-C 11-MAY-1990 NVE CERN GENEVA
-C MODIFICATIONS OF HF AND RB IMPLEMENTED BY RETAINING
-C THE LOGIC OF GEANH 3.13
-C 14-MAY-1990 NVE CERN GENEVA
-C PROTECTION FOR ATAN2 INTRODUCED IN "GMUNU"
-C 15-MAY-1990 NVE CERN GENEVA
-C COMPLETE "+KEEP" FOR /NUCIO/ UNDER PATCHY FLAG "SINGLE"
-C AND THIS SEQUENCE INTODUCED IN "NUCREC" AND "PHPNUC"
-C 17-MAY-1990 HF RWTH AACHEN/NVE CERN GENEVA
-C DOUBLE INVOKATION OF NUCREC REMOVED FROM "GHEISH"
-C FOR SLOW NEUTRONS WHICH RESULTS IN LONGER PATH
-C 18-MAY-1990 RB CERN GENEVA
-C CLEANER CONSTRUCTION TO PUT DOUBLE PRECISION OF
-C /NUCIO UNDER CONTROL OF PATCHY FLAG "SINGLE"
-C 20-JUN-1990 RB/NVE CERN GENEVA
-C NEW OPTION IHADR=3 INTRODUCED TO SELECT INVOKATION
-C OF THE NUCRIN PACKAGE FROM "GHEISH" FOR ENERGIES
-C BELOW 5 GEV
-C 27-SEP-1990 RB/NVE CERN GENEVA
-C NUCRIN PACKAGE REPLACED BY NEW VERSION OF RB
-C AND PROTECTION AGAINST CRAZY P VALUES ADDED IN "GHEISH"
-C 27-SEP-1990 MR/NVE CERN GENEVA
-C CORRECTION FOR THETA=PI IN ROUTINE "DEFS1"
-C AS A RESULT OF THE BUG THE ORIGINAL (HIGH ENERGETIC)
-C PARTICLE MIGHT HAVE GOT LOST IN CASE OF AN INTERACTION
-C AT THE BEGINNING OF A DETECTOR
-C 27-SEP-1990 HJT/NVE CERN GENEVA
-C AVOIDING NEGATIVE W2 IN "GMUNU" AND CORRECTIONS MADE FOR
-C 'SIG' IN "GMUNUI"
-C 27-SEP-1990 NVE CERN GENEVA
-C PRINT MESSAGES WITH CONTACT PERSON REMOVED IN "GHEISH"
-C 28-SEP-1990 NVE CERN GENEVA
-C GIFACE AND GHEISH CODE CLEANED FROM UNUSED VARIABLES ETC.
-C AS PROPOSED BY RB
-C 25-OCT-1990 NVE CERN GENEVA
-C PROTECTION FOR 'ZINTHA' TO BECOME -0. ADDED IN "GHEISH"
-C TO PREVENT INFINITE LOOP DUE TO PRECISION PROBLEM
-C 26-OCT-1990 NVE CERN GENEVA
-C LOCAL ARRAYS INITIALISED IN "PHASP" AND "PHPNUC" TO
-C ENABLE RUNNING IN DYNAMIC COMP. MODE UNDER UNIX
-C 29-OCT-1990 NVE CERN GENEVA
-C BUG FIXED FOR DOUBLE PRECISION RANDOM NUMBERS IN "PHPNUC"
-C AND FORMAT FOR DEBUG PRINT CHANGED IN "NUCREC"
-C
-C ********************************************************************
-C *** ***
-C *** IN CASE OF ANY TROUBLES, COMMENTS OR SUGGESTIONS CONTACT : ***
-C *** ***
-C *** NICK VAN EIJNDHOVEN ***
-C *** CERN ***
-C *** B 595 R-004 ***
-C *** CH-1211 GENEVA 23 ***
-C *** SWITZERLAND ***
-C *** EUROPE ***
-C *** TEL. +41-22-7674740 OR CERN BEEP 7294 ***
-C *** BITNET ADDRESS : NICK at CERNVM.CERN.CH ***
-C *** ***
-C ********************************************************************
-+PATCH,*GEANH. *** INSTALLATION PILOT PATCH ***
-+DECK,BLANK.
-*CMZ : 3.21/02 29/03/94 15.41.37 by S.Giani
-*-- Author :
-+USE,P=GHCDES,T=E.
-+USE,P=GIFACE,T=E.
-+USE,P=GHEISHA,T=E.
-+USE,P=GHUTILS,T=E.
-+USE,P=GHROUT,T=E.
-+USE,P=GHUTILS,D=CSDAT,T=I.
-+PATCH,GHDOC. *** SOME USEFUL GHEISHA DOCUMENTATION ***
-+DECK,BLANK.
-*CMZ : 3.21/02 29/03/94 15.41.37 by S.Giani
-*-- Author :
-C**
-C** THE BLANK-COMMON IS USED FOR KINEMATIC-CALCULATIONS WITH THE
-C** VECSUB-ROUTINE (2000 WORDS) AND FOR CERN-HBOOK PLOTTING
-C** SYSTEM. IF THE PLOTS ARE FILLED IN THE MEMORY, DO NOT FORGET
-C** A HISTGO(2000)- STATEMENT IN THE ANALYSIS-ROUTINE.
-C** THE DESY-GEP-HBOOK FACILITY DOESN'T USE THE MEMORY, SO THE
-C** BLANK-COMMON MUST ONLY BE INITIALISED FOR 2000 WORDS.
-C** THE NORMAL FILLING OF THE PV-VECTORS IN KINEMATIC CALCULATIONS
-C** ARE AS FOLLOWS:
-C** PV(1,*) = PX (OR PX/P)
-C** PV(2,*) = PY (OR PY/P)
-C** PV(3,*) = PZ (OR PZ/P)
-C** PV(4,*) = ENERGY
-C** PV(5,*) = MASS (SOMETIMES NEGATIVE)
-C** PV(6,*) = CHARGE
-C** PV(7,*) = TIME OF FLIGHT
-C** PV(8,*) = PARTICLE INDEX (SEE #MASIND)
-C** PV(9,*) = 0.
-C** PV(10,*)= USERWORD
-C**
-+DECK,CONSTS.
-*CMZ : 3.21/02 29/03/94 15.41.37 by S.Giani
-*-- Author :
-C**
-C** IN THE /CONSTS-COMMON ARE SOME PARTICLE CONSTANTS
-C**
-C** PI 3.1425927
-C** TWPI 2*PI
-C** PIBTW PI/2.
-C** MP MASS OF PROTON
-C** MPI PION
-C** MMU MUON
-C** MEL ELECTRON
-C** MKCH CHARGED KAON
-C** MK0 NEUTRAL KAON
-C** SMP SQRT(MP)
-C** SMPI SQRT(MPI)
-C** SMU SQRT(MMU)
-C** CT CT OF PIONS
-C** CTKCH CHARGED KAON
-C** CTK0 NEUTRAL KAON
-C** ML0 MASS OF LAMBDA
-C** MSP SIGMA+
-C** MS0 SIGMA0
-C** MSM SIGMA-
-C** MX0 CHI0
-C** MXM CHI-
-C** CTL0 CT OF LAMBDA
-C** CTSP SIGMA+
-C** CTS0 SIGMA0
-C** CTSM SIGMA-
-C** CTX0 CHI0
-C** CTXM CHI-
-C**
-+DECK,CURPAR.
-*CMZ : 3.21/02 29/03/94 15.41.37 by S.Giani
-*-- Author :
-C** WEIGHT(1) | WEIGHTS FROM THE GENERATOR INPUT.
-C** . | NOT USED IN THE PROGRAM.
-C** . | TAKEN FROM INPUT-ROUTINES, DEFAULT-VALUES=1.
-C** . | THE TOTAL WEIGHT IS CALCULATED AS SUM(WEIGHT(I))
-C** WEIGHT(10) |
-C**
-C** DDELTN STEPSIZE AS CALCULATED BY STEPPING ROUTINE ALEX.
-C** DELTN IN RESULT-COMMON IS INITIALLY THE SAME, BUT
-C** MAY BE CHANGED DURING THE STEP (INTERACTION,DECAY).
-C** IFILE NUMBER OF INPUT-ROUTINE TO BE CALLED (=0,1,...9)
-C** (FROM INIT)
-C** IRUN RUN-NUMBER (FROM INIT, NOT USED IN PROGRAM)
-C** NEVT EVENT-NUMBER
-C** NEVENT TOTAL NUMBER OF EVENTS TO BE PROCESSED(FROM INIT)
-C** SHFLAG FLAG FOR ELECTROMAGNETIC SHOWERS(FROM INIT)
-C** = 0 EGS
-C** > 0 GHEISHA ELECTROMAGNETIC SHOWER ROUTINES
-C** WITH ONE-DIMENSIONAL PARAMETRIZATIONS BELOW
-C** THE CUT-OFF ENERGY CENG(1)
-C** (DO NOT USE THEM WITHOUT CAREFUL CHECKS)
-C** ITHST THE RUN SHOULD STOP ITHST SECONDS BEFORE END OF
-C** GO-STEP (FROM CUTS)
-C** ITTOT TOTAL TIME FOR GO-STEP
-C** ITLST REMAINING TIME FOR GO-STEP
-C** IFRND COUNTER FOR USED LOCATIONS IN STACK
-C** TOFCUT TIMING-CUT (IN 1/20. NSEC) (FROM CUTS)
-C** CMOM(1) | MOMENTUM CUTS FOR VARIOUS THINKS,
-C** CMOM(2) | DO NOT CHANGE THEM !!!!!
-C** CMOM(3) |
-C** CMOM(4) |
-C** CMOM(5) |
-C** CENG(1) ENERGY CUT-OFF FOR ELECTROMAGNETIC PARTICLES(CUTS)
-C** BELOW THIS ENERGY PARAMETRIZATIONS ARE USED.
-C** CENG(2) ENERGY CUT-OFF FOR MUON-BREMSSTRAHLUNG.
-C** THESE TWO NUMBERS HAVE BEEN CAREFUL ADJUSTED ACCORDIN
-C** G TO THE DEDX-FORMULA USED IN THE GHEISHA-ELECTRO-
-C** MAGNETIC SHOWER TREATMENT. THUS DO NOT CHANGE THEM
-C** WITHOUT THINKING ABOUT THE CONSEQUENCES.
-C** CENG(3) ENERGY CUT-OFF FOR CHARGED HADRONS(FROM CUTS)
-C** CENG(4) ENERGY CUT-OFF FOR NEUTRAL HADRONS(FROM CUTS)
-C** CENG(5) ENERGY CUT-OFF FOR DELTA-RAYS, BELOW THIS ENERGY
-C** DELTA-ELECTRONS ARE ONLY TRACKED, ABOVE THIS ENERGY
-C** THEY ARE STORED ON THE STACK AND TREATED WITH
-C** THE RESPECTIVE SHOWER ROUTINES (GHEISHA OR EGS).
-C** THE FOLLOWING QUANTITIES ARE USED IN NUCLEAR CASCADE-ROUTINES
-C**
-C** RS CENTER OF MASS ENERGY
-C** S (CENTER OF MASS ENERGY)**2
-C** NP |
-C** NM |OTHER QUANTITIES USED INTERNALLY IN
-C** NN |CASCADE-ROUTINES
-C** NR |
-C** NO |
-C** NZ |
-C** IPA(1)-IPA(200)|
-C** ATNO2 ACTUAL ATOMIC NUMBER OF NUCLEUS(FOR COMPOUNDS)
-C** ZNO2 ACTUAL CHARGE NUMBER OF NUCLEUS(FOR COMPOUNDS)
-C**
-+DECK,ERRCOM.
-*CMZ : 3.21/02 29/03/94 15.41.37 by S.Giani
-*-- Author :
-C**
-C** THE COMMON /ERRCOM CONTAINS FLAGS AND COUNTERS FOR VARIOUS
-C** PURPOSES:
-C**
-C** IER(1) ALEX: NUMBER OF TRACKS LEAVING DETECTOR
-C** IER(2) ALEX: STEPPING ERRORS
-C** IER(3) ALEX:
-C** IER(4) ALEX:
-C** IER(5) FINDCE: SUCCESSFUL CALLS
-C** IER(6) NEXCEL: TOTAL CALLS
-C** IER(7) NEXCEL: NEXT CELL FOUND
-C** IER(8) NEXCEL: PREVIOUS CELL FOUND
-C** IER(9) NEXCEL: FIRST CELL OF NEXT CALORIMETER
-C** IER(10) NEXCEL: LAST CELL OF PREVIOUS CALORIMETER
-C** IER(11) NEXCEL: RECOVERY
-C** IER(12) NEXCEL: OUTSIDE DETECTOR
-C** IER(13) CALIM : NUMBER OF GARBAGE COLLECTIONS
-C** IER(14) TRACK : DEDX > AVAILABLE ENERGY
-C** IER(15) MFSTP : NO SETTING OF M.F. PARAMETERS
-C** IER(16) MFSTQ : NO SETTING OF M.F. PARAMETERS
-C** IER(17) SELECT: TRACKS SKIPPED
-C** IER(18)
-C** IER(19)
-C** IER(20) ASMDK : TOTAL NUMBER OF S-B DECAYS
-C** IER(21) ALODK
-C** IER(22) ASODK
-C** IER(23) ASPDK
-C** IER(24) AXMDK
-C** IER(25) AXODK
-C** IER(26) KCHDK
-C** IER(27) KODKY
-C** IER(28) KOLDKY
-C** IER(29) LODKY
-C** IER(30) MUDKY
-C** IER(31) PIDK
-C** IER(32) PIODKY
-C** IER(33) SMDKY
-C** IER(34) SODKY
-C** IER(35) SPDKY
-C** IER(36) XMDKY
-C** IER(37) XODKY
-C** IER(38)
-C** IER(39)
-C** IER(40) CASMU : TOTAL NUMBER OF MU NUCLEUS INTERACTIONS
-C** IER(41) INTACT: TOTAL NUMBER OF ELASTIC HADRON NULEUS INTERACTIONS
-C** IER(42) INTACT: " " QUASI-ELASTIC " "
-C** IER(43) INTACT: " " INELASTIC " "
-C** IER(44)
-C** IER(45)
-C** IER(46) COSCAT: TOTAL NUMBER OF CALLS
-C** IER(47) TWOB :
-C** IER(48) TWOCLU:
-C** IER(49) GENXPT:
-C** IER(50) STPAIR:
-C** IER(51) > CASCADE-ROUTINES: TOTAL NUMBER OF CALLS
-C** IER(52) > " "
-C** . >
-C** . >
-C** . >
-C** IER(80) > " "
-C** IER(81) CAPTUR
-C** IER(82) FISSIO
-C** IER(83) IPFISS
-C** IER(84) KMABS
-C** IER(85) NBANH
-C** IER(86) PBANH
-C** IER(87) PIMABS
-C** IER(88) DELRAY: DELTA-RAYS STORED ON STACK
-C** IER(89) DELRAY: DELTA-RAYS NOT STORED ON STACK
-C** IER(90) GBREMS
-C** IER(91) GPAIR
-C** IER(92) MBREMS
-C** IER(93)
-C** IER(94)
-C** IER(95)
-C** IER(96)
-C** IER(97)
-C** IER(98)
-C** IER(99)
-C** IER(100)
-C**
-+DECK,EVENT.
-*CMZ : 3.21/02 29/03/94 15.41.37 by S.Giani
-*-- Author :
-C**
-C** THE /EVENT COMMON IS THE STACK, WHERE ALL PARTICLES PRODUCED
-C** IN A SHOWER ARE STORED. ONE TRACK HAS 12 LOCATIONS .
-C**
-C** NSIZE = TOTAL LENGTH OF THE STACK (TO BE SET IN BLOCK-DATA)
-C** NCUR = POINTER TO THE TRACK WHICH SHOULD BE COPIED NEXT FROM
-C** THE STACK TO THE RESULT-COMMON.
-C** NEXT = POINTER TO THE LOCATION WHERE THE NEXT PRODUCED TRACK
-C** SHOULD BE STORED.
-C** NTOT = TOTAL NUMBER OF TRACKS CURRENTLY STORED.
-C**
-C** THE TRACK NEXT TO BE COPIED FROM THE STACK THEN LOOKS LIKE
-C**
-C** EVENT(NCUR ) = X
-C** EVENT(NCUR+ 1) = Y
-C** EVENT(NCUR+ 2) = Z
-C** EVENT(NCUR+ 3) = RCA
-C** EVENT(NCUR+ 4) = RCE
-C** EVENT(NCUR+ 5) = MASS
-C** EVENT(NCUR+ 6) = CHARGE
-C** EVENT(NCUR+ 7) = TOF
-C** EVENT(NCUR+ 8) = PX
-C** EVENT(NCUR+ 9) = PY
-C** EVENT(NCUR+10) = PZ
-C** EVENT(NCUR+11) = USERW
-C**
-C**
-+DECK,MASIND.
-*CMZ : 3.21/02 29/03/94 15.41.37 by S.Giani
-*-- Author :
-C** MASS INDEX FOR ALL PARTICLES CALCULATED FROM MASSES IN BLOCK DATA
-C**
-C** PARTICLE IPART
-C** -----------------------------------
-C** GAMMA 1
-C** NEUTRINO 2
-C** POSITRON 3
-C** ELEKTRON 4
-C** MUON + 5
-C** MUON - 6
-C** PION + 7
-C** PION 0 8
-C** PION - 9
-C** KAON + 10
-C** KAON 0 S 11
-C** KAON 0 L 12
-C** KAON - 13
-C** PROTON 14
-C** PROTON BAR 15
-C** NEUTRON 16
-C** NEUTRON BAR 17
-C** LAMBDA 18
-C** LAMBDA BAR 19
-C** SIGMA + 20
-C** SIGMA 0 21
-C** SIGMA - 22
-C** SIGMA + BAR 23
-C** SIGMA 0 BAR 24
-C** SIGMA - BAR 25
-C** XSI 0 26
-C** XSI - 27
-C** XSI 0 BAR 28
-C** XSI - BAR 29
-C** DEUTERONS 30
-C** TRITONS 31
-C** ALPHAS 32
-C** NEW PARTICLES 33
-+DECK,MASSES.
-*CMZ : 3.21/02 29/03/94 15.41.37 by S.Giani
-*-- Author :
-C** MASSES FOR ALL PARTICLES CALCULATED FROM MASSES IN BLOCK DATA
-C**
-C** PARTICLE MASS (GEV)
-C** -----------------------------------
-C** GAMMA 0.
-C** NEUTRINO 0.00001
-C** POSITRON 0.00051
-C** ELEKTRON 0.00051
-C** MUON + 0.106
-C** MUON - 0.106
-C** PION + 0.140
-C** PION 0 0.140
-C** PION - 0.140
-C** KAON + 0.494
-C** KAON 0 S 0.498
-C** KAON 0 L -0.498
-C** KAON - 0.494
-C** PROTON 0.938
-C** PROTON BAR -0.938
-C** NEUTRON 0.938
-C** NEUTRON BAR -0.938
-C** LAMBDA 1.1156
-C** LAMBDA BAR -1.1156
-C** SIGMA + 1.1894
-C** SIGMA 0 1.1925
-C** SIGMA - 1.1974
-C** SIGMA + BAR -1.1894
-C** SIGMA 0 BAR -1.1925
-C** SIGMA - BAR -1.1974
-C** XSI 0 1.3149
-C** XSI - 1.3213
-C** XSI 0 BAR -1.3149
-C** XSI - BAR -1.3213
-C** ALPHAS+FRAGMENTS UNCHANGED
-C** NEW PARTICLES UNCHANGED
-+DECK,MAT.
-*CMZ : 3.21/02 29/03/94 15.41.37 by S.Giani
-*-- Author :
-C**
-C** ALL MATERIAL CONSTANTS ARE PARTLY STORED ON THE COMMON /MAT IN THE
-C** BLOCK DATA OR CALCULATED IN THE ROUTINE MATTER.IN PRESENT VERSION
-C** THERE MAY BE DEFINED UP TO 20 MATERIALS WITH THE MATERIAL-INDEX
-C** NUMBER 'IND' . THIS MATERIAL INDEX NUMBER MUST BE GIVEN FOR
-C** EACH CELL OF A CALORIMETER IN THE GEOMETRY INPUT DATA CARDS.
-C** (SEE COMMON /CALSTR AND INIT). IND =0 IS ALWAYS INTERPRETED AS
-C** VACUUM IN THE PROGRAM.
-C
-C** DEN (IND+1) = DENSITY (GR/CM**3)
-C** RADLTH(IND+1) = RADIATION LENGTH (CM)
-C** ATNO (IND+1) = ATOMIC NUMBER (AVERAGE VALUE, SEE LATER)
-C** ZNO (IND+1) = CHARGE NUMBER OF NUCLEUS (AVERAGE VALUE, SEE LATER)
-C** ABSL (IND+1) = ABSORPTION LENGTH (ONLY USED FOR STEP SIZE
-C** CALCULATION)
-C** CDEN (IND+1) = C - PARAMETER IN STERNHEIMERS THEORY
-C** MDEN (IND+1) = M - PARAMETER IN STERNHEIMERS THEORY
-C** X0DEN (IND+1) = X0- PARAMETER IN STERNHEIMERS THEORY
-C** X1DEN (IND+1) = X1- PARAMETER IN STERNHEIMERS THEORY
-C** RION (IND+1) = IONISATION POTENTIAL
-C** MATID (IND+1) = GHEISHA ALPHANUMERIC LABEL (A4)
-C** MATID1(IND+1,24) = EGS ALPHANUMERIC LABEL (24*A1)
-C** 10 PARAMETERS DESCRIBING THE MATERIAL AT VARIOUS PLACES
-C** IN THE PROGRAM :
-C** PARMAT(IND+1, 1) = X DE/DX CORRECTION FACTOR FOR LANDAU
-C** TYPE DISTRIBUTIONS
-C** PARMAT(IND+1, 2) = 1. FOR SOLIDS
-C** = 2. FOR FLUIDS
-C** = 3. FOE GASEOUS MATERIALS
-C** PARMAT(IND+1, 3) = 1. DELTA-RAY SELECTION : ALL PARTICLES
-C** = 2. DELTA-RAY SELECTION : ONLY MUONS
-C** = 3. DELTA-RAY SELECTION : MUONS AND ELECTRONS
-C** = 4. DELTA-RAY SELECTION : MUONS,ELECTRONS,PIONS
-C** PARMAT(IND+1, 4) = MINIMUM RANGE FOR DELTA-ELECTRONS
-C** PARMAT(IND+1, 5) = 1. FOR ANORGANIC SCINTILLATORS ONLY
-C** PARMAT(IND+1, 6) = SATURATION COEFFICIENT IN BIRK'S LAW
-C** = 1. DEFAULT VALUE SAT=0.010/DENSITY,
-C** > 1. SAT=PARMAT(IND+1,6)-1.
-C** PARMAT(IND+1, 7) > 0. INDUCED HADRON NUCLEAR FISSION
-C** PARMAT(IND+1, 8) > 0. PHOTOABSORBTION AND PHOTOFISSION
-C** PARMAT(IND+1, 9) > 0. NATURAL RADIOACTIVITY
-C** PARMAT(IND+1,10) = CORRECTION FACTOR FOR ENERGY LOSS BY
-C** NUCLEAR BREAKUP EFFECTS
-C** = 0. DEFAULT MODEL DESCRIPTION IS USED.
-C**
-C** THE DENSITY, ATOMIC NUMBER AND CHARGE NUMBER , DEFINED ABOVE,
-C** ARE AVERAGE VALUES FOR COMPOUND MATERIALS LIKE BGO.
-C** THESE VALUES ARE USED FOR DE/DX- CALCULATIONS ONLY.
-C**
-C** ALL MATERIALS MAY BE DEFINED AS COMPOUNDS OR MIXTURES,
-C** THE FOLLOWING NUMBERS ARE TAKEN FROM THE EGS DATA FILE,
-C** OR, IF NOT GIVEN, CALCULATED.
-C** IFRAC(J) = NUMBER OF COMPOUNDS IN THIS MATERIAL
-C** FRAC1(J,I) = PARTIAL INTERACT.LENGTH OF THE I.TH COMPOUND
-C** DEN1 (J,I) = PARTIAL DENSITY OF THE I.TH COMPOUND
-C** ATNO1(J,I) = ATOMIC NUMBER OF THE I.TH COMPOUND
-C** ZNO1 (J,I) = CHARGE NUMBER OF THE I.TH COMPOUND
-C**
-C**
-+DECK,RESULT.
-*CMZ : 3.21/02 29/03/94 15.41.37 by S.Giani
-*-- Author :
-C**
-C** THE RESULT COMMON STORES ALL INFORMATION OF THE CURRENT TRACK:
-C**
-C** XEND | START- OR END- COORDINATES OF THE CURRENT STEP.
-C** YEND |
-C** ZEND |
-C** RCA CALO1*1000.+CALO2*1. |CALO1 AND CALO2 (CELL1 AND
-C** RCE CELL1*1000.+CELL2*1. |CELL2) ARE THE CALORIMETER
-C** |(CELLS), WHERE THIS STEP COMES
-C** |FROM AND GOES TO.
-C** AMAS MASS
-C** NCH CHARGE
-C** TOF TIME OF FLIGHT (IN 1/20 NSEC)
-C** PX PX/P = COSL*COSP
-C** PY PY/P = COSL*SINP
-C** PZ PZ/P = SINL
-C** USERW USERWORD (SEE 'HSTORY')
-C** INTCT INTERACTION/DECAY-COUNTER
-C** P MOMENTUM
-C** EN TOTAL ENERGY
-C** EK KINETIC ENERGY
-C** AMASQ MASS**2
-C** DELTN ACTUAL STEPSIZE (SEE ALSO DDELTN IN COMMON /CURPAR)
-C** ITK NUMBER OF GENERATOR TRACK (SEE INPUT-ROUTINES)
-C** NTK NUMBER OF TRACK IN SHOWER
-C** IPART PARTICLE INDEX (SEE #MASIND)
-C** IND MATERIAL INDEX (SEE #MATTER)
-C** LCALO CALORIMETER NUMBER (=CALORIMETER1 IN RCA)
-C** ICEL CELL NUMBER (=CELL1 IN RCE)
-C** SINL SINE OF DIP-ANGLE
-C** COSL COSINE OF DIP-ANGLE
-C** SINP SINE OF NORMAL PHI-ANGLE (WITH RESPECT TO X-AXIS)
-C** COSP COSINE OF NORMAL PHI-ANGLE
-C**
-+PATCH,GHCDES. *** ALL COMMONS NEEDED FOR GEANT/GHEISHA8 COMBINATION ***
-+DECK,BLANK.
-*CMZ : 3.21/02 29/03/94 15.41.37 by S.Giani
-*-- Author :
-+KEEP,MXGKGH.
- PARAMETER (MXGKGH=100)
-+KEEP,/BLANK. *** NVE 09-FEB-1988 ***
- PARAMETER (MXGKPV=MXGKGH)
- COMMON /VECUTY/ PV(10,MXGKPV)
-C
-+KEEP,/BLANKP. *** NVE 09-FEB-1988 ***
- PARAMETER (MXGKPV=MXGKGH)
- COMMON /VECUTY/ PV(10,MXGKPV)
-C
-+KEEP,/CONSTS.
- COMMON/CONSTS/ PI,TWPI,PIBTW,MP,MPI,MMU,MEL,MKCH,MK0,SMP,SMPI,
- $ SMU,CT,CTKCH,CTK0,
- $ ML0,MSP,MS0,MSM,MX0,MXM,CTL0,CTSP,CTSM,CTX0,CTXM,
- $ RMASS(35),RCHARG(35)
-C
- REAL MP,MPI,MMU,MEL,MKCH,MK0,
- * ML0,MSP,MS0,MSM,MX0,MXM
-C
-+KEEP,/COSCOM.
- COMMON/COSCOM/AA,BB,CC,DD,RR
-C
-+KEEP,/CURPAR.
- PARAMETER (MXGKCU=MXGKGH)
- COMMON/CURPAR/WEIGHT(10),DDELTN,IFILE,IRUN,NEVT,NEVENT,SHFLAG,
- * ITHST,ITTOT,ITLST,IFRND,TOFCUT,CMOM(5),CENG(5),
- * RS,S,ENP(10),NP,NM,NN,NR,NO,NZ,IPA(MXGKCU),
- * ATNO2,ZNO2
-C
-+KEEP,/ERRCOM.
- COMMON/ERRCOM/ IER(100)
-C
-+KEEP,/EVENT.
- PARAMETER (MXEVEN=12*MXGKGH)
- COMMON/EVENT / NSIZE,NCUR,NEXT,NTOT,EVE(MXEVEN)
-C
-+KEEP,/GENIO.
- COMMON/GENIN /TECM,AMASS(18),NPG,KGENEV
- COMMON/GENOUT/PCM(5,18),WGT
-C
-+KEEP,NUCIOD. *** Used in /NUCIO under control of PATCHY flag "SINGLE"
- DOUBLE PRECISION TECM,AMASS,PCM,WGT
-C
-+KEEP,/NUCIO.
- COMMON/NUCIN /TECM,AMASS(18),NPG,KGENEV
- COMMON/NUCOUT/PCM(5,18),WGT
-+SEQ,NUCIOD,IF=-SINGLE.
-C
-+KEEP,/KGINIT. *** NVE 09-FEB-1988 ***
-C --- INITIALIZATION FLAGS FOR VARIOUS GHEISHA ROUTINES ---
- COMMON /KGINIT/ KGINIT(50)
-C
-+KEEP,/MAT.
- COMMON/MAT / LMAT,
- * DEN(21),RADLTH(21),ATNO(21),ZNO(21),ABSL(21),
- * CDEN(21),MDEN(21),X0DEN(21),X1DEN(21),RION(21),
- * MATID(21),MATID1(21,24),PARMAT(21,10),
- * IFRAT,IFRAC(21),FRAC1(21,10),DEN1(21,10),
- * ATNO1(21,10),ZNO1(21,10)
-C
-+KEEP,/PRNTFL.
- COMMON/PRNTFL/INBCD,NEWBCD,INBIN,NEWBIN,NPEVT,NEVTP,LPRT,NPRT(10)
- LOGICAL LPRT,NPRT
-C
-+KEEP,/RESULT.
- COMMON/RESULT/XEND,YEND,ZEND,RCA,RCE,AMAS,NCH,TOF,PX,PY,PZ,
- * USERW,INTCT,P,EN,EK,AMASQ,DELTN,ITK,NTK,IPART,IND,
- * LCALO,ICEL,SINL,COSL,SINP,COSP,
- * XOLD,YOLD,ZOLD,POLD,PXOLD,PYOLD,PZOLD,
- * XSCAT,YSCAT,ZSCAT,PSCAT,PXSCAT,PYSCAT,PZSCAT
- REAL NCH,INTCT
-C
-+KEEP,/DEFCOM.
-+SEQ,MXGKGH.
-+SEQ,/CONSTS.
-+SEQ,/CURPAR.
-+SEQ,/RESULT.
-+SEQ,/MAT.
-+SEQ,/EVENT.
-+SEQ,/PRNTFL
-+SEQ,/ERRCOM.
-+SEQ,/BLANK.
-C
-+KEEP,LIMITS.
-C --- BOUNDARY LIMITS FOR ARGUMENTS OF INTRINSIC FUNCTIONS ---
-C --- XL DENOTES LOWER BOUND WHEREAS XU DENOTES UPPER BOUND ---
- COMMON /LIMITS/ EXPXL,EXPXU
-C
-+KEEP,/CSDIM.
-C --- DIMENSION STATEMENTS FOR CROSS SECTION DATA ---
- DIMENSION PLAB(41),CSEL(35,41),CSIN(35,41),CSPIEL(3,41),
- $ CSPIIN(3,41),CSPNEL(3,41),CSPNIN(3,41),
- $ ELAB(17),CNLWAT(15),CNLWEL(15,17),CNLWIN(15,17),
- $ CSCAP(100),EKFISS(21),CSFISS(4,21)
-C
-+KEEP,/CSDAT.
-C --- CROSS-SECTION DATA BY "PCSDAT" 01-FEB-1989 ---
-C
- DATA PLAB /
- $ 0.00000E+00, 0.10000 , 0.15000 , 0.20000 , 0.25000 ,
- $ 0.30000 , 0.35000 , 0.40000 , 0.45000 , 0.50000 ,
- $ 0.55000 , 0.60000 , 0.65000 , 0.70000 , 0.75000 ,
- $ 0.80000 , 0.85000 , 0.90000 , 0.95000 , 1.0000 ,
- $ 1.1000 , 1.2000 , 1.3000 , 1.4000 , 1.5000 ,
- $ 1.6000 , 1.8000 , 2.0000 , 2.2000 , 2.4000 ,
- $ 2.6000 , 2.8000 , 3.0000 , 4.0000 , 5.0000 ,
- $ 6.0000 , 8.0000 , 10.000 , 20.000 , 100.00 ,
- $ 1000.0 /
- DATA (CSEL( 1,J),J=1,41) /
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00/
- DATA (CSEL( 2,J),J=1,41) /
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00/
- DATA (CSEL( 3,J),J=1,41) /
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00/
- DATA (CSEL( 4,J),J=1,41) /
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00/
- DATA (CSEL( 5,J),J=1,41) /
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00/
- DATA (CSEL( 6,J),J=1,41) /
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00/
- DATA (CSEL( 7,J),J=1,41) /
- $ 0.00000E+00, 6.0000 , 20.000 , 71.000 , 155.00 ,
- $ 195.00 , 130.00 , 78.000 , 60.000 , 32.000 ,
- $ 23.500 , 18.500 , 15.000 , 12.500 , 10.000 ,
- $ 9.1000 , 8.6000 , 8.8000 , 9.5000 , 10.600 ,
- $ 13.000 , 15.500 , 17.100 , 17.200 , 16.200 ,
- $ 15.000 , 12.300 , 10.200 , 9.0000 , 8.0000 ,
- $ 7.3000 , 6.8000 , 6.5000 , 5.8000 , 5.4000 ,
- $ 5.2000 , 5.0000 , 4.9000 , 3.8000 , 3.2000 ,
- $ 3.5000 /
- DATA (CSEL( 8,J),J=1,41) /
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00/
- DATA (CSEL( 9,J),J=1,41) /
- $ 0.00000E+00, 1.0000 , 3.0000 , 8.0000 , 18.000 ,
- $ 25.000 , 27.500 , 12.300 , 10.600 , 11.000 ,
- $ 12.500 , 14.500 , 17.000 , 19.400 , 19.800 ,
- $ 16.800 , 14.000 , 14.800 , 20.000 , 26.100 ,
- $ 19.500 , 15.000 , 12.800 , 11.500 , 10.500 ,
- $ 9.8000 , 8.8000 , 8.2000 , 7.8000 , 7.5000 ,
- $ 7.2000 , 7.0000 , 6.8000 , 6.1000 , 5.7000 ,
- $ 5.4000 , 4.9000 , 4.6000 , 4.0000 , 3.3000 ,
- $ 3.5000 /
- DATA (CSEL(10,J),J=1,41) /
- $ 10.000 , 11.200 , 11.300 , 11.400 , 11.500 ,
- $ 11.600 , 11.800 , 12.000 , 12.100 , 12.200 ,
- $ 12.300 , 12.400 , 12.500 , 12.500 , 12.500 ,
- $ 12.400 , 12.300 , 12.200 , 12.000 , 11.800 ,
- $ 11.200 , 11.500 , 9.9000 , 9.4000 , 8.8000 ,
- $ 8.4000 , 7.5000 , 6.9000 , 6.3000 , 5.9000 ,
- $ 5.5000 , 5.2000 , 5.0000 , 4.0000 , 3.5000 ,
- $ 3.3000 , 3.1000 , 3.1000 , 3.0000 , 2.5000 ,
- $ 3.0000 /
- DATA (CSEL(11,J),J=1,41) /
- $ 10.000 , 11.200 , 11.300 , 11.400 , 11.500 ,
- $ 11.600 , 11.800 , 12.000 , 12.100 , 12.200 ,
- $ 12.300 , 12.400 , 12.500 , 12.500 , 12.500 ,
- $ 12.400 , 12.300 , 12.200 , 12.000 , 11.800 ,
- $ 11.200 , 11.500 , 9.9000 , 9.4000 , 8.8000 ,
- $ 8.4000 , 7.5000 , 6.9000 , 6.3000 , 5.9000 ,
- $ 5.5000 , 5.2000 , 5.0000 , 4.0000 , 3.5000 ,
- $ 3.3000 , 3.1000 , 3.1000 , 3.0000 , 2.5000 ,
- $ 3.0000 /
- DATA (CSEL(12,J),J=1,41) /
- $ 160.83 , 82.800 , 58.575 , 43.683 , 34.792 ,
- $ 28.650 , 24.367 , 20.917 , 18.192 , 16.300 ,
- $ 14.608 , 13.017 , 12.250 , 11.700 , 12.017 ,
- $ 14.075 , 15.842 , 16.433 , 16.042 , 15.008 ,
- $ 12.575 , 10.708 , 9.2000 , 8.0167 , 7.2833 ,
- $ 7.0750 , 6.6333 , 6.1250 , 5.6583 , 5.2750 ,
- $ 4.9333 , 4.6250 , 4.4583 , 3.7333 , 3.3833 ,
- $ 3.1833 , 2.9833 , 2.7500 , 2.3667 , 2.2000 ,
- $ 2.6000 /
- DATA (CSEL(13,J),J=1,41) /
- $ 300.00 , 140.00 , 97.000 , 70.000 , 55.000 ,
- $ 45.000 , 37.000 , 31.000 , 26.000 , 23.000 ,
- $ 20.000 , 17.000 , 15.500 , 14.500 , 14.700 ,
- $ 18.500 , 22.000 , 23.000 , 22.500 , 20.700 ,
- $ 16.500 , 14.000 , 11.500 , 9.6000 , 8.6000 ,
- $ 8.5000 , 8.3000 , 7.6000 , 7.0000 , 6.4000 ,
- $ 5.9000 , 5.5000 , 5.3000 , 4.4000 , 4.1000 ,
- $ 3.9000 , 3.7000 , 3.3000 , 2.6000 , 2.5000 ,
- $ 3.0000 /
- DATA (CSEL(14,J),J=1,41) /
- $ 1100.0 , 115.00 , 105.00 , 100.00 , 56.000 ,
- $ 40.000 , 27.000 , 22.000 , 21.000 , 20.000 ,
- $ 20.000 , 20.000 , 20.500 , 21.000 , 22.000 ,
- $ 23.000 , 24.000 , 24.000 , 24.400 , 24.500 ,
- $ 25.000 , 25.500 , 26.000 , 26.500 , 27.000 ,
- $ 27.000 , 26.000 , 23.000 , 21.500 , 20.000 ,
- $ 19.000 , 18.000 , 17.000 , 13.000 , 11.500 ,
- $ 10.300 , 9.4000 , 9.0000 , 8.8000 , 7.0000 ,
- $ 7.5000 /
- DATA (CSEL(15,J),J=1,41) /
- $ 200.00 , 163.00 , 141.00 , 120.00 , 111.00 ,
- $ 99.500 , 92.500 , 86.500 , 82.000 , 78.000 ,
- $ 74.000 , 71.000 , 67.500 , 65.000 , 62.500 ,
- $ 59.700 , 58.100 , 56.300 , 54.700 , 52.700 ,
- $ 50.000 , 48.400 , 47.000 , 46.000 , 45.200 ,
- $ 42.800 , 39.200 , 36.300 , 32.800 , 30.400 ,
- $ 28.100 , 26.300 , 24.500 , 19.250 , 16.840 ,
- $ 14.600 , 12.340 , 11.210 , 8.8500 , 7.5000 ,
- $ 7.5000 /
- DATA (CSEL(16,J),J=1,41) /
- $ 4200.0 , 440.00 , 420.00 , 400.00 , 230.00 ,
- $ 160.00 , 105.00 , 80.000 , 62.000 , 50.000 ,
- $ 45.000 , 41.000 , 38.000 , 36.000 , 35.000 ,
- $ 34.000 , 33.000 , 32.000 , 31.500 , 31.000 ,
- $ 30.500 , 30.000 , 29.500 , 29.000 , 28.500 ,
- $ 28.000 , 26.000 , 23.000 , 21.500 , 20.000 ,
- $ 19.000 , 18.000 , 17.000 , 13.000 , 11.500 ,
- $ 10.300 , 9.4000 , 9.0000 , 8.8000 , 7.0000 ,
- $ 7.5000 /
- DATA (CSEL(17,J),J=1,41) /
- $ 185.88 , 133.23 , 119.37 , 102.86 , 93.102 ,
- $ 82.752 , 76.205 , 71.008 , 67.366 , 64.096 ,
- $ 60.891 , 58.501 , 55.735 , 53.773 , 51.839 ,
- $ 49.671 , 48.485 , 47.045 , 45.803 , 44.306 ,
- $ 42.623 , 41.786 , 41.115 , 40.630 , 40.129 ,
- $ 38.242 , 35.233 , 32.662 , 29.639 , 27.573 ,
- $ 25.536 , 23.948 , 22.356 , 17.723 , 15.614 ,
- $ 13.653 , 11.675 , 10.653 , 8.6198 , 7.4464 ,
- $ 7.4821 /
- DATA (CSEL(18,J),J=1,41) /
- $ 1100.0 , 115.00 , 105.00 , 100.00 , 56.000 ,
- $ 40.000 , 27.000 , 22.000 , 21.000 , 20.000 ,
- $ 20.000 , 19.067 , 19.333 , 19.500 , 19.833 ,
- $ 20.567 , 21.800 , 22.900 , 23.869 , 23.809 ,
- $ 22.161 , 21.488 , 19.732 , 19.433 , 19.345 ,
- $ 19.029 , 18.121 , 16.280 , 15.258 , 14.280 ,
- $ 13.644 , 12.963 , 12.316 , 9.5333 , 8.4333 ,
- $ 7.5728 , 6.9696 , 6.7518 , 6.6175 , 5.6000 ,
- $ 6.1145 /
- DATA (CSEL(19,J),J=1,41) /
- $ 157.65 , 73.701 , 76.096 , 68.571 , 57.305 ,
- $ 49.257 , 43.616 , 40.024 , 38.098 , 36.287 ,
- $ 34.674 , 33.105 , 31.712 , 30.685 , 29.613 ,
- $ 28.602 , 28.336 , 28.075 , 27.786 , 27.215 ,
- $ 26.380 , 26.146 , 25.108 , 24.783 , 24.360 ,
- $ 23.219 , 21.431 , 20.095 , 18.382 , 17.267 ,
- $ 16.100 , 15.175 , 14.271 , 11.573 , 10.305 ,
- $ 9.1471 , 8.0149 , 7.4349 , 6.2499 , 5.8928 ,
- $ 6.0774 /
- DATA (CSEL(20,J),J=1,41) /
- $ 1100.0 , 115.00 , 105.00 , 100.00 , 56.000 ,
- $ 40.000 , 27.000 , 22.000 , 21.000 , 20.000 ,
- $ 20.000 , 19.067 , 19.333 , 19.500 , 19.833 ,
- $ 20.567 , 21.800 , 22.900 , 23.869 , 23.809 ,
- $ 22.161 , 21.488 , 19.732 , 19.433 , 19.345 ,
- $ 19.029 , 18.121 , 16.280 , 15.258 , 14.280 ,
- $ 13.644 , 12.963 , 12.316 , 9.5333 , 8.4333 ,
- $ 7.5728 , 6.9696 , 6.7518 , 6.6175 , 5.6000 ,
- $ 6.1145 /
- DATA (CSEL(21,J),J=1,41) /
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00/
- DATA (CSEL(22,J),J=1,41) /
- $ 1100.0 , 115.00 , 105.00 , 100.00 , 56.000 ,
- $ 40.000 , 27.000 , 22.000 , 21.000 , 20.000 ,
- $ 20.000 , 19.067 , 19.333 , 19.500 , 19.833 ,
- $ 20.567 , 21.800 , 22.900 , 23.869 , 23.809 ,
- $ 22.161 , 21.488 , 19.732 , 19.433 , 19.345 ,
- $ 19.029 , 18.121 , 16.280 , 15.258 , 14.280 ,
- $ 13.644 , 12.963 , 12.316 , 9.5333 , 8.4333 ,
- $ 7.5728 , 6.9696 , 6.7518 , 6.6175 , 5.6000 ,
- $ 6.1145 /
- DATA (CSEL(23,J),J=1,41) /
- $ 185.88 , 133.23 , 119.37 , 102.86 , 93.102 ,
- $ 82.752 , 76.205 , 71.008 , 67.366 , 64.096 ,
- $ 60.891 , 58.104 , 55.241 , 53.140 , 50.934 ,
- $ 48.660 , 47.566 , 46.585 , 45.581 , 44.003 ,
- $ 41.134 , 39.374 , 36.878 , 35.523 , 34.503 ,
- $ 32.334 , 29.365 , 27.370 , 24.705 , 22.921 ,
- $ 21.229 , 19.879 , 18.559 , 14.625 , 12.758 ,
- $ 11.041 , 9.3440 , 8.5484 , 6.7104 , 6.0000 ,
- $ 6.1131 /
- DATA (CSEL(24,J),J=1,41) /
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00/
- DATA (CSEL(25,J),J=1,41) /
- $ 157.65 , 73.701 , 76.096 , 68.571 , 57.305 ,
- $ 49.257 , 43.616 , 40.024 , 38.098 , 36.287 ,
- $ 34.674 , 33.105 , 31.712 , 30.685 , 29.613 ,
- $ 28.602 , 28.336 , 28.075 , 27.786 , 27.215 ,
- $ 26.380 , 26.146 , 25.108 , 24.783 , 24.360 ,
- $ 23.219 , 21.431 , 20.095 , 18.382 , 17.267 ,
- $ 16.100 , 15.175 , 14.271 , 11.573 , 10.305 ,
- $ 9.1471 , 8.0149 , 7.4349 , 6.2499 , 5.8928 ,
- $ 6.0774 /
- DATA (CSEL(26,J),J=1,41) /
- $ 1100.0 , 115.00 , 105.00 , 100.00 , 56.000 ,
- $ 40.000 , 27.000 , 22.000 , 21.000 , 20.000 ,
- $ 20.000 , 18.133 , 18.167 , 18.000 , 17.667 ,
- $ 18.133 , 19.600 , 21.800 , 23.338 , 23.118 ,
- $ 19.323 , 17.476 , 13.464 , 12.367 , 11.691 ,
- $ 11.057 , 10.242 , 9.5593 , 9.0151 , 8.5591 ,
- $ 8.2884 , 7.9253 , 7.6311 , 6.0667 , 5.3667 ,
- $ 4.8456 , 4.5392 , 4.5036 , 4.4351 , 4.2000 ,
- $ 4.7289 /
- DATA (CSEL(27,J),J=1,41) /
- $ 1100.0 , 115.00 , 105.00 , 100.00 , 56.000 ,
- $ 40.000 , 27.000 , 22.000 , 21.000 , 20.000 ,
- $ 20.000 , 18.133 , 18.167 , 18.000 , 17.667 ,
- $ 18.133 , 19.600 , 21.800 , 23.338 , 23.118 ,
- $ 19.323 , 17.476 , 13.464 , 12.367 , 11.691 ,
- $ 11.057 , 10.242 , 9.5593 , 9.0151 , 8.5591 ,
- $ 8.2884 , 7.9253 , 7.6311 , 6.0667 , 5.3667 ,
- $ 4.8456 , 4.5392 , 4.5036 , 4.4351 , 4.2000 ,
- $ 4.7289 /
- DATA (CSEL(28,J),J=1,41) /
- $ 157.65 , 73.701 , 76.096 , 68.571 , 57.305 ,
- $ 49.257 , 43.616 , 40.024 , 38.098 , 36.287 ,
- $ 34.674 , 32.708 , 31.218 , 30.052 , 28.707 ,
- $ 27.591 , 27.417 , 27.615 , 27.564 , 26.913 ,
- $ 24.891 , 23.734 , 20.871 , 19.677 , 18.734 ,
- $ 17.311 , 15.563 , 14.803 , 13.448 , 12.615 ,
- $ 11.794 , 11.106 , 10.474 , 8.4745 , 7.4498 ,
- $ 6.5350 , 5.6835 , 5.3300 , 4.3406 , 4.4464 ,
- $ 4.7083 /
- DATA (CSEL(29,J),J=1,41) /
- $ 143.53 , 43.935 , 54.462 , 51.429 , 39.407 ,
- $ 32.510 , 27.321 , 24.532 , 23.465 , 22.383 ,
- $ 21.566 , 20.209 , 19.453 , 18.825 , 18.046 ,
- $ 17.562 , 17.802 , 18.360 , 18.667 , 18.519 ,
- $ 17.514 , 17.120 , 14.985 , 14.306 , 13.663 ,
- $ 12.753 , 11.596 , 11.165 , 10.287 , 9.7882 ,
- $ 9.2294 , 8.7539 , 8.3300 , 6.9480 , 6.2234 ,
- $ 5.5881 , 5.0189 , 4.7733 , 4.1104 , 4.3929 ,
- $ 4.6905 /
- DATA (CSEL(30,J),J=1,41) /
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00/
- DATA (CSEL(31,J),J=1,41) /
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00/
- DATA (CSEL(32,J),J=1,41) /
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00/
- DATA (CSEL(33,J),J=1,41) /
- $ 1100.0 , 115.00 , 105.00 , 100.00 , 56.000 ,
- $ 40.000 , 27.000 , 22.000 , 21.000 , 20.000 ,
- $ 20.000 , 18.133 , 18.167 , 18.000 , 17.667 ,
- $ 18.133 , 19.600 , 21.800 , 23.338 , 23.118 ,
- $ 19.323 , 17.476 , 13.464 , 12.367 , 11.691 ,
- $ 11.057 , 10.242 , 9.5593 , 9.0151 , 8.5591 ,
- $ 8.2884 , 7.9253 , 7.6311 , 6.0667 , 5.3667 ,
- $ 4.8456 , 4.5392 , 4.5036 , 4.4351 , 4.2000 ,
- $ 4.7289 /
- DATA (CSEL(34,J),J=1,41) /
- $ 143.53 , 43.935 , 54.462 , 51.429 , 39.407 ,
- $ 32.510 , 27.321 , 24.532 , 23.465 , 22.383 ,
- $ 21.566 , 20.209 , 19.453 , 18.825 , 18.046 ,
- $ 17.562 , 17.802 , 18.360 , 18.667 , 18.519 ,
- $ 17.514 , 17.120 , 14.985 , 14.306 , 13.663 ,
- $ 12.753 , 11.596 , 11.165 , 10.287 , 9.7882 ,
- $ 9.2294 , 8.7539 , 8.3300 , 6.9480 , 6.2234 ,
- $ 5.5881 , 5.0189 , 4.7733 , 4.1104 , 4.3929 ,
- $ 4.6905 /
- DATA (CSEL(35,J),J=1,41) /
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00/
- DATA (CSIN( 1,J),J=1,41) /
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00/
- DATA (CSIN( 2,J),J=1,41) /
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00/
- DATA (CSIN( 3,J),J=1,41) /
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00/
- DATA (CSIN( 4,J),J=1,41) /
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00/
- DATA (CSIN( 5,J),J=1,41) /
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00/
- DATA (CSIN( 6,J),J=1,41) /
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00/
- DATA (CSIN( 7,J),J=1,41) /
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.50000 , 1.2000 , 1.7000 ,
- $ 2.2500 , 3.0000 , 3.6000 , 4.5000 , 5.4000 ,
- $ 6.3000 , 8.6000 , 9.0000 , 10.000 , 11.500 ,
- $ 14.000 , 17.000 , 19.500 , 22.000 , 24.000 ,
- $ 21.500 , 18.500 , 19.000 , 20.500 , 22.200 ,
- $ 23.000 , 23.300 , 23.000 , 21.000 , 20.500 ,
- $ 20.200 , 20.100 , 20.000 , 20.000 , 20.000 ,
- $ 21.000 /
- DATA (CSIN( 8,J),J=1,41) /
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00/
- DATA (CSIN( 9,J),J=1,41) /
- $ 0.00000E+00, 3.0000 , 9.2000 , 20.500 , 36.500 ,
- $ 45.000 , 28.000 , 19.500 , 15.500 , 14.200 ,
- $ 15.500 , 17.500 , 20.000 , 23.000 , 26.000 ,
- $ 20.000 , 23.000 , 26.500 , 32.000 , 35.000 ,
- $ 28.500 , 22.000 , 22.500 , 23.500 , 24.000 ,
- $ 24.500 , 26.000 , 27.500 , 27.500 , 27.000 ,
- $ 26.500 , 25.500 , 25.000 , 23.000 , 22.500 ,
- $ 22.200 , 22.000 , 22.000 , 21.200 , 20.700 ,
- $ 21.000 /
- DATA (CSIN(10,J),J=1,41) /
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.50000 , 1.5000 , 2.7000 , 3.8000 , 4.8000 ,
- $ 6.5000 , 7.6000 , 8.4000 , 9.0000 , 9.4000 ,
- $ 9.8000 , 10.500 , 11.000 , 11.500 , 11.800 ,
- $ 12.200 , 12.400 , 12.600 , 13.200 , 13.500 ,
- $ 13.700 , 14.000 , 14.200 , 14.500 , 16.400 ,
- $ 17.000 /
- DATA (CSIN(11,J),J=1,41) /
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.50000 , 1.5000 , 2.7000 , 3.8000 , 4.8000 ,
- $ 6.5000 , 7.6000 , 8.4000 , 9.0000 , 9.4000 ,
- $ 9.8000 , 10.500 , 11.000 , 11.500 , 11.800 ,
- $ 12.200 , 12.400 , 12.600 , 13.200 , 13.500 ,
- $ 13.700 , 14.000 , 14.200 , 14.500 , 16.400 ,
- $ 17.000 /
- DATA (CSIN(12,J),J=1,41) /
- $ 266.67 , 133.33 , 83.333 , 57.083 , 44.500 ,
- $ 33.250 , 24.583 , 20.833 , 18.333 , 16.083 ,
- $ 15.625 , 15.083 , 14.833 , 15.083 , 15.833 ,
- $ 17.042 , 18.958 , 20.758 , 22.533 , 22.825 ,
- $ 21.250 , 18.567 , 17.767 , 18.100 , 19.933 ,
- $ 20.783 , 21.225 , 21.000 , 20.558 , 20.258 ,
- $ 20.017 , 19.767 , 19.600 , 19.183 , 18.850 ,
- $ 18.575 , 18.350 , 18.175 , 17.808 , 17.558 ,
- $ 19.250 /
- DATA (CSIN(13,J),J=1,41) /
- $ 400.00 , 200.00 , 120.00 , 81.000 , 62.000 ,
- $ 47.000 , 35.000 , 28.000 , 24.000 , 21.000 ,
- $ 19.500 , 19.000 , 18.800 , 19.000 , 20.000 ,
- $ 21.000 , 23.000 , 25.000 , 27.000 , 27.500 ,
- $ 25.500 , 22.000 , 20.800 , 21.000 , 23.000 ,
- $ 24.000 , 24.000 , 23.800 , 23.000 , 22.500 ,
- $ 22.000 , 21.600 , 21.400 , 21.000 , 20.500 ,
- $ 20.200 , 19.800 , 19.500 , 18.600 , 17.500 ,
- $ 20.000 /
- DATA (CSIN(14,J),J=1,41) /
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.10000 , 1.5000 ,
- $ 7.0000 , 12.000 , 17.000 , 19.500 , 20.500 ,
- $ 22.000 , 23.500 , 24.800 , 25.800 , 26.500 ,
- $ 27.000 , 27.500 , 28.000 , 30.000 , 31.000 ,
- $ 32.000 , 32.500 , 32.500 , 33.000 , 33.500 ,
- $ 34.000 /
- DATA (CSIN(15,J),J=1,41) /
- $ 1500.0 , 1160.0 , 310.00 , 230.00 , 178.00 ,
- $ 153.00 , 134.00 , 124.00 , 113.00 , 106.00 ,
- $ 101.00 , 96.000 , 92.000 , 89.000 , 87.000 ,
- $ 84.000 , 81.000 , 78.500 , 76.500 , 75.000 ,
- $ 72.000 , 70.000 , 68.000 , 64.500 , 63.000 ,
- $ 62.000 , 61.000 , 59.500 , 58.500 , 56.500 ,
- $ 56.500 , 56.000 , 55.500 , 52.000 , 50.000 ,
- $ 48.000 , 45.000 , 44.000 , 39.200 , 34.500 ,
- $ 34.500 /
- DATA (CSIN(16,J),J=1,41) /
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.10000 , 1.5000 ,
- $ 7.0000 , 12.000 , 17.000 , 19.500 , 20.500 ,
- $ 22.000 , 23.500 , 24.800 , 25.800 , 26.500 ,
- $ 27.000 , 27.500 , 28.000 , 30.000 , 31.000 ,
- $ 32.000 , 32.500 , 32.500 , 33.000 , 33.500 ,
- $ 34.000 /
- DATA (CSIN(17,J),J=1,41) /
- $ 1394.1 , 948.17 , 262.43 , 197.14 , 149.30 ,
- $ 127.25 , 110.39 , 101.79 , 92.834 , 87.104 ,
- $ 83.109 , 79.099 , 75.965 , 73.627 , 72.161 ,
- $ 69.889 , 67.595 , 65.595 , 64.057 , 63.054 ,
- $ 61.377 , 60.434 , 59.485 , 56.970 , 55.931 ,
- $ 55.398 , 54.827 , 53.538 , 52.861 , 51.247 ,
- $ 51.344 , 50.992 , 50.644 , 47.876 , 46.358 ,
- $ 44.887 , 42.577 , 41.815 , 38.180 , 34.254 ,
- $ 34.418 /
- DATA (CSIN(18,J),J=1,41) /
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.97815E-01, 1.4577 ,
- $ 6.2052 , 10.112 , 12.902 , 14.300 , 14.688 ,
- $ 15.505 , 16.379 , 17.554 , 18.309 , 18.920 ,
- $ 19.389 , 19.804 , 20.284 , 22.000 , 22.733 ,
- $ 23.527 , 24.097 , 24.382 , 24.816 , 26.800 ,
- $ 27.719 /
- DATA (CSIN(19,J),J=1,41) /
- $ 1182.4 , 524.50 , 167.30 , 131.43 , 91.895 ,
- $ 75.743 , 63.184 , 57.376 , 52.502 , 49.313 ,
- $ 47.326 , 44.762 , 43.222 , 42.015 , 41.221 ,
- $ 40.244 , 39.504 , 39.145 , 38.860 , 38.731 ,
- $ 37.987 , 37.814 , 36.326 , 34.750 , 33.953 ,
- $ 33.635 , 33.349 , 32.938 , 32.785 , 32.092 ,
- $ 32.373 , 32.312 , 32.329 , 31.261 , 30.597 ,
- $ 30.073 , 29.228 , 29.182 , 27.683 , 27.107 ,
- $ 27.956 /
- DATA (CSIN(20,J),J=1,41) /
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.97815E-01, 1.4577 ,
- $ 6.2052 , 10.112 , 12.902 , 14.300 , 14.688 ,
- $ 15.505 , 16.379 , 17.554 , 18.309 , 18.920 ,
- $ 19.389 , 19.804 , 20.284 , 22.000 , 22.733 ,
- $ 23.527 , 24.097 , 24.382 , 24.816 , 26.800 ,
- $ 27.719 /
- DATA (CSIN(21,J),J=1,41) /
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00/
- DATA (CSIN(22,J),J=1,41) /
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.97815E-01, 1.4577 ,
- $ 6.2052 , 10.112 , 12.902 , 14.300 , 14.688 ,
- $ 15.505 , 16.379 , 17.554 , 18.309 , 18.920 ,
- $ 19.389 , 19.804 , 20.284 , 22.000 , 22.733 ,
- $ 23.527 , 24.097 , 24.382 , 24.816 , 26.800 ,
- $ 27.719 /
- DATA (CSIN(23,J),J=1,41) /
- $ 1394.1 , 948.17 , 262.43 , 197.14 , 149.30 ,
- $ 127.25 , 110.39 , 101.79 , 92.834 , 87.104 ,
- $ 83.109 , 78.563 , 75.292 , 72.760 , 70.900 ,
- $ 68.467 , 66.314 , 64.955 , 63.746 , 62.623 ,
- $ 59.233 , 56.946 , 53.355 , 49.810 , 48.090 ,
- $ 46.839 , 45.695 , 44.863 , 44.062 , 42.599 ,
- $ 42.684 , 42.328 , 42.041 , 39.508 , 37.880 ,
- $ 36.299 , 34.075 , 33.553 , 29.723 , 27.600 ,
- $ 28.120 /
- DATA (CSIN(24,J),J=1,41) /
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00/
- DATA (CSIN(25,J),J=1,41) /
- $ 1182.4 , 524.50 , 167.30 , 131.43 , 91.895 ,
- $ 75.743 , 63.184 , 57.376 , 52.502 , 49.313 ,
- $ 47.326 , 44.762 , 43.222 , 42.015 , 41.221 ,
- $ 40.244 , 39.504 , 39.145 , 38.860 , 38.731 ,
- $ 37.987 , 37.814 , 36.326 , 34.750 , 33.953 ,
- $ 33.635 , 33.349 , 32.938 , 32.785 , 32.092 ,
- $ 32.373 , 32.312 , 32.329 , 31.261 , 30.597 ,
- $ 30.073 , 29.228 , 29.182 , 27.683 , 27.107 ,
- $ 27.956 /
- DATA (CSIN(26,J),J=1,41) /
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.95639E-01, 1.4154 ,
- $ 5.4104 , 8.2240 , 8.8031 , 9.1000 , 8.8761 ,
- $ 9.0095 , 9.2576 , 10.307 , 10.818 , 11.341 ,
- $ 11.778 , 12.108 , 12.569 , 14.000 , 14.467 ,
- $ 15.054 , 15.694 , 16.263 , 16.632 , 20.100 ,
- $ 21.438 /
- DATA (CSIN(27,J),J=1,41) /
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.95639E-01, 1.4154 ,
- $ 5.4104 , 8.2240 , 8.8031 , 9.1000 , 8.8761 ,
- $ 9.0095 , 9.2576 , 10.307 , 10.818 , 11.341 ,
- $ 11.778 , 12.108 , 12.569 , 14.000 , 14.467 ,
- $ 15.054 , 15.694 , 16.263 , 16.632 , 20.100 ,
- $ 21.438 /
- DATA (CSIN(28,J),J=1,41) /
- $ 1182.4 , 524.50 , 167.30 , 131.43 , 91.895 ,
- $ 75.743 , 63.184 , 57.376 , 52.502 , 49.313 ,
- $ 47.326 , 44.225 , 42.549 , 41.148 , 39.960 ,
- $ 38.822 , 38.223 , 38.505 , 38.549 , 38.301 ,
- $ 35.843 , 34.326 , 30.196 , 27.590 , 26.112 ,
- $ 25.076 , 24.217 , 24.264 , 23.985 , 23.445 ,
- $ 23.713 , 23.647 , 23.726 , 22.892 , 22.119 ,
- $ 21.485 , 20.726 , 20.921 , 19.226 , 20.454 ,
- $ 21.658 /
- DATA (CSIN(29,J),J=1,41) /
- $ 1076.5 , 312.66 , 119.74 , 98.571 , 63.193 ,
- $ 49.990 , 39.579 , 35.168 , 32.335 , 30.417 ,
- $ 29.434 , 27.325 , 26.514 , 25.775 , 25.120 ,
- $ 24.711 , 24.818 , 25.600 , 26.106 , 26.355 ,
- $ 25.220 , 24.760 , 21.681 , 20.060 , 19.044 ,
- $ 18.474 , 18.044 , 18.301 , 18.347 , 18.192 ,
- $ 18.557 , 18.639 , 18.870 , 18.769 , 18.478 ,
- $ 18.372 , 18.302 , 18.735 , 18.206 , 20.207 ,
- $ 21.576 /
- DATA (CSIN(30,J),J=1,41) /
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00/
- DATA (CSIN(31,J),J=1,41) /
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00/
- DATA (CSIN(32,J),J=1,41) /
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00/
- DATA (CSIN(33,J),J=1,41) /
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.95639E-01, 1.4154 ,
- $ 5.4104 , 8.2240 , 8.8031 , 9.1000 , 8.8761 ,
- $ 9.0095 , 9.2576 , 10.307 , 10.818 , 11.341 ,
- $ 11.778 , 12.108 , 12.569 , 14.000 , 14.467 ,
- $ 15.054 , 15.694 , 16.263 , 16.632 , 20.100 ,
- $ 21.438 /
- DATA (CSIN(34,J),J=1,41) /
- $ 1076.5 , 312.66 , 119.74 , 98.571 , 63.193 ,
- $ 49.990 , 39.579 , 35.168 , 32.335 , 30.417 ,
- $ 29.434 , 27.325 , 26.514 , 25.775 , 25.120 ,
- $ 24.711 , 24.818 , 25.600 , 26.106 , 26.355 ,
- $ 25.220 , 24.760 , 21.681 , 20.060 , 19.044 ,
- $ 18.474 , 18.044 , 18.301 , 18.347 , 18.192 ,
- $ 18.557 , 18.639 , 18.870 , 18.769 , 18.478 ,
- $ 18.372 , 18.302 , 18.735 , 18.206 , 20.207 ,
- $ 21.576 /
- DATA (CSIN(35,J),J=1,41) /
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00/
- DATA (CSPIEL( 1,J),J=1,41) /
- $ 0.00000E+00, 350.00 , 580.00 , 600.00 , 550.00 ,
- $ 450.00 , 410.00 , 370.00 , 340.00 , 230.00 ,
- $ 220.00 , 205.00 , 180.00 , 155.00 , 145.00 ,
- $ 140.00 , 160.00 , 195.00 , 235.00 , 250.00 ,
- $ 270.00 , 280.00 , 300.00 , 300.00 , 290.00 ,
- $ 285.00 , 265.00 , 240.00 , 230.00 , 222.00 ,
- $ 204.00 , 196.00 , 190.00 , 170.00 , 170.00 ,
- $ 160.00 , 150.00 , 140.00 , 120.00 , 80.000 ,
- $ 80.000 /
- DATA (CSPIEL( 2,J),J=1,41) /
- $ 0.00000E+00, 700.00 , 1000.0 , 1200.0 , 1300.0 ,
- $ 1300.0 , 1250.0 , 1250.0 , 1100.0 , 1000.0 ,
- $ 940.00 , 740.00 , 700.00 , 670.00 , 660.00 ,
- $ 670.00 , 680.00 , 700.00 , 735.00 , 800.00 ,
- $ 810.00 , 820.00 , 820.00 , 810.00 , 800.00 ,
- $ 800.00 , 700.00 , 600.00 , 500.00 , 470.00 ,
- $ 440.00 , 410.00 , 380.00 , 330.00 , 330.00 ,
- $ 330.00 , 330.00 , 330.00 , 285.00 , 240.00 ,
- $ 240.00 /
- DATA (CSPIEL( 3,J),J=1,41) /
- $ 0.00000E+00, 1700.0 , 2200.0 , 2200.0 , 1800.0 ,
- $ 1300.0 , 1200.0 , 900.00 , 900.00 , 1000.0 ,
- $ 1100.0 , 1300.0 , 1400.0 , 1420.0 , 1490.0 ,
- $ 1560.0 , 1580.0 , 1690.0 , 1795.0 , 2000.0 ,
- $ 2070.0 , 2140.0 , 2050.0 , 2010.0 , 1970.0 ,
- $ 1880.0 , 1690.0 , 1500.0 , 1420.0 , 1390.0 ,
- $ 1350.0 , 1360.0 , 1370.0 , 1280.0 , 1290.0 ,
- $ 1295.0 , 1250.0 , 1200.0 , 1050.0 , 900.00 ,
- $ 900.00 /
- DATA (CSPIIN( 1,J),J=1,41) /
- $ 0.00000E+00, 200.00 , 320.00 , 500.00 , 600.00 ,
- $ 600.00 , 590.00 , 530.00 , 510.00 , 470.00 ,
- $ 430.00 , 425.00 , 420.00 , 425.00 , 425.00 ,
- $ 430.00 , 430.00 , 435.00 , 435.00 , 440.00 ,
- $ 430.00 , 430.00 , 420.00 , 420.00 , 420.00 ,
- $ 415.00 , 415.00 , 410.00 , 410.00 , 408.00 ,
- $ 406.00 , 404.00 , 400.00 , 380.00 , 340.00 ,
- $ 340.00 , 340.00 , 340.00 , 340.00 , 340.00 ,
- $ 340.00 /
- DATA (CSPIIN( 2,J),J=1,41) /
- $ 0.00000E+00, 400.00 , 800.00 , 1000.0 , 1100.0 ,
- $ 1200.0 , 1150.0 , 1050.0 , 1000.0 , 900.00 ,
- $ 860.00 , 860.00 , 850.00 , 850.00 , 840.00 ,
- $ 830.00 , 820.00 , 810.00 , 805.00 , 800.00 ,
- $ 800.00 , 800.00 , 800.00 , 800.00 , 800.00 ,
- $ 800.00 , 800.00 , 800.00 , 800.00 , 780.00 ,
- $ 760.00 , 740.00 , 720.00 , 720.00 , 700.00 ,
- $ 690.00 , 680.00 , 670.00 , 665.00 , 660.00 ,
- $ 660.00 /
- DATA (CSPIIN( 3,J),J=1,41) /
- $ 0.00000E+00, 1000.0 , 1900.0 , 2600.0 , 2900.0 ,
- $ 3000.0 , 2800.0 , 2600.0 , 2500.0 , 2300.0 ,
- $ 2200.0 , 2000.0 , 1900.0 , 1880.0 , 1860.0 ,
- $ 1840.0 , 1820.0 , 1810.0 , 1805.0 , 1800.0 ,
- $ 1780.0 , 1760.0 , 1750.0 , 1740.0 , 1730.0 ,
- $ 1720.0 , 1710.0 , 1700.0 , 1680.0 , 1660.0 ,
- $ 1650.0 , 1640.0 , 1630.0 , 1620.0 , 1610.0 ,
- $ 1605.0 , 1600.0 , 1600.0 , 1550.0 , 1500.0 ,
- $ 1500.0 /
- DATA (CSPNEL( 1,J),J=1,41) /
- $ 2100.0 , 1800.0 , 1500.0 , 1050.0 , 900.00 ,
- $ 950.00 , 800.00 , 650.00 , 570.00 , 390.00 ,
- $ 300.00 , 240.00 , 230.00 , 230.00 , 220.00 ,
- $ 220.00 , 225.00 , 225.00 , 240.00 , 240.00 ,
- $ 290.00 , 330.00 , 335.00 , 350.00 , 355.00 ,
- $ 370.00 , 350.00 , 330.00 , 310.00 , 290.00 ,
- $ 270.00 , 265.00 , 260.00 , 230.00 , 210.00 ,
- $ 210.00 , 200.00 , 200.00 , 190.00 , 180.00 ,
- $ 180.00 /
- DATA (CSPNEL( 2,J),J=1,41) /
- $ 3800.0 , 2900.0 , 1850.0 , 1550.0 , 1450.0 ,
- $ 1520.0 , 1460.0 , 1300.0 , 1140.0 , 880.00 ,
- $ 700.00 , 620.00 , 540.00 , 560.00 , 460.00 ,
- $ 460.00 , 470.00 , 470.00 , 480.00 , 480.00 ,
- $ 580.00 , 600.00 , 610.00 , 620.00 , 620.00 ,
- $ 620.00 , 590.00 , 580.00 , 460.00 , 440.00 ,
- $ 420.00 , 400.00 , 480.00 , 430.00 , 380.00 ,
- $ 380.00 , 380.00 , 380.00 , 380.00 , 380.00 ,
- $ 380.00 /
- DATA (CSPNEL( 3,J),J=1,41) /
- $ 7000.0 , 6000.0 , 4500.0 , 3350.0 , 2700.0 ,
- $ 3000.0 , 3550.0 , 3970.0 , 3280.0 , 2490.0 ,
- $ 2100.0 , 1510.0 , 1440.0 , 1370.0 , 1370.0 ,
- $ 1370.0 , 1400.0 , 1400.0 , 1420.0 , 1420.0 ,
- $ 1440.0 , 1460.0 , 1460.0 , 1450.0 , 1450.0 ,
- $ 1470.0 , 1400.0 , 1400.0 , 1380.0 , 1370.0 ,
- $ 1360.0 , 1350.0 , 1340.0 , 1330.0 , 1320.0 ,
- $ 1310.0 , 1305.0 , 1300.0 , 1300.0 , 1300.0 ,
- $ 1300.0 /
- DATA (CSPNIN( 1,J),J=1,41) /
- $ 0.00000E+00, 200.00 , 400.00 , 800.00 , 800.00 ,
- $ 550.00 , 500.00 , 450.00 , 430.00 , 410.00 ,
- $ 400.00 , 390.00 , 380.00 , 370.00 , 370.00 ,
- $ 370.00 , 365.00 , 365.00 , 360.00 , 360.00 ,
- $ 360.00 , 360.00 , 365.00 , 370.00 , 375.00 ,
- $ 380.00 , 400.00 , 410.00 , 420.00 , 430.00 ,
- $ 440.00 , 440.00 , 440.00 , 440.00 , 440.00 ,
- $ 440.00 , 440.00 , 440.00 , 440.00 , 440.00 ,
- $ 440.00 /
- DATA (CSPNIN( 2,J),J=1,41) /
- $ 0.00000E+00, 400.00 , 950.00 , 1050.0 , 1050.0 ,
- $ 980.00 , 940.00 , 900.00 , 860.00 , 820.00 ,
- $ 800.00 , 780.00 , 760.00 , 740.00 , 740.00 ,
- $ 740.00 , 730.00 , 730.00 , 720.00 , 720.00 ,
- $ 720.00 , 720.00 , 730.00 , 740.00 , 750.00 ,
- $ 760.00 , 800.00 , 820.00 , 820.00 , 820.00 ,
- $ 820.00 , 820.00 , 820.00 , 820.00 , 820.00 ,
- $ 820.00 , 820.00 , 820.00 , 820.00 , 820.00 ,
- $ 820.00 /
- DATA (CSPNIN( 3,J),J=1,41) /
- $ 0.00000E+00, 0.00000E+00, 500.00 , 1450.0 , 1700.0 ,
- $ 1800.0 , 1750.0 , 1730.0 , 1720.0 , 1710.0 ,
- $ 1700.0 , 1690.0 , 1660.0 , 1630.0 , 1630.0 ,
- $ 1630.0 , 1600.0 , 1600.0 , 1580.0 , 1580.0 ,
- $ 1580.0 , 1580.0 , 1600.0 , 1630.0 , 1650.0 ,
- $ 1670.0 , 1760.0 , 1800.0 , 1800.0 , 1800.0 ,
- $ 1800.0 , 1800.0 , 1800.0 , 1800.0 , 1800.0 ,
- $ 1800.0 , 1800.0 , 1800.0 , 1800.0 , 1800.0 ,
- $ 1800.0 /
- DATA ELAB /
- $ 0.10000E-03, 0.20000E-03, 0.30000E-03, 0.40000E-03, 0.50000E-03,
- $ 0.70000E-03, 0.10000E-02, 0.20000E-02, 0.30000E-02, 0.40000E-02,
- $ 0.50000E-02, 0.70000E-02, 0.10000E-01, 0.15000E-01, 0.20000E-01,
- $ 0.25000E-01, 0.32700E-01/
- DATA CNLWAT /
- $ 1.0000 , 16.000 , 27.000 , 56.000 , 59.000 ,
- $ 64.000 , 91.000 , 112.00 , 119.00 , 127.00 ,
- $ 137.00 , 181.00 , 207.00 , 209.00 , 238.00 /
- DATA (CNLWEL( 1,J),J=1,17) /
- $ 6000.0 , 5500.0 , 5200.0 , 4900.0 , 4800.0 ,
- $ 4400.0 , 4000.0 , 2900.0 , 2200.0 , 1800.0 ,
- $ 1400.0 , 1100.0 , 900.00 , 700.00 , 600.00 ,
- $ 560.00 , 520.00 /
- DATA (CNLWEL( 2,J),J=1,17) /
- $ 5400.0 , 5050.0 , 4800.0 , 4600.0 , 4399.0 ,
- $ 4090.0 , 3700.0 , 2600.0 , 1950.0 , 1600.0 ,
- $ 1300.0 , 900.00 , 700.00 , 800.00 , 1050.0 ,
- $ 1250.0 , 1320.0 /
- DATA (CNLWEL( 3,J),J=1,17) /
- $ 5500.0 , 5150.0 , 4900.0 , 4699.0 , 4490.0 ,
- $ 4150.0 , 3750.0 , 2790.0 , 2100.0 , 1650.0 ,
- $ 1300.0 , 950.00 , 800.00 , 860.00 , 1000.0 ,
- $ 1090.0 , 1080.0 /
- DATA (CNLWEL( 4,J),J=1,17) /
- $ 5499.0 , 4970.0 , 4450.0 , 4080.0 , 3750.0 ,
- $ 3380.0 , 2900.0 , 2400.0 , 2380.0 , 2350.0 ,
- $ 2300.0 , 2100.0 , 1720.0 , 1370.0 , 1200.0 ,
- $ 1060.0 , 870.00 /
- DATA (CNLWEL( 5,J),J=1,17) /
- $ 5399.0 , 4710.0 , 4180.0 , 3760.0 , 3460.0 ,
- $ 3150.0 , 2730.0 , 2270.0 , 1850.0 , 1850.0 ,
- $ 2130.0 , 2330.0 , 2120.0 , 1640.0 , 1310.0 ,
- $ 1100.0 , 1050.0 /
- DATA (CNLWEL( 6,J),J=1,17) /
- $ 5099.0 , 4405.0 , 3825.0 , 3455.0 , 3125.0 ,
- $ 2695.0 , 2350.0 , 1850.0 , 1580.0 , 1820.0 ,
- $ 2050.0 , 2210.0 , 2000.0 , 1590.0 , 1310.0 ,
- $ 1120.0 , 1040.0 /
- DATA (CNLWEL( 7,J),J=1,17) /
- $ 6290.0 , 5960.0 , 5640.0 , 5370.0 , 5150.0 ,
- $ 4800.0 , 4250.0 , 3150.0 , 2470.0 , 2100.0 ,
- $ 2230.0 , 2420.0 , 2450.0 , 2050.0 , 1760.0 ,
- $ 1550.0 , 1330.0 /
- DATA (CNLWEL( 8,J),J=1,17) /
- $ 6885.0 , 6650.0 , 6350.0 , 6150.0 , 6000.0 ,
- $ 5700.0 , 5360.0 , 4250.0 , 2800.0 , 1870.0 ,
- $ 1810.0 , 1820.0 , 2170.0 , 2450.0 , 2150.0 ,
- $ 1700.0 , 1390.0 /
- DATA (CNLWEL( 9,J),J=1,17) /
- $ 6600.0 , 6500.0 , 6400.0 , 6249.0 , 6190.0 ,
- $ 5950.0 , 5520.0 , 4250.0 , 2750.0 , 1900.0 ,
- $ 1850.0 , 1950.0 , 2340.0 , 2800.0 , 2540.0 ,
- $ 2100.0 , 1760.0 /
- DATA (CNLWEL(10,J),J=1,17) /
- $ 7400.0 , 7200.0 , 6999.0 , 6840.0 , 6655.0 ,
- $ 6320.0 , 5820.0 , 4400.0 , 2850.0 , 2000.0 ,
- $ 1800.0 , 1800.0 , 2150.0 , 2600.0 , 2350.0 ,
- $ 1950.0 , 2100.0 /
- DATA (CNLWEL(11,J),J=1,17) /
- $ 7900.0 , 7700.0 , 7499.0 , 7390.0 , 7202.0 ,
- $ 6810.0 , 6360.0 , 4920.0 , 3450.0 , 2600.0 ,
- $ 2200.0 , 1950.0 , 2300.0 , 2800.0 , 2650.0 ,
- $ 2250.0 , 2050.0 /
- DATA (CNLWEL(12,J),J=1,17) /
- $ 7900.0 , 7750.0 , 7699.0 , 7590.0 , 7450.0 ,
- $ 7200.0 , 6850.0 , 5650.0 , 4400.0 , 3700.0 ,
- $ 3400.0 , 2800.0 , 2700.0 , 3100.0 , 3250.0 ,
- $ 3100.0 , 2750.0 /
- DATA (CNLWEL(13,J),J=1,17) /
- $ 6100.0 , 5950.0 , 5750.0 , 5599.0 , 5440.0 ,
- $ 5200.0 , 4800.0 , 4300.0 , 5800.0 , 5750.0 ,
- $ 4800.0 , 3420.0 , 2650.0 , 3200.0 , 3650.0 ,
- $ 3500.0 , 2980.0 /
- DATA (CNLWEL(14,J),J=1,17) /
- $ 6100.0 , 5950.0 , 5750.0 , 5599.0 , 5440.0 ,
- $ 5200.0 , 4800.0 , 4300.0 , 5800.0 , 5750.0 ,
- $ 4800.0 , 3420.0 , 2650.0 , 3200.0 , 3650.0 ,
- $ 3500.0 , 2980.0 /
- DATA (CNLWEL(15,J),J=1,17) /
- $ 6600.0 , 6350.0 , 6100.0 , 5899.0 , 5690.0 ,
- $ 5300.0 , 4850.0 , 4450.0 , 5650.0 , 5700.0 ,
- $ 4950.0 , 3850.0 , 3050.0 , 3050.0 , 3460.0 ,
- $ 3650.0 , 3340.0 /
- DATA (CNLWIN( 1,J),J=1,17) /
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00/
- DATA (CNLWIN( 2,J),J=1,17) /
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 1.0000 ,
- $ 10.000 , 50.000 , 100.00 , 200.00 , 300.00 ,
- $ 400.00 , 600.00 , 700.00 , 750.00 , 700.00 ,
- $ 700.00 , 680.00 /
- DATA (CNLWIN( 3,J),J=1,17) /
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 1.0000 , 10.000 ,
- $ 50.000 , 100.00 , 260.00 , 450.00 , 600.00 ,
- $ 700.00 , 800.00 , 900.00 , 940.00 , 900.00 ,
- $ 860.00 , 820.00 /
- DATA (CNLWIN( 4,J),J=1,17) /
- $ 1.0000 , 80.000 , 200.00 , 320.00 , 400.00 ,
- $ 520.00 , 700.00 , 1000.0 , 1120.0 , 1200.0 ,
- $ 1200.0 , 1200.0 , 1180.0 , 1130.0 , 1100.0 ,
- $ 1090.0 , 1080.0 /
- DATA (CNLWIN( 5,J),J=1,17) /
- $ 1.0000 , 90.000 , 220.00 , 340.00 , 420.00 ,
- $ 550.00 , 720.00 , 1080.0 , 1300.0 , 1400.0 ,
- $ 1420.0 , 1420.0 , 1380.0 , 1260.0 , 1190.0 ,
- $ 1150.0 , 1100.0 /
- DATA (CNLWIN( 6,J),J=1,17) /
- $ 1.0000 , 95.000 , 225.00 , 345.00 , 425.00 ,
- $ 555.00 , 750.00 , 1150.0 , 1500.0 , 1680.0 ,
- $ 1700.0 , 1690.0 , 1550.0 , 1360.0 , 1240.0 ,
- $ 1180.0 , 1120.0 /
- DATA (CNLWIN( 7,J),J=1,17) /
- $ 10.000 , 140.00 , 260.00 , 380.00 , 450.00 ,
- $ 600.00 , 750.00 , 1200.0 , 1580.0 , 1800.0 ,
- $ 1820.0 , 1830.0 , 1800.0 , 1750.0 , 1690.0 ,
- $ 1650.0 , 1620.0 /
- DATA (CNLWIN( 8,J),J=1,17) /
- $ 15.000 , 150.00 , 300.00 , 400.00 , 500.00 ,
- $ 650.00 , 840.00 , 1500.0 , 2100.0 , 2130.0 ,
- $ 2140.0 , 2130.0 , 2080.0 , 2000.0 , 1950.0 ,
- $ 1900.0 , 1860.0 /
- DATA (CNLWIN( 9,J),J=1,17) /
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 1.0000 , 10.000 ,
- $ 150.00 , 380.00 , 1000.0 , 1650.0 , 2100.0 ,
- $ 2100.0 , 2100.0 , 2060.0 , 1950.0 , 1860.0 ,
- $ 1800.0 , 1740.0 /
- DATA (CNLWIN(10,J),J=1,17) /
- $ 0.00000E+00, 0.00000E+00, 1.0000 , 10.000 , 45.000 ,
- $ 180.00 , 380.00 , 1050.0 , 1900.0 , 2300.0 ,
- $ 2300.0 , 2200.0 , 2150.0 , 2000.0 , 1900.0 ,
- $ 1800.0 , 1750.0 /
- DATA (CNLWIN(11,J),J=1,17) /
- $ 0.00000E+00, 0.00000E+00, 1.0000 , 10.000 , 48.000 ,
- $ 190.00 , 390.00 , 1080.0 , 2000.0 , 2400.0 ,
- $ 2400.0 , 2300.0 , 2200.0 , 2100.0 , 1950.0 ,
- $ 1850.0 , 1800.0 /
- DATA (CNLWIN(12,J),J=1,17) /
- $ 0.00000E+00, 0.00000E+00, 1.0000 , 10.000 , 50.000 ,
- $ 200.00 , 400.00 , 1100.0 , 2100.0 , 2500.0 ,
- $ 2500.0 , 2450.0 , 2300.0 , 2100.0 , 2000.0 ,
- $ 1900.0 , 1850.0 /
- DATA (CNLWIN(13,J),J=1,17) /
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 1.0000 , 10.000 ,
- $ 100.00 , 350.00 , 900.00 , 1400.0 , 2000.0 ,
- $ 2300.0 , 2380.0 , 2400.0 , 2300.0 , 2250.0 ,
- $ 2200.0 , 2120.0 /
- DATA (CNLWIN(14,J),J=1,17) /
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 1.0000 , 10.000 ,
- $ 100.00 , 350.00 , 900.00 , 1400.0 , 2000.0 ,
- $ 2300.0 , 2380.0 , 2400.0 , 2300.0 , 2250.0 ,
- $ 2200.0 , 2120.0 /
- DATA (CNLWIN(15,J),J=1,17) /
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 1.0000 , 10.000 ,
- $ 100.00 , 400.00 , 950.00 , 1600.0 , 2200.0 ,
- $ 2550.0 , 2750.0 , 2700.0 , 2600.0 , 2540.0 ,
- $ 2450.0 , 2360.0 /
- DATA (CSCAP(J),J=1,50) /
- $ 6.0000 , 5.7000 , 5.5000 , 5.3000 , 5.2000 ,
- $ 5.1000 , 5.0000 , 4.9000 , 4.8000 , 4.8000 ,
- $ 4.8000 , 4.8000 , 4.8000 , 4.8000 , 4.8000 ,
- $ 4.8000 , 4.9000 , 5.0000 , 5.2000 , 5.5000 ,
- $ 6.0000 , 6.7000 , 7.5000 , 8.5000 , 10.000 ,
- $ 12.000 , 14.500 , 19.000 , 26.500 , 40.000 ,
- $ 75.000 , 120.00 , 180.00 , 260.00 , 360.00 ,
- $ 330.00 , 60.000 , 7.0000 , 9.5000 , 20.000 ,
- $ 75.000 , 140.00 , 250.00 , 360.00 , 480.00 ,
- $ 580.00 , 590.00 , 500.00 , 300.00 , 100.00 /
- DATA (CSCAP(J),J=51,100) /
- $ 200.00 , 300.00 , 400.00 , 470.00 , 500.00 ,
- $ 430.00 , 100.00 , 20.000 , 22.000 , 40.000 ,
- $ 560.00 , 950.00 , 1000.0 , 1000.0 , 1000.0 ,
- $ 990.00 , 920.00 , 860.00 , 790.00 , 740.00 ,
- $ 650.00 , 600.00 , 540.00 , 470.00 , 440.00 ,
- $ 390.00 , 360.00 , 340.00 , 320.00 , 310.00 ,
- $ 280.00 , 2.0000 , 2.5000 , 6.0000 , 13.000 ,
- $ 38.000 , 65.000 , 140.00 , 280.00 , 300.00 ,
- $ 430.00 , 580.00 , 650.00 , 800.00 , 920.00 ,
- $ 1100.0 , 1250.0 , 1400.0 , 1550.0 , 1700.0 /
- DATA EKFISS /
- $ 0.10000E-03, 0.20000E-03, 0.30000E-03, 0.50000E-03, 0.70000E-03,
- $ 0.10000E-02, 0.15000E-02, 0.20000E-02, 0.30000E-02, 0.50000E-02,
- $ 0.70000E-02, 0.10000E-01, 0.15000E-01, 0.20000E-01, 0.50000E-01,
- $ 0.10000 , 0.20000 , 0.30000 , 0.40000 , 0.50000 ,
- $ 1000.0 /
- DATA (CSFISS( 1,J),J=1,21) /
- $ 2600.0 , 2300.0 , 2300.0 , 2100.0 , 2000.0 ,
- $ 1950.0 , 1930.0 , 1900.0 , 1800.0 , 1600.0 ,
- $ 2100.0 , 2300.0 , 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00/
- DATA (CSFISS( 2,J),J=1,21) /
- $ 1850.0 , 1400.0 , 1300.0 , 1150.0 , 1100.0 ,
- $ 1200.0 , 1250.0 , 1300.0 , 1250.0 , 1150.0 ,
- $ 1600.0 , 1900.0 , 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00/
- DATA (CSFISS( 3,J),J=1,21) /
- $ 1700.0 , 1650.0 , 1650.0 , 1700.0 , 1700.0 ,
- $ 1800.0 , 1900.0 , 2000.0 , 1950.0 , 1800.0 ,
- $ 2150.0 , 2450.0 , 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00/
- DATA (CSFISS( 4,J),J=1,21) /
- $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
- $ 0.00000E+00, 250.00 , 550.00 , 550.00 , 550.00 ,
- $ 550.00 , 550.00 , 1000.0 , 1400.0 , 1600.0 ,
- $ 1500.0 , 1400.0 , 1300.0 , 1200.0 , 1100.0 ,
- $ 1000.0 /
-C --- END OF CROSS SECTION DATA STATEMENTS ---
-C
-+KEEP,PCODIM.
-C --- DIMENSION STMTS. FOR GEANT/GHEISHA PARTICLE CODE CONVERSIONS ---
-C --- KIPART(I)=GHEISHA CODE CORRESPONDING TO GEANT CODE I ---
-C --- IKPART(I)=GEANT CODE CORRESPONDING TO GHEISHA CODE I ---
-C
- DIMENSION KIPART(48),IKPART(35)
-C
-+KEEP,PCODAT.
-C --- DATA STMTS. FOR GEANT/GHEISHA PARTICLE CODE CONVERSIONS ---
-C --- KIPART(I)=GHEISHA CODE CORRESPONDING TO GEANT CODE I ---
-C --- IKPART(I)=GEANT CODE CORRESPONDING TO GHEISHA CODE I ---
-C
- DATA KIPART/
- $ 1, 3, 4, 2, 5, 6, 8, 7,
- $ 9, 12, 10, 13, 16, 14, 15, 11,
- $ 35, 18, 20, 21, 22, 26, 27, 33,
- $ 17, 19, 23, 24, 25, 28, 29, 34,
- $ 35, 35, 35, 35, 35, 35, 35, 35,
- $ 35, 35, 35, 35, 30, 31, 32, 35/
-C
- DATA IKPART/
- $ 1, 4, 2, 3, 5, 6, 8, 7,
- $ 9, 11, 16, 10, 12, 14, 15, 13,
- $ 25, 18, 26, 19, 20, 21, 27, 28,
- $ 29, 22, 23, 30, 31, 45, 46, 47,
- $ 24, 32, 48/
-C
-+PATCH,PAMEND.
-*
diff --git a/src/car/geant.car b/src/car/geant.car
deleted file mode 120000
index 1c3fd65..0000000
--- a/src/car/geant.car
+++ /dev/null
@@ -1 +0,0 @@
-geant321.car
\ No newline at end of file
diff --git a/src/car/geant321.car b/src/car/geant321.car
deleted file mode 100644
index 24d6c9d..0000000
--- a/src/car/geant321.car
+++ /dev/null
@@ -1,4527 +0,0 @@
-+TITLE.
-C GEANT 3.21/11 10/02/98 17.58.14 CERN PROGRAM LIBRARY GEANT = W5013
-+PATCH,$VERSION.
-+DECK,V3_21.
-*CMZ : 3.21/10 13/11/97 17.58.14 by S.Giani
-*-- Author :
-*
-*::> VERSION 3.21/04 21/03/95 17.58.14
-*
-*
-*::> VERSION 3.21/03 17/10/94 16.00.29
-*
-*
-*::> VERSION 3.21/02 25/07/94 15.24.16
-*
-*
-*::> VERSION 3.21/01 28/03/94 16.10.10
-*
-*
-*::> VERSION 3.21/00 28/02/94 16.32.43
-*
-**********************************************************************
-* *
-* G E A N T 3 . 2 1 *
-* *
-* C E R N *
-* *
-* 15/3/94 Geneva CH *
-* *
-**********************************************************************
-*
-* GEANT 3.21 has a new tracking logic to speed up the search over the
-* volumes positioned inside a given node (Virtual Divisions).
-* The new tracking is initialized by GGCLOS in a completely
-* transparent way and in a negligible amount of time.
-* The GUNEAR and GSORD techniques are automatically disabled
-* and no change in the user code is needed. Anyway, it is
-* still possible to get the old Geant tracking recompiling
-* GEANT and GEANG with the patchy flag OLD.
-* To implement the new logic, the following routines have
-* written or deeply modified: GTNEXT, GGCLOS, GTMEDI, GNEXT,
-* GMEDIA, GINVOL, GVDCAR, GVDRAD, GVDPHI, GVDLIM, GSCVOL.
-* S.Giani.
-*
-* GEANT 3.21 has a new logic for MANY volumes: the tracking is not
-* based anymore on a step-search, but relies on a algorithm
-* similar to the one used for ONLY volumes (giving then
-* basically the same speed obtained for ONLY). The new logic
-* of MANY allows boolean operations between volumes, clipping
-* of protuding objects, divisions along arbitrary axis,
-* overlaps of 1-D structures to build 2-D or 3-D structures
-* (like honeycombs, spaghetti, etc.). To implement the new
-* logic, the following routines have been written or modified:
-* GTNEXT, GTMEDI, GNEXT, GMEDIA, GTELEC, GTCKOV, GTHADR,
-* GTHION, GTMUON.
-* S.Giani.
-*
-* GEANT 3.21 contains modifications to GTELEC, GTGAMA, GDRAY in order
-* to exploit the e.m. low energy effects introduced in 3.16
-* without any overhead in performance compared with 3.15.
-* A bug in the delta ray productions is now fixed.
-* Thanks to L.Urban.
-*
-* GEANT 3.21 provides a ray-tracing as a new visualization tool. The
-* ray-tracing is based on the new Geant tracking and allows
-* the visualization of the boolean operations results.
-* The following routines have been written or modified:
-* GDRACK, GDSTEP, GDNINO, GDOPT, GDRAYT, GDRAW, GDINIT,
-* GTRIG, GTRIGI, GDKINE, GDLUMI, GLIGHT, GFIND, GXDRAW,
-* CDF.
-* S.Giani.
-*
-* A new GGPERP has been written to cope with almost all the shapes.
-* It is now of general utility both for the Cerenkovs
-* and for the ray-tracing.
-* Thanks to R.Jones.
-*
-* A new set of routines to compute distances to surfaces has been
-* introduced (GVSAFE, GVGRAD, GVPSQR, GVSIGN, GVLONG).
-* Thanks to V.Perev.
-*
-* Important fix in GPHYSI: user words for media were overwriting
-* ILABS, ISYNC and ISTRA.
-* Thanks to S.Giani, S.Ravndal.
-*
-* GXOBJ has been improved to handle DETs as objects of a SET directory
-* in the HITS class.
-* Thanks to S.Giani, A.Dellacqua.
-*
-* GTNINO has been corrected in order to print the mechanism NEXT when
-* crossing boundaries.
-* Thanks to S.Giani, M.Maire.
-*
-* GFMFIN and GFMDIS are the new names for the 316 routines FMUFIN and
-* FMDIST to avoid clashes with the program library. GFMFIN has
-* also been corrected for a 316 bug affecting neutrons.
-* Thanks to C.Zeitniz,K.Lassila,S.Ravndal.
-*
-* GINTRP and GINPCO have been corrected to handle sharp edges with no
-* risk of float exception.
-* Thanks to L.Gibbons.
-*
-* GGPERP has been corrected in reading the TRAP parameters and a systematic
-* consistency of single precision or double precision variables in
-* the MAX,MIN,MOD operands is provided.
-* Thanks to S.Ravndal.
-*
-* FEREVV and FERHAV are now new from FLUKA.
-* Thanks to A.Ferrari.
-*
-* FEREVV has been adapted to the Geant random numbers generators.
-* Thanks to S.Ravndal.
-*
-* In GRNDMQ the option `SH' is provided to write the seeds ISEED1 and
-* ISEED2 to the event header bank.
-* Thanks to S.Ravndal.
-*
-* In GMORIN,FLINIT and GHEINI the interface messages are removed.
-* Thanks to S.Ravndal.
-*
-* In GGDPAR now PAR(3) is correctly initialized to 1.for slices of
-* a PGON.
-*
-*
-* The seq GCNUM has been added to the deck ERTRGO in Geane.
-*
-*
-*
-* G321X and G321M are the new names for the KUIP output of the CDF.
-* Thanks to S.Giani.
-*
-* GMORIN has been modified in order to read correctly xsneut.dat
-* for MSDOS and WINNT as well.
-* Thanks to V.Fine.
-*
-* GEAMON has been modified in order to print Real and CPU Time longer
-* than 999 sec.
-* Thanks to R.Brun.
-*
-*
-**********************************************************************
-* *
-* G E A N T 3 . 2 1 *
-* *
-* Correction cradle 0.01 *
-* *
-* C E R N *
-* *
-* 29/3/94 Geneva CH *
-* *
-**********************************************************************
-*
-* GZINIT and GSCKOV have been corrected (compared with 3.16) in order
-* to initialize correctly the link area for the Zebra pointers
-* of the banks relative to straggling, Cerenkovs, Asho, etc.
-* Four pointers were not seen by Mzlint and, moreover, the link
-* area (containing pointers for straggling, etc.) was initialized
-* only if using Cerenkovs.
-* Thanks to M.Verzocchi and R.Brun.
-*
-* FERHAV in Geanf was provoking a float exception due to a negative sqrt.
-* The problem was fixed thanks to a comparison with the original
-* Fluka code.
-* Thanks to B.Slater and S.Giani.
-*
-* PREPRE has been deoptimized on HP.
-* Thanks to A.Kulik.
-*
-* In GSKINE a pointer was not saved (in the previous versions as well).
-* Thanks to A.Dellacqua.
-*
-* In GTNEXT and GNEXT precision problems are handled more effectively.
-* Thanks to P.Ward, C.Markou and S.Giani.
-*
-* In GTNEXT the blocking of the volume from which particles are exiting
-* has been corrected.
-* Thanks to P.Ward.
-*
-* Problems in the interactive materials, mixtures and media definition
-* have been solved. (Routines GXCONT,GXGEOM). Idem for the 3D
-* Dspec (routine GXDRAW).
-*
-* In order to handle correctly calls to Gfcoor in phi (for x=0 or y=0)
-* GTMEDI, GMEDIA and GINVOL have been modified.
-* Thanks to P.Ward.
-*
-* In the ray-tracing, GDNINO has been corrected for precision problems.
-* Thanks to S.Giani.
-*
-*
-**********************************************************************
-* *
-* G E A N T 3 . 2 1 *
-* *
-* Correction cradle 0.02 *
-* *
-* C E R N *
-* *
-* 25/7/94 Geneva CH *
-* *
-**********************************************************************
-*
-* In GTNEXT precision problems in phi have been solved.
-* Thanks to A.Rosowsky and A.Givernaud.
-*
-* In GDRAY a missing protection for delta ray production was added.
-* Thanks to L.Urban.
-*
-* In GINVOL the variable ingt is corrrectly reset. It was not reset in
-* all the previous versions of GEANT as well.
-* Thanks to R.Jones.
-*
-* GTCKOV, GTHADR, GTHION, GLISUR have been corrected and extended compared
-* with the first implementation in 3.16 for Cerenkov tracking.
-* Thanks to R.Jones.
-*
-* GSKPHO has been fixed for Cerenkov physics compared with the previous
-* version of GEANT (3.16).
-* Thanks to S.Bottai.
-*
-* GFTMAT had a wrong pointer to plot the muon-nucleus cross sections since
-* version 3.16. Now it is fixed.
-* Thanks to C.Wiebusch and S.Ravndal.
-*
-* GFINDS has been restored to the 3.15 functionality.
-* Thanks to A.Dellacqua and S.Tonse.
-*
-* GFANG has been fixed for a special pathological case.
-* Thanks to C.Zosi.
-*
-* GSROTM has been fixed for a special pathological case.
-* Thanks to A.Vlassov.
-*
-* GDRAYT does not increment ievent anymore.
-* Thanks to P.Jacobs.
-*
-* GLVOLU has been fixed to recompute the pointers of the geometrical tree
-* even if the names and numbers were identical.
-* Thanks to R.Jones, T.Noble, S.Ravndal.
-*
-* GVDRAD has been fixed to compute the scope of tubs.
-* Thanks to K.Albiol and S.Giani.
-*
-* GDSPEC has been fixed to print degrees for the 3-rd parameter of sphe.
-* Thanks to S.Ravndal.
-*
-* GVDPHI has been fixed for a special pathological case (only for volumes
-* with planar surfaces).
-* Thanks to M.Kaspar and S.Giani.
-*
-* GXCONT is changed to handle correctly the variables ievent and nevent.
-* Thanks to P.Jacobs.
-*
-* SVGAM7 in Gheisha has now a protection against the log(0).
-* Thanks to D.Heck.
-*
-* FEREVV and FERHAV have been updated.
-* Thanks to A.Ferrari.
-*
-* In FLUFIN the correct mechanism is given to lmec in case of energy
-* below cut-off.
-* Thanks to B.Slater and S.Ravndal.
-*
-* In NUDISV the array anpowr is saved.
-* Thanks to S.Ravndal.
-*
-* In GMXSEC imed is used instead of nmed.
-* Thanks to K.L.Perini.
-*
-*
-*
-**********************************************************************
-* *
-* G E A N T 3 . 2 1 *
-* *
-* Correction version 0.03 = 94b release *
-* *
-* C E R N *
-* *
-* 18/10/94 Geneva CH *
-* *
-**********************************************************************
-*
-* In GDCGVW traslation problems have been fixed (graphics).
-* Thanks to J.Stepanek, S.Giani.
-*
-* In GLTRAC nlevel is now initialized to 0 and GTNEXT has been improved
-* further for handling precision problems.
-* Thanks to A.Dellacqua.
-*
-* GDRELX and GTELEC have been corrected for energy deposition problems.
-* Thanks to L.Urban.
-*
-* GSDVT2 has been corrected for divisions in phi.
-* Thanks to V.Popov.
-*
-* GPVOLU and GFMOTH are now able to handle cases where copy number = 1
-* is not defined.
-* Thanks to S.Giani, S.Nowak.
-*
-* GTREVE has been changed in order to avoid the loading of the graphics
-* package if not desired.
-* Thanks to S.Giani, I.Bird.
-*
-* GUPHAD, GUHADR and FLINIT give warnings and conditions for the use of FLUKA.
-* Thanks to A.Ferrari.
-*
-* GVDPHI and GVDCAR have been further improved to compute the scope of pgon.
-* Thanks to P.Kent.
-*
-* GTELEC now computes cross sections for SYNC only if there is mag. field.
-* Thanks to M.Maire.
-*
-* GPCXYZ printing format can now handle bigger dimensions.
-* Thanks to S.Ravndal.
-*
-* GDRMAT and GPRMAT headers are now consistent with GFTMAT. In GPLMAT `STEP'
-* and `RANGE' do not belong anymore to `ALL' as physical processes.
-* Thanks to M.Maire, S.Ravndal.
-*
-* GPHYSI is now setting dray=0 if loss=0. Labs, Sync and Stra can be switched
-* interactively. Decay and Sync are now also defined in vacuum.
-* Thanks to M.Maire, S.Ravndal.
-*
-* In GRNDMQ the ' ' and the 'G' options work now as described in the doc.
-* Thanks to S.ONeale, S.Ravndal.
-*
-* GPART calls GSDK anyhow to give flexibility at run time (for the interactive
-* version). The values relatives to the particles are now updated to
-* Phys.Rev. D50 1173 1994.
-* Thanks to S.Ravndal, F.H.Heinsius.
-*
-* In GDEXCA (Cadint) a bug from 316 is now fixed.
-* Thanks to J.Vuoskosky.
-*
-* GBREME and GSYNC (see the new doc for the meaning of sync=0,1,2,3) have
-* been improved and the two relative mechanism can happen at the same time.
-* Thanks to M.Maire.
-*
-*
-*
-**********************************************************************
-* *
-* G E A N T 3 . 2 1 *
-* *
-* Correction version 0.10 = 98 release *
-* *
-* C E R N *
-* *
-* 28/3/95 Geneva CH *
-* *
-**********************************************************************
-*
-* In GTCKOV the variable RIN1 is not reset to 0 any longer.
-* Thanks to A.Delpozo
-*
-* In GSTRAC heavy ions have now the correct itrtyp=8.
-* Thanks to Yfwang
-*
-* In GTNEXT the variable SNXT and SNXNEW are compared with BIG1 to cure
-* precision problems.
-* Thanks to A.Dellacqua, P.Ward.
-*
-* In GPVOLU and GPVOLX the variable MOTHER is now declared as CHARACTER*4.
-* Thanks to V.Tretyak
-*
-* In GGCLOS a test on IQUEST(11).le.0 has been changed into IQUEST(11).lt.0.
-* Thanks to P.Ward
-*
-* In GLTRAC nlevel is reset to 0 only if GONLY(NLEVEL).EQ.0.
-* Thanks to P.Ward, S.Giani
-*
-* In GDCGOB a bug on the unit for the angles of spheres has been fixed.
-* Thanks to J.Allison
-*
-* GPRMAT is now protected against floating point exceptions.
-* Thanks to R.Ruber
-*
-* GRNDMQ has been improved storing the seeds.
-* Thanks to S.Ravndal.
-*
-* In GTNINO the time of flight is now updated.
-* Thanks to S.Ravndal.
-*
-* In GXPHYS, GXCS, the interactive facilities have been extended.
-* Thanks to M.Maire
-*
-* GPCXYZ has a corrected format to print.
-* Thanks to S.Ravndal
-*
-* A GUXCS dummy routine has been created to extend the interactive use of COMIS.
-* Thanks to M.Maire.
-*
-* GDPRTR is now able to recognize b/w Xterminals before drawing the tree.
-* Thanks to S.Giani, B.Lorazo.
-*
-* GLVOLU has been corrected in the computation of GTRAN for the slices of
-* divided volumes.
-* Thanks to S.Giani.
-*
-* GXGEOM now allows correctly the definition of the basic shapes interactively.
-* Thanks to S.Giani.
-*
-* GETVER and GINIT are improved to extract and print automatically the version.
-* Thanks to M.Maire.
-*
-* GFTMAT and GPLMAT have been corrected in plotting the cross sections.
-* Thanks to S.Ravndal, G.Zholobov.
-*
-* GLANDZ has been protected against floating point exceptions.
-* Thanks to L.Urban, B.Fox.
-*
-* GLUDKY contains now the time of interaction (Lund).
-* Thanks to S.Ravndal, C.Wiebusch.
-*
-* GPAIRG has been protected against undefined values for the variable X.
-* Thanks to L.Urban, H.Ihssen.
-*
-* GINIT, GFFGO and GTELEC are modified in order to include a new data card,
-* ABAN, which allows to follow the electrons down to the cuts value even
-* when they are not doing physics (ABAN=0) or to propagate them up to the
-* end-point with an optimized algorithm (ABAN=2). The default is ABAN=1
-* (normal 3.21 behaviour).
-* Thanks to L.Urban, S.Ravndal.
-*
-* BRTTP has been protected in case the file flukaaf.dat is not found.
-* Thanks to S.Ravndal.
-*
-* GMORIN has been modified and GMISET has been created in order to interface
-* to the new version of Micap (from Gcalor 1.03.08) which has been introduced
-* in GEANM.
-* Thanks to S.Ravndal.
-*
-* GPRSGG and GBRSGE have been modified to assume constant cross sections
-* above 100 GeV both for pair production and for bremsstrahlung.
-* Thanks to G.Battistoni, L.Urban.
-*
-* GVDPHI has been corrected and improved for the scope computation of tubes,
-* cons and polycons which are rotated and translated at the same time.
-* Thanks to S.Giani, J.P.Vialle.
-
-+DECK,V3_16.
-*CMZ : 29/03/94 15.41.18 by S.Giani
-*-- Author :
-*
-*::> VERSION 3.16/00 07/12/93 14.33.29
-*
-+DECK,V3_15.
-*CMZ : 29/03/94 15.41.18 by S.Giani
-*-- Author :
-*
-*::> VERSION 3.15/09 920408 13.02
-*
-*
-* ************************************************************
-* * *
-* * *
-* * G E A N T Version 3.15 *
-* * *
-* * O F F I C I A L R E L E A S E *
-* * *
-* * CERN, Geneva, April 7, 1992 *
-* * *
-* * *
-* * *
-* ************************************************************
-*
-*
-*::> VERSION 3.15/08 920401 8.41
-*
-*
-*::> VERSION 3.15/07 920331 9.42
-*
-*
-*::> VERSION 3.15/06 920331 8.01
-*
-*
-*::> VERSION 3.15/05 920329 15.41
-*
-*
-*::> VERSION 3.15/04 920329 13.45
-*
-*
-*::> VERSION 3.15/03 920327 18.49
-*
-*
-*::> VERSION 3.15/02 920316 12.53
-*
-*
-*::> VERSION 3.15/01 920316 10.18
-*
-* Prerelease stamping of 3.15
-*
-+DECK,V3_14.
-*CMZ : 29/03/94 15.41.18 by S.Giani
-*-- Author :
-*
-*::> VERSION 3.14/16 901107 15.23
-*
-* See PATCH,HISTORY for the description of version 3.14
-*
-
-+DECK,V3_13.
-*CMZ : 29/03/94 15.41.18 by S.Giani
-*-- Author :
-*
-*::> VERSION 3.13/05 890628 15.01
-*
-* See PATCH,HISTORY for the description of version 3.14
-*
-+PATCH,HISTORY
-+DECK,BLANKDEK.
-*CMZ : 3.21/02 29/03/94 15.41.18 by S.Giani
-*-- Author :
-*
-*
-* ************************************************
-* * *
-* * G E A N T version 3.16 *
-* * *
-* * Official R E L E A S E *
-* * ============================== *
-* * *
-* ************************************************
-*
-+DECK,V_313.
-*CMZ : 3.21/02 29/03/94 15.41.18 by S.Giani
-*-- Author :
-*
-*::> VERSION 3.13/05 890628 15.01
-*
-* Changes in GTELEC,GTHADR and GTMUON for overstopping tracks.
-* STEP and SLENG correction optimized
-* In COMMON/GCDRAW/ variable IGVIEW changed to IDVIEW
-* Routine GTRMUL recoded
-* DOUBLE precision in GINTCO and protection added.
-* Changes in GNOPG6.
-* Changes in GINME (for spheres,tubes and cones DPP.LE.0)
-* GDINIT called by GXINT
-* Particle data table updated in GPART
-* Tests on boundary conditions for IEKBIN modified in GTGAMA
-* A new user callable routine GBIRK introduced in GPHYS.
-* GBIRK may be called from GUSTEP to compute the Birk
-* correction factors for anorganic scintillators.
-*
-*::> VERSION 3.13/04 890623 12.34
-*
-* New version of GLANDZ and GPOISS by L.Urban
-* GRNDM calling sequence changed
-* Sequence numbers (1-->215) can be initialized
-* with data card RNDM
-* Ex:
-* RNDM 9876 1234534 initializes sequence 1
-* RNDM 45 initilizes sequence 45 with the starting
-* seed of sequence 45
-* New routine GRANOR (copy of RANNOR for GRNDM)
-*
-*::> VERSION 3.13/03 890425 12.09
-*
-* Update of inline documentation DOCGBASE,DOCGKINE,DOCGTRAK
-* Deck GGCLOS modified and moved from GGEOM to GBASE
-* New deck GHCLOS (called by GGCLOS) in GBASE
-* Deck GEVKEV moved from GTRAK to GCONS
-* New decks GFNDIG,GFNHIT,GRHITS in GHITS
-* Minor bug corrected in GTELEC
-* Control of debug and removal of SNXT=BIG in GTNEXT
-* Call to GUSTEP removed from GUVIEW
-*
-*::> VERSION 3.13/02 890311 10.45
-*
-* Bug corrected in GPAIRM (COMMON/GCMATE/ overwritten
-* Bug corrected in outines GDRELM and GDRELP
-* (error in AVO changed to AVOGAD)
-* Minor corrections in physics routines
-* SAVE statements added
-* Protection in GHANGL
-* Default changed to GHEISHA instead of TATINA
-* in routines GUPHAD and GUHADR
-* Bug corrected in GHTATI (NAMEC(12) instead of NAMEC(10)
-*
-+DECK,V_314.
-*CMZ : 3.21/02 29/03/94 15.41.18 by S.Giani
-*-- Author :
-C
-C
-C ************************************************
-C * *
-C * G E A N T version 3.14.16 *
-C * *
-C * Official R e l e a s e *
-C * ============================== *
-C * *
-C ************************************************
-C
-C
-C
-* The version 3.14 of GEANT is being released. Apart from a few
-* features, reported below, the new version is compatible with the
-* previous version 3.13. Substantial developments have taken place,
-* in particular in the physics and tracking areas.
-*
-* In addition to the GEANT team
-* (R.Brun:CERN/CN-AS, F.Bruyant:CERN/ECP-PI and M.Maire:LAPP),
-* many people have contributed to the new version, especially
-* - a large number of users of the previous version who reported
-* their experience, found bugs and suggested several improvements,
-* - the guinea-pigs of 3.14 who gave us essential comments during
-* our attempt to automatize computation of the tracking parameters.
-* ** A.Givernaud (UA1), F.Nessi, V.Vercesi(UA2/LHC)
-* ** The LHC proto collaborations
-* - H.Fesefelt(Aachen) has provided a new version of the GHEISHA
-* package with help from N.Van Eijndhoven (CERN/CN-AS)
-* - H.J Trost from ANL has reported problems in the muon-nuclear
-* interactions routines and provided the relevant corrections.
-* - P.Pedroni (Pavia) has implemented a new interface called
-* by GHEISHA for low-energy hadronic processes (See NUCRIN below).
-* - the contributors to the geometry package:
-* for the introduction of new shapes
-* ELTU by A.Solano (ZEUS)
-* HYPE by M.Corden (ALEPH and SSC)
-* CTUB by A.McPherson (CEBAF)
-* for systematic investigation of problems with the old shapes
-* R.Nierhaus (CERN/CN-AS)
-* - S.Egli (H1) has proposed an automatic optimisation for the
-* geometry at initialisation time.
-* - G.Lynch from Berkeley has investigated the multiple-scattering
-* various strategies and proposed a new algorithm.
-* - A.Rotondi and P.Montagna have proposed a new technique for the
-* fast generation of Vavilov distribution.
-* K.S.Koelbig (CERN/CN-AS) has implemented a new routine GVAVIV
-* based on their work.
-* - J.Salt (CERN/CN-AS) has implemented the graphics interface to the
-* CG package from Serpukhov with the help of E.Chernaev.
-* - The IBM team (C.Guerin, M.Roelisberger) have investigated how
-* to speed-up the program. Their work has been coordinated
-* by F.Carminati (CERN/CN-AS).
-*
-* GEANT3.14 documentation
-* =======================
-* The printing of a new manual describing the new version is
-* scheduled for the end of this year. The CERN Program Library
-* will not distribute anymore the old document (version 3.11).
-*
-*
-* Important notice to GEANT users
-* ===============================
-*
-* Following the reorganisation of the CERN research divisions
-* in July 90, R.Brun is now in charge of the Application Software
-* group (AS) in the CN division and F.Bruyant is in charge of the
-* Production support and computers Infrastructure group (PI) in the
-* ECP division. They will nevertheless continue, with M.Maire, to be
-* actively involved in the development of GEANT. Federico Carminati
-* is the coordinator of a simulation software unit in the CN-AS group.
-* Users are strongly recommended to address their questions,etc
-* directly to him (email: FCA at CERNVM.CERN.CH on BITNET). In particular,
-* feedback from users making comparisons with real data will be most
-* appreciated.
-*
-* The simulation team is preparing the ground for the next version
-* of GEANT. In view of the proposed new accelerators, the following
-* items are considered with high priority:
-* - Parametrization techniques. A survey of the various methods
-* used in current experiments has been done and the implementation
-* of a new algorithm based on the GSCAN geometry + GFLASH (H1)
-* is in progress.
-* - Improvements in the geometry package. General shape definition,
-* surface based algorithms.
-* - Detector data structure and data base. Interface with CAD systems.
-* - Parallelism (at event level and below).
-*
-*
-*......................................................................
-*
-* *** Compatibility with version 3.13
-* ===============================
-* - If COMMON blocks GCMULO or/and GCJLOC were included in the
-* user code, the new GEANT sequences GCMULO and GCJLOC must be
-* inserted and the code recompiled.
-* - Initialisation data structures saved with the previous versions
-* cannot be read by the new version, because the binning for
-* the cross-sections and energy loss tables has been changed.
-* - The GCPHYS variables SOLOSS,STLOSS,SOMULS,STMULS are no more
-* defined (see comments below)
-* - The GCTRAK variable IDECAD is replaced by IGAUTO
-*
-*
-* *** MAIN CHANGES IN THE TRACKING PROCEDURES
-* =======================================
-*
-* The tracking control routines GTGAMA,GTELEC,GTHADR,GTNEUT,GTMUON
-* have been largely rewritten to reflect the changes to the energy-loss
-* and multiple scattering processes.
-*
-*
-* *** The ENERGY RANGE of the cross section and energy loss tables can
-* be fixed by the user with the new data card :
-* 'ERANG' EKMIN EKMAX NKBIN
-* which defines nkbin bins from Ekmin to Ekmax in a logarithmic scale.
-* The default is, as before, 90 bins from 10 Kev to 10 Tev but in
-* logarithmic scale. NKBIN must be 50<NKBIN<200.
-*
-* WARNING 1 : as a consequence the common GCMULO has been changed.
-* User applications referencing GCMULO must be recompiled.
-*
-* WARNING 2 : as a consequence the ZEBRA data structure JMATE
-* contains now cross-sections and energy loss tables based on the new
-* energy range. Structures saved by previous versions of GEANT cannot
-* be used by the new version.
-*
-* WARNING 3 : changing the 'ERANG' data card arguments requires to
-* recreate the initialisation data structures.
-*
-* WARNING 4 : for Hadrons, GEANT tabulates the energy-loss tables
-* for a proton-kinetic energy equivalent. As a consequence, the value
-* given for EKMAX must be at least 7 times the maximum kinetic energy
-* of particles to be tracked (ratio proton/pion mass).
-* For LHC/SSC simulations, we recommend ERANG 1.E-5 1.E+5 100
-* The recommended value for NKBIN is 10*LOG10(EKMAX/EKBIN).
-*
-*
-* *** The MEAN STOPPING RANGE of a charged particle (STOPMX) is computed and
-* tabulated as a function of the kinetic energy (routine GRANGI).
-* There are tables for electrons, muons, protons. The others particles are
-* scaled from the proton table.
-* As for the other tabulated quantities, the Stopping Range can be displayed
-* with the routines GPLMAT and/or GPRMAT (keyword 'RANG').
-*
-* During the tracking, the MEAN ENERGY LOSS over a given step (DEMEAN) is
-* computed from the difference of the stopping range before and after the
-* transport of the particle.
-*
-*
-* *** ENERGY LOSS STRAGGLING : when ILOSS=2 (default) the Landau/Vavilov
-* fluctuations are applied to the mean energy loss over the step.
-* The VAVILOV distribution has been improved so that the fluctuations are
-* less dependent on the step size.
-*
-* ILOSS=1 is now equivalent to ILOSS=3 i.e. restricted fluctuations are
-* applied together with delta-ray production (see routine GLANDZ).
-* The user who wish to inhibit the energy fluctuations must set ILOSS=4
-* The latter option has been kept for debug purpose only.
-*
-*
-* *** MULTIPLE SCATTERING. The calculation of the step size (SMULS) is new :
-* Bethe criterion taken into account, limitation of step size at low
-* energy (see routine GMULOF).
-*
-* New routine GMULTS : depending on the step size the Moliere distribution,
-* or its gaussian approximation, is used.
-*
-* The routines GMOLI, GMOLIE (ex Gmol), GMOLS have been slightly modified.
-*
-* In the routine GMGAUS (ex Gmuls), we use a new sigma (G. Lynch LBL-28165).
-* The lateral displacement has been deleted. As a consequence the tracking
-* parameter DMAXMS is not used anymore for the control of the step size.
-* DMAXMS.LE.0 forces no multiple scattering at all in the medium.
-*
-* New routine GMCOUL : for very small steps single Coulomb scatters are
-* generated instead of Moliere distribution.
-*
-* By default (IMULS=1) GEANT will select automatically the algorithm to use
-* (GMCOUL, GMOLIE or GMGAUS).
-*
-*
-* *** NEW ROUTINE GMULOF. The step for energy loss (SLOSS), the step for
-* multiple scattering (SMULS), and the step for the curvature in a magnetic
-* field (SFIELD) can be precomputed and tabulated, at least for electrons
-* and muons. The routine GMULOF, called from GPHYSI, tabulates:
-* SMULOF = MIN ( SMULS , SLOSS , SFIELD )
-* which is the effective step due to the "continuous processes".
-* SMULOF can be displayed with the routines GPLMAT/GPRMAT, keyword 'STEP'.
-*
-*
-* *** Multiple scattering and energy loss computations are systematically
-* applied at each step during tracking. Therefore the GCPHYS variables
-* SOLOSS, STLOSS, SOMULS, STMULS are OBSOLETE. However, for backward
-* compatibility with 3.13, STLOSS is set equal to STEP.
-*
-*
-* *** TRACKING PARAMETERS STMIN and DEEMAX.
-*
-* The meaning of STMIN is the following : at low energy (below 1 Mev) the
-* multiple scattering condition can induce a very small step SMULOF.
-* On the other hand the Stopping Range is also small. Therefore, if the
-* Stopping Range is smaller than STMIN, the constraint SMULOF is ignored.
-* The exact condition is :
-* IF (SMULOF.LE.STMIN) SMULOF = MIN ( STOPMX, STMIN )
-* STMIN is no more than an accelerator factor for the stopping particles.
-*
-* The DEEMAX parameter remains the main tracking parameter. It governs the
-* precision of the tracking by limitating SMULOF.
-*
-*
-* *** AUTOMATIC COMPUTATION of STMIN and DEEMAX.
-*
-* By default Geant3.14 overwrites STMIN and DEEMAX. The STMIN default value
-* correspond to a stopping range of 200 Kev above CUTELE.
-* The default for DEEMAX follows the following algorithm:
-* - For non-sensitive volumes (ISVOL=0) DEEMAX is set to 0.25 for
-* materials with a radiation length x0<2cm
-* and DEEMAX=0.25-0.2/sqrt(x0) for other materials.
-* - For sensitive volumes (ISVOL.NE.0) DEEMAX=0.2/sqrt(x0)
-* These values have been tuned empirically on a variety of setups.
-*
-* A new data card 'AUTO' has been implemented :
-* Setting 'AUTO' 1 is equivalent to NO data card, i.e. automatic computation
-* Setting 'AUTO' 0 : NO automatic computation, EXCEPT if STMIN and/or DEEMAX
-* has been given a negative value by the user.
-*
-* WARNING : The default values above have been found reasonable for any kind
-* of medium. The unexperienced user is invited to start with automatic
-* computation. Please check the actual parameters by calling GPRINT ('TMED'
-* after the call to GPHYSI.
-*
-* We STRONGLY recommend to always run in AUTO mode (default). The AUTO
-* mode makes GEANT a predictive tool if all parameters are automatically
-* computed by the system as opposed to tuning data and Monte Carlo
-* via the tracking parameters.
-*
-* *** GPHYSI
-* The routine GPHYSI has been improved to include additional protections
-* and to take into account the changes due to the new energy-range tables.
-* It must be noted that is mandatory to always call GPHYSI at the end
-* of the initialisation phase even when initialisation data structures
-* are read from a file.
-*
-* *** GPIONS
-* This new routine (a complement to GPART) defines a subset of the most
-* common "stable" elements in the nature.
-* GPIONS can be called at the initialisation stage after GPART. It creates
-* particles with GEANT identifiers 61 to 112.
-* GPIONS has been written for the heavy ions experiments in view of an
-* interface with the program FRITIOF which is being developed by
-* P.Gorodetzky (Strasbourg).
-*
-* *** GDEBUG
-* This new user callable routine from GUSTEP will take the following actions
-* if the flag IDEBUG=1:
-*
-* IF(IDEBUG.NE.0) THEN
-* IF((ISWIT(2).EQ.1).OR.(ISWIT(3).EQ.1)) CALL GSXYZ ! store point in JXYZ
-* IF (ISWIT(2).EQ.2) CALL GPCXYZ ! step by step printed debug
-* IF (ISWIT(1).EQ.2) CALL GPGKIN ! list of particles generated during step
-* IF (ISWIT(2).EQ.3) THEN
-* IF(ISWIT(4).EQ.3.AND.CHARGE.EQ.0.)RETURN
-* CALL GDCXYZ ! interactive drawing of trajectories
-* ENDIF
-* ENDIF
-*
-* *** New user callable routine GBIRK to take into account BIRK's factors.
-* ====================================================================
-* This new routine is callable from the GUSTEP routine. EDEP=DESTEP
-* if no Birk factors have been given via GSTPAR.
-* SUBROUTINE GBIRK(EDEP)
-*
-* *** apply BIRK's saturation law to energy deposition ***
-* *** only organic scintillators implemented in this version MODEL=1
-*
-* Note : the material is assumed ideal, which means that impurities
-* and aging effects are not taken into account
-*
-* algorithm : edep = destep / (1. + RKB*dedx + C*(dedx)**2)
-*
-* the values of RKB and C can be entered via :
-*
-* call gstpar(imate,'BIRK1',value) to set the model (value= 1. or 2.)
-* call gstpar(imate,'BIRK2',value) to set RKB
-* call gstpar(imate,'BIRK3',value) to set C
-*
-* the basic units of the coefficient are g/(Mev*cm**2)
-* because the de/dx is obtained in Mev/cm
-*
-* exp. values from NIM 80 (1970) 239-244 :
-*
-* RKB = 0.013 g/mev*cm**2 and C = 9.6e-6 g**2/(Mev**2)(cm**4)
-*
-*
-*
-*
-* *** GEANH news
-*
-*
-* a serious bug in GMUNUI has been reported by
-* Hans-Jochen Trost from ANL:
-* : convert millibarns to cm**2 by a factor 10**-27
-* and obtain therefore NA * 1 millibarn/cm**2 a
-* factor 10 smaller than in the code. Hans has verified
-* that the original code gives to high an energy loss
-* due to muon-nuclear interactions on iron by a fac-
-* tor of about 5-10, comparing to W.Lohmann et al.,
-* CERN 85-03 whose predictions have recently been
-* verified by CCFR data up to 1.2 TeV.
-* Hans has also introduced protections in GMUNU.
-*
-* A new version of the GHEISHA package has been introduced by
-* H.Fesefelt (contact him for details).
-*
-* The TATINA package is considered obsolete. Default routines
-* GUPHAD/GUHADR call GHEISHA. We are planning to remove the code
-* of TATINA in the coming versions of GEANT.
-*
-*
-* *** NUCRIN: A new model for hadronic showers at low energies
-* ========================================================
-*
-*
-* NUCRIN (see ref.1) simulates hadron-nucleus ( A > 3) inelastic
-* interactions from a few MeV/c up to about 4.5 GeV/c laboratory
-* momentum of the incoming particle.
-* NUCRIN is automatically called by the GHEISHA routine GHEISH
-* when the flag IHADR=3 (set by data card HADR).
-* It is assumed that these reactions are the superimposition of three
-* basic processes:
-*
-* (a) inelastic collision of the projectile hadron (allowed particles are :
-* p,pbar,n,nbar,pi0,pi+,pi-,k+,k-,k0,k0bar,lamda0,lamda0bar,sigma+,
-* sigma-,sigma0) with a target nucleon in the nucleus.
-* This interaction is simulated,taking into account of the nucleon
-* Fermi momentum, using HADRIN (see ref.2) program.
-* The corresponding physical model is based on the experimental evidence
-* that, in the selected momentum range,the inelastic cross section shows
-* the typical threshold and resonance behaviour of meson production:
-* the primary hadron-nucleon system is excited to an isobaric state
-* which then decays into hadrons or other resonances.
-*
-* If the interacting nucleus is hydrogen,HADRIN can also be used
-* in a separate way to simulate hadron-proton reaction.
-*
-* (b) induced intranuclear cascade with resulting proton and neutron
-* emission;
-*
-* (c) nuclear evaporation and deexcitation from residual nucleus. At the
-* output the total energy available for these processes is given as
-* "excitation energy".
-*
-* The mean excitation and cascade energies and the average multiplicities
-* of cascade particles are parametrized, according to experimental
-* distributions.
-* In each event their value are sampled from gaussian distribution:
-* if they fall in the permitted kinematical region, energy and types of
-* cascade nucleons are calculated and the remaining energy is assigned to
-* the incoming particle.
-* For hadron-nucleon interactions all relevant kinematic variables are
-* Lorentz-trasformed into the target nucleon rest system. If interaction
-* kinetic energy is greater than the total available collision energy
-* a new Fermi momentun is sampled, otherwise an event is generated with
-* HADRIN,in which decays modes of 107 particle and resonances into about
-* 450 different channels are tabulated and outgoing particle directions
-* and momenta are chosen to reproduced experimental momentum transfer
-* distributions.
-* Final state particles kinematical variables are transformed back into
-* laboratory system; reaction and sampled event energies are again compared:
-* if their difference is negative, energy is not conserved and generation
-* has to be started once more with a new Fermi momentum sampling or if it
-* is,on the contrary positive, particle momenta and energies are corrected
-* to reach conservation.
-* The sampled events conserve the energy, the momentum, the electric and
-* baryonic charge and the strangeness.
-* NUCRIN and HADRIN are initialised, by default, before event generation,
-* with a call to subroutines HADDEN and CHANWX which estabilish internal
-* weight tables and decay channels.
-*
-* -----------------------------------------------------------------------
-* (1) K. Hanssgen, J. Ranft , Comp. Phys. Comm. 39, 53 (1986)
-* (2) K. Hanssgen, J. Ranft , Comp. Phys. Comm. 39, 37 (1986)
-*
-*
-* *** GEOMETRY PACKAGE: New shapes and many improvements
-* ==================================================
-*
-* Automatic optimisation of the geometry structure:
-* A new data card OPTI has been introduced (S.Egli H1).
-* OPTI -1 : disable optimisation
-* OPTI 0 : only volumes GSORDered are optimised (as in 3.13)
-* OPTI 1 : volumes GSORDered are optimised along the axis
-* specified. All the other volumes are automatically
-* optimised along the best axis (1 to 7).
-* OPTI 2 : All volumes are optimised along the best axis.
-* Volumes for which GSORD was called are also optimised.
-* The default value for OPTI is 0.
-* In case OPTI >0, the result of the optimisation is printed.
-* The automatic optimisation is done at initialisation time by
-* a new routine GGORDQ called by GGCLOS.
-*
-*
-* Most of the geometry routines have been revisited and consolidated.
-* The following new shapes are available.
-*
-* 'ELTU' is a cylinder with an elliptical section.
-* It has three parameters: the ellipse semi-axis in X,
-* the ellipse semi-axis in Y and the half length in Z.
-* Given the equation of the conical curve:
-* X**2/A**2 + Y**2/B**2 = 1,
-* describing the volume,then: PAR(1) = A
-* PAR(2) = B
-* PAR(3) = DZ
-* ELTU is not divisible.
-*
-* 'HYPE' is a hyperbolic tube, ie the inner and outer surfaces
-* are hyperboloids, as would be formed by a system of
-* cylindrical wires which were then rotated
-* tangentially about their centres. The 4 parameters
-* are the inner and outer radii, the half length in z,
-* and the "stereo angle" theta in degrees, such that
-* the hyperbolic surfaces are given by
-* r**2 = (z*tan(theta))**2 + (r at z=0)**2
-*
-* 'CTUB' (for cut tube) is a TUBS whose end planes are not
-* perpendicular to the z axis. It has 11 parameters :
-* the 5 of the TUBS shape plus the components of the normal
-* to the end plane at the lower z (LXL,LYL,LZL) and
-* those at the higher z (LXH,LYH,LZH).
-* DZ means the half length in z for x = y = 0
-*
-*
-* Bugs have been fixed in the routines GNPCON, GNPGON and GNOPGO.
-*
-* The new version of GNOTRP requires an extended parameter array.
-* In addition to the 11 specified parameters (of which 4 are
-* modified in subroutine GSVOLU or GSPOSP), the coefficients of
-* the implicit normalized plane equation for the 6 surfaces
-* of the hexahedron are stored.
-*
-* IMPORTANT NOTE concerning the TRAP shape
-* ========================================
-* The Geant documentation describes the Geant shape TRAP as follows:
-*
-* TRAP is a general trapezoid, i.e. one for which the
-* faces perpendicular to z are trapezia and their
-* centres are not at the same x, y. It has 11
-* parameters: Dz the half length in z, Th & Phi the
-* polar angles from the centre of the face at z=-Dz
-* to that at z=+Dz, H1 the half length in y at
-* z=-Dz, LB1 the half length in x at z=-Dz and y=low
-* edge, LH1 the half length in x at z=-Dz and y=
-* high edge, Th1 the angle w.r.t. the y axis from
-* the centre of the low y edge to the centre of the
-* high y edge, and H2, LB2, LH2, Th2 the
-* corresponding quantities to the 1s but at z=+Dz.
-*
-* This seems to describe a general hexahedron with 3 constraints:
-* 2 constraints follow from the fact that two faces are "trapezia".
-* (twice 2 edges parallel).
-* The 3rd constaint is that two faces are parallel, namely the "trapezia"
-* faces are both perpendicular to the Z-axis.
-* We will assume that shape TRAP is a hexahedron with 3
-* constraints and direct our attention to the degrees of freedom
-* of such a shape.
-* The shape has 8 vertices and therefore 24 coordinates.
-* If we first consider a volume with 8 vertices and 6 surfaces,
-* but do not make the assumption that the surfaces are plane,
-* we see that this shape has 18 degrees of freedom.
-* We loose 3 coordinates because of the translational invariance
-* of the shape and 3 coordinates because of its rotational
-* invariance.
-* If we now assume that the shape is a hexahedron, that is
-* bounded by plane surfaces, we have 6 constraints, one for each
-* surface, and our hexahedron has 12 degrees of freedom.
-* Considering the 3 constraints mentioned in the beginning,
-* we conclude that our shape trapezohedron has 9 degrees of freedom.
-* It is however described by 11 parameters.
-* Therefore we must either drop our assumption that shape TRAP is
-* a hexahedron, that is bounded by parallel surfaces, or we must
-* request that the user specifies the 11 parameters with certain
-* constraints.
-*
-* To check that the user respected the constraints, we check the
-* coplanarity of the faces during the specification phase of shape TRAP.
-* We know the vertex coordinates, and we have the indices to the
-* vertices for each face.
-* Assuming that a face is tetrahedron, we compute its volume.
-* We divide by the surface of the base triangle, and get a measure
-* for the coplanarity of the face, which is actually a distance.
-* A warning message is printed in case of no-coplanar faces.
-*
-* GSORD problem
-* =============
-* A bug has been found in GTNEXT (and alike) which is induced by a bug of
-* logic in GSORD/GGORD. User calls to GSORD, with ordering axis 4 (Rxy)
-* or 5 (Rxyz), may cause problems when the ordered contents are such that
-* one can jump from a given content to another one without crossing a
-* content which, along the given axis, occupies a position in between the
-* start and the end contents : e.g. coaxial TUBES with different Z-lengths
-* should not in general be ordered by GSORD along the axis IAX=4 (Rxy).
-* However, part of the information provided by such calls can still be
-* used, in the static context of GTMEDI for instance. Therefore, the
-* following convention has been introduced: If the user is sure that the
-* contents are positioned in such a way that the anomaly mentioned above
-* cannot occur, the call to GSORD can be modified by using IAX=14 (instead
-* of 4), or 15 (instead of 5), in which case the ordering techniques will
-* also be used in the dynamic context of GTNEXT. In case of doubt, the
-* user has better to keep the old code, with IAX=4 or 5.
-*
-* *** DRAWING PACKAGE: Interface to the CG package
-* ============================================
-*
-* An interface to the CG (Combinatorial Geometry) package written
-* at Serpukhov by E.Cernaev et al is now available. The new package
-* is automatically called if the option 'HIDE' is selected. eg.
-*
-* CALL GDOPT('HIDE','ON') in a Fortran program
-* DOPT HIDE ON/OFF in the interactive version
-*
-* This new facility includes a hidden line and surface algorithm
-* which permits nice 3-D views of a detector.
-* In the frequent case of hermetic 4 PI detectors, a facility
-* to remove a box (The Cutting BOX) is also implemented. The Cutting BOX
-* specifies a region of the detector which must be Cut to see inside.
-* A new interactive command CBOX is available to specify the box limits.
-*
-* The CG system is part of the GEANG file (See Patches CGCDES,CGPACK)
-* To activate the CG package, +USE,CG,*GEANG.
-*
-*
-* *** The SCAN geometry
-* =================
-* A new Patch,GSCAN has been introduced on a provisional basis in the GEANG
-* file. See discussion about SCAN below.
-*
-* *** GUPARA: Parametrization interface
-* =================================
-* A new FFREAD data cards PCUT can be used to set parametrization cuts.
-* The first argument of the PCUT card is a integer flag which turns or
-* on off the parametrization mechanism. If the parametrization is turned on
-* and a particle falls below one of the 5 cuts specified by the PCUT card
-* (similar in kind to the cuts specified by the card CUTS), then the
-* routine GUPARA is called and tracking of the particle is abandoned. This
-* mechanism is provided for applying parametrization schemes which
-* replace a particle by a parametrized shower when it falls below
-* a certain threshold.
-*
-*.............................................................................
-*
-*
-* *** GXINT: Interactive version
-* ==========================
-*
-* New menu FORTRAN: CALL,FILE,CLOSE,FORTRAN
-* New menu HISTOGRAM: FILE,LIST,PLOT,DELETE,LEGO,HRIN,HROUT,PUT,GET
-* ZONE,SET,OPTION,NULL
-* New menu PICTURE: FILE,LIST,DELETE,SCRATCH,PLOT,RENAME,IZOUT,IZIN,IGSET
-* New menu SCAN: PHI,THETA,SLIST,VERTEX,SFACTORS,LSCAN,HSCAN
-* New menu PHYSICS: ANNI,BREM,COMP,DCAY,DRAY,HADR,LOSS,MULS,MUNU,PAIR,
-* PFIS,PHOT,RAYL,CUTS,PHYSI
-*
-* The menus FORTRAN,HISTOGRAM and PICTURE are subsets of the similar
-* menus in the PAW system.
-*
-* The menu PHYSICS gives the possibility to modify the run conditions.
-* In case physics conditions are changed (LOSS,DRAY,MULS,CUTS) it is
-* mandatory to call the command PHYSI (which calls GPHYSI) to recompute
-* the cross-section and/or energy loss tables.
-*
-* The menu FORTRAN is similar to the FORTRAN menu of PAW. It contains
-* in addition a new very important command FORTRAN which gives the
-* possibility to describe the geometry (UGEOM) in a Fortran routine
-* that can be edited interactively with the local editor and also
-* executed interactively under the control of the Fortran interpreter
-* COMIS.
-*
-* *** GEANT >FORTRAN FNAME
-*
-* The routines in the file FNAME will be compiled by COMIS.
-* If routines with names: UGEOM,GUKINE,GUOUT,UGLAST are found,
-* then they will be automatically called by GXINT instead of
-* the routines with the same names compiled with the standard
-* Fortran compiler and linked with the application.
-* The user callable routines from the GEANT library as well as
-* routines from PACKLIB (HBOOK,HPLOT,HIGZ,ZEBRA) may be called
-* from these user routines. All GEANT common blocks may be
-* referenced.
-* In case where the routine UGEOM is called several times,
-* it is important to DROP all the initialisation data structures
-* JVOLUM,JMATE,JTMED,etc already in memory by using the routine GIDROP.
-*
-* Example of an interactive session where the routine UGEOM is modified:
-*
-* GEANT > Edit ugeom.for
-* GEANT > Fortran ugeom.for
-* GEANT > Call GIDROP
-* GEANT > Call UGEOM
-* GEANT > Dtree
-* GEANT > Edit ugeom.for
-* GEANT > Fortran ugeom.for
-* GEANT > Call GIDROP
-* GEANT > Call UGEOM
-* GEANT > Dtree
-*
-* If FNAME='-', calls to user routines is reset and standard
-* routines called instead.
-*
-* *** Interface to CG
-* The command DOPT has a new option HIDE (DOPT HIDE ON/OFF)
-* Type DOPT without parameters to get the list of all currently
-* available options.
-* When this option is ON, the subsequent graphics commands DCUT/DRAW
-* will invoke the CG system for hidden line/surface removal.
-* This algorithm requires a lot of memory and time. It is recommended
-* to set the visibility attributes (SATT SEEN 0) for many of the
-* volumes in case the command aborts for lake of memory or time.
-* This option can also be used with the view banks mechanism (DOPEN)
-*
-* New command CBOX to specify the boundaries of the cutting box.
-*
-* *** PLMAT
-*
-* The existing command PLMAT offers the new possibility to plot
-* various physics parameters (cross-sections, energy-loss tables,etc)
-* in graphics format (via HPLOT) if MECAN=ALLG
-* The Keywords 'STEP' or 'RANG' may also be specified to produce
-* an alphanumeric output of the step-size and energy-range tables.
-*
-* PLMAT IMATE IPART MECAN [ IDM ]
-*
-* IMATE I 'Material number'
-* IPART I 'Particle number'
-* MECAN C 'Mechanism'
-* IDM I 'ID mode option' D=0
-*
-*
-* *** New menu SCAN. The SCAN geometry
-* ================================
-*
-* This new menu contains various commands for an interactive interface
-* to the SCAN geometry
-* The SCAN geometry algorithm has been designed as a tool to improve
-* the tracking speed. This new facility still requires substantial
-* developments in view of the new parametrisation algorithms which
-* are developed in collaboration between the CN/AS group and the
-* LEP/HERA/LHC/SSC and other interested groups.
-* The SCAN facility is being introduced in the version 3.14 on a trial
-* basis to familiarise potential users with the concept.
-* The SCAN geometry data structure JSCAN is automatically generated
-* either by calling the GSCAN routine in the PATCH,GSCAN of GEANG
-* or interactively by using the commands in the new menu SCAN.
-* Starting from the normal geometry data structure created by GSVOLU,
-* GSPOS,GSDVN,etc, the detector may be divided into a simpler geometry
-* structure (theta,phi) or (eta,phi).
-* Geantinos are tracked starting from a VERTEX position through
-* the NPHI,NTETA divisions. For each division, the SCAN procedure
-* will insert into the JSCAN data structure the following information
-* for every main detector component specified in the SLIST command
-* in the spherical R direction:
-* Total number of radiation lengths up to entry in each R
-* Total number of absorption lenghts
-* Detector identifier
-* When the interactive command TRIGGER is entered, the number of
-* Geantinos specified as parameter will be tracked. In case the
-* data structure JSCAN is not empty, the program will automatically
-* start with the first PHI,TETA division not yet filled. As the
-* number of Geantinos to be tracked can be very large (depending
-* on the granularity) this gives the possibility to fill the JSCAN
-* data structures in several passes.
-*
-*
-* New menu SCAN: PHI,TETA,SLIST,VERTEX,SFACTORS,LSCAN,HSCAN
-*
-* ==> /SCAN/PHI NPHI [ PHIMIN PHIMAX ]
-*
-* NPHI I 'Number of PHI divisions' D=90
-* PHIMIN R 'Minimum PHI in degrees' D=0
-* PHIMAX R 'Maximum PHI in degrees' D=360
-*
-* To specify number of divisions along PHI.
-*
-*
-* ==> /SCAN/TETA NTETA TETMIN TETMAX [ DIVTYP ]
-*
-* NTETA I 'Number of TETA divisions' D=90
-* TETMIN R 'Minimum value of TETA' D=0
-* TETMAX R 'Maximum value of TETA' D=180
-* DIVTYP I 'Type of TETA division' D=1 R=1:2
-*
-* To specify number of divisions along TETA.
-* If DIVTYP=1 divisions in degrees following the THETA angle.
-* If DIVTYP=2 divisions in pseudo-rapidity ETA.
-*
-*
-* ==> /SCAN/SLIST LIST
-*
-* LIST C 'List of master volumes'
-*
-* Only boundary crossings of volumes given in LIST
-* will be seen in the SCAN geometry.
-*
-*
-* ==> /SCAN/VERTEX VX VY VZ
-*
-* VX R 'Scan vertex origin' D=0
-* VY R 'Scan vertex origin' D=0
-* VZ R 'Scan vertex origin' D=0
-*
-* All Geantinos tracked will start from position VX,VY,VZ.
-*
-*
-* ==> /SCAN/SFACTORS FACTX0 FACTL FACTR
-*
-* FACTX0 R 'Scale factor for SX0' D=100
-* FACTL R 'Scale factor for SL' D=1000
-* FACTR R 'Scale factor for R' D=100
-*
-* Set scale factors for SX0,SL and R. The given scale factors must be
-* such that:
-*
-* SX0*FACTX0 < 2**15-1 (32767)
-* SL*FACTL < 2**10-1 (1023)
-* SR*FACTR < 2**17-1 (131071)
-*
-*
-* ==> /SCAN/LSCAN ID [ VOLUME CHOPT ]
-*
-* ID I 'Lego plot identifier' D=2000
-* VOLUME C 'Volume name' D='XXXX'
-* CHOPT C 'List of options' D='OPX' R=' ,O,P,I,X,L'
-*
-* Generates and plot a table of physics quantities such as
-* the total number of radiation lengths or interaction lengths
-* in function of the SCAN parameters TETA,PHI.
-*
-* CHOPT='O' table is generated at Exit of VOLUME.
-* CHOPT='I' table is generated at Entry of VOLUME.
-* CHOPT='X' radiation lengths
-* CHOPT='L' Interaction lengths
-* CHOPT='P' Plot the table
-*
-* If VOLUME='XXXX' Mother volume is used.
-*
-*
-* ==> /SCAN/HSCAN IDPHI [ VOLUME CHOPT ]
-*
-* IDPHI I 'Histogram/phi identifier' D=1000
-* VOLUME C 'Volume name' D='XXXX'
-* CHOPT C 'List of options' D='OPX' R=' ,O,P,I,X,L'
-*
-* Generates and plot an histogram of physics quantities such as
-* the total number of radiation lengths or interaction lengths
-* in function of the SCAN parameter TETA for a given value of PHI.
-*
-* CHOPT='O' histogram is generated at Exit of VOLUME.
-* CHOPT='I' histogram is generated at Entry of VOLUME.
-* CHOPT='X' radiation lengths
-* CHOPT='L' Interaction lengths
-* CHOPT='P' Plot the histogram
-*
-* If VOLUME='XXXX' Mother volume is used.
-* The histogram identifier IDPHI is used to also identify which
-* PHI division to plot. IPHI=MOD(IDPHI,1000).
-* If IPHI=0, then all PHI divisions are generated (not plotted)
-* with histogram identifiers IDPHI+PHI division number.
-*
-*
-*
-*
-*
-*
-* *** New commands FILE,REND,MDIR,CDIR,IN,OUT in the RZ menu.
-* =======================================================
-*
-*
-* ==> RZ/FILE LUN FNAME [ CHOPT ]
-*
-* LUN I 'Logical unit number'
-* FNAME C 'File name'
-* CHOPT C 'Options' D=' ' R=' ,U,N,I,O'
-*
-* Open a GEANT/RZ file. Call GRFILE (See below).
-*
-* CHOPT=' ' readonly mode
-* CHOPT='U' update mode
-* CHOPT='N' create new file
-* CHOPT='I' Read all structures from existing file
-* CHOPT='O' Write all structures on file
-*
-*
-* ==> RZ/OUT OBJECT [ IDVERS ]
-*
-* OBJECT C 'Structure name'
-* IDVERS I 'Version number' D=1
-*
-* Write data structure identified by OBJECT,IDVERS to RZ file.
-* Call GROUT (See below)
-*
-* MATE write JMATE structure
-* TMED write JTMED structure
-* VOLU write JVOLUM structure
-* ROTM write JROTM structure
-* SETS write JSET structure
-* PART write JPART structure
-* SCAN write JSCAN structure
-* * write all structures
-*
-* ==> RZ/IN OBJECT [ IDVERS ]
-*
-* OBJECT C 'Structure name'
-* IDVERS I 'Version number' D=1
-*
-* Read data structure identified by OBJECT,IDVERS into memory.
-* Call GRIN (See below)
-*
-* MATE read JMATE structure
-* TMED read JTMED structure
-* VOLU read JVOLUM structure
-* ROTM read JROTM structure
-* SETS read JSET structure
-* PART read JPART structure
-* SCAN read JSCAN structure
-* * read all structures
-*
-*
-*
-*
-* *** New routines for direct access I/O in the GIOPA package
-* =======================================================
-*
-* ==> SUBROUTINE GRFILE(LUN,CHFILE,CHOPT)
-*.
-*. Routine to open a GEANT/RZ data base.
-*.
-*. LUN logical unit number associated to the file
-*.
-*. CHFILE RZ file name
-*.
-*. CHOPT is a character string which may be
-*. 'N' To create a new file
-*. 'U' to open an existing file for update
-*. ' ' to open an existing file for read only
-*. 'Q' The initial allocation (default 1000 records)
-*. is given in IQUEST(10)
-*. 'I' Read all data structures from file to memory
-*. 'O' Write all data structures from memory to file
-*.
-*. Note:
-*. If options 'I' or 'O' all data structures are read or
-*. written from/to file and the file is closed.
-*. See routine GRMDIR to create subdirectories
-*. See routines GROUT,GRIN to write,read objects
-*.
-*.
-*.
-*. ==> SUBROUTINE GROUT(CHOBJ,IDVERS,CHOPT)
-*.
-*. Routine to write GEANT object(s) in the RZ file
-*. at the Current Working Directory (See RZCDIR)
-*. Input is taken from the data structures in memory
-*. (VOLU,ROTM,TMED,MATE,SETS,PART,SCAN)
-*.
-*. CHOBJ The type of object to be written:
-*. MATE write JMATE structure
-*. TMED write JTMED structure
-*. VOLU write JVOLUM structure
-*. ROTM write JROTM structure
-*. SETS write JSET structure
-*. PART write JPART structure
-*. SCAN write LSCAN structure
-*. INIT write all initialisation structures
-*.
-*. IDVERS is a positive integer which specifies the version
-*. number of the object(s).
-*.
-*. CHOPT List of options (none for the time being)
-*.
-*. Note that if the cross-sections and energy loss tables
-*. are available in the data structure JMATE, then they are
-*. saved on the data base.
-*.
-*.
-*. The data structures saved by this routine can be retrieved
-*. with the routine GRIN.
-*.
-*. Before calling this routine a RZ data base must have been
-*. created using GRFILE.
-*. The data base must be closed with RZEND.
-*. Ex: if LUN=1 CALL RZEND('LUN1')
-*.
-*. The RZ data base can be transported between different
-*. machines in using the ZEBRA RZ utility RZTOFZ.
-*.
-*. The interactive version of GEANT provides facilities
-*. to interactively update, create and display objects.
-*.
-*. Example.
-*.
-*. CALL GRFILE(1,'Geometry.dat','N')
-*. CALL GROUT('VOLU',1,' ')
-*. CALL GROUT('MATE',1,' ')
-*. CALL GROUT('TMED',1,' ')
-*. CALL GROUT('ROTM',1,' ')
-*. CALL GROUT('PART',1,' ')
-*. CALL GROUT('SCAN',1,' ')
-*. CALL GROUT('SETS',1,' ')
-*.
-*. The same result can be achieved by:
-*. CALL GRFILE(1,'Geometry.dat','NO')
-*.
-*.
-*.
-*. ==> SUBROUTINE GRIN(CHOBJ,IDVERS,CHOPT)
-*.
-*. Routine to read GEANT object(s) fromin the RZ file
-*. at the Current Working Directory (See RZCDIR)
-*. The data structures from disk are read in memory
-*. (VOLU,ROTM,TMED,MATE,SETS,PART,SCAN)
-*.
-*. CHOBJ The type of object to be read:
-*. MATE read JMATE structure
-*. TMED read JTMED structure
-*. VOLU read JVOLUM structure
-*. ROTM read JROTM structure
-*. SETS read JSET structure
-*. PART read JPART structure
-*. SCAN read LSCAN structure
-*. INIT read all initialisation structures
-*.
-*. IDVERS is a positive integer which specifies the version
-*. number of the object(s).
-*.
-*. CHOPT List of options (none for the time being)
-*.
-*.
-*. The RZ data base has been created via GRFILE/GROUT
-*.
-*.
-*. Example.
-*.
-*. CALL GRFILE(1,'Geometry.dat',' ')
-*. CALL GRIN ('VOLU',1,' ')
-*. CALL GRIN ('MATE',1,' ')
-*. CALL GRIN ('TMED',1,' ')
-*. CALL GRIN ('ROTM',1,' ')
-*. CALL GRIN ('PART',1,' ')
-*. CALL GRIN ('SCAN',1,' ')
-*. CALL GRIN ('SETS',1,' ')
-*.
-*. The same result can be achieved by:
-*. CALL GRFILE(1,'Geometry.dat','I')
-*.
-*.
-*.
-* ==> SUBROUTINE GRMDIR(CHDIR,CHOPT)
-*.
-*.
-*. Routine to create a subdirectory
-*.
-*. CHDIR Subdirectory name
-*.
-*. CHOPT is a character string which may be
-*. ' ' To create a subdirectory
-*. 'S' To create a subdirectory and set the new
-*. Current Directory to this directory.
-*.
-*.
-
-+DECK,V_315
-*CMZ : 3.21/02 29/03/94 15.41.18 by S.Giani
-*-- Author :
-*
-*
-* Maintenance and support for the GEANT MonteCarlo system
-* are performed by the Simulation Section of the CERN
-* Computing and Networks division. For any problem please
-* contact:
-*
-* Federico Carminati
-* CERN-CN
-* 1211 Geneva 23
-* Tel: +41 22 767.4959
-* Telefax: +41 22 767.7155
-* E-mail:
-* BITnet/EARN: FCA at CERNVM
-* DECnet : VXCERN::FCA (Node 22.190)
-* Internet : fca at cernvm.cern.ch
-*
-* An electronic GEANT discussion list has been set up on CERNVM.
-* To be included in the mailing list it is enough to send the
-* following message:
-*
-* TELL LISTSERV AT CERNVM SUBSCRIBE LGEANT Firstname Lastname Inst
-*
-* People who do not dispose of a TELL (or equivalent) bitnet
-* command should send a mail to LISTSERV at CERNVM containing the
-* only line:
-*
-* SUBSCRIBE LGEANT Firstname Lastname Inst
-*
-*================================= History
-*
-*===> 20/NOV/1990
-*
-* Current plans set the release of GEANT 3.15 around the third
-* quarter of 1991.
-*
-*===> 27/NOV/1990
-*
-* Correction in GTRACK to set correctly the value of PREC
-* to match machine precision. Thanks to Stephan Egli and
-* M.Maire.
-* Introduced in the 314 correction cradle.
-*
-*===> 28/NOV/1990
-*
-* Correction in GNTUBE to avoid square root of a negative
-* number. Thanks to M.Maire
-* Introduced in the 314 correction cradle.
-*
-* Eliminate TOFG=0 from GINIT, already done in GTRIGI
-* Thanks to F.Carminati
-* Introduced in the 314 correction cradle.
-*
-*===> 29/NOV/1990
-*
-* UNIX and BSLASH flags correctly set inside *GEANT.
-* Thanks to A.Nathaniel
-* GPMATE now prints also the components in case of
-* mixtures. If NUMB is <0 then materials from 1 to
-* -NUMB are printed. Thanks to Stephan Egli.
-*
-* Corrections in GRGET (obsolete), GGET, GRIN to reset
-* correctly the number in GCNUM. Thanks to Stephan Egli
-* Introduced in the 314 correction cradle.
-*
-*===> 30/NOV/1990
-*
-* New version of GNOELT and GNELTU, thanks to Yoshihisa Iga
-* and R.Nierhaus
-* Introduced in the 314 correction cradle.
-*
-* Correction in GTRAK, all mechanisms turned off in the
-* vacuum. Thanks to S.Egli
-* Introduced in the 314 correction cradle.
-*
-*
-*===> 03/DEC/1990
-*
-* New routine GXPICK for the interactive version (Command
-* DRAWING/PICK) to pick a point in a detector and return
-* volume/material characteristics. Thanks to S.Egli.
-*
-*===> 04/DEC/1990
-*
-* MAXNOD from 2000 to 8000 in GDTR0. Suggestion by S.Egli.
-* Introduced in the 314 correction cradle.
-*
-* Bug corrected in GGCLOS, do not touch ISEARC in case
-* of user search (ISEARC.GT.0). Thanks to D.Ward.
-* Introduced in the 314 correction cradle.
-*
-*===> 05/DEC/1990
-*
-* Correction in TWOB, get correctly Tmin and Tmax and
-* their distribution. Thanks to Marko Mikuz.
-* Introduced in the 314 correction cradle.
-*
-*===> 06/DEC/1990
-*
-* Correction in TWOCLU and GENXPT to improve energy
-* conservation. Thanks to S.Egli.
-* Introduced in the 314 correction cradle.
-*
-*===> 11/DEC/1990
-*
-* Generic function LOG introduced in GHFRAK. Generic
-* functions MAX and MIN introduced in several routines
-* in GGEOM (HYPE) and CGPACK. Generic SIN, COS, ATAN and
-* SQRT introduced in CGPACK. Thanks to Federico Carminati.
-* Introduced in the 314 correction cradle.
-*
-*===> 13/DEC/1990
-*
-* GTAU routine to be obsoleted.
-*
-* Supporting link for the LSCAN data structure mispelled
-* in several places. Corrected now. Thanks to Isabel Josa.
-* Introduced in the 314 correction cradle.
-*
-* Unused variable IPOT eliminated from GHFFER.
-*
-* Changes in the interactive part for ATC GKS which does
-* not use FORTRAN unit for metafiles. (routines GXINT and
-* GXGCON). Thanks to W.Koellner
-*
-*===> 14/DEC/1990
-*
-* REAL*8 changed to DOUBLE PRECISION in CGPACK.
-* Life of the D+/- mesons was 100 times too short.
-* Thanks to Cheng He Sheng.
-* Introduced in the 314 correction cradle.
-*
-*===> 19/DEC/1990
-*
-* Modification in GDRAW and GDSPEC to correct a bug.
-* Modifications in GLVOLU not to print a warning message
-* caused by drawing.
-* Introduced in the 314 correction cradle.
-*
-*===> 20/DEC/1990
-*
-* Correction in GRAYLI affecting Rayleigh effect in
-* mixtures.
-* Introduced in the 314 correction cradle.
-*
-* Recode of GRAYLI and GHESIG to be safer with respect
-* to compiler optimization.
-* Thanks to Rafi Yaari.
-*
-*===> 8/JAN/1991
-*
-* Corrections in GRGET, GGET, GRIN to set correctly
-* NPART, NTMED, NMATE, NVOLUM. Thanks to Lee Roberts.
-* Introduced in the 314 correction cradle.
-*
-* New meaning for ISVOL. If <0 the material is not a
-* a detector but the tracking parameters are the same
-* as in the case ISVOL>0 (sensitive medium).
-* Thanks to Michel Maire.
-* Introduced in the 314 correction cradle.
-*
-*===> 9/JAN/1991
-*
-* TMAXFD not recomputed with IGAUTO=1 if the value given
-* by the user >= 0. Default value reset to 20. instead of
-* 60. degrees. Thanks to W.Mueller and M.Maire
-* Introduced in the 314 correction cradle.
-*
-*===> 10/JAN/1991
-*
-* Corrections in GPFIS, GPFISI and GPHYSI for the fotofission
-* and fotoabsorbtion (Giant resonance) of photons on Uranium
-* and plutonium. Thanks to Harm Fesefeld.
-* Introduced in the 314 correction cradle.
-*
-* Correction in GPHYSI in case ILOSS=2 and more than one
-* tracking medium with the same material number then a
-* spurious error message was printed. Thanks to Kevin Sparks
-* Introduced in the 314 correction cradle.
-*
-* Corrections in GENXPT, TWOCLU, TWOB, CINEMA and EXNU.
-* Thanks to Harm Fesefeldt.
-* Introduced in the 314 correction cradle.
-*
-*===> 11/JAN/1991
-*
-* Correction in GPPART in case of user words. Thanks to Walter
-* Mueller.
-* Introduced in the 314 correction cradle.
-*
-* Correction in GSTMED to protect for EPSIL <=0. Thanks to
-* Michel Lefebvre.
-* Introduced in the 314 correction cradle.
-*
-*===> 14/JAN/1991
-*
-* Correction in GRGET to read the banks in the correct
-* division. Thanks to M.Maire.
-* Introduced in the 314 correction cradle.
-*
-* Improvement of GRIN, GROUT. New global keywords KINE and
-* TRIG can now be used. Thanks to Federico Carminati
-* Introduced in the 314 correction cradle.
-*
-*===> 17/JAN/1991
-*
-* Correction in GSVOLU, GSDVN, GSDVN2, GSDVT, GSDVT2 not to
-* use uninitialized LINATT, set by GDINIT. This should take
-* care of the problem of empty drawings. Thanks to Simone Giani.
-* Introduced in the 314 correction cradle.
-*
-* Correction in GPKINE to print correctly user words and vertex
-* information. Thanks to Kevin Sparks.
-* Introduced in the 314 correction cradle.
-*
-* Correction in GPVERT to print correctly user words and vertex
-* information. Thanks to Soren G. Frederiksen.
-* Introduced in the 314 correction cradle.
-*
-*===> 18/JAN/1991
-*
-* Max. GCKING stack size parametrized. The actual value of the
-* stack is not changed (100), but can be redefined in the
-* sequence GCKMAX. Important for LHC studies.
-* Thanks to Harm Fesefeldt.
-*
-* Correction in GPRINT to call correctly GPDIGI and GPSETS.
-* Thanks to Michel Maire.
-* Introduced in the 314 correction cradle.
-*
-*===> 22/JAN/1991
-*
-* New facilities of DZDOC introduced in the interactive menu.
-* Patchy flag (DZDOC) to assure backward compatibility.
-* Thanks to O.Schaile
-*
-*===> 31/JAN/1991
-*
-* New facility using the JUMPT package to call user routines.
-* Patchy flag (USRJMP) to assure bacward compatibility.
-* Thanks to F.Carminati
-*
-*===> 05/FEB/1991
-*
-* Correction in GINIT to print the level of the correction
-* cradle applied. Thanks to F.Carminati.
-* Introduced in the 314 correction cradle.
-*
-* Correction Cradle 3.14/06 stamped and released.
-*
-*===> 06/FEB/1991
-*
-* Introduction of the AIX370 flag in GEANX and GEANT.
-* Thanks to Roger Howard.
-*
-*===> 13/FEB/1991
-*
-* Protection in GTRACK, GFTRAC and GLTRAC, do not update
-* pointers to cross section banks in the vacuum.
-* Thanks to C.Fuglesang, S.Banerjee, M.Maire.
-* Introduced in the 314 correction cradle.
-*
-*???> Backward incompatibility
-*
-* GFDETH returns NAMESH as a character*4 array and
-* GFDETD returns NAMESD as a character*4 array.
-* Thanks to M.Maire.
-*
-*
-*===> 14/FEB/1991
-*
-* Mods in GPMATE, GPPART, GPTMED, GSDK, GSMATE, GSMIXT, GSPART,
-* GSTMED, GSROTM, GPROTM
-* to warn against replacement of existing objects. Thanks to
-* Steve O'Neale.
-* Introduced in the 314 correction cradle.
-*
-* Force load of user routines in GINIT.
-* Introduced in the 314 correction cradle.
-*
-*===> 15/FEB/1991
-*
-* GSDVN to notify correctly when mother volume does not exists.
-* Thanks to Victor Perevoztchikov.
-* Introduced in the 314 correction cradle.
-*
-*===> 20/FEB/1991
-*
-* Correction in GHEINI for the exponent range to be compatible
-* with IEEE machines. Original limits were for IBM/370.
-* Routine LIMDAT eliminated. Thanks to Hans-Jochen Trost.
-* Introduced in the 314 correction cradle.
-*
-*???> Backward incompatibility
-*
-* Parameter NAMATE returned from GFMATE now a CHARACTER*20
-* variable. Thanks to Michel Maire.
-*
-* Monitoring introduced, flag MONITOR. Thanks to F.Carminati.
-* Mods in GXINT, GINIT, GLAST. Routine GEAMON introduced.
-* Introduced in the 314 correction cradle.
-*
-*===> 22/FEB/1991
-*
-* GWORK in GINIT was (DUMMY) called without arguments.
-* GUDTIM was (dummy) called as a routine and it is a
-* function. Thanks to F.Carminati.
-* Introduced in the 314 correction cradle.
-*
-* GUVIEW to specify 3rd argument as a character. Thanks to
-* Federico Carminati.
-* Introduced in the 314 correction cradle.
-*
-* Call NUCRIN with the right number of arguments (the last
-* was not used anyway). Thanks to Federico Carminati.
-* Introduced in the 314 correction cradle.
-*
-*===> 04/MAR/1991
-*
-* Correction in GMUSIG to avoid division by zero. Thanks to
-* M.Verzocchi.
-* Introduced in the 314 correction cradle.
-*
-*
-*===> 20/MAR/1991
-*
-* Corrections in GPRELM, muon e+e- soft radiation. Correction in
-* GDRELM for the ionization energy loss for muons. Thanks to
-* A.Nathaniel. Introduced in the 314 correction cradle.
-*
-*===> 21/MAR/1991
-*
-* Correction in GPHYSI to initialise the JMULOF bank even in
-* the case of vacuum. Electron tracking in vacuum was not taking
-* into account the TMAXFD parameter. Correction in GRANGI to set
-* the range to BIG in case of 0 energy loss tabulated in JLOSS.
-* Correction in GPHYSI to switch off all the mechanisms in the
-* vacuum but decay. The corresponding code in GTRACK has been
-* removed. The previous corrections for IUPD in GLTRAC, GFTRAC
-* and GTRACK have been removed as well. Thanks to D.Ward, R.Brun,
-* F.Carminati
-* Introduced in the 314 correction cradle.
-*
-* Corrections in GRANGI and in GTHADR to cure small steps in
-* tracking. Thanks to M.Maire.
-* Introduced in the 314 correction cradle.
-*
-*===> 25/MAR/1991
-*
-*???> Backward incompatibility
-*
-* GFPART returns NAPART as a CHARACTER*20 array. Thanks to R.Rui
-* Introduced in the 314 correction cradle.
-*
-*===> 26/MAR/1991
-*
-* GFTMAT will return the correct values for the vacuum, except
-* for hadrons. Thanks to P.Gumplinger.
-* Introduced in the 314 correction cradle.
-*
-* Correction in GPCXYZ when the number of mechanisms is greater
-* than 6. Thanks to Y.Iga.
-* Introduced in the 314 correction cradle.
-*
-*
-*===> 27/MAR/1991
-*
-* GDXYZ corrected to use HIGZ generic line types. Thanks to
-* M.Maire.
-* Introduced in the 314 correction cradle.
-*
-* Correction in the CDF for RZ/IN and RZ/OUT. Thanks to
-* F.Carminati.
-* Introduced in the 314 correction cradle.
-*
-*===> 04/APR/1991
-*
-* For reasons of speed GKS-type lines are used now in
-* GDCXYZ, GDXYZ. Thanks to F.Carminati.
-* Introduced in the 314 correction cradle.
-*
-*===> 18/APR/1991
-*
-* Correction of the logic for TMAXFD. Now is:
-*
-* AUTO 1: 0<TMAXFD<20 --> accepted
-* TMAXFD>20 --> set to 20
-* TMAXFD<=0 --> set to 20
-*
-* AUTO 0: TMAXFD>0 --> accepted
-* TMAXFD<=0 --> set to 20
-*
-* Thanks to Gerry Lynch.
-* Introduced in the 314 correction cradle.
-*
-* Correction in GMULOF. STMIN=BIG for the vacuum. Thanks
-* to F.Carminati.
-* Introduced in the 314 correction cradle.
-*
-* Correction in GRFILE, GRIN called with IDVERS=0 and not
-* 999. Thanks to F.Carminati.
-* Introduced in the 314 correction cradle.
-*
-*===> 22/APR/1991
-*
-* Corrections in GPRELA, GMULOF, GPHYSI and GTNEXT. Now
-* STMIN is set to 0. for vacuum independly of the AUTO
-* flag. Thanks to M.Maire.
-* Introduced in the 314 correction cradle.
-*
-* Format correction in GSDVN. Thanks to Federico Carminati.
-* Introduced in the 314 correction cradle.
-*
-*===> 23/APR/1991
-*
-* Correction in GINIT to initialize LIN via IQTTIN if
-* different from 0. Thanks to F.Carminati
-* Introduced in the 314 correction cradle.
-*
-*===> 24/APR/1991
-*
-* New routines GPLMAT, GPRMAT, GPGKIN from Michel Maire.
-*
-*===> 25/APR/1991
-*
-* geant.metafile is not opened any more by default.
-* The METAFILE command now accepts the metafile name
-* for packages like ATC-GKS which do not use FORTRAN.
-* Thanks to W.Koellner.
-*
-*===> 01/MAY/1991
-*
-* Problem corrected in GHEISH for neutron cascade. A neutron
-* undergoing an hadronic reaction could generate two recoil
-* protons. Thanks to Henk den Bok.
-* Introduced in the 314 correction cradle.
-*
-* Correction in GNEXT/GTNEXT. STMIN not used anymore for
-* MANY volumes. Thanks to M.Maire.
-* Introduced in the 314 correction cradle.
-*
-*===> 02/MAY/1991
-*
-* Call to NVETIM routine removed from GHEISHA. Thanks to
-* F.Carminati.
-*
-*===> 07/MAY/1991
-*
-* RNDM interactive command added to set the random number
-* generator seeds. Thanks to F.Carminati.
-*
-*===> 08/MAY/1991
-*
-* New routine GDTRAK introduced to draw a track and delete
-* it from the JXYZ buffer optionally. Thanks to R.Brun,
-* F.Carminati.
-*
-* Important correction in GTGAMA, GTNEUT to avoid problems
-* due to machine precision. When a push is made to cross a
-* volume boundary the condition that the change in coordinate
-* be not negligible is imposed. Thanks to F.Carminati, R.Brun.
-* Introduced in the 314 correction cradle.
-*
-*===> 09/MAY/1991
-*
-* Correction in GMGAUS due to G.Lynch. The sigma of the multiple
-* scattering in the gaussian approssimation was too small.
-* Introduced in the 314 correction cradle.
-*
-*===> 14/MAY/1991
-*
-* Corrections in GTELEC, GTHADR and GTMUON to introduce the
-* same boundary correction than in GTNEUT, GTGAMA. Thanks to
-* P.Gumplinger.
-* Introduced in the 314 correction cradle.
-*
-* New menu in GXINT to handle FZ files. Thanks to F.Carminati
-*
-*===> 17/MAY/1991
-*
-* Correction in GHFHDN to reset to 0. TOFD. Thanks to
-* R.Rui.
-* Introduced in the 314 correction cradle.
-*
-*===> 31/MAY/1991
-*
-* Correction in GTRACK to allow PREC to decrease and avoid
-* problems when changing particle and position but not medium.
-* Thanks to R.Spiwoks.
-* Introduced in the 314 correction cradle.
-*
-*===> 4/JUN/1991
-*
-* New version of the hidden line removal, thanks to S.Giani.
-* New menu CVOL introduced to cut volumes and new SHIFT
-* command to shift volumes for drawing.
-*
-* Correction in GHEISH. The ENP parameters are reset to 0.
-* at the beginning of every event. Thanks to Henk den Bok.
-* Introduced in the 314 correction cradle.
-*
-*===> 5/JUN/1991
-*
-* Correction introduced in GPHYSI. JTM recalculated after
-* bank push. Thanks to K.Sparks.
-* Introduced in the 314 correction cradle.
-*
-*===> 11/JUN/1991
-*
-* Correction introduced in GTELEC, GTMUON, GTHADR. When the
-* energy loss is below machine precision, it is recalculated
-* via the De/Dx table. Thanks to H.Fesefeld and Ralf Spiwoks.
-* Introduced in the 314 correction cradle.
-*
-* Booking of the bank IMAT-4 delayed till GPHYSI. Will save some
-* words in case of materials which are not inserted in a tracking
-* medium. Thanks to F.Carminati.
-*
-*???> Backward incompatibility
-*
-* The argument DMAXMS in the calling sequence of GSTMED, unused
-* in 314, will be called STEMAX and will assume the meaning of
-* maximum step allowed for a particle in the given material.
-* This will only affect people running with AUTO 0. In case of
-* automatic computation of the tracking media parameters, this
-* number will be set to BIG (=1.E10).
-* Thanks to F.Carminati, M.Maire.
-*
-*===> 12/JUN/1991
-*
-* Corrections in GMUNU to allow the usage of a variable number of
-* energy bins. Corrections in PHASP and GMUSIG for very high
-* energies. Thanks to Hans-Jochen Trost.
-* Introduced in the 314 correction cradle.
-*
-* Correction in GFLTHE to avoid division by 0. Thanks to
-* Roy Bossingham.
-* Introduced in the 314 correction cradle.
-*
-*===> 13/JUN/1991
-*
-* Correction in GINPGO and GINPCO to check correctly the PHI
-* limits. Thanks to R.Bossingham.
-* Introduced in the 314 correction cradle.
-*
-*===> 19/JUN/1991
-*
-* Correction in GMUNU to calculate correctly the angle of the
-* incoming muon. Thanks to H-J.Trost.
-* Introduced in the 314 correction cradle.
-*
-*===> 20/JUN/1991
-*
-* Corrections in GLANDZ for high energy to avoid numerical
-* problems. Thanks to H-J.Trost.
-* Introduced in the 314 correction cradle.
-*
-*===> 26/JUN/1991
-*
-* All the routines and the commons of the HADRIN/NUCRIN
-* package have been renamed. All routines begin now with
-* GHF and all commons with GCF. This to avoid interactions
-* with the interface with FLUKA. Thanks to F.Carminati
-*
-*===> 28/JUN/1991
-*
-* New algorithm for pushing a view bank. Now push of the
-* max between MORGS and the 25% of the size of the view
-* bank. Thanks to S.Giani.
-*
-*===> 17/JUL/1991
-*
-* Common HIATT of HIGZ removed from GXCONT and workstation type
-* retrieved in GXDZ from Workstation ID. Thanks to O.Couet.
-*
-* Modification in GMUSIG to protect against possible division
-* by zero. Thanks to M.Sarris.
-*
-* Correction in GDSHOW to recalculate COSPSI and SINPSI. Thanks
-* to M.Verzocchi.
-* Introduced in the 314 correction cradle.
-*
-*===> 18/JUL/1991
-*
-* Correction in GINVOL. When tracking in magnetic
-* field they could return the wrong volume. Thanks to D.Greiner.
-* Introduced in the 314 correction cradle.
-*
-*===> 24/JUL/1991
-*
-* Corrections in GRIN to allow tracking after reading a data
-* structure. Thanks to R.Brun.
-* Introduced in the 314 correction cradle.
-*
-* Modifications in GXINT to allow running with the MOTIF
-* user interface. Thanks to R.Brun.
-*
-*===> 31/JUL/1991
-*
-* INT=0 suppressed in GHEISH after nuclear fission.
-* Thanks to Kati Lassila.
-*
-*===> 01/AUG/1991
-*
-* Protection introduced in GMUSIG. Thanks to Jochen Trost.
-* Introduced in the 314 correction cradle.
-*
-*===> 02/AUG/1991
-*
-* Correction in GHSTOP to fix the calculation of the time of
-* flight for stopping particles. Thanks to L.Roberts.
-* Introduced in the 314 correction cradle.
-*
-* Correction in GNPGON not to calculate safety for the inner
-* radius when this is 0. Thanks to Andrei Nomerotsky.
-* Introduced in the 314 correction cradle.
-*
-* Correction in GNOTRP to return the correct SNXT. Thanks to
-* V.Innocente.
-* Introduced in the 314 correction cradle.
-*
-* Correction in GHSTOP not to discard hadrons at rest, they
-* may decay. Thanks to H.Fesefeld.
-* Introduced in the 314 correction cradle.
-*
-* Modifications in GHSTOP and GHEISH to handle user defined
-* particles. Thanks to P.Gumplinger.
-* Introduced in the 314 correction cradle.
-*
-*===> 12/AUG/1991
-*
-* Call to GUINTI added in GINTRI to define user commands. Thanks
-* to V.Vercesi.
-* Introduced in the 314 correction cradle.
-*
-*===> 21/AUG/1991
-*
-* Modification in GTMED to print a warning when FIELDM .EQ. 0
-* and IFIELD .NE. 0. Thanks to Federico Carminati
-*
-* Modification in GTHADR to set CFLD = BIG in case FIELDM=0.
-* Thanks to V.Vercesi.
-* Introduced in the 314 correction cradle.
-*
-*===> 27/AUG/1991
-*
-* Call to C dummy routine to initialise X11 introduced in
-* GXINT for IBM/VM. Thanks to M.Marquina.
-*
-*===> 19/SEP/1991
-*
-* Rayleigh effect now the default. IRAYL is set to 1 by default
-* in GINIT. Thanks to M.Maire
-*
-* Changes in the multiple scattering routines. GMOLI1 and GMOLI2
-* suppressed and GMOLIO used instead. Corresponding changes in
-* GMULTS and GMULOF. The code of GMOLS has been put in line inside
-* GMOLIE and GMOLS is obsolete. GPOISS and GMCOUL modified for
-* performance reasons.
-* Gaussian scattering is now generated according to the Rossi
-* gaussian formula and there is no logarithmic term in the
-* sigma of the gaussian. This gives a distribution where the
-* tails are underestimated, but which is consistent over many
-* steps.
-* Moliere and single Coulomb scattering are chosen according to
-* the value of Omega in the Moliere formula.
-* The new meaning of IMULS is the following:
-*
-* IMULS = 0 No multiple scattering
-* IMULS = 1,2 Moliere or single Coulomb scattering
-* IMULS = 3 Gaussian scattering with Rossi formula
-*
-* Thanks to G.Lynch.
-*
-*===> 14/OCT/1991
-*
-* New algorithm for calculation of energy loss. The stopping
-* range is now calculated with a parabolical interpolation
-* instead than with a linear one. This gives a dE/dx curve
-* which is a piecewise linear function and not a step function.
-* Thanks to F.Carminati.
-*
-* Modification of GNOPG1 taking care of the case of a particle
-* which is very near to the surface and it may appear inside due
-* to machine precision. This could cause the volume to be skipped.
-* Thanks to R.Nierhaus.
-*
-* Routine GNPGON rewritten for the calculation of SNXT. The
-* previous routine was returning wrong results. Thanks to
-* R.Nierhaus.
-*
-*===> 28/OCT/1991
-*
-* Modifications in the routines GFLPHI and GFCOOR. The ordering
-* for TUBS in phi was wrong. Volumes could become invisible.
-* Thanks to F.Carminati.
-*
-* New routine GFVERT introduced. Retrieves the parameters of a
-* vertex. Thanks to F.Carminati.
-*
-*===> 29/OCT/1991
-*
-* Modification in NUCREC to zero the whole of the PV array
-* to prevent the use of uninitiated variables. Thanks to
-* F.Ranjard. Introduced in the 3.14 correction cradel.
-*
-*===> 1/NOV/1991
-*
-* Useless code commented out in GTRAIN. Thanks to F.Carminati.
-*
-* GNCONE gone to double precision. Thanks to J.Toth.
-*
-*===> 5/NOV/1991
-*
-* Variable USERW undefined in the RESULT common now set to
-* UPWGHT from GCTRAK common. Thanks to F.Ranjard.
-*
-* Type declarations for GCSTAK completed. Thanks to M.Battle.
-*
-*===> 5/DEC/1991
-*
-* New calculation of the range table. Simpson integration rule
-* used. Modifications in GRANGI, GCOEFF.
-*
-*===> 10/DEC/1991
-*
-* Protection introduced against the reading of a pre-315 data
-* structure. The value of STEMAX is set to BIG in this case.
-* Modification in GPHYSI.
-*
-* Better handling of version numbers in I/O operations.
-* Modifications in GPHYSI and GRIN.
-*
-*===> 08/JAN/1992
-*
-* Correction in GLANDZ to avoid gaussian distribution for
-* very thin layers. The version of GEANT 3.13 has been
-* used for this. Thanks to F.Carminati and M.Maire.
-*
-* Corrections in GTNEXT, GINVOL and GTMEDI to protect against
-* wrong values of INGOTO when using MANY volumes. Thanks to
-* R.Brun.
-*
-*===> 15/JAN/1992
-*
-*???> Backward incompatibility
-*
-* The random numbers seeds are stored at the end of every event
-* in the JRUNG bank at locations 19 and 20. If the JRUNG data
-* structure is read in and the data card RNDM or the interactive
-* command RNDM has not been issued (NRNDM(1), NRNDM(2) <> 0),
-* and if the words 19/20 are not 0, then the random number
-* generator is restarted with these seeds. Thanks to F.Carminati
-*
-* The RNDM command now reads the values of the seeds into
-* NRNDM(1) and NRNDM(2) in common GCFLAG. The values 0 0
-* can be used for the random seeds. These values will not
-* alter the current status of the random number generator,
-* but zeroing the variables NRNDM(1) and NRNDM(2) will
-* allow them to be reinitialised with the values stored
-* in a data structure read from disk. Thanks to F.Carminati
-*
-* Routine GREND now needs an integer as input. This is to be
-* consistent with GRFILE.
-*
-*===> 27/JAN/1992
-*
-* The following changes made to the names of FLUKA routines
-* to avoid clashes with ISAJET. Thanks to L.Roberts.
-*
-* Type Original name New name
-* Routine DECAY FKDECA
-* Routine FLAVOR FKFLAV
-* Routine SIGINT FKSIGI
-*
-*===> 31/JAN/1992
-*
-* Corrections in GMEDIA in case of many volumes to avoid
-* program crash. Thanks to R.Jones.
-*
-* Change of logics in GRUN. Now if NEVENT is <= 0, no event
-* is processed. Thanks to B.Lockman.
-*
-* Common GCFLAX put in the GCFLAG sequence with the BATCH and
-* NOLOG variable from GXINT. Thanks to B.Cole.
-*
-* Problem corrected in GDECAY. The mass of the particle was
-* altered. If the next particle was the same, the mass was
-* not reset to its correct value. Thanks to S.Tonse.
-*
-* TIMINT is now really the time left after initiatlization
-* as is specified in the documentation and not the time
-* USED for initialization as it was till now.
-* Thanks to V.Ivanov.
-*
-* Corrections in GNPGON. Improvement of code safety under
-* optimization in GNOGO1, GNPGON, GNPCON. Thanks to Y.Iga.
-*
-*===> 4/FEB/1992
-*
-* Corrections in GMULOF and GTHADR. SFIELD takes precedence
-* on STMIN in case IFIELD=1 to make sure that the Runge-Kutta
-* approssimation still works. Thanks to R.Hawkings.
-*
-*===> 10/FEB/1992
-*
-* Correction in GDRAY to improve the precision in the calculation
-* of the angle. Thanks to F.Carminati & P.Lubrano.
-*
-* Change in GFKINE. The variable TOFG is not updated any more.
-* Thanks to F.Carminati
-*
-* New GMEDIA, GTMEDI, GINVOL to take care of the problems with
-* MANY volumes. Thanks to R.Jones.
-*
-*===> 14/FEB/1992
-*
-* Bug corrected in GNPGON when the particle was exactly on the
-* wall of the last Z section. Thanks to V.Palichik.
-*
-*===> 17/FEB/1992
-*
-* Updated routines GLUND, GLUNDI and new sequences LUDAT1, LUDAT3,
-* LUJETS. The data cards MSTE, KTYP, PMAS, PWID, IDB have been
-* removed because either obsolete or not aplicable. The new code
-* runs with JETSET 7.3 upward. Thanks to F.Carminati, T.Sjostrand.
-*
-* Update of GLUDKY to work with 7.3. Thanks to F.Carminati.
-*
-*===> 23/FEB/1992
-*
-* New subroutine GFIN to handle sequential input. Routine GGET
-* has been maintained for backward compatibility.
-* Thanks to F.Carminati.
-*
-*===> 01/MAR/1992
-*
-* New Runge-Kutta integration routine for the tracking in
-* magnetic field. If the result of the stepping is not accurate,
-* the step is divided in 2 parts and the integration repeated
-* and so on. Thanks to V.Perevotchikov.
-*
-*===> 05/MAR/1992
-*
-* Correction in GLTRAC. When the particle fetched has an entry
-* in JKINE the correct vertex number is calculated. Thanks to
-* Y.Foka.
-*
-*===> 06/MAR/1992
-*
-* Correction in GTELEC. The calculated range may be slightly
-* larger than the maximum allowed range due to precision
-* problems and this was leading to very small negative steps.
-* Thanks to R.Brun.
-*
-*===> 08/MAR/1992
-*
-* New GRKUTA, GHELIX, GHELX3 from V.Perevotchikov.
-*
-*===> 16/MAR/1992
-*
-* ENERGY renamed to FKENER in FLUKA. Thanks to F.Carminati
-*
-*===> 17/MAR/1992
-*
-* VERTEX->FKVERT, ZEROIN->FKZERO, ERROR->FKERRO in FLUKA.
-* Thanks to F.Carminati
-*
-* Corrections in PBANH. Thanks to M.Sasaki.
-*
-*===> 19/MAR/1992
-*
-* Corrections in GFIN, GFOUT and GRIN, version 0 is now allowed
-* for a data structure in I/O. Thanks to B.Cole.
-*
-* Modification in GBREME to improve precision for small angles.
-* Thanks to F.Carminati.
-*
-* Inlining of rotation routines in GFTRAC, GINVOL, GTMEDI,
-* GTNEXT, GMEPOS, GMEDIA. Thanks to D.Kryn, F.Carminati.
-*
-* New routines GDLENS, GDPLST and GDPRTR in the drawing package.
-* New version of GDTREE. Thanks to S.Giani.
-*
-* Streamlining of GDTOM, GINROT, GITRAN, GMTOD, GRMTD, GRMUL,
-* GROT, GTRMUL and GTRNSF. Thanks to F.Carminati.
-*
-*===> 23/MAR/1992
-*
-*???> Backward incompatibility
-* Tracking medium name in GFTMED changed in CHARACTER variable.
-* Thanks to V.Perevotchikov.
-*
-* IMPULS renamed to FKIMPU
-* DRES renamed to FKDRES
-* ERUP renamed to FKERUP in FLUKA. Thanks to F.Carminati.
-*
-*===> 24/MAR/1992
-*
-* COSI entry point renamed to FKCOSI
-* POLI renamed to FKPOLI in FLUKA. Thanks to F.Carminati
-*
-* Changes in GCOMP to increase the precision of the rotation
-* of the scattered photons and electrons in the reference
-* frame of the incoming particle. Thanks to F.Carminati
-*
-* New version of the routines GNOPG1 and GNPGO1. Speed up of
-* a factor two or more achieved. Thanks to F.Carminati,
-* M.Roethlisberger.
-*
-*===> 29/MAR/1992
-*
-* Improvement of the routines GMEDIA, GTMEDI and GINVOL. A better
-* use is made of the variable INGOTO. Thanks to R.Jones, F.Carminati.
-*
-*===> 01/APR/1992
-*
-* Modification in GTRACK. If a particle tries for more than 5 times
-* consecutively to exit a volume, the precision used for tracking is
-* multiplied by 5 and so on every fifth attempt. Thanks to
-* F.Carminati.
-*
-* Modification in FLUFIN to normalise in double precision the
-* direction cosines given to FLUKA. Thanks to A.Ferrari
-*
-* Modification in GLANDZ to avoid peaks in energy loss for very
-* light materials. Thanks to F.Carminati
-*
-* New routine GETVER to crack the title sequence and to return
-* the correct version number. Thanks to F.Carminati and M.Maire.
-*
-+DECK,V_316
-*CMZ : 3.21/02 29/03/94 15.41.18 by S.Giani
-*-- Author :
-*
-* Correction cradle for version 3.15 of the GEANT Programme
-* and history of the evolution of 3.16.
-*
-* Important !!!
-* =============
-*
-* Only corrections flagged by "Introduced in the 3.15 correction
-* cradle" are applied to 3.15. All the other comments refer
-* to modifications which will appear in the 3.16 version of
-* the program.
-*
-********************************************************************
-*
-*===> 06/12/93
-*
-* Release of the 3.11 correction cradle.
-*
-*===> 02/12/93
-*
-* Correction in GBRELE and GRANGI. Thanks to F.Carminati.
-* Introduced in the 3.15 correction cradle.
-*
-*===> 29/11/93
-*
-* Release of the 3.10/00 correction cradle.
-*
-*===> 21/10/93
-*
-* Correction in FKDECA and HADEVV to permit the correct
-* treatment of charmed particles decay. Thanks to
-* A.Ferrari. Introduced in the 3.15 correction cradle.
-*
-* Correction in FKDRES to avoid a loop. Thanks to
-* B.Slater and A.Ferrari. Introduced in the 3.15 correction
-* cradle.
-*
-*===> 20/10/93
-*
-* Correction in GDRAW to update current pointer to IN
-* bank. Correction in GGPPAR to compute the internal
-* parameters of a TRAP with negative parameters. Thanks
-* to S.Banerjee. Introduced in the 3.15 correction cradle.
-*
-*===> 19/10/93
-*
-* Correction in GTNEUT, GTHADR, to allow hadronic decay
-* in the vacuum. Thanks to R.Jones. Introduced in the
-* 3.15 correction cradle.
-*
-*===> 01/10/93
-*
-* Correction in GNSLWD to avoid numerical problem. Thanks
-* to A.Parri. Introduced in the 3.15 correction cradle.
-*
-*===> 15/09/93
-*
-* Release of the 3.09/00 correction cradle.
-*
-*===> 13/09/93
-*
-* Correction in GNOCTU, thanks to M.Nessi. Introduced in
-* the 3.15 correction cradle.
-*
-*===> 03/09/93
-*
-* Correction in EVENTV to protect square root of a negative
-* number. Thanks to B.Slater and A.Ferrari. Introduced in
-* the 3.15 correction cradle.
-*
-*===> 11/08/93
-*
-* New tratment for thin layer, mainly gas, of dE/dx
-* introduced. Thanks to V.Grishin, S.Kotelnikov,
-* K.Lassila-Perini and P.Nevski.
-*
-* All bit manipulation functions replaced by Military
-* Standard functions. Thanks to F.Carminati.
-*
-*===> 19/07/93
-*
-* Correction in FLUFIN in order to avoid 0 mechanism
-* number when IHADR=2. Thanks to P.Bloch. Introduced
-* in the 3.15 correction cradle.
-*
-* Correction in GSROTM, NROTM updated when the bank is
-* pushed. Thanks to M.Maire. Introduced in the 3.15
-* correction cradle.
-*
-* Correction in ERTRGO. Thanks to E.Nagy. Introduced
-* in the 3.15 correction cradle.
-*
-*===> 07/06/93
-*
-* Release of version 3.08 of the correction cradle.
-*
-* New version of the FLUKA interface introduced. New
-* model for energy straggling introduced (Ermilova&
-* Checkin) and synchrotron radiation. Thanks to K.
-* Lassila-Perini, A.Ferrari&P.Sala et al. and I.
-* Gavrilenko. Please see the documentation for more
-* information.
-*
-* New routine GFANG introduced. It finds the angles
-* Theta and Phi which are used to rotate a vector in
-* the master system of the other. Thanks to F.Carminati
-*
-* New rotine GVROT introduced. It will rotate in full
-* double precision a vector in the reference system of
-* another one. Thanks to F.Carminati
-*
-* Corrections in GRIN/GFIN to calculate correctly the
-* number of rotation matrixes. Thanks to M.Maire.
-* Introduced in the 3.15 correction cradle.
-*
-* Correction in FLUFIN to pass antiprotons to FLUKA when
-* they are 'stopping'. Thanks to A.Ferrari. Introduced in
-* the 3.15 correction cradle.
-*
-*
-*===> 27/05/93
-*
-* Corrections in FLUFIN to pass stopping antiprotons,
-* antineutrons and pions to FLUKA for annihilation. The
-* other hadrons are either decayed or (neutral particles)
-* passed to GHEISHA/GHSTOP.
-*
-*===> 04/05/93
-*
-* Correction in FDNOPT to properly initialise an
-* array. Thanks to K.Lassila-Perini. Introduced in
-* the 3.15 correction cradle.
-*
-*===> 21/04/93
-*
-* New routine from Laszlo Urban for the tracking of
-* ions, GTHION. Ions now have to be given particle
-* type 8. Thanks to L.Urban.
-*
-*===> 18/04/93
-*
-* Addition in GPPERP, the sphere has been added. Thanks
-* to R.Jones.
-*
-* Old Hadrin/Nucrin interface deleted. HADR 3 flag has
-* no meaning any more. Warning message introduced in
-* GPHYSI, when IHADR=3 then reset it to 1 and use GHEISHA.
-* Thanks to F.Carminati.
-*
-* Tatina code eliminated from GEANT. Thanks to F.Carminati.
-*
-* Small changes in GSCHIT to avoid integer/floating
-* conversions and to speed-up the code. Thanks to
-* F.Carminati.
-*
-*===> 07/04/93
-*
-* Correction in the GPOISS routine to avoid overflows.
-* Thanks to S.Qian. Introduced in the 3.15 correction
-* cradle.
-*
-*===> 06/04/93
-*
-* Correction in GNSPHR to avoid floating point overflow.
-* Thanks to S.Ljungfelt. Introduced in the 3.15 correction
-* cradle.
-*
-*===> 22/03/93
-*
-* Correction in GEAMON to extend the field for CPU
-* time. Thanks to R.Brun. Introduced in the 3.15
-* correction cradle.
-*
-*===> 14/03/93
-*
-* Release of version 3.07 of the correction cradle.
-*
-* Corrections in GZINIT, GPHYSI and GDSHOW. The
-* working space is now allocated via calls to
-* GWORK. GWORK has been modified and it only
-* increases the working space, it never reduces it.
-* Thanks to M.Corden. Introduced in the 3.15
-* correction cradle.
-*
-*===> 10/03/93
-*
-* Correction in GFIN/GFOUT to avoid spurious error
-* message. Thanks to M.Maire.
-*
-*===> 03/03/93
-*
-* Correction in GLTRAC to improve the precision of
-* the calculation of the kinetic energy. Thanks to
-* C.Zeitnitz. Introduced in the 3.15 correction
-* cradle.
-*
-* Correction in GTRACK to avoid output overflow in
-* format statement. Thanks to M.Corden. Introduced
-* in the 3.15 correction cradle.
-*
-* Correction in GDXYZ to obtain the correct line color
-* for a track. Thanks to M.Corden. Introduced in the
-* 3.15 correction cradle.
-*
-*===> 02/03/93
-*
-* New treatment of the photoelectric effect introduced.
-* Thanks to J.Chwastowski. Please see documentation for
-* more information.
-*
-*===> 01/03/93
-*
-* Changes in GKGEOM to avoid warnings with the new
-* version of KUIP. Thanks to A.Nathaniel. Introduced
-* in the 3.15 correction cradle.
-*
-* Changes in GSDVN2 to support division of spheres
-* in PHI with initial offset. Thanks to F.Carminati.
-*
-* Changes in GMEDIV and GNSPHR to correct precision
-* problems. Thanks to F.Carminati.
-*
-* Introduction of the Cerenkov effect. Thanks to
-* R.Jones. Please see documentation for more
-* details.
-*
-*===> 12/02/93
-*
-* Changes in GSDVN to support division in PHI (axis
-* N. 3) of the sphere. Thanks to F.Carminati.
-*
-* Changes in GDRAWS to partially support the drawing
-* of parts of sphere. Thanks to F.Carminati.
-*
-*===> 09/02/93
-*
-* Release of version 3.06 of the correction cradle.
-*
-*===> 28/01/93
-*
-* Correction in GXINT for compatibility with the KUIP
-* installed with version 93a of the CERN Program Library.
-* Thanks to R.Jones. Introduced in the 3.15 correction
-* cradle.
-*
-*===> 27/01/93
-*
-* Correction in GMUNU. Only GHEISHA used to handle the
-* interaction irrespective of the value of IHADR. Thanks
-* to K.Lassila-Perini and G.Battistoni. Introduced in the
-* 3.15 correction cradle.
-*
-* Corrections in GGPPAR to handle a tube with negative
-* parameters positioned into a tubes in the general case.
-* Thanks to F.Carminati.
-*
-*===> 19/01/93
-*
-* Correction in FLUFIN to make sure that just neutrons
-* are passed to GHEISHA. Thanks to K.Lassila. Introduced
-* in the 3.15 correction cradle.
-*
-*===> 21/12/92
-*
-* Option Q(uiet) introduced in GRIN/GROUT. Thanks to
-* M.Maire.
-*
-* New version of GRKUTA protected against 0 fields and
-* improved for precision. Introduced in the 3.15 correction
-* cradle. Thanks to W.Manner.
-*
-*===> 15/12/92
-*
-* IQ(JRUNG+29) set to the event sequence number of the
-* last generated event in GTRIGC. Thanks to M.Maire.
-*
-*===> 11/12/92
-*
-* Call to LUPART replaced with LU1ENT in GLUDKY. LUPART
-* was an obsolete routine deleted from JETSET 7.3
-* library. Thanks to R.Gomes.
-*
-*===> 23/11/92
-*
-* Release of the version 3.05/00 of the correction
-* cradle.
-*
-* Corrections in GRANGI to account for the use of the
-* ERAN card. Thanks to P.Gumplinger. Introduced in the
-* 3.15 correction cradle.
-*
-*===> 18/11/92
-*
-* Correction in GDRAWS for very thin CTUBes. Thanks to
-* M.Guidal. Introduced in the 3.15 correction cradle.
-*
-* New version of GRKUTA introduced. It will limit the
-* number of iterations and cut steps to prevent looping.
-* Thanks to V.Perevotchikov. Introduced in the 3.15
-* correction cradle.
-*
-*===> 11/11/92
-*
-* Correction in GGDSPE to allow repeated division of
-* tubes along R. Thanks to M.Maire. Introduced in the
-* 3.15 correction cradle.
-*
-*===> 11/11/92
-*
-* Correction in GNPCON when the particle is slightly
-* outside of the last plane in Z. It could happen for
-* precision problems. Thank to C.Georgiopoulos.
-* Introduced in the 3.15 correction cradle.
-*
-* Quiet option introduced in GFIN and GFOUT to suppress
-* printing. Thanks to A.Eisner.
-*
-* Correction in the header of GFIN, GFOUT. Thanks to
-* A.Eisner.
-*
-* Correction to GSNEXT. It now checks the values of the
-* input list. Repeated values or values which are not
-* within the allowed limits are ignored and a warning
-* message is printed. Thanks to F.Luehring.
-*
-*===> 04/11/92
-*
-* Modification in GSVOLU. A warning is printed if the same
-* volume name is repeated twice. Thanks to V.Perevoztchikov.
-*
-*===> 23/10/92
-*
-* Print statement in GSKING replaced by a WRITE(CHMAIL
-* Thanks to F.Carminati.
-*
-*===> 19/10/92
-*
-* Correction in GDRAY to increase the precision of
-* the angle calculation. Thanks to F.Malek.
-* Introduced in the 3.15 correction cradle.
-*
-*===> 19/10/92
-*
-* Release of version 3.04 of the correction cradle.
-*
-* Corrections in FEREVV and HADEVV. Thanks to A.Ferrari.
-* Introduced in the 3.15 correction cradle.
-*
-*===> 16/10/92
-*
-* Release of version 3.03 of the correction cradle.
-*
-*===> 13/10/92
-*
-* Correction in GFIN and GFOUT to handle correctly
-* ZEBRA error conditions. Thanks to H.Uijterwaal.
-* Introduced in the 3.15 correction cradle.
-*
-* Correction in GDECAY to improve precision of rotation
-* of secondaries. Thanks to F.Carminati. Introduced in
-* the 3.15 correction cradle.
-*
-* Correction in FEREVV to avoid square root of negative
-* number. Thanks to A.Ferrari. Introduced in the 3.15
-* correction cradle.
-*
-* Correction in GDRAW to avoid error when traversing the
-* tree. Thanks to F.Carminati. Included in the 3.15
-* correction cradle.
-*
-*===> 09/10/92
-*
-* Correction in GXPICT, added definition of a character
-* variable. Thanks to F.Carminati. Introduced in the 3.15
-* correction cradle.
-*
-*===> 08/10/92
-*
-* Corrections in ERPRDOC, EUFILV and ERTEST to change
-* Hollerith in characters for GEANE. Thanks to V.Innocente.
-* Introduced in the 3.15 correction cradle.
-*
-*===> 24/09/92
-*
-* Correction in NUCREL to avoid square root of negative
-* numbers. Thanks to A.Ferrari. Introduced in the 3.15
-* correction cradle.
-*
-*===> 23/09/92
-*
-* Correction in GMEDIA. INFR not set going up the tree to
-* avoid problem with user calls of GMEDIA during tracking.
-* Thanks to S.Banerjee. Introduced in the 3.15 correction
-* cradle.
-*
-*===> 21/09/92
-*
-* Correction in GRANGI to avoid interpolation of DE/DX
-* beyond 10GeV. Thanks to V.Innocente. Introduced in the
-* 3.15 correction cradle.
-*
-*===> 16/09/92
-*
-* Correction in GBRELA. Auxiliary integration point for
-* muon dedx table was wrong. Thanks to V.Innocente.
-* Introduced in the 3.15 correction cradle.
-*
-*===> 15/09/92
-*
-* Release of version 3.02 of the correction cradle.
-*
-* Correction in GMEDIA, GTMEDI: JVIN not properly
-* initialised. Thanks to F.Carminati. Introduced in
-* the 3.15 correction cradle.
-*
-* Release of version 3.01 of the correction cradle.
-*
-* Correction to GSDVN for a mistype. Thanks to H.Plothow.
-* Introduced in the 3.15 correction cradle.
-*
-* Small mod to GSNGTR for the CRAY. Function DSIGN changed
-* to SIGN. Thanks to F.Carminati. Introduced in the 3.15
-* correction cradle.
-*
-* Release of version 3.00 of the correction cradle.
-*
-* Correction in GDECAY. When IDCAY=2 the routine does not
-* produce secondaries. Thanks to R.Jones. Introduced in
-* the 3.15 correction cradle.
-*
-* Corrections in GFIN, GFOUT. Thanks to B.Cole. Introduced
-* in the 3.15 correction cradle.
-*
-*===> 14/09/92
-*
-* Correction in GMEDIV, GMEDIA, GINVOL, GTMEDI to
-* improve precision and prevent blocking of volumes.
-* Thanks to F.Carminati, R.Jones. Introduced in the
-* 3.15 correction cradle.
-*
-*===> 03/09/92
-*
-* GDLADY and GDMISS routines introduced. Thanks to
-* H.Plothow.
-*
-* Correction in GXDRAW for the coordinates of the
-* drawing of the GIRL. Thanks to F.Carminati.
-* Introduced in the 3.15 correction cradle.
-*
-* Correction in GPHSIG, typing mistake in a formula.
-* Thanks to M.Fanti. Introduced in the 3.15 correction
-* cradle.
-*
-*===> 02/09/92
-*
-* Corrections in GSDVN, GGPPAR, GGDPAR, GMEDIV, GCENT,
-* GSDVN2, GSDVT, GSDVT2 to allow the division of a TRAP
-* along y. Thanks to F.Carminati. Introduced in the 3.15
-* correction cradle.
-*
-* Corrections in GNPGO1 for precision problems. Thanks
-* to K.Lassila. Introduced in the 3.15 correction
-* cradle.
-*
-* Corrections in GGDPAR, GSDVN for the z division of a
-* Polygone. Thanks to F.Carminati. Introduced in the
-* 3.15 correction cradle.
-*
-*===> 01/09/92
-*
-* Correction in GSDVT for the division of a parallepiped.
-* Thanks to Y.Fisiak. Introduced in the 3.15 correction
-* cradle.
-*
-* Correction in GRKUTA. Helix is used if angle of
-* curvature is too large. In this case step is anyway
-* smaller than STMIN which is under user control.
-* Thanks to H.Plothow and V.Perevotchikov. Introduced
-* in the 3.15 correction cradle.
-*
-*===> 26/08/92
-*
-* Correction in GKRZ and CDF for the command RZ/FILE.
-* Record lenght fixed at 1024 in GRFILE cannot be
-* Changed by the user. Thanks to H.Plothow. Introduced
-* in the 3.15 correction cradle.
-*
-* Corrections in GTMEDI, GMEDIA and GINVOL for the case
-* of 'MANY' volumes. Uncleared blocking words found in
-* the tree. Thanks to H.Plothow. Introduced in the 3.15
-* correction cradle.
-*
-*===> 25/08/92
-*
-* Correction in GNSPHR. The PHI limits were used
-* incorrectly in calculating the distance to the
-* sphere. This was slowing down calculation but still
-* giving correct results. Thanks to J.Stepanek.
-* Introduced in the 3.15 correction cradle.
-*
-*===> 21/08/92
-*
-* Correction in GGORDQ. Incorrect counting of volumes
-* in case of phi ordering and phi division spanning
-* across 0 degrees. Thanks to L.Roberts and F.Carminati.
-* Introduced in the 3.15 correction cradle.
-*
-*===> 18/08/92
-*
-* Version 2.00 of the correction cradle released
-*
-*
-* Correction in GDRELP and GDRELM. The shell corrections
-* where underestimated due to a wrong factor introduced
-* translating the original formula from ev to Gev. Thanks
-* to A.Ferrari and K.Lassila-Perini. Introduced in the
-* 3.15 correction cradle.
-*
-*===> 17/08/92
-*
-* Correction in GCENT in case of general trapezoid sliced
-* in z in a local development structure.
-* Thanks to S.Chekhtman. Introduced in the 3.15 correction
-* cradle.
-*
-* Correction in GHEISH. Time of flight correctly initialised
-* for particles with number > 48. Thanks to A.Eisner.
-* Introduced in the 3.15 correction cradle.
-*
-*===> 14/08/92
-*
-* Correction in GGPPAR for boxes with negative parameters
-* in traps. The current code supports correctly boxes with
-* one, two or three negative parameters positioned in a trap
-* not necessarily in the centre. The trap must not be twisted
-* and the ALP1 and ALP2 angles (PAR(7) and PAR(11)) must be
-* equal. This facility must be used with care because the
-* algorithm first maximises Z, then Y and then X. The result
-* may be not quite what is expected in all cases, and the
-* user is invited to check carefully the result. Thanks to
-* H.Plothow. Introduced in the 3.15 correction cradle.
-*
-*===> 12/08/92
-*
-* Correction in GINVOL, GTMEDI and GMEDIA to handle correctly
-* the GSNEAR case when LIST(1)=1 and LIST(2)=0, that is when
-* all the volume are separated inside a mother. Optimisation
-* of the routine in case a large number of objects are
-* positioned at the same level and GUNEAR is used. Thanks to
-* R.Jones, M.Lefebvre and M.Pieri. Introduced in the 3.15
-* correction cradle.
-*
-*===> 07/08/92
-*
-* Correction in GTNEXT. When the currents step brings
-* the particle on the surface of the next volume, signal
-* IGNEXT=1 to GTxxxx to 'push' into the next volume.
-* This is a genuine bug and some volumes may be lost
-* due to this. Thanks to M.Maire. Introduced in the 3.15
-* correction cradle.
-*
-*===> 02/08/92
-*
-* Corrections to the precision in GNOPG1, GNCONE, GNOCON.
-* Thanks to R.Jones. Introduced in the 3.15 correction
-* cradle.
-*
-*===> 31/07/92
-*
-* Correction in the printout of GTRACK when max number
-* of steps is reached. Event number and random numbers are
-* printed out as well. Thanks to M.Maire. Introduced in the
-* 3.15 correction cradle.
-*
-*===> 29/07/92
-*
-* Correction in PIMABS for HPUX only. If variable NT is
-* saved then the routine compiles correctly, otherwise
-* not. Thanks to F.Carminati. Introduced in the 3.15
-* correction cradle.
-*
-* Correction in NIZL. All local variable are saved now.
-* Thanks to F.Carminati. Introduced in the 3.15 correction
-* cradle.
-*
-*===> 29/07/92
-*
-* Correction in CDF and in GKDRAW. Minimum angle for the
-* drawing is 0 and not 1. Thanks to H.Plothow. Introduced
-* in the 3.15 correction cradle.
-*
-* Minor update of GXFZ, a character length has been set
-* to 4 to keep KUIP happy. Thanks to F.Carminati. Introduced
-* in the 3.15 correction cradle.
-*
-*===> 28/07/92
-*
-* Corrections in GXFZ. Now the array LUNITS is properly
-* updated when a file is closed.
-*
-* Correction in GBRSGE, GBRSGM. Save statement introduced.
-* Thanks to L.Roberts. Introduced in the 3.15 correction
-* cradle.
-*
-* Correction in GINVOL for many volumes. Thanks to S.Giani
-* and R.Jones. Introduced in the 3.15 correction cradle.
-*
-* Correction in GMCOUL to prevent a division by 0. Thanks
-* to M.Maire. Introduced in the 3.15 correction cradle.
-*
-*===> 03/06/92
-*
-* Correction in GSNGTR. Double precision variables removed
-* in case of 64 bits machines. Thanks to E.Boehm. Introduced
-* in the 3.15 correction cradle.
-*
-* Correction in the SROTM command. The lower limit for
-* PHI3 is really 0. and not 1. Thanks to E.Boehm. Introduced
-* in the 3.15 correction cradle.
-*
-*===> 01/06/92
-*
-* New version of GRKUTA. In fact this is the 3.14 version
-* with the multiple steps algorithm of 3.15 introduced.
-* If the bending angle in one step is too big, then the
-* integration is done in several steps rather than in
-* one. The IMPLICIT REAL*8 in the cradle is to avoid
-* problems with the CRAY in the absence of PATCHY delayed
-* control cards. Thanks to V.Perevotchikov. Introduced in
-* the 3.15 correction cradle.
-*
-*===> 25/05/92
-*
-* Sequence GCONSP changed for 32 bits machines. All
-* constants are suffixed with D0 to avoid truncations.
-* Thanks to F.Carminati. Introduced in the 3.15 correction
-* cradle.
-*
-*===> 25/05/92
-*
-* Version 1.00 of the correction cradle released
-*
-*===> 21/05/92
-*
-* Correction in GHFNUC: TNNUC variable was undefined.
-* Thanks to B.Lund-Jensen.
-* Introduced in the 3.15 correction cradle.
-*
-*===> 08/05/92
-*
-* Correction in TWOCLU to avoid infinite looping in some
-* pathological cases. Thanks to L.Roberts.
-* Introduced in the 3.15 correction cradle.
-*
-*===> 06/05/92
-*
-* Correction in GNPGO1. Constants changed to double
-* precision to avoid problems on the IBM. Thanks to
-* D.Ward.
-* Introduced in the 3.15 correction cradle.
-*
-*===> 28/04/92
-*
-* Correction in GXINT to obtain the correct time in
-* the monitoring routine when running interactively
-* on IBM/VM. Thanks to F.Carminati.
-* Introduced in the 3.15 correction cradle.
-*
-*===> 16/04/92
-*
-* Correction in GMULTS. A particle going exactly along
-* the negative direction of the Z axis could be rotated
-* of 180 degrees after multiple scattering. Thanks to
-* P.Gabriel.
-* Introduced in the 3.15 correction cradle.
-*
-*===> 15/04/92
-*
-* Correction in GXDRAW. The arguments of DHEAD were
-* fetched with the wrong order. Thanks to F.Videbaek.
-* Introduced in the 3.15 correction cradle.
-*
-* Correction in GPHYSI. Variable NUMOLD is now reset to
-* zero. This may affect people running interactively and
-* using the command PHYSI. Thanks to F.Videbaek.
-* Introduced in the 3.15 correction cradle.
-*
-+PATCH,*GEANT
-+DECK,BLANKDEK.
-*CMZ : 3.21/02 29/03/94 15.41.18 by S.Giani
-*-- Author :
-+USE,GCDES.
-+USE,GBASE.
-+USE,GCONS.
-+USE,GHITS.
-+USE,GIOPA.
-+USE,GKINE.
-+USE,GPHYS.
-+USE,GTRAK.
-+USE,GSTRAG.
-+USE,GUSER.
-+USE, SINGLE, IF=CDC, CRAY.
-+USE, F2C, IF=MSDOS,WINNT,LINUX.
-+USE, UNIX, IF=SUN, SGI, DECS, CONVEX, IBMRT, AIX370.
-+USE, UNIX, IF=HPUX, APOLLO, IPSC, NEXT.
-+USE, IBMALL, IF=IBM, IBMMVS, AIX370.
-+USE, DOUBLE, IF=APOLLO, IBMALL, VAX.
-+USE, DOUBLE, IF=UNIX, IF=-SINGLE.
-+USE, BSLASH, IF=SUN, SGI, DECS, IBMRT, IPSC, F2C, QMALPH.
-+USE, USRJMP, IF=UNIX.
-+USE, HIGZ,CG,MONITOR,FLUKA,IF=BLDLIB.
-+DECK, INCSEQ, IF=INCLUDE
-*CMZ : 3.21/02 29/03/94 15.41.18 by S.Giani
-*-- Author :
-+KEEP,INCBEG,IF=IBM
- INCLUDE '
-+KEEP,INCEND,IF=IBM
- +'
-+PATCH,*GEAINC,IF=MINCL.
-+DECK,blankdek.
-*CMZ : 3.21/02 29/03/94 15.41.18 by S.Giani
-*-- Author :
-+USE,GCDES
-+USE,GTINCL. Include files for GEANT car file
-+USE,GGINCL. Include files for GEANG car file CG package
-+USE,GFINCL. Include files for GEANF car file
-+USE,GHINCL. Include files for GEANH car file
-+USE,ERINCL Include files for GEANE car file
-+PATCH,GCDES.
-+DECK,BLANKDEK,IF=-INCLUDE.
-*CMZ : 3.21/02 29/03/94 15.41.18 by S.Giani
-*-- Author :
-+KEEP,GTLINK
- INTEGER JDIGI ,JDRAW ,JHEAD ,JHITS ,JKINE ,JMATE ,JPART
- + ,JROTM ,JRUNG ,JSET ,JSTAK ,JGSTAT,JTMED ,JTRACK,JVERTX
- + ,JVOLUM,JXYZ ,JGPAR ,JGPAR2,JSKLT
-C
-+KEEP,GCLINK
-+SEQ, GTLINK, IF=TYPE.
- COMMON/GCLINK/JDIGI ,JDRAW ,JHEAD ,JHITS ,JKINE ,JMATE ,JPART
- + ,JROTM ,JRUNG ,JSET ,JSTAK ,JGSTAT,JTMED ,JTRACK,JVERTX
- + ,JVOLUM,JXYZ ,JGPAR ,JGPAR2,JSKLT
-C
-+KEEP,GTBANK
- INTEGER IQ,LQ,NZEBRA,IXSTOR,IXDIV,IXCONS,LMAIN,LR1,JCG
- INTEGER KWBANK,KWWORK,IWS
- REAL GVERSN,ZVERSN,FENDQ,WS,Q
-C
-+KEEP,GCBANK
-+SEQ,GTBANK,IF=TYPE.
- PARAMETER (KWBANK=69000,KWWORK=5200)
- COMMON/GCBANK/NZEBRA,GVERSN,ZVERSN,IXSTOR,IXDIV,IXCONS,FENDQ(16)
- + ,LMAIN,LR1,WS(KWBANK)
- DIMENSION IQ(2),Q(2),LQ(8000),IWS(2)
- EQUIVALENCE (Q(1),IQ(1),LQ(9)),(LQ(1),LMAIN),(IWS(1),WS(1))
- EQUIVALENCE (JCG,JGSTAT)
-+SEQ,GCLINK
-+KEEP,GTCURS
- INTEGER INTFLA
- REAL SIZD2,FACHV,HALF,SAVPLX,SAVPLY,YPLT,XPLT
-*
-+KEEP,GCCURS
-+SEQ,GTCURS,IF=TYPE
- COMMON/GCCURS/INTFLA,SIZD2,FACHV,HALF,SAVPLX,SAVPLY,YPLT,XPLT
-*
-+KEEP,GTCUTS
- REAL CUTGAM,CUTELE,CUTNEU,CUTHAD,CUTMUO,BCUTE,BCUTM
- + ,DCUTE ,DCUTM ,PPCUTM,TOFMAX,GCUTS
-C
-+KEEP,GCCUTS
- COMMON/GCCUTS/CUTGAM,CUTELE,CUTNEU,CUTHAD,CUTMUO,BCUTE,BCUTM
- + ,DCUTE ,DCUTM ,PPCUTM,TOFMAX,GCUTS(5)
-C
-+SEQ,GTCUTS,IF=TYPE.
-+KEEP,GTURSB
- INTEGER NUMNDS,IADDI,NUMND2,NNPAR,IISELT
-*
-+KEEP,GCURSB
- COMMON/GCURSB/NUMNDS,IADDI,NUMND2,NNPAR,IISELT
- COMMON/GCURSC/MOMO
- CHARACTER*4 MOMO
-*
-+SEQ,GTURSB,IF=TYPE
-+KEEP,GTFLAG.
- INTEGER IDEBUG,IDEMIN,IDEMAX,ITEST,IDRUN,IDEVT,IEORUN
- + ,IEOTRI,IEVENT,ISWIT,IFINIT,NEVENT,NRNDM
-C
-+KEEP,GCFLAG
- COMMON/GCFLAG/IDEBUG,IDEMIN,IDEMAX,ITEST,IDRUN,IDEVT,IEORUN
- + ,IEOTRI,IEVENT,ISWIT(10),IFINIT(20),NEVENT,NRNDM(2)
- COMMON/GCFLAX/BATCH, NOLOG
- LOGICAL BATCH, NOLOG
-C
-+SEQ,GTFLAG,IF=TYPE.
-+KEEP,GCNMEC
- PARAMETER(NMECA=45,IBLOWN=23)
- CHARACTER*4 CHNMEC(NMECA)
-*
-* *** Two blank spaces for FISF and CAPF which do not exist
-*
-* *** The low-neutron cross-sections have to be at the end for the
-* *** logics of the routine to work, and they have to start at
-* *** IBLOWN
- DATA CHNMEC /
- + 'HADF', 'INEF', 'ELAF', 'NULL', 'NULL',
- + 'HADG', 'INEG', 'ELAG', 'FISG', 'CAPG',
- + 'LOSS', 'PHOT', 'ANNI', 'COMP', 'BREM',
- + 'PAIR', 'DRAY', 'PFIS', 'RAYL', 'MUNU',
- + 'RANG', 'STEP', 'LOWN', 'NABS', 'NELA',
- + 'NINE', 'NINC', 'N,2N', 'N,3N', 'N,NA',
- + 'N2NA', 'N,NP', 'NFIS', 'N,GA', 'N,PR',
- + 'N,DE', 'N,TR', 'N3HE', 'N,AL', 'N,2A',
- + 'N,3A', 'N,2P', 'N,PA', 'NT2A', 'ND2A'/
-*
-+KEEP,GTOPTI
- INTEGER IOPTIM
-+KEEP,GCOPTI
- COMMON/GCOPTI/ IOPTIM
-C
-+SEQ, GTOPTI, IF=TYPE
-+KEEP,GCJLOC
- COMMON/GCJLOC/NJLOC(2),JTM,JMA,JLOSS,JPROB,JMIXT,JPHOT,JANNI
- + ,JCOMP,JBREM,JPAIR,JDRAY,JPFIS,JMUNU,JRAYL
- + ,JMULOF,JCOEF,JRANG
-C
- INTEGER NJLOC ,JTM,JMA,JLOSS,JPROB,JMIXT,JPHOT,JANNI
- + ,JCOMP,JBREM,JPAIR,JDRAY,JPFIS,JMUNU,JRAYL
- + ,JMULOF,JCOEF,JRANG
-C
- COMMON/GCJLCK/NJLCK(2),JTCKOV,JABSCO,JEFFIC,JINDEX,JCURIN
- + ,JPOLAR,JTSTRA,JTSTCO,JTSTEN,JTASHO
-C
- EQUIVALENCE (JLASTV,JTSTEN)
-C
- INTEGER NJLCK,JTCKOV,JABSCO,JEFFIC,JINDEX,JCURIN
- + ,JPOLAR,JLASTV,JTSTRA,JTSTCO,JTSTEN
- + ,JTASHO
-C
-+KEEP,GTKINE.
- INTEGER IKINE,ITRA,ISTAK,IVERT,IPART,ITRTYP,NAPART,IPAOLD
- REAL PKINE,AMASS,CHARGE,TLIFE,VERT,PVERT
-C
-+KEEP,GCKINE
- COMMON/GCKINE/IKINE,PKINE(10),ITRA,ISTAK,IVERT,IPART,ITRTYP
- + ,NAPART(5),AMASS,CHARGE,TLIFE,VERT(3),PVERT(4),IPAOLD
-C
-+SEQ,GTKINE,IF=TYPE.
-+KEEP,GCKMAX
- INTEGER MXGKIN
- PARAMETER (MXGKIN=100)
-+KEEP,GCKING
-+SEQ, GCKMAX
- COMMON/GCKING/KCASE,NGKINE,GKIN(5,MXGKIN),
- + TOFD(MXGKIN),IFLGK(MXGKIN)
- INTEGER KCASE,NGKINE ,IFLGK,MXPHOT,NGPHOT
- REAL GKIN,TOFD,XPHOT
-C
- PARAMETER (MXPHOT=800)
- COMMON/GCKIN2/NGPHOT,XPHOT(11,MXPHOT)
-C
- COMMON/GCKIN3/GPOS(3,MXGKIN)
- REAL GPOS
-C
-+KEEP,GTLIST.
- INTEGER NHSTA,NGET ,NSAVE,NSETS,NPRIN,NGEOM,NVIEW,NPLOT
- + ,NSTAT,LHSTA,LGET ,LSAVE,LSETS,LPRIN,LGEOM,LVIEW,LPLOT,LSTAT
-C
-+KEEP,GCLIST
- COMMON/GCLIST/NHSTA,NGET ,NSAVE,NSETS,NPRIN,NGEOM,NVIEW,NPLOT
- + ,NSTAT,LHSTA(20),LGET (20),LSAVE(20),LSETS(20),LPRIN(20)
- + ,LGEOM(20),LVIEW(20),LPLOT(20),LSTAT(20)
-C
-+SEQ,GTLIST,IF=TYPE.
-+KEEP,GCMATE
- COMMON/GCMATE/NMAT,NAMATE(5),A,Z,DENS,RADL,ABSL
-C
- INTEGER NMAT,NAMATE
- REAL A,Z,DENS,RADL,ABSL
-C
-+KEEP,GCMULO
- COMMON/GCMULO/SINMUL(101),COSMUL(101),SQRMUL(101),OMCMOL,CHCMOL
- + ,EKMIN,EKMAX,NEKBIN,NEK1,EKINV,GEKA,GEKB,EKBIN(200),ELOW(200)
-C
- REAL SINMUL,COSMUL,SQRMUL,OMCMOL,CHCMOL,EKMIN,EKMAX,ELOW,EKINV
- REAL GEKA,GEKB,EKBIN
- INTEGER NEKBIN,NEK1
-C
-+KEEP,GCMZFO
- COMMON/GCMZFO/IOMATE,IOPART,IOTMED,IOSEJD,IOSJDD,IOSJDH,IOSTAK
- + ,IOMZFO(13)
-C
- INTEGER IOMATE,IOPART,IOTMED,IOSEJD,IOSJDD,IOSJDH,IOSTAK
- + ,IOMZFO
-C
-+KEEP,GTNUM.
- INTEGER NMATE ,NVOLUM,NROTM,NTMED,NTMULT,NTRACK,NPART
- + ,NSTMAX,NVERTX,NHEAD,NBIT ,NALIVE,NTMSTO
-C
-+KEEP,GCNUM
- COMMON/GCNUM/NMATE ,NVOLUM,NROTM,NTMED,NTMULT,NTRACK,NPART
- + ,NSTMAX,NVERTX,NHEAD,NBIT
- COMMON /GCNUMX/ NALIVE,NTMSTO
-C
-+SEQ,GTNUM,IF=TYPE.
-+KEEP,GTCONS
- REAL PI,TWOPI,PIBY2,DEGRAD,RADDEG,CLIGHT,BIG,EMASS
- REAL EMMU,PMASS,AVO
-C
-+KEEP,GCONSP,IF=SINGLE
- REAL PI,TWOPI,PIBY2,DEGRAD,RADDEG,CLIGHT,BIG,EMASS
- REAL EMMU,PMASS,AVO
-*
- PARAMETER (PI=3.14159265358979324)
- PARAMETER (TWOPI=6.28318530717958648)
- PARAMETER (PIBY2=1.57079632679489662)
- PARAMETER (DEGRAD=0.0174532925199432958)
- PARAMETER (RADDEG=57.2957795130823209)
- PARAMETER (CLIGHT=29979245800.)
- PARAMETER (BIG=10000000000.)
- PARAMETER (EMASS=0.00051099906)
- PARAMETER (EMMU=0.105658389)
- PARAMETER (PMASS=0.93827231)
- PARAMETER (AVO=0.60221367)
-*
-+KEEP,GCONSP,IF=-SINGLE
- DOUBLE PRECISION PI,TWOPI,PIBY2,DEGRAD,RADDEG,CLIGHT,BIG,EMASS
- DOUBLE PRECISION EMMU,PMASS,AVO
-*
- PARAMETER (PI=3.14159265358979324D0)
- PARAMETER (TWOPI=6.28318530717958648D0)
- PARAMETER (PIBY2=1.57079632679489662D0)
- PARAMETER (DEGRAD=0.0174532925199432958D0)
- PARAMETER (RADDEG=57.2957795130823209D0)
- PARAMETER (CLIGHT=29979245800.D0)
- PARAMETER (BIG=10000000000.D0)
- PARAMETER (EMASS=0.0005109990615D0)
- PARAMETER (EMMU=0.105658387D0)
- PARAMETER (PMASS=0.9382723128D0)
- PARAMETER (AVO=0.60221367D0)
-*
-+KEEP,GCONST.
-+SEQ, GTCONS, IF=TYPE.
- COMMON/GCONST/PI,TWOPI,PIBY2,DEGRAD,RADDEG,CLIGHT,BIG,EMASS
- COMMON/GCONSX/EMMU,PMASS,AVO
-C
-+KEEP,GTPHYS.
- INTEGER IPAIR,ICOMP,IPHOT,IPFIS,IDRAY,IANNI,IBREM,IHADR,IMUNU
- + ,IDCAY,ILOSS,IMULS,IRAYL,ILABS,ISYNC,ISTRA
- REAL SPAIR,SLPAIR,ZINTPA,STEPPA,SCOMP,SLCOMP,ZINTCO,STEPCO
- + ,SPHOT,SLPHOT,ZINTPH,STEPPH,SPFIS,SLPFIS,ZINTPF,STEPPF
- + ,SDRAY,SLDRAY,ZINTDR,STEPDR,SANNI,SLANNI,ZINTAN,STEPAN
- + ,SBREM,SLBREM,ZINTBR,STEPBR,SHADR,SLHADR,ZINTHA,STEPHA
- + ,SMUNU,SLMUNU,ZINTMU,STEPMU,SDCAY,SLIFE ,SUMLIF,DPHYS1
- + ,SLOSS,SOLOSS,STLOSS,DPHYS2,SMULS,SOMULS,STMULS,DPHYS3
- + ,SRAYL,SLRAYL,ZINTRA,STEPRA,SLABS,SLLABS,ZINTLA,STEPLA
-C
-+KEEP,GCPHYS
- COMMON/GCPHYS/IPAIR,SPAIR,SLPAIR,ZINTPA,STEPPA
- + ,ICOMP,SCOMP,SLCOMP,ZINTCO,STEPCO
- + ,IPHOT,SPHOT,SLPHOT,ZINTPH,STEPPH
- + ,IPFIS,SPFIS,SLPFIS,ZINTPF,STEPPF
- + ,IDRAY,SDRAY,SLDRAY,ZINTDR,STEPDR
- + ,IANNI,SANNI,SLANNI,ZINTAN,STEPAN
- + ,IBREM,SBREM,SLBREM,ZINTBR,STEPBR
- + ,IHADR,SHADR,SLHADR,ZINTHA,STEPHA
- + ,IMUNU,SMUNU,SLMUNU,ZINTMU,STEPMU
- + ,IDCAY,SDCAY,SLIFE ,SUMLIF,DPHYS1
- + ,ILOSS,SLOSS,SOLOSS,STLOSS,DPHYS2
- + ,IMULS,SMULS,SOMULS,STMULS,DPHYS3
- + ,IRAYL,SRAYL,SLRAYL,ZINTRA,STEPRA
- COMMON/GCPHLT/ILABS,SLABS,SLLABS,ZINTLA,STEPLA
- + ,ISYNC
- + ,ISTRA
-*
-+SEQ,GTPHYS,IF=TYPE.
-+KEEP,GTPARM.
- INTEGER IPARAM,MPSTAK,NSPARA,NPGENE
- REAL PCUTGA,PCUTEL,PCUTNE,PCUTHA,PCUTMU
-+KEEP,GCPARM.
- COMMON/GCPARM/IPARAM,PCUTGA,PCUTEL,PCUTNE,PCUTHA,PCUTMU
- + ,NSPARA,MPSTAK,NPGENE
- REAL PACUTS(5)
- EQUIVALENCE (PACUTS(1),PCUTGA)
-+SEQ,GTPARM,IF=TYPE.
-C
-+KEEP,GCPOLY
- COMMON/GCPOLY/IZSEC,IPSEC
- INTEGER IZSEC,IPSEC
-C
-+KEEP,GCPUSH
- COMMON/GCPUSH/NCVERT,NCKINE,NCJXYZ,NPVERT,NPKINE,NPJXYZ
- INTEGER NCVERT,NCKINE,NCJXYZ,NPVERT,NPKINE,NPJXYZ
-C
-+KEEP,GCRZ
- COMMON/GCRZ1/NRECRZ,NRGET,NRSAVE,LRGET(20),LRSAVE(20)
- INTEGER NRECRZ,NRGET,NRSAVE,LRGET ,LRSAVE
- COMMON/GCRZ2/RZTAGS
- CHARACTER*8 RZTAGS(4)
-C
-+KEEP,GTSETS.
- INTEGER IHSET,IHDET,ISET,IDET,IDTYPE,NVNAME,NUMBV
-C
-+KEEP,GCSETS.
- COMMON/GCSETS/IHSET,IHDET,ISET,IDET,IDTYPE,NVNAME,NUMBV(20)
-C
-+SEQ,GTSETS,IF=TYPE.
-+KEEP,GTSTAK.
- INTEGER NJTMAX,NJTMIN,NTSTKP,NTSTKS,NDBOOK,NDPUSH,NJFREE,NJGARB,
- + NJINVO,LINSAV,LMXSAV,NWSTAK,NWINT,NWREAL,NWTRAC
- INTEGER ISTORD
-+KEEP,GCSHNO.
- PARAMETER ( NSBOX=1, NSTRD1=2, NSTRD2=3, NSTRAP=4, NSTUBE=5,
- + NSTUBS=6, NSCONE=7, NSCONS=8, NSSPHE=9, NSPARA=10,NSPGON=11,
- + NSPCON=12,NSELTU=13,NSHYPE=14,NSGTRA=28, NSCTUB=29 )
-+KEEP,GCSTAK.
-+SEQ,GTSTAK,IF=TYPE.
- PARAMETER (NWSTAK=12,NWINT=11,NWREAL=12,NWTRAC=NWINT+NWREAL+5)
- COMMON /GCSTAK/ NJTMAX, NJTMIN, NTSTKP, NTSTKS, NDBOOK, NDPUSH,
- + NJFREE, NJGARB, NJINVO, LINSAV(15), LMXSAV(15)
- EQUIVALENCE (ISTORD,NJTMIN)
-C
-+KEEP,GCSTRA.
- PARAMETER (ILTAB=200)
- COMMON /GCSTRA / EMAX,EM(200),SFINT,EPSR(ILTAB),EPSI(ILTAB),
- + FINT(ILTAB),EMIN,EPPS,BETA2,GAMMA2,WP2,S2,MEEV,EMM(200),
- + GAMLOG(21),NP,NTAB,IE,NFACT,NICOLL
-*
- INTEGER NP,NTAB,IE,NFACT
- REAL EMAX,EM,SFINT,EPSR,EPSI,FINT,EMIN,EPPS,EMM,GAMLOG
- + ,BETA2,GAMMA2,WP2,S2,MEEV
-*
-+KEEP,GTASHO
- REAL ZMED,AMED,DMED,E0MED,ZSMED,ESMED,ALFA,
- * STEP,PLIN,PLOG,BE2,PLASM,TRNSMA,
- * BOSC,AOSC,EOSC,ZOSC,EMEAN,CMGO,EMGO,EMGOMI
- INTEGER NSMED,IOSC,NOSC,NMGO,NMGOMA
-C
-+KEEP,GCASHO
- COMMON/GCASHO/ZMED,AMED,DMED,E0MED,ZSMED(50),ESMED(50),ALFA,
- * STEP,PLIN,PLOG,BE2,PLASM,TRNSMA,
- * BOSC(50),AOSC(50),EOSC(50),ZOSC(50),EMEAN,
- * CMGO(2000),EMGO,EMGOMI,
- * NSMED,IOSC(50),NOSC,NMGO,NMGOMA
-C
-+SEQ,GTASHO,IF=TYPE.
-+KEEP,GCTIME
- COMMON/GCTIME/TIMINT,TIMEND,ITIME,IGDATE,IGTIME
- INTEGER ITIME,IGDATE,IGTIME
- REAL TIMINT,TIMEND
-C
-+KEEP,GTHIL2.
- INTEGER LARETT,JTICK,JMYLL,JFIMOT,JFISCA,JFINAM,
- + JAASS1,JAASS2,JAASS3,JAASS4,
- + JTICKS,JMYLLS,JMYMOT
-+KEEP,GCHIL2.
-+SEQ, GTHIL2, IF=TYPE
- COMMON/GCHIL2/LARETT(2),JTICK,JMYLL,JFIMOT,JFISCA,JFINAM,
- + JAASS1,JAASS2,
- + JAASS3,JAASS4,JTICKS,JMYLLS,JMYMOT
-*
-+KEEP,GTTMED.
- INTEGER NUMED,NATMED,ISVOL,IFIELD,IUPD,ISTPAR,NUMOLD
- REAL FIELDM,TMAXFD,STEMAX,DEEMAX,EPSIL,STMIN,CFIELD,PREC
- INTEGER JMIN,NPCKOV,IMCKOV,ITCKOV
- REAL THRIND,PMIN,DP,DNDL
-C
-+KEEP,GCTMED
- COMMON/GCTMED/NUMED,NATMED(5),ISVOL,IFIELD,FIELDM,TMAXFD,STEMAX
- + ,DEEMAX,EPSIL,STMIN,CFIELD,PREC,IUPD,ISTPAR,NUMOLD
- COMMON/GCTLIT/THRIND,PMIN,DP,DNDL,JMIN,ITCKOV,IMCKOV,NPCKOV
-C
-+SEQ,GTTMED,IF=TYPE.
-+KEEP,GTTRAK.
- INTEGER NMEC,LMEC,NAMEC,NSTEP ,MAXNST,IGNEXT,INWVOL,ISTOP,MAXMEC
- + ,IGAUTO,IEKBIN,ILOSL, IMULL,INGOTO,NLDOWN,NLEVIN,NLVSAV,ISTORY
- + ,MAXME1,NAMEC1
- REAL VECT,GETOT,GEKIN,VOUT,DESTEP,DESTEL,SAFETY,SLENG ,STEP
- + ,SNEXT,SFIELD,TOFG ,GEKRAT,UPWGHT
- REAL POLAR
-+KEEP,GCTRAK
-+SEQ,GTTRAK,IF=TYPE.
- PARAMETER (MAXMEC=30)
- COMMON/GCTRAK/VECT(7),GETOT,GEKIN,VOUT(7),NMEC,LMEC(MAXMEC)
- + ,NAMEC(MAXMEC),NSTEP ,MAXNST,DESTEP,DESTEL,SAFETY,SLENG
- + ,STEP ,SNEXT ,SFIELD,TOFG ,GEKRAT,UPWGHT,IGNEXT,INWVOL
- + ,ISTOP ,IGAUTO,IEKBIN, ILOSL, IMULL,INGOTO,NLDOWN,NLEVIN
- + ,NLVSAV,ISTORY
- PARAMETER (MAXME1=30)
- COMMON/GCTPOL/POLAR(3), NAMEC1(MAXME1)
-C
-+KEEP,GCUNIT
- COMMON/GCUNIT/LIN,LOUT,NUNITS,LUNITS(5)
- INTEGER LIN,LOUT,NUNITS,LUNITS
- COMMON/GCMAIL/CHMAIL
- CHARACTER*132 CHMAIL
-C
-+KEEP,GTVOLU.
- INTEGER NLEVEL,NAMES,NUMBER,LVOLUM,LINDEX,INFROM,NLEVMX,
- + NLDEV,LINMX
- REAL GTRAN,GRMAT,GONLY,GLX
-+KEEP,GCVOLU
- COMMON/GCVOLU/NLEVEL,NAMES(15),NUMBER(15),
- +LVOLUM(15),LINDEX(15),INFROM,NLEVMX,NLDEV(15),LINMX(15),
- +GTRAN(3,15),GRMAT(10,15),GONLY(15),GLX(3)
-C
-+SEQ,GTVOLU,IF=TYPE.
-+KEEP,GTVOL1.
- INTEGER NAMES1,NUMBR1,LVOLU1
-+KEEP,GCVOL1
- COMMON/GCVOL1/NLEVL1,NAMES1(15),NUMBR1(15),LVOLU1(15)
-C
-+SEQ,GTVOL1,IF=TYPE.
-+KEEP,GCVOL2
- COMMON/GCVOL2/NLEVE2,NAMES2(15),NUMB2(15),
- +LVOL2(15),LIND2(15),INFRO2,NLDEV2(15),LINMX2(15),
- +GTRAN2(3,15),GRMAT2(10,15),GONLY2(15),GLX2(15)
- INTEGER NLEVE2,NAMES2,NUMB2,LVOL2,LIND2,INFRO2,NLDEV2,LINMX2
- REAL GTRAN2,GRMAT2,GONLY2,GLX2
-C
-+KEEP,GTDRAW.
- INTEGER NUMNOD,MAXNOD,NUMND1,LEVVER,LEVHOR,MAXV,IPICK,
- + MLEVV,MLEVH,NWCUT,JNAM,JMOT,JXON,JBRO,JDUP,JSCA,JDVM,JPSM,
- + JNAM1,JMOT1,JXON1,JBRO1,JDUP1,JSCA1,JULEV,JVLEV,
- + LOOKTB,IDRNUM,NGVIEW,ICUTFL,ICUT,NSURF,ISURF,LINATT,LINATP,
- + ITXATT,ITHRZ,IPRJ,ITR3D,IPKHIT,IOBJ,LINBUF,
- + MAXGU,MORGU,MAXGS,MORGS,MAXTU,MORTU,MAXTS,MORTS,
- + IGU,IGS,ITU,ITS,NKVIEW,IDVIEW,
- + NOPEN,IGMR,IPIONS,ITRKOP,IHIDEN,MYISEL
- REAL GRMAT0,GTRAN0,GSIN,GCOS,SINPSI,COSPSI,GTHETA,GPHI,GPSI,
- + GU0,GV0,GSCU,GSCV,CTHETA,CPHI,DCUT,GZUA,GZVA,GZUB,GZVB,GZUC,
- + GZVC,PLTRNX,PLTRNY,DPERS,ZZFU,ZZFV,DDUMMY
-+KEEP,GCDRAW
- COMMON/GCDRAW/NUMNOD,MAXNOD,NUMND1,LEVVER,LEVHOR,MAXV,IPICK,
- + MLEVV,MLEVH,NWCUT,JNAM,JMOT,JXON,JBRO,JDUP,JSCA,JDVM,JPSM,
- + JNAM1,JMOT1,JXON1,JBRO1,JDUP1,JSCA1,JULEV,JVLEV,
- + LOOKTB(16),
- + GRMAT0(10),GTRAN0(3),IDRNUM,GSIN(41),GCOS(41),SINPSI,COSPSI,
- + GTHETA,GPHI,GPSI,GU0,GV0,GSCU,GSCV,NGVIEW,
- + ICUTFL,ICUT,CTHETA,CPHI,DCUT,NSURF,ISURF,
- + GZUA,GZVA,GZUB,GZVB,GZUC,GZVC,PLTRNX,PLTRNY,
- + LINATT,LINATP,ITXATT,ITHRZ,IPRJ,DPERS,ITR3D,IPKHIT,IOBJ,LINBUF,
- + MAXGU,MORGU,MAXGS,MORGS,MAXTU,MORTU,MAXTS,MORTS,
- + IGU,IGS,ITU,ITS,NKVIEW,IDVIEW,
- + NOPEN,IGMR,IPIONS,ITRKOP,IHIDEN,
- + ZZFU,ZZFV,MYISEL,
- + DDUMMY(15)
-C
-+SEQ,GTDRAW,IF=TYPE.
-+KEEP,GSECTI
- COMMON/GSECTI/ AIEL(20),AIIN(20),AIFI(20),AICA(20),ALAM,K0FLAG
- INTEGER K0FLAG
- REAL AIEL,AIIN,AIFI,AICA,ALAM
-C
-+KEEP,GCGOBJ
- PARAMETER (NTRCG=1)
- PARAMETER (NWB=207,NWREV=100,NWS=1500)
- PARAMETER (C2TOC1=7.7, C3TOC1=2.,TVLIM=1296.)
- COMMON /GCGOBJ/IST,IFCG,ILCG,NTCUR,NFILT,NTNEX,KCGST
- + ,NCGVOL,IVFUN,IVCLOS,IFACST,NCLAS1,NCLAS2,NCLAS3
- COMMON /CGBLIM/IHOLE,CGXMIN,CGXMAX,CGYMIN,CGYMAX,CGZMIN,CGZMAX
-C
-+KEEP,GTSCAN
- INTEGER MSLIST,NPHI,IPHIMI,IPHIMA,IPHI1,IPHIL,NTETA,MODTET,NSLMAX,
- + MAXMDT,NSLIST,ISLIST,IPHI,ITETA,ISCUR
- REAL PHIMIN,PHIMAX,TETMIN,TETMAX,VSCAN,FACTX0,FACTL,
- + FACTR,SX0,SABS,TETMID,TETMAD
- + ,SX0S,SX0T,SABSS,SABST,FACTSF
- + ,DLTPHI,DLTETA,DPHIM1,DTETM1
- + ,FCX0M1,FCLLM1,FCRRM1
-+KEEP,GCSCAN
-+SEQ,GTSCAN, IF=TYPE
- PARAMETER (MSLIST=32,MAXMDT=3)
- COMMON/GCSCAN/SCANFL,NPHI,PHIMIN,PHIMAX,NTETA,TETMIN,TETMAX,
- + MODTET,IPHIMI,IPHIMA,IPHI1,IPHIL,NSLMAX,
- + NSLIST,ISLIST(MSLIST),VSCAN(3),FACTX0,FACTL,
- + FACTR,IPHI,ITETA,ISCUR,SX0,SABS,TETMID(MAXMDT),
- + TETMAD(MAXMDT)
- + ,SX0S,SX0T,SABSS,SABST,FACTSF
- + ,DLTPHI,DLTETA,DPHIM1,DTETM1
- + ,FCX0M1,FCLLM1,FCRRM1
- LOGICAL SCANFL
- COMMON/GCSCAC/SFIN,SFOUT
- CHARACTER*80 SFIN,SFOUT
-*
-+KEEP,GTSCAL.
- INTEGER MXSLNK, ISLINK, LSLAST, LSCAN, LSTEMP, LSPARA, LSERAY
-*
-+KEEP,GCSCAL.
-+SEQ,GTSCAL, IF=TYPE
- PARAMETER(MXSLNK=100)
- COMMON/GCSCAL/ ISLINK(MXSLNK)
- EQUIVALENCE (LSLAST,ISLINK(MXSLNK))
- EQUIVALENCE (LSCAN ,ISLINK(1)),(LSTEMP,ISLINK(2))
- EQUIVALENCE (LSPARA,ISLINK(3)),(LSERAY,ISLINK(4))
-*
-+KEEP,GTPARA.
- INTEGER BITPHI, BITTET, BITPOT
- LOGICAL SYMPHI, SYMTEU, SYMTED
-+KEEP,GCPARA.
-+SEQ,GTPARA.
- PARAMETER (LSTACK = 5000)
-C BITPOT is for Phi.Or.Tet
-C
-C ---------------------------------------------------------
- COMMON /GCPARA/
- + EPSIX0 (LSTACK) ,
- + IDRPHI (LSTACK ) , IDRTET (LSTACK ),
- + IDROUT (LSTACK ) , JPLOST (LSTACK ),
- + IPHTMP (LSTACK ) ,
- + BITPHI (LSTACK ) , BITTET (LSTACK ),
- + BITPOT (LSTACK ) , JJLOST, JJFILL,
- + JENTRY, JEMPTY,
- + EPSMAX,
- + JJTEMP, JJWORK , JJSTK1,
- + J1TEMP, J1STK1,
- + IFOUNP, IFOUNT , IFNPOT,
- + SYMPHI,
- + SYMTEU, SYMTED
-C
-+KEEP,GTJUMP
- INTEGER JUDCAY, JUDIGI, JUDTIM, JUFLD , JUHADR, JUIGET,
- + JUINME, JUINTI, JUKINE, JUNEAR, JUOUT , JUPHAD,
- + JUSKIP, JUSTEP, JUSWIM, JUTRAK, JUTREV, JUVIEW,
- + JUPARA
- INTEGER JMPADR, MAXJMP
-*
-+KEEP,GCJUMP
-+SEQ ,GTJUMP, IF=TYPE
- PARAMETER (MAXJMP=30)
- COMMON/GCJUMP/JUDCAY, JUDIGI, JUDTIM, JUFLD , JUHADR, JUIGET,
- + JUINME, JUINTI, JUKINE, JUNEAR, JUOUT , JUPHAD,
- + JUSKIP, JUSTEP, JUSWIM, JUTRAK, JUTREV, JUVIEW,
- + JUPARA
- DIMENSION JMPADR(MAXJMP)
- EQUIVALENCE (JMPADR(1), JUDCAY)
-*
-+KEEP,GCOMIS
- COMMON/GCOMIS/JUINIT,JUGEOM,JUKINE,JUSTEP,JUOUT,JULAST
- DIMENSION JPCOMS(6)
- EQUIVALENCE (JPCOMS,JUINIT)
-*
-+KEEP,GCXLUN
- COMMON/GCXLUN/LUNIT(128)
-*
-+KEEP,GTMUTR
-*
- INTEGER NCVOLS,NSHIFT,KSHIFT,ICUBE,NAIN,JJJ,NIET,IVOOLD,
- + IWPOIN,IHPOIN,IVECVO,IOLDSU,ICGP,IPORNT
- REAL GXMIN,GXMAX,GYMIN,GYMAX,GZMIN,GZMAX,GXXXX,GYYYY,GZZZZ
- REAL CLIPMI,CLIPMA,ABCD,BMIN,BMAX,CGB,CGB1,GBOOM
- REAL PORGX,PORGY,PORGZ,POX,POY,POZ,PORMIR,PORMAR
-+KEEP,GCMUTR
-+SEQ, GTMUTR, IF=TYPE
-*
- PARAMETER (MULTRA=50)
- CHARACTER*4 GNASH, GNNVV, GNVNV
- COMMON/GCMUTR/NCVOLS,KSHIFT,NSHIFT,ICUBE,NAIN,JJJ,
- + NIET,IOLDSU,IVOOLD,IWPOIN,IHPOIN,IVECVO(100),
- + PORGX,PORGY,PORGZ,POX(15),POY(15),POZ(15),GBOOM,
- + PORMIR(18),PORMAR(18),IPORNT,
- + ICGP,CLIPMI(6),CLIPMA(6),
- + ABCD(4),BMIN(6),BMAX(6),CGB(16000),CGB1(16000),
- + GXMIN(MULTRA),GXMAX(MULTRA),GYMIN(MULTRA),
- + GYMAX(MULTRA),GZMIN(MULTRA),GZMAX(MULTRA),
- + GXXXX(MULTRA),GYYYY(MULTRA),GZZZZ(MULTRA)
-*
- COMMON/GCMUTC/ GNASH(MULTRA),GNNVV(MULTRA),GNVNV(MULTRA)
-*
-+KEEP,GTHILN.
- INTEGER LARECG,JCGOBJ,JCGCOL,JCOUNT,JCLIPS,IMPOIN,IMCOUN,
- + JSIX,JSIY,JSIZ,JPXC,JPYC,JPZC,ICLIP1,ICLIP2
-+KEEP,GCHILN.
-+SEQ, GTHILN, IF=TYPE
- COMMON/GCHILN/LARECG(2), JCGOBJ, JCGCOL, JCOUNT, JCLIPS,
- + IMPOIN, IMCOUN, JSIX, JSIY, JSIZ,
- + JPXC, JPYC, JPZC, ICLIP1, ICLIP2
-*
-+KEEP,GTSPEE
-*
- REAL S1,S2,S3,SS1,SS2,SS3,SRAGMX,SRAGMN,
- + RAINT1,RAINT2,RMIN1,RMIN2,RMAX1,RMAX2
- INTEGER ISCOP,NTIM,NTFLAG,IOLDCU,ITSTCU,ISUBLI,IPORLI
- INTEGER LPASS,JPORJJ,LEP,JSC
-*
-+KEEP,GCSPEE.
-+SEQ, GTSPEE, IF=TYPE
- COMMON/GCSPEE/S1,S2,S3,SS1,SS2,SS3,LEP,IPORLI,ISUBLI,
- + SRAGMX,SRAGMN,RAINT1,RAINT2,RMIN1,RMIN2,
- + RMAX1,RMAX2,JPORJJ,ITSTCU,IOLDCU,ISCOP,
- + NTIM,NTFLAG,LPASS,JSC
-*
-+KEEP, LUJETS
- COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5)
- INTEGER N,K
- REAL P,V
- SAVE /LUJETS/
-*
-+KEEP, LUDAT1
- COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
- INTEGER MSTU,MSTJ
- REAL PARU,PARJ
- SAVE /LUDAT1/
-*
-+KEEP, LUDAT3
- COMMON/LUDAT3/MDCY(500,3),MDME(2000,2),BRAT(2000),KFDP(2000,5)
- INTEGER MDCY,MDME,KFDP
- REAL BRAT
- SAVE /LUDAT3/
-*
-+KEEP,GCLUND
- COMMON/GCLUND/IFLUND,ECLUND
- INTEGER IFLUND
- REAL ECLUND
-C
-+KEEP,PAWCT
- INTEGER NWPAW,IXPAWC,IHBOOK,IXHIGZ,IXKUIP,IFENCE,LLMAIN,IQQ,LQQ
- REAL WWS,QQ
-+KEEP,PAWC
-+SEQ,PAWCT,IF=TYPE.
- COMMON /PAWC/ NWPAW,IXPAWC,IHBOOK,IXHIGZ,IXKUIP,IFENCE(5),
- + LLMAIN, WWS(9989)
- DIMENSION IQQ(2),QQ(2),LQQ(8000)
- EQUIVALENCE (QQ(1),IQQ(1),LQQ(9)),(LQQ(1),LLMAIN)
-C
-+KEEP,GCPMXZ.
- INTEGER MAXELZ
- PARAMETER (MAXELZ=100)
-C
-+KEEP,GC10EV.
- REAL G10EV,TENEV
- PARAMETER (G10EV=1.0E-8)
- PARAMETER (TENEV=1.E-2)
-C
-+KEEP,GCSHPT.
-C Shells are numbered from 1 to 24.
-C Shells used:
-C K,L1,L2,L3,M1,M2,M3,M4,M5
-C N1,N2,N3,N4,N5,N6,N7,
-C O1,O2,O3,O4,O5,P1,P2,P3
-C VARIABLES:
-C NSHLST - value of Z for which the shells starts to be present
-C N1ST - pointer to K shell of a given Z (in ESHELL array)
-C NSHLLS - Number of used shells for a given Z
-C ESHELL - Shells potentials in eV !!!
- INTEGER LENGTH,MAXSHL
- PARAMETER (LENGTH= 1409)
- PARAMETER (MAXSHL=24)
- INTEGER NSHLST,N1ST,NSHLLS
- REAL ESHELL
- DIMENSION NSHLST(MAXSHL),N1ST(MAXELZ),NSHLLS(MAXELZ)
- DIMENSION ESHELL(LENGTH)
- COMMON /GCSHPT/NSHLST,N1ST,NSHLLS,ESHELL
-C
-+KEEP,GCPHPR.
-C Probability of radiative decay mode.
- REAL GFLUPR
- COMMON /GCPHPR/ GFLUPR(4,MAXELZ)
-C
-+KEEP,GCPHNR.
-C INRFIN - nonradiative decay mode
- INTEGER IGNRFN
- COMMON /GCPHNR/ IGNRFN(8,MAXELZ)
-C
-+KEEP,GCPHRD.
-C GRATE - radiative modes' rates
- INTEGER KSHLS,L1SHLS,L2SHLS,L3SHLS,ISHLS,ISHLUS,ISHLTR
- REAL GPHRAT
- PARAMETER (KSHLS=6)
- PARAMETER (L1SHLS=8)
- PARAMETER (L2SHLS=7)
- PARAMETER (L3SHLS=8)
- PARAMETER (ISHLS=29)
- COMMON / GCPHRD / GPHRAT(ISHLS,MAXELZ),ISHLUS(24,4),ISHLTR(ISHLS)
-C
-+KEEP,GCPHXS.
- INTEGER MAXPOW,MAXINT
- PARAMETER (MAXPOW=4)
- PARAMETER (MAXINT=13)
- CHARACTER*6 CRNGUP
- COMMON /GCPXRN/ CRNGUP(MAXINT,MAXELZ)
- REAL COFS,GPOMIN
- COMMON /GCPXCF/ COFS(MAXPOW,MAXINT,MAXELZ),GPOMIN(MAXELZ)
-C
-+KEEP, GFKDIS
- COMMON/ GFKDIS/ ZINE, ZELA, ZTOT, INT
- + ,SINE, SELA, FSIG, IFMAT, IGF
-C
-C
-+KEEP,GTHVIR.
- INTEGER JVIRT,JVDIV,JCONT2,JCONT
-+KEEP,GCHVIR
- COMMON/GCHVIR/JVIRT,JVDIV,JCONT2,JCONT
-C
-+SEQ,GTHVIR,IF=TYPE.
-C
-+KEEP,GTVDMA.
- INTEGER NVMANY,MANYLE,MANYNA,MANYNU,
- + NFMANY,MYCOUN,IMYSE
- REAL RAYTRA,VECCOS
-+KEEP,GCVDMA
- COMMON/GCVDMA/NVMANY,MANYLE(20),MANYNA(20,15),
- +MANYNU(20,15),NFMANY,MYCOUN,IMYSE,RAYTRA,VECCOS(3)
-C
-+SEQ,GTVDMA,IF=TYPE.
-C
-+KEEP,GTFDIM.
- INTEGER NPROC,NMPTOT
- REAL TSEQTO,TOTMBY,TSEQ,TLAT,TNET,X1MIN,X1MAX,
- + Y1MIN,Y1MAX,Z1MIN,Z1MAX,XCUT,YCUT,ZCUT
-+KEEP,GCFDIM
- COMMON/GCFDIM/NPROC,NMPTOT,TSEQTO,TOTMBY,TSEQ,
- +TLAT,TNET,X1MIN,X1MAX,Y1MIN,Y1MAX,Z1MIN,Z1MAX,
- +XCUT,YCUT,ZCUT
-C
-+SEQ,GTFDIM,IF=TYPE.
-C
-+KEEP,GTRAYT.
- INTEGER INTEN,IOMBRA,IXYFLA,NOFLAG
- REAL XLPOS,YLPOS,ZLPOS,XLDIR,YLDIR,ZLDIR,APFLAH,
- + CCXX,CCYY,CCZZ,BOFLAG,APFLAG,
- + XCOSXS,YCOSYS,ZCOSZS,VDX,VDY,VDZ,SSLENG,
- + XPINTS,YPINTS,ZPINTS,FPINTX,FPINTY,FPINTZ,
- + AROTS,ZROTS,RRR
-+KEEP,GCRAYT
- COMMON/GCRAYT/INTEN,IOMBRA,IXYFLA,NOFLAG,
- +XLPOS,YLPOS,ZLPOS,XLDIR,YLDIR,ZLDIR,APFLAH,
- +CCXX(4),CCYY(4),CCZZ(4),BOFLAG,APFLAG,
- +XCOSXS,YCOSYS,ZCOSZS,VDX,VDY,VDZ,SSLENG,
- +XPINTS,YPINTS,ZPINTS,FPINTX,FPINTY,FPINTZ,
- +AROTS(4,4),ZROTS(4,4),RRR(4)
-C
-+SEQ,GTRAYT,IF=TYPE.
-C
-+KEEP,GTPIXE.
- INTEGER LIMPRE,IFLAPE,ICOLOR,IXXX,IYYY,
- + ISSEEN,ISCOLO,ISLSTY,ISLWID,ISFILL,
- + IMAP,JON,NMAP
- REAL UUU,VVV,ZUV,ZNMAP1
-+KEEP,GCPIXE
- COMMON/GCPIXE/LIMPRE,IFLAPE,ICOLOR,IXXX,IYYY,
- +ISSEEN,ISCOLO,ISLSTY,ISLWID,ISFILL,
- +IMAP,JON,NMAP,UUU,VVV,ZUV,ZNMAP1
-C
-+SEQ,GTPIXE,IF=TYPE.
-
-+DECK,INCDEK,IF=INCLUDE.
-*CMZ : 3.21/02 29/03/94 15.41.18 by S.Giani
-*-- Author :
-+KEEP,GCLINK
-*
-+SEQ,INCBEG
- + gclink
-+SEQ,INCEND
-+KEEP,GCBANK
-*
-+SEQ,INCBEG
- + gcbank
-+SEQ,INCEND
-+KEEP,GCCURS
-*
-+SEQ,INCBEG
- + gccurs
-+SEQ,INCEND
-+KEEP,GCCUTS
-*
-+SEQ,INCBEG
- + gccuts
-+SEQ,INCEND
-+KEEP,GCURSB
-*
-+SEQ,INCBEG
- + gcursb
-+SEQ,INCEND
-+KEEP,GCFLAG
-*
-+SEQ,INCBEG
- + gcflag
-+SEQ,INCEND
-+KEEP,GCOPTI
-*
-+SEQ,INCBEG
- + gcopti
-+SEQ,INCEND
-+KEEP,GCJLOC
-*
-+SEQ,INCBEG
- + gcjloc
-+SEQ,INCEND
-+KEEP,GCKINE
-*
-+SEQ,INCBEG
- + gckine
-+SEQ,INCEND
-+KEEP,GCKMAX
-*
-+SEQ,INCBEG
- + gckmax
-+SEQ,INCEND
-+KEEP,GCKING
-*
-+SEQ,INCBEG
- + gcking
-+SEQ,INCEND
-+KEEP,GCLIST
-*
-+SEQ,INCBEG
- + gclist
-+SEQ,INCEND
-+KEEP,GCMATE
-*
-+SEQ,INCBEG
- + gcmate
-+SEQ,INCEND
-+KEEP,GCMULO
-*
-+SEQ,INCBEG
- + gcmulo
-+SEQ,INCEND
-+KEEP,GCMZFO
-*
-+SEQ,INCBEG
- + gcmzfo
-+SEQ,INCEND
-+KEEP,GCNUM
-*
-+SEQ,INCBEG
- + gcnum
-+SEQ,INCEND
-+KEEP,GCONSP
-*
-+SEQ,INCBEG
- + gconsp
-+SEQ,INCEND
-+KEEP,GCONST
-*
-+SEQ,INCBEG
- + gconst
-+SEQ,INCEND
-+KEEP,GCPHYS
-*
-+SEQ,INCBEG
- + gcphys
-+SEQ,INCEND
-+KEEP,GCPARM
-*
-+SEQ,INCBEG
- + gcparm
-+SEQ,INCEND
-+KEEP,GCPOLY
-*
-+SEQ,INCBEG
- + gcpoly
-+SEQ,INCEND
-+KEEP,GCPUSH
-*
-+SEQ,INCBEG
- + gcpush
-+SEQ,INCEND
-+KEEP,GCRZ
-*
-+SEQ,INCBEG
- + gcrz
-+SEQ,INCEND
-+KEEP,GCSETS
-*
-+SEQ,INCBEG
- + gcsets
-+SEQ,INCEND
-+KEEP,GCSHNO
-*
-+SEQ,INCBEG
- + gcshno
-+SEQ,INCEND
-+KEEP,GCSTAK
-*
-+SEQ,INCBEG
- + gcstak
-+SEQ,INCEND
-+KEEP,GCTIME
-*
-+SEQ,INCBEG
- + gctime
-+SEQ,INCEND
-+KEEP,GCHIL2
-*
-+SEQ,INCBEG
- + gchil2
-+SEQ,INCEND
-+KEEP,GCTMED
-*
-+SEQ,INCBEG
- + gctmed
-+SEQ,INCEND
-+KEEP,GCTRAK
-*
-+SEQ,INCBEG
- + gctrak
-+SEQ,INCEND
-+KEEP,GCUNIT
-*
-+SEQ,INCBEG
- + gcunit
-+SEQ,INCEND
-+KEEP,GCVOLU
-*
-+SEQ,INCBEG
- + gcvolu
-+SEQ,INCEND
-+KEEP,GCVOL1
-*
-+SEQ,INCBEG
- + gcvol1
-+SEQ,INCEND
-+KEEP,GCVOL2
-*
-+SEQ,INCBEG
- + gcvol2
-+SEQ,INCEND
-+KEEP,GCDRAW
-*
-+SEQ,INCBEG
- + gcdraw
-+SEQ,INCEND
-+KEEP,GSECTI
-*
-+SEQ,INCBEG
- + gsecti
-+SEQ,INCEND
-+KEEP,GCGOBJ
-*
-+SEQ,INCBEG
- + gcgobj
-+SEQ,INCEND
-+KEEP,GCSCAN
-*
-+SEQ,INCBEG
- + gcscan
-+SEQ,INCEND
-+KEEP,GCSCAL
-*
-+SEQ,INCBEG
- + gcscal
-+SEQ,INCEND
-+KEEP,GCPARA
-*
-+SEQ,INCBEG
- + gcpara
-+SEQ,INCEND
-+KEEP,GCJUMP
-*
-+SEQ,INCBEG
- + gcjump
-+SEQ,INCEND
-+KEEP,GCOMIS
-*
-+SEQ,INCBEG
- + gcomis
-+SEQ,INCEND
-+KEEP,GCXLUN
-*
-+SEQ,INCBEG
- + gcxlun
-+SEQ,INCEND
-+KEEP,GCMUTR
-*
-+SEQ,INCBEG
- + gcmutr
-+SEQ,INCEND
-+KEEP,GCHILN
-*
-+SEQ,INCBEG
- + gchiln
-+SEQ,INCEND
-+KEEP,GCSPEE
-*
-+SEQ,INCBEG
- + gcspee
-+SEQ,INCEND
-+KEEP, LUJETS
-*
-+SEQ,INCBEG
- + lujets
-+SEQ,INCEND
-+KEEP, LUDAT1
-*
-+SEQ,INCBEG
- + ludat1
-+SEQ,INCEND
-+KEEP, LUDAT3
-*
-+SEQ,INCBEG
- + ludat3
-+SEQ,INCEND
-+KEEP,GCLUND
-*
-+SEQ,INCBEG
- + gclund
-+SEQ,INCEND
-+KEEP,PAWC
-*
-+SEQ,INCBEG
- + pawc
-+SEQ,INCEND
-+KEEP,GCPMXZ
-*
-+SEQ,INCBEG
- + gcpmxz
-+SEQ,INCEND
-+KEEP,GC10EV
-*
-+SEQ,INCBEG
- + gc10ev
-+SEQ,INCEND
-+KEEP,GCSHPT
-*
-+SEQ,INCBEG
- + gcshpt
-+SEQ,INCEND
-+KEEP,GCPHPR
-*
-+SEQ,INCBEG
- + gcphpr
-+SEQ,INCEND
-+KEEP,GCPHNR
-*
-+SEQ,INCBEG
- + gcphnr
-+SEQ,INCEND
-+KEEP,GCPHRD
-*
-+SEQ,INCBEG
- + gcphrd
-+SEQ,INCEND
-+KEEP,GCPHXS
-*
-+SEQ,INCBEG
- + gcphxs
-+SEQ,INCEND
-+KEEP,GCPOTM
-*
-+SEQ,INCBEG
- + gcpotm
-+SEQ,INCEND
-+PATCH,GTINCL,IF=MINCL
-+DECK,GCBANK
-*CMZ : 3.21/02 29/03/94 15.41.18 by S.Giani
-*-- Author :
-*
-+SEQ,GCBANK
-+DECK,GCCURS
-*CMZ : 3.21/02 29/03/94 15.41.18 by S.Giani
-*-- Author :
-*
-+SEQ,GCCURS
-+DECK,GCCUTS
-*CMZ : 3.21/02 29/03/94 15.41.18 by S.Giani
-*-- Author :
-*
-+SEQ,GCCUTS
-+DECK,GCDRAW
-*CMZ : 3.21/02 29/03/94 15.41.18 by S.Giani
-*-- Author :
-*
-+SEQ,GCDRAW
-+DECK,GCFLAG
-*CMZ : 3.21/02 29/03/94 15.41.18 by S.Giani
-*-- Author :
-*
-+SEQ,GCFLAG
-+DECK,GCGOBJ
-*CMZ : 3.21/02 29/03/94 15.41.18 by S.Giani
-*-- Author :
-*
-+SEQ,GCGOBJ
-+DECK,GCHIL2.
-*CMZ : 3.21/02 29/03/94 15.41.18 by S.Giani
-*-- Author :
-*
-+SEQ,GCHIL2.
-+DECK,GCHILN.
-*CMZ : 3.21/02 29/03/94 15.41.18 by S.Giani
-*-- Author :
-*
-+SEQ,GCHILN.
-+DECK,GCJLOC
-*CMZ : 3.21/02 29/03/94 15.41.18 by S.Giani
-*-- Author :
-*
-+SEQ,GCJLOC
-+DECK,GCJUMP
-*CMZ : 3.21/02 29/03/94 15.41.18 by S.Giani
-*-- Author :
-*
-+SEQ,GCJUMP
-+DECK,GCKINE
-*CMZ : 3.21/02 29/03/94 15.41.18 by S.Giani
-*-- Author :
-*
-+SEQ,GCKINE
-+DECK,GCKING
-*CMZ : 3.21/02 29/03/94 15.41.18 by S.Giani
-*-- Author :
-*
-+SEQ,GCKING
-+DECK,GCKMAX
-*CMZ : 3.21/02 29/03/94 15.41.18 by S.Giani
-*-- Author :
-*
-+SEQ,GCKMAX
-+DECK,GCLINK
-*CMZ : 3.21/02 29/03/94 15.41.18 by S.Giani
-*-- Author :
-*
-+SEQ,GCLINK
-+DECK,GCLIST
-*CMZ : 3.21/02 29/03/94 15.41.18 by S.Giani
-*-- Author :
-*
-+SEQ,GCLIST
-+DECK,GCLUND
-*CMZ : 3.21/02 29/03/94 15.41.18 by S.Giani
-*-- Author :
-*
-+SEQ,GCLUND
-+DECK,GCMATE
-*CMZ : 3.21/02 29/03/94 15.41.18 by S.Giani
-*-- Author :
-*
-+SEQ,GCMATE
-+DECK,GCMULO
-*CMZ : 3.21/02 29/03/94 15.41.18 by S.Giani
-*-- Author :
-*
-+SEQ,GCMULO
-+DECK,GCMUTR
-*CMZ : 3.21/02 29/03/94 15.41.18 by S.Giani
-*-- Author :
-*
-+SEQ,GCMUTR
-+DECK,GCMZFO
-*CMZ : 3.21/02 29/03/94 15.41.18 by S.Giani
-*-- Author :
-*
-+SEQ,GCMZFO
-+DECK,GCNUM
-*CMZ : 3.21/02 29/03/94 15.41.18 by S.Giani
-*-- Author :
-*
-+SEQ,GCNUM
-+DECK,GCOMIS
-*CMZ : 3.21/02 29/03/94 15.41.18 by S.Giani
-*-- Author :
-*
-+SEQ,GCOMIS
-+DECK,GCONSP
-*CMZ : 3.21/02 29/03/94 15.41.18 by S.Giani
-*-- Author :
-*
-+SEQ,GCONSP
-+DECK,GCONST.
-*CMZ : 3.21/02 29/03/94 15.41.18 by S.Giani
-*-- Author :
-*
-+SEQ,GCONST.
-+DECK,GCOPTI
-*CMZ : 3.21/02 29/03/94 15.41.18 by S.Giani
-*-- Author :
-*
-+SEQ,GCOPTI
-+DECK,GCPARA.
-*CMZ : 3.21/02 29/03/94 15.41.18 by S.Giani
-*-- Author :
-*
-+SEQ,GCPARA.
-+DECK,GCPARM.
-*CMZ : 3.21/02 29/03/94 15.41.18 by S.Giani
-*-- Author :
-*
-+SEQ,GCPARM.
-+DECK,GCPHNR.
-*CMZ : 3.21/02 29/03/94 15.41.18 by S.Giani
-*-- Author :
-*
-+SEQ,GCPHNR.
-+DECK,GCPHPR.
-*CMZ : 3.21/02 29/03/94 15.41.18 by S.Giani
-*-- Author :
-*
-+SEQ,GCPHPR.
-+DECK,GCPHRD.
-*CMZ : 3.21/02 29/03/94 15.41.18 by S.Giani
-*-- Author :
-*
-+SEQ,GCPHRD.
-+DECK,GCPHXS.
-*CMZ : 3.21/02 29/03/94 15.41.18 by S.Giani
-*-- Author :
-*
-+SEQ,GCPHXS.
-+DECK,GCPHYS
-*CMZ : 3.21/02 29/03/94 15.41.18 by S.Giani
-*-- Author :
-*
-+SEQ,GCPHYS
-+DECK,GCPMXZ.
-*CMZ : 3.21/02 29/03/94 15.41.18 by S.Giani
-*-- Author :
-*
-+SEQ,GCPMXZ.
-+DECK,GCPOLY
-*CMZ : 3.21/02 29/03/94 15.41.18 by S.Giani
-*-- Author :
-*
-+SEQ,GCPOLY
-+DECK,GCPOTM.
-*CMZ : 3.21/02 29/03/94 15.41.18 by S.Giani
-*-- Author :
-*
-+SEQ,GCPOTM.
-+DECK,GCPUSH
-*CMZ : 3.21/02 29/03/94 15.41.18 by S.Giani
-*-- Author :
-*
-+SEQ,GCPUSH
-+DECK,GCRZ
-*CMZ : 3.21/02 29/03/94 15.41.18 by S.Giani
-*-- Author :
-*
-+SEQ,GCRZ
-+DECK,GCSCAL.
-*CMZ : 3.21/02 29/03/94 15.41.18 by S.Giani
-*-- Author :
-*
-+SEQ,GCSCAL.
-+DECK,GCSCAN
-*CMZ : 3.21/02 29/03/94 15.41.18 by S.Giani
-*-- Author :
-*
-+SEQ,GCSCAN
-+DECK,GCSETS.
-*CMZ : 3.21/02 29/03/94 15.41.18 by S.Giani
-*-- Author :
-*
-+SEQ,GCSETS.
-+DECK,GCSHNO.
-*CMZ : 3.21/02 29/03/94 15.41.18 by S.Giani
-*-- Author :
-*
-+SEQ,GCSHNO.
-+DECK,GCSHPT.
-*CMZ : 3.21/02 29/03/94 15.41.18 by S.Giani
-*-- Author :
-*
-+SEQ,GCSHPT.
-+DECK,GCSPEE.
-*CMZ : 3.21/02 29/03/94 15.41.18 by S.Giani
-*-- Author :
-*
-+SEQ,GCSPEE.
-+DECK,GCSTAK.
-*CMZ : 3.21/02 29/03/94 15.41.18 by S.Giani
-*-- Author :
-*
-+SEQ,GCSTAK.
-+DECK,GCTIME
-*CMZ : 3.21/02 29/03/94 15.41.18 by S.Giani
-*-- Author :
-*
-+SEQ,GCTIME
-+DECK,GCTMED
-*CMZ : 3.21/02 29/03/94 15.41.18 by S.Giani
-*-- Author :
-*
-+SEQ,GCTMED
-+DECK,GCTRAK
-*CMZ : 3.21/02 29/03/94 15.41.18 by S.Giani
-*-- Author :
-*
-+SEQ,GCTRAK
-+DECK,GCUNIT
-*CMZ : 3.21/02 29/03/94 15.41.18 by S.Giani
-*-- Author :
-*
-+SEQ,GCUNIT
-+DECK,GCURSB
-*CMZ : 3.21/02 29/03/94 15.41.18 by S.Giani
-*-- Author :
-*
-+SEQ,GCURSB
-+DECK,GCVOL1
-*CMZ : 3.21/02 29/03/94 15.41.18 by S.Giani
-*-- Author :
-*
-+SEQ,GCVOL1
-+DECK,GCVOL2
-*CMZ : 3.21/02 29/03/94 15.41.18 by S.Giani
-*-- Author :
-*
-+SEQ,GCVOL2
-+DECK,GCVOLU
-*CMZ : 3.21/02 29/03/94 15.41.18 by S.Giani
-*-- Author :
-*
-+SEQ,GCVOLU
-+DECK,GCXLUN
-*CMZ : 3.21/02 29/03/94 15.41.18 by S.Giani
-*-- Author :
-*
-+SEQ,GCXLUN
-+DECK,GSECTI
-*CMZ : 3.21/02 29/03/94 15.41.18 by S.Giani
-*-- Author :
-*
-+SEQ,GSECTI
-+DECK, LUDAT1
-*CMZ : 3.21/02 29/03/94 15.41.18 by S.Giani
-*-- Author :
-*
-+SEQ, LUDAT1
-+DECK, LUDAT3
-*CMZ : 3.21/02 29/03/94 15.41.18 by S.Giani
-*-- Author :
-*
-+SEQ, LUDAT3
-+DECK, LUJETS
-*CMZ : 3.21/02 29/03/94 15.41.18 by S.Giani
-*-- Author :
-*
-+SEQ, LUJETS
-+DECK,PAWC
-*CMZ : 3.21/02 29/03/94 15.41.18 by S.Giani
-*-- Author :
-*
-+SEQ,PAWC
-*-- Author :
-+PATCH,PAMEND.
-*
diff --git a/src/car/hbook.car b/src/car/hbook.car
deleted file mode 100644
index f0297c9..0000000
--- a/src/car/hbook.car
+++ /dev/null
@@ -1,2162 +0,0 @@
-+TITLE.
-HBOOK 4.24/00 05/05/95 11.48.44 PROGRAM LIBRARY HBOOK = Y250
-+PATCH,$VERSION.
-+DECK,V4_24.
-*CMZ : 24/10/95 14.32.46 by Julian Bunn
-*-- Author : Unknown 05/05/95
-*
-* 24/10/95 14.32.19
-*
-* Remove redundant option in HRENID
-*
-* 11/10/95 19.56.41
-*
-* Correct bug in HFILPR that was causing X values equal to the
-* end of the scale not to be filled in the overflow bin correctly.
-*
-* 11/10/95 17.51.27
-*
-* Modify HUWFUN so that option I does not cause calls to HBNAME to appear.
-*
-* 26/09/95 11.16.42
-*
-* Correction in hoper1 which previously was accessing non-existant
-* error banks for some histogram operations. (Sent by Mike Redmond)
-*
-* Removal of trigraph ???' in routines HLATTR HLNEXT and HLNXTG1
-*
-* Correction in HMCMLL for wrong number of args in call to MNEXCM
-*
-* 30/06/95
-*
-* Correction by Rene in HBIN for "big integers".
-*
-* 21/06/95
-*
-* Add test program for FPCLASSC patch. New directory TESTS for HBOOK
-* test programs ...
-*
-* 17/05/95
-*
-* Mod to HMDIR so that identically named sub-directories are not
-* created in memory.
-*
-* 16/05/95 10.30.55
-* Mods in HMINIM and HMAXIM to reset the min and the max when
-* the min is greater than the max for 2d histos (it was implemented
-* only for 1D).
-*
-* 05/05/95 14.57.05
-* FPCLASSC selected in *HBOOK
-*
-*::> VERSION 4.24/00 05/05/95 11.48.44
-*
-*
-* New patch FPCLASSC by Francois Dardare. This interfaces to the
-* system routines on the various platforms that identify the
-* IEEE NaNs (where appropriate), and classifies them in a general
-* way. The routines are called in HFILL, HFN and HFNT2 to check
-* user arguments, and warnings are issued where appropriate.
-*
-* New routine HNFORM for assiting users in creating the character
-* string that describes CW nTuple variables that is used as an
-* argument to HBNAME or HBNAMC.
-*
-+DECK,V4_23.
-*CMZ : 27/07/95 17.22.32 by Julian Bunn
-*-- Author : Rene Brun 05/11/94
-*
-*::> VERSION 4.23/02 05/05/95 11.19.28
-*
-*
-*::> VERSION 4.23/01 22/02/95 14.34.06
-*
-* New user routines HIJE and HXYE for returning errors on cells in
-* 2D histograms a la HIE,HXE.
-*
-* New routine HBVERS in the C patch, that returns the version string.
-*
-* Some error checking and extra calls to HBUG in the HFNT tree.
-*
-* Modification to HCX to fix a bug produced when the routine was
-* called with option 2 (get error) for a histogram without the
-* required bank.
-*
-* Extra argument IOPT added to HCXY in order to allow the caller
-* to specify whether the contents (IOPT=1) or the error (IOPT=2)
-* on the given cell is returned.
-*
-* Bug corrected in HROUT. Problem was appearing in case of many
-* subdirectories. Variable NLCDIR was not correctly set when returning
-* to the parent level.
-*
-* Deck HNTDUP: declare IDUM to be REAL*8 to make it double-word aligned.
-*
-* Introduce DOUBLE PRECISION in HCX for Profile histograms
-*
-* Adjust HREBIN to allow for non-equiwidth bins.
-*
-*::> VERSION 4.23/00 05/11/94 09.36.29
-*
-* HLDIR with CHOPT='N' works now also for disk directories.
-*
-* Protect HMINUT when option Z is given (LINEAR was set to zero)
-*
-* Protection in HFN in case HGIVEN is called immediatly before.
-* LCONT pointer is now always recomputed.
-*
-* Implement ../ style in HPATH.
-+DECK,V4_22.
-*CMZ : 4.22/14 14/10/94 12.20.44 by Rene Brun
-*-- Author : Rene Brun 30/03/94
-*
-*::> VERSION 4.22/14 14/10/94 12.20.44
-*
-* Due to some early design mistake PAW expects all character columns to
-* be returned in character*32 variables instead of in variables of the
-* original size. For single character variables this was fine, however
-* character array columns were not restored correctly (unless they had
-* an original size of 32). To fix this HBOOK has to know if the Ntuple
-* is read back by PAW. Bit 3 in the status word of the first block is
-* set in this case (in HBNAM). HGNT2 and HGNTF check this bit in case
-* of character arrays. Routines modified: HBNAM, HGNT2, HGNTF, HNTGET,
-* HRIN.
-*
-*::> VERSION 4.22/13 28/09/94 08.40.30
-*
-* Change in HBUG. When LERR.LE.0 error messagse are not printed.
-*
-* HNTDEL: fix UHTOC call (don't multiply NCHRZ by 4).
-*
-* Change default quota to 32000 records in HRFILE
-*
-*::> VERSION 4.22/12 19/09/94 11.16.36
-*
-* Move VIDQQ sattement in HLIMAP to avoid problem with F2C.
-*
-*::> VERSION 4.22/11 05/09/94 13.36.29
-*
-* Many decks indented.
-*
-* New option in HLIMAP.
-* When the first parameter LIMIT=0, an existing shared memory
-* is attached as the current directory. In this case, HLIMIT must have been
-* called before.
-*
-* Changes in HDIFF to solve numerical problems (precision).
-*
-* Extend range of formats in HINDEX and HINPRX.
-*
-* Bug corrected in HRESETM1 and HREZ0M in case of profile histograms
-* or histograms with error bars (bug reported by W.Brueckner)
-*
-* Protection in HFCXY for large real numbers
-*
-*::> VERSION 4.22/10 04/08/94 14.58.02
-*
-* Routine HALLOC:
-* Free all Ntuple buffers or all buffers belonging to Ntuples in
-* the same unit.
-* If lun<0 free all Ntuple buffers that are in use (do this from an
-* exception handler in case the filling of the buffers was
-* interrupted).
-*
-* Modification in HREBIN. If IFIRST<0 then do not normalize Y values
-*
-* Bug corrected in HMINUT when option 'E' is specified.
-* NARGS must be set to 0 before calling MNEXCM in this case.
-* (Problem reported by Marcos Dracos)
-*
-* Profile histograms can be filled with weights (mods in HFILPF)
-*
-*::> VERSION 4.22/09 27/07/94 18.45.44
-*
-* Implement calculation of errors in HOPERA for 2-D histograms
-*
-* Deck HALLOC: force refill of Ntuple cache also when event range changes.
-* added new routine HBFREEC to free cache associated
-* with chains.
-*
-* Routine HBALLOC: pass also first event (to define event range).
-*
-* Routine HGNT1: accepts dynamic buffer offsets as argument (used by
-* HGNTBF).
-*
-* Routines HGNT, HGNTV, HGNTB: changed call to HGNT1 accordingly.
-*
-* Routine HGNT2: check for the usage of the cache for each variable
-* instead of only once.
-*
-* Routine HGNTBF: completely re-written. Does not read a whole column
-* in cache anymore. Is now a convenient front-end for HGNT2 with the
-* IVOFF cache offsets set.
-*
-* New routine HCPOFF: copy cache offsets into an array IVOFF. This array
-* is used in case of chains in PAW to continue filling the cache in the
-* place where the last call to HGNTF stoped.
-*
-*::> VERSION 4.22/08 15/07/94 09.31.43
-*
-* Modify calling sequence of HNTDUP (new convention for NEWBUF)
-*
-* New routine HBGMAX in HALLOC to return the maximum amount of memory
-* that may be malloced.
-*
-* Protection in HSCR in file in READ only mode
-*
-* New routine HCONVOL introduced (Per Steinar Iversen)
-* See comments in routine
-*
-* Modify dummy calls to HFUNC,HSUPIM,HSUPIS to avoid intercompilation
-* analysis message on Alpha/VMS.
-*
-*::> VERSION 4.22/07 28/06/94 17.44.26
-*
-* New routine HMERGE(Nfiles,Files,Filout)
-* New Routine HMERGIN calls HMERGE
-*
-*::> VERSION 4.22/06 28/06/94 08.25.18
-*
-* Mods in HRFILE to take into account possible new option 'N' in RZMAKE
-*
-* HRESET can reset ntuples
-* New routine HNTRSET called by HRESET for CWNtuples
-*
-* Implement new option 'K' in HMINUT
-*
-*::> VERSION 4.22/05 21/06/94 18.38.39
-*
-* Deck HALLOC: fix in case malloc and realloc fail.
-*
-* Routine HMERGE: need option X in HROPEN for auto-record length
-* detection to work on Alpha/OSF/VMS.
-*
-* Routine HNTDUP: updated some comments.
-*
-* Mods in HMINUT.
-* Set the FNIX and FEPS parameters in agreement with the MINUIT definition.
-* Defaults are unchanged. FNIX and FEPS can be modified via
-* the routine HSETPR or PAW command HSETPR.
-*
-* New routine HBAR2 to store errors for 2-D histograms
-* Routines HF2,HPAKE,HUNPKE,HFITH1 modified in consequence
-*
-* hfithc - protection against deviation being 0 is introduced
-*
-* hminut - correction MINUIT save file ISAV=7
-*
-* Protection in HNTNAM in case of misalignement (INTEGER*4 mixed
-* with REAL*8 variables in the same block).
-*
-*::> VERSION 4.22/04 08/06/94 11.38.01
-*
-* Routine HRENAME: works now also for CWN's.
-*
-* Routine HBNT: in case of memory resident Ntuple set IQ(LCID+ZNCHRZ)=0.
-*
-* Routine HUWFUN: cosmetic change.
-*
-* New routine HNTDUP: duplicates a complete Ntuple header. Works for
-* CWN's as well as RWN's.
-*
-* New routine HNTVDEF: returns a complete variable definition. Used
-* by HNTDUP (works for CWN's and RWN's).
-*
-* New patch HMERGE: this patch contains the program HMERG that can merge
-* hbook files with identical objects. Histograms are added and
-* Ntuples are combined. Works for CWN's and RWN's.
-* HMERG is the main program (to be selected with option MAIN). It calls
-* the main control routine HMERGE (user callable).
-*
-* Implement proposal from Stephane Coutu for the computation of errors
-* for profile histograms (see routine HBPROF)
-*
-* Add TYPE declaration to several sequences
-*
-* Changes in HIDOPT for option SHOW
-* Options PROS or PROE are displayed with option SHOW
-*
-* Mods in HCX for the computation of errors for profile histograms.
-* With the previous versions, channels with one entry only had
-* an error=0. Now the error is teh sqrt(abs(content)).
-*
-* Mystyping in HWPDCL (PAWR8 instead of PAWCR8
-*
-*::> VERSION 4.22/03 30/05/94 14.10.33
-*
-* Routine HLNEXT supports RLOGIN directories
-*
-* New routine HRENAME(ID,CHOLD,CHNEW) to rename columns of ntuples
-*
-* Bug fixed in HCDIR in case of subdirectories (hrout, option T, then HREND)
-*
-*::> VERSION 4.22/02 19/05/94 12.07.56
-*
-* Several changes in patch HMCSTAT (Christine Beeston)
-* >1) I've fixed the bug with the number of entries - I now use HSUM instead
-* >of HNOENT to get the number of entries in a histogram, since including
-* >the underflows and overflows messes up the normalisation of the result.
-* >
-* >2) The user can now do multiple simultaneous fits (this was requested and
-* >seems useful) - to do this they must call HMCINI once for each set of
-* >histograms (each fit will have a data histogram and a set of monte carlo
-* >and weight histograms), and then
-* >HMCLNL must be called with the histogram identifiers and number of MC
-* >sources, as well as the fractions.
-* >
-* >HMCMLL already uses the new HMCLNL, I have left the old HMCLNL as HMCLNO,
-* >but will delete it in a couple of months.
-* >
-* >HMCINI and the new and old versions of HMCLNL both contain a banner
-* >announcing the change, as it's not backwards compatible.
-* >
-* >The weight histograms may be used for more than one of the
-* >fits if necessary - a check is made to make sure that they are not
-* >normalised more than once.
-*
-* Minor change in HRENDC (nchmax=nchtop before loop)
-*
-* Mods in HMINUT to compute an equivalent chisquare in case
-* of a log-likelihood fit
-*
-* Bug fixed in HPAK in case weights <1.e-5 (number of entries was wrong)
-*
-* Protection in HREND (NCHTOP was changed in the loop)
-*
-*::> VERSION 4.22/01 07/04/94 09.04.32
-*
-* Bug corrected in HFC1 in case of empty histograms with one bin only
-*
-*::> VERSION 4.22/00 30/03/94 09.53.07
-*
-* Bug fixed in HBOOKN (IQ(LCIDN+5) set to ID) for disk-resident tuples
-* This bug affected HBOOK jobs calling HPROJ1,HPROJ2, HGN or HGNF when
-* the ntuple header was not written to the file
-*
-+DECK,V4_21.
-*CMZ : 4.21/13 17/03/94 10.36.58 by Rene Brun
-*-- Author : Rene Brun 26/10/93
-*
-*::> VERSION 4.21/13 17/03/94 10.36.57
-*
-* Routine HNTDEL has been rewritten (cannot call HLOOP if HDELET is called)
-*
-*::> VERSION 4.21/12 16/03/94 17.42.29
-*
-* Correct bug in HNTDEL (see after HDELET the 2 lines commented)
-*
-* Mods in HGIVE to return TITLE in case of ntuples
-*
-* HRESET can reset memory resident ntuples
-*
-*::> VERSION 4.21/11 12/03/94 15.48.34
-*
-* New routine HRENDC
-* C I/O option implemented in HRFILE/HROPEN
-*
-*::> VERSION 4.21/10 03/03/94 16.00.31
-*
-* Maximum size of PAWCR4 increased from 5000 to 50000 words
-*
-*::> VERSION 4.21/09 28/02/94 18.55.39
-*
-* Option 'W' can be specified with option 'L' (log likelihood)
-* When option W is given, bins with errors=0 are not used in the fit.
-*
-* New option 'Z' added in HFITV.
-* When option 'Z' is given, UFCN is the user fitting model
-* UFCN is a subroutine with the calling sequence:
-* Subroutine UFCN(N,X,Y,EY,NPAR,IFLAG,NPFITS)
-* where X(N),Y(N),EY(N) are the input vectors,
-* NPAR the number of parameters
-* NPFITS is an output parameter= Number of points used in the fit
-* The user must declare the common/HCFITD/FITPAD(24),FITFUN in UFCN
-*
-* Change name of routine HBIBNIT to HBINIT1 to avoid clash with OPAL.
-*
-* New routine HKIND returning the type of ID.
-*
-* Bug corrected in HFITV: variable BINWID not set. (Reported by W.Mueller)
-*
-* Argument missing in CALL MZPUSH in routine HRZKEY.
-*
-* bug corrected in HGNTBF:
-* return as negative error the number of columns that we load from disk
-*
-*::> VERSION 4.21/08 17/02/94 16.41.07
-*
-* Change DLOG, DSIGN and DABS to SIGN,LOG and ABS in patch HMCSTAT.
-*
-* New routines HKFILL, HKF1, HKFF1, HKF2, HKFF2, HKFILPF,HKFI1,HKFFI1.
-* These routines are fast filling routines called in teh context of PAW
-* by the new COMIS translator facility.
-*
-* Packing of floating points in CWN was not correct.
-* Fixes are in routines HFNT2, HGNT2, HGNTF, HNTNAM.
-*
-* Set IQUEST(1) in HRZIN/HRZOUT.
-*
-* Clear buffers in HREND.
-*
-* Changes in HCDIR/HLDIR and HLNEXT for PIAF files.
-*
-* Changes in HROUT and HNTRD:
-* Status word should be 0 when buffer comes from disk. However, in one
-* strange case (when coming from Piaf) it was not 0.
-*
-* New routine HF1E(id,x,w,e) to fill a 1-D histogram
-* ID contents incremented by W
-* ID errors incremented by E**2
-*
-* New routine HBOOKNC. This new routine has a calling sequence
-* very close to HBOOKN and creates a CWN instead.
-*
-* Changes in pilot patch for WINNT and MSDOS versions.
-*
-* Don't reset LBUF and LTMP in HCDIR and HROUT. Only update the
-* master pointer LBUFM and LTMPM. Other routines involved: HNBUF,
-* HNBUFD, HNBUFR, HNTMP, HNTMPD. This fixed a bug reported
-* by M. Dahlinger.
-*
-* New routine HNTDEL. This routine is called by HREND and deletes
-* all Ntuple headers of non-memory resident Ntuples related to the
-* closed unit from //PAWC.
-*
-* In HRZCD used sequence $CZSOCK.
-*
-* Compute binomial errors in HOPERA if option B is given.
-*
-* New routines HBONT,HFONT,HFONTR,HFONTCX to create and fill
-* an Omnipurpose Column-Wise-ntuple.
-* NEW sequence /HCBONT/
-*
-* Optimisation in HRZKEY
-*
-* In HNTNAM a protection was missing
-* and in HBSET ierror was not initialized
-*
-*::> VERSION 4.21/07 20/12/93 13.01.27
-*
-* Changes in HRDIR for Unix shared memory.
-* New routine HRDIRM in patch HMMAP called by HRDIR.
-*
-* Bug corrected in HLATTR for global sections
-*
-* Bug corrected in HBNT and HROUT for CWN memory-resident ntuples in
-* the case of subdirectories in RZ file.
-* Same bug in HNBFWR and HNTRD.
-*
-* Bug corrected in HPAKAD
-*
-* Bug fixed in HGNTF in case of packing and multiple ntuples
-*
-* Protection in HBNAME (HNTNAM)
-*
-*::> VERSION 4.21/06 09/12/93 08.56.15
-*
-* Bug found in the hmcstats code and fixed. The bug would have
-* caused slightly different results for people using VERY low monte carlo
-* statistics, with lots of empty bins (Christine Beeston).
-*
-* New routines HLNXTG and HLNXTG1 in HGLOBAL.
-* New routines HLNXTM and HLNXTM1 in HMMAP.
-* New routines HRZING and HRZINM called from HLATTR.
-* These new routines are called by HLNEXT to return the next
-* object from a global section or shared memory.
-*
-*::> VERSION 4.21/05 29/11/93 17.23.14
-*
-* New routine HOPTPF to send /HCOPT/ to PIAF.
-*
-*::> VERSION 4.21/04 29/11/93 08.15.23
-*
-* New routine HSTAF(CHOPT).
-* If CHOPT='YES' ststistics are computed at filling time.
-* routines modified: HBOOK1, HBOOK2, HBPROF, HMACHI.
-* new sequence /HCOPT/
- HSTAF is automatically called by the HPLOT options 'HSTA' and 'HNST'
-*
-*::> VERSION 4.21/03 25/11/93 15.47.53
-*
-* New routine HRZKEY called by HRIN. The new routine may speed up
-* considerably the routines HGN and HGNF. It computes the serial key
-* number for each ntuple extension and stores it in a bank which
-* is the next of LCONT.
-* Routines HGN and HGNF modified accordingly.
-*
-*::> VERSION 4.21/02 17/11/93 13.06.05
-*
-* Problem in HCDIR preventing the RLOGIN command in PAW is fixed.
-*
-* Modify HRENID to process old/new RWNs and CWNs
-*
-* Changes in HCREATEG to support ALPHA/VMS global sections.
-*
-*::> VERSION 4.21/01 16/11/93 08.52.59
-*
-* Add type declarations in HUWFUN
-*
-* In HINDEX, change format from I6 to I7.
-*
-* Mods in HCDIR for the old PIAF/PAWSERV.
-*
-* Mods in HDELET/HIDPOS for PIAF (add new sequence $HCACHE).
-*
-* Implement possibility to add 1-D histograms with alphanumeric labels
-* Mods in HOPERA. New routine HOPER1A.
-*
-* Protection in routine HDBCOP (R.J.Genik). See comments in routine.
-*
-* Set bit 5 to 0 in HLABEL
-*
-*::> VERSION 4.21/00 26/10/93 15.39.39
-*
-* Unused parameters deleted in the following routines:
-* HRESETM1,HREZ0M,HCOPYN,HCOPYT.
-*
-* The following obsolete routines from HBOOK version 3 have been deleted:
-* HCORE,HDISKF,HFNEXT,HISTGO,HLCM,HLCM3,HLOK,HSTORE,HUNLOK,HWRITE.
-*
-* Change format in HFNT2 error message (mail from Yves Roblin)
-*
-* Remove unused variables or common blocks
-+DECK,V4_20.
-*CMZ : 4.20/14 22/10/93 11.19.43 by Rene Brun
-*-- Author : Rene Brun 21/06/93
-*
-*::> VERSION 4.20/14 22/10/93 11.19.43
-*
-* Remove IOFSET limitation in HRIN for ntuples
-*
-*::> VERSION 4.20/13 21/10/93 15.10.39
-*
-* Introduce WINNT flag in nearly all routines with the LINUX flag.
-*
-* Large array T removed in HMCLNL (C.Beeston)
-*
-*::> VERSION 4.20/12 18/10/93 17.48.08
-*
-*
-*::> VERSION 4.20/11 15/10/93 16.56.03
-*
-*
-* Routine HGNTBF: fixed bug in case an index variable fit in memory
-* while the variable depending on that index variable did not fit in
-* memory.
-*
-*::> VERSION 4.20/10 13/10/93 18.01.16
-*
-*
-* Implement possibility to list/plot histograms in a subdirectory
-* of a shared memory section. Mods in HCOPYU and HPLISM.
-*
-* Routine HMCMLL: put DATA statement after declarations.
-*
-* Routine HCDIR: don't allow to CD to server connection point (like
-* cd //piaf1) this does not make sense plus it causes conflicts when
-* a chain is named piaf1.
-*
-* Routine HNBUF: first word of contents back must be zeroed. Fixes bug
-* when filling different Ntuples with index variables in the same job.
-*
-* KEEP,HCMPCM contained +SELFs: OK for CMZ not for Patchy.
-* New KEEPs,HCMPCM1 and 2.
-*
-*::> VERSION 4.20/09 28/09/93 16.39.40
-*
-*
-* New PATCH,HMCSTAT from Christine Beeston, R.Barlow from OPAL.
-* Fits the given Monte Carlo distributions to the data distribution, using
-* a binned maximum likelihood fit which includes the effect of both data
-* and Monte Carlo statistics, and allows weights to be
-* provided for each Monte Carlo distribution. The data and Monte Carlo
-* distributions must be presented in 1 dimensional histograms.
-* The best estimate of the fraction of each Monte
-* Carlo distribution present in the data distribution is returned, with an
-* error estimate where required.
-*
-* Common /PAWIDN/ : X(512) changed to X(522)
-*
-* New routines HPLISG,HPLISG1 in patch HGLOBAL.
-* Routine HLDIR modified to call new routine HPLISG (VAX only).
-* HPLISH can do a Histo/List in Global sections.
-*
-* Replace line with TEST.GT.1.5 by TEST.GE.0. in HFCN
-*
-*::> VERSION 4.20/08 12/09/93 18.57.43
-*
-*
-* Histogram directory bank LTAB created and MZPUSHed with 500 words
-* and links instead of 50. This speeds up considerably programs
-* using a large number of histograms.
-*
-* New deck HRNGPF in patch HBOOK
-* New deck HNDESC in patch HNTUP
-* Corrections in CWN filling and GET routines for character type columns
-*
-* Ulrich Mueller changes for IEEE computers in filling routines.
-* There is an unpleasant feature in HBOOK on computers with IEEE 754
-* floating point arithmetic (in our case on DECstations under Ultrix
-* 4.3a, CERNLIB 93b or 93d).
-*
-* Calculations on these machines can give as result Infinity or
-* Not-a-Number (NaN). If one tries to fill these numbers into histograms
-* (and this happens in real-world applications, especially during the
-* development phase of a program), some problems may arise:
-*
-* 1) Filling of +/- infinity as value. This case is handled properly by
-* the checks for over/underflow and the value is counted as such.
-*
-* 2) Filling of NaN as value. The over/underflow checks fail because
-* relations like .LT. or .GE. are always false if one of the operands
-* is NaN. Then the value is converted to a bin address, which is an
-* undefined integer and finally results in either a segmentation
-* fault or an overwriting of memory somewhere.
-*
-* However, this could easily be fixed, for example in HF1 (the other
-* routines are analogous):
-*
-* IF(X.LT.Q(LPRX+1))THEN
-* ICHAN=0
-* ELSEIF(.NOT.(X.LT.Q(LPRX+2)))THEN
-* ICHAN=IQ(LPRX)+1
-* ELSE
-* ... calculate bin address ...
-* ENDIF
-*
-* By changing the overflow check from .GE. to .NOT. .LT. the NaN
-* value will be counted as overflow. Another approach would be a
-* separate check for NaN, something like
-* IF (.NOT. (X.LT.0. .OR. X.GE.0.))
-* together with an appropriate error message.
-* ====> This changes has been made in all filling routines
-*
-* 3) Filling of Infinity or NaN as a weight. This is maybe the worst
-* case. The value is added to the bin, and this results in a crash
-* when the ZEBRA structure is written to a file, or in a crash of PAW
-* if one tries to plot the bad histogram.
-*
-* I propose to add a check for the finiteness of the weight. On most
-* machines a (C-)function "finite" is available for that purpose.
-* =====> This suggested change is not yet implemented.
-* Ulrich Mueller Exp. WA89, Div. PPE, CERN, CH-1211 Geneva 23
-* ulm at vsnhd1.cern.ch Phone +41-22-767-8658, FAX +41-22-7850314
-*
-*::> VERSION 4.20/07 07/09/93 12.09.33
-*
-* Optimization in HGNTBF in case of running on Piaf slave server
-*
-* Introduced the deck HRNGPF (formerly PFRANGE in the Paw source)
-*
-* Optimize logic of HCDIR for PIAF connections
-*
-*::> VERSION 4.20/06 06/09/93 12.20.45
-*
-* Optimize logic for sorting IDs in HRSORT
-*
-*::> VERSION 4.20/05 29/08/93 10.08.32
-*
-*
-* New routine HRSORT(CHOPT) to sort IDs in a RZ directory
-* HRSORT is automatically called by HLDIR if option 'S' given
-* Routine HLNEXT automatically sorts IDs in increasing order
-* HLNEXT is the routine called by the PAW++ browser
-*
-* New definition of $HCPIAF for parallel PIAF
-* Changes in HLOGPF,HINPF,HOUTPF for parallel PIAF
-*
-* Changes in LINUX version in HSHM
-*
-* Changes for Windows/NT (HMMAP in particular)
-*
-* Sequence/common/HCRECO renamed HCRECV to avoid clash with L3 programs
-*
-*::> VERSION 4.20/04 05/08/93 15.06.25
-*
-* Protections introduced in case of empty arrays in HGNT2,HGNTBF.
-*
-* Changes in Unix mapping memory routines.
-* SGI moved from BSD to SYS5 class.
-*
-*::> VERSION 4.20/03 03/08/93 15.30.17
-*
-*
-* Bug fix in HGNTBF for indexed variables in ntuples.
-*
-* Protection in HRESET to not reset ntuples.
-*
-* Protection in HRIN if IOFSET is not 0 for RWN ntuples.
-*
-* Changes in sequence HCNTPAW. MAXCOL=1000 replaced by:
-* MAXCR8=1000, MAXCR4=5000, MAXC32=1000
-*
-* Maximum number of files extended to 50.
-*
-* New routine HPROF2 to make profile histograms from 2-D histograms
-*
-* Mods in HMINUT to call a user routine (via JUMPX2) to read
-* MINUIT commands. (In paw the user routine is PMNCOMD)
-*
-* Decks HCDIR and HROUT: update LBUF and LTMP when switching between
-* different directories in memory.
-*
-* New routines HRESETM,HRESETM1,HREZ0M to reset histograms
-* in shared memory (from W.Bruckner).
-* New routines HPLISM,HPLISM1 to list histograms in shared memory (W.B.)
-* Mods in HLDIR to call HPLISM.
-*
-* Remove WARNING in HDIFFB in case of identical histograms (HDBINI)
-*
-*::> VERSION 4.20/02 23/07/93 10.44.48
-*
-* Mods in HRESET to reset HFIT structure
-*
-* Deck HFNT2: when value is out of range substitute max or min value,
-* also check range when only number of bits is specified.
-*
-* Deck HALLOC: moved code from PVMEM (PAW) into HBPRNT.
-*
-*::> VERSION 4.20/01 28/06/93 11.48.27
-*
-* Mods in HMINUT to call the new MINUIT routine MNCOMD.
-* The new routine MNCOMD is temporarily introduced as a DECK,MNCOMND
-* in the HBOOK file. This should be removed for the next release.
-* In particular MNCOMD will not work as it is on CRAYs.
-*
-*
-*::> VERSION 4.20/00 21/06/93 18.17.17
-*
-* Fix problem in HRIN (IOFSET moved to 1st statement)
-*
-* Deck HNTNAM: correct call to HBUG.
-*
-* Save in word 12 (ZID) of the CWN header the Ntuple ID used
-* to write the Ntuple extensions on disk. This ID necessary when an
-* Ntuple has been loaded in memory with on offset. Decks changed:
-* HRIN, HBNT, HNBUFR, HNTRD.
-*
-* Deck HGNTF: changed some error checks.
-*
-* Deck HNTMPF: forgot to set LTMP1 (caused problems reading and
-* writing CWN's at the same time).
-*
-* Deck HRECOV: set NTCUR=0 and fixed special case of endless loop.
-*
-* Fixed bug in HALLOC (block names of 8 characters were overwriting
-* on VMS systems the first character of the column name)
-+DECK,V4_19.
-*CMZ : 4.19/05 08/06/93 12.17.57 by Rene Brun
-*-- Author : Rene Brun 29/04/93
-*
-*::> VERSION 4.19/05 08/06/93 12.17.57
-*
-*
-* Add new sequence /CZCBUF/IZCBUF
-* Changes in HMACHI,HRDIR and HLOGPF to use JUMPT2 to call CZGETC
-*
-*::> VERSION 4.19/04 07/06/93 08.48.10
-*
-*
-* Changes in HLNEXT (implement client/server for PIAF)
-* Routine HCREATEM modified for SYSV systems (ICOMAD(1) set to 0)
-* HRECOV improved for CWN. Recovery time faster.
-* Problem fixed in handling of chains (1st event was missed occasionally)
-*
-*::> VERSION 4.19/03 27/05/93 15.28.21
-*
-* LINUX version introduced (from V.Balashov and A.Lomov)
-*
-* Changes to HRECOV. New routines HRECO1 and HRECO2
-*
-*::> VERSION 4.19/02 26/05/93 16.00.03
-*
-*
-* New routine HRECOV to recover ntuples missing the last header info.
-* HRECOV attempts to read the latest saved header. From the header
-* information, it looks at all ntuple extensions to reconstruct
-* the maximum number of blocks/events.
-* If successful, the new header is written to the file
-* Header of CWM Ntuple is written the first time a content buffer
-* is written. The header is written again whenever a column has
-* been added to the Ntuple. After every HFNT2 call that caused
-* buffers to be written the RZ directory structure is flushed to disk.
-* These intermediate Ntuple headers are used by the HRECOV routine.
-* They can be recognized by the fact that IQ(LCID+ZNOENT) = -1.
-*
-* Protection added in HBFUN2 (for HRNDM2) (O.Perdereau)
-*
-* Improvements to HQSIG1/2/3. (J.Allison)
-*
-* Mods in HROPEN. An already open file in U mode cannot be attached
-* if another process is also attaching the file in U mode. RZEND now
-* called to delete the ZEBRA structure.
-*
-*::> VERSION 4.19/01 11/05/93 15.19.34
-*
-* New sequences $CZBUFF and $CZSOCK in HCDES
-* Changes in HCDIR, HRDIR and HLOGPF for the PIAF server case
-*
-* Routine HFN saves now the ntuple header and calls RZSAVE everytime
-* the RZ buffer is written to the file. This changes enables recovery
-* in case the job writing the ntuple crashes before HROUT/HREND.
-*
-* HRIN modified for the ADD option (IOFSET=99999)
-* A user reported a case where ID1+IOFSET=ID of an existing histogram.
-* When IOFSET=99999, the internal offset is now chosen to avoid a conflict.
-*
-* Bug corrected in HXE for variable bin size histograms
-*
-* Mods in Memory mapping routines HCREATEM and HALLOC
-*
-*::> VERSION 4.19/00 930429 8.34
-*
-* WARNING!!!. Patch HCDES split into individual sequences.
-*
-* New sequences JBYT3,JBYT4 introduced for MSDOS.
-* New sequence HCRLF (Carriage Return, Line Feed).
-* Several routines modified to introduce the flags MSDOS,NDP and GNU.
-* In printing formats, several '1' replaced by CRLF from HCRLF.
-*
-* Sequence $HCK modified. Parameters KBWIDX,KBWIDY deleted.
-* Parameters KMIN,KMAX renamed KMIN1 and KMIN2.
-* New Parameters KMIN2,KMAX2.
-* Logic to support HMINIM AND HMAXIM for 2-DIM implemented.
-* As a consequence the inverse of the binwidth is not stored
-* anymore in the LCID structure.
-* The position Q(LCID+KBWIDX) is now occupied by Q(LCID+KMIN2)
-* The position Q(LCID+KBWIDY) is now occupied by Q(LCID+KMAX2)
-* Routines HMAXIM/HMINIM modified.
-* All HBOOK/HPLOT routines dealing with the binwidth are changed.
-*
-* Bug fixed in HMINUT. In case of loglikelihood fits, the
-* MINUIT ERRDEF was incorrectly set to 0.5
-*
-* Sequence /HCFITD/ has been modified to FITPAD(24),FITFUN
-* When the option 'U' is given in the fit routines, the application
-* must store the value of the function in FITFUN (Double Precision).
-* By default, HFITGA,PO,EX use the 'U' option.
-*
-* Change in routine HOPER1 to prevent INTEGER Overflows in HFCX.
-* Number of entries in LC3 set to -1
-*
-* Logic to handle ntuple chains introduced.
-*
-* Bug corrected in HRZFRA (VAX version only)
-*
-* Changes in HBUG (CHMESS(1:1)=+ prints Warning instead of Error
-*
-* KEEP,HCFITR modified (added IFYLOW,IFYUP, renamed IFXLOW,IFXUP)
-* Introduce subrange in Y in all fitting routines
-*
-* HBFUN1: Change LCONT to LFUNC. LCONT recomputed if user function
-* calls HFIND.
-* HRZIN: Change LBANK-JBIAS to LBANK+JBIAS
-* New routines for chains
-* New option 'A' in HDIFFB
-+DECK,V4_18.
-*CMZ : 4.18/00 26/02/93 08.35.02 by Rene Brun
-*-- Author : Rene Brun 26/02/93
-*
-*::> VERSION 4.18/00 930226 8.35
-*
-* Routine HLATTR rewritten
-* New version of routine HQWAVE by John Allison
-* Mods in HFNT2
-*
-+DECK,V4_17.
-*CMZ : 4.17/09 16/02/93 10.01.47 by Rene Brun
-*-- Author : Rene Brun 31/07/92
-*
-*::> VERSION 4.17/09 930216 10.01
-*
-* Names of some ZEBRA banks modified. DDL implemented.
-* Mods in routines to list directories.
-* Bug fixed in HFNT2 in case a CWN is filled again (Dave Rees)
-*
-*::> VERSION 4.17/08 930204 11.57
-*
-* Nasty bug found in HNTWRT. When routine HCDIR is called,
-* then IDLAST is reset to 0. If HNTWRT was called again,
-* in the same call to HFNT, then IDRZ(1)=0 !
-*
-* Bug fixed in HLABEL and HLPOS (found by M.Goossens).
-*
-*::> VERSION 4.17/07 930201 14.06
-*
-* Changes in the Ntuple handling routines for ntuples with arrays
-* and substructures.
-*
-*::> VERSION 4.17/06 930126 18.16
-*
-* Changes in HGNT2 and HGNTF for ntuples with arrays.
-* Protection in case of large ntuples that could not be processed
-* by PAW.
-*
-*::> VERSION 4.17/05 930124 13.19
-*
-* Protections in HROPEN if filename already attached.
-* Change in HRFILE for option 'O' (exchange mode not used)
-* Bug fix in HRMDIR, HMDIR, HGN and HGNF.
-* Bug fix in HALLOC (wrong memory allocation when the new buffer
-* is bigger than the previous one for the same column)
-*
-*::> VERSION 4.17/04 930120 8.10
-*
-* The following problems fixed after the release:
-* Implement option 'O' in HRFILE to create old format files
-* Corresponding changes in HREND,HRIN,HRMDIR,HMDIR,HFN
-* Bug fixes when merging old-format with new-format ntuples
-* Bug fixed in HLABEL for 2-D case.
-* Bug fixed in HLNEXT,HLDIR2 to access the first key of a file.
-* Replace BIGP in HBOOKN by 1.E30 to avoid overflow on IBM.
-*
-*
-*::> VERSION 4.17/03 930115 17.09
-*
-* Version released for cernlib 93a
-*
-*
-*::> VERSION 4.17/02 921221 17.56
-*
-* Implement option 'E' in HOPERA.
-*
-* Changes in HSCR to delete ntuples
-*
-* New routine HDDIR to delete directories (memory or RZ)
-*
-* Bug fixed in HMINUT when option 'E' given
-* COMMON/HCFITD/FITPAD(25) may be used in user fcn routine (DOUBLE P)
-*
-* New example HEXAM8 in patch,HEXAM
-* Example HEXAM6 modified.
-* New ZEBRA pointers LHFIT,LFUNC,LHFCO,LHFNA introduced in HCBOOK
-* Changes in HSUPIN,HSUPIS
-*
-*::> VERSION 4.17/01 921207 16.54
-*
-*
-*
-* New set of routines to store alphanumeric labels on the axes.
-* Corresponding routines (HFC1,HFC2) to fill histograms with labels
-* (implementation by P.Aubert)
-*
-* New routine HFINAM to store the names of the parameters after HFIT..
-*
-* Modifications in HRZIN for PAWSERV
-*
-* Reorganization of LHBOOK and LCDIR links (See HLIMIT)
-* Link 8 of LHBOOK/LCDIR reserved for HPLTAB (instead of link 4)
-*
-* New Patch,HDIFF introduced (Rich Genik from D0)
-* New routine HDIFFB to compare histograms bin by bin
-* Existing routine HDIFF moved to this patch from patch,HBOOK.
-*
-* New Patch,HQUAD introduced (Author John Allison Manchester)
-* HQUAD (see routine HQUAD) performs a fit with multiquadric radial
-* basis functions on 1- and 2-D histograms and ntuples with up to
-* NDMAX variables.
-*
-*::> VERSION 4.17/00 920731 15.54
-*
-*
-* New PATCH,HNTUP introduced
-* All routines referencing ntuples modified, including I/O routines.
-* See new HBOOK manual for a complete description of the new ntuples.
-* Sequences /HCBOOK/, /HCDIRE/ modified.
-* Same sequences used by HPLOT and PAW (must be recompiled).
-*
-*
-* Protection in HOPER1 (divide by 0) (D.Sanders)
-*
-* Routine HFITHC modified. DOUBLE PRECISION added.
-* Option 'L' added in HFITHN
-*
-* Changes in HPAK,HFCX,HFCXY to increment the number of entries
-* following the sum of the contents in case of integer contents
-*
-* Bug corrected in HGNPAR for memory-resident ntuples (title garbled)
-* Bug corrected in HRIN for memory-resident ntuples (title garbled)
-*
-* Bug in output format in routine HWRITF corrected (Janusz Chwastowski)
-*
-*
-* ! ! ! ! W A R N I N G ! ! ! !
-*
-* HBOOK/RZ file format is changed. New version of HBOOK can still read
-* old format files. The change consists in adding a new key.
-* KEY(1)=ID as in old format
-* KEY(2)=ntuple extension number (0 for histograms)
-* The new array ICHTYP(20) in HCDIRE contains the type of HBOOK file.
-* ICHTYP(ICDIR)=1 for old format HBOOK files
-* =5 for new files
-* The new HBOOK files are machine independent and can be transported
-* across all architectures with normal binary FTP.
-* Maximum number of records in HBOOK file changed from 4000 to 16000
-* 'X' EXchange mode is now set automatically
-*
-+DECK,V4_16.
-*CMZ : 4.16/00 24/07/92 08.20.42 by Rene Brun
-*-- Author : Rene Brun 24/07/92
-*
-*::> VERSION 4.16/00 920724 8.20
-*
-* New routine HLNEXT to scan the content of a HBOOK, RZ directory
-*
-+DECK,V4_15.
-*CMZ : 02/06/92 17.55.07 by Rene Brun
-*-- Author : Rene Brun 17/04/92
-*
-*::> VERSION 4.15/00 920417 17.05
-*
-*
-* Bug fixed in HCREATEM/HMAPM (SYS5) by Chip Watson Cebaf.
-*
-* Bug fixed in HRESET in case of ntuples (J.Colas)
-*
-* Set error criterion properly for Chi**2 or Liklihood fits
-* routine HMINUT corrected (John Marraffino)
-*
-* Changes in HCDES. New sequence HCFITD.
-* HCFITD introduced in HFCNH,HFCNV,HGAUS,HDEXPO and HPOLYN.
-* COMMON/HCFITD/FITPAD(25) may be used in user routine FUTIL
-* instead of single precision parameters.
-*
-* Bug fixed in HFITHN (return array PARAM) Ian Scott
-*
-+DECK,V4_14.
-*CMZ : 4.14/05 21/03/92 10.52.54 by Unknown
-*-- Author : Rene Brun 22/10/91
-*
-*::> VERSION 4.14/05 920321 10.52
-*
-* Protection introduced in HPR1V (P.Lanius)
-*
-*
-*::> VERSION 4.14/04 920309 23.16
-* Ntuple saga again. The procedure to speed-up memory-resident
-* ntuples had several consequences. Changes made in HGNPAR.
-*
-*
-*::> VERSION 4.14/03 920308 8.33
-*
-* Change logic in HRIN for memory-resident ntuples.
-* Previous algorithm affected also disk-resident ntuples
-*
-*
-*::> VERSION 4.14/02 920306 11.04
-*
-* Bug corrected in HRIN for memory-resident ntuples (1 block)
-*
-*
-*::> VERSION 4.14/01 920302 16.31
-*
-* Bug corrected in HOPER1 for functions (A.Nathaniel)
-* Changes in UNIX memory mapping routines.
-* Note that HLIMAP cannot be used under HPUX with the current
-* version of f77 (crash in MZSTOR).
-*
-*
-*::> VERSION 4.14/00 911022 9.25
-*
-* Protections in HRNDM1 and HRNDM2
-* Changes in HFCNV
-* Format change in HPTIT
-* New routine HRENID to rename IDS on a RZ file
-* Bug corrected in HFUNC (shift by 1 channel)
-* Format change (I6 to I8) in HINDEX and HINPRX
-* Mods in HPR1H for BIBBI case
-* Bug corrected in HSTATI/HPRST in case of negative contents
-* Save IQUEST(10) in HROPEN due to changes in RZOPEN
-* New routine HGDIRE(LUN,CHDIR) to return TOPDIR name corresponding
-* to LUN.
-*
-* Option 'I' changed to ' ' in all calls to MZPUSH
-* Speed-up of HGN and HGNF
-* Changes in HRIN to speed up HGN/HGNF
-* New fast filling routine HF1N (called by PAW)
-*
-+DECK,V4_13.
-*CMZ : 4.13/01 06/09/91 13.59.22 by Rene Brun
-*-- Author : Rene Brun 02/09/91
-*
-*::> VERSION 4.13/01 910906 13.59
-*
-* Routines HPROJ1 and HPROJ2 changed with the correct /PAWIDN/
-*
-*::> VERSION 4.13/00 910902 17.07
-*
-*
-* This version of HBOOK requires ZEBRA version 3.66/8
-* Changes in PILOT,PATCH for IBMMVS and NEWLIB.
-* Changes in HEXAM for IBMMVS.
-* Changes in HMAXIM/HMINIM
-* SET EPS changed to 1.E-14 in HMINUT
-* New option 'E' in Fitting routines
-* Option 'E' selects a better error evaluation
-* New routine HGFIT returning fit parameters
-* Changes in HPR1H,HPR1V (reset I20,I21 for 2-Dim case)
-* New PATCH,CHBOOK (in C) for memory mapping)
-* Routine HLDIR can list a RZ tree in histo format.
-* Mods in HLDIR to call RZSCAN (new ZEBRA routine) and HLDIRT
-* Routine HLDIR2 deleted.
-* Protection in HPDIR when trying to print a RZ directory.
-* Routine HMDIR modified to allow creation of a directory
-* in a directory which is not the current directory
-* Bug corrected in HFUNC
-* Protection in HPAFF (same as RZPAFF by M.Marquina)
-*
-+DECK,V4_12.
-*CMZ : 4.12/00 17/04/91 08.17.57 by Rene Brun
-*-- Author : Rene Brun 17/04/91
-*
-*::> VERSION 4.12/00 910417 8.17
-*
-* Changes in FORMAT in routine HDIFF
-*
-+DECK,V4_11.
-*CMZ : 4.11/01 15/02/91 18.07.12 by Rene Brun
-*-- Author : Rene Brun 10/02/91
-*
-*::> VERSION 4.11/01 910215 18.07
-*
-* Flag NEWLIB introduced in HMACHI
-*
-*::> VERSION 4.11/00 910210 16.55
-*
-*
-* Remove the test in HFCNV on TEST (same as HFCNH)
-* Bugs corrected in HFETCH and HREAD
-* Bug corrected in HLDIR2 (IOFSET not initialized: W.Brueckner)
-* Bug corrected in HX/HPR1H for non-equidistant bins (G.Maringer)
-* SAVE statement added in HFF2 (W.Brueckner)
-* Correction in HAUTO (LW not computed)
-* Introduce HPUX version
-*
-
-+DECK,V4_10.
-*CMZ : 4.10/06 10/02/91 16.53.12 by Rene Brun
-*-- Author : Rene Brun 07/11/90
-*
-*::> VERSION 4.10/06 910210 16.53
-*
-*
-*::> VERSION 4.10/05 901107 16.37
-*
-* COMMON/HCDIRE/ modified. Number of possible directories
-* has been changed from 20 to 100.
-* This changes implies recompilation of HPLOT,PAW.
-* Note that a similar change has been made in RZEBRA.
-* Argument to user functions copied before calling
-* the function in HBFUN1/HBFUN2 to prevent cases
-* where a bad user is changing the argument.
-* Bug corrected in HFIND for HBOOKB case
-* Correction in HFITH in case of HFITGA (Sigma>0)
-* Added IQUEST(1)=1 in HCDIR if directory not found (M.Guan..)
-* Slight changes for OS9/RTF compiler (Equivalence order)
-* Bug corrected in HSPLI2 (A.Nathaniel)
-* Mods in HCOPYN calling a new routine HCOPYT (copy Ntuples)
-* Mods in HSCALE and HMAXIM. HMAXIM may be called for a 2-Dim
-* HMAXIM uses KSCAL2 word
-*
-*
-+PATCH,HISTORY.
-+DECK,BLANKDEK.
-*CMZ : 4.10/05 16/08/90 10.35.58 by Rene Brun
-*-- Author :
-*
-* VERSION 4.10 (16/08/90)
-*
-* COMMON/HCDIRE/ modified. Number of possible directories
-* has been changed from 20 to 100.
-* This changes implies recompilation of HPLOT,PAW.
-* Note that a similar change has been made in RZEBRA.
-* Argument to user functions copied before calling
-* the function in HBFUN1/HBFUN2 to prevent cases
-* where a bad user is changing the argument.
-* Bug corrected in HFIND for HBOOKB case
-* Correction in HFITH in case of HFITGA (Sigma>0)
-* Added IQUEST(1)=1 in HCDIR if directory not found (M.Guan..)
-* Slight changes for OS9/RTF compiler (Equivalence order)
-* Bug corrected in HSPLI2 (A.Nathaniel)
-* Mods in HCOPYN calling a new routine HCOPYT (copy Ntuples)
-* Mods in HSCALE and HMAXIM. HMAXIM may be called for a 2-Dim
-* HMAXIM uses KSCAL2 word
-*
-*
-* VERSION 4.09 (11/04/90)
-*
-* Mods in HDIFF (for HPAK case)
-* New routine HPAKAD
-* Changes in machine PATCHY flags
-* Routine HROPEN based on new ZEBRA routine RZOPEN
-* New routine HFNOV to fill a "cyclic Ntuple"
-* Double precision variables in HSTATI and HPRST
-* Bug corrected in HOPER1 for Number of equivalent events
-* Changes in HFN (HCDIR+RZCDIR) when RZ is used together
-* with HBOOK.
-* Changes in HCREATEG
-* New DECK H0MPW introduced for MACMPW to force a new segment
-* Bug fixed in HLDIR (M.Guanziroli)
-*
-* VERSION 4.08 (18/12/89)
-*
-* SET EPS=0.0000002 in HMINUT
-* New routine HFITHN introduced
-* + internal routines HICTOI,HFITF,HFITHC
-* + new Patchy sequence HCFITF
-* Bug corrected in HINDEX for slices
-* Changes in HFITH1 and HSUPIS to take care of histograms
-* with non-equidistant bins
-* In HCOPY set bit 5 =0
-* In HRIN look at bit 5 before deleting histogram in memory
-* In HIDOPT, option SHOW implemented
-*
-* VERSION 4.07 (29/09/89)
-*
-* Mods in HHIPAR. Do not force IWEIGH=1 if HPAKE.
-* Mods in HMINUI. (if PARAM=0.)
-* Mods in HFCN
-* Protection in HMDIR against CHDIR with more than 16 characters
-* Sequences HCFIT4,HCFIT5 deleted.
-* Bug corrected in HRNDM2
-* MAXLEN changed to 110 in HPAFF
-* HGN returns IERROR=-1 if event nr > number of events
-* Mods in HCREATEG (Jim Loken)
-* Protection in HDIPKL
-* Minor change in HMINUI
-* Minor change in HEXAM5
-* Maximum number of variables in a Ntuple changed to 512
-* Change in HFITGA. Parameter COEFF in phase with documentation
-* HDIFF writes on LOUT instead of 6.
-* Text of message changed in HUNPAK/HUNPKE
-* Bug corrected in HFINOP for BANY
-* SAVE statement added in HRNDM1/HRNDM2
-* Array FITDER added in sequence /HCFITS/.
-* Variable EPSIH renamed EPSIF in /HCFIT6/.
-* Format changed in HPTIT (I4 instead of I3)
-* DEFT changed to SETD in HIDOPT.
-* Epsil shift (1.e-6) in booking routines removed.
-* Change in HDELET (clear link for HCOPYM)
-* Change in HSIFLA (status word bit 5 set for PAW)
-* Changes in all routines modifying histogram structure
-* (call sbit0(iq(lcid),5) for PAW
-* Set IQUEST(1)=0 in HSPACE (problems with the ZEBRA server)
-* Correct HCOPYN for profile histograms with option S
-* New version of HCREATEG from J.Loken
-* Changes in HINDEX for printing limits of slices and bands*
-* New fitting routines HFITH and HFITV introduced
-* Routines HFITPO,HFITEX,HFITGA interfaced to HFITH
-* Added calls to interactive Minuit if option 'M'
-* Examples modified
-* Fit parameters now stored with histogram data structure.
-* Variable IOFIT in /HCFORM/
-*
-* VERSION 4.06 (30/06/89)
-*
-* INOT replaced by INNOT in printing routines
-* Current Directory set to //PAWC at the end of HREND
-* Bug corrected in HNORMA (C.ERD)
-* Bug corrected in HSTATI
-* HRDIR implemented for subdirs of a global section
-* Change to standard intrinsic functions of Fortran 77
-* CONVEX version introduced
-* Version of HROPEN for IBMMVS introduced.
-* New routine HDERIV (user callable)
-* HDERIV is a replacement for the dummy routines
-* HDERI1,HDERI2,HDERIN
-* HEXAM modified
-* Report bug in HBOOKN for ID>9999
-* Bug corrected in HRZIN for Ntuples (CZ mode)
-*
-* New interface to MINUIT introduced (with E.Lessner FNAL)
-* Changes in fitting routines for IWEIGH.NE.0
-*
-* Changes in HBARX/HBARY
-* When HBARX/Y is called, the routine fills the sum of
-* the square of the weights from the actual contents
-* This is introduced to make easier the computation
-* of error bars by HOPERA.
-*
-* VERSION 4.05 (29/03/89)
-*
-* Sequence JBIT replaced for Apollo
-* Unused sequences removed
-* Bugs corrected in HPROJ1(2) ISEL not used
-* Routines HRZIN/HRZOUT changed (New CZ and ZS)
-* New routine HRDIR
-* Bug corrected in HPR1H
-* Remove limitation for CHRZPA<3 in HBOOKN
-* Protection added in HFILPF (overflows)
-* DOUBLE PRECISION kept on CRAY in HF1,HPRST and HSTATI
-* Bug corrected in HPR1V for INTE and many parts
-* Bug corrected in HARRAY
-* Bug corrected in HF1AUT
-* Bug corrected in HMONIT
-* sequence HCDIRE modified. New array HFNAME containing
-* the file name
-* Mods in HBOOKN. 80 characters always allocated to CHRZPA.
-* Mods in HRIN to change CHRZPA to current directory.
-* Bug corrected in HBCDI (RETURN missing)
-* Patchy flag SAVE removed (default)
-*
-* Mods in HBOOKN (Limit to 120)
-* Protection in HTERM
-* Mods in HCOPYN (add profiles)
-* Mods in HRZIN
-* Mods in HRGET and HRPUT when CHFILE=' '
-* Add option 'A' in HRGET (JOFSET=99999 in HRIN)
-* Bug corrected in HLDIR2
-* Bug corrected in HEXAM5 (array EY not defined)
-* Unused variables removed (FTN on DN10000)
-* Calls to UCTOH1 replaced by UCTOH
-* Bug corrected in HSPFUN (Annette Frenkel)
-* HSPLI1 always return CHISQ
-* New options 'F1 and F2' in HDIFF
-* Routine HISTDO now calls HPDIR('//PAWC','TI')
-* Option 'I' added in HPDIR
-* Routines HRZFIL and HRZEND removed
-* Changes in HRFILE,HRZCD for communication mode
-* Change IQUEST(1)=0 in HCDIR
-* Bug corrected in HSTATI (LCONT set to IFW removed)
-* IDLAST always set to 0 in HLOOP
-* Bug corrected in HPHIST/HPROT for slices in X
-* Routines for Vax Global sections rewritten by J.Loken
-*
-* VERSION 4.04 (10/11/88)
-*
-* Changes in all booking routines (31-->16)
-* Mods in HROUT
-* Mods in HFF1,HIPAK1,HF1,HF2
-* Patchy flag SAVE introduced
-* New routines HGNPAR and HGNF
-* Routines HPROJ1 and HPROJ2 modified
-*
-* VERSION 4.03 (05/09/88)
-*
-* Routine HCX modified to solve a CRAY compiler problem
-* Routines HFETCH,HFETC1 corrected for same problem as HCX
-* Routine HF1 corrected for non-equidistant bins histograms
-* Argument IDD added in HSPACE
-* Argument KCASE in HUNPAK declared type CHARACTER
-* Argument KNAME in HPHIST and HPROT declared type CHARACTER
-* NOARG removed from HPHIST and HPROT
-* Bug corrected in HPHIST affecting HPR1V
-* Routines HPROJ1,HPROJ2 modified to handle MASK logic in PAW
-* and HGN
-* Routine HFILPF changed to take W into account
-* COMMON/PAWIDN/IDNEVT,X(127) added.
-* UNIX version introduced.
-* Changes in HMACHI,HPCHAN,HPATH.
-* Bugs corrected in HFILPR and HPR1V.
-* Bank LHBOOK changed to 50 links (10 struct.)
-* Automatic binning algorithm modified (HF1AUT)
-* Routine HROUT accepts option 'T'
-* New routines HROPEN,HRGET and HRPUT
-* Routine HRIN modified to simulate option 'T'
-* If ICYCLE>1000 and ID=0 implies option 'T'
-* Routines HBOOK1 and HF1 changed. Accumulate the 100 first
-* entries instead of just 50.
-* Mods in all routines using NBIT
-* Check for space left in HLDIR
-* Changes in HMAPG (J.Loken)
-*
-* VERSION 4.02 (28/04/88)
-*
-* Bugs corrected in routine HFF1,HFF2,HIPAK1,HIPAK2 (Kevin Einsweiler)
-* Bugs corrected in HIDOPT (Helmut Burkhardt)
-* Bugs corrected in HPROJ1,HPROJ2 (V.Journe)
-* Option I implemented in HLDIR (HINDEX format)
-* New routine HUNPKE to unpack errors (same calling as HUNPAK)
-* Bug corrected in HSTATI(C.Onions)
-* Bug corrected in HOPER1 (calculation of errors)(V.Gibson,A.Parker)
-* Bugs corrected in HSPFUN,HSPLI1,HSPLI2
-* Bug corrected in HFETCH (D.Schlatter)
-* ALLIANT version introduced
-* New facility to access remote files across a network
-* An implementation with TCP/IP is available
-* (Works together with the new option FZCHANNEL of ZEBRA)
-* Correction in HFETCH (problem on NORD) (A.Read)
-* Changes in HRFILE for global sections (IQUEST)
-* LOUT changed to 6 for Apollo and Alliant
-* Y scale factor better computed when HMAXIM is called (V.Palladino)
-* Operations between profile histograms implemented (suggested by H.Chan
-* Modification of algorithm to print integrated contents (P.O.Hulth)
-* Routine HGN optimized
-* New routine HGIVEN (same as HGIVE for N-tuples) (R.Namjoshi)
-* Routine HSCR implemented as described in the documentation
-* Mods in HBANDX and HBANDY (reverse booking order)
-* Set a limitation for NVAR<129 in HBOOKN
-* Changes in HFN and HCDIR for N-tuples in memory
-* Protection in booking routines in case HDELET is called
-* IDLAST reset in all printing routines
-* Bugs corrected in HLDIR and HPDIR
-*
-* VERSION 4.01 (18/02/88)
-*
-* Bugs corrected in routine HGN (Rohit + Iversen)
-* Bug corrected in HFINOP (affected HSTATI and HUNPAK)
-* Bugs corrected in HPROJ1,HPROJ2
-* Protection in HROUT
-*
-* VERSION 4.00 (08/02/88)
-*
-* New version based on ZEBRA. (version 3.54 needed)
-* Storage area is the COMMON/PAWC/H(ispace)
-* The user has to dimension this common block and
-* initialize the HBOOK package by CALL HLIMIT(ispace)
-*
-* Only character strings or variables are accepted for titles
-*
-* With the new version one must always specified
-* the correct number of arguments in subroutine calls. The
-* facility to miss some arguments will be withdrawn from HBOOK
-* in a few monthes.
-* HFILL must have 4 arguments
-* HSTORE and HFETCH are dummy. Use HRFILE,HRIN,HROUT,HREND instead
-*
-* A set of new routines is available for
-* - Structuring IDs in memory.
-* - Statistical comparison of histograms (HDIFF)
-* - Give options
-* - Sequential I/O
-* - Random access I/O (PATCH,HRZ)
-* - N-tuples
-* - New routine HFILPR to fill existing projections
-* - New routine HGSTAT to get statistics
-* - New routines HBPROF and HFILPF to book and fill
-* profile histograms
-* - New functionality for HLIMIT
-* without initialization of ZEBRA
-* - New routine HBUG to print error messages
-* - Using shared areas (Online) HCOPYM
-* - New routine HBOOKB (histos with non-equidistant bins)
-* - New routine HREP1 to replace contents of one channel
-* - New routine HGN to return one event from a N-tuple
-* - New routine HPSTAT to print statistics about ID
-* - PATCH,HGLOBAL for shared global sections on VAX
-* (See new documentation)
-*
-+PATCH,*HBOOK
-+DECK,BLANKDEK.
-*CMZ : 05/05/95 14.56.58 by Unknown
-*-- Author :
-+USE,HBOOK,HDIFF,HNTUP,HQUAD,HMCSTAT,HRZ,HMERGE,HCDES.
-+USE,HGLOBAL,IF=VAX.
-+USE, ALPHA_OSF, IF=QMVAOS.
-+USE, IBM, IF=IBMMVS,NEWLIB.
-+USE, UNIX, IF=IBMRT, SGI, SUN, APOLLO, HPUX, AIX370, LINUX,NEXT.
-+USE, UNIX, IF=ALLIANT, MACMPW, CONVEX, DECS, IPSC,MSDOS,WINNT.
-+USE, QF2C, IF=MSDOS.
-+USE, DOUBLE, IF=IBM, VAX, NORD, UNIVAC.
-+USE, DOUBLE, IF=UNIX, IF=-SINGLE.
-+USE, BSLASH, IF=SGI, IBMRT, SUN,DECS,IPSC,APOF77,GNU,LINUX,QMALPH.
-+USE, BSLASH, IF=WINNT, QF2C.
-+USE, CZ, IF=APOLLO,VAX,UNIX,IBM,IF=-IPSC,IF=-MSDOS,IF=-WINNT.
-+USE, QX_SC, IF=SUN, SGI, DECS, CONVEX, IBMRT, HPUX, AIX370,IPSC.
-+USE, QX_SC, IF=NEXT,MSDOS,LINUX,WINNT.
-+USE, QX_SC, IF=APOLLO, IF=APOF77.
-+USE, QXNO_SC, IF=APOLLO, IF=-APOF77.
-+USE, BSD, IF=APOLLO,SUN,CONVEX.
-+USE, SYS5, IF=IBMRT,DECS,HPUX,SGI,AIX370,IPSC,LINUX.
-+USE, HMMAP, IF=APOLLO,UNIX,IF=-CRAY,IF=-IPSC,IF=-MSDOS.
-+USE, CHBOOK,FPCLASSC.
-+USE, NO_IEEE, IF=IBM,VAX,AIX370,NORD,UNIVAC.
-+PATCH,*HMERGE.
-+DECK,BLANKDEK.
-*CMZ : 4.22/04 07/06/94 09.11.09 by Rene Brun
-*-- Author : Fons Rademakers 06/06/94
-+USE,MAIN,HMERGE,HCDES.
-+PATCH,*HEXAM
-+DECK,BLANKDEK.
-*CMZ : 4.20/13 21/10/93 15.01.08 by Rene Brun
-*-- Author :
-+USE,HEXAM,HCDES,EXAMPLES.
-+USE, UNIX, IF=IBMRT, SGI, SUN, APOLLO,HPUX,AIX370,LINUX.
-+USE, UNIX, IF=ALLIANT, MACMPW, CONVEX, DECS, MSDOS, WINNT.
-+USE, DOUBLE, IF=IBM, VAX, NORD, UNIVAC.
-+USE, DOUBLE, IF=UNIX, IF=-SINGLE.
-+USE, BSLASH, IF=SGI, IBMRT, SUN, F2C, LINUX, WINNT.
-
-+PATCH,HCDES
-+KEEP,hchoptm.
-*CMZ : 4.22/11 24/08/94 17.54.34 by Rene Brun
-*-- Author : Rene Brun 24/08/94
- CHARACTER*16 CHOPTM
- COMMON/HCHOPTM/CHOPTM
-*
-+KEEP,HCFAST.
-*CMZ : 4.21/08 14/02/94 17.19.04 by Rene Brun
-*-- Author : Rene Brun 14/02/94
- PARAMETER (NIDMAX=1000)
- COMMON/HCFAST/NID(NIDMAX)
-
-+KEEP,HCBONT.
-*CMZ : 4.21/10 01/03/94 11.54.50 by Rene Brun
-*-- Author : Rene Brun 10/01/94
-*
-*-- ATTENTION: when changing anything in these common blocks check
-*-- also $HCNTPAW.
-*
- PARAMETER (MAXNP = 1000, MAXNC = 8000)
- PARAMETER (MAXDUM=50007-4*MAXNP-3)
- REAL XONT(MAXNP), YONT(MAXNP), ZONT(MAXNP), WONT(MAXNP)
- REAL DUMCR4(MAXDUM)
- INTEGER KONTYP, NONT,NCHONT
- CHARACTER*4 CHONT(MAXNC)
-*
- COMMON /PAWCR4/KONTYP,NONT,XONT,YONT,ZONT,WONT,NCHONT,DUMCR4
- COMMON /PAWC32/ CHONT
-*
-+KEEP,HCOPT.
-*CMZ : 4.21/05 29/11/93 14.10.46 by Fons Rademakers
-*-- Author : Rene Brun 27/11/93
- COMMON/HCOPT/ICOPT(10)
-*
- EQUIVALENCE (ISTAF, ICOPT(1))
-*
-+KEEP,HCACHE.
-*CMZ : 4.21/01 01/11/93 18.20.48 by Fons Rademakers
-*-- Author : Fons Rademakers 01/11/93
- PARAMETER (IDMXNT = 100)
- COMMON /HCACHE/ IDNOT(IDMXNT), IDTNOT
-+KEEP,HCMCPM1.
-*CMZ : 4.20/10 30/09/93 08.15.34 by Rene Brun
-*-- Author :
- REAL BJ(NSRCMX)
-+KEEP,HCMCPM2.
-*CMZ : 4.20/10 30/09/93 08.15.34 by Rene Brun
-*-- Author :
- DOUBLE PRECISION BJ(NSRCMX)
-+KEEP,HCMCPM.
-*CMZ : 4.20/13 19/10/93 15.38.13 by Roger Barlow, Christine Beeston
-*-- Author : Christine Beeston 24/09/93
-
-C some maximum values - max number of bins and dimensions
- INTEGER NSRCMX,NSRCMN,NOPTS
- PARAMETER(NSRCMX=20,NSRCMN=2,NOPTS=7)
-
-C Numbers of monte carlo and data events, links to data, MC and weight
-C histograms, Number of mc sources, options, total number of bins.
-C normalisation constants for weight histograms
-
-+SEQ,HCMCPM1,IF=-DOUBLE.
-+SEQ,HCMCPM2,IF=DOUBLE.
- INTEGER NDATEV,NMCEV(NSRCMX),
- + NMCSRC,IOPT(NOPTS),NTOT
- COMMON/HINPUTS/NDATEV,NMCEV,NMCSRC,IOPT,NTOT,BJ
-C Histogram IDs
- INTEGER IDD,IDM(NSRCMX),IDW(NSRCMX)
- COMMON/HMCIDS/IDD,IDM,IDW
-
-+KEEP,HCRECV.
-*CMZ : 4.20/05 19/08/93 11.48.32 by Rene Brun
-*-- Author : Fons Rademakers 25/05/93
- LOGICAL NRECOV
- COMMON /HCRECV/ NRECOV
-*
-+KEEP,HCMINPU.
-*CMZ : 4.20/03 28/07/93 09.34.19 by Rene Brun
-*-- Author : Rene Brun 18/06/93
- INTEGER NCMINP,IADINP
- COMMON/HCMINP1/NCMINP,IADINP
- PARAMETER (MCHINP=50)
- CHARACTER*80 CHINPU(MCHINP)
- COMMON/HCMINPU/CHINPU
-*
-+KEEP,CZCBUF.
-*CMZ : 4.19/05 08/06/93 10.43.23 by Rene Brun
-*-- Author : Rene Brun 08/06/93
- COMMON/CZCBUF/IZCBUF
-*
-+KEEP,HCSAVE.
-*CMZ : 4.19/02 14/05/93 12.46.14 by Fons Rademakers
-*-- Author : Fons Rademakers 14/05/93
- LOGICAL NTSAVE
- COMMON /HCSAVE/ NTSAVE
-*
-+KEEP,CZSOCK.
-*CMZ : 4.22/04 02/06/94 08.46.59 by Rene Brun
-*-- Author : Fons Rademakers 06/05/93
- INTEGER LUNCZ,IADTCP,LBUFCZ,ISKIN,ISKOUT,IPROT
- COMMON/CZSOCK/LUNCZ,IADTCP,LBUFCZ,ISKIN,ISKOUT,IPROT
-+KEEP,CZBUFF.
-*CMZ : 4.20/03 28/07/93 10.57.50 by Rene Brun
-*-- Author : Fons Rademakers 06/05/93
- CHARACTER*512 CHBUF
- COMMON/CZBUFC/CHBUF
-*
-+KEEP,HCRLF1.
-*CMZ : 4.19/00 19/04/93 10.16.13 by Rene Brun
-*-- Author : Rene Brun 19/04/93
- PARAMETER (CRLF='1')
-+KEEP,HCRLF2.
-*CMZ : 4.19/00 19/04/93 10.16.13 by Rene Brun
-*-- Author : Rene Brun 19/04/93
- PARAMETER (CRLF=CHAR(12))
-+KEEP,HCRLF.
-*CMZ : 4.20/13 21/10/93 15.01.47 by Rene Brun
-*-- Author : Rene Brun 19/04/93
- CHARACTER*1 CRLF
-+SEQ,HCRLF1,IF=-MSDOS,IF=-WINNT.
-+SEQ,HCRLF2,IF=MSDOS,WINNT.
-+KEEP,HCPIAF.
-*CMZ : 4.21/08 01/02/94 11.41.10 by Fons Rademakers
-*-- Author : Fons Rademakers 15/04/93
-*--- shared between HBOOK and PAW
- PARAMETER (MXSLPF = 32)
- COMMON/HCPIAF/NTPIAF
- + ,CONNPF,SERVPF,MASTPF,SLAVPF,CLINPF,CLUTPF,LOGLPF
- + ,NSLAVE,NSLBAD,NSLVPF,SLINPF(MXSLPF),SLUTPF(MXSLPF)
- + ,NGSIZE, MYSID, SMASK, SRIN, SROUT, SVMIO, STUSER
- + ,STCPU, MASPID
- COMMON/HCPIA1/SLHOPF(MXSLPF), SLHBAD(MXSLPF), PIAFRC
-*--- flag set by HGETNT if the current Ntuple is on Piaf server
- LOGICAL NTPIAF
-*--- flag if Piaf server is connected
- LOGICAL CONNPF
-*--- flag if this is a server (master or slave)
- LOGICAL SERVPF
-*--- flag if this is the master server
- LOGICAL MASTPF
-*--- flag if this is a slave server
- LOGICAL SLAVPF
-*--- sockets between client and master server
- INTEGER CLINPF, CLUTPF
-*--- log level of diagnostic output
- INTEGER LOGLPF
-*--- number of active slaves and mask used by the select (PSELCT) function
- INTEGER NSLAVE, SMASK
-*--- number of running slave servers and sockets between master and slaves
- INTEGER NSLVPF, SLINPF, SLUTPF
-*--- hosts on which slaves are running
- CHARACTER*16 SLHOPF
-*--- number hosts on which no slaves can be run
- INTEGER NSLBAD
-*--- hosts on which no slaves can be run
- CHARACTER*16 SLHBAD
-*--- current slave group view: group size and unique slave id
- INTEGER NGSIZE, MYSID
-*--- pid of the master server (used by slave servers)
- INTEGER MASPID
-*--- authentication record
- CHARACTER*64 PIAFRC
-*--- IO and CPU usage of all slaves
- REAL SRIN, SROUT, SVMIO, STUSER, STCPU
-*--- Work space
- COMMON/HCPIAC/CHSMPF, CHLMPF
- CHARACTER CHSMPF*80, CHLMPF*256
-*
-+KEEP,HCK
-*CMZ : 4.19/00 26/04/93 12.34.29 by Rene Brun
-*-- Author :
- INTEGER KNCX ,KXMIN ,KXMAX ,KMIN1 ,KMAX1 ,KNORM , KTIT1,
- + KNCY ,KYMIN ,KYMAX ,KMIN2 ,KMAX2 ,KSCAL2 , KTIT2,
- + KNBIT ,KNOENT ,KSTAT1 ,KNSDIR ,KNRH ,
- + KCON1 ,KCON2 ,KBITS ,KNTOT
- PARAMETER(KNCX=3,KXMIN=4,KXMAX=5,KMIN1=7,KMAX1=8,KNORM=9,KTIT1=10,
- + KNCY=7,KYMIN=8,KYMAX=9,KMIN2=6,KMAX2=10,KSCAL2=11,
- + KTIT2=12,KNBIT=1,KNOENT=2,KSTAT1=3,KNSDIR=5,KNRH=6,
- + KCON1=9,KCON2=3,KBITS=1,KNTOT=2)
-*
-+KEEP,HCBOOK.
-*CMZ : 4.19/01 30/04/93 17.22.15 by Rene Brun
-*-- Author :
- INTEGER NWPAW,IXPAWC,IHDIV,IXHIGZ,IXKU, LMAIN
- REAL FENC , HCV
- COMMON/PAWC/NWPAW,IXPAWC,IHDIV,IXHIGZ,IXKU,FENC(5),LMAIN,HCV(9989)
- INTEGER IQ ,LQ
- REAL Q
- DIMENSION IQ(2),Q(2),LQ(8000)
- EQUIVALENCE (LQ(1),LMAIN),(IQ(1),LQ(9)),(Q(1),IQ(1))
- INTEGER HVERSN,IHWORK,LHBOOK,LHPLOT,LGTIT,LHWORK,
- +LCDIR,LSDIR,LIDS,LTAB,LCID,LCONT,LSCAT,LPROX,LPROY,LSLIX,
- +LSLIY,LBANX,LBANY,LPRX,LPRY,LFIX,LLID,LR1,LR2,LNAME,LCHAR,LINT,
- +LREAL,LBLOK,LLBLK,LBUFM,LBUF,LTMPM,LTMP,LTMP1,LHPLIP,LHDUM,
- +LHFIT,LFUNC,LHFCO,LHFNA,LCIDN
- COMMON/HCBOOK/HVERSN,IHWORK,LHBOOK,LHPLOT,LGTIT,LHWORK,
- +LCDIR,LSDIR,LIDS,LTAB,LCID,LCONT,LSCAT,LPROX,LPROY,LSLIX,
- +LSLIY,LBANX,LBANY,LPRX,LPRY,LFIX,LLID,LR1,LR2,LNAME,LCHAR,LINT,
- +LREAL,LBLOK,LLBLK,LBUFM,LBUF,LTMPM,LTMP,LTMP1,LHPLIP,LHDUM(9),
- +LHFIT,LFUNC,LHFCO,LHFNA,LCIDN
-*
-+SEQ,HCK
-+KEEP,HCFORM
-*CMZ : 4.19/00 13/04/93 16.36.40 by Rene Brun
-*-- Author :
- COMMON/HCFORM/IODIR,IOH1,IOH2,IOHN,IOCF1,IOCF2,IOCB1,IOCB2,
- + IOCF4,IOFIT,IONT,IOBL,IJUNK
-*
-+KEEP,HCFLAG
-*CMZ : 4.19/00 13/04/93 16.36.40 by Rene Brun
-*-- Author :
- INTEGER ID ,IDBADD,LID ,IDLAST,IDHOLD,NBIT ,NBITCH,
- + NCHAR ,NRHIST,IERR ,NV
- COMMON/HCFLAG/ID ,IDBADD,LID ,IDLAST,IDHOLD,NBIT ,NBITCH,
- + NCHAR ,NRHIST,IERR ,NV
-*
-+KEEP,HCDIRE.
-*CMZ : 4.20/03 28/07/93 09.33.32 by Rene Brun
-*-- Author :
- PARAMETER (NLPATM=100, MXFILES=50)
- COMMON /HCDIRN/NLCDIR,NLNDIR,NLPAT,ICDIR,NCHTOP,ICHTOP(MXFILES)
- + ,ICHTYP(MXFILES),ICHLUN(MXFILES)
- CHARACTER*16 CHNDIR, CHCDIR, CHPAT ,CHTOP
- COMMON /HCDIRC/CHCDIR(NLPATM),CHNDIR(NLPATM),CHPAT(NLPATM)
- + ,CHTOP(NLPATM)
- CHARACTER*80 HFNAME
- COMMON /HCFILE/HFNAME(MXFILES)
-*
-+KEEP,HCVERS
-*CMZ : 4.22/04 02/06/94 08.50.52 by Rene Brun
-*-- Author :
- INTEGER INSTAL(20),IVERS(5),IDATE(8)
- COMMON/HCVERS/INSTAL,IVERS,IDATE
-*
-+KEEP,HCUNIT
-*CMZ : 4.20/00 17/06/93 13.11.59 by Rene Brun
-*-- Author :
- INTEGER LOUT,LERR,LINFIT
- COMMON/HCUNIT/LOUT,LERR,LINFIT
-*
-+KEEP,HCBITS
-*CMZ : 4.19/00 13/04/93 16.36.40 by Rene Brun
-*-- Author :
- INTEGER I1, I2, I3, I4, I5, I6, I7, I8,
- + I9, I10, I11, I12, I13, I14, I15, I16,
- +I17, I18, I19, I20, I21, I22, I23, I24, I25, I26, I27,
- +I28, I29, I30, I31, I32, I33, I34, I35, I123, I230
- COMMON / HCBITS / I1, I2, I3, I4, I5, I6, I7, I8,
- + I9, I10, I11, I12, I13, I14, I15, I16,
- +I17, I18, I19, I20, I21, I22, I23, I24, I25, I26, I27,
- +I28, I29, I30, I31, I32, I33, I34, I35, I123, I230
-*
-+KEEP,HCPRIN
-*CMZ : 4.22/04 02/06/94 14.29.18 by Rene Brun
-*-- Author :
- INTEGER IFW ,NW ,NB ,IH ,NHT ,ICN ,IPONCE,
- + NH ,MSTEP ,NOENT ,NOLD ,IDOLAR,IBLANC,KBINSZ,INO ,
- + KSQUEZ,NCOLMA,NCOLPA,NLINPA, ICBLAC,ICSTAR,ICFUNC,
- + IDG(42),MAXBIT(30),IDENT(9)
- REAL BIGP
-*
- COMMON/HCPRIN/IFW ,NW ,NB ,IH ,NHT ,ICN ,IPONCE,
- + NH ,MSTEP ,NOENT ,NOLD ,IDOLAR,IBLANC,KBINSZ,INO ,
- + KSQUEZ,NCOLMA,NCOLPA,NLINPA,BIGP ,ICBLAC,ICSTAR,ICFUNC,
- + IDG ,MAXBIT,IDENT
-*
-+KEEP,HCFITF
-*CMZ : 4.19/00 13/04/93 16.36.40 by Rene Brun
-*-- Author :
- PARAMETER(MAXOP=10)
- COMMON/HCFITF/NOPER,LOPER(MAXOP),IFTYPE(MAXOP),NPF(MAXOP)
-*
-+KEEP,HCFITR
-*CMZ : 4.22/04 02/06/94 08.47.30 by Rene Brun
-*-- Author :
- INTEGER IFTRNG,IFXLOW,IFXUP,IFYLOW,IFYUP
- COMMON/HCFITR/IFTRNG,IFXLOW,IFXUP,IFYLOW,IFYUP
-C
-+KEEP,HCFIT1
-*CMZ : 4.19/00 13/04/93 16.36.40 by Rene Brun
-*-- Author :
- COMMON /HCFIT1/ NUMEP1,N3,EPS
-*
-+KEEP,HCTIT
-*CMZ : 4.19/00 13/04/93 16.36.40 by Rene Brun
-*-- Author :
- COMMON/HCTIT/LTIT(40)
-*
-+KEEP,HCPAR0
-*CMZ : 4.19/00 13/04/93 16.36.40 by Rene Brun
-*-- Author :
- REAL PNEF,PNBF,PSEL,PFLV,PLUN,PNBX,PNCX,FNIX,FEPS
- COMMON /HCPAR0/ PNEF,PNBF,PSEL,PFLV,PLUN,PNBX,PNCX,FNIX,FEPS
-*
-+KEEP,HCPAR1
-*CMZ : 4.19/00 13/04/93 16.36.40 by Rene Brun
-*-- Author :
- COMMON /HCPAR1/ IOPT(8),ND,NP,NPMAX,NBF,NBFMAX,NEF,NCO,NCOMAX
-*
-+KEEP,HCPAR2
-*CMZ : 4.19/00 13/04/93 16.36.40 by Rene Brun
-*-- Author :
- COMMON /HCPAR2/ COEFF(50),IBASFT(10,50),XMIN(10),XMAX(10),
- + ALIM(10),BLIM(10)
-*
-+KEEP,HCPOUT
-*CMZ : 4.19/00 13/04/93 16.36.40 by Rene Brun
-*-- Author :
- COMMON /HCPOUT/ IFLAG,RSSS,R2S,SECO(50),COMIN(50),COMAX(50)
-*
-+KEEP,HCFIT2
-*CMZ : 4.19/00 13/04/93 16.36.40 by Rene Brun
-*-- Author :
- COMMON/HCFIT2/ENDFLG,NA,INDFLG(5),IFLFUN,NAMFUN,IDIMPN,XFUMIL(10),
- + NUMEP ,XMIN ,EPSW ,ALLCHA,BINWID,WGTMAX,YMIN,BINWIY,
- + NCHANX,LINEAR,IFLSF ,IFLBUF,IDER,IWEIGH,ITFUM,ISUPIM
-*
-+KEEP,HCFIT3
-*CMZ : 4.19/00 13/04/93 16.36.40 by Rene Brun
-*-- Author :
- COMMON /HCFIT3/ NPOLYN,IPARAM,IDERIV,IDEROK
-*
-+KEEP,HCFIT6
-*CMZ : 4.19/00 13/04/93 16.36.40 by Rene Brun
-*-- Author :
- COMMON /HCFIT6/XVAR(10),EPSIF,NUP,NFCNMH,ITPR,IHIS,IMINU,
- + NX,NY,NPFIT,ILICO,CHIM,IOFSET,IMAT,IBQ(14),ILXE,ILYE,
- + ILEY,ICSTAT,NFLRET,IDESUM
-*
-+KEEP,HCFITS
-*CMZ : 4.19/00 13/04/93 16.36.40 by Rene Brun
-*-- Author :
- INTEGER NCFITS,NPFITS,NFPAR
- REAL FITCHI,FITPAR ,FITSIG
- + ,FITDER
- COMMON/HCFITS/NCFITS,NPFITS,NFPAR,FITCHI,FITPAR(35),FITSIG(35)
- + ,FITDER(35)
- CHARACTER*8 FITNAM
- COMMON/HCFITN/FITNAM(35)
-*
-+KEEP,HCFITD1.
-*CMZ : 4.19/00 28/04/93 11.16.52 by Rene Brun
-*-- Author :
- DOUBLE PRECISION FITPAD,FITFUN
-+KEEP,HCFITD.
-*CMZ : 4.19/00 28/04/93 11.16.52 by Rene Brun
-*-- Author :
-+SEQ,HCFITD1,IF=DOUBLE.
- COMMON/HCFITD/FITPAD(24),FITFUN
-*
-+KEEP,HCMAIL.
-*CMZ : 4.19/00 13/04/93 16.36.40 by Rene Brun
-*-- Author :
- CHARACTER*128 CHMAIL
- COMMON /HCMAIL/CHMAIL
-*
-+KEEP,HCNT
-*CMZ : 4.19/00 13/04/93 16.36.40 by Rene Brun
-*-- Author :
- COMMON /HCNT/ IBIPW, IBIPB, IBYPW, ISHBIT
-*
-+KEEP,HCNTPAR.
-*CMZ : 4.20/00 21/06/93 12.39.17 by Fons Rademakers
-*-- Author :
- INTEGER ZBITS, ZNDIM, ZNOENT, ZNPRIM, ZNRZB, ZIFCON,
- + ZIFNAM, ZIFCHA, ZIFINT, ZIFREA, ZNWTIT, ZITIT1,
- + ZNCHRZ, ZDESC, ZLNAME, ZNAME, ZARIND, ZRANGE, ZNADDR,
- + ZIBLOK, ZNBLOK, ZLCONT, ZIFBIT, ZIBANK, ZIFTMP, ZITMP,
- + ZID, ZNTMP, ZNTMP1, ZLINK
- PARAMETER(ZBITS=1, ZNDIM=2, ZNOENT=3, ZNPRIM=4, ZLCONT=6,
- + ZNRZB=5, ZIFCON=7, ZIFNAM=4, ZIFCHA=5, ZIFINT=6,
- + ZIFREA=7, ZNWTIT=8, ZITIT1=9, ZNCHRZ=13, ZIFBIT=8,
- + ZDESC=1, ZLNAME=2, ZNAME=3, ZRANGE=4, ZNADDR=12,
- + ZARIND=11, ZIBLOK=8, ZNBLOK=10, ZIBANK=9, ZIFTMP=11,
- + ZID=12, ZITMP=10, ZNTMP=6, ZNTMP1=3, ZLINK=6)
-*
-+KEEP,HCNTPAW.
-*CMZ : 4.21/10 01/03/94 11.54.50 by Rene Brun
-*-- Author : Fons Rademakers 10/04/93
-*
-*-- ATTENTION: MAXCR4 must be 50007 in order for variables in $HCBONT to
-*-- fit into PAWCR4. When changing any of these parameters
-*-- check also $HCBONT.
-*
- PARAMETER (MAXCR8 = 1000, MAXCR4 = 50007, MAXC32 = 1000)
- REAL*8 RVAR8(MAXCR8)
- REAL RVAR4(MAXCR4)
- INTEGER IVAR4(MAXCR4)
- LOGICAL LVAR4(MAXCR4)
- CHARACTER*32 CVAR32(MAXC32)
-*
- COMMON /PAWCR8/ RVAR8
- COMMON /PAWCR4/ RVAR4
- COMMON /PAWC32/ CVAR32
-*
- EQUIVALENCE (IVAR4, RVAR4)
- EQUIVALENCE (LVAR4, RVAR4)
-*
-+KEEP,HNTCUR.
-*CMZ : 4.19/00 13/04/93 16.36.40 by Rene Brun
-*-- Author :
- COMMON /HNTCUR/ NTCUR
-*
-+KEEP,HCSET.
-*CMZ : 4.19/00 13/04/93 16.36.40 by Rene Brun
-*-- Author :
- COMMON /HCSET/ IBSIZE
-*
-+KEEP,HMAC1.
-*CMZ : 4.19/00 13/04/93 16.36.40 by Rene Brun
-*-- Author :
- PARAMETER (MBIT=60,MBITCH=6,MOUT=L"OUTPUT",HMBIGP=1.E+200)
-+KEEP,HMAC2.
-*CMZ : 4.19/00 13/04/93 16.36.40 by Rene Brun
-*-- Author :
- PARAMETER (MBIT=32,MBITCH=8,MOUT=6,HMBIGP=1.E+60)
-+KEEP,HMAC3.
-*CMZ : 4.19/00 13/04/93 16.36.40 by Rene Brun
-*-- Author :
- PARAMETER (MBIT=36,MBITCH=9,MOUT=2,HMBIGP=1.E+38)
-+KEEP,HMAC4.
-*CMZ : 4.19/00 13/04/93 16.36.40 by Rene Brun
-*-- Author :
- PARAMETER (MBIT=32,MBITCH=8,MOUT=6,HMBIGP=1.E+36)
-+KEEP,HMAC5.
-*CMZ : 4.19/00 13/04/93 16.36.40 by Rene Brun
-*-- Author :
- PARAMETER (MBIT=64,MBITCH=8,MOUT=6,HMBIGP=1.E+200)
-+KEEP,HMAC6.
-*CMZ : 4.19/00 13/04/93 16.36.40 by Rene Brun
-*-- Author :
- PARAMETER (MBIT=32,MBITCH=8,MOUT=6,HMBIGP=1.E+30)
-+KEEP,HMACHINE.
-*CMZ : 4.19/00 19/04/93 09.58.06 by Rene Brun
-*-- Author :
-+SEQ,HMAC1,IF=CDC.
-+SEQ,HMAC2,IF=IBM,NORD.
-+SEQ,HMAC3,IF=UNIVAC.
-+SEQ,HMAC4,IF=VAX.
-+SEQ,HMAC5,IF=CRAY, CONVEX, UNIX, IF=-DOUBLE.
-+SEQ,HMAC6,IF=UNIX,IF=DOUBLE.
-
-+KEEP,JBYT1.
-*CMZ : 4.19/00 13/04/93 16.36.40 by Rene Brun
-*-- Author :
- JBYT (IZW,IZP,NZB) = JIBITS (IZW,IZP-1,NZB)
-+KEEP,JBYT2.
-*CMZ : 4.19/00 13/04/93 16.36.40 by Rene Brun
-*-- Author :
-*
-+KEEP,JBYT3.
-*CMZ : 4.19/00 19/04/93 09.55.52 by Rene Brun
-*-- Author :
-*
- JBIT (IZZW,IZZP) = IBITS (IZZW,IZZP-1,1)
- JBYT (IZZW,IZZP,NZZB) = IBITS (IZZW,IZZP-1,NZZB)
-+KEEP,JBYT4.
-*CMZ : 4.19/00 19/04/93 09.55.52 by Rene Brun
-*-- Author :
-*
- JBIT (IZW,IZP) = AND(RSHIFT(IZW,IZP-1),1)
- JBYT (IZW,IZP,NZB) = ISHFTR(LSHIFT(IZW,33-IZP-NZB),32-NZB)
-+KEEP,JBYT.
-*CMZ : 4.21/08 14/02/94 10.53.41 by Rene Brun
-*-- Author :
-+SEQ,JBYT1,IF=VAX,ALLIANT.
-+SEQ,JBYT2,IF=IBM,NORD,CRAY,CDC,UNIX, IF=-ALLIANT,IF=-MSDOS,IF=-WINNT.
-+SEQ,JBYT3,IF=MSDOS,IF=NDP.
-+SEQ,JBYT4,IF=MSDOS,WINNT,IF=QF2C.
-
-+KEEP,HCQCOM.
-*CMZ : 4.19/00 13/04/93 16.36.40 by Rene Brun
-*-- Author :
-* Basic parameters and data for multiquadric fit.
-* VPRINT is true if verbose option selected.
- LOGICAL VPRINT
-* NTUPLE is .TRUE. if ntuple is being processed, otherwise .FALSE.
- LOGICAL NTUPLE
-* IMQFUN function flag: = 0, no function evaluated yet.
-* = 1, linear sum of multiquadrics.
-* = 2, exponential of linear sum of multiquadrics.
-* (Note: HQF... routines take account of this, HQD... always calculate the
-* simple sum of multiquadrics.)
- INTEGER IMQFUN
-* IDMQ stores current histogram no. when required.
- INTEGER IDMQ
-* JMQ, KMQ store current multiquadric basis function nos. when required.
- INTEGER JMQ, KMQ
-* NSIG is number of significant points.
- INTEGER NSIG
-* NFREE is number of free parameters in the fitting (often equal to NSIG).
- INTEGER NFREE
-* Limits and recommended values of no. of significant points.
- INTEGER NSMIN, NSMIN1, NSMIN2, NSMIN3, NSREC1, NSREC2, NSREC3
- PARAMETER (NSMIN1 = 5, NSMIN2 = 10, NSMIN3 = 10)
- PARAMETER (NSREC1 = 15, NSREC2 = 50, NSREC3 = 50)
-* NSMAX its maximum no. of significant points.
- INTEGER NSMAX
- PARAMETER (NSMAX = 500)
-* NDIM is the number of dimensions - NDMAX is its maximum.
- INTEGER NDIM, NDMAX
- PARAMETER (NDMAX = 3)
-* NDIMC is dimensionality of data currently under consideration (<= NDIM).
-* NDIMWH is which of the NDIM1 dimensions are currently being considered.
- INTEGER NDIMC, NDIMWH (NDMAX)
-* NBINS is no. of bins in each coordinate, NBTOT the total
-* no. of bins in current histogram.
- INTEGER NBINS (NDMAX)
- INTEGER NX, NY, NZ, NBTOT
- EQUIVALENCE (NX, NBINS (1)), (NY, NBINS (2)), (NZ, NBINS (3))
-* Similarly, NBINSN is no. of bins for which first significant points where
-* found when surveying Ntuple data.
- INTEGER NBINSN (NDMAX)
- INTEGER NXN, NYN, NZN
- EQUIVALENCE (NXN, NBINSN (1)), (NYN, NBINSN (2)),
- +(NZN, NBINSN (3))
-* NNBINn is no. of bins used to bin ntuple data in n-dimensions.
- INTEGER NNBIN1, NNBIN2, NNBIN3
- PARAMETER (NNBIN1 = 100, NNBIN2 = 40, NNBIN3 = 40)
-* NMQEVS is no. of events (see also WMQEVS).
- INTEGER NMQEVS
-* NMQFUL is no. of histogram bins with non-zero content.
- INTEGER NMQFUL
-* NINTVS, NQUADS are no. of intervals and no. of gaussian quadrature points
-* per interval for integration of multiquadric functions.
- INTEGER NINTVS, NQUADS
- PARAMETER (NINTVS = 50, NQUADS = 8)
-* LAREA is working space for ZEBRA link maintenance.
-* LHQUAD is pointer to parent bank in Q in /PAWC/ in SEQ HCBOOK.
-* (For bank structure see HQINIT header.)
-* LnH and LnV are pointers to current n-D histogram contents and variances.
-* LHQCOV is pointer to covariances.
-* LHQDER is working bank for double derivatives.
-* LHQWK1/2.. are more working banks.
-* LHQDJN is pointer to temporary bank holding function values.
-* LLAST is a dummy pointer - always last!
- INTEGER LAREA (2), LHQUAD, L1H, L1V, L2H, L2V, L3H, L3V,
- +LHQCOV, LHQDER, LHQWK1, LHQWK2, LHQWK3,
- +LHQDJN, LLAST
-*
-* SIGGRD contains the gradient of the function with respect to the strengths.
-* SIGDEN the (approximate) density of the function at the significant point.
- REAL SIGGRD (NSMAX)
- REAL SIGDEN (NSMAX)
-* SIGV contains significant points' coordinate vectors.
- REAL SIGV (NSMAX, NDMAX)
- REAL SIGX (NSMAX), SIGY (NSMAX), SIGZ (NSMAX)
- EQUIVALENCE (SIGX, SIGV), (SIGY, SIGV (1, 2)), (SIGZ, SIGV (1, 3))
-* SIGDEL contains the scale parameter Delta for each coordinate.
- REAL SIGDEL (NSMAX)
-* SIGVMI, SIGVMA, SIGVBI, SIGVT are lower and upper limits, bin size
-* and total range.
- REAL SIGVMI (NDMAX), SIGVMA (NDMAX), SIGVBI (NDMAX), SIGVT (NDMAX)
- REAL XMI, XMA, DX, DXT, YMI, YMA, DY, DYT, ZMI, ZMA, DZ, DZT
- EQUIVALENCE (XMI, SIGVMI (1)), (XMA, SIGVMA (1))
- EQUIVALENCE (DX, SIGVBI (1)), (DXT, SIGVT (1))
- EQUIVALENCE (YMI, SIGVMI (2)), (YMA, SIGVMA (2))
- EQUIVALENCE (DY, SIGVBI (2)), (DYT, SIGVT (2))
- EQUIVALENCE (ZMI, SIGVMI (3)), (ZMA, SIGVMA (3))
- EQUIVALENCE (DZ, SIGVBI (3)), (DZT, SIGVT (3))
-* BINV is used to store current coordinates - usually bin centres, but can
-* be edges 0. or 1.
- REAL BINV (NDMAX)
- REAL XBIN, YBIN, ZBIN
- EQUIVALENCE (XBIN, BINV (1)), (YBIN, BINV (2)), (ZBIN, BINV (3))
-* VOLTOT is total "volume" and VOLBIN is "volume" of bin in current histogram.
- REAL VOLTOT, VOLBIN
-* WMQEVS is weighted no. of events (see also NMQEVS).
- REAL WMQEVS
-* VSCALE scales variances (only if incorrectly assigned errors suspected).
- REAL VSCALE
-* VMEAN1, VMEAN2 are mean variance per histogram entry and its square.
- REAL VMEAN1, VMEAN2
-* VCONST is a constant multiplying exponential of sum of multiquadrics for
-* Poisson likelihood fitting.
- REAL VCONST
-* SENSIT is a sensitivity parameter - normally 1 - which controls the
-* selection of significant points.
- REAL SENSIT
-* SLCUT is current value of cut for Laplacian significance.
- REAL SLCUT
-* SLRMS is rms of Laplacian significance.
- REAL SLRMS
-* SPREAD is a smoothness parameter - normally 1 - which multiplies the
-* scale parameter (radius of curvature).
- REAL SPREAD
-* SMALLD is a "small" value of the multiquadric parameter DELTA for edges, etc.
-* (usually set to 1.E-6 in HQUAD, HQUADN).
- REAL SMALLD
-* HQMIN, HQMAX, HQFMIN, HQFMAX are current minimum and maximum bin heights and
-* function values (at bin centres).
- REAL HQMIN, HQMAX, HQFMIN, HQFMAX
-*
- COMMON /HCQCOM/ SIGGRD, SIGDEN, SIGV, SIGDEL,
- + SIGVMI, SIGVMA, SIGVBI, SIGVT,
- + BINV, VOLTOT, VOLBIN, WMQEVS, VSCALE, VMEAN1, VMEAN2,
- + VCONST, SENSIT, SLCUT, SLRMS, SPREAD, SMALLD,
- + HQMIN, HQMAX, HQFMIN, HQFMAX,
- + IMQFUN, IDMQ, JMQ, KMQ,
- + NSIG, NFREE, NSMIN, NDIM, NDIMC, NDIMWH,
- + NBINS, NBTOT, NBINSN, NMQEVS, NMQFUL,
- + LAREA, LHQUAD, L1H, L1V, L2H, L2V, L3H, L3V,
- + LHQCOV, LHQDER, LHQWK1, LHQWK2, LHQWK3,
- + LHQDJN, LLAST,
- + VPRINT, NTUPLE
-
-+KEEP, HCQCOR1.
-*CMZ : 4.19/00 13/04/93 16.36.40 by Rene Brun
-*-- Author :
-* SIGA contains the coefficients of the multiquadric basis functions.
- REAL SIGA (NSMAX)
- COMMON /HCQCOR/ SIGA
-+KEEP, HCQCOR2.
-*CMZ : 4.19/00 13/04/93 16.36.40 by Rene Brun
-*-- Author :
-* SIGA contains the coefficients of the multiquadric basis functions.
- DOUBLE PRECISION SIGA (NSMAX)
- COMMON /HCQCOD/ SIGA
-
-+KEEP, HCQCOR.
-*CMZ : 4.19/00 13/04/93 16.36.40 by Rene Brun
-*-- Author :
-+SEQ,HCQCOR1,IF=-DOUBLE.
-+SEQ,HCQCOR2,IF=DOUBLE.
-+KEEP,HCDIFB.
-*CMZ : 4.19/00 13/04/93 16.36.40 by Rene Brun
-*-- Author :
-C
-C----------------------------------------------------------------------
-C
-C HDIFFB specific common block
-C
-C----------------------------------------------------------------------
-C
-C
-C Option string: Contains all possible character options, used as input
-C for the option decoding utility HUOPTC. This returns a
-C 1-d array of length the number of options with contents
-C one or zero. One indicates that that option was selected.
-C For example, HUOPTC('A','ABC',SELECTED(3)) would return
-C (1,0,0) in SELECTED array. Likewise, 'CB' would return
-C (0,1,1).
-C
-C HDIFFB has 12 possible options, and the resulting 1-d
-C array, OPTS(12) is placed in the HDIFFB common block.
-C
-C----------------------------------------------------------------------
-C
- INTEGER NPARMS
- PARAMETER( NPARMS = 12 )
- CHARACTER*(NPARMS) OPTST
- INTEGER OFLOW, UFLOW, SOPTN, COPTN, AOPTN
- INTEGER NORMD,DEBUG,ZEROS,XUNDR,XOVER,YUNDR,YOVER
-C - possible options string
- PARAMETER( OPTST = 'NDOUSCAZRLTB' )
-C - option N, don't normalize contents
-C - option D, debugging printout
-C - option O, overflow option
-C - option U, underflow option
-C - option S, statistical comparison
-C - option C, compatibility test
-C - option A, absolute test
-C - option Z, skip ref bin = 0
-C - option R, X-Axis overflow
-C - option L, X-Axis underflow
-C - option T, Y-Axis overflow
-C - option B, Y-Axis underflow
- PARAMETER( NORMD = 1 , DEBUG = 2 , OFLOW = 3, UFLOW = 4,
- + SOPTN = 5, COPTN = 6 , AOPTN = 7 , ZEROS = 8, XOVER = 9,
- + XUNDR = 10, YOVER = 11, YUNDR = 12)
-C
-C----------------------------------------------------------------------
-C Global HDIFFB declarations
-C----------------------------------------------------------------------
-C
- INTEGER DUMPDV,IDR,IDD,BEGINI,BEGINJ,ENDI,ENDJ
- INTEGER OPTS(NPARMS),XSIZ
- REAL LAMBDA,LNBIGP,ACDIGT
- LOGICAL TWODIM,WEIGHR,WEIGHD,PROFIL,PSDMR,PSDMD
-
- COMMON/HCDIFB/TWODIM,WEIGHR,WEIGHD,PROFIL,PSDMR,PSDMD,DUMPDV,
- + IDR,IDD,BEGINI,BEGINJ,ENDI,ENDJ,LAMBDA,OPTS,XSIZ,LNBIGP,ACDIGT
diff --git a/src/car/higz.car b/src/car/higz.car
deleted file mode 100644
index 291e9cc..0000000
--- a/src/car/higz.car
+++ /dev/null
@@ -1,2639 +0,0 @@
-+TITLE.
-HIGZ 1.23/05 18/10/95 10.14.00 PROGRAM LIBRARY HIGZ = Q120
-+PATCH,$VERSION.
-+DECK,V1_23.
-*CMZ : 10/11/95 10.51.46 by O.Couet
-*-- Author : O.Couet 05/05/95
-*
-* 10/11/95 10.51.30 by O.Couet
-* Mods in IGCOLM
-*
-* 01/11/95 14.05.51 by O.Couet
-* Mods in IMAC (Cees Th. de Laat)
-*
-*::> VERSION 1.23/05 18/10/95 10.14.00
-*
-* In x11int, size_hints and wm_hints are memset to 0.
-*
-* 17/10/95 18.22.29 by O.Couet
-* New routine IGELLI to draw an ellipse.
-*
-* 11/10/95 17.26.20 by O.Couet
-* The default value of CHHE in igset is now 0.28 (like in HPLOT).
-*
-* 04/10/95 17.40.07 by O.Couet
-* IRAST was not initialized in IGTABL
-*
-* 02/10/95 17.14.30 by O.Couet
-* TK_WINDOWS flag in x11int
-*
-*::> VERSION 1.23/04 28/09/95 09.54.20
-*
-* Mods in x11int: free the colors before defining a new one.
-*
-*::> VERSION 1.23/03 20/09/95 14.08.27
-*
-* Bug fixed in IZPM. The marker types different from 1 to 5 produced
-* some PS output in the LaTex files.
-*
-* 05/09/95 15.03.33
-* A +SELF was missing in ISTXAL in IKERNEL
-*
-* 04/09/95 12.17.57
-* Fixes in IGOBJ and IGPICK for the picking in PAW++
-*
-* 01/09/95 09.45.00
-* IKFILE crashed if the file higz_windows.dat was r/w protected.
-*
-*::> VERSION 1.23/02 30/08/95 18.20.27
-*
-* Bug fixed in IZDNB: the alpha numeric labels was not stored
-* in the picture in case of IZMERG.
-*
-* 30/08/95 13.44.39
-* The test of validity on window size in IGSSE is now a
-* .LT.0 test instead of .LE.0 test
-*
-* 29/08/95 11.43.13
-* The PASS attribute is now use as line width for the PS
-* hollow fonts.
-*
-* 15/08/95 17.39.19
-* IKFNTX called IXSETTF as a subroutine, rather than an
-* integer function in the MSDOS part.
-*
-* 07/06/95 17.36.31
-* %%BeginProlog and %%EndProlog was misplaced in PS files.
-*
-* 01/06/95 16.16.50
-* Xflush is now called at the end of ixreqlo (x11int) to be
-* sure that rubberdanding line has been erased.
-*
-* 30/05/95 09.45.20
-* Bug fixed in igaxis: The alignment of the exponent was
-* not correct on the axis drawn on the right of the plots.
-*
-*::> VERSION 1.23/01 24/05/95 11.13.21
-*
-* The "gsave" an "grestore" are now managed via the routine
-* IPSVRT which count the number of gsave in the variable NBSAVE.
-* This allows to write the correct number of grestore at the
-* end of the PS file.
-*
-* 08/05/95 11.51.44
-* New MSDOS version (Valery Fine)
-*
-*::> VERSION 1.23/00 05/05/95 15.25.21
-*
-* In IZGRAP and IZHIST, BORD was not consider as a possible
-* attribute for graphs and histograms.
-*
-* 10/04/95 17.50.26
-* Bug fixed in IGPICK for the picking of IGTABL.
-*
-* 10/04/95 10.39.58
-* New version of IGOBJ which looks in all the NTs if nothing is found
-* in the one the user picked in. A new routine to scan the NTs in a
-* picture has been created for that (IZGNNT).
-*
-+DECK,V1_22.
-*CMZ : 1.22/11 07/04/95 10.46.41 by O.Couet
-*-- Author : O.Couet 10/11/94
-*
-*::> VERSION 1.22/11 07/04/95 10.46.41
-*
-* Bug fixed in IGPAVE: The coordinates was not stored in the correct
-* order.
-*
-*::> VERSION 1.22/10 05/04/95 15.48.50
-*
-* Fix in IZTX: the IGTEXT call (for PS) was not done with GFLAG=.TRUE.
-*
-* 05/04/95 11.03.50
-* Bug fixed in IGAXIS. When the axis is close to the vertical a test
-* XMIN = XMAX was done. Now we compare the difference to EPSIL.
-*
-* 03/04/95 17.08.19
-* Fix in IPPATT: the trailing blank before the continuation line in
-* the middle of a character string are removed on VAXes.
-*
-* 03/04/95 10.36.54
-* Bug fixed in //HIGZ/IKERNEL/IRQLC. After the MAIL option removal
-* the SAMPLE variable was not initialized (a +SELF was missing).
-*
-*::> VERSION 1.22/09 23/03/95 15.25.29
-*
-* Bug fixed in IPL (all the versions): The clipping on line type
-* greater than 12 was not correct.
-*
-* 09/03/95 16.17.22
-* Mods in IGTABL and IGHCXY to drawn the errors (color) correctly for
-* 1D histos.
-*
-*::> VERSION 1.22/08 09/03/95 14.09.16
-*
-* New option E in IGTABL. This option allows to draw the error
-* on 2D histograms. Used with S1, S2, etc the colors are mapped
-* on the errors not on the content.
-*
-* 27/02/95 17.41.51
-* The MAIL option (telnetg) has bin removed from the installation
-* cradle *HIGZ.
-*
-* 24/02/95 16.57.11
-* Misplaced RETURN in IGWWK (options 2BUF and HWCO).
-*
-* 24/02/95 15.46.45
-* Bug fixed in IGTAB4: Th background color for surface was not correct
-* if, for example, BCOL=1102.
-*
-* 22/02/95 12.05.12
-* All the ONtuple material has been moved in the OBSOLETE patch.
-*
-* 14/02/95 10.43.48
-* Bug fixed in IKBOX for the FALCO driver. IGSG was missing.
-*
-*::> VERSION 1.22/07 09/02/95 17.03.34
-*
-* Bug fixed in IPTEXT. Some arrays was accessed with wrong indeces.
-*
-* 07/02/95 10.10.51
-* Mod in IPEND: In some cases (for example NEXT at the end of a macro)
-* a PS file was terminated like an EPS file.
-*
-*::> VERSION 1.22/06 03/02/95 12.15.27
-*
-* Bug fixed in IPTEXT: in some case the text was cutted in the middle
-* of an octal code.
-*
-*::> VERSION 1.22/05 30/01/95 11.02.06
-*
-* Bug fixed in IZSCLI. The PostScript clipping was stored in
-* the LaTex file (-777).
-*
-* 27/01/95 16.28.10
-*
-* Better drawing of the ARC border. Patch IG: IGARC2 IGARC3 IGARC4
-*
-*::> VERSION 1.22/04 25/01/95 17.50.08
-*
-* New routine IXMOVWI to move an X11 window.
-*
-* 25/01/95 15.44.18
-*
-* New option WIID in IGQWK to return the window identifier associated
-* to a given workstation ID.
-*
-* Bug fixed in ixgetwi (x11int): It was not working for several
-* windows.
-*
-*::> VERSION 1.22/03 06/01/95 15.29.04
-*
-* ISWN3 is called in IGTABL instead of IHSVIE. If IHSVIE is called,
-* a sequence like:
-* call hplfr3(0.,4.,0.,1.,0.,1.,30.,30.,'WBF')
-* lego 20
-* does not work because the window (ISWN3) is not normalized after
-* the call to HPLFR3.
-* Protection added in ISVP3 and ISWN3
-*
-*::> VERSION 1.22/02 05/01/95 15.10.45
-*
-* Mods in IZSCLI, IPINIT, IPZONE: The clipping is now set only
-* if IPZONE has been called. Otherwise some clipping problems
-* can append if there is several zones in the PS file
-* Mod in IPDEF: atend is replaced by (atend).
-*
-*::> VERSION 1.22/01 15/11/94 15.57.56
-*
-* Modif in IGAXIS to have the correct label alignment (L,R,C) for
-* vertical axis. I the previous version it was set to Left always
-* if the axis was drawn TOP do DOWN. IGCOLM also been modified
-* accordingly.
-*
-*::> VERSION 1.22/00 10/11/94 11.49.51
-*
-* Modif in the definition of the clipping for PostScript to avoid
-* side effect in FrameMaker.
-*
-+DECK,V1_21.
-*CMZ : 1.21/12 25/10/94 13.47.25 by O.Couet
-*-- Author : O.Couet 30/03/94
-*
-*::> VERSION 1.21/12 25/10/94 13.47.24
-*
-* Bug fixed in IPIOUT: the I7 format was too small. It is now I15.
-*
-*::> VERSION 1.21/11 21/10/94 12.01.27
-*
-* Improvement in IGAXIS in case of integer labelling. The optimization
-* provide by IGAXI0 is better than the one provide by IGAXI4. When
-* integer labelling is required, IGAXI0 is invoke first and only
-* if the result is not an integer labelling, IGAXI4 is invoked.
-*
-*::> VERSION 1.21/10 17/10/94 15.08.15
-*
-* VIDQQ is now removed from IGINIT because it is now in igvers.
-* Mods IGAXIS to have a better drawing of label like 10^xxx: Now we
-* take into account the length of the exponant to avoid
-* overlapping text. (improvement suggested by Mike Kelsey).
-* New option HWCO in IGQWK to return the number of hardware colours
-* available.
-*
-*::> VERSION 1.21/09 27/09/94 17.41.14
-*
-* In IGPICK, TA_IND was not declared as an INTEGER. It is now
-* replaced by ITAIND.
-* Mods in X11INT: VAX machines was asumed to be X11R3 now
-* they are consider as X11R4 (at least) machines. APOLLO machines
-* are still consider as X11R3 machines.
-* Bug fixed in IACWK (X11 version). The line width set was not the
-* same as the one set by ISLWSC.
-* Bug fixed in ICLKS. This routine close all the workstations still
-* open. It was looping on ILOPWK but this list was changed by
-* ICLWK, so ICLKS tried to close a non opened workstation. Now
-* ILOPWK is copied in an intermediate array.
-* Mods in IRQST/GPR. A small editor is now available.
-* (Robert Franchisseur robert at ramses.ibp.fr)
-* New C routine igvers to return the current HIGZ version. It is
-* used by the PAW command BUGREPORT
-* Precision problem in LOG scale has been solved (hopefully) in
-* IGAXIS. (XMNLOG-IH1).GT.EPSIL is now (XMNLOG-IH1).GT.0.. This
-* problem has been reflected in the pawdemo file.
-* Protection added in ISTXAL (IKERNEL): ixsetta was called even
-* with GFLAG=.FALSE.
-* New option 'X' in IGZSET to turn OFF the 'Z' mode without changing
-* the 'G' mode (used in HPLOPT).
-* New set of pattern in the X11 driver.
-* The Fill Pattern from 1 to 25 are now available also on PS files.
-* be careful with GhostView because to many filled areas with
-* such patterns can block this program.
-* Speed optimization in the PS file writing (a factor 3.6). A fast
-* writting routine has been introduced (IPPSTF entry point of
-* IPPSTR). In IPIOUT some code of IPPSTR is now inlined. IPDRAW
-* call has been replaced by two IPIOUT calls. The speed up gained
-* is the following (a 100x100 scatter plot):
-* Real time 00:01:08 (Old version)
-* Real time 00:00:34 (new IPIOUT)
-* Real time 00:00:22 (IPPSTF and inline in IPIOUT)
-* Real time 00:00:19 (suppress IPDRAW in IZPM)
-*
-*::> VERSION 1.21/08 22/07/94 15.22.13
-*
-* New routine IXWARP in x11int to move the pointer at a given
-* position (Adeyemi Adesanya).
-* New routine IZPAVE to store IGPAVE as a macro primitive. It implies
-* also mods in IZDNB and IGPICK.
-* Mods in IGRAP1 (push the LX and LY banks) in order to draw
-* filled area in one go.
-* Changes in IGPICK to pick text (Yemi)
-* A blank was missing in IPFON (DECS only)
-*
-*::> VERSION 1.21/07 30/06/94 14.56.15
-*
-* Protection added in IKFILE (ERR=999 in the last READ).
-* New routine IXQPTR in x11int to query the current pointer
-* position (Adeyemi Adesanya).
-* Mods in IGTAB5 to return in QUEST the axis positions (useful
-* for HPLOT to draw the axis titles).
-*
-*::> VERSION 1.21/06 27/06/94 18.21.00
-*
-* Mods in IZFILE to take into account the new option 'N' of RZMAKE.
-* Mods in IGTABL and IGTAB2 in order to close the surface plots
-* when the options POL, CYL, SPH or PSD are used.
-* Bug fixed in ixreqlo (x11int) when a button was pressed, the
-* cursor was undefined but not set to NULL (now it is).
-*
-*::> VERSION 1.21/05 17/06/94 17.41.08
-*
-* Bug fixed in IXCLSDS (X11INT): isdisp was not reset.
-* (Thierry MOUTHUY, <mouthuy at marpix1.in2p3.fr>).
-* New options 'E' and 'C' in IGZSET.
-* New options 'FB' and 'BB' in IGTABL.
-*
-*::> VERSION 1.21/04 10/06/94 15.05.39
-*
-* New option 'K' in IGHIST (histogram are pacKed like in HBOOK).
-* Fix in X11INT/ixreqst: in some cases, the '?' cursor was not
-* set correctly.
-* Protection added in IZPM and IGAXIS: when IGTEXT is called with
-* option 'S', the ANGLE parameter should be initialize to 0.
-* Optimization in IGAXIS to avoid identical labels on the same
-* axis (IF1 and IF2 too small), and to avoid x10^0.
-* In the sequence HIATT, all the variables are now declared.
-*
-*::> VERSION 1.21/03 06/06/94 13.34.58
-*
-* New version of IZPM (PS driver) to have shorter files.
-* Mods in IKFNTX to have a better maping between X11 and PS fonts.
-* Interface to GKSBx (CMZ flag: GKSBX).
-* Mods in IGKS and IDI3000 to use the C management of the NTs.
-* The cursor is reset after a request locator in sample mode (X11).
-* Mods is IPTEXT: the "stwn" value is now printed in I6.
-* Bug fixed in IGSA (FALCO version): it was a side effect of the
-* last mod apply for GPR (bug reported by Andrea Parri).
-*
-*::> VERSION 1.21/02 19/05/94 10.09.37
-*
-* Bug fixed in IGAXIS (precision problem on IBM/VM). This was a side
-* effect of the fix made in the version 1.20/05 for the X00 and
-* XONE comparison. Now the variable XMNSAV is not used, only XMNLOG
-* is used.
-* Bug fixed in IGSA (GPR version). GPR_RELEASE_DISPLAY was not
-* called if no workstation was opened.
-* Bug fixed in the PostScript driver: if EPS is selected and if the
-* BoundingBox is not yet in the file, the clipping cannot be set.
-*
-*::> VERSION 1.21/01 11/05/94 18.57.56
-*
-* New option 'W' in IGPXMP (write a pixmap in a bitmap file).
-* Major changes in the PostScript driver: the clipping is now
-* managed in the PS file itself.
-*
-*::> VERSION 1.21/00 30/03/94 18.14.42
-*
-* IGINIT: If GKSIBM is selected, METDEF = 3
-* In IGSA (DECGKS), '\' is now BSLASH (AlphaVMS).
-*
-+DECK,V1_20.
-*CMZ : 1.20/11 28/02/94 11.26.52 by O.Couet
-*-- Author : O.Couet 02/11/93
-*
-*::> VERSION 1.20/11 28/02/94 11.26.52
-*
-* Bugs fixed in IGTABL (default parameter values initialization).
-* IGERR was called in IGWKTY without LUNERR and LUNOUT initialized.
-* Update in IZHIST to take into account the new 'Z' option of IGHIST.
-*
-*::> VERSION 1.20/10 21/02/94 11.15.35
-*
-* Mods in IGTEXT, IKFNTX *HIGZ and *HIGZEXAM for Windows-NT (Valery Fine)
-* New option 'Z' in IGHIST. Like in IGRAPH, if it is selected, the vectors
-* X and Y are taken into PAWC at the adresses IQUEST(81) and IQUEST(82).
-* This protect agains the ZEBRA garbage collections.
-*
-*::> VERSION 1.20/09 26/01/94 09.21.23
-*
-* IGPICK is now able to pick IGARC.
-* Mod in IXOPNDS (x11int): The display was reopen for each window.
-* The READ in IGWKTY is in FORTRAN (IXGETL under the flag CCREAD) because
-* KUIP do the READ in FORTRAN (cf FFREAD).
-* Mod in ISTXFP for the FALCO driver.
-*
-*::> VERSION 1.20/08 20/01/94 11.30.15
-*
-* The 3D is available (ISWN3, ISVP3) for the X11 only. ntmgt should be
-* used also with the GKS version.
-* New routine IXDOGIF to produce gif files. It is available only if
-* if the FLAG GIF is selected.
-* Correction in IKERNEL/IPM: The marker size was not linear
-*
-*::> VERSION 1.20/07 17/01/94 18.06.42
-*
-* Mods in the FALCO driver: John Clement
-* Protection added in IZDIPI. (LN)
-* IXCLSDS perform immediatly a return if display=NULL
-* Bug fixed in IHPVIE (a RETURN was missing).
-* Mods in IOPWK, IGWKTY, IGINIT and IKFILE to be able to call
-* IGWKTY before or after IGINIT.
-*
-*::> VERSION 1.20/06 07/01/94 18.38.19
-*
-* Mod in IGXMES for IBM/VM.
-* New 3D routines: ISWN3 and ISVP3. See the HIGZ manual for more details
-* Protection added in IHSDRL (if NT > NTMAX).
-* Mods in IGTABL to use the new 3D routines
-* Mods for FALCO driver: John Clement, Rice University
-* <CLEMENT at physics.rice.edu>. I some places, test like IWTYPE.EQ.7878
-* should be IGIWTY(IWKID).EQ.7878
-*
-*::> VERSION 1.20/05 08/12/93 09.33.04
-*
-* Bug fixed in IGAXIS. In some cases (it seems very rarely because
-* the code has not change in this part since at least 3 years)
-* in the test:
-* IF((X00-XONE).GT.EPSIL) GOTO 150
-* EPSIL was to big. Now the test is:
-* IF(X00.GT.XONE) GOTO 150
-* and in fact that is what is needed in this case.
-* Changes in rotated to avoid warnings with /com/cc on APOLLO.
-*
-*::> VERSION 1.20/04 26/11/93 13.42.06
-*
-* Fix in higzcc/rotated for IBM/VM: The text width returned for
-* lowercase is 0. Now it is protected.
-* New routine IGDWK to Get the Default WorKstation type. This
-* routine is called by IGWKTY.
-*
-*::> VERSION 1.20/03 23/11/93 11.44.01
-*
-* Mods in IGCOLM in order to support default position and color map.
-* The xvertext package to rotate and scale X11 fonts is now available
-* in higzcc/rotated (Alan Richardson(mppa3 at uk.ac.sussex.syma))
-* Now the X11 fonts are managed as follows:
-* font=xx precision=0 : X11 font a rotated
-* font=xx precision=1 : IGTEXT is used on the screen
-* font=xx precision=2 : X11 font a rotated and scaled.
-* Fix in higzcc/rotated for IBM/VM.
-* Protection added in ixgetge: sometimes (for instance after a CTRL-C),
-* XGetGeometry returns wrong values. In this case the previous "good
-* values" are used.
-*
-*::> VERSION 1.20/02 08/11/93 09.53.03
-*
-* IXSELWI is now called in IACWK (X11) to be sure the window
-* in active even if IGTERM is not called.
-*
-*::> VERSION 1.20/01 03/11/93 11.12.27
-*
-* The unused routine IGPHSL is now removed.
-* The PATCH IGKS3D is removed (not used and not documented). The
-* related routines in IG and the corresding KEEP in HICDES are
-* also removed.
-*
-*::> VERSION 1.20/00 02/11/93 17.44.57
-*
-* Some unused sequences are removed.
-*
-+DECK,V1_19.
-*CMZ : 1.19/17 22/10/93 17.59.07 by O.Couet
-*-- Author : O.Couet 28/06/93
-*
-*::> VERSION 1.19/17 22/10/93 17.59.07
-*
-* Mods in IGRAP1 in order to draw Curves with in infinite number
-* of point (ZEBRA banks replace HIGRAF common block). Mods also
-* in IGRAPH to take advantage of the new version of IGRAP1.
-*
-*::> VERSION 1.19/16 22/10/93 09.34.26
-*
-* Bug fixed in IZGRAP in case the original data are in a zebra bank.
-* The format in IZPICT (for the listing) are now I5 instead of I2.
-*
-*::> VERSION 1.19/15 12/10/93 12.10.10
-*
-* Bug fixed in IGAXIS (case NULL 9.999 10).
-* Optimization in IGAXIS. In case of overlap, the alphanumeric labels
-* are rotated.
-* Mods in IGTABL, IZTABL and IZDNB to allow 2D plots with more than 999
-* bins (with subranges).
-*
-*::> VERSION 1.19/14 07/10/93 15.33.40
-*
-* Flag NOVAGKS suppressed.
-* Useless pilot patches *GKSGRAL, *DECGKS, *SUNGKS, *GPR, *GL, *X11 and
-* *DI3000 are removed. The installation of HIGZ should be done with
-* the pilot patch *HIGZ.
-* For DecStation Color, GXinvert should be use for rubberbanding.
-*
-*::> VERSION 1.19/13 01/10/93 10.54.59
-*
-* Speed improvments in IPM4ID (3-4 times faster).
-* Mods in IGWKTY. For UNIX machines wokstation type read is done via
-* a C routine (IXGETL) in order to allow:
-* $ paw < filename
-* or
-* $ cat filename | paw
-*
-*::> VERSION 1.19/12 28/09/93 17.37.09
-*
-* Bug fixed in IZGRAP: The BASL attributes was not flaged.
-* Bug fixed in IRQST for FALCO: the output parameter L was not correct.
-* IGSG is now called in ISLN for the FALCO driver.
-* New routine IPM4ID to draw NT/PLOT id.x%y%z%t
-*
-*::> VERSION 1.19/11 27/09/93 11.59.25
-*
-* In IGTCCH the character % is translated into '"Y#'
-*
-*::> VERSION 1.19/10 15/09/93 11.16.41
-*
-* Changes in IGTAB5, and IGTABL to be able to define the log option
-* from the calling sequence and not via COMMON.
-* Bug fixed in IZMERG.
-*
-*::> VERSION 1.19/09 06/09/93 11.29.16
-*
-* Mods in IGRAPH: when it was called with an invalid CHOPT (for
-* example '?'), a blank CHOPT was stored in the picture and
-* the image produced with IZPICT was different from the original.
-* Bug fixed in IKBOX. For the 7879 driver and solid filled areas,
-* IGHATC was not called correctly.
-*
-*::> VERSION 1.19/08 03/09/93 17.08.41
-*
-* Flag QMALPH added in *HIGZ.
-* The routine ixgetwi in x11int is now a FORTRAN callable routine.
-*
-*::> VERSION 1.19/07 31/08/93 09.39.07
-*
-* Mods in the PATCH IMAC: New version of imacplo an f_readwi.
-* The deck imacevl is now obsolete.
-*
-*::> VERSION 1.19/06 27/08/93 17.15.44
-*
-* Improvments in the vertical centering of rotated texts. This
-* implies mods in the ITX routines (IKERNEL, IGKS and IDI3000)
-* and in the routine IPTEXT.
-* Small Improvments in the 3d function drawing (PATCH IH).
-*
-*::> VERSION 1.19/05 26/08/93 11.58.10
-*
-* Improvments in the 3d function drawing (PATCH IH). It is
-* also possible to draw with hidden lines removal.
-*
-*::> VERSION 1.19/04 25/08/93 10.19.48
-*
-* Changes for CONVEX (V.Balashov).
-* Bug fixed in IOPKS in the pathes IGKS an IDI3000: The string
-* CHVERS was not initialized.
-*
-*::> VERSION 1.19/03 24/08/93 12.03.26
-*
-* New flag WINNT introduced.
-* In IGTEXT, IA is saved for MACMPW (Cees Delaat).
-* Lot of changes in the IMAC PATCH (Cees Delaat).
-*
-*::> VERSION 1.19/02 930729 13.07
-*
-* Unreachable code suppressed in IGTAB6.
-* IF=HIGZEXAM on +PATCH,HIGZEXAM.
-* CHDEFT has now 256 in IGMENU (instead of 80). (Roger Ruber
-* RUBER at JPNKEKVX.BITNET)
-* Bug fixed in IPDEF for the not A4 landscape PS file.
-*
-*::> VERSION 1.19/01 930705 12.42
-*
-* Protection added in IGMENU if the multiple choices ended with ','.
-*
-*::> VERSION 1.19/00 930628 12.14
-*
-* Protection added in IPTEXT: if the text size is less or equal
-* to zero, a RETURN is performed.
-* The EPS files contain now a showpage.
-*
-+DECK,V1_18.
-*CMZ : 1.18/10 22/06/93 17.28.47 by O.Couet
-*-- Author : O.Couet 30/04/93
-*
-*::> VERSION 1.18/10 930622 17.28
-*
-* In the FALCO driver the marker type 3 (*) in known. This implies
-* mods in IGPM.
-* Mod in IGAXIS to have a better alignment for the vertical right
-* labeled axis.
-* Line type for FALCO implemented (merlant at csnvs1.in2p3.fr).
-* Bug fixed in ISCHH (patch IKERNEL): in case of FALCO, CHHE was
-* not stored in the pictures.
-*
-*::> VERSION 1.18/09 930611 9.40
-*
-* Bug fixed in ICLWK in case one the workstation was a PS file.
-* New version of IGTABL and IGTAB6 to allow POL etc.. with
-* Gouraud shading surfaces.
-*
-*::> VERSION 1.18/08 10/06/93 17.50.50
-*
-* In IKERNEL/IOPWK for the X11 version the string :0.0 is append after
-* the display name/adress only if ":" is not yet in the name.
-* New primitive ICA to draw cell arrays.
-* Remove bug in IGSSE (introduced with the changes for DECGKS)
-*
-*::> VERSION 1.18/07 930601 17.22
-*
-* Changes in IKERNEL/IOPWK for the X11 version to allow to change
-* the HIGZ window name. In higz_windows.dat after the adress
-* of the host it is possible to give the window name.
-*
-*::> VERSION 1.18/06 930528 9.32
-*
-* Improvment in IPSCOL (set the PostScript Color): if the color is
-* black, the operator "setgray" is used instead of "setrgbcolor"
-* because on some color printers black is better with "setgray".
-*
-*::> VERSION 1.18/05 930527 15.01
-*
-* LINUX version introduced. <balashov at main1.jinr.dubna.su>
-* New version of hidden line removal algorithm for Polar, Cylindrical,
-* and Sperical coordinates.
-* Bug fixed in IGTCCH: CHBUF is now erased before to be filled.
-*
-*::> VERSION 1.18/04 930526 14.08
-*
-* Bug fixed in IKFILE: on IBM/VM the string CCHOST was too long.
-*
-*::> VERSION 1.18/03 930525 17.06
-*
-* Mods for the GKSGRAL,NEWLIB version in IGSA, IGSG ad IGWKTY
-* (Harald Butenschoen)
-*
-*::> VERSION 1.18/02 930525 10.13
-*
-* The string CHHOST in HIKERC was too small it is now 80 characters.
-* (mjk at illini.physics.utah.edu)
-* "IF=" on PATCH cards.
-* In the X11 driver, the class hint is now equal to "HIGZ" (W.Brueckner).
-*
-*::> VERSION 1.18/01 930511 17.24
-*
-* The X11 mode to draw the cursor in ixreqlo is define according to
-* the XServerVendor output.
-* In IGMETA, if LUN=999, the metafile is deactivated AND closed.
-* New routine IGMETN to set the metafile name. It is usefull for
-* some HIGZ version (ATCGKS, MSDOS ...)
-* Mods in IH routine to have the angle on the first coordinate with
-* Polar, Cylindrical and Spherical reprsentations.
-* Bug fixed in ntmgt: #include <stdio.h> was missing for SUN
-* New routine IGTCCH to translate IGTEXT control characters (in a string)
-* into their printable version.
-*
-*::> VERSION 1.18/00 930430 12.57
-*
-* New C deck NTMGT to manage dynamically the NT. Now used only with X11.
-* Mods in IZPICT and IZSELN: The NT banks have now the same name in order
-* to describe there structure with dzdoc.
-* In IGTEXT, XW,YW and WDTH are now initialized to 0.
-* Mods in various routines for DECGKS on VAX (Lynn Garren <GARREN at FNPSP>).
-* Now the number of colors in HILUT is 256.
-* New options POL, CYL, SPH, and PSD in IGTABL.
-* Sequences are now splited in hicdes, and QFTITLECH is used to set
-* the version number.
-* Logarithmic scales on X and Y axis are now available for Lego and Surface
-* plots. It implies mods in many routines around IGTABL and also
-* in IGAXIS: with options W and G the label were not correct.
-* The X11 mode to draw the cursor in ixreqlo is now "GXxor" which seems
-* to work in a better way than "GXinvert".
-*
-+DECK,V1_17.
-*CMZ : 1.17/03 22/03/93 10.04.38 by O.Couet
-*-- Author : O.Couet 24/02/93
-*
-*::> VERSION 1.17/03 930322 10.04
-*
-* The maximal number of NTs is now 100.
-* The routine XGetCGValues is not used for VAX machines (x11int).
-* A cross cursor is displayed together with the cross-air (x11int).
-* The line type of the contour plots is controled with IGSET LTYP
-* when all the contours are drawn with the same line type (IGTABL)
-* Bug fixed in IFA3: NGRAF was not initialized.
-*
-*::> VERSION 1.17/02 930309 11.58
-*
-* Improvements in the GDDM driver. This version may be used on
-* IBM 3192G terminals, IBM 5080 stations and corresponding
-* emulators (notable the Macintosh version of tn3270).
-* The modifications have been contributed by J.Salicio/CIEMAT.
-*
-*::> VERSION 1.17/01 930302 12.20
-*
-* Bug fixed in IKERNEL/IOPWK: in case of "Invalid Workstation type"
-* INOPWK wasn't decremented.
-* Mods in IGWKTY: when '?' is typed by the user, the metafile
-* types are not displayed.
-*
-*::> VERSION 1.17/00 930224 15.51
-*
-* Improvments in IGAXIS: If the intermediate labels in LOG scale
-* overlap each other, they are not drawn. The position of the
-* exponants is now better in case of LOG scale.
-* New routine IZGRAP to store the IGRAPH primitive.
-* New option Z in IGRAPH.
-* Improvments in IGAXIS: If the intermediate labels in LOG scale
-* are drawn if YMAX < 10000.
-*
-+DECK,V1_16.
-*CMZ : 1.16/13 01/02/93 14.50.45 by Rene Brun
-*-- Author : O.Couet 23/07/92
-*
-*::> VERSION 1.16/13 930201 14.50
-*
-*
-* Inprovments in the X11 fonts management. 4 fonts are kept in
-* memory in order to avoid too many fonts loading.
-*
-*::> VERSION 1.16/12 930126 10.15
-*
-* Bug fixed in IPDLIN. Some line where missing in PS file
-* if they were too small.
-* Improvements in IPTEXT. The PostScript text was always visible
-* even if the text position was outside the paper.
-*
-*::> VERSION 1.16/11 930122 9.40
-*
-* Bug fix in IPZONE for the marker type 1 size.
-*
-*::> VERSION 1.16/10 930118 15.57
-*
-* Mods in IPTEXT in the ' ' and \040 management.
-* Improvments in the intermediate label drawing in case of
-* LOG axis. the rule is now: If 1 =< WMIN <100 and
-* Log(WMAX/WMIN) <2, some intermediate label are drawn.
-*
-*::> VERSION 1.16/09 930112 11.26
-*
-* Changes in IKFNTX: on IBM/VM only non proportional fonts are
-* used in the X11 version because for the proportional fonts
-* the text width is not correctly computed.
-* Bug fixed in IZPM: In PostScript files, invalid marker types
-* produce points.
-* Improvments in IGTAB5 in order to have the size of the axis
-* value, the size of the axis tick marks and the offset of the
-* values independant of the viewing angles in the surface and
-* lego plots drawing.
-* Bug fixed in IGTAB2: in case of LOGZ option the position of the
-* contour plot was not correct with the SURF3 option of IGTABL.
-*
-*::> VERSION 1.16/08 930106 11.16
-*
-* A few bugs fixed in the DI3000 PATCH <MARRAFINO at FNPSP>
-* Mods in x11int in the graphics context used to draw the
-* rubberbanding cursor: it is now more portable
-* jank at sunra1.cern.ch or jank at cernvm (Werner Jank)
-* Mods in the PostScript driver for EPS files: a new dictionnary
-* is defined in order to be included in WORD.<SCHRODER at CERNVM>
-* Mods in the PostScript driver for EPS files: the new dictionnary
-* was too small.
-* Changes in IZPICT. The options C, O, and D can be invoked in the
-* same CALL to IZPICT.
-* Mods in IGHIST. The 1Dim histogram with 1 or 2 bins are not plotted
-* with a marker or with a line but according to the current
-* option choosen.
-*
-*::> VERSION 1.16/07 921126 11.40
-*
-* Bug corrected in IZHIST: The value give to IZPUSH was not
-* correct in case of non equidistant bins.
-* New version of the routine ixmotif. New routine ixminit to
-* initialize the Motif call backs from IOPWK.
-* Mods in IHSDRL (IH) to avoid precision problems on NEXT.
-* New version of the routine IGMESS calling the routine IGXMES
-* which allows a more flexible usage of the X11 windows.
-* Mod in ixopnwi: if the window name begins with '-' the extension
-* ' @ machine_name' is not added to the window title.
-* Mods in the MSDOS driver in the routines IGWKTY, IGSG, IOPWK
-* and MAPCOL to support SuperVGA 800x600 with 16 colors screen
-* (Dr.Valery Fine LCTA/JINR Dubna).
-*
-*::> VERSION 1.16/06 921030 11.04
-*
-* Changes in IGAXIS. With LOG scale, intermediate division
-* are ploted if one one decade is visible. This implies also
-* mods in IZRTOC.
-* Bug fixed in IPTEXT. The @ mechanism to escape control characters
-* was wrong for <, >, ", #, ?, !, & and $.
-* New sequence HIPICK use in IGPID and IGPICK.
-* Default FONT and PRECISION change to 0,2 in IGSET.
-*
-*::> VERSION 1.16/05 921013 16.26
-*
-* Changes in IGAXIS secondary and tertiary axis divisions are
-* optimized like the primary divisions.
-* Changes in the MacIntosh driver (fill area management) (C.Delaat).
-* Bug fixed in the IKERNEL PATCH: With the FALCO driver, some
-* attributes (FACI, FAIS etc...) where not correctly stored in
-* the ZEBRA data structure.
-*
-*::> VERSION 1.16/04 921009 13.53
-*
-* Some fixes in the Macintosh driver (Cees Delaat).
-* New option 'Q' in IZPICT.
-* Changes in the X11 interface. The routine ixmotif allows to
-* manage several window in a motif program. The routine ixopnwi
-* has one additional parameter IFLAG.
-* New flag APOF77 for the f77 apollo compiler.
-* New flag QX_SC and QXNO_SC to add or not an "_" in the C routines.
-* Bug fixed: the PostScript marker size is now reset in IPZONE.
-* Some changes in IGAXI3 in order to get a better automatic
-* labeling of the axis.
-* Changes in IPTEXT: the control characters can be escaped with '@'.
-*
-*::> VERSION 1.16/03 920824 9.44
-*
-* Bug fixed in IZSELN: the graphics editor didn't work. This
-* was a side effect of the introduction of IGPID (Lee Roberts).
-* Bug fixed in the routine IRQST for GL: the blank was forgotten.
-* (Lee Roberts).
-*
-*::> VERSION 1.16/02 920820 10.06
-*
-* Mods in x11int. The window is raised by ixupdwi only
-* if necessary.
-* New version of PostScript text (routine IPTEXT in PATCH IPOST)..
-* (P.Juillot CRN Strasbourg <JUILLOT at CERNVM).
-*
-*::> VERSION 1.16/01 920818 11.03
-*
-* Mods in the Mac interface (Cees de Laat)
-* Bug fixed in x11int (ixsetco) the RGB value were not stored.
-* Bug fixed in IGAXIS in the optimization of the secondary divisions.
-*
-*::> VERSION 1.16/00 920723 13.57
-*
-* Change in IGAXIS for the TOP->DOWN labels.
-*
-+DECK,V1_15.
-*CMZ : 1.15/03 22/07/92 12.17.38 by O.Couet
-*-- Author : O.Couet 14/07/92
-*
-*::> VERSION 1.15/03 920722 12.17
-*
-* Bug corrected in IGSEE and ITX at the PATCHY level (MSDOS
-* flag side effect).
-* Change in IGINIT: the alpha numeric labels are now initialized
-* with ' '. And in IGLBL: if the label list has N<50 labels, the
-* labels form N+1 to 50 are reset to ' '.
-* Bug fixed in IGADID: the IZPUSH parameter was not correct.
-*
-*::> VERSION 1.15/02 920717 14.25
-*
-* Bug fixed in lego and surface drawing: on VM legos with a small
-* range on X or Y axis were shifted. some variables needed
-* to be in DOUBLE PRECISION in the IH PATCH (on VM).
-*
-*::> VERSION 1.15/01 920715 10.00
-*
-* Change in IGCHWK. In the case of GKS OPND and LUNWIN were not
-* initialized <GUNTER at CERNVM>.
-* Change in IRQLC for ATCGKS (call to GPREC) (koellner at lbl.Bitnet).
-*
-*::> VERSION 1.15/00 920714 16.29
-*
-* New flag GKSIBM for the native version of GKS on IBM RS6000.
-* To install this version of HIGZ the following selection are
-* needed: +USE,*HIGZ,IBMRT,GKSIBM. (Roger Howard <RH2 at CERNVM>).
-* Mods in X11INT for IBM/VM: the static variable are now initialised
-* with a "long NULL" (LNULL).
-*
-+DECK,V1_14.
-*CMZ : 1.14/13 03/07/92 13.06.26 by O.Couet
-*-- Author : O.Couet
-*
-*::> VERSION 1.14/13 920703 13.06
-*
-* New routine ixrscwi in x11int to rescale a X11 window.
-* IGMESS is now able to resize the message window if necessary.
-* New routine IPM3ID to store identifiers for each point of a 3D
-* polymarker.
-* New version of the MSDOS driver.
-*
-*::> VERSION 1.14/12 920630 17.21
-*
-* Mods in IGTABL: In case of colored Legos or Surfaces, if the
-* color levels are not initialised, it is now done automatically.
-* (Mariapia.Pascarella at crs4.it).
-*
-*::> VERSION 1.14/11 920630 16.19
-*
-* New workstation transformation management. For the time being
-* it is implemented only for the X11 driver.
-* First version of the MSDOS driver (fine at main2.jinr.dubna.su).
-* To install HIGZ with this driver the following PATCHY
-* selections are needed:
-* +USE,*HIGZ,MSDOS
-*
-*::> VERSION 1.14/10 920623 16.07
-*
-* The definition of VAL in IGSET has changed if PNAME='2BUF':
-* VAL=10*(WKID)+(double buffer mode: 1.=on 0.=off)
-* This implies also changes in ixs2buf (X11INT).
-* Changes in *HIGZ and IKBOX for MACMPW.
-* New clipping mechanism in the X11 interface. The routines IXCLIP
-* and IXNOCLI need now the window identifier as input parameter.
-*
-*::> VERSION 1.14/09 920610 10.04
-*
-* Some improvements in the MAC driver. To install HIGZ with this
-* driver the following PATCHY selections are needed:
-* +USE,*HIGZ,MACMPW,machinename
-* Mod in ixreqlo in x11int for B&W screens.
-* MACPLO and FCLEVL are renamed into IMACPLO and IMACEVL in the
-* MacIntosh driver.
-* New version of ixupdwi (X11INT) calling XSync (Cees de Laat).
-*
-*::> VERSION 1.14/08 920519 17.17
-*
-* Changes in the X11 interface:
-* - IXGETGE returns the Display size if IWID<0.
-* - New routine IXGETPL to return the number of planes.
-* - IXUPDWI has an input parameter in order to raise or not
-* the current graphics window.
-*
-* First version of the MacIntosh driver (Cees de Laat).
-*
-* Mods in IXREQLO, in sample mode it return:
-*
-* 11 = left is released
-* 12 = middle is released
-* 13 = right is released
-* -1 = nothing is pressed or released
-* -2 = leave the window
-*
-* This is also available in the X11 version of IRQLC.
-*
-*::> VERSION 1.14/07 920513 12.02
-*
-* New version of the double buffer for X11. Now it works on several
-* windows. The changes done previously (see version 1.14/05) in the
-* routines ICLRWK, IUWK and the sequence HI2BUF are not necessary
-* as the work is now done by the C routine IXS2BUF.
-*
-*::> VERSION 1.14/06 920506 9.59
-*
-* Few mods in the PostScript driver for US format (Lee Roberts).
-* New routine to write a pixmap in a bitmap file: IXWRPX
-* Mod in IGRSIZ if the double buffer is on.
-* Bug corrected in IZPM. A declaration was after a DATA statement.
-* Mods in IZDIPI and IGCLES in order to avoid wrong PostScript files
-* in the context of STYLE GP in PAW.
-* Mods in IGTABL, IGTAB2 and IGTAB6 in order to plot the contour and
-* the nodes of the surfaces in the middle of the histograms bins.
-* Protection added in the FALCO driver (routine IGSG in IKERNEL).
-*
-*::> VERSION 1.14/05 920414 10.03
-*
-* Nothing is done in the routine ixupdwi (DECK X11INT) if a
-* pixmap is opened.
-* First implementation of the double buffer with the X11 driver.
-* This implies a new sequence HI2BUF and new routines in the
-* C X11 driver (ixclrpx, ixswapx). To set on or of the double
-* buffer it is enough to do:
-* CALL IGSET('2BUF',1.) or CALL IGSET('2BUF',0.)
-* Note that CALL IGSET('*',0.) don't reset the double buffer off.
-* Bug corrected in IZCDA, the number of real attributes was not
-* correctly compute (REDMOND at CERNVM).
-*
-* American paper sizes in the PostScript driver are now available.
-* The PostScript specifier is of the form:
-*
-* -[Format][Nx][Ny][Type]
-*
-* 3 new values of Format are now available:
-*
-* 100 ==> 8.5x11 inch
-* 200 ==> 8.5x14 inch
-* 300 ==> 11x17 inch
-*
-*::> VERSION 1.14/04 920401 14.01
-*
-* Correction in x11int, the declaration "int Motif=NULL" has been
-* changed to "int Motif=(int)NULL" for IBM/VM.
-* Correction in the routine IPDEF (PATCH IPOST) to prevent too long
-* PostScript file names.
-*
-*::> VERSION 1.14/03 920319 14.38
-*
-* If an external_window (motif) is required (X11 interface) the border
-* width used is 0 in XCreateWindow.
-* In the X11 interface a new graphics context (gcpxmp) is used for
-* the pixmap management.
-* In the routine IGRSIZ, used to redraw the current picture, pixmaps
-* are used in order to avoid to see the drawing.
-* If a motif window is required (X11 interface) the XCloseDisplay is
-* not performed.
-* Mods in x11int in order to release the unused fonts.
-*
-*::> VERSION 1.14/02 920312 17.29
-*
-* Mods in IGTABL:
-* - NCOL is reset after the drawing of a Gouraud shaded surfaces.
-* - For the 3D plots, if PAR(11) = 0 the axis are not drawn.
-*
-*::> VERSION 1.14/01 920310 18.39
-*
-* Bug corrected in IGTAB6. The end of the DO-LOOP number 10 was
-* misplaced.
-* Mods in IPM3 and IPL3 in order to plot a non limited number
-* of points.
-*
-*::> VERSION 1.14/00 920228 17.54
-*
-* The clipping can now be controlled with the routine IGSET.
-* New routine IGPXMP to control the X11 pixmaps. This routine is just
-* dummy if HIGZ is installed without X11.
-* New option 'P' (post structure) in IGSTR.
-* New PHIGS routine (for NT/PLOT) IATR3, IGPARF, IGPHSL and IGPHST.
-* Correction in the PostScript boxes clipping (IZBOX).
-* The GL version of IUWK call now GFLUSH
-* (Lee Roberts SSCVX1::LROBERTS).
-* New routine ixwipx to save a part of the current open window in a
-* preopen pixmap. This functionality is available in IGPXMP under
-* the option 'S'.
-* New version for the PostScript marker 30 (m30) (P.Juillot).
-* New logic to compute the color map for the option S4 in IGTABL.
-* The basic color used is the current fill area color index.
-* IGTAB4 is now able to draw the background of the 3d plots.
-* Correction in IGSA (IGKS) GUESC001 is now called with IWK
-* (W.Koellner, LBL).
-* Mods in the PostScript drivers. New Structuring comments are
-* introduced: %%Pages: atend, %%EOF, %%Trailer, %%Page. This
-* is useful for some PostScript previewers, for example
-* 'pageview' on SUN workstations.
-*
-+DECK,V1_13.
-*CMZ : 09/02/95 15.51.10 by O.Couet
-*-- Author :
-*
-*::> VERSION 1.13/08 911204 17.14
-*
-* New routines to create and display pixmaps in X11INT:
-* ixopnpx : create a new pixmap
-* ixclpx : close the current opened pixmap
-* ixcppx : copy a pixmap to the screen
-* Modification in ixopndsp: the variable lenhst was not tested as
-* a pointer.
-* Change in X11INT, if the line width is 1, 0 is used (for speed).
-*
-*::> VERSION 1.13/07 911114 14.14
-*
-* Modification in IZPUSH in the use of MZNEED.
-* Mods in IGTABL. The drawing of axis for the 2D representation is
-* implemented.
-* Protection added in IGTABL if the subrange of the matrix to be
-* plotted is not correct.
-* Correction in IGRTOH, the light parameter was not at the right place
-* IGERR use now LUNERR to print the error messages. If LUNERR is not
-* equal to 6, the error message are printed in the file "higz.err".
-* Change in IGQWK in the DECGKS workstation type test (brock at cernapo)
-* Bug fixed in IGTABL. In case of option 'R' with a subrange, the plot
-* was misplaced.
-*
-*::> VERSION 1.13/06 911024 10.56
-*
-* New fill area style indices in the X11 interface (1-9).
-* ixsetfas has now two parameters.
-* Correction in IZPM for the PostScript marker size.
-* New Graphics Context "echo" in the X11 interface for input echo.
-* New function "setinput" to enable or disable the inputs in X11
-* windows (mods in X11INT). This function is used in ixreqlo
-* and ixreqst.
-* Mod in IGHATC to have continuous hatches between two different
-* fill areas (Chuck Parsons MIT).
-*
-*::> VERSION 1.13/05 911017 10.13
-*
-* Entry point ixflpat removed from X11INT.
-* Correction in IPDEF: a "stroke" was missing in the PostScript
-* macros "m2" and "m5".
-*
-*::> VERSION 1.13/04 911015 9.44
-*
-* First version of the $KUMACS PATCH.
-* Mods in IGAXIS. NCAR is now a parameter and the variable IAZ was
-* not used (F.Carminati CN/AS).
-* Mods in IGQWK. IWT was not used (Cf APOLLO compiler with -info 4).
-* Changes in X11INT to avoid to trap the event outside the routine
-* ixreqlo. This is useful for Motif applications (N.Cremel CN/AS)
-* Corrections for IBM/VM in X11INT: some NULL was not correctly
-* defined (Wojciech Wojcik <WOJCIK at FRCPN11.BITNET>).
-* Correction in IPDEF on VAX/VMS: the macro "mb" was not correct.
-* Correction in IPTEXT. If the last character of a text was a "\"
-* nothing was printed.
-*
-*::> VERSION 1.13/03 911003 17.44
-*
-* Changes in the drawing of markers in the PostScript interface.
-* The marker 1 to 5 and 20 to 31 are now drawn via PostScript
-* macros:
-* 1) The aspect of markers, in particular for the types 20,21,22,23 and
-* 29, is better because they are fully black.
-* 2) The size of the PostScript file has reduced and doesn't depend
-* on the marker type.
-* N.B. The PostScript macros "mk" and "circ" are now not used so
-* they are suppressed from the PS file.
-*
-*::> VERSION 1.13/02 910930 12.02
-*
-* Some improvements in the "font-loading" for X11. The routine
-* ixsettf can be now use just to see if a font exist.
-* Some modifications to IPINIT, IPLTYP, and IPTMAC to fix a problem
-* when printing several pages in a LaTeX metafile. (A.Nathaniel)
-* The full A4 page can now be used in encapsulated LaTeX
-* metafiles. (A.Nathaniel)
-* Flag ALLIANT introduced (Curtis A. Meyer <cmeyer at physik.unizh.ch>)
-*
-*::> VERSION 1.13/01 910918 18.03
-*
-* Bug corrected in IGAXIS on HP: the "0" was not drawn.
-* MZNEED is now called with option 'G' in IZPUSH.
-* Change in IXGETGE: The window ID is an input parameter
-* to avoid to activate the window before getting the size.
-* IXCLRWI call now XFlush.
-* New option Z in IGTABL to display the Z scale with option COL.
-* A new routine IGCOLM has been introduced.
-*
-*::> VERSION 1.13/00 910827 12.18
-*
-* New PostScript macro "circ" to draw circle marker.
-* gethostname removed from x11int (now in cspack).
-*
-* IPSC/860 version introduced (Lee Roberts) flag IPSC
-*
-* Changes in HIGZEX: PSCRIPT flag is now used.
-* Bug corrected in IRQLC and IGRNG in PATCH IGKS for the
-* DECGKS version (Chuck Parsons MIT).
-*
-+DECK,V1_12.
-*CMZ : 09/02/95 15.51.10 by O.Couet
-*-- Author :
-*
-*::> VERSION 1.12/16 910816 18.22
-*
-* Protection added in IPM (IKERNEL) if N > IBUFSI.
-*
-* Important rewrite of the PostScript interface, and introduction
-* of new features to divide the paper in several zone. This work
-* has been done with the help of P.Juillot (CRN Strasbourg).
-* The PostScript workstation types have now the following format:
-*
-* -[Format][Nx][Ny][Type]
-*
-*::> VERSION 1.12/15 910717 18.20
-*
-* Clean up in the PostScript procedures defined in IPDEF (P.Juillot).
-* The comment %%Title in PostScript gives the name of the file.
-* 2D PHIGS interface introduced.
-* MOTIF flag no more needed.
-* Mods in IEARC (Valery Fine).
-* Clipping of the software polymarkers (20-31) implemented.
-* Some improvements in the creation and displaying speed of pictures.
-* New version of the functions IXWCDC and IYWCDC for X11
-* to avoid overflow problems on VAX/VMS.
-*
-*::> VERSION 1.12/14 910627 11.43
-*
-* Mods in the FALCO driver in IKBOX and IFA. IGSA is called in IACWK
-* in case of 7879.
-* Two new routines for Motif: ixgetwi to retrieve the X11 window id
-* of a given workstation, and IGDRPI to redraw the current picture
-* if it exists (useful when the window is resized).
-* Bug corrected in IPFOUT if the number to be printed in the PS file
-* is 0
-* Mods in IGRNG (IG) for ATCGKS. IERR=22 instead of 31 (W.Koellner)
-* New options in IGPIE.
-* H : To force the labels size to be the current character height.
-* R : To draw the labels align on the radius.
-* Mod in IGTABL in the contour plot drawing. In case of a given set
-* of altitudes the drawing was wrong (ICONT=12 instead of 11).
-*
-*::> VERSION 1.12/13 910605 11.30
-*
-* FLAG MOTIF introduced.
-* New routine IGMESS to print a message in a X11 window.
-* Correction in ISCR (IKERNEL) to update the colors if the color
-* change is already use.
-* Protection added in IGAXI3 if the number of division is < 2.
-* Improvements in the usage of the X11 fonts (routine IKFNTX).
-* CALL IGSA remove for the FALCO driver in IACWK (L.Tremblet).
-* Changes in the PostScript driver to reduce the size of the
-* tables with option COL.
-* Some variables are now in DOUBLE PRECISION in IGHATC to avoid
-* missing hatches (A.Michalon).
-* Mods in HIGZEXAM for IBMVMS.
-* New option DRMD in IGSET to change the drawing mode of graphics.
-* New option SYNC in IGSET to allow to set the Synchronization on or
-* off in the X11 driver.
-* FLAG BATCH to generate HIGZ only with ZEBRA and PostScript:
-* *HIGZ,BATCH,machinename.
-*
-*::> VERSION 1.12/12 910503 17.55
-*
-* NCAR is now set to 5 is IGAXIS because of rounding problem on IBM if
-* it is equal to 6.
-* host_name has now a length of 64 characters in X11INT (B.Stone).
-* Mod in IPINIT: The line in the LaTeX file -778 is now 80 for IBM/VM.
-* New options 'S' and 'R' in IGZSET to Save and Restore the state of
-* the 'G' and 'Z' flags.
-*
-*::> VERSION 1.12/11 910425 12.27
-*
-* Protection added if the X11 fonts are not available (ITX, IKFNTX).
-* One line removed in HIEX3. It was drawing a text outside the screen.
-* New C routine "ixbox" to draw boxes faster (3x) with X11.
-* Flag PSCRIPT added in IGBOX, ICLRWK, IFA, IPL, IPM, ISELNT and ITX
-* in order to install HIGZ without ZEBRA but with PostScript.
-* Correction in IGRAP1: if it was called from IGHIST with option F
-* the fill area was not drawn.
-* Marker type "dot" added in the FALCO driver (Lee Roberts).
-* Mods in IGRAP1 to allow both the drawing of contour and the drawing
-* of function with X in increasing order.
-* IGTERM call now IUWK with control FLAG equal to 1 (useful for GKS).
-* X11 windows are now created with a border width of 1.
-* Mods in IGTABL to allow to plot flat distributions (ZMAX=ZMIN).
-*
-*::> VERSION 1.12/10 910409 15.22
-*
-* Protection added in IKFILE (IKERNEL): an INQUIRE is done on the
-* higz_windows.dat to avoid an error on IBM/VM when it is
-* opened in 'OLD' mode.
-* GCGTOA and GCATOG are now called in IGSA and IGSG in the GKSGRAL
-* version for APOLLO.
-* IRQLC is now able to do the sample mode for X11
-* The C routine "ixreqlo" is completely new. It provide now several
-* prompt echo types and the sample mode.
-* The decwindows flag is now suppressed in X11INT.
-*
-*::> VERSION 1.12/09 910402 16.36
-*
-* Protection added in ISWN (IKERNEL) if the range of the window
-* is not correct.
-* Bug corrected in IGAXIS (IG) when (WMAX-WMIN)/N1A less than 0.001
-* Some corrections in the FALCO driver (ICLRWK, IOPWK and IGQWK)
-*
-*::> VERSION 1.12/08 910328 15.49
-*
-* New PATCHY flag NOVERS to avoid the printing of the version number
-* in the routine IOPKS (PATCH IKERNEL).
-* New routine IGASCI to return the ASCII code of one character.
-*
-*::> VERSION 1.12/07 910322 10.22
-*
-* The routine IKFNTX (to set the X11 fonts) is now access in ITX.
-* The routine IKFILE call now the KERNLIB routine GETENVF for UNIX
-* and CRAY instead of GETENV.
-*
-*::> VERSION 1.12/06 910315 17.00
-*
-* Protection added in the macro "mk" of the PostScript driver (s)
-* Bug corrected in IKFILE if the file "higz_windows.dat" is in the
-* Current directory.
-* All the Adobe fonts are now available in the X11 interface with
-* variable heights.
-*
-*::> VERSION 1.12/05 910307 17.06
-*
-* Mod in IMWRIT (PATCH IMAIL) in case of UNIX the 1X is not use
-* in the FORMAT.
-* Mods in IGQ (IG) flag SGI replaced by GL.
-* The following GKS entry points are available in the PATCH IKERNEL:
-* GACWK,GCLKS,GCLRWK,GCLWK,GDAWK,GFA,GOPKS,GOPWK,GPL,GPM,GRQLC,
-* GRQST,GSCHH,GSCHUP,GSCLIP,GSCR,GSELNT,GSFACI,GSFAIS,GSFASI,GSLN,
-* GSLWSC,GSMK,GSMKSC,GSPLCI,GSPMCI,GSTXAL,GSTXCI,GSTXFP,GSVP,
-* GSWKVP,GSWKWN,GSWN,GTX,GUWK
-* Mods in the Latex driver in markers and text (A.Nathaniel)
-* Mods in the X11 interface for IBM/VM. The concerned routines
-* are: IOPWK,IKFILE (IKERNEL) and X11INT (HIGZCC).
-*
-*::> VERSION 1.12/04 910228 14.22
-*
-* Changes the the HIGZ examples (HIEX2) DO loop on IGTEXT go
-* now up to 45 (A. Johnstad SSC).
-* New workstation type 7879 for xterm (A.Nathaniel).
-* Minor mods for ATC/GKS Version (W.Koellner)
-* Changes in the LaTeX driver to support boxes (A.Nathaniel)
-*
-*::> VERSION 1.12/03 910218 15.31
-*
-* Changes in Pilot patch *HIGZ for automatic selection of IBM.
-* For ATCGKS the default metafiles names in IGMETA are in lowercase.
-* Mods in IGWKTY for AIX370.
-* Mods in x11int for CRAY the X11 includes were missing.
-*
-*::> VERSION 1.12/02 910215 9.50
-*
-* New version of the routine IPTMAC to avoid the "overfull hbox"
-* in the LaTeX interpretation.
-*
-*::> VERSION 1.12/01 910214 15.25
-*
-* Correction in IFPUT (patch IFALCO) "SAVE BOUT" was missing.
-* Mods in the LaTeX driver to allow to have several plots in the
-* same file (-778).
-*
-*::> VERSION 1.12/00 910212 12.24
-*
-* Mods in X11INT (in the routine setcolor) for B&W (F. Marabelle)
-* FALCO interface introduced. To install use:
-* *HIGZ,FALCO,machinename.
-* This interface can be install with X11.
-* The workstation type is 7878.
-* Correction in IPDEF. Centering problem with -111.
-* New C DECK FALINT in PATCH HIGZCC to do the HIGZ/FALCO interface
-* on the UNIX machines (L. Tremblet ECP/DS).
-* New flag HPUX introduced for HP-Unix.
-* Correction in the X11 version of request string.
-* Mods in IOPWK and IGSSE for SUNGKS (Lee Roberts).
-* Mods in IHWL02 to fix rounding problems (Steve Gensler).
-* New metafiles type -777 and -778 to output encapsulated
-* LaTeX pictures (-777) and LaTeX picture (-778) (A.Nathaniel).
-* This implies changes in IGINIT,IZBOX,IZCLRD,IZFA,IZPL,IZPM
-* IZSELN,IZTX,IPDRAW,IPINIT, and IPSCOL and the creation of the
-* new routines IPDLIN,IPJOUT,IPLTYP,IPTLIN,IPTMAC, and IPTTEX.
-* Implementation of marker types 2..5 for X-Windows in IPM,ISMK
-* of IKERNEL
-* New PostScript workstation type -114 and -115 for portrait and
-* landscape color printer (the vertical translate is bigger).
-* Improvements in text alignment and line types in the X11 interface.
-* New variable CHMETA (metafile name) introduced in HIMETA
-*
-+DECK,V1_11.
-*CMZ : 09/02/95 15.51.10 by O.Couet
-*-- Author :
-*
-*::> VERSION 1.11/07 901214 16.28
-*
-* Mods in IGRAP1 to draw closed curves
-* IGRAP1 use the COMMON HIARC for working space
-* Mods in the routines IGARC* in order to use the COMMON HIARC
-* Changes in the metafiles management in the ATCGKS version
-* (W.KOELLNER). This implies mods in the routines IGSSE,
-* IGMETA, and IGRNG in the PATCH IG.
-* Flag AIX370 introduced in IGWKTY (PATCH IG)
-* The COMMON HIARC is replace by:
-* COMMON /HIGRAF/NGRAF,XGRAF(503),YGRAF(503) in order to be
-* accessible in a COMIS program
-* New option 'F' (for Fill area) in IGRAPH. 'FC' is also possible
-*
-*::> VERSION 1.11/06 901207 11.22
-*
-* Changes in IGTABL to define via PAR(2) the color of a contour plot
-* In IGRAPH the protection on the "increasing order" for curves
-* is removed
-*
-*::> VERSION 1.11/05 901203 10.38
-*
-* The IXCRLWIN (Patch HIGZCC) call now "XSetWindowBackground" to
-* the color 0 as background color
-* Change in IZPICT: In case of addressing picture by number, the
-* conversion between CHARACTER and INTEGER in done by IZCTOI
-* and not with an internal READ (problem on the VAX)
-*
-*::> VERSION 1.11/04 901129 11.01
-*
-* The line width acts now on the line type 13, 14 and 15. This
-* implies mods in: /IKERNEL/IPL, /IGKS/IPL, /IGMR/IPL, and
-* /IDI3000/IPL
-* New logic to specify the Display_Name with X11:
-* The routine IGWKTY can get (with X11) a workstation type like:
-* "n.hostname" where "n" is the line number in the file
-* higz_windows.dat and "hostname" the name of the machine on
-* which the graphics is displayed. This facility avoid to define
-* the variable DISPLAY before using HIGZ.
-* o If the one gives to IGWKTY a workstation type like "n.hostname",
-* the "hostname" is written at the end of the line "n" in
-* higz_windows.dat.
-* o If one gives the workstation type "n" and if a "hostname" is
-* present on the line "n" in higz_windows.dat, the graphics goes
-* to the machine "hostname".
-* o If one gives the workstation type "n" and if a "hostname" is NOT
-* on the line "n" in higz_windows.dat, the graphics goes to
-* the machine define by the variable DISPLAY.
-* o If one gives the workstation type "n." and if a "hostname" is
-* present on the line "n" in higz_windows.dat, the graphics goes
-* on the machine define by the variable DISPLAY and "hostname" is
-* removed from the line "n" in higz_windows.dat.
-* This implies mods in IGWKTY (IG), IOPWK (IKERNEL) and X11INT (HIGZCC)
-* in which a new routine has been created: IXOPNDSP
-* In IGQWK, IDTY is replace by IGIWTY(IWKID) in case of GKS
-*
-*::> VERSION 1.11/03 901126 17.04
-*
-* The routine IKBOX (PATCH IKERNEL) is activated only if
-* "GL" or "GPR is selected.
-* Changes in the C interface to X11: all the C routines with
-* a character string as input parameter (IXOPNWIN, IXSETTFN,
-* IXTEXT) have now one more input parameter: the string length.
-* This imply also changes in the routines IOPWK, IACWK, ISTXFP,
-* and ITX in the PATCH IKERNEL.
-*
-*::> VERSION 1.11/02 901123 10.15
-*
-* Correction in fill area in the X11 interface: in case of hollow
-* mode the polygon was not closed.
-* Bug fixed in IGTABL in case of stacked LEGO with hidden line
-* removal (the minimum was not good).
-* Correction in IPDEF (PATCH IPOST) in case of PostScript file
-* -112 the centering was not good.
-*
-*::> VERSION 1.11/00 901107 14.09
-*
-* ATCGKS version introduced by: Werner KOELLNER, LBL
-*
-* To install it do:
-* +USE,VAX,ATCGKS,*GKSGRAL. On VAX/VMS
-* +USE,SUN,ATCGKS,*HIGZ. On SUN
-*
-* In IPINIT the first line of a PostScript file is now :
-* %!PS-Adobe-2.0
-* %!PS-Adobe-2.0 EPSF-2.0 for encapsulated PostScript
-* Option LOGX and LOGY in IGTABL
-* ZMIN and ZMAX available for all option of IGTABL
-* Request locator and clipping in the GDDM driver
-* The marker "point" in PostScript (mk) is now done with an arc
-* Correction for Black and White devices in X11 interface:
-* Background and Foreground colors were inverted
-* Changes in the DECGKS version (IOPWK, IGQWK, IGRNG) to
-* distinguish between DEC-Windows workstation types and
-* non-windows types by assuming all workstation types at
-* or above 200 are DEC-Windows.
-* Check on the "Server Vendor" in the X11INT (patch HIGZCC)
-* New flag BSLASH (different from UNIX) to replace "\" by "\\"
-* Mods for 3.2 Version of ATCGKS.
-* New PATCH IH for hidden surfaces and hidden lines drawing.
-* Bug corrected in IGHIST: In option C the center of each is used
-* New driver for encapsulated PostScript (-113)
-* The date of creation and the version of HIGZ are now printed
-* in PostScript to follow the Adobe conventions.
-* Protection add in PostScript driver if an error in writing occurs
-* Mods in IXLINE (X11INT) if the number of points is 1 XDrawPoint
-* is used (F.Marabelle SACLAY).
-* The PostScript plot are now centered on the page with WKTYPE
-* equal to -111 or -112
-*
-+DECK,V1_09.
-*CMZ : 09/02/95 15.51.10 by O.Couet
-*-- Author :
-*
-*::> VERSION 1.09/00 891219 15.24
-*
-* Bugs corrected in IZHIST in case of not equidistant bins
-* Correction for CRAY in IGSET (NINT used in TXAL)
-* Correction in IUWK (PATCH IGKS) to call IPUWK even if GFLAG=.FALSE.
-* New version of clear for PostScript (see IZCLRD)
-* Accents are available in PostScript
-* New PostScript metafile type -2xx with 132 characters per lines
-* Telnetg : Protections added in IMFIN and IMFOUT (if XMIN=XMAX)
-* Bug corrected in IPINIT (CALL IZSELN is added)
-* In IGTABL, the contour plot can now drawn a given set of altitudes
-* Changes in IGTABL to allow scaling change on Lego plots
-* New routine IPTEXT (called by IZTX) in PATCH IPOST to draw the
-* PostScript text like IGTEXT if 0 < Font < -25 and Precision = 1
-*
-+DECK,V1_08.
-*CMZ : 09/02/95 15.51.10 by O.Couet
-*-- Author :
-*
-*::> VERSION 1.08/00 891011 14.13
-*
-* Bugs corrected in contour plot (routine IGTABL)
-* Option LOG on Z-axis is available in IGTABL
-* New fill area style index available (> 100 see routine IGFA)
-* IGARC6 deleted (obsolete)
-* New routine IZOPEN to open a picture file
-* Clean up in IGSA and IGSG (PATCH IDI3000) for VAX version
-* IGWKTY has been modified for DEC-GKS to use the logical name
-* GKS$WSTYPE to obtain the default workstation type for
-* DEC-GKS. This logical name is provided by DEC and, in case of a
-* default workstation selection, is used by DEC-GKS anyway. In case
-* of a problem with the GKS$WSTYPE logical name translation, the
-* workstation defaults to a monochrome VT240. (Similar to DEC's
-* default selection described on page 4-43 of the DEC GKS Reference
-* Manual). This code provides DECwindows as the default device on
-* a DECwindows workstation and VWS as the default device on a VWS
-* workstation.
-*
-+DECK,V1_07.
-*CMZ : 09/02/95 15.51.10 by O.Couet
-*-- Author :
-*
-*::> VERSION 1.07/01 890922 11.03
-*
-* Protections in request locator (IRQLC and IGINIT)
-* Bugs corrected in IGAXI0 and IGAXI2 in case of very large labels
-* MASK=MSBIT(xxx,xxx,xxx) replaced by CALL SBIT(xxx,xxx,xxx) in
-* IGSATT of HIGZ/GMR
-* CALL IUWK(0,0) update all the workstations
-* New routine IGTERM in PATCH IG
-* PATCHY flag WINDOWS introduced (+USE,DECGKS,WINDOWS)
-* New version of IGRAPH and IGHIST without ZEBRA.
-* Option MAIL take care with IGTERM
-* PATCHY flag WINDOWS introduced in IGWKTY
-* New option 'K' (Key) in IGPAVE
-* New option 'D' (Delete) in IGPAVE (useful for IGMENU)
-* New routine IEGRID to draw the grid in the graphics editor
-* Bug fixed in IZMERG if the picture contains only NT=0
-* New routine clipping routine IGCLIP (in IG) using Cohen-Sutherland
-* clipping algorithm (now used by IPDRAW in IPOST).
-* New IGVOLU (volume orientation inside WC)
-* Mods in IGICOL IGWKTY and IGRNG for DECGKS
-* New PostScript workstation type -113 without 'translate' and
-* with the bounding box.
-* New routine IGTABL to draw all kind of tables representation
-* New routine IZTABL to store IGTABL in picture
-*
-*::> VERSION 1.07/00 890601 10.56
-*
-* Improvement of the axis labeling optimization (IGAXIS and IGAXI0)
-* New workstation types for DECGKS and GK2000 introduced in IGWKTY
-* New version of IZCOPY (without using MZCOPY)
-* X Factor and Y Factor added in GED grid
-* PATCHY Flag SUN and SUNGKS introduced in IGWKTY
-* Mod in IZPICT (option 'L': the active picture is noted)
-* CALL IZPICT('*','S') Delete all pictures in memory
-* CALL IZPICT('*','D') Display all pictures in memory
-* CALL IZPICT('*','M') <==> CALL IZPICT(' ','M')
-* IQUEST(1) is set to 1 in IGERR
-* If PNAME='*' in IZOUT all picture in memory are stored on disk
-* If PNAME=' ' in IZOUT the current picture in memory are stored on disk
-* If PNAME='*' in IZIN all picture on disk are put in memory
-* Option 'A' in IZPICT. Combined with 'L' it provide the full listing
-* Pictures in memory could be addressed by number this implies
-* Mods in IZPICT, IZCOPY, IZGED and IZMERG.
-* Generic functions introduced (LOG10, MAX, MIN etc ..)
-* New versions of IGTEXT for CONVEX and SUN.
-* Protection in IZIN if the CWD is not a picture data base
-* New 3D version: Cuts are implemented
-* 2 New routines for 3D IGPINT and IGCCYL
-* Mods in HIGZ/GMR in routines: IGDRAV,ICLRWK,IDAWK,IOPWK,IPL
-* IRQLC,IGSATT,IGSEGM,IGVIEW,IGPICK
-* DPINIT,GMINSERT,GMSPRIO,GMRBAND
-* GMPECHO,GMTRANB1
-* New options 'GX' and 'GY' (for LOGX and LOGY) in IGHIST and IGRAPH
-*
-+DECK,V1_06.
-*CMZ : 09/02/95 15.51.10 by O.Couet
-*-- Author :
-*
-*::> VERSION 1.06/07 890405 17.53
-*
-*
-* New version of IGMENU for SUNGKS
-* Bug corrected in IZBOX in the stored of PLCI
-* New version for GMR3D, implies mods in HICDES, IGSSE and
-* IGDIME. New version of IGMR
-* New Macro primitive IGPAVE to draw "paving blocks"
-* Mods in *GMR (IGMR3D replaced by 3D)
-* New options in the routine IGQWK (used in IGMETA and IGEND):
-* ACTI to inquire if a workstation is active
-* OPEN to inquire if a workstation is open
-* New option 'S' in IGPAVE
-* New routine in IGWKTY (PATCH IG) to read the workstation type
-* from the standard input.
-* New features in IGSEGM (DEL *, VISI * etc ...)
-*
-*::> VERSION 1.06/06 890316 16.20
-*
-*
-* Protection in IZIN if PNAME is already in memory
-* Numerous and significant corrections to P=IDI300
-* Bug corrected on PATCHY FLAG selection on DECK IZFBOX
-* and MAIL option introduced in *DI3000
-* HIGZ version for SUN:
-* - PATCHY FLAG "SUN" and "SUNGKS" introduced
-* - HIGZ/SUN version is generated by:
-* +USE,*SUNGKS.
-* +EXE.
-* +PAM,11,T=CARDS,T=ATTACH .higz.car
-* +QUIT.
-* New features in HIGZ-3D:
-* - New shapes in IGVOLU (PCON and PGON)
-* - New routine IGFR3D (in IG) to convert 3D to 2D
-*
-*::> VERSION 1.06/05 890302 12.56
-*
-* First version of graphics input and error recovering
-* with option MAIL
-* More compact way to send the data in option MAIL
-* New option DIME in IGSET (Mods in IGINIT IGSET and ISELNT)
-* New 3D routines (IGVOLU, IGROTM, IGDRAW, IGDRAV and IGTRAN)
-* in the patch IG
-* New attribute NLIN for the 3D shapes (number of lines)
-* Any window size is now take into account by IMINT and telnetg
-* Grid size initialized to 20x20 in IZGED
-* Complete IGMENU in MAIL option
-*
-*::> VERSION 1.06/04 890217 10.36
-*
-*
-* New option 'I' in IGMENU (Input mode)
-* New MAIL option (connected with TELNETG).New PATCH IMAIL
-* and new PATCHY FLAG: MAIL. The MAIL option is now tested
-* with APOLLO, VAX and IBM sending graphics to an APOLLO
-* with a square graphics window. this version contains only
-* the graphics outputs.
-*
-*::> VERSION 1.06/03 890124 15.46
-*
-* Mods in IZDNB and IZPICK to allow the translation of polyline and
-* Fill Area in the graphics editor
-* The command GRID is available in IZGED (with sampled locator input)
-* UNDO impossible on the first state of a picture
-* The command FRONT is available in IZGED
-* Mods in the PostScript driver (to use -112 several times in the same file)
-* Mods in IGEND to close correctly the OPEN and ACTIVATE workstation.
-* Mods in IGAXIS in case of labels 10xn (if X0 .EQ. X1)
-*
-+DECK,V1_05.
-*CMZ : 09/02/95 15.51.10 by O.Couet
-*-- Author :
-*
-*::> VERSION 1.05/00 881222
-*
-* New version of IGKS3D.
-* New Fonts in the PostScript Driver (-15/0 to -24/0)
-* GFLAG and ZFLAG introduced in IGKS3d routines
-* New routine IGQ
-* Routine IGCLES move from the PATCH GED to the PATCH IG
-* Mods in IPINIT an IZTX to center and align the PostScript text
-* IGAXIS grid are drawn on the positive side of the axis.
-* New version of the MENU package (connected with KUIP)
-* Changes in IZHATC, in IGMETA
-* Changes in IZIN to access the picture by number
-* The pictures have now a maximal name length of 20 characters
-* New data structure to manage the attributes (new routine IZATT new HIATT)
-* The 24 routines to store the attributes in pictures are replaced by IZATT
-* Mods in GED: Better user interface
-* Routine IZSFA suppressed
-* CHOPT initialize to ' ' in the decoding of IGAXIS, IGHIST
-* New routine IGQWK
-* The range of an INTEGER attribute is now -100001<IATT<900000
-* (the old range was -501<IATT<900500)
-* New PATCH IDI3000
-* Mods in the PostScript part of IZPL in case of 12<ILN<15
-* Mods in IZHIST
-*
-+DECK,V1_04.
-*CMZ : 09/02/95 15.51.10 by O.Couet
-*-- Author :
-*
-*::> VERSION 1.04/00 881104
-*
-* New routine IUWK
-* Changes in IGRNG (call to IUWK)
-* IPM changed to GPM in routine IPL (recursivity from IPM)
-* Bug corrected in IZSCHU.
-* DECGKS version introduced.
-* PostScript Interface introduced (-111=Portrait -112=Landscape).
-* Character height and position of the PostScript Font are OK.
-* Minor bugs corrected.
-* Bugs corrected in IZGED in order to be called in STYLE G of PAW
-* The alphanumeric axis labels are now stored in the ZEBRA structure
-* The clipping is supported in the PostScript interface
-* The menu position in IGMENU are given in % of the screen size
-* Improvement in IGMENU and IZGED (Menu FILES introduced).
-* Line width introduced in IZGED
-* Bug corrected in IGAXIS in case of NDIV.LE.3
-* Bug corrected in IGSET if AWLN<0
-* Error with a local ZEBRA link corrected in IZGED
-* Bug corrected in IZLBL
-* New option 'M' in IGAXIS
-*
-+DECK,V1_03.
-*CMZ : 09/02/95 15.51.10 by O.Couet
-*-- Author :
-*
-*::> VERSION 1.03/00 880906
-*
-* Changes in IGINIT and IGEND
-* Structure for GMR,UISDC,DI3000 versions introduced.
-* New patches IGKS,IGMR,IGKS3D
-* New PILOT patches for master versions.
-* ZEBRA flag introduced (if Z option not wanted)
-* The new attribute: Axis Wire Length is reachable via IGSET
-* PATCH,HIGZEXAM introduced
-*
-+DECK,V1_02.
-*CMZ : 09/02/95 15.51.10 by O.Couet
-*-- Author :
-*
-*::> VERSION 1.02/00 880420
-*
-* 27/03/87 New version of IZMERG the option 'D' is available
-*
-* 27/03/87 The routine IRQLC fills the COMMON /QUEST/ with the window
-* and viewport parameters. For more precision see the comments
-* at the beginning of the routine
-*
-* 30/03/87 New version of IGAXIS with beautiful ticks marks and labels
-*
-* 01/04/87 A new version of IZMERG
-*
-* 02/04/87 First implementation of IGRAPH
-*
-* 06/04/87 New format in the option SHOW in IGSET
-*
-* 07/04/87 Correction of IGARC in case of R1=R2 and PHIMIN=PHIMAX
-*
-* 13/04/87 Corrections for IBM/VM
-*
-* 13/04/87 New version of IGRAPH for Fill Area
-*
-* 13/04/87 New picture structure : Control bank.
-*
-* 16/04/87 The routine IGSA is implemented
-*
-* 21/04/87 New internal coding of the control bank
-*
-* 22/04/87 Polyline with two points and marker with one point are stored
-* in a compact way
-*
-* 23/04/87 Line type from 12 to 15 are available . They are independent from
-* the basic graphics package . For this line types the Basic Segment
-* Length may be sets with the routine IGSET
-*
-* 11/05/87 Implementation of the routines IGSG and IGSA for IBM
-*
-* 20/05/87 First version of IGPIE
-*
-* 27/05/87 Modifications for the GTS_GRAL version of GKS
-*
-* 27/05/87 The routine IGRNG is available. This routine maps the workstation
-* window onto the whole screen and select the normalization
-* transformation number 1 according to the XSIZ and YSIZ parameters
-*
-* 12/06/87 Mods in IGAXIS to solve rounding problems for log axis
-*
-* 17/06/87 New error routine IGERR
-*
-* 18/06/87 Bar charts implemented in IGRAPH (option "B")
-*
-* 26/06/87 Changes in routine IGMETA (variable IWTYPE was reset!)
-*
-* 30/06/87 Bug corrected in IZPICT when GFLAG=.FALSE.
-*
-* 02/07/87 Bug corrected when ZFLAG=.TRUE. and GFLAG=.FALSE.
-*
-* 16/07/87 Bars attributes in IGRAPH are now stored in the data structure.
-*
-* 29/07/87 RBOF,RBWD are returned in RQUEST(1) and RQUEST(2) after a call
-* to IGRAPH with option 'B'
-*
-* 06/08/87 Some bugs in IGRAPH are corrected
-*
-* 10/08/87 New version of IGRAPH with new options "L" and "M"
-*
-* 12/08/87 IZGRAP corrected according to the new version of IGRAPH
-*
-* 13/08/87 IGRAPH is now IGHIST (cf. doc) and IZGRAP is now IZHIST.
-* The old option "A" is now the option "F" for "Fill area"
-*
-* 13/08/87 The angle of IGARC are now in degrees
-*
-* 20/08/87 Changes in IGAXIS (temporary variable CHTEMP)
-*
-* 28/09/87 New version of IGAXIS: option I (Integer labeling). Correction
-* in IGSET : BARO can be .LT.0.
-*
-* 05/10/87 The routines IGSA and IGSG have the "Workstation Type" as input
-* parameter.
-*
-* 20/10/87 The routine IZRIOS is replaced by the routines IZIN, IZOUT, IZSCR
-*
-* 28/10/87 This file contains now the PATCH MENU and the PATCH GED
-*
-* 30/11/87 A priority system is available between the normalization
-* transformation. The last selected transformation by ISELNT
-* has the higher priority. In case of overlaping of the
-* transformations the transformations with the higher priority
-* is choosen by IRQLC .
-*
-* 04/01/88 Modifications to IGRAP1. Normalization in X and Y
-*
-* 04/03/88 Mods in the IZ routine (IZHIST)
-*
-* 30/03/88 Bug corrected in IPM
-*
-* 18/04/88 Changes in HICDES to run on CRAY
-*
-* 24/05/88 Mods in IGMETA
-*
-+PATCH,$KUMACS.
-+DECK,HELP.
-*CMZ : 1.19/14 05/10/93 16.00.03 by O.Couet
-*-- Author :
- Macro HELP
-*
- Mess ' '
- Mess ' The installation procedure of HIGZ is:'
- Mess ' '
- Mess ' CMZ -INSTALL HIGZ GRAPHICS_PACKAGE LIB_NAM SRC_DIR OPTIONS'
- Mess ' '
- Mess ' Where :'
- Mess ' '
- Mess ' GRAPHICS_PACKAGE could be :'
- Mess ' GKSGRAL, SUNGKS, MGKS, PLOT10GKS'
- Mess ' UNIGKS, DECGKS, GK2000, ATCGKS'
- Mess ' PHIGS, GL, GPR, X11, GDDM'
- Mess ' FALCO, DI3000, BATCH'
- Mess ' '
- Mess ' LIB_NAM is the library name'
- Mess ' '
- Mess ' SRC_DIR is the source directory name'
- Mess ' '
- Mess ' OPTIONS :'
- Mess ' - DEBUG compile with debug option'
- Mess ' - FALCO allows to install the FALCO driver '
- Mess ' with GRAPHICS_PACKAGE'
- Mess ' '
-*
- Return
-+DECK,INSTALL.
-*CMZ : 1.22/02 18/11/94 15.20.15 by O.Couet
-*-- Author :
- Macro INSTALL 1=X 2=X 3=' ' 4=X
-*
- If [1]='?' Then
- Exec help
- Goto END
- Endif
-*
-* GRAPHICS Underlaying graphics package used
-* LIBRARY Library name
-* CODEDIR Source code directory
-*
- GRAPHICS = $Upper([1])
- LIBRARY = $Lower([2])
- CODEDIR = $Lower([3])
-*
- D = FALSE
- Do I = 4,[#]
- Case $Upper([%I]) In
- (DEBUG) D = TRUE
- (FALCO) Sel FALCO
- Endcase
- Enddo
-*
- Case [GRAPHICS] In
- (GKSGRAL)
- (SUNGKS)
- (MGKS)
- (PLOT10GKS)
- (UNIGKS)
- (DECGKS)
- (GK2000)
- (ATCGKS)
- (GKSBX)
- (PHIGS)
- (GL)
- (GPR)
- (X11)
- (GDDM)
- (FALCO)
- (DI3000)
- (BATCH)
- (*,X)Mess ' '
- Mess '*** ERROR : Incorrect graphics package name.'
- Mess '*** The possible choices are:'
- Mess ' '
- Mess 'GKSGRAL, SUNGKS, MGKS, PLOT10GKS'
- Mess 'UNIGKS, DECGKS, GK2000, ATCGKS, GKSBX'
- Mess 'PHIGS, GL, GPR, X11, GDDM'
- Mess 'FALCO, DI3000, BATCH'
- Mess ' '
- Goto END
- Endcase
-*
-* All the options selected are valid, the installation can start
-*
- Mess ' '
- Mess Installation of HIGZ on $MACHINE with [GRAPHICS] _
- starting at $DATE $TIME .
- Mess ' '
-*
-* Define the installation script name
-*
- Set [CODEDIR]//higz.sh -XADCL
-*
-* Set up the library name
-*
- If [LIBRARY] = 'x' Then
- Set [CODEDIR]//'$cmzfile.a' -L
- Else
- Set [LIBRARY] -L
- Endif
-*
-* Set the debug option if necessary
-*
- If [D] = TRUE Then
- Case $MACHINE In
- (APOLLO) D='-dba '
- (VAX,ALPHA) D='/NOOP/DEB'
- (*) D='-g '
- Endcase
- Else
- D=' '
- Endif
-*
-* Select the options
-*
- Select $MACHINE [GRAPHICS]
-*
-* Select FORTRAN extension name
-*
- Case $MACHINE In
- (APOLLO) EXT = ftn
- (VAX,ALPHA) EXT = FOR
- (IBM) EXT = FORTRAN
- (*) EXT = f
- Endcase
-*
-* Select the languages
-*
- Set f77 xcc -lan
-*
-* Set the directory source code
-*
- Case $MACHINE In
- (VAX,ALPHA) Set [CODEDIR]//'HIGZ.'//[EXT] -F f77
- (*) Set [CODEDIR]*.[EXT] -F f77
- Endcase
- Set [CODEDIR]//*.c -F xcc
-*
-* Set up the C compiling options
-*
- Case $MACHINE In
- (APOLLO) CC = '/com/cc '
- CFLAGS = ' '
- INCDIR = ' '
- (HPUX) CC = 'cc '
- CFLAGS = '-c -G '
- INCDIR = '-I /usr/include/X11R5 '
- (SUN) CC = '/usr/local/bin/gcc '
- CFLAGS = '-c -DANSI_CPP '
- INCDIR = ' '
- (VAX,ALPHA) CC = 'CC'
- CFLAGS = '/STANDARD=VAXC '
- INCDIR = ' '
- (DECS) CC = 'c89 '
- CFLAGS = '-c '
- INCDIR = ' '
- (SGI) CC = 'cc '
- CFLAGS = '-c -G 0 '
- INCDIR = ' '
- (*) CC = 'cc '
- CFLAGS = '-c '
- INCDIR = ' '
- Endcase
- Set [CC]//[CFLAGS]//[D]//[INCDIR]//' $compfile' -C xcc
-*
-* Set up the FORTRAN compiling options
-*
- Case $MACHINE In
- (APOLLO) FORTRAN = '/com/ftn '
- FFLAGS = '-indexl -save '
- (HPUX) FORTRAN = 'f77 '
- FFLAGS = '-c -G +Obb100 +ppu '
- (SUN) FORTRAN = 'f77 '
- FFLAGS = '-c -O '
- (IBMRT) FORTRAN = 'xlf '
- FFLAGS = '-c -qextname '
- (VAX,ALPHA) FORTRAN = 'FOR'
- FFLAGS = ' '
- (DECS) FORTRAN = 'f77 '
- FFLAGS = '-c -O0 -G 0 '
- (SGI) FORTRAN = 'f77 '
- FFLAGS = '-c -G 0 '
- (*) FORTRAN = 'f77 '
- FFLAGS = '-c '
- Endcase
- Set [FORTRAN]//[FFLAGS]//[D]//' $compfile' -C f77
-*
-* Compile and archive
-*
- Pilot *HIGZ
- CMake -P
-*
-END:
- Return
-+PATCH,*HIGZ.
-+DECK,BLANKDEK.
-*CMZ : 1.23/05 09/10/95 15.34.18 by O.Couet
-*-- Author :
-+USE, HICDES,IZ,IG,IH,ZEBRA,PSCRIPT,IPOST.
-+USE, UNIX, IF=SGI,IBMRT,SUN,CONVEX,DECS,AIX370,HPUX.
-+USE, UNIX, IF=IPSC,ALLIANT,MACMPW,MSDOS,NEXT,LINUX,WINNT,TK_WINDOWS.
-+USE, VAX, IF=ALPHA.
-+USE, APOLLO, IF=APOF77.
-+USE, IBM, IF=IBMMVS,NEWLIB.
-+USE, F2C, IF=MSDOS,WINNT,LINUX.
-+USE, BSLASH, IF=SUN,SGI,DECS,IBMRT,IPSC,APOF77,F2C,QMALPH.
-+USE, BSLASH, IF=WINNT
-+USE, MENU,GED, IF=UNIX,APOLLO,IBM,VAX,NORD,CRAY.
-+USE, GKSGRAL, IF=SUNGKS,GKSIBM.
-+USE, GKS, IF=GKSGRAL,MGKS,PLOT10GKS,UNIGKS.
-+USE, GKS, IF=DECGKS,GK2000,ATCGKS,GKSBX.
-+USE, IGKS, IF=GKS.
-+USE, GL,CIPACK,IF=MSDOS.
-+USE, X11, IF=WINNT,TK_WINDOWS.
-+USE, KERNEL, IF=GL,GPR,X11,GDDM,MACMPW,MSDOS.
-+USE, IKERNEL, IF=KERNEL,BATCH,FALCO,PHIGS.
-+USE, QXNO_SC, IF=CRAY,VAX,IBM.
-+USE, QXNO_SC, IF=APOLLO,IF=-APOF77.
-+USE, QX_SC, IF=SGI,IBMRT,SUN,CONVEX,DECS,AIX370,HPUX,APOF77.
-+USE, QX_SC, IF=NEXT,CONVEX,F2C,WINNT.
-+USE, NTC.
-+USE, HIGZCC, IF=X11,FALCO,NTC,UNIX.
-+USE, IFALCO, IF=FALCO.
-+USE, IDI3000, IF=DI3000.
-+USE, IMAC, IF=MACMPW.
-+USE, NOVERS, IF=PHIGS.
-+USE, IMSDOS, IF=MSDOS.
-+USE, IGOLD, IF=MSDOS.
-+USE, CVX, IF=CONVEX,IF=SINGLE.
-+USE, CVY, IF=CONVEX,IF=-SINGLE.
-+PATCH,*HIGZEXAM.
-+DECK,BLANKDEK.
-*CMZ : 1.20/10 31/01/94 12.19.26 by O.Couet
-*-- Author :
-+USE,HIGZEXAM.
-+USE, UNIX, IF=SGI,IBMRT,SUN,CONVEX,DECS,AIX370,HPUX,LINUX.
-+USE, UNIX, IF=WINNT.
-+PATCH,HICDES. CONTAINS ALL COMMON BLOCKS
-+KEEP,HIFC3.
-*CMZ : 1.20/08 18/01/94 14.30.32 by O.Couet
-*-- Author : O.Couet 18/01/94
- COMMON/HIFC3/XL,YL,FLAG1
-+KEEP,HIFC1.
-*CMZ : 1.20/08 18/01/94 14.30.07 by O.Couet
-*-- Author : O.Couet 18/01/94
- COMMON/HIFC1/ISFL
-+KEEP,HIFC6.
-*CMZ : 1.20/08 18/01/94 14.29.45 by O.Couet
-*-- Author : O.Couet 18/01/94
- COMMON/HIFC6/ISCR,IPOUT,JPIN,MFL
-+KEEP,HIFC2.
-*CMZ : 1.20/08 18/01/94 14.25.59 by O.Couet
-*-- Author : O.Couet 18/01/94
- COMMON/HIFC2/FX,FY,XMIN,XMAX,YMIN,YMAX,IXMIN,IXMAX,IYMIN,IYMAX
-+KEEP,HI3D.
-*CMZ : 1.20/06 21/12/93 11.41.11 by O.Couet
-*-- Author : O.Couet 20/12/93
- COMMON /HI3D/ AWNX,BWNX,CWNX,DWNX,AWNY,BWNY,CWNY,DWNY
-+KEEP,HIVERS.
-*CMZ : 1.18/00 23/04/93 17.50.07 by O.Couet
-*-- Author :
- COMMON /HIVERS/ CHVERS
- CHARACTER*8 CHVERS
-+KEEP,HIPAW.
-*CMZ : 1.18/00 23/04/93 17.27.56 by O.Couet
-*-- Author :
- COMMON /PAWC/ NWPAW,IXPAWC,IHBOOK,IXHIGZ,IXKU,IFENCE(5)
- +, LMAIN, IPAW(9989)
- DIMENSION IQ(2),Q(2),LQ(8000)
- EQUIVALENCE (Q(1),IQ(1),LQ(9)),(LQ(1),LMAIN)
- COMMON /QUEST/ IQUEST(100)
- DIMENSION RQUEST(100)
- EQUIVALENCE (IQUEST(1),RQUEST(1))
- COMMON /HILINK/ LHIGZ,LCG,LWV
- +, LPICT,LHNT0,LHI,LHF,LHC,LHNT,LHNTLA
- +, LPICD,LDNT0,LDI,LDF,LDC,LDNT,LDNTLA
- +, LPIC2,L2NT0,L2I,L2F,L2C,L2NT,L2NTLA
- +, LNDECO,LIDECO,LFDECO,LCDECO
- +, LPSAV,LPCOP,LNTCOP,LSTACK(10),LAST
- COMMON /HIPTR/ ITBPTR,INTPTR,IFLPTR,ISTPTR
- +, IIAPTR,IRAPTR
- COMMON /HISIZE/ INSIZ,IISIZ,IFSIZ,ISSIZ
- +, IRNSIZ,IRISIZ,IRFSIZ,IRSSIZ
- COMMON /HINUM/ NBPICT,INBNT,INBLEV
-
-+KEEP,HINT.
-*CMZ : 1.18/00 23/04/93 17.27.56 by O.Couet
-*-- Author :
- PARAMETER (INWDNT=2)
- PARAMETER (NBNTMX=100)
- COMMON /HINT/ NTSTOR(INWDNT*NBNTMX+1),WNVPST(8*NBNTMX)
-
-+KEEP,HIQUES.
-*CMZ : 1.18/00 23/04/93 17.27.56 by O.Couet
-*-- Author :
- COMMON /QUEST/ IQUEST(100)
- DIMENSION RQUEST(100)
- EQUIVALENCE (IQUEST(1),RQUEST(1))
-
-+KEEP,HIFLAG.
-*CMZ : 1.21/05 16/06/94 14.37.23 by O.Couet
-*-- Author :
- COMMON /HIFLAG/ GFLAG,GLFLAG,ZFLAG,PFLAG,MFLAG,TFLAG
- +,ASFLAG,GRFLAG,AXFLAG,CFLAG
- LOGICAL GFLAG,GLFLAG,ZFLAG,PFLAG,MFLAG,TFLAG
- +,ASFLAG,GRFLAG,AXFLAG,CFLAG
-
-+KEEP,HILUN.
-*CMZ : 1.18/00 23/04/93 17.27.56 by O.Couet
-*-- Author :
- COMMON /HILUN/ LUNIN,LUNOUT,LUNERR
-
-+KEEP,HIATT. Attributes list
-*CMZ : 1.21/03 02/06/94 15.12.02 by O.Couet
-*-- Author :
- INTEGER INTR,IWTYPE,IDID,IDTY,ILOPWK(10),IWTYL(10),INOPWK
- +, IWINID(10),IPICT,ICLIP,NT0PRI,IPLCI,ILN,IPMCI,IMK,IFACI
- +, IFAIS,IFASI,ITXCI,ITXALG,IFTPR,INPASS,IBORD,INLINE
- +, INTATT(17),IFONT,IPREC,ITXALH,ITXALV,IDIM,INBCOL
- REAL XRATIO,YRATIO,RWXMIN,RWXMAX,RWYMIN,RWYMAX,RVXMIN,RVXMAX
- +, RVYMIN,RVYMAX,RDWXMI,RDWXMA,RDWYMI,RDWYMA,RDVXMI,RDVXMA
- +, RDVYMI,RDVYMA,RMDSX,RMDSY,XWKSIZ(10),YWKSIZ(10),WKMAX(10)
- +, XWKR(10),YWKR(10),XWKW1(10),YWKW1(10),XWKV1(10),YWKV1(10)
- +, XWKW2(10),YWKW2(10),XWKV2(10),YWKV2(10),REDIT,RMKSC,RLWSC
- +, RBSL,RANGLE,RCHH,RCSHIF,RBOF,RBWD,RAWL,RTMS,RALH,RALD
- +, REAATT(18),RCHUX,RCHUY
- LOGICAL ACWKFL(10),NODRFL(10)
- COMMON /HIATT/ INTR,XRATIO,YRATIO
- +,RWXMIN,RWXMAX,RWYMIN,RWYMAX,RVXMIN,RVXMAX,RVYMIN,RVYMAX
- +,RDWXMI,RDWXMA,RDWYMI,RDWYMA,RDVXMI,RDVXMA,RDVYMI,RDVYMA
- +,RMDSX ,RMDSY ,IWTYPE,IDID ,IDTY
- +,ILOPWK,ACWKFL,NODRFL,IWTYL ,INOPWK
- +,XWKSIZ,YWKSIZ,WKMAX ,IWINID,XWKR ,YWKR
- +,XWKW1 ,YWKW1 ,XWKV1 ,YWKV1
- +,XWKW2 ,YWKW2 ,XWKV2 ,YWKV2
- +,IPICT ,ICLIP ,REDIT,NT0PRI
- +,RMKSC ,RLWSC ,RBSL ,RANGLE,RCHH ,RCSHIF,RBOF ,RBWD
- +,RAWL ,RTMS ,RALH ,RALD ,REAATT
- +,IPLCI ,ILN ,IPMCI ,IMK ,IFACI ,IFAIS ,IFASI ,ITXCI
- +,ITXALG,IFTPR ,INPASS,IBORD ,INLINE,INTATT
- +,IFONT ,IPREC ,ITXALH,ITXALV,RCHUX ,RCHUY
- +,IDIM ,INBCOL
-+KEEP,HIATNB. Number of INTEGER and REAL attributes
-*CMZ : 1.18/00 23/04/93 17.27.56 by O.Couet
-*-- Author :
- PARAMETER (NBRATT=12,NBIATT=13)
-
-+KEEP,HIAADR. Attributes adresses in the current picture
-*CMZ : 1.18/00 23/04/93 17.27.56 by O.Couet
-*-- Author :
- COMMON /HIAADR/ IATADR(60)
-
-+KEEP,HIATNM. Attributes names
-*CMZ : 1.18/00 23/04/93 17.27.56 by O.Couet
-*-- Author :
- CHARACTER*4 CHRATT(NBRATT),CHIATT(NBIATT)
- DATA CHRATT /'MSCF','LWID','BASL','TANG','CHHE','CSHI'
- +, 'BARO','BARW','AWLN','TMSI','LASI','LAOF'/
- DATA CHIATT /'PLCI','LTYP','PMCI','MTYP','FACI','FAIS'
- +, 'FASI','TXCI','TXAL','TXFP','PASS','BORD'
- +, 'NLIN'/
-
-+KEEP,HIFLAT. Attributes control flags
-*CMZ : 1.18/00 23/04/93 17.27.57 by O.Couet
-*-- Author :
- COMMON /HIFLAT/
- + KMKSC,KLWSC,KBSL ,KTANG,KCHH ,KTXSH
- +,KBOF ,KBWD ,KAWL ,KTMS ,KALH ,KALD
- +,KRFLAG(18)
- +,KPLCI,KLN ,KPMCI,KMK ,KFACI,KFAIS
- +,KFASI,KTXCI,KTXAL,KFONT,KTXPA,KBOR
- +,KNLIN
- +,KIFLAG(17)
-
-+KEEP,HICODE. Attributes codes
-*CMZ : 1.21/08 20/07/94 16.40.03 by O.Couet
-*-- Author :
- PARAMETER (INOPCO=1 ,IUNDCO=2 ,IPICO1=3 ,IPICO2=4 ,IMIDCO=5
- +,IHISCO=6 ,IPM1CO=7 ,IPL2CO=8 ,IPLCO =9 ,IPMCO =10,IFACO =11
- +,ITXCO =12,IBXCO =13,IFBXCO=14,IARCCO=15,IAXICO=16,IGTXCO=17
- +,IMLCO =18,ILBLCO=19,ITABCO=20,IGRACO=21,IPAVCO=22
- +,ICRCO =48,ICLICO=49
- +,IMKSCO=50,ILWSCO=51,IBSLCO=52,IANGCO=53,ICHHCO=54,IGTSCO=55
- +,IBOFCO=56,IBWDCO=57,IAWLCO=58,ITMSCO=59,IALHCO=60,IALDCO=61
- +,IPLCCO=80,ILNCO =81,IPMCCO=82,IMKCO =83,IFACCO=84,IFAICO=85
- +,IFASCO=86,ITXCCO=87,ITXACO=88,ITXFCO=89,IGTWCO=90,IBORCO=91
- +,INLICO=92)
-
-+KEEP,HISAVE.
-*CMZ : 1.18/00 23/04/93 17.27.57 by O.Couet
-*-- Author :
- COMMON /HISAVE/ ISAVE(NBIATT),RSAVE(NBRATT),ISVNT,WNVPSV(8)
-
-+KEEP,HISAVA.
-*CMZ : 1.18/00 23/04/93 17.27.57 by O.Couet
-*-- Author :
- COMMON /HISAVA/ ISAVA(NBIATT),RSAVA(NBRATT)
-
-+KEEP,HISVED.
-*CMZ : 1.18/00 23/04/93 17.27.57 by O.Couet
-*-- Author :
- COMMON /HISVED/ ISAVED(NBIATT),RSAVED(NBRATT)
-
-+KEEP,HICUR.
-*CMZ : 1.18/00 23/04/93 17.27.57 by O.Couet
-*-- Author :
- COMMON /HICUR/ HICDIR
- CHARACTER*32 HICDIR
-
-+KEEP,HIGED.
-*CMZ : 1.18/00 23/04/93 17.27.57 by O.Couet
-*-- Author :
- COMMON /HIGED/ XPM(2,3),YPM(2,3),ICUMEN(3),ICUCHO(3),NBU(3)
- +,NBITEM(3),ISOF,ICPLCI,ICLN,ICFACI,ICFAIS,ICFASI,ICBOCI,ICBOIS
- +,ICBOSI,ICBOBO,ICFBCI,ICFBIS,ICFBSI,ICFBBO,ICPMCI,ICMK,RCMKSC
- +,RCSTAN,RCSTSI,ICSTPA,RCSTSH,ICSTCI,RCTXAN,RCTXSI,ICTXFT,ICTXPR
- +,ICTXCI,ICTXAH,ICTXAV,RCBOF,RCBWD,ICHILN,ICHIPC,ICHIFC,ICHIFI
- +,ICHIFS,RCARSI,ICARLC,ICARFC,ICARFI,ICARFS,ICARLN,RCAXTS,RCAXLS
- +,RCAXLO,RCAXW1,RCAXW2,ICAXND,ICAXLN,ICAXLC,ICAXLF,ICAXLP,ICACFI
- +,ICACFS,ICACBO,ICACLC,ICACFC,RCLWSC,X(100),Y(100)
- +,IXSTEP,IYSTEP,IXFACT,IYFACT,ICPBST,ICPFST,RCDZPV
- CHARACTER*32 TITLE(3)
- CHARACTER*20 CHUSKE(20,3)
- CHARACTER*32 CHITEM(20,3)
- CHARACTER*80 CHDEF(20)
- CHARACTER*32 CHOPST,CHOPAX,CHOPHI,CHOPPV
- CHARACTER*80 CCST,CCTX
- CHARACTER*80 CHFAC,CHPLC,CHTXC,CHPMC,CHFAIS,CHHIFC,CHHIPC,CHARFC
- + ,CHARLC,CHARFI,CHBOC,CHBOIS,CHFBC,CHFBIS,CHSTC,CHHIIS
- + ,CHAXLC,CHACIS,CHACLC,CHACFC
- CHARACTER*8 CHDOAR,CHBOBO,CHFBBO,CHAFL,CHACBO
- CHARACTER*80 EDIPIC
- COMMON /HIGEDC/ TITLE,CHUSKE,CHITEM,CHDEF,CHOPST,CHOPAX,CHOPHI
- +,CCST,CCTX,CHFAC,CHPLC,CHTXC,CHPMC,CHFAIS,CHHIFC,CHHIPC,CHARFC
- +,CHARLC,CHARFI,CHBOC,CHBOIS,CHFBC,CHFBIS,CHSTC,CHHIIS,CHAXLC
- +,CHACIS,CHACLC,CHACFC,CHDOAR,CHBOBO,CHFBBO,CHAFL,CHACBO,EDIPIC
- +,CHOPPV
-
-+KEEP,HIACA.
-*CMZ : 1.18/00 23/04/93 17.27.57 by O.Couet
-*-- Author :
- COMMON/HIACA/ IACHOP,IADRAT
-
-+KEEP,HILABS.
-*CMZ : 1.18/00 23/04/93 17.27.57 by O.Couet
-*-- Author :
- PARAMETER (MAXLAB=100)
- CHARACTER*32 HILABS
- COMMON/HILBL1/NHILAB
- COMMON/HILBL2/HILABS(MAXLAB)
-
-+KEEP,HIMENU.
-*CMZ : 1.18/00 23/04/93 17.27.57 by O.Couet
-*-- Author :
- COMMON /HIMENU/ Y3,Y4,YT,XSIZ,YSIZ,RINT,REDLOC,NBCHOI,ICUCH,DEC
- +,OTH,TH,XPOS(2),YPOS(2),IRSU,ILSU,XM,XML,XMR,YSTEP,XP,YP
- +,XOPT,IPARA,ISOFT,NBUSER,UTH,USIZ,ISEGM(100),MENNUM
-
-+KEEP,HIMDOS.
-*CMZ : 1.18/00 23/04/93 17.27.57 by O.Couet
-*-- Author :
- COMMON /HIMDOS/ IPICNM,SCMETA
-+KEEP,HIMETA.
-*CMZ : 1.18/00 23/04/93 17.27.57 by O.Couet
-*-- Author :
- COMMON /HIMETA/ IDMETA,XMFACT,YMFACT,TEKACT,METACT,FILOPN
- LOGICAL TEKACT,METACT,FILOPN
- COMMON /HIMETC/ CHMETA
- CHARACTER*24 CHMETA
-+SEQ,HIMDOS,IF=MSDOS.
-
-+KEEP,HIMET2.
-*CMZ : 1.18/00 23/04/93 17.27.57 by O.Couet
-*-- Author :
- COMMON /HIMET2/ ITGKS,METDEF,IFUSER
-
-+KEEP,HIGRAF.
-*CMZ : 1.18/00 23/04/93 17.27.57 by O.Couet
-*-- Author :
- PARAMETER (NPMAX=500)
- COMMON /HIGRAF/ NGRAF,XGRAF(NPMAX),YGRAF(NPMAX)
-
-+KEEP,HICONV.
-*CMZ : 1.18/00 23/04/93 17.27.57 by O.Couet
-*-- Author :
- COMMON /HICONV/ X1MIN,X1MAX,Y1MIN,Y1MAX,X2MIN,X2MAX,Y2MIN,Y2MAX
-
-+KEEP,HICONT.
-*CMZ : 1.18/00 23/04/93 17.27.57 by O.Couet
-*-- Author :
- COMMON /HICONT/ DZ,ZMIN,ZMAX
-
-+KEEP,HIPACK.
-*CMZ : 1.22/08 24/02/95 17.10.52 by O.Couet
-*-- Author :
- COMMON /HIPACK/ NCX,NCY,IPACK,ILOG,ZLOW,ZHIGH,IDIM1,IOPTER
-
-+KEEP,HIHIST.
-*CMZ : 1.18/00 23/04/93 17.27.57 by O.Couet
-*-- Author :
- COMMON /HIHIST/ XWORK(204),YWORK(204),XWORKL(204),YWORKL(204)
-
-+KEEP,ICMTOP.
-*CMZ : 1.18/00 23/04/93 17.27.57 by O.Couet
-*-- Author :
- ICMTOP(U)=NINT(72.*U/2.54)
-+KEEP,HIWCPS.
-*CMZ : 1.18/00 23/04/93 17.27.57 by O.Couet
-*-- Author :
- IXWCPS(U)=NINT(4.*WKMAX(IPSI)*(FX*(U-X1W)+X1V))
- IYWCPS(V)=NINT(4.*WKMAX(IPSI)*(FY*(V-Y1W)+Y1V))
-+KEEP,HIPOST.
-*CMZ : 1.23/01 23/05/95 14.36.14 by O.Couet
-*-- Author :
- COMMON /HIPOST/ X1V,X2V,Y1V,Y2V,X1W,X2W,Y1W,Y2W,FX,FY
- +,LUNPS,LENBUF,IPSCI,PSRED,PSGRN,PSBLU,IPSMSC
- +,IPSLT,IPSLW,IPSWID,IPSI,IPSWTY,IPTWTY,LENBMX
- +,XVP1,XVP2,YVP1,YVP2,XVS1,XVS2,YVS1,YVS2,XPSR,YPSR
- +,NX,NY,IXZ,IYZ,MODE,NPAGES,IPCLIP,IPDXC,IPDYC,IPXC,IPYC
- +,LOPRT,LOBB,LOCLR,LOPRNG,LOSCLI,LOZONE,NBSAVE,NBSAV0
- LOGICAL LOPRT,LOBB,LOCLR,LOPRNG,LOSCLI,LOZONE
- COMMON /HIPOSC/ STRBUF,BSLASH,ALIGN1
- CHARACTER*132 STRBUF
- CHARACTER*1 BSLASH
- CHARACTER*3 ALIGN1
-
-+KEEP,HILUT.
-*CMZ : 1.18/00 23/04/93 17.27.57 by O.Couet
-*-- Author :
- PARAMETER (NBCLUT=256)
- COMMON /HILUT/ REDLUT(NBCLUT),GRNLUT(NBCLUT),BLULUT(NBCLUT)
-
-+KEEP,HIMAIL.
-*CMZ : 1.18/00 23/04/93 17.27.57 by O.Couet
-*-- Author :
- COMMON /HIMAIC/ CHMAIL,CHOPTM,CHCTRL,CHEOR,ALIGN2
- CHARACTER*2 CHCTRL
- CHARACTER*1 CHEOR,ALIGN2
- CHARACTER*80 CHMAIL,CHOPTM
-
-+KEEP,HILOC.
-*CMZ : 1.18/00 23/04/93 17.27.57 by O.Couet
-*-- Author :
- COMMON /HILOC/ OLDXP,OLDYP
-
-+KEEP,HIPICK.
-*CMZ : 1.18/00 23/04/93 17.27.57 by O.Couet
-*-- Author :
- PARAMETER (LEVLEN=16)
- COMMON /HIPICK/ CHLVL,CHLVL2
- CHARACTER*(LEVLEN) CHLVL,CHLVL2
-
-+KEEP,HIBITVAX.
-*CMZ : 1.18/00 23/04/93 17.27.57 by O.Couet
-*-- Author :
- JBIT (IZW,IZP)=JIBITS (IZW,IZP-1,1)
- JBYT (IZW,IZP,NZB)=JIBITS (IZW,IZP-1,NZB)
-+KEEP,HIBIT
-*CMZ : 1.18/00 23/04/93 17.27.57 by O.Couet
-*-- Author :
-+SEQ,HIBITVAX,IF=VAX.
-*
-+DECK,DICDES,IF=DI3000. COMMONS FOR HIGZ-DI3000 INTERFACE
-*CMZ : 1.14/04 23/03/92 10.37.27 by Unknown
-*-- Author :
-+KEEP,DI3DEV.
- LOGICAL ENTRY_FLAG
- COMMON /DI3DEV/ ENTRY_FLAG
-
-+KEEP,DI3MET.
- CHARACTER*30 METNAM
- COMMON /DI3MET/ METNAM
-
-+KEEP,DI3SEG.
- LOGICAL SEGOPN
- COMMON /DI3SEG/ SEGOPN
-
-+DECK,IHDES.
-*CMZ : 1.19/05 26/08/93 09.41.02 by O.Couet
-*-- Author :
-+KEEP,HCSCRN.
- PARAMETER (NSLIC=1000, NTMAX=100)
- COMMON /HCSCRN/ TN(4,3),TB(4,3),
- & NT,X0,DX,U(2,NSLIC),D(2,NSLIC),T(2,NTMAX)
-+KEEP, HCRAST.
- PARAMETER (NBW=30, L1=NBW/2, L2=(NBW+1)/2)
- PARAMETER (LMASK=(NBW+1)*L1+(NBW-L1*2)*L2)
- INTEGER IRAST(4),JMASK(NBW),MASK(LMASK)
- COMMON /HCRAST/ NXRAST,NYRAST,XRAST,DXRAST,YRAST,DYRAST,
- & IFRAST,JRAST,IRAST,JMASK,MASK
-+KEEP,HCTNOR.
- COMMON /HCTNOR/ TNORM(4,3),TBACK(4,3)
-+KEEP,HCLEVL.
- PARAMETER (LLEV=256)
- COMMON /HCLEVL/ NLEV,FUNLEV(LLEV+1),ICLEV(LLEV+2)
-+KEEP,HCLINE.
- PARAMETER (LLINES=200)
- COMMON /HCLINE/ NLINES,ILLEVL(LLINES),PLINES(3,2,LLINES)
-+KEEP,PNVMAX.
- PARAMETER (NVMAX=20)
-+KEEP, HCPHI.
- PARAMETER (NPMAX=180)
- COMMON /HCPHI/ APHI(NPMAX+3)
-+KEEP,HCLIGH.
- PARAMETER (LLIGHT = 4)
- COMMON /HCLIGH/ LOFF,YDL,YLS(LLIGHT),VLS(3,LLIGHT),QA,QD,QS,NQS
-+KEEP,HCEQUI,IF=VAX,DECS,LINUX.
- PARAMETER (I2EQUI=2)
-+KEEP,HCEQUI,IF=-VAX,IF=-DECS,IF=-LINUX.
- PARAMETER (I2EQUI=1)
-+KEEP,HCZBUF.
- INTEGER*2 IBUFF(1)
- COMMON /HCZBUF/ KXSCR,KYSCR,JSCRN,JZBUF,IBUFF
-+KEEP,HCZCLI.
- COMMON /HCZCLI/ KX1CLI,KX2CLI,KY1CLI,KY2CLI
-+KEEP,HCZWIN.
- COMMON /HCZWIN/ XW1,XW2,YW1,YW2,ZW1,ZW2
-+KEEP,HCZPOR.
- COMMON /HCZPOR/ IXP1,IXP2,IYP1,IYP2,IZP1,IZP2
-+KEEP, HCMCUB.
- COMMON /HCMCUB/ P8(3,8),F8(8),G8(3,8)
-+KEEP, HCMCTR.
- PARAMETER (NISO = 4, NMAXP = NISO*13, NMAXT = NISO*12)
- REAL XYZ(3,NMAXP),XYZN(3,NMAXP),GRAD(3,NMAXP)
- REAL DTRIA(6,NMAXT),ABCD(3,NMAXT)
- INTEGER ITRIA(3,NMAXT),IATTR(NMAXT),IORDER(NMAXT)
- COMMON /HCMCTR/ XYZ,XYZN,GRAD,DTRIA,ABCD,ITRIA,IATTR,IORDER
-+KEEP,HIHID.
- PARAMETER (MAXSTK=10)
- COMMON /HIHID/ REFWRD(MAXSTK),ZMINST,ZMAXST
- +,IXFCHA(MAXSTK),IYFCHA(MAXSTK),IXNCHA(MAXSTK),IYNCHA(MAXSTK)
- +,ISTCOL(MAXSTK),ISTCO2(MAXSTK),ISTCOT,ISTCOB,IADRES(MAXSTK)
- +,NIDS,XSTP,YSTP,XLAB1,YLAB1,XLAB2,YLAB2,IDRGR,RLEGBO,RLEGBW
- +,I4AXI,ISYS,ILOGX,ILOGY,XVAL1,XVAL2,YVAL1,YVAL2,RINRAD,DANG
-+DECK,KERDES,IF=KERNEL,IF=-MSDOS.
-*CMZ : 1.20/07 13/01/94 18.14.47 by O.Couet
-*-- Author :
-+KEEP,HIKERN,IF=GPR. COMMON BLOCK for the GPR interface
-%include '/sys/ins/pad.ins.ftn'
-%include '/sys/ins/base.ins.ftn'
-%include '/sys/ins/gpr.ins.ftn'
- PARAMETER (IBUFSI=1000)
- COMMON /HIKERN/ WKSC(10),ICURWK,IXPOS(IBUFSI),IYPOS(IBUFSI)
- +,WINSIZ(4),IXX,IYY,IXYLOC(2),STREAM(10),ICURCI(10),IOFCOL
- +,UNOBS,LOINS,LUNWIN
- LOGICAL UNOBS,LOINS
- INTEGER*2 WINSIZ,IXPOS,IYPOS,IXX,IYY,IXYLOC,STREAM
- INTEGER*2 WINID,DISCHA(31),DISLER,HIPLAN
- COMMON /HIKERC/ FILEN
- CHARACTER*80 FILEN
-
-+KEEP,HIWCDC,IF=GPR. Convert WC to DC for the GPR interface
- IXWCDC(U)=MIN(
- +WKSC(IWKNB)*(RVXMIN+XRATIO*(U-RWXMIN)),XWKSIZ(IWKNB))
- IYWCDC(V)=MIN(YWKSIZ(IWKNB)-
- +WKSC(IWKNB)*(RVYMIN+YRATIO*(V-RWYMIN)),YWKSIZ(IWKNB))
-
-+KEEP,GLSGI,IF=GL,IF=SGI.
-#include <fgl.h>
-#include <fdevice.h>
-
-+KEEP,GLIBM,IF=GL,IF=IBMRT.
- INCLUDE 'gl/fgl.h'
- INCLUDE 'gl/fdevice.h'
-
-+KEEP,HIKERN,IF=GL. COMMON BLOCK for the GL interface
-+SEQ,GLSGI,IF=SGI.
-+SEQ,GLIBM,IF=IBMRT.
- PARAMETER (IBUFSI=1000)
- COMMON /HIKERN/ WKSC(10),WINSIZ(4),IPOS(2,IBUFSI),IXX,IYY,ICURWK
- +,LOINS,ICURCI(10),IOFCOL,IXLOCO,IYLOCO,LUNWIN
- LOGICAL LOINS
- INTEGER WINSIZ,WINID
- INTEGER*2 IVAL
- COMMON /HIKERC/ FILEN
- CHARACTER*80 FILEN
-
-+KEEP,HIWCDC,IF=GL. Convert WC to DC for the GL interface
- IXWCDC(U)=INT(WKSC(IWKNB)*(RVXMIN+XRATIO*(U-RWXMIN)))
- IYWCDC(V)=INT(WKSC(IWKNB)*(RVYMIN+YRATIO*(V-RWYMIN)))
-
-+KEEP,HIKERN,IF=X11,IF=-WINNT. COMMON BLOCK for the X11 interface
- PARAMETER (IBUFSI=1000)
- COMMON /HIKERN/ WKSC(10),ICURWK,WINSIZ(4)
- +,IPOS(2,IBUFSI),LUNWIN,THX11,IFPX11,RMAGN
- INTEGER WINSIZ
- INTEGER*2 IPOS
- COMMON /HIKERC/ CHHOST,FILEN,FX11
- CHARACTER*80 CHHOST,FILEN,FX11
-
-+KEEP,HIKERN,IF=WINNT. COMMON BLOCK for the Windows NT interface
- PARAMETER (IBUFSI=1000)
- COMMON /HIKERN/ WKSC(10),ICURWK,WINSIZ(4)
- +,IPOS(2,IBUFSI),LUNWIN,THX11,IFPX11
- INTEGER WINSIZ
- COMMON /HIKERC/ CHHOST,FILEN,FX11
- CHARACTER*80 CHHOST,FILEN,FX11
-
-+KEEP,HIWCDC,IF=X11,IF=VAX. Convert WC to DC for X11
- IXWCDC(U)=MAX(MIN(XWKV1(IWKNB)+
- +XWKR(IWKNB)*(XRATIO*(U-RWXMIN)+RVXMIN-XWKW1(IWKNB))
- +,32767.),-32766.)
- IYWCDC(V)=MAX(MIN(YWKSIZ(IWKNB)-(YWKV1(IWKNB)+
- +YWKR(IWKNB)*(YRATIO*(V-RWYMIN)+RVYMIN-YWKW1(IWKNB)))
- +,32767.),-32766.)
-
-+KEEP,HIWCDC,IF=X11,IF=-VAX. Convert WC to DC for X11
- IXWCDC(U)=XWKV1(IWKNB)+
- +XWKR(IWKNB)*(XRATIO*(U-RWXMIN)+RVXMIN-XWKW1(IWKNB))
- IYWCDC(V)=YWKSIZ(IWKNB)-(YWKV1(IWKNB)+
- +YWKR(IWKNB)*(YRATIO*(V-RWYMIN)+RVYMIN-YWKW1(IWKNB)))
-
-+KEEP,HIKERN,IF=GDDM. COMMON BLOCK for the GDDM interface
- PARAMETER (IBUFSI=1000)
- COMMON /HIKERN/ WKSC(10),ICURWK
- +,XPOS(IBUFSI),YPOS(IBUFSI),ICURCI
-
-+KEEP,HIWCDC,IF=GDDM. Convert WC to DC for the GDDM interface
- XWCDC(U)=WKSC(IWKNB)*(RVXMIN+XRATIO*(U-RWXMIN))
- YWCDC(V)=WKSC(IWKNB)*(RVYMIN+YRATIO*(V-RWYMIN))
-
-+KEEP,HIKERN,IF=MACMPW. COMMON BLOCK for the MacIntosh interface
- PARAMETER (IBUFSI=1000)
- COMMON /HIKERN/ WKSC(10),ICURWK,WINSIZ(4)
- +,IPOS(2,IBUFSI),LUNWIN
- INTEGER WINSIZ
- COMMON /HIKERC/ FILEN
- CHARACTER*80 FILEN
-
-+KEEP,HIWCDC,IF=MACMPW. Convert WC to DC for MacIntosh
- IXWCDC(U)=WKSC(IWKNB)*(RVXMIN+XRATIO*(U-RWXMIN))
- IYWCDC(V)=YWKSIZ(IWKNB)-WKSC(IWKNB)*(RVYMIN+YRATIO*(V-RWYMIN))
-+DECK,MSDES,IF=MSDOS.
-*CMZ : 1.14/13 03/07/92 12.05.59 by O.Couet
-*-- Author :
-+KEEP, PINUM.
- PARAMETER (PI=3.1415926, PI2 = 2*PI)
-+KEEP, GOLDEN.
-C--
-C-- PARAMETERS FOR SURFER META-FILE
-C
- INTEGER PA,MA,TR,PS,SC,SS,SP
- PARAMETER (NJOB = 7)
- PARAMETER (PA=1,MA=2,TR=3,PS=4,SC=5,SS=6,SP=7)
-
- PARAMETER (LBUF=256)
- COMMON /GOLDEN/ LUNG(9), NREC, M_OPEN, BIMODE, BUFFER(LBUF/4)
- *, IPOINT, SYMFIL,COOR(4), LOCK, FRADEL
- LOGICAL BIMODE, M_OPEN, LOCK, FRADEL
- CHARACTER*80 SYMFIL
- CHARACTER*512 CHMBUF
- EQUIVALENCE (BUFFER,CHMBUF)
-+KEEP, HIVERS.
- character*52 CHVERS
- DATA
- * CHVERS /' 1.14/13D (FineSoft,JINR, fine at main2.jinr.dubna.su)'/
-+KEEP, GREX.
-C INCLUDE 'GREX.FH'
-C INCLUDE 'DOS.FH'
- integer get_video_mode
- integer video_configuration
- integer graphics_mode
- integer super_vga
- integer clear
- integer get_device_limits
- integer move
- integer draw
- integer get_cursor
- integer get_clip_limits
- integer set_clip_limits
- integer graphic_text
- integer locate
- integer pause
- integer delete_graphics
- integer beep
- integer set_xor
- integer write_string
- integer set_color
- integer vga_palette
- integer define_color
- integer filled_rectangle
- integer filled_ellipse
- integer open_ellipse
- integer linewi
- integer ixsetfs
- integer setpat
- integer polfil
- integer set_pixel
- integer set_dash
- integer move_cursor
- integer init_mouse
- integer get_mouse
- integer set_mouse
- integer set_mp_ratio
- integer set_palette
- integer magnify_text
- integer text_mode
- integer write_screen
- integer display_off
- integer display_on
-+KEEP,HIKERN, IF=NDP. COMMON BLOCK for the NDP_PC interface
-+SEQ, GREX.
- PARAMETER (IBUFSI=1000)
- PARAMETER (ISURF= 18)
- PARAMETER (IRIS = 17)
-
-+SEQ, GOLDEN.
-
- COMMON /HIKERN/ WKSC(10),WINSIZ(4),IPOS(IBUFSI,2),IXX,IYY,ICURWK
- +,LOINS,ICURCI(10),IOFCOL,IXLOCO,IYLOCO,IWKNB,LUNMET(10)
- *, MAX_COLOR(10), IER, DASH_PATTERN(16), video_system(4)
- *, PAL, ISTEP, MAG_X, MAG_Y, MOUSE, IXSAVE(10), IYSAVE(10)
- LOGICAL LOINS, MOUSE
- INTEGER WINSIZ,WINID,video_system
- CHARACTER*4 DASH_PATTERN
- CHARACTER PAL(20)
-C--- INTEGER STRWID
-+KEEP,HIKERN, IF=-NDP. COMMON BLOCK for the NDP_PC interface
-+SEQ, GREX.
- PARAMETER (IBUFSI=1000)
- PARAMETER (ISURF= 18)
- PARAMETER (IRIS = 17)
-
-+SEQ, GOLDEN.
-
- COMMON /HIKERN/ WKSC(10),WINSIZ(4),IPOS(2,IBUFSI),IXX,IYY,ICURWK
- +,LOINS,ICURCI(10),IOFCOL,IXLOCO,IYLOCO,IWKNB,LUNMET(10)
- *, MAX_COLOR(10), IER, DASH_PATTERN(16), video_system(4)
- *, PAL, ISTEP, MAG_X, MAG_Y, MOUSE, IXSAVE(10), IYSAVE(10)
- LOGICAL LOINS, MOUSE
- INTEGER WINSIZ,WINID,video_system
- CHARACTER*4 DASH_PATTERN
- CHARACTER PAL(20)
-C--- INTEGER STRWID
-+KEEP,HIWCDC. Convert WC to DC for the PC AT 386/486 interface
- IXWCDC(U)=NINT(WKSC(IWKNB)*(RVXMIN+XRATIO*(U-RWXMIN)))
- IYWCDC(V)=NINT(YWKSIZ(IWKNB)
- * -WKSC(IWKNB)*(RVYMIN+YRATIO*(V-RWYMIN)))
-+DECK,PHIGSDES,IF=PHIGS.
-*CMZ : 1.18/02 12/05/93 09.27.30 by O.Couet
-*-- Author :
-+KEEP,HIPHIG. COMMON BLOCK for the PHIGS interface
- COMMON /HIPHIG/ LOSTOP,LOSTEX,ICSTN
- LOGICAL LOSTOP,LOSTEX
-+PATCH,PAMEND.
-*
diff --git a/src/car/kuip.car b/src/car/kuip.car
deleted file mode 100644
index d065333..0000000
--- a/src/car/kuip.car
+++ /dev/null
@@ -1,2257 +0,0 @@
-+TITLE.
-KUIP 2.07/08 24/01/96 17.26.56 PROGRAM LIBRARY KUIP = I202
-+PATCH,$VERSION.
-+DECK,V2_07.
-*CMZ : 2.07/08 24/01/96 17.26.56 by Gunter Folger
-*-- Author : Gunter Folger 06/03/95
-*
-*::> VERSION 2.07/08 24/01/96 17.26.56
-*
-*
-* 21/11/95 17.23.46
-*
-*
-* 21/11/95 11.26.07
-*
-* NC. Change in KMENU (CKUIP) :
-* 1) in command mode, in HELP, put a "*" before real commands
-* (not sub-menus).
-* 2) bug correction for VMS ("HELP", and "HELP NULL").
-*
-* 06/11/95 16.42.31
-*
-* NC. Change in mkdpan (CMOTIF) : bug correction for panel, e.g.:
-* panel 0
-* panel 1.01 'vec/pri-' 'print vector'
-* panel 1.02 'vec/pri-' 'print -'
-* panel 1.03 'vec/pri-'
-* panel 0 d
-*
-* 22/06/95 14.53.05
-*
-* NC. Change in KUXLISHLP iand $MKUXLIHLP (code generated from Architect)
-* in order to avoid problem with "km_listSBox" (previously it was
-* defined "extern" in 2 different include files).
-*
-*::> VERSION 2.07/07 22/06/95 14.51.58
-*
-*
-* 16/06/95 16.09.58
-*
-* GF. Protect for a NULL pointer in kmenu/interactive_find
-*
-*::> VERSION 2.07/06 14/06/95 15.33.42
-*
-* GF. Change definition/declaration of cdf_text, cdf_value
-*
-*::> VERSION 2.07/05 12/06/95 17.52.08
-*
-*
-* 12/06/95 17.32.31
-* GF. fixed problem with recursive vaiable assignment in
-* kalias/*subst_var_alias
-*
-*
-*::> VERSION 2.07/04 23/05/95 15.34.19
-*
-* NC. Change logic for "new help machanism" (KMENU):
-* For "HELP xxx" : if xxx is a valid command name and command is unique,
-* then print help as before (do not look for keywords "xxx" but add
-* a "See also" message at the end for other commands with that keyword).
-* In that case to have all commands (valid command name + keyword)
-* do "HELP xxx -K(EYWORD)". if xxx is a valid command name but not
-* unique do the same as "HELP xxx -K(EYWORD)" (print all commands,
-* valid + keyword).
-*
-* GF. Fixed problem with mod(); kmath_y affected.
-* added ku_qcas() identicalto its fortran version
-*
-*::> VERSION 2.07/03 09/05/95 17.27.59
-*
-* GF. -fix several problems in kuvec
-* -add check for trailing blanks to fill_arg_list (kexec); this avoids
-* problems when an alias with trailing blanks is at the end of cmd.
-* -make kxmexec aware of filecase setting in unix ( \ msdos).
-*
-* NC. Correction in "new" HELP for option EDIT/NOEDIT.
-* Suppress all reference to /KUIP/CHELP and replace them by
-* /KUIP/HELP.
-*
-* NC. Put a more explicit message in "check_version" when the CDF
-* has to be re-compiled (indicating which CDF causes the problem).
-*
-*::> VERSION 2.07/02 03/04/95 14.28.00
-*
-* NC. bug correction for popup menus in the graphics window with sub-menus
-* (mkdgra).
-*
-*
-*::> VERSION 2.07/01 07/03/95 15.53.53
-*
-* NC. change resource "centerCommand" to an integer value (before it was
-* a boolean) : 0 (False) means "normal" (cursor position), 1 (True)
-* means "center" and -1 (new) means position (0,0).
-*
-*::> VERSION 2.07/00 06/03/95 12.08.12
-*
-* NC. New find comand. Is actually descibed in 2.06/08.
-
-
-+DECK,V2_06.
-*CMZ : 2.06/10 03/03/95 16.31.15 by N.Cremel
-*-- Author : N.Cremel 03/03/95
-*
-*::> VERSION 2.06/10 03/03/95 16.31.15
-*
-* ICONWIDGET : change || by &&
-*
-*::> VERSION 2.06/09 03/03/95 16.27.18
-*
-*
-* Implement the new FIND mechanism (new behavior for command "HELP".
-* Behavior of "HELP" is kept in new command name "CHELP" (for
-* "Command Help").
-* This new HELP is connected to the new directive:
-* >Keyword
-* list-of-keywords
-* in the CDF.
-* e.g.
-* >Command PSVIEW
-* >Parameters
-* FNAME 'File name' C
-* >Keyword
-* PostScript
-* display viewer
-* >Guidance
-* ...
-* Notes:
-* 1- This implies to install also the new CDF compiler (kuipc) and
-* the new kxterm.
-* 2- I have (at the same time) implemented in kuipc the new CDF directive:
-* >Link
-* list-of-links
-* similar to >Keyword (same logic), for future development arround the
-* HTML links.
-*
-* Bug correction: MAX_opt (for option-menu parameters) was not
-* tested (MKDCMP). Do other check on "MAX" definition ($MKDIMS).
-*
-*-- Author : Gunter Folger 05/10/94
-*
-*::> VERSION 2.06/08 24/02/95 14.42.34
-*
-* fix trivial = to == in iconwidget in #if
-*
-*::> VERSION 2.06/07 22/02/95 17.01.33
-*
-*
-* 03/02/95 15.58.06
-*
-* fsearch modified to correct problem for VMS when current dir is
-* search list
-* Iconwidget still; the difference is not Irix4, but Motif1.1 except Hp and
-* apollo, which have in Motif1.1 the 1.2 prototype
-*
-*::> VERSION 2.06/06 18/01/95 15.32.31
-*
-* uxxt : add test for "XtSpecificationRelease"
-*
-*::> VERSION 2.06/05 17/01/95 14.40.04
-*
-* adapt iconwdget for SGI Irix4.
-*
-*::> VERSION 2.06/04 17/01/95 09.56.35
-*
-* kuxxt : add test for "XtSpecificationRelease"
-*
-*::> VERSION 2.06/03 16/01/95 11.13.30
-*
-* Do not exit on input of mulitnational characters; they are ignored now.
-*
-* Write error message on attempt to create a vector with more than 3d;
-* previously quietly a 3d vector was created.
-*
-* Command panels: give possibility to have all parameters input in a
-* scrolled window. Add new resource "scrolledCmdPanel. In .Xdefaults:
-* *scrolledCmdPanel: auto (default)
-* or *scrolledCmdPanel: always
-* or *scrolledCmdPanel: never
-* "auto" means that the scrolled window is automatically created if the
-* number of params. > 10 (otherwise fixed size area). "always" and "never"
-* means, respectively, that the scrolled window is always (or never) created.
-*
-* km_create_sctext (used for "HELP") : calculate height of the window, to
-* avoid too big windows with small amount of text.
-*
-* new routine "CreateIconWidget" to avoid extern reference to "iconWidgetClass"
-* which was causing problems on VMS (for user-defined panels, "view" option
-* "by name and icon").
-*
-* KUXXT, ICONWIDGET : small corrections for DEC-CC.
-*
-* For panel definition: accept labels with blank inside and replace blanks
-* by '0' for valid alias definition (new routine strblk0).
-*
-* Bug correction in panel: when a new button is filled (mouse button 2)
-* or a button is erased (mouse button 3) then do it in all "views"
-* and not only in the current one (km_panel_execute).
-*
-* KMUMEN : small correction for DEC-CC.
-*
-* Panels: "view" option "by name and icon" is implemented (ICONWIDGET)
-* Change the logic in panel management.
-*
-* Allow for file names up to 256 chars in KUOPEN, including path; was 80
-*
-*::> VERSION 2.06/02 21/11/94 12.13.54
-* Correct typo in pop_stack
-*
-*::> VERSION 2.06/01 17/11/94 16.15.57
-*
-* 2 bugs correction in "panel" :
-* - "panel 0 d" protect empty panels (KUWHAT)
-* - "close" panel : give all panels a different title (MKDCMP)
-*
-* carry over previous fixesto kmacro, kuwham, mkdcmp, kmiout, and kxterm
-* add protection for failed execl call in kmisc/shsystem
-*
-*::> VERSION 2.06/00 05/10/94 12.02.47
-*
-* New commands GLOBAL/CREATE, IMPORT, DELETE, LIST for handling global
-* variables.
-*
-* Support for variable indirection and arrays of variables.
-*
-+DECK,V2_05.
-*CMZ : 2.05/22 09/11/94 12.26.44 by Gunter Folger
-*-- Author : Alfred Nathaniel 25/03/94
-*
-*::> VERSION 2.05/22 09/11/94 12.26.44
-*
-* Undo correction to fexpand, and move the fix into KMACRO; ie. KMACRO checks
-* if the macro name starts with a -, and then strips this - off, and ignores
-* the search path.
-*
-*::> VERSION 2.05/21 19/10/94 15.41.52
-*
-* Correct fexpand; it now also checks if the ftype needs to appended if the
-* filename starts with -.
-*
-*::> VERSION 2.05/20 17/10/94 12.19.43
-*
-* Take corrections from Fons for problem in kxterm ( after a command
-* the cursor went to column1 )
-* routines affected: /cmotif/kuwham,kmiout /kxterm/kxterm
-*
-*::> VERSION 2.05/19 11/10/94 17.25.32
-*
-* Fix kmacro to compile ok after correcting missing endcase/endif/.. in a macro
-*::> VERSION 2.05/18 07/10/94 10.33.38
-*
-* Correct mkdcmp (Nicole)
-* Fix reading from file on AIX, OSF, and Ultrix.
-
-*
-*::> VERSION 2.05/17 19/09/94 14.21.30
-*
-* getline() on VMS didn't realize when the terminal connection was dropped.
-*
-* $UNQUOTE did not work as intended.
-*
-* Fixed problems with edit server on VMS.
-*
-* Bug correction in multi_panel: panel 0 d title ' '.
-* Give possibility to open a panel "closed" (PalB) inside a palette:
-* panel 0 d title c
-* or
-* panel 0 d title c:200x200+0+0 (e.g. when specifying the button size)
-* Add "File" entries: "Close" and "Exit" in palettes.
-* --> MKMPAN, $MKUXPL, KUXPAB, KUXPAL.
-*
-* Add cursors km_help_cursor, km_busy_cursor, km_blck_cursor, km_selc_cursor
-*
-* Possibility to set "echo off" even with no kxterm (Ged)
-* (--> Kuwham, init_motif in KUWHAM).
-*
-* Multi_panels (Motif) : implement possibility to specify the panel size
-* with "panel 0 d name geometry" (or km_panel_display(name,geometry)
-* geometry = wxh+0+0 (position is ignored)
-* (km_panel_add --> $MKUTFM, KUWHAT, MKMPAN)
-*
-*::> VERSION 2.05/16 17/08/94 13.54.40
-*
-* Solve compilation problem on Apollo (true and false are cpp defines).
-*
-*::> VERSION 2.05/15 15/08/94 11.18.39
-*
-* Panels (Motif) : implement possibility to give an option
-* "panel x.y command [label] [pixmap] [opts]"
-* implement option "T" for "Toggle" behavior (button stays pressed
-* until another button is selected).
-* --> C user callable routine: km_panel_key_opt(
-* int row,int col,char *command,char *alias_label,char *pixmap,char *opt);
-* ($MKUTFM, $KFLAG_H, $KMPANEL, KUWHAT, MKDPAN)
-*
-* Bug correction for panels with icons (KICON)
-*
-* Allow APPLICATION terminator to be indented.
-*
-* In MACRO header allow default values as "[1]=0" in addition to "1=0".
-*
-* New INTEGER FUNCTION KUQKEY() returning 1 if user has hit the return key
-* or 0 otherwise.
-*
-* Provide KUCLOS entry point for KICLOS to make naming more consistent.
-*
-*::> VERSION 2.05/14 28/07/94 12.17.25
-*
-* SHELL: on VMS write command line into DCL file because LIB$SPAWN
-* does not do symbol substitution like in "LINK main,'LIB$'".
-*
-* Fortran callable entry for browser initialization (km_browser_set) :
-* KMBRSET(BRNAME, PATH)
-*
-* Browser initialization :
-* - user routine km_browser_set (char *br_name, char *path) (KMBROW)
-* --> to give initial values for opening the browser
-* - KUIP command "BROWSER br_name path" (execution at run time) (KUIPMCDF)
-*
-*::> VERSION 2.05/13 21/07/94 12.56.33
-*
-* Improve option list in command panels (MKDCMP)
-*
-* Reinstate strdup() for Ultrix.
-*
-*::> VERSION 2.05/12 15/07/94 16.19.42
-*
-* Fix in KUIPC.
-*
-*::> VERSION 2.05/11 15/07/94 14.59.04
-*
-* Correct bug when resizing the graphics windoe (MKDGRA)
-*
-*::> VERSION 2.05/10 15/07/94 09.46.11
-*
-* Fix in KUIPC.
-*
-*::> VERSION 2.05/09 14/07/94 15.10.11
-*
-* General cleanup of archaic stuff. From now on non-ANSI C compilers
-* are not supported anymore.
-*
-* Preparations for a "kuip.h" header file.
-*
-* Fix problem with same button label in different panels, for example,
-* "blue" button in two panels p1 and p2. One has to give a name to
-* the panel at the very beginning, e.g.
-* panel 0 r p1
-* panel 3.04 'blue/panel1' 'blue'
-* etc...
-* and panel 0 r p2
-* panel 3.04 'blue/panel2' 'blue'
-* etc...
-*
-* New resource "noKxterm" for suppressing kxterm creation and display.
-* Same can be achived by e.g. CALL KUINIM('Ged(-nokxterm)').
-*
-* New command "Browser browsable_name" to open a browsable (without having
-* to click with the mouse). Provided also as user callable routine:
-* km_set_browser(browsable_name).
-* E.g. "Browse Commands" opens the browsable class "Commands" defined
-* in the CDF. (N.B. the browsable_name is case sensitive).
-*
-* Restructuring of MKDGRA.
-*
-* Correction for char '~' (to be recognized as the home directory
-* in browser (decks KMBFIL, KMBMAC).
-* Correction for expanding correctly the Path with / when ~ is the first
-* character (deck KMBROW).
-* Correction for correctly execute "delete file" menu item in the
-* browser (cmmand 'KUIP/SHELL rm filename', deck MKDCMP)
-*
-* Implement parameter type KmTYPE_FILE for Motif (FileSelectionBox)
-* Add resources for cursor fonts: XmNmainCursor, XmNgraphCursor,
-* XmNinputCursor, XmNwaitCursor.
-* change disp_prompt_C from km_prompt to km_prompt_answer where the CANCEL
-* button (which was not meaningful) is suppressed.
-*
-* EXEC: on VM search all disks for .kumac files.
-*
-* KUSPY('OFF') now goes back to the argument position marked by KUSPY('ON')
-* instead of simply rewinding to the very first argument.
-*
-* KUGETH deleted. It was unsafe and could overwrite storage.
-* Hopefully nobody uses it.
-*
-* KUGETQ deleted.
-*
-*::> VERSION 2.05/08 27/06/94 15.07.11
-*
-* Fixed problem with blanks in CASE label list.
-*
-* Fixed compilation problem for VMS6.1 DECC.
-*
-*::> VERSION 2.05/07 16/06/94 14.39.41
-*
-* Added $SHELL(cmd,sep).
-*
-* New system function $EXEC.
-*
-*::> VERSION 2.05/06 06/06/94 12.40.01
-*
-* $SHELL(cmd) and $SHELL(cmd,' ') now return the complete output with
-* newlines replaced by blanks.
-*
-*::> VERSION 2.05/05 06/06/94 11.55.32
-*
-* MACRO/DEFAULTS -auto did not work because of case mismatch.
-* MACRO/DEFAULTS ~/dir did not work on some systems because default shell
-* does not understand ~ (reported by Maarten Litmaath).
-*
-* Macros: use checksum instead of file modification date to test if
-* .kumac file has changed. File system stamp have a granularity of
-* one second which could lead to problems.
-*
-* New system function $SHELL(cmd) and $SHELL(cmd,n) to return first or
-* n'th line of command output (for Unix only).
-*
-*::> VERSION 2.05/04 30/05/94 17.17.10
-*
-* Macros: variable indirection did not work.
-*
-* VAXC: go back to (much slower) standard malloc() routines.
-* The VAXC$MALLOC_OPT routines have a serious flaw:
-* for( n = 1; n < 100000; n++ ) buf = realloc( buf, n );
-* will exhaust the virtual address space?!?
-*
-* READ statement: show default value also if prompt is user supplied.
-*
-*
-*::> VERSION 2.05/03 26/05/94 09.41.07
-*
-* Fix for STOPM statement and ";&" logic in macros.
-*
-*
-*::> VERSION 2.05/02 24/05/94 16.31.33
-*
-* Rewrite of the KUMAC interpreter in C. The main difference is that
-* EXEC inside a macro is treated like any other command. This solves
-* a number of outstanding problems:
-*
-* -- "EXE", "M/EXEC", or any other abbreviation of the command path
-* "/MACRO/EXEC" is now allowed. Before this would lead to undefined
-* behaviour due to a recursive Fortran call.
-*
-* -- Defining an alias for an EXEC call or changing the MACRO/DEFAULT
-* path during macro execution has now the expected effect. Before
-* aliases and .kumac search where done at macro compilation time
-* rather than execution time.
-*
-* -- It is now possible to execute a macro containing EXEC calls to
-* non-existing .kumac files --- provided, of course, that the EXEC
-* is never reached, e.g. in a "CASE $OS IN ..." construct.
-*
-* -- It is now possible to create or to modify a .kumac file during
-* macro execution and call the macros in the new file.
-*
-* -- Mixed-case path names of .kumac files are possible now.
-*
-* The response time should be better than in the previous version:
-*
-* -- The new compiler needs only one pass rather than two passes over
-* the .kumac file.
-*
-* -- A macro calling other macros will compiler the other .kumac files
-* when needed rather than compiling everything up-front.
-*
-* -- Macros are cached --- if a .kumac file has been envoked already
-* beforehand and it hasn't been changed then it is not recompiled
-* when it is used again.
-*
-* In addition the following bugs are fixed in the new version:
-*
-* -- ON ERROR GOTO works now also for nested EXEC calls.
-*
-* -- Undefined numbered variables are now set to ' ' as documented.
-*
-* -- Depending on the length of the .kumac file name the use of several
-* variables in an expression could lead to truncation due to the
-* fixed length of a Fortran character string.
-*
-* The new version provides the following new features:
-*
-* -- The READ statement allows to specify the prompt string.
-*
-* -- The NEXTL statement allows to continue with the next loop iteration,
-* similar to the "continue" statement in C.
-*
-* -- BREAKL and NEXTL allow to specify how many levels of nested loops
-* should be skipped.
-*
-* -- The STOPM statement allows to stop macro execution, i.e. unwind
-* nested EXEC calls and return to the command line prompt immediately.
-*
-* -- The RETURN statement allows to specify the return value.
-*
-* -- The variable "[0]" contains the fully qualified macro name, i.e.
-* "/path/file.kumac#macro".
-*
-* -- ON ERROR handling allows now the following choices:
-* ON ERROR CONTINUE
-* ON ERROR GOTO label
-* ON ERROR EXITM value
-* ON ERROR STOPM
-*
-* -- The spelling "OFF ERROR" instead of "OF ERROR" is now allowed.
-*
-* -- Block constructs can now be written on a single line using ";"
-* as line separator, e.g. "cmd1 ; IF ... THEN ; cmd2 ; ENDIF".
-*
-* -- The macro constructs are now documented in the on-line help ---
-* try "HELP SYNTAX". Thanks to Mike Kelsey for editing the text.
-*
-* -- "!" as macro argument will now use the default value given in
-* the MACRO definition.
-*
-* The new version contains the following known incompatibilities:
-*
-* -- The command /MACRO/RECURSION has been deleted --- all macros are
-* recursive now.
-*
-* -- ":=" as alternative to the assignment operator "=" is not supported
-* anymore. NB: "LET var = expr" is still allowed.
-*
-* Special thanks to Robert Franchisseur, Mike Kelsey, and Andrea Parri
-* for beta-testing the new macro interpreter.
-*
-* --------------------------------------------------------------------
-*
-* Correction for char '~' (to be recognized as the home directory
-* in browser (decks KMBFIL, KMBMAC).
-*
-* Correction for expanding correctly the Path with / when ~ is the first
-* character (deck KMBROW).
-*
-* Correction for correctly execute "delete file" menu item in the
-* browser (KUIP/SHELL rm filename, deck MKDCMP)
-*
-* getline(): ^Z did not work on SunOS and other BSD based systems because
-* there getpgrp() needs pid as argument (in contrast to SysV and Posix)
-* (reported by Maarten Ballintijn).
-*
-* SHELL command: on Unix interpret command line by HOST_SHELL shell.
-* Before the command was passed to whatever shell was spawned by system().
-*
-* KUCMD would still create menus with identical names (reported by Sunanda
-* Banerjee).
-*
-* New system functions $FEXIST(filename).
-*
-* New command SET/DOLLAR to enable/disable the substitution of "$var" as
-* environment variables.
-*
-* New system function $ENV(var) to get environment variable independent of
-* DOLLAR setting.
-*
-*
-*::> VERSION 2.05/01 07/04/94 08.56.31
-*
-- Correction for compilation on VM
-- Bug correction in the browser on Sun (popup menus)
-- Give access to specific resources in the browser
- (e.g. fileScWindow.bottomOffset, etc...) for adjusting the browser
- "inside geometry" when using very big fonts (for the Geant demo
- at CHEP ...)
-*::> VERSION 2.05/00 25/03/94 16.34.38
-*
-- Complete redesign of the "Panel" interface :
- * menu-bar with "File", "View" and "Help" (instead of buttons "Save",
- "Close" and "Help" at the bottom).
- * possibility to have key with labels (aliases), commands or pixmaps.
- The general command for key definition is:
- "panel x.y command [label] [pixmap]"
- * In "View" menu, possibility to view:
- -> By Name
- -> By Icon
- -> By Name and Icon (not yet implemented).
- -> By Command (normal)
- -> By Command (1 col.)
- * Implement "context help" on all panel buttons (user defined).
- * Command "Panel 0 c" to close a panel in command mode.
-
-- Implement "Palette" interface silmilar to UIMX (command /MOTIF/MULTI_PANEL).
-
-- Provide a C callable interface for panels & palettes definition and display
-instead of using the macro language (Jamie's request for Ged).
-
-- Implement the possibility (user callable entries in C) to display a list and
-return one selection in a user-defined command (action routine) - User
-request -.
-
-- new routine "interactive_help_motif" to display a Motif selection box
-with all possible choices when typing "HELP" without any argument.
-
-- add fallback for "fileScWindow.width" (default 80) for changing ratio
-in the browser between the dir - and file - lists of objects (requested by
-Sven for Geant demo with big fonts).
-
-- Implement the possibility to have an "All Cycles" view option in the
-browser on VMS (at the moment it is commented). Change "XmNradioBehavior"
-to FALSE (to make combination of several view options possible).
-
-- Implement the possibility to specify "IconBoxTITLES" as a resource in
-.Xdefaults, e.g. "Paw++*iconType: 4" - User request -.
-
-- add resource "panelInteractive" (True by default, or False to inhibit
-"close" panel, and supress possibility for panel editing) - User request -.
-
-- Prevent the HELP window(s) to disappear under kxterm.
-
-- Store the "Paw++ Locate" window (km_HigzOutput) into the list of possible
-windows to be raised - User request -.
-
-- bug correction for empty strings inside command argument panels.
-+DECK,V2_04.
-*CMZ : 2.04/10 09/03/94 15.50.59 by Alfred Nathaniel
-*-- Author : Alfred Nathaniel 27/10/93
-*
-*::> VERSION 2.04/10 09/03/94 15.50.59
-*
-* More corrections for Convex version.
-*
-* SHELL: do not convert shell command to uppercase on VM --- NQS++ uses
-* lowercase options (reported by Dave Edsall).
-*
-* New interface class String=$fun(Number,String) for application defined
-* functions.
-*
-* KUIPC: protect against TABs in CDF input (reported by Walter F.J. Mueller).
-*
-* Change' Set/LCDIR [path]' to ' -Set/LCDIR [path]' in KUIPMCDF
-*
-*::> VERSION 2.04/09 01/03/94 11.27.08
-*
-* Changes in command PANELS (to correct a problem reported in HISTO/FIT)
-*
-* Introduction of teh command "panel 0 c title" ("panel close")
-* to close a panel with name title in a KUIP macro.
-* This was previously only possible with the mouse.
-*
-* Changes for CONVEX in $HKUIP_H, HKUIP and KEXEC
-*
-* Bug fix in KMENU when HELP without parameters
-*
-*::> VERSION 2.04/08 16/02/94 14.16.39
-*
-* Batch mode did not work on VAX/VMS due to wrong VAXC$CRTL_INIT() placement
-* (reported by John Marrafino).
-*
-* "cmd $fun([var])" did not work if [var] contained an operator like ".and."
-* (reported by Mats Cronqvist).
-*
-* CALL KUCMD('..',' ','SW') crashed when creating a menu without any commands
-* (reported by Vincenzo Innocente).
-*
-* Allow comma-separated list of names for ALIAS/DELETE and VECTOR/DELETE
-* (reported by Mike Kelsey).
-*
-* Corrections for Windows/NT port by Valeri Fine.
-*
-*::> VERSION 2.04/07 25/01/94 16.02.27
-*
-* KUFDEF: allow for functions without arguments given as "$name()".
-*
-*::> VERSION 2.04/06 25/01/94 13.33.49
-*
-* $FORMAT: fix for format descriptors like I9.5 which did not put leading
-* zeroes on VAX/VMS.
-*
-* Use Fortran READ for command input when stdin is not a terminal.
-* (RS/6000, DECstation, and Alpha-OSF/1 Fortran I/O does not use C-stream
-* functions.)
-*
-* KUCMD: missing check if a menu name already existed.
-*
-* KMFILE: remove version number from VMS file specs in browser.
-*
-* GETLINE: make it less noisy be removing some beeps.
-*
-*::> VERSION 2.04/05 22/12/93 09.43.07
-*
-* add ressource "centerCommand".
-* add command /MOTIF/ICON (panel with icons)
-* implement panel with icons.
-* suppress "Double Click" in list of browsables (browser).
-* new KUIPCC to suppress a bug for option parameter with integer values.
-*
-*::> VERSION 2.04/04 14/12/93 15.03.03
-*
-* KXTERM: corrections for transcript saving in VMS.
-*
-* HOST_PRINTER and KUIP/PRINT: new commands to send a file to the printer;
-* Print is now included in the action menus of the file system browser.
-*
-* MACRO/DATA: new command to be used as "APPL DATA file.name" to write text
-* from immediate data in a macro.
-*
-* New system function $IQUEST(I) returning the status vector element.
-* "IF $IQUEST(1)=0 THEN ..." allows to test the success of the last command.
-*
-* KUESVR: create lock file in /tmp if /usr/tmp fails, e.g. because directory
-* is NFS mounted and locking not supported (reported by Dave Edsall).
-*
-*::> VERSION 2.04/03 29/11/93 17.02.31
-*
-* Bug fix in the command pull-down menus of the main browser.
-*
-* Slight changes in the CDF.
-*
-*::> VERSION 2.04/02 23/11/93 16.47.06
-*
-* KXTERM: delay flow control to allow FFREAD from stdin.
-*
-* KUGETF: allow KUGETL mechanism to get a list of filenames.
-*
-* Command COLUMNS: add protection in case environment variable "COLUMNS" does
-* not contain a number (reported by Maurizio Loreti).
-*
-* getline: ^Z-suspend did not work if the program was called from a shell
-* script (reported by Maarten Ballintijn).
-*
-* $SUBSTRING(s,k,n) returned one character too much if k+n happened to be the
-* length of the string.
-*
-*::> VERSION 2.04/01 27/10/93 15.02.14
-*
-* KUIPC produced wrong Fortran code for a 64-character string on continuation
-* lines (reported by David Wagner).
-*
-* KUIPC: compiler-indepenent treatment of backslash in character strings.
-*
-*::> VERSION 2.04/00 27/10/93 10.29.10
-*
-* Use HOST_EDITOR setting in VMS Motif version.
-*
-* Break interception for Motif version on VMS.
-*
-* "cmd;" resulted in "unknown command cmd;" rather than executing the
-* command "cmd".
-*
-* last.kumac could not be written if application started in a directory with
-* a mixed-case name.
-*
-* Treat alias content in expressions as number if possible.
-*
-* Preserve trailing blanks in variable initialization in MACRO header.
-*
-* Preserve trailing blanks in macro variable assignment
-*
-* KUHOME: do not apply filecase conversion to allow uppercase directory names.
-*
-* Browser: corrections for editing for path window.
-*
-* KUOPEN: new status code 'DONTKNOW' which opens the highest cycle on VMS
-* ('UNKNOWN' creates a new cycle); on other systems equivalent to 'UNKNOWN'
-*
-* Disable Control-C for Motif version on VMS.
-*
-* Set Motif host editor to /DISPLAY=DECW.
-*
-* Mods for CONVEX version by Victor Balashov (Dubna).
-*
-* KIMATH: fix to recognize numbers .LT.1 without leading zero.
-*
-+DECK,V2_03.
-*CMZ : 2.03/15 01/10/93 16.26.50 by Alfred Nathaniel
-*-- Author : Alfred Nathaniel 05/07/93
-*
-*::> VERSION 2.03/15 01/10/93 16.26.50
-*
-* Motif: provide dummy mbstowcs() for VAX/VMS.
-*
-* KXTERM: fix communication problem if output stream contains # character.
-*
-*::> VERSION 2.03/14 29/09/93 15.50.24
-*
-* KXTERM: add display of current local directory.
-* Line buffering between application process and kxterm
-* because mailboxes use record I/O.
-*
-* MANUAL command: recursive descent to all submenus.
-*
-* EXEC command in Motif mode: allow to pass more than one macro argument.
-*
-* KIMATH: fix problem for "vec(1)<vec(2)".
-* Round to 6 significat digits before testing equality/non-eq. of expressions.
-*
-* Unix and VMS: use unique names for all tempfiles.
-*
-* KUVAR: don't do alias translations etc.
-*
-*::> VERSION 2.03/13 16/09/93 17.21.03
-*
-* KUIPC: fix for long names as >Action routines
-*
-* KUEDIT: test return code from system() == -1 rather than < 0
-*
-*::> VERSION 2.03/12 13/09/93 09.34.59
-*
-* KIMINT: don't interpret [] inside application text as variable names.
-*
-* KIMATH: Change in treatment of vector names to allow:
-* a = '?'
-* IF [a]='?' THEN
-*
-*::> VERSION 2.03/11 06/09/93 08.50.52
-*
-* $var now looks for environment variable on VMS as well. Uppercase names are
-* searched first in the logical names tables and then in the symbol table.
-* Lowercase names are searched for only in the symbol table. Replacement is
-* suppressed if $var is followed by a colon to avoid DISK$USER: etc.
-*
-* New command SET/LCDIR to change current working directory (only for Unix
-* and VMS).
-*
-* Asynchronous editing for VMS implemented (not yet fully tested).
-* HOST_EDITOR must be TPU/DISPLAY=MOTIF.
-*
-* $VEXIST did not work if the vector has existing. $QUOTE did not work
-* correctly (reported by by Tim Adye).
-*
-*::> VERSION 2.03/10 03/09/93 11.13.54
-*
-* Second iteration of KUIP/Motif for VMS.
-*
-*::> VERSION 2.03/09 02/09/93 11.53.22
-*
-* Bug fix for $VLEN function.
-*
-* First iteration of kxterm for VMS (C.W. Hobbs/DEC).
-*
-*::> VERSION 2.03/08 01/09/93 09.45.31
-*
-* Allow digits as first character in an alias name.
-*
-*::> VERSION 2.03/07 31/08/93 18.14.00
-*
-* New routine KUFDEF to define application specific system functions.
-*
-* Buffer flushing for RS/6000 to keep correct sequence of C and Fortran output
-* if stdout is redirected into a file. This requires compiler version xlf 2.3.
-*
-* First iteration of Windows/NT port (Valeri Fine).
-*
-*
-*::> VERSION 2.03/06 25/08/93 13.09.50
-*
-* Problems with +KEEP with PATCHY vs. CMZ installation.
-*
-* $OS and $MACHINE were not described in HELP FUNCTIONS
-*
-*::> VERSION 2.03/05 24/08/93 17.23.28
-*
-*
-* KUIPC: part of the menu tree was forgotten in C output mode (reported by
-* Robert Franchisseur).
-*
-* getline: mysterious hangups of Falco terminals connected to through a
-* DECserver line to Ultrix (reported by Rob Kreuger).
-* Went from POSIX terminal driver back to BSD driver for Ultrix.
-* BSD driver (also used for Apollo and NeXT) now catches typeahead.
-*
-* KIMINT: bug in the handling of nested IFs:
-* IF 1=1 THEN
-* IF 1=1 THEN
-* IF 1=0 THEN
-* mess Not reached
-* ELSE
-* mess first
-* ENDIF
-* ENDIF
-* mess Okay
-* IF 1=1 THEN
-* IF 1=1 THEN
-* mess second
-* ENDIF
-* ENDIF
-* ENDIF
-* did not execute any of the commands! (Reported by Nige Watson.)
-*
-* KIMATH: Vector indizes can now contain expressions, e.g. VEC([n]+1)
-*
-* KUGETI/KUGETR: Arguments can be expressions which are evaluated.
-*
-* System functions can now be nested and the arguments can be expressions,
-* e.g. "$lower($substring($OS$MACHINE,[k]+1,2*[n]))"
-*
-* New system functions: $INDEX(str1,str2), $WORDS(string,[sep]),
-* $WORD(string,[k,[n,[sep]]]), $QUOTE(string), $UNQUOTE(string),
-* $INLINE(string).
-*
-* ALIAS/CREATE: value is alias expanded; new option "-N" to inhibit expansion.
-*
-* ALIAS/LIST: print alias names sorted alphabetically.
-*
-* KIMINT: case labels were not properly recognized if the command following
-* on the same line contained parenthethes. (Reported by Mike Kelsey).
-*
-* KIMCAL: FOR statement crashed if the loop index had a name
-* longer than 4 characters. (Reported by Mike Kelsey).
-*
-* KIMCAL: SHIFT left a quote character at the end of [*]. (Reported by
-* Mike Kelsey).
-*
-* The modifications for ;& and ;! introduced a bug: single commands always
-* returned status code 0. As a result HELP went into the editor even if
-* the command name was invalid. (Reported by David Wagner).
-*
-* Final fix for old-style behaviour for optional parameters without defaults
-* (mainly used by GEANT drawing commands). (Thanks to Shaheen Tonse and
-* Dean Chacon for pointing it out the actual problem.)
-*
-* KUVCRE actually imposed an upper limit of 10 characters for vector names.
-* STYLE G did not write commands to LAST.KUMAC.
-* TRACE ON WAIT did not allow to skip a command.
-*
-*
-*::> VERSION 2.03/04 05/08/93 12.29.35
-*
-*
-* new command "NEWPANEL" (defined in KUIPCDF) for building a new and
-* empty panel to be filled interactively at run time.
-* add possibility to raise (popup) the kxterm window.
-* add a "LIST" button to all options parameters which gives access to a
-* full explanation of the options.
-* add "Exit" in the browser window (menu "File").
-* update "helps" in KUIPMCDF.
-*
-*::> VERSION 2.03/03 12/07/93 10.17.35
-*
-* Yacc grammar did not treat the cases of more than one string concatenation
-* per expression and the comparison of a numeric value to a string.
-*
-*::> VERSION 2.03/02 07/07/93 18.35.24
-*
-* Fix for KUIPC and YKUIP.
-*
-*::> VERSION 2.03/01 06/07/93 10.02.10
-*
-* Fix for Alpha/OSF.
-*
-*::> VERSION 2.03/00 05/07/93 17.35.42
-*
-* KIMATH: the evaluation of
-* a = -2.34
-* b = 40
-* c = [a] - [b]
-* resulted in c = -0.234E-39. (Reported by Walter Brueckner).
-* Expression evaluation is now done by a Yacc-generated parser which allows
-* arbitrarily complex expressions like
-* c = [a]*[x] + [b]
-* The IF statement can now also contain a combination of logical expressions
-* like
-* if [a]<[b] .and. [c]>[d] then
-* ...
-* endif
-*
-*
-* STYLE G: clicking on the black box to select another option value could
-* hand up the system in case one of the option values was the blank string.
-* (Reported by Robert Franchisseur).
-*
-*
-* KUIPC produced garbage Fortran code if the guidance text contained lots of
-* significant blanks. (Reported by Lawrence Williams).
-*
-* KUIPC in Fortran output mode did not handle correctly >Menu directives going
-* upwards more than one level. (Reported by Steve Fisher).
-*
-*
-* KUOPEN: added CALL DMCSCL... to avoid locking of VM-SFS files.
-* (Request by Wojciech Wojcik).
-*
-* SHELL for Apollo: memory was overwritten when the shell command exceeded
-* 128 characters. Also /bin/ksh was started as a restricted shell.
-* (Reported by Nige Watson).
-*
-* GETLINE: add support for DEC function keys F12/F13/F14.
-* (Request by Jim Conboy).
-*
-* A command list separated by semicolon was not quite equivalent to the same
-* commands on consecutive lines: In
-* CMD1 ; CMD2
-* the second command was not executed if the first one returned a non-zero
-* status code. CMD2 is now executed even if CMD1 fails. The construct
-* CMD1 ;& CMD2
-* allows to execute CMD2 only if CMD1 succeeds while
-* CMD1 ;! CMD2
-* executes CMD2 only if CMD1 fails. (Request by Burkhard Burow).
-*
-*
-* Motif part: fixed some cases of NULL pointer dereferencing.
-+DECK,V2_02.
-*CMZ : 2.02/09 07/06/93 15.43.12 by Alfred Nathaniel
-*-- Author : Alfred Nathaniel 29/04/93
-*
-*::> VERSION 2.02/09 930607 15.43
-*
-* KMDIAL: fix for Piaf password prompt in Motif.
-*
-*::> VERSION 2.02/08 930604 13.55
-*
-* Deck KUPIAF removed. Piaf syncronization moved into PAW.
-*
-*::> VERSION 2.02/07 930527 13.11
-*
-* Linux version introduced.
-*
-* Restructuring of getline(): previous terminal interface recognition failed
-* for NeXT.
-*
-* Motif window for menu guidance text.
-*
-*::> VERSION 2.02/06 930526 15.19
-*
-* On Apollo the complete C part can and should be compiled under BSD now.
-*
-* SHELL command: fixed problem with VMS batch and Apollo /bin/sh.
-*
-*::> VERSION 2.02/05 930525 18.24
-*
-* New routine KUPROP(CHPRMT,CHVAL,NCH) to prompt for a password.
-*
-* STYLE GP: panel lines can be redefined with fewer numbers of fields.
-*
-* Piaf synchronization for VMS/Multinet implemented.
-*
-*::> VERSION 2.02/04 930511 15.22
-*
-* Bug fix in ICONBOX.
-*
-*::> VERSION 2.02/03 930511 15.10
-*
-* The routine registered by KUCOMV is now called without arguments. The called
-* routine has to CALL KUVNAM(VNAME) to retrieve the vector name which was
-* deleted.
-*
-*::> VERSION 2.02/02 930507 10.30
-*
-* KUCOMV routine was only called for '*' (delete all vectors).
-*
-*::> VERSION 2.02/01 930504 11.49
-*
-* New routine KUCOMV(SUB) to register a subroutine SUB(CHNAME) which is called
-* whenever a vector is deleted. This is mainly needed for COMIS which keeps a
-* table of defined vectors.
-*
-* New system function $FORMAT(number,format) to format a number according to a
-* Fortran-like FORMAT string, e.g. $FORMAT([x],F9.3). Supports F,E,G,I, and
-* Z (hexadecimal).
-*
-*::> VERSION 2.02/00 930429 17.48
-*
-* KIDTAB: replace TABs by an equivalent number of blanks (assuming tab
-* positions are every 8th column). Before TABS were replaced by a single
-* blank only.
-*
-* STYLE G could not be used in PAWLOGON.
-*
-* Add minus sign to list of valid characters for building alias names
-* (request by Per Scharff-Hansen).
-*
-* KUGETE did not work when prompting for missing mandatory argument
-* (reported by Steve Fisher).
-*
-* KIMINT: label calculation caused integer overflow when using more than
-* 26 IF-ENDIF constructs (fatal on VMS). Changing from MAXIFS=200,MAXIFN=20
-* to MAXIFS=120,MAXIFN=10 should push the limit beyond 100. Hopefully
-* nobody uses more then 10 levels of nested IFs.
-*
-* KUARGS: mismatch between code and manual. Option BATCH should NOT imply
-* NOLOG, i.e. LOGON.KUMAC should still be executed.
-*
-+DECK,V2_01.
-*CMZ : 2.01/07 06/04/93 11.47.34 by Alfred Nathaniel
-*-- Author : Alfred Nathaniel 25/02/93
-*
-*::> VERSION 2.01/07 930406 11.47
-*
-* Fix for KUGETx returning last value for optional parameters without default
-* in case of positional arguments.
-*
-*::> VERSION 2.01/06 930406 9.43
-*
-* "$name" will be replaced by value of environment variable if it is defined
-* and "name" is not a KUIP system function.
-*
-* Allow switching to STYLE G from logon kumac.
-*
-* STYLE G: high-light last choice in menus; if panel is defined display it
-* along with menus (reported by Robert Franchisseur).
-*
-* Increased limit for number of macro arguments from 9 to 99.
-*
-* IBM: disabled trapping of floating point underflows (CALL XUFLOW).
-* Remove call to KUALFA from error handler. This caused recursive Fortran I/O
-* in the GKS version.
-*
-* DECstation c89: make it compile without "-common" option.
-*
-* Fixes for MSDOS version using f2c and gcc (Valery Fine).
-*
-* Set IQUEST(1)=0 before calling action routine to fix problem of VECTOR/READ
-* with good filename being ignored after a VECTOR/READ with an invalid filename
-* (reported by IVERSEN at VSFYS1.FI.UIB.NO)
-*
-* KUGETx returns last value for optional parameters without default value.
-* Interactive Geant relies on this e.g. for the DRAW command.
-*
-* Version 2.01/02 introduced that all floating point numbers were printed with
-* a decimal point. This broke the usage of $SIGMA for index calculations. The
-* old behaviour that e.g. $SIGMA(2*3+1) returns "7" is restored.
-* To solve the problem which originally triggered the change a new system
-* function $RSIGMA is available now. This function has be to used in COMIS
-* calls expecting a REAL argument, e.g.
-* CALL file.f($RSIGMA(sqrt(x(1)))
-* Otherwise the value may be passed as an INTEGER if the SIGMA result turns out
-* to be a whole number.
-*
-* Filecase conversion for EXEC statements inside KUMACS.
-*
-* The invisible vector ? was not correctly treated for subranges (reported by
-* Nicole Lhermitte).
-*
-* A continuation line start in the first column is concatenated as-is, e.g.
-* VEC/READ x,y,_
-* z,t file.dat
-* is equivalent to "VEC/READ x,y,z,t file.dat". Before there was put in at
-* least one blanks between the concatenated lines.
-*
-* getline(): implemented ^J/LF (delete word), ^R (refresh) and ^X for style DCL
-* and do output buffering. Prefer Posix over BSD termio to solve problem with
-* type-ahead on Sun.
-*
-* KUIP/SHELL for Apollo: use pgm_$invoke() instead of system(). Otherwise
-* /com/sh is suspected to overwrite memory because of an unassigned I/O stream
-* (reported by Robert Franchisseur).
-*
-*::> VERSION 2.01/05 930311 12.35
-*
-* Fix problem if too many alias expansions happen during kumac compilation
-* (reported by Hanspeter Beck).
-*
-*::> VERSION 2.01/04 930308 11.31
-*
-* Fix for help menu in browser.
-*
-*::> VERSION 2.01/03 930305 15.12
-*
-* Renamed IGXMES to KMXMES.
-*
-* Motif version: enable help menus again.
-*
-*::> VERSION 2.01/02 930302 18.12
-*
-* Bug fix for $SUBSTRING.
-*
-* VECTOR/INPUT: bug fix for 2-dim vectors
-*
-* VECTOR/PRINT: print proper indizes for 2-dim vectors
-*
-* First iteration for Alpha/OSF.
-*
-* KUIP/EDIT: default .KUMAC extension missing for MVS.
-*
-* Fix recursion if $LAST is used in a command (reported by B. BUROW).
-*
-* Emulate "%G" and "%.<n>d" format which behaves improperly on VAX/VMS.
-*
-*::> VERSION 2.01/01 930226 17.22
-*
-* Small fix in KXTERM.
-*
-*::> VERSION 2.01/00 930225 17.52
-*
-* KXUNIT: protection against very long filenames.
-*
-* A few more corrections for NeXT.
-*
-* KUIPC: allow call with input file name only.
-*
-* Ignore quotes around string in $SUBSTRING expression.
-*
-* Allow compilation with non-ANSI compiler.
-*
-* Non-folkloristic functions strdup(), strcasecmp(), etc. are only redefined
-* if they do not exist in the C-library.
-*
-* New routine KUGETQ to protect arguments with multiple tokens by quotes.
-* To be used by MACRO/EXEC that "EXEC macro 'Hello World'" is passed as
-* one argument.
-*
-* More MVS/NEWLIB corrections.
-*
-* LAST command changed: the new default N=-99 behaves like the old
-* default N=-1. Values -99<N<0 print out the last -N commands.
-* This scheme originally invented for MVS support is also useful to
-* allow cut-and-paste of blocks of commands on workstation screens.
-*
-+DECK,V2_00.
-*CMZ : 2.00/16 15/02/93 17.08.42 by Alfred Nathaniel
-*-- Author : Alfred Nathaniel 04/12/92
-*
-*::> VERSION 2.00/16 930215 17.08
-*
-* The location of the kxterm executable can now be defined as environment
-* variable KXTERM.
-*
-* Access from C to PAWC through a pointer to allow the use of dynamic common
-* blocks on IBM.
-*
-* Corrections for MVS (Harald Butenschoen).
-*
-* Ansi C compiler on Sun provides fixed include files <time.h> and <signal.h>.
-*
-* V/CREATE and V/INPUT allow again vector elements to be used as initializers
-* (reported by L.Pontecorvo)
-*
-* The macro READ statement did not provide the correct default value for
-* already existing variables (reported by Timothy Cox).
-*
-* The number of commands in the history list printed by "!" is now restricted
-* to the value set by SET/RECORDING.
-*
-*::> VERSION 2.00/15 930201 14.27
-*
-* SET/ROOT was looking at menus at the same level as the root menu.
-* SET/ROOT now changes the prompt to the menu name.
-* (Problems reported by Mogens Dam.)
-*
-* KUIP/EDIT creates new files in the first directory in the MACRO/DEFAULTS
-* search list. Before it has always created in the current directory.
-* (Problem reported by Nige Watson.)
-*
-* Another bug fix for string concatenation: "abc//'def'//ghi" gave the
-* wrong result. (Problem reported by Nicole Lhermitte.)
-*
-* KUGETL: blank values in a variable length argument list were ignored.
-*
-* Remove edit server lock file before exiting.
-*
-* Avoid "writable strings" problem with default values.
-*
-*::> VERSION 2.00/14 930128 18.32
-*
-* Alpha/VMS CC with /STAN=VAXC is now compiling without warnings.
-*
-* Second iteration for NeXT implementation.
-*
-* Bug fix in getline(): memory was overwritten when prompt exceeded
-* 80 characters (affected PAWGKS on VMS).
-*
-* After 3 consecutive ^C ask whether he wants to exit from application.
-*
-* Put additional calls to KUALFA in strategic places.
-*
-* "READ var" keeps the initial value of macro variable when pressing <CR>.
-* Problem reported by Tim Cox.
-*
-* For implicit LOOP arguments to commands: comma is only recognized as
-* argument separator if it is outside balanced ().
-*
-* For KUGETL: comma is only recognized as argument separator if it is
-* outside balanced () or ''.
-*
-*::> VERSION 2.00/13 930126 16.50
-*
-* Avoid compiler warnings on Apollo and SGI.
-*
-* Fix for accessing common blocks from C on Cray.
-*
-* Restored old behaviour for KUPROx routines: input value is left unchanged
-* if typing <CR>.
-*
-* Fix for SUN and DECstation: strtod() is declared in <math.h> instead
-* of <stdlib.h>
-*
-* Replace long by int: we assume that int is at least 32 bits.
-*
-* New routine KUGRFL to flush the graphics output after each command.
-* The routine passed should do the same as IGTERM for X11 but be dummy for GKS.
-*
-* KUGETE ignored default value.
-*
-* First iteration for NeXT implementation.
-*
-* KIMULT: '*' was missing from list of characters which inhibit ';' being
-* the line separator --> on VMS "shell del file.type;*" was not working
-* inside a macro.
-*
-*::> VERSION 2.00/12 930122 21.24
-*
-* Removed KUALFA after each command executed.
-*
-* On VM/CMS: replace sleep() emulation by call to SLEEPF (clash with with
-* entry in COMMTXT.TXTLIB).
-*
-* On VAX/VMS: MACRO/DEFAULT -Auto worked only if a search path was set.
-*
-* Undefined numbered variables, e.g. [1] are now replaced by "!".
-*
-* KUGETI and KUGETR now prompt in case the argument is not a valid number.
-*
-* Wrong logic in string concatenation: "abc//def//'ghi'" became "'abc//defghi'"
-* instead of "'abcdefghi'".
-*
-* "TRACE ON TEST" executed action routines.
-*
-*::> VERSION 2.00/11 930121 16.27
-*
-* "V/CREATE name" is now treated as "V/CREATE name(1)".
-*
-* Environment variable KUIPEDITOR takes precedence over EDITOR.
-*
-*::> VERSION 2.00/10 930120 18.43
-*
-* New CDF features are now available as well through Fortran mode of KUIPC.
-*
-* "-option" was only recognized if it was the last argument on the command
-* line.
-*
-* Use G-format instead of F-format to convert result of $SIGMA.
-*
-* Edit server is only used if HOST_EDITOR command contains a '&'.
-* HOST_EDITOR 'vi &' is treated as HOST_EDITOR 'xterm -e vi &'.
-*
-*::> VERSION 2.00/09 930118 16.45
-*
-* Style GP reimplemented.
-*
-* Motif terminal kxterm introduced.
-*
-*::> VERSION 2.00/08 930115 14.06
-*
-* FATMEN's "LS file -L" did not work because the second parameter is an
-* Integer which had implictly the MINUS flag set inhibiting the CHOPT trial.
-* ==> KUIPC changed that the MINUS flag for numeric parameters is not set
-* automatically any more. Instead "-value" on a numeric argument position
-* is checked whether it is a number. Otherwise the CHOPT assignment is tried.
-*
-* The filename "last.kumac" was undefined when exiting with having executed
-* a LAST command (message "Cannot open" when leaving application).
-*
-* In order to allow the new HPLOT escape sequences "@[" an undocumented
-* feature had to be removed: The construct "@[name]" forced variable
-* substitution even inside quoted strings. The same functionality is
-* achieved by using "//" for string concatenation, e.g. "vecname='vec@[n]'"
-* has to be replaced by "vecname='vec'//[n]".
-*
-* Bug fix for VMS file paths inside macros, e.g. "shell dir disk$xx:[user]".
-* Note: VMS file paths may NOT appear in EXEC statements inside a macro,
-* i.e. "EXEC DISK$xx:[user]macnam" does not work inside a macro (it does
-* though when entering it on the command line).
-* Workaround: define a logical name for the directory path and use
-* "EXEC LOG_NAME:macnam" or include the directory in the kumac search
-* path "MACRO/DEFAULT [],DISK$xx:[user]" and use "EXEC macnam".
-*
-*::> VERSION 2.00/07 930113 15.58
-*
-* Typing "Q" after WAIT prompt terminates macro execution.
-*
-* Bug fix in Motif prompt for WAIT command.
-*
-*::> VERSION 2.00/06 930112 18.45
-*
-* In concatenated system functions, e.g. "$machine$os" only the last one
-* was replaced.
-*
-* Macro variables "[%var]" were not replaced.
-*
-* TRACE ON WAIT implemented.
-*
-* All keyboard input requests are now done through Motif widgets.
-*
-* KGETAR did not work for VMS.
-*
-* New special argument value "!!" replaced by value used for previous
-* command execution, i.e. for mandatory parameters it behaves like
-* pressing <CR> at prompt.
-*
-* "-option" syntax was misbehaving if a shorted range value was a substring
-* of a longer range value.
-*
-*::> VERSION 2.00/05 930107 17.38
-*
-* The dollar sign can be used in alias names.
-*
-* LaTeX manual formatting improved.
-*
-* Command LAST excluded the last command.
-*
-* Appending the default ".KUMAC" filetype was not done for VMS path names
-* like "[dir.sub]file".
-*
-* Problems with macro variable substitition if macro file name contains a
-* VMS directory path solved. (Special thanks to Rob Kreuger for reporting
-* the VMS related problems.)
-*
-* MACRO/DEFAULT -Auto/AutoReverse reimplemented. The default path can now
-* be a comma separated list of directories.
-*
-*::> VERSION 2.00/04 921218 17.03
-*
-* Falco terminals lost arrow keys when logging into TAGIBM because the
-* escape sequences changes from "ESC-[-A" to "ESC-O-A".
-*
-* VMS signal handler installed to avoid program aborting for VMS
-* specific exceptions, e.g. invalid filenames.
-*
-* Unix only: KUHOME replaces now again environment variables in
-* filenames, e.g. $HOME/file.type
-*
-* When prompting for missing arguments the last used value is proposed
-* as default.
-*
-*::> VERSION 2.00/03 921214 19.06
-*
-* KUIPAPPL.TMP files are opened for unformatted access to allow RECFM V
-* on VM/CMS.
-*
-* Bug fix for VM/CMS crash in KUPATH: In a CALL SUB('ABC') to a C function
-* SUB(char *ptr, int*len) the pointer ptr my NOT be considered as a local
-* variable. Doing ptr++ will be disastrous in the end.
-*
-*::> VERSION 2.00/02 921211 18.13
-*
-* KUIP system functions were not substituted if used in CASE
-* e.g. CASE $OS IN ... did not work
-*
-* Bug fix for VM/CMS crash when calling help for command with
-* >User-Help twice
-*
-* KUARGS for option -n (no logon kumac) fixed
-*
-* Assignments "name = val" evaluated to "name = @macname[val]".
-* Fixed by removing the obsoleted feature of decoding unbracketed
-* variable names on the right hand side, i.e. "i = i+1" must now
-* be written as "i = [i]+1".
-*
-* KUVAR was passing a string constant to routines which could overwrite it.
-*
-* Name clash with FATMEN for routine fmatch(). Renamed to fwmatch()
-*
-* Command repetition now also recognized if ! is not in first column.
-*
-* Recognize alias names as help item, e.g. "A/CRE LS DIR C; HELP LS"
-*
-* Delete KUIPHELP.TMP file after exiting from HELP in -EDIT style
-*
-*::> VERSION 2.00/01 921209 17.54
-*
-* Delete temp vectors created for non-contiguous subarrays
-*
-* For gcc (Sun) use option -fwritable-strings
-*
-*::> VERSION 2.00/00 921204 21.36
-*
-* A large fraction of KUIP has been rewritten in C. The new version is
-* intended to be (mostly) backwards compatible to the old one but because
-* of the large amount of new code involved we cannot exclude that some
-* incompatibilities remain. We want to urge all users to test their KUMAC
-* files with the PAW version in the new area before it goes into production.
-*
-* At the moment the following features are not yet fully implemented:
-*
-* DEFAULTS -AUTO
-* MANUAL in SGML and plain TeX
-* STYLE GP
-* TRACE WAIT
-* system functions for STYLE GP ($KEYNUM, $KEYVAL)
-*
-*
-* Known incompatibilities:
-*
-* - Alias names may contain only letters, digits, @-signs and underscores.
-* (If someone can make a strong case that this is too restrictive,
-* let us know; we can still consider going back to the old scheme.)
-*
-* - The commands /KUIP/LISTHELP and /KUIP/SET_SHOW/MODE have been removed.
-*
-*
-* Improvements:
-*
-* - There is no limit on the number of aliases anymore.
-* Since KUMAC variables are treated internally as a special kind of
-* alias complex macros could hit the limit of 200 aliases before.
-*
-* - The HELP command recognizes now abbreviations for submenu names.
-* E.g. HELP H/OP works now while before HELP HISTOGRAM/OPERATIONS had
-* to be spelled out.
-*
-* - The HELP command does a simple text formatting. The line length is
-* controlled by /KUIP/SET_SHOW/COLUMNS.
-*
-* - The HELP -EDIT option is now implemented for all systems.
-* A new command /KUIP/SET_SHOW/HOST_PAGER defines the pager used to
-* display the help text. E.g. on a Unix workstation define
-* HOST_PAGER 'xterm -e view &' to display the help text in a
-* separate window.
-*
-* - A new command /KUIP/SET_SHOW/FILECASE allows now to select the case
-* sensitivity for filenames on Unix systems. Before this functionality
-* was hidden as STYLE '-FILECASE ON'.
-*
-* - A new command /KUIP/SET_SHOW/RECALL_STYLE to define the command recall
-* and editing style. There is a choice between ksh/emacs-like binding
-* and the key definitions used by DCL command line editing on VAX/VMS.
-*
-*******************************************************************************
-* - A completely new Motif interface with a browser for application *
-* specific object types and many more features. *
-*******************************************************************************
-*
-+PATCH,$KUMACS.
-+DECK,CLEAN.
-*CMZ : 1.68/00 02/03/92 13.55.43 by Fons Rademakers
-*-- Author :
-
-*****************************************************************
-* *
- macro clean os=x ftn=x
-* *
-*****************************************************************
-
-mess 'Deleting old fortran and binary files....'
-
-if [os] = unix goto unix
-if [os] = vm goto vm
-if [os] = vms goto vms
- goto error
-
-unix:
- host_shell /bin/sh
-* shell /bin/rm -fr [ftn]
- shell /bin/mkdir [ftn]
- goto end
-
-vm:
- shell gime 20 [ftn]
-* shell erase * fortran [ftn]
-* shell erase * text [ftn]
- goto end
-
-vms:
-* shell delete '[.'//[ftn]//']*.*;*'
-* shell delete [ftn].dir;*
- shell create/directory/protection=(o:dwre) '[.'//[ftn]//']'
- goto end
-
-error:
-mess *** Error in clean: os = [os], ftn = [ftn] ***
-
-end:
-mess 'Deleting old fortran and binary files....done'
-
-return
-
-+DECK,HELP.
-*CMZ : 1.68/00 02/03/92 13.55.43 by Fons Rademakers
-*-- Author :
-
-
-*****************************************************************
-* *
- macro help name=x
-* *
-*****************************************************************
-
-if [name] = apollo goto apollo
-if [name] = sgi goto generic
-if [name] = hpux goto generic
-if [name] = sun goto generic
-if [name] = decs goto generic
-if [name] = ibmrt goto generic
-if [name] = aix370 goto generic
-if [name] = cray goto generic
-if [name] = ibm goto generic
-if [name] = newlib goto generic
-if [name] = vax goto generic
-
- mess ' '
- mess 'To install KUIP type the following:'
- mess ' '
- mess ' EXEC INSTALL <machine> [<opt>] [-dev] [-lib]'
- mess ' '
- mess 'Where <machine> may be one of the following:'
- mess ' apollo, sgi, hpux, sun, decs, ibmrt, aix370,'
- mess ' cray, ibm, newlib, vax'
- mess ' '
- mess 'To see the possible values of <opt> for a specific machine type:'
- mess ' EXEC <machine> help or EXEC <machine> ?'
- mess ' '
- mess 'The option -dev should only be specified for compiling and'
- mess 'linking in debug (development) mode.'
- mess ' '
- mess 'If option -lib is specified a stand-alone library will be created,'
- mess 'otherwise the object file(s) are kept for later usage.'
- mess ' '
- goto end
-
-apollo:
- mess ' '
- mess 'To install KUIP on the '//[name]//' type:'
- mess ' '
- mess EXEC INSTALL [name] '[<opt>] [-dev] [-lib]'
- mess ' '
- mess 'Where <opt> may be one of the following:'
- mess ' m68k (default) to install CMZ on a motorola Apollo'
- mess ' a88k to install CMZ on a DN10000 Apollo'
- mess ' '
- mess 'The option -dev should only be specified for compiling and'
- mess 'linking in debug (development) mode.'
- mess ' '
- mess 'If option -lib is specified a stand-alone library will be created,'
- mess 'otherwise the object file(s) are kept for later usage.'
- mess ' '
- goto end
-
-generic:
- mess ' '
- mess 'To install KUIP on the '//[name]//' type:'
- mess ' '
- mess EXEC INSTALL [name] '[-dev] [-lib]'
- mess ' '
- mess 'The option -dev should only be specified for compiling and'
- mess 'linking in debug (development) mode.'
- mess ' '
- mess 'If option -lib is specified a stand-alone library will be created,'
- mess 'otherwise the object file(s) are kept for later usage.'
- mess ' '
- goto end
-
-end:
-return
-+DECK,INSTALL.
-*CMZ : 1.68/00 02/03/92 13.55.43 by Fons Rademakers
-*-- Author :
-
-
-*****************************************************************
-* *
- macro install 1=x 2=x 3=x 4=x
-* *
-*****************************************************************
-*
-*-- delete any alias that may interfere with the macro
-*
-alias/delete *
-
-*
-*-- some of the variables used in this script
-*
-* NAME Kind of machine
-* CPU CPU type (for Apollo only: m68k or a88k)
-* OS Operating system type: Unix, VMS, VM, NEWLIB
-* FTN Name of subdirectory for fortran files
-* VERS Version of cernlib to link with
-* DEV If -dev then development version, compile with debug flag
-* LIB If set a stand-alone library will be created, if not
-* the object files will be kept for later use
-*
-NAME = $lower([1])
-A2 = $lower([2])
-A3 = $lower([3])
-A4 = $lower([4])
-OPT = x
-DEV = x
-LIB = x
-VERS = new
-
-if [A2] <> -dev goto endif2
- DEV = [A2]
- goto arg3
-endif2:
-if [A2] <> -lib goto endif3
- LIB = [A2]
- goto arg3
-endif3:
-OPT = [A2]
-arg3:
-if [A3] <> -dev goto endif4
- DEV = [A3]
- goto arg4
-endif4:
-if [A3] <> -lib goto endif5
- LIB = [A3]
- goto arg4
-endif5:
-if [A3] = x goto arg4
-goto help
-arg4:
-if [A4] <> -dev goto endif6
- DEV = [A4]
- goto arg5
-endif6:
-if [A4] <> -lib goto endif7
- LIB = [A4]
- goto arg5
-endif7:
-if [A4] = x goto arg5
-goto help
-arg5:
-
-*
-*-- the user wants help or needs help
-*
-if [NAME] = ? goto help
-if [NAME] = help goto help
-if [NAME] = x goto help
-
-if [OPT] = ? goto help1
-if [OPT] = help goto help1
-
-*
-*-- set the variables before the actual installation
-*
-if [NAME] = apollo goto apollo
-if [NAME] = sgi goto unix
-if [NAME] = hpux goto unix
-if [NAME] = sun goto unix
-if [NAME] = decs goto unix
-if [NAME] = ibmrt goto unix
-if [NAME] = aix370 goto unix
-if [NAME] = cray goto unix
-if [NAME] = ibm goto ibmvm
-if [NAME] = newlib goto newlib
-if [NAME] = vax goto vms
- goto help
-
-apollo:
- CPU = [OPT]
- if [CPU] = x goto m68k
- if [CPU] = m68k goto unix
- if [CPU] = a88k goto unix
- goto help1
- m68k:
- CPU = m68k
- goto unix
-
-unix:
- OS = unix
- FTN = ftn
- goto endif1
-
-ibmvm:
- OS = vm
- FTN = M
- goto endif1
-
-newlib:
- OS = newlib
- FTN = M
- goto endif1
-
-vms:
- OS = vms
- FTN = ftn
- goto endif1
-
-endif1:
-
-*
-*-- here follows the actual install stuff
-*
-mess ' '
-mess Installation of CMZ on [NAME] starting at $DATE $TIME .....
-mess ' '
-
-exec clean os=[OS] ftn=[FTN]
-exec load name=[NAME] os=[OS] ftn=[FTN] cpu=[CPU] dev=[DEV]
-if [LIB] <> x goto library
- cfor /
- set c -lan
- cfor /
- set ftn -lan
- goto endif8
-library:
- cflib /
- set c -lan
- cflib /
- set ftn -lan
-endif8:
-
-mess ' '
-mess 'If you also want to build kuipc type:'
-mess exec kuipc name=[NAME] os=[OS] vers=[VERS] dev=[DEV]
-mess ' '
-
-mess ' '
-mess Installation of CMZ on [NAME] finished at $DATE $TIME .....
-mess ' '
-
-goto end
-
-
-help:
-exec help
-goto end
-
-help1:
-exec help name=[NAME]
-goto end
-
-end:
-return
-
-+DECK,LOAD.
-*CMZ : 1.68/00 02/03/92 13.55.43 by Fons Rademakers
-*-- Author :
-
-*****************************************************************
-* *
- macro load name=x os=x ftn=x cpu=x dev=x
-* *
-*****************************************************************
-
-mess 'Setting compile flags and loading sequences....'
-
-if [name] = apollo goto apollo
-if [os] = unix goto unix
-if [os] = vm goto vm
-if [os] = newlib goto newlib
-if [os] = vms goto vms
- goto error
-
-apollo:
- sel . apollo abbrev double qxno_sc bsd
-
- set [ftn]/*.ftn -f
- set kuip.lib -l
-
- if [dev] <> x goto devapo
- if [cpu] <> m68k goto a88k
- set 'ftn $compfile -b $compfile.bin -zero -save -indexl -frnd _
- -cpu 3000' -c
- goto endif
- a88k:
- set 'ftn $compfile -b $compfile.bin -zero -save -indexl -natural _
- -cpu at' -c
- goto endif
- devapo:
- if [cpu] <> m68k goto deva88k
- set 'ftn $compfile -b $compfile.bin -zero -save -indexl -pic -frnd _
- -cpu 3000 -dba' -c
- goto endif
- deva88k:
- set 'ftn $compfile -b $compfile.bin -zero -save -indexl -natural _
- -cpu at -dba' -c
- goto endif
-
-unix:
- set [ftn]/*.f -f
- set c -lan
- set [ftn]/*.c -f
- set ftn -lan
- set kuip.a -l
-
- if [name] = sgi goto sgi
- if [name] = hpux goto hpux
- if [name] = sun goto sun
- if [name] = decs goto decs
- if [name] = ibmrt goto ibmrt
- if [name] = aix370 goto aix370
- if [name] = cray goto cray
- goto error
-
- sgi:
- sel . [name] [os] abbrev double bslash csetjmp qx_sc bsd
- OPTF = -static -O -nocpp
- goto endif1
-
- hpux:
- sel . [name] [os] abbrev double csetjmp qx_sc sys5
- OPTF = -K +ppu -O
- goto endif1
-
- sun:
- sel . [name] [os] abbrev double bslash csetjmp qx_sc bsd
- OPTF = -O
- goto endif1
-
- decs:
- sel . [name] [os] abbrev double bslash csetjmp qx_sc sys5
- OPTF = -static -G 3 -O
- goto endif1
-
- ibmrt:
- sel . [name] [os] abbrev double bslash csetjmp qx_sc sys5
- set 'xlf -qextname -qrndsngl -qcharlen=32767 -O -c $compfile' -c
- goto endif
-
- aix370:
- sel . [name] [os] abbrev double qx_sc
- set 'xlf -qextname -qrndsngl -qcharlen=32767 -O -c $compfile' -c
- goto endif
-
- cray:
- sel . [name] abbrev qxcapt
- set 'cft77 -ed -o off -b $compfile.o $compfile' -c
- goto endif
-
- endif1:
- if [dev] <> x goto devset
- set 'f77 @[OPTF] -c $compfile' -c
- set c -lan
- set 'cc @[OPTC] -c $compfile' -c
- set ftn -lan
- goto endif
- devset:
- * default is debug
- goto endif
-
-vm:
- sel . [name] ibmall abbrev double
-
- set kuip.fortran.[ftn] -f
- set kuip.txtlib.a -l
- set 'vfort $compfile "(" noprint charlen "("15500")"' -c
- goto endif
-
-newlib:
- sel . [name] ibmmvs ibmall abbrev double
-
- mess '*** set compiler directive correctly ***'
- goto error
-* set kuip.fortran.[ftn] -f
-* set kuip.txtlib.a -l
-* set 'vfort $compfile "(" noprint charlen "("15500")"' -c
-* goto endif
-
-vms:
- sel . [name] abbrev double
-
- set '[.'//[ftn]//']kuip.for' -f
- set kuip.olb -l
- if [dev] <> x goto devvms
- set '$ for/obj=$compfile.obj $compfile' -c
- goto endif
- devvms:
- * default is debug
- goto endif
-
-endif:
-
-seq . /kucdes
-
-goto end
-
-error:
-mess *** Error in load: name = [name], os = [os] ***
-
-end:
-mess 'Setting compile flags and loading sequences....done'
-
-return
-
-+DECK,KUIPC.
-*CMZ : 1.68/00 02/03/92 13.55.43 by Fons Rademakers
-*-- Author :
-
-*****************************************************************
-* *
- macro kuipc name=x os=x vers=x dev=x
-* *
-*****************************************************************
-
-mess 'Compiling kuipc....'
-
-sel kuipcpat
-
-if [name] = apollo goto apollo
-if [os] = unix goto unix
-if [os] = vm goto vm
-if [os] = newlib goto newlib
-if [os] = vms goto vms
- goto error
-
-apollo:
- set kuipc.ftn -f
- cfor /kuipc
- if [dev] <> x goto devapo
- shell bind -sparse_vm -b kuipc kuipc.bin _
- /cern/[vers]/lib/libpacklib.a _
- /cern/[vers]/lib/libkernlib.a
- goto end
- devapo:
- shell bind -sparse_vm -b kuipc kuipc.bin _
- kuip.lib $HOME/kern/kernlib.lib
- goto end
-
-unix:
- set kuipc.f -f
- cfor /kuipc
- if [dev] <> x goto devunix
- shell f77 -o kuipc kuipc.o _
- /cern/[vers]/lib/libpacklib.a _
- /cern/[vers]/lib/libkernlib.a
- goto end
- devunix:
- shell f77 -o kuipc kuipc.o _
- kuip.a $HOME/kern/kernlib.a
- goto end
-
-vm:
- set kuipc.fortran.a -f
- cfor /kuipc
- * cannot bind from CMZ
- goto end
-
-newlib:
- mess '*** set directives for kuipc correctly ***'
-* set kuipc.fortran.a -f
-* cfor /kuipc
- goto error
-
-vms:
- set kuipc.for -f
- cfor /kuipc
- if [dev] <> x goto devvms
- shell link/exe=kuipc kuipc.obj, _
- 'cern:['//[vers]//'.lib]packlib/lib,kernlib/lib'
- goto end
- devvms:
- shell link/debug/exe=kuipc kuipc.obj,kuip.olb, _
- 'cern:['//[vers]//'.lib]kernlib/lib
- goto end
-
-error:
-mess *** Error in load: name = [name], os = [os] ***
-
-end:
-mess 'Compiling kuipc....done'
-
-return
-
-+PATCH,*KUIP
-+DECK,BLANKDEK.
-*CMZ : 2.04/02 23/11/93 11.13.05 by Alfred Nathaniel
-*-- Author :
-+USE,KUCDES,KUIP.
-+USE,KUFLAGS.
-+USE,HKUIP,CKUIP.
-+USE,MKCDES,IF=MOTIF.
-+USE,CMOTIF,IF=MOTIF.
-+USE,XMCLIB,IF=MOTIF.
-+PATCH,*KUESVR.
-+DECK,BLANKDEK.
-*CMZ : 2.02/06 26/05/93 10.55.24 by Alfred Nathaniel
-*-- Author :
-+USE,KUFLAGS.
-+USE,HKUIP.
-+USE,KUESVPAT.
-+USE,KUESVR.
-+PATCH,*KXTERM.
-+DECK,BLANKDEK.
-*CMZ : 2.04/02 23/11/93 15.06.11 by Alfred Nathaniel
-*-- Author :
-+USE,KUFLAGS.
-+USE,HKUIP.
-+USE,MKCDES.
-+USE,KXCDES.
-+USE,KXTERMPAT.
-+USE,KXTERM.
-+USE,P=CKUIP,D=KKERN.
-+USE,P=CMOTIF,D=VMSQIO,IF=VMS.
-+USE,P=XMCLIB,D=KUXXT.
-+PATCH,*KUIPC
-+DECK,BLANKDEK.
-*CMZ : 2.00/00 03/12/92 15.47.32 by Alfred Nathaniel
-*-- Author :
-+USE,KUIPCPAT.
-+USE,KUIPC.
-+USE,HKUIP.
-+USE,P=CKUIP,D=KKERN.
-+USE,KUFLAGS
-
-+PATCH, KUFLAGS.
-+DECK,BLANKDEK.
-*CMZ : 2.03/13 14/09/93 13.15.13 by Alfred Nathaniel
-*-- Author :
-+USE, IBMVM, IF=IBM. temporary for backwards compatibility
-+USE, APOLLO, IF=APOF77, APOFTN.
-+USE, AIX370, IF=IBMAIX.
-+USE, IBMAIX, IF=AIX370.
-+USE, MSDOS, IF=WINNT.
-+USE, ALPHAOSF,IF=QMVAOS.
-+USE, UNIX, IF=ALLIANT,ALPHAOSF,AMIGAUX,APOLLO ,CDCUX ,CONVEX ,DECS.
-+USE, UNIX, IF=GOULD ,HPUX ,IBMAIX ,IBMRT ,IBMUX ,IPSC ,LINUX.
-+USE, UNIX, IF=MACAUX ,MACMPW ,MIPS ,MSDOS ,NECSX ,NEXT.
-+USE, UNIX, IF=SGI ,SUN ,UNISYS ,VAXULX.
-+USE, ALPHAVMS,IF=QMALPH.
-+USE, ALPHA, IF=ALPHAVMS, ALPHAOSF.
-+USE, VAX, IF=VAXVMS.
-+USE, VMS, IF=ALPHAVMS, VAXVMS.
-+USE, IBMMVS, IF=NEWLIB.
-+USE, IBMALL, IF=IBMVM, IBMMVS.
-+USE, DOUBLE, IF=IBMALL, VMS.
-+USE, DOUBLE, IF=UNIX, IF=-SINGLE.
-+USE, BSLASH, IF=ALPHA, APOF77, DECS, IBMRT, LINUX, MSDOS, SGI, SUN.
-
-+PATCH,KUCDES
-+DECK,KUCDES.
-*CMZ : 2.05/02 27/04/94 12.04.46 by Alfred Nathaniel
-*-- Author :
-+KEEP,KCMCMD.
- PARAMETER (MAXCMD = 512)
-
-+KEEP,KCGEN
- COMMON /PAWC/ NWPAW,IXPAWC,IHBOOK,IXHIGZ,IXKUIP,IFENCE(5),
- + LMAIN(1), WS(9989)
- DIMENSION IQ(2),Q(2),LQ(8000)
- EQUIVALENCE (LQ(1),LMAIN(1))
- EQUIVALENCE (IQ(1),LQ(9))
- EQUIVALENCE ( Q(1),LQ(9))
-
- COMMON /KCLINK/
- + LTOP,LVEC,LCMD,LACT,LMAC,LLIST,LSDUM1,
- + LCEL,LNAME,LPAR,LPARV,LTRAV,LVECN,LCELGF,
- + LROOT,LTOPW1,LTOPW2,LMACN,LCLIST,LLAST
-
-+KEEP,KCGEN1
- PARAMETER (MAXLEV=10)
-
- COMMON /KCBANC/ WDNAM(MAXLEV),INPMOD,CPRMPT,CHGLOS,CDFFIL,EDITOR,
- + SHELL,TRAPRO,CHMULT,CHMULM,CHMEXE,
- + MACBAK,MACEXT,BSLASH
- +
- CHARACTER*64 CPRMPT,EDITOR,TRAPRO,SHELL
- CHARACTER*32 WDNAM,CHGLOS
- CHARACTER*16 CDFFIL
- CHARACTER*8 INPMOD,MACBAK
- CHARACTER*7 MACEXT
- CHARACTER*1 BSLASH
- CHARACTER*80 CHMULM
- CHARACTER*(MAXCMD) CHMULT,CHMEXE
-
- COMMON /KCLAST/ CELLST,PNALST,PATLST(MAXLEV)
- CHARACTER*32 CELLST
- CHARACTER*40 PNALST
- CHARACTER*32 PATLST
-
- COMMON /KCUTIL/ NCMD,IWD,LUNFIL,LPRMPT,TIMING,TRACE,CALMOD,
- + NVADD,IREPET,IREFAC,IBRAK,TIMALL,LENTER,UNIQUE,
- + LENMUL,MULTFL,HISTOK,NOHIST,LENMUM,FILCAS,MEXEFL
- LOGICAL TIMING,TRACE,TIMALL,UNIQUE,MULTFL,HISTOK,NOHIST,FILCAS,
- + MEXEFL
- INTEGER CALMOD
-
- COMMON /KCHELP/ HELPAT,UHPATH
- CHARACTER*80 HELPAT
- CHARACTER*32 UHPATH
-
-+KEEP,KCGEN2
- PARAMETER (MAXLVA=16)
- COMMON /KCVADD/
- + LVADDR(MAXLVA)
-
- COMMON /KCFORM/ IOCEL,IONAME,IOPAR,IOPARV,IOVEC,IOVECN
-
- COMMON /KCSPR/ SPRMPT
- CHARACTER*64 SPRMPT
-
- COMMON /KCAPPL/ APPLIC,APEXIT
- CHARACTER*64 APPLIC
- CHARACTER*32 APEXIT
-
- COMMON /KCAPPM/ APPMAC,APPMEX
- CHARACTER*64 APPMAC
- CHARACTER*32 APPMEX
-
- COMMON /KCROOT/ CHROOT
- CHARACTER*64 CHROOT
-
- COMMON /KCUSER/ LAPPLI,LUNAPP
-
- COMMON /KCEXEL/ EXELIN
- CHARACTER*(MAXCMD) EXELIN
-
- COMMON /KCEXIT/ IEXADD,IUSADD,NEXADD,IUTADD,IQUADD,IBRADD
- + ,LICALL,LICAL2,LICAL3
- LOGICAL LICALL,LICAL2,LICAL3
-
-+KEEP,KCMAC
- COMMON /KCMAC/ MACTAB,NSTLEV,QUITFL,WAITFL,WAITFF,DEBTAB,SKIPFL,
- + HEADFL,IONERF,NOEXEC
- LOGICAL MACTAB,QUITFL,WAITFL,WAITFF,DEBTAB,SKIPFL,HEADFL,NOEXEC
-
- PARAMETER (MAXLIN=500)
- COMMON /KCMACC/ MACBUF(MAXLIN)
- CHARACTER*80 MACBUF
-
- PARAMETER (MAXMAC=100,MAXLAB=100,LENSYM=48)
- COMMON /KCMEC/ NUMMAC,NUMLAB,IIIMAC
- COMMON /KCMECI/ LABADD(MAXLAB),MACUND(MAXMAC),LABADM(MAXLAB)
-CCCM COMMON /KCMECC/ MACNAM(MAXMAC),LABNAM(MAXLAB),MACPAT,AUTOEX
- COMMON /KCMECC/ MACNAM(MAXMAC),LABNAM(MAXLAB),MACPAT,AUTOEX,MACLIS
- CHARACTER*(LENSYM) MACNAM,LABNAM
-CCCM CHARACTER*80 MACPAT
- CHARACTER*80 MACPAT,MACLIS
- CHARACTER*20 AUTOEX
-
-+KEEP,KCPAR
- PARAMETER (MAXPAR=100)
- COMMON /KCPARI/ PARPTR(4,MAXPAR),GETPAR,ICLENG,ICLIST,
- + IPFLAG(MAXPAR),NONPOL,NOPOS1
- INTEGER PARPTR,GETPAR
-
- COMMON /KCPARS/ GETSPY,SPYFLG,PROFLG,SPYING
- INTEGER GETSPY
- LOGICAL SPYFLG,PROFLG,SPYING
-
- COMMON /KCDEFL/ DEFLAG
- LOGICAL DEFLAG
-
- COMMON /KCPART/ TOTPAR
- INTEGER TOTPAR
-
- COMMON /KCPARC/ PARLST,CLIST,NOALIN,COMAND,CHLAST,NONPOS
- CHARACTER*80 CLIST,COMAND
- CHARACTER*(MAXCMD) NONPOS
- CHARACTER*(MAXCMD) PARLST,NOALIN,CHLAST
-+KEEP,KCQUES
- COMMON /QUEST/ IQUEST(100)
-
-+KEEP,KCSIGM
- COMMON /KCSIGM/ ISIADD,NVSIGM
-
- COMMON /SIKUIP/ CHSIGM
- CHARACTER*80 CHSIGM
-
-+KEEP,KCUNIT
-CCCM COMMON /KCUNIT/ ILUIN,ILUOUT,LUOUT,LUNLOG,LUNHIS,LUACT,LUNMAN
- COMMON /KCUNIT/ ILUIN,ILUOUT,LUOUT,LUNLOG,LUNHIS,LUACT,LUNMAN,
- + LUNML
- COMMON /KCLUI/ LUIBAS,LUIFIL,LUIVR,LUIVW,
- + LUIHIS,LUIAPP,LUIHIW,LUIMAN
-
-+KEEP,KCVECT
- COMMON /KCVECT/ NUMVEC,TOTPAV,GETPAV,TVECFL
- INTEGER TOTPAV,GETPAV
- LOGICAL TVECFL
-
-+KEEP,KCWORK
- COMMON /KCWORK/ VECTOR(100)
-
-+KEEP,KCESVR.
-*-- when changing MAXSVR ajust also the size in /CKUIP/KUGSVR
- PARAMETER (MAXSVR =20)
- INTEGER NSVFIL, NSVCUR, IESADD
- LOGICAL SERVER
- COMMON /KCESVR/ NSVFIL, NSVCUR, IESADD, SERVER
-
- CHARACTER*32 EDTFIL(MAXSVR)
- CHARACTER*32 EDTCMD(MAXSVR)
- COMMON /KCEFIL/ EDTFIL, EDTCMD
-
-+PATCH,PAMEND.
-*
diff --git a/src/car/paw.car b/src/car/paw.car
deleted file mode 100644
index 679ce08..0000000
--- a/src/car/paw.car
+++ /dev/null
@@ -1,3349 +0,0 @@
-+TITLE.
-PAW 2.07/18 20/11/95 11.15.38 PROGRAM LIBRARY PAW = Q121
-+PATCH,$VERSION.
-+DECK,V2_07.
-*CMZ : 20/11/95 15.38.13 by O.Couet
-*-- Author : O.Couet 05/05/95
-*
-* 20/11/95 15.37.36 by O.Couet
-*
-*::> VERSION 2.07/18 20/11/95 11.15.38
-*
-* Bug fixed in PAWDEC: the QP routines was called.
-*
-*::> VERSION 2.07/17 17/11/95 16.02.17
-*
-* Mods in PAFUNC. The old QP is not used at all in FUN1, FUN2 and FUN/PLOT.
-* COMIS is used instead. The HELP of FUN1 and FUN2 has been improved.
-*
-* 16/11/95 14.02.46 by O.Couet
-* TCPIAF: mods for WINSOCK on Windows
-*
-* 10/11/95 17.29.56 by O.Couet
-* Mods in the calls to hplfr3, taking care into account the fact that
-* it now compute the log.
-*
-* 02/11/95 16.07.04 by O.Couet
-* If /cern/pro/bin/pawsys.kumac doesn't exist, the macro defined in the
-* environment variable called PAWSYS is executed.
-*
-*::> VERSION 2.07/16 01/11/95 13.10.37
-*
-* Used the option 'Z' for HPLAER in PAGHPL
-*
-* 31/10/95 11.36.06 by O.Couet
-* With the help of the new HPLOT routine HPLQSE, the '?' in now not
-* mandatory in $GRAFINFO.
-*
-* 30/10/95 11.28.57 by O.Couet
-* Update in the help of CONTOUR
-*
-*::> VERSION 2.07/15 27/10/95 11.51.12
-*
-* New system function $OPTION.
-*
-* 25/10/95 10.17.25 by O.Couet
-* Double quotes are changed in single quotes in the CDF.
-*
-* 17/10/95 18.33.54 by O.Couet
-* New command ELLIPSE
-*
-*::> VERSION 2.07/14 16/10/95 15.43.12
-*
-* FLAG TKTCL added in PAWINT1, PAWINT2 and 0PAMAIN.
-*
-* 16/10/95 14.05.41 by O.Couet
-* New MASK menu
-*
-* 11/10/95 11.44.15 by O.Couet
-* Improve the HELP of CONTOUR
-*
-* 02/10/95 18.41.26 by O.Couet
-* The default value for UWFUNC in all the Ntuple commands is '1.'
-*
-* 25/09/95 17.30.14
-* In HMERGE, FILECASE KEEP was not taken into account.
-* Implies mods in MERGIN.
-*
-* 20/09/95 16.49.08
-* A call to kualfa was missing in paobs.
-*
-*::> VERSION 2.07/13 19/09/95 09.38.54
-*
-* Fix in PAWSEL (division by 0) wbr at axher1.desy.de (Walter Brueckner)
-*
-*::> VERSION 2.07/12 14/09/95 14.19.45
-*
-* Mods in PIAFRONT
-*
-* 13/09/95 16.37.34
-* HRDIR is now callable from COMIS.
-*
-*::> VERSION 2.07/11 13/09/95 15.40.45
-*
-* PAPLOT is now called with CHCASE='HIST' in PANTUP.
-*
-* 01/09/95 13.40.27
-* The OVERFLOW was not correct in $HINFO.
-*
-* 24/08/95 13.43.43
-* New version of PIAFDEC
-*
-* 23/08/95 18.27.31
-* Mods in bugrep. PAWSUPPORT is added
-*
-*::> VERSION 2.07/10 23/08/95 09.44.41
-*
-* Bug fixed in HGETID: repeating H/PL -1 produced an error.
-*
-* 23/08/95 09.16.55
-* Help of META and WORKSTATION improved.
-*
-* 22/08/95 17.47.01
-* New piafdec
-*
-* 18/08/95 15.44.00
-* In $LOCAL and LOCAL "panic" is changed into "local_panic".
-*
-*::> VERSION 2.07/09 18/08/95 15.18.36
-*
-* New command OP/FUN.
-*
-* 17/08/95 15.04.52
-* Bug fixed in pawsel. It is now possible to do:
-* nt/plot 30.x nt.f(1,2,3,4,5,6,7,8,9,10)
-*
-* 16/08/95 16.33.55
-* Long deck names like FPGETOPTD are now reduced.
-*
-*::> VERSION 2.07/08 16/08/95 16.13.00
-*
-* Bug fixed in PAFTH and PAFITV: these routine required the Motif
-* library even in pawX11.
-*
-* 15/08/95 17.25.11
-* Bug fixed in HVTOB: 20(4:18,0.:0.5) was not working on the y-axis
-*
-* 15/08/95 12.01.56
-* Timo mods in PIAFRONT and TCPIAF.
-*
-*::> VERSION 2.07/07 11/08/95 12.14.57
-*
-* Bug fixed in PAFITH the varibale VERRORNAM was used instead of
-* VERRORNUM.
-*
-* 11/08/95 11.48.52
-* P(1) is initialized to 0. in PAWCS to avoid warnings with purify.
-*
-* Correction in PANDRA so that call to PPROJN has correct number of
-* arguments.
-*
-*::> VERSION 2.07/06 14/07/95 14.22.36
-*
-* Small mod in parlineform to change a #include to a +SEQ.
-*
-* Timo mods for PIAF.
-*
-* 05/07/95 09.08.40
-* in pafitv LODRAW was set to 0 instead of .FALSE.
-*
-* 03/07/95 17.58.46
-* PAUTIT has now one parameter.
-*
-* 03/07/95 16.00.20
-* The routine getatt in now in the PAW patch.
-*
-*::> VERSION 2.07/05 29/06/95 15.28.26
-*
-* in pafith LODRAW was set to 0 instead of .FALSE.
-*
-* 28/06/95 14.46.58
-* Fixes in Fit panel. Bug in the allocation of space for parameters.
-* (Yana Gaponenko).
-*
-*::> VERSION 2.07/04 28/06/95 10.37.34
-*
-* New routine PAHPR which allows to print histograms with ranges.
-* It is called in PAHIO and PAPLOT.
-*
-* 26/06/95 13.47.47
-* Mod in PASCAN: In case of vectors, the first entry is scanned
-* only once.
-*
-*::> VERSION 2.07/03 22/06/95 10.14.42
-*
-* The Fit panel is re-activated (*PAW).
-*
-* 21/06/95 16.04.48
-* Mods in Fit panel for VMS version (Yana Gaponenko).
-*
-* 20/06/95 14.37.18
-* FPHSETRNG was wrong (Yana Gaponenko).
-*
-*::> VERSION 2.07/02 16/06/95 10.51.13
-*
-* about.c is now dummy
-*
-* 14/06/95 11.23.05
-* MULTINET_SHUTDOWN added in 0PAMAINM
-*
-* 07/06/95 10.30.34
-* Improvements in the HELPs of ZONE, SWN, SVP and SELNT.
-*
-* 06/06/95 15.32.11
-* SELF DEV in palogo
-*
-* 01/06/95 17.36.08
-* New options in $HINFO:
-* $HINFO(id,'1DHISTO') ... 1 if ID is a 1D histogram or 0 otherwise
-* $HINFO(id,'2DHISTO') ... 1 if ID is a 2D histogram or 0 otherwise
-* $HINFO(id,'TABLE') ..... 1 if ID is a table or 0 otherwise
-* $HINFO(id,'PROFILE') ... 1 if ID is a profile histogram or 0 otherwise
-* $HINFO(id,'NTUPLE') .... 1 if ID is a Ntuple or 0 otherwise
-* $HINFO(id,'LOG') ....... 1 if ID has LOG Y scale or 0 otherwise
-*
-* 30/05/95 09.40.26
-* Complete the HELP of the command TIC.
-*
-* 29/05/95 13.23.45
-* in $PCHTAG CHBIG has now 512 characters (maximu size on AIX).
-* (problem found by Michael Dahlinger).
-*
-* 19/05/95 11.34.54
-* New version of the KEY command
-*
-* Fix in PCINFO: local functions are no longer sent to PIAF
-* for processing when the user uses FUN/FUN1 commands ....
-*
-* 17/05/95 08.58.57
-* Fix in bugrep: "automatically" was spelled "automaticaly"
-*
-* 11/05/95 11.59.10
-* Bug fixed in HGETID. ICRANG was always set to 1 even in case
-* of invalid range.
-*
-*::> VERSION 2.07/01 10/05/95 10.36.03
-*
-* It is now possible to copy histograms with ranges. This implies
-* mod in HGETID, HGETIR (use a new routine HVTOB). The command
-* H/COPY use the NEW routine HCOPYR of HBOOK.
-*
-* 08/05/95 14.37.16
-* Protection added in PAFITH agains: h/fit 100.sliy.1 g
-*
-* 05/05/95 16.27.32
-* EXTERNAL flaged with FPANELS in PAFITH and PAFITV
-*
-*::> VERSION 2.07/00 05/05/95 15.22.00
-*
-* MAXFCU=2000. Protection in pproj0,pprojn,pascan
-*
-* 04/05/95 18.08.37
-* FPANELS flag in utils
-*
-* 04/05/95 16.00.57
-* Fitting panels temporarly disabled.
-*
-* 04/05/95 10.25.12
-* New option in PASPI2 to draw the spider plots as segments.
-*
-* 02/05/95 10.19.42
-* Mods in PASCAN and PASPI2 to allows to animate the spider plots.
-*
-* 28/04/95 12.18.17
-* New MATCH parameter in the command NT/READ.
-*
-* 28/04/95 12.17.14
-* The last line of the table was not print in PASCAN when only one
-* event was scan.
-*
-* 28/04/95 09.06.30
-* Changes in PASPI2. The formats F12.2 have been replaced by E12.4. The
-* problem appears on VMS.
-*
-* 26/04/95 17.31.48
-* String was initialized with '' in PAFITH and PAFITV which is invalid
-* on VMS.
-*
-* 26/04/95 17.07.56
-* The common KCGUID is now suppressed (old kuip common). It is replaced
-* by PCHTAG which is smaller and more widely used (gain of space).
-*
-* 26/04/95 10.53.22
-* Bug fixed in PASCAN and PASCA1: even with the ouput redirected on
-* a file, some lines were output on the screen in NT/SCAN.
-*
-* 25/04/95 16.17.38
-* HELP of H/PLOT, H/ERR and AERR changed according to the new
-* behaviour of option "1" in HPLAER.
-*
-* 24/04/95 16.10.45
-* New version of the fitting panel (Gregory Kozlovsky).
-*
-* 24/04/95 16.10.32
-* New paw.com (VAX)
-*
-* 21/04/95 11.55.49
-* Bug fixed in PAVECT. in V/PLOT X%Y, IGRAPH was not called with
-* option 'Z'.
-*
-* 18/04/95 16.31.52
-* The slide package is now obsolete (move into SLIDE_OBS). In *PAW
-* the SLIDE flag is not selected.
-*
-* 18/04/95 12.10.26
-* New version of the fitting panel (Gregory Kozlovsky).
-*
-* 13/04/95 11.29.00
-* Mod in PCHROP: RZOPEN is call with option C (for UNIX machines) like
-* in PAWROP.
-*
-* 12/04/95 17.41.30
-* New version of ATITLE using the new HPLOT routine HPLLGD.
-*
-* 11/04/95 13.53.29
-* HBUG an IGERR are now disable for VAX. These routines are already
-* defined in HBOOK and HIGZ. Having these routines double defined,
-* causes problems to create sharable images on VAX/VMS.
-*
-* 11/04/95 13.45.53
-* New patch MANPAGES
-*
-* 11/04/95 10.53.58
-* Mods in PAWFCA and PCINFO. The CUTOL to convert COMIS file names
-* to lowercase is now commented because COMIS takes care of the case
-* conversion set by the FILECASE command.
-*
-* 07/04/95 17.42.07
-* Dummy entry MULTINET_SHUTDOWN added in 0pamain.
-*
-* 07/04/95 16.47.13
-* Option "overlay" added in the pull down menu of 1d histos (Paw++)
-*
-+DECK,V2_06.
-*CMZ : 2.06/20 03/03/95 18.36.01 by O.Couet
-*-- Author : O.Couet 09/11/94
-*
-*::> VERSION 2.06/20 03/03/95 18.36.01
-*
-* Mod in the CDF. The xample given in the NT/DUPLICATE command are now
-* correct. The "include ?" facility is exaplin in the command UWFUNC.
-*
-*::> VERSION 2.06/19 01/03/95 18.29.58
-*
-* New command VERSION, bugfix and extension of BUGREPORT.
-*
-*::> VERSION 2.06/18 01/03/95 14.04.16
-*
-* Bug fixed in PAQCUT. It now check if the cut exist.
-*
-* 01/03/95 11.21.53
-* Bug fixed in HGETID. The mod made in 2.06/14 was incorrect. The
-* seach of free histo ID was wrong. This bug has been shown in stacked
-* lego plots.
-*
-* 28/02/95 13.34.23
-* The old option E in the call to FZENDO in PAZFZ has been removed.
-*
-* 28/02/95 13.33.43
-* FZENDI and FZENDO are now called with option X in PAWFOP.
-*
-*::> VERSION 2.06/17 27/02/95 10.01.40
-*
-* HPLONT and IGONT removed from PAWCS
-*
-* 23/02/95 11.00.49
-* HFITHN added in PAWCS
-*
-*::> VERSION 2.06/16 22/02/95 16.01.29
-*
-* Bug fixed (F.Rademakers) in PFINDF1: The EQUIVALENCE was not
-* correctly manged in the UWFUNC generated functions.
-*
-*::> VERSION 2.06/15 20/02/95 14.36.12
-*
-* 20/02/95 13.53.35
-* #define __TIME_T 1
-* added in tcpiaf
-*
-* 20/02/95 13.35.49
-* Flag QCDEC added in tcpiaf.
-*
-*::> VERSION 2.06/14 14/02/95 15.09.35
-*
-* Mods in HGETID: If a histogram didn't exist in the current dir, then
-* the histogram with the same id in the PAWC directory gets erased.
-*
-* 13/02/95 09.47.48
-* #define stat_2 stat added in TCPIAF
-*
-*::> VERSION 2.06/13 06/02/95 11.05.44
-*
-* Bug fixing in the staging part of PIAF (Timo Hakulinen):
-*
-* Patch CPAW: TCPIAF. File name normalisation for files to be staged.
-* Patch PIAFS: PIAFC PSEXEC PSTAGE: Routine to call special utility
-* for spreaded files (ls, cp etc ..)
-* Patch STAGERD (All the decks are modified): Cosmetics changes
-*
-* 01/02/95 09.39.55
-* The control on expiration is removed (VERTIM routine).
-*
-*::> VERSION 2.06/12 31/01/95 14.06.33
-*
-* PNUTIL has been modified to improve the infos given by the command
-* NT/READ (error messages, number of events read etc ...)
-*
-*::> VERSION 2.06/11 31/01/95 09.47.34
-*
-* New HELP for the command in the menu /GRAPHICS/PRIMITIVES: each
-* command has now an example.
-*
-* The commands SMK, SMPCI etc ... are now obsolete.
-*
-* Mod in PBHIST to take care of the new histogram title format.
-*
-*::> VERSION 2.06/10 19/01/95 10.39.30
-*
-* Bug fixed in pawsel: the arrays of characters were not managed
-* correctly in the command NT/PLOT.
-*
-* The help(s) of PROX, PROY, BANX etc ... has been completed.
-*
-*::> VERSION 2.06/09 16/01/95 14.58.16
-*
-* Bug fixed in file.c. The character array lun was dimensionned to 5.
-* But it may have up to 6 characters: LUN20\0 . Now the dimension is 6.
-*
-* Protections added in PAFEYN (commands ARCHELIX and HELIX).
-*
-* Version Number changed in PALOGS
-*
-* HFPANEL and FITPCDES are now selected in *PAW.
-*
-*::> VERSION 2.06/08 12/01/95 15.56.51
-*
-* New PATCH: SCRIPTS. It contains 3 decks (IBM, UNIX and VAX). Each
-* deck is the script file used to start paw on IBM/VM, UNIX and VAXes
-* machines.
-*
-*::> VERSION 2.06/07 09/01/95 18.25.49
-*
-* Bug fixed ine PACUTS in order to be able to read one single
-* cut into a cut file.
-*
-*::> VERSION 2.06/06 16/12/94 16.23.11
-*
-* Mods in CMOTIF (cuts file init style) to support ~/filename
-*
-*::> VERSION 2.06/05 16/12/94 10.13.51
-*
-* Improvments in the help of SWN and SVP.
-*
-* The fix in $matrix (VERSION 2.06/02) has been removed by the XBAE
-* changes in 2.06/04. It is now fixed again.
-*
-*::> VERSION 2.06/04 08/12/94 11.44.12
-*
-* Reverts to the previous version of the XBAE widgets for VMS. Maybe one
-* day they will work on VMS too.
-*
-*::> VERSION 2.06/03 24/11/94 17.11.57
-*
-* Mods in histo for the Scale widget.
-*
-* Development version of PIAF for VMS.
-*
-*::> VERSION 2.06/02 21/11/94 15.23.54
-*
-* Mods in matrix (XBAE). An input parameter "offset" has been renamed
-* because of a clash with a #define (the problem appears only on
-* VAX/VMS)
-*
-* Modif in $MATRIX: there was an extra "," in an enum statement. This
-* produced an compilation error on Ultrix.
-*
-*::> VERSION 2.06/01 21/11/94 10.30.25
-*
-* The menu OBSOLETE in now removed. (command GAUSS EXP etc ..)
-*
-*::> VERSION 2.06/00 09/11/94 17.10.20
-*
-* Bug fixed in PPROJ0 and PPROJN: In expression like:
-* NT/PLOT 10.func.f 2
-* the weight was not correct.
-*
-+DECK,V2_05.
-*CMZ : 2.05/24 08/11/94 18.14.44 by O.Couet
-*-- Author : Rene Brun 23/03/94
-*
-*::> VERSION 2.05/24 08/11/94 18.14.44
-*
-* New version of XBAE patch.
-*
-* PAWFCA and PCINFO are now compatible in the .sl management.
-*
-* PSEXEC useless code removed.
-*
-*::> VERSION 2.05/23 24/10/94 11.47.50
-*
-* Fix in PAVECT to support LOG scales in V/PLOT X%Y
-*
-* Bug fixed in handling in CWN array subranges (analyse).
-*
-*::> VERSION 2.05/22 21/10/94 09.37.07
-*
-* Fix in the Paw++ cut editor when inverting (.NOT.) a bracketed expression.
-*
-*::> VERSION 2.05/21 18/10/94 12.15.31
-*
-* Fix in case column-wise ntuple arrays do not fit in the cache
-*
-* Can now again remove //lun's from chain definitions
-*
-*::> VERSION 2.05/20 14/10/94 11.29.09
-*
-* Protection in PBHIST for HIGZ classes.
-*
-* Routine PAWFCA and PCINFO: also analyse pre-compiled Comis routines for
-* Ntuple columns.
-*
-* Routine PFINDF and PFINDF1: PFINDF recursively analyses the routines in the
-* calling tree to find all used Ntuple columns. Before only the top-level
-* routine was analyzed.
-*
-* Routine PCPVAR: restore correctly character array columns from column cache.
-*
-*::> VERSION 2.05/19 28/09/94 08.45.00
-*
-* New version of STAGERD by Timo.
-*
-* Minor changes in PIAFC, PSTAGE and PSEXEC.
-*
-* Routine PAMLOC: print unsigned int only in HEX format when sign bit is set.
-*
-*::> VERSION 2.05/18 19/09/94 11.11.18
-*
-* VMS fixes in 0PAMAINM and TCPIAF (by Jamie).
-*
-* Bug fix in bugrep for VMS : types.h doesn't exist on VMS, and the
-* ARCH_TYPE has been replaced by HW_TYPE.
-*
-* New option A in NT/SCAN to draw the average spider plot.
-*
-*::> VERSION 2.05/17 05/09/94 13.38.47
-*
-* Add Bessel functions BESJ0,BESJ1,BESY0,BESY1,BESI0,BESI1,BESK0,BESK1
-* EBESI0,EBESI1,EBESK0,EBESK1 in PAWCS
-*
-* Change PAW prompt style in PAWPP.
-*
-* Implement MOTIF interface to BUGREPORT
-* New routine MAILDIALOG added in UIMX. Deck ABOUTDIALOG deleted.
-* New deck MAIL in CMOTIF. Changes in INIT.
-*
-* Bug fix in PAWJOJ (called by command LINTRA) when the number of
-* variables was greater than 16(reported by F.Lamarche).
-*
-* Bug fix in PANTUP with option=s if ID=1000000
-*
-* New routine PAVERS with sequence VIDQQ.
-* PAVERS is called by the new routine BUGREPORT (CPAW).
-*
-* New routine BUGREPORT and corresponding command BUGREPORT in /KUIP.
-*
-* HPLFRA in called in PAFITV. Previously a temporary histo 12345
-* was created.
-*
-* Solaris port of PIAF.
-*
-* New patch STAGERD contains PIAF stager daemon process. To build
-* piafserv include sequences from patch STAGERD.
-*
-* Problem causing crash on DN10K corrected in PAWCS (G.Folger)
-*
-* Comment changed in PCHROP
-*
-* New version of PIAFC.
-*
-* #if !defined(__convexc__) statements added in PARSE,TABLE,GENERATI
-* (report by V.Balashov)
-*
-* PAFORT: There was a bug that in CALL sub.f('a') the character
-* constant would be converted to uppercase.
-*
-*::> VERSION 2.05/16 04/08/94 15.00.22
-*
-* Introduce protections and cleanup of buffers in case of CRTL/C.
-* Mods in PPROJN,PALLOC and PAWBRK.
-*
-* Fix bug in PALLOC: CDUM declared CHARACTER type.
-*
-* New option parameter CHOPT in command REBIN.
-* In particular, if the option 'N' is given, the result of new bin is
-* the sum of the cumulated bin instead of teh average (default).
-*
-*::> VERSION 2.05/15 28/07/94 12.26.03
-*
-* Changes in PASCAN and PASPI2 to support ranges (see HELP SCAN)
-*
-* Mods in PAFITV to support 2-D vectors.
-*
-* Mods in HGETNT: In case of SCAN, do not read (by default) column 1
-*
-* Mods in HGETN2: call HBNAME with $CLEAR also in case of Nt/loop
-*
-* Invalidate cache when deleting chain in PCHAIN and PCHCLO.
-*
-* Add Remote Procedure call for PIAF in PCHROP.
-*
-* Changed Ntuple column caching algorithm. Columns of chains and
-* RWN's are also cached now. New routine PALLOC allocates space
-* via HBALLOC. Filling of cache is now done in PPROJ0 or PPROJN
-* (which know how to loop over chains). The routine PABFIL is
-* deleted.
-*
-* Introduced spider plots. Use option -S to the SCAN command to get
-* spider plots.
-*
-* Mods in PFCUTS and PFPUSH. Do not check CUT syntax on PIAF (has
-* already been done on the PAW client side).
-*
-* Mods in generati, analyse and pawsel to handle graphical cuts
-* on CWN arrays inside a complex selection mechanism.
-*
-* Mods in PASCAN and PASCA1 to allow chains scanning.
-* (LABEL done on PASCAN).
-*
-*::> VERSION 2.05/14 14/07/94 14.15.12
-*
-* New command Ntuple/Hmerge to merge HBOOK files
-* New routine MERGIN called by command Hmerge.
-*
-* New command Ntuple/Duplicate added. PAWDEF/PAWDEC and PNUTIL modified.
-*
-* Graphical cuts implemented for CWN arrays
-*
-* Add HRENAME and HNTDUP in list of callable routines in PAWCS
-*
-* Protection in PANTUP in case IFIRST> number of events.
-*
-* PIAF ported to SGI
-*
-* Bug fixed in PACUTS. CHCUTY was not initialized in case of graphical
-* cuts on 1D histograms.
-*
-*::> VERSION 2.05/13 05/07/94 18.32.55
-*
-* T=XCC added in PATCH,FITPCDES.
-*
-* Several lines with more than 80 characters in HFPANEL
-*
-* ATITLE has an additional parameter: ZTIT.
-*
-*::> VERSION 2.05/12 30/06/94 13.45.46
-*
-* bug corrected in PAWUWF (inversion OR/AND)
-*
-*::> VERSION 2.05/11 28/06/94 15.24.06
-*
-* bug fixed in TCPIAF (ALPHA/VMS only)
-*
-* Mods in PAWUWF to support the generation of an Include file
-* instead of a Real function.
-*
-* Mods in the CDF to reflect the changes in UWFUNC
-*
-*::> VERSION 2.05/10 28/06/94 08.22.32
-*
-* VMEM changed from 64MB to 54MB in PAWINT3.
-*
-* Delete .f and .sl files in PIAF when sequential mode.
-*
-* Modify PAHOPE to support HRESET for ntuples.
-*
-* The functions $CALL, $ICALL, and $DCALL allow to call REAL, INTEGER, and
-* DOUBLE PRECISION functions, respectively. The function call must be
-* enclosed in quotes, for example:
-* $CALL('fun.f(1.5)')
-*
-* Modify PMNCOMD to support new option 'K' in Histo/Fit
-*
-* Several bugs fixed in patch,HFPANEL when porting to ALPHA/OSF
-*
-* Routine PASCAN modified. If LOUT is not stdout, no prompt generated
-* like in Batch mode.
-*
-*::> VERSION 2.05/09 21/06/94 19.08.00
-*
-* Routine PSEXEC: reset sockets to client/master (after interrupt they
-* could still be set for master/slave communication).
-*
-* Routine PAWROP: always send option -X to piaf to force file opening
-* in exchange mode (solves problem on Alpha/OSF port of piaf).
-*
-* Add new HBOOK routine HBAR2 to PAWCS
-*
-* New options 'FB' and 'BB' in HISTO/PLOT to remove the Front and
-* Back Boxes on surface and lego plots.
-*
-* In HISTO/PLOT the option 'A' (to avoid the axis drawing) works
-* also on 2D histograms representations.
-*
-* Remove PRINT 'A FAIRE' in PASCAN
-*
-* New PATCHES HFPANEL and FITPCDES
-* This introduces the new MINUIT fit panel (invoked with option M)
-* These two new patches require a new version of HBOOK as well.
-*
-* Fix bug in PAWSEL in case of REAL*8
-*
-* Add loadstats for IBMRT/PIAF
-*
-* Fix bug in PASCAN for REAL*8 columns
-*
-* Deck PIAFC: print average load statistics in the PIAF/STATUS command.
-*
-*::> VERSION 2.05/08 10/06/94 17.32.07
-*
-* Decks PIAFS, PIAFC: if file /usr/piaf/etc/nopiaf exists return its
-* contents to the client and close the piaf connection. Using this file
-* it is easy to tell users why they can not use PIAF.
-*
-* Routine RLOGIN: close gracefully after the nopiaf message. Previous
-* versions of PAW will work but give the user the impression that the
-* connection is still open.
-*
-* Routine PSEXEC: forces the master server to pass via PSLVIO to collect
-* statistics in case of an error exit.
-*
-* Routines PFCUTS, PSPAW: fix RPC problem concerning graphical cuts.
-*
-* Routine PCNEXT: fix for memory resident Ntuples.
-*
-* New optional parameter WKID in the commands LOCATE, VLOCATE and
-* CUTS to allows request locator in any window. This implies to add
-* one input parameter in the routine PAWLOC.
-*
-*::> VERSION 2.05/07 08/06/94 11.34.49
-*
-* Change in MHLATTR (call HCDIR instead of HPATH)
-*
-* In HGETID, ICX2 and ICY2 were limited to 99999. Now the initial
-* value is the number of bins in the histo.
-*
-* Routine MHLATTR: uses new routine HNTVDEF to display extended column info.
-*
-* Decks NTUPLE and SCAN: small fixes to handle extended info.
-*
-* Deck PIAFC: protect against unknown remote login name.
-*
-* The vectors adresses in the command GRAPH (PAGPRI) are stored in
-* ZEBRA reference links (LQ(LCDIR-40) and LQ(LCDIR-41)).
-*
-* The default editor for VAX/VMS (PAWPP) is edit/tpu/disp=decw.
-* (suggestion made by Michael Dahlinger)
-*
-* Bug corrected in PAFITV (inversion of NDIM and NVAR)
-* (thanks to Stefan Kluth)
-*
-* Change PAWSYS to PAWSYS1 (VM only) in PAWINT4
-*
-* Protection in PAWSEL (missing test for dividing by 0 in arrays)
-* bug fix in PAWSEL (case Nt/plot 1.v v1.ne.v2)
-*
-* New options added in Profile histograms (see HBOOK/HBPROF routine)
-*
-* Changes in PIAFS from ALPHA/OSF in decks PIAFC, PIAFRONT and PSLVIO
-*
-* Change CDF for commands IDOPT (description of PROE) and SMOOTH
-*
-*::> VERSION 2.05/06 30/05/94 18.50.57
-*
-* Bug fix in PANTUP when option='s' and arrays
-*
-* bug fix in PAWSEL (case Nt/plot 1.v v.ne.0)
-*
-*::> VERSION 2.05/05 30/05/94 14.08.00
-*
-* Routine PBHLUN modified to support RLOGIN files in the browser
-* This also requires new version of HBOOK (routine HLNEXT modified)
-* and a new version of PAWSERV in CSPACK (many new routines)
-*
-* Added new HBOOK routine HRENAME to PAWCS
-*
-*::> VERSION 2.05/04 25/05/94 09.18.19
-*
-* $GRAFINFO('TXFP') corrected for negative values.
-*
-* Allow use of "MACRO/DEFAULT -AutoReverse" without running LAST.KUMAC
-* at startup-time.
-*
-* Fix some memory leaks in parser for selection functions.
-*
-* Protections in PAWROP (for PIAF, options U and N)
-*
-* Minor changes in CMOTIF/CUTS and in PIAFs/PIAFC and PSEXEC
-*
-* Bug fixed in PADVAR. A character string comparison was done with
-* invalid indeces with a ntuple variable equal to ' '.
-*
-*::> VERSION 2.05/03 19/05/94 11.59.49
-*
-* Add protections (iquest(1) in HGETNT and MHLATTR
-*
-* Add GAMMA function to PAWCS
-*
-* Protection in PAPICT
-*
-*::> VERSION 2.05/02 07/04/94 08.53.28
-*
-* Change in PPROJ0 (PIAF slave case)
-*
-* New options in CMOTIF/NTUPLE
-*
-* Bug fixed in CMOTIF/STYLE (Option TIC)
-*
-* Add ISFACI and IGHTOR to PAWCS
-*
-* Change declaration for htons in TCPIAF (problem with UCX version only)
-*
-* Fix in PPROJ0 and PPROJN. In the sequence NT/PLOT 10.x 2
-* the weight '2' was ignored.
-*
-* Fix in analyse (CPAW). In a sequence like
-* NT/PLOT 10.x XXX(1).AND.X>2.AND.X<3 all the selection after
-* 'X>2' were ignored.
-*
-* Fix in PEXMSK. The sequence Nt/plot 10.x was wrong following the
-* creation of a mask with a name XXX
-*
-* mods in CDF/PAMCDF: One can remove PIAF files via the browser
-*
-* Use VERSQQ in ABOUT
-*
-*::> VERSION 2.05/01 28/03/94 08.42.11
-*
-* Temporary fix in PCINFO for filecase of COMIS files
-*
-* Mods in PIAFC for non-HPUX machines
-*
-*::> VERSION 2.05/00 23/03/94 10.58.43
-*
-* Popup dialogs from the Style Panel became unreachable when the style
-* panel was closed before closing the popup dialogs.
-*
-* The columns to be scanned can now be selected via a column selection
-* dialog which will popup when selecting the "Scan..." button in the
-* Ntuple Viewer.
-*
-* Bug corrected in GENERATI: Character TITLE not initialized (VAX/VMS only)
-*
-* Bug corrected in PAMASK (VAX/VMS only). Mask was written even in readonly mode
-*
-* C I/O option disabled on DECS
-*
-* Mods in PAFITV to support 2-D vectors
-*
-+DECK,V2_04.
-*CMZ : 2.04/15 14/03/94 12.47.29 by Rene Brun
-*-- Author : Rene Brun 28/10/93
-*
-*::> VERSION 2.04/15 14/03/94 12.47.29
-*
-* Change $PAWSIZ for VAX to BIG
-*
-* Change format in PASCA1
-*
-* Plot commands typed in kxterm now also cause the histo style panel
-* to be set accordingly. Change in $PCADDR and new $PCHIST. Decks
-* PAHIST, PANTUP, PAWFCI, PAWINT2, PMINIT, HISTO changed, new deck PMHIST.
-*
-* Cut editor now also accepts weights (select 'W' from operator menu).
-* Decks CUTEXPR, CUTS, $CUTEXPR changed.
-*
-* Major re-naming and re-ordering of PATCHES and DECKS. In view of CMZ's
-* new include file generating capabilities. CMDES became HMOTIF. HPAW
-* is now of type XCC (was DATA) and contains now also the $CHAIN sequences.
-* All KEEP names were stripped of their _H (this would generate include
-* files with names like analyse_h.h which is not nice). PILOT patches
-* updated accordingly. Still PATCHY compatible.
-*
-* Fixes in layout of HistoStyle panel.
-*
-* New options in Ntuple viewer (profile, boxes and extended info)
-* and introduction of a column selector for the scan command.
-*
-* Unix systems now use C I/O. Changes in PAWROP and PAZRZ.
-*
-* Changed the names of ANUMCH and ALPHCH to PNUMCH and PLPHCH (names were
-* also used in COMIS).
-*
-* In PANTUP: for 2D plot 'D' option also produces scatter plot.
-*
-* Fix in PPROJ0 in case less events than slaves (PIAF).
-*
-* Bug fixed in HGETN2: for CWN ntuples, NTVARM and TTVARM was
-* reset together MLOWNT and MUPNT. So the colors was not visible
-* in expression like NT/PLOT 10.x%y%z%t.
-*
-* In PANT3D the histogram title is drawn.
-*
-*::> VERSION 2.04/14 03/03/94 15.56.52
-*
-* Modify comment lines in PAWSEL.
-*
-* Delete TYPEDEF statement in TCPIAF for VAX/VMS
-*
-* Additions to PIAF LOG file.
-*
-* ZEBRA routines added to PAWCS.
-* MZSTOR,MZDIV,MZLINK,MZWORK,MZBOOK,MZDROP,MZPUSH
-* MZWIPE,MZGARB,MZFORM,LZFIND,LZFID,DZSHOW,DZVERI
-* HBOOK routine HDIFFB added to PAWCS
-*
-*::> VERSION 2.04/13 28/02/94 18.50.06
-*
-* Changes in CDF to reflect the new options in fitting routines.
-*
-* Changes in RLOGIN and TCPIAF to handle the PIAFRC new behaviour.
-*
-* Mods in PAFITV to introduce new option 'Z' of HFITV
-* New routine PAWFITZ
-*
-* Routine SIGINI from SIGMA renamed to SIGINI1
-* Routine HBINIT from HBOOK renamed to HBINIT1
-*
-* New HBOOK routine HKIND callable from PAWCS
-*
-* Mods in PAWFCA to allow VMS filenames satrting with SYMBOL:FILE
-*
-* Added an extensive logging facility for PIAF. The logging system uses
-* the BSD syslog facilty to spool the log info to a single file in the
-* cluster. The syslogd needs to be configured to relay messages to the
-* logging facilities LOCAL6 (piafserv) and LOCAL7 (piafslave).
-*
-* New deck PIAFL in patch PIAFS with the logging routines.
-* New deck $PIAF contains C include.
-* New deck PNTLOG to collect the single command statistics.
-* Other decks changed: PIAFC, PIAFS, PSEXEC, PSKUIP, PSLOG, PSLOOP,
-* PABFIL, PANTUP, PPROJ0, PPROJN.
-*
-*::> VERSION 2.04/12 17/02/94 16.39.33
-*
-* Dummy routines for TGV (VAX and ALPHA only) in 0PAMAIN/0PAMAINM
-*
-* Mods in PAWCS to call the "HFILL fast replacement" via CSHEXT.
-*
-* The file .piafrc is not created automatically anymore. Changes in
-* TCPIAF and PIAFRONT. Depending on the protocol level flag IPROTO
-* PIAFRONT and PIAFSERV know how to treat the passwd information.
-*
-* Added inactivety timeout of 10 hours in PIAF.
-*
-* Changed name of piaf_*.log files to incorporate the slave sequence number.
-*
-* New option '0' added in commands ERRORS and AERRORS.
-*
-* Changes in $PAWFIL4, PAWINT1 and PAWINT4 for MSDOS, WINNT.
-*
-* The command LOCATE has been modified. One can now invoke a user
-* COMIS routine when in locator mode. When a mouse button is pressed,
-* the user routine is called and the user has access to the current mouse
-* coordinates. See HELP LOCATE.
-*
-* HBUG called with only 2 arguments in PECRIT.
-*
-* Implemented .f77 (using the Fortran compiler) for PIAF.
-* Routines changed: PAWFCA, PCINFO, PFCSEX, PSEXEC, and a few others.
-*
-* Routine PSLAVE sends PID of master server to slaves. Slaves use this
-* PID when loading the .sl (see previous item).
-*
-* When doing NT/LOOP 10 zz.f don't load by default column 1.
-* Routines changed: HGETNT and PANTUP.
-*
-* Routine PSMPUT: increased multicast time out to 60 seconds and don't
-* trigger on slaves that already replied.
-*
-* WINNT flag introduced in pilot patch.
-*
-* Moved the call HBFREE (to free the Ntuple columns from cache) from
-* PACLOS to HREND.
-*
-* Mods in PFINDV and PFINDF for the new COMIS interface (f77) and CSLISTX.
-*
-* Changes in TCPIAF for ALPHA/VMS and TGV version
-*
-* Several changes in PIAFS to support Disk Pool Manager in all the /PIAF
-* commands.
-*
-* SIGINT renamed to SIGINI in PAWINT3 (clash with ISAJET)
-*
-* $GRAFINFO('?TXFP') and '?TXAL' corrected to return value compatible
-* with IGSET.
-*
-* New $GRAFINFO('TXFONT'), TXPREC, TXALIH, and TXALIV to return text
-* font, precision, and horizontal and vertical alignment as separate
-* values.
-*
-* New function $RGBINFO(icol,'R'|'B'|'G') to return values from color
-* tables.
-*
-* New function $HCDIR() to return current Hbook directory.
-*
-* Replace logic to analyze CWN variables in COMIS routines by the
-* built-in logic in COMIS routine CSLISTX.
-*
-* Mods in PHINFO
-*
-* Mods in PAWDEF (GRAFINFO/RGBINFO)
-*
-* Bug corrected in ANALYSE (recursive cut definition problem)
-*
-* Add option ".W' in CSCOM/PAWCS to prepare for CSLISTX
-*
-*::> VERSION 2.04/11 17/01/94 17.50.39
-*
-* Add /HCBONT/ and /HCBONTC/ in list of PAWCS commons.
-* Add new HPLOT routine HPLONT in PAWCS
-* Add new HIGZ routine IGONT in PAWCS
-*
-* Disable option L (CFOPEN) in PAWFOP for IBM.
-*
-* Increase size of COMIS stack from 20000 to 30000 words
-*
-* Reset LFIX=0 in HSETCD
-*
-* New command DLINE X1 X2 Y1 Y2. It draws a line taking care of
-* log scales. Also the syntax is conform to BOX, ARROW etc ...
-*
-*::> VERSION 2.04/10 09/01/94 14.49.17
-*
-* Changes in PPROJN, PANTUP and PIAFS to use new HIGZ/HPLOT 3-D
-*
-*::> VERSION 2.04/09 22/12/93 09.37.01
-*
-* Mods in PIAFS to support the new accounting scheme
-*
-*::> VERSION 2.04/08 08/12/93 13.55.48
-*
-* Global sections and shared memory are now visible with the browser.
-*
-* Introduce +SELF,IF=CZ in PANTUP.
-*
-* Introduce new option '?' in PAWINT2.
-*
-* Update list of dummies in 0PAMAIN and 0PAMAINM if NO CZ option.
-*
-* Problem with +SELF,IF=CZ fixed in routine PBPLUN.
-*
-*::> VERSION 2.04/07 29/11/93 17.15.20
-*
-* Changes in /CMOTIF/INIT to make PAW++ and GEANT++ happy
-*
-* Implement code to send /HCOPT/ from HBOOK to the PIAF server.
-*
-* Protect HFIXID for cases like Hi/plot id.prox where ID is 1-D
-*
-*::> VERSION 2.04/06 29/11/93 08.13.22
-*
-* Add GAUSS and DGAUSS in PAWCS
-*
-* Move SET PROMPT before calling PAWINT4 in PAW and PAWPP.
-*
-*::> VERSION 2.04/05 26/11/93 16.21.24
-*
-* Restructure of 0PAMAIN,PAW,PAWPP,PAWINT2.
-* With this new structure it is now possible to pass the workstation
-* type to PAW without being prompted.
-* ex: PAW default: you get the prompt Give workstation type
-* PAW -w no prompt. Use default workstation type
-* PAW -w 3 no prompt. Use workstation type 3.
-*
-* Sequences PCARGS and PCMODE modified.
-* The sequence PCARGS contains a character*80 variable CHARGS
-* which is the string passed to the invoquation of the PAW program.
-*
-*::> VERSION 2.04/04 25/11/93 15.45.35
-*
-* Bug fixed in HGETN2 (CHARACTER*8 BLOCK) missing.
-*
-* Mods in PAWROP to open PIAF connection automatically.
-*
-* Mods in PAMER2 to take advantage of the new HBOOK routine HRZKEY
-*
-* Undo the mods in HGETN2 to avoid problem with Ntuple/plot id.1
-*
-* changes in PIAFC for SIGHUP received by master and slave.
-*
-*::> VERSION 2.04/03 22/11/93 15.59.44
-*
-* Restructure initialisation routines PAW,PAWPP,PAWINTx
-*
-* Mods in PASCAN,PASCA1 for the MOTIF version
-*
-* Increase dimensions in $PAWCFU.
-*
-* Overflow problem (1.E10) corrected in GENERATI
-*
-*::> VERSION 2.04/02 17/11/93 14.50.53
-*
-* Introduce HBOOK routine HRENID in PAWCS:
-* To rename an HBOOK ID (histogram or ntuple), do:
-* Histo/file lun fname ! U
-* call hrenid(idold,idnew)
-*
-* Several changes in the patch,PIAFS.
-*
-* New version of CFCU.
-*
-*::> VERSION 2.04/01 16/11/93 08.50.20
-*
-* Minor change in PAGPRI (loop index changed from 6 to 7)
-*
-* NT/PLOT with four variables display also the color scale used.
-*
-* New option "X" in PACUTS in order to define graphical cuts using
-* a tracking cross cursor.
-*
-* Changes in PAWINT3 to print version/date automatically.
-*
-* Changes in PALOG to compute warning dates automatically.
-*
-* Modifications in PANTUP to allow more than 3 expressions in NT/LOOP
-*
-* Many changes PASCAN,PASCA1. Routine PASCA2 deleted.
-* New PASCAN is able to process new ntuples with PX(Ntrack).
-*
-* Changes in CFCU and PAWFCU: Calling PAWFCU with a simple NTUPLE column
-* name returns the column number of the variable instead of a pointer
-* in the ICODE stack.
-*
-* Sequences $PAWCFU $PCSCAN modified.
-*
-* WARNING!!!!! Important restructuting of the Main programs
-* and Initialisation routines.
-* 0PAMAIN and 0PAMAINM call new routines PAW and PAWPP.
-* PAWINT replaced by PAWINT1,PAWINT2,PAWINT3 and PAWINT4.
-* The new structure has been introduced to facilitate the calls
-* to PAW and PAWPP from user's programs, eg GEANT.
-*
-* Changes in LEX/SCANNER and CPAW/LEX_YY to:
-* correct syntax for COMIS files on VMS
-* DISK$SCRATCH:user is allowed as a filename
-* same thing for MASKs.
-*
-* Correction in CTOF77 macro in HPAW for VMS.
-*
-*::> VERSION 2.04/00 28/10/93 12.13.49
-*
-* $pawcfu extend CFUINFO to 6 to store 2 pawevt and pawsel
-* descriptor at the same time
-*
-* pawfcu pproj0 and pprojn look now for cfuinfo(5) and cfuinfo(6)
-* instead of ISEL and ISEVT
-*
-* MasterGeneration now generates two stack if ISEL = 1
-*
-* analyse_isel => case 1 OK ( mask and expr )
-*
-* analyse add a missing CopyTree
-*
-* parser add a missing CopyTree
-*
-* pcinfo correct the length of comis function's name
-*
-* Change in PALUNF. Output parameter redefined if LUN=0
-*
-* Variable PI now known from the parser.
-*
-* Documentation for parser updated.
-*
-* clean-up of unused variables and common blocks
-*
-* Function PNTVAL changed to Subroutine.
-*
-* Unused parameters CTITL and CAX removed from PANT3D.
-*
-* Clean-up routine CUBE and DRAWCU
-+DECK,V2_03.
-*CMZ : 2.03/22 22/10/93 09.43.08 by Rene Brun
-*-- Author : Rene Brun 21/06/93
-*
-*::> VERSION 2.03/22 22/10/93 09.43.08
-*
-* Bug in parser corrected for IBM only (problem with pipe character |)
-*
-*::> VERSION 2.03/21 21/10/93 15.22.20
-*
-* PIAF starts in PARalell mode by default
-*
-* Protections in PRINT statements (not to exceed 128 characters on VMS)
-*
-* Changes in PACUTS to allow for Log scales
-*
-*::> VERSION 2.03/20 19/10/93 15.35.29
-*
-*
-* Mods in PAWLOC for LOG scale axis
-*
-* Mods in PALOGS for PIAF (switch between SEQ and PAR mode)
-*
-* Several minor bugs in selection algorithms
-*
-* change colour defaults in cmotif/init
-*
-*::> VERSION 2.03/19 18/10/93 18.15.34
-*
-* Handling of the PIAF/STAGE command implemented on client side.
-*
-* New PIAF commands message mkdir and rmdir
-*
-* Fix in PPROJN for variable length arrays(2-D graphics case).
-*
-* Dummy code removed from PAWSEL
-*
-* Bug corrected in PAHOPE (wrong setting of JOFSET).
-*
-* Handling of x**y modified (case when y is integer).
-*
-*::> VERSION 2.03/18 15/10/93 16.54.01
-*
-* Fix in PPROJN for variable length arrays.
-*
-* Graphical cuts are correctly transmitted to Piaf.
-*
-* Removed some dead code from HGET2.
-*
-* In PACUTS, reset CUTS arrays before redefining a cut.
-*
-*::> VERSION 2.03/17 13/10/93 17.41.06
-*
-* Changes in PAWSEL to support chains
-*
-* Mods in PAHIST and PAPLOT in order to be able to draw LEGO
-* and SURFACES with more than 1000 channels
-*
-* Mod in the command GRAPH: the limits of the frame were not
-* computed correctly in case of constant negative functions.
-*
-*::> VERSION 2.03/16 08/10/93 18.07.34
-*
-* Corrections in Yacc/Lex parsers for the priority to evaluate
-* operations.
-*
-* .and..not. is now OK.
-*
-* Note important restriction on VM. COMIS files must be .fxxx
-*
-* Changes in ntuple expression selection mechanism:
-* a<1e4 not recognised, a<1.e4 was OK
-*
-* Comment calls to the new HMCSTAT package in PAWCS because of
-* space problems on VM.
-*
-* Limitation to 999 bins in PAHIST and PAPLOT removed.
-*
-* New Piafserver protocol (931013). Added graphical cut RPC.
-*
-* Routine PACUTS: fixed bug when saving and printing 1D graphical
-* cuts.
-* Introduced some Convex specific changes from Balashov.
-*
-* The command FOR/CLOSE now supports LUN=0 to close all open units.
-*
-* The above change is used in the PSTATE routine used in the Piaf
-* Master server to send the state information to the slave servers.
-*
-* Bug fixed in PCHNCD: did not return to correct sub-directory.
-*
-* Bug fixed in PPROJN: incorrect histogram filling when only event
-* numbers were stored in the dynamic memory buffer.
-*
-* Bug fixed in PECRIT: mistake in the LICODE scanning.
-*
-*::> VERSION 2.03/15 30/09/93 18.14.08
-*
-* Underscore allowed in ntuple variable names.
-*
-* New logic in ntuple selections and expressions to support
-* variable length arrays.
-*
-* Maximum cut expression-length increased to 128 characters
-*
-*::> VERSION 2.03/14 29/09/93 13.36.56
-*
-* Code removed in PAHIST and PAPLOT for Date, Stats etc.. drawing.
-*
-* Add routines HMCINI and HMCMLL to the list of PAWCS.
-* These two routines are part of the new package HMCSTAT in HBOOK
-* developped by C.Beeston, R.Barlow from OPAL.
-*
-* Mods in PPROJN to draw NT/PLOT id.x%y%z%t
-*
-*::> VERSION 2.03/13 27/09/93 11.50.35
-*
-* The HPLOT sequences HPL2, HPL9 and HPL12 are now suppressed.
-* This implies mods in PAGRAF, PAGHPL and PAHIST.
-*
-*::> VERSION 2.03/12 17/09/93 16.44.09
-*
-*
-* Mods in CMOTIF/CUTS to allow COMIS functions in Ntuple_viewer cuts
-*
-* Bug corrected in CPAW/GENERATI for graphical cuts and ANDs in cuts.
-*
-*::> VERSION 2.03/11 16/09/93 19.10.35
-*
-* Sequence $PCFUNC modified.
-*
-* Dummy routine CZTCP added in 0PAMAINM.
-*
-* HPUX option in LEX_YY and FLEX_SKEL
-*
-* Mods in PAWCS: Add HXI in list of COMIS callable routines
-*
-*::> VERSION 2.03/10 15/09/93 14.29.40
-*
-* Corrections in PPROJ0 to compute the VIDNs in Nt/Loop
-*
-* Changes in PAFUNC,PANDRA,PANT3D
-*
-*::> VERSION 2.03/09 13/09/93 16.43.34
-*
-* Problem with Character alignement fixed in PAWFCU.
-* Unitialized variable found in PPROJN
-* New version of PAWFCU.
-*
-*::> VERSION 2.03/08 07/09/93 12.05.29
-*
-* Modules deleted: PAWEVT,PAWDFF,PAWFCL,PAWFCM,PAWSLO,PAWTRN
-* PAWTYT,PAWTES,PAWTAL.
-*
-* Mods in PANTUP (upper/lower case in calls to PIAF routines)
-*
-* Changes to compile on RS6000.
-*
-*::> VERSION 2.03/07 06/09/93 12.42.13
-*
-* PATCH,PAWDEC removed.
-* Deck PAWDEC moved to patch,CPAW.
-* Deck PAMDEC moved to CMOTIF
-*
-* New patches YACC, LEX and HPAW.
-* Replacement of the old PAWFCU by the new set of routines PAWFCU,etc
-* generated by YACC and LEX.
-* Many changes in PPROJ0, PPROJN, PASCAN,etc to reflect the changes
-* due to the new PAWFCU.
-* Note that during the implementation phase, the include files in HPAW
-* must be generated before processing CPAW.
-*
-* The new PAWFCU includes many new facilities, in particular a better
-* syntax checking, the logic for arrays in ntuples.
-*
-* *** Parallel Piaf server code introduced ***
-*
-* Many changes and new routines in the PIAFS patch and a number
-* of new PF.... routines in the PAW patch.
-*
-* Changes in PADRFA, PANDRA and PPROJN to call the new routine IHISO.
-*
-* Bug fixed in HISTO (PATCH CMOTIF). The option used to draw ntuples with
-* Gouraud shading was not correct.
-*
-* MINUIT routine MNERRS callable from PAWCS
-*
-*::> VERSION 2.03/06 05/08/93 12.39.53
-*
-* New routines DENLAN,DSTLAN,DIFLAN,XM1LAN,XM2LAN,RANLAN in PAWCS.
-*
-*::> VERSION 2.03/05 03/08/93 15.39.17
-*
-*
-* New routine PMNCOMD called by HMINUT to read MINUIT data cards
-* Minuit command MNC is intercepted if it has 3 arguments
-* In this case a graphical contour is drawn
-* and the points in the contour are saved in vectors XFIT,YFIT
-* Normal PAW commands can be executed from MINUIT if they
-* are prefixed with a +
-*
-* Mods in the MOTIF interface to implement browser for PIAF files.
-*
-* Bug fix in PPROJ0 when XLOW(I)=XUP(I)
-*
-* Mods in PAHIO to call new routine HRESETM for shared memory
-*
-* Add routines HGNTB and RZQUOT in PAWCS.
-*
-* Routine HBUG activated for APOLLO
-*
-*::> VERSION 2.03/04 23/07/93 10.47.00
-*
-* Increased dynamic Ntuple buffer size in piafserv to 64MB (was 10MB).
-*
-* Command NT/CSELECT propagates setting to piafserv.
-* Routine PACSEL makes RPC back to client.
-*
-* Command NT/VMEM returns also memory statistics for piafserv.
-* Routine PVMEM: part of code moved to HBPRNT in HBOOK.
-*
-* Message of the day (motd) is now echoed immidiately after connecting
-* to piafserv.
-*
-* The commands H/ERR and H/AERR have now a CHOPT parameter (see HELP).
-*
-* New options to draw the errors in the command HISTO/PLOT (see HELP).
-*
-*::> VERSION 2.03/03 08/07/93 10.33.46
-*
-* Bug fix in PAWTYT for LOGICAL variables
-*
-*::> VERSION 2.03/02 930705 16.25
-*
-* The HPLOT routine HPLFRA is now callable in a COMIS program
-* (see PAWCS).
-*
-* New Command:
-* * GRAPHICS/HPLOT/AERRORS X Y EXL EXU EYL EYU N [ ISYMB SSIZE ]
-* to draw asymetric error bars.
-*
-* The "IAUTO" mechanism is now suppressed from PANTUP in order to
-* have the same plot with:
-* NT/PLOT 30.x and NT/PLOT 30.1
-* The variable IAUTO is suppressed from the sequence PAWNTU.
-*
-*::> VERSION 2.03/01 28/06/93 11.49.39
-*
-* Sequence PAWCFU modified
-*
-* Correction in PPROJ0 for log scale Y axis
-*
-* New version of the PIAFS patch.
-* command PIAF/CLOSE renamed to PIAF/DISCONNECT
-*
-* Bug fixed in PFINDV for VAGE(I)=AGE problem
-*
-* New version of TCPIAF
-*
-* New command HMINUIT (for Application HMINUIT)
-* Interactive MINUIT commands can be given in a APPLICATION HMINUIT
-* before invoking one the fit commands
-*
-* PAWFCU now handles correctly character substrings in a selection.
-*
-*::> VERSION 2.03/00 21/06/93 18.25.27
-*
-* UWFUNC now also adds the chain COMMONs to selection functions for
-* the RWNs.
-*
-* Fix for "NT/CHAIN chn -P path" command for VMS
-*
-* Added X (exchange mode option) to CHOPT for HI/FILE commands
-* (necessary for automatic record length detection) issued via the
-* Motif interface and via the chain mechanism
-*
-* Fixed bug in Ntuple scanner (matrix was not saved in context struct)
-*
-* Some code cleanup: Remove commons that are not referenced.
-*
-+DECK,V2_02.
-*CMZ : 2.02/07 08/06/93 12.16.22 by Rene Brun
-*-- Author : Rene Brun 29/04/93
-*
-*::> VERSION 2.02/07 08/06/93 12.16.22
-*
-* Add LRECL to PAWROP/PIAF message
-*
-* Mods in TCPIAF for VMS and Apollos
-*
-* Add initialisation of COMMON/CZCBUF/IZCBUF in PAWINT
-*
-*::> VERSION 2.02/06 07/06/93 15.14.04
-*
-* Changes in Histostyle (overlapping buttons for Alpha/OSF)
-*
-* Count I/O for commands PUT/GET in PZOPEN/TCPIAF
-*
-* Cleanup of some C code (inconsistencies found by Alpha OSF compiler).
-*
-*::> VERSION 2.02/05 04/06/93 14.30.04
-*
-* New commands PUT/GET in menu PIAF and associated routines
-*
-* Changes in PFINDV (in cases of TABs)
-*
-* PADVAR now adds automatically index variables referenced by other
-* variables to the list of variables to be read.
-*
-* Remove call to HSETC2 in PNUTIL/RECOVER
-*
-* Routine PSEXEC of the Piafserver now understands HGETNT and
-* HLNEXT RPC's (used by Hbook/Object browser).
-*
-* Routine HGETNT now makes an RPC to get the number of entries in
-* a chain. Before it was reading over the network the headers of
-* all Ntuples in the chain.
-*
-* Variable CERN removed from sequence PCARGS
-* Variable NTOLD initialized in PAWINT
-*
-* Changes in PAWFCU/PAWILD/PAWSEL
-*
-*::> VERSION 2.02/04 28/05/93 17.07.38
-*
-*
-* Change in PANTUP and PBIN when plotting ntuples with INTEGERS
-* in a column.
-*
-* Routine IGERR modified for the case CHROUT=' '
-*
-* Bug fixed in PASCA1 in case a mask is used in the selection.
-*
-* Nt/scan can be used for chains
-*
-*::> VERSION 2.02/03 27/05/93 15.20.53
-*
-* Default number of events to be processed by the Ntuple commands
-* has been changed from 999999 to 99999999.
-*
-* Changes in HGETNT for chains (compute total number of events)
-* Changes in PANTUP,PCNEXT,PPROJ0 and PPROJN for chains.
-*
-* Remove compiler warning from CPAW/CHAIN
-*
-* LINUX version introduced (V.Balashov, A.Lomov)
-*
-*::> VERSION 2.02/02 26/05/93 15.44.39
-*
-*
-* Sequence PAWBIG extended from 1000000 to 2000000 words
-*
-* Changes in PAWCS (Logical units) for NEWLIB version
-*
-* Several changes for the CHAIN mechanism.
-*
-* Many changes for the PIAF server.
-* First PIAF client-server implementation
-* New PATCH, HBPIAF. This contains HBOOK routines modified for
-* the PIAF server.
-*
-* New command NTUPLE/RECOVER to recover ntuple files with missing headers
-*
-* Mods in PAWROP. An already open file in U mode cannot be attached
-* if another process is also attaching the file in U mode. RZEND now
-* called to delete the ZEBRA structure.
-*
-* Changes in PCHNCD
-*
-* New HIGZ routine IGTCCH called in PACSEL
-*
-* Many changes in MOTIF version to support new coordinate systems
-* (Polar, cylindrical,spherical,pseudo-rapidity)
-*
-*::> VERSION 2.02/01 11/05/93 15.30.32
-*
-* Routines PAWINTM and PAWINT merged into PAWINT. This implies changes
-* in 0PAMAIN and 0PAMAINM.
-*
-* Changes calls to CSRPAW and CSRJCL to new COMIS routines
-* CSR1FN,CSR2FN and CSR3FN.
-*
-* Sequences CZSOCK and CZBUFF transfered to HBOOK.
-* Implemented RPC for HRDIR.
-* Fortran/Close closes now also correctly file connected to piafserv.
-* Routine PSRZIN does not look in PAWC anymore (see comments in routine).
-*
-* Bug fixed in PFINDV (IBM case) KLINE not cleared
-*
-* Bug fixed in PBIN for integers
-*
-* New sequence PACOMIS introduced. Space for COMIS increased from 10000
-* to 20000 words. PACOMIS referenced in PAWINT/PAWINTM
-*
-* New menu PIAF introduced. See corresponding HELP.
-*
-* Routines HGETID and HGETIR modified for the implementation of
-* the new sub-range facility.
-* Histogram subranges can be specified in 2 different ways:
-* 1- h/pl id(ic1:ic2) with ic1 and ic2 integers means plot
-* from channel ic1 to channel ic2
-* 2- h/pl id(x1:x2) with x1 and x2 reals (with a .) means plot
-* from channel corresponding to x1
-* Note that the mix mode h/pl id(x1:ic2) is also accepted
-* This subrange works also for 2-DIM cases.
-*
-* Interface to new version of COMIS introduced.
-* Many bugs (COMIS) corrected (the complete list from W.Mueller)
-* KUIP vectors can be used in COMIS main programs.
-* Garbage collections do not destroy the KUIP vectors in COMIS routines.
-*
-* In Histo/fit and Vector/Fit commands, one can now reference
-* an already compiled COMIS routine. The previous version accepted
-* only COMIS files.
-*
-* Sequences HPL3 and HIMETA suppressed.
-* New option -P for CHAIN command.
-* Work dialog for NTUPLE commands looping over chains (PAW++ only)
-*
-*::> VERSION 2.02/00 930429 8.26
-*
-* Chain logic implemented. See HELP Ntuple/Chain.
-*
-* Many changes due to the introduction of the PIAF server
-*
-* bug fixed in PAWFCA. Local variable I1 changed to J1 to avoid
-* a possible overwrite of I1 in /HCBITS/
-*
-* bug fixed in PAWFCU. Element 29 of array LNEXT set to 1.
-* This solves the problem :N/PLOT xxxx.XMNEN(VAR1,VAR2)
-*
-* Changes to Graphical cuts.
-* Graphical cuts on tranformations of the original variables
-* are accepted. This new facility requires a new version of SIGMA.
-*
-* In PAWCS INTRINSIC ERF,ERFC instead of EXTERNAL for IBM.
-*
-* Mods in PAFORT for calls to COMIS on VAX
-*
-+DECK,V2_01.
-*CMZ : 29/04/93 08.23.38 by Rene Brun
-*-- Author : Rene Brun 26/02/93
-*
-*::> VERSION 2.01/01 930305 14.57
-*
-* Bug fixes in PAFITH, PAFITV and PAMASK (CALL CLTOU).
-* Fixed the 25+ bugs reported by Rick Jones concerning Paw++.
-* Added extensive help on Paw++ user definable resources.
-* Added Paw++ About box (accessable via Kxterm).
-*
-*::> VERSION 2.01/00 930226 8.53
-*
-* Implement calls to KUGETF instead of KUGETC to take into account
-* the new KUIP command FILECASE.
-* Implement option 'D' in Histo/File
-* Change Histo/Scratch to Histo/Hscratch in CDF.
-* Bug fixed in PAWSEL for Graphical cuts
-* NeXT version available (Bernardino Ferreira).
-+DECK,V2_00.
-*CMZ : 26/02/93 08.53.39 by Rene Brun
-*-- Author : Rene Brun 07/12/92
-*
-*::> VERSION 2.00/07 930216 9.17
-*.
-* Changes in PAWFOP to open FZ files with the L option (CFOPEN)
-* Bugs corrected in PAWTYT,PPROJ0.
-*
-*::> VERSION 2.00/06 930201 14.03
-*
-* Protections against negative values for LOG10.
-* New function PLOG10.
-* Bug fixes in PAWFCU.
-* Changes in ntuple routines for ntuple with structures.
-* In PAHOPE: reset variable JOFSET.
-*
-*::> VERSION 2.00/05 930126 18.12
-*
-* Changes in PNTVAL for ntuples with arrays not correctly filled.
-* Call to IGTERM in PAMAINM to update the buffer for MOTIF version
-*
-*::> VERSION 2.00/04 930125 10.21
-*
-* Version for official distribution: Release CERNLIB v93a
-*
-* Bug fix in PAHOPE (test on CHOPT instead of CHOPT1) RESET works
-* Bug fixes in PAMERG when mixing old/new HBOOK files
-* Protection in PAWROP to prevent opening a file already connected
-* Bug fix in PAWTYT for long expressions in SQRT
-* Bug fixes in PAWFCU
-*
-*::> VERSION 2.00/03 930120 8.19
-*
-* Bugs fixed in routines to merge ntuples (old/new format)
-* Bug fixed in PAWFCU,PAWTYT (addition of COMIS functions)
-*
-*::> VERSION 2.00/02 930118 16.51
-*
-* Interface to new MOTIF/KXTERM panel
-*
-* Routine PAWSIM changed to DOUBLE PRECISION and use of HCFITD
-*
-* Option 'E' introduced in Histo/Operations commands
-* This option computes correctly the error bars for the resulting
-* histogram. Requires equivalent mods in HBOOK/HOPERA.
-*
-* Change HELP of Ntuple/Create command.
-* Add new callable routines in PAWCS
-*
-*::> VERSION 2.00/01 921221 17.55
-*
-*
-*::> VERSION 2.00/00 921207 10.28
-*
-*
-* new user callable routine HFINAM callable from COMIS.
-* HFINAM can be used to store the names of the parameters of a fit
-*
-* Protection added in LOCATE (PAGRAF)
-*
-* New command PICTURE/PRINT to print the current picture.
-*
-+DECK,V1_14.
-*CMZ : 20/10/92 10.03.08 by O.Couet
-*-- Author : Rene Brun 14/07/92
-*
-*::> VERSION 1.14/01 920715 9.31
-*
-* Change in PAWLOC, ISTAT is now tested just after the call
-* to IRQLC (koellner at lbl.Bitnet).
-*
-*::> VERSION 1.14/00 920714 13.29
-*
-* Routine PMLOCA removed from FPMOTIF (it was not used).
-* Bug corrected in PANT3D LOGX was tested instead of LOGZ.
-* The polymarker color index in now reset in PANTPM.
-* Bug corrected in PAHIST: angles not used in H/PLOT
-* Routines ERF,ERFC,FREQ,PROB added to list of callable routines
-* from COMIS in PAWCS.
-* Commons /HCFITS/ and /HCFITD/ added to PAWCS.
-* bug corrected in PAMASK for option CLOSE (L option in <MZDROP)
-* bug corrected in PAHIST: ANGLEs not used for 2D histos
-* without subranges.
-* Bug corrected in PAHIST (side effect of the previous correction)
-* slices were ignored in HISTO/PLOT ID.SLIX.
-*
-+DECK,V1_13.
-*CMZ : 14/07/92 13.29.42 by Rene Brun
-*-- Author : O.Couet 03/03/92
-*
-*::> VERSION 1.13/01 920306 9.49
-*
-* Bugs corrected in PAWUWF (changes in PAWIDN)
-* LINTRA command revisited. Sequence EQULIN replaced by PCLINT
-*
-*::> VERSION 1.13/00 920303 14.00
-*
-* First version of the $KUMACS PATCH.
-* Bug corrected in PAWFCU (A.Nathaniel)
-* Default values for X and Y in command TICKS are changed
-* to 1.E30.
-*
-* Bug corrected in PAWFCU (bug submitted by W.Mueller GSI)
-* Description : If one wants to fill with NTUPLE/PROJECT a
-* histogram with both a cut C and a weight W
-* one can use a command like
-* NTU/PROJ 10 100.exp W*(C)
-* e.g. NTU/PROJ 10 100.x a*(y>0)
-* which will increment at x with weight a if y>0.
-* This works fine, but the very similar case with two
-* conditions
-* NTU/PROJ 10 100.exp W*(C1)*(C2)
-* never increments the histogram no matter what the
-* conditions are. (bug corrected by Andy Cox)
-*
-* Many new routines added in PAWCS
-* (Most of the HBOOK user callable routines)
-*
-* IGTERM is called in the PAWEX macros.
-*
-* Mod in PAHIST to take care of the option "3" and "4" in the
-* command SURFACE
-*
-* New routines PANT3D, PANTAX and PANTPM to plot Ntuple in 3D
-* (G.Richards)
-* In the comand CUTS, the parameter CHOPT is now called OPTION
-*
-* More details on PAW version 1.13/00 are given in PAW.NEWS113
-*
-+DECK,V1_12.
-*CMZ : 03/03/92 14.15.24 by O.Couet
-*-- Author : Rene Brun 02/09/91
-*
-*::> VERSION 1.12/00 910902 11.17
-*
-* Changes in PAFITH to add option E in fit commands
-*
-+DECK,V1_11.
-*CMZ : 24/07/91 17.55.48 by Rene Brun
-*-- Author :
-*
-*::> VERSION 1.11/03 910708 14.44
-*
-* New routine HCOPYP to copy a projection into a 1-dim hist.
-* Ex: If ID=20 contains a PROX and 20 SLIX, then
-* H/copy 20.prox 1 copy PROX from 20 inti ID=1
-* H/copy 20.slix.12 12 copy SLIX.12 into ID=12
-*
-* Bug corrected in GET/Abscisa (C.Erd)
-* New versions of LOCATE and VLOCATE using the sample mode
-* facility of the X11 version of HIGZ.
-* Protection in PAFITV to avoid to draw a bar chart if 'B'
-* (Bounds) is selected in V/FIT.
-*
-* Corrections for NEWLIB version (Harald Butenschoen,DESY)
-* in routines PAMAIN,PAHIO,PAOPEN,PAWFOP
-*
-* New routines HMAXIM,HMINIM,HMAX,HMIN,HNORMA,HREND in PAWCS
-* New routine HGFIT in PAWCS
-* Buffer size for COMIS increased from 5000 to 10000 words
-*
-* Bug corrected in PASCA1 whem masks are used
-*
-* Change in PANTUP for Ntuple/Read on VM
-*
-* First version of PAW_MOTIF: Flag MOTIF introduced and
-* new patches FPMOTIF and CPMOTIF.
-*
-*::> VERSION 1.11/02 910307 11.55
-*
-* Bug corrected in command Ntuple/Lintra
-* Rename parameter CHOPT to OPTION in command Ntuple/Plot
-* Memory mapping implemented in command GLOBAL
-* (requires mapping routines from HBOOK and KUIP)
-*
-*::> VERSION 1.11/01 910225 8.40
-*
-* Changes in PILOT,PATCH *PAW
-* Changes in RLOGIN to allow hostnames up to 16 characters
-*
-*::> VERSION 1.11/00 910214 18.30
-*
-* New COMMON HIGRAF introduced in PAWCS. This allows to
-* access the points used by the command GRAPH with
-* option 'C' in a COMIS program.
-* New option 'F' in the command GRAPH. The command GRAPH
-* with option 'C' or 'CF' allows now to draw closed
-* contours.
-*
-* Correction in PAGKSA: LIST change in PALETTE
-* Upgrade of command SCAN. It is now possible to scan
-* expressions of the original variables.
-* In the command CONTOUR, IFLAG is now replaced by CHOPT.
-* This allow to superimpose contour plots. This mod is
-* compatible with the previous version.
-*
-+DECK,V1_10.
-*CMZ : 10/07/91 19.40.26 by Rene Brun
-*-- Author :
-*
-*::> VERSION 1.10/00 901107 14.12
-*
-* Option LOGX and LOGY available for 2D histos and Ntuples
-* The command MAX works now on 2D histograms
-* Bug corrected in PAGPRI (command HIST in case of non
-* equidistants bins)
-* New application : SLIDE
-* Mods in installation craddle
-* Bug corrected in FUN/PLOT in case of option same
-* New commands:
-* /FUNCTION/DRAW UFUNC [ CHOPT ]
-* /FUNCTION/ANGLE [ THETA PHI ]
-* /FUNCTION/RANGE [ XLOW XUP YLOW YUP ZLOW ZUP ]
-* /GRAPHICS/ATTRIBUTES/PALETTE PALNB [ NEL LIST ]
-* /GRAPHICS/WORKSTATION IWKID [ CHOPT IWTYP ]
-* /NTUPLE/LINTRA IDN [ CHOPT NEVENT IFIRST NVARS VARLIS ]
-* Commands modified, in order to take care of the new 3D
-* plots facilities of HIGZ:
-* /HISTOGRAM/2D_PLOT/LEGO [ ID THETA PHI CHOPT ]
-* /HISTOGRAM/2D_PLOT/SURFACE [ ID THETA PHI CHOPT ]
-* /HISTOGRAM/PLOT [ ID CHOPT ]
-*
-+DECK,V1_08.
-*CMZ : 10/07/91 19.40.26 by Rene Brun
-*-- Author :
-*
-*::> VERSION 1.09/00 900124 10.42
-*
-* Fix bug in PAMERG
-* Command Ntuple/Plot can now book/fill a Profile histogram
-* if option 'P' is given.
-*
-*::> VERSION 1.08/00 891220 18.47
-*
-* New parameter in command CONTOUR to plot user contours
-* When option 'E' is selected in Ntuple/Plot, HBARX is
-* automatically called for the output histogram
-* New routines HCDIR and HGIVEN in PAWCS
-* Command NULL now based on HPLFRA from HPLOT
-* This allow the redefinition of LOG/LIN scales
-* on a LIN/LOG scale frame.
-* Special connection ID for GKS metafiles 4011-->4230
-*
-
-+DECK,V1_07.
-*CMZ : 10/07/91 19.40.26 by Rene Brun
-*-- Author :
-*
-*::> VERSION 1.07/00 891010 18.23
-*
-*
-* Correction in PAFUNC (option 'S')
-* Number of Ntuple variables extended to 512
-* Bug fixed in PAHFIT
-* PAHFIT modified for the new HFITGA,EX,PO
-* New commands Histo/Fit and Vector/Fit
-* Correction in PAFUNC for LOGY scales
-* Changes in HGETID fir status word bit 5 of HBOOK
-* New routine PALOGS for PAW monitoring
-* Changes in PAMAIN (PAW$LOGON on VAX,etc)
-* RSHELL writes on LOUT
-* Command Picture/SCR activated.
-* Added Interactive Minuit to HFITH/HFITV.
-* PAHIST modified to call HPLTAB for sub-ranges.
-* Mods in PAFORT and PASIGM to permit calling
-* COMIS or SIGMA in KUIP macros.
-* CDF modified
-* PAWROP. Automatic LRECL on VAX.
-* Ranges in CONTOUR,LEGO,SURFACE.
-
-+DECK,V1_06.
-*CMZ : 10/07/91 19.40.26 by Rene Brun
-*-- Author :
-*
-*::> VERSION 1.06/00 890629 12.25
-*
-* Bug corrected in PAWROP (VAX)
-* Bug corrected in HPROJ0 (double counting in MASKs)
-* Bug corrected in HPROJA (remove CALL PAWFCI)
-* Routine KUTIME added in PAWCS
-* Routine HPLOC added in PAWCS
-* Routine HDERIV added in PAWCS
-* Bug corrected in PAWUWF (comma missing in case of V_..)
-* Common blocks /QUEST/ and /KCWORK/ added to PAWCS
-* Changes for log/log scales in PAFUNC
-* CALL KUTERM(IGTERM) added in PAWINT (to empty graphics buffers)
-* Changes in PACSEL and PANTUP (when typing CSEL CB)
-* test .LE. changed to.EQ. after KUGETV (for ? vector)
-* BATCH version introduced
-* New routine PAWARG (NOLOG,BATCH,BATCHF)
-*
-+DECK,V1_05.
-*CMZ : 10/07/91 19.40.26 by Rene Brun
-*-- Author :
-*
-*
- Routine PAWWID deleted. Replaced by HIGZ routine IGWKTY
-*
-*::> VERSION 1.05/04 890403 8.30
-*
-* New menu /NETWORK with 2 new commands RLOGIN and RSHELL
-* New routines RLOGIN and RSHELL
-* Interface for the ZEBRA server ZS rewritten
-* Call to PACSEL added in PANTUP (for lego and contour)
-* Changes in PANTUP (avoid 2 passes when ID exists)
-* ==>Important change in HGETID and HGETNT
-* If current directory is not //PAWC, then ID in /PAWC/
-* is always deleted and HRIN called
-* H/plot ID always gets a copy from Current Directory
-* IDOLD not used anymore
-* More information given in the HELP of Ntuple/Plot.
-* New command PAVE
-* LOCATE command returns CONTENT of channel/cell
-* Hbook functions HX and HXY callable from COMIS
-*
-*::> VERSION 1.05/03 890301 18.57
-*
-* Changes for IWK in PAWWID,PANTUP
-* Changes in PAGPRI (Dim for XLOG changed to 800 from 200)
-* Changes in Command Fit/Function (additional parameters)
-* Sequence NTSCAN renamed PCSCAN
-* (Version never released)
-*
-*
-*::> VERSION 1.05/02 890124 16.07
-*
-*
-* New sequences PCPATL,PCCHAR and PCFUNC
-* Use above sequences instead of local variables
-* KUGETI(ID) changed to PAGETI(ID). New routine PAGETI
-* ID='*' means ID='0'
-* All local variables SAVEd
-* List of COMIS routines printed by ENTRY PAWCSH
-* Protections in PAHFIT and PAWSEL
-* New command DDIR to delete a directory
-* Command ARROW can draw a double arrow
-* CDF modified
-* Modified HBOOK sequence HCDIRE introduced.
-* HFNAME filled with file name
-* Sequence HPL1 deleted. Use HPLOPT(opt,-1) instead
-* Protections in HGETID,HGETNT and PAWROP
-* Automatic setting of workstation type on Apollos
-* Changes in PANTUP for automatic binning
-* New command Ntuple/Merge
-* New routines PAMERG,PAMER1 and PAMER2
-* NUPD changed from 30000 to 1000000
-*
-*::> VERSION 1.05/01 881221 14.05
-*
-* Unused variables or commons deleted.
-* Routine PAWUSR called with an argument in PAWINT and PAEXIT
-* Changes in PAWFOP for IBM (IOFILE01 instead of IOFILE1)
-* Routine VECDEF called from PAWDEF and not from KUINIT
-* New routine PAHELP
-* Mods in CDF for new HELP facility (PAHELP)
-* New routine PACLOS (FILEDEF CLEAR on VM)
-* New routines PAOPEN,PAREAD,PAWRIT (callable from COMIS)
-* New PATCH,CDF introduced
-* ZLOWNT,ZUPNT introduced in /PAWNTU/
-* Changes in PANTUP (LOSTAT) and 40 bins for 2-Dim
-*
-+PATCH,$KUMACS.
-+DECK,INSTALL.
-*CMZ : 2.07/06 11/07/95 17.46.47 by O.Couet
-*-- Author : O.Couet 04/10/91
- Macro INSTALL 1=X 2=ftn 3=X 4=X
-*
- If [1]='?' Then
- Exec help
- Goto END
- Endif
- File hbook
- Pilot *hbook
- Rel hbook
-*
-* Set the FORTRAN extension
-*
- Case $MACHINE In
- (APOLLO) Alias/Create ext ftn
- (IBM) Alias/Create ext fortran
- (VAX) Alias/Create ext for
- (*) Alias/Create ext f
- Endcase
-*
-* LIBRARY Library name
-* CODEDIR Source code directory
-*
- LIBRARY = $Lower([1])
- CODEDIR = $Lower([2])
-*
-* Install the examples
-*
- If [CODEDIR]='example' Then
- Select $MACHINE
- Set [LIBRARY]/*.kumac -D
- Ctot -Y //paw/paxmac/*
- Set [LIBRARY]/*.ext -D
- Ctot //paw/paxfor/*
- Set [LIBRARY]/*.dat -D
- Ctot //paw/paxdat/*
- Goto END
- Endif
-*
- D = FALSE
- M = FALSE
- Do I = 3,[#]
- Case $Upper([%I]) In
- (DEBUG) D = TRUE
- (MOTIF) M = TRUE
- Endcase
- Enddo
-*
- Mess ' '
- Mess Installation of PAWLIB on $MACHINE _
- starting at $DATE $TIME .
- Mess ' '
-*
- Set [CODEDIR]/paw.sh -XADCL
-*
-* Set up the library name
-*
- If [LIBRARY] = 'x' Then
- Set [CODEDIR]/$cmzfile.a -L
- Else
- Set [LIBRARY] -L
- Endif
-*
- If [D] = TRUE Then
- Case $MACHINE In
- (APOLLO) D=' -dba'
- (HPUX,SGI,SUN,DECS,IBMRT) D=' -g'
- (VAX) D='/NOOP/DEB'
- Endcase
- Else
- D=' '
- Endif
-*
- If [M] = TRUE Then
- Sel MOTIF
- Endif
-*
-* Set up the FORTRAN compiling options
-*
- Set FORTRAN -LAN
- Set [CODEDIR]/*.ext -F
- Case $MACHINE In
- (APOLLO) Set '/com/ftn $compfile//[D]//' -indexl -save' -C
- (HPUX) Set 'f77 -c'//[D]//' +ppu $compfile' -C
- (SUN) Set 'f77 -c'//[D]//' -O $compfile' -C
- (IBMRT) Set 'xlf -c'//[D]//' -qextname $compfile' -C
- (SGI,DECS) Set 'f77 -c'//[D]//' $compfile G 3' -C
- (VAX) Set 'FOR'//[D]//' $compfile' -C
- Endcase
-*
-* Select the options
-*
- Select $MACHINE
-*
- Pilot *PAW
-*
-* CMZ, FORTRAN, Library ...
-*
- Set
- seq
- Cfl -P
-*
-* Motif Part
-*
- If [M] = FALSE Goto END
- Set C -LAN
- Set [CODEDIR]/*.c -F
-*
- if $MACHINE = HPUX Then
- OPTC = ' -z -DSYSV -Aa -D_HPUX_SOURCE'
- X11H = ' -I/usr/include/X11R4'
- XMH = ' -I/usr/include/Motif1.1'
- Set 'cc -c'//[D]//[OPTC]//[X11H]//[XMH]//' $compfile' -C
- Endif
- if $MACHINE = IBMRT Then
- Set 'cc -c'//[D]//' $compfile' -C
- Endif
-*
- Pilot *PAW
- Set
- Cfl -P
-*
-END:
- Return
-+DECK,HELP.
-*CMZ : 1.13/00 06/02/92 15.14.55 by O.Couet
-*-- Author : O.Couet 04/10/91
- Macro HELP
-*
- Mess ' '
- Mess ' The installation procedure of the PAW library is:'
- Mess ' '
- Mess ' CMZ -INSTALL PAW LIB_NAM SRC_DIR OPTIONS'
- Mess ' '
- Mess ' Where :'
- Mess ' '
- Mess ' LIB_NAM is the library name'
- Mess ' '
- Mess ' SRC_DIR is the source directory name'
- Mess ' '
- Mess ' OPTIONS :'
- Mess ' - DEBUG compile with debug option'
- Mess ' '
- Mess ' The installation procedure of the PAW examples is:'
- Mess ' '
- Mess ' CMZ -INSTALL PAW DIR example'
- Mess ' '
- Mess ' Where :'
- Mess ' '
- Mess ' DIR is the directory where the example will be installed'
- Mess ' '
-*
- Return
-+PATCH,*PAW
-+DECK,BLANKDEK.
-*CMZ : 21/11/95 14.12.43 by O.Couet
-*-- Author :
-+USE,HCDES. This PATCH is in the HBOOK PAM file
-+USE,HPAW, IF=-MAIN. Contains include files for patch CPAW
-+USE,PAW,CPAW, IF=-MAIN.
-+USE,FPANELS,IF=MOTIF,IF=-MAIN.
-+USE,HMOTIF,FMOTIF,CMOTIF,UIMX,TREE,IF=MOTIF,IF=-MAIN.
-+USE,FPANELSH,FPANELSC,FPANELSF,IF=MOTIF,IF=-MAIN.
-+USE,XBAE, IF=MOTIF,IF=-VAX,IF=-QMALPH,IF=-MAIN.
-+USE,XBAEVMS, IF=MOTIF,IF=VAX,QMALPH,IF=-MAIN.
-+USE,P=PAW,D=0PAMAIN, IF=MAIN,IF=-MOTIF.
-+USE,P=PAW,D=0PAMAINM, IF=MAIN,IF=MOTIF.
-+USE,PAWCDES,COMIS.
-+USE,QP, IF=DEV.
-+USE,NTUPLE, IF=QP.
-+USE,CZ, IF=-IPSC,IF=-MSDOS.
-+USE,UNIX, IF=ALLIANT,CONVEX,AIX370,UNISYS,MSDOS,LINUX,WINNT.
-+USE,UNIX, IF=DECS,GOULD,IBMRT,MACMPW,SGI,SUN,HPUX,IPSC.
-+USE,IBM, IF=IBMMVS,NEWLIB.
-+USE,BSLASH, IF=IBMRT,SGI,DECS,SUN,IPSC,APOF77,LINUX,QMALPH.
-+USE,BSLASH, IF=MSDOS,WINNT.
-+USE,DOUBLE, IF=IBM,VAX,NORD,APOLLO.
-+USE,DOUBLE, IF=UNIX,IF=-SINGLE.
-+USE,MMAP, IF=UNIX,APOLLO,IF=-IPSC,IF=-MSDOS,IF=-NEXT,IF=-CONVEX.
-+USE,QXNO_SC, IF=CRAY,VAX,IBM.
-+USE,QXNO_SC, IF=APOLLO,IF=-APOF77.
-+USE,QX_SC, IF=SGI,IBMRT,SUN,CONVEX,DECS,AIX370,HPUX,APOF77.
-+USE,QX_SC, IF=NEXT,LINUX,MSDOS,WINNT.
-+USE,BUGREPORT, IF=UNIX,VAX,IBM,IF=-IBMMVS,IF=-NEWLIB.
-+PATCH,*PIAFS.
-+DECK,blankdek.
-*CMZ : 2.06/01 08/12/94 16.57.25 by Fons Rademakers
-*-- Author : Fons Rademakers 15/04/93
-+USE,PIAFSPAT.
-+USE,CORE.
-+USE,PIAFS.
-+USE,HBPIAF. modified routines until we dare to move them into HBOOK itself
-+USE,TGV,IF=VAX.
-+PATCH,SCRIPTS.
-+DECK,IBM,IF=IBM.
-*CMZ : 2.06/08 12/01/95 15.52.59 by O.Couet
-*-- Author : M.Marquina 08/24/89
-/*DEFAULTS_SUPPORTED*/
-/**********************************************************************
- * *
- * PAW EXEC v1.21 *
- * *
- * Exec to drive PAW supporting versions *
- * *
- * Author: M.Marquina 89/08/24 *
- * *
- * Mods Date Comments *
- * MARQUINA 90/05/25 Preserve user filedefs before running PAW *
- * MARQUINA 90/05/28 Enable transmission of options *
- * 90/07/13 Introduce GDDM option *
- * 90/08/24 Use new XCPUSH/XCPOP, monitor with UMLOG *
- * 90/10/10 Support shared version of PAW with option SHARED *
- * 90/11/13 Add GKS option *
- * 91/02/17 Support PF-keys and defaults (TERM,DRIVER) *
- * 91/03/04 Introduce X11 via X11 and HOST options *
- * 91/03/21 Preserve user TXTLIBs via CPUSH/CPOP *
- * 91/04/04 Issue a message when the module is missing *
- * 91/04/19 Stop exec monitoring of PAW *
- * 91/04/19 Give meaningful messages for rc=-2,-4 *
- * 91/07/29 Set C-libs to run X11 module in XA mode *
- * 91/11/22 Add option TCPIP *
- * 92/02/28 Remove protection on GDDM segment. Now at 9M *
- * 92/03/10 Move up the lower limit to run PAW *
- * 92/12/09 Use NEW as replacement for missing DEV modules *
- * Replace XCPUSH/XCPOP by new RXLOCFN functionality*
- * Enable TCPIP version as default,set min-stor 9M *
- * 93/03/18 Add DISPLAY as synonym to HOST *
- * 93/06/01 Check XC mode to run GDDM version *
- * 93/09/17 Increase minimum required storage *
- * N.Watson 93/10/21 Remove eventual trailing parenthesis *
- * *
- **********************************************************************/
- Address Command
- Arg parms "(" options ")"
- Parse Source . . xfn .
-
- f.list ='FIND'(options,"LIST" )>0
- f.set ='FIND'(options,"SET" )
- f.reset ='FIND'(options,"RESET")>0
-
- If f.reset Then Do
- 'GLOBALV SELECT *EXEC SETLP' xfn
- Call ERROR 3 4
- End
-
- 'GLOBALV SELECT *EXEC GET' xfn
- optd='VALUE'(xfn) ; If optd="" Then optd="DRIVER GKS TERM ?"
-
- If f.list Then Do
- 'CLRSCRN'
- vs='SOURCELINE'(4) ; Parse Var vs . . . vs .
- Say ' ____________________________________________'
- Say ' ' xfn vs ': Default options'
- Say ' ____________________________________________'
- Say ' ' optd
- Exit
- End
-
- Parse Var optd . "DRIVER" drvd . ; drv=drvd
- Parse Var optd . "TERM " trmd . ; trm=trmd
-
- f.term ='FIND'(options,"TERM " )
- f.driv ='FIND'(options,"DRIVER")
- f.gks ='FIND'(options,"GKS" )
- f.gddm ='FIND'(options,"GDDM" )
- f.x11 ='FIND'(options,"X11" )
-
- f.local ='FIND'(options,"LOCAL" )
- f.shared='FIND'(options,"SHARED")
-
- If f.term>0 Then Do
- trm='WORD'(options,f.term+1) ; options='DELWORD'(options,f.term,2)
- End
- If f.driv>0 Then Do
- drv='WORD'(options,f.driv+1) ; options='DELWORD'(options,f.driv,2)
- End
- If f.gks>0 Then Do
- drv='GKS' ;options='DELWORD'(options,f.gks,1)
- End
- If f.gddm>0 Then Do
- drv='GDDM' ;options='DELWORD'(options,f.gddm,1)
- End
- If f.x11>0 Then Do
- drv='X11' ;options='DELWORD'(options,f.x11,1)
- End
-
- If f.set>0 Then Do
- 'GLOBALV SELECT *EXEC SETLP' xfn "DRIVER" drv "TERM" trm
- 'EXEC DEFAULTS LIST' xfn
- Exit
- End
-
- If ^'QSTOR'("11M") Then Call ERROR 1 8 "11M"
- If ^'XFLAG'("CMSXA") & drv="GDDM" Then Call ERROR 2 8
-
- vn='GETVER'(options,"LINK")
- vv=""
- If vn^="PRO" Then Do
- vv='LEFT'(vn,1)"_"
- vtext="TCPIP"
- If f.local>0 Then vtext="Local"
- Say
- Say "Calling" vn "version of" xfn"-"drv"/"vtext"..."
- Say
- End
- If f.shared>0 Then Do
- vv=vv"S" ; options='DELWORD'(options,f.shared,1)
- End
- pgm=vv||xfn
- If f.local >0 Then Do
- pgm=pgm"L" ; options='DELWORD'(options,f.local,1)
- End
- pgm='LEFT'(pgm||drv,8)
-
- 'ESTATE' pgm 'MODULE'
- If rc^=0 Then Call ERROR 5 rc pgm vn
-
- prc='CPUSH'("FILEDEF","CLEAR","PFK","SET","TXTLIB","LOADLIB")
-
- nw='FIND'(options,vn)
- If nw>0 Then options='DELWORD'(options,nw,1)
-
- If f.shared>0 Then 'EXEC CERNLIB PAWLIB GRAFLIB ( SHARED'
-
- nw='FIND'(options,"HOST")+'FIND'(options,"DISPLAY") ; host=""
- If nw>0 Then Do
- host='WORD'(options,nw+1)
- options='DELWORD'(options,nw,2)
- End
- If drv="GDDM" Then 'GLOBAL TXTLIB ADMNLIB ADMGLIB ADMRLIB'
-
-/* With the new KUIP all PAW modules need the IBMLIB library */
-
- 'EXEC CERNLIB ( TCPIP USER QUIET'
-
- If drv="X11" & host^="" Then ,
- 'GLOBALV SELECT CENV SETPL DISPLAY' host':0'
-
- If options^="" Then parms=parms "("options
- 'FILEDEF 6 TERM (LRECL 133'
-
- 'IDENTIFY ( LIFO' ; Pull . . site .
- If site="CERNVM" Then 'EXEC UMLOGDEV * 0' vn pgm parms
-
- 'EXECIO 1 CP ( LIFO STRING QUERY CONSOLE' /* Run in batch? */
- Pull . . console . ; _b= console^="ON"
-
- If ^_b Then Do
- 'EXEC USERPF PAW' /* Set PAW PF-keys */
- If trm^="?" Then Do /* Get Workstation type */
- tlist="" ; wlist=""
- Select
- When drv="GKS" Then Do
- tlist="ALPHA PSP PSL T4010 T4012 T4014 T4014E" ,
- "T4107 T4109 T4111 T4113 T4115 T4207 PG " ,
- "MX2000 MX8000 MG200 MG600 FALCO VT240 VT340 "
- wlist="0 -111 -112 101 102 101 103 " ,
- "121 122 123 125 127 121 7878 " ,
- "121 127 7800 7800 7878 1020 1030 "
- End
- When drv="X11" Then Do
- tlist="ALPHA PSP PSL EPS PSCP PSCL LATEX " ,
- "LATEX"
- wlist="0 -111 -112 -113 -114 -115 -777 " ,
- "-778"
- End
- Otherwise Nop
- End
- nw='FIND'(tlist,trm) ; If nw>0 Then trm='WORD'(wlist,nw)
- Push trm
- End
- End
- If vn="DEV" Then Do
- 'ESTATE' pgm 'MODULE' ; If rc^=0 Then pgm="N_"'SUBSTR'(pgm,3)
- End
- pgm parms
- cc=rc
- If site="CERNVM" Then 'EXEC UMLOGDEV * 1' vn pgm parms
-
- If prc=0 Then rc='CPOP'("FILEDEF","PFK","SET","TXTLIB","LOADLIB")
- If cc=-2 Then Call ERROR 4 cc pgm vn
- If cc=-4 Then Call ERROR 6 cc pgm vn
- Exit cc
-/* ------------------------------------------------------------------ */
- ERROR:
- Procedure Expose xfn
- Arg ne cc vv v2 .
-
- src="CRN"xfn
- err.1 ="001E Insufficient storage. Get at least" vv ,
- "with the command: CP DEFINE STORAGE" vv
- err.2 ="002E PAW/GDDM may only run in XC mode;" ,
- "use the command: IPL CMSXC"
- err.3 ="003W Defaults reset for" xfn "command"
- err.4 ="004W Module" vv "cannot run in SUBSET mode"
- err.5 ="005W Module" vv "not available in the" v2 "area"
- err.6 ="006W Module" vv "cannot load. IPL or LOGOFF to clear" ,
- "the memory"
- err.99="900E Uninitialised variable encountered on line" vv
-
- 'EXECIO 1 EMSG (STRING' src||err.ne
- Exit cc
-+DECK,UNIX,IF=UNIX.
-*CMZ : 2.06/08 12/01/95 15.56.15 by O.Couet
-*-- Author : M.Marquina 06/10/90
-#!/bin/sh
-# **********************************************************************
-# * PAW SHELL 1.05 *
-# * *
-# * Shell driver to the different versions of PAW *
-# * *
-# * Author: M.Marquina 90/10/06 *
-# * Mods Date Commments *
-# * MARQUINA 90/11/30 Add host option, pass on non-filtered options *
-# * 91/08/15 Access pawGKS directly from GKS_ROOT *
-# * 91/12/12 Correct local SUN host *
-# * 93/03/26 Add -display option, do not override DISPLAY *
-# * clean up empty paw.metafile *
-# * G.Folger 93/11/02 pawGKS is now in CERN_ROOT/$ver/gksbin *
-# * *
-# **********************************************************************
-
- SHOPT="d:h:v:"
-#SEQ,GETOPTD.
- [ "`uname -s`" = "DomainOS" ] && drv="GKS" || drv="X11"
- [ -z "$CERN" ] && CERN="/cern"
- [ -z "$CERN_LEVEL" ] && ver="pro" || ver="$CERN_LEVEL"
-
- while [ $# -gt 0 ]
- do case $1 in
- -d) drv=$2 ; shift ;;
- -h) hst=$2 ; shift ;;
- -display) hst=$2 ; shift ;;
- -v) ver=$2 ; shift ;;
- --) shift ; break ;;
- *) break ;;
- esac
- shift
- done
-
- GDIR=$CERN/$ver/bin
- if [ "$drv" = "GKS" ] ; then
- [ -z "$GKS_ROOT" ] && GKS_ROOT="$CERN/gks/$ver"
- [ -z "$GKS" ] && . $CERN/gks/$ver/mgr/gksstart.sh
-# inlib $GKS_INLIB
- GDIR=$CERN/$ver/gksbin
- fi
- if [ "$drv" = "X11" -a -n "$hst" ] ; then
- nw=`echo $hst | awk -F: '{ print NF }'`
- [ $nw -eq 1 ] && hst="$hst:0"
- DISPLAY="$hst" ; export DISPLAY
- fi
- if [ "$ver" != "pro" ] ; then
- echo
- echo " Calling $ver version of paw-$drv"
- echo
- fi
- $GDIR/paw$drv $*
- [ ! -s paw.metafile ] && rm paw.metafile
-+DECK,VAX,IF=VAX.
-*CMZ : 2.07/00 24/04/95 16.10.29 by O.Couet
-*-- Author : J.Bunn 12/01/95
-$!========================================================================
-$!
-$! Name : PAW
-$!
-$! Purpose : Invokes the required version of the PAW executable
-$!
-$! Arguments : See PAW /HELP
-$!
-$! Created 25-NOV-1994 Julian J. Bunn
-$! Mods 7-MAR-1995 Roger Ruber (for UCX)
-$! 24-APR-1995 Julian J. Bunn (corrections for batch mode)
-$!
-$!========================================================================
-$ ON ERROR THEN $ GOTO EXIT
-$ ON CONTROL_Y THEN $ GOTO EXIT
-$ all_opts = "''p1' ''p2' ''p3' ''p4' ''p5' ''p6' ''p7' ''p8'"
-$!
-$! If a site paw_options.com exists, then take override symbols from that ...
-$!
-$ if f$search("cern_root:[exe]paw_options.com") .nes. "" then
- at cern_root:[exe]paw_options
-$!
-$! Otherwise, set them here ...
-$!
-$ if f$type(root_dir) .eqs. "" then root_dir = f$trnlnm("CERN")-"]" ! The
-root of the CERN Program Library Tree, minus it's appendage
-$ if f$type(driver_override) .eqs. "" then driver_override = "" ! "X11"
-for X, "DGKS" for DEC GKS, "GKS" for GTS-GRAL
-$ if f$type(TCP_override) .eqs. "" then TCP_override = "" ! "_U"
-for UCX, "_M" for Multinet, "" for not linked with IP
-$! ! (no
-IP means no NETWORK menu in PAW, and, e.g. no PIAF access)
-$ if f$type(level_override) .eqs. "" then level_override = "" ! NEW
-or OLD or PRO or blank
-$ if f$type(plusplus_override) .eqs. "" then plusplus_override = "" ! ++ or
-blank
-$ if f$type(transport_override) .eqs. "" then transport_override = ""! blank
-or TCPIP or DECNET or WINTCP (to create remote displays)
-$ set symbol/scope=local
-$!
-$! Other symbols used in the procedure
-$ paw_choice = "" ! will be the selected PAW exe
-$ paw_available = "" ! will be list of PAW exe locally available
-$ paw_options = "" ! the options to be passed to the PAW exe
-$ node = "" ! will be the remote node name for remote display
-$ transport_type = "" ! will be transport to remote node
-$ display_was_created = "no"
-$ display_exists = "no"
-$ create_display = "no"
-$ help = "no"
-$!
-$! First extract any overrides set by the user on the command line
-$ lopts = f$length(all_opts)
-$ lpp = f$locate("++",all_opts)
-$ lip = f$locate("=TCPIP",all_opts)
-$ lde = f$locate("=DECNET",all_opts)
-$ lwi = f$locate("=WINTCP",all_opts)
-$ lnode = f$locate("/NOD",all_opts)
-$ lx11 = f$locate("/X",all_opts)
-$ ldgks = f$locate("/D",all_opts)
-$ lgks = f$locate("/G",all_opts)
-$ lpro = f$locate("/P",all_opts)
-$ lold = f$locate("/O",all_opts)
-$ lnew = f$locate("/NE",all_opts)
-$ lquer = f$locate("/Q",all_opts)
-$ lhelp = f$locate("HELP",all_opts)
-$ lmult = f$locate("/M",all_opts)
-$ lucx = f$locate("/U",all_opts)
-$ lbare = f$locate("/NOT",all_opts)
-$ llist = f$locate("/L",all_opts)
-$ if lx11 .ne. lopts then driver_override = "X11"
-$ if ldgks .ne. lopts then driver_override = "DGKS"
-$ if lgks .ne. lopts then driver_override = "GKS"
-$ if lnew .ne. lopts then level_override = "NEW"
-$ if lold .ne. lopts then level_override = "OLD"
-$ if lpro .ne. lopts then level_override = "PRO"
-$ if lpp .ne. lopts then plusplus_override = "PP"
-$ if lpp .ne. lopts then driver_override = "" !
-driver IS Motif
-$ if lpp .ne. lopts .and. lbare .ne. lopts then plusplus_override = "P" !
-temporary fix for PAWP.EXE !
-$ if lip .ne. lopts then transport_override = "TCPIP"
-$ if lde .ne. lopts then transport_override = "DECNET"
-$ if lwi .ne. lopts then transport_override = "WINTCP"
-$ if lquer .ne. lopts then help = "yes"
-$ if lhelp .ne. lopts then help = "yes"
-$ if lmult .ne. lopts then TCP_override = "_M"
-$ if lucx .ne. lopts then TCP_override = "_U"
-$ if lbare .ne. lopts then TCP_override = ""
-$ if lnode .ne. lopts then create_display = "yes"
-$ if lip .ne. lopts then create_display = "yes"
-$ if lde .ne. lopts then create_display = "yes"
-$ if lwi .ne. lopts then create_display = "yes"
-$ if lnode .ne. lopts
-$ then
-$ topts = f$extract(lnode,999,all_opts)
-$ node = f$element(1,"=",topts)
-$ node = f$element(0,"/",node)
-$ endif
-$ cernlib_version = "pro"
-$ if f$type(cern_level) .nes. "" then cernlib_version = cern_level
-$ if level_override .nes. "" then cernlib_version = level_override
-$!
-$ if help .eqs. "yes"
-$ then
-$ gosub help_text
-$ goto EXIT
-$ endif
-$!
-$ if llist .ne. lopts then gosub select_paw
-$!
-$get_connection_type:
-$ if transport_override .nes. "" then transport_type = transport_override
-$ if f$trnlnm("DECW$DISPLAY") .nes. "" then display_exists = "yes"
-$ if display_exists .eqs. "yes" .and. create_display .eqs. "no" then goto
-get_paw_type
-$!
-$!If the user has not specified /NODE or decnet,tcpip,wintcp transport, then
-use port settings
-$ if create_display .eqs. "yes" then goto set_display
-$ create_display = "yes"
-$ port = f$getdvi("TT","TT_ACCPORNAM")
-$ lport = f$length(port)
-$ if f$locate("/",port) .ne. lport
-$ then
-$!Terminal cannot be used to get remote machine on user's behalf
-$ goto get_paw_type
-$ endif
-$ if f$locate("::",port) .ne. lport
-$ then
-$!A DECnet connection
-$ node = f$extract(0,f$locate("::",port),port)
-$ transport_type = "DECNET"
-$ goto set_display
-$ endif
-$ If F$LOCATE("Port:",port).ne.lport ! UCX connection
-$ Then
-$!A UCX connection
-$ port=F$EXTRACT(0,F$LOCATE("Port:",port),port)
-$ If F$LOCATE("Host:",port).ne.lport
-$ Then
-$ port=F$EDIT(F$EXTRACT(F$LOCATE(":",port)+1,lport,port),"TRIM,\
-COMPRESS")
-$ node=port
-$ Endif
-$ transport_type = "TCPIP"
-$ goto set_display
-$ Endif
-$ If F$TRNLNM("TWG$ETC").nes."".and.F$LOCATE(".",port).nes.lport ! Wollongong
-$ Then
-$!A Wollongong connection
-$ tmp =F$EXTRACT(0,F$LOCATE(".",port)+1,port)
-$ tmp2=F$EXTRACT(F$LOCATE(".",port)+1,lport,port)
-$ tmp =tmp + F$EXTRACT(0,F$LOCATE(".",tmp2)+1,tmp2)
-$ tmp2=F$EXTRACT(F$LOCATE(".",tmp2)+1,F$LENGTH(tmp2),tmp2)
-$ tmp =tmp + F$EXTRACT(0,F$LOCATE(".",tmp2)+1,tmp2)
-$ tmp2=F$EXTRACT(F$LOCATE(".",tmp2)+1,F$LENGTH(tmp2),tmp2)
-$ tmp =tmp + F$EXTRACT(0,F$LOCATE(".",tmp2),tmp2)
-$ node=tmp
-$ transport_type = "WINTCP"
-$ goto set_display
-$ Endif
-$ if f$locate(".",port) .ne. lport
-$ then
-$ node = port
-$ transport_type = "TCPIP"
-$ goto set_display
-$ endif
-$!
-$set_display:
-$!In this section we set a display if required, prompting for missing
-information
-$ if create_display .eqs. "yes"
-$ then
-$ if transport_type .eqs. ""
-$ then
-$ write sys$output " "
-$ write sys$output "You can display PAW output locally (LOCAL), on a
-remote VMS workstation
-$ write sys$output "via DECNET (DECNET) or to a remote workstation \
-via TCP/IP."
-$ write sys$output " "
-$loop2:
-$ if f$mode() .eqs. "BATCH" then goto batch
-$ inquire/nopun transport_type "Select one of DECNET TCPIP WINTCP \
-LOCAL : "
-$ if f$locate(transport_type,"DECNET TCPIP WINTCP LOCAL") .eq.
-f$length("DECNET TCPIP WINTCP LOCAL") then goto loop2
-$ if transport_type .eqs. "LOCAL"
-$ then
-$ create_display = "no"
-$ goto get_paw_type
-$ endif
-$ endif
-$loop3:
-$ if node .eqs. ""
-$ then
-$ if f$mode() .eqs. "BATCH" then goto batch
-$ write sys$output " "
-$ if transport_type .eqs. "DECNET" then inquire/nopun node "Enter the \
-DECnet node name : "
-$ if transport_type .eqs. "TCPIP" then inquire/nopun node "Enter the \
-IP name or number of the remote node : "
-$ if transport_type .eqs. "WINTCP" then inquire/nopun node "Enter the \
-IP name or number of the remote node : "
-$ write sys$output " "
-$ goto loop3
-$ endif
-$ comm = "set display/create/transport=''transport_type'/node=''node'"
-$ write sys$output "Creating DISPLAY with : ""''comm'"""
-$ 'comm
-$ if .not. $severity then goto exit
-$ display_was_created = "yes"
-$ display_exists = "yes"
-$ endif
-$get_paw_type:
-$ pp = plusplus_override
-$ if driver_override .nes. "" then driver = driver_override
-$ tcp = TCP_override
-$ write sys$output "The ''cernlib_version' version of the PAW''pp' ''driver' \
-driver for PAW is selected."
-$ paw_choice = "PAW''pp'''driver'''tcp'"
-$got_paw_choice:
-$ pawfile = f$search(root_dir+cernlib_version+".*...]"+paw_choice+".EXE")
-$ if pawfile .eqs. ""
-$ then
-$ write sys$output "The PAW exe called ''paw_choice' is not available."
-$ paw_choice = ""
-$ paw_available = ""
-$ gosub select_paw
-$ goto got_paw_choice
-$ endif
-$ pawcomm = "$''pawfile'''all_opts'"
-$ set symbol/scope=global
-$ kxterm:=="CERN:[''cernlib_version'.exe]kxterm"
-$ write sys$output "Executing ''pawfile'"
-$ deassign sys$input
-$ pawcomm 'paw_options'
-$EXIT:
-$ if display_was_created .eqs. "yes" then set display/delete/node='node'
-$ EXIT
-$HELP_TEXT:
-$ type sys$input
-$ DECK
-
- The PAW command is invoked as follows:
-
- $ PAW[++] [/option...]
-
- where "++" invokes the PAW version with the Motif user interface.
- The allowed qualifiers are as follows:
-
- /OLD Selects an executable from the OLD CERN Library
- /PRO Selects an executable from the PRO CERN Library
- /NEW Selects an executable from the NEW CERN Library
-
- /X11 Selects the X11 driver for X Window displays
- /DGKS Selects the DEC GKS driver
- /GKS Selects the GTS-GRAL GKS driver
-
- /MULTINET Selects an executable linked with Multinet TCP/IP
- /UCX Selects an executable linked with DEC TCP/IP (UCX)
- /NOTCPIP Selects an executable without IP (no NETWORK commands)
-
- /TRANSPORT= These qualifiers are used to set the display to a
- /NODE= remote DECNET or IP connected workstation.
-
- /LIST Lists the available PAW EXE files on the system
- /HELP Displays this help
-
- There are some defaults that have already been set for you. They are:
-
-$ EOD
-$ if level_override .nes. "" then -
- write sys$output " The ''level_override' versions of PAW"
-$ if plusplus_override .eqs. "PP" then -
- write sys$output " the PAW++ Motif user interface"
-$ if driver_override .nes. "" then -
- write sys$output " The driver for ''driver_override'"
-$ if TCP_override .eqs. "_M" then -
- write sys$output " Linked with Multinet"
-$ if TCP_override .eqs. "_U" then -
- write sys$output " Linked with UCX"
-$ if TCP_override .eqs. "" then -
- write sys$output " Linked without a TCP/IP package"
-$ if transport_override .nes. "" then -
- write sys$output " Displays to be created over ''transport_override'"
-$ write sys$output " "
-$ return
-$GET_PAW_LIST:
-$ if paw_available .nes. "" then goto end_get_paw_list
-$ write sys$output " "
-$ write sys$output "Listing available versions of PAW in ''cernlib_version' \
-..."
-$ write sys$output " "
-$loop1:
-$ pawfile = f$search(root_dir+cernlib_version+".*...]PAW*.exe")
-$ if pawfile .eqs. "" then goto end_get_paw_list
-$ if f$locate("PAWSERV",pawfile) .ne. f$length(pawfile) then goto loop1
-$ is = f$locate("]PAW",pawfile) + 1
-$ pawfile = f$extract(is,999,pawfile)
-$ pawfile = f$extract(0,f$locate(".EXE",pawfile),pawfile)
-$ paw_type = "Unknown"
-$ if pawfile .eqs. "PAWPP" then paw_type = "PAW++ with no TCP/IP"
-$ if pawfile .eqs. "PAWPP_M" then paw_type = "PAW++ linked with Multinet"
-$ if pawfile .eqs. "PAWPP_U" then paw_type = "PAW++ linked with UCX"
-$ if pawfile .eqs. "PAWPP_W" then paw_type = "PAW++ linked with Wollongong"
-$ if pawfile .eqs. "PAWX11" then paw_type = "PAW for X11 with no TCP/IP"
-$ if pawfile .eqs. "PAWX11_M" then paw_type = "PAW for X11 linked with \
-Multinet"
-$ if pawfile .eqs. "PAWX11_U" then paw_type = "PAW for X11 linked with UCX"
-$ if pawfile .eqs. "PAWX11_W" then paw_type = "PAW for X11 linked with \
-Wollongong"
-$ if pawfile .eqs. "PAWDGKS" then paw_type = "PAW with DEC GKS and no TCP/IP"
-$ if pawfile .eqs. "PAWDGKS_M" then paw_type = "PAW with DEC GKS and linked \
-with Multinet"
-$ if pawfile .eqs. "PAWDGKS_U" then paw_type = "PAW with DEC GKS and linked \
-with UCX"
-$ if pawfile .eqs. "PAWDGKS_W" then paw_type = "PAW with DEC GKS and linked \
-with Wollongong"
-$ write sys$output "*** File ''pawfile' which is ''paw_type'"
-$ paw_available = paw_available + " " + pawfile
-$ goto loop1
-$end_get_paw_list:
-$ return
-$SELECT_PAW:
-$start_select_paw:
-$ gosub get_paw_list
-$ write sys$output " "
-$ if f$mode() .eqs. "BATCH" then goto batch
-$ inquire/nopun paw_choice "Select the PAW version you require from the \
-above list (or QUIT) : "
-$ if f$extract(0,1,paw_choice) .eqs. "Q" then goto EXIT
-$ if f$locate(paw_choice,paw_available) .eq. f$length(paw_available)
-$ then
-$ write sys$output "''paw_choice' is not in the above list !"
-$ goto start_select_paw
-$ endif
-$end_select_paw:
-$ driver_override = ""
-$ tcp_override = ""
-$ plusplus_override = ""
-$ lpawc = f$length(paw_choice)
-$ if f$locate("X11",paw_choice) .ne. lpawc then driver_override = "X11"
-$ if f$locate("GKS",paw_choice) .ne. lpawc then driver_override = "GKS"
-$ if f$locate("DGKS",paw_choice) .ne. lpawc then driver_override = "DGKS"
-$ if f$locate("_U",paw_choice) .ne. lpawc then tcp_override = "_U"
-$ if f$locate("_M",paw_choice) .ne. lpawc then tcp_override = "_M"
-$ if f$locate("_W",paw_choice) .ne. lpawc then tcp_override = "_W"
-$ if f$locate("_",paw_choice) .eq. lpawc then tcp_override = ""
-$ if f$locate("PP",paw_choice) .ne. lpawc then plusplus_override = "PP"
-$ if f$locate("PP",paw_choice) .ne. lpawc then driver_override = ""
-$ if paw_choice .eqs. "PAWP" ! temporary fix for bad naming convention
-$ then
-$ plusplus_override = "P"
-$ driver_override = ""
-$ tcp_override = ""
-$ endif
-$ return
-$
-$BATCH:
-$ copy sys$input sys$output
- PAW requires additional information on the command line before it can be
- run in batch. For example, you may need to specify the remote display
- device with /NODE and /TRANSPORT (or use SET DISPLAY/CREATE prior to calling
- PAW in the batch job).
-$ exit
-+PATCH,MANPAGES.
-+DECK,UNIX,IF=UNIX.
-*CMZ : 2.07/00 11/04/95 13.45.37 by O.Couet
-*-- Author : O.Couet 11/04/95
-.TH PAW 1 "Physics Analysis Workstation"
-.SH NAME
-paw \- invoke the "Physics Analysis Workstation" package
-.SH SYNOPSIS
-paw [-b \fImacro_name\fR] [-w \fIworkstation_type\fR] [-n]
-
-paw++ [-b \fImacro_name\fR] [-n]
-
-.SH DESCRIPTION
-
-PAW
-is an interactive utility for visualizing experimental data on a
-computer graphics display. It may be run in batch mode if desired
-for very large and time consuming data analyses; typically, however,
-the user will decide on an analysis procedure interactively before
-running a batch job.
-
-PAW
-combines a handful of CERN High Energy Physics Library systems
-that may also be used individually in software that
-processes and displays data. The purpose of PAW is
-to provide many common analysis and display
-procedures that would be duplicated needlessly
-by individual programmers, to supply a flexible way to invoke these
-common procedures, and yet also to allow user customization where
-necessary.
-
-PAW++ is a Motif based version of PAW.
-
-.SS OPTIONS
-
-When
-.B paw
-starts, the macro
-.B
-pawlogon.kumac
-in the current directory is executed. If this macro doesn't exist
-the system tries to execute the macro
-.B .pawlogon.kumac
-in the home directory.
-.TP 8
-.RI \-n
-The macro \fIpawlogon\fR is not executed.
-.TP 8
-.RI \-b \ macro_name
-The macro specified is executed in batch mode and
-.B paw
-exits when the macro ends.
-.TP 8
-.RI \-w \ worstation_type
-PAW starts immediatly without prompting for the workstation type.
-If worstation_type = 0, paw starts without graphics.
-
-When the X11 version of paw is used, a list of 10 valid
-workstations type is provided in the file
-.B higz_windows.dat.
-By default this file is in the current directory. If it is not,
-the one in the home directory is used. If it is not in the home
-directory, one is automatically created in the current directory.
-Each line in this file describes the position and the size of the
-window. To access one of the described windows it is enough to
-give the line number in reply to the prompt "Workstation type"
-
-.SH ENVIRONMENT VARIABLES
-.TP 20
-HIGZPRINTER
-Specifies the command line executed when the command PICTURE/PRINT
-is invoked.
-.TP 20
-$ENV()
-Any environment variable can be accessed in paw with the function
-.B $ENV().
-
-.SH SEE ALSO
-
-The PAW reference manual, the online help (PAW command HELP), the
-WWW pages: http://asdwww.cern.ch/pl/paw/index.html
-
-.SH COPYRIGHT
-(C) Copyright CERN, Geneva 1995.
-
-
-+PATCH,PAWCDES.
-+KEEP,FPADR.
-*CMZ : 2.07/08 16/08/95 15.34.10 by O.Couet
-*-- Author : O.Couet 16/08/95
-* To store the adresses of FPHSTART and FPVSTART
- COMMON /FPADR/ JMFPH, JMFPV
-+KEEP,PCHTAG.
-*CMZ : 2.07/02 29/05/95 13.23.39 by O.Couet
-*-- Author : O.Couet 26/04/95
- PARAMETER (NTAG=100,NCHTAG=32,NCHBIG=512)
- CHARACTER*(NCHTAG) CHTAG
- CHARACTER*(NCHBIG) CHBIG
- COMMON /PCHTAG/ CHTAG(NTAG)
- EQUIVALENCE (CHTAG(1),CHBIG)
-+KEEP,FPCOMS.
-*CMZ : 2.07/00 24/04/95 17.58.46 by O.Couet
-*-- Author : Gregory Kozlovsky 09/04/95
-*
-* tranfer data from pafith and pafitv to the fit panel
-* and store data needed to draw graphics in HFGRUPDATE and VFGRUPDATE
-* CHFOPTN - fit options, CHPOPTN - plot options
-* HFXMIN,HFXMAX - the scale in x which does not change
-*
- CHARACTER*32 CHFOPTN,CHPOPTN
- CHARACTER*80 XVECNAM,YVECNAM,EYVECNAM,
- + VPARNAM,VLOWNAM,VUPPNAM,VSTEPNAM,VERRORNUM
- COMMON/FPCOM/ JAD,FPXMIN,FPXMAX,FPYMIN,FPYMAX
- COMMON/FPCOMC/ CHFOPTN,CHPOPTN,XVECNAM,YVECNAM,EYVECNAM,
- + VPARNAM,VLOWNAM,VUPPNAM,VSTEPNAM,VERRORNUM
-+KEEP,PCHIST.
-*CMZ : 2.04/15 13/03/94 13.15.29 by Fons Rademakers
-*-- Author : Fons Rademakers 13/03/94
- CHARACTER*64 HPATH
- COMMON /PCHIST/ HPATH
-*
-+KEEP,PCCMD.
-*CMZ : 2.04/13 18/02/94 17.38.08 by Fons Rademakers
-*-- Author : Fons Rademakers 18/02/94
- LOGICAL NTCMD
- COMMON /PCCMD/ NTCMD
-*
-+KEEP,PAWFIL5,IF=MSDOS.
-*CMZ : 2.04/12 15/02/94 08.50.12 by Rene Brun
-*-- Author : Rene Brun 15/02/94
- CHARACTER*255 PAWSYS,PAWLOG
- DATA PAWSYS/'\\cern\\pro\\bin\\pawsys.kumac'/
- DATA PAWLOG/'pawlogon.kum'/
-*
-+KEEP,PAWFIL6,IF=WINNT.
-*CMZ : 2.04/12 15/02/94 08.50.12 by Rene Brun
-*-- Author : Rene Brun 15/02/94
- CHARACTER*255 PAWSYS,PAWLOG
- DATA PAWSYS/'\\cern\\pro\\bin\\pawsys.kumac'/
- DATA PAWLOG/'pawlogon.kumac'/
-+KEEP,PALOC.
-*CMZ : 2.04/12 01/02/94 14.02.30 by O.Couet
-*-- Author : O.Couet 01/02/94
- COMMON /PALOC/ JADLOC
-+KEEP,PCMODE.
-*CMZ : 2.04/05 26/11/93 11.40.00 by Rene Brun
-*-- Author : Rene Brun 18/11/93
-* IPIAF =1 for the PIAF server
-* IPAWPP=1 if PAW++
- COMMON/PCMODE/IPIAF,IPAWPP,NOLOG,BATCH
- LOGICAL NOLOG,BATCH
-*
-+KEEP,PCOLV.
-*CMZ : 2.03/14 27/09/93 14.12.45 by O.Couet
-*-- Author :
- COMMON /PCOLV/ NCOLOR,FMIN,FMAX,IC1,IC2,IC3
-*
-+KEEP,PCWK.
-*CMZ : 2.03/13 27/09/93 08.58.42 by Rene Brun
-*-- Author : Rene Brun 27/09/93
- COMMON/PCWK/IWK
-*
-+KEEP,PCHOST.
-*CMZ : 2.04/12 11/02/94 17.41.30 by Fons Rademakers
-*-- Author : Fons Rademakers 10/08/93
- COMMON/CIPIAF/ISPROTO
- COMMON/CCPIAF/CHHOST, CHUSER, CHVERS, CONDIR
- CHARACTER*16 CHHOST, CHUSER, CHVERS
- CHARACTER*32 CONDIR
-*
-+KEEP,PACOMIS.
-*CMZ : 2.04/11 11/01/94 09.14.16 by Rene Brun
-*-- Author : Rene Brun 06/05/93
- PARAMETER (NCOMIS=30000)
- COMMON/COMIS/CS(NCOMIS)
-+KEEP,PCNTWK.
-*CMZ : 2.03/07 24/08/93 17.20.45 by Fons Rademakers
-*-- Author : Fons Rademakers 03/05/93
- CHARACTER*16 CRHOST
- COMMON /PCNTWK/ NPASS, IPASS, IMINEV, IMAXEV, MISBYT, NCHAIN,
- + NTCONT, IEDONE
- COMMON /PCNTW1/ CRHOST
-*
-+KEEP,PCPIAF.
-*CMZ : 2.04/12 11/02/94 18.09.44 by Fons Rademakers
-*-- Author : Alfred Nathaniel 01/05/93
-*
-*-- Update for every major incompatible change in Piaf client-server protocol.
-*-- A change in VERSPF requires the building of a Piaf server with a new
-*-- file extension.
-*
- CHARACTER VERSPF*8
- PARAMETER (VERSPF = '931013')
-*
-*-- Update for every minor incompatible change in Piaf client-server protocol.
-*
- INTEGER IPROTO
- PARAMETER (IPROTO = 1)
-+KEEP,PAWCHN.
-*CMZ : 2.02/01 10/05/93 00.52.38 by Fons Rademakers
-*-- Author : Fons Rademakers 13/04/93
- LOGICAL CHAIN
- CHARACTER*128 CFILE
- COMMON /PAWCHN/ CHAIN, NCHEVT, ICHEVT
- COMMON /PAWCHC/ CFILE
-*
- CHARACTER*80 CURCHN
- COMMON /PAWCH2/ CURCHN
-*
- LOGICAL CHNXMT
- COMMON /PAWCH3/ CHNXMT
-*
-+KEEP,PAWBIG.
-*CMZ : 2.02/02 25/05/93 19.17.20 by Rene Brun
-*-- Author :
- PARAMETER (NWPAW=2000000)
-*
-+KEEP,PAWSMALL.
-*CMZ : 2.02/00 13/04/93 18.00.47 by Rene Brun
-*-- Author :
- PARAMETER (NWPAW=500000)
-*
-+KEEP,PAWSIZ.
-*CMZ : 2.02/00 13/04/93 18.00.47 by Rene Brun
-*-- Author :
-+SEQ,PAWBIG,IF=UNIX,APOLLO,VAX.
-+SEQ,PAWBIG,IF=IBM,IF=NEWLIB.
-+SEQ,PAWSMALL,IF=IBM,IF=-NEWLIB.
-
-+KEEP,PAWCOM
-*CMZ : 2.03/07 03/09/93 14.10.38 by Fons Rademakers
-*-- Author :
- COMMON/PAWCOM/ID,NUM,JOFSET,IDOLD,KHRIN
- COMMON/PAWCID/CHID,CHCASE
- CHARACTER*128 CHID
- CHARACTER*4 CHCASE
-*
-+KEEP,PAWFIL1. IF=IBM,IF=-IBMMVS.
-*CMZ : 2.02/00 13/04/93 18.00.48 by Rene Brun
-*-- Author :
- CHARACTER*255 PAWSYS,PAWLOG
- DATA PAWSYS/'/PAWSYS KUMAC *'/
- DATA PAWLOG/'/PAWLOGON KUMAC *'/
-*
-* THE FOLLOWING IS NEEDED WHILE KUIP DOES NOT UNDERSTAND VS-FORTRAN
-* FILES
-*
- CHARACTER*255 PAWSY1,PAWLO1,PAWSY2,PAWLO2
- DATA PAWSY1/'/PAWSYS KUMAC *'/
- DATA PAWLO1/'/PAWLOGON KUMAC *'/
- DATA PAWSY2/'PAWSYS.KUMAC.*'/
- DATA PAWLO2/'PAWLOGON.KUMAC.*'/
-*
-+KEEP,PAWFIL2. IF=IBMMVS.
-*CMZ : 2.02/00 13/04/93 18.00.48 by Rene Brun
-*-- Author :
- CHARACTER*255 PAWSYS,PAWLOG
- DATA PAWSYS/'.R01UTL.PAWSYS.KUMAC'/
- DATA PAWLOG/'PAWLOGON'/
-*
-+KEEP,PAWFIL3. IF=VAX.
-*CMZ : 2.02/00 13/04/93 18.00.48 by Rene Brun
-*-- Author :
- CHARACTER*255 PAWSYS,PAWLOG
- DATA PAWSYS/'CERN_ROOT:[EXE]PAWSYS.KUMAC'/
- DATA PAWLOG/'pawlogon.kumac'/
-*
-+KEEP,PAWFIL4. IF=UNIX,CRAY,APOLLO.
-*CMZ : 2.02/00 13/04/93 18.00.48 by Rene Brun
-*-- Author :
- CHARACTER*255 PAWSYS,PAWLOG
- DATA PAWSYS/'/cern/pro/bin/pawsys.kumac'/
- DATA PAWLOG/'pawlogon.kumac'/
-*
-+KEEP,PAWFIL.
-*CMZ : 2.04/12 15/02/94 08.50.12 by Rene Brun
-*-- Author :
-+SEQ,PAWFIL1,IF=IBM,IF=-IBMMVS.
-+SEQ,PAWFIL2,IF=IBMMVS.
-+SEQ,PAWFIL3,IF=VAX.
-+SEQ,PAWFIL4,IF=UNIX,CRAY,APOLLO,IF=-MSDOS,IF=-WINNT.
-+SEQ,PAWFIL5,IF=MSDOS.
-+SEQ,PAWFIL6,IF=WINNT.
-
-+KEEP,PCRANG
-*CMZ : 2.07/01 09/05/95 11.07.00 by O.Couet
-*-- Author :
-* IC[X,Y][1,2] is the range limited by 1 and the number of bins
-* IB[X,Y][1,2] is the non limited range
- COMMON/PCRANG/ICRANG,ICX1,ICX2,ICY1,ICY2,IBX1,IBX2,IBY1,IBY2
-*
-+KEEP,PAWBGN
-*CMZ : 2.02/00 13/04/93 18.00.48 by Rene Brun
-*-- Author :
- COMMON/PAWBGN/ICOMIS,ISIGMA
-*
-+KEEP,PAWLUN
-*CMZ : 2.02/00 13/04/93 19.47.18 by Fons Rademakers
-*-- Author :
- COMMON/PAWLUN/LUNIT(128), LUNCHN
-*
-+KEEP,PNTOLD.
-*CMZ : 2.02/00 13/04/93 18.00.48 by Rene Brun
-*-- Author :
- LOGICAL NTOLD
- COMMON /PNTOLD/ NTOLD
-*
-+KEEP,PAWNPU
-*CMZ : 2.02/00 13/04/93 18.00.48 by Rene Brun
-*-- Author :
- COMMON/PAWNPU/NPFUNC,NPFUNX,NPFUNY,NPFUNZ,ANGLE1,ANGLE2
- +, RANGX1,RANGX2,RANGY1,RANGY2,RANGZ1,RANGZ2
- +, VALHQF
-*
-+KEEP,PAWCFU.
-*CMZ : 2.07/00 04/05/95 17.01.51 by Julian Bunn
-*-- Author :
- PARAMETER (MAXCLL=512,MAXLAB=1000,MAXFCU=2000,MAXSTK=13)
- PARAMETER (MXVAR=100, MAXFCC=44)
-*
- INTEGER JADF
- COMMON/PAWCF2/JADF, IDCHAR(3), NVART, NVART2, NVART3, IDFNEW,
- $ LABELX, LABELY, LABELZ, ICTYPE,
- $ INDX(MAXCLL), INDX2(MAXCLL), ITYPE(MAXCLL), ISIZE(MAXCLL),
- $ IELEM(MAXCLL), IOFFST(MAXCLL), IOFFST2(MAXCLL)
-*
- CHARACTER*32
- $ CSTACK(100) , CHLABX(MAXLAB), CHLABY(MAXLAB),
- $ CHLABZ(MAXLAB), CHFCU , VAR(MAXCLL),
- $ HFCU(100)
- COMMON/PAWCF3/VAR,CSTACK,CHLABX,CHLABY,CHLABZ,CHFCU,HFCU
-*
-* we allow up to 4 array expressions in a selection (bbbwaaaaa..)
- REAL RFCU(MAXFCU*4)
- REAL*8 DFCU
- INTEGER IFCU
- LOGICAL LFCU
- COMMON/PAWCF4/DFCU,IFCU,LFCU,RFCU
-*
- INTEGER CFUINFO(0:MXVAR,6),CFUPOS
-* we allow MAXSTK arrays of maximum length MAXFCU
- REAL RSTACK(0:MAXSTK,0:MAXFCU)
-* and MAXSTK character arrays of maximum length MAXFCC
- CHARACTER*32 CHPILE(0:MAXSTK,0:MAXFCC)
- LOGICAL NOSEL
- COMMON/PAWCF5/RSTACK,CFUINFO,CFUPOS,NOSEL
- COMMON/PAWCF6/CHPILE
-*
-+KEEP,PAWIDN
-*CMZ : 2.03/18 14/10/93 19.51.31 by Fons Rademakers
-*-- Author :
- COMMON/PAWIDN/IDNEVT,VIDN1,VIDN2,VIDN3,VIDN(10),X(512)
- COMMON/PAWOFF/NEVTID,IVIOFF(13),IWIOFF,IEIOFF
- COMMON/PCHIDN/CHNAMS(512)
- CHARACTER*8 CHNAMS
-*
-+KEEP,PAWNTU
-*CMZ : 2.03/18 14/10/93 19.51.04 by Fons Rademakers
-*-- Author :
- INTEGER TTVARX,TTVARY,TTVARZ,TTVARM(10)
- COMMON/PAWNTU/NTVARX,NTVARY,NTVARZ
- $ ,ICODES,XLOWNT,XUPNT,YLOWNT,YUPNT,ZLOWNT,ZUPNT
- $ ,NTVARM,MLOWNT,MUPNT,TTVARX,TTVARY,TTVARZ,TTVARM
- COMMON/PAWNT1/KTYPE,KCUTS
- COMMON/PAWNT2/CHVARX,CHVARY,CHVARZ,CHNTUP,CHVARM
- REAL MLOWNT(10),MUPNT(10)
- INTEGER NTVARM(10)
- CHARACTER*128 CHVARX,CHVARY,CHVARZ,CHVARM(10)
- CHARACTER*128 CHNTUP
-+KEEP,PAWCFW
-*CMZ : 2.02/00 13/04/93 18.00.48 by Rene Brun
-*-- Author :
- PARAMETER (ICDIM=200)
- COMMON/PAWCFW/ICFREE,ICODE(ICDIM)
- DIMENSION XCODE(ICDIM)
- EQUIVALENCE (ICODE(1),XCODE(1))
-*
-+KEEP,PAWVET
-*CMZ : 2.02/00 13/04/93 18.00.48 by Rene Brun
-*-- Author :
- PARAMETER (ICMAXK=30)
- COMMON/PAWVET/ICMASK(ICMAXK)
-*
-+KEEP,PCARGS
-*CMZ : 2.04/05 26/11/93 11.40.00 by Rene Brun
-*-- Author :
- CHARACTER*80 CHARGS
- COMMON/PCARGS/CHARGS
-*
-+KEEP,PCSCAN.
-*CMZ : 2.04/14 02/03/94 18.49.29 by Fons Rademakers
-*-- Author :
- COMMON/PCSCAN/IVARS(MXVAR),IVART(MXVAR),INTFLG
-*
-*-- Re-use the RSTACK and CHPILE arrays from common's PAWFC5 and PAWFC6
-*-- make sure that SSTACk and SCPILE are smaller
-*
- PARAMETER (MXVARR=137,MXCARR=5)
- REAL SSTACK(0:MXVAR,0:MXVARR)
- CHARACTER*32 SCPILE(0:MXVAR,0:MXCARR)
- EQUIVALENCE (SSTACK, RSTACK)
- EQUIVALENCE (SCPILE, CHPILE)
-+KEEP,PCMASK
-*CMZ : 2.02/00 13/04/93 18.00.48 by Rene Brun
-*-- Author :
- PARAMETER (MASDIM=9)
- COMMON/PCMASK/LMASK,LMBUF,LM,IMSK(MASDIM),IMRD,MBIT(MASDIM),MBITD,
- + NUMD,NBUFFD,NBUFFR,NBUFF(MASDIM),IDEC,LREC,NBMASK
- COMMON/PCMAS2/CHMASK
- CHARACTER*32 CHMASK(20)
-*
-+KEEP,PCCSEL
-*CMZ : 2.03/04 21/07/93 18.40.35 by Fons Rademakers
-*-- Author :
- COMMON/PCCSEL/IOPTCS(5),CSIZE
- EQUIVALENCE (IOPTCS(1),IOPTCR),(IOPTCS(2),IOPTCB)
- EQUIVALENCE (IOPTCS(3),IOPTCM),(IOPTCS(4),IOPTCC)
- EQUIVALENCE (IOPTCS(5),IOPTCN)
- COMMON/PCCSE2/CHCSEL,CSOPT
- CHARACTER*80 CHCSEL
- CHARACTER*8 CSOPT
-*
-+KEEP,PCPATL
-*CMZ : 2.02/00 13/04/93 18.00.48 by Rene Brun
-*-- Author :
- COMMON/PCPATL/CHPATL
- CHARACTER*32 CHPATL
-*
-+KEEP,PCCHAR
-*CMZ : 2.07/17 17/11/95 12.01.12 by O.Couet
-*-- Author :
- PARAMETER (NCHAR=128)
- CHARACTER*(NCHAR) CHTITL,CHUTIT,CHFILE,CHTEMP
- COMMON/PCCHAR/CHTITL,CHUTIT,CHFILE,CHTEMP
-+KEEP,PACHAR.
-*CMZ : 2.02/00 13/04/93 18.00.48 by Rene Brun
-*-- Author :
- COMMON/PACHAR/JZERO,JNEUF,JAMAX,JZMAX,JAMIN,JZMIN,JDOLL,JSCOR
-*
-+KEEP,PCFUNC
-*CMZ : 2.03/12 16/09/93 19.14.32 by Rene Brun
-*-- Author :
- COMMON/PCFUNC/CHFUNC
- CHARACTER*128 CHFUNC
-+KEEP,PCFITF
-*CMZ : 2.02/00 13/04/93 18.00.48 by Rene Brun
-*-- Author :
- PARAMETER(MAXOP=10)
- COMMON/PCFITF/NOPER,LOPER(MAXOP),IFTYPE(MAXOP),NPF(MAXOP)
-*
-+KEEP,PCSLAS
-*CMZ : 2.02/00 13/04/93 18.00.48 by Rene Brun
-*-- Author :
- COMMON/PCSLAS/BSLASH,BSDUM
- CHARACTER*1 BSLASH
- CHARACTER*3 BSDUM
-*
-+KEEP,PCBUFF.
-*CMZ : 2.02/00 13/04/93 18.00.48 by Rene Brun
-*-- Author :
- COMMON/PCBUFF/PAWBUF(2004)
-*
-+KEEP,PCADDR.
-*CMZ : 2.04/15 13/03/94 12.11.10 by Fons Rademakers
-*-- Author :
- COMMON /PCADDR/ JMPANT, JMLAB, JMROW, JMCHAIN, JNTWINI, JNTWCHK,
- + JMHIST
-*
-+KEEP,PCMATW.
-*CMZ : 2.02/00 13/04/93 18.00.48 by Rene Brun
-*-- Author :
- CHARACTER*32 OUTSTR(512)
- COMMON /PCMATW/ OUTSTR
-*
-+KEEP,PAWCUT
-*CMZ : 2.03/15 30/09/93 12.14.09 by Pierre AUBERT
-*-- Author :
- COMMON/PAWCUT/ICUTYP(100),XPCUT(20,100),YPCUT(20,100),
- + IVCUTX(100),CUTXL(100),CUTXU(100),
- + IVCUTY(100),CUTYL(100),CUTYU(100)
- COMMON/PAWCUE/CHCUTS,CHCUTX,CHCUTY
- CHARACTER*128 CHCUTS(100),CHCUTX(100),CHCUTY(100)
-*
-
-+KEEP,QUEST
-*CMZ : 2.02/00 13/04/93 18.00.48 by Rene Brun
-*-- Author :
- COMMON /QUEST/IQUEST(100)
- DIMENSION RQUEST(100)
- EQUIVALENCE(IQUEST(1),RQUEST(1))
-*
-+KEEP,PCLIN1.
-*CMZ : 2.02/00 13/04/93 18.00.48 by Rene Brun
-*-- Author :
- PARAMETER (KNTMAX=20,KNTMA1=KNTMAX+1,KNTMA2=KNTMAX*KNTMAX)
- COMMON/PCLINT/AR(KNTMA2),DEIGVA(KNTMAX),DWORK(KNTMAX)
- + ,SS(KNTMAX),S(KNTMAX),XX(KNTMAX),XA(KNTMAX),AM(KNTMA2)
- + ,EIGVEC(KNTMA2),EIGVAL(KNTMA1),XSI(KNTMAX),R(KNTMAX)
-+KEEP,PCLIN2.
-*CMZ : 2.02/00 13/04/93 18.00.48 by Rene Brun
-*-- Author :
- DOUBLE PRECISION AR,DEIGVA,DWORK,SS
-+KEEP,PCLINT.
-*CMZ : 2.02/00 13/04/93 18.00.49 by Rene Brun
-*-- Author :
-+SEQ,PCLIN1.
-+SEQ,PCLIN2,IF=DOUBLE.
-*
-+KEEP,GPLOTST.
-*CMZ : 2.02/00 13/04/93 18.00.49 by Rene Brun
-*-- Author :
- COMMON /GPLOTST/ RMAXP(4),RMINP(4),ISTCNT,NEW
- LOGICAL NEW
-*
-+KEEP,HPLCSC.
-*CMZ : 2.03/14 28/09/93 15.40.57 by O.Couet
-*-- Author :
- PARAMETER (IPMSIZ=1000)
- COMMON/HPLCSC/U(IPMSIZ),V(IPMSIZ),W(IPMSIZ),T(IPMSIZ),
- + IDEVT(IPMSIZ)
-*
-+KEEP,RZCXIO
-*CMZ : 2.02/00 13/04/93 18.00.49 by Rene Brun
-*-- Author :
- COMMON/RZCOUNT/RZXIN,RZXOUT
-*
-+PATCH,PAMEND.
-*
diff --git a/src/car/zebra.car b/src/car/zebra.car
deleted file mode 100644
index b27adf5..0000000
--- a/src/car/zebra.car
+++ /dev/null
@@ -1,1154 +0,0 @@
-ZEBRA 3.77 960130 21.40 CERN PROGRAM LIBRARY Q100
- Data structure management package
-
-+PATCH, *ZEBRA. Interface Zebra pilot
-+USE, *ZALT, IF=ALLIANT.
-+USE, *ZAPO, IF=APOLLO.
-+USE, *ZCRU, IF=CRAY.
-+USE, *ZCVX, IF=CONVEX, IF=-DOUBLE.
-+USE, *ZCVY, IF=CONVEX, IF=DOUBLE.
-+USE, *ZVMI, IF=DECS.
-+USE, *ZHPX, IF=HPUX.
-+USE, *ZIBX, IF=IBMAIX.
-+USE, *ZIRT, IF=IBMRT.
-+USE, *ZIRTD, IF=IBMRTD.
-+USE, *ZIBM, IF=IBM, IBMMVS, IBMVM.
-+USE, *ZIBMD, IF=IBMD, IBMMVSD, IBMVMD.
-+USE, QIBM_VM, T=INH, IF=IBMMVS.
-+USE, IOPACK, T=INH, IF=IBMMVS, IF=NEWLIB.
-+USE, *ZLNX, IF=LINUX.
-+USE, *ZMPW, IF=MACMPW.
-+USE, *ZDOS, IF=MSDOS.
-+USE, *ZDOS, QS_WNT, IF=WINNT.
-+USE, *ZNXT, IF=NEXT.
-+USE, *ZOS9, IF=OS9.
-+USE, *ZSGI, IF=SGI.
-+USE, *ZSUN, IF=SUN.
-+USE, *ZVAX, IF=VAX, VAXVMS, VAXULX.
-+USE, FZCONV, T=INH.
-+PATCH, *ZEBRAT, T=JOIN. Local Zebra test pilot
-+USE, *ZEBRAL, QCDETE.
-+PATCH, *ZEBRAL, T=JOIN. Local Zebra pilot
-+USE, *ZSUN.
-+PATCH, *ZALT. Pilot for ALLIANT
-+USE, QCDE, QMALT.
-+USE, QMUIX.
-+USE, QUTYALT.
-+USE, B32, A4.
-+USE, HEX.
-+USE, QIEEE. IEEE floating point
-+USE, QISASTD. ISA standard routines ISHFT IOR etc
-+USE, QMILSTD. MIL standard routines IBITS MVBITS ISHFTC
-+USE, QCFIO. C library I/O available
-+USE, QZENORM.
-+USE, Q$BITSEQ.
-+KEEP, Q_JBIT.
- JBIT (IZW,IZP) = IBITS (IZW,IZP-1,1)
-+KEEP, Q_JBYT.
- JBYT (IZW,IZP,NZB) = IBITS (IZW,IZP-1,NZB)
-+KEEP, Q_JBYTET.
- JBYTET (MZ,IZW,IZP,NZB) = IAND (MZ, IBITS(IZW,IZP-1,NZB))
-+KEEP, Q_JBYTOR.
- JBYTOR (MZ,IZW,IZP,NZB) = IOR (MZ, IBITS(IZW,IZP-1,NZB))
-+KEEP, Q_MBYTET.
- MBYTET (MZ,IZW,IZP,NZB) = IAND (IZW,
- + NOT(ishft (ISHFT(NOT(MZ),32-NZB),-33+IZP+NZB)) )
-+KEEP, Q_MBYTOR.
- MBYTOR (MZ,IZW,IZP,NZB) = IOR (IZW,
- + ishft (ISHFT(MZ,32-NZB),-33+IZP+NZB) )
-+KEEP, MZEUNIT, P=MQ, D=MZINCO.
- IQREAD = 2
- IQPRNT = 3
- IQPNCH = 4
-+KEEP, MZEUNIT2, P=MQ, D=MZINCO.
- IQTTIN = 5
- IQTYPE = 6
-+KEEP, MZEBCD1.
- CQALLC(48:64) = '#''!:"_]&@?[>< ^;%'
- CQALLC(61:61) = CHAR(92)
-+PATCH, *ZAPO. Pilot for APOLLO
-+USE, QCDE, QMAPO.
-+USE, QUTYAPO.
-+USE, B32, A4.
-+USE, HEX.
-+USE, QIEEE. IEEE floating point
-+USE, QCFIO. C library I/O available
-+USE, QZENORM.
-+KEEP, Q_SHIFTL.
- ISHFTL (IZW,NZB) = LSHFT (IZW, NZB)
-+KEEP, Q_SHIFTR.
- ISHFTR (IZW,NZB) = RSHFT (IZW, NZB)
-+KEEP, Q_AND.
- IAND (IZV,IZW) = AND (IZV, IZW)
-+KEEP, Q_OR.
- IOR (IZV,IZW) = OR (IZV, IZW)
-+KEEP, Q_XOR.
- IEOR (IZV,IZW) = XOR (IZV, IZW)
-+SELF. NOT is standard on APOLLO
-+KEEP, Q_JBIT.
- JBIT (IZW,IZP) = AND (RSHFT(IZW,IZP-1), 1)
-+KEEP, Q_JBYT.
- JBYT (IZW,IZP,NZB)= RSHFT (LSHFT(IZW,33-IZP-NZB), 32-NZB)
-+KEEP, Q_SBIT0.
- MSBIT0 (IZW,IZP) = AND (IZW, NOT(LSHFT(1,IZP-1)) )
-+KEEP, Q_SBIT1.
- MSBIT1 (IZW,IZP) = OR (IZW, LSHFT(1,IZP-1) )
-+KEEP, Q_SBIT.
- MSBIT (MZ,IZW,IZP) = OR (AND (IZW, NOT(LSHFT(1,IZP-1)) )
- + , LSHFT(AND(MZ,1),IZP-1) )
-+KEEP, Q_SBYT.
- MSBYT (MZ,IZW,IZP,NZB) = OR (
- + AND (IZW, NOT(LSHFT (RSHFT(NOT(INT4(0)),32-NZB), IZP-1)))
- + , RSHFT (LSHFT(MZ,32-NZB), 33-IZP-NZB) )
-+KEEP, Q_JBYTET.
- JBYTET (MZ,IZW,IZP,NZB) = AND (MZ,
- + RSHFT (LSHFT(IZW,33-IZP-NZB), 32-NZB) )
-+KEEP, Q_JBYTOR.
- JBYTOR (MZ,IZW,IZP,NZB) = OR (MZ,
- + RSHFT (LSHFT(IZW,33-IZP-NZB), 32-NZB) )
-+KEEP, Q_MBYTET.
- MBYTET (MZ,IZW,IZP,NZB) = AND (IZW, NOT(RSHFT (
- + LSHFT(NOT(MZ),32-NZB), 33-IZP-NZB)) )
-+KEEP, Q_MBYTOR.
- MBYTOR (MZ,IZW,IZP,NZB) = OR (IZW, RSHFT (
- + LSHFT(MZ,32-NZB), 33-IZP-NZB) )
-+KEEP, MZEUNIT, P=MQ, D=MZINCO.
- IQREAD = 5
- IQPRNT = 6
- IQPNCH = 3
-+KEEP, MZEUNIT2, P=MQ, D=MZINCO.
- IQTTIN = 5
- IQTYPE = 6
-+KEEP, MZLINK24.
- LOCAR = RSHFT (IADDR(LAREA(1)),2) - LQSTOR
- LOCR = RSHFT (IADDR(LREF(1)),2) - LQSTOR
- LOCRL = RSHFT (IADDR(LREFL(1)),2) - LQSTOR
-+KEEP, MZLINT14.
- LOCAR = RSHFT (IADDR(LAREA(1)),2) - LQSTOR
-+KEEP, MZLINT24.
- LOCR = RSHFT (IADDR(LREF(1)),2) - LQSTOR
- LOCRL = RSHFT (IADDR(LREFL(1)),2) - LQSTOR
-+KEEP, MZWORK21.
- NEWL = RSHFT (IADDR(DFIRST(1)),2) - (LQSTOR+1)
- NEWD = RSHFT (IADDR(DLAST(1)),2) - LQSTOR
-+KEEP, MZLIFTLOCF.
- KADR = RSHFT (IADDR(LSUPP(1)),2) - LQSTOR
-+PATCH, *ZCRU. Pilot for CRAY system UNICOS
-+USE, *ZCRY, QMCRU.
-+USE, QCFIO. C library I/O available
-+PATCH, *ZCRY, T=JOIN. Pilot for CRAY system COS
-+USE, QCDE, QMCRY.
-+USE, QUTYCRY.
-+USE, B64, B36M, B48M, B60M.
-+USE, A8, A5M, A6M, A8M.
-+USE, HEX.
-+USE, QZENORM.
-+KEEP, ZMACHFIX.
- PARAMETER (IQBITW=64, IQBITC=8, IQCHAW=8)
-+KEEP, Q_LOCF.
- LOCF (IZLOC) = LOC (IZLOC)
-+KEEP, Q_SHIFTL.
- ISHFTL (IZW,NZB) = SHIFTL (IZW, NZB)
-+KEEP, Q_SHIFTR.
- ISHFTR (IZW,NZB) = SHIFTR (IZW, NZB)
-+KEEP, Q_JBIT.
- JBIT (IZW,IZP) = SHIFTR(IZW,IZP-1) .AND. MASK(127)
-+KEEP, Q_JBYT.
- JBYT (IZW,IZP,NZB) = SHIFTR(IZW,IZP-1) .AND. MASK(128-NZB)
-+KEEP, Q_SBIT0.
- MSBIT0 (IZW,IZP) = IZW .AND. SHIFT(MASK(65),IZP)
-+KEEP, Q_SBIT1.
- MSBIT1 (IZW,IZP) = IZW .OR. SHIFT(MASK(1), IZP)
-+KEEP, Q_SBIT.
- MSBIT (MZ,IZW,IZP) = (IZW .AND. SHIFT(MASK(65),IZP))
- + .OR. SHIFT(MZ.AND.MASK(127),IZP-1)
-+KEEP, Q_SBYT.
- MSBYT (MZ,IZW,IZP,NZB) = (IZW .AND. SHIFT(MASK(64-NZB),IZP-1))
- + .OR. SHIFT(MZ.AND.MASK(128-NZB),IZP-1)
-+KEEP, Q_JBYTET.
- JBYTET (MZ,IZW,IZP,NZB) = MZ .AND. SHIFTR(IZW,IZP-1)
- + .AND. MASK(128-NZB)
-+KEEP, Q_JBYTOR.
- JBYTOR (MZ,IZW,IZP,NZB) = MZ .OR. (SHIFTR(IZW,IZP-1)
- + .AND. MASK(128-NZB) )
-+KEEP, Q_MBYTET.
- MBYTET (MZ,IZW,IZP,NZB) = IZW .AND.
- + SHIFT (MZ.OR. MASK(64-NZB), IZP-1)
-+KEEP, Q_MBYTOR.
- MBYTOR (MZ,IZW,IZP,NZB) = IZW .OR.
- + SHIFT (MZ.AND.MASK(128-NZB),IZP-1)
-+KEEP, MZEMACH, P=MQ, D=MZINCO.
- IQNIL = 0777770516040020000000B
-+KEEP, MZEUNIT, P=MQ, D=MZINCO, IF=-QMCRU.
- IQREAD = 3L$IN
- IQPRNT = 4L$OUT
- IQPNCH = 6L$PUNCH
-+KEEP, ZPOSTMTR, P=QEND, D=ZPOSTM.
- CALL TRBK (IQLOG)
-+PATCH, *ZCVX. Pilot for Convex 64-bit mode native
-+USE, QCDE, QMCVX, QMCV64.
-+USE, QUTYCVX.
-+USE, B64, B36M, B48M, B60M.
-+USE, A8, A5M, A6M, A8M.
-+USE, HEX.
-+USE, QISASTD. ISA standard routines ISHFT IOR etc
-+USE, QCFIO, T=INH. C library I/O not available
-+USE, QZENORM.
-+KEEP, ZMACHFIX.
- PARAMETER (IQBITW=64, IQBITC=8, IQCHAW=8)
-+KEEP, Q_JBIT.
- JBIT (IZW,IZP) = IBITS (IZW,IZP-1,1)
-+KEEP, Q_JBYT.
- JBYT (IZW,IZP,NZB) = IBITS (IZW,IZP-1,NZB)
-+KEEP, Q_SBIT0.
- MSBIT0 (IZW,IZP) = IBCLR (IZW,IZP-1)
-+KEEP, Q_SBIT1.
- MSBIT1 (IZW,IZP) = IBSET (IZW,IZP-1)
-+KEEP, Q_JBYTET.
- JBYTET (MZ,IZW,IZP,NZB) = MZ .AND. IBITS(IZW,IZP-1,NZB)
-+KEEP, Q_JBYTOR.
- JBYTOR (MZ,IZW,IZP,NZB) = MZ .OR. IBITS(IZW,IZP-1,NZB)
-+KEEP, MZEUNIT2, P=MQ, D=MZINCO.
- IQTTIN = 5
- IQTYPE = 6
-+KEEP, ZPOSTMTR, P=QEND, D=ZPOSTM.
- CALL TRACEBACK
-+PATCH, *ZCVY, T=JOIN. Pilot for Convex 32-bit mode IEEE
-+USE, QCDE, QMCVX, QMCV32.
-+USE, QUTYCVY.
-+USE, B32.
-+USE, A4.
-+USE, HEX.
-+USE, QIEEE. IEEE floating point
-+USE, QMUIX.
-+USE, QISASTD. ISA standard routines ISHFT IOR etc
-+USE, QCFIO. C library I/O available
-+USE, QZENORM.
-+KEEP, Q_JBIT.
- JBIT (IZW,IZP) = IBITS (IZW,IZP-1,1)
-+KEEP, Q_JBYT.
- JBYT (IZW,IZP,NZB) = IBITS (IZW,IZP-1,NZB)
-+KEEP, Q_SBIT0.
- MSBIT0 (IZW,IZP) = IBCLR (IZW,IZP-1)
-+KEEP, Q_SBIT1.
- MSBIT1 (IZW,IZP) = IBSET (IZW,IZP-1)
-+KEEP, Q_JBYTET.
- JBYTET (MZ,IZW,IZP,NZB) = MZ .AND. IBITS(IZW,IZP-1,NZB)
-+KEEP, Q_JBYTOR.
- JBYTOR (MZ,IZW,IZP,NZB) = MZ .OR. IBITS(IZW,IZP-1,NZB)
-+KEEP, MZEUNIT2, P=MQ, D=MZINCO.
- IQTTIN = 5
- IQTYPE = 6
-+KEEP, ZPOSTMTR, P=QEND, D=ZPOSTM.
- CALL TRACEBACK
-+PATCH, *ZDOS. Pilot for MS DOS
-+USE, QF_DEC, IF=QS_WNT.
-+USE, QF_F2C, IF=-QS_WNT.
-+USE, QCDE, QMDOS.
-+USE, QUTYDOS.
-+USE, B32, A4.
-+USE, HEX.
-+USE, F77TRARG. careful about char. argument transmission
-+USE, QIEEE. IEEE floating point
-+USE, QISASTD, IF=QF_DEC. ISA standard routines, ISHFT, IOR, etc
-+USE, QMILSTD, IF=QF_DEC. MIL standard routines, IBITS, MVBITS, ISHFTC
-+USE, QISASTD, IF=QF_NDP. ISA standard routines, ISHFT, IOR, etc
-+USE, QMILSTD, IF=QF_NDP. MIL standard routines, IBITS, MVBITS, ISHFTC
-+USE, QHOLL. Hollerith constants exist
-+USE, QORTHOLL, T=INH. Hollerith storage not orthodox
-+USE, QDEFAULT.
-+USE, QCFIO. C library I/O available
-+USE, QZENORM.
-+USE, QMUIX. Normal Unix system machine
-+USE, RZBYTES, IF=-QF_DEC.
-+USE, Q$BITSEQ, IF=QF_DEC.
-+KEEP, IALL1S. set a word of all ones
- PARAMETER (IALL11 = NOT(0))
-+KEEP, Q_JBIT, IF=QF_NDP.
- JBIT (IZZW,IZZP) = IBITS (IZZW,IZZP-1,1)
-+KEEP, Q_JBYT, IF=QF_NDP.
- JBYT (IZZW,IZZP,NZZB) = IBITS (IZZW,IZZP-1,NZZB)
-+KEEP, Q_SBIT0, IF=QF_NDP.
- MSBIT0 (IZZW,IZZP) = IAND (IZZW, NOT(ISHFT(1,IZZP-1)) )
-+KEEP, Q_SBIT1, IF=QF_NDP.
- MSBIT1 (IZZW,IZZP) = IOR (IZZW, ISHFT(1,IZZP-1) )
-+KEEP, Q_SBIT, IF=QF_NDP.
- MSBIT (MZZ,IZZW,IZZP) = IOR (IAND (IZZW, NOT(ISHFT(1,IZZP-1)) )
- + , ISHFT(IAND(MZZ,1),IZZP-1))
-+KEEP, Q_SBYT, IF=QF_NDP.
- MSBYT (MZZ,IZZW,IZZP,NZZB) = IOR (
- + IAND (IZZW, NOT(ISHFT (ISHFT(NOT(0),-32+NZZB), IZZP-1)))
- + , ISHFT (ISHFT(MZZ,32-NZZB), -33+IZZP+NZZB) )
-+KEEP, Q_JBYTET, IF=QF_NDP.
- JBYTET (MZZ,IZZW,IZZP,NZZB) = IAND (MZZ, IBITS(IZZW,IZZP-1,NZZB))
-+KEEP, Q_JBYTOR, IF=QF_NDP.
- JBYTOR (MZZ,IZZW,IZZP,NZZB) = IOR (MZZ, IBITS(IZZW,IZZP-1,NZZB))
-+KEEP, Q_MBYTET, IF=QF_NDP.
- MBYTET (MZZ,IZZW,IZZP,NZZB) = IAND (IZZW,
- + NOT(ishft (ISHFT(NOT(MZZ),32-NZZB),-33+IZZP+NZZB)) )
-+KEEP, Q_MBYTOR, IF=QF_NDP.
- MBYTOR (MZZ,IZZW,IZZP,NZZB) = IOR (IZZW,
- + ishft (ISHFT(MZZ,32-NZZB),-33+IZZP+NZZB) )
-+KEEP, Q_SHIFTL, IF=QF_F2C.
- ISHFTL(IZW,NZB) = LSHIFT(IZW,NZB)
-+SELF. Note: RSHIFT is arithmetic with F2C, it cannot be used
-+KEEP, Q_AND, IF=QF_F2C.
- IAND(IZV,IZW) = AND(IZV,IZW)
-+KEEP, Q_OR, IF=QF_F2C.
- IOR(IZV,IZW) = OR(IZV,IZW)
-+KEEP, Q_XOR, IF=QF_F2C.
- IEOR(IZV,IZW) = XOR(IZV,IZW)
-+KEEP, Q_JBIT, IF=QF_F2C.
- JBIT (IZW,IZP) = AND(RSHIFT(IZW,IZP-1),1)
-+KEEP, Q_JBYT, IF=QF_F2C.
- JBYT (IZW,IZP,NZB) = ISHFTR(LSHIFT(IZW,33-IZP-NZB),32-NZB)
-+KEEP, Q_SBIT0, IF=QF_F2C.
- MSBIT0 (IZW,IZP) = AND (IZW, NOT(LSHIFT(1,IZP-1)) )
-+KEEP, Q_SBIT1, IF=QF_F2C.
- MSBIT1 (IZW,IZP) = OR (IZW, LSHIFT(1,IZP-1) )
-+KEEP, Q_SBIT, IF=QF_F2C.
- MSBIT (MZ,IZW,IZP) = OR (AND (IZW, NOT(LSHIFT(1,IZP-1)) )
- + , LSHIFT(AND(MZ,1),IZP-1))
-+KEEP, MZEUNIT, P=MQ, D=MZINCO.
- IQREAD = 2
- IQPRNT = 3
- IQPNCH = 4
-+KEEP, MZEUNIT2, P=MQ, D=MZINCO.
- IQTTIN = 5
- IQTYPE = 6
-+KEEP, MZEBCD1.
- CQALLC(48:64) = '#''!:"_]&@?[>< ^;%'
- CQALLC(61:61) = CHAR(92)
-+PATCH, *ZHPX. Pilot for HP UNIX
-+USE, QCDE, QMHPX.
-+USE, QMUIX.
-+USE, QUTYHPX.
-+USE, B32, A4.
-+USE, HEX.
-+USE, QIEEE. IEEE floating point
-+USE, QISASTD. ISA standard routines ISHFT IOR etc
-+USE, QMILSTD. MIL standard routines IBITS MVBITS ISHFTC
-+USE, QCFIO. C library I/O available
-+USE, QZENORM.
-+USE, Q$BITSEQ.
-+KEEP, Q_JBIT.
- JBIT (IZW,IZP) = IBITS (IZW,IZP-1,1)
-+KEEP, Q_JBYT.
- JBYT (IZW,IZP,NZB) = IBITS (IZW,IZP-1,NZB)
-+KEEP, Q_JBYTET.
- JBYTET (MZ,IZW,IZP,NZB) = IAND (MZ, IBITS(IZW,IZP-1,NZB))
-+KEEP, Q_JBYTOR.
- JBYTOR (MZ,IZW,IZP,NZB) = IOR (MZ, IBITS(IZW,IZP-1,NZB))
-+KEEP, Q_MBYTET.
- MBYTET (MZ,IZW,IZP,NZB) = IAND (IZW,
- + NOT(ishft (ISHFT(NOT(MZ),32-NZB),-33+IZP+NZB)) )
-+KEEP, Q_MBYTOR.
- MBYTOR (MZ,IZW,IZP,NZB) = IOR (IZW,
- + ishft (ISHFT(MZ,32-NZB),-33+IZP+NZB) )
-+KEEP, MZEUNIT, P=MQ, D=MZINCO.
- IQREAD = 2
- IQPRNT = 3
- IQPNCH = 4
-+KEEP, MZEUNIT2, P=MQ, D=MZINCO.
- IQTTIN = 5
- IQTYPE = 6
-+KEEP, MZEBCD1.
- CQALLC(48:64) = '#''!:"_]&@?[>< ^;%'
- CQALLC(61:61) = CHAR(92)
-+PATCH, *ZIBMSI. Pilot for IBM with FORTRAN 77 SIEMENS
-+USE, *ZIBM, QMIBMFSI.
-+SELF. At CERN the Siemens compiler is used on system MVS
-+KEEP, Q_SHIFTL.
- ISHFTL (IZW,NZB) = SHFTL (IZW, NZB)
-+KEEP, Q_SHIFTR.
- ISHFTR (IZW,NZB) = SHFTR (IZW, NZB)
-+KEEP, Q_AND.
- IAND (IZV,IZW) = LAND (IZV, IZW)
-+KEEP, Q_OR.
- IOR (IZV,IZW) = LOR (IZV, IZW)
-+KEEP, Q_XOR.
- IEOR (IZV,IZW) = LXOR (IZV, IZW)
-+KEEP, Q_NOT.
- NOT (IZW) = LCOMPL (IZW)
-+KEEP, Q_JBIT.
- JBIT (IZW,IZP) = SHFTR (SHFTL(IZW,32-IZP), 31)
-+KEEP, Q_JBYT.
- JBYT (IZW,IZP,NZB)= SHFTR (SHFTL(IZW,33-IZP-NZB), 32-NZB)
-+KEEP, Q_SBIT0.
- MSBIT0 (IZW,IZP) = LAND (IZW, LCOMPL(SHFTL(1,IZP-1)) )
-+KEEP, Q_SBIT1.
- MSBIT1 (IZW,IZP) = LOR (IZW, SHFTL(1,IZP-1) )
-+KEEP, Q_SBIT.
- MSBIT (MZ,IZW,IZP) = LOR (LAND (IZW, LCOMPL(SHFTL(1,IZP-1)) )
- + , SHFTL(LAND(MZ,1),IZP-1) )
-+KEEP, Q_SBYT.
- MSBYT (MZ,IZW,IZP,NZB) = LOR (
- + LAND (IZW, LCOMPL(SHFTL (SHFTR(-1,32-NZB), IZP-1)))
- + , SHFTR (SHFTL(MZ,32-NZB), 33-IZP-NZB) )
-+KEEP, Q_JBYTET.
- JBYTET (MZ,IZW,IZP,NZB) = LAND (MZ,
- + SHFTR (SHFTL(IZW,33-IZP-NZB), 32-NZB) )
-+KEEP, Q_JBYTOR.
- JBYTOR (MZ,IZW,IZP,NZB) = LOR (MZ,
- + SHFTR (SHFTL(IZW,33-IZP-NZB), 32-NZB) )
-+KEEP, Q_MBYTET.
- MBYTET (MZ,IZW,IZP,NZB) = LAND (IZW, LCOMPL(SHFTR (
- + SHFTL(LCOMPL(MZ),32-NZB), 33-IZP-NZB)) )
-+KEEP, Q_MBYTOR.
- MBYTOR (MZ,IZW,IZP,NZB) = LOR (IZW, SHFTR (
- + SHFTL(MZ,32-NZB), 33-IZP-NZB) )
-+PATCH, *ZIBM, T=JOIN. Pilot for IBM
-+USE, QMIBMFVS, IF=-QMIBMFSI. VS compiler default
-+USE, QIBM_VM. system VM/CMS default
-+USE, QCDE, QMIBM.
-+USE, QUTYIBM.
-+USE, B32, A4.
-+USE, QEBCDIC.
-+USE, HEX.
-+USE, QISASTD. ISA standard routines ISHFT IOR etc
-+USE, QZENORM.
-+KEEP, ZPOSTMTR, P=QEND, D=ZPOSTM.
- CALL ERRTRA
-+KEEP, QTOABEND. FORCE LAST LINE TO BE OUT OF THE BUFFER
- WRITE (IQLOG,9701)
- 9701 FORMAT ('0GOING TO ABEND.'/ 20(1X,20(1H*)/) )
- CALL ABEND
-+PATCH, *ZIBMD,T=JOIN. Pilot for IBM autodbl
-+USE, AUTODBL. for Auto-double
-+USE, QMIBMFVS, IF=-QMIBMFSI. VS compiler default
-+USE, QIBM_VM. system VM/CMS default
-+USE, QCDE, QMIBMD.
-+USE, QUTYIBM.
-+USE, B32, A4.
-+USE, QEBCDIC.
-+USE, HEX.
-+USE, QISASTD. ISA standard routines ISHFT IOR etc
-+USE, QZENORM.
-+KEEP, ZPOSTMTR, P=QEND, D=ZPOSTM.
- CALL ERRTRA
-+KEEP, QTOABEND. FORCE LAST LINE TO BE OUT OF THE BUFFER
- WRITE (IQLOG,9701)
- 9701 FORMAT ('0GOING TO ABEND.'/ 20(1X,20(1H*)/) )
- CALL ABEND
-+PATCH, *ZIBX. Pilot for IBM 3090 with AIX
-+USE, QCDE, QMIBX.
-+USE, QMUIX.
-+USE, QUTYIBX.
-+USE, B32, A4.
-+USE, HEX.
-+USE, QISASTD. ISA standard routines ISHFT IOR etc
-+USE, QCFIO. C library I/O available
-+USE, QZENORM.
-+KEEP, MZEUNIT, P=MQ, D=MZINCO.
- IQREAD = 2
- IQPRNT = 3
- IQPNCH = 4
-+KEEP, MZEUNIT2, P=MQ, D=MZINCO.
- IQTTIN = 5
- IQTYPE = 6
-+KEEP, MZEBCD1.
- CQALLC(48:64) = '#''!:"_]&@?[>< ^;%'
- CQALLC(61:61) = CHAR(92)
-+PATCH, *ZIRT, T=JOIN. Pilot for IBM /RT
-+USE, QCDE, QMIRT.
-+USE, QMUIX.
-+USE, QUTYIRT.
-+USE, B32, A4.
-+USE, HEX.
-+USE, QIEEE. IEEE floating point
-+USE, QISASTD. ISA standard routines ISHFT IOR etc
-+USE, QCFIO. C library I/O available
-+USE, QZENORM.
-+USE, Q$BITSEQ.
-+KEEP, MZEUNIT, P=MQ, D=MZINCO.
- IQREAD = 2
- IQPRNT = 3
- IQPNCH = 4
-+KEEP, MZEUNIT2, P=MQ, D=MZINCO.
- IQTTIN = 5
- IQTYPE = 6
-+KEEP, MZEBCD1.
- CQALLC(48:64) = '#''!:"_]&@?[>< ^;%'
-+PATCH, *ZIRTD,T=JOIN. Pilot for IBM /RT autodbl
-+USE, AUTODBL. for Auto-double
-+USE, QCDE, QMIRTD.
-+USE, QMUIX.
-+USE, QUTYIRT.
-+USE, B32, A4.
-+USE, HEX.
-+USE, QIEEE. IEEE floating point
-+USE, QISASTD. ISA standard routines ISHFT IOR etc
-+USE, QCFIO. C library I/O available
-+USE, QZENORM.
-+USE, Q$BITSEQ.
-+KEEP, MZEUNIT, P=MQ, D=MZINCO.
- IQREAD = 2
- IQPRNT = 3
- IQPNCH = 4
-+KEEP, MZEUNIT2, P=MQ, D=MZINCO.
- IQTTIN = 5
- IQTYPE = 6
-+KEEP, MZEBCD1.
- CQALLC(48:64) = '#''!:"_]&@?[>< ^;%'
-+PATCH, *ZLNX, T=JOIN. Pilot for LINUX
-+USE, QCDE, QMLNX.
-+USE, QMUIX.
-+USE, QUTYLNX.
-+USE, B32, A4.
-+USE, HEX.
-+USE, QIEEE. IEEE floating point
-+USE, QORTHOLL, T=INH. Hollerith storage not orthodox
-+USE, QCFIO. C library I/O available
-+USE, QZENORM.
-+KEEP, Q_SHIFTL.
- ISHFTL (IZW,NZB) = LSHIFT (IZW,NZB)
-+KEEP, Q_AND.
- IAND(IZV,IZW) = AND(IZV,IZW)
-+KEEP, Q_OR.
- IOR(IZV,IZW) = OR(IZV,IZW)
-+KEEP, Q_XOR.
- IEOR(IZV,IZW) = XOR(IZV,IZW)
-+KEEP, Q_JBIT.
- JBIT(IZW,IZP) = AND(ISHFTR(IZW,IZP-1),1)
-+KEEP, Q_JBYT.
- JBYT(IZW,IZP,NZB) = ISHFTR(LSHIFT(IZW,33-IZP-NZB),32-NZB)
-+KEEP, Q_SBIT0.
- MSBIT0 (IZW,IZP) = AND (IZW, NOT(LSHIFT(1,IZP-1)))
-+KEEP, Q_SBIT1.
- MSBIT1 (IZW,IZP) = OR (IZW, LSHIFT(1,IZP-1))
-+KEEP, Q_SBIT.
- MSBIT (MZ,IZW,IZP) = OR (AND (IZW, NOT(LSHIFT(1,IZP-1)))
- + ,LSHIFT(AND(MZ,1),IZP-1))
-+KEEP, Q_SBYT.
- MSBYT (MZ,IZW,IZP,NZB) = OR (
- + AND (IZW, NOT(LSHIFT (ISHFTR(NOT(0),32-NZB),IZP-1)))
- + ,ISHFTR (LSHIFT(MZ,32-NZB), 33-IZP-NZB) )
-+KEEP, Q_JBYTET.
- JBYTET (MZ,IZW,IZP,NZB) = AND (MZ,
- + ISHFTR (LSHIFT(IZW,33-IZP-NZB),32-NZB) )
-+KEEP, Q_JBYTOR.
- JBYTOR (MZ,IZW,IZP,NZB) = OR (MZ,
- + ISHFTR (LSHIFT(IZW,33-IZP-NZB),32-NZB) )
-+KEEP, Q_MBYTET.
- MBYTET (MZ,IZW,IZP,NZB) = AND (IZW,
- + NOT(ISHFTR (LSHIFT(NOT(MZ),32-NZB),33-IZP-NZB)) )
-+KEEP, Q_MBYTOR.
- MBYTOR (MZ,IZW,IZP,NZB) = OR (IZW,
- + ISHFTR (LSHIFT(MZ,32-NZB),33-IZP-NZB))
-+KEEP, MZEUNIT.
- IQREAD = 2
- IQPRNT = 3
- IQPNCH = 4
-+KEEP, MZEUNIT2.
- IQTTIN = 5
- IQTYPE = 6
-+KEEP, MZEBCD1.
- CQALLC(48:64) = '#''!:"_]&@?[>< ^;%'
- CQALLC(61:61) = CHAR(92)
-+PATCH, *ZMPW. Pilot for MAC II MPW & LSE FORTRAN
-+USE, QCDE, QMMPW.
-+USE, QUTYMPW.
-+USE, B32, A4.
-+USE, HEX.
-+USE, QISASTD. ISA standard routines ISHFT IOR etc
-+USE, QIEEE. IEEE floating point
-+USE, QZENORM.
-+USE, Q$BITSEQ.
-+KEEP, MZEUNIT, P=MQ, D=MZINCO.
- IQREAD = 2
- IQPRNT = 3
- IQPNCH = 4
-+KEEP, MZEUNIT2, P=MQ, D=MZINCO.
- IQTTIN = 5
- IQTYPE = 6
-+KEEP, MZEBCD1.
- CQALLC(48:64) = '#''!:"_]&@?[>< ^;%'
- CQALLC(61:61) = CHAR(92)
-+PATCH, *ZNXT. Pilot for NeXT with ABSOFT-F77
-+USE, QCDE, QMNXT.
-+USE, QMUIX.
-+USE, QUTYNXT.
-+USE, B32, A4.
-+USE, HEX.
-+USE, QIEEE. IEEE floating point
-+USE, QISASTD. ISA standard routines ISHFT IOR etc
-+USE, QMILSTD. MIL standard routines IBITS MVBITS ISHFTC
-+USE, QCFIO. C library I/O available
-+USE, QZENORM.
-+KEEP, MZEUNIT, P=MQ, D=MZINCO.
- IQREAD = 2
- IQPRNT = 3
- IQPNCH = 4
-+KEEP, MZEUNIT2, P=MQ, D=MZINCO.
- IQTTIN = 5
- IQTYPE = 6
-+KEEP, MZEBCD1.
- CQALLC(48:64) = '#''!:"_]&@?[>< ^;%'
- CQALLC(61:61) = CHAR(92)
-+PATCH, *ZOS9. Pilot for HP UNIX
-+USE, QCDE, QMOS9.
-+USE, QMUIX.
-+USE, QUTYOS9.
-+USE, B32, A4.
-+USE, HEX.
-+USE, QIEEE. IEEE floating point
-+USE, QISASTD. ISA standard routines ISHFT IOR etc
-+USE, QMILSTD. MIL standard routines IBITS MVBITS ISHFTC
-+USE, QCFIO. C library I/O available
-+USE, QZENORM.
-+KEEP, Q_JBIT.
- JBIT (IZW,IZP) = IBITS (IZW,IZP-1,1)
-+KEEP, Q_JBYT.
- JBYT (IZW,IZP,NZB) = IBITS (IZW,IZP-1,NZB)
-+KEEP, Q_JBYTET.
- JBYTET (MZ,IZW,IZP,NZB) = IAND (MZ, IBITS(IZW,IZP-1,NZB))
-+KEEP, Q_JBYTOR.
- JBYTOR (MZ,IZW,IZP,NZB) = IOR (MZ, IBITS(IZW,IZP-1,NZB))
-+KEEP, Q_MBYTET.
- MBYTET (MZ,IZW,IZP,NZB) = IAND (IZW,
- + NOT(ishft (ISHFT(NOT(MZ),32-NZB),-33+IZP+NZB)) )
-+KEEP, Q_MBYTOR.
- MBYTOR (MZ,IZW,IZP,NZB) = IOR (IZW,
- + ishft (ISHFT(MZ,32-NZB),-33+IZP+NZB) )
-+KEEP, MZEUNIT, P=MQ, D=MZINCO.
- IQREAD = 2
- IQPRNT = 3
- IQPNCH = 4
-+KEEP, MZEUNIT2, P=MQ, D=MZINCO.
- IQTTIN = 5
- IQTYPE = 6
-+KEEP, MZEBCD1.
- CQALLC(48:64) = '#''!:"_]&@?[>< ^;%'
- CQALLC(61:61) = CHAR(92)
-+PATCH, *ZSGI. Pilot for Silicon Graphics Iris
-+USE, QCDE, QMSGI.
-+USE, QMUIX.
-+USE, QUTYSGI.
-+USE, B32, A4.
-+USE, HEX.
-+USE, QIEEE. IEEE floating point
-+USE, QISASTD. ISA standard routines ISHFT IOR etc
-+USE, QMILSTD. MIL standard routines IBITS MVBITS ISHFTC
-+USE, QCFIO. C library I/O available
-+USE, QZENORM.
-+USE, Q$BITSEQ.
-+KEEP, MZEUNIT, P=MQ, D=MZINCO.
- IQREAD = 2
- IQPRNT = 3
- IQPNCH = 4
-+KEEP, MZEUNIT2, P=MQ, D=MZINCO.
- IQTTIN = 5
- IQTYPE = 6
-+KEEP, MZEBCD1.
- CQALLC(48:64) = '#''!:"_]&@?[>< ^;%'
- CQALLC(61:61) = CHAR(92)
-+PATCH, *ZSUN. Pilot for SUN
-+USE, QCDE, QMSUN.
-+USE, QMUIX.
-+USE, QUTYSUN.
-+USE, B32, A4.
-+USE, HEX.
-+USE, QIEEE. IEEE floating point
-+USE, QCFIO. C library I/O available
-+USE, QZENORM.
-+KEEP, Q_SHIFTR, IF=BUGLRSHFT. temporary to avoid lrshft bug in ftn 3.0
- ISHFTR (IZW,NZB) = ishft (IZW,-NZB)
-+KEEP, Q_JBIT, IF=BUGLRSHFT.
-+KEEP, Q_JBYT, IF=BUGLRSHFT.
-+KEEP, Q_JBYTET, IF=BUGLRSHFT.
-+KEEP, Q_JBYTOR, IF=BUGLRSHFT.
-+KEEP, Q_MBYTET, IF=BUGLRSHFT.
-+KEEP, Q_MBYTOR, IF=BUGLRSHFT.
-+SELF.
-+KEEP, Q_SHIFTL.
- ISHFTL (IZW,NZB) = LSHIFT (IZW, NZB)
-+KEEP, Q_SHIFTR.
- ISHFTR (IZW,NZB) = lrshft (IZW, NZB)
-+KEEP, Q_AND.
- IAND (IZV,IZW) = AND (IZV, IZW)
-+KEEP, Q_OR.
- IOR (IZV,IZW) = OR (IZV, IZW)
-+KEEP, Q_XOR.
- IEOR (IZV,IZW) = XOR (IZV, IZW)
-+KEEP, Q_JBIT.
- JBIT (IZW,IZP) = AND (lrshft(IZW,IZP-1), 1)
-+KEEP, Q_JBYT.
- JBYT (IZW,IZP,NZB)= lrshft (LSHIFT(IZW,33-IZP-NZB),32-NZB)
-+KEEP, Q_SBIT0.
- MSBIT0 (IZW,IZP) = AND (IZW, NOT(LSHIFT(1,IZP-1)) )
-+KEEP, Q_SBIT1.
- MSBIT1 (IZW,IZP) = OR (IZW, LSHIFT(1,IZP-1) )
-+KEEP, Q_SBIT.
- MSBIT (MZ,IZW,IZP) = OR (AND (IZW, NOT(LSHIFT(1,IZP-1)) )
- + , LSHIFT(AND(MZ,1),IZP-1) )
-+KEEP, Q_JBYTET.
- JBYTET (MZ,IZW,IZP,NZB) = AND (MZ,
- + lrshft (LSHIFT(IZW,33-IZP-NZB), 32-NZB))
-+KEEP, Q_JBYTOR.
- JBYTOR (MZ,IZW,IZP,NZB) = OR (MZ,
- + lrshft (LSHIFT(IZW,33-IZP-NZB), 32-NZB))
-+KEEP, Q_MBYTET.
- MBYTET (MZ,IZW,IZP,NZB) = AND (IZW, NOT(lrshft (
- + LSHIFT(NOT(MZ),32-NZB), 33-IZP-NZB)))
-+KEEP, Q_MBYTOR.
- MBYTOR (MZ,IZW,IZP,NZB) = OR (IZW, lrshft (
- + LSHIFT(MZ,32-NZB), 33-IZP-NZB))
-+KEEP, MZEUNIT, P=MQ, D=MZINCO.
- IQREAD = 2
- IQPRNT = 3
- IQPNCH = 4
-+KEEP, MZEUNIT2, P=MQ, D=MZINCO.
- IQTTIN = 5
- IQTYPE = 6
-+KEEP, MZEBCD1.
- CQALLC(48:64) = '#''!:"_]&@?[>< ^;%'
- CQALLC(61:61) = CHAR(92)
-+PATCH, *ZVAX. Pilot for VAX
-+USE, QCDE, QMVAX.
-+USE, QUTYVAX.
-+USE, B32, A4.
-+USE, HEX.
-+USE, QISASTD. ISA standard routines ISHFT IOR etc
-+USE, QMILSTD. MIL standard routines IBITS MVBITS ISHFTC
-+USE, QORTHOLL, T=INH. Hollerith storage not orthodox
-+USE, QCFIO. C library I/O available
-+USE, QZENORM.
-+SELF. Q_AND, Q_OR, Q_XOR, Q_NOT : IAND / IOR / IEOR / NOT are standard on VAX
-+KEEP, MZEUNIT, P=MQ, D=MZINCO.
- IQREAD = 2
- IQPRNT = 3
- IQPNCH = 4
-+KEEP, MZEUNIT2, P=MQ, D=MZINCO.
- IQTTIN = 5
- IQTYPE = 6
-+KEEP, MZEBCD1.
- CQALLC(48:64) = '#''!:"_]&@?[>< ^;%'
- CQALLC(61:61) = CHAR(92)
-+PATCH, *ZVMI, T=JOIN. Pilot for Decstation VAX / MIPS
-+USE, QCDE, QMVMI.
-+USE, QMUIX.
-+USE, B32, A4.
-+USE, QUTYVMI.
-+USE, HEX.
-+USE, QIEEE. IEEE floating point
-+USE, QISASTD. ISA standard routines ISHFT IOR etc
-+USE, QORTHOLL, T=INH. Hollerith storage not orthodox
-+USE, QCFIO. C library I/O available
-+USE, QZENORM.
-+SELF. Q_AND, Q_OR, Q_XOR, Q_NOT : IAND / IOR / IEOR / NOT are standard on VMI
-+KEEP, MZEUNIT, P=MQ, D=MZINCO.
- IQREAD = 2
- IQPRNT = 3
- IQPNCH = 4
-+KEEP, MZEUNIT2, P=MQ, D=MZINCO.
- IQTTIN = 5
- IQTYPE = 6
-+KEEP, MZEBCD1.
- CQALLC(48:64) = '#''!:"_]&@?[>< ^;%'
- CQALLC(61:61) = CHAR(92)
-+PATCH, *ZVDS. Pilot for vdSchmitt compiler
-+USE, QCDE, QMVDS.
-+USE, QUTYVDS.
-+USE, B32, A4.
-+USE, HEX.
-+USE, QISASTD. ISA standard routines ISHFT IOR etc
-+USE, QERREND. IOSTAT not possible in READ statements
-+USE, QTRCHAR. Trace-back with names of type CHARACTER
-+USE, QZENORM.
-+KEEP, Q_SHIFTL, T=NOL. ISHFTL / ISHFTR are intrinsics of vdS
-+KEEP, Q_SHIFTR, T=NOL.
-+KEEP, Q_JBIT. JBYT is an intrinsic of vdS
- JBIT (IZW,IZP) = JBYT (IZW,IZP,1)
-+KEEP, Q_SBIT0.
- MSBIT0 (IZW,IZP) = AND (IZW, NOT(LSHFT(1,IZP-1)) )
-+KEEP, Q_SBIT1.
- MSBIT1 (IZW,IZP) = OR (IZW, LSHFT(1,IZP-1) )
-+KEEP, Q_SBIT.
- MSBIT (MZ,IZW,IZP) = OR (AND (IZW, NOT(LSHFT(1,IZP-1)) )
- + , LSHFT(AND(MZ,1),IZP-1) )
-+KEEP, Q_SBYT.
- MSBYT (MZ,IZW,IZP,NZB) = OR (
- + AND (IZW, NOT(LSHFT (RSHFT(NOT(0),32-NZB), IZP-1)))
- + , RSHFT (LSHFT(MZ,32-NZB), 33-IZP-NZB) )
-+KEEP, Q_JBYTET.
- JBYTET (MZ,IZW,IZP,NZB) = AND (MZ, JBYT(IZW,IZP,NZB))
-+KEEP, Q_JBYTOR.
- JBYTOR (MZ,IZW,IZP,NZB) = OR (MZ, JBYT(IZW,IZP,NZB))
-+KEEP, Q_MBYTET.
- MBYTET (MZ,IZW,IZP,NZB) = AND (IZW, NOT(RSHFT (
- + LSHFT(NOT(MZ),32-NZB), 33-IZP-NZB)) )
-+KEEP, Q_MBYTOR.
- MBYTOR (MZ,IZW,IZP,NZB) = OR (IZW, RSHFT (
- + LSHFT(MZ,32-NZB), 33-IZP-NZB) )
-+KEEP, MZEUNIT, P=MQ, D=MZINCO.
- IQREAD = 5
- IQPRNT = 6
- IQPNCH = 3
-+KEEP, MZEUNIT2, P=MQ, D=MZINCO.
- IQTTIN = 1
- IQTYPE = 1
-+KEEP, MZEBCD1.
- CQALLC(48:64) = '#''!:"_]&@?[>< ^;%'
- CQALLC(61:61) = CHAR(92)
-+PATCH, Q$BITSEQ.
-+KEEP, Q_JBIT.
- JBIT (IZW,IZP) = IAND (ISHFT(IZW,1-IZP), 1)
-+KEEP, Q_JBYT.
- JBYT (IZW,IZP,NZB) = ISHFT (ISHFT(IZW,33-IZP-NZB), -32+NZB)
-+KEEP, Q_SBIT0.
- MSBIT0 (IZW,IZP) = IAND (IZW, NOT(ISHFT(1,IZP-1)) )
-+KEEP, Q_SBIT1.
- MSBIT1 (IZW,IZP) = IOR (IZW, ISHFT(1,IZP-1) )
-+KEEP, Q_SBIT.
- MSBIT (MZ,IZW,IZP) = IOR (IAND (IZW, NOT(ISHFT(1,IZP-1)) )
- + , ISHFT(IAND(MZ,1),IZP-1))
-+KEEP, Q_SBYT.
- MSBYT (MZ,IZW,IZP,NZB) = IOR (
- + IAND (IZW, NOT(ISHFT (ISHFT(NOT(0),-32+NZB), IZP-1)))
- + , ISHFT (ISHFT(MZ,32-NZB), -33+IZP+NZB) )
-+KEEP, Q_JBYTET.
- JBYTET (MZ,IZW,IZP,NZB) = IAND (MZ,
- + ISHFT (ISHFT(IZW,33-IZP-NZB),-32+NZB) )
-+KEEP, Q_JBYTOR.
- JBYTOR (MZ,IZW,IZP,NZB) = IOR (MZ,
- + ISHFT (ISHFT(IZW,33-IZP-NZB),-32+NZB) )
-+KEEP, Q_MBYTET.
- MBYTET (MZ,IZW,IZP,NZB) = IAND (IZW,
- + NOT(ISHFT (ISHFT(NOT(MZ),32-NZB),-33+IZP+NZB)) )
-+KEEP, Q_MBYTOR.
- MBYTOR (MZ,IZW,IZP,NZB) = IOR (IZW,
- + ISHFT (ISHFT(MZ,32-NZB),-33+IZP+NZB) )
-+PATCH, QCDE.
-+USE, QASCII, IF=-QEBCDIC. Character set is ASCII
-+USE, QPRINT. Printing is possible
-+USE, QHOLL. Hollerith constants exist
-+USE, EQUHOLCH, IF=QHOLL. EQUIVALENCE Hollerith/Character ok
-+USE, QORTHOLL. Orthodox Hollerith storage left to right
-+USE, QTRHOLL, IF=QHOLL. Trace-back names Hollerith
-+USE, QTRHOLL, T=INH, IF=QTRCHAR. Trace-back names type Character
-+KEEP, Q_SHIFTL.
- ISHFTL (IZW,NZB) = ISHFT (IZW, NZB)
-+KEEP, Q_SHIFTR.
- ISHFTR (IZW,NZB) = ISHFT (IZW,-NZB)
-+KEEP, Q_AND, T=NOLIST.
-+KEEP, Q_OR, T=NOLIST.
-+KEEP, Q_XOR, T=NOLIST.
-+KEEP, Q_NOT, T=NOLIST.
-+KEEP, Q_JBIT, T=NOLIST.
-+KEEP, Q_JBYT, T=NOLIST.
-+KEEP, Q_SBIT0, T=NOLIST.
-+KEEP, Q_SBIT1, T=NOLIST.
-+KEEP, Q_SBIT, T=NOLIST.
-+KEEP, Q_SBYT, T=NOLIST.
-+KEEP, Q_SHIFTL, T=NOLIST.
-+KEEP, Q_SHIFTR, T=NOLIST.
-+KEEP, Q_JBYTET, T=NOLIST.
-+KEEP, Q_JBYTOR, T=NOLIST.
-+KEEP, Q_MBYTET, T=NOLIST.
-+KEEP, Q_MBYTOR, T=NOLIST.
-+KEEP, Q_LOCF, T=NOLIST.
-+KEEP, Q$SHIFT.
-+SEQ, Q_SHIFTL, Q_SHIFTR.
-+KEEP, Q$ANDOR.
-+SEQ, Q_AND, Q_OR, Q_XOR, Q_NOT.
-+KEEP, Q$JBIT.
-+SEQ, Q_JBIT, Q_JBYT.
-+KEEP, Q$SBIT.
-+SEQ, Q_SBIT0, Q_SBIT1, Q_SBIT.
-+KEEP, Q$SBYT.
-+SEQ, Q_SBYT.
-+KEEP, Q$JBYTET.
-+SEQ, Q_JBYTET, Q_JBYTOR, Q_MBYTET, Q_MBYTOR.
-+KEEP, Q$LOCF.
-+SEQ, Q_LOCF.
-+DECK, QCDE.
-+SELF. ------------- for general use ---------------------------
-+KEEP, ZBCD. BCD char. in CETA order with A1 format
- COMMON /ZBCD/ IQNUM2(11),IQLETT(26),IQNUM(10), IQPLUS,IQMINS
- +, IQSTAR,IQSLAS,IQOPEN,IQCLOS,IQDOLL,IQEQU, IQBLAN
- +, IQCOMA,IQDOT, IQNUMB,IQAPO, IQEXCL,IQCOLO,IQQUOT
- +, IQUNDE,IQCLSQ,IQAND, IQAT, IQQUES,IQOPSQ,IQGREA
- +, IQLESS,IQREVE,IQCIRC,IQSEMI,IQPERC, IQLOWL(26)
- +, IQCROP,IQVERT,IQCRCL,IQNOT, IQGRAV, IQILEG
- +, NQHOL0,NQHOLL(95)
-+KEEP, ZBCDCH. BCD char. in CETA order as CHARACTER
- CHARACTER CQALLC*96
- COMMON /ZBCDCH/ CQALLC
- CHARACTER*1 CQLETT(96), CQNUM(10)
- EQUIVALENCE (CQLETT(1),CQALLC(1:1))
- EQUIVALENCE (CQNUM(1), CQALLC(27:27))
-+KEEP, ZCETA. CETA values in internal order
- PARAMETER (NQTCET=256)
- COMMON /ZCETA/ IQCETA(256),IQTCET(256)
-+KEEP, ZHEADP. Page heading parameters
- COMMON /ZHEADP/IQHEAD(20),IQDATE,IQTIME,IQPAGE,NQPAGE(4)
-+KEEP, ZKRAKC.
- COMMON /ZKRAKC/IQHOLK(120), IQKRAK(80), IQCETK(122)
-+KEEP, ZKRAKCC, IF=EQUHOLCH.
- COMMON /ZKRAKC/IQHOLK(120), IQKRAK(80), IQCETK(122)
- CHARACTER CQHOLK*120
- EQUIVALENCE (CQHOLK,IQHOLK)
-+KEEP, ZKRAKCC.
- COMMON /ZKRAKC/IQHOLK(120), IQKRAK(80), IQCETK(122)
- COMMON /ZCRAKC/CQHOLK
- CHARACTER CQHOLK*120
-+KEEP, ZLIMIT. MZFLAG Limit parameters
- COMMON /ZLIMIT/LQLIML,LQLIMH
-+KEEP, ZMACHFIX.
- PARAMETER (IQBITW=32, IQBITC=8, IQCHAW=4)
-+KEEP, ZMACH. Machine parameters
-+CDE, ZMACHFIX.
- COMMON /ZMACH/ NQBITW,NQBITC,NQCHAW
- +, NQLNOR,NQLMAX,NQLPTH,NQRMAX,IQLPCT,IQNIL
-+KEEP, ZNATUR. Constants of Nature
- COMMON /ZNATUR/QPI2,QPI,QPIBY2,QPBYHR
-+KEEP, ZSTATE. Program Status parameters
- COMMON /ZSTATE/QVERSN,NQPHAS,IQDBUG,NQDCUT,NQWCUT,NQERR
- +, NQLOGD,NQLOGM,NQLOCK,NQDEVZ,NQOPTS(6)
-+KEEP, ZUNIT. Logical Unit Numbers
- COMMON /ZUNIT/ IQREAD,IQPRNT,IQPR2,IQLOG,IQPNCH,IQTTIN,IQTYPE
- COMMON /ZUNITZ/IQDLUN,IQFLUN,IQHLUN, NQUSED
-+KEEP, ZVFAUT. Automatic verify parameters
- COMMON /ZVFAUT/IQVID(2),IQVSTA,IQVLOG,IQVTHR(2),IQVREM(2,6)
-+KEEP, QUEST.
- COMMON /QUEST/ IQUEST(100)
-+KEEP, QSTORE.
- IF (JBYT(IXSTOR,27,6).NE.JQSTOR) CALL MZSDIV (IXSTOR,-7)
-+SELF. ------------- for ZEBRA MZ ------------------------------
-+KEEP, MZBITS.
- PARAMETER (IQDROP=25, IQMARK=26, IQCRIT=27, IQSYSX=28)
-+KEEP, MZCA, IF=QTRHOLL. Process Master parameters
- COMMON /MZCA/ NQSTOR,NQOFFT(16),NQOFFS(16),NQALLO(16), NQIAM
- +, LQATAB,LQASTO,LQBTIS, LQWKTB,NQWKTB,LQWKFZ
- +, MQKEYS(3),NQINIT,NQTSYS,NQM99,NQPERM,NQFATA,NQCASE
- +, NQTRAC,MQTRAC(48)
- EQUIVALENCE (KQSP,NQOFFS(1))
-+KEEP, MZCA, IF=-QTRHOLL. Process Master parameters
- COMMON /MZCA/ NQSTOR,NQOFFT(16),NQOFFS(16),NQALLO(16), NQIAM
- +, LQATAB,LQASTO,LQBTIS, LQWKTB,NQWKTB,LQWKFZ
- +, MQKEYS(3),NQINIT,NQTSYS,NQM99,NQPERM
- +, NQFATA,NQCASE,NQTRAC
- EQUIVALENCE (KQSP,NQOFFS(1))
- COMMON /MZCA2/ MQTRAC(44)
- CHARACTER MQTRAC*8
-+KEEP, MZCB. Current Store and Division
- COMMON /MZCB/ JQSTOR,KQT,KQS, JQDIVI,JQDIVR
- +, JQKIND,JQMODE,JQDIVN,JQSHAR,JQSHR1,JQSHR2,NQRESV
- +, LQSTOR,NQFEND,NQSTRU,NQREF,NQLINK,NQMINR,LQ2END
- +, JQDVLL,JQDVSY,NQLOGL,NQSNAM(6)
- DIMENSION IQCUR(16)
- EQUIVALENCE (IQCUR(1),LQSTOR)
-+KEEP, MZCC. Store Control Table (matrix)
- COMMON /MZCC/ LQPSTO,NQPFEN,NQPSTR,NQPREF,NQPLK,NQPMIN,LQP2E
- +, JQPDVL,JQPDVS,NQPLOG,NQPNAM(6)
- +, LQSYSS(10), LQSYSR(10), IQTDUM(22)
- +, LQSTA(21), LQEND(20), NQDMAX(20),IQMODE(20)
- +, IQKIND(20),IQRCU(20), IQRTO(20), IQRNO(20)
- +, NQDINI(20),NQDWIP(20),NQDGAU(20),NQDGAF(20)
- +, NQDPSH(20),NQDRED(20),NQDSIZ(20)
- +, IQDN1(20), IQDN2(20), KQFT, LQFSTA(21)
- DIMENSION IQTABV(16)
- EQUIVALENCE (IQTABV(1),LQPSTO)
-+KEEP, EQLQMRF. MZ - 2 reference links
-C Links LQSYSR(1) and LQSYSR(2) are working links of MZ
-+KEEP, EQLQMST. MZ - 1 structural link (only)
- DIMENSION LQMST(9)
- EQUIVALENCE (LQMST(1),LQSYSS(2))
-+KEEP, EQLQT. TZ - 1 structural link (only)
- DIMENSION LQT(9)
- EQUIVALENCE (LQT(1),LQSYSS(3))
-+KEEP, EQLQF. FZ - 1 structural, 3 reference links
- EQUIVALENCE (LQFS,LQSYSS(4)), (LQFF,LQSYSR(4))
- +, (LQFI,LQSYSR(5)), (LQFX,LQSYSR(6))
-+KEEP, EQLQFORM. MZFORM - 1 structural link
- EQUIVALENCE (LQFORM,LQSYSS(5))
-+KEEP, EQLQR. RZ - 1 structural link
- EQUIVALENCE (LQRS,LQSYSS(7))
-+KEEP, EQLQRRF. RZ - 1 reference link (only)
- DIMENSION LQRRF(9)
- EQUIVALENCE (LQRRF(1),LQSYSR(7))
-+KEEP, EQLQZEP.
- EQUIVALENCE (LQZEP,LQSYSS(10))
-+KEEP, MZCL. Lift Name parameters
- COMMON /MZCL/ NQLN,NQLS,NQNIO,NQID,NQNL,NQNS,NQND,NQIOCH(16)
- +, LQSUP,NQBIA, NQIOSV(3)
-+KEEP, MZCN. Verify Name parameters
- COMMON /MZCN/ IQLN,IQLS,IQNIO,IQID,IQNL,IQNS,IQND, IQNX,IQFOUL
-+KEEP, MZCT. Memory Table parameters
- COMMON /MZCT/ MQDVGA,MQDVWI,JQSTMV,JQDVM1,JQDVM2,NQDVMV,IQFLIO
- +, MQDVAC,NQNOOP,IQPART,NQFREE, IQTBIT,IQTVAL
- +, IQTNMV,JQGAPM,JQGAPR,NQGAPN,NQGAP,IQGAP(5,4)
- +, LQTA,LQTE, LQRTA,LQTC1,LQTC2,LQRTE
- +, LQMTA,LQMTB,LQMTE,LQMTLU,LQMTBR
- +, LQMTC1,LQMTC2, NQFRTC,NQLIVE
-+KEEP, MZCWK. MQ Working area
- PARAMETER (NQWKTT=2560)
- COMMON /MZCWK/ IQWKTB(NQWKTT), IQWKFZ(NQWKTT)
-+KEEP, MZIOC.
- COMMON /MZIOC/ NWFOAV,NWFOTT,NWFODN,NWFORE,IFOCON(3)
- +, MFOSAV(2), JFOEND,JFOREP,JFOCUR,MFO(200)
-+KEEP, ZVFWKC. ZVERIF working area
- CHARACTER CHWARN*10, TEXTHD*50
- COMMON /ZVFWKC/MASKST,IFLHD,NFATAL,NWARN, LFAILS,LFAILD,IXVSTO
- +, JVMODE,IFLST,IFLLA,IFLDV,IFLBK
- +, LSTOLO,LSTOHI, JDESLA,LOCAR,LOCARR,LOCARE,LATMP
- +, LDIVLO,LDIVHI,MASKTO
- +, LBKLS,IDBK(2),NBKNN(4),LBKLN,LBKNX,IBKXX
- +, NAMEPR(2), CHWARN,TEXTHD
-+KEEP, ZEBQ.
- COMMON /ZEBQ/ IQFENC(4), LQ(100)
- DIMENSION IQ(92), Q(92)
- EQUIVALENCE (IQ(1),LQ(9)), (Q(1),IQ(1))
-+KEEP, QEQU.
- DIMENSION LQLUP(99), LQLORG(98),IQWIDN(97),IQWIDH(96)
- +, IQWNL(95), IQWNS(94), IQWND(93)
- EQUIVALENCE (LQLUP(8), LQLORG(7), IQWIDN(6), IQWIDH(5)
- +, IQWNL(4), IQWNS(3), IQWND(2), IQ(1))
-+KEEP, MQSYS.
-+CDE, MZBITS.
-+CDE, QUEST.
-+CDE, ZEBQ, MZCA, MZCB, MZCC.
-+KEEP, MQSYSH.
-+CDE, MZBITS.
-+CDE, QUEST.
-+CDE, ZEBQ, MZCA, MZCB.
-+KEEP, Q.
-+CDE, ZEBQ, MZCA, MZCB.
-+SELF. ------------- for ZEBRA trace-back ----------------------
-+KEEP, QTRACE, IF=-QTRHOLL, A6M. with check on capacity MQTRAC
- MQTRAC(NQTRAC+1) = NAMESR
- NQTRAC = NQTRAC + 1
- IF (NQTRAC.GE.41) CALL ZFATAL
-+KEEP, QTRACE.
- MQTRAC(NQTRAC+1) = NAMESR(1)
- MQTRAC(NQTRAC+2) = NAMESR(2)
- NQTRAC = NQTRAC + 2
- IF (NQTRAC.GE.41) CALL ZFATAL
-+KEEP, QTRACEQ, IF=-QTRHOLL, A6M. without check on capacity
- MQTRAC(NQTRAC+1) = NAMESR
- NQTRAC = NQTRAC + 1
-+KEEP, QTRACEQ.
- MQTRAC(NQTRAC+1) = NAMESR(1)
- MQTRAC(NQTRAC+2) = NAMESR(2)
- NQTRAC = NQTRAC + 2
-+KEEP, QTRACE99, IF=-QTRHOLL, A6M.
- 999 NQTRAC = NQTRAC - 1
-+KEEP, QTRACE99.
- 999 NQTRAC = NQTRAC - 2
-+KEEP, QTOFATAL, IF=QTRHOLL, IF=A6M.
- IQUEST(10)= NAMESR
- CALL ZFATAL
-+KEEP, QTOFATAL, IF=QTRHOLL.
- IQUEST(9) = NAMESR(1)
- IQUEST(10)= NAMESR(2)
- CALL ZFATAL
-+KEEP, QTOFATAL, IF=A6M.
- CALL UCTOH (NAMESR,IQUEST(10),6,6)
- CALL ZFATAL
-+KEEP, QTOFATAL.
- CALL UCTOH (NAMESR,IQUEST(9),4,8)
- CALL ZFATAL
-+SELF. ------------- for ZEBRA FZ ------------------------------
-+KEEP, FZSTAT.
- COMMON /FZSTAT/INFLUN, INFSTA, INFOFZ(40)
-+KEEP, FZCF.
- COMMON /FZCF/ LUNF, MSTATF,MEDIUF,IFIFOF,IDAFOF,IACMOF,IUPAKF
- +, IADOPF,IACTVF,INCBPF,LOGLVF,MAXREF, IOPTVF(24)
-+KEEP, FZCI.
- COMMON /FZCI/ LUNI,LUNNI,IXDIVI,LTEMPI,IEVFLI
- +, MSTATI,MEDIUI,IFIFOI,IDAFOI,IACMOI,IUPAKI
- +, IADOPI,IACTVI,INCBPI,LOGLVI,MAXREI, ISTENI
- +, LBPARI, L4STOI,L4STAI,L4CURI,L4ENDI
- +, IFLAGI,NFASTI,N4SKII,N4RESI,N4DONI,N4ENDI
- +, IOPTIE,IOPTIR,IOPTIS,IOPTIA,IOPTIT,IOPTID
- +, IOPTIF,IOPTIG,IOPTIH,IOPTI2(4)
- +, IDI(2),IPILI(4),NWTXI,NWSEGI,NWTABI,NWBKI,LENTRI
- +, NWUHCI,IOCHI(16),NWUMXI,NWUHI,NWIOI
- +, NWRDAI,NRECAI,LUHEAI,JRETCD,JERROR,NWERR
- PARAMETER (JAUIOC=50, JAUSEG=68, JAUEAR=130)
-+KEEP, FZCX.
- COMMON /FZCX/ LUNX,LUNNX,IXDIVX,LTEMPX,IEVFLX
- +, MSTATX,MEDIUX,IFIFOX,IDAFOX,IACMOX,IUPAKX
- +, IADOPX,IACTVX,INCBPX,LOGLVX,MAXREX
- +, NWFILX,ISTENX,LTEXTX,ICOPYX
- +, LBPARX,L4STOX,L4STAX,L4CURX,L4ENDX
- +, MODTBX,JFLGAX,IOPTXD,IOPTXI,IOPTXS,IOPTXZ,IOPTXM
- +, IOPTXL,IOPTXN,IOPTXP,IOPTXF,IOPTXT,IOPTXV(2)
- +, IDX(2),IPILX(4),NWTXX,NWSEGX,NWTABX,NWBKX,LENTRX
- +, NWUHCX,IOCHX(16),NWUHX,NWIOX,LUHEAX,JRUNX
-+KEEP, FZCSEG.
- COMMON /FZCSEG/NQSEG,IQSEGH(2,20),IQSEGD(20),IQSGLU,IQSGWK
-+KEEP, FZCOCC.
- COMMON /FZCOCC/NQOCC,IQOCDV(20),IQOCSP(20)
-+SELF. ------------- for ZEBRA JZ91 ------------------------------
-+KEEP, JZUC.
- COMMON /JZUC/ LQJZ,LQUP,LQDW,LQSV,LQAN, JQLEV,JQFLAG(10)
-+SELF. ------------- for ZEBRA RZ ------------------------------
-+KEEP, RZBUFF.
- COMMON /RZBUFF/ ITEST(8704)
-C
-+KEEP, RZCLUN.
- COMMON /RZCLUN/LUN,LREC,ISAVE,IMODEX,IRELAT,NHPWD,IHPWD(2)
- +, IZRECL,IMODEC,IMODEH
-C
-+KEEP, RZCH.
- COMMON /RZCH/ CHWOLD,CHL
- CHARACTER*255 CHWOLD,CHL
-C
-+KEEP, RZDIR.
- PARAMETER (NLPATM=100)
- COMMON /RZDIRN/NLCDIR,NLNDIR,NLPAT
- COMMON /RZDIRC/CHCDIR(NLPATM),CHNDIR(NLPATM),CHPAT(NLPATM)
- CHARACTER*16 CHNDIR, CHCDIR, CHPAT
-C
-+KEEP, RZK.
- PARAMETER (KUP=5,KPW1=7,KNCH=9,KDATEC=10,KDATEM=11,KQUOTA=12,
- + KRUSED=13,KWUSED=14,KMEGA=15,KRZVER=16,KIRIN=17,
- + KIROUT=18,KRLOUT=19,KIP1=20,KNFREE=22,KNSD=23,KLD=24,
- + KLB=25,KLS=26,KLK=27,KLF=28,KLC=29,KLE=30,KNKEYS=31,
- + KNWKEY=32,KKDES=33,KNSIZE=253,KEX=6,KNMAX=100)
-C
-+KEEP, RZCKEY.
- COMMON/RZCKEY/IHEAD(3),KEY(100),KEY2(100),KEYDUM(50)
-C
-+KEEP, RZCOUT.
- COMMON /RZCOUT/IP1,IR1,IR2,IROUT,IRLOUT,IOPTRR
-C
-+KEEP,RZCOUNT. I/O counters
- COMMON/RZCOUNT/RZXIO(2)
-C
-+KEEP,RZCSTR.
- PARAMETER (MAXFILES=128, MAXSTRIP=21)
- CHARACTER*128 RZNAMES(MAXFILES),RZSFILE(MAXSTRIP)
- COMMON/RZCSTRC/RZNAMES,RZSFILE
- COMMON/RZCSTRI/ISLAST,ISTRIP(MAXFILES),NSTRIP(MAXFILES),
- + NRSTRIP(MAXFILES)
-C
-+KEEP, RZCLXX.
- COMMON /RZCL/ LTOP,LRZ0,LCDIR,LRIN,LROUT,LFREE,LUSED,LPURG
- +, LTEMP,LCORD,LFROM
-+KEEP, RZCL.
-+CDE, MQSYS.
-C
-+CDE, RZCLXX, EQLQR.
-C
-+SELF. ------------- for ZEBRA CQ ------------------------------
-+KEEP, CQC.
- COMMON /CQC/ IQCIN,IQCOPT(8),NQCF,IQCHEK
-+KEEP, CQBKC.
- COMMON /CQBKC/ MMBANK(9), MMBKD(9), IDVV(21)
-+SELF. ------------- for memory ------------------------------
-+KEEP, HZC, IF=-QCDE. HISTOGRAM MANIPULATION
- COMMON /HZC/ NQHNH,NQHPAK(3),NQHGW,NQHNX,QHDX,QHXL,QHSTEP,NQHAND
- +, LQHH,LQHE,LQHC,LQHL,LQHLB,LQHLC,LQHD,LQHX,LQHT,LQHW
- +, IQHCUT,IQHXXX,IQHINT,NQHLAB,IQHFMT,IQHW(8)
- +, QHSMA,QHBIG,QHTOT,NQHNX2
- +, LQHCUT,NQHEXP,IQHOPT(7)
-+SELF. ------------- for defaults ------------------------------
-+KEEP, QCARDL, T=NOLIST.
-+SELF, IF=A4,A5,A6,A8,A10, IF=A10,A8,A6,A5.
-+SELF, IF=A5M,A6M,A8M, IF=A6M,A8M, IF=A8M.
-+SELF, IF=B32,B36,B48,B60,B64, IF=B64,B60,B48,B36.
-+SELF, IF=B36M,B48M,B60M, IF=B48M,B60M, IF=B60M.
-+PATCH,PAMEND.
-*
diff --git a/src/cfortran/Examples/Imakefile b/src/cfortran/Examples/Imakefile
deleted file mode 100644
index eca2e39..0000000
--- a/src/cfortran/Examples/Imakefile
+++ /dev/null
@@ -1,11 +0,0 @@
-FILES= chbook-example.c chigz-example.c \ @@\
- chplot-example.c hbook-cwn.c hbook-cwnc.c \ @@\
- hbook-ntuple.c minuit-fcn.c minuit-fcn.f minuit-main.c \ @@\
- pamain.c read_rwntuple.c \ @@\
-
-
-#ifndef CERNLIB_VAXVMS
-InstallIncludes($(FILES),$(CERN_INCLUDEDIR),cfortran/Examples)
-#else
-InstallIncludes($(FILES),$(CERN_INCLUDEDIR),cfortran.examples)
-#endif
diff --git a/src/cfortran/Examples/chbook-example.c b/src/cfortran/Examples/chbook-example.c
deleted file mode 100644
index 3c6ddf1..0000000
--- a/src/cfortran/Examples/chbook-example.c
+++ /dev/null
@@ -1,48 +0,0 @@
-/*
- * This example demonstrate how to call HBOOK from C (histogram part).
- *
- * For question/problems contact: Heplib.Support at cern.ch
- *
- */
-
-#include <stdlib.h>
-#include <cfortran.h>
-#include <hbook.h>
-
-#if defined(__hpux) || defined(_IBMR2)
-# define extname
-#endif
-
-#define PAWC_SIZE 50000
-
-typedef struct { float PAW[PAWC_SIZE]; } PAWC_DEF;
-#define PAWC COMMON_BLOCK(PAWC,pawc)
-COMMON_BLOCK_DEF(PAWC_DEF,PAWC);
-
-#if defined(__vms) || defined(vms)
-/* On VMS rand has a range of 2**31 */
-# define RAND_RANGE 2146483648.
-#else
-# define RAND_RANGE 32768.
-#endif
-
-main()
-{
- int hid=1;
- int i,j;
- float r;
-/*
- * Some C++ compiler generates a memset error when a character string
- * is passed directly as argument to a F77 function. Using an intermediate
- * variable make it work.
- */
-
- HLIMIT(PAWC_SIZE);
- HBOOK1(hid,"Some random distribution",20000,-4.,4.,0.);
-
- for (i=0;i<100000;i++){
- for (j=0,r=0.;j<10;r += rand()/RAND_RANGE -0.5 ,j++);
- HFILL(hid,r,0.,1.);
- }
- HPRINT(hid);
-}
diff --git a/src/cfortran/Examples/chigz-example.c b/src/cfortran/Examples/chigz-example.c
deleted file mode 100644
index 963749a..0000000
--- a/src/cfortran/Examples/chigz-example.c
+++ /dev/null
@@ -1,52 +0,0 @@
-/*
- * This example demonstrate how to call HIGZ from C.
- *
- * For question/problems contact: Heplib.Support at cern.ch
- *
- */
-
-#include <cfortran.h>
-#include <packlib.h>
-#include <higz.h>
-
-#if defined(__hpux) || defined(_IBMR2)
-# define extname
-#endif
-
-#define PAWC_SIZE 50000
-
-typedef struct { float PAW[PAWC_SIZE]; } PAWC_DEF;
-#define PAWC COMMON_BLOCK(PAWC,pawc)
-COMMON_BLOCK_DEF(PAWC_DEF,PAWC);
-
-main()
-{
- int itype,istat;
- char c;
-/*
- * Initialisation
- */
- MZEBRA(-3);
- MZPAW(PAWC_SIZE," ");
- IGINIT(0);
- IGWKTY(itype);
- IGSSE(6, itype);
-/*
- * Some simple drawing
- */
- KUOPEN(77,"chigz-example.ps","NEW",istat);
- IGMETA(77,-111);
- IGRNG(21., 21.);
- IGBOX(1.0, 20.0, 1.0, 20.0);
- IGBOX(2.0, 19.0, 2.0, 19.0);
- IGBOX(3.0, 18.0, 3.0, 18.0);
- IGBOX(4.0, 17.0, 4.0, 17.0);
- IGSET("TXAL",23.);
- IGSET("CHHE",0.5);
- ITX (10.5,10.5,"HIGZ called from a C program");
- IGTERM();
- IGMETA(999,0);
- KUCLOS(77," ",1);
- c = getchar();
- IGEND();
-}
diff --git a/src/cfortran/Examples/chplot-example.c b/src/cfortran/Examples/chplot-example.c
deleted file mode 100644
index 674daaf..0000000
--- a/src/cfortran/Examples/chplot-example.c
+++ /dev/null
@@ -1,65 +0,0 @@
-/*
- * This example demonstrate how to call HPLOT from C.
- *
- * For question/problems contact: Heplib.Support at cern.ch
- *
- */
-
-#include <stdlib.h>
-#include <cfortran.h>
-#include <graflib.h>
-#include <packlib.h>
-#include <kernlib.h>
-
-#if defined(__hpux) || defined(_IBMR2)
-# define extname
-#endif
-
-#define PAWC_SIZE 50000
-
-typedef struct { float PAW[PAWC_SIZE]; } PAWC_DEF;
-#define PAWC COMMON_BLOCK(PAWC,pawc)
-COMMON_BLOCK_DEF(PAWC_DEF,PAWC);
-
-main()
-{
- int istat;
- char c;
-
- HLIMIT(PAWC_SIZE);
- HPLINT(4);
-/*
- * Histograms booking and filling
- */
- HBOOK1(1,"x",100,-4.,4.,0.);
- HBOOK1(2,"y",100,-4.,4.,0.);
- HBOOK1(3,"(x-y)/(x+y)",100,-6.,6.,0.);
- fill();
-/*
- * Histograms plotting
- */
- KUOPEN(77,"chplot-example.ps","NEW",istat);
- IGMETA(77,-111);
- HPLZON(2,2,1," ");
- HPLOT(1," "," ",0);
- HPLOT(2," "," ",0);
- HPLZON(1,2,2,"S");
- HPLOT(3," "," ",0);
- IGMETA(999,0);
- KUCLOS(77," ",1);
- c = getchar();
- HPLEND();
-}
-
-fill()
-{
- float x,y;
- int i;
-
- for ( i=1; i<1001; i++) {
- RANNOR(x,y);
- HF1(1,x,1.);
- HF1(2,y,1.);
- HF1(3,(x-y)/(x+y),1.);
- }
-}
diff --git a/src/cfortran/Examples/hbook-cwn.c b/src/cfortran/Examples/hbook-cwn.c
deleted file mode 100644
index 8d4fa8c..0000000
--- a/src/cfortran/Examples/hbook-cwn.c
+++ /dev/null
@@ -1,39 +0,0 @@
-#include <stdlib.h>
-#include <stdio.h>
-#include <cfortran.h>
-#include <packlib.h>
-
-#define PAWC_SIZE 50000
-
-typedef float PAWC_DEF[PAWC_SIZE];
-#define PAWC COMMON_BLOCK(PAWC,pawc)
-COMMON_BLOCK_DEF(PAWC_DEF,PAWC);
-
-main()
-{
- const int nmax = 300;
- int record_size=1024;
- int istat, n, icycle;
-
- struct { float r; } mycwn;
-
- HLIMIT(PAWC_SIZE);
-
- HROPEN(1,"MYCWN","mycwn.hbook","NX",record_size,istat);
- if (istat) {
- printf("Error in opening file ...");
- return EXIT_FAILURE;
- }
-
- HBNT(1,"MYCWN"," ");
- HBNAME(1,"BLOCK",mycwn.r,"R:R*4");
-
- for (n=0; n<=nmax; n++) {
- mycwn.r = n*n;
- HFNT(1);
- }
-
- HROUT(0,icycle," ");
- HREND("MYCWN");
- KUCLOS(1," ",1);
-}
diff --git a/src/cfortran/Examples/hbook-cwnc.c b/src/cfortran/Examples/hbook-cwnc.c
deleted file mode 100644
index 951c375..0000000
--- a/src/cfortran/Examples/hbook-cwnc.c
+++ /dev/null
@@ -1,68 +0,0 @@
-#include <stdlib.h>
-#include <stdio.h>
-#include <cfortran.h>
-#include <packlib.h>
-
-#define PAWC_SIZE 50000
-
-typedef float PAWC_DEF[PAWC_SIZE];
-#define PAWC COMMON_BLOCK(PAWC,pawc)
-COMMON_BLOCK_DEF(PAWC_DEF,PAWC);
-
-main()
-{
- int record_size=1024;
- int istat, icycle;
-
- HLIMIT(PAWC_SIZE);
-
- HROPEN(1,"MYCWN","mycwn.hbook","NX",record_size,istat);
- if (istat) {
- printf("Error in opening file ...");
- return EXIT_FAILURE;
- }
-
- HBNT(1,"MYCWN"," ");
-
- {
- /* Struct is required if defining more than one variable
- within a single call to HBNAMC or HBNAME.
- Struct may also be required in order to introduce
- an aligned variable, see 'int align' below,
- which ensures that the subsequent character arrays are aligned.
- HBNAMC requires the characters to be aligned.
- */
- struct { int align; char a[8]; char b[3][4];} m;
- struct { int align; char c[4]; } n;
- HBNAMC(1,"BLOCK",m.a,"A:C*8,B(3):C");
- HBNAMC(1,"BLOCK",n.c,"C:C");
-
-
- /* Since HFNT() gets the character info. via
- an adress stored in the HBNAMC call,
- there is no way that cfortran.h can convert
- from C strings to Fortran strings.
- The character arrays have the same number of bytes in C as they do in
- Fortran. i.e. there is no room for C's trailing '\0' character.
- So use strncpy() and blank pad until the ed of the array.
- */
-
- strncpy(m.a, "hiho1 ",8);
- strncpy(m.b[0], "ba ",4);
- strncpy(m.b[1], "bb ",4); /* bb and bc don't show in PAW. */
- strncpy(m.b[2], "bc ",4); /* Either PAW is broken, or how I use cfortran.h.*/
- strncpy(n.c, "coco",4);
- HFNT(1);
-
- strncpy(m.a, "hiho2 ",8);
- strncpy(m.b[0], "ba2 ",4);
- strncpy(m.b[1], "bb2 ",4); /* Again bb2 and bc2 don't show in PAW. */
- strncpy(m.b[2], "bc2 ",4);
- strncpy(n.c, "coc2",4);
- HFNT(1);
- }
-
- HROUT(0,icycle," ");
- HREND("MYCWN");
- KUCLOS(1," ",1);
-}
diff --git a/src/cfortran/Examples/hbook-ntuple.c b/src/cfortran/Examples/hbook-ntuple.c
deleted file mode 100644
index 0e70ab0..0000000
--- a/src/cfortran/Examples/hbook-ntuple.c
+++ /dev/null
@@ -1,48 +0,0 @@
-/*
- * This example demonstrate how to call HBOOK from C (ntuple part).
- *
- * For question/problems contact: Heplib.Support at cern.ch
- *
- */
-
-#include <stdlib.h>
-#include <cfortran.h>
-#include <packlib.h>
-
-#define PAWC_SIZE 50000
-
-typedef struct { float PAW[PAWC_SIZE]; } PAWC_DEF;
-#define PAWC COMMON_BLOCK(PAWC,pawc)
-COMMON_BLOCK_DEF(PAWC_DEF,PAWC);
-
-main()
-{
- int hid=1,istat=0,icycle=0;
- int i,i1,j;
- int nvar;
- float r[3];
- char chtag_in[3][6]={"X","Y","Z"};
- char chtag_out[5][8],chtitl[80];
- float rmin[5],rmax[5];
- int record_size=1024;
-
- HLIMIT(PAWC_SIZE);
- HROPEN(1,"example","ntuple-example.hbook","N",record_size,istat);
- HBOOKN(hid," An Ntuple",3," ",5000,chtag_in);
-
- for (i=0;i<10000;i++){
- for(i1=0;i1<3;i1++)
- for (j=0,r[i1]=0.;j<10;r[i1] += rand()/32768. -0.5 ,j++);
- HFN(hid,r);
- }
- nvar=5;
- HGIVEN(hid,chtitl,nvar,chtag_out,rmin,rmax);
- printf(" title obtained:%s\n variables %d\ntags:>%s< >%s< >%s<\n",
- chtitl,nvar,chtag_out[0],chtag_out[1],chtag_out[2]);
- printf(" rmin: %e %e %e\n",rmin[0],rmin[1],rmin[2]);
- printf(" rmax: %e %e %e\n",rmax[0],rmax[1],rmax[2]);
-
- HROUT(0,icycle," ");
- HREND("example");
- KUCLOS(1," ",1);
-}
diff --git a/src/cfortran/Examples/minuit-fcn.c b/src/cfortran/Examples/minuit-fcn.c
deleted file mode 100644
index a58cc66..0000000
--- a/src/cfortran/Examples/minuit-fcn.c
+++ /dev/null
@@ -1,42 +0,0 @@
-#include <math.h>
-#include <string.h>
-#include <cfortran.h>
-
-/* Authors: William Hanlon <whanlon at cosmic.utah.edu>,
- * Gunter Folger <Gunter.Folger at cern.ch>
- */
-
-/* prototype for benefit of the wrapper */
-void fcn(int npar, double grad[3], double * fcnval,
- double xval[2],int iflag, void (*Dummy)());
-
-/* this macro creates a wrapper function called fcn_, which in turn calls the
- * function fcn defined below. The wrapper properly passes ints by value to
- * fcn, while it receives ints by reference from the fortran calling routine.
- */
-FCALLSCSUB6(fcn,FCN,fcn,INT,DOUBLEV,PDOUBLE,DOUBLEV,INT,ROUTINE)
-
-
-void fcn(int npar, double grad[3], double * fcnval,
- double xval[2],int iflag, void (*Dummy)())
-{
- double Xc=1.11,Yc=3.14;
-
- switch(iflag) {
- case 1:
-/*
- * Initialise.
- */
- printf(" fcn_c called to initialise\n");
- break;
- case 2:
-/*
- * derivatives...
- */
- break;
-
- default:
- *fcnval = pow(xval[0]-Xc,2.) + pow((xval[1]-Yc),3.)*xval[1];
- break;
- }
-}
diff --git a/src/cfortran/Examples/minuit-fcn.f b/src/cfortran/Examples/minuit-fcn.f
deleted file mode 100644
index 8175b6a..0000000
--- a/src/cfortran/Examples/minuit-fcn.f
+++ /dev/null
@@ -1,27 +0,0 @@
- Subroutine FCN(Npar,Grad,Fval,Xval,Iflag,Futil)
- Implicit Double Precision (a-h,o-z)
-
- Dimension Xval(*), Grad(*)
-
- Data Xc,Yc/1.11D0,3.14d0/
-*
-* demo FCN
-* Gunter Folger, December 94
-*
-
- if ( Iflag.eq.1 ) Then
-*
-* Initialaise.
-*
- Elseif ( Iflag.eq.2) Then
-*
-* derivatives...
-*
- Endif
-
- Fval = (Xval(1)-Xc)**2 + (Xval(2)-Yc)**3*Xval(2)
-
- Return
-
-*
- End
diff --git a/src/cfortran/Examples/minuit-main.c b/src/cfortran/Examples/minuit-main.c
deleted file mode 100644
index 69b9af0..0000000
--- a/src/cfortran/Examples/minuit-main.c
+++ /dev/null
@@ -1,32 +0,0 @@
-/*
- * This example demonstrate how to call MINUIT from C.
- *
- * For question/problems contact: Heplib.Support at cern.ch
- *
- *
- * Authors: William Hanlon <whanlon at cosmic.utah.edu>,
- * Gunter Folger <Gunter.Folger at cern.ch>
- */
-
-#include "cfortran.h"
-#include "minuit.h"
-#define Ncont 20
-int main()
-{
- int error_flag=0;
- PROTOCCALLSFSUB0(FCN,fcn)
- struct {
- double x[Ncont];
- double y[Ncont];
- int n;
- } pts;
- double f_null=0.;
-
- MNINIT(5,6,7); /* initialise */
- MNSETI(" Minuit Example "); /* set title */
- MNPARM(1,"X",0.,.1,f_null,f_null,error_flag);
- MNPARM(2,"-Y-",0.,.01,f_null,f_null,error_flag);
- MNEXCM(C_FUNCTION(FCN,fcn),"MIGRAD",0,0,error_flag,0);
- MNEXCM(C_FUNCTION(FCN,fcn),"MINOS",0,0,error_flag,0);
- MNCONT(C_FUNCTION(FCN,fcn),1,2,Ncont,pts.x[0],pts.y[0],pts.n, 0);
-}
diff --git a/src/cfortran/Examples/pamain.c b/src/cfortran/Examples/pamain.c
deleted file mode 100644
index 1d6c386..0000000
--- a/src/cfortran/Examples/pamain.c
+++ /dev/null
@@ -1,23 +0,0 @@
-#include <stdlib.h>
-#include <cfortran.h>
-#include <paw.h>
-#include <kuip.h>
-
-#define PAWC_SIZE 9000000
-
-typedef struct { float PAW[PAWC_SIZE]; } PAWC_DEF;
-#define PAWC COMMON_BLOCK(PAWC,pawc)
-COMMON_BLOCK_DEF(PAWC_DEF,PAWC);
-
-int main()
-{
- int iwtyp;
-
- PAW(PAWC_SIZE,iwtyp);
-
- KUWHAG();
-
- PAEXIT();
-
- return 0;
-}
diff --git a/src/cfortran/Examples/read_rwntuple.c b/src/cfortran/Examples/read_rwntuple.c
deleted file mode 100644
index 9ea276e..0000000
--- a/src/cfortran/Examples/read_rwntuple.c
+++ /dev/null
@@ -1,60 +0,0 @@
-#include <stdlib.h>
-#include <cfortran.h>
-#include <packlib.h>
-
-#define Memory_Size 50000
-#define Number_of_Variables 27
-#define Number_of_Events 10
-
-typedef struct { float PAW[Memory_Size]; } PAWC_DEF;
-#define PAWC COMMON_BLOCK(PAWC,pawc)
-COMMON_BLOCK_DEF(PAWC_DEF,PAWC);
-
-main()
-{
- int istat = 0;
- int icycle = 0;
- int i,j,Ierr;
- int IDN = 0;
- int record_size = 1024;
-
- float Event[Number_of_Variables];
- char Chtags[Number_of_Variables][3] =
- {"A1","A2","A3","A4","A5","A6","A7","A8","A9",
- "B1","B2","B3","B4","B5","B6","B7","B8","B9",
- "C1","C2","C3","C4","C5","C6","C7","C8","C9"};
-
- HLIMIT(Memory_Size);
-
- HROPEN(1,"EXAMPLE","example.hbook","N",record_size,istat);
- if (istat != 0) {
- printf("Error in opening file ...\n");
- exit;
- }
-
- HBOOKN(10,"Ntuple example",Number_of_Variables,"//EXAMPLE",9000,Chtags);
-
- for (i=1; i<=Number_of_Events; i++) {
- for (j=0; j<Number_of_Variables; j++) {
- Event[j] = (float)i*(float)(j+1);
- }
- HFN(10,Event);
- }
-
- HROUT(0,icycle," ");
- HREND("EXAMPLE");
- KUCLOS(1," ",1);
-/*
- * Read back the ntuple 10
- */
- HROPEN(1,"EXAMPLE","example.hbook","U",record_size,istat);
- HRIN(10,9999,0);
-
- for (i=1; i<=10; i++) {
- HGN(10,IDN,i,Event,Ierr);
- printf("%f %f %f \n", Event[0],Event[1],Event[2]);
- }
-
- HREND("EXAMPLE");
- KUCLOS(1," ",1);
-}
diff --git a/src/cfortran/Imakefile b/src/cfortran/Imakefile
deleted file mode 100644
index 65a7655..0000000
--- a/src/cfortran/Imakefile
+++ /dev/null
@@ -1,17 +0,0 @@
-#define IHaveSubdirs
-
-#ifndef CERNLIB_VAXVMS
-SUBDIRS= Examples
-#else
-SUBDIRS= $e$xamples
-#endif
-
-FILES= cfortran.h \ @@\
- comis.h cspack.h \ @@\
- geant315.h geant321.h gen.h hbook.h higz.h hplot.h \ @@\
- jetset74.h kernlib.h lapack.h lepto62.h minuit.h packlib.h paw.h \ @@\
- graflib.h kuip.h zebra.h
-
-InstallIncludes($(FILES),$(CERN_INCLUDEDIR),cfortran)
-
-InstallIncludeSubdirs($(SUBDIRS))
diff --git a/src/cfortran/cfortran.doc b/src/cfortran/cfortran.doc
deleted file mode 100755
index 6c6f4b3..0000000
--- a/src/cfortran/cfortran.doc
+++ /dev/null
@@ -1,2051 +0,0 @@
-/* cfortran.doc 4.3 */
-/* www-zeus.desy.de/~burow OR anonymous ftp at zebra.desy.de */
-/* Burkhard Burow burow at desy.de 1990 - 1998. */
-
-
- cfortran.h : Interfacing C or C++ and FORTRAN
-
-Supports: Alpha and VAX VMS, Alpha OSF, DECstation and VAX Ultrix, IBM RS/6000,
- Silicon Graphics, Sun, CRAY, Apollo, HP9000, LynxOS, Convex, Absoft,
- f2c, g77, NAG f90, PowerStation Fortran with Visual C++, NEC SX-4,
- Portland Group.
-
-C and C++ are generally equivalent as far as cfortran.h is concerned.
-Unless explicitly noted otherwise, mention of C implicitly includes C++.
-C++ compilers tested include:
- SunOS> CC +p +w # Clean compiles.
- IRIX> CC # Clean compiles.
- IRIX> CC -fullwarn # Still some warnings to be overcome.
- GNU> g++ -Wall # Compiles are clean, other than warnings for unused
- # cfortran.h static routines.
-
-N.B.: The best documentation on interfacing C or C++ and Fortran is in
- the chapter named something like 'Interfacing C and Fortran'
- to be found in the user's guide of almost every Fortran compiler.
- Understanding this information for one or more Fortran compilers
- greatly clarifies the aims and actions of cfortran.h.
- Such a chapter generally also addresses issues orthogonal to cfortran.h,
- for example the order of array indices, the index of the first element,
- as well as compiling and linking issues.
-
-
-0 Short Summary of the Syntax Required to Create the Interface
---------------------------------------------------------------
-
-e.g. Prototyping a FORTRAN subroutine for C:
-
-/* PROTOCCALLSFSUBn is optional for C, but mandatory for C++. */
-
- PROTOCCALLSFSUB2(SUB_NAME,sub_name,STRING,PINT)
-#define SUB_NAME(A,B) CCALLSFSUB2(SUB_NAME,sub_name,STRING,PINT, A,B)
-
- ^ - -
- number of arguments _____| | STRING BYTE PBYTE BYTEV(..)|
- / | STRINGV DOUBLE PDOUBLE DOUBLEV(..)|
- / | PSTRING FLOAT PFLOAT FLOATV(..)|
- types of arguments ____ / | PNSTRING INT PINT INTV(..)|
- \ | PPSTRING LOGICAL PLOGICAL LOGICALV(..)|
- \ | PSTRINGV LONG PLONG LONGV(..)|
- \ | ZTRINGV SHORT PSHORT SHORTV(..)|
- | PZTRINGV ROUTINE PVOID SIMPLE |
- - -
-
-
-e.g. Prototyping a FORTRAN function for C:
-/* PROTOCCALLSFFUNn is mandatory for both C and C++. */
-PROTOCCALLSFFUN1(INT,FUN_NAME,fun_name,STRING)
-#define FUN_NAME(A) CCALLSFFUN1(FUN_NAME,fun_name,STRING, A)
-
-e.g. calling FUN_NAME from C: {int a; a = FUN_NAME("hello");}
-
-
-e.g. Creating a FORTRAN-callable wrapper for
- a C function returning void, with a 7 dimensional integer array argument:
- [Not supported from C++.]
-FCALLSCSUB1(csub_name,CSUB_NAME,csub_name,INTVVVVVVV)
-
-
-e.g. Creating a FORTRAN-callable wrapper for other C functions:
-FCALLSCFUN1(STRING,cfun_name,CFUN_NAME,cfun_name,INT)
- [ ^-- BYTE, DOUBLE, FLOAT, INT, LOGICAL, LONG, SHORT, VOID
- are other types returned by functions. ]
-
-
-e.g. COMMON BLOCKs:
-FORTRAN: common /fcb/ v,w,x
- character *(13) v, w(4), x(3,2)
-C:
-typedef struct { char v[13],w[4][13],x[2][3][13]; } FCB_DEF;
-#define FCB COMMON_BLOCK(FCB,fcb)
-COMMON_BLOCK_DEF(FCB_DEF,FCB);
-FCB_DEF FCB; /* Define, i.e. allocate memory, in exactly one *.c file. */
-
-e.g. accessing FCB in C: printf("%.13s",FCB.v);
-
-
-
-I Introduction
---------------
-
-cfortran.h is an easy-to-use powerful bridge between C and FORTRAN.
-It provides a completely transparent, machine independent interface between
-C and FORTRAN routines (= subroutines and/or functions) and global data,
-i.e. structures and COMMON blocks.
-
-The complete cfortran.h package consists of 4 files: the documentation in
-cfortran.doc, the engine cfortran.h, examples in cfortest.c and
-cfortex.f/or. [cfortex.for under VMS, cfortex.f on other machines.]
-
-The cfortran.h package continues to be developed. The most recent version is
-available via www at http://www-zeus.desy.de/~burow
-or via anonymous ftp at zebra.desy.de (131.169.2.244).
-
-The examples may be run using one of the following sets of instructions:
-
-N.B. Unlike earlier versions, cfortran.h 3.0 and later versions
- automatically uses the correct ANSI ## or pre-ANSI /**/
- preprocessor operator as required by the C compiler.
-
-N.B. As a general rule when trying to determine how to link C and Fortran,
- link a trivial Fortran program using the Fortran compilers verbose option,
- in order to see how the Fortran compiler drives the linker. e.g.
- unix> cat f.f
- END
- unix> f77 -v f.f
- .. lots of info. follows ...
-
-N.B. If using a C main(), i.e. Fortran PROGRAM is not entry of the executable,
- and if the link bombs with a complaint about
- a missing "MAIN" (e.g. MAIN__, MAIN_, f90_main or similar),
- then Fortran has hijacked the entry point to the executable
- and wishes to call the rest of the executable via "MAIN".
- This can usually be satisfied by doing e.g. 'cc -Dmain=MAIN__ ...'
- but often kills the command line arguments in argv and argc.
- The f77 verbose option, usually -v, may point to a solution.
-
-
-RS/6000> # Users are strongly urged to use f77 -qextname and cc -Dextname
-RS/6000> # Use -Dextname=extname if extname is a symbol used in the C code.
-RS/6000> xlf -c -qextname cfortex.f
-RS/6000> cc -c -Dextname cfortest.c
-RS/6000> xlf -o cfortest cfortest.o cfortex.o && cfortest
-
-DECFortran> #Only DECstations with DECFortran for Ultrix RISC Systems.
-DECFortran> cc -c -DDECFortran cfortest.c
-DECFortran> f77 -o cfortest cfortest.o cfortex.f && cfortest
-
-IRIX xxxxxx 5.2 02282015 IP20 mips
-MIPS> # DECstations and Silicon Graphics using the MIPS compilers.
-MIPS> cc -o cfortest cfortest.c cfortex.f -lI77 -lU77 -lF77 && cfortest
-MIPS> # Can also let f77 drive linking, e.g.
-MIPS> cc -c cfortest.c
-MIPS> f77 -o cfortest cfortest.o cfortex.f && cfortest
-
-Apollo> # Some 'C compiler 68K Rev6.8' break. [See Section II o) Notes: Apollo]
-Apollo> f77 -c cfortex.f && cc -o cfortest cfortest.c cfortex.o && cfortest
-
-VMS> define lnk$library sys$library:vaxcrtl
-VMS> cc cfortest.c
-VMS> fortran cfortex.for
-VMS> link/exec=cfortest cfortest,cfortex
-VMS> run cfortest
-
-OSF1 xxxxxx V3.0 347 alpha
-Alpha/OSF> # Probably better to let cc drive linking, e.g.
-Alpha/OSF> f77 -c cfortex.f
-Alpha/OSF> cc -o cfortest cfortest.c cfortex.o -lUfor -lfor -lFutil -lots -lm
-Alpha/OSF> cfortest
-Alpha/OSF> # Else may need 'cc -Dmain=MAIN__' to let f77 drive linking.
-
-Sun> # Some old cc(1) need a little help. [See Section II o) Notes: Sun]
-Sun> f77 -o cfortest cfortest.c cfortex.f -lc -lm && cfortest
-Sun> # Some older f77 may require 'cc -Dmain=MAIN_'.
-
-CRAY> cft77 cfortex.f
-CRAY> cc -c cfortest.c
-CRAY> segldr -o cfortest.e cfortest.o cfortex.o
-CRAY> ./cfortest.e
-
-NEC> cc -c -Xa cfortest.c
-NEC> f77 -o cfortest cfortest.o cfortex.f && cfortest
-
-VAX/Ultrix/cc> # For cc on VAX Ultrix only, do the following once to cfortran.h.
-VAX/Ultrix/cc> mv cfortran.h cftmp.h && grep -v "^#pragma" <cftmp.h >cfortran.h
-
-VAX/Ultrix/f77> # In the following, 'CC' is either 'cc' or 'gcc -ansi'. NOT'vcc'
-VAX/Ultrix/f77> CC -c -Dmain=MAIN_ cfortest.c
-VAX/Ultrix/f77> f77 -o cfortest cfortex.f cfortest.o && cfortest
-
-LynxOS> # In the following, 'CC' is either 'cc' or 'gcc -ansi'.
-LynxOS> # Unfortunately cc is easily overwhelmed by cfortran.h,
-LynxOS> # and won't compile some of the cfortest.c demos.
-LynxOS> f2c -R cfortex.f
-LynxOS> CC -Dlynx -o cfortest cfortest.c cfortex.c -lf2c && cfortest
-
-HP9000> # Tested with HP-UX 7.05 B 9000/380 and with A.08.07 A 9000/730
-HP9000> # CC may be either 'c89 -Aa' or 'cc -Aa'
-HP9000> # Depending on the compiler version, you may need to include the
-HP9000> # option '-tp,/lib/cpp' or worse, you'll have to stick to the K&R C.
-HP9000> # [See Section II o) Notes: HP9000]
-HP9000> # Users are strongly urged to use f77 +ppu and cc -Dextname
-HP9000> # Use -Dextname=extname if extname is a symbol used in the C code.
-HP9000> CC -Dextname -c cfortest.c
-HP9000> f77 +ppu cfortex.f -o cfortest cfortest.o && cfortest
-HP9000> # Older f77 may need
-HP9000> f77 -c cfortex.f
-HP9000> CC -o cfortest cfortest.c cfortex.o -lI77 -lF77 && cfortest
-
-HP0000> # If old-style f77 +800 compiled objects are required:
-HP9000> # #define hpuxFortran800
-HP9000> cc -c -Aa -DhpuxFortran800 cfortest.c
-HP9000> f77 +800 -o cfortest cfortest.o cfortex.f
-
-f2c> # In the following, 'CC' is any C compiler.
-f2c> f2c -R cfortex.f
-f2c> CC -o cfortest -Df2cFortran cfortest.c cfortex.c -lf2c && cfortest
-
-Portland Group $ # Presumably other C compilers also work.
-Portland Group $ pgcc -DpgiFortran -c cfortest.c
-Portland Group $ pgf77 -o cfortest cfortex.f cfortest.o && cfortest
-
-NAGf90> # cfortex.f is distributed with Fortran 77 style comments.
-NAGf90> # To convert to f90 style comments do the following once to cfortex.f:
-NAGf90> mv cfortex.f cf_temp.f && sed 's/^C/\!/g' cf_temp.f > cfortex.f
-NAGf90> # In the following, 'CC' is any C compiler.
-NAGf90> CC -c -DNAGf90Fortran cfortest.c
-NAGf90> f90 -o cfortest cfortest.o cfortex.f && cfortest
-
-PC> # On a PC with PowerStation Fortran and Visual_C++
-PC> cl /c cftest.c
-PC> fl32 cftest.obj cftex.for
-
-GNU> # GNU Fortran
-GNU> # See Section VI caveat on using 'gcc -traditional'.
-GNU> gcc -ansi -Wall -O -c -Df2cFortran cfortest.c
-GNU> g77 -ff2c -o cfortest cfortest.o cfortex.f && cfortest
-
-AbsoftUNIX> # Absoft Fortran for all UNIX based operating systems.
-AbsoftUNIX> # e.g. Linux or Next on Intel or Motorola68000.
-AbsoftUNIX> # Absoft f77 -k allows Fortran routines to be safely called from C.
-AbsoftUNIX> gcc -ansi -Wall -O -c -DAbsoftUNIXFortran cfortest.c
-AbsoftUNIX> f77 -k -o cfortest cfortest.o cfortex.f && cfortest
-
-AbsoftPro> # Absoft Pro Fortran for MacOS
-AbsoftPro> # Use #define AbsoftProFortran
-
-CLIPPER> # INTERGRAPH CLIX using CLIPPER C and Fortran compilers.
-CLIPPER> # N.B. - User, not cfortran.h, is responsible for
-CLIPPER> # f77initio() and f77uninitio() if required.
-CLIPPER> # - LOGICAL values are not mentioned in CLIPPER doc.s,
-CLIPPER> # so they may not yet be correct in cfortran.h.
-CLIPPER> # - K&R mode (-knr or Ac=knr) breaks FLOAT functions
-CLIPPER> # (see CLIPPER doc.s) and cfortran.h does not fix it up.
-CLIPPER> # [cfortran.h ok for old sun C which made the same mistake.]
-CLIPPER> acc cfortest.c -c -DCLIPPERFortran
-CLIPPER> af77 cfortex.f cfortest.o -o cfortest
-
-
-By changing the SELECTion ifdef of cfortest.c and recompiling one can try out
-a few dozen different few-line examples.
-
-
-
-The benefits of using cfortran.h include:
-1. Machine/OS/compiler independent mixing of C and FORTRAN.
-
-2. Identical (within syntax) calls across languages, e.g.
-C FORTRAN
- CALL HBOOK1(1,'pT spectrum of pi+',100,0.,5.,0.)
-/* C*/
- HBOOK1(1,"pT spectrum of pi+",100,0.,5.,0.);
-
-3. Each routine need only be set up once in its lifetime. e.g.
-/* Setting up a FORTRAN routine to be called by C.
- ID,...,VMX are merely the names of arguments.
- These tags must be unique w.r.t. each other but are otherwise arbitrary. */
-PROTOCCALLSFSUB6(HBOOK1,hbook1,INT,STRING,INT,FLOAT,FLOAT,FLOAT)
-#define HBOOK1(ID,CHTITLE,NX,XMI,XMA,VMX) \
- CCALLSFSUB6(HBOOK1,hbook1,INT,STRING,INT,FLOAT,FLOAT,FLOAT, \
- ID,CHTITLE,NX,XMI,XMA,VMX)
-
-4. Source code is NOT required for the C routines exported to FORTRAN, nor for
- the FORTRAN routines imported to C. In fact, routines are most easily
- prototyped using the information in the routines' documentation.
-
-5. Routines, and the code calling them, can be coded naturally in the language
- of choice. C routines may be coded with the natural assumption of being
- called only by C code. cfortran.h does all the required work for FORTRAN
- code to call C routines. Similarly it also does all the work required for C
- to call FORTRAN routines. Therefore:
- - C programmers need not embed FORTRAN argument passing mechanisms into
- their code.
- - FORTRAN code need not be converted into C code. i.e. The honed and
- time-honored FORTRAN routines are called by C.
-
-6. cfortran.h is a single ~1700 line C include file; portable to most
- remaining, if not all, platforms.
-
-7. STRINGS and VECTORS of STRINGS along with the usual simple arguments to
- routines are supported as are functions returning STRINGS or numbers. Arrays
- of pointers to strings and values of structures as C arguments, will soon be
- implemented. After learning the machinery of cfortran.h, users can expand
- it to create custom types of arguments. [This requires no modification to
- cfortran.h, all the preprocessor directives required to implement the
- custom types can be defined outside cfortran.h]
-
-8. cfortran.h requires each routine to be exported to be explicitly set up.
- While is usually only be done once in a header file it would be best if
- applications were required to do no work at all in order to cross languages.
- cfortran.h's simple syntax could be a convenient back-end for a program
- which would export FORTRAN or C routines directly from the source code.
-
-
- -----
-
-Example 1 - cfortran.h has been used to make the C header file hbook.h,
- which then gives any C programmer, e.g. example.c, full and
- completely transparent access to CERN's HBOOK library of routines.
- Each HBOOK routine required about 3 lines of simple code in
- hbook.h. The example also demonstrates how FORTRAN common blocks
- are defined and used.
-
-/* hbook.h */
-#include "cfortran.h"
- :
-PROTOCCALLSFSUB6(HBOOK1,hbook1,INT,STRING,INT,FLOAT,FLOAT,FLOAT)
-#define HBOOK1(ID,CHTITLE,NX,XMI,XMA,VMX) \
- CCALLSFSUB6(HBOOK1,hbook1,INT,STRING,INT,FLOAT,FLOAT,FLOAT, \
- ID,CHTITLE,NX,XMI,XMA,VMX)
- :
-/* end hbook.h */
-
-/* example.c */
-#include "hbook.h"
- :
-typedef struct {
- int lines;
- int status[SIZE];
- float p[SIZE]; /* momentum */
-} FAKE_DEF;
-#define FAKE COMMON_BLOCK(FAKE,fake)
-COMMON_BLOCK_DEF(FAKE_DEF,FAKE);
- :
-main ()
-{
- :
- HBOOK1(1,"pT spectrum of pi+",100,0.,5.,0.);
-/* c.f. the call in FORTRAN:
- CALL HBOOK1(1,'pT spectrum of pi+',100,0.,5.,0.)
-*/
- :
- FAKE.p[7]=1.0;
- :
-}
-
-N.B. i) The routine is language independent.
- ii) hbook.h is machine independent.
- iii) Applications using routines via cfortran.h are machine independent.
-
- -----
-
-Example 2 - Many VMS System calls are most easily called from FORTRAN, but
- cfortran.h now gives that ease in C.
-
-#include "cfortran.h"
-
-PROTOCCALLSFSUB3(LIB$SPAWN,lib$spawn,STRING,STRING,STRING)
-#define LIB$SPAWN(command,input_file,output_file) \
- CCALLSFSUB3(LIB$SPAWN,lib$spawn,STRING,STRING,STRING, \
- command,input_file,output_file)
-
-main ()
-{
-LIB$SPAWN("set term/width=132","","");
-}
-
-Obviously the cfortran.h command above could be put into a header file along
-with the description of the other system calls, but as this example shows, it's
-not much hassle to set up cfortran.h for even a single call.
-
- -----
-
-Example 3 - cfortran.h and the source cstring.c create the cstring.obj library
- which gives FORTRAN access to all the functions in C's system
- library described by the system's C header file string.h.
-
-C EXAMPLE.FOR
- PROGRAM EXAMPLE
- DIMENSION I(20), J(30)
- :
- CALL MEMCPY(I,J,7)
- :
- END
-
-/* cstring.c */
-#include <string.h> /* string.h prototypes memcpy() */
-#include "cfortran.h"
-
- :
-FCALLSCSUB3(memcpy,MEMCPY,memcpy,PVOID,PVOID,INT)
- :
-
-
-The simplicity exhibited in the above example exists for many but not all
-machines. Note 4. of Section II ii) details the limitations and describes tools
-which try to maintain the best possible interface when FORTRAN calls C
-routines.
-
- -----
-
-
-II Using cfortran.h
--------------------
-
-The user is asked to look at the source files cfortest.c and cfortex.f
-for clarification by example.
-
-o) Notes:
-
-o Specifying the Fortran compiler
- cfortran.h generates interfaces for the default Fortran compiler. The default
-can be overridden by defining,
- . in the code, e.g.: #define NAGf90Fortran
- OR . in the compile directive, e.g.: unix> cc -DNAGf90Fortran
-one of the following before including cfortran.h:
- NAGf90Fortran f2cFortran hpuxFortran apolloFortran sunFortran
- IBMR2Fortran CRAYFortran mipsFortran DECFortran vmsFortran
- CONVEXFortran PowerStationFortran AbsoftUNIXFortran
- SXFortran pgiFortran AbsoftProFortran
-This also allows crosscompilation.
-If wanted, NAGf90Fortran, f2cFortran, DECFortran, AbsoftUNIXFortran,
-AbsoftProFortran and pgiFortran must be requested by the user.
-
-o /**/
- cfortran.h (ab)uses the comment kludge /**/ when the ANSI C preprocessor
-catenation operator ## doesn't exist. In at least MIPS C, this kludge is
-sensitive to blanks surrounding arguments to macros.
- Therefore, for applications using non-ANSI C compilers, the argtype_i,
-routine_name, routine_type and common_block_name arguments to the
-PROTOCCALLSFFUNn, CCALLSFSUB/FUNn, FCALLSCSUB/FUNn and COMMON_BLOCK macros
---- MUST NOT --- be followed by any white space characters such as
-blanks, tabs or newlines.
-
-o LOGICAL
- FORTRAN LOGICAL values of .TRUE. and .FALSE. do not agree with the C
-representation of TRUE and FALSE on all machines. cfortran.h does the
-conversion for LOGICAL and PLOGICAL arguments and for functions returning
-LOGICAL. Users must convert arrays of LOGICALs from C to FORTRAN with the
-C2FLOGICALV(array_name, elements_in_array); macro. Similarly, arrays of LOGICAL
-values may be converted from the FORTRAN into C representation by using
-F2CLOGICALV(array_name, elements_in_array);
-
- When C passes or returns LOGICAL values to FORTRAN, by default cfortran.h
-only makes the minimal changes required to the value. [e.g. Set/Unset the
-single relevant bit or do nothing for FORTRAN compilers which use 0 as FALSE
-and treat all other values as TRUE.] Therefore cfortran.h will pass LOGICALs
-to FORTRAN which do not have an identical representation to .TRUE. or .FALSE.
-This is fine except for abuses of FORTRAN/77 in the style of:
- logical l
- if (l .eq. .TRUE.) ! (1)
-instead of the correct:
- if (l .eqv. .TRUE.) ! (2)
-or:
- if (l) ! (3)
-For FORTRAN code which treats LOGICALs from C in the method of (1),
-LOGICAL_STRICT must be defined before including cfortran.h, either in the
-code, "#define LOGICAL_STRICT", or compile with "cc -DLOGICAL_STRICT".
-There is no reason to use LOGICAL_STRICT for FORTRAN code which does not do (1).
-At least the IBM's xlf and the Apollo's f77 do not even allow code along the
-lines of (1).
-
- DECstations' DECFortran and MIPS FORTRAN compilers use different internal
-representations for LOGICAL values. [Both compilers are usually called f77,
-although when both are installed on a single machine the MIPS' one is usually
-renamed. (e.g. f772.1 for version 2.10.)] cc doesn't know which FORTRAN
-compiler is present, so cfortran.h assumes MIPS f77. To use cc with DECFortran
-define the preprocessor constant 'DECFortran'.
-e.g. i) cc -DDECFortran -c the_code.c
- or ii) #define DECFortran /* in the C code or add to cfortran.h. */
-
- MIPS f77 [SGI and DECstations], f2c, and f77 on VAX Ultrix treat
-.eqv./.neqv. as .eq./.ne.. Therefore, for these compilers, LOGICAL_STRICT is
-defined by default in cfortran.h. [The Sun and HP compilers have not been
-tested, so they may also require LOGICAL_STRICT as the default.]
-
-o SHORT and BYTE
- They are irrelevant for the CRAY where FORTRAN has no equivalent to C's short.
-Similarly BYTE is irrelevant for f2c and for VAX Ultrix f77 and fort. The
-author has tested SHORT and BYTE with a modified cfortest.c/cfortex.f on all
-machines supported except for the HP9000 and the Sun.
-
- BYTE is a signed 8-bit quantity, i.e. values are -128 to 127, on all machines
-except for the SGI [at least for MIPS Computer Systems 2.0.] On the SGI it is
-an unsigned 8-bit quantity, i.e. values are 0 to 255, although the SGI 'FORTRAN
-77 Programmers Guide' claims BYTE is signed. Perhaps MIPS 2.0 is dated, since
-the DECstations using MIPS 2.10 f77 have a signed BYTE.
-
- To minimize the difficulties of signed and unsigned BYTE, cfortran.h creates
-the type 'INTEGER_BYTE' to agree with FORTRAN's BYTE. Users may define
-SIGNED_BYTE or UNSIGNED_BYTE, before including cfortran.h, to specify FORTRAN's
-BYTE. If neither is defined, cfortran.h assumes SIGNED_BYTE.
-
-o CRAY
- The type DOUBLE in cfortran.h corresponds to FORTRAN's DOUBLE PRECISION.
- The type FLOAT in cfortran.h corresponds to FORTRAN's REAL.
-
-On a classic CRAY [i.e. all models except for the t3e]:
-( 64 bit) C float == C double == Fortran REAL
-(128 bit) C long double == Fortran DOUBLE PRECISION
-Therefore when moving a mixed C and FORTRAN app. to/from a classic CRAY,
-either the C code will have to change,
-or the FORTRAN code and cfortran.h declarations will have to change.
-DOUBLE_PRECISION is a cfortran.h macro which provides the former option,
-i.e. the C code is automatically changed.
-DOUBLE_PRECISION is 'long double' on classic CRAY and 'double' elsewhere.
-DOUBLE_PRECISION thus corresponds to FORTRAN's DOUBLE PRECISION
-on all machines, including classic CRAY.
-
-On a classic CRAY with the fortran compiler flag '-dp':
-Fortran DOUBLE PRECISION thus is also the faster 64bit type.
-(This switch is often used since the application is usually satisfied by
- 64 bit precision and the application needs the speed.)
-DOUBLE_PRECISION is thus not required in this case,
-since the classic CRAY behaves like all other machines.
-If DOUBLE_PRECISION is used nonetheless, then on the classic CRAY
-the default cfortran.h behavior must be overridden,
-for example by the C compiler option '-DDOUBLE_PRECISION=double'.
-
-On a CRAY t3e:
-(32 bit) C float == Fortran Unavailable
-(64 bit) C double == C long double == Fortran REAL == Fortran DOUBLE PRECISION
-Notes:
-- (32 bit) is available as Fortran REAL*4 and
- (64 bit) is available as Fortran REAL*8.
- Since cfortran.h is all about more portability, not about less portability,
- the use of the nonstandard REAL*4 and REAL*8 is strongly discouraged.
-- Fortran DOUBLE PRECISION is folded to REAL with the following warning:
- 'DOUBLE PRECISION is not supported on this platform. REAL will be used.'
- Similarly, Fortran REAL*16 is mapped to REAL*8 with a warning.
-This behavior differs from that of other machines, including the classic CRAY.
-FORTRAN_REAL is thus introduced for the t3e,
-just as DOUBLE_PRECISION is introduced for the classic CRAY.
-FORTRAN_REAL is 'double' on t3e and 'float' elsewhere.
-FORTRAN_REAL thus corresponds to FORTRAN's REAL on all machines, including t3e.
-
-
-o f2c
- f2c, by default promotes REAL functions to double. cfortran.h does not (yet)
-support this, so the f2c -R option must be used to turn this promotion off.
-
-o f2c
-[Thanks to Dario Autiero for pointing out the following.]
-f2c has a strange feature in that either one or two underscores are appended
-to a Fortran name of a routine or common block,
-depending on whether or not the original name contains an underscore.
-
- S.I. Feldman et al., "A fortran to C converter",
- Computing Science Technical Report No. 149.
-
- page 2, chapter 2: INTERLANGUAGE conventions
- ...........
- To avoid conflict with the names of library routines and with names that
- f2c generates,
- Fortran names may have one or two underscores appended. Fortran names are
- forced to lower case (unless the -U option described in Appendix B is in
- effect); external names, i.e. the names of fortran procedures and common
- blocks, have a single underscore appended if they do not contain any
- underscore and have a pair of underscores appended if they do contain
- underscores. Thus fortran subroutines names ABC, A_B_C and A_B_C_ result
- in C functions named abc_, a_b_c__ and a_b_c___.
- ...........
-
-cfortran.h is unable to change the naming convention on a name by name basis.
-Fortran routine and common block names which do not contain an underscore
-are unaffected by this feature.
-Names which do contain an underscore may use the following work-around:
-
-/* First 2 lines are a completely standard cfortran.h interface
- to the Fortran routine E_ASY . */
- PROTOCCALLSFSUB2(E_ASY,e_asy, PINT, INT)
-#define E_ASY(A,B) CCALLSFSUB2(E_ASY,e_asy, PINT, INT, A, B)
-#ifdef f2cFortran
-#define e_asy_ e_asy__
-#endif
-/* Last three lines are a work-around for the strange f2c naming feature. */
-
-o NAG f90
- The Fortran 77 subset of Fortran 90 is supported. Extending cfortran.h to
-interface C with all of Fortran 90 has not yet been examined.
- The NAG f90 library hijacks the main() of any program and starts the user's
-program with a call to: void f90_main(void);
-While this in itself is only a minor hassle, a major problem arises because
-NAG f90 provides no mechanism to access command line arguments.
- At least version 'NAGWare f90 compiler Version 1.1(334)' appended _CB to
-common block names instead of the usual _. To fix, add this to cfortran.h:
-#ifdef old_NAG_f90_CB_COMMON
-#define COMMON_BLOCK CFC_ /* for all other Fortran compilers */
-#else
-#define COMMON_BLOCK(UN,LN) _(LN,_CB)
-#endif
-
-o RS/6000
- Using "xlf -qextname ...", which appends an underscore, '_', to all FORTRAN
-external references, requires "cc -Dextname ..." so that cfortran.h also
-generates these underscores.
-Use -Dextname=extname if extname is a symbol used in the C code.
-The use of "xlf -qextname" is STRONGLY ENCOURAGED, since it allows for
-transparent naming schemes when mixing C and Fortran.
-
-o HP9000
- Using "f77 +ppu ...", which appends an underscore, '_', to all FORTRAN
-external references, requires "cc -Dextname ..." so that cfortran.h also
-generates these underscores.
-Use -Dextname=extname if extname is a symbol used in the C code.
-The use of "f77 +ppu" is STRONGLY ENCOURAGED, since it allows for
-transparent naming schemes when mixing C and Fortran.
-
- At least one release of the HP /lib/cpp.ansi preprocessor is broken and will
-go into an infinite loop when trying to process cfortran.h with the
-## catenation operator. The K&R version of cfortran.h must then be used and the
-K&R preprocessor must be specified. e.g.
- HP9000> cc -Aa -tp,/lib/cpp -c source.c
-The same problem with a similar solution exists on the Apollo.
-An irrelevant error message '0: extraneous name /usr/include' will appear for
-each source file due to another HP bug, and can be safely ignored.
-e.g. 'cc -v -c -Aa -tp,/lib/cpp cfortest.c' will show that the driver passes
-'-I /usr/include' instead of '-I/usr/include' to /lib/cpp
-
-On some machines the above error causes compilation to stop; one must then use
-K&R C, as with old HP compilers which don't support function prototyping.
-cfortran.h has to be informed that K&R C is to being used, e.g.
-HP9000> cc -D__CF__KnR -c source.c
-
-o AbsoftUNIXFortran
-By default, cfortran.h follows the default AbsoftUNIX/ProFortran and prepends _C
-to each COMMON BLOCK name. To override the cfortran.h behavior
-#define COMMON_BLOCK(UN,LN) before #including cfortran.h.
-[Search for COMMON_BLOCK in cfortran.h for examples.]
-
-o Apollo
-On at least one release, 'C compiler 68K Rev6.8(168)', the default C
-preprocessor, from cc -A xansi or cc -A ansi, enters an infinite loop when
-using cfortran.h. This Apollo bug can be circumvented by using:
- . cc -DANSI_C_preprocessor=0 to force use of /**/, instead of '##'.
- AND . The pre-ANSI preprocessor, i.e. use cc -Yp,/usr/lib
-The same problem with a similar solution exists on the HP.
-
-o Sun
-Old versions of cc(1), say <~1986, may require help for cfortran.h applications:
- . #pragma may not be understood, hence cfortran.h and cfortest.c may require
- sun> mv cfortran.h cftmp.h && grep -v "^#pragma" <cftmp.h >cfortran.h
- sun> mv cfortest.c cftmp.c && grep -v "^#pragma" <cftmp.c >cfortest.c
- . Old copies of math.h may not include the following from a newer math.h.
- [For an ancient math.h on a 386 or sparc, get similar from a new math.h.]
- #ifdef mc68000 /* 5 lines Copyright (c) 1988 by Sun Microsystems, Inc. */
- #define FLOATFUNCTIONTYPE int
- #define RETURNFLOAT(x) return (*(int *)(&(x)))
- #define ASSIGNFLOAT(x,y) *(int *)(&x) = y
- #endif
-
-o CRAY, Sun, Apollo [pre 6.8 cc], VAX Ultrix and HP9000
- Only FORTRAN routines with less than 15 arguments can be prototyped for C,
-since these compilers don't allow more than 31 arguments to a C macro. This can
-be overcome, [see Section IV], with access to any C compiler without this
-limitation, e.g. gcc, on ANY machine.
-
-o VAX Ultrix
- vcc (1) with f77 is not supported. Although:
-VAXUltrix> f77 -c cfortex.f
-VAXUltrix> vcc -o cfortest cfortest.c cfortex.o -lI77 -lU77 -lF77 && cfortest
-will link and run. However, the FORTRAN standard I/O is NOT merged with the
-stdin and stdout of C, and instead uses the files fort.6 and fort.5. For vcc,
-f77 can't drive the linking, as for gcc and cc, since vcc objects must be
-linked using lk (1). f77 -v doesn't tell much, and without VAX Ultrix manuals,
-the author can only wait for the info. required.
-
- fort (1) is not supported. Without VAX Ultrix manuals the author cannot
-convince vcc/gcc/cc and fort to generate names of routines and COMMON blocks
-that match at the linker, lk (1). i.e. vcc/gcc/cc prepend a single underscore
-to external references, e.g. NAME becomes _NAME, while fort does not modify the
-references. So ... either fort has prepend an underscore to external
-references, or vcc/gcc/cc have to generate unmodified names. man 1 fort
-mentions JBL, is JBL the only way?
-
-o VAX VMS C
- The compiler 'easily' exhausts its table space and generates:
-%CC-F-BUGCHECK, Compiler bug check during parser phase .
- Submit an SPR with a problem description.
- At line number 777 in DISK:[DIR]FILE.C;1.
-where the line given, '777', includes a call across C and FORTRAN via
-cfortran.h, usually with >7 arguments and/or very long argument expressions.
-This SPR can be staved off, with the simple modification to cfortran.h, such
-that the relevant CCALLSFSUBn (or CCALLSFFUNn or FCALLSCFUNn) is not
-cascaded up to CCALLSFSUB14, and instead has its own copy of the contents of
-CCALLSFSUB14. [If these instructions are not obvious after examining cfortran.h
-please contact the author.]
-[Thanks go to Mark Kyprianou (kyp at stsci.edu) for this solution.]
-
-o Mips compilers
- e.g. DECstations and SGI, require applications with a C main() and calls to
-GETARG(3F), i.e. FORTRAN routines returning the command line arguments, to use
-two macros as shown:
- :
-CF_DECLARE_GETARG; /* This must be external to all routines. */
- :
-main(int argc, char *argv[])
-{
- :
-CF_SET_GETARG(argc,argv); /* This must precede any calls to GETARG(3F). */
- :
-}
-The macros are null and benign on all other systems. Sun's GETARG(3F) also
-doesn't work with a generic C main() and perhaps a workaround similar to the
-Mips' one exists.
-
-o Alpha/OSF
-Using the DEC Fortran and the DEC C compilers of DEC OSF/1 [RT] V1.2 (Rev. 10),
-Fortran, when called from C, has occasional trouble using a routine received as
-a dummy argument.
-
-e.g. In the following the Fortran routine 'e' will crash when it tries to use
- the C routine 'c' or the Fortran routine 'f'.
- The example works on other systems.
-
-C FORTRAN /* C */
- integer function f() #include <stdio.h>
- f = 2 int f_();
- return int e_(int (*u)());
- end
- int c(){ return 1;}
- integer function e(u) int d (int (*u)()) { return u();}
- integer u
- external u main()
- e=u() { /* Calls to d work. */
- return printf("d (c ) returns %d.\n",d (c ));
- end printf("d (f_) returns %d.\n",d (f_));
- /* Calls to e_ crash. */
- printf("e_(c ) returns %d.\n",e_(c ));
- printf("e_(f_) returns %d.\n",e_(f_));
- }
-
-Solutions to the problem are welcomed!
-A kludge which allows the above example to work correctly, requires an extra
-argument to be given when calling the dummy argument function.
-i.e. Replacing 'e=u()' by 'e=u(1)' allows the above example to work.
-
-
-o The FORTRAN routines are called using macro expansions, therefore the usual
-caveats for expressions in arguments apply. The expressions to the routines may
-be evaluated more than once, leading to lower performance and in the worst case
-bizarre bugs.
-
-o For those who wish to use cfortran.h in large applications. [See Section IV.]
-This release is intended to make it easy to get applications up and running.
-This implies that applications are not as efficient as they could be:
-- The current mechanism is inefficient if a single header file is used to
- describe a large library of FORTRAN functions. Code for a static wrapper fn.
- is generated in each piece of C source code for each FORTRAN function
- specified with the CCALLSFFUNn statement, irrespective of whether or not the
- function is ever called.
-- Code for several static utility routines internal to cfortran.h is placed
- into any source code which #includes cfortran.h. These routines should
- probably be in a library.
-
-
-i) Calling FORTRAN routines from C:
- --------------------------------
-
-The FORTRAN routines are defined by one of the following two instructions:
-
-for a SUBROUTINE:
-/* PROTOCCALLSFSUBn is optional for C, but mandatory for C++. */
-PROTOCCALLSFSUBn(ROUTINE_NAME,routine_name,argtype_1,...,argtype_n)
-#define Routine_name(argname_1,..,argname_n) \
-CCALLSFSUBn(ROUTINE_NAME,routine_name,argtype_1,...,argtype_n, \
- argname_1,..,argname_n)
-
-for a FUNCTION:
-PROTOCCALLSFFUNn(routine_type,ROUTINE_NAME,routine_name,argtype_1,...,argtype_n)
-#define Routine_name(argname_1,..,argname_n) \
-CCALLSFFUNn(ROUTINE_NAME,routine_name,argtype_1,...,argtype_n, \
- argname_1,..,argname_n)
-
-Where:
-'n' = 0->14 [SUBROUTINE's ->27] (easily expanded in cfortran.h to > 14 [27]) is
- the number of arguments to the routine.
-Routine_name = C name of the routine (IN UPPER CASE LETTERS).[see 2.below]
-ROUTINE_NAME = FORTRAN name of the routine (IN UPPER CASE LETTERS).
-routine_name = FORTRAN name of the routine (IN lower case LETTERS).
-routine_type = the type of argument returned by FORTRAN functions.
- = BYTE, DOUBLE, FLOAT, INT, LOGICAL, LONG, SHORT, STRING, VOID.
- [Instead of VOID one would usually use CCALLSFSUBn.
- VOID forces a wrapper function to be used.]
-argtype_i = the type of argument passed to the FORTRAN routine and must be
- consistent in the definition and prototyping of the routine s.a.
- = BYTE, DOUBLE, FLOAT, INT, LOGICAL, LONG, SHORT, STRING.
- For vectors, i.e. 1 dim. arrays use
- = BYTEV, DOUBLEV, FLOATV, INTV, LOGICALV, LONGV, SHORTV,
- STRINGV, ZTRINGV.
- For vectors of vectors, i.e. 2 dim. arrays use
- = BYTEVV, DOUBLEVV, FLOATVV, INTVV, LOGICALVV, LONGVV, SHORTVV.
- For n-dim. arrays, 1<=n<=7 [7 is the maximum in Fortran 77],
- = BYTEV..nV's..V, DOUBLEV..V, FLOATV..V, INTV..V, LOGICALV..V,
- LONGV..V, SHORTV..V.
- N.B. Array dimensions and types are checked by the C compiler.
- For routines changing the values of an argument, the keyword is
- prepended by a 'P'.
- = PBYTE, PDOUBLE, PFLOAT, PINT, PLOGICAL, PLONG, PSHORT,
- PSTRING, PSTRINGV, PZTRINGV.
- For EXTERNAL procedures passed as arguments use
- = ROUTINE.
- For exceptional arguments which require no massaging to fit the
- argument passing mechanisms use
- = PVOID.
- The argument is cast and passed as (void *).
- Although PVOID could be used to describe all array arguments on
- most (all?) machines , it shouldn't be because the C compiler
- can no longer check the type and dimension of the array.
-argname_i = any valid unique C tag, but must be consistent in the definition
- as shown.
-
-Notes:
-
-1. cfortran.h may be expanded to handle a more argument type. To suppport new
-arguments requiring complicated massaging when passed between Fortran and C,
-the user will have to understand cfortran.h and follow its code and mechanisms.
-
-To define types requiring little or no massaging when passed between Fortran
-and C, the pseudo argument type SIMPLE may be used.
-For a user defined type called 'newtype', the definitions required are:
-
-/* The following 7 lines are required verbatim.
- 'newtype' is the name of the new user defined argument type.
-*/
-#define newtype_cfV( T,A,B,F) SIMPLE_cfV(T,A,B,F)
-#define newtype_cfSEP(T, B) SIMPLE_cfSEP(T,B)
-#define newtype_cfINT(N,A,B,X,Y,Z) SIMPLE_cfINT(N,A,B,X,Y,Z)
-#define newtype_cfSTR(N,T,A,B,C,D,E) SIMPLE_cfSTR(N,T,A,B,C,D,E)
-#define newtype_cfCC( T,A,B) SIMPLE_cfCC(T,A,B)
-#define newtype_cfAA( T,A,B) newtype_cfB(T,A) /* Argument B not used. */
-#define newtype_cfU( T,A) newtype_cfN(T,A)
-
-/* 'parameter_type(A)' is a declaration for 'A' and describes the type of the
-parameter expected by the Fortran function. This type will be used in the
-prototype for the function, if using ANSI C, and to declare the argument used
-by the intermediate function if calling a Fortran FUNCTION.
-Valid 'parameter_type(A)' include: int A
- void (*A)()
- double A[17]
-*/
-#define newtype_cfN( T,A) parameter_type(A) /* Argument T not used. */
-
-/* Before any argument of the new type is passed to the Fortran routine, it may
-be massaged as given by 'massage(A)'.
-*/
-#define newtype_cfB( T,A) massage(A) /* Argument T not used. */
-
-An example of a simple user defined type is given cfortex.f and cfortest.c.
-Two uses of SIMPLE user defined types are [don't show the 7 verbatim #defines]:
-
-/* Pass the address of a structure, using a type called PSTRUCT */
-#define PSTRUCT_cfN( T,A) void *A
-#define PSTRUCT_cfB( T,A) (void *) &(A)
-
-/* Pass an integer by value, (not standard F77 ), using a type called INTVAL */
-#define INTVAL_cfN( T,A) int A
-#define INTVAL_cfB( T,A) (A)
-
-[If using VAX VMS, surrounding the #defines with "#pragma (no)standard" allows
- the %CC-I-PARAMNOTUSED messages to be avoided.]
-
-Upgrades to cfortran.h try to be, and have been, backwards compatible. This
-compatibility cannot be offered to user defined types. SIMPLE user defined
-types are less of a risk since they require so little effort in their creation.
-If a user defined type is required in more than one C header file of interfaces
-to libraries of Fortran routines, good programming practice, and ease of code
-maintenance, suggests keeping any user defined type within a single file which
-is #included as required. To date, changes to the SIMPLE macros were introduced
-in versions 2.6, 3.0 and 3.2 of cfortran.h.
-
-
-2. Routine_name is the name of the macro which the C programmer will use in
-order to call a FORTRAN routine. In theory Routine_name could be any valid and
-unique name, but in practice, the name of the FORTRAN routine in UPPER CASE
-works everywhere and would seem to be an obvious choice.
-
-
-3. <BYTE|DOUBLE|BYTE|DOUBLE|FLOAT|INT|LOGICAL|LONG|SHORT><V|VV|VVV|...>
-
-cfortran.h encourages the exact specification of the type and dimension of
-array parameters because it allows the C compiler to detect errors in the
-arguments when calling the routine.
-
-cfortran.h does not strictly require the exact specification since the argument
-is merely the address of the array and is passed on to the calling routine.
-Any array parameter could be declared as PVOID, but this circumvents
-C's compiletime ability to check the correctness of arguments and is therefore
-discouraged.
-
-Passing the address of these arguments implies that PBYTEV, PFLOATV, ... ,
-PDOUBLEVV, ... don't exist in cfortran.h, since by default the routine and the
-calling code share the same array, i.e. the same values at the same memory
-location.
-
-These comments do NOT apply to arrays of (P)S/ZTRINGV. For these parameters,
-cfortran.h passes a massaged copy of the array to the routine. When the routine
-returns, S/ZTRINGV ignores the copy, while PS/ZTRINGV replaces the calling
-code's original array with copy, which may have been modified by the called
-routine.
-
-
-4. (P)STRING(V):
-- STRING - If the argument is a fixed length character array, e.g. char ar[8];,
-the string is blank, ' ', padded on the right to fill out the array before
-being passed to the FORTRAN routine. The useful size of the string is the same
-in both languages, e.g. ar[8] is passed as character*7. If the argument is a
-pointer, the string cannot be blank padded, so the length is passed as
-strlen(argument). On return from the FORTRAN routine, pointer arguments are not
-disturbed, but arrays have the terminating '\0' replaced to its original
-position. i.e. The padding blanks are never visible to the C code.
-
-- PSTRING - The argument is massaged as with STRING before being passed to the
-FORTRAN routine. On return, the argument has all trailing blanks removed,
-regardless of whether the argument was a pointer or an array.
-
-- (P)STRINGV - Passes a 1- or 2-dimensional char array. e.g. char a[7],b[6][8];
-STRINGV may thus also pass a string constant, e.g. "hiho".
-(P)STRINGV does NOT pass a pointer, e.g. char *, to either a 1- or a
-2-dimensional array, since it cannot determine the array dimensions.
-A pointer can only be passed using (P)ZTRINGV.
-N.B. If a C routine receives a character array argument, e.g. char a[2][3],
- such an argument is actually a pointer and my thus not be passed by
- (P)STRINGV. Instead (P)ZTRINGV must be used.
-
-- STRINGV - The elements of the argument are copied into space malloc'd, and
-each element is padded with blanks. The useful size of each element is the same
-in both languages. Therefore char bb[6][8]; is equivalent to character*7 bb(6).
-On return from the routine the malloc'd space is simply released.
-
-- PSTRINGV - Since FORTRAN has no trailing '\0', elements in an array of
-strings are contiguous. Therefore each element of the C array is padded with
-blanks and strip out C's trailing '\0'. After returning from the routine, the
-trailing '\0' is reinserted and kill the trailing blanks in each element.
-
-- SUMMARY: STRING(V) arguments are blank padded during the call to the FORTRAN
-routine, but remain original in the C code. (P)STRINGV arguments are blank
-padded for the FORTRAN call, and after returning from FORTRAN trailing blanks
-are stripped off.
-
-
-5. (P)ZTRINGV:
-- (P)ZTRINGV - is identical to (P)STRINGV,
-except that the dimensions of the array of strings is explicitly specified,
-which thus also allows a pointer to be passed.
-(P)ZTRINGV can thus pass a 1- or 2-dimensional char array, e.g. char b[6][8],
-or it can pass a pointer to such an array, e.g. char *p;.
-ZTRINGV may thus also pass a string constant, e.g. "hiho".
-If passing a 1-dimensional array, routine_name_ELEMS_j (see below) must be 1.
-[Users of (P)ZTRINGV should examine cfortest.c for examples.]:
-
-- (P)ZTRINGV must thus be used instead of (P)STRINGV whenever sizeof()
-can't be used to determine the dimensions of the array of string or strings.
-e.g. when calling FORTRAN from C with a char * received by C as an argument.
-
-- There is no (P)ZTRING type, since (P)ZTRINGV can pass a 1-dimensional
-array or a pointer to such an array, e.g. char a[7], *b;
-If passing a 1-dimensional array, routine_name_ELEMS_j (see below) must be 1.
-
-- To specify the numbers of elements,
-routine_name_ELEMS_j and routine_name_ELEMLEN_j must be defined as shown below
-before interfacing the routine with CCALLSFSUBn, PROTOCCALLSFFUNn, etc.
-
-#define routine_name_ELEMS_j ZTRINGV_ARGS(k)
- [..ARGS for subroutines, ..ARGF for functions.]
-or
-#define routine_name_ELEMS_j ZTRINGV_NUM(l)
-Where: routine_name is as above.
- j [1-n], is the argument being specifying.
- k [1-n], the value of the k'th argument is the dynamic number
- of elements for argument j. The k'th argument must be
- of type BYTE, DOUBLE, FLOAT, INT, LONG or SHORT.
- l the number of elements for argument j. This must be an
- integer constant available at compile time.
- i.e. it is static.
-
-- Similarly to specify the useful length, [i.e. don't count C's trailing '\0',]
-of each element:
-#define routine_name_ELEMLEN_j ZTRINGV_ARGS(m)
- [..ARGS for subroutines, ..ARGF for functions.]
-or
-#define routine_name_ELEMLEN_j ZTRINGV_NUM(q)
-Where: m [1-n], as for k but this is the length of each element.
- q as for l but this is the length of each element.
-
-
-6. ROUTINE
-The argument is an EXTERNAL procedure.
-
-When C passes a routine to Fortran, the language of the function must be
-specified as follows: [The case of some_*_function must be given as shown.]
-
-When C passes a C routine to a Fortran:
- FORTRAN_ROUTINE(arg1, .... ,
- C_FUNCTION(SOME_C_FUNCTION,some_c_function),
- ...., argn);
-
-and similarly when C passes a Fortran routine to Fortran:
- FORTRAN_ROUTINE(arg1, .... ,
- FORTRAN_FUNCTION(SOME_FORT_FUNCTION,some_fort_function),
- ...., argn);
-
-If fcallsc has been redefined; the same definition of fcallsc used when creating
-the wrapper for 'some_c_function' must also be defined when C_FUNCTION is used.
-See ii) 4. of this section for when and how to redefine fcallsc.
-
-ROUTINE was introduced with cfortran.h version 2.6. Earlier versions of
-cfortran.h used PVOID to pass external procedures as arguments. Using PVOID for
-this purpose is no longer recommended since it won't work 'as is' for
-apolloFortran, hpuxFortran800, AbsoftUNIXFortran, AbsoftProFortran.
-
-7. CRAY only:
-In a given piece of source code, where FFUNC is any FORTRAN routine,
-FORTRAN_FUNCTION(FFUNC,ffunc)
-disallows a previous
-#define FFUNC(..) CCALLSFSUBn(FFUNC,ffunc,...) [ or CCALLSFFUNn]
-in order to make the UPPER CASE FFUNC callable from C.
-#define Ffunc(..) ... is OK though, as are obviously any other names.
-
-
-ii) Calling C routines from FORTRAN:
- --------------------------------
-
-Each of the following two statements to export a C routine to FORTRAN create
-FORTRAN 'wrappers', written in C, which must be compiled and linked along with
-the original C routines and with the FORTRAN calling code.
-
-FORTRAN callable 'wrappers' may also be created for C macros. i.e. in this
-section, the term 'C function' may be replaced by 'C macro'.
-
-for C functions returning void:
-FCALLSCSUBn( Routine_name,ROUTINE_NAME,routine_name,argtype_1,...,argtype_n)
-
-for all other C functions:
-FCALLSCFUNn(routine_type,Routine_name,ROUTINE_NAME,routine_name,argtype_1,...,argtype_n)
-
-Where:
-'n' = 0->27 (easily expanded to > 27) stands for the number of arguments to the
- routine.
-Routine_name = the C name of the routine. [see 9. below]
-ROUTINE_NAME = the FORTRAN name of the routine (IN UPPER CASE LETTERS).
-routine_name = the FORTRAN name of the routine (IN lower case LETTERS).
-routine_type = the type of argument returned by C functions.
- = BYTE, DOUBLE, FLOAT, INT, LOGICAL, LONG, SHORT, STRING, VOID.
- [Instead of VOID, FCALLSCSUBn is recommended.]
-argtype_i = the type of argument passed to the FORTRAN routine and must be
- consistent in the definition and prototyping of the routine
- = BYTE, DOUBLE, FLOAT, INT, LOGICAL, LONG, SHORT, STRING.
- For vectors, i.e. 1 dim. arrays use
- = BYTEV, DOUBLEV, FLOATV, INTV, LOGICALV, LONGV, SHORTV, STRINGV.
- For vectors of vectors, 2 dim. arrays use
- = BYTEVV, DOUBLEVV, FLOATVV, INTVV, LOGICALVV, LONGVV, SHORTVV.
- For n-dim. arrays use
- = BYTEV..nV's..V, DOUBLEV..V, FLOATV..V, INTV..V, LOGICALV..V,
- LONGV..V, SHORTV..V.
- For routines changing the values of an argument, the keyword is
- prepended by a 'P'.
- = PBYTE, PDOUBLE, PFLOAT, PINT, PLOGICAL, PLONG, PSHORT,
- PSTRING, PNSTRING, PPSTRING, PSTRINGV.
- For EXTERNAL procedures passed as arguments use
- = ROUTINE.
- For exceptional arguments which require no massaging to fit the
- argument passing mechanisms use
- = PVOID.
- The argument is cast and passed as (void *).
-
-
-Notes:
-
-0. For Fortran calling C++ routines, C++ does NOT easily allow support for:
- STRINGV.
- BYTEVV, DOUBLEVV, FLOATVV, INTVV, LOGICALVV, LONGVV, SHORTVV.
- BYTEV..V, DOUBLEV..V, FLOATV..V, INTV..V, LOGICALV..V, LONGV..V, SHORTV..V.
-Though there are ways to get around this restriction,
-the restriction is not serious since these types are unlikely to be used as
-arguments for a C++ routine.
-
-1. FCALLSCSUB/FUNn expect that the routine to be 'wrapped' has been properly
-prototyped, or at least declared.
-
-
-2. cfortran.h may be expanded to handle a new argument type not already among
-the above.
-
-
-3. <BYTE|DOUBLE|BYTE|DOUBLE|FLOAT|INT|LOGICAL|LONG|SHORT><V|VV|VVV|...>
-
-cfortran.h encourages the exact specification of the type and dimension of
-array parameters because it allows the C compiler to detect errors in the
-arguments when declaring the routine using FCALLSCSUB/FUNn, assuming the
-routine to be 'wrapped' has been properly prototyped.
-
-cfortran.h does not strictly require the exact specification since the argument
-is merely the address of the array and is passed on to the calling routine.
-Any array parameter could be declared as PVOID, but this circumvents
-C's compiletime ability to check the correctness of arguments and is therefore
-discouraged.
-
-Passing the address of these arguments implies that PBYTEV, PFLOATV, ... ,
-PDOUBLEVV, ... don't exist in cfortran.h, since by default the routine and the
-calling code share the same array, i.e. the same values at the same memory
-location.
-
-These comments do NOT apply to arrays of (P)STRINGV. For these parameters,
-cfortran.h passes a massaged copy of the array to the routine. When the routine
-returns, STRINGV ignores the copy, while PSTRINGV replaces the calling
-code's original array with copy, which may have been modified by the called
-routine.
-
-
-4. (P(N))STRING arguments have any trailing blanks removed before being passed
-to C, the same holds true for each element in (P)STRINGV. Space is malloc'd in
-all cases big enough to hold the original string (elements) as well as C's
-terminating '\0'. i.e. The useful size of the string (elements) is the same in
-both languages. P(N)STRING(V) => the string (elements) will be copied from the
-malloc'd space back into the FORTRAN bytes. If one of the two escape mechanisms
-mentioned below for PNSTRING has been used, the copying back to FORTRAN is
-obviously not relevant.
-
-
-5. (PN)STRING's, [NOT PSTRING's nor (P)STRINGV's,] behavior may be overridden
-in two cases. In both cases PNSTRING and STRING behave identically.
-
-a) If a (PN)STRING argument's first 4 bytes are all the NUL character,
-i.e. '\0\0\0\0' the NULL pointer is passed to the C routine.
-
-b) If the characters of a (PN)STRING argument contain at least one HEX-00, i.e.
-the NUL character, i.e. C strings' terminating '\0', the address of the string
-is simply passed to the C routine. i.e. The argument is treated in this case as
-it would be with PPSTRING, to which we refer the reader for more detail.
-
-Mechanism a) overrides b). Therefore, to use this mechanism to pass the NULL
-string, "", to C, the first character of the string must obviously be the NUL
-character, but of the first 4 characters in the string, at least one must not
-be HEX-00.
-
-Example:
-C FORTRAN /* C */
- character*40 str #include "cfortran.h"
-C Set up a NULL as : void cs(char *s) {if (s) printf("%s.\n",s);}
-C i) 4 NUL characters. FCALLSCSUB1(cs,CS,cs,STRING)
-C ii) NULL pointer.
- character*4 NULL
- NULL = CHAR(0)//CHAR(0)//CHAR(0)//CHAR(0)
-
- data str/'just some string'/
-
-C Passing the NULL pointer to cs.
- call cs(NULL)
-C Passing a copy of 'str' to cs.
- call cs(str)
-C Passing address of 'str' to cs. Trailing blanks NOT killed.
- str(40:) = NULL
- call cs(str)
- end
-
-Strings passed from Fortran to C via (PN)STRING must not have undefined
-contents, otherwise undefined behavior will result, since one of the above two
-escape mechanisms may occur depending on the contents of the string.
-
-This is not be a problem for STRING arguments, which are read-only in the C
-routine and hence must have a well defined value when being passed in.
-
-PNSTRING arguments require special care. Even if they are write-only in the C
-routine, PNSTRING's above two escape mechanisms require that the value of the
-argument be well defined when being passed in from Fortran to C. Therefore,
-unless one or both of PNSTRING's escape mechanisms are required, PSTRING should
-be used instead of PNSTRING.
-Prior to version 2.8, PSTRING did have the above two escape mechanisms,
-but they were removed from PSTRING to allow strings with undefined contents to
-be passed in. PNSTRING behaves like the old PSTRING.
-[Thanks go to Paul Dubois (dubios at icf.llnl.gov) for pointing out that PSTRING
- must allow for strings with undefined contents to be passed in.]
-
-Example:
-C FORTRAN /* C */
- character*10 s,sn #include "cfortran.h"
- void ps(char *s) {strcpy(s,"hello");}
-C Can call ps with undef. s. FCALLSCSUB1(ps,PS,ps,PSTRING)
- call ps(s) FCALLSCSUB1(ps,PNS,pns,PNSTRING)
- print *,s,'=s'
-
-C Can't call pns with undef. s.
-C e.g. If first 4 bytes of s were
-C "\0\0\0\0", ps would try
-C to copy to NULL because
-C of PNSTRING mechanism.
- sn = ""
- call pns(sn)
- print *,sn,'=sn'
-
- end
-
-
-6. PPSTRING
-The address of the string argument is simply passed to the C routine. Therefore
-the C routine and the FORTRAN calling code share the same string at the same
-memory location. If the C routine modifies the string, the string will also be
-modified for the FORTRAN calling code.
-The user is responsible for negociating the differences in representation of a
-string in Fortran and in C, i.e. the differences are not automatically resolved
-as they are for (P(N)STRING(V).
-This mechanism is provided for two reasons:
- - Some C routines require the string to exist at the given memory location,
- after the C routine has exited. Recall that for the usual (P(N)STRING(V)
- mechanism, a copy of the FORTRAN string is given to the C routine, and this
- copy ceases to exist after returning to the FORTRAN calling code.
- - This mechanism can save runtime CPU cycles over (P(N)STRING(V), since it
- does not perform their malloc, copy and kill trailing blanks of the string
- to be passed.
- Only in a small minority of cases does the potential benefit of the saved
- CPU cycles outweigh the programming effort required to manually resolve
- the differences in representation of a string in Fortran and in C.
-
-For arguments passed via PPSTRING, the argument passed may also be an array of
-strings.
-
-
-7. ROUTINE
-ANSI C requires that the type of the value returned by the routine be known,
-For all ROUTINE arguments passed from Fortran to C, the type of ROUTINE is
-specified by defining a cast as follows:
-
-#undef ROUTINE_j
-#define ROUTINE_j (cast)
-where:
- j [1-n], is the argument being specifying.
- (cast) is a cast matching that of the argument expected by the C
- function protoytpe for which a wrapper is being defined.
-
-e.g. To create a Fortran wrapper for qsort(3C):
-#undef ROUTINE_4
-#define ROUTINE_4 (int (*)(void *,void *))
-FCALLSCSUB4(qsort,FQSORT,fqsort,PVOID,INT,INT,ROUTINE)
-
-In order to maintain backward compatibility, cfortran.h defines a generic cast
-for ROUTINE_1, ROUTINE_2, ..., ROUTINE_27. The user's definition is therefore
-strictly required only for DEC C, which at the moment is the only compiler
-which insists on the correct cast for pointers to functions.
-
-When using the ROUTINE argument inside some Fortran code:
-- it is difficult to pass a C routine as the parameter,
- since in many Fortran implementations,
- Fortran has no access to the normal C namespace.
- e.g. For most UNIX,
- Fortran implicitly only has access to C routines ending in _.
- If the calling Fortran code receives the routine as a parameter
- it can of course easily pass it along.
-- if a Fortran routine is passed directly as the parameter,
- the called C routine must call the parameter routine
- using the Fortran argument passing conventions.
-- if a Fortran routine is to be passed as the parameter,
- but if Fortran can be made to pass a C routine as the parameter,
- then it may be best to pass a C-callable wrapper for the Fortran routine.
- The called C routine is thus spared all Fortran argument passing conventions.
- cfortran.h can be used to create such a C-callable wrapper
- to the parameter Fortran routine.
-
-ONLY PowerStationFortran:
-This Fortran provides no easy way to pass a Fortran routine as an argument to a
-C routine. The problem arises because in Fortran the stack is cleared by the
-called routine, while in C/C++ it is cleared by the caller.
-The C/C++ stack clearing behavior can be changed to that of Fortran by using
-stdcall__ in the function prototype. The stdcall__ cannot be applied in this
-case since the called C routine expects the ROUTINE parameter to be a C routine
-and does not know that it should apply stdcall__.
-In principle the cfortran.h generated Fortran callable wrapper for the called C
-routine should be able to massage the ROUTINE argument such that stdcall__ is
-performed, but it is not yet known how this could be easily done.
-
-
-8. THE FOLLOWING INSTRUCTIONS ARE NOT REQUIRED FOR VAX VMS
- ------------
-(P)STRINGV information [NOT required for VAX VMS]: cfortran.h cannot convert
-the FORTRAN vector of STRINGS to the required C vector of STRINGS without
-explicitly knowing the number of elements in the vector. The application must
-do one of the following for each (P)STRINGV argument in a routine before that
-routine's FCALLSCFUNn/SUBn is called:
-
-#define routine_name_STRV_Ai NUM_ELEMS(j)
- or
-#define routine_name_STRV_Ai NUM_ELEM_ARG(k)
- or
-#define routine_name_STRV_Ai TERM_CHARS(l,m)
-
-where: routine_name is as above.
- i [i=1->n.] specifies the argument number of a STRING VECTOR.
- j would specify a fixed number of elements.
- k [k=1->n. k!=i] would specify an integer argument which specifies the
- number of elements.
- l [char] the terminating character at the beginning of an
- element, indicating to cfortran.h that the preceding
- elements in the vector are the valid ones.
- m [m=1-...] the number of terminating characters required to appear
- at the beginning of the terminating string element.
- The terminating element is NOT passed on to
- the C routine.
-
-e.g. #define ce_STRV_A1 TERM_CHARS(' ',2)
- FCALLSCSUB1(ce,CE,ce,STRINGV)
-
-cfortran.h will pass on all elements, in the 1st and only argument to the C
-routine ce, of the STRING VECTOR until, but not including, the first string
-element beginning with 2 blank, ' ', characters.
-
-
-9. INSTRUCTIONS REQUIRED ONLY FOR FORTRAN COMPILERS WHICH GENERATE
- -------------
- ROUTINE NAMES WHICH ARE UNDISTINGUISHABLE FROM C ROUTINE NAMES
- i.e. VAX VMS
- AbsoftUNIXFortran (AbsoftProFortran ok, since it uses Uppercase names.)
- HP9000 if not using the +ppu option of f77
- IBM RS/6000 if not using the -qextname option of xlf
- Call them the same_namespace compilers.
-
-FCALLSCSUBn(...) and FCALLSCFUNn(...), when compiled, are expanded into
-'wrapper' functions, so called because they wrap around the original C
-functions and interface the format of the original C functions' arguments and
-return values with the format of the FORTRAN call.
-
-Ideally one wants to be able to call the C routine from FORTRAN using the same
-name as the original C name. This is not a problem for FORTRAN compilers which
-append an underscore, '_', to the names of routines, since the original C
-routine has the name 'name', and the FORTRAN wrapper is called 'name_'.
-Similarly, if the FORTRAN compiler generates upper case names for routines, the
-original C routine 'name' can have a wrapper called 'NAME', [Assuming the C
-routine name is not in upper case.] For these compilers, e.g. Mips, CRAY, IBM
-RS/6000 'xlf -qextname', HP-UX 'f77 +ppu', the naming of the wrappers is done
-automatically.
-
-For same_namespace compilers things are not as simple, but cfortran.h tries to
-provide tools and guidelines to minimize the costs involved in meeting their
-constraints. The following two options can provide same_namespace compilers
-with distinct names for the wrapper and the original C function.
-
-These compilers are flagged by cfortran.h with the CF_SAME_NAMESPACE constant,
-so that the change in the C name occurs only when required.
-
-For the remainder of the discussion, routine names generated by FORTRAN
-compilers are referred to in lower case, these names should be read as upper
-case for the appropriate compilers.
-
-
-HP9000: (When f77 +ppu is not used.)
-f77 has a -U option which forces uppercase external names to be generated.
-Unfortunately, cc does not handle recursive macros. Hence, if one wished to use
--U for separate C and FORTRAN namespaces, one would have to adopt a different
-convention of naming the macros which allow C to call FORTRAN subroutines.
-(Functions are not a problem.) The macros are currently the uppercase of the
-original FORTRAN name, and would have to be changed to lower case or mixed
-case, or to a different name. (Lower case would of course cause conflicts on
-many other machines.) Therefore, it is suggested that f77 -U not be used, and
-instead that Option a) or Option b) outlined below be used.
-
-
-VAX/VMS:
-For the name used by FORTRAN in calling a C routine to be the same as that of
-the C routine, the source code of the C routine is required. A preprocessor
-directive can then force the C compiler to generate a different name for the C
-routine.
-e.g. #if defined(vms)
- #define name name_
- #endif
- void name() {printf("name: was called.\n");}
- FCALLSCSUB0(name,NAME,name)
-
-In the above, the C compiler generates the original routine with the name
-'name_' and a wrapper called 'NAME'. This assumes that the name of the routine,
-as seen by the C programmer, is not in upper case. The VAX VMS linker is not
-case sensitive, allowing cfortran.h to export the upper case name as the
-wrapper, which then doesn't conflict with the routine name in C. Since the IBM,
-HP and AbsoftUNIXFortran platforms have case sensitive linkers
-this technique is not available to them.
-
-The above technique is required even if the C name is in mixed case, see
-Option a) for the other compilers, but is obviously not required when
-Option b) is used.
-
-
-Option a) Mixed Case names for the C routines to be called by FORTRAN.
-
-If the original C routines have mixed case names, there are no name space
-conflicts.
-
-Nevertheless for VAX/VMS, the technique outlined above must also used.
-
-
-Option b) Modifying the names of C routines when used by FORTRAN:
-
-The more robust naming mechanism, which guarantees portability to all machines,
-'renames' C routines when called by FORTRAN. Indeed, one must change the names
-on same_namespace compilers when FORTRAN calls C routines for which the source
-is unavailable. [Even when the source is available, renaming may be preferable
-to Option a) for large libraries of C routines.]
-
-Obviously, if done for a single type of machine, it must be done for all
-machines since the names of routines used in FORTRAN code cannot be easily
-redefined for different machines.
-
-The simplest way to achieve this end is to do explicitly give the modified
-FORTRAN name in the FCALLSCSUBn(...) and FCALLSCFUNn(...) declarations. e.g.
-
-FCALLSCSUB0(name,CFNAME,cfname)
-
-This allows FORTRAN to call the C routine 'name' as 'cfname'. Any name can of
-course be used for a given routine when it is called from FORTRAN, although
-this is discouraged due to the confusion it is sure to cause. e.g. Bizarre,
-but valid and allowing C's 'call_back' routine to be called from FORTRAN as
-'abcd':
-
-FCALLSCSUB0(call_back,ABCD,abcd)
-
-
-cfortran.h also provides preprocessor directives for a systematic 'renaming' of
-the C routines when they are called from FORTRAN. This is done by redefining
-the fcallsc macro before the FCALLSCSUB/FUN/n declarations as follows:
-
-#undef fcallsc
-#define fcallsc(UN,LN) preface_fcallsc(CF,cf,UN,LN)
-
-FCALLSCSUB0(hello,HELLO,hello)
-
-Will cause C's routine 'hello' to be known in FORTRAN as 'cfhello'. Similarly
-all subsequent FCALLSCSUB/FUN/n declarations will generate wrappers to allow
-FORTRAN to call C with the C routine's name prefaced by 'cf'. The following has
-the same effect, with subsequent FCALLSCSUB/FUN/n's appending the modifier to
-the original C routines name.
-
-#undef fcallsc
-#define fcallsc(UN,LN) append_fcallsc(Y,y,UN,LN)
-
-FCALLSCSUB0(Xroutine,ROUTINE,routine)
-
-Hence, C's Xroutine is called from FORTRAN as:
- CALL XROUTINEY()
-
-The original behavior of FCALLSCSUB/FUN/n, where FORTRAN routine names are left
-identical to those of C, is returned using:
-
-#undef fcallsc
-#define fcallsc(UN,LN) orig_fcallsc(UN,LN)
-
-
-In C, when passing a C routine, i.e. its wrapper, as an argument to a FORTRAN
-routine, the FORTRAN name declared is used and the correct fcallsc must be in
-effect. E.g. Passing 'name' and 'routine' of the above examples to the FORTRAN
-routines, FT1 and FT2, respectively:
-
-/* This might not be needed if fcallsc is already orig_fcallsc. */
-#undef fcallsc
-#define fcallsc(UN,LN) orig_fcallsc(UN,LN)
-FT1(C_FUNCTION(CFNAME,cfname));
-
-#undef fcallsc
-#define fcallsc(UN,LN) append_fcallsc(Y,y,UN,LN)
-FT1(C_FUNCTION(XROUTINE,xroutine));
-
-If the names of C routines are modified when used by FORTRAN, fcallsc would
-usually be defined once in a header_file.h for the application. This definition
-would then be used and be valid for the entire application and fcallsc would at
-no point need to be redefined.
-
-
-ONCE AGAIN: THE DEFINITIONS, INSTRUCTIONS, DECLARATIONS AND DIFFICULTIES
-DESCRIBED HERE, NOTE 9. of II ii),
-APPLY ONLY FOR VAX VMS,
- IBM RS/6000 WITHOUT THE -qextname OPTION FOR xlf, OR
- HP-UX WITHOUT THE +ppu OPTION FOR f77
- AbsoftUNIXFortran
-AND APPLY ONLY WHEN CREATING WRAPPERS WHICH ENABLE FORTRAN TO CALL C ROUTINES.
-
-
-
-iii) Using C to manipulate FORTRAN COMMON BLOCKS:
- -------------------------------------------------------
-
-FORTRAN common blocks are set up with the following three constructs:
-
-1.
-#define Common_block_name COMMON_BLOCK(COMMON_BLOCK_NAME,common_block_name)
-
-Common_block_name is in UPPER CASE.
-COMMON_BLOCK_NAME is in UPPER CASE.
-common_block_name is in lower case.
-[Common_block_name actually follows the same 'rules' as Routine_name in Note 2.
- of II i).] This construct exists to ensure that C code accessing the common
-block is machine independent.
-
-2.
-COMMON_BLOCK_DEF(TYPEDEF_OF_STRUCT, Common_block_name);
-
-where
-typedef { ... } TYPEDEF_OF_STRUCT;
-declares the structure which maps on to the common block. The #define of
-Common_block_name must come before the use of COMMON_BLOCK_DEF.
-
-3.
-In exactly one of the C source files, storage should be set aside for the
-common block with the definition:
-
-TYPEDEF_OF_STRUCT Common_block_name;
-
-The above definition may have to be omitted on some machines for a common block
-which is initialized by Fortran BLOCK DATA or is declared with a smaller size
-in the C routines than in the Fortran routines.
-
-The rules for common blocks are not well defined when linking/loading a mixture
-of C and Fortran, but the following information may help resolve problems.
-
-From the 2nd or ANSI ed. of K&R C, p.31, last paragraph:
-i)
- An external variable must be defined, exactly once, outside of any function;
- this sets aside storage for it.
-ii)
- The variable must also be declared in each function that wants to access it;
- ...
- The declaration ... may be implicit from context.
-
-In Fortran, every routine says 'common /bar/ foo',
-i.e. part ii) of the above, but there's no part i) requirement.
-cc/ld on some machines don't require i) either.
-Therefore, when handling Fortran, and sometimes C,
-the loader/linker must automagically set aside storage for common blocks.
-
-Some loaders, including at least one for the CRAY, turn off the
-'automagically set aside storage' capability for Fortran common blocks,
-if any C object declares that common block.
-Therefore, C code should define, i.e. set aside storage,
-for the the common block as shown above.
-
-e.g.
-C Fortran
- common /fcb/ v,w,x
- character *(13) v, w(4), x(3,2)
-
-/* C */
-typedef struct { char v[13],w[4][13],x[2][3][13]; } FCB_DEF;
-#define Fcb COMMON_BLOCK(FCB,fcb)
-COMMON_BLOCK_DEF(FCB_DEF,Fcb);
-FCB_DEF Fcb; /* Definition, which sets aside storage for Fcb, */
- /* may appear in at most one C source file. */
-
-
-C programs can place a string (or a multidimensional array of strings) into a
-FORTRAN common block using the following call:
-
-C2FCBSTR( CSTR, FSTR,DIMENSIONS);
-
-where:
-
-CSTR is a pointer to the first element of C's copy of the string (array).
- The C code must use a duplicate of, not the original, common block string,
- because the FORTRAN common block does not allocate space for C strings'
- terminating '\0'.
-
-FSTR is a pointer to the first element of the string (array) in the common
- block.
-
-DIMENSIONS is the number of dimensions of string array.
- e.g. char a[10] has DIMENSIONS=0.
- char aa[10][17] has DIMENSIONS=1.
- etc...
-
-C2FCBSTR will copy the string (array) from CSTR to FSTR, padding with blanks,
-' ', the trailing characters as required. C2FCBSTR uses DIMENSIONS and FSTR to
-determine the lengths of the individual string elements and the total number of
-elements in the string array.
-
-Note that:
-- the number of string elements in CSTR and FSTR are identical.
-- for arrays of strings, the useful lengths of strings in CSTR and FSTR must be
- the same. i.e. CSTR elements each have 1 extra character to accommodate the
- terminating '\0'.
-- On most non-ANSI compilers, the DIMENSION argument cannot be prepended by any
- blanks.
-
-
-FCB2CSTR( FSTR, CSTR,DIMENSIONS)
-
-is the inverse of C2FCBSTR, and shares the same arguments and caveats.
-FCB2CSTR copies each string element of FSTR to CSTR, minus FORTRAN strings'
-trailing blanks.
-
-
-cfortran.h USERS ARE STRONGLY URGED TO EXAMINE THE COMMON BLOCK EXAMPLES IN
-cfortest.c AND cfortex.f. The use of strings in common blocks is
-demonstrated, along with a suggested way for C to imitate FORTRAN EQUIVALENCE'd
-variables.
-
-
- ===> USERS OF CFORTRAN.H NEED READ NO FURTHER <===
-
-
-III Some Musings
-----------------
-
-cfortran.h is simple enough to be used by the most basic of applications, i.e.
-making a single C/FORTRAN routine available to the FORTRAN/C programmers. Yet
-cfortran.h is powerful enough to easily make entire C/FORTRAN libraries
-available to FORTRAN/C programmers.
-
-
-cfortran.h is the ideal tool for FORTRAN libraries which are being (re)written
-in C, but are to (continue to) support FORTRAN users. It allows the routines to
-be written in 'natural C', without having to consider the FORTRAN argument
-passing mechanisms of any machine. It also allows C code accessing these
-rewritten routines, to use the C entry point. Without cfortran.h, one risks the
-perverse practice of C code calling a C function using FORTRAN argument passing
-mechanisms!
-
-
-Perhaps the philosophy and mechanisms of cfortran.h could be used and extended
-to create other language bridges such as ADAFORTRAN, CPASCAL, COCCAM, etc.
-
-
-The code generation machinery inside cfortran.h, i.e. the global structure is
-quite good, being clean and workable as seen by its ability to meet the needs
-and constraints of many different compilers. Though the individual instructions
-of the A..., C..., T..., R... and K... tables deserve to be cleaned up.
-
-
-
-IV Getting Serious with cfortran.h
------------------------------------
-
-cfortran.h is set up to be as simple as possible for the casual user. While
-this ease of use will always be present, 'hooks', i.e. preprocessor directives,
-are required in cfortran.h so that some of the following 'inefficiencies' can
-be eliminated if they cause difficulties:
-
-o cfortran.h contains a few small routines for string manipulation. These
-routines are declared static and are included and compiled in all source code
-which uses cfortran.h. Hooks should be provided in cfortran.h to create an
-object file of these routines, allowing cfortran.h to merely prototypes
-these routines in the application source code. This is the only 'problem' which
-afflicts both halves of cfortran.h. The remaining discussion refers to the C
-calls FORTRAN half only.
-
-o Similar to the above routines, cfortran.h generates code for a 'wrapper'
-routine for each FUNCTION exported from FORTRAN. Again cfortran.h needs
-preprocessor directives to create a single object file of these routines,
-and to merely prototype them in the applications.
-
-o Libraries often contain hundreds of routines. While the preprocessor makes
-quick work of generating the required interface code from cfortran.h and the
-application.h's, it may be convenient for very large stable libraries to have
-final_application.h's which already contain the interface code, i.e. these
-final_application.h's would not require cfortran.h. [The convenience can be
-imagined for the VAX VMS CC compiler which has a fixed amount of memory for
-preprocessor directives. Not requiring cfortran.h, with its hundreds of
-directives, could help prevent this compiler from choking on its internal
-limits quite so often.]
-
-With a similar goal in mind, cfortran.h defines 100's of preprocessor
-directives. There is always the potential that these will clash with other tags
-in the users code, so final_applications.h, which don't require cfortran.h,
-also provide the solution.
-
-In the same vein, routines with more than 14 arguments can not be interfaced by
-cfortran.h with compilers which limit C macros to 31 arguments. To resolve this
-difficulty, final_application.h's can be created on a compiler without this
-limitation.
-
-Therefore, new machinery is required to do:
-
-application.h + cfortran.h => final_application.h
-
-The following example may help clarify the means and ends:
-
-If the following definition of the HBOOK1 routine, the /*commented_out_part*/,
-is passed through the preprocessor [perhaps #undefing and #defining preprocessor
-constants if creating an application.h for compiler other than that of the
-preprocessor being used, e.g. cpp -Umips -DCRAY ... ] :
-
-#include "cfortran.h"
-PROTOCCALLSFSUB6(HBOOK1,hbook1,INT,STRING,INT,FLOAT,FLOAT,FLOAT)
-/*#define HBOOK1(ID,CHTITLE,NX,XMI,XMA,VMX) \*/
- CCALLSFSUB6(HBOOK1,hbook1,INT,STRING,INT,FLOAT,FLOAT,FLOAT, \
- ID,CHTITLE,NX,XMI,XMA,VMX)
-
-A function prototype is produced by the PROTOCCALLSFSUB6(...).
-Interface code is produced, based on the 'variables',
-ID,CHTITLE,NX,XMI,XMA,VMX, which will correctly massage a HBOOK1 call.
-Therefore, adding the #define line:
-
-'prototype code'
-#define HBOOK1(ID,CHTITLE,NX,XMI,XMA,VMX) \
- 'interface code'(ID,CHTITLE,NX,XMI,XMA,VMX)
-
-which is placed into final_application.h.
-
-The only known limitation of the above method does not allow the 'variable'
-names to include B1,B2,...,B9,BA,BB,...
-
-Obviously the machinery to automatically generate final_applications.h from
-cfortran.h and applications.h needs more than just some preprocessor
-directives, but a fairly simple unix shell script should be sufficient. Any
-takers?
-
-
-
-V Machine Dependencies of cfortran.h
-------------------------------------
-
-Porting cfortran.h applications, e.g. the hbook.h and cstring.c mentioned
-above, to other machines is trivial since they are machine independent. Porting
-cfortran.h requires a solid knowledge of the new machines C preprocessor, and
-its FORTRAN argument passing mechanisms. Logically cfortran.h exists as two
-halves, a "C CALLS FORTRAN" and a "FORTRAN CALLS C" utility. In some cases it
-may be perfectly reasonable to port only 'one half' of cfortran.h onto a new
-system.
-
-
-The lucky programmer porting cfortran.h to a new machine, must discover the
-FORTRAN argument passing mechanisms. A safe starting point is to assume that
-variables and arrays are simply passed by reference, but nothing is guaranteed.
-Strings, and n-dimensional arrays of strings are a different story. It is
-doubtful that any systems do it quite like VAX VMS does it, so that a UNIX or
-f2c versions may provide an easier starting point.
-
-
-cfortran.h uses and abuses the preprocessor's ## operator. Although the ##
-operator does not exist in many compilers, many kludges do. cfortran.h uses
-/**/ with no space allowed between the slashes, '/', and the macros or tags
-to be concatenated. e.g.
-#define concat(a,b) a/**/b /* works*/
-main()
-{
- concat(pri,ntf)("hello"); /* e.g. */
-}
-N.B. On some compilers without ##, /**/ may also not work. The author may be
-able to offer alternate kludges.
-
-
-
-VI Bugs in vendors C compilers and other curiosities
-----------------------------------------------------
-
-1. ULTRIX xxxxxx 4.3 1 RISC
-
-Condolences to long suffering ultrix users!
-DEC supplies a working C front end for alpha/OSF, but not for ultrix.
-
-From K&R ANSI C p. 231:
- ultrix> cat cat.c
- #define cat(x, y) x ## y
- #define xcat(x,y) cat(x,y)
- cat(cat(1,2),3)
- xcat(xcat(1,2),3)
- ultrix> cc -E cat.c
- 123 <---- Should be: cat(1,2)3
- 123 <---- Correct.
- ultrix>
-
-The problem for cfortran.h, preventing use of -std and -std1:
- ultrix> cat c.c
- #define cat(x, y) x ## y
- #define xcat(x,y) cat(x,y)
- #define AB(X) X+X
- #define C(E,F,G) cat(E,F)(G)
- #define X(E,F,G) xcat(E,F)(G)
- C(A,B,2)
- X(A,B,2)
- ultrix> cc -std1 -E c.c
- 2+2
- AB (2) <---- ?????????????
- ultrix>
- ultrix> cc -std0 -E c.c
- 2+2
- AB(2) <---- ?????????????
- ultrix>
-
-Due to further ultrix preprocessor problems,
-for all definitions of definitions with arguments,
-cfortran.h >= 3.0 includes the arguments and recommends the same,
-even though it is not required by ANSI C.
-e.g. Users are advised to do
- #define fcallsc(UN,LN) orig_fcallsc(UN,LN)
-instead of
- #define fcallsc orig_fcallsc
-since ultrix fails to properly preprocess the latter example.
-CRAY used to (still does?) occasionally trip up on this problem.
-
-
-2. ConvexOS convex C210 11.0 convex
-
-In a program with a C main, output to LUN=6=* from Fortran goes into
-$pwd/fort.6 instead of stdout. Presumably, a magic incantation can be called
-from the C main in order to properly initialize the Fortran I/O.
-
-
-3. SunOS 5.3 Generic_101318-69 sun4m sparc
-
-The default data and code alignments produced by cc, gcc and f77 are compatible.
-If deviating from the defaults, consistent alignment options must be used
-across all objects compiled by cc and f77. [Does gcc provide such options?]
-
-
-4. SunOS 5.3 Generic_101318-69 sun4m sparc with cc: SC3.0.1 13 Jul 1994
- or equivalently
- ULTRIX 4.4 0 RISC using cc -oldc
- are K&R C preprocessors that suffer from infinite loop macros, e.g.
-
- zedy03> cat src.c
- #include "cfortran.h"
- PROTOCCALLSFFUN1(INT,FREV,frev, INTV)
- #define FREV(A1) CCALLSFFUN1( FREV,frev, INTV, A1)
- /* To avoid the problem, deletete these ---^^^^--- spaces. */
- main() { static int a[] = {1,2}; FREV(a); return EXIT_SUCCESS; }
-
- zedy03> cc -c -Xs -v -DMAX_PREPRO_ARGS=31 -D__CF__KnR src.c
- "src.c", line 4: FREV: actuals too long
- "src.c", line 4: FREV: actuals too long
- .... 3427 more lines of the same message
- "src.c", line 4: FREV: actuals too long
- cc : Fatal error in /usr/ccs/lib/cpp
- Segmentation fault (core dumped)
-
-
-5. Older sun C compilers
-
-To link to f77 objects, older sun C compilers require the math.h macros:
-
-#define RETURNFLOAT(x) { union {double _d; float _f; } _kluge; \
- _kluge._f = (x); return _kluge._d; }
-#define ASSIGNFLOAT(x,y) { union {double _d; float _f; } _kluge; \
- _kluge._d = (y); x = _kluge._f; }
-
-Unfortunately, in at least some copies of the sun math.h, the semi-colon
-for 'float _f;' is left out, leading to compiler warnings.
-
-The solution is to correct math.h, or to change cfortran.h to #define
-RETURNFLOAT(x) and ASSIGNFLOAT(x,y) instead of including math.h.
-
-
-6. gcc version 2.6.3 and probably all other versions as well
-
-Unlike all other C compilers supported by cfortran.h,
-'gcc -traditional' promotes to double all functions returning float
-as demonstrated bu the following example.
-
-/* m.c */
-#include <stdio.h>
-int main() { FLOAT_FUNCTION d(); float f; f = d(); printf("%f\n",f); return 0; }
-
-/* d.c */
-float d() { return -123.124; }
-
-burow[29] gcc -c -traditional d.c
-burow[30] gcc -DFLOAT_FUNCTION=float m.c d.o && a.out
-0.000000
-burow[31] gcc -DFLOAT_FUNCTION=double m.c d.o && a.out
--123.124001
-burow[32]
-
-Thus, 'gcc -traditional' is not supported by cfortran.h.
-Support would require the same RETURNFLOAT, etc. macro machinery
-present in old sun math.h, before sun gave up the same promotion.
-
-
-7. CRAY
-
-At least some versions of the t3e and t3d C preprocessor are broken
-in the fashion described below.
-At least some versions of the t90 C preprocessor do not have this problem.
-
-On the CRAY, all Fortran names are converted to uppercase.
-Generally the uppercase name is also used for the macro interface
-created by cfortran.h.
-
-For example, in the following interface,
-EASY is both the name of the macro in the original C code
-and EASY is the name of the resulting function to be called.
-
-#define EASY(A,B) CCALLSFSUB2(EASY,easy, PINT, INTV, A, B)
-
-The fact that a macro called EASY() expands to a function called EASY()
-is not a problem for a working C preprocessor.
-From Kernighan and Ritchie, 2nd edition, p.230:
-
- In both kinds of macro, the replacement token sequence is repeatedly
- rescanned for more identifiers. However, once a given identifier has been
- replaced in a given expansion, it is not replaced if it turns up again during
- rescanning; instead it is left unchanged.
-
-Unfortunately, some CRAY preprocessors are broken and don't obey the above rule.
-A work-around is for the user to NOT use the uppercase name
-of the name of the macro interface provided by cfortran.h. For example:
-
-#define Easy(A,B) CCALLSFSUB2(EASY,easy, PINT, INTV, A, B)
-
-Luckily, the above work-around is not required since the following
-work-around within cfortran.h also circumvents the bug:
-
- /* (UN), not UN, is required in order to get around CRAY preprocessor bug.*/
- #define CFC_(UN,LN) (UN) /* Uppercase FORTRAN symbols. */
-
-Aside: The Visual C++ compiler is happy with UN, but barfs on (UN),
- so either (UN) causes nonstandard C/C++ or Visual C++ is broken.
-
-
-VII History and Acknowledgements
---------------------------------
-
-1.0 - Supports VAX VMS using C 3.1 and FORTRAN 5.4. Oct. '90.
-1.0 - Supports Silicon Graphics w. Mips Computer 2.0 f77 and cc. Feb. '91.
- [Port of C calls FORTRAN half only.]
-1.1 - Supports Mips Computer System 2.0 f77 and cc. Mar. '91.
- [Runs on at least: Silicon Graphics IRIX 3.3.1
- DECstations with Ultrix V4.1]
-1.2 - Internals made simpler, smaller, faster, stronger. May '91.
- - Mips version works on IBM RS/6000, this is now called the unix version.
-1.3 - UNIX and VAX VMS versions are merged into a single cfortran.h. July '91.
- - C can help manipulate (arrays of) strings in FORTRAN common blocks.
- - Dimensions of string arrays arguments can be explicit.
- - Supports Apollo DomainOS 10.2 (sys5.3) with f77 10.7 and cc 6.7.
-
-2.0 - Improved code generation machinery creates K&R or ANSI C. Aug. '91.
- - Supports Sun, CRAY. f2c with vcc on VAX Ultrix.
- - cfortran.h macros now require routine and COMMON block names in both
- upper and lower case. No changes required to applications though.
- - PROTOCCALLSFSUBn is eliminated, with no loss to cfortran.h performance.
- - Improved tools and guidelines for naming C routines called by FORTRAN.
-2.1 - LOGICAL correctly supported across all machines. Oct. '91.
- - Improved support for DOUBLE PRECISION on the CRAY.
- - HP9000 fully supported.
- - VAX Ultrix cc or gcc with f77 now supported.
-2.2 - SHORT, i.e. INTEGER*2, and BYTE now supported. Dec. '91.
- - LOGICAL_STRICT introduced. More compact and robust internal tables.
- - typeV and typeVV for type = BYTE, DOUBLE, FLOAT, INT, LOGICAL, LONG,SHORT.
- - FORTRAN passing strings and NULL pointer to C routines improved.
-2.3 - Extraneous arguments removed from many internal tables. May '92.
- - Introduce pseudo argument type SIMPLE for user defined types.
- - LynxOS using f2c supported. (Tested with LynxOS 2.0 386/AT.)
-2.4 - Separation of internal C and Fortran compilation directives. Oct. '92.
- - f2c and NAG f90 supported on all machines.
-2.5 - Minor mod.s to source and/or doc for HP9000, f2c, and NAG f90. Nov. '92.
-2.6 - Support external procedures as arguments with type ROUTINE. Dec. '92.
-2.7 - Support Alpha VMS. Support HP9000 f77 +ppu Jan. '93.
- - Support arrays with up to 7 dimensions.
- - Minor mod. of Fortran NULL to C via (P)STRING.
- - Specify the type of ROUTINE passed from Fortran to C [ANSI C requirement.]
- - Macros never receive a null parameter [RS/6000 requirement.]
-2.8 - PSTRING for Fortran calls C no longer provides escape to pass April'93.
- NULL pointer nor to pass address of original string.
- PNSTRING introduced with old PSTRING's behavior.
- PPSTRING introduced to always pass original address of string.
- - Support Alpha/OSF.
- - Document that common blocks used in C should be declared AND defined.
-
-3.0 - Automagic handling of ANSI ## versus K&R /**/ preprocessor op. March'95.
- - Less chance of name space collisions between cfortran.h and other codes.
- - SIMPLE macros, supporting user defined types, have changed names.
-3.1 - Internal macro name _INT not used. Conflicted with IRIX 5.3. May '95.
- - SunOS, all versions, should work out of the box.
- - ZTRINGV_ARGS|F(k) may no longer point to a PDOUBLE or PFLOAT argument.
- - ConvexOS 11.0 supported.
-3.2 - __hpux no longer needs to be restricted to MAX_PREPRO_ARGS=31. Oct. '95.
- - PSTRING bug fixed.
- - ZTRINGV_ARGS|F(k) may not point to a PBYTE,PINT,PLONG or PSHORT argument.
- - (P)ZTRINGV machinery improved. Should lead to fewer compiler warnings.
- (P)ZTRINGV no longer limits recursion or the nesting of routines.
- - SIMPLE macros, supporting user defined types, have changed slightly.
-3.3 - Supports PowerStation Fortran with Visual C++. Nov. '95.
- - g77 should work using f2cFortran, though no changes made for it.
- - (PROTO)CCALLSFFUN10 extended to (PROTO)CCALLSFFUN14.
- - FCALLSCFUN10 and SUB10 extended to FCALLSCFUN14 and SUB14.
-3.4 - C++ supported, Dec. '95.
- but it required the reintroduction of PROTOCCALLSFSUBn for users.
- - HP-UX f77 +800 supported.
-3.5 - Absoft UNIX Fortran supported. Sept.'96.
-3.6 - Minor corrections to cfortran.doc. Oct. '96.
- - Fixed bug for 15th argument. [Thanks to Tom Epperly at Aspen Tech.]
- - For AbsoftUNIXFortran, obey default of prepending _C to COMMON BLOCK name.
- - Fortran calling C with ROUTINE argument fixed and cleaned up.
-3.7 - Circumvent IBM and HP "null argument" preprocessor warning. Oct. '96
-3.8 - (P)STRINGV and (P)ZTRINGV can pass a 1- or 2-dim. char array. Feb. '97
- (P)ZTRINGV thus effectively also provides (P)ZTRING.
- - (P)ZTRINGV accepts a (char *) pointer.
-3.9 - Bug fixed for *VVVVV. May '97
- - f2c: Work-around for strange underscore-dependent naming feature.
- - NEC SX-4 supported.
- - CRAY: LOGICAL conversion uses _btol and _ltob from CRAY's fortran.h.
- - CRAY: Avoid bug of some versions of the C preprocessor.
- - CRAY T3E: FORTRAN_REAL introduced.
-
-4.0 - new/delete now used for C++. malloc/free still used for C. Jan. '98
- - FALSE no longer is defined by cfortran.h .
- - Absoft Pro Fortran for MacOS supported.
-4.1 - COMMA and COLON no longer are defined by cfortran.h . April'98
- - Bug fixed when 10th arg. or beyond is a string.
- [Rob Lucchesi of NASA-Goddard pointed out this bug.]
- - CCALLSFSUB/FUN extended from 14 to 27 arguments.
- - Workaround SunOS CC 4.2 cast bug. [Thanks to Savrak SAR of CERN.]
-4.2 - Portland Group needs -DpgiFortran . [Thank George Lai of NASA.] June '98
-4.3 - (PROTO)CCALLSFSUB extended from 20 to 27 arguments. July '98
-
-
-['Support' implies these and more recent releases of the respective
- OS/compilers/linkers can be used with cfortran.h.
- Earlier releases may also work.]
-
-
-Acknowledgements:
-- CERN very generously sponsored a week in 1994 for me to work on cfortran.h.
-- M.L.Luvisetto (Istituto Nazionale Fisica Nucleare - Centro Nazionale
- Analisi Fotogrammi, Bologna, Italy) provided all the support for the port to
- the CRAY. Marisa's encouragement and enthusiasm was also much appreciated.
-- J.Bunn (CERN) supported the port to PowerStation Fortran with Visual C++.
-- Paul Schenk (UC Riverside, CERN PPE/OPAL) in June 1993 extended cfortran.h 2.7
- to have C++ call Fortran. This was the starting point for full C++ in 3.4.
-- Glenn P.Davis of University Corp. for Atmospheric Research (UCAR) / Unidata
- supported the NEC SX-4 port and helped understand the CRAY.
-- Tony Goelz of Absoft Corporation ported cfortran.h to Absoft.
-- Though cfortran.h has been created in my 'copious' free time, I thank
- NSERC for their generous support of my grad. student and postdoc years.
-- Univ.Toronto, DESY, CERN and others have provided time on their computers.
-
-
-THIS PACKAGE, I.E. CFORTRAN.H, THIS DOCUMENT, AND THE CFORTRAN.H EXAMPLE
-PROGRAMS ARE PROPERTY OF THE AUTHOR WHO RESERVES ALL RIGHTS. THIS PACKAGE AND
-THE CODE IT PRODUCES MAY BE FREELY DISTRIBUTED WITHOUT FEES, SUBJECT TO THE
-FOLLOWING RESTRICTIONS:
-- YOU MUST ACCOMPANY ANY COPIES OR DISTRIBUTION WITH THIS (UNALTERED) NOTICE.
-- YOU MAY NOT RECEIVE MONEY FOR THE DISTRIBUTION OR FOR ITS MEDIA
- (E.G. TAPE, DISK, COMPUTER, PAPER.)
-- YOU MAY NOT PREVENT OTHERS FROM COPYING IT FREELY.
-- YOU MAY NOT DISTRIBUTE MODIFIED VERSIONS WITHOUT CLEARLY DOCUMENTING YOUR
- CHANGES AND NOTIFYING THE AUTHOR.
-- YOU MAY NOT MISREPRESENTED THE ORIGIN OF THIS SOFTWARE, EITHER BY EXPLICIT
- CLAIM OR BY OMISSION.
-
-THE INTENT OF THE ABOVE TERMS IS TO ENSURE THAT THE CFORTRAN.H PACKAGE NOT BE
-USED FOR PROFIT MAKING ACTIVITIES UNLESS SOME ROYALTY ARRANGEMENT IS ENTERED
-INTO WITH ITS AUTHOR.
-
-THIS SOFTWARE IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
-EXPRESSED OR IMPLIED. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE
-SOFTWARE IS WITH YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST
-OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. THE AUTHOR IS NOT RESPONSIBLE
-FOR ANY SUPPORT OR SERVICE OF THE CFORTRAN.H PACKAGE.
-
- Burkhard Burow
- burow at desy.de
-
-P.S. Your comments and questions are welcomed and usually promptly answered.
-
-VAX VMS and Ultrix, Alpha, OSF, Silicon Graphics (SGI), DECstation, Mips RISC,
-Sun, CRAY, Convex, IBM RS/6000, Apollo DomainOS, HP, LynxOS, f2c, NAG, Absoft,
-NEC SX-4, PowerStation and Visual C++ are registered trademarks of their
-respective owners.
-
-/* end: cfortran.doc */
diff --git a/src/cfortran/cfortran.h b/src/cfortran/cfortran.h
deleted file mode 100755
index efde0cb..0000000
--- a/src/cfortran/cfortran.h
+++ /dev/null
@@ -1,2363 +0,0 @@
-/* cfortran.h 4.4_cernlib2002 */
-/* http://www-zeus.desy.de/~burow/cfortran/ */
-/* Burkhard Burow burow at desy.de 1990 - 2002. */
-
-#ifndef __CFORTRAN_LOADED
-#define __CFORTRAN_LOADED
-
-/*
- THIS FILE IS PROPERTY OF BURKHARD BUROW. IF YOU ARE USING THIS FILE YOU
- SHOULD ALSO HAVE ACCESS TO CFORTRAN.DOC WHICH PROVIDES TERMS FOR USING,
- MODIFYING, COPYING AND DISTRIBUTING THE CFORTRAN.H PACKAGE.
-*/
-
-/*
- Avoid symbols already used by compilers and system *.h:
- __ - OSF1 zukal06 V3.0 347 alpha, cc -c -std1 cfortest.c
-
- */
-
-
-/* First prepare for the C compiler. */
-
-#ifndef ANSI_C_preprocessor /* i.e. user can override. */
-#ifdef __CF__KnR
-#define ANSI_C_preprocessor 0
-#else
-#ifdef __STDC__
-#define ANSI_C_preprocessor 1
-#else
-#define _cfleft 1
-#define _cfright
-#define _cfleft_cfright 0
-#define ANSI_C_preprocessor _cfleft/**/_cfright
-#endif
-#endif
-#endif
-
-#if ANSI_C_preprocessor
-#define _0(A,B) A##B
-#define _(A,B) _0(A,B) /* see cat,xcat of K&R ANSI C p. 231 */
-#define _2(A,B) A##B /* K&R ANSI C p.230: .. identifier is not replaced */
-#define _3(A,B,C) _(A,_(B,C))
-#else /* if it turns up again during rescanning. */
-#define _(A,B) A/**/B
-#define _2(A,B) A/**/B
-#define _3(A,B,C) A/**/B/**/C
-#endif
-
-#if (defined(vax)&&defined(unix)) || (defined(__vax__)&&defined(__unix__))
-#define VAXUltrix
-#endif
-
-#include <stdio.h> /* NULL [in all machines stdio.h] */
-#include <string.h> /* strlen, memset, memcpy, memchr. */
-#if !( defined(VAXUltrix) || defined(sun) || (defined(apollo)&&!defined(__STDCPP__)) )
-#include <stdlib.h> /* malloc,free */
-#else
-#include <malloc.h> /* Had to be removed for DomainOS h105 10.4 sys5.3 425t*/
-#ifdef apollo
-#define __CF__APOLLO67 /* __STDCPP__ is in Apollo 6.8 (i.e. ANSI) and onwards */
-#endif
-#endif
-
-#if !defined(__GNUC__) && !defined(__sun) && (defined(sun)||defined(VAXUltrix)||defined(lynx))
-#define __CF__KnR /* Sun, LynxOS and VAX Ultrix cc only supports K&R. */
- /* Manually define __CF__KnR for HP if desired/required.*/
-#endif /* i.e. We will generate Kernighan and Ritchie C. */
-/* Note that you may define __CF__KnR before #include cfortran.h, in order to
-generate K&R C instead of the default ANSI C. The differences are mainly in the
-function prototypes and declarations. All machines, except the Apollo, work
-with either style. The Apollo's argument promotion rules require ANSI or use of
-the obsolete std_$call which we have not implemented here. Hence on the Apollo,
-only C calling FORTRAN subroutines will work using K&R style.*/
-
-
-/* Remainder of cfortran.h depends on the Fortran compiler. */
-
-#if defined(CLIPPERFortran) || defined(pgiFortran)
-#define f2cFortran
-#endif
-
-/* VAX/VMS does not let us \-split long #if lines. */
-/* Split #if into 2 because some HP-UX can't handle long #if */
-#if !(defined(NAGf90Fortran)||defined(f2cFortran)||defined(hpuxFortran)||defined(apolloFortran)||defined(sunFortran)||defined(IBMR2Fortran)||defined(CRAYFortran))
-#if !(defined(mipsFortran)||defined(DECFortran)||defined(vmsFortran)||defined(CONVEXFortran)||defined(PowerStationFortran)||defined(AbsoftUNIXFortran)||defined(AbsoftProFortran)||defined(SXFortran))
-/* If no Fortran compiler is given, we choose one for the machines we know. */
-#if defined(lynx) || defined(VAXUltrix)
-#define f2cFortran /* Lynx: Only support f2c at the moment.
- VAXUltrix: f77 behaves like f2c.
- Support f2c or f77 with gcc, vcc with f2c.
- f77 with vcc works, missing link magic for f77 I/O.*/
-#endif
-#if defined(__hpux) /* 921107: Use __hpux instead of __hp9000s300 */
-#define hpuxFortran /* Should also allow hp9000s7/800 use.*/
-#endif
-#if defined(apollo)
-#define apolloFortran /* __CF__APOLLO67 also defines some behavior. */
-#endif
-#if defined(sun) || defined(__sun)
-#define sunFortran
-#endif
-#if defined(_IBMR2)
-#define IBMR2Fortran
-#endif
-#if defined(_CRAY)
-#define CRAYFortran /* _CRAYT3E also defines some behavior. */
-#endif
-#if defined(_SX)
-#define SXFortran
-#endif
-#if defined(mips) || defined(__mips)
-#define mipsFortran
-#endif
-#if defined(vms) || defined(__vms)
-#define vmsFortran
-#endif
-#if defined(__alpha) && defined(__unix__)
-#define DECFortran
-#endif
-#if defined(__convex__)
-#define CONVEXFortran
-#endif
-#if defined(VISUAL_CPLUSPLUS)
-#define PowerStationFortran
-#endif
-#endif /* ...Fortran */
-#endif /* ...Fortran */
-
-/* Split #if into 2 because some HP-UX can't handle long #if */
-#if !(defined(NAGf90Fortran)||defined(f2cFortran)||defined(hpuxFortran)||defined(apolloFortran)||defined(sunFortran)||defined(IBMR2Fortran)||defined(CRAYFortran))
-#if !(defined(mipsFortran)||defined(DECFortran)||defined(vmsFortran)||defined(CONVEXFortran)||defined(PowerStationFortran)||defined(AbsoftUNIXFortran)||defined(AbsoftProFortran)||defined(SXFortran))
-/* If your compiler barfs on ' #error', replace # with the trigraph for # */
- #error "cfortran.h: Can't find your environment among:\
- - MIPS cc and f77 2.0. (e.g. Silicon Graphics, DECstations, ...) \
- - IBM AIX XL C and FORTRAN Compiler/6000 Version 01.01.0000.0000 \
- - VAX VMS CC 3.1 and FORTRAN 5.4. \
- - Alpha VMS DEC C 1.3 and DEC FORTRAN 6.0. \
- - Alpha OSF DEC C and DEC Fortran for OSF/1 AXP Version 1.2 \
- - Apollo DomainOS 10.2 (sys5.3) with f77 10.7 and cc 6.7. \
- - CRAY \
- - NEC SX-4 SUPER-UX \
- - CONVEX \
- - Sun \
- - PowerStation Fortran with Visual C++ \
- - HP9000s300/s700/s800 Latest test with: HP-UX A.08.07 A 9000/730 \
- - LynxOS: cc or gcc with f2c. \
- - VAXUltrix: vcc,cc or gcc with f2c. gcc or cc with f77. \
- - f77 with vcc works; but missing link magic for f77 I/O. \
- - NO fort. None of gcc, cc or vcc generate required names.\
- - f2c : Use #define f2cFortran, or cc -Df2cFortran \
- - NAG f90: Use #define NAGf90Fortran, or cc -DNAGf90Fortran \
- - Absoft UNIX F77: Use #define AbsoftUNIXFortran or cc -DAbsoftUNIXFortran \
- - Absoft Pro Fortran: Use #define AbsoftProFortran \
- - Portland Group Fortran: Use #define pgiFortran"
-/* Compiler must throw us out at this point! */
-#endif
-#endif
-
-
-#if defined(VAXC) && !defined(__VAXC)
-#define OLD_VAXC
-#pragma nostandard /* Prevent %CC-I-PARAMNOTUSED. */
-#endif
-
-/* Throughout cfortran.h we use: UN = Uppercase Name. LN = Lowercase Name. */
-
-#if defined(f2cFortran) || defined(NAGf90Fortran) || defined(DECFortran) || defined(mipsFortran) || defined(apolloFortran) || defined(sunFortran) || defined(CONVEXFortran) || defined(SXFortran) || defined(extname)
-#define CFC_(UN,LN) _(LN,_) /* Lowercase FORTRAN symbols. */
-#define orig_fcallsc(UN,LN) CFC_(UN,LN)
-#else
-#if defined(CRAYFortran) || defined(PowerStationFortran) || defined(AbsoftProFortran)
-#ifdef _CRAY /* (UN), not UN, circumvents CRAY preprocessor bug. */
-#define CFC_(UN,LN) (UN) /* Uppercase FORTRAN symbols. */
-#else /* At least VISUAL_CPLUSPLUS barfs on (UN), so need UN. */
-#define CFC_(UN,LN) UN /* Uppercase FORTRAN symbols. */
-#endif
-#define orig_fcallsc(UN,LN) CFC_(UN,LN) /* CRAY insists on arg.'s here. */
-#else /* For following machines one may wish to change the fcallsc default. */
-#define CF_SAME_NAMESPACE
-#ifdef vmsFortran
-#define CFC_(UN,LN) LN /* Either case FORTRAN symbols. */
- /* BUT we usually use UN for C macro to FORTRAN routines, so use LN here,*/
- /* because VAX/VMS doesn't do recursive macros. */
-#define orig_fcallsc(UN,LN) UN
-#else /* HP-UX without +ppu or IBMR2 without -qextname. NOT reccomended. */
-#define CFC_(UN,LN) LN /* Lowercase FORTRAN symbols. */
-#define orig_fcallsc(UN,LN) CFC_(UN,LN)
-#endif /* vmsFortran */
-#endif /* CRAYFortran PowerStationFortran */
-#endif /* ....Fortran */
-
-#define fcallsc(UN,LN) orig_fcallsc(UN,LN)
-#define preface_fcallsc(P,p,UN,LN) CFC_(_(P,UN),_(p,LN))
-#define append_fcallsc(P,p,UN,LN) CFC_(_(UN,P),_(LN,p))
-
-#define C_FUNCTION(UN,LN) fcallsc(UN,LN)
-#define FORTRAN_FUNCTION(UN,LN) CFC_(UN,LN)
-
-#ifndef COMMON_BLOCK
-#ifndef CONVEXFortran
-#ifndef CLIPPERFortran
-#if !(defined(AbsoftUNIXFortran)||defined(AbsoftProFortran))
-#define COMMON_BLOCK(UN,LN) CFC_(UN,LN)
-#else
-#define COMMON_BLOCK(UN,LN) _(_C,LN)
-#endif /* AbsoftUNIXFortran or AbsoftProFortran */
-#else
-#define COMMON_BLOCK(UN,LN) _(LN,__)
-#endif /* CLIPPERFortran */
-#else
-#define COMMON_BLOCK(UN,LN) _3(_,LN,_)
-#endif /* CONVEXFortran */
-#endif /* COMMON_BLOCK */
-
-#ifndef DOUBLE_PRECISION
-#if defined(CRAYFortran) && !defined(_CRAYT3E)
-#define DOUBLE_PRECISION long double
-#else
-#define DOUBLE_PRECISION double
-#endif
-#endif
-
-#ifndef FORTRAN_REAL
-#if defined(CRAYFortran) && defined(_CRAYT3E)
-#define FORTRAN_REAL double
-#else
-#define FORTRAN_REAL float
-#endif
-#endif
-
-#ifdef CRAYFortran
-#ifdef _CRAY
-#include <fortran.h>
-#else
-#include "fortran.h" /* i.e. if crosscompiling assume user has file. */
-#endif
-#define FLOATVVVVVVV_cfPP (FORTRAN_REAL *) /* Used for C calls FORTRAN. */
-/* CRAY's double==float but CRAY says pointers to doubles and floats are diff.*/
-#define VOIDP (void *) /* When FORTRAN calls C, we don't know if C routine
- arg.'s have been declared float *, or double *. */
-#else
-#define FLOATVVVVVVV_cfPP
-#define VOIDP
-#endif
-
-#ifdef vmsFortran
-#if defined(vms) || defined(__vms)
-#include <descrip.h>
-#else
-#include "descrip.h" /* i.e. if crosscompiling assume user has file. */
-#endif
-#endif
-
-#ifdef sunFortran
-#if defined(sun) || defined(__sun)
-#include <math.h> /* Sun's FLOATFUNCTIONTYPE, ASSIGNFLOAT, RETURNFLOAT. */
-#else
-#include "math.h" /* i.e. if crosscompiling assume user has file. */
-#endif
-/* At least starting with the default C compiler SC3.0.1 of SunOS 5.3,
- * FLOATFUNCTIONTYPE, ASSIGNFLOAT, RETURNFLOAT are not required and not in
- * <math.h>, since sun C no longer promotes C float return values to doubles.
- * Therefore, only use them if defined.
- * Even if gcc is being used, assume that it exhibits the Sun C compiler
- * behavior in order to be able to use *.o from the Sun C compiler.
- * i.e. If FLOATFUNCTIONTYPE, etc. are in math.h, they required by gcc.
- */
-#endif
-
-#ifndef apolloFortran
-#define COMMON_BLOCK_DEF(DEFINITION, NAME) DEFINITION NAME
-#define CF_NULL_PROTO
-#else /* HP doesn't understand #elif. */
-/* Without ANSI prototyping, Apollo promotes float functions to double. */
-/* Note that VAX/VMS, IBM, Mips choke on 'type function(...);' prototypes. */
-#define CF_NULL_PROTO ...
-#ifndef __CF__APOLLO67
-#define COMMON_BLOCK_DEF(DEFINITION, NAME) \
- DEFINITION NAME __attribute((__section(NAME)))
-#else
-#define COMMON_BLOCK_DEF(DEFINITION, NAME) \
- DEFINITION NAME #attribute[section(NAME)]
-#endif
-#endif
-
-#ifdef __cplusplus
-#undef CF_NULL_PROTO
-#define CF_NULL_PROTO ...
-#endif
-
-
-#ifndef USE_NEW_DELETE
-#ifdef __cplusplus
-#define USE_NEW_DELETE 1
-#else
-#define USE_NEW_DELETE 0
-#endif
-#endif
-#if USE_NEW_DELETE
-#define _cf_malloc(N) new char[N]
-#define _cf_free(P) delete[] P
-#else
-#define _cf_malloc(N) (char *)malloc(N)
-#define _cf_free(P) free(P)
-#endif
-
-#ifdef mipsFortran
-#define CF_DECLARE_GETARG int f77argc; char **f77argv
-#define CF_SET_GETARG(ARGC,ARGV) f77argc = ARGC; f77argv = ARGV
-#else
-#define CF_DECLARE_GETARG
-#define CF_SET_GETARG(ARGC,ARGV)
-#endif
-
-#ifdef OLD_VAXC /* Allow %CC-I-PARAMNOTUSED. */
-#pragma standard
-#endif
-
-#define AcfCOMMA ,
-#define AcfCOLON ;
-
-/*-------------------------------------------------------------------------*/
-
-/* UTILITIES USED WITHIN CFORTRAN.H */
-
-#define _cfMIN(A,B) (A<B?A:B)
-
-/* 970211 - XIX.145:
- firstindexlength - better name is all_but_last_index_lengths
- secondindexlength - better name is last_index_length
- */
-#define firstindexlength(A) (sizeof(A[0])==1 ? 1 : (sizeof(A) / sizeof(A[0])) )
-#define secondindexlength(A) (sizeof(A[0])==1 ? sizeof(A) : sizeof(A[0]) )
-
-/* Behavior of FORTRAN LOGICAL. All machines' LOGICAL is same size as C's int.
-Conversion is automatic except for arrays which require F2CLOGICALV/C2FLOGICALV.
-f2c, MIPS f77 [DECstation, SGI], VAX Ultrix f77,
-HP-UX f77 : as in C.
-VAX/VMS FORTRAN, VAX Ultrix fort,
-Absoft Unix Fortran, IBM RS/6000 xlf : LS Bit = 0/1 = TRUE/FALSE.
-Apollo : neg. = TRUE, else FALSE.
-[Apollo accepts -1 as TRUE for function values, but NOT all other neg. values.]
-[DECFortran for Ultrix RISC is also called f77 but is the same as VAX/VMS.]
-[MIPS f77 treats .eqv./.neqv. as .eq./.ne. and hence requires LOGICAL_STRICT.]*/
-
-#if defined(NAGf90Fortran) || defined(f2cFortran) || defined(mipsFortran) || defined(PowerStationFortran) || defined(hpuxFortran800) || defined(AbsoftUNIXFortran) || defined(AbsoftProFortran) || defined(SXFortran)
-/* SX/PowerStationFortran have 0 and 1 defined, others are neither T nor F. */
-/* hpuxFortran800 has 0 and 0x01000000 defined. Others are unknown. */
-#define LOGICAL_STRICT /* Other Fortran have .eqv./.neqv. == .eq./.ne. */
-#endif
-
-#define C2FLOGICALV(A,I) \
- do {int __i; for(__i=0;__i<I;__i++) A[__i]=C2FLOGICAL(A[__i]); } while (0)
-#define F2CLOGICALV(A,I) \
- do {int __i; for(__i=0;__i<I;__i++) A[__i]=F2CLOGICAL(A[__i]); } while (0)
-
-#if defined(apolloFortran)
-#define C2FLOGICAL(L) ((L)?-1:(L)&~((unsigned)1<<sizeof(int)*8-1))
-#define F2CLOGICAL(L) ((L)<0?(L):0)
-#else
-#if defined(CRAYFortran)
-#define C2FLOGICAL(L) _btol(L)
-#define F2CLOGICAL(L) _ltob(&(L)) /* Strangely _ltob() expects a pointer. */
-#else
-#if defined(IBMR2Fortran) || defined(vmsFortran) || defined(DECFortran) || defined(AbsoftUNIXFortran)
-/* How come no AbsoftProFortran ? */
-#define C2FLOGICAL(L) ((L)?(L)|1:(L)&~(int)1)
-#define F2CLOGICAL(L) ((L)&1?(L):0)
-#else
-#if defined(CONVEXFortran)
-#define C2FLOGICAL(L) ((L) ? ~0 : 0 )
-#define F2CLOGICAL(L) (L)
-#else /* others evaluate LOGICALs as for C. */
-#define C2FLOGICAL(L) (L)
-#define F2CLOGICAL(L) (L)
-#ifndef LOGICAL_STRICT
-#undef C2FLOGICALV
-#undef F2CLOGICALV
-#define C2FLOGICALV(A,I)
-#define F2CLOGICALV(A,I)
-#endif /* LOGICAL_STRICT */
-#endif /* CONVEXFortran || All Others */
-#endif /* IBMR2Fortran vmsFortran DECFortran AbsoftUNIXFortran */
-#endif /* CRAYFortran */
-#endif /* apolloFortran */
-
-/* 970514 - In addition to CRAY, there may be other machines
- for which LOGICAL_STRICT makes no sense. */
-#if defined(LOGICAL_STRICT) && !defined(CRAYFortran)
-/* Force C2FLOGICAL to generate only the values for either .TRUE. or .FALSE.
- SX/PowerStationFortran only have 0 and 1 defined.
- Elsewhere, only needed if you want to do:
- logical lvariable
- if (lvariable .eq. .true.) then ! (1)
- instead of
- if (lvariable .eqv. .true.) then ! (2)
- - (1) may not even be FORTRAN/77 and that Apollo's f77 and IBM's xlf
- refuse to compile (1), so you are probably well advised to stay away from
- (1) and from LOGICAL_STRICT.
- - You pay a (slight) performance penalty for using LOGICAL_STRICT. */
-#undef C2FLOGICAL
-#ifdef hpuxFortran800
-#define C2FLOGICAL(L) ((L)?0x01000000:0)
-#else
-#if defined(apolloFortran) || defined(vmsFortran) || defined(DECFortran)
-#define C2FLOGICAL(L) ((L)?-1:0) /* These machines use -1/0 for .true./.false.*/
-#else
-#define C2FLOGICAL(L) ((L)? 1:0) /* All others use +1/0 for .true./.false.*/
-#endif
-#endif
-#endif /* LOGICAL_STRICT */
-
-/* Convert a vector of C strings into FORTRAN strings. */
-#ifndef __CF__KnR
-static char *c2fstrv(char* cstr, char *fstr, int elem_len, int sizeofcstr)
-#else
-static char *c2fstrv( cstr, fstr, elem_len, sizeofcstr)
- char* cstr; char *fstr; int elem_len; int sizeofcstr;
-#endif
-{ int i,j;
-/* elem_len includes \0 for C strings. Fortran strings don't have term. \0.
- Useful size of string must be the same in both languages. */
-for (i=0; i<sizeofcstr/elem_len; i++) {
- for (j=1; j<elem_len && *cstr; j++) *fstr++ = *cstr++;
- cstr += 1+elem_len-j;
- for (; j<elem_len; j++) *fstr++ = ' ';
-} /* 95109 - Seems to be returning the original fstr. */
-return fstr-sizeofcstr+sizeofcstr/elem_len; }
-
-/* Convert a vector of FORTRAN strings into C strings. */
-#ifndef __CF__KnR
-static char *f2cstrv(char *fstr, char* cstr, int elem_len, int sizeofcstr)
-#else
-static char *f2cstrv( fstr, cstr, elem_len, sizeofcstr)
- char *fstr; char* cstr; int elem_len; int sizeofcstr;
-#endif
-{ int i,j;
-/* elem_len includes \0 for C strings. Fortran strings don't have term. \0.
- Useful size of string must be the same in both languages. */
-cstr += sizeofcstr;
-fstr += sizeofcstr - sizeofcstr/elem_len;
-for (i=0; i<sizeofcstr/elem_len; i++) {
- *--cstr = '\0';
- for (j=1; j<elem_len; j++) *--cstr = *--fstr;
-} return cstr; }
-
-/* kill the trailing char t's in string s. */
-#ifndef __CF__KnR
-static char *kill_trailing(char *s, char t)
-#else
-static char *kill_trailing( s, t) char *s; char t;
-#endif
-{char *e;
-e = s + strlen(s);
-if (e>s) { /* Need this to handle NULL string.*/
- while (e>s && *--e==t); /* Don't follow t's past beginning. */
- e[*e==t?0:1] = '\0'; /* Handle s[0]=t correctly. */
-} return s; }
-
-/* kill_trailingn(s,t,e) will kill the trailing t's in string s. e normally
-points to the terminating '\0' of s, but may actually point to anywhere in s.
-s's new '\0' will be placed at e or earlier in order to remove any trailing t's.
-If e<s string s is left unchanged. */
-#ifndef __CF__KnR
-static char *kill_trailingn(char *s, char t, char *e)
-#else
-static char *kill_trailingn( s, t, e) char *s; char t; char *e;
-#endif
-{
-if (e==s) *e = '\0'; /* Kill the string makes sense here.*/
-else if (e>s) { /* Watch out for neg. length string.*/
- while (e>s && *--e==t); /* Don't follow t's past beginning. */
- e[*e==t?0:1] = '\0'; /* Handle s[0]=t correctly. */
-} return s; }
-
-/* Note the following assumes that any element which has t's to be chopped off,
-does indeed fill the entire element. */
-#ifndef __CF__KnR
-static char *vkill_trailing(char* cstr, int elem_len, int sizeofcstr, char t)
-#else
-static char *vkill_trailing( cstr, elem_len, sizeofcstr, t)
- char* cstr; int elem_len; int sizeofcstr; char t;
-#endif
-{ int i;
-for (i=0; i<sizeofcstr/elem_len; i++) /* elem_len includes \0 for C strings. */
- kill_trailingn(cstr+elem_len*i,t,cstr+elem_len*(i+1)-1);
-return cstr; }
-
-#ifdef vmsFortran
-typedef struct dsc$descriptor_s fstring;
-#define DSC$DESCRIPTOR_A(DIMCT) \
-struct { \
- unsigned short dsc$w_length; unsigned char dsc$b_dtype; \
- unsigned char dsc$b_class; char *dsc$a_pointer; \
- char dsc$b_scale; unsigned char dsc$b_digits; \
- struct { \
- unsigned : 3; unsigned dsc$v_fl_binscale : 1; \
- unsigned dsc$v_fl_redim : 1; unsigned dsc$v_fl_column : 1; \
- unsigned dsc$v_fl_coeff : 1; unsigned dsc$v_fl_bounds : 1; \
- } dsc$b_aflags; \
- unsigned char dsc$b_dimct; unsigned long dsc$l_arsize; \
- char *dsc$a_a0; long dsc$l_m [DIMCT]; \
- struct { \
- long dsc$l_l; long dsc$l_u; \
- } dsc$bounds [DIMCT]; \
-}
-typedef DSC$DESCRIPTOR_A(1) fstringvector;
-/*typedef DSC$DESCRIPTOR_A(2) fstringarrarr;
- typedef DSC$DESCRIPTOR_A(3) fstringarrarrarr;*/
-#define initfstr(F,C,ELEMNO,ELEMLEN) \
-( (F).dsc$l_arsize= ( (F).dsc$w_length =(ELEMLEN) ) \
- *( (F).dsc$l_m[0]=(F).dsc$bounds[0].dsc$l_u=(ELEMNO) ), \
- (F).dsc$a_a0 = ( (F).dsc$a_pointer=(C) ) - (F).dsc$w_length ,(F))
-
-#else
-#define _NUM_ELEMS -1
-#define _NUM_ELEM_ARG -2
-#define NUM_ELEMS(A) A,_NUM_ELEMS
-#define NUM_ELEM_ARG(B) *_2(A,B),_NUM_ELEM_ARG
-#define TERM_CHARS(A,B) A,B
-#ifndef __CF__KnR
-static int num_elem(char *strv, unsigned elem_len, int term_char, int num_term)
-#else
-static int num_elem( strv, elem_len, term_char, num_term)
- char *strv; unsigned elem_len; int term_char; int num_term;
-#endif
-/* elem_len is the number of characters in each element of strv, the FORTRAN
-vector of strings. The last element of the vector must begin with at least
-num_term term_char characters, so that this routine can determine how
-many elements are in the vector. */
-{
-unsigned num,i;
-if (num_term == _NUM_ELEMS || num_term == _NUM_ELEM_ARG)
- return term_char;
-if (num_term <=0) num_term = (int)elem_len;
-for (num=0; ; num++) {
- for (i=0; i<(unsigned)num_term && *strv==term_char; i++,strv++);
- if (i==(unsigned)num_term) break;
- else strv += elem_len-i;
-}
-return (int)num;
-}
-#endif
-/*-------------------------------------------------------------------------*/
-
-/* UTILITIES FOR C TO USE STRINGS IN FORTRAN COMMON BLOCKS */
-
-/* C string TO Fortran Common Block STRing. */
-/* DIM is the number of DIMensions of the array in terms of strings, not
- characters. e.g. char a[12] has DIM = 0, char a[12][4] has DIM = 1, etc. */
-#define C2FCBSTR(CSTR,FSTR,DIM) \
- c2fstrv((char *)CSTR, (char *)FSTR, sizeof(FSTR)/cfelementsof(FSTR,DIM)+1, \
- sizeof(FSTR)+cfelementsof(FSTR,DIM))
-
-/* Fortran Common Block string TO C STRing. */
-#define FCB2CSTR(FSTR,CSTR,DIM) \
- vkill_trailing(f2cstrv((char *)FSTR, (char *)CSTR, \
- sizeof(FSTR)/cfelementsof(FSTR,DIM)+1, \
- sizeof(FSTR)+cfelementsof(FSTR,DIM)), \
- sizeof(FSTR)/cfelementsof(FSTR,DIM)+1, \
- sizeof(FSTR)+cfelementsof(FSTR,DIM), ' ')
-
-#define cfDEREFERENCE0
-#define cfDEREFERENCE1 *
-#define cfDEREFERENCE2 **
-#define cfDEREFERENCE3 ***
-#define cfDEREFERENCE4 ****
-#define cfDEREFERENCE5 *****
-#define cfelementsof(A,D) (sizeof(A)/sizeof(_(cfDEREFERENCE,D)(A)))
-
-/*-------------------------------------------------------------------------*/
-
-/* UTILITIES FOR C TO CALL FORTRAN SUBROUTINES */
-
-/* Define lookup tables for how to handle the various types of variables. */
-
-#ifdef OLD_VAXC /* Prevent %CC-I-PARAMNOTUSED. */
-#pragma nostandard
-#endif
-
-#define ZTRINGV_NUM(I) I
-#define ZTRINGV_ARGFP(I) (*(_2(A,I))) /* Undocumented. For PINT, etc. */
-#define ZTRINGV_ARGF(I) _2(A,I)
-#ifdef CFSUBASFUN
-#define ZTRINGV_ARGS(I) ZTRINGV_ARGF(I)
-#else
-#define ZTRINGV_ARGS(I) _2(B,I)
-#endif
-
-#define PBYTE_cfVP(A,B) PINT_cfVP(A,B)
-#define PDOUBLE_cfVP(A,B)
-#define PFLOAT_cfVP(A,B)
-#ifdef ZTRINGV_ARGS_allows_Pvariables
-/* This allows Pvariables for ARGS. ARGF machinery is above ARGFP.
- * B is not needed because the variable may be changed by the Fortran routine,
- * but because B is the only way to access an arbitrary macro argument. */
-#define PINT_cfVP(A,B) int B = (int)A; /* For ZSTRINGV_ARGS */
-#else
-#define PINT_cfVP(A,B)
-#endif
-#define PLOGICAL_cfVP(A,B) int *B; /* Returning LOGICAL in FUNn and SUBn */
-#define PLONG_cfVP(A,B) PINT_cfVP(A,B)
-#define PSHORT_cfVP(A,B) PINT_cfVP(A,B)
-
-#define VCF_INT_S(T,A,B) _(T,VVVVVVV_cfTYPE) B = A;
-#define VCF_INT_F(T,A,B) _(T,_cfVCF)(A,B)
-/* _cfVCF table is directly mapped to _cfCCC table. */
-#define BYTE_cfVCF(A,B)
-#define DOUBLE_cfVCF(A,B)
-#if !defined(__CF__KnR)
-#define FLOAT_cfVCF(A,B)
-#else
-#define FLOAT_cfVCF(A,B) FORTRAN_REAL B = A;
-#endif
-#define INT_cfVCF(A,B)
-#define LOGICAL_cfVCF(A,B)
-#define LONG_cfVCF(A,B)
-#define SHORT_cfVCF(A,B)
-
-/* 980416
- Cast (void (*)(CF_NULL_PROTO)) causes SunOS CC 4.2 occasionally to barf,
- while the following equivalent typedef is fine.
- For consistency use the typedef on all machines.
- */
-typedef void (*cfCAST_FUNCTION)(CF_NULL_PROTO);
-
-#define VCF(TN,I) _Icf4(4,V,TN,_(A,I),_(B,I),F)
-#define VVCF(TN,AI,BI) _Icf4(4,V,TN,AI,BI,S)
-#define INT_cfV(T,A,B,F) _(VCF_INT_,F)(T,A,B)
-#define INTV_cfV(T,A,B,F)
-#define INTVV_cfV(T,A,B,F)
-#define INTVVV_cfV(T,A,B,F)
-#define INTVVVV_cfV(T,A,B,F)
-#define INTVVVVV_cfV(T,A,B,F)
-#define INTVVVVVV_cfV(T,A,B,F)
-#define INTVVVVVVV_cfV(T,A,B,F)
-#define PINT_cfV( T,A,B,F) _(T,_cfVP)(A,B)
-#define PVOID_cfV( T,A,B,F)
-#if defined(apolloFortran) || defined(hpuxFortran800) || defined(AbsoftUNIXFortran) || defined(AbsoftProFortran)
-#define ROUTINE_cfV(T,A,B,F) void (*B)(CF_NULL_PROTO) = (cfCAST_FUNCTION)A;
-#else
-#define ROUTINE_cfV(T,A,B,F)
-#endif
-#define SIMPLE_cfV(T,A,B,F)
-#ifdef vmsFortran
-#define STRING_cfV(T,A,B,F) static struct {fstring f; unsigned clen;} B = \
- {{0,DSC$K_DTYPE_T,DSC$K_CLASS_S,NULL},0};
-#define PSTRING_cfV(T,A,B,F) static fstring B={0,DSC$K_DTYPE_T,DSC$K_CLASS_S,NULL};
-#define STRINGV_cfV(T,A,B,F) static fstringvector B = \
- {sizeof(A),DSC$K_DTYPE_T,DSC$K_CLASS_A,NULL,0,0,{0,0,1,1,1},1,0,NULL,0,{1,0}};
-#define PSTRINGV_cfV(T,A,B,F) static fstringvector B = \
- {0,DSC$K_DTYPE_T,DSC$K_CLASS_A,NULL,0,0,{0,0,1,1,1},1,0,NULL,0,{1,0}};
-#else
-#define STRING_cfV(T,A,B,F) struct {unsigned int clen, flen; char *nombre;} B;
-#define STRINGV_cfV(T,A,B,F) struct {char *s, *fs; unsigned flen; char *nombre;} B;
-#define PSTRING_cfV(T,A,B,F) int B;
-#define PSTRINGV_cfV(T,A,B,F) struct{char *fs; unsigned int sizeofA,flen;}B;
-#endif
-#define ZTRINGV_cfV(T,A,B,F) STRINGV_cfV(T,A,B,F)
-#define PZTRINGV_cfV(T,A,B,F) PSTRINGV_cfV(T,A,B,F)
-
-/* Note that the actions of the A table were performed inside the AA table.
- VAX Ultrix vcc, and HP-UX cc, didn't evaluate arguments to functions left to
- right, so we had to split the original table into the current robust two. */
-#define ACF(NAME,TN,AI,I) _(TN,_cfSTR)(4,A,NAME,I,AI,_(B,I),0)
-#define DEFAULT_cfA(M,I,A,B)
-#define LOGICAL_cfA(M,I,A,B) B=C2FLOGICAL(B);
-#define PLOGICAL_cfA(M,I,A,B) A=C2FLOGICAL(A);
-#define STRING_cfA(M,I,A,B) STRING_cfC(M,I,A,B,sizeof(A))
-#define PSTRING_cfA(M,I,A,B) PSTRING_cfC(M,I,A,B,sizeof(A))
-#ifdef vmsFortran
-#define AATRINGV_cfA( A,B, sA,filA,silA) \
- initfstr(B,_cf_malloc((sA)-(filA)),(filA),(silA)-1), \
- c2fstrv(A,B.dsc$a_pointer,(silA),(sA));
-#define APATRINGV_cfA( A,B, sA,filA,silA) \
- initfstr(B,A,(filA),(silA)-1),c2fstrv(A,A,(silA),(sA));
-#else
-#define AATRINGV_cfA( A,B, sA,filA,silA) \
- (B.s=_cf_malloc((sA)-(filA)),B.fs=c2fstrv(A,B.s,(B.flen=(silA)-1)+1,(sA)));
-#define APATRINGV_cfA( A,B, sA,filA,silA) \
- B.fs=c2fstrv(A,A,(B.flen=(silA)-1)+1,B.sizeofA=(sA));
-#endif
-#define STRINGV_cfA(M,I,A,B) \
- AATRINGV_cfA((char *)A,B,sizeof(A),firstindexlength(A),secondindexlength(A))
-#define PSTRINGV_cfA(M,I,A,B) \
- APATRINGV_cfA((char *)A,B,sizeof(A),firstindexlength(A),secondindexlength(A))
-#define ZTRINGV_cfA(M,I,A,B) AATRINGV_cfA( (char *)A,B, \
- (_3(M,_ELEMS_,I))*(( _3(M,_ELEMLEN_,I))+1), \
- (_3(M,_ELEMS_,I)),(_3(M,_ELEMLEN_,I))+1)
-#define PZTRINGV_cfA(M,I,A,B) APATRINGV_cfA( (char *)A,B, \
- (_3(M,_ELEMS_,I))*(( _3(M,_ELEMLEN_,I))+1), \
- (_3(M,_ELEMS_,I)),(_3(M,_ELEMLEN_,I))+1)
-
-#define PBYTE_cfAAP(A,B) &A
-#define PDOUBLE_cfAAP(A,B) &A
-#define PFLOAT_cfAAP(A,B) FLOATVVVVVVV_cfPP &A
-#define PINT_cfAAP(A,B) &A
-#define PLOGICAL_cfAAP(A,B) B= &A /* B used to keep a common W table. */
-#define PLONG_cfAAP(A,B) &A
-#define PSHORT_cfAAP(A,B) &A
-
-#define AACF(TN,AI,I,C) _SEP_(TN,C,cfCOMMA) _Icf(3,AA,TN,AI,_(B,I))
-#define INT_cfAA(T,A,B) &B
-#define INTV_cfAA(T,A,B) _(T,VVVVVV_cfPP) A
-#define INTVV_cfAA(T,A,B) _(T,VVVVV_cfPP) A[0]
-#define INTVVV_cfAA(T,A,B) _(T,VVVV_cfPP) A[0][0]
-#define INTVVVV_cfAA(T,A,B) _(T,VVV_cfPP) A[0][0][0]
-#define INTVVVVV_cfAA(T,A,B) _(T,VV_cfPP) A[0][0][0][0]
-#define INTVVVVVV_cfAA(T,A,B) _(T,V_cfPP) A[0][0][0][0][0]
-#define INTVVVVVVV_cfAA(T,A,B) _(T,_cfPP) A[0][0][0][0][0][0]
-#define PINT_cfAA(T,A,B) _(T,_cfAAP)(A,B)
-#define PVOID_cfAA(T,A,B) (void *) A
-#if defined(apolloFortran) || defined(hpuxFortran800) || defined(AbsoftUNIXFortran)
-#define ROUTINE_cfAA(T,A,B) &B
-#else
-#define ROUTINE_cfAA(T,A,B) (cfCAST_FUNCTION)A
-#endif
-#define STRING_cfAA(T,A,B) STRING_cfCC(T,A,B)
-#define PSTRING_cfAA(T,A,B) PSTRING_cfCC(T,A,B)
-#ifdef vmsFortran
-#define STRINGV_cfAA(T,A,B) &B
-#else
-#ifdef CRAYFortran
-#define STRINGV_cfAA(T,A,B) _cptofcd(B.fs,B.flen)
-#else
-#define STRINGV_cfAA(T,A,B) B.fs
-#endif
-#endif
-#define PSTRINGV_cfAA(T,A,B) STRINGV_cfAA(T,A,B)
-#define ZTRINGV_cfAA(T,A,B) STRINGV_cfAA(T,A,B)
-#define PZTRINGV_cfAA(T,A,B) STRINGV_cfAA(T,A,B)
-
-#if defined(vmsFortran) || defined(CRAYFortran)
-#define JCF(TN,I)
-#define KCF(TN,I)
-#else
-#define JCF(TN,I) _(TN,_cfSTR)(1,J,_(B,I), 0,0,0,0)
-#if defined(AbsoftUNIXFortran)
-#define DEFAULT_cfJ(B) ,0
-#else
-#define DEFAULT_cfJ(B)
-#endif
-#define LOGICAL_cfJ(B) DEFAULT_cfJ(B)
-#define PLOGICAL_cfJ(B) DEFAULT_cfJ(B)
-#define STRING_cfJ(B) ,B.flen
-#define PSTRING_cfJ(B) ,B
-#define STRINGV_cfJ(B) STRING_cfJ(B)
-#define PSTRINGV_cfJ(B) STRING_cfJ(B)
-#define ZTRINGV_cfJ(B) STRING_cfJ(B)
-#define PZTRINGV_cfJ(B) STRING_cfJ(B)
-
-/* KCF is identical to DCF, except that KCF ZTRING is not empty. */
-#define KCF(TN,I) _(TN,_cfSTR)(1,KK,_(B,I), 0,0,0,0)
-#if defined(AbsoftUNIXFortran)
-#define DEFAULT_cfKK(B) , unsigned B
-#else
-#define DEFAULT_cfKK(B)
-#endif
-#define LOGICAL_cfKK(B) DEFAULT_cfKK(B)
-#define PLOGICAL_cfKK(B) DEFAULT_cfKK(B)
-#define STRING_cfKK(B) , unsigned B
-#define PSTRING_cfKK(B) STRING_cfKK(B)
-#define STRINGV_cfKK(B) STRING_cfKK(B)
-#define PSTRINGV_cfKK(B) STRING_cfKK(B)
-#define ZTRINGV_cfKK(B) STRING_cfKK(B)
-#define PZTRINGV_cfKK(B) STRING_cfKK(B)
-#endif
-
-#define WCF(TN,AN,I) _(TN,_cfSTR)(2,W,AN,_(B,I), 0,0,0)
-#define DEFAULT_cfW(A,B)
-#define LOGICAL_cfW(A,B)
-#define PLOGICAL_cfW(A,B) *B=F2CLOGICAL(*B);
-#define STRING_cfW(A,B) (B.nombre=A,B.nombre[B.clen]!='\0'?B.nombre[B.clen]='\0':0); /* A?="constnt"*/
-#define PSTRING_cfW(A,B) kill_trailing(A,' ');
-#ifdef vmsFortran
-#define STRINGV_cfW(A,B) _cf_free(B.dsc$a_pointer);
-#define PSTRINGV_cfW(A,B) \
- vkill_trailing(f2cstrv((char*)A, (char*)A, \
- B.dsc$w_length+1, B.dsc$l_arsize+B.dsc$l_m[0]), \
- B.dsc$w_length+1, B.dsc$l_arsize+B.dsc$l_m[0], ' ');
-#else
-#define STRINGV_cfW(A,B) _cf_free(B.s);
-#define PSTRINGV_cfW(A,B) vkill_trailing( \
- f2cstrv((char*)A,(char*)A,B.flen+1,B.sizeofA), B.flen+1,B.sizeofA,' ');
-#endif
-#define ZTRINGV_cfW(A,B) STRINGV_cfW(A,B)
-#define PZTRINGV_cfW(A,B) PSTRINGV_cfW(A,B)
-
-#define NCF(TN,I,C) _SEP_(TN,C,cfCOMMA) _Icf(2,N,TN,_(A,I),0)
-#define NNCF(TN,I,C) UUCF(TN,I,C)
-#define NNNCF(TN,I,C) _SEP_(TN,C,cfCOLON) _Icf(2,N,TN,_(A,I),0)
-#define INT_cfN(T,A) _(T,VVVVVVV_cfTYPE) * A
-#define INTV_cfN(T,A) _(T,VVVVVV_cfTYPE) * A
-#define INTVV_cfN(T,A) _(T,VVVVV_cfTYPE) * A
-#define INTVVV_cfN(T,A) _(T,VVVV_cfTYPE) * A
-#define INTVVVV_cfN(T,A) _(T,VVV_cfTYPE) * A
-#define INTVVVVV_cfN(T,A) _(T,VV_cfTYPE) * A
-#define INTVVVVVV_cfN(T,A) _(T,V_cfTYPE) * A
-#define INTVVVVVVV_cfN(T,A) _(T,_cfTYPE) * A
-#define PINT_cfN(T,A) _(T,_cfTYPE) * A
-#define PVOID_cfN(T,A) void * A
-#if defined(apolloFortran) || defined(hpuxFortran800) || defined(AbsoftUNIXFortran)
-#define ROUTINE_cfN(T,A) void (**A)(CF_NULL_PROTO)
-#else
-#define ROUTINE_cfN(T,A) void ( *A)(CF_NULL_PROTO)
-#endif
-#ifdef vmsFortran
-#define STRING_cfN(T,A) fstring * A
-#define STRINGV_cfN(T,A) fstringvector * A
-#else
-#ifdef CRAYFortran
-#define STRING_cfN(T,A) _fcd A
-#define STRINGV_cfN(T,A) _fcd A
-#else
-#define STRING_cfN(T,A) char * A
-#define STRINGV_cfN(T,A) char * A
-#endif
-#endif
-#define PSTRING_cfN(T,A) STRING_cfN(T,A) /* CRAY insists on arg.'s here. */
-#define PNSTRING_cfN(T,A) STRING_cfN(T,A) /* CRAY insists on arg.'s here. */
-#define PPSTRING_cfN(T,A) STRING_cfN(T,A) /* CRAY insists on arg.'s here. */
-#define PSTRINGV_cfN(T,A) STRINGV_cfN(T,A)
-#define ZTRINGV_cfN(T,A) STRINGV_cfN(T,A)
-#define PZTRINGV_cfN(T,A) PSTRINGV_cfN(T,A)
-
-
-/* Apollo 6.7, CRAY, old Sun, VAX/Ultrix vcc/cc and new ultrix
- can't hack more than 31 arg's.
- e.g. ultrix >= 4.3 gives message:
- zow35> cc -c -DDECFortran cfortest.c
- cfe: Fatal: Out of memory: cfortest.c
- zow35>
- Old __hpux had the problem, but new 'HP-UX A.09.03 A 9000/735' is fine
- if using -Aa, otherwise we have a problem.
- */
-#ifndef MAX_PREPRO_ARGS
-#if !defined(__GNUC__) && (defined(VAXUltrix) || defined(__CF__APOLLO67) || (defined(sun)&&!defined(__sun)) || defined(_CRAY) || defined(__ultrix__) || (defined(__hpux)&&defined(__CF__KnR)))
-#define MAX_PREPRO_ARGS 31
-#else
-#define MAX_PREPRO_ARGS 99
-#endif
-#endif
-
-#if defined(AbsoftUNIXFortran) || defined(AbsoftProFortran)
-/* In addition to explicit Absoft stuff, only Absoft requires:
- - DEFAULT coming from _cfSTR.
- DEFAULT could have been called e.g. INT, but keep it for clarity.
- - M term in CFARGT14 and CFARGT14FS.
- */
-#define ABSOFT_cf1(T0) _(T0,_cfSTR)(0,ABSOFT1,0,0,0,0,0)
-#define ABSOFT_cf2(T0) _(T0,_cfSTR)(0,ABSOFT2,0,0,0,0,0)
-#define ABSOFT_cf3(T0) _(T0,_cfSTR)(0,ABSOFT3,0,0,0,0,0)
-#define DEFAULT_cfABSOFT1
-#define LOGICAL_cfABSOFT1
-#define STRING_cfABSOFT1 ,MAX_LEN_FORTRAN_FUNCTION_STRING
-#define DEFAULT_cfABSOFT2
-#define LOGICAL_cfABSOFT2
-#define STRING_cfABSOFT2 ,unsigned D0
-#define DEFAULT_cfABSOFT3
-#define LOGICAL_cfABSOFT3
-#define STRING_cfABSOFT3 ,D0
-#else
-#define ABSOFT_cf1(T0)
-#define ABSOFT_cf2(T0)
-#define ABSOFT_cf3(T0)
-#endif
-
-/* _Z introduced to cicumvent IBM and HP silly preprocessor warning.
- e.g. "Macro CFARGT14 invoked with a null argument."
- */
-#define _Z
-
-#define CFARGT14S(S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \
- S(T1,1) S(T2,2) S(T3,3) S(T4,4) S(T5,5) S(T6,6) S(T7,7) \
- S(T8,8) S(T9,9) S(TA,10) S(TB,11) S(TC,12) S(TD,13) S(TE,14)
-#define CFARGT27S(S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) \
- S(T1,1) S(T2,2) S(T3,3) S(T4,4) S(T5,5) S(T6,6) S(T7,7) \
- S(T8,8) S(T9,9) S(TA,10) S(TB,11) S(TC,12) S(TD,13) S(TE,14) \
- S(TF,15) S(TG,16) S(TH,17) S(TI,18) S(TJ,19) S(TK,20) S(TL,21) \
- S(TM,22) S(TN,23) S(TO,24) S(TP,25) S(TQ,26) S(TR,27)
-
-#define CFARGT14FS(F,S,M,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \
- F(T1,1,0) F(T2,2,1) F(T3,3,1) F(T4,4,1) F(T5,5,1) F(T6,6,1) F(T7,7,1) \
- F(T8,8,1) F(T9,9,1) F(TA,10,1) F(TB,11,1) F(TC,12,1) F(TD,13,1) F(TE,14,1) \
- M CFARGT14S(S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)
-#define CFARGT27FS(F,S,M,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) \
- F(T1,1,0) F(T2,2,1) F(T3,3,1) F(T4,4,1) F(T5,5,1) F(T6,6,1) F(T7,7,1) \
- F(T8,8,1) F(T9,9,1) F(TA,10,1) F(TB,11,1) F(TC,12,1) F(TD,13,1) F(TE,14,1) \
- F(TF,15,1) F(TG,16,1) F(TH,17,1) F(TI,18,1) F(TJ,19,1) F(TK,20,1) F(TL,21,1) \
- F(TM,22,1) F(TN,23,1) F(TO,24,1) F(TP,25,1) F(TQ,26,1) F(TR,27,1) \
- M CFARGT27S(S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR)
-
-#if !(defined(PowerStationFortran)||defined(hpuxFortran800))
-/* Old CFARGT14 -> CFARGT14FS as seen below, for Absoft cross-compile yields:
- SunOS> cc -c -Xa -DAbsoftUNIXFortran c.c
- "c.c", line 406: warning: argument mismatch
- Haven't checked if this is ANSI C or a SunOS bug. SunOS -Xs works ok.
- Behavior is most clearly seen in example:
- #define A 1 , 2
- #define C(X,Y,Z) x=X. y=Y. z=Z.
- #define D(X,Y,Z) C(X,Y,Z)
- D(x,A,z)
- Output from preprocessor is: x = x . y = 1 . z = 2 .
- #define CFARGT14(F,S,M,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \
- CFARGT14FS(F,S,M,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)
-*/
-#define CFARGT14(F,S,M,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \
- F(T1,1,0) F(T2,2,1) F(T3,3,1) F(T4,4,1) F(T5,5,1) F(T6,6,1) F(T7,7,1) \
- F(T8,8,1) F(T9,9,1) F(TA,10,1) F(TB,11,1) F(TC,12,1) F(TD,13,1) F(TE,14,1) \
- M CFARGT14S(S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)
-#define CFARGT27(F,S,M,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) \
- F(T1,1,0) F(T2,2,1) F(T3,3,1) F(T4,4,1) F(T5,5,1) F(T6,6,1) F(T7,7,1) \
- F(T8,8,1) F(T9,9,1) F(TA,10,1) F(TB,11,1) F(TC,12,1) F(TD,13,1) F(TE,14,1) \
- F(TF,15,1) F(TG,16,1) F(TH,17,1) F(TI,18,1) F(TJ,19,1) F(TK,20,1) F(TL,21,1) \
- F(TM,22,1) F(TN,23,1) F(TO,24,1) F(TP,25,1) F(TQ,26,1) F(TR,27,1) \
- M CFARGT27S(S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR)
-
-#define CFARGT20(F,S,M,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK) \
- F(T1,1,0) F(T2,2,1) F(T3,3,1) F(T4,4,1) F(T5,5,1) F(T6,6,1) F(T7,7,1) \
- F(T8,8,1) F(T9,9,1) F(TA,10,1) F(TB,11,1) F(TC,12,1) F(TD,13,1) F(TE,14,1) \
- F(TF,15,1) F(TG,16,1) F(TH,17,1) F(TI,18,1) F(TJ,19,1) F(TK,20,1) \
- S(T1,1) S(T2,2) S(T3,3) S(T4,4) S(T5,5) S(T6,6) S(T7,7) \
- S(T8,8) S(T9,9) S(TA,10) S(TB,11) S(TC,12) S(TD,13) S(TE,14) \
- S(TF,15) S(TG,16) S(TH,17) S(TI,18) S(TJ,19) S(TK,20)
-#define CFARGTA14(F,S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE) \
- F(T1,A1,1,0) F(T2,A2,2,1) F(T3,A3,3,1) F(T4,A4,4,1) F(T5,A5,5,1) F(T6,A6,6,1) \
- F(T7,A7,7,1) F(T8,A8,8,1) F(T9,A9,9,1) F(TA,AA,10,1) F(TB,AB,11,1) F(TC,AC,12,1) \
- F(TD,AD,13,1) F(TE,AE,14,1) S(T1,1) S(T2,2) S(T3,3) S(T4,4) \
- S(T5,5) S(T6,6) S(T7,7) S(T8,8) S(T9,9) S(TA,10) \
- S(TB,11) S(TC,12) S(TD,13) S(TE,14)
-#if MAX_PREPRO_ARGS>31
-#define CFARGTA20(F,S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK) \
- F(T1,A1,1,0) F(T2,A2,2,1) F(T3,A3,3,1) F(T4,A4,4,1) F(T5,A5,5,1) F(T6,A6,6,1) \
- F(T7,A7,7,1) F(T8,A8,8,1) F(T9,A9,9,1) F(TA,AA,10,1) F(TB,AB,11,1) F(TC,AC,12,1) \
- F(TD,AD,13,1) F(TE,AE,14,1) F(TF,AF,15,1) F(TG,AG,16,1) F(TH,AH,17,1) F(TI,AI,18,1) \
- F(TJ,AJ,19,1) F(TK,AK,20,1) S(T1,1) S(T2,2) S(T3,3) S(T4,4) \
- S(T5,5) S(T6,6) S(T7,7) S(T8,8) S(T9,9) S(TA,10) \
- S(TB,11) S(TC,12) S(TD,13) S(TE,14) S(TF,15) S(TG,16) \
- S(TH,17) S(TI,18) S(TJ,19) S(TK,20)
-#define CFARGTA27(F,S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,AN,AO,AP,AQ,AR) \
- F(T1,A1,1,0) F(T2,A2,2,1) F(T3,A3,3,1) F(T4,A4,4,1) F(T5,A5,5,1) F(T6,A6,6,1) \
- F(T7,A7,7,1) F(T8,A8,8,1) F(T9,A9,9,1) F(TA,AA,10,1) F(TB,AB,11,1) F(TC,AC,12,1) \
- F(TD,AD,13,1) F(TE,AE,14,1) F(TF,AF,15,1) F(TG,AG,16,1) F(TH,AH,17,1) F(TI,AI,18,1) \
- F(TJ,AJ,19,1) F(TK,AK,20,1) F(TL,AL,21,1) F(TM,AM,22,1) F(TN,AN,23,1) F(TO,AO,24,1) \
- F(TP,AP,25,1) F(TQ,AQ,26,1) F(TR,AR,27,1) S(T1,1) S(T2,2) S(T3,3) \
- S(T4,4) S(T5,5) S(T6,6) S(T7,7) S(T8,8) S(T9,9) \
- S(TA,10) S(TB,11) S(TC,12) S(TD,13) S(TE,14) S(TF,15) \
- S(TG,16) S(TH,17) S(TI,18) S(TJ,19) S(TK,20) S(TL,21) \
- S(TM,22) S(TN,23) S(TO,24) S(TP,25) S(TQ,26) S(TR,27)
-#endif
-#else
-#define CFARGT14(F,S,M,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \
- F(T1,1,0) S(T1,1) F(T2,2,1) S(T2,2) F(T3,3,1) S(T3,3) F(T4,4,1) S(T4,4) \
- F(T5,5,1) S(T5,5) F(T6,6,1) S(T6,6) F(T7,7,1) S(T7,7) F(T8,8,1) S(T8,8) \
- F(T9,9,1) S(T9,9) F(TA,10,1) S(TA,10) F(TB,11,1) S(TB,11) F(TC,12,1) S(TC,12) \
- F(TD,13,1) S(TD,13) F(TE,14,1) S(TE,14)
-#define CFARGT27(F,S,M,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) \
- F(T1,1,0) S(T1,1) F(T2,2,1) S(T2,2) F(T3,3,1) S(T3,3) F(T4,4,1) S(T4,4) \
- F(T5,5,1) S(T5,5) F(T6,6,1) S(T6,6) F(T7,7,1) S(T7,7) F(T8,8,1) S(T8,8) \
- F(T9,9,1) S(T9,9) F(TA,10,1) S(TA,10) F(TB,11,1) S(TB,11) F(TC,12,1) S(TC,12) \
- F(TD,13,1) S(TD,13) F(TE,14,1) S(TE,14) F(TF,15,1) S(TF,15) F(TG,16,1) S(TG,16) \
- F(TH,17,1) S(TH,17) F(TI,18,1) S(TI,18) F(TJ,19,1) S(TJ,19) F(TK,20,1) S(TK,20) \
- F(TL,21,1) S(TL,21) F(TM,22,1) S(TM,22) F(TN,23,1) S(TN,23) F(TO,24,1) S(TO,24) \
- F(TP,25,1) S(TP,25) F(TQ,26,1) S(TQ,26) F(TR,27,1) S(TR,27)
-
-#define CFARGT20(F,S,M,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK) \
- F(T1,1,0) S(T1,1) F(T2,2,1) S(T2,2) F(T3,3,1) S(T3,3) F(T4,4,1) S(T4,4) \
- F(T5,5,1) S(T5,5) F(T6,6,1) S(T6,6) F(T7,7,1) S(T7,7) F(T8,8,1) S(T8,8) \
- F(T9,9,1) S(T9,9) F(TA,10,1) S(TA,10) F(TB,11,1) S(TB,11) F(TC,12,1) S(TC,12) \
- F(TD,13,1) S(TD,13) F(TE,14,1) S(TE,14) F(TF,15,1) S(TF,15) F(TG,16,1) S(TG,16) \
- F(TH,17,1) S(TH,17) F(TI,18,1) S(TI,18) F(TJ,19,1) S(TJ,19) F(TK,20,1) S(TK,20)
-#define CFARGTA14(F,S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE) \
- F(T1,A1,1,0) S(T1,1) F(T2,A2,2,1) S(T2,2) F(T3,A3,3,1) S(T3,3) \
- F(T4,A4,4,1) S(T4,4) F(T5,A5,5,1) S(T5,5) F(T6,A6,6,1) S(T6,6) \
- F(T7,A7,7,1) S(T7,7) F(T8,A8,8,1) S(T8,8) F(T9,A9,9,1) S(T9,9) \
- F(TA,AA,10,1) S(TA,10) F(TB,AB,11,1) S(TB,11) F(TC,AC,12,1) S(TC,12) \
- F(TD,AD,13,1) S(TD,13) F(TE,AE,14,1) S(TE,14)
-#if MAX_PREPRO_ARGS>31
-#define CFARGTA20(F,S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK) \
- F(T1,A1,1,0) S(T1,1) F(T2,A2,2,1) S(T2,2) F(T3,A3,3,1) S(T3,3) \
- F(T4,A4,4,1) S(T4,4) F(T5,A5,5,1) S(T5,5) F(T6,A6,6,1) S(T6,6) \
- F(T7,A7,7,1) S(T7,7) F(T8,A8,8,1) S(T8,8) F(T9,A9,9,1) S(T9,9) \
- F(TA,AA,10,1) S(TA,10) F(TB,AB,11,1) S(TB,11) F(TC,AC,12,1) S(TC,12) \
- F(TD,AD,13,1) S(TD,13) F(TE,AE,14,1) S(TE,14) F(TF,AF,15,1) S(TF,15) \
- F(TG,AG,16,1) S(TG,16) F(TH,AH,17,1) S(TH,17) F(TI,AI,18,1) S(TI,18) \
- F(TJ,AJ,19,1) S(TJ,19) F(TK,AK,20,1) S(TK,20)
-#define CFARGTA27(F,S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,AN,AO,AP,AQ,AR) \
- F(T1,A1,1,0) S(T1,1) F(T2,A2,2,1) S(T2,2) F(T3,A3,3,1) S(T3,3) \
- F(T4,A4,4,1) S(T4,4) F(T5,A5,5,1) S(T5,5) F(T6,A6,6,1) S(T6,6) \
- F(T7,A7,7,1) S(T7,7) F(T8,A8,8,1) S(T8,8) F(T9,A9,9,1) S(T9,9) \
- F(TA,AA,10,1) S(TA,10) F(TB,AB,11,1) S(TB,11) F(TC,AC,12,1) S(TC,12) \
- F(TD,AD,13,1) S(TD,13) F(TE,AE,14,1) S(TE,14) F(TF,AF,15,1) S(TF,15) \
- F(TG,AG,16,1) S(TG,16) F(TH,AH,17,1) S(TH,17) F(TI,AI,18,1) S(TI,18) \
- F(TJ,AJ,19,1) S(TJ,19) F(TK,AK,20,1) S(TK,20) F(TL,AL,21,1) S(TL,21) \
- F(TM,AM,22,1) S(TM,22) F(TN,AN,23,1) S(TN,23) F(TO,AO,24,1) S(TO,24) \
- F(TP,AP,25,1) S(TP,25) F(TQ,AQ,26,1) S(TQ,26) F(TR,AR,27,1) S(TR,27)
-#endif
-#endif
-
-
-#define PROTOCCALLSFSUB1( UN,LN,T1) \
- PROTOCCALLSFSUB14(UN,LN,T1,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0)
-#define PROTOCCALLSFSUB2( UN,LN,T1,T2) \
- PROTOCCALLSFSUB14(UN,LN,T1,T2,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0)
-#define PROTOCCALLSFSUB3( UN,LN,T1,T2,T3) \
- PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0)
-#define PROTOCCALLSFSUB4( UN,LN,T1,T2,T3,T4) \
- PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0)
-#define PROTOCCALLSFSUB5( UN,LN,T1,T2,T3,T4,T5) \
- PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0)
-#define PROTOCCALLSFSUB6( UN,LN,T1,T2,T3,T4,T5,T6) \
- PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0)
-#define PROTOCCALLSFSUB7( UN,LN,T1,T2,T3,T4,T5,T6,T7) \
- PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0)
-#define PROTOCCALLSFSUB8( UN,LN,T1,T2,T3,T4,T5,T6,T7,T8) \
- PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0)
-#define PROTOCCALLSFSUB9( UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9) \
- PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,CF_0,CF_0,CF_0,CF_0,CF_0)
-#define PROTOCCALLSFSUB10(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA) \
- PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,CF_0,CF_0,CF_0,CF_0)
-#define PROTOCCALLSFSUB11(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB) \
- PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,CF_0,CF_0,CF_0)
-#define PROTOCCALLSFSUB12(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC) \
- PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,CF_0,CF_0)
-#define PROTOCCALLSFSUB13(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD) \
- PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,CF_0)
-
-
-#define PROTOCCALLSFSUB15(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF) \
- PROTOCCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,CF_0,CF_0,CF_0,CF_0,CF_0)
-#define PROTOCCALLSFSUB16(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG) \
- PROTOCCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,CF_0,CF_0,CF_0,CF_0)
-#define PROTOCCALLSFSUB17(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH) \
- PROTOCCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,CF_0,CF_0,CF_0)
-#define PROTOCCALLSFSUB18(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI) \
- PROTOCCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,CF_0,CF_0)
-#define PROTOCCALLSFSUB19(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ) \
- PROTOCCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,CF_0)
-
-#define PROTOCCALLSFSUB21(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL) \
- PROTOCCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0)
-#define PROTOCCALLSFSUB22(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM) \
- PROTOCCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,CF_0,CF_0,CF_0,CF_0,CF_0)
-#define PROTOCCALLSFSUB23(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN) \
- PROTOCCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,CF_0,CF_0,CF_0,CF_0)
-#define PROTOCCALLSFSUB24(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO) \
- PROTOCCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,CF_0,CF_0,CF_0)
-#define PROTOCCALLSFSUB25(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP) \
- PROTOCCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,CF_0,CF_0)
-#define PROTOCCALLSFSUB26(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ) \
- PROTOCCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,CF_0)
-
-
-#ifndef FCALLSC_QUALIFIER
-#ifdef VISUAL_CPLUSPLUS
-#define FCALLSC_QUALIFIER __stdcall
-#else
-#define FCALLSC_QUALIFIER
-#endif
-#endif
-
-#ifdef __cplusplus
-#define CFextern extern "C"
-#else
-#define CFextern extern
-#endif
-
-
-#ifdef CFSUBASFUN
-#define PROTOCCALLSFSUB0(UN,LN) \
- PROTOCCALLSFFUN0( VOID,UN,LN)
-#define PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \
- PROTOCCALLSFFUN14(VOID,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)
-#define PROTOCCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK)\
- PROTOCCALLSFFUN20(VOID,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK)
-#define PROTOCCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR)\
- PROTOCCALLSFFUN27(VOID,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR)
-#else
-/* Note: Prevent compiler warnings, null #define PROTOCCALLSFSUB14/20 after
- #include-ing cfortran.h if calling the FORTRAN wrapper within the same
- source code where the wrapper is created. */
-#define PROTOCCALLSFSUB0(UN,LN) _(VOID,_cfPU)(CFC_(UN,LN))();
-#ifndef __CF__KnR
-#define PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \
- _(VOID,_cfPU)(CFC_(UN,LN))( CFARGT14(NCF,KCF,_Z,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) );
-#define PROTOCCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK)\
- _(VOID,_cfPU)(CFC_(UN,LN))( CFARGT20(NCF,KCF,_Z,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK) );
-#define PROTOCCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR)\
- _(VOID,_cfPU)(CFC_(UN,LN))( CFARGT27(NCF,KCF,_Z,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) );
-#else
-#define PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \
- PROTOCCALLSFSUB0(UN,LN)
-#define PROTOCCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK) \
- PROTOCCALLSFSUB0(UN,LN)
-#define PROTOCCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) \
- PROTOCCALLSFSUB0(UN,LN)
-#endif
-#endif
-
-
-#ifdef OLD_VAXC /* Allow %CC-I-PARAMNOTUSED. */
-#pragma standard
-#endif
-
-
-#define CCALLSFSUB1( UN,LN,T1, A1) \
- CCALLSFSUB5 (UN,LN,T1,CF_0,CF_0,CF_0,CF_0,A1,0,0,0,0)
-#define CCALLSFSUB2( UN,LN,T1,T2, A1,A2) \
- CCALLSFSUB5 (UN,LN,T1,T2,CF_0,CF_0,CF_0,A1,A2,0,0,0)
-#define CCALLSFSUB3( UN,LN,T1,T2,T3, A1,A2,A3) \
- CCALLSFSUB5 (UN,LN,T1,T2,T3,CF_0,CF_0,A1,A2,A3,0,0)
-#define CCALLSFSUB4( UN,LN,T1,T2,T3,T4, A1,A2,A3,A4)\
- CCALLSFSUB5 (UN,LN,T1,T2,T3,T4,CF_0,A1,A2,A3,A4,0)
-#define CCALLSFSUB5( UN,LN,T1,T2,T3,T4,T5, A1,A2,A3,A4,A5) \
- CCALLSFSUB10(UN,LN,T1,T2,T3,T4,T5,CF_0,CF_0,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,0,0,0,0,0)
-#define CCALLSFSUB6( UN,LN,T1,T2,T3,T4,T5,T6, A1,A2,A3,A4,A5,A6) \
- CCALLSFSUB10(UN,LN,T1,T2,T3,T4,T5,T6,CF_0,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,0,0,0,0)
-#define CCALLSFSUB7( UN,LN,T1,T2,T3,T4,T5,T6,T7, A1,A2,A3,A4,A5,A6,A7) \
- CCALLSFSUB10(UN,LN,T1,T2,T3,T4,T5,T6,T7,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,0,0,0)
-#define CCALLSFSUB8( UN,LN,T1,T2,T3,T4,T5,T6,T7,T8, A1,A2,A3,A4,A5,A6,A7,A8) \
- CCALLSFSUB10(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,0,0)
-#define CCALLSFSUB9( UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,A1,A2,A3,A4,A5,A6,A7,A8,A9)\
- CCALLSFSUB10(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,0)
-#define CCALLSFSUB10(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA)\
- CCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,CF_0,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,0,0,0,0)
-#define CCALLSFSUB11(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB)\
- CCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,0,0,0)
-#define CCALLSFSUB12(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC)\
- CCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,0,0)
-#define CCALLSFSUB13(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD)\
- CCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,0)
-
-#ifdef __cplusplus
-#define CPPPROTOCLSFSUB0( UN,LN)
-#define CPPPROTOCLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)
-#define CPPPROTOCLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK)
-#define CPPPROTOCLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR)
-#else
-#define CPPPROTOCLSFSUB0(UN,LN) \
- PROTOCCALLSFSUB0(UN,LN)
-#define CPPPROTOCLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \
- PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)
-#define CPPPROTOCLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK) \
- PROTOCCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK)
-#define CPPPROTOCLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) \
- PROTOCCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR)
-#endif
-
-#ifdef CFSUBASFUN
-#define CCALLSFSUB0(UN,LN) CCALLSFFUN0(UN,LN)
-#define CCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE)\
- CCALLSFFUN14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE)
-#else
-/* do{...}while(0) allows if(a==b) FORT(); else BORT(); */
-#define CCALLSFSUB0( UN,LN) do{CPPPROTOCLSFSUB0(UN,LN) CFC_(UN,LN)();}while(0)
-#define CCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE)\
-do{VVCF(T1,A1,B1) VVCF(T2,A2,B2) VVCF(T3,A3,B3) VVCF(T4,A4,B4) VVCF(T5,A5,B5) \
- VVCF(T6,A6,B6) VVCF(T7,A7,B7) VVCF(T8,A8,B8) VVCF(T9,A9,B9) VVCF(TA,AA,B10) \
- VVCF(TB,AB,B11) VVCF(TC,AC,B12) VVCF(TD,AD,B13) VVCF(TE,AE,B14) \
- CPPPROTOCLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \
- ACF(LN,T1,A1,1) ACF(LN,T2,A2,2) ACF(LN,T3,A3,3) \
- ACF(LN,T4,A4,4) ACF(LN,T5,A5,5) ACF(LN,T6,A6,6) ACF(LN,T7,A7,7) \
- ACF(LN,T8,A8,8) ACF(LN,T9,A9,9) ACF(LN,TA,AA,10) ACF(LN,TB,AB,11) \
- ACF(LN,TC,AC,12) ACF(LN,TD,AD,13) ACF(LN,TE,AE,14) \
- CFC_(UN,LN)( CFARGTA14(AACF,JCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE) );\
- WCF(T1,A1,1) WCF(T2,A2,2) WCF(T3,A3,3) WCF(T4,A4,4) WCF(T5,A5,5) \
- WCF(T6,A6,6) WCF(T7,A7,7) WCF(T8,A8,8) WCF(T9,A9,9) WCF(TA,AA,10) \
- WCF(TB,AB,11) WCF(TC,AC,12) WCF(TD,AD,13) WCF(TE,AE,14) }while(0)
-#endif
-
-
-#if MAX_PREPRO_ARGS>31
-#define CCALLSFSUB15(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF)\
- CCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,CF_0,CF_0,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,0,0,0,0,0)
-#define CCALLSFSUB16(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG)\
- CCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,CF_0,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,0,0,0,0)
-#define CCALLSFSUB17(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH)\
- CCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,0,0,0)
-#define CCALLSFSUB18(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI)\
- CCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,0,0)
-#define CCALLSFSUB19(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ)\
- CCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,0)
-
-#ifdef CFSUBASFUN
-#define CCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH, \
- TI,TJ,TK, A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK) \
- CCALLSFFUN20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH, \
- TI,TJ,TK, A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK)
-#else
-#define CCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH, \
- TI,TJ,TK, A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK) \
-do{VVCF(T1,A1,B1) VVCF(T2,A2,B2) VVCF(T3,A3,B3) VVCF(T4,A4,B4) VVCF(T5,A5,B5) \
- VVCF(T6,A6,B6) VVCF(T7,A7,B7) VVCF(T8,A8,B8) VVCF(T9,A9,B9) VVCF(TA,AA,B10) \
- VVCF(TB,AB,B11) VVCF(TC,AC,B12) VVCF(TD,AD,B13) VVCF(TE,AE,B14) VVCF(TF,AF,B15) \
- VVCF(TG,AG,B16) VVCF(TH,AH,B17) VVCF(TI,AI,B18) VVCF(TJ,AJ,B19) VVCF(TK,AK,B20) \
- CPPPROTOCLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK) \
- ACF(LN,T1,A1,1) ACF(LN,T2,A2,2) ACF(LN,T3,A3,3) ACF(LN,T4,A4,4) \
- ACF(LN,T5,A5,5) ACF(LN,T6,A6,6) ACF(LN,T7,A7,7) ACF(LN,T8,A8,8) \
- ACF(LN,T9,A9,9) ACF(LN,TA,AA,10) ACF(LN,TB,AB,11) ACF(LN,TC,AC,12) \
- ACF(LN,TD,AD,13) ACF(LN,TE,AE,14) ACF(LN,TF,AF,15) ACF(LN,TG,AG,16) \
- ACF(LN,TH,AH,17) ACF(LN,TI,AI,18) ACF(LN,TJ,AJ,19) ACF(LN,TK,AK,20) \
- CFC_(UN,LN)( CFARGTA20(AACF,JCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK) ); \
- WCF(T1,A1,1) WCF(T2,A2,2) WCF(T3,A3,3) WCF(T4,A4,4) WCF(T5,A5,5) WCF(T6,A6,6) \
- WCF(T7,A7,7) WCF(T8,A8,8) WCF(T9,A9,9) WCF(TA,AA,10) WCF(TB,AB,11) WCF(TC,AC,12) \
- WCF(TD,AD,13) WCF(TE,AE,14) WCF(TF,AF,15) WCF(TG,AG,16) WCF(TH,AH,17) WCF(TI,AI,18) \
- WCF(TJ,AJ,19) WCF(TK,AK,20) }while(0)
-#endif
-#endif /* MAX_PREPRO_ARGS */
-
-#if MAX_PREPRO_ARGS>31
-#define CCALLSFSUB21(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL)\
- CCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,0,0,0,0,0,0)
-#define CCALLSFSUB22(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM)\
- CCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,CF_0,CF_0,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,0,0,0,0,0)
-#define CCALLSFSUB23(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,AN)\
- CCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,CF_0,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,AN,0,0,0,0)
-#define CCALLSFSUB24(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,AN,AO)\
- CCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,AN,AO,0,0,0)
-#define CCALLSFSUB25(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,AN,AO,AP)\
- CCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,AN,AO,AP,0,0)
-#define CCALLSFSUB26(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,AN,AO,AP,AQ)\
- CCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,AN,AO,AP,AQ,0)
-
-#ifdef CFSUBASFUN
-#define CCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR, \
- A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,AN,AO,AP,AQ,AR) \
- CCALLSFFUN27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR, \
- A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,AN,AO,AP,AQ,AR)
-#else
-#define CCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR, \
- A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,AN,AO,AP,AQ,AR) \
-do{VVCF(T1,A1,B1) VVCF(T2,A2,B2) VVCF(T3,A3,B3) VVCF(T4,A4,B4) VVCF(T5,A5,B5) \
- VVCF(T6,A6,B6) VVCF(T7,A7,B7) VVCF(T8,A8,B8) VVCF(T9,A9,B9) VVCF(TA,AA,B10) \
- VVCF(TB,AB,B11) VVCF(TC,AC,B12) VVCF(TD,AD,B13) VVCF(TE,AE,B14) VVCF(TF,AF,B15) \
- VVCF(TG,AG,B16) VVCF(TH,AH,B17) VVCF(TI,AI,B18) VVCF(TJ,AJ,B19) VVCF(TK,AK,B20) \
- VVCF(TL,AL,B21) VVCF(TM,AM,B22) VVCF(TN,AN,B23) VVCF(TO,AO,B24) VVCF(TP,AP,B25) \
- VVCF(TQ,AQ,B26) VVCF(TR,AR,B27) \
- CPPPROTOCLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) \
- ACF(LN,T1,A1,1) ACF(LN,T2,A2,2) ACF(LN,T3,A3,3) ACF(LN,T4,A4,4) \
- ACF(LN,T5,A5,5) ACF(LN,T6,A6,6) ACF(LN,T7,A7,7) ACF(LN,T8,A8,8) \
- ACF(LN,T9,A9,9) ACF(LN,TA,AA,10) ACF(LN,TB,AB,11) ACF(LN,TC,AC,12) \
- ACF(LN,TD,AD,13) ACF(LN,TE,AE,14) ACF(LN,TF,AF,15) ACF(LN,TG,AG,16) \
- ACF(LN,TH,AH,17) ACF(LN,TI,AI,18) ACF(LN,TJ,AJ,19) ACF(LN,TK,AK,20) \
- ACF(LN,TL,AL,21) ACF(LN,TM,AM,22) ACF(LN,TN,AN,23) ACF(LN,TO,AO,24) \
- ACF(LN,TP,AP,25) ACF(LN,TQ,AQ,26) ACF(LN,TR,AR,27) \
- CFC_(UN,LN)( CFARGTA27(AACF,JCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR,\
- A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,AN,AO,AP,AQ,AR) ); \
- WCF(T1,A1,1) WCF(T2,A2,2) WCF(T3,A3,3) WCF(T4,A4,4) WCF(T5,A5,5) WCF(T6,A6,6) \
- WCF(T7,A7,7) WCF(T8,A8,8) WCF(T9,A9,9) WCF(TA,AA,10) WCF(TB,AB,11) WCF(TC,AC,12) \
- WCF(TD,AD,13) WCF(TE,AE,14) WCF(TF,AF,15) WCF(TG,AG,16) WCF(TH,AH,17) WCF(TI,AI,18) \
- WCF(TJ,AJ,19) WCF(TK,AK,20) WCF(TL,AL,21) WCF(TM,AM,22) WCF(TN,AN,23) WCF(TO,AO,24) \
- WCF(TP,AP,25) WCF(TQ,AQ,26) WCF(TR,AR,27) }while(0)
-#endif
-#endif /* MAX_PREPRO_ARGS */
-
-/*-------------------------------------------------------------------------*/
-
-/* UTILITIES FOR C TO CALL FORTRAN FUNCTIONS */
-
-/*N.B. PROTOCCALLSFFUNn(..) generates code, whether or not the FORTRAN
- function is called. Therefore, especially for creator's of C header files
- for large FORTRAN libraries which include many functions, to reduce
- compile time and object code size, it may be desirable to create
- preprocessor directives to allow users to create code for only those
- functions which they use. */
-
-/* The following defines the maximum length string that a function can return.
- Of course it may be undefine-d and re-define-d before individual
- PROTOCCALLSFFUNn(..) as required. It would also be nice to have this derived
- from the individual machines' limits. */
-#define MAX_LEN_FORTRAN_FUNCTION_STRING 0x4FE
-
-/* The following defines a character used by CFORTRAN.H to flag the end of a
- string coming out of a FORTRAN routine. */
-#define CFORTRAN_NON_CHAR 0x7F
-
-#ifdef OLD_VAXC /* Prevent %CC-I-PARAMNOTUSED. */
-#pragma nostandard
-#endif
-
-#define _SEP_(TN,C,cfCOMMA) _(__SEP_,C)(TN,cfCOMMA)
-#define __SEP_0(TN,cfCOMMA)
-#define __SEP_1(TN,cfCOMMA) _Icf(2,SEP,TN,cfCOMMA,0)
-#define INT_cfSEP(T,B) _(A,B)
-#define INTV_cfSEP(T,B) INT_cfSEP(T,B)
-#define INTVV_cfSEP(T,B) INT_cfSEP(T,B)
-#define INTVVV_cfSEP(T,B) INT_cfSEP(T,B)
-#define INTVVVV_cfSEP(T,B) INT_cfSEP(T,B)
-#define INTVVVVV_cfSEP(T,B) INT_cfSEP(T,B)
-#define INTVVVVVV_cfSEP(T,B) INT_cfSEP(T,B)
-#define INTVVVVVVV_cfSEP(T,B) INT_cfSEP(T,B)
-#define PINT_cfSEP(T,B) INT_cfSEP(T,B)
-#define PVOID_cfSEP(T,B) INT_cfSEP(T,B)
-#define ROUTINE_cfSEP(T,B) INT_cfSEP(T,B)
-#define SIMPLE_cfSEP(T,B) INT_cfSEP(T,B)
-#define VOID_cfSEP(T,B) INT_cfSEP(T,B) /* For FORTRAN calls C subr.s.*/
-#define STRING_cfSEP(T,B) INT_cfSEP(T,B)
-#define STRINGV_cfSEP(T,B) INT_cfSEP(T,B)
-#define PSTRING_cfSEP(T,B) INT_cfSEP(T,B)
-#define PSTRINGV_cfSEP(T,B) INT_cfSEP(T,B)
-#define PNSTRING_cfSEP(T,B) INT_cfSEP(T,B)
-#define PPSTRING_cfSEP(T,B) INT_cfSEP(T,B)
-#define ZTRINGV_cfSEP(T,B) INT_cfSEP(T,B)
-#define PZTRINGV_cfSEP(T,B) INT_cfSEP(T,B)
-
-#if defined(SIGNED_BYTE) || !defined(UNSIGNED_BYTE)
-#ifdef OLD_VAXC
-#define INTEGER_BYTE char /* Old VAXC barfs on 'signed char' */
-#else
-#define INTEGER_BYTE signed char /* default */
-#endif
-#else
-#define INTEGER_BYTE unsigned char
-#endif
-#define BYTEVVVVVVV_cfTYPE INTEGER_BYTE
-#define DOUBLEVVVVVVV_cfTYPE DOUBLE_PRECISION
-#define FLOATVVVVVVV_cfTYPE FORTRAN_REAL
-#define INTVVVVVVV_cfTYPE int
-#define LOGICALVVVVVVV_cfTYPE int
-#define LONGVVVVVVV_cfTYPE long
-#define SHORTVVVVVVV_cfTYPE short
-#define PBYTE_cfTYPE INTEGER_BYTE
-#define PDOUBLE_cfTYPE DOUBLE_PRECISION
-#define PFLOAT_cfTYPE FORTRAN_REAL
-#define PINT_cfTYPE int
-#define PLOGICAL_cfTYPE int
-#define PLONG_cfTYPE long
-#define PSHORT_cfTYPE short
-
-#define CFARGS0(A,T,V,W,X,Y,Z) _3(T,_cf,A)
-#define CFARGS1(A,T,V,W,X,Y,Z) _3(T,_cf,A)(V)
-#define CFARGS2(A,T,V,W,X,Y,Z) _3(T,_cf,A)(V,W)
-#define CFARGS3(A,T,V,W,X,Y,Z) _3(T,_cf,A)(V,W,X)
-#define CFARGS4(A,T,V,W,X,Y,Z) _3(T,_cf,A)(V,W,X,Y)
-#define CFARGS5(A,T,V,W,X,Y,Z) _3(T,_cf,A)(V,W,X,Y,Z)
-
-#define _Icf(N,T,I,X,Y) _(I,_cfINT)(N,T,I,X,Y,0)
-#define _Icf4(N,T,I,X,Y,Z) _(I,_cfINT)(N,T,I,X,Y,Z)
-#define BYTE_cfINT(N,A,B,X,Y,Z) DOUBLE_cfINT(N,A,B,X,Y,Z)
-#define DOUBLE_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,INT,B,X,Y,Z,0)
-#define FLOAT_cfINT(N,A,B,X,Y,Z) DOUBLE_cfINT(N,A,B,X,Y,Z)
-#define INT_cfINT(N,A,B,X,Y,Z) DOUBLE_cfINT(N,A,B,X,Y,Z)
-#define LOGICAL_cfINT(N,A,B,X,Y,Z) DOUBLE_cfINT(N,A,B,X,Y,Z)
-#define LONG_cfINT(N,A,B,X,Y,Z) DOUBLE_cfINT(N,A,B,X,Y,Z)
-#define SHORT_cfINT(N,A,B,X,Y,Z) DOUBLE_cfINT(N,A,B,X,Y,Z)
-#define PBYTE_cfINT(N,A,B,X,Y,Z) PDOUBLE_cfINT(N,A,B,X,Y,Z)
-#define PDOUBLE_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,PINT,B,X,Y,Z,0)
-#define PFLOAT_cfINT(N,A,B,X,Y,Z) PDOUBLE_cfINT(N,A,B,X,Y,Z)
-#define PINT_cfINT(N,A,B,X,Y,Z) PDOUBLE_cfINT(N,A,B,X,Y,Z)
-#define PLOGICAL_cfINT(N,A,B,X,Y,Z) PDOUBLE_cfINT(N,A,B,X,Y,Z)
-#define PLONG_cfINT(N,A,B,X,Y,Z) PDOUBLE_cfINT(N,A,B,X,Y,Z)
-#define PSHORT_cfINT(N,A,B,X,Y,Z) PDOUBLE_cfINT(N,A,B,X,Y,Z)
-#define BYTEV_cfINT(N,A,B,X,Y,Z) DOUBLEV_cfINT(N,A,B,X,Y,Z)
-#define BYTEVV_cfINT(N,A,B,X,Y,Z) DOUBLEVV_cfINT(N,A,B,X,Y,Z)
-#define BYTEVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVV_cfINT(N,A,B,X,Y,Z)
-#define BYTEVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVV_cfINT(N,A,B,X,Y,Z)
-#define BYTEVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVV_cfINT(N,A,B,X,Y,Z)
-#define BYTEVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVV_cfINT(N,A,B,X,Y,Z)
-#define BYTEVVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVVV_cfINT(N,A,B,X,Y,Z)
-#define DOUBLEV_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,INTV,B,X,Y,Z,0)
-#define DOUBLEVV_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,INTVV,B,X,Y,Z,0)
-#define DOUBLEVVV_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,INTVVV,B,X,Y,Z,0)
-#define DOUBLEVVVV_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,INTVVVV,B,X,Y,Z,0)
-#define DOUBLEVVVVV_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,INTVVVVV,B,X,Y,Z,0)
-#define DOUBLEVVVVVV_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,INTVVVVVV,B,X,Y,Z,0)
-#define DOUBLEVVVVVVV_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,INTVVVVVVV,B,X,Y,Z,0)
-#define FLOATV_cfINT(N,A,B,X,Y,Z) DOUBLEV_cfINT(N,A,B,X,Y,Z)
-#define FLOATVV_cfINT(N,A,B,X,Y,Z) DOUBLEVV_cfINT(N,A,B,X,Y,Z)
-#define FLOATVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVV_cfINT(N,A,B,X,Y,Z)
-#define FLOATVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVV_cfINT(N,A,B,X,Y,Z)
-#define FLOATVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVV_cfINT(N,A,B,X,Y,Z)
-#define FLOATVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVV_cfINT(N,A,B,X,Y,Z)
-#define FLOATVVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVVV_cfINT(N,A,B,X,Y,Z)
-#define INTV_cfINT(N,A,B,X,Y,Z) DOUBLEV_cfINT(N,A,B,X,Y,Z)
-#define INTVV_cfINT(N,A,B,X,Y,Z) DOUBLEVV_cfINT(N,A,B,X,Y,Z)
-#define INTVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVV_cfINT(N,A,B,X,Y,Z)
-#define INTVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVV_cfINT(N,A,B,X,Y,Z)
-#define INTVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVV_cfINT(N,A,B,X,Y,Z)
-#define INTVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVV_cfINT(N,A,B,X,Y,Z)
-#define INTVVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVVV_cfINT(N,A,B,X,Y,Z)
-#define LOGICALV_cfINT(N,A,B,X,Y,Z) DOUBLEV_cfINT(N,A,B,X,Y,Z)
-#define LOGICALVV_cfINT(N,A,B,X,Y,Z) DOUBLEVV_cfINT(N,A,B,X,Y,Z)
-#define LOGICALVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVV_cfINT(N,A,B,X,Y,Z)
-#define LOGICALVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVV_cfINT(N,A,B,X,Y,Z)
-#define LOGICALVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVV_cfINT(N,A,B,X,Y,Z)
-#define LOGICALVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVV_cfINT(N,A,B,X,Y,Z)
-#define LOGICALVVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVVV_cfINT(N,A,B,X,Y,Z)
-#define LONGV_cfINT(N,A,B,X,Y,Z) DOUBLEV_cfINT(N,A,B,X,Y,Z)
-#define LONGVV_cfINT(N,A,B,X,Y,Z) DOUBLEVV_cfINT(N,A,B,X,Y,Z)
-#define LONGVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVV_cfINT(N,A,B,X,Y,Z)
-#define LONGVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVV_cfINT(N,A,B,X,Y,Z)
-#define LONGVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVV_cfINT(N,A,B,X,Y,Z)
-#define LONGVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVV_cfINT(N,A,B,X,Y,Z)
-#define LONGVVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVVV_cfINT(N,A,B,X,Y,Z)
-#define SHORTV_cfINT(N,A,B,X,Y,Z) DOUBLEV_cfINT(N,A,B,X,Y,Z)
-#define SHORTVV_cfINT(N,A,B,X,Y,Z) DOUBLEVV_cfINT(N,A,B,X,Y,Z)
-#define SHORTVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVV_cfINT(N,A,B,X,Y,Z)
-#define SHORTVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVV_cfINT(N,A,B,X,Y,Z)
-#define SHORTVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVV_cfINT(N,A,B,X,Y,Z)
-#define SHORTVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVV_cfINT(N,A,B,X,Y,Z)
-#define SHORTVVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVVV_cfINT(N,A,B,X,Y,Z)
-#define PVOID_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,B,B,X,Y,Z,0)
-#define ROUTINE_cfINT(N,A,B,X,Y,Z) PVOID_cfINT(N,A,B,X,Y,Z)
-/*CRAY coughs on the first,
- i.e. the usual trouble of not being able to
- define macros to macros with arguments.
- New ultrix is worse, it coughs on all such uses.
- */
-/*#define SIMPLE_cfINT PVOID_cfINT*/
-#define SIMPLE_cfINT(N,A,B,X,Y,Z) PVOID_cfINT(N,A,B,X,Y,Z)
-#define VOID_cfINT(N,A,B,X,Y,Z) PVOID_cfINT(N,A,B,X,Y,Z)
-#define STRING_cfINT(N,A,B,X,Y,Z) PVOID_cfINT(N,A,B,X,Y,Z)
-#define STRINGV_cfINT(N,A,B,X,Y,Z) PVOID_cfINT(N,A,B,X,Y,Z)
-#define PSTRING_cfINT(N,A,B,X,Y,Z) PVOID_cfINT(N,A,B,X,Y,Z)
-#define PSTRINGV_cfINT(N,A,B,X,Y,Z) PVOID_cfINT(N,A,B,X,Y,Z)
-#define PNSTRING_cfINT(N,A,B,X,Y,Z) PVOID_cfINT(N,A,B,X,Y,Z)
-#define PPSTRING_cfINT(N,A,B,X,Y,Z) PVOID_cfINT(N,A,B,X,Y,Z)
-#define ZTRINGV_cfINT(N,A,B,X,Y,Z) PVOID_cfINT(N,A,B,X,Y,Z)
-#define PZTRINGV_cfINT(N,A,B,X,Y,Z) PVOID_cfINT(N,A,B,X,Y,Z)
-#define CF_0_cfINT(N,A,B,X,Y,Z)
-
-
-#define UCF(TN,I,C) _SEP_(TN,C,cfCOMMA) _Icf(2,U,TN,_(A,I),0)
-#define UUCF(TN,I,C) _SEP_(TN,C,cfCOMMA) _SEP_(TN,1,I)
-#define UUUCF(TN,I,C) _SEP_(TN,C,cfCOLON) _Icf(2,U,TN,_(A,I),0)
-#define INT_cfU(T,A) _(T,VVVVVVV_cfTYPE) A
-#define INTV_cfU(T,A) _(T,VVVVVV_cfTYPE) * A
-#define INTVV_cfU(T,A) _(T,VVVVV_cfTYPE) * A
-#define INTVVV_cfU(T,A) _(T,VVVV_cfTYPE) * A
-#define INTVVVV_cfU(T,A) _(T,VVV_cfTYPE) * A
-#define INTVVVVV_cfU(T,A) _(T,VV_cfTYPE) * A
-#define INTVVVVVV_cfU(T,A) _(T,V_cfTYPE) * A
-#define INTVVVVVVV_cfU(T,A) _(T,_cfTYPE) * A
-#define PINT_cfU(T,A) _(T,_cfTYPE) * A
-#define PVOID_cfU(T,A) void *A
-#define ROUTINE_cfU(T,A) void (*A)(CF_NULL_PROTO)
-#define VOID_cfU(T,A) void A /* Needed for C calls FORTRAN sub.s. */
-#define STRING_cfU(T,A) char *A /* via VOID and wrapper. */
-#define STRINGV_cfU(T,A) char *A
-#define PSTRING_cfU(T,A) char *A
-#define PSTRINGV_cfU(T,A) char *A
-#define ZTRINGV_cfU(T,A) char *A
-#define PZTRINGV_cfU(T,A) char *A
-
-/* VOID breaks U into U and UU. */
-#define INT_cfUU(T,A) _(T,VVVVVVV_cfTYPE) A
-#define VOID_cfUU(T,A) /* Needed for FORTRAN calls C sub.s. */
-#define STRING_cfUU(T,A) char *A
-
-
-#define BYTE_cfPU(A) CFextern INTEGER_BYTE FCALLSC_QUALIFIER A
-#define DOUBLE_cfPU(A) CFextern DOUBLE_PRECISION FCALLSC_QUALIFIER A
-#if ! (defined(FLOATFUNCTIONTYPE)&&defined(ASSIGNFLOAT)&&defined(RETURNFLOAT))
-#define FLOAT_cfPU(A) CFextern FORTRAN_REAL FCALLSC_QUALIFIER A
-#else
-#define FLOAT_cfPU(A) CFextern FLOATFUNCTIONTYPE FCALLSC_QUALIFIER A
-#endif
-#define INT_cfPU(A) CFextern int FCALLSC_QUALIFIER A
-#define LOGICAL_cfPU(A) CFextern int FCALLSC_QUALIFIER A
-#define LONG_cfPU(A) CFextern long FCALLSC_QUALIFIER A
-#define SHORT_cfPU(A) CFextern short FCALLSC_QUALIFIER A
-#define STRING_cfPU(A) CFextern void FCALLSC_QUALIFIER A
-#define VOID_cfPU(A) CFextern void FCALLSC_QUALIFIER A
-
-#define BYTE_cfE INTEGER_BYTE A0;
-#define DOUBLE_cfE DOUBLE_PRECISION A0;
-#if ! (defined(FLOATFUNCTIONTYPE)&&defined(ASSIGNFLOAT)&&defined(RETURNFLOAT))
-#define FLOAT_cfE FORTRAN_REAL A0;
-#else
-#define FLOAT_cfE FORTRAN_REAL AA0; FLOATFUNCTIONTYPE A0;
-#endif
-#define INT_cfE int A0;
-#define LOGICAL_cfE int A0;
-#define LONG_cfE long A0;
-#define SHORT_cfE short A0;
-#define VOID_cfE
-#ifdef vmsFortran
-#define STRING_cfE static char AA0[1+MAX_LEN_FORTRAN_FUNCTION_STRING]; \
- static fstring A0 = \
- {MAX_LEN_FORTRAN_FUNCTION_STRING,DSC$K_DTYPE_T,DSC$K_CLASS_S,AA0};\
- memset(AA0, CFORTRAN_NON_CHAR, MAX_LEN_FORTRAN_FUNCTION_STRING);\
- *(AA0+MAX_LEN_FORTRAN_FUNCTION_STRING)='\0';
-#else
-#ifdef CRAYFortran
-#define STRING_cfE static char AA0[1+MAX_LEN_FORTRAN_FUNCTION_STRING]; \
- static _fcd A0; *(AA0+MAX_LEN_FORTRAN_FUNCTION_STRING)='\0';\
- memset(AA0,CFORTRAN_NON_CHAR, MAX_LEN_FORTRAN_FUNCTION_STRING);\
- A0 = _cptofcd(AA0,MAX_LEN_FORTRAN_FUNCTION_STRING);
-#else
-/* 'cc: SC3.0.1 13 Jul 1994' barfs on char A0[0x4FE+1];
- * char A0[0x4FE +1]; char A0[1+0x4FE]; are both OK. */
-#define STRING_cfE static char A0[1+MAX_LEN_FORTRAN_FUNCTION_STRING]; \
- memset(A0, CFORTRAN_NON_CHAR, \
- MAX_LEN_FORTRAN_FUNCTION_STRING); \
- *(A0+MAX_LEN_FORTRAN_FUNCTION_STRING)='\0';
-#endif
-#endif
-/* ESTRING must use static char. array which is guaranteed to exist after
- function returns. */
-
-/* N.B.i) The diff. for 0 (Zero) and >=1 arguments.
- ii)That the following create an unmatched bracket, i.e. '(', which
- must of course be matched in the call.
- iii)Commas must be handled very carefully */
-#define INT_cfGZ(T,UN,LN) A0=CFC_(UN,LN)(
-#define VOID_cfGZ(T,UN,LN) CFC_(UN,LN)(
-#ifdef vmsFortran
-#define STRING_cfGZ(T,UN,LN) CFC_(UN,LN)(&A0
-#else
-#if defined(CRAYFortran) || defined(AbsoftUNIXFortran) || defined(AbsoftProFortran)
-#define STRING_cfGZ(T,UN,LN) CFC_(UN,LN)( A0
-#else
-#define STRING_cfGZ(T,UN,LN) CFC_(UN,LN)( A0,MAX_LEN_FORTRAN_FUNCTION_STRING
-#endif
-#endif
-
-#define INT_cfG(T,UN,LN) INT_cfGZ(T,UN,LN)
-#define VOID_cfG(T,UN,LN) VOID_cfGZ(T,UN,LN)
-#define STRING_cfG(T,UN,LN) STRING_cfGZ(T,UN,LN), /*, is only diff. from _cfG*/
-
-#define BYTEVVVVVVV_cfPP
-#define INTVVVVVVV_cfPP /* These complement FLOATVVVVVVV_cfPP. */
-#define DOUBLEVVVVVVV_cfPP
-#define LOGICALVVVVVVV_cfPP
-#define LONGVVVVVVV_cfPP
-#define SHORTVVVVVVV_cfPP
-#define PBYTE_cfPP
-#define PINT_cfPP
-#define PDOUBLE_cfPP
-#define PLOGICAL_cfPP
-#define PLONG_cfPP
-#define PSHORT_cfPP
-#define PFLOAT_cfPP FLOATVVVVVVV_cfPP
-
-#define BCF(TN,AN,C) _SEP_(TN,C,cfCOMMA) _Icf(2,B,TN,AN,0)
-#define INT_cfB(T,A) (_(T,VVVVVVV_cfTYPE)) A
-#define INTV_cfB(T,A) A
-#define INTVV_cfB(T,A) (A)[0]
-#define INTVVV_cfB(T,A) (A)[0][0]
-#define INTVVVV_cfB(T,A) (A)[0][0][0]
-#define INTVVVVV_cfB(T,A) (A)[0][0][0][0]
-#define INTVVVVVV_cfB(T,A) (A)[0][0][0][0][0]
-#define INTVVVVVVV_cfB(T,A) (A)[0][0][0][0][0][0]
-#define PINT_cfB(T,A) _(T,_cfPP)&A
-#define STRING_cfB(T,A) (char *) A
-#define STRINGV_cfB(T,A) (char *) A
-#define PSTRING_cfB(T,A) (char *) A
-#define PSTRINGV_cfB(T,A) (char *) A
-#define PVOID_cfB(T,A) (void *) A
-#define ROUTINE_cfB(T,A) (cfCAST_FUNCTION)A
-#define ZTRINGV_cfB(T,A) (char *) A
-#define PZTRINGV_cfB(T,A) (char *) A
-
-#define SCF(TN,NAME,I,A) _(TN,_cfSTR)(3,S,NAME,I,A,0,0)
-#define DEFAULT_cfS(M,I,A)
-#define LOGICAL_cfS(M,I,A)
-#define PLOGICAL_cfS(M,I,A)
-#define STRING_cfS(M,I,A) ,sizeof(A)
-#define STRINGV_cfS(M,I,A) ,( (unsigned)0xFFFF*firstindexlength(A) \
- +secondindexlength(A))
-#define PSTRING_cfS(M,I,A) ,sizeof(A)
-#define PSTRINGV_cfS(M,I,A) STRINGV_cfS(M,I,A)
-#define ZTRINGV_cfS(M,I,A)
-#define PZTRINGV_cfS(M,I,A)
-
-#define HCF(TN,I) _(TN,_cfSTR)(3,H,cfCOMMA, H,_(C,I),0,0)
-#define HHCF(TN,I) _(TN,_cfSTR)(3,H,cfCOMMA,HH,_(C,I),0,0)
-#define HHHCF(TN,I) _(TN,_cfSTR)(3,H,cfCOLON, H,_(C,I),0,0)
-#define H_CF_SPECIAL unsigned
-#define HH_CF_SPECIAL
-#define DEFAULT_cfH(M,I,A)
-#define LOGICAL_cfH(S,U,B)
-#define PLOGICAL_cfH(S,U,B)
-#define STRING_cfH(S,U,B) _(A,S) _(U,_CF_SPECIAL) B
-#define STRINGV_cfH(S,U,B) STRING_cfH(S,U,B)
-#define PSTRING_cfH(S,U,B) STRING_cfH(S,U,B)
-#define PSTRINGV_cfH(S,U,B) STRING_cfH(S,U,B)
-#define PNSTRING_cfH(S,U,B) STRING_cfH(S,U,B)
-#define PPSTRING_cfH(S,U,B) STRING_cfH(S,U,B)
-#define ZTRINGV_cfH(S,U,B)
-#define PZTRINGV_cfH(S,U,B)
-
-/* Need VOID_cfSTR because Absoft forced function types go through _cfSTR. */
-/* No spaces inside expansion. They screws up macro catenation kludge. */
-#define VOID_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
-#define BYTE_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
-#define DOUBLE_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
-#define FLOAT_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
-#define INT_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
-#define LOGICAL_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,LOGICAL,A,B,C,D,E)
-#define LONG_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
-#define SHORT_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
-#define BYTEV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
-#define BYTEVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
-#define BYTEVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
-#define BYTEVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
-#define BYTEVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
-#define BYTEVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
-#define BYTEVVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
-#define DOUBLEV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
-#define DOUBLEVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
-#define DOUBLEVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
-#define DOUBLEVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
-#define DOUBLEVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
-#define DOUBLEVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
-#define DOUBLEVVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
-#define FLOATV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
-#define FLOATVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
-#define FLOATVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
-#define FLOATVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
-#define FLOATVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
-#define FLOATVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
-#define FLOATVVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
-#define INTV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
-#define INTVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
-#define INTVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
-#define INTVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
-#define INTVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
-#define INTVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
-#define INTVVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
-#define LOGICALV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
-#define LOGICALVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
-#define LOGICALVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
-#define LOGICALVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
-#define LOGICALVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
-#define LOGICALVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
-#define LOGICALVVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
-#define LONGV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
-#define LONGVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
-#define LONGVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
-#define LONGVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
-#define LONGVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
-#define LONGVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
-#define LONGVVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
-#define SHORTV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
-#define SHORTVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
-#define SHORTVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
-#define SHORTVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
-#define SHORTVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
-#define SHORTVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
-#define SHORTVVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
-#define PBYTE_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
-#define PDOUBLE_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
-#define PFLOAT_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
-#define PINT_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
-#define PLOGICAL_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,PLOGICAL,A,B,C,D,E)
-#define PLONG_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
-#define PSHORT_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
-#define STRING_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,STRING,A,B,C,D,E)
-#define PSTRING_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,PSTRING,A,B,C,D,E)
-#define STRINGV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,STRINGV,A,B,C,D,E)
-#define PSTRINGV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,PSTRINGV,A,B,C,D,E)
-#define PNSTRING_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,PNSTRING,A,B,C,D,E)
-#define PPSTRING_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,PPSTRING,A,B,C,D,E)
-#define PVOID_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
-#define ROUTINE_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
-#define SIMPLE_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
-#define ZTRINGV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,ZTRINGV,A,B,C,D,E)
-#define PZTRINGV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,PZTRINGV,A,B,C,D,E)
-#define CF_0_cfSTR(N,T,A,B,C,D,E)
-
-/* See ACF table comments, which explain why CCF was split into two. */
-#define CCF(NAME,TN,I) _(TN,_cfSTR)(5,C,NAME,I,_(A,I),_(B,I),_(C,I))
-#define DEFAULT_cfC(M,I,A,B,C)
-#define LOGICAL_cfC(M,I,A,B,C) A=C2FLOGICAL( A);
-#define PLOGICAL_cfC(M,I,A,B,C) *A=C2FLOGICAL(*A);
-#ifdef vmsFortran
-#define STRING_cfC(M,I,A,B,C) (B.clen=strlen(A),B.f.dsc$a_pointer=A, \
- C==sizeof(char*)||C==(unsigned)(B.clen+1)?B.f.dsc$w_length=B.clen: \
- (memset((A)+B.clen,' ',C-B.clen-1),A[B.f.dsc$w_length=C-1]='\0'));
- /* PSTRING_cfC to beware of array A which does not contain any \0. */
-#define PSTRING_cfC(M,I,A,B,C) (B.dsc$a_pointer=A, C==sizeof(char*) ? \
- B.dsc$w_length=strlen(A): (A[C-1]='\0',B.dsc$w_length=strlen(A), \
- memset((A)+B.dsc$w_length,' ',C-B.dsc$w_length-1), B.dsc$w_length=C-1));
-#else
-#define STRING_cfC(M,I,A,B,C) (B.nombre=A,B.clen=strlen(A), \
- C==sizeof(char*)||C==(unsigned)(B.clen+1)?B.flen=B.clen: \
- (memset(B.nombre+B.clen,' ',C-B.clen-1),B.nombre[B.flen=C-1]='\0'));
-#define PSTRING_cfC(M,I,A,B,C) (C==sizeof(char*)? B=strlen(A): \
- (A[C-1]='\0',B=strlen(A),memset((A)+B,' ',C-B-1),B=C-1));
-#endif
- /* For CRAYFortran for (P)STRINGV_cfC, B.fs is set, but irrelevant. */
-#define STRINGV_cfC(M,I,A,B,C) \
- AATRINGV_cfA( A,B,(C/0xFFFF)*(C%0xFFFF),C/0xFFFF,C%0xFFFF)
-#define PSTRINGV_cfC(M,I,A,B,C) \
- APATRINGV_cfA( A,B,(C/0xFFFF)*(C%0xFFFF),C/0xFFFF,C%0xFFFF)
-#define ZTRINGV_cfC(M,I,A,B,C) \
- AATRINGV_cfA( A,B, (_3(M,_ELEMS_,I))*((_3(M,_ELEMLEN_,I))+1), \
- (_3(M,_ELEMS_,I)), (_3(M,_ELEMLEN_,I))+1 )
-#define PZTRINGV_cfC(M,I,A,B,C) \
- APATRINGV_cfA( A,B, (_3(M,_ELEMS_,I))*((_3(M,_ELEMLEN_,I))+1), \
- (_3(M,_ELEMS_,I)), (_3(M,_ELEMLEN_,I))+1 )
-
-#define BYTE_cfCCC(A,B) &A
-#define DOUBLE_cfCCC(A,B) &A
-#if !defined(__CF__KnR)
-#define FLOAT_cfCCC(A,B) &A
- /* Although the VAX doesn't, at least the */
-#else /* HP and K&R mips promote float arg.'s of */
-#define FLOAT_cfCCC(A,B) &B /* unprototyped functions to double. Cannot */
-#endif /* use A here to pass the argument to FORTRAN. */
-#define INT_cfCCC(A,B) &A
-#define LOGICAL_cfCCC(A,B) &A
-#define LONG_cfCCC(A,B) &A
-#define SHORT_cfCCC(A,B) &A
-#define PBYTE_cfCCC(A,B) A
-#define PDOUBLE_cfCCC(A,B) A
-#define PFLOAT_cfCCC(A,B) A
-#define PINT_cfCCC(A,B) A
-#define PLOGICAL_cfCCC(A,B) B=A /* B used to keep a common W table. */
-#define PLONG_cfCCC(A,B) A
-#define PSHORT_cfCCC(A,B) A
-
-#define CCCF(TN,I,M) _SEP_(TN,M,cfCOMMA) _Icf(3,CC,TN,_(A,I),_(B,I))
-#define INT_cfCC(T,A,B) _(T,_cfCCC)(A,B)
-#define INTV_cfCC(T,A,B) A
-#define INTVV_cfCC(T,A,B) A
-#define INTVVV_cfCC(T,A,B) A
-#define INTVVVV_cfCC(T,A,B) A
-#define INTVVVVV_cfCC(T,A,B) A
-#define INTVVVVVV_cfCC(T,A,B) A
-#define INTVVVVVVV_cfCC(T,A,B) A
-#define PINT_cfCC(T,A,B) _(T,_cfCCC)(A,B)
-#define PVOID_cfCC(T,A,B) A
-#if defined(apolloFortran) || defined(hpuxFortran800) || defined(AbsoftUNIXFortran)
-#define ROUTINE_cfCC(T,A,B) &A
-#else
-#define ROUTINE_cfCC(T,A,B) A
-#endif
-#define SIMPLE_cfCC(T,A,B) A
-#ifdef vmsFortran
-#define STRING_cfCC(T,A,B) &B.f
-#define STRINGV_cfCC(T,A,B) &B
-#define PSTRING_cfCC(T,A,B) &B
-#define PSTRINGV_cfCC(T,A,B) &B
-#else
-#ifdef CRAYFortran
-#define STRING_cfCC(T,A,B) _cptofcd(A,B.flen)
-#define STRINGV_cfCC(T,A,B) _cptofcd(B.s,B.flen)
-#define PSTRING_cfCC(T,A,B) _cptofcd(A,B)
-#define PSTRINGV_cfCC(T,A,B) _cptofcd(A,B.flen)
-#else
-#define STRING_cfCC(T,A,B) A
-#define STRINGV_cfCC(T,A,B) B.fs
-#define PSTRING_cfCC(T,A,B) A
-#define PSTRINGV_cfCC(T,A,B) B.fs
-#endif
-#endif
-#define ZTRINGV_cfCC(T,A,B) STRINGV_cfCC(T,A,B)
-#define PZTRINGV_cfCC(T,A,B) PSTRINGV_cfCC(T,A,B)
-
-#define BYTE_cfX return A0;
-#define DOUBLE_cfX return A0;
-#if ! (defined(FLOATFUNCTIONTYPE)&&defined(ASSIGNFLOAT)&&defined(RETURNFLOAT))
-#define FLOAT_cfX return A0;
-#else
-#define FLOAT_cfX ASSIGNFLOAT(AA0,A0); return AA0;
-#endif
-#define INT_cfX return A0;
-#define LOGICAL_cfX return F2CLOGICAL(A0);
-#define LONG_cfX return A0;
-#define SHORT_cfX return A0;
-#define VOID_cfX return ;
-#if defined(vmsFortran) || defined(CRAYFortran)
-#define STRING_cfX return kill_trailing( \
- kill_trailing(AA0,CFORTRAN_NON_CHAR),' ');
-#else
-#define STRING_cfX return kill_trailing( \
- kill_trailing( A0,CFORTRAN_NON_CHAR),' ');
-#endif
-
-#define CFFUN(NAME) _(__cf__,NAME)
-
-/* Note that we don't use LN here, but we keep it for consistency. */
-#define CCALLSFFUN0(UN,LN) CFFUN(UN)()
-
-#ifdef OLD_VAXC /* Allow %CC-I-PARAMNOTUSED. */
-#pragma standard
-#endif
-
-#define CCALLSFFUN1( UN,LN,T1, A1) \
- CCALLSFFUN5 (UN,LN,T1,CF_0,CF_0,CF_0,CF_0,A1,0,0,0,0)
-#define CCALLSFFUN2( UN,LN,T1,T2, A1,A2) \
- CCALLSFFUN5 (UN,LN,T1,T2,CF_0,CF_0,CF_0,A1,A2,0,0,0)
-#define CCALLSFFUN3( UN,LN,T1,T2,T3, A1,A2,A3) \
- CCALLSFFUN5 (UN,LN,T1,T2,T3,CF_0,CF_0,A1,A2,A3,0,0)
-#define CCALLSFFUN4( UN,LN,T1,T2,T3,T4, A1,A2,A3,A4)\
- CCALLSFFUN5 (UN,LN,T1,T2,T3,T4,CF_0,A1,A2,A3,A4,0)
-#define CCALLSFFUN5( UN,LN,T1,T2,T3,T4,T5, A1,A2,A3,A4,A5) \
- CCALLSFFUN10(UN,LN,T1,T2,T3,T4,T5,CF_0,CF_0,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,0,0,0,0,0)
-#define CCALLSFFUN6( UN,LN,T1,T2,T3,T4,T5,T6, A1,A2,A3,A4,A5,A6) \
- CCALLSFFUN10(UN,LN,T1,T2,T3,T4,T5,T6,CF_0,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,0,0,0,0)
-#define CCALLSFFUN7( UN,LN,T1,T2,T3,T4,T5,T6,T7, A1,A2,A3,A4,A5,A6,A7) \
- CCALLSFFUN10(UN,LN,T1,T2,T3,T4,T5,T6,T7,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,0,0,0)
-#define CCALLSFFUN8( UN,LN,T1,T2,T3,T4,T5,T6,T7,T8, A1,A2,A3,A4,A5,A6,A7,A8) \
- CCALLSFFUN10(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,0,0)
-#define CCALLSFFUN9( UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,A1,A2,A3,A4,A5,A6,A7,A8,A9)\
- CCALLSFFUN10(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,0)
-#define CCALLSFFUN10(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA)\
- CCALLSFFUN14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,CF_0,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,0,0,0,0)
-#define CCALLSFFUN11(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB)\
- CCALLSFFUN14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,0,0,0)
-#define CCALLSFFUN12(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC)\
- CCALLSFFUN14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,0,0)
-#define CCALLSFFUN13(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD)\
- CCALLSFFUN14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,0)
-
-#define CCALLSFFUN14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE)\
-((CFFUN(UN)( BCF(T1,A1,0) BCF(T2,A2,1) BCF(T3,A3,1) BCF(T4,A4,1) BCF(T5,A5,1) \
- BCF(T6,A6,1) BCF(T7,A7,1) BCF(T8,A8,1) BCF(T9,A9,1) BCF(TA,AA,1) \
- BCF(TB,AB,1) BCF(TC,AC,1) BCF(TD,AD,1) BCF(TE,AE,1) \
- SCF(T1,LN,1,A1) SCF(T2,LN,2,A2) SCF(T3,LN,3,A3) SCF(T4,LN,4,A4) \
- SCF(T5,LN,5,A5) SCF(T6,LN,6,A6) SCF(T7,LN,7,A7) SCF(T8,LN,8,A8) \
- SCF(T9,LN,9,A9) SCF(TA,LN,10,AA) SCF(TB,LN,11,AB) SCF(TC,LN,12,AC) \
- SCF(TD,LN,13,AD) SCF(TE,LN,14,AE))))
-
-/* N.B. Create a separate function instead of using (call function, function
-value here) because in order to create the variables needed for the input
-arg.'s which may be const.'s one has to do the creation within {}, but these
-can never be placed within ()'s. Therefore one must create wrapper functions.
-gcc, on the other hand may be able to avoid the wrapper functions. */
-
-/* Prototypes are needed to correctly handle the value returned correctly. N.B.
-Can only have prototype arg.'s with difficulty, a la G... table since FORTRAN
-functions returning strings have extra arg.'s. Don't bother, since this only
-causes a compiler warning to come up when one uses FCALLSCFUNn and CCALLSFFUNn
-for the same function in the same source code. Something done by the experts in
-debugging only.*/
-
-#define PROTOCCALLSFFUN0(F,UN,LN) \
-_(F,_cfPU)( CFC_(UN,LN))(CF_NULL_PROTO); \
-static _Icf(2,U,F,CFFUN(UN),0)() {_(F,_cfE) _Icf(3,GZ,F,UN,LN) ABSOFT_cf1(F));_(F,_cfX)}
-
-#define PROTOCCALLSFFUN1( T0,UN,LN,T1) \
- PROTOCCALLSFFUN5 (T0,UN,LN,T1,CF_0,CF_0,CF_0,CF_0)
-#define PROTOCCALLSFFUN2( T0,UN,LN,T1,T2) \
- PROTOCCALLSFFUN5 (T0,UN,LN,T1,T2,CF_0,CF_0,CF_0)
-#define PROTOCCALLSFFUN3( T0,UN,LN,T1,T2,T3) \
- PROTOCCALLSFFUN5 (T0,UN,LN,T1,T2,T3,CF_0,CF_0)
-#define PROTOCCALLSFFUN4( T0,UN,LN,T1,T2,T3,T4) \
- PROTOCCALLSFFUN5 (T0,UN,LN,T1,T2,T3,T4,CF_0)
-#define PROTOCCALLSFFUN5( T0,UN,LN,T1,T2,T3,T4,T5) \
- PROTOCCALLSFFUN10(T0,UN,LN,T1,T2,T3,T4,T5,CF_0,CF_0,CF_0,CF_0,CF_0)
-#define PROTOCCALLSFFUN6( T0,UN,LN,T1,T2,T3,T4,T5,T6) \
- PROTOCCALLSFFUN10(T0,UN,LN,T1,T2,T3,T4,T5,T6,CF_0,CF_0,CF_0,CF_0)
-#define PROTOCCALLSFFUN7( T0,UN,LN,T1,T2,T3,T4,T5,T6,T7) \
- PROTOCCALLSFFUN10(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,CF_0,CF_0,CF_0)
-#define PROTOCCALLSFFUN8( T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8) \
- PROTOCCALLSFFUN10(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,CF_0,CF_0)
-#define PROTOCCALLSFFUN9( T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9) \
- PROTOCCALLSFFUN10(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,CF_0)
-#define PROTOCCALLSFFUN10(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA) \
- PROTOCCALLSFFUN14(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,CF_0,CF_0,CF_0,CF_0)
-#define PROTOCCALLSFFUN11(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB) \
- PROTOCCALLSFFUN14(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,CF_0,CF_0,CF_0)
-#define PROTOCCALLSFFUN12(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC) \
- PROTOCCALLSFFUN14(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,CF_0,CF_0)
-#define PROTOCCALLSFFUN13(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD) \
- PROTOCCALLSFFUN14(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,CF_0)
-
-/* HP/UX 9.01 cc requires the blank between '_Icf(3,G,T0,UN,LN) CCCF(T1,1,0)' */
-
-#ifndef __CF__KnR
-#define PROTOCCALLSFFUN14(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \
- _(T0,_cfPU)(CFC_(UN,LN))(CF_NULL_PROTO); static _Icf(2,U,T0,CFFUN(UN),0)( \
- CFARGT14FS(UCF,HCF,_Z,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) ) \
-{ CFARGT14S(VCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) _(T0,_cfE) \
- CCF(LN,T1,1) CCF(LN,T2,2) CCF(LN,T3,3) CCF(LN,T4,4) CCF(LN,T5,5) \
- CCF(LN,T6,6) CCF(LN,T7,7) CCF(LN,T8,8) CCF(LN,T9,9) CCF(LN,TA,10) \
- CCF(LN,TB,11) CCF(LN,TC,12) CCF(LN,TD,13) CCF(LN,TE,14) _Icf(3,G,T0,UN,LN) \
- CFARGT14(CCCF,JCF,ABSOFT_cf1(T0),T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)); \
- WCF(T1,A1,1) WCF(T2,A2,2) WCF(T3,A3,3) WCF(T4,A4,4) WCF(T5,A5,5) \
- WCF(T6,A6,6) WCF(T7,A7,7) WCF(T8,A8,8) WCF(T9,A9,9) WCF(TA,A10,10) \
- WCF(TB,A11,11) WCF(TC,A12,12) WCF(TD,A13,13) WCF(TE,A14,14) _(T0,_cfX)}
-#else
-#define PROTOCCALLSFFUN14(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \
- _(T0,_cfPU)(CFC_(UN,LN))(CF_NULL_PROTO); static _Icf(2,U,T0,CFFUN(UN),0)( \
- CFARGT14FS(UUCF,HHCF,_Z,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) ) \
- CFARGT14FS(UUUCF,HHHCF,_Z,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) ; \
-{ CFARGT14S(VCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) _(T0,_cfE) \
- CCF(LN,T1,1) CCF(LN,T2,2) CCF(LN,T3,3) CCF(LN,T4,4) CCF(LN,T5,5) \
- CCF(LN,T6,6) CCF(LN,T7,7) CCF(LN,T8,8) CCF(LN,T9,9) CCF(LN,TA,10) \
- CCF(LN,TB,11) CCF(LN,TC,12) CCF(LN,TD,13) CCF(LN,TE,14) _Icf(3,G,T0,UN,LN) \
- CFARGT14(CCCF,JCF,ABSOFT_cf1(T0),T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)); \
- WCF(T1,A1,1) WCF(T2,A2,2) WCF(T3,A3,3) WCF(T4,A4,4) WCF(T5,A5,5) \
- WCF(T6,A6,6) WCF(T7,A7,7) WCF(T8,A8,8) WCF(T9,A9,9) WCF(TA,A10,10) \
- WCF(TB,A11,11) WCF(TC,A12,12) WCF(TD,A13,13) WCF(TE,A14,14) _(T0,_cfX)}
-#endif
-
-/*-------------------------------------------------------------------------*/
-
-/* UTILITIES FOR FORTRAN TO CALL C ROUTINES */
-
-#ifdef OLD_VAXC /* Prevent %CC-I-PARAMNOTUSED. */
-#pragma nostandard
-#endif
-
-#if defined(vmsFortran) || defined(CRAYFortran)
-#define DCF(TN,I)
-#define DDCF(TN,I)
-#define DDDCF(TN,I)
-#else
-#define DCF(TN,I) HCF(TN,I)
-#define DDCF(TN,I) HHCF(TN,I)
-#define DDDCF(TN,I) HHHCF(TN,I)
-#endif
-
-#define QCF(TN,I) _(TN,_cfSTR)(1,Q,_(B,I), 0,0,0,0)
-#define DEFAULT_cfQ(B)
-#define LOGICAL_cfQ(B)
-#define PLOGICAL_cfQ(B)
-#define STRINGV_cfQ(B) char *B; unsigned int _(B,N);
-#define STRING_cfQ(B) char *B=NULL;
-#define PSTRING_cfQ(B) char *B=NULL;
-#define PSTRINGV_cfQ(B) STRINGV_cfQ(B)
-#define PNSTRING_cfQ(B) char *B=NULL;
-#define PPSTRING_cfQ(B)
-
-#ifdef __sgi /* Else SGI gives warning 182 contrary to its C LRM A.17.7 */
-#define ROUTINE_orig *(void**)&
-#else
-#define ROUTINE_orig (void *)
-#endif
-
-#define ROUTINE_1 ROUTINE_orig
-#define ROUTINE_2 ROUTINE_orig
-#define ROUTINE_3 ROUTINE_orig
-#define ROUTINE_4 ROUTINE_orig
-#define ROUTINE_5 ROUTINE_orig
-#define ROUTINE_6 ROUTINE_orig
-#define ROUTINE_7 ROUTINE_orig
-#define ROUTINE_8 ROUTINE_orig
-#define ROUTINE_9 ROUTINE_orig
-#define ROUTINE_10 ROUTINE_orig
-#define ROUTINE_11 ROUTINE_orig
-#define ROUTINE_12 ROUTINE_orig
-#define ROUTINE_13 ROUTINE_orig
-#define ROUTINE_14 ROUTINE_orig
-#define ROUTINE_15 ROUTINE_orig
-#define ROUTINE_16 ROUTINE_orig
-#define ROUTINE_17 ROUTINE_orig
-#define ROUTINE_18 ROUTINE_orig
-#define ROUTINE_19 ROUTINE_orig
-#define ROUTINE_20 ROUTINE_orig
-#define ROUTINE_21 ROUTINE_orig
-#define ROUTINE_22 ROUTINE_orig
-#define ROUTINE_23 ROUTINE_orig
-#define ROUTINE_24 ROUTINE_orig
-#define ROUTINE_25 ROUTINE_orig
-#define ROUTINE_26 ROUTINE_orig
-#define ROUTINE_27 ROUTINE_orig
-
-#define TCF(NAME,TN,I,M) _SEP_(TN,M,cfCOMMA) _(TN,_cfT)(NAME,I,_(A,I),_(B,I),_(C,I))
-#define BYTE_cfT(M,I,A,B,D) *A
-#define DOUBLE_cfT(M,I,A,B,D) *A
-#define FLOAT_cfT(M,I,A,B,D) *A
-#define INT_cfT(M,I,A,B,D) *A
-#define LOGICAL_cfT(M,I,A,B,D) F2CLOGICAL(*A)
-#define LONG_cfT(M,I,A,B,D) *A
-#define SHORT_cfT(M,I,A,B,D) *A
-#define BYTEV_cfT(M,I,A,B,D) A
-#define DOUBLEV_cfT(M,I,A,B,D) A
-#define FLOATV_cfT(M,I,A,B,D) VOIDP A
-#define INTV_cfT(M,I,A,B,D) A
-#define LOGICALV_cfT(M,I,A,B,D) A
-#define LONGV_cfT(M,I,A,B,D) A
-#define SHORTV_cfT(M,I,A,B,D) A
-#define BYTEVV_cfT(M,I,A,B,D) (void *)A /* We have to cast to void *,*/
-#define BYTEVVV_cfT(M,I,A,B,D) (void *)A /* since we don't know the */
-#define BYTEVVVV_cfT(M,I,A,B,D) (void *)A /* dimensions of the array. */
-#define BYTEVVVVV_cfT(M,I,A,B,D) (void *)A /* i.e. Unfortunately, can't */
-#define BYTEVVVVVV_cfT(M,I,A,B,D) (void *)A /* check that the type */
-#define BYTEVVVVVVV_cfT(M,I,A,B,D) (void *)A /* matches the prototype. */
-#define DOUBLEVV_cfT(M,I,A,B,D) (void *)A
-#define DOUBLEVVV_cfT(M,I,A,B,D) (void *)A
-#define DOUBLEVVVV_cfT(M,I,A,B,D) (void *)A
-#define DOUBLEVVVVV_cfT(M,I,A,B,D) (void *)A
-#define DOUBLEVVVVVV_cfT(M,I,A,B,D) (void *)A
-#define DOUBLEVVVVVVV_cfT(M,I,A,B,D) (void *)A
-#define FLOATVV_cfT(M,I,A,B,D) (void *)A
-#define FLOATVVV_cfT(M,I,A,B,D) (void *)A
-#define FLOATVVVV_cfT(M,I,A,B,D) (void *)A
-#define FLOATVVVVV_cfT(M,I,A,B,D) (void *)A
-#define FLOATVVVVVV_cfT(M,I,A,B,D) (void *)A
-#define FLOATVVVVVVV_cfT(M,I,A,B,D) (void *)A
-#define INTVV_cfT(M,I,A,B,D) (void *)A
-#define INTVVV_cfT(M,I,A,B,D) (void *)A
-#define INTVVVV_cfT(M,I,A,B,D) (void *)A
-#define INTVVVVV_cfT(M,I,A,B,D) (void *)A
-#define INTVVVVVV_cfT(M,I,A,B,D) (void *)A
-#define INTVVVVVVV_cfT(M,I,A,B,D) (void *)A
-#define LOGICALVV_cfT(M,I,A,B,D) (void *)A
-#define LOGICALVVV_cfT(M,I,A,B,D) (void *)A
-#define LOGICALVVVV_cfT(M,I,A,B,D) (void *)A
-#define LOGICALVVVVV_cfT(M,I,A,B,D) (void *)A
-#define LOGICALVVVVVV_cfT(M,I,A,B,D) (void *)A
-#define LOGICALVVVVVVV_cfT(M,I,A,B,D) (void *)A
-#define LONGVV_cfT(M,I,A,B,D) (void *)A
-#define LONGVVV_cfT(M,I,A,B,D) (void *)A
-#define LONGVVVV_cfT(M,I,A,B,D) (void *)A
-#define LONGVVVVV_cfT(M,I,A,B,D) (void *)A
-#define LONGVVVVVV_cfT(M,I,A,B,D) (void *)A
-#define LONGVVVVVVV_cfT(M,I,A,B,D) (void *)A
-#define SHORTVV_cfT(M,I,A,B,D) (void *)A
-#define SHORTVVV_cfT(M,I,A,B,D) (void *)A
-#define SHORTVVVV_cfT(M,I,A,B,D) (void *)A
-#define SHORTVVVVV_cfT(M,I,A,B,D) (void *)A
-#define SHORTVVVVVV_cfT(M,I,A,B,D) (void *)A
-#define SHORTVVVVVVV_cfT(M,I,A,B,D) (void *)A
-#define PBYTE_cfT(M,I,A,B,D) A
-#define PDOUBLE_cfT(M,I,A,B,D) A
-#define PFLOAT_cfT(M,I,A,B,D) VOIDP A
-#define PINT_cfT(M,I,A,B,D) A
-#define PLOGICAL_cfT(M,I,A,B,D) ((*A=F2CLOGICAL(*A)),A)
-#define PLONG_cfT(M,I,A,B,D) A
-#define PSHORT_cfT(M,I,A,B,D) A
-#define PVOID_cfT(M,I,A,B,D) A
-#if defined(apolloFortran) || defined(hpuxFortran800) || defined(AbsoftUNIXFortran)
-#define ROUTINE_cfT(M,I,A,B,D) _(ROUTINE_,I) (*A)
-#else
-#define ROUTINE_cfT(M,I,A,B,D) _(ROUTINE_,I) A
-#endif
-/* A == pointer to the characters
- D == length of the string, or of an element in an array of strings
- E == number of elements in an array of strings */
-#define TTSTR( A,B,D) \
- ((B=_cf_malloc(D+1))[D]='\0', memcpy(B,A,D), kill_trailing(B,' '))
-#define TTTTSTR( A,B,D) (!(D<4||A[0]||A[1]||A[2]||A[3]))?NULL: \
- memchr(A,'\0',D) ?A : TTSTR(A,B,D)
-#define TTTTSTRV( A,B,D,E) (_(B,N)=E,B=_cf_malloc(_(B,N)*(D+1)), (void *) \
- vkill_trailing(f2cstrv(A,B,D+1, _(B,N)*(D+1)), D+1,_(B,N)*(D+1),' '))
-#ifdef vmsFortran
-#define STRING_cfT(M,I,A,B,D) TTTTSTR( A->dsc$a_pointer,B,A->dsc$w_length)
-#define STRINGV_cfT(M,I,A,B,D) TTTTSTRV(A->dsc$a_pointer, B, \
- A->dsc$w_length , A->dsc$l_m[0])
-#define PSTRING_cfT(M,I,A,B,D) TTSTR( A->dsc$a_pointer,B,A->dsc$w_length)
-#define PPSTRING_cfT(M,I,A,B,D) A->dsc$a_pointer
-#else
-#ifdef CRAYFortran
-#define STRING_cfT(M,I,A,B,D) TTTTSTR( _fcdtocp(A),B,_fcdlen(A))
-#define STRINGV_cfT(M,I,A,B,D) TTTTSTRV(_fcdtocp(A),B,_fcdlen(A), \
- num_elem(_fcdtocp(A),_fcdlen(A),_3(M,_STRV_A,I)))
-#define PSTRING_cfT(M,I,A,B,D) TTSTR( _fcdtocp(A),B,_fcdlen(A))
-#define PPSTRING_cfT(M,I,A,B,D) _fcdtocp(A)
-#else
-#define STRING_cfT(M,I,A,B,D) TTTTSTR( A,B,D)
-#define STRINGV_cfT(M,I,A,B,D) TTTTSTRV(A,B,D, num_elem(A,D,_3(M,_STRV_A,I)))
-#define PSTRING_cfT(M,I,A,B,D) TTSTR( A,B,D)
-#define PPSTRING_cfT(M,I,A,B,D) A
-#endif
-#endif
-#define PNSTRING_cfT(M,I,A,B,D) STRING_cfT(M,I,A,B,D)
-#define PSTRINGV_cfT(M,I,A,B,D) STRINGV_cfT(M,I,A,B,D)
-#define CF_0_cfT(M,I,A,B,D)
-
-#define RCF(TN,I) _(TN,_cfSTR)(3,R,_(A,I),_(B,I),_(C,I),0,0)
-#define DEFAULT_cfR(A,B,D)
-#define LOGICAL_cfR(A,B,D)
-#define PLOGICAL_cfR(A,B,D) *A=C2FLOGICAL(*A);
-#define STRING_cfR(A,B,D) if (B) _cf_free(B);
-#define STRINGV_cfR(A,B,D) _cf_free(B);
-/* A and D as defined above for TSTRING(V) */
-#define RRRRPSTR( A,B,D) if (B) memcpy(A,B, _cfMIN(strlen(B),D)), \
- (D>strlen(B)?memset(A+strlen(B),' ', D-strlen(B)):0), _cf_free(B);
-#define RRRRPSTRV(A,B,D) c2fstrv(B,A,D+1,(D+1)*_(B,N)), _cf_free(B);
-#ifdef vmsFortran
-#define PSTRING_cfR(A,B,D) RRRRPSTR( A->dsc$a_pointer,B,A->dsc$w_length)
-#define PSTRINGV_cfR(A,B,D) RRRRPSTRV(A->dsc$a_pointer,B,A->dsc$w_length)
-#else
-#ifdef CRAYFortran
-#define PSTRING_cfR(A,B,D) RRRRPSTR( _fcdtocp(A),B,_fcdlen(A))
-#define PSTRINGV_cfR(A,B,D) RRRRPSTRV(_fcdtocp(A),B,_fcdlen(A))
-#else
-#define PSTRING_cfR(A,B,D) RRRRPSTR( A,B,D)
-#define PSTRINGV_cfR(A,B,D) RRRRPSTRV(A,B,D)
-#endif
-#endif
-#define PNSTRING_cfR(A,B,D) PSTRING_cfR(A,B,D)
-#define PPSTRING_cfR(A,B,D)
-
-#define BYTE_cfFZ(UN,LN) INTEGER_BYTE FCALLSC_QUALIFIER fcallsc(UN,LN)(
-#define DOUBLE_cfFZ(UN,LN) DOUBLE_PRECISION FCALLSC_QUALIFIER fcallsc(UN,LN)(
-#define INT_cfFZ(UN,LN) int FCALLSC_QUALIFIER fcallsc(UN,LN)(
-#define LOGICAL_cfFZ(UN,LN) int FCALLSC_QUALIFIER fcallsc(UN,LN)(
-#define LONG_cfFZ(UN,LN) long FCALLSC_QUALIFIER fcallsc(UN,LN)(
-#define SHORT_cfFZ(UN,LN) short FCALLSC_QUALIFIER fcallsc(UN,LN)(
-#define VOID_cfFZ(UN,LN) void FCALLSC_QUALIFIER fcallsc(UN,LN)(
-#ifndef __CF__KnR
-/* The void is req'd by the Apollo, to make this an ANSI function declaration.
- The Apollo promotes K&R float functions to double. */
-#define FLOAT_cfFZ(UN,LN) FORTRAN_REAL FCALLSC_QUALIFIER fcallsc(UN,LN)(void
-#ifdef vmsFortran
-#define STRING_cfFZ(UN,LN) void FCALLSC_QUALIFIER fcallsc(UN,LN)(fstring *AS
-#else
-#ifdef CRAYFortran
-#define STRING_cfFZ(UN,LN) void FCALLSC_QUALIFIER fcallsc(UN,LN)(_fcd AS
-#else
-#if defined(AbsoftUNIXFortran) || defined(AbsoftProFortran)
-#define STRING_cfFZ(UN,LN) void FCALLSC_QUALIFIER fcallsc(UN,LN)(char *AS
-#else
-#define STRING_cfFZ(UN,LN) void FCALLSC_QUALIFIER fcallsc(UN,LN)(char *AS, unsigned D0
-#endif
-#endif
-#endif
-#else
-#if ! (defined(FLOATFUNCTIONTYPE)&&defined(ASSIGNFLOAT)&&defined(RETURNFLOAT))
-#define FLOAT_cfFZ(UN,LN) FORTRAN_REAL FCALLSC_QUALIFIER fcallsc(UN,LN)(
-#else
-#define FLOAT_cfFZ(UN,LN) FLOATFUNCTIONTYPE FCALLSC_QUALIFIER fcallsc(UN,LN)(
-#endif
-#if defined(vmsFortran) || defined(CRAYFortran) || defined(AbsoftUNIXFortran)
-#define STRING_cfFZ(UN,LN) void FCALLSC_QUALIFIER fcallsc(UN,LN)(AS
-#else
-#define STRING_cfFZ(UN,LN) void FCALLSC_QUALIFIER fcallsc(UN,LN)(AS, D0
-#endif
-#endif
-
-#define BYTE_cfF(UN,LN) BYTE_cfFZ(UN,LN)
-#define DOUBLE_cfF(UN,LN) DOUBLE_cfFZ(UN,LN)
-#ifndef __CF_KnR
-#define FLOAT_cfF(UN,LN) FORTRAN_REAL FCALLSC_QUALIFIER fcallsc(UN,LN)(
-#else
-#define FLOAT_cfF(UN,LN) FLOAT_cfFZ(UN,LN)
-#endif
-#define INT_cfF(UN,LN) INT_cfFZ(UN,LN)
-#define LOGICAL_cfF(UN,LN) LOGICAL_cfFZ(UN,LN)
-#define LONG_cfF(UN,LN) LONG_cfFZ(UN,LN)
-#define SHORT_cfF(UN,LN) SHORT_cfFZ(UN,LN)
-#define VOID_cfF(UN,LN) VOID_cfFZ(UN,LN)
-#define STRING_cfF(UN,LN) STRING_cfFZ(UN,LN),
-
-#define INT_cfFF
-#define VOID_cfFF
-#ifdef vmsFortran
-#define STRING_cfFF fstring *AS;
-#else
-#ifdef CRAYFortran
-#define STRING_cfFF _fcd AS;
-#else
-#define STRING_cfFF char *AS; unsigned D0;
-#endif
-#endif
-
-#define INT_cfL A0=
-#define STRING_cfL A0=
-#define VOID_cfL
-
-#define INT_cfK
-#define VOID_cfK
-/* KSTRING copies the string into the position provided by the caller. */
-#ifdef vmsFortran
-#define STRING_cfK \
- memcpy(AS->dsc$a_pointer,A0,_cfMIN(AS->dsc$w_length,(A0==NULL?0:strlen(A0))));\
- AS->dsc$w_length>(A0==NULL?0:strlen(A0))? \
- memset(AS->dsc$a_pointer+(A0==NULL?0:strlen(A0)),' ', \
- AS->dsc$w_length-(A0==NULL?0:strlen(A0))):0;
-#else
-#ifdef CRAYFortran
-#define STRING_cfK \
- memcpy(_fcdtocp(AS),A0, _cfMIN(_fcdlen(AS),(A0==NULL?0:strlen(A0))) ); \
- _fcdlen(AS)>(A0==NULL?0:strlen(A0))? \
- memset(_fcdtocp(AS)+(A0==NULL?0:strlen(A0)),' ', \
- _fcdlen(AS)-(A0==NULL?0:strlen(A0))):0;
-#else
-#define STRING_cfK memcpy(AS,A0, _cfMIN(D0,(A0==NULL?0:strlen(A0))) ); \
- D0>(A0==NULL?0:strlen(A0))?memset(AS+(A0==NULL?0:strlen(A0)), \
- ' ', D0-(A0==NULL?0:strlen(A0))):0;
-#endif
-#endif
-
-/* Note that K.. and I.. can't be combined since K.. has to access data before
-R.., in order for functions returning strings which are also passed in as
-arguments to work correctly. Note that R.. frees and hence may corrupt the
-string. */
-#define BYTE_cfI return A0;
-#define DOUBLE_cfI return A0;
-#if ! (defined(FLOATFUNCTIONTYPE)&&defined(ASSIGNFLOAT)&&defined(RETURNFLOAT))
-#define FLOAT_cfI return A0;
-#else
-#define FLOAT_cfI RETURNFLOAT(A0);
-#endif
-#define INT_cfI return A0;
-#ifdef hpuxFortran800
-/* Incredibly, functions must return true as 1, elsewhere .true.==0x01000000. */
-#define LOGICAL_cfI return ((A0)?1:0);
-#else
-#define LOGICAL_cfI return C2FLOGICAL(A0);
-#endif
-#define LONG_cfI return A0;
-#define SHORT_cfI return A0;
-#define STRING_cfI return ;
-#define VOID_cfI return ;
-
-#ifdef OLD_VAXC /* Allow %CC-I-PARAMNOTUSED. */
-#pragma standard
-#endif
-
-#define FCALLSCSUB0( CN,UN,LN) FCALLSCFUN0(VOID,CN,UN,LN)
-#define FCALLSCSUB1( CN,UN,LN,T1) FCALLSCFUN1(VOID,CN,UN,LN,T1)
-#define FCALLSCSUB2( CN,UN,LN,T1,T2) FCALLSCFUN2(VOID,CN,UN,LN,T1,T2)
-#define FCALLSCSUB3( CN,UN,LN,T1,T2,T3) FCALLSCFUN3(VOID,CN,UN,LN,T1,T2,T3)
-#define FCALLSCSUB4( CN,UN,LN,T1,T2,T3,T4) \
- FCALLSCFUN4(VOID,CN,UN,LN,T1,T2,T3,T4)
-#define FCALLSCSUB5( CN,UN,LN,T1,T2,T3,T4,T5) \
- FCALLSCFUN5(VOID,CN,UN,LN,T1,T2,T3,T4,T5)
-#define FCALLSCSUB6( CN,UN,LN,T1,T2,T3,T4,T5,T6) \
- FCALLSCFUN6(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6)
-#define FCALLSCSUB7( CN,UN,LN,T1,T2,T3,T4,T5,T6,T7) \
- FCALLSCFUN7(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7)
-#define FCALLSCSUB8( CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8) \
- FCALLSCFUN8(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8)
-#define FCALLSCSUB9( CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9) \
- FCALLSCFUN9(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9)
-#define FCALLSCSUB10(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA) \
- FCALLSCFUN10(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA)
-#define FCALLSCSUB11(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB) \
- FCALLSCFUN11(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB)
-#define FCALLSCSUB12(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC) \
- FCALLSCFUN12(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC)
-#define FCALLSCSUB13(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD) \
- FCALLSCFUN13(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD)
-#define FCALLSCSUB14(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \
- FCALLSCFUN14(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)
-#define FCALLSCSUB15(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF) \
- FCALLSCFUN15(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF)
-#define FCALLSCSUB16(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG) \
- FCALLSCFUN16(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG)
-#define FCALLSCSUB17(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH) \
- FCALLSCFUN17(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH)
-#define FCALLSCSUB18(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI) \
- FCALLSCFUN18(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI)
-#define FCALLSCSUB19(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ) \
- FCALLSCFUN19(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ)
-#define FCALLSCSUB20(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK) \
- FCALLSCFUN20(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK)
-#define FCALLSCSUB21(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL) \
- FCALLSCFUN21(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL)
-#define FCALLSCSUB22(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM) \
- FCALLSCFUN22(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM)
-#define FCALLSCSUB23(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN) \
- FCALLSCFUN23(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN)
-#define FCALLSCSUB24(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO) \
- FCALLSCFUN24(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO)
-#define FCALLSCSUB25(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP) \
- FCALLSCFUN25(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP)
-#define FCALLSCSUB26(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ) \
- FCALLSCFUN26(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ)
-#define FCALLSCSUB27(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) \
- FCALLSCFUN27(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR)
-
-
-#define FCALLSCFUN1( T0,CN,UN,LN,T1) \
- FCALLSCFUN5 (T0,CN,UN,LN,T1,CF_0,CF_0,CF_0,CF_0)
-#define FCALLSCFUN2( T0,CN,UN,LN,T1,T2) \
- FCALLSCFUN5 (T0,CN,UN,LN,T1,T2,CF_0,CF_0,CF_0)
-#define FCALLSCFUN3( T0,CN,UN,LN,T1,T2,T3) \
- FCALLSCFUN5 (T0,CN,UN,LN,T1,T2,T3,CF_0,CF_0)
-#define FCALLSCFUN4( T0,CN,UN,LN,T1,T2,T3,T4) \
- FCALLSCFUN5 (T0,CN,UN,LN,T1,T2,T3,T4,CF_0)
-#define FCALLSCFUN5( T0,CN,UN,LN,T1,T2,T3,T4,T5) \
- FCALLSCFUN10(T0,CN,UN,LN,T1,T2,T3,T4,T5,CF_0,CF_0,CF_0,CF_0,CF_0)
-#define FCALLSCFUN6( T0,CN,UN,LN,T1,T2,T3,T4,T5,T6) \
- FCALLSCFUN10(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,CF_0,CF_0,CF_0,CF_0)
-#define FCALLSCFUN7( T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7) \
- FCALLSCFUN10(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,CF_0,CF_0,CF_0)
-#define FCALLSCFUN8( T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8) \
- FCALLSCFUN10(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,CF_0,CF_0)
-#define FCALLSCFUN9( T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9) \
- FCALLSCFUN10(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,CF_0)
-#define FCALLSCFUN10(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA) \
- FCALLSCFUN14(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,CF_0,CF_0,CF_0,CF_0)
-#define FCALLSCFUN11(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB) \
- FCALLSCFUN14(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,CF_0,CF_0,CF_0)
-#define FCALLSCFUN12(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC) \
- FCALLSCFUN14(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,CF_0,CF_0)
-#define FCALLSCFUN13(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD) \
- FCALLSCFUN14(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,CF_0)
-
-
-#define FCALLSCFUN15(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF) \
- FCALLSCFUN20(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,CF_0,CF_0,CF_0,CF_0,CF_0)
-#define FCALLSCFUN16(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG) \
- FCALLSCFUN20(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,CF_0,CF_0,CF_0,CF_0)
-#define FCALLSCFUN17(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH) \
- FCALLSCFUN20(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,CF_0,CF_0,CF_0)
-#define FCALLSCFUN18(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI) \
- FCALLSCFUN20(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,CF_0,CF_0)
-#define FCALLSCFUN19(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ) \
- FCALLSCFUN20(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,CF_0)
-#define FCALLSCFUN20(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK) \
- FCALLSCFUN27(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0)
-#define FCALLSCFUN21(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL) \
- FCALLSCFUN27(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0)
-#define FCALLSCFUN22(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM) \
- FCALLSCFUN27(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,CF_0,CF_0,CF_0,CF_0,CF_0)
-#define FCALLSCFUN23(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN) \
- FCALLSCFUN27(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,CF_0,CF_0,CF_0,CF_0)
-#define FCALLSCFUN24(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO) \
- FCALLSCFUN27(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,CF_0,CF_0,CF_0)
-#define FCALLSCFUN25(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP) \
- FCALLSCFUN27(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,CF_0,CF_0)
-#define FCALLSCFUN26(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ) \
- FCALLSCFUN27(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,CF_0)
-
-
-#ifndef __CF__KnR
-#define FCALLSCFUN0(T0,CN,UN,LN) CFextern _(T0,_cfFZ)(UN,LN) ABSOFT_cf2(T0)) \
- {_Icf(2,UU,T0,A0,0); _Icf(0,L,T0,0,0) CN(); _Icf(0,K,T0,0,0) _(T0,_cfI)}
-
-#define FCALLSCFUN14(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \
- CFextern _(T0,_cfF)(UN,LN) \
- CFARGT14(NCF,DCF,ABSOFT_cf2(T0),T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) ) \
- { CFARGT14S(QCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \
- _Icf(2,UU,T0,A0,0); _Icf(0,L,T0,0,0) CN( TCF(LN,T1,1,0) TCF(LN,T2,2,1) \
- TCF(LN,T3,3,1) TCF(LN,T4,4,1) TCF(LN,T5,5,1) TCF(LN,T6,6,1) TCF(LN,T7,7,1) \
- TCF(LN,T8,8,1) TCF(LN,T9,9,1) TCF(LN,TA,10,1) TCF(LN,TB,11,1) TCF(LN,TC,12,1) \
- TCF(LN,TD,13,1) TCF(LN,TE,14,1) ); _Icf(0,K,T0,0,0) \
- CFARGT14S(RCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) _(T0,_cfI) }
-
-#define FCALLSCFUN27(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) \
- CFextern _(T0,_cfF)(UN,LN) \
- CFARGT27(NCF,DCF,ABSOFT_cf2(T0),T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) ) \
- { CFARGT27S(QCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) \
- _Icf(2,UU,T0,A0,0); _Icf(0,L,T0,0,0) CN( TCF(LN,T1,1,0) TCF(LN,T2,2,1) \
- TCF(LN,T3,3,1) TCF(LN,T4,4,1) TCF(LN,T5,5,1) TCF(LN,T6,6,1) TCF(LN,T7,7,1) \
- TCF(LN,T8,8,1) TCF(LN,T9,9,1) TCF(LN,TA,10,1) TCF(LN,TB,11,1) TCF(LN,TC,12,1) \
- TCF(LN,TD,13,1) TCF(LN,TE,14,1) TCF(LN,TF,15,1) TCF(LN,TG,16,1) TCF(LN,TH,17,1) \
- TCF(LN,TI,18,1) TCF(LN,TJ,19,1) TCF(LN,TK,20,1) TCF(LN,TL,21,1) TCF(LN,TM,22,1) \
- TCF(LN,TN,23,1) TCF(LN,TO,24,1) TCF(LN,TP,25,1) TCF(LN,TQ,26,1) TCF(LN,TR,27,1) ); _Icf(0,K,T0,0,0) \
- CFARGT27S(RCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) _(T0,_cfI) }
-
-#else
-#define FCALLSCFUN0(T0,CN,UN,LN) CFextern _(T0,_cfFZ)(UN,LN) ABSOFT_cf3(T0)) _Icf(0,FF,T0,0,0)\
- {_Icf(2,UU,T0,A0,0); _Icf(0,L,T0,0,0) CN(); _Icf(0,K,T0,0,0) _(T0,_cfI)}
-
-#define FCALLSCFUN14(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \
- CFextern _(T0,_cfF)(UN,LN) \
- CFARGT14(NNCF,DDCF,ABSOFT_cf3(T0),T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)) _Icf(0,FF,T0,0,0) \
- CFARGT14FS(NNNCF,DDDCF,_Z,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE); \
- { CFARGT14S(QCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \
- _Icf(2,UU,T0,A0,0); _Icf(0,L,T0,0,0) CN( TCF(LN,T1,1,0) TCF(LN,T2,2,1) \
- TCF(LN,T3,3,1) TCF(LN,T4,4,1) TCF(LN,T5,5,1) TCF(LN,T6,6,1) TCF(LN,T7,7,1) \
- TCF(LN,T8,8,1) TCF(LN,T9,9,1) TCF(LN,TA,10,1) TCF(LN,TB,11,1) TCF(LN,TC,12,1) \
- TCF(LN,TD,13,1) TCF(LN,TE,14,1) ); _Icf(0,K,T0,0,0) \
- CFARGT14S(RCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) _(T0,_cfI)}
-
-#define FCALLSCFUN27(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) \
- CFextern _(T0,_cfF)(UN,LN) \
- CFARGT27(NNCF,DDCF,ABSOFT_cf3(T0),T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR)) _Icf(0,FF,T0,0,0) \
- CFARGT27FS(NNNCF,DDDCF,_Z,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR); \
- { CFARGT27S(QCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) \
- _Icf(2,UU,T0,A0,0); _Icf(0,L,T0,0,0) CN( TCF(LN,T1,1,0) TCF(LN,T2,2,1) \
- TCF(LN,T3,3,1) TCF(LN,T4,4,1) TCF(LN,T5,5,1) TCF(LN,T6,6,1) TCF(LN,T7,7,1) \
- TCF(LN,T8,8,1) TCF(LN,T9,9,1) TCF(LN,TA,10,1) TCF(LN,TB,11,1) TCF(LN,TC,12,1) \
- TCF(LN,TD,13,1) TCF(LN,TE,14,1) TCF(LN,TF,15,1) TCF(LN,TG,16,1) TCF(LN,TH,17,1) \
- TCF(LN,TI,18,1) TCF(LN,TJ,19,1) TCF(LN,TK,20,1) TCF(LN,TL,21,1) TCF(LN,TM,22,1) \
- TCF(LN,TN,23,1) TCF(LN,TO,24,1) TCF(LN,TP,25,1) TCF(LN,TQ,26,1) TCF(LN,TR,27,1) ); _Icf(0,K,T0,0,0) \
- CFARGT27S(RCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) _(T0,_cfI)}
-
-#endif
-
-
-#endif /* __CFORTRAN_LOADED */
diff --git a/src/cfortran/comis.h b/src/cfortran/comis.h
deleted file mode 100644
index 3652732..0000000
--- a/src/cfortran/comis.h
+++ /dev/null
@@ -1,32 +0,0 @@
-PROTOCCALLSFFUN1(INT,CSADDR,csaddr,STRING)
-#define CSADDR(CHFILE) CCALLSFFUN1(CSADDR,csaddr,STRING,CHFILE)
-
-PROTOCCALLSFFUN12(DOUBLE,CSDJCL,csdjcl,INT,INT,PVOID,PVOID,PVOID,PVOID,PVOID,PVOID,PVOID,PVOID,PVOID,PVOID)
-#define CSDJCL(IADR,NPAR,P1,P2,P3,P4,P5,P6,P7,P8,P9,P10) CCALLSFFUN12(CSDJCL,csdjcl,INT,INT,PVOID,PVOID,PVOID,PVOID,PVOID,PVOID,PVOID,PVOID,PVOID,PVOID,IADR,NPAR,P1,P2,P3,P4,P5,P6,P7,P8,P9,P10)
-
-PROTOCCALLSFSUB2(CSEXEC,csexec,STRING,PINT)
-#define CSEXEC(CHFILE,IRET) CCALLSFSUB2(CSEXEC,csexec,STRING,PINT,CHFILE,IRET)
-
-PROTOCCALLSFSUB3(CSGTIDP,csgtidp,INT,PSTRING,PINT)
-#define CSGTIDP(CADR,NAME,LEN) CCALLSFSUB3(CSGTIDP,csgtidp,INT,PSTRING,PINT,CADR,NAME,LEN)
-
-PROTOCCALLSFFUN12(INT,CSIJCL,csijcl,INT,INT,PVOID,PVOID,PVOID,PVOID,PVOID,PVOID,PVOID,PVOID,PVOID,PVOID)
-#define CSIJCL(IADR,NPAR,P1,P2,P3,P4,P5,P6,P7,P8,P9,P10) CCALLSFFUN12(CSIJCL,csijcl,INT,INT,PVOID,PVOID,PVOID,PVOID,PVOID,PVOID,PVOID,PVOID,PVOID,PVOID,IADR,NPAR,P1,P2,P3,P4,P5,P6,P7,P8,P9,P10)
-
-PROTOCCALLSFFUN2(INT,CSLISTC,cslistc,INT,PINT)
-#define CSLISTC(PROADDR,NEXT) CCALLSFFUN2(CSLISTC,cslistc,INT,PINT,PROADDR,NEXT)
-
-PROTOCCALLSFSUB4(CSLISTX,cslistx,STRING,INT,PINT,PINT)
-#define CSLISTX(CNAME,PROADDR,IOFFS,NEL) CCALLSFSUB4(CSLISTX,cslistx,STRING,INT,PINT,PINT,CNAME,PROADDR,IOFFS,NEL)
-
-PROTOCCALLSFFUN12(LOGICAL,CSLJCL,csljcl,INT,INT,PVOID,PVOID,PVOID,PVOID,PVOID,PVOID,PVOID,PVOID,PVOID,PVOID)
-#define CSLJCL(IADR,NPAR,P1,P2,P3,P4,P5,P6,P7,P8,P9,P10) CCALLSFFUN12(CSLJCL,csljcl,INT,INT,PVOID,PVOID,PVOID,PVOID,PVOID,PVOID,PVOID,PVOID,PVOID,PVOID,IADR,NPAR,P1,P2,P3,P4,P5,P6,P7,P8,P9,P10)
-
-PROTOCCALLSFFUN12(FLOAT,CSRJCL,csrjcl,INT,INT,PVOID,PVOID,PVOID,PVOID,PVOID,PVOID,PVOID,PVOID,PVOID,PVOID)
-#define CSRJCL(IADR,NPAR,P1,P2,P3,P4,P5,P6,P7,P8,P9,P10) CCALLSFFUN12(CSRJCL,csrjcl,INT,INT,PVOID,PVOID,PVOID,PVOID,PVOID,PVOID,PVOID,PVOID,PVOID,PVOID,IADR,NPAR,P1,P2,P3,P4,P5,P6,P7,P8,P9,P10)
-
-PROTOCCALLSFSUB7(CSTYPAR,cstypar,INT,INT,PSTRING,PINT,PINT,INTV,PINT)
-#define CSTYPAR(IADDR,IPAR,CTYP,ISIZE,NVDIM,DIM,IERR) CCALLSFSUB7(CSTYPAR,cstypar,INT,INT,PSTRING,PINT,PINT,INTV,PINT,IADDR,IPAR,CTYP,ISIZE,NVDIM,DIM,IERR)
-
-PROTOCCALLSFSUB2(CSTYPE,cstype,INT,PSTRING)
-#define CSTYPE(CADR,CHTYPE) CCALLSFSUB2(CSTYPE,cstype,INT,PSTRING,CADR,CHTYPE)
diff --git a/src/cfortran/cspack.h b/src/cfortran/cspack.h
deleted file mode 100644
index 0e75ee5..0000000
--- a/src/cfortran/cspack.h
+++ /dev/null
@@ -1,5 +0,0 @@
-PROTOCCALLSFSUB2(CZPUTA,czputa,STRING,PINT)
-#define CZPUTA(CHMAIL,ISTAT) CCALLSFSUB2(CZPUTA,czputa,STRING,PINT,CHMAIL,ISTAT)
-
-PROTOCCALLSFSUB2(CZGETA,czgeta,PSTRING,PINT)
-#define CZGETA(CHMAIL,ISTAT) CCALLSFSUB2(CZGETA,czgeta,PSTRING,PINT,CHMAIL,ISTAT)
diff --git a/src/cfortran/geant315.h b/src/cfortran/geant315.h
deleted file mode 100644
index f66cc89..0000000
--- a/src/cfortran/geant315.h
+++ /dev/null
@@ -1,4799 +0,0 @@
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/abbrch.f
-------------------------------------------------------------------*/
-
-#define ABBRCH(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15,A16,A17,A18,A19,A20,A21,A22,A23,A24,A25,A26,A27,A28,A29,A30,A31,A32,A33,A34,A35) CCALLSFSUB35(ABBRCH,abbrch,INT,INT,PINT,INT,DOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PINT,PINT,PDOUBLE,PINT,PINT,PINT,PINT,PDOUBLE,PDOUBLE,DOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PINT,DOUBLE,DOUBLE,INT,INT,INT,INT,INT,INT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15,A16,A17,A18,A19,A20,A21,A22,A23,A24,A25,A26,A27,A28,A29,A30,A31,A32,A33,A34,A35)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/ainel.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN5(DOUBLE,AINEL,ainel,INT,INT,DOUBLE,DOUBLE,DOUBLE)
-#define AINEL(A2,A3,A4,A5,A6) CCALLSFFUN5(AINEL,ainel,INT,INT,DOUBLE,DOUBLE,DOUBLE,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/akeka.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN3(DOUBLE,AKEKA,akeka,INT,DOUBLE,DOUBLE)
-#define AKEKA(A2,A3,A4) CCALLSFFUN3(AKEKA,akeka,INT,DOUBLE,DOUBLE,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/altra.f
-------------------------------------------------------------------*/
-
-#define ALTRA(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13) CCALLSFSUB13(ALTRA,altra,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/altraf.f
-------------------------------------------------------------------*/
-
-#define ALTRAF(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15) CCALLSFSUB15(ALTRAF,altraf,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/amga.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN1(DOUBLE,AMGA,amga,INT)
-#define AMGA(A2) CCALLSFFUN1(AMGA,amga,INT,A2)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/ankeka.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN4(DOUBLE,ANKEKA,ankeka,INT,DOUBLE,DOUBLE,DOUBLE)
-#define ANKEKA(A2,A3,A4,A5) CCALLSFFUN4(ANKEKA,ankeka,INT,DOUBLE,DOUBLE,DOUBLE,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/atomas.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN2(FLOAT,ATOMAS,atomas,FLOAT,FLOAT)
-#define ATOMAS(A2,A3) CCALLSFFUN2(ATOMAS,atomas,FLOAT,FLOAT,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/bamjet.f
-------------------------------------------------------------------*/
-
-#define BAMJET(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(BAMJET,bamjet,PINT,INT,INT,INT,INT,DOUBLE,INT,A1,A2,A3,A4,A5,A6,A7)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/bamjev.f
-------------------------------------------------------------------*/
-
-#define BAMJEV(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(BAMJEV,bamjev,PINT,INT,INT,INT,INT,DOUBLE,INT,A1,A2,A3,A4,A5,A6,A7)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/bekeka.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN4(DOUBLE,BEKEKA,bekeka,INT,DOUBLE,DOUBLE,DOUBLE)
-#define BEKEKA(A2,A3,A4,A5) CCALLSFFUN4(BEKEKA,bekeka,INT,DOUBLE,DOUBLE,DOUBLE,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/berttp.f
-------------------------------------------------------------------*/
-
-#define BERTTP() CCALLSFSUB0(BERTTP,berttp)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/beta.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN3(DOUBLE,BETA,beta,DOUBLE,DOUBLE,DOUBLE)
-#define BETA(A2,A3,A4) CCALLSFFUN3(BETA,beta,DOUBLE,DOUBLE,DOUBLE,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/betarn.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN2(DOUBLE,BETARN,betarn,DOUBLE,DOUBLE)
-#define BETARN(A2,A3) CCALLSFFUN2(BETARN,betarn,DOUBLE,DOUBLE,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/betrst.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN4(DOUBLE,BETRST,betrst,DOUBLE,DOUBLE,PDOUBLE,PDOUBLE)
-#define BETRST(A2,A3,A4,A5) CCALLSFFUN4(BETRST,betrst,DOUBLE,DOUBLE,PDOUBLE,PDOUBLE,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/bkeka.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN3(DOUBLE,BKEKA,bkeka,INT,DOUBLE,DOUBLE)
-#define BKEKA(A2,A3,A4) CCALLSFFUN3(BKEKA,bkeka,INT,DOUBLE,DOUBLE,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/bklass.f
-------------------------------------------------------------------*/
-
-#define BKLASS(A1,A2,A3,A4,A5) CCALLSFSUB5(BKLASS,bklass,INT,INT,INT,PINT,PINT,A1,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/bnkeka.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN4(DOUBLE,BNKEKA,bnkeka,INT,DOUBLE,DOUBLE,DOUBLE)
-#define BNKEKA(A2,A3,A4,A5) CCALLSFFUN4(BNKEKA,bnkeka,INT,DOUBLE,DOUBLE,DOUBLE,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/calumo.f
-------------------------------------------------------------------*/
-
-#define CALUMO(A1,A2) CCALLSFSUB2(CALUMO,calumo,INT,INT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/calumv.f
-------------------------------------------------------------------*/
-
-#define CALUMV(A1,A2) CCALLSFSUB2(CALUMV,calumv,INT,INT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/captur.f
-------------------------------------------------------------------*/
-
-#define CAPTUR(A1) CCALLSFSUB1(CAPTUR,captur,PINT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/casal0.f
-------------------------------------------------------------------*/
-
-#define CASAL0(A1,A2,A3) CCALLSFSUB3(CASAL0,casal0,INT,PINT,PINT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/casaom.f
-------------------------------------------------------------------*/
-
-#define CASAOM(A1,A2,A3) CCALLSFSUB3(CASAOM,casaom,INT,INT,INT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/casasm.f
-------------------------------------------------------------------*/
-
-#define CASASM(A1,A2,A3) CCALLSFSUB3(CASASM,casasm,INT,PINT,PINT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/casasp.f
-------------------------------------------------------------------*/
-
-#define CASASP(A1,A2,A3) CCALLSFSUB3(CASASP,casasp,INT,PINT,PINT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/casax0.f
-------------------------------------------------------------------*/
-
-#define CASAX0(A1,A2,A3) CCALLSFSUB3(CASAX0,casax0,INT,INT,INT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/casaxm.f
-------------------------------------------------------------------*/
-
-#define CASAXM(A1,A2,A3) CCALLSFSUB3(CASAXM,casaxm,INT,INT,INT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/casfrg.f
-------------------------------------------------------------------*/
-
-#define CASFRG(A1,A2,A3) CCALLSFSUB3(CASFRG,casfrg,PINT,INT,INT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/cask0.f
-------------------------------------------------------------------*/
-
-#define CASK0(A1,A2,A3) CCALLSFSUB3(CASK0,cask0,INT,PINT,PINT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/cask0b.f
-------------------------------------------------------------------*/
-
-#define CASK0B(A1,A2,A3) CCALLSFSUB3(CASK0B,cask0b,INT,PINT,PINT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/caskm.f
-------------------------------------------------------------------*/
-
-#define CASKM(A1,A2,A3) CCALLSFSUB3(CASKM,caskm,INT,PINT,PINT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/caskp.f
-------------------------------------------------------------------*/
-
-#define CASKP(A1,A2,A3) CCALLSFSUB3(CASKP,caskp,INT,PINT,PINT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/casl0.f
-------------------------------------------------------------------*/
-
-#define CASL0(A1,A2,A3) CCALLSFSUB3(CASL0,casl0,INT,PINT,PINT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/casn.f
-------------------------------------------------------------------*/
-
-#define CASN(A1,A2,A3) CCALLSFSUB3(CASN,casn,INT,PINT,PINT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/casnb.f
-------------------------------------------------------------------*/
-
-#define CASNB(A1,A2,A3) CCALLSFSUB3(CASNB,casnb,INT,PINT,PINT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/casom.f
-------------------------------------------------------------------*/
-
-#define CASOM(A1,A2,A3) CCALLSFSUB3(CASOM,casom,INT,PINT,PINT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/casp.f
-------------------------------------------------------------------*/
-
-#define CASP(A1,A2,A3) CCALLSFSUB3(CASP,casp,INT,PINT,PINT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/caspb.f
-------------------------------------------------------------------*/
-
-#define CASPB(A1,A2,A3) CCALLSFSUB3(CASPB,caspb,INT,PINT,PINT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/caspim.f
-------------------------------------------------------------------*/
-
-#define CASPIM(A1,A2,A3) CCALLSFSUB3(CASPIM,caspim,INT,PINT,PINT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/caspip.f
-------------------------------------------------------------------*/
-
-#define CASPIP(A1,A2,A3) CCALLSFSUB3(CASPIP,caspip,INT,PINT,PINT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/cassm.f
-------------------------------------------------------------------*/
-
-#define CASSM(A1,A2,A3) CCALLSFSUB3(CASSM,cassm,INT,PINT,PINT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/cassp.f
-------------------------------------------------------------------*/
-
-#define CASSP(A1,A2,A3) CCALLSFSUB3(CASSP,cassp,INT,PINT,PINT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/casx0.f
-------------------------------------------------------------------*/
-
-#define CASX0(A1,A2,A3) CCALLSFSUB3(CASX0,casx0,INT,PINT,PINT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/casxm.f
-------------------------------------------------------------------*/
-
-#define CASXM(A1,A2,A3) CCALLSFSUB3(CASXM,casxm,INT,PINT,PINT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/cgaffi.f
-------------------------------------------------------------------*/
-
-#define CGAFFI(A1,A2) CCALLSFSUB2(CGAFFI,cgaffi,PFLOAT,PFLOAT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/cgbfit.f
-------------------------------------------------------------------*/
-
-#define CGBFIT(A1,A2,A3) CCALLSFSUB3(CGBFIT,cgbfit,FLOATV,FLOATV,PINT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/cgbint.f
-------------------------------------------------------------------*/
-
-#define CGBINT(A1,A2,A3,A4,A5) CCALLSFSUB5(CGBINT,cgbint,FLOATV,FLOATV,INT,PFLOAT,PINT,A1,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/cgbmmt.f
-------------------------------------------------------------------*/
-
-#define CGBMMT(A1,A2,A3) CCALLSFSUB3(CGBMMT,cgbmmt,FLOATV,FLOATV,PINT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/cgbool.f
-------------------------------------------------------------------*/
-
-#define CGBOOL(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(CGBOOL,cgbool,INT,INT,FLOATV,FLOATV,INT,PFLOAT,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/cgbox.f
-------------------------------------------------------------------*/
-
-#define CGBOX(A1,A2,A3,A4,A5) CCALLSFSUB5(CGBOX,cgbox,PFLOAT,INT,INT,INT,PFLOAT,A1,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/cgbrik.f
-------------------------------------------------------------------*/
-
-#define CGBRIK(A1,A2,A3,A4,A5) CCALLSFSUB5(CGBRIK,cgbrik,FLOAT,FLOAT,FLOAT,INT,PFLOAT,A1,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/cgbsea.f
-------------------------------------------------------------------*/
-
-#define CGBSEA(A1,A2,A3,A4) CCALLSFSUB4(CGBSEA,cgbsea,FLOATV,FLOATV,PINT,PINT,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/cgbsec.f
-------------------------------------------------------------------*/
-
-#define CGBSEC(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(CGBSEC,cgbsec,FLOATV,FLOATV,FLOATV,FLOATV,INT,PFLOAT,PINT,A1,A2,A3,A4,A5,A6,A7)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/cgbsor.f
-------------------------------------------------------------------*/
-
-#define CGBSOR(A1,A2) CCALLSFSUB2(CGBSOR,cgbsor,PINT,PFLOAT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/cgbsub.f
-------------------------------------------------------------------*/
-
-#define CGBSUB(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(CGBSUB,cgbsub,INT,FLOATV,PFLOAT,INT,PFLOAT,PINT,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/cgbtef.f
-------------------------------------------------------------------*/
-
-#define CGBTEF(A1,A2,A3,A4,A5) CCALLSFSUB5(CGBTEF,cgbtef,INT,INT,FLOATV,FLOATV,PFLOAT,A1,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/cgbtfp.f
-------------------------------------------------------------------*/
-
-#define CGBTFP(A1,A2,A3) CCALLSFSUB3(CGBTFP,cgbtfp,FLOATV,FLOATV,PFLOAT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/cgbttt.f
-------------------------------------------------------------------*/
-/*
-#define cgbttt_ELEMS_1 ZTRINGV_NUM(1)
-#define cgbttt_ELEMLEN_1 ZTRINGV_NUM(2)
-*/
-
-#define CGBTTT(A1,A2,A3,A4,A5) CCALLSFSUB5(CGBTTT,cgbttt,STRING,FLOAT,FLOAT,INT,PINT,A1,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/cgcev.f
-------------------------------------------------------------------*/
-
-#define CGCEV(A1,A2) CCALLSFSUB2(CGCEV,cgcev,INT,FLOATV,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/cgcopy.f
-------------------------------------------------------------------*/
-
-#define CGCOPY(A1,A2,A3) CCALLSFSUB3(CGCOPY,cgcopy,FLOATV,INT,PFLOAT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/cgelli.f
-------------------------------------------------------------------*/
-
-#define CGELLI(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(CGELLI,cgelli,FLOAT,FLOAT,FLOAT,INT,INT,INT,PFLOAT,A1,A2,A3,A4,A5,A6,A7)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/cgfac2.f
-------------------------------------------------------------------*/
-
-#define CGFAC2(A1,A2,A3,A4) CCALLSFSUB4(CGFAC2,cgfac2,PFLOAT,PFLOAT,PFLOAT,INT,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/cgfaco.f
-------------------------------------------------------------------*/
-
-#define CGFACO(A1,A2,A3,A4,A5) CCALLSFSUB5(CGFACO,cgfaco,PFLOAT,PFLOAT,INT,INT,FLOAT,A1,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/cgfare.f
-------------------------------------------------------------------*/
-
-#define CGFARE(A1,A2,A3,A4) CCALLSFSUB4(CGFARE,cgfare,INT,FLOATV,PINT,INT,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/cgfvis.f
-------------------------------------------------------------------*/
-
-#define CGFVIS(A1,A2,A3,A4) CCALLSFSUB4(CGFVIS,cgfvis,INT,FLOATV,PINT,INT,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/cghcre.f
-------------------------------------------------------------------*/
-
-#define CGHCRE(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(CGHCRE,cghcre,INT,INT,FLOATV,FLOATV,INT,PFLOAT,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/cghdfa.f
-------------------------------------------------------------------*/
-
-#define CGHDFA(A1,A2,A3,A4,A5) CCALLSFSUB5(CGHDFA,cghdfa,INT,PFLOAT,INTV,INTV,PFLOAT,A1,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/cghend.f
-------------------------------------------------------------------*/
-
-#define CGHEND(A1,A2,A3) CCALLSFSUB3(CGHEND,cghend,PFLOAT,PINT,PFLOAT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/cgheva.f
-------------------------------------------------------------------*/
-
-#define CGHEVA(A1,A2) CCALLSFSUB2(CGHEVA,cgheva,FLOATV,PFLOAT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/cghins.f
-------------------------------------------------------------------*/
-
-#define CGHINS(A1,A2,A3) CCALLSFSUB3(CGHINS,cghins,FLOATV,PFLOAT,INT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/cghmov.f
-------------------------------------------------------------------*/
-
-#define CGHMOV(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(CGHMOV,cghmov,PFLOAT,PFLOAT,INT,INT,PFLOAT,PINT,PINT,A1,A2,A3,A4,A5,A6,A7)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/cghpla.f
-------------------------------------------------------------------*/
-
-#define CGHPLA(A1,A2,A3) CCALLSFSUB3(CGHPLA,cghpla,INTV,PFLOAT,PFLOAT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/cghren.f
-------------------------------------------------------------------*/
-
-#define CGHREN(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(CGHREN,cghren,INT,INT,INT,INT,PFLOAT,PINT,PINT,PINT,A1,A2,A3,A4,A5,A6,A7,A8)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/cghshi.f
-------------------------------------------------------------------*/
-
-#define CGHSHI(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(CGHSHI,cghshi,INT,PINT,PINT,INTV,PINT,PINT,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/cghsiz.f
-------------------------------------------------------------------*/
-
-#define CGHSIZ(A1,A2,A3,A4,A5) CCALLSFSUB5(CGHSIZ,cghsiz,FLOATV,INT,PINT,PINT,INT,A1,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/cghtre.f
-------------------------------------------------------------------*/
-
-#define CGHTRE(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(CGHTRE,cghtre,INT,PFLOAT,PINT,PINT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/cginve.f
-------------------------------------------------------------------*/
-
-#define CGINVE(A1) CCALLSFSUB1(CGINVE,cginve,PFLOAT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/cgmnmx.f
-------------------------------------------------------------------*/
-
-#define CGMNMX(A1,A2,A3) CCALLSFSUB3(CGMNMX,cgmnmx,FLOATV,PFLOAT,PFLOAT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/cgrifl.f
-------------------------------------------------------------------*/
-
-#define CGRIFL(A1,A2) CCALLSFSUB2(CGRIFL,cgrifl,PFLOAT,PFLOAT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/cgsaan.f
-------------------------------------------------------------------*/
-
-#define CGSAAN(A1,A2,A3,A4,A5) CCALLSFSUB5(CGSAAN,cgsaan,FLOAT,FLOAT,INT,INT,PINT,A1,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/cgscop.f
-------------------------------------------------------------------*/
-
-#define CGSCOP(A1,A2,A3,A4) CCALLSFSUB4(CGSCOP,cgscop,INT,FLOATV,PFLOAT,PFLOAT,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/cgshel.f
-------------------------------------------------------------------*/
-
-#define CGSHEL(A1,A2,A3,A4) CCALLSFSUB4(CGSHEL,cgshel,FLOAT,FLOAT,PINT,PFLOAT,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/cgshif.f
-------------------------------------------------------------------*/
-
-#define CGSHIF(A1,A2,A3,A4) CCALLSFSUB4(CGSHIF,cgshif,FLOAT,FLOAT,FLOAT,FLOATV,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/cgsize.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN4(FLOAT,CGSIZE,cgsize,INT,INT,INTV,INTV)
-#define CGSIZE(A2,A3,A4,A5) CCALLSFFUN4(CGSIZE,cgsize,INT,INT,INTV,INTV,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/cgslic.f
-------------------------------------------------------------------*/
-
-#define CGSLIC(A1,A2,A3,A4) CCALLSFSUB4(CGSLIC,cgslic,FLOATV,FLOATV,INT,PFLOAT,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/cgsnor.f
-------------------------------------------------------------------*/
-
-#define CGSNOR(A1) CCALLSFSUB1(CGSNOR,cgsnor,PFLOAT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/cgsphe.f
-------------------------------------------------------------------*/
-
-#define CGSPHE(A1,A2,A3,A4,A5) CCALLSFSUB5(CGSPHE,cgsphe,FLOAT,INT,INT,INT,FLOATV,A1,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/cgsub.f
-------------------------------------------------------------------*/
-
-#define CGSUB(A1,A2,A3,A4) CCALLSFSUB4(CGSUB,cgsub,FLOATV,FLOATV,INT,FLOATV,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/cgtset.f
-------------------------------------------------------------------*/
-
-#define CGTSET(A1,A2,A3) CCALLSFSUB3(CGTSET,cgtset,INT,PFLOAT,PINT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/cgtstr.f
-------------------------------------------------------------------*/
-
-#define CGTSTR(A1,A2) CCALLSFSUB2(CGTSTR,cgtstr,FLOATV,PINT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/cgvedg.f
-------------------------------------------------------------------*/
-
-#define CGVEDG(A1,A2,A3,A4) CCALLSFSUB4(CGVEDG,cgvedg,INT,FLOATV,FLOATV,PINT,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/cgvhed.f
-------------------------------------------------------------------*/
-
-#define CGVHED(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(CGVHED,cgvhed,PFLOAT,INTV,INTV,PFLOAT,PINT,PINT,FLOATV,FLOATV,A1,A2,A3,A4,A5,A6,A7,A8)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/cgvtef.f
-------------------------------------------------------------------*/
-
-#define CGVTEF(A1,A2,A3) CCALLSFSUB3(CGVTEF,cgvtef,INTV,PFLOAT,PINT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/cgvtin.f
-------------------------------------------------------------------*/
-
-#define CGVTIN(A1,A2,A3) CCALLSFSUB3(CGVTIN,cgvtin,FLOAT,FLOAT,INT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/cgwire.f
-------------------------------------------------------------------*/
-
-#define CGWIRE(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(CGWIRE,cgwire,FLOATV,INT,INT,INT,PFLOAT,INT,INTV,A1,A2,A3,A4,A5,A6,A7)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/cgwsor.f
-------------------------------------------------------------------*/
-
-#define CGWSOR(A1,A2) CCALLSFSUB2(CGWSOR,cgwsor,PINT,PFLOAT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/cgzre.f
-------------------------------------------------------------------*/
-
-#define CGZRE(A1,A2,A3) CCALLSFSUB3(CGZRE,cgzre,INT,PFLOAT,PINT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/cgzrev.f
-------------------------------------------------------------------*/
-
-#define CGZREV(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(CGZREV,cgzrev,PFLOAT,FLOAT,FLOAT,INT,INT,PFLOAT,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/chanwt.f
-------------------------------------------------------------------*/
-
-#define CHANWT() CCALLSFSUB0(CHANWT,chanwt)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/cinema.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN1(FLOAT,CINEMA,cinema,FLOAT)
-#define CINEMA(A2) CCALLSFFUN1(CINEMA,cinema,FLOAT,A2)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/compo.f
-------------------------------------------------------------------*/
-
-#define COMPO() CCALLSFSUB0(COMPO,compo)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/coranh.f
-------------------------------------------------------------------*/
-
-#define CORANH(A1,A2) CCALLSFSUB2(CORANH,coranh,PINT,INT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/corevt.f
-------------------------------------------------------------------*/
-
-#define COREVT(A1,A2,A3,A4,A5) CCALLSFSUB5(COREVT,corevt,DOUBLE,DOUBLE,INT,DOUBLE,DOUBLE,A1,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/corrin.f
-------------------------------------------------------------------*/
-
-#define CORRIN(A1,A2,A3,A4,A5) CCALLSFSUB5(CORRIN,corrin,DOUBLE,DOUBLE,INT,DOUBLE,DOUBLE,A1,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/coscat.f
-------------------------------------------------------------------*/
-
-#define COSCAT() CCALLSFSUB0(COSCAT,coscat)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/datar3.f
-------------------------------------------------------------------*/
-
-#define DATAR3() CCALLSFSUB0(DATAR3,datar3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/datesh.f
-------------------------------------------------------------------*/
-
-#define DATESH() CCALLSFSUB0(DATESH,datesh)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/decaux.f
-------------------------------------------------------------------*/
-
-#define DECAUX(A1,A2) CCALLSFSUB2(DECAUX,decaux,INT,INT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/defs1.f
-------------------------------------------------------------------*/
-
-#define DEFS1(A1,A2,A3) CCALLSFSUB3(DEFS1,defs1,INT,INT,INT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/difevv.f
-------------------------------------------------------------------*/
-
-#define DIFEVV(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(DIFEVV,difevv,PINT,INT,INT,DOUBLE,DOUBLE,DOUBLE,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/dlpnuc.f
-------------------------------------------------------------------*/
-
-#define DLPNUC(A1,A2) CCALLSFSUB2(DLPNUC,dlpnuc,PDOUBLE,INT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/dlpsor.f
-------------------------------------------------------------------*/
-
-#define DLPSOR(A1,A2) CCALLSFSUB2(DLPSOR,dlpsor,PDOUBLE,INT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/dost.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN2(DOUBLE,DOST,dost,INT,DOUBLE)
-#define DOST(A2,A3) CCALLSFFUN2(DOST,dost,INT,DOUBLE,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/dotes2.f
-------------------------------------------------------------------*/
-
-#define DOTES2(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(DOTES2,dotes2,DOUBLE,DOUBLE,DOUBLE,DOUBLE,PDOUBLE,INT,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/dotnuc.f
-------------------------------------------------------------------*/
-
-#define DOTNUC(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(DOTNUC,dotnuc,DOUBLE,DOUBLE,DOUBLE,DOUBLE,PDOUBLE,INT,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/dpdnuc.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN3(DOUBLE,DPDNUC,dpdnuc,DOUBLE,DOUBLE,DOUBLE)
-#define DPDNUC(A2,A3,A4) CCALLSFFUN3(DPDNUC,dpdnuc,DOUBLE,DOUBLE,DOUBLE,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/drelab.f
-------------------------------------------------------------------*/
-
-#define DRELAB(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(DRELAB,drelab,PDOUBLE,PDOUBLE,PDOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,A1,A2,A3,A4,A5,A6,A7)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/dresf.f
-------------------------------------------------------------------*/
-
-#define DRESF(A1,A2,A3,A4,A5) CCALLSFSUB5(DRESF,dresf,INT,INT,DOUBLE,DOUBLE,DOUBLE,A1,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/eexi.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN3(DOUBLE,EEXI,eexi,INT,DOUBLE,DOUBLE)
-#define EEXI(A2,A3,A4) CCALLSFFUN3(EEXI,eexi,INT,DOUBLE,DOUBLE,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/ekeka.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN4(DOUBLE,EKEKA,ekeka,INT,DOUBLE,DOUBLE,DOUBLE)
-#define EKEKA(A2,A3,A4,A5) CCALLSFFUN4(EKEKA,ekeka,INT,DOUBLE,DOUBLE,DOUBLE,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/energi.f
-------------------------------------------------------------------*/
-
-#define ENERGI(A1,A2,A3,A4,A5,A6,A7,A8,A9) CCALLSFSUB9(ENERGI,energi,INT,INT,INT,INTV,PDOUBLE,PDOUBLE,PDOUBLE,DOUBLE,DOUBLE,A1,A2,A3,A4,A5,A6,A7,A8,A9)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/enrg.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN2(DOUBLE,ENRG,enrg,DOUBLE,DOUBLE)
-#define ENRG(A2,A3) CCALLSFFUN2(ENRG,enrg,DOUBLE,DOUBLE,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/evdeex.f
-------------------------------------------------------------------*/
-
-#define EVDEEX(A1) CCALLSFSUB1(EVDEEX,evdeex,DOUBLE,A1)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/eventv.f
-------------------------------------------------------------------*/
-
-#define EVENTV(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(EVENTV,eventv,INT,PDOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,INT,A1,A2,A3,A4,A5,A6,A7,A8)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/evevap.f
-------------------------------------------------------------------*/
-
-#define EVEVAP(A1) CCALLSFSUB1(EVEVAP,evevap,DOUBLE,A1)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/evvini.f
-------------------------------------------------------------------*/
-/*
-#define evvini_ELEMS_2 ZTRINGV_NUM(1)
-#define evvini_ELEMLEN_2 ZTRINGV_NUM(8)
-*/
-
-#define EVVINI(A1,A2) CCALLSFSUB2(EVVINI,evvini,DOUBLEV,STRING,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/exnu.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN1(FLOAT,EXNU,exnu,FLOAT)
-#define EXNU(A2) CCALLSFFUN1(EXNU,exnu,FLOAT,A2)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/fcount.f
-------------------------------------------------------------------*/
-
-#define FCOUNT() CCALLSFSUB0(FCOUNT,fcount)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/fctcos.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN1(FLOAT,FCTCOS,fctcos,FLOAT)
-#define FCTCOS(A2) CCALLSFFUN1(FCTCOS,fctcos,FLOAT,A2)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/fdevap.f
-------------------------------------------------------------------*/
-
-#define FDEVAP() CCALLSFSUB0(FDEVAP,fdevap)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/fdnopt.f
-------------------------------------------------------------------*/
-
-#define FDNOPT() CCALLSFSUB0(FDNOPT,fdnopt)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/ferevv.f
-------------------------------------------------------------------*/
-
-#define FEREVV(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11) CCALLSFSUB11(FEREVV,ferevv,INT,INT,INT,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,INT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/ferhad.f
-------------------------------------------------------------------*/
-
-#define FERHAD(A1,A2,A3,A4,A5,A6,A7,A8,A9) CCALLSFSUB9(FERHAD,ferhad,DOUBLE,DOUBLE,INT,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,INT,A1,A2,A3,A4,A5,A6,A7,A8,A9)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/ferhav.f
-------------------------------------------------------------------*/
-
-#define FERHAV(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(FERHAV,ferhav,INT,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/fermi.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN1(FLOAT,FERMI,fermi,FLOAT)
-#define FERMI(A2) CCALLSFFUN1(FERMI,fermi,FLOAT,A2)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/fissio.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN1(FLOAT,FISSIO,fissio,FLOAT)
-#define FISSIO(A2) CCALLSFFUN1(FISSIO,fissio,FLOAT,A2)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/fkdeca.f
-------------------------------------------------------------------*/
-
-#define FKDECA(A1,A2) CCALLSFSUB2(FKDECA,fkdeca,PINT,INT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/fkdres.f
-------------------------------------------------------------------*/
-
-#define FKDRES(A1,A2,A3,A4,A5) CCALLSFSUB5(FKDRES,fkdres,INT,INT,DOUBLE,PDOUBLE,PDOUBLE,A1,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/fkener.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN2(DOUBLE,FKENER,fkener,DOUBLE,DOUBLE)
-#define FKENER(A2,A3) CCALLSFFUN2(FKENER,fkener,DOUBLE,DOUBLE,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/fkerro.f
-------------------------------------------------------------------*/
-
-#define FKERRO() CCALLSFSUB0(FKERRO,fkerro)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/fkerup.f
-------------------------------------------------------------------*/
-
-#define FKERUP() CCALLSFSUB0(FKERUP,fkerup)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/fkflav.f
-------------------------------------------------------------------*/
-
-#define FKFLAV(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15) CCALLSFSUB15(FKFLAV,fkflav,INT,INT,INT,DOUBLE,INTV,DOUBLEV,PINT,PINT,INT,DOUBLE,INT,INT,INT,INT,INT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/fkimpu.f
-------------------------------------------------------------------*/
-
-#define FKIMPU(A1,A2,A3,A4,A5,A6,A7,A8,A9) CCALLSFSUB9(FKIMPU,fkimpu,DOUBLE,DOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,INT,INT,DOUBLE,A1,A2,A3,A4,A5,A6,A7,A8,A9)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/fkpoli.f
-------------------------------------------------------------------*/
-
-#define FKPOLI(A1,A2) CCALLSFSUB2(FKPOLI,fkpoli,PDOUBLE,PDOUBLE,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/fksigi.f
-------------------------------------------------------------------*/
-
-#define FKSIGI(A1,A2,A3,A4,A5,A6,A7,A8,A9) CCALLSFSUB9(FKSIGI,fksigi,INT,DOUBLE,INT,PINT,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,INT,A1,A2,A3,A4,A5,A6,A7,A8,A9)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/fkvert.f
-------------------------------------------------------------------*/
-
-#define FKVERT(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11) CCALLSFSUB11(FKVERT,fkvert,INT,INT,INT,INT,DOUBLE,PINT,DOUBLEV,INTV,INTV,DOUBLE,INT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/fkzero.f
-------------------------------------------------------------------*/
-
-#define FKZERO() CCALLSFSUB0(FKZERO,fkzero)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/fldist.f
-------------------------------------------------------------------*/
-
-#define FLDIST() CCALLSFSUB0(FLDIST,fldist)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/flinit.f
-------------------------------------------------------------------*/
-
-#define FLINIT() CCALLSFSUB0(FLINIT,flinit)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/flkdt1.f
-------------------------------------------------------------------*/
-
-#define FLKDT1() CCALLSFSUB0(FLKDT1,flkdt1)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/flkdt2.f
-------------------------------------------------------------------*/
-
-#define FLKDT2() CCALLSFSUB0(FLKDT2,flkdt2)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/flkdt3.f
-------------------------------------------------------------------*/
-
-#define FLKDT3() CCALLSFSUB0(FLKDT3,flkdt3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/flkdt4.f
-------------------------------------------------------------------*/
-
-#define FLKDT4() CCALLSFSUB0(FLKDT4,flkdt4)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/flkdt5.f
-------------------------------------------------------------------*/
-
-#define FLKDT5() CCALLSFSUB0(FLKDT5,flkdt5)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/flkdt6.f
-------------------------------------------------------------------*/
-
-#define FLKDT6() CCALLSFSUB0(FLKDT6,flkdt6)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/flkdt7.f
-------------------------------------------------------------------*/
-
-#define FLKDT7() CCALLSFSUB0(FLKDT7,flkdt7)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/flufin.f
-------------------------------------------------------------------*/
-
-#define FLUFIN() CCALLSFSUB0(FLUFIN,flufin)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/frmic.f
-------------------------------------------------------------------*/
-
-#define FRMIC(A1) CCALLSFSUB1(FRMIC,frmic,PDOUBLE,A1)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gamrn.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN2(DOUBLE,GAMRN,gamrn,DOUBLE,DOUBLE)
-#define GAMRN(A2,A3) CCALLSFFUN2(GAMRN,gamrn,DOUBLE,DOUBLE,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/ganni.f
-------------------------------------------------------------------*/
-
-#define GANNI() CCALLSFSUB0(GANNI,ganni)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/ganni2.f
-------------------------------------------------------------------*/
-
-#define GANNI2() CCALLSFSUB0(GANNI2,ganni2)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gannii.f
-------------------------------------------------------------------*/
-
-#define GANNII() CCALLSFSUB0(GANNII,gannii)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gannir.f
-------------------------------------------------------------------*/
-
-#define GANNIR() CCALLSFSUB0(GANNIR,gannir)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/garndm.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN1(FLOAT,GARNDM,garndm,FLOAT)
-#define GARNDM(A2) CCALLSFFUN1(GARNDM,garndm,FLOAT,A2)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gbhsta.f
-------------------------------------------------------------------*/
-
-#define GBHSTA() CCALLSFSUB0(GBHSTA,gbhsta)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gbirk.f
-------------------------------------------------------------------*/
-
-#define GBIRK(A1) CCALLSFSUB1(GBIRK,gbirk,PFLOAT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gbrela.f
-------------------------------------------------------------------*/
-
-#define GBRELA() CCALLSFSUB0(GBRELA,gbrela)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gbrele.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN3(FLOAT,GBRELE,gbrele,FLOAT,FLOAT,FLOAT)
-#define GBRELE(A2,A3,A4) CCALLSFFUN3(GBRELE,gbrele,FLOAT,FLOAT,FLOAT,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gbrelm.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN3(FLOAT,GBRELM,gbrelm,FLOAT,FLOAT,FLOAT)
-#define GBRELM(A2,A3,A4) CCALLSFFUN3(GBRELM,gbrelm,FLOAT,FLOAT,FLOAT,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gbreme.f
-------------------------------------------------------------------*/
-
-#define GBREME() CCALLSFSUB0(GBREME,gbreme)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gbremm.f
-------------------------------------------------------------------*/
-
-#define GBREMM() CCALLSFSUB0(GBREMM,gbremm)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gbrsga.f
-------------------------------------------------------------------*/
-
-#define GBRSGA() CCALLSFSUB0(GBRSGA,gbrsga)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gbrsge.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN3(FLOAT,GBRSGE,gbrsge,FLOAT,FLOAT,FLOAT)
-#define GBRSGE(A2,A3,A4) CCALLSFFUN3(GBRSGE,gbrsge,FLOAT,FLOAT,FLOAT,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gbrsgm.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN3(FLOAT,GBRSGM,gbrsgm,FLOAT,FLOAT,FLOAT)
-#define GBRSGM(A2,A3,A4) CCALLSFFUN3(GBRSGM,gbrsgm,FLOAT,FLOAT,FLOAT,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gbstat.f
-------------------------------------------------------------------*/
-
-#define GBSTAT() CCALLSFSUB0(GBSTAT,gbstat)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gcderr.f
-------------------------------------------------------------------*/
-
-#define GCDERR(A1,A2,A3) CCALLSFSUB3(GCDERR,gcderr,PINT,FLOAT,FLOAT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gcdrif.f
-------------------------------------------------------------------*/
-
-#define GCDRIF(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(GCDRIF,gcdrif,FLOAT,FLOAT,FLOAT,FLOATV,FLOATV,PINT,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gcent.f
-------------------------------------------------------------------*/
-
-#define GCENT(A1,A2) CCALLSFSUB2(GCENT,gcent,INT,PFLOAT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gclose.f
-------------------------------------------------------------------*/
-
-#define GCLOSE(A1,A2) CCALLSFSUB2(GCLOSE,gclose,INT,PINT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gcmwpc.f
-------------------------------------------------------------------*/
-
-#define GCMWPC(A1,A2,A3) CCALLSFSUB3(GCMWPC,gcmwpc,FLOATV,FLOATV,PINT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gcoeff.f
-------------------------------------------------------------------*/
-
-#define GCOEFF() CCALLSFSUB0(GCOEFF,gcoeff)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gcomp.f
-------------------------------------------------------------------*/
-
-#define GCOMP() CCALLSFSUB0(GCOMP,gcomp)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gcompi.f
-------------------------------------------------------------------*/
-
-#define GCOMPI() CCALLSFSUB0(GCOMPI,gcompi)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gcubs.f
-------------------------------------------------------------------*/
-
-#define GCUBS(A1,A2,A3,A4,A5) CCALLSFSUB5(GCUBS,gcubs,FLOAT,FLOAT,FLOAT,FLOAT,PFLOAT,A1,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gd16v.f
-------------------------------------------------------------------*/
-
-#define GD16V(A1,A2) CCALLSFSUB2(GD16V,gd16v,INT,INTV,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gd3d3d.f
-------------------------------------------------------------------*/
-
-#define GD3D3D(A1,A2,A3,A4) CCALLSFSUB4(GD3D3D,gd3d3d,PFLOAT,INT,PFLOAT,INT,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gdahit.f
-------------------------------------------------------------------*/
-
-#define GDAHIT(A1,A2,A3,A4,A5) CCALLSFSUB5(GDAHIT,gdahit,FLOAT,FLOAT,FLOAT,INT,FLOAT,A1,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gdarc.f
-------------------------------------------------------------------*/
-
-#define GDARC(A1,A2,A3,A4) CCALLSFSUB4(GDARC,gdarc,FLOAT,FLOAT,FLOAT,FLOAT,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gdarr.f
-------------------------------------------------------------------*/
-/*
-#define gdarr_ELEMS_6 ZTRINGV_NUM(1)
-#define gdarr_ELEMLEN_6 ZTRINGV_NUM(255)
-*/
-
-#define GDARR(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(GDARR,gdarr,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,STRING,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gdaxis.f
-------------------------------------------------------------------*/
-
-#define GDAXIS(A1,A2,A3,A4) CCALLSFSUB4(GDAXIS,gdaxis,FLOAT,FLOAT,FLOAT,FLOAT,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gdbomb.f
-------------------------------------------------------------------*/
-
-#define GDBOMB(A1,A2) CCALLSFSUB2(GDBOMB,gdbomb,INT,INT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gdcgcl.f
-------------------------------------------------------------------*/
-
-#define GDCGCL(A1) CCALLSFSUB1(GDCGCL,gdcgcl,INT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gdcgem.f
-------------------------------------------------------------------*/
-
-#define GDCGEM(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11) CCALLSFSUB11(GDCGEM,gdcgem,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,PINT,PFLOAT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gdcger.f
-------------------------------------------------------------------*/
-
-#define GDCGER(A1) CCALLSFSUB1(GDCGER,gdcger,FLOAT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gdcghi.f
-------------------------------------------------------------------*/
-
-#define GDCGHI(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(GDCGHI,gdcghi,INT,INT,INT,INT,INT,INT,INT,A1,A2,A3,A4,A5,A6,A7)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gdcgob.f
-------------------------------------------------------------------*/
-
-#define GDCGOB(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(GDCGOB,gdcgob,INT,PINT,FLOATV,INT,INT,INT,INT,A1,A2,A3,A4,A5,A6,A7)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gdcgpr.f
-------------------------------------------------------------------*/
-
-#define GDCGPR() CCALLSFSUB0(GDCGPR,gdcgpr)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gdcgrs.f
-------------------------------------------------------------------*/
-
-#define GDCGRS() CCALLSFSUB0(GDCGRS,gdcgrs)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gdcgsl.f
-------------------------------------------------------------------*/
-
-#define GDCGSL(A1,A2) CCALLSFSUB2(GDCGSL,gdcgsl,INT,INT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gdcgvw.f
-------------------------------------------------------------------*/
-
-#define GDCGVW(A1,A2) CCALLSFSUB2(GDCGVW,gdcgvw,FLOATV,PFLOAT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gdcgwv.f
-------------------------------------------------------------------*/
-
-#define GDCGWV(A1) CCALLSFSUB1(GDCGWV,gdcgwv,INT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gdchit.f
-------------------------------------------------------------------*/
-/*
-#define gdchit_ELEMS_1 ZTRINGV_NUM(1)
-#define gdchit_ELEMLEN_1 ZTRINGV_NUM(4)
-#define gdchit_ELEMS_2 ZTRINGV_NUM(1)
-#define gdchit_ELEMLEN_2 ZTRINGV_NUM(4)
-*/
-
-#define GDCHIT(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(GDCHIT,gdchit,STRING,STRING,INT,INT,FLOAT,INT,FLOAT,FLOAT,A1,A2,A3,A4,A5,A6,A7,A8)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gdcirc.f
-------------------------------------------------------------------*/
-
-#define GDCIRC(A1,A2) CCALLSFSUB2(GDCIRC,gdcirc,FLOAT,FLOAT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gdcirr.f
-------------------------------------------------------------------*/
-
-#define GDCIRR(A1,A2) CCALLSFSUB2(GDCIRR,gdcirr,FLOAT,FLOAT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gdciry.f
-------------------------------------------------------------------*/
-
-#define GDCIRY(A1,A2) CCALLSFSUB2(GDCIRY,gdciry,FLOAT,FLOAT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gdclos.f
-------------------------------------------------------------------*/
-
-#define GDCLOS() CCALLSFSUB0(GDCLOS,gdclos)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gdcol.f
-------------------------------------------------------------------*/
-
-#define GDCOL(A1) CCALLSFSUB1(GDCOL,gdcol,INT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gdcol1.f
-------------------------------------------------------------------*/
-
-#define GDCOL1(A1) CCALLSFSUB1(GDCOL1,gdcol1,INT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gdcota.f
-------------------------------------------------------------------*/
-
-#define GDCOTA() CCALLSFSUB0(GDCOTA,gdcota)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gdcurs.f
-------------------------------------------------------------------*/
-
-#define GDCURS(A1,A2,A3) CCALLSFSUB3(GDCURS,gdcurs,FLOAT,FLOAT,PINT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gdcut.f
-------------------------------------------------------------------*/
-
-#define GDCUT() CCALLSFSUB0(GDCUT,gdcut)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gdcxyz.f
-------------------------------------------------------------------*/
-
-#define GDCXYZ() CCALLSFSUB0(GDCXYZ,gdcxyz)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gdebug.f
-------------------------------------------------------------------*/
-
-#define GDEBUG() CCALLSFSUB0(GDEBUG,gdebug)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gdeca2.f
-------------------------------------------------------------------*/
-
-#define GDECA2(A1,A2,A3,A4) CCALLSFSUB4(GDECA2,gdeca2,FLOAT,FLOAT,FLOAT,PFLOAT,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gdeca3.f
-------------------------------------------------------------------*/
-
-#define GDECA3(A1,A2,A3,A4,A5) CCALLSFSUB5(GDECA3,gdeca3,FLOAT,FLOAT,FLOAT,FLOAT,PFLOAT,A1,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gdecay.f
-------------------------------------------------------------------*/
-
-#define GDECAY() CCALLSFSUB0(GDECAY,gdecay)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gdelet.f
-------------------------------------------------------------------*/
-
-#define GDELET(A1) CCALLSFSUB1(GDELET,gdelet,INT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gdeltu.f
-------------------------------------------------------------------*/
-
-#define GDELTU(A1,A2,A3) CCALLSFSUB3(GDELTU,gdeltu,FLOAT,FLOAT,FLOAT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gdfr3d.f
-------------------------------------------------------------------*/
-
-#define GDFR3D(A1,A2,A3,A4) CCALLSFSUB4(GDFR3D,gdfr3d,PFLOAT,INT,PFLOAT,PFLOAT,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gdfspc.f
-------------------------------------------------------------------*/
-/*
-#define gdfspc_ELEMS_1 ZTRINGV_NUM(1)
-#define gdfspc_ELEMLEN_1 ZTRINGV_NUM(4)
-*/
-
-#define GDFSPC(A1,A2,A3) CCALLSFSUB3(GDFSPC,gdfspc,STRING,INT,INT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gdgirl.f
-------------------------------------------------------------------*/
-
-#define GDGIRL(A1,A2) CCALLSFSUB2(GDGIRL,gdgirl,FLOAT,FLOAT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gdhead.f
-------------------------------------------------------------------*/
-/*
-#define gdhead_ELEMS_2 ZTRINGV_NUM(1)
-#define gdhead_ELEMLEN_2 ZTRINGV_NUM(255)
-*/
-
-#define GDHEAD(A1,A2,A3) CCALLSFSUB3(GDHEAD,gdhead,INT,STRING,FLOAT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gdhits.f
-------------------------------------------------------------------*/
-/*
-#define gdhits_ELEMS_1 ZTRINGV_NUM(1)
-#define gdhits_ELEMLEN_1 ZTRINGV_NUM(4)
-#define gdhits_ELEMS_2 ZTRINGV_NUM(1)
-#define gdhits_ELEMLEN_2 ZTRINGV_NUM(4)
-*/
-
-#define GDHITS(A1,A2,A3,A4,A5) CCALLSFSUB5(GDHITS,gdhits,STRING,STRING,INT,INT,FLOAT,A1,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gdinit.f
-------------------------------------------------------------------*/
-
-#define GDINIT() CCALLSFSUB0(GDINIT,gdinit)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gdlcyl.f
-------------------------------------------------------------------*/
-
-#define GDLCYL(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(GDLCYL,gdlcyl,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gdlens.f
-------------------------------------------------------------------*/
-/*
-#define gdlens_ELEMS_2 ZTRINGV_NUM(1)
-#define gdlens_ELEMLEN_2 ZTRINGV_NUM(4)
-*/
-
-#define GDLENS(A1,A2) CCALLSFSUB2(GDLENS,gdlens,INT,STRING,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gdline.f
-------------------------------------------------------------------*/
-
-#define GDLINE(A1,A2) CCALLSFSUB2(GDLINE,gdline,FLOATV,FLOATV,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gdlw.f
-------------------------------------------------------------------*/
-
-#define GDLW(A1) CCALLSFSUB1(GDLW,gdlw,INT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gdlw1.f
-------------------------------------------------------------------*/
-
-#define GDLW1(A1) CCALLSFSUB1(GDLW1,gdlw1,INT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gdman.f
-------------------------------------------------------------------*/
-
-#define GDMAN(A1,A2) CCALLSFSUB2(GDMAN,gdman,FLOAT,FLOAT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gdnson.f
-------------------------------------------------------------------*/
-/*
-#define gdnson_ELEMS_1 ZTRINGV_NUM(1)
-#define gdnson_ELEMLEN_1 ZTRINGV_NUM(4)
-*/
-
-#define GDNSON(A1,A2,A3) CCALLSFSUB3(GDNSON,gdnson,STRING,PINT,PINT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gdopen.f
-------------------------------------------------------------------*/
-
-#define GDOPEN(A1) CCALLSFSUB1(GDOPEN,gdopen,INT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gdopt.f
-------------------------------------------------------------------*/
-/*
-#define gdopt_ELEMS_1 ZTRINGV_NUM(1)
-#define gdopt_ELEMLEN_1 ZTRINGV_NUM(4)
-#define gdopt_ELEMS_2 ZTRINGV_NUM(1)
-#define gdopt_ELEMLEN_2 ZTRINGV_NUM(4)
-*/
-
-#define GDOPT(A1,A2) CCALLSFSUB2(GDOPT,gdopt,STRING,STRING,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gdpart.f
-------------------------------------------------------------------*/
-
-#define GDPART(A1,A2,A3) CCALLSFSUB3(GDPART,gdpart,INT,INT,FLOAT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gdpdk.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN3(DOUBLE,GDPDK,gdpdk,DOUBLE,DOUBLE,DOUBLE)
-#define GDPDK(A2,A3,A4) CCALLSFFUN3(GDPDK,gdpdk,DOUBLE,DOUBLE,DOUBLE,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gdplst.f
-------------------------------------------------------------------*/
-/*
-#define gdplst_ELEMS_2 ZTRINGV_NUM(1)
-#define gdplst_ELEMLEN_2 ZTRINGV_NUM(4)
-*/
-
-#define GDPLST(A1,A2,A3,A4) CCALLSFSUB4(GDPLST,gdplst,INT,PSTRING,INT,INT,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gdprtr.f
-------------------------------------------------------------------*/
-/*
-#define gdprtr_ELEMS_1 ZTRINGV_NUM(1)
-#define gdprtr_ELEMLEN_1 ZTRINGV_NUM(4)
-*/
-
-#define GDPRTR(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10) CCALLSFSUB10(GDPRTR,gdprtr,STRING,FLOAT,FLOAT,FLOAT,FLOAT,INT,INT,INT,INT,PINT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gdraw.f
-------------------------------------------------------------------*/
-/*
-#define gdraw_ELEMS_1 ZTRINGV_NUM(1)
-#define gdraw_ELEMLEN_1 ZTRINGV_NUM(4)
-*/
-
-#define GDRAW(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(GDRAW,gdraw,STRING,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,A1,A2,A3,A4,A5,A6,A7,A8)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gdrawc.f
-------------------------------------------------------------------*/
-/*
-#define gdrawc_ELEMS_1 ZTRINGV_NUM(1)
-#define gdrawc_ELEMLEN_1 ZTRINGV_NUM(4)
-*/
-
-#define GDRAWC(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(GDRAWC,gdrawc,STRING,INT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,A1,A2,A3,A4,A5,A6,A7)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gdrawp.f
-------------------------------------------------------------------*/
-
-#define GDRAWP(A1,A2,A3) CCALLSFSUB3(GDRAWP,gdrawp,FLOATV,FLOATV,INT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gdraws.f
-------------------------------------------------------------------*/
-
-#define GDRAWS(A1,A2) CCALLSFSUB2(GDRAWS,gdraws,INT,PFLOAT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gdrawt.f
-------------------------------------------------------------------*/
-/*
-#define gdrawt_ELEMS_3 ZTRINGV_NUM(1)
-#define gdrawt_ELEMLEN_3 ZTRINGV_NUM(255)
-*/
-
-#define GDRAWT(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(GDRAWT,gdrawt,FLOAT,FLOAT,STRING,FLOAT,FLOAT,INT,INT,A1,A2,A3,A4,A5,A6,A7)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gdrawv.f
-------------------------------------------------------------------*/
-
-#define GDRAWV(A1,A2,A3) CCALLSFSUB3(GDRAWV,gdrawv,FLOATV,FLOATV,INT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gdrawx.f
-------------------------------------------------------------------*/
-/*
-#define gdrawx_ELEMS_1 ZTRINGV_NUM(1)
-#define gdrawx_ELEMLEN_1 ZTRINGV_NUM(4)
-*/
-
-#define GDRAWX(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10) CCALLSFSUB10(GDRAWX,gdrawx,STRING,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gdray.f
-------------------------------------------------------------------*/
-
-#define GDRAY() CCALLSFSUB0(GDRAY,gdray)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gdrcut.f
-------------------------------------------------------------------*/
-
-#define GDRCUT(A1,A2,A3,A4) CCALLSFSUB4(GDRCUT,gdrcut,INT,FLOAT,PINT,PFLOAT,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gdrect.f
-------------------------------------------------------------------*/
-
-#define GDRECT(A1,A2,A3,A4) CCALLSFSUB4(GDRECT,gdrect,FLOATV,FLOATV,FLOATV,FLOATV,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gdrela.f
-------------------------------------------------------------------*/
-
-#define GDRELA() CCALLSFSUB0(GDRELA,gdrela)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gdrele.f
-------------------------------------------------------------------*/
-
-#define GDRELE(A1,A2,A3,A4) CCALLSFSUB4(GDRELE,gdrele,FLOAT,FLOAT,INT,PFLOAT,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gdrelm.f
-------------------------------------------------------------------*/
-
-#define GDRELM(A1,A2,A3,A4,A5) CCALLSFSUB5(GDRELM,gdrelm,FLOAT,FLOAT,FLOAT,FLOAT,PFLOAT,A1,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gdrelp.f
-------------------------------------------------------------------*/
-
-#define GDRELP(A1,A2,A3,A4,A5) CCALLSFSUB5(GDRELP,gdrelp,FLOAT,FLOAT,FLOAT,FLOAT,PFLOAT,A1,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gdrot.f
-------------------------------------------------------------------*/
-
-#define GDROT(A1,A2,A3,A4,A5) CCALLSFSUB5(GDROT,gdrot,PFLOAT,FLOAT,FLOAT,FLOAT,FLOAT,A1,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gdrprt.f
-------------------------------------------------------------------*/
-
-#define GDRPRT(A1,A2,A3) CCALLSFSUB3(GDRPRT,gdrprt,INT,INT,FLOAT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gdrsga.f
-------------------------------------------------------------------*/
-
-#define GDRSGA() CCALLSFSUB0(GDRSGA,gdrsga)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gdrvol.f
-------------------------------------------------------------------*/
-
-#define GDRVOL(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11) CCALLSFSUB11(GDRVOL,gdrvol,INT,INTV,INTV,INT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gdrwsc.f
-------------------------------------------------------------------*/
-
-#define GDRWSC(A1,A2) CCALLSFSUB2(GDRWSC,gdrwsc,INT,PFLOAT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gdsarc.f
-------------------------------------------------------------------*/
-
-#define GDSARC(A1,A2,A3,A4,A5) CCALLSFSUB5(GDSARC,gdsarc,FLOAT,FLOAT,FLOAT,PFLOAT,PINT,A1,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gdscal.f
-------------------------------------------------------------------*/
-
-#define GDSCAL(A1,A2) CCALLSFSUB2(GDSCAL,gdscal,FLOAT,FLOAT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gdshad.f
-------------------------------------------------------------------*/
-
-#define GDSHAD(A1,A2) CCALLSFSUB2(GDSHAD,gdshad,PINT,FLOAT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gdshif.f
-------------------------------------------------------------------*/
-
-#define GDSHIF(A1,A2) CCALLSFSUB2(GDSHIF,gdshif,INT,INT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gdshow.f
-------------------------------------------------------------------*/
-
-#define GDSHOW(A1) CCALLSFSUB1(GDSHOW,gdshow,INT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gdson.f
-------------------------------------------------------------------*/
-/*
-#define gdson_ELEMS_2 ZTRINGV_NUM(1)
-#define gdson_ELEMLEN_2 ZTRINGV_NUM(4)
-#define gdson_ELEMS_3 ZTRINGV_NUM(1)
-#define gdson_ELEMLEN_3 ZTRINGV_NUM(4)
-*/
-
-#define GDSON(A1,A2,A3) CCALLSFSUB3(GDSON,gdson,INT,STRING,PSTRING,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gdspec.f
-------------------------------------------------------------------*/
-/*
-#define gdspec_ELEMS_1 ZTRINGV_NUM(1)
-#define gdspec_ELEMLEN_1 ZTRINGV_NUM(4)
-*/
-
-#define GDSPEC(A1) CCALLSFSUB1(GDSPEC,gdspec,STRING,A1)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gdssur.f
-------------------------------------------------------------------*/
-
-#define GDSSUR(A1,A2,A3,A4) CCALLSFSUB4(GDSSUR,gdssur,FLOATV,FLOATV,FLOATV,FLOATV,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gdsurf.f
-------------------------------------------------------------------*/
-
-#define GDSURF(A1) CCALLSFSUB1(GDSURF,gdsurf,INT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gdthrz.f
-------------------------------------------------------------------*/
-
-#define GDTHRZ(A1) CCALLSFSUB1(GDTHRZ,gdthrz,PFLOAT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gdtom.f
-------------------------------------------------------------------*/
-
-#define GDTOM(A1,A2,A3) CCALLSFSUB3(GDTOM,gdtom,FLOATV,PFLOAT,INT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gdtr0.f
-------------------------------------------------------------------*/
-
-#define GDTR0(A1,A2,A3,A4) CCALLSFSUB4(GDTR0,gdtr0,INT,INT,INT,INT,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gdtr1.f
-------------------------------------------------------------------*/
-
-#define GDTR1(A1,A2,A3,A4) CCALLSFSUB4(GDTR1,gdtr1,INT,INT,PINT,PINT,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gdtr10.f
-------------------------------------------------------------------*/
-
-#define GDTR10(A1) CCALLSFSUB1(GDTR10,gdtr10,INT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gdtr11.f
-------------------------------------------------------------------*/
-
-#define GDTR11(A1,A2,A3) CCALLSFSUB3(GDTR11,gdtr11,PINT,PINT,INT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gdtr12.f
-------------------------------------------------------------------*/
-
-#define GDTR12(A1) CCALLSFSUB1(GDTR12,gdtr12,INT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gdtr2.f
-------------------------------------------------------------------*/
-
-#define GDTR2(A1,A2,A3,A4) CCALLSFSUB4(GDTR2,gdtr2,INT,PINT,INT,PINT,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gdtr3.f
-------------------------------------------------------------------*/
-
-#define GDTR3(A1) CCALLSFSUB1(GDTR3,gdtr3,INT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gdtr4.f
-------------------------------------------------------------------*/
-
-#define GDTR4() CCALLSFSUB0(GDTR4,gdtr4)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gdtr5.f
-------------------------------------------------------------------*/
-
-#define GDTR5(A1) CCALLSFSUB1(GDTR5,gdtr5,INT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gdtr6.f
-------------------------------------------------------------------*/
-
-#define GDTR6(A1) CCALLSFSUB1(GDTR6,gdtr6,PINT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gdtr8.f
-------------------------------------------------------------------*/
-/*
-#define gdtr8_ELEMS_1 ZTRINGV_NUM(1)
-#define gdtr8_ELEMLEN_1 ZTRINGV_NUM(4)
-#define gdtr8_ELEMS_2 ZTRINGV_NUM(1)
-#define gdtr8_ELEMLEN_2 ZTRINGV_NUM(4)
-*/
-
-#define GDTR8(A1,A2,A3) CCALLSFSUB3(GDTR8,gdtr8,STRING,STRING,PINT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gdtr99.f
-------------------------------------------------------------------*/
-
-#define GDTR99(A1) CCALLSFSUB1(GDTR99,gdtr99,INT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gdtrak.f
-------------------------------------------------------------------*/
-/*
-#define gdtrak_ELEMS_1 ZTRINGV_NUM(1)
-#define gdtrak_ELEMLEN_1 ZTRINGV_NUM(255)
-*/
-
-#define GDTRAK(A1) CCALLSFSUB1(GDTRAK,gdtrak,STRING,A1)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gdtree.f
-------------------------------------------------------------------*/
-/*
-#define gdtree_ELEMS_1 ZTRINGV_NUM(1)
-#define gdtree_ELEMLEN_1 ZTRINGV_NUM(4)
-*/
-
-#define GDTREE(A1,A2,A3) CCALLSFSUB3(GDTREE,gdtree,PSTRING,INT,INT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gdxyz.f
-------------------------------------------------------------------*/
-
-#define GDXYZ(A1) CCALLSFSUB1(GDXYZ,gdxyz,INT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gdxzoo.f
-------------------------------------------------------------------*/
-
-#define GDXZOO(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(GDXZOO,gdxzoo,INT,FLOAT,FLOAT,PFLOAT,PFLOAT,FLOAT,FLOAT,A1,A2,A3,A4,A5,A6,A7)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gdzoom.f
-------------------------------------------------------------------*/
-
-#define GDZOOM(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(GDZOOM,gdzoom,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/geamon.f
-------------------------------------------------------------------*/
-/*
-#define geamon_ELEMS_2 ZTRINGV_NUM(1)
-#define geamon_ELEMLEN_2 ZTRINGV_NUM(255)
-*/
-
-#define GEAMON(A1,A2) CCALLSFSUB2(GEAMON,geamon,INT,STRING,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/geditv.f
-------------------------------------------------------------------*/
-
-#define GEDITV(A1) CCALLSFSUB1(GEDITV,geditv,INT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gekbin.f
-------------------------------------------------------------------*/
-
-#define GEKBIN() CCALLSFSUB0(GEKBIN,gekbin)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/genxpt.f
-------------------------------------------------------------------*/
-
-#define GENXPT(A1,A2,A3) CCALLSFSUB3(GENXPT,genxpt,INT,INT,FLOAT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/getnum.f
-------------------------------------------------------------------*/
-
-#define GETNUM(A1,A2) CCALLSFSUB2(GETNUM,getnum,INTV,PINT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/getver.f
-------------------------------------------------------------------*/
-/*
-#define getver_ELEMS_1 ZTRINGV_NUM(1)
-#define getver_ELEMLEN_1 ZTRINGV_NUM(8)
-*/
-
-#define GETVER(A1,A2) CCALLSFSUB2(GETVER,getver,PSTRING,PFLOAT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gevkev.f
-------------------------------------------------------------------*/
-/*
-#define gevkev_ELEMS_3 ZTRINGV_NUM(1)
-#define gevkev_ELEMLEN_3 ZTRINGV_NUM(4)
-*/
-
-#define GEVKEV(A1,A2,A3) CCALLSFSUB3(GEVKEV,gevkev,FLOAT,PFLOAT,PSTRING,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gfatt.f
-------------------------------------------------------------------*/
-/*
-#define gfatt_ELEMS_1 ZTRINGV_NUM(1)
-#define gfatt_ELEMLEN_1 ZTRINGV_NUM(4)
-#define gfatt_ELEMS_2 ZTRINGV_NUM(1)
-#define gfatt_ELEMLEN_2 ZTRINGV_NUM(4)
-*/
-
-#define GFATT(A1,A2,A3) CCALLSFSUB3(GFATT,gfatt,STRING,STRING,PINT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gfclim.f
-------------------------------------------------------------------*/
-
-#define GFCLIM(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(GFCLIM,gfclim,INT,INT,INT,PFLOAT,PFLOAT,INT,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gfcoor.f
-------------------------------------------------------------------*/
-
-#define GFCOOR(A1,A2,A3) CCALLSFSUB3(GFCOOR,gfcoor,FLOATV,INT,PFLOAT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gfcord.f
-------------------------------------------------------------------*/
-
-#define GFCORD(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(GFCORD,gfcord,INT,FLOATV,FLOATV,PFLOAT,PINT,PINT,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gfcoul.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN1(FLOAT,GFCOUL,gfcoul,FLOAT)
-#define GFCOUL(A2) CCALLSFFUN1(GFCOUL,gfcoul,FLOAT,A2)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gfcvol.f
-------------------------------------------------------------------*/
-
-#define GFCVOL() CCALLSFSUB0(GFCVOL,gfcvol)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gfdet.f
-------------------------------------------------------------------*/
-/*
-#define gfdet_ELEMS_1 ZTRINGV_NUM(1)
-#define gfdet_ELEMLEN_1 ZTRINGV_NUM(4)
-#define gfdet_ELEMS_2 ZTRINGV_NUM(1)
-#define gfdet_ELEMLEN_2 ZTRINGV_NUM(4)
-#define gfdet_ELEMS_4 ZTRINGV_NUM(1)
-#define gfdet_ELEMLEN_4 ZTRINGV_NUM(4)
-*/
-
-#define GFDET(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10) CCALLSFSUB10(GFDET,gfdet,STRING,STRING,PINT,STRINGV,PINT,INT,PINT,PINT,PINT,PINT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gfdeta.f
-------------------------------------------------------------------*/
-/*
-#define gfdeta_ELEMS_1 ZTRINGV_NUM(1)
-#define gfdeta_ELEMLEN_1 ZTRINGV_NUM(4)
-#define gfdeta_ELEMS_2 ZTRINGV_NUM(1)
-#define gfdeta_ELEMLEN_2 ZTRINGV_NUM(4)
-*/
-
-#define GFDETA(A1,A2,A3) CCALLSFSUB3(GFDETA,gfdeta,STRING,STRING,INT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gfdetd.f
-------------------------------------------------------------------*/
-/*
-#define gfdetd_ELEMS_1 ZTRINGV_NUM(1)
-#define gfdetd_ELEMLEN_1 ZTRINGV_NUM(4)
-#define gfdetd_ELEMS_2 ZTRINGV_NUM(1)
-#define gfdetd_ELEMLEN_2 ZTRINGV_NUM(4)
-#define gfdetd_ELEMS_4 ZTRINGV_NUM(1)
-#define gfdetd_ELEMLEN_4 ZTRINGV_NUM(4)
-*/
-
-#define GFDETD(A1,A2,A3,A4,A5) CCALLSFSUB5(GFDETD,gfdetd,STRING,STRING,PINT,STRINGV,PINT,A1,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gfdeth.f
-------------------------------------------------------------------*/
-/*
-#define gfdeth_ELEMS_1 ZTRINGV_NUM(1)
-#define gfdeth_ELEMLEN_1 ZTRINGV_NUM(4)
-#define gfdeth_ELEMS_2 ZTRINGV_NUM(1)
-#define gfdeth_ELEMLEN_2 ZTRINGV_NUM(4)
-#define gfdeth_ELEMS_4 ZTRINGV_NUM(1)
-#define gfdeth_ELEMLEN_4 ZTRINGV_NUM(4)
-*/
-
-#define GFDETH(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(GFDETH,gfdeth,STRING,STRING,PINT,STRINGV,PINT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5,A6,A7)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gfdetu.f
-------------------------------------------------------------------*/
-/*
-#define gfdetu_ELEMS_1 ZTRINGV_NUM(1)
-#define gfdetu_ELEMLEN_1 ZTRINGV_NUM(4)
-#define gfdetu_ELEMS_2 ZTRINGV_NUM(1)
-#define gfdetu_ELEMLEN_2 ZTRINGV_NUM(4)
-*/
-
-#define GFDETU(A1,A2,A3,A4,A5) CCALLSFSUB5(GFDETU,gfdetu,STRING,STRING,INT,PINT,FLOATV,A1,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gfdigi.f
-------------------------------------------------------------------*/
-/*
-#define gfdigi_ELEMS_1 ZTRINGV_NUM(1)
-#define gfdigi_ELEMLEN_1 ZTRINGV_NUM(4)
-#define gfdigi_ELEMS_2 ZTRINGV_NUM(1)
-#define gfdigi_ELEMLEN_2 ZTRINGV_NUM(4)
-*/
-
-#define GFDIGI(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12) CCALLSFSUB12(GFDIGI,gfdigi,STRING,STRING,INT,INT,INT,INT,INTV,PINT,PINT,PINT,PINT,PINT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gffgo.f
-------------------------------------------------------------------*/
-
-#define GFFGO() CCALLSFSUB0(GFFGO,gffgo)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gfhits.f
-------------------------------------------------------------------*/
-/*
-#define gfhits_ELEMS_1 ZTRINGV_NUM(1)
-#define gfhits_ELEMLEN_1 ZTRINGV_NUM(4)
-#define gfhits_ELEMS_2 ZTRINGV_NUM(1)
-#define gfhits_ELEMLEN_2 ZTRINGV_NUM(4)
-*/
-
-#define GFHITS(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11) CCALLSFSUB11(GFHITS,gfhits,STRING,STRING,INT,INT,INT,INT,INTV,PINT,PINT,PFLOAT,PINT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gfhsta.f
-------------------------------------------------------------------*/
-
-#define GFHSTA() CCALLSFSUB0(GFHSTA,gfhsta)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gfin.f
-------------------------------------------------------------------*/
-/*
-#define gfin_ELEMS_2 ZTRINGV_NUM(#@#)
-#define gfin_ELEMLEN_2 ZTRINGV_NUM(4)
-#define gfin_ELEMS_5 ZTRINGV_NUM(1)
-#define gfin_ELEMLEN_5 ZTRINGV_NUM(255)
-*/
-
-#define GFIN(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(GFIN,gfin,INT,STRINGV,INT,INT,STRING,PINT,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gfinds.f
-------------------------------------------------------------------*/
-
-#define GFINDS() CCALLSFSUB0(GFINDS,gfinds)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gfipar.f
-------------------------------------------------------------------*/
-
-#define GFIPAR(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(GFIPAR,gfipar,INT,INT,INT,PINT,PINT,FLOATV,FLOATV,A1,A2,A3,A4,A5,A6,A7)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gfkine.f
-------------------------------------------------------------------*/
-
-#define GFKINE(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(GFKINE,gfkine,INT,PFLOAT,PFLOAT,PINT,PINT,PFLOAT,PINT,A1,A2,A3,A4,A5,A6,A7)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gflcar.f
-------------------------------------------------------------------*/
-
-#define GFLCAR(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(GFLCAR,gflcar,INT,INT,INT,FLOATV,PFLOAT,PFLOAT,PINT,A1,A2,A3,A4,A5,A6,A7)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gflphi.f
-------------------------------------------------------------------*/
-
-#define GFLPHI(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(GFLPHI,gflphi,INT,INT,FLOATV,FLOATV,PFLOAT,PFLOAT,PINT,A1,A2,A3,A4,A5,A6,A7)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gflrad.f
-------------------------------------------------------------------*/
-
-#define GFLRAD(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(GFLRAD,gflrad,INT,INT,INT,FLOATV,FLOATV,PFLOAT,PFLOAT,PINT,A1,A2,A3,A4,A5,A6,A7,A8)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gflthe.f
-------------------------------------------------------------------*/
-
-#define GFLTHE(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(GFLTHE,gflthe,INT,INT,FLOATV,FLOATV,PFLOAT,PFLOAT,PINT,A1,A2,A3,A4,A5,A6,A7)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gfmate.f
-------------------------------------------------------------------*/
-
-#define GFMATE(A1,A2,A3,A4,A5,A6,A7,A8,A9) CCALLSFSUB9(GFMATE,gfmate,INT,BYTE,PFLOAT,PFLOAT,PFLOAT,PFLOAT,PFLOAT,FLOATV,PINT,A1,A2,A3,A4,A5,A6,A7,A8,A9)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gfmoth.f
-------------------------------------------------------------------*/
-/*
-#define gfmoth_ELEMS_1 ZTRINGV_NUM(1)
-#define gfmoth_ELEMLEN_1 ZTRINGV_NUM(4)
-#define gfmoth_ELEMS_2 ZTRINGV_NUM(1)
-#define gfmoth_ELEMLEN_2 ZTRINGV_NUM(4)
-*/
-
-#define GFMOTH(A1,A2,A3) CCALLSFSUB3(GFMOTH,gfmoth,STRING,PSTRING,PINT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gfndig.f
-------------------------------------------------------------------*/
-/*
-#define gfndig_ELEMS_1 ZTRINGV_NUM(1)
-#define gfndig_ELEMLEN_1 ZTRINGV_NUM(4)
-#define gfndig_ELEMS_2 ZTRINGV_NUM(1)
-#define gfndig_ELEMLEN_2 ZTRINGV_NUM(4)
-*/
-
-#define GFNDIG(A1,A2,A3) CCALLSFSUB3(GFNDIG,gfndig,STRING,STRING,PINT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gfnhit.f
-------------------------------------------------------------------*/
-/*
-#define gfnhit_ELEMS_1 ZTRINGV_NUM(1)
-#define gfnhit_ELEMLEN_1 ZTRINGV_NUM(4)
-#define gfnhit_ELEMS_2 ZTRINGV_NUM(1)
-#define gfnhit_ELEMLEN_2 ZTRINGV_NUM(4)
-*/
-
-#define GFNHIT(A1,A2,A3) CCALLSFSUB3(GFNHIT,gfnhit,STRING,STRING,PINT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gfout.f
-------------------------------------------------------------------*/
-/*
-#define gfout_ELEMS_2 ZTRINGV_NUM(#@#)
-#define gfout_ELEMLEN_2 ZTRINGV_NUM(4)
-#define gfout_ELEMS_5 ZTRINGV_NUM(1)
-#define gfout_ELEMLEN_5 ZTRINGV_NUM(255)
-*/
-
-#define GFOUT(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(GFOUT,gfout,INT,STRINGV,INT,INT,STRING,PINT,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gfpara.f
-------------------------------------------------------------------*/
-/*
-#define gfpara_ELEMS_1 ZTRINGV_NUM(1)
-#define gfpara_ELEMLEN_1 ZTRINGV_NUM(4)
-*/
-
-#define GFPARA(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(GFPARA,gfpara,STRING,INT,INT,PINT,PINT,PFLOAT,FLOATV,A1,A2,A3,A4,A5,A6,A7)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gfpart.f
-------------------------------------------------------------------*/
-/*
-#define gfpart_ELEMS_2 ZTRINGV_NUM(1)
-#define gfpart_ELEMLEN_2 ZTRINGV_NUM(20)
-*/
-
-#define GFPART(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(GFPART,gfpart,INT,STRING,PINT,PFLOAT,PFLOAT,PFLOAT,PFLOAT,PINT,A1,A2,A3,A4,A5,A6,A7,A8)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gfpath.f
-------------------------------------------------------------------*/
-
-#define GFPATH(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(GFPATH,gfpath,INT,INT,INTV,PINT,PINT,PINT,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gfstat.f
-------------------------------------------------------------------*/
-
-#define GFSTAT(A1) CCALLSFSUB1(GFSTAT,gfstat,INT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gftitl.f
-------------------------------------------------------------------*/
-
-#define GFTITL(A1,A2) CCALLSFSUB2(GFTITL,gftitl,INTV,INTV,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gftmat.f
-------------------------------------------------------------------*/
-/*
-#define gftmat_ELEMS_3 ZTRINGV_NUM(1)
-#define gftmat_ELEMLEN_3 ZTRINGV_NUM(4)
-*/
-
-#define GFTMAT(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(GFTMAT,gftmat,INT,INT,STRING,INT,FLOATV,PFLOAT,FLOATV,PINT,A1,A2,A3,A4,A5,A6,A7,A8)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gftmed.f
-------------------------------------------------------------------*/
-/*
-#define gftmed_ELEMS_2 ZTRINGV_NUM(1)
-#define gftmed_ELEMLEN_2 ZTRINGV_NUM(20)
-*/
-
-#define GFTMED(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13) CCALLSFSUB13(GFTMED,gftmed,INT,STRING,PINT,PINT,PINT,PFLOAT,PFLOAT,PFLOAT,PFLOAT,PFLOAT,PFLOAT,PFLOAT,PINT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gftrac.f
-------------------------------------------------------------------*/
-
-#define GFTRAC() CCALLSFSUB0(GFTRAC,gftrac)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gfupar.f
-------------------------------------------------------------------*/
-
-#define GFUPAR(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(GFUPAR,gfupar,INT,INT,PINT,PINT,PFLOAT,FLOATV,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gfvert.f
-------------------------------------------------------------------*/
-
-#define GFVERT(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(GFVERT,gfvert,INT,PFLOAT,PINT,PINT,PFLOAT,PFLOAT,PINT,A1,A2,A3,A4,A5,A6,A7)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/ggcave.f
-------------------------------------------------------------------*/
-
-#define GGCAVE() CCALLSFSUB0(GGCAVE,ggcave)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/ggclos.f
-------------------------------------------------------------------*/
-
-#define GGCLOS() CCALLSFSUB0(GGCLOS,ggclos)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/ggdetv.f
-------------------------------------------------------------------*/
-
-#define GGDETV(A1,A2) CCALLSFSUB2(GGDETV,ggdetv,INT,INT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/ggdpar.f
-------------------------------------------------------------------*/
-
-#define GGDPAR(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(GGDPAR,ggdpar,INT,INT,INT,INTV,INT,PINT,PFLOAT,A1,A2,A3,A4,A5,A6,A7)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/ggdspe.f
-------------------------------------------------------------------*/
-
-#define GGDSPE(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(GGDSPE,ggdspe,INT,INT,FLOATV,PINT,PINT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5,A6,A7)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/ggdvlp.f
-------------------------------------------------------------------*/
-
-#define GGDVLP() CCALLSFSUB0(GGDVLP,ggdvlp)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gget.f
-------------------------------------------------------------------*/
-/*
-#define gget_ELEMS_2 ZTRINGV_NUM(1)
-#define gget_ELEMLEN_2 ZTRINGV_NUM(4)
-*/
-
-#define GGET(A1,A2,A3,A4,A5) CCALLSFSUB5(GGET,gget,INT,STRINGV,INT,PINT,PINT,A1,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/ggnlev.f
-------------------------------------------------------------------*/
-
-#define GGNLEV() CCALLSFSUB0(GGNLEV,ggnlev)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/ggord.f
-------------------------------------------------------------------*/
-
-#define GGORD(A1) CCALLSFSUB1(GGORD,ggord,INT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/ggordq.f
-------------------------------------------------------------------*/
-
-#define GGORDQ(A1) CCALLSFSUB1(GGORDQ,ggordq,INT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/ggppar.f
-------------------------------------------------------------------*/
-
-#define GGPPAR(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(GGPPAR,ggppar,INT,INT,INT,INTV,INT,PINT,PFLOAT,A1,A2,A3,A4,A5,A6,A7)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/ggvchk.f
-------------------------------------------------------------------*/
-
-#define GGVCHK(A1,A2,A3,A4) CCALLSFSUB4(GGVCHK,ggvchk,INT,INT,PINT,PINT,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/ghadro.f
-------------------------------------------------------------------*/
-
-#define GHADRO(A1,A2,A3,A4) CCALLSFSUB4(GHADRO,ghadro,FLOAT,PFLOAT,PFLOAT,INT,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/ghangl.f
-------------------------------------------------------------------*/
-
-#define GHANGL(A1,A2,A3,A4,A5) CCALLSFSUB5(GHANGL,ghangl,INT,FLOAT,PFLOAT,FLOAT,PFLOAT,A1,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/ghclos.f
-------------------------------------------------------------------*/
-
-#define GHCLOS() CCALLSFSUB0(GHCLOS,ghclos)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/ghdca2.f
-------------------------------------------------------------------*/
-
-#define GHDCA2(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(GHDCA2,ghdca2,FLOAT,FLOAT,FLOAT,FLOAT,INT,INT,FLOAT,FLOAT,A1,A2,A3,A4,A5,A6,A7,A8)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/ghdca3.f
-------------------------------------------------------------------*/
-
-#define GHDCA3(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10) CCALLSFSUB10(GHDCA3,ghdca3,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,INT,INT,INT,FLOAT,FLOAT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gheini.f
-------------------------------------------------------------------*/
-
-#define GHEINI() CCALLSFSUB0(GHEINI,gheini)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gheish.f
-------------------------------------------------------------------*/
-
-#define GHEISH() CCALLSFSUB0(GHEISH,gheish)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/ghelix.f
-------------------------------------------------------------------*/
-
-#define GHELIX(A1,A2,A3,A4) CCALLSFSUB4(GHELIX,ghelix,FLOAT,FLOAT,FLOATV,PFLOAT,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/ghelx3.f
-------------------------------------------------------------------*/
-
-#define GHELX3(A1,A2,A3,A4) CCALLSFSUB4(GHELX3,ghelx3,FLOAT,FLOAT,FLOATV,PFLOAT,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/ghesig.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN10(FLOAT,GHESIG,ghesig,FLOAT,FLOAT,FLOAT,FLOATV,FLOATV,FLOATV,INT,FLOAT,FLOAT,INT)
-#define GHESIG(A2,A3,A4,A5,A6,A7,A8,A9,A10,A11) CCALLSFFUN10(GHESIG,ghesig,FLOAT,FLOAT,FLOAT,FLOATV,FLOATV,FLOATV,INT,FLOAT,FLOAT,INT,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/ghfacf.f
-------------------------------------------------------------------*/
-
-#define GHFACF() CCALLSFSUB0(GHFACF,ghfacf)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/ghfake.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN3(FLOAT,GHFAKE,ghfake,INT,FLOAT,FLOAT)
-#define GHFAKE(A2,A3,A4) CCALLSFFUN3(GHFAKE,ghfake,INT,FLOAT,FLOAT,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/ghfalt.f
-------------------------------------------------------------------*/
-
-#define GHFALT(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15) CCALLSFSUB15(GHFALT,ghfalt,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,PFLOAT,PFLOAT,PFLOAT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/ghfamg.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN1(FLOAT,GHFAMG,ghfamg,INT)
-#define GHFAMG(A2) CCALLSFFUN1(GHFAMG,ghfamg,INT,A2)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/ghfank.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN4(FLOAT,GHFANK,ghfank,INT,FLOAT,FLOAT,FLOAT)
-#define GHFANK(A2,A3,A4,A5) CCALLSFFUN4(GHFANK,ghfank,INT,FLOAT,FLOAT,FLOAT,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/ghfcal.f
-------------------------------------------------------------------*/
-
-#define GHFCAL(A1,A2) CCALLSFSUB2(GHFCAL,ghfcal,INT,INT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/ghfcha.f
-------------------------------------------------------------------*/
-
-#define GHFCHA() CCALLSFSUB0(GHFCHA,ghfcha)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/ghfcos.f
-------------------------------------------------------------------*/
-
-#define GHFCOS(A1,A2) CCALLSFSUB2(GHFCOS,ghfcos,PFLOAT,PFLOAT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/ghfeex.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN3(FLOAT,GHFEEX,ghfeex,INT,FLOAT,FLOAT)
-#define GHFEEX(A2,A3,A4) CCALLSFFUN3(GHFEEX,ghfeex,INT,FLOAT,FLOAT,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/ghfeke.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN4(FLOAT,GHFEKE,ghfeke,INT,FLOAT,FLOAT,FLOAT)
-#define GHFEKE(A2,A3,A4,A5) CCALLSFFUN4(GHFEKE,ghfeke,INT,FLOAT,FLOAT,FLOAT,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/ghffer.f
-------------------------------------------------------------------*/
-
-#define GHFFER(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10) CCALLSFSUB10(GHFFER,ghffer,FLOAT,FLOAT,INT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,INT,INT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/ghffrm.f
-------------------------------------------------------------------*/
-
-#define GHFFRM(A1) CCALLSFSUB1(GHFFRM,ghffrm,PFLOAT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/ghfhad.f
-------------------------------------------------------------------*/
-
-#define GHFHAD(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(GHFHAD,ghfhad,INT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,INT,INT,A1,A2,A3,A4,A5,A6,A7,A8)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/ghfhdi.f
-------------------------------------------------------------------*/
-
-#define GHFHDI() CCALLSFSUB0(GHFHDI,ghfhdi)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/ghfhdn.f
-------------------------------------------------------------------*/
-
-#define GHFHDN(A1,A2,A3,A4) CCALLSFSUB4(GHFHDN,ghfhdn,FLOAT,FLOAT,INT,PINT,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/ghfhyp.f
-------------------------------------------------------------------*/
-
-#define GHFHYP(A1,A2,A3,A4) CCALLSFSUB4(GHFHYP,ghfhyp,PINT,PINT,PFLOAT,PFLOAT,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/ghfief.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN2(INT,GHFIEF,ghfief,FLOAT,INT)
-#define GHFIEF(A2,A3) CCALLSFFUN2(GHFIEF,ghfief,FLOAT,INT,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/ghfkin.f
-------------------------------------------------------------------*/
-
-#define GHFKIN(A1,A2,A3) CCALLSFSUB3(GHFKIN,ghfkin,FLOATV,FLOATV,FLOAT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/ghfnuc.f
-------------------------------------------------------------------*/
-
-#define GHFNUC(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(GHFNUC,ghfnuc,INT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,A1,A2,A3,A4,A5,A6,A7,A8)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/ghfpof.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN2(FLOAT,GHFPOF,ghfpof,FLOAT,INT)
-#define GHFPOF(A2,A3) CCALLSFFUN2(GHFPOF,ghfpof,FLOAT,INT,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/ghfpol.f
-------------------------------------------------------------------*/
-
-#define GHFPOL(A1,A2) CCALLSFSUB2(GHFPOL,ghfpol,FLOAT,PFLOAT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/ghfrag.f
-------------------------------------------------------------------*/
-
-#define GHFRAG(A1) CCALLSFSUB1(GHFRAG,ghfrag,PFLOAT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/ghfrak.f
-------------------------------------------------------------------*/
-
-#define GHFRAK(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(GHFRAK,ghfrak,INT,FLOAT,FLOAT,FLOAT,PFLOAT,PFLOAT,PFLOAT,PINT,A1,A2,A3,A4,A5,A6,A7,A8)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/ghfsgi.f
-------------------------------------------------------------------*/
-
-#define GHFSGI(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10) CCALLSFSUB10(GHFSGI,ghfsgi,INT,FLOAT,INT,PINT,PFLOAT,PFLOAT,PFLOAT,PFLOAT,INT,INT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/ghftch.f
-------------------------------------------------------------------*/
-
-#define GHFTCH(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10) CCALLSFSUB10(GHFTCH,ghftch,PFLOAT,FLOAT,FLOAT,FLOAT,FLOAT,INT,INT,INT,FLOAT,FLOAT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/ghfthr.f
-------------------------------------------------------------------*/
-
-#define GHFTHR(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15,A16,A17,A18,A19) CCALLSFSUB19(GHFTHR,ghfthr,FLOAT,PFLOAT,PFLOAT,PFLOAT,PFLOAT,PFLOAT,PFLOAT,PFLOAT,PFLOAT,PFLOAT,PFLOAT,PFLOAT,PFLOAT,PFLOAT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15,A16,A17,A18,A19)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/ghftra.f
-------------------------------------------------------------------*/
-
-#define GHFTRA(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15) CCALLSFSUB15(GHFTRA,ghftra,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,PFLOAT,FLOAT,FLOAT,FLOAT,PFLOAT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/ghftrn.f
-------------------------------------------------------------------*/
-
-#define GHFTRN(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10) CCALLSFSUB10(GHFTRN,ghftrn,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,PFLOAT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/ghftwd.f
-------------------------------------------------------------------*/
-
-#define GHFTWD(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13) CCALLSFSUB13(GHFTWD,ghftwd,FLOAT,PFLOAT,PFLOAT,PFLOAT,PFLOAT,PFLOAT,FLOAT,FLOAT,PFLOAT,PFLOAT,PFLOAT,FLOAT,FLOAT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/ghftwo.f
-------------------------------------------------------------------*/
-
-#define GHFTWO(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15,A16,A17,A18) CCALLSFSUB18(GHFTWO,ghftwo,PFLOAT,PFLOAT,PFLOAT,PFLOAT,PFLOAT,PFLOAT,FLOAT,PFLOAT,FLOAT,PFLOAT,INT,INT,FLOAT,FLOAT,FLOAT,INT,FLOAT,FLOAT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15,A16,A17,A18)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/ghfxla.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN3(FLOAT,GHFXLA,ghfxla,FLOAT,FLOAT,FLOAT)
-#define GHFXLA(A2,A3,A4) CCALLSFFUN3(GHFXLA,ghfxla,FLOAT,FLOAT,FLOAT,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/ghgene.f
-------------------------------------------------------------------*/
-
-#define GHGENE(A1,A2,A3,A4,A5) CCALLSFSUB5(GHGENE,ghgene,INT,FLOAT,FLOAT,FLOAT,INT,A1,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/ghisra.f
-------------------------------------------------------------------*/
-
-#define GHISRA(A1,A2,A3,A4,A5) CCALLSFSUB5(GHISRA,ghisra,FLOATV,INT,FLOAT,FLOAT,PFLOAT,A1,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/ghkind.f
-------------------------------------------------------------------*/
-
-#define GHKIND(A1,A2,A3) CCALLSFSUB3(GHKIND,ghkind,FLOAT,INT,INT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/ghlead.f
-------------------------------------------------------------------*/
-
-#define GHLEAD(A1,A2,A3,A4) CCALLSFSUB4(GHLEAD,ghlead,FLOAT,INT,INT,FLOAT,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/ghmix.f
-------------------------------------------------------------------*/
-
-#define GHMIX(A1,A2,A3,A4) CCALLSFSUB4(GHMIX,ghmix,FLOATV,FLOATV,INT,PFLOAT,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/ghmlg.f
-------------------------------------------------------------------*/
-
-#define GHMLG(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(GHMLG,ghmlg,FLOAT,FLOAT,FLOAT,PFLOAT,INT,INT,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/ghmome.f
-------------------------------------------------------------------*/
-
-#define GHMOME(A1,A2,A3,A4) CCALLSFSUB4(GHMOME,ghmome,FLOAT,INT,INT,PFLOAT,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/ghmult.f
-------------------------------------------------------------------*/
-
-#define GHMULT(A1,A2,A3,A4) CCALLSFSUB4(GHMULT,ghmult,FLOAT,PINT,INT,FLOAT,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/ghrear.f
-------------------------------------------------------------------*/
-
-#define GHREAR(A1,A2,A3,A4) CCALLSFSUB4(GHREAR,ghrear,PINT,PINT,FLOATV,PFLOAT,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/ghsig.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN3(FLOAT,GHSIG,ghsig,FLOAT,INT,FLOAT)
-#define GHSIG(A2,A3,A4) CCALLSFFUN3(GHSIG,ghsig,FLOAT,INT,FLOAT,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/ghsigm.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN3(FLOAT,GHSIGM,ghsigm,FLOAT,INT,FLOAT)
-#define GHSIGM(A2,A3,A4) CCALLSFFUN3(GHSIGM,ghsigm,FLOAT,INT,FLOAT,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/ghstop.f
-------------------------------------------------------------------*/
-
-#define GHSTOP() CCALLSFSUB0(GHSTOP,ghstop)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/ghtati.f
-------------------------------------------------------------------*/
-
-#define GHTATI() CCALLSFSUB0(GHTATI,ghtati)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/ghttra.f
-------------------------------------------------------------------*/
-
-#define GHTTRA(A1,A2,A3,A4) CCALLSFSUB4(GHTTRA,ghttra,FLOAT,PFLOAT,INT,INT,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gicyl.f
-------------------------------------------------------------------*/
-
-#define GICYL(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10) CCALLSFSUB10(GICYL,gicyl,FLOAT,FLOATV,FLOATV,FLOAT,FLOAT,INT,PFLOAT,PFLOAT,PFLOAT,PINT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/ginctu.f
-------------------------------------------------------------------*/
-
-#define GINCTU(A1,A2,A3) CCALLSFSUB3(GINCTU,ginctu,FLOATV,FLOATV,PINT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gingtr.f
-------------------------------------------------------------------*/
-
-#define GINGTR(A1,A2,A3) CCALLSFSUB3(GINGTR,gingtr,FLOATV,FLOATV,PINT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/ginit.f
-------------------------------------------------------------------*/
-
-#define GINIT() CCALLSFSUB0(GINIT,ginit)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/ginme.f
-------------------------------------------------------------------*/
-
-#define GINME(A1,A2,A3,A4) CCALLSFSUB4(GINME,ginme,FLOATV,FLOAT,FLOATV,PINT,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/ginpar.f
-------------------------------------------------------------------*/
-
-#define GINPAR(A1,A2,A3) CCALLSFSUB3(GINPAR,ginpar,FLOATV,FLOATV,PINT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/ginpco.f
-------------------------------------------------------------------*/
-
-#define GINPCO(A1,A2,A3) CCALLSFSUB3(GINPCO,ginpco,FLOATV,FLOATV,PINT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/ginpgo.f
-------------------------------------------------------------------*/
-
-#define GINPGO(A1,A2,A3) CCALLSFSUB3(GINPGO,ginpgo,FLOATV,FLOATV,PINT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/ginrot.f
-------------------------------------------------------------------*/
-
-#define GINROT(A1,A2,A3) CCALLSFSUB3(GINROT,ginrot,FLOATV,FLOATV,PFLOAT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gintco.f
-------------------------------------------------------------------*/
-
-#define GINTCO(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(GINTCO,gintco,FLOATV,FLOAT,FLOAT,FLOAT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gintrp.f
-------------------------------------------------------------------*/
-
-#define GINTRP(A1,A2,A3) CCALLSFSUB3(GINTRP,gintrp,FLOATV,FLOATV,PINT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/ginvol.f
-------------------------------------------------------------------*/
-
-#define GINVOL(A1,A2) CCALLSFSUB2(GINVOL,ginvol,FLOATV,PINT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/giplan.f
-------------------------------------------------------------------*/
-
-#define GIPLAN(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10) CCALLSFSUB10(GIPLAN,giplan,FLOAT,FLOATV,FLOATV,FLOAT,FLOAT,INT,PFLOAT,PFLOAT,PFLOAT,PINT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gitran.f
-------------------------------------------------------------------*/
-
-#define GITRAN(A1,A2,A3,A4) CCALLSFSUB4(GITRAN,gitran,FLOATV,FLOATV,INT,PFLOAT,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gkhits.f
-------------------------------------------------------------------*/
-/*
-#define gkhits_ELEMS_1 ZTRINGV_NUM(1)
-#define gkhits_ELEMLEN_1 ZTRINGV_NUM(4)
-#define gkhits_ELEMS_2 ZTRINGV_NUM(1)
-#define gkhits_ELEMLEN_2 ZTRINGV_NUM(4)
-*/
-
-#define GKHITS(A1,A2,A3) CCALLSFSUB3(GKHITS,gkhits,STRING,STRING,FLOAT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gkxyz.f
-------------------------------------------------------------------*/
-
-#define GKXYZ(A1) CCALLSFSUB1(GKXYZ,gkxyz,FLOAT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/glande.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN1(FLOAT,GLANDE,glande,FLOAT)
-#define GLANDE(A2) CCALLSFFUN1(GLANDE,glande,FLOAT,A2)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/glandg.f
-------------------------------------------------------------------*/
-
-#define GLANDG(A1) CCALLSFSUB1(GLANDG,glandg,PFLOAT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/glando.f
-------------------------------------------------------------------*/
-
-#define GLANDO(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10) CCALLSFSUB10(GLANDO,glando,INT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,PFLOAT,PINT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/glandr.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN1(FLOAT,GLANDR,glandr,FLOAT)
-#define GLANDR(A2) CCALLSFFUN1(GLANDR,glandr,FLOAT,A2)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/glands.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN1(FLOAT,GLANDS,glands,FLOAT)
-#define GLANDS(A2) CCALLSFFUN1(GLANDS,glands,FLOAT,A2)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/glandz.f
-------------------------------------------------------------------*/
-
-#define GLANDZ(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(GLANDZ,glandz,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,PFLOAT,A1,A2,A3,A4,A5,A6,A7,A8)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/glast.f
-------------------------------------------------------------------*/
-
-#define GLAST() CCALLSFSUB0(GLAST,glast)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/glmoth.f
-------------------------------------------------------------------*/
-/*
-#define glmoth_ELEMS_1 ZTRINGV_NUM(1)
-#define glmoth_ELEMLEN_1 ZTRINGV_NUM(255)
-*/
-
-#define GLMOTH(A1,A2,A3,A4,A5) CCALLSFSUB5(GLMOTH,glmoth,STRING,INT,PINT,PINT,PINT,A1,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/glook.f
-------------------------------------------------------------------*/
-/*
-#define glook_ELEMS_1 ZTRINGV_NUM(1)
-#define glook_ELEMLEN_1 ZTRINGV_NUM(255)
-*/
-
-#define GLOOK(A1,A2,A3,A4) CCALLSFSUB4(GLOOK,glook,STRING,INTV,INT,PINT,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gloren.f
-------------------------------------------------------------------*/
-
-#define GLOREN(A1,A2,A3) CCALLSFSUB3(GLOREN,gloren,FLOATV,FLOATV,PFLOAT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/glsklt.f
-------------------------------------------------------------------*/
-
-#define GLSKLT() CCALLSFSUB0(GLSKLT,glsklt)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gltrac.f
-------------------------------------------------------------------*/
-
-#define GLTRAC() CCALLSFSUB0(GLTRAC,gltrac)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gludky.f
-------------------------------------------------------------------*/
-
-#define GLUDKY() CCALLSFSUB0(GLUDKY,gludky)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/glund.f
-------------------------------------------------------------------*/
-
-#define GLUND() CCALLSFSUB0(GLUND,glund)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/glundi.f
-------------------------------------------------------------------*/
-
-#define GLUNDI() CCALLSFSUB0(GLUNDI,glundi)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/glvolu.f
-------------------------------------------------------------------*/
-
-#define GLVOLU(A1,A2,A3,A4) CCALLSFSUB4(GLVOLU,glvolu,INT,INTV,INTV,PINT,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gm3pol.f
-------------------------------------------------------------------*/
-
-#define GM3POL(A1,A2) CCALLSFSUB2(GM3POL,gm3pol,FLOAT,INT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gmail.f
-------------------------------------------------------------------*/
-
-#define GMAIL(A1,A2) CCALLSFSUB2(GMAIL,gmail,INT,INT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gmate.f
-------------------------------------------------------------------*/
-
-#define GMATE() CCALLSFSUB0(GMATE,gmate)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gmclos.f
-------------------------------------------------------------------*/
-
-#define GMCLOS() CCALLSFSUB0(GMCLOS,gmclos)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gmcoul.f
-------------------------------------------------------------------*/
-
-#define GMCOUL(A1,A2) CCALLSFSUB2(GMCOUL,gmcoul,FLOAT,PFLOAT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gmedia.f
-------------------------------------------------------------------*/
-
-#define GMEDIA(A1,A2) CCALLSFSUB2(GMEDIA,gmedia,FLOATV,PINT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gmedin.f
-------------------------------------------------------------------*/
-
-#define GMEDIN() CCALLSFSUB0(GMEDIN,gmedin)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gmediv.f
-------------------------------------------------------------------*/
-
-#define GMEDIV(A1,A2,A3,A4) CCALLSFSUB4(GMEDIV,gmediv,INT,PINT,PFLOAT,INT,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gmepos.f
-------------------------------------------------------------------*/
-
-#define GMEPOS(A1,A2,A3,A4) CCALLSFSUB4(GMEPOS,gmepos,INT,INT,PFLOAT,INT,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gmgaus.f
-------------------------------------------------------------------*/
-
-#define GMGAUS(A1,A2) CCALLSFSUB2(GMGAUS,gmgaus,FLOAT,PFLOAT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gmol4.f
-------------------------------------------------------------------*/
-
-#define GMOL4(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(GMOL4,gmol4,PFLOAT,FLOAT,PFLOAT,PFLOAT,FLOAT,PINT,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gmoli.f
-------------------------------------------------------------------*/
-
-#define GMOLI(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(GMOLI,gmoli,FLOATV,FLOATV,FLOATV,INT,FLOAT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5,A6,A7)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gmolie.f
-------------------------------------------------------------------*/
-
-#define GMOLIE(A1,A2,A3) CCALLSFSUB3(GMOLIE,gmolie,FLOAT,FLOAT,PFLOAT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gmolio.f
-------------------------------------------------------------------*/
-
-#define GMOLIO(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(GMOLIO,gmolio,FLOATV,FLOATV,FLOATV,INT,FLOAT,FLOAT,FLOAT,PFLOAT,A1,A2,A3,A4,A5,A6,A7,A8)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gmopen.f
-------------------------------------------------------------------*/
-
-#define GMOPEN(A1,A2,A3) CCALLSFSUB3(GMOPEN,gmopen,FLOAT,FLOAT,INT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gmtod.f
-------------------------------------------------------------------*/
-
-#define GMTOD(A1,A2,A3) CCALLSFSUB3(GMTOD,gmtod,FLOATV,PFLOAT,INT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gmulof.f
-------------------------------------------------------------------*/
-
-#define GMULOF() CCALLSFSUB0(GMULOF,gmulof)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gmults.f
-------------------------------------------------------------------*/
-
-#define GMULTS() CCALLSFSUB0(GMULTS,gmults)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gmunu.f
-------------------------------------------------------------------*/
-
-#define GMUNU() CCALLSFSUB0(GMUNU,gmunu)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gmunui.f
-------------------------------------------------------------------*/
-
-#define GMUNUI() CCALLSFSUB0(GMUNUI,gmunui)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gmusig.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN3(FLOAT,GMUSIG,gmusig,FLOAT,FLOAT,FLOAT)
-#define GMUSIG(A2,A3,A4) CCALLSFFUN3(GMUSIG,gmusig,FLOAT,FLOAT,FLOAT,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gnbox.f
-------------------------------------------------------------------*/
-
-#define GNBOX(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(GNBOX,gnbox,FLOATV,FLOATV,INT,FLOAT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gncone.f
-------------------------------------------------------------------*/
-
-#define GNCONE(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(GNCONE,gncone,FLOATV,FLOATV,INT,INT,FLOAT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5,A6,A7)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gnctub.f
-------------------------------------------------------------------*/
-
-#define GNCTUB(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(GNCTUB,gnctub,FLOATV,FLOATV,INT,FLOAT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gneltu.f
-------------------------------------------------------------------*/
-
-#define GNELTU(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(GNELTU,gneltu,FLOATV,FLOATV,INT,FLOAT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gnext.f
-------------------------------------------------------------------*/
-
-#define GNEXT(A1,A2,A3) CCALLSFSUB3(GNEXT,gnext,FLOATV,PFLOAT,PFLOAT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gnhype.f
-------------------------------------------------------------------*/
-
-#define GNHYPE(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(GNHYPE,gnhype,FLOATV,FLOATV,INT,FLOAT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gnobox.f
-------------------------------------------------------------------*/
-
-#define GNOBOX(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(GNOBOX,gnobox,FLOATV,FLOATV,INT,FLOAT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gnocon.f
-------------------------------------------------------------------*/
-
-#define GNOCON(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(GNOCON,gnocon,FLOATV,FLOATV,INT,INT,FLOAT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5,A6,A7)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gnoctu.f
-------------------------------------------------------------------*/
-
-#define GNOCTU(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(GNOCTU,gnoctu,FLOATV,FLOATV,INT,FLOAT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gnoelt.f
-------------------------------------------------------------------*/
-
-#define GNOELT(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(GNOELT,gnoelt,FLOATV,FLOATV,INT,FLOAT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gnohyp.f
-------------------------------------------------------------------*/
-
-#define GNOHYP(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(GNOHYP,gnohyp,FLOATV,FLOATV,INT,FLOAT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gnopar.f
-------------------------------------------------------------------*/
-
-#define GNOPAR(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(GNOPAR,gnopar,FLOATV,FLOATV,INT,FLOAT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gnopco.f
-------------------------------------------------------------------*/
-
-#define GNOPCO(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(GNOPCO,gnopco,FLOATV,FLOATV,INT,FLOAT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gnopg1.f
-------------------------------------------------------------------*/
-
-#define GNOPG1(A1,A2,A3) CCALLSFSUB3(GNOPG1,gnopg1,FLOATV,FLOATV,PFLOAT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gnopgo.f
-------------------------------------------------------------------*/
-
-#define GNOPGO(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(GNOPGO,gnopgo,FLOATV,FLOATV,INT,FLOAT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gnosph.f
-------------------------------------------------------------------*/
-
-#define GNOSPH(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(GNOSPH,gnosph,FLOATV,FLOATV,INT,FLOAT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gnotr1.f
-------------------------------------------------------------------*/
-
-#define GNOTR1(A1) CCALLSFSUB1(GNOTR1,gnotr1,FLOATV,A1)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gnotr2.f
-------------------------------------------------------------------*/
-
-#define GNOTR2(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(GNOTR2,gnotr2,FLOATV,FLOATV,FLOATV,INT,INT,INT,INT,PFLOAT,A1,A2,A3,A4,A5,A6,A7,A8)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gnotr9.f
-------------------------------------------------------------------*/
-
-#define GNOTR9(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(GNOTR9,gnotr9,FLOATV,FLOATV,FLOATV,INT,INT,INT,INT,A1,A2,A3,A4,A5,A6,A7)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gnotra.f
-------------------------------------------------------------------*/
-
-#define GNOTRA(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(GNOTRA,gnotra,FLOATV,FLOATV,INT,INT,FLOAT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5,A6,A7)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gnotrp.f
-------------------------------------------------------------------*/
-
-#define GNOTRP(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(GNOTRP,gnotrp,FLOATV,FLOATV,INT,FLOAT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gnotub.f
-------------------------------------------------------------------*/
-
-#define GNOTUB(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(GNOTUB,gnotub,FLOATV,FLOATV,INT,INT,FLOAT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5,A6,A7)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gnpara.f
-------------------------------------------------------------------*/
-
-#define GNPARA(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(GNPARA,gnpara,FLOATV,FLOATV,INT,FLOAT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gnpcon.f
-------------------------------------------------------------------*/
-
-#define GNPCON(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(GNPCON,gnpcon,FLOATV,FLOATV,INT,FLOAT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gnpgo1.f
-------------------------------------------------------------------*/
-
-#define GNPGO1(A1,A2,A3) CCALLSFSUB3(GNPGO1,gnpgo1,FLOATV,FLOATV,PFLOAT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gnpgon.f
-------------------------------------------------------------------*/
-
-#define GNPGON(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(GNPGON,gnpgon,FLOATV,FLOATV,INT,FLOAT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gnslwd.f
-------------------------------------------------------------------*/
-
-#define GNSLWD(A1,A2,A3,A4) CCALLSFSUB4(GNSLWD,gnslwd,PINT,INT,INT,FLOAT,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gnsphr.f
-------------------------------------------------------------------*/
-
-#define GNSPHR(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(GNSPHR,gnsphr,FLOATV,FLOATV,INT,FLOAT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gntrap.f
-------------------------------------------------------------------*/
-
-#define GNTRAP(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(GNTRAP,gntrap,FLOATV,FLOATV,INT,INT,FLOAT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5,A6,A7)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gntrp.f
-------------------------------------------------------------------*/
-
-#define GNTRP(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(GNTRP,gntrp,FLOATV,FLOATV,INT,FLOAT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gntube.f
-------------------------------------------------------------------*/
-
-#define GNTUBE(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(GNTUBE,gntube,FLOATV,FLOATV,INT,INT,FLOAT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5,A6,A7)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gopen.f
-------------------------------------------------------------------*/
-/*
-#define gopen_ELEMS_2 ZTRINGV_NUM(1)
-#define gopen_ELEMLEN_2 ZTRINGV_NUM(255)
-*/
-
-#define GOPEN(A1,A2,A3,A4) CCALLSFSUB4(GOPEN,gopen,INT,STRING,INT,PINT,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gpairg.f
-------------------------------------------------------------------*/
-
-#define GPAIRG() CCALLSFSUB0(GPAIRG,gpairg)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gpairm.f
-------------------------------------------------------------------*/
-
-#define GPAIRM() CCALLSFSUB0(GPAIRM,gpairm)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gpart.f
-------------------------------------------------------------------*/
-
-#define GPART() CCALLSFSUB0(GPART,gpart)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gpcxyz.f
-------------------------------------------------------------------*/
-
-#define GPCXYZ() CCALLSFSUB0(GPCXYZ,gpcxyz)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gpdigi.f
-------------------------------------------------------------------*/
-/*
-#define gpdigi_ELEMS_1 ZTRINGV_NUM(1)
-#define gpdigi_ELEMLEN_1 ZTRINGV_NUM(4)
-#define gpdigi_ELEMS_2 ZTRINGV_NUM(1)
-#define gpdigi_ELEMLEN_2 ZTRINGV_NUM(4)
-*/
-
-#define GPDIGI(A1,A2) CCALLSFSUB2(GPDIGI,gpdigi,STRING,STRING,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gpdk.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN3(FLOAT,GPDK,gpdk,FLOAT,FLOAT,FLOAT)
-#define GPDK(A2,A3,A4) CCALLSFFUN3(GPDK,gpdk,FLOAT,FLOAT,FLOAT,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gpdrif.f
-------------------------------------------------------------------*/
-
-#define GPDRIF(A1,A2,A3) CCALLSFSUB3(GPDRIF,gpdrif,FLOATV,FLOATV,PINT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gpfis.f
-------------------------------------------------------------------*/
-
-#define GPFIS() CCALLSFSUB0(GPFIS,gpfis)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gpfisi.f
-------------------------------------------------------------------*/
-
-#define GPFISI() CCALLSFSUB0(GPFISI,gpfisi)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gpghei.f
-------------------------------------------------------------------*/
-
-#define GPGHEI() CCALLSFSUB0(GPGHEI,gpghei)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gpgkin.f
-------------------------------------------------------------------*/
-
-#define GPGKIN() CCALLSFSUB0(GPGKIN,gpgkin)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gphadr.f
-------------------------------------------------------------------*/
-
-#define GPHADR() CCALLSFSUB0(GPHADR,gphadr)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gphits.f
-------------------------------------------------------------------*/
-/*
-#define gphits_ELEMS_1 ZTRINGV_NUM(1)
-#define gphits_ELEMLEN_1 ZTRINGV_NUM(4)
-#define gphits_ELEMS_2 ZTRINGV_NUM(1)
-#define gphits_ELEMLEN_2 ZTRINGV_NUM(4)
-*/
-
-#define GPHITS(A1,A2) CCALLSFSUB2(GPHITS,gphits,STRING,STRING,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gphmfi.f
-------------------------------------------------------------------*/
-
-#define GPHMFI() CCALLSFSUB0(GPHMFI,gphmfi)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gphot.f
-------------------------------------------------------------------*/
-
-#define GPHOT() CCALLSFSUB0(GPHOT,gphot)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gphoti.f
-------------------------------------------------------------------*/
-
-#define GPHOTI() CCALLSFSUB0(GPHOTI,gphoti)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gphsig.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN2(FLOAT,GPHSIG,gphsig,FLOAT,FLOAT)
-#define GPHSIG(A2,A3) CCALLSFFUN2(GPHSIG,gphsig,FLOAT,FLOAT,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gphysi.f
-------------------------------------------------------------------*/
-
-#define GPHYSI() CCALLSFSUB0(GPHYSI,gphysi)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gpions.f
-------------------------------------------------------------------*/
-
-#define GPIONS() CCALLSFSUB0(GPIONS,gpions)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gpjxyz.f
-------------------------------------------------------------------*/
-
-#define GPJXYZ(A1) CCALLSFSUB1(GPJXYZ,gpjxyz,INT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gpkine.f
-------------------------------------------------------------------*/
-
-#define GPKINE(A1) CCALLSFSUB1(GPKINE,gpkine,INT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gplmat.f
-------------------------------------------------------------------*/
-/*
-#define gplmat_ELEMS_3 ZTRINGV_NUM(1)
-#define gplmat_ELEMLEN_3 ZTRINGV_NUM(255)
-*/
-
-#define GPLMAT(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(GPLMAT,gplmat,INT,INT,STRING,INT,FLOATV,INT,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gpmate.f
-------------------------------------------------------------------*/
-
-#define GPMATE(A1) CCALLSFSUB1(GPMATE,gpmate,INT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gpmwpc.f
-------------------------------------------------------------------*/
-
-#define GPMWPC(A1,A2,A3) CCALLSFSUB3(GPMWPC,gpmwpc,FLOATV,FLOATV,PINT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gpoiss.f
-------------------------------------------------------------------*/
-
-#define GPOISS(A1,A2,A3) CCALLSFSUB3(GPOISS,gpoiss,FLOATV,PINT,INT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gppart.f
-------------------------------------------------------------------*/
-
-#define GPPART(A1) CCALLSFSUB1(GPPART,gppart,INT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gprela.f
-------------------------------------------------------------------*/
-
-#define GPRELA() CCALLSFSUB0(GPRELA,gprela)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gprelm.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN3(FLOAT,GPRELM,gprelm,FLOAT,FLOAT,FLOAT)
-#define GPRELM(A2,A3,A4) CCALLSFFUN3(GPRELM,gprelm,FLOAT,FLOAT,FLOAT,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gprint.f
-------------------------------------------------------------------*/
-/*
-#define gprint_ELEMS_1 ZTRINGV_NUM(1)
-#define gprint_ELEMLEN_1 ZTRINGV_NUM(255)
-*/
-
-#define GPRINT(A1,A2) CCALLSFSUB2(GPRINT,gprint,STRING,INT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gprmat.f
-------------------------------------------------------------------*/
-/*
-#define gprmat_ELEMS_3 ZTRINGV_NUM(1)
-#define gprmat_ELEMLEN_3 ZTRINGV_NUM(255)
-*/
-
-#define GPRMAT(A1,A2,A3,A4,A5) CCALLSFSUB5(GPRMAT,gprmat,INT,INT,STRING,INT,FLOATV,A1,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gprobi.f
-------------------------------------------------------------------*/
-
-#define GPROBI() CCALLSFSUB0(GPROBI,gprobi)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gprotm.f
-------------------------------------------------------------------*/
-
-#define GPROTM(A1) CCALLSFSUB1(GPROTM,gprotm,INT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gprsga.f
-------------------------------------------------------------------*/
-
-#define GPRSGA() CCALLSFSUB0(GPRSGA,gprsga)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gprsgg.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN2(FLOAT,GPRSGG,gprsgg,FLOAT,FLOAT)
-#define GPRSGG(A2,A3) CCALLSFFUN2(GPRSGG,gprsgg,FLOAT,FLOAT,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gprsgm.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN3(FLOAT,GPRSGM,gprsgm,FLOAT,FLOAT,FLOAT)
-#define GPRSGM(A2,A3,A4) CCALLSFFUN3(GPRSGM,gprsgm,FLOAT,FLOAT,FLOAT,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gpsets.f
-------------------------------------------------------------------*/
-/*
-#define gpsets_ELEMS_1 ZTRINGV_NUM(1)
-#define gpsets_ELEMLEN_1 ZTRINGV_NUM(4)
-#define gpsets_ELEMS_2 ZTRINGV_NUM(1)
-#define gpsets_ELEMLEN_2 ZTRINGV_NUM(4)
-*/
-
-#define GPSETS(A1,A2) CCALLSFSUB2(GPSETS,gpsets,STRING,STRING,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gpstat.f
-------------------------------------------------------------------*/
-
-#define GPSTAT() CCALLSFSUB0(GPSTAT,gpstat)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gptmed.f
-------------------------------------------------------------------*/
-
-#define GPTMED(A1) CCALLSFSUB1(GPTMED,gptmed,INT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gpvert.f
-------------------------------------------------------------------*/
-
-#define GPVERT(A1) CCALLSFSUB1(GPVERT,gpvert,INT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gpvolu.f
-------------------------------------------------------------------*/
-
-#define GPVOLU(A1) CCALLSFSUB1(GPVOLU,gpvolu,INT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/grangi.f
-------------------------------------------------------------------*/
-
-#define GRANGI() CCALLSFSUB0(GRANGI,grangi)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/granor.f
-------------------------------------------------------------------*/
-
-#define GRANOR(A1,A2) CCALLSFSUB2(GRANOR,granor,PFLOAT,PFLOAT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/grayl.f
-------------------------------------------------------------------*/
-
-#define GRAYL() CCALLSFSUB0(GRAYL,grayl)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/grayli.f
-------------------------------------------------------------------*/
-
-#define GRAYLI() CCALLSFSUB0(GRAYLI,grayli)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/grend.f
-------------------------------------------------------------------*/
-
-#define GREND(A1) CCALLSFSUB1(GREND,grend,INT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/grfile.f
-------------------------------------------------------------------*/
-/*
-#define grfile_ELEMS_2 ZTRINGV_NUM(1)
-#define grfile_ELEMLEN_2 ZTRINGV_NUM(255)
-#define grfile_ELEMS_3 ZTRINGV_NUM(1)
-#define grfile_ELEMLEN_3 ZTRINGV_NUM(255)
-*/
-
-#define GRFILE(A1,A2,A3) CCALLSFSUB3(GRFILE,grfile,INT,STRING,STRING,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/grget.f
-------------------------------------------------------------------*/
-/*
-#define grget_ELEMS_1 ZTRINGV_NUM(1)
-#define grget_ELEMLEN_1 ZTRINGV_NUM(4)
-*/
-
-#define GRGET(A1,A2,A3,A4,A5) CCALLSFSUB5(GRGET,grget,STRINGV,INT,INT,INT,INT,A1,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/grhits.f
-------------------------------------------------------------------*/
-/*
-#define grhits_ELEMS_1 ZTRINGV_NUM(1)
-#define grhits_ELEMLEN_1 ZTRINGV_NUM(255)
-#define grhits_ELEMS_2 ZTRINGV_NUM(1)
-#define grhits_ELEMLEN_2 ZTRINGV_NUM(255)
-*/
-
-#define GRHITS(A1,A2,A3,A4) CCALLSFSUB4(GRHITS,grhits,STRING,STRING,INT,INTV,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/grin.f
-------------------------------------------------------------------*/
-/*
-#define grin_ELEMS_1 ZTRINGV_NUM(1)
-#define grin_ELEMLEN_1 ZTRINGV_NUM(255)
-#define grin_ELEMS_3 ZTRINGV_NUM(1)
-#define grin_ELEMLEN_3 ZTRINGV_NUM(255)
-*/
-
-#define GRIN(A1,A2,A3) CCALLSFSUB3(GRIN,grin,STRING,INT,STRING,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/grkuta.f
-------------------------------------------------------------------*/
-
-#define GRKUTA(A1,A2,A3,A4) CCALLSFSUB4(GRKUTA,grkuta,FLOAT,FLOAT,FLOATV,PFLOAT,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/grleas.f
-------------------------------------------------------------------*/
-
-#define GRLEAS(A1) CCALLSFSUB1(GRLEAS,grleas,INT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/grmdir.f
-------------------------------------------------------------------*/
-/*
-#define grmdir_ELEMS_1 ZTRINGV_NUM(1)
-#define grmdir_ELEMLEN_1 ZTRINGV_NUM(255)
-#define grmdir_ELEMS_2 ZTRINGV_NUM(1)
-#define grmdir_ELEMLEN_2 ZTRINGV_NUM(255)
-*/
-
-#define GRMDIR(A1,A2) CCALLSFSUB2(GRMDIR,grmdir,STRING,STRING,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/grmtd.f
-------------------------------------------------------------------*/
-
-#define GRMTD(A1,A2,A3) CCALLSFSUB3(GRMTD,grmtd,FLOATV,INT,PFLOAT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/grmul.f
-------------------------------------------------------------------*/
-
-#define GRMUL(A1,A2,A3) CCALLSFSUB3(GRMUL,grmul,FLOATV,INT,PFLOAT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/grndm.f
-------------------------------------------------------------------*/
-
-#define GRNDM(A1,A2) CCALLSFSUB2(GRNDM,grndm,PFLOAT,INT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/grndmq.f
-------------------------------------------------------------------*/
-/*
-#define grndmq_ELEMS_4 ZTRINGV_NUM(1)
-#define grndmq_ELEMLEN_4 ZTRINGV_NUM(255)
-*/
-
-#define GRNDMQ(A1,A2,A3,A4) CCALLSFSUB4(GRNDMQ,grndmq,PINT,PINT,INT,STRING,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/grot.f
-------------------------------------------------------------------*/
-
-#define GROT(A1,A2,A3) CCALLSFSUB3(GROT,grot,FLOATV,FLOATV,PFLOAT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/grout.f
-------------------------------------------------------------------*/
-/*
-#define grout_ELEMS_1 ZTRINGV_NUM(1)
-#define grout_ELEMLEN_1 ZTRINGV_NUM(255)
-#define grout_ELEMS_3 ZTRINGV_NUM(1)
-#define grout_ELEMLEN_3 ZTRINGV_NUM(255)
-*/
-
-#define GROUT(A1,A2,A3) CCALLSFSUB3(GROUT,grout,STRING,INT,STRING,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/grpar.f
-------------------------------------------------------------------*/
-
-#define GRPAR(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10) CCALLSFSUB10(GRPAR,grpar,FLOAT,INT,FLOATV,INT,FLOAT,FLOAT,INT,FLOATV,PINT,PFLOAT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/grsave.f
-------------------------------------------------------------------*/
-/*
-#define grsave_ELEMS_1 ZTRINGV_NUM(1)
-#define grsave_ELEMLEN_1 ZTRINGV_NUM(4)
-*/
-
-#define GRSAVE(A1,A2,A3,A4,A5) CCALLSFSUB5(GRSAVE,grsave,STRINGV,INT,INT,INT,INT,A1,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/grun.f
-------------------------------------------------------------------*/
-
-#define GRUN() CCALLSFSUB0(GRUN,grun)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gsagtr.f
-------------------------------------------------------------------*/
-
-#define GSAGTR(A1,A2,A3,A4) CCALLSFSUB4(GSAGTR,gsagtr,FLOATV,FLOATV,PFLOAT,INT,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gsahit.f
-------------------------------------------------------------------*/
-
-#define GSAHIT(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(GSAHIT,gsahit,INT,INT,INT,INTV,FLOATV,PINT,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gsaphi.f
-------------------------------------------------------------------*/
-
-#define GSAPHI(A1,A2,A3,A4) CCALLSFSUB4(GSAPHI,gsaphi,FLOATV,FLOAT,FLOAT,PFLOAT,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gsatt.f
-------------------------------------------------------------------*/
-/*
-#define gsatt_ELEMS_1 ZTRINGV_NUM(1)
-#define gsatt_ELEMLEN_1 ZTRINGV_NUM(4)
-#define gsatt_ELEMS_2 ZTRINGV_NUM(1)
-#define gsatt_ELEMLEN_2 ZTRINGV_NUM(4)
-*/
-
-#define GSATT(A1,A2,A3) CCALLSFSUB3(GSATT,gsatt,STRING,STRING,INT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gsave.f
-------------------------------------------------------------------*/
-/*
-#define gsave_ELEMS_2 ZTRINGV_NUM(1)
-#define gsave_ELEMLEN_2 ZTRINGV_NUM(4)
-*/
-
-#define GSAVE(A1,A2,A3,A4,A5) CCALLSFSUB5(GSAVE,gsave,INT,STRINGV,INT,INT,PINT,A1,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gscani.f
-------------------------------------------------------------------*/
-
-#define GSCANI() CCALLSFSUB0(GSCANI,gscani)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gscank.f
-------------------------------------------------------------------*/
-
-#define GSCANK() CCALLSFSUB0(GSCANK,gscank)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gscano.f
-------------------------------------------------------------------*/
-
-#define GSCANO() CCALLSFSUB0(GSCANO,gscano)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gscanu.f
-------------------------------------------------------------------*/
-
-#define GSCANU() CCALLSFSUB0(GSCANU,gscanu)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gschit.f
-------------------------------------------------------------------*/
-
-#define GSCHIT(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(GSCHIT,gschit,INT,INT,INT,INTV,FLOATV,INT,PINT,A1,A2,A3,A4,A5,A6,A7)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gschk.f
-------------------------------------------------------------------*/
-/*
-#define gschk_ELEMS_1 ZTRINGV_NUM(1)
-#define gschk_ELEMLEN_1 ZTRINGV_NUM(4)
-#define gschk_ELEMS_2 ZTRINGV_NUM(1)
-#define gschk_ELEMLEN_2 ZTRINGV_NUM(4)
-*/
-
-#define GSCHK(A1,A2,A3,A4) CCALLSFSUB4(GSCHK,gschk,STRING,STRING,INT,PINT,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gscvol.f
-------------------------------------------------------------------*/
-
-#define GSCVOL() CCALLSFSUB0(GSCVOL,gscvol)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gsdet.f
-------------------------------------------------------------------*/
-/*
-#define gsdet_ELEMS_1 ZTRINGV_NUM(1)
-#define gsdet_ELEMLEN_1 ZTRINGV_NUM(4)
-#define gsdet_ELEMS_2 ZTRINGV_NUM(1)
-#define gsdet_ELEMLEN_2 ZTRINGV_NUM(4)
-#define gsdet_ELEMS_4 ZTRINGV_NUM(1)
-#define gsdet_ELEMLEN_4 ZTRINGV_NUM(4)
-*/
-
-#define GSDET(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10) CCALLSFSUB10(GSDET,gsdet,STRINGV,STRINGV,INT,STRINGV,INTV,INT,INT,INT,PINT,PINT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gsdeta.f
-------------------------------------------------------------------*/
-/*
-#define gsdeta_ELEMS_1 ZTRINGV_NUM(1)
-#define gsdeta_ELEMLEN_1 ZTRINGV_NUM(4)
-#define gsdeta_ELEMS_2 ZTRINGV_NUM(1)
-#define gsdeta_ELEMLEN_2 ZTRINGV_NUM(4)
-#define gsdeta_ELEMS_3 ZTRINGV_NUM(1)
-#define gsdeta_ELEMLEN_3 ZTRINGV_NUM(4)
-*/
-
-#define GSDETA(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(GSDETA,gsdeta,STRING,STRING,STRING,INT,INT,PINT,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gsdetd.f
-------------------------------------------------------------------*/
-/*
-#define gsdetd_ELEMS_1 ZTRINGV_NUM(1)
-#define gsdetd_ELEMLEN_1 ZTRINGV_NUM(4)
-#define gsdetd_ELEMS_2 ZTRINGV_NUM(1)
-#define gsdetd_ELEMLEN_2 ZTRINGV_NUM(4)
-#define gsdetd_ELEMS_4 ZTRINGV_NUM(1)
-#define gsdetd_ELEMLEN_4 ZTRINGV_NUM(4)
-*/
-
-#define GSDETD(A1,A2,A3,A4,A5) CCALLSFSUB5(GSDETD,gsdetd,STRING,STRING,INT,STRINGV,INTV,A1,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gsdeth.f
-------------------------------------------------------------------*/
-/*
-#define gsdeth_ELEMS_1 ZTRINGV_NUM(1)
-#define gsdeth_ELEMLEN_1 ZTRINGV_NUM(4)
-#define gsdeth_ELEMS_2 ZTRINGV_NUM(1)
-#define gsdeth_ELEMLEN_2 ZTRINGV_NUM(4)
-#define gsdeth_ELEMS_4 ZTRINGV_NUM(1)
-#define gsdeth_ELEMLEN_4 ZTRINGV_NUM(4)
-*/
-
-#define GSDETH(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(GSDETH,gsdeth,STRING,STRING,INT,STRINGV,INTV,FLOATV,FLOATV,A1,A2,A3,A4,A5,A6,A7)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gsdetu.f
-------------------------------------------------------------------*/
-/*
-#define gsdetu_ELEMS_1 ZTRINGV_NUM(1)
-#define gsdetu_ELEMLEN_1 ZTRINGV_NUM(4)
-#define gsdetu_ELEMS_2 ZTRINGV_NUM(1)
-#define gsdetu_ELEMLEN_2 ZTRINGV_NUM(4)
-*/
-
-#define GSDETU(A1,A2,A3,A4) CCALLSFSUB4(GSDETU,gsdetu,STRING,STRING,INT,FLOATV,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gsdetv.f
-------------------------------------------------------------------*/
-/*
-#define gsdetv_ELEMS_1 ZTRINGV_NUM(1)
-#define gsdetv_ELEMLEN_1 ZTRINGV_NUM(4)
-#define gsdetv_ELEMS_2 ZTRINGV_NUM(1)
-#define gsdetv_ELEMLEN_2 ZTRINGV_NUM(4)
-*/
-
-#define GSDETV(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(GSDETV,gsdetv,STRING,STRING,INT,INT,INT,PINT,PINT,A1,A2,A3,A4,A5,A6,A7)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gsdigi.f
-------------------------------------------------------------------*/
-
-#define GSDIGI(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(GSDIGI,gsdigi,INT,INT,INTV,INT,INTV,INTV,PINT,A1,A2,A3,A4,A5,A6,A7)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gsdk.f
-------------------------------------------------------------------*/
-
-#define GSDK(A1,A2,A3) CCALLSFSUB3(GSDK,gsdk,INT,FLOATV,INTV,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gsdvn.f
-------------------------------------------------------------------*/
-/*
-#define gsdvn_ELEMS_1 ZTRINGV_NUM(1)
-#define gsdvn_ELEMLEN_1 ZTRINGV_NUM(4)
-#define gsdvn_ELEMS_2 ZTRINGV_NUM(1)
-#define gsdvn_ELEMLEN_2 ZTRINGV_NUM(4)
-*/
-
-#define GSDVN(A1,A2,A3,A4) CCALLSFSUB4(GSDVN,gsdvn,STRING,STRING,INT,INT,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gsdvn2.f
-------------------------------------------------------------------*/
-/*
-#define gsdvn2_ELEMS_1 ZTRINGV_NUM(1)
-#define gsdvn2_ELEMLEN_1 ZTRINGV_NUM(4)
-#define gsdvn2_ELEMS_2 ZTRINGV_NUM(1)
-#define gsdvn2_ELEMLEN_2 ZTRINGV_NUM(4)
-*/
-
-#define GSDVN2(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(GSDVN2,gsdvn2,STRING,STRING,INT,INT,PFLOAT,INT,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gsdvs.f
-------------------------------------------------------------------*/
-/*
-#define gsdvs_ELEMS_1 ZTRINGV_NUM(1)
-#define gsdvs_ELEMLEN_1 ZTRINGV_NUM(4)
-#define gsdvs_ELEMS_2 ZTRINGV_NUM(1)
-#define gsdvs_ELEMLEN_2 ZTRINGV_NUM(4)
-*/
-
-#define GSDVS(A1,A2,A3,A4,A5) CCALLSFSUB5(GSDVS,gsdvs,STRING,STRING,FLOAT,INT,INT,A1,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gsdvs2.f
-------------------------------------------------------------------*/
-/*
-#define gsdvs2_ELEMS_1 ZTRINGV_NUM(1)
-#define gsdvs2_ELEMLEN_1 ZTRINGV_NUM(4)
-#define gsdvs2_ELEMS_2 ZTRINGV_NUM(1)
-#define gsdvs2_ELEMLEN_2 ZTRINGV_NUM(4)
-*/
-
-#define GSDVS2(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(GSDVS2,gsdvs2,STRING,STRING,FLOAT,INT,FLOAT,INT,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gsdvt.f
-------------------------------------------------------------------*/
-/*
-#define gsdvt_ELEMS_1 ZTRINGV_NUM(1)
-#define gsdvt_ELEMLEN_1 ZTRINGV_NUM(4)
-#define gsdvt_ELEMS_2 ZTRINGV_NUM(1)
-#define gsdvt_ELEMLEN_2 ZTRINGV_NUM(4)
-*/
-
-#define GSDVT(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(GSDVT,gsdvt,STRING,STRING,FLOAT,INT,INT,INT,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gsdvt2.f
-------------------------------------------------------------------*/
-/*
-#define gsdvt2_ELEMS_1 ZTRINGV_NUM(1)
-#define gsdvt2_ELEMLEN_1 ZTRINGV_NUM(4)
-#define gsdvt2_ELEMS_2 ZTRINGV_NUM(1)
-#define gsdvt2_ELEMLEN_2 ZTRINGV_NUM(4)
-*/
-
-#define GSDVT2(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(GSDVT2,gsdvt2,STRING,STRING,FLOAT,INT,PFLOAT,INT,INT,A1,A2,A3,A4,A5,A6,A7)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gsdvx.f
-------------------------------------------------------------------*/
-/*
-#define gsdvx_ELEMS_1 ZTRINGV_NUM(1)
-#define gsdvx_ELEMLEN_1 ZTRINGV_NUM(4)
-#define gsdvx_ELEMS_2 ZTRINGV_NUM(1)
-#define gsdvx_ELEMLEN_2 ZTRINGV_NUM(4)
-*/
-
-#define GSDVX(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(GSDVX,gsdvx,STRING,STRING,INT,INT,FLOAT,FLOAT,INT,INT,A1,A2,A3,A4,A5,A6,A7,A8)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gsipar.f
-------------------------------------------------------------------*/
-
-#define GSIPAR(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(GSIPAR,gsipar,INT,INT,INT,INT,FLOATV,FLOATV,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gskine.f
-------------------------------------------------------------------*/
-
-#define GSKINE(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(GSKINE,gskine,FLOATV,INT,INT,FLOATV,INT,PINT,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gsking.f
-------------------------------------------------------------------*/
-
-#define GSKING(A1) CCALLSFSUB1(GSKING,gsking,INT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gsmate.f
-------------------------------------------------------------------*/
-/*
-#define gsmate_ELEMS_2 ZTRINGV_NUM(1)
-#define gsmate_ELEMLEN_2 ZTRINGV_NUM(255)
-*/
-
-#define GSMATE(A1,A2,A3,A4,A5,A6,A7,A8,A9) CCALLSFSUB9(GSMATE,gsmate,INT,STRING,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,FLOATV,INT,A1,A2,A3,A4,A5,A6,A7,A8,A9)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gsmixt.f
-------------------------------------------------------------------*/
-/*
-#define gsmixt_ELEMS_2 ZTRINGV_NUM(1)
-#define gsmixt_ELEMLEN_2 ZTRINGV_NUM(255)
-*/
-
-#define GSMIXT(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(GSMIXT,gsmixt,INT,STRING,FLOATV,FLOATV,FLOAT,INT,PFLOAT,A1,A2,A3,A4,A5,A6,A7)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gsnear.f
-------------------------------------------------------------------*/
-/*
-#define gsnear_ELEMS_1 ZTRINGV_NUM(1)
-#define gsnear_ELEMLEN_1 ZTRINGV_NUM(4)
-*/
-
-#define GSNEAR(A1,A2,A3,A4) CCALLSFSUB4(GSNEAR,gsnear,STRING,INT,INT,INTV,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gsnext.f
-------------------------------------------------------------------*/
-/*
-#define gsnext_ELEMS_1 ZTRINGV_NUM(1)
-#define gsnext_ELEMLEN_1 ZTRINGV_NUM(4)
-*/
-
-#define GSNEXT(A1,A2,A3,A4) CCALLSFSUB4(GSNEXT,gsnext,STRING,INT,INT,INTV,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gsngtr.f
-------------------------------------------------------------------*/
-
-#define GSNGTR(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(GSNGTR,gsngtr,FLOATV,FLOATV,INT,FLOAT,PFLOAT,FLOAT,INT,A1,A2,A3,A4,A5,A6,A7)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gsord.f
-------------------------------------------------------------------*/
-/*
-#define gsord_ELEMS_1 ZTRINGV_NUM(1)
-#define gsord_ELEMLEN_1 ZTRINGV_NUM(4)
-*/
-
-#define GSORD(A1,A2) CCALLSFSUB2(GSORD,gsord,STRING,INT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gspart.f
-------------------------------------------------------------------*/
-/*
-#define gspart_ELEMS_2 ZTRINGV_NUM(1)
-#define gspart_ELEMLEN_2 ZTRINGV_NUM(255)
-*/
-
-#define GSPART(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(GSPART,gspart,INT,STRING,INT,FLOAT,FLOAT,FLOAT,FLOATV,INT,A1,A2,A3,A4,A5,A6,A7,A8)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gspos.f
-------------------------------------------------------------------*/
-/*
-#define gspos_ELEMS_1 ZTRINGV_NUM(1)
-#define gspos_ELEMLEN_1 ZTRINGV_NUM(4)
-#define gspos_ELEMS_3 ZTRINGV_NUM(1)
-#define gspos_ELEMLEN_3 ZTRINGV_NUM(4)
-#define gspos_ELEMS_8 ZTRINGV_NUM(1)
-#define gspos_ELEMLEN_8 ZTRINGV_NUM(4)
-*/
-
-#define GSPOS(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(GSPOS,gspos,STRING,INT,STRING,FLOAT,FLOAT,FLOAT,INT,STRING,A1,A2,A3,A4,A5,A6,A7,A8)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gsposp.f
-------------------------------------------------------------------*/
-/*
-#define gsposp_ELEMS_1 ZTRINGV_NUM(1)
-#define gsposp_ELEMLEN_1 ZTRINGV_NUM(4)
-#define gsposp_ELEMS_3 ZTRINGV_NUM(1)
-#define gsposp_ELEMLEN_3 ZTRINGV_NUM(4)
-#define gsposp_ELEMS_8 ZTRINGV_NUM(1)
-#define gsposp_ELEMLEN_8 ZTRINGV_NUM(4)
-*/
-
-#define GSPOSP(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10) CCALLSFSUB10(GSPOSP,gsposp,STRING,INT,STRING,FLOAT,FLOAT,FLOAT,INT,STRING,FLOATV,INT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gsrotm.f
-------------------------------------------------------------------*/
-
-#define GSROTM(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(GSROTM,gsrotm,INT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,A1,A2,A3,A4,A5,A6,A7)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gsscan.f
-------------------------------------------------------------------*/
-
-#define GSSCAN(A1,A2) CCALLSFSUB2(GSSCAN,gsscan,INT,INT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gsstak.f
-------------------------------------------------------------------*/
-
-#define GSSTAK(A1) CCALLSFSUB1(GSSTAK,gsstak,INT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gstmed.f
-------------------------------------------------------------------*/
-/*
-#define gstmed_ELEMS_2 ZTRINGV_NUM(1)
-#define gstmed_ELEMLEN_2 ZTRINGV_NUM(255)
-*/
-
-#define GSTMED(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13) CCALLSFSUB13(GSTMED,gstmed,INT,STRING,INT,INT,INT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,FLOATV,INT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gstpar.f
-------------------------------------------------------------------*/
-/*
-#define gstpar_ELEMS_2 ZTRINGV_NUM(1)
-#define gstpar_ELEMLEN_2 ZTRINGV_NUM(255)
-*/
-
-#define GSTPAR(A1,A2,A3) CCALLSFSUB3(GSTPAR,gstpar,INT,STRING,FLOAT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gstrac.f
-------------------------------------------------------------------*/
-
-#define GSTRAC() CCALLSFSUB0(GSTRAC,gstrac)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gsunea.f
-------------------------------------------------------------------*/
-/*
-#define gsunea_ELEMS_1 ZTRINGV_NUM(1)
-#define gsunea_ELEMLEN_1 ZTRINGV_NUM(4)
-*/
-
-#define GSUNEA(A1,A2) CCALLSFSUB2(GSUNEA,gsunea,STRING,INT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gsvert.f
-------------------------------------------------------------------*/
-
-#define GSVERT(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(GSVERT,gsvert,FLOATV,INT,INT,FLOATV,INT,PINT,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gsvolu.f
-------------------------------------------------------------------*/
-/*
-#define gsvolu_ELEMS_1 ZTRINGV_NUM(1)
-#define gsvolu_ELEMLEN_1 ZTRINGV_NUM(4)
-#define gsvolu_ELEMS_2 ZTRINGV_NUM(1)
-#define gsvolu_ELEMLEN_2 ZTRINGV_NUM(4)
-*/
-
-#define GSVOLU(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(GSVOLU,gsvolu,STRING,STRING,INT,FLOATV,INT,PINT,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gsxyz.f
-------------------------------------------------------------------*/
-
-#define GSXYZ() CCALLSFSUB0(GSXYZ,gsxyz)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gtau.f
-------------------------------------------------------------------*/
-
-#define GTAU() CCALLSFSUB0(GTAU,gtau)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gtelec.f
-------------------------------------------------------------------*/
-
-#define GTELEC() CCALLSFSUB0(GTELEC,gtelec)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gtgama.f
-------------------------------------------------------------------*/
-
-#define GTGAMA() CCALLSFSUB0(GTGAMA,gtgama)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gthadr.f
-------------------------------------------------------------------*/
-
-#define GTHADR() CCALLSFSUB0(GTHADR,gthadr)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gtmedi.f
-------------------------------------------------------------------*/
-
-#define GTMEDI(A1,A2) CCALLSFSUB2(GTMEDI,gtmedi,FLOATV,PINT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gtmuon.f
-------------------------------------------------------------------*/
-
-#define GTMUON() CCALLSFSUB0(GTMUON,gtmuon)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gtneut.f
-------------------------------------------------------------------*/
-
-#define GTNEUT() CCALLSFSUB0(GTNEUT,gtneut)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gtnext.f
-------------------------------------------------------------------*/
-
-#define GTNEXT() CCALLSFSUB0(GTNEXT,gtnext)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gtnino.f
-------------------------------------------------------------------*/
-
-#define GTNINO() CCALLSFSUB0(GTNINO,gtnino)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gtrack.f
-------------------------------------------------------------------*/
-
-#define GTRACK() CCALLSFSUB0(GTRACK,gtrack)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gtrain.f
-------------------------------------------------------------------*/
-
-#define GTRAIN(A1,A2) CCALLSFSUB2(GTRAIN,gtrain,FLOATV,PFLOAT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gtreve.f
-------------------------------------------------------------------*/
-
-#define GTREVE() CCALLSFSUB0(GTREVE,gtreve)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gtrig.f
-------------------------------------------------------------------*/
-
-#define GTRIG() CCALLSFSUB0(GTRIG,gtrig)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gtrigc.f
-------------------------------------------------------------------*/
-
-#define GTRIGC() CCALLSFSUB0(GTRIGC,gtrigc)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gtrigi.f
-------------------------------------------------------------------*/
-
-#define GTRIGI() CCALLSFSUB0(GTRIGI,gtrigi)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gtrmul.f
-------------------------------------------------------------------*/
-
-#define GTRMUL(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(GTRMUL,gtrmul,FLOATV,FLOATV,FLOATV,INT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gtrnsf.f
-------------------------------------------------------------------*/
-
-#define GTRNSF(A1,A2,A3,A4) CCALLSFSUB4(GTRNSF,gtrnsf,FLOATV,FLOATV,FLOATV,PFLOAT,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gudcay.f
-------------------------------------------------------------------*/
-
-#define GUDCAY() CCALLSFSUB0(GUDCAY,gudcay)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gudigi.f
-------------------------------------------------------------------*/
-
-#define GUDIGI() CCALLSFSUB0(GUDIGI,gudigi)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gudtim.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN4(FLOAT,GUDTIM,gudtim,FLOAT,FLOAT,INT,FLOAT)
-#define GUDTIM(A2,A3,A4,A5) CCALLSFFUN4(GUDTIM,gudtim,FLOAT,FLOAT,INT,FLOAT,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gufld.f
-------------------------------------------------------------------*/
-
-#define GUFLD(A1,A2) CCALLSFSUB2(GUFLD,gufld,FLOATV,PFLOAT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/guhadr.f
-------------------------------------------------------------------*/
-
-#define GUHADR() CCALLSFSUB0(GUHADR,guhadr)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/guiget.f
-------------------------------------------------------------------*/
-
-#define GUIGET(A1,A2,A3) CCALLSFSUB3(GUIGET,guiget,INT,INT,INT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/guinme.f
-------------------------------------------------------------------*/
-
-#define GUINME(A1,A2,A3,A4) CCALLSFSUB4(GUINME,guinme,FLOATV,FLOAT,FLOATV,PINT,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/guinti.f
-------------------------------------------------------------------*/
-
-#define GUINTI() CCALLSFSUB0(GUINTI,guinti)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gukine.f
-------------------------------------------------------------------*/
-
-#define GUKINE() CCALLSFSUB0(GUKINE,gukine)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gunear.f
-------------------------------------------------------------------*/
-
-#define GUNEAR(A1,A2,A3,A4) CCALLSFSUB4(GUNEAR,gunear,INT,INT,FLOATV,INT,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gunliv.f
-------------------------------------------------------------------*/
-
-#define GUNLIV(A1,A2,A3) CCALLSFSUB3(GUNLIV,gunliv,INT,INT,INT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/guout.f
-------------------------------------------------------------------*/
-
-#define GUOUT() CCALLSFSUB0(GUOUT,guout)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gupara.f
-------------------------------------------------------------------*/
-
-#define GUPARA() CCALLSFSUB0(GUPARA,gupara)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/guphad.f
-------------------------------------------------------------------*/
-
-#define GUPHAD() CCALLSFSUB0(GUPHAD,guphad)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/guskip.f
-------------------------------------------------------------------*/
-
-#define GUSKIP(A1) CCALLSFSUB1(GUSKIP,guskip,PINT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gustep.f
-------------------------------------------------------------------*/
-
-#define GUSTEP() CCALLSFSUB0(GUSTEP,gustep)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/guswim.f
-------------------------------------------------------------------*/
-
-#define GUSWIM(A1,A2,A3,A4) CCALLSFSUB4(GUSWIM,guswim,FLOAT,FLOAT,FLOATV,FLOATV,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gutrak.f
-------------------------------------------------------------------*/
-
-#define GUTRAK() CCALLSFSUB0(GUTRAK,gutrak)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gutrev.f
-------------------------------------------------------------------*/
-
-#define GUTREV() CCALLSFSUB0(GUTREV,gutrev)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/guview.f
-------------------------------------------------------------------*/
-/*
-#define guview_ELEMS_3 ZTRINGV_NUM(1)
-#define guview_ELEMLEN_3 ZTRINGV_NUM(255)
-*/
-
-#define GUVIEW(A1,A2,A3,A4) CCALLSFSUB4(GUVIEW,guview,INT,INT,STRING,INT,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gvaviv.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN3(FLOAT,GVAVIV,gvaviv,FLOAT,FLOAT,FLOAT)
-#define GVAVIV(A2,A3,A4) CCALLSFFUN3(GVAVIV,gvaviv,FLOAT,FLOAT,FLOAT,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gviewf.f
-------------------------------------------------------------------*/
-
-#define GVIEWF(A1,A2,A3) CCALLSFSUB3(GVIEWF,gviewf,FLOATV,FLOATV,INT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gwork.f
-------------------------------------------------------------------*/
-
-#define GWORK(A1) CCALLSFSUB1(GWORK,gwork,INT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gxsi.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN1(FLOAT,GXSI,gxsi,FLOAT)
-#define GXSI(A2) CCALLSFFUN1(GXSI,gxsi,FLOAT,A2)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gzebra.f
-------------------------------------------------------------------*/
-
-#define GZEBRA(A1) CCALLSFSUB1(GZEBRA,gzebra,INT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/gzinit.f
-------------------------------------------------------------------*/
-
-#define GZINIT() CCALLSFSUB0(GZINIT,gzinit)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/hadden.f
-------------------------------------------------------------------*/
-
-#define HADDEN() CCALLSFSUB0(HADDEN,hadden)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/hadevv.f
-------------------------------------------------------------------*/
-
-#define HADEVV(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(HADEVV,hadevv,PINT,INT,INT,DOUBLE,DOUBLE,DOUBLE,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/hadrin.f
-------------------------------------------------------------------*/
-
-#define HADRIN(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(HADRIN,hadrin,INT,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,INT,A1,A2,A3,A4,A5,A6,A7)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/hadriv.f
-------------------------------------------------------------------*/
-
-#define HADRIV(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(HADRIV,hadriv,INT,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,INT,A1,A2,A3,A4,A5,A6,A7)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/hevhin.f
-------------------------------------------------------------------*/
-
-#define HEVHIN(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(HEVHIN,hevhin,PINT,INT,INT,DOUBLE,DOUBLE,DOUBLE,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/hinhev.f
-------------------------------------------------------------------*/
-
-#define HINHEV(A1,A2,A3,A4) CCALLSFSUB4(HINHEV,hinhev,INT,DOUBLE,DOUBLE,INT,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/hklass.f
-------------------------------------------------------------------*/
-
-#define HKLASS(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15,A16,A17,A18,A19,A20,A21,A22,A23,A24) CCALLSFSUB24(HKLASS,hklass,PINT,INT,INT,INT,INTV,INTV,INT,INT,INT,INT,INTV,PINT,PINT,PINT,PINT,PINT,PINT,DOUBLE,DOUBLE,INT,INT,INT,INT,INT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15,A16,A17,A18,A19,A20,A21,A22,A23,A24)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/hypero.f
-------------------------------------------------------------------*/
-
-#define HYPERO(A1,A2,A3,A4) CCALLSFSUB4(HYPERO,hypero,PINT,PINT,PDOUBLE,PDOUBLE,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/iefun.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN2(INT,IEFUN,iefun,DOUBLE,INT)
-#define IEFUN(A2,A3) CCALLSFFUN2(IEFUN,iefun,DOUBLE,INT,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/incini.f
-------------------------------------------------------------------*/
-
-#define INCINI() CCALLSFSUB0(INCINI,incini)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/index2.f
-------------------------------------------------------------------*/
-
-#define INDEX2(A1,A2,A3) CCALLSFSUB3(INDEX2,index2,INT,INT,INT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/kinpar.f
-------------------------------------------------------------------*/
-
-#define KINPAR(A1,A2,A3) CCALLSFSUB3(KINPAR,kinpar,DOUBLEV,DOUBLEV,DOUBLE,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/kmabs.f
-------------------------------------------------------------------*/
-
-#define KMABS(A1) CCALLSFSUB1(KMABS,kmabs,PINT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/kpois.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN1(INT,KPOIS,kpois,DOUBLE)
-#define KPOIS(A2) CCALLSFFUN1(KPOIS,kpois,DOUBLE,A2)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/limdat.f
-------------------------------------------------------------------*/
-
-#define LIMDAT() CCALLSFSUB0(LIMDAT,limdat)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/lortra.f
-------------------------------------------------------------------*/
-
-#define LORTRA(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(LORTRA,lortra,INT,INT,DOUBLE,DOUBLE,DOUBLE,DOUBLE,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/minv.f
-------------------------------------------------------------------*/
-
-#define MINV(A1,A2,A3,A4,A5) CCALLSFSUB5(MINV,minv,PFLOAT,INT,PFLOAT,PINT,PINT,A1,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/nbanh.f
-------------------------------------------------------------------*/
-
-#define NBANH(A1) CCALLSFSUB1(NBANH,nbanh,PINT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/nfac.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN1(INT,NFAC,nfac,INT)
-#define NFAC(A2) CCALLSFFUN1(NFAC,nfac,INT,A2)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/nizl.f
-------------------------------------------------------------------*/
-
-#define NIZL(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(NIZL,nizl,INT,DOUBLE,DOUBLE,DOUBLE,PDOUBLE,PDOUBLE,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/normal.f
-------------------------------------------------------------------*/
-
-#define NORMAL(A1) CCALLSFSUB1(NORMAL,normal,PFLOAT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/nucevv.f
-------------------------------------------------------------------*/
-
-#define NUCEVV(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(NUCEVV,nucevv,PINT,INT,DOUBLE,PDOUBLE,DOUBLE,DOUBLE,DOUBLE,A1,A2,A3,A4,A5,A6,A7)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/nucrec.f
-------------------------------------------------------------------*/
-
-#define NUCREC(A1,A2) CCALLSFSUB2(NUCREC,nucrec,PINT,INT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/nucrel.f
-------------------------------------------------------------------*/
-
-#define NUCREL(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(NUCREL,nucrel,INT,PDOUBLE,PDOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,A1,A2,A3,A4,A5,A6,A7,A8)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/nucriv.f
-------------------------------------------------------------------*/
-
-#define NUCRIV(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(NUCRIV,nucriv,INT,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,A1,A2,A3,A4,A5,A6,A7,A8)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/nudisv.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN5(INT,NUDISV,nudisv,DOUBLE,INT,DOUBLE,PDOUBLE,PDOUBLE)
-#define NUDISV(A2,A3,A4,A5,A6) CCALLSFFUN5(NUDISV,nudisv,DOUBLE,INT,DOUBLE,PDOUBLE,PDOUBLE,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/nuprel.f
-------------------------------------------------------------------*/
-
-#define NUPREL(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(NUPREL,nuprel,INT,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/parjet.f
-------------------------------------------------------------------*/
-
-#define PARJET(A1,A2) CCALLSFSUB2(PARJET,parjet,PINT,INT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/pbanh.f
-------------------------------------------------------------------*/
-
-#define PBANH(A1) CCALLSFSUB1(PBANH,pbanh,PINT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/pcsdat.f
-------------------------------------------------------------------*/
-
-#define PCSDAT(A1,A2,A3) CCALLSFSUB3(PCSDAT,pcsdat,INT,INT,LOGICAL,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/phasp.f
-------------------------------------------------------------------*/
-
-#define PHASP() CCALLSFSUB0(PHASP,phasp)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/phpnuc.f
-------------------------------------------------------------------*/
-
-#define PHPNUC() CCALLSFSUB0(PHPNUC,phpnuc)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/pimabs.f
-------------------------------------------------------------------*/
-
-#define PIMABS(A1) CCALLSFSUB1(PIMABS,pimabs,PINT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/plot.f
-------------------------------------------------------------------*/
-
-#define PLOT(A1,A2,A3,A4,A5,A6,A7,A8,A9) CCALLSFSUB9(PLOT,plot,DOUBLEV,DOUBLEV,INT,INT,INT,DOUBLE,DOUBLE,DOUBLE,DOUBLE,A1,A2,A3,A4,A5,A6,A7,A8,A9)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/plotdt.f
-------------------------------------------------------------------*/
-
-#define PLOTDT(A1,A2,A3,A4,A5,A6,A7,A8,A9) CCALLSFSUB9(PLOTDT,plotdt,DOUBLEV,DOUBLEV,INT,INT,INT,DOUBLE,DOUBLE,DOUBLE,DOUBLE,A1,A2,A3,A4,A5,A6,A7,A8,A9)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/pmltpc.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN6(FLOAT,PMLTPC,pmltpc,INT,INT,INT,INT,FLOAT,FLOAT)
-#define PMLTPC(A2,A3,A4,A5,A6,A7) CCALLSFFUN6(PMLTPC,pmltpc,INT,INT,INT,INT,FLOAT,FLOAT,A2,A3,A4,A5,A6,A7)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/pmprab.f
-------------------------------------------------------------------*/
-
-#define PMPRAB(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(PMPRAB,pmprab,INT,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,A1,A2,A3,A4,A5,A6,A7)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/poisso.f
-------------------------------------------------------------------*/
-
-#define POISSO(A1,A2) CCALLSFSUB2(POISSO,poisso,FLOAT,PINT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/qnrg.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN4(DOUBLE,QNRG,qnrg,DOUBLE,DOUBLE,DOUBLE,DOUBLE)
-#define QNRG(A2,A3,A4,A5) CCALLSFFUN4(QNRG,qnrg,DOUBLE,DOUBLE,DOUBLE,DOUBLE,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/raco.f
-------------------------------------------------------------------*/
-
-#define RACO(A1,A2,A3) CCALLSFSUB3(RACO,raco,PDOUBLE,PDOUBLE,PDOUBLE,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/rakeka.f
-------------------------------------------------------------------*/
-
-#define RAKEKA(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(RAKEKA,rakeka,INT,DOUBLE,DOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/rakekv.f
-------------------------------------------------------------------*/
-
-#define RAKEKV(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11) CCALLSFSUB11(RAKEKV,rakekv,INT,PDOUBLE,DOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,DOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/ranres.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN1(FLOAT,RANRES,ranres,FLOAT)
-#define RANRES(A2) CCALLSFFUN1(RANRES,ranres,FLOAT,A2)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/rbkekv.f
-------------------------------------------------------------------*/
-
-#define RBKEKV(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11) CCALLSFSUB11(RBKEKV,rbkekv,INT,PDOUBLE,DOUBLE,DOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,DOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/rchanv.f
-------------------------------------------------------------------*/
-
-#define RCHANV() CCALLSFSUB0(RCHANV,rchanv)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/rchanw.f
-------------------------------------------------------------------*/
-
-#define RCHANW() CCALLSFSUB0(RCHANW,rchanw)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/rotes2.f
-------------------------------------------------------------------*/
-
-#define ROTES2(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(ROTES2,rotes2,FLOAT,FLOAT,FLOAT,FLOAT,PFLOAT,INT,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/rtmi.f
-------------------------------------------------------------------*/
-
-#define RTMI(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(RTMI,rtmi,PFLOAT,PFLOAT,FLOAT,FLOAT,FLOAT,FLOAT,INT,PINT,A1,A2,A3,A4,A5,A6,A7,A8)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/samcst.f
-------------------------------------------------------------------*/
-
-#define SAMCST(A1,A2,A3) CCALLSFSUB3(SAMCST,samcst,INT,DOUBLE,PDOUBLE,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/selfab.f
-------------------------------------------------------------------*/
-
-#define SELFAB(A1) CCALLSFSUB1(SELFAB,selfab,PFLOAT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/setcur.f
-------------------------------------------------------------------*/
-
-#define SETCUR(A1) CCALLSFSUB1(SETCUR,setcur,INT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/settrk.f
-------------------------------------------------------------------*/
-
-#define SETTRK(A1) CCALLSFSUB1(SETTRK,settrk,INT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/sfecfe.f
-------------------------------------------------------------------*/
-
-#define SFECFE(A1,A2) CCALLSFSUB2(SFECFE,sfecfe,DOUBLE,DOUBLE,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/shptot.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN2(DOUBLE,SHPTOT,shptot,INT,DOUBLE)
-#define SHPTOT(A2,A3) CCALLSFFUN2(SHPTOT,shptot,INT,DOUBLE,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/sigel.f
-------------------------------------------------------------------*/
-
-#define SIGEL(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(SIGEL,sigel,INT,DOUBLE,DOUBLE,DOUBLE,PDOUBLE,PDOUBLE,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/sihael.f
-------------------------------------------------------------------*/
-
-#define SIHAEL(A1,A2,A3,A4,A5) CCALLSFSUB5(SIHAEL,sihael,INT,DOUBLE,DOUBLE,DOUBLE,PDOUBLE,A1,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/steep.f
-------------------------------------------------------------------*/
-
-#define STEEP(A1) CCALLSFSUB1(STEEP,steep,PFLOAT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/steeq.f
-------------------------------------------------------------------*/
-
-#define STEEQ(A1,A2) CCALLSFSUB2(STEEQ,steeq,PFLOAT,INT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/steer.f
-------------------------------------------------------------------*/
-
-#define STEER(A1) CCALLSFSUB1(STEER,steer,PFLOAT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/stees.f
-------------------------------------------------------------------*/
-
-#define STEES(A1,A2) CCALLSFSUB2(STEES,stees,PFLOAT,FLOAT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/stpair.f
-------------------------------------------------------------------*/
-
-#define STPAIR() CCALLSFSUB0(STPAIR,stpair)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/tchoic.f
-------------------------------------------------------------------*/
-
-#define TCHOIC(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10) CCALLSFSUB10(TCHOIC,tchoic,PDOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,INT,INT,INT,DOUBLE,DOUBLE,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/tdelay.f
-------------------------------------------------------------------*/
-
-#define TDELAY(A1) CCALLSFSUB1(TDELAY,tdelay,PFLOAT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/threpd.f
-------------------------------------------------------------------*/
-
-#define THREPD(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15,A16,A17,A18,A19) CCALLSFSUB19(THREPD,threpd,DOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15,A16,A17,A18,A19)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/trafo.f
-------------------------------------------------------------------*/
-
-#define TRAFO(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15) CCALLSFSUB15(TRAFO,trafo,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,PDOUBLE,DOUBLE,DOUBLE,DOUBLE,PDOUBLE,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/trans.f
-------------------------------------------------------------------*/
-
-#define TRANS(A1,A2,A3,A4,A5,A6,A7,A8,A9) CCALLSFSUB9(TRANS,trans,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,A1,A2,A3,A4,A5,A6,A7,A8,A9)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/ttrans.f
-------------------------------------------------------------------*/
-
-#define TTRANS(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10) CCALLSFSUB10(TTRANS,ttrans,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/twob.f
-------------------------------------------------------------------*/
-
-#define TWOB(A1,A2,A3) CCALLSFSUB3(TWOB,twob,INT,INT,FLOAT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/twoclu.f
-------------------------------------------------------------------*/
-
-#define TWOCLU(A1,A2,A3) CCALLSFSUB3(TWOCLU,twoclu,INT,INT,FLOAT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/twopad.f
-------------------------------------------------------------------*/
-
-#define TWOPAD(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13) CCALLSFSUB13(TWOPAD,twopad,DOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,DOUBLE,DOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,DOUBLE,DOUBLE,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/twopar.f
-------------------------------------------------------------------*/
-
-#define TWOPAR(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15,A16,A17,A18) CCALLSFSUB18(TWOPAR,twopar,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,DOUBLE,PDOUBLE,DOUBLE,PDOUBLE,INT,INT,DOUBLE,DOUBLE,DOUBLE,INT,DOUBLE,DOUBLE,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15,A16,A17,A18)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/vecsub.f
-------------------------------------------------------------------*/
-
-#define ADD(A1,A2,A3) CCALLSFSUB3(ADD,add,INT,INT,INT,A1,A2,A3)
-
-
-#define SUB(A1,A2,A3) CCALLSFSUB3(SUB,sub,INT,INT,INT,A1,A2,A3)
-
-
-#define LOR(A1,A2,A3) CCALLSFSUB3(LOR,lor,INT,INT,INT,A1,A2,A3)
-
-
-#define LENGTX(A1,A2) CCALLSFSUB2(LENGTX,lengtx,INT,PFLOAT,A1,A2)
-
-
-#define ANG(A1,A2,A3,A4) CCALLSFSUB4(ANG,ang,INT,INT,PFLOAT,PFLOAT,A1,A2,A3,A4)
-
-
-#define DEFS(A1,A2,A3) CCALLSFSUB3(DEFS,defs,INT,INT,INT,A1,A2,A3)
-
-
-#define TRAC(A1,A2,A3) CCALLSFSUB3(TRAC,trac,INT,INT,INT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/verein.f
-------------------------------------------------------------------*/
-
-#define VEREIN(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15,A16,A17,A18,A19,A20,A21,A22,A23,A24,A25,A26,A27,A28,A29,A30,A31,A32,A33,A34) CCALLSFSUB34(VEREIN,verein,PINT,PINT,INT,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,INT,INT,INT,INT,PINT,INT,INTV,INTV,PINT,PINT,PINT,PINT,PINT,PINT,DOUBLE,DOUBLE,DOUBLE,INT,INT,INT,INT,INT,INT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15,A16,A17,A18,A19,A20,A21,A22,A23,A24,A25,A26,A27,A28,A29,A30,A31,A32,A33,A34)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/xlamb.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN3(DOUBLE,XLAMB,xlamb,DOUBLE,DOUBLE,DOUBLE)
-#define XLAMB(A2,A3,A4) CCALLSFFUN3(XLAMB,xlamb,DOUBLE,DOUBLE,DOUBLE,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : /cern/new/src/cfs/geant315/zeregs.f
-------------------------------------------------------------------*/
-
-#define ZEREGS() CCALLSFSUB0(ZEREGS,zeregs)
-
diff --git a/src/cfortran/geant321.h b/src/cfortran/geant321.h
deleted file mode 100644
index 8b6173b..0000000
--- a/src/cfortran/geant321.h
+++ /dev/null
@@ -1,6101 +0,0 @@
-/*------------------------------------------------------------------
-fortran filename : abbrch.f
-------------------------------------------------------------------*/
-
-#define ABBRCH(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15,A16,A17,A18,A19,A20,A21,A22,A23,A24,A25,A26,A27,A28,A29,A30,A31,A32,A33,A34,A35) CCALLSFSUB35(ABBRCH,abbrch,INT,INT,PINT,INT,DOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PINT,PINT,PDOUBLE,PINT,PINT,PINT,PINT,PDOUBLE,PDOUBLE,DOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PINT,DOUBLE,DOUBLE,INT,INT,INT,INT,INT,INT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15,A16,A17,A18,A19,A20,A21,A22,A23,A24,A25,A26,A27,A28,A29,A30,A31,A32,A33,A34,A35)
-
-/*------------------------------------------------------------------
-fortran filename : ainel.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN5(DOUBLE,AINEL,ainel,INT,INT,DOUBLE,DOUBLE,DOUBLE)
-#define AINEL(A2,A3,A4,A5,A6) CCALLSFFUN5(AINEL,ainel,INT,INT,DOUBLE,DOUBLE,DOUBLE,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : akeka.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN3(DOUBLE,AKEKA,akeka,INT,DOUBLE,DOUBLE)
-#define AKEKA(A2,A3,A4) CCALLSFFUN3(AKEKA,akeka,INT,DOUBLE,DOUBLE,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : altra.f
-------------------------------------------------------------------*/
-
-#define ALTRA(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13) CCALLSFSUB13(ALTRA,altra,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13)
-
-/*------------------------------------------------------------------
-fortran filename : altraf.f
-------------------------------------------------------------------*/
-
-#define ALTRAF(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15) CCALLSFSUB15(ALTRAF,altraf,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15)
-
-/*------------------------------------------------------------------
-fortran filename : amga.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN1(DOUBLE,AMGA,amga,INT)
-#define AMGA(A2) CCALLSFFUN1(AMGA,amga,INT,A2)
-
-/*------------------------------------------------------------------
-fortran filename : angcdf.f
-------------------------------------------------------------------*/
-
-#define ANGCDF(A1,A2,A3) CCALLSFSUB3(ANGCDF,angcdf,PFLOAT,INTV,INT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : ankeka.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN4(DOUBLE,ANKEKA,ankeka,INT,DOUBLE,DOUBLE,DOUBLE)
-#define ANKEKA(A2,A3,A4,A5) CCALLSFFUN4(ANKEKA,ankeka,INT,DOUBLE,DOUBLE,DOUBLE,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : atomas.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN2(FLOAT,ATOMAS,atomas,FLOAT,FLOAT)
-#define ATOMAS(A2,A3) CCALLSFFUN2(ATOMAS,atomas,FLOAT,FLOAT,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : azirn.f
-------------------------------------------------------------------*/
-
-#define AZIRN(A1,A2) CCALLSFSUB2(AZIRN,azirn,PFLOAT,PFLOAT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : bamjev.f
-------------------------------------------------------------------*/
-
-#define BAMJEV(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(BAMJEV,bamjev,PINT,INT,INT,INT,INT,DOUBLE,INT,A1,A2,A3,A4,A5,A6,A7)
-
-/*------------------------------------------------------------------
-fortran filename : bankr.f
-------------------------------------------------------------------*/
-
-#define BANKR(A1,A2,A3) CCALLSFSUB3(BANKR,bankr,FLOATV,INTV,INT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : barier.f
-------------------------------------------------------------------*/
-
-#define BARIER(A1,A2,A3,A4,A5) CCALLSFSUB5(BARIER,barier,INT,INT,FLOAT,FLOAT,PFLOAT,A1,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : beexi.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN3(DOUBLE,BEEXI,beexi,INT,DOUBLE,DOUBLE)
-#define BEEXI(A2,A3,A4) CCALLSFFUN3(BEEXI,beexi,INT,DOUBLE,DOUBLE,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : bekeka.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN4(DOUBLE,BEKEKA,bekeka,INT,DOUBLE,DOUBLE,DOUBLE)
-#define BEKEKA(A2,A3,A4,A5) CCALLSFFUN4(BEKEKA,bekeka,INT,DOUBLE,DOUBLE,DOUBLE,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : berttp.f
-------------------------------------------------------------------*/
-
-#define BERTTP() CCALLSFSUB0(BERTTP,berttp)
-
-/*------------------------------------------------------------------
-fortran filename : beta.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN3(DOUBLE,BETA,beta,DOUBLE,DOUBLE,DOUBLE)
-#define BETA(A2,A3,A4) CCALLSFFUN3(BETA,beta,DOUBLE,DOUBLE,DOUBLE,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : betarn.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN2(DOUBLE,BETARN,betarn,DOUBLE,DOUBLE)
-#define BETARN(A2,A3) CCALLSFFUN2(BETARN,betarn,DOUBLE,DOUBLE,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : betrst.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN4(DOUBLE,BETRST,betrst,DOUBLE,DOUBLE,PDOUBLE,PDOUBLE)
-#define BETRST(A2,A3,A4,A5) CCALLSFFUN4(BETRST,betrst,DOUBLE,DOUBLE,PDOUBLE,PDOUBLE,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : bimsel.f
-------------------------------------------------------------------*/
-
-#define BIMSEL(A1,A2,A3,A4,A5) CCALLSFSUB5(BIMSEL,bimsel,INT,DOUBLE,DOUBLE,DOUBLE,LOGICAL,A1,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : bkeka.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN3(DOUBLE,BKEKA,bkeka,INT,DOUBLE,DOUBLE)
-#define BKEKA(A2,A3,A4) CCALLSFFUN3(BKEKA,bkeka,INT,DOUBLE,DOUBLE,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : bklass.f
-------------------------------------------------------------------*/
-
-#define BKLASS(A1,A2,A3,A4,A5) CCALLSFSUB5(BKLASS,bklass,INT,INT,INT,PINT,PINT,A1,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : bnkeka.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN4(DOUBLE,BNKEKA,bnkeka,INT,DOUBLE,DOUBLE,DOUBLE)
-#define BNKEKA(A2,A3,A4,A5) CCALLSFFUN4(BNKEKA,bnkeka,INT,DOUBLE,DOUBLE,DOUBLE,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : cadig.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN1(FLOAT,CADIG,cadig,FLOAT)
-#define CADIG(A2) CCALLSFFUN1(CADIG,cadig,FLOAT,A2)
-
-/*------------------------------------------------------------------
-fortran filename : calumo.f
-------------------------------------------------------------------*/
-
-#define CALUMO(A1,A2) CCALLSFSUB2(CALUMO,calumo,INT,INT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : calumv.f
-------------------------------------------------------------------*/
-
-#define CALUMV(A1,A2) CCALLSFSUB2(CALUMV,calumv,INT,INT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : cangle.f
-------------------------------------------------------------------*/
-
-#define CANGLE(A1,A2,A3,A4,A5) CCALLSFSUB5(CANGLE,cangle,FLOATV,INTV,FLOAT,PFLOAT,INT,A1,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : captur.f
-------------------------------------------------------------------*/
-
-#define CAPTUR(A1) CCALLSFSUB1(CAPTUR,captur,PINT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : casal0.f
-------------------------------------------------------------------*/
-
-#define CASAL0(A1,A2,A3) CCALLSFSUB3(CASAL0,casal0,INT,PINT,PINT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : casaom.f
-------------------------------------------------------------------*/
-
-#define CASAOM(A1,A2,A3) CCALLSFSUB3(CASAOM,casaom,INT,INT,INT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : casasm.f
-------------------------------------------------------------------*/
-
-#define CASASM(A1,A2,A3) CCALLSFSUB3(CASASM,casasm,INT,PINT,PINT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : casasp.f
-------------------------------------------------------------------*/
-
-#define CASASP(A1,A2,A3) CCALLSFSUB3(CASASP,casasp,INT,PINT,PINT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : casax0.f
-------------------------------------------------------------------*/
-
-#define CASAX0(A1,A2,A3) CCALLSFSUB3(CASAX0,casax0,INT,INT,INT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : casaxm.f
-------------------------------------------------------------------*/
-
-#define CASAXM(A1,A2,A3) CCALLSFSUB3(CASAXM,casaxm,INT,INT,INT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : casfrg.f
-------------------------------------------------------------------*/
-
-#define CASFRG(A1,A2,A3) CCALLSFSUB3(CASFRG,casfrg,PINT,INT,INT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : cask0.f
-------------------------------------------------------------------*/
-
-#define CASK0(A1,A2,A3) CCALLSFSUB3(CASK0,cask0,INT,PINT,PINT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : cask0b.f
-------------------------------------------------------------------*/
-
-#define CASK0B(A1,A2,A3) CCALLSFSUB3(CASK0B,cask0b,INT,PINT,PINT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : caskm.f
-------------------------------------------------------------------*/
-
-#define CASKM(A1,A2,A3) CCALLSFSUB3(CASKM,caskm,INT,PINT,PINT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : caskp.f
-------------------------------------------------------------------*/
-
-#define CASKP(A1,A2,A3) CCALLSFSUB3(CASKP,caskp,INT,PINT,PINT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : casl0.f
-------------------------------------------------------------------*/
-
-#define CASL0(A1,A2,A3) CCALLSFSUB3(CASL0,casl0,INT,PINT,PINT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : casn.f
-------------------------------------------------------------------*/
-
-#define CASN(A1,A2,A3) CCALLSFSUB3(CASN,casn,INT,PINT,PINT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : casnb.f
-------------------------------------------------------------------*/
-
-#define CASNB(A1,A2,A3) CCALLSFSUB3(CASNB,casnb,INT,PINT,PINT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : casom.f
-------------------------------------------------------------------*/
-
-#define CASOM(A1,A2,A3) CCALLSFSUB3(CASOM,casom,INT,PINT,PINT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : casp.f
-------------------------------------------------------------------*/
-
-#define CASP(A1,A2,A3) CCALLSFSUB3(CASP,casp,INT,PINT,PINT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : caspb.f
-------------------------------------------------------------------*/
-
-#define CASPB(A1,A2,A3) CCALLSFSUB3(CASPB,caspb,INT,PINT,PINT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : caspim.f
-------------------------------------------------------------------*/
-
-#define CASPIM(A1,A2,A3) CCALLSFSUB3(CASPIM,caspim,INT,PINT,PINT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : caspip.f
-------------------------------------------------------------------*/
-
-#define CASPIP(A1,A2,A3) CCALLSFSUB3(CASPIP,caspip,INT,PINT,PINT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : cassm.f
-------------------------------------------------------------------*/
-
-#define CASSM(A1,A2,A3) CCALLSFSUB3(CASSM,cassm,INT,PINT,PINT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : cassp.f
-------------------------------------------------------------------*/
-
-#define CASSP(A1,A2,A3) CCALLSFSUB3(CASSP,cassp,INT,PINT,PINT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : casx0.f
-------------------------------------------------------------------*/
-
-#define CASX0(A1,A2,A3) CCALLSFSUB3(CASX0,casx0,INT,PINT,PINT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : casxm.f
-------------------------------------------------------------------*/
-
-#define CASXM(A1,A2,A3) CCALLSFSUB3(CASXM,casxm,INT,PINT,PINT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : cevap.f
-------------------------------------------------------------------*/
-
-#define CEVAP(A1,A2,A3,A4,A5) CCALLSFSUB5(CEVAP,cevap,FLOAT,FLOAT,FLOAT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : cevap1.f
-------------------------------------------------------------------*/
-
-#define CEVAP1(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(CEVAP1,cevap1,FLOAT,FLOAT,FLOAT,FLOAT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : cgaffi.f
-------------------------------------------------------------------*/
-
-#define CGAFFI(A1,A2) CCALLSFSUB2(CGAFFI,cgaffi,PFLOAT,PFLOAT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : cgbfit.f
-------------------------------------------------------------------*/
-
-#define CGBFIT(A1,A2,A3) CCALLSFSUB3(CGBFIT,cgbfit,FLOATV,FLOATV,PINT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : cgbint.f
-------------------------------------------------------------------*/
-
-#define CGBINT(A1,A2,A3,A4,A5) CCALLSFSUB5(CGBINT,cgbint,FLOATV,FLOATV,INT,PFLOAT,PINT,A1,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : cgbmmt.f
-------------------------------------------------------------------*/
-
-#define CGBMMT(A1,A2,A3) CCALLSFSUB3(CGBMMT,cgbmmt,FLOATV,FLOATV,PINT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : cgbool.f
-------------------------------------------------------------------*/
-
-#define CGBOOL(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(CGBOOL,cgbool,INT,INT,FLOATV,FLOATV,INT,PFLOAT,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : cgbox.f
-------------------------------------------------------------------*/
-
-#define CGBOX(A1,A2,A3,A4,A5) CCALLSFSUB5(CGBOX,cgbox,PFLOAT,INT,INT,INT,PFLOAT,A1,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : cgbrik.f
-------------------------------------------------------------------*/
-
-#define CGBRIK(A1,A2,A3,A4,A5) CCALLSFSUB5(CGBRIK,cgbrik,FLOAT,FLOAT,FLOAT,INT,PFLOAT,A1,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : cgbsea.f
-------------------------------------------------------------------*/
-
-#define CGBSEA(A1,A2,A3,A4) CCALLSFSUB4(CGBSEA,cgbsea,FLOATV,FLOATV,PINT,PINT,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : cgbsec.f
-------------------------------------------------------------------*/
-
-#define CGBSEC(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(CGBSEC,cgbsec,FLOATV,FLOATV,FLOATV,FLOATV,INT,PFLOAT,PINT,A1,A2,A3,A4,A5,A6,A7)
-
-/*------------------------------------------------------------------
-fortran filename : cgbsor.f
-------------------------------------------------------------------*/
-
-#define CGBSOR(A1,A2) CCALLSFSUB2(CGBSOR,cgbsor,PINT,PFLOAT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : cgbsub.f
-------------------------------------------------------------------*/
-
-#define CGBSUB(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(CGBSUB,cgbsub,INT,FLOATV,PFLOAT,INT,PFLOAT,PINT,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : cgbtef.f
-------------------------------------------------------------------*/
-
-#define CGBTEF(A1,A2,A3,A4,A5) CCALLSFSUB5(CGBTEF,cgbtef,INT,INT,FLOATV,FLOATV,PFLOAT,A1,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : cgbtfp.f
-------------------------------------------------------------------*/
-
-#define CGBTFP(A1,A2,A3) CCALLSFSUB3(CGBTFP,cgbtfp,FLOATV,FLOATV,PFLOAT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : cgbttt.f
-------------------------------------------------------------------*/
-/*
-#define cgbttt_ELEMS_1 ZTRINGV_NUM(1)
-#define cgbttt_ELEMLEN_1 ZTRINGV_NUM(2)
-*/
-
-#define CGBTTT(A1,A2,A3,A4,A5) CCALLSFSUB5(CGBTTT,cgbttt,STRING,FLOAT,FLOAT,INT,PINT,A1,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : cgcev.f
-------------------------------------------------------------------*/
-
-#define CGCEV(A1,A2) CCALLSFSUB2(CGCEV,cgcev,INT,FLOATV,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : cgcopy.f
-------------------------------------------------------------------*/
-
-#define CGCOPY(A1,A2,A3) CCALLSFSUB3(CGCOPY,cgcopy,FLOATV,INT,PFLOAT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : cgelli.f
-------------------------------------------------------------------*/
-
-#define CGELLI(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(CGELLI,cgelli,FLOAT,FLOAT,FLOAT,INT,INT,INT,PFLOAT,A1,A2,A3,A4,A5,A6,A7)
-
-/*------------------------------------------------------------------
-fortran filename : cgfac2.f
-------------------------------------------------------------------*/
-
-#define CGFAC2(A1,A2,A3,A4) CCALLSFSUB4(CGFAC2,cgfac2,PFLOAT,PFLOAT,PFLOAT,INT,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : cgfaco.f
-------------------------------------------------------------------*/
-
-#define CGFACO(A1,A2,A3,A4,A5) CCALLSFSUB5(CGFACO,cgfaco,PFLOAT,PFLOAT,INT,INT,FLOAT,A1,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : cgfare.f
-------------------------------------------------------------------*/
-
-#define CGFARE(A1,A2,A3,A4) CCALLSFSUB4(CGFARE,cgfare,INT,FLOATV,PINT,INT,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : cgfvis.f
-------------------------------------------------------------------*/
-
-#define CGFVIS(A1,A2,A3,A4) CCALLSFSUB4(CGFVIS,cgfvis,INT,FLOATV,PINT,INT,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : cghcre.f
-------------------------------------------------------------------*/
-
-#define CGHCRE(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(CGHCRE,cghcre,INT,INT,FLOATV,FLOATV,INT,PFLOAT,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : cghdfa.f
-------------------------------------------------------------------*/
-
-#define CGHDFA(A1,A2,A3,A4,A5) CCALLSFSUB5(CGHDFA,cghdfa,INT,PFLOAT,INTV,INTV,PFLOAT,A1,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : cghend.f
-------------------------------------------------------------------*/
-
-#define CGHEND(A1,A2,A3) CCALLSFSUB3(CGHEND,cghend,PFLOAT,PINT,PFLOAT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : cgheva.f
-------------------------------------------------------------------*/
-
-#define CGHEVA(A1,A2) CCALLSFSUB2(CGHEVA,cgheva,FLOATV,PFLOAT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : cghins.f
-------------------------------------------------------------------*/
-
-#define CGHINS(A1,A2,A3) CCALLSFSUB3(CGHINS,cghins,FLOATV,PFLOAT,INT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : cghmov.f
-------------------------------------------------------------------*/
-
-#define CGHMOV(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(CGHMOV,cghmov,PFLOAT,PFLOAT,INT,INT,PFLOAT,PINT,PINT,A1,A2,A3,A4,A5,A6,A7)
-
-/*------------------------------------------------------------------
-fortran filename : cghpla.f
-------------------------------------------------------------------*/
-
-#define CGHPLA(A1,A2,A3) CCALLSFSUB3(CGHPLA,cghpla,INTV,PFLOAT,PFLOAT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : cghren.f
-------------------------------------------------------------------*/
-
-#define CGHREN(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(CGHREN,cghren,INT,INT,INT,INT,PFLOAT,PINT,PINT,PINT,A1,A2,A3,A4,A5,A6,A7,A8)
-
-/*------------------------------------------------------------------
-fortran filename : cghshi.f
-------------------------------------------------------------------*/
-
-#define CGHSHI(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(CGHSHI,cghshi,INT,PINT,PINT,INTV,PINT,PINT,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : cghsiz.f
-------------------------------------------------------------------*/
-
-#define CGHSIZ(A1,A2,A3,A4,A5) CCALLSFSUB5(CGHSIZ,cghsiz,FLOATV,INT,PINT,PINT,INT,A1,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : cghtre.f
-------------------------------------------------------------------*/
-
-#define CGHTRE(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(CGHTRE,cghtre,INT,PFLOAT,PINT,PINT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : cginve.f
-------------------------------------------------------------------*/
-
-#define CGINVE(A1) CCALLSFSUB1(CGINVE,cginve,PFLOAT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : cgmnmx.f
-------------------------------------------------------------------*/
-
-#define CGMNMX(A1,A2,A3) CCALLSFSUB3(CGMNMX,cgmnmx,FLOATV,PFLOAT,PFLOAT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : cgpers.f
-------------------------------------------------------------------*/
-
-#define CGPERS(A1) CCALLSFSUB1(CGPERS,cgpers,PFLOAT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : cgrifl.f
-------------------------------------------------------------------*/
-
-#define CGRIFL(A1,A2) CCALLSFSUB2(CGRIFL,cgrifl,PFLOAT,PFLOAT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : cgsaan.f
-------------------------------------------------------------------*/
-
-#define CGSAAN(A1,A2,A3,A4,A5) CCALLSFSUB5(CGSAAN,cgsaan,FLOAT,FLOAT,INT,INT,PINT,A1,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : cgscop.f
-------------------------------------------------------------------*/
-
-#define CGSCOP(A1,A2,A3,A4) CCALLSFSUB4(CGSCOP,cgscop,INT,FLOATV,PFLOAT,PFLOAT,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : cgshel.f
-------------------------------------------------------------------*/
-
-#define CGSHEL(A1,A2,A3,A4) CCALLSFSUB4(CGSHEL,cgshel,FLOAT,FLOAT,PINT,PFLOAT,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : cgshif.f
-------------------------------------------------------------------*/
-
-#define CGSHIF(A1,A2,A3,A4) CCALLSFSUB4(CGSHIF,cgshif,FLOAT,FLOAT,FLOAT,FLOATV,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : cgsize.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN4(FLOAT,CGSIZE,cgsize,INT,INT,INTV,INTV)
-#define CGSIZE(A2,A3,A4,A5) CCALLSFFUN4(CGSIZE,cgsize,INT,INT,INTV,INTV,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : cgslic.f
-------------------------------------------------------------------*/
-
-#define CGSLIC(A1,A2,A3,A4) CCALLSFSUB4(CGSLIC,cgslic,FLOATV,FLOATV,INT,PFLOAT,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : cgsnor.f
-------------------------------------------------------------------*/
-
-#define CGSNOR(A1) CCALLSFSUB1(CGSNOR,cgsnor,PFLOAT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : cgsphe.f
-------------------------------------------------------------------*/
-
-#define CGSPHE(A1,A2,A3,A4,A5) CCALLSFSUB5(CGSPHE,cgsphe,FLOAT,INT,INT,INT,FLOATV,A1,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : cgsub.f
-------------------------------------------------------------------*/
-
-#define CGSUB(A1,A2,A3,A4) CCALLSFSUB4(CGSUB,cgsub,FLOATV,FLOATV,INT,FLOATV,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : cgtset.f
-------------------------------------------------------------------*/
-
-#define CGTSET(A1,A2,A3) CCALLSFSUB3(CGTSET,cgtset,INT,PFLOAT,PINT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : cgtstr.f
-------------------------------------------------------------------*/
-
-#define CGTSTR(A1,A2) CCALLSFSUB2(CGTSTR,cgtstr,FLOATV,PINT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : cgvedg.f
-------------------------------------------------------------------*/
-
-#define CGVEDG(A1,A2,A3,A4) CCALLSFSUB4(CGVEDG,cgvedg,INT,FLOATV,FLOATV,PINT,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : cgvhed.f
-------------------------------------------------------------------*/
-
-#define CGVHED(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(CGVHED,cgvhed,PFLOAT,INTV,INTV,PFLOAT,PINT,PINT,FLOATV,FLOATV,A1,A2,A3,A4,A5,A6,A7,A8)
-
-/*------------------------------------------------------------------
-fortran filename : cgvtef.f
-------------------------------------------------------------------*/
-
-#define CGVTEF(A1,A2,A3) CCALLSFSUB3(CGVTEF,cgvtef,INTV,PFLOAT,PINT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : cgvtin.f
-------------------------------------------------------------------*/
-
-#define CGVTIN(A1,A2,A3) CCALLSFSUB3(CGVTIN,cgvtin,FLOAT,FLOAT,INT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : cgwire.f
-------------------------------------------------------------------*/
-
-#define CGWIRE(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(CGWIRE,cgwire,FLOATV,INT,INT,INT,PFLOAT,INT,INTV,A1,A2,A3,A4,A5,A6,A7)
-
-/*------------------------------------------------------------------
-fortran filename : cgwsor.f
-------------------------------------------------------------------*/
-
-#define CGWSOR(A1,A2) CCALLSFSUB2(CGWSOR,cgwsor,PINT,PFLOAT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : cgzre.f
-------------------------------------------------------------------*/
-
-#define CGZRE(A1,A2,A3) CCALLSFSUB3(CGZRE,cgzre,INT,PFLOAT,PINT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : cgzrev.f
-------------------------------------------------------------------*/
-
-#define CGZREV(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(CGZREV,cgzrev,PFLOAT,FLOAT,FLOAT,INT,INT,PFLOAT,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : chanwt.f
-------------------------------------------------------------------*/
-
-#define CHANWT() CCALLSFSUB0(CHANWT,chanwt)
-
-/*------------------------------------------------------------------
-fortran filename : chkzeb.f
-------------------------------------------------------------------*/
-
-#define CHKZEB(A1,A2) CCALLSFSUB2(CHKZEB,chkzeb,INT,INT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : cinema.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN1(FLOAT,CINEMA,cinema,FLOAT)
-#define CINEMA(A2) CCALLSFFUN1(CINEMA,cinema,FLOAT,A2)
-
-/*------------------------------------------------------------------
-fortran filename : clear.f
-------------------------------------------------------------------*/
-
-#define CLEAR(A1,A2,A3) CCALLSFSUB3(CLEAR,clear,PINT,INT,INT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : cmlabe.f
-------------------------------------------------------------------*/
-
-#define CMLABE(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(CMLABE,cmlabe,FLOATV,INTV,FLOAT,INT,INT,PFLOAT,FLOAT,INT,A1,A2,A3,A4,A5,A6,A7,A8)
-
-/*------------------------------------------------------------------
-fortran filename : cmlabi.f
-------------------------------------------------------------------*/
-
-#define CMLABI(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10) CCALLSFSUB10(CMLABI,cmlabi,FLOATV,INTV,FLOAT,INT,INT,PFLOAT,FLOAT,PINT,INT,INT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10)
-
-/*------------------------------------------------------------------
-fortran filename : cohert.f
-------------------------------------------------------------------*/
-
-#define COHERT(A1,A2,A3) CCALLSFSUB3(COHERT,cohert,INT,INT,FLOAT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : colisn.f
-------------------------------------------------------------------*/
-
-#define COLISN(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15,A16,A17,A18,A19,A20,A21,A22,A23,A24,A25,A26,A27,A28,A29,A30,A31,A32,A33,A34,A35,A36,A37,A38,A39,A40,A41,A42,A43,A44,A45,A46,A47,A48) CCALLSFSUB48(COLISN,colisn,FLOATV,INTV,INTV,INTV,INTV,INTV,INTV,INTV,PINT,PINT,INTV,INTV,PINT,PINT,FLOATV,PFLOAT,PINT,PINT,PINT,PINT,PINT,PINT,PINT,PINT,PINT,PINT,PINT,PINT,PINT,PINT,PINT,PINT,PINT,PINT,PINT,PINT,PINT,PINT,PINT,PINT,PINT,PINT,PINT,INTV,PINT,PFLOAT,INT,INT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15,A16,A17,A18,A19,A20,A21,A22,A23,A24,A25,A26,A27,A28,A29,A30,A31,A32,A33,A34,A35,A36,A37,A38,A39,A40,A41,A42,A43,A44,A45,A46,A47,A48)
-
-/*------------------------------------------------------------------
-fortran filename : compo.f
-------------------------------------------------------------------*/
-
-#define COMPO() CCALLSFSUB0(COMPO,compo)
-
-/*------------------------------------------------------------------
-fortran filename : coranh.f
-------------------------------------------------------------------*/
-
-#define CORANH(A1,A2) CCALLSFSUB2(CORANH,coranh,PINT,INT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : corevt.f
-------------------------------------------------------------------*/
-
-#define COREVT(A1,A2,A3,A4,A5) CCALLSFSUB5(COREVT,corevt,DOUBLE,DOUBLE,INT,DOUBLE,DOUBLE,A1,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : corrin.f
-------------------------------------------------------------------*/
-
-#define CORRIN(A1,A2,A3,A4,A5) CCALLSFSUB5(CORRIN,corrin,DOUBLE,DOUBLE,INT,DOUBLE,DOUBLE,A1,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : coscat.f
-------------------------------------------------------------------*/
-
-#define COSCAT() CCALLSFSUB0(COSCAT,coscat)
-
-/*------------------------------------------------------------------
-fortran filename : cosleg.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN1(DOUBLE,COSLEG,cosleg,PDOUBLE)
-#define COSLEG(A2) CCALLSFFUN1(COSLEG,cosleg,PDOUBLE,A2)
-
-/*------------------------------------------------------------------
-fortran filename : cterp.f
-------------------------------------------------------------------*/
-
-#define CTERP(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(CTERP,cterp,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,PFLOAT,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : datar3.f
-------------------------------------------------------------------*/
-
-#define DATAR3() CCALLSFSUB0(DATAR3,datar3)
-
-/*------------------------------------------------------------------
-fortran filename : decaux.f
-------------------------------------------------------------------*/
-
-#define DECAUX(A1,A2) CCALLSFSUB2(DECAUX,decaux,INT,INT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : defs1.f
-------------------------------------------------------------------*/
-
-#define DEFS1(A1,A2,A3) CCALLSFSUB3(DEFS1,defs1,INT,INT,INT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : difevv.f
-------------------------------------------------------------------*/
-
-#define DIFEVV(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(DIFEVV,difevv,PINT,INT,INT,DOUBLE,DOUBLE,DOUBLE,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : dlpnuc.f
-------------------------------------------------------------------*/
-
-#define DLPNUC(A1,A2) CCALLSFSUB2(DLPNUC,dlpnuc,PDOUBLE,INT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : dlpsor.f
-------------------------------------------------------------------*/
-
-#define DLPSOR(A1,A2) CCALLSFSUB2(DLPSOR,dlpsor,PDOUBLE,INT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : dost.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN2(DOUBLE,DOST,dost,INT,DOUBLE)
-#define DOST(A2,A3) CCALLSFFUN2(DOST,dost,INT,DOUBLE,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : dotes2.f
-------------------------------------------------------------------*/
-
-#define DOTES2(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(DOTES2,dotes2,DOUBLE,DOUBLE,DOUBLE,DOUBLE,PDOUBLE,INT,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : dotnuc.f
-------------------------------------------------------------------*/
-
-#define DOTNUC(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(DOTNUC,dotnuc,DOUBLE,DOUBLE,DOUBLE,DOUBLE,PDOUBLE,INT,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : dpdnuc.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN3(DOUBLE,DPDNUC,dpdnuc,DOUBLE,DOUBLE,DOUBLE)
-#define DPDNUC(A2,A3,A4) CCALLSFFUN3(DPDNUC,dpdnuc,DOUBLE,DOUBLE,DOUBLE,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : drelab.f
-------------------------------------------------------------------*/
-
-#define DRELAB(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(DRELAB,drelab,PDOUBLE,PDOUBLE,PDOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,A1,A2,A3,A4,A5,A6,A7)
-
-/*------------------------------------------------------------------
-fortran filename : eexi.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN3(DOUBLE,EEXI,eexi,INT,DOUBLE,DOUBLE)
-#define EEXI(A2,A3,A4) CCALLSFFUN3(EEXI,eexi,INT,DOUBLE,DOUBLE,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : eexlvl.f
-------------------------------------------------------------------*/
-
-#define EEXLVL(A1,A2,A3,A4,A5) CCALLSFSUB5(EEXLVL,eexlvl,INT,INT,PDOUBLE,PDOUBLE,PDOUBLE,A1,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : ekeka.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN4(DOUBLE,EKEKA,ekeka,INT,DOUBLE,DOUBLE,DOUBLE)
-#define EKEKA(A2,A3,A4,A5) CCALLSFFUN4(EKEKA,ekeka,INT,DOUBLE,DOUBLE,DOUBLE,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : energi.f
-------------------------------------------------------------------*/
-
-#define ENERGI(A1,A2,A3,A4,A5,A6,A7,A8,A9) CCALLSFSUB9(ENERGI,energi,INT,INT,INT,INTV,PDOUBLE,PDOUBLE,PDOUBLE,DOUBLE,DOUBLE,A1,A2,A3,A4,A5,A6,A7,A8,A9)
-
-/*------------------------------------------------------------------
-fortran filename : enrg.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN2(DOUBLE,ENRG,enrg,DOUBLE,DOUBLE)
-#define ENRG(A2,A3) CCALLSFFUN2(ENRG,enrg,DOUBLE,DOUBLE,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : evaplr.f
-------------------------------------------------------------------*/
-
-#define EVAPLR(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(EVAPLR,evaplr,FLOAT,FLOAT,FLOAT,FLOAT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : evdeex.f
-------------------------------------------------------------------*/
-
-#define EVDEEX(A1) CCALLSFSUB1(EVDEEX,evdeex,DOUBLE,A1)
-
-/*------------------------------------------------------------------
-fortran filename : eventv.f
-------------------------------------------------------------------*/
-
-#define EVENTV(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(EVENTV,eventv,INT,PDOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,INT,A1,A2,A3,A4,A5,A6,A7,A8)
-
-/*------------------------------------------------------------------
-fortran filename : evevap.f
-------------------------------------------------------------------*/
-
-#define EVEVAP(A1) CCALLSFSUB1(EVEVAP,evevap,DOUBLE,A1)
-
-/*------------------------------------------------------------------
-fortran filename : evvini.f
-------------------------------------------------------------------*/
-/*
-#define evvini_ELEMS_2 ZTRINGV_NUM(1)
-#define evvini_ELEMLEN_2 ZTRINGV_NUM(8)
-*/
-
-#define EVVINI(A1,A2) CCALLSFSUB2(EVVINI,evvini,DOUBLEV,STRING,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : exnu.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN1(FLOAT,EXNU,exnu,FLOAT)
-#define EXNU(A2) CCALLSFFUN1(EXNU,exnu,FLOAT,A2)
-
-/*------------------------------------------------------------------
-fortran filename : exprnf.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN1(FLOAT,EXPRNF,exprnf,FLOAT)
-#define EXPRNF(A2) CCALLSFFUN1(EXPRNF,exprnf,FLOAT,A2)
-
-/*------------------------------------------------------------------
-fortran filename : fctcos.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN1(FLOAT,FCTCOS,fctcos,FLOAT)
-#define FCTCOS(A2) CCALLSFFUN1(FCTCOS,fctcos,FLOAT,A2)
-
-/*------------------------------------------------------------------
-fortran filename : fdevap.f
-------------------------------------------------------------------*/
-
-#define FDEVAP() CCALLSFSUB0(FDEVAP,fdevap)
-
-/*------------------------------------------------------------------
-fortran filename : fdnopt.f
-------------------------------------------------------------------*/
-
-#define FDNOPT() CCALLSFSUB0(FDNOPT,fdnopt)
-
-/*------------------------------------------------------------------
-fortran filename : fdpree.f
-------------------------------------------------------------------*/
-
-#define FDPREE() CCALLSFSUB0(FDPREE,fdpree)
-
-/*------------------------------------------------------------------
-fortran filename : fekfnc.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN2(DOUBLE,FEKFNC,fekfnc,DOUBLE,INT)
-#define FEKFNC(A2,A3) CCALLSFFUN2(FEKFNC,fekfnc,DOUBLE,INT,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : ferevv.f
-------------------------------------------------------------------*/
-
-#define FEREVV(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11) CCALLSFSUB11(FEREVV,ferevv,INT,INT,INT,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,INT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11)
-
-/*------------------------------------------------------------------
-fortran filename : ferhav.f
-------------------------------------------------------------------*/
-
-#define FERHAV(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(FERHAV,ferhav,INT,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : fermi.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN1(FLOAT,FERMI,fermi,FLOAT)
-#define FERMI(A2) CCALLSFFUN1(FERMI,fermi,FLOAT,A2)
-
-/*------------------------------------------------------------------
-fortran filename : fisfra.f
-------------------------------------------------------------------*/
-
-#define FISFRA(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(FISFRA,fisfra,INT,INT,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,A1,A2,A3,A4,A5,A6,A7)
-
-/*------------------------------------------------------------------
-fortran filename : fisrnf.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN2(FLOAT,FISRNF,fisrnf,FLOAT,FLOAT)
-#define FISRNF(A2,A3) CCALLSFFUN2(FISRNF,fisrnf,FLOAT,FLOAT,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : fissio.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN1(FLOAT,FISSIO,fissio,FLOAT)
-#define FISSIO(A2) CCALLSFFUN1(FISSIO,fissio,FLOAT,A2)
-
-/*------------------------------------------------------------------
-fortran filename : fkdeca.f
-------------------------------------------------------------------*/
-
-#define FKDECA(A1,A2) CCALLSFSUB2(FKDECA,fkdeca,PINT,INT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : fkdres.f
-------------------------------------------------------------------*/
-
-#define FKDRES(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(FKDRES,fkdres,INT,INT,DOUBLE,PDOUBLE,PDOUBLE,PLOGICAL,INT,A1,A2,A3,A4,A5,A6,A7)
-
-/*------------------------------------------------------------------
-fortran filename : fkener.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN2(DOUBLE,FKENER,fkener,DOUBLE,DOUBLE)
-#define FKENER(A2,A3) CCALLSFFUN2(FKENER,fkener,DOUBLE,DOUBLE,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : fkerup.f
-------------------------------------------------------------------*/
-
-#define FKERUP(A1) CCALLSFSUB1(FKERUP,fkerup,INT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : fkflav.f
-------------------------------------------------------------------*/
-
-#define FKFLAV(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15) CCALLSFSUB15(FKFLAV,fkflav,INT,INT,INT,DOUBLE,INTV,DOUBLEV,PINT,PINT,INT,DOUBLE,INT,INT,INT,INT,INT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15)
-
-/*------------------------------------------------------------------
-fortran filename : fkimpu.f
-------------------------------------------------------------------*/
-
-#define FKIMPU(A1,A2,A3,A4,A5,A6,A7,A8,A9) CCALLSFSUB9(FKIMPU,fkimpu,DOUBLE,DOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,INT,INT,DOUBLE,A1,A2,A3,A4,A5,A6,A7,A8,A9)
-
-/*------------------------------------------------------------------
-fortran filename : fksigi.f
-------------------------------------------------------------------*/
-
-#define FKSIGI(A1,A2,A3,A4,A5,A6,A7,A8,A9) CCALLSFSUB9(FKSIGI,fksigi,INT,DOUBLE,INT,PINT,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,INT,A1,A2,A3,A4,A5,A6,A7,A8,A9)
-
-/*------------------------------------------------------------------
-fortran filename : fkvert.f
-------------------------------------------------------------------*/
-
-#define FKVERT(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11) CCALLSFSUB11(FKVERT,fkvert,INT,INT,INT,INT,DOUBLE,PINT,DOUBLEV,INTV,INTV,DOUBLE,INT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11)
-
-/*------------------------------------------------------------------
-fortran filename : fkzero.f
-------------------------------------------------------------------*/
-
-#define FKZERO() CCALLSFSUB0(FKZERO,fkzero)
-
-/*------------------------------------------------------------------
-fortran filename : fldist.f
-------------------------------------------------------------------*/
-
-#define FLDIST() CCALLSFSUB0(FLDIST,fldist)
-
-/*------------------------------------------------------------------
-fortran filename : flinit.f
-------------------------------------------------------------------*/
-
-#define FLINIT() CCALLSFSUB0(FLINIT,flinit)
-
-/*------------------------------------------------------------------
-fortran filename : flkdt1.f
-------------------------------------------------------------------*/
-
-#define FLKDT1() CCALLSFSUB0(FLKDT1,flkdt1)
-
-/*------------------------------------------------------------------
-fortran filename : flkdt2.f
-------------------------------------------------------------------*/
-
-#define FLKDT2() CCALLSFSUB0(FLKDT2,flkdt2)
-
-/*------------------------------------------------------------------
-fortran filename : flkdt3.f
-------------------------------------------------------------------*/
-
-#define FLKDT3() CCALLSFSUB0(FLKDT3,flkdt3)
-
-/*------------------------------------------------------------------
-fortran filename : flkdt4.f
-------------------------------------------------------------------*/
-
-#define FLKDT4() CCALLSFSUB0(FLKDT4,flkdt4)
-
-/*------------------------------------------------------------------
-fortran filename : flkdt5.f
-------------------------------------------------------------------*/
-
-#define FLKDT5() CCALLSFSUB0(FLKDT5,flkdt5)
-
-/*------------------------------------------------------------------
-fortran filename : flkdt6.f
-------------------------------------------------------------------*/
-
-#define FLKDT6() CCALLSFSUB0(FLKDT6,flkdt6)
-
-/*------------------------------------------------------------------
-fortran filename : flkdt7.f
-------------------------------------------------------------------*/
-
-#define FLKDT7() CCALLSFSUB0(FLKDT7,flkdt7)
-
-/*------------------------------------------------------------------
-fortran filename : fltrnf.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN1(FLOAT,FLTRNF,fltrnf,INT)
-#define FLTRNF(A2) CCALLSFFUN1(FLTRNF,fltrnf,INT,A2)
-
-/*------------------------------------------------------------------
-fortran filename : flufin.f
-------------------------------------------------------------------*/
-
-#define FLUFIN() CCALLSFSUB0(FLUFIN,flufin)
-
-/*------------------------------------------------------------------
-fortran filename : fpfrnc.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN2(DOUBLE,FPFRNC,fpfrnc,DOUBLE,INT)
-#define FPFRNC(A2,A3) CCALLSFFUN2(FPFRNC,fpfrnc,DOUBLE,INT,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : fpower.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN3(DOUBLE,FPOWER,fpower,INT,INT,DOUBLE)
-#define FPOWER(A2,A3,A4) CCALLSFFUN3(FPOWER,fpower,INT,INT,DOUBLE,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : fprob.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN3(DOUBLE,FPROB,fprob,DOUBLE,DOUBLE,DOUBLE)
-#define FPROB(A2,A3,A4) CCALLSFFUN3(FPROB,fprob,DOUBLE,DOUBLE,DOUBLE,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : fradnc.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN1(DOUBLE,FRADNC,fradnc,DOUBLE)
-#define FRADNC(A2) CCALLSFFUN1(FRADNC,fradnc,DOUBLE,A2)
-
-/*------------------------------------------------------------------
-fortran filename : frhinc.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN1(DOUBLE,FRHINC,frhinc,DOUBLE)
-#define FRHINC(A2) CCALLSFFUN1(FRHINC,frhinc,DOUBLE,A2)
-
-/*------------------------------------------------------------------
-fortran filename : frhonc.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN1(DOUBLE,FRHONC,frhonc,DOUBLE)
-#define FRHONC(A2) CCALLSFFUN1(FRHONC,frhonc,DOUBLE,A2)
-
-/*------------------------------------------------------------------
-fortran filename : gamrn.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN2(DOUBLE,GAMRN,gamrn,DOUBLE,DOUBLE)
-#define GAMRN(A2,A3) CCALLSFFUN2(GAMRN,gamrn,DOUBLE,DOUBLE,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : ganni.f
-------------------------------------------------------------------*/
-
-#define GANNI() CCALLSFSUB0(GANNI,ganni)
-
-/*------------------------------------------------------------------
-fortran filename : ganni2.f
-------------------------------------------------------------------*/
-
-#define GANNI2() CCALLSFSUB0(GANNI2,ganni2)
-
-/*------------------------------------------------------------------
-fortran filename : gannii.f
-------------------------------------------------------------------*/
-
-#define GANNII() CCALLSFSUB0(GANNII,gannii)
-
-/*------------------------------------------------------------------
-fortran filename : gannir.f
-------------------------------------------------------------------*/
-
-#define GANNIR() CCALLSFSUB0(GANNIR,gannir)
-
-/*------------------------------------------------------------------
-fortran filename : garndm.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN1(FLOAT,GARNDM,garndm,FLOAT)
-#define GARNDM(A2) CCALLSFFUN1(GARNDM,garndm,FLOAT,A2)
-
-/*------------------------------------------------------------------
-fortran filename : gavrl2.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN3(FLOAT,GAVRL2,gavrl2,FLOAT,FLOAT,FLOAT)
-#define GAVRL2(A2,A3,A4) CCALLSFFUN3(GAVRL2,gavrl2,FLOAT,FLOAT,FLOAT,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : gavrl3.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN3(FLOAT,GAVRL3,gavrl3,FLOAT,FLOAT,FLOAT)
-#define GAVRL3(A2,A3,A4) CCALLSFFUN3(GAVRL3,gavrl3,FLOAT,FLOAT,FLOAT,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : gbflos.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN2(FLOAT,GBFLOS,gbflos,FLOAT,FLOAT)
-#define GBFLOS(A2,A3) CCALLSFFUN2(GBFLOS,gbflos,FLOAT,FLOAT,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : gbfsig.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN2(FLOAT,GBFSIG,gbfsig,FLOAT,FLOAT)
-#define GBFSIG(A2,A3) CCALLSFFUN2(GBFSIG,gbfsig,FLOAT,FLOAT,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : gbhsta.f
-------------------------------------------------------------------*/
-
-#define GBHSTA() CCALLSFSUB0(GBHSTA,gbhsta)
-
-/*------------------------------------------------------------------
-fortran filename : gbirk.f
-------------------------------------------------------------------*/
-
-#define GBIRK(A1) CCALLSFSUB1(GBIRK,gbirk,PFLOAT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : gboset.f
-------------------------------------------------------------------*/
-
-#define GBOSET(A1) CCALLSFSUB1(GBOSET,gboset,FLOATV,A1)
-
-/*------------------------------------------------------------------
-fortran filename : gbrela.f
-------------------------------------------------------------------*/
-
-#define GBRELA() CCALLSFSUB0(GBRELA,gbrela)
-
-/*------------------------------------------------------------------
-fortran filename : gbrele.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN3(FLOAT,GBRELE,gbrele,FLOAT,FLOAT,FLOAT)
-#define GBRELE(A2,A3,A4) CCALLSFFUN3(GBRELE,gbrele,FLOAT,FLOAT,FLOAT,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : gbrelm.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN3(FLOAT,GBRELM,gbrelm,FLOAT,FLOAT,FLOAT)
-#define GBRELM(A2,A3,A4) CCALLSFFUN3(GBRELM,gbrelm,FLOAT,FLOAT,FLOAT,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : gbreme.f
-------------------------------------------------------------------*/
-
-#define GBREME() CCALLSFSUB0(GBREME,gbreme)
-
-/*------------------------------------------------------------------
-fortran filename : gbremm.f
-------------------------------------------------------------------*/
-
-#define GBREMM() CCALLSFSUB0(GBREMM,gbremm)
-
-/*------------------------------------------------------------------
-fortran filename : gbrsga.f
-------------------------------------------------------------------*/
-
-#define GBRSGA() CCALLSFSUB0(GBRSGA,gbrsga)
-
-/*------------------------------------------------------------------
-fortran filename : gbrsge.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN3(FLOAT,GBRSGE,gbrsge,FLOAT,FLOAT,FLOAT)
-#define GBRSGE(A2,A3,A4) CCALLSFFUN3(GBRSGE,gbrsge,FLOAT,FLOAT,FLOAT,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : gbrsgm.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN3(FLOAT,GBRSGM,gbrsgm,FLOAT,FLOAT,FLOAT)
-#define GBRSGM(A2,A3,A4) CCALLSFFUN3(GBRSGM,gbrsgm,FLOAT,FLOAT,FLOAT,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : gbstat.f
-------------------------------------------------------------------*/
-
-#define GBSTAT() CCALLSFSUB0(GBSTAT,gbstat)
-
-/*------------------------------------------------------------------
-fortran filename : gbteth.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN3(FLOAT,GBTETH,gbteth,FLOAT,FLOAT,FLOAT)
-#define GBTETH(A2,A3,A4) CCALLSFFUN3(GBTETH,gbteth,FLOAT,FLOAT,FLOAT,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : gcbrem.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN1(FLOAT,GCBREM,gcbrem,FLOAT)
-#define GCBREM(A2) CCALLSFFUN1(GCBREM,gcbrem,FLOAT,A2)
-
-/*------------------------------------------------------------------
-fortran filename : gcderr.f
-------------------------------------------------------------------*/
-
-#define GCDERR(A1,A2,A3) CCALLSFSUB3(GCDERR,gcderr,PINT,FLOAT,FLOAT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : gcdrif.f
-------------------------------------------------------------------*/
-
-#define GCDRIF(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(GCDRIF,gcdrif,FLOAT,FLOAT,FLOAT,FLOATV,FLOATV,PINT,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : gcent.f
-------------------------------------------------------------------*/
-
-#define GCENT(A1,A2) CCALLSFSUB2(GCENT,gcent,INT,PFLOAT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : gchnwk.f
-------------------------------------------------------------------*/
-
-#define GCHNWK() CCALLSFSUB0(GCHNWK,gchnwk)
-
-/*------------------------------------------------------------------
-fortran filename : gckmat.f
-------------------------------------------------------------------*/
-/*
-#define gckmat_ELEMS_2 ZTRINGV_NUM(1)
-#define gckmat_ELEMLEN_2 ZTRINGV_NUM(20)
-*/
-
-#define GCKMAT(A1,A2) CCALLSFSUB2(GCKMAT,gckmat,INT,STRING,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : gckpar.f
-------------------------------------------------------------------*/
-
-#define GCKPAR(A1,A2,A3) CCALLSFSUB3(GCKPAR,gckpar,INT,PINT,PFLOAT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : gclose.f
-------------------------------------------------------------------*/
-
-#define GCLOSE(A1,A2) CCALLSFSUB2(GCLOSE,gclose,INT,PINT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : gcmwpc.f
-------------------------------------------------------------------*/
-
-#define GCMWPC(A1,A2,A3) CCALLSFSUB3(GCMWPC,gcmwpc,FLOATV,FLOATV,PINT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : gcoeff.f
-------------------------------------------------------------------*/
-
-#define GCOEFF() CCALLSFSUB0(GCOEFF,gcoeff)
-
-/*------------------------------------------------------------------
-fortran filename : gcomp.f
-------------------------------------------------------------------*/
-
-#define GCOMP() CCALLSFSUB0(GCOMP,gcomp)
-
-/*------------------------------------------------------------------
-fortran filename : gcompi.f
-------------------------------------------------------------------*/
-
-#define GCOMPI() CCALLSFSUB0(GCOMPI,gcompi)
-
-/*------------------------------------------------------------------
-fortran filename : gcoset.f
-------------------------------------------------------------------*/
-
-#define GCOSET(A1,A2) CCALLSFSUB2(GCOSET,gcoset,FLOATV,INT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : gctset.f
-------------------------------------------------------------------*/
-
-#define GCTSET(A1) CCALLSFSUB1(GCTSET,gctset,FLOATV,A1)
-
-/*------------------------------------------------------------------
-fortran filename : gcubs.f
-------------------------------------------------------------------*/
-
-#define GCUBS(A1,A2,A3,A4,A5) CCALLSFSUB5(GCUBS,gcubs,FLOAT,FLOAT,FLOAT,FLOAT,PFLOAT,A1,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : gd16v.f
-------------------------------------------------------------------*/
-
-#define GD16V(A1,A2) CCALLSFSUB2(GD16V,gd16v,INT,INTV,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : gd3d3d.f
-------------------------------------------------------------------*/
-
-#define GD3D3D(A1,A2,A3,A4) CCALLSFSUB4(GD3D3D,gd3d3d,PFLOAT,INT,PFLOAT,INT,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : gdahit.f
-------------------------------------------------------------------*/
-
-#define GDAHIT(A1,A2,A3,A4,A5) CCALLSFSUB5(GDAHIT,gdahit,FLOAT,FLOAT,FLOAT,INT,FLOAT,A1,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : gdarc.f
-------------------------------------------------------------------*/
-
-#define GDARC(A1,A2,A3,A4) CCALLSFSUB4(GDARC,gdarc,FLOAT,FLOAT,FLOAT,FLOAT,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : gdarr.f
-------------------------------------------------------------------*/
-/*
-#define gdarr_ELEMS_6 ZTRINGV_NUM(1)
-#define gdarr_ELEMLEN_6 ZTRINGV_NUM(255)
-*/
-
-#define GDARR(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(GDARR,gdarr,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,STRING,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : gdaxis.f
-------------------------------------------------------------------*/
-
-#define GDAXIS(A1,A2,A3,A4) CCALLSFSUB4(GDAXIS,gdaxis,FLOAT,FLOAT,FLOAT,FLOAT,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : gdbomb.f
-------------------------------------------------------------------*/
-
-#define GDBOMB(A1,A2) CCALLSFSUB2(GDBOMB,gdbomb,INT,INT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : gdcgcl.f
-------------------------------------------------------------------*/
-
-#define GDCGCL(A1) CCALLSFSUB1(GDCGCL,gdcgcl,INT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : gdcgem.f
-------------------------------------------------------------------*/
-
-#define GDCGEM(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11) CCALLSFSUB11(GDCGEM,gdcgem,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,PINT,PFLOAT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11)
-
-/*------------------------------------------------------------------
-fortran filename : gdcger.f
-------------------------------------------------------------------*/
-
-#define GDCGER(A1) CCALLSFSUB1(GDCGER,gdcger,FLOAT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : gdcghi.f
-------------------------------------------------------------------*/
-
-#define GDCGHI(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(GDCGHI,gdcghi,INT,INT,INT,INT,INT,INT,INT,A1,A2,A3,A4,A5,A6,A7)
-
-/*------------------------------------------------------------------
-fortran filename : gdcgob.f
-------------------------------------------------------------------*/
-
-#define GDCGOB(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(GDCGOB,gdcgob,INT,PINT,FLOATV,INT,INT,INT,INT,A1,A2,A3,A4,A5,A6,A7)
-
-/*------------------------------------------------------------------
-fortran filename : gdcgpr.f
-------------------------------------------------------------------*/
-
-#define GDCGPR() CCALLSFSUB0(GDCGPR,gdcgpr)
-
-/*------------------------------------------------------------------
-fortran filename : gdcgrs.f
-------------------------------------------------------------------*/
-
-#define GDCGRS() CCALLSFSUB0(GDCGRS,gdcgrs)
-
-/*------------------------------------------------------------------
-fortran filename : gdcgsl.f
-------------------------------------------------------------------*/
-
-#define GDCGSL(A1,A2) CCALLSFSUB2(GDCGSL,gdcgsl,INT,INT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : gdcgvw.f
-------------------------------------------------------------------*/
-
-#define GDCGVW(A1,A2) CCALLSFSUB2(GDCGVW,gdcgvw,FLOATV,PFLOAT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : gdcgwv.f
-------------------------------------------------------------------*/
-
-#define GDCGWV(A1) CCALLSFSUB1(GDCGWV,gdcgwv,INT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : gdchit.f
-------------------------------------------------------------------*/
-/*
-#define gdchit_ELEMS_1 ZTRINGV_NUM(1)
-#define gdchit_ELEMLEN_1 ZTRINGV_NUM(4)
-#define gdchit_ELEMS_2 ZTRINGV_NUM(1)
-#define gdchit_ELEMLEN_2 ZTRINGV_NUM(4)
-*/
-
-#define GDCHIT(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(GDCHIT,gdchit,STRING,STRING,INT,INT,FLOAT,INT,FLOAT,FLOAT,A1,A2,A3,A4,A5,A6,A7,A8)
-
-/*------------------------------------------------------------------
-fortran filename : gdcirc.f
-------------------------------------------------------------------*/
-
-#define GDCIRC(A1,A2) CCALLSFSUB2(GDCIRC,gdcirc,FLOAT,FLOAT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : gdcirr.f
-------------------------------------------------------------------*/
-
-#define GDCIRR(A1,A2) CCALLSFSUB2(GDCIRR,gdcirr,FLOAT,FLOAT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : gdciry.f
-------------------------------------------------------------------*/
-
-#define GDCIRY(A1,A2) CCALLSFSUB2(GDCIRY,gdciry,FLOAT,FLOAT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : gdclos.f
-------------------------------------------------------------------*/
-
-#define GDCLOS() CCALLSFSUB0(GDCLOS,gdclos)
-
-/*------------------------------------------------------------------
-fortran filename : gdcol.f
-------------------------------------------------------------------*/
-
-#define GDCOL(A1) CCALLSFSUB1(GDCOL,gdcol,INT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : gdcol1.f
-------------------------------------------------------------------*/
-
-#define GDCOL1(A1) CCALLSFSUB1(GDCOL1,gdcol1,INT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : gdcota.f
-------------------------------------------------------------------*/
-
-#define GDCOTA() CCALLSFSUB0(GDCOTA,gdcota)
-
-/*------------------------------------------------------------------
-fortran filename : gdcurs.f
-------------------------------------------------------------------*/
-
-#define GDCURS(A1,A2,A3) CCALLSFSUB3(GDCURS,gdcurs,FLOAT,FLOAT,PINT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : gdcut.f
-------------------------------------------------------------------*/
-
-#define GDCUT() CCALLSFSUB0(GDCUT,gdcut)
-
-/*------------------------------------------------------------------
-fortran filename : gdcxyz.f
-------------------------------------------------------------------*/
-
-#define GDCXYZ() CCALLSFSUB0(GDCXYZ,gdcxyz)
-
-/*------------------------------------------------------------------
-fortran filename : gdebug.f
-------------------------------------------------------------------*/
-
-#define GDEBUG() CCALLSFSUB0(GDEBUG,gdebug)
-
-/*------------------------------------------------------------------
-fortran filename : gdeca2.f
-------------------------------------------------------------------*/
-
-#define GDECA2(A1,A2,A3,A4) CCALLSFSUB4(GDECA2,gdeca2,FLOAT,FLOAT,FLOAT,PFLOAT,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : gdeca3.f
-------------------------------------------------------------------*/
-
-#define GDECA3(A1,A2,A3,A4,A5) CCALLSFSUB5(GDECA3,gdeca3,FLOAT,FLOAT,FLOAT,FLOAT,PFLOAT,A1,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : gdecay.f
-------------------------------------------------------------------*/
-
-#define GDECAY() CCALLSFSUB0(GDECAY,gdecay)
-
-/*------------------------------------------------------------------
-fortran filename : gdelet.f
-------------------------------------------------------------------*/
-
-#define GDELET(A1) CCALLSFSUB1(GDELET,gdelet,INT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : gdeltu.f
-------------------------------------------------------------------*/
-
-#define GDELTU(A1,A2,A3) CCALLSFSUB3(GDELTU,gdeltu,FLOAT,FLOAT,FLOAT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : gdexca.f
-------------------------------------------------------------------*/
-/*
-#define gdexca_ELEMS_1 ZTRINGV_NUM(1)
-#define gdexca_ELEMLEN_1 ZTRINGV_NUM(4)
-*/
-
-#define GDEXCA(A1,A2) CCALLSFSUB2(GDEXCA,gdexca,STRING,INT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : gdfr3d.f
-------------------------------------------------------------------*/
-
-#define GDFR3D(A1,A2,A3,A4) CCALLSFSUB4(GDFR3D,gdfr3d,PFLOAT,INT,PFLOAT,PFLOAT,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : gdfspc.f
-------------------------------------------------------------------*/
-/*
-#define gdfspc_ELEMS_1 ZTRINGV_NUM(1)
-#define gdfspc_ELEMLEN_1 ZTRINGV_NUM(4)
-*/
-
-#define GDFSPC(A1,A2,A3) CCALLSFSUB3(GDFSPC,gdfspc,STRING,INT,INT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : gdhead.f
-------------------------------------------------------------------*/
-/*
-#define gdhead_ELEMS_2 ZTRINGV_NUM(1)
-#define gdhead_ELEMLEN_2 ZTRINGV_NUM(255)
-*/
-
-#define GDHEAD(A1,A2,A3) CCALLSFSUB3(GDHEAD,gdhead,INT,STRING,FLOAT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : gdhits.f
-------------------------------------------------------------------*/
-/*
-#define gdhits_ELEMS_1 ZTRINGV_NUM(1)
-#define gdhits_ELEMLEN_1 ZTRINGV_NUM(4)
-#define gdhits_ELEMS_2 ZTRINGV_NUM(1)
-#define gdhits_ELEMLEN_2 ZTRINGV_NUM(4)
-*/
-
-#define GDHITS(A1,A2,A3,A4,A5) CCALLSFSUB5(GDHITS,gdhits,STRING,STRING,INT,INT,FLOAT,A1,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : gdinit.f
-------------------------------------------------------------------*/
-
-#define GDINIT() CCALLSFSUB0(GDINIT,gdinit)
-
-/*------------------------------------------------------------------
-fortran filename : gdkine.f
-------------------------------------------------------------------*/
-
-#define GDKINE() CCALLSFSUB0(GDKINE,gdkine)
-
-/*------------------------------------------------------------------
-fortran filename : gdlcyl.f
-------------------------------------------------------------------*/
-
-#define GDLCYL(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(GDLCYL,gdlcyl,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : gdlens.f
-------------------------------------------------------------------*/
-/*
-#define gdlens_ELEMS_2 ZTRINGV_NUM(1)
-#define gdlens_ELEMLEN_2 ZTRINGV_NUM(4)
-*/
-
-#define GDLENS(A1,A2) CCALLSFSUB2(GDLENS,gdlens,INT,STRING,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : gdline.f
-------------------------------------------------------------------*/
-
-#define GDLINE(A1,A2) CCALLSFSUB2(GDLINE,gdline,FLOATV,FLOATV,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : gdlumi.f
-------------------------------------------------------------------*/
-
-#define GDLUMI(A1,A2) CCALLSFSUB2(GDLUMI,gdlumi,PINT,FLOAT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : gdlw.f
-------------------------------------------------------------------*/
-
-#define GDLW(A1) CCALLSFSUB1(GDLW,gdlw,INT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : gdlw1.f
-------------------------------------------------------------------*/
-
-#define GDLW1(A1) CCALLSFSUB1(GDLW1,gdlw1,INT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : gdman.f
-------------------------------------------------------------------*/
-
-#define GDMAN(A1,A2) CCALLSFSUB2(GDMAN,gdman,FLOAT,FLOAT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : gdnino.f
-------------------------------------------------------------------*/
-
-#define GDNINO() CCALLSFSUB0(GDNINO,gdnino)
-
-/*------------------------------------------------------------------
-fortran filename : gdnson.f
-------------------------------------------------------------------*/
-/*
-#define gdnson_ELEMS_1 ZTRINGV_NUM(1)
-#define gdnson_ELEMLEN_1 ZTRINGV_NUM(4)
-*/
-
-#define GDNSON(A1,A2,A3) CCALLSFSUB3(GDNSON,gdnson,STRING,PINT,PINT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : gdopen.f
-------------------------------------------------------------------*/
-
-#define GDOPEN(A1) CCALLSFSUB1(GDOPEN,gdopen,INT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : gdopt.f
-------------------------------------------------------------------*/
-/*
-#define gdopt_ELEMS_1 ZTRINGV_NUM(1)
-#define gdopt_ELEMLEN_1 ZTRINGV_NUM(4)
-#define gdopt_ELEMS_2 ZTRINGV_NUM(1)
-#define gdopt_ELEMLEN_2 ZTRINGV_NUM(4)
-*/
-
-#define GDOPT(A1,A2) CCALLSFSUB2(GDOPT,gdopt,STRING,STRING,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : gdpart.f
-------------------------------------------------------------------*/
-
-#define GDPART(A1,A2,A3) CCALLSFSUB3(GDPART,gdpart,INT,INT,FLOAT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : gdpdk.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN3(DOUBLE,GDPDK,gdpdk,DOUBLE,DOUBLE,DOUBLE)
-#define GDPDK(A2,A3,A4) CCALLSFFUN3(GDPDK,gdpdk,DOUBLE,DOUBLE,DOUBLE,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : gdplst.f
-------------------------------------------------------------------*/
-/*
-#define gdplst_ELEMS_2 ZTRINGV_NUM(1)
-#define gdplst_ELEMLEN_2 ZTRINGV_NUM(4)
-*/
-
-#define GDPLST(A1,A2,A3,A4) CCALLSFSUB4(GDPLST,gdplst,INT,PSTRING,INT,INT,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : gdprtr.f
-------------------------------------------------------------------*/
-/*
-#define gdprtr_ELEMS_1 ZTRINGV_NUM(1)
-#define gdprtr_ELEMLEN_1 ZTRINGV_NUM(4)
-*/
-
-#define GDPRTR(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10) CCALLSFSUB10(GDPRTR,gdprtr,STRING,FLOAT,FLOAT,FLOAT,FLOAT,INT,INT,INT,INT,PINT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10)
-
-/*------------------------------------------------------------------
-fortran filename : gdrack.f
-------------------------------------------------------------------*/
-
-#define GDRACK() CCALLSFSUB0(GDRACK,gdrack)
-
-/*------------------------------------------------------------------
-fortran filename : gdraw.f
-------------------------------------------------------------------*/
-/*
-#define gdraw_ELEMS_1 ZTRINGV_NUM(1)
-#define gdraw_ELEMLEN_1 ZTRINGV_NUM(4)
-*/
-
-#define GDRAW(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(GDRAW,gdraw,STRING,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,A1,A2,A3,A4,A5,A6,A7,A8)
-
-/*------------------------------------------------------------------
-fortran filename : gdrawc.f
-------------------------------------------------------------------*/
-/*
-#define gdrawc_ELEMS_1 ZTRINGV_NUM(1)
-#define gdrawc_ELEMLEN_1 ZTRINGV_NUM(4)
-*/
-
-#define GDRAWC(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(GDRAWC,gdrawc,STRING,INT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,A1,A2,A3,A4,A5,A6,A7)
-
-/*------------------------------------------------------------------
-fortran filename : gdrawp.f
-------------------------------------------------------------------*/
-
-#define GDRAWP(A1,A2,A3) CCALLSFSUB3(GDRAWP,gdrawp,FLOATV,FLOATV,INT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : gdraws.f
-------------------------------------------------------------------*/
-
-#define GDRAWS(A1,A2) CCALLSFSUB2(GDRAWS,gdraws,INT,PFLOAT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : gdrawt.f
-------------------------------------------------------------------*/
-/*
-#define gdrawt_ELEMS_3 ZTRINGV_NUM(1)
-#define gdrawt_ELEMLEN_3 ZTRINGV_NUM(255)
-*/
-
-#define GDRAWT(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(GDRAWT,gdrawt,FLOAT,FLOAT,STRING,FLOAT,FLOAT,INT,INT,A1,A2,A3,A4,A5,A6,A7)
-
-/*------------------------------------------------------------------
-fortran filename : gdrawv.f
-------------------------------------------------------------------*/
-
-#define GDRAWV(A1,A2,A3) CCALLSFSUB3(GDRAWV,gdrawv,FLOATV,FLOATV,INT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : gdrawx.f
-------------------------------------------------------------------*/
-/*
-#define gdrawx_ELEMS_1 ZTRINGV_NUM(1)
-#define gdrawx_ELEMLEN_1 ZTRINGV_NUM(4)
-*/
-
-#define GDRAWX(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10) CCALLSFSUB10(GDRAWX,gdrawx,STRING,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10)
-
-/*------------------------------------------------------------------
-fortran filename : gdray.f
-------------------------------------------------------------------*/
-
-#define GDRAY() CCALLSFSUB0(GDRAY,gdray)
-
-/*------------------------------------------------------------------
-fortran filename : gdrayt.f
-------------------------------------------------------------------*/
-/*
-#define gdrayt_ELEMS_1 ZTRINGV_NUM(1)
-#define gdrayt_ELEMLEN_1 ZTRINGV_NUM(4)
-*/
-
-#define GDRAYT(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(GDRAYT,gdrayt,STRING,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,A1,A2,A3,A4,A5,A6,A7,A8)
-
-/*------------------------------------------------------------------
-fortran filename : gdrect.f
-------------------------------------------------------------------*/
-
-#define GDRECT(A1,A2,A3,A4) CCALLSFSUB4(GDRECT,gdrect,FLOATV,FLOATV,FLOATV,FLOATV,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : gdrela.f
-------------------------------------------------------------------*/
-
-#define GDRELA() CCALLSFSUB0(GDRELA,gdrela)
-
-/*------------------------------------------------------------------
-fortran filename : gdrele.f
-------------------------------------------------------------------*/
-
-#define GDRELE(A1,A2,A3,A4) CCALLSFSUB4(GDRELE,gdrele,FLOAT,FLOAT,INT,PFLOAT,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : gdreli.f
-------------------------------------------------------------------*/
-
-#define GDRELI(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(GDRELI,gdreli,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,PFLOAT,A1,A2,A3,A4,A5,A6,A7)
-
-/*------------------------------------------------------------------
-fortran filename : gdrelm.f
-------------------------------------------------------------------*/
-
-#define GDRELM(A1,A2,A3,A4,A5) CCALLSFSUB5(GDRELM,gdrelm,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,A1,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : gdrelp.f
-------------------------------------------------------------------*/
-
-#define GDRELP(A1,A2,A3,A4,A5) CCALLSFSUB5(GDRELP,gdrelp,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,A1,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : gdrelx.f
-------------------------------------------------------------------*/
-
-#define GDRELX(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(GDRELX,gdrelx,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,PFLOAT,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : gdrmat.f
-------------------------------------------------------------------*/
-/*
-#define gdrmat_ELEMS_3 ZTRINGV_NUM(ZTRINGV_ARGS(4))
-#define gdrmat_ELEMLEN_3 ZTRINGV_NUM(4)
-*/
-
-#define GDRMAT(A1,A2,A3,A4) CCALLSFSUB4(GDRMAT,gdrmat,INT,INT,STRINGV,INT,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : gdrot.f
-------------------------------------------------------------------*/
-
-#define GDROT(A1,A2,A3,A4,A5) CCALLSFSUB5(GDROT,gdrot,PFLOAT,FLOAT,FLOAT,FLOAT,FLOAT,A1,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : gdrprt.f
-------------------------------------------------------------------*/
-
-#define GDRPRT(A1,A2,A3,A4) CCALLSFSUB4(GDRPRT,gdrprt,INT,INT,FLOAT,INT,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : gdrsga.f
-------------------------------------------------------------------*/
-
-#define GDRSGA() CCALLSFSUB0(GDRSGA,gdrsga)
-
-/*------------------------------------------------------------------
-fortran filename : gdrvol.f
-------------------------------------------------------------------*/
-
-#define GDRVOL(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11) CCALLSFSUB11(GDRVOL,gdrvol,INT,INTV,INTV,INT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11)
-
-/*------------------------------------------------------------------
-fortran filename : gdrwsc.f
-------------------------------------------------------------------*/
-
-#define GDRWSC(A1,A2) CCALLSFSUB2(GDRWSC,gdrwsc,INT,PFLOAT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : gdsarc.f
-------------------------------------------------------------------*/
-
-#define GDSARC(A1,A2,A3,A4,A5) CCALLSFSUB5(GDSARC,gdsarc,FLOAT,FLOAT,FLOAT,PFLOAT,PINT,A1,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : gdscal.f
-------------------------------------------------------------------*/
-
-#define GDSCAL(A1,A2) CCALLSFSUB2(GDSCAL,gdscal,FLOAT,FLOAT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : gdshad.f
-------------------------------------------------------------------*/
-
-#define GDSHAD(A1,A2) CCALLSFSUB2(GDSHAD,gdshad,PINT,FLOAT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : gdshif.f
-------------------------------------------------------------------*/
-
-#define GDSHIF(A1,A2) CCALLSFSUB2(GDSHIF,gdshif,INT,INT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : gdshow.f
-------------------------------------------------------------------*/
-
-#define GDSHOW(A1) CCALLSFSUB1(GDSHOW,gdshow,INT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : gdson.f
-------------------------------------------------------------------*/
-/*
-#define gdson_ELEMS_2 ZTRINGV_NUM(1)
-#define gdson_ELEMLEN_2 ZTRINGV_NUM(4)
-#define gdson_ELEMS_3 ZTRINGV_NUM(1)
-#define gdson_ELEMLEN_3 ZTRINGV_NUM(4)
-*/
-
-#define GDSON(A1,A2,A3) CCALLSFSUB3(GDSON,gdson,INT,STRING,PSTRING,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : gdspec.f
-------------------------------------------------------------------*/
-/*
-#define gdspec_ELEMS_1 ZTRINGV_NUM(1)
-#define gdspec_ELEMLEN_1 ZTRINGV_NUM(4)
-*/
-
-#define GDSPEC(A1) CCALLSFSUB1(GDSPEC,gdspec,STRING,A1)
-
-/*------------------------------------------------------------------
-fortran filename : gdssur.f
-------------------------------------------------------------------*/
-
-#define GDSSUR(A1,A2,A3,A4) CCALLSFSUB4(GDSSUR,gdssur,FLOATV,FLOATV,FLOATV,FLOATV,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : gdstep.f
-------------------------------------------------------------------*/
-
-#define GDSTEP() CCALLSFSUB0(GDSTEP,gdstep)
-
-/*------------------------------------------------------------------
-fortran filename : gdsurf.f
-------------------------------------------------------------------*/
-
-#define GDSURF(A1) CCALLSFSUB1(GDSURF,gdsurf,INT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : gdthrz.f
-------------------------------------------------------------------*/
-
-#define GDTHRZ(A1) CCALLSFSUB1(GDTHRZ,gdthrz,PFLOAT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : gdtom.f
-------------------------------------------------------------------*/
-
-#define GDTOM(A1,A2,A3) CCALLSFSUB3(GDTOM,gdtom,FLOATV,PFLOAT,INT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : gdtr0.f
-------------------------------------------------------------------*/
-
-#define GDTR0(A1,A2,A3,A4) CCALLSFSUB4(GDTR0,gdtr0,INT,INT,INT,INT,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : gdtr1.f
-------------------------------------------------------------------*/
-
-#define GDTR1(A1,A2,A3,A4) CCALLSFSUB4(GDTR1,gdtr1,INT,INT,PINT,PINT,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : gdtr10.f
-------------------------------------------------------------------*/
-
-#define GDTR10(A1) CCALLSFSUB1(GDTR10,gdtr10,INT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : gdtr11.f
-------------------------------------------------------------------*/
-
-#define GDTR11(A1,A2,A3) CCALLSFSUB3(GDTR11,gdtr11,PINT,PINT,INT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : gdtr12.f
-------------------------------------------------------------------*/
-
-#define GDTR12(A1) CCALLSFSUB1(GDTR12,gdtr12,INT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : gdtr2.f
-------------------------------------------------------------------*/
-
-#define GDTR2(A1,A2,A3,A4) CCALLSFSUB4(GDTR2,gdtr2,INT,PINT,INT,PINT,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : gdtr3.f
-------------------------------------------------------------------*/
-
-#define GDTR3(A1) CCALLSFSUB1(GDTR3,gdtr3,INT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : gdtr4.f
-------------------------------------------------------------------*/
-
-#define GDTR4() CCALLSFSUB0(GDTR4,gdtr4)
-
-/*------------------------------------------------------------------
-fortran filename : gdtr5.f
-------------------------------------------------------------------*/
-
-#define GDTR5(A1) CCALLSFSUB1(GDTR5,gdtr5,INT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : gdtr6.f
-------------------------------------------------------------------*/
-
-#define GDTR6(A1) CCALLSFSUB1(GDTR6,gdtr6,PINT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : gdtr8.f
-------------------------------------------------------------------*/
-/*
-#define gdtr8_ELEMS_1 ZTRINGV_NUM(1)
-#define gdtr8_ELEMLEN_1 ZTRINGV_NUM(4)
-#define gdtr8_ELEMS_2 ZTRINGV_NUM(1)
-#define gdtr8_ELEMLEN_2 ZTRINGV_NUM(4)
-*/
-
-#define GDTR8(A1,A2,A3) CCALLSFSUB3(GDTR8,gdtr8,STRING,STRING,PINT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : gdtr99.f
-------------------------------------------------------------------*/
-
-#define GDTR99(A1) CCALLSFSUB1(GDTR99,gdtr99,INT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : gdtrak.f
-------------------------------------------------------------------*/
-/*
-#define gdtrak_ELEMS_1 ZTRINGV_NUM(1)
-#define gdtrak_ELEMLEN_1 ZTRINGV_NUM(255)
-*/
-
-#define GDTRAK(A1) CCALLSFSUB1(GDTRAK,gdtrak,STRING,A1)
-
-/*------------------------------------------------------------------
-fortran filename : gdtree.f
-------------------------------------------------------------------*/
-/*
-#define gdtree_ELEMS_1 ZTRINGV_NUM(1)
-#define gdtree_ELEMLEN_1 ZTRINGV_NUM(4)
-*/
-
-#define GDTREE(A1,A2,A3) CCALLSFSUB3(GDTREE,gdtree,PSTRING,INT,INT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : gdwmn1.f
-------------------------------------------------------------------*/
-
-#define GDWMN1(A1,A2) CCALLSFSUB2(GDWMN1,gdwmn1,FLOAT,FLOAT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : gdwmn2.f
-------------------------------------------------------------------*/
-
-#define GDWMN2(A1,A2) CCALLSFSUB2(GDWMN2,gdwmn2,FLOAT,FLOAT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : gdwmn3.f
-------------------------------------------------------------------*/
-
-#define GDWMN3(A1,A2) CCALLSFSUB2(GDWMN3,gdwmn3,FLOAT,FLOAT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : gdxyz.f
-------------------------------------------------------------------*/
-
-#define GDXYZ(A1) CCALLSFSUB1(GDXYZ,gdxyz,INT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : gdxzoo.f
-------------------------------------------------------------------*/
-
-#define GDXZOO(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(GDXZOO,gdxzoo,INT,FLOAT,FLOAT,PFLOAT,PFLOAT,FLOAT,FLOAT,A1,A2,A3,A4,A5,A6,A7)
-
-/*------------------------------------------------------------------
-fortran filename : gdzoom.f
-------------------------------------------------------------------*/
-
-#define GDZOOM(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(GDZOOM,gdzoom,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : geamon.f
-------------------------------------------------------------------*/
-/*
-#define geamon_ELEMS_2 ZTRINGV_NUM(1)
-#define geamon_ELEMLEN_2 ZTRINGV_NUM(255)
-*/
-
-#define GEAMON(A1,A2) CCALLSFSUB2(GEAMON,geamon,INT,STRING,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : geditv.f
-------------------------------------------------------------------*/
-
-#define GEDITV(A1) CCALLSFSUB1(GEDITV,geditv,INT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : gefch2.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN3(FLOAT,GEFCH2,gefch2,FLOAT,FLOAT,FLOAT)
-#define GEFCH2(A2,A3,A4) CCALLSFFUN3(GEFCH2,gefch2,FLOAT,FLOAT,FLOAT,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : gekbin.f
-------------------------------------------------------------------*/
-
-#define GEKBIN() CCALLSFSUB0(GEKBIN,gekbin)
-
-/*------------------------------------------------------------------
-fortran filename : gelset.f
-------------------------------------------------------------------*/
-
-#define GELSET(A1) CCALLSFSUB1(GELSET,gelset,FLOATV,A1)
-
-/*------------------------------------------------------------------
-fortran filename : genset.f
-------------------------------------------------------------------*/
-
-#define GENSET() CCALLSFSUB0(GENSET,genset)
-
-/*------------------------------------------------------------------
-fortran filename : genxpt.f
-------------------------------------------------------------------*/
-
-#define GENXPT(A1,A2,A3) CCALLSFSUB3(GENXPT,genxpt,INT,INT,FLOAT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : geta.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN7(DOUBLE,GETA,geta,DOUBLE,INT,INT,INT,INT,PDOUBLE,PDOUBLE)
-#define GETA(A2,A3,A4,A5,A6,A7,A8) CCALLSFFUN7(GETA,geta,DOUBLE,INT,INT,INT,INT,PDOUBLE,PDOUBLE,A2,A3,A4,A5,A6,A7,A8)
-
-/*------------------------------------------------------------------
-fortran filename : getene.f
-------------------------------------------------------------------*/
-
-#define GETENE(A1,A2,A3,A4) CCALLSFSUB4(GETENE,getene,FLOAT,FLOATV,INTV,INT,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : getnu.f
-------------------------------------------------------------------*/
-
-#define GETNU(A1,A2,A3,A4,A5) CCALLSFSUB5(GETNU,getnu,FLOATV,INTV,FLOAT,INT,PFLOAT,A1,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : getnum.f
-------------------------------------------------------------------*/
-
-#define GETNUM(A1,A2) CCALLSFSUB2(GETNUM,getnum,INTV,PINT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : getpar.f
-------------------------------------------------------------------*/
-
-#define GETPAR(A1,A2,A3) CCALLSFSUB3(GETPAR,getpar,INT,INT,PINT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : getshp.f
-------------------------------------------------------------------*/
-
-#define GETSHP(A1,A2) CCALLSFSUB2(GETSHP,getshp,INT,FLOATV,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : getver.f
-------------------------------------------------------------------*/
-/*
-#define getver_ELEMS_1 ZTRINGV_NUM(1)
-#define getver_ELEMLEN_1 ZTRINGV_NUM(8)
-*/
-
-#define GETVER(A1,A2) CCALLSFSUB2(GETVER,getver,PSTRING,PFLOAT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : gevkev.f
-------------------------------------------------------------------*/
-/*
-#define gevkev_ELEMS_3 ZTRINGV_NUM(1)
-#define gevkev_ELEMLEN_3 ZTRINGV_NUM(4)
-*/
-
-#define GEVKEV(A1,A2,A3) CCALLSFSUB3(GEVKEV,gevkev,FLOAT,PFLOAT,PSTRING,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : gfang.f
-------------------------------------------------------------------*/
-
-#define GFANG(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(GFANG,gfang,FLOATV,PFLOAT,PFLOAT,PFLOAT,PFLOAT,PLOGICAL,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : gfatt.f
-------------------------------------------------------------------*/
-/*
-#define gfatt_ELEMS_1 ZTRINGV_NUM(1)
-#define gfatt_ELEMLEN_1 ZTRINGV_NUM(4)
-#define gfatt_ELEMS_2 ZTRINGV_NUM(1)
-#define gfatt_ELEMLEN_2 ZTRINGV_NUM(4)
-*/
-
-#define GFATT(A1,A2,A3) CCALLSFSUB3(GFATT,gfatt,STRING,STRING,PINT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : gfclim.f
-------------------------------------------------------------------*/
-
-#define GFCLIM(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(GFCLIM,gfclim,INT,INT,INT,PFLOAT,PFLOAT,INT,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : gfcoor.f
-------------------------------------------------------------------*/
-
-#define GFCOOR(A1,A2,A3) CCALLSFSUB3(GFCOOR,gfcoor,FLOATV,INT,PFLOAT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : gfcord.f
-------------------------------------------------------------------*/
-
-#define GFCORD(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(GFCORD,gfcord,INT,FLOATV,FLOATV,PFLOAT,PINT,PINT,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : gfcoul.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN1(FLOAT,GFCOUL,gfcoul,FLOAT)
-#define GFCOUL(A2) CCALLSFFUN1(GFCOUL,gfcoul,FLOAT,A2)
-
-/*------------------------------------------------------------------
-fortran filename : gfcvol.f
-------------------------------------------------------------------*/
-
-#define GFCVOL() CCALLSFSUB0(GFCVOL,gfcvol)
-
-/*------------------------------------------------------------------
-fortran filename : gfdet.f
-------------------------------------------------------------------*/
-/*
-#define gfdet_ELEMS_1 ZTRINGV_NUM(1)
-#define gfdet_ELEMLEN_1 ZTRINGV_NUM(4)
-#define gfdet_ELEMS_2 ZTRINGV_NUM(1)
-#define gfdet_ELEMLEN_2 ZTRINGV_NUM(4)
-#define gfdet_ELEMS_4 ZTRINGV_NUM(1)
-#define gfdet_ELEMLEN_4 ZTRINGV_NUM(4)
-*/
-
-#define GFDET(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10) CCALLSFSUB10(GFDET,gfdet,STRING,STRING,PINT,STRINGV,PINT,INT,PINT,PINT,PINT,PINT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10)
-
-/*------------------------------------------------------------------
-fortran filename : gfdeta.f
-------------------------------------------------------------------*/
-/*
-#define gfdeta_ELEMS_1 ZTRINGV_NUM(1)
-#define gfdeta_ELEMLEN_1 ZTRINGV_NUM(4)
-#define gfdeta_ELEMS_2 ZTRINGV_NUM(1)
-#define gfdeta_ELEMLEN_2 ZTRINGV_NUM(4)
-*/
-
-#define GFDETA(A1,A2,A3) CCALLSFSUB3(GFDETA,gfdeta,STRING,STRING,INT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : gfdetd.f
-------------------------------------------------------------------*/
-/*
-#define gfdetd_ELEMS_1 ZTRINGV_NUM(1)
-#define gfdetd_ELEMLEN_1 ZTRINGV_NUM(4)
-#define gfdetd_ELEMS_2 ZTRINGV_NUM(1)
-#define gfdetd_ELEMLEN_2 ZTRINGV_NUM(4)
-#define gfdetd_ELEMS_4 ZTRINGV_NUM(1)
-#define gfdetd_ELEMLEN_4 ZTRINGV_NUM(4)
-*/
-
-#define GFDETD(A1,A2,A3,A4,A5) CCALLSFSUB5(GFDETD,gfdetd,STRING,STRING,PINT,STRINGV,PINT,A1,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : gfdeth.f
-------------------------------------------------------------------*/
-/*
-#define gfdeth_ELEMS_1 ZTRINGV_NUM(1)
-#define gfdeth_ELEMLEN_1 ZTRINGV_NUM(4)
-#define gfdeth_ELEMS_2 ZTRINGV_NUM(1)
-#define gfdeth_ELEMLEN_2 ZTRINGV_NUM(4)
-#define gfdeth_ELEMS_4 ZTRINGV_NUM(1)
-#define gfdeth_ELEMLEN_4 ZTRINGV_NUM(4)
-*/
-
-#define GFDETH(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(GFDETH,gfdeth,STRING,STRING,PINT,STRINGV,PINT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5,A6,A7)
-
-/*------------------------------------------------------------------
-fortran filename : gfdetu.f
-------------------------------------------------------------------*/
-/*
-#define gfdetu_ELEMS_1 ZTRINGV_NUM(1)
-#define gfdetu_ELEMLEN_1 ZTRINGV_NUM(4)
-#define gfdetu_ELEMS_2 ZTRINGV_NUM(1)
-#define gfdetu_ELEMLEN_2 ZTRINGV_NUM(4)
-*/
-
-#define GFDETU(A1,A2,A3,A4,A5) CCALLSFSUB5(GFDETU,gfdetu,STRING,STRING,INT,PINT,FLOATV,A1,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : gfdigi.f
-------------------------------------------------------------------*/
-/*
-#define gfdigi_ELEMS_1 ZTRINGV_NUM(1)
-#define gfdigi_ELEMLEN_1 ZTRINGV_NUM(4)
-#define gfdigi_ELEMS_2 ZTRINGV_NUM(1)
-#define gfdigi_ELEMLEN_2 ZTRINGV_NUM(4)
-*/
-
-#define GFDIGI(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12) CCALLSFSUB12(GFDIGI,gfdigi,STRING,STRING,INT,INT,INT,INT,INTV,PINT,PINT,PINT,PINT,PINT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12)
-
-/*------------------------------------------------------------------
-fortran filename : gffgo.f
-------------------------------------------------------------------*/
-
-#define GFFGO() CCALLSFSUB0(GFFGO,gffgo)
-
-/*------------------------------------------------------------------
-fortran filename : gfhead.f
-------------------------------------------------------------------*/
-
-#define GFHEAD(A1,A2,A3,A4) CCALLSFSUB4(GFHEAD,gfhead,PINT,PINT,PINT,PFLOAT,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : gfhits.f
-------------------------------------------------------------------*/
-/*
-#define gfhits_ELEMS_1 ZTRINGV_NUM(1)
-#define gfhits_ELEMLEN_1 ZTRINGV_NUM(4)
-#define gfhits_ELEMS_2 ZTRINGV_NUM(1)
-#define gfhits_ELEMLEN_2 ZTRINGV_NUM(4)
-*/
-
-#define GFHITS(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11) CCALLSFSUB11(GFHITS,gfhits,STRING,STRING,INT,INT,INT,INT,INTV,PINT,PINT,PFLOAT,PINT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11)
-
-/*------------------------------------------------------------------
-fortran filename : gfhsta.f
-------------------------------------------------------------------*/
-
-#define GFHSTA() CCALLSFSUB0(GFHSTA,gfhsta)
-
-/*------------------------------------------------------------------
-fortran filename : gfin.f
-------------------------------------------------------------------*/
-/*
-#define gfin_ELEMS_2 ZTRINGV_NUM(#{58{4Ø#)
-#define gfin_ELEMLEN_2 ZTRINGV_NUM(4)
-#define gfin_ELEMS_5 ZTRINGV_NUM(1)
-#define gfin_ELEMLEN_5 ZTRINGV_NUM(255)
-*/
-
-#define GFIN(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(GFIN,gfin,INT,STRINGV,INT,INT,STRING,PINT,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : gfind.f
-------------------------------------------------------------------*/
-/*
-#define gfind_ELEMS_1 ZTRINGV_NUM(1)
-#define gfind_ELEMLEN_1 ZTRINGV_NUM(4)
-#define gfind_ELEMS_2 ZTRINGV_NUM(1)
-#define gfind_ELEMLEN_2 ZTRINGV_NUM(4)
-*/
-
-#define GFIND(A1,A2,A3) CCALLSFSUB3(GFIND,gfind,STRING,STRING,PINT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : gfinds.f
-------------------------------------------------------------------*/
-
-#define GFINDS() CCALLSFSUB0(GFINDS,gfinds)
-
-/*------------------------------------------------------------------
-fortran filename : gfipar.f
-------------------------------------------------------------------*/
-
-#define GFIPAR(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(GFIPAR,gfipar,INT,INT,INT,PINT,PINT,FLOATV,FLOATV,A1,A2,A3,A4,A5,A6,A7)
-
-/*------------------------------------------------------------------
-fortran filename : gfkine.f
-------------------------------------------------------------------*/
-
-#define GFKINE(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(GFKINE,gfkine,INT,PFLOAT,PFLOAT,PINT,PINT,PFLOAT,PINT,A1,A2,A3,A4,A5,A6,A7)
-
-/*------------------------------------------------------------------
-fortran filename : gflcar.f
-------------------------------------------------------------------*/
-
-#define GFLCAR(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(GFLCAR,gflcar,INT,INT,INT,FLOATV,PFLOAT,PFLOAT,PINT,A1,A2,A3,A4,A5,A6,A7)
-
-/*------------------------------------------------------------------
-fortran filename : gflphi.f
-------------------------------------------------------------------*/
-
-#define GFLPHI(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(GFLPHI,gflphi,INT,INT,FLOATV,FLOATV,PFLOAT,PFLOAT,PINT,A1,A2,A3,A4,A5,A6,A7)
-
-/*------------------------------------------------------------------
-fortran filename : gflrad.f
-------------------------------------------------------------------*/
-
-#define GFLRAD(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(GFLRAD,gflrad,INT,INT,INT,FLOATV,FLOATV,PFLOAT,PFLOAT,PINT,A1,A2,A3,A4,A5,A6,A7,A8)
-
-/*------------------------------------------------------------------
-fortran filename : gflthe.f
-------------------------------------------------------------------*/
-
-#define GFLTHE(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(GFLTHE,gflthe,INT,INT,FLOATV,FLOATV,PFLOAT,PFLOAT,PINT,A1,A2,A3,A4,A5,A6,A7)
-
-/*------------------------------------------------------------------
-fortran filename : gfluct.f
-------------------------------------------------------------------*/
-
-#define GFLUCT(A1,A2) CCALLSFSUB2(GFLUCT,gfluct,FLOAT,PFLOAT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : gfmate.f
-------------------------------------------------------------------*/
-
-#define GFMATE(A1,A2,A3,A4,A5,A6,A7,A8,A9) CCALLSFSUB9(GFMATE,gfmate,INT,BYTE,PFLOAT,PFLOAT,PFLOAT,PFLOAT,PFLOAT,FLOATV,PINT,A1,A2,A3,A4,A5,A6,A7,A8,A9)
-
-/*------------------------------------------------------------------
-fortran filename : gfmdis.f
-------------------------------------------------------------------*/
-
-#define GFMDIS() CCALLSFSUB0(GFMDIS,gfmdis)
-
-/*------------------------------------------------------------------
-fortran filename : gfmfin.f
-------------------------------------------------------------------*/
-
-#define GFMFIN() CCALLSFSUB0(GFMFIN,gfmfin)
-
-/*------------------------------------------------------------------
-fortran filename : gfmoth.f
-------------------------------------------------------------------*/
-/*
-#define gfmoth_ELEMS_1 ZTRINGV_NUM(1)
-#define gfmoth_ELEMLEN_1 ZTRINGV_NUM(4)
-#define gfmoth_ELEMS_2 ZTRINGV_NUM(1)
-#define gfmoth_ELEMLEN_2 ZTRINGV_NUM(4)
-*/
-
-#define GFMOTH(A1,A2,A3) CCALLSFSUB3(GFMOTH,gfmoth,STRING,PSTRING,PINT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : gfndig.f
-------------------------------------------------------------------*/
-/*
-#define gfndig_ELEMS_1 ZTRINGV_NUM(1)
-#define gfndig_ELEMLEN_1 ZTRINGV_NUM(4)
-#define gfndig_ELEMS_2 ZTRINGV_NUM(1)
-#define gfndig_ELEMLEN_2 ZTRINGV_NUM(4)
-*/
-
-#define GFNDIG(A1,A2,A3) CCALLSFSUB3(GFNDIG,gfndig,STRING,STRING,PINT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : gfnhit.f
-------------------------------------------------------------------*/
-/*
-#define gfnhit_ELEMS_1 ZTRINGV_NUM(1)
-#define gfnhit_ELEMLEN_1 ZTRINGV_NUM(4)
-#define gfnhit_ELEMS_2 ZTRINGV_NUM(1)
-#define gfnhit_ELEMLEN_2 ZTRINGV_NUM(4)
-*/
-
-#define GFNHIT(A1,A2,A3) CCALLSFSUB3(GFNHIT,gfnhit,STRING,STRING,PINT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : gfnrdt.f
-------------------------------------------------------------------*/
-
-#define GFNRDT(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(GFNRDT,gfnrdt,FLOAT,FLOATV,INT,PINT,PINT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5,A6,A7)
-
-/*------------------------------------------------------------------
-fortran filename : gfout.f
-------------------------------------------------------------------*/
-/*
-#define gfout_ELEMS_2 ZTRINGV_NUM(#{5@{4à#)
-#define gfout_ELEMLEN_2 ZTRINGV_NUM(4)
-#define gfout_ELEMS_5 ZTRINGV_NUM(1)
-#define gfout_ELEMLEN_5 ZTRINGV_NUM(255)
-*/
-
-#define GFOUT(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(GFOUT,gfout,INT,STRINGV,INT,INT,STRING,PINT,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : gfpara.f
-------------------------------------------------------------------*/
-/*
-#define gfpara_ELEMS_1 ZTRINGV_NUM(1)
-#define gfpara_ELEMLEN_1 ZTRINGV_NUM(4)
-*/
-
-#define GFPARA(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(GFPARA,gfpara,STRING,INT,INT,PINT,PINT,PFLOAT,FLOATV,A1,A2,A3,A4,A5,A6,A7)
-
-/*------------------------------------------------------------------
-fortran filename : gfpart.f
-------------------------------------------------------------------*/
-/*
-#define gfpart_ELEMS_2 ZTRINGV_NUM(1)
-#define gfpart_ELEMLEN_2 ZTRINGV_NUM(20)
-*/
-
-#define GFPART(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(GFPART,gfpart,INT,STRING,PINT,PFLOAT,PFLOAT,PFLOAT,PFLOAT,PINT,A1,A2,A3,A4,A5,A6,A7,A8)
-
-/*------------------------------------------------------------------
-fortran filename : gfpath.f
-------------------------------------------------------------------*/
-
-#define GFPATH(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(GFPATH,gfpath,INT,INT,INTV,PINT,PINT,PINT,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : gfrdt.f
-------------------------------------------------------------------*/
-
-#define GFRDT(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(GFRDT,gfrdt,FLOAT,FLOATV,INT,PINT,PINT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5,A6,A7)
-
-/*------------------------------------------------------------------
-fortran filename : gfrung.f
-------------------------------------------------------------------*/
-
-#define GFRUNG(A1,A2,A3,A4) CCALLSFSUB4(GFRUNG,gfrung,PINT,PINT,PINT,PFLOAT,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : gfsdpr.f
-------------------------------------------------------------------*/
-
-#define GFSDPR(A1,A2,A3) CCALLSFSUB3(GFSDPR,gfsdpr,FLOAT,INT,PFLOAT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : gfshdc.f
-------------------------------------------------------------------*/
-
-#define GFSHDC(A1,A2) CCALLSFSUB2(GFSHDC,gfshdc,INT,FLOAT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : gfshls.f
-------------------------------------------------------------------*/
-
-#define GFSHLS(A1,A2,A3) CCALLSFSUB3(GFSHLS,gfshls,FLOAT,PFLOAT,PINT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : gfstat.f
-------------------------------------------------------------------*/
-
-#define GFSTAT(A1) CCALLSFSUB1(GFSTAT,gfstat,INT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : gftmat.f
-------------------------------------------------------------------*/
-/*
-#define gftmat_ELEMS_3 ZTRINGV_NUM(1)
-#define gftmat_ELEMLEN_3 ZTRINGV_NUM(4)
-*/
-
-#define GFTMAT(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(GFTMAT,gftmat,INT,INT,STRING,INT,FLOATV,PFLOAT,PFLOAT,PINT,A1,A2,A3,A4,A5,A6,A7,A8)
-
-/*------------------------------------------------------------------
-fortran filename : gftmed.f
-------------------------------------------------------------------*/
-/*
-#define gftmed_ELEMS_2 ZTRINGV_NUM(1)
-#define gftmed_ELEMLEN_2 ZTRINGV_NUM(20)
-*/
-
-#define GFTMED(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13) CCALLSFSUB13(GFTMED,gftmed,INT,STRING,PINT,PINT,PINT,PFLOAT,PFLOAT,PFLOAT,PFLOAT,PFLOAT,PFLOAT,PFLOAT,PINT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13)
-
-/*------------------------------------------------------------------
-fortran filename : gftrac.f
-------------------------------------------------------------------*/
-
-#define GFTRAC() CCALLSFSUB0(GFTRAC,gftrac)
-
-/*------------------------------------------------------------------
-fortran filename : gfupar.f
-------------------------------------------------------------------*/
-
-#define GFUPAR(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(GFUPAR,gfupar,INT,INT,PINT,PINT,PFLOAT,FLOATV,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : gfvert.f
-------------------------------------------------------------------*/
-
-#define GFVERT(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(GFVERT,gfvert,INT,PFLOAT,PINT,PINT,PFLOAT,PFLOAT,PINT,A1,A2,A3,A4,A5,A6,A7)
-
-/*------------------------------------------------------------------
-fortran filename : gfvolu.f
-------------------------------------------------------------------*/
-/*
-#define gfvolu_ELEMS_2 ZTRINGV_NUM(1)
-#define gfvolu_ELEMLEN_2 ZTRINGV_NUM(4)
-#define gfvolu_ELEMS_3 ZTRINGV_NUM(1)
-#define gfvolu_ELEMLEN_3 ZTRINGV_NUM(4)
-*/
-
-#define GFVOLU(A1,A2,A3) CCALLSFSUB3(GFVOLU,gfvolu,INT,STRING,PSTRING,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : ggcave.f
-------------------------------------------------------------------*/
-
-#define GGCAVE() CCALLSFSUB0(GGCAVE,ggcave)
-
-/*------------------------------------------------------------------
-fortran filename : ggckov.f
-------------------------------------------------------------------*/
-
-#define GGCKOV() CCALLSFSUB0(GGCKOV,ggckov)
-
-/*------------------------------------------------------------------
-fortran filename : ggclos.f
-------------------------------------------------------------------*/
-
-#define GGCLOS() CCALLSFSUB0(GGCLOS,ggclos)
-
-/*------------------------------------------------------------------
-fortran filename : ggdetv.f
-------------------------------------------------------------------*/
-
-#define GGDETV(A1,A2) CCALLSFSUB2(GGDETV,ggdetv,INT,INT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : ggdpar.f
-------------------------------------------------------------------*/
-
-#define GGDPAR(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(GGDPAR,ggdpar,INT,INT,INT,INTV,INT,PINT,PFLOAT,A1,A2,A3,A4,A5,A6,A7)
-
-/*------------------------------------------------------------------
-fortran filename : ggdspe.f
-------------------------------------------------------------------*/
-
-#define GGDSPE(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(GGDSPE,ggdspe,INT,INT,FLOATV,PINT,PINT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5,A6,A7)
-
-/*------------------------------------------------------------------
-fortran filename : ggdvlp.f
-------------------------------------------------------------------*/
-
-#define GGDVLP() CCALLSFSUB0(GGDVLP,ggdvlp)
-
-/*------------------------------------------------------------------
-fortran filename : gget.f
-------------------------------------------------------------------*/
-/*
-#define gget_ELEMS_2 ZTRINGV_NUM(1)
-#define gget_ELEMLEN_2 ZTRINGV_NUM(4)
-*/
-
-#define GGET(A1,A2,A3,A4,A5) CCALLSFSUB5(GGET,gget,INT,STRINGV,INT,PINT,PINT,A1,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : ggnlev.f
-------------------------------------------------------------------*/
-
-#define GGNLEV() CCALLSFSUB0(GGNLEV,ggnlev)
-
-/*------------------------------------------------------------------
-fortran filename : ggord.f
-------------------------------------------------------------------*/
-
-#define GGORD(A1) CCALLSFSUB1(GGORD,ggord,INT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : ggordq.f
-------------------------------------------------------------------*/
-
-#define GGORDQ(A1) CCALLSFSUB1(GGORDQ,ggordq,INT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : ggperp.f
-------------------------------------------------------------------*/
-
-#define GGPERP(A1,A2,A3) CCALLSFSUB3(GGPERP,ggperp,FLOATV,FLOATV,PINT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : ggppar.f
-------------------------------------------------------------------*/
-
-#define GGPPAR(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(GGPPAR,ggppar,INT,INT,INT,INTV,INT,PINT,PFLOAT,A1,A2,A3,A4,A5,A6,A7)
-
-/*------------------------------------------------------------------
-fortran filename : ggvchk.f
-------------------------------------------------------------------*/
-
-#define GGVCHK(A1,A2,A3,A4) CCALLSFSUB4(GGVCHK,ggvchk,INT,INT,PINT,PINT,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : ghclos.f
-------------------------------------------------------------------*/
-
-#define GHCLOS() CCALLSFSUB0(GHCLOS,ghclos)
-
-/*------------------------------------------------------------------
-fortran filename : gheini.f
-------------------------------------------------------------------*/
-
-#define GHEINI() CCALLSFSUB0(GHEINI,gheini)
-
-/*------------------------------------------------------------------
-fortran filename : gheish.f
-------------------------------------------------------------------*/
-
-#define GHEISH() CCALLSFSUB0(GHEISH,gheish)
-
-/*------------------------------------------------------------------
-fortran filename : ghelix.f
-------------------------------------------------------------------*/
-
-#define GHELIX(A1,A2,A3,A4) CCALLSFSUB4(GHELIX,ghelix,FLOAT,FLOAT,FLOATV,PFLOAT,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : ghelx3.f
-------------------------------------------------------------------*/
-
-#define GHELX3(A1,A2,A3,A4) CCALLSFSUB4(GHELX3,ghelx3,FLOAT,FLOAT,FLOATV,PFLOAT,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : ghepec.f
-------------------------------------------------------------------*/
-
-#define GHEPEC(A1) CCALLSFSUB1(GHEPEC,ghepec,INT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : ghesig.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN10(FLOAT,GHESIG,ghesig,FLOAT,FLOAT,FLOAT,FLOATV,FLOATV,FLOATV,INT,FLOAT,FLOAT,INT)
-#define GHESIG(A2,A3,A4,A5,A6,A7,A8,A9,A10,A11) CCALLSFFUN10(GHESIG,ghesig,FLOAT,FLOAT,FLOAT,FLOATV,FLOATV,FLOATV,INT,FLOAT,FLOAT,INT,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11)
-
-/*------------------------------------------------------------------
-fortran filename : ghetun.f
-------------------------------------------------------------------*/
-
-#define GHETUN(A1) CCALLSFSUB1(GHETUN,ghetun,PINT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : ghmix.f
-------------------------------------------------------------------*/
-
-#define GHMIX(A1,A2,A3,A4) CCALLSFSUB4(GHMIX,ghmix,FLOATV,FLOATV,INT,PFLOAT,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : ghsig.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN3(FLOAT,GHSIG,ghsig,FLOAT,INT,FLOAT)
-#define GHSIG(A2,A3,A4) CCALLSFFUN3(GHSIG,ghsig,FLOAT,INT,FLOAT,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : ghsigm.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN3(FLOAT,GHSIGM,ghsigm,FLOAT,INT,FLOAT)
-#define GHSIGM(A2,A3,A4) CCALLSFFUN3(GHSIGM,ghsigm,FLOAT,INT,FLOAT,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : ghstop.f
-------------------------------------------------------------------*/
-
-#define GHSTOP() CCALLSFSUB0(GHSTOP,ghstop)
-
-/*------------------------------------------------------------------
-fortran filename : gicyl.f
-------------------------------------------------------------------*/
-
-#define GICYL(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10) CCALLSFSUB10(GICYL,gicyl,FLOAT,FLOATV,FLOATV,FLOAT,FLOAT,INT,PFLOAT,PFLOAT,PFLOAT,PINT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10)
-
-/*------------------------------------------------------------------
-fortran filename : gidrop.f
-------------------------------------------------------------------*/
-
-#define GIDROP() CCALLSFSUB0(GIDROP,gidrop)
-
-/*------------------------------------------------------------------
-fortran filename : ginctu.f
-------------------------------------------------------------------*/
-
-#define GINCTU(A1,A2,A3) CCALLSFSUB3(GINCTU,ginctu,FLOATV,FLOATV,PINT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : gingtr.f
-------------------------------------------------------------------*/
-
-#define GINGTR(A1,A2,A3) CCALLSFSUB3(GINGTR,gingtr,FLOATV,FLOATV,PINT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : ginit.f
-------------------------------------------------------------------*/
-
-#define GINIT() CCALLSFSUB0(GINIT,ginit)
-
-/*------------------------------------------------------------------
-fortran filename : ginme.f
-------------------------------------------------------------------*/
-
-#define GINME(A1,A2,A3,A4) CCALLSFSUB4(GINME,ginme,FLOATV,FLOAT,FLOATV,PINT,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : ginpar.f
-------------------------------------------------------------------*/
-
-#define GINPAR(A1,A2,A3) CCALLSFSUB3(GINPAR,ginpar,FLOATV,FLOATV,PINT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : ginpco.f
-------------------------------------------------------------------*/
-
-#define GINPCO(A1,A2,A3) CCALLSFSUB3(GINPCO,ginpco,FLOATV,FLOATV,PINT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : ginpgo.f
-------------------------------------------------------------------*/
-
-#define GINPGO(A1,A2,A3) CCALLSFSUB3(GINPGO,ginpgo,FLOATV,FLOATV,PINT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : ginrot.f
-------------------------------------------------------------------*/
-
-#define GINROT(A1,A2,A3) CCALLSFSUB3(GINROT,ginrot,FLOATV,FLOATV,PFLOAT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : gintco.f
-------------------------------------------------------------------*/
-
-#define GINTCO(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(GINTCO,gintco,FLOATV,FLOAT,FLOAT,FLOAT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : gintri.f
-------------------------------------------------------------------*/
-
-#define GINTRI() CCALLSFSUB0(GINTRI,gintri)
-
-/*------------------------------------------------------------------
-fortran filename : gintrp.f
-------------------------------------------------------------------*/
-
-#define GINTRP(A1,A2,A3) CCALLSFSUB3(GINTRP,gintrp,FLOATV,FLOATV,PINT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : ginvol.f
-------------------------------------------------------------------*/
-
-#define GINVOL(A1,A2) CCALLSFSUB2(GINVOL,ginvol,FLOATV,PINT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : giplan.f
-------------------------------------------------------------------*/
-
-#define GIPLAN(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10) CCALLSFSUB10(GIPLAN,giplan,FLOAT,FLOATV,FLOATV,FLOAT,FLOAT,INT,PFLOAT,PFLOAT,PFLOAT,PINT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10)
-
-/*------------------------------------------------------------------
-fortran filename : gitran.f
-------------------------------------------------------------------*/
-
-#define GITRAN(A1,A2,A3,A4) CCALLSFSUB4(GITRAN,gitran,FLOATV,FLOATV,INT,PFLOAT,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : gjwrit.f
-------------------------------------------------------------------*/
-
-#define GJWRIT() CCALLSFSUB0(GJWRIT,gjwrit)
-
-/*------------------------------------------------------------------
-fortran filename : gkhits.f
-------------------------------------------------------------------*/
-/*
-#define gkhits_ELEMS_1 ZTRINGV_NUM(1)
-#define gkhits_ELEMLEN_1 ZTRINGV_NUM(4)
-#define gkhits_ELEMS_2 ZTRINGV_NUM(1)
-#define gkhits_ELEMLEN_2 ZTRINGV_NUM(4)
-*/
-
-#define GKHITS(A1,A2,A3) CCALLSFSUB3(GKHITS,gkhits,STRING,STRING,FLOAT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : gkokri.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN3(FLOAT,GKOKRI,gkokri,FLOAT,FLOAT,FLOAT)
-#define GKOKRI(A2,A3,A4) CCALLSFFUN3(GKOKRI,gkokri,FLOAT,FLOAT,FLOAT,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : gkxyz.f
-------------------------------------------------------------------*/
-
-#define GKXYZ(A1) CCALLSFSUB1(GKXYZ,gkxyz,FLOAT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : glande.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN1(FLOAT,GLANDE,glande,FLOAT)
-#define GLANDE(A2) CCALLSFFUN1(GLANDE,glande,FLOAT,A2)
-
-/*------------------------------------------------------------------
-fortran filename : glandg.f
-------------------------------------------------------------------*/
-
-#define GLANDG(A1) CCALLSFSUB1(GLANDG,glandg,PFLOAT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : glando.f
-------------------------------------------------------------------*/
-
-#define GLANDO(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10) CCALLSFSUB10(GLANDO,glando,INT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,PFLOAT,PINT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10)
-
-/*------------------------------------------------------------------
-fortran filename : glandr.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN1(FLOAT,GLANDR,glandr,FLOAT)
-#define GLANDR(A2) CCALLSFFUN1(GLANDR,glandr,FLOAT,A2)
-
-/*------------------------------------------------------------------
-fortran filename : glands.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN1(FLOAT,GLANDS,glands,FLOAT)
-#define GLANDS(A2) CCALLSFFUN1(GLANDS,glands,FLOAT,A2)
-
-/*------------------------------------------------------------------
-fortran filename : glandz.f
-------------------------------------------------------------------*/
-
-#define GLANDZ(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(GLANDZ,glandz,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,PFLOAT,FLOAT,FLOAT,A1,A2,A3,A4,A5,A6,A7,A8)
-
-/*------------------------------------------------------------------
-fortran filename : glast.f
-------------------------------------------------------------------*/
-
-#define GLAST() CCALLSFSUB0(GLAST,glast)
-
-/*------------------------------------------------------------------
-fortran filename : glight.f
-------------------------------------------------------------------*/
-
-#define GLIGHT(A1,A2,A3,A4) CCALLSFSUB4(GLIGHT,glight,FLOAT,FLOAT,FLOAT,INT,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : glisur.f
-------------------------------------------------------------------*/
-
-#define GLISUR(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(GLISUR,glisur,FLOATV,FLOATV,INT,INT,PFLOAT,PFLOAT,INT,A1,A2,A3,A4,A5,A6,A7)
-
-/*------------------------------------------------------------------
-fortran filename : glmoth.f
-------------------------------------------------------------------*/
-/*
-#define glmoth_ELEMS_1 ZTRINGV_NUM(1)
-#define glmoth_ELEMLEN_1 ZTRINGV_NUM(255)
-*/
-
-#define GLMOTH(A1,A2,A3,A4,A5) CCALLSFSUB5(GLMOTH,glmoth,STRING,INT,PINT,PINT,PINT,A1,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : glook.f
-------------------------------------------------------------------*/
-/*
-#define glook_ELEMS_1 ZTRINGV_NUM(1)
-#define glook_ELEMLEN_1 ZTRINGV_NUM(255)
-*/
-
-#define GLOOK(A1,A2,A3,A4) CCALLSFSUB4(GLOOK,glook,STRING,INTV,INT,PINT,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : gloren.f
-------------------------------------------------------------------*/
-
-#define GLOREN(A1,A2,A3) CCALLSFSUB3(GLOREN,gloren,FLOATV,FLOATV,PFLOAT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : glsklt.f
-------------------------------------------------------------------*/
-
-#define GLSKLT() CCALLSFSUB0(GLSKLT,glsklt)
-
-/*------------------------------------------------------------------
-fortran filename : gltrac.f
-------------------------------------------------------------------*/
-
-#define GLTRAC() CCALLSFSUB0(GLTRAC,gltrac)
-
-/*------------------------------------------------------------------
-fortran filename : gludky.f
-------------------------------------------------------------------*/
-
-#define GLUDKY() CCALLSFSUB0(GLUDKY,gludky)
-
-/*------------------------------------------------------------------
-fortran filename : glund.f
-------------------------------------------------------------------*/
-
-#define GLUND() CCALLSFSUB0(GLUND,glund)
-
-/*------------------------------------------------------------------
-fortran filename : glundi.f
-------------------------------------------------------------------*/
-
-#define GLUNDI() CCALLSFSUB0(GLUNDI,glundi)
-
-/*------------------------------------------------------------------
-fortran filename : glvolu.f
-------------------------------------------------------------------*/
-
-#define GLVOLU(A1,A2,A3,A4) CCALLSFSUB4(GLVOLU,glvolu,INT,INTV,INTV,PINT,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : gm3pol.f
-------------------------------------------------------------------*/
-
-#define GM3POL(A1,A2) CCALLSFSUB2(GM3POL,gm3pol,FLOAT,INT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : gmail.f
-------------------------------------------------------------------*/
-
-#define GMAIL(A1,A2) CCALLSFSUB2(GMAIL,gmail,INT,INT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : gmate.f
-------------------------------------------------------------------*/
-
-#define GMATE() CCALLSFSUB0(GMATE,gmate)
-
-/*------------------------------------------------------------------
-fortran filename : gmclos.f
-------------------------------------------------------------------*/
-
-#define GMCLOS() CCALLSFSUB0(GMCLOS,gmclos)
-
-/*------------------------------------------------------------------
-fortran filename : gmcoul.f
-------------------------------------------------------------------*/
-
-#define GMCOUL(A1,A2) CCALLSFSUB2(GMCOUL,gmcoul,FLOAT,PFLOAT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : gmedia.f
-------------------------------------------------------------------*/
-
-#define GMEDIA(A1,A2) CCALLSFSUB2(GMEDIA,gmedia,FLOATV,PINT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : gmedin.f
-------------------------------------------------------------------*/
-
-#define GMEDIN() CCALLSFSUB0(GMEDIN,gmedin)
-
-/*------------------------------------------------------------------
-fortran filename : gmediv.f
-------------------------------------------------------------------*/
-
-#define GMEDIV(A1,A2,A3,A4) CCALLSFSUB4(GMEDIV,gmediv,INT,PINT,PFLOAT,INT,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : gmepos.f
-------------------------------------------------------------------*/
-
-#define GMEPOS(A1,A2,A3,A4) CCALLSFSUB4(GMEPOS,gmepos,INT,INT,PFLOAT,INT,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : gmgaus.f
-------------------------------------------------------------------*/
-
-#define GMGAUS(A1,A2) CCALLSFSUB2(GMGAUS,gmgaus,FLOAT,PFLOAT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : gmicap.f
-------------------------------------------------------------------*/
-
-#define GMICAP() CCALLSFSUB0(GMICAP,gmicap)
-
-/*------------------------------------------------------------------
-fortran filename : gmol4.f
-------------------------------------------------------------------*/
-
-#define GMOL4(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(GMOL4,gmol4,PFLOAT,FLOAT,PFLOAT,PFLOAT,FLOAT,PINT,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : gmoli.f
-------------------------------------------------------------------*/
-
-#define GMOLI(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(GMOLI,gmoli,FLOATV,FLOATV,FLOATV,INT,FLOAT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5,A6,A7)
-
-/*------------------------------------------------------------------
-fortran filename : gmolie.f
-------------------------------------------------------------------*/
-
-#define GMOLIE(A1,A2,A3) CCALLSFSUB3(GMOLIE,gmolie,FLOAT,FLOAT,PFLOAT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : gmolio.f
-------------------------------------------------------------------*/
-
-#define GMOLIO(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(GMOLIO,gmolio,FLOATV,FLOATV,FLOATV,INT,FLOAT,FLOAT,FLOAT,PFLOAT,A1,A2,A3,A4,A5,A6,A7,A8)
-
-/*------------------------------------------------------------------
-fortran filename : gmopen.f
-------------------------------------------------------------------*/
-
-#define GMOPEN(A1,A2,A3) CCALLSFSUB3(GMOPEN,gmopen,FLOAT,FLOAT,INT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : gmorin.f
-------------------------------------------------------------------*/
-
-#define GMORIN() CCALLSFSUB0(GMORIN,gmorin)
-
-/*------------------------------------------------------------------
-fortran filename : gmplxs.f
-------------------------------------------------------------------*/
-
-#define GMPLXS(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15,A16,A17,A18,A19,A20,A21,A22,A23,A24,A25,A26,A27,A28,A29,A30,A31,A32,A33,A34,A35,A36,A37,A38,A39,A40,A41,A42,A43,A44,A45,A46,A47,A48,A49,A50) CCALLSFSUB50(GMPLXS,gmplxs,FLOATV,INTV,INTV,INTV,INTV,INTV,INTV,INTV,PINT,PINT,INTV,INTV,PINT,PINT,FLOATV,PFLOAT,INTV,INTV,INTV,INTV,INTV,INTV,INTV,INTV,INTV,INTV,INTV,INTV,INTV,INTV,INTV,INTV,INTV,INTV,INTV,INTV,INTV,INTV,INTV,INTV,INTV,PINT,PINT,INTV,PINT,PFLOAT,INT,INT,INT,PFLOAT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15,A16,A17,A18,A19,A20,A21,A22,A23,A24,A25,A26,A27,A28,A29,A30,A31,A32,A33,A34,A35,A36,A37,A38,A39,A40,A41,A42,A43,A44,A45,A46,A47,A48,A49,A50)
-
-/*------------------------------------------------------------------
-fortran filename : gmtod.f
-------------------------------------------------------------------*/
-
-#define GMTOD(A1,A2,A3) CCALLSFSUB3(GMTOD,gmtod,FLOATV,PFLOAT,INT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : gmulof.f
-------------------------------------------------------------------*/
-
-#define GMULOF() CCALLSFSUB0(GMULOF,gmulof)
-
-/*------------------------------------------------------------------
-fortran filename : gmults.f
-------------------------------------------------------------------*/
-
-#define GMULTS() CCALLSFSUB0(GMULTS,gmults)
-
-/*------------------------------------------------------------------
-fortran filename : gmunu.f
-------------------------------------------------------------------*/
-
-#define GMUNU() CCALLSFSUB0(GMUNU,gmunu)
-
-/*------------------------------------------------------------------
-fortran filename : gmunui.f
-------------------------------------------------------------------*/
-
-#define GMUNUI() CCALLSFSUB0(GMUNUI,gmunui)
-
-/*------------------------------------------------------------------
-fortran filename : gmusig.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN3(FLOAT,GMUSIG,gmusig,FLOAT,FLOAT,FLOAT)
-#define GMUSIG(A2,A3,A4) CCALLSFFUN3(GMUSIG,gmusig,FLOAT,FLOAT,FLOAT,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : gmxsec.f
-------------------------------------------------------------------*/
-
-#define GMXSEC(A1,A2) CCALLSFSUB2(GMXSEC,gmxsec,INT,PFLOAT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : gnbox.f
-------------------------------------------------------------------*/
-
-#define GNBOX(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(GNBOX,gnbox,FLOATV,FLOATV,INT,FLOAT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : gnckov.f
-------------------------------------------------------------------*/
-
-#define GNCKOV() CCALLSFSUB0(GNCKOV,gnckov)
-
-/*------------------------------------------------------------------
-fortran filename : gncone.f
-------------------------------------------------------------------*/
-
-#define GNCONE(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(GNCONE,gncone,FLOATV,FLOATV,INT,INT,FLOAT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5,A6,A7)
-
-/*------------------------------------------------------------------
-fortran filename : gnctub.f
-------------------------------------------------------------------*/
-
-#define GNCTUB(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(GNCTUB,gnctub,FLOATV,FLOATV,INT,FLOAT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : gneltu.f
-------------------------------------------------------------------*/
-
-#define GNELTU(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(GNELTU,gneltu,FLOATV,FLOATV,INT,FLOAT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : gnext.f
-------------------------------------------------------------------*/
-
-#define GNEXT(A1,A2,A3) CCALLSFSUB3(GNEXT,gnext,FLOATV,PFLOAT,PFLOAT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : gnhype.f
-------------------------------------------------------------------*/
-
-#define GNHYPE(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(GNHYPE,gnhype,FLOATV,FLOATV,INT,FLOAT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : gnobox.f
-------------------------------------------------------------------*/
-
-#define GNOBOX(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(GNOBOX,gnobox,FLOATV,FLOATV,INT,FLOAT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : gnocon.f
-------------------------------------------------------------------*/
-
-#define GNOCON(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(GNOCON,gnocon,FLOATV,FLOATV,INT,INT,FLOAT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5,A6,A7)
-
-/*------------------------------------------------------------------
-fortran filename : gnoctu.f
-------------------------------------------------------------------*/
-
-#define GNOCTU(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(GNOCTU,gnoctu,FLOATV,FLOATV,INT,FLOAT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : gnoelt.f
-------------------------------------------------------------------*/
-
-#define GNOELT(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(GNOELT,gnoelt,FLOATV,FLOATV,INT,FLOAT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : gnohyp.f
-------------------------------------------------------------------*/
-
-#define GNOHYP(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(GNOHYP,gnohyp,FLOATV,FLOATV,INT,FLOAT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : gnopar.f
-------------------------------------------------------------------*/
-
-#define GNOPAR(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(GNOPAR,gnopar,FLOATV,FLOATV,INT,FLOAT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : gnopco.f
-------------------------------------------------------------------*/
-
-#define GNOPCO(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(GNOPCO,gnopco,FLOATV,FLOATV,INT,FLOAT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : gnopg1.f
-------------------------------------------------------------------*/
-
-#define GNOPG1(A1,A2,A3) CCALLSFSUB3(GNOPG1,gnopg1,FLOATV,FLOATV,PFLOAT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : gnopgo.f
-------------------------------------------------------------------*/
-
-#define GNOPGO(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(GNOPGO,gnopgo,FLOATV,FLOATV,INT,FLOAT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : gnosph.f
-------------------------------------------------------------------*/
-
-#define GNOSPH(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(GNOSPH,gnosph,FLOATV,FLOATV,INT,FLOAT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : gnotr1.f
-------------------------------------------------------------------*/
-
-#define GNOTR1(A1) CCALLSFSUB1(GNOTR1,gnotr1,FLOATV,A1)
-
-/*------------------------------------------------------------------
-fortran filename : gnotr2.f
-------------------------------------------------------------------*/
-
-#define GNOTR2(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(GNOTR2,gnotr2,FLOATV,FLOATV,FLOATV,INT,INT,INT,INT,PFLOAT,A1,A2,A3,A4,A5,A6,A7,A8)
-
-/*------------------------------------------------------------------
-fortran filename : gnotr9.f
-------------------------------------------------------------------*/
-
-#define GNOTR9(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(GNOTR9,gnotr9,FLOATV,FLOATV,FLOATV,INT,INT,INT,INT,A1,A2,A3,A4,A5,A6,A7)
-
-/*------------------------------------------------------------------
-fortran filename : gnotra.f
-------------------------------------------------------------------*/
-
-#define GNOTRA(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(GNOTRA,gnotra,FLOATV,FLOATV,INT,INT,FLOAT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5,A6,A7)
-
-/*------------------------------------------------------------------
-fortran filename : gnotrp.f
-------------------------------------------------------------------*/
-
-#define GNOTRP(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(GNOTRP,gnotrp,FLOATV,FLOATV,INT,FLOAT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : gnotub.f
-------------------------------------------------------------------*/
-
-#define GNOTUB(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(GNOTUB,gnotub,FLOATV,FLOATV,INT,INT,FLOAT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5,A6,A7)
-
-/*------------------------------------------------------------------
-fortran filename : gnpara.f
-------------------------------------------------------------------*/
-
-#define GNPARA(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(GNPARA,gnpara,FLOATV,FLOATV,INT,FLOAT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : gnpcon.f
-------------------------------------------------------------------*/
-
-#define GNPCON(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(GNPCON,gnpcon,FLOATV,FLOATV,INT,FLOAT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : gnpgo1.f
-------------------------------------------------------------------*/
-
-#define GNPGO1(A1,A2,A3) CCALLSFSUB3(GNPGO1,gnpgo1,FLOATV,FLOATV,PFLOAT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : gnpgon.f
-------------------------------------------------------------------*/
-
-#define GNPGON(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(GNPGON,gnpgon,FLOATV,FLOATV,INT,FLOAT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : gnslwd.f
-------------------------------------------------------------------*/
-
-#define GNSLWD(A1,A2,A3,A4) CCALLSFSUB4(GNSLWD,gnslwd,PINT,INT,INT,FLOAT,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : gnsphr.f
-------------------------------------------------------------------*/
-
-#define GNSPHR(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(GNSPHR,gnsphr,FLOATV,FLOATV,INT,FLOAT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : gntrap.f
-------------------------------------------------------------------*/
-
-#define GNTRAP(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(GNTRAP,gntrap,FLOATV,FLOATV,INT,INT,FLOAT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5,A6,A7)
-
-/*------------------------------------------------------------------
-fortran filename : gntrp.f
-------------------------------------------------------------------*/
-
-#define GNTRP(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(GNTRP,gntrp,FLOATV,FLOATV,INT,FLOAT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : gntube.f
-------------------------------------------------------------------*/
-
-#define GNTUBE(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(GNTUBE,gntube,FLOATV,FLOATV,INT,INT,FLOAT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5,A6,A7)
-
-/*------------------------------------------------------------------
-fortran filename : gopen.f
-------------------------------------------------------------------*/
-/*
-#define gopen_ELEMS_2 ZTRINGV_NUM(1)
-#define gopen_ELEMLEN_2 ZTRINGV_NUM(255)
-*/
-
-#define GOPEN(A1,A2,A3,A4) CCALLSFSUB4(GOPEN,gopen,INT,STRING,INT,PINT,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : goptim.f
-------------------------------------------------------------------*/
-
-#define GOPTIM(A1) CCALLSFSUB1(GOPTIM,goptim,INT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : goscin.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN2(FLOAT,GOSCIN,goscin,FLOAT,FLOAT)
-#define GOSCIN(A2,A3) CCALLSFFUN2(GOSCIN,goscin,FLOAT,FLOAT,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : gpairg.f
-------------------------------------------------------------------*/
-/*------------------------------------------------------------------
-fortran filename : gpairm.f
-------------------------------------------------------------------*/
-
-#define GPAIRM() CCALLSFSUB0(GPAIRM,gpairm)
-
-/*------------------------------------------------------------------
-fortran filename : gpart.f
-------------------------------------------------------------------*/
-
-#define GPART() CCALLSFSUB0(GPART,gpart)
-
-/*------------------------------------------------------------------
-fortran filename : gpaset.f
-------------------------------------------------------------------*/
-
-#define GPASET(A1) CCALLSFSUB1(GPASET,gpaset,FLOATV,A1)
-
-/*------------------------------------------------------------------
-fortran filename : gpaw.f
-------------------------------------------------------------------*/
-
-#define GPAW(A1,A2) CCALLSFSUB2(GPAW,gpaw,INT,INT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : gpawpp.f
-------------------------------------------------------------------*/
-
-#define GPAWPP(A1,A2) CCALLSFSUB2(GPAWPP,gpawpp,INT,INT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : gpcset.f
-------------------------------------------------------------------*/
-
-#define GPCSET(A1) CCALLSFSUB1(GPCSET,gpcset,FLOATV,A1)
-
-/*------------------------------------------------------------------
-fortran filename : gpcxyz.f
-------------------------------------------------------------------*/
-
-#define GPCXYZ() CCALLSFSUB0(GPCXYZ,gpcxyz)
-
-/*------------------------------------------------------------------
-fortran filename : gpdigi.f
-------------------------------------------------------------------*/
-/*
-#define gpdigi_ELEMS_1 ZTRINGV_NUM(1)
-#define gpdigi_ELEMLEN_1 ZTRINGV_NUM(4)
-#define gpdigi_ELEMS_2 ZTRINGV_NUM(1)
-#define gpdigi_ELEMLEN_2 ZTRINGV_NUM(4)
-*/
-
-#define GPDIGI(A1,A2) CCALLSFSUB2(GPDIGI,gpdigi,STRING,STRING,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : gpdk.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN3(FLOAT,GPDK,gpdk,FLOAT,FLOAT,FLOAT)
-#define GPDK(A2,A3,A4) CCALLSFFUN3(GPDK,gpdk,FLOAT,FLOAT,FLOAT,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : gpdrif.f
-------------------------------------------------------------------*/
-
-#define GPDRIF(A1,A2,A3) CCALLSFSUB3(GPDRIF,gpdrif,FLOATV,FLOATV,PINT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : gpfis.f
-------------------------------------------------------------------*/
-
-#define GPFIS() CCALLSFSUB0(GPFIS,gpfis)
-
-/*------------------------------------------------------------------
-fortran filename : gpfisi.f
-------------------------------------------------------------------*/
-
-#define GPFISI() CCALLSFSUB0(GPFISI,gpfisi)
-
-/*------------------------------------------------------------------
-fortran filename : gpghei.f
-------------------------------------------------------------------*/
-
-#define GPGHEI() CCALLSFSUB0(GPGHEI,gpghei)
-
-/*------------------------------------------------------------------
-fortran filename : gpgkin.f
-------------------------------------------------------------------*/
-
-#define GPGKIN() CCALLSFSUB0(GPGKIN,gpgkin)
-
-/*------------------------------------------------------------------
-fortran filename : gpgset.f
-------------------------------------------------------------------*/
-
-#define GPGSET(A1) CCALLSFSUB1(GPGSET,gpgset,FLOATV,A1)
-
-/*------------------------------------------------------------------
-fortran filename : gphak.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN1(FLOAT,GPHAK,gphak,FLOAT)
-#define GPHAK(A2) CCALLSFFUN1(GPHAK,gphak,FLOAT,A2)
-
-/*------------------------------------------------------------------
-fortran filename : gphal2.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN1(FLOAT,GPHAL2,gphal2,FLOAT)
-#define GPHAL2(A2) CCALLSFFUN1(GPHAL2,gphal2,FLOAT,A2)
-
-/*------------------------------------------------------------------
-fortran filename : gphal3.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN1(FLOAT,GPHAL3,gphal3,FLOAT)
-#define GPHAL3(A2) CCALLSFFUN1(GPHAL3,gphal3,FLOAT,A2)
-
-/*------------------------------------------------------------------
-fortran filename : gphead.f
-------------------------------------------------------------------*/
-
-#define GPHEAD() CCALLSFSUB0(GPHEAD,gphead)
-
-/*------------------------------------------------------------------
-fortran filename : gphini.f
-------------------------------------------------------------------*/
-
-#define GPHINI() CCALLSFSUB0(GPHINI,gphini)
-
-/*------------------------------------------------------------------
-fortran filename : gphits.f
-------------------------------------------------------------------*/
-/*
-#define gphits_ELEMS_1 ZTRINGV_NUM(1)
-#define gphits_ELEMLEN_1 ZTRINGV_NUM(4)
-#define gphits_ELEMS_2 ZTRINGV_NUM(1)
-#define gphits_ELEMLEN_2 ZTRINGV_NUM(4)
-*/
-
-#define GPHITS(A1,A2) CCALLSFSUB2(GPHITS,gphits,STRING,STRING,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : gphmfi.f
-------------------------------------------------------------------*/
-
-#define GPHMFI() CCALLSFSUB0(GPHMFI,gphmfi)
-
-/*------------------------------------------------------------------
-fortran filename : gphot.f
-------------------------------------------------------------------*/
-
-#define GPHOT() CCALLSFSUB0(GPHOT,gphot)
-
-/*------------------------------------------------------------------
-fortran filename : gphoti.f
-------------------------------------------------------------------*/
-
-#define GPHOTI() CCALLSFSUB0(GPHOTI,gphoti)
-
-/*------------------------------------------------------------------
-fortran filename : gphrin.f
-------------------------------------------------------------------*/
-
-#define GPHRIN() CCALLSFSUB0(GPHRIN,gphrin)
-
-/*------------------------------------------------------------------
-fortran filename : gphsg1.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN1(FLOAT,GPHSG1,gphsg1,FLOAT)
-#define GPHSG1(A2) CCALLSFFUN1(GPHSG1,gphsg1,FLOAT,A2)
-
-/*------------------------------------------------------------------
-fortran filename : gphsg2.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN1(FLOAT,GPHSG2,gphsg2,FLOAT)
-#define GPHSG2(A2) CCALLSFFUN1(GPHSG2,gphsg2,FLOAT,A2)
-
-/*------------------------------------------------------------------
-fortran filename : gphsgp.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN2(FLOAT,GPHSGP,gphsgp,INT,FLOAT)
-#define GPHSGP(A2,A3) CCALLSFFUN2(GPHSGP,gphsgp,INT,FLOAT,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : gphsig.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN2(FLOAT,GPHSIG,gphsig,FLOAT,FLOAT)
-#define GPHSIG(A2,A3) CCALLSFFUN2(GPHSIG,gphsig,FLOAT,FLOAT,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : gphxin.f
-------------------------------------------------------------------*/
-
-#define GPHXIN() CCALLSFSUB0(GPHXIN,gphxin)
-
-/*------------------------------------------------------------------
-fortran filename : gphxsi.f
-------------------------------------------------------------------*/
-
-#define GPHXSI() CCALLSFSUB0(GPHXSI,gphxsi)
-
-/*------------------------------------------------------------------
-fortran filename : gphysi.f
-------------------------------------------------------------------*/
-
-#define GPHYSI() CCALLSFSUB0(GPHYSI,gphysi)
-
-/*------------------------------------------------------------------
-fortran filename : gpions.f
-------------------------------------------------------------------*/
-
-#define GPIONS() CCALLSFSUB0(GPIONS,gpions)
-
-/*------------------------------------------------------------------
-fortran filename : gpjxyz.f
-------------------------------------------------------------------*/
-
-#define GPJXYZ(A1) CCALLSFSUB1(GPJXYZ,gpjxyz,INT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : gpkine.f
-------------------------------------------------------------------*/
-
-#define GPKINE(A1) CCALLSFSUB1(GPKINE,gpkine,INT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : gpkinx.f
-------------------------------------------------------------------*/
-
-#define GPKINX(A1) CCALLSFSUB1(GPKINX,gpkinx,INT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : gplmat.f
-------------------------------------------------------------------*/
-/*
-#define gplmat_ELEMS_3 ZTRINGV_NUM(1)
-#define gplmat_ELEMLEN_3 ZTRINGV_NUM(255)
-*/
-
-#define GPLMAT(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(GPLMAT,gplmat,INT,INT,STRING,INT,FLOATV,INT,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : gpmate.f
-------------------------------------------------------------------*/
-
-#define GPMATE(A1) CCALLSFSUB1(GPMATE,gpmate,INT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : gpmatx.f
-------------------------------------------------------------------*/
-
-#define GPMATX(A1) CCALLSFSUB1(GPMATX,gpmatx,INT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : gpmwpc.f
-------------------------------------------------------------------*/
-
-#define GPMWPC(A1,A2,A3) CCALLSFSUB3(GPMWPC,gpmwpc,FLOATV,FLOATV,PINT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : gpoiss.f
-------------------------------------------------------------------*/
-
-#define GPOISS(A1,A2,A3) CCALLSFSUB3(GPOISS,gpoiss,FLOATV,PINT,INT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : gposi.f
-------------------------------------------------------------------*/
-/*
-#define gposi_ELEMS_3 ZTRINGV_NUM(1)
-#define gposi_ELEMLEN_3 ZTRINGV_NUM(10)
-*/
-
-#define GPOSI(A1,A2,A3,A4) CCALLSFSUB4(GPOSI,gposi,FLOATV,FLOATV,STRING,INT,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : gppart.f
-------------------------------------------------------------------*/
-
-#define GPPART(A1) CCALLSFSUB1(GPPART,gppart,INT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : gpparx.f
-------------------------------------------------------------------*/
-
-#define GPPARX(A1) CCALLSFSUB1(GPPARX,gpparx,INT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : gprela.f
-------------------------------------------------------------------*/
-
-#define GPRELA() CCALLSFSUB0(GPRELA,gprela)
-
-/*------------------------------------------------------------------
-fortran filename : gprelm.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN3(FLOAT,GPRELM,gprelm,FLOAT,FLOAT,FLOAT)
-#define GPRELM(A2,A3,A4) CCALLSFFUN3(GPRELM,gprelm,FLOAT,FLOAT,FLOAT,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : gprint.f
-------------------------------------------------------------------*/
-/*
-#define gprint_ELEMS_1 ZTRINGV_NUM(1)
-#define gprint_ELEMLEN_1 ZTRINGV_NUM(255)
-*/
-
-#define GPRINT(A1,A2) CCALLSFSUB2(GPRINT,gprint,STRING,INT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : gprmat.f
-------------------------------------------------------------------*/
-/*
-#define gprmat_ELEMS_3 ZTRINGV_NUM(1)
-#define gprmat_ELEMLEN_3 ZTRINGV_NUM(255)
-*/
-
-#define GPRMAT(A1,A2,A3,A4,A5) CCALLSFSUB5(GPRMAT,gprmat,INT,INT,STRING,INT,FLOATV,A1,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : gprobi.f
-------------------------------------------------------------------*/
-
-#define GPROBI() CCALLSFSUB0(GPROBI,gprobi)
-
-/*------------------------------------------------------------------
-fortran filename : gprotm.f
-------------------------------------------------------------------*/
-
-#define GPROTM(A1) CCALLSFSUB1(GPROTM,gprotm,INT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : gprotx.f
-------------------------------------------------------------------*/
-
-#define GPROTX(A1) CCALLSFSUB1(GPROTX,gprotx,INT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : gprsga.f
-------------------------------------------------------------------*/
-
-#define GPRSGA() CCALLSFSUB0(GPRSGA,gprsga)
-
-/*------------------------------------------------------------------
-fortran filename : gprsgg.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN2(FLOAT,GPRSGG,gprsgg,FLOAT,FLOAT)
-#define GPRSGG(A2,A3) CCALLSFFUN2(GPRSGG,gprsgg,FLOAT,FLOAT,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : gprsgm.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN3(FLOAT,GPRSGM,gprsgm,FLOAT,FLOAT,FLOAT)
-#define GPRSGM(A2,A3,A4) CCALLSFFUN3(GPRSGM,gprsgm,FLOAT,FLOAT,FLOAT,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : gprung.f
-------------------------------------------------------------------*/
-
-#define GPRUNG() CCALLSFSUB0(GPRUNG,gprung)
-
-/*------------------------------------------------------------------
-fortran filename : gpscin.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN4(DOUBLE,GPSCIN,gpscin,DOUBLE,DOUBLE,DOUBLE,FLOATV)
-#define GPSCIN(A2,A3,A4,A5) CCALLSFFUN4(GPSCIN,gpscin,DOUBLE,DOUBLE,DOUBLE,FLOATV,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : gpsets.f
-------------------------------------------------------------------*/
-/*
-#define gpsets_ELEMS_1 ZTRINGV_NUM(1)
-#define gpsets_ELEMLEN_1 ZTRINGV_NUM(4)
-#define gpsets_ELEMS_2 ZTRINGV_NUM(1)
-#define gpsets_ELEMLEN_2 ZTRINGV_NUM(4)
-*/
-
-#define GPSETS(A1,A2) CCALLSFSUB2(GPSETS,gpsets,STRING,STRING,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : gpstat.f
-------------------------------------------------------------------*/
-
-#define GPSTAT() CCALLSFSUB0(GPSTAT,gpstat)
-
-/*------------------------------------------------------------------
-fortran filename : gptmed.f
-------------------------------------------------------------------*/
-
-#define GPTMED(A1) CCALLSFSUB1(GPTMED,gptmed,INT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : gptmex.f
-------------------------------------------------------------------*/
-
-#define GPTMEX(A1) CCALLSFSUB1(GPTMEX,gptmex,INT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : gptset.f
-------------------------------------------------------------------*/
-
-#define GPTSET(A1,A2) CCALLSFSUB2(GPTSET,gptset,INT,INT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : gpvert.f
-------------------------------------------------------------------*/
-
-#define GPVERT(A1) CCALLSFSUB1(GPVERT,gpvert,INT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : gpvolu.f
-------------------------------------------------------------------*/
-
-#define GPVOLU(A1) CCALLSFSUB1(GPVOLU,gpvolu,INT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : gpvolx.f
-------------------------------------------------------------------*/
-
-#define GPVOLX(A1) CCALLSFSUB1(GPVOLX,gpvolx,INT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : grangi.f
-------------------------------------------------------------------*/
-
-#define GRANGI() CCALLSFSUB0(GRANGI,grangi)
-
-/*------------------------------------------------------------------
-fortran filename : granor.f
-------------------------------------------------------------------*/
-
-#define GRANOR(A1,A2) CCALLSFSUB2(GRANOR,granor,PFLOAT,PFLOAT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : grayl.f
-------------------------------------------------------------------*/
-
-#define GRAYL() CCALLSFSUB0(GRAYL,grayl)
-
-/*------------------------------------------------------------------
-fortran filename : grayli.f
-------------------------------------------------------------------*/
-
-#define GRAYLI() CCALLSFSUB0(GRAYLI,grayli)
-
-/*------------------------------------------------------------------
-fortran filename : grend.f
-------------------------------------------------------------------*/
-
-#define GREND(A1) CCALLSFSUB1(GREND,grend,INT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : greswk.f
-------------------------------------------------------------------*/
-
-#define GRESWK() CCALLSFSUB0(GRESWK,greswk)
-
-/*------------------------------------------------------------------
-fortran filename : greucl.f
-------------------------------------------------------------------*/
-/*
-#define greucl_ELEMS_2 ZTRINGV_NUM(1)
-#define greucl_ELEMLEN_2 ZTRINGV_NUM(255)
-*/
-
-#define GREUCL(A1,A2) CCALLSFSUB2(GREUCL,greucl,INT,STRING,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : grfile.f
-------------------------------------------------------------------*/
-/*
-#define grfile_ELEMS_2 ZTRINGV_NUM(1)
-#define grfile_ELEMLEN_2 ZTRINGV_NUM(255)
-#define grfile_ELEMS_3 ZTRINGV_NUM(1)
-#define grfile_ELEMLEN_3 ZTRINGV_NUM(255)
-*/
-
-#define GRFILE(A1,A2,A3) CCALLSFSUB3(GRFILE,grfile,INT,STRING,STRING,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : grget.f
-------------------------------------------------------------------*/
-/*
-#define grget_ELEMS_1 ZTRINGV_NUM(1)
-#define grget_ELEMLEN_1 ZTRINGV_NUM(4)
-*/
-
-#define GRGET(A1,A2,A3,A4,A5) CCALLSFSUB5(GRGET,grget,STRINGV,INT,INT,INT,INT,A1,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : grhits.f
-------------------------------------------------------------------*/
-/*
-#define grhits_ELEMS_1 ZTRINGV_NUM(1)
-#define grhits_ELEMLEN_1 ZTRINGV_NUM(255)
-#define grhits_ELEMS_2 ZTRINGV_NUM(1)
-#define grhits_ELEMLEN_2 ZTRINGV_NUM(255)
-*/
-
-#define GRHITS(A1,A2,A3,A4) CCALLSFSUB4(GRHITS,grhits,STRING,STRING,INT,INTV,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : grin.f
-------------------------------------------------------------------*/
-/*
-#define grin_ELEMS_1 ZTRINGV_NUM(1)
-#define grin_ELEMLEN_1 ZTRINGV_NUM(255)
-#define grin_ELEMS_3 ZTRINGV_NUM(1)
-#define grin_ELEMLEN_3 ZTRINGV_NUM(255)
-*/
-
-#define GRIN(A1,A2,A3) CCALLSFSUB3(GRIN,grin,STRING,INT,STRING,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : grkuta.f
-------------------------------------------------------------------*/
-
-#define GRKUTA(A1,A2,A3,A4) CCALLSFSUB4(GRKUTA,grkuta,FLOAT,FLOAT,FLOATV,PFLOAT,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : grleas.f
-------------------------------------------------------------------*/
-
-#define GRLEAS(A1) CCALLSFSUB1(GRLEAS,grleas,INT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : grmdir.f
-------------------------------------------------------------------*/
-/*
-#define grmdir_ELEMS_1 ZTRINGV_NUM(1)
-#define grmdir_ELEMLEN_1 ZTRINGV_NUM(255)
-#define grmdir_ELEMS_2 ZTRINGV_NUM(1)
-#define grmdir_ELEMLEN_2 ZTRINGV_NUM(255)
-*/
-
-#define GRMDIR(A1,A2) CCALLSFSUB2(GRMDIR,grmdir,STRING,STRING,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : grmtd.f
-------------------------------------------------------------------*/
-
-#define GRMTD(A1,A2,A3) CCALLSFSUB3(GRMTD,grmtd,FLOATV,INT,PFLOAT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : grmul.f
-------------------------------------------------------------------*/
-
-#define GRMUL(A1,A2,A3) CCALLSFSUB3(GRMUL,grmul,FLOATV,INT,PFLOAT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : grndm.f
-------------------------------------------------------------------*/
-
-#define GRNDM(A1,A2) CCALLSFSUB2(GRNDM,grndm,PFLOAT,INT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : grndmq.f
-------------------------------------------------------------------*/
-/*
-#define grndmq_ELEMS_4 ZTRINGV_NUM(1)
-#define grndmq_ELEMLEN_4 ZTRINGV_NUM(255)
-*/
-
-#define GRNDMQ(A1,A2,A3,A4) CCALLSFSUB4(GRNDMQ,grndmq,PINT,PINT,INT,STRING,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : grndst.f
-------------------------------------------------------------------*/
-
-#define GRNDST(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11) CCALLSFSUB11(GRNDST,grndst,FLOATV,INTV,INT,INT,FLOAT,PFLOAT,FLOAT,PFLOAT,FLOAT,FLOAT,INT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11)
-
-/*------------------------------------------------------------------
-fortran filename : grot.f
-------------------------------------------------------------------*/
-
-#define GROT(A1,A2,A3) CCALLSFSUB3(GROT,grot,FLOATV,FLOATV,PFLOAT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : grout.f
-------------------------------------------------------------------*/
-/*
-#define grout_ELEMS_1 ZTRINGV_NUM(1)
-#define grout_ELEMLEN_1 ZTRINGV_NUM(255)
-#define grout_ELEMS_3 ZTRINGV_NUM(1)
-#define grout_ELEMLEN_3 ZTRINGV_NUM(255)
-*/
-
-#define GROUT(A1,A2,A3) CCALLSFSUB3(GROUT,grout,STRING,INT,STRING,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : grpar.f
-------------------------------------------------------------------*/
-
-#define GRPAR(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10) CCALLSFSUB10(GRPAR,grpar,FLOAT,INT,FLOATV,INT,FLOAT,FLOAT,INT,FLOATV,PINT,PFLOAT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10)
-
-/*------------------------------------------------------------------
-fortran filename : grsave.f
-------------------------------------------------------------------*/
-/*
-#define grsave_ELEMS_1 ZTRINGV_NUM(1)
-#define grsave_ELEMLEN_1 ZTRINGV_NUM(4)
-*/
-
-#define GRSAVE(A1,A2,A3,A4,A5) CCALLSFSUB5(GRSAVE,grsave,STRINGV,INT,INT,INT,INT,A1,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : grun.f
-------------------------------------------------------------------*/
-
-#define GRUN() CCALLSFSUB0(GRUN,grun)
-
-/*------------------------------------------------------------------
-fortran filename : gsagtr.f
-------------------------------------------------------------------*/
-
-#define GSAGTR(A1,A2,A3,A4) CCALLSFSUB4(GSAGTR,gsagtr,FLOATV,FLOATV,PFLOAT,INT,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : gsahit.f
-------------------------------------------------------------------*/
-
-#define GSAHIT(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(GSAHIT,gsahit,INT,INT,INT,INTV,FLOATV,PINT,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : gsaphi.f
-------------------------------------------------------------------*/
-
-#define GSAPHI(A1,A2,A3,A4) CCALLSFSUB4(GSAPHI,gsaphi,FLOATV,FLOAT,FLOAT,PFLOAT,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : gsatt.f
-------------------------------------------------------------------*/
-/*
-#define gsatt_ELEMS_1 ZTRINGV_NUM(1)
-#define gsatt_ELEMLEN_1 ZTRINGV_NUM(4)
-#define gsatt_ELEMS_2 ZTRINGV_NUM(1)
-#define gsatt_ELEMLEN_2 ZTRINGV_NUM(4)
-*/
-
-#define GSATT(A1,A2,A3) CCALLSFSUB3(GSATT,gsatt,STRING,STRING,INT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : gsave.f
-------------------------------------------------------------------*/
-/*
-#define gsave_ELEMS_2 ZTRINGV_NUM(1)
-#define gsave_ELEMLEN_2 ZTRINGV_NUM(4)
-*/
-
-#define GSAVE(A1,A2,A3,A4,A5) CCALLSFSUB5(GSAVE,gsave,INT,STRINGV,INT,INT,PINT,A1,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : gscani.f
-------------------------------------------------------------------*/
-
-#define GSCANI() CCALLSFSUB0(GSCANI,gscani)
-
-/*------------------------------------------------------------------
-fortran filename : gscank.f
-------------------------------------------------------------------*/
-
-#define GSCANK() CCALLSFSUB0(GSCANK,gscank)
-
-/*------------------------------------------------------------------
-fortran filename : gscano.f
-------------------------------------------------------------------*/
-
-#define GSCANO() CCALLSFSUB0(GSCANO,gscano)
-
-/*------------------------------------------------------------------
-fortran filename : gscanu.f
-------------------------------------------------------------------*/
-
-#define GSCANU() CCALLSFSUB0(GSCANU,gscanu)
-
-/*------------------------------------------------------------------
-fortran filename : gschit.f
-------------------------------------------------------------------*/
-
-#define GSCHIT(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(GSCHIT,gschit,INT,INT,INT,INTV,FLOATV,INT,PINT,A1,A2,A3,A4,A5,A6,A7)
-
-/*------------------------------------------------------------------
-fortran filename : gschk.f
-------------------------------------------------------------------*/
-/*
-#define gschk_ELEMS_1 ZTRINGV_NUM(1)
-#define gschk_ELEMLEN_1 ZTRINGV_NUM(4)
-#define gschk_ELEMS_2 ZTRINGV_NUM(1)
-#define gschk_ELEMLEN_2 ZTRINGV_NUM(4)
-*/
-
-#define GSCHK(A1,A2,A3,A4) CCALLSFSUB4(GSCHK,gschk,STRING,STRING,INT,PINT,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : gsckov.f
-------------------------------------------------------------------*/
-
-#define GSCKOV(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(GSCKOV,gsckov,INT,INT,FLOATV,FLOATV,FLOATV,FLOATV,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : gscvol.f
-------------------------------------------------------------------*/
-
-#define GSCVOL() CCALLSFSUB0(GSCVOL,gscvol)
-
-/*------------------------------------------------------------------
-fortran filename : gsdet.f
-------------------------------------------------------------------*/
-/*
-#define gsdet_ELEMS_1 ZTRINGV_NUM(1)
-#define gsdet_ELEMLEN_1 ZTRINGV_NUM(4)
-#define gsdet_ELEMS_2 ZTRINGV_NUM(1)
-#define gsdet_ELEMLEN_2 ZTRINGV_NUM(4)
-#define gsdet_ELEMS_4 ZTRINGV_NUM(1)
-#define gsdet_ELEMLEN_4 ZTRINGV_NUM(4)
-*/
-
-#define GSDET(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10) CCALLSFSUB10(GSDET,gsdet,STRING,STRING,INT,STRING,INTV,INT,INT,INT,PINT,PINT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10)
-
-/*------------------------------------------------------------------
-fortran filename : gsdeta.f
-------------------------------------------------------------------*/
-/*
-#define gsdeta_ELEMS_1 ZTRINGV_NUM(1)
-#define gsdeta_ELEMLEN_1 ZTRINGV_NUM(4)
-#define gsdeta_ELEMS_2 ZTRINGV_NUM(1)
-#define gsdeta_ELEMLEN_2 ZTRINGV_NUM(4)
-#define gsdeta_ELEMS_3 ZTRINGV_NUM(1)
-#define gsdeta_ELEMLEN_3 ZTRINGV_NUM(4)
-*/
-
-#define GSDETA(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(GSDETA,gsdeta,STRING,STRING,STRING,INT,INT,PINT,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : gsdetd.f
-------------------------------------------------------------------*/
-/*
-#define gsdetd_ELEMS_1 ZTRINGV_NUM(1)
-#define gsdetd_ELEMLEN_1 ZTRINGV_NUM(4)
-#define gsdetd_ELEMS_2 ZTRINGV_NUM(1)
-#define gsdetd_ELEMLEN_2 ZTRINGV_NUM(4)
-#define gsdetd_ELEMS_4 ZTRINGV_NUM(1)
-#define gsdetd_ELEMLEN_4 ZTRINGV_NUM(4)
-*/
-
-#define GSDETD(A1,A2,A3,A4,A5) CCALLSFSUB5(GSDETD,gsdetd,STRING,STRING,INT,STRINGV,INTV,A1,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : gsdeth.f
-------------------------------------------------------------------*/
-/*
-#define gsdeth_ELEMS_1 ZTRINGV_NUM(1)
-#define gsdeth_ELEMLEN_1 ZTRINGV_NUM(4)
-#define gsdeth_ELEMS_2 ZTRINGV_NUM(1)
-#define gsdeth_ELEMLEN_2 ZTRINGV_NUM(4)
-#define gsdeth_ELEMS_4 ZTRINGV_NUM(1)
-#define gsdeth_ELEMLEN_4 ZTRINGV_NUM(4)
-*/
-
-#define GSDETH(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(GSDETH,gsdeth,STRING,STRING,INT,STRINGV,INTV,FLOATV,FLOATV,A1,A2,A3,A4,A5,A6,A7)
-
-/*------------------------------------------------------------------
-fortran filename : gsdetu.f
-------------------------------------------------------------------*/
-/*
-#define gsdetu_ELEMS_1 ZTRINGV_NUM(1)
-#define gsdetu_ELEMLEN_1 ZTRINGV_NUM(4)
-#define gsdetu_ELEMS_2 ZTRINGV_NUM(1)
-#define gsdetu_ELEMLEN_2 ZTRINGV_NUM(4)
-*/
-
-#define GSDETU(A1,A2,A3,A4) CCALLSFSUB4(GSDETU,gsdetu,STRING,STRING,INT,FLOATV,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : gsdetv.f
-------------------------------------------------------------------*/
-/*
-#define gsdetv_ELEMS_1 ZTRINGV_NUM(1)
-#define gsdetv_ELEMLEN_1 ZTRINGV_NUM(4)
-#define gsdetv_ELEMS_2 ZTRINGV_NUM(1)
-#define gsdetv_ELEMLEN_2 ZTRINGV_NUM(4)
-*/
-
-#define GSDETV(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(GSDETV,gsdetv,STRING,STRING,INT,INT,INT,PINT,PINT,A1,A2,A3,A4,A5,A6,A7)
-
-/*------------------------------------------------------------------
-fortran filename : gsdigi.f
-------------------------------------------------------------------*/
-
-#define GSDIGI(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(GSDIGI,gsdigi,INT,INT,INTV,INT,INTV,INTV,PINT,A1,A2,A3,A4,A5,A6,A7)
-
-/*------------------------------------------------------------------
-fortran filename : gsdk.f
-------------------------------------------------------------------*/
-
-#define GSDK(A1,A2,A3) CCALLSFSUB3(GSDK,gsdk,INT,FLOATV,INTV,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : gsdvn.f
-------------------------------------------------------------------*/
-/*
-#define gsdvn_ELEMS_1 ZTRINGV_NUM(1)
-#define gsdvn_ELEMLEN_1 ZTRINGV_NUM(4)
-#define gsdvn_ELEMS_2 ZTRINGV_NUM(1)
-#define gsdvn_ELEMLEN_2 ZTRINGV_NUM(4)
-*/
-
-#define GSDVN(A1,A2,A3,A4) CCALLSFSUB4(GSDVN,gsdvn,STRING,STRING,INT,INT,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : gsdvn2.f
-------------------------------------------------------------------*/
-/*
-#define gsdvn2_ELEMS_1 ZTRINGV_NUM(1)
-#define gsdvn2_ELEMLEN_1 ZTRINGV_NUM(4)
-#define gsdvn2_ELEMS_2 ZTRINGV_NUM(1)
-#define gsdvn2_ELEMLEN_2 ZTRINGV_NUM(4)
-*/
-
-#define GSDVN2(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(GSDVN2,gsdvn2,STRING,STRING,INT,INT,FLOAT,INT,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : gsdvs.f
-------------------------------------------------------------------*/
-/*
-#define gsdvs_ELEMS_1 ZTRINGV_NUM(1)
-#define gsdvs_ELEMLEN_1 ZTRINGV_NUM(4)
-#define gsdvs_ELEMS_2 ZTRINGV_NUM(1)
-#define gsdvs_ELEMLEN_2 ZTRINGV_NUM(4)
-*/
-
-#define GSDVS(A1,A2,A3,A4,A5) CCALLSFSUB5(GSDVS,gsdvs,STRING,STRING,FLOAT,INT,INT,A1,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : gsdvs2.f
-------------------------------------------------------------------*/
-/*
-#define gsdvs2_ELEMS_1 ZTRINGV_NUM(1)
-#define gsdvs2_ELEMLEN_1 ZTRINGV_NUM(4)
-#define gsdvs2_ELEMS_2 ZTRINGV_NUM(1)
-#define gsdvs2_ELEMLEN_2 ZTRINGV_NUM(4)
-*/
-
-#define GSDVS2(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(GSDVS2,gsdvs2,STRING,STRING,FLOAT,INT,FLOAT,INT,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : gsdvt.f
-------------------------------------------------------------------*/
-/*
-#define gsdvt_ELEMS_1 ZTRINGV_NUM(1)
-#define gsdvt_ELEMLEN_1 ZTRINGV_NUM(4)
-#define gsdvt_ELEMS_2 ZTRINGV_NUM(1)
-#define gsdvt_ELEMLEN_2 ZTRINGV_NUM(4)
-*/
-
-#define GSDVT(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(GSDVT,gsdvt,STRING,STRING,FLOAT,INT,INT,INT,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : gsdvt2.f
-------------------------------------------------------------------*/
-/*
-#define gsdvt2_ELEMS_1 ZTRINGV_NUM(1)
-#define gsdvt2_ELEMLEN_1 ZTRINGV_NUM(4)
-#define gsdvt2_ELEMS_2 ZTRINGV_NUM(1)
-#define gsdvt2_ELEMLEN_2 ZTRINGV_NUM(4)
-*/
-
-#define GSDVT2(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(GSDVT2,gsdvt2,STRING,STRING,FLOAT,INT,PFLOAT,INT,INT,A1,A2,A3,A4,A5,A6,A7)
-
-/*------------------------------------------------------------------
-fortran filename : gsdvx.f
-------------------------------------------------------------------*/
-/*
-#define gsdvx_ELEMS_1 ZTRINGV_NUM(1)
-#define gsdvx_ELEMLEN_1 ZTRINGV_NUM(4)
-#define gsdvx_ELEMS_2 ZTRINGV_NUM(1)
-#define gsdvx_ELEMLEN_2 ZTRINGV_NUM(4)
-*/
-
-#define GSDVX(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(GSDVX,gsdvx,STRING,STRING,INT,INT,FLOAT,FLOAT,INT,INT,A1,A2,A3,A4,A5,A6,A7,A8)
-
-/*------------------------------------------------------------------
-fortran filename : gshead.f
-------------------------------------------------------------------*/
-
-#define GSHEAD(A1,A2,A3) CCALLSFSUB3(GSHEAD,gshead,INT,FLOATV,PINT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : gshlin.f
-------------------------------------------------------------------*/
-
-#define GSHLIN() CCALLSFSUB0(GSHLIN,gshlin)
-
-/*------------------------------------------------------------------
-fortran filename : gsipar.f
-------------------------------------------------------------------*/
-
-#define GSIPAR(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(GSIPAR,gsipar,INT,INT,INT,INT,FLOATV,FLOATV,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : gskine.f
-------------------------------------------------------------------*/
-
-#define GSKINE(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(GSKINE,gskine,FLOATV,INT,INT,FLOATV,INT,PINT,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : gsking.f
-------------------------------------------------------------------*/
-
-#define GSKING(A1) CCALLSFSUB1(GSKING,gsking,INT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : gskinu.f
-------------------------------------------------------------------*/
-
-#define GSKINU(A1,A2,A3,A4) CCALLSFSUB4(GSKINU,gskinu,INT,INT,FLOATV,PINT,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : gskpho.f
-------------------------------------------------------------------*/
-
-#define GSKPHO(A1) CCALLSFSUB1(GSKPHO,gskpho,INT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : gsmate.f
-------------------------------------------------------------------*/
-/*
-#define gsmate_ELEMS_2 ZTRINGV_NUM(1)
-#define gsmate_ELEMLEN_2 ZTRINGV_NUM(255)
-*/
-
-#define GSMATE(A1,A2,A3,A4,A5,A6,A7,A8,A9) CCALLSFSUB9(GSMATE,gsmate,INT,STRING,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,FLOATV,INT,A1,A2,A3,A4,A5,A6,A7,A8,A9)
-
-/*------------------------------------------------------------------
-fortran filename : gsmixt.f
-------------------------------------------------------------------*/
-/*
-#define gsmixt_ELEMS_2 ZTRINGV_NUM(1)
-#define gsmixt_ELEMLEN_2 ZTRINGV_NUM(255)
-*/
-
-#define GSMIXT(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(GSMIXT,gsmixt,INT,STRING,FLOATV,FLOATV,FLOAT,INT,PFLOAT,A1,A2,A3,A4,A5,A6,A7)
-
-/*------------------------------------------------------------------
-fortran filename : gsnear.f
-------------------------------------------------------------------*/
-/*
-#define gsnear_ELEMS_1 ZTRINGV_NUM(1)
-#define gsnear_ELEMLEN_1 ZTRINGV_NUM(4)
-*/
-
-#define GSNEAR(A1,A2,A3,A4) CCALLSFSUB4(GSNEAR,gsnear,STRING,INT,INT,INTV,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : gsnext.f
-------------------------------------------------------------------*/
-/*
-#define gsnext_ELEMS_1 ZTRINGV_NUM(1)
-#define gsnext_ELEMLEN_1 ZTRINGV_NUM(4)
-*/
-
-#define GSNEXT(A1,A2,A3,A4) CCALLSFSUB4(GSNEXT,gsnext,STRING,INT,INT,INTV,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : gsngtr.f
-------------------------------------------------------------------*/
-
-#define GSNGTR(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(GSNGTR,gsngtr,FLOATV,FLOATV,INT,FLOAT,PFLOAT,FLOAT,INT,A1,A2,A3,A4,A5,A6,A7)
-
-/*------------------------------------------------------------------
-fortran filename : gsord.f
-------------------------------------------------------------------*/
-/*
-#define gsord_ELEMS_1 ZTRINGV_NUM(1)
-#define gsord_ELEMLEN_1 ZTRINGV_NUM(4)
-*/
-
-#define GSORD(A1,A2) CCALLSFSUB2(GSORD,gsord,STRING,INT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : gspart.f
-------------------------------------------------------------------*/
-/*
-#define gspart_ELEMS_2 ZTRINGV_NUM(1)
-#define gspart_ELEMLEN_2 ZTRINGV_NUM(255)
-*/
-
-#define GSPART(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(GSPART,gspart,INT,STRING,INT,FLOAT,FLOAT,FLOAT,FLOATV,INT,A1,A2,A3,A4,A5,A6,A7,A8)
-
-/*------------------------------------------------------------------
-fortran filename : gspe3d.f
-------------------------------------------------------------------*/
-/*
-#define gspe3d_ELEMS_1 ZTRINGV_NUM(1)
-#define gspe3d_ELEMLEN_1 ZTRINGV_NUM(4)
-*/
-
-#define GSPE3D(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(GSPE3D,gspe3d,STRING,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,A1,A2,A3,A4,A5,A6,A7)
-
-/*------------------------------------------------------------------
-fortran filename : gspos.f
-------------------------------------------------------------------*/
-/*
-#define gspos_ELEMS_1 ZTRINGV_NUM(1)
-#define gspos_ELEMLEN_1 ZTRINGV_NUM(4)
-#define gspos_ELEMS_3 ZTRINGV_NUM(1)
-#define gspos_ELEMLEN_3 ZTRINGV_NUM(4)
-#define gspos_ELEMS_8 ZTRINGV_NUM(1)
-#define gspos_ELEMLEN_8 ZTRINGV_NUM(4)
-*/
-
-#define GSPOS(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(GSPOS,gspos,STRING,INT,STRING,FLOAT,FLOAT,FLOAT,INT,STRING,A1,A2,A3,A4,A5,A6,A7,A8)
-
-/*------------------------------------------------------------------
-fortran filename : gsposp.f
-------------------------------------------------------------------*/
-/*
-#define gsposp_ELEMS_1 ZTRINGV_NUM(1)
-#define gsposp_ELEMLEN_1 ZTRINGV_NUM(4)
-#define gsposp_ELEMS_3 ZTRINGV_NUM(1)
-#define gsposp_ELEMLEN_3 ZTRINGV_NUM(4)
-#define gsposp_ELEMS_8 ZTRINGV_NUM(1)
-#define gsposp_ELEMLEN_8 ZTRINGV_NUM(4)
-*/
-
-#define GSPOSP(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10) CCALLSFSUB10(GSPOSP,gsposp,STRING,INT,STRING,FLOAT,FLOAT,FLOAT,INT,STRING,FLOATV,INT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10)
-
-/*------------------------------------------------------------------
-fortran filename : gspset.f
-------------------------------------------------------------------*/
-
-#define GSPSET(A1) CCALLSFSUB1(GSPSET,gspset,FLOATV,A1)
-
-/*------------------------------------------------------------------
-fortran filename : gsrotm.f
-------------------------------------------------------------------*/
-
-#define GSROTM(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(GSROTM,gsrotm,INT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,A1,A2,A3,A4,A5,A6,A7)
-
-/*------------------------------------------------------------------
-fortran filename : gsrung.f
-------------------------------------------------------------------*/
-
-#define GSRUNG(A1,A2,A3) CCALLSFSUB3(GSRUNG,gsrung,INT,FLOATV,PINT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : gsscan.f
-------------------------------------------------------------------*/
-
-#define GSSCAN(A1,A2) CCALLSFSUB2(GSSCAN,gsscan,INT,INT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : gsstak.f
-------------------------------------------------------------------*/
-
-#define GSSTAK(A1) CCALLSFSUB1(GSSTAK,gsstak,INT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : gstcor.f
-------------------------------------------------------------------*/
-
-#define GSTCOR(A1,A2,A3,A4,A5) CCALLSFSUB5(GSTCOR,gstcor,FLOAT,FLOAT,FLOAT,FLOAT,PFLOAT,A1,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : gstdn.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN1(FLOAT,GSTDN,gstdn,FLOAT)
-#define GSTDN(A2) CCALLSFFUN1(GSTDN,gstdn,FLOAT,A2)
-
-/*------------------------------------------------------------------
-fortran filename : gstini.f
-------------------------------------------------------------------*/
-
-#define GSTINI() CCALLSFSUB0(GSTINI,gstini)
-
-/*------------------------------------------------------------------
-fortran filename : gstint.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN4(FLOAT,GSTINT,gstint,FLOAT,FLOATV,FLOATV,INT)
-#define GSTINT(A2,A3,A4,A5) CCALLSFFUN4(GSTINT,gstint,FLOAT,FLOATV,FLOATV,INT,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : gstmat.f
-------------------------------------------------------------------*/
-/*
-#define gstmat_ELEMS_1 ZTRINGV_NUM(1)
-#define gstmat_ELEMLEN_1 ZTRINGV_NUM(24)
-*/
-
-#define GSTMAT(A1) CCALLSFSUB1(GSTMAT,gstmat,STRING,A1)
-
-/*------------------------------------------------------------------
-fortran filename : gstmed.f
-------------------------------------------------------------------*/
-/*
-#define gstmed_ELEMS_2 ZTRINGV_NUM(1)
-#define gstmed_ELEMLEN_2 ZTRINGV_NUM(255)
-*/
-
-#define GSTMED(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13) CCALLSFSUB13(GSTMED,gstmed,INT,STRING,INT,INT,INT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,FLOATV,INT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13)
-
-/*------------------------------------------------------------------
-fortran filename : gstord.f
-------------------------------------------------------------------*/
-
-#define GSTORD() CCALLSFSUB0(GSTORD,gstord)
-
-/*------------------------------------------------------------------
-fortran filename : gstpar.f
-------------------------------------------------------------------*/
-/*
-#define gstpar_ELEMS_2 ZTRINGV_NUM(1)
-#define gstpar_ELEMLEN_2 ZTRINGV_NUM(255)
-*/
-
-#define GSTPAR(A1,A2,A3) CCALLSFSUB3(GSTPAR,gstpar,INT,STRING,FLOAT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : gstrac.f
-------------------------------------------------------------------*/
-
-#define GSTRAC() CCALLSFSUB0(GSTRAC,gstrac)
-
-/*------------------------------------------------------------------
-fortran filename : gstren.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN3(FLOAT,GSTREN,gstren,FLOAT,FLOAT,FLOAT)
-#define GSTREN(A2,A3,A4) CCALLSFFUN3(GSTREN,gstren,FLOAT,FLOAT,FLOAT,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : gstset.f
-------------------------------------------------------------------*/
-/*
-#define gstset_ELEMS_1 ZTRINGV_NUM(1)
-#define gstset_ELEMLEN_1 ZTRINGV_NUM(24)
-#define gstset_ELEMS_2 ZTRINGV_NUM(1)
-#define gstset_ELEMLEN_2 ZTRINGV_NUM(4)
-#define gstset_ELEMS_3 ZTRINGV_NUM(1)
-#define gstset_ELEMLEN_3 ZTRINGV_NUM(24)
-#define gstset_ELEMS_4 ZTRINGV_NUM(1)
-#define gstset_ELEMLEN_4 ZTRINGV_NUM(24)
-#define gstset_ELEMS_5 ZTRINGV_NUM(1)
-#define gstset_ELEMLEN_5 ZTRINGV_NUM(24)
-#define gstset_ELEMS_6 ZTRINGV_NUM(1)
-#define gstset_ELEMLEN_6 ZTRINGV_NUM(24)
-*/
-
-#define GSTSET(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(GSTSET,gstset,STRING,STRING,STRING,STRING,STRING,STRING,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : gsttab.f
-------------------------------------------------------------------*/
-
-#define GSTTAB(A1,A2,A3,A4) CCALLSFSUB4(GSTTAB,gsttab,FLOAT,PINT,PFLOAT,PFLOAT,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : gstxin.f
-------------------------------------------------------------------*/
-
-#define GSTXIN() CCALLSFSUB0(GSTXIN,gstxin)
-
-/*------------------------------------------------------------------
-fortran filename : gsunea.f
-------------------------------------------------------------------*/
-/*
-#define gsunea_ELEMS_1 ZTRINGV_NUM(1)
-#define gsunea_ELEMLEN_1 ZTRINGV_NUM(4)
-*/
-
-#define GSUNEA(A1,A2) CCALLSFSUB2(GSUNEA,gsunea,STRING,INT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : gsvert.f
-------------------------------------------------------------------*/
-
-#define GSVERT(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(GSVERT,gsvert,FLOATV,INT,INT,FLOATV,INT,PINT,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : gsveru.f
-------------------------------------------------------------------*/
-
-#define GSVERU(A1,A2,A3,A4) CCALLSFSUB4(GSVERU,gsveru,INT,INT,FLOATV,PINT,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : gsvolu.f
-------------------------------------------------------------------*/
-/*
-#define gsvolu_ELEMS_1 ZTRINGV_NUM(1)
-#define gsvolu_ELEMLEN_1 ZTRINGV_NUM(4)
-#define gsvolu_ELEMS_2 ZTRINGV_NUM(1)
-#define gsvolu_ELEMLEN_2 ZTRINGV_NUM(4)
-*/
-
-#define GSVOLU(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(GSVOLU,gsvolu,STRING,STRING,INT,FLOATV,INT,PINT,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : gsxyz.f
-------------------------------------------------------------------*/
-
-#define GSXYZ() CCALLSFSUB0(GSXYZ,gsxyz)
-
-/*------------------------------------------------------------------
-fortran filename : gsync.f
-------------------------------------------------------------------*/
-
-#define GSYNC() CCALLSFSUB0(GSYNC,gsync)
-
-/*------------------------------------------------------------------
-fortran filename : gsynge.f
-------------------------------------------------------------------*/
-
-#define GSYNGE(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(GSYNGE,gsynge,FLOAT,FLOAT,FLOAT,FLOAT,PINT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5,A6,A7)
-
-/*------------------------------------------------------------------
-fortran filename : gtau.f
-------------------------------------------------------------------*/
-
-#define GTAU() CCALLSFSUB0(GTAU,gtau)
-
-/*------------------------------------------------------------------
-fortran filename : gtckov.f
-------------------------------------------------------------------*/
-
-#define GTCKOV() CCALLSFSUB0(GTCKOV,gtckov)
-
-/*------------------------------------------------------------------
-fortran filename : gtelec.f
-------------------------------------------------------------------*/
-
-#define GTELEC() CCALLSFSUB0(GTELEC,gtelec)
-
-/*------------------------------------------------------------------
-fortran filename : gtgama.f
-------------------------------------------------------------------*/
-
-#define GTGAMA() CCALLSFSUB0(GTGAMA,gtgama)
-
-/*------------------------------------------------------------------
-fortran filename : gthadr.f
-------------------------------------------------------------------*/
-
-#define GTHADR() CCALLSFSUB0(GTHADR,gthadr)
-
-/*------------------------------------------------------------------
-fortran filename : gthion.f
-------------------------------------------------------------------*/
-
-#define GTHION() CCALLSFSUB0(GTHION,gthion)
-
-/*------------------------------------------------------------------
-fortran filename : gtiso.f
-------------------------------------------------------------------*/
-
-#define GTISO(A1,A2,A3) CCALLSFSUB3(GTISO,gtiso,PFLOAT,PFLOAT,PFLOAT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : gtmed.f
-------------------------------------------------------------------*/
-
-#define GTMED(A1,A2) CCALLSFSUB2(GTMED,gtmed,INT,PINT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : gtmedi.f
-------------------------------------------------------------------*/
-
-#define GTMEDI(A1,A2) CCALLSFSUB2(GTMEDI,gtmedi,FLOATV,PINT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : gtmuon.f
-------------------------------------------------------------------*/
-
-#define GTMUON() CCALLSFSUB0(GTMUON,gtmuon)
-
-/*------------------------------------------------------------------
-fortran filename : gtneut.f
-------------------------------------------------------------------*/
-
-#define GTNEUT() CCALLSFSUB0(GTNEUT,gtneut)
-
-/*------------------------------------------------------------------
-fortran filename : gtnext.f
-------------------------------------------------------------------*/
-
-#define GTNEXT() CCALLSFSUB0(GTNEXT,gtnext)
-
-/*------------------------------------------------------------------
-fortran filename : gtnino.f
-------------------------------------------------------------------*/
-
-#define GTNINO() CCALLSFSUB0(GTNINO,gtnino)
-
-/*------------------------------------------------------------------
-fortran filename : gtrack.f
-------------------------------------------------------------------*/
-
-#define GTRACK() CCALLSFSUB0(GTRACK,gtrack)
-
-/*------------------------------------------------------------------
-fortran filename : gtrain.f
-------------------------------------------------------------------*/
-
-#define GTRAIN(A1,A2) CCALLSFSUB2(GTRAIN,gtrain,FLOATV,PFLOAT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : gtrase.f
-------------------------------------------------------------------*/
-
-#define GTRASE(A1) CCALLSFSUB1(GTRASE,gtrase,FLOATV,A1)
-
-/*------------------------------------------------------------------
-fortran filename : gtrdse.f
-------------------------------------------------------------------*/
-
-#define GTRDSE(A1,A2) CCALLSFSUB2(GTRDSE,gtrdse,FLOATV,INT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : gtreve.f
-------------------------------------------------------------------*/
-
-#define GTREVE() CCALLSFSUB0(GTREVE,gtreve)
-
-/*------------------------------------------------------------------
-fortran filename : gtrig.f
-------------------------------------------------------------------*/
-
-#define GTRIG() CCALLSFSUB0(GTRIG,gtrig)
-
-/*------------------------------------------------------------------
-fortran filename : gtrigc.f
-------------------------------------------------------------------*/
-
-#define GTRIGC() CCALLSFSUB0(GTRIGC,gtrigc)
-
-/*------------------------------------------------------------------
-fortran filename : gtrigi.f
-------------------------------------------------------------------*/
-
-#define GTRIGI() CCALLSFSUB0(GTRIGI,gtrigi)
-
-/*------------------------------------------------------------------
-fortran filename : gtrmul.f
-------------------------------------------------------------------*/
-
-#define GTRMUL(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(GTRMUL,gtrmul,FLOATV,FLOATV,FLOATV,INT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : gtrnsf.f
-------------------------------------------------------------------*/
-
-#define GTRNSF(A1,A2,A3,A4) CCALLSFSUB4(GTRNSF,gtrnsf,FLOATV,FLOATV,FLOATV,PFLOAT,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : gtrset.f
-------------------------------------------------------------------*/
-
-#define GTRSET(A1) CCALLSFSUB1(GTRSET,gtrset,FLOATV,A1)
-
-/*------------------------------------------------------------------
-fortran filename : gtuset.f
-------------------------------------------------------------------*/
-
-#define GTUSET(A1,A2) CCALLSFSUB2(GTUSET,gtuset,FLOATV,INT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : gtxset.f
-------------------------------------------------------------------*/
-/*
-#define gtxset_ELEMS_1 ZTRINGV_NUM(1)
-#define gtxset_ELEMLEN_1 ZTRINGV_NUM(24)
-#define gtxset_ELEMS_2 ZTRINGV_NUM(1)
-#define gtxset_ELEMLEN_2 ZTRINGV_NUM(4)
-#define gtxset_ELEMS_6 ZTRINGV_NUM(1)
-#define gtxset_ELEMLEN_6 ZTRINGV_NUM(24)
-#define gtxset_ELEMS_7 ZTRINGV_NUM(1)
-#define gtxset_ELEMLEN_7 ZTRINGV_NUM(24)
-#define gtxset_ELEMS_8 ZTRINGV_NUM(1)
-#define gtxset_ELEMLEN_8 ZTRINGV_NUM(24)
-#define gtxset_ELEMS_9 ZTRINGV_NUM(1)
-#define gtxset_ELEMLEN_9 ZTRINGV_NUM(24)
-*/
-
-#define GTXSET(A1,A2,A3,A4,A5,A6,A7,A8,A9) CCALLSFSUB9(GTXSET,gtxset,STRING,STRING,INT,INT,INT,STRING,STRING,STRING,STRING,A1,A2,A3,A4,A5,A6,A7,A8,A9)
-
-/*------------------------------------------------------------------
-fortran filename : gudcay.f
-------------------------------------------------------------------*/
-
-#define GUDCAY() CCALLSFSUB0(GUDCAY,gudcay)
-
-/*------------------------------------------------------------------
-fortran filename : gudigi.f
-------------------------------------------------------------------*/
-
-#define GUDIGI() CCALLSFSUB0(GUDIGI,gudigi)
-
-/*------------------------------------------------------------------
-fortran filename : gudtim.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN4(FLOAT,GUDTIM,gudtim,FLOAT,FLOAT,INT,FLOAT)
-#define GUDTIM(A2,A3,A4,A5) CCALLSFFUN4(GUDTIM,gudtim,FLOAT,FLOAT,INT,FLOAT,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : gufld.f
-------------------------------------------------------------------*/
-
-#define GUFLD(A1,A2) CCALLSFSUB2(GUFLD,gufld,FLOATV,PFLOAT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : guhadr.f
-------------------------------------------------------------------*/
-
-#define GUHADR() CCALLSFSUB0(GUHADR,guhadr)
-
-/*------------------------------------------------------------------
-fortran filename : guiget.f
-------------------------------------------------------------------*/
-
-#define GUIGET(A1,A2,A3) CCALLSFSUB3(GUIGET,guiget,INT,INT,INT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : guinme.f
-------------------------------------------------------------------*/
-
-#define GUINME(A1,A2,A3,A4) CCALLSFSUB4(GUINME,guinme,FLOATV,FLOAT,FLOATV,PINT,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : guinti.f
-------------------------------------------------------------------*/
-
-#define GUINTI() CCALLSFSUB0(GUINTI,guinti)
-
-/*------------------------------------------------------------------
-fortran filename : gukine.f
-------------------------------------------------------------------*/
-
-#define GUKINE() CCALLSFSUB0(GUKINE,gukine)
-
-/*------------------------------------------------------------------
-fortran filename : gunear.f
-------------------------------------------------------------------*/
-
-#define GUNEAR(A1,A2,A3,A4) CCALLSFSUB4(GUNEAR,gunear,INT,INT,FLOATV,INT,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : gunliv.f
-------------------------------------------------------------------*/
-
-#define GUNLIV(A1,A2,A3) CCALLSFSUB3(GUNLIV,gunliv,INT,INT,INT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : guout.f
-------------------------------------------------------------------*/
-
-#define GUOUT() CCALLSFSUB0(GUOUT,guout)
-
-/*------------------------------------------------------------------
-fortran filename : gupara.f
-------------------------------------------------------------------*/
-
-#define GUPARA() CCALLSFSUB0(GUPARA,gupara)
-
-/*------------------------------------------------------------------
-fortran filename : guphad.f
-------------------------------------------------------------------*/
-
-#define GUPHAD() CCALLSFSUB0(GUPHAD,guphad)
-
-/*------------------------------------------------------------------
-fortran filename : guplsh.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN2(FLOAT,GUPLSH,guplsh,INT,INT)
-#define GUPLSH(A2,A3) CCALLSFFUN2(GUPLSH,guplsh,INT,INT,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : guskip.f
-------------------------------------------------------------------*/
-
-#define GUSKIP(A1) CCALLSFSUB1(GUSKIP,guskip,PINT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : gustep.f
-------------------------------------------------------------------*/
-
-#define GUSTEP() CCALLSFSUB0(GUSTEP,gustep)
-
-/*------------------------------------------------------------------
-fortran filename : guswim.f
-------------------------------------------------------------------*/
-
-#define GUSWIM(A1,A2,A3,A4) CCALLSFSUB4(GUSWIM,guswim,FLOAT,FLOAT,FLOATV,FLOATV,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : gutrak.f
-------------------------------------------------------------------*/
-
-#define GUTRAK() CCALLSFSUB0(GUTRAK,gutrak)
-
-/*------------------------------------------------------------------
-fortran filename : gutrev.f
-------------------------------------------------------------------*/
-
-#define GUTREV() CCALLSFSUB0(GUTREV,gutrev)
-
-/*------------------------------------------------------------------
-fortran filename : guview.f
-------------------------------------------------------------------*/
-/*
-#define guview_ELEMS_3 ZTRINGV_NUM(1)
-#define guview_ELEMLEN_3 ZTRINGV_NUM(255)
-*/
-
-#define GUVIEW(A1,A2,A3,A4) CCALLSFSUB4(GUVIEW,guview,INT,INT,STRING,INT,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : gvaviv.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN3(FLOAT,GVAVIV,gvaviv,FLOAT,FLOAT,FLOAT)
-#define GVAVIV(A2,A3,A4) CCALLSFFUN3(GVAVIV,gvaviv,FLOAT,FLOAT,FLOAT,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : gvdcar.f
-------------------------------------------------------------------*/
-
-#define GVDCAR(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(GVDCAR,gvdcar,INT,INT,INT,FLOATV,PFLOAT,PFLOAT,PINT,A1,A2,A3,A4,A5,A6,A7)
-
-/*------------------------------------------------------------------
-fortran filename : gvdlim.f
-------------------------------------------------------------------*/
-
-#define GVDLIM(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(GVDLIM,gvdlim,INT,INT,INT,PFLOAT,PFLOAT,INT,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : gvdphi.f
-------------------------------------------------------------------*/
-
-#define GVDPHI(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(GVDPHI,gvdphi,INT,INT,FLOATV,FLOATV,PFLOAT,PFLOAT,PINT,A1,A2,A3,A4,A5,A6,A7)
-
-/*------------------------------------------------------------------
-fortran filename : gvdrad.f
-------------------------------------------------------------------*/
-
-#define GVDRAD(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(GVDRAD,gvdrad,INT,INT,INT,FLOATV,FLOATV,PFLOAT,PFLOAT,PINT,A1,A2,A3,A4,A5,A6,A7,A8)
-
-/*------------------------------------------------------------------
-fortran filename : gvdthe.f
-------------------------------------------------------------------*/
-
-#define GVDTHE(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(GVDTHE,gvdthe,INT,INT,FLOATV,FLOATV,PFLOAT,PFLOAT,PINT,A1,A2,A3,A4,A5,A6,A7)
-
-/*------------------------------------------------------------------
-fortran filename : gvgrad.f
-------------------------------------------------------------------*/
-
-#define GVGRAD(A1,A2,A3,A4) CCALLSFSUB4(GVGRAD,gvgrad,FLOATV,FLOATV,INT,PFLOAT,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : gviewf.f
-------------------------------------------------------------------*/
-
-#define GVIEWF(A1,A2,A3) CCALLSFSUB3(GVIEWF,gviewf,FLOATV,FLOATV,INT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : gvlong.f
-------------------------------------------------------------------*/
-
-#define GVLONG(A1,A2,A3,A4,A5) CCALLSFSUB5(GVLONG,gvlong,FLOATV,FLOATV,INT,PFLOAT,PINT,A1,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : gvpsqr.f
-------------------------------------------------------------------*/
-
-#define GVPSQR(A1,A2,A3) CCALLSFSUB3(GVPSQR,gvpsqr,FLOATV,PFLOAT,PINT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : gvrot.f
-------------------------------------------------------------------*/
-
-#define GVROT(A1,A2) CCALLSFSUB2(GVROT,gvrot,FLOATV,PFLOAT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : gvsafe.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN4(FLOAT,GVSAFE,gvsafe,FLOATV,FLOAT,FLOATV,INT)
-#define GVSAFE(A2,A3,A4,A5) CCALLSFFUN4(GVSAFE,gvsafe,FLOATV,FLOAT,FLOATV,INT,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : gvsign.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN4(INT,GVSIGN,gvsign,FLOATV,FLOAT,FLOATV,INT)
-#define GVSIGN(A2,A3,A4,A5) CCALLSFFUN4(GVSIGN,gvsign,FLOATV,FLOAT,FLOATV,INT,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : gweucl.f
-------------------------------------------------------------------*/
-/*
-#define gweucl_ELEMS_2 ZTRINGV_NUM(1)
-#define gweucl_ELEMLEN_2 ZTRINGV_NUM(255)
-#define gweucl_ELEMS_3 ZTRINGV_NUM(1)
-#define gweucl_ELEMLEN_3 ZTRINGV_NUM(4)
-*/
-
-#define GWEUCL(A1,A2,A3,A4,A5) CCALLSFSUB5(GWEUCL,gweucl,INT,STRING,STRING,INT,INT,A1,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : gwork.f
-------------------------------------------------------------------*/
-
-#define GWORK(A1) CCALLSFSUB1(GWORK,gwork,PINT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : gwrtre.f
-------------------------------------------------------------------*/
-/*
-#define gwrtre_ELEMS_1 ZTRINGV_NUM(1)
-#define gwrtre_ELEMLEN_1 ZTRINGV_NUM(4)
-*/
-
-#define GWRTRE(A1,A2) CCALLSFSUB2(GWRTRE,gwrtre,STRING,INT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : gxclos.f
-------------------------------------------------------------------*/
-
-#define GXCLOS(A1) CCALLSFSUB1(GXCLOS,gxclos,INT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : gxcont.f
-------------------------------------------------------------------*/
-
-#define GXCONT() CCALLSFSUB0(GXCONT,gxcont)
-
-/*------------------------------------------------------------------
-fortran filename : gxcs.f
-------------------------------------------------------------------*/
-
-#define GXCS() CCALLSFSUB0(GXCS,gxcs)
-
-/*------------------------------------------------------------------
-fortran filename : gxdraw.f
-------------------------------------------------------------------*/
-
-#define GXDRAW() CCALLSFSUB0(GXDRAW,gxdraw)
-
-/*------------------------------------------------------------------
-fortran filename : gxdz.f
-------------------------------------------------------------------*/
-
-#define GXDZ() CCALLSFSUB0(GXDZ,gxdz)
-
-/*------------------------------------------------------------------
-fortran filename : gxfca.f
-------------------------------------------------------------------*/
-/*
-#define gxfca_ELEMS_1 ZTRINGV_NUM(1)
-#define gxfca_ELEMLEN_1 ZTRINGV_NUM(255)
-*/
-
-#define GXFCA(A1,A2,A3,A4) CCALLSFSUB4(GXFCA,gxfca,PSTRING,PINT,PINT,INT,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : gxfort.f
-------------------------------------------------------------------*/
-
-#define GXFORT() CCALLSFSUB0(GXFORT,gxfort)
-
-/*------------------------------------------------------------------
-fortran filename : gxfz.f
-------------------------------------------------------------------*/
-
-#define GXFZ() CCALLSFSUB0(GXFZ,gxfz)
-
-/*------------------------------------------------------------------
-fortran filename : gxgcon.f
-------------------------------------------------------------------*/
-
-#define GXGCON() CCALLSFSUB0(GXGCON,gxgcon)
-
-/*------------------------------------------------------------------
-fortran filename : gxgeom.f
-------------------------------------------------------------------*/
-
-#define GXGEOM() CCALLSFSUB0(GXGEOM,gxgeom)
-
-/*------------------------------------------------------------------
-fortran filename : gxgint.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN4(FLOAT,GXGINT,gxgint,FLOAT,FLOAT,FLOAT,FLOAT)
-#define GXGINT(A2,A3,A4,A5) CCALLSFFUN4(GXGINT,gxgint,FLOAT,FLOAT,FLOAT,FLOAT,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : gxlist.f
-------------------------------------------------------------------*/
-
-#define GXLIST() CCALLSFSUB0(GXLIST,gxlist)
-
-/*------------------------------------------------------------------
-fortran filename : gxlunf.f
-------------------------------------------------------------------*/
-
-#define GXLUNF(A1,A2,A3) CCALLSFSUB3(GXLUNF,gxlunf,INT,INT,PINT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : gxobj.f
-------------------------------------------------------------------*/
-/*
-#define gxobj_ELEMS_1 ZTRINGV_NUM(1)
-#define gxobj_ELEMLEN_1 ZTRINGV_NUM(255)
-#define gxobj_ELEMS_2 ZTRINGV_NUM(1)
-#define gxobj_ELEMLEN_2 ZTRINGV_NUM(255)
-#define gxobj_ELEMS_3 ZTRINGV_NUM(1)
-#define gxobj_ELEMLEN_3 ZTRINGV_NUM(255)
-#define gxobj_ELEMS_4 ZTRINGV_NUM(1)
-#define gxobj_ELEMLEN_4 ZTRINGV_NUM(255)
-#define gxobj_ELEMS_5 ZTRINGV_NUM(1)
-#define gxobj_ELEMLEN_5 ZTRINGV_NUM(255)
-#define gxobj_ELEMS_6 ZTRINGV_NUM(1)
-#define gxobj_ELEMLEN_6 ZTRINGV_NUM(255)
-#define gxobj_ELEMS_7 ZTRINGV_NUM(1)
-#define gxobj_ELEMLEN_7 ZTRINGV_NUM(255)
-*/
-
-#define GXOBJ(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(GXOBJ,gxobj,STRING,STRING,STRING,PSTRING,PSTRING,STRING,PSTRING,A1,A2,A3,A4,A5,A6,A7)
-
-/*------------------------------------------------------------------
-fortran filename : gxphys.f
-------------------------------------------------------------------*/
-
-#define GXPHYS() CCALLSFSUB0(GXPHYS,gxphys)
-
-/*------------------------------------------------------------------
-fortran filename : gxpick.f
-------------------------------------------------------------------*/
-
-#define GXPICK() CCALLSFSUB0(GXPICK,gxpick)
-
-/*------------------------------------------------------------------
-fortran filename : gxrz.f
-------------------------------------------------------------------*/
-
-#define GXRZ() CCALLSFSUB0(GXRZ,gxrz)
-
-/*------------------------------------------------------------------
-fortran filename : gxscah.f
-------------------------------------------------------------------*/
-/*
-#define gxscah_ELEMS_2 ZTRINGV_NUM(1)
-#define gxscah_ELEMLEN_2 ZTRINGV_NUM(255)
-#define gxscah_ELEMS_3 ZTRINGV_NUM(1)
-#define gxscah_ELEMLEN_3 ZTRINGV_NUM(255)
-*/
-
-#define GXSCAH(A1,A2,A3) CCALLSFSUB3(GXSCAH,gxscah,INT,STRING,STRING,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : gxscal.f
-------------------------------------------------------------------*/
-/*
-#define gxscal_ELEMS_2 ZTRINGV_NUM(1)
-#define gxscal_ELEMLEN_2 ZTRINGV_NUM(255)
-#define gxscal_ELEMS_3 ZTRINGV_NUM(1)
-#define gxscal_ELEMLEN_3 ZTRINGV_NUM(255)
-*/
-
-#define GXSCAL(A1,A2,A3) CCALLSFSUB3(GXSCAL,gxscal,PINT,STRING,STRING,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : gxscan.f
-------------------------------------------------------------------*/
-
-#define GXSCAN() CCALLSFSUB0(GXSCAN,gxscan)
-
-/*------------------------------------------------------------------
-fortran filename : gxsi.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN1(FLOAT,GXSI,gxsi,FLOAT)
-#define GXSI(A2) CCALLSFFUN1(GXSI,gxsi,FLOAT,A2)
-
-/*------------------------------------------------------------------
-fortran filename : gzebra.f
-------------------------------------------------------------------*/
-
-#define GZEBRA(A1) CCALLSFSUB1(GZEBRA,gzebra,INT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : gzinit.f
-------------------------------------------------------------------*/
-
-#define GZINIT() CCALLSFSUB0(GZINIT,gzinit)
-
-/*------------------------------------------------------------------
-fortran filename : hadden.f
-------------------------------------------------------------------*/
-
-#define HADDEN() CCALLSFSUB0(HADDEN,hadden)
-
-/*------------------------------------------------------------------
-fortran filename : hadevv.f
-------------------------------------------------------------------*/
-
-#define HADEVV(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(HADEVV,hadevv,PINT,INT,INT,DOUBLE,DOUBLE,DOUBLE,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : hadrin.f
-------------------------------------------------------------------*/
-
-#define HADRIN(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(HADRIN,hadrin,INT,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,INT,A1,A2,A3,A4,A5,A6,A7)
-
-/*------------------------------------------------------------------
-fortran filename : hadriv.f
-------------------------------------------------------------------*/
-
-#define HADRIV(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(HADRIV,hadriv,INT,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,INT,A1,A2,A3,A4,A5,A6,A7)
-
-/*------------------------------------------------------------------
-fortran filename : hevhin.f
-------------------------------------------------------------------*/
-
-#define HEVHIN(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(HEVHIN,hevhin,PINT,INT,INT,DOUBLE,DOUBLE,DOUBLE,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : higclu.f
-------------------------------------------------------------------*/
-
-#define HIGCLU(A1,A2,A3) CCALLSFSUB3(HIGCLU,higclu,INT,INT,FLOAT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : highab.f
-------------------------------------------------------------------*/
-
-#define HIGHAB(A1) CCALLSFSUB1(HIGHAB,highab,PFLOAT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : higsel.f
-------------------------------------------------------------------*/
-
-#define HIGSEL(A1) CCALLSFSUB1(HIGSEL,higsel,PINT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : higxpt.f
-------------------------------------------------------------------*/
-
-#define HIGXPT(A1,A2,A3) CCALLSFSUB3(HIGXPT,higxpt,INT,INT,FLOAT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : hinhev.f
-------------------------------------------------------------------*/
-
-#define HINHEV(A1,A2,A3,A4) CCALLSFSUB4(HINHEV,hinhev,INT,DOUBLE,DOUBLE,INT,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : hklass.f
-------------------------------------------------------------------*/
-
-#define HKLASS(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15,A16,A17,A18,A19,A20,A21,A22,A23,A24) CCALLSFSUB24(HKLASS,hklass,PINT,INT,INT,INT,INTV,INTV,INT,INT,INT,INT,INTV,PINT,PINT,PINT,PINT,PINT,PINT,DOUBLE,DOUBLE,INT,INT,INT,INT,INT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15,A16,A17,A18,A19,A20,A21,A22,A23,A24)
-
-/*------------------------------------------------------------------
-fortran filename : hypero.f
-------------------------------------------------------------------*/
-
-#define HYPERO(A1,A2,A3,A4) CCALLSFSUB4(HYPERO,hypero,PINT,PINT,PDOUBLE,PDOUBLE,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : iefun.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN2(INT,IEFUN,iefun,DOUBLE,INT)
-#define IEFUN(A2,A3) CCALLSFFUN2(IEFUN,iefun,DOUBLE,INT,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : incini.f
-------------------------------------------------------------------*/
-
-#define INCINI() CCALLSFSUB0(INCINI,incini)
-
-/*------------------------------------------------------------------
-fortran filename : index2.f
-------------------------------------------------------------------*/
-
-#define INDEX2(A1,A2,A3) CCALLSFSUB3(INDEX2,index2,INT,INT,INT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : interp.f
-------------------------------------------------------------------*/
-
-#define INTERP(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(INTERP,interp,FLOAT,PFLOAT,FLOAT,FLOAT,FLOAT,FLOAT,INT,A1,A2,A3,A4,A5,A6,A7)
-
-/*------------------------------------------------------------------
-fortran filename : intsch.f
-------------------------------------------------------------------*/
-
-#define INTSCH(A1,A2,A3,A4) CCALLSFSUB4(INTSCH,intsch,INTV,INT,PINT,INT,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : isotpe.f
-------------------------------------------------------------------*/
-
-#define ISOTPE(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12) CCALLSFSUB12(ISOTPE,isotpe,FLOATV,INTV,INTV,FLOATV,INTV,PINT,PINT,FLOAT,FLOAT,INT,PINT,PINT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12)
-
-/*------------------------------------------------------------------
-fortran filename : kinpar.f
-------------------------------------------------------------------*/
-
-#define KINPAR(A1,A2,A3) CCALLSFSUB3(KINPAR,kinpar,DOUBLEV,DOUBLEV,DOUBLE,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : kmabs.f
-------------------------------------------------------------------*/
-
-#define KMABS(A1) CCALLSFSUB1(KMABS,kmabs,PINT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : kpois.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN1(INT,KPOIS,kpois,DOUBLE)
-#define KPOIS(A2) CCALLSFFUN1(KPOIS,kpois,DOUBLE,A2)
-
-/*------------------------------------------------------------------
-fortran filename : labnf.f
-------------------------------------------------------------------*/
-
-#define LABNF(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(LABNF,labnf,FLOATV,INTV,FLOATV,FLOAT,INT,FLOAT,INT,A1,A2,A3,A4,A5,A6,A7)
-
-/*------------------------------------------------------------------
-fortran filename : limdat.f
-------------------------------------------------------------------*/
-
-#define LIMDAT() CCALLSFSUB0(LIMDAT,limdat)
-
-/*------------------------------------------------------------------
-fortran filename : lortra.f
-------------------------------------------------------------------*/
-
-#define LORTRA(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(LORTRA,lortra,INT,INT,DOUBLE,DOUBLE,DOUBLE,DOUBLE,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : lr2bod.f
-------------------------------------------------------------------*/
-
-#define LR2BOD(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13) CCALLSFSUB13(LR2BOD,lr2bod,FLOATV,INTV,INT,INT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,PFLOAT,FLOAT,INT,INT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13)
-
-/*------------------------------------------------------------------
-fortran filename : lrnorm.f
-------------------------------------------------------------------*/
-
-#define LRNORM(A1,A2,A3,A4,A5,A6,A7,A8,A9) CCALLSFSUB9(LRNORM,lrnorm,FLOATV,INTV,PINT,PINT,PINT,FLOAT,INT,INT,PFLOAT,A1,A2,A3,A4,A5,A6,A7,A8,A9)
-
-/*------------------------------------------------------------------
-fortran filename : minv.f
-------------------------------------------------------------------*/
-
-#define MINV(A1,A2,A3,A4,A5) CCALLSFSUB5(MINV,minv,PFLOAT,INT,PFLOAT,PINT,PINT,A1,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : moxsec.f
-------------------------------------------------------------------*/
-
-#define MOXSEC() CCALLSFSUB0(MOXSEC,moxsec)
-
-/*------------------------------------------------------------------
-fortran filename : n2nn3n.f
-------------------------------------------------------------------*/
-
-#define N2NN3N(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(N2NN3N,n2nn3n,FLOATV,INTV,FLOAT,INT,INT,FLOATV,FLOAT,INT,A1,A2,A3,A4,A5,A6,A7,A8)
-
-/*------------------------------------------------------------------
-fortran filename : nbanh.f
-------------------------------------------------------------------*/
-
-#define NBANH(A1) CCALLSFSUB1(NBANH,nbanh,PINT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : nclvin.f
-------------------------------------------------------------------*/
-
-#define NCLVIN() CCALLSFSUB0(NCLVIN,nclvin)
-
-/*------------------------------------------------------------------
-fortran filename : nclvst.f
-------------------------------------------------------------------*/
-
-#define NCLVST(A1,A2) CCALLSFSUB2(NCLVST,nclvst,INT,INT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : nfac.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN1(INT,NFAC,nfac,INT)
-#define NFAC(A2) CCALLSFFUN1(NFAC,nfac,INT,A2)
-
-/*------------------------------------------------------------------
-fortran filename : nghevy.f
-------------------------------------------------------------------*/
-
-#define NGHEVY(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(NGHEVY,nghevy,FLOATV,INTV,INT,FLOAT,FLOAT,INT,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : nizl.f
-------------------------------------------------------------------*/
-
-#define NIZL(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(NIZL,nizl,INT,DOUBLE,DOUBLE,DOUBLE,PDOUBLE,PDOUBLE,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : nizlnw.f
-------------------------------------------------------------------*/
-
-#define NIZLNW(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(NIZLNW,nizlnw,INT,DOUBLE,DOUBLE,DOUBLE,DOUBLE,PDOUBLE,PDOUBLE,A1,A2,A3,A4,A5,A6,A7)
-
-/*------------------------------------------------------------------
-fortran filename : nn2bod.f
-------------------------------------------------------------------*/
-
-#define NN2BOD(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11) CCALLSFSUB11(NN2BOD,nn2bod,FLOATV,INTV,INT,INT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,INT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11)
-
-/*------------------------------------------------------------------
-fortran filename : normal.f
-------------------------------------------------------------------*/
-
-#define NORMAL(A1) CCALLSFSUB1(NORMAL,normal,PFLOAT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : nsigta.f
-------------------------------------------------------------------*/
-
-#define NSIGTA(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(NSIGTA,nsigta,FLOAT,INT,PFLOAT,FLOATV,INTV,INTV,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : nucevv.f
-------------------------------------------------------------------*/
-
-#define NUCEVV(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(NUCEVV,nucevv,PINT,INT,DOUBLE,PDOUBLE,DOUBLE,DOUBLE,DOUBLE,A1,A2,A3,A4,A5,A6,A7)
-
-/*------------------------------------------------------------------
-fortran filename : nucnuc.f
-------------------------------------------------------------------*/
-
-#define NUCNUC(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12) CCALLSFSUB12(NUCNUC,nucnuc,INT,INT,DOUBLE,PDOUBLE,PLOGICAL,PLOGICAL,PINT,PINT,PINT,PINT,PLOGICAL,PLOGICAL,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12)
-
-/*------------------------------------------------------------------
-fortran filename : nucrec.f
-------------------------------------------------------------------*/
-
-#define NUCREC(A1,A2) CCALLSFSUB2(NUCREC,nucrec,PINT,INT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : nucrel.f
-------------------------------------------------------------------*/
-
-#define NUCREL(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(NUCREL,nucrel,INT,PDOUBLE,PDOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,A1,A2,A3,A4,A5,A6,A7,A8)
-
-/*------------------------------------------------------------------
-fortran filename : nucriv.f
-------------------------------------------------------------------*/
-
-#define NUCRIV(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(NUCRIV,nucriv,INT,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,A1,A2,A3,A4,A5,A6,A7,A8)
-
-/*------------------------------------------------------------------
-fortran filename : nudisv.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN6(INT,NUDISV,nudisv,DOUBLE,INT,DOUBLE,PDOUBLE,PDOUBLE,PDOUBLE)
-#define NUDISV(A2,A3,A4,A5,A6,A7) CCALLSFFUN6(NUDISV,nudisv,DOUBLE,INT,DOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,A2,A3,A4,A5,A6,A7)
-
-/*------------------------------------------------------------------
-fortran filename : nuprel.f
-------------------------------------------------------------------*/
-
-#define NUPREL(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(NUPREL,nuprel,INT,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : nwisel.f
-------------------------------------------------------------------*/
-
-#define NWISEL(A1,A2) CCALLSFSUB2(NWISEL,nwisel,INT,LOGICAL,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : parjet.f
-------------------------------------------------------------------*/
-
-#define PARJET(A1,A2) CCALLSFSUB2(PARJET,parjet,PINT,INT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : partxs.f
-------------------------------------------------------------------*/
-
-#define PARTXS(A1,A2,A3,A4,A5) CCALLSFSUB5(PARTXS,partxs,FLOATV,INTV,FLOAT,FLOAT,PFLOAT,A1,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : pbanh.f
-------------------------------------------------------------------*/
-
-#define PBANH(A1) CCALLSFSUB1(PBANH,pbanh,PINT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : pcsdat.f
-------------------------------------------------------------------*/
-
-#define PCSDAT(A1,A2,A3) CCALLSFSUB3(PCSDAT,pcsdat,INT,INT,LOGICAL,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : peanut.f
-------------------------------------------------------------------*/
-
-#define PEANUT(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(PEANUT,peanut,INT,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,A1,A2,A3,A4,A5,A6,A7)
-
-/*------------------------------------------------------------------
-fortran filename : pfnclv.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN2(DOUBLE,PFNCLV,pfnclv,INT,LOGICAL)
-#define PFNCLV(A2,A3) CCALLSFFUN2(PFNCLV,pfnclv,INT,LOGICAL,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : phasp.f
-------------------------------------------------------------------*/
-
-#define PHASP() CCALLSFSUB0(PHASP,phasp)
-
-/*------------------------------------------------------------------
-fortran filename : phdset.f
-------------------------------------------------------------------*/
-
-#define PHDSET(A1) CCALLSFSUB1(PHDSET,phdset,INT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : phdwll.f
-------------------------------------------------------------------*/
-
-#define PHDWLL(A1,A2,A3) CCALLSFSUB3(PHDWLL,phdwll,DOUBLE,DOUBLE,DOUBLE,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : photon.f
-------------------------------------------------------------------*/
-
-#define PHOTON(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15,A16,A17,A18,A19) CCALLSFSUB19(PHOTON,photon,FLOATV,INTV,PINT,PINT,INTV,INTV,PINT,PINT,FLOATV,PINT,PINT,PINT,INTV,INTV,FLOAT,PINT,INT,INT,FLOAT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15,A16,A17,A18,A19)
-
-/*------------------------------------------------------------------
-fortran filename : phpnuc.f
-------------------------------------------------------------------*/
-
-#define PHPNUC() CCALLSFSUB0(PHPNUC,phpnuc)
-
-/*------------------------------------------------------------------
-fortran filename : pimabs.f
-------------------------------------------------------------------*/
-
-#define PIMABS(A1) CCALLSFSUB1(PIMABS,pimabs,PINT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : pioabs.f
-------------------------------------------------------------------*/
-
-#define PIOABS(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12) CCALLSFSUB12(PIOABS,pioabs,INT,INT,DOUBLE,PDOUBLE,PLOGICAL,PLOGICAL,PINT,PINT,INT,INT,PLOGICAL,PLOGICAL,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12)
-
-/*------------------------------------------------------------------
-fortran filename : pmltpc.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN6(FLOAT,PMLTPC,pmltpc,INT,INT,INT,INT,FLOAT,FLOAT)
-#define PMLTPC(A2,A3,A4,A5,A6,A7) CCALLSFFUN6(PMLTPC,pmltpc,INT,INT,INT,INT,FLOAT,FLOAT,A2,A3,A4,A5,A6,A7)
-
-/*------------------------------------------------------------------
-fortran filename : pmprab.f
-------------------------------------------------------------------*/
-
-#define PMPRAB(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(PMPRAB,pmprab,INT,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,A1,A2,A3,A4,A5,A6,A7)
-
-/*------------------------------------------------------------------
-fortran filename : poisso.f
-------------------------------------------------------------------*/
-
-#define POISSO(A1,A2) CCALLSFSUB2(POISSO,poisso,FLOAT,PINT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : poli.f
-------------------------------------------------------------------*/
-
-#define POLI(A1,A2) CCALLSFSUB2(POLI,poli,PDOUBLE,PDOUBLE,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : prepre.f
-------------------------------------------------------------------*/
-/*------------------------------------------------------------------
-fortran filename : qnrg.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN4(DOUBLE,QNRG,qnrg,DOUBLE,DOUBLE,DOUBLE,DOUBLE)
-#define QNRG(A2,A3,A4,A5) CCALLSFFUN4(QNRG,qnrg,DOUBLE,DOUBLE,DOUBLE,DOUBLE,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : raco.f
-------------------------------------------------------------------*/
-
-#define RACO(A1,A2,A3) CCALLSFSUB3(RACO,raco,PDOUBLE,PDOUBLE,PDOUBLE,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : rakekv.f
-------------------------------------------------------------------*/
-
-#define RAKEKV(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11) CCALLSFSUB11(RAKEKV,rakekv,INT,PDOUBLE,DOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,DOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11)
-
-/*------------------------------------------------------------------
-fortran filename : randc.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN1(DOUBLE,RANDC,randc,INT)
-#define RANDC(A2) CCALLSFFUN1(RANDC,randc,INT,A2)
-
-/*------------------------------------------------------------------
-fortran filename : ranres.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN1(FLOAT,RANRES,ranres,FLOAT)
-#define RANRES(A2) CCALLSFFUN1(RANRES,ranres,FLOAT,A2)
-
-/*------------------------------------------------------------------
-fortran filename : rbkekv.f
-------------------------------------------------------------------*/
-
-#define RBKEKV(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11) CCALLSFSUB11(RBKEKV,rbkekv,INT,PDOUBLE,DOUBLE,DOUBLE,PDOUBLE,PDOUBLE,DOUBLE,DOUBLE,PDOUBLE,DOUBLE,DOUBLE,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11)
-
-/*------------------------------------------------------------------
-fortran filename : rchanv.f
-------------------------------------------------------------------*/
-
-#define RCHANV() CCALLSFSUB0(RCHANV,rchanv)
-
-/*------------------------------------------------------------------
-fortran filename : rnmaxf.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN1(FLOAT,RNMAXF,rnmaxf,FLOAT)
-#define RNMAXF(A2) CCALLSFFUN1(RNMAXF,rnmaxf,FLOAT,A2)
-
-/*------------------------------------------------------------------
-fortran filename : rotat.f
-------------------------------------------------------------------*/
-
-#define ROTAT(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10) CCALLSFSUB10(ROTAT,rotat,DOUBLE,DOUBLE,DOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10)
-
-/*------------------------------------------------------------------
-fortran filename : rotes2.f
-------------------------------------------------------------------*/
-
-#define ROTES2(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(ROTES2,rotes2,FLOAT,FLOAT,FLOAT,FLOAT,PFLOAT,INT,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : rstsel.f
-------------------------------------------------------------------*/
-
-#define RSTSEL(A1) CCALLSFSUB1(RSTSEL,rstsel,INT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : rtmi.f
-------------------------------------------------------------------*/
-
-#define RTMI(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(RTMI,rtmi,PFLOAT,PFLOAT,FLOAT,FLOAT,FLOAT,FLOAT,INT,PINT,A1,A2,A3,A4,A5,A6,A7,A8)
-
-/*------------------------------------------------------------------
-fortran filename : samcst.f
-------------------------------------------------------------------*/
-
-#define SAMCST(A1,A2,A3) CCALLSFSUB3(SAMCST,samcst,INT,DOUBLE,PDOUBLE,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : sbcomp.f
-------------------------------------------------------------------*/
-
-#define SBCOMP(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(SBCOMP,sbcomp,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : secegy.f
-------------------------------------------------------------------*/
-
-#define SECEGY(A1,A2,A3,A4) CCALLSFSUB4(SECEGY,secegy,PFLOAT,FLOATV,PFLOAT,INTV,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : secl11.f
-------------------------------------------------------------------*/
-
-#define SECL11(A1,A2,A3,A4,A5) CCALLSFSUB5(SECL11,secl11,FLOATV,INTV,PFLOAT,FLOAT,FLOAT,A1,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : seclf1.f
-------------------------------------------------------------------*/
-
-#define SECLF1(A1,A2,A3,A4,A5) CCALLSFSUB5(SECLF1,seclf1,FLOATV,INTV,PFLOAT,FLOAT,FLOAT,A1,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : seclf5.f
-------------------------------------------------------------------*/
-
-#define SECLF5(A1,A2,A3,A4,A5) CCALLSFSUB5(SECLF5,seclf5,FLOATV,INTV,PFLOAT,FLOAT,FLOAT,A1,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : seclf7.f
-------------------------------------------------------------------*/
-
-#define SECLF7(A1,A2,A3,A4,A5) CCALLSFSUB5(SECLF7,seclf7,FLOATV,INTV,PFLOAT,FLOAT,FLOAT,A1,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : seclf9.f
-------------------------------------------------------------------*/
-
-#define SECLF9(A1,A2,A3,A4,A5) CCALLSFSUB5(SECLF9,seclf9,FLOATV,INTV,PFLOAT,FLOAT,FLOAT,A1,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : selfab.f
-------------------------------------------------------------------*/
-
-#define SELFAB(A1) CCALLSFSUB1(SELFAB,selfab,PFLOAT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : setcur.f
-------------------------------------------------------------------*/
-
-#define SETCUR(A1) CCALLSFSUB1(SETCUR,setcur,INT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : settrk.f
-------------------------------------------------------------------*/
-
-#define SETTRK(A1) CCALLSFSUB1(SETTRK,settrk,INT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : sfecfe.f
-------------------------------------------------------------------*/
-
-#define SFECFE(A1,A2) CCALLSFSUB2(SFECFE,sfecfe,DOUBLE,DOUBLE,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : sflraf.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN1(FLOAT,SFLRAF,sflraf,FLOAT)
-#define SFLRAF(A2) CCALLSFFUN1(SFLRAF,sflraf,FLOAT,A2)
-
-/*------------------------------------------------------------------
-fortran filename : shptot.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN2(DOUBLE,SHPTOT,shptot,INT,DOUBLE)
-#define SHPTOT(A2,A3) CCALLSFFUN2(SHPTOT,shptot,INT,DOUBLE,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : sigel.f
-------------------------------------------------------------------*/
-
-#define SIGEL(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(SIGEL,sigel,INT,DOUBLE,DOUBLE,DOUBLE,PDOUBLE,PDOUBLE,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : sigfer.f
-------------------------------------------------------------------*/
-
-#define SIGFER(A1,A2,A3,A4) CCALLSFSUB4(SIGFER,sigfer,INT,DOUBLE,DOUBLE,LOGICAL,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : sigmor.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN2(FLOAT,SIGMOR,sigmor,FLOAT,INT)
-#define SIGMOR(A2,A3) CCALLSFFUN2(SIGMOR,sigmor,FLOAT,INT,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : sihael.f
-------------------------------------------------------------------*/
-
-#define SIHAEL(A1,A2,A3,A4,A5) CCALLSFSUB5(SIHAEL,sihael,INT,DOUBLE,DOUBLE,DOUBLE,PDOUBLE,A1,A2,A3,A4,A5)
-
-/*------------------------------------------------------------------
-fortran filename : sitsao.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN3(DOUBLE,SITSAO,sitsao,DOUBLE,INT,DOUBLE)
-#define SITSAO(A2,A3,A4) CCALLSFFUN3(SITSAO,sitsao,DOUBLE,INT,DOUBLE,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : stalin.f
-------------------------------------------------------------------*/
-
-#define STALIN() CCALLSFSUB0(STALIN,stalin)
-
-/*------------------------------------------------------------------
-fortran filename : steep.f
-------------------------------------------------------------------*/
-
-#define STEEP(A1) CCALLSFSUB1(STEEP,steep,PFLOAT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : steeq.f
-------------------------------------------------------------------*/
-
-#define STEEQ(A1,A2) CCALLSFSUB2(STEEQ,steeq,PFLOAT,INT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : steer.f
-------------------------------------------------------------------*/
-
-#define STEER(A1) CCALLSFSUB1(STEER,steer,PFLOAT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : stees.f
-------------------------------------------------------------------*/
-
-#define STEES(A1,A2) CCALLSFSUB2(STEES,stees,PFLOAT,FLOAT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : stopar.f
-------------------------------------------------------------------*/
-
-#define STOPAR(A1,A2) CCALLSFSUB2(STOPAR,stopar,INT,PINT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : stpair.f
-------------------------------------------------------------------*/
-
-#define STPAIR() CCALLSFSUB0(STPAIR,stpair)
-
-/*------------------------------------------------------------------
-fortran filename : sverl2.f
-------------------------------------------------------------------*/
-
-#define SVERL2(A1,A2) CCALLSFSUB2(SVERL2,sverl2,INT,PFLOAT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : svgam7.f
-------------------------------------------------------------------*/
-
-#define SVGAM7(A1,A2) CCALLSFSUB2(SVGAM7,svgam7,FLOAT,PFLOAT,A1,A2)
-
-/*------------------------------------------------------------------
-fortran filename : tbsplt.f
-------------------------------------------------------------------*/
-
-#define TBSPLT(A1,A2,A3,A4) CCALLSFSUB4(TBSPLT,tbsplt,FLOATV,FLOAT,INT,PFLOAT,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : tchoic.f
-------------------------------------------------------------------*/
-
-#define TCHOIC(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10) CCALLSFSUB10(TCHOIC,tchoic,PDOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,INT,INT,INT,DOUBLE,DOUBLE,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10)
-
-/*------------------------------------------------------------------
-fortran filename : tdelay.f
-------------------------------------------------------------------*/
-
-#define TDELAY(A1) CCALLSFSUB1(TDELAY,tdelay,PFLOAT,A1)
-
-/*------------------------------------------------------------------
-fortran filename : threpd.f
-------------------------------------------------------------------*/
-
-#define THREPD(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15,A16,A17,A18,A19) CCALLSFSUB19(THREPD,threpd,DOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15,A16,A17,A18,A19)
-
-/*------------------------------------------------------------------
-fortran filename : thrmsc.f
-------------------------------------------------------------------*/
-
-#define THRMSC(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14) CCALLSFSUB14(THRMSC,thrmsc,FLOATV,INTV,INTV,INTV,PFLOAT,PFLOAT,PFLOAT,PFLOAT,FLOAT,PFLOAT,FLOATV,INT,PINT,INT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14)
-
-/*------------------------------------------------------------------
-fortran filename : thrsel.f
-------------------------------------------------------------------*/
-
-#define THRSEL(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15,A16,A17,A18,A19) CCALLSFSUB19(THRSEL,thrsel,INT,INT,INT,FLOAT,PFLOAT,PFLOAT,FLOAT,FLOATV,FLOATV,FLOATV,FLOATV,PFLOAT,FLOATV,PFLOAT,FLOATV,INT,INTV,INTV,INT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15,A16,A17,A18,A19)
-
-/*------------------------------------------------------------------
-fortran filename : trafo.f
-------------------------------------------------------------------*/
-
-#define TRAFO(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15) CCALLSFSUB15(TRAFO,trafo,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,PDOUBLE,DOUBLE,DOUBLE,DOUBLE,PDOUBLE,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15)
-
-/*------------------------------------------------------------------
-fortran filename : trahad.f
-------------------------------------------------------------------*/
-
-#define TRAHAD(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(TRAHAD,trahad,INT,INT,DOUBLE,DOUBLE,DOUBLE,DOUBLE,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : trans.f
-------------------------------------------------------------------*/
-
-#define TRANS(A1,A2,A3,A4,A5,A6,A7,A8,A9) CCALLSFSUB9(TRANS,trans,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,A1,A2,A3,A4,A5,A6,A7,A8,A9)
-
-/*------------------------------------------------------------------
-fortran filename : trebod.f
-------------------------------------------------------------------*/
-
-#define TREBOD(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14) CCALLSFSUB14(TREBOD,trebod,FLOATV,INTV,INT,INT,PINT,FLOAT,FLOAT,PFLOAT,FLOAT,FLOAT,PFLOAT,FLOAT,FLOAT,INT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14)
-
-/*------------------------------------------------------------------
-fortran filename : ttrans.f
-------------------------------------------------------------------*/
-
-#define TTRANS(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10) CCALLSFSUB10(TTRANS,ttrans,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10)
-
-/*------------------------------------------------------------------
-fortran filename : twob.f
-------------------------------------------------------------------*/
-
-#define TWOB(A1,A2,A3) CCALLSFSUB3(TWOB,twob,INT,INT,FLOAT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : twobod.f
-------------------------------------------------------------------*/
-
-#define TWOBOD(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11) CCALLSFSUB11(TWOBOD,twobod,FLOATV,INTV,PINT,INT,FLOAT,PFLOAT,FLOAT,PFLOAT,FLOAT,FLOAT,INT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11)
-
-/*------------------------------------------------------------------
-fortran filename : twoclu.f
-------------------------------------------------------------------*/
-
-#define TWOCLU(A1,A2,A3) CCALLSFSUB3(TWOCLU,twoclu,INT,INT,FLOAT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : twopad.f
-------------------------------------------------------------------*/
-
-#define TWOPAD(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13) CCALLSFSUB13(TWOPAD,twopad,DOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,DOUBLE,DOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,DOUBLE,DOUBLE,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13)
-
-/*------------------------------------------------------------------
-fortran filename : twopar.f
-------------------------------------------------------------------*/
-
-#define TWOPAR(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15,A16,A17,A18) CCALLSFSUB18(TWOPAR,twopar,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,DOUBLE,PDOUBLE,DOUBLE,PDOUBLE,INT,INT,DOUBLE,DOUBLE,DOUBLE,INT,DOUBLE,DOUBLE,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15,A16,A17,A18)
-
-/*------------------------------------------------------------------
-fortran filename : umofin.f
-------------------------------------------------------------------*/
-
-#define UMOFIN(A1,A2,A3,A4) CCALLSFSUB4(UMOFIN,umofin,INT,PDOUBLE,PDOUBLE,PLOGICAL,A1,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : vecsub.f
-------------------------------------------------------------------*/
-
-#define ADD(A1,A2,A3) CCALLSFSUB3(ADD,add,INT,INT,INT,A1,A2,A3)
-
-
-#define ADD3(A1,A2,A3) CCALLSFSUB3(ADD3,add3,INT,INT,INT,A1,A2,A3)
-
-
-#define SUB3(A1,A2,A3) CCALLSFSUB3(SUB3,sub3,INT,INT,INT,A1,A2,A3)
-
-
-#define CROSS3(A1,A2,A3) CCALLSFSUB3(CROSS3,cross3,INT,INT,INT,A1,A2,A3)
-
-
-#define SUB(A1,A2,A3) CCALLSFSUB3(SUB,sub,INT,INT,INT,A1,A2,A3)
-
-
-#define LOR(A1,A2,A3) CCALLSFSUB3(LOR,lor,INT,INT,INT,A1,A2,A3)
-
-
-#define LENGTX(A1,A2) CCALLSFSUB2(LENGTX,lengtx,INT,PFLOAT,A1,A2)
-
-
-#define ANG(A1,A2,A3,A4) CCALLSFSUB4(ANG,ang,INT,INT,PFLOAT,PFLOAT,A1,A2,A3,A4)
-
-
-#define DEFS(A1,A2,A3) CCALLSFSUB3(DEFS,defs,INT,INT,INT,A1,A2,A3)
-
-
-#define TRAC(A1,A2,A3) CCALLSFSUB3(TRAC,trac,INT,INT,INT,A1,A2,A3)
-
-/*------------------------------------------------------------------
-fortran filename : verein.f
-------------------------------------------------------------------*/
-
-#define VEREIN(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15,A16,A17,A18,A19,A20,A21,A22,A23,A24,A25,A26,A27,A28,A29,A30,A31,A32,A33,A34) CCALLSFSUB34(VEREIN,verein,PINT,PINT,INT,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,INT,INT,INT,INT,PINT,INT,INTV,INTV,PINT,PINT,PINT,PINT,PINT,PINT,DOUBLE,DOUBLE,DOUBLE,INT,INT,INT,INT,INT,INT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15,A16,A17,A18,A19,A20,A21,A22,A23,A24,A25,A26,A27,A28,A29,A30,A31,A32,A33,A34)
-
-/*------------------------------------------------------------------
-fortran filename : xinneu.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN3(DOUBLE,XINNEU,xinneu,DOUBLE,DOUBLE,DOUBLE)
-#define XINNEU(A2,A3,A4) CCALLSFFUN3(XINNEU,xinneu,DOUBLE,DOUBLE,DOUBLE,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : xinpro.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN3(DOUBLE,XINPRO,xinpro,DOUBLE,DOUBLE,DOUBLE)
-#define XINPRO(A2,A3,A4) CCALLSFFUN3(XINPRO,xinpro,DOUBLE,DOUBLE,DOUBLE,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : xlamb.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN3(DOUBLE,XLAMB,xlamb,DOUBLE,DOUBLE,DOUBLE)
-#define XLAMB(A2,A3,A4) CCALLSFFUN3(XLAMB,xlamb,DOUBLE,DOUBLE,DOUBLE,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : xsecn1.f
-------------------------------------------------------------------*/
-
-#define XSECN1(A1,A2,A3,A4,A5,A6,A7,A8,A9) CCALLSFSUB9(XSECN1,xsecn1,INTV,INTV,PINT,PINT,PINT,PINT,FLOATV,INTV,PINT,A1,A2,A3,A4,A5,A6,A7,A8,A9)
-
-/*------------------------------------------------------------------
-fortran filename : xsecn2.f
-------------------------------------------------------------------*/
-
-#define XSECN2(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15,A16,A17,A18,A19,A20,A21,A22,A23,A24,A25) CCALLSFSUB25(XSECN2,xsecn2,INTV,INTV,INTV,PINT,PINT,PFLOAT,PINT,PINT,PINT,PINT,PINT,PINT,PINT,PINT,PINT,PINT,PFLOAT,PFLOAT,PINT,PFLOAT,FLOATV,INTV,INT,PINT,INTV,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15,A16,A17,A18,A19,A20,A21,A22,A23,A24,A25)
-
-/*------------------------------------------------------------------
-fortran filename : xsecn3.f
-------------------------------------------------------------------*/
-
-#define XSECN3(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13) CCALLSFSUB13(XSECN3,xsecn3,INTV,INTV,FLOATV,INTV,PINT,PINT,PINT,PINT,PFLOAT,INTV,FLOATV,INT,PINT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13)
-
-/*------------------------------------------------------------------
-fortran filename : xsecn5.f
-------------------------------------------------------------------*/
-
-#define XSECN5(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11) CCALLSFSUB11(XSECN5,xsecn5,INTV,PINT,PINT,PINT,PINT,PFLOAT,INTV,FLOATV,INTV,INT,PINT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11)
-
-/*------------------------------------------------------------------
-fortran filename : xsecnu.f
-------------------------------------------------------------------*/
-
-#define XSECNU(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(XSECNU,xsecnu,FLOATV,INT,FLOAT,PFLOAT,INT,INT,A1,A2,A3,A4,A5,A6)
-
-/*------------------------------------------------------------------
-fortran filename : xseneu.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN3(DOUBLE,XSENEU,xseneu,DOUBLE,DOUBLE,DOUBLE)
-#define XSENEU(A2,A3,A4) CCALLSFFUN3(XSENEU,xseneu,DOUBLE,DOUBLE,DOUBLE,A2,A3,A4)
-
-/*------------------------------------------------------------------
-fortran filename : xsepro.f
-------------------------------------------------------------------*/
-
- PROTOCCALLSFFUN3(DOUBLE,XSEPRO,xsepro,DOUBLE,DOUBLE,DOUBLE)
-#define XSEPRO(A2,A3,A4) CCALLSFFUN3(XSEPRO,xsepro,DOUBLE,DOUBLE,DOUBLE,A2,A3,A4)
-
diff --git a/src/cfortran/gen.h b/src/cfortran/gen.h
deleted file mode 100644
index 0b883a4..0000000
--- a/src/cfortran/gen.h
+++ /dev/null
@@ -1,1491 +0,0 @@
-/* Subroutines/Functions with COMPLEX not supported ***
-
-#define CBSJA(A1,A2,A3,A4,A5) CCALLSFSUB5(CBSJA,cbsja,COMPLEX,FLOAT,INT,INT,PCOMPLEX,A1,A2,A3,A4,A5)
-#define WBSJA(A1,A2,A3,A4,A5) CCALLSFSUB5(WBSJA,wbsja,COMPLEX,DOUBLE,INT,INT,PCOMPLEX,A1,A2,A3,A4,A5)
-PROTOCCALLSFFUN1(COMPLEX,CDIGAM,cdigam,COMPLEX)
-#define CDIGAM(A2) CCALLSFFUN1(CDIGAM,cdigam,COMPLEX,A2)
-PROTOCCALLSFFUN1(COMPLEX,WDIGAM,wdigam,COMPLEX)
-#define WDIGAM(A2) CCALLSFFUN1(WDIGAM,wdigam,COMPLEX,A2)
-#define CELFUN(A1,A2,A3,A4,A5) CCALLSFSUB5(CELFUN,celfun,COMPLEX,FLOAT,PCOMPLEX,PCOMPLEX,PCOMPLEX,A1,A2,A3,A4,A5)
-#define WELFUN(A1,A2,A3,A4,A5) CCALLSFSUB5(WELFUN,welfun,COMPLEX,DOUBLE,PCOMPLEX,PCOMPLEX,PCOMPLEX,A1,A2,A3,A4,A5)
-PROTOCCALLSFFUN4(COMPLEX,CELINT,celint,COMPLEX,FLOAT,FLOAT,FLOAT)
-#define CELINT(A2,A3,A4,A5) CCALLSFFUN4(CELINT,celint,COMPLEX,FLOAT,FLOAT,FLOAT,A2,A3,A4,A5)
-PROTOCCALLSFFUN4(COMPLEX,WELINT,welint,COMPLEX,DOUBLE,DOUBLE,DOUBLE)
-#define WELINT(A2,A3,A4,A5) CCALLSFFUN4(WELINT,welint,COMPLEX,DOUBLE,DOUBLE,DOUBLE,A2,A3,A4,A5)
-PROTOCCALLSFFUN1(COMPLEX,CEXPIN,cexpin,COMPLEX)
-#define CEXPIN(A2) CCALLSFFUN1(CEXPIN,cexpin,COMPLEX,A2)
-PROTOCCALLSFFUN1(COMPLEX,WEXPIN,wexpin,COMPLEX)
-#define WEXPIN(A2) CCALLSFFUN1(WEXPIN,wexpin,COMPLEX,A2)
-PROTOCCALLSFFUN1(COMPLEX,CGAMMA,cgamma,COMPLEX)
-#define CGAMMA(A2) CCALLSFFUN1(CGAMMA,cgamma,COMPLEX,A2)
-PROTOCCALLSFFUN1(COMPLEX,WGAMMA,wgamma,COMPLEX)
-#define WGAMMA(A2) CCALLSFFUN1(WGAMMA,wgamma,COMPLEX,A2)
-PROTOCCALLSFFUN4(COMPLEX,CGAUSS,cgauss,ROUTINE,COMPLEX,COMPLEX,FLOAT)
-#define CGAUSS(A2,A3,A4,A5) CCALLSFFUN4(CGAUSS,cgauss,ROUTINE,COMPLEX,COMPLEX,FLOAT,A2,A3,A4,A5)
-PROTOCCALLSFFUN4(COMPLEX,WGAUSS,wgauss,ROUTINE,COMPLEX,COMPLEX,DOUBLE)
-#define WGAUSS(A2,A3,A4,A5) CCALLSFFUN4(WGAUSS,wgauss,ROUTINE,COMPLEX,COMPLEX,DOUBLE,A2,A3,A4,A5)
-PROTOCCALLSFFUN3(COMPLEX,CGPLG,cgplg,INT,INT,FLOAT)
-#define CGPLG(A2,A3,A4) CCALLSFFUN3(CGPLG,cgplg,INT,INT,FLOAT,A2,A3,A4)
-PROTOCCALLSFFUN3(COMPLEX,WGPLG,wgplg,INT,INT,DOUBLE)
-#define WGPLG(A2,A3,A4) CCALLSFFUN3(WGPLG,wgplg,INT,INT,DOUBLE,A2,A3,A4)
-PROTOCCALLSFFUN1(COMPLEX,CLGAMA,clgama,COMPLEX)
-#define CLGAMA(A2) CCALLSFFUN1(CLGAMA,clgama,COMPLEX,A2)
-PROTOCCALLSFFUN1(COMPLEX,WLGAMA,wlgama,COMPLEX)
-#define WLGAMA(A2) CCALLSFFUN1(WLGAMA,wlgama,COMPLEX,A2)
-#define CIRCLE(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(CIRCLE,circle,PCOMPLEX,FLOAT,COMPLEXV,COMPLEXV,INT,PINT,INT,A1,A2,A3,A4,A5,A6,A7)
-PROTOCCALLSFFUN3(COMPLEX,CLOGOK,clogok,COMPLEX,INT,INT)
-#define CLOGOK(A2,A3,A4) CCALLSFFUN3(CLOGOK,clogok,COMPLEX,INT,INT,A2,A3,A4)
-#define WPOLYZ(A1,A2,A3,A4,A5) CCALLSFSUB5(WPOLYZ,wpolyz,COMPLEXV,INT,INT,PCOMPLEX,PDOUBLE,A1,A2,A3,A4,A5)
-#define CPSC(A1,A2,A3,A4,A5) CCALLSFSUB5(CPSC,cpsc,COMPLEX,COMPLEX,INT,PCOMPLEX,PFLOAT,A1,A2,A3,A4,A5)
-PROTOCCALLSFFUN3(FLOAT,CRIT,crit,COMPLEX,COMPLEX,FLOAT)
-#define CRIT(A2,A3,A4) CCALLSFFUN3(CRIT,crit,COMPLEX,COMPLEX,FLOAT,A2,A3,A4)
-PROTOCCALLSFFUN3(COMPLEX,CSQRTK,csqrtk,COMPLEX,INT,INT)
-#define CSQRTK(A2,A3,A4) CCALLSFFUN3(CSQRTK,csqrtk,COMPLEX,INT,INT,A2,A3,A4)
-PROTOCCALLSFFUN1(COMPLEX,CWERF,cwerf,COMPLEX)
-#define CWERF(A2) CCALLSFFUN1(CWERF,cwerf,COMPLEX,A2)
-PROTOCCALLSFFUN1(COMPLEX,WWERF,wwerf,COMPLEX)
-#define WWERF(A2) CCALLSFFUN1(WWERF,wwerf,COMPLEX,A2)
-PROTOCCALLSFFUN3(COMPLEX,CWHITM,cwhitm,COMPLEX,COMPLEX,COMPLEX)
-#define CWHITM(A2,A3,A4) CCALLSFFUN3(CWHITM,cwhitm,COMPLEX,COMPLEX,COMPLEX,A2,A3,A4)
-PROTOCCALLSFFUN3(COMPLEX,WWHITM,wwhitm,COMPLEX,COMPLEX,COMPLEX)
-#define WWHITM(A2,A3,A4) CCALLSFFUN3(WWHITM,wwhitm,COMPLEX,COMPLEX,COMPLEX,A2,A3,A4)
-#define DEFLAT(A1,A2,A3) CCALLSFSUB3(DEFLAT,deflat,PCOMPLEX,PINT,COMPLEX,A1,A2,A3)
-#define HYPGM(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(HYPGM,hypgm,COMPLEX,COMPLEX,COMPLEX,COMPLEX,PCOMPLEX,FLOAT,PINT,A1,A2,A3,A4,A5,A6,A7)
-#define LEGFN(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(LEGFN,legfn,COMPLEX,COMPLEX,PCOMPLEX,PCOMPLEX,PINT,INT,A1,A2,A3,A4,A5,A6)
-PROTOCCALLSFFUN3(INT,NZERFZ,nzerfz,COMPLEX,COMPLEXV,INT)
-#define NZERFZ(A2,A3,A4) CCALLSFFUN3(NZERFZ,nzerfz,COMPLEX,COMPLEXV,INT,A2,A3,A4)
-#define NZEROS(A1,A2,A3,A4) CCALLSFSUB4(NZEROS,nzeros,PINT,COMPLEX,FLOAT,COMPLEX,A1,A2,A3,A4)
-#define POLY2(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(POLY2,poly2,COMPLEXV,INT,PCOMPLEX,PFLOAT,INT,INT,A1,A2,A3,A4,A5,A6)
-#define PREP(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(PREP,prep,PCOMPLEX,PCOMPLEX,PCOMPLEX,INT,COMPLEX,FLOAT,PINT,COMPLEX,A1,A2,A3,A4,A5,A6,A7,A8)
-PROTOCCALLSFFUN13(COMPLEX,C309R1,c309r1,COMPLEX,COMPLEX,COMPLEX,COMPLEX,DOUBLE,INT,PDOUBLE,PINT,DOUBLE,DOUBLE,LOGICAL,DOUBLE,COMPLEX)
-#define C309R1(A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14) CCALLSFFUN13(C309R1,c309r1,COMPLEX,COMPLEX,COMPLEX,COMPLEX,DOUBLE,INT,PDOUBLE,PINT,DOUBLE,DOUBLE,LOGICAL,DOUBLE,COMPLEX,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14)
-PROTOCCALLSFFUN12(COMPLEX,C309R2,c309r2,COMPLEX,COMPLEX,COMPLEX,COMPLEX,DOUBLE,INT,INT,PDOUBLE,PINT,DOUBLE,DOUBLE,DOUBLE)
-#define C309R2(A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13) CCALLSFFUN12(C309R2,c309r2,COMPLEX,COMPLEX,COMPLEX,COMPLEX,DOUBLE,INT,INT,PDOUBLE,PINT,DOUBLE,DOUBLE,DOUBLE,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13)
-PROTOCCALLSFFUN9(COMPLEX,C309R3,c309r3,COMPLEX,COMPLEX,COMPLEX,DOUBLE,INT,PDOUBLE,DOUBLE,PINT,PCOMPLEX)
-#define C309R3(A2,A3,A4,A5,A6,A7,A8,A9,A10) CCALLSFFUN9(C309R3,c309r3,COMPLEX,COMPLEX,COMPLEX,DOUBLE,INT,PDOUBLE,DOUBLE,PINT,PCOMPLEX,A2,A3,A4,A5,A6,A7,A8,A9,A10)
-PROTOCCALLSFFUN13(COMPLEX,C309R5,c309r5,COMPLEX,COMPLEX,COMPLEX,DOUBLE,PCOMPLEX,PCOMPLEX,LOGICAL,INT,PDOUBLE,PINT,DOUBLE,DOUBLE,LOGICAL)
-#define C309R5(A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14) CCALLSFFUN13(C309R5,c309r5,COMPLEX,COMPLEX,COMPLEX,DOUBLE,PCOMPLEX,PCOMPLEX,LOGICAL,INT,PDOUBLE,PINT,DOUBLE,DOUBLE,LOGICAL,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14)
-PROTOCCALLSFFUN13(COMPLEX,C309R6,c309r6,COMPLEX,COMPLEX,COMPLEX,COMPLEX,DOUBLE,INT,PINT,PCOMPLEX,PDOUBLE,DOUBLE,PCOMPLEX,PCOMPLEX,COMPLEXV)
-#define C309R6(A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14) CCALLSFFUN13(C309R6,c309r6,COMPLEX,COMPLEX,COMPLEX,COMPLEX,DOUBLE,INT,PINT,PCOMPLEX,PDOUBLE,DOUBLE,PCOMPLEX,PCOMPLEX,COMPLEXV,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14)
-#define C309R7(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(C309R7,c309r7,COMPLEXV,PCOMPLEX,INT,PINT,PCOMPLEX,DOUBLE,A1,A2,A3,A4,A5,A6)
-PROTOCCALLSFFUN2(COMPLEX,C309R8,c309r8,COMPLEX,DOUBLE)
-#define C309R8(A2,A3) CCALLSFFUN2(C309R8,c309r8,COMPLEX,DOUBLE,A2,A3)
-PROTOCCALLSFFUN3(COMPLEX,RGAM,rgam,COMPLEX,COMPLEX,COMPLEX)
-#define RGAM(A2,A3,A4) CCALLSFFUN3(RGAM,rgam,COMPLEX,COMPLEX,COMPLEX,A2,A3,A4)
-#define DMULLZ(A1,A2,A3,A4) CCALLSFSUB4(DMULLZ,dmullz,DOUBLEV,INT,INT,PCOMPLEX,A1,A2,A3,A4)
-#define DRTEQ4(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(DRTEQ4,drteq4,DOUBLE,DOUBLE,DOUBLE,DOUBLE,PCOMPLEX,PDOUBLE,PINT,A1,A2,A3,A4,A5,A6,A7)
-#define VP(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(VP,vp,PCOMPLEX,COMPLEX,COMPLEXV,INT,PINT,INT,A1,A2,A3,A4,A5,A6)
-#define WCLBES(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13) CCALLSFSUB13(WCLBES,wclbes,COMPLEX,COMPLEX,COMPLEX,INT,PCOMPLEX,PCOMPLEX,PCOMPLEX,PCOMPLEX,PCOMPLEX,INT,INT,PINT,INT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13)
-
-*** End Subroutines/Functions using COMPLEX */
-
-PROTOCCALLSFFUN1(FLOAT,ADIGAM,adigam,FLOAT)
-#define ADIGAM(A2) CCALLSFFUN1(ADIGAM,adigam,FLOAT,A2)
-
-PROTOCCALLSFFUN1(FLOAT,ALGAMA,algama,FLOAT)
-#define ALGAMA(A2) CCALLSFFUN1(ALGAMA,algama,FLOAT,A2)
-
-PROTOCCALLSFFUN1(FLOAT,QLGAMA,qlgama,FLOAT)
-#define QLGAMA(A2) CCALLSFFUN1(QLGAMA,qlgama,FLOAT,A2)
-
-PROTOCCALLSFFUN1(DOUBLE,DLGAMA,dlgama,DOUBLE)
-#define DLGAMA(A2) CCALLSFFUN1(DLGAMA,dlgama,DOUBLE,A2)
-
-PROTOCCALLSFFUN1(FLOAT,ASINH,asinh,FLOAT)
-#define ASINH(A2) CCALLSFFUN1(ASINH,asinh,FLOAT,A2)
-
-PROTOCCALLSFFUN1(DOUBLE,DASINH,dasinh,DOUBLE)
-#define DASINH(A2) CCALLSFFUN1(DASINH,dasinh,DOUBLE,A2)
-
-PROTOCCALLSFFUN1(FLOAT,ATANI,atani,FLOAT)
-#define ATANI(A2) CCALLSFFUN1(ATANI,atani,FLOAT,A2)
-
-PROTOCCALLSFFUN1(DOUBLE,DATANI,datani,DOUBLE)
-#define DATANI(A2) CCALLSFFUN1(DATANI,datani,DOUBLE,A2)
-
-PROTOCCALLSFFUN2(FLOAT,ATG,atg,FLOAT,FLOAT)
-#define ATG(A2,A3) CCALLSFFUN2(ATG,atg,FLOAT,FLOAT,A2,A3)
-
-PROTOCCALLSFFUN1(FLOAT,BESI0,besi0,FLOAT)
-#define BESI0(A2) CCALLSFFUN1(BESI0,besi0,FLOAT,A2)
-
-PROTOCCALLSFFUN1(DOUBLE,DBESI0,dbesi0,DOUBLE)
-#define DBESI0(A2) CCALLSFFUN1(DBESI0,dbesi0,DOUBLE,A2)
-
-PROTOCCALLSFFUN1(FLOAT,BESJ0,besj0,FLOAT)
-#define BESJ0(A2) CCALLSFFUN1(BESJ0,besj0,FLOAT,A2)
-
-PROTOCCALLSFFUN1(DOUBLE,DBESJ0,dbesj0,DOUBLE)
-#define DBESJ0(A2) CCALLSFFUN1(DBESJ0,dbesj0,DOUBLE,A2)
-
-PROTOCCALLSFFUN2(FLOAT,BINOM,binom,FLOAT,INT)
-#define BINOM(A2,A3) CCALLSFFUN2(BINOM,binom,FLOAT,INT,A2,A3)
-
-PROTOCCALLSFFUN2(DOUBLE,DBINOM,dbinom,DOUBLE,INT)
-#define DBINOM(A2,A3) CCALLSFFUN2(DBINOM,dbinom,DOUBLE,INT,A2,A3)
-
-PROTOCCALLSFFUN2(FLOAT,BSIR3,bsir3,FLOAT,INT)
-#define BSIR3(A2,A3) CCALLSFFUN2(BSIR3,bsir3,FLOAT,INT,A2,A3)
-
-PROTOCCALLSFFUN2(DOUBLE,DBSIR3,dbsir3,DOUBLE,INT)
-#define DBSIR3(A2,A3) CCALLSFFUN2(DBSIR3,dbsir3,DOUBLE,INT,A2,A3)
-
-PROTOCCALLSFFUN2(FLOAT,BSIR4,bsir4,FLOAT,INT)
-#define BSIR4(A2,A3) CCALLSFFUN2(BSIR4,bsir4,FLOAT,INT,A2,A3)
-
-PROTOCCALLSFFUN2(DOUBLE,DBSIR4,dbsir4,DOUBLE,INT)
-#define DBSIR4(A2,A3) CCALLSFFUN2(DBSIR4,dbsir4,DOUBLE,INT,A2,A3)
-
-PROTOCCALLSFFUN5(FLOAT,CAUCHY,cauchy,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT)
-#define CAUCHY(A2,A3,A4,A5,A6) CCALLSFFUN5(CAUCHY,cauchy,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFFUN5(DOUBLE,DCAUCH,dcauch,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE)
-#define DCAUCH(A2,A3,A4,A5,A6) CCALLSFFUN5(DCAUCH,dcauch,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFFUN6(DOUBLE,CHEBQU,chebqu,DOUBLE,DOUBLE,DOUBLE,PDOUBLE,INT,DOUBLE)
-#define CHEBQU(A2,A3,A4,A5,A6,A7) CCALLSFFUN6(CHEBQU,chebqu,DOUBLE,DOUBLE,DOUBLE,PDOUBLE,INT,DOUBLE,A2,A3,A4,A5,A6,A7)
-
-PROTOCCALLSFFUN2(FLOAT,CHISIN,chisin,FLOAT,INT)
-#define CHISIN(A2,A3) CCALLSFFUN2(CHISIN,chisin,FLOAT,INT,A2,A3)
-
-PROTOCCALLSFFUN4(FLOAT,CHSUM,chsum,INT,FLOATV,INT,FLOAT)
-#define CHSUM(A2,A3,A4,A5) CCALLSFFUN4(CHSUM,chsum,INT,FLOATV,INT,FLOAT,A2,A3,A4,A5)
-
-PROTOCCALLSFFUN4(DOUBLE,DCHSUM,dchsum,INT,DOUBLEV,INT,DOUBLE)
-#define DCHSUM(A2,A3,A4,A5) CCALLSFFUN4(DCHSUM,dchsum,INT,DOUBLEV,INT,DOUBLE,A2,A3,A4,A5)
-
-PROTOCCALLSFFUN9(FLOAT,CLEBSG,clebsg,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT)
-#define CLEBSG(A2,A3,A4,A5,A6,A7,A8,A9,A10) CCALLSFFUN9(CLEBSG,clebsg,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,A2,A3,A4,A5,A6,A7,A8,A9,A10)
-
-PROTOCCALLSFFUN1(FLOAT,DAWSON,dawson,FLOAT)
-#define DAWSON(A2) CCALLSFFUN1(DAWSON,dawson,FLOAT,A2)
-
-PROTOCCALLSFFUN1(DOUBLE,DDAWSN,ddawsn,DOUBLE)
-#define DDAWSN(A2) CCALLSFFUN1(DDAWSN,ddawsn,DOUBLE,A2)
-
-PROTOCCALLSFFUN1(FLOAT,DENLAN,denlan,FLOAT)
-#define DENLAN(A2) CCALLSFFUN1(DENLAN,denlan,FLOAT,A2)
-
-PROTOCCALLSFFUN1(FLOAT,DIFLAN,diflan,FLOAT)
-#define DIFLAN(A2) CCALLSFFUN1(DIFLAN,diflan,FLOAT,A2)
-
-PROTOCCALLSFFUN1(FLOAT,DILOG,dilog,FLOAT)
-#define DILOG(A2) CCALLSFFUN1(DILOG,dilog,FLOAT,A2)
-
-PROTOCCALLSFFUN1(DOUBLE,DDILOG,ddilog,DOUBLE)
-#define DDILOG(A2) CCALLSFFUN1(DDILOG,ddilog,DOUBLE,A2)
-
-PROTOCCALLSFFUN1(FLOAT,DINVAV,dinvav,FLOAT)
-#define DINVAV(A2) CCALLSFFUN1(DINVAV,dinvav,FLOAT,A2)
-
-PROTOCCALLSFFUN1(FLOAT,DISLAN,dislan,FLOAT)
-#define DISLAN(A2) CCALLSFFUN1(DISLAN,dislan,FLOAT,A2)
-
-PROTOCCALLSFFUN2(FLOAT,DISVAV,disvav,FLOAT,INT)
-#define DISVAV(A2,A3) CCALLSFFUN2(DISVAV,disvav,FLOAT,INT,A2,A3)
-
-PROTOCCALLSFFUN4(FLOAT,DJMNB,djmnb,FLOAT,FLOAT,FLOAT,FLOAT)
-#define DJMNB(A2,A3,A4,A5) CCALLSFFUN4(DJMNB,djmnb,FLOAT,FLOAT,FLOAT,FLOAT,A2,A3,A4,A5)
-
-PROTOCCALLSFFUN4(DOUBLE,DDJMNB,ddjmnb,DOUBLE,DOUBLE,DOUBLE,DOUBLE)
-#define DDJMNB(A2,A3,A4,A5) CCALLSFFUN4(DDJMNB,ddjmnb,DOUBLE,DOUBLE,DOUBLE,DOUBLE,A2,A3,A4,A5)
-
-PROTOCCALLSFFUN7(DOUBLE,DSPNB1,dspnb1,INT,INT,INT,INT,DOUBLE,DOUBLEV,PINT)
-#define DSPNB1(A2,A3,A4,A5,A6,A7,A8) CCALLSFFUN7(DSPNB1,dspnb1,INT,INT,INT,INT,DOUBLE,DOUBLEV,PINT,A2,A3,A4,A5,A6,A7,A8)
-
-PROTOCCALLSFFUN13(DOUBLE,DSPNB2,dspnb2,INT,INT,INT,INT,INT,INT,INT,INT,DOUBLE,DOUBLE,DOUBLEV,DOUBLEV,PINT)
-#define DSPNB2(A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14) CCALLSFFUN13(DSPNB2,dspnb2,INT,INT,INT,INT,INT,INT,INT,INT,DOUBLE,DOUBLE,DOUBLEV,DOUBLEV,PINT,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14)
-
-PROTOCCALLSFFUN7(DOUBLE,DSPPS1,dspps1,INT,INT,INT,DOUBLE,DOUBLEV,DOUBLEV,PINT)
-#define DSPPS1(A2,A3,A4,A5,A6,A7,A8) CCALLSFFUN7(DSPPS1,dspps1,INT,INT,INT,DOUBLE,DOUBLEV,DOUBLEV,PINT,A2,A3,A4,A5,A6,A7,A8)
-
-PROTOCCALLSFFUN14(DOUBLE,DSPPS2,dspps2,INT,INT,INT,INT,INT,INT,DOUBLE,DOUBLE,DOUBLEV,DOUBLEV,PDOUBLE,INT,PDOUBLE,PINT)
-#define DSPPS2(A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15) CCALLSFFUN14(DSPPS2,dspps2,INT,INT,INT,INT,INT,INT,DOUBLE,DOUBLE,DOUBLEV,DOUBLEV,PDOUBLE,INT,PDOUBLE,PINT,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15)
-
-PROTOCCALLSFFUN3(DOUBLE,DVDOT,dvdot,INT,DOUBLEV,DOUBLEV)
-#define DVDOT(A2,A3,A4) CCALLSFFUN3(DVDOT,dvdot,INT,DOUBLEV,DOUBLEV,A2,A3,A4)
-
-PROTOCCALLSFFUN2(DOUBLE,E401BD,e401bd,DOUBLE,DOUBLE)
-#define E401BD(A2,A3) CCALLSFFUN2(E401BD,e401bd,DOUBLE,DOUBLE,A2,A3)
-
-PROTOCCALLSFFUN2(FLOAT,ELIN1,elin1,FLOAT,FLOAT)
-#define ELIN1(A2,A3) CCALLSFFUN2(ELIN1,elin1,FLOAT,FLOAT,A2,A3)
-
-PROTOCCALLSFFUN1(FLOAT,ERF,erf,FLOAT)
-#define ERF(A2) CCALLSFFUN1(ERF,erf,FLOAT,A2)
-
-PROTOCCALLSFFUN1(DOUBLE,DERF,derf,DOUBLE)
-#define DERF(A2) CCALLSFFUN1(DERF,derf,DOUBLE,A2)
-
-PROTOCCALLSFFUN7(INT,EXMBUC,exmbuc,INT,INT,FLOATV,FLOAT,INT,PINT,INT)
-#define EXMBUC(A2,A3,A4,A5,A6,A7,A8) CCALLSFFUN7(EXMBUC,exmbuc,INT,INT,FLOATV,FLOAT,INT,PINT,INT,A2,A3,A4,A5,A6,A7,A8)
-
-PROTOCCALLSFFUN3(FLOAT,FCONC,fconc,FLOAT,FLOAT,INT)
-#define FCONC(A2,A3,A4) CCALLSFFUN3(FCONC,fconc,FLOAT,FLOAT,INT,A2,A3,A4)
-
-PROTOCCALLSFFUN3(DOUBLE,DFCONC,dfconc,DOUBLE,DOUBLE,INT)
-#define DFCONC(A2,A3,A4) CCALLSFFUN3(DFCONC,dfconc,DOUBLE,DOUBLE,INT,A2,A3,A4)
-
-PROTOCCALLSFFUN2(FLOAT,FERDR,ferdr,FLOAT,INT)
-#define FERDR(A2,A3) CCALLSFFUN2(FERDR,ferdr,FLOAT,INT,A2,A3)
-
-PROTOCCALLSFFUN2(DOUBLE,DFERDR,dferdr,DOUBLE,INT)
-#define DFERDR(A2,A3) CCALLSFFUN2(DFERDR,dferdr,DOUBLE,INT,A2,A3)
-
-PROTOCCALLSFFUN2(FLOAT,FINARG,finarg,INT,INT)
-#define FINARG(A2,A3) CCALLSFFUN2(FINARG,finarg,INT,INT,A2,A3)
-
-PROTOCCALLSFFUN2(FLOAT,FREARG,frearg,FLOAT,FLOAT)
-#define FREARG(A2,A3) CCALLSFFUN2(FREARG,frearg,FLOAT,FLOAT,A2,A3)
-
-PROTOCCALLSFFUN3(FLOAT,FRED2,fred2,FLOAT,FLOAT,FLOAT)
-#define FRED2(A2,A3,A4) CCALLSFFUN3(FRED2,fred2,FLOAT,FLOAT,FLOAT,A2,A3,A4)
-
-PROTOCCALLSFFUN1(FLOAT,FRED3,fred3,FLOAT)
-#define FRED3(A2) CCALLSFFUN1(FRED3,fred3,FLOAT,A2)
-
-PROTOCCALLSFFUN1(FLOAT,FREQ,freq,FLOAT)
-#define FREQ(A2) CCALLSFFUN1(FREQ,freq,FLOAT,A2)
-
-PROTOCCALLSFFUN1(DOUBLE,DFREQ,dfreq,DOUBLE)
-#define DFREQ(A2) CCALLSFFUN1(DFREQ,dfreq,DOUBLE,A2)
-
-PROTOCCALLSFFUN1(FLOAT,FRSIN,frsin,FLOAT)
-#define FRSIN(A2) CCALLSFFUN1(FRSIN,frsin,FLOAT,A2)
-
-PROTOCCALLSFFUN1(DOUBLE,DFRSIN,dfrsin,DOUBLE)
-#define DFRSIN(A2) CCALLSFFUN1(DFRSIN,dfrsin,DOUBLE,A2)
-
-PROTOCCALLSFFUN2(FLOAT,FUN,fun,INT,FLOATV)
-#define FUN(A2,A3) CCALLSFFUN2(FUN,fun,INT,FLOATV,A2,A3)
-
-PROTOCCALLSFFUN1(FLOAT,G116F1,g116f1,FLOAT)
-#define G116F1(A2) CCALLSFFUN1(G116F1,g116f1,FLOAT,A2)
-
-PROTOCCALLSFFUN2(DOUBLE,DGAGNC,dgagnc,DOUBLE,DOUBLE)
-#define DGAGNC(A2,A3) CCALLSFFUN2(DGAGNC,dgagnc,DOUBLE,DOUBLE,A2,A3)
-
-PROTOCCALLSFFUN2(FLOAT,GAMDIS,gamdis,FLOAT,FLOAT)
-#define GAMDIS(A2,A3) CCALLSFFUN2(GAMDIS,gamdis,FLOAT,FLOAT,A2,A3)
-
-PROTOCCALLSFFUN1(FLOAT,GAMMA,gamma,FLOAT)
-#define GAMMA(A2) CCALLSFFUN1(GAMMA,gamma,FLOAT,A2)
-
-PROTOCCALLSFFUN1(FLOAT,QGAMMA,qgamma,FLOAT)
-#define QGAMMA(A2) CCALLSFFUN1(QGAMMA,qgamma,FLOAT,A2)
-
-PROTOCCALLSFFUN1(DOUBLE,DGAMMA,dgamma,DOUBLE)
-#define DGAMMA(A2) CCALLSFFUN1(DGAMMA,dgamma,DOUBLE,A2)
-
-PROTOCCALLSFFUN1(FLOAT,GAMMF,gammf,FLOAT)
-#define GAMMF(A2) CCALLSFFUN1(GAMMF,gammf,FLOAT,A2)
-
-PROTOCCALLSFFUN1(DOUBLE,DGAMMF,dgammf,DOUBLE)
-#define DGAMMF(A2) CCALLSFFUN1(DGAMMF,dgammf,DOUBLE,A2)
-
-PROTOCCALLSFFUN2(FLOAT,GAPNC,gapnc,FLOAT,FLOAT)
-#define GAPNC(A2,A3) CCALLSFFUN2(GAPNC,gapnc,FLOAT,FLOAT,A2,A3)
-
-PROTOCCALLSFFUN2(DOUBLE,DGAPNC,dgapnc,DOUBLE,DOUBLE)
-#define DGAPNC(A2,A3) CCALLSFFUN2(DGAPNC,dgapnc,DOUBLE,DOUBLE,A2,A3)
-
-PROTOCCALLSFFUN1(FLOAT,GAUSIN,gausin,FLOAT)
-#define GAUSIN(A2) CCALLSFFUN1(GAUSIN,gausin,FLOAT,A2)
-
-PROTOCCALLSFFUN1(DOUBLE,DGAUSN,dgausn,DOUBLE)
-#define DGAUSN(A2) CCALLSFFUN1(DGAUSN,dgausn,DOUBLE,A2)
-
-PROTOCCALLSFFUN4(FLOAT,GAUSS,gauss,ROUTINE,FLOAT,FLOAT,FLOAT)
-#define GAUSS(A2,A3,A4,A5) CCALLSFFUN4(GAUSS,gauss,ROUTINE,FLOAT,FLOAT,FLOAT,A2,A3,A4,A5)
-
-PROTOCCALLSFFUN4(FLOAT,QGAUSS,qgauss,ROUTINE,FLOAT,FLOAT,FLOAT)
-#define QGAUSS(A2,A3,A4,A5) CCALLSFFUN4(QGAUSS,qgauss,ROUTINE,FLOAT,FLOAT,FLOAT,A2,A3,A4,A5)
-
-PROTOCCALLSFFUN4(DOUBLE,DGAUSS,dgauss,ROUTINE,DOUBLE,DOUBLE,DOUBLE)
-#define DGAUSS(A2,A3,A4,A5) CCALLSFFUN4(DGAUSS,dgauss,ROUTINE,DOUBLE,DOUBLE,DOUBLE,A2,A3,A4,A5)
-
-PROTOCCALLSFFUN6(DOUBLE,GPINDP,gpindp,DOUBLE,DOUBLE,DOUBLE,PDOUBLE,DOUBLE,INT)
-#define GPINDP(A2,A3,A4,A5,A6,A7) CCALLSFFUN6(GPINDP,gpindp,DOUBLE,DOUBLE,DOUBLE,PDOUBLE,DOUBLE,INT,A2,A3,A4,A5,A6,A7)
-
-PROTOCCALLSFFUN2(INT,IGET,iget,INTV,INT)
-#define IGET(A2,A3) CCALLSFFUN2(IGET,iget,INTV,INT,A2,A3)
-
-PROTOCCALLSFFUN3(INT,IILZ,iilz,INT,INTV,INT)
-#define IILZ(A2,A3,A4) CCALLSFFUN3(IILZ,iilz,INT,INTV,INT,A2,A3,A4)
-
-PROTOCCALLSFFUN3(INT,ILSUM,ilsum,INT,LOGICALV,INT)
-#define ILSUM(A2,A3,A4) CCALLSFFUN3(ILSUM,ilsum,INT,LOGICALV,INT,A2,A3,A4)
-
-PROTOCCALLSFFUN10(FLOAT,QLINSQ,qlinsq,INT,INT,INT,FLOATV,PFLOAT,FLOATV,FLOATV,FLOATV,PDOUBLE,INT)
-#define QLINSQ(A2,A3,A4,A5,A6,A7,A8,A9,A10,A11) CCALLSFFUN10(QLINSQ,qlinsq,INT,INT,INT,FLOATV,PFLOAT,FLOATV,FLOATV,FLOATV,PDOUBLE,INT,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11)
-
-PROTOCCALLSFFUN3(INT,LKKSPL,lkkspl,DOUBLE,DOUBLEV,INT)
-#define LKKSPL(A2,A3,A4) CCALLSFFUN3(LKKSPL,lkkspl,DOUBLE,DOUBLEV,INT,A2,A3,A4)
-
-PROTOCCALLSFFUN4(INT,LOCHAR,lochar,INTV,INT,INTV,INT)
-#define LOCHAR(A2,A3,A4,A5) CCALLSFFUN4(LOCHAR,lochar,INTV,INT,INTV,INT,A2,A3,A4,A5)
-
-PROTOCCALLSFFUN2(INT,MAXFZE,maxfze,FLOATV,INT)
-#define MAXFZE(A2,A3) CCALLSFFUN2(MAXFZE,maxfze,FLOATV,INT,A2,A3)
-
-PROTOCCALLSFFUN2(INT,MAXIZE,maxize,INTV,INT)
-#define MAXIZE(A2,A3) CCALLSFFUN2(MAXIZE,maxize,INTV,INT,A2,A3)
-
-PROTOCCALLSFFUN2(INT,MINFZE,minfze,FLOATV,INT)
-#define MINFZE(A2,A3) CCALLSFFUN2(MINFZE,minfze,FLOATV,INT,A2,A3)
-
-PROTOCCALLSFFUN2(INT,MINIZE,minize,INTV,INT)
-#define MINIZE(A2,A3) CCALLSFFUN2(MINIZE,minize,INTV,INT,A2,A3)
-
-PROTOCCALLSFFUN2(INT,NDIGIT,ndigit,DOUBLE,DOUBLE)
-#define NDIGIT(A2,A3) CCALLSFFUN2(NDIGIT,ndigit,DOUBLE,DOUBLE,A2,A3)
-
-PROTOCCALLSFFUN1(INT,NEAR1,near1,FLOAT)
-#define NEAR1(A2) CCALLSFFUN1(NEAR1,near1,FLOAT,A2)
-
-PROTOCCALLSFFUN1(INT,NIC311,nic311,FLOAT)
-#define NIC311(A2) CCALLSFFUN1(NIC311,nic311,FLOAT,A2)
-
-PROTOCCALLSFFUN1(INT,NORRAN,norran,PFLOAT)
-#define NORRAN(A2) CCALLSFFUN1(NORRAN,norran,PFLOAT,A2)
-
-PROTOCCALLSFFUN2(FLOAT,PROB,prob,FLOAT,INT)
-#define PROB(A2,A3) CCALLSFFUN2(PROB,prob,FLOAT,INT,A2,A3)
-
-PROTOCCALLSFFUN1(FLOAT,PROBKL,probkl,FLOAT)
-#define PROBKL(A2) CCALLSFFUN1(PROBKL,probkl,FLOAT,A2)
-
-PROTOCCALLSFFUN4(FLOAT,PROD1,prod1,FLOATV,FLOATV,INT,INT)
-#define PROD1(A2,A3,A4,A5) CCALLSFFUN4(PROD1,prod1,FLOATV,FLOATV,INT,INT,A2,A3,A4,A5)
-
-PROTOCCALLSFFUN7(FLOAT,PROD2,prod2,PFLOAT,FLOATV,INT,INT,INT,INT,FLOAT)
-#define PROD2(A2,A3,A4,A5,A6,A7,A8) CCALLSFFUN7(PROD2,prod2,PFLOAT,FLOATV,INT,INT,INT,INT,FLOAT,A2,A3,A4,A5,A6,A7,A8)
-
-PROTOCCALLSFFUN5(FLOAT,QUAD,quad,INT,INT,FLOATV,FLOATV,FLOAT)
-#define QUAD(A2,A3,A4,A5,A6) CCALLSFFUN5(QUAD,quad,INT,INT,FLOATV,FLOATV,FLOAT,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFFUN13(DOUBLE,C309R4,c309r4,DOUBLE,DOUBLE,DOUBLE,DOUBLE,PDOUBLE,PDOUBLE,LOGICAL,INT,PDOUBLE,PINT,DOUBLE,DOUBLE,LOGICAL)
-#define C309R4(A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14) CCALLSFFUN13(C309R4,c309r4,DOUBLE,DOUBLE,DOUBLE,DOUBLE,PDOUBLE,PDOUBLE,LOGICAL,INT,PDOUBLE,PINT,DOUBLE,DOUBLE,LOGICAL,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14)
-
-PROTOCCALLSFFUN1(FLOAT,RANGAM,rangam,FLOAT)
-#define RANGAM(A2) CCALLSFFUN1(RANGAM,rangam,FLOAT,A2)
-
-PROTOCCALLSFFUN1(FLOAT,RANLAN,ranlan,FLOAT)
-#define RANLAN(A2) CCALLSFFUN1(RANLAN,ranlan,FLOAT,A2)
-
-PROTOCCALLSFFUN2(FLOAT,RELI1,reli1,FLOAT,FLOAT)
-#define RELI1(A2,A3) CCALLSFFUN2(RELI1,reli1,FLOAT,FLOAT,A2,A3)
-
-PROTOCCALLSFFUN2(DOUBLE,DELI1,deli1,DOUBLE,DOUBLE)
-#define DELI1(A2,A3) CCALLSFFUN2(DELI1,deli1,DOUBLE,DOUBLE,A2,A3)
-
-PROTOCCALLSFFUN1(FLOAT,RELI1C,reli1c,FLOAT)
-#define RELI1C(A2) CCALLSFFUN1(RELI1C,reli1c,FLOAT,A2)
-
-PROTOCCALLSFFUN1(DOUBLE,DELI1C,deli1c,DOUBLE)
-#define DELI1C(A2) CCALLSFFUN1(DELI1C,deli1c,DOUBLE,A2)
-
-PROTOCCALLSFFUN5(DOUBLE,DELI2,deli2,DOUBLE,DOUBLE,DOUBLE,DOUBLE,INT)
-#define DELI2(A2,A3,A4,A5,A6) CCALLSFFUN5(DELI2,deli2,DOUBLE,DOUBLE,DOUBLE,DOUBLE,INT,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFFUN3(DOUBLE,DELI3,deli3,DOUBLE,DOUBLE,DOUBLE)
-#define DELI3(A2,A3,A4) CCALLSFFUN3(DELI3,deli3,DOUBLE,DOUBLE,DOUBLE,A2,A3,A4)
-
-PROTOCCALLSFFUN4(DOUBLE,DELIGC,deligc,DOUBLE,DOUBLE,DOUBLE,DOUBLE)
-#define DELIGC(A2,A3,A4,A5) CCALLSFFUN4(DELIGC,deligc,DOUBLE,DOUBLE,DOUBLE,DOUBLE,A2,A3,A4,A5)
-
-PROTOCCALLSFFUN1(DOUBLE,DELIKC,delikc,DOUBLE)
-#define DELIKC(A2) CCALLSFFUN1(DELIKC,delikc,DOUBLE,A2)
-
-PROTOCCALLSFFUN1(FLOAT,REXPIN,rexpin,FLOAT)
-#define REXPIN(A2) CCALLSFFUN1(REXPIN,rexpin,FLOAT,A2)
-
-PROTOCCALLSFFUN1(DOUBLE,DEXPIN,dexpin,DOUBLE)
-#define DEXPIN(A2) CCALLSFFUN1(DEXPIN,dexpin,DOUBLE,A2)
-
-PROTOCCALLSFFUN6(DOUBLE,DFRDH2,dfrdh2,DOUBLE,DOUBLE,DOUBLE,PDOUBLE,INT,INT)
-#define DFRDH2(A2,A3,A4,A5,A6,A7) CCALLSFFUN6(DFRDH2,dfrdh2,DOUBLE,DOUBLE,DOUBLE,PDOUBLE,INT,INT,A2,A3,A4,A5,A6,A7)
-
-PROTOCCALLSFFUN1(FLOAT,RG32,rg32,INT)
-#define RG32(A2) CCALLSFFUN1(RG32,rg32,INT,A2)
-
-PROTOCCALLSFFUN6(FLOAT,RGMLT1,rgmlt1,FLOAT,FLOAT,FLOAT,INT,INT,FLOAT)
-#define RGMLT1(A2,A3,A4,A5,A6,A7) CCALLSFFUN6(RGMLT1,rgmlt1,FLOAT,FLOAT,FLOAT,INT,INT,FLOAT,A2,A3,A4,A5,A6,A7)
-
-PROTOCCALLSFFUN6(DOUBLE,DGMLT1,dgmlt1,DOUBLE,DOUBLE,DOUBLE,INT,INT,DOUBLEV)
-#define DGMLT1(A2,A3,A4,A5,A6,A7) CCALLSFFUN6(DGMLT1,dgmlt1,DOUBLE,DOUBLE,DOUBLE,INT,INT,DOUBLEV,A2,A3,A4,A5,A6,A7)
-
-PROTOCCALLSFFUN6(DOUBLE,DGMLT2,dgmlt2,DOUBLE,DOUBLE,DOUBLE,INT,INT,DOUBLEV)
-#define DGMLT2(A2,A3,A4,A5,A6,A7) CCALLSFFUN6(DGMLT2,dgmlt2,DOUBLE,DOUBLE,DOUBLE,INT,INT,DOUBLEV,A2,A3,A4,A5,A6,A7)
-
-PROTOCCALLSFFUN6(DOUBLE,DGMLT3,dgmlt3,DOUBLE,DOUBLE,DOUBLE,INT,INT,DOUBLEV)
-#define DGMLT3(A2,A3,A4,A5,A6,A7) CCALLSFFUN6(DGMLT3,dgmlt3,DOUBLE,DOUBLE,DOUBLE,INT,INT,DOUBLEV,A2,A3,A4,A5,A6,A7)
-
-PROTOCCALLSFFUN6(DOUBLE,DGMLT4,dgmlt4,DOUBLE,DOUBLE,DOUBLE,INT,INT,DOUBLEV)
-#define DGMLT4(A2,A3,A4,A5,A6,A7) CCALLSFFUN6(DGMLT4,dgmlt4,DOUBLE,DOUBLE,DOUBLE,INT,INT,DOUBLEV,A2,A3,A4,A5,A6,A7)
-
-PROTOCCALLSFFUN6(DOUBLE,DGMLT5,dgmlt5,DOUBLE,DOUBLE,DOUBLE,INT,INT,DOUBLEV)
-#define DGMLT5(A2,A3,A4,A5,A6,A7) CCALLSFFUN6(DGMLT5,dgmlt5,DOUBLE,DOUBLE,DOUBLE,INT,INT,DOUBLEV,A2,A3,A4,A5,A6,A7)
-
-PROTOCCALLSFFUN6(DOUBLE,DGMLT6,dgmlt6,DOUBLE,DOUBLE,DOUBLE,INT,INT,DOUBLEV)
-#define DGMLT6(A2,A3,A4,A5,A6,A7) CCALLSFFUN6(DGMLT6,dgmlt6,DOUBLE,DOUBLE,DOUBLE,INT,INT,DOUBLEV,A2,A3,A4,A5,A6,A7)
-
-PROTOCCALLSFFUN4(DOUBLE,DGQUAD,dgquad,DOUBLE,DOUBLE,DOUBLE,INT)
-#define DGQUAD(A2,A3,A4,A5) CCALLSFFUN4(DGQUAD,dgquad,DOUBLE,DOUBLE,DOUBLE,INT,A2,A3,A4,A5)
-
-PROTOCCALLSFFUN1(FLOAT,RN32,rn32,INT)
-#define RN32(A2) CCALLSFFUN1(RN32,rn32,INT,A2)
-
-PROTOCCALLSFFUN1(FLOAT,RNDM2,rndm2,FLOAT)
-#define RNDM2(A2) CCALLSFFUN1(RNDM2,rndm2,FLOAT,A2)
-
-PROTOCCALLSFFUN1(FLOAT,RNORTH,rnorth,INT)
-#define RNORTH(A2) CCALLSFFUN1(RNORTH,rnorth,INT,A2)
-
-PROTOCCALLSFFUN2(FLOAT,RPSIPG,rpsipg,FLOAT,INT)
-#define RPSIPG(A2,A3) CCALLSFFUN2(RPSIPG,rpsipg,FLOAT,INT,A2,A3)
-
-PROTOCCALLSFFUN2(DOUBLE,DPSIPG,dpsipg,DOUBLE,INT)
-#define DPSIPG(A2,A3) CCALLSFFUN2(DPSIPG,dpsipg,DOUBLE,INT,A2,A3)
-
-PROTOCCALLSFFUN1(FLOAT,RRIZET,rrizet,FLOAT)
-#define RRIZET(A2) CCALLSFFUN1(RRIZET,rrizet,FLOAT,A2)
-
-PROTOCCALLSFFUN1(DOUBLE,DRIZET,drizet,DOUBLE)
-#define DRIZET(A2) CCALLSFFUN1(DRIZET,drizet,DOUBLE,A2)
-
-PROTOCCALLSFFUN3(FLOAT,RTHETA,rtheta,INT,FLOAT,FLOAT)
-#define RTHETA(A2,A3,A4) CCALLSFFUN3(RTHETA,rtheta,INT,FLOAT,FLOAT,A2,A3,A4)
-
-PROTOCCALLSFFUN3(DOUBLE,DTHETA,dtheta,INT,DOUBLE,DOUBLE)
-#define DTHETA(A2,A3,A4) CCALLSFFUN3(DTHETA,dtheta,INT,DOUBLE,DOUBLE,A2,A3,A4)
-
-PROTOCCALLSFFUN3(FLOAT,RVNSPC,rvnspc,FLOAT,FLOAT,FLOAT)
-#define RVNSPC(A2,A3,A4) CCALLSFFUN3(RVNSPC,rvnspc,FLOAT,FLOAT,FLOAT,A2,A3,A4)
-
-PROTOCCALLSFFUN3(DOUBLE,DVNSPC,dvnspc,DOUBLE,DOUBLE,DOUBLE)
-#define DVNSPC(A2,A3,A4) CCALLSFFUN3(DVNSPC,dvnspc,DOUBLE,DOUBLE,DOUBLE,A2,A3,A4)
-
-PROTOCCALLSFFUN4(FLOAT,SIMPS,simps,FLOATV,FLOAT,FLOAT,INT)
-#define SIMPS(A2,A3,A4,A5) CCALLSFFUN4(SIMPS,simps,FLOATV,FLOAT,FLOAT,INT,A2,A3,A4,A5)
-
-PROTOCCALLSFFUN4(DOUBLE,DSIMPS,dsimps,DOUBLEV,DOUBLE,DOUBLE,INT)
-#define DSIMPS(A2,A3,A4,A5) CCALLSFFUN4(DSIMPS,dsimps,DOUBLEV,DOUBLE,DOUBLE,INT,A2,A3,A4,A5)
-
-PROTOCCALLSFFUN1(FLOAT,SININT,sinint,FLOAT)
-#define SININT(A2) CCALLSFFUN1(SININT,sinint,FLOAT,A2)
-
-PROTOCCALLSFFUN1(DOUBLE,DSININ,dsinin,DOUBLE)
-#define DSININ(A2) CCALLSFFUN1(DSININ,dsinin,DOUBLE,A2)
-
-PROTOCCALLSFFUN2(FLOAT,STRAG,strag,FLOAT,FLOAT)
-#define STRAG(A2,A3) CCALLSFFUN2(STRAG,strag,FLOAT,FLOAT,A2,A3)
-
-PROTOCCALLSFFUN1(FLOAT,STRH0,strh0,FLOAT)
-#define STRH0(A2) CCALLSFFUN1(STRH0,strh0,FLOAT,A2)
-
-PROTOCCALLSFFUN1(DOUBLE,DSTRH0,dstrh0,DOUBLE)
-#define DSTRH0(A2) CCALLSFFUN1(DSTRH0,dstrh0,DOUBLE,A2)
-
-PROTOCCALLSFFUN2(FLOAT,STUDIN,studin,FLOAT,INT)
-#define STUDIN(A2,A3) CCALLSFFUN2(STUDIN,studin,FLOAT,INT,A2,A3)
-
-PROTOCCALLSFFUN2(FLOAT,STUDIS,studis,FLOAT,INT)
-#define STUDIS(A2,A3) CCALLSFFUN2(STUDIS,studis,FLOAT,INT,A2,A3)
-
-PROTOCCALLSFFUN2(FLOAT,THETA1,theta1,FLOAT,FLOAT)
-#define THETA1(A2,A3) CCALLSFFUN2(THETA1,theta1,FLOAT,FLOAT,A2,A3)
-
-PROTOCCALLSFFUN10(FLOAT,TRIINT,triint,FLOAT,INT,INT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT)
-#define TRIINT(A2,A3,A4,A5,A6,A7,A8,A9,A10,A11) CCALLSFFUN10(TRIINT,triint,FLOAT,INT,INT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11)
-
-PROTOCCALLSFFUN10(DOUBLE,DTRINT,dtrint,DOUBLE,INT,INT,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE)
-#define DTRINT(A2,A3,A4,A5,A6,A7,A8,A9,A10,A11) CCALLSFFUN10(DTRINT,dtrint,DOUBLE,INT,INT,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11)
-
-PROTOCCALLSFFUN6(FLOAT,TRISUM,trisum,FLOAT,FLOATV,INT,FLOATV,INT,INT)
-#define TRISUM(A2,A3,A4,A5,A6,A7) CCALLSFFUN6(TRISUM,trisum,FLOAT,FLOATV,INT,FLOATV,INT,INT,A2,A3,A4,A5,A6,A7)
-
-PROTOCCALLSFFUN1(LOGICAL,USRTRM,usrtrm,INT)
-#define USRTRM(A2) CCALLSFFUN1(USRTRM,usrtrm,INT,A2)
-
-PROTOCCALLSFFUN1(FLOAT,VAVDEN,vavden,FLOAT)
-#define VAVDEN(A2) CCALLSFFUN1(VAVDEN,vavden,FLOAT,A2)
-
-PROTOCCALLSFFUN3(FLOAT,VAVFCN,vavfcn,FLOAT,FLOAT,FLOAT)
-#define VAVFCN(A2,A3,A4) CCALLSFFUN3(VAVFCN,vavfcn,FLOAT,FLOAT,FLOAT,A2,A3,A4)
-
-PROTOCCALLSFFUN3(FLOAT,VAVRAN,vavran,FLOAT,FLOAT,FLOAT)
-#define VAVRAN(A2,A3,A4) CCALLSFFUN3(VAVRAN,vavran,FLOAT,FLOAT,FLOAT,A2,A3,A4)
-
-PROTOCCALLSFFUN1(INT,VOMAS,vomas,INT)
-#define VOMAS(A2) CCALLSFFUN1(VOMAS,vomas,INT,A2)
-
-PROTOCCALLSFFUN1(FLOAT,VVIDEN,vviden,FLOAT)
-#define VVIDEN(A2) CCALLSFFUN1(VVIDEN,vviden,FLOAT,A2)
-
-PROTOCCALLSFFUN1(FLOAT,XM1LAN,xm1lan,FLOAT)
-#define XM1LAN(A2) CCALLSFFUN1(XM1LAN,xm1lan,FLOAT,A2)
-
-PROTOCCALLSFFUN1(FLOAT,XM2LAN,xm2lan,FLOAT)
-#define XM2LAN(A2) CCALLSFFUN1(XM2LAN,xm2lan,FLOAT,A2)
-
-PROTOCCALLSFFUN6(DOUBLE,DZEROX,dzerox,DOUBLE,DOUBLE,DOUBLE,INT,DOUBLE,INT)
-#define DZEROX(A2,A3,A4,A5,A6,A7) CCALLSFFUN6(DZEROX,dzerox,DOUBLE,DOUBLE,DOUBLE,INT,DOUBLE,INT,A2,A3,A4,A5,A6,A7)
-
-PROTOCCALLSFSUB12(ADDBND,addbnd,INT,PINT,INTV,PINT,PINT,INT,INT,INT,PDOUBLE,DOUBLEV,PDOUBLE,PDOUBLE)
-#define ADDBND(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12) CCALLSFSUB12(ADDBND,addbnd,INT,PINT,INTV,PINT,PINT,INT,INT,INT,PDOUBLE,DOUBLEV,PDOUBLE,PDOUBLE,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12)
-
-PROTOCCALLSFSUB1(ARITHM,arithm,PFLOAT)
-#define ARITHM(A1) CCALLSFSUB1(ARITHM,arithm,PFLOAT,A1)
-
-PROTOCCALLSFSUB5(ASLGF,aslgf,INT,FLOAT,INT,INT,PFLOAT)
-#define ASLGF(A1,A2,A3,A4,A5) CCALLSFSUB5(ASLGF,aslgf,INT,FLOAT,INT,INT,PFLOAT,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB5(DASLGF,daslgf,INT,DOUBLE,INT,INT,PDOUBLE)
-#define DASLGF(A1,A2,A3,A4,A5) CCALLSFSUB5(DASLGF,daslgf,INT,DOUBLE,INT,INT,PDOUBLE,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB7(ASSIGN,assign,PFLOAT,INT,INT,INT,PINT,PFLOAT,INT)
-#define ASSIGN(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(ASSIGN,assign,PFLOAT,INT,INT,INT,PINT,PFLOAT,INT,A1,A2,A3,A4,A5,A6,A7)
-
-PROTOCCALLSFSUB7(BAKVEC,bakvec,INT,INT,PFLOAT,PFLOAT,INT,PFLOAT,PINT)
-#define BAKVEC(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(BAKVEC,bakvec,INT,INT,PFLOAT,PFLOAT,INT,PFLOAT,PINT,A1,A2,A3,A4,A5,A6,A7)
-
-PROTOCCALLSFSUB6(BALANC,balanc,INT,INT,PFLOAT,PINT,PINT,PFLOAT)
-#define BALANC(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(BALANC,balanc,INT,INT,PFLOAT,PINT,PINT,PFLOAT,A1,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFSUB7(BALBAK,balbak,INT,INT,INT,INT,FLOATV,INT,PFLOAT)
-#define BALBAK(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(BALBAK,balbak,INT,INT,INT,INT,FLOATV,INT,PFLOAT,A1,A2,A3,A4,A5,A6,A7)
-
-PROTOCCALLSFSUB9(BFGS,bfgs,INT,INT,PDOUBLE,DOUBLE,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLE,PDOUBLE)
-#define BFGS(A1,A2,A3,A4,A5,A6,A7,A8,A9) CCALLSFSUB9(BFGS,bfgs,INT,INT,PDOUBLE,DOUBLE,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLE,PDOUBLE,A1,A2,A3,A4,A5,A6,A7,A8,A9)
-
-PROTOCCALLSFSUB4(BINOMI,binomi,INT,FLOAT,PINT,PINT)
-#define BINOMI(A1,A2,A3,A4) CCALLSFSUB4(BINOMI,binomi,INT,FLOAT,PINT,PINT,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB14(BISECT,bisect,INT,FLOAT,FLOATV,FLOATV,PFLOAT,PFLOAT,PFLOAT,INT,PINT,PFLOAT,PINT,PINT,PFLOAT,PFLOAT)
-#define BISECT(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14) CCALLSFSUB14(BISECT,bisect,INT,FLOAT,FLOATV,FLOATV,PFLOAT,PFLOAT,PFLOAT,INT,PINT,PFLOAT,PINT,PINT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14)
-
-PROTOCCALLSFSUB27(BNDOPT,bndopt,INT,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,PDOUBLE,PDOUBLE,DOUBLE,DOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,DOUBLEV,PDOUBLE,PDOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,INT,PINT,PINT,PINT,INT,INT)
-#define BNDOPT(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15,A16,A17,A18,A19,A20,A21,A22,A23,A24,A25,A26,A27) CCALLSFSUB27(BNDOPT,bndopt,INT,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,PDOUBLE,PDOUBLE,DOUBLE,DOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,DOUBLEV,PDOUBLE,PDOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,INT,PINT,PINT,PINT,INT,INT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15,A16,A17,A18,A19,A20,A21,A22,A23,A24,A25,A26,A27)
-
-PROTOCCALLSFSUB10(BNDTST,bndtst,INT,PDOUBLE,DOUBLEV,DOUBLEV,DOUBLE,PINT,PINT,PINT,PINT,PLOGICAL)
-#define BNDTST(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10) CCALLSFSUB10(BNDTST,bndtst,INT,PDOUBLE,DOUBLEV,DOUBLEV,DOUBLE,PINT,PINT,PINT,PINT,PLOGICAL,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10)
-
-PROTOCCALLSFSUB6(BOUNDS,bounds,INT,PINT,PINT,FLOATV,PFLOAT,PFLOAT)
-#define BOUNDS(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(BOUNDS,bounds,INT,PINT,PINT,FLOATV,PFLOAT,PFLOAT,A1,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFSUB5(BSJA,bsja,FLOAT,FLOAT,INT,INT,FLOATV)
-#define BSJA(A1,A2,A3,A4,A5) CCALLSFSUB5(BSJA,bsja,FLOAT,FLOAT,INT,INT,FLOATV,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB5(QBSJA,qbsja,FLOAT,FLOAT,INT,INT,FLOATV)
-#define QBSJA(A1,A2,A3,A4,A5) CCALLSFSUB5(QBSJA,qbsja,FLOAT,FLOAT,INT,INT,FLOATV,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB5(DBSJA,dbsja,DOUBLE,DOUBLE,INT,INT,DOUBLEV)
-#define DBSJA(A1,A2,A3,A4,A5) CCALLSFSUB5(DBSJA,dbsja,DOUBLE,DOUBLE,INT,INT,DOUBLEV,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB7(BUCMVE,bucmve,INT,INT,INT,PFLOAT,PFLOAT,INT,INT)
-#define BUCMVE(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(BUCMVE,bucmve,INT,INT,INT,PFLOAT,PFLOAT,INT,INT,A1,A2,A3,A4,A5,A6,A7)
-
-PROTOCCALLSFSUB15(BUFOPT,bufopt,INT,PFLOAT,PFLOAT,FLOATV,FLOATV,PFLOAT,PFLOAT,FLOAT,FLOAT,PDOUBLE,INT,INTV,INT,INT,INT)
-#define BUFOPT(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15) CCALLSFSUB15(BUFOPT,bufopt,INT,PFLOAT,PFLOAT,FLOATV,FLOATV,PFLOAT,PFLOAT,FLOAT,FLOAT,PDOUBLE,INT,INTV,INT,INT,INT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15)
-
-PROTOCCALLSFSUB5(BZEJY,bzejy,FLOAT,INT,INT,FLOAT,PFLOAT)
-#define BZEJY(A1,A2,A3,A4,A5) CCALLSFSUB5(BZEJY,bzejy,FLOAT,INT,INT,FLOAT,PFLOAT,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB5(DBZEJY,dbzejy,DOUBLE,INT,INT,DOUBLE,PDOUBLE)
-#define DBZEJY(A1,A2,A3,A4,A5) CCALLSFSUB5(DBZEJY,dbzejy,DOUBLE,INT,INT,DOUBLE,PDOUBLE,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB2(C128,c128,FLOATV,PFLOAT)
-#define C128(A1,A2) CCALLSFSUB2(C128,c128,FLOATV,PFLOAT,A1,A2)
-
-PROTOCCALLSFSUB2(C256,c256,FLOATV,PFLOAT)
-#define C256(A1,A2) CCALLSFSUB2(C256,c256,FLOATV,PFLOAT,A1,A2)
-
-PROTOCCALLSFSUB0(C311BD,c311bd)
-#define C311BD() CCALLSFSUB0(C311BD,c311bd)
-
-PROTOCCALLSFSUB2(C512,c512,FLOATV,PFLOAT)
-#define C512(A1,A2) CCALLSFSUB2(C512,c512,FLOATV,PFLOAT,A1,A2)
-
-PROTOCCALLSFSUB2(C64,c64,FLOATV,PFLOAT)
-#define C64(A1,A2) CCALLSFSUB2(C64,c64,FLOATV,PFLOAT,A1,A2)
-
-PROTOCCALLSFSUB8(CBABK2,cbabk2,INT,INT,INT,INT,FLOATV,INT,PFLOAT,PFLOAT)
-#define CBABK2(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(CBABK2,cbabk2,INT,INT,INT,INT,FLOATV,INT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5,A6,A7,A8)
-
-PROTOCCALLSFSUB7(CBAL,cbal,INT,INT,PFLOAT,PFLOAT,PINT,PINT,PFLOAT)
-#define CBAL(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(CBAL,cbal,INT,INT,PFLOAT,PFLOAT,PINT,PINT,PFLOAT,A1,A2,A3,A4,A5,A6,A7)
-
-PROTOCCALLSFSUB6(CFT,cft,PFLOAT,PFLOAT,INT,INT,INT,PINT)
-#define CFT(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(CFT,cft,PFLOAT,PFLOAT,INT,INT,INT,PINT,A1,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFSUB13(CHEB,cheb,INT,INT,INT,INT,PFLOAT,PFLOAT,FLOAT,PFLOAT,PFLOAT,PINT,PFLOAT,PINT,PINT)
-#define CHEB(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13) CCALLSFSUB13(CHEB,cheb,INT,INT,INT,INT,PFLOAT,PFLOAT,FLOAT,PFLOAT,PFLOAT,PINT,PFLOAT,PINT,PINT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13)
-
-PROTOCCALLSFSUB3(CHEB02,cheb02,PDOUBLE,INT,INT)
-#define CHEB02(A1,A2,A3) CCALLSFSUB3(CHEB02,cheb02,PDOUBLE,INT,INT,A1,A2,A3)
-
-PROTOCCALLSFSUB7(CHECF,checf,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,INT,FLOAT)
-#define CHECF(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(CHECF,checf,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,INT,FLOAT,A1,A2,A3,A4,A5,A6,A7)
-
-PROTOCCALLSFSUB7(QCHECF,qchecf,FLOAT,FLOAT,FLOAT,FLOAT,PFLOAT,PINT,PFLOAT)
-#define QCHECF(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(QCHECF,qchecf,FLOAT,FLOAT,FLOAT,FLOAT,PFLOAT,PINT,PFLOAT,A1,A2,A3,A4,A5,A6,A7)
-
-PROTOCCALLSFSUB7(DCHECF,dchecf,DOUBLE,DOUBLE,DOUBLE,DOUBLE,PDOUBLE,PINT,PDOUBLE)
-#define DCHECF(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(DCHECF,dchecf,DOUBLE,DOUBLE,DOUBLE,DOUBLE,PDOUBLE,PINT,PDOUBLE,A1,A2,A3,A4,A5,A6,A7)
-
-PROTOCCALLSFSUB5(CHMOVE,chmove,STRING,INT,PSTRING,INT,INT)
-#define CHMOVE(A1,A2,A3,A4,A5) CCALLSFSUB5(CHMOVE,chmove,STRING,INT,PSTRING,INT,INT,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB16(CINVIT,cinvit,INT,INT,PFLOAT,PFLOAT,PFLOAT,FLOATV,LOGICALV,INT,PINT,PFLOAT,PFLOAT,PINT,PFLOAT,PFLOAT,PFLOAT,PFLOAT)
-#define CINVIT(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15,A16) CCALLSFSUB16(CINVIT,cinvit,INT,INT,PFLOAT,PFLOAT,PFLOAT,FLOATV,LOGICALV,INT,PINT,PFLOAT,PFLOAT,PINT,PFLOAT,PFLOAT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15,A16)
-
-PROTOCCALLSFSUB8(CLEBS,clebs,INT,INT,INT,INT,INT,INT,PINT,PINT)
-#define CLEBS(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(CLEBS,clebs,INT,INT,INT,INT,INT,INT,PINT,PINT,A1,A2,A3,A4,A5,A6,A7,A8)
-
-PROTOCCALLSFSUB3(COEDIN,coedin,FLOAT,FLOAT,INT)
-#define COEDIN(A1,A2,A3) CCALLSFSUB3(COEDIN,coedin,FLOAT,FLOAT,INT,A1,A2,A3)
-
-PROTOCCALLSFSUB4(COEDIS,coedis,FLOAT,FLOAT,INT,INT)
-#define COEDIS(A1,A2,A3,A4) CCALLSFSUB4(COEDIS,coedis,FLOAT,FLOAT,INT,INT,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB9(COMBAK,combak,INT,INT,INT,PFLOAT,PFLOAT,INTV,INT,PFLOAT,PFLOAT)
-#define COMBAK(A1,A2,A3,A4,A5,A6,A7,A8,A9) CCALLSFSUB9(COMBAK,combak,INT,INT,INT,PFLOAT,PFLOAT,INTV,INT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5,A6,A7,A8,A9)
-
-PROTOCCALLSFSUB7(COMHES,comhes,INT,INT,INT,INT,PFLOAT,PFLOAT,PINT)
-#define COMHES(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(COMHES,comhes,INT,INT,INT,INT,PFLOAT,PFLOAT,PINT,A1,A2,A3,A4,A5,A6,A7)
-
-PROTOCCALLSFSUB9(COMLR,comlr,INT,INT,INT,INT,PFLOAT,PFLOAT,PFLOAT,PFLOAT,PINT)
-#define COMLR(A1,A2,A3,A4,A5,A6,A7,A8,A9) CCALLSFSUB9(COMLR,comlr,INT,INT,INT,INT,PFLOAT,PFLOAT,PFLOAT,PFLOAT,PINT,A1,A2,A3,A4,A5,A6,A7,A8,A9)
-
-PROTOCCALLSFSUB12(COMLR2,comlr2,INT,INT,INT,INT,INTV,PFLOAT,PFLOAT,PFLOAT,PFLOAT,PFLOAT,PFLOAT,PINT)
-#define COMLR2(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12) CCALLSFSUB12(COMLR2,comlr2,INT,INT,INT,INT,INTV,PFLOAT,PFLOAT,PFLOAT,PFLOAT,PFLOAT,PFLOAT,PINT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12)
-
-PROTOCCALLSFSUB8(CONPRT,conprt,PFLOAT,INT,INT,INT,INT,INT,FLOAT,FLOAT)
-#define CONPRT(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(CONPRT,conprt,PFLOAT,INT,INT,INT,INT,INT,FLOAT,FLOAT,A1,A2,A3,A4,A5,A6,A7,A8)
-
-PROTOCCALLSFSUB3(CONT,cont,FLOAT,INT,FLOATV)
-#define CONT(A1,A2,A3) CCALLSFSUB3(CONT,cont,FLOAT,INT,FLOATV,A1,A2,A3)
-
-PROTOCCALLSFSUB5(CPOLYZ,cpolyz,FLOAT,INT,INT,FLOAT,FLOAT)
-#define CPOLYZ(A1,A2,A3,A4,A5) CCALLSFSUB5(CPOLYZ,cpolyz,FLOAT,INT,INT,FLOAT,FLOAT,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB7(D107S1,d107s1,INT,DOUBLE,DOUBLE,DOUBLE,INT,PDOUBLE,PDOUBLE)
-#define D107S1(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(D107S1,d107s1,INT,DOUBLE,DOUBLE,DOUBLE,INT,PDOUBLE,PDOUBLE,A1,A2,A3,A4,A5,A6,A7)
-
-PROTOCCALLSFSUB1(D115BD,d115bd,PINT)
-#define D115BD(A1) CCALLSFSUB1(D115BD,d115bd,PINT,A1)
-
-/*
-PROTOCCALLSFSUB38(D501L1,d501l1,BYTE,DOUBLE,INT,INT,DOUBLEV,INT,DOUBLEV,DOUBLEV,INT,DOUBLE,INT,INT,INT,DOUBLEV,DOUBLEV,DOUBLEV,PDOUBLE,DOUBLEV,INTV,INT,PDOUBLE,INT,PDOUBLE,PDOUBLE,*ERROR*V,DOUBLEV,PDOUBLE,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,PDOUBLE,PDOUBLE,PDOUBLE,DOUBLEV,PDOUBLE,INTV,PINT)
-#define D501L1(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15,A16,A17,A18,A19,A20,A21,A22,A23,A24,A25,A26,A27,A28,A29,A30,A31,A32,A33,A34,A35,A36,A37,A38) CCALLSFSUB38(D501L1,d501l1,BYTE,DOUBLE,INT,INT,DOUBLEV,INT,DOUBLEV,DOUBLEV,INT,DOUBLE,INT,INT,INT,DOUBLEV,DOUBLEV,DOUBLEV,PDOUBLE,DOUBLEV,INTV,INT,PDOUBLE,INT,PDOUBLE,PDOUBLE,*ERROR*V,DOUBLEV,PDOUBLE,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,PDOUBLE,PDOUBLE,PDOUBLE,DOUBLEV,PDOUBLE,INTV,PINT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15,A16,A17,A18,A19,A20,A21,A22,A23,A24,A25,A26,A27,A28,A29,A30,A31,A32,A33,A34,A35,A36,A37,A38)
-
-PROTOCCALLSFSUB27(D501L2,d501l2,INT,INT,DOUBLEV,INT,INT,DOUBLE,INT,INT,INT,DOUBLEV,DOUBLEV,DOUBLEV,PDOUBLE,DOUBLEV,INTV,INT,DOUBLEV,PDOUBLE,*ERROR*V,DOUBLEV,DOUBLEV,PDOUBLE,DOUBLEV,PDOUBLE,PDOUBLE,DOUBLE,PINT)
-#define D501L2(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15,A16,A17,A18,A19,A20,A21,A22,A23,A24,A25,A26,A27) CCALLSFSUB27(D501L2,d501l2,INT,INT,DOUBLEV,INT,INT,DOUBLE,INT,INT,INT,DOUBLEV,DOUBLEV,DOUBLEV,PDOUBLE,DOUBLEV,INTV,INT,DOUBLEV,PDOUBLE,*ERROR*V,DOUBLEV,DOUBLEV,PDOUBLE,DOUBLEV,PDOUBLE,PDOUBLE,DOUBLE,PINT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15,A16,A17,A18,A19,A20,A21,A22,A23,A24,A25,A26,A27)
-
-PROTOCCALLSFSUB24(D501N1,d501n1,INT,INT,INT,PDOUBLE,DOUBLEV,DOUBLEV,DOUBLEV,INT,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,PDOUBLE,PINT,DOUBLEV,PDOUBLE,PINT,PINT,DOUBLE,DOUBLE,DOUBLE,INT,BYTE,PINT)
-#define D501N1(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15,A16,A17,A18,A19,A20,A21,A22,A23,A24) CCALLSFSUB24(D501N1,d501n1,INT,INT,INT,PDOUBLE,DOUBLEV,DOUBLEV,DOUBLEV,INT,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,PDOUBLE,PINT,DOUBLEV,PDOUBLE,PINT,PINT,DOUBLE,DOUBLE,DOUBLE,INT,BYTE,PINT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15,A16,A17,A18,A19,A20,A21,A22,A23,A24)
-
-PROTOCCALLSFSUB22(D501N2,d501n2,INT,INT,INT,PDOUBLE,DOUBLEV,DOUBLEV,DOUBLEV,INT,PDOUBLE,PDOUBLE,DOUBLEV,PDOUBLE,PINT,PDOUBLE,PDOUBLE,PINT,PINT,DOUBLE,DOUBLE,DOUBLE,INT,PINT)
-#define D501N2(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15,A16,A17,A18,A19,A20,A21,A22) CCALLSFSUB22(D501N2,d501n2,INT,INT,INT,PDOUBLE,DOUBLEV,DOUBLEV,DOUBLEV,INT,PDOUBLE,PDOUBLE,DOUBLEV,PDOUBLE,PINT,PDOUBLE,PDOUBLE,PINT,PINT,DOUBLE,DOUBLE,DOUBLE,INT,PINT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15,A16,A17,A18,A19,A20,A21,A22)
-
-PROTOCCALLSFSUB18(D501P1,d501p1,INT,INT,INT,DOUBLEV,INT,DOUBLEV,DOUBLEV,INT,DOUBLE,DOUBLE,INT,INT,INT,DOUBLEV,DOUBLEV,DOUBLEV,PINT,BYTE)
-#define D501P1(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15,A16,A17,A18) CCALLSFSUB18(D501P1,d501p1,INT,INT,INT,DOUBLEV,INT,DOUBLEV,DOUBLEV,INT,DOUBLE,DOUBLE,INT,INT,INT,DOUBLEV,DOUBLEV,DOUBLEV,PINT,BYTE,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15,A16,A17,A18)
-
-PROTOCCALLSFSUB12(D501P2,d501p2,PLOGICAL,INT,DOUBLEV,DOUBLEV,DOUBLEV,*ERROR*V,DOUBLE,DOUBLE,INT,LOGICAL,INT,BYTE)
-#define D501P2(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12) CCALLSFSUB12(D501P2,d501p2,PLOGICAL,INT,DOUBLEV,DOUBLEV,DOUBLEV,*ERROR*V,DOUBLE,DOUBLE,INT,LOGICAL,INT,BYTE,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12)
-
-PROTOCCALLSFSUB15(D501SF,d501sf,BYTE,DOUBLE,INT,INT,DOUBLEV,INT,PDOUBLE,PDOUBLE,INT,INT,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,PINT)
-#define D501SF(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15) CCALLSFSUB15(D501SF,d501sf,BYTE,DOUBLE,INT,INT,DOUBLEV,INT,PDOUBLE,PDOUBLE,INT,INT,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,PINT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15)
-*/
-PROTOCCALLSFSUB0(D700SU,d700su)
-#define D700SU() CCALLSFSUB0(D700SU,d700su)
-
-PROTOCCALLSFSUB0(D701BD,d701bd)
-#define D701BD() CCALLSFSUB0(D701BD,d701bd)
-
-PROTOCCALLSFSUB3(DCHPWS,dchpws,INT,DOUBLEV,PDOUBLE)
-#define DCHPWS(A1,A2,A3) CCALLSFSUB3(DCHPWS,dchpws,INT,DOUBLEV,PDOUBLE,A1,A2,A3)
-
-PROTOCCALLSFSUB8(DECOMP,decomp,INT,INT,PFLOAT,PFLOAT,PINT,PLOGICAL,PFLOAT,PFLOAT)
-#define DECOMP(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(DECOMP,decomp,INT,INT,PFLOAT,PFLOAT,PINT,PLOGICAL,PFLOAT,PFLOAT,A1,A2,A3,A4,A5,A6,A7,A8)
-
-PROTOCCALLSFSUB12(DELBND,delbnd,INT,PINT,INTV,PINT,PINT,INT,PINT,DOUBLEV,INT,PDOUBLE,PDOUBLE,PDOUBLE)
-#define DELBND(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12) CCALLSFSUB12(DELBND,delbnd,INT,PINT,INTV,PINT,PINT,INT,PINT,DOUBLEV,INT,PDOUBLE,PDOUBLE,PDOUBLE,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12)
-
-PROTOCCALLSFSUB4(DELETE,delete,INT,PINT,INT,PINT)
-#define DELETE(A1,A2,A3,A4) CCALLSFSUB4(DELETE,delete,INT,PINT,INT,PINT,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB26(DELSLV,delslv,INT,DOUBLE,DOUBLE,LOGICAL,DOUBLE,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLE,PINT,INT,PINT,PDOUBLE,PDOUBLE,DOUBLE,DOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PINT)
-#define DELSLV(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15,A16,A17,A18,A19,A20,A21,A22,A23,A24,A25,A26) CCALLSFSUB26(DELSLV,delslv,INT,DOUBLE,DOUBLE,LOGICAL,DOUBLE,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLE,PINT,INT,PINT,PDOUBLE,PDOUBLE,DOUBLE,DOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PINT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15,A16,A17,A18,A19,A20,A21,A22,A23,A24,A25,A26)
-
-PROTOCCALLSFSUB8(DEQBS,deqbs,INT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT)
-#define DEQBS(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(DEQBS,deqbs,INT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,A1,A2,A3,A4,A5,A6,A7,A8)
-
-PROTOCCALLSFSUB8(DDEQBS,ddeqbs,INT,DOUBLE,DOUBLE,PDOUBLE,PDOUBLE,DOUBLE,DOUBLE,PDOUBLE)
-#define DDEQBS(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(DDEQBS,ddeqbs,INT,DOUBLE,DOUBLE,PDOUBLE,PDOUBLE,DOUBLE,DOUBLE,PDOUBLE,A1,A2,A3,A4,A5,A6,A7,A8)
-
-PROTOCCALLSFSUB8(DEQMR,deqmr,INT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT)
-#define DEQMR(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(DEQMR,deqmr,INT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,A1,A2,A3,A4,A5,A6,A7,A8)
-
-PROTOCCALLSFSUB8(DDEQMR,ddeqmr,INT,DOUBLE,DOUBLE,PDOUBLE,PDOUBLE,DOUBLE,DOUBLE,PDOUBLE)
-#define DDEQMR(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(DDEQMR,ddeqmr,INT,DOUBLE,DOUBLE,PDOUBLE,PDOUBLE,DOUBLE,DOUBLE,PDOUBLE,A1,A2,A3,A4,A5,A6,A7,A8)
-
-PROTOCCALLSFSUB5(DERIV,deriv,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT)
-#define DERIV(A1,A2,A3,A4,A5) CCALLSFSUB5(DERIV,deriv,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB5(DDERIV,dderiv,DOUBLE,DOUBLE,PDOUBLE,PDOUBLE,PDOUBLE)
-#define DDERIV(A1,A2,A3,A4,A5) CCALLSFSUB5(DDERIV,dderiv,DOUBLE,DOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB24(DFUNFT,dfunft,DOUBLE,INT,INT,INT,INT,INT,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,INT,DOUBLE,INT,INT,INT,INTV,DOUBLE,DOUBLEV,PDOUBLE,DOUBLEV,DOUBLEV,INT)
-#define DFUNFT(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15,A16,A17,A18,A19,A20,A21,A22,A23,A24) CCALLSFSUB24(DFUNFT,dfunft,DOUBLE,INT,INT,INT,INT,INT,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,INT,DOUBLE,INT,INT,INT,INTV,DOUBLE,DOUBLEV,PDOUBLE,DOUBLEV,DOUBLEV,INT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15,A16,A17,A18,A19,A20,A21,A22,A23,A24)
-
-PROTOCCALLSFSUB2(DIRCOS,dircos,FLOATV,FLOATV)
-#define DIRCOS(A1,A2) CCALLSFSUB2(DIRCOS,dircos,FLOATV,FLOATV,A1,A2)
-
-PROTOCCALLSFSUB7(DIVON,divon,INT,FLOATV,FLOATV,FLOAT,INT,PFLOAT,PFLOAT)
-#define DIVON(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(DIVON,divon,INT,FLOATV,FLOATV,FLOAT,INT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5,A6,A7)
-
-PROTOCCALLSFSUB19(DMAXLK,dmaxlk,DOUBLE,INT,INT,INT,INT,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,INT,DOUBLE,INT,INT,INT,INTV,DOUBLE,DOUBLEV,DOUBLEV,INT)
-#define DMAXLK(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15,A16,A17,A18,A19) CCALLSFSUB19(DMAXLK,dmaxlk,DOUBLE,INT,INT,INT,INT,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,INT,DOUBLE,INT,INT,INT,INTV,DOUBLE,DOUBLEV,DOUBLEV,INT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15,A16,A17,A18,A19)
-
-PROTOCCALLSFSUB15(DSMPLX,dsmplx,PDOUBLE,DOUBLEV,DOUBLEV,DOUBLE,INT,INT,INT,INT,INT,PINT,INT,DOUBLEV,PDOUBLE,PDOUBLE,PINT)
-#define DSMPLX(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15) CCALLSFSUB15(DSMPLX,dsmplx,PDOUBLE,DOUBLEV,DOUBLEV,DOUBLE,INT,INT,INT,INT,INT,PINT,INT,DOUBLEV,PDOUBLE,PDOUBLE,PINT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15)
-
-PROTOCCALLSFSUB11(DSPAP1,dspap1,INT,INT,INT,DOUBLEV,DOUBLEV,INT,DOUBLEV,DOUBLEV,DOUBLEV,INT,PINT)
-#define DSPAP1(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11) CCALLSFSUB11(DSPAP1,dspap1,INT,INT,INT,DOUBLEV,DOUBLEV,INT,DOUBLEV,DOUBLEV,DOUBLEV,INT,PINT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11)
-
-PROTOCCALLSFSUB18(DSPAP2,dspap2,INT,INT,INT,INT,INT,INT,DOUBLEV,DOUBLEV,PDOUBLE,INT,INT,DOUBLEV,DOUBLEV,PDOUBLE,INT,DOUBLEV,INT,PINT)
-#define DSPAP2(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15,A16,A17,A18) CCALLSFSUB18(DSPAP2,dspap2,INT,INT,INT,INT,INT,INT,DOUBLEV,DOUBLEV,PDOUBLE,INT,INT,DOUBLEV,DOUBLEV,PDOUBLE,INT,DOUBLEV,INT,PINT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15,A16,A17,A18)
-
-PROTOCCALLSFSUB7(DSPCD1,dspcd1,INT,INT,INT,DOUBLEV,DOUBLEV,PDOUBLE,PINT)
-#define DSPCD1(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(DSPCD1,dspcd1,INT,INT,INT,DOUBLEV,DOUBLEV,PDOUBLE,PINT,A1,A2,A3,A4,A5,A6,A7)
-
-PROTOCCALLSFSUB12(DSPCD2,dspcd2,INT,INT,INT,INT,INT,INT,DOUBLEV,DOUBLEV,PDOUBLE,INT,PDOUBLE,PINT)
-#define DSPCD2(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12) CCALLSFSUB12(DSPCD2,dspcd2,INT,INT,INT,INT,INT,INT,DOUBLEV,DOUBLEV,PDOUBLE,INT,PDOUBLE,PINT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12)
-
-PROTOCCALLSFSUB10(DSPIN1,dspin1,INT,INT,DOUBLEV,DOUBLEV,INT,PDOUBLE,DOUBLEV,DOUBLEV,PINT,PINT)
-#define DSPIN1(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10) CCALLSFSUB10(DSPIN1,dspin1,INT,INT,DOUBLEV,DOUBLEV,INT,PDOUBLE,DOUBLEV,DOUBLEV,PINT,PINT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10)
-
-PROTOCCALLSFSUB16(DSPIN2,dspin2,INT,INT,INT,INT,DOUBLEV,DOUBLEV,PDOUBLE,INT,INT,PDOUBLE,PDOUBLE,PDOUBLE,INT,PDOUBLE,PINT,PINT)
-#define DSPIN2(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15,A16) CCALLSFSUB16(DSPIN2,dspin2,INT,INT,INT,INT,DOUBLEV,DOUBLEV,PDOUBLE,INT,INT,PDOUBLE,PDOUBLE,PDOUBLE,INT,PDOUBLE,PINT,PINT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15,A16)
-
-PROTOCCALLSFSUB6(DSPKN1,dspkn1,INT,INT,DOUBLE,DOUBLE,PDOUBLE,PINT)
-#define DSPKN1(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(DSPKN1,dspkn1,INT,INT,DOUBLE,DOUBLE,PDOUBLE,PINT,A1,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFSUB11(DSPKN2,dspkn2,INT,INT,INT,INT,DOUBLE,DOUBLE,DOUBLE,DOUBLE,PDOUBLE,PDOUBLE,PINT)
-#define DSPKN2(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11) CCALLSFSUB11(DSPKN2,dspkn2,INT,INT,INT,INT,DOUBLE,DOUBLE,DOUBLE,DOUBLE,PDOUBLE,PDOUBLE,PINT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11)
-
-PROTOCCALLSFSUB6(DSPVD1,dspvd1,DOUBLE,INT,INT,DOUBLEV,PDOUBLE,PINT)
-#define DSPVD1(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(DSPVD1,dspvd1,DOUBLE,INT,INT,DOUBLEV,PDOUBLE,PINT,A1,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFSUB10(DSPVD2,dspvd2,DOUBLE,INT,INT,INT,INT,DOUBLEV,DOUBLEV,PDOUBLE,INT,PINT)
-#define DSPVD2(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10) CCALLSFSUB10(DSPVD2,dspvd2,DOUBLE,INT,INT,INT,INT,DOUBLEV,DOUBLEV,PDOUBLE,INT,PINT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10)
-
-PROTOCCALLSFSUB19(DSUMSQ,dsumsq,DOUBLE,INT,INT,INT,DOUBLEV,DOUBLEV,DOUBLEV,INT,DOUBLE,INT,INT,INT,INTV,DOUBLE,DOUBLEV,PDOUBLE,DOUBLEV,DOUBLEV,INT)
-#define DSUMSQ(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15,A16,A17,A18,A19) CCALLSFSUB19(DSUMSQ,dsumsq,DOUBLE,INT,INT,INT,DOUBLEV,DOUBLEV,DOUBLEV,INT,DOUBLE,INT,INT,INT,INTV,DOUBLE,DOUBLEV,PDOUBLE,DOUBLEV,DOUBLEV,INT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15,A16,A17,A18,A19)
-
-PROTOCCALLSFSUB3(DVCOPY,dvcopy,INT,DOUBLEV,PDOUBLE)
-#define DVCOPY(A1,A2,A3) CCALLSFSUB3(DVCOPY,dvcopy,INT,DOUBLEV,PDOUBLE,A1,A2,A3)
-
-PROTOCCALLSFSUB0(DVNBKD,dvnbkd)
-#define DVNBKD() CCALLSFSUB0(DVNBKD,dvnbkd)
-
-PROTOCCALLSFSUB0(DVNOPT,dvnopt)
-#define DVNOPT() CCALLSFSUB0(DVNOPT,dvnopt)
-
-PROTOCCALLSFSUB11(ECONDE,econde,DOUBLEV,PDOUBLE,INT,PINT,DOUBLE,DOUBLE,DOUBLE,INT,DOUBLEV,DOUBLEV,DOUBLEV)
-#define ECONDE(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11) CCALLSFSUB11(ECONDE,econde,DOUBLEV,PDOUBLE,INT,PINT,DOUBLE,DOUBLE,DOUBLE,INT,DOUBLEV,DOUBLEV,DOUBLEV,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11)
-
-PROTOCCALLSFSUB8(ECTRAD,ectrad,DOUBLEV,INT,DOUBLEV,PINT,DOUBLE,DOUBLE,DOUBLE,INT)
-#define ECTRAD(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(ECTRAD,ectrad,DOUBLEV,INT,DOUBLEV,PINT,DOUBLE,DOUBLE,DOUBLE,INT,A1,A2,A3,A4,A5,A6,A7,A8)
-
-PROTOCCALLSFSUB10(EISCG1,eiscg1,INT,INT,PFLOAT,PFLOAT,FLOATV,FLOATV,PFLOAT,PFLOAT,INT,FLOATV)
-#define EISCG1(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10) CCALLSFSUB10(EISCG1,eiscg1,INT,INT,PFLOAT,PFLOAT,FLOATV,FLOATV,PFLOAT,PFLOAT,INT,FLOATV,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10)
-
-PROTOCCALLSFSUB7(EISCG2,eiscg2,INT,INT,PFLOAT,PFLOAT,FLOATV,FLOATV,INT)
-#define EISCG2(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(EISCG2,eiscg2,INT,INT,PFLOAT,PFLOAT,FLOATV,FLOATV,INT,A1,A2,A3,A4,A5,A6,A7)
-
-PROTOCCALLSFSUB9(EISCH1,eisch1,INT,INT,PFLOAT,PFLOAT,FLOATV,PFLOAT,PFLOAT,INT,FLOATV)
-#define EISCH1(A1,A2,A3,A4,A5,A6,A7,A8,A9) CCALLSFSUB9(EISCH1,eisch1,INT,INT,PFLOAT,PFLOAT,FLOATV,PFLOAT,PFLOAT,INT,FLOATV,A1,A2,A3,A4,A5,A6,A7,A8,A9)
-
-PROTOCCALLSFSUB7(EISCH2,eisch2,INT,INT,PFLOAT,PFLOAT,FLOATV,INT,FLOATV)
-#define EISCH2(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(EISCH2,eisch2,INT,INT,PFLOAT,PFLOAT,FLOATV,INT,FLOATV,A1,A2,A3,A4,A5,A6,A7)
-
-PROTOCCALLSFSUB13(EISCH3,eisch3,INT,INT,PFLOAT,PFLOAT,FLOAT,FLOAT,INT,INT,FLOATV,PFLOAT,PFLOAT,INT,FLOATV)
-#define EISCH3(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13) CCALLSFSUB13(EISCH3,eisch3,INT,INT,PFLOAT,PFLOAT,FLOAT,FLOAT,INT,INT,FLOATV,PFLOAT,PFLOAT,INT,FLOATV,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13)
-
-PROTOCCALLSFSUB11(EISCH4,eisch4,INT,INT,PFLOAT,PFLOAT,FLOAT,FLOAT,INT,INT,FLOATV,INT,FLOATV)
-#define EISCH4(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11) CCALLSFSUB11(EISCH4,eisch4,INT,INT,PFLOAT,PFLOAT,FLOAT,FLOAT,INT,INT,FLOATV,INT,FLOATV,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11)
-
-PROTOCCALLSFSUB8(EISRG1,eisrg1,INT,INT,PFLOAT,FLOATV,FLOATV,PFLOAT,INT,FLOATV)
-#define EISRG1(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(EISRG1,eisrg1,INT,INT,PFLOAT,FLOATV,FLOATV,PFLOAT,INT,FLOATV,A1,A2,A3,A4,A5,A6,A7,A8)
-
-PROTOCCALLSFSUB6(EISRG2,eisrg2,INT,INT,PFLOAT,FLOATV,FLOATV,INT)
-#define EISRG2(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(EISRG2,eisrg2,INT,INT,PFLOAT,FLOATV,FLOATV,INT,A1,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFSUB7(EISRS1,eisrs1,INT,INT,PFLOAT,FLOATV,PFLOAT,INT,FLOATV)
-#define EISRS1(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(EISRS1,eisrs1,INT,INT,PFLOAT,FLOATV,PFLOAT,INT,FLOATV,A1,A2,A3,A4,A5,A6,A7)
-
-PROTOCCALLSFSUB6(EISRS2,eisrs2,INT,INT,PFLOAT,FLOATV,INT,FLOATV)
-#define EISRS2(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(EISRS2,eisrs2,INT,INT,PFLOAT,FLOATV,INT,FLOATV,A1,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFSUB11(EISRS3,eisrs3,INT,INT,PFLOAT,FLOAT,FLOAT,INT,INT,FLOATV,PFLOAT,INT,FLOATV)
-#define EISRS3(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11) CCALLSFSUB11(EISRS3,eisrs3,INT,INT,PFLOAT,FLOAT,FLOAT,INT,INT,FLOATV,PFLOAT,INT,FLOATV,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11)
-
-PROTOCCALLSFSUB10(EISRS4,eisrs4,INT,INT,PFLOAT,FLOAT,FLOAT,INT,INT,FLOATV,INT,FLOATV)
-#define EISRS4(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10) CCALLSFSUB10(EISRS4,eisrs4,INT,INT,PFLOAT,FLOAT,FLOAT,INT,INT,FLOATV,INT,FLOATV,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10)
-
-PROTOCCALLSFSUB7(EISST1,eisst1,INT,INT,PFLOAT,PFLOAT,PFLOAT,INT,PFLOAT)
-#define EISST1(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(EISST1,eisst1,INT,INT,PFLOAT,PFLOAT,PFLOAT,INT,PFLOAT,A1,A2,A3,A4,A5,A6,A7)
-
-PROTOCCALLSFSUB6(EISST2,eisst2,INT,INT,PFLOAT,PFLOAT,INT,PFLOAT)
-#define EISST2(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(EISST2,eisst2,INT,INT,PFLOAT,PFLOAT,INT,PFLOAT,A1,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFSUB11(EISST3,eisst3,INT,INT,PFLOAT,FLOAT,FLOAT,INT,INT,FLOATV,PFLOAT,INT,PFLOAT)
-#define EISST3(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11) CCALLSFSUB11(EISST3,eisst3,INT,INT,PFLOAT,FLOAT,FLOAT,INT,INT,FLOATV,PFLOAT,INT,PFLOAT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11)
-
-PROTOCCALLSFSUB10(EISST4,eisst4,INT,INT,PFLOAT,FLOAT,FLOAT,INT,INT,FLOATV,INT,PFLOAT)
-#define EISST4(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10) CCALLSFSUB10(EISST4,eisst4,INT,INT,PFLOAT,FLOAT,FLOAT,INT,INT,FLOATV,INT,PFLOAT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10)
-
-PROTOCCALLSFSUB8(ELANAL,elanal,INT,INT,INT,PFLOAT,FLOATV,FLOATV,FLOATV,FLOATV)
-#define ELANAL(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(ELANAL,elanal,INT,INT,INT,PFLOAT,FLOATV,FLOATV,FLOATV,FLOATV,A1,A2,A3,A4,A5,A6,A7,A8)
-
-PROTOCCALLSFSUB5(ELFUN,elfun,FLOAT,FLOAT,PFLOAT,PFLOAT,PFLOAT)
-#define ELFUN(A1,A2,A3,A4,A5) CCALLSFSUB5(ELFUN,elfun,FLOAT,FLOAT,PFLOAT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB5(DELFUN,delfun,DOUBLE,DOUBLE,PDOUBLE,PDOUBLE,PDOUBLE)
-#define DELFUN(A1,A2,A3,A4,A5) CCALLSFSUB5(DELFUN,delfun,DOUBLE,DOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB7(ELMBAK,elmbak,INT,INT,INT,PFLOAT,INTV,INT,PFLOAT)
-#define ELMBAK(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(ELMBAK,elmbak,INT,INT,INT,PFLOAT,INTV,INT,PFLOAT,A1,A2,A3,A4,A5,A6,A7)
-
-PROTOCCALLSFSUB6(ELMHES,elmhes,INT,INT,INT,INT,PFLOAT,PINT)
-#define ELMHES(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(ELMHES,elmhes,INT,INT,INT,INT,PFLOAT,PINT,A1,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFSUB12(ELPAHY,elpahy,PFLOAT,INT,INT,FLOAT,FLOAT,FLOATV,INT,FLOATV,FLOATV,INT,FLOATV,FLOATV)
-#define ELPAHY(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12) CCALLSFSUB12(ELPAHY,elpahy,PFLOAT,INT,INT,FLOAT,FLOAT,FLOATV,INT,FLOATV,FLOATV,INT,FLOATV,FLOATV,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12)
-
-PROTOCCALLSFSUB7(ELTRAN,eltran,INT,INT,INT,INT,PFLOAT,INTV,PFLOAT)
-#define ELTRAN(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(ELTRAN,eltran,INT,INT,INT,INT,PFLOAT,INTV,PFLOAT,A1,A2,A3,A4,A5,A6,A7)
-
-PROTOCCALLSFSUB13(EPDBPS,epdbps,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,INT,INT,FLOAT,PINT,PFLOAT,PFLOAT,PINT)
-#define EPDBPS(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13) CCALLSFSUB13(EPDBPS,epdbps,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,INT,INT,FLOAT,PINT,PFLOAT,PFLOAT,PINT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13)
-
-PROTOCCALLSFSUB4(EPDCHK,epdchk,FLOATV,FLOATV,FLOATV,INT)
-#define EPDCHK(A1,A2,A3,A4) CCALLSFSUB4(EPDCHK,epdchk,FLOATV,FLOATV,FLOATV,INT,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB2(EPDCHN,epdchn,FLOAT,FLOAT)
-#define EPDCHN(A1,A2) CCALLSFSUB2(EPDCHN,epdchn,FLOAT,FLOAT,A1,A2)
-
-PROTOCCALLSFSUB4(EPDCJ,epdcj,PFLOAT,FLOATV,PINT,PFLOAT)
-#define EPDCJ(A1,A2,A3,A4) CCALLSFSUB4(EPDCJ,epdcj,PFLOAT,FLOATV,PINT,PFLOAT,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB0(EPDE1,epde1)
-#define EPDE1() CCALLSFSUB0(EPDE1,epde1)
-
-PROTOCCALLSFSUB0(EPDECC,epdecc)
-#define EPDECC() CCALLSFSUB0(EPDECC,epdecc)
-
-PROTOCCALLSFSUB2(EPDFIX,epdfix,INT,PINT)
-#define EPDFIX(A1,A2) CCALLSFSUB2(EPDFIX,epdfix,INT,PINT,A1,A2)
-
-PROTOCCALLSFSUB4(EPDIN,epdin,FLOATV,FLOATV,PINT,PFLOAT)
-#define EPDIN(A1,A2,A3,A4) CCALLSFSUB4(EPDIN,epdin,FLOATV,FLOATV,PINT,PFLOAT,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB5(EPDITR,epditr,FLOAT,PFLOAT,PFLOAT,PINT,PFLOAT)
-#define EPDITR(A1,A2,A3,A4,A5) CCALLSFSUB5(EPDITR,epditr,FLOAT,PFLOAT,PFLOAT,PINT,PFLOAT,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB4(EPDJE,epdje,PFLOAT,FLOATV,PINT,PFLOAT)
-#define EPDJE(A1,A2,A3,A4) CCALLSFSUB4(EPDJE,epdje,PFLOAT,FLOATV,PINT,PFLOAT,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB11(EPDLOC,epdloc,INT,FLOAT,PFLOAT,INTV,PFLOAT,PFLOAT,PFLOAT,PFLOAT,PFLOAT,PINT,FLOAT)
-#define EPDLOC(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11) CCALLSFSUB11(EPDLOC,epdloc,INT,FLOAT,PFLOAT,INTV,PFLOAT,PFLOAT,PFLOAT,PFLOAT,PFLOAT,PINT,FLOAT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11)
-
-PROTOCCALLSFSUB4(EPDSRT,epdsrt,INT,INTV,PFLOAT,PFLOAT)
-#define EPDSRT(A1,A2,A3,A4) CCALLSFSUB4(EPDSRT,epdsrt,INT,INTV,PFLOAT,PFLOAT,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB5(EPDTAB,epdtab,INT,PFLOAT,FLOAT,INT,PINT)
-#define EPDTAB(A1,A2,A3,A4,A5) CCALLSFSUB5(EPDTAB,epdtab,INT,PFLOAT,FLOAT,INT,PINT,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB5(EPSILO,epsilo,PDOUBLE,INT,INT,INT,PFLOAT)
-#define EPSILO(A1,A2,A3,A4,A5) CCALLSFSUB5(EPSILO,epsilo,PDOUBLE,INT,INT,INT,PFLOAT,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB4(ERPRIP,erprip,FLOATV,FLOATV,FLOATV,FLOATV)
-#define ERPRIP(A1,A2,A3,A4) CCALLSFSUB4(ERPRIP,erprip,FLOATV,FLOATV,FLOATV,FLOATV,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB1(ERRORF,errorf,INT)
-#define ERRORF(A1) CCALLSFSUB1(ERRORF,errorf,INT,A1)
-
-PROTOCCALLSFSUB13(ESOLVE,esolve,INT,INT,FLOAT,FLOAT,FLOAT,FLOAT,INT,FLOAT,FLOAT,FLOAT,FLOAT,PFLOAT,INT)
-#define ESOLVE(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13) CCALLSFSUB13(ESOLVE,esolve,INT,INT,FLOAT,FLOAT,FLOAT,FLOAT,INT,FLOAT,FLOAT,FLOAT,FLOAT,PFLOAT,INT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13)
-
-PROTOCCALLSFSUB9(FCN1,fcn1,INT,INT,FLOATV,FLOATV,INT,INT,FLOATV,INT,INT)
-#define FCN1(A1,A2,A3,A4,A5,A6,A7,A8,A9) CCALLSFSUB9(FCN1,fcn1,INT,INT,FLOATV,FLOATV,INT,INT,FLOATV,INT,INT,A1,A2,A3,A4,A5,A6,A7,A8,A9)
-
-PROTOCCALLSFSUB11(FEASMV,feasmv,INT,INT,INTV,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLE,PDOUBLE,PINT,PINT)
-#define FEASMV(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11) CCALLSFSUB11(FEASMV,feasmv,INT,INT,INTV,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLE,PDOUBLE,PINT,PINT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11)
-
-PROTOCCALLSFSUB4(FEQN,feqn,INT,DOUBLEV,DOUBLE,PDOUBLE)
-#define FEQN(A1,A2,A3,A4) CCALLSFSUB4(FEQN,feqn,INT,DOUBLEV,DOUBLE,PDOUBLE,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB6(FFTRC,fftrc,FLOATV,FLOATV,INT,FLOATV,FLOATV,INT)
-#define FFTRC(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(FFTRC,fftrc,FLOATV,FLOATV,INT,FLOATV,FLOATV,INT,A1,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFSUB7(FIGI,figi,INT,INT,PFLOAT,PFLOAT,PFLOAT,PFLOAT,PINT)
-#define FIGI(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(FIGI,figi,INT,INT,PFLOAT,PFLOAT,PFLOAT,PFLOAT,PINT,A1,A2,A3,A4,A5,A6,A7)
-
-PROTOCCALLSFSUB7(FIGI2,figi2,INT,INT,PFLOAT,PFLOAT,PFLOAT,PFLOAT,PINT)
-#define FIGI2(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(FIGI2,figi2,INT,INT,PFLOAT,PFLOAT,PFLOAT,PFLOAT,PINT,A1,A2,A3,A4,A5,A6,A7)
-
-PROTOCCALLSFSUB3(FINDEM,findem,FLOAT,INT,PFLOAT)
-#define FINDEM(A1,A2,A3) CCALLSFSUB3(FINDEM,findem,FLOAT,INT,PFLOAT,A1,A2,A3)
-
-PROTOCCALLSFSUB19(FINDPC,findpc,PDOUBLE,DOUBLEV,DOUBLEV,DOUBLE,INT,INT,INT,INTV,INTV,PINT,INTV,INTV,INT,PINT,INT,PDOUBLE,PDOUBLE,FLOAT,INT)
-#define FINDPC(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15,A16,A17,A18,A19) CCALLSFSUB19(FINDPC,findpc,PDOUBLE,DOUBLEV,DOUBLEV,DOUBLE,INT,INT,INT,INTV,INTV,PINT,INTV,INTV,INT,PINT,INT,PDOUBLE,PDOUBLE,FLOAT,INT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15,A16,A17,A18,A19)
-
-PROTOCCALLSFSUB4(FRAME,frame,FLOAT,FLOAT,FLOAT,FLOAT)
-#define FRAME(A1,A2,A3,A4) CCALLSFSUB4(FRAME,frame,FLOAT,FLOAT,FLOAT,FLOAT,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB7(FRED1,fred1,FLOAT,FLOAT,FLOAT,FLOAT,INT,PFLOAT,INT)
-#define FRED1(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(FRED1,fred1,FLOAT,FLOAT,FLOAT,FLOAT,INT,PFLOAT,INT,A1,A2,A3,A4,A5,A6,A7)
-
-PROTOCCALLSFSUB10(FUMILI,fumili,PFLOAT,INT,INT,INT,INT,FLOAT,PFLOAT,PFLOAT,INT,PINT)
-#define FUMILI(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10) CCALLSFSUB10(FUMILI,fumili,PFLOAT,INT,INT,INT,INT,FLOAT,PFLOAT,PFLOAT,INT,PINT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10)
-
-PROTOCCALLSFSUB4(FUNPRE,funpre,FLOAT,PFLOAT,FLOAT,FLOAT)
-#define FUNPRE(A1,A2,A3,A4) CCALLSFSUB4(FUNPRE,funpre,FLOAT,PFLOAT,FLOAT,FLOAT,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB2(FUNRAN,funran,FLOATV,PFLOAT)
-#define FUNRAN(A1,A2) CCALLSFSUB2(FUNRAN,funran,FLOATV,PFLOAT,A1,A2)
-
-PROTOCCALLSFSUB5(FUNZER,funzer,FLOAT,FLOAT,FLOAT,PFLOAT,PFLOAT)
-#define FUNZER(A1,A2,A3,A4,A5) CCALLSFSUB5(FUNZER,funzer,FLOAT,FLOAT,FLOAT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB4(GATHER,gather,INT,PFLOAT,FLOATV,INTV)
-#define GATHER(A1,A2,A3,A4) CCALLSFSUB4(GATHER,gather,INT,PFLOAT,FLOATV,INTV,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB3(GENPNT,genpnt,INT,FLOATV,FLOAT)
-#define GENPNT(A1,A2,A3) CCALLSFSUB3(GENPNT,genpnt,INT,FLOATV,FLOAT,A1,A2,A3)
-
-PROTOCCALLSFSUB1(GENT,gent,INT)
-#define GENT(A1) CCALLSFSUB1(GENT,gent,INT,A1)
-
-PROTOCCALLSFSUB6(GETSCH,getsch,BYTE,BYTE,BYTE,INT,PBYTE,PINT)
-#define GETSCH(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(GETSCH,getsch,BYTE,BYTE,BYTE,INT,PBYTE,PINT,A1,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFSUB6(GETSST,getsst,INTV,INT,INT,INT,INTV,PINT)
-#define GETSST(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(GETSST,getsst,INTV,INT,INT,INT,INTV,PINT,A1,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFSUB6(GRAPH,graph,PINT,INT,INT,PINT,PINT,PINT)
-#define GRAPH(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(GRAPH,graph,PINT,INT,INT,PINT,PINT,PINT,A1,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFSUB9(GRDCMP,grdcmp,INT,INT,INTV,DOUBLEV,DOUBLE,DOUBLE,DOUBLEV,PDOUBLE,PDOUBLE)
-#define GRDCMP(A1,A2,A3,A4,A5,A6,A7,A8,A9) CCALLSFSUB9(GRDCMP,grdcmp,INT,INT,INTV,DOUBLEV,DOUBLE,DOUBLE,DOUBLEV,PDOUBLE,PDOUBLE,A1,A2,A3,A4,A5,A6,A7,A8,A9)
-
-PROTOCCALLSFSUB12(H101S1,h101s1,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,INT,INT,INT,INT,INT,PINT,INT,PDOUBLE)
-#define H101S1(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12) CCALLSFSUB12(H101S1,h101s1,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,INT,INT,INT,INT,INT,PINT,INT,PDOUBLE,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12)
-
-PROTOCCALLSFSUB15(H101S2,h101s2,PDOUBLE,DOUBLEV,DOUBLEV,INT,INT,INT,INT,PINT,INT,PINT,INT,PDOUBLE,PDOUBLE,DOUBLE,INT)
-#define H101S2(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15) CCALLSFSUB15(H101S2,h101s2,PDOUBLE,DOUBLEV,DOUBLEV,INT,INT,INT,INT,PINT,INT,PINT,INT,PDOUBLE,PDOUBLE,DOUBLE,INT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15)
-
-PROTOCCALLSFSUB9(ASSNDX,assndx,INT,PFLOAT,INT,INT,INT,PINT,PFLOAT,PINT,INT)
-#define ASSNDX(A1,A2,A3,A4,A5,A6,A7,A8,A9) CCALLSFSUB9(ASSNDX,assndx,INT,PFLOAT,INT,INT,INT,PINT,PFLOAT,PINT,INT,A1,A2,A3,A4,A5,A6,A7,A8,A9)
-
-PROTOCCALLSFSUB5(HISRAN,hisran,FLOATV,INT,FLOAT,FLOAT,FLOAT)
-#define HISRAN(A1,A2,A3,A4,A5) CCALLSFSUB5(HISRAN,hisran,FLOATV,INT,FLOAT,FLOAT,FLOAT,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB8(HQR,hqr,INT,INT,INT,INT,PFLOAT,PFLOAT,PFLOAT,PINT)
-#define HQR(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(HQR,hqr,INT,INT,INT,INT,PFLOAT,PFLOAT,PFLOAT,PINT,A1,A2,A3,A4,A5,A6,A7,A8)
-
-PROTOCCALLSFSUB9(HQR2,hqr2,INT,INT,INT,INT,PFLOAT,PFLOAT,PFLOAT,PFLOAT,PINT)
-#define HQR2(A1,A2,A3,A4,A5,A6,A7,A8,A9) CCALLSFSUB9(HQR2,hqr2,INT,INT,INT,INT,PFLOAT,PFLOAT,PFLOAT,PFLOAT,PINT,A1,A2,A3,A4,A5,A6,A7,A8,A9)
-
-PROTOCCALLSFSUB8(HTRIBK,htribk,INT,INT,PFLOAT,PFLOAT,PFLOAT,INT,PFLOAT,PFLOAT)
-#define HTRIBK(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(HTRIBK,htribk,INT,INT,PFLOAT,PFLOAT,PFLOAT,INT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5,A6,A7,A8)
-
-PROTOCCALLSFSUB8(HTRIDI,htridi,INT,INT,PFLOAT,PFLOAT,PFLOAT,PFLOAT,PFLOAT,PFLOAT)
-#define HTRIDI(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(HTRIDI,htridi,INT,INT,PFLOAT,PFLOAT,PFLOAT,PFLOAT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5,A6,A7,A8)
-
-PROTOCCALLSFSUB6(I128,i128,FLOATV,FLOATV,INT,FLOATV,FLOATV,INT)
-#define I128(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(I128,i128,FLOATV,FLOATV,INT,FLOATV,FLOATV,INT,A1,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFSUB6(I32,i32,FLOATV,FLOATV,INT,FLOATV,FLOATV,INT)
-#define I32(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(I32,i32,FLOATV,FLOATV,INT,FLOATV,FLOATV,INT,A1,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFSUB6(I64,i64,FLOATV,FLOATV,INT,FLOATV,FLOATV,INT)
-#define I64(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(I64,i64,FLOATV,FLOATV,INT,FLOATV,FLOATV,INT,A1,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFSUB4(IMTQL1,imtql1,INT,PFLOAT,PFLOAT,PINT)
-#define IMTQL1(A1,A2,A3,A4) CCALLSFSUB4(IMTQL1,imtql1,INT,PFLOAT,PFLOAT,PINT,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB6(IMTQL2,imtql2,INT,INT,PFLOAT,PFLOAT,PFLOAT,PINT)
-#define IMTQL2(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(IMTQL2,imtql2,INT,INT,PFLOAT,PFLOAT,PFLOAT,PINT,A1,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFSUB5(INTGRL,intgrl,INT,INT,INT,PFLOAT,PFLOAT)
-#define INTGRL(A1,A2,A3,A4,A5) CCALLSFSUB5(INTGRL,intgrl,INT,INT,INT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB13(INVIT,invit,INT,INT,PFLOAT,PFLOAT,FLOATV,LOGICALV,INT,PINT,PFLOAT,PINT,PFLOAT,PFLOAT,PFLOAT)
-#define INVIT(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13) CCALLSFSUB13(INVIT,invit,INT,INT,PFLOAT,PFLOAT,FLOATV,LOGICALV,INT,PINT,PFLOAT,PINT,PFLOAT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13)
-
-PROTOCCALLSFSUB0(J509BD,j509bd)
-#define J509BD() CCALLSFSUB0(J509BD,j509bd)
-
-PROTOCCALLSFSUB5(LDLSOL,ldlsol,INT,INT,PDOUBLE,DOUBLEV,PDOUBLE)
-#define LDLSOL(A1,A2,A3,A4,A5) CCALLSFSUB5(LDLSOL,ldlsol,INT,INT,PDOUBLE,DOUBLEV,PDOUBLE,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB0(LEG1,leg1)
-#define LEG1() CCALLSFSUB0(LEG1,leg1)
-
-PROTOCCALLSFSUB0(LEGOR,legor)
-#define LEGOR() CCALLSFSUB0(LEGOR,legor)
-
-PROTOCCALLSFSUB0(LEGV,legv)
-#define LEGV() CCALLSFSUB0(LEGV,legv)
-
-PROTOCCALLSFSUB0(LEGZ,legz)
-#define LEGZ() CCALLSFSUB0(LEGZ,legz)
-
-PROTOCCALLSFSUB7(LFIT,lfit,FLOATV,FLOATV,INT,INT,PFLOAT,PFLOAT,PFLOAT)
-#define LFIT(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(LFIT,lfit,FLOATV,FLOATV,INT,INT,PFLOAT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5,A6,A7)
-
-PROTOCCALLSFSUB8(LFITW,lfitw,FLOATV,FLOATV,FLOATV,INT,INT,PFLOAT,PFLOAT,PFLOAT)
-#define LFITW(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(LFITW,lfitw,FLOATV,FLOATV,FLOATV,INT,INT,PFLOAT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5,A6,A7,A8)
-
-PROTOCCALLSFSUB12(LIHOIN,lihoin,PFLOAT,INT,INT,INT,INT,PFLOAT,INT,PINT,FLOAT,INT,PFLOAT,PINT)
-#define LIHOIN(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12) CCALLSFSUB12(LIHOIN,lihoin,PFLOAT,INT,INT,INT,INT,PFLOAT,INT,PINT,FLOAT,INT,PFLOAT,PINT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12)
-
-PROTOCCALLSFSUB12(DLHOIN,dlhoin,PDOUBLE,INT,INT,INT,INT,PDOUBLE,INT,PINT,DOUBLE,INT,PDOUBLE,PINT)
-#define DLHOIN(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12) CCALLSFSUB12(DLHOIN,dlhoin,PDOUBLE,INT,INT,INT,INT,PDOUBLE,INT,PINT,DOUBLE,INT,PDOUBLE,PINT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12)
-
-PROTOCCALLSFSUB12(LINSQ,linsq,INT,INT,INT,PFLOAT,PFLOAT,FLOATV,FLOATV,PFLOAT,PDOUBLE,FLOAT,FLOAT,PFLOAT)
-#define LINSQ(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12) CCALLSFSUB12(LINSQ,linsq,INT,INT,INT,PFLOAT,PFLOAT,FLOATV,FLOATV,PFLOAT,PDOUBLE,FLOAT,FLOAT,PFLOAT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12)
-
-PROTOCCALLSFSUB8(D508R1,d508r1,PDOUBLE,INT,INT,INT,INT,PINT,PINT,PDOUBLE)
-#define D508R1(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(D508R1,d508r1,PDOUBLE,INT,INT,INT,INT,PINT,PINT,PDOUBLE,A1,A2,A3,A4,A5,A6,A7,A8)
-
-PROTOCCALLSFSUB8(D508R2,d508r2,PDOUBLE,INT,INT,FLOAT,INT,INTV,PINT,PDOUBLE)
-#define D508R2(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(D508R2,d508r2,PDOUBLE,INT,INT,FLOAT,INT,INTV,PINT,PDOUBLE,A1,A2,A3,A4,A5,A6,A7,A8)
-
-PROTOCCALLSFSUB16(LOCSCH,locsch,INT,INT,INT,INTV,DOUBLEV,DOUBLE,DOUBLEV,DOUBLEV,DOUBLE,DOUBLE,PINT,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE)
-#define LOCSCH(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15,A16) CCALLSFSUB16(LOCSCH,locsch,INT,INT,INT,INTV,DOUBLEV,DOUBLE,DOUBLEV,DOUBLEV,DOUBLE,DOUBLE,PINT,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15,A16)
-
-PROTOCCALLSFSUB9(LRCH,lrch,INT,INT,PFLOAT,FLOAT,INT,PFLOAT,INT,INT,PFLOAT)
-#define LRCH(A1,A2,A3,A4,A5,A6,A7,A8,A9) CCALLSFSUB9(LRCH,lrch,INT,INT,PFLOAT,FLOAT,INT,PFLOAT,INT,INT,PFLOAT,A1,A2,A3,A4,A5,A6,A7,A8,A9)
-
-PROTOCCALLSFSUB10(LSQQR,lsqqr,PFLOAT,PFLOAT,PFLOAT,INT,INT,INT,INT,INT,PLOGICAL,PFLOAT)
-#define LSQQR(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10) CCALLSFSUB10(LSQQR,lsqqr,PFLOAT,PFLOAT,PFLOAT,INT,INT,INT,INT,INT,PLOGICAL,PFLOAT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10)
-
-PROTOCCALLSFSUB4(MAP,map,FLOAT,FLOAT,FLOAT,FLOAT)
-#define MAP(A1,A2,A3,A4) CCALLSFSUB4(MAP,map,FLOAT,FLOAT,FLOAT,FLOAT,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB1(MCONV,mconv,INT)
-#define MCONV(A1) CCALLSFSUB1(MCONV,mconv,INT,A1)
-
-PROTOCCALLSFSUB6(MFT,mft,INT,INT,PFLOAT,PFLOAT,PFLOAT,INT)
-#define MFT(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(MFT,mft,INT,INT,PFLOAT,PFLOAT,PFLOAT,INT,A1,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFSUB8(RMINFC,rminfc,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,PFLOAT,PFLOAT,PLOGICAL)
-#define RMINFC(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(RMINFC,rminfc,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,PFLOAT,PFLOAT,PLOGICAL,A1,A2,A3,A4,A5,A6,A7,A8)
-
-PROTOCCALLSFSUB8(DMINFC,dminfc,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,PDOUBLE,PDOUBLE,PLOGICAL)
-#define DMINFC(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(DMINFC,dminfc,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,PDOUBLE,PDOUBLE,PLOGICAL,A1,A2,A3,A4,A5,A6,A7,A8)
-
-PROTOCCALLSFSUB11(MINSQ,minsq,INT,INT,PFLOAT,PFLOAT,FLOATV,INT,INT,INT,PFLOAT,FLOAT,FLOAT)
-#define MINSQ(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11) CCALLSFSUB11(MINSQ,minsq,INT,INT,PFLOAT,PFLOAT,FLOATV,INT,INT,INT,PFLOAT,FLOAT,FLOAT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11)
-
-PROTOCCALLSFSUB6(MODCHL,modchl,INT,INT,PDOUBLE,DOUBLE,PDOUBLE,PINT)
-#define MODCHL(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(MODCHL,modchl,INT,INT,PDOUBLE,DOUBLE,PDOUBLE,PINT,A1,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFSUB8(MONITO,monito,FLOAT,INT,INT,INT,FLOAT,FLOAT,FLOAT,FLOAT)
-#define MONITO(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(MONITO,monito,FLOAT,INT,INT,INT,FLOAT,FLOAT,FLOAT,FLOAT,A1,A2,A3,A4,A5,A6,A7,A8)
-
-PROTOCCALLSFSUB3(MTLPRT,mtlprt,STRING,STRING,STRING)
-#define MTLPRT(A1,A2,A3) CCALLSFSUB3(MTLPRT,mtlprt,STRING,STRING,STRING,A1,A2,A3)
-
-PROTOCCALLSFSUB4(MTLSET,mtlset,STRING,INT,INT,INT)
-#define MTLSET(A1,A2,A3,A4) CCALLSFSUB4(MTLSET,mtlset,STRING,INT,INT,INT,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB14(MULCHK,mulchk,INT,INT,INTV,INT,DOUBLE,DOUBLEV,DOUBLEV,DOUBLE,DOUBLE,DOUBLEV,PDOUBLE,PLOGICAL,PINT,PINT)
-#define MULCHK(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14) CCALLSFSUB14(MULCHK,mulchk,INT,INT,INTV,INT,DOUBLE,DOUBLEV,DOUBLEV,DOUBLE,DOUBLE,DOUBLEV,PDOUBLE,PLOGICAL,PINT,PINT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14)
-
-PROTOCCALLSFSUB5(MUNOMI,munomi,INT,INT,PFLOAT,PINT,PINT)
-#define MUNOMI(A1,A2,A3,A4,A5) CCALLSFSUB5(MUNOMI,munomi,INT,INT,PFLOAT,PINT,PINT,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB10(MXDIPR,mxdipr,PFLOAT,PFLOAT,PFLOAT,INT,INT,INT,INT,INT,INT,INT)
-#define MXDIPR(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10) CCALLSFSUB10(MXDIPR,mxdipr,PFLOAT,PFLOAT,PFLOAT,INT,INT,INT,INT,INT,INT,INT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10)
-
-PROTOCCALLSFSUB6(MXSTEP,mxstep,DOUBLE,DOUBLE,DOUBLE,DOUBLE,PDOUBLE,PDOUBLE)
-#define MXSTEP(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(MXSTEP,mxstep,DOUBLE,DOUBLE,DOUBLE,DOUBLE,PDOUBLE,PDOUBLE,A1,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFSUB2(NAMES,names,INT,INT)
-#define NAMES(A1,A2) CCALLSFSUB2(NAMES,names,INT,INT,A1,A2)
-
-PROTOCCALLSFSUB3(NAMEZB,namezb,FLOAT,INT,INT)
-#define NAMEZB(A1,A2,A3) CCALLSFSUB3(NAMEZB,namezb,FLOAT,INT,INT,A1,A2,A3)
-
-PROTOCCALLSFSUB29(NEWPTQ,newptq,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,PDOUBLE,PDOUBLE,DOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PINT,PINT)
-#define NEWPTQ(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15,A16,A17,A18,A19,A20,A21,A22,A23,A24,A25,A26,A27,A28,A29) CCALLSFSUB29(NEWPTQ,newptq,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,PDOUBLE,PDOUBLE,DOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PINT,PINT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15,A16,A17,A18,A19,A20,A21,A22,A23,A24,A25,A26,A27,A28,A29)
-
-PROTOCCALLSFSUB9(NEWRO,newro,INT,INT,INT,FLOAT,PFLOAT,FLOATV,FLOATV,FLOATV,FLOATV)
-#define NEWRO(A1,A2,A3,A4,A5,A6,A7,A8,A9) CCALLSFSUB9(NEWRO,newro,INT,INT,INT,FLOAT,PFLOAT,FLOATV,FLOATV,FLOATV,FLOATV,A1,A2,A3,A4,A5,A6,A7,A8,A9)
-
-PROTOCCALLSFSUB6(NMDCHL,nmdchl,INT,INT,PDOUBLE,DOUBLE,PDOUBLE,PDOUBLE)
-#define NMDCHL(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(NMDCHL,nmdchl,INT,INT,PDOUBLE,DOUBLE,PDOUBLE,PDOUBLE,A1,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFSUB8(NOCUT,nocut,INT,DOUBLEV,DOUBLEV,PDOUBLE,PINT,PINT,PDOUBLE,PINT)
-#define NOCUT(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(NOCUT,nocut,INT,DOUBLEV,DOUBLEV,PDOUBLE,PINT,PINT,PDOUBLE,PINT,A1,A2,A3,A4,A5,A6,A7,A8)
-
-PROTOCCALLSFSUB5(NODAUD,nodaud,PINT,INT,INT,INT,PINT)
-#define NODAUD(A1,A2,A3,A4,A5) CCALLSFSUB5(NODAUD,nodaud,PINT,INT,INT,INT,PINT,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB7(NORMCO,normco,PFLOAT,PFLOAT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT)
-#define NORMCO(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(NORMCO,normco,PFLOAT,PFLOAT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,A1,A2,A3,A4,A5,A6,A7)
-
-PROTOCCALLSFSUB2(NRAN,nran,PFLOAT,INT)
-#define NRAN(A1,A2) CCALLSFSUB2(NRAN,nran,PFLOAT,INT,A1,A2)
-
-PROTOCCALLSFSUB0(MINNEW,minnew)
-#define MINNEW() CCALLSFSUB0(MINNEW,minnew)
-
-PROTOCCALLSFSUB3(ORDRE2,ordre2,PFLOAT,PFLOAT,INT)
-#define ORDRE2(A1,A2,A3) CCALLSFSUB3(ORDRE2,ordre2,PFLOAT,PFLOAT,INT,A1,A2,A3)
-
-PROTOCCALLSFSUB7(ORTBAK,ortbak,INT,INT,INT,PFLOAT,PFLOAT,INT,PFLOAT)
-#define ORTBAK(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(ORTBAK,ortbak,INT,INT,INT,PFLOAT,PFLOAT,INT,PFLOAT,A1,A2,A3,A4,A5,A6,A7)
-
-PROTOCCALLSFSUB6(ORTHES,orthes,INT,INT,INT,INT,PFLOAT,PFLOAT)
-#define ORTHES(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(ORTHES,orthes,INT,INT,INT,INT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFSUB12(ORTHVC,orthvc,INT,INT,INTV,DOUBLEV,DOUBLE,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLE,PDOUBLE,PDOUBLE,PDOUBLE)
-#define ORTHVC(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12) CCALLSFSUB12(ORTHVC,orthvc,INT,INT,INTV,DOUBLEV,DOUBLE,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12)
-
-PROTOCCALLSFSUB7(ORTRAN,ortran,INT,INT,INT,INT,PFLOAT,PFLOAT,PFLOAT)
-#define ORTRAN(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(ORTRAN,ortran,INT,INT,INT,INT,PFLOAT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5,A6,A7)
-
-PROTOCCALLSFSUB2(PAPER,paper,INT,INT)
-#define PAPER(A1,A2) CCALLSFSUB2(PAPER,paper,INT,INT,A1,A2)
-
-PROTOCCALLSFSUB5(PARLSQ,parlsq,FLOATV,FLOATV,INT,PFLOAT,PFLOAT)
-#define PARLSQ(A1,A2,A3,A4,A5) CCALLSFSUB5(PARLSQ,parlsq,FLOATV,FLOATV,INT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB5(PARTN,partn,INT,FLOATV,FLOATV,FLOAT,INT)
-#define PARTN(A1,A2,A3,A4,A5) CCALLSFSUB5(PARTN,partn,INT,FLOATV,FLOATV,FLOAT,INT,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB2(PERMU,permu,PINT,INT)
-#define PERMU(A1,A2) CCALLSFSUB2(PERMU,permu,PINT,INT,A1,A2)
-
-PROTOCCALLSFSUB6(PGRAPH,pgraph,PINT,INT,INT,PINT,INT,PINT)
-#define PGRAPH(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(PGRAPH,pgraph,PINT,INT,INT,PINT,INT,PINT,A1,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFSUB12(PIVOT,pivot,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,INT,INT,INT,INT,INT,PINT,PINT,FLOAT)
-#define PIVOT(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12) CCALLSFSUB12(PIVOT,pivot,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,INT,INT,INT,INT,INT,PINT,PINT,FLOAT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12)
-
-PROTOCCALLSFSUB3(POISSN,poissn,FLOAT,PINT,PINT)
-#define POISSN(A1,A2,A3) CCALLSFSUB3(POISSN,poissn,FLOAT,PINT,PINT,A1,A2,A3)
-
-PROTOCCALLSFSUB7(POLROT,polrot,FLOAT,FLOAT,PFLOAT,PFLOAT,FLOAT,FLOAT,FLOAT)
-#define POLROT(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(POLROT,polrot,FLOAT,FLOAT,PFLOAT,PFLOAT,FLOAT,FLOAT,FLOAT,A1,A2,A3,A4,A5,A6,A7)
-
-PROTOCCALLSFSUB3(PRIPAR,pripar,FLOATV,FLOATV,PFLOAT)
-#define PRIPAR(A1,A2,A3) CCALLSFSUB3(PRIPAR,pripar,FLOATV,FLOATV,PFLOAT,A1,A2,A3)
-
-PROTOCCALLSFSUB5(PROC1,proc1,PFLOAT,PFLOAT,INT,INT,INT)
-#define PROC1(A1,A2,A3,A4,A5) CCALLSFSUB5(PROC1,proc1,PFLOAT,PFLOAT,INT,INT,INT,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB3(QFUNCT,qfunct,FLOAT,PFLOAT,PFLOAT)
-#define QFUNCT(A1,A2,A3) CCALLSFSUB3(QFUNCT,qfunct,FLOAT,PFLOAT,PFLOAT,A1,A2,A3)
-
-PROTOCCALLSFSUB4(QUASI,quasi,PFLOAT,INT,INT,INT)
-#define QUASI(A1,A2,A3,A4) CCALLSFSUB4(QUASI,quasi,PFLOAT,INT,INT,INT,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB4(RAN3D,ran3d,PFLOAT,PFLOAT,PFLOAT,FLOAT)
-#define RAN3D(A1,A2,A3,A4) CCALLSFSUB4(RAN3D,ran3d,PFLOAT,PFLOAT,PFLOAT,FLOAT,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB2(RANUMS,ranums,PFLOAT,INT)
-#define RANUMS(A1,A2) CCALLSFSUB2(RANUMS,ranums,PFLOAT,INT,A1,A2)
-
-PROTOCCALLSFSUB12(RATQR,ratqr,INT,FLOAT,FLOATV,FLOATV,PFLOAT,INT,PFLOAT,PINT,PFLOAT,LOGICAL,INT,PINT)
-#define RATQR(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12) CCALLSFSUB12(RATQR,ratqr,INT,FLOAT,FLOATV,FLOATV,PFLOAT,INT,PFLOAT,PINT,PFLOAT,LOGICAL,INT,PINT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12)
-
-PROTOCCALLSFSUB5(RCA,rca,INT,FLOATV,INT,PFLOAT,INT)
-#define RCA(A1,A2,A3,A4,A5) CCALLSFSUB5(RCA,rca,INT,FLOATV,INT,PFLOAT,INT,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB3(RCHPWS,rchpws,INT,FLOAT,FLOAT)
-#define RCHPWS(A1,A2,A3) CCALLSFSUB3(RCHPWS,rchpws,INT,FLOAT,FLOAT,A1,A2,A3)
-
-PROTOCCALLSFSUB10(RCSPLN,rcspln,INT,FLOAT,INT,FLOAT,INT,INT,FLOAT,FLOAT,FLOAT,FLOAT)
-#define RCSPLN(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10) CCALLSFSUB10(RCSPLN,rcspln,INT,FLOAT,INT,FLOAT,INT,INT,FLOAT,FLOAT,FLOAT,FLOAT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10)
-
-PROTOCCALLSFSUB10(DCSPLN,dcspln,INT,DOUBLEV,INT,PDOUBLE,INT,INT,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE)
-#define DCSPLN(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10) CCALLSFSUB10(DCSPLN,dcspln,INT,DOUBLEV,INT,PDOUBLE,INT,INT,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10)
-
-PROTOCCALLSFSUB12(RECPAR,recpar,INT,PFLOAT,PFLOAT,FLOAT,FLOAT,INT,PINT,PINT,FLOATV,PINT,FLOATV,INT)
-#define RECPAR(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12) CCALLSFSUB12(RECPAR,recpar,INT,PFLOAT,PFLOAT,FLOAT,FLOAT,INT,PINT,PINT,FLOATV,PINT,FLOATV,INT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12)
-
-PROTOCCALLSFSUB8(RFRDH1,rfrdh1,FLOAT,FLOAT,INT,FLOAT,INT,FLOAT,INT,INT)
-#define RFRDH1(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(RFRDH1,rfrdh1,FLOAT,FLOAT,INT,FLOAT,INT,FLOAT,INT,INT,A1,A2,A3,A4,A5,A6,A7,A8)
-
-PROTOCCALLSFSUB8(DFRDH1,dfrdh1,DOUBLE,DOUBLE,INT,DOUBLEV,INTV,PDOUBLE,INT,PINT)
-#define DFRDH1(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(DFRDH1,dfrdh1,DOUBLE,DOUBLE,INT,DOUBLEV,INTV,PDOUBLE,INT,PINT,A1,A2,A3,A4,A5,A6,A7,A8)
-
-PROTOCCALLSFSUB6(RFT,rft,INT,FLOATV,INT,FLOATV,INT,INT)
-#define RFT(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(RFT,rft,INT,FLOATV,INT,FLOATV,INT,INT,A1,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFSUB1(RIWIAD,riwiad,DOUBLE)
-#define RIWIAD(A1) CCALLSFSUB1(RIWIAD,riwiad,DOUBLE,A1)
-
-PROTOCCALLSFSUB0(RIWIBD,riwibd)
-#define RIWIBD() CCALLSFSUB0(RIWIBD,riwibd)
-
-PROTOCCALLSFSUB7(DRKNYS,drknys,INT,DOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,DOUBLE,PDOUBLE)
-#define DRKNYS(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(DRKNYS,drknys,INT,DOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,DOUBLE,PDOUBLE,A1,A2,A3,A4,A5,A6,A7)
-
-PROTOCCALLSFSUB7(RKNYS,rknys,INT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT)
-#define RKNYS(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(RKNYS,rknys,INT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,A1,A2,A3,A4,A5,A6,A7)
-
-PROTOCCALLSFSUB6(RKSTP,rkstp,INT,FLOAT,PFLOAT,PFLOAT,FLOAT,PFLOAT)
-#define RKSTP(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(RKSTP,rkstp,INT,FLOAT,PFLOAT,PFLOAT,FLOAT,PFLOAT,A1,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFSUB6(DRKSTP,drkstp,INT,DOUBLE,PDOUBLE,PDOUBLE,DOUBLE,PDOUBLE)
-#define DRKSTP(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(DRKSTP,drkstp,INT,DOUBLE,PDOUBLE,PDOUBLE,DOUBLE,PDOUBLE,A1,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFSUB3(RLEN,rlen,INT,DOUBLEV,PDOUBLE)
-#define RLEN(A1,A2,A3) CCALLSFSUB3(RLEN,rlen,INT,DOUBLEV,PDOUBLE,A1,A2,A3)
-
-PROTOCCALLSFSUB4(RMULLZ,rmullz,FLOAT,INT,INT,FLOAT)
-#define RMULLZ(A1,A2,A3,A4) CCALLSFSUB4(RMULLZ,rmullz,FLOAT,INT,INT,FLOAT,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB5(DGSET,dgset,DOUBLE,DOUBLE,INT,DOUBLEV,DOUBLEV)
-#define DGSET(A1,A2,A3,A4,A5) CCALLSFSUB5(DGSET,dgset,DOUBLE,DOUBLE,INT,DOUBLEV,DOUBLEV,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB5(ROTATE,rotate,PFLOAT,PFLOAT,FLOAT,FLOAT,INT)
-#define ROTATE(A1,A2,A3,A4,A5) CCALLSFSUB5(ROTATE,rotate,PFLOAT,PFLOAT,FLOAT,FLOAT,INT,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB5(RPA,rpa,INT,FLOATV,INT,PFLOAT,INT)
-#define RPA(A1,A2,A3,A4,A5) CCALLSFSUB5(RPA,rpa,INT,FLOATV,INT,PFLOAT,INT,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB5(RPS,rps,INT,FLOATV,INT,PFLOAT,INT)
-#define RPS(A1,A2,A3,A4,A5) CCALLSFSUB5(RPS,rps,INT,FLOATV,INT,PFLOAT,INT,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB5(RSA,rsa,INT,FLOATV,INT,PFLOAT,INT)
-#define RSA(A1,A2,A3,A4,A5) CCALLSFSUB5(RSA,rsa,INT,FLOATV,INT,PFLOAT,INT,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB15(RSMPLX,rsmplx,FLOAT,FLOAT,FLOAT,FLOAT,INT,INT,INT,INT,INT,INT,INT,FLOAT,FLOAT,FLOAT,INT)
-#define RSMPLX(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15) CCALLSFSUB15(RSMPLX,rsmplx,FLOAT,FLOAT,FLOAT,FLOAT,INT,INT,INT,INT,INT,INT,INT,FLOAT,FLOAT,FLOAT,INT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15)
-
-PROTOCCALLSFSUB9(RSRTNT,rsrtnt,INT,INT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,PFLOAT,LOGICAL)
-#define RSRTNT(A1,A2,A3,A4,A5,A6,A7,A8,A9) CCALLSFSUB9(RSRTNT,rsrtnt,INT,INT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,PFLOAT,LOGICAL,A1,A2,A3,A4,A5,A6,A7,A8,A9)
-
-PROTOCCALLSFSUB9(DSRTNT,dsrtnt,INT,INT,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,PDOUBLE,PLOGICAL)
-#define DSRTNT(A1,A2,A3,A4,A5,A6,A7,A8,A9) CCALLSFSUB9(DSRTNT,dsrtnt,INT,INT,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,PDOUBLE,PLOGICAL,A1,A2,A3,A4,A5,A6,A7,A8,A9)
-
-PROTOCCALLSFSUB5(RTEQ3,rteq3,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT)
-#define RTEQ3(A1,A2,A3,A4,A5) CCALLSFSUB5(RTEQ3,rteq3,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB5(DRTEQ3,drteq3,DOUBLE,DOUBLE,DOUBLE,PDOUBLE,PDOUBLE)
-#define DRTEQ3(A1,A2,A3,A4,A5) CCALLSFSUB5(DRTEQ3,drteq3,DOUBLE,DOUBLE,DOUBLE,PDOUBLE,PDOUBLE,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB7(RTEQ4,rteq4,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,INT)
-#define RTEQ4(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(RTEQ4,rteq4,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,INT,A1,A2,A3,A4,A5,A6,A7)
-
-PROTOCCALLSFSUB2(S128,s128,FLOATV,PFLOAT)
-#define S128(A1,A2) CCALLSFSUB2(S128,s128,FLOATV,PFLOAT,A1,A2)
-
-PROTOCCALLSFSUB2(S256,s256,FLOATV,PFLOAT)
-#define S256(A1,A2) CCALLSFSUB2(S256,s256,FLOATV,PFLOAT,A1,A2)
-
-PROTOCCALLSFSUB2(S512,s512,FLOATV,PFLOAT)
-#define S512(A1,A2) CCALLSFSUB2(S512,s512,FLOATV,PFLOAT,A1,A2)
-
-PROTOCCALLSFSUB2(S64,s64,FLOATV,PFLOAT)
-#define S64(A1,A2) CCALLSFSUB2(S64,s64,FLOATV,PFLOAT,A1,A2)
-
-PROTOCCALLSFSUB2(SCAL,scal,INT,PFLOAT)
-#define SCAL(A1,A2) CCALLSFSUB2(SCAL,scal,INT,PFLOAT,A1,A2)
-
-PROTOCCALLSFSUB4(SCATTER,scatter,INT,PFLOAT,INTV,FLOATV)
-#define SCATTER(A1,A2,A3,A4) CCALLSFSUB4(SCATTER,scatter,INT,PFLOAT,INTV,FLOATV,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB8(SETTOL,settol,INT,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PINT,PINT)
-#define SETTOL(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(SETTOL,settol,INT,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PINT,PINT,A1,A2,A3,A4,A5,A6,A7,A8)
-
-PROTOCCALLSFSUB8(SETUP,setup,FLOAT,INT,FLOAT,INT,FLOAT,INT,FLOAT,INT)
-#define SETUP(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(SETUP,setup,FLOAT,INT,FLOAT,INT,FLOAT,INT,FLOAT,INT,A1,A2,A3,A4,A5,A6,A7,A8)
-
-PROTOCCALLSFSUB2(SGZ,sgz,INT,PFLOAT)
-#define SGZ(A1,A2) CCALLSFSUB2(SGZ,sgz,INT,PFLOAT,A1,A2)
-
-PROTOCCALLSFSUB5(SHRNK,shrnk,INT,INT,PDOUBLE,INT,PDOUBLE)
-#define SHRNK(A1,A2,A3,A4,A5) CCALLSFSUB5(SHRNK,shrnk,INT,INT,PDOUBLE,INT,PDOUBLE,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB12(SIMPLE,simple,PDOUBLE,DOUBLEV,DOUBLEV,DOUBLE,INTV,INT,INTV,INTV,INTV,PDOUBLE,INT,INT)
-#define SIMPLE(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12) CCALLSFSUB12(SIMPLE,simple,PDOUBLE,DOUBLEV,DOUBLEV,DOUBLE,INTV,INT,INTV,INTV,INTV,PDOUBLE,INT,INT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12)
-
-PROTOCCALLSFSUB8(SLV,slv,INT,INT,PFLOAT,FLOATV,INTV,PFLOAT,PFLOAT,PFLOAT)
-#define SLV(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(SLV,slv,INT,INT,PFLOAT,FLOATV,INTV,PFLOAT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5,A6,A7,A8)
-
-PROTOCCALLSFSUB10(SNLEQ,snleq,INT,FLOAT,FLOAT,FLOAT,FLOAT,INT,INT,INT,FLOAT,FLOAT)
-#define SNLEQ(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10) CCALLSFSUB10(SNLEQ,snleq,INT,FLOAT,FLOAT,FLOAT,FLOAT,INT,INT,INT,FLOAT,FLOAT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10)
-
-PROTOCCALLSFSUB10(DSNLEQ,dsnleq,INT,PDOUBLE,PDOUBLE,DOUBLE,DOUBLE,INT,INT,PINT,DOUBLE,PDOUBLE)
-#define DSNLEQ(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10) CCALLSFSUB10(DSNLEQ,dsnleq,INT,PDOUBLE,PDOUBLE,DOUBLE,DOUBLE,INT,INT,PINT,DOUBLE,PDOUBLE,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10)
-
-PROTOCCALLSFSUB4(SORTDQ,sortdq,PDOUBLE,INT,INT,INT)
-#define SORTDQ(A1,A2,A3,A4) CCALLSFSUB4(SORTDQ,sortdq,PDOUBLE,INT,INT,INT,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB4(SORTIQ,sortiq,PINT,INT,INT,INT)
-#define SORTIQ(A1,A2,A3,A4) CCALLSFSUB4(SORTIQ,sortiq,PINT,INT,INT,INT,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB4(SORTRQ,sortrq,PFLOAT,INT,INT,INT)
-#define SORTRQ(A1,A2,A3,A4) CCALLSFSUB4(SORTRQ,sortrq,PFLOAT,INT,INT,INT,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB5(SPLAN0,splan0,PDOUBLE,DOUBLE,DOUBLE,DOUBLE,INT)
-#define SPLAN0(A1,A2,A3,A4,A5) CCALLSFSUB5(SPLAN0,splan0,PDOUBLE,DOUBLE,DOUBLE,DOUBLE,INT,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB6(SPLAN1,splan1,PDOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,INT)
-#define SPLAN1(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(SPLAN1,splan1,PDOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,INT,A1,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFSUB7(SPLAN2,splan2,PDOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,INT)
-#define SPLAN2(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(SPLAN2,splan2,PDOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,INT,A1,A2,A3,A4,A5,A6,A7)
-
-PROTOCCALLSFSUB8(SPLAN3,splan3,PDOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,INT)
-#define SPLAN3(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(SPLAN3,splan3,PDOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,INT,A1,A2,A3,A4,A5,A6,A7,A8)
-
-PROTOCCALLSFSUB15(SPLAS1,splas1,INT,INT,INT,INT,DOUBLEV,DOUBLEV,INT,PDOUBLE,PDOUBLE,DOUBLEV,PDOUBLE,PDOUBLE,INT,DOUBLEV,PINT)
-#define SPLAS1(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15) CCALLSFSUB15(SPLAS1,splas1,INT,INT,INT,INT,DOUBLEV,DOUBLEV,INT,PDOUBLE,PDOUBLE,DOUBLEV,PDOUBLE,PDOUBLE,INT,DOUBLEV,PINT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15)
-
-PROTOCCALLSFSUB26(SPLAS2,splas2,INT,INT,INT,INT,INT,INT,INT,INT,INT,INT,INT,INT,DOUBLEV,DOUBLEV,PDOUBLE,INT,PDOUBLE,PDOUBLE,PDOUBLE,DOUBLEV,PDOUBLE,DOUBLEV,DOUBLEV,INT,PDOUBLE,INT)
-#define SPLAS2(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15,A16,A17,A18,A19,A20,A21,A22,A23,A24,A25,A26) CCALLSFSUB26(SPLAS2,splas2,INT,INT,INT,INT,INT,INT,INT,INT,INT,INT,INT,INT,DOUBLEV,DOUBLEV,PDOUBLE,INT,PDOUBLE,PDOUBLE,PDOUBLE,DOUBLEV,PDOUBLE,DOUBLEV,DOUBLEV,INT,PDOUBLE,INT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15,A16,A17,A18,A19,A20,A21,A22,A23,A24,A25,A26)
-
-PROTOCCALLSFSUB11(SPLIN3,splin3,FLOATV,FLOATV,PFLOAT,INT,INT,FLOATV,PFLOAT,PFLOAT,INT,INT,INT)
-#define SPLIN3(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11) CCALLSFSUB11(SPLIN3,splin3,FLOATV,FLOATV,PFLOAT,INT,INT,FLOATV,PFLOAT,PFLOAT,INT,INT,INT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11)
-
-PROTOCCALLSFSUB10(SPLIT,split,INT,FLOATV,FLOATV,FLOAT,FLOAT,PLOGICAL,PINT,PFLOAT,PFLOAT,INT)
-#define SPLIT(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10) CCALLSFSUB10(SPLIT,split,INT,FLOATV,FLOATV,FLOAT,FLOAT,PLOGICAL,PINT,PFLOAT,PFLOAT,INT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10)
-
-PROTOCCALLSFSUB17(SPLX,splx,PDOUBLE,DOUBLEV,DOUBLEV,DOUBLE,INT,INT,INT,INT,INT,PINT,PINT,PINT,PINT,PINT,DOUBLEV,DOUBLEV,PINT)
-#define SPLX(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15,A16,A17) CCALLSFSUB17(SPLX,splx,PDOUBLE,DOUBLEV,DOUBLEV,DOUBLE,INT,INT,INT,INT,INT,PINT,PINT,PINT,PINT,PINT,DOUBLEV,DOUBLEV,PINT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15,A16,A17)
-
-PROTOCCALLSFSUB3(SPXINV,spxinv,PFLOAT,INT,PINT)
-#define SPXINV(A1,A2,A3) CCALLSFSUB3(SPXINV,spxinv,PFLOAT,INT,PINT,A1,A2,A3)
-
-PROTOCCALLSFSUB10(SVD,svd,PFLOAT,PFLOAT,PFLOAT,INT,INT,INT,INT,INT,LOGICAL,LOGICAL)
-#define SVD(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10) CCALLSFSUB10(SVD,svd,PFLOAT,PFLOAT,PFLOAT,INT,INT,INT,INT,INT,LOGICAL,LOGICAL,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10)
-
-PROTOCCALLSFSUB4(SYNT,synt,INT,INT,INT,PFLOAT)
-#define SYNT(A1,A2,A3,A4) CCALLSFSUB4(SYNT,synt,INT,INT,INT,PFLOAT,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB7(TAYCHD,taychd,DOUBLE,DOUBLE,DOUBLEV,PDOUBLE,INT,INT,PDOUBLE)
-#define TAYCHD(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(TAYCHD,taychd,DOUBLE,DOUBLE,DOUBLEV,PDOUBLE,INT,INT,PDOUBLE,A1,A2,A3,A4,A5,A6,A7)
-
-PROTOCCALLSFSUB15(TINVIT,tinvit,INT,INT,FLOATV,FLOATV,FLOATV,INT,FLOATV,INTV,PFLOAT,PINT,PFLOAT,PFLOAT,PFLOAT,PFLOAT,PFLOAT)
-#define TINVIT(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15) CCALLSFSUB15(TINVIT,tinvit,INT,INT,FLOATV,FLOATV,FLOATV,INT,FLOATV,INTV,PFLOAT,PINT,PFLOAT,PFLOAT,PFLOAT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15)
-
-PROTOCCALLSFSUB5(TKOLMO,tkolmo,FLOATV,INT,FLOATV,INT,PFLOAT)
-#define TKOLMO(A1,A2,A3,A4,A5) CCALLSFSUB5(TKOLMO,tkolmo,FLOATV,INT,FLOATV,INT,PFLOAT,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB4(TQL1,tql1,INT,PFLOAT,PFLOAT,PINT)
-#define TQL1(A1,A2,A3,A4) CCALLSFSUB4(TQL1,tql1,INT,PFLOAT,PFLOAT,PINT,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB6(TQL2,tql2,INT,INT,PFLOAT,PFLOAT,PFLOAT,PINT)
-#define TQL2(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(TQL2,tql2,INT,INT,PFLOAT,PFLOAT,PFLOAT,PINT,A1,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFSUB4(TRANSD,transd,DOUBLEV,PDOUBLE,INT,DOUBLEV)
-#define TRANSD(A1,A2,A3,A4) CCALLSFSUB4(TRANSD,transd,DOUBLEV,PDOUBLE,INT,DOUBLEV,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB8(TRAPER,traper,FLOATV,FLOATV,FLOATV,INT,FLOAT,FLOAT,PFLOAT,PFLOAT)
-#define TRAPER(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(TRAPER,traper,FLOATV,FLOATV,FLOATV,INT,FLOAT,FLOAT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5,A6,A7,A8)
-
-PROTOCCALLSFSUB6(TRBAK1,trbak1,INT,INT,PFLOAT,FLOATV,INT,PFLOAT)
-#define TRBAK1(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(TRBAK1,trbak1,INT,INT,PFLOAT,FLOATV,INT,PFLOAT,A1,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFSUB0(TRDZ,trdz)
-#define TRDZ() CCALLSFSUB0(TRDZ,trdz)
-
-PROTOCCALLSFSUB5(TREAUD,treaud,PINT,INT,PINT,INT,PINT)
-#define TREAUD(A1,A2,A3,A4,A5) CCALLSFSUB5(TREAUD,treaud,PINT,INT,PINT,INT,PINT,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB6(TRED1,tred1,INT,INT,PFLOAT,PFLOAT,PFLOAT,PFLOAT)
-#define TRED1(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(TRED1,tred1,INT,INT,PFLOAT,PFLOAT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFSUB6(TRED2,tred2,INT,INT,PFLOAT,PFLOAT,PFLOAT,PFLOAT)
-#define TRED2(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(TRED2,tred2,INT,INT,PFLOAT,PFLOAT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFSUB1(TREDMP,tredmp,INT)
-#define TREDMP(A1) CCALLSFSUB1(TREDMP,tredmp,INT,A1)
-
-PROTOCCALLSFSUB5(TREVNI,trevni,INTV,INT,PINT,INT,PINT)
-#define TREVNI(A1,A2,A3,A4,A5) CCALLSFSUB5(TREVNI,trevni,INTV,INT,PINT,INT,PINT,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB7(TRICOF,tricof,PFLOAT,INT,PFLOAT,INT,PFLOAT,INT,INT)
-#define TRICOF(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(TRICOF,tricof,PFLOAT,INT,PFLOAT,INT,PFLOAT,INT,INT,A1,A2,A3,A4,A5,A6,A7)
-
-PROTOCCALLSFSUB11(TSTEXT,tstext,INT,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLE,DOUBLE,PINT,INT,PINT,PDOUBLE,PDOUBLE)
-#define TSTEXT(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11) CCALLSFSUB11(TSTEXT,tstext,INT,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLE,DOUBLE,PINT,INT,PINT,PDOUBLE,PDOUBLE,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11)
-
-PROTOCCALLSFSUB19(TSTURM,tsturm,INT,INT,FLOAT,FLOATV,FLOATV,PFLOAT,PFLOAT,PFLOAT,INT,PINT,PFLOAT,PFLOAT,PINT,PFLOAT,PFLOAT,PFLOAT,PFLOAT,PFLOAT,PFLOAT)
-#define TSTURM(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15,A16,A17,A18,A19) CCALLSFSUB19(TSTURM,tsturm,INT,INT,FLOAT,FLOATV,FLOATV,PFLOAT,PFLOAT,PFLOAT,INT,PINT,PFLOAT,PFLOAT,PINT,PFLOAT,PFLOAT,PFLOAT,PFLOAT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15,A16,A17,A18,A19)
-
-PROTOCCALLSFSUB3(TUP,tup,INTV,INT,INT)
-#define TUP(A1,A2,A3) CCALLSFSUB3(TUP,tup,INTV,INT,INT,A1,A2,A3)
-
-PROTOCCALLSFSUB3(U100DV,u100dv,INTV,INTV,PINT)
-#define U100DV(A1,A2,A3) CCALLSFSUB3(U100DV,u100dv,INTV,INTV,PINT,A1,A2,A3)
-
-PROTOCCALLSFSUB2(U100FC,u100fc,INT,PINT)
-#define U100FC(A1,A2) CCALLSFSUB2(U100FC,u100fc,INT,PINT,A1,A2)
-
-PROTOCCALLSFSUB3(U100PM,u100pm,INTV,PINT,PINT)
-#define U100PM(A1,A2,A3) CCALLSFSUB3(U100PM,u100pm,INTV,PINT,PINT,A1,A2,A3)
-
-PROTOCCALLSFSUB3(U100PR,u100pr,PINT,PINT,PINT)
-#define U100PR(A1,A2,A3) CCALLSFSUB3(U100PR,u100pr,PINT,PINT,PINT,A1,A2,A3)
-
-PROTOCCALLSFSUB6(USRINT,usrint,FLOAT,FLOAT,INT,FLOAT,INT,FLOAT)
-#define USRINT(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(USRINT,usrint,FLOAT,FLOAT,INT,FLOAT,INT,FLOAT,A1,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFSUB3(VAVSET,vavset,FLOAT,FLOAT,INT)
-#define VAVSET(A1,A2,A3) CCALLSFSUB3(VAVSET,vavset,FLOAT,FLOAT,INT,A1,A2,A3)
-
-PROTOCCALLSFSUB6(VAVZRO,vavzro,FLOAT,FLOAT,PFLOAT,FLOAT,FLOAT,INT)
-#define VAVZRO(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(VAVZRO,vavzro,FLOAT,FLOAT,PFLOAT,FLOAT,FLOAT,INT,A1,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFSUB7(VD01A,vd01a,PINT,PFLOAT,PFLOAT,INT,FLOAT,FLOAT,FLOAT)
-#define VD01A(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(VD01A,vd01a,PINT,PFLOAT,PFLOAT,INT,FLOAT,FLOAT,FLOAT,A1,A2,A3,A4,A5,A6,A7)
-
-PROTOCCALLSFSUB5(VVISET,vviset,FLOAT,FLOAT,INT,PFLOAT,PFLOAT)
-#define VVISET(A1,A2,A3,A4,A5) CCALLSFSUB5(VVISET,vviset,FLOAT,FLOAT,INT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB6(WHENEQ,wheneq,INT,INTV,INT,INT,PINT,PINT)
-#define WHENEQ(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(WHENEQ,wheneq,INT,INTV,INT,INT,PINT,PINT,A1,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFSUB6(WHENFGE,whenfge,INT,FLOATV,INT,FLOAT,PINT,PINT)
-#define WHENFGE(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(WHENFGE,whenfge,INT,FLOATV,INT,FLOAT,PINT,PINT,A1,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFSUB6(WHENFGT,whenfgt,INT,FLOATV,INT,FLOAT,PINT,PINT)
-#define WHENFGT(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(WHENFGT,whenfgt,INT,FLOATV,INT,FLOAT,PINT,PINT,A1,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFSUB6(WHENFLE,whenfle,INT,FLOATV,INT,FLOAT,PINT,PINT)
-#define WHENFLE(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(WHENFLE,whenfle,INT,FLOATV,INT,FLOAT,PINT,PINT,A1,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFSUB6(WHENFLT,whenflt,INT,FLOATV,INT,FLOAT,PINT,PINT)
-#define WHENFLT(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(WHENFLT,whenflt,INT,FLOATV,INT,FLOAT,PINT,PINT,A1,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFSUB6(WHENIGE,whenige,INT,INTV,INT,INT,PINT,PINT)
-#define WHENIGE(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(WHENIGE,whenige,INT,INTV,INT,INT,PINT,PINT,A1,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFSUB6(WHENIGT,whenigt,INT,INTV,INT,INT,PINT,PINT)
-#define WHENIGT(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(WHENIGT,whenigt,INT,INTV,INT,INT,PINT,PINT,A1,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFSUB6(WHENILE,whenile,INT,INTV,INT,INT,PINT,PINT)
-#define WHENILE(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(WHENILE,whenile,INT,INTV,INT,INT,PINT,PINT,A1,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFSUB6(WHENILT,whenilt,INT,INTV,INT,INT,PINT,PINT)
-#define WHENILT(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(WHENILT,whenilt,INT,INTV,INT,INT,PINT,PINT,A1,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFSUB6(WHENNE,whenne,INT,INTV,INT,INT,PINT,PINT)
-#define WHENNE(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(WHENNE,whenne,INT,INTV,INT,INT,PINT,PINT,A1,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFSUB6(ZEROX,zerox,FLOAT,FLOAT,FLOAT,INT,FLOAT,INT)
-#define ZEROX(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(ZEROX,zerox,FLOAT,FLOAT,FLOAT,INT,FLOAT,INT,A1,A2,A3,A4,A5,A6)
diff --git a/src/cfortran/graflib.h b/src/cfortran/graflib.h
deleted file mode 100644
index 27c2612..0000000
--- a/src/cfortran/graflib.h
+++ /dev/null
@@ -1,2 +0,0 @@
-#include "higz.h"
-#include "hplot.h"
diff --git a/src/cfortran/hbook.h b/src/cfortran/hbook.h
deleted file mode 100644
index 0db42dd..0000000
--- a/src/cfortran/hbook.h
+++ /dev/null
@@ -1,569 +0,0 @@
-/*
- Corrections:
- 14-Dec-98 OC The definition of HFITHN was wrong
- 11-Dec-98 OC mods in HUNPAK HUNPKE HREBIN: PFLOAT is now FLOATV
- 02-Feb-98 OC mods for HBNAME
- 30-Jan-98 OC HID1 HID2 were not correct
- 30-Jan-98 OC HRENDC added
- 15-Feb-94 GF HGIVE correct output args
- HGIVEN idem
- 18-Feb-94 GF comment headers for routines with more than 10 Arguments
- and break long lines by \ (for the VAX)
- -------------above carried over from previous file on 15-Mar-94
- 11-Apr-94 GF remove ALL occurences of ZTRING (these are not used so far)
- correct HOPEN, HROUT calls
- 21-Apr-94 GF restore PROTOCCALLSFFUNi lines for functions.
- 18-May-94 GF correct passing of external functions, must use ROUTINE
- further comments kept in RCS/CVS
- 12-Apr-95 GF delete all non documented routines; this should give a more
- version for this file.
----------------------------------------
-*/
-
-PROTOCCALLSFSUB3(HARRAY,harray,INT,INT,PINT)
-#define HARRAY(A1,A2,A3) CCALLSFSUB3(HARRAY,harray,INT,INT,PINT,A1,A2,A3)
-
-PROTOCCALLSFSUB4(HBANDX,hbandx,INT,FLOAT,FLOAT,FLOAT)
-#define HBANDX(A1,A2,A3,A4) CCALLSFSUB4(HBANDX,hbandx,INT,FLOAT,FLOAT,FLOAT,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB4(HBANDY,hbandy,INT,FLOAT,FLOAT,FLOAT)
-#define HBANDY(A1,A2,A3,A4) CCALLSFSUB4(HBANDY,hbandy,INT,FLOAT,FLOAT,FLOAT,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB1(HBARX,hbarx,INT)
-#define HBARX(A1) CCALLSFSUB1(HBARX,hbarx,INT,A1)
-
-PROTOCCALLSFSUB1(HBARY,hbary,INT)
-#define HBARY(A1) CCALLSFSUB1(HBARY,hbary,INT,A1)
-
-PROTOCCALLSFSUB6(HBFUN1,hbfun1,INT,STRING,INT,FLOAT,FLOAT,ROUTINE)
-#define HBFUN1(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(HBFUN1,hbfun1,INT,STRING,INT,FLOAT,FLOAT,ROUTINE,A1,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFSUB9(HBFUN2,hbfun2,INT,STRING,INT,FLOAT,FLOAT,INT,FLOAT,FLOAT,ROUTINE)
-#define HBFUN2(A1,A2,A3,A4,A5,A6,A7,A8,A9) CCALLSFSUB9(HBFUN2,hbfun2,INT,STRING,INT,FLOAT,FLOAT,INT,FLOAT,FLOAT,ROUTINE,A1,A2,A3,A4,A5,A6,A7,A8,A9)
-
-PROTOCCALLSFSUB2(HBIGBI,hbigbi,INT,INT)
-#define HBIGBI(A1,A2) CCALLSFSUB2(HBIGBI,hbigbi,INT,INT,A1,A2)
-
-PROTOCCALLSFSUB2(HRENID,hrenid,INT,INT)
-#define HRENID(A1,A2) CCALLSFSUB2(HRENID,hrenid,INT,INT,A1,A2)
-
-PROTOCCALLSFSUB1(HBINSZ,hbinsz,STRING)
-#define HBINSZ(A1) CCALLSFSUB1(HBINSZ,hbinsz,STRING,A1)
-
-PROTOCCALLSFSUB4(HBNAMC,hbnamc,INT,STRING,PSTRINGV,STRING)
-#define HBNAMC(A1,A2,A3,A4) CCALLSFSUB4(HBNAMC,hbnamc,INT,STRING,PSTRINGV,STRING,A1,A2,A3,A4)
-
-#ifndef PSTRUCT_cfV
-#define PSTRUCT_cfV( T,A,B,F) SIMPLE_cfV(T,A,B,F)
-#define PSTRUCT_cfSEP(T, B) SIMPLE_cfSEP(T,B)
-#define PSTRUCT_cfINT(N,A,B,X,Y,Z) SIMPLE_cfINT(N,A,B,X,Y,Z)
-#define PSTRUCT_cfSTR(N,T,A,B,C,D,E) SIMPLE_cfSTR(N,T,A,B,C,D,E)
-#define PSTRUCT_cfCC( T,A,B) SIMPLE_cfCC(T,A,B)
-#define PSTRUCT_cfAA( T,A,B) PSTRUCT_cfB(T,A) /* Argument B not used. */
-#define PSTRUCT_cfU( T,A) PSTRUCT_cfN(T,A)
-#define PSTRUCT_cfN( T,A) void *A
-#define PSTRUCT_cfB( T,A) (void *) &(A)
-#endif
-
-PROTOCCALLSFSUB4(HBNAME,hbname,INT,STRING,PSTRUCT,STRING)
-#define HBNAME(A1,A2,A3,A4) CCALLSFSUB4(HBNAME,hbname,INT,STRING,PSTRUCT,STRING,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB3(HBNT,hbnt,INT,STRING,STRING)
-#define HBNT(A1,A2,A3) CCALLSFSUB3(HBNT,hbnt,INT,STRING,STRING,A1,A2,A3)
-
-PROTOCCALLSFSUB5(HNTDUP,hntdup,INT,INT,INT,STRING,STRING)
-#define HNTDUP(A1,A2,A3,A4,A5) CCALLSFSUB5(HNTDUP,hntdup,INT,INT,INT,STRING,STRING,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB5(HBOOKB,hbookb,INT,STRING,INT,FLOATV,FLOAT)
-#define HBOOKB(A1,A2,A3,A4,A5) CCALLSFSUB5(HBOOKB,hbookb,INT,STRING,INT,FLOATV,FLOAT,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB6(HBOOKN,hbookn,INT,STRING,INT,STRING,INT,STRINGV)
-#define HBOOKN(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(HBOOKN,hbookn,INT,STRING,INT,STRING,INT,STRINGV,A1,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFSUB6(HBOOK1,hbook1,INT,STRING,INT,FLOAT,FLOAT,FLOAT)
-#define HBOOK1(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(HBOOK1,hbook1,INT,STRING,INT,FLOAT,FLOAT,FLOAT,A1,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFSUB9(HBOOK2,hbook2,INT,STRING,INT,FLOAT,FLOAT,INT,FLOAT,FLOAT,FLOAT)
-#define HBOOK2(A1,A2,A3,A4,A5,A6,A7,A8,A9) CCALLSFSUB9(HBOOK2,hbook2,INT,STRING,INT,FLOAT,FLOAT,INT,FLOAT,FLOAT,FLOAT,A1,A2,A3,A4,A5,A6,A7,A8,A9)
-
-PROTOCCALLSFSUB2(HBPRO,hbpro,INT,FLOAT)
-#define HBPRO(A1,A2) CCALLSFSUB2(HBPRO,hbpro,INT,FLOAT,A1,A2)
-
-PROTOCCALLSFSUB8(HBPROF,hbprof,INT,STRING,INT,FLOAT,FLOAT,FLOAT,FLOAT,STRING)
-#define HBPROF(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(HBPROF,hbprof,INT,STRING,INT,FLOAT,FLOAT,FLOAT,FLOAT,STRING,A1,A2,A3,A4,A5,A6,A7,A8)
-
-PROTOCCALLSFSUB2(HBPROX,hbprox,INT,FLOAT)
-#define HBPROX(A1,A2) CCALLSFSUB2(HBPROX,hbprox,INT,FLOAT,A1,A2)
-
-PROTOCCALLSFSUB2(HBPROY,hbproy,INT,FLOAT)
-#define HBPROY(A1,A2) CCALLSFSUB2(HBPROY,hbproy,INT,FLOAT,A1,A2)
-
-PROTOCCALLSFSUB3(HBSET,hbset,STRING,INT,PINT)
-#define HBSET(A1,A2,A3) CCALLSFSUB3(HBSET,hbset,STRING,INT,PINT,A1,A2,A3)
-
-PROTOCCALLSFSUB3(HBSLIX,hbslix,INT,INT,FLOAT)
-#define HBSLIX(A1,A2,A3) CCALLSFSUB3(HBSLIX,hbslix,INT,INT,FLOAT,A1,A2,A3)
-
-PROTOCCALLSFSUB3(HBSLIY,hbsliy,INT,INT,FLOAT)
-#define HBSLIY(A1,A2,A3) CCALLSFSUB3(HBSLIY,hbsliy,INT,INT,FLOAT,A1,A2,A3)
-
-PROTOCCALLSFSUB2(HCDIR,hcdir,PSTRING,STRING)
-#define HCDIR(A1,A2) CCALLSFSUB2(HCDIR,hcdir,PSTRING,STRING,A1,A2)
-
-PROTOCCALLSFSUB2(HCOMPA,hcompa,INTV,INT)
-#define HCOMPA(A1,A2) CCALLSFSUB2(HCOMPA,hcompa,INTV,INT,A1,A2)
-
-PROTOCCALLSFSUB3(HCOPY,hcopy,INT,INT,STRING)
-#define HCOPY(A1,A2,A3) CCALLSFSUB3(HCOPY,hcopy,INT,INT,STRING,A1,A2,A3)
-
-PROTOCCALLSFSUB8(HCOPYR,hcopyr,INT,INT,STRING,INT,INT,INT,INT,STRING)
-#define HCOPYR(A1,A2,A3,A4,A5,A7,A8) CCALLSFSUB8(HCOPYR,hcopyr,INT,INT,STRING,INT,INT,INT,INT,STRING,A1,A2,A3,A4,A5,A6,A7,A8)
-
-PROTOCCALLSFSUB3(HCOPYM,hcopym,INT,INTV,INT)
-#define HCOPYM(A1,A2,A3) CCALLSFSUB3(HCOPYM,hcopym,INT,INTV,INT,A1,A2,A3)
-
-PROTOCCALLSFSUB1(HDELET,hdelet,INT)
-#define HDELET(A1) CCALLSFSUB1(HDELET,hdelet,INT,A1)
-
-PROTOCCALLSFSUB1(HDERIV,hderiv,FLOATV)
-#define HDERIV(A1) CCALLSFSUB1(HDERIV,hderiv,FLOATV,A1)
-
-PROTOCCALLSFSUB4(HDIFF,hdiff,INT,INT,PFLOAT,STRING)
-#define HDIFF(A1,A2,A3,A4) CCALLSFSUB4(HDIFF,hdiff,INT,INT,PFLOAT,STRING,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB7(HDIFFB,hdiffb,INT,INT,FLOAT,INT,STRING,INT,FLOATV)
-#define HDIFFB(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(HDIFFB,hdiffb,INT,INT,FLOAT,INT,STRING,INT,FLOATV,A1,A2,A3,A4,A5,A6,A7)
-
-PROTOCCALLSFSUB1(HDUMP,hdump,INT)
-#define HDUMP(A1) CCALLSFSUB1(HDUMP,hdump,INT,A1)
-
-PROTOCCALLSFSUB1(HERMES,hermes,INT)
-#define HERMES(A1) CCALLSFSUB1(HERMES,hermes,INT,A1)
-
-PROTOCCALLSFSUB7(HFC2,hfc2,INT,INT,STRING,INT,STRING,FLOAT,STRING)
-#define HFC2(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(HFC2,hfc2,INT,INT,STRING,INT,STRING,FLOAT,STRING,A1,A2,A3,A4,A5,A6,A7)
-
-PROTOCCALLSFSUB4(HFF1,hff1,INT,PINT,FLOAT,FLOAT)
-#define HFF1(A1,A2,A3,A4) CCALLSFSUB4(HFF1,hff1,INT,PINT,FLOAT,FLOAT,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB5(HFF2,hff2,INT,PINT,FLOAT,FLOAT,FLOAT)
-#define HFF2(A1,A2,A3,A4,A5) CCALLSFSUB5(HFF2,hff2,INT,PINT,FLOAT,FLOAT,FLOAT,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB4(HFILL,hfill,INT,FLOAT,FLOAT,FLOAT)
-#define HFILL(A1,A2,A3,A4) CCALLSFSUB4(HFILL,hfill,INT,FLOAT,FLOAT,FLOAT,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB3(HFINAM,hfinam,INT,STRINGV,INT)
-#define HFINAM(A1,A2,A3) CCALLSFSUB3(HFINAM,hfinam,INT,STRINGV,INT,A1,A2,A3)
-
-PROTOCCALLSFSUB6(HFITEX,hfitex,INT,PFLOAT,PFLOAT,PFLOAT,INT,FLOATV)
-#define HFITEX(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(HFITEX,hfitex,INT,PFLOAT,PFLOAT,PFLOAT,INT,FLOATV,A1,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFSUB7(HFITGA,hfitga,INT,PFLOAT,PFLOAT,PFLOAT,PFLOAT,INT,FLOATV)
-#define HFITGA(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(HFITGA,hfitga,INT,PFLOAT,PFLOAT,PFLOAT,PFLOAT,INT,FLOATV,A1,A2,A3,A4,A5,A6,A7)
-
-PROTOCCALLSFSUB10(HFITH,hfith,INT,ROUTINE,STRING,INT,FLOATV,FLOATV,FLOATV,FLOATV,FLOATV,PFLOAT)
-#define HFITH(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10) CCALLSFSUB10(HFITH,hfith,INT,ROUTINE,STRING,INT,FLOATV,FLOATV,FLOATV,FLOATV,FLOATV,PFLOAT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10)
-
-PROTOCCALLSFSUB10(HFITHN,hfithn,INT,STRING,STRING,INT,FLOATV,FLOATV,FLOATV,FLOATV,FLOATV,PFLOAT)
-#define HFITHN(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10) CCALLSFSUB10(HFITHN,hfithn,INT,STRING,STRING,INT,FLOATV,FLOATV,FLOATV,FLOATV,FLOATV,PFLOAT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10)
-
-PROTOCCALLSFSUB11(HFITL,hfitl,INT,ROUTINE,INT,DOUBLEV,PFLOAT,INT,PFLOAT,PFLOAT,FLOATV,FLOATV,FLOATV)
-#define HFITL(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11) CCALLSFSUB11(HFITL,hfitl,INT,ROUTINE,INT,DOUBLEV,PFLOAT,INT,PFLOAT,PFLOAT,FLOATV,FLOATV,FLOATV,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11)
-
-PROTOCCALLSFSUB16(HFITN,hfitn,PFLOAT,FLOATV,FLOATV,INT,INT,INT,ROUTINE,INT,DOUBLEV,PFLOAT,INT,PFLOAT,PFLOAT,FLOATV,FLOATV,FLOATV)
-#define HFITN(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15,A16) CCALLSFSUB16(HFITN,hfitn,PFLOAT,FLOATV,FLOATV,INT,INT,INT,ROUTINE,INT,DOUBLEV,PFLOAT,INT,PFLOAT,PFLOAT,FLOATV,FLOATV,FLOATV,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15,A16)
-
-PROTOCCALLSFSUB6(HFITPO,hfitpo,INT,INT,FLOATV,PFLOAT,INT,FLOATV)
-#define HFITPO(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(HFITPO,hfitpo,INT,INT,FLOATV,PFLOAT,INT,FLOATV,A1,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFSUB7(HFITS,hfits,INT,ROUTINE,INT,DOUBLEV,PFLOAT,INT,PFLOAT)
-#define HFITS(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(HFITS,hfits,INT,ROUTINE,INT,DOUBLEV,PFLOAT,INT,PFLOAT,A1,A2,A3,A4,A5,A6,A7)
-
-PROTOCCALLSFSUB15(HFITV,hfitv,INT,INT,INT,PFLOAT,FLOATV,FLOATV,ROUTINE,STRING,INT,FLOATV,FLOATV,FLOATV,FLOATV,PFLOAT,PFLOAT)
-#define HFITV(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15) CCALLSFSUB15(HFITV,hfitv,INT,INT,INT,PFLOAT,FLOATV,FLOATV,ROUTINE,STRING,INT,FLOATV,FLOATV,FLOATV,FLOATV,PFLOAT,PFLOAT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15)
-
-PROTOCCALLSFSUB10(HFIT1,hfit1,FLOATV,FLOATV,FLOATV,INT,ROUTINE,INT,DOUBLEV,PFLOAT,INT,PFLOAT)
-#define HFIT1(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10) CCALLSFSUB10(HFIT1,hfit1,FLOATV,FLOATV,FLOATV,INT,ROUTINE,INT,DOUBLEV,PFLOAT,INT,PFLOAT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10)
-
-PROTOCCALLSFSUB2(HFN,hfn,INT,FLOATV)
-#define HFN(A1,A2) CCALLSFSUB2(HFN,hfn,INT,FLOATV,A1,A2)
-
-PROTOCCALLSFSUB1(HFNT,hfnt,INT)
-#define HFNT(A1) CCALLSFSUB1(HFNT,hfnt,INT,A1)
-
-PROTOCCALLSFSUB2(HFNTB,hfntb,INT,STRING)
-#define HFNTB(A1,A2) CCALLSFSUB2(HFNTB,hfntb,INT,STRING,A1,A2)
-
-PROTOCCALLSFSUB4(HFPAK1,hfpak1,INT,PINT,FLOATV,INT)
-#define HFPAK1(A1,A2,A3,A4) CCALLSFSUB4(HFPAK1,hfpak1,INT,PINT,FLOATV,INT,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB2(HFUNC,hfunc,INT,ROUTINE)
-#define HFUNC(A1,A2) CCALLSFSUB2(HFUNC,hfunc,INT,ROUTINE,A1,A2)
-
-PROTOCCALLSFSUB3(HF1,hf1,INT,FLOAT,FLOAT)
-#define HF1(A1,A2,A3) CCALLSFSUB3(HF1,hf1,INT,FLOAT,FLOAT,A1,A2,A3)
-
-PROTOCCALLSFSUB4(HF2,hf2,INT,FLOAT,FLOAT,FLOAT)
-#define HF2(A1,A2,A3,A4) CCALLSFSUB4(HF2,hf2,INT,FLOAT,FLOAT,FLOAT,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB7(HGFIT,hgfit,INT,PINT,PINT,PFLOAT,PFLOAT,PFLOAT,PSTRINGV)
-#define HGFIT(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(HGFIT,hgfit,INT,PINT,PINT,PFLOAT,PFLOAT,PFLOAT,PSTRINGV,A1,A2,A3,A4,A5,A6,A7)
-
-PROTOCCALLSFSUB10(HGIVE,hgive,INT,PSTRING,PINT,PFLOAT,PFLOAT,PINT,PFLOAT,PFLOAT,PINT,PINT)
-#define HGIVE(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10) CCALLSFSUB10(HGIVE,hgive,INT,PSTRING,PINT,PFLOAT,PFLOAT,PINT,PFLOAT,PFLOAT,PINT,PINT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10)
-
-PROTOCCALLSFSUB6(HGIVEN,hgiven,INT,PSTRING,PINT,PSTRINGV,FLOATV,FLOATV)
-#define HGIVEN(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(HGIVEN,hgiven,INT,PSTRING,PINT,PSTRINGV,FLOATV,FLOATV,A1,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFSUB3(HKIND,hkind,INT,INTV,STRING)
-#define HKIND(A1,A2,A3) CCALLSFSUB3(HKIND,hkind,INT,INTV,STRING,A1,A2,A3)
-
-PROTOCCALLSFSUB5(HGN,hgn,INT,PINT,INT,FLOATV,PINT)
-#define HGN(A1,A2,A3,A4,A5) CCALLSFSUB5(HGN,hgn,INT,PINT,INT,FLOATV,PINT,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB4(HGNF,hgnf,INT,INT,PFLOAT,PINT)
-#define HGNF(A1,A2,A3,A4) CCALLSFSUB4(HGNF,hgnf,INT,INT,PFLOAT,PINT,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB2(HGNPAR,hgnpar,INT,STRING)
-#define HGNPAR(A1,A2) CCALLSFSUB2(HGNPAR,hgnpar,INT,STRING,A1,A2)
-
-PROTOCCALLSFSUB3(HGNT,hgnt,INT,INT,INT)
-#define HGNT(A1,A2,A3) CCALLSFSUB3(HGNT,hgnt,INT,INT,INT,A1,A2,A3)
-
-PROTOCCALLSFSUB4(HGNTB,hgntb,INT,STRING,INT,INT)
-#define HGNTB(A1,A2,A3,A4) CCALLSFSUB4(HGNTB,hgntb,INT,STRING,INT,INT,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB3(HGNTF,hgntf,INT,INT,PINT)
-#define HGNTF(A1,A2,A3) CCALLSFSUB3(HGNTF,hgntf,INT,INT,PINT,A1,A2,A3)
-
-PROTOCCALLSFSUB5(HGNTV,hgntv,INT,STRINGV,INT,INT,INT)
-#define HGNTV(A1,A2,A3,A4,A5) CCALLSFSUB5(HGNTV,hgntv,INT,STRINGV,INT,INT,INT,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB2(HIDALL,hidall,INTV,PINT)
-#define HIDALL(A1,A2) CCALLSFSUB2(HIDALL,hidall,INTV,PINT,A1,A2)
-
-PROTOCCALLSFSUB2(HIDOPT,hidopt,INT,STRING)
-#define HIDOPT(A1,A2) CCALLSFSUB2(HIDOPT,hidopt,INT,STRING,A1,A2)
-
-PROTOCCALLSFSUB2(HID1,hid1,INTV,PINT)
-#define HID1(A1,A2) CCALLSFSUB2(HID1,hid1,INTV,PINT,A1,A2)
-
-PROTOCCALLSFSUB2(HID2,hid2,INTV,PINT)
-#define HID2(A1,A2) CCALLSFSUB2(HID2,hid2,INTV,PINT,A1,A2)
-
-PROTOCCALLSFSUB5(HIJXY,hijxy,INT,INT,INT,PFLOAT,PFLOAT)
-#define HIJXY(A1,A2,A3,A4,A5) CCALLSFSUB5(HIJXY,hijxy,INT,INT,INT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB0(HINDEX,hindex)
-#define HINDEX() CCALLSFSUB0(HINDEX,hindex)
-
-PROTOCCALLSFSUB4(HIPAK1,hipak1,INT,PINT,INTV,INT)
-#define HIPAK1(A1,A2,A3,A4) CCALLSFSUB4(HIPAK1,hipak1,INT,PINT,INTV,INT,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB0(HISTDO,histdo)
-#define HISTDO() CCALLSFSUB0(HISTDO,histdo)
-
-PROTOCCALLSFSUB3(HIX,hix,INT,INT,PFLOAT)
-#define HIX(A1,A2,A3) CCALLSFSUB3(HIX,hix,INT,INT,PFLOAT,A1,A2,A3)
-
-PROTOCCALLSFSUB4(HLABEL,hlabel,INT,INT,STRINGV,STRING)
-#define HLABEL(A1,A2,A3,A4) CCALLSFSUB4(HLABEL,hlabel,INT,INT,STRINGV,STRING,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB2(HLDIR,hldir,STRING,STRING)
-#define HLDIR(A1,A2) CCALLSFSUB2(HLDIR,hldir,STRING,STRING,A1,A2)
-
-PROTOCCALLSFSUB1(HLIMIT,hlimit,INT)
-#define HLIMIT(A1) CCALLSFSUB1(HLIMIT,hlimit,INT,A1)
-
-PROTOCCALLSFSUB4(HLNEXT,hlnext,PINT,PSTRING,PSTRING,STRING)
-#define HLNEXT(A1,A2,A3,A4) CCALLSFSUB4(HLNEXT,hlnext,PINT,PSTRING,PSTRING,STRING,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB2(HLOCAT,hlocat,INT,PINT)
-#define HLOCAT(A1,A2) CCALLSFSUB2(HLOCAT,hlocat,INT,PINT,A1,A2)
-
-PROTOCCALLSFSUB2(HMAXIM,hmaxim,INT,FLOAT)
-#define HMAXIM(A1,A2) CCALLSFSUB2(HMAXIM,hmaxim,INT,FLOAT,A1,A2)
-
-PROTOCCALLSFSUB2(HMDIR,hmdir,STRING,STRING)
-#define HMDIR(A1,A2) CCALLSFSUB2(HMDIR,hmdir,STRING,STRING,A1,A2)
-
-PROTOCCALLSFSUB2(HMINIM,hminim,INT,FLOAT)
-#define HMINIM(A1,A2) CCALLSFSUB2(HMINIM,hminim,INT,FLOAT,A1,A2)
-
-PROTOCCALLSFSUB2(HNOENT,hnoent,INT,PINT)
-#define HNOENT(A1,A2) CCALLSFSUB2(HNOENT,hnoent,INT,PINT,A1,A2)
-
-PROTOCCALLSFSUB2(HNORMA,hnorma,INT,FLOAT)
-#define HNORMA(A1,A2) CCALLSFSUB2(HNORMA,hnorma,INT,FLOAT,A1,A2)
-
-PROTOCCALLSFSUB6(HOPERA,hopera,INT,STRING,INT,INT,FLOAT,FLOAT)
-#define HOPERA(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(HOPERA,hopera,INT,STRING,INT,INT,FLOAT,FLOAT,A1,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFSUB1(HOUTPU,houtpu,INT)
-#define HOUTPU(A1) CCALLSFSUB1(HOUTPU,houtpu,INT,A1)
-
-PROTOCCALLSFSUB1(HPAGSZ,hpagsz,INT)
-#define HPAGSZ(A1) CCALLSFSUB1(HPAGSZ,hpagsz,INT,A1)
-
-PROTOCCALLSFSUB2(HPAK,hpak,INT,FLOATV)
-#define HPAK(A1,A2) CCALLSFSUB2(HPAK,hpak,INT,FLOATV,A1,A2)
-
-PROTOCCALLSFSUB2(HPAKAD,hpakad,INT,FLOATV)
-#define HPAKAD(A1,A2) CCALLSFSUB2(HPAKAD,hpakad,INT,FLOATV,A1,A2)
-
-PROTOCCALLSFSUB2(HPAKE,hpake,INT,FLOATV)
-#define HPAKE(A1,A2) CCALLSFSUB2(HPAKE,hpake,INT,FLOATV,A1,A2)
-
-PROTOCCALLSFSUB7(HPARAM,hparam,INT,INT,FLOAT,INTV,PDOUBLE,PINT,PINT)
-#define HPARAM(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(HPARAM,hparam,INT,INT,FLOAT,INTV,PDOUBLE,PINT,PINT,A1,A2,A3,A4,A5,A6,A7)
-
-PROTOCCALLSFSUB11(HPARMN,hparmn,PFLOAT,FLOATV,FLOATV,INT,INT,INT,FLOAT,INTV,PDOUBLE,PINT,PINT)
-#define HPARMN(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11) CCALLSFSUB11(HPARMN,hparmn,PFLOAT,FLOATV,FLOATV,INT,INT,INT,FLOAT,INTV,PDOUBLE,PINT,PINT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11)
-
-PROTOCCALLSFSUB2(HPCHAR,hpchar,INTV,INTV)
-#define HPCHAR(A1,A2) CCALLSFSUB2(HPCHAR,hpchar,INTV,INTV,A1,A2)
-
-PROTOCCALLSFSUB2(HPDIR,hpdir,STRING,STRING)
-#define HPDIR(A1,A2) CCALLSFSUB2(HPDIR,hpdir,STRING,STRING,A1,A2)
-
-PROTOCCALLSFSUB3(HPHIST,hphist,INT,STRING,INT)
-#define HPHIST(A1,A2,A3) CCALLSFSUB3(HPHIST,hphist,INT,STRING,INT,A1,A2,A3)
-
-PROTOCCALLSFSUB1(HPHS,hphs,INT)
-#define HPHS(A1) CCALLSFSUB1(HPHS,hphs,INT,A1)
-
-PROTOCCALLSFSUB1(HPHST,hphst,INT)
-#define HPHST(A1) CCALLSFSUB1(HPHST,hphst,INT,A1)
-
-PROTOCCALLSFSUB0(HPONCE,hponce)
-#define HPONCE() CCALLSFSUB0(HPONCE,hponce)
-
-PROTOCCALLSFSUB1(HPRINT,hprint,INT)
-#define HPRINT(A1) CCALLSFSUB1(HPRINT,hprint,INT,A1)
-
-PROTOCCALLSFSUB1(HPRNT,hprnt,INT)
-#define HPRNT(A1) CCALLSFSUB1(HPRNT,hprnt,INT,A1)
-
-PROTOCCALLSFSUB7(HPROJ1,hproj1,INT,INT,INT,ROUTINE,INT,INT,INT)
-#define HPROJ1(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(HPROJ1,hproj1,INT,INT,INT,ROUTINE,INT,INT,INT,A1,A2,A3,A4,A5,A6,A7)
-
-PROTOCCALLSFSUB8(HPROJ2,hproj2,INT,INT,INT,ROUTINE,INT,INT,INT,INT)
-#define HPROJ2(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(HPROJ2,hproj2,INT,INT,INT,ROUTINE,INT,INT,INT,INT,A1,A2,A3,A4,A5,A6,A7,A8)
-
-PROTOCCALLSFSUB3(HPROT,hprot,INT,STRING,INT)
-#define HPROT(A1,A2,A3) CCALLSFSUB3(HPROT,hprot,INT,STRING,INT,A1,A2,A3)
-
-PROTOCCALLSFSUB1(HPSCAT,hpscat,INT)
-#define HPSCAT(A1) CCALLSFSUB1(HPSCAT,hpscat,INT,A1)
-
-PROTOCCALLSFSUB1(HPTAB,hptab,INT)
-#define HPTAB(A1) CCALLSFSUB1(HPTAB,hptab,INT,A1)
-
-PROTOCCALLSFSUB11(HQUAD,hquad,INT,STRING,INT,FLOAT,FLOAT,PINT,PFLOAT,PINT,PFLOAT,PFLOAT,PINT)
-#define HQUAD(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11) CCALLSFSUB11(HQUAD,hquad,INT,STRING,INT,FLOAT,FLOAT,PINT,PFLOAT,PINT,PFLOAT,PFLOAT,PINT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11)
-
-PROTOCCALLSFSUB3(HRDIR,hrdir,INT,PSTRINGV,PINT)
-#define HRDIR(A1,A2,A3) CCALLSFSUB3(HRDIR,hrdir,INT,PSTRINGV,PINT,A1,A2,A3)
-
-PROTOCCALLSFSUB8(HREBIN,hrebin,INT,FLOATV,FLOATV,FLOATV,FLOATV,INT,INT,INT)
-#define HREBIN(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(HREBIN,hrebin,INT,FLOATV,FLOATV,FLOATV,FLOATV,INT,INT,INT,A1,A2,A3,A4,A5,A6,A7,A8)
-
-PROTOCCALLSFSUB2(HRECOV,hrecov,INT,STRING)
-#define HRECOV(A1,A2) CCALLSFSUB2(HRECOV,hrecov,INT,STRING,A1,A2)
-
-PROTOCCALLSFSUB1(HREND,hrend,STRING)
-#define HREND(A1) CCALLSFSUB1(HREND,hrend,STRING,A1)
-
-PROTOCCALLSFSUB1(HRENDC,hrendc,STRING)
-#define HRENDC(A1) CCALLSFSUB1(HRENDC,hrendc,STRING,A1)
-
-PROTOCCALLSFSUB2(HRESET,hreset,INT,STRING)
-#define HRESET(A1,A2) CCALLSFSUB2(HRESET,hreset,INT,STRING,A1,A2)
-
-PROTOCCALLSFSUB3(HRFILE,hrfile,INT,STRING,STRING)
-#define HRFILE(A1,A2,A3) CCALLSFSUB3(HRFILE,hrfile,INT,STRING,STRING,A1,A2,A3)
-
-PROTOCCALLSFSUB3(HRGET,hrget,INT,STRING,STRING)
-#define HRGET(A1,A2,A3) CCALLSFSUB3(HRGET,hrget,INT,STRING,STRING,A1,A2,A3)
-
-PROTOCCALLSFSUB3(HRIN,hrin,INT,INT,INT)
-#define HRIN(A1,A2,A3) CCALLSFSUB3(HRIN,hrin,INT,INT,INT,A1,A2,A3)
-
-PROTOCCALLSFSUB3(HRNDM2,hrndm2,INT,PFLOAT,PFLOAT)
-#define HRNDM2(A1,A2,A3) CCALLSFSUB3(HRNDM2,hrndm2,INT,PFLOAT,PFLOAT,A1,A2,A3)
-
-PROTOCCALLSFSUB6(HROPEN,hropen,INT,STRING,STRING,STRING,PINT,PINT)
-#define HROPEN(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(HROPEN,hropen,INT,STRING,STRING,STRING,PINT,PINT,A1,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFSUB3(HROUT,hrout,INT,PINT,STRING)
-#define HROUT(A1,A2,A3) CCALLSFSUB3(HROUT,hrout,INT,PINT,STRING,A1,A2,A3)
-
-PROTOCCALLSFSUB3(HRPUT,hrput,INT,STRING,STRING)
-#define HRPUT(A1,A2,A3) CCALLSFSUB3(HRPUT,hrput,INT,STRING,STRING,A1,A2,A3)
-
-PROTOCCALLSFSUB2(HSCALE,hscale,INT,FLOAT)
-#define HSCALE(A1,A2) CCALLSFSUB2(HSCALE,hscale,INT,FLOAT,A1,A2)
-
-PROTOCCALLSFSUB3(HSCR,hscr,INT,INT,STRING)
-#define HSCR(A1,A2,A3) CCALLSFSUB3(HSCR,hscr,INT,INT,STRING,A1,A2,A3)
-
-PROTOCCALLSFSUB2(HSETPR,hsetpr,STRING,FLOAT)
-#define HSETPR(A1,A2) CCALLSFSUB2(HSETPR,hsetpr,STRING,FLOAT,A1,A2)
-
-PROTOCCALLSFSUB3(HSMOOF,hsmoof,INT,INT,FLOAT)
-#define HSMOOF(A1,A2,A3) CCALLSFSUB3(HSMOOF,hsmoof,INT,INT,FLOAT,A1,A2,A3)
-
-PROTOCCALLSFSUB5(HSPLI1,hspli1,INT,INT,INT,INT,PFLOAT)
-#define HSPLI1(A1,A2,A3,A4,A5) CCALLSFSUB5(HSPLI1,hspli1,INT,INT,INT,INT,PFLOAT,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB5(HSPLI2,hspli2,INT,INT,INT,INT,INT)
-#define HSPLI2(A1,A2,A3,A4,A5) CCALLSFSUB5(HSPLI2,hspli2,INT,INT,INT,INT,INT,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB1(HSQUEZ,hsquez,STRING)
-#define HSQUEZ(A1) CCALLSFSUB1(HSQUEZ,hsquez,STRING,A1)
-
-PROTOCCALLSFSUB1(HTITLE,htitle,STRING)
-#define HTITLE(A1) CCALLSFSUB1(HTITLE,htitle,STRING,A1)
-
-PROTOCCALLSFSUB4(HUNPAK,hunpak,INT,FLOATV,STRING,INT)
-#define HUNPAK(A1,A2,A3,A4) CCALLSFSUB4(HUNPAK,hunpak,INT,FLOATV,STRING,INT,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB4(HUNPKE,hunpke,INT,FLOATV,STRING,INT)
-#define HUNPKE(A1,A2,A3,A4) CCALLSFSUB4(HUNPKE,hunpke,INT,FLOATV,STRING,INT,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB5(HUWFUN,huwfun,INT,INT,STRING,INT,STRING)
-#define HUWFUN(A1,A2,A3,A4,A5) CCALLSFSUB5(HUWFUN,huwfun,INT,INT,STRING,INT,STRING,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB3(HXI,hxi,INT,FLOAT,PINT)
-#define HXI(A1,A2,A3) CCALLSFSUB3(HXI,hxi,INT,FLOAT,PINT,A1,A2,A3)
-
-PROTOCCALLSFSUB5(HXYIJ,hxyij,INT,FLOAT,FLOAT,PINT,PINT)
-#define HXYIJ(A1,A2,A3,A4,A5) CCALLSFSUB5(HXYIJ,hxyij,INT,FLOAT,FLOAT,PINT,PINT,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFFUN1(LOGICAL,HEXIST,hexist,INT)
-#define HEXIST(A2) CCALLSFFUN1(HEXIST,hexist,INT,A2)
-
-PROTOCCALLSFFUN2(FLOAT,HI,hi,INT,INT)
-#define HI(A2,A3) CCALLSFFUN2(HI,hi,INT,INT,A2,A3)
-
-PROTOCCALLSFFUN2(FLOAT,HIE,hie,INT,INT)
-#define HIE(A2,A3) CCALLSFFUN2(HIE,hie,INT,INT,A2,A3)
-
-PROTOCCALLSFFUN2(FLOAT,HIF,hif,INT,INT)
-#define HIF(A2,A3) CCALLSFFUN2(HIF,hif,INT,INT,A2,A3)
-
-PROTOCCALLSFFUN3(FLOAT,HIJ,hij,INT,INT,INT)
-#define HIJ(A2,A3,A4) CCALLSFFUN3(HIJ,hij,INT,INT,INT,A2,A3,A4)
-
-PROTOCCALLSFFUN3(FLOAT,HIJE,hije,INT,INT,INT)
-#define HIJE(A2,A3,A4) CCALLSFFUN3(HIJE,hije,INT,INT,INT,A2,A3,A4)
-
-PROTOCCALLSFFUN1(FLOAT,HMAX,hmax,INT)
-#define HMAX(A2) CCALLSFFUN1(HMAX,hmax,INT,A2)
-
-PROTOCCALLSFFUN1(FLOAT,HMIN,hmin,INT)
-#define HMIN(A2) CCALLSFFUN1(HMIN,hmin,INT,A2)
-
-PROTOCCALLSFFUN1(FLOAT,HRNDM1,hrndm1,INT)
-#define HRNDM1(A2) CCALLSFFUN1(HRNDM1,hrndm1,INT,A2)
-
-PROTOCCALLSFFUN4(FLOAT,HSPFUN,hspfun,INT,FLOAT,INT,INT)
-#define HSPFUN(A2,A3,A4,A5) CCALLSFFUN4(HSPFUN,hspfun,INT,FLOAT,INT,INT,A2,A3,A4,A5)
-
-PROTOCCALLSFFUN4(FLOAT,HSTATI,hstati,INT,INT,STRING,INT)
-#define HSTATI(A2,A3,A4,A5) CCALLSFFUN4(HSTATI,hstati,INT,INT,STRING,INT,A2,A3,A4,A5)
-
-PROTOCCALLSFFUN1(FLOAT,HSUM,hsum,INT)
-#define HSUM(A2) CCALLSFFUN1(HSUM,hsum,INT,A2)
-
-PROTOCCALLSFFUN2(FLOAT,HX,hx,INT,FLOAT)
-#define HX(A2,A3) CCALLSFFUN2(HX,hx,INT,FLOAT,A2,A3)
-
-PROTOCCALLSFFUN2(FLOAT,HXE,hxe,INT,FLOAT)
-#define HXE(A2,A3) CCALLSFFUN2(HXE,hxe,INT,FLOAT,A2,A3)
-
-PROTOCCALLSFFUN3(FLOAT,HXY,hxy,INT,FLOAT,FLOAT)
-#define HXY(A2,A3,A4) CCALLSFFUN3(HXY,hxy,INT,FLOAT,FLOAT,A2,A3,A4)
-
-PROTOCCALLSFSUB11(HBALLOC,hballoc,INT,STRING,STRING,STRING,INT,INT,INT,INT,INTV,PINT,PINT)
-#define HBALLOC(IDN,CHDIR,VAR,BLOCK,ITYPE,ISIZE,IFIRST,NELEM,IBASE,IOFF,NUSE)\
- CCALLSFSUB11(HBALLOC,hballoc,INT,STRING,STRING,STRING,INT,INT,INT,INT,INTV,PINT,PINT,IDN,CHDIR,VAR,BLOCK,ITYPE,ISIZE,IFIRST,NELEM,IBASE,IOFF,NUSE)
-
-PROTOCCALLSFSUB1(HBFREE,hbfree,INT)
-#define HBFREE(LUN) CCALLSFSUB1(HBFREE,hbfree,INT,LUN)
-
-PROTOCCALLSFSUB1(HBINIT1,hbinit1,INT)
-#define HBINIT1(IFLAG) CCALLSFSUB1(HBINIT1,hbinit1,INT,IFLAG)
-
-PROTOCCALLSFSUB0(HDCOFL,hdcofl)
-#define HDCOFL() CCALLSFSUB0(HDCOFL,hdcofl)
-
-PROTOCCALLSFSUB4(HF1N,hf1n,INT,FLOATV,FLOATV,INT)
-#define HF1N(ID,X,W,NEVT) CCALLSFSUB4(HF1N,hf1n,INT,FLOATV,FLOATV,INT,ID,X,W,NEVT)
-
-PROTOCCALLSFSUB6(HGNTBF,hgntbf,INT,ZTRINGV,INTV,INT,INT,PINT)
-/* fix the element length of VAR to 32 */
-#define hgntbf_ELEMS_2 ZTRINGV_ARGS(4)
-#define hgntbf_ELEMLEN_2 ZTRINGV_NUM(32)
-#define HGNTBF(IDN,VAR,IOFFST,NVAR,IDNEVT,IERROR)\
- CCALLSFSUB6(HGNTBF,hgntbf,INT,ZTRINGV,INTV,INT,INT,PINT,IDN,VAR,IOFFST,NVAR,IDNEVT,IERROR)
-
-PROTOCCALLSFSUB1(HGTDIR,hgtdir,PSTRING)
-#define HGTDIR(CHDIR) CCALLSFSUB1(HGTDIR,hgtdir,PSTRING,CHDIR)
-
-PROTOCCALLSFFUN2(LOGICAL,HLABEQ,hlabeq,INT,STRING)
-#define HLABEQ(IDD,CHOPT) CCALLSFFUN2(HLABEQ,hlabeq,INT,STRING,IDD,CHOPT)
-
-PROTOCCALLSFFUN2(INT,HLABNB,hlabnb,INT,STRING)
-#define HLABNB(IDD,CHOPT) CCALLSFFUN2(HLABNB,hlabnb,INT,STRING,IDD,CHOPT)
-
-PROTOCCALLSFSUB4(HLGNXT,hlgnxt,INT,INT,PSTRING,STRING)
-#define HLGNXT(IDD,IPOS,CHLAB,CHOPT) CCALLSFSUB4(HLGNXT,hlgnxt,INT,INT,PSTRING,STRING,IDD,IPOS,CHLAB,CHOPT)
-
-PROTOCCALLSFSUB2(HLOGPF,hlogpf,STRING,PINT)
-#define HLOGPF(CHHEAD,ISTAT) CCALLSFSUB2(HLOGPF,hlogpf,STRING,PINT,CHHEAD,ISTAT)
-
-PROTOCCALLSFSUB4(HNTDIM,hntdim,STRING,PINT,INTV,INT)
-#define HNTDIM(TVAR,NVDIM,IVDIM,MXVDIM) CCALLSFSUB4(HNTDIM,hntdim,STRING,PINT,INTV,INT,TVAR,NVDIM,IVDIM,MXVDIM)
-
-PROTOCCALLSFSUB7(HNTGET,hntget,INT,STRING,PINT,PINT,PINT,PINT,PINT)
-#define HNTGET(ID1,TVAR,INDX,ITYPE,ISIZE,IELEM,IER)\
- CCALLSFSUB7(HNTGET,hntget,INT,STRING,PINT,PINT,PINT,PINT,PINT,ID1,TVAR,INDX,ITYPE,ISIZE,IELEM,IER)
-
-PROTOCCALLSFSUB8(HNTGETI,hntgeti,INT,INT,INT,PSTRING,PINT,PINT,PINT,PINT)
-#define HNTGETI(ID1,ICOM,INDX,TVAR,ITYPE,ISIZE,IELEM,IER)\
- CCALLSFSUB8(HNTGETI,hntgeti,INT,INT,INT,PSTRING,PINT,PINT,PINT,PINT,ID1,ICOM,INDX,TVAR,ITYPE,ISIZE,IELEM,IER)
-
-PROTOCCALLSFFUN1(LOGICAL,HNTNEW,hntnew,INT)
-#define HNTNEW(IDN) CCALLSFFUN1(HNTNEW,hntnew,INT,IDN)
-
-PROTOCCALLSFSUB4(HNTRNG,hntrng,STRING,PINT,PINT,PINT)
-#define HNTRNG(TVAR,ILOW,IUP,IERR) CCALLSFSUB4(HNTRNG,hntrng,STRING,PINT,PINT,PINT,TVAR,ILOW,IUP,IERR)
-
-PROTOCCALLSFSUB8(HNTVAR,hntvar,INT,INT,PSTRING,PSTRING,PINT,PINT,PINT,PINT)
-#define HNTVAR(ID1,IVAR,CHTAG,BLOCK,NSUB,ITYPE,ISIZE,IELEM) \
- CCALLSFSUB8(HNTVAR,hntvar,INT,INT,PSTRING,PSTRING,PINT,PINT,PINT,PINT,ID1,IVAR,CHTAG,BLOCK,NSUB,ITYPE,ISIZE,IELEM)
-
-PROTOCCALLSFSUB4(HRNGPF,hrngpf,INT,INT,PINT,PINT)
-#define HRNGPF(NSLAV,MYSID,IFIRST,ITO) \
- CCALLSFSUB4(HRNGPF,hrngpf,INT,INT,PINT,PINT,NSLAV,MYSID,IFIRST,ITO)
-
-PROTOCCALLSFSUB6(HVXIST,hvxist,STRING,PSTRING,PSTRING,PINT,PINT,PINT)
-#define HVXIST(TVAR,BLOCK,CIVAR,ITYPE,ISIZE,IELEM) \
- CCALLSFSUB6(HVXIST,hvxist,STRING,PSTRING,PSTRING,PINT,PINT,PINT,\
- TVAR,BLOCK,CIVAR,ITYPE,ISIZE,IELEM)
-
-#if defined(vms) || defined(__vms)
-
-PROTOCCALLSFFUN3(INT,HCREATEG,hcreateg,STRING,PINT,INT)
-#define HCREATEG(A2,A3,A4) CCALLSFFUN3(HCREATEG,hcreateg,STRING,PINT,INT,A2,A3,A4)
-
-PROTOCCALLSFFUN3(INT,HMAPG,hmapg,STRING,PINT,PINT)
-#define HMAPG(A2,A3,A4) CCALLSFFUN3(HMAPG,hmapg,STRING,PINT,PINT,A2,A3,A4)
-
-#else
-
-PROTOCCALLSFSUB2(HLIMAP,hlimap,INT,STRING)
-#define HLIMAP(A1,A2) CCALLSFSUB2(HLIMAP,hlimap,INT,STRING,A1,A2)
-
-#endif
diff --git a/src/cfortran/higz.h b/src/cfortran/higz.h
deleted file mode 100644
index d4abe7b..0000000
--- a/src/cfortran/higz.h
+++ /dev/null
@@ -1,251 +0,0 @@
-PROTOCCALLSFSUB1(IACWK,iacwk,INT)
-#define IACWK(A1) CCALLSFSUB1(IACWK,iacwk,INT,A1)
-
-PROTOCCALLSFSUB8(ICA,ica,FLOAT,FLOAT,FLOAT,FLOAT,INT,INT,PINT,STRING)
-#define ICA(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(ICA,ica,FLOAT,FLOAT,FLOAT,FLOAT,INT,INT,PINT,STRING,A1,A2,A3,A4,A5,A6,A7,A8)
-
-PROTOCCALLSFSUB0(ICLKS,iclks)
-#define ICLKS() CCALLSFSUB0(ICLKS,iclks)
-
-PROTOCCALLSFSUB2(ICLRWK,iclrwk,INT,INT)
-#define ICLRWK(A1,A2) CCALLSFSUB2(ICLRWK,iclrwk,INT,INT,A1,A2)
-
-PROTOCCALLSFSUB1(ICLWK,iclwk,INT)
-#define ICLWK(A1) CCALLSFSUB1(ICLWK,iclwk,INT,A1)
-
-PROTOCCALLSFSUB1(IDAWK,idawk,INT)
-#define IDAWK(A1) CCALLSFSUB1(IDAWK,idawk,INT,A1)
-
-PROTOCCALLSFSUB3(IFA,ifa,INT,FLOATV,FLOATV)
-#define IFA(A1,A2,A3) CCALLSFSUB3(IFA,ifa,INT,FLOATV,FLOATV,A1,A2,A3)
-
-PROTOCCALLSFSUB4(IFA3,ifa3,INT,FLOATV,FLOATV,FLOATV)
-#define IFA3(A1,A2,A3,A4) CCALLSFSUB4(IFA3,ifa3,INT,FLOATV,FLOATV,FLOATV,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB6(IGARC,igarc,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT)
-#define IGARC(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(IGARC,igarc,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,A1,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFSUB8(IGAXIS,igaxis,FLOAT,FLOAT,FLOAT,FLOAT,PFLOAT,PFLOAT,PINT,STRING)
-#define IGAXIS(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(IGAXIS,igaxis,FLOAT,FLOAT,FLOAT,FLOAT,PFLOAT,PFLOAT,PINT,STRING,A1,A2,A3,A4,A5,A6,A7,A8)
-
-PROTOCCALLSFSUB4(IGBOX,igbox,FLOAT,FLOAT,FLOAT,FLOAT)
-#define IGBOX(A1,A2,A3,A4) CCALLSFSUB4(IGBOX,igbox,FLOAT,FLOAT,FLOAT,FLOAT,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB9(IGCOLM,igcolm,FLOAT,FLOAT,FLOAT,FLOAT,PINT,INTV,FLOAT,FLOAT,STRING)
-#define IGCOLM(A1,A2,A3,A4,A5,A6,A7,A8,A9) CCALLSFSUB9(IGCOLM,igcolm,FLOAT,FLOAT,FLOAT,FLOAT,PINT,INTV,FLOAT,FLOAT,STRING,A1,A2,A3,A4,A5,A6,A7,A8,A9)
-
-PROTOCCALLSFSUB0(IGEND,igend)
-#define IGEND() CCALLSFSUB0(IGEND,igend)
-
-PROTOCCALLSFSUB4(IGHIST,ighist,INT,FLOATV,FLOATV,STRING)
-#define IGHIST(A1,A2,A3,A4) CCALLSFSUB4(IGHIST,ighist,INT,FLOATV,FLOATV,STRING,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB1(IGINIT,iginit,INT)
-#define IGINIT(A1) CCALLSFSUB1(IGINIT,iginit,INT,A1)
-
-PROTOCCALLSFSUB2(IGLBL,iglbl,INT,STRINGV)
-#define IGLBL(A1,A2) CCALLSFSUB2(IGLBL,iglbl,INT,STRINGV,A1,A2)
-
-PROTOCCALLSFSUB7(IGLOC,igloc,INT,PINT,PINT,PFLOAT,PFLOAT,PFLOAT,PFLOAT)
-#define IGLOC(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(IGLOC,igloc,INT,PINT,PINT,PFLOAT,PFLOAT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5,A6,A7)
-
-PROTOCCALLSFSUB8(IGLOC2,igloc2,INT,INT,FLOAT,FLOAT,FLOAT,FLOAT,INT,STRING)
-#define IGLOC2(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(IGLOC2,igloc2,INT,INT,FLOAT,FLOAT,FLOAT,FLOAT,INT,STRING,A1,A2,A3,A4,A5,A6,A7,A8)
-
-PROTOCCALLSFSUB14(IGMENU,igmenu,INT,STRING,PFLOAT,PFLOAT,PFLOAT,PFLOAT,INT,STRINGV,INT,STRINGV,STRINGV,PSTRINGV,PINT,STRING)
-#define IGMENU(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14) CCALLSFSUB14(IGMENU,igmenu,INT,STRING,PFLOAT,PFLOAT,PFLOAT,PFLOAT,INT,STRINGV,INT,STRINGV,STRINGV,PSTRINGV,PINT,STRING,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14)
-
-PROTOCCALLSFSUB4(IGMESS,igmess,INT,STRINGV,STRING,STRING)
-#define IGMESS(A1,A2,A3,A4) CCALLSFSUB4(IGMESS,igmess,INT,STRINGV,STRING,STRING,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB2(IGMETA,igmeta,INT,INT)
-#define IGMETA(A1,A2) CCALLSFSUB2(IGMETA,igmeta,INT,INT,A1,A2)
-
-PROTOCCALLSFSUB8(IGPAVE,igpave,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,INT,INT,STRING)
-#define IGPAVE(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(IGPAVE,igpave,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,INT,INT,STRING,A1,A2,A3,A4,A5,A6,A7,A8)
-
-PROTOCCALLSFSUB7(IGPICK,igpick,INT,FLOAT,FLOAT,PINT,PSTRINGV,PINT,STRING)
-#define IGPICK(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(IGPICK,igpick,INT,FLOAT,FLOAT,PINT,PSTRINGV,PINT,STRING,A1,A2,A3,A4,A5,A6,A7)
-
-PROTOCCALLSFSUB4(IGPID,igpid,INT,STRING,INT,STRING)
-#define IGPID(A1,A2,A3,A4) CCALLSFSUB4(IGPID,igpid,INT,STRING,INT,STRING,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB9(IGPIE,igpie,FLOAT,FLOAT,FLOAT,INT,FLOATV,STRING,INTV,INTV,INTV)
-#define IGPIE(A1,A2,A3,A4,A5,A6,A7,A8,A9) CCALLSFSUB9(IGPIE,igpie,FLOAT,FLOAT,FLOAT,INT,FLOATV,STRING,INTV,INTV,INTV,A1,A2,A3,A4,A5,A6,A7,A8,A9)
-
-PROTOCCALLSFSUB2(IGQ,igq,STRING,PFLOAT)
-#define IGQ(A1,A2) CCALLSFSUB2(IGQ,igq,STRING,PFLOAT,A1,A2)
-
-PROTOCCALLSFSUB3(IGQWK,igqwk,INT,STRING,FLOATV)
-#define IGQWK(A1,A2,A3) CCALLSFSUB3(IGQWK,igqwk,INT,STRING,FLOATV,A1,A2,A3)
-
-PROTOCCALLSFSUB4(IGRAPH,igraph,INT,FLOATV,FLOATV,STRING)
-#define IGRAPH(A1,A2,A3,A4) CCALLSFSUB4(IGRAPH,igraph,INT,FLOATV,FLOATV,STRING,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB2(IGRNG,igrng,FLOAT,FLOAT)
-#define IGRNG(A1,A2) CCALLSFSUB2(IGRNG,igrng,FLOAT,FLOAT,A1,A2)
-
-PROTOCCALLSFSUB1(IGRSIZ,igrsiz,INT)
-#define IGRSIZ(A1) CCALLSFSUB1(IGRSIZ,igrsiz,INT,A1)
-
-PROTOCCALLSFSUB6(IGRTOH,igrtoh,FLOAT,FLOAT,FLOAT,PFLOAT,PFLOAT,PFLOAT)
-#define IGRTOH(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(IGRTOH,igrtoh,FLOAT,FLOAT,FLOAT,PFLOAT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFSUB6(IGHTOR,ightor,FLOAT,FLOAT,FLOAT,PFLOAT,PFLOAT,PFLOAT)
-#define IGHTOR(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(IGHTOR,ightor,FLOAT,FLOAT,FLOAT,PFLOAT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFSUB1(IGSA,igsa,INT)
-#define IGSA(A1) CCALLSFSUB1(IGSA,igsa,INT,A1)
-
-PROTOCCALLSFSUB2(IGSET,igset,STRING,FLOAT)
-#define IGSET(A1,A2) CCALLSFSUB2(IGSET,igset,STRING,FLOAT,A1,A2)
-
-PROTOCCALLSFSUB1(IGSG,igsg,INT)
-#define IGSG(A1) CCALLSFSUB1(IGSG,igsg,INT,A1)
-
-PROTOCCALLSFSUB2(IGSSE,igsse,INT,INT)
-#define IGSSE(A1,A2) CCALLSFSUB2(IGSSE,igsse,INT,INT,A1,A2)
-
-PROTOCCALLSFSUB6(IGTABL,igtabl,INT,INT,FLOATV,INT,FLOATV,STRING)
-#define IGTABL(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(IGTABL,igtabl,INT,INT,FLOATV,INT,FLOATV,STRING,A1,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFSUB0(IGTERM,igterm)
-#define IGTERM() CCALLSFSUB0(IGTERM,igterm)
-
-PROTOCCALLSFSUB6(IGTEXT,igtext,FLOAT,FLOAT,STRING,FLOAT,PFLOAT,STRING)
-#define IGTEXT(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(IGTEXT,igtext,FLOAT,FLOAT,STRING,FLOAT,PFLOAT,STRING,A1,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFSUB1(IGWKTY,igwkty,PINT)
-#define IGWKTY(A1) CCALLSFSUB1(IGWKTY,igwkty,PINT,A1)
-
-PROTOCCALLSFSUB7(IGXMES,igxmes,INT,INT,INT,INT,STRINGV,STRING,STRING)
-#define IGXMES(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(IGXMES,igxmes,INT,INT,INT,INT,STRINGV,STRING,STRING,A1,A2,A3,A4,A5,A6,A7)
-
-PROTOCCALLSFSUB1(IGZSET,igzset,STRING)
-#define IGZSET(A1) CCALLSFSUB1(IGZSET,igzset,STRING,A1)
-
-PROTOCCALLSFSUB1(IOPKS,iopks,INT)
-#define IOPKS(A1) CCALLSFSUB1(IOPKS,iopks,INT,A1)
-
-PROTOCCALLSFSUB3(IOPWK,iopwk,INT,INT,INT)
-#define IOPWK(A1,A2,A3) CCALLSFSUB3(IOPWK,iopwk,INT,INT,INT,A1,A2,A3)
-
-PROTOCCALLSFSUB3(IPL,ipl,INT,FLOATV,FLOATV)
-#define IPL(A1,A2,A3) CCALLSFSUB3(IPL,ipl,INT,FLOATV,FLOATV,A1,A2,A3)
-
-PROTOCCALLSFSUB4(IPL3,ipl3,INT,FLOATV,FLOATV,FLOATV)
-#define IPL3(A1,A2,A3,A4) CCALLSFSUB4(IPL3,ipl3,INT,FLOATV,FLOATV,FLOATV,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB3(IPM,ipm,INT,FLOATV,FLOATV)
-#define IPM(A1,A2,A3) CCALLSFSUB3(IPM,ipm,INT,FLOATV,FLOATV,A1,A2,A3)
-
-PROTOCCALLSFSUB4(IPM3,ipm3,INT,FLOATV,FLOATV,FLOATV)
-#define IPM3(A1,A2,A3,A4) CCALLSFSUB4(IPM3,ipm3,INT,FLOATV,FLOATV,FLOATV,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB6(IPM3ID,ipm3id,INT,FLOATV,FLOATV,FLOATV,INT,INTV)
-#define IPM3ID(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(IPM3ID,ipm3id,INT,FLOATV,FLOATV,FLOATV,INT,INTV,A1,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFSUB9(IPM4ID,ipm4id,INT,FLOATV,FLOATV,FLOATV,FLOATV,FLOAT,FLOAT,INT,INTV)
-#define IPM4ID(A1,A2,A3,A4,A5,A6,A7,A8,A9) CCALLSFSUB9(IPM4ID,ipm4id,INT,FLOATV,FLOATV,FLOATV,FLOATV,FLOAT,FLOAT,INT,INTV,A1,A2,A3,A4,A5,A6,A7,A8,A9)
-
-PROTOCCALLSFSUB5(IPMID,ipmid,INT,FLOATV,FLOATV,INT,INTV)
-#define IPMID(A1,A2,A3,A4,A5) CCALLSFSUB5(IPMID,ipmid,INT,FLOATV,FLOATV,INT,INTV,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB6(IRQLC,irqlc,INT,INT,INT,INT,FLOAT,FLOAT)
-#define IRQLC(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(IRQLC,irqlc,INT,INT,INT,INT,FLOAT,FLOAT,A1,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFSUB5(IRQST,irqst,INT,INT,INT,INT,FLOAT)
-#define IRQST(A1,A2,A3,A4,A5) CCALLSFSUB5(IRQST,irqst,INT,INT,INT,INT,FLOAT,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB1(ISCHH,ischh,FLOAT)
-#define ISCHH(A1) CCALLSFSUB1(ISCHH,ischh,FLOAT,A1)
-
-PROTOCCALLSFSUB2(ISCHUP,ischup,FLOAT,FLOAT)
-#define ISCHUP(A1,A2) CCALLSFSUB2(ISCHUP,ischup,FLOAT,FLOAT,A1,A2)
-
-PROTOCCALLSFSUB1(ISCLIP,isclip,INT)
-#define ISCLIP(A1) CCALLSFSUB1(ISCLIP,isclip,INT,A1)
-
-PROTOCCALLSFSUB5(ISCR,iscr,INT,INT,FLOAT,FLOAT,FLOAT)
-#define ISCR(A1,A2,A3,A4,A5) CCALLSFSUB5(ISCR,iscr,INT,INT,FLOAT,FLOAT,FLOAT,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB1(ISELNT,iselnt,INT)
-#define ISELNT(A1) CCALLSFSUB1(ISELNT,iselnt,INT,A1)
-
-PROTOCCALLSFSUB1(ISFACI,isfaci,INT)
-#define ISFACI(A1) CCALLSFSUB1(ISFACI,isfaci,INT,A1)
-
-PROTOCCALLSFSUB1(ISFAIS,isfais,INT)
-#define ISFAIS(A1) CCALLSFSUB1(ISFAIS,isfais,INT,A1)
-
-PROTOCCALLSFSUB1(ISFASI,isfasi,INT)
-#define ISFASI(A1) CCALLSFSUB1(ISFASI,isfasi,INT,A1)
-
-PROTOCCALLSFSUB1(ISLN,isln,INT)
-#define ISLN(A1) CCALLSFSUB1(ISLN,isln,INT,A1)
-
-PROTOCCALLSFSUB1(ISLWSC,islwsc,FLOAT)
-#define ISLWSC(A1) CCALLSFSUB1(ISLWSC,islwsc,FLOAT,A1)
-
-PROTOCCALLSFSUB1(ISMK,ismk,INT)
-#define ISMK(A1) CCALLSFSUB1(ISMK,ismk,INT,A1)
-
-PROTOCCALLSFSUB1(ISMKSC,ismksc,FLOAT)
-#define ISMKSC(A1) CCALLSFSUB1(ISMKSC,ismksc,FLOAT,A1)
-
-PROTOCCALLSFSUB1(ISPLCI,isplci,INT)
-#define ISPLCI(A1) CCALLSFSUB1(ISPLCI,isplci,INT,A1)
-
-PROTOCCALLSFSUB1(ISPMCI,ispmci,INT)
-#define ISPMCI(A1) CCALLSFSUB1(ISPMCI,ispmci,INT,A1)
-
-PROTOCCALLSFSUB2(ISTXAL,istxal,INT,INT)
-#define ISTXAL(A1,A2) CCALLSFSUB2(ISTXAL,istxal,INT,INT,A1,A2)
-
-PROTOCCALLSFSUB1(ISTXCI,istxci,INT)
-#define ISTXCI(A1) CCALLSFSUB1(ISTXCI,istxci,INT,A1)
-
-PROTOCCALLSFSUB2(ISTXFP,istxfp,INT,INT)
-#define ISTXFP(A1,A2) CCALLSFSUB2(ISTXFP,istxfp,INT,INT,A1,A2)
-
-PROTOCCALLSFSUB5(ISVP,isvp,INT,FLOAT,FLOAT,FLOAT,FLOAT)
-#define ISVP(A1,A2,A3,A4,A5) CCALLSFSUB5(ISVP,isvp,INT,FLOAT,FLOAT,FLOAT,FLOAT,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB5(ISWKVP,iswkvp,INT,FLOAT,FLOAT,FLOAT,FLOAT)
-#define ISWKVP(A1,A2,A3,A4,A5) CCALLSFSUB5(ISWKVP,iswkvp,INT,FLOAT,FLOAT,FLOAT,FLOAT,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB5(ISWKWN,iswkwn,INT,FLOAT,FLOAT,FLOAT,FLOAT)
-#define ISWKWN(A1,A2,A3,A4,A5) CCALLSFSUB5(ISWKWN,iswkwn,INT,FLOAT,FLOAT,FLOAT,FLOAT,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB5(ISWN,iswn,INT,FLOAT,FLOAT,FLOAT,FLOAT)
-#define ISWN(A1,A2,A3,A4,A5) CCALLSFSUB5(ISWN,iswn,INT,FLOAT,FLOAT,FLOAT,FLOAT,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB3(ITX,itx,FLOAT,FLOAT,STRING)
-#define ITX(A1,A2,A3) CCALLSFSUB3(ITX,itx,FLOAT,FLOAT,STRING,A1,A2,A3)
-
-PROTOCCALLSFSUB4(ITX3,itx3,FLOAT,FLOAT,FLOAT,STRING)
-#define ITX3(A1,A2,A3,A4) CCALLSFSUB4(ITX3,itx3,FLOAT,FLOAT,FLOAT,STRING,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB2(IUWK,iuwk,INT,INT)
-#define IUWK(A1,A2) CCALLSFSUB2(IUWK,iuwk,INT,INT,A1,A2)
-
-PROTOCCALLSFSUB2(IZCTOI,izctoi,STRING,INT)
-#define IZCTOI(A1,A2) CCALLSFSUB2(IZCTOI,izctoi,STRING,INT,A1,A2)
-
-PROTOCCALLSFSUB2(IZCTOR,izctor,STRING,PFLOAT)
-#define IZCTOR(A1,A2) CCALLSFSUB2(IZCTOR,izctor,STRING,PFLOAT,A1,A2)
-
-PROTOCCALLSFSUB2(IZITOC,izitoc,INT,STRING)
-#define IZITOC(A1,A2) CCALLSFSUB2(IZITOC,izitoc,INT,STRING,A1,A2)
-
-PROTOCCALLSFSUB6(IZOPEN,izopen,INT,STRING,STRING,STRING,INT,INT)
-#define IZOPEN(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(IZOPEN,izopen,INT,STRING,STRING,STRING,INT,INT,A1,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFSUB2(IZOUT,izout,STRING,INT)
-#define IZOUT(A1,A2) CCALLSFSUB2(IZOUT,izout,STRING,INT,A1,A2)
-
-PROTOCCALLSFSUB2(IZPICT,izpict,PSTRING,STRING)
-#define IZPICT(A1,A2) CCALLSFSUB2(IZPICT,izpict,PSTRING,STRING,A1,A2)
-
-PROTOCCALLSFSUB2(IZRTOC,izrtoc,FLOAT,PSTRING)
-#define IZRTOC(A1,A2) CCALLSFSUB2(IZRTOC,izrtoc,FLOAT,PSTRING,A1,A2)
diff --git a/src/cfortran/hplot.h b/src/cfortran/hplot.h
deleted file mode 100644
index d14d855..0000000
--- a/src/cfortran/hplot.h
+++ /dev/null
@@ -1,155 +0,0 @@
-PROTOCCALLSFSUB10(HPLAER,hplaer,FLOATV,FLOATV,FLOATV,FLOATV,FLOATV,FLOATV,INT,STRING,INT,FLOAT)
-#define HPLAER(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10) CCALLSFSUB10(HPLAER,hplaer,FLOATV,FLOATV,FLOATV,FLOATV,FLOATV,FLOATV,INT,STRING,INT,FLOAT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10)
-
-PROTOCCALLSFSUB5(HPLARC,hplarc,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT)
-#define HPLARC(A1,A2,A3,A4,A5) CCALLSFSUB5(HPLARC,hplarc,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB5(HPLBOX,hplbox,FLOAT,FLOAT,FLOAT,FLOAT,STRING)
-#define HPLBOX(A1,A2,A3,A4,A5) CCALLSFSUB5(HPLBOX,hplbox,FLOAT,FLOAT,FLOAT,FLOAT,STRING,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB1(HPLCAP,hplcap,INT)
-#define HPLCAP(A1) CCALLSFSUB1(HPLCAP,hplcap,INT,A1)
-
-PROTOCCALLSFSUB1(HPLAX2,hplax2,FLOATV)
-#define HPLAX2(A1) CCALLSFSUB1(HPLAX2,hplax2,FLOATV,A1)
-
-PROTOCCALLSFSUB1(HPLATT,hplatt,INT)
-#define HPLATT(A1) CCALLSFSUB1(HPLATT,hplatt,INT,A1)
-
-PROTOCCALLSFSUB8(HPLCHA,hplcha,INT,FLOAT,FLOAT,PINT,PFLOAT,PFLOAT,PINT,PINT)
-#define HPLCHA(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(HPLCHA,hplcha,INT,FLOAT,FLOAT,PINT,PFLOAT,PFLOAT,PINT,PINT,A1,A2,A3,A4,A5,A6,A7,A8)
-
-PROTOCCALLSFSUB3(HPLCOM,hplcom,FLOAT,FLOAT,STRING)
-#define HPLCOM(A1,A2,A3) CCALLSFSUB3(HPLCOM,hplcom,FLOAT,FLOAT,STRING,A1,A2,A3)
-
-PROTOCCALLSFSUB3(HPLABL,hplabl,INT,INT,STRINGV)
-#define HPLABL(A1,A2,A3) CCALLSFSUB3(HPLABL,hplabl,INT,INT,STRINGV,A1,A2,A3)
-
-PROTOCCALLSFSUB3(HPLCON,hplcon,INT,INT,INT)
-#define HPLCON(A1,A2,A3) CCALLSFSUB3(HPLCON,hplcon,INT,INT,INT,A1,A2,A3)
-
-PROTOCCALLSFSUB0(HPLDAT,hpldat)
-#define HPLDAT() CCALLSFSUB0(HPLDAT,hpldat)
-
-PROTOCCALLSFSUB1(HPLDO,hpldo,INT)
-#define HPLDO(A1) CCALLSFSUB1(HPLDO,hpldo,INT,A1)
-
-PROTOCCALLSFSUB3(HPLEGO,hplego,INT,FLOAT,FLOAT)
-#define HPLEGO(A1,A2,A3) CCALLSFSUB3(HPLEGO,hplego,INT,FLOAT,FLOAT,A1,A2,A3)
-
-PROTOCCALLSFSUB0(HPLEND,hplend)
-#define HPLEND() CCALLSFSUB0(HPLEND,hplend)
-
-PROTOCCALLSFSUB8(HPLERR,hplerr,FLOATV,FLOATV,FLOATV,FLOATV,INT,STRING,INT,FLOAT)
-#define HPLERR(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(HPLERR,hplerr,FLOATV,FLOATV,FLOATV,FLOATV,INT,STRING,INT,FLOAT,A1,A2,A3,A4,A5,A6,A7,A8)
-
-PROTOCCALLSFSUB9(HPLFR3,hplfr3,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,STRING)
-#define HPLFR3(A1,A2,A3,A4,A5,A6,A7,A8,A9) CCALLSFSUB9(HPLFR3,hplfr3,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,STRING,A1,A2,A3,A4,A5,A6,A7,A8,A9)
-
-PROTOCCALLSFSUB5(HPLFRA,hplfra,FLOAT,FLOAT,FLOAT,FLOAT,STRING)
-#define HPLFRA(A1,A2,A3,A4,A5) CCALLSFSUB5(HPLFRA,hplfra,FLOAT,FLOAT,FLOAT,FLOAT,STRING,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB4(HPLFUN,hplfun,FLOATV,FLOATV,INT,STRING)
-#define HPLFUN(A1,A2,A3,A4) CCALLSFSUB4(HPLFUN,hplfun,FLOATV,FLOATV,INT,STRING,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB4(HPLGIV,hplgiv,PFLOAT,PFLOAT,PFLOAT,PFLOAT)
-#define HPLGIV(A1,A2,A3,A4) CCALLSFSUB4(HPLGIV,hplgiv,PFLOAT,PFLOAT,PFLOAT,PFLOAT,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB0(HPLGTL,hplgtl)
-#define HPLGTL() CCALLSFSUB0(HPLGTL,hplgtl)
-
-PROTOCCALLSFSUB2(HPLGZO,hplgzo,PINT,PINT)
-#define HPLGZO(A1,A2) CCALLSFSUB2(HPLGZO,hplgzo,PINT,PINT,A1,A2)
-
-PROTOCCALLSFSUB4(HPLINE,hpline,FLOATV,FLOATV,INT,STRING)
-#define HPLINE(A1,A2,A3,A4) CCALLSFSUB4(HPLINE,hpline,FLOATV,FLOATV,INT,STRING,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB1(HPLINT,hplint,INT)
-#define HPLINT(A1) CCALLSFSUB1(HPLINT,hplint,INT,A1)
-
-PROTOCCALLSFSUB3(HPLIST,hplist,INT,INT,INTV)
-#define HPLIST(A1,A2,A3) CCALLSFSUB3(HPLIST,hplist,INT,INT,INTV,A1,A2,A3)
-
-PROTOCCALLSFSUB4(HPLKEY,hplkey,FLOAT,FLOAT,INT,STRING)
-#define HPLKEY(A1,A2,A3,A4) CCALLSFSUB4(HPLKEY,hplkey,FLOAT,FLOAT,INT,STRING,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB0(HPLNEW,hplnew)
-#define HPLNEW() CCALLSFSUB0(HPLNEW,hplnew)
-
-PROTOCCALLSFSUB7(HPLNT,hplnt,INT,INT,FLOAT,INT,INT,INT,INT)
-#define HPLNT(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(HPLNT,hplnt,INT,INT,FLOAT,INT,INT,INT,INT,A1,A2,A3,A4,A5,A6,A7)
-
-PROTOCCALLSFSUB0(HPLNUL,hplnul)
-#define HPLNUL() CCALLSFSUB0(HPLNUL,hplnul)
-
-PROTOCCALLSFSUB0(HPLNXT,hplnxt)
-#define HPLNXT() CCALLSFSUB0(HPLNXT,hplnxt)
-
-PROTOCCALLSFSUB8(HPLOC,hploc,INT,INT,PFLOAT,PFLOAT,INT,INT,INT,INT)
-#define HPLOC(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(HPLOC,hploc,INT,INT,PFLOAT,PFLOAT,INT,INT,INT,INT,A1,A2,A3,A4,A5,A6,A7,A8)
-
-PROTOCCALLSFSUB2(HPLOPT,hplopt,STRINGV,INT)
-#define HPLOPT(A1,A2) CCALLSFSUB2(HPLOPT,hplopt,STRINGV,INT,A1,A2)
-
-PROTOCCALLSFSUB4(HPLOT,hplot,INT,STRING,STRING,INT)
-#define HPLOT(A1,A2,A3,A4) CCALLSFSUB4(HPLOT,hplot,INT,STRING,STRING,INT,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB3(HPLPRO,hplpro,INT,STRING,STRING)
-#define HPLPRO(A1,A2,A3) CCALLSFSUB3(HPLPRO,hplpro,INT,STRING,STRING,A1,A2,A3)
-
-PROTOCCALLSFSUB2(HPLPTO,hplpto,STRING,PSTRING)
-#define HPLPTO(A1,A2) CCALLSFSUB2(HPLPTO,hplpto,STRING,PSTRING,A1,A2)
-
-PROTOCCALLSFSUB2(HPLSET,hplset,STRING,PFLOAT)
-#define HPLSET(A1,A2) CCALLSFSUB2(HPLSET,hplset,STRING,PFLOAT,A1,A2)
-
-PROTOCCALLSFSUB2(HPLQOP,hplqop,STRING,PFLOAT)
-#define HPLQOP(A1,A2) CCALLSFSUB2(HPLQOP,hplqop,STRING,PFLOAT,A1,A2)
-
-PROTOCCALLSFSUB3(HPLSIZ,hplsiz,PFLOAT,PFLOAT,STRING)
-#define HPLSIZ(A1,A2,A3) CCALLSFSUB3(HPLSIZ,hplsiz,PFLOAT,PFLOAT,STRING,A1,A2,A3)
-
-PROTOCCALLSFSUB7(HPLSOF,hplsof,FLOAT,FLOAT,STRING,FLOAT,FLOAT,FLOAT,INT)
-#define HPLSOF(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(HPLSOF,hplsof,FLOAT,FLOAT,STRING,FLOAT,FLOAT,FLOAT,INT,A1,A2,A3,A4,A5,A6,A7)
-
-PROTOCCALLSFSUB4(HPLSUR,hplsur,INT,FLOAT,FLOAT,INT)
-#define HPLSUR(A1,A2,A3,A4) CCALLSFSUB4(HPLSUR,hplsur,INT,FLOAT,FLOAT,INT,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB6(HPLSYM,hplsym,FLOATV,FLOATV,INT,INT,FLOAT,STRING)
-#define HPLSYM(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(HPLSYM,hplsym,FLOATV,FLOATV,INT,INT,FLOAT,STRING,A1,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFSUB4(HPLTAB,hpltab,INT,INT,FLOAT,FLOAT)
-#define HPLTAB(A1,A2,A3,A4) CCALLSFSUB4(HPLTAB,hpltab,INT,INT,FLOAT,FLOAT,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB1(HPLTIT,hpltit,STRING)
-#define HPLTIT(A1) CCALLSFSUB1(HPLTIT,hpltit,STRING,A1)
-
-PROTOCCALLSFSUB5(HPLTOC,hpltoc,FLOAT,FLOAT,PFLOAT,PFLOAT,PINT)
-#define HPLTOC(A1,A2,A3,A4,A5) CCALLSFSUB5(HPLTOC,hpltoc,FLOAT,FLOAT,PFLOAT,PFLOAT,PINT,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB6(HPLTXT,hpltxt,FLOAT,FLOAT,STRING,INT,INT,INT)
-#define HPLTXT(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(HPLTXT,hpltxt,FLOAT,FLOAT,STRING,INT,INT,INT,A1,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFSUB3(HPLUSR,hplusr,INT,STRING,INT)
-#define HPLUSR(A1,A2,A3) CCALLSFSUB3(HPLUSR,hplusr,INT,STRING,INT,A1,A2,A3)
-
-PROTOCCALLSFSUB4(HPLWIN,hplwin,INT,INT,INT,INT)
-#define HPLWIN(A1,A2,A3,A4) CCALLSFSUB4(HPLWIN,hplwin,INT,INT,INT,INT,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB4(HPLWIR,hplwir,STRING,FLOAT,FLOAT,STRING)
-#define HPLWIR(A1,A2,A3,A4) CCALLSFSUB4(HPLWIR,hplwir,STRING,FLOAT,FLOAT,STRING,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB4(HPLZOM,hplzom,INT,STRING,INT,INT)
-#define HPLZOM(A1,A2,A3,A4) CCALLSFSUB4(HPLZOM,hplzom,INT,STRING,INT,INT,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB4(HPLZON,hplzon,INT,INT,INT,STRING)
-#define HPLZON(A1,A2,A3,A4) CCALLSFSUB4(HPLZON,hplzon,INT,INT,INT,STRING,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB3(HPLAXI,hplaxi,FLOATV,FLOATV,INT)
-#define HPLAXI(A1,A2,A3) CCALLSFSUB3(HPLAXI,hplaxi,FLOATV,FLOATV,INT,A1,A2,A3)
-
-PROTOCCALLSFSUB3(HPLSTA,hplsta,INT,STRING,INT)
-#define HPLSTA(A1,A2,A3) CCALLSFSUB3(HPLSTA,hplsta,INT,STRING,INT,A1,A2,A3)
-
-PROTOCCALLSFSUB5(HPLLGD,hpllgd,STRING,STRING,STRING,INT,STRING)
-#define HPLLGD(A1,A2,A3,A4,A5) CCALLSFSUB5(HPLLGD,hpllgd,STRING,STRING,STRING,INT,STRING,A1,A2,A3,A4,A5)
diff --git a/src/cfortran/jetset74.h b/src/cfortran/jetset74.h
deleted file mode 100644
index ac181f4..0000000
--- a/src/cfortran/jetset74.h
+++ /dev/null
@@ -1,329 +0,0 @@
-PROTOCCALLSFFUN2(INT,KLU,klu,INT,INT)
-#define KLU(A2,A3) CCALLSFFUN2(KLU,klu,INT,INT,A2,A3)
-
-PROTOCCALLSFFUN2(FLOAT,PLU,plu,INT,INT)
-#define PLU(A2,A3) CCALLSFFUN2(PLU,plu,INT,INT,A2,A3)
-
-PROTOCCALLSFFUN4(FLOAT,PYCTQ2,pyctq2,INT,INT,FLOAT,FLOAT)
-#define PYCTQ2(A2,A3,A4,A5) CCALLSFFUN4(PYCTQ2,pyctq2,INT,INT,FLOAT,FLOAT,A2,A3,A4,A5)
-
-PROTOCCALLSFFUN1(DOUBLE,PYDILN,pydiln,DOUBLE)
-#define PYDILN(A2) CCALLSFFUN1(PYDILN,pydiln,DOUBLE,A2)
-
-PROTOCCALLSFFUN1(INT,LUCHGE,luchge,INT)
-#define LUCHGE(A2) CCALLSFFUN1(LUCHGE,luchge,INT,A2)
-
-PROTOCCALLSFFUN1(INT,LUCOMP,lucomp,INT)
-#define LUCOMP(A2) CCALLSFFUN1(LUCOMP,lucomp,INT,A2)
-
-PROTOCCALLSFFUN1(FLOAT,PYGAMM,pygamm,FLOAT)
-#define PYGAMM(A2) CCALLSFFUN1(PYGAMM,pygamm,FLOAT,A2)
-
-PROTOCCALLSFFUN3(FLOAT,PYHFTH,pyhfth,FLOAT,FLOAT,FLOAT)
-#define PYHFTH(A2,A3,A4) CCALLSFFUN3(PYHFTH,pyhfth,FLOAT,FLOAT,FLOAT,A2,A3,A4)
-
-PROTOCCALLSFFUN3(FLOAT,PYSPEN,pyspen,FLOAT,FLOAT,INT)
-#define PYSPEN(A2,A3,A4) CCALLSFFUN3(PYSPEN,pyspen,FLOAT,FLOAT,INT,A2,A3,A4)
-
-PROTOCCALLSFFUN2(DOUBLE,RKDOT,rkdot,DOUBLEV,DOUBLEV)
-#define RKDOT(A2,A3) CCALLSFFUN2(RKDOT,rkdot,DOUBLEV,DOUBLEV,A2,A3)
-
-PROTOCCALLSFFUN1(DOUBLE,RKRAND,rkrand,INT)
-#define RKRAND(A2) CCALLSFFUN1(RKRAND,rkrand,INT,A2)
-
-PROTOCCALLSFFUN6(COMPLEX,RKZF,rkzf,INT,DOUBLEV,DOUBLEV,DOUBLE,INT,DOUBLEV)
-#define RKZF(A2,A3,A4,A5,A6,A7) CCALLSFFUN6(RKZF,rkzf,INT,DOUBLEV,DOUBLEV,DOUBLE,INT,DOUBLEV,A2,A3,A4,A5,A6,A7)
-
-PROTOCCALLSFFUN3(COMPLEX,RKZPR,rkzpr,INT,DOUBLEV,DOUBLEV)
-#define RKZPR(A2,A3,A4) CCALLSFFUN3(RKZPR,rkzpr,INT,DOUBLEV,DOUBLEV,A2,A3,A4)
-
-PROTOCCALLSFFUN4(COMPLEX,RKZSF,rkzsf,INT,DOUBLEV,INT,DOUBLEV)
-#define RKZSF(A2,A3,A4,A5) CCALLSFFUN4(RKZSF,rkzsf,INT,DOUBLEV,INT,DOUBLEV,A2,A3,A4,A5)
-
-PROTOCCALLSFFUN1(FLOAT,RLU,rlu,INT)
-#define RLU(A2) CCALLSFFUN1(RLU,rlu,INT,A2)
-
-PROTOCCALLSFFUN1(FLOAT,ULALEM,ulalem,FLOAT)
-#define ULALEM(A2) CCALLSFFUN1(ULALEM,ulalem,FLOAT,A2)
-
-PROTOCCALLSFFUN1(FLOAT,ULALPS,ulalps,FLOAT)
-#define ULALPS(A2) CCALLSFFUN1(ULALPS,ulalps,FLOAT,A2)
-
-PROTOCCALLSFFUN2(FLOAT,ULANGL,ulangl,FLOAT,FLOAT)
-#define ULANGL(A2,A3) CCALLSFFUN2(ULANGL,ulangl,FLOAT,FLOAT,A2,A3)
-
-PROTOCCALLSFFUN1(FLOAT,ULMASS,ulmass,INT)
-#define ULMASS(A2) CCALLSFFUN1(ULMASS,ulmass,INT,A2)
-
-PROTOCCALLSFSUB5(LU1ENT,lu1ent,INT,INT,FLOAT,FLOAT,FLOAT)
-#define LU1ENT(A1,A2,A3,A4,A5) CCALLSFSUB5(LU1ENT,lu1ent,INT,INT,FLOAT,FLOAT,FLOAT,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB4(LU2ENT,lu2ent,INT,INT,INT,FLOAT)
-#define LU2ENT(A1,A2,A3,A4) CCALLSFSUB4(LU2ENT,lu2ent,INT,INT,INT,FLOAT,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB7(LU3ENT,lu3ent,INT,INT,INT,INT,FLOAT,FLOAT,FLOAT)
-#define LU3ENT(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(LU3ENT,lu3ent,INT,INT,INT,INT,FLOAT,FLOAT,FLOAT,A1,A2,A3,A4,A5,A6,A7)
-
-PROTOCCALLSFSUB11(LU4ENT,lu4ent,INT,INT,INT,INT,INT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT)
-#define LU4ENT(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11) CCALLSFSUB11(LU4ENT,lu4ent,INT,INT,INT,INT,INT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11)
-
-PROTOCCALLSFSUB1(LUBOEI,luboei,INT)
-#define LUBOEI(A1) CCALLSFSUB1(LUBOEI,luboei,INT,A1)
-
-PROTOCCALLSFSUB1(LUCELL,lucell,PINT)
-#define LUCELL(A1) CCALLSFSUB1(LUCELL,lucell,PINT,A1)
-
-PROTOCCALLSFSUB1(LUCLUS,luclus,PINT)
-#define LUCLUS(A1) CCALLSFSUB1(LUCLUS,luclus,PINT,A1)
-
-PROTOCCALLSFSUB1(LUDECY,ludecy,INT)
-#define LUDECY(A1) CCALLSFSUB1(LUDECY,ludecy,INT,A1)
-
-PROTOCCALLSFSUB1(LUEDIT,luedit,INT)
-#define LUEDIT(A1) CCALLSFSUB1(LUEDIT,luedit,INT,A1)
-
-PROTOCCALLSFSUB2(LUEEVT,lueevt,INT,FLOAT)
-#define LUEEVT(A1,A2) CCALLSFSUB2(LUEEVT,lueevt,INT,FLOAT,A1,A2)
-
-PROTOCCALLSFSUB2(LUERRM,luerrm,INT,BYTE)
-#define LUERRM(A1,A2) CCALLSFSUB2(LUERRM,luerrm,INT,BYTE,A1,A2)
-
-PROTOCCALLSFSUB0(LUEXEC,luexec)
-#define LUEXEC() CCALLSFSUB0(LUEXEC,luexec)
-
-PROTOCCALLSFSUB4(LUFOWO,lufowo,PFLOAT,PFLOAT,PFLOAT,PFLOAT)
-#define LUFOWO(A1,A2,A3,A4) CCALLSFSUB4(LUFOWO,lufowo,PFLOAT,PFLOAT,PFLOAT,PFLOAT,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB1(LUGIVE,lugive,BYTE)
-#define LUGIVE(A1) CCALLSFSUB1(LUGIVE,lugive,BYTE,A1)
-
-PROTOCCALLSFSUB1(LUHEPC,luhepc,INT)
-#define LUHEPC(A1) CCALLSFSUB1(LUHEPC,luhepc,INT,A1)
-
-PROTOCCALLSFSUB1(LUINDF,luindf,INT)
-#define LUINDF(A1) CCALLSFSUB1(LUINDF,luindf,INT,A1)
-
-PROTOCCALLSFSUB2(LUJMAS,lujmas,PFLOAT,PFLOAT)
-#define LUJMAS(A1,A2) CCALLSFSUB2(LUJMAS,lujmas,PFLOAT,PFLOAT,A1,A2)
-
-PROTOCCALLSFSUB2(LUJOIN,lujoin,INT,INTV)
-#define LUJOIN(A1,A2) CCALLSFSUB2(LUJOIN,lujoin,INT,INTV,A1,A2)
-
-PROTOCCALLSFSUB4(LUKFDI,lukfdi,INT,INT,PINT,PINT)
-#define LUKFDI(A1,A2,A3,A4) CCALLSFSUB4(LUKFDI,lukfdi,INT,INT,PINT,PINT,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB1(LULIST,lulist,INT)
-#define LULIST(A1) CCALLSFSUB1(LULIST,lulist,INT,A1)
-
-PROTOCCALLSFSUB0(LULOGO,lulogo)
-#define LULOGO() CCALLSFSUB0(LULOGO,lulogo)
-
-PROTOCCALLSFSUB2(LUNAME,luname,INT,PBYTE)
-#define LUNAME(A1,A2) CCALLSFSUB2(LUNAME,luname,INT,PBYTE,A1,A2)
-
-PROTOCCALLSFSUB2(LUONIA,luonia,INT,FLOAT)
-#define LUONIA(A1,A2) CCALLSFSUB2(LUONIA,luonia,INT,FLOAT,A1,A2)
-
-PROTOCCALLSFSUB1(LUPREP,luprep,INT)
-#define LUPREP(A1) CCALLSFSUB1(LUPREP,luprep,INT,A1)
-
-PROTOCCALLSFSUB3(LUPTDI,luptdi,INT,PFLOAT,PFLOAT)
-#define LUPTDI(A1,A2,A3) CCALLSFSUB3(LUPTDI,luptdi,INT,PFLOAT,PFLOAT,A1,A2,A3)
-
-PROTOCCALLSFSUB6(LURADK,luradk,FLOAT,PINT,PFLOAT,PFLOAT,PFLOAT,PFLOAT)
-#define LURADK(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(LURADK,luradk,FLOAT,PINT,PFLOAT,PFLOAT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFSUB7(LUDBRB,ludbrb,INT,INT,FLOAT,FLOAT,DOUBLE,DOUBLE,DOUBLE)
-#define LUDBRB(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(LUDBRB,ludbrb,INT,INT,FLOAT,FLOAT,DOUBLE,DOUBLE,DOUBLE,A1,A2,A3,A4,A5,A6,A7)
-
-PROTOCCALLSFSUB5(LUROBO,lurobo,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT)
-#define LUROBO(A1,A2,A3,A4,A5) CCALLSFSUB5(LUROBO,lurobo,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB3(LUSHOW,lushow,INT,INT,FLOAT)
-#define LUSHOW(A1,A2,A3) CCALLSFSUB3(LUSHOW,lushow,INT,INT,FLOAT,A1,A2,A3)
-
-PROTOCCALLSFSUB2(LUSPHE,lusphe,PFLOAT,PFLOAT)
-#define LUSPHE(A1,A2) CCALLSFSUB2(LUSPHE,lusphe,PFLOAT,PFLOAT,A1,A2)
-
-PROTOCCALLSFSUB1(LUSTRF,lustrf,INT)
-#define LUSTRF(A1) CCALLSFSUB1(LUSTRF,lustrf,INT,A1)
-
-PROTOCCALLSFSUB1(LUTABU,lutabu,INT)
-#define LUTABU(A1) CCALLSFSUB1(LUTABU,lutabu,INT,A1)
-
-PROTOCCALLSFSUB4(LUTAUD,lutaud,INT,INT,INT,PINT)
-#define LUTAUD(A1,A2,A3,A4) CCALLSFSUB4(LUTAUD,lutaud,INT,INT,INT,PINT,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB1(LUTEST,lutest,INT)
-#define LUTEST(A1) CCALLSFSUB1(LUTEST,lutest,INT,A1)
-
-PROTOCCALLSFSUB2(LUTHRU,luthru,PFLOAT,PFLOAT)
-#define LUTHRU(A1,A2) CCALLSFSUB2(LUTHRU,luthru,PFLOAT,PFLOAT,A1,A2)
-
-PROTOCCALLSFSUB2(LUUPDA,luupda,INT,INT)
-#define LUUPDA(A1,A2) CCALLSFSUB2(LUUPDA,luupda,INT,INT,A1,A2)
-
-PROTOCCALLSFSUB6(LUX3JT,lux3jt,PINT,FLOAT,INT,FLOAT,PFLOAT,PFLOAT)
-#define LUX3JT(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(LUX3JT,lux3jt,PINT,FLOAT,INT,FLOAT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFSUB10(LUX4JT,lux4jt,PINT,FLOAT,INT,FLOAT,PINT,PFLOAT,PFLOAT,PFLOAT,PFLOAT,PFLOAT)
-#define LUX4JT(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10) CCALLSFSUB10(LUX4JT,lux4jt,PINT,FLOAT,INT,FLOAT,PINT,PFLOAT,PFLOAT,PFLOAT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10)
-
-PROTOCCALLSFSUB7(LUXDIF,luxdif,INT,INT,INT,FLOAT,PFLOAT,PFLOAT,PFLOAT)
-#define LUXDIF(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(LUXDIF,luxdif,INT,INT,INT,FLOAT,PFLOAT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5,A6,A7)
-
-PROTOCCALLSFSUB3(LUXJET,luxjet,FLOAT,PINT,PFLOAT)
-#define LUXJET(A1,A2,A3) CCALLSFSUB3(LUXJET,luxjet,FLOAT,PINT,PFLOAT,A1,A2,A3)
-
-PROTOCCALLSFSUB4(LUXKFL,luxkfl,INT,FLOAT,FLOAT,PINT)
-#define LUXKFL(A1,A2,A3,A4) CCALLSFSUB4(LUXKFL,luxkfl,INT,FLOAT,FLOAT,PINT,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB3(LUXTOT,luxtot,INT,FLOAT,PFLOAT)
-#define LUXTOT(A1,A2,A3) CCALLSFSUB3(LUXTOT,luxtot,INT,FLOAT,PFLOAT,A1,A2,A3)
-
-PROTOCCALLSFSUB4(LUZDIS,luzdis,INT,INT,FLOAT,PFLOAT)
-#define LUZDIS(A1,A2,A3,A4) CCALLSFSUB4(LUZDIS,luzdis,INT,INT,FLOAT,PFLOAT,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB2(PDFSET,pdfset,PSTRINGV,PDOUBLE)
-#define PDFSET(A1,A2) CCALLSFSUB2(PDFSET,pdfset,PSTRINGV,PDOUBLE,A1,A2)
-
-PROTOCCALLSFSUB0(PYDIFF,pydiff)
-#define PYDIFF() CCALLSFSUB0(PYDIFF,pydiff)
-
-PROTOCCALLSFSUB0(PYDOCU,pydocu)
-#define PYDOCU() CCALLSFSUB0(PYDOCU,pydocu)
-
-PROTOCCALLSFSUB0(PYEVNT,pyevnt)
-#define PYEVNT() CCALLSFSUB0(PYEVNT,pyevnt)
-
-PROTOCCALLSFSUB1(PYEVWT,pyevwt,PFLOAT)
-#define PYEVWT(A1) CCALLSFSUB1(PYEVWT,pyevwt,PFLOAT,A1)
-
-PROTOCCALLSFSUB1(PYFRAM,pyfram,INT)
-#define PYFRAM(A1) CCALLSFSUB1(PYFRAM,pyfram,INT,A1)
-
-PROTOCCALLSFSUB4(PYI3AU,pyi3au,FLOAT,FLOAT,PFLOAT,PFLOAT)
-#define PYI3AU(A1,A2,A3,A4) CCALLSFSUB4(PYI3AU,pyi3au,FLOAT,FLOAT,PFLOAT,PFLOAT,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB4(PYINIT,pyinit,STRING,STRING,STRING,FLOAT)
-#define PYINIT(A1,A2,A3,A4) CCALLSFSUB4(PYINIT,pyinit,STRING,STRING,STRING,FLOAT,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB1(PYINKI,pyinki,INT)
-#define PYINKI(A1) CCALLSFSUB1(PYINKI,pyinki,INT,A1)
-
-PROTOCCALLSFSUB0(PYINPR,pyinpr)
-#define PYINPR() CCALLSFSUB0(PYINPR,pyinpr)
-
-PROTOCCALLSFSUB0(PYINRE,pyinre)
-#define PYINRE() CCALLSFSUB0(PYINRE,pyinre)
-
-PROTOCCALLSFSUB1(PYKCUT,pykcut,PINT)
-#define PYKCUT(A1) CCALLSFSUB1(PYKCUT,pykcut,PINT,A1)
-
-PROTOCCALLSFSUB1(PYKLIM,pyklim,INT)
-#define PYKLIM(A1) CCALLSFSUB1(PYKLIM,pyklim,INT,A1)
-
-PROTOCCALLSFSUB3(PYKMAP,pykmap,INT,INT,FLOAT)
-#define PYKMAP(A1,A2,A3) CCALLSFSUB3(PYKMAP,pykmap,INT,INT,FLOAT,A1,A2,A3)
-
-PROTOCCALLSFSUB0(PYMAXI,pymaxi)
-#define PYMAXI() CCALLSFSUB0(PYMAXI,pymaxi)
-
-PROTOCCALLSFSUB1(PYMULT,pymult,INT)
-#define PYMULT(A1) CCALLSFSUB1(PYMULT,pymult,INT,A1)
-
-PROTOCCALLSFSUB7(PYOFSH,pyofsh,INT,INT,INT,INT,FLOAT,PFLOAT,PFLOAT)
-#define PYOFSH(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(PYOFSH,pyofsh,INT,INT,INT,INT,FLOAT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5,A6,A7)
-
-PROTOCCALLSFSUB1(PYPILE,pypile,INT)
-#define PYPILE(A1) CCALLSFSUB1(PYPILE,pypile,INT,A1)
-
-PROTOCCALLSFSUB1(PYQQBH,pyqqbh,PFLOAT)
-#define PYQQBH(A1) CCALLSFSUB1(PYQQBH,pyqqbh,PFLOAT,A1)
-
-PROTOCCALLSFSUB0(PYRAND,pyrand)
-#define PYRAND() CCALLSFSUB0(PYRAND,pyrand)
-
-PROTOCCALLSFSUB2(PYREMN,pyremn,INT,INT)
-#define PYREMN(A1,A2) CCALLSFSUB2(PYREMN,pyremn,INT,INT,A1,A2)
-
-PROTOCCALLSFSUB0(PYRESD,pyresd)
-#define PYRESD() CCALLSFSUB0(PYRESD,pyresd)
-
-PROTOCCALLSFSUB2(PYSAVE,pysave,INT,PINT)
-#define PYSAVE(A1,A2) CCALLSFSUB2(PYSAVE,pysave,INT,PINT,A1,A2)
-
-PROTOCCALLSFSUB0(PYSCAT,pyscat)
-#define PYSCAT() CCALLSFSUB0(PYSCAT,pyscat)
-
-PROTOCCALLSFSUB2(PYSIGH,pysigh,PINT,PFLOAT)
-#define PYSIGH(A1,A2) CCALLSFSUB2(PYSIGH,pysigh,PINT,PFLOAT,A1,A2)
-
-PROTOCCALLSFSUB4(PYSPLI,pyspli,INT,INT,PINT,PINT)
-#define PYSPLI(A1,A2,A3,A4) CCALLSFSUB4(PYSPLI,pyspli,INT,INT,PINT,PINT,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB2(PYSSPA,pysspa,INT,INT)
-#define PYSSPA(A1,A2) CCALLSFSUB2(PYSSPA,pysspa,INT,INT,A1,A2)
-
-PROTOCCALLSFSUB3(PYSTAG,pystag,FLOAT,FLOAT,PFLOAT)
-#define PYSTAG(A1,A2,A3) CCALLSFSUB3(PYSTAG,pystag,FLOAT,FLOAT,PFLOAT,A1,A2,A3)
-
-PROTOCCALLSFSUB1(PYSTAT,pystat,INT)
-#define PYSTAT(A1) CCALLSFSUB1(PYSTAT,pystat,INT,A1)
-
-PROTOCCALLSFSUB3(PYSTEL,pystel,FLOAT,FLOAT,PFLOAT)
-#define PYSTEL(A1,A2,A3) CCALLSFSUB3(PYSTEL,pystel,FLOAT,FLOAT,PFLOAT,A1,A2,A3)
-
-PROTOCCALLSFSUB4(PYSTFL,pystfl,INT,FLOAT,FLOAT,PFLOAT)
-#define PYSTFL(A1,A2,A3,A4) CCALLSFSUB4(PYSTFL,pystfl,INT,FLOAT,FLOAT,PFLOAT,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB4(PYSTFU,pystfu,INT,FLOAT,FLOAT,PFLOAT)
-#define PYSTFU(A1,A2,A3,A4) CCALLSFSUB4(PYSTFU,pystfu,INT,FLOAT,FLOAT,PFLOAT,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB3(PYSTGA,pystga,FLOAT,FLOAT,PFLOAT)
-#define PYSTGA(A1,A2,A3) CCALLSFSUB3(PYSTGA,pystga,FLOAT,FLOAT,PFLOAT,A1,A2,A3)
-
-PROTOCCALLSFSUB6(PYSTGS,pystgs,DOUBLE,DOUBLE,DOUBLE,DOUBLE,INT,PDOUBLE)
-#define PYSTGS(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(PYSTGS,pystgs,DOUBLE,DOUBLE,DOUBLE,DOUBLE,INT,PDOUBLE,A1,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFSUB6(PYSTHG,pysthg,INT,FLOAT,FLOAT,FLOAT,FLOAT,PFLOAT)
-#define PYSTHG(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(PYSTHG,pysthg,INT,FLOAT,FLOAT,FLOAT,FLOAT,PFLOAT,A1,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFSUB3(PYSTPI,pystpi,FLOAT,FLOAT,PFLOAT)
-#define PYSTPI(A1,A2,A3) CCALLSFSUB3(PYSTPI,pystpi,FLOAT,FLOAT,PFLOAT,A1,A2,A3)
-
-PROTOCCALLSFSUB3(PYSTPR,pystpr,FLOAT,FLOAT,PFLOAT)
-#define PYSTPR(A1,A2,A3) CCALLSFSUB3(PYSTPR,pystpr,FLOAT,FLOAT,PFLOAT,A1,A2,A3)
-
-PROTOCCALLSFSUB1(PYTEST,pytest,INT)
-#define PYTEST(A1) CCALLSFSUB1(PYTEST,pytest,INT,A1)
-
-PROTOCCALLSFSUB2(PYUPEV,pyupev,INT,PFLOAT)
-#define PYUPEV(A1,A2) CCALLSFSUB2(PYUPEV,pyupev,INT,PFLOAT,A1,A2)
-
-PROTOCCALLSFSUB3(PYUPIN,pyupin,INT,STRING,FLOAT)
-#define PYUPIN(A1,A2,A3) CCALLSFSUB3(PYUPIN,pyupin,INT,STRING,FLOAT,A1,A2,A3)
-
-PROTOCCALLSFSUB4(PYWAUX,pywaux,INT,FLOAT,FLOAT,PFLOAT)
-#define PYWAUX(A1,A2,A3,A4) CCALLSFSUB4(PYWAUX,pywaux,INT,FLOAT,FLOAT,PFLOAT,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB4(PYWIDT,pywidt,INT,FLOAT,PFLOAT,PFLOAT)
-#define PYWIDT(A1,A2,A3,A4) CCALLSFSUB4(PYWIDT,pywidt,INT,FLOAT,PFLOAT,PFLOAT,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB0(PYXTOT,pyxtot)
-#define PYXTOT() CCALLSFSUB0(PYXTOT,pyxtot)
-
-PROTOCCALLSFSUB8(RKBBV,rkbbv,FLOATV,FLOATV,FLOATV,FLOATV,FLOATV,FLOATV,INT,PFLOAT)
-#define RKBBV(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(RKBBV,rkbbv,FLOATV,FLOATV,FLOATV,FLOATV,FLOATV,FLOATV,INT,PFLOAT,A1,A2,A3,A4,A5,A6,A7,A8)
-
-PROTOCCALLSFSUB6(RKHLPK,rkhlpk,INT,PINT,PINT,PINT,PINT,PINT)
-#define RKHLPK(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(RKHLPK,rkhlpk,INT,PINT,PINT,PINT,PINT,PINT,A1,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFSUB2(RLUGET,rluget,INT,INT)
-#define RLUGET(A1,A2) CCALLSFSUB2(RLUGET,rluget,INT,INT,A1,A2)
-
-PROTOCCALLSFSUB2(RLUSET,rluset,INT,INT)
-#define RLUSET(A1,A2) CCALLSFSUB2(RLUSET,rluset,INT,INT,A1,A2)
-
-PROTOCCALLSFSUB11(STRUCTM,structm,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,PDOUBLE)
-#define STRUCTM(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11) CCALLSFSUB11(STRUCTM,structm,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,PDOUBLE,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11)
diff --git a/src/cfortran/kernlib.h b/src/cfortran/kernlib.h
deleted file mode 100644
index 01384e3..0000000
--- a/src/cfortran/kernlib.h
+++ /dev/null
@@ -1,1514 +0,0 @@
-PROTOCCALLSFFUN1(FLOAT,ALOGAM,alogam,FLOAT)
-#define ALOGAM(A2) CCALLSFFUN1(ALOGAM,alogam,FLOAT,A2)
-
-PROTOCCALLSFFUN1(FLOAT,BESI0,besi0,FLOAT)
-#define BESI0(A2) CCALLSFFUN1(BESI0,besi0,FLOAT,A2)
-
-PROTOCCALLSFFUN1(FLOAT,BESI1,besi1,FLOAT)
-#define BESI1(A2) CCALLSFFUN1(BESI1,besi1,FLOAT,A2)
-
-PROTOCCALLSFFUN1(FLOAT,BESJ0,besj0,FLOAT)
-#define BESJ0(A2) CCALLSFFUN1(BESJ0,besj0,FLOAT,A2)
-
-PROTOCCALLSFFUN1(FLOAT,BESJ1,besj1,FLOAT)
-#define BESJ1(A2) CCALLSFFUN1(BESJ1,besj1,FLOAT,A2)
-
-PROTOCCALLSFFUN1(FLOAT,BESK0,besk0,FLOAT)
-#define BESK0(A2) CCALLSFFUN1(BESK0,besk0,FLOAT,A2)
-
-PROTOCCALLSFFUN1(FLOAT,BESK1,besk1,FLOAT)
-#define BESK1(A2) CCALLSFFUN1(BESK1,besk1,FLOAT,A2)
-
-PROTOCCALLSFFUN1(FLOAT,BESY0,besy0,FLOAT)
-#define BESY0(A2) CCALLSFFUN1(BESY0,besy0,FLOAT,A2)
-
-PROTOCCALLSFFUN1(FLOAT,BESY1,besy1,FLOAT)
-#define BESY1(A2) CCALLSFFUN1(BESY1,besy1,FLOAT,A2)
-
-PROTOCCALLSFFUN1(FLOAT,COSINT,cosint,FLOAT)
-#define COSINT(A2) CCALLSFFUN1(COSINT,cosint,FLOAT,A2)
-
-PROTOCCALLSFFUN1(DOUBLE,DERF,derf,DOUBLE)
-#define DERF(A2) CCALLSFFUN1(DERF,derf,DOUBLE,A2)
-
-PROTOCCALLSFFUN1(DOUBLE,DFREQ,dfreq,DOUBLE)
-#define DFREQ(A2) CCALLSFFUN1(DFREQ,dfreq,DOUBLE,A2)
-
-PROTOCCALLSFFUN1(DOUBLE,DGAMMA,dgamma,DOUBLE)
-#define DGAMMA(A2) CCALLSFFUN1(DGAMMA,dgamma,DOUBLE,A2)
-
-PROTOCCALLSFFUN4(DOUBLE,DGAUSS,dgauss,ROUTINE,DOUBLE,DOUBLE,DOUBLE)
-#define DGAUSS(A2,A3,A4,A5) CCALLSFFUN4(DGAUSS,dgauss,ROUTINE,DOUBLE,DOUBLE,DOUBLE,A2,A3,A4,A5)
-
-PROTOCCALLSFFUN5(FLOAT,DIVDIF,divdif,FLOATV,FLOATV,INT,FLOAT,INT)
-#define DIVDIF(A2,A3,A4,A5,A6) CCALLSFFUN5(DIVDIF,divdif,FLOATV,FLOATV,INT,FLOAT,INT,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFFUN8(DOUBLE,DMBIL,dmbil,INT,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV)
-#define DMBIL(A2,A3,A4,A5,A6,A7,A8,A9) CCALLSFFUN8(DMBIL,dmbil,INT,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,A2,A3,A4,A5,A6,A7,A8,A9)
-
-PROTOCCALLSFFUN6(DOUBLE,DVMPA,dvmpa,INT,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLE)
-#define DVMPA(A2,A3,A4,A5,A6,A7) CCALLSFFUN6(DVMPA,dvmpa,INT,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLE,A2,A3,A4,A5,A6,A7)
-
-PROTOCCALLSFFUN5(DOUBLE,DVMPY,dvmpy,INT,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV)
-#define DVMPY(A2,A3,A4,A5,A6) CCALLSFFUN5(DVMPY,dvmpy,INT,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFFUN3(DOUBLE,DVSUM,dvsum,INT,DOUBLEV,DOUBLEV)
-#define DVSUM(A2,A3,A4) CCALLSFFUN3(DVSUM,dvsum,INT,DOUBLEV,DOUBLEV,A2,A3,A4)
-
-PROTOCCALLSFFUN1(FLOAT,ELLICE,ellice,FLOAT)
-#define ELLICE(A2) CCALLSFFUN1(ELLICE,ellice,FLOAT,A2)
-
-PROTOCCALLSFFUN1(FLOAT,ELLICK,ellick,FLOAT)
-#define ELLICK(A2) CCALLSFFUN1(ELLICK,ellick,FLOAT,A2)
-
-PROTOCCALLSFFUN1(FLOAT,ERF,erf,FLOAT)
-#define ERF(A2) CCALLSFFUN1(ERF,erf,FLOAT,A2)
-
-PROTOCCALLSFFUN1(FLOAT,EXPINT,expint,FLOAT)
-#define EXPINT(A2) CCALLSFFUN1(EXPINT,expint,FLOAT,A2)
-
-PROTOCCALLSFFUN5(FLOAT,FINT,fint,INT,FLOATV,INTV,FLOATV,FLOATV)
-#define FINT(A2,A3,A4,A5,A6) CCALLSFFUN5(FINT,fint,INT,FLOATV,INTV,FLOATV,FLOATV,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFFUN1(FLOAT,FREQ,freq,FLOAT)
-#define FREQ(A2) CCALLSFFUN1(FREQ,freq,FLOAT,A2)
-
-PROTOCCALLSFFUN1(FLOAT,GAMMA,gamma,FLOAT)
-#define GAMMA(A2) CCALLSFFUN1(GAMMA,gamma,FLOAT,A2)
-
-PROTOCCALLSFFUN4(FLOAT,GAUSS,gauss,ROUTINE,FLOAT,FLOAT,FLOAT)
-#define GAUSS(A2,A3,A4,A5) CCALLSFFUN4(GAUSS,gauss,ROUTINE,FLOAT,FLOAT,FLOAT,A2,A3,A4,A5)
-
-PROTOCCALLSFFUN4(FLOAT,GQUAD,gquad,FLOAT,FLOAT,FLOAT,INT)
-#define GQUAD(A2,A3,A4,A5) CCALLSFFUN4(GQUAD,gquad,FLOAT,FLOAT,FLOAT,INT,A2,A3,A4,A5)
-
-PROTOCCALLSFFUN3(INT,LOCATF,locatf,FLOATV,INT,FLOAT)
-#define LOCATF(A2,A3,A4) CCALLSFFUN3(LOCATF,locatf,FLOATV,INT,FLOAT,A2,A3,A4)
-
-PROTOCCALLSFFUN3(INT,LOCATI,locati,INTV,INT,INT)
-#define LOCATI(A2,A3,A4) CCALLSFFUN3(LOCATI,locati,INTV,INT,INT,A2,A3,A4)
-
-PROTOCCALLSFFUN2(FLOAT,PROB,prob,FLOAT,INT)
-#define PROB(A2,A3) CCALLSFFUN2(PROB,prob,FLOAT,INT,A2,A3)
-
-PROTOCCALLSFFUN0(FLOAT,RANF,ranf)
-#define RANF() CCALLSFFUN0(RANF,ranf)
-
-PROTOCCALLSFFUN8(FLOAT,RMBIL,rmbil,INT,FLOATV,FLOATV,FLOATV,FLOATV,FLOATV,FLOATV,FLOATV)
-#define RMBIL(A2,A3,A4,A5,A6,A7,A8,A9) CCALLSFFUN8(RMBIL,rmbil,INT,FLOATV,FLOATV,FLOATV,FLOATV,FLOATV,FLOATV,FLOATV,A2,A3,A4,A5,A6,A7,A8,A9)
-
-PROTOCCALLSFFUN6(FLOAT,RVMPA,rvmpa,INT,FLOATV,FLOATV,FLOATV,FLOATV,FLOAT)
-#define RVMPA(A2,A3,A4,A5,A6,A7) CCALLSFFUN6(RVMPA,rvmpa,INT,FLOATV,FLOATV,FLOATV,FLOATV,FLOAT,A2,A3,A4,A5,A6,A7)
-
-PROTOCCALLSFFUN5(FLOAT,RVMPY,rvmpy,INT,FLOATV,FLOATV,FLOATV,FLOATV)
-#define RVMPY(A2,A3,A4,A5,A6) CCALLSFFUN5(RVMPY,rvmpy,INT,FLOATV,FLOATV,FLOATV,FLOATV,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFFUN3(FLOAT,RVSUM,rvsum,INT,FLOATV,FLOATV)
-#define RVSUM(A2,A3,A4) CCALLSFFUN3(RVSUM,rvsum,INT,FLOATV,FLOATV,A2,A3,A4)
-
-PROTOCCALLSFFUN1(FLOAT,SININT,sinint,FLOAT)
-#define SININT(A2) CCALLSFFUN1(SININT,sinint,FLOAT,A2)
-
-PROTOCCALLSFFUN2(LOGICAL,ACCESSF,accessf,STRING,INT)
-#define ACCESSF(A2,A3) CCALLSFFUN2(ACCESSF,accessf,STRING,INT,A2,A3)
-
-PROTOCCALLSFFUN4(FLOAT,AMAXMU,amaxmu,FLOATV,INT,INT,INT)
-#define AMAXMU(A2,A3,A4,A5) CCALLSFFUN4(AMAXMU,amaxmu,FLOATV,INT,INT,INT,A2,A3,A4,A5)
-
-PROTOCCALLSFFUN2(FLOAT,ATG,atg,FLOAT,FLOAT)
-#define ATG(A2,A3) CCALLSFFUN2(ATG,atg,FLOAT,FLOAT,A2,A3)
-
-PROTOCCALLSFFUN1(STRING,CFROMI,cfromi,INT)
-#define CFROMI(A2) CCALLSFFUN1(CFROMI,cfromi,INT,A2)
-
-PROTOCCALLSFFUN1(INT,CHDIRF,chdirf,BYTE)
-#define CHDIRF(A2) CCALLSFFUN1(CHDIRF,chdirf,BYTE,A2)
-
-PROTOCCALLSFFUN2(FLOAT,DOTI,doti,FLOATV,FLOATV)
-#define DOTI(A2,A3) CCALLSFFUN2(DOTI,doti,FLOATV,FLOATV,A2,A3)
-
-PROTOCCALLSFFUN1(FLOAT,FLOARG,floarg,FLOATV)
-#define FLOARG(A2) CCALLSFFUN1(FLOARG,floarg,FLOATV,A2)
-
-PROTOCCALLSFFUN3(INT,ICDECI,icdeci,BYTE,INTV,INTV)
-#define ICDECI(A2,A3,A4) CCALLSFFUN3(ICDECI,icdeci,BYTE,INTV,INTV,A2,A3,A4)
-
-PROTOCCALLSFFUN3(INT,ICEQU,icequ,BYTEV,BYTEV,INT)
-#define ICEQU(A2,A3,A4) CCALLSFFUN3(ICEQU,icequ,BYTEV,BYTEV,INT,A2,A3,A4)
-
-PROTOCCALLSFFUN4(INT,ICFILA,icfila,BYTE,BYTE,INTV,INTV)
-#define ICFILA(A2,A3,A4,A5) CCALLSFFUN4(ICFILA,icfila,BYTE,BYTE,INTV,INTV,A2,A3,A4,A5)
-
-PROTOCCALLSFFUN4(INT,ICFIND,icfind,BYTE,BYTE,INTV,INTV)
-#define ICFIND(A2,A3,A4,A5) CCALLSFFUN4(ICFIND,icfind,BYTE,BYTE,INTV,INTV,A2,A3,A4,A5)
-
-PROTOCCALLSFFUN4(INT,ICFMUL,icfmul,BYTE,BYTE,INTV,INTV)
-#define ICFMUL(A2,A3,A4,A5) CCALLSFFUN4(ICFMUL,icfmul,BYTE,BYTE,INTV,INTV,A2,A3,A4,A5)
-
-PROTOCCALLSFFUN3(INT,ICFNBL,icfnbl,BYTE,INTV,INTV)
-#define ICFNBL(A2,A3,A4) CCALLSFFUN3(ICFNBL,icfnbl,BYTE,INTV,INTV,A2,A3,A4)
-
-PROTOCCALLSFFUN3(INT,ICHEXI,ichexi,BYTE,INTV,INTV)
-#define ICHEXI(A2,A3,A4) CCALLSFFUN3(ICHEXI,ichexi,BYTE,INTV,INTV,A2,A3,A4)
-
-PROTOCCALLSFFUN3(INT,ICINQ,icinq,STRING,STRINGV,INT)
-#define ICINQ(A2,A3,A4) CCALLSFFUN3(ICINQ,icinq,STRING,STRINGV,INT,A2,A3,A4)
-
-PROTOCCALLSFFUN3(INT,ICINQL,icinql,STRING,STRINGV,INT)
-#define ICINQL(A2,A3,A4) CCALLSFFUN3(ICINQL,icinql,STRING,STRINGV,INT,A2,A3,A4)
-
-PROTOCCALLSFFUN3(INT,ICINQU,icinqu,STRING,STRINGV,INT)
-#define ICINQU(A2,A3,A4) CCALLSFFUN3(ICINQU,icinqu,STRING,STRINGV,INT,A2,A3,A4)
-
-PROTOCCALLSFFUN5(INT,ICLOC,icloc,BYTE,INT,BYTE,INT,INT)
-#define ICLOC(A2,A3,A4,A5,A6) CCALLSFFUN5(ICLOC,icloc,BYTE,INT,BYTE,INT,INT,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFFUN5(INT,ICLOCL,iclocl,BYTE,INT,BYTE,INT,INT)
-#define ICLOCL(A2,A3,A4,A5,A6) CCALLSFFUN5(ICLOCL,iclocl,BYTE,INT,BYTE,INT,INT,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFFUN5(INT,ICLOCU,iclocu,BYTE,INT,BYTE,INT,INT)
-#define ICLOCU(A2,A3,A4,A5,A6) CCALLSFFUN5(ICLOCU,iclocu,BYTE,INT,BYTE,INT,INT,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFFUN3(INT,ICLUNS,icluns,BYTE,INT,INT)
-#define ICLUNS(A2,A3,A4) CCALLSFFUN3(ICLUNS,icluns,BYTE,INT,INT,A2,A3,A4)
-
-PROTOCCALLSFFUN2(INT,ICMPCH,icmpch,INT,INT)
-#define ICMPCH(A2,A3) CCALLSFFUN2(ICMPCH,icmpch,INT,INT,A2,A3)
-
-PROTOCCALLSFFUN3(INT,ICNEXT,icnext,BYTE,INTV,INTV)
-#define ICNEXT(A2,A3,A4) CCALLSFFUN3(ICNEXT,icnext,BYTE,INTV,INTV,A2,A3,A4)
-
-PROTOCCALLSFFUN3(INT,ICNTH,icnth,STRING,STRINGV,INT)
-#define ICNTH(A2,A3,A4) CCALLSFFUN3(ICNTH,icnth,STRING,STRINGV,INT,A2,A3,A4)
-
-PROTOCCALLSFFUN3(INT,ICNTHL,icnthl,STRING,STRINGV,INT)
-#define ICNTHL(A2,A3,A4) CCALLSFFUN3(ICNTHL,icnthl,STRING,STRINGV,INT,A2,A3,A4)
-
-PROTOCCALLSFFUN3(INT,ICNTHU,icnthu,STRING,STRINGV,INT)
-#define ICNTHU(A2,A3,A4) CCALLSFFUN3(ICNTHU,icnthu,STRING,STRINGV,INT,A2,A3,A4)
-
-PROTOCCALLSFFUN3(INT,ICNUM,icnum,BYTE,INTV,INTV)
-#define ICNUM(A2,A3,A4) CCALLSFFUN3(ICNUM,icnum,BYTE,INTV,INTV,A2,A3,A4)
-
-PROTOCCALLSFFUN3(INT,ICNUMA,icnuma,BYTE,INTV,INTV)
-#define ICNUMA(A2,A3,A4) CCALLSFFUN3(ICNUMA,icnuma,BYTE,INTV,INTV,A2,A3,A4)
-
-PROTOCCALLSFFUN3(INT,ICNUMU,icnumu,BYTE,INTV,INTV)
-#define ICNUMU(A2,A3,A4) CCALLSFFUN3(ICNUMU,icnumu,BYTE,INTV,INTV,A2,A3,A4)
-
-PROTOCCALLSFFUN3(INT,ICOCTI,icocti,BYTE,INTV,INTV)
-#define ICOCTI(A2,A3,A4) CCALLSFFUN3(ICOCTI,icocti,BYTE,INTV,INTV,A2,A3,A4)
-
-PROTOCCALLSFFUN1(INT,ICTYPE,ictype,BYTE)
-#define ICTYPE(A2) CCALLSFFUN1(ICTYPE,ictype,BYTE,A2)
-
-PROTOCCALLSFFUN1(INT,IFROMC,ifromc,STRING)
-#define IFROMC(A2) CCALLSFFUN1(IFROMC,ifromc,STRING,A2)
-
-PROTOCCALLSFFUN4(INT,INCBYT,incbyt,INTV,PINT,INTV,INTV)
-#define INCBYT(A2,A3,A4,A5) CCALLSFFUN4(INCBYT,incbyt,INTV,PINT,INTV,INTV,A2,A3,A4,A5)
-
-PROTOCCALLSFFUN1(INT,INTARG,intarg,FLOATV)
-#define INTARG(A2) CCALLSFFUN1(INTARG,intarg,FLOATV,A2)
-
-PROTOCCALLSFFUN1(LOGICAL,INTRAC,intrac,FLOAT)
-#define INTRAC(A2) CCALLSFFUN1(INTRAC,intrac,FLOAT,A2)
-
-PROTOCCALLSFFUN3(INT,IUBACK,iuback,INTV,INT,INT)
-#define IUBACK(A2,A3,A4) CCALLSFFUN3(IUBACK,iuback,INTV,INT,INT,A2,A3,A4)
-
-PROTOCCALLSFFUN3(INT,IUBIN,iubin,FLOAT,FLOATV,PLOGICAL)
-#define IUBIN(A2,A3,A4) CCALLSFFUN3(IUBIN,iubin,FLOAT,FLOATV,PLOGICAL,A2,A3,A4)
-
-PROTOCCALLSFFUN4(INT,IUCHAN,iuchan,FLOAT,FLOAT,FLOAT,INT)
-#define IUCHAN(A2,A3,A4,A5) CCALLSFFUN4(IUCHAN,iuchan,FLOAT,FLOAT,FLOAT,INT,A2,A3,A4,A5)
-
-PROTOCCALLSFFUN3(INT,IUCOLA,iucola,INT,INTV,INT)
-#define IUCOLA(A2,A3,A4) CCALLSFFUN3(IUCOLA,iucola,INT,INTV,INT,A2,A3,A4)
-
-PROTOCCALLSFFUN3(INT,IUCOMP,iucomp,INT,INTV,INT)
-#define IUCOMP(A2,A3,A4) CCALLSFFUN3(IUCOMP,iucomp,INT,INTV,INT,A2,A3,A4)
-
-PROTOCCALLSFFUN1(INT,IUEND,iuend,PINT)
-#define IUEND(A2) CCALLSFFUN1(IUEND,iuend,PINT,A2)
-
-PROTOCCALLSFFUN4(INT,IUFILA,iufila,INT,INTV,INT,INT)
-#define IUFILA(A2,A3,A4,A5) CCALLSFFUN4(IUFILA,iufila,INT,INTV,INT,INT,A2,A3,A4,A5)
-
-PROTOCCALLSFFUN4(INT,IUFIND,iufind,INT,INTV,INT,INT)
-#define IUFIND(A2,A3,A4,A5) CCALLSFFUN4(IUFIND,iufind,INT,INTV,INT,INT,A2,A3,A4,A5)
-
-PROTOCCALLSFFUN3(INT,IUFNBL,iufnbl,INTV,INT,INT)
-#define IUFNBL(A2,A3,A4) CCALLSFFUN3(IUFNBL,iufnbl,INTV,INT,INT,A2,A3,A4)
-
-PROTOCCALLSFFUN3(INT,IUFORW,iuforw,INTV,INT,INT)
-#define IUFORW(A2,A3,A4) CCALLSFFUN3(IUFORW,iuforw,INTV,INT,INT,A2,A3,A4)
-
-PROTOCCALLSFFUN3(INT,IUHIST,iuhist,FLOAT,FLOATV,PLOGICAL)
-#define IUHIST(A2,A3,A4) CCALLSFFUN3(IUHIST,iuhist,FLOAT,FLOATV,PLOGICAL,A2,A3,A4)
-
-PROTOCCALLSFFUN4(INT,IUHUNT,iuhunt,INT,INTV,INT,INT)
-#define IUHUNT(A2,A3,A4,A5) CCALLSFFUN4(IUHUNT,iuhunt,INT,INTV,INT,INT,A2,A3,A4,A5)
-
-PROTOCCALLSFFUN3(INT,IULAST,iulast,INT,INTV,INT)
-#define IULAST(A2,A3,A4) CCALLSFFUN3(IULAST,iulast,INT,INTV,INT,A2,A3,A4)
-
-PROTOCCALLSFFUN4(INT,IULOOK,iulook,INT,INTV,INT,INT)
-#define IULOOK(A2,A3,A4,A5) CCALLSFFUN4(IULOOK,iulook,INT,INTV,INT,INT,A2,A3,A4,A5)
-
-PROTOCCALLSFFUN1(INT,IUMODE,iumode,INT)
-#define IUMODE(A2) CCALLSFFUN1(IUMODE,iumode,INT,A2)
-
-PROTOCCALLSFFUN2(INT,IUNEXT,iunext,INTV,INT)
-#define IUNEXT(A2,A3) CCALLSFFUN2(IUNEXT,iunext,INTV,INT,A2,A3)
-
-PROTOCCALLSFFUN5(INT,IUSAME,iusame,INTV,INT,INT,INT,PINT)
-#define IUSAME(A2,A3,A4,A5,A6) CCALLSFFUN5(IUSAME,iusame,INTV,INT,INT,INT,PINT,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFFUN2(INT,IUWEED,iuweed,INTV,INT)
-#define IUWEED(A2,A3) CCALLSFFUN2(IUWEED,iuweed,INTV,INT,A2,A3)
-
-PROTOCCALLSFFUN2(INT,JBIT,jbit,INT,INT)
-#define JBIT(A2,A3) CCALLSFFUN2(JBIT,jbit,INT,INT,A2,A3)
-
-PROTOCCALLSFFUN3(INT,JBYT,jbyt,INT,INT,INT)
-#define JBYT(A2,A3,A4) CCALLSFFUN3(JBYT,jbyt,INT,INT,INT,A2,A3,A4)
-
-PROTOCCALLSFFUN4(INT,JBYTET,jbytet,INT,INT,INT,INT)
-#define JBYTET(A2,A3,A4,A5) CCALLSFFUN4(JBYTET,jbytet,INT,INT,INT,INT,A2,A3,A4,A5)
-
-PROTOCCALLSFFUN4(INT,JBYTOR,jbytor,INT,INT,INT,INT)
-#define JBYTOR(A2,A3,A4,A5) CCALLSFFUN4(JBYTOR,jbytor,INT,INT,INT,INT,A2,A3,A4,A5)
-
-PROTOCCALLSFFUN3(INT,JBYTPK,jbytpk,INTV,INT,INTV)
-#define JBYTPK(A2,A3,A4) CCALLSFFUN3(JBYTPK,jbytpk,INTV,INT,INTV,A2,A3,A4)
-
-PROTOCCALLSFFUN4(INT,JRSBYT,jrsbyt,INT,PINT,INT,INT)
-#define JRSBYT(A2,A3,A4,A5) CCALLSFFUN4(JRSBYT,jrsbyt,INT,PINT,INT,INT,A2,A3,A4,A5)
-
-PROTOCCALLSFFUN1(INT,JUMPAD,jumpad,INT)
-#define JUMPAD(A2) CCALLSFFUN1(JUMPAD,jumpad,INT,A2)
-
-PROTOCCALLSFFUN1(INT,LOCB,locb,FLOATV)
-#define LOCB(A2) CCALLSFFUN1(LOCB,locb,FLOATV,A2)
-
-PROTOCCALLSFFUN6(INT,LOCBYT,locbyt,INT,INTV,INT,INT,INT,INT)
-#define LOCBYT(A2,A3,A4,A5,A6,A7) CCALLSFFUN6(LOCBYT,locbyt,INT,INTV,INT,INT,INT,INT,A2,A3,A4,A5,A6,A7)
-
-PROTOCCALLSFFUN1(INT,LOCF,locf,FLOATV)
-#define LOCF(A2) CCALLSFFUN1(LOCF,locf,FLOATV,A2)
-
-PROTOCCALLSFFUN2(INT,LSTATF,lstatf,STRING,INTV)
-#define LSTATF(A2,A3) CCALLSFFUN2(LSTATF,lstatf,STRING,INTV,A2,A3)
-
-PROTOCCALLSFFUN2(INT,LVMAX,lvmax,FLOATV,INT)
-#define LVMAX(A2,A3) CCALLSFFUN2(LVMAX,lvmax,FLOATV,INT,A2,A3)
-
-PROTOCCALLSFFUN2(INT,LVMAXA,lvmaxa,FLOATV,INT)
-#define LVMAXA(A2,A3) CCALLSFFUN2(LVMAXA,lvmaxa,FLOATV,INT,A2,A3)
-
-PROTOCCALLSFFUN2(INT,LVMIN,lvmin,FLOATV,INT)
-#define LVMIN(A2,A3) CCALLSFFUN2(LVMIN,lvmin,FLOATV,INT,A2,A3)
-
-PROTOCCALLSFFUN2(INT,LVMINA,lvmina,FLOATV,INT)
-#define LVMINA(A2,A3) CCALLSFFUN2(LVMINA,lvmina,FLOATV,INT,A2,A3)
-
-PROTOCCALLSFFUN3(INT,LVSDMI,lvsdmi,DOUBLEV,INT,INT)
-#define LVSDMI(A2,A3,A4) CCALLSFFUN3(LVSDMI,lvsdmi,DOUBLEV,INT,INT,A2,A3,A4)
-
-PROTOCCALLSFFUN3(INT,LVSDMX,lvsdmx,DOUBLEV,INT,INT)
-#define LVSDMX(A2,A3,A4) CCALLSFFUN3(LVSDMX,lvsdmx,DOUBLEV,INT,INT,A2,A3,A4)
-
-PROTOCCALLSFFUN3(INT,LVSIMI,lvsimi,INTV,INT,INT)
-#define LVSIMI(A2,A3,A4) CCALLSFFUN3(LVSIMI,lvsimi,INTV,INT,INT,A2,A3,A4)
-
-PROTOCCALLSFFUN3(INT,LVSIMX,lvsimx,INTV,INT,INT)
-#define LVSIMX(A2,A3,A4) CCALLSFFUN3(LVSIMX,lvsimx,INTV,INT,INT,A2,A3,A4)
-
-PROTOCCALLSFFUN3(INT,LVSMI,lvsmi,FLOATV,INT,INT)
-#define LVSMI(A2,A3,A4) CCALLSFFUN3(LVSMI,lvsmi,FLOATV,INT,INT,A2,A3,A4)
-
-PROTOCCALLSFFUN3(INT,LVSMX,lvsmx,FLOATV,INT,INT)
-#define LVSMX(A2,A3,A4) CCALLSFFUN3(LVSMX,lvsmx,FLOATV,INT,INT,A2,A3,A4)
-
-PROTOCCALLSFFUN4(INT,MBYTET,mbytet,INT,INT,INT,INT)
-#define MBYTET(A2,A3,A4,A5) CCALLSFFUN4(MBYTET,mbytet,INT,INT,INT,INT,A2,A3,A4,A5)
-
-PROTOCCALLSFFUN4(INT,MBYTOR,mbytor,INT,INT,INT,INT)
-#define MBYTOR(A2,A3,A4,A5) CCALLSFFUN4(MBYTOR,mbytor,INT,INT,INT,INT,A2,A3,A4,A5)
-
-PROTOCCALLSFFUN5(INT,MCBYT,mcbyt,INT,INT,INT,INT,INT)
-#define MCBYT(A2,A3,A4,A5,A6) CCALLSFFUN5(MCBYT,mcbyt,INT,INT,INT,INT,INT,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFFUN3(INT,MSBIT,msbit,INT,INT,INT)
-#define MSBIT(A2,A3,A4) CCALLSFFUN3(MSBIT,msbit,INT,INT,INT,A2,A3,A4)
-
-PROTOCCALLSFFUN2(INT,MSBIT0,msbit0,INT,INT)
-#define MSBIT0(A2,A3) CCALLSFFUN2(MSBIT0,msbit0,INT,INT,A2,A3)
-
-PROTOCCALLSFFUN2(INT,MSBIT1,msbit1,INT,INT)
-#define MSBIT1(A2,A3) CCALLSFFUN2(MSBIT1,msbit1,INT,INT,A2,A3)
-
-PROTOCCALLSFFUN4(INT,MSBYT,msbyt,INT,INT,INT,INT)
-#define MSBYT(A2,A3,A4,A5) CCALLSFFUN4(MSBYT,msbyt,INT,INT,INT,INT,A2,A3,A4,A5)
-
-PROTOCCALLSFFUN1(INT,NCDECI,ncdeci,BYTE)
-#define NCDECI(A2) CCALLSFFUN1(NCDECI,ncdeci,BYTE,A2)
-
-PROTOCCALLSFFUN1(INT,NCHEXI,nchexi,BYTE)
-#define NCHEXI(A2) CCALLSFFUN1(NCHEXI,nchexi,BYTE,A2)
-
-PROTOCCALLSFFUN1(INT,NCOCTI,ncocti,BYTE)
-#define NCOCTI(A2) CCALLSFFUN1(NCOCTI,ncocti,BYTE,A2)
-
-PROTOCCALLSFFUN2(FLOAT,PROXIM,proxim,FLOAT,FLOAT)
-#define PROXIM(A2,A3) CCALLSFFUN2(PROXIM,proxim,FLOAT,FLOAT,A2,A3)
-
-PROTOCCALLSFFUN4(FLOAT,PSCALE,pscale,PINT,INT,FLOAT,INT)
-#define PSCALE(A2,A3,A4,A5) CCALLSFFUN4(PSCALE,pscale,PINT,INT,FLOAT,INT,A2,A3,A4,A5)
-
-PROTOCCALLSFFUN2(INT,READLNF,readlnf,STRING,STRING)
-#define READLNF(A2,A3) CCALLSFFUN2(READLNF,readlnf,STRING,STRING,A2,A3)
-
-PROTOCCALLSFFUN2(INT,RENAMEF,renamef,STRING,STRING)
-#define RENAMEF(A2,A3) CCALLSFFUN2(RENAMEF,renamef,STRING,STRING,A2,A3)
-
-PROTOCCALLSFFUN1(FLOAT,RNDM,rndm,INT)
-#define RNDM(A2) CCALLSFFUN1(RNDM,rndm,INT,A2)
-
-PROTOCCALLSFFUN2(INT,SETENVF,setenvf,STRING,STRING)
-#define SETENVF(A2,A3) CCALLSFFUN2(SETENVF,setenvf,STRING,STRING,A2,A3)
-
-PROTOCCALLSFFUN2(INT,STATF,statf,STRING,INTV)
-#define STATF(A2,A3) CCALLSFFUN2(STATF,statf,STRING,INTV,A2,A3)
-
-PROTOCCALLSFFUN1(INT,SYSTEMF,systemf,BYTE)
-#define SYSTEMF(A2) CCALLSFFUN1(SYSTEMF,systemf,BYTE,A2)
-
-PROTOCCALLSFFUN1(INT,UNLINKF,unlinkf,BYTE)
-#define UNLINKF(A2) CCALLSFFUN1(UNLINKF,unlinkf,BYTE,A2)
-
-PROTOCCALLSFFUN2(FLOAT,VASUM,vasum,FLOATV,INT)
-#define VASUM(A2,A3) CCALLSFFUN2(VASUM,vasum,FLOATV,INT,A2,A3)
-
-PROTOCCALLSFFUN3(FLOAT,VDIST,vdist,FLOATV,FLOATV,INT)
-#define VDIST(A2,A3,A4) CCALLSFFUN3(VDIST,vdist,FLOATV,FLOATV,INT,A2,A3,A4)
-
-PROTOCCALLSFFUN3(FLOAT,VDIST2,vdist2,FLOATV,FLOATV,INT)
-#define VDIST2(A2,A3,A4) CCALLSFFUN3(VDIST2,vdist2,FLOATV,FLOATV,INT,A2,A3,A4)
-
-PROTOCCALLSFFUN3(FLOAT,VDOT,vdot,FLOATV,FLOATV,INT)
-#define VDOT(A2,A3,A4) CCALLSFFUN3(VDOT,vdot,FLOATV,FLOATV,INT,A2,A3,A4)
-
-PROTOCCALLSFFUN3(FLOAT,VDOTN,vdotn,FLOATV,FLOATV,INT)
-#define VDOTN(A2,A3,A4) CCALLSFFUN3(VDOTN,vdotn,FLOATV,FLOATV,INT,A2,A3,A4)
-
-PROTOCCALLSFFUN3(FLOAT,VDOTN2,vdotn2,FLOATV,FLOATV,INT)
-#define VDOTN2(A2,A3,A4) CCALLSFFUN3(VDOTN2,vdotn2,FLOATV,FLOATV,INT,A2,A3,A4)
-
-PROTOCCALLSFFUN2(FLOAT,VMAX,vmax,FLOATV,INT)
-#define VMAX(A2,A3) CCALLSFFUN2(VMAX,vmax,FLOATV,INT,A2,A3)
-
-PROTOCCALLSFFUN2(FLOAT,VMAXA,vmaxa,FLOATV,INT)
-#define VMAXA(A2,A3) CCALLSFFUN2(VMAXA,vmaxa,FLOATV,INT,A2,A3)
-
-PROTOCCALLSFFUN2(FLOAT,VMIN,vmin,FLOATV,INT)
-#define VMIN(A2,A3) CCALLSFFUN2(VMIN,vmin,FLOATV,INT,A2,A3)
-
-PROTOCCALLSFFUN2(FLOAT,VMINA,vmina,FLOATV,INT)
-#define VMINA(A2,A3) CCALLSFFUN2(VMINA,vmina,FLOATV,INT,A2,A3)
-
-PROTOCCALLSFFUN2(FLOAT,VMOD,vmod,FLOATV,INT)
-#define VMOD(A2,A3) CCALLSFFUN2(VMOD,vmod,FLOATV,INT,A2,A3)
-
-PROTOCCALLSFFUN2(FLOAT,VSUM,vsum,FLOATV,INT)
-#define VSUM(A2,A3) CCALLSFFUN2(VSUM,vsum,FLOATV,INT,A2,A3)
-
-PROTOCCALLSFFUN1(STRING,CHARN,charn,INT)
-#define CHARN(A2) CCALLSFFUN1(CHARN,charn,INT,A2)
-
-PROTOCCALLSFFUN1(INT,CLEAP,cleap,INT)
-#define CLEAP(A2) CCALLSFFUN1(CLEAP,cleap,INT,A2)
-
-PROTOCCALLSFFUN1(INT,CYEAR4,cyear4,INT)
-#define CYEAR4(A2) CCALLSFFUN1(CYEAR4,cyear4,INT,A2)
-
-PROTOCCALLSFFUN1(INT,ICHARN,icharn,STRING)
-#define ICHARN(A2) CCALLSFFUN1(ICHARN,icharn,STRING,A2)
-
-PROTOCCALLSFFUN1(INT,INDEXA,indexa,STRING)
-#define INDEXA(A2) CCALLSFFUN1(INDEXA,indexa,STRING,A2)
-
-PROTOCCALLSFFUN2(INT,INDEXB,indexb,STRING,STRING)
-#define INDEXB(A2,A3) CCALLSFFUN2(INDEXB,indexb,STRING,STRING,A2,A3)
-
-PROTOCCALLSFFUN2(INT,INDEXC,indexc,STRING,STRING)
-#define INDEXC(A2,A3) CCALLSFFUN2(INDEXC,indexc,STRING,STRING,A2,A3)
-
-PROTOCCALLSFFUN1(INT,INDEXN,indexn,STRING)
-#define INDEXN(A2) CCALLSFFUN1(INDEXN,indexn,STRING,A2)
-
-PROTOCCALLSFFUN1(INT,INDEXS,indexs,STRING)
-#define INDEXS(A2) CCALLSFFUN1(INDEXS,indexs,STRING,A2)
-
-PROTOCCALLSFFUN1(INT,INDXAC,indxac,STRING)
-#define INDXAC(A2) CCALLSFFUN1(INDXAC,indxac,STRING,A2)
-
-PROTOCCALLSFFUN2(INT,INDXBC,indxbc,STRING,STRING)
-#define INDXBC(A2,A3) CCALLSFFUN2(INDXBC,indxbc,STRING,STRING,A2,A3)
-
-PROTOCCALLSFFUN1(INT,INDXNC,indxnc,STRING)
-#define INDXNC(A2) CCALLSFFUN1(INDXNC,indxnc,STRING,A2)
-
-PROTOCCALLSFFUN2(INT,ISCAN,iscan,STRING,STRING)
-#define ISCAN(A2,A3) CCALLSFFUN2(ISCAN,iscan,STRING,STRING,A2,A3)
-
-PROTOCCALLSFFUN1(INT,NUMBIT,numbit,INT)
-#define NUMBIT(A2) CCALLSFFUN1(NUMBIT,numbit,INT,A2)
-
-PROTOCCALLSFFUN0(LOGICAL,RALPH,ralph)
-#define RALPH() CCALLSFFUN0(RALPH,ralph)
-
-PROTOCCALLSFFUN1(FLOAT,RCHAR,rchar,STRING)
-#define RCHAR(A2) CCALLSFFUN1(RCHAR,rchar,STRING,A2)
-
-PROTOCCALLSFFUN0(LOGICAL,RDENDB,rdendb)
-#define RDENDB() CCALLSFFUN0(RDENDB,rdendb)
-
-PROTOCCALLSFFUN0(LOGICAL,RDIGI,rdigi)
-#define RDIGI() CCALLSFFUN0(RDIGI,rdigi)
-
-PROTOCCALLSFFUN1(STRING,RDUPCH,rdupch,STRING)
-#define RDUPCH(A2) CCALLSFFUN1(RDUPCH,rdupch,STRING,A2)
-
-PROTOCCALLSFFUN2(STRING,REPEAT,repeat,STRING,INT)
-#define REPEAT(A2,A3) CCALLSFFUN2(REPEAT,repeat,STRING,INT,A2,A3)
-
-PROTOCCALLSFFUN2(STRING,SPACES,spaces,STRING,INT)
-#define SPACES(A2,A3) CCALLSFFUN2(SPACES,spaces,STRING,INT,A2,A3)
-
-PROTOCCALLSFFUN3(STRING,STRIP,strip,STRING,STRING,STRING)
-#define STRIP(A2,A3,A4) CCALLSFFUN3(STRIP,strip,STRING,STRING,STRING,A2,A3,A4)
-
-PROTOCCALLSFFUN3(STRING,SUBWORD,subword,STRING,INT,INT)
-#define SUBWORD(A2,A3,A4) CCALLSFFUN3(SUBWORD,subword,STRING,INT,INT,A2,A3,A4)
-
-PROTOCCALLSFFUN2(INT,VERIFY,verify,STRING,STRING)
-#define VERIFY(A2,A3) CCALLSFFUN2(VERIFY,verify,STRING,STRING,A2,A3)
-
-PROTOCCALLSFFUN2(STRING,WORD,word,STRING,INT)
-#define WORD(A2,A3) CCALLSFFUN2(WORD,word,STRING,INT,A2,A3)
-
-PROTOCCALLSFFUN1(INT,WORDS,words,STRING)
-#define WORDS(A2) CCALLSFFUN1(WORDS,words,STRING,A2)
-
-
-/* Subroutines/Functions with COMPLEX not supported ***
-
-#define CCMMPY(A1,A2,A3,A4,A5,A6,A7,A8,A9) CCALLSFSUB9(CCMMPY,ccmmpy,INT,INT,COMPLEXV,COMPLEXV,COMPLEXV,COMPLEXV,COMPLEXV,PCOMPLEX,COMPLEXV,A1,A2,A3,A4,A5,A6,A7,A8,A9)
-#define CCUMPY(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(CCUMPY,ccumpy,INT,COMPLEXV,COMPLEXV,COMPLEXV,COMPLEXV,COMPLEXV,PCOMPLEX,COMPLEXV,A1,A2,A3,A4,A5,A6,A7,A8)
-#define CEQINV(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(CEQINV,ceqinv,INT,COMPLEXVV,INT,FLOATV,PINT,INT,COMPLEXV,A1,A2,A3,A4,A5,A6,A7)
-#define CEQN(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(CEQN,ceqn,INT,COMPLEXVV,INT,FLOATV,PINT,INT,COMPLEXV,A1,A2,A3,A4,A5,A6,A7)
-#define CFACT(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(CFACT,cfact,INT,PCOMPLEX,INT,PINT,PINT,PCOMPLEX,PINT,A1,A2,A3,A4,A5,A6,A7)
-#define CFEQN(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(CFEQN,cfeqn,INT,PCOMPLEX,INT,INTV,INT,PCOMPLEX,A1,A2,A3,A4,A5,A6)
-#define CFFT(A1,A2) CCALLSFSUB2(CFFT,cfft,PCOMPLEX,INT,A1,A2)
-#define CFINV(A1,A2,A3,A4) CCALLSFSUB4(CFINV,cfinv,INT,PCOMPLEX,INT,INTV,A1,A2,A3,A4)
-#define CINV(A1,A2,A3,A4,A5) CCALLSFSUB5(CINV,cinv,INT,COMPLEXVV,INT,FLOATV,PINT,A1,A2,A3,A4,A5)
-#define CMADD(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11) CCALLSFSUB11(CMADD,cmadd,INT,INT,COMPLEXV,COMPLEXV,COMPLEXV,COMPLEXV,COMPLEXV,COMPLEXV,PCOMPLEX,COMPLEXV,COMPLEXV,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11)
-PROTOCCALLSFFUN8(COMPLEX,CMBIL,cmbil,INT,COMPLEXV,COMPLEXV,COMPLEXV,COMPLEXV,COMPLEXV,COMPLEXV,COMPLEXV)
-#define CMBIL(A2,A3,A4,A5,A6,A7,A8,A9) CCALLSFFUN8(CMBIL,cmbil,INT,COMPLEXV,COMPLEXV,COMPLEXV,COMPLEXV,COMPLEXV,COMPLEXV,COMPLEXV,A2,A3,A4,A5,A6,A7,A8,A9)
-#define CMCPY(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(CMCPY,cmcpy,INT,INT,COMPLEXV,COMPLEXV,COMPLEXV,PCOMPLEX,COMPLEXV,COMPLEXV,A1,A2,A3,A4,A5,A6,A7,A8)
-#define CMMLA(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12) CCALLSFSUB12(CMMLA,cmmla,INT,INT,INT,COMPLEXV,COMPLEXV,COMPLEXV,COMPLEXV,COMPLEXV,COMPLEXV,PCOMPLEX,COMPLEXV,COMPLEXV,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12)
-#define CMMLS(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12) CCALLSFSUB12(CMMLS,cmmls,INT,INT,INT,COMPLEXV,COMPLEXV,COMPLEXV,COMPLEXV,COMPLEXV,COMPLEXV,PCOMPLEX,COMPLEXV,COMPLEXV,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12)
-#define CMMLT(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13) CCALLSFSUB13(CMMLT,cmmlt,INT,INT,INT,PCOMPLEX,COMPLEXV,COMPLEXV,PCOMPLEX,COMPLEXV,COMPLEXV,PCOMPLEX,COMPLEXV,COMPLEXV,PCOMPLEX,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13)
-#define CMMLTC(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13) CCALLSFSUB13(CMMLTC,cmmltc,INT,INT,INT,PCOMPLEX,COMPLEXV,COMPLEXV,PCOMPLEX,COMPLEXV,COMPLEXV,PCOMPLEX,COMPLEXV,COMPLEXV,PCOMPLEX,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13)
-#define CMMNA(A1,A2,A3,A4,A5,A6,A7,A8,A9) CCALLSFSUB9(CMMNA,cmmna,INT,INT,COMPLEXV,COMPLEXV,COMPLEXV,COMPLEXV,COMPLEXV,PCOMPLEX,COMPLEXV,A1,A2,A3,A4,A5,A6,A7,A8,A9)
-#define CMMNS(A1,A2,A3,A4,A5,A6,A7,A8,A9) CCALLSFSUB9(CMMNS,cmmns,INT,INT,COMPLEXV,COMPLEXV,COMPLEXV,COMPLEXV,COMPLEXV,PCOMPLEX,COMPLEXV,A1,A2,A3,A4,A5,A6,A7,A8,A9)
-#define CMMPA(A1,A2,A3,A4,A5,A6,A7,A8,A9) CCALLSFSUB9(CMMPA,cmmpa,INT,INT,COMPLEXV,COMPLEXV,COMPLEXV,COMPLEXV,COMPLEXV,PCOMPLEX,COMPLEXV,A1,A2,A3,A4,A5,A6,A7,A8,A9)
-#define CMMPS(A1,A2,A3,A4,A5,A6,A7,A8,A9) CCALLSFSUB9(CMMPS,cmmps,INT,INT,COMPLEXV,COMPLEXV,COMPLEXV,COMPLEXV,COMPLEXV,PCOMPLEX,COMPLEXV,A1,A2,A3,A4,A5,A6,A7,A8,A9)
-#define CMMPY(A1,A2,A3,A4,A5,A6,A7,A8,A9) CCALLSFSUB9(CMMPY,cmmpy,INT,INT,COMPLEXV,COMPLEXV,COMPLEXV,COMPLEXV,COMPLEXV,PCOMPLEX,COMPLEXV,A1,A2,A3,A4,A5,A6,A7,A8,A9)
-#define CMMPYC(A1,A2,A3,A4,A5,A6,A7,A8,A9) CCALLSFSUB9(CMMPYC,cmmpyc,INT,INT,COMPLEXV,COMPLEXV,COMPLEXV,COMPLEXV,COMPLEXV,PCOMPLEX,COMPLEXV,A1,A2,A3,A4,A5,A6,A7,A8,A9)
-#define CMNMA(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12) CCALLSFSUB12(CMNMA,cmnma,INT,INT,INT,COMPLEXV,COMPLEXV,COMPLEXV,COMPLEXV,COMPLEXV,COMPLEXV,PCOMPLEX,COMPLEXV,COMPLEXV,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12)
-#define CMNMS(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12) CCALLSFSUB12(CMNMS,cmnms,INT,INT,INT,COMPLEXV,COMPLEXV,COMPLEXV,COMPLEXV,COMPLEXV,COMPLEXV,PCOMPLEX,COMPLEXV,COMPLEXV,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12)
-#define CMRAN(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(CMRAN,cmran,INT,INT,COMPLEX,COMPLEX,PCOMPLEX,COMPLEXV,COMPLEXV,A1,A2,A3,A4,A5,A6,A7)
-#define CMSCL(A1,A2,A3,A4,A5,A6,A7,A8,A9) CCALLSFSUB9(CMSCL,cmscl,INT,INT,COMPLEX,COMPLEXV,COMPLEXV,COMPLEXV,PCOMPLEX,COMPLEXV,COMPLEXV,A1,A2,A3,A4,A5,A6,A7,A8,A9)
-#define CMSET(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(CMSET,cmset,INT,INT,COMPLEX,PCOMPLEX,COMPLEXV,COMPLEXV,A1,A2,A3,A4,A5,A6)
-#define CMSUB(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11) CCALLSFSUB11(CMSUB,cmsub,INT,INT,COMPLEXV,COMPLEXV,COMPLEXV,COMPLEXV,COMPLEXV,COMPLEXV,PCOMPLEX,COMPLEXV,COMPLEXV,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11)
-#define CMUTL(A1,A2,A3,A4) CCALLSFSUB4(CMUTL,cmutl,INT,PCOMPLEX,COMPLEXV,COMPLEXV,A1,A2,A3,A4)
-#define CRSCL(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10) CCALLSFSUB10(CRSCL,crscl,INT,INT,COMPLEXV,COMPLEXV,COMPLEXV,COMPLEXV,COMPLEXV,PCOMPLEX,COMPLEXV,COMPLEXV,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10)
-#define CUMNA(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(CUMNA,cumna,INT,COMPLEXV,COMPLEXV,COMPLEXV,COMPLEXV,COMPLEXV,PCOMPLEX,COMPLEXV,A1,A2,A3,A4,A5,A6,A7,A8)
-#define CUMNS(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(CUMNS,cumns,INT,COMPLEXV,COMPLEXV,COMPLEXV,COMPLEXV,COMPLEXV,PCOMPLEX,COMPLEXV,A1,A2,A3,A4,A5,A6,A7,A8)
-#define CUMPA(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(CUMPA,cumpa,INT,COMPLEXV,COMPLEXV,COMPLEXV,COMPLEXV,COMPLEXV,PCOMPLEX,COMPLEXV,A1,A2,A3,A4,A5,A6,A7,A8)
-#define CUMPS(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(CUMPS,cumps,INT,COMPLEXV,COMPLEXV,COMPLEXV,COMPLEXV,COMPLEXV,PCOMPLEX,COMPLEXV,A1,A2,A3,A4,A5,A6,A7,A8)
-#define CUMPY(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(CUMPY,cumpy,INT,COMPLEXV,COMPLEXV,COMPLEXV,COMPLEXV,COMPLEXV,PCOMPLEX,COMPLEXV,A1,A2,A3,A4,A5,A6,A7,A8)
-#define CUMPYC(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(CUMPYC,cumpyc,INT,COMPLEXV,COMPLEXV,COMPLEXV,COMPLEXV,COMPLEXV,PCOMPLEX,COMPLEXV,A1,A2,A3,A4,A5,A6,A7,A8)
-#define CVADD(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(CVADD,cvadd,INT,COMPLEXV,COMPLEXV,COMPLEXV,COMPLEXV,PCOMPLEX,COMPLEXV,A1,A2,A3,A4,A5,A6,A7)
-#define CVCPY(A1,A2,A3,A4,A5) CCALLSFSUB5(CVCPY,cvcpy,INT,COMPLEXV,COMPLEXV,PCOMPLEX,COMPLEXV,A1,A2,A3,A4,A5)
-#define CVDIV(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(CVDIV,cvdiv,INT,COMPLEXV,COMPLEXV,COMPLEXV,COMPLEXV,PCOMPLEX,COMPLEXV,PINT,A1,A2,A3,A4,A5,A6,A7,A8)
-PROTOCCALLSFFUN6(COMPLEX,CVMPA,cvmpa,INT,COMPLEXV,COMPLEXV,COMPLEXV,COMPLEXV,COMPLEX)
-#define CVMPA(A2,A3,A4,A5,A6,A7) CCALLSFFUN6(CVMPA,cvmpa,INT,COMPLEXV,COMPLEXV,COMPLEXV,COMPLEXV,COMPLEX,A2,A3,A4,A5,A6,A7)
-PROTOCCALLSFFUN6(COMPLEX,CVMPAC,cvmpac,INT,COMPLEXV,COMPLEXV,COMPLEXV,COMPLEXV,COMPLEX)
-#define CVMPAC(A2,A3,A4,A5,A6,A7) CCALLSFFUN6(CVMPAC,cvmpac,INT,COMPLEXV,COMPLEXV,COMPLEXV,COMPLEXV,COMPLEX,A2,A3,A4,A5,A6,A7)
-PROTOCCALLSFFUN5(COMPLEX,CVMPY,cvmpy,INT,COMPLEXV,COMPLEXV,COMPLEXV,COMPLEXV)
-#define CVMPY(A2,A3,A4,A5,A6) CCALLSFFUN5(CVMPY,cvmpy,INT,COMPLEXV,COMPLEXV,COMPLEXV,COMPLEXV,A2,A3,A4,A5,A6)
-PROTOCCALLSFFUN5(COMPLEX,CVMPYC,cvmpyc,INT,COMPLEXV,COMPLEXV,COMPLEXV,COMPLEXV)
-#define CVMPYC(A2,A3,A4,A5,A6) CCALLSFFUN5(CVMPYC,cvmpyc,INT,COMPLEXV,COMPLEXV,COMPLEXV,COMPLEXV,A2,A3,A4,A5,A6)
-#define CVMUL(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(CVMUL,cvmul,INT,COMPLEXV,COMPLEXV,COMPLEXV,COMPLEXV,PCOMPLEX,COMPLEXV,A1,A2,A3,A4,A5,A6,A7)
-#define CVMULA(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(CVMULA,cvmula,INT,COMPLEXV,COMPLEXV,COMPLEXV,COMPLEXV,PCOMPLEX,COMPLEXV,A1,A2,A3,A4,A5,A6,A7)
-#define CVMUNA(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(CVMUNA,cvmuna,INT,COMPLEXV,COMPLEXV,COMPLEXV,COMPLEXV,PCOMPLEX,COMPLEXV,A1,A2,A3,A4,A5,A6,A7)
-#define CVRAN(A1,A2,A3,A4,A5) CCALLSFSUB5(CVRAN,cvran,INT,COMPLEX,COMPLEX,PCOMPLEX,COMPLEXV,A1,A2,A3,A4,A5)
-#define CVSCA(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(CVSCA,cvsca,INT,COMPLEX,COMPLEXV,COMPLEXV,COMPLEXV,COMPLEXV,PCOMPLEX,COMPLEXV,A1,A2,A3,A4,A5,A6,A7,A8)
-#define CVSCL(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(CVSCL,cvscl,INT,COMPLEX,COMPLEXV,COMPLEXV,PCOMPLEX,COMPLEXV,A1,A2,A3,A4,A5,A6)
-#define CVSCS(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(CVSCS,cvscs,INT,COMPLEX,COMPLEXV,COMPLEXV,COMPLEXV,COMPLEXV,PCOMPLEX,COMPLEXV,A1,A2,A3,A4,A5,A6,A7,A8)
-#define CVSET(A1,A2,A3,A4) CCALLSFSUB4(CVSET,cvset,INT,COMPLEX,PCOMPLEX,COMPLEXV,A1,A2,A3,A4)
-#define CVSUB(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(CVSUB,cvsub,INT,COMPLEXV,COMPLEXV,COMPLEXV,COMPLEXV,PCOMPLEX,COMPLEXV,A1,A2,A3,A4,A5,A6,A7)
-PROTOCCALLSFFUN3(COMPLEX,CVSUM,cvsum,INT,COMPLEXV,COMPLEXV)
-#define CVSUM(A2,A3,A4) CCALLSFFUN3(CVSUM,cvsum,INT,COMPLEXV,COMPLEXV,A2,A3,A4)
-#define CVXCH(A1,A2,A3,A4,A5) CCALLSFSUB5(CVXCH,cvxch,INT,PCOMPLEX,COMPLEXV,PCOMPLEX,COMPLEXV,A1,A2,A3,A4,A5)
-#define MULLER(A1,A2,A3) CCALLSFSUB3(MULLER,muller,FLOATV,INT,PCOMPLEX,A1,A2,A3)
-#define RFFT(A1,A2) CCALLSFSUB2(RFFT,rfft,PCOMPLEX,INT,A1,A2)
-
-*** End Subroutines/Functions using COMPLEX */
-
-
-PROTOCCALLSFSUB7(D106XX,d106xx,INT,FLOAT,FLOAT,FLOAT,INT,PFLOAT,PFLOAT)
-#define D106XX(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(D106XX,d106xx,INT,FLOAT,FLOAT,FLOAT,INT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5,A6,A7)
-
-PROTOCCALLSFSUB14(D509HI,d509hi,PFLOAT,PFLOAT,FLOAT,FLOAT,PFLOAT,FLOAT,PINT,INT,FLOAT,PINT,FLOAT,FLOAT,PFLOAT,PFLOAT)
-#define D509HI(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14) CCALLSFSUB14(D509HI,d509hi,PFLOAT,PFLOAT,FLOAT,FLOAT,PFLOAT,FLOAT,PINT,INT,FLOAT,PINT,FLOAT,FLOAT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14)
-
-PROTOCCALLSFSUB7(DBEQN,dbeqn,INT,INT,PDOUBLE,INT,PINT,INT,PDOUBLE)
-#define DBEQN(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(DBEQN,dbeqn,INT,INT,PDOUBLE,INT,PINT,INT,PDOUBLE,A1,A2,A3,A4,A5,A6,A7)
-
-PROTOCCALLSFSUB7(DEQINV,deqinv,INT,DOUBLEVV,INT,FLOATV,PINT,INT,DOUBLEV)
-#define DEQINV(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(DEQINV,deqinv,INT,DOUBLEVV,INT,FLOATV,PINT,INT,DOUBLEV,A1,A2,A3,A4,A5,A6,A7)
-
-PROTOCCALLSFSUB7(DEQN,deqn,INT,DOUBLEVV,INT,FLOATV,PINT,INT,DOUBLEV)
-#define DEQN(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(DEQN,deqn,INT,DOUBLEVV,INT,FLOATV,PINT,INT,DOUBLEV,A1,A2,A3,A4,A5,A6,A7)
-
-PROTOCCALLSFSUB7(DFACT,dfact,INT,PDOUBLE,INT,PINT,PINT,PDOUBLE,PINT)
-#define DFACT(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(DFACT,dfact,INT,PDOUBLE,INT,PINT,PINT,PDOUBLE,PINT,A1,A2,A3,A4,A5,A6,A7)
-
-PROTOCCALLSFSUB6(DFEQN,dfeqn,INT,PDOUBLE,INT,INTV,INT,PDOUBLE)
-#define DFEQN(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(DFEQN,dfeqn,INT,PDOUBLE,INT,INTV,INT,PDOUBLE,A1,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFSUB4(DFINV,dfinv,INT,PDOUBLE,INT,INTV)
-#define DFINV(A1,A2,A3,A4) CCALLSFSUB4(DFINV,dfinv,INT,PDOUBLE,INT,INTV,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB5(DINV,dinv,INT,DOUBLEVV,INT,FLOATV,PINT)
-#define DINV(A1,A2,A3,A4,A5) CCALLSFSUB5(DINV,dinv,INT,DOUBLEVV,INT,FLOATV,PINT,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB11(DMADD,dmadd,INT,INT,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,PDOUBLE,DOUBLEV,DOUBLEV)
-#define DMADD(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11) CCALLSFSUB11(DMADD,dmadd,INT,INT,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,PDOUBLE,DOUBLEV,DOUBLEV,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11)
-
-PROTOCCALLSFSUB8(DMCPY,dmcpy,INT,INT,DOUBLEV,DOUBLEV,DOUBLEV,PDOUBLE,DOUBLEV,DOUBLEV)
-#define DMCPY(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(DMCPY,dmcpy,INT,INT,DOUBLEV,DOUBLEV,DOUBLEV,PDOUBLE,DOUBLEV,DOUBLEV,A1,A2,A3,A4,A5,A6,A7,A8)
-
-PROTOCCALLSFSUB12(DMMLA,dmmla,INT,INT,INT,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,PDOUBLE,DOUBLEV,DOUBLEV)
-#define DMMLA(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12) CCALLSFSUB12(DMMLA,dmmla,INT,INT,INT,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,PDOUBLE,DOUBLEV,DOUBLEV,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12)
-
-PROTOCCALLSFSUB12(DMMLS,dmmls,INT,INT,INT,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,PDOUBLE,DOUBLEV,DOUBLEV)
-#define DMMLS(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12) CCALLSFSUB12(DMMLS,dmmls,INT,INT,INT,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,PDOUBLE,DOUBLEV,DOUBLEV,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12)
-
-PROTOCCALLSFSUB13(DMMLT,dmmlt,INT,INT,INT,PDOUBLE,DOUBLEV,DOUBLEV,PDOUBLE,DOUBLEV,DOUBLEV,PDOUBLE,DOUBLEV,DOUBLEV,PDOUBLE)
-#define DMMLT(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13) CCALLSFSUB13(DMMLT,dmmlt,INT,INT,INT,PDOUBLE,DOUBLEV,DOUBLEV,PDOUBLE,DOUBLEV,DOUBLEV,PDOUBLE,DOUBLEV,DOUBLEV,PDOUBLE,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13)
-
-PROTOCCALLSFSUB9(DMMNA,dmmna,INT,INT,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,PDOUBLE,DOUBLEV)
-#define DMMNA(A1,A2,A3,A4,A5,A6,A7,A8,A9) CCALLSFSUB9(DMMNA,dmmna,INT,INT,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,PDOUBLE,DOUBLEV,A1,A2,A3,A4,A5,A6,A7,A8,A9)
-
-PROTOCCALLSFSUB9(DMMNS,dmmns,INT,INT,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,PDOUBLE,DOUBLEV)
-#define DMMNS(A1,A2,A3,A4,A5,A6,A7,A8,A9) CCALLSFSUB9(DMMNS,dmmns,INT,INT,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,PDOUBLE,DOUBLEV,A1,A2,A3,A4,A5,A6,A7,A8,A9)
-
-PROTOCCALLSFSUB9(DMMPA,dmmpa,INT,INT,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,PDOUBLE,DOUBLEV)
-#define DMMPA(A1,A2,A3,A4,A5,A6,A7,A8,A9) CCALLSFSUB9(DMMPA,dmmpa,INT,INT,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,PDOUBLE,DOUBLEV,A1,A2,A3,A4,A5,A6,A7,A8,A9)
-
-PROTOCCALLSFSUB9(DMMPS,dmmps,INT,INT,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,PDOUBLE,DOUBLEV)
-#define DMMPS(A1,A2,A3,A4,A5,A6,A7,A8,A9) CCALLSFSUB9(DMMPS,dmmps,INT,INT,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,PDOUBLE,DOUBLEV,A1,A2,A3,A4,A5,A6,A7,A8,A9)
-
-PROTOCCALLSFSUB9(DMMPY,dmmpy,INT,INT,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,PDOUBLE,DOUBLEV)
-#define DMMPY(A1,A2,A3,A4,A5,A6,A7,A8,A9) CCALLSFSUB9(DMMPY,dmmpy,INT,INT,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,PDOUBLE,DOUBLEV,A1,A2,A3,A4,A5,A6,A7,A8,A9)
-
-PROTOCCALLSFSUB12(DMNMA,dmnma,INT,INT,INT,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,PDOUBLE,DOUBLEV,DOUBLEV)
-#define DMNMA(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12) CCALLSFSUB12(DMNMA,dmnma,INT,INT,INT,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,PDOUBLE,DOUBLEV,DOUBLEV,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12)
-
-PROTOCCALLSFSUB12(DMNMS,dmnms,INT,INT,INT,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,PDOUBLE,DOUBLEV,DOUBLEV)
-#define DMNMS(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12) CCALLSFSUB12(DMNMS,dmnms,INT,INT,INT,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,PDOUBLE,DOUBLEV,DOUBLEV,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12)
-
-PROTOCCALLSFSUB7(DMRAN,dmran,INT,INT,DOUBLE,DOUBLE,PDOUBLE,DOUBLEV,DOUBLEV)
-#define DMRAN(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(DMRAN,dmran,INT,INT,DOUBLE,DOUBLE,PDOUBLE,DOUBLEV,DOUBLEV,A1,A2,A3,A4,A5,A6,A7)
-
-PROTOCCALLSFSUB9(DMSCL,dmscl,INT,INT,DOUBLE,DOUBLEV,DOUBLEV,DOUBLEV,PDOUBLE,DOUBLEV,DOUBLEV)
-#define DMSCL(A1,A2,A3,A4,A5,A6,A7,A8,A9) CCALLSFSUB9(DMSCL,dmscl,INT,INT,DOUBLE,DOUBLEV,DOUBLEV,DOUBLEV,PDOUBLE,DOUBLEV,DOUBLEV,A1,A2,A3,A4,A5,A6,A7,A8,A9)
-
-PROTOCCALLSFSUB6(DMSET,dmset,INT,INT,DOUBLE,PDOUBLE,DOUBLEV,DOUBLEV)
-#define DMSET(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(DMSET,dmset,INT,INT,DOUBLE,PDOUBLE,DOUBLEV,DOUBLEV,A1,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFSUB11(DMSUB,dmsub,INT,INT,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,PDOUBLE,DOUBLEV,DOUBLEV)
-#define DMSUB(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11) CCALLSFSUB11(DMSUB,dmsub,INT,INT,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,PDOUBLE,DOUBLEV,DOUBLEV,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11)
-
-PROTOCCALLSFSUB4(DMUTL,dmutl,INT,PDOUBLE,DOUBLEV,DOUBLEV)
-#define DMUTL(A1,A2,A3,A4) CCALLSFSUB4(DMUTL,dmutl,INT,PDOUBLE,DOUBLEV,DOUBLEV,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB6(DRKSTP,drkstp,INT,DOUBLE,PDOUBLE,PDOUBLE,FLOAT,PDOUBLE)
-#define DRKSTP(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(DRKSTP,drkstp,INT,DOUBLE,PDOUBLE,PDOUBLE,FLOAT,PDOUBLE,A1,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFSUB10(DRSCL,drscl,INT,INT,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,PDOUBLE,DOUBLEV,DOUBLEV)
-#define DRSCL(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10) CCALLSFSUB10(DRSCL,drscl,INT,INT,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,PDOUBLE,DOUBLEV,DOUBLEV,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10)
-
-PROTOCCALLSFSUB6(DSEQN,dseqn,INT,PDOUBLE,INT,PINT,INT,PDOUBLE)
-#define DSEQN(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(DSEQN,dseqn,INT,PDOUBLE,INT,PINT,INT,PDOUBLE,A1,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFSUB6(DSFACT,dsfact,INT,PDOUBLE,INT,PINT,PDOUBLE,PINT)
-#define DSFACT(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(DSFACT,dsfact,INT,PDOUBLE,INT,PINT,PDOUBLE,PINT,A1,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFSUB5(DSFEQN,dsfeqn,INT,PDOUBLE,INT,INT,PDOUBLE)
-#define DSFEQN(A1,A2,A3,A4,A5) CCALLSFSUB5(DSFEQN,dsfeqn,INT,PDOUBLE,INT,INT,PDOUBLE,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB3(DSFINV,dsfinv,INT,PDOUBLE,INT)
-#define DSFINV(A1,A2,A3) CCALLSFSUB3(DSFINV,dsfinv,INT,PDOUBLE,INT,A1,A2,A3)
-
-PROTOCCALLSFSUB4(DSINV,dsinv,INT,PDOUBLE,INT,PINT)
-#define DSINV(A1,A2,A3,A4) CCALLSFSUB4(DSINV,dsinv,INT,PDOUBLE,INT,PINT,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB8(DUMNA,dumna,INT,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,PDOUBLE,DOUBLEV)
-#define DUMNA(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(DUMNA,dumna,INT,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,PDOUBLE,DOUBLEV,A1,A2,A3,A4,A5,A6,A7,A8)
-
-PROTOCCALLSFSUB8(DUMNS,dumns,INT,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,PDOUBLE,DOUBLEV)
-#define DUMNS(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(DUMNS,dumns,INT,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,PDOUBLE,DOUBLEV,A1,A2,A3,A4,A5,A6,A7,A8)
-
-PROTOCCALLSFSUB8(DUMPA,dumpa,INT,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,PDOUBLE,DOUBLEV)
-#define DUMPA(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(DUMPA,dumpa,INT,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,PDOUBLE,DOUBLEV,A1,A2,A3,A4,A5,A6,A7,A8)
-
-PROTOCCALLSFSUB8(DUMPS,dumps,INT,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,PDOUBLE,DOUBLEV)
-#define DUMPS(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(DUMPS,dumps,INT,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,PDOUBLE,DOUBLEV,A1,A2,A3,A4,A5,A6,A7,A8)
-
-PROTOCCALLSFSUB8(DUMPY,dumpy,INT,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,PDOUBLE,DOUBLEV)
-#define DUMPY(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(DUMPY,dumpy,INT,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,PDOUBLE,DOUBLEV,A1,A2,A3,A4,A5,A6,A7,A8)
-
-PROTOCCALLSFSUB7(DVADD,dvadd,INT,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,PDOUBLE,DOUBLEV)
-#define DVADD(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(DVADD,dvadd,INT,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,PDOUBLE,DOUBLEV,A1,A2,A3,A4,A5,A6,A7)
-
-PROTOCCALLSFSUB5(DVCPY,dvcpy,INT,DOUBLEV,DOUBLEV,PDOUBLE,DOUBLEV)
-#define DVCPY(A1,A2,A3,A4,A5) CCALLSFSUB5(DVCPY,dvcpy,INT,DOUBLEV,DOUBLEV,PDOUBLE,DOUBLEV,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB8(DVDIV,dvdiv,INT,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,PDOUBLE,DOUBLEV,PINT)
-#define DVDIV(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(DVDIV,dvdiv,INT,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,PDOUBLE,DOUBLEV,PINT,A1,A2,A3,A4,A5,A6,A7,A8)
-
-PROTOCCALLSFSUB7(DVMUL,dvmul,INT,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,PDOUBLE,DOUBLEV)
-#define DVMUL(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(DVMUL,dvmul,INT,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,PDOUBLE,DOUBLEV,A1,A2,A3,A4,A5,A6,A7)
-
-PROTOCCALLSFSUB7(DVMULA,dvmula,INT,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,PDOUBLE,DOUBLEV)
-#define DVMULA(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(DVMULA,dvmula,INT,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,PDOUBLE,DOUBLEV,A1,A2,A3,A4,A5,A6,A7)
-
-PROTOCCALLSFSUB7(DVMUNA,dvmuna,INT,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,PDOUBLE,DOUBLEV)
-#define DVMUNA(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(DVMUNA,dvmuna,INT,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,PDOUBLE,DOUBLEV,A1,A2,A3,A4,A5,A6,A7)
-
-PROTOCCALLSFSUB5(DVRAN,dvran,INT,DOUBLE,DOUBLE,PDOUBLE,DOUBLEV)
-#define DVRAN(A1,A2,A3,A4,A5) CCALLSFSUB5(DVRAN,dvran,INT,DOUBLE,DOUBLE,PDOUBLE,DOUBLEV,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB8(DVSCA,dvsca,INT,DOUBLE,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,PDOUBLE,DOUBLEV)
-#define DVSCA(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(DVSCA,dvsca,INT,DOUBLE,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,PDOUBLE,DOUBLEV,A1,A2,A3,A4,A5,A6,A7,A8)
-
-PROTOCCALLSFSUB6(DVSCL,dvscl,INT,DOUBLE,DOUBLEV,DOUBLEV,PDOUBLE,DOUBLEV)
-#define DVSCL(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(DVSCL,dvscl,INT,DOUBLE,DOUBLEV,DOUBLEV,PDOUBLE,DOUBLEV,A1,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFSUB8(DVSCS,dvscs,INT,DOUBLE,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,PDOUBLE,DOUBLEV)
-#define DVSCS(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(DVSCS,dvscs,INT,DOUBLE,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,PDOUBLE,DOUBLEV,A1,A2,A3,A4,A5,A6,A7,A8)
-
-PROTOCCALLSFSUB4(DVSET,dvset,INT,DOUBLE,PDOUBLE,DOUBLEV)
-#define DVSET(A1,A2,A3,A4) CCALLSFSUB4(DVSET,dvset,INT,DOUBLE,PDOUBLE,DOUBLEV,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB7(DVSUB,dvsub,INT,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,PDOUBLE,DOUBLEV)
-#define DVSUB(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(DVSUB,dvsub,INT,DOUBLEV,DOUBLEV,DOUBLEV,DOUBLEV,PDOUBLE,DOUBLEV,A1,A2,A3,A4,A5,A6,A7)
-
-PROTOCCALLSFSUB5(DVXCH,dvxch,INT,PDOUBLE,DOUBLEV,PDOUBLE,DOUBLEV)
-#define DVXCH(A1,A2,A3,A4,A5) CCALLSFSUB5(DVXCH,dvxch,INT,PDOUBLE,DOUBLEV,PDOUBLE,DOUBLEV,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB7(DZERO,dzero,DOUBLE,DOUBLE,PDOUBLE,PDOUBLE,DOUBLE,INT,DOUBLE)
-#define DZERO(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(DZERO,dzero,DOUBLE,DOUBLE,PDOUBLE,PDOUBLE,DOUBLE,INT,DOUBLE,A1,A2,A3,A4,A5,A6,A7)
-
-PROTOCCALLSFSUB3(E208PR,e208pr,INT,PINT,INT)
-#define E208PR(A1,A2,A3) CCALLSFSUB3(E208PR,e208pr,INT,PINT,INT,A1,A2,A3)
-
-PROTOCCALLSFSUB5(F010PR,f010pr,STRING,INT,INT,INT,INT)
-#define F010PR(A1,A2,A3,A4,A5) CCALLSFSUB5(F010PR,f010pr,STRING,INT,INT,INT,INT,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB5(GSET,gset,FLOAT,FLOAT,INT,FLOATV,FLOATV)
-#define GSET(A1,A2,A3,A4,A5) CCALLSFSUB5(GSET,gset,FLOAT,FLOAT,INT,FLOATV,FLOATV,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB1(KERNNT,kernnt,INT)
-#define KERNNT(A1) CCALLSFSUB1(KERNNT,kernnt,INT,A1)
-
-PROTOCCALLSFSUB4(KERSET,kerset,STRING,INT,INT,INT)
-#define KERSET(A1,A2,A3,A4) CCALLSFSUB4(KERSET,kerset,STRING,INT,INT,INT,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB6(LLSQ,llsq,INT,FLOATV,FLOATV,PFLOAT,PFLOAT,PINT)
-#define LLSQ(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(LLSQ,llsq,INT,FLOATV,FLOATV,PFLOAT,PFLOAT,PINT,A1,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFSUB5(LSQ,lsq,INT,FLOATV,FLOATV,INT,PFLOAT)
-#define LSQ(A1,A2,A3,A4,A5) CCALLSFSUB5(LSQ,lsq,INT,FLOATV,FLOATV,INT,PFLOAT,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB9(MINVAR,minvar,PFLOAT,PFLOAT,PFLOAT,FLOAT,FLOAT,INT,FLOAT,FLOAT,FLOAT)
-#define MINVAR(A1,A2,A3,A4,A5,A6,A7,A8,A9) CCALLSFSUB9(MINVAR,minvar,PFLOAT,PFLOAT,PFLOAT,FLOAT,FLOAT,INT,FLOAT,FLOAT,FLOAT,A1,A2,A3,A4,A5,A6,A7,A8,A9)
-
-PROTOCCALLSFSUB5(POLINT,polint,FLOATV,FLOATV,INT,FLOAT,PFLOAT)
-#define POLINT(A1,A2,A3,A4,A5) CCALLSFSUB5(POLINT,polint,FLOATV,FLOATV,INT,FLOAT,PFLOAT,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB3(RAN2VS,ran2vs,FLOAT,PFLOAT,PFLOAT)
-#define RAN2VS(A1,A2,A3) CCALLSFSUB3(RAN2VS,ran2vs,FLOAT,PFLOAT,PFLOAT,A1,A2,A3)
-
-PROTOCCALLSFSUB4(RAN3VS,ran3vs,FLOAT,PFLOAT,PFLOAT,PFLOAT)
-#define RAN3VS(A1,A2,A3,A4) CCALLSFSUB4(RAN3VS,ran3vs,FLOAT,PFLOAT,PFLOAT,PFLOAT,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB1(RANGET,ranget,PDOUBLE)
-#define RANGET(A1) CCALLSFSUB1(RANGET,ranget,PDOUBLE,A1)
-
-PROTOCCALLSFSUB7(RBEQN,rbeqn,INT,INT,PFLOAT,INT,PINT,INT,PFLOAT)
-#define RBEQN(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(RBEQN,rbeqn,INT,INT,PFLOAT,INT,PINT,INT,PFLOAT,A1,A2,A3,A4,A5,A6,A7)
-
-PROTOCCALLSFSUB7(REQINV,reqinv,INT,FLOATVV,INT,FLOATV,PINT,INT,FLOATV)
-#define REQINV(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(REQINV,reqinv,INT,FLOATVV,INT,FLOATV,PINT,INT,FLOATV,A1,A2,A3,A4,A5,A6,A7)
-
-PROTOCCALLSFSUB7(REQN,reqn,INT,FLOATVV,INT,FLOATV,PINT,INT,FLOATV)
-#define REQN(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(REQN,reqn,INT,FLOATVV,INT,FLOATV,PINT,INT,FLOATV,A1,A2,A3,A4,A5,A6,A7)
-
-PROTOCCALLSFSUB7(RFACT,rfact,INT,PFLOAT,INT,PINT,PINT,PFLOAT,PINT)
-#define RFACT(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(RFACT,rfact,INT,PFLOAT,INT,PINT,PINT,PFLOAT,PINT,A1,A2,A3,A4,A5,A6,A7)
-
-PROTOCCALLSFSUB6(RFEQN,rfeqn,INT,PFLOAT,INT,INTV,INT,PFLOAT)
-#define RFEQN(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(RFEQN,rfeqn,INT,PFLOAT,INT,INTV,INT,PFLOAT,A1,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFSUB4(RFINV,rfinv,INT,PFLOAT,INT,INTV)
-#define RFINV(A1,A2,A3,A4) CCALLSFSUB4(RFINV,rfinv,INT,PFLOAT,INT,INTV,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB5(RINV,rinv,INT,FLOATVV,INT,FLOATV,PINT)
-#define RINV(A1,A2,A3,A4,A5) CCALLSFSUB5(RINV,rinv,INT,FLOATVV,INT,FLOATV,PINT,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB6(RKSTP,rkstp,INT,FLOAT,PFLOAT,PFLOAT,FLOAT,PFLOAT)
-#define RKSTP(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(RKSTP,rkstp,INT,FLOAT,PFLOAT,PFLOAT,FLOAT,PFLOAT,A1,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFSUB11(RMADD,rmadd,INT,INT,FLOATV,FLOATV,FLOATV,FLOATV,FLOATV,FLOATV,PFLOAT,FLOATV,FLOATV)
-#define RMADD(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11) CCALLSFSUB11(RMADD,rmadd,INT,INT,FLOATV,FLOATV,FLOATV,FLOATV,FLOATV,FLOATV,PFLOAT,FLOATV,FLOATV,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11)
-
-PROTOCCALLSFSUB8(RMCPY,rmcpy,INT,INT,FLOATV,FLOATV,FLOATV,PFLOAT,FLOATV,FLOATV)
-#define RMCPY(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(RMCPY,rmcpy,INT,INT,FLOATV,FLOATV,FLOATV,PFLOAT,FLOATV,FLOATV,A1,A2,A3,A4,A5,A6,A7,A8)
-
-PROTOCCALLSFSUB12(RMMLA,rmmla,INT,INT,INT,FLOATV,FLOATV,FLOATV,FLOATV,FLOATV,FLOATV,PFLOAT,FLOATV,FLOATV)
-#define RMMLA(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12) CCALLSFSUB12(RMMLA,rmmla,INT,INT,INT,FLOATV,FLOATV,FLOATV,FLOATV,FLOATV,FLOATV,PFLOAT,FLOATV,FLOATV,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12)
-
-PROTOCCALLSFSUB12(RMMLS,rmmls,INT,INT,INT,FLOATV,FLOATV,FLOATV,FLOATV,FLOATV,FLOATV,PFLOAT,FLOATV,FLOATV)
-#define RMMLS(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12) CCALLSFSUB12(RMMLS,rmmls,INT,INT,INT,FLOATV,FLOATV,FLOATV,FLOATV,FLOATV,FLOATV,PFLOAT,FLOATV,FLOATV,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12)
-
-PROTOCCALLSFSUB13(RMMLT,rmmlt,INT,INT,INT,PFLOAT,FLOATV,FLOATV,PFLOAT,FLOATV,FLOATV,PFLOAT,FLOATV,FLOATV,PFLOAT)
-#define RMMLT(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13) CCALLSFSUB13(RMMLT,rmmlt,INT,INT,INT,PFLOAT,FLOATV,FLOATV,PFLOAT,FLOATV,FLOATV,PFLOAT,FLOATV,FLOATV,PFLOAT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13)
-
-PROTOCCALLSFSUB9(RMMNA,rmmna,INT,INT,FLOATV,FLOATV,FLOATV,FLOATV,FLOATV,PFLOAT,FLOATV)
-#define RMMNA(A1,A2,A3,A4,A5,A6,A7,A8,A9) CCALLSFSUB9(RMMNA,rmmna,INT,INT,FLOATV,FLOATV,FLOATV,FLOATV,FLOATV,PFLOAT,FLOATV,A1,A2,A3,A4,A5,A6,A7,A8,A9)
-
-PROTOCCALLSFSUB9(RMMNS,rmmns,INT,INT,FLOATV,FLOATV,FLOATV,FLOATV,FLOATV,PFLOAT,FLOATV)
-#define RMMNS(A1,A2,A3,A4,A5,A6,A7,A8,A9) CCALLSFSUB9(RMMNS,rmmns,INT,INT,FLOATV,FLOATV,FLOATV,FLOATV,FLOATV,PFLOAT,FLOATV,A1,A2,A3,A4,A5,A6,A7,A8,A9)
-
-PROTOCCALLSFSUB9(RMMPA,rmmpa,INT,INT,FLOATV,FLOATV,FLOATV,FLOATV,FLOATV,PFLOAT,FLOATV)
-#define RMMPA(A1,A2,A3,A4,A5,A6,A7,A8,A9) CCALLSFSUB9(RMMPA,rmmpa,INT,INT,FLOATV,FLOATV,FLOATV,FLOATV,FLOATV,PFLOAT,FLOATV,A1,A2,A3,A4,A5,A6,A7,A8,A9)
-
-PROTOCCALLSFSUB9(RMMPS,rmmps,INT,INT,FLOATV,FLOATV,FLOATV,FLOATV,FLOATV,PFLOAT,FLOATV)
-#define RMMPS(A1,A2,A3,A4,A5,A6,A7,A8,A9) CCALLSFSUB9(RMMPS,rmmps,INT,INT,FLOATV,FLOATV,FLOATV,FLOATV,FLOATV,PFLOAT,FLOATV,A1,A2,A3,A4,A5,A6,A7,A8,A9)
-
-PROTOCCALLSFSUB9(RMMPY,rmmpy,INT,INT,FLOATV,FLOATV,FLOATV,FLOATV,FLOATV,PFLOAT,FLOATV)
-#define RMMPY(A1,A2,A3,A4,A5,A6,A7,A8,A9) CCALLSFSUB9(RMMPY,rmmpy,INT,INT,FLOATV,FLOATV,FLOATV,FLOATV,FLOATV,PFLOAT,FLOATV,A1,A2,A3,A4,A5,A6,A7,A8,A9)
-
-PROTOCCALLSFSUB12(RMNMA,rmnma,INT,INT,INT,FLOATV,FLOATV,FLOATV,FLOATV,FLOATV,FLOATV,PFLOAT,FLOATV,FLOATV)
-#define RMNMA(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12) CCALLSFSUB12(RMNMA,rmnma,INT,INT,INT,FLOATV,FLOATV,FLOATV,FLOATV,FLOATV,FLOATV,PFLOAT,FLOATV,FLOATV,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12)
-
-PROTOCCALLSFSUB12(RMNMS,rmnms,INT,INT,INT,FLOATV,FLOATV,FLOATV,FLOATV,FLOATV,FLOATV,PFLOAT,FLOATV,FLOATV)
-#define RMNMS(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12) CCALLSFSUB12(RMNMS,rmnms,INT,INT,INT,FLOATV,FLOATV,FLOATV,FLOATV,FLOATV,FLOATV,PFLOAT,FLOATV,FLOATV,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12)
-
-PROTOCCALLSFSUB7(RMRAN,rmran,INT,INT,FLOAT,FLOAT,PFLOAT,FLOATV,FLOATV)
-#define RMRAN(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(RMRAN,rmran,INT,INT,FLOAT,FLOAT,PFLOAT,FLOATV,FLOATV,A1,A2,A3,A4,A5,A6,A7)
-
-PROTOCCALLSFSUB9(RMSCL,rmscl,INT,INT,FLOAT,FLOATV,FLOATV,FLOATV,PFLOAT,FLOATV,FLOATV)
-#define RMSCL(A1,A2,A3,A4,A5,A6,A7,A8,A9) CCALLSFSUB9(RMSCL,rmscl,INT,INT,FLOAT,FLOATV,FLOATV,FLOATV,PFLOAT,FLOATV,FLOATV,A1,A2,A3,A4,A5,A6,A7,A8,A9)
-
-PROTOCCALLSFSUB6(RMSET,rmset,INT,INT,FLOAT,PFLOAT,FLOATV,FLOATV)
-#define RMSET(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(RMSET,rmset,INT,INT,FLOAT,PFLOAT,FLOATV,FLOATV,A1,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFSUB11(RMSUB,rmsub,INT,INT,FLOATV,FLOATV,FLOATV,FLOATV,FLOATV,FLOATV,PFLOAT,FLOATV,FLOATV)
-#define RMSUB(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11) CCALLSFSUB11(RMSUB,rmsub,INT,INT,FLOATV,FLOATV,FLOATV,FLOATV,FLOATV,FLOATV,PFLOAT,FLOATV,FLOATV,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11)
-
-PROTOCCALLSFSUB4(RMUTL,rmutl,INT,PFLOAT,FLOATV,FLOATV)
-#define RMUTL(A1,A2,A3,A4) CCALLSFSUB4(RMUTL,rmutl,INT,PFLOAT,FLOATV,FLOATV,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB10(RRSCL,rrscl,INT,INT,FLOATV,FLOATV,FLOATV,FLOATV,FLOATV,PFLOAT,FLOATV,FLOATV)
-#define RRSCL(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10) CCALLSFSUB10(RRSCL,rrscl,INT,INT,FLOATV,FLOATV,FLOATV,FLOATV,FLOATV,PFLOAT,FLOATV,FLOATV,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10)
-
-PROTOCCALLSFSUB6(RSEQN,rseqn,INT,PFLOAT,INT,PINT,INT,PFLOAT)
-#define RSEQN(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(RSEQN,rseqn,INT,PFLOAT,INT,PINT,INT,PFLOAT,A1,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFSUB6(RSFACT,rsfact,INT,PFLOAT,INT,PINT,PFLOAT,PINT)
-#define RSFACT(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(RSFACT,rsfact,INT,PFLOAT,INT,PINT,PFLOAT,PINT,A1,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFSUB5(RSFEQN,rsfeqn,INT,PFLOAT,INT,INT,PFLOAT)
-#define RSFEQN(A1,A2,A3,A4,A5) CCALLSFSUB5(RSFEQN,rsfeqn,INT,PFLOAT,INT,INT,PFLOAT,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB3(RSFINV,rsfinv,INT,PFLOAT,INT)
-#define RSFINV(A1,A2,A3) CCALLSFSUB3(RSFINV,rsfinv,INT,PFLOAT,INT,A1,A2,A3)
-
-PROTOCCALLSFSUB4(RSINV,rsinv,INT,PFLOAT,INT,PINT)
-#define RSINV(A1,A2,A3,A4) CCALLSFSUB4(RSINV,rsinv,INT,PFLOAT,INT,PINT,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB8(RUMNA,rumna,INT,FLOATV,FLOATV,FLOATV,FLOATV,FLOATV,PFLOAT,FLOATV)
-#define RUMNA(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(RUMNA,rumna,INT,FLOATV,FLOATV,FLOATV,FLOATV,FLOATV,PFLOAT,FLOATV,A1,A2,A3,A4,A5,A6,A7,A8)
-
-PROTOCCALLSFSUB8(RUMNS,rumns,INT,FLOATV,FLOATV,FLOATV,FLOATV,FLOATV,PFLOAT,FLOATV)
-#define RUMNS(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(RUMNS,rumns,INT,FLOATV,FLOATV,FLOATV,FLOATV,FLOATV,PFLOAT,FLOATV,A1,A2,A3,A4,A5,A6,A7,A8)
-
-PROTOCCALLSFSUB8(RUMPA,rumpa,INT,FLOATV,FLOATV,FLOATV,FLOATV,FLOATV,PFLOAT,FLOATV)
-#define RUMPA(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(RUMPA,rumpa,INT,FLOATV,FLOATV,FLOATV,FLOATV,FLOATV,PFLOAT,FLOATV,A1,A2,A3,A4,A5,A6,A7,A8)
-
-PROTOCCALLSFSUB8(RUMPS,rumps,INT,FLOATV,FLOATV,FLOATV,FLOATV,FLOATV,PFLOAT,FLOATV)
-#define RUMPS(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(RUMPS,rumps,INT,FLOATV,FLOATV,FLOATV,FLOATV,FLOATV,PFLOAT,FLOATV,A1,A2,A3,A4,A5,A6,A7,A8)
-
-PROTOCCALLSFSUB8(RUMPY,rumpy,INT,FLOATV,FLOATV,FLOATV,FLOATV,FLOATV,PFLOAT,FLOATV)
-#define RUMPY(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(RUMPY,rumpy,INT,FLOATV,FLOATV,FLOATV,FLOATV,FLOATV,PFLOAT,FLOATV,A1,A2,A3,A4,A5,A6,A7,A8)
-
-PROTOCCALLSFSUB7(RVADD,rvadd,INT,FLOATV,FLOATV,FLOATV,FLOATV,PFLOAT,FLOATV)
-#define RVADD(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(RVADD,rvadd,INT,FLOATV,FLOATV,FLOATV,FLOATV,PFLOAT,FLOATV,A1,A2,A3,A4,A5,A6,A7)
-
-PROTOCCALLSFSUB5(RVCPY,rvcpy,INT,FLOATV,FLOATV,PFLOAT,FLOATV)
-#define RVCPY(A1,A2,A3,A4,A5) CCALLSFSUB5(RVCPY,rvcpy,INT,FLOATV,FLOATV,PFLOAT,FLOATV,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB8(RVDIV,rvdiv,INT,FLOATV,FLOATV,FLOATV,FLOATV,PFLOAT,FLOATV,PINT)
-#define RVDIV(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(RVDIV,rvdiv,INT,FLOATV,FLOATV,FLOATV,FLOATV,PFLOAT,FLOATV,PINT,A1,A2,A3,A4,A5,A6,A7,A8)
-
-PROTOCCALLSFSUB7(RVMUL,rvmul,INT,FLOATV,FLOATV,FLOATV,FLOATV,PFLOAT,FLOATV)
-#define RVMUL(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(RVMUL,rvmul,INT,FLOATV,FLOATV,FLOATV,FLOATV,PFLOAT,FLOATV,A1,A2,A3,A4,A5,A6,A7)
-
-PROTOCCALLSFSUB7(RVMULA,rvmula,INT,FLOATV,FLOATV,FLOATV,FLOATV,PFLOAT,FLOATV)
-#define RVMULA(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(RVMULA,rvmula,INT,FLOATV,FLOATV,FLOATV,FLOATV,PFLOAT,FLOATV,A1,A2,A3,A4,A5,A6,A7)
-
-PROTOCCALLSFSUB7(RVMUNA,rvmuna,INT,FLOATV,FLOATV,FLOATV,FLOATV,PFLOAT,FLOATV)
-#define RVMUNA(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(RVMUNA,rvmuna,INT,FLOATV,FLOATV,FLOATV,FLOATV,PFLOAT,FLOATV,A1,A2,A3,A4,A5,A6,A7)
-
-PROTOCCALLSFSUB5(RVRAN,rvran,INT,FLOAT,FLOAT,PFLOAT,FLOATV)
-#define RVRAN(A1,A2,A3,A4,A5) CCALLSFSUB5(RVRAN,rvran,INT,FLOAT,FLOAT,PFLOAT,FLOATV,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB8(RVSCA,rvsca,INT,FLOAT,FLOATV,FLOATV,FLOATV,FLOATV,PFLOAT,FLOATV)
-#define RVSCA(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(RVSCA,rvsca,INT,FLOAT,FLOATV,FLOATV,FLOATV,FLOATV,PFLOAT,FLOATV,A1,A2,A3,A4,A5,A6,A7,A8)
-
-PROTOCCALLSFSUB6(RVSCL,rvscl,INT,FLOAT,FLOATV,FLOATV,PFLOAT,FLOATV)
-#define RVSCL(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(RVSCL,rvscl,INT,FLOAT,FLOATV,FLOATV,PFLOAT,FLOATV,A1,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFSUB8(RVSCS,rvscs,INT,FLOAT,FLOATV,FLOATV,FLOATV,FLOATV,PFLOAT,FLOATV)
-#define RVSCS(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(RVSCS,rvscs,INT,FLOAT,FLOATV,FLOATV,FLOATV,FLOATV,PFLOAT,FLOATV,A1,A2,A3,A4,A5,A6,A7,A8)
-
-PROTOCCALLSFSUB4(RVSET,rvset,INT,FLOAT,PFLOAT,FLOATV)
-#define RVSET(A1,A2,A3,A4) CCALLSFSUB4(RVSET,rvset,INT,FLOAT,PFLOAT,FLOATV,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB7(RVSUB,rvsub,INT,FLOATV,FLOATV,FLOATV,FLOATV,PFLOAT,FLOATV)
-#define RVSUB(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(RVSUB,rvsub,INT,FLOATV,FLOATV,FLOATV,FLOATV,PFLOAT,FLOATV,A1,A2,A3,A4,A5,A6,A7)
-
-PROTOCCALLSFSUB5(RVXCH,rvxch,INT,PFLOAT,FLOATV,PFLOAT,FLOATV)
-#define RVXCH(A1,A2,A3,A4,A5) CCALLSFSUB5(RVXCH,rvxch,INT,PFLOAT,FLOATV,PFLOAT,FLOATV,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB7(RZERO,rzero,FLOAT,FLOAT,PFLOAT,PFLOAT,FLOAT,INT,FLOAT)
-#define RZERO(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(RZERO,rzero,FLOAT,FLOAT,PFLOAT,PFLOAT,FLOAT,INT,FLOAT,A1,A2,A3,A4,A5,A6,A7)
-
-PROTOCCALLSFSUB4(TMPRNT,tmprnt,STRING,INT,INT,INT)
-#define TMPRNT(A1,A2,A3,A4) CCALLSFSUB4(TMPRNT,tmprnt,STRING,INT,INT,INT,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB5(VRAN2S,vran2s,FLOAT,INT,PFLOAT,PFLOAT,PFLOAT)
-#define VRAN2S(A1,A2,A3,A4,A5) CCALLSFSUB5(VRAN2S,vran2s,FLOAT,INT,PFLOAT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB6(VRAN3S,vran3s,FLOAT,INT,PFLOAT,PFLOAT,PFLOAT,PFLOAT)
-#define VRAN3S(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(VRAN3S,vran3s,FLOAT,INT,PFLOAT,PFLOAT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFSUB0(ABEND,abend)
-#define ABEND() CCALLSFSUB0(ABEND,abend)
-
-PROTOCCALLSFSUB4(BITPOS,bitpos,INTV,INT,PINT,PINT)
-#define BITPOS(A1,A2,A3,A4) CCALLSFSUB4(BITPOS,bitpos,INTV,INT,PINT,PINT,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB4(BLOW,blow,FLOATV,INTV,INTV,INT)
-#define BLOW(A1,A2,A3,A4) CCALLSFSUB4(BLOW,blow,FLOATV,INTV,INTV,INT,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB4(BUNCH,bunch,INTV,FLOATV,INTV,INT)
-#define BUNCH(A1,A2,A3,A4) CCALLSFSUB4(BUNCH,bunch,INTV,FLOATV,INTV,INT,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB5(CBYT,cbyt,INT,INT,PINT,INT,INT)
-#define CBYT(A1,A2,A3,A4,A5) CCALLSFSUB5(CBYT,cbyt,INT,INT,PINT,INT,INT,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB3(CCOPIV,ccopiv,BYTEV,PBYTE,INT)
-#define CCOPIV(A1,A2,A3) CCALLSFSUB3(CCOPIV,ccopiv,BYTEV,PBYTE,INT,A1,A2,A3)
-
-PROTOCCALLSFSUB3(CCOPYL,ccopyl,BYTEV,PBYTE,INT)
-#define CCOPYL(A1,A2,A3) CCALLSFSUB3(CCOPYL,ccopyl,BYTEV,PBYTE,INT,A1,A2,A3)
-
-PROTOCCALLSFSUB3(CCOPYR,ccopyr,BYTEV,PBYTE,INT)
-#define CCOPYR(A1,A2,A3) CCALLSFSUB3(CCOPYR,ccopyr,BYTEV,PBYTE,INT,A1,A2,A3)
-
-PROTOCCALLSFSUB6(CCOSUB,ccosub,BYTE,PBYTE,INT,INT,BYTE,BYTE)
-#define CCOSUB(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(CCOSUB,ccosub,BYTE,PBYTE,INT,INT,BYTE,BYTE,A1,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFSUB6(CENVIR,cenvir,BYTE,INT,PBYTE,INT,INT,INT)
-#define CENVIR(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(CENVIR,cenvir,BYTE,INT,PBYTE,INT,INT,INT,A1,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFSUB4(CFILL,cfill,BYTE,PBYTE,INT,INT)
-#define CFILL(A1,A2,A3,A4) CCALLSFSUB4(CFILL,cfill,BYTE,PBYTE,INT,INT,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB7(CFOPEN,cfopen,PINT,INT,INT,BYTE,INT,BYTE,PINT)
-#define CFOPEN(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(CFOPEN,cfopen,PINT,INT,INT,BYTE,INT,BYTE,PINT,A1,A2,A3,A4,A5,A6,A7)
-
-PROTOCCALLSFSUB3(CFWEOF,cfweof,INT,INT,PINT)
-#define CFWEOF(A1,A2,A3) CCALLSFSUB3(CFWEOF,cfweof,INT,INT,PINT,A1,A2,A3)
-
-PROTOCCALLSFSUB2(CHTOI,chtoi,FLOAT,INT)
-#define CHTOI(A1,A2) CCALLSFSUB2(CHTOI,chtoi,FLOAT,INT,A1,A2)
-
-PROTOCCALLSFSUB4(CIOPEN,ciopen,PINT,BYTE,BYTE,PINT)
-#define CIOPEN(A1,A2,A3,A4) CCALLSFSUB4(CIOPEN,ciopen,PINT,BYTE,BYTE,PINT,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB4(CKRACK,ckrack,BYTEV,INTV,INTV,INT)
-#define CKRACK(A1,A2,A3,A4) CCALLSFSUB4(CKRACK,ckrack,BYTEV,INTV,INTV,INT,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB3(CLEFT,cleft,PBYTE,INTV,INTV)
-#define CLEFT(A1,A2,A3) CCALLSFSUB3(CLEFT,cleft,PBYTE,INTV,INTV,A1,A2,A3)
-
-PROTOCCALLSFSUB1(CLTOU,cltou,PBYTE)
-#define CLTOU(A1) CCALLSFSUB1(CLTOU,cltou,PBYTE,A1)
-
-PROTOCCALLSFSUB3(CRIGHT,cright,PBYTE,INTV,INTV)
-#define CRIGHT(A1,A2,A3) CCALLSFSUB3(CRIGHT,cright,PBYTE,INTV,INTV,A1,A2,A3)
-
-PROTOCCALLSFSUB3(CROSS,cross,FLOATV,FLOATV,PFLOAT)
-#define CROSS(A1,A2,A3) CCALLSFSUB3(CROSS,cross,FLOATV,FLOATV,PFLOAT,A1,A2,A3)
-
-PROTOCCALLSFSUB4(CSETDI,csetdi,INTV,PBYTE,INTV,INTV)
-#define CSETDI(A1,A2,A3,A4) CCALLSFSUB4(CSETDI,csetdi,INTV,PBYTE,INTV,INTV,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB4(CSETHI,csethi,INTV,PBYTE,INTV,INTV)
-#define CSETHI(A1,A2,A3,A4) CCALLSFSUB4(CSETHI,csethi,INTV,PBYTE,INTV,INTV,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB4(CSETOI,csetoi,INTV,PBYTE,INTV,INTV)
-#define CSETOI(A1,A2,A3,A4) CCALLSFSUB4(CSETOI,csetoi,INTV,PBYTE,INTV,INTV,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB8(CSETVI,csetvi,INTV,INTV,INTV,BYTE,INTV,INTV,INTV,INTV)
-#define CSETVI(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(CSETVI,csetvi,INTV,INTV,INTV,BYTE,INTV,INTV,INTV,INTV,A1,A2,A3,A4,A5,A6,A7,A8)
-
-PROTOCCALLSFSUB8(CSETVM,csetvm,INTV,INTV,INTV,BYTE,INTV,INTV,INTV,INTV)
-#define CSETVM(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(CSETVM,csetvm,INTV,INTV,INTV,BYTE,INTV,INTV,INTV,INTV,A1,A2,A3,A4,A5,A6,A7,A8)
-
-PROTOCCALLSFSUB3(CSQMBL,csqmbl,PBYTE,INTV,INTV)
-#define CSQMBL(A1,A2,A3) CCALLSFSUB3(CSQMBL,csqmbl,PBYTE,INTV,INTV,A1,A2,A3)
-
-PROTOCCALLSFSUB4(CSQMCH,csqmch,STRING,PBYTE,INTV,INTV)
-#define CSQMCH(A1,A2,A3,A4) CCALLSFSUB4(CSQMCH,csqmch,STRING,PBYTE,INTV,INTV,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB5(CTRANS,ctrans,STRING,STRING,STRING,INT,INT)
-#define CTRANS(A1,A2,A3,A4,A5) CCALLSFSUB5(CTRANS,ctrans,STRING,STRING,STRING,INT,INT,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB1(CUTOL,cutol,PBYTE)
-#define CUTOL(A1) CCALLSFSUB1(CUTOL,cutol,PBYTE,A1)
-
-PROTOCCALLSFSUB2(DATIME,datime,PINT,PINT)
-#define DATIME(A1,A2) CCALLSFSUB2(DATIME,datime,PINT,PINT,A1,A2)
-
-PROTOCCALLSFSUB2(DATIMH,datimh,INTV,INTV)
-#define DATIMH(A1,A2) CCALLSFSUB2(DATIMH,datimh,INTV,INTV,A1,A2)
-
-PROTOCCALLSFSUB4(FFSIZE,ffsize,INT,INT,PINT,PINT)
-#define FFSIZE(A1,A2,A3,A4) CCALLSFSUB4(FFSIZE,ffsize,INT,INT,PINT,PINT,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB2(FLPSOR,flpsor,PFLOAT,INT)
-#define FLPSOR(A1,A2) CCALLSFSUB2(FLPSOR,flpsor,PFLOAT,INT,A1,A2)
-
-PROTOCCALLSFSUB2(GETENVF,getenvf,STRING,STRING)
-#define GETENVF(A1,A2) CCALLSFSUB2(GETENVF,getenvf,STRING,STRING,A1,A2)
-
-PROTOCCALLSFSUB1(GETWDF,getwdf,BYTE)
-#define GETWDF(A1) CCALLSFSUB1(GETWDF,getwdf,BYTE,A1)
-
-PROTOCCALLSFSUB1(GSHOW,gshow,INT)
-#define GSHOW(A1) CCALLSFSUB1(GSHOW,gshow,INT,A1)
-
-PROTOCCALLSFSUB1(GSHOWF,gshowf,INT)
-#define GSHOWF(A1) CCALLSFSUB1(GSHOWF,gshowf,INT,A1)
-
-PROTOCCALLSFSUB4(IE3FOD,ie3fod,INTV,INTV,INT,PINT)
-#define IE3FOD(A1,A2,A3,A4) CCALLSFSUB4(IE3FOD,ie3fod,INTV,INTV,INT,PINT,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB4(IE3FOS,ie3fos,INTV,INTV,INT,PINT)
-#define IE3FOS(A1,A2,A3,A4) CCALLSFSUB4(IE3FOS,ie3fos,INTV,INTV,INT,PINT,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB4(IE3TOD,ie3tod,INTV,INTV,INT,PINT)
-#define IE3TOD(A1,A2,A3,A4) CCALLSFSUB4(IE3TOD,ie3tod,INTV,INTV,INT,PINT,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB4(IE3TOS,ie3tos,INTV,INTV,INT,PINT)
-#define IE3TOS(A1,A2,A3,A4) CCALLSFSUB4(IE3TOS,ie3tos,INTV,INTV,INT,PINT,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB2(INTSOR,intsor,PINT,INT)
-#define INTSOR(A1,A2) CCALLSFSUB2(INTSOR,intsor,PINT,INT,A1,A2)
-
-PROTOCCALLSFSUB2(ITOCH,itoch,INT,FLOAT)
-#define ITOCH(A1,A2) CCALLSFSUB2(ITOCH,itoch,INT,FLOAT,A1,A2)
-
-PROTOCCALLSFSUB1(JOBNAM,jobnam,PINT)
-#define JOBNAM(A1) CCALLSFSUB1(JOBNAM,jobnam,PINT,A1)
-
-PROTOCCALLSFSUB2(JUMPX2,jumpx2,INTV,INTV)
-#define JUMPX2(A1,A2) CCALLSFSUB2(JUMPX2,jumpx2,INTV,INTV,A1,A2)
-
-PROTOCCALLSFSUB3(JUMPY2,jumpy2,FLOAT,INTV,INTV)
-#define JUMPY2(A1,A2,A3) CCALLSFSUB3(JUMPY2,jumpy2,FLOAT,INTV,INTV,A1,A2,A3)
-
-PROTOCCALLSFSUB1(KERNGT,kerngt,INT)
-#define KERNGT(A1) CCALLSFSUB1(KERNGT,kerngt,INT,A1)
-
-PROTOCCALLSFSUB3(LOREN4,loren4,FLOATV,FLOATV,PFLOAT)
-#define LOREN4(A1,A2,A3) CCALLSFSUB3(LOREN4,loren4,FLOATV,FLOATV,PFLOAT,A1,A2,A3)
-
-PROTOCCALLSFSUB4(LORENB,lorenb,FLOAT,FLOATV,FLOATV,PFLOAT)
-#define LORENB(A1,A2,A3,A4) CCALLSFSUB4(LORENB,lorenb,FLOAT,FLOATV,FLOATV,PFLOAT,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB4(LORENF,lorenf,FLOAT,FLOATV,FLOATV,PFLOAT)
-#define LORENF(A1,A2,A3,A4) CCALLSFSUB4(LORENF,lorenf,FLOAT,FLOATV,FLOATV,PFLOAT,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB8(MATIN1,matin1,PFLOAT,INT,INT,INT,INT,PINT,PINT,PFLOAT)
-#define MATIN1(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(MATIN1,matin1,PFLOAT,INT,INT,INT,INT,PINT,PINT,PFLOAT,A1,A2,A3,A4,A5,A6,A7,A8)
-
-PROTOCCALLSFSUB5(MVBITS,mvbits,INT,INT,INT,PINT,INT)
-#define MVBITS(A1,A2,A3,A4,A5) CCALLSFSUB5(MVBITS,mvbits,INT,INT,INT,PINT,INT,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB4(MXEQU,mxequ,PFLOAT,FLOATV,INT,INT)
-#define MXEQU(A1,A2,A3,A4) CCALLSFSUB4(MXEQU,mxequ,PFLOAT,FLOATV,INT,INT,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB6(MXMAD,mxmad,FLOATV,FLOATV,FLOATV,INT,INT,INT)
-#define MXMAD(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(MXMAD,mxmad,FLOATV,FLOATV,FLOATV,INT,INT,INT,A1,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFSUB5(MXMLRT,mxmlrt,FLOATV,FLOATV,FLOATV,INT,INT)
-#define MXMLRT(A1,A2,A3,A4,A5) CCALLSFSUB5(MXMLRT,mxmlrt,FLOATV,FLOATV,FLOATV,INT,INT,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB4(MXTRP,mxtrp,FLOATV,PFLOAT,INT,INT)
-#define MXTRP(A1,A2,A3,A4) CCALLSFSUB4(MXTRP,mxtrp,FLOATV,PFLOAT,INT,INT,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB2(MXUTY,mxuty,PFLOAT,INT)
-#define MXUTY(A1,A2) CCALLSFSUB2(MXUTY,mxuty,PFLOAT,INT,A1,A2)
-
-PROTOCCALLSFSUB1(NOARG,noarg,INT)
-#define NOARG(A1) CCALLSFSUB1(NOARG,noarg,INT,A1)
-
-PROTOCCALLSFSUB1(PERRORF,perrorf,BYTE)
-#define PERRORF(A1) CCALLSFSUB1(PERRORF,perrorf,BYTE,A1)
-
-PROTOCCALLSFSUB5(PKBYT,pkbyt,INTV,PINT,INTV,INTV,INTV)
-#define PKBYT(A1,A2,A3,A4,A5) CCALLSFSUB5(PKBYT,pkbyt,INTV,PINT,INTV,INTV,INTV,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB4(PKCHAR,pkchar,INTV,PINT,INT,INTV)
-#define PKCHAR(A1,A2,A3,A4) CCALLSFSUB4(PKCHAR,pkchar,INTV,PINT,INT,INTV,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB3(POWEZE,poweze,FLOAT,PFLOAT,INT)
-#define POWEZE(A1,A2,A3) CCALLSFSUB3(POWEZE,poweze,FLOAT,PFLOAT,INT,A1,A2,A3)
-
-PROTOCCALLSFSUB4(RANECQ,ranecq,PINT,PINT,INT,STRING)
-#define RANECQ(A1,A2,A3,A4) CCALLSFSUB4(RANECQ,ranecq,PINT,PINT,INT,STRING,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB3(RANECU,ranecu,PFLOAT,INT,INT)
-#define RANECU(A1,A2,A3) CCALLSFSUB3(RANECU,ranecu,PFLOAT,INT,INT,A1,A2,A3)
-
-PROTOCCALLSFSUB2(RANMAR,ranmar,PFLOAT,INT)
-#define RANMAR(A1,A2) CCALLSFSUB2(RANMAR,ranmar,PFLOAT,INT,A1,A2)
-
-PROTOCCALLSFSUB2(RANNOR,rannor,PFLOAT,PFLOAT)
-#define RANNOR(A1,A2) CCALLSFSUB2(RANNOR,rannor,PFLOAT,PFLOAT,A1,A2)
-
-PROTOCCALLSFSUB3(RMMAQ,rmmaq,PINT,PINT,BYTE)
-#define RMMAQ(A1,A2,A3) CCALLSFSUB3(RMMAQ,rmmaq,PINT,PINT,BYTE,A1,A2,A3)
-
-PROTOCCALLSFSUB3(RMMAR,rmmar,PFLOAT,INT,INT)
-#define RMMAR(A1,A2,A3) CCALLSFSUB3(RMMAR,rmmar,PFLOAT,INT,INT,A1,A2,A3)
-
-PROTOCCALLSFSUB3(ROT,rot,FLOATV,FLOAT,PFLOAT)
-#define ROT(A1,A2,A3) CCALLSFSUB3(ROT,rot,FLOATV,FLOAT,PFLOAT,A1,A2,A3)
-
-PROTOCCALLSFSUB3(SBIT,sbit,INT,PINT,INT)
-#define SBIT(A1,A2,A3) CCALLSFSUB3(SBIT,sbit,INT,PINT,INT,A1,A2,A3)
-
-PROTOCCALLSFSUB2(SBIT0,sbit0,PINT,INT)
-#define SBIT0(A1,A2) CCALLSFSUB2(SBIT0,sbit0,PINT,INT,A1,A2)
-
-PROTOCCALLSFSUB2(SBIT1,sbit1,PINT,INT)
-#define SBIT1(A1,A2) CCALLSFSUB2(SBIT1,sbit1,PINT,INT,A1,A2)
-
-PROTOCCALLSFSUB4(SBYT,sbyt,INT,PINT,INT,INT)
-#define SBYT(A1,A2,A3,A4) CCALLSFSUB4(SBYT,sbyt,INT,PINT,INT,INT,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB4(SBYTOR,sbytor,INT,PINT,INT,INT)
-#define SBYTOR(A1,A2,A3,A4) CCALLSFSUB4(SBYTOR,sbytor,INT,PINT,INT,INT,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB4(SBYTPK,sbytpk,INT,FLOATV,INT,INTV)
-#define SBYTPK(A1,A2,A3,A4) CCALLSFSUB4(SBYTPK,sbytpk,INT,FLOATV,INT,INTV,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB5(SETFMT,setfmt,PINT,PINT,INT,FLOATV,INT)
-#define SETFMT(A1,A2,A3,A4,A5) CCALLSFSUB5(SETFMT,setfmt,PINT,PINT,INT,FLOATV,INT,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB3(SMXINV,smxinv,PFLOAT,INT,PINT)
-#define SMXINV(A1,A2,A3) CCALLSFSUB3(SMXINV,smxinv,PFLOAT,INT,PINT,A1,A2,A3)
-
-PROTOCCALLSFSUB5(SORCHA,sorcha,PSTRINGV,INT,INT,INT,INT)
-#define SORCHA(A1,A2,A3,A4,A5) CCALLSFSUB5(SORCHA,sorcha,PSTRINGV,INT,INT,INT,INT,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB4(SORTD,sortd,PDOUBLE,INT,INT,INT)
-#define SORTD(A1,A2,A3,A4) CCALLSFSUB4(SORTD,sortd,PDOUBLE,INT,INT,INT,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB4(SORTI,sorti,PINT,INT,INT,INT)
-#define SORTI(A1,A2,A3,A4) CCALLSFSUB4(SORTI,sorti,PINT,INT,INT,INT,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB4(SORTR,sortr,PFLOAT,INT,INT,INT)
-#define SORTR(A1,A2,A3,A4) CCALLSFSUB4(SORTR,sortr,PFLOAT,INT,INT,INT,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB3(SORTTC,sorttc,INTV,PINT,INT)
-#define SORTTC(A1,A2,A3) CCALLSFSUB3(SORTTC,sorttc,INTV,PINT,INT,A1,A2,A3)
-
-PROTOCCALLSFSUB3(SORTTF,sorttf,FLOATV,PINT,INT)
-#define SORTTF(A1,A2,A3) CCALLSFSUB3(SORTTF,sorttf,FLOATV,PINT,INT,A1,A2,A3)
-
-PROTOCCALLSFSUB3(SORTTI,sortti,INTV,PINT,INT)
-#define SORTTI(A1,A2,A3) CCALLSFSUB3(SORTTI,sortti,INTV,PINT,INT,A1,A2,A3)
-
-PROTOCCALLSFSUB5(SORTX,sortx,PINT,INT,INT,INT,PINT)
-#define SORTX(A1,A2,A3,A4,A5) CCALLSFSUB5(SORTX,sortx,PINT,INT,INT,INT,PINT,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB6(SORTZV,sortzv,FLOATV,PINT,INT,INT,INT,INT)
-#define SORTZV(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(SORTZV,sortzv,FLOATV,PINT,INT,INT,INT,INT,A1,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFSUB4(TCDUMP,tcdump,INT,INTV,INT,INT)
-#define TCDUMP(A1,A2,A3,A4) CCALLSFSUB4(TCDUMP,tcdump,INT,INTV,INT,INT,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB4(TLERR,tlerr,PFLOAT,PFLOAT,PFLOAT,PINT)
-#define TLERR(A1,A2,A3,A4) CCALLSFSUB4(TLERR,tlerr,PFLOAT,PFLOAT,PFLOAT,PINT,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB7(TLPIV,tlpiv,FLOATV,FLOATV,INT,INT,INT,PFLOAT,PFLOAT)
-#define TLPIV(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(TLPIV,tlpiv,FLOATV,FLOATV,INT,INT,INT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5,A6,A7)
-
-PROTOCCALLSFSUB3(TLRES,tlres,FLOATV,PFLOAT,FLOATV)
-#define TLRES(A1,A2,A3) CCALLSFSUB3(TLRES,tlres,FLOATV,PFLOAT,FLOATV,A1,A2,A3)
-
-PROTOCCALLSFSUB6(TLS,tls,FLOATV,FLOATV,PFLOAT,PINT,FLOAT,PFLOAT)
-#define TLS(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(TLS,tls,FLOATV,FLOATV,PFLOAT,PINT,FLOAT,PFLOAT,A1,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFSUB6(TLSC,tlsc,PFLOAT,PFLOAT,PFLOAT,PINT,FLOAT,PFLOAT)
-#define TLSC(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(TLSC,tlsc,PFLOAT,PFLOAT,PFLOAT,PINT,FLOAT,PFLOAT,A1,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFSUB4(TLSMSQ,tlsmsq,FLOATV,INT,INT,PFLOAT)
-#define TLSMSQ(A1,A2,A3,A4) CCALLSFSUB4(TLSMSQ,tlsmsq,FLOATV,INT,INT,PFLOAT,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB7(TLSTEP,tlstep,FLOATV,PFLOAT,INT,INT,INT,INT,FLOAT)
-#define TLSTEP(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(TLSTEP,tlstep,FLOATV,PFLOAT,INT,INT,INT,INT,FLOAT,A1,A2,A3,A4,A5,A6,A7)
-
-PROTOCCALLSFSUB4(TLSWOP,tlswop,PFLOAT,PFLOAT,INT,INT)
-#define TLSWOP(A1,A2,A3,A4) CCALLSFSUB4(TLSWOP,tlswop,PFLOAT,PFLOAT,INT,INT,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB5(TLUK,tluk,PFLOAT,INT,PINT,PFLOAT,PFLOAT)
-#define TLUK(A1,A2,A3,A4,A5) CCALLSFSUB5(TLUK,tluk,PFLOAT,INT,PINT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB1(TMPRO,tmpro,BYTE)
-#define TMPRO(A1) CCALLSFSUB1(TMPRO,tmpro,BYTE,A1)
-
-PROTOCCALLSFSUB2(TOSLAT,toslat,INT,INT)
-#define TOSLAT(A1,A2) CCALLSFSUB2(TOSLAT,toslat,INT,INT,A1,A2)
-
-PROTOCCALLSFSUB4(TRAAT,traat,FLOATV,PFLOAT,INT,INT)
-#define TRAAT(A1,A2,A3,A4) CCALLSFSUB4(TRAAT,traat,FLOATV,PFLOAT,INT,INT,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB2(TRACEQ,traceq,INT,INT)
-#define TRACEQ(A1,A2) CCALLSFSUB2(TRACEQ,traceq,INT,INT,A1,A2)
-
-PROTOCCALLSFSUB5(TRAL,tral,FLOATV,FLOATV,PFLOAT,INT,INT)
-#define TRAL(A1,A2,A3,A4,A5) CCALLSFSUB5(TRAL,tral,FLOATV,FLOATV,PFLOAT,INT,INT,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB5(TRALT,tralt,FLOATV,FLOATV,PFLOAT,INT,INT)
-#define TRALT(A1,A2,A3,A4,A5) CCALLSFSUB5(TRALT,tralt,FLOATV,FLOATV,PFLOAT,INT,INT,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB5(TRAS,tras,FLOATV,FLOATV,PFLOAT,INT,INT)
-#define TRAS(A1,A2,A3,A4,A5) CCALLSFSUB5(TRAS,tras,FLOATV,FLOATV,PFLOAT,INT,INT,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB5(TRASAT,trasat,FLOATV,FLOATV,PFLOAT,INT,INT)
-#define TRASAT(A1,A2,A3,A4,A5) CCALLSFSUB5(TRASAT,trasat,FLOATV,FLOATV,PFLOAT,INT,INT,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB4(TRATA,trata,FLOATV,PFLOAT,INT,INT)
-#define TRATA(A1,A2,A3,A4) CCALLSFSUB4(TRATA,trata,FLOATV,PFLOAT,INT,INT,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB5(TRATS,trats,FLOATV,FLOATV,PFLOAT,INT,INT)
-#define TRATS(A1,A2,A3,A4,A5) CCALLSFSUB5(TRATS,trats,FLOATV,FLOATV,PFLOAT,INT,INT,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB5(TRATSA,tratsa,FLOATV,FLOATV,PFLOAT,INT,INT)
-#define TRATSA(A1,A2,A3,A4,A5) CCALLSFSUB5(TRATSA,tratsa,FLOATV,FLOATV,PFLOAT,INT,INT,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB3(TRCHLU,trchlu,FLOATV,PFLOAT,INT)
-#define TRCHLU(A1,A2,A3) CCALLSFSUB3(TRCHLU,trchlu,FLOATV,PFLOAT,INT,A1,A2,A3)
-
-PROTOCCALLSFSUB3(TRCHUL,trchul,FLOATV,PFLOAT,INT)
-#define TRCHUL(A1,A2,A3) CCALLSFSUB3(TRCHUL,trchul,FLOATV,PFLOAT,INT,A1,A2,A3)
-
-PROTOCCALLSFSUB3(TRINV,trinv,FLOATV,PFLOAT,INT)
-#define TRINV(A1,A2,A3) CCALLSFSUB3(TRINV,trinv,FLOATV,PFLOAT,INT,A1,A2,A3)
-
-PROTOCCALLSFSUB5(TRLA,trla,FLOATV,FLOATV,PFLOAT,INT,INT)
-#define TRLA(A1,A2,A3,A4,A5) CCALLSFSUB5(TRLA,trla,FLOATV,FLOATV,PFLOAT,INT,INT,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB5(TRLTA,trlta,FLOATV,FLOATV,PFLOAT,INT,INT)
-#define TRLTA(A1,A2,A3,A4,A5) CCALLSFSUB5(TRLTA,trlta,FLOATV,FLOATV,PFLOAT,INT,INT,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB3(TRPCK,trpck,FLOATV,PFLOAT,INT)
-#define TRPCK(A1,A2,A3) CCALLSFSUB3(TRPCK,trpck,FLOATV,PFLOAT,INT,A1,A2,A3)
-
-PROTOCCALLSFSUB4(TRQSQ,trqsq,FLOATV,FLOATV,PFLOAT,INT)
-#define TRQSQ(A1,A2,A3,A4) CCALLSFSUB4(TRQSQ,trqsq,FLOATV,FLOATV,PFLOAT,INT,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB5(TRSA,trsa,FLOATV,FLOATV,PFLOAT,INT,INT)
-#define TRSA(A1,A2,A3,A4,A5) CCALLSFSUB5(TRSA,trsa,FLOATV,FLOATV,PFLOAT,INT,INT,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB5(TRSAT,trsat,FLOATV,FLOATV,PFLOAT,INT,INT)
-#define TRSAT(A1,A2,A3,A4,A5) CCALLSFSUB5(TRSAT,trsat,FLOATV,FLOATV,PFLOAT,INT,INT,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB3(TRSINV,trsinv,FLOATV,FLOATV,INT)
-#define TRSINV(A1,A2,A3) CCALLSFSUB3(TRSINV,trsinv,FLOATV,FLOATV,INT,A1,A2,A3)
-
-PROTOCCALLSFSUB3(TRSMLU,trsmlu,FLOATV,PFLOAT,INT)
-#define TRSMLU(A1,A2,A3) CCALLSFSUB3(TRSMLU,trsmlu,FLOATV,PFLOAT,INT,A1,A2,A3)
-
-PROTOCCALLSFSUB3(TRSMUL,trsmul,FLOATV,PFLOAT,INT)
-#define TRSMUL(A1,A2,A3) CCALLSFSUB3(TRSMUL,trsmul,FLOATV,PFLOAT,INT,A1,A2,A3)
-
-PROTOCCALLSFSUB3(TRUPCK,trupck,FLOATV,PFLOAT,INT)
-#define TRUPCK(A1,A2,A3) CCALLSFSUB3(TRUPCK,trupck,FLOATV,PFLOAT,INT,A1,A2,A3)
-
-PROTOCCALLSFSUB4(UBITS,ubits,INTV,INT,PINT,PINT)
-#define UBITS(A1,A2,A3,A4) CCALLSFSUB4(UBITS,ubits,INTV,INT,PINT,PINT,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB3(UBLANK,ublank,PINT,INT,INT)
-#define UBLANK(A1,A2,A3) CCALLSFSUB3(UBLANK,ublank,PINT,INT,INT,A1,A2,A3)
-
-PROTOCCALLSFSUB3(UBLOW,ublow,INTV,PINT,INTV)
-#define UBLOW(A1,A2,A3) CCALLSFSUB3(UBLOW,ublow,INTV,PINT,INTV,A1,A2,A3)
-
-PROTOCCALLSFSUB3(UBUNCH,ubunch,INTV,PINT,INTV)
-#define UBUNCH(A1,A2,A3) CCALLSFSUB3(UBUNCH,ubunch,INTV,PINT,INTV,A1,A2,A3)
-
-PROTOCCALLSFSUB6(UCOCOP,ucocop,FLOATV,PFLOAT,INT,INT,INT,INT)
-#define UCOCOP(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(UCOCOP,ucocop,FLOATV,PFLOAT,INT,INT,INT,INT,A1,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFSUB3(UCOPIV,ucopiv,FLOATV,PFLOAT,INT)
-#define UCOPIV(A1,A2,A3) CCALLSFSUB3(UCOPIV,ucopiv,FLOATV,PFLOAT,INT,A1,A2,A3)
-
-PROTOCCALLSFSUB3(UCOPY,ucopy,FLOATV,PFLOAT,INT)
-#define UCOPY(A1,A2,A3) CCALLSFSUB3(UCOPY,ucopy,FLOATV,PFLOAT,INT,A1,A2,A3)
-
-PROTOCCALLSFSUB3(UCOPY2,ucopy2,FLOATV,PFLOAT,INT)
-#define UCOPY2(A1,A2,A3) CCALLSFSUB3(UCOPY2,ucopy2,FLOATV,PFLOAT,INT,A1,A2,A3)
-
-PROTOCCALLSFSUB3(UCOPYN,ucopyn,INTV,PINT,INT)
-#define UCOPYN(A1,A2,A3) CCALLSFSUB3(UCOPYN,ucopyn,INTV,PINT,INT,A1,A2,A3)
-
-PROTOCCALLSFSUB4(UCTOH,uctoh,BYTE,PINT,INT,INT)
-#define UCTOH(A1,A2,A3,A4) CCALLSFSUB4(UCTOH,uctoh,BYTE,PINT,INT,INT,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB3(UCTOH1,uctoh1,BYTE,PINT,INT)
-#define UCTOH1(A1,A2,A3) CCALLSFSUB3(UCTOH1,uctoh1,BYTE,PINT,INT,A1,A2,A3)
-
-PROTOCCALLSFSUB6(UDICOP,udicop,FLOATV,PFLOAT,INT,INT,INT,INT)
-#define UDICOP(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(UDICOP,udicop,FLOATV,PFLOAT,INT,INT,INT,INT,A1,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFSUB4(UFILL,ufill,PINT,INT,INT,INT)
-#define UFILL(A1,A2,A3,A4) CCALLSFSUB4(UFILL,ufill,PINT,INT,INT,INT,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB3(UFLINT,uflint,PFLOAT,INTV,INTV)
-#define UFLINT(A1,A2,A3) CCALLSFSUB3(UFLINT,uflint,PFLOAT,INTV,INTV,A1,A2,A3)
-
-PROTOCCALLSFSUB3(UH1TOC,uh1toc,INTV,PBYTE,INT)
-#define UH1TOC(A1,A2,A3) CCALLSFSUB3(UH1TOC,uh1toc,INTV,PBYTE,INT,A1,A2,A3)
-
-PROTOCCALLSFSUB3(UHOLLR,uhollr,FLOATV,INT,FLOATV)
-#define UHOLLR(A1,A2,A3) CCALLSFSUB3(UHOLLR,uhollr,FLOATV,INT,FLOATV,A1,A2,A3)
-
-PROTOCCALLSFSUB4(UHTOC,uhtoc,INTV,INT,PBYTE,INT)
-#define UHTOC(A1,A2,A3,A4) CCALLSFSUB4(UHTOC,uhtoc,INTV,INT,PBYTE,INT,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB3(ULEFT,uleft,PINT,INT,INT)
-#define ULEFT(A1,A2,A3) CCALLSFSUB3(ULEFT,uleft,PINT,INT,INT,A1,A2,A3)
-
-PROTOCCALLSFSUB4(UOPT,uopt,FLOATV,FLOATV,PINT,INT)
-#define UOPT(A1,A2,A3,A4) CCALLSFSUB4(UOPT,uopt,FLOATV,FLOATV,PINT,INT,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB3(UOPTC,uoptc,STRING,STRING,PINT)
-#define UOPTC(A1,A2,A3) CCALLSFSUB3(UOPTC,uoptc,STRING,STRING,PINT,A1,A2,A3)
-
-PROTOCCALLSFSUB5(UPKBYT,upkbyt,INTV,INTV,PINT,INTV,INTV)
-#define UPKBYT(A1,A2,A3,A4,A5) CCALLSFSUB5(UPKBYT,upkbyt,INTV,INTV,PINT,INTV,INTV,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB4(UPKCH,upkch,INTV,PINT,INT,INTV)
-#define UPKCH(A1,A2,A3,A4) CCALLSFSUB4(UPKCH,upkch,INTV,PINT,INT,INTV,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB3(URIGHT,uright,PINT,INT,INT)
-#define URIGHT(A1,A2,A3) CCALLSFSUB3(URIGHT,uright,PINT,INT,INT,A1,A2,A3)
-
-PROTOCCALLSFSUB4(USET,uset,INT,PINT,INT,INT)
-#define USET(A1,A2,A3,A4) CCALLSFSUB4(USET,uset,INT,PINT,INT,INT,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB3(USWOP,uswop,PFLOAT,PFLOAT,INT)
-#define USWOP(A1,A2,A3) CCALLSFSUB3(USWOP,uswop,PFLOAT,PFLOAT,INT,A1,A2,A3)
-
-PROTOCCALLSFSUB5(UTRANS,utrans,FLOATV,FLOATV,INTV,INTV,INTV)
-#define UTRANS(A1,A2,A3,A4,A5) CCALLSFSUB5(UTRANS,utrans,FLOATV,FLOATV,INTV,INTV,INTV,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB3(UZERO,uzero,PINT,INT,INT)
-#define UZERO(A1,A2,A3) CCALLSFSUB3(UZERO,uzero,PINT,INT,INT,A1,A2,A3)
-
-PROTOCCALLSFSUB4(VADD,vadd,FLOATV,FLOATV,PFLOAT,INT)
-#define VADD(A1,A2,A3,A4) CCALLSFSUB4(VADD,vadd,FLOATV,FLOATV,PFLOAT,INT,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB4(VBIAS,vbias,FLOATV,FLOAT,PFLOAT,INT)
-#define VBIAS(A1,A2,A3,A4) CCALLSFSUB4(VBIAS,vbias,FLOATV,FLOAT,PFLOAT,INT,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB2(VBLANK,vblank,PINT,INT)
-#define VBLANK(A1,A2) CCALLSFSUB2(VBLANK,vblank,PINT,INT,A1,A2)
-
-PROTOCCALLSFSUB3(VCOPYN,vcopyn,FLOATV,PFLOAT,INT)
-#define VCOPYN(A1,A2,A3) CCALLSFSUB3(VCOPYN,vcopyn,FLOATV,PFLOAT,INT,A1,A2,A3)
-
-PROTOCCALLSFSUB3(VEXCUM,vexcum,FLOATV,PFLOAT,INT)
-#define VEXCUM(A1,A2,A3) CCALLSFSUB3(VEXCUM,vexcum,FLOATV,PFLOAT,INT,A1,A2,A3)
-
-PROTOCCALLSFSUB3(VFILL,vfill,PFLOAT,INT,FLOAT)
-#define VFILL(A1,A2,A3) CCALLSFSUB3(VFILL,vfill,PFLOAT,INT,FLOAT,A1,A2,A3)
-
-PROTOCCALLSFSUB3(VFIX,vfix,FLOATV,PINT,INT)
-#define VFIX(A1,A2,A3) CCALLSFSUB3(VFIX,vfix,FLOATV,PINT,INT,A1,A2,A3)
-
-PROTOCCALLSFSUB3(VFLOAT,vfloat,INTV,PFLOAT,INT)
-#define VFLOAT(A1,A2,A3) CCALLSFSUB3(VFLOAT,vfloat,INTV,PFLOAT,INT,A1,A2,A3)
-
-PROTOCCALLSFSUB2(VIZPRI,vizpri,INT,BYTE)
-#define VIZPRI(A1,A2) CCALLSFSUB2(VIZPRI,vizpri,INT,BYTE,A1,A2)
-
-PROTOCCALLSFSUB6(VLINCO,vlinco,FLOATV,FLOAT,FLOATV,FLOAT,PFLOAT,INT)
-#define VLINCO(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(VLINCO,vlinco,FLOATV,FLOAT,FLOATV,FLOAT,PFLOAT,INT,A1,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFSUB6(VLINE,vline,FLOATV,FLOAT,FLOATV,FLOAT,PFLOAT,INT)
-#define VLINE(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(VLINE,vline,FLOATV,FLOAT,FLOATV,FLOAT,PFLOAT,INT,A1,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFSUB5(VMATL,vmatl,PFLOAT,FLOATV,PFLOAT,INT,INT)
-#define VMATL(A1,A2,A3,A4,A5) CCALLSFSUB5(VMATL,vmatl,PFLOAT,FLOATV,PFLOAT,INT,INT,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB5(VMATR,vmatr,FLOATV,PFLOAT,PFLOAT,INT,INT)
-#define VMATR(A1,A2,A3,A4,A5) CCALLSFSUB5(VMATR,vmatr,FLOATV,PFLOAT,PFLOAT,INT,INT,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB4(VMUL,vmul,FLOATV,FLOATV,PFLOAT,INT)
-#define VMUL(A1,A2,A3,A4) CCALLSFSUB4(VMUL,vmul,FLOATV,FLOATV,PFLOAT,INT,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB4(VSCALE,vscale,FLOATV,FLOAT,PFLOAT,INT)
-#define VSCALE(A1,A2,A3,A4) CCALLSFSUB4(VSCALE,vscale,FLOATV,FLOAT,PFLOAT,INT,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB4(VSUB,vsub,FLOATV,FLOATV,PFLOAT,INT)
-#define VSUB(A1,A2,A3,A4) CCALLSFSUB4(VSUB,vsub,FLOATV,FLOATV,PFLOAT,INT,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB3(VUNIT,vunit,FLOATV,PFLOAT,INT)
-#define VUNIT(A1,A2,A3) CCALLSFSUB3(VUNIT,vunit,FLOATV,PFLOAT,INT,A1,A2,A3)
-
-PROTOCCALLSFSUB2(VZERO,vzero,PINT,INT)
-#define VZERO(A1,A2) CCALLSFSUB2(VZERO,vzero,PINT,INT,A1,A2)
-
-PROTOCCALLSFSUB3(XINB,xinb,INT,FLOATV,PINT)
-#define XINB(A1,A2,A3) CCALLSFSUB3(XINB,xinb,INT,FLOATV,PINT,A1,A2,A3)
-
-PROTOCCALLSFSUB3(XINBF,xinbf,INT,FLOATV,PINT)
-#define XINBF(A1,A2,A3) CCALLSFSUB3(XINBF,xinbf,INT,FLOATV,PINT,A1,A2,A3)
-
-PROTOCCALLSFSUB5(XINBS,xinbs,INT,FLOATV,INT,FLOATV,PINT)
-#define XINBS(A1,A2,A3,A4,A5) CCALLSFSUB5(XINBS,xinbs,INT,FLOATV,INT,FLOATV,PINT,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB3(XINCF,xincf,INT,FLOATV,PINT)
-#define XINCF(A1,A2,A3) CCALLSFSUB3(XINCF,xincf,INT,FLOATV,PINT,A1,A2,A3)
-
-PROTOCCALLSFSUB3(XOUTB,xoutb,INT,FLOATV,INT)
-#define XOUTB(A1,A2,A3) CCALLSFSUB3(XOUTB,xoutb,INT,FLOATV,INT,A1,A2,A3)
-
-PROTOCCALLSFSUB3(XOUTBF,xoutbf,INT,FLOATV,INT)
-#define XOUTBF(A1,A2,A3) CCALLSFSUB3(XOUTBF,xoutbf,INT,FLOATV,INT,A1,A2,A3)
-
-PROTOCCALLSFSUB5(XOUTBS,xoutbs,INT,FLOATV,INT,FLOATV,INT)
-#define XOUTBS(A1,A2,A3,A4,A5) CCALLSFSUB5(XOUTBS,xoutbs,INT,FLOATV,INT,FLOATV,INT,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB3(XOUTCF,xoutcf,INT,FLOATV,INT)
-#define XOUTCF(A1,A2,A3) CCALLSFSUB3(XOUTCF,xoutcf,INT,FLOATV,INT,A1,A2,A3)
-
-PROTOCCALLSFSUB7(BINSIZ,binsiz,FLOAT,FLOAT,INT,PFLOAT,PFLOAT,PINT,PFLOAT)
-#define BINSIZ(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(BINSIZ,binsiz,FLOAT,FLOAT,INT,PFLOAT,PFLOAT,PINT,PFLOAT,A1,A2,A3,A4,A5,A6,A7)
-
-PROTOCCALLSFSUB4(CALDAT,caldat,INT,PBYTE,PINT,PINT)
-#define CALDAT(A1,A2,A3,A4) CCALLSFSUB4(CALDAT,caldat,INT,PBYTE,PINT,PINT,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB4(CDMON,cdmon,INT,INT,PINT,PINT)
-#define CDMON(A1,A2,A3,A4) CCALLSFSUB4(CDMON,cdmon,INT,INT,PINT,PINT,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB4(CYDIY,cydiy,INT,PINT,PINT,PINT)
-#define CYDIY(A1,A2,A3,A4) CCALLSFSUB4(CYDIY,cydiy,INT,PINT,PINT,PINT,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB3(GETBIT,getbit,INT,INTV,PINT)
-#define GETBIT(A1,A2,A3) CCALLSFSUB3(GETBIT,getbit,INT,INTV,PINT,A1,A2,A3)
-
-PROTOCCALLSFSUB4(GETBYT,getbyt,INTV,INT,INT,PINT)
-#define GETBYT(A1,A2,A3,A4) CCALLSFSUB4(GETBYT,getbyt,INTV,INT,INT,PINT,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB0(INITC,initc)
-#define INITC() CCALLSFSUB0(INITC,initc)
-
-PROTOCCALLSFSUB7(NAMEFD,namefd,INT,STRING,PSTRINGV,INT,PSTRINGV,INT,PINT)
-#define NAMEFD(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(NAMEFD,namefd,INT,STRING,STRINGV,INT,PSTRINGV,INT,PINT,A1,A2,A3,A4,A5,A6,A7)
-
-PROTOCCALLSFSUB1(RDINT,rdint,PINT)
-#define RDINT(A1) CCALLSFSUB1(RDINT,rdint,PINT,A1)
-
-PROTOCCALLSFSUB1(RDLOAD,rdload,STRING)
-#define RDLOAD(A1) CCALLSFSUB1(RDLOAD,rdload,STRING,A1)
-
-PROTOCCALLSFSUB2(RDMANT,rdmant,INT,PINT)
-#define RDMANT(A1,A2) CCALLSFSUB2(RDMANT,rdmant,INT,PINT,A1,A2)
-
-PROTOCCALLSFSUB1(RDMODE,rdmode,INT)
-#define RDMODE(A1) CCALLSFSUB1(RDMODE,rdmode,INT,A1)
-
-PROTOCCALLSFSUB1(RDNAME,rdname,PSTRING)
-#define RDNAME(A1) CCALLSFSUB1(RDNAME,rdname,PSTRING,A1)
-
-PROTOCCALLSFSUB0(RDNEXT,rdnext)
-#define RDNEXT() CCALLSFSUB0(RDNEXT,rdnext)
-
-PROTOCCALLSFSUB0(RDSKIP,rdskip)
-#define RDSKIP() CCALLSFSUB0(RDSKIP,rdskip)
-
-PROTOCCALLSFSUB0(RDSKPB,rdskpb)
-#define RDSKPB() CCALLSFSUB0(RDSKPB,rdskpb)
-
-PROTOCCALLSFSUB1(RDUPST,rdupst,PSTRING)
-#define RDUPST(A1) CCALLSFSUB1(RDUPST,rdupst,PSTRING,A1)
-
-PROTOCCALLSFSUB4(RDWORD,rdword,PINT,PFLOAT,PSTRING,PINT)
-#define RDWORD(A1,A2,A3,A4) CCALLSFSUB4(RDWORD,rdword,PINT,PFLOAT,PSTRING,PINT,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB3(SETBIT,setbit,INT,INTV,INT)
-#define SETBIT(A1,A2,A3) CCALLSFSUB3(SETBIT,setbit,INT,INTV,INT,A1,A2,A3)
-
-PROTOCCALLSFSUB4(SETBYT,setbyt,INTV,INT,INT,INT)
-#define SETBYT(A1,A2,A3,A4) CCALLSFSUB4(SETBYT,setbyt,INTV,INT,INT,INT,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB3(UMCOM,umcom,STRING,STRING,STRING)
-#define UMCOM(A1,A2,A3) CCALLSFSUB3(UMCOM,umcom,STRING,STRING,STRING,A1,A2,A3)
-
-PROTOCCALLSFSUB2(WHICH,which,PINT,PINT)
-#define WHICH(A1,A2) CCALLSFSUB2(WHICH,which,PINT,PINT,A1,A2)
-
-PROTOCCALLSFSUB3(WHICHF,whichf,STRING,STRING,PSTRING)
-#define WHICHF(A1,A2,A3) CCALLSFSUB3(WHICHF,whichf,STRING,STRING,PSTRING,A1,A2,A3)
-
-PROTOCCALLSFSUB1(WORDSEP,wordsep,STRING)
-#define WORDSEP(A1) CCALLSFSUB1(WORDSEP,wordsep,STRING,A1)
diff --git a/src/cfortran/kuip.h b/src/cfortran/kuip.h
deleted file mode 100644
index 470e5cb..0000000
--- a/src/cfortran/kuip.h
+++ /dev/null
@@ -1,8 +0,0 @@
-PROTOCCALLSFSUB3(KUCLOS,kuclos,INT,STRING,INT)
-#define KUCLOS(A1,A2,A3) CCALLSFSUB3(KUCLOS,kuclos,INT,STRING,INT,A1,A2,A3)
-
-PROTOCCALLSFSUB4(KUOPEN,kuopen,INT,STRING,STRING,PINT)
-#define KUOPEN(A1,A2,A3,A4) CCALLSFSUB4(KUOPEN,kuopen,INT,STRING,STRING,PINT,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB0(KUWHAG,kuwhag)
-#define KUWHAG() CCALLSFSUB0(KUWHAG,kuwhag)
diff --git a/src/cfortran/lapack.h b/src/cfortran/lapack.h
deleted file mode 100644
index 4ab22a2..0000000
--- a/src/cfortran/lapack.h
+++ /dev/null
@@ -1,2 +0,0 @@
-PROTOCCALLSFSUB11(DGELS,dgels,STRING,INT,INT,INT,DOUBLEV,INT,DOUBLEV,INT,DOUBLEV,INT,PINT)
-#define DGELS(TRANS,M,N,NRHS,A,LDA,B,LDB,WORK,LWORK,INFO) CCALLSFSUB11(DGELS,dgels,STRING,INT,INT,INT,DOUBLEV,INT,DOUBLEV,INT,DOUBLEV,INT,PINT,TRANS,M,N,NRHS,A,LDA,B,LDB,WORK,LWORK,INFO)
diff --git a/src/cfortran/lepto62.h b/src/cfortran/lepto62.h
deleted file mode 100644
index e92e01d..0000000
--- a/src/cfortran/lepto62.h
+++ /dev/null
@@ -1,176 +0,0 @@
-PROTOCCALLSFFUN2(FLOAT,DCROSS,dcross,FLOAT,FLOAT)
-#define DCROSS(A2,A3) CCALLSFFUN2(DCROSS,dcross,FLOAT,FLOAT,A2,A3)
-
-PROTOCCALLSFFUN2(DOUBLE,DFUN,dfun,INT,DOUBLEV)
-#define DFUN(A2,A3) CCALLSFFUN2(DFUN,dfun,INT,DOUBLEV,A2,A3)
-
-PROTOCCALLSFFUN1(FLOAT,DLOWER,dlower,FLOAT)
-#define DLOWER(A2) CCALLSFFUN1(DLOWER,dlower,FLOAT,A2)
-
-PROTOCCALLSFFUN6(FLOAT,DQCD,dqcd,INT,INT,INT,FLOAT,FLOAT,FLOAT)
-#define DQCD(A2,A3,A4,A5,A6,A7) CCALLSFFUN6(DQCD,dqcd,INT,INT,INT,FLOAT,FLOAT,FLOAT,A2,A3,A4,A5,A6,A7)
-
-PROTOCCALLSFFUN5(FLOAT,DQCDI,dqcdi,INT,INT,FLOAT,FLOAT,FLOAT)
-#define DQCDI(A2,A3,A4,A5,A6) CCALLSFFUN5(DQCDI,dqcdi,INT,INT,FLOAT,FLOAT,FLOAT,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFFUN1(FLOAT,DSIGMA,dsigma,FLOAT)
-#define DSIGMA(A2) CCALLSFFUN1(DSIGMA,dsigma,FLOAT,A2)
-
-PROTOCCALLSFFUN1(FLOAT,DUPPER,dupper,FLOAT)
-#define DUPPER(A2) CCALLSFFUN1(DUPPER,dupper,FLOAT,A2)
-
-PROTOCCALLSFFUN1(FLOAT,FLGINT,flgint,FLOAT)
-#define FLGINT(A2) CCALLSFFUN1(FLGINT,flgint,FLOAT,A2)
-
-PROTOCCALLSFFUN1(FLOAT,FLQINT,flqint,FLOAT)
-#define FLQINT(A2) CCALLSFFUN1(FLQINT,flqint,FLOAT,A2)
-
-PROTOCCALLSFFUN1(FLOAT,FLTINT,fltint,FLOAT)
-#define FLTINT(A2) CCALLSFFUN1(FLTINT,fltint,FLOAT,A2)
-
-PROTOCCALLSFFUN5(FLOAT,GADAPF,gadapf,FLOAT,FLOAT,FLOAT,FLOAT,PFLOAT)
-#define GADAPF(A2,A3,A4,A5,A6) CCALLSFFUN5(GADAPF,gadapf,FLOAT,FLOAT,FLOAT,FLOAT,PFLOAT,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFFUN1(INT,LKINEM,lkinem,INT)
-#define LKINEM(A2) CCALLSFFUN1(LKINEM,lkinem,INT,A2)
-
-PROTOCCALLSFFUN2(FLOAT,LMPINT,lmpint,PFLOAT,INT)
-#define LMPINT(A2,A3) CCALLSFFUN2(LMPINT,lmpint,PFLOAT,INT,A2,A3)
-
-PROTOCCALLSFFUN5(INT,LQMCUT,lqmcut,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT)
-#define LQMCUT(A2,A3,A4,A5,A6) CCALLSFFUN5(LQMCUT,lqmcut,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFFUN1(DOUBLE,RIWFUN,riwfun,DOUBLEV)
-#define RIWFUN(A2) CCALLSFFUN1(RIWFUN,riwfun,DOUBLEV,A2)
-
-PROTOCCALLSFSUB0(DVNOPT,dvnopt)
-#define DVNOPT() CCALLSFSUB0(DVNOPT,dvnopt)
-
-PROTOCCALLSFSUB3(FLINTG,flintg,FLOAT,FLOAT,FLOAT)
-#define FLINTG(A1,A2,A3) CCALLSFSUB3(FLINTG,flintg,FLOAT,FLOAT,FLOAT,A1,A2,A3)
-
-PROTOCCALLSFSUB3(FLIPOL,flipol,PFLOAT,PFLOAT,PFLOAT)
-#define FLIPOL(A1,A2,A3) CCALLSFSUB3(FLIPOL,flipol,PFLOAT,PFLOAT,PFLOAT,A1,A2,A3)
-
-PROTOCCALLSFSUB0(FLTABL,fltabl)
-#define FLTABL() CCALLSFSUB0(FLTABL,fltabl)
-
-PROTOCCALLSFSUB5(GADAP,gadap,FLOAT,FLOAT,FLOAT,PFLOAT,PFLOAT)
-#define GADAP(A1,A2,A3,A4,A5) CCALLSFSUB5(GADAP,gadap,FLOAT,FLOAT,FLOAT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB7(GADAP2,gadap2,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,PFLOAT,PFLOAT)
-#define GADAP2(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(GADAP2,gadap2,FLOAT,FLOAT,FLOAT,FLOAT,FLOAT,PFLOAT,PFLOAT,A1,A2,A3,A4,A5,A6,A7)
-
-PROTOCCALLSFSUB2(LAZIMU,lazimu,FLOAT,FLOAT)
-#define LAZIMU(A1,A2) CCALLSFSUB2(LAZIMU,lazimu,FLOAT,FLOAT,A1,A2)
-
-PROTOCCALLSFSUB0(LEPTO,lepto)
-#define LEPTO() CCALLSFSUB0(LEPTO,lepto)
-
-PROTOCCALLSFSUB0(LEPTOX,leptox)
-#define LEPTOX() CCALLSFSUB0(LEPTOX,leptox)
-
-PROTOCCALLSFSUB2(LFLAV,lflav,PINT,PINT)
-#define LFLAV(A1,A2) CCALLSFSUB2(LFLAV,lflav,PINT,PINT,A1,A2)
-
-PROTOCCALLSFSUB2(LFRAME,lframe,INT,INT)
-#define LFRAME(A1,A2) CCALLSFSUB2(LFRAME,lframe,INT,INT,A1,A2)
-
-PROTOCCALLSFSUB5(LINIT,linit,INT,INT,FLOAT,FLOAT,INT)
-#define LINIT(A1,A2,A3,A4,A5) CCALLSFSUB5(LINIT,linit,INT,INT,FLOAT,FLOAT,INT,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB0(LMCMND,lmcmnd)
-#define LMCMND() CCALLSFSUB0(LMCMND,lmcmnd)
-
-PROTOCCALLSFSUB0(LMEPS,lmeps)
-#define LMEPS() CCALLSFSUB0(LMEPS,lmeps)
-
-PROTOCCALLSFSUB0(LMIDA2,lmida2)
-#define LMIDA2() CCALLSFSUB0(LMIDA2,lmida2)
-
-PROTOCCALLSFSUB0(LMIDAT,lmidat)
-#define LMIDAT() CCALLSFSUB0(LMIDAT,lmidat)
-
-PROTOCCALLSFSUB0(LMINEW,lminew)
-#define LMINEW() CCALLSFSUB0(LMINEW,lminew)
-
-PROTOCCALLSFSUB1(LMINTO,lminto,FLOATV)
-#define LMINTO(A1) CCALLSFSUB1(LMINTO,lminto,FLOATV,A1)
-
-PROTOCCALLSFSUB2(LMPRIN,lmprin,INT,FLOAT)
-#define LMPRIN(A1,A2) CCALLSFSUB2(LMPRIN,lmprin,INT,FLOAT,A1,A2)
-
-PROTOCCALLSFSUB2(LMRAZZ,lmrazz,FLOAT,FLOATV)
-#define LMRAZZ(A1,A2) CCALLSFSUB2(LMRAZZ,lmrazz,FLOAT,FLOATV,A1,A2)
-
-PROTOCCALLSFSUB0(LMSIMP,lmsimp)
-#define LMSIMP() CCALLSFSUB0(LMSIMP,lmsimp)
-
-PROTOCCALLSFSUB3(LNSTRF,lnstrf,FLOAT,FLOAT,PFLOAT)
-#define LNSTRF(A1,A2,A3) CCALLSFSUB3(LNSTRF,lnstrf,FLOAT,FLOAT,PFLOAT,A1,A2,A3)
-
-PROTOCCALLSFSUB3(LPRIKT,lprikt,FLOAT,PFLOAT,PFLOAT)
-#define LPRIKT(A1,A2,A3) CCALLSFSUB3(LPRIKT,lprikt,FLOAT,PFLOAT,PFLOAT,A1,A2,A3)
-
-PROTOCCALLSFSUB1(LPRWTS,lprwts,INT)
-#define LPRWTS(A1) CCALLSFSUB1(LPRWTS,lprwts,INT,A1)
-
-PROTOCCALLSFSUB2(LQCDPR,lqcdpr,PFLOAT,PFLOAT)
-#define LQCDPR(A1,A2) CCALLSFSUB2(LQCDPR,lqcdpr,PFLOAT,PFLOAT,A1,A2)
-
-PROTOCCALLSFSUB2(LQEVAR,lqevar,INT,INT)
-#define LQEVAR(A1,A2) CCALLSFSUB2(LQEVAR,lqevar,INT,INT,A1,A2)
-
-PROTOCCALLSFSUB0(LQEV,lqev)
-#define LQEV() CCALLSFSUB0(LQEV,lqev)
-
-PROTOCCALLSFSUB0(LQGEV,lqgev)
-#define LQGEV() CCALLSFSUB0(LQGEV,lqgev)
-
-PROTOCCALLSFSUB0(LQQBEV,lqqbev)
-#define LQQBEV() CCALLSFSUB0(LQQBEV,lqqbev)
-
-PROTOCCALLSFSUB5(LREMH,lremh,INT,FLOAT,PINT,INT,PFLOAT)
-#define LREMH(A1,A2,A3,A4,A5) CCALLSFSUB5(LREMH,lremh,INT,FLOAT,PINT,INT,PFLOAT,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB2(LSCALE,lscale,INT,PFLOAT)
-#define LSCALE(A1,A2) CCALLSFSUB2(LSCALE,lscale,INT,PFLOAT,A1,A2)
-
-PROTOCCALLSFSUB1(LSHOWR,lshowr,INT)
-#define LSHOWR(A1) CCALLSFSUB1(LSHOWR,lshowr,INT,A1)
-
-PROTOCCALLSFSUB5(LSIGMX,lsigmx,INT,FLOATV,PFLOAT,FLOATV,INT)
-#define LSIGMX(A1,A2,A3,A4,A5) CCALLSFSUB5(LSIGMX,lsigmx,INT,FLOATV,PFLOAT,FLOATV,INT,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB1(LTIMEX,ltimex,PFLOAT)
-#define LTIMEX(A1) CCALLSFSUB1(LTIMEX,ltimex,PFLOAT,A1)
-
-PROTOCCALLSFSUB1(LWBB,lwbb,PFLOAT)
-#define LWBB(A1) CCALLSFSUB1(LWBB,lwbb,PFLOAT,A1)
-
-PROTOCCALLSFSUB1(LWEITS,lweits,INT)
-#define LWEITS(A1) CCALLSFSUB1(LWEITS,lweits,INT,A1)
-
-PROTOCCALLSFSUB2(LXP,lxp,PFLOAT,PINT)
-#define LXP(A1,A2) CCALLSFSUB2(LXP,lxp,PFLOAT,PINT,A1,A2)
-
-PROTOCCALLSFSUB0(LXSECT,lxsect)
-#define LXSECT() CCALLSFSUB0(LXSECT,lxsect)
-
-PROTOCCALLSFSUB2(LYREMN,lyremn,INT,INT)
-#define LYREMN(A1,A2) CCALLSFSUB2(LYREMN,lyremn,INT,INT,A1,A2)
-
-PROTOCCALLSFSUB4(LYSPLI,lyspli,INT,INT,PINT,PINT)
-#define LYSPLI(A1,A2,A3,A4) CCALLSFSUB4(LYSPLI,lyspli,INT,INT,PINT,PINT,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB2(LYSSPA,lysspa,INT,INT)
-#define LYSSPA(A1,A2) CCALLSFSUB2(LYSSPA,lysspa,INT,INT,A1,A2)
-
-PROTOCCALLSFSUB4(LYSTFU,lystfu,INT,FLOAT,FLOAT,PFLOAT)
-#define LYSTFU(A1,A2,A3,A4) CCALLSFSUB4(LYSTFU,lystfu,INT,FLOAT,FLOAT,PFLOAT,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB3(LZP,lzp,FLOAT,PFLOAT,PINT)
-#define LZP(A1,A2,A3) CCALLSFSUB3(LZP,lzp,FLOAT,PFLOAT,PINT,A1,A2,A3)
-
-PROTOCCALLSFSUB0(RIWIBD,riwibd)
-#define RIWIBD() CCALLSFSUB0(RIWIBD,riwibd)
diff --git a/src/cfortran/minuit.h b/src/cfortran/minuit.h
deleted file mode 100644
index 3e134fb..0000000
--- a/src/cfortran/minuit.h
+++ /dev/null
@@ -1,192 +0,0 @@
-/*
- * Interface to minuit using cfortran.h
- *
- * Edit history:
- * G.Folger 12-Dec-94 change some to use ROUTINE for passing fcn/futil
- */
-
-PROTOCCALLSFFUN1(LOGICAL,MNUNPT,mnunpt,BYTE)
-#define MNUNPT(A2) CCALLSFFUN1(MNUNPT,mnunpt,BYTE,A2)
-
-PROTOCCALLSFSUB2(MINUIT,minuit,ROUTINE,ROUTINE)
-#define MINUIT(A1,A2) CCALLSFSUB2(MINUIT,minuit,ROUTINE,ROUTINE,A1,A2)
-
-PROTOCCALLSFSUB2(MNAMIN,mnamin,DOUBLE,DOUBLE)
-#define MNAMIN(A1,A2) CCALLSFSUB2(MNAMIN,mnamin,DOUBLE,DOUBLE,A1,A2)
-
-PROTOCCALLSFSUB7(MNBINS,mnbins,DOUBLE,DOUBLE,INT,PDOUBLE,PDOUBLE,PINT,PDOUBLE)
-#define MNBINS(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(MNBINS,mnbins,DOUBLE,DOUBLE,INT,PDOUBLE,PDOUBLE,PINT,PDOUBLE,A1,A2,A3,A4,A5,A6,A7)
-
-PROTOCCALLSFSUB4(MNCALF,mncalf,DOUBLE,DOUBLEV,PDOUBLE,DOUBLE)
-#define MNCALF(A1,A2,A3,A4) CCALLSFSUB4(MNCALF,mncalf,DOUBLE,DOUBLEV,PDOUBLE,DOUBLE,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB0(MNCLER,mncler)
-#define MNCLER() CCALLSFSUB0(MNCLER,mncler)
-
-PROTOCCALLSFSUB5(MNCNTR,mncntr,DOUBLE,INT,INT,PINT,DOUBLE)
-#define MNCNTR(A1,A2,A3,A4,A5) CCALLSFSUB5(MNCNTR,mncntr,DOUBLE,INT,INT,PINT,DOUBLE,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB4(MNCOMD,mncomd,ROUTINE,STRING,PINT,ROUTINE)
-#define MNCOMD(A1,A2,A3,A4) CCALLSFSUB4(MNCOMD,mncomd,ROUTINE,STRING,PINT,ROUTINE,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB8(MNCONT,mncont,ROUTINE,INT,INT,INT,PDOUBLE,PDOUBLE,PINT,ROUTINE)
-#define MNCONT(A1,A2,A3,A4,A5,A6,A7,A8) CCALLSFSUB8(MNCONT,mncont,ROUTINE,INT,INT,INT,PDOUBLE,PDOUBLE,PINT,ROUTINE,A1,A2,A3,A4,A5,A6,A7,A8)
-
-PROTOCCALLSFSUB9(MNCRCK,mncrck,STRING,INT,PSTRING,PINT,INT,PDOUBLE,PINT,PINT,INT)
-#define MNCRCK(A1,A2,A3,A4,A5,A6,A7,A8,A9) CCALLSFSUB9(MNCRCK,mncrck,STRING,INT,PSTRING,PINT,INT,PDOUBLE,PINT,PINT,INT,A1,A2,A3,A4,A5,A6,A7,A8,A9)
-
-PROTOCCALLSFSUB4(MNCROS,mncros,DOUBLE,PDOUBLE,PINT,DOUBLE)
-#define MNCROS(A1,A2,A3,A4) CCALLSFSUB4(MNCROS,mncros,DOUBLE,PDOUBLE,PINT,DOUBLE,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB2(MNCUVE,mncuve,DOUBLE,DOUBLE)
-#define MNCUVE(A1,A2) CCALLSFSUB2(MNCUVE,mncuve,DOUBLE,DOUBLE,A1,A2)
-
-PROTOCCALLSFSUB2(MNDERI,mnderi,DOUBLE,DOUBLE)
-#define MNDERI(A1,A2) CCALLSFSUB2(MNDERI,mnderi,DOUBLE,DOUBLE,A1,A2)
-
-PROTOCCALLSFSUB3(MNDXDI,mndxdi,DOUBLE,INT,PDOUBLE)
-#define MNDXDI(A1,A2,A3) CCALLSFSUB3(MNDXDI,mndxdi,DOUBLE,INT,PDOUBLE,A1,A2,A3)
-
-PROTOCCALLSFSUB7(MNEIG,mneig,PDOUBLE,INT,INT,INT,PDOUBLE,DOUBLE,PINT)
-#define MNEIG(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(MNEIG,mneig,PDOUBLE,INT,INT,INT,PDOUBLE,DOUBLE,PINT,A1,A2,A3,A4,A5,A6,A7)
-
-PROTOCCALLSFSUB2(MNEMAT,mnemat,PDOUBLE,INT)
-#define MNEMAT(A1,A2) CCALLSFSUB2(MNEMAT,mnemat,PDOUBLE,INT,A1,A2)
-
-PROTOCCALLSFSUB5(MNERRS,mnerrs,INT,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE)
-#define MNERRS(A1,A2,A3,A4,A5) CCALLSFSUB5(MNERRS,mnerrs,INT,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB5(MNEVAL,mneval,DOUBLE,DOUBLE,PDOUBLE,PINT,DOUBLE)
-#define MNEVAL(A1,A2,A3,A4,A5) CCALLSFSUB5(MNEVAL,mneval,DOUBLE,DOUBLE,PDOUBLE,PINT,DOUBLE,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB6(MNEXCM,mnexcm,ROUTINE,STRING,DOUBLEV,INT,PINT,ROUTINE)
-#define MNEXCM(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(MNEXCM,mnexcm,ROUTINE,STRING,DOUBLEV,INT,PINT,ROUTINE,A1,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFSUB1(MNEXIN,mnexin,PDOUBLE)
-#define MNEXIN(A1) CCALLSFSUB1(MNEXIN,mnexin,PDOUBLE,A1)
-
-PROTOCCALLSFSUB2(MNFIXP,mnfixp,INT,PINT)
-#define MNFIXP(A1,A2) CCALLSFSUB2(MNFIXP,mnfixp,INT,PINT,A1,A2)
-
-PROTOCCALLSFSUB1(MNFREE,mnfree,INT)
-#define MNFREE(A1) CCALLSFSUB1(MNFREE,mnfree,INT,A1)
-
-PROTOCCALLSFSUB2(MNGRAD,mngrad,DOUBLE,DOUBLE)
-#define MNGRAD(A1,A2) CCALLSFSUB2(MNGRAD,mngrad,DOUBLE,DOUBLE,A1,A2)
-
-PROTOCCALLSFSUB2(MNHELP,mnhelp,STRING,INT)
-#define MNHELP(A1,A2) CCALLSFSUB2(MNHELP,mnhelp,STRING,INT,A1,A2)
-
-PROTOCCALLSFSUB2(MNHES1,mnhes1,DOUBLE,DOUBLE)
-#define MNHES1(A1,A2) CCALLSFSUB2(MNHES1,mnhes1,DOUBLE,DOUBLE,A1,A2)
-
-PROTOCCALLSFSUB2(MNHESS,mnhess,DOUBLE,DOUBLE)
-#define MNHESS(A1,A2) CCALLSFSUB2(MNHESS,mnhess,DOUBLE,DOUBLE,A1,A2)
-
-PROTOCCALLSFSUB2(MNIMPR,mnimpr,DOUBLE,DOUBLE)
-#define MNIMPR(A1,A2) CCALLSFSUB2(MNIMPR,mnimpr,DOUBLE,DOUBLE,A1,A2)
-
-PROTOCCALLSFSUB1(MNINEX,mninex,DOUBLEV)
-#define MNINEX(A1) CCALLSFSUB1(MNINEX,mninex,DOUBLEV,A1)
-
-PROTOCCALLSFSUB3(MNINIT,mninit,INT,INT,INT)
-#define MNINIT(A1,A2,A3) CCALLSFSUB3(MNINIT,mninit,INT,INT,INT,A1,A2,A3)
-
-PROTOCCALLSFSUB2(MNINPU,mninpu,INT,PINT)
-#define MNINPU(A1,A2) CCALLSFSUB2(MNINPU,mninpu,INT,PINT,A1,A2)
-
-PROTOCCALLSFSUB2(MNINTR,mnintr,ROUTINE,ROUTINE)
-#define MNINTR(A1,A2) CCALLSFSUB2(MNINTR,mnintr,ROUTINE,ROUTINE,A1,A2)
-
-PROTOCCALLSFSUB2(MNLIMS,mnlims,DOUBLE,DOUBLE)
-#define MNLIMS(A1,A2) CCALLSFSUB2(MNLIMS,mnlims,DOUBLE,DOUBLE,A1,A2)
-
-PROTOCCALLSFSUB7(MNLINE,mnline,DOUBLE,DOUBLEV,DOUBLE,DOUBLEV,DOUBLE,DOUBLE,DOUBLE)
-#define MNLINE(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(MNLINE,mnline,DOUBLE,DOUBLEV,DOUBLE,DOUBLEV,DOUBLE,DOUBLE,DOUBLE,A1,A2,A3,A4,A5,A6,A7)
-
-PROTOCCALLSFSUB1(MNMATU,mnmatu,INT)
-#define MNMATU(A1) CCALLSFSUB1(MNMATU,mnmatu,INT,A1)
-
-PROTOCCALLSFSUB2(MNMIGR,mnmigr,DOUBLE,DOUBLE)
-#define MNMIGR(A1,A2) CCALLSFSUB2(MNMIGR,mnmigr,DOUBLE,DOUBLE,A1,A2)
-
-PROTOCCALLSFSUB2(MNMNOS,mnmnos,DOUBLE,DOUBLE)
-#define MNMNOS(A1,A2) CCALLSFSUB2(MNMNOS,mnmnos,DOUBLE,DOUBLE,A1,A2)
-
-PROTOCCALLSFSUB6(MNMNOT,mnmnot,DOUBLE,INT,INT,DOUBLE,DOUBLE,DOUBLE)
-#define MNMNOT(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(MNMNOT,mnmnot,DOUBLE,INT,INT,DOUBLE,DOUBLE,DOUBLE,A1,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFSUB7(MNPARM,mnparm,INT,STRING,DOUBLE,DOUBLE,PDOUBLE,PDOUBLE,PINT)
-#define MNPARM(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(MNPARM,mnparm,INT,STRING,DOUBLE,DOUBLE,PDOUBLE,PDOUBLE,PINT,A1,A2,A3,A4,A5,A6,A7)
-
-PROTOCCALLSFSUB2(MNPARS,mnpars,BYTE,PINT)
-#define MNPARS(A1,A2) CCALLSFSUB2(MNPARS,mnpars,BYTE,PINT,A1,A2)
-
-PROTOCCALLSFSUB5(MNPFIT,mnpfit,DOUBLEV,DOUBLEV,INT,PDOUBLE,PDOUBLE)
-#define MNPFIT(A1,A2,A3,A4,A5) CCALLSFSUB5(MNPFIT,mnpfit,DOUBLEV,DOUBLEV,INT,PDOUBLE,PDOUBLE,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB3(MNPINT,mnpint,PDOUBLE,INT,PDOUBLE)
-#define MNPINT(A1,A2,A3) CCALLSFSUB3(MNPINT,mnpint,PDOUBLE,INT,PDOUBLE,A1,A2,A3)
-
-PROTOCCALLSFSUB7(MNPLOT,mnplot,PDOUBLE,PDOUBLE,PSTRINGV,INT,INT,INT,INT)
-#define MNPLOT(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(MNPLOT,mnplot,PDOUBLE,PDOUBLE,PSTRINGV,INT,INT,INT,INT,A1,A2,A3,A4,A5,A6,A7)
-
-PROTOCCALLSFSUB7(MNPOUT,mnpout,INT,PSTRING,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PINT)
-#define MNPOUT(A1,A2,A3,A4,A5,A6,A7) CCALLSFSUB7(MNPOUT,mnpout,INT,PSTRING,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PINT,A1,A2,A3,A4,A5,A6,A7)
-
-PROTOCCALLSFSUB2(MNPRIN,mnprin,INT,DOUBLE)
-#define MNPRIN(A1,A2) CCALLSFSUB2(MNPRIN,mnprin,INT,DOUBLE,A1,A2)
-
-PROTOCCALLSFSUB0(MNPSDF,mnpsdf)
-#define MNPSDF() CCALLSFSUB0(MNPSDF,mnpsdf)
-
-PROTOCCALLSFSUB5(MNRAZZ,mnrazz,DOUBLE,DOUBLEV,PDOUBLE,PINT,PINT)
-#define MNRAZZ(A1,A2,A3,A4,A5) CCALLSFSUB5(MNRAZZ,mnrazz,DOUBLE,DOUBLEV,PDOUBLE,PINT,PINT,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB4(MNREAD,mnread,DOUBLE,INT,PINT,DOUBLE)
-#define MNREAD(A1,A2,A3,A4) CCALLSFSUB4(MNREAD,mnread,DOUBLE,INT,PINT,DOUBLE,A1,A2,A3,A4)
-
-PROTOCCALLSFSUB2(MNRN15,mnrn15,PDOUBLE,PINT)
-#define MNRN15(A1,A2) CCALLSFSUB2(MNRN15,mnrn15,PDOUBLE,PINT,A1,A2)
-
-PROTOCCALLSFSUB1(MNRSET,mnrset,INT)
-#define MNRSET(A1) CCALLSFSUB1(MNRSET,mnrset,INT,A1)
-
-PROTOCCALLSFSUB0(MNSAVE,mnsave)
-#define MNSAVE() CCALLSFSUB0(MNSAVE,mnsave)
-
-PROTOCCALLSFSUB2(MNSCAN,mnscan,DOUBLE,DOUBLE)
-#define MNSCAN(A1,A2) CCALLSFSUB2(MNSCAN,mnscan,DOUBLE,DOUBLE,A1,A2)
-
-PROTOCCALLSFSUB2(MNSEEK,mnseek,DOUBLE,DOUBLE)
-#define MNSEEK(A1,A2) CCALLSFSUB2(MNSEEK,mnseek,DOUBLE,DOUBLE,A1,A2)
-
-PROTOCCALLSFSUB2(MNSET,mnset,DOUBLE,DOUBLE)
-#define MNSET(A1,A2) CCALLSFSUB2(MNSET,mnset,DOUBLE,DOUBLE,A1,A2)
-
-PROTOCCALLSFSUB1(MNSETI,mnseti,STRING)
-#define MNSETI(A1) CCALLSFSUB1(MNSETI,mnseti,STRING,A1)
-
-PROTOCCALLSFSUB2(MNSIMP,mnsimp,DOUBLE,DOUBLE)
-#define MNSIMP(A1,A2) CCALLSFSUB2(MNSIMP,mnsimp,DOUBLE,DOUBLE,A1,A2)
-
-PROTOCCALLSFSUB6(MNSTAT,mnstat,PDOUBLE,PDOUBLE,PDOUBLE,PINT,PINT,PINT)
-#define MNSTAT(A1,A2,A3,A4,A5,A6) CCALLSFSUB6(MNSTAT,mnstat,PDOUBLE,PDOUBLE,PDOUBLE,PINT,PINT,PINT,A1,A2,A3,A4,A5,A6)
-
-PROTOCCALLSFSUB2(MNSTIN,mnstin,BYTE,PINT)
-#define MNSTIN(A1,A2) CCALLSFSUB2(MNSTIN,mnstin,BYTE,PINT,A1,A2)
-
-PROTOCCALLSFSUB2(MNTINY,mntiny,DOUBLE,PDOUBLE)
-#define MNTINY(A1,A2) CCALLSFSUB2(MNTINY,mntiny,DOUBLE,PDOUBLE,A1,A2)
-
-PROTOCCALLSFSUB5(MNVERT,mnvert,PDOUBLE,INT,INT,INT,PINT)
-#define MNVERT(A1,A2,A3,A4,A5) CCALLSFSUB5(MNVERT,mnvert,PDOUBLE,INT,INT,INT,PINT,A1,A2,A3,A4,A5)
-
-PROTOCCALLSFSUB3(MNWARN,mnwarn,BYTE,BYTE,BYTE)
-#define MNWARN(A1,A2,A3) CCALLSFSUB3(MNWARN,mnwarn,BYTE,BYTE,BYTE,A1,A2,A3)
-
-PROTOCCALLSFSUB0(MNWERR,mnwerr)
-#define MNWERR() CCALLSFSUB0(MNWERR,mnwerr)
-
-PROTOCCALLSFSUB0(STAND,stand)
-#define STAND() CCALLSFSUB0(STAND,stand)
diff --git a/src/cfortran/packlib.h b/src/cfortran/packlib.h
deleted file mode 100644
index 2e946af..0000000
--- a/src/cfortran/packlib.h
+++ /dev/null
@@ -1,4 +0,0 @@
-#include "hbook.h"
-#include "minuit.h"
-#include "kuip.h"
-#include "zebra.h"
diff --git a/src/cfortran/paw.h b/src/cfortran/paw.h
deleted file mode 100644
index 13b963e..0000000
--- a/src/cfortran/paw.h
+++ /dev/null
@@ -1,6 +0,0 @@
-PROTOCCALLSFSUB2(PAW,paw,INT,INT)
-#define PAW(A1,A2) CCALLSFSUB2(PAW,paw,INT,INT,A1,A2)
-
-PROTOCCALLSFSUB0(PAEXIT,paexit)
-#define PAEXIT() CCALLSFSUB0(PAEXIT,paexit)
-
diff --git a/src/cfortran/zebra.h b/src/cfortran/zebra.h
deleted file mode 100644
index 2bb3f0f..0000000
--- a/src/cfortran/zebra.h
+++ /dev/null
@@ -1,5 +0,0 @@
-PROTOCCALLSFSUB1(MZEBRA,mzebra,INT)
-#define MZEBRA(A1) CCALLSFSUB1(MZEBRA,mzebra,INT,A1)
-
-PROTOCCALLSFSUB2(MZPAW,mzpaw,INT,STRING)
-#define MZPAW(A1,A2) CCALLSFSUB2(MZPAW,mzpaw,INT,STRING,A1,A2)
diff --git a/src/config/Amoeba.cf b/src/config/Amoeba.cf
deleted file mode 100644
index d3f174f..0000000
--- a/src/config/Amoeba.cf
+++ /dev/null
@@ -1,414 +0,0 @@
-/* $Id: Amoeba.cf,v 1.2 2005/04/18 15:23:07 mclareni Exp $
- *
- * $Log: Amoeba.cf,v $
- * Revision 1.2 2005/04/18 15:23:07 mclareni
- * Mods submitted by Kevin B. McCarty to fix insecure Cernlib uses of /tmp.
- *
- * Revision 1.1.1.1 1995/12/20 15:26:47 cernlib
- * X11R6 config files unmodified
- *
- *
- */
-XCOMM platform: $XConsortium: Amoeba.cf,v 1.7 95/01/05 19:38:42 kaleb Exp $
-
-/* The presence of this configuration file in the X distribution
- * does not imply full support for the system it describes.
- * Additional patches from The XFree86 Project, Inc. will be required to
- * compile the X distribution on Amoeba. According to them, these patches
- * will also be made available at the regular Amoeba ftp site
- * ftp.am.cs.vu.nl.
- */
-
-/*
- * Configuration file for Amoeba 5.2
- */
-
-#define OSName Amoeba 5.2
-XCOMM operating system: OSName
-#define OSMajorVersion 5
-#define OSMinorVersion 2
-#define OSTeenyVersion 0
-#define OSVendor Vrije Universiteit
-
-#define AmoebaArchitecture YES
-
-/* Configuration defaults */
-#ifndef AmoebaTop
-#define AmoebaTop __AM_TOP__
-#endif
-#ifndef AmoebaBin
-#define AmoebaBin $(ATOP)/bin.sun4
-#endif
-#ifndef AmoebaConf
-#define AmoebaConf __AM_CONF__
-#endif
-
-#define HasNdbm YES
-#define NeedSdbm YES
-#define HasShm NO
-#define HasSecureRPC NO
-#define SetTtyGroup NO
-#define HasPutenv YES
-#define HasSockets NO
-#define HasStreams NO
-
-#if defined(Sun3Architecture) || defined(SparcArchitecture)
-#define XsunAmoebaServer YES
-#define XsunAmoebaMonoServer YES
-#endif
-
-#define BuildFonts NO
-#define BuildFontServer NO
-#define BuildPex NO
-#define BuildPexExt NO
-#define BuildXIE NO
-
-#define YaccCmd byacc
-#define TermcapLibrary /* in libajax */
-#define LexLib /* not needed */
-
-#define PexCCOptions DefaultCCOptions
-#define ServerOSDefines XFree86ServerOSDefines
-
-#define UsrLibDir $(DESTDIR)/profile/module/x11/lib
-#define LibDir $(DESTDIR)/profile/module/x11/lib
-#define ManDirectoryRoot $(DESTDIR)/profile/module/x11/man
-#define BinDir $(DESTDIR)/profile/module/x11/bin
-#define IncRoot $(DESTDIR)/profile/module/x11/include
-#define FontDir $(DESTDIR)/profile/module/x11/fonts/$(ARCH)
-#define DefaultRGBDatabase $(DESTDIR)/profile/module/x11/lib/rgb/$(ARCH)/rgb
-
-#define ManSuffix 1
-#define ManPath ManDirectoryRoot
-#define XmanLocalSearchPath ManDirectoryRoot
-
-#define DefaultUserPath :/bin:$(BINDIR)
-#define DefaultSystemPath /bin:$(BINDIR):
-
-#define StandardIncludes -I$(ATOP)/src/h \
- -I$(ATOP)/src/h/posix \
- -I$(ATOP)/src/h/posix/machdep/$(ARCH) \
- -I$(ATOP)/src/h/machdep/arch/$(ARCH) \
- -I$(ATOP)/src/h/toolset/$(TOOLSET)
-
-#define Malloc0ReturnsNull YES
-#define ServerInstallFlags -s 32
-#define FontDefines -DFONT_SNF
-#define ConnectionFlags -DAMTCPCONN -DAMRPCCONN
-#define ServerXdmcpDefines /* no -DXDMCP */
-#define UseRgbTxt YES
-#define NdbmDefines -DSDBM -DNDBM -I$(INCLUDESRC)
-#define DBMLibrary /* $(LIBSRC)/sdbm/libsdbm.a */
-
-#if defined(i386Architecture)
-#ifndef AckToolset
-#define AckToolset YES
-#define ExtraFPLoadFlags -fp
-#endif
-#define XF86MonoServer YES
-#endif
-
-#if defined(Sun3Architecture)
-#ifndef AckToolset
-#define AckToolset YES
-#endif
-#endif
-
-#if AckToolset
-#define CcCmd ack
-#define ServerCcCmd ack
-#define LdCmd ack
-#define AckArchOption -mam_$(ARCH)
-#define DefaultCCOptions AckArchOption
-#define LibraryCCOptions AckArchOption
-#define LdCombineFlags -Rled-r -c.out
-#define ArCmd aal clrv
-#define RanlibCmd /bin/true
-#define AsCmd AmoebaConf/$(ARCH).$(TOOLSET)/toolset/do_as AckArchOption
-#define AsIncl -I$(ATOP)/src/h/machdep/arch/$(ARCH)
-#define AsmDefines -DACK_ASSEMBLER
-#define LdPreLib /**/
-#define LdPostLib /**/
-#endif
-
-#if defined(SparcArchitecture)
-#define AllocateLocalDefines -DINCLUDE_ALLOCA_H
-
-#define CcCmd cc
-#define ServerCcCmd cc
-#define LdCmd AmoebaConf/$(ARCH).$(TOOLSET)/toolset/do_gld
-#define DefaultCCOptions -sun4
-#define LibraryCCOptions -sun4
-#define AmoebaCompilerDefs -Usun
-#define ServerExtraDefines AllocateLocalDefines
-#define LdPostLib /**/
-#endif
-
-#ifndef AmoebaCompilerDefs
-#define AmoebaCompilerDefs /**/
-#endif
-
-#define CommonAmoebaDefines -DAMOEBA -D$(ARCH) AmoebaCompilerDefs
-#define StandardDefines CommonAmoebaDefines
-#define StandardCppDefines StandardDefines
-
-#ifndef ExtraFPLoadFlags
-#define ExtraFPLoadFlags
-#endif
-#define MathLibrary $(ALIB)/math/libmath.a
-#define OSLibraries $(ALIB)/ajax/libajax.a \
- $(ALIB)/amoeba/libamoeba.a \
- MathLibrary \
- ExtraFPLoadFlags
-#define ServerExtraSysLibs $(CBRT) OSLibraries
-#define ExtraLoadFlags OSLibraries
-
-ATOP = AmoebaTop
-ALIB = AmoebaConf/$(ARCH).$(TOOLSET)/lib
-#if AckToolset
-/* The ACK toolset already links in the appropriate head.o by default */
-HEAD =
-#else
-HEAD = $(ALIB)/head/head.o
-#endif
-
-ABIN = AmoebaBin
-AINSTALL = /bin/sh $(CONFIGSRC)/util/aminstall.sh $(ABIN)
-AINSTALLFLAGS =
-TOB = /bin/sh $(CONFIGSRC)/util/aminstall.sh $(ABIN)
-MKXDIRHIER = /bin/sh $(CONFIGSRC)/util/ammkdirhier.sh $(ABIN)
-
-/* Make wizardy: */
-COMPILE.c=$(CC) $(CFLAGS) $(CPPFLAGS) -c
-LINK.c=$(CC) $(CFLAGS) $(CPPFLAGS) $(LDFLAGS)
-
-#if defined(i386Architecture)
-ARCH = i80386
-TOOLSET = ack
-ALDFLAGS = /* -mam_i80386 now in CCopts */ -.c -Rcv-s32
-
-#include <xfree86.cf>
-#endif
-
-#if defined(Sun3Architecture)
-ARCH = mc68000
-TOOLSET = ack
-ALDFLAGS = -.c -Rcv-s32
-#endif
-
-#if defined(SparcArchitecture)
-ARCH = sparc
-TOOLSET = sun
-SPARCLIBDIR = AmoebaBin/gnu/sparc
-ALDFLAGS = -mam_sparc -n -Ttext 40000 -Bstatic -e start -L$(SPARCLIBDIR)
-#endif
-
-#define BootstrapCFlags -DAMOEBA -DCROSS_$(ARCH) -DCROSS_COMPILE
-
-/*
- * The rest of this files consists of rules to allow cross-compilation
- * and installation of binaries and data files from the Unix host to
- * the Amoeba file system.
- */
-
-/* #ifdef CROSS_COMPILING */
-#define CrossCompiling YES
-
-#define HostLinkRule(target, flags, src, libs) cc -o target src
-
-#define LinkRule(program,options,objects,libraries) \
-$(LD) $(ALDFLAGS) $(HEAD) -o program options objects libraries $(EXTRA_LOAD_FLAGS)
-
-/* ComplexHostProgramTarget - Compile a program such that we can run
- * it on this host, i.e., don't use the default cross compiler.
- */
-#ifndef ComplexHostProgramTarget
-#define ComplexHostProgramTarget(program) @@\
- CC=cc @@\
- STD_INCLUDES= @@\
- CFLAGS=$(TOP_INCLUDES) $(INCLUDES) $(BOOTSTRAPCFLAGS) @@\
-EXTRA_LOAD_FLAGS= @@\
- PROGRAM = program @@\
- @@\
-AllTarget(program) @@\
- @@\
-program: $(OBJS) $(DEPLIBS) @@\
- RemoveTargetProgram($@) @@\
- HostLinkRule($@,$(_NOOP_),$(OBJS),$(DEPLIBS) $(LOCAL_LIBRARIES)) @@\
- @@\
-DependTarget() @@\
- @@\
-LintTarget() @@\
- @@\
-clean:: @@\
- RemoveFile(ProgramTargetName(program))
-#endif /* ComplexHostProgramTarget */
-
-#ifndef SimpleHostProgramTarget
-#define SimpleHostProgramTarget(program) @@\
- OBJS = program.o @@\
- SRCS = program.c @@\
- @@\
-ComplexHostProgramTarget(program)
-#endif /* SimpleHostProgramTarget */
-
-
-#ifndef Concat
-#if (__STDC__ && !defined(UnixCpp)) || defined(AnsiCpp)
-#define Concat(a,b)a##b
-#else
-#define Concat(a,b)a/**/b
-#endif
-#endif
-
-/*
- * LintLibReferences - variables for lint libraries
- */
-#ifndef LintLibReferences
-#define LintLibReferences(varname,libname,libsource) @@\
-Concat(LINT,varname) = Concat(libsource/llib-,libname.ln)
-#endif
-
-/*
- * UnsharedLibReferences - variables for unshared libraries
- */
-#ifndef UnsharedLibReferences
-#define UnsharedLibReferences(varname,libname,libsource) @@\
-Concat3(DEP,varname,LIB) = Concat($(BUILDLIBDIR)/lib,libname.a) @@\
- Concat(varname,LIB) = Concat($(BUILDLIBDIR)/lib,libname.a) @@\
-LintLibReferences(varname,libname,libsource)
-#endif
-
-#ifndef InstallLibrary
-#define InstallLibrary(libname,dest) @@\
-install:: Concat(lib,libname.a) @@\
- @echo '** TODO: Install Library ' Concat(lib,libname.a)
-#endif /* InstallLibrary */
-
-#ifndef MergeIntoInstalledLibrary
-#define MergeIntoInstalledLibrary(tolib,fromlib) @@\
-install:: fromlib @@\
- @echo '** TODO: merge ' fromlib into tolib
-#endif /* MergeIntoInstalledLibrary */
-
-#ifndef InstallLibraryAlias
-#define InstallLibraryAlias(libname,alias,dest) @@\
-install:: @@\
- @echo '** TODO: Install lib alias ' libname alias dest
-#endif /* InstallLibraryAlias */
-
-#ifndef InstallLintLibrary
-#define InstallLintLibrary(libname,dest) @@\
-install.ln:: Concat(llib-l,libname.ln) @@\
- @echo '** TODO: Install lintlib ' Concat(llib-l,libname.ln)
-#endif /* InstallLintLibrary */
-
-#ifndef InstallManPageLong
-#define InstallManPageLong(file,destdir,dest) @@\
-install.man:: file.man @@\
- @echo '** TODO: Install man page ' file.man
-#endif /* InstallManPageLong */
-
-#ifndef InstallManPageAliases
-#define InstallManPageAliases(file,destdir,aliases) @@\
-install.man:: @@\
- @(TMP=$(DESTDIR)destdir/file.$(MANSUFFIX).$$$$; \ @@\
- $(MKXDIRHIER) `dirname $${TMP}` ; \ @@\
- $(RM) $${TMP}; \ @@\
- echo .so `basename destdir`/file.$(MANSUFFIX) > $${TMP}; \ @@\
- for i in aliases; do (set -x; \ @@\
- $(TOB) $${TMP} $(DESTDIR)destdir/$$i.$(MANSUFFIX)); \ @@\
- done; \ @@\
- $(RM) $${TMP})
-#endif /* InstallManPageAliases */
-
-#ifndef InstallNamedNonExec
-#define InstallNamedNonExec(srcname,dstname,dest) @@\
-install:: srcname @@\
- $(MKXDIRHIER) $(DESTDIR)dest @@\
- $(TOB) srcname $(DESTDIR)dest/dstname
-#endif /* InstallNamedNonExec */
-
-#ifndef InstallNonExecFile
-#define InstallNonExecFile(file,dest) @@\
-install:: file @@\
- $(MKXDIRHIER) dest @@\
- $(TOB) file dest/file
-#endif /* InstallNonExecFile */
-
-#ifndef InstallNonExec
-#define InstallNonExec(file,dest) @@\
-install:: file @@\
- $(TOB) file dest/file
-#endif /* InstallNonExec */
-
-#ifndef InstallProgramWithFlags
-#define InstallProgramWithFlags(program,dest,flags) @@\
-install:: program @@\
- $(MKXDIRHIER) dest/program @@\
- $(AINSTALL) $(AINSTALLFLAGS) program dest/program/pd.$(ARCH)
-#endif /* InstallProgramWithFlags */
-
-#ifndef InstallScript
-#define InstallScript(program,dest) @@\
-install:: program.script @@\
- $(TOB) program.script dest/program
-#endif /* InstallScript */
-
-#ifndef InstallNamedScript
-#define InstallNamedScript(srcname,dstname,dest) @@\
-install:: srcname @@\
- $(TOB) srcname dest/dstname
-#endif /* InstallNamedScript */
-
-#ifndef InstallNamedProg
-#define InstallNamedProg(srcname,dstname,dest) @@\
-install:: srcname @@\
- $(MKXDIRHIER) $(DESTDIR)dest/dstname @@\
- $(AINSTALL) $(AINSTALLFLAGS) srcname $(DESTDIR)dest/dstname/pd.$(ARCH)
-#endif /* InstallNamedProg */
-
-#ifndef InstallMultipleDestFlags
-#define InstallMultipleDestFlags(step,list,dest,flags) @@\
-step:: list @@\
- $(MKXDIRHIER) $(DESTDIR)dest @@\
- @case '${MFLAGS}' in *[i]*) set +e;; esac; \ @@\
- for i in list; do \ @@\
- (set -x; $(TOB) $$i dest/$$i); \ @@\
- done
-#endif /* InstallMultipleDestFlags */
-
-#ifndef InstallMultipleProg
-#define InstallMultipleProg(list,dest) @@\
-install:: list @@\
- @case '${MFLAGS}' in *[i]*) set +e;; esac; \ @@\
- for i in list; do \ @@\
- (set -x; \ @@\
- $(MKXDIRHIER) $(DESTDIR)dest/$$i; \ @@\
- $(AINSTALL) $(AINSTALLFLAGS) $$i dest/$$i/pd.$(ARCH));\ @@\
- done
-#endif /* InstallMultipleProg */
-
-#ifndef InstallAppDefaults
-#if InstallAppDefFiles
-#define InstallAppDefaults(class) @@\
-install:: class.ad @@\
- $(MKXDIRHIER) $(XAPPLOADDIR) @@\
- $(TOB) class.ad $(DESTDIR)$(XAPPLOADDIR)/class
-#else
-#define InstallAppDefaults(class)
-#endif /* InstallAppDefFiles */
-#endif /* InstallAppDefaults */
-
-#ifndef InstallAppDefaultsLong
-#if InstallAppDefFiles
-#define InstallAppDefaultsLong(file,class) @@\
-install:: file.ad @@\
- $(MKXDIRHIER) $(DESTDIR)$(XAPPLOADDIR) @@\
- $(TOB) file.ad $(DESTDIR)$(XAPPLOADDIR)/class
-#else
-#define InstallAppDefaultsLong(file,class)
-#endif /* InstallAppDefFiles */
-#endif /* InstallAppDefaultsLong */
-
-/* #endif CROSS_COMPILE */
diff --git a/src/config/DGUX.cf b/src/config/DGUX.cf
deleted file mode 100644
index 72d8f67..0000000
--- a/src/config/DGUX.cf
+++ /dev/null
@@ -1,24 +0,0 @@
-/* $Id: DGUX.cf,v 1.1.1.1 1995/12/20 15:26:47 cernlib Exp $
- *
- * $Log: DGUX.cf,v $
- * Revision 1.1.1.1 1995/12/20 15:26:47 cernlib
- * X11R6 config files unmodified
- *
- *
- */
-XCOMM platform: $XConsortium: DGUX.cf,v 1.3 93/10/13 15:29:59 rws Exp $
-
-#define OSName DG/UX 4.32
-XCOMM operating system: OSName
-#define OSMajorVersion 4
-#define OSMinorVersion 32
-
-#define BootstrapCFlags -DDGUX
-#define StandardDefines -DDGUX -DSYSV
-#define SystemV YES
-#define HasPutenv YES
-#define HasGcc YES
-#define BuildServer NO
-#define UNCOMPRESSPATH /usr/bin/X11/uncompress
-
-#define ExtraFilesToClean *.lg
diff --git a/src/config/FreeBSD.cf b/src/config/FreeBSD.cf
deleted file mode 100644
index c0a4eb5..0000000
--- a/src/config/FreeBSD.cf
+++ /dev/null
@@ -1,77 +0,0 @@
-/* $Id: FreeBSD.cf,v 1.1.1.1 1995/12/20 15:26:44 cernlib Exp $
- *
- * $Log: FreeBSD.cf,v $
- * Revision 1.1.1.1 1995/12/20 15:26:44 cernlib
- * X11R6 config files unmodified
- *
- *
- */
-XCOMM platform: $XConsortium: FreeBSD.cf,v 1.5 95/04/07 19:42:53 kaleb Exp $
-
-#define OSName FreeBSD 1.1
-#define OSVendor /**/
-XCOMM operating system: OSName
-#define OSMajorVersion 1
-#define OSMinorVersion 1
-#define OSTeenyVersion 0
-
-#define HasPutenv YES
-#define HasBSD44Sockets YES
-
-#define CppCmd /usr/libexec/cpp -traditional
-#define PreProcessCmd /usr/libexec/cpp -traditional
-#undef InstallCmd
-#define InstallCmd /usr/bin/install
-
-#define UseGas YES
-#ifndef GccUsesGas
-# define GccUsesGas YES
-#endif
-
-#ifndef AsmDefines
-# define AsmDefines -DUSE_GAS
-#endif
-
-#if GccUsesGas
-# define GccGasOption -DGCCUSESGAS
-#else
-# define GccGasOption /**/
-#endif
-
-#ifndef HasGcc2
-# define HasGcc2 YES
-#endif
-
-#define CcCmd gcc
-#define DefaultCCOptions /**/
-
-#ifdef i386Architecture
-#define OptimizedCDebugFlags -m486 -O2
-#else
-#define OptimizedCDebugFlags -O2
-#endif
-#if OSMajorVersion < 2
-#define ServerOSDefines XFree86ServerOSDefines -DDDXTIME -DXNO_SYSCONF
-#else
-#define ServerOSDefines XFree86ServerOSDefines -DDDXTIME
-#endif
-#define ServerExtraDefines GccGasOption
-
-#define StandardDefines -DCSRG_BASED
-#define XawI18nDefines -DUSE_XWCHAR_STRING -DUSE_XMBTOWC
-
-#define TroffCmd groff -Tps
-#define SetTtyGroup YES
-#define HasNdbm YES
-#define HasShm YES
-#define HasWChar32 YES
-
-#define HasLibCrypt YES
-
-#define AvoidNullMakeCommand YES
-
-#include <bsdLib.rules>
-
-#ifdef i386Architecture
-#include <xfree86.cf>
-#endif
diff --git a/src/config/Fresco.tmpl b/src/config/Fresco.tmpl
deleted file mode 100644
index ddf0205..0000000
--- a/src/config/Fresco.tmpl
+++ /dev/null
@@ -1,21 +0,0 @@
-/* $Id: Fresco.tmpl,v 1.1.1.1 1995/12/20 15:26:47 cernlib Exp $
- *
- * $Log: Fresco.tmpl,v $
- * Revision 1.1.1.1 1995/12/20 15:26:47 cernlib
- * X11R6 config files unmodified
- *
- *
- */
-XCOMM $XConsortium: Fresco.tmpl,v 1.5 94/03/31 16:31:31 matt Exp $
-XCOMM
-XCOMM Definitions for using Fresco library
-XCOMM
-
- DEPLIBS = FrescoClientDepLibs
-LOCAL_LIBRARIES = FrescoClientLibs
-
-#include <Threads.tmpl>
-
-#define CplusplusSource
-
-NormalCplusplusObjectRule()
diff --git a/src/config/Imake.cf b/src/config/Imake.cf
deleted file mode 100644
index 6dcbf63..0000000
--- a/src/config/Imake.cf
+++ /dev/null
@@ -1,470 +0,0 @@
-/* $Id: Imake.cf,v 1.6 2006/09/15 09:34:47 mclareni Exp $
- *
- * $Log: Imake.cf,v $
- * Revision 1.6 2006/09/15 09:34:47 mclareni
- * Submitted mods for gcc4/gfortran and MacOSX, corrected to work also on slc4 with gcc3.4 and 4.1
- *
- * Revision 1.5 2004/10/05 15:54:40 mclareni
- * Add configuration file linux-lp64 for Linux 64-bit pointer systems like AMD Opteron and Intel IA64.
- *
- * Revision 1.4 1998/09/25 09:23:38 mclareni
- * Modifications for the Mklinux port flagged by CERNLIB_PPC
- *
- * Revision 1.3 1998/06/09 13:54:39 cernlib
- * Make sure unix is properly undefined to compile kernlib/unix
- *
- * Revision 1.2 1995/12/21 11:31:57 cernlib
- * Imake files end 1995
- *
- * Revision 1.1.1.1 1995/12/20 15:26:44 cernlib
- * X11R6 config files unmodified
- *
- *
- */
-XCOMM $XConsortium: Imake.cf,v 1.19 95/01/05 19:24:32 kaleb Exp $
-/*
- * To add support for another platform:
- *
- * 1. Identify a machine-specific cpp symbol. If your preprocessor
- * does not have any built in, you will need to add the symbol to the
- * cpp_argv table in config/imake/imakemdep.h and rebuild imake with
- * the BOOTSTRAPCFLAGS variable set (see the macII for an example).
- *
- * 2. Add all machine-specific cpp symbols (either defined by you or by
- * the preprocessor or compiler) to the predefs table in
- * config/imake/imakemdep.h.
- *
- * 3. But a new #ifdef block below that defines MacroIncludeFile and
- * MacroFile for your new platform and then #undefs the machine-
- * specific preprocessor symbols (to avoid problems with file names).
- *
- * 4. Create a .cf file with the name given by MacroFile.
- */
-
-#ifdef ultrix
-#define MacroIncludeFile <ultrix.cf>
-#define MacroFile ultrix.cf
-#ifdef vax
-#undef vax
-#define VaxArchitecture
-#endif
-#ifdef mips
-#undef mips
-#define MipsArchitecture
-#endif
-#undef ultrix
-#define UltrixArchitecture
-#endif /* ultrix */
-
-#if defined(vax) && !defined(UltrixArchitecture)
-#define MacroIncludeFile <bsd.cf>
-#define MacroFile bsd.cf
-#undef vax
-#define BSDArchitecture
-#define VaxArchitecture
-#endif /* vax */
-
-#ifdef bsdi
-#define MacroIncludeFile <bsdi.cf>
-#define MacroFile bsdi.cf
-#undef bsdi
-#define BSD386Architecture
-#define i386BsdArchitecture
-#define i386Architecture
-#endif /* bsdi */
-
-#ifdef __NetBSD__
-#define MacroIncludeFile <NetBSD.cf>
-#define MacroFile NetBSD.cf
-#undef __NetBSD__
-#define NetBSDArchitecture
-#ifdef __i386__
-#define i386BsdArchitecture
-#define i386Architecture
-#endif
-#if defined(__sparc__) || defined(sparc)
-#define SparcArchitecture
-#undef sparc
-#endif
-#endif /* NetBSD */
-
-#ifdef __FreeBSD__
-#define MacroIncludeFile <FreeBSD.cf>
-#define MacroFile FreeBSD.cf
-#undef __FreeBSD__
-#define FreeBSDArchitecture
-#ifdef __i386__
-#define i386BsdArchitecture
-#define i386Architecture
-#endif
-#endif /* __FreeBSD__ */
-
-#ifdef AMOEBA
-/* Should be before the 'sun' entry because we may be cross-compiling */
-#define MacroIncludeFile <Amoeba.cf>
-#define MacroFile Amoeba.cf
-#if defined(i80386) || defined(__i80386__)
-#define i386Architecture
-#else
-#if defined(mc68000) || defined(__mc68000__)
-#define Sun3Architecture
-#define SunArchitecture
-#else
-#if defined(sparc) || defined(__sparc__)
-#define SparcArchitecture
-#define SunArchitecture
-#endif
-#endif
-#endif
-#undef i80386
-#undef mc68000
-#undef sparc
-#undef sun
-#endif /* AMOEBA */
-
-#ifdef sun
-#define MacroIncludeFile <sun.cf>
-#define MacroFile sun.cf
-#ifdef SVR4
-#undef SVR4
-#define SVR4Architecture
-#endif
-#ifdef sparc
-#undef sparc
-#define SparcArchitecture
-#endif
-#ifdef mc68000
-#undef mc68000
-#define Sun3Architecture
-#endif
-#ifdef i386
-#undef i386
-#define i386Architecture
-#endif
-#undef sun
-#define SunArchitecture
-#endif /* sun */
-
-#ifdef hpux
-#define MacroIncludeFile <hp.cf>
-#define MacroFile hp.cf
-#undef hpux
-#define HPArchitecture
-#endif /* hpux */
-
-#ifdef USL
-#define MacroIncludeFile <usl.cf>
-#define MacroFile usl.cf
-#undef USL
-#undef SVR4
-#define SVR4Architecture
-#define i386Architecture
-#endif /* USL */
-
-#ifdef NCR
-#define MacroIncludeFile <ncr.cf>
-#define MacroFile ncr.cf
-#undef NCR
-#undef SVR4
-#define SVR4Architecture
-#define i386Architecture
-#endif /* NCR */
-
-#ifdef apollo
-#define MacroIncludeFile <apollo.cf>
-#define MacroFile apollo.cf
-#undef apollo
-#define ApolloArchitecture
-#endif /* apollo */
-
-#ifdef sony
-#define MacroIncludeFile <sony.cf>
-#define MacroFile sony.cf
-#undef sony
-#undef sony_news
-#define SonyArchitecture
-#ifdef mc68020
-#undef mc68020
-#undef mc68030
-#define Mc68020Architecture
-#endif
-#ifdef mips
-#undef mips
-#define MipsArchitecture
-#endif
-#if !defined(bsd43) || defined(SYSTYPE_SYSV) || defined(_SYSTYPE_SYSV)
-#define SonySysvArchitecture
-#else
-#define SonyBsdArchitecture
-#endif
-#endif /* sony */
-
-#ifdef M4310
-#define MacroIncludeFile <pegasus.cf>
-#define MacroFile pegasus.cf
-#undef M4310
-#define PegasusArchitecture
-#endif /* M4310 */
-
-#ifdef M4330
-#define MacroIncludeFile <m4330.cf>
-#define MacroFile m4330.cf
-#undef M4330
-#define M4330Architecture
-#endif /* M4330 */
-
-#ifdef macII
-#define MacroIncludeFile <macII.cf>
-#define MacroFile macII.cf
-#undef macII
-#define MacIIArchitecture
-#endif /* macII */
-
-#ifdef __APPLE__
-# define MacroIncludeFile <MacOSX.cf>
-# define MacroFile MacOSX.cf
-# define MacOSXArchitecture
-# define DarwinArchitecture
-#endif
-
-#ifdef _CRAY
-#define MacroIncludeFile <cray.cf>
-#define MacroFile cray.cf
-#undef cray
-#undef CRAY
-#undef CRAY1
-#undef CRAY2
-#undef YMP
-#define CrayArchitecture
-#endif /* _CRAY */
-
-#ifdef sgi
-#define MacroIncludeFile <sgi.cf>
-#define MacroFile sgi.cf
-#undef sgi
-#define SGIArchitecture
-#undef mips
-#define MipsArchitecture
-#endif /* sgi */
-
-#ifdef stellar
-#define MacroIncludeFile <stellar.cf>
-#define MacroFile stellar.cf
-#undef stellar
-#define StellarArchitecture
-#endif /* stellar */
-
-#if defined(ibm) || defined(_IBMR2) || defined(ibm032) || defined(aix)
-#define MacroIncludeFile <ibm.cf>
-#define MacroFile ibm.cf
-#ifdef ibm
-#undef ibm
-#endif
-#define IBMArchitecture
-#ifdef i386
-#undef i386
-#define PS2Architecture
-#endif
-#ifdef ibm032
-#undef ibm032
-#define RtArchitecture
-#endif
-#ifdef aix
-#undef aix
-#define AIXArchitecture
-#endif
-#ifdef _IBMR2
-#undef _IBMR2
-#define RsArchitecture
-#endif
-#endif /* ibm */
-
-#ifdef luna
-#undef luna
-#define MacroIncludeFile <luna.cf>
-#define MacroFile luna.cf
-#define LunaArchitecture
-#ifdef mc68000
-#undef mc68000
-#define Mc68000Architecture
-#else
-#undef mc88000
-#define Mc88000Architecture
-#endif
-#endif /* luna */
-
-#ifdef Mips
-# define MacroIncludeFile <Mips.cf>
-# define MacroFile Mips.cf
-# undef Mips
-# undef mips
-# if defined(SYSTYPE_BSD43) || defined(BSD) || defined(BSD43)
-# define MipsBsdArchitecture
-# else /* BSD */
-# define MipsSysvArchitecture
-# endif /* BSD */
-#endif /* Mips */
-
-#ifdef MOTOROLA
-# define MacroIncludeFile <moto.cf>
-# define MacroFile moto.cf
-# undef MOTOROLA
-# ifdef SYSV
-# define MotoR3Architecture
-# endif
-# ifdef SVR4
-# define MotoR4Architecture
-# endif
-#endif /* MOTOROLA */
-
-#ifdef SVR4
-# ifdef i386
-# define i386Architecture
-# endif
-# define SVR4Architecture
-# define MacroIncludeFile <svr4.cf>
-# define MacroFile svr4.cf
-# undef SVR4
-#endif /* SVR4 */
-
-#ifdef SYSV
-# ifdef i386
-# define MacroIncludeFile <x386.cf>
-# define MacroFile x386.cf
-# define i386SVR3Architecture
-# endif
-#endif /* SYSV */
-
-#ifdef SYSV386
-# ifdef SVR4
-# define i386Architecture
-# define SVR4Architecture
-# define i386SVR4Architecture
-# define MacroIncludeFile <svr4.cf>
-# define MacroFile svr4.cf
-# undef SVR4
-# else
-# define MacroIncludeFile <x386.cf>
-# define MacroFile x386.cf
-# define i386SVR3Architecture
-# endif
-#endif /* SYSV386 */
-
-#ifdef DGUX
-#define MacroIncludeFile <DGUX.cf>
-#define MacroFile DGUX.cf
-#undef DGUX
-#define DguxArchitecture
-#endif /* DGUX */
-
-#ifdef __convex__
-# define MacroIncludeFile <convex.cf>
-# define MacroFile convex.cf
-# ifdef convex
-# undef convex
-# endif
-# define ConvexArchitecture
-#endif /* _convex_ */
-
-/* GF. #ifdef __osf__ */
-#if defined(__osf__) || defined(__alpha)
-#define MacroIncludeFile <osf1.cf>
-#define MacroFile osf1.cf
-#define OSF1Architecture
-#undef __osf__
-#ifdef __mips__
-#undef __mips__
-#define MipsArchitecture
-#endif
-#ifdef __alpha
-#undef __alpha
-#define AlphaArchitecture
-#endif
-#endif /* __osf__ */
-
-#ifdef Oki
-#define MacroIncludeFile <Oki.cf>
-#define MacroFile Oki.cf
-#undef Oki
-#define i860SVR4Architecture
-#endif /* Oki */
-
-#ifdef WIN32
-#define MacroIncludeFile <Win32.cf>
-#define MacroFile Win32.cf
-#define Win32Architecture
-#endif /* WIN32 */
-
-#ifdef linux
-#ifdef PPC
-#define MacroIncludeFile <linux-pmac.cf>
-#define MacroFile linux-pmac.cf
-#undef linux
-#undef PPC
-#define LinuxArchitecture
-#define PPCArchitecture
-#elif _LP64
-#define MacroIncludeFile <linux-lp64.cf>
-#define MacroFile linux-lp64.cf
-#undef linux
-#undef _LP64
-#define LinuxArchitecture
-#else
-#define MacroIncludeFile <linux.cf>
-#define MacroFile linux.cf
-#undef linux
-#define LinuxArchitecture
-#define i386Architecture
-#endif
-#endif /* linux */
-
-#ifdef __uxp__
-#define MacroIncludeFile <fujitsu.cf>
-#define MacroFile fujitsu.cf
-#undef __uxp__
-#ifdef sparc
-#undef sparc
-#define SparcArchitecture
-#endif
-#endif /* __uxp__ */
-
-#ifdef __sxg__
-#define MacroIncludeFile <fujitsu.cf>
-#define MacroFile fujitsu.cf
-#undef __sxg__
-#define mc68000Architecture
-#endif /* __sxg__ */
-
-#if defined(sequent) || defined(_SEQUENT_)
-# define MacroIncludeFile <sequent.cf>
-# define MacroFile sequent.cf
-# ifdef sequent
-# undef sequent
-# define Dynix3Architecture
-# endif
-# ifdef _SEQUENT_
-# undef _SEQUENT_
-# define DynixPtxArchitecture
-# endif
-# define SequentArchitecture
-#endif
-
-#if defined(_nec_ews_svr4) || defined(nec_ews_svr4) || defined(nec_ews_svr2) || defined(SX) || defined(_nec_up) || defined(_nec_ft) || defined(PC_UX)
-#ifdef nec
-#undef nec
-#endif
-#define MacroIncludeFile <nec.cf>
-#define MacroFile nec.cf
-#define NecArchitecture
-#endif
-
-#ifdef unix
-#undef unix
-#endif /* unix */
-
-#ifndef MacroIncludeFile
-XCOMM WARNING: Imake.cf not configured; guessing at definitions!!!
-XCOMM This might mean that BOOTSTRAPCFLAGS was not set when building imake.
-#define MacroIncludeFile <generic.cf>
-#define MacroFile generic.cf
-#endif
diff --git a/src/config/Imake.rules b/src/config/Imake.rules
deleted file mode 100644
index 25391c5..0000000
--- a/src/config/Imake.rules
+++ /dev/null
@@ -1,2494 +0,0 @@
-/* $Id: Imake.rules,v 1.25 2005/04/18 15:23:07 mclareni Exp $
- *
- * $Log: Imake.rules,v $
- * Revision 1.25 2005/04/18 15:23:07 mclareni
- * Mods submitted by Kevin B. McCarty to fix insecure Cernlib uses of /tmp.
- *
- * Revision 1.24 2000/04/19 10:51:00 mclareni
- * In gmake 3.79, strip fails if it is given 0 arguments
- *
- * Revision 1.23 1997/07/10 15:38:02 mclareni
- * Add commands to CppSedMagic to remove extra # lines in gxint321.f for HP and AIX
- *
- * Revision 1.22 1997/02/28 10:42:27 gunter
- * mods for WNT, Win32Path and PATHSEP
- *
- * merged in from WNT:
- * Revision 1.21 1997/01/29 16:34:48 cernlib
- * Correct in InstallIncludes the pattern rule.
- *
- * Revision 1.20 1997/01/09 08:45:13 cernlib
- * In rules for SubdirDataFile remove the extra CopyFile((subdir/file,file)
- * 1996/05/21 16:59:17 cernlib
- * add Expand and Append macros to replace Concat()
- *
- * Revision 1.19 1997/01/06 16:43:32 cernlib
- * Add conditional Motif.
- * Install removes only local filesonly if they are real files, but not symlinks.
- *
- * Revision 1.18 1996/11/13 13:26:49 cernlib
- * Add InstallSharedLibrary(...
- * Use $@ and $< for install.lib
- *
- * Revision 1.16 1996/05/15 13:37:04 cernlib
- * Change rules to install include files
- *
- * Revision 1.15 1996/05/09 14:25:56 cernlib
- * added rule to install include files
- *
- * Revision 1.14 1996/05/01 16:24:29 cernlib
- * Add rules to installinclude files
- *
- * Revision 1.13 1996/05/01 11:54:40 gunter
- * Introduce new way of building libraries.
- * CVS:----------------------------------------------------------------------
- *
- * Revision 1.12 1996/04/24 13:21:42 cernlib
- * Remove a redundant $(MAKE) Makefile in the tree rule.
- *
- * Revision 1.11 1996/04/03 07:37:42 cernlib
- * Use $< and $@ for InstallNamedTarget; this allows to pick up sources from
- * VPATH
- *
- * Revision 1.10 1996/04/01 15:34:00 cernlib
- * New rules for installing data files;
- * new rules to make data files available to tests
- *
- * Revision 1.9 1996/03/08 17:12:06 cernlib
- * *** empty log message ***
- *
- * Revision 1.8 1996/02/29 10:38:48 cernlib
- * Add DoIncludePackage to Imake.rules
- * Correct compiel options in osf1.cf,sun.cf
- *
- * Revision 1.7 1996/02/23 17:16:39 cernlib
- * add provsions for X11/ Motfid include files.
- * and some other small corrections
- *
- * Revision 1.6 1996/02/14 11:03:28 cernlib
- * add provisions for running tests
- *
- * Revision 1.5 1996/02/12 14:21:16 cernlib
- * a library now depends (indirectly) on all the objects therein
- *
- * Revision 1.4 1996/02/08 08:28:13 cernlib
- * hp.cf:remove +ESlit from cc options
- * imake.rules: new rules to get name of package lib ( incomplete )
- * biglib.rules: add ranlib
- *
- * Revision 1.3 1996/01/25 11:22:34 cernlib
- * Values for IMAKE and MAKEDEPEND are used from env. variables if defined, else
- * from command search path.
- * Correct fortran options for local (not archive,..) compilation.
- *
- * Revision 1.2 1995/12/21 11:32:03 cernlib
- * Imake files end 1995
- *
- * Revision 1.1.1.1 1995/12/20 15:26:46 cernlib
- * X11R6 config files unmodified
- *
- *
- */
-XCOMM -----------------------------------------------------------------------
-XCOMM Imake rules for building libraries, programs, scripts, and data files
-XCOMM rules: $XConsortium: Imake.rules,v 1.197.1.1 95/06/19 18:01:48 gildea Exp $
-
-/*
- * MACHINE-INDEPENDENT RULES; DO NOT MODIFY
- *
- * Warning, when defining rules: make sure you do not include both a trailing
- * backslash and double ampersand backslash or else you will get an extra
- * backslash in the Makefile.
- *
- * The following macros are defined for the various templates and Imakefiles
- * (for a list of the applicable make variables, see the template files):
- *
- * Append (a,b)
- * Concat (a,b)
- * Concat3 (a,b,c)
- * Concat4 (a,b,c,d)
- * Expand (a)
- * _Use (a,b)
- * _UseCat (a,b,c)
- * ProgramTargetName (target)
- * RunProgram (progvar,options)
- * RemoveFile (file)
- * RemoveFiles (files)
- * CenterLoadTarget (target,srclist,libs,defines)
- * CenterProgramTarget (program,srclist,objlist,locallibs,syslibs)
- * SentinelLinkTarget (step,program,linklist)
- * SentinelProgramTarget (program,deplist,linklist)
- * SentinelCplusplusProgramTarget (program,deplist,linklist)
- * PurifyLinkTarget (step,program,linklist)
- * PurifyProgramTarget (program,deplist,linklist)
- * PurifyCplusplusProgramTarget (program,deplist,linklist)
- * ProofLinkTarget (step,program,linklist)
- * ProofProgramTarget (program,deplist,linklist)
- * ProofCplusplusProgramTarget (program,deplist,linklist)
- * ProofCleanTarget ()
- * RemoveTargetProgram (program)
- * MakeDir (dir)
- * BuildIncludesTop (srclist)
- * BuildIncludes (srclist,dstsubdir,dstupdir)
- * LinkRule (program,options,objects,libraries)
- * HostLinkRule (program,options,objects,libraries)
- * NormalProgramTarget (program,objects,deplibs,locallibs,syslibs)
- * SetUIDProgramTarget (program,objects,deplibs,locallibs,syslibs)
- * SingleProgramTarget (program,objects,locallibs,syslibs)
- * SimpleProgramTarget (program)
- * ComplexProgramTarget (program)
- * ComplexProgramTarget_1 (program,locallib,syslib)
- * ComplexProgramTarget_2 (program,locallib,syslib)
- * ComplexProgramTarget_3 (program,locallib,syslib)
- * ServerTargetWithFlags (server,subdirs,objects,libs,syslibs,flags)
- * ServerTarget (server,subdirs,objects,libs,syslibs)
- * MoveToBakFile (file)
- * RMoveToBakFile (file)
- * RanLibrary (args)
- * LibraryTargetName (libname)
- * LibraryTargetNameSuffix (libname,suffix)
- * InstallNamedTarget (step,srcname,flags,dest,dstname)
- * InstallTarget (step,file,flags,dest)
- * InstallLibrary (libname,dest)
- * MergeIntoInstalledLibrary (tolib,fromlib)
- * InstallLibraryAlias (libname,alias,dest)
- * InstallLintLibrary (libname,dest)
- * InstallManPageLong (file,destdir,dest)
- * InstallManPage (file,destdir)
- * InstallManPageAliases (file,destdir,aliases)
- * InstallNamedNonExec (srcname,dstname,dest)
- * InstallNonExecFile (file,dest)
- * InstallNonExec (file,dest)
- * InstallProgramWithFlags (program,dest,flags)
- * InstallProgram (program,dest)
- * InstallScript (program,dest)
- * InstallNamedProg (srcname,dstname,dest)
- * LinkFileList (step,list,dir,sub)
- * InstallMultipleDestFlags (step,list,dest,flags)
- * InstallMultipleDest (step,list,dest)
- * InstallMultiple (list,dest)
- * InstallMultipleFlags (list,dest,flags)
- * InstallMultipleMan (list,dest)
- * DependDependency ()
- * DependTarget ()
- * DependTarget3 (srcs1,srcs2,srcs3)
- * CleanTarget ()
- * TagsTarget ()
- * ImakeDependency (target)
- * BuildMakefileTarget (notused,imakeflags)
- * MakefileTarget ()
- * LibMkdir (dir)
- * LibCleanDir (dir)
- * LintLibReferences (varname,libname,libsource)
- * UnsharedLibReferences (varname,libname,libsource)
- * SharedLibDependencies (libname,libsource,revname)
- * SharedDSLibDependencies (libname,libsource,revname)
- * SharedLibReferences (varname,libname,libsource,revname,rev)
- * SharedDSLibReferences (varname,libname,libsource,revname,rev)
- * ObjectCompile (options)
- * NormalLibObjCompile (options)
- * NormalSharedLibObjCompile (options)
- * LibObjCompile (dir,options)
- * DebuggedLibObjCompile (options)
- * ProfiledLibObjCompile (options)
- * SharedLibObjCompile (options)
- * NormalLibraryObjectRule ()
- * NormalFortranObjectRule ()
- * ObjectFromSpecialSource (dst,src,flags)
- * SpecialObjectRule (objs,depends,options)
- * SpecialCObjectRule (basename,depends,options)
- * LexFile (file)
- * YaccFile (file,flags)
- * MakeLibrary (libname,objlist)
- * NormalLibraryTarget (libname,objlist)
- * NormalLibraryTarget2 (libname,objlist1,objlist2)
- * NormalLibraryTarget3 (libname,objlist1,objlist2,objlist3)
- * NormalDepLibraryTarget (libname,deplist,objlist)
- * UnsharedLibraryTarget (libname,objlist,down,up)
- * UnsharedLibraryTarget3 (libname,objlist1,objlist2,objlist3,down,up)
- * SubdirLibraryRule (objlist)
- * ProfiledLibraryTarget (libname,objlist)
- * DebuggedLibraryTarget (libname,objlist)
- * AliasedLibraryTarget (libname,alias)
- * NormalRelocatableTarget (objname,objlist)
- * ProfiledRelocatableTarget (objname,objlist)
- * DebuggedRelocatableTarget (objname,objlist)
- * LintLibraryTarget (libname,srclist)
- * NormalLintTarget (srclist)
- * LintTarget ()
- * LinkSourceFile (src,dir)
- * LinkFile (tofile,fromfile)
- * MakeSubincludesForBuild (step,dir,srclist)
- * NamedTargetSubdirs (name,dirs,verb,flags,subname)
- * NamedMakeSubdirs (name,dirs)
- * MakeSubdirs (dirs)
- * DependSubdirs (dirs)
- * ForceSubdirs (dirs)
- * InstallSubdirs (dirs)
- * InstallManSubdirs (dirs)
- * IncludesSubdirs (dirs)
- * NamedCleanSubdirs (name,dirs)
- * CleanSubdirs (dirs)
- * NamedTagSubdirs (name,dirs)
- * TagSubdirs (dirs)
- * MakeLintSubdirs (dirs,target,subtarget)
- * LintSubdirs (dirs)
- * MakeLintLibSubdirs (dirs)
- * MakeMakeSubdirs (dirs,target)
- * MakefileSubdirs (dirs)
- * CppScriptTarget (dst,src,defs,deplist)
- * MakeScriptFromCpp (name,defs)
- * CppFileTarget (dst,src,defs,deplist)
- * MakeDirectories (step,dirs)
- * AllTarget (depends)
- *
- *
- * The following are in specific <os>Lib.rules:
- *
- * SharedLibraryTarget (libname,rev,solist,down,up)
- * SharedLibraryDataTarget (libname,rev,salist)
- * InstallSharedLibrary (libname,rev,dest)
- * InstallSharedLibraryData (libname,rev,dest)
- *
- */
-
-#define NullParameter
-
-/* if [ -d ] or [ ! -d ] causes make to fail, define this as - */
-#ifndef DirFailPrefix
-#define DirFailPrefix
-#endif
-
-#ifndef Expand
-#define Expand(a)a
-#endif
-
-/*
- * Concat - concatenates two strings.
- */
-#ifndef Concat
-#if (__STDC__ && !defined(UnixCpp)) || defined(AnsiCpp)
-#define Concat(a,b)a##b
-#else
-#define Concat(a,b)a/**/b
-#endif
-#endif
-
-#ifndef Append
-#define Append(a,b)Concat(Expand(a),b)
-#endif
-
-/*
- * Concat3 - concatenates three strings.
- */
-#ifndef Concat3
-#if (__STDC__ && !defined(UnixCpp)) || defined(AnsiCpp)
-#define Concat3(a,b,c)a##b##c
-#else
-#define Concat3(a,b,c)a/**/b/**/c
-#endif
-#endif
-
-/*
- * Concat4 - concatenates four strings.
- */
-#ifndef Concat4
-#if (__STDC__ && !defined(UnixCpp)) || defined(AnsiCpp)
-#define Concat4(a,b,c,d)a##b##c##d
-#else
-#define Concat4(a,b,c,d)a/**/b/**/c/**/d
-#endif
-#endif
-
-/*
- * _Use - makes a choice based on UseInstalled.
- */
-#ifndef _Use
-#ifdef UseInstalled
-#define _Use(a,b) a
-#else
-#define _Use(a,b) b
-#endif
-#endif /* _Use */
-
-/*
- * _UseCat - combination of _Use and Concat.
- * exists to avoid problems with some preprocessors
- */
-#ifndef _UseCat
-#if (__STDC__ && !defined(UnixCpp)) || defined(AnsiCpp)
-#ifdef UseInstalled
-#define _UseCat(a,b,c) a##c
-#else
-#define _UseCat(a,b,c) b##c
-#endif
-#else
-#ifdef UseInstalled
-#define _UseCat(a,b,c) a/**/c
-#else
-#define _UseCat(a,b,c) b/**/c
-#endif
-#endif
-#endif /* _UseCat */
-
-#ifndef ProgramTargetName
-#define ProgramTargetName(target)target
-#endif
-
-#ifndef RunProgram
-#define RunProgram(progvar,options) $(progvar) options
-#endif
-
-#ifndef RemoveFile
-#define RemoveFile(file) $(RM) file
-#endif /* RemoveFile */
-
-#ifndef RemoveFiles
-#define RemoveFiles(files) $(RM) files
-#endif /* RemoveFiles */
-
-/*
- * CenterLoadTarget - generate rules to load files into CodeCenter
- */
-#ifndef CenterLoadTarget
-#if HasCodeCenter
-#define CenterLoadTarget(target,srclist,libs,defines) @@\
-ProgramTargetName(target):: srclist @@\
- XCOMM load defines srclist libs
-#else
-#define CenterLoadTarget(target,srclist,libs,defines) /**/
-#endif
-#endif /* CenterLoadTarget */
-
-/*
- * CenterProgramTarget - generate rules to make CodeCenter read in sources
- * and objects.
- */
-#ifndef CenterProgramTarget
-#define CenterProgramTarget(program,srclist,objlist,locallibs,syslibs) @@\
-CenterLoadTarget(Concat(debug_,program),srclist,$(EXTRA_LDOPTIONS) $(LOCAL_LDFLAGS) $(LDPRELIB) locallibs $(LDLIBS) syslibs,$(ALLDEFINES)) @@\
- @@\
-CenterLoadTarget(Concat(odebug_,program),objlist,$(EXTRA_LDOPTIONS) $(LOCAL_LDFLAGS) $(LDPRELIB) locallibs $(LDLIBS) syslibs,$(ALLDEFINES))
-#endif /* CenterProgramTarget */
-
-#ifndef SentinelLinkTarget
-#if HasSentinel
-#define SentinelLinkTarget(step,program,linklist) @@\
-ProgramTargetName(step.sentinel): @@\
- RemoveTargetProgram($@) @@\
- $(CCENVSETUP) $(SENTINEL) $(SENTINELOPTIONS) $(CC) -o program.sentinel $(LDOPTIONS) linklist $(EXTRA_LOAD_FLAGS)
-#else
-#define SentinelLinkTarget(step,program,linklist) /**/
-#endif
-#endif /* SentinelLinkTarget */
-
-/*
- * SentinelProgramTarget - generate rules to make Sentinel image
- */
-#ifndef SentinelProgramTarget
-#if HasSentinel
-#define SentinelProgramTarget(program,deplist,linklist) @@\
-ProgramTargetName(program.sentinel): deplist @@\
- RemoveTargetProgram($@) @@\
- $(CCENVSETUP) $(SENTINEL) $(SENTINELOPTIONS) $(CC) -o $@ $(LDOPTIONS) linklist $(EXTRA_LOAD_FLAGS) @@\
- @@\
-clean clean.sentinel:: @@\
- RemoveFile(program.sentinel)
-#else
-#define SentinelProgramTarget(program,deplist,linklist) /**/
-#endif
-#endif /* SentinelProgramTarget */
-
-/*
- * SentinelCplusplusProgramTarget - generate rules to make Sentinel image
- */
-#ifndef SentinelCplusplusProgramTarget
-#if HasSentinel
-#define SentinelCplusplusProgramTarget(program,deplist,linklist) @@\
-ProgramTargetName(program.sentinel): deplist @@\
- RemoveTargetProgram($@) @@\
- $(CXXENVSETUP) $(SENTINEL) $(SENTINELOPTIONS) $(CXX) -o $@ $(CXXLDOPTIONS) linklist $(EXTRA_LOAD_FLAGS) @@\
- @@\
-clean clean.sentinel:: @@\
- RemoveFile(program.sentinel)
-#else
-#define SentinelCplusplusProgramTarget(program,deplist,linklist) /**/
-#endif
-#endif /* SentinelCplusplusProgramTarget */
-
-#ifndef PurifyLinkTarget
-#if HasPurify
-#define PurifyLinkTarget(step,program,linklist) @@\
-ProgramTargetName(step.pure): @@\
- RemoveTargetProgram($@) @@\
- $(CCENVSETUP) $(PURIFY) $(PURIFYOPTIONS) $(CC) -o program.pure $(LDOPTIONS) linklist $(EXTRA_LOAD_FLAGS)
-#else
-#define PurifyLinkTarget(step,program,linklist) /**/
-#endif
-#endif /* PurifyLinkTarget */
-
-/*
- * PurifyProgramTarget - generate rules to make Purify'ed image
- */
-#ifndef PurifyProgramTarget
-#if HasPurify
-#define PurifyProgramTarget(program,deplist,linklist) @@\
-ProgramTargetName(program.pure): deplist @@\
- RemoveTargetProgram($@) @@\
- $(CCENVSETUP) $(PURIFY) $(PURIFYOPTIONS) $(CC) -o $@ $(LDOPTIONS) linklist $(EXTRA_LOAD_FLAGS) @@\
- @@\
-clean clean.pure:: @@\
- RemoveFile(program.pure)
-#else
-#define PurifyProgramTarget(program,deplist,linklist) /**/
-#endif
-#endif /* PurifyProgramTarget */
-
-/*
- * PurifyCplusplusProgramTarget - generate rules to make Purify'ed image
- */
-#ifndef PurifyCplusplusProgramTarget
-#if HasPurify
-#define PurifyCplusplusProgramTarget(program,deplist,linklist) @@\
-ProgramTargetName(program.pure): deplist @@\
- RemoveTargetProgram($@) @@\
- $(CXXENVSETUP) $(PURIFY) $(PURIFYOPTIONS) $(CXX) -o $@ $(CXXLDOPTIONS) linklist $(EXTRA_LOAD_FLAGS) @@\
- @@\
-clean clean.pure:: @@\
- RemoveFile(program.pure)
-#else
-#define PurifyCplusplusProgramTarget(program,deplist,linklist) /**/
-#endif
-#endif /* PurifyCplusplusProgramTarget */
-
-#ifndef ProofLinkTarget
-#if HasTestCenter
-#define ProofLinkTarget(step,program,linklist) @@\
-ProgramTargetName(step.tc): @@\
- RemoveTargetProgram($@) @@\
- $(CCENVSETUP) $(PROOF) $(PROOFOPTIONS) $(CC) -o program.tc $(LDOPTIONS) linklist $(EXTRA_LOAD_FLAGS)
-#else
-#define ProofLinkTarget(step,program,linklist) /**/
-#endif
-#endif /* ProofLinkTarget */
-
-/*
- * ProofProgramTarget - generate rules to make Proof'ed image
- */
-#ifndef ProofProgramTarget
-#if HasTestCenter
-#define ProofProgramTarget(program,deplist,linklist) @@\
-ProgramTargetName(program.tc): deplist @@\
- RemoveTargetProgram($@) @@\
- $(CCENVSETUP) $(PROOF) $(PROOFOPTIONS) $(CC) -o $@ $(LDOPTIONS) linklist $(EXTRA_LOAD_FLAGS) @@\
- @@\
-clean clean.tc:: @@\
- RemoveFiles(program.tc program.tc.*.*)
-#else
-#define ProofProgramTarget(program,deplist,linklist) /**/
-#endif
-#endif /* ProofProgramTarget */
-
-/*
- * ProofCplusplusProgramTarget - generate rules to make Proof'ed image
- */
-#ifndef ProofCplusplusProgramTarget
-#if HasTestCenter
-#define ProofCplusplusProgramTarget(program,deplist,linklist) @@\
-ProgramTargetName(program.tc): deplist @@\
- RemoveTargetProgram($@) @@\
- $(CXXENVSETUP) $(PROOF) $(PROOFOPTIONS) $(CXX) -o $@ $(CXXLDOPTIONS) linklist $(EXTRA_LOAD_FLAGS) @@\
- @@\
-clean clean.tc:: @@\
- RemoveFiles(program.tc program.tc.*.*)
-#else
-#define ProofCplusplusProgramTarget(program,deplist,linklist) /**/
-#endif
-#endif /* ProofCplusplusProgramTarget */
-
-#ifndef ProofCleanTarget
-#if HasTestCenter
-#define ProofCleanTarget() @@\
-clean clean.tc:: @@\
- $(RM) -r TC.Cache
-#else
-#define ProofCleanTarget() /**/
-#endif
-#endif /* ProofCleanTarget */
-
-#ifndef RemoveTargetProgram
-#if RemoveTargetProgramByMoving
-#define RemoveTargetProgram(program) \
--if [ -f program ]; then RemoveFile(Concat(program,~)); $(MV) program Concat(program,~); fi
-#else
-#define RemoveTargetProgram(program) RemoveFile(program)
-#endif
-#endif /* RemoveTargetProgram */
-
-#ifndef MakeDir
-#define MakeDir(dir) DirFailPrefix at if [ -d dir ]; then set +x; \ @@\
- else (set -x; $(MKDIRHIER) dir); fi
-#endif /* MakeDir */
-
-#ifndef BuildIncludesTop
-#define BuildIncludesTop(srclist) @@\
-includes:: @@\
- MakeDir($(BUILDINCDIR)) @@\
- @(set -x; cd $(BUILDINCDIR); for i in srclist; do \ @@\
- RemoveFile($$i); \ @@\
- $(LN) $(BUILDINCTOP)/$(CURRENT_DIR)/$$i .; \ @@\
- done)
-#endif /* BuildIncludesTop */
-
-#ifndef BuildIncludes
-#define BuildIncludes(srclist,dstsubdir,dstupdir) @@\
-includes:: @@\
- MakeDir($(BUILDINCDIR)/dstsubdir) @@\
- @(set -x; cd $(BUILDINCDIR)/dstsubdir; for i in srclist; do \ @@\
- RemoveFile($$i); \ @@\
- $(LN) $(BUILDINCTOP)/dstupdir/$(CURRENT_DIR)/$$i .; \ @@\
- done)
-#endif /* BuildIncludes */
-
-#ifndef BuildInterfaces
-#define BuildInterfaces(srclist,dstsubdir,dstupdir) @@\
-interfaces:: @@\
- MakeDir($(BUILDINCDIR)/dstsubdir) @@\
- @(set -x; cd $(BUILDINCDIR)/dstsubdir; for i in srclist; do \ @@\
- RemoveFile($$i); \ @@\
- $(LN) $(BUILDINCTOP)/dstupdir/$(CURRENT_DIR)/$$i .; \ @@\
- done)
-#endif /* BuildInterfaces */
-
-/*
- * LinkRule - link a program
- */
-#ifndef LinkRule
-#define LinkRule(program,options,objects,libraries) \
-$(CCLINK) -o program options objects libraries $(EXTRA_LOAD_FLAGS)
-#endif /* LinkRule */
-
-/*
- * HostLinkRule - link a utility to be used on the build host
- * (differs from LinkRule if cross compiling)
- */
-#ifndef HostLinkRule
-#define HostLinkRule LinkRule
-#endif
-
-#ifndef CplusplusLinkRule
-#define CplusplusLinkRule(program,options,objects,libraries) \
-$(CXXLINK) -o program options objects libraries $(EXTRA_LOAD_FLAGS)
-#endif /* CplusplusLinkRule */
-
-/*
- * NormalProgramTarget - generate rules to compile and link the indicated
- * program; since it does not use any default object files, it may be used for
- * multiple programs in the same Imakefile.
- */
-#ifndef NormalProgramTarget
-#define NormalProgramTarget(program,objects,deplibs,locallibs,syslibs) @@\
-ProgramTargetName(program): objects deplibs @@\
- RemoveTargetProgram($@) @@\
- LinkRule($@,$(LDOPTIONS),objects,locallibs $(LDLIBS) syslibs) @@\
- @@\
-SentinelProgramTarget(program,objects deplibs,objects locallibs $(LDLIBS) syslibs) @@\
-PurifyProgramTarget(program,objects deplibs,objects locallibs $(LDLIBS) syslibs) @@\
-ProofProgramTarget(program,objects deplibs,objects locallibs $(LDLIBS) syslibs) @@\
- @@\
-clean:: @@\
- RemoveFile(ProgramTargetName(program))
-#endif /* NormalProgramTarget */
-
-
-/*
- * NormalCplusplusProgramTarget - Like NormalTargetProgram, but uses
- * C++ linking rules.
- */
-#ifndef NormalCplusplusProgramTarget
-#define NormalCplusplusProgramTarget(program,objects,deplibs,locallibs,syslibs) @@\
-ProgramTargetName(program): objects deplibs @@\
- RemoveTargetProgram($@) @@\
- CplusplusLinkRule($@,$(CXXLDOPTIONS),objects,locallibs $(LDLIBS) syslibs) @@\
- @@\
-SentinelCplusplusProgramTarget(program,objects deplibs,objects locallibs $(LDLIBS) syslibs) @@\
-PurifyCplusplusProgramTarget(program,objects deplibs,objects locallibs $(LDLIBS) syslibs) @@\
-ProofCplusplusProgramTarget(program,objects deplibs,objects locallibs $(LDLIBS) syslibs) @@\
- @@\
-clean:: @@\
- RemoveFile(ProgramTargetName(program))
-#endif /* NormalCplusplusProgramTarget */
-
-
-#ifndef SetUIDProgramTarget
-#define SetUIDProgramTarget NormalProgramTarget
-#endif
-
-
-/*
- * SingleProgramTarget - obsolete version of NormalProgramTarget that does
- * not have deplibs.
- */
-#ifndef SingleProgramTarget
-#define SingleProgramTarget(program,objects,locallibs,syslibs) @@\
-NormalProgramTarget(program,objects,NullParameter,locallibs,syslibs)
-#endif /* SingleProgramTarget */
-
-/*
- * SimpleProgramTarget - generate rules for compiling and linking programs
- * that only have one C source file. It should only be used in Imakefiles
- * that describe a single program.
- */
-#ifndef SimpleProgramTarget
-#define SimpleProgramTarget(program) @@\
- OBJS = program.o @@\
- SRCS = program.c @@\
- @@\
-ComplexProgramTarget(program)
-#endif /* SimpleProgramTarget */
-
-#ifndef SimpleCplusplusProgramTarget
-#define SimpleCplusplusProgramTarget(program) @@\
- OBJS = program.o @@\
- SRCS = program.CCsuf @@\
- @@\
-ComplexCplusplusProgramTarget(program)
-#endif /* SimpleCplusplusProgramTarget */
-
-#ifndef ProgramTargetHelper
-#define ProgramTargetHelper(program,srcs,objs,deplib,locallib,syslib) @@\
-ProgramTargetName(program): $(objs) $(deplib) @@\
- RemoveTargetProgram($@) @@\
- LinkRule($@,$(LDOPTIONS),$(objs),locallib $(LDLIBS) syslib) @@\
- @@\
-CenterProgramTarget(program,$(srcs),$(objs),locallib,syslib) @@\
-SentinelProgramTarget(program,$(objs) $(deplib),$(objs) locallib $(LDLIBS) syslib) @@\
-PurifyProgramTarget(program,$(objs) $(deplib),$(objs) locallib $(LDLIBS) syslib) @@\
-ProofProgramTarget(program,$(objs) $(deplib),$(objs) locallib $(LDLIBS) syslib) @@\
- @@\
-InstallProgram(program,$(BINDIR)) @@\
-InstallManPage(program,$(MANDIR))
-#endif /* ProgramTargetHelper */
-
-#ifndef CplusplusProgramTargetHelper
-#define CplusplusProgramTargetHelper(program,srcs,objs,deplib,locallib,syslib) @@\
-ProgramTargetName(program): $(objs) $(deplib) @@\
- RemoveTargetProgram($@) @@\
- CplusplusLinkRule($@,$(CXXLDOPTIONS),$(objs),locallib $(LDLIBS) syslib) @@\
- @@\
-CenterProgramTarget(program,$(srcs),$(objs),locallib,syslib) @@\
-SentinelCplusplusProgramTarget(program,$(objs) $(deplib),$(objs) locallib $(LDLIBS) syslib) @@\
-PurifyCplusplusProgramTarget(program,$(objs) $(deplib),$(objs) locallib $(LDLIBS) syslib) @@\
-ProofCplusplusProgramTarget(program,$(objs) $(deplib),$(objs) locallib $(LDLIBS) syslib) @@\
- @@\
-InstallProgram(program,$(BINDIR)) @@\
-InstallManPage(program,$(MANDIR))
-#endif /* CplusplusProgramTargetHelper */
-
-/*
- * ComplexProgramTarget - generate rules for compiling and linking the
- * program specified by $(OBJS) and $(SRCS), installing the program and its
- * man page, and generating dependencies. It should only be used in
- * Imakefiles that describe a single program.
- */
-#ifndef ComplexProgramTarget
-#define ComplexProgramTarget(program) @@\
- PROGRAM = program @@\
- @@\
-AllTarget(program) @@\
- @@\
-ProgramTargetHelper(program,SRCS,OBJS,DEPLIBS,$(LOCAL_LIBRARIES),NullParameter) @@\
- @@\
-DependTarget() @@\
-LintTarget() @@\
- @@\
-clean:: @@\
- RemoveFile(ProgramTargetName(program))
-#endif /* ComplexProgramTarget */
-
-#ifndef ComplexCplusplusProgramTarget
-#define ComplexCplusplusProgramTarget(program) @@\
- PROGRAM = program @@\
- @@\
-AllTarget(program) @@\
- @@\
-CplusplusProgramTargetHelper(program,SRCS,OBJS,DEPLIBS,$(LOCAL_LIBRARIES),NullParameter) @@\
- @@\
-DependTarget() @@\
-LintTarget() @@\
- @@\
-clean:: @@\
- RemoveFile(ProgramTargetName(program))
-#endif /* ComplexCplusplusProgramTarget */
-
-/*
- * ComplexProgramTarget_1 - generate rules for compiling and linking the
- * program specified by $(OBJS1) and $(SRCS1), installing the program and its
- * man page, and generating dependencies for it and any programs described
- * by $(SRCS2) and $(SRCS3). It should be used to build the primary
- * program in Imakefiles that describe multiple programs.
- */
-#ifndef ComplexProgramTarget_1
-#define ComplexProgramTarget_1(program,locallib,syslib) @@\
- OBJS = $(OBJS1) $(OBJS2) $(OBJS3) @@\
- SRCS = $(SRCS1) $(SRCS2) $(SRCS3) @@\
- @@\
-AllTarget($(PROGRAMS)) @@\
- @@\
-ProgramTargetHelper(program,SRCS1,OBJS1,DEPLIBS1,locallib,syslib) @@\
- @@\
-DependTarget() @@\
-LintTarget() @@\
- @@\
-clean:: @@\
- RemoveFiles($(PROGRAMS))
-#endif /* ComplexProgramTarget_1 */
-
-#ifndef ComplexCplusplusProgramTarget_1
-#define ComplexCplusplusProgramTarget_1(program,locallib,syslib) @@\
- OBJS = $(OBJS1) $(OBJS2) $(OBJS3) @@\
- SRCS = $(SRCS1) $(SRCS2) $(SRCS3) @@\
- @@\
-AllTarget($(PROGRAMS)) @@\
- @@\
-CplusplusProgramTargetHelper(program,SRCS1,OBJS1,DEPLIBS1,locallib,syslib)@@\
- @@\
-DependTarget() @@\
-LintTarget() @@\
- @@\
-clean:: @@\
- RemoveFiles($(PROGRAMS))
-#endif /* ComplexCplusplusProgramTarget_1 */
-
-/*
- * ComplexProgramTarget_2 - generate rules for compiling and linking the
- * program specified by $(OBJS2) and $(SRCS2) and installing the program and
- * man page. It should be used to build the second program in Imakefiles
- * describing more than one program.
- */
-#ifndef ComplexProgramTarget_2
-#define ComplexProgramTarget_2(program,locallib,syslib) @@\
-ProgramTargetHelper(program,SRCS2,OBJS2,DEPLIBS2,locallib,syslib)
-#endif /* ComplexProgramTarget_2 */
-
-#ifndef ComplexCplusplusProgramTarget_2
-#define ComplexCplusplusProgramTarget_2(program,locallib,syslib) @@\
-CplusplusProgramTargetHelper(program,SRCS2,OBJS2,DEPLIBS2,locallib,syslib)
-#endif /* ComplexCplusplusProgramTarget_2 */
-
-/*
- * ComplexProgramTarget_3 - generate rules for compiling and linking the
- * program specified by $(OBJS3) and $(SRCS3) and installing the program and
- * man page. It should be used to build the third program in Imakefiles
- * describing more than one program.
- */
-#ifndef ComplexProgramTarget_3
-#define ComplexProgramTarget_3(program,locallib,syslib) @@\
-ProgramTargetHelper(program,SRCS3,OBJS3,DEPLIBS3,locallib,syslib)
-#endif /* ComplexProgramTarget_3 */
-
-#ifndef ComplexCplusplusProgramTarget_3
-#define ComplexCplusplusProgramTarget_3(program,locallib,syslib) @@\
-CplusplusProgramTargetHelper(program,SRCS3,OBJS3,DEPLIBS3,locallib,syslib)
-#endif /* ComplexCplusplusProgramTarget_3 */
-
-#ifndef MoveToBakFile
-#define MoveToBakFile(file) - at if [ -f file ]; then set -x; \ @@\
- $(MV) file file.bak; else exit 0; fi
-#endif /* MoveToBakFile */
-
-#ifndef RMoveToBakFile
-#define RMoveToBakFile(file) - at if [ -f file ]; then set -x; \ @@\
- RemoveFile(file.bak); $(MV) file file.bak; \ @@\
- else exit 0; fi
-#endif /* RMoveToBakFile */
-
-/*
- * ServerTargetWithFlags - generate rules to compile, link, and relink a server
- */
-#ifndef ServerTargetWithFlags
-#define ServerTargetWithFlags(server,subdirs,objects,libs,syslibs,flags) @@\
-AllTarget(server) @@\
-ProgramTargetName(server): subdirs objects libs @@\
- MoveToBakFile($@) @@\
- LinkRule($@,$(LDOPTIONS),objects,libs $(LDLIBS) syslibs) @@\
- @@\
-Concat(load,server): @@\
- MoveToBakFile(ProgramTargetName(server)) @@\
- LinkRule(ProgramTargetName(server),$(LDOPTIONS),objects,libs $(LDLIBS) syslibs) @@\
- @@\
-loadX:: Concat(load,server) @@\
- @@\
-SentinelProgramTarget(server,subdirs objects libs,objects libs $(LDLIBS) syslibs) @@\
-SentinelLinkTarget(Concat(load,server),server,objects libs $(LDLIBS) syslibs) @@\
-PurifyProgramTarget(server,subdirs objects libs,objects libs $(LDLIBS) syslibs) @@\
-PurifyLinkTarget(Concat(load,server),server,objects libs $(LDLIBS) syslibs) @@\
-ProofProgramTarget(server,subdirs objects libs,objects libs $(LDLIBS) syslibs) @@\
-ProofLinkTarget(Concat(load,server),server,objects libs $(LDLIBS) syslibs) @@\
- @@\
-InstallProgramWithFlags(server,$(BINDIR),flags) @@\
- @@\
-clean:: @@\
- RemoveFile(ProgramTargetName(server))
-#endif /* ServerTargetWithFlags */
-
-/*
- * ServerTarget - rules to compile, link, and relink a normal server
- */
-#ifndef ServerTarget
-#define ServerTarget(server,subdirs,objects,libs,syslibs) @@\
-ServerTargetWithFlags(server,subdirs,objects,libs,syslibs,$(_NOOP_))
-#endif /* ServerTarget */
-
-#if DoRanlibCmd
-#define RanLibrary(args) $(RANLIB) args
-#else
-#define RanLibrary(args) $(_NULLCMD_)
-#endif
-
-#ifndef LibraryTargetName
-#define LibraryTargetName(libname)Concat(lib,libname.a)
-#endif
-
-#ifndef LibraryTargetNameSuffix
-#define LibraryTargetNameSuffix(libname,suffix)Concat3(lib,libname,suffix.a)
-#endif
-
-#if 0
- This is repleced by rule below; install only if we have a nerwer file
-#ifndef InstallNamedTarget
-#define InstallNamedTarget(step,srcname,flags,dest,dstname) @@\
-step:: srcname @@\
- MakeDir($(DESTDIR)dest) @@\
- $(INSTALL) $(INSTALLFLAGS) flags srcname $(DESTDIR)dest/dstname
-#endif /* InstallNamedTarget */
-#endif
-
-#ifndef InstallNamedTarget
-#define InstallNamedTarget(step,srcname,flags,dest,dstname) @@\
-step:: $(DESTDIR)dest/dstname @@\
- @@\
-$(DESTDIR)dest/dstname: srcname @@\
- MakeDir($(@D)) @@\
- RemoveFile($@) @@\
- $(INSTALL) $(INSTALLFLAGS) flags $< $@ @@\
- @if [ -r $(<F) ]; then RemoveFile($(<F));$(LN) $@ $(<F); \ @@\
- else true;fi
-#endif /* InstallNamedTarget */
-
-
-#ifndef InstallTarget
-#define InstallTarget(step,file,flags,dest) @@\
-InstallNamedTarget(step,file,flags,dest,file)
-#endif /* InstallTarget */
-
-/*
- * InstallLibrary - generate rules to install the indicated library.
- */
-#ifndef InstallLibrary
-#define InstallLibrary(libname,dest) @@\
-.PHONY: install.lib lib/libname @@\
-lib/libname:: $(DESTDIR)dest/LibraryTargetName(libname) @@\
- @@\
-install.lib:: $(DESTDIR)dest/LibraryTargetName(libname) @@\
- @@\
-$(DESTDIR)dest/LibraryTargetName(libname): LibraryTargetName(libname) @@\
- MakeDir($(@D)) @@\
- $(INSTALL) $(INSTALLFLAGS) $(INSTLIBFLAGS) $< $@ @@\
- RanLibrary($(RANLIBINSTFLAGS) $@) @@\
- RemoveFile($<) @@\
- $(LN) $@ $<
-#endif /* InstallLibrary */
-
-/*
- * InstallSharedLibrary - generate rules to install the indicated sharable
- * Library
- */
-#undef InstallSharedLibrary
-#ifndef InstallSharedLibrary
-#define InstallSharedLibrary(libname,rev,dest) @@\
-.PHONY: install.lib shlib/libname @@\
-shlib/libname:: $(DESTDIR)dest/SharedLibraryTargetName(libname) @@\
- @@\
-install.shlib:: $(DESTDIR)dest/SharedLibraryTargetName(libname) @@\
- @@\
-$(DESTDIR)dest/SharedLibraryTargetName(libname): SharedLibraryTargetName(libname) @@\
- MakeDir($(@D)) @@\
- $(INSTALL) $(INSTALLFLAGS) $(INSTLIBFLAGS) $< $@ @@\
- RemoveFile($<) @@\
- $(LN) $@ $<
-#endif /* InstallSharedLibrary */
-
-/*
- * InstallLinkKitLibrary - rule to install Link Kit library.
- * (only used for XFree86). This is a no-op
- * rule so that Imakefiles on non-XFree86 systems
- * continue to build Makefiles correctly.
- */
-#ifndef InstallLinkKitLibrary
-#define InstallLinkKitLibrary(lib,dir)
-#endif
-
-
-/*
- * InstallLinkKitNamedLibrary - rule to install Link Kit library.
- * (only used for XFree86). This is a no-op
- * rule so that Imakefiles on non-XFree86 systems
- * continue to build Makefiles correctly.
- */
-#ifndef InstallLinkKitNamedLibrary
-#define InstallLinkKitNamedLibrary(lib,dlib,dir)
-#endif
-
-
-/*
- * MergeIntoInstalledLibrary - generate rules to merge one library into another
- */
-#ifndef MergeIntoInstalledLibrary
-#define MergeIntoInstalledLibrary(tolib,fromlib) @@\
-install:: fromlib @@\
- $(SCRIPTSRC)/mergelib $(DESTDIR)tolib fromlib
-#endif /* MergeIntoInstalledLibrary */
-
-/*
- * InstallLibraryAlias - generate rules to create a link from one library name
- * to another for the purposes of aliasing.
- */
-#ifndef InstallLibraryAlias
-#define InstallLibraryAlias(libname,alias,dest) @@\
-install.lib:: $(DESTDIR)dest/LibraryTargetName(alias) @@\
- @@\
-$(DESTDIR)dest/LibraryTargetName(alias): $(DESTDIR)dest/LibraryTargetName(libname) @@\
- -(cd $(DESTDIR)dest; \ @@\
- RemoveFile(LibraryTargetName(alias)); \ @@\
- $(LN) LibraryTargetName(libname) LibraryTargetName(alias))
-#endif /* InstallLibraryAlias */
-
-
-/*
- * InstallLintLibrary - generate rules to install the indicated lint library.
- */
-#ifndef InstallLintLibrary
-#define InstallLintLibrary(libname,dest) @@\
-InstallTarget(install.ln,Concat(llib-l,libname.ln),$(INSTLIBFLAGS),dest)
-#endif /* InstallLintLibrary */
-
-
-/*
- * InstallManPageLong - generate rules to install the indicated manual page,
- * giving it an alternate name. This is used for installing man pages whose
- * base name without the .man suffix would normally be longer than 8 characters
- * (the limit for using source code control systems on files systems with
- * short file names).
- */
-#ifndef InstallManPageLong
-#define InstallManPageLong(file,destdir,dest) @@\
-InstallNamedTarget(install.man,file.man,$(INSTMANFLAGS),destdir,dest.$(MANSUFFIX))
-#endif /* InstallManPageLong */
-
-
-/*
- * InstallManPage - generate rules to install the indicated manual page.
- */
-#ifndef InstallManPage
-#define InstallManPage(file,destdir) @@\
-InstallManPageLong(file,destdir,file)
-#endif /* InstallManPage */
-
-
-/*
- * InstallManPageAliases - generate rules to install manual page aliases.
- */
-#ifndef InstallManPageAliases
-#define InstallManPageAliases(file,destdir,aliases) @@\
-install.man:: @@\
- @(TMP=$(DESTDIR)destdir/file.$(MANSUFFIX).$$$$; \ @@\
- $(MKDIRHIER) `dirname $${TMP}` ; \ @@\
- RemoveFile($${TMP}); \ @@\
- echo .so `basename destdir`/file.$(MANSUFFIX) > $${TMP}; \ @@\
- for i in aliases; do (set -x; \ @@\
- $(INSTALL) $(INSTALLFLAGS) $(INSTMANFLAGS) $${TMP} $(DESTDIR)destdir/$$i.$(MANSUFFIX)); \ @@\
- done; \ @@\
- RemoveFile($${TMP}))
-#endif /* InstallManPageAliases */
-
-
-/*
- * InstallNamedNonExec - generate rules to install a data file
- */
-#ifndef InstallNamedNonExec
-#define InstallNamedNonExec(srcname,dstname,dest) @@\
-InstallNamedTarget(install,srcname,$(INSTDATFLAGS),dest,dstname)
-#endif /* InstallNamedNonExec */
-
-
-/*
- * InstallNonExecFile - generate rules to install a data file
- */
-#ifndef InstallNonExecFile
-#define InstallNonExecFile(file,dest) @@\
-InstallTarget(install,file,$(INSTDATFLAGS),dest)
-#endif /* InstallNonExecFile */
-
-/*
- * InstallNonExecFileTarget - generate rules to install a data file
- * with target
- */
-#ifndef InstallNonExecFileTarget
-#define InstallNonExecFileTarget(target,file,dest) @@\
-InstallTarget(target,file,$(INSTDATFLAGS),dest)
-#endif /* InstallNonExecFileTarget */
-
-
-/*
- * InstallLinkKitNonExecFile - rule for installing server Link Kit files.
- * (only used for XFree86). This is a no-op
- * rule so that Imakefiles on non-XFree86 systems
- * continue to build Makefiles correctly.
- */
-#ifndef InstallLinkKitNonExecFile
-#define InstallLinkKitNonExecFile(file,dir)
-#endif
-
-
-/*
- * InstallNonExec - generate rules to install a data file, but does not
- * try to create the destination directory (deprecated)
- */
-#ifndef InstallNonExec
-#define InstallNonExec(file,dest) @@\
-install:: file @@\
- $(INSTALL) $(INSTALLFLAGS) $(INSTDATFLAGS) file $(DESTDIR)dest
-#endif /* InstallNonExec */
-
-
-/*
- * InstallProgramWithFlags - generate rules to install an executable program
- * using given install flags.
- */
-#ifndef InstallProgramWithFlags
-#define InstallProgramWithFlags(program,dest,flags) @@\
-.PHONY: bin/program @@\
-bin/program:: $(DESTDIR)dest/program @@\
- @@\
-InstallTarget(install.bin,ProgramTargetName(program),$(INSTPGMFLAGS) flags,dest)
-#endif /* InstallProgramWithFlags */
-
-
-/*
- * InstallProgram - generate rules to install an executable program using any
- * special install flags set in $(INSTALLFLAGS).
- */
-#ifndef InstallProgram
-#define InstallProgram(program,dest) @@\
-InstallProgramWithFlags(program,dest,NullParameter)
-#endif /* InstallProgram */
-
-
-
-/*
- * InstallScript - install a shell script.
- */
-#ifndef InstallScript
-#define InstallScript(program,dest) @@\
-InstallNamedTarget(install.bin,program.script,$(INSTBINFLAGS),dest,program)
-#endif /* InstallScript */
-
-
-/*
- * InstallNamedProg - install a program with renaming and no stripping.
- */
-#ifndef InstallNamedProg
-#define InstallNamedProg(srcname,dstname,dest) @@\
-InstallNamedTarget(install.bin,srcname,$(INSTBINFLAGS),dest,dstname)
-#endif /* InstallNamedProg */
-
-
-/*
- * LinkFileList - link a list of list of files from one place to another
- */
-#ifndef LinkFileList
-#define LinkFileList(step,list,dir,sub) @@\
-step:: list @@\
- @case '${MFLAGS}' in *[i]*) set +e;; esac; \ @@\
- echo " cd" dir; cd dir; \ @@\
- for i in list; do (set -x; RemoveFile($$i); $(LN) sub/$$i .); done
-#endif
-
-
-/*
- * InstallMultipleDestFlags - generate rules to install multiple files at
- * once during a particular step in the build using a specific set of install
- * flags.
- */
-#ifndef InstallMultipleDestFlags
-#define InstallMultipleDestFlags(step,list,dest,flags) @@\
-step:: list @@\
- MakeDir($(DESTDIR)dest) @@\
- @case '${MFLAGS}' in *[i]*) set +e;; esac; \ @@\
- for i in list; do \ @@\
- (set -x; $(INSTALL) $(INSTALLFLAGS) flags $$i $(DESTDIR)dest); \ @@\
- done
-#endif /* InstallMultipleDestFlags */
-
-
-/*
- * InstallMultipleDest - generate rules to install multiple files at once
- * during a particular step in the build using any install flags set in
- * $(INSTDATFLAGS).
- */
-#ifndef InstallMultipleDest
-#define InstallMultipleDest(step,list,dest) @@\
-InstallMultipleDestFlags(step,list,dest,$(INSTDATFLAGS))
-#endif /* InstallMultipleDest */
-
-/*
- * InstallMultiple - generate rules to install multiple files at once
- * during the install step of the build using any install flags set in
- * $(INSTALLFLAGS).
- */
-#ifndef InstallMultiple
-#define InstallMultiple(list,dest) @@\
-InstallMultipleDest(install,list,dest)
-#endif /* InstallMultiple */
-
-
-/*
- * InstallMultipleFlags - generate rules to install multiple files at once
- * during the install step of the build using the given install flags.
- */
-#ifndef InstallMultipleFlags
-#define InstallMultipleFlags(list,dest,flags) @@\
-InstallMultipleDestFlags(install,list,dest,flags)
-#endif /* InstallMultipleFlags */
-
-
-/*
- * InstallMultipleMan - generate rules to install a variety of manual pages
- * during the install.man step of the build.
- */
-#ifndef InstallMultipleMan
-#define InstallMultipleMan(list,dest) @@\
-InstallMultipleDestFlags(install.man,list,dest,$(INSTMANFLAGS))
-#endif /* InstallMultipleMan */
-
-
-/*
- * DependDependency - generate rules to build the makedepend program if
- * this Imakefile is within the source tree.
- */
-#ifndef DependDependency
-#ifdef UseInstalled
-#define DependDependency() /**/
-#else
-#define DependDependency() @@\
-depend:: ProgramTargetName($(DEPEND)) @@\
- @@\
-ProgramTargetName($(DEPEND)): @@\
- @echo "checking $@ over in $(DEPENDSRC) first..."; \ @@\
- cd $(DEPENDSRC); $(MAKE); \ @@\
- echo "okay, continuing in $(CURRENT_DIR)"
-
-#endif /* UseInstalled */
-#endif /* DependDependency */
-
-/*
- * IxxDependency - generate rules to build the interface translator if
- * this Imakefile is within the source tree.
- */
-#ifndef IxxDependency
-#ifdef UseInstalled
-#define IxxDependency() /**/
-#else
-#define IxxDependency() @@\
-interfaces:: ProgramTargetName($(IXX)) @@\
- @@\
-ProgramTargetName($(IXX)): @@\
- @echo "checking $@ over in $(IXXSRC) first..."; \ @@\
- cd $(IXXSRC); $(MAKE); \ @@\
- echo "okay, continuing in $(CURRENT_DIR)"
-#endif /* UseInstalled */
-#endif /* IxxDependency */
-
-/*
- * DependTarget - generate rules to compute dependencies for all files listed
- * in $(SRCS).
- */
-#ifndef DependTarget
-#define DependTarget() @@\
-DependDependency() @@\
- @@\
-depend:: @@\
- RunProgram(DEPEND,$(DEPENDFLAGS) -- $(ALLDEFINES) $(DEPEND_DEFINES) -- $(SRCS))
-#endif /* DependTarget */
-
-/*
- * DependTarget3 - generate rules to compute dependencies for all files given.
- */
-#ifndef DependTarget3
-#define DependTarget3(srcs1,srcs2,srcs3) @@\
-DependDependency() @@\
- @@\
-depend:: @@\
- RunProgram(DEPEND,$(DEPENDFLAGS) -- $(ALLDEFINES) $(DEPEND_DEFINES) -- srcs1) @@\
- RunProgram(DEPEND,-a $(DEPENDFLAGS) -- $(ALLDEFINES) $(DEPEND_DEFINES) -- srcs2) @@\
- RunProgram(DEPEND,-a $(DEPENDFLAGS) -- $(ALLDEFINES) $(DEPEND_DEFINES) -- srcs3)
-#endif /* DependTarget3 */
-
-
-/*
- * CleanTarget - generate rules to remove any garbage files
- */
-#ifndef CleanTarget
-#define CleanTarget() @@\
-clean:: @@\
- $(RM_CMD) FilesToClean ExtraFilesToClean "#"* @@\
- @@\
-ProofCleanTarget()
-#endif /* CleanTarget */
-
-
-/*
- * TagsTarget - generate rules to compute tags files for C source code.
- */
-#ifndef TagsTarget
-#define TagsTarget() @@\
-tags:: @@\
- $(TAGS) -w *.[ch] @@\
- $(TAGS) -xw *.[ch] > TAGS
-#endif /* TagsTarget */
-
-
-/*
- * ImakeDependency - generate rules to compile imake if this Imakefile is
- * within the source tree.
- */
-#ifndef ImakeDependency
-#ifdef UseInstalled
-#define ImakeDependency(target) /**/
-#else
-#define ImakeDependency(target) @@\
-target:: ProgramTargetName($(IMAKE)) @@\
- @@\
-ProgramTargetName($(IMAKE)): @@\
- -@(cd $(IMAKESRC); if [ -f Makefile ]; then \ @@\
- echo "checking $@ in $(IMAKESRC) first..."; $(MAKE) all; else \ @@\
- echo "bootstrapping $@ from Makefile.ini in $(IMAKESRC) first..."; \ @@\
- $(MAKE) -f Makefile.ini BOOTSTRAPCFLAGS="$(BOOTSTRAPCFLAGS)"; fi; \ @@\
- echo "okay, continuing in $(CURRENT_DIR)")
-#endif /* UseInstalled */
-#endif /* ImakeDependency */
-
-
-/*
- * BuildMakefileTarget - generate rules to build a Makefile from an Imakefile
- * and any special imake flags. This is generally done automatically by the
- * template or by any special Imakefiles. The first argument exists just
- * because imakeflags is usually empty and some preprocessors will complain
- * if an empty argument is passed as the sole argument to a macro.
- */
-#ifndef BuildMakefileTarget
-#define BuildMakefileTarget(notused,imakeflags) @@\
-ImakeDependency(Makefile) @@\
- @@\
-Makefile:: Imakefile @@\
- RMoveToBakFile($@) @@\
- $(IMAKE_CMD) -DTOPDIR=$(TOP) -DCURDIR=$(CURRENT_DIR) \ @@\
- -DPackageTop=$(PACKAGETOP) \ @@\
- -DPackageName=$(PACKAGE_NAME) \ @@\
- imakeflags -f $<
-
-#endif /* BuildMakefileTarget */
-
-
-/*
- * MakefileTarget - generate rules to build a normal Makefile.
- */
-#ifndef MakefileTarget
-#define MakefileTarget() @@\
-BuildMakefileTarget(Imakefile,NullParameter)
-#endif /* MakefileTarget */
-
-
-/*
- * LibMkdir - helper for creating library object subdirectories
- */
-#ifndef LibMkdir
-#define LibMkdir(dir) DirFailPrefix at if [ -d dir ]; then exit 0; else set -x; mkdir dir; fi
-#endif
-
-/*
- * LibCleanDir - helper for cleaning library object subdirectories
- */
-#ifndef LibCleanDir
-#define LibCleanDir(dir) - at if [ -d dir ]; then \ @@\
- (set -x; cd dir; RemoveFiles(*.Osuf)); else exit 0; fi
-#endif
-
-/*
- * LintLibReferences - variables for lint libraries
- */
-#ifndef LintLibReferences
-#define LintLibReferences(varname,libname,libsource) @@\
-Concat(LINT,varname) = _UseCat($(LINTLIBDIR)/llib-l,libsource/llib-,libname.ln)
-#endif
-
-/*
- * UnsharedLibReferences - variables for unshared libraries
- */
-#ifndef UnsharedLibReferences
-#define UnsharedLibReferences(varname,libname,libsource) @@\
-Concat3(DEP,varname,LIB) = _UseCat($(USRLIBDIR)/lib,$(BUILDLIBDIR)/lib,libname.a) @@\
-Concat(varname,LIB) = LoaderLibPrefix Concat(-l,libname) @@\
-LintLibReferences(varname,libname,libsource)
-#endif
-
-/*
- * SharedLibDependencies - shared library dependencies
- */
-#ifndef SharedLibDependencies
-#define SharedLibDependencies(libname,libsource,revname) /**/
-#endif
-
-/*
- * SharedDSLibDependencies - shared library dependencies with data separation
- */
-#ifndef SharedDSLibDependencies
-#define SharedDSLibDependencies(libname,libsource,revname) /**/
-#endif
-
-/*
- * SharedLibReferences - variables for shared libraries
- */
-#ifndef SharedLibReferences
-#define SharedLibReferences(varname,libname,libsource,revname,rev) @@\
-revname = rev @@\
-Concat3(DEP,varname,LIB) = SharedLibDependencies(libname,libsource,revname) @@\
-Concat(varname,LIB) = LoaderLibPrefix Concat(-l,libname) @@\
-LintLibReferences(varname,libname,libsource)
-#endif
-
-/*
- * SharedDSLibReferences - variables for shared libraries
- */
-#ifndef SharedDSLibReferences
-#define SharedDSLibReferences(varname,libname,libsource,revname,rev) @@\
-revname = rev @@\
-Concat3(DEP,varname,LIB) = SharedDSLibDependencies(libname,libsource,revname) @@\
-Concat(varname,LIB) = LoaderLibPrefix Concat(-l,libname) @@\
-LintLibReferences(varname,libname,libsource)
-#endif
-
-/*
- * CPPOnlyCompile - run C compiler's preprocessor only
- */
-#ifndef CPPOnlyCompile
-#define CPPOnlyCompile(src,options) RemoveFile($@) @@\
- $(CC) -E $(CFLAGS) options src > $@
-#endif
-
-/*
- * ObjectCompile - compile fragment for a normal object file
- */
-#ifndef ObjectCompile
-#define ObjectCompile(options) RemoveFile($@) @@\
- $(CC) -c $(CFLAGS) options $<
-#endif
-
-#ifndef ObjectCplusplusCompile
-#define ObjectCplusplusCompile(options) RemoveFile($@) @@\
- $(CXX) -c $(CXXFLAGS) options $*.CCsuf
-#endif
-
-/*
- * NormalLibObjCompile - compile fragment for a normal library object file
- */
-#ifndef NormalLibObjCompile
-#define NormalLibObjCompile(options) ObjectCompile(options)
-#endif
-
-#ifndef NormalLibObjCplusplusCompile
-#define NormalLibObjCplusplusCompile(options) ObjectCplusplusCompile(options)
-#endif
-
-/*
- * NormalSharedLibObjCompile - compile fragment for shared objects
- */
-#ifndef NormalSharedLibObjCompile
-#define NormalSharedLibObjCompile(options) NormalLibObjCompile(options $(SHLIBDEF) $(SHAREDCODEDEF) $(PICFLAGS))
-#endif
-
-#ifndef NormalSharedLibObjCplusplusCompile
-#define NormalSharedLibObjCplusplusCompile(options) NormalLibObjCplusplusCompile(options $(SHLIBDEF) $(SHAREDCODEDEF) $(CXXPICFLAGS))
-#endif
-
-/*
- * LibObjCompile - compile fragment for unshared/profiled/debugged objects
- */
-#ifndef LibObjCompile
-#define LibObjCompile(dir,options) RemoveFiles($@ dir/$@) @@\
- $(CC) -c $(CCOPTIONS) $(ALLDEFINES) options $*.c @@\
- $(MV) $@ dir/$@
-#endif
-
-#ifndef LibObjCplusplusCompile
-#define LibObjCplusplusCompile(dir,options) RemoveFiles($@ dir/$@) @@\
- $(CXX) -c $(CXXOPTIONS) $(CXXDEFINES) options $*.CCsuf @@\
- $(MV) $@ dir/$@
-#endif
-
-/*
- * DebuggedLibObjCompile - compile fragment for debugged objects
- */
-#ifndef DebuggedLibObjCompile
-#define DebuggedLibObjCompile(options) LibObjCompile(debugger,DebuggableCDebugFlags options)
-#endif
-
-#ifndef DebuggedLibObjCplusplusCompile
-#define DebuggedLibObjCplusplusCompile(options) LibObjCplusplusCompile(debugger,DebuggableCplusplusDebugFlags options)
-#endif
-
-/*
- * ProfiledLibObjCompile - compile fragment for profiled objects
- */
-#ifndef ProfiledLibObjCompile
-#define ProfiledLibObjCompile(options) LibObjCompile(profiled,ProfiledCDebugFlags options)
-#endif
-
-#ifndef ProfiledLibObjCplusplusCompile
-#define ProfiledLibObjCplusplusCompile(options) LibObjCplusplusCompile(profiled,ProfiledCplusplusDebugFlags options)
-#endif
-
-/*
- * UnsharedLibObjCompile - compile fragment for unshared objects
- */
-#ifndef UnsharedLibObjCompile
-#define UnsharedLibObjCompile(options) LibObjCompile(unshared,$(CDEBUGFLAGS) options)
-#endif
-
-#ifndef UnsharedLibObjCplusplusCompile
-#define UnsharedLibObjCplusplusCompile(options) LibObjCplusplusCompile(unshared,$(CXXDEBUGFLAGS) options)
-#endif
-
-/*
- * SharedLibObjCompile - compile fragment for shared objects
- */
-#ifndef SharedLibObjCompile
-#define SharedLibObjCompile(options) LibObjCompile(shared,options $(SHLIBDEF) $(SHAREDCODEDEF) $(PICFLAGS) $(CDEBUGFLAGS))
-#endif
-
-/*
- * NormalLibraryObjectRule - for simple libraries
- */
-#ifndef NormalLibraryObjectRule
-#define NormalLibraryObjectRule() @@\
-.c.Osuf: @@\
- NormalLibObjCompile($(_NOOP_))
-#endif /* NormalLibraryObjectRule */
-
-#ifndef NormalCplusplusObjectRule
-#define NormalCplusplusObjectRule() @@\
-.CCsuf.Osuf: @@\
- NormalLibObjCplusplusCompile($(_NOOP_))
-#endif
-
-#ifndef NormalFortranObjectRule
-#define NormalFortranObjectRule() @@\
-.f.Osuf: @@\
- RemoveFile($@) @@\
- $(FC) -c $(FCFLAGS) $*.f
-#endif
-
-/*
- * SpecialObjectRule - generate rules to compile a file with special flags.
- */
-#ifndef SpecialObjectRule
-#define SpecialObjectRule(objs,depends,options) @@\
-objs: depends @@\
- ObjectCompile(options)
-#endif /* SpecialObjectRule */
-
-#ifndef SpecialCplusplusObjectRule
-#define SpecialCplusplusObjectRule(baseobj,basedep,options) @@\
-baseobj.Osuf: basedep.CCsuf @@\
- ObjectCplusplusCompile(options)
-#endif /* SpecialCplusplusObjectRule */
-
-/*
- * SpecialCObjectRule - generate rules to compile a C file with special flags.
- * also handles CodeCenter rules
- */
-#ifndef SpecialCObjectRule
-#define SpecialCObjectRule(basename,depends,options) @@\
-SpecialObjectRule(basename.Osuf,basename.c depends,options) @@\
- @@\
-basename.i: basename.c depends @@\
- CPPOnlyCompile(basename.c,options) @@\
- @@\
-CenterLoadTarget(debug_src,basename.c,NullParameter,$(ALLDEFINES) options)
-#endif /* SpecialCObjectRule */
-
-
-#ifndef ObjectFromSpecialSource
-#define ObjectFromSpecialSource(dst,src,flags) @@\
-dst.c: src.c @@\
- RemoveFile($@) @@\
- $(LN) $? $@ @@\
- @@\
-SpecialCObjectRule(dst,NullParameter,flags) @@\
- @@\
-depend:: dst.c @@\
- @@\
-clean:: @@\
- RemoveFile(dst.c)
-#endif /* ObjectFromSpecialSource */
-
-
-#ifndef LexFile
-#define LexFile(file) @@\
-depend:: file.c @@\
- @@\
-clean:: @@\
- RemoveFiles(lex.yy.c file.c)
-#endif /* LexFile */
-
-#ifndef YaccFile
-#define YaccFile(file,flags) @@\
-depend:: file.c @@\
- @@\
-file.h file.c: file.y @@\
- $(YACC) flags file.y @@\
- $(MV) y.tab.c file.c @@\
- $(MV) y.tab.h file.h @@\
- @@\
-clean:: @@\
- RemoveFiles(y.tab.c y.tab.h file.h file.c)
-#endif /* YaccFile */
-
-#ifndef MakeHFromIDL
-#define MakeHFromIDL(name,flags) @@\
- @@\
-interfaces:: name.h @@\
- @@\
-name.h: name.idl @@\
- @RemoveFile(name.h) @@\
- $(CPP) $(CXXDEFINES) name.idl | \ @@\
- $(IXX) $(IXXFLAGS) $(IXXINCLUDES) -file name.idl flags > name.h
-#endif /* MakeHFromIDL */
-
-#ifndef MakeLibrary
-#define MakeLibrary(libname,objlist) $(AR) libname objlist
-#endif
-
-#ifndef LinkBuildLibrary
-#ifdef UseInstalled
-#define LinkBuildLibrary(lib) $(_NULLCMD_)
-#else
-#define LinkBuildLibrary(lib) MakeDir($(BUILDLIBDIR)) @@\
- RemoveFile($(BUILDLIBDIR)/lib) @@\
- cd $(BUILDLIBDIR); $(LN) $(BUILDINCTOP)/$(CURRENT_DIR)/lib .
-#endif
-#endif /* LinkBuildLibrary */
-
-#ifndef _LinkBuildLibrary /* will get redefined elsewhere */
-#define _LinkBuildLibrary(lib) $(_NULLCMD_)
-#endif /* _LinkBuildLibrary */
-
-/*
- * NormalLibraryTarget - generate rules to create a library.
- */
-#ifndef NormalLibraryTarget
-#define NormalLibraryTarget(libname,objlist) @@\
-AllTarget(LibraryTargetName(libname)) @@\
- @@\
-LibraryTargetName(libname): objlist @@\
- RemoveFile($@) @@\
- MakeLibrary($@,objlist) @@\
- RanLibrary($@) @@\
- _LinkBuildLibrary($@)
-#endif /* NormalLibraryTarget */
-
-
-/*
- * NormalLibraryTarget2 - generate rules to create a library in two steps.
- * This is used to create libraries with large numbers of files.
- */
-#ifndef NormalLibraryTarget2
-#define NormalLibraryTarget2(libname,objlist1,objlist2) @@\
-AllTarget(LibraryTargetName(libname)) @@\
- @@\
-LibraryTargetName(libname): objlist1 objlist2 @@\
- RemoveFile($@) @@\
- MakeLibrary($@,objlist1) @@\
- MakeLibrary($@,objlist2) @@\
- RanLibrary($@) @@\
- _LinkBuildLibrary($@)
-#endif /* NormalLibraryTarget2 */
-
-
-/*
- * NormalLibraryTarget3 - generate rules to create a library in three steps.
- * This is used to create libraries with very large numbers of files.
- */
-#ifndef NormalLibraryTarget3
-#define NormalLibraryTarget3(libname,objlist1,objlist2,objlist3) @@\
-AllTarget(LibraryTargetName(libname)) @@\
- @@\
-LibraryTargetName(libname): objlist1 objlist2 objlist3 @@\
- RemoveFile($@) @@\
- MakeLibrary($@,objlist1) @@\
- MakeLibrary($@,objlist2) @@\
- MakeLibrary($@,objlist3) @@\
- RanLibrary($@) @@\
- _LinkBuildLibrary($@)
-#endif /* NormalLibraryTarget3 */
-
-
-/*
- * NormalDepLibraryTarget - generate rules to create a library.
- */
-#ifndef NormalDepLibraryTarget
-#define NormalDepLibraryTarget(libname,deplist,objlist) @@\
-AllTarget(LibraryTargetName(libname)) @@\
- @@\
-LibraryTargetName(libname): deplist @@\
- RemoveFile($@) @@\
- MakeLibrary($@,objlist) @@\
- RanLibrary($@) @@\
- _LinkBuildLibrary($@)
-#endif /* NormalDepLibraryTarget */
-
-
-/*
- * UnsharedLibraryTarget - generate rules to create a library.
- */
-#ifndef UnsharedLibraryTarget
-#define UnsharedLibraryTarget(libname,objlist,down,up) @@\
-AllTarget(LibraryTargetName(libname)) @@\
- @@\
-LibraryTargetName(libname): objlist @@\
- RemoveFile($@) @@\
- (cd down; MakeLibrary(up/$@,objlist)) @@\
- RanLibrary($@) @@\
- _LinkBuildLibrary($@)
-#endif /* UnsharedLibraryTarget */
-
-
-/*
- * UnsharedLibraryTarget3 - generate rules to create a library in three steps.
- * This is used to create libraries with very large numbers of files.
- */
-#ifndef UnsharedLibraryTarget3
-#define UnsharedLibraryTarget3(libname,objlist1,objlist2,objlist3,down,up) @@\
-AllTarget(LibraryTargetName(libname)) @@\
- @@\
-LibraryTargetName(libname): objlist1 objlist2 objlist3 @@\
- RemoveFile($@) @@\
- (cd down; MakeLibrary(up/$@,objlist1)) @@\
- (cd down; MakeLibrary(up/$@,objlist2)) @@\
- (cd down; MakeLibrary(up/$@,objlist3)) @@\
- RanLibrary($@) @@\
- _LinkBuildLibrary($@)
-#endif /* UnsharedLibraryTarget3 */
-
-
-/*
- * SubdirLibraryRule -
- */
-#ifndef SubdirLibraryRule
-#define SubdirLibraryRule(objlist) @@\
-all:: DONE @@\
- @@\
-DONE: objlist @@\
- RemoveFile($@) @@\
- touch $@ @@\
- @@\
-clean:: @@\
- RemoveFile(DONE)
-#endif /* SubdirLibraryRule */
-
-
-/*
- * ProfiledLibraryTarget - generate rules to create a profiled library.
- */
-#ifndef ProfiledLibraryTarget
-#define ProfiledLibraryTarget(libname,objlist) @@\
-AllTarget(LibraryTargetNameSuffix(libname,_p)) @@\
- @@\
-LibraryTargetNameSuffix(libname,_p): objlist @@\
- RemoveFile($@) @@\
- cd profiled; MakeLibrary(../$@,objlist) @@\
- RanLibrary($@)
-
-#endif /* ProfiledLibraryTarget */
-
-
-/*
- * DebuggedLibraryTarget - generate rules to create a debuggable library.
- */
-#ifndef DebuggedLibraryTarget
-#define DebuggedLibraryTarget(libname,objlist) @@\
-AllTarget(LibraryTargetNameSuffix(libname,_d)) @@\
- @@\
-LibraryTargetNameSuffix(libname,_d): objlist @@\
- RemoveFile($@) @@\
- cd debugger; MakeLibrary(../$@,objlist) @@\
- RanLibrary($@)
-
-#endif /* DebuggedLibraryTarget */
-
-
-/*
- * AliasedLibraryTarget - generate rules to link one library to another.
- */
-#ifndef AliasedLibraryTarget
-#define AliasedLibraryTarget(libname,alias) @@\
-AllTarget(LibraryTargetName(alias)) @@\
- @@\
-LibraryTargetName(alias): LibraryTargetName(libname) @@\
- RemoveFile($@) @@\
- $(LN) LibraryTargetName(libname) $@ @@\
- @@\
-clean:: @@\
- RemoveFile(LibraryTargetName(alias))
-#endif /* AliasedLibraryTarget */
-
-
-/*
- * NormalRelocatableTarget - generate rules to produce a relocatable object
- * file instead of a library.
- */
-#ifndef NormalRelocatableTarget
-#define NormalRelocatableTarget(objname,objlist) @@\
-AllTarget(objname.Osuf) @@\
- @@\
-objname.Osuf: objlist @@\
- RemoveFile($@) @@\
- $(LD) $(LDCOMBINEFLAGS) objlist -o $@
-#endif /* NormalRelocatableTarget */
-
-
-/*
- * ProfiledRelocatableTarget - generate rules to produce a profiled relocatable
- * object file instead of a library.
- */
-#ifndef ProfiledRelocatableTarget
-#define ProfiledRelocatableTarget(objname,objlist) @@\
-AllTarget(Concat(objname,_p.Osuf)) @@\
- @@\
-Concat(objname,_p.Osuf): objlist @@\
- RemoveFile($@) @@\
- $(LD) -X -r objlist -o $@
-
-#endif /* ProfiledRelocatableTarget */
-
-
-/*
- * DebuggedRelocatableTarget - generate rules to produce a debuggable
- * relocatable object file instead of a library.
- */
-#ifndef DebuggedRelocatableTarget
-#define DebuggedRelocatableTarget(objname,objlist) @@\
-AllTarget(Concat(objname,_d.Osuf)) @@\
- @@\
-Concat(objname,_d.Osuf): objlist @@\
- RemoveFile($@) @@\
- $(LD) -X -r objlist -o $@
-
-#endif /* DebuggedRelocatableTarget */
-
-
-/*
- * LintLibraryTarget - generate rules to create a lint library. Note that the
- * lint library is always forced to be newer than the library itself.
- */
-#ifndef LintLibraryTarget
-#define LintLibraryTarget(libname,srclist) @@\
-lintlib:: Concat(llib-l,libname.ln) @@\
- @@\
-Concat(llib-l,libname.ln): srclist @@\
- RemoveFile($@) @@\
- $(LINT) Concat($(LINTLIBFLAG),libname) $(LINTFLAGS) srclist
-#endif /* LintLibraryTarget */
-
-
-/*
- * NormalLintTarget - generate rules to lint a set of sources.
- */
-#ifndef NormalLintTarget
-#define NormalLintTarget(srclist) @@\
-lint: @@\
- $(LINT) $(LINTFLAGS) srclist $(LINTLIBS) @@\
-lint1: @@\
- $(LINT) $(LINTFLAGS) $(FILE) $(LINTLIBS)
-#endif /* NormalLintTarget */
-
-
-/*
- * LintTarget - generate rules to lint $(SRCS)
- */
-#ifndef LintTarget
-#define LintTarget() @@\
-NormalLintTarget($(SRCS))
-#endif
-
-
-/*
- * LinkSourceFile - snag source file from some other directory
- */
-#ifndef LinkSourceFile
-#define LinkSourceFile(src,dir) @@\
-src: dir/src @@\
- RemoveFile($@) @@\
- $(LN) $? $@ @@\
- @@\
-includes:: src @@\
- @@\
-depend:: src @@\
- @@\
-clean:: @@\
- RemoveFile(src)
-#endif
-
-
-/*
- * LinkFile - link a file
- */
-#ifndef LinkFile
-#define LinkFile(tofile,fromfile) @@\
-tofile:: fromfile @@\
- RemoveFile($@) @@\
- $(LN) $? $@ @@\
- @@\
-includes:: tofile @@\
- @@\
-depend:: tofile @@\
- @@\
-clean:: @@\
- RemoveFile(tofile)
-#endif
-
-
-#ifndef MakeSubincludesForBuild
-#define MakeSubincludesForBuild(step,dir,srclist) @@\
-step:: dir srclist @@\
- @-(list=`echo srclist | sed -e 's/[^ ]*\///g'`; \ @@\
- set -x; cd dir; RemoveFiles($$list)) @@\
- @for i in srclist; do \ @@\
- (set -x; cd dir; $(LN) ../$$i .); \ @@\
- done @@\
- @@\
-dir:: @@\
- $(MKDIRHIER) dir @@\
- @@\
-clean:: @@\
- @-(if [ -d dir ]; then \ @@\
- list=`echo srclist | sed -e 's/[^ ]*\///g'`; \ @@\
- set -x; cd dir; RemoveFile($$list); else exit 0; fi)
-#endif
-
-
-/*
- * NamedTargetSubdirs - recursively make a series of steps
- */
-#ifndef NamedTargetSubdirs
-#define NamedTargetSubdirs(name,dirs,verb,flags,subname) @@\
-name:: $(foreach dir,dirs,$(dir)/Makefile) @@\
- @@\
-name:: @@\
- @set -e; \ @@\
- case '${MFLAGS}' in *[ik]*) set +e;; esac; \ @@\
- for i in dirs ;\ @@\
- do \ @@\
- (cd $$i ; echo verb "in $(CURRENT_DIR)/$$i..."; \ @@\
- $(MAKE) $(MFLAGS) flags subname)||exit $$?; \ @@\
- done
-#endif
-
-
-/*
- * NamedMakeSubdirs - generate rules to do makes in the given subdirectories.
- * If you want CDEBUGFLAGS passed along to subdirectories, provide a line like
- * the following in the appropriate Imakefile
- *
- * #define PassCDebugFlags 'CDEBUGFLAGS=$(CDEBUGFLAGS)'
- */
-#ifndef NamedMakeSubdirs
-#define NamedMakeSubdirs(name,dirs) \
-NamedTargetSubdirs(name,dirs,"making" name,PassCDebugFlags,all)
-#endif /* NamedMakeSubdirs */
-
-#ifndef MakeSubdirs
-#define MakeSubdirs(dirs) @@\
-NamedMakeSubdirs(all,dirs)
-#endif /* MakeSubdirs */
-
-
-/*
- * DependSubdirs - generate rules to recursively compute dependencies as
- * part of the make depend step.
- */
-#ifndef DependSubdirs
-#define DependSubdirs(dirs) \
-NamedTargetSubdirs(depend,dirs,"depending",NullParameter,depend)
-#endif /* DependSubdirs */
-
-
-/*
- * ForceSubdirs - force make to build subdirectories
- */
-#ifndef ForceSubdirs
-#define ForceSubdirs(dirs) @@\
-dirs: FRC @@\
- @cd $@ ; echo "making all in $(CURRENT_DIR)/$@..."; \ @@\
- $(MAKE) $(MFLAGS) PassCDebugFlags all @@\
- @@\
-FRC:
-#endif /* ForceSubdirs */
-
-/*
- * InstallSubdirs - generate rules to recursively install programs and files.
- */
-#ifndef InstallSubdirs
-#define InstallSubdirs(dirs) \
-NamedTargetSubdirs(install,dirs,"installing",DESTDIR=$(DESTDIR),install)
-#endif /* InstallSubdirs */
-
-/*
- * InstallLibSubdirs - generate rules to recursively install Libraries
- */
-#ifndef InstallLibSubdirs
-#define InstallLibSubdirs(dirs) \
-NamedTargetSubdirs(install.lib,dirs,"installing",DESTDIR=$(DESTDIR),install.lib)
-#endif /* InstallSubdirs */
-
-/*
- * InstallBinSubdirs - generate rules to recursively install programs and
- * scripts
- */
-#ifndef InstallBinSubdirs
-#define InstallBinSubdirs(dirs) \
-NamedTargetSubdirs(install.bin,dirs,"installing",DESTDIR=$(DESTDIR) \
-PACKAGE_LIB=$(PACKAGE_LIB),install.bin)
-#endif /* InstallSubdirs */
-
-/*
- * InstallIncludeSubdirs - rules to install recursively install includes
- */
-#ifndef InstallIncludeSubdirs
-#define InstallIncludeSubdirs(dirs) \
-NamedTargetSubdirs(install.include,dirs,"installing",DESTDIR=$(DESTDIR) \
-,install.include)
-#endif /* InstallSubdirs */
-
-
-
-/*
- * InstallManSubdirs - generate rules to recursively install manual pages.
- */
-#ifndef InstallManSubdirs
-#define InstallManSubdirs(dirs) \
-NamedTargetSubdirs(install.man,dirs,"installing man pages",DESTDIR=$(DESTDIR),install.man)
-#endif /* InstallManSubdirs */
-
-
-/*
- * IncludesSubdirs - generate rules to recursively put include files in build
- */
-#ifndef IncludesSubdirs
-#define IncludesSubdirs(dirs) \
-NamedTargetSubdirs(includes,dirs,including,NullParameter,includes)
-#endif
-
-
-/*
- * InstallLinkKitSubdirs - generate rules to recursively install server Link
- * Kit (only used for XFree86). This is a no-op
- * rule so that Imakefiles on non-XFree86 systems
- * continue to build Makefiles correctly.
- */
-#ifndef InstallLinkKitSubdirs
-#define InstallLinkKitSubdirs(dirs)
-#endif
-
-
-/*
- * CleanSubdirs - generate rules to recursively clean out garbage files.
- */
-#ifndef NamedCleanSubdirs
-#define NamedCleanSubdirs(name,dirs) \
-NamedTargetSubdirs(name,dirs,"cleaning",RM_CMD='$(RM_CMD)',clean)
-#endif /* NamedCleanSubdirs */
-
-#ifndef CleanSubdirs
-#define CleanSubdirs(dirs) \
-NamedCleanSubdirs(clean,dirs)
-#endif
-
-
-/*
- * TagSubdirs - generate rules to recursively create tags files.
- */
-#ifndef NamedTagSubdirs
-#define NamedTagSubdirs(name,dirs) \
-NamedTargetSubdirs(name,dirs,"tagging",TAGS='$(TAGS)',tags)
-#endif /* TagSubdirs */
-
-#ifndef TagSubdirs
-#define TagSubdirs(dirs) \
-NamedTagSubdirs(tags,dirs)
-#endif
-
-/*
- * MakeLintSubdirs - generate rules to recursively lint directories as part
- * of the named step.
- */
-#ifndef MakeLintSubdirs
-#define MakeLintSubdirs(dirs,target,subtarget) \
-NamedTargetSubdirs(target,dirs,"linting" for target and subtarget,DESTDIR=$(DESTDIR) LINTOPTS='$(LINTOPTS)',subtarget)
-#endif /* MakeLintSubdirs */
-
-
-/*
- * LintSubdirs - generate rules to recursively lint directories as part of
- * the make lint step.
- */
-#ifndef LintSubdirs
-#define LintSubdirs(dirs) @@\
-MakeLintSubdirs(dirs,lint,lint)
-#endif /* LintSubdirs */
-
-
-/*
- * MakeLintLibSubdirs - generate rules to recursively create lint libraries.
- */
-#ifndef MakeLintLibSubdirs
-#define MakeLintLibSubdirs(dirs) @@\
-MakeLintSubdirs(dirs,lintlib,lintlib)
-#endif /* MakeLintLibSubdirs */
-
-
-/*
- * MakeMakeSubdirs - generate rules to recursively recreate Makefiles as part
- * of the specified step in the build. If $(TOP) is set to an absolute path,
- * do not prepend the ../ prefix. This makes running things outside of the
- * source tree to be much easier.
- */
-#ifndef MakeMakeSubdirs
-#define MakeMakeSubdirs(dirs,target) @@\
-target:: @@\
- - at case '${MFLAGS}' in *[ik]*) set +e;; esac; \ @@\
- case '${MFLAGS}' in *n*) executeit="no";; esac; \ @@\
- for i in dirs ;\ @@\
- do \ @@\
- case "$(CURRENT_DIR)" in \ @@\
- .) curdir= ;; \ @@\
- *) curdir=$(CURRENT_DIR)/ ;; \ @@\
- esac; \ @@\
- echo "making Makefiles in $$curdir$$i..."; \ @@\
- itmp="$$i" \ @@\
- curtmp="$(CURRENT_DIR)" \ @@\
- toptmp=""; \ @@\
- case "$$itmp" in \ @@\
- ../?*) \ @@\
- while echo "$$itmp" | grep '^../' > /dev/null;\ @@\
- do \ @@\
- toptmp="/`basename $$curtmp`$$toptmp"; \ @@\
- curtmp="`dirname $$curtmp`"; \ @@\
- itmp="`echo $$itmp | sed 's;../;;'`"; \ @@\
- done \ @@\
- ;; \ @@\
- esac; \ @@\
- case "$$itmp" in \ @@\
- */?*/?*/?*/?*) newtop=../../../../..;; \ @@\
- */?*/?*/?*) newtop=../../../..;; \ @@\
- */?*/?*) newtop=../../..;; \ @@\
- */?*) newtop=../..;; \ @@\
- *) newtop=..;; \ @@\
- esac; \ @@\
- newtop="$$newtop$$toptmp"; \ @@\
- case "$(TOP)" in \ @@\
- /?*) imaketop=$(TOP) \ @@\
- imakeprefix= ;; \ @@\
- .) imaketop=$$newtop \ @@\
- imakeprefix=$$newtop/ ;; \ @@\
- *) imaketop=$$newtop/$(TOP) \ @@\
- imakeprefix=$$newtop/ ;; \ @@\
- esac; \ @@\
- cd $$i; \ @@\
- RemoveFile(Makefile.bak); \ @@\
- if [ -f Makefile ]; then \ @@\
- echo " $(MV) Makefile Makefile.bak"; \ @@\
- if [ "$$executeit" != "no" ]; then \ @@\
- $(MV) Makefile Makefile.bak; \ @@\
- fi; \ @@\
- fi; \ @@\
- if [ "$$executeit" != "no" ]; then \ @@\
- ImakeSubCmdHelper -DTOPDIR=$$imaketop \ @@\
- -DCURDIR=$$curdir$$i \ @@\
- -DPackageTop=$(PACKAGETOP) \ @@\
- -DPackageName=$(PACKAGE_NAME); \ @@\
- fi; \ @@\
- $(MAKE) $(MFLAGS) Makefiles; \ @@\
- cd $$newtop; \ @@\
- done
-
-#ifdef UseInstalled
-#define ImakeSubCmdHelper $(IMAKE_CMD)
-#else
-#define ImakeSubCmdHelper $$imakeprefix$(IMAKE) -I$$imakeprefix$(IRULESRC) $(IMAKE_DEFINES)
-#endif
-
-#endif /* MakeMakeSubdirs */
-
-
-/*
- * MakefileSubdirs - generate rules to create Makefiles.
- */
-#ifndef MakefileSubdirs
-#define MakefileSubdirs(dirs) @@\
-MakeMakeSubdirs(dirs,Makefiles)
-#endif /* MakefileSubdirs */
-
-
-
-/*
- * Translate XCOMM into pound sign with sed, rather than passing -DXCOMM=XCOMM
- * to cpp, because that trick does not work on all ANSI C preprocessors.
- * Also delete line numbers from the cpp output (-P is not portable, I guess).
- */
-#ifndef CppSedMagic
-#define CppSedMagic sed -e '/^# *[0-9][0-9]* *.*$$/d' -e '/^XCOMM$$/s//#/' -e '/^XCOMM[^a-zA-Z0-9_]/s/^XCOMM/#/' -e '/^# [0-9][0-9]/d' -e '/^#line /d'
-#endif /* CppSedMagic */
-
-/*
- * CppScriptTarget - generate rules to create a shell script by running the
- * input through cpp. If the ExecableScripts configuration parameter is not
- * set, then make sure that the first line begins with a colon.
- */
-#ifndef CppScriptTarget
-#if ExecableScripts /* can use #! instead of colon */
-#define CppScriptTarget(dst,src,defs,deplist) @@\
-dst:: src deplist @@\
- RemoveFile($@) @@\
- $(CPP) defs <src | CppSedMagic >$@ @@\
- chmod a+x $@ @@\
- @@\
-clean:: @@\
- RemoveFile(dst)
-#else
-#define CppScriptTarget(dst,src,defs,deplist) @@\
-dst:: src deplist @@\
- RemoveFile($@) @@\
- echo \: >$@ @@\
- sed '1d' src | $(CPP) defs | CppSedMagic >>$@ @@\
- chmod a+x $@ @@\
- @@\
-clean:: @@\
- RemoveFile(dst)
-#endif /* ExecableScripts */
-#endif /* CppScriptTarget */
-
-
-/*
- * MakeScriptFromCpp - generate rules to create a script from a file with a
- * .cpp suffix.
- */
-#ifndef MakeScriptFromCpp
-#define MakeScriptFromCpp(name,defs) @@\
-CppScriptTarget(name,name.cpp,defs,NullParameter)
-#endif /* MakeScriptFromCpp */
-
-#ifndef CppFileTarget
-#define CppFileTarget(dst,src,defs,deplist) @@\
-dst:: src deplist @@\
- RemoveFile($@) @@\
- $(CPP) defs <src | CppSedMagic >$@ @@\
- @@\
-clean:: @@\
- RemoveFiles(dst)
-#endif /* CppFileTarget */
-
-/*
- * MakeDirectories - generate rules to create a hierarchy of directories.
- */
-#ifndef MakeDirectories
-#define MakeDirectories(step,dirs) @@\
-step:: @@\
- @case '${MFLAGS}' in *[i]*) set +e;; esac; @@\
- DirFailPrefix at for i in dirs; do if [ -d $(DESTDIR)$$i ]; then \ @@\
- set +x; else (set -x; $(MKDIRHIER) $(DESTDIR)$$i); fi \ @@\
- done
-#endif /* MakeDirectories */
-
-
-/*
- * AllTarget - generate rules to build necessary things during make all.
- */
-#ifndef AllTarget
-#define AllTarget(depends) @@\
-all:: depends
-#endif /* AllTarget */
-
-#ifdef DefineOldLibraryRules
-#include <oldlib.rules>
-#endif
-
-/* Additions for CERN program library--------------------------- */
-
-#ifndef TopOfPackage
-#define TopOfPackage(package)PACKAGETOP=$(CURRENT_DIR) @@\
-PACKAGE_NAME=package
-#endif
-
-#ifndef MakeSubDirs
-#define MakeSubDirs(dirs) @@\
-directories: dirs @@\
- @@\
-dirs: @@\
- mkdir $@
-#endif
-
-/*
- * MakeSubdirsMakefiles - generate rules to create subdirectories and Makefiles
- */
-#ifndef MakeSubdirsMakefiles
-#define MakeSubdirsMakefiles(dirs,target)\ @@\
-NamedTargetSubdirs(target,dirs,Checking Makefiles,VERSION=nil,target) @@\
-MakeSubdirMakefile(dirs)
-#endif
-/*
- * MakeSubdirMakefile - rule to create subdirectory/Makefile, one at a time
- */
-#ifndef MakeSubdirMakefile
-#define MakeSubdirMakefile(dirs) @@\
-$(foreach dir,dirs,$(dir)/Makefile): @@\
- - at case '${MFLAGS}' in *[ik]*) set +e;; esac; \ @@\
- case '${MFLAGS}' in -*n*) executeit="no";; esac; \ @@\
- i=`dirname $@`; \ @@\
- case "$(CURRENT_DIR)" in \ @@\
- .) curdir= ;; \ @@\
- *) curdir=$(CURRENT_DIR)/ ;; \ @@\
- esac; \ @@\
- echo "making Makefiles in $$curdir$$i..."; \ @@\
- itmp="$$i" \ @@\
- curtmp="$(CURRENT_DIR)" \ @@\
- toptmp=""; \ @@\
- case "$$itmp" in \ @@\
- ../?*) \ @@\
- while echo "$$itmp" | grep '^../' > /dev/null;\ @@\
- do \ @@\
- toptmp="/`basename $$curtmp`$$toptmp"; \ @@\
- curtmp="`dirname $$curtmp`"; \ @@\
- itmp="`echo $$itmp | sed 's;../;;'`"; \ @@\
- done \ @@\
- ;; \ @@\
- esac; \ @@\
- case "$$itmp" in \ @@\
- */?*/?*/?*/?*) newtop=../../../../..;; \ @@\
- */?*/?*/?*) newtop=../../../..;; \ @@\
- */?*/?*) newtop=../../..;; \ @@\
- */?*) newtop=../..;; \ @@\
- *) newtop=..;; \ @@\
- esac; \ @@\
- newtop="$$newtop$$toptmp"; \ @@\
- case "$(TOP)" in \ @@\
- /?*) imaketop=$(TOP) \ @@\
- imakeprefix= ;; \ @@\
- .) imaketop=$$newtop \ @@\
- imakeprefix=$$newtop/ ;; \ @@\
- *) imaketop=$$newtop/$(TOP) \ @@\
- imakeprefix=$$newtop/ ;; \ @@\
- esac; \ @@\
- if [ ! -d $$i ]; then \ @@\
- MkdirHierCmd $$i; \ @@\
- fi; \ @@\
- cd $$i; \ @@\
- RemoveFile(Makefile.bak); \ @@\
- if [ -f Makefile ]; then \ @@\
- true; \ @@\
- else \ @@\
- for imakedir in $$newtop $(VPATH); do \ @@\
- imakefile=`echo $$imakedir/$$i/Imakefile | \ @@\
- sed -e 's://:/:'`; \ @@\
- if [ -f $$imakefile ]; then break;fi; \ @@\
- done; \ @@\
- if [ ! -f $$imakefile ]; then \ @@\
- echo "No Imakefile found --> exit"; \ @@\
- exit 1; \ @@\
- fi; \ @@\
- if [ "$$executeit" != "no" ]; then \ @@\
- ImakeSubCmdHelper -DTOPDIR=$$imaketop \ @@\
- -DCURDIR=$$curdir$$i \ @@\
- -DPackageTop=$(PACKAGETOP) \ @@\
- -DPackageName=$(PACKAGE_NAME) \ @@\
- -f $$imakefile; \ @@\
- fi; \ @@\
- fi;
-#endif
-
-/*
- * Win32Path is dummy, except on Win32
- */
-#ifndef Win32Path
-#define Win32Path(arg)arg
-#endif
-
-/* DefinePackageLibrary
- * get the path/name of the library for the current package
- * and possible add a local library
- *
- */
-#ifndef DefinePackageLibrary
-#define DefinePackageLibrary(locallib) \
-ifeq ($(strip $(PACKAGE_LIB)),) @@\
-PACKAGE_LIB=$(TOP)$(PACKAGETOP)/LibraryTargetName($(PACKAGE_NAME)) @@\
-endif @@\
-ifneq (locallib,) @@\
-override PACKAGE_LIB:= LibraryTargetName(locallib) $(PACKAGE_LIB) @@\
- @@\
-endif
-#endif
-
-/*
- * LinkFileFromDir(dir,file)
- * create a symlink ( or copy that file ) to a file in another dir
- */
-#ifndef LinkFileFromDir
-#define LinkFileFromDir(dir,file) @@\
-file: dir/file @@\
- RemoveFile(file) @@\
- LnCmd Win32Path($<) Win32Path($@)
-#endif
-
-/* TestTarget
- * create a targets to link and run tests.
- *
- */
-#ifndef TestTarget
-#define TestTarget(program,data,inputdata) \ @@\
-.PHONY: test @@\
- @@\
-ifeq ($(strip $(QUOTE) inputdata $(QUOTE)),$(QUOTE) $(QUOTE)) @@\
-test:: ProgramTargetName(program) data inputdata @@\
- @echo Testing $(PACKAGE_NAME) @@\
- @echo " ... using" program @@\
- @Concat(.,$(PATHSEP))ProgramTargetName(program) @@\
- @@\
-else @@\
-test:: ProgramTargetName(program) data inputdata @@\
- @echo Testing $(PACKAGE_NAME) @@\
- @echo " ... using" program @@\
- @Concat(.,$(PATHSEP))ProgramTargetName(program) < inputdata @@\
- @@\
-endif @@\
- @@\
-clean:: @@\
- RemoveFile(ProgramTargetName(program)) @@\
- RemoveFiles(core *.log data inputdata)
-#endif
-
-/*
- * TestSubdirs - generate rules to recursively build and run tests.
- */
-#ifndef NamedTestSubdirs
-#define NamedTestSubdirs(name,dirs) \
-NamedTargetSubdirs(name,dirs,"testing",PACKAGE_LIB=$(PACKAGE_LIB),test)
-#endif /* TestSubdirs */
-
-/*
- * SubdirDataFile - rule to build a data file in subdir
- *
- */
-#ifndef SubdirDataFile
-#define SubdirDataFile(target,file,subdir) @@\
-target:: file @@\
- @@\
-NamedTargetSubdirs(file,subdir,Makeing file,PACKAGETOP=$(PACKAGETOP),$(TOP)$(CURRENT_DIR)/file)
-#endif
-
-/*
- * PackageDirFileTarget(file) copy a file to the PACKAGETOP directory
- */
-#ifndef PackageDirFileTarget
-#define PackageDirFileTarget(file) CopyFile(file,$(TOP)$(PACKAGETOP)/file)
-#endif
-
-/*
- * CopyFile(fromfile,tofile) copy a file
- */
-#ifndef CopyFile
-#define CopyFile(fromfile,tofile) @@\
-tofile:: fromfile @@\
- @RemoveFile($@) @@\
- $(CP) Win32Path($<) Win32Path($@) @@\
- @@\
-clean:: @@\
- @RemoveFile(tofile)
-#endif
-
-#ifndef TestSubdirs
-#define TestSubdirs(dirs) \
-NamedTestSubdirs(test,dirs)
-#endif
-
-#ifndef DoIncludePackage
-#define DoIncludePackage(pack)\ @@\
-IMAKE_INCLUDES=-I$(TOP)$(PACKAGETOP)/pack\ @@\
- -I$(PROJECTROOT)$(LOCALTOP)$(PACKAGETOP)/pack
-#endif
-
-#ifndef Quote
-#define Quote(string)$(strip $(QUOTE) string $(QUOTE))
-#endif
-
-/*
- * UpdateIncludeDir
- * copy include files from local to installed directory
- *
- */
-#ifndef InstallIncludes
-#define InstallIncludes(files,dir,subdir)\ @@\
-ifneq ($(strip dir),) @@\
-install.include:: $(foreach file,files,$(DESTDIR)dir/subdir/$(file)) @@\
- @@\
-$(foreach file,files,$(DESTDIR)dir/subdir/$(file)):\ @@\
-$(DESTDIR)dir/subdir/%: % @@\
- MakeDir($(DESTDIR)dir/subdir) @@\
- RemoveFile($@) @@\
- $(INSTALL) $(INSTALLFLAGS) $(INSTINCFLAGS) $< $@ @@\
- @@\
-else @@\
-install.include:: @@\
- @@\
-endif
-#endif /* InstallNamedTarget */
-
-
-/*
- * Delegate a target to a sub directory (or directories)
- */
-#ifndef DelegateTarget
-#define DelegateTarget(target,dirs)\
-NamedTargetSubdirs(target,dirs,Makeing target,NullParameter,target)
-#endif
-
-/*
- * Create a Make Variable to allow to flags systems without Motif
- */
-#ifndef MotifDependantMakeVar
-#define MotifDependantMakeVar(variable,value) @@\
-variable=value @@\
-
-#endif
-
-/*
- * NT needs to massage names of objects from .o to ...
- */
-#ifndef SetWin32ObjSuffix
-#define SetWin32ObjSuffix(objs)objs
-#endif
-
-
-/* The end*/
-
diff --git a/src/config/Imake.tmpl b/src/config/Imake.tmpl
deleted file mode 100644
index 054fb04..0000000
--- a/src/config/Imake.tmpl
+++ /dev/null
@@ -1,1422 +0,0 @@
-/* $Id: Imake.tmpl,v 1.18 2001/09/21 16:02:11 mclareni Exp $
- *
- * $Log: Imake.tmpl,v $
- * Revision 1.18 2001/09/21 16:02:11 mclareni
- * Add CcLinkCmd definition, primarily for osf1
- *
- * Revision 1.17 1997/03/17 15:56:04 gunter
- * Use FortranDepend from fortran.rules to insert dependecy rule
- *
- * Revision 1.16 1997/02/28 10:35:12 gunter
- * use .Osuf instead of .o
- *
- * Taken from WNT changed file
- * add Expand and Append macros to replace Concat()
- *
- * Revision 1.15 1996/11/13 13:27:35 cernlib
- * Add a TOUCH make variable.
- *
- * Revision 1.14 1996/05/01 11:59:17 cernlib
- * add FPP; this is the preprocessor used with fortran
- *
- * Revision 1.13 1996/05/01 11:54:41 gunter
- * Introduce new way of building libraries.
- * CVS:----------------------------------------------------------------------
- *
- * Revision 1.12 1996/04/02 21:01:46 thakulin
- * Add support for Apogee and EPC C and Fortran compilers (presently
- * only on Sun platform). Introduce HasApogee and HasEPC Imake
- * macros plus other supporting macros (CernlibCCDefines, CernlibFCDefines,
- * FortranLoadFlags, ImakeCompilerSelect, UseImakeCompilerSelect).
- * Fix one erroneus test of FortranDoesCpp.
- *
- * Revision 1.11 1996/04/02 10:09:41 cernlib
- * Add dummies for macros needed on VMS.
- *
- * Revision 1.10 1996/03/08 17:12:08 cernlib
- * *** empty log message ***
- *
- * Revision 1.9 1996/03/07 13:14:08 maartenb
- * - Fixed merge failure.
- *
- * - Added defs for PIF ( Position Independent Fortran ) flags
- * followed the scheme for C++
- *
- * Revision 1.8 1996/03/06 11:04:16 cernlib
- * Imake.tmpl : Correct rule to run kuipc
- * fortran.rules: echo makedepend
- * site.def: undef MakeCmd before #define ( Sun has this defined to ..openwin...)
- * *.cf : small mods
- *
- * Revision 1.7 1996/03/04 17:30:36 cernlib
- * Parametrize Ansi C compiel options. other small mods
- *
- * Revision 1.6 1996/02/23 17:16:41 cernlib
- * add provsions for X11/ Motfid include files.
- * and some other small corrections
- *
- * Revision 1.5 1996/02/14 11:03:32 cernlib
- * add provisions for running tests
- *
- * Revision 1.4 1996/02/01 16:08:32 cernlib
- * Various changes in FOTRANDEFINES ( for IBM, and Makedepend)
- * make cc default c compiler in aix
- * use /usr/lib/X11/bin/makedepend on SunOS and Solaris
- *
- * Revision 1.3 1996/01/25 11:22:47 cernlib
- * Values for IMAKE and MAKEDEPEND are used from env. variables if defined, else
- * from command search path.
- * Correct fortran options for local (not archive,..) compilation.
- *
- * Revision 1.2 1995/12/21 11:32:08 cernlib
- * Imake files end 1995
- *
- * Revision 1.1.1.1 1995/12/20 15:26:43 cernlib
- * X11R6 config files unmodified
- *
- *
- */
-#define XCOMM #
-XCOMM ----------------------------------------------------------------------
-XCOMM Makefile generated from IMAKE_TEMPLATE and INCLUDE_IMAKEFILE
-XCOMM $XConsortium: Imake.tmpl,v 1.224.1.1 95/06/19 17:51:01 gildea Exp $
-XCOMM
-
-/*
- * generic imake template
- */
-
-/*
- * Modify Imake.cf when adding a new architecture, do not modify this file.
- * Platform-specific parameters may be set in the appropriate <vendor>.cf
- * configuration files. Site-specific parameters should be set in the file
- * site.def. Full rebuilds are recommended if any parameters are changed.
- * If your C preprocessor does not define any unique symbols, you will need
- * to set BOOTSTRAPCFLAGS when rebuilding imake (usually when doing
- * "make World" the first time).
- */
-
-#define ImakeConfigRelease 6
-
-#define YES 1
-#define NO 0
-
-.SUFFIXES: .i
-
-#include <Imake.cf>
-
-XCOMM -----------------------------------------------------------------------
-XCOMM site-specific configuration parameters that need to come before
-XCOMM the platform-specific parameters - edit site.def to change
-#define BeforeVendorCF
-#include <site.def>
-#undef BeforeVendorCF
-
-#if defined(HasGcc2) && !defined(HasGcc)
-#define HasGcc HasGcc2
-#endif
-
-XCOMM -----------------------------------------------------------------------
-XCOMM platform-specific configuration parameters - edit MacroFile to change
-#include MacroIncludeFile
-
-XCOMM -----------------------------------------------------------------------
-XCOMM site-specific configuration parameters that go after
-XCOMM the platform-specific parameters - edit site.def to change
-#define AfterVendorCF
-#include <site.def>
-#undef AfterVendorCF
-
-/*
- * defaults for various generic parameters; set in site.def if needed
- */
-
-/* the following are needed before we can include Imake.rules */
-
-#ifndef SystemV
-#define SystemV NO /* SYSV (R3) */
-#endif
-#ifndef SystemV4
-#define SystemV4 NO /* SVR4 */
-#endif
-#ifndef HasCodeCenter
-#define HasCodeCenter NO
-#endif
-#ifndef HasSentinel
-#define HasSentinel NO
-#endif
-#ifndef HasPurify
-#define HasPurify NO
-#endif
-#ifndef HasTestCenter
-#define HasTestCenter NO
-#endif
-#ifndef RemoveTargetProgramByMoving
-#define RemoveTargetProgramByMoving NO
-#endif
-#ifndef DoRanlibCmd
-#if SystemV || SystemV4
-#define DoRanlibCmd NO
-#else
-#define DoRanlibCmd YES
-#endif
-#endif
-#ifndef ExecableScripts
-#if SystemV
-#define ExecableScripts NO
-#else
-#define ExecableScripts YES /* kernel exec() can handle #! */
-#endif
-#endif
-
-#ifdef WIN32
-# include <Win32.rules>
-
-# ifdef HasFortran
-# include "Win32.biglib.rules"
-# include <Win32.fortran.rules>
-# endif
-#endif
-
-#include <Imake.rules>
-
-#ifndef HasSharedLibraries
-#define HasSharedLibraries NO
-#endif
-#ifndef OSMajorVersion
-#define OSMajorVersion 0
-#endif
-#ifndef OSMinorVersion
-#define OSMinorVersion 0
-#endif
-#ifndef UnalignedReferencesAllowed
-#define UnalignedReferencesAllowed NO /* if arbitrary deref is okay */
-#endif
-#ifndef AvoidNullMakeCommand
-#define AvoidNullMakeCommand NO
-#endif
-#if AvoidNullMakeCommand
-/*
- * An obscure bug in BSD4.3's original make causes it not to recognize a
- * macro definition if the macro name starts with a non-alpha and in
- * column one.
- */
- _NULLCMD_ = @ echo -n
-#endif
-
-#ifndef CrossCompiling
-#define CrossCompiling NO
-#endif
-#ifndef BourneShell /* to force shell in makefile */
-#define BourneShell /bin/sh
-#endif
-#ifndef ConstructMFLAGS
-#if SystemV
-#define ConstructMFLAGS YES /* build MFLAGS from MAKEFLAGS */
-#else
-#define ConstructMFLAGS NO /* build MFLAGS from MAKEFLAGS */
-#endif
-#endif
-
-#ifndef HasLargeTmp
-#define HasLargeTmp NO /* be paranoid */
-#endif
-
-#ifndef HasBSD44Sockets
-#define HasBSD44Sockets NO
-#endif
-#ifndef HasSockets
-#define HasSockets YES
-#endif
-#ifndef HasStreams
-#define HasStreams !HasSockets
-#endif
-#ifndef HasDECnet
-#define HasDECnet NO
-#endif
-#ifndef HasPoll
-#if SystemV || SystemV4
-#define HasPoll YES
-#else
-#define HasPoll NO
-#endif
-#endif
-#ifndef HasVFork
-#if SystemV
-#define HasVFork NO /* not yet... */
-#else
-#define HasVFork YES
-#endif
-#endif
-#ifndef HasPutenv
-#define HasPutenv NO /* assume not */
-#endif
-#ifndef HasVoidSignalReturn
-#define HasVoidSignalReturn YES /* assume yes */
-#endif
-#ifndef HasBsearch
-#define HasBsearch YES /* assume yes */
-#endif
-#ifndef HasFortran
-#define HasFortran NO
-#endif
-#ifndef HasCplusplus
-#if HasGcc2ForCplusplus
-#define HasCplusplus YES
-#else
-#define HasCplusplus NO
-#endif
-#endif
-#ifndef HasNdbm
-#define HasNdbm NO
-#endif
-#ifndef HasSecureRPC
-#define HasSecureRPC NO /* if you have Secure RPC */
-#endif
-#ifndef HasKrb5
-#define HasKrb5 NO /* if you have Kerberos V5 */
-#endif
-#ifndef HasLatex
-#define HasLatex YES
-#endif
-#ifndef HasShm
-#if SystemV || SystemV4
-#define HasShm YES
-#else
-#define HasShm NO
-#endif
-#endif
-#if HasKrb5
-#ifndef Krb5Includes
-#define Krb5Includes -I/krb5/include
-#endif
-#ifndef Krb5Libraries
-#define Krb5Libraries -L/krb5/lib -L/usr/isode/lib -lkrb5 -lcrypto -lisode -lcom_err -ldbm
-#endif
-#else
-#undef Krb5Includes
-#define Krb5Includes /**/
-#undef Krb5Libraries
-#define Krb5Libraries /**/
-#endif
-#ifndef NeedConstPrototypes
-#define NeedConstPrototypes NO
-#endif
-#ifndef NeedVarargsPrototypes
-#define NeedVarargsPrototypes NO
-#endif
-#ifndef NeedNestedPrototypes
-#define NeedNestedPrototypes NO
-#endif
-#ifndef NeedFunctionPrototypes
-#define NeedFunctionPrototypes (NeedVarargsPrototypes || NeedNestedPrototypes)
-#endif
-#ifndef NeedWidePrototypes
-#define NeedWidePrototypes YES /* mix and match ANSI-C, non-ANSI */
-#endif
-
-#ifndef StripInstalledPrograms
-#define StripInstalledPrograms NO /* leave symbol table just in case */
-#endif
-#ifndef UseCCMakeDepend /* use slow cc -E script */
-#define UseCCMakeDepend NO
-#endif
-
-/* DefaultUsrBin is independent of ProjectRoot.
- This is a directory where programs will be found even if PATH
- is not set, for example when coming in remotely via rsh. */
-#ifndef DefaultUsrBin
-#define DefaultUsrBin /usr/bin
-#endif
-
-#ifndef UsrLibDir
-#ifdef ProjectRoot
-#define UsrLibDir Concat(ProjectRoot,/lib)
-#ifndef AlternateUsrLibDir
-#define AlternateUsrLibDir YES
-#endif
-#else
-#define UsrLibDir /usr/lib
-#ifndef AlternateUsrLibDir
-#define AlternateUsrLibDir NO
-#endif
-#endif
-#else
-#ifndef AlternateUsrLibDir
-#define AlternateUsrLibDir YES
-#endif
-#endif
-#ifndef ShLibDir
-#define ShLibDir UsrLibDir
-#endif
-#ifndef IncRoot
-#ifdef ProjectRoot
-#define IncRoot Concat(ProjectRoot,/include)
-#ifndef AlternateIncRoot
-#define AlternateIncRoot YES
-#endif
-#else
-#define IncRoot /usr/include
-#ifndef AlternateIncRoot
-#define AlternateIncRoot NO
-#endif
-#endif
-#else
-#ifndef AlternateIncRoot
-#define AlternateIncRoot YES
-#endif
-#endif
-#ifndef LintlibDir
-#define LintlibDir $(USRLIBDIR)/lint
-#endif
-#ifndef SystemManDirectory
-#if SystemV4
-#define SystemManDirectory /usr/share/man
-#else
-#define SystemManDirectory /usr/man
-#endif
-#endif
-#ifndef ManDirectoryRoot
-#ifdef ProjectRoot
-#define ManDirectoryRoot Concat(ProjectRoot,/man)
-#else
-#define ManDirectoryRoot SystemManDirectory
-#endif
-#endif
-#ifndef ManPath
-#define ManPath ManDirectoryRoot
-#endif
-#ifndef ManSourcePath
-#define ManSourcePath $(MANPATH)/man
-#endif
-#ifndef ManDir
-#define ManDir $(MANSOURCEPATH)$(MANSUFFIX)
-#endif
-#ifndef LibmanDir
-#define LibmanDir $(MANSOURCEPATH)$(LIBMANSUFFIX)
-#endif
-#ifndef FileManDir
-#define FileManDir $(MANSOURCEPATH)$(FILEMANSUFFIX)
-#endif
-#ifndef ConfigSrc
-#define ConfigSrc $(CVSCOSRC)/config
-#endif
-#ifndef DependDir
-#if UseCCMakeDepend
-#define DependDir $(CONFIGSRC)/util
-#else
-#define DependDir $(CONFIGSRC)/makedepend
-#endif
-#endif
-#ifndef UNCOMPRESSPATH
-#define UNCOMPRESSPATH /usr/ucb/uncompress
-#endif
-#ifndef OptimizedCDebugFlags
-#define OptimizedCDebugFlags -O
-#endif
-#ifndef OptimizedCplusplusDebugFlags
-#define OptimizedCplusplusDebugFlags OptimizedCDebugFlags
-#endif
-#ifndef DebuggableCDebugFlags
-#define DebuggableCDebugFlags -g
-#endif
-#ifndef DebuggableCplusplusDebugFlags
-#define DebuggableCplusplusDebugFlags DebuggableCDebugFlags
-#endif
-#ifndef ProfiledCDebugFlags
-#define ProfiledCDebugFlags -pg
-#endif
-#ifndef ProfiledCplusplusDebugFlags
-#define ProfiledCplusplusDebugFlags ProfiledCDebugFlags
-#endif
-#ifndef NoOpCDebugFlags
-#define NoOpCDebugFlags /**/
-#endif
-#ifndef DefaultCDebugFlags
-#define DefaultCDebugFlags OptimizedCDebugFlags
-#endif
-#ifndef CcAnsiMode
-#define CcAnsiMode /**/
-#endif
-#ifndef CcStrictAnsiMode
-#define CcStrictAnsiMode /**/
-#endif
-
-#ifndef DefaultCplusplusDebugFlags
-#define DefaultCplusplusDebugFlags OptimizedCplusplusDebugFlags
-#endif
-#ifndef DefaultCCOptions
-#define DefaultCCOptions /* floating point, etc. */
-#endif
-#ifndef DefaultCplusplusOptions
-#define DefaultCplusplusOptions /* floating point, etc. */
-#endif
-#ifndef NoRConst
-#define NoRConst NO /* YES if const for structs of funcs is bad */
-#endif
-#ifndef InstPgmFlags
-#define InstPgmFlags -s
-#endif
-#ifndef InstBinFlags
-#define InstBinFlags -m 0755
-#endif
-#ifndef InstUidFlags
-#define InstUidFlags -m 4755
-#endif
-#ifndef InstLibFlags
-#define InstLibFlags -m 0644
-#endif
-#ifndef InstIncFlags
-#define InstIncFlags -m 0444
-#endif
-#ifndef InstManFlags
-#define InstManFlags -m 0444
-#endif
-#ifndef InstDatFlags
-#define InstDatFlags -m 0444
-#endif
-#ifndef InstKmemFlags /* put -g kmem -m 2755 in site.def... */
-#define InstKmemFlags InstUidFlags
-#endif
-#ifndef ArCmdBase
-#define ArCmdBase ar
-#endif
-#ifndef ArCmd
-#if HasLargeTmp || SystemV4
-#define ArCmd ArCmdBase cq
-#else
-#define ArCmd ArCmdBase clq
-#endif
-#endif
-#ifndef ArAddCmd
-#if HasLargeTmp || SystemV4
-#define ArAddCmd ArCmdBase ru
-#else
-#define ArAddCmd ArCmdBase rul
-#endif
-#endif
-#ifndef ArExtCmd
-#if HasLargeTmp || SystemV4
-#define ArExtCmd ArCmdBase x
-#else
-#define ArExtCmd ArCmdBase xl
-#endif
-#endif
-
-#ifndef XargsCmd
-#define XargsCmd xargs
-#endif
-
-#ifndef BootstrapCFlags
-#define BootstrapCFlags /**/
-#endif
-#ifndef HasGcc2
-#define HasGcc2 NO
-#endif
-#ifndef HasGcc
-#define HasGcc HasGcc2
-#endif
-#ifndef HasGcc2ForCplusplus
-#define HasGcc2ForCplusplus NO
-#endif
-#ifndef HasCenterLineC
-#define HasCenterLineC NO
-#endif
-#ifndef HasApogee
-#define HasApogee NO
-#endif
-#ifndef HasEPC
-#define HasEPC NO
-#endif
-#ifndef HasCenterLineCplusplus
-#define HasCenterLineCplusplus NO
-#endif
-#ifndef CcCmd
-#if HasGcc2
-#define CcCmd gcc -fpcc-struct-return
-#else
-#if HasGcc
-#define CcCmd gcc -fstrength-reduce -fpcc-struct-return
-#else
-#if HasCenterLineC
-#define CcCmd clcc
-#else
-#if HasApogee
-#define CcCmd apcc
-#define CernlibCCDefines -DCERNLIB_QFAPOGEE
-#define CERNLIB_QFAPOGEE
-#else
-#if HasEPC
-#define CcCmd ecc
-#define CernlibCCDefines -DCERNLIB_QFEPC
-#define CERNLIB_QFEPC
-#else
-#define CcCmd cc
-#endif
-#endif
-#endif
-#endif
-#endif
-#endif
-#ifndef CplusplusCmd
-#if HasGcc2ForCplusplus
-#define CplusplusCmd g++
-#else
-#define CplusplusCmd CC
-#endif
-#endif
-#ifndef CplusplusStandardDefines
-#define CplusplusStandardDefines StandardDefines
-#endif
-#ifndef CplusplusExtraDefines
-#define CplusplusExtraDefines /**/
-#endif
-#ifndef CplusplusExtraIncludes
-#define CplusplusExtraIncludes /**/
-#endif
-#ifndef CplusplusDependIncludes
-#define CplusplusDependIncludes /**/
-#endif
-#ifndef CplusplusOptions
-#define CplusplusOptions /**/
-#endif
-#ifndef CplusplusSpecialOptions
-#define CplusplusSpecialOptions /**/
-#endif
-
-#ifndef CcLinkCmd
-#define CcLinkCmd CcCmd
-#endif
-
-#if HasFortran
-
-#ifndef FortranCmd
-#if HasApogee
-#define FortranCmd apf77
-#define CernlibFCDefines CernlibCCDefines
-#else
-#if HasEPC
-#define FortranCmd epcf90
-#define CernlibFCDefines CernlibCCDefines
-#else
-#define FortranCmd f77
-#endif
-#endif
-#endif
-
-#ifndef FortranCppCmd
-#define FortranCppCmd CppCmd
-#endif
-#ifndef FortranFlags
-#define FortranFlags /**/
-#endif
-#ifndef FortranLoadFlags /* flags to add when using the Fortran driver as a loader */
-#define FortranLoadFlags /**/
-#endif
-#ifndef FortranSaveFlags /* flags to compile with SAVEing all variables*/
-#define FortranSaveFlags /**/
-#endif
-#ifndef FortranNoSaveFlags /* flags to turn OFF SAVEing all variables */
-#define FortranNoSaveFlags /**/
-#endif
-#ifndef OptimisedFortranFlags /* flag to optimise */
-#define OptimisedFortranFlags -O
-#endif
-#ifndef DebuggableFortranDebugFlags /* flags to turn on debugging info */
-#define DebuggableFortranDebugFlags -g
-#endif
-#ifndef NoOpFortranDebugFlags /* flags NOT to turn on optimisation or debug*/
-#define NoOpFortranDebugFlags /**/
-#endif
-#ifndef DefaultFCOptions /* for default options like +ppu.. */
-#define DefaultFCOptions /**/
-#endif
-#ifndef FortranDebugFlags /* flags to turn on debug and/or optimasatio */
-#define FortranDebugFlags OptimisedFortranFlags
-#endif
-#ifndef FortranLinkCmd
-#define FortranLinkCmd FortranCmd
-#endif
-#endif /* HasFortran */
-/* dummy macros for Unix; these are needed on VMS */
-#ifndef NeedTcpipLib
-#define NeedTcpipLib /**/
-#endif
-#ifndef NeedSysexe
-#define NeedSysexe /**/
-#endif
-#ifndef NeedgethostnameObj
-#define NeedgethostnameObj /**/
-#endif
-/* end dummy Macros */
-#ifndef AsCmd
-#define AsCmd as
-#endif
-#ifndef CompressCmd
-#define CompressCmd compress
-#endif
-#ifndef CppCmd
-#define CppCmd /lib/cpp
-#endif
-#ifndef PreProcessCmd
-#define PreProcessCmd CcCmd -E
-#endif
-#ifndef InstallCmd /* hack should be in project */
-#if SystemV || SystemV4
-#ifdef UseInstalled /* assume BINDIR in path */
-#define InstallCmd bsdinst
-#else
-#define InstallCmd $(SHELL) $(CONFIGSRC)/util/bsdinst.sh
-#endif
-#else
-#define InstallCmd install
-#endif
-#endif
-#ifndef InstallFlags
-#define InstallFlags -c
-#endif
-#ifndef LdCmd
-#define LdCmd ld
-#endif
-#ifndef LexCmd
-#define LexCmd lex
-#endif
-#ifndef LexLib
-#define LexLib -ll
-#endif
-#ifndef YaccCmd
-#define YaccCmd yacc
-#endif
-#ifndef CplusplusYaccCmd
-#define CplusplusYaccCmd YaccCmd
-#endif
-#ifndef LintCmd
-#define LintCmd lint
-#endif
-#ifndef LintLibFlag
-#if SystemV || SystemV4
-#define LintLibFlag -o
-#else
-#define LintLibFlag -C
-#endif
-#endif
-#ifndef LintOpts
-#if SystemV || SystemV4
-#define LintOpts -bh
-#else
-#define LintOpts -axz
-#endif
-#endif
-#ifndef CpCmd
-#define CpCmd cp
-#endif
-#ifndef HasSymLinks
-#define HasSymLinks YES
-#endif
-#ifndef LnCmd /* can use cp instead of ln if necessary */
-#if HasSymLinks
-#define LnCmd ln -s
-#else
-#define LnCmd ln
-#endif
-#endif
-#ifndef MakeCmd
-#define MakeCmd make
-#endif
-#ifndef MvCmd
-#define MvCmd mv
-#endif
-#ifndef RanlibCmd
-#define RanlibCmd ranlib
-#endif
-#ifndef TouchCmd
-#define TouchCmd touch
-#endif
-#ifndef RanlibInstFlags
-#define RanlibInstFlags /**/
-#endif
-#ifndef RmCmd
-#define RmCmd rm -f
-#endif
-#ifndef SedCmd
-#define SedCmd sed
-#endif
-#ifndef StandardIncludes /* for platform-specifics */
-#define StandardIncludes /**/
-#endif
-#ifndef MotifIncludes
-#define MotifIncludes /**/
-#endif
-#ifndef X11Includes
-#define X11Includes /**/
-#endif
-#ifndef StandardDefines
-#if SystemV
-#define StandardDefines -DSYSV
-#else
-#if SystemV4
-#define StandardDefines -DSVR4
-#else
-#define StandardDefines /**/
-#endif
-#endif
-#endif
-#ifndef StandardCppDefines
-#define StandardCppDefines StandardDefines
-#endif
-#ifndef Malloc0ReturnsNull
-#define Malloc0ReturnsNull NO
-#endif
-#ifndef ToolkitStringsABIOptions
-#define ToolkitStringsABIOptions /**/
-#endif
-#ifndef NdbmDefines
-#if HasNdbm
-#define NdbmDefines -DNDBM
-#else
-#define NdbmDefines /**/
-#endif
-#endif
-#ifndef LdPreLib
-#if !defined(UseInstalled)
-#define LdPreLib -L$(BUILDLIBDIR)
-#else
-#if AlternateUsrLibDir
-#define LdPreLib -L$(USRLIBDIR)
-#else
-#define LdPreLib /**/
-#endif
-#endif
-#endif
-#ifndef LdPostLib
-#if !defined(UseInstalled) && AlternateUsrLibDir && !HasLdRunPath
-#define LdPostLib -L$(USRLIBDIR)
-#else
-#define LdPostLib /**/
-#endif
-#endif
-#ifndef MathLibrary
-#define MathLibrary -lm
-#endif
-#ifndef DBMLibrary
-#define DBMLibrary -ldbm
-#endif
-#ifndef ExtraLibraries
-#if SystemV4
-#if HasSockets
-#define ExtraLibraries -lsocket -lnsl -lw
-#else
-#define ExtraLibraries -lnsl -lw
-#endif
-#else
-#define ExtraLibraries /**/
-#endif
-#endif
-#ifndef ExtraLoadOptions
-#define ExtraLoadOptions /**/
-#endif
-#ifndef ExtraLoadFlags
-#define ExtraLoadFlags /**/
-#endif
-#ifndef LdCombineFlags
-#if SystemV4
-#define LdCombineFlags -r
-#else
-#define LdCombineFlags -X -r
-#endif
-#endif
-#ifndef LdStripFlags
-#define LdStripFlags -x
-#endif
-#ifndef TagsCmd
-#define TagsCmd ctags
-#endif
-#ifndef LoaderLibPrefix
-#define LoaderLibPrefix /**/
-#endif
-#ifndef ImakeCmd
-#ifdef UseInstalled /* assume BINDIR in path */
-#define ImakeCmd imake
-#else
-#define ImakeCmd $(IMAKESRC)/imake
-#endif
-#endif
-#ifndef DependCmd
-#ifdef UseInstalled /* assume BINDIR in path */
-#define DependCmd makedepend
-#else
-#define DependCmd $(DEPENDSRC)/makedepend
-#endif
-#endif
-#ifndef DependFlags
-#define DependFlags /**/
-#endif
-#ifndef IxxCmd
-#ifdef UseInstalled
-#define IxxCmd ixx /* assume BINDIR in path */
-#else
-#define IxxCmd $(IXXSRC)/ixx
-#endif
-#endif
-#ifndef IxxFlags
-#define IxxFlags -s BaseObject -m TypeObj -r RequestObj -p Xf
-#endif
-#ifndef IxxIncludes
-#define IxxIncludes -i '<X11/Fresco/enter-scope.h>'
-#endif
-#ifndef MkdirHierCmd
-#ifdef UseInstalled /* assume BINDIR in path */
-#define MkdirHierCmd mkdirhier
-#else
-#define MkdirHierCmd $(SHELL) $(CONFIGSRC)/util/mkdirhier.sh
-#endif
-#endif
-#ifndef TroffCmd
-#define TroffCmd psroff
-#endif
-#ifndef MsMacros
-#define MsMacros -ms
-#endif
-#ifndef TblCmd
-#define TblCmd tbl
-#endif
-#ifndef EqnCmd
-#define EqnCmd eqn
-#endif
-#ifndef DvipsCmd
-#define DvipsCmd dvips
-#endif
-#ifndef LatexCmd
-#define LatexCmd latex
-#endif
-#if HasSentinel
-#ifndef SentinelCmd
-#define SentinelCmd sentinel
-#endif
-#ifndef SentinelOptions
-#define SentinelOptions /**/
-#endif
-#endif
-#if HasPurify
-#ifndef PurifyCmd
-#define PurifyCmd purify
-#endif
-#ifndef PurifyOptions
-#define PurifyOptions /**/
-#endif
-#endif
-#if HasTestCenter
-#ifndef ProofCmd
-#define ProofCmd proof
-#endif
-#ifndef ProofOptions
-#define ProofOptions /**/
-#endif
-#endif
-#ifndef PathSeparator
-#define PathSeparator /
-#endif
-#ifndef Osuf
-#define Osuf o
-#endif
-#ifndef CCsuf
-#define CCsuf cxx
-#endif
-#ifndef ManSuffix
-#define ManSuffix n /* use just one tab or cpp will die */
-#endif
-#ifndef LibManSuffix
-#define LibManSuffix 3 /* use just one tab or cpp will die */
-#endif
-#ifndef FileManSuffix
-#if SystemV || SystemV4 || defined(OSF1Architecture)
-#define FileManSuffix 4 /* use just one tab or cpp will die */
-#else
-#define FileManSuffix 5 /* use just one tab or cpp will die */
-#endif
-#endif
-#ifndef ExpandManNames
-#if SystemV
-#define ExpandManNames NO
-#else
-#define ExpandManNames YES
-#endif
-#endif
-#ifndef TOPDIR
-#define TOPDIR .
-#endif
-#ifndef CURDIR
-#define CURDIR .
-#endif
-#ifndef SiteIConfigFiles
-#define SiteIConfigFiles /**/
-#endif
-#ifndef ExtraFilesToClean
-#define ExtraFilesToClean /**/
-#endif
-#ifndef FilesToClean
-#define FilesToClean *.CKP *.ln *.BAK *.bak *.Osuf core errs ,* *~ *.a .emacs_* tags TAGS make.log MakeOut
-#endif
-/* Dummy default. This macro should be used from Imake command line to
- define a non-standard compiler select macro like 'HasEPC' or similar */
-#ifndef ImakeCompilerSelect
-#define ImakeCompilerSelect /**/
-#define UseImakeCompilerSelect /**/
-#else
-#define UseImakeCompilerSelect -DImakeCompilerSelect=ImakeCompilerSelect ImakeCompilerSelect
-#endif
-
- PATHSEP = PathSeparator
- / = PathSeparator
- SHELL = BourneShell
-
- TOP = TOPDIR
- CURRENT_DIR = CURDIR
-
- QUOTE="@@\ENDQUOTE="
-
-ifeq "$(strip $(IMAKE))" ""
- IMAKE = ImakeCmd
-endif
-ifeq "$(strip $(MAKEDEPEND))" ""
- DEPEND = DependCmd
-else
- DEPEND = $(MAKEDEPEND)
-endif
- MKDIRHIER = MkdirHierCmd
- CONFIGSRC = ConfigSrc
- IMAKESRC = $(CONFIGSRC)/imake
- DEPENDSRC = DependDir
- IXXSRC = $(UNSUPPORTEDSRC)/programs/ixx
- IXX = IxxCmd
- IXXFLAGS = IxxFlags
- IXXINCLUDES = IxxIncludes
-
- INCROOT = IncRoot /* base of where to put header files */
- USRLIBDIR = UsrLibDir /* nonshared libraries */
- SHLIBDIR = ShLibDir /* shared libraries */
- LINTLIBDIR = LintlibDir /* lint libraries */
- MANPATH = ManPath /* top of manual page tree */
- MANSOURCEPATH = ManSourcePath /* prefix for man page sources */
- MANDIR = ManDir /* man pages for commands */
- LIBMANDIR = LibmanDir /* man pages for library routines */
- FILEMANDIR = FileManDir /* man pages for config files */
-
- AR = ArCmd
-#if defined(UseXargs) && UseXargs
- XARGS = XargsCmd
-#endif
- BOOTSTRAPCFLAGS = BootstrapCFlags /* set if cpp does not have uniq sym */
- CC = CcCmd
- AS = AsCmd
-#ifndef CernlibCCDefines
-#define CernlibCCDefines /**/
-#endif
- CCDEFINES = CernlibCCDefines
-#if HasFortran
-#ifndef CernlibFCDefines
-#define CernlibFCDefines /**/
-#endif
- FC = FortranCmd
- FPP = FortranCppCmd
- FDEBUGFLAGS = FortranDebugFlags
-FORTRANSAVEOPTION = FortranNoSaveFlags
- FORTRANOPTIONS = DefaultFCOptions $(FORTRANSAVEOPTION)
- FCLINK = FortranLinkCmd
- FORTRANINCLUDES = $(INCLUDES) $(EXTRA_INCLUDES) $(PACKAGE_INCLUDES) $(TOP_INCLUDES)
- FORTRANDEFINES = CernlibFCDefines
-FORTRANALLDEFMDEPEND = $(FORTRANINCLUDES) $(FORTRANDEFINES) $(CERNDEFINES) $(EXTRA_DEFINES) $(DEFINES)
-#ifdef AIXArchitecture
- FORTRANALLDEFINES = $(foreach def,$(FORTRANALLDEFMDEPEND),-WF,$(def))
-#else
- FORTRANALLDEFINES = $(FORTRANALLDEFMDEPEND)
-#endif
-
-#if FortranDoesCpp
- FCFLAGS = $(FDEBUGFLAGS) $(FORTRANOPTIONS) $(FORTRANALLDEFINES)
-#else
- FCFLAGS = $(FDEBUGFLAGS) $(FORTRANOPTIONS)
-#endif
-#endif
-#if HasCplusplus
-
-.SUFFIXES: .CCsuf
-
- CXX = CplusplusCmd
- CXXDEBUGFLAGS = DefaultCplusplusDebugFlags
- CXXEXTRA_DEFINES = CplusplusExtraDefines
-CXXEXTRA_INCLUDES = CplusplusExtraIncludes
- CXXIDL_INCLUDES = -I$(TOP)/include
- CXXSTD_DEFINES = CplusplusStandardDefines
- CXXOPTIONS = CplusplusOptions
- CXXINCLUDES = $(INCLUDES) $(TOP_INCLUDES) $(CXXEXTRA_INCLUDES) $(CXXIDL_INCLUDES)
- CXXDEFINES = $(CXXINCLUDES) $(CXXSTD_DEFINES) $(THREADS_CXXDEFINES) $(CXXEXTRA_DEFINES)
- CXXFLAGS = $(CXXDEBUGFLAGS) $(CXXOPTIONS) $(THREADS_CXXFLAGS) $(CXXDEFINES)
-#endif
- COMPRESS = CompressCmd
- CPP = CppCmd $(STD_CPP_DEFINES) /* simple filters */
- PREPROCESSCMD = PreProcessCmd $(STD_CPP_DEFINES) /* prefered; mdep */
- INSTALL = InstallCmd
- INSTALLFLAGS = InstallFlags
- LD = LdCmd
- LEX = LexCmd
- LEXLIB = LexLib
- YACC = YaccCmd
- CCYACC = CplusplusYaccCmd
- LINT = LintCmd
- LINTLIBFLAG = LintLibFlag
- LINTOPTS = LintOpts
- LN = LnCmd
- MAKE = MakeCmd
- MV = MvCmd
- CP = CpCmd
-#if DoRanlibCmd
- RANLIB = RanlibCmd
- RANLIBINSTFLAGS = RanlibInstFlags
-#endif
- RM = RmCmd
- MANSUFFIX = ManSuffix /* suffix for command man pages */
- LIBMANSUFFIX = LibManSuffix /* suffix for library man pages */
- FILEMANSUFFIX = FileManSuffix /* suffix for config file man pages */
- TROFF = TroffCmd
- MSMACROS = MsMacros
- TBL = TblCmd
- EQN = EqnCmd
- TOUCH = TouchCmd /* to touch a file */
-#if HasLatex
- DVIPS = DvipsCmd
- LATEX = LatexCmd
-#endif
-#if HasSentinel
- SENTINEL = SentinelCmd
- SENTINELOPTIONS = SentinelOptions
-#endif
-#if HasPurify
- PURIFY = PurifyCmd
- PURIFYOPTIONS = PurifyOptions
-#endif
-#if HasTestCenter
- PROOF = ProofCmd
- PROOFOPTIONS = ProofOptions
-#endif
- STD_INCLUDES = StandardIncludes
- STD_CPP_DEFINES = StandardCppDefines
- STD_DEFINES = StandardDefines
- EXTRA_LOAD_FLAGS = ExtraLoadFlags
- EXTRA_LDOPTIONS = ExtraLoadOptions
- EXTRA_LIBRARIES = ExtraLibraries Krb5Libraries
- TAGS = TagsCmd
-#if ConstructMFLAGS
- MFLAGS=$(filter-out --%,$(filter -%,$(MAKEFLAGS)))
-#endif
-#if HasSharedLibraries
- SHAREDCODEDEF = SharedCodeDef
- SHLIBDEF = SharedLibraryDef
-#ifdef SharedLibraryLoadFlags
- SHLIBLDFLAGS = SharedLibraryLoadFlags
-#endif
-/*
- * Here we set up flags needed to produce position-independent code
- * when doing C and C++ compilation. The default if you specify C
- * PIC flags without also specifying C++ PIC flags is to assume that
- * the C flags work for both. If your C++ compiler requires different
- * flags, specify them explicitly in PositionIndependentCplusplusFlags.
- */
-#ifdef PositionIndependentCFlags
- PICFLAGS = PositionIndependentCFlags
-#endif
-#ifdef PositionIndependentCplusplusFlags
- CXXPICFLAGS = PositionIndependentCplusplusFlags
-#else
-#ifdef PositionIndependentCFlags
- CXXPICFLAGS = PositionIndependentCFlags
-#endif
-#endif
-#ifdef PositionIndependentFortranFlags
- PIFFLAGS = PositionIndependentFortranFlags
-#else
-#ifdef PositionIndependentCFlags
- PIFFLAGS = PositionIndependentCFlags
-#endif
-#endif
-#endif
-#if !HasVoidSignalReturn
- SIGNAL_DEFINES = -DSIGNALRETURNSINT
-#endif
-/*
- * The following supports forcing of function prototypes
- */
-#if NeedFunctionPrototypes && NeedVarargsPrototypes && NeedConstPrototypes && NeedNestedPrototypes
-#define _funcprotodef -DFUNCPROTO=15
-#else
-#if NeedFunctionPrototypes && NeedVarargsPrototypes && NeedNestedPrototypes
-#define _funcprotodef -DFUNCPROTO=11
-#else
-#if NeedFunctionPrototypes && NeedNestedPrototypes
-#define _funcprotodef -DFUNCPROTO=9
-#else
-#if NeedFunctionPrototypes && NeedVarargsPrototypes && NeedConstPrototypes
-#define _funcprotodef -DFUNCPROTO=7
-#else
-#if NeedFunctionPrototypes && NeedConstPrototypes
-#define _funcprotodef -DFUNCPROTO=5
-#else
-#if NeedFunctionPrototypes && NeedVarargsPrototypes
-#define _funcprotodef -DFUNCPROTO=3
-#else
-#if NeedFunctionPrototypes
-#define _funcprotodef -DFUNCPROTO
-#else
-#define _funcprotodef /**/
-#endif
-#endif
-#endif
-#endif
-#endif
-#endif
-#endif
-#if NeedWidePrototypes
-#define _wideprotodef /**/
-#else
-#define _wideprotodef -DNARROWPROTO
-#endif
- PROTO_DEFINES = _funcprotodef _wideprotodef
-#undef _funcprotodef
-#undef _wideprotodef
-
-#if StripInstalledPrograms
- INSTPGMFLAGS = InstPgmFlags /* install flags for stripping */
-#else
- INSTPGMFLAGS =
-#endif
- INSTBINFLAGS = InstBinFlags /* install flags for programs */
- INSTUIDFLAGS = InstUidFlags /* install flags for setuid programs */
- INSTLIBFLAGS = InstLibFlags /* install flags for libraries */
- INSTINCFLAGS = InstIncFlags /* install flags for headers */
- INSTMANFLAGS = InstManFlags /* install flags for man pages */
- INSTDATFLAGS = InstDatFlags /* install flags for data files */
- INSTKMEMFLAGS = InstKmemFlags /* install flags for /dev/kmem progs */
-
-#ifdef ProjectRoot
- PROJECTROOT = ProjectRoot
-#endif
-#ifdef UseInstalled
-#if AlternateIncRoot
- TOP_INCLUDES = -I$(INCROOT) /* def: for alternative /usr/include */
-#endif
-#else
- TOP_INCLUDES = -I$(TOP) /* def: for builds within tree */
-#endif
- CDEBUGFLAGS = DefaultCDebugFlags
- CCOPTIONS = DefaultCCOptions /* to distinguish from param flags */
-/*
- * STD_INCLUDES contains system-specific includes
- * TOP_INCLUDES specifies how to get to /usr/include or its build substitute
- * PACKAGE_INCLUDES gives include files for given package ( CERNlib extension)
- * EXTRA_INCLUDES contains project-specific includes set in project incfiles
- * INCLUDES contains client-specific includes set in Imakefile
- * LOCAL_LDFLAGS contains client-specific ld flags flags set in Imakefile
- */
- ALLINCLUDES = $(INCLUDES) $(EXTRA_INCLUDES) $(PACKAGE_INCLUDES) $(TOP_INCLUDES) $(STD_INCLUDES)
- ALLDEFINES = $(ALLINCLUDES) $(STD_DEFINES) $(EXTRA_DEFINES) $(PROTO_DEFINES) $(THREADS_DEFINES) $(DEFINES) $(CCDEFINES) $(CERNDEFINES)
- CFLAGS = $(CDEBUGFLAGS) $(CCOPTIONS) $(THREADS_CFLAGS) $(ALLDEFINES)
- LINTFLAGS = $(LINTOPTS) -DLINT $(ALLDEFINES) $(DEPEND_DEFINES)
- LDPRELIB = LdPreLib
- LDPOSTLIB = LdPostLib
- LDOPTIONS = $(CDEBUGFLAGS) $(CCOPTIONS) $(EXTRA_LDOPTIONS) $(THREADS_LDFLAGS) $(LOCAL_LDFLAGS) $(LDPRELIB)
- CXXLDOPTIONS = $(CXXDEBUGFLAGS) $(CXXOPTIONS) $(EXTRA_LDOPTIONS) $(THREADS_CXXLDFLAGS) $(LOCAL_LDFLAGS) $(LDPRELIB)
- FCLDOPTIONS = FortranLoadFlags $(FDEBUGFLAGS) $(FORTRANOPTIONS) $(EXTRA_LDOPTIONS) $(THREADS_LDFLAGS) $(LOCAL_LDFLAGS) $(LDPRELIB)
-
- LDLIBS = $(LDPOSTLIB) $(THREADS_LIBS) $(SYS_LIBRARIES) $(EXTRA_LIBRARIES)
-#if AlternateUsrLibDir && HasLdRunPath
- CCENVSETUP = LD_RUN_PATH=$(USRLIBDIR)
- CCLINK = $(CCENVSETUP) CcLinkCmd
-#else
- CCLINK = CcLinkCmd
-#endif
-#if AlternateUsrLibDir && HasLdRunPath
- CXXENVSETUP = LD_RUN_PATH=$(USRLIBDIR)
- CXXLINK = $(CXXENVSETUP) $(CXX)
-#else
- CXXLINK = $(CXX)
-#endif
- LDSTRIPFLAGS = LdStripFlags
- LDCOMBINEFLAGS = LdCombineFlags
- DEPENDFLAGS = DependFlags
-
- MACROFILE = MacroFile
- RM_CMD = $(RM)
-
- IMAKE_DEFINES = /* leave blank, for command line use only */
- IMAKE_INCLUDES= /* blank, for command line or Imakefile use */
-#ifdef UseInstalled
- IRULESRC = $(CONFIGDIR) /* used in rules file */
- IMAKE_CMD = $(IMAKE) -DUseInstalled -DLocalTop=$(LOCALTOP) UseImakeCompilerSelect \
- -I$(IRULESRC) $(IMAKE_INCLUDES) $(IMAKE_DEFINES)
-#else
- IRULESRC = $(CONFIGSRC)/cf
- IMAKE_CMD = $(IMAKE) -I$(IRULESRC) $(IMAKE_DEFINES)
-#endif
- ICONFIGFILES = $(IRULESRC)/Imake.tmpl $(IRULESRC)/Project.tmpl \
- $(IRULESRC)/site.def $(IRULESRC)/$(MACROFILE) \
- SiteIConfigFiles $(EXTRA_ICONFIGFILES)
-
-#ifndef LocalRulesFile
-/* need this to make ANSI-style preprocessors happy */
-#define LocalRulesFile <noop.rules>
-#endif
-#include LocalRulesFile
-
-/*
- * get project-specific configuration and rules
- */
-#include <Project.tmpl>
-#ifndef LocalTmplFile
-/* need this to make ANSI-style preprocessors happy */
-#define LocalTmplFile <noop.rules>
-#endif
-#include LocalTmplFile
-
-#ifdef FixupLibReferences
-FixupLibReferences()
-#endif
-
-/* ConfigDir comes from Project.tmpl */
- CONFIGDIR = ConfigDir /* build configuration information */
-
-/* add definitions for PACKAGE_INCLUDE */
-#ifndef PackageTop
-#define PackageTop /* nothing */
-#endif
-#ifndef PackageName
-#define PackageName /* nothing */
-#endif
-#ifndef LocalTop
-#define LocalTop /* nothing */
-#endif
-#ifndef CernlibSystem
-#define CernlibSystem /* nothing, but this should not happen GF.*/
-#endif
- CERNDEFINES=CernlibSystem
- PACKAGETOP=PackageTop
- PACKAGE_NAME=PackageName
- LOCALTOP=LocalTop /* empty, but ???? */
-
- PACKAGE_INCLUDES=-I$(TOP)$(PACKAGETOP) -I$(PROJECTROOT)$(LOCALTOP)$(PACKAGETOP) -I$(VPATH)
-
- VPATH=$(PROJECTROOT)$(LOCALTOP)$(CURRENT_DIR)
-
-/* Standard names needed */
-
-
-OBJS_C=$(SRCS_C:.c=.Osuf) /* Objects created from C */
-OBJS_F=$(SRCS_F:.F=.Osuf) /* Objects created from Fortran */
-OBJS_CDF=$(SRCS_CDF:.cdf=.Osuf) /* cdf -> c -> object file */
-
-OBJS=$(OBJS_C) $(OBJS_F) $(OBJS_CDF)
-
-XCOMM -----------------------------------------------------------------------
-XCOMM start of Imakefile : INCLUDE_IMAKEFILE
-#include INCLUDE_IMAKEFILE
-
-/*
- *
- * GF. Add rules and target for gmake style of checking dependencies
- * 950817
- *
-*/
-
-/* emptyrule is needed to avoid picking a default rule from included files.
- */
-
-emptyrule::
-
-.SUFFIXES: .d
-
-.c.d:
- $(SHELL) -ec "gcc -M $(ALLDEFINES) $< \ @@\
- | sed 's/^[ ]*$*\.o/& $@/g' >$@"
-
-.F.d:
- FortranDepend(.,NullParameter)
-
-
-
-XCOMM -----------------------------------------------------------------------
-XCOMM common rules for all Makefiles - do not edit
-
-.c.i:
- CPPOnlyCompile($*.c,$(_NOOP_))
-/*
- * These need to be here so that rules in Imakefile occur first; the blank
- * emptyrule is to make sure that an empty Imakefile does not default to make
- * clean.
- */
-emptyrule::
-
-CleanTarget()
-
-#ifndef IHaveSpecialMakefileTarget
-MakefileTarget()
-#endif
-
-TagsTarget()
-#ifdef MakefileAdditions
-MakefileAdditions()
-#endif
-
-CenterLoadTarget(debug_src,$(SRCS),NullParameter,$(ALLDEFINES))
-
-CenterLoadTarget(debug_obj,$(OBJS),NullParameter,$(ALLDEFINES))
-
-#ifdef IHaveSubdirs
-XCOMM -----------------------------------------------------------------------
-XCOMM rules for building in SUBDIRS - do not edit
-
-InstallSubdirs($(SUBDIRS))
-InstallManSubdirs($(SUBDIRS))
-InstallLinkKitSubdirs($(SUBDIRS))
-CleanSubdirs($(SUBDIRS))
-TagSubdirs($(SUBDIRS))
-MakefileSubdirs($(SUBDIRS))
-IncludesSubdirs($(SUBDIRS))
-MakeSubdirsMakefiles($(SUBDIRS),tree)
-
-#else
-XCOMM -----------------------------------------------------------------------
-XCOMM empty rules for directories that do not have SUBDIRS - do not edit
-
-install::
- @echo "install in $(CURRENT_DIR) done"
-
-install.man::
- @echo "install.man in $(CURRENT_DIR) done"
-
-install.linkkit::
- @echo "install.linkkit in $(CURRENT_DIR) done"
-
-Makefiles::
-
-includes::
-
-depend::
-
-tree::
- @true
-
-all::
-
-#endif /* if subdirectory rules are needed */
-
-#ifdef IHaveCDF
-.SUFFIXES: .cdf
-
- KUIPC=kuipc /* get this from search Path for the moment */
- /* use $(@F) to force output to be local */
-.cdf.c:
- $(KUIPC) $< $(@F)
-
-#endif
-
-XCOMM -----------------------------------------------------------------------
-XCOMM dependencies generated by makedepend
diff --git a/src/config/Imakefile b/src/config/Imakefile
deleted file mode 100644
index d849723..0000000
--- a/src/config/Imakefile
+++ /dev/null
@@ -1,93 +0,0 @@
-/* $Id: Imakefile,v 1.1.1.1 1995/12/20 15:26:45 cernlib Exp $
- *
- * $Log: Imakefile,v $
- * Revision 1.1.1.1 1995/12/20 15:26:45 cernlib
- * X11R6 config files unmodified
- *
- *
- */
-XCOMM $XConsortium: Imakefile,v 1.32 94/04/09 21:46:51 rws Exp $
-
-#ifdef LocalConfigFiles
-LOCALFILES = LocalConfigFiles
-#endif
-
-DEFFILES = \
-site.def
-
-RULEFILES = \
-Imake.rules \
-Win32.rules \
-hpLib.rules \
-bsdLib.rules \
-ibmLib.rules \
-lnxLib.rules \
-necLib.rules \
-noop.rules \
-oldlib.rules \
-osfLib.rules \
-sgiLib.rules \
-sunLib.rules \
-sv4Lib.rules \
-xf86.rules
-
-TMPLFILES = \
-Imake.tmpl \
-Fresco.tmpl \
-Ixx.tmpl \
-bsdLib.tmpl \
-lnxLib.tmpl \
-Library.tmpl \
-Project.tmpl \
-Server.tmpl \
-Threads.tmpl \
-WinLib.tmpl \
-hpLib.tmpl \
-ibmLib.tmpl \
-necLib.tmpl \
-osfLib.tmpl \
-sunLib.tmpl \
-sv4Lib.tmpl
-
-CFFILES = \
-Imake.cf \
-Amoeba.cf \
-DGUX.cf \
-Mips.cf \
-NetBSD.cf \
-FreeBSD.cf \
-Oki.cf \
-Win32.cf \
-apollo.cf \
-bsd.cf \
-bsdi.cf \
-convex.cf \
-cray.cf \
-fujitsu.cf \
-generic.cf \
-hp.cf \
-ibm.cf \
-linux.cf \
-luna.cf \
-macII.cf \
-moto.cf \
-ncr.cf \
-nec.cf \
-osf1.cf \
-pegasus.cf \
-rtcchack.bac \
-sequent.cf \
-sgi.cf \
-sony.cf \
-sun.cf \
-svr4.cf \
-ultrix.cf \
-usl.cf \
-x386.cf \
-xfree86.cf
-
-INSTFILES = $(RULEFILES) $(TMPLFILES) $(DEFFILES) $(CFFILES) $(LOCALFILES)
-
-all::
-
-InstallMultipleDestFlags(install,$(INSTFILES),$(CONFIGDIR),$(INSTDATFLAGS))
diff --git a/src/config/Ixx.tmpl b/src/config/Ixx.tmpl
deleted file mode 100644
index 39434be..0000000
--- a/src/config/Ixx.tmpl
+++ /dev/null
@@ -1,91 +0,0 @@
-/* $Id: Ixx.tmpl,v 1.1.1.1 1995/12/20 15:26:43 cernlib Exp $
- *
- * $Log: Ixx.tmpl,v $
- * Revision 1.1.1.1 1995/12/20 15:26:43 cernlib
- * X11R6 config files unmodified
- *
- *
- */
-XCOMM $XConsortium: Ixx.tmpl,v 1.5 94/03/28 17:13:30 matt Exp $
-XCOMM
-XCOMM Definitions for using interface translator
-XCOMM
-
-#ifdef UseInstalled
-#define IxCmd ixx
-#else
-#define IxCmd $(CONTRIBSRC)/programs/ixx/ixx
-#endif
-
-#ifndef IXFlags
-#define IXFlags \
--s BaseObject -m TypeObj -r RequestObj -stubclass Stub -p Xf $(EXTRA_IXFLAGS)
-#endif
-
-#ifndef IXIncludes
-#define IXIncludes -i '<X11/Fresco/_enter.h>'
-#endif
-
-IX = IxCmd
-IXFLAGS = IXFlags
-IXINCLUDES = IXIncludes
-
-.SUFFIXES: .idl
-
-#ifndef MakeIDLHeader
-#define MakeIDLHeader(name_idl,name_h,flags) @@\
-headers:: name_h @@\
-name_h: name_idl @@\
- @$(RM) name_h ix-name_h @@\
- @echo "Generating name_h from name_idl" @@\
- @$(CPP) $(CXXDEFINES) $(CXXINCLUDES) name_idl | \ @@\
- $(IX) $(IXFLAGS) $(IXINCLUDES) flags > ix-name_h @@\
- @$(MV) ix-name_h name_h @@\
- @chmod a-w name_h @@\
- @@\
-clean_headers:: @@\
- @$(RM) name_h
-#endif
-
-#ifndef MakeHeader
-#define MakeHeader(name) \
-MakeIDLHeader(Interfaces/name.idl,name.h,NullParameter)
-#endif
-
-#ifndef MakeHeaderFlags
-#define MakeHeaderFlags(name,flags) \
-MakeIDLHeader(Interfaces/name.idl,name.h,-file Interfaces/name.idl flags)
-#endif
-
-#ifndef EditImplName
-#define EditImplName(dep,name,interfaces,tmp) @@\
-all.sed:: dep @@\
-dep:: interfaces @@\
- @$(RM) tmp @@\
- @echo "Editing" name @@\
- @cat interfaces | $(CPP) $(CXXDEFINES) $(CXXINCLUDES) | \ @@\
- $(IX) $(IXFLAGS) -filter name > tmp @@\
- @$(MV) tmp name
-#endif
-
-.SUFFIXES: .sed
-
-#ifndef EditImpl
-#define EditImpl(name,interfaces) \
-EditImplName(name.sed,name.CCsuf,interfaces,new-name.CCsuf)
-#endif
-
-#ifndef EditImplHeader
-#define EditImplHeader(name,interfaces) \
-EditImplName(name.sed,name.h,interfaces,new-name.h)
-#endif
-
-INTERFACES_SLASH = /
-INTERFACES = Interfaces$(INTERFACES_SLASH)*.idl
-
-#ifndef DependHeaders
-#define DependHeaders() @@\
-depend:: @@\
- $(DEPEND) -o.h -s "# DO NOT DELETE" -- $(CXXINCLUDES) -- \
- $(INTERFACES)
-#endif
diff --git a/src/config/Library.tmpl b/src/config/Library.tmpl
deleted file mode 100644
index d313263..0000000
--- a/src/config/Library.tmpl
+++ /dev/null
@@ -1,319 +0,0 @@
-/* $Id: Library.tmpl,v 1.1.1.1 1995/12/20 15:26:40 cernlib Exp $
- *
- * $Log: Library.tmpl,v $
- * Revision 1.1.1.1 1995/12/20 15:26:40 cernlib
- * X11R6 config files unmodified
- *
- *
- */
-/*
- * Library imakefile info - this contains any special redefinitions, etc.
- * that Imakefiles in the various library subtrees will need.
- *
- * Before including this, you must set the following boolean variables:
- * DoNormalLib, DoSharedLib, DoDebugLib, DoProfileLib
- *
- * To get automatic generation of standard rules, also set the variables:
- * LibName, SoRev, HasSharedData, and optionally HugeLibrary and IncSubdir
- */
-
-XCOMM $XConsortium: Library.tmpl,v 1.34 95/06/16 17:44:51 gildea Exp $
-
-#ifndef LibraryCplusplusOptions
-#if DoSharedLib && defined(SharedLibraryCplusplusOptions)
-#define LibraryCplusplusOptions SharedLibraryCplusplusOptions
-#else
-#define LibraryCplusplusOptions DefaultCplusplusOptions
-#endif
-#endif
-#ifndef LibraryDefines
-#define LibraryDefines StandardDefines
-#endif
-#ifndef LibraryCDebugFlags
-#define LibraryCDebugFlags DefaultCDebugFlags
-#endif
-#ifndef LibraryCplusplusDebugFlags
-#define LibraryCplusplusDebugFlags DefaultCplusplusDebugFlags
-#endif
-#ifndef SeparateSharedCompile
-#define SeparateSharedCompile YES
-#endif
-
-#ifndef CplusplusSource
-#ifndef LibraryCcCmd
-#if DoSharedLib && defined(SharedLibraryCcCmd)
-#define LibraryCcCmd SharedLibraryCcCmd
-#else
-#define LibraryCcCmd CcCmd
-#endif
-#endif
-#ifndef LibraryCCOptions
-#if DoSharedLib && defined(SharedLibraryCCOptions)
-#define LibraryCCOptions SharedLibraryCCOptions
-#else
-#define LibraryCCOptions DefaultCCOptions
-#endif
-#endif
-
- CC = LibraryCcCmd
- CCOPTIONS = LibraryCCOptions
-STD_DEFINES = LibraryDefines
-CDEBUGFLAGS = LibraryCDebugFlags
-#else
-#ifndef LibraryCplusplusCmd
-#if DoSharedLib && defined(SharedLibraryCplusplusCmd)
-#define LibraryCplusplusCmd SharedLibraryCplusplusCmd
-#else
-#define LibraryCplusplusCmd CplusplusCmd
-#endif
-#endif
-#ifndef LibraryCplusplusOptions
-#if DoSharedLib && defined(SharedLibraryCplusplusOptions)
-#define LibraryCplusplusOptions SharedLibraryCplusplusOptions
-#else
-#define LibraryCplusplusOptions DefaultCplusplusOptions
-#endif
-#endif
-
- CXX = LibraryCplusplusCmd
- CXXOPTIONS = LibraryCplusplusOptions
- STD_DEFINES = LibraryDefines
-CXXDEBUGFLAGS = LibraryCplusplusDebugFlags
-#endif
-
-#if DoDebugLib
-#define _DebuggedLibMkdir() LibMkdir(debugger)
-#ifndef CplusplusSource
-#define _DebuggedObjCompile(options) DebuggedLibObjCompile(options)
-#else
-#define _DebuggedObjCompile(options) DebuggedLibObjCplusplusCompile(options)
-#endif
-#define _DebuggedCleanDir() LibCleanDir(debugger)
-#else
-#define _DebuggedLibMkdir() $(_NULLCMD_)
-#define _DebuggedObjCompile(options) $(_NULLCMD_)
-#define _DebuggedCleanDir() $(_NULLCMD_)
-#endif
-
-#if DoProfileLib
-#define _ProfiledLibMkdir() LibMkdir(profiled)
-#ifndef CplusplusSource
-#define _ProfiledObjCompile(options) ProfiledLibObjCompile(options)
-#else
-#define _ProfiledObjCompile(options) ProfiledLibObjCplusplusCompile(options)
-#endif
-#define _ProfiledCleanDir() LibCleanDir(profiled)
-#else
-#define _ProfiledLibMkdir() $(_NULLCMD_)
-#define _ProfiledObjCompile(options) $(_NULLCMD_)
-#define _ProfiledCleanDir() $(_NULLCMD_)
-#endif
-
-#if !DoNormalLib
-#define _NormalLibMkdir() $(_NULLCMD_)
-#define _NormalObjCompile(options) $(_NULLCMD_)
-#define _NormalCleanDir() $(_NULLCMD_)
-#else
-#if DoSharedLib && SeparateSharedCompile
-#define _NormalLibMkdir() LibMkdir(unshared)
-#ifndef CplusplusSource
-#define _NormalObjCompile(options) UnsharedLibObjCompile(options)
-#else
-#define _NormalObjCompile(options) UnsharedLibObjCplusplusCompile(options)
-#endif
-#define _NormalCleanDir() LibCleanDir(unshared)
-#else
-#define _NormalLibMkdir() $(_NULLCMD_)
-#ifndef CplusplusSource
-#define _NormalObjCompile(options) NormalLibObjCompile(options)
-#else
-#define _NormalObjCompile(options) NormalLibObjCplusplusCompile(options)
-#endif
-#define _NormalCleanDir() $(_NULLCMD_)
-#endif
-#endif
-
-#if !DoSharedLib || (DoNormalLib && !SeparateSharedCompile)
-#define _SharedObjCompile(options) $(_NULLCMD_)
-#else
-#if SeparateSharedCompile
-#ifndef CplusplusSource
-#define _SharedObjCompile(options) NormalSharedLibObjCompile(options)
-#else
-#define _SharedObjCompile(options) NormalSharedLibObjCplusplusCompile(options)
-#endif
-#else
-#ifndef CplusplusSource
-#define _SharedObjCompile(options) NormalLibObjCompile(options)
-#else
-#define _SharedObjCompile(options) NormalLibObjCplusplusCompile(options)
-#endif
-#endif
-#endif
-
-#ifndef CplusplusSource
-#define SRCsuf c
-#else
-#define SRCsuf CCsuf
-#ifdef SunArchitecture
-.SUFFIXES: .CCsuf
-#endif
-#endif
-
-#ifndef LibraryObjectRule
-#define LibraryObjectRule() @@\
-all:: @@\
- _DebuggedLibMkdir() @@\
- _ProfiledLibMkdir() @@\
- _NormalLibMkdir() @@\
- @@\
-includes:: @@\
- _DebuggedLibMkdir() @@\
- _ProfiledLibMkdir() @@\
- _NormalLibMkdir() @@\
- @@\
-.SRCsuf.Osuf: @@\
- _DebuggedObjCompile($(_NOOP_)) @@\
- _ProfiledObjCompile($(_NOOP_)) @@\
- _NormalObjCompile($(_NOOP_)) @@\
- _SharedObjCompile($(_NOOP_)) @@\
- @@\
-clean:: @@\
- _DebuggedCleanDir() @@\
- _ProfiledCleanDir() @@\
- _NormalCleanDir() @@\
-
-#endif /* LibraryObjectRule */
-
-#ifndef SpecialLibObjectRule
-#define SpecialLibObjectRule(objs,depends,options) @@\
-objs: depends @@\
- _DebuggedObjCompile(options) @@\
- _ProfiledObjCompile(options) @@\
- _NormalObjCompile(options) @@\
- _SharedObjCompile(options) @@\
-
-#endif /* SpecialLibObjectRule */
-
-#ifndef SpecialCLibObjectRule
-#define SpecialCLibObjectRule(basename,depends,options) @@\
-SpecialLibObjectRule(basename.Osuf,basename.SRCsuf depends,options) @@\
- @@\
-basename.i: basename.SRCsuf depends @@\
- CPPOnlyCompile(basename.SRCsuf,options) @@\
- @@\
-CenterLoadTarget(debug_src,basename.SRCsuf,NullParameter,$(ALLDEFINES) options)
-#endif /* SpecialCLibObjectRule */
-
-#ifndef SpecialCplusplusLibObjectRule
-#define SpecialCplusplusLibObjectRule(basename,depends,options) @@\
-SpecialLibObjectRule(basename.Osuf,basename.SRCsuf depends,options) @@\
- @@\
-CenterLoadTarget(debug_src,basename.SRCsuf,NullParameter,$(ALLDEFINES) options)
-#endif /* SpecialCplusplusLibObjectRule */
-
-/*
- * ToolkitMakeStrings generates a string-table, i.e., a C source
- * file and the matching header(s), e.g., Xt's StringDefs.c, StringDefs.h,
- * and Shell.h files; or Motif's XmStrDefs.c and XmStrDefs.h files.
- *
- * The 'files' argument is the list of files that will be produced by
- * this rule, e.g., for Xt they would be "Shell.h StringDefs.c StringDefs.h"
- * and for Motif they would be "XmStrDefs.c XmStrDefs.h".
- *
- * The 'source' argument is the string-list file to be parsed, e.g., in
- * Xt that would be "util/string.list". For Motif 2.0 it would be
- * "../../tools/makestr/xmstring.list", and for Motif-CDE1 it would be
- * "util/xmstring.list".
- *
- * The 'options' argument is passed by the library's Imakefile, see the
- * Xt Imakefile for an example. Typically this would be nothing, -intelabi,
- * or -sparcabi; there are other choices, but these are typical.
- *
- * The 'depends' argument names additional files the target files
- * depend on. It should name the #ctmpl and #htmpl files from the
- * 'source' file.
- *
- * The 'dest' argument is the C source output file. For Xt this should
- * be "StringDefs.c", and for all versions of Motif it would be "XmStrDefs.c"
- *
- * Headers are generated and named according to data in the 'source'
- * file.
- */
-
-#ifndef ToolkitMakeStrings
-#define ToolkitMakeStrings(files,source,options,depends,dest) @@\
-MAKESTRS = $(CONFIGSRC)/util/makestrs @@\
- @@\
-$(MAKESTRS): $(MAKESTRS).c @@\
- cd $(CONFIGSRC)/util && make makestrs @@\
- @@\
-files: $(MAKESTRS) source depends @@\
- RemoveFiles(files) @@\
- RunProgram(MAKESTRS,options < source > dest) @@\
- @@\
-AllTarget(files) @@\
- @@\
-includes:: files @@\
- @@\
-depend:: files
-#endif /* ToolkitMakeStrings */
-
-#ifdef LibName
-
-LIBNAME = LibName
-
-LibraryObjectRule()
-
-#undef _LinkBuildLibrary
-#define _LinkBuildLibrary(lib) LinkBuildLibrary(lib)
-
-#if DoSharedLib
-SharedLibraryTarget($(LIBNAME),$(SoRev),$(OBJS),.,.)
-InstallSharedLibrary($(LIBNAME),$(SoRev),$(SHLIBDIR))
-#if HasSharedData
-SharedLibraryDataTarget($(LIBNAME),$(SoRev),$(UNSHAREDOBJS))
-InstallSharedLibraryData($(LIBNAME),$(SoRev),$(SHLIBDIR))
-#endif
-#endif
-#if DoNormalLib
-#if HugeLibrary
-#if DoSharedLib && SeparateSharedCompile
-UnsharedLibraryTarget3($(LIBNAME),$(OBJS1),$(OBJS2),$(OBJS3),unshared,..)
-#else
-NormalLibraryTarget3($(LIBNAME),$(OBJS1),$(OBJS2),$(OBJS3))
-#endif
-#else
-#if DoSharedLib && SeparateSharedCompile
-UnsharedLibraryTarget($(LIBNAME),$(OBJS),unshared,..)
-#else
-NormalLibraryTarget($(LIBNAME),$(OBJS))
-#endif
-#endif
-InstallLibrary($(LIBNAME),$(USRLIBDIR))
-#endif
-#if DoProfileLib
-ProfiledLibraryTarget($(LIBNAME),$(OBJS))
-InstallLibrary($(LIBNAME)_p,$(USRLIBDIR))
-#endif
-#if DoDebugLib
-DebuggedLibraryTarget($(LIBNAME),$(OBJS))
-InstallLibrary($(LIBNAME)_d,$(USRLIBDIR))
-#endif
-
-LintLibraryTarget($(LIBNAME),$(SRCS))
-InstallLintLibrary($(LIBNAME),$(LINTLIBDIR))
-#ifdef IncSubdir
-BuildIncludes($(HEADERS),IncSubdir,..)
-InstallMultipleFlags($(HEADERS),$(INCDIR)/IncSubdir,$(INSTINCFLAGS))
-#else
-#ifndef CplusplusSource
-#if !defined(LibHeaders) || LibHeaders
-BuildIncludesTop($(HEADERS))
-InstallMultipleFlags($(HEADERS),$(INCDIR),$(INSTINCFLAGS))
-#endif
-#endif
-#endif
-
-NormalLintTarget($(SRCS))
-#endif
diff --git a/src/config/MacOSX.cf b/src/config/MacOSX.cf
deleted file mode 100644
index 9f9bc22..0000000
--- a/src/config/MacOSX.cf
+++ /dev/null
@@ -1,172 +0,0 @@
-XCOMM platform: $SFO: MOSXS.cf,v 1.0 95/11/19 23:21:00 sl Exp $
-
-#define OSVendor Apple Computer, Inc.
-#ifdef MacOSXArchitecture
-#define OSName MacOSX
-#define OSMajorVersion DefaultOSMajorVersion
-#define OSMinorVersion DefaultOSMinorVersion
-#define OSTeenyVersion 0
-#endif
-
-XCOMM #define ProjectRulesFile <MacOSX.rules>
-XCOMM #define ProjectTmplFile <MacOSX.tmpl>
-
-#define InstKmemFlags -m 2755 -g kmem
-/* #define ConstructMFLAGS NO */
-
-#define HasNdbm YES
-#define SetTtyGroup YES
-#define HasBsearch YES
-#ifdef MacOSXArchitecture
-#define HasPutenv YES
-#define MathLibrary /**/
-#define DBMLibrary /**/
-#define TermcapLibrary /**/
-#define HasBSD44Sockets YES
-#define HAS_SNPRINTF YES
-#endif
-
-#define NeedConstPrototypes YES
-#define NeedVarargsPrototypes YES
-#define NeedFunctionPrototypes YES
-#define NeedWidePrototypes NO
-
-#define GzipFontCompression YES
-#define CompressAllFonts YES
-
-#ifndef HasShm
-# define HasShm YES
-#endif
-#ifndef BuildGlxExt
-# define BuildGlxExt YES
-# define GlxUseNSGL YES
-#endif
-#define BuildServer YES
-#define BuildXprint NO
-#define BuildFonts YES
-#define BuildDPMS NO
-
-#define TenonServer YES
-#define XprtServer NO
-#define XVendorString "Tenon Intersystems Xtools"
-#define XVendorRelease 1000
-#ifndef UseRgbTxt
-#define UseRgbTxt YES
-#endif
-
-#define BuildPexExt NO
-
-#ifndef BuildGLXLibrary
-# define BuildGLXLibrary YES
-#endif
-
-/* no direct graphics extension */
-#define BuildXF86DGA NO
-
-/* no extra tablets and weird input devices */
-#define BuildXInputExt NO
-
-/* Build Xinerama (aka panoramiX) extension */
-#define BuildXinerama YES
-
-/* no Display Power Management extension */
-#define BuildDPMSExt NO
-
-# define BuildXvExt NO
-#define OptimizedCDebugFlags -O0 -g -pipe
-#define ExtraLoadFlags -L/usr/X11R6/lib
-
-#define BuildExamples YES
-
-/*#define StandardDefines -DCERNLIB_LINUX -DCERNLIB_PPC -DCERNLIB_MACOSX \
- -Dunix=unix -D__powerpc__ -D__DARWIN__ */
-#define StandardDefines -DCERNLIB_LINUX -DCERNLIB_MACOSX \
- -Dunix=unix -D__DARWIN__
-/* -DX_NOT_POSIX -DX_LOCALE */
-
-#define HasVoidSignalReturn YES
-
-#ifndef DependFlags
-#define DependFlags -I/usr/include/ansi -I/usr/include/bsd
-#endif
-
-#define InstallCmd install /* unlink old */
-
-/* #define ArCmd libtool -a -o */
-#define ArCmd ar -r
-
-#ifndef RanlibCmd
-#define RanlibCmd ranlib -c -s
-#endif
-
-/* see below for ServerDefines */
-
-#define PrimaryScreenResolution 95 /* for 17 inch screen */
-
-#define ServerCDebugFlags -O0 -g -pipe
-
-/* #define HasGcc YES */
-#ifndef HasGcc
-#define HasGcc YES
-#endif
-
-#undef CcCmd
-#undef CplusplusCmd
-#ifdef MacOSXArchitecture
-#if 0
-#define CcCmd cc -arch "ppc" -no-cpp-precomp -ftree-vectorize
-#define CplusplusCmd c++ -no-cpp-precomp -ftree-vectorize
-#else
-#define CcCmd cc -ftree-vectorize
-#define CplusplusCmd c++ -ftree-vectorize
-#endif
-#endif
-#ifndef CcCmd
-#define CcCmd cc
-#endif
-
-#define CppCmd /usr/bin/cpp
-
-#include <MacOSX.rules>
-#include <xf86.rules>
-#undef XFree86Server
-/* #define GLX_DIRECT_RENDERING */
-
-#define f2cFortran YES
-#define FortranCmd gfortran
-#define XargsCmd xargs
-#define FortranSaveFlags /* -fno-automatic */ /* Everything static !? */
-#define OptimisedFortranFlags -O0 -g -funroll-loops -fomit-frame-pointer \
- -ftree-vectorize
-#define DefaultFCOptions -fno-second-underscore
-/*#define CernlibSystem -DCERNLIB_LINUX -DCERNLIB_UNIX -DCERNLIB_LNX \
- -DCERNLIB_PPC -DCERNLIB_QMGLIBC \
- -DCERNLIB_MACOSX -DCERNLIB_GFORTRAN */
-
-#define CernlibSystem -DCERNLIB_LINUX -DCERNLIB_UNIX -DCERNLIB_LNX \
- -DCERNLIB_QMGLIBC \
- -DCERNLIB_MACOSX -DCERNLIB_GFORTRAN
-
-/* #define CERNLIB_SHIFT NO */
-#define CERNLIB_LINUX
-#define CERNLIB_UNIX
-#define CERNLIB_LNX
-/*#define CERNLIB_PPC*/
-#define CERNLIB_QMGLIBC
-#define CERNLIB_MACOSX
-#define CERNLIB_GFORTRAN
-
-#define X11Includes -I/usr/X11R6/include
-
-/*
- * Create a Make Variable to allow building with/out Motif
- */
-#define MotifIncludes -I/sw/include
-#undef MotifDependantMakeVar
-#define MotifDependantMakeVar(variable,value) @@\
-ifneq ($(strip $(HAVE_MOTIF)),) @@\
- variable=value @@\
-endif @@\
-/* End CERNLIB changes */
-
-
diff --git a/src/config/MacOSX.rules b/src/config/MacOSX.rules
deleted file mode 100644
index 8d4a6a0..0000000
--- a/src/config/MacOSX.rules
+++ /dev/null
@@ -1,117 +0,0 @@
-XCOMM $XConsortium: MOSXS.rules,v 1.1 97/12/12 15:34:45 sl Exp $
-
-/*
- * MacOSX shared library rules
- */
-
-#define HasSharedLibraries YES
-
-#define ForceNormalLib NO
-
-#ifndef SharedDataSeparation
-#define SharedDataSeparation YES
-#endif
-#ifndef SharedCodeDef
-#define SharedCodeDef
-#endif
-#ifndef SharedLibraryDef
-#define SharedLibraryDef -fno-common
-#endif
-
-#define ShLibIncludeFile <MacOSX.tmpl>
-
-#ifndef SharedLibraryLoadFlags
-#define SharedLibraryLoadFlags
-#endif
-#ifndef PositionIndependentCFlags
-#define PositionIndependentCFlags
-#endif
-
-
-
-
-/*
- * InstallSharedLibrary - generate rules to install the shared library.
- */
-#ifndef InstallSharedLibrary
-#define InstallSharedLibrary(libname,rev,dest) @@\
-install:: Concat(lib,libname.dylib) @@\
- MakeDir($(DESTDIR)dest) @@\
- $(INSTALL) $(INSTALLFLAGS) $(INSTBINFLAGS) Concat(lib,libname.dylib) $(DESTDIR)dest
-@@\
-
-#endif /* InstallSharedLibrary */
-
-/*
- * NormalSharedLibraryTarget - generate rules to create a shared library;
- * build it into a different name so that the we do not hose people by having
- * the library gone for long periods.
- */
-#ifndef SharedLibraryTarget
-#define SharedLibraryTarget(libname,rev,solist,down,up) @@\
-AllTarget(Concat(lib,libname.dylib)) @@\
- @@\
-Concat(lib,libname.dylib): solist $(EXTRALIBRARYDEPS) @@\
- $(RM) $@~ @@\
- (cd down; $(CC) -I/usr/X11R6/lib -dynamiclib -undefined suppress -install_name /usr/X11R6/lib/$@ -o up/$@~ $(SHLIBLDFLAGS) solist $(REQUIREDLIBS)) @@\
- $(MV) $@~ $@ @@\
- LinkBuildLibrary($@) @@\
- @@\
-clean:: @@\
- $(RM) Concat(lib,libname.dylib)
-
-#endif /* SharedLibraryTarget */
-
-/*
- * SharedDepLibraryTarget - generate rules to create a shared library.
- */
-#ifndef SharedDepLibraryTarget
-#define SharedDepLibraryTarget(libname,rev,deplist,solist,down,up) @@\
-AllTarget(Concat(lib,libname.dylib)) @@\
- @@\
-Concat(lib,libname.dylib): deplist $(EXTRALIBRARYDEPS) @@\
- $(RM) $@~ @@\
- (cd down; $(CC) -I/usr/X11R6/lib -dynamiclib -undefined suppress -install_name /usr/X11R6/lib/$@ -o up/$@~ $(SHLIBLDFLAGS) solist $(REQUIREDLIBS)) @@\
- $(RM) $@ @@\
- $(MV) $@~ $@ @@\
- LinkBuildLibrary($@) @@\
- @@\
-clean:: @@\
- $(RM) Concat(lib,libname.dylib)
-
-#endif /* SharedDepLibraryTarget */
-
-/*
- * SharedLibraryDataTarget - generate rules to create shlib data file;
- */
-#ifndef SharedLibraryDataTarget
-#define SharedLibraryDataTarget(libname,rev,salist)
-#endif /* SharedLibraryDataTarget */
-
-#ifndef InstallSharedLibraryData
-#define InstallSharedLibraryData(libname,rev,dest)
-#endif /* InstallSharedLibraryData */
-
-/*
- * SharedLibReferences - variables for shared libraries
- */
-#ifndef SharedLibReferences
-#define SharedLibReferences(varname,libname,libsource,revname,rev) @@\
-revname = rev @@\
-Concat3(DEP,varname,LIB) = SharedLibDependencies(libname,libsource,revname) @@\
-Concat(varname,LIB) = LoaderLibPrefix Concat(-l,libname) @@\
-LintLibReferences(varname,libname,libsource)
-#endif
-
-/*
- * SharedDSLibReferences - variables for shared libraries
- */
-#ifndef SharedDSLibReferences
-#define SharedDSLibReferences(varname,libname,libsource,revname,rev) @@\
-revname = rev @@\
-Concat3(DEP,varname,LIB) = SharedDSLibDependencies(libname,libsource,revname) @@\
-Concat(varname,LIB) = LoaderLibPrefix Concat(-l,libname) Concat3(Shared,libname,Reqs) @@\
-LintLibReferences(varname,libname,libsource)
-#endif
-
-
diff --git a/src/config/MacOSX.tmpl b/src/config/MacOSX.tmpl
deleted file mode 100644
index 23ae57f..0000000
--- a/src/config/MacOSX.tmpl
+++ /dev/null
@@ -1,67 +0,0 @@
-XCOMM $XConsortium: MOSXS.tmpl,v 1.2 97/12/12 19:07:12 sl Exp $
-
-/*
- * Xnext shared library template
- */
-
-
-
-#ifndef SharedXtReqs
-#define SharedXtReqs /**/
-#endif
-#ifndef SharedXawReqs
-#define SharedXawReqs /**/
-#endif
-#ifndef SharedXmuReqs
-#define SharedXmuReqs $(LDPRELIB) $(XTOOLONLYLIB) $(XONLYLIB)
-#endif
-
-#define SharedLibX11 YES
-#define SharedX11Rev F
-SharedLibReferences(XONLY,X11,$(XLIBSRC),SOXLIBREV,SharedX11Rev)
-
-#define SharedLibXau NO /* don't need shared form */
-#define SharedLibXdmcp NO /* don't need shared form */
-
-#define SharedLibXmu YES
-#define SharedXmuRev F
-
-#define SharedOldXRev F
-
-#define SharedLibXext YES
-#define SharedXextRev F
-
-#define SharedLibXt YES
-#define SharedXtRev F
-SharedDSLibReferences(XTOOLONLY,Xt,$(TOOLKITSRC),SOXTREV,SharedXtRev)
-
-#define SharedXawRev F
-
-#define SharedXtfRev A
-
-#define SharedLibXi YES
-#define SharedXiRev F
-SharedLibReferences(XI,Xi,$(XILIBSRC),SOXINPUTREV,SharedXiRev)
-
-#define SharedLibXtst YES
-#define SharedXtstRev F
-SharedLibReferences(XTEST,Xtst,$(XTESTLIBSRC),SOXTESTREV,SharedXtstRev)
-
-
-#define SharedPexRev F
-SharedLibReferences(PEX,PEX5,$(PEXLIBSRC),SOPEXREV,SharedPexRev)
-
-#define SharedLibXie YES
-#define SharedXieRev F
-
-#define SharedLibICE YES
-#define SharedICERev F
-SharedLibReferences(ICE,ICE,$(ICESRC),SOICEREV,SharedICERev)
-
-#define SharedLibSM YES
-#define SharedSMRev F
-SharedLibReferences(SM,SM,$(SMSRC),SOSMREV,SharedSMRev)
-
-#define SharedFSRev F
-SharedLibReferences(FS,FS,$(FSLIBSRC),SOFSREV,SharedFSRev)
-
diff --git a/src/config/Mips.cf b/src/config/Mips.cf
deleted file mode 100644
index f3894c3..0000000
--- a/src/config/Mips.cf
+++ /dev/null
@@ -1,74 +0,0 @@
-/* $Id: Mips.cf,v 1.1.1.1 1995/12/20 15:26:43 cernlib Exp $
- *
- * $Log: Mips.cf,v $
- * Revision 1.1.1.1 1995/12/20 15:26:43 cernlib
- * X11R6 config files unmodified
- *
- *
- */
-/*
- * Set version numbers before making makefiles.
- *
- * X11r5 only builds using the berkeley libraries and compiler. Make
- * sure your path includes /bsd43/bin before /bin/ or /usr/bin.
- */
-
-#define OSName RISCOS
-#define OSMajorVersion 4
-#define OSMinorVersion 50
-
-XCOMM platform: $XConsortium: Mips.cf,v 1.14 94/03/24 15:24:34 gildea Exp $
-XCOMM operating system: OSName
-
-/***************************************************************************
- * Platform-specific parameters *
- ***************************************************************************/
-
-#define HasVoidSignalReturn NO
-#define SetTtyGroup YES
-#define UnalignedReferencesAllowed NO /* if arbitrary deref okay */
-#define HasBsearch NO
-
-#define MipsArchitecture
-#define MakeEnv -e
-
-#define DefaultCCOptions -signed -systype bsd43 -Olimit 2000 -Wf,-XNd8400,-XNp12000
-#define StandardDefines -DMips -DBSD43
-#define PostIncDir /usr/include/bsd43
-#define ExtraLibraries -lmld
-#define ArCmd ar clr
-#define BootstrapCFlags -DMips
-#define InstallCmd /etc/mipsinstall -f
-#define MakeCmd make MakeEnv
-#define DoRanlibCmd NO
-#define AllocateLocalDefines -DINCLUDE_ALLOCA_H
-
-/***************************************************************************
- * *
- * DEFINE PARAMETERS FOR BUILDING *
- * *
- ***************************************************************************/
-
-#define XmipsServer YES
-
-/***************************************************************************
- * *
- * OVERRIDE ANY CONFIGURATION PARAMETERS FROM Imake.tmpl *
- * *
- ***************************************************************************/
-
-#define SpecialMalloc NO
-
-#define PrimaryScreenResolution 110
-
-#define ConstructMFLAGS NO /* build MFLAGS from MAKEFLAGS */
-
-#define DefaultUserPath /usr/net:/bin:/usr/bin:$(BINDIR):/usr/ucb
-#define DefaultSystemPath /usr/net:/bin:/usr/bin:/etc:$(BINDIR):/usr/ucb
-
-/* mips manuals are really complicated. This certainly won't work. */
-
-#define ManDirectoryRoot /man/cat
-#define ManSourcePath $(MANPATH)/man
-
-#define InstKmemFlags -g sys -m 2755
diff --git a/src/config/NetBSD.cf b/src/config/NetBSD.cf
deleted file mode 100644
index f97891c..0000000
--- a/src/config/NetBSD.cf
+++ /dev/null
@@ -1,163 +0,0 @@
-/* $Id: NetBSD.cf,v 1.2 2005/04/18 15:23:07 mclareni Exp $
- *
- * $Log: NetBSD.cf,v $
- * Revision 1.2 2005/04/18 15:23:07 mclareni
- * Mods submitted by Kevin B. McCarty to fix insecure Cernlib uses of /tmp.
- *
- * Revision 1.1.1.1 1995/12/20 15:26:45 cernlib
- * X11R6 config files unmodified
- *
- *
- */
-XCOMM platform: $XConsortium: NetBSD.cf,v 1.5 95/04/07 19:42:55 kaleb Exp $
-
-#define OSName NetBSD
-#define OSVendor /**/
-XCOMM operating system: OSName
-#define OSMajorVersion 0
-#define OSMinorVersion 9
-
-#define HasPutenv YES
-#define HasBSD44Sockets YES
-
-#define CppCmd /usr/libexec/cpp -traditional
-#define PreProcessCmd /usr/libexec/cpp -traditional
-#undef InstallCmd
-#define InstallCmd /usr/bin/install
-#undef TblCmd
-#define TblCmd /usr/bin/tbl
-#undef EqnCmd
-#define EqnCmd /usr/bin/eqn -Tascii
- COL = /usr/bin/col
- NEQN = /usr/bin/neqn
- NROFF = /usr/bin/nroff
-
-#define UseGas YES
-#ifndef GccUsesGas
-# define GccUsesGas YES
-#endif
-
-#ifndef AsmDefines
-# define AsmDefines -DUSE_GAS
-#endif
-
-#if GccUsesGas
-# define GccGasOption -DGCCUSESGAS
-#else
-# define GccGasOption /**/
-#endif
-
-#ifndef HasGcc2
-# define HasGcc2 YES
-#endif
-
-#define CcCmd gcc
-#if UseInstalled
-#define DefaultCCOptions /**/
-#else
-#define DefaultCCOptions -ansi -Dasm=__asm
-#endif
-
-#ifdef i386Architecture
-#define OptimizedCDebugFlags -m486 -O2
-#if OSMajorVersion < 1
-#define ServerOSDefines XFree86ServerOSDefines -DDDXTIME -DXNO_SYSCONF
-#else
-#define ServerOSDefines XFree86ServerOSDefines -DDDXTIME
-#endif
-#else
-#define OptimizedCDebugFlags -O2
-# ifdef SparcArchitecture
-# define ServerOSDefines -DDDXOSINIT
-# else
-# define ServerOSDefines /**/
-# endif
-#endif
-#define ServerExtraDefines GccGasOption XFree86ServerDefines
-
-#define StandardDefines -DCSRG_BASED
-#define XawI18nDefines -DUSE_XWCHAR_STRING -DUSE_XMBTOWC
-
-#define TroffCmd groff -Tps
-#define SetTtyGroup YES
-#define DBMLibrary /**/
-#define HasNdbm YES
-#define HasShm YES
-#define HasWChar32 YES
-
-#define HasLibCrypt YES
-
-#define AvoidNullMakeCommand YES
-
-XCOMM Man pages need to be formatted when installed, so override the default
-XCOMM imake rules.
-
-#define ManSuffix 1
-#define FileManSuffix 5
-#define ManSourcePath $(MANPATH)/cat
-
-#define InstallManPageLong(file,destdir,dest) @@\
-all:: file.0 @@\
- @@\
-file.0:: file.man @@\
- @if [ -f file.man ]; \ @@\
- then \ @@\
- cat file.man | $(NEQN) | $(TBL) | $(NROFF) -man | $(COL) >file.0; \ @@\
- fi @@\
- @@\
-file.man:: @@\
- @@\
-install.man:: @@\
- MakeDir($(DESTDIR)destdir) @@\
- - at if [ -f file.0 ]; \ @@\
- then \ @@\
- $(INSTALL) -c $(INSTMANFLAGS) file.0 $(DESTDIR)destdir/dest.0; \@@\
- fi
-
-#define InstallMultipleManSuffix(list,dest,suff) @@\
-install.man:: @@\
- MakeDir($(DESTDIR)dest) @@\
- case '${MFLAGS}' in *[i]*) set +e;; esac; \ @@\
- for i in list; do \ @@\
- (set -x; \ @@\
- TMP=$(DESTDIR)dest/$$$$.suff ; \ @@\
- cat $$i.suff | $(NEQN) | $(TBL) | $(NROFF) -man | $(COL) >$${TMP}; \ @@\
- $(INSTALL) -c $(INSTMANFLAGS) $${TMP} $(DESTDIR)dest/$$i.0; \ @@\
- $(RM) $${TMP} ); \ @@\
- done
-
-#define InstallMultipleMan(list,dest) @@\
- InstallMultipleManSuffix(list,dest,man)
-
-#define InstallManPageAliases(file,destdir,aliases) @@\
-install.man:: @@\
- @case '${MFLAGS}' in *[i]*) set +e;; esac; \ @@\
- for i in aliases; do \ @@\
- (set -x; \ @@\
- $(RM) $(DESTDIR)destdir/$$i.0;\ @@\
- $(LN) destdir/file.0 $(DESTDIR)destdir/$$i.0;\ @@\
- ); \ @@\
- done
-
-#define NetBSDArchitecture
-
-#include <bsdLib.rules>
-
-#ifdef SparcArchitecture
-#ifndef Xsun24Server
-#define Xsun24Server NO
-#endif
-#ifndef XsunServer
-#define XsunServer YES
-#endif
-#ifndef XsunMonoServer
-#define XsunMonoServer YES
-#endif
-#ifndef UseRgbTxt
-#define UseRgbTxt YES
-#endif
-#endif
-
-#ifdef i386Architecture
-# include <xfree86.cf>
-#endif
diff --git a/src/config/Oki.cf b/src/config/Oki.cf
deleted file mode 100644
index a93eb69..0000000
--- a/src/config/Oki.cf
+++ /dev/null
@@ -1,30 +0,0 @@
-/* $Id: Oki.cf,v 1.1.1.1 1995/12/20 15:26:45 cernlib Exp $
- *
- * $Log: Oki.cf,v $
- * Revision 1.1.1.1 1995/12/20 15:26:45 cernlib
- * X11R6 config files unmodified
- *
- *
- */
-XCOMM platform: $XConsortium: Oki.cf,v 1.14 95/06/09 20:57:00 gildea Exp $
-
-#define OSName Unix System V/860 Release 4.0 Version 3
-XCOMM operating system: OSName
-#define OSMajorVersion 4
-#define OSMinorVersion 0
-#define OSTeenyVersion 3
-
-#define BootstrapCFlags -DOki
-#define SystemV4 YES
-#define HasLdRunPath YES
-#define ConnectionFlags -DTCPCONN -DUNIXCONN -DLOCALCONN
-#define SetTtyGroup YES
-#define HasPutenv YES
-#define HasPoll YES
-#define PatheticCpp YES
-#define CcCmd /usr/bin/cc
-#define StandardDefines -DSVR4 -Di860
-#define DefaultCCOptions -Xa
-#define BuildServer NO
-#define ToolkitStringsABIOptions -intelabi
-#include <sv4Lib.rules>
diff --git a/src/config/Project.tmpl b/src/config/Project.tmpl
deleted file mode 100644
index e483d5d..0000000
--- a/src/config/Project.tmpl
+++ /dev/null
@@ -1,51 +0,0 @@
-/* $Id: Project.tmpl,v 1.6 1997/02/28 10:35:59 gunter Exp $
- *
- * $Log: Project.tmpl,v $
- * Revision 1.6 1997/02/28 10:35:59 gunter
- * remove trailing / for CERN_...
- *
- * Revision 1.5 1996/11/13 13:28:56 cernlib
- * Add CERN_SHLIBDIR
- *
- * Revision 1.4 1996/03/19 14:49:57 cernlib
- * add CERN_BINDIR, CERN_LIBDIR initialisation
- *
- * Revision 1.3 1996/03/08 17:12:09 cernlib
- * *** empty log message ***
- *
- * Revision 1.2 1995/12/21 11:32:15 cernlib
- * Imake files end 1995
- *
- * Revision 1.1.1.1 1995/12/20 15:26:41 cernlib
- * X11R6 config files unmodified
- *
- *
- */
-/* CERNlib Project */
-/* @(#) $(Header) */
-
-
-#ifndef ConfigDir
-#define ConfigDir $(CVSCOSRC)$/config
-#endif
-
-
-ifeq ($(strip $(CERN)),)
-CERN=/cern
-endif
-
-ifeq ($(strip $(CERN_LEVEL)),)
-CERN_LEVEL=new
-endif
-
-ifeq ($(strip $(CERN_LIBDIR)),)
-CERN_LIBDIR=$(CERN)$/$(CERN_LEVEL)$/lib
-endif
-
-ifeq ($(strip $(CERN_SHLIBDIR)),)
-CERN_SHLIBDIR=$(CERN)$/$(CERN_LEVEL)$/shlib
-endif
-
-ifeq ($(strip $(CERN_BINDIR)),)
-CERN_BINDIR=$(CERN)$/$(CERN_LEVEL)$/bin
-endif
diff --git a/src/config/README b/src/config/README
deleted file mode 100644
index 897b5dd..0000000
--- a/src/config/README
+++ /dev/null
@@ -1,387 +0,0 @@
-/* $Id: README,v 1.2 1996/04/02 21:02:27 thakulin Exp $
- *
- * $Log: README,v $
- * Revision 1.2 1996/04/02 21:02:27 thakulin
- * Add entries for HasApogee and HasEPC macros.
- *
- * Revision 1.1.1.1 1995/12/20 15:26:45 cernlib
- * X11R6 config files unmodified
- *
- *
- */
-$XConsortium: README,v 1.37.1.1 95/07/06 13:57:09 kaleb Exp $
-
-The easiest way to write an Imakefile is to find another one that does
-something similar and copy/modify it!
-
-Imake.tmpl provides defaults for the following variables:
-
- AlternateIncRoot compiler needs -I to find project includes
- AlternateUsrLibDir linker needs -L to find project libraries
- ArCmd command used to create libraries
- ArCmdBase program name part of ArCmd
- ArAddCmd flags to have ArCmdBase add files to a library
- ArExtCmd flags to have ArCmdBase extract files
- AsCmd command used to run assembler
- BootstrapCFlags missing cpp symbols needed to get started
- BourneShell command used to run Bourne Shell
- CCsuf suffix that C++ source files have
- CURDIR current directory relative to top of sources
- CcCmd command to run C compiler
- CompressCmd command to run compress program
- ConstructMFLAGS System V option to set MFLAGS make variable
- CpCmd command to copy one file to another
- CplusplusCmd command to run C++ compiler
- CplusplusYaccCmd command to produce C++ source from yacc source
- CppCmd command to run C preprocessor
- CrossCompiling cross compiling? (not fully supported)
- DebuggableCDebugFlags C compiler -I's and -D's to turn on debug info
- DefaultCCOptions default special C compiler options
- DefaultCDebugFlags debug/optimize flags for programs
- DefaultUsrBin program directory used even if PATH not set
- DependFlags extra makedepend flags
- DoRanlibCmd boolean for system uses ranlib
- EqnCmd command used for eqn
- ExecableScripts boolean for systems that can exec() #!/bin/sh
- ExpandManNames boolean to expand man pages names to long form
- ExtraFilesToClean extra files to remove on make clean
- ExtraLibraries system-specific libraries need to link
- ExtraLoadFlags system-specific loader flags
- FileManSuffix man suffix for file format pages
- FilesToClean files to delete in make clean
- FortranCmd command to run Fortran compiler
- FortranDebugFlags flags for Fortran debug info
- FortranFlags Fortran compiler flags
- HasApogee boolean for system has Apogee compiler suite
- HasBSD44Sockets boolean for system has BSD4.4 sockets
- HasBsearch boolean for libc has bsearch()
- HasCenterLineC boolean for system has CenterLine C compiler
- HasCenterLineCplusplus boolean for system has CenterLine C++ compiler
- HasCodeCenter boolean for system has CodeCenter
- HasCplusplus system has a C++ compiler?
- HasDECnet system has DECnet?
- HasEPC boolean for system has EPC compiler suite
- HasFortran boolean for system has Fortran compiler
- HasGcc boolean for system has GNU gcc compiler
- HasGcc2 boolean for system has GNU gcc 2.x compiler
- HasGcc2ForCplusplus use gcc 2 for C++ programs?
- HasKrb5 system has Kerberos version 5 support?
- HasLargeTmp boolean for system has /tmp space
- HasNdbm boolean for system has ndbm routines
- HasPoll use poll() syscall?
- HasPurify boolean for system has Purify
- HasPutenv boolean for libc has putenv()
- HasSecureRPC boolean for Sun Secure RPC
- HasSentinel boolean for system has Sentinel available
- HasSharedLibraries boolean for system has shared libraries
- HasShm boolean for System V shared memory
- HasSockets boolean for system has BSD sockets
- HasStreams use STREAMS I/O interface?
- HasSymLinks boolean for system has symbolic links
- HasTestCenter boolean for system has TestCenter
- HasVFork boolean for system has vfork()
- HasVoidSignalReturn boolean for POSIX signal() procs
- IncRoot parent of X11 include directory
- InstBinFlags install flags for binaries
- InstDatFlags install flags for data files
- InstIncFlags install flags for header files
- InstKmemFlags install flags for xload to get at /dev/kmem
- InstLibFlags install flags for libraries
- InstManFlags install flags for manual pages
- InstPgmFlags install flags for normal programs
- InstUidFlags install flags for xterm to chown /dev/ptys
- InstallCmd command to install files
- IxxCmd IDL to C++ command
- Krb5Includes where to include Kerberos header files from
- Krb5Libraries where to load Kerberos libraries from
- LdCmd command to run loader
- LdCombineFlags flags for incremental loading
- LexCmd command to run lex
- LexLib library for programs using lex output
- LintCmd command to run lint
- LintLibFlag flags to generate lint libraries
- LintOpts lint options to control strictness
- LnCmd command to link two files
- LoaderLibPrefix loader flags before libraries
- MacroFile name of machine-dependent config params file
- MacroIncludeFile <MacroFile>
- MakeCmd command to run make
- Malloc0ReturnsNull boolean for malloc(0) == NULL
- MathLibrary library for programs using C math functions
- MsMacros macro flag for TroffCmd, normally "-ms"
- MvCmd command to rename a file
- NdbmDefines -D's to turn on use of ndbm routines
- NeedConstPrototoypes whether const is supported
- NeedFunctionPrototypes whether or not to force function prototypes
- NeedNestedPrototypes whether nested prototypes are supported
- NeedVarargsPrototypes whether varargs prototypes are supported
- NeedWidePrototypes whether or not to widen function prototypes
- NoOpCDebugFlags C compiler flags to not debug or optimize
- NoRConst YES if const for structs of funcs is bad
- OSMajorVersion major version number of operating system
- OSMinorVersion minor version number of operating system
- OptimizedCDebugFlags C compiler flags to turn on optimization
- PreProcessCmd command to run /lib/cpp on scripts
- RanlibCmd command to clean up libraries
- RanlibInstFlags flags to ranlib after copying
- RmCmd command to delete files
- ShLibDir directory in which to install shared libraries
- StandardCppDefines -D's for running cpp
- StandardDefines -D's for running C compiler
- StandardIncludes -I's for running C compiler
- StripInstalledPrograms boolean for sites that want to install -s
- SystemV boolean for systems that are at least SVR2
- SystemV4 boolean for SVR4 systems
- TOPDIR relative path to top of sources
- TagsCmd command to run tags
- TblCmd command to run tbl
- TroffCmd command to run troff to get PostScript
- UNCOMPRESSPATH command to run uncompress
- UnalignedReferencesAllowed boolean for unaligned copies ok
- UsrLibDir directory in which to install libraries
- YaccCmd command to run yacc
-
-Project.tmpl provides defaults for the following variables:
-
- AdmDir directory containing system log files
- AllocateLocalDefines -D's to turn on alloca()
- BDFTOSNFFILT command to run bdftosnf
- BaseExtensionDefines universal extensions to use
- BinDir directory in which to install programs
- BuildFontServer build font server
- BuildFonts build pcf fonts
- BuildIncRoot relative path to location of headers in build
- BuildIncTop path from build includes directory to top
- BuildPex build all PEX-related code
- BuildPexClients boolean for building PEX clients/demos
- BuildPexExt build PEX extension
- BuildServer build X server
- BuildXIE build X Image Extension
- BuildDIS build Document Imaging Subset of XIE
- BuildXInputExt build X Input extension
- BuildXInputLib build X Input library
- BuildXKB build X Keyboard Extension?
- ConfigDir install directory for config files
- ConnectionFlags -D's for supported transports
- ContribDir location of user-contributed sources
- DebugLibFS build libFS_d.a
- DebugLibICE build libICE_d.a
- DebugLibPex build libPEX5_d.a
- DebugLibSM build libSM_d.a
- DebugLibX11 build libX11_d.a
- DebugLibXau build libXau_d.a
- DebugLibXaw build libXaw_d.a
- DebugLibXdmcp build libXdmcp_d.a
- DebugLibXext build libXext_d.a
- DebugLibXi build libXi_d.a
- DebugLibXie build libXie_d.a
- DebugLibXmu build libXmu_d.a
- DebugLibXt build libXt_d.a
- DebugLibXtst build libXtst_d.a
- DebugOldX build liboldX_d.a
- DefaultFSConfigFile default font server config file
- DefaultFontPath default server font path
- DefaultRGBDatabase default server rgb color database
- DefaultSystemPath default system xdm PATH environment variable
- DefaultSystemShell default /bin/sh
- DefaultUserPath default user xdm PATH environment variable
- DependCmd command to run makedepend
- DependDir build directory containing makedepend program
- ExtensionDefines -D's for universal extensions
- ExtensionOSDefines -D's for additional extensions
- FontCompilerFlags flags for bdftosnf
- FontDefines -D's to turn on font options
- FontDir directory in which to install fonts
- FontFilters -D's to specify font conversion filters
- FontOSDefines -D's for which fonts to support
- ForceNormalLib force building of .a in addition to shared lib
- HasXdmAuth boolean for using XDM-AUTHORIZATION-1
- InstallAppDefFiles boolean for installing new app defaults files
- InstallFSConfig boolean for installing fs config file
- InstallLibManPages boolean for installing library man pages
- InstallXdmConfig boolean for installing xdm config files
- InstallXinitConfig boolean for installing xinit config files
- LibDir directory in which to install X11 support files
- LibManSuffix man suffix for library pages
- LibmanDir directory in which to install library man pages
- LintlibDir directory in which to install lint libs
- ManDir directory in which to install program man pages
- ManDirectoryRoot parent of man directories relative to root
- ManPath full path of parent directory
- ManSourcePath common prefix of man page directories
- ManSuffix man suffix for programs
- NeedDefaultDepLibs boolean for enabling default DEPLIBS
- NlsDir directory in which to install nls files
- NormalLibFS build libFS.a
- NormalLibICE build libICE.a
- NormalLibPex build libPEX5.a
- NormalLibPhigs build libphigs.a
- NormalLibSM build libSM.a
- NormalLibX11 build libX11.a
- NormalLibXau build libXau.a
- NormalLibXaw build libXaw.a
- NormalLibXdmcp build libXdmcp.a
- NormalLibXext build libXext.a
- NormalLibXi build libXi.a
- NormalLibXie build libXie.a
- NormalLibXmu build libXmu.a
- NormalLibXt build libXt.a
- NormalLibXtst build libXtst.a
- NormalOldX build liboldX.a
- OsNameDefines beats me
- PexApiDir PEX include file location
- PexCCOptions special options for building PEX library
- PexCDebugFlags special flags for building PEX library
- PexClientDefines special -D's for building PEX clients
- PexDipexDefines special -D's for building PEX di files
- PexPhigsDefines special -D's for building PEX library
- PexShmIPC boolean for using shared memory in phigsmon
- PhigsInclude include directory for phigs clients
- PrimaryScreenResolution resolution of default server screen
- ProfileLibFS build libFS_p.a
- ProfileLibICE build libICE_p.a
- ProfileLibPex build libPEX5_p.a
- ProfileLibSM build libSM_p.a
- ProfileLibX11 build libX11_p.a
- ProfileLibXau build libXau_p.a
- ProfileLibXaw build libXaw_p.a
- ProfileLibXdmcp build libXdmcp_p.a
- ProfileLibXext build libXext_p.a
- ProfileLibXi build libXi_p.a
- ProfileLibXie build libXie_p.a
- ProfileLibXmu build libXmu_p.a
- ProfileLibXt build libXt_p.a
- ProfileLibXtst build libXtst_p.a
- ProfileOldX build liboldX_p.a
- ProjectX version indicating this is the X Window System
- RemoveTargetProgramByMoving boolean for rm -f that doesn't
- SHELLPATH -D for /bin/sh
- ServerDefines complete -D's for server
- ServerExtraDefines special -D's for server
- ServerOSDefines OS -D's for server
- SharedLibFS boolean for making sharable libFS.so
- SharedLibICE boolean for making sharable libICE.so
- SharedLibPex boolean for making sharable libPEX5.so
- SharedLibPhigs boolean for making sharable libphigs.so
- SharedLibSM boolean for making sharable libSM.so
- SharedLibX11 boolean for making sharable libX11.so
- SharedLibXau boolean for making sharable libXau.so
- SharedLibXaw boolean for making sharable libXaw.so
- SharedLibXdmcp boolean for making sharable libXdmcp.so
- SharedLibXext boolean for making sharable libXext.so
- SharedLibXi boolean for making sharable libXi.so
- SharedLibXie boolean for making sharable libXie.so
- SharedLibXmu boolean for making sharable libXmu.so
- SharedLibXt boolean for making sharable libXt.so
- SharedLibXtst boolean for making sharable libXtst.so
- SharedOldX boolean for making sharable liboldX.so
- ShmDefines MIT-SHM define
- TwmDir directory in which to install twm config files
- UseCCMakeDepend boolean for using alternate makedepend script
- UseRgbTxt use rgb.txt file as is instead of DBM-compiled
- XAppLoadDir directory in which to install app defaults
- XFileSearchPathBase base file search path
- XFileSearchPathDefault default path to search for app defaults files
- XInputDefines XINPUT define
- XawClientDepLibs DEPLIBS for clients that use Xaw
- XawClientLibs LOCAL_LIBRARIES for clients that use Xaw
- XdmConfigurationSubdirectory name of default xdm configuration
- XdmDir directory in which to install xdm files
- XdmServersType type of xdm Xservers file to install
- XinitDir directory in which to install xinit files
- XmanLocalSearchPath non-standard path for man pages
- XtErrorPrefix leading text in XtError() msg; eg. 'X Toolkit '
- XtWarningPrefix leading text in XtWarning()msg, same as above
- ZBDFTOSNFFILT -D to run uncompress and bdftosnf
-
-
-Library.tmpl provides defaults for the following variables:
-
- AvoidNullMakeCommand for makes that spout about $(_NULLCMD_)
- LibraryCCOptions special C compiler options for libraries
- LibraryCDebugFlags library debug/optimize flags to override defs
- LibraryCcCmd command to run C compiler in libraries
- LibraryCplusplusOptions special C++ options for libraries
- LibraryCplusplusDebugFlags library debug/optimize flags for C++
- LibraryCplusplusCmd command to run C++ compiler in libraries
- LibraryDefines -D's for libraries
- SeparateSharedCompile shared and unshared libs use same binaries?
-
-
-Server.tmpl provides defaults for the following variables:
-
- ServerCCOptions server C compiler options to override defaults
- ServerCcCmd command to run C compiler in server
- ServerCDebugFlags server debug/opt compiler flags
- ServerDefines server standard -D's
- InstallServerSetUID does this system need X server suid to root?
-
-
-Threads.tmpl provides defaults for the following variables:
-
- LocalThreads whether to enable multi-threading support
- LocalThreadsDefines -D flags needed in this directory
-
-
-An <os>Lib.rules file provides defaults for the following variables:
-
- HasSharedLibraries boolean for using shared libraries
- SharedDataSeparation boolean indicating separate data/code
- SharedCodeDef -D's for compiling shared library files
- SharedLibraryDef -D's for defining which kind of shared lib
- ShLibIncludeFile location of the <os>Lib.tmpl file
- SharedLibraryLoadFlags loader flags when making the library
- PositionIndependentCFlags PIC compiler flags for C
- PositionIndependentCplusplusFlags PIC compiler flags for C++
-
- Note: PositionIndependentCplusplusFlags is only required if the
- C and C++ compilers use different flags to build PIC code. The
- default configuration will try to use PositionIndependentCFlags
- for both C and C++ compiles.
-
-An <os>Lib.tmpl file provides defaults for the following variables:
-
- SharedFSReqs required libs for libFS.so
- SharedFSRev version number for libFS.so
- SharedICEReqs required libs for libICE.so
- SharedICERev version number for libICE.so
- SharedOldXReqs required libs for liboldX.so
- SharedOldXRev version number for liboldX.so
- SharedPexReqs required libs for libPEX5.so
- SharedPexRev version number for libPEX5.so
- SharedSMReqs required libs for libSM.so
- SharedSMRev version number for libSM.so
- SharedX11Reqs required libs for libX11.so
- SharedX11Rev version number for libX11.so
- SharedXauReqs required libs for libXau.so
- SharedXauRev version number for libXau.so
- SharedXawReqs required libs for libXaw.so
- SharedXawRev version number for libXaw.so
- SharedXdmcpReqs required libs for libXdmcp.so
- SharedXdmcpRev version number for libXdmcp.so
- SharedXextReqs required libs for libXext.so
- SharedXextRev version number for libXext.so
- SharedXiReqs required libs for libXi.so
- SharedXiRev version number for libXi.so
- SharedXieReqs required libs for libXie.so
- SharedXieRev version number for libXie.so
- SharedXmuReqs required libs for libXmu.so
- SharedXmuRev version number for libXmu.so
- SharedXtReqs required libs for libXt.so
- SharedXtRev version number for libXt.so
- SharedXtstReqs required libs for libXtst.so
- SharedXtstRev version number for libXtst.so
-
-The following variables are used by some part of the tree:
-
- AckToolset programs/Xserver/hw/xfree86
- BuildChooser build the xdm chooser program?
- SharedLibXdmGreet use xdm shared dynamic greeter library?
- LatexCmd command to run LaTeX on a document
- DvipsCmd command to turn .dvi file into PostScript
- MotifBC using Motif 1.1.1, 1.1.2, or 1.1.3?
- GetValuesBC compat GetValues behavior for broken apps?
- NeedBerklib application needs libXbsd?
- SvgaConfig default SVGA configuration
- HasGetReturnAddress util/memleak
- HasShadowPasswd system has getspnam() function
diff --git a/src/config/Server.tmpl b/src/config/Server.tmpl
deleted file mode 100644
index f89a097..0000000
--- a/src/config/Server.tmpl
+++ /dev/null
@@ -1,57 +0,0 @@
-/* $Id: Server.tmpl,v 1.1.1.1 1995/12/20 15:26:42 cernlib Exp $
- *
- * $Log: Server.tmpl,v $
- * Revision 1.1.1.1 1995/12/20 15:26:42 cernlib
- * X11R6 config files unmodified
- *
- *
- */
-/*
- * Server imakefile info - this contains any special redefinitions, etc.
- * that Imakefiles in the server subtree will need.
- */
-
-XCOMM $XConsortium: Server.tmpl,v 1.13 94/04/08 16:59:46 rws Exp $
-
-#define PassCDebugFlags CDEBUGFLAGS="$(CDEBUGFLAGS)" LDSTRIPFLAGS="$(LDSTRIPFLAGS)"
-
-#ifndef ServerCcCmd
-#define ServerCcCmd CcCmd
-#endif
-#ifndef ServerCCOptions
-#define ServerCCOptions DefaultCCOptions
-#endif
-#ifndef ServerDefines
-#define ServerDefines StandardDefines
-#endif
-#ifndef ServerCDebugFlags
-#define ServerCDebugFlags DefaultCDebugFlags
-#endif
-#ifndef DoThreadedServer
-#define DoThreadedServer NO
-#endif
-#ifndef InstallServerSetUID
-#define InstallServerSetUID NO
-#endif
-
-/*
- * SetUIDServerTarget - compile, link, and relink a setuid server
- */
-#ifndef SetUIDServerTarget
-#if InstallServerSetUID
-#define SetUIDServerTarget(server,subdirs,objects,libs,syslibs) @@\
-ServerTargetWithFlags(server,subdirs,objects,libs,syslibs,$(INSTUIDFLAGS))
-#else
-#define SetUIDServerTarget ServerTarget
-#endif
-#endif /* SetUIDServerTarget */
-
- CC = ServerCcCmd
- CCOPTIONS = ServerCCOptions
-#if DoThreadedServer
-SERVER_THREAD_DEFINES = XThreadsDefines ThreadTypeDefines
-#endif
-STD_DEFINES = ServerDefines $(SERVER_THREAD_DEFINES)
-CDEBUGFLAGS = ServerCDebugFlags
-EXT_DEFINES = ExtensionDefines
-
diff --git a/src/config/Threads.tmpl b/src/config/Threads.tmpl
deleted file mode 100644
index ba6e052..0000000
--- a/src/config/Threads.tmpl
+++ /dev/null
@@ -1,77 +0,0 @@
-/* $Id: Threads.tmpl,v 1.1.1.1 1995/12/20 15:26:39 cernlib Exp $
- *
- * $Log: Threads.tmpl,v $
- * Revision 1.1.1.1 1995/12/20 15:26:39 cernlib
- * X11R6 config files unmodified
- *
- *
- */
-XCOMM $XConsortium: Threads.tmpl,v 1.3 94/03/30 12:04:19 gildea Exp $
-
-/*
- * For a multi-threaded application or library,
- * Define LocalThreadsDefines in your Imakefile (unless you like the
- * project default), then include this file.
- * Everything else should be automatic.
- */
-
-#ifndef LocalThreadsDefines
-#ifdef ProjectThreadsDefines
-#define LocalThreadsDefines ProjectThreadsDefines
-#else
-#define LocalThreadsDefines /**/
-#endif
-#endif
-
-#ifndef LocalThreads
-#ifdef ThreadedProject
-#define LocalThreads ThreadedProject
-#else
-#define LocalThreads YES
-#endif
-#endif
-
-#ifndef ThreadTypeDefines
-#if HasCThreads
-#define ThreadTypeDefines -DCTHREADS
-#else
-#define ThreadTypeDefines /**/
-#endif
-#endif
-#ifndef SystemMTDefines
-#define SystemMTDefines /**/
-#endif
-#ifndef CplusplusSystemMTDefines
-#define CplusplusSystemMTDefines /**/
-#endif
-#ifndef ThreadsCompileFlags
-#define ThreadsCompileFlags /**/
-#endif
-#ifndef ThreadsCplusplusCompileFlags
-#define ThreadsCplusplusCompileFlags /**/
-#endif
-
-#ifndef ThreadsLibraries
-#define ThreadsLibraries /**/
-#endif
-#ifndef ThreadsCplusplusLibraries
-#define ThreadsCplusplusLibraries /**/
-#endif
-#ifndef ThreadsLoadFlags
-#define ThreadsLoadFlags ThreadsCompileFlags
-#endif
-#ifndef ThreadsCplusplusLoadFlags
-#define ThreadsCplusplusLoadFlags ThreadsCplusplusCompileFlags
-#endif
-
-#if LocalThreads
- THREADS_CFLAGS = ThreadsCompileFlags
- THREADS_DEFINES = LocalThreadsDefines ThreadTypeDefines SystemMTDefines
- THREADS_LDFLAGS = ThreadsLoadFlags
- THREADS_LIBS = ThreadsLibraries
-
- THREADS_CXXFLAGS = ThreadsCplusplusCompileFlags
-THREADS_CXXDEFINES = LocalThreadsDefines ThreadTypeDefines CplusplusSystemMTDefines
-THREADS_CXXLDFLAGS = ThreadsCplusplusLoadFlags
- THREADS_CXXLIBS = ThreadsCplusplusLibraries
-#endif
diff --git a/src/config/Win32.biglib.rules b/src/config/Win32.biglib.rules
deleted file mode 100644
index 1ad49e6..0000000
--- a/src/config/Win32.biglib.rules
+++ /dev/null
@@ -1,132 +0,0 @@
-/*
- * rules to build a library from objects in subdirs
- * VF 180897 ArchiveLibraryBuild has been introduced
- * VF 180897 SubdirLibraryBuild2 has been removed
- * GF. 180895
- * VF. 111195 for Windows NT 3.51
- * VF. 200596 for Windows NT 3.51
- *
- * use this rules with:
- * Imakefile:
- * SubdirLibraryTarget(libname,subdirlist)
- * where: libname: name of library to make
- * subdirlist: list of subdirectories to take $(OBJS) files from
- *
- * and invoke make with :
- * make library
- * to get library libname up to date.
- *
- * At the moment ONLY one library per Imakefile/Makefile is allowed.
- *
- *
- * make library does:
- * 1) in rule library:
- * through dependency make shure that libhelp rules is always
- * followed
- * when this is back, relaunch make to check if the actual LIBRARY
- * needs to be rebuild; this cannot be done in the original make,
- * as checking of stamps is done before the rules are followed,
- * ie. the library would always be recreated, as we have to follow
- * the subdirectory rules always.
- * 2) in rule libhelp:
- * intermediate thing to allow submake to start at this place
- * 3) in rule LOCALSTAMP:
- * check if local $(OBJS) need recompilation (implicit)
- * if any object was changed, remove $(STAMP) and
- * touch local stamp "LOCALSTAMP".
- * side effect if there are no objects: create local stamp LOCALSTAMP
- *
- * 4) in rule SUBDIRSTAMP:
- * visit all sub directories and start at 2). $(STAMP) is set to
- * "directory/SUBDIRSTAMP" to allow the submake to commucate any
- * changes back.
- * if stamp SUBDIRSTAMP was deleted by any of the sub-makes,
- * remove the $(STAMP), ie, communicate changes back up, and
- * touch SUBDIRSTAMP. Note that at the top level
- * $(STAMP)=LOCALSTAMP, ie. any change in a subdirectory cause
- * this fiel to disappear, and in turn the $(LIBRARY) to be
- * recreated through rule 1) and 5)
- * 5) rule $(LIBRARY)
- * receate $(LIBRARY) when LOCALSTAMP is newer from objects in
- * subdirs. This may run LOCALSTAMP rule again to create
- * LOCALSTAMP, if this was deleted.
- *
- */
-
-/* --------------------------------------------------------------------- */
-
-#define ArchiveLibraryBuild(libname,version) @@\
-LibraryTargetName(libname): version/objects.list @@\
- @echo rebuild version library $@ in $(CURRENT_DIR) @@\
- RemoveFile($@) @@\
- MakeLibrary($@,$(indirectfile)$(VERDIR)objects.list)
-
-/* --------------------------------------------------------------------- */
-
-#define SubdirLibraryObjects2old(dirs) @@\
-ifeq ($(MAKEOBJECTLIST),1) @@\
-$(VERDIR)objects.list:: $(basename $($(VEROBJS))) @@\
- @@\
-$(basename $($(VEROBJS))):: ; @if NOT Quote($@) == "" echo $(addsuffix .Osuf, Win32Path($@)) >> Win32Path( $(VERDIR)objects.list) @@\
-else @@\
- @@\
-$(VERDIR)objects.list:: $(foreach dir,dirs,$(dir)/Makefile) @@\
- @@\
-$(VERDIR)objects.list:: $($(VEROBJS)) Makefile \ @@\
- $(foreach dir,dirs,$(dir)/$(VERDIR)objects.list) @@\
- @if NOT "$(VERSION)" == "" if NOT EXIST $(VERSION)\NUL mkdir $(VERSION) @@\
- RemoveFile($@) @@\
- $(MAKE) MAKEOBJECTLIST=1 VERSION=$(VERSION) $(VERDIR)objects.list @@\
- if NOT Quote($(firstword dirs)) == "" \ @@\
- for %d in ( Win32Path(dirs) ) do \ @@\
- ( pushd %d & \ @@\
- SedCmd -e "\=^[^\\]=s=^.=%d\\&=" $@ >> Win32Path( ../$@ ) & \ @@\
- popd) @@\
- @@\
-$(foreach dir,dirs,$(dir)/$(VERDIR)objects.list):: @@\
- @ echo checking $(CURRENT_DIR)/FirstDir($@) @@\
- @ $(MAKE) -C FirstDir($@) VERSION=$(VERSION) \ @@\
- $(VERDIR)objects.list @@\
-endif
-
-/* --------------------------------------------------------------------- */
-
-#define SubdirLibraryObjects2(dirs) @@\
-$(foreach ver,Libversions,$(ver)/objects.list):: \ @@\
- $(foreach dir,dirs,$(dir)/Makefile) @@\
- @@\
-define build-object-list @@\
-if NOT Quote($(@D))=="" if NOT EXIST Win32Path($(@D))NUL mkdir Win32Path($(patsubst %/,%,$(@D))) @@\
- at RemoveFile($@) @@\
-if NOT $(QUOTE)$(strip $(word 1,$($(patsubst %/,%,$(@D))_OBJS)))$(QUOTE) == "" \ @@\
-for %f in (Win32Path($($(patsubst %/,%,$(@D))_OBJS))) do echo %f >> Win32Path($@) @@\
- at if NOT $(QUOTE)$(strip $(firstword dirs))$(QUOTE) == "" \ @@\
- for %d in ( Win32Path(dirs) ) do \ @@\
- ( pushd %d & \ @@\
- SedCmd -e "\=^[^\\]=s=^.=%d\\&=" Win32Path($@) >> Win32Path( ../$@ ) & \ @@\
- popd ) @@\
-endef @@\
- @@\
-ifeq ($(strip $(VERSION)),archive) @@\
-archive/objects.list:: Makefile $(archive_OBJS) \ @@\
- $(foreach dir,dirs,$(dir)/archive/objects.list) @@\
- $(build-object-list) @@\
- @@\
-else @@\
-archive/objects.list:: @@\
- $(MAKE) VERSION=archive archive/objects.list @@\
- @@\
-endif @@\
-debug/objects.list:: Makefile $(debug_OBJS) \ @@\
- $(foreach dir,dirs,$(dir)/debug/objects.list) @@\
- $(build-object-list) @@\
- @@\
-shared/objects.list:: Makefile $(shared_OBJS) \ @@\
- $(foreach dir,dirs,$(dir)/shared/objects.list) @@\
- $(build-object-list) @@\
- @@\
-$(foreach dir,dirs,$(foreach ver,Libversions,$(dir)/$(ver)/objects.list))::@@\
- @ echo checking $(CURRENT_DIR)/FirstDir($@) @@\
- @ $(MAKE) -C FirstDir($@) VERSION=$(filter Libversions,$(subst /, ,$@)) \ @@\
- $(patsubst FirstDir($@)/%,%,$@)
-
diff --git a/src/config/Win32.cf b/src/config/Win32.cf
deleted file mode 100644
index 906b269..0000000
--- a/src/config/Win32.cf
+++ /dev/null
@@ -1,329 +0,0 @@
-/* $Id: Win32.cf,v 1.8 1999/05/07 16:09:39 mclareni Exp $
- *
- * CERNLIB_MSSTDCALL cpp flag has been introduced
- *
- * $Log: Win32.cf,v $
- * Revision 1.8 1999/05/07 16:09:39 mclareni
- * A cleanup of the compiler options. In particular, remove -D_NTSDK which stopped
- * cfstati.c working. Our tests and PAW work.
- *
- * Revision 1.7 1997/11/06 14:10:19 mclareni
- * Separate C optimisation from default options
- *
- * Revision 1.5 1997/09/01 15:52:28 mclareni
- * More NT corrections
- *
- * Revision 1.4 1997/07/15 17:44:34 mclareni
- * Nenads mods for Digital Fortran DF90 and Intel Fortran
- *
- * Revision 1.3 1997/04/22 14:13:22 mclareni
- * Change OptimisedFortranFlags from O2 to Ox for Microsoft Fortran
- *
- * Revision 1.2 1997/02/28 10:36:53 gunter
- * usable version, many mods
- *
- * Revision 1.1.1.1 1995/12/20 15:26:45 cernlib
- * X11R6 config files unmodified
- *
- *
- */
-XCOMM platform: $XConsortium: Win32.cf,v 1.38 94/04/01 19:58:56 kaleb Exp $
-
-#define IntelCPUFamily Pentium
-
-#define OSName Microsoft Windows NT 4.0
-XCOMM operating system: OSName
-#define OSMajorVersion 4
-#define OSMinorVersion 0
-#define OSteenyVersion 0
-
-#ifndef PCHostArchitecture
-#define PCHostArchitecture Intel
-#endif
-
-#define BootstrapCFlags -DWIN32
-
-#define CPUType PCHostArchitecture
-#if PCHostArchitecture==Intel
-# define CpuDefines -D_X86_=1
-/*# define CPUType i386*/
-# ifndef IntelCPUFamily
-# define IntelCPUFamily i386
-# endif
-# if IntelCPUFamily==i386
-# define CCCPUOptimization -G5
-# elif IntelCPUFamily==i486
-# define CCCPUOptimization -G4
-# elif IntelCPUFamily==Pentium
-# define CCCPUOptimization -G5
-# elif IntelCPUFamily==PentiumPro
-# define CCCPUOptimization -G6
-#else
-# undef CCCPUOptimization
-#endif
-#elif PCHostArchitecture==ALPHA
-# define CpuDefines -D_ALPHA_=1
-#elif PCHostArchitecture==MIPS
-# define CpuDefines -D_MIPS_=1
-#else
-# undef CpuDefines
-#endif
-
-CPU = i386
-/* !include <ntwin32.mak> */
-/* --- Some flags from Microsoft Win32.Mak file */
-TARGETOS=BOTH
-
-/* binary declarations common to all platforms */
-#ifdef _IRC_
-cc = icl
-#else
-cc = cl
-#endif
-rc = rc
-link = link
-implib = lib
-hc = hcrtf -x
-
-/* declarations common to all compiler options
-ccommon = -D_NTSDK */
-
-ifeq "$(CPU)" "i386"
-vc_cflags = $(ccommon) CpuDefines -DVISUAL_CPLUSPLUS
-scall = -Gz
-endif
-
-APPVER = 4.0
-
-ifeq "$(APPVER)" "4.0"
-vc_cflags := $(vc_cflags)
-else
-ifeq "$(APPVER)" == "3.51"
-vc_cflags := $(vc_cflags) -DWINVER=0x0400
-else
-vc_cflags := $(vc_cflags) -DWINVER=0x030A
-endif
-endif
-
-
-ifdef NO_ANSI
-noansi = -DNULL=0
-endif
-
-/* for Windows applications that use the C Run-Time libraries */
-cvars = -DWIN32 $(noansi) -D_WIN32
-cvarsmt = $(cvars) -D_MT
-cvarsdll = $(cvarsmt) -D_DLL
-
-/* for compatibility with older-style makefiles */
-cvarsmtdll = $(cvarsmt) -D_DLL
-
-/* for POSIX applications */
-psxvars = -D_POSIX_
-
-/* resource compiler */
-rcflags = /r
-rcvars = -DWIN32 $(noansi)
-
-ifeq "$(APPVER)" "4.0"
-rcvars := $(rcvars) -DWINVER=0x0400
-else
-rcvars := $(rcvars) -DWINVER=0x030A
-endif
-
-
-/* These CRT Libraries assume the use of Microsoft Visual C++ 2.0 on */
-/* x86 and MIPS platforms. If you are using another Compiler product, */
-/* change the libc* variable to correspond to your import library names.*/
-
-ifeq ("$(CPU)","PPC")
-libc = libc.lib
-libcmt = libcmt.lib
-libcdll = crtdll.lib
-
-/* for POSIX applications */
-psxlibs = libcpsx.lib psxdll.lib psxrtl.lib
-
-else
-libc = libc.lib oldnames.lib
-libcmt = libcmt.lib oldnames.lib
-libcdll = msvcrt.lib oldnames.lib
-
-/* for POSIX applications */
-psxlibs = libcpsx.lib psxdll.lib psxrtl.lib oldnames.lib
-
-endif
-
-/* optional profiling and tuning libraries */
-ifdef PROFILE
-optlibs = cap.lib
-else
-ifdef TUNE
-optlibs = wst.lib
-else
-optlibs =
-endif
-endif
-
-/* The PPC compiler currently requires a library for 64-bit integers. */
-ifeq ("$(CPU)","PPC")
-int64lib = int64.lib
-else
-int64lib =
-endif
-
-
-/* basic subsystem specific libraries, less the C Run-Time */
-baselibs = kernel32.lib $(optlibs) advapi32.lib
-winlibs = $(baselibs) user32.lib gdi32.lib comdlg32.lib winspool.lib
-
-/* for Windows applications that use the C Run-Time libraries */
-conlibs = $(libc) $(baselibs)
-conlibsmt = $(libcmt) $(baselibs)
-conlibsdll = $(libcdll) $(baselibs)
-guilibs = $(libc) $(winlibs)
-guilibsmt = $(libcmt) $(winlibs)
-guilibsdll = $(libcdll) $(winlibs)
-
-/* ----- end Win3.mak file ------ */
-/* =============================== */
-
-/* brain-damaged windows headers will not compile with -Za */
-#define StandardDefines $(cvars) CpuDefines
-/* #define DefaultCCOptions -nologo -batch -G4 -W2 */
-#define DefaultCCOptions -nologo CCCPUOptimization /Zd $(vc_cflags) -W2
-#define StandardIncludes -I$(subst ;, -I,$(Include)) -I.\
-
-#define PathSeparator $(subst u,\,u) /* strange way to get one '\' */
-
-#define Win32Path(path) $(subst /,\,path)
-#define OptimizedCDebugFlags /O1
-#define NoOpCDebugFlags /Od
-#define DebuggableCDebugFlags $(cdebug)
-#define DefaultCDebugFlags OptimizedCDebugFlags
-
-#define ThreadedX YES
-#define CpCmd copy
-#define LnCmd copy
-#define MvCmd ren
-#define RmCmd del
-/* if you do not have deltree, substitute rd /s and suffer the prompts */
-#define RmTreeCmd rmdir /S
-#define CcCmd $(cc)
-#define HasCplusplus YES
-#define CplusplusCmd $(cc)
-#define PreProcessCmd CcCmd -nologo /C -EP
-#define CppCmd CcCmd -nologo /C -E
-#define FortranCppCmd PreProcessCmd
-#define PatheticCpp YES
-#define ArCmdBase lib
-#define ArCmd ArCmdBase
-#define CplusplusCmd $(cc)
-#define MkdirHierCmd mkdir
-#define InstallCmd copy
-#define InstPgmFlags /**/
-#define InstBinFlags /**/
-#define InstUidFlags /**/
-#define InstLibFlags /**/
-#define InstIncFlags /**/
-#define InstManFlags /**/
-#define InstDatFlags /**/
-#define InstallFlags /**/
-/* #define ExtraLibraries $(conlibs) $(conlibsdll) wsock32.lib */
-#define ExtraLibraries wsock32.lib
-
-#ifndef NMAKE
-#define MakeCmd make
-#else
-#define MakeCmd nmake
-#endif
-
-#define LdCmd $(link)
-#define MathLibrary
-#define HasSymLinks NO
-#define HasPutenv YES
-
-#define Osuf obj
-#define SetWin32ObjSuffix(objfilename) $(patsubst %.o,%.Osuf,objfilename)
-
-#define BuildServer NO
-#define ConnectionFlags -DTCPCONN
-#define StdIncDir /msdev/include
-#define LdPreLib /**/
-#define LdPostLib /**/
-#ifndef UseInstalled
-#define ImakeCmd $(IMAKESRC:/=\)\imake
-#define DependCmd $(DEPENDSRC:/=\)\makedepend
-#endif
-#define FilesToClean *.bak *.obj *.lib make.log
-#define ShLibDir $(BINDIR)
-
-#define ThreadsCompileFlags -D_MT
-
-#define ThreadsCplusplusCompileFlags ThreadsCompileFlags
-/* #define ExtraLoadFlags -link */
-
-#define HasFortran YES
-#define FortranDoesCpp NO
-
-#define XFileSearchPathBase Concat4($(LIBDIR)/;L/;T/;N;C,;S:$(LIBDIR)/;l/;T/;N;C,;S:$(LIBDIR)/;T/;N;C,;S:$(LIBDIR)/;L/;T/;N;S:$(LIBDIR)/;l/;T/;N;S:$(LIBDIR)/;T/;N;S)
-
-#define BuildFonts NO
-#define BuildFresco NO
-#define XawI18nDefines -DHAS_WCHAR_H
-
-#ifdef _DF90_
-/* f77 DEC driver default options :
- -fpconstants -optimize=4 -altparam -intconstant /assume:byterecl
- */
-# define DefaultFCOptions CCCPUOptimization /Zd /nologo /4Nportlib
-# define OptimisedFortranFlags -Ox
-# define NoOpFortranDebugFlags -Od
-
-/*
- # define DefaultFCOptions CCCPUOptimization /nologo /4Nportlib /GNl /iface:nomixed_str_len_arg /iface:cref
- # define OptimisedFortranFlags /Zd /Ox /fast /fpe:3
- /optimize:0 /iface:nomixed_str_len_arg /fpe:0
- /recursive
-*/
-# define CernlibSystem -DCERNLIB_WINNT -DCERNLIB_UNIX -DCERNLIB_MSSTDCALL -DCERNLIB_QFMSOFT
-/* -CERNLIB_QFDEC -DCERNLIB_QXNO_SC -DCERNLIB_NOQUAD 13.08.97 vf */
-#elif _IRC_
-# define DefaultFCOptions CCCPUOptimization /nologo /4Nportlib
-# define OptimisedFortranFlags -Ox
-# define CernlibSystem -DCERNLIB_WINNT -DCERNLIB_UNIX -DCERNLIB_QFMSOFT
-# define CERNLIB_QFMSOFT
-#else
-# define DefaultFCOptions CCCPUOptimization /Zd /nologo /4Nportlib
-
-/* # define OptimisedFortranFlags /Zd -Ox 13.08.97 vf */
-# define OptimisedFortranFlags /Ox
- /* flags to turn on debugging info This must be /Zd !!! */
-# define DebuggableFortranDebugFlags -Zi
- /* flags NOT to turn on optimisation or debug*/
-# define NoOpFortranDebugFlags /Od
- /* CERNLIB options */
-# define CernlibSystem -DCERNLIB_WINNT -DCERNLIB_UNIX -DCERNLIB_QFMSOFT -DCERNLIB_MSSTDCALL
-# define CERNLIB_QFMSOFT
-# define CERNLIB_MSSTDCALL
-#endif
-
-#define CERNLIB_F90
-#define CERNLIB_WINNT
-#define CERNLIB_UNIX
-
-
-colon=:
-indirectfile=@
-
-#ifdef UseXargs
-#undef UseXargs
-#endif
-
-#ifdef CERNLIB_SHIFT
-#undef CERNLIB_SHIFT
-#endif
-
-#define UseXargs NO
-#define X11Includes
-
diff --git a/src/config/Win32.fortran.rules b/src/config/Win32.fortran.rules
deleted file mode 100644
index 02db362..0000000
--- a/src/config/Win32.fortran.rules
+++ /dev/null
@@ -1,223 +0,0 @@
-/*
- * This file defines:
- *
- * - FortranCmd
- * - FortranFlags
- * - FortranDebugFlags
- * - Fsuf
- * - FsufF
- * - FortranTargetName(fortranname)
- * - FortranTargetNameSuffix(fortranname,suffix)
- * - FortranDoesCpp
- * - FortranLinkRule(program,options,objects,libraries)
- * - NormalFortranProgramTarget(program,objects,deplibs,locallibs,syslibs)
- * - SimpleFortranProgramTarget(program)
- * - ComplexFortranProgramTarget(program)
- * - MakeFortranSource(src,dst)
- * - ObjectFortranCompile(options)
- * - SetLibraryTargetDir(dirs,libname)
- * - CreateNormalLibrary(libname,objs)
- * -
- * -
- * -
- * -
- * -
- * ==========
- * #include <fortran.rules>
- */
-
-/*
- * Concat - concatenates two strings.
- */
-#ifndef Concat
-#if (__STDC__ && !defined(UnixCpp)) || defined(AnsiCpp)
-#define Concat(a,b)a##b
-#else
-#define Concat(a,b)a/**/b
-#endif
-#endif
-
-#ifdef _DF90_
-# define FortranCmd f77
-# elif _IRC_
-# define FortranCmd ifl
-# else
-# define FortranCmd fl32
-#endif
-
-#define CernlibFCDefines CpuDefines
-
-# define FortranFlags $(FFLAGS)
-/*
- *# define FortranDebugFlags $(fdebugflags)
- */
-
-lib = lib
-/*
- * Define a suffix for the Fortran compiler
- */
-#ifndef Fsuf
-#define Fsuf F
-#endif
-
-#ifdef fsuf
-# undef fsuf
-#endif
-
-#define FsufF for
-#define fsuf FsufF
-
-#define FortranTargetName(fortranname)fortranname.FsufF
-
-#define FortranTargetNameSuffix(fortranname,suffix)Concat(fortranname,suffix.FsufF)
-
-#define FortranDoesCpp NO
-
-#ifdef LibObjCompile
-# undef LibObjCompile
-#endif
-
-#ifndef LibObjCompile
-#define LibObjCompile(dir,options) RemoveFile($@) @@\
- $(CC) -c options $(CCOPTIONS) $(ALLDEFINES) Win32Path(Concat(-Fo,$@)) Win32Path($<)
-/* $(CC) -c options $(CCOPTIONS) $(ALLDEFINES) Win32Path(Concat(-Fo,$@)) Win32Path(Concat(-Fd,$(TOP)$(PACKAGETOP)$(PACKAGE_NAME))) Win32Path($<) */
-#endif
-
-/*
- * create a list of dependency libraries for libraries from cernlib
- *
- */
-#ifndef CernlibDependLibrary
-#define CernlibDependLibrary(cernlibs) /* void */
-#endif
-
-/* Helper top use cernlb command
- */
-#ifndef CernlibCmd
-#define CernlibCmd(libraries)libraries
-#endif
-
-#ifndef CernlibFortranLinkRule
-#define CernlibFortranLinkRule(pgm,ldoptions,objs,libs,cernlibs)\
- @cernlib cernlibs @@\
- FortranLinkRule(pgm,ldoptions,objs,libs @cernlib)
-#endif
-
-
-
-#define FortranLinkRule(program,options,objects,libraries) \
- $(FCLINK) Win32Path(Concat(-Fe,program)) options Win32Path(SetWin32ObjSuffix(objects)) Win32Path(libraries) $(FC_EXTRA_LOAD_FLAGS)
-
-#define NormalFortranProgramTarget(program,objects,deplibs,locallibs,syslibs)\ @@\
-XVARdef0 = objects @@\
- @@\
-ProgramTargetName(program): SetWin32ObjSuffix($(XVARuse0)) deplibs @@\
- RemoveTargetProgram($@) @@\
- FortranLinkRule($@,$(FCLDOPTIONS),SetWin32ObjSuffix($(XVARuse0)),locallibs syslibs) @@\
- @@\
-clean:: @@\
- RemoveFile(ProgramTargetName(program))
-
-/* FortranLinkRule($@,$(FCLDOPTIONS),$(XVARuse0:.o=.obj),locallibs $(LDLIBS) syslibs) */
-/* NormalFortranProgramTarget */
-
-#ifdef MS_NMAKE
-#define SimpleFortranProgramTarget(program) @@\
-OBJS = program.Osuf @@\
-SRCS = program.Fsuf @@\
- @@\
-ComplexFortranProgramTarget(program)
-#endif
-/* SimpleFortranProgramTarget */
-
-
-#ifdef MS_NMAKE
-#define ComplexFortranProgramTarget(program) @@\
-PROGRAM = ProgramTargetName(program) @@\
- @@\
-AllTarget(ProgramTargetName(program)) @@\
- @@\
-FortranProgramTargetHelper(program,SRCS,OBJS,DEPLIBS,$(LOCAL_LIBRARIES),NullParameter) @@\
- @@\
-DependTarget() @@\
- @@\
-clean:: @@\
- RemoveFile($(PROGRAM))
-#endif /* MS_NMAKE */
-
-/*
- * MakeFortranSource(src,dst) - apply either Cpp or a simple copy
- * command to create a "real" Fortran file
- * when "native" Fortran has a lack of CPP features
- * and/or treats another file-extension.
- */
-#ifndef MakeFortranSource
-#if !FortranDoesCpp
-#define MakeFortranSource(src,dst) RemoveFiles(dst) @@\
- $(FPP) $(FORTRANALLDEFINES) Win32Path(Concat(-Tc,src)) >Win32Path(dst)
-#endif
-#endif
-
-
-/* -------------- Start of the rule RunFortranCompile ----------------- */
-#define RunFortranCompile(options,source)\
- $(FC) -c options Win32Path(Concat(-Fo,$@)) Win32Path(Concat(-Tf,source))
-
-/* It is old rule to compile with PDB */
-/* $(FC) -c options Win32Path(Concat(-Fo,$@)) Win32Path(Concat(-Tf,source)) \ @@\ */
-/* Win32Path(Concat(-Fd,$(TOP)$(PACKAGETOP)$(PACKAGE_NAME))) */
-
-/* -------------- End of the rule RunFortranCompile ----------------- */
-
-#define NormalFortranObjectRule() CppFortranObjectRule()
-
-#define SetLibraryTargetDir(dirs,libname) @@\
-dirs:: @@\
- @@\
-library:: dirs @@\
- !$(MAKE) $(MFLAG) LIBRARY_NAME=libname library -f Concat3($**,\,Makefile) @@\
-
-#define CreateNormalLibrary(libname,objs) @@\
-XVARdef0 = objs @@\
- @@\
-LibraryTargetName(libname):: /* Here is empty rules to keep the "make" happy */ @@\
- @@\
-library:: SetWin32ObjSuffix($(XVARuse0) @@\
- MakeLibrary(LibraryTargetName(libname),$**) @@\
- @@\
-clean:: @@\
- RemoveFile(LibraryTargetName(libname))
-
-#define MakeDepend(dir,flags)\
- if not exist Win32Path(dir)\NUL mkdir Win32Path(dir) @@\
- @echo.> $@ @@\
- $(DEPEND) -f$@ -M -p dir/ -- flags $<
-
-
-/*
- * CernlibCcProgramTarget - rule to link program using
- * cernlib utility to find give all required libraries ( ie. no extra
- * syslibs needed.
- */
-#ifndef CernlibCcProgramTarget
-#define CernlibCcProgramTarget(program,objects,deplibs,locallibs,cernlibs)\
-Concat(program,_deplibs)=@cernlib @@\
- @@\
-ProgramTargetName(program): objects deplibs $(Concat(program,_deplibs)) @@\
- RemoveTargetProgram($@) @@\
- @echo "Linking with cern libraries" @@\
- @cernlib cernlibs @@\
- CernlibLinkRule($@,$(LDOPTIONS),objects,locallibs $(LDLIBS),cernlib cernlibs) @@\
- @@\
-clean:: @@\
- RemoveFile(ProgramTargetName(program)) @@\
-
-#endif /*CernlibCcProgramTarget */
-
-
-#include <fortran.rules>
-
-
-
-
-
diff --git a/src/config/Win32.rules b/src/config/Win32.rules
deleted file mode 100644
index 68f98c2..0000000
--- a/src/config/Win32.rules
+++ /dev/null
@@ -1,485 +0,0 @@
-XCOMM platform: $XConsortium: Win32.rules,v 1.40 94/03/28 17:11:24 matt Exp $
-/*
- ****************************************************************
- * The followind line MUST be deleted after all:
-
- -I\\Misf58\users\cernlib\config \ @@\
- ****************************************************************
- */
-#define HasSharedLibraries YES
-#define NeedLibInsideFlag YES
-#define SharedLibXaw NO
-#define SharedLibXmu NO
-#define SharedLibXt NO
-#define SharedDataSeparation NO
-#define SharedCodeDef /**/
-#define SharedLibraryDef /**/
-#define ShLibIncludeFile <WinLib.tmpl>
-#define SharedLibraryLoadFlags -dll
-#define PositionIndependentCFlags /**/
-#define BourneShell cmd
-/* #define BourneShell c:/hamilton/bin/csh -c */
-/* LDOPTIONS = $(CDEBUGFLAGS) $(CCOPTIONS) $(EXTRA_LDOPTIONS) $(THREADS_LDFLAGS) $(LOCAL_LDFLAGS) $(LDPRELIB) */
-/* LDOPTIONS = $(CDEBUGFLAGS) $(EXTRA_LDOPTIONS) $(THREADS_LDFLAGS) $(LOCAL_LDFLAGS) $(LDPRELIB) */
-
-.c.obj:
- $(CC) -c Win32Path($<) $(CFLAGS)
-
-#if HasCplusplus
-.CCsuf.obj:
- $(CXX) -c Win32Path($<) $(CFLAGS)
-#endif
-
-.F.Osuf:
-
-
-#define ProgramTargetName(target)target.exe
-
-#define RunProgram(progvar,options) Win32Path(progvar) options
-
-#define RemoveFile(file) (if exist Win32Path(file) $(RM) Win32Path(file))
-
-#define MoveFile(file1,file2) (RemoveFile(file2) & CpCmd Win32Path(file1) Win32Path(file2) & RemoveFile(file1))
-
-#define RemoveFiles(files) \
- for %F in ( Win32Path(files) ) do RemoveFile(%F)
-
-#define MakeDir(dir) -$(MKDIRHIER) Win32Path(dir)
-
-#define LibObjCompile(dir,options) @@\
- RemoveFiles($@ dir\$@) @@\
- $(CC) -c $(CCOPTIONS) $(ALLDEFINES) options Win32Path($*.c) @@\
- $(MV) Win32Path($@) Win32Path(dir\$@)
-
-#define BuildIncludesTop(srclist,dstsubdir,dstupdir) @@\
-includes:: @@\
- MakeDir($(BUILDINCDIR)) @@\
- @(pushd Win32Path($(BUILDINCDIR)) & for %i in ( Win32Path(srclist) ) do \ @@\
- RemoveFile(%i) & \ @@\
- $(LN) Win32Path($(BUILDINCTOP)$(CURRENT_DIR)%i) . & \ @@\
- popd)
-
-#define BuildIncludes(srclist,dstsubdir,dstupdir) @@\
-includes:: @@\
- MakeDir($(BUILDINCDIR)\dstsubdir) @@\
- @( pushd Win32Path($(BUILDINCDIR)dstsubdir) & for %i in ( Win32Path(srclist) ) do \ @@\
- RemoveFile(%i) & \ @@\
- $(LN) Win32Path($(BUILDINCTOP)dstupdir$(CURRENT_DIR)%i) . & \ @@\
- popd @@\
- )
-
-#define LinkFileList(step,list,dir,sub) @@\
-step:: list @@\
- rem @case '${MFLAGS}' in *[i]*) set +e;; esac; & \ @@\
- echo " pushd" dir & pushd Win32Path(dir) & \ @@\
- for %i in ( Win32Path(list) ) do (rem set -x || (RemoveFile(%i)) && $(LN) Win32Path(sub%i) .)
-
-#define LinkRule(program,options,objects,libraries) \
-$(CCLINK) Concat(-Fe,program) options objects libraries $(EXTRA_LOAD_FLAGS)
-
-#define NormalProgramTarget(program,objects,deplibs,locallibs,syslibs) @@\
- @@\
-ProgramTargetName(program): SetWin32ObjSuffix(objects) deplibs @@\
- RemoveTargetProgram($@) @@\
- LinkRule($@,$(LDOPTIONS),SetWin32ObjSuffix(objects),locallibs $(LDLIBS) syslibs) @@\
- @@\
-clean:: @@\
- RemoveFile(ProgramTargetName(program))
-
-#define ProgramTargetHelper(program,srcs,objs,deplib,locallib,syslib) @@\
-ProgramTargetName(program): SetWin32ObjSuffix(objs) $(deplib) @@\
- RemoveTargetProgram($@) @@\
- LinkRule($@,$(LDOPTIONS),SetWin32ObjSuffix(objs),locallib $(LDLIBS) syslib) @@\
- @@\
-InstallProgram(program,$(BINDIR)) @@\
-InstallManPage(program,$(MANDIR))
-
-#define ComplexProgramTarget(program) @@\
-PROGRAM = ProgramTargetName(program) @@\
- @@\
-AllTarget(ProgramTargetName(program)) @@\
- @@\
-ProgramTargetHelper(program,SRCS,OBJS,DEPLIBS,$(LOCAL_LIBRARIES),NullParameter) @@\
- @@\
-DependTarget() @@\
-LintTarget() @@\
- @@\
-clean:: @@\
- RemoveFile($(PROGRAM))
-
-#define ComplexProgramTarget_1(program,locallib,syslib) @@\
-OBJS = $(OBJS1) $(OBJS2) $(OBJS3) @@\
-SRCS = $(SRCS1) $(SRCS2) $(SRCS3) @@\
-PROGRAM1 = ProgramTargetName(program) @@\
- @@\
-AllTarget($(PROGRAM1) $(PROGRAM2) $(PROGRAM3)) @@\
- @@\
-ProgramTargetHelper(program,SRCS1,OBJS1,DEPLIBS1,locallib,syslib) @@\
- @@\
-DependTarget() @@\
-LintTarget() @@\
- @@\
-clean:: @@\
- for %i in ($(PROGRAMS)) do $(RM) ProgramTargetName(%i)
-
-#define ComplexProgramTarget_2(program,locallib,syslib) @@\
-PROGRAM2 = ProgramTargetName(program) @@\
- @@\
-ProgramTargetHelper(program,SRCS2,OBJS2,DEPLIBS2,locallib,syslib)
-
-#define ComplexProgramTarget_3(program,locallib,syslib) @@\
-PROGRAM3 = ProgramTargetName(program) @@\
- @@\
-ProgramTargetHelper(program,SRCS3,OBJS3,DEPLIBS3,locallib,syslib)
-
-#define MoveToBakFile(file) - at if exist Win32Path(file) $(MV) Win32Path(file) Win32Path(file.bak)
-
-#define RMoveToBakFile(file) -RemoveFile(file.bak) @@\
- MoveToBakFile(file)
-
-#define InstallMultipleDestFlags(step,list,dest,flags) @@\
-XVARdef0 = Win32Path($(DESTDIR)dest) @@\
- @@\
-step:: list @@\
- MakeDir($(XVARuse0)) @@\
- for %i in ( Win32Path(list) ) do \ @@\
- (rem set -x & $(INSTALL) $(INSTALLFLAGS) flags %i $(XVARuse0)) \ @@\
-
-#define CleanTarget() @@\
-clean:: @@\
- RemoveFiles(FilesToClean ExtraFilesToClean)
-
-#define LibraryTargetName(libname)libname.lib
-
-#define LibraryTargetNameSuffix(libname,suffix)Concat(libname,suffix.lib)
-
-#define MakeLibrary(libname,objlist) \
- ( echo Creating libname & \ @@\
- (if exist Win32Path(libname) $(AR) -nologo -out$(colon)Win32Path(libname) Win32Path(libname) Win32Path(objlist) > NUL) & \ @@\
- (if not exist Win32Path(libname) $(AR) -nologo -out$(colon)Win32Path(libname) Win32Path(objlist) > NUL) )
-
-#define LinkSourceFile(src,dir) @@\
-XVARdef0 = Concat(dir,src) @@\
- @@\
-src: $(XVARuse0) @@\
- RemoveFile($@) @@\
- $(LN) Win32Path($? $@) @@\
- @@\
-includes:: src @@\
- @@\
-depends:: src @@\
- @@\
-clean:: @@\
- RemoveFile(src)
-
-#define LinkFile(tofile,fromfile) @@\
-tofile:: fromfile @@\
- RemoveFile($@) @@\
- $(LN) Win32PAth($? $@) @@\
- @@\
-includes:: tofile @@\
- @@\
-depend:: tofile @@\
- @@\
-clean:: @@\
- RemoveFile(tofile)
-
-
-#define NormalLibraryTarget(libname,objlist) @@\
-AllTarget(LibraryTargetName(libname)) @@\
- @@\
-XVARdef0 = objlist @@\
- @@\
-LibraryTargetName(libname): SetWin32ObjSuffix(objlist) @@\
- RemoveFile($@) @@\
- MakeLibrary($@,SetWin32ObjSuffix(objlist))
-
-#define NormalLibraryTarget2(libname,objlist1,objlist2) @@\
-NormalLibraryTarget(libname,objlist1 objlist2)
-
-#define NormalLibraryTarget3(libname,objlist1,objlist2,objlist3) @@\
-NormalLibraryTarget(libname,objlist1 objlist2 objlist3)
-
-#define NormalDepLibraryTarget(libname,deplist,objlist) @@\
-AllTarget(LibraryTargetName(libname)) @@\
- @@\
-XVARdef0 = deplist @@\
-XVARdef1 = objlist @@\
-XVARdef2 = Win32Path(XVARuse1) @@\
- @@\
-LibraryTargetName(libname): $(XVARuse0) @@\
- RemoveFile($@) @@\
- MakeLibrary($@,SetWin32ObjSuffix($(XVARuse2)))
-
-#define ProfiledLibraryTarget(libname,objlist) @@\
-AllTarget(LibraryTargetNameSuffix(libname,_p)) @@\
- @@\
-XVARdef0 = objlist @@\
- @@\
-LibraryTargetNameSuffix(libname,_p): SetWin32ObjSuffix($(XVARuse0)) @@\
- RemoveFile($@) @@\
- pushd profiled @@\
- MakeLibrary(..\$@,SetWin32ObjSuffix($(XVARuse0))) @@\
- popd
-
-#define DebuggedLibraryTarget(libname,objlist) @@\
-AllTarget(LibraryTargetNameSuffix(libname,_d)) @@\
- @@\
-XVARdef0 = objlist @@\
- @@\
-LibraryTargetNameSuffix(libname,_d): SetWin32ObjSuffix($(XVARuse0)) @@\
- RemoveFile($@) @@\
- ( pushd debugger & \ @@\
- MakeLibrary(..\$@,SetWin32ObjSuffix($(XVARuse0))) & \ @@\
- popd )
-
-#ifndef UseInstalled
-#define ImakeDependency(target) @@\
-target:: ProgramTargetName($(IMAKE)) @@\
- @@\
-ProgramTargetName($(IMAKE)): @@\
- pushd Win32Path($(IMAKESRC)) @@\
- if exist Makefile $(MAKE) all @@\
- if not exist Makefile $(MAKE) -f Makefile.ini BOOTSTRAPCFLAGS="$(BOOTSTRAPCFLAGS)" @@\
- popd @@\
-#define ImakeDependency(target)
-#endif
-
-#ifndef UseInstalled
-#define DependDependency() @@\
-depend:: ProgramTargetName($(DEPEND)) @@\
- @@\
-ProgramTargetName($(DEPEND)): @@\
- pushd Win32Path($(DEPENDSRC)) @@\
- $(MAKE) @@\
- popd
-#endif
-
-#define DependTarget() @@\
-DependDependency() @@\
- @@\
-depend:: @@\
- Win32Path($(DEPEND)) $(DEPENDFLAGS) -- $(ALLDEFINES) $(DEPEND_DEFINES) -- $(SRCS)
-
-#define DependTarget3(srcs1,srcs2,srcs3) @@\
-DependDependency() @@\
- @@\
-depend:: @@\
- Win32Path($(DEPEND)) $(DEPENDFLAGS) -- $(ALLDEFINES) $(DEPEND_DEFINES) -- srcs1 srcs2 srcs3
-
-#define ForceSubdirs(dirs) @@\
-Avoid.Error dirs: FRC @@\
- @pushd Win32Path($@) @@\
- @echo making all in Win32Path($(CURRENT_DIR)$@)... @@\
- $(MAKE) $(MFLAGS) PassCDebugFlags all @@\
- popd @@\
- @@\
-FRC:
-
-#define MakeMakeSubdirs(dirs,target) @@\
-XVARdef0 = dirs @@\
-XVARdef1 = $$ @@\
- @@\
-target:: @@\
- @$(MAKE) $(MFLAGS) -f
-
-
-#ifndef UseInstalled
-#define ImakeSubCmdHelper ..\$(IMAKE) -I..\$(IRULESRC) $(IMAKE_DEFINES)
-#else
-#define ImakeSubCmdHelper $(IMAKE_CMD)
-#endif
-
-/*
- * MakeSubdirMakefile - rule to create subdirectory/Makefile, one at a time
- */
-#ifdef _DF90_
-#define MakeSubdirMakefile(dirs) @@\
-%/Makefile: %/Imakefile @@\
- if not exist Win32Path($(dir $@)NUL) md Win32Path($(dir $@)) @@\
- ( pushd Win32Path($(dir $@)) & \ @@\
- RemoveFile(Makefile) & \ @@\
- ImakeSubCmdHelper -D_DF90_ -DTOPDIR=$(TOP) \ @@\
- -DCURDIR=$(CURRENT_DIR)/$(patsubst %/,%,$(dir $@)) \ @@\
- -DPackageTop=$(PACKAGETOP) \ @@\
- -DPackageName=$(PACKAGE_NAME) \ @@\
- -f $< & \ @@\
- popd \ @@\
- )
-#elif _IRC_
-#define MakeSubdirMakefile(dirs) @@\
-%/Makefile: %/Imakefile @@\
- if not exist Win32Path($(dir $@)NUL) md Win32Path($(dir $@)) @@\
- ( pushd Win32Path($(dir $@)) & \ @@\
- RemoveFile(Makefile) & \ @@\
- ImakeSubCmdHelper -D_IRC_ -DTOPDIR=$(TOP) \ @@\
- -DCURDIR=$(CURRENT_DIR)/$(patsubst %/,%,$(dir $@)) \ @@\
- -DPackageTop=$(PACKAGETOP) \ @@\
- -DPackageName=$(PACKAGE_NAME) \ @@\
- -f $< & \ @@\
- popd \ @@\
- )
-#else
-#define MakeSubdirMakefile(dirs) @@\
-%/Makefile: %/Imakefile @@\
- if not exist Win32Path($(dir $@)NUL) md Win32Path($(dir $@)) @@\
- ( pushd Win32Path($(dir $@)) & \ @@\
- RemoveFile(Makefile) & \ @@\
- popd \ @@\
- ) & \ @@\
- ImakeSubCmdHelper -DTOPDIR=$(TOP) \ @@\
- -DCURDIR=$(CURRENT_DIR)/$(patsubst %/,%,$(dir $@)) \ @@\
- -DPackageTop=$(PACKAGETOP) \ @@\
- -DPackageName=$(PACKAGE_NAME) \ @@\
- -f $< -s $@
-#endif
-
-#define NamedTargetSubdirs(name,dirs,verb,flags,subname) @@\
-name:: $(foreach dir,dirs,$(dir)/Makefile) @@\
- @@\
-name:: @@\
- for %i in ( Win32Path(dirs) ) \ @@\
- do \ @@\
- (pushd %i & echo verb in Win32Path($(CURRENT_DIR)%i)... & \ @@\
- $(MAKE) $(MFLAGS) flags subname & \ @@\
- popd )
-
-#define UnsharedLibReferences(varname,libname,libsource) @@\
-Concat3(DEP,varname,LIB) = _UseCat($(USRLIBDIR)/,libsource/,libname.lib) @@\
-Concat(varname,LIB) = LoaderLibPrefix _Use(libname.lib,$(Concat3(DEP,varname,LIB))) @@\
-LintLibReferences(varname,libname,libsource)
-
-#define SharedLibReferences(varname,libname,libsource,revname,rev) @@\
-revname = rev @@\
-UnsharedLibReferences(varname,libname,libsource)
-
-#define SubdirLibraryRule(objlist) @@\
-XVARdef0 = objlist @@\
- @@\
-all:: DONE @@\
- @@\
-DONE: SetWin32ObjSuffix($(XVARuse0)) @@\
- RemoveFile($@) @@\
- echo - > $@ @@\
- @@\
-clean:: @@\
- RemoveFile(DONE)
-
-#define CppScriptTarget(dst,src,defs,deplist) @@\
-dst:: @@\
- @echo sorry, unable to make $@
-
-#define CppFileTarget(dst,src,defs,deplist) @@\
-XVARdef0 = src @@\
- @@\
-dst:: src deplist @@\
- RemoveFile($@) @@\
- $(PREPROCESSCMD) -I. defs Win32Path(Concat(-Tc,$(XVARuse0))) >$@ @@\
- @@\
-clean:: @@\
- RemoveFiles(dst)
-
-#define InstallNamedTarget(step,srcname,flags,dest,dstname) @@\
-XVARdef0 = $(DESTDIR)dest/ @@\
- @@\
-step:: srcname @@\
- MakeDir(Win32Path($(XVARuse0))) @@\
- $(INSTALL) $(INSTALLFLAGS) flags Win32Path(srcname) Win32Path($(XVARuse0)dstname)
-
-#define InstallLibrary(libname,dest) @@\
-InstallTarget(install,LibraryTargetName(libname),$(INSTLIBFLAGS),dest)
-
-#define InstallScript(program,dest) /**/
-
-#define InstallNamedProg(srcname,dstname,dest) @@\
-install:: srcname @@\
- @echo sorry, unable to make srcname
-
-#define InstallSharedLibrary(libname,rev,dest) @@\
-InstallTarget(install,LibraryTargetName(libname),$(INSTLIBFLAGS),$(USRLIBDIR)) @@\
-InstallTarget(install,libname.dll,$(INSTLIBFLAGS),dest)
-
-#define InstallSharedLibraryData(libname,rev,dest)
-
-#define MakeDLL(libname,solist) $(LD) SharedLibraryLoadFlags -out\:libname.dll libname.exp solist
-
-#define SharedLibraryTarget(libname,rev,solist,down,up) @@\
-AllTarget(libname.dll) @@\
- @@\
-CppFileTarget(libname.def,libname-def.cpp,-DLIBRARY_VERSION=rev,$(ICONFIGFILES)) @@\
- @@\
-XVARdef0 = solist @@\
- @@\
-LibraryTargetName(libname): SetWin32ObjSuffix(XVARuse0) libname.def @@\
- RemoveFile($@) @@\
- MakeLibrary($@,-def$(colon)libname.def SetWin32ObjSuffix($(XVARuse0))) @@\
- RemoveFile(libname.dll) @@\
- MakeDLL(libname,SetWin32ObjSuffix($(XVARuse0)) $(REQUIREDLIBS) $(EXTRA_LIBRARIES)) @@\
- @@\
-libname.dll: LibraryTargetName(libname) @@\
- RemoveFile(libname.dll) @@\
- MakeDLL(libname,SetWin32ObjSuffix($(XVARuse0)) $(REQUIREDLIBS) $(EXTRA_LIBRARIES)) @@\
- @@\
-clean:: @@\
- RemoveFile(LibraryTargetName(libname)) @@\
- RemoveFile(libname.dll)
-
-#define SharedLibraryDataTarget(libname,rev,salist)
-
-#define ObjectCplusplusCompile(options) RemoveFile($@) @@\
- $(CXX) -c Win32Path($*.CCsuf) $(CFLAGS) options
-
-
-#define CplusplusLinkRule LinkRule
-
-#define CplusplusProgramTargetHelper ProgramTargetHelper
-
-#ifndef ComplexCplusplusProgramTarget
-#define ComplexCplusplusProgramTarget(program) @@\
- PROGRAM = ProgramTargetName(program) @@\
- @@\
-AllTarget(ProgramTargetName(program)) @@\
- @@\
-CplusplusProgramTargetHelper(program,SRCS,OBJS,DEPLIBS,$(LOCAL_LIBRARIES),NullParameter) @@\
- @@\
-DependTarget() @@\
-LintTarget() @@\
- @@\
-clean:: @@\
- RemoveFile(ProgramTargetName(program))
-#endif /* ComplexCplusplusProgramTarget */
-
-/*
-#define MakeSubdirsMakefiles(dirs,target) @@\
-target:: @@\
- \users\cernlib\config\tree.cmd target "$(MFLAGS)" "$(TOP)" "$(CURRENT_DIR)" "$(PACKAGETOP)" "$(VPATH)" "$(MKDIRHIER)" ( dirs )
-
-*/
-
-#define MakeDepRules @@\
-/* @@\
- * @@\
- * VF. Add rules and target for gmake style of checking dependencies @@\
- * 951113 @@\
- * @@\
-*/ @@\
- @@\
-/* emptyrule is needed to avoid picking a default rule from included files. @@\
- */ @@\
- @@\
-emptyrule:: @@\
- @@\
-.SUFFIXES: .d .F @@\
- @@\
-.c.d: @@\
- @echo # dependences for $(@:/=\) >$(@:/=\) @@\
- makedepend -M -f Win32Path($@) Win32Path($(ALLDEFINES)) Win32Path($<) >Win32Path($@) @@\
- @@\
-.F.d: @@\
- @echo # dependences for Win32Path($@) >Win32Path($@) @@\
- makedepend -M -f Win32Path($@) Win32Path($(ALLDEFINES)) Win32Path($<) @@\
-
-/*
-#include "win32.fortran.rules"
-*/
-
diff --git a/src/config/WinLib.tmpl b/src/config/WinLib.tmpl
deleted file mode 100644
index 26b439b..0000000
--- a/src/config/WinLib.tmpl
+++ /dev/null
@@ -1,20 +0,0 @@
-/* $Id: WinLib.tmpl,v 1.1.1.1 1995/12/20 15:26:44 cernlib Exp $
- *
- * $Log: WinLib.tmpl,v $
- * Revision 1.1.1.1 1995/12/20 15:26:44 cernlib
- * X11R6 config files unmodified
- *
- *
- */
-XCOMM $XConsortium: WinLib.tmpl,v 1.1 94/01/08 18:32:51 rws Exp $
-
-#define SharedOldXReqs $(LDPRELIB) $(XLIBONLY)
-#define SharedXtReqs $(LDPRELIB) $(XLIBONLY)
-#define SharedXawReqs $(LDPRELIB) $(XMULIB) $(XTOOLLIB) $(XLIB)
-#define SharedXmuReqs $(LDPRELIB) $(XTOOLLIB) $(XLIB)
-#define SharedXextReqs $(LDPRELIB) $(XLIBONLY)
-#define SharedXiReqs $(LDPRELIB) $(XLIB)
-#define SharedPexReqs $(LDPRELIB) $(XLIBONLY) MathLibrary
-#define SharedXtstReqs $(LDPRELIB) $(XLIB)
-#define SharedXieReqs $(LDPRELIB) $(XLIBONLY)
-#define SharedSMReqs $(LDPRELIB) $(ICELIB)
diff --git a/src/config/apollo.cf b/src/config/apollo.cf
deleted file mode 100644
index 7d944a4..0000000
--- a/src/config/apollo.cf
+++ /dev/null
@@ -1,36 +0,0 @@
-/* $Id: apollo.cf,v 1.1.1.1 1995/12/20 15:26:44 cernlib Exp $
- *
- * $Log: apollo.cf,v $
- * Revision 1.1.1.1 1995/12/20 15:26:44 cernlib
- * X11R6 config files unmodified
- *
- *
- */
-XCOMM platform: $XConsortium: apollo.cf,v 1.31 93/08/07 11:24:47 rws Exp $
-
-/*
- * Minimally tested, and only in the bsd4.3 environment. X_NOT_POSIX is not
- * in Xosdefs.h, because we suspect someone might want to try building with
- * POSIX support in the sysv environment (the OS doc seems to imply that
- * POSIX is supported in sysv).
- */
-
-#define OSName Domain/OS SR10.3
-XCOMM operating system: OSName
-#define OSMajorVersion 10
-#define OSMinorVersion 3
-
-#define CCompilerMajorVersion 6
-#define CCompilerMinorVersion 8
-
-#define StandardDefines -DX_NOT_POSIX
-#define BuildServer NO
-#define HasNdbm YES
-#define ConnectionFlags -DTCPCONN
-
-#define InstallManPageLong(file,destdir,dest) @@\
-install.man:: file.man @@\
- MakeDir($(DESTDIR)destdir) @@\
- nroff -man file.man > file.mantxt @@\
- $(INSTALL) -c $(INSTMANFLAGS) file.mantxt $(DESTDIR)destdir/dest.$(MANSUFFIX) @@\
- $(RM) file.mantxt
diff --git a/src/config/biglib.rules b/src/config/biglib.rules
deleted file mode 100644
index c90e58a..0000000
--- a/src/config/biglib.rules
+++ /dev/null
@@ -1,405 +0,0 @@
-/* $Id: biglib.rules,v 1.16 2000/04/19 10:51:01 mclareni Exp $
- *
- * $Log: biglib.rules,v $
- * Revision 1.16 2000/04/19 10:51:01 mclareni
- * In gmake 3.79, strip fails if it is given 0 arguments
- *
- * Revision 1.15 1997/02/28 10:38:29 gunter
- * add a WNT on UseXargs...
- *
- * Revision 1.14 1996/12/16 15:10:08 cernlib
- * Correct logic bug with nested foreach
- *
- * Revision 1.13 1996/11/13 13:24:42 cernlib
- * Changes for shared libraries on OSF: build these from .a and force
- * that .a is up-to-date
- *
- * Revision 1.12 1996/10/29 13:46:48 cernlib
- * building shared libs in progress. Works for HP. AIX and OSF not yet.
- *
- * Revision 1.11 1996/05/09 14:30:03 cernlib
- * Reorder targets such that the targets are:
- * - if the library name is set, this is the first target
- * - if there library name is NIL, then the rules updating objects is first.
- *
- * Use tr instead of sed "-y..." to break lines.
- *
- * Revision 1.10 1996/05/01 13:39:05 cernlib
- * $(VERDIR)/object.list must also depend on the Makefile itsself as a changed
- * makefile could have different LIBDIRS
- *
- * Revision 1.9 1996/05/01 11:54:42 gunter
- * Introduce new way of building libraries.
- * CVS:----------------------------------------------------------------------
- *
- * Revision 1.8 1996/04/11 15:24:01 cernlib
- * small mods
- *
- * Revision 1.7 1996/04/01 15:37:16 cernlib
- * Add _debug and _shared versions of lib to .PHONY
- * make libname target a :: rule; this was needed to build the data files
- * together with the library.
- *
- * Revision 1.6 1996/03/14 08:27:21 cernlib
- * Make dependency files depend on Makefile; This forces a recomile if the
- * Makefile is changed.
- *
- * Revision 1.5 1996/02/14 11:03:35 cernlib
- * add provisions for running tests
- *
-# Revision 1.4 1996/02/12 14:21:24 cernlib
-# a library now depends (indirectly) on all the objects therein
-#
-# Revision 1.3 1996/02/08 08:28:18 cernlib
-# biglib.rules: add ranlib
-#
-# Revision 1.2 1996/01/25 11:22:59 cernlib
-# Values for IMAKE and MAKEDEPEND are used from env. variables if defined, else
-# from command search path.
-# Correct fortran options for local (not archive,..) compilation.
-#
-# Revision 1.1 1995/12/21 14:07:14 cernlib
-# files as of end 1995
-#
- *
- */
-/*
- * rules to build a library from objects in subdirs
- * GF. 180895
- * mod: 081195 more transparent, add debug libraries
- *
- * use this rules with:
- * Imakefile:
- * SubdirLibraryTarget(libname,subdirlist)
- * where: libname: name of library to make
- * subdirlist: list of subdirectories to take $(OBJS) files from
- *
- * and invoke make with :
- * make libname -or- make libname_debug
- * or on Unix : gmake liblibname.a NOTE: This will not work for
- * _debug/_shared
- * to get library libname up to date.
- *
- * At the moment ONLY one library per Imakefile/Makefile is allowed.
- *
- *
- * make library does:
- * in rule libname/libname_debug:
- * i) update stamp/object.list files, this implies that all compiled
- * files are up to date,
- * ii) rebuild library, if anything changed.
- * this rebuild is either done:
- * - using the object.list file; this lists all objects for this
- * library. xargs is used to make shure we do not overflow
- * the command line.
- * - visiting all subdirectries recursively, and adding in each
- * directory the objects of this directory.
- *
- */
-
-/* the order of SubdirLibrary... is such that
- * - if a library is defined, this will be the first target generated
- * - if NO library is defined, a target updating all objects is first
- */
-#ifndef SubdirLibraryTarget
-#define Libversions archive debug shared
-#if (defined(UseXargs) && UseXargs) || defined(CERNLIB_WINNT)
-#define SubdirLibraryTarget(libname,subdirlist) @@\
-SubdirLibraryVariables(libname,subdirlist) @@\
-SubdirLibraryObjects2(subdirlist) @@\
-SubdirLibraryBuild2(libname) @@\
- @@\
-ifneq ($($(VEROBJS)),) @@\
-$($(VEROBJS):.Osuf=.d): Makefile @@\
-include $($(VEROBJS):.Osuf=.d) @@\
- @@\
-endif @@\
- @@\
-clean:: @@\
- RemoveFiles($(LIBRARY) $(VERDIR)stamp $(VERDIR)objects.list)
-#else
-#define SubdirLibraryTarget(libname,subdirlist) @@\
-SubdirLibraryVariables(libname,subdirlist) @@\
-SubdirLibraryObjects(subdirlist) @@\
-SubdirLibraryBuild(libname) @@\
-SubdirLibraryAddObjects(subdirlist) @@\
- @@\
-ifneq ($($(VEROBJS)),) @@\
-$($(VEROBJS):.Osuf=.d): Makefile @@\
-include $($(VEROBJS):.Osuf=.d) @@\
- @@\
-endif @@\
- @@\
-clean:: @@\
- RemoveFiles($(LIBRARY) $(VERDIR)stamp $(VERDIR)objects.list)
-#endif
-#endif
-
-/* --------------------------------------------------------------------- */
-
-#ifndef SubdirLibraryVariables
-#define SubdirLibraryVariables(libname,subdirlist) @@\
-ifeq ($(strip $(VERSION)),) @@\
-VERSION=archive @@\
-endif @@\
-ifneq ($(strip $(VERSION)),archive) @@\
-LIBRARY=Concat(libname,_$(VERSION)) @@\
-else @@\
-LIBRARY=libname @@\
-endif @@\
-LIBPATH=$(TOP)$(CURRENT_DIR) @@\
-SUBDIRLIST=subdirlist @@\
-SUBDIRSTAMPS=$(foreach dir,subdirlist,$(dir)/$(VERSION)/stamp) @@\
-ifeq ($(strip $(PACKAGE_LIB)),) @@\
-override PACKAGE_LIB=$(LIBPATH)/LibraryTargetName($(LIBRARY)) @@\
-endif @@\
- @@\
-ifneq (libname,) @@\
-.PHONY: libname Concat(libname,-debug) Concat(libname,-shared) @@\
- @@\
-libname:: @@\
- @$(MAKE) VERSION=archive LibraryTargetName($@) @@\
- @@\
-Concat(libname,-debug):: @@\
- @$(MAKE) VERSION=debug LibraryTargetName($@) @@\
- @@\
-Concat(libname,-shared):: @@\
- @$(MAKE) VERSION=shared SharedLibraryTargetName(libname) @@\
- @@\
-endif @@\
- @@\
-archive_OBJS=$(foreach obj,$(OBJS),archive/$(obj)) @@\
-debug_OBJS=$(foreach obj,$(OBJS),debug/$(obj)) @@\
-shared_OBJS=$(foreach obj,$(OBJS),shared/$(obj)) @@\
- @@\
- @@\
-ifeq ($(VERSION),archive) @@\
-VEROBJS:=archive_OBJS @@\
- @@\
-endif @@\
- @@\
-ifeq ($(VERSION),debug) @@\
-VEROBJS:=debug_OBJS @@\
- @@\
-endif @@\
- @@\
-ifeq ($(VERSION),shared) @@\
-VEROBJS:=shared_OBJS @@\
- @@\
-endif @@\
- @@\
-ifeq ($(VERSION),nil) @@\
-VERDIR= @@\
-VEROBJS= @@\
-endif @@\
- @@\
-ifneq ($(strip $(VERSION)),) @@\
-VERDIR=$(VERSION)/ @@\
-else @@\
-VERDIR= @@\
-VEROBJS= @@\
-endif
-#endif
-
-/* --------------------------------------------------------------------- */
-
-#ifndef SubdirLibraryBuild2
-#define SubdirLibraryBuild2(libname) @@\
-ifneq ($(strip $(QUOTE) libname $(QUOTE)),$(QUOTE)$(QUOTE)) @@\
-ArchiveLibraryBuild(libname,archive) @@\
- @@\
-ArchiveLibraryBuild(libname-debug,debug) @@\
- @@\
-SharedLibraryBuild(libname,shared) @@\
- @@\
-endif
-#endif
-
-#ifndef ArchiveLibraryBuild
-#define ArchiveLibraryBuild(libname,version) @@\
-LibraryTargetName(libname): version/objects.list @@\
- @echo rebuild version library $@ in $(CURRENT_DIR) @@\
- @$(RM) $@ @@\
- @date @@\
- @cat version/objects.list | \ @@\
- $(XARGS) $(AR) $@ @@\
- @date @@\
- RanLibrary($@)
-#endif
-
-#if defined(HPArchitecture)
-
-#ifndef SharedLibraryTargetName
-#define SharedLibraryTargetName(name)Concat(lib,name.sl)
-#endif
-#ifndef SharedLibraryBuild
-#define SharedLibraryBuild(libname,version) @@\
-SharedLibraryTargetName(libname): version/objects.list @@\
- @echo rebuild version library $@ in $(CURRENT_DIR) @@\
- @$(RM) $@ @@\
- @date @@\
- ld -b -o$@ -c version/objects.list @@\
- @date
-#endif
-
-#elif defined(AIXArchitecture)
-
-#ifndef SharedLibraryTargetName
-#define SharedLibraryTargetName(name)Concat(lib,name-s.a)
-#endif
-#ifndef SharedLibraryBuild
-#define SharedLibraryBuild(libname,version) @@\
-SharedLibraryTargetName(libname): version/objects.list @@\
- @echo rebuild version library $@ in $(CURRENT_DIR) @@\
- @$(RM) $@ @@\
- @date @@\
- @cat version/objects.list | \ @@\
- $(XARGS) $(AR) shr.a @@\
- dump -g shr.a \ @@\
- | sed -n -e 's/^[ ]*[0-9][0-9]*[ ]*\([^ .][^ ]*\)$$/\1/p' > $@.syms @@\
- $(LD) -o shr.o shr.a -H512 -T512 -bM\:SRE -bE\:$@.syms @@\
- $(RM) shr.a @@\
- $(AR) $@ shr.o @@\
- $(RM) $@.syms shr.o @@\
- @date
-#endif
-
-#elif defined(AlphaArchitecture)
-
-#ifndef SharedLibraryTargetName
-#define SharedLibraryTargetName(name)Concat(lib,name.so)
-#endif
-
-#ifndef SharedLibraryBuild
-#define SharedLibraryBuild(libname,version) @@\
-SharedLibraryTargetName(libname): LibraryTargetName(libname) @@\
- @echo rebuild version library $@ in $(CURRENT_DIR) @@\
- @$(RM) $@ @@\
- @date @@\
- ld -shared -o $@ -all LibraryTargetName(libname) -none \ @@\
- -lUfor -lfor -LFutil -lm -lots -lc @@\
- @date
-#endif
-
-#elif 1
-#ifndef SharedLibraryBuild
-#define SharedLibraryBuild(libname,version) @@\
-SharedLibraryTargetName(libname): @@\
- @echo No shared library available yet for `uname`
-#endif
-#endif
-#ifndef SharedLibraryTargetName
-#define SharedLibraryTargetName(name)Concat(lib,name.sl)
-#endif
-
-/* --------------------------------------------------------------------- */
-
-#ifndef SubdirLibraryBuild
-#define SubdirLibraryBuild(libname) @@\
-ifneq ($(strip libname),) @@\
-LibraryTargetName($(LIBRARY)): $(VERDIR)stamp @@\
- @$(SHELL) -ec 'if [ -z "$(LIBRARY)" ]; then \ @@\
- echo No library specified in $(CURRENT_DIR); \ @@\
- false; \ @@\
- fi' @@\
- @echo rebuild $(VERSION) library $(LIBRARY) in $(CURRENT_DIR) @@\
- @$(RM) LibraryTargetName($(LIBRARY)) @@\
- @$(MAKE) --no-print-directory \ @@\
- LIBPATH=$(LIBPATH) LIBRARY=$(LIBRARY) \ @@\
- VERSION=$(VERSION) \ @@\
- libaddobjects @@\
- RanLibrary($@) @@\
- @@\
-endif
-#endif
-
-/* --------------------------------------------------------------------- */
-
-#ifndef SubdirLibraryAddObjects
-#define SubdirLibraryAddObjects(subdirlist) @@\
-libaddobjects: @@\
- @if [ -n "$(OBJS)" ]; then \ @@\
- echo adding $(VERSION) objects from $(CURRENT_DIR)/$(VERSION);\ @@\
- (cd ./$(VERSION);\
- $(AR) $(LIBPATH)/LibraryTargetName($(LIBRARY)) $(OBJS));\ @@\
- else \ @@\
- true; \ @@\
- fi @@\
- @ $(SHELL) -ec ' \ @@\
- subdirs="$(SUBDIRLIST)"; \ @@\
- if [ -n "$(SUBDIRLIST)" ]; then \ @@\
- for dir in $$subdirs; do \ @@\
- (cd $$dir; \ @@\
- $(MAKE) --no-print-directory \ @@\
- LIBPATH=$(LIBPATH) LIBRARY=$(LIBRARY) \ @@\
- VERSION=$(VERSION) \ @@\
- $@ ); \ @@\
- done; \ @@\
- fi;'
-#endif
-
-/* --------------------------------------------------------------------- */
-
-#ifndef SubdirLibraryObjects
-#define SubdirLibraryObjects(subdirlist) @@\
-$(SUBDIRSTAMPS):: $(foreach dir,subdirlist,$(dir)/Makefile) @@\
- @@\
-$(SUBDIRSTAMPS):: @@\
- @ echo checking $(CURRENT_DIR)/FirstDir($@) @@\
- @ $(MAKE) -C FirstDir($@) VERSION=$(VERSION) $(VERDIR)stamp @@\
- @@\
-$(VERDIR)stamp:: $($(VEROBJS)) $(SUBDIRSTAMPS) @@\
- - at if [ -n "$(VERSION)" -a ! -d "$(VERSION)" ] ; then \ @@\
- mkdir $(VERSION);fi @@\
- @ $(TOUCH) $@
-#endif
-
-/* --------------------------------------------------------------------- */
-
-#ifndef SubdirLibraryObjects2
-#define SubdirLibraryObjects2(dirs) @@\
-$(foreach ver,Libversions,$(ver)/objects.list):: \ @@\
- $(foreach dir,dirs,$(dir)/Makefile) @@\
- @@\
-define build-object-list @@\
-@[ -n "$(@D)" -a ! -d "$(@D)" ] && mkdir $(@D) || true @@\
- at RemoveFile($@) @@\
- at echo $(strip $($(@D)_OBJS)) | tr ' ' '\012' > $@ @@\
-@ (set -e;\ @@\
- case '${MFLAGS}' in *[i]*) set +e;; esac; \ @@\
- subdirs=Quote(dirs);\ @@\
- list=`/bin/pwd`/$@;\ @@\
- for dir in $$subdirs; do \ @@\
- (set -e;cd $$dir;SedCmd -e "\=^[^/]=s=^.=$$dir/&=" $@ >> $$list);\@@\
- done) || (rm $@; exit 1) @@\
-endef @@\
- @@\
-ifeq ($(strip $(VERSION)),archive) @@\
-archive/objects.list:: Makefile $(archive_OBJS) \ @@\
- $(foreach dir,dirs,$(dir)/archive/objects.list) @@\
- $(build-object-list) @@\
- @@\
-else @@\
-archive/objects.list:: @@\
- $(MAKE) VERSION=archive archive/objects.list @@\
- @@\
-endif @@\
-debug/objects.list:: Makefile $(debug_OBJS) \ @@\
- $(foreach dir,dirs,$(dir)/debug/objects.list) @@\
- $(build-object-list) @@\
- @@\
-shared/objects.list:: Makefile $(shared_OBJS) \ @@\
- $(foreach dir,dirs,$(dir)/shared/objects.list) @@\
- $(build-object-list) @@\
- @@\
-$(foreach dir,dirs,$(foreach ver,Libversions,$(dir)/$(ver)/objects.list))::@@\
- @ echo checking $(CURRENT_DIR)/FirstDir($@) @@\
- @ $(MAKE) -C FirstDir($@) VERSION=$(filter Libversions,$(subst /, ,$@)) \ @@\
- $(patsubst FirstDir($@)/%,%,$@)
-#endif
-
-/* --------------------------------------------------------------------- */
-
-#ifndef FirstDir
-#define FirstDir(dir)$(firstword $(subst /, ,dir))
-#endif
diff --git a/src/config/bsd.cf b/src/config/bsd.cf
deleted file mode 100644
index 2bc6ed4..0000000
--- a/src/config/bsd.cf
+++ /dev/null
@@ -1,31 +0,0 @@
-/* $Id: bsd.cf,v 1.1.1.1 1995/12/20 15:26:40 cernlib Exp $
- *
- * $Log: bsd.cf,v $
- * Revision 1.1.1.1 1995/12/20 15:26:40 cernlib
- * X11R6 config files unmodified
- *
- *
- */
-XCOMM platform: $XConsortium: bsd.cf,v 1.22 95/01/05 19:30:02 kaleb Exp $
-
-#define OSName 4.3bsd
-XCOMM operating system: OSName
-#define OSMajorVersion 4
-#define OSMinorVersion 3
-
-#define BootstrapCFlags -DNOSTDHDRS
-#define StandardDefines -DNOSTDHDRS -DCSRG_BASED
-#define HasVoidSignalReturn NO
-#define HasBsearch NO
-#define DirFailPrefix -
-#define AvoidNullMakeCommand YES
-
-#define BuildServer NO
-
-#ifdef VaxArchitecture
-#define UnalignedReferencesAllowed YES /* if arbitrary deref is okay */
-#endif
-
-#if OSMajorVersion >= 4 && OSMinorVersion >= 3
-#define SetTtyGroup YES
-#endif
diff --git a/src/config/bsdLib.rules b/src/config/bsdLib.rules
deleted file mode 100644
index 870e35b..0000000
--- a/src/config/bsdLib.rules
+++ /dev/null
@@ -1,104 +0,0 @@
-/* $Id: bsdLib.rules,v 1.1.1.1 1995/12/20 15:26:38 cernlib Exp $
- *
- * $Log: bsdLib.rules,v $
- * Revision 1.1.1.1 1995/12/20 15:26:38 cernlib
- * X11R6 config files unmodified
- *
- *
- */
-XCOMM $XConsortium: bsdLib.rules,v 1.1 94/03/29 15:34:45 gildea Exp $
-
-/*
- * NetBSD/FreeBSD shared library rules
- */
-
-#ifndef HasSharedLibraries
-#define HasSharedLibraries YES
-#endif
-#ifndef ForceNormalLib
-#define ForceNormalLib YES
-#endif
-#ifndef SharedDataSeparation
-#define SharedDataSeparation NO
-#endif
-#ifndef SharedCodeDef
-#define SharedCodeDef
-#endif
-#ifndef SharedLibraryDef
-#define SharedLibraryDef -DBSDSHLIB
-#endif
-#ifndef ShLibIncludeFile
-#define ShLibIncludeFile <bsdLib.tmpl>
-#endif
-#ifndef SharedLibraryLoadFlags
-#define SharedLibraryLoadFlags -Bshareable
-#endif
-#ifndef PositionIndependentCFlags
-#define PositionIndependentCFlags -fpic
-#endif
-
-/*
- * InstallSharedLibrary - generate rules to install the shared library.
- */
-#ifndef InstallSharedLibrary
-#define InstallSharedLibrary(libname,rev,dest) @@\
-install:: Concat(lib,libname.so.rev) @@\
- MakeDir($(DESTDIR)dest) @@\
- $(INSTALL) -c $(INSTLIBFLAGS) Concat(lib,libname.so.rev) $(DESTDIR)dest
-@@\
-
-#endif /* InstallSharedLibrary */
-
-/*
- * NormalSharedLibraryTarget - generate rules to create a shared library;
- * build it into a different name so that the we do not hose people by having
- * the library gone for long periods.
- */
-#ifndef SharedLibraryTarget
-#define SharedLibraryTarget(libname,rev,solist,down,up) @@\
-AllTarget(Concat(lib,libname.so.rev)) @@\
- @@\
-Concat(lib,libname.so.rev): solist @@\
- $(RM) $@~ @@\
- (cd down; $(LD) -o up/$@~ $(SHLIBLDFLAGS) solist $(REQUIREDLIBS)) @@\
- $(RM) $@ @@\
- $(MV) $@~ $@ @@\
- LinkBuildLibrary($@) @@\
- @@\
-clean:: @@\
- $(RM) Concat(lib,libname.so.rev)
-
-#endif /* SharedLibraryTarget */
-
-/*
- * SharedLibraryDataTarget - generate rules to create shlib data file;
- */
-#ifndef SharedLibraryDataTarget
-#define SharedLibraryDataTarget(libname,rev,salist)
-#endif /* SharedLibraryDataTarget */
-
-#ifndef InstallSharedLibraryData
-#define InstallSharedLibraryData(libname,rev,dest)
-#endif /* InstallSharedLibraryData */
-
-/*
- * SharedLibReferences - variables for shared libraries
- */
-#ifndef SharedLibReferences
-#define SharedLibReferences(varname,libname,libsource,revname,rev) @@\
-revname = rev @@\
-Concat3(DEP,varname,LIB) = SharedLibDependencies(libname,libsource,revname) @@\
-Concat(varname,LIB) = LoaderLibPrefix Concat(-l,libname) @@\
-LintLibReferences(varname,libname,libsource)
-#endif
-
-/*
- * SharedDSLibReferences - variables for shared libraries
- */
-#ifndef SharedDSLibReferences
-#define SharedDSLibReferences(varname,libname,libsource,revname,rev) @@\
-revname = rev @@\
-Concat3(DEP,varname,LIB) = SharedDSLibDependencies(libname,libsource,revname) @@\
-Concat(varname,LIB) = LoaderLibPrefix Concat(-l,libname) Concat3(Shared,libname,Reqs) @@\
-LintLibReferences(varname,libname,libsource)
-#endif
diff --git a/src/config/bsdLib.tmpl b/src/config/bsdLib.tmpl
deleted file mode 100644
index f33d526..0000000
--- a/src/config/bsdLib.tmpl
+++ /dev/null
@@ -1,23 +0,0 @@
-/* $Id: bsdLib.tmpl,v 1.1.1.1 1995/12/20 15:26:45 cernlib Exp $
- *
- * $Log: bsdLib.tmpl,v $
- * Revision 1.1.1.1 1995/12/20 15:26:45 cernlib
- * X11R6 config files unmodified
- *
- *
- */
-XCOMM $XConsortium: bsdLib.tmpl,v 1.2 95/01/23 19:07:12 kaleb Exp $
-
-/*
- * NetBSD/FreeBSD shared library template
- */
-
-#ifndef SharedXtReqs
-#define SharedXtReqs /**/
-#endif
-#ifndef SharedXawReqs
-#define SharedXawReqs /**/
-#endif
-#ifndef SharedXmuReqs
-#define SharedXmuReqs $(LDPRELIB) $(XTOOLONLYLIB) $(XONLYLIB)
-#endif
diff --git a/src/config/bsdi.cf b/src/config/bsdi.cf
deleted file mode 100644
index 67ebed5..0000000
--- a/src/config/bsdi.cf
+++ /dev/null
@@ -1,117 +0,0 @@
-/* $Id: bsdi.cf,v 1.2 2005/04/18 15:23:07 mclareni Exp $
- *
- * $Log: bsdi.cf,v $
- * Revision 1.2 2005/04/18 15:23:07 mclareni
- * Mods submitted by Kevin B. McCarty to fix insecure Cernlib uses of /tmp.
- *
- * Revision 1.1.1.1 1995/12/20 15:26:44 cernlib
- * X11R6 config files unmodified
- *
- *
- */
-XCOMM platform: $XConsortium: bsdi.cf,v 1.14 95/01/11 18:27:52 kaleb Exp $
-
-#define OSName BSD/386 1.1
-#define OSVendor BSDI
-XCOMM operating system: OSName
-#define OSMajorVersion 1
-#define OSMinorVersion 1
-
-#define HasPutenv YES
-#define HasBSD44Sockets YES
-#if OSMinorVersion >= 1
-#define HasGcc2 YES
-#define HasGcc2ForCplusplus YES
-#define CcCmd gcc2
-#endif
-#define CppCmd /usr/bin/cpp
-#define TroffCmd groff -Tps
-#define SetTtyGroup YES
-#define HasNdbm YES
-#define HasWChar32 YES
-#define DirFailPrefix -
-#define AvoidNullMakeCommand YES
-# ifndef GccUsesGas
-# define GccUsesGas YES
-# endif
-
-#if GccUsesGas
-# define GccGasOption -DGCCUSESGAS
-#else
-# define GccGasOption /**/
-#endif
-
-#define ServerExtraDefines GccGasOption XFree86ServerDefines
-#define ServerOSDefines XFree86ServerOSDefines -DDDXTIME
-#define XFree86ConsoleDefines /**/
-#define AsmDefines -DUSE_GAS
-
-#define StandardDefines -DCSRG_BASED
-
-#undef InstallCmd
-#define InstallCmd /usr/bin/install
-#undef TblCmd
-#define TblCmd /usr/bin/tbl
-#undef EqnCmd
-#define EqnCmd /usr/bin/eqn -Tascii
- COL = /usr/bin/col
- NEQN = /usr/bin/eqn -Tascii
- NROFF = /usr/bin/nroff
-
-#define OptimizedCDebugFlags -O2 -m486
-
-XCOMM Man pages need to be formatted when installed, so override the default
-XCOMM imake rules.
-
-#define ManSuffix 1
-#define ManSourcePath $(MANPATH)/cat
-
-#define InstallManPageLong(file,destdir,dest) @@\
-all:: file.0 @@\
- @@\
-file.0:: file.man @@\
- @if [ -f file.man ]; \ @@\
- then \ @@\
- cat file.man | $(NEQN) | $(TBL) | $(NROFF) -man | $(COL) >file.0; \ @@\
- fi @@\
- @@\
-file.man:: @@\
- @@\
-install.man:: @@\
- MakeDir($(DESTDIR)destdir) @@\
- - at if [ -f file.0 ]; \ @@\
- then \ @@\
- $(INSTALL) -c $(INSTMANFLAGS) file.0 $(DESTDIR)destdir/dest.0; \@@\
- fi
-
-#define InstallMultipleManSuffix(list,dest,suff) @@\
-install.man:: @@\
- MakeDir($(DESTDIR)dest) @@\
- case '${MFLAGS}' in *[i]*) set +e;; esac; \ @@\
- for i in list; do \ @@\
- (set -x; \ @@\
- TMP=$(DESTDIR)dest/$$$$.suff ; \ @@\
- cat $$i.suff | $(NEQN) | $(TBL) | $(NROFF) -man | $(COL) >$${TMP}; \ @@\
- $(INSTALL) -c $(INSTMANFLAGS) $${TMP} $(DESTDIR)dest/$$i.0; \ @@\
- $(RM) $${TMP} ); \ @@\
- done
-
-#define InstallMultipleMan(list,dest) @@\
- InstallMultipleManSuffix(list,dest,man)
-
-#define InstallManPageAliases(file,destdir,aliases) @@\
-install.man:: @@\
- @case '${MFLAGS}' in *[i]*) set +e;; esac; \ @@\
- for i in aliases; do \ @@\
- (set -x; \ @@\
- $(RM) $(DESTDIR)destdir/$$i.0;\ @@\
- $(LN) destdir/file.0 $(DESTDIR)destdir/$$i.0;\ @@\
- ); \ @@\
- done
-
-/*
- * These seem redundant, but leave them in for now.
- */
-#define i386Bsd 1
-#define i386Bsdi 1
-#include <xfree86.cf>
diff --git a/src/config/convex.cf b/src/config/convex.cf
deleted file mode 100644
index 135eaae..0000000
--- a/src/config/convex.cf
+++ /dev/null
@@ -1,102 +0,0 @@
-/* $Id: convex.cf,v 1.1.1.1 1995/12/20 15:26:47 cernlib Exp $
- *
- * $Log: convex.cf,v $
- * Revision 1.1.1.1 1995/12/20 15:26:47 cernlib
- * X11R6 config files unmodified
- *
- *
- */
-XCOMM platform: $XConsortium: convex.cf,v 1.1 91/07/29 10:31:44 rws Exp $
-
-#define OSName ConvexOS V9.0
-XCOMM operating system: OSName
-#define OSMajorVersion 9
-#define OSMinorVersion 0
-#define VersionNumber 0.0.0.0
-
-#define BootstrapCFlags -tm c1
-#define SetTtyGroup YES
-#define BuildServer NO
-#define ConnectionFlags -DTCPCONN -DUNIXCONN -DCOVUENETCONN
-#define InstallXdmConfig YES
-#define XdmDir $(LIBDIR)/xdm-sample
-#define XdmServersType fs /* one tab here */
-#define HasXmWidgets NO
-#define InstKmemFlags -g kmem -m 2755 -v $(VERSION)
-#define InstScriptFlags -m 0755 -g bin
-#define InstManFlags -m 0444 -g bin
-#define DefaultCCOptions -fn -tm c1
-#define LibraryCCOptions -fx -tm c1
-#define StripFlags -r -x
-#define HasSecureOS YES
-#define BuildExamples YES
-#define BuildMotif NO
-#define BuildConvexClients YES
-#define MotifBC YES
-#define UilCommand uil
-#define ExampleDir $(LIBDIR)/examples
-#define UnSupDir $(LIBDIR)/unsupported
-#define BuildTestExt YES
-#define DefaultScreenSaverTime 0
-
-#if BuildTestExt
-#define TestDefines -DXTESTEXT1
-#else
-#define TestDefines /**/
-#endif
-
-#define ExtensionOSDefines TestDefines
-
- VERSION = VersionNumber
- UIL = UilCommand
- UNSUPDIR = UnSupDir /* unsupported examples and code */
-
-/*
- * _Use - makes a choice based on UseInstalled.
- */
-#ifndef _Use
-#ifdef UseInstalled
-#define _Use(a,b) a
-#else
-#define _Use(a,b) b
-#endif
-#endif
-
-/*
- * _UseCat - combination of _Use and Concat.
- * exists to avoid problems with some preprocessors
- */
-#ifndef _UseCat
-#if (defined(__STDC__) || (defined(__convex__) && defined(__stdc__)))
-&& !defined(UnixCpp)
-#ifdef UseInstalled
-#define _UseCat(a,b,c) a##c
-#else
-#define _UseCat(a,b,c) b##c
-#endif
-#else
-#ifdef UseInstalled
-#define _UseCat(a,b,c) a/**/c
-#else
-#define _UseCat(a,b,c) b/**/c
-#endif
-#endif
-#endif
-
-#if HasXmWidgets
- MRESOURCESRC = $(LIBSRC)/Mrm
-DEPMRESOURCELIB = _UseCat($(USRLIBDIR),$(MRESOURCESRC),/libMrm.a)
- MRESOURCELIB = LoaderLibPrefix _Use(-lMrm,$(DEPMRESOURCELIB))
-LINTMRESOURCELIB= _UseCat($(LINTLIBDIR),$(MRESOURCESRC),/llib-lMrm.ln)
-
- XMLIBSRC = $(LIBSRC)/Xm
- DEPXMLIB = _UseCat($(USRLIBDIR),$(XMLIBSRC),/libXm.a)
- XMLIB = LoaderLibPrefix _Use(-lXm,$(DEPXMLIB))
- LINTXMLIB = _UseCat($(LINTLIBDIR),$(XMLIBSRC),/llib-lXm.ln)
-
- UILLIBSRC = $(LIBSRC)/uil
- DEPUILLIB = _UseCat($(USRLIBDIR),$(UILLIBSRC),/libUil.a)
- UILLIB = LoaderLibPrefix _Use(-lUil,$(DEPUILLIB))
- LINTUILLIB = _UseCat($(LINTLIBDIR),$(UILLIBSRC),/llib-lUil.ln)
-
-#endif
diff --git a/src/config/cray.cf b/src/config/cray.cf
deleted file mode 100644
index 77b24df..0000000
--- a/src/config/cray.cf
+++ /dev/null
@@ -1,51 +0,0 @@
-/* $Id: cray.cf,v 1.1.1.1 1995/12/20 15:26:42 cernlib Exp $
- *
- * $Log: cray.cf,v $
- * Revision 1.1.1.1 1995/12/20 15:26:42 cernlib
- * X11R6 config files unmodified
- *
- *
- */
-XCOMM platform: $XConsortium: cray.cf,v 1.49 94/04/04 21:28:10 rws Exp $
-
-#define OSName UNICOS 8.0
-XCOMM operating system: OSName
-#define OSMajorVersion 8
-#define OSMinorVersion 0
-
-#define SystemV YES
-#define Malloc0ReturnsNull YES
-#define RemoveTargetProgramByMoving YES
-#define ArCmd bld cr
-#define StandardDefines -DSYSV -DUSG
-#define ExecableScripts NO
-#define HasPoll NO
-#define HasXServer NO
-#define BuildPex NO
-#define ConnectionFlags -DTCPCONN
-#define HasShm NO
-#define PexNativeFPFormat PEXCRAY_Floating
-#define NativeFPFormat CRAY_Float
-#ifdef UseInstalled
-#define InstallCmd install
-#else
-#define InstallCmd $(SHELL) $(CONFIGSRC)/util/install.sh
-#endif
-
-#ifdef _CRAY2
-#define DefaultCCOptions -hpagelm -hlimitlm
-#endif
-
-#if OSMajorVersion >= 6
-#define PreProcessCmd /lib/pcpp
-#define CppCmd /lib/pcpp
-#else
-# if OSMajorVersion == 5
-# define PreProcessCmd /lib/cpp
-# define CppCmd /lib/cpp
-# define ExtraLoadFlags -lnet
-# endif
-#endif
-
-/* XKB library code does not work here yet */
-#define BuildXKBlib NO
diff --git a/src/config/fortran.rules b/src/config/fortran.rules
deleted file mode 100644
index 5de6b65..0000000
--- a/src/config/fortran.rules
+++ /dev/null
@@ -1,495 +0,0 @@
-/* $Id: fortran.rules,v 1.20 1997/05/30 16:25:18 mclareni Exp $
- *
- * $Log: fortran.rules,v $
- * Revision 1.20 1997/05/30 16:25:18 mclareni
- * Remove extra #define for SGI
- *
- * Revision 1.19 1997/05/07 08:41:16 mclareni
- * Put back MakeFortranSource for SGI to handle continuation lines
- *
- * Revision 1.18 1997/03/17 15:56:42 gunter
- * add archive-shared-debug to .d in dependecy
- *
- * Revision 1.17 1997/02/28 10:39:10 gunter
- * many mods for WNT
- *
- * Revision 1.16 1996/11/05 08:30:53 cernlib
- * check for program to have -x after link,if not this is an error.
- *
- * 1996/05/20 12:12:59 cernlib
- * VF. CppFortranObjectRule rule has been changed slightly
- *
- * Revision 1.15 1996/05/01 11:56:59 cernlib
- * make possible to split cpp from f77 on sgi
- *
- * Revision 1.14 1996/04/23 12:56:19 cernlib
- * Add CernlibCcProgramTarget.
- * Show cernlibs we link with.
- *
- * Revision 1.13 1996/04/09 15:43:04 cernlib
- * Restore $(FORTRANALLDEFINES) in the CppFortranObjectRule in the
- * FortranDoesCpp part
- *
- * Revision 1.12 1996/04/02 21:04:59 thakulin
- * Mods inspired by the Apogee and EPC ports (make !FortranDoesCpp work,
- * Add fsuf macro).
- *
- * Revision 1.11 1996/04/01 15:48:56 cernlib
- * Adapt to fortran not being able to redirect object files.
- *
- * Revision 1.10 1996/04/01 15:32:21 cernlib
- * Objects depend on .d files;
- * programs depend on libraries given by cernlib
- *
- * Revision 1.9 1996/03/19 14:48:56 cernlib
- * Make object file depend on .d file; this interm forces recompile on
- * change of makefile
- *
- * Revision 1.8 1996/03/08 17:12:10 cernlib
- * *** empty log message ***
- *
- * Revision 1.7 1996/03/06 11:04:18 cernlib
- * Imake.tmpl : Correct rule to run kuipc
- * fortran.rules: echo makedepend
- * site.def: undef MakeCmd before #define ( Sun has this defined to ..openwin...)
- * *.cf : small mods
- *
- * Revision 1.6 1996/03/04 17:30:40 cernlib
- * Parametrize Ansi C compiel options. other small mods
- *
-# Revision 1.5 1996/02/23 17:16:42 cernlib
-# add provsions for X11/ Motfid include files.
-# and some other small corrections
-#
-# Revision 1.4 1996/02/01 16:08:36 cernlib
-# Various changes in FOTRANDEFINES ( for IBM, and Makedepend)
-# make cc default c compiler in aix
-# use /usr/lib/X11/bin/makedepend on SunOS and Solaris
-#
-# Revision 1.3 1996/01/25 11:23:11 cernlib
-# Values for IMAKE and MAKEDEPEND are used from env. variables if defined, else
-# from command search path.
-# Correct fortran options for local (not archive,..) compilation.
-#
-# Revision 1.2 1996/01/11 13:45:06 cernlib
-# correct FortranDepend rule to use FORTRANALLDEFINES
-#
-# Revision 1.1 1995/12/21 14:07:18 cernlib
-# files as of end 1995
-#
- *
- */
-/*
- * All macro of this file. Macros marked ** are for use in Imakefiles.
- * * used in other config files
- * - internal to this file
- *
- * Fsuf -- Suffix for Fortran not yet preprocessed
- * fsuf -- Suffix for Fortran after preprocessing
- * FortranDoesCpp -- YES or NO
-
- * FortranLinkRule(program,options,objects,libraries)
- * NormalFortranProgramTarget(program,objects,deplibs,locallibs,syslibs)
-** CernlibFortranProgramTarget(program,objects,deplibs,locallibs,cernlibs)
- * CernlibFortranLinkRule(pgm,ldoption,objs,libs,cernlibs)
- * SimpleFortranProgramTarget(program)
- * FortranProgramTargetHelper(program,srcs,objs,deplib,locallib,syslib)
- * ComplexFortranProgramTarget(program)
-
- * MakeFortranSource(src,dst) RemoveFiles(dst)
- * ObjectFortranCompile(options) -- compile fragment for normal Fortran file
- * CppFortranObjectRule() -- rules to compile non library fortran routines
- * LibObjFortranCompile(dir,options)
-** SpecialFortranObjectRule(baseobj,basedep,options,cppoptions)
- * SpecialFortranLibObjectRule(baseobj,basedep,options,cppoptions)
- * SpecialFortranArchiveObjectRule(baseobj,basedep,options,cppoptions)
- * SpecialFortranSharedObjectRule(baseobj,basedep,options,cppoptions)
- * SpecialFortranDebugObjectRule(baseobj,basedep,options,cppoptions)
- * LibObjCompile(dir,options) --
- * NormalLibraryObjectRule()
- * DebugLibraryObjectRule()
- * SharedLibraryObjectRule()
- * MakeDepend(dir,flags)\
- * CDepend(dir,flags) MakeDepend(dir,$(ALLDEFINES) flags)
- * FortranDepend(dir,flags) MakeDepend(dir,$(ALLDEFINES) flags)
- * NormalFortranLibObjectRule()
- * DebugFortranLibObjectRule()
- * SharedFortranLibObjectRule()
- * DEBUG() -- temporary for debuging config files.
-
- */
-
-/*
- * Define a suffix for the Fortran compiler
- */
-
-#ifndef Fsuf
-#define Fsuf F
-#endif
-
-#ifndef fsuf
-#define fsuf f
-#endif
-
-
-#ifndef FortranDoesCpp
-#define FortranDoesCpp YES
-#endif
-
-/*
- * FortranLinkRule - link a fortran program
- */
-#ifndef FortranLinkRule
-#define FortranLinkRule(program,options,objects,libraries) \
- $(FCLINK) -o program options objects libraries $(EXTRA_LOAD_FLAGS) \ @@\
- || RemoveFile(program) @@\
- @if [ ! -x program ] ; then set -e; \ @@\
- echo Error: program not executable;RemoveFile(program);\ @@\
- exit 1; else exit 0;fi
-
-#endif
-
-
-/*
- * NormalFortranProgramTarget - generate rules to compile and link the indicated
- * program; since it does not use any default object files, it may be used for
- * multiple programs in the same Imakefile.
- */
-#ifndef NormalFortranProgramTarget
-#define NormalFortranProgramTarget(program,objects,deplibs,locallibs,syslibs) \
-ProgramTargetName(program): objects deplibs @@\
- RemoveTargetProgram($@) @@\
- FortranLinkRule($@,$(FCLDOPTIONS),objects,locallibs $(LDLIBS) syslibs) @@\
- @@\
- @@\
-clean:: @@\
- RemoveFile(ProgramTargetName(program)) @@\
-
-#endif /* NormalFortranProgramTarget */
-
-/*
- * Create a list of dependency libraries for libs coming via cernlib ..
- *
- */
-#ifndef CernlibDependLibrary
-#define CernlibDependLibrary(cernlibs)\
-$(filter-out +%,$(filter-out -%,$(shell cernlib cernlibs)))
-#endif
-
-/* Helper to use cernlib command
- */
-#ifndef CernlibCmd
-#define CernlibCmd(libraries)cernlib libraries
-#endif
-/*
- * CernlibFortranProgramTarget - rule to link fortran program using
- * cernlib utility to find give all required libraries ( ie. no extra
- * syslibs needed.
- */
-#ifndef CernlibFortranProgramTarget
-#define CernlibFortranProgramTarget(program,objects,deplibs,locallibs,cernlibs)\
-ProgramTargetName(program): SetWin32ObjSuffix(objects) deplibs CernlibDependLibrary(cernlibs) @@\
- RemoveTargetProgram($@) @@\
- @echo "Linking with cern libraries" @@\
- @cernlib cernlibs @@\
- CernlibFortranLinkRule($@,$(FCLDOPTIONS),objects,locallibs $(LDLIBS),CernlibCmd(cernlibs)) @@\
- @@\
-clean:: @@\
- RemoveFile(ProgramTargetName(program)) @@\
-
-#endif /*CernlibFortranProgramTarget */
-
-/*
- * CernlibFortranLinkRule - link using fortran linker and cernlib
- */
-#ifndef CernlibFortranLinkRule
-#define CernlibFortranLinkRule(pgm,ldoption,objs,libs,cernlibs)\
- FortranLinkRule(pgm,ldoption,objs,libs `cernlibs`)
-#endif
-
-/*
- * CernlibCcProgramTarget - rule to link program using
- * cernlib utility to find give all required libraries ( ie. no extra
- * syslibs needed.
- */
-#ifndef CernlibCcProgramTarget
-#define CernlibCcProgramTarget(program,objects,deplibs,locallibs,cernlibs)\
-ProgramTargetName(program): objects deplibs CernlibDependLibrary(cernlibs) @@\
- RemoveTargetProgram($@) @@\
- @echo "Linking with cern libraries" @@\
- @cernlib cernlibs @@\
- CernlibLinkRule($@,$(LDOPTIONS),objects,locallibs $(LDLIBS),cernlib cernlibs) @@\
- @@\
-clean:: @@\
- RemoveFile(ProgramTargetName(program)) @@\
-
-#endif /*CernlibCcProgramTarget */
-
-/*
- * CernlibLinkRule - link using fortran linker and cernlib
- */
-#ifndef CernlibLinkRule
-#define CernlibLinkRule(pgm,ldoption,objs,libs,cernlibs)\
- LinkRule(pgm,ldoption,objs,libs `cernlibs`)
-#endif
-
-
-#ifndef SimpleFortranProgramTarget
-#define SimpleFortranProgramTarget(program) @@\
- OBJS = program.Osuf @@\
- SRCS = program.Fsuf @@\
- @@\
-ComplexFortranProgramTarget(program)
-#endif /* SimpleFortranProgramTarget */
-
-#ifndef FortranProgramTargetHelper
-#define FortranProgramTargetHelper(program,srcs,objs,deplib,locallib,syslib) @@\
-ProgramTargetName(program): $(objs:.o=.Osuf) $(deplib) @@\
- RemoveTargetProgram($@) @@\
- FortranLinkRule($@,$(FCLDOPTIONS),$(objs:.o=.Osuf),locallib $(LDLIBS) syslib) @@\
- @@\
-InstallProgram(program,$(BINDIR)) @@\
-InstallManPage(program,$(MANDIR))
-#endif
-
-#ifndef ComplexFortranProgramTarget
-#define ComplexFortranProgramTarget(program) @@\
- PROGRAM = ProgramTargetName(program) @@\
- @@\
-AllTarget(ProgramTargetName(program)) @@\
- @@\
-FortranProgramTargetHelper(program,SRCS,OBJS,DEPLIBS,$(LOCAL_LIBRARIES),NullParameter) @@\
- @@\
- DependTarget() @@\
- @@\
-clean:: @@\
- RemoveFile($(PROGRAM)) @@\
-
-#endif /* ComplexFortranProgramTarget */
-
-/*
- * MakeFortranSource(src,dst) - apply either Cpp or a simple copy
- * command to create a "real" Fortran file
- * when "native" Fortran has a lack of CPP features
- * and/or treats another file-extension.
- */
-#if (!defined(MakeFortranSource)) && (!FortranDoesCpp)
-#ifndef CERNLIB_SGI
-#define MakeFortranSource(src,dst) RemoveFiles(dst) @@\
- $(FPP) $(FORTRANALLDEFINES) < src > dst
-#else /* SGI */
-#define MakeFortranSource(src,dst) RemoveFiles(dst) @@\
- sed -e "/^#[ ]*else/s/else/elif 1/" src > Concat(s_,dst) @@\
- $(FPP) $(FORTRANALLDEFINES) Concat(s_,dst) @@\
- $(MV) $(subst .fsuf,.i,Concat(s_,dst)) dst
-#endif /* SGI */
-#endif /* MakeFortranSource */
-
-/*
- * ObjectFortranCompile(options) - compile fragment for normal Fortran file
- */
-#ifndef ObjectFortranCompile
-#if FortranDoesCpp
-#ifdef SGIArchitecture
-#define ObjectFortranCompile(options) RemoveFile($@) @@\
- sed -e "/^#[ ]*else/s/else/elif 1/" $< > s_$(<F) @@\
- RunFortranCompile(options $(FORTRANOPTIONS) $(FORTRANALLDEFINES),s_$(<F))
-#else
-#define ObjectFortranCompile(options) RemoveFile($@) @@\
- RunFortranCompile(options $(FORTRANOPTIONS) $(FORTRANALLDEFINES),$<)
-#endif
-#else
-#define ObjectFortranCompile(options) RemoveFile($@) @@\
- MakeFortranSource($<,$(<F:.Fsuf=.fsuf)) @@\
-ifneq ($(MAKEFORTRANSOURCEONLY),yes) @@\
- RunFortranCompile(options $(FORTRANOPTIONS),$(<F:.Fsuf=.fsuf)) @@\
-endif @@\
-ifneq ($(SAVEFORTRANSOURCE),yes) @@\
- RemoveFile($(<F:.Fsuf=.fsuf)) @@\
-endif
-#endif
-#endif
-
-#ifndef RunFortranCompile
-#ifndef FortranCannotRedirectObject
-#define RunFortranCompile(options,source)\
- $(FC) -c options -o $@ source
-#else
-#define RunFortranCompile(options,source)\
- $(FC) -c options source && mv $(@F) $@
-#endif
-#endif
-
-#ifndef CppFortranObjectRule
-#define CppFortranObjectRule() @@\
-.SUFFIXES: .Fsuf @@\
- @@\
-.Fsuf.Osuf: @@\
- ObjectFortranCompile($(FDEBUGFLAGS))
-#endif
-
-/* LibObjFortranCompile is used to compile ALL fortran ending up in a library
- * It just calls ObjectFortranCompile(options), but is separate to provide
- * for a compiler wich will not allow to redirect output (object)
- */
-#ifndef LibObjFortranCompile
-#define LibObjFortranCompile(dir,options) ObjectFortranCompile(options)
-#endif
-
-
-#ifndef SpecialFortranObjectRule
-#define SpecialFortranObjectRule(baseobj,basedep,options,cppoptions) @@\
-baseobj.Osuf: basedep.Fsuf @@\
- ObjectFortranCompile(options cppoptions)
-#endif /* SpecialFortranObjectRule */
-
-#ifndef SpecialFortranLibObjectRule
-#define SpecialFortranLibObjectRule(baseobj,basedep,options,cppoptions) @@\
-SpecialFortranArchiveObjectRule(baseobj,basedep,options,cppoptions) @@\
-SpecialFortranSharedObjectRule(baseobj,basedep,options,cppoptions) @@\
-SpecialFortranDebugObjectRule(baseobj,basedep,options,cppoptions)
-#endif
-
-#ifndef SpecialFortranArchiveObjectRule
-#define SpecialFortranArchiveObjectRule(baseobj,basedep,options,cppoptions) @@\
-archive/baseobj.Osuf: basedep.Fsuf archive/basedep.d @@\
- LibObjFortranCompile(archive,options cppoptions)
-#endif
-
-#ifndef SpecialFortranSharedObjectRule
-#define SpecialFortranSharedObjectRule(baseobj,basedep,options,cppoptions) @@\
-shared/baseobj.Osuf: basedep.Fsuf shared/basedep.d @@\
- LibObjFortranCompile(shared,options cppoptions)
-#endif
-
-#ifndef SpecialFortranDebugObjectRule
-#define SpecialFortranDebugObjectRule(baseobj,basedep,options,cppoptions) @@\
-debug/baseobj.Osuf: basedep.Fsuf debug/basedep.d @@\
- LibObjFortranCompile(debug,options cppoptions)
-#endif
-
-
-
-#if defined(LibObjCompile) && (!defined(CERNLIB_WINNT))
-#undef LibObjCompile
-#endif
-
-#ifndef LibObjCompile
-#define LibObjCompile(dir,options) RemoveFile($@) @@\
- $(CC) -c options $(CCOPTIONS) $(ALLDEFINES) $< -o $@
-#endif
-
-
-#ifdef NormalLibraryObjectRule
-#undef NormalLibraryObjectRule
-#endif
-#ifndef NormalLibraryObjectRule
-#define NormalLibraryObjectRule() @@\
-archive/%.Osuf : %.c archive/%.d @@\
- LibObjCompile(archive,$(CDEBUGFLAGS)) @@\
- @@\
-archive/%.d : %.c @@\
- CDepend(archive,$(_NOOP_))
-#endif
-
-#ifdef DebugLibraryObjectRule
-#undef DebugLibraryObjectRule
-#endif
-#ifndef DebugLibraryObjectRule
-#define DebugLibraryObjectRule() @@\
-debug/%.Osuf : %.c debug/%.d @@\
- LibObjCompile(debug,DebuggableCDebugFlags) @@\
- @@\
-debug/%.d : %.c @@\
- CDepend(debug,$(_NOOP_))
-#endif
-
-#ifdef SharedLibraryObjectRule
-#undef SharedLibraryObjectRule
-#endif
-#ifndef SharedLibraryObjectRule
-#define SharedLibraryObjectRule() @@\
-shared/%.Osuf : %.c shared/%.d @@\
- LibObjCompile(shared,$(CDEBUGFLAGS) $(PICFLAGS)) @@\
- @@\
-shared/%.d : %.c @@\
- CDepend(shared,$(_NOOP_))
-#endif
-
-
-#ifndef MakeDepend
-#define MakeDepend(dir,flags)\
- - at if [ ! -d dir ] ; then mkdir dir; fi @@\
- @ $(TOUCH) $@.tmp @@\
- $(DEPEND) -f$@.tmp -p dir/ -- flags $< @@\
- @ sed 's=$*\.o=& $@=g' $@.tmp > $@ @@\
- @ RemoveFiles($@.tmp $@.tmp.bak)
-#endif
-
-#ifndef CDepend
-#define CDepend(dir,flags) MakeDepend(dir,$(ALLDEFINES) flags)
-#endif
-
-#ifndef FortranDepend
-#define FortranDepend(dir,flags) MakeDepend(dir,$(FORTRANALLDEFMDEPEND) flags)
-#endif
-
-NormalLibraryObjectRule()
-DebugLibraryObjectRule()
-SharedLibraryObjectRule()
-
-#ifdef NormalFortranLibObjectRule
-#undef NormalFortranLibObjectRule
-#endif
-#ifndef NormalFortranLibObjectRule
-#define NormalFortranLibObjectRule() @@\
-archive/%.Osuf : %.F archive/%.d @@\
- LibObjFortranCompile(archive,$(FDEBUGFLAGS)) @@\
- @@\
-archive/%.d : %.F @@\
- FortranDepend(archive,$(_NOOP_))
-#endif
-
-#ifdef DebugFortranLibObjectRule
-#undef DebugFortranLibObjectRule
-#endif
-#ifndef DebugFortranLibObjectRule
-#define DebugFortranLibObjectRule() @@\
-debug/%.Osuf : %.F debug/%.d @@\
- LibObjFortranCompile(debug,DebuggableFortranDebugFlags) @@\
- @@\
-debug/%.d : %.F @@\
- FortranDepend(debug,$(_NOOP_))
-#endif
-
-#ifdef SharedFortranLibObjectRule
-#undef SharedFortranLibObjectRule
-#endif
-#ifndef SharedFortranLibObjectRule
-#define SharedFortranLibObjectRule() @@\
-shared/%.Osuf : %.F shared/%.d @@\
- LibObjFortranCompile(shared,$(FDEBUGFLAGS) $(PIFFLAGS)) @@\
- @@\
-shared/%.d : %.F @@\
- FortranDepend(shared,$(_NOOP_))
-#endif
-
-
-CppFortranObjectRule()
-
-NormalFortranLibObjectRule()
-DebugFortranLibObjectRule()
-SharedFortranLibObjectRule()
-
-/* If HasFortran */
-#include <biglib.rules>
-
-#ifndef DEBUG
-#define DEBUG() @@\
-debug: @@\
- @echo PACKAGE_INCLUDES= $(PACKAGE_INCLUDES) @@\
- @echo ALLINCLUDES=$(ALLINCLUDES) @@\
- @echo ALLDEFINES=$(ALLDEFINES) @@\
- @echo FORTRANALLDEFINES=$(FORTRANALLDEFINES)
-#endif
-
diff --git a/src/config/fujitsu.cf b/src/config/fujitsu.cf
deleted file mode 100644
index 3a3c47a..0000000
--- a/src/config/fujitsu.cf
+++ /dev/null
@@ -1,56 +0,0 @@
-/* $Id: fujitsu.cf,v 1.1.1.1 1995/12/20 15:26:44 cernlib Exp $
- *
- * $Log: fujitsu.cf,v $
- * Revision 1.1.1.1 1995/12/20 15:26:44 cernlib
- * X11R6 config files unmodified
- *
- *
- */
-XCOMM platform: $XConsortium: fujitsu.cf,v 1.5 95/06/19 02:56:37 gildea Exp $
-
-#ifdef SparcArchitecture
-
-#define OSName FUJITSU UXP/DS V10L20
-XCOMM operating system: OSName
-#define OSMajorVersion 10
-#define OSMinorVersion 20
-
-#define BootstrapCFlags -D__uxp__
-#define StandardDefines -D__uxp__ -DSVR4 -DANSICPP
-#define StandardCppDefines -D__uxp__ -DSVR4 -DANSICPP
-
-#define CppCmd /usr/ccs/lib/cpp
-
-#define SystemV4 YES
-#define HasSockets YES
-#ifndef HasLdRunPath
-#define HasLdRunPath YES
-#endif
-#define BuildServer NO
-
-#include <sv4Lib.rules>
-
-#endif
-
-#ifdef mc68000Architecture
-#define OSName FUJITSU SX/G E17
-XCOMM operating system: OSName
-#define OSMajorVersion 17
-#define OSMinorVersion 10
-
-#define BootstrapCFlags -D__sxg__
-#define StandardDefines -D__sxg__ -DSYSV -DUSG -DNOSTDHDRS -I/usr/xwin/include
-#define StandardCppDefines -D__sxg__ -DSYSV -DUSG -DNOSTDHDRS -I/usr/xwin/include
-
-#define LnCmd ln
-
-#define DoRanlibCmd NO
-#define DefaultCCOptions +Z384
-#define ExtraLibraries -lXbsd -lsocket -lu
-#define TermcapLibrary -lcurses
-#define BuildServer NO
-#define HasSymLinks NO
-#define HasVFork NO
-#define XawI18nDefines -DUSE_XWCHAR_STRING -DUSE_XMBTOWC
-
-#endif
diff --git a/src/config/generic.cf b/src/config/generic.cf
deleted file mode 100644
index 54199aa..0000000
--- a/src/config/generic.cf
+++ /dev/null
@@ -1,23 +0,0 @@
-/* $Id: generic.cf,v 1.1.1.1 1995/12/20 15:26:45 cernlib Exp $
- *
- * $Log: generic.cf,v $
- * Revision 1.1.1.1 1995/12/20 15:26:45 cernlib
- * X11R6 config files unmodified
- *
- *
- */
-XCOMM platform: $XConsortium: generic.cf,v 1.6 91/07/03 14:47:42 rws Exp $
-
-#define OSName Unknown Operating System
-XCOMM operating system: OSName
-#define OSMajorVersion 0
-#define OSMinorVersion 0
-
-#ifdef SYSV
-#define SystemV YES
-#endif
-#ifdef SVR4
-#define SystemV4 YES
-#endif
-
-#define BuildServer NO
diff --git a/src/config/host.def b/src/config/host.def
deleted file mode 100644
index dbf2ae0..0000000
--- a/src/config/host.def
+++ /dev/null
@@ -1,9 +0,0 @@
-/* $Id: host.def,v 1.1.1.1 1995/12/20 15:26:42 cernlib Exp $
- *
- * $Log: host.def,v $
- * Revision 1.1.1.1 1995/12/20 15:26:42 cernlib
- * X11R6 config files unmodified
- *
- *
- */
-
diff --git a/src/config/hp.cf b/src/config/hp.cf
deleted file mode 100644
index 9eed5ff..0000000
--- a/src/config/hp.cf
+++ /dev/null
@@ -1,177 +0,0 @@
-/* $Id: hp.cf,v 1.13 2001/02/14 17:15:22 mclareni Exp $
- *
- * $Log: hp.cf,v $
- * Revision 1.13 2001/02/14 17:15:22 mclareni
- * CFIO needs the C compiler cc -Ae option for a Castor header file.
- *
- * Revision 1.12 1999/01/08 13:36:07 cernsoft
- * add options +Z for PIC and +DA1.1 for portability
- *
- * Revision 1.11 1997/06/05 08:51:11 mclareni
- * Old and new compilers seem to accept OptimisedFortranFlags +O2
- *
- * Revision 1.10 1997/04/18 06:49:14 mclareni
- * New compiler needs OptimisedFortranFlags -O2, default -O is not Posix compliant
- *
- * Revision 1.9 1996/11/13 13:20:52 cernlib
- * Add #define SharedLibraryExtension .sl
- *
- * Revision 1.8 1996/05/01 11:54:43 gunter
- * Introduce new way of building libraries.
- * CVS:----------------------------------------------------------------------
- *
- * Revision 1.7 1996/03/08 17:12:11 cernlib
- * *** empty log message ***
- *
- * Revision 1.6 1996/03/06 11:04:19 cernlib
- * Imake.tmpl : Correct rule to run kuipc
- * fortran.rules: echo makedepend
- * site.def: undef MakeCmd before #define ( Sun has this defined to ..openwin...)
- * *.cf : small mods
- *
- * Revision 1.5 1996/03/04 17:30:41 cernlib
- * Parametrize Ansi C compiel options. other small mods
- *
- * Revision 1.4 1996/02/23 17:16:43 cernlib
- * add provsions for X11/ Motfid include files.
- * and some other small corrections
- *
- * Revision 1.3 1996/02/08 08:28:23 cernlib
- * hp.cf:remove +ESlit from cc options
- * imake.rules: new rules to get name of package lib ( incomplete )
- * biglib.rules: add ranlib
- *
- * Revision 1.2 1995/12/21 11:32:20 cernlib
- * Imake files end 1995
- *
- * Revision 1.1.1.1 1995/12/20 15:26:42 cernlib
- * X11R6 config files unmodified
- *
- *
- */
-XCOMM platform: $XConsortium: hp.cf,v 1.70 94/10/28 20:47:55 dpw Exp $
-
-#define OSName HP-UX 9.1
-XCOMM operating system: OSName
-#define OSMajorVersion 9
-#define OSMinorVersion 1
-#define OSTeenyVersion 0
-
-
-/*
- * C++ compiler setup. This file knows what options to use with
- * certain compilers, including HP C++ and CenterLine C++.
- *
- * For HP C++, define HasHPCplusplus to YES in site.def.
- * For CenterLine C++, define HasCenterLineCplusplus to YES in site.def.
- * For other compilers, define HasCplusplus to YES in site.def, and
- * check to see if you need to provide values for CplusplusOptions
- * and/or DefaultCplusplusOptions.
- *
- * In any case, you may also need to set CplusplusDependIncludes.
- */
-
-#if HasHPCplusplus
-#ifndef HasCplusplus
-#define HasCplusplus YES
-#endif
-#ifndef DefaultCplusplusOptions
-#define DefaultCplusplusOptions -Aa
-#endif
-#ifndef CplusplusOptions
-#define CplusplusOptions -Aa
-#endif
-#ifndef CplusplusDependIncludes
-#define CplusplusDependIncludes -I/usr/include/CC
-#endif
-#endif
-
-#if HasCenterLineCplusplus
-#ifndef HasCplusplus
-#define HasCplusplus YES
-#endif
-#ifndef OptimizedCplusplusDebugFlags
-#define OptimizedCplusplusDebugFlags -O
-#endif
-#ifndef CplusplusDependIncludes
-#define CplusplusDependIncludes -I/usr/local/CenterLine/clc++/pa-hpux8/incl
-#endif
-#endif
-
-
-#define SystemV YES
-#define Malloc0ReturnsNull YES
-
-#ifdef __hp9000s800
-#define OptimizedCDebugFlags +O1
-#define DefaultCCOptions -Aa +ESlit
-#define SharedLibraryCCOptions -Aa
-#define StandardDefines -Dhpux -DSYSV -D_HPUX_SOURCE
-#define ServerExtraDefines -DXOS -DBSTORE -DSOFTWARE_CURSOR -DNO_ALLOCA -DSCREEN_PIXMAPS -DMERGE_SAVE_UNDERS -DR5 -DHAS_IFREQ -DFORCE_SEPARATE_PRIVATE
-#include <hpLib.rules>
-#else
-#define StandardDefines -Dhpux -DSYSV
-#if OSMajorVersion < 8
-#define DefaultCCOptions -Wc,-Nd4000,-Ns4100,-Ne700,-Np200,-Nw300
-#define PexCCOptions -Wp,-H150000 -Wc,-Nd4000,-Ns8100,-Ne700,-Np200
-#else
-#define OptimizedCDebugFlags +O1
-#define PexCCOptions -Wp,-H250000
-#endif
-#define PexShmIPC NO
-#define LintOpts -ax -Nd4000 -Ns8000 -Ne700 -Np200 -Na25000
-#endif
-#define MvCmd mv -f
-#define LdCombineFlags -r
-#define ExecableScripts YES
-#define HasVFork YES
-#define HasPoll YES
-#define RemoveTargetProgramByMoving YES
-#define ExpandManNames YES
-#define HasPutenv YES
-#define HasNdbm YES
-#define DBMLibrary /usr/lib/libdbm.a
-#define PrimaryScreenResolution 91
-#define ExtensionOSDefines -DHPINPUT -DXTESTEXT1
-#define XhpServer YES
-#define ServerExtraSysLibs -ldld
-#ifndef BuildXInputExt
-#define BuildXInputExt YES
-#endif
-#define HPFastScrolling YES
-#define BuildServer __hp9000s700
-#define NeedBerklib (BuildServer|BuildFontServer)
-#define XawI18nDefines -DHAS_WCHAR_H -DHAS_ISW_FUNCS
-
-#if OSMajorVersion < 6 || (OSMajorVersion == 6 && OSMinorVersion < 2)
-#define ConnectionFlags -DTCPCONN /* no unix sockets */
-#endif
-
-#if OSMajorVersion > 8
-#define HasWChar32 YES
-#endif
-
-/* CERNlib modifications below */
-
-#undef DefaultCCOptions
-#define DefaultCCOptions -Ae +Z +DA1.1
-
-#define FortranCmd fort77
-/* +ppu to add trailing underscore; +B to treat \ as escape
- * like all other Unixes do
- */
-#define DefaultFCOptions +ppu +B +Z +DA1.1
-#define OptimisedFortranFlags +O2
-#define FortranSaveFlags -K
-#define CernlibSystem -DCERNLIB_HPUX -DCERNLIB_UNIX
-#define CERNLIB_HPUX
-#define CERNLIB_UNIX
-
-#define CcAnsiMode -Ae
-#define CcStrictAnsiMode -Aa
-#define MotifIncludes -I/usr/include/Motif1.2
-#define X11Includes -I/usr/include/X11R5
-
-#define SedCmd gsed /* sed is broken, returns 0 even
- * if cannot open input file */
-#define SharedLibraryExtension .sl
diff --git a/src/config/hpLib.rules b/src/config/hpLib.rules
deleted file mode 100644
index 4368d56..0000000
--- a/src/config/hpLib.rules
+++ /dev/null
@@ -1,93 +0,0 @@
-/* $Id: hpLib.rules,v 1.2 1996/03/07 14:22:39 maartenb Exp $
- *
- * $Log: hpLib.rules,v $
- * Revision 1.2 1996/03/07 14:22:39 maartenb
- * - Fix position independent option.
- *
- * Revision 1.1.1.1 1995/12/20 15:26:40 cernlib
- * X11R6 config files unmodified
- *
- *
- */
-XCOMM $XConsortium: hpLib.rules,v 1.4 93/09/11 17:57:18 rws Exp $
-
-/*
- * HP shared library rules
- */
-
-#ifndef HasSharedLibraries
-#define HasSharedLibraries YES
-#endif
-#ifndef SharedDataSeparation
-#define SharedDataSeparation NO
-#endif
-#ifndef SharedCodeDef
-#define SharedCodeDef /**/
-#endif
-#ifndef SharedLibraryDef
-#define SharedLibraryDef /**/
-#endif
-#ifndef ShLibIncludeFile
-#define ShLibIncludeFile <hpLib.tmpl>
-#endif
-#ifndef SharedLibraryLoadFlags
-#define SharedLibraryLoadFlags -b
-#endif
-#ifndef PositionIndependentCFlags
-#define PositionIndependentCFlags +Z
-#endif
-#ifndef UseInstalled
-#define ExtraLoadOptions -L$(USRLIBDIR)
-#endif
-
-/*
- * InstallSharedLibrary - generate rules to install the shared library.
- */
-#ifndef InstallSharedLibrary
-#define InstallSharedLibrary(libname,rev,dest) @@\
-install:: Concat(lib,libname.sl.rev) @@\
- MakeDir($(DESTDIR)dest) @@\
- $(INSTALL) $(INSTALLFLAGS) $(INSTLIBFLAGS) Concat(lib,libname.sl.rev) $(DESTDIR)dest @@\
- $(RM) Concat($(DESTDIR)dest/lib,libname.sl) @@\
- $(LN) Concat(lib,libname.sl.rev) Concat($(DESTDIR)dest/lib,libname.sl)
-
-#endif /* InstallSharedLibrary */
-
-/*
- * InstallSharedLibraryData - generate rules to install the shared library data
- */
-#ifndef InstallSharedLibraryData
-#define InstallSharedLibraryData(libname,rev,dest)
-#endif /* InstallSharedLibraryData */
-
-
-/*
- * SharedLibraryTarget - generate rules to create a shared library;
- * build it into a different name so that we do not hose people by having
- * the library gone for long periods.
- */
-#ifndef SharedLibraryTarget
-#define SharedLibraryTarget(libname,rev,solist,down,up) @@\
-AllTarget(Concat(lib,libname.sl.rev)) @@\
- @@\
-Concat(lib,libname.sl.rev): solist @@\
- $(RM) $@~ @@\
- (cd down; $(LD) -o up/$@~ $(SHLIBLDFLAGS) solist) @@\
- $(RM) $@ @@\
- $(MV) $@~ $@ @@\
- $(RM) Concat(lib,libname.sl) @@\
- $(LN) $@ Concat(lib,libname.sl) @@\
- LinkBuildLibrary($@) @@\
- LinkBuildLibrary(Concat(lib,libname.sl)) @@\
- @@\
-clean:: @@\
- $(RM) Concat(lib,libname.sl.rev) Concat(lib,libname.sl)
-
-#endif /* SharedLibraryTarget */
-
-/*
- * SharedLibraryDataTarget - generate rules to create shlib data file;
- */
-#ifndef SharedLibraryDataTarget
-#define SharedLibraryDataTarget(libname,rev,salist)
-#endif /* SharedLibraryTarget */
diff --git a/src/config/hpLib.tmpl b/src/config/hpLib.tmpl
deleted file mode 100644
index e3a723b..0000000
--- a/src/config/hpLib.tmpl
+++ /dev/null
@@ -1,15 +0,0 @@
-/* $Id: hpLib.tmpl,v 1.1.1.1 1995/12/20 15:26:40 cernlib Exp $
- *
- * $Log: hpLib.tmpl,v $
- * Revision 1.1.1.1 1995/12/20 15:26:40 cernlib
- * X11R6 config files unmodified
- *
- *
- */
-XCOMM $XConsortium: hpLib.tmpl,v 1.8 93/08/25 15:30:15 rws Exp $
-
-/*
- * HP shared library template
- */
-
-/* nothing needed yet */
diff --git a/src/config/ibm.cf b/src/config/ibm.cf
deleted file mode 100644
index dffb0df..0000000
--- a/src/config/ibm.cf
+++ /dev/null
@@ -1,362 +0,0 @@
-/* $Id: ibm.cf,v 1.5 1996/12/16 15:10:59 cernlib Exp $
- *
- * $Log: ibm.cf,v $
- * Revision 1.5 1996/12/16 15:10:59 cernlib
- * patch up tyhe install to specify the group
- *
- * Revision 1.4 1996/11/13 13:22:02 cernlib
- * Add #define SharedLibraryExtension -s.a
- *
- * Revision 1.3 1996/02/01 16:08:41 cernlib
- * Various changes in FOTRANDEFINES ( for IBM, and Makedepend)
- * make cc default c compiler in aix
- * use /usr/lib/X11/bin/makedepend on SunOS and Solaris
- *
- * Revision 1.2 1995/12/21 11:32:24 cernlib
- * Imake files end 1995
- *
- * Revision 1.1.1.1 1995/12/20 15:26:42 cernlib
- * X11R6 config files unmodified
- *
- *
- */
-XCOMM platform: $XConsortium: ibm.cf,v 1.55.1.1 95/06/30 14:22:43 kaleb Exp $
-
-#ifdef RsArchitecture
-#ifndef OSName
-#define OSName AIX 3.2.5
-#endif
-#ifndef OSMajorVersion
-#define OSMajorVersion 3
-#endif
-#ifndef OSMinorVersion
-#define OSMinorVersion 2
-#endif
-#ifndef OSTeenyVersion
-#define OSTeenyVersion 5
-#endif
-#else
-#ifdef RtArchitecture
-#ifdef AIXArchitecture
-#define OSName AIX 2.2
-#define OSMajorVersion 2
-#define OSMinorVersion 2
-#else
-#define OSName AOS 4.3
-#define OSMajorVersion 4
-#define OSMinorVersion 3
-#endif
-#else
-#define OSName AIX 1.2.1
-#define OSMajorVersion 1
-#define OSMinorVersion 2
-#define OSTeenyVersion 1
-#endif
-#endif
-XCOMM operating system: OSName
-
-#ifdef RsArchitecture
-
-#if OSMajorVersion > 3 || (OSMajorVersion == 3 && OSMinorVersion >= 2)
-#define HasBSD44Sockets YES
-#define HasPutenv YES
-/*
- * If you do not have threads support installed, put
- * #define HasPosixThreads NO
- * in the BeforeVendorCF section of your site.def.
- */
-#if !defined(HasPosixThreads) && ((OSMajorVersion == 3 && (OSMinorVersion > 2 || (OSMinorVersion == 2 && OSTeenyVersion > 4))) || (OSMajorVersion == 4 && (OSMinorVersion > 1 || (OSMinorVersion == 1 && OSTeenyVersion > 1))))
-#define HasPosixThreads YES
-#endif
-#if HasPosixThreads
-#define SystemMTDefines -D_THREAD_SAFE
-#define ThreadedX YES
-#define ThreadsLibraries -lpthreads -lc_r
-#endif
-#endif /* OS > 3.2 */
-
-
-/*
- * For IBM platforms, we must define both the location of the compiler
- * and the location of its standard C++ library. The library location
- * is needed to resolve dependent library symbols when we build our own
- * C++ shared libraries like libFresco
- */
-
-#ifndef CplusplusCmd
-#define CplusplusCmd xlC
-#endif
-#ifndef CplusplusLibC
-#define CplusplusLibC /usr/lpp/xlC/lib/libC.a
-#endif
-#ifndef CplusplusDependIncludes
-#define CplusplusDependIncludes -I/usr/lpp/xlC/include
-#endif
-
-/*
- * IBM's xlC refuses to compile files unless their names end in ".C".
- * As an alternative to this fix, one could edit /etc/xlC.cfg
- * to change the suffix accepted by the compiler, but we prefer not
- * requiring users to reconfigure their C++ compilers to make them work.
- * We also have to override the default SUFFIXES to defeat the use of
- * the builtin .C -> .o file, which doesn't use the right flags.
- */
-
-.SUFFIXES:
-.SUFFIXES: .o .c .y .l .s .sh .h .f .Y .L .cxx
-
-#define NormalLibObjCplusplusCompile(options) test -r $*.C || $(LN) $*.CCsuf $*.C @@\
- $(CXX) -c $(CXXFLAGS) options $*.C
-
-#define SpecialCplusplusObjectRule(baseobj,basedep,options) @@\
-baseobj.Osuf: basedep.CCsuf @@\
- test -r basedep.C || $(LN) basedep.CCsuf basedep.C @@\
- $(CXX) -c $(CXXFLAGS) options basedep.C
-
-
-#define SystemV YES
-#define LdCombineFlags -r
-#define ExecableScripts YES
-#define Malloc0ReturnsNull YES
-#define CppCmd /usr/lpp/X11/Xamples/util/cpp/cpp
-#define ExpandManNames YES
-#define ExtensionOSDefines -DXTESTEXT1
-#define StandardDefines -DSYSV -DAIXV3 -D_ALL_SOURCE
-#if OSMajorVersion >= 4
-#define XawI18nDefines -DHAS_WCHAR_H -DHAS_ISW_FUNCS
-#define CcCmd c89 /* full conforming ANSI C w/ ANSI headers */
- _NULLCMD_ = @ echo
-#else
-#define XibmServer YES
-#define ibmIncludeSKYWAY YES
-#define CcCmd xlc
-#endif
-#define OPERATING_SYSTEM AIX /* directory name under server/ddx/ibm/ */
-#define InstallCmd /usr/ucb/install
-#include <ibmLib.rules>
-
-#ifndef ManKeywordsTarget
-#define ManKeywordsTarget(manpath) @@\
-man_keywords:: @@\
- /usr/lib/makewhatis $(DESTDIR)manpath
-#endif
-
-
-#else /* end of RsArchitecture */
-
-
-#define UnixCpp /**/
-#define cppdefs -DUNIXCPP
-
-#ifdef ATHENA
-#define ibmAthenaDefs -DATHENA
-#else
-#define ibmAthenaDefs /**/
-#endif
-
-#ifdef AIXArchitecture
-#define SystemV YES
-#ifdef RtArchitecture
-#define BootstrapCFlags -Daix
-#define OSDefines -DAIX -DAIXrt -DNO_FUNCTION_PROTOTYPES -DIBM_OS_HAS_HFT
-#else
-#define ExecableScripts YES
-#define ExpandManNames YES
-#define InstallCmd /usr/ucb/install
-#define OSDefines -DAIX386 -DIBM_OS_HAS_HFT
-#define NeedFunctionPrototypes YES
-#define NeedNestedPrototypes YES
-#define NeedConstPrototypes YES
-#define NeedVarargsPrototypes YES
-#define LdCombineFlags -r /* PS/2 doesn't do ld -X */
-#endif
-#define OPERATING_SYSTEM AIX /* directory name under server/ddx/ibm/ */
-
-#ifdef USE_PCC
-#define CcCmd i386cc
-#define ibmosdefs -DHCVERSION=HCRevision
-#else
-#ifdef RtArchitecture
-#define CcCmd cc -Nd4000 -Nn3000 -DBSD_INCLUDES
-#define ibmosdefs -DSYSV -Nd4000 -Nn3000
-#define ibmlibdefs -Hcpp
-#else
-#define ibmosdefs -DSYSV
-#endif
-#endif /* USE_PCC */
-
-#else /* else AOS - warning: AOS is going away... */
-#define HasNdbm YES
-#define CcCmd hc
-#define ibmosdefs -DHCVERSION=HCRevision
-#define OSDefines -DBSDrt
-#define OPERATING_SYSTEM BSDrt
-#define BootstrapCFlags -Dibm
-#if OSMajorVersion >= 4 && OSMinorVersion >= 3
-#define SetTtyGroup YES
-#endif
-#endif /* AIXArchitecture */
-
-#define HasVoidSignalReturn NO
-
-#ifdef RtArchitecture
-/*
- * These define the screens the server will allow
- * affected: .../server/ddx/ibm/Makefile
- * .../server/ddx/ibm/common/Makefile
- * Also, be sure to remove .../server/ddx/ibm/common/ibmscreen.o
- */
-#define ibmInclude8514 NO /* YES */
-#define ibmIncludeAED NO
-#define ibmIncludeAPA16 YES
-#define ibmIncludeAPA8c NO
-#define ibmIncludeEGA NO /* YES */
-#define ibmIncludeMPEL NO
-#define ibmIncludeVGA NO /* YES */
-#define ibmIncludeGEN NO
-#endif /* RtArchitecture */
-
-#ifdef PS2Architecture
-/*
- * These define the screens the server will allow
- * affected: .../server/ddx/ibm/Makefile
- * .../server/ddx/ibm/common/Makefile
- * Also, be sure to remove .../server/ddx/ibm/common/ibmscreen.o
- *
- * PS2, Rt, ...
- */
-#define ibmInclude8514 YES
-#define ibmIncludeAED NO
-#define ibmIncludeAPA16 NO
-#define ibmIncludeAPA8c NO
-#define ibmIncludeEGA NO
-#define ibmIncludeMPEL NO
-#define ibmIncludeVGA YES
-#define ibmIncludeGEN NO
-#endif /* PS2Architecture */
-
-/*
- * These define the screens the server will allow
- * affected: .../server/ddx/ibm/Makefile
- * .../server/ddx/ibm/common/Makefile
- * Also, be sure to remove .../server/ddx/ibm/common/ibmscreen.o
- *
- * PS2, Rt, ...
- */
-#ifndef ibmosdefs
-#define ibmosdefs /**/
-#endif
-#ifndef ibmarchdefs
-#define ibmarchdefs /**/
-#endif
-#ifndef ibmlibdefs
-#define ibmlibdefs /**/
-#endif
-
-
-#define StandardDefines -Dibm ibmosdefs ibmarchdefs
-#define LintOpts -ax -Dibm ibmosdefs ibmarchdefs
-
-/*
- * This defines the name of server you want.
- * affected: .../X11/server/Makefile
- */
-#define XibmServer YES
-
-/*****************************************************************************
- * Platform-specfic parameters *
- *****************************************************************************/
-
- /*
- * affected: .../server/ddx/ibm/common/Makefile
- * .../server/os/4.2bsd/Makefile
- * remove: .../server/ddx/ibm/common/ibminit.o
- * .../server/ddx/ibm/common/ibmio.o
- * .../server/ddx/ibm/common/ibmutils.o
- * .../server/os/4.2bsd/utils.o
- */
-
-/* Need This Also For our IBM Imakefiles */
-#define SpecialMalloc NO
-#define ibmSpecialMalloc NO
-
- PCC = pcc
-
-#ifndef AIXArchitecture /* AOS-specific */
-/*
- * It's real useful to know the version of hc we're using, but hc doesn't
- * identify itself in the pre-processor, so we have to do it by hand.
- *
- * To determine which version of hc you have, compile (DON'T link) some simple
- * program ("hello world" leaps to mind) and look in the .o (with "nm") for a
- * symbol named ".oVhc[0-9].[0-9][a-z]" -- this symbol is included in all
- * .o's by hc, and identifies the compiler release.
- *
- * To Calculate HCRevision, multiply the version number by 1000 and add the
- * index of the release letter.
- * For example, if nm reports:
- * 00000000 A .oVhc2.1d
- * The HCRevision is ((2.1 * 1000)+('d'-'a'+1)) == 21004
- * Another popular version of hc is:
- * 00000000 A .oVhc1.4r
- * Whose HCRevision is ((1.4 * 1000)+('r'-'a'+1)) == 14018
- *
- * A good clue that HCRevision is defined incorrectly is the undefined symbol
- * '_Alloca' at load time.
- */
-
-#define HCRevision 21025
-
-/*
- * hc revision 1.4r won't compile parts of Xt and some clients.
- */
-#if HCRevision == 14018
-#define BandAidCompiler "rtcchack.bac"
-#undef MacroFile
-#define MacroFile ibm.cf $(IRULESRC)/rtcchack.bac
-#endif
-#endif /* AOS */
-
-
-/*
- * define this as you like for server compilation
- * affected: all makefiles in .../X11/server
- */
-#define ServerExtraDefines cppdefs -DNOSTDHDRS OSDefines
-
-
-#define FontOSDefines StandardDefines
-/* define this as you like for server font support */
-#ifdef AIXArchitecture
-#define FontFilters BDFTOSNFFILT SHELLPATH
-#endif
-
-/* define the following line for easily debuggable servers, the */
-/* second line for especially speedy servers. */
-/* #define ServerCDebugFlags -O -DDEBUG -DTRACE_X */
-#define ServerCDebugFlags -O ibmAthenaDefs
-
-/* define this as you like for normal library compilation */
-#define LibraryDefines cppdefs ibmlibdefs StandardDefines
-
-#endif /* non RsArchitecture */
-
-
-/* cernlib additions */
-
-#undef CcCmd
-#define CcCmd cc
-
-#define FortranCmd xlf
-#define DefaultFCOptions -qextname
-#define OptimisedFortranFlags -O
-#define FortranSaveFlags /* default */
-#define FortranNoSaveFlags /* -qnosave but not used up to now */
-#define CernlibSystem -DCERNLIB_IBMRT -DCERNLIB_UNIX
-#define CERNLIB_IBMRT
-#define CERNLIB_UNIX
-
-#define SharedLibraryExtension -s.a
-/* for aix 4.1 (hopefully temporary) we need this -g */
-#undef InstallCmd
-#define InstallCmd /usr/ucb/install -g $(GROUP)
diff --git a/src/config/ibmLib.rules b/src/config/ibmLib.rules
deleted file mode 100644
index 5f674c1..0000000
--- a/src/config/ibmLib.rules
+++ /dev/null
@@ -1,108 +0,0 @@
-/* $Id: ibmLib.rules,v 1.1.1.1 1995/12/20 15:26:40 cernlib Exp $
- *
- * $Log: ibmLib.rules,v $
- * Revision 1.1.1.1 1995/12/20 15:26:40 cernlib
- * X11R6 config files unmodified
- *
- *
- */
-XCOMM $XConsortium: ibmLib.rules,v 1.9 93/12/24 11:28:07 rws Exp $
-
-/*
- * AIX shared library rules
- */
-
-#ifndef HasSharedLibraries
-#define HasSharedLibraries YES
-#endif
-#ifndef ForceNormalLib
-#define ForceNormalLib NO
-#endif
-#ifndef SharedDataSeparation
-#define SharedDataSeparation NO
-#endif
-#ifndef SharedCodeDef
-#define SharedCodeDef -DSHAREDCODE
-#endif
-#ifndef SharedLibraryDef
-#define SharedLibraryDef -DAIXSHLIB
-#endif
-#ifndef ShLibIncludeFile
-#define ShLibIncludeFile <ibmLib.tmpl>
-#endif
-#ifndef PositionIndependentCFlags
-#define PositionIndependentCFlags -bM\:SRE
-#endif
-#ifndef ExtraLoadFlags
-#define ExtraLoadFlags -bnodelcsect
-#endif
-#if ThreadedX
-#define BaseShLibReqs -lc_r -lm
-#else
-#define BaseShLibReqs -lc -lm
-#endif
-
-/*
- * SharedLibReferences - variables for shared libraries
- */
-#ifndef SharedLibReferences
-#define SharedLibReferences(varname,libname,libsource,revname,rev) @@\
-Concat3(DEP,varname,LIB) = /**/ @@\
-Concat(varname,LIB) = _Use(Concat(-l,libname),Concat(libsource/lib,libname.a)) @@\
-LintLibReferences(varname,libname,libsource)
-#endif
-
-/*
- * SharedDSLibReferences - variables for shared libraries
- */
-#ifndef SharedDSLibReferences
-#define SharedDSLibReferences(varname,libname,libsource,revname,rev) @@\
-SharedLibReferences(varname,libname,libsource,revname,rev)
-#endif
-
-/*
- * InstallSharedLibrary - generate rules to install the shared library.
- */
-#ifndef InstallSharedLibrary
-#define InstallSharedLibrary(libname,rev,dest) @@\
-InstallLibrary(libname,dest)
-#endif /* InstallSharedLibrary */
-
-/*
- * InstallSharedLibraryData - generate rules to install the shared library data
- */
-#ifndef InstallSharedLibraryData
-#define InstallSharedLibraryData(libname,rev,dest)
-#endif /* InstallSharedLibraryData */
-
-/*
- * NormalSharedLibraryTarget - generate rules to create a shared library;
- * build it into a different name so that the we do not hose people by having
- * the library gone for long periods.
- */
-#ifndef SharedLibraryTarget
-#define SharedLibraryTarget(libname,rev,solist,down,up) @@\
-AllTarget(Concat(lib,libname.a)) @@\
- @@\
-Concat(lib,libname.a): solist $(UNSHAREDOBJS) @@\
- $(RM) $@~ shr.o @@\
- (cd down; $(AR) up/$@~ solist) @@\
- dump -g $@~ | sed -n -e 's/^[ ]*[0-9][0-9]*[ ]*\([^ .][^ ]*\)$$/\1/p' > $@.syms @@\
- $(LD) -o shr.o $@~ -H512 -T512 -bM\:SRE -bE\:$@.syms $(REQUIREDLIBS) BaseShLibReqs -L$(USRLIBDIR) @@\
- $(RM) $@~ @@\
- $(AR) $@~ shr.o $(UNSHAREDOBJS) @@\
- $(RM) $@.syms $@ shr.o @@\
- $(MV) $@~ $@ @@\
- LinkBuildLibrary($@) @@\
- @@\
-clean:: @@\
- $(RM) Concat(lib,libname.a)
-
-#endif /* SharedLibraryTarget */
-
-/*
- * SharedLibraryDataTarget - generate rules to create shlib data file;
- */
-#ifndef SharedLibraryDataTarget
-#define SharedLibraryDataTarget(libname,rev,salist)
-#endif /* SharedLibraryTarget */
diff --git a/src/config/ibmLib.tmpl b/src/config/ibmLib.tmpl
deleted file mode 100644
index 2cc2a91..0000000
--- a/src/config/ibmLib.tmpl
+++ /dev/null
@@ -1,38 +0,0 @@
-/* $Id: ibmLib.tmpl,v 1.1.1.1 1995/12/20 15:26:44 cernlib Exp $
- *
- * $Log: ibmLib.tmpl,v $
- * Revision 1.1.1.1 1995/12/20 15:26:44 cernlib
- * X11R6 config files unmodified
- *
- *
- */
-XCOMM $XConsortium: ibmLib.tmpl,v 1.16 94/03/09 11:16:26 matt Exp $
-
-/*
- * AIX shared library template
- */
-
-#if ThreadedX
-#define SharedX11Reqs -lpthreads
-#endif
-#define SharedXextReqs $(XLIBONLY)
-#define SharedXmuReqs $(XTOOLLIB) $(XLIB)
-#define SharedOldXReqs $(XLIBONLY)
-#if ThreadedX
-#define SharedXtReqs $(XLIBONLY) $(SMLIB) $(ICELIB) -lpthreads
-#else
-#define SharedXtReqs $(XLIBONLY) $(SMLIB) $(ICELIB)
-#endif
-#define SharedXawReqs $(XMULIB) $(XTOOLLIB) $(XLIB)
-#define SharedXiReqs $(XLIB)
-#define SharedXtstReqs $(XLIB)
-#define SharedPexReqs $(XLIBONLY)
-#define SharedXieReqs $(XLIBONLY)
-#define SharedSMReqs $(ICELIB)
-#define SharedFrescoReqs $(XLIBONLY) CplusplusLibC
-#define SharedXtfReqs $(FRESCOLIB) $(XTOOLLIB) $(XLIB) CplusplusLibC
-
-#ifndef FixupLibReferences
-#define FixupLibReferences() @@\
-DEPXTOOLLIB = _UseCat($(USRLIBDIR),$(TOOLKITSRC),/libXt.a)
-#endif
diff --git a/src/config/imake_boot b/src/config/imake_boot
deleted file mode 100755
index b52d0d3..0000000
--- a/src/config/imake_boot
+++ /dev/null
@@ -1,17 +0,0 @@
-#!/bin/sh
-
-if [ "$CVSCOSRC" = "" ] ; then
- echo YOU must set CVSCOSRC first
- echo " try : setenv CVSCOSRC
- /afs/.cern.ch/asis/share/cern/97a/src"
- echo " or :
- CVSCOSRC=/afs/.cern.ch/asis/share/cern/97a/src;export CVSCOSRC"
- exit 1
-fi
-if [ -f Imakefile ] ; then
- imake -DUseInstalled -I$CVSCOSRC/config \
- -DTOPDIR=`/bin/pwd` -DCURDIR= -fImakefile
-else
- imake -DUseInstalled -I$CVSCOSRC/config \
- -DTOPDIR=`/bin/pwd` -DCURDIR= -f$CVSCOSRC/Imakefile
-fi
diff --git a/src/config/linux-lp64.cf b/src/config/linux-lp64.cf
deleted file mode 100644
index e071b2f..0000000
--- a/src/config/linux-lp64.cf
+++ /dev/null
@@ -1,201 +0,0 @@
-/* $Id: linux-lp64.cf,v 1.2 2006/12/20 14:21:03 mclareni Exp $
- *
- * $Log: linux-lp64.cf,v $
- * Revision 1.2 2006/12/20 14:21:03 mclareni
- * Add definition Hasgfortran for gcc4/gfortran
- *
- * Revision 1.1 2004/10/05 15:54:40 mclareni
- * Add configuration file linux-lp64 for Linux 64-bit pointer systems like AMD Opteron and Intel IA64.
- *
- */
-
-#define OSName Linux
-#define OSVendor /**/
-#define OSMajorVersion 2
-#define OSMinorVersion 4
-#define OSTeenyVersion 21
-
-#undef unix /* GF. this is not needed anywhere */
-
-#ifndef UseElfFormat
-#define UseElfFormat NO
-#endif
-#define HasGcc2ForCplusplus YES
-#define GccUsesGas YES
-#define UseGas YES
-#define GnuCpp YES
-#define HasShadowPasswd NO
-#ifndef HasLibCrypt
-# define HasLibCrypt NO
-#endif
-#define HasPutenv YES
-#define HasShm YES
-#define HasSockets YES
-
-#define AvoidNullMakeCommand YES
-#define StripInstalledPrograms YES
-#define CompressAllFonts YES
-#define Malloc0ReturnsNull YES
-#define NeedConstPrototypes YES
-#define NeedFunctionPrototypes YES
-#define NeedNestedPrototypes YES
-#define NeedVarargsPrototypes YES
-#define NeedWidePrototypes NO
-
-#if UseElfFormat
-#define CcCmd gcc -b i486-linuxelf
-#define AsCmd /usr/i486-linuxelf/bin/as
-#define LdCmd ld -m elf_i386
-#define AsmDefines -D__ELF__
-#define CplusplusCmd g++ -b i486-linuxelf
-#else
-#define CcCmd gcc
-#define AsCmd as
-#define LdCmd ld
-#define AsmDefines -DUSE_GAS
-#endif
-#define CppCmd /lib/cpp
-#define YaccCmd bison -y
-#define LexCmd flex -l
-#define LexLib -lfl
-#define PreProcessCmd CcCmd -E
-#define PostIncDir `CcCmd --print-libgcc-file-name | sed 's/libgcc.a/include/'`
-#define LdCombineFlags -r
-#define OptimizedCDebugFlags -O2 -m486 -fno-strength-reduce\
- -fomit-frame-pointer
-#define StandardDefines -Dlinux -D__i386__ -D_POSIX_SOURCE \
- -D_BSD_SOURCE -D_GNU_SOURCE -DX_LOCALE
-#define XawI18nDefines -DUSE_XWCHAR_STRING -DUSE_XMBTOWC
-#define HasWChar32 YES
-#define StandardCppDefines -traditional StandardDefines
-#define ServerOSDefines XFree86ServerOSDefines -DDDXTIME
-#define ExtensionOSDefines -DXTESTEXT1
-#define ServerExtraDefines -DGCCUSESGAS XFree86ServerDefines
-#define ConnectionFlags -DUNIXCONN -DTCPCONN
-#define InstUidFlags -s -m 4755
-
-/* Some of these man page defaults are overriden in the above OS sections */
-#ifndef ManSuffix
-# define ManSuffix 1x
-#endif
-#ifndef ManDir
-# define ManDir $(MANSOURCEPATH)1
-#endif
-#ifndef LibManSuffix
-# define LibManSuffix 3x
-#endif
-#ifndef LibmanDir
-# define LibmanDir $(MANSOURCEPATH)3
-#endif
-#ifndef FileManSuffix
-# define FileManSuffix 5x
-#endif
-#ifndef FileManDir
-# define FileManDir $(MANSOURCEPATH)5
-#endif
-
-#include <lnxLib.rules>
-/* #include <xfree86.cf> */
-
-
-#ifdef HasPgf77
-#define f2cFortran YES
-#define FortranCmd pgf77
-/*
-#define FortranDoesCpp NO
-#define FortranCppCmd /lib/cpp -traditional -C
-*/
-#define XargsCmd xargs
-#define FortranSaveFlags /* */ /* Everything static !? */
-#define OptimisedFortranFlags -g -pc 64 -tp p6
-#define DefaultFCOptions -Msave -fpic -Kieee
-#define CernlibSystem -DCERNLIB_LINUX -DCERNLIB_UNIX -DCERNLIB_LNX -DCERNLIB_QMGLIBC -DCERNLIB_QFPGF77 -DCERNLIB_QMLXIA64
-
-#else
-
-# ifdef HasIntelifc
-# undef CcCmd
-# undef DefaultCCOptions
-# undef OptimizedCDebugFlags
-# undef StandardDefines
-# undef NeedFunctionPrototypes
-# undef NeedWidePrototypes
-# define CcCmd icc
-# define DefaultCCOptions
-# define OptimizedCDebugFlags -O
-
-# define FortranDoesCpp NO
-#define FortranCppCmd /usr/bin/cpp -traditional -C
-# define FortranCmd ifort
-# define XargsCmd xargs
-# define FortranSaveFlags -save
-# define OptimisedFortranFlags -O2
-# define NoOpFortranDebugFlags -O0
-# define DefaultFCOptions
-# define CernlibSystem -DCERNLIB_LINUX -DCERNLIB_UNIX -DCERNLIB_LNX -DCERNLIB_QMGLIBC -DCERNLIB_QMLXIA64
-
-#else
-
-# ifdef Hasgfortran
-# undef CcCmd
-# undef DefaultCCOptions
-# undef OptimizedCDebugFlags
-# undef StandardDefines
-# undef NeedFunctionPrototypes
-# undef NeedWidePrototypes
-# define CcCmd gcc4
-# define DefaultCCOptions
-# define OptimizedCDebugFlags -O -g -fomit-frame-pointer
-
-# define FortranDoesCpp YES
-# define f2cFortran YES
-# define FortranCmd gfortran
-# define XargsCmd xargs
-# define FortranSaveFlags -fno-automatic
-# define OptimisedFortranFlags -O0 -g -funroll-loops -fomit-frame-pointer
-# define DefaultFCOptions -fno-second-underscore
-# define NoOpFortranDebugFlags -O0
-# define CernlibSystem -DCERNLIB_LINUX -DCERNLIB_UNIX -DCERNLIB_LNX -DCERNLIB_QMGLIBC -DCERNLIB_GFORTRAN -DCERNLIB_QMLXIA64
-
-#define CERNLIB_GFORTRAN
-
-# else /* g77 */
-
-/* Start CERNLIB changes A.Waananen 15. Apr. 1996 */
-/* Adapted to CERN style GF. 20-Sep-96 */
-
-# undef DefaultCCOptions
-# undef OptimizedCDebugFlags
-# undef StandardDefines
-# define OptimizedCDebugFlags -O1 -fomit-frame-pointer
-
-#define f2cFortran YES
-#define FortranCmd g77
-#define XargsCmd xargs
-#define FortranSaveFlags /* */ /* Everything static !? */
-#define DefaultFCOptions -fno-automatic -fno-second-underscore -fugly-complex
-#define CernlibSystem -DCERNLIB_LINUX -DCERNLIB_UNIX -DCERNLIB_LNX -DCERNLIB_QMGLIBC -DCERNLIB_QMLXIA64
-
-# endif
-
-#endif
-#endif
-
-#define CERNLIB_LINUX
-#define CERNLIB_UNIX
-#define CERNLIB_LNX
-#define CERNLIB_QMGLIBC
-#define CERNLIB_QMLXIA64
-
-/* #define CERNLIB_SHIFT YES uncomment this to make the shift packlib */
-
-#define X11Includes -I/usr/X11R6/include
-/* #define MotifIncludes -I/usr/local/include Cern Rh6.1 Lesstif */
-
-/*
- * Create a Make Variable to allow building with/out Motif
- */
-
-
-/* End CERNLIB changes */
-
diff --git a/src/config/linux-pmac.cf b/src/config/linux-pmac.cf
deleted file mode 100644
index 660fe31..0000000
--- a/src/config/linux-pmac.cf
+++ /dev/null
@@ -1,133 +0,0 @@
-
-#ifndef OSName
-#define OSName Linux
-#endif
-#ifndef OSVendor
-#define OSVendor Linux PPC
-#endif
-#ifndef OSMajorVersion
-#define OSMajorVersion 2
-#endif
-#ifndef OSMinorVersion
-#define OSMinorVersion 0
-#endif
-#ifndef OSTeenyVersion
-#define OSTeenyVersion 33
-#endif
-
-#undef unix /* GF. this is not needed anywhere */
-
-#define HasNdbm YES
-#define DBMLibrary -lgdbm
-#define UseElfFormat YES
-#define HasGcc YES
-#define HasGcc2 YES
-/* Create static and shared libraries */
-#define HasSharedLibraries YES
-#define ForceNormalLib YES
-#define HasGcc2ForCplusplus YES
-#define GccUsesGas YES
-#define UseGas YES
-#define GnuCpp YES
-#define HasShadowPasswd NO
-#define HasLibCrypt YES
-#define HasPutenv YES
-#define HasShm YES
-#define HasSockets YES
-#define HasZlib YES
-
-#define AvoidNullMakeCommand YES
-#define StripInstalledPrograms YES
-#define CompressAllFonts YES
-#define Malloc0ReturnsNull YES
-#define NeedConstPrototypes YES
-#define NeedFunctionPrototypes YES
-#define NeedNestedPrototypes YES
-#define NeedVarargsPrototypes YES
-#define NeedWidePrototypes NO
-#define SetTtyGroup YES
-
-#define CcCmd gcc
-#define DefaultCCOptions -fsigned-char
-#define AsCmd as
-#define LdCmd ld
-#define AsmDefines -DUSE_GAS -U__ELF__
-#define MkdirHierCmd mkdir -p
-#define CppCmd /lib/cpp
-#define YaccCmd byacc
-#define LexCmd flex -l
-#define LexLib -lfl
-#define PreProcessCmd CcCmd -E
-#define PostIncDir `CcCmd --print-libgcc-file-name | sed 's/libgcc.a/include/'`
-#define LdCombineFlags -r
-#define OptimizedCDebugFlags -O2 -fno-strength-reduce -fomit-frame-pointer
-#define StandardDefines -Dlinux -DPPC -D__powerpc__ -D_POSIX_SOURCE \
- -D_BSD_SOURCE -D_SVID_SOURCE -DX_LOCALE
-#define XawI18nDefines -DUSE_XWCHAR_STRING -DUSE_XMBTOWC
-#define HasWChar32 YES
-#define StandardCppDefines -traditional StandardDefines
-#define XpmacServer YES
-#define BuildXKB YES
-#define BuildXKBLib YES
-#define ServerOSDefines -DDDXTIME
-#define ExtensionOSDefines -DXTESTEXT1
-#define ServerExtraDefines -DGCCUSESGAS
-#define ConnectionFlags -DUNIXCONN -DTCPCONN
-#define InstallXserverSetUID YES
-#define InstUidFlags -s -m 4711
-
-#define ServerExtraSysLibs
-#define ExtraLibraries -lcrypt
-
-/* Some of these man page defaults are overriden in the above OS sections */
-#ifndef ManSuffix
-# define ManSuffix 1x
-#endif
-#ifndef ManDir
-# define ManDir $(MANSOURCEPATH)1
-#endif
-#ifndef LibManSuffix
-# define LibManSuffix 3x
-#endif
-#ifndef LibmanDir
-# define LibmanDir $(MANSOURCEPATH)3
-#endif
-#ifndef FileManSuffix
-# define FileManSuffix 5x
-#endif
-#ifndef FileManDir
-# define FileManDir $(MANSOURCEPATH)5
-#endif
-
-#include <lnxLib.rules>
-#define f2cFortran YES
-#define FortranCmd g77
-#define XargsCmd xargs
-#define FortranSaveFlags /* */ /* Everything static !? */
-#define OptimisedFortranFlags -O2 -funroll-loops -fomit-frame-pointer
-#define DefaultFCOptions -fno-automatic \
- -fno-second-underscore \
- -fno-f90 -fugly-complex -fno-globals \
- -fugly-init -Wno-globals
-#define CernlibSystem -DCERNLIB_LINUX -DCERNLIB_UNIX -DCERNLIB_LNX \
- -DCERNLIB_PPC -DCERNLIB_QMGLIBC
-
-#define CERNLIB_SHIFT NO
-#define CERNLIB_LINUX
-#define CERNLIB_UNIX
-#define CERNLIB_LNX
-#define CERNLIB_PPC
-#define CERNLIB_QMGLIBC
-
-#define X11Includes -I/usr/X11R6/include
-
-/*
- * Create a Make Variable to allow building with/out Motif
- */
-#undef MotifDependantMakeVar
-#define MotifDependantMakeVar(variable,value) @@\
-ifneq ($(strip $(HAVE_MOTIF)),) @@\
- variable=value @@\
-endif @@\
-/* End CERNLIB changes */
-
diff --git a/src/config/linux.cf b/src/config/linux.cf
deleted file mode 100644
index cc0bee5..0000000
--- a/src/config/linux.cf
+++ /dev/null
@@ -1,286 +0,0 @@
-/* $Id: linux.cf,v 1.20 2006/09/15 09:34:48 mclareni Exp $
- *
- * $Log: linux.cf,v $
- * Revision 1.20 2006/09/15 09:34:48 mclareni
- * Submitted mods for gcc4/gfortran and MacOSX, corrected to work also on slc4 with gcc3.4 and 4.1
- *
- * Revision 1.19 2004/10/05 15:56:45 mclareni
- * Update the Kernel levels and remove Make warnings about HasGcc.
- *
- * Revision 1.18 2003/06/26 13:25:35 mclareni
- * Clean up the ifc options for ifc 7.0 on Redhat 73, adding Motif by default.
- * Add the shift option as a comment so the default is still noshift.
- *
- * Revision 1.17 2002/07/08 10:27:28 mclareni
- * Add #endif to complete new else condition.
- *
- * Revision 1.16 2002/07/05 14:20:37 mclareni
- * Add compiler options for Intel IA32 ifc/icc 60 under HasIntelifc
- *
- * Revision 1.15 2002/04/24 16:37:41 mclareni
- * Make OpenMotif includes in /usr/X11R6/include the default
- *
- * Revision 1.14 2001/09/14 10:05:01 mclareni
- * Remove most of the old gcc compiler options. The problems on 2.4 kernels seem
- * to be caused by -D_GNU_SOURCE.
- *
- * Revision 1.12 2000/08/11 14:43:40 mclareni
- * New set of options for PGI pgf77, mostly de-optimised
- *
- * Revision 1.11 2000/01/14 15:44:36 mclareni
- * Add Lesstif includes from /usr/local/include
- *
- * Revision 1.10 1999/05/25 08:58:14 cernsoft
- * Remove code to build with/without Motif depending on environment variable
- *
- * Revision 1.9 1998/08/25 12:15:10 mclareni
- * Add QMGLIBC flag
- *
- * Revision 1.8 1998/02/10 10:48:59 mclareni
- * To compile herwig59 and mathlib tests need -fugly-complex option to allow REAL(DOUBLE COMPLEX arg)
- *
- * Revision 1.7 1998/01/15 14:44:01 mclareni
- * Prevent adding 2 underscores, mainly for Comis
- *
- * Revision 1.6 1997/12/15 16:20:44 mclareni
- * Changes for the Portland Group f77 compiler, inside ifdef HasPgf77
- *
- * Revision 1.5 1997/07/04 17:00:28 mclareni
- * The gcc default for backslash is required for Cernlib
- *
- * Revision 1.4 1997/07/04 16:31:44 mclareni
- * There is an official shift version for Linux
- *
- * Revision 1.3 1996/12/16 15:12:05 cernlib
- * By default inhibit Motif on Linux; can be changed via environment
- *
- * Revision 1.2 1996/11/13 13:23:15 cernlib
- * Add cernlib options for fortran etc..
- *
- * Revision 1.1.1.1 1995/12/20 15:26:45 cernlib
- * X11R6 config files unmodified
- *
- *
- */
-XCOMM platform: $XConsortium: linux.cf,v 1.11 95/01/23 18:32:03 kaleb Exp $
-
-#define OSName Linux
-#define OSVendor /**/
-#define OSMajorVersion 2
-#define OSMinorVersion 4
-#define OSTeenyVersion 2020
-
-#undef unix /* GF. this is not needed anywhere */
-
-#ifndef UseElfFormat
-#define UseElfFormat NO
-#endif
-#define HasGcc2ForCplusplus YES
-#define GccUsesGas YES
-#define UseGas YES
-#define GnuCpp YES
-#define HasShadowPasswd NO
-#ifndef HasLibCrypt
-# define HasLibCrypt NO
-#endif
-#define HasPutenv YES
-#define HasShm YES
-#define HasSockets YES
-
-#define AvoidNullMakeCommand YES
-#define StripInstalledPrograms YES
-#define CompressAllFonts YES
-#define Malloc0ReturnsNull YES
-#define NeedConstPrototypes YES
-#define NeedFunctionPrototypes YES
-#define NeedNestedPrototypes YES
-#define NeedVarargsPrototypes YES
-#define NeedWidePrototypes NO
-
-#if UseElfFormat
-#define CcCmd gcc -b i486-linuxelf
-#define AsCmd /usr/i486-linuxelf/bin/as
-#define LdCmd ld -m elf_i386
-#define AsmDefines -D__ELF__
-#define CplusplusCmd g++ -b i486-linuxelf
-#else
-#define CcCmd gcc
-#define AsCmd as
-#define LdCmd ld
-#define AsmDefines -DUSE_GAS
-#endif
-#define CppCmd /lib/cpp
-#define YaccCmd bison -y
-#define LexCmd flex -l
-#define LexLib -lfl
-#define PreProcessCmd CcCmd -E
-#define PostIncDir `CcCmd --print-libgcc-file-name | sed 's/libgcc.a/include/'`
-#define LdCombineFlags -r
-#define OptimizedCDebugFlags -O2 -m486 -fno-strength-reduce\
- -fomit-frame-pointer
-#define StandardDefines -Dlinux -D__i386__ -D_POSIX_SOURCE \
- -D_BSD_SOURCE -D_GNU_SOURCE -DX_LOCALE
-#define XawI18nDefines -DUSE_XWCHAR_STRING -DUSE_XMBTOWC
-#define HasWChar32 YES
-#define StandardCppDefines -traditional StandardDefines
-#define ServerOSDefines XFree86ServerOSDefines -DDDXTIME
-#define ExtensionOSDefines -DXTESTEXT1
-#define ServerExtraDefines -DGCCUSESGAS XFree86ServerDefines
-#define ConnectionFlags -DUNIXCONN -DTCPCONN
-#define InstUidFlags -s -m 4755
-
-/* Some of these man page defaults are overriden in the above OS sections */
-#ifndef ManSuffix
-# define ManSuffix 1x
-#endif
-#ifndef ManDir
-# define ManDir $(MANSOURCEPATH)1
-#endif
-#ifndef LibManSuffix
-# define LibManSuffix 3x
-#endif
-#ifndef LibmanDir
-# define LibmanDir $(MANSOURCEPATH)3
-#endif
-#ifndef FileManSuffix
-# define FileManSuffix 5x
-#endif
-#ifndef FileManDir
-# define FileManDir $(MANSOURCEPATH)5
-#endif
-
-#include <lnxLib.rules>
-/* #include <xfree86.cf> */
-
-#ifdef HasPgf77
-#define f2cFortran YES
-#define FortranCmd pgf77
-/*
-#define FortranDoesCpp NO
-#define FortranCppCmd /lib/cpp -traditional -C
-*/
-#define XargsCmd xargs
-#define FortranSaveFlags /* */ /* Everything static !? */
-#define OptimisedFortranFlags -g -pc 64 -tp p6
-#define DefaultFCOptions -Msave -fpic -Kieee
-#define CernlibSystem -DCERNLIB_LINUX -DCERNLIB_UNIX -DCERNLIB_LNX -DCERNLIB_QMGLIBC -DCERNLIB_QFPGF77
-
-#else
-
-# ifdef HasIntelifc
-# undef CcCmd
-# undef DefaultCCOptions
-# undef OptimizedCDebugFlags
-# undef StandardDefines
-# undef NeedFunctionPrototypes
-# undef NeedWidePrototypes
-# define CcCmd icc
-# define DefaultCCOptions
-# define OptimizedCDebugFlags -O
-
-# define FortranDoesCpp NO
-#define FortranCppCmd /usr/bin/cpp -traditional -C
-# define FortranCmd ifc
-# define XargsCmd xargs
-# define FortranSaveFlags -save
-# define OptimisedFortranFlags -O -mp1 -fp_port
-# define NoOpFortranDebugFlags -O0
-# define DefaultFCOptions
-# define CernlibSystem -DCERNLIB_LINUX -DCERNLIB_UNIX -DCERNLIB_LNX -DCERNLIB_QMGLIBC
-
-#else
-
-# ifdef HasIntelefc
-# undef CcCmd
-# undef DefaultCCOptions
-# undef OptimizedCDebugFlags
-# undef StandardDefines
-# undef NeedFunctionPrototypes
-# undef NeedWidePrototypes
-# define CcCmd ecc
-# define DefaultCCOptions -KPIC
-# define OptimizedCDebugFlags -O
-
-# define FortranDoesCpp NO
-#define FortranCppCmd /lib/cpp -traditional -C
-# define FortranCmd efc
-# define XargsCmd xargs
-# define FortranSaveFlags -save
-# define OptimisedFortranFlags -O
-# define DefaultFCOptions -KPIC
-# define CernlibSystem -DCERNLIB_LINUX -DCERNLIB_UNIX -DCERNLIB_LNX -DCERNLIB_QMGLIBC
-# define CERNLIB_SHIFT NO
-/*
- * Create a Make Variable to allow building with/out Motif
- */
-#undef MotifDependantMakeVar
-#define MotifDependantMakeVar(variable,value) @@\
-ifneq ($(strip $(HAVE_MOTIF)),) @@\
- variable=value @@\
-endif @@\
-
-#else
-
-# ifdef Hasgfortran
-# undef CcCmd
-# undef DefaultCCOptions
-# undef OptimizedCDebugFlags
-# undef StandardDefines
-# undef NeedFunctionPrototypes
-# undef NeedWidePrototypes
-# define CcCmd gcc4
-# define DefaultCCOptions
-# define OptimizedCDebugFlags -O -g -fomit-frame-pointer
-
-# define FortranDoesCpp YES
-# define f2cFortran YES
-# define FortranCmd gfortran
-# define XargsCmd xargs
-# define FortranSaveFlags -fno-automatic
-# define OptimisedFortranFlags -O0 -g -funroll-loops -fomit-frame-pointer
-# define DefaultFCOptions -fno-second-underscore
-# define NoOpFortranDebugFlags -O0
-# define CernlibSystem -DCERNLIB_LINUX -DCERNLIB_UNIX -DCERNLIB_LNX -DCERNLIB_QMGLIBC -DCERNLIB_GFORTRAN
-
-#define CERNLIB_GFORTRAN
-
-# else /* g77 */
-
-/* Start CERNLIB changes A.Waananen 15. Apr. 1996 */
-/* Adapted to CERN style GF. 20-Sep-96 */
-
-# undef DefaultCCOptions
-# undef OptimizedCDebugFlags
-# undef StandardDefines
-# define OptimizedCDebugFlags -O1 -fomit-frame-pointer
-
-#define f2cFortran YES
-#define FortranCmd g77
-#define XargsCmd xargs
-#define FortranSaveFlags /* */ /* Everything static !? */
-#define DefaultFCOptions -fno-automatic -fno-second-underscore -fugly-complex
-#define CernlibSystem -DCERNLIB_LINUX -DCERNLIB_UNIX -DCERNLIB_LNX -DCERNLIB_QMGLIBC
-
-# endif
-# endif
-
-#endif
-#endif
-
-#define CERNLIB_LINUX
-#define CERNLIB_UNIX
-#define CERNLIB_LNX
-#define CERNLIB_QMGLIBC
-
-/* # define CERNLIB_SHIFT YES uncomment this to make the shift packlib */
-
-#define X11Includes -I/usr/X11R6/include
-/* #define MotifIncludes -I/usr/local/include Cern Rh6.1 Lesstif */
-
-/*
- * Create a Make Variable to allow building with/out Motif
- */
-
-
-/* End CERNLIB changes */
-
diff --git a/src/config/lnxLib.rules b/src/config/lnxLib.rules
deleted file mode 100644
index 02a2960..0000000
--- a/src/config/lnxLib.rules
+++ /dev/null
@@ -1,521 +0,0 @@
-/* $Id: lnxLib.rules,v 1.1.1.1 1995/12/20 15:26:45 cernlib Exp $
- *
- * $Log: lnxLib.rules,v $
- * Revision 1.1.1.1 1995/12/20 15:26:45 cernlib
- * X11R6 config files unmodified
- *
- *
- */
-XCOMM $XConsortium: lnxLib.rules,v 1.8 95/01/16 21:11:00 kaleb Exp $
-
-/*
- * Linux shared library rules (DLL & ELF versions)
- */
-#ifndef HasSharedLibraries
-#define HasSharedLibraries YES
-#endif
-#ifndef ForceNormalLib
-#define ForceNormalLib NO
-#endif
-
-#define SharedOldX NO
-
-#if UseElfFormat
-
-#ifndef SharedDataSeparation
-#define SharedDataSeparation NO
-#endif
-#ifndef SharedCodeDef
-#define SharedCodeDef /**/
-#endif
-#ifndef SharedLibraryDef
-#define SharedLibraryDef /**/
-#endif
-#ifndef ShLibIncludeFile
-#define ShLibIncludeFile <lnxLib.tmpl>
-#endif
-#ifndef SharedLibraryLoadFlags
-#define SharedLibraryLoadFlags --shared
-#endif
-#ifndef PositionIndependentCFlags
-#define PositionIndependentCFlags -fPIC
-#endif
-#ifndef PositionIndependentCplusplusFlags
-#define PositionIndependentCplusplusFlags -fPIC
-#endif
-
-/*
- * InstallSharedLibrary - generate rules to install the shared library.
- * NOTE: file must be executable, hence "INSTBINFLAGS"
- */
-#ifndef InstallSharedLibrary
-#define InstallSharedLibrary(libname,rev,dest) @@\
-install:: Concat(lib,libname.so.rev) @@\
- MakeDir($(DESTDIR)dest) @@\
- $(INSTALL) $(INSTALLFLAGS) $(INSTBINFLAGS) Concat(lib,libname.so.rev) $(DESTDIR)dest @@\
- (T=`echo Concat($(DESTDIR)dest/lib,libname.so.rev) | sed 's/\.[^\.]*$$//'`;\
- $(RM) $$T && $(LN) Concat(lib,libname.so.rev) $$T) @@\
- $(RM) Concat($(DESTDIR)dest/lib,libname.so) @@\
- $(LN) Concat(lib,libname.so.rev) Concat($(DESTDIR)dest/lib,libname.so)
-#endif /* InstallSharedLibrary */
-
-/*
- * InstallSharedLibraryData - generate rules to install the shared library data
- */
-#ifndef InstallSharedLibraryData
-#define InstallSharedLibraryData(libname,rev,dest)
-#endif /* InstallSharedLibraryData */
-
-
-/*
- * SharedLibraryTarget - generate rules to create a shared library;
- * build it into a different name so that we do not hose people by having
- * the library gone for long periods.
- */
-#ifndef SharedLibraryTarget
-#define SharedLibraryTarget(libname,rev,solist,down,up) @@\
-AllTarget(Concat(lib,libname.so.rev)) @@\
- @@\
-Concat(lib,libname.so.rev): solist @@\
- $(RM) $@~ @@\
- (cd down; T=`echo $@ | sed 's/\.[^\.]*$$//'`; \
- $(LD) -o up/$@~ $(SHLIBLDFLAGS) --soname $$T solist $(REQUIREDLIBS)) @@\
- $(RM) $@ @@\
- $(MV) $@~ $@ @@\
- $(RM) Concat(lib,libname.so) @@\
- $(LN) $@ Concat(lib,libname.so) @@\
- LinkBuildLibrary($@) @@\
- LinkBuildLibrary(Concat(lib,libname.so)) @@\
- @@\
-clean:: @@\
- $(RM) Concat(lib,libname.so.rev) Concat(lib,libname.so)
-
-#endif /* SharedLibraryTarget */
-
-/*
- * SharedLibraryDataTarget - generate rules to create shlib data file;
- */
-#ifndef SharedLibraryDataTarget
-#define SharedLibraryDataTarget(libname,rev,salist)
-#endif /* SharedLibraryTarget */
-
-#else /* UseElfFormat */
-
-#ifndef SharedDataSeparation
-#define SharedDataSeparation NO
-#endif
-#ifndef SharedCodeDef
-#define SharedCodeDef /**/
-#endif
-#ifndef SharedLibraryDef
-#define SharedLibraryDef /**/
-#endif
-#ifndef ShLibIncludeFile
-#define ShLibIncludeFile <lnxLib.tmpl>
-#endif
-#ifndef SharedLibraryLoadFlags
-#define SharedLibraryLoadFlags /**/
-#endif
-#ifndef PositionIndependentCFlags
-#define PositionIndependentCFlags -B/usr/dll/jump/
-#endif
-
-/*
- * These definitions are now extended to work with the X sources and
- * external sources wishing to build shared libs.
- *
- * A library can create it's own shlibs (.so) or can be incorporated into
- * another "host" lib. All libraries generate stub (.sa) files.
- * A "host" lib does all the work to generate the stubs for itself and its
- * "guests", invoking the "guest" Makefiles to create the objects for
- * inclusion into the "host" shlib. A "guest" lib will ask the "host" to
- * create the stubfiles, then copy its own into its directory.
- * Most external libs are "host" libs; the concept of "guest" is a holdover
- * from older libs during the days of scarce shared library address space.
- *
- * To create a simple "host" shared lib, Xfoo, define:
- *
- * JUMP_ROOT_Xfoo = <source directory>
- * JUMP_IS_HOST_Xfoo = YES
- * JUMP_STUBLIBS_Xfoo = libXfoo.sa
- * JUMP_DIR_Xfoo = $(JUMP_ROOT_Xfoo)/shared <work directory>
- * JUMP_DEFS_Xfoo = -DFOO <defs for jump files>
- * JUMP_VARS_Xfoo = $(JUMP_ROOT_Xfoo)/jump_vars <see DLL docs>
- * JUMP_FUNCS_Xfoo = $(JUMP_ROOT_Xfoo)/jump_funcs <see DLL docs>
- * JUMP_IGNORE_Xfoo = $(JUMP_ROOT_Xfoo)/jump_ignore <see DLL docs>
- * JUMP_EXPORT_Xfoo = $(JUMP_DIR_Xfoo)/jump.vars <exported symbols>
- * JUMP_IMPORT_Xfoo = $(JUMP_DIR_Xbar) <imported symbols>
- * JUMP_ADDRESS_Xfoo = 0xXXXXXXXX <fill in with address>
- * JUMP_JUMPTABLESIZE_Xfoo = 0x4000 <adjust if necessary>
- * JUMP_GOTSIZE_Xfoo = 4096 <adjust if necessary>
- * JUMP_STUBNAMES_Xfoo = libXfoo <and others>
- * JUMP_STUBS_IMPORT_Xfoo = /usr/lib/libc.sa <and others>
- * JUMP_LDLIBS_Xfoo = `$(CC) --print-libgcc-file-name` -lc <and others>
- *
- * To create a complex "host", you need to add
- * JUMP_SIBARS_Xt = jump/libXbar.a~ <and others>
- * These are the archives of the shared objects of the "guest" libs. They
- * need to be added to the JUMP_LDLIBS_Xfoo lines.
- *
- * For further clarification, study the definitions of libXaw, a simple "host"
- * lib, libXt, a complex "host" lib, and libXmu, one of libXts "guests".
- *
- * As a hint of how to start (with the DLL docs), touch jump_vars, jump_funcs
- * and jump_ignore, then compile. Then massage the jump.vars and jump.funcs
- * files in the shared subdirectory into jump_xxx files.
- */
-
-#ifndef UseInstalled
-XCOMM These are only needed to build the server
-
-JUMP_LDLIBS_libc = `$(CC) --print-libgcc-file-name` -lc
-
-XCOMM libX11.so (X11, SM, ICE)
-JUMP_ROOT_X11 = $(XLIBSRC)
-JUMP_IS_HOST_X11 = YES
-JUMP_STUBLIBS_X11 = libX11.sa libSM.sa libICE.sa
-JUMP_SIBDIRS_X11 = $(JUMP_ROOT_SM) $(JUMP_ROOT_ICE)
-JUMP_DIR_X11 = $(JUMP_ROOT_X11)/shared
-JUMP_DEFS_X11 = $(XDMAUTHDEFS)
-JUMP_VARS_X11 = $(JUMP_ROOT_X11)/jump_vars
-JUMP_FUNCS_X11 = $(JUMP_ROOT_X11)/jump_funcs
-JUMP_IGNORE_X11 = $(JUMP_ROOT_X11)/jump_ignore
-JUMP_EXPORT_X11 = $(JUMP_DIR_X11)/jump.vars
-JUMP_ADDRESS_X11 = 0x60200000
-JUMP_JUMPTABLESIZE_X11 = 0x4000
-JUMP_GOTSIZE_X11 = 4096
-JUMP_STUBNAMES_X11 = libX11 libSM libICE
-JUMP_STUBS_IMPORT_X11 = /usr/lib/libc.sa
-JUMP_SIBARS_X11 = jump/libSM.a~ jump/libICE.a~
-JUMP_LDLIBS_X11 = $(JUMP_SIBARS_X11) $(JUMP_LDLIBS_libc)
-
-XCOMM libSM (part of libX11.so)
-JUMP_ROOT_SM = $(SMSRC)
-JUMP_IS_HOST_SM = NO
-JUMP_HOST_SM = $(JUMP_ROOT_X11)
-JUMP_DIR_SM = $(JUMP_DIR_X11)
-
-XCOMM libICE (part of libX11.so)
-JUMP_ROOT_ICE = $(ICESRC)
-JUMP_IS_HOST_ICE = NO
-JUMP_HOST_ICE = $(JUMP_ROOT_X11)
-JUMP_DIR_ICE = $(JUMP_DIR_X11)
-
-XCOMM libXt.so (Xt, Xmu, Xext, Xi, Xtst)
-JUMP_ROOT_Xt = $(TOOLKITSRC)
-JUMP_IS_HOST_Xt = YES
-JUMP_STUBLIBS_Xt = libXt.sa libXmu.sa libXext.sa libXi.sa libXtst.sa
-JUMP_SUBDIRS_Xt = $(JUMP_ROOT_X11)
-JUMP_SIBDIRS_Xt = $(JUMP_ROOT_Xmu) $(JUMP_ROOT_Xext) \
- $(JUMP_ROOT_Xi) $(JUMP_ROOT_Xtst)
-JUMP_DIR_Xt = $(JUMP_ROOT_Xt)/shared
-JUMP_VARS_Xt = $(JUMP_ROOT_Xt)/jump_vars
-JUMP_FUNCS_Xt = $(JUMP_ROOT_Xt)/jump_funcs
-JUMP_IGNORE_Xt = $(JUMP_ROOT_Xt)/jump_ignore
-JUMP_EXPORT_Xt = $(JUMP_DIR_Xt)/jump.vars
-JUMP_IMPORT_Xt = $(JUMP_EXPORT_X11)
-JUMP_ADDRESS_Xt = 0x602a0000
-JUMP_JUMPTABLESIZE_Xt = 0x4000
-JUMP_GOTSIZE_Xt = 4096
-JUMP_STUBNAMES_Xt = libXt libXmu libXext libXi libXtst
-JUMP_STUBS_IMPORT_Xt = $(JUMP_STUBS_IMPORT_X11)
-JUMP_SIBARS_Xt = jump/libXmu.a~ jump/libXext.a~ jump/libXi.a~ jump/libXtst.a~
-JUMP_LDLIBS_Xt = $(JUMP_SIBARS_Xt) $(JUMP_ROOT_ICE)/libICE.sa \
- $(JUMP_ROOT_SM)/libSM.sa $(JUMP_ROOT_X11)/libX11.sa $(JUMP_LDLIBS_libc)
-
-XCOMM libXmu (part of libXt.so)
-JUMP_ROOT_Xmu = $(XMUSRC)
-JUMP_IS_HOST_Xmu = NO
-JUMP_HOST_Xmu = $(JUMP_ROOT_Xt)
-JUMP_DIR_Xmu = $(JUMP_DIR_Xt)
-
-XCOMM libXext (part of libXt.so)
-JUMP_ROOT_Xext = $(XEXTLIBSRC)
-JUMP_IS_HOST_Xext = NO
-JUMP_HOST_Xext = $(JUMP_ROOT_Xt)
-JUMP_DIR_Xext = $(JUMP_DIR_Xt)
-
-XCOMM libXi (part of libXt.so)
-JUMP_ROOT_Xi = $(XILIBSRC)
-JUMP_IS_HOST_Xi = NO
-JUMP_HOST_Xi = $(JUMP_ROOT_Xt)
-JUMP_DIR_Xi = $(JUMP_DIR_Xt)
-
-XCOMM libXtst (part of libXt.so)
-JUMP_ROOT_Xtst = $(XTESTLIBSRC)
-JUMP_IS_HOST_Xtst = NO
-JUMP_HOST_Xtst = $(JUMP_ROOT_Xt)
-JUMP_DIR_Xtst = $(JUMP_DIR_Xt)
-
-XCOMM libXaw.so (Xaw)
-JUMP_ROOT_Xaw = $(AWIDGETSRC)
-JUMP_IS_HOST_Xaw = YES
-JUMP_STUBLIBS_Xaw = libXaw.sa
-JUMP_SUBDIRS_Xaw = $(JUMP_ROOT_Xt)
-JUMP_DIR_Xaw = $(JUMP_ROOT_Xaw)/shared
-JUMP_VARS_Xaw = $(JUMP_ROOT_Xaw)/jump_vars
-JUMP_FUNCS_Xaw = $(JUMP_ROOT_Xaw)/jump_funcs
-JUMP_IGNORE_Xaw = $(JUMP_ROOT_Xaw)/jump_ignore
-JUMP_EXPORT_Xaw = $(JUMP_DIR_Xaw)/jump.vars
-JUMP_IMPORT_Xaw = $(JUMP_EXPORT_Xt) $(JUMP_EXPORT_X11)
-JUMP_ADDRESS_Xaw = 0x60300000
-JUMP_JUMPTABLESIZE_Xaw = 0x4000
-JUMP_GOTSIZE_Xaw = 4096
-JUMP_STUBNAMES_Xaw = libXaw
-JUMP_STUBS_IMPORT_Xaw = $(JUMP_STUBS_IMPORT_X11)
-JUMP_LDLIBS_Xaw = $(JUMP_ROOT_Xt)/libXt.sa $(JUMP_ROOT_Xt)/libXmu.sa \
- $(JUMP_ROOT_Xt)/libXext.sa $(JUMP_ROOT_X11)/libX11.sa \
- $(JUMP_LDLIBS_libc)
-
-# libPEX.so (PEX5)
-JUMP_ROOT_PEX5 = $(PEXLIBSRC)
-JUMP_IS_HOST_PEX5 = YES
-JUMP_STUBLIBS_PEX5 = libPEX5.sa
-JUMP_SUBDIRS_PEX5 = $(JUMP_ROOT_X11)
-JUMP_DIR_PEX5 = $(JUMP_ROOT_PEX5)/shared
-JUMP_VARS_PEX5 = $(JUMP_ROOT_PEX5)/jump_vars
-JUMP_FUNCS_PEX5 = $(JUMP_ROOT_PEX5)/jump_funcs
-JUMP_IGNORE_PEX5 = $(JUMP_ROOT_PEX5)/jump_ignore
-JUMP_EXPORT_PEX5 = $(JUMP_DIR_PEX5)/jump.vars
-JUMP_IMPORT_PEX5 = $(JUMP_EXPORT_X11)
-JUMP_ADDRESS_PEX5 = 0x60b00000
-JUMP_JUMPTABLESIZE_PEX5 = 0x4000
-JUMP_GOTSIZE_PEX5 = 4096
-JUMP_STUBNAMES_PEX5 = libPEX5
-JUMP_STUBS_IMPORT_PEX5 = $(JUMP_STUBS_IMPORT_X11) /usr/lib/libm.sa
-JUMP_LDLIBS_PEX5 = $(JUMP_ROOT_X11)/libX11.sa $(JUMP_LDLIBS_libc) -lm
-
-# libXIE.so (XIE)
-JUMP_ROOT_XIE = $(XIELIBSRC)
-JUMP_IS_HOST_XIE = YES
-JUMP_STUBLIBS_XIE = libXIE.sa
-JUMP_SUBDIRS_XIE = $(JUMP_ROOT_X11)
-JUMP_DIR_XIE = $(JUMP_ROOT_XIE)/shared
-JUMP_VARS_XIE = $(JUMP_ROOT_XIE)/jump_vars
-JUMP_FUNCS_XIE = $(JUMP_ROOT_XIE)/jump_funcs
-JUMP_IGNORE_XIE = $(JUMP_ROOT_XIE)/jump_ignore
-JUMP_EXPORT_XIE = $(JUMP_DIR_XIE)/jump.vars
-JUMP_IMPORT_XIE = $(JUMP_EXPORT_X11)
-JUMP_ADDRESS_XIE = 0x60be0000
-JUMP_JUMPTABLESIZE_XIE = 0x4000
-JUMP_GOTSIZE_XIE = 4096
-JUMP_STUBNAMES_XIE = libXIE
-JUMP_STUBS_IMPORT_XIE = $(JUMP_STUBS_IMPORT_X11) /usr/lib/libm.sa
-JUMP_LDLIBS_XIE = $(JUMP_ROOT_X11)/libX11.sa $(JUMP_LDLIBS_libc) -lm
-
-XCOMM libFresco.so (Fresco, Xtf)
-JUMP_ROOT_Fresco = $(FRESCOSRC)/src
-JUMP_IS_HOST_Fresco = YES
-JUMP_STUBLIBS_Fresco = libFresco.sa libXtf.sa
-JUMP_SUBDIRS_Fresco = $(JUMP_ROOT_X11)
-JUMP_SIBDIRS_Fresco = $(JUMP_ROOT_Xtf)
-JUMP_DIR_Fresco = $(JUMP_ROOT_Fresco)/shared
-JUMP_VARS_Fresco = $(JUMP_ROOT_Fresco)/jump_vars
-JUMP_FUNCS_Fresco = $(JUMP_ROOT_Fresco)/jump_funcs
-JUMP_IGNORE_Fresco = $(JUMP_ROOT_Fresco)/jump_ignore
-JUMP_EXPORT_Fresco = $(JUMP_DIR_Fresco)/jump.vars
-JUMP_IMPORT_Fresco = $(JUMP_EXPORT_X11)
-JUMP_ADDRESS_Fresco = 0x60bc0000
-JUMP_JUMPTABLESIZE_Fresco = 0x4000
-JUMP_GOTSIZE_Fresco = 4096
-JUMP_STUBNAMES_Fresco = libFresco libXtf
-JUMP_STUBS_IMPORT_Fresco = $(JUMP_STUBS_IMPORT_X11)
-JUMP_SIBARS_Fresco = jump/libXtf.a~
-JUMP_LDLIBS_Fresco = $(JUMP_SIBARS_Fresco) $(JUMP_ROOT_X11)/libX11.sa \
- $(JUMP_LDLIBS_libc)
-
-XCOMM libXtf (part of libFresco.so)
-JUMP_ROOT_Xtf = $(XTFSRC)
-JUMP_IS_HOST_Xtf = NO
-JUMP_HOST_Xtf = $(JUMP_ROOT_Fresco)
-JUMP_DIR_Xtf = $(JUMP_DIR_Fresco)
-
-#endif /* !UseInstalled */
-
-/*
- * SharedLibraryDataTarget - generate rules to create shared data file
- */
-#ifndef SharedLibraryDataTarget
-#define SharedLibraryDataTarget(libname,rev,salist)
-#endif
-
-/*
- * SharedLibraryTarget - generate rules to create a shared library;
- * There are two basic flavors of libs: self-generating, which create
- * their own (and possibly other) libs, and hosted, which rely on another
- * lib for all the work.
- */
-#ifndef SharedLibraryTarget
-#define SharedLibraryTarget(libname,rev,solist,down,up) @@\
-XCOMM This logic is such to compile the libs in their proper order, @@\
-XCOMM remain dependent on subsidiary libs, and yet minimize local work @@\
- @@\
-JUMP_DIR=./jump @@\
-JUMP_LIB=Concat(lib,libname) @@\
- @@\
-XCOMM this is needed for newer gnumake versions @@\
-export JUMP_DIR JUMP_LIB @@\
- @@\
-JUMP_IS_HOST=$(Concat(JUMP_IS_HOST_,libname)) @@\
-JUMP_AR=$(JUMP_DIR)/Concat(lib,libname.a~) @@\
-JUMP_SA=Concat(lib,libname.sa) @@\
-JUMP_SO=Concat(lib,libname.so.rev) @@\
- @@\
-JUMP_HOST=$(Concat(JUMP_HOST_,libname)) @@\
- @@\
-INSTSOLIBFLAGS=-m 0555 @@\
- @@\
-AllTarget($(BUILDLIBDIR)/$(JUMP_SA)) @@\
- @@\
-$(BUILDLIBDIR)/$(JUMP_SA): $(JUMP_SA) @@\
- LinkBuildLibrary($(JUMP_SA)) @@\
- @@\
-$(JUMP_SA) $(Concat(JUMP_STUBLIBS_,libname)) do_JUMP_SA: \
- down/mk_JUMP_SA_$(JUMP_IS_HOST) @@\
- @@\
-down/mk_JUMP_SA_0:: mk_JUMP_HOST @@\
- @@\
-down/mk_JUMP_SA_0:: $(JUMP_HOST)/$(JUMP_SA) @@\
- $(RM) $(JUMP_SA) @@\
- $(LN) $(JUMP_HOST)/$(JUMP_SA) $(JUMP_SA) @@\
- touch $@ @@\
- @@\
-down/mk_JUMP_SA_1:: $(JUMP_SO) @@\
- @@\
-down/mk_JUMP_SA_1:: down/mk_JUMP_SO_2 @@\
- $(RM) $(Concat(JUMP_STUBLIBS_,libname)) @@\
- mkstubs -v rev -l $(JUMP_LIB) \
- -a $(Concat(JUMP_ADDRESS_,libname)) \
- -j $(Concat(JUMP_JUMPTABLESIZE_,libname)) \
- -g $(Concat(JUMP_GOTSIZE_,libname)) \
- -- $(Concat(JUMP_STUBNAMES_,libname)) @@\
- verify-shlib -l $(JUMP_SO) \
- $(Concat(JUMP_STUBLIBS_,libname)) @@\
- $(MV) verify.out $(JUMP_DIR) @@\
- touch $@ @@\
- @@\
-mk_JUMP_HOST: @@\
- @echo checking stub library $(JUMP_SA) in $(JUMP_HOST)... @@\
- @(cd $(JUMP_HOST); $(MAKE) $(MFLAGS) $(JUMP_SA)) || exit 1 @@\
- @echo ok. continuing in $(Concat(JUMP_ROOT_,libname))... @@\
- @@\
-$(JUMP_SO): down/mk_JUMP_SO_$(JUMP_IS_HOST) @@\
- @@\
-down/mk_JUMP_SO_0: @@\
- @@\
-down/mk_JUMP_SO_1:: $(JUMP_AR) mk_JUMP_SIBDIRS down/mk_JUMP_SO_2 @@\
- @@\
-down/mk_JUMP_SO_2: down/mk_JUMP_AR $(Concat(JUMP_SIBARS_,libname)) @@\
- $(RM) $(JUMP_SO) @@\
- mkimage -f -v rev -l $(JUMP_LIB) \
- -a $(Concat(JUMP_ADDRESS_,libname)) \
- -j $(Concat(JUMP_JUMPTABLESIZE_,libname)) \
- -g $(Concat(JUMP_GOTSIZE_,libname)) \
- -- $(JUMP_AR) $(Concat(JUMP_LDLIBS_,libname)) @@\
- $(RM) $(JUMP_DIR)/__jump.s $(JUMP_DIR)/__jump.o @@\
- LinkBuildLibrary($(JUMP_SO)) @@\
- touch $@ @@\
- @@\
-mk_JUMP_SIBDIRS: @@\
- @for d in $(Concat(JUMP_SIBDIRS_,libname)); do \
- echo checking ar library in $$d...; \
- (cd $$d ; $(MAKE) $(MFLAGS) fastdo_JUMP_AR) || edit 1; \
- echo ok. continuing in $(Concat(JUMP_ROOT_,libname))...;done@@\
- @@\
-fastdo_JUMP_AR: $(JUMP_DIR) down/mk_JUMP_AR @@\
- @@\
-$(JUMP_AR) do_JUMP_AR:: jumpsetup down/mk_JUMP_AR @@\
- @@\
-jumpsetup: $(JUMP_DIR) jumpsetup_$(JUMP_IS_HOST) @@\
- @@\
-$(JUMP_DIR): @@\
- $(RM) jump @@\
- LibMkdir($(Concat(JUMP_DIR_,libname))) @@\
- $(LN) $(Concat(JUMP_DIR_,libname)) jump @@\
- @@\
-jumpsetup_0: @@\
- @echo doing jump setup in host $(JUMP_HOST)... @@\
- @(cd $(JUMP_HOST); $(MAKE) $(MFLAGS) jumpsetup) || exit 1 @@\
- @echo ok. continuing in $(Concat(JUMP_ROOT_,libname))... @@\
- @@\
-jumpsetup_1:: @@\
- @for d in $(Concat(JUMP_SUBDIRS_,libname)); do \
- echo checking stub library in $$d...; \
- (cd $$d ; $(MAKE) $(MFLAGS) do_JUMP_SA) || exit 1; \
- echo ok. continuing in $(Concat(JUMP_ROOT_,libname))...;done@@\
- @@\
-jumpsetup_1:: $(JUMP_DIR)/jump.funcs $(JUMP_DIR)/jump.vars \
- $(JUMP_DIR)/jump.ignore $(JUMP_DIR)/jump.import @@\
- @@\
-$(JUMP_DIR)/jump.funcs: $(Concat(JUMP_FUNCS_,libname)) @@\
- $(RM) $(JUMP_DIR)/jump.funcs @@\
- cat $(Concat(JUMP_FUNCS_,libname)) | \
- $(CPP) $(ALLDEFINES) $(Concat(JUMP_DEFS_,libname)) > $@ @@\
- @@\
-$(JUMP_DIR)/jump.vars: $(Concat(JUMP_VARS_,libname)) @@\
- $(RM) $(JUMP_DIR)/jump.vars @@\
- cat $(Concat(JUMP_VARS_,libname)) | \
- $(CPP) $(ALLDEFINES) $(Concat(JUMP_DEFS_,libname)) > $@ @@\
- @@\
-$(JUMP_DIR)/jump.ignore: $(Concat(JUMP_IGNORE_,libname)) @@\
- $(RM) $(JUMP_DIR)/jump.ignore @@\
- cat $(Concat(JUMP_IGNORE_,libname)) | \
- $(CPP) $(ALLDEFINES) $(Concat(JUMP_DEFS_,libname)) > $@ @@\
- @@\
-$(JUMP_DIR)/jump.import: $(JUMP_DIR)/stubs.import \
- $(Concat(JUMP_IMPORT_,libname)) @@\
- $(RM) $(JUMP_DIR)/jump.import @@\
- cat $(JUMP_DIR)/stubs.import $(Concat(JUMP_IMPORT_,libname)) > $@ @@\
- @@\
-$(JUMP_DIR)/stubs.import: $(Concat(JUMP_STUBS_IMPORT_,libname)) @@\
- $(RM) $(JUMP_DIR)/stubs.import @@\
- nm --no-cplus $(Concat(JUMP_STUBS_IMPORT_,libname)) | grep '__GOT__' | \
- sed 's/__GOT__/_/' > $@ @@\
- @@\
-down/mk_JUMP_AR: solist @@\
- $(RM) $(JUMP_AR) @@\
- @if [ -s $(JUMP_DIR)/jump.log ]; then \
- echo "Error: Leftover globals for shared lib"; \
- exit 1; fi @@\
- (cd down; $(AR) up/$(JUMP_AR) solist) || exit 1 @@\
- $(RANLIB) $(JUMP_AR) @@\
- touch $@ @@\
- @@\
-clean:: jumpclean @@\
- @@\
-jumpclean: jumpclean_$(JUMP_IS_HOST) @@\
- $(RM) $(JUMP_SA) down/mk_JUMP_AR @@\
- $(RM) -r $(JUMP_DIR) @@\
- @@\
-jumpclean_0: @@\
- $(RM) down/mk_JUMP_SA_0 @@\
- $(RM) $(JUMP_HOST)/$(JUMP_SA) @@\
- @@\
-jumpclean_1: @@\
- $(RM) -r $(JUMP_SO) $(Concat(JUMP_DIR_,libname)) \ @@\
- down/mk_JUMP_SA_1 down/mk_JUMP_SO_1 down/mk_JUMP_SO_2
-#endif /* SharedLibraryTarget */
-
-/*
- * InstallSharedLibrary - generate rules to install the shared library.
- */
-#ifndef InstallSharedLibrary
-#define InstallSharedLibrary(libname,rev,dest) @@\
-install:: $(JUMP_SA) $(JUMP_SO) @@\
- MakeDir($(DESTDIR)dest) @@\
- @if [ "$(JUMP_IS_HOST)" = YES ]; then \
- (T=$(DESTDIR)dest/`echo $(JUMP_SO)|sed 's/\.[^\.]*$$//'`;\
- set -x; \
- $(INSTALL) -s -c $(INSTSOLIBFLAGS) $(JUMP_SO) $(DESTDIR)dest; \
- $(RM) $$T && $(LN) $(JUMP_SO) $$T); fi @@\
- $(INSTALL) -c $(INSTLIBFLAGS) $(JUMP_SA) $(DESTDIR)dest
-#endif /* InstallSharedLibrary */
-
-/*
- * InstallSharedLibraryData - generate rules to install the shared library data
- */
-#ifndef InstallSharedLibraryData
-#define InstallSharedLibraryData(libname,rev,dest)
-#endif /* InstallSharedLibraryData */
-
-#endif /* UseElfFormat */
diff --git a/src/config/lnxLib.tmpl b/src/config/lnxLib.tmpl
deleted file mode 100644
index a6ad39f..0000000
--- a/src/config/lnxLib.tmpl
+++ /dev/null
@@ -1,30 +0,0 @@
-/* $Id: lnxLib.tmpl,v 1.1.1.1 1995/12/20 15:26:47 cernlib Exp $
- *
- * $Log: lnxLib.tmpl,v $
- * Revision 1.1.1.1 1995/12/20 15:26:47 cernlib
- * X11R6 config files unmodified
- *
- *
- */
-XCOMM $XConsortium: lnxLib.tmpl,v 1.5 95/01/11 21:44:44 kaleb Exp $
-
-/*
- * Linux shared library template
- */
-
-/* Linux ELF shared libraries are deficient in link semantics */
-#if UseElfFormat
-#ifndef FixupLibReferences
-#define FixupLibReferences() @@\
-XMULIBONLY = -lXmu @@\
-XMULIB = $(XMULIBONLY) $(XTOOLLIB) $(XLIB)
-#endif
-#ifndef XawClientLibs
-#define XawClientLibs $(XAWLIB) $(XMULIBONLY) $(XTOOLLIB) $(XLIB)
-#endif
-#else
-#ifndef FixupLibReferences
-#define FixupLibReferences() @@\
-XMULIB = -lXmu $(XLIB)
-#endif
-#endif
diff --git a/src/config/luna.cf b/src/config/luna.cf
deleted file mode 100644
index aa2ed25..0000000
--- a/src/config/luna.cf
+++ /dev/null
@@ -1,98 +0,0 @@
-/* $Id: luna.cf,v 1.1.1.1 1995/12/20 15:26:45 cernlib Exp $
- *
- * $Log: luna.cf,v $
- * Revision 1.1.1.1 1995/12/20 15:26:45 cernlib
- * X11R6 config files unmodified
- *
- *
- */
-XCOMM platform: $XConsortium: luna.cf,v 1.30 94/04/01 19:59:08 kaleb Exp $
-/*
- * Please set the values for OSMajorVerion and OSMinorVersion
- * before making makefiles.
- */
-
-#ifdef Mc68000Architecture
-# ifdef luna2
-#define OSName Mach 2.5 Vers 1.40
-#define OSMajorVersion 1
-#define OSMinorVersion 40
-# else
-#define OSName UNIOS-B 4.3BSD UNIX: 2.00
-#define OSMajorVersion 2
-#define OSMinorVersion 0
-#define DirFailPrefix -
-# endif
-#else /* Mc88000Architecture */
-#define OSName Mach 2.5 Vers 2.00.1
-#define OSMajorVersion 2
-#define OSMinorVersion 0
-#define OSTeenyVersion 1
-#endif
-XCOMM operating system: OSName
-
-#define HasBsearch NO
-#define HasVoidSignalReturn NO
-#define HasGcc YES
-#define HasCThreads YES
-#define Malloc0ReturnsNull HasCThreads /* -lthreads fails, -lc works */
-#define XawI18nDefines -DHAS_WCHAR_H -DHAS_ISW_FUNCS
-
-#define ThreadsLibraries -lthreads -lmach
-
-#define PrimaryScreenResolution 100
-#define BuildXKB YES
-
-#ifdef Mc68000Architecture
-#ifdef luna2
-#if ((OSMajorVersion <= 1) && (OSMinorVersion < 40))
-#define ServerExtraDefines -DUNUSE_DRV_TIME -DUNUSE_SIGIO_SIGNAL
-#endif
-#else /* luna1 */
-#if ((OSMajorVersion <= 1) && (OSMinorVersion <= 60))
-#define StandardDefines -Dluna -Duniosb
-#endif
-#if ((OSMajorVersion < 2) || ((OSMajorVersion == 2) && (OSMinorVersion < 1)))
-#define ServerExtraDefines -DUNUSE_DRV_TIME -DUNUSE_SIGIO_SIGNAL
-#endif
-#endif /* luna2 */
-#if HasGcc
-#define OptimizedCDebugFlags -O -traditional
-#define ServerCDebugFlags -Dmc68020 -O -traditional
-#else /* cc */
-#define OptimizedCDebugFlags -O -Z18
-#define ServerCDebugFlags -Dmc68020 -O -Z18
-#endif /* HasGcc */
-#endif /* Mc68000Architecture */
-
-
-#ifdef Mc88000Architecture
-#if ((OSMajorVersion <= 1) && (OSMinorVersion <= 12))
-#define ServerExtraDefines -DUNUSE_DRV_TIME -DUNUSE_SIGIO_SIGNAL
-#endif
-#define HasNdbm YES
-#define ExtraLibraries -li18n
-#if HasGcc
-#define CcCmd gcc -fstrength-reduce
-#define PreIncDir /usr/local/lib/gcc/gcc-include
-#define OptimizedCDebugFlags -O2 /* -traditional */
-#else
-#define PreIncDir /usr/lib/ccom/include
-#endif
-#define PostIncDir /usr/mach/include
-#endif
-
-#ifdef Mc68000Architecture
-#define UnalignedReferencesAllowed YES /* if arbitrary deref is okay */
-#define BuildPexExt NO
-#define XlunaServer YES
-#endif
-
-#ifdef Mc88000Architecture
-#define BuildPexExt NO
-#define XlunaServer YES
-#endif
-
-#if ((OSMajorVersion >= 2) && (OSMinorVersion >= 0) && (OSTeenyVersion >= 1))
-#define HasWChar32 YES
-#endif
diff --git a/src/config/macII.cf b/src/config/macII.cf
deleted file mode 100644
index 1975229..0000000
--- a/src/config/macII.cf
+++ /dev/null
@@ -1,53 +0,0 @@
-/* $Id: macII.cf,v 1.1.1.1 1995/12/20 15:26:42 cernlib Exp $
- *
- * $Log: macII.cf,v $
- * Revision 1.1.1.1 1995/12/20 15:26:42 cernlib
- * X11R6 config files unmodified
- *
- *
- */
-XCOMM platform: $XConsortium: macII.cf,v 1.47 94/07/05 11:09:07 kaleb Exp $
-
-#define OSName A/UX 3.0.1
-#define OSMajorVersion 3
-#define OSMinorVersion 0
-#define OSTeenyVersion 1
-XCOMM operating system: OSName
-
-#if HasGcc
-#define BootstrapCFlags -DmacII
-#endif
-#define SystemV YES
-#define HasPoll NO
-#define NeedBerklib YES
-#define ExtraLibraries $(XBSDLIB) -lposix -lm -lmr
-#define Malloc0ReturnsNull YES
-#define StandardDefines -DmacII -DSYSV
-#define ExecableScripts NO
-#define RemoveTargetProgramByMoving YES
-#define ExpandManNames YES
-#define PexShmIPC NO
-#define XmacIIServer YES
-#define XawI18nDefines -DUSE_XWCHAR_STRING -DUSE_XMBTOWC
-#if MacHasc89
-#define CcCmd c89 -D_POSIX_SOURCE
-#else
-#define HasVoidSignalReturn NO
-#endif
-#if OSMajorVersion <= 2
-#define ServerExtraDefines -DSUPPORT_2_0
-#endif
-#define InstKmemFlags -g sys -m 2755
-#define ExtensionOSDefines -DXTESTEXT1
-
-#if !HasGcc
-#define DefaultCCOptions -A 3
-#define PexCCOptions -A 4
-#endif
-
-/*
- * If you wish to override the man page directories, do so here using just
- * one tab between the parameter name (e.g. ManDirectoryRoot) and the
- * value so that cpp doesn't get confused.
- */
-#define ManDirectoryRoot /usr/catman/u_man
diff --git a/src/config/moto.cf b/src/config/moto.cf
deleted file mode 100644
index 18356ac..0000000
--- a/src/config/moto.cf
+++ /dev/null
@@ -1,54 +0,0 @@
-/* $Id: moto.cf,v 1.1.1.1 1995/12/20 15:26:46 cernlib Exp $
- *
- * $Log: moto.cf,v $
- * Revision 1.1.1.1 1995/12/20 15:26:46 cernlib
- * X11R6 config files unmodified
- *
- *
- */
-XCOMM platform: $XConsortium: moto.cf,v 1.14 94/04/05 18:19:38 converse Exp $
-
-#if defined(MotoR3Architecture)
-
-#define OSName Motorola R32V2/R3V6.2
-#define OSMajorVersion 3
-#define OSMinorVersion 2
-
-#define SystemV YES
-#define BootstrapCFlags -DSYSV -DMOTOROLA
-#define StandardDefines -DSYSV -DUSG -DMOTOROLA
-#define Malloc0ReturnsNull YES
-#define BuildServer NO
-#define UseCCMakeDepend YES
-#define OptimizedCDebugFlags /* -O */
-
-#define DefaultUserPath :/bin:/usr/bin:$(BINDIR)
-#define DefaultSystemPath /etc:/bin:/usr/bin:$(BINDIR)
-
-#endif /* MotoR3Architecture */
-
-
-#if defined(MotoR4Architecture)
-
-#define OSName Motorola R40V4
-#define OSMajorVersion 4
-#define OSMinorVersion 4
-
-#define SystemV4 YES
-#define BootstrapCFlags -DSVR4 -DMOTOROLA
-#define StandardDefines -DSVR4 -DMOTOROLA
-#define BuildServer NO
-
-#define CppCmd /usr/ccs/lib/cpp
-#define LdCmd /usr/ccs/bin/ld
-#define LexCmd /usr/ccs/bin/lex
-#define MakeCmd /usr/ccs/bin/make
-#define YaccCmd /usr/ccs/bin/yacc
-#define CcCmd /bin/cc /* a front-end to gcc/CI5 */
-#define DefaultCCOptions /* -Xc no longer needed */
-
-#include <sv4Lib.rules>
-
-#endif /* MotoR4Architecture */
-
-XCOMM operating system: OSName
diff --git a/src/config/ncr.cf b/src/config/ncr.cf
deleted file mode 100644
index 6085c9e..0000000
--- a/src/config/ncr.cf
+++ /dev/null
@@ -1,123 +0,0 @@
-/* $Id: ncr.cf,v 1.2 2005/04/18 15:23:07 mclareni Exp $
- *
- * $Log: ncr.cf,v $
- * Revision 1.2 2005/04/18 15:23:07 mclareni
- * Mods submitted by Kevin B. McCarty to fix insecure Cernlib uses of /tmp.
- *
- * Revision 1.1.1.1 1995/12/20 15:26:42 cernlib
- * X11R6 config files unmodified
- *
- *
- */
-XCOMM platform: $XConsortium: ncr.cf,v 1.21 95/06/09 20:57:00 gildea Exp $
-#define OSName Unix System V Release 4/MP-RAS
-#define OSVendor NCR
-XCOMM operating system: OSName
-
-#define BootstrapCFlags -DNCR
-#define HasStreams YES
-#define XawI18nDefines -DUSE_XWCHAR_STRING
-
-/* Build Flags */
-
-#define StandardDefines -DSVR4 -DNCR -Di386 -DXML -DXI18N
-#define DefaultCCOptions -Xa -Hnocopyr -W0,-asm
-#define DefaultCDebugFlags -O3
-#define AllocateLocalDefines -DINCLUDE_ALLOCA_H
-#define ServerExtraDefines -DNO_SECONDARY AllocateLocalDefines XFree86ServerDefines
-#define ServerOSDefines -DDDXTIME XFree86ServerOSDefines
-#define ToolkitStringsABIOptions -intelabi
-
-XCOMM This has not been tested, don't turn it on yet.
-XCOMM #define ExtensionOSDefines -DXTESTEXT1
-
-#define ExtraLoadFlags -lc -L/usr/ucblib -lucb -lm -lgen -lcmd
-
-/* Setup proper ownership of installed files */
-
-#define StripInstalledPrograms YES
-#define InstPgmFlags -s -m 0755 -o bin -g bin
-#define InstBinFlags -m 0755 -o bin -g bin
-#define InstUidFlags -m 4755 -o root -g bin
-#define InstLibFlags -m 0644 -o bin -g bin
-#define InstIncFlags -m 0444 -o bin -g bin
-#define InstManFlags -m 0444 -o bin -g bin
-#define InstDatFlags -m 0444 -o bin -g bin
-
-/* Various Configuration settings */
-
-#define DefaultUserPath /bin:/sbin:/usr/bin:/usr/sbin:$(BINDIR):/usr/ucb
-#define DefaultSystemPath /etc:/bin:/usr/bin:/sbin:/usr/sbin:$(BINDIR):/usr/ucb
-#define ExtraFilesToClean *.z
-
-/* Create man pages properly */
-
-#define BookFormatManPages YES
-#define ManDirectoryRoot /usr/catman/X115
-#define ManSuffix 1X
-#define LibManSuffix 3X
-#define FileManSuffix 4X
-#define ManSourcePath $(MANPATH)/g
-#define XmanSearchPath /usr/catman
-
-#undef TblCmd
-#define TblCmd /usr/ucb/tbl
-#undef EqnCmd
-#define EqnCmd /usr/ucb/eqn
- COL = /usr/bin/col
- NEQN = /usr/ucb/neqn
- NROFF = /usr/ucb/nroff -Tlp
-
-/*
- * Man pages need to be formatted when installed, so override the default
- * imake rules.
- */
-#define InstallManPageLong(file,destdir,dest) @@\
-all:: file.z @@\
- @@\
-file.z:: file.man @@\
- @if [ -f file.man ]; \ @@\
- then \ @@\
- cat file.man | $(NEQN) | $(TBL) | $(NROFF) -man | $(COL) >file.$$$$.man; \ @@\
- $(RM) file.$$$$.man.z; \ @@\
- pack -f file.$$$$.man; \ @@\
- cp file.$$$$.man.z file.z; \ @@\
- $(RM) file.$$$$.man.z; \ @@\
- fi @@\
- @@\
-file.man:: @@\
- @@\
-install.man:: @@\
- MakeDir($(DESTDIR)destdir) @@\
- - at if [ -f file.z ]; \ @@\
- then \ @@\
- $(INSTALL) -c $(INSTMANFLAGS) file.z $(DESTDIR)destdir/dest.z; \@@\
- fi
-
-#define InstallMultipleManSuffix(list,dest,suff) @@\
-install.man:: @@\
- MakeDir($(DESTDIR)dest) @@\
- case '${MFLAGS}' in *[i]*) set +e;; esac; \ @@\
- for i in list; do \ @@\
- (set -x; \ @@\
- TMP=$(DESTDIR)dest/$$$$.suff ; \ @@\
- cat $$i.suff | $(NEQN) | $(TBL) | $(NROFF) -man | $(COL) >$${TMP}; \ @@\
- pack -f $${TMP}; \ @@\
- $(INSTALL) -c $(INSTMANFLAGS) $${TMP}.z $(DESTDIR)dest/$$i.z; \ @@\
- $(RM) $${TMP}.z); \ @@\
- done
-
-#define InstallMultipleMan(list,dest) @@\
- InstallMultipleManSuffix(list,dest,man)
-
-#define InstallManPageAliases(file,destdir,aliases) @@\
-install.man:: @@\
- @case '${MFLAGS}' in *[i]*) set +e;; esac; \ @@\
- for i in aliases; do \ @@\
- (set -x; \ @@\
- $(RM) $(DESTDIR)destdir/$$i.z;\ @@\
- (cd $(DESTDIR)destdir; $(LN) file.z $$i.z);\ @@\
- ); \ @@\
- done
-
-#include <svr4.cf>
diff --git a/src/config/nec.cf b/src/config/nec.cf
deleted file mode 100644
index bb43683..0000000
--- a/src/config/nec.cf
+++ /dev/null
@@ -1,103 +0,0 @@
-/* $Id: nec.cf,v 1.1.1.1 1995/12/20 15:26:43 cernlib Exp $
- *
- * $Log: nec.cf,v $
- * Revision 1.1.1.1 1995/12/20 15:26:43 cernlib
- * X11R6 config files unmodified
- *
- *
- */
-XCOMM platform: $XConsortium: nec.cf,v 1.2 94/04/11 21:18:22 rws Exp $
-
-#ifdef nec_ews_svr2
-# define NecCISCArchitecture
-#else /* !defined(nec_ews_svr2) */
-# if defined(nec_ews_svr4) || defined(_nec_ews_svr4) || defined(_nec_up)
-# define NecRISCArchitecture
-# else /* !(defined(nec_ews_svr4) || defined(_nec_ews_svr4) || defined(_nec_up)) */
-# ifdef SX
-# define NecSX3Architecture
-# else /* !defined(SX) */
-# ifdef _nec_ft
-# define NecFaultTolerantArchitecture
-# else /* !defined(_nec_ft) */
-# ifdef PC_UX
-# define NecPCArchitecture
-# endif /* PC_UX */
-# endif /* !defined(_nec_ft) */
-# endif /* !defined(SX) */
-# endif /* !(defined(nec_ews_svr4) || defined(_nec_ews_svr4) || defined(_nec_up)) */
-#endif /* !defined(nec_ews_svr2) */
-
-#ifdef NecCISCArchitecture
-#define OSName EWS-UX/V
-#define OSMajorVersion 10
-#define OSMinorVersion 1
-#define HasSharedLibraries NO
-#define HasVoidSignalReturn NO
-#define HasSockets YES
-#define SystemV YES
-#define StandardDefines -Dnec_ews -Dnec_ews_svr2 -DUSG -DSYSV
-#define StandardCppDefines -Dnec_ews -Dnec_ews_svr2 -DUSG -DSYSV
-#define LnCmd ln -s
- LEXOPTION = -j
-#endif
-
-#ifdef NecRISCArchitecture
-# ifdef _nec_up
-#define OSName UP-UX/V
-#define OSMajorVersion 5
-#define OSMinorVersion 1
-# else
-#define OSName EWS-UX/V\(Rel4.2\)
-#define OSMajorVersion 9
-#define OSMinorVersion 1
-# endif
-#define HasSharedLibraries YES
-#define HasVoidSignalReturn YES
-#define SystemV4 YES
-#define HasSockets YES
-#endif
-
-#ifdef NecSX3Architecture
-#define OSName SUPER-UX
-#define OSMajorVersion 3
-#define OSMinorVersion 1
-#define SystemV YES
-#define HasSharedLibraries NO
-#define HasVoidSignalReturn YES
-#endif
-
-#ifdef NecFaultTolerantArchitecture
-#define OSName FT-UX/V
-#define OSMajorVersion 5
-#define OSMinorVersion 1
-#define HasSharedLibraries YES
-#define HasVoidSignalReturn YES
-#define SystemV4 YES
-#define HasSockets YES
-#endif
-
-#ifdef NecPCArchitecture
-#define OSName PC-UX/V
-#define OSMajorVersion 3
-#define OSMinorVersion 1
-#define HasSharedLibraries NO
-#define HasVoidSignalReturn NO
-#define SystemV YES
-#endif
-
-#define HasSaberC NO /* for machines that have it */
-#define HasGcc NO
-#define HasBsearch YES
-
-#define DefaultCCOptions -Wf,-XNp9000,-XNd6000
-#define ExtraLibraries -lsocket -lnsl -lw
-
-#define BuildServer NO
-/* #define InstallCmd $(INS) */
-#define RemoveTargetProgramByMoving YES
-
-#include <necLib.rules>
-
-#define LibraryCCOptions DefaultCCOptions
-#define LibraryDefines StandardDefines
diff --git a/src/config/necLib.rules b/src/config/necLib.rules
deleted file mode 100644
index e71916c..0000000
--- a/src/config/necLib.rules
+++ /dev/null
@@ -1,111 +0,0 @@
-/* $Id: necLib.rules,v 1.1.1.1 1995/12/20 15:26:42 cernlib Exp $
- *
- * $Log: necLib.rules,v $
- * Revision 1.1.1.1 1995/12/20 15:26:42 cernlib
- * X11R6 config files unmodified
- *
- *
- */
-XCOMM $XConsortium: necLib.rules,v 1.2 94/04/11 21:17:09 rws Exp $
-
-/*
- * NECOS shared library rules
- */
-
-#ifndef HasSharedLibraries
-#define HasSharedLibraries YES
-#endif
-#ifndef SharedDataSeparation
-#define SharedDataSeparation YES
-#endif
-#ifndef SharedCodeDef
-#define SharedCodeDef
-#endif
-#ifndef SharedLibraryDef
-#define SharedLibraryDef
-#endif
-#ifndef ShLibIncludeFile
-#define ShLibIncludeFile <necLib.tmpl>
-#endif
-#ifndef SharedLibraryLoadFlags
-#define SharedLibraryLoadFlags
-#endif
-#ifndef PositionIndependentCFlags
-#define PositionIndependentCFlags
-#endif
-
-
-#ifndef SeparateSharedCompile
-#define SeparateSharedCompile NO
-#endif
-
-#define SharedLibObjCompile(options) $(_NULLCMD_)
-
-/*
- * InstallSharedLibrary - generate rules to install the shared library.
- */
-#ifndef InstallSharedLibrary
-#define InstallSharedLibrary(libname,rev,dest) @@\
-install:: Concat(lib,libname.so.rev) @@\
- MakeDir($(DESTDIR)dest) @@\
- $(INSTALL) -c $(INSTLIBFLAGS) Concat(lib,libname.so.rev) $(DESTDIR)dest @@\
- $(LN) $(DESTDIR)dest/Concat(lib,libname.so.rev) $(DESTDIR)dest/Concat(lib,libname.so) @@\
-
-#endif /* InstallSharedLibrary */
-
-/*
- * InstallSharedLibraryData - generate rules to install the shared library data
- */
-#ifndef InstallSharedLibraryData
-#define InstallSharedLibraryData(libname,rev,dest) @@\
-install:: Concat(lib,libname.sa.rev) @@\
- MakeDir($(DESTDIR)dest) @@\
- $(INSTALL) -c $(INSTLIBFLAGS) Concat(lib,libname.sa.rev) $(DESTDIR)dest @@\
- RanLibrary($(RANLIBINSTFLAGS) Concat($(DESTDIR)dest/lib,libname.sa.rev))
-
-#endif /* InstallSharedLibraryData */
-
-/*
- * NormalSharedLibraryTarget - generate rules to create a shared library;
- * build it into a different name so that the we do not hose people by having
- * the library gone for long periods.
- */
-#ifndef SharedLibraryTarget
-#define SharedLibraryTarget(libname,rev,solist,down,up) @@\
-AllTarget(Concat(lib,libname.so.rev)) @@\
- @@\
-Concat(lib,libname.so.rev): solist @@\
- $(RM) $@~ @@\
- $(CC) -G -o $@~ $(SHLIBLDFLAGS) solist @@\
- $(RM) $@ @@\
- $(MV) $@~ $@ @@\
- @@\
-AllTarget(Concat(lib,libname.so)) @@\
- @@\
-Concat(lib,libname.so): Concat(lib,libname.so.rev) @@\
- $(RM) $@ @@\
- $(LN) $? $@ @@\
- LinkBuildLibrary($@) @@\
- LinkBuildLibrary(Concat(lib,libname.so)) @@\
- @@\
-clean:: @@\
- $(RM) Concat(lib,libname.so.rev)
-
-#endif /* SharedLibraryTarget */
-
-/*
- * SharedLibraryDataTarget - generate rules to create shlib data file;
- */
-#ifndef SharedLibraryDataTarget
-#define SharedLibraryDataTarget(libname,rev,salist) @@\
-AllTarget(Concat(lib,libname.sa.rev)) @@\
- @@\
-Concat(lib,libname.sa.rev): salist @@\
- $(RM) $@ @@\
- $(AR) $@ salist @@\
- RanLibrary($@) @@\
- @@\
-clean:: @@\
- $(RM) Concat(lib,libname.sa.rev)
-
-#endif /* SharedLibraryDataTarget */
diff --git a/src/config/necLib.tmpl b/src/config/necLib.tmpl
deleted file mode 100644
index 5225f1e..0000000
--- a/src/config/necLib.tmpl
+++ /dev/null
@@ -1,37 +0,0 @@
-/* $Id: necLib.tmpl,v 1.1.1.1 1995/12/20 15:26:44 cernlib Exp $
- *
- * $Log: necLib.tmpl,v $
- * Revision 1.1.1.1 1995/12/20 15:26:44 cernlib
- * X11R6 config files unmodified
- *
- *
- */
-XCOMM $XConsortium: necLib.tmpl,v 1.1 94/03/26 18:15:22 rws Exp $
-
-/*
- * NEC shared library template
- */
-
-#ifndef SharedXlibRev
-#define SharedXlibRev 4.10
-#endif
-#ifndef SharedOldXRev
-#define SharedOldXRev 4.10
-#endif
-#ifndef SharedXtRev
-#define SharedXtRev 4.10
-#endif
-#ifndef SharedXawRev
-#define SharedXawRev 5.0
-#endif
-#ifndef SharedXmuRev
-#define SharedXmuRev 4.10
-#endif
-#ifndef SharedXextRev
-#define SharedXextRev 4.10
-#endif
-#ifndef SharedXinputRev
-#define SharedXinputRev 4.10
-#endif
-
-#include <sv4Lib.tmpl>
diff --git a/src/config/noop.rules b/src/config/noop.rules
deleted file mode 100644
index 269928e..0000000
--- a/src/config/noop.rules
+++ /dev/null
@@ -1,17 +0,0 @@
-/* $Id: noop.rules,v 1.4 1996/11/15 14:15:59 cernlib Exp $
- *
- * $Log: noop.rules,v $
- * Revision 1.4 1996/11/15 14:15:59 cernlib
- * cvsroot NOW set!
- *
- * Revision 1.3 1996/11/15 14:15:06 cernlib
- * no cvsroot set!
- *
- * Revision 1.2 1996/11/14 17:28:05 cernlib
- * test check in, no change done
- *
- * Revision 1.1.1.1 1995/12/20 15:26:44 cernlib
- * X11R6 config files unmodified
- *
- *
- */
diff --git a/src/config/oldlib.rules b/src/config/oldlib.rules
deleted file mode 100644
index 6adf895..0000000
--- a/src/config/oldlib.rules
+++ /dev/null
@@ -1,117 +0,0 @@
-/* $Id: oldlib.rules,v 1.1.1.1 1995/12/20 15:26:47 cernlib Exp $
- *
- * $Log: oldlib.rules,v $
- * Revision 1.1.1.1 1995/12/20 15:26:47 cernlib
- * X11R6 config files unmodified
- *
- *
- */
-/* You should not use these any more, use new Library.tmpl insead */
-
-XCOMM $XConsortium: oldlib.rules,v 1.2 91/04/09 19:15:13 rws Exp $
-
-/*
- * ProfiledLibraryObjectRule - generate make rules to build both profiled
- * and "normal" objects.
- */
-#ifndef ProfiledLibraryObjectRule
-#define ProfiledLibraryObjectRule() @@\
-all:: @@\
- LibMkdir(profiled) @@\
- @@\
-.c.o: @@\
- ProfiledLibObjCompile(NullParameter) @@\
- NormalLibObjCompile(NullParameter) @@\
- @@\
-clean:: @@\
- LibCleanDir(profiled) @@\
-
-#endif /* ProfiledLibraryObjectRule */
-
-
-/*
- * DebuggedLibraryObjectRule - generate make rules to build both debuggable
- * and "normal" objects.
- */
-#ifndef DebuggedLibraryObjectRule
-#define DebuggedLibraryObjectRule() @@\
-all:: @@\
- LibMkdir(debugger) @@\
- @@\
-.c.o: @@\
- DebuggedLibObjCompile(NullParameter) @@\
- NormalLibObjCompile(NullParameter) @@\
- @@\
-clean:: @@\
- LibCleanDir(debugger) @@\
-
-#endif /* DebuggedLibraryObjectRule */
-
-
-/*
- * DebuggedAndProfiledLibraryOjbectRule - generate make rules to build
- * debuggable, profiled, and "normal" objects.
- */
-#ifndef DebuggedAndProfiledLibraryObjectRule
-#define DebuggedAndProfiledLibraryObjectRule() @@\
-all:: @@\
- LibMkdir(profiled) @@\
- LibMkdir(debugger) @@\
- @@\
-.c.o: @@\
- ProfiledLibObjCompile(NullParameter) @@\
- DebuggedLibObjCompile(NullParameter) @@\
- NormalLibObjCompile(NullParameter) @@\
- @@\
-clean:: @@\
- LibCleanDir(profiled) @@\
- LibCleanDir(debugger) @@\
-
-#endif /* DebuggedAndProfiledLibraryObjectRule */
-
-
-/*
- * SpecialProfiledObjectRule - generate rules to compile a file with special
- * flags and to make a profiled version.
- */
-#ifndef SpecialProfiledObjectRule
-#define SpecialProfiledObjectRule(objs,depends,options) @@\
-all:: @@\
- LibMkdir(profiled) @@\
- @@\
-objs: depends @@\
- ProfiledLibObjCompile(options) @@\
- NormalLibObjCompile(options)
-#endif /* SpecialProfiledObjectRule */
-
-
-/*
- * SpecialDebuggedObjectRule - generate rules to compile a file with special
- * flags and to make a debuggable version.
- */
-#ifndef SpecialDebuggedObjectRule
-#define SpecialDebuggedObjectRule(objs,depends,options) @@\
-all:: @@\
- LibMkdir(debugger) @@\
- @@\
-objs: depends @@\
- DebuggedLibObjCompile(options) @@\
- NormalLibObjCompile(options)
-#endif /* SpecialDebuggedObjectRule */
-
-
-/*
- * SpecialDebuggedAndProfiledObjectRule - generate rules to compile a file
- * with special flags and to make debuggable and profiled versions.
- */
-#ifndef SpecialDebuggedAndProfiledObjectRule
-#define SpecialDebuggedAndProfiledObjectRule(objs,depends,options) @@\
-all:: @@\
- LibMkdir(profiled) @@\
- LibMkdir(debugger) @@\
- @@\
-objs: depends @@\
- ProfiledLibObjCompile(options) @@\
- DebuggedLibObjCompile(options) @@\
- NormalLibObjCompile(options)
-#endif /* SpecialDebuggedAndProfiledObjectRule */
diff --git a/src/config/osf1.cf b/src/config/osf1.cf
deleted file mode 100644
index 8a7c911..0000000
--- a/src/config/osf1.cf
+++ /dev/null
@@ -1,164 +0,0 @@
-/* $Id: osf1.cf,v 1.13 2001/09/21 16:04:34 mclareni Exp $
- *
- * $Log: osf1.cf,v $
- * Revision 1.13 2001/09/21 16:04:34 mclareni
- * Add CcLinkCmd definition to prevent the -shared option which is required for compiling
- *
- * Revision 1.12 2001/09/17 12:48:53 mclareni
- * Add f77 option -check nopower, mainly to allow (-y)**2.0 in Comis, as most other compilers do.
- *
- * Revision 1.11 2001/02/14 17:10:37 mclareni
- * With Dunix V4.0 1229 (4.0F) the C compiler cc now supports the -shared option.
- *
- * Revision 1.10 2000/05/16 16:08:12 mclareni
- * Separate the Fortran compile and link commands, as the -shared option kills linking
- *
- * Revision 1.9 1999/03/16 16:10:31 mclareni
- * Add f77 option -shared for position independent code
- *
- * Revision 1.8 1998/02/09 15:29:20 mclareni
- * The mathlib routines cwhitm64, nzerfz64, wclbes do not compile on DGUX with -fpe4; changes to enable this
- *
- * Revision 1.7 1998/01/09 15:18:38 mclareni
- * For the f77 default options select -fpe4 and remove -math_library fast
- *
- * Revision 1.6 1996/03/08 17:12:13 cernlib
- * *** empty log message ***
- *
- * Revision 1.5 1996/03/06 11:04:20 cernlib
- * Imake.tmpl : Correct rule to run kuipc
- * fortran.rules: echo makedepend
- * site.def: undef MakeCmd before #define ( Sun has this defined to ..openwin...)
- * *.cf : small mods
- *
- * Revision 1.4 1996/03/04 17:30:57 cernlib
- * Parametrize Ansi C compiel options. other small mods
- *
- * Revision 1.3 1996/02/29 10:38:56 cernlib
- * Add DoIncludePackage to Imake.rules
- * Correct compiel options in osf1.cf,sun.cf
- *
- * Revision 1.2 1995/12/21 11:32:28 cernlib
- * Imake files end 1995
- *
- * Revision 1.1.1.1 1995/12/20 15:26:42 cernlib
- * X11R6 config files unmodified
- *
- *
- */
-XCOMM platform: $XConsortium: osf1.cf,v 1.42.1.1 94/09/15 20:41:35 kaleb Exp $
-/* only tested with Digital OSF/1 */
-
-#ifdef AlphaArchitecture
-#define OSName OSF/1 1.3
-XCOMM operating system: OSName
-#define OSMajorVersion 1
-#define OSMinorVersion 3
-#else
-#define OSName OSF/1 1.0
-XCOMM operating system: OSName
-#define OSMajorVersion 1
-#define OSMinorVersion 0
-#endif
-
-#define HasPutenv YES
-#define Malloc0ReturnsNull YES
-#define HasNdbm YES
-#define HasShm YES
-#define AvoidNullMakeCommand YES
-#define HasPosixThreads YES
-#define SystemMTDefines -D_REENTRANT
-#define HasPoll YES
-#define HasVFork NO
-#define InstallCmd installbsd
-/* this just touches the file urghhh GF.
- * #define RanlibCmd ranlib -t
- */
-#if OSMajorVersion > 1 || OSMinorVersion > 0
-#define ModernOSF1 YES
-#else
-#define ModernOSF1 NO
-#define ShLibDir /usr/shlib
-#define SharedLibPex NO /* losing, no shared -lm */
-#endif
-#define ThreadedX ModernOSF1
-
-#if ThreadedX
-#define ThreadsLibraries -lpthreads -lmach -lc_r
-#endif
-
-/*
- * C++ compiler setup. This file knows what options to use with the
- * DEC C++ compiler, and may learn about other compilers in the future.
- *
- * For DEC C++, define HasDECCplusplus to YES in site.def.
- * For other compilers, define HasCplusplus to YES in site.def, and
- * check to see if you need to provide values for CplusplusOptions
- * and/or DefaultCplusplusOptions.
- *
- * In any case, you may also need to set CplusplusDependIncludes.
- *
- * NOTE: For DEC C++ version 1.3, we want to set ForceNormalLib
- * to YES because no one has managed to get the C++ compiler
- * to either build or link with shared libraries, and DEC has
- * not been able to tell us how to do it.
- */
-
-#if HasDECCplusplus
-#ifndef HasCplusplus
-#define HasCplusplus YES
-#endif
-#ifndef SharedLibFresco
-#define SharedLibFresco NO
-#endif
-#ifndef SharedLibXtf
-#define SharedLibXtf NO
-#endif
-#ifndef CplusplusCmd
-#define CplusplusCmd /usr/bin/cxx
-#endif
-#ifndef CplusplusDependIncludes
-#define CplusplusDependIncludes -D__DECCXX -I/usr/include/cxx
-#endif
-#ifndef CplusplusLibC
-#define CplusplusLibC -L/usr/lib/cmplrs/cxx -lcxx
-#endif
-#ifndef ForceNormalLib
-#define ForceNormalLib YES
-#endif
-#endif /* HasDECCplusplus */
-
-#include <osfLib.rules>
-#define NoRConst YES
-
-#ifdef AlphaArchitecture
-#define HasWChar32 YES
-/* GF.
- * #define DefaultCCOptions -std1
- */
-#define XawI18nDefines -DHAS_WCHAR_H
-#define BuildServer NO
-#endif
-#ifdef MipsArchitecture
-#define DefaultCCOptions -Xc
-#define XdecServer YES
-#define ServerOSDefines -DDDXTIME
-#define PexCCOptions -Xc -Wf,-XNp15000,-XNd15000
-#define NormalLibObjCompile(options) $(RM) $@ $*.os \ @@\
- && $(CC) -c options $(CFLAGS) $*.c \ @@\
- && $(LD) $(LDSTRIPFLAGS) -r $@ -o $*.os \ @@\
- && $(MV) $*.os $@
-#endif
-
-#define CcCmd cc -shared
-#define CcLinkCmd cc
-#define FortranCmd f77 -shared
-#define FortranLinkCmd f77
-#define DefaultFCOptions
-#define OptimisedFortranFlags -O -fpe4 -check nopower
-#define FortranNoSaveFlags -automatic
-
-#define CernlibSystem -DCERNLIB_QMVAOS -DCERNLIB_DECS -DCERNLIB_UNIX
-#define CERNLIB_QMVAOS
-#define CERNLIB_DECS
-#define CERNLIB_UNIX
diff --git a/src/config/osfLib.rules b/src/config/osfLib.rules
deleted file mode 100644
index 43c1584..0000000
--- a/src/config/osfLib.rules
+++ /dev/null
@@ -1,123 +0,0 @@
-/* $Id: osfLib.rules,v 1.1.1.1 1995/12/20 15:26:45 cernlib Exp $
- *
- * $Log: osfLib.rules,v $
- * Revision 1.1.1.1 1995/12/20 15:26:45 cernlib
- * X11R6 config files unmodified
- *
- *
- */
-XCOMM $XConsortium: osfLib.rules,v 1.9 94/01/18 14:58:49 rws Exp $
-
-/*
- * OSF/1 shared library rules
- */
-
-#ifndef HasSharedLibraries
-#define HasSharedLibraries YES
-#endif
-#ifndef SeparateSharedCompile
-#define SeparateSharedCompile NO
-#endif
-#ifndef SharedDataSeparation
-#define SharedDataSeparation NO
-#endif
-#ifndef SharedCodeDef
-#define SharedCodeDef /**/
-#endif
-#ifndef SharedLibraryDef
-#define SharedLibraryDef /**/
-#endif
-#ifndef ShLibIncludeFile
-#define ShLibIncludeFile <osfLib.tmpl>
-#endif
-#ifndef SharedLibraryLoadFlags
-#if ModernOSF1
-#define SharedLibraryLoadFlags -shared -no_archive -rpath $(USRLIBDIR)
-#else
-#define SharedLibraryLoadFlags -shared -no_archive
-#endif
-#endif
-#ifndef PositionIndependentCFlags
-#define PositionIndependentCFlags /**/
-#endif
-
-/*
- * InstallSharedLibrary - generate rules to install the shared library.
- */
-#ifndef InstallSharedLibrary
-#define InstallSharedLibrary(libname,rev,dest) @@\
-install:: Concat(lib,libname.so.rev) @@\
- MakeDir($(DESTDIR)dest) @@\
- $(INSTALL) $(INSTALLFLAGS) $(INSTLIBFLAGS) Concat(lib,libname.so.rev) $(DESTDIR)dest @@\
- $(RM) Concat($(DESTDIR)dest/lib,libname.so) @@\
- $(LN) Concat(lib,libname.so.rev) Concat($(DESTDIR)dest/lib,libname.so)
-
-#endif /* InstallSharedLibrary */
-
-/*
- * InstallSharedLibraryData - generate rules to install the shared library data
- */
-#ifndef InstallSharedLibraryData
-#define InstallSharedLibraryData(libname,rev,dest)
-#endif /* InstallSharedLibraryData */
-
-#ifndef PackageName(libname)
-#if ModernOSF1
-#define PackageName(libname) /**/
-#else
-#define PackageName(libname) -package libname
-#endif
-#endif
-#if ThreadedX && ModernOSF1
-#define BaseShLibReqs -lc_r -lc
-#else
-#define BaseShLibReqs -lc
-#endif
-
-/*
- * SharedLibraryTarget - generate rules to create a shared library;
- * build it into a different name so that we do not hose people by having
- * the library gone for long periods.
- */
-#ifndef SharedLibraryTarget
-#if SeparateSharedCompile
-#define SharedLibraryTarget(libname,rev,solist,down,up) @@\
-AllTarget(Concat(lib,libname.so.rev)) @@\
- @@\
-Concat(lib,libname.so.rev): solist @@\
- $(RM) $@~ @@\
- (cd down; $(LD) -o up/$@~ $(SHLIBLDFLAGS) PackageName($@) -soname $@ solist $(REQUIREDLIBS) BaseShLibReqs) @@\
- $(RM) $@ @@\
- $(MV) $@~ $@ @@\
- $(RM) Concat(lib,libname.so) @@\
- $(LN) $@ Concat(lib,libname.so) @@\
- LinkBuildLibrary($@) @@\
- LinkBuildLibrary(Concat(lib,libname.so)) @@\
- @@\
-clean:: @@\
- $(RM) Concat(lib,libname.so.rev) Concat(lib,libname.so)
-#else
-#define SharedLibraryTarget(libname,rev,solist,down,up) @@\
-AllTarget(Concat(lib,libname.so.rev)) @@\
- @@\
-Concat(lib,libname.so.rev): solist @@\
- $(RM) $@~ @@\
- $(LD) -o $@~ $(SHLIBLDFLAGS) PackageName($@) -soname $@ solist $(REQUIREDLIBS) BaseShLibReqs @@\
- $(RM) $@ @@\
- $(MV) $@~ $@ @@\
- $(RM) Concat(lib,libname.so) @@\
- $(LN) $@ Concat(lib,libname.so) @@\
- LinkBuildLibrary($@) @@\
- LinkBuildLibrary(Concat(lib,libname.so)) @@\
- @@\
-clean:: @@\
- $(RM) Concat(lib,libname.so.rev) Concat(lib,libname.so)
-#endif /* SeparateSharedCompile */
-#endif /* SharedLibraryTarget */
-
-/*
- * SharedLibraryDataTarget - generate rules to create shlib data file;
- */
-#ifndef SharedLibraryDataTarget
-#define SharedLibraryDataTarget(libname,rev,salist)
-#endif /* SharedLibraryTarget */
diff --git a/src/config/osfLib.tmpl b/src/config/osfLib.tmpl
deleted file mode 100644
index abff3f7..0000000
--- a/src/config/osfLib.tmpl
+++ /dev/null
@@ -1,41 +0,0 @@
-/* $Id: osfLib.tmpl,v 1.1.1.1 1995/12/20 15:26:43 cernlib Exp $
- *
- * $Log: osfLib.tmpl,v $
- * Revision 1.1.1.1 1995/12/20 15:26:43 cernlib
- * X11R6 config files unmodified
- *
- *
- */
-XCOMM $XConsortium: osfLib.tmpl,v 1.18 94/06/03 21:38:46 matt Exp $
-
-/*
- * OSF/1 shared library template
- */
-
-#if ThreadedX && ModernOSF1
-#define SharedX11Reqs -lpthreads -lmach
-#endif
-#define SharedOldXReqs $(LDPRELIB) $(XLIBONLY)
-
-#if ThreadedX && ModernOSF1
-#define SharedXtReqs $(LDPRELIB) $(XLIBONLY) $(SMLIB) $(ICELIB) -lpthreads -lmach
-#else
-#define SharedXtReqs $(LDPRELIB) $(XLIBONLY) $(SMLIB) $(ICELIB)
-#endif
-#define SharedXawReqs $(LDPRELIB) $(XMULIB) $(XTOOLLIB) $(XLIB) -init _XawFixupVendorShell
-#define SharedXmuReqs $(LDPRELIB) $(XTOOLLIB) $(XLIB)
-#define SharedXextReqs $(LDPRELIB) $(XLIBONLY)
-#define SharedXiReqs $(LDPRELIB) $(XLIB)
-#define SharedPexReqs $(LDPRELIB) $(XLIBONLY) MathLibrary
-#define SharedXtstReqs $(LDPRELIB) $(XLIB)
-#define SharedXieReqs $(LDPRELIB) $(XLIBONLY)
-#define SharedSMReqs $(LDPRELIB) $(ICELIB)
-
-#if ThreadedX && ModernOSF1
-#define FrescoSysLibs -lpthreads -lmach CplusplusLibC MathLibrary
-#else
-#define FrescoSysLibs CplusplusLibC MathLibrary
-#endif
-
-#define SharedFrescoReqs $(LDPRELIB) $(XLIBONLY) FrescoSysLibs
-#define SharedXtfReqs $(LDPRELIB) $(FRESCOLIB) $(XTOOLLIB) $(XLIB) FrescoSysLibs
diff --git a/src/config/pegasus.cf b/src/config/pegasus.cf
deleted file mode 100644
index b5461b2..0000000
--- a/src/config/pegasus.cf
+++ /dev/null
@@ -1,36 +0,0 @@
-/* $Id: pegasus.cf,v 1.1.1.1 1995/12/20 15:26:43 cernlib Exp $
- *
- * $Log: pegasus.cf,v $
- * Revision 1.1.1.1 1995/12/20 15:26:43 cernlib
- * X11R6 config files unmodified
- *
- *
- */
-XCOMM platform: $XConsortium: pegasus.cf,v 1.36 94/02/10 12:16:24 rws Exp $
-
-#define OSName UTek 4.0
-XCOMM operating system: OSName
-#define OSMajorVersion 4
-#define OSMinorVersion 0
-
-#define HasNdbm YES
-#define HasVoidSignalReturn NO
-
-#define BootstrapCFlags -DM4310 -DUTEK
-#define StandardDefines -DM4310 -DUTEK -Dpegasus
-
-#if HasGcc
-/* put back all of the -Ds which -ansi removes */
-#define CcCmd gcc -ansi -fstrength-reduce -fpcc-struct-return -Dmc68000 -Dtektronix -Dutek -Dunix -Dm68k
-#endif
-
-#define BuildServer NO
-/* #define XtekServer YES */
-
-#define ServerExtraDefines -DM4310 -DM4317
-#define ServerOSDefines -DDDXTIME
-#define FontFilters BDFTOSNFFILT SHELLPATH
-#define PrimaryScreenResolution 95
-
-.DIRECTORIES: /* Turn off directory search for RCS */
-
diff --git a/src/config/rtcchack.bac b/src/config/rtcchack.bac
deleted file mode 100644
index 509ed02..0000000
--- a/src/config/rtcchack.bac
+++ /dev/null
@@ -1,23 +0,0 @@
-/* $Id: rtcchack.bac,v 1.1.1.1 1995/12/20 15:26:42 cernlib Exp $
- *
- * $Log: rtcchack.bac,v $
- * Revision 1.1.1.1 1995/12/20 15:26:42 cernlib
- * X11R6 config files unmodified
- *
- *
- */
-/* High C version 1.4r absolutely will not support the XtOffset
- macro as defined by the Intrinsics, nor have we been able to
- find a suitable workaround, even using the builtin _offsetof().
- */
-
-#undef AllTarget
-#define AllTarget(depends) @@\
-all:: @@\
- @$(MAKE) $(MFLAGS) CC=$(PCC) CDEBUGFLAGS=$(CDEBUGFLAGS) dummy \ @@\
- `grep -w -l XtOffset *.c | sed -e 's/\(.*\).c$$/\1.o/'` @@\
- @$(MAKE) $(MFLAGS) CC=$(CC) CDEBUGFLAGS=$(CDEBUGFLAGS) everything @@\
- @@\
-everything:: depends @@\
- @@\
-dummy::
diff --git a/src/config/sequent.cf b/src/config/sequent.cf
deleted file mode 100644
index d875e07..0000000
--- a/src/config/sequent.cf
+++ /dev/null
@@ -1,77 +0,0 @@
-/* $Id: sequent.cf,v 1.1.1.1 1995/12/20 15:26:44 cernlib Exp $
- *
- * $Log: sequent.cf,v $
- * Revision 1.1.1.1 1995/12/20 15:26:44 cernlib
- * X11R6 config files unmodified
- *
- *
- */
-XCOMM platform: $XConsortium: sequent.cf,v 1.1 94/02/04 21:35:31 rws Exp $
-/*
- * SET VERSION NUMBERS BEFORE MAKING MAKEFILES; also, you'll need to install
- * util/scripts/bsdinstall.sh before doing a "make install"
- */
-
-#if defined(DynixPtxArchitecture) || defined(_SEQUENT_)
-
-#define OSName Dynix/ptx
-#define OSMajorVersion 2
-#define OSMinorVersion 0
-
-#define SystemV YES
-#define SymbolTableFlags
-#define DefaultCCOptions SymbolTableFlags
-#define SharedLibraryCCOptions DefaultCCOptions
-#define StandardDefines -DSYSV
-#define MotifDefines -DSTRINGS_ALIGNED -DNO_REGCOMP
-#define ExtraLibraries $(XBSDLIB) -lsocket -linet -lnsl -lseq
-#define XmExtraLibraries -lgen
-
-#define NeedBerklib YES
-#define HasShadowPasswd YES
-#define InstallXdmConfig YES
-#define HasSockets YES
-
-/*
- * Plan to remove Prototypes defines and use -Xc with
- * Dynix/ptx:
- * OSMajorVersion=4
- * OSMinorVersion=0
- * Using -Xc with Version 4.0 will elliminate most warnings
- */
-#define NeedFunctionPrototypes YES
-#define NeedNestedPrototypes YES
-#define NeedConstPrototypes YES
-#define NeedVarargsPrototypes YES
-
-
-/*
- * unfortunately pbmplus uses this...
- */
-RANLIB = :
-
-#endif /* defined(DynixPtxArchitecture) || defined(_SEQUENT_) */
-
-#if defined(Dynix3Architecture) || defined(sequent)
-
-#define OSName Dynix 3
-#define OSMajorVersion 3
-#define OSMinorVersion 2
-
-#define SymbolTableFlags -W0,-Nn7500 -W0,-Nd10000
-#define DefaultCCOptions SymbolTableFlags
-#define StandardDefines -DX_NOT_STDC_ENV -DX_NOT_POSIX
-#define ExtraLibraries -lseq
-
-#define HasVoidSignalReturn NO
-#define HasBsearch NO
-
-#define SetTtyGroup YES
-
-#endif /* defined(Dynix3Architecture) || defined(sequent) */
-
-#define BuildServer NO
-#define BuildXInputLib NO
-#define BuildPexClients NO
-
-#define LnCmd ln -s
diff --git a/src/config/sgi.cf b/src/config/sgi.cf
deleted file mode 100644
index 83d7734..0000000
--- a/src/config/sgi.cf
+++ /dev/null
@@ -1,197 +0,0 @@
-/* $Id: sgi.cf,v 1.16 2001/04/04 14:46:32 mclareni Exp $
- *
- * $Log: sgi.cf,v $
- * Revision 1.16 2001/04/04 14:46:32 mclareni
- * SGI cc does not have a -static option
- *
- * Revision 1.15 1999/11/19 09:17:37 mclareni
- * Add -static to the Fortran and C default options
- *
- * Revision 1.14 1999/03/09 13:46:34 cernsoft
- * For SGI 6.5 set -mips3 for portability
- *
- * Revision 1.12 1998/01/22 16:14:57 mclareni
- * Introduce cpp flag CERNLIB_QMIRIX64 for IRIX64 systems
- *
- * Revision 1.11 1998/01/09 17:03:03 mclareni
- * Add options for Irix 6.4, keeping 5.3 as Pre64
- *
- * Revision 1.10 1996/05/15 13:40:32 cernlib
- * Comment ExtraLibraries, such that we don't put -lmalloc ... before cernlib
- *
- * Revision 1.9 1996/05/09 14:30:55 cernlib
- * use xargs as XargsCmd
- *
- * Revision 1.8 1996/05/01 11:56:59 cernlib
- * make possible to split cpp from f77 on sgi
- *
- * Revision 1.7 1996/04/11 15:23:17 cernlib
- * Add possiblity to build optimised for mips2
- *
- * Revision 1.6 1996/03/08 17:12:14 cernlib
- * *** empty log message ***
- *
- * Revision 1.5 1996/03/06 11:04:21 cernlib
- * Imake.tmpl : Correct rule to run kuipc
- * fortran.rules: echo makedepend
- * site.def: undef MakeCmd before #define ( Sun has this defined to ..openwin...)
- * *.cf : small mods
- *
- * Revision 1.4 1996/03/04 17:31:00 cernlib
- * Parametrize Ansi C compiel options. other small mods
- *
- * Revision 1.3 1996/02/12 14:21:31 cernlib
- * a library now depends (indirectly) on all the objects therein
- *
- * Revision 1.2 1995/12/21 11:32:33 cernlib
- * Imake files end 1995
- *
- * Revision 1.1.1.1 1995/12/20 15:26:43 cernlib
- * X11R6 config files unmodified
- *
- *
- */
-XCOMM platform: $XConsortium: sgi.cf,v 1.43 94/06/03 21:38:45 matt Exp $
-
-#define OSName IRIX 6.5
-XCOMM operating system: OSName
-#define OSMajorVersion 6
-#define OSMinorVersion 5
-#define OSTeenyVersion 0
-
-#if OSMajorVersion < 4
-/* We do not guarantee this will work */
-#define BootstrapCFlags -DX_WCHAR -DX_LOCALE -DX_USEBFUNCS -DSYSV
-#define StandardDefines -DX_WCHAR -DX_LOCALE -DX_USEBFUNCS -DSYSV
-#endif
-
-#define SystemV YES
-#define HasPutenv YES
-#define ExecableScripts YES
-#if OSMajorVersion > 3
-#define SetTtyGroup YES
-#else
-#define SetTtyGroup NO
-#endif
-#define HasNdbm YES
-#define HasPoll YES
-#define Malloc0ReturnsNull YES
-#define ExpandManNames YES
-#define BuildXInputExt YES
-
-#if OSMajorVersion > 3 || (OSMajorVersion == 3 && OSMinorVersion > 2)
-#define NeedVarargsPrototypes YES
-#define NeedConstPrototypes YES
-#define NeedWidePrototypes NO
-#endif
-
-#if OSMajorVersion > 4
-#define HasWChar32 YES
-#define XawI18nDefines -DHAS_WCTYPE_H
-#endif
-
-/* Extra libraries provide : yp, sysV malloc, shared libc, and widechar */
-/*#define ExtraLibraries -lsun -lmalloc -lc_s -lw */
-
-/* #include <sgiLib.rules> */
-
-#define SymbolTables -Wf,-XNp9000,-XNd8000,-XNh2000
-#define PexSymbolTables -Wf,-XNp15000,-XNd15000,-XNh2000
-#define ServerSymbolTables -Wf,-XNp8000,-XNh2000,-XNd8000
-
-/* this is for floating point, ANSI cpp */
-#define sgiCCOptions -xansi -D__STDC__=1 -float
-#define DefaultCCOptions sgiCCOptions SymbolTables
-#define PexCCOptions sgiCCOptions PexSymbolTables
-#define ServerCCOptions sgiCCOptions ServerSymbolTables
-
-/* For SGI C++ compiler, need to search extra dirs in make depend */
-#ifndef CplusplusDependIncludes
-#define CplusplusDependIncludes -I/usr/include/CC
-#endif
-
-/* At SGI, we don't need this */
-/* at Cern we do...
- *#define ConstructMFLAGS NO /* build MFLAGS from MAKEFLAGS */
-
-/* Used only for compressed fonts */
-#define UNCOMPRESSPATH /usr/bsd/uncompress
-
-/* Normally used only to conditionally chose the default font path order */
-#define PrimaryScreenResolution 96
-
-/* Override Imake.tmpl's "-X" flag */
-#define LdCombineFlags -r
-
-/* Installation Build Parameters */
-#define InstKmemFlags -m 2755 -g sys
-
-#define ArCmd ar scq
-
-/* for xdm or anyone else to use */
-#define DefaultUserPath :/usr/sbin:/usr/bsd:/usr/bin:/bin:$(BINDIR):/etc:/usr/etc
-#define DefaultSystemPath /usr/sbin:/usr/bsd:/bin:/etc:/usr/bin:/usr/etc:$(BINDIR)
-
-#define BuildServer NO
-#define ServerOSDefines -DDDXTIME
-/* only need this for binary compatibility with their ddx */
-#define ServerExtraDefines -DNEED_LINEHELPER
-
-/* Changed to a single shell command for pmake/smake */
-/*
- * NormalLibObjCompile - compile fragment for a library object file
- * do ld -x to remove line number symbols for libraries
- */
-#define NormalLibObjCompile(options) $(RM) $@ $*.os \ @@\
- && $(CC) -c options $(CFLAGS) $*.c \ @@\
- && $(LD) $(LDSTRIPFLAGS) -r $@ -o $*.os \ @@\
- && $(MV) $*.os $@
-
-#define LibObjCompile(dir,options) $(RM) $@ dir/$@ \ @@\
- && $(CC) -c $(CCOPTIONS) $(ALLDEFINES) options $*.c \ @@\
- && $(MV) $@ dir/$@
-
-/* Cernlib additions */
-
-#define XargsCmd xargs
-
-#undef DefaultCCOptions
-
-#ifdef IsMips2
-#define DefaultCCOptions -mips2
-#define DefaultFCOptions -mips2 -align32
-#define FortranCppCmd f77 -P
-#define OptimisedFortranFlags -O -Olimit 2000
-#define FortranSaveFlags -static
-#define CernlibSystem -DCERNLIB_SGI -DCERNLIB_UNIX
-#define CERNLIB_SGI
-#define CERNLIB_UNIX
-
-#elif defined(Pre64)
-#define DefaultCCOptions /**/
-#define DefaultFCOptions
-#define FortranCppCmd f77 -P
-#define OptimisedFortranFlags -O -Olimit 2000
-#define FortranSaveFlags -static
-#define CernlibSystem -DCERNLIB_SGI -DCERNLIB_UNIX
-#define CERNLIB_SGI
-#define CERNLIB_UNIX
-
-#else
-
-#define DefaultCCOptions -n32 -mips3 -OPT:Olimit=0
-#define DefaultFCOptions -static -n32 -mips3 -OPT:Olimit=0
-#define FortranCppCmd f77 -P
-#define OptimisedFortranFlags -O
-#define FortranSaveFlags -static
-#define InstallCmd /usr/local/bin/gnu/install
-#define CernlibSystem -DCERNLIB_QMIRIX64 -DCERNLIB_SGI -DCERNLIB_UNIX
-#define CERNLIB_QMIRIX64
-#define CERNLIB_SGI
-#define CERNLIB_UNIX
-
-#endif
-#define CcAnsiMode -xansi
-#define CcStrictAnsiMode -ansi
-
-
diff --git a/src/config/sgiLib.rules b/src/config/sgiLib.rules
deleted file mode 100644
index f241880..0000000
--- a/src/config/sgiLib.rules
+++ /dev/null
@@ -1,57 +0,0 @@
-/* $Id: sgiLib.rules,v 1.1.1.1 1995/12/20 15:26:42 cernlib Exp $
- *
- * $Log: sgiLib.rules,v $
- * Revision 1.1.1.1 1995/12/20 15:26:42 cernlib
- * X11R6 config files unmodified
- *
- *
- */
-XCOMM $XConsortium: sgiLib.rules,v 1.8 93/09/11 17:59:30 rws Exp $
-
-#ifndef HasSharedLibraries
-#define HasSharedLibraries YES
-#endif
-#ifndef SharedDataSeparation
-#define SharedDataSeparation YES
-#endif
-#define SharedCodeDef -DSHAREDCODE
-#define SharedLibraryDef -DATTSHAREDLIB
-#define PositionIndependentCFlags -G 0
-
-/*
- * SharedLibraryTarget - generate rules to create a shared library;
- * build it into a different name so that the we don't hose people by having
- * the library gone for long periods.
- */
-#define SharedLibraryTarget(libname,rev,solist,down,up) @@\
-AllTarget(Concat3(lib,libname,_s)) @@\
- @@\
-Concat3(lib,libname,_s): sharedlib.o solist Concat(lib,libname.spec) @@\
- $(RM) $@ $@.a \ @@\
- && cd down \ @@\
- && mkshlib -s Concat(up/lib,libname.spec) -t up/$@ -h up/$@.a \ @@\
- && ar rs up/$@.a sharedlib.o @@\
- LinkBuildLibrary($@) @@\
- LinkBuildLibrary($@.a) @@\
- @@\
-clean:: @@\
- $(RM) Concat3(lib,libname,_s) Concat3(lib,libname,_s.a)
-
-#define SharedLibraryDataTarget(libname,rev,salist)
-
-/*
- * InstallSharedLibrary - generate rules to install the shared library.
- * NOTE: file must be executable, hence "INSTBINFLAGS"
- */
-#define InstallSharedLibrary(libname,rev,dest) @@\
-install:: Concat3(lib,libname,_s) @@\
- MakeDir($(DESTDIR)dest) @@\
- $(INSTALL) $(INSTALLFLAGS) $(INSTLIBFLAGS) Concat3(lib,libname,_s.a) $(DESTDIR)dest @@\
- $(INSTALL) $(INSTALLFLAGS) $(INSTBINFLAGS) Concat3(lib,libname,_s) $(DESTDIR)dest
-
-
-/*
- * InstallSharedLibraryData - generate rules to install the shared library data
- */
-#define InstallSharedLibraryData(libname,rev,dest) @@\
-InstallTarget(install,Concat3(lib,libname,_s.a),$(INSTLIBFLAGS),dest)
diff --git a/src/config/site.def b/src/config/site.def
deleted file mode 100644
index 311ebdd..0000000
--- a/src/config/site.def
+++ /dev/null
@@ -1,194 +0,0 @@
-/* $Id: site.def,v 1.9 2002/04/26 14:46:04 mclareni Exp $
- *
- * $Log: site.def,v $
- * Revision 1.9 2002/04/26 14:46:04 mclareni
- * Do not use shift by default, mainly for non CERN builds
- *
- * Revision 1.8 1997/02/28 10:39:53 gunter
- * mods for WNT
- *
- * Revision 1.7 1996/11/13 13:19:39 cernlib
- * Allow to veto setting of CERNLIB_SHIFT in any .cf file by defining it as false.
- *
- * Revision 1.6 1996/05/01 11:54:43 gunter
- * Introduce new way of building libraries.
- * CVS:----------------------------------------------------------------------
- *
- * Revision 1.5 1996/03/13 08:53:57 cernlib
- * Typo corrected
- *
- * Revision 1.4 1996/03/12 17:10:17 cernlib
- * #define CERNLIB_SHIFT on UNIX; this will turn on the use of shift sofware
- *
- * Revision 1.3 1996/03/06 11:04:21 cernlib
- * Imake.tmpl : Correct rule to run kuipc
- * fortran.rules: echo makedepend
- * site.def: undef MakeCmd before #define ( Sun has this defined to ..openwin...)
- * *.cf : small mods
- *
- * Revision 1.2 1995/12/21 11:32:37 cernlib
- * Imake files end 1995
- *
- * Revision 1.1.1.1 1995/12/20 15:26:44 cernlib
- * X11R6 config files unmodified
- *
- *
- */
-XCOMM site: $XConsortium: site.sample,v 1.9 94/04/08 17:02:06 rws Exp $
-
-/*****************************************************************************
- * *
- * SITE-SPECIFIC DEFINITIONS *
- * *
- * This file contains two halves, one included before the vendor-specific *
- * configuration file (.cf file), and one included after the .cf file. *
- * The before-half should be protected by #ifdef BeforeVendorCF, and the *
- * after-half should be protected by #ifdef AfterVendorCF. *
- * *
- * The before-half should only set things that the .cf file depends on. *
- * For the .cf files shipped in this release, the main variables in this *
- * category are HasGcc and HasGcc2. *
- * *
- * The after-half should contain all other definitions. For example, *
- * place your ProjectRoot definition here. *
- * *
- * OS Major and Minor version numbers should be changed directly in the .cf *
- * file, not overridden in site.def. *
- * *
- *****************************************************************************/
-
-/* if you want host-specific customization, this is one way to do it */
-/*
-#ifndef SiteIConfigFiles
-#define SiteIConfigFiles $(IRULESRC)/host.def
-#define LocalConfigFiles host.def
-#endif
-
-*/
-
-
-#ifdef BeforeVendorCF
-
-#define HasFortran YES
-
-/*
-#include <host.def>
-*/
-
-/*
-#ifndef HasGcc2
-#define HasGcc2 YES
-#endif
-*/
-
-#endif /* BeforeVendorCF */
-
-#ifdef AfterVendorCF
-
-#define ProjectRoot $(CVSCOSRC)
-
-#ifndef UseXargs
-#define UseXargs YES
-#endif
-
-#ifndef XargsCmd
-#define XargsCmd /usr/local/bin/gxargs
-#endif
-
-/* define CERNLIB_SHIFT to turn on using shift software */
-/* if it is already defined and false, undef it! */
-/* do not use shift by default
-#if defined(CERNLIB_UNIX) && !defined(CERNLIB_WINNT)
-#if ! defined(CERNLIB_SHIFT)
-#define CERNLIB_SHIFT
-#elif ! CERNLIB_SHIFT
-#undef CERNLIB_SHIFT
-#endif
-#endif
- */
-
-/* gmake does like ConstructMFLAGS to be YES(?) */
-#undef MakeCmd
-#ifndef WIN32
-# define MakeCmd gmake
-#else
-# define MakeCmd make
-#endif
-#define ConstructMFLAGS YES
-
-#ifndef WIN32
-# define LocalRulesFile <fortran.rules>
-#else
-# undef LocalRulesFile
-#endif
-
-/* #define HasXdmAuth YES */
-
-/* #define BuildXKB YES */
-
-/* #define PreIncDir /usr/local/lib/gcc-lib/sparc-sun-sunos4.1.3/2.5.8/include */
-
-/*
-#if defined(SunArchitecture) && defined(SparcArchitecture)
-#define HasCodeCenter YES
-#ifndef SVR4
-#define HasTestCenter YES
-#endif
-#endif
-*/
-
-/*
-#ifdef __hp9000s800
-#define HasCodeCenter YES
-#endif
-*/
-
-/*
-#if defined(SunArchitecture) && defined(SparcArchitecture) && !defined(SVR4)
-#define HasPurify YES
-#endif
-*/
-
-/*
-#define HasSentinel YES
-*/
-
-/*
-#if XsvgaServer
-#define SvgaConfig vga.pmi:1024x768
-#endif
-*/
-
-/* You do NOT need SetUID if you only run the server under xdm */
-/* You MAY need SetUID if users run the server by hand or under xinit */
-/* Consult your system administrator before making the X server setuid */
-/*
-#if defined(SunArchitecture) && OSMajorVersion > 4
-#define InstallXserverSetUID YES
-#endif
-*/
-
-/* You do NOT need SetUID if you only run the server under xdm */
-/* You MAY need SetUID if users run the server by hand or under xinit */
-/* Consult your system administrator before making the X server setuid */
-/*
-#if XsvgaServer
-#define SvgaConfig vga.pmi:1024x768
-#define InstallXserverSetUID YES
-#endif
-*/
-
-/* You do NOT need SetUID if you only run the server under xdm */
-/* You MAY need SetUID if users run the server by hand or under xinit */
-/* Consult your system administrator before making the X server setuid */
-/*
-#ifdef XFree86Version
-#define InstallXserverSetUID YES
-#endif
-*/
-
-/*
-#include <host.def>
-*/
-
-#endif /* AfterVendorCF */
diff --git a/src/config/site.sample b/src/config/site.sample
deleted file mode 100644
index a4a56f0..0000000
--- a/src/config/site.sample
+++ /dev/null
@@ -1,135 +0,0 @@
-/* $Id: site.sample,v 1.1.1.1 1995/12/20 15:26:43 cernlib Exp $
- *
- * $Log: site.sample,v $
- * Revision 1.1.1.1 1995/12/20 15:26:43 cernlib
- * X11R6 config files unmodified
- *
- *
- */
-XCOMM site: $XConsortium: site.sample,v 1.11.1.1 94/12/07 10:24:08 kaleb Exp $
-
-/*****************************************************************************
- * *
- * SITE-SPECIFIC DEFINITIONS *
- * *
- * This file contains two halves, one included before the vendor-specific *
- * configuration file (.cf file), and one included after the .cf file. *
- * The before-half should be protected by #ifdef BeforeVendorCF, and the *
- * after-half should be protected by #ifdef AfterVendorCF. *
- * *
- * The before-half should only set things that the .cf file depends on. *
- * For the .cf files shipped in this release, the main variables in this *
- * category are HasGcc, HasGcc2, and HasCplusplus *
- * *
- * The after-half should contain all other definitions. For example, *
- * place your ProjectRoot definition here. *
- * *
- * OS Major and Minor version numbers should be changed directly in the .cf *
- * file, not overridden in site.def. *
- * *
- *****************************************************************************/
-
-/* if you want host-specific customization, this is one way to do it */
-/*
-#ifndef SiteIConfigFiles
-#define SiteIConfigFiles $(IRULESRC)/host.def
-#define LocalConfigFiles host.def
-#endif
-
-*/
-
-
-#ifdef BeforeVendorCF
-
-/*
-#include <host.def>
-*/
-
-/*
-#ifndef HasGcc2
-#define HasGcc2 YES
-#endif
-*/
-
-/*
-#ifndef HasCplusplus
-#define HasCplusplus YES
-#endif
-*/
-
-#endif /* BeforeVendorCF */
-
-#ifdef AfterVendorCF
-
-#define ProjectRoot /usr/X11R6
-
-/* #define HasXdmAuth YES */
-
-/* #define BuildXKB YES */
-
-/* #define PreIncDir /usr/local/lib/gcc-lib/sparc-sun-sunos4.1.3/2.5.8/include */
-
-/*
-#if defined(SunArchitecture) && defined(SparcArchitecture)
-#define HasCodeCenter YES
-#ifndef SVR4Architecture
-#define HasTestCenter YES
-#endif
-#endif
-*/
-
-/*
-#ifdef __hp9000s800
-#define HasCodeCenter YES
-#endif
-*/
-
-/*
-#if defined(SunArchitecture) && defined(SparcArchitecture) && !defined(SVR4Architecture)
-#define HasPurify YES
-#endif
-*/
-
-/*
-#define HasSentinel YES
-*/
-
-/*
-#if XsvgaServer
-#define SvgaConfig vga.pmi:1024x768
-#endif
-*/
-
-/* You do NOT need SetUID if you only run the server under xdm */
-/* You MAY need SetUID if users run the server by hand or under xinit */
-/* Consult your system administrator before making the X server setuid */
-/*
-#if defined(SunArchitecture) && OSMajorVersion > 4
-#define InstallXserverSetUID YES
-#endif
-*/
-
-/* You do NOT need SetUID if you only run the server under xdm */
-/* You MAY need SetUID if users run the server by hand or under xinit */
-/* Consult your system administrator before making the X server setuid */
-/*
-#if XsvgaServer
-#define SvgaConfig vga.pmi:1024x768
-#define InstallXserverSetUID YES
-#endif
-*/
-
-/* You do NOT need SetUID if you only run the server under xdm */
-/* You MAY need SetUID if users run the server by hand or under xinit */
-/* Consult your system administrator before making the X server setuid */
-/*
-#ifdef XFree86Version
-#define InstallXserverSetUID YES
-#endif
-*/
-
-/*
-#include <host.def>
-*/
-
-#endif /* AfterVendorCF */
diff --git a/src/config/sony.cf b/src/config/sony.cf
deleted file mode 100644
index 84095d4..0000000
--- a/src/config/sony.cf
+++ /dev/null
@@ -1,88 +0,0 @@
-/* $Id: sony.cf,v 1.1.1.1 1995/12/20 15:26:43 cernlib Exp $
- *
- * $Log: sony.cf,v $
- * Revision 1.1.1.1 1995/12/20 15:26:43 cernlib
- * X11R6 config files unmodified
- *
- *
- */
-XCOMM platform: $XConsortium: sony.cf,v 1.57 94/04/02 08:40:51 kaleb Exp $
-
-#ifdef SonyBsdArchitecture
-
-#define OSName NEWS-OS 4.2.1C
-#define OSMajorVersion 4
-#define OSMinorVersion 2
-#define OSTeenyVersion 1
-#define SetTtyGroup YES
-#define HasVoidSignalReturn NO
-#define HasNdbm YES
-#define DirFailPrefix -
-#define InstKmemFlags -g kmem -m 2755
-#define DefaultUserPath :/bin:/usr/bin:$(BINDIR):/usr/ucb:/usr/sony/bin:
-#define DefaultSystemPath /etc:/usr/etc:/bin:/usr/bin:$(BINDIR):/usr/ucb:/usr/sony/bin:
-#ifdef MipsArchitecture
-#define ExtraLibraries -lmld
-#define LintOpts -ax
-#define LintLibFlag -o
-#define DefaultCCOptions -Wf,-XNh2000,-XNd6000,-XNp10000 -Olimit 2000
-#define PexCCOptions -Wf,-XNh2000,-XNd15000,-XNp15000 -Olimit 2000
-#else
-#define HasFortran YES
-#endif
-#if OSMajorVersion >= 4
-#define HasShm YES
-#define HasPutenv YES
-#define HasSecureRPC YES
-#define XdmDir /etc/xdm
-#if OSMinorVersion >= 1
-#define HasBsearch YES
-#else
-#define HasBsearch NO
-#endif
-#else
-#define StandardDefines -DNOSTDHDRS
-#define HasBsearch NO
-#endif
-
-#else
-
-#define OSName NEWS-OS 6.0
-#define OSMajorVersion 6
-#define OSMinorVersion 0
-#define BootstrapCFlags -Dsony
-#define SystemV4 YES
-#define CcCmd /usr/bin/cc
-#if OSMajorVersion >= 6
-#define DefaultCCOptions -Xc -Wf,-XNp9000,-XNd6000
-#define PexCCOptions -Xc -Wf,-XNp15000,-XNd15000
-#define SharedLibraryLoadFlags -G -rpath $(USRLIBDIR)
-#define PositionIndependentCFlags -K PIC -Wx,-G 0
-#define PositionIndependentCplusplusFlags -K PIC -Wx,-G 0
-#define SharedXmuReqs $(LDPRELIB) $(XTOOLLIB)
-#define FixupLibReferences() /**/
-#include <sv4Lib.rules>
-#else
-#define DefaultCCOptions -Wf,-XNp9000,-XNd6000
-#define PexCCOptions -Wf,-XNp15000,-XNd15000
-#endif
-
-#endif
-
-/*
- * SONY C++ compiler is based on vanilla cfront, which means it
- * refuses to compile files unless their names end in ".C". We
- * have to completely override .SUFFIXES to avoid using the builtin
- * .C to .o rule in cases where the link to foo.C is already there,
- * because the builtin rule doesn't use the right compilation flags.
- */
-
-.SUFFIXES:
-.SUFFIXES: .o .c .y .l .s .sh .h .f .Y .L .cxx
-
-#define NormalLibObjCplusplusCompile(options) test -r $*.C || $(LN) $*.CCsuf $*.C @@\
- $(CXX) -c $(CXXFLAGS) options $*.C
-
-XCOMM operating system: OSName
-
-#define BuildServer NO
diff --git a/src/config/sun.cf b/src/config/sun.cf
deleted file mode 100644
index 286f242..0000000
--- a/src/config/sun.cf
+++ /dev/null
@@ -1,437 +0,0 @@
-/* $Id: sun.cf,v 1.12 2000/03/21 18:02:49 mclareni Exp $
- *
- * $Log: sun.cf,v $
- * Revision 1.12 2000/03/21 18:02:49 mclareni
- * Remove specific directory for makedepend, the openwin version seems to work and is normally in the search path
- *
- * Revision 1.11 1999/03/10 16:49:06 mclareni
- * Add -KPIC option for f77 and cc
- *
- * Revision 1.10 1998/02/03 09:46:40 mclareni
- * Mathlib needs cpp, not fpp, with f77 SC4.2
- *
- * Revision 1.9 1996/04/23 12:57:28 cernlib
- * Do not use LDRUNPATH by setting LdRunPath to NO
- *
- * Revision 1.8 1996/04/02 21:05:42 thakulin
- * Add support for Apogee and EPC C and Fortran compilers.
- *
- * Revision 1.7 1996/03/08 17:12:15 cernlib
- * *** empty log message ***
- *
- * Revision 1.6 1996/03/06 11:04:23 cernlib
- * Imake.tmpl : Correct rule to run kuipc
- * fortran.rules: echo makedepend
- * site.def: undef MakeCmd before #define ( Sun has this defined to ..openwin...)
- * *.cf : small mods
- *
- * Revision 1.5 1996/03/04 17:31:03 cernlib
- * Parametrize Ansi C compiel options. other small mods
- *
- * Revision 1.4 1996/02/29 10:38:57 cernlib
- * Add DoIncludePackage to Imake.rules
- * Correct compiel options in osf1.cf,sun.cf
- *
- * Revision 1.3 1996/02/01 16:08:46 cernlib
- * Various changes in FOTRANDEFINES ( for IBM, and Makedepend)
- * make cc default c compiler in aix
- * use /usr/lib/X11/bin/makedepend on SunOS and Solaris
- *
- * Revision 1.2 1995/12/21 11:32:42 cernlib
- * Imake files end 1995
- *
- * Revision 1.1.1.1 1995/12/20 15:26:43 cernlib
- * X11R6 config files unmodified
- *
- *
- */
-XCOMM platform: $XConsortium: sun.cf,v 1.139.1.1 95/06/19 18:22:21 gildea Exp $
-
-#ifdef SVR4Architecture
-#ifdef i386Architecture
-#ifndef OSName
-#define OSName SunOS 5.1 x86
-#endif
-XCOMM operating system: OSName
-#ifndef OSMajorVersion
-#define OSMajorVersion 5
-#endif
-#ifndef OSMinorVersion
-#define OSMinorVersion 1
-#endif
-#ifndef OSTeenyVersion
-#define OSTeenyVersion 0
-#endif
-#else
-#ifndef OSName
-#define OSName SunOS 5.3
-#endif
-XCOMM operating system: OSName
-#ifndef OSMajorVersion
-#define OSMajorVersion 5
-#endif
-#ifndef OSMinorVersion
-#define OSMinorVersion 3
-#endif
-#ifndef OSTeenyVersion
-#define OSTeenyVersion 0
-#endif
-#endif
-#else
-#ifndef OSName
-#define OSName SunOS 4.1.3
-#endif
-XCOMM operating system: OSName
-#ifndef OSMajorVersion
-#define OSMajorVersion 4
-#endif
-#ifndef OSMinorVersion
-#define OSMinorVersion 1
-#endif
-#ifndef OSTeenyVersion
-#define OSTeenyVersion 3
-#endif
-#endif
-
-/*
- * Compiler setup. This sun.cf file knows what options to use with
- * certain compilers, including Sun C, CenterLine C, and gcc. It
- * also understands how to set some of the options for various C++
- * compilers, including Sun C++ and CenterLine C++.
- *
- * === C Compiler Setup ==========================================
- *
- * For SunPro C, define HasSunC to YES in site.def.
- * For CenterLine C, define HasCenterLineC to YES in site.def
- * For gcc or gcc2, define HasGcc or HasGcc2 to YES in site.def
- * For other compilers, define HasSunC to NO in site.def, then
- * provide appropriate values for the various compiler related
- * configuration varibles used here.
- *
- * If you say you have the SunPro C compiler, we assume you have
- * version 2.0.x of the compiler. If you have version 3.0.x instead,
- * define CCompilerMajorVersion as 3 in site.def
- *
- * If you don't tell us which C compiler you have, we assume you have
- * the SunPro C compiler under Solaris 2.x, and the bundled /bin/cc
- * under SunOS 4.1.x
- *
- * === C++ Compiler Setup ==========================================
- *
- * For SunPro C++, define HasSunCplusplus to YES in site.def
- * For CenterLine C++, define HasCenterLineCplusplus to YES in site.def
- * For Gnu g++ 2.6.x, define HasGcc2ForCplusplus to YES in site.def
- * For other compilers, define HasCplusplus to YES in site.def, and
- * check to see if you need to provide values for CplusplusOptions
- * and/or DefaultCplusplusOptions.
- *
- * In any case, you may also need to set CplusplusDependIncludes.
- *
- * If you say you have the SunPro C++ compiler, we assume you have
- * version 3.0.x of the compiler. If you have version 4.0.x instead,
- * define CplusplusCompilerMajorVersion as 4 in site.def.
- *
- */
-
-#ifndef HasSunC
-#if (HasCenterLineC || HasGcc || HasGcc2 || HasApogee || HasEPC || OSMajorVersion < 5)
-#define HasSunC NO
-#else
-#define HasSunC YES
-#endif
-#endif
-
-#if HasSunC
-#ifndef CCompilerMajorVersion
-#define CCompilerMajorVersion 2
-#endif
-#endif
-
-#if HasSunCplusplus
-#ifndef HasCplusplus
-#define HasCplusplus YES
-#endif
-#ifndef CplusplusCompilerMajorVersion
-#define CplusplusCompilerMajorVersion 3
-#endif
-#endif
-
-#if HasCenterLineC
-#ifndef CcCmd
-#define CcCmd clcc
-#endif
-#endif
-
-#if HasCenterLineCplusplus
-#ifndef HasCplusplus
-#define HasCplusplus YES
-#endif
-#ifndef DefaultCplusplusOptions
-#define DefaultCplusplusOptions -Xa
-#endif
-#ifndef CplusplusOptions
-#define CplusplusOptions -Xa
-#endif
-#endif
-
-/*
- * Gnu g++ 2.6.0 cannot build working C++ shared libraries under Solaris 2
- */
-#if HasGcc2ForCplusplus && OSMajorVersion > 4
-#ifndef SharedLibFresco
-#define SharedLibFresco NO
-#endif
-#ifndef SharedLibXtf
-#define SharedLibXtf NO
-#endif
-#endif
-
-#if OSMajorVersion < 4 || (OSMajorVersion == 4 && OSMinorVersion < 1)
-/* We do not guarantee this will work */
-#define BootstrapCFlags -DNOSTDHDRS
-#define StandardDefines -DNOSTDHDRS
-#define XawI18nDefines -DUSE_XWCHAR_STRING -DUSE_XMBTOWC
-#endif
-
-#if OSMajorVersion == 4
-#if OSMinorVersion == 1
-#define HasPoll YES
-#endif
-#if OSMinorVersion > 1 || (OSMinorVersion == 1 && OSTeenyVersion > 1)
-/* You ALSO need this if you have Sun ld patch 100170-06 or later to 4.1.1 */
-#define SunPost411FCSLd YES
-#endif
-#endif
-
-#ifdef i386Architecture
-#if OSMajorVersion > 4
-#define ServerExtraDefines AllocateLocalDefines XFree86ServerDefines
-#define ServerOSDefines XFree86ServerOSDefines
-#else
-#define ServerExtraDefines AllocateLocalDefines
-#define ServerOSDefines -DDDXOSINIT
-#endif
-#else
-#define ServerExtraDefines AllocateLocalDefines
-#define ServerOSDefines -DDDXOSINIT
-#endif
-
-#if OSMajorVersion > 4
-#define BootstrapCFlags -DSVR4
-#ifndef XawI18nDefines
-#define XawI18nDefines -DHAS_WCTYPE_H -DHAS_ISW_FUNCS
-#endif
-#ifdef i386Architecture
-#define StandardDefines -Dsun -Di386 -DSVR4 -D__i386
-#define ToolkitStringsABIOptions -intelabi
-#else
-#define StandardDefines -Dsun -DSVR4
-#define ToolkitStringsABIOptions -sparcabi
-#endif
-#define ExtraLibraries -lsocket -lnsl
-#if OSMinorVersion > 1
-#define ThreadedX YES
-#if HasSunC && CCompilerMajorVersion > 2
-#define ThreadsCompileFlags -mt
-#else
-#define SystemMTDefines -D_REENTRANT
-#define ThreadsLibraries -lthread
-#endif
-#if HasSunCplusplus && CplusplusCompilerMajorVersion > 3
-#define ThreadsCplusplusCompileFlags -mt
-#else
-#define CplusplusSystemMTDefines -D_REENTRANT
-#define ThreadsCplusplusLibraries -lthread
-#endif
-#endif /* OSMinorVersion > 1 */
-#define HasVFork NO
-#define InstKmemFlags -g sys -m 2755
-#define ShLibIncludeFile <sunLib.tmpl>
-/*
- * Set flags for position independent code before including sv4Lib.rules
- * if the compiler in use doesn't use standard SVR4 flags
- */
-#if HasSunC || HasCenterLineC || HasEPC
-#define PositionIndependentCFlags -KPIC
-#endif
-#if HasApogee
-#define PositionIndependentCFlags -PIC
-#endif
-#if HasSunCplusplus || HasCenterLineCplusplus
-#define PositionIndependentCplusplusFlags -pic
-#endif
-#else
-#define InstKmemFlags -g kmem -m 2755
-#include <sunLib.rules>
-#endif
-
-#define HasNdbm YES
-#define HasShm YES
-#define HasSecureRPC YES
-#define SetTtyGroup YES
-#define HasPutenv YES
-#ifndef i386Architecture
-#ifndef Xsun24Server
-#define Xsun24Server NO /* color, mono, multiple depths */
-#endif
-#ifndef XsunServer
-#define XsunServer YES /* color and mono, 8 bit only */
-#endif
-#ifndef XsunMonoServer
-#define XsunMonoServer NO /* monochrome only */
-#endif
-#endif /* not i386Architecture */
-#ifndef BuildPexExt
-#define BuildPexExt (XsunServer || Xsun24Server)
-#endif
-#ifndef BuildXKB
-#define BuildXKB YES
-#endif
-
-#if HasGcc
-#if OSMajorVersion > 4 && defined(i386Architecture)
-#ifndef DefaultCCOptions
-#if OSMinorVersion == 1
-#define DefaultCCOptions -DNO_ASM
-#else
-#define DefaultCCOptions -ansi -DNO_ASM
-#endif
-#endif
-#endif
-#if HasGcc2
-#define OptimizedCDebugFlags -O2
-#else
-#define SharedLibraryCcCmd cc
-#define ExtraLoadFlags -B/usr/bin/
-#define AllocateLocalDefines /**/
-
-.c.o:
- $(CC) -c $(CFLAGS) $*.c
-
-#endif /* HasGcc2 (else) */
-#else /* not HasGcc */
-
-#define AllocateLocalDefines -DINCLUDE_ALLOCA_H
-
-/* Set up compiler-dependent options for Sun C */
-
-#if HasSunC
-#ifdef Sun3Architecture
-#ifndef DefaultCCOptions
-#define DefaultCCOptions -f68881 -pipe
-#endif
-#else /* not defined(Sun3Architecture) */
-#if OSMajorVersion < 5
-#ifndef DefaultCCOptions
-#define DefaultCCOptions -pipe
-#endif
-#else /* OSMajorVersion >= 5*/
-#ifndef DefaultCCOptions
-#define DefaultCCOptions -Xa
-#endif
-#endif
-#endif
-#endif
-
-/* Set compiler-dependent options for CenterLine C */
-
-#if HasCenterLineC
-#ifndef DefaultCCOptions
-#define DefaultCCOptions -Xt -w1 -DANSICPP -U__HIGHC__
-#endif
-#ifndef NeedConstPrototypes
-#define NeedConstPrototypes YES
-#endif
-#ifndef NeedNestedPrototypes
-#define NeedNestedPrototypes YES
-#endif
-#ifndef NeedVarargsPrototypes
-#define NeedVarargsPrototypes YES
-#endif
-#endif
-
-
-#define PexCCOptions DefaultCCOptions
-
-#endif /* HasGcc (else) */
-
-#if OSMajorVersion < 5
-#define SharedAllocateLocalDefines -DINCLUDE_ALLOCA_H
-#define LibraryCCOptions /* don't want special floating point */
-#endif
-
-#if OSMajorVersion > 4
-#include <svr4.cf>
-#endif
-
-
-/* CERNLIB additions */
-
-#ifdef HasLdRunPath
-#undef HasLdRunPath
-#endif
-#define HasLdRunPath NO
-
-#if OSMajorVersion > 4 /* SOLARIS */
-
-#undef DefaultCCOptions
-#define DefaultCCOptions -KPIC
-
-#define FortranSaveFlags /* None */
-#define CernlibSystem -DCERNLIB_SUN -DCERNLIB_SOLARIS -DCERNLIB_UNIX
-#define CERNLIB_SUN
-#define CERNLIB_SOLARIS
-#define CERNLIB_UNIX
-
-#define X11Includes -I/usr/openwin/share/include
-#define MotifIncludes -I/usr/dt/include
-
-#if HasApogee
-#define CcAnsiMode -Xc=mixed
-#define CcStrictAnsiMode -Xc=ansi
-/* suppress warnings about commons having different sizes in different
- object modules */
-#define DefaultFCOptions /**/
-#define FortranLoadFlags -Wl,-t
-# ifndef OptimizedCDebugFlags
-#define OptimizedCDebugFlags -fast
-# endif
-# ifndef OptimisedFortranFlags
-#define OptimisedFortranFlags -fast
-# endif
-#else
-# if HasEPC
-#define CcAnsiMode -Xa
-#define CcStrictAnsiMode -Xc
-/* EPC tokenizing cpp gets confused about the .F files */
-#define FortranDoesCpp NO
-#define FortranCannotRedirectObject
-# ifndef OptimizedCDebugFlags
-#define OptimizedCDebugFlags /**/
-# endif
-# ifndef OptimisedFortranFlags
-#define OptimisedFortranFlags -fast
-# endif
-# else
-#define CcAnsiMode -Xa
-#define CcStrictAnsiMode -Xc
-#define DefaultFCOptions -xpp=cpp -KPIC
-# ifndef OptimisedFortranFlags
-#define OptimisedFortranFlags -O
-# endif
-# endif
-#endif
-
-#else /* SunOS */
-
-#define CcCmd acc
-
-#define OptimisedFortranFlags -O
-#define FortranSaveFlags /* None */
-#define CernlibSystem -DCERNLIB_SUN -DCERNLIB_UNIX
-#define CERNLIB_SUN
-#define CERNLIB_UNIX
-#define X11Includes -I/usr/local/include
-#define MotifIncludes -I/usr/motif12/usr/include
-
-#endif
diff --git a/src/config/sunLib.rules b/src/config/sunLib.rules
deleted file mode 100644
index 7685afc..0000000
--- a/src/config/sunLib.rules
+++ /dev/null
@@ -1,119 +0,0 @@
-/* $Id: sunLib.rules,v 1.1.1.1 1995/12/20 15:26:43 cernlib Exp $
- *
- * $Log: sunLib.rules,v $
- * Revision 1.1.1.1 1995/12/20 15:26:43 cernlib
- * X11R6 config files unmodified
- *
- *
- */
-XCOMM $XConsortium: sunLib.rules,v 1.14 94/03/28 15:24:43 gildea Exp $
-
-/*
- * SunOS shared library rules
- */
-
-#ifndef HasSharedLibraries
-#define HasSharedLibraries YES
-#endif
-#ifndef SharedDataSeparation
-#define SharedDataSeparation YES
-#endif
-#ifndef SharedCodeDef
-#define SharedCodeDef -DSHAREDCODE
-#endif
-#ifndef SharedLibraryDef
-#define SharedLibraryDef -DSUNSHLIB
-#endif
-#ifndef ShLibIncludeFile
-#define ShLibIncludeFile <sunLib.tmpl>
-#endif
-#ifndef SharedLibraryLoadFlags
-#define SharedLibraryLoadFlags -assert pure-text
-#endif
-#ifndef PositionIndependentCFlags
-#if HasGcc2
-#define PositionIndependentCFlags -fpic
-#else
-#define PositionIndependentCFlags -pic
-#endif
-#endif
-#ifndef PositionIndependentCplusplusFlags
-#if HasGcc2ForCplusplus
-#define PositionIndependentCplusplusFlags -fpic
-#else
-#define PositionIndependentCplusplusFlags -pic
-#endif
-#endif
-
-/*
- * SharedDSLibDependencies - shared library dependencies with data separation
- */
-#ifndef SharedDSLibDependencies
-#define SharedDSLibDependencies(libname,libsource,revname) _UseCat($(USRLIBDIR)/lib,libsource/lib,libname.sa.$(revname))
-#endif
-
-/*
- * InstallSharedLibrary - generate rules to install the shared library.
- */
-#ifndef InstallSharedLibrary
-#define InstallSharedLibrary(libname,rev,dest) @@\
-InstallTarget(install,Concat(lib,libname.so.rev),$(INSTLIBFLAGS),dest)
-#endif /* InstallSharedLibrary */
-
-/*
- * InstallSharedLibraryData - generate rules to install the shared library data
- */
-#ifndef InstallSharedLibraryData
-#define InstallSharedLibraryData(libname,rev,dest) @@\
-install:: Concat(lib,libname.sa.rev) @@\
- MakeDir($(DESTDIR)dest) @@\
- $(INSTALL) $(INSTALLFLAGS) $(INSTLIBFLAGS) Concat(lib,libname.sa.rev) $(DESTDIR)dest @@\
- RanLibrary($(RANLIBINSTFLAGS) Concat($(DESTDIR)dest/lib,libname.sa.rev))
-#endif /* InstallSharedLibraryData */
-
-#if HasPurify
-#define PureCleanSharedLibrary(libname,rev) @@\
-clean clean.pure:: @@\
- $(RM) Concat3(lib,libname,_pure_*.so.rev)
-#else
-#define PureCleanSharedLibrary(libname,rev) /**/
-#endif
-
-/*
- * NormalSharedLibraryTarget - generate rules to create a shared library;
- * build it into a different name so that the we do not hose people by having
- * the library gone for long periods.
- */
-#ifndef SharedLibraryTarget
-#define SharedLibraryTarget(libname,rev,solist,down,up) @@\
-AllTarget(Concat(lib,libname.so.rev)) @@\
- @@\
-Concat(lib,libname.so.rev): solist @@\
- $(RM) $@~ @@\
- (cd down; $(LD) -o up/$@~ $(SHLIBLDFLAGS) solist $(REQUIREDLIBS)) @@\
- $(RM) $@ @@\
- $(MV) $@~ $@ @@\
- LinkBuildLibrary($@) @@\
- @@\
-clean:: @@\
- $(RM) Concat(lib,libname.so.rev) @@\
- @@\
-PureCleanSharedLibrary(libname,rev)
-#endif /* SharedLibraryTarget */
-
-/*
- * SharedLibraryDataTarget - generate rules to create shlib data file;
- */
-#ifndef SharedLibraryDataTarget
-#define SharedLibraryDataTarget(libname,rev,salist) @@\
-AllTarget(Concat(lib,libname.sa.rev)) @@\
- @@\
-Concat(lib,libname.sa.rev): salist @@\
- $(RM) $@ @@\
- $(AR) $@ salist @@\
- RanLibrary($@) @@\
- LinkBuildLibrary($@) @@\
- @@\
-clean:: @@\
- $(RM) Concat(lib,libname.sa.rev)
-#endif /* SharedLibraryDataTarget */
diff --git a/src/config/sunLib.tmpl b/src/config/sunLib.tmpl
deleted file mode 100644
index 0eeb77c..0000000
--- a/src/config/sunLib.tmpl
+++ /dev/null
@@ -1,57 +0,0 @@
-/* $Id: sunLib.tmpl,v 1.1.1.1 1995/12/20 15:26:44 cernlib Exp $
- *
- * $Log: sunLib.tmpl,v $
- * Revision 1.1.1.1 1995/12/20 15:26:44 cernlib
- * X11R6 config files unmodified
- *
- *
- */
-XCOMM $XConsortium: sunLib.tmpl,v 1.38 95/07/06 14:06:11 kaleb Exp $
-
-/*
- * SunOS shared library template
- */
-
-#if OSMajorVersion <= 4
-
-#if SunPost411FCSLd
-#define SharedXmuReqs $(LDPRELIB) $(XTOOLLIB) $(XLIB)
-#endif
-
-#ifndef SharedX11Rev
-#define SharedX11Rev 4.20
-#endif
-#ifndef SharedOldXRev
-#define SharedOldXRev 4.20
-#endif
-#ifndef SharedXtRev
-#define SharedXtRev 4.20
-#endif
-#ifndef SharedXmuRev
-#define SharedXmuRev 4.20
-#endif
-#ifndef SharedXextRev
-#define SharedXextRev 4.20
-#endif
-#ifndef SharedXiRev
-#define SharedXiRev 4.20
-#endif
-#ifndef SharedXtstRev
-#define SharedXtstRev 1.10
-#endif
-#ifndef SharedPexRev
-#define SharedPexRev 1.10
-#endif
-
-#else /* else it's Solaris */
-
-#if ThreadedX
-#if OSMinorVersion > 3
-#define SharedX11Reqs /**/
-#endif
-#endif
-#define SharedXmuReqs $(LDPRELIB) $(XTOOLLIB) $(XLIB)
-#define FixupLibReferences() /**/
-#include <sv4Lib.tmpl>
-
-#endif
diff --git a/src/config/sv4Lib.rules b/src/config/sv4Lib.rules
deleted file mode 100644
index 73c75d3..0000000
--- a/src/config/sv4Lib.rules
+++ /dev/null
@@ -1,98 +0,0 @@
-/* $Id: sv4Lib.rules,v 1.1.1.1 1995/12/20 15:26:42 cernlib Exp $
- *
- * $Log: sv4Lib.rules,v $
- * Revision 1.1.1.1 1995/12/20 15:26:42 cernlib
- * X11R6 config files unmodified
- *
- *
- */
-XCOMM $XConsortium: sv4Lib.rules,v 1.14 94/04/09 12:00:10 rws Exp $
-
-/*
- * SVR4 shared library rules
- */
-
-#ifndef HasSharedLibraries
-#define HasSharedLibraries YES
-#endif
-#ifndef SharedDataSeparation
-#define SharedDataSeparation NO
-#endif
-#ifndef SharedCodeDef
-#define SharedCodeDef /**/
-#endif
-#ifndef SharedLibraryDef
-#define SharedLibraryDef /**/
-#endif
-#ifndef ShLibIncludeFile
-#define ShLibIncludeFile <sv4Lib.tmpl>
-#endif
-#ifndef SharedLibraryLoadFlags
-#define SharedLibraryLoadFlags -G -z text
-#endif
-#ifndef PositionIndependentCFlags
-#if HasGcc2
-#define PositionIndependentCFlags -fpic
-#else
-#define PositionIndependentCFlags -K PIC
-#endif
-#endif
-#ifndef PositionIndependentCplusplusFlags
-#if HasGcc2ForCplusplus
-#define PositionIndependentCplusplusFlags -fpic
-#else
-#define PositionIndependentCplusplusFlags -K PIC
-#endif
-#endif
-
-/*
- * InstallSharedLibrary - generate rules to install the shared library.
- */
-#ifndef InstallSharedLibrary
-#define InstallSharedLibrary(libname,rev,dest) @@\
-install:: Concat(lib,libname.so.rev) @@\
- MakeDir($(DESTDIR)dest) @@\
- $(INSTALL) $(INSTALLFLAGS) $(INSTLIBFLAGS) Concat(lib,libname.so.rev) $(DESTDIR)dest @@\
- $(RM) Concat($(DESTDIR)dest/lib,libname.so) @@\
- $(LN) Concat(lib,libname.so.rev) Concat($(DESTDIR)dest/lib,libname.so)
-
-#endif /* InstallSharedLibrary */
-
-/*
- * InstallSharedLibraryData - generate rules to install the shared library data
- */
-#ifndef InstallSharedLibraryData
-#define InstallSharedLibraryData(libname,rev,dest)
-#endif /* InstallSharedLibraryData */
-
-
-/*
- * SharedLibraryTarget - generate rules to create a shared library;
- * build it into a different name so that we do not hose people by having
- * the library gone for long periods.
- */
-#ifndef SharedLibraryTarget
-#define SharedLibraryTarget(libname,rev,solist,down,up) @@\
-AllTarget(Concat(lib,libname.so.rev)) @@\
- @@\
-Concat(lib,libname.so.rev): solist @@\
- $(RM) $@~ @@\
- (cd down; $(CCENVSETUP) $(LD) -o up/$@~ $(SHLIBLDFLAGS) -h $@ solist $(REQUIREDLIBS)) @@\
- $(RM) $@ @@\
- $(MV) $@~ $@ @@\
- $(RM) Concat(lib,libname.so) @@\
- $(LN) $@ Concat(lib,libname.so) @@\
- LinkBuildLibrary($@) @@\
- LinkBuildLibrary(Concat(lib,libname.so)) @@\
- @@\
-clean:: @@\
- $(RM) Concat(lib,libname.so.rev) Concat(lib,libname.so)
-
-#endif /* SharedLibraryTarget */
-
-/*
- * SharedLibraryDataTarget - generate rules to create shlib data file;
- */
-#ifndef SharedLibraryDataTarget
-#define SharedLibraryDataTarget(libname,rev,salist)
-#endif /* SharedLibraryTarget */
diff --git a/src/config/sv4Lib.tmpl b/src/config/sv4Lib.tmpl
deleted file mode 100644
index e97db15..0000000
--- a/src/config/sv4Lib.tmpl
+++ /dev/null
@@ -1,28 +0,0 @@
-/* $Id: sv4Lib.tmpl,v 1.1.1.1 1995/12/20 15:26:43 cernlib Exp $
- *
- * $Log: sv4Lib.tmpl,v $
- * Revision 1.1.1.1 1995/12/20 15:26:43 cernlib
- * X11R6 config files unmodified
- *
- *
- */
-XCOMM $XConsortium: sv4Lib.tmpl,v 1.20 95/07/06 14:06:11 kaleb Exp $
-
-/*
- * SVR4 shared library template
- */
-
-/* SVR4 shared libraries are deficient in link semantics */
-XMULIBONLY = -lXmu
-#ifndef FixupLibReferences
-#define FixupLibReferences() @@\
-XMULIB = $(XMULIBONLY) -z nodefs
-#endif
-#ifndef XawClientLibs
-#define XawClientLibs $(XAWLIB) $(XMULIBONLY) $(XTOOLLIB) $(XLIB)
-#endif
-#if ThreadedX
-#ifndef SharedX11Reqs
-#define SharedX11Reqs -lthread
-#endif
-#endif
diff --git a/src/config/svr4.cf b/src/config/svr4.cf
deleted file mode 100644
index c27a684..0000000
--- a/src/config/svr4.cf
+++ /dev/null
@@ -1,149 +0,0 @@
-/* $Id: svr4.cf,v 1.1.1.1 1995/12/20 15:26:45 cernlib Exp $
- *
- * $Log: svr4.cf,v $
- * Revision 1.1.1.1 1995/12/20 15:26:45 cernlib
- * X11R6 config files unmodified
- *
- *
- */
-XCOMM $XConsortium: svr4.cf,v 1.14 95/06/30 18:21:43 kaleb Exp $
-/*
- * A default OS name
- */
-#ifndef OSName
-#ifdef i386Architecture
-#define OSName UNIX System V/386 Release 4
-#else
-#define OSName UNIX System V Release 4
-#endif
-#endif
-#ifndef OSVendor
-#define OSVendor /**/
-#endif
-
-/*
- * The default version will be 4.0.0 which should be
- * the least common denominator of all SVR4
- */
-
-#ifndef OSMajorVersion
-#define OSMajorVersion 4
-#endif
-#ifndef OSMinorVersion
-#define OSMinorVersion 0
-#endif
-#ifndef OSTeenyVersion
-#define OSTeenyVersion 0
-#endif
-#ifndef BootstrapCFlags
-#ifdef i386Architecture
-#define BootstrapCFlags -DSVR4 -Di386
-#else
-#ifdef SYSV386
-#define BootstrapCFlags -DSVR4 -Di386
-#else
-#define BootstrapCFlags -DSVR4
-#endif
-#endif
-#endif
-
-/* Some stuff that all SVR4s should have */
-
-#define SystemV4 YES
-#ifndef HasLdRunPath
-#define HasLdRunPath YES
-#endif
-#define HasPoll YES
-#ifndef SVR4Architecture
-#define SVR4Architecture
-#endif
-#ifndef PatheticCpp
-#define PatheticCpp YES
-#endif
-#define Malloc0ReturnsNull YES /* in case -lmalloc used */
-
-/*
- * Here are the default paths to use to pick up tools for building.
- */
-#ifndef ArCmdBase
-#define ArCmdBase /usr/ccs/bin/ar
-#endif
-#ifndef AsCmd
-#define AsCmd /usr/ccs/bin/as
-#endif
-#ifndef CppCmd
-#define CppCmd /usr/ccs/lib/cpp
-#endif
-#ifndef LdCmd
-#define LdCmd /usr/ccs/bin/ld
-#endif
-#ifndef LexCmd
-#define LexCmd /usr/ccs/bin/lex
-#endif
-#ifndef MakeCmd
-#define MakeCmd /usr/ccs/bin/make
-#endif
-#ifndef YaccCmd
-#define YaccCmd /usr/ccs/bin/yacc
-#endif
-
-#if (OSMinorVersion == 0)
-#ifndef XawI18nDefines
-#define XawI18nDefines -DUSE_XWCHAR_STRING
-#endif
-#endif
-
-#ifdef i386Architecture
-#ifndef StandardDefines
-#define StandardDefines -DSVR4 -Di386
-#endif
-#ifndef ToolkitStringsABIOptions
-#define ToolkitStringsABIOptions -intelabi
-#endif
-#ifndef DefaultCCOptions
-#if HasGcc2
-#if !defined(SunArchitecture)
-#define DefaultCCOptions -ansi
-#endif
-#else
-#define DefaultCCOptions -Xa -Dasm=__asm
-#endif
-#endif
-#ifndef DefaultCDebugFlags
-#if HasGcc2
-#define DefaultCDebugFlags -O2
-#else
-#define DefaultCDebugFlags -O
-#endif
-#endif
-#ifndef ServerOSDefines
-#define ServerOSDefines -DDDXTIME XFree86ServerOSDefines
-#endif
-#endif
-
-/*
- * The TLI interface is more robust on most SVR4s, so it will be the default.
- */
-#if !defined(SunArchitecture)
-#ifndef ConnectionFlags
-#define ConnectionFlags -DSTREAMSCONN -DUNIXCONN -DLOCALCONN
-#endif
-#endif
-
-#ifndef ManSuffix
-#define ManSuffix 1x
-#define ManDir $(MANSOURCEPATH)1
-#endif
-#ifndef LibManSuffix
-#define LibManSuffix 3x
-#define LibmanDir $(MANSOURCEPATH)3
-#endif
-#ifndef FileManSuffix
-#define FileManSuffix 4
-#endif
-
-#ifdef i386Architecture
-#include <xfree86.cf>
-#endif
-
-#include <sv4Lib.rules>
diff --git a/src/config/ultrix.cf b/src/config/ultrix.cf
deleted file mode 100644
index f6bcf26..0000000
--- a/src/config/ultrix.cf
+++ /dev/null
@@ -1,75 +0,0 @@
-/* $Id: ultrix.cf,v 1.1.1.1 1995/12/20 15:26:45 cernlib Exp $
- *
- * $Log: ultrix.cf,v $
- * Revision 1.1.1.1 1995/12/20 15:26:45 cernlib
- * X11R6 config files unmodified
- *
- *
- */
-XCOMM platform: $XConsortium: ultrix.cf,v 1.64 94/04/09 20:44:15 rws Exp $
-
-#define OSName Ultrix-32 4.3
-XCOMM operating system: OSName
-#define OSMajorVersion 4
-#define OSMinorVersion 3
-
-#define HasNdbm YES
-#define HasPutenv YES
-#define HasShm YES
-#define LintLibFlag -o
-#define LintOpts -ax
-
-#if HasDECnet
-#define ExtraLibraries -ldnet
-#endif
-
-#if ThreadedX
-/* if you want to experiment, turn this on, but no guarantees */
-#define HasPosixThreads YES
-#define ExtraLibraries -lpthreads -li
-#endif
-
-#ifdef VaxArchitecture
-#define PexNativeFPFormat PEXDEC_F_Floating
-#define NativeFPFormat DEC_F_Float
-#define UnalignedReferencesAllowed YES /* if arbitrary deref is okay */
-#define BuildServer NO
-#endif
-
-#ifdef MipsArchitecture
-#if OSMajorVersion > 4 || (OSMajorVersion == 4 && OSMinorVersion >= 2)
-#define XdecServer YES
-#define ServerOSDefines -DDDXTIME
-/* Even under ultrix 4.2, the compiler miscompiles some alloca calls */
-#define AllocateLocalDefines /* -DINCLUDE_ALLOCA_H */
-#else
-#define BuildServer NO
-#define AllocateLocalDefines /**/
-#endif
-#if !HasGcc
-#define NeedFunctionPrototypes YES
-#define PexCCOptions -Wf,-XNp15000,-XNd15000
-/*
- * NormalLibObjCompile - compile fragment for a library object file
- * do ld -x to remove line number symbols for libraries
- */
-#define NormalLibObjCompile(options) $(RM) $@ $*.os \ @@\
- && $(CC) -c options $(CFLAGS) $*.c \ @@\
- && $(LD) $(LDSTRIPFLAGS) -r $@ -o $*.os \ @@\
- && $(MV) $*.os $@
-#endif
-#endif
-
-#if HasGcc
-#ifdef VaxArchitecture
-#define CcCmd gcc -ansi -Dvax -Dultrix -fpcc-struct-return
-#endif
-#ifdef MipsArchitecture
-#define CcCmd gcc -ansi -Dmips -Dultrix -fpcc-struct-return
-#endif
-#define ServerCCOptions /* */
-#define AllocateLocalDefines /* */
-#endif
-
-#define ServerExtraDefines AllocateLocalDefines
-#define HasWChar32 YES
diff --git a/src/config/usl.cf b/src/config/usl.cf
deleted file mode 100644
index 6171e92..0000000
--- a/src/config/usl.cf
+++ /dev/null
@@ -1,30 +0,0 @@
-/* $Id: usl.cf,v 1.1.1.1 1995/12/20 15:26:44 cernlib Exp $
- *
- * $Log: usl.cf,v $
- * Revision 1.1.1.1 1995/12/20 15:26:44 cernlib
- * X11R6 config files unmodified
- *
- *
- */
-XCOMM platform: $XConsortium: usl.cf,v 1.37 95/06/30 18:11:39 kaleb Exp $
-
-#define OSName UNIX System V/386 Release 4.2 Version 1.1.1
-XCOMM operating system: OSName
-#define OSMajorVersion 4
-#define OSMinorVersion 2
-#define OSTeenyVersion 1
-
-#define BootstrapCFlags -DUSL
-#define StandardDefines -DUSL -DSVR4 -Di386
-#define NeedWidePrototypes NO /* experimental */
-#define ServerExtraDefines -D__USLC__ XFree86ServerDefines
-#define ServerOSDefines -DDDXTIME XFree86ServerOSDefines
-#define ToolkitStringsABIOptions -intelabi
-#define XawI18nDefines -DHAS_WCTYPE_H -DHAS_ISW_FUNCS
-#if OSTeenyVersion > 1
-#define ExtraLibraries -lsocket -lnsl -lgen
-#define ThreadedX YES
-#define SystemMTDefines -D_REENTRANT
-#define ThreadsLibraries -lthread
-#endif
-#include <svr4.cf>
diff --git a/src/config/x386.cf b/src/config/x386.cf
deleted file mode 100644
index e170b3d..0000000
--- a/src/config/x386.cf
+++ /dev/null
@@ -1,172 +0,0 @@
-/* $Id: x386.cf,v 1.2 2005/04/18 15:23:07 mclareni Exp $
- *
- * $Log: x386.cf,v $
- * Revision 1.2 2005/04/18 15:23:07 mclareni
- * Mods submitted by Kevin B. McCarty to fix insecure Cernlib uses of /tmp.
- *
- * Revision 1.1.1.1 1995/12/20 15:26:43 cernlib
- * X11R6 config files unmodified
- *
- *
- */
-XCOMM platform: $XConsortium: x386.cf,v 1.12 95/06/09 21:28:51 gildea Exp $
-
-/*****************************************************************************
- * Site-specfic parameters *
- *****************************************************************************/
-
-/*
- * there are some switches to set appropriate...
- */
-
-#define HasGcc YES /* doesn't work for SVR4 */
-#define HasNdbm YES /* correct for GNU dbm & SVR4 */
-#define StripInstalledPrograms YES
-#define X386Server YES
-#define ExtensionOSDefines -DXTESTEXT1
-#define MotifBC YES
-
-/*****************************************************************************
- * Do not change anything below *
- *****************************************************************************/
-
-/* You must manually compute BootstrapCFlags for initial build */
-#define BootstrapCFlags OSDefines OSRelease
-
-#define StandardDefines OSDefines OSRelease
-#define LdCombineFlags -r
-
-#if defined(i386SVR3Architecture)
-
-#define SystemV YES
-
-#define NeedBerklib YES
-#define HasSymLinks NO
-
-/*
- * V/386 Release 3.2
- */
-#ifdef ISC
-/* INTERACTIVE UNIX Version 2.2.1 */
-# define OSVendor "Interactive System Corp."
-# define OSDefines -DISC
-# define LocalLibraries -lpt
-# define PosixLibraries -lcposix
-# define SocketLibraries -linet
-#endif
-
-#ifdef ESIX
-#define OSVendor "ESIX System Inc."
-#define OSDefines -DESIX
-#define LocalLibraries -lpt
-#define SocketLibraries -lnet -lnsl_s
-#define PosixLibraries /**/
-#endif
-
-#ifdef SCO
-#define OSDefines -DSCO -DBROKEN_FTOL -DNO_PROTOTYPE -D_SVID
-#define OSVendor "Santa Cruz Operation Ltd."
-#define LocalLibraries -lpt
-#define SocketLibraries -lsocket
-#define PosixLibraries /**/
-#endif
-
-#ifdef ATT
-#define OSDefines -DATT
-#define OSVendor "AT&T"
-#define LocalLibraries -lpt
-#define SocketLibraries -lnet -lnsl_s /* just a guess */
-#define PosixLibraries /**/
-#endif
-
-#define OSName Unix System V/386 Release 3.2
-#define OSMajorVersion 3
-#define OSMinorVersion 2
-#define OSRelease -DSYSV -DSYSV386
-
-#if HasGcc
-# define CcCmd gcc -DNO_ASM -fstrength-reduce -fpcc-struct-return -fwritable-strings
-# define LibraryCcCmd gcc -DNO_ASM -fstrength-reduce -fpcc-struct-return
-# define ShlibDefines -D__GNUC__ -DGNULIB=/usr/local/lib/gcc-gnulib
-#else
-# define ShlibDefines /**/
-#endif
-
-#if HasSockets
-/* # define ConnectionFlags -DLOCALCONN -DTCPCONN */
-# define ConnectionFlags -DTCPCONN
-# define ExtraLibraries SocketLibraries LocalLibraries -lc_s PosixLibraries
-#else
-# define ConnectionFlags -DLOCALCONN
-# define ExtraLibraries $(LIBDIR)/etc/inetemul.o LocalLibraries -lc_s PosixLibraries
-#endif
-
-/* #include <sv3Lib.rules> */ /* not working yet */
-
-/*
- * Man pages need to be formatted when installed, so override the default
- * imake rules.
- */
-#define InstallManPageLong(file,destdir,dest) @@\
-install.man:: file.man @@\
- $(RM) destdir/dest.$(MANSUFFIX) @@\
- TMP=destdir/dest.$$$$.$(MANSUFFIX) ; \ @@\
- $(INSTALL) -c $(INSTMANFLAGS) file.man $${TMP} ; \ @@\
- cat file.man | neqn | nroff -man >$${TMP} ; \ @@\
- $(INSTALL) -c $(INSTMANFLAGS) $${TMP} destdir/dest.$(MANSUFFIX) ; \ @@\
- $(RM) $${TMP}
-
-#define InstallMultipleMan(list,dest) @@\
-install.man:: list @@\
- @case '${MFLAGS}' in *[i]*) set +e;; esac; \ @@\
- for i in list; do \ @@\
- (set -x; \ @@\
- $(RM) dest/$$i; \ @@\
- TMP=dest/$$i.$$$$ ; \ @@\
- $(INSTALL) -c $(INSTMANFLAGS) $$i $${TMP} ; \ @@\
- cat $$i | neqn | nroff -man >$${TMP}; \ @@\
- $(INSTALL) -c $(INSTMANFLAGS) $${TMP} dest/$$i; \ @@\
- $(RM) $${TMP} ); \ @@\
- done
-
-/* If you have trouble with make bombing out in Xlib, try uncommenting this. */
-/* You will not get dependencies as a result, but better than nothing. */
-/* #define DependTarget3(srcs1,srcs2,srcs3) */
-
-#endif /* i386SVR3Architecture */
-
-
-/*
- * V/386 Release 4.0
- */
-#if defined(i386SVR4Architecture)
-
-#define SystemV4 YES
-
-/* this is now just for Dell's one */
-
-#ifdef DELL
-#define OSDefines -DDELL
-#define OSVendor "DELL Computer Corp."
-#endif
-
-#define OSName Unix System V/386 Release 4.0
-#define OSMajorVersion 4
-#define OSMinorVersion 0
-#define OSRelease -DSVR4 -DSYSV386
-
-#if HasGcc
-# define CcCmd gcc -ansi -fstrength-reduce -fpcc-struct-return -Di386
-# if HasSharedLibraries
-# define LibraryCcCmd cc -Xa -Di386 -Dasm=__asm
-# endif
-#else
-# define CcCmd cc -Xa -Di386 -Dasm=__asm
-#endif
-
-#include <sv4Lib.rules>
-
-#endif /* i386SVR4Architecture */
-
-
-XCOMM operating system: OSName OSVendor
diff --git a/src/config/xf86.rules b/src/config/xf86.rules
deleted file mode 100644
index 277e952..0000000
--- a/src/config/xf86.rules
+++ /dev/null
@@ -1,131 +0,0 @@
-/* $Id: xf86.rules,v 1.1.1.1 1995/12/20 15:26:45 cernlib Exp $
- *
- * $Log: xf86.rules,v $
- * Revision 1.1.1.1 1995/12/20 15:26:45 cernlib
- * X11R6 config files unmodified
- *
- *
- */
-XCOMM $XConsortium: xf86.rules,v 1.7 95/01/25 16:34:39 kaleb Exp $
-
-/*
- * These rules are needed to build the Xfree86 X Servers
- */
-
-#ifndef CPPOnlyAsm
-#define CPPOnlyAsm(basename,options) RemoveFile(basename.i) @@\
- $(CPP) AsmDefines $(DEFINES) $(INCLUDES) options basename.s | \ @@\
- grep -v '^\#' > basename.i
-#endif
-
-#ifndef AssembleObject
-#define AssembleObject(flags) CPPOnlyAsm($*,flags) @@\
- $(AS) -o $*.o $*.i @@\
- RemoveFile($*.i)
-#endif
-
-#ifndef NormalAsmObjectRule
-#define NormalAsmObjectRule() @@\
-.s.o: @@\
- AssembleObject($(_NOOP_)) @@\
- @@\
-.s.i: @@\
- CPPOnlyAsm($*,$(_NOOP_))
-#endif
-
-#ifndef ObjectFromSpecialAsmSource
-#define ObjectFromSpecialAsmSource(dst,src,flags) @@\
-dst.s: src.s @@\
- RemoveFile($@) @@\
- $(LN) $? $@ @@\
- @@\
-dst.o: dst.s @@\
- AssembleObject(flags) @@\
- @@\
-dst.i: dst.s @@\
- CPPOnlyAsm(dst,flags) @@\
- @@\
-depend:: dst.s @@\
- @@\
-clean:: @@\
- RemoveFile(dst.s)
-#endif
-
-
-/*
- * Rules for building config files from scripts
- */
-
-#ifndef Depend
-# define Depend depend
-#endif
-
-#ifndef ConfigTargetLong
-#define ConfigTargetLong(target,dep,script,args,extra) @@\
-all:: Configure @@\
- @@\
-Configure:: target.o @@\
- @@\
-target.c: script dep @@\
- $(MAKE) $(MFLAGS) Makefile @@\
- $(MAKE) $(MFLAGS) extra Concat(Build,target) @@\
- @@\
-Concat(Build,target): @@\
- $(RM) target.c @@\
- $(SHELL) script args @@\
- @@\
-clean:: @@\
- $(RM) target.c
-#endif
-
-#define ConfigTarget(target,dep,script,args) ConfigTargetLong(target,dep,script,args,Depend)
-
-#define ConfigTargetNoDepend(target,dep,script,args) ConfigTargetLong(target,dep,script,args,)
-
-/*
- * Rules for installing LinkKit parts (target is install.linkkit)
- */
-
-#ifndef InstallLinkKitNonExecFile
-#define InstallLinkKitNonExecFile(file,dest) @@\
-install.linkkit:: file @@\
- MakeDir($(DESTDIR)dest) @@\
- $(INSTALL) -c $(INSTDATFLAGS) file $(DESTDIR)dest
-#endif
-
-#ifndef InstallLinkKitLibrary
-#define InstallLinkKitLibrary(libname,dest) @@\
-install.linkkit:: Concat(lib,libname.a) @@\
- MakeDir($(DESTDIR)dest) @@\
- $(INSTALL) -c $(INSTLIBFLAGS) Concat(lib,libname.a) $(DESTDIR)dest @@\
- RanLibrary($(RANLIBINSTFLAGS) Concat($(DESTDIR)dest/lib,libname.a))
-#endif
-
-#ifndef InstallLinkKitNamedLibrary
-#define InstallLinkKitNamedLibrary(libname,dlibname,dest) @@\
-install.linkkit:: Concat(lib,libname.a) @@\
- MakeDir($(DESTDIR)dest) @@\
- $(INSTALL) -c $(INSTLIBFLAGS) Concat(lib,libname.a) \ @@\
- Concat($(DESTDIR)dest/lib,dlibname.a) @@\
- RanLibrary($(RANLIBINSTFLAGS) Concat($(DESTDIR)dest/lib,dlibname.a))
-#endif
-
-#ifndef InstallLinkKitNamedNonExec
-#define InstallLinkKitNamedNonExec(srcname,dstname,dest) @@\
-install.linkkit:: srcname @@\
- MakeDir($(DESTDIR)dest) @@\
- $(INSTALL) -c $(INSTDATFLAGS) srcname $(DESTDIR)dest/dstname
-#endif
-
-#ifndef InstallLinkKitNamedProg
-#define InstallLinkKitNamedProg(srcname,dstname,dest) @@\
-install.linkkit:: srcname @@\
- MakeDir($(DESTDIR)dest) @@\
- $(INSTALL) -c $(INSTBINFLAGS) srcname $(DESTDIR)dest/dstname
-#endif
-
-#ifndef InstallLinkKitSubdirs
-#define InstallLinkKitSubdirs(dirs) \
-NamedTargetSubdirs(install.linkkit,dirs,"installing link kit",DESTDIR='$(DESTDIR)',install.linkkit)
-#endif
-
diff --git a/src/config/xfree86.cf b/src/config/xfree86.cf
deleted file mode 100644
index 130ad27..0000000
--- a/src/config/xfree86.cf
+++ /dev/null
@@ -1,367 +0,0 @@
-/* $Id: xfree86.cf,v 1.1.1.1 1995/12/20 15:26:46 cernlib Exp $
- *
- * $Log: xfree86.cf,v $
- * Revision 1.1.1.1 1995/12/20 15:26:46 cernlib
- * X11R6 config files unmodified
- *
- *
- */
-XCOMM $XConsortium: xfree86.cf,v 1.9 95/01/25 16:42:40 kaleb Exp $
-/*
- * This configuration file contains all of the configuration
- * information for the XFree86 based X Servers.
- *
- * Most of these settings can be overridden in a vendor.cf or the
- * BeforeVendor part of the site.def file.
- */
-
-/*
- * Default settings for which X Servers to build.
- */
-#ifndef XF86SVGAServer
-# define XF86SVGAServer YES
-#endif
-
-#ifndef XF86VGA16Server
-# define XF86VGA16Server NO
-# ifndef XF86VGA16DualServer
-# define XF86VGA16DualServer NO
-# endif
-#endif
-
-#ifndef XF86MonoServer
-# define XF86MonoServer NO
-# ifndef XF86MonoDualServer
-# define XF86MonoDualServer NO
-# endif
-#endif
-
-#ifndef XF86S3Server
-# define XF86S3Server NO
-#endif
-
-#ifndef XF86I8514Server
-# define XF86I8514Server NO
-#endif
-
-#ifndef XF86Mach8Server
-# define XF86Mach8Server NO
-#endif
-
-#ifndef XF86Mach32Server
-# define XF86Mach32Server NO
-#endif
-
-#ifndef XF86Mach64Server
-# define XF86Mach64Server NO
-#endif
-
-#ifndef XF86AGXServer
-# define XF86AGXServer NO
-#endif
-
-#ifndef XF86P9000Server
-# define XF86P9000Server NO
-#endif
-
-#ifndef XF86W32Server
-# define XF86W32Server NO
-#endif
-
-#if XF86S3Server
-# define XF86S3Dir s3
-#else
-# define XF86S3Dir /**/
-#endif
-
-#if XF86I8514Server
-# define XF86I8514Dir ibm8514
-#else
-# define XF86I8514Dir /**/
-#endif
-
-#if XF86Mach8Server
-# define XF86Mach8Dir mach8
-#else
-# define XF86Mach8Dir /**/
-#endif
-
-#if XF86Mach32Server
-# define XF86Mach32Dir mach32
-#else
-# define XF86Mach32Dir /**/
-#endif
-
-#if XF86Mach64Server
-# define XF86Mach64Dir mach64
-#else
-# define XF86Mach64Dir /**/
-#endif
-
-#if XF86P9000Server
-# define XF86P9000Dir p9000
-#else
-# define XF86P9000Dir /**/
-#endif
-
-#if XF86AGXServer
-# define XF86AGXDir agx
-#else
-# define XF86AGXDir /**/
-#endif
-
-#if XF86W32Server
-# define XF86W32Dir et4000w32
-#else
-# define XF86W32Dir /**/
-#endif
-
-#undef XF86AccelServerDirs
-#define XF86AccelServerDirs XF86S3Dir XF86I8514Dir XF86Mach8Dir XF86Mach32Dir XF86Mach64Dir XF86P9000Dir XF86AGXDir XF86W32Dir
-
-#undef XF86AccelServer
-#if XF86S3Server || XF86I8514Server || XF86Mach8Server || XF86Mach32Server || XF86Mach64Server || XF86P9000Server || XF86AGXServer || XF86W32Server
-# define XF86AccelServer YES
-#else
-# define XF86AccelServer NO
-#endif
-
-/*
- * Driver list for several of the X Servers.
- */
-#ifndef XF86SvgaDrivers
-# define XF86SvgaDrivers et4000 et3000 pvga1 gvga ati tvga8900 cirrus \
- ncr77c22 compaq oak mx al2101 ali cl64xx \
- video7 chips generic
-#endif
-
-#ifndef XF86Vga16Drivers
-# define XF86Vga16Drivers et4000 ncr77c22 ati tvga8900 oak cl64xx generic
-#endif
-
-#ifndef XF86Vga2Drivers
-# define XF86Vga2Drivers et4000 et3000 pvga1 gvga ati tvga8900 cirrus \
- ncr77c22 compaq oak cl64xx generic
-#endif
-
-#ifndef XF86Vga2Banked
-# define XF86Vga2Banked YES
-#endif
-
-#ifndef XF86MonoDrivers
-# define XF86MonoDrivers hgc1280 sigma apollo hercules
-#endif
-
-/* This doesn't do anything (yet) */
-#ifndef XF86S3Drivers
-# define XF86S3Drivers mmio_928 s3_generic
-#endif
-
-#ifndef XF86W32Drivers
-# define XF86W32Drivers et4000w32
-#endif
-
-#ifndef BuildPexExt
-#define BuildPexExt XF86AccelServer || XF86SVGAServer
-#endif
-
-#ifndef BuildXIE
-#define BuildXIE XF86AccelServer || XF86SVGAServer
-#endif
-
-/*
- * By default, build all of the fonts.
- */
-#ifndef Build75Dpi
-#define Build75Dpi YES
-#endif
-#ifndef Build100Dpi
-#define Build100Dpi YES
-#endif
-#ifndef BuildSpeedo
-#define BuildSpeedo YES
-#endif
-#ifndef BuildType1
-#define BuildType1 YES
-#endif
-
-#ifndef CompressAllFonts
-#define CompressAllFonts YES
-#endif
-
-#ifndef InstallXcmsTxt
-#define InstallXcmsTxt YES
-#endif
-
-#ifndef HasLinuxDoc
-#define HasLinuxDoc NO
-#endif
-
-#ifndef InstallJapaneseDocs
-#define InstallJapaneseDocs NO
-#endif
-
-/* Server defines required for all OSs */
-#ifndef XFree86ServerDefines
-#define XFree86ServerDefines -DSTATIC_COLOR -DAVOID_GLYPHBLT -DPIXPRIV LinkKitDefines
-#endif
-
-#ifndef XFree86ServerOSDefines
-#define XFree86ServerOSDefines -DDDXOSINIT -DSERVER_LOCK
-#endif
-
-#ifndef XFree86ConsoleDefines
-#ifdef i386BsdArchitecture
-#define XFree86ConsoleDefines -DPCCONS_SUPPORT -DSYSCONS_SUPPORT -DPCVT_SUPPORT
-#else
-#define XFree86ConsoleDefines /**/
-#endif
-#endif
-
-#ifndef UseServerLock
-#define UseServerLock YES
-#endif
-
-#ifndef XF86LinkKit
-#define XF86LinkKit NO
-#endif
-
-#ifndef LinkKitDefines
-#if XF86LinkKit
-#define LinkKitDefines -DLINKKIT
-#else
-#define LinkKitDefines /**/
-#endif
-#endif
-
-#ifndef ServerExtraDefines
-#define ServerExtraDefines XFree86ServerDefines
-#endif
-
-#ifndef ServerOSDefines
-#define ServerOSDefines XFree86ServerOSDefines
-#endif
-
-#ifndef LinkKitDir
-#define LinkKitDir $(USRLIBDIR)/Server
-#endif
-
-LINKKITDIR = LinkKitDir
-
-/*
- * Some commonly refered to directories are defined here.
- */
-
-#if XF86LinkKit
- XF86SRC = $(TOP)
- XF86ACCELSRC = $(XF86SRC)/lib
- XF86COMSRC = $(XF86SRC)/lib
- XF86CONFIGSRC = $(XF86SRC)
- XF86HWSRC = $(XF86SRC)/lib
- XF86OSSRC = $(XF86SRC)/lib
- DRIVERSRC = $(XF86SRC)/drivers
- VGADRIVERSRC = $(XF86SRC)/drivers/vga256
-VGA16DRIVERSRC = $(XF86SRC)/drivers/vga16
- VGA2DRIVERSRC = $(XF86SRC)/drivers/vga2
- MONODRIVERSRC = $(XF86SRC)/drivers/mono
- S3DRIVERSRC = $(XF86SRC)/drivers/s3
-
-#ifdef SiteIConfigFiles
-#undef SiteIConfigFiles
-#endif
-#define SiteIConfigFiles $(TOP)/site.def $(TOP)/Imakefile
-#else
- XF86SRC = $(SERVERSRC)/hw/xfree86
- XF86ACCELSRC = $(XF86SRC)/accel
- XF86COMSRC = $(XF86SRC)/common
- XF86CONFIGSRC = $(XF86COMSRC)
- XF86HWSRC = $(XF86SRC)/common_hw
- XF86OSSRC = $(XF86SRC)/os-support
- VGADRIVERSRC = $(XF86SRC)/vga256/drivers
-VGA16DRIVERSRC = $(XF86SRC)/vga16/drivers
- VGA2DRIVERSRC = $(XF86SRC)/vga2/drivers
- MONODRIVERSRC = $(XF86SRC)/mono/drivers
- S3DRIVERSRC = $(XF86SRC)/accel/s3/drivers
-#endif
-
-/*
- * These libraries are needed by all X Servers
- */
-
-XF86INIT = $(XF86COMSRC)/xf86Init.o
-XF86MINIT = $(XF86COMSRC)/xf86Init_m.o
-XF86CONFIG = $(XF86CONFIGSRC)/xf86_Option.o
-XF86COMLIB = $(XF86COMSRC)/libxf86.a
-XF86OSLIB = $(XF86OSSRC)/libxf86_os.a
-XF86HWLIB = $(XF86HWSRC)/libxf86_hw.a
-XF86LIBS = $(XF86INIT) $(XF86CONFIG) $(XF86COMLIB) $(XF86HWLIB) $(XF86OSLIB)
-XF86MLIBS = $(XF86MINIT) $(XF86CONFIG) $(XF86COMLIB) $(XF86HWLIB) $(XF86OSLIB)
-
- XFREE86DOCDIR = $(LIBDIR)/doc
- XFREE86PSDOCDIR = $(XFREE86DOCDIR)/PostScript
- XFREE86HTMLDOCDIR = $(XFREE86DOCDIR)/html
-XFREE86JAPANESEDOCDIR = $(XFREE86DOCDIR)/Japanese
-
-/*
- * Other stuff used in the X Server source.
- */
-
-#ifndef AsmDefines
-#define AsmDefines /**/
-#endif
-
-#ifndef XFree86Version
-#define XFree86Version 3110
-#endif
-
-#ifndef XVendorString
-#define XVendorString "The XFree86 Project, Inc"
-#endif
-
-#ifndef XVendorRelease
-#define XVendorRelease XFree86Version
-#endif
-
-#ifndef UseRgbTxt
-#define UseRgbTxt YES
-#endif
-
-
-/*
- * GNU Compiler stuff
- */
-#ifndef HasGcc2
-#define HasGcc2 NO
-#endif
-#ifndef HasGcc
-#define HasGcc HasGcc2
-#endif
-#ifndef HasGcc2ForCplusplus
-#define HasGcc2ForCplusplus HasGcc2
-#endif
-
-#if HasGcc
-#ifndef DefaultCCOptions
-#if defined(SunArchitecture) && defined(i386Architecture)
-#define DefaultCCOptions -DNO_ASM
-#else
-#define DefaultCCOptions -ansi -DNO_ASM
-#endif
-#endif
-#endif
-
-#ifndef BuildLBXCompatible
-#define BuildLBXCompatible NO
-#endif
-
-#ifndef BuildLBX
-#define BuildLBX NO
-#endif
-
-#if BuildLBXCompatible
-#if !BuildLBX
-#define LbxDefines -DLBX_COMPAT
-#endif
-#endif
-
-#include <xf86.rules>
diff --git a/src/graflib/Imakefile b/src/graflib/Imakefile
deleted file mode 100644
index f703e36..0000000
--- a/src/graflib/Imakefile
+++ /dev/null
@@ -1,22 +0,0 @@
-
-#define IHaveSubdirs
-#define PassCDebugFlags
-
-
-LIBDIRS= dzdoc hplot
-
-SUBDIRS= $(LIBDIRS) higz
-
-MakeSubdirs($(SUBDIRS))
-
-SubdirLibraryTarget(graflib,$(LIBDIRS))
-
-InstallLibrary(graflib,$(CERN_LIBDIR))
-
-InstallLibSubdirs(higz)
-
-TestSubdirs(higz)
-
-InstallBinSubdirs(dzdoc)
-
-InstallIncludeSubdirs($(SUBDIRS))
diff --git a/src/graflib/dzdoc/Imakefile b/src/graflib/dzdoc/Imakefile
deleted file mode 100644
index 4784721..0000000
--- a/src/graflib/dzdoc/Imakefile
+++ /dev/null
@@ -1,17 +0,0 @@
-
-#define IHaveSubdirs
-#define PassCDebugFlags
-
-
-LIBDIRS= cdf dzdkern dzdraw
-SUBDIRS= $(LIBDIRS) dzedit dzdoc
-
-TopOfPackage(dzdoc)
-
-SubdirLibraryTarget(dzdoc,$(LIBDIRS))
-
-InstallBinSubdirs(dzedit)
-
-InstallIncludeSubdirs(dzdoc)
-
-/* doc dzdoc dzedit dzeditcdf */
diff --git a/src/graflib/dzdoc/cdf/Imakefile b/src/graflib/dzdoc/cdf/Imakefile
deleted file mode 100644
index 73c5e63..0000000
--- a/src/graflib/dzdoc/cdf/Imakefile
+++ /dev/null
@@ -1,5 +0,0 @@
-#define IHaveCDF
-
-SRCS_CDF = zbrcdf.cdf
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/graflib/dzdoc/cdf/zbrcdf.cdf b/src/graflib/dzdoc/cdf/zbrcdf.cdf
deleted file mode 100644
index da8ada6..0000000
--- a/src/graflib/dzdoc/cdf/zbrcdf.cdf
+++ /dev/null
@@ -1,847 +0,0 @@
-*
-* $Id: zbrcdf.cdf,v 1.1.1.1 1996/03/04 16:12:51 mclareni Exp $
-*
-* $Log: zbrcdf.cdf,v $
-* Revision 1.1.1.1 1996/03/04 16:12:51 mclareni
-* Dzdoc/Zebpack
-*
-*
-
->NAME ZBRDEF
-
->Graphics
->Browse Zebra ' ' DZDZEB
-List
-'Open bank doc Rzfile' . 'DZDOC/FILE/OPEN_DOC'
-'Add doc directory' . 'DZDOC/FILE/DIR_ADD'
-'Put doc into Rzfile' . 'DZDOC/FILE/EDIT_DOC'
-'Display bank tree' . 'DZDOC/BANKDISPLAY/TREE'
-
->Class /STORE Stores big_store sm_dir
-List
-'Show store DZSTOR' . 'SHOW_STORE [this]'
-
->Class /DIV Divisions big_div sm_key
-List
-'Display division' . 'BROWSE/SHOW_DIV [this]'
-'Snap division' . 'BROWSE/SNAP_DIV [this]'
-'Verify division' . 'BROWSE/VERIFY_DIV [this]'
-'Collect garbage' . 'BROWSE/COL_GARB [this]'
-'Set filter for banks' . 'BROWSE/FILT_BANKS'
-
->Class BANK Banks big_bank sm_key
-'Display bank tree' . ' ' DZDB01
-'Show cont documentd' . ' ' DZDB03
-'DZ Show contents' . ' ' DZDB04
-'Show system words' . ' ' DZDB05
-'Survey bank tree' . ' ' DZDB06
-'Put into vector' . 'BROWSE/PT_VECT [that]'
-'Show documention' . ' ' DZDB07
-'Edit documention' . ' ' DZDB08
-'Modify data words' . 'BROWSE/SH_MODIFY [that]'
-'Drop bank (tree)' . 'BROWSE/SH_DROP [that]'
-'Write fo FZ file' . 'BROWSE/SH_FOUT [that]'
-+
-'Display bank tree' . ' ' DZDB11
-'More down banks' . ' ' DZDB12
-'Show cont documentd' . ' ' DZDB13
-'DZ Show contents' . ' ' DZDB14
-'Show sytem words' . ' ' DZDB15
-'Survey bank tree' . ' ' DZDB16
-'Put into vector' . 'BROWSE/PT_VECT -[this]'
-'Show documention' . ' ' DZDB17
-'Edit documention' . ' ' DZDB18
-'Mark for Ntuple' . 'BROWSE/MARK_NT -[this]'
-'Modify data words' . 'BROWSE/SH_MODIFY -[this]'
-'Drop bank (tree)' . 'BROWSE/SH_DROP -[this]'
-'Write fo FZ file' . 'BROWSE/SH_FOUT -[this]'
-
->Class /rzfil Rzfile rzfile sm_dir
-List
-'Close Rzfile' . 'BROWSE/CLOSE_RZ [this]'
-'Show status' . 'BROWSE/SHOW_RZS [this]'
-
->Class /rzdir Rz-directory rzdir sm_dir
-List
-'List directory (RZLDIR)' . 'BROWSE/SH_RZLDIR [path]/[this]'
-'Show key definition' . 'BROWSE/SH_KEY_DEF [path]/[this]'
-'Set filter on keys' . 'BROWSE/FILT_KEY'
-
->Class key Keys big_key sm_key
-'Read key into memory' . 'BROWSE/GET_KEY [path] [that]'
-'Show key definition' . 'BROWSE/SH_KEY_DEF [path]/[this]'
-'Show key words' . 'BROWSE/SH_KEY [path] [that]'
-'Set filter on keys' . 'BROWSE/FILT_KEY'
-
-
->Class FZ Fzfiles fzfile sm_dir
-'Get event (head + d/s)' . 'BROWSE/GET_EVENT [that] D'
-'Get user header' . 'BROWSE/GET_HEAD [that] D'
-'Get the pending d/s ' . 'BROWSE/GET_PDS [that] D'
-'List marked for Ntuple' . 'BROWSE/LIST_NTUPLE '
-'Fill Ntuple' . 'BROWSE/FILL_NTUPLE [that]'
-'Show Fzfile info' . 'BROWSE/SH_FZINFO [that]'
-'Set logging level' . 'BROWSE/FZ_LOG_LEVEL [that]'
-'Rewind Fzfile' . 'BROWSE/REWIND_FZ [that]'
-'Close Fzfile' . 'BROWSE/CLOSE_FZ [that]'
-
->Icon_bitmaps
-#define rzfile_width 30
-#define rzfile_height 30
-static char rzfile_bits[] = {
- 0x01, 0xfe, 0xff, 0xff, 0xfc, 0x00, 0x00, 0xe0, 0xfe, 0x01, 0x08, 0xe0,
- 0x86, 0x01, 0x14, 0xe0, 0x86, 0x01, 0x3e, 0xe0, 0xfe, 0x00, 0x55, 0xe0,
- 0x7e, 0x80, 0xff, 0xe0, 0x66, 0xc0, 0xd5, 0xe1, 0xe6, 0x60, 0x7f, 0xe3,
- 0xc6, 0xa1, 0xef, 0xe3, 0x86, 0x21, 0xfb, 0xe2, 0x00, 0x50, 0x5e, 0xe3,
- 0x01, 0xa8, 0xb4, 0xe2, 0x01, 0x44, 0x59, 0xe3, 0x01, 0x8c, 0xaa, 0xe2,
- 0x00, 0x14, 0x5d, 0xf3, 0xfe, 0x25, 0xae, 0xf2, 0xfe, 0x45, 0x5b, 0xf3,
- 0xc0, 0x85, 0xa9, 0xf2, 0xe0, 0x84, 0x5c, 0xf3, 0x70, 0x88, 0xae, 0xf2,
- 0x38, 0x90, 0x5b, 0xf1, 0x1c, 0xa0, 0xa9, 0xf0, 0x0e, 0xc0, 0x59, 0xf0,
- 0xfe, 0x80, 0x2a, 0xf0, 0xfe, 0x01, 0x1c, 0xf0, 0x00, 0x00, 0x08, 0xf0,
- 0x01, 0x00, 0x00, 0xf0, 0x01, 0xe0, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff};
-
-#define fzfile_width 30
-#define fzfile_height 30
-static char fzfile_bits[] = {
- 0x00, 0x00, 0x00, 0xe0, 0xfe, 0x03, 0x00, 0xe0, 0xfe, 0x03, 0x08, 0xe0,
- 0x06, 0x00, 0x14, 0xe0, 0x06, 0x00, 0x3e, 0xe0, 0x7e, 0x00, 0x55, 0xe0,
- 0x7e, 0x80, 0xff, 0xe0, 0x06, 0xc0, 0xd5, 0xe1, 0x06, 0x60, 0x7f, 0xe3,
- 0x06, 0xa0, 0xef, 0xe3, 0x06, 0x20, 0xfb, 0xe2, 0x06, 0x50, 0x5e, 0xe3,
- 0x06, 0xa8, 0xb4, 0xe2, 0x00, 0x44, 0x59, 0xe3, 0x00, 0x8c, 0xaa, 0xe2,
- 0x00, 0x14, 0x5d, 0xe3, 0xfe, 0x25, 0xae, 0xe2, 0xfe, 0x45, 0x5b, 0xe3,
- 0xc0, 0x95, 0xa9, 0xe2, 0xe0, 0xa4, 0x5c, 0xe3, 0x70, 0x88, 0xae, 0xe2,
- 0x38, 0x90, 0x5b, 0xe1, 0x1c, 0xa0, 0xa9, 0xe0, 0x0e, 0xc0, 0x59, 0xe0,
- 0xfe, 0x81, 0x2a, 0xe0, 0xfe, 0x01, 0x1c, 0xe0, 0x00, 0x00, 0x08, 0xe0,
- 0x00, 0x00, 0x00, 0xe0, 0x00, 0x00, 0x00, 0xe0, 0xff, 0xff, 0xff, 0xff};
-
-#define rzdir_width 30
-#define rzdir_height 23
-static char rzdir_bits[] = {
- 0xff, 0xff, 0xff, 0x3f, 0x01, 0x00, 0x00, 0x20, 0x01, 0x00, 0x00, 0x30,
- 0xa9, 0xaa, 0xaa, 0x3a, 0x51, 0x55, 0x55, 0x35, 0xa9, 0xaa, 0xaa, 0x3a,
- 0x01, 0x54, 0x15, 0x30, 0x01, 0xa8, 0x0a, 0x30, 0x51, 0x01, 0x40, 0x35,
- 0xa9, 0x02, 0xa0, 0x3a, 0x51, 0x55, 0x55, 0x35, 0xa9, 0xaa, 0xaa, 0x3a,
- 0xd1, 0x5f, 0xff, 0x34, 0xe9, 0x1f, 0xff, 0x3a, 0xd1, 0x5c, 0x75, 0x35,
- 0xe9, 0xae, 0xba, 0x3a, 0xd1, 0x57, 0x5d, 0x35, 0xe9, 0xae, 0xae, 0x3a,
- 0xd1, 0x5c, 0xff, 0x34, 0xe9, 0xba, 0xff, 0x3a, 0x51, 0x55, 0x55, 0x35,
- 0xfd, 0xff, 0xff, 0x3f, 0xff, 0xff, 0xff, 0x3f};
-
-#define big_key_width 30
-#define big_key_height 30
-static char big_key_bits[] = {
- 0x00, 0x00, 0x00, 0xc0, 0xe0, 0x1f, 0x00, 0xc0, 0x78, 0xf0, 0xff, 0xcf,
- 0x18, 0xc0, 0xff, 0xcf, 0x0c, 0x80, 0xff, 0xcf, 0x8c, 0x87, 0xff, 0xcf,
- 0xc4, 0x0f, 0xff, 0xcf, 0xc4, 0x1f, 0xff, 0xcf, 0xc4, 0x1f, 0xff, 0xcf,
- 0xc4, 0x1f, 0xff, 0xcf, 0xc4, 0x0f, 0xff, 0xcf, 0x8c, 0x87, 0xff, 0xcf,
- 0x0c, 0x00, 0xff, 0xcf, 0x1c, 0x00, 0xfe, 0xcf, 0x7c, 0x10, 0xfc, 0xcf,
- 0xfc, 0x3f, 0xf8, 0xcf, 0xfc, 0x7f, 0xf0, 0xcf, 0xfc, 0xff, 0xe0, 0xcf,
- 0xfc, 0xff, 0xc1, 0xcf, 0xfc, 0xff, 0x83, 0xcf, 0xfc, 0xff, 0x03, 0xcf,
- 0xfc, 0xff, 0x01, 0xce, 0xfc, 0xff, 0x00, 0xce, 0xfc, 0x3f, 0x00, 0xcf,
- 0xfc, 0x1f, 0x80, 0xcf, 0xfc, 0x1f, 0xc1, 0xcf, 0xfc, 0x9f, 0xe7, 0xcf,
- 0xfc, 0x9f, 0xf1, 0xcf, 0x00, 0xf8, 0x7f, 0xc0, 0x00, 0x00, 0x00, 0xc0};
-
-#define big_div_width 30
-#define big_div_height 30
-static char big_div_bits[] = {
- 0xff, 0xff, 0xff, 0x3f, 0x01, 0x00, 0x00, 0x20, 0x01, 0x00, 0x00, 0x20,
- 0xf1, 0x1f, 0xfc, 0x27, 0xf9, 0x1f, 0xfe, 0x27, 0xfd, 0x17, 0xff, 0x25,
- 0x25, 0x14, 0x09, 0x25, 0x05, 0x04, 0x01, 0x21, 0x05, 0x04, 0x01, 0x21,
- 0x01, 0x00, 0x00, 0x20, 0x01, 0x00, 0x00, 0x20, 0x01, 0x00, 0x00, 0x20,
- 0xf1, 0x1f, 0xfc, 0x27, 0xf9, 0x1f, 0xfe, 0x27, 0xfd, 0x17, 0xff, 0x25,
- 0x25, 0x14, 0x09, 0x25, 0x05, 0x04, 0x01, 0x21, 0x05, 0x04, 0x01, 0x21,
- 0x01, 0x00, 0x00, 0x20, 0x01, 0x00, 0x00, 0x20, 0x01, 0x00, 0x00, 0x20,
- 0x01, 0x00, 0x00, 0x20, 0xf1, 0x1f, 0xfc, 0x27, 0xf9, 0x1f, 0xfe, 0x27,
- 0xfd, 0x17, 0xff, 0x25, 0x25, 0x14, 0x09, 0x25, 0x05, 0x04, 0x01, 0x21,
- 0x05, 0x04, 0x01, 0x21, 0x01, 0x00, 0x00, 0x20, 0xff, 0xff, 0xff, 0x3f};
-
-#define big_bank_width 30
-#define big_bank_height 30
-static char big_bank_bits[] = {
- 0xff, 0xff, 0xff, 0x3f, 0x81, 0x00, 0x00, 0x20, 0x81, 0x01, 0x00, 0x20,
- 0xc1, 0x03, 0x00, 0x20, 0x41, 0x06, 0x00, 0x20, 0xa1, 0x0c, 0x00, 0x20,
- 0x31, 0x38, 0x00, 0x20, 0x19, 0xfc, 0xf0, 0x27, 0x89, 0xe6, 0x7f, 0x24,
- 0xcd, 0x33, 0x63, 0x2c, 0x2d, 0x39, 0x73, 0x3e, 0x19, 0x9b, 0x31, 0x3b,
- 0x01, 0x9e, 0x39, 0x29, 0x01, 0x9c, 0x99, 0x35, 0x01, 0xec, 0xf8, 0x25,
- 0x01, 0xdc, 0x5d, 0x34, 0x01, 0x2c, 0xcf, 0x32, 0x01, 0x1a, 0x80, 0x32,
- 0x01, 0x0e, 0x80, 0x22, 0x01, 0x0e, 0x80, 0x22, 0x01, 0x06, 0x80, 0x21,
- 0x01, 0x07, 0xc0, 0x21, 0x01, 0x00, 0x00, 0x20, 0xe1, 0xff, 0xff, 0x2f,
- 0x31, 0x00, 0x00, 0x2e, 0xf9, 0xff, 0xff, 0x2b, 0x59, 0x00, 0x00, 0x2b,
- 0x59, 0x00, 0x00, 0x2b, 0x19, 0x00, 0x00, 0x23, 0xff, 0xff, 0xff, 0x3f};
-
-#define big_store_width 30
-#define big_store_height 30
-static char big_store_bits[] = {
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x06, 0x00, 0x18,
- 0x00, 0xff, 0xff, 0x1f, 0x80, 0xff, 0xff, 0x1f, 0xc0, 0x06, 0x00, 0x1e,
- 0x78, 0x06, 0x60, 0x1b, 0xf8, 0xff, 0xff, 0x19, 0xf8, 0xff, 0xff, 0x18,
- 0x18, 0x06, 0x60, 0x18, 0x18, 0x06, 0x60, 0x18, 0x18, 0x06, 0x60, 0x18,
- 0x18, 0xff, 0xff, 0x1f, 0x98, 0x06, 0x60, 0x1c, 0x58, 0x06, 0x60, 0x1a,
- 0x38, 0x00, 0x60, 0x19, 0xf8, 0xff, 0xff, 0x18, 0x18, 0x06, 0x60, 0x18,
- 0x18, 0xfe, 0xff, 0x1f, 0x18, 0xff, 0xff, 0x1f, 0x98, 0x07, 0x60, 0x1c,
- 0xd8, 0x06, 0x60, 0x1e, 0x78, 0x00, 0x60, 0x1b, 0xf8, 0xff, 0xff, 0x01,
- 0xf8, 0xff, 0xff, 0x00, 0x18, 0x00, 0x60, 0x00, 0x18, 0x00, 0x60, 0x00,
- 0x18, 0x00, 0x60, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
-
-#define big_fzfile_width 30
-#define big_fzfile_height 30
-static char big_fzfile_bits[] = {
- 0xff, 0xff, 0xff, 0x3f, 0x01, 0x00, 0x00, 0x20, 0x01, 0x00, 0x00, 0x20,
- 0xf9, 0x0f, 0x00, 0x20, 0x01, 0x00, 0x00, 0x20, 0x01, 0x00, 0x00, 0x20,
- 0xf9, 0xff, 0x03, 0x20, 0x01, 0x00, 0x00, 0x20, 0x01, 0x00, 0x00, 0x20,
- 0xf9, 0xff, 0x7f, 0x20, 0x01, 0x00, 0x00, 0x20, 0x01, 0x00, 0x00, 0x20,
- 0x01, 0x00, 0x00, 0x20, 0xc1, 0x7f, 0xfe, 0x23, 0xc1, 0x7f, 0xfe, 0x23,
- 0xc1, 0x00, 0x80, 0x23, 0xc1, 0x00, 0xc0, 0x21, 0xc1, 0x00, 0xe0, 0x20,
- 0xc1, 0x0f, 0x70, 0x20, 0xc1, 0x0f, 0x70, 0x20, 0xc1, 0x00, 0x38, 0x20,
- 0xc1, 0x00, 0x1c, 0x20, 0xc1, 0x00, 0x0e, 0x20, 0xc1, 0x00, 0xfe, 0x23,
- 0xc1, 0x00, 0xfe, 0x23, 0x01, 0x00, 0x00, 0x20, 0x01, 0x00, 0x00, 0x20,
- 0x01, 0x00, 0x00, 0x20, 0x01, 0x00, 0x00, 0x20, 0xff, 0xff, 0xff, 0x3f};
-#define big_cart_width 30
-#define big_cart_height 30
-static char big_cart_bits[] = {
- 0xff, 0xff, 0xff, 0x3f, 0x01, 0x00, 0x00, 0x20, 0x01, 0x00, 0x00, 0x20,
- 0x01, 0x00, 0x00, 0x20, 0x01, 0xfe, 0xff, 0x21, 0x01, 0xff, 0xff, 0x23,
- 0x81, 0xff, 0xff, 0x23, 0xc1, 0xff, 0xff, 0x23, 0xe1, 0xff, 0xff, 0x23,
- 0xf1, 0xff, 0xff, 0x23, 0xf1, 0x1f, 0xfc, 0x23, 0xf1, 0x8f, 0xf8, 0x23,
- 0xf1, 0x07, 0xf0, 0x23, 0xf1, 0xc7, 0xf1, 0x23, 0xf1, 0x47, 0xf1, 0x23,
- 0xf1, 0xc7, 0xf1, 0x23, 0xf1, 0x17, 0xf4, 0x23, 0xf1, 0x0f, 0xf8, 0x23,
- 0xf1, 0x1f, 0xfc, 0x23, 0xf1, 0xff, 0xff, 0x23, 0xf1, 0xff, 0xff, 0x23,
- 0xf1, 0xff, 0xff, 0x23, 0xf1, 0xff, 0xff, 0x23, 0xf1, 0xff, 0xff, 0x23,
- 0xf1, 0xff, 0xff, 0x23, 0xe1, 0xff, 0xff, 0x21, 0x01, 0x00, 0x00, 0x20,
- 0x01, 0x00, 0x00, 0x20, 0x01, 0x00, 0x00, 0x20, 0xff, 0xff, 0xff, 0x3f};
-#define big_tape_width 30
-#define big_tape_height 30
-static char big_tape_bits[] = {
- 0x00, 0xf0, 0x07, 0x00, 0x00, 0x0e, 0x38, 0x00, 0x80, 0x01, 0xc0, 0x00,
- 0x40, 0xe0, 0x03, 0x01, 0x20, 0xfc, 0x1f, 0x02, 0x10, 0xfe, 0x3f, 0x04,
- 0x08, 0xff, 0x7f, 0x08, 0x88, 0xff, 0xff, 0x08, 0xc4, 0xff, 0xff, 0x11,
- 0xe4, 0xff, 0xff, 0x13, 0xe4, 0xff, 0xff, 0x13, 0xe2, 0x1f, 0xfc, 0x27,
- 0xf2, 0x0f, 0xf8, 0x27, 0xf2, 0x0f, 0xf8, 0x27, 0xf2, 0x0f, 0xf8, 0x27,
- 0xf2, 0x0f, 0xf8, 0x27, 0xf2, 0x0f, 0xf8, 0x27, 0xe2, 0x1f, 0xfc, 0x27,
- 0xe4, 0xff, 0xff, 0x13, 0xe4, 0xff, 0xff, 0x13, 0xc4, 0xff, 0xff, 0x11,
- 0x88, 0xff, 0xff, 0x08, 0x08, 0xff, 0x7f, 0x08, 0x10, 0xfe, 0x3f, 0x04,
- 0x20, 0xfc, 0x1f, 0x02, 0x40, 0xe0, 0x03, 0x01, 0x80, 0x01, 0xc0, 0x00,
- 0x00, 0x0e, 0x38, 0x00, 0x00, 0xf0, 0x07, 0x00, 0x00, 0x00, 0x00, 0x00};
-
-#define big_key1_width 30
-#define big_key1_height 30
-static char big_key1_bits[] = {
- 0xff, 0xff, 0xff, 0x3f, 0x01, 0x00, 0x00, 0x20, 0x01, 0x00, 0x00, 0x30,
- 0xa9, 0xaa, 0xaa, 0x3a, 0x51, 0x55, 0x55, 0x35, 0xf9, 0xff, 0xff, 0x3f,
- 0x11, 0x00, 0x00, 0x34, 0x19, 0x00, 0x00, 0x3c, 0xf1, 0xff, 0xff, 0x37,
- 0x59, 0x55, 0xb5, 0x3e, 0x31, 0x33, 0x13, 0x34, 0x19, 0x11, 0x31, 0x3c,
- 0xf1, 0xff, 0xff, 0x37, 0x59, 0x55, 0xb5, 0x3e, 0x31, 0x33, 0x13, 0x34,
- 0x19, 0x11, 0x31, 0x3c, 0xf1, 0xff, 0xff, 0x37, 0x59, 0x55, 0xb5, 0x3e,
- 0x31, 0x33, 0x13, 0x34, 0x19, 0x11, 0x31, 0x3c, 0xf1, 0xff, 0xff, 0x37,
- 0x59, 0x55, 0xb5, 0x3e, 0x31, 0x33, 0x13, 0x34, 0x19, 0x11, 0x31, 0x3c,
- 0x31, 0x33, 0x13, 0x34, 0xf9, 0xff, 0xff, 0x3f, 0x51, 0x55, 0x55, 0x35,
- 0xa9, 0xaa, 0xaa, 0x3a, 0xfd, 0xff, 0xff, 0x3f, 0xff, 0xff, 0xff, 0x3f};
-
-#define sm_key_width 20
-#define sm_key_height 20
-static char sm_key_bits[] = {
- 0xff, 0xff, 0x0f, 0x01, 0x00, 0x08, 0x01, 0x00, 0x0c, 0xa9, 0xaa, 0x0e,
- 0xf1, 0xff, 0x0d, 0x19, 0x00, 0x0f, 0xf1, 0xff, 0x0d, 0xd9, 0xb6, 0x0f,
- 0xb1, 0x6d, 0x0d, 0x99, 0x24, 0x0f, 0xf1, 0xff, 0x0d, 0xd9, 0xb6, 0x0f,
- 0xb1, 0x6d, 0x0d, 0xf9, 0xff, 0x0f, 0x91, 0x24, 0x0d, 0xb9, 0x6d, 0x0f,
- 0xf1, 0xff, 0x0d, 0xa9, 0xaa, 0x0e, 0xfd, 0xff, 0x0f, 0xff, 0xff, 0x0f};
-
-#define sm_dir_width 20
-#define sm_dir_height 16
-static char sm_dir_bits[] = {
- 0xff, 0xff, 0x0f, 0x01, 0x00, 0x08, 0x01, 0x00, 0x0c, 0x51, 0x55, 0x0d,
- 0xa9, 0xaa, 0x0e, 0x01, 0x15, 0x0c, 0x29, 0x80, 0x0e, 0x51, 0x55, 0x0d,
- 0xa9, 0xaa, 0x0e, 0x51, 0x55, 0x0d, 0xa9, 0xaa, 0x0e, 0x51, 0x55, 0x0d,
- 0xa9, 0xaa, 0x0e, 0x51, 0x55, 0x0d, 0xfd, 0xff, 0x0f, 0xff, 0xff, 0x0f};
-
->MENU DZDOC
-
->Help_item HELP_Zebra
-
->guidance
-
-. *** The Zebra-Browser ***
-.
-Selecting "Zebra" from the KUIP object browser will display
-an icon for each Zebra store, for each open Fzfile and each
-open Rzfile. A store is named with its number plus the name
-given to MZSTOR with slashes (/) replaced by underscores (_).
-A Fzfile is named with the logical unit number, a Rzfile with
-the top directory given to it by RZFILE.
-.
-.
-Double click in the store symbol will display icons for the
-divisions in this store, clicking the divisions will display
-the banks im this divisions, clicking a bank will show the
-tree for this bank in the graphics window (see DZDISP).
-Popup menus (use right mouse key) are provided which allow to
-print information on stores, divisions and banks (DZSTOR,
-DZSNAP, DZSURV). The layout of banks in divisions can be
-shown graphically by the command 'Display_division'.
-.
-.
-Double click in the FZfile symbol will read the next data
-structure from the file into division 1 of store 0 and
-display the bank tree for the top bank in the graphics
-window. A popup menu allows to read the User header only,
-to display information (see FZINFO) on the file or close the
-file. Trying to read beyond End of Data will force the
-file to be rewound to avoid exit via ZFATAL.
-.
-.
-Double click in the RZfile symbol will display directories
-and/or keys contained in the file. Double click on a key
-symbol will read the data structure for this key into
-division 1 of store 0 and display the bank tree for the
-top bank in ths graphics window. Show status (RZSTAT) and
-close are accessible by a popup menu.
-.
-. **** Embedded DZDOC ****
-.
-The Zebra browser popup menus give access to parts of the
-DZDOC package. DZDOC allows to describe Zebra banks (linkage
-and data words) with a defined format.
-It puts this description into a Rzfile for direct access
-and makes it available to DZDISP which can then display the
-data words of a bank together with their meaning.
-.
-.
-Opening, updating and using of the Rzfile can be done in the
-same session. The file is opened via the menu item
-'Open_bank_doc_Rzfile', one has to choose if it should be
-opened 'New' for 'Update' or 'Readonly'.
-Information can put into the file using the item
-'Put_doc_into_Rzfile', for more information see help for this
-command.
-.
-An alternative way is to use the item 'Edit_documentation' in
-the popup menu associated with each bank (in the browser or
-graphics window). In this case the editor is called with the
-documentation contained in an (open) Rzfile if it is there.
-If not a template with the documentation generated from the
-selected bank in memory is presented in the editor.
-If the file gets modified the documentation will be put into
-the Rzfile if it is open for update. Note that the file
-naming convention uses the hollerith Id of a bank
-concatinated with the Id of its up-bank ('none' for a top
-bank) with the extension '.dzdoc'.
-.
-.
-. **** Vector/histogram filling ****
-.
-The data words of a bank may be copied into a KUIP vector which
-is optionally directly plotted or drawn (VECTOR/PLOT or DRAW).
-This is done from the popup menu in the graphics or Icon
-display of the ZEBRA banks. The vectors may then further be
-manipulated by all the commands of the vector package.
-This only works within paw++ where the VECTOR facilities are
-linked in.
-.
-.
-. **** Ntuple filling ****
-.
-A simple facility is provided to mark words in a data structure
-read from an FZ-file for filling into a Ntuple. The entries may
-be scalar variables (i.e. one value of a bank) or arrays.
-Marking of data words may be done explicitly giving the absolute
-offset in a bank (a range in case of an array) or symbolically
-if a (correct) documentation for the bank is available. In the
-second case all values of a variable (max 100) in a bank are
-extracted and filled into the Ntuple.
-.
-The marking is done from the popup menu associated to banks in
-the graphics display, the system finds and remembers the links
-to the bank.
-.
-Filling is controlled from the popup menu for the FZ-file icon.
-For further details consult the Help items for these commands.
-
->Menu Set_par
->Guidance
-Set various parameters:
-Enable/disable workstation activation.
-Select the two keys and the cycle to be shown by the browser.
-DZDOC may optionally use a different window (workstation IWKID).
-for its output.
-CDZOPT Option when calling DZSHOW
-
->Command GeomFont
->Guidance
-Set scale factor for size of banktree picture and
-text fonts/precision
->Parameters
-PSCALE 'Scale factor' R D=1.
-ITFONT 'Text font in bank display' I D=-6
-ITPREC 'Text prec in bank display' I D=0
->Action DZDSKD
-
->Command BankColor
->Guidance
-Choose if bank display should be colored.
-Color indexes for bank center and box.
->Parameters
-COLBNK 'Color bank display' C D='Yes' R='Yes,No'
-+
-IBCCOL 'Color for bank center' I D=7
-IBDCOL 'Color for data box' I D=3
->Action DZDSKD
-
->Command WorkStation
->Guidance
-Enable/disable workstation activation.
-DZDOC may optionally use a different window (workstation IWKID).
->Parameters
-CCACT 'Activate workstation' C D='No' R='No,Yes'
-IWKID 'Use workstation Id' I D=1
->Action DZDSKD
-
->Command BrowseKey
->Guidance
-Select the two keys and the cycle to be shown by the browser.
->Parameters
-IKDSP1 'Key to display' I D=1
-IKDSP2 'Key to display' I D=2
-ICYDSP 'Cycle to display' I D=1000000
->Action DZDSKD
-
->Command Ref_links
->Guidance
-Select if reference links should be followed
->Parameters
-CREFLN 'Follow reference links' C D='Yes' R='No,Yes'
->Action DZDSKD
-
->Command DZshow_Opt
->Guidance
-CDZOPT Option when calling DZSHOW
->Parameters
-CDZOPT 'DZSHOW option' C D='.'
->Action DZDSKD
-
->Command New_Window
->Guidance
-Select if output of DZDISP etc. should go in a new window or
-be displayed on the terminal (KXTERM).
->Parameters
-CNEWIN 'Open new windows' C D='Yes' R='No,Yes'
->Action DZDSKD
-
->MENU ../File
-
->Command Open_doc
->Guidance
-Open (RZ) file with bank documentation in
-Readonly (default), New or Update mode
-Option L: List contents (RZLDIR) (file must be open)
->Parameters
-CHDOCB 'File name' C D=' '
-+
-CHOPT 'Options' C D='R' R='R,N,U,L'
->Action DZDORF
-
->COMMAND Edit_doc
->GUIDANCE
-Edit documentation for selected bank. The source may be
-taken from:
- - an (open) RZ documentation file
- - an Ascii file in current dir or one added by DIR_ADD
- - a template of a bank in memory (Store and div must be given)
-In the case of 'Ascii' the file name may explicitly be given in CHFILE,
-if CHFILE = ' ' it is defaulted to 'CHBANK_CHUPID.dzdoc'.
->Parameters
-CHBANK 'Bank Hol_Id ' C D=' '
-CHUPID 'UpBank Hol_Id' C D=' '
-CHOPT 'Option ' C D='Rz' R='Rz,Ascii,Memory'
-CHFILE 'File name ' C D=' '
-STORE 'Store ' I D=0
-Div 'Division ' I D=2
->ACTION DZDEDD
-
->Command Dir_add
->Guidance
-Add a directory into search path when looking for
-bank documention files. (max 10 dirs allowed)
->Parameters
-CHDIR 'Directory name' C D=' '
->Action DZDDAD
-
->MENU ../Bankdisplay
-
->COMMAND Tree
->GUIDANCE
-Show bank tree for selected bank
->Parameters
-CHBANK 'Bank Hol_Id' C D=' '
-+
-NID 'Num Id ' I D=0
-STORE 'Store ' I D=0
-Div 'Division ' I D=2
-CHUPID 'UpBank Hol_Id' C D=' '
->ACTION DZDSHA
-
->COMMAND Contents
->GUIDANCE
-Show contents of bank documented.
->Parameters
-CHBANK 'Bank Hol_Id' C D=' '
-+
-NID 'Num Id ' I D=0
-STORE 'Store ' I D=0
-Div 'Division ' I D=2
-CHUPID 'UpBank Hol_Id' C D=' '
->ACTION DZDSHA
-
->COMMAND DZshow_cont
->GUIDANCE
-Show contents of bank by DZSHOW (no documentation)
->Parameters
-CHBANK 'Bank Hol_Id' C D=' '
-+
-NID 'Num Id ' I D=0
-STORE 'Store ' I D=0
-Div 'Division ' I D=2
-CHUPID 'UpBank Hol_Id' C D=' '
->ACTION DZDSHA
-
->COMMAND Systemwords
->GUIDANCE
-Show system words and links for selected bank
->Parameters
-CHBANK 'Bank Hol_Id' C D=' '
-+
-NID 'Num Id ' I D=0
-STORE 'Store ' I D=0
-Div 'Division ' I D=2
-CHUPID 'UpBank Hol_Id' C D=' '
->ACTION DZDSHA
-
->COMMAND Documentation
->GUIDANCE
-Show documentation for selected bank
->Parameters
-CHBANK 'Bank Hol_Id' C D=' '
-+
-NID 'Num Id ' I D=0
-STORE 'Store ' I D=0
-Div 'Division ' I D=2
-CHUPID 'UpBank Hol_Id' C D=' '
->ACTION DZDSHA
-
->COMMAND Survey
->GUIDANCE
-Call DZSURV for selected bank
->Parameters
-CHBANK 'Bank Hol_Id' C D=' '
-+
-NID 'Num Id ' I D=0
-STORE 'Store ' I D=0
-Div 'Division ' I D=2
-CHUPID 'UpBank Hol_Id' C D=' '
->ACTION DZDSHA
-
->MENU ../BROWSE
-
->GUIDANCE
-The commands in this menu are accessible only via the browser
-since they need as argument an identification given internally
-by the callback routine.
-
->COMMAND MARK_NT
->GUIDANCE
-Mark data word(s) for Ntuple. An explicit word number
-or range of words may be given, in this case CHNAME is
-only used as a tag.
-If blank its defaulted to: Bankid+IWORD (8 Characters)
-
-If IWORDF is 0, it is assumed that a bank doc is available,
-and CHNAME is the name of a variable in the doc.
-If used with the option "array" all values with this name
-in the bank will be filled (max. 100)
-
-CHBANK: internal bank numbering, dont touch
-
-CHOPT: Switch between single variables and arrays.
- 'single' mark a single (scalar) variable
- 'array' put each occurence of a variable in bank
- into an array and call HFNT once per event
-IWORDF:
- if > 0 data
- -1 length of bank (not yet implemented)
- -2 number of links (nyi)
- -5 numerical Id of bank (nyi)
- -10 the link offset (Jbias of bank in Upbank) (nyi)
-IWORDL:
- > IWORDF last word to be marked (only with "array")
-
-Option: 'L' loop on all other links (Jbias) to this bank
- in Upbank or on all next banks if it is part
- of a linear structure (nyi)
->Parameters
-IDBANK 'Int Bank Id (DONT TOUCH)' I D=0
-CHOPT 'Single variable or array' C D='Array' R='Single,Array'
-IWORDF 'First word number' I D=0
-IWORDL 'Last word number' I D=0
-CHNAME 'Mnemonic (variable name)' C D=' '
-COPT 'Option' C D='.'
->ACTION DZDSPI
-
->COMMAND SH_FOUT
->GUIDANCE
-Write bank tree to FZFILE
->Parameters
-IDBANK 'Int Bank Id (DONT TOUCH)' I D=0
-LUNFOU 'Unit number' I D=0
-CHBANK 'Holl Id' C D=' '
-CHOPT 'Option for FZOUT' C D=' '
-CHEAD 'Write user header' C D='Yes'
->ACTION DZDSPI
-
->COMMAND SH_DROP
->GUIDANCE
-Drop bank (tree)
->Parameters
-IDBANK 'Int Bank Id (DONT TOUCH)' I D=0
-CHOPT 'Option for MZDROP' C D='.'
->ACTION DZDSPI
-
->COMMAND SH_MODIFY
->GUIDANCE
-Modify data words of bank. Data words IFWORD -
-ILWORD will be filled with IVALUE, RVALUE or CVALUE
-depending on the type given in the IO-Char.
-If more than 1 word are modified the type of the
-first taken.
-The integer value is interpreted as hexadecimal if
-preceeded by $ or 16x.
-If ILWORD=0 its set to IFWORD.
-HINT+WARNING:
-If the dataword offset is <=0 you can modify system words
-on your own risk.
->Parameters
-IDBANK 'Int Bank Id (DONT TOUCH)' I D=0
-IFWORD 'First word' I D=' '
-ILWORD 'Last word' I D=' '
-IVALUE 'Integer value' C D=' '
-RVALUE 'Real value' R D=0.
-CVALUE 'Char*4 value' C D='? ? '
->ACTION DZDSPI
-
->COMMAND PT_VECT
->GUIDANCE
-Put bank contents into a vector,
-If CHVECT is blank name is taken from hollerith Id.
-If IFWORD and ILWORD are 0 all data words are taken.
-With option PLOT the values are filled in a histogram
-which is then plotted (see VECTOR/PLOT), DRAW interprets
-the data words as histogram contents (VECTOR/DRAW).
->Parameters
-IDBANK 'Int Bank Id (DONT TOUCH)' I D=0
-IDHIST 'Histogram Id' I D=12345
-CHVECT 'Vector Name' C D=' '
-IFWORD 'First word' I D=0
-ILWORD 'Last word' I D=0
-CHOPT 'Option' C D='DRAW' R='DRAW,PLOT, '
->ACTION DZDSPI
-
->COMMAND SHOW_RZS
->GUIDANCE
-Show status of a RZ file
->Parameters
-CHPATH 'Rz directory' C D=' '
->ACTION DZDSRS
-
->COMMAND GET_KEY
->GUIDANCE
-Read d/s of a RZ key into memory
->Parameters
-CHPATH 'Rz directory' C D=' '
-CHKNUM 'Key sequential num' C D=' '
->ACTION DZDGKY
-
->COMMAND SH_KEY
->GUIDANCE
-Show key words
->Parameters
-CHPATH 'Rz directory' C D=' '
-CHKNUM 'Key sequential num' C D=' '
->ACTION DZDGKY
-
->COMMAND SH_KEY_DEF
->GUIDANCE
-Show tags of keys
->Parameters
-CHPATH 'Rz directory' C D=' '
->ACTION DZDGKY
-
-
->COMMAND SH_RZLDIR
->GUIDANCE
-List directory (RZLDIR)
->Parameters
-CHPATH 'Rz directory' C D=' '
->ACTION DZDGKY
-
-
->COMMAND FILT_KEY
->GUIDANCE
-Set a filter on keywords (max first 9),
-Keys created with the A option may be shown
-optionally.
-
->Parameters
-IKEYNR 'Keyword number' I D=1
-IVALUE 'Integer value' I D=0
-CVALUE 'Char*4 (hollerith) value' C D=' '
-CHOPT 'Option' C D='Int' R='Int,Char,Reset'
-CHYENO 'List keys with Append opt' C D='NO' R='NO,YES'
->ACTION DZDSFK
-
->COMMAND FILT_BANKS
->GUIDANCE
-Set a mask on hollerith and/or numerical Id of a bank.
-The wildcard character is * or blank (i.e. CIDMSK = ' '
-selects all).
-Example: C**S , display all banks with Id starting with C
-and ending with S.
-If NIDMSK /= 0 display only banks with this numerical Id.
->Parameters
-CIDMSK 'Mask Hol Id' C D=' '
-NIDMSK 'Numerical Id' I D=0
->ACTION DZDSFB
-
->COMMAND CLOSE_RZ
->GUIDANCE
-Close RZ file
->Parameters
-CHPATH 'Rz directory' C D=' '
->ACTION DZDCRZ
-
->COMMAND PUT_EVENT
->GUIDANCE
-Write bank tree to FZFILE read by GET_EVENT, if CHBANK /= ' '
-the hollerith Id of the top bank is checked first
->Parameters
-LUNFOU 'Unit number' I D=0
-+
-CHBANK 'Bank Hol_Id' C D=' '
-CHOPT 'Option for FZOUT' C D=' '
-CHEAD 'Write user header' C D='Yes'
->ACTION DZDPEV
-
->COMMAND CLOSE_FZ
->GUIDANCE
-Close FZ file
->Parameters
-CHLUN 'Unit number' C D=' '
->ACTION DZDCFZ
-
->COMMAND REWIND_FZ
->GUIDANCE
-Rewind FZ file
->Parameters
-CHLUN 'Unit number' C D=' '
->ACTION DZDRWF
-
->COMMAND FZ_LOG_LEVEL
->GUIDANCE
-Set logging level for FZ file
->Parameters
-CHLUN 'Unit number' C D=' '
-LOGL 'Log level' I R=-3:4
->ACTION DZDFLL
-
->COMMAND GET_EVENT
->GUIDANCE
-Read next d/s into memory and display it, if CHDS = 'D'
->Parameters
-CHLUN 'Unit number' C D=' '
-+
-CHDS 'Display flag' C D=' '
->ACTION DZDFZI
-
->COMMAND GET_HEADER
->GUIDANCE
-Read next User header into memory
->Parameters
-CHLUN 'Unit number' C D=' '
-+
-CHDS 'Display flag' C D=' '
->ACTION DZDFZI
-
->COMMAND GET_PDS
->GUIDANCE
-Read the pending d/s into memory
->Parameters
-CHLUN 'Unit number' C D=' '
-+
-CHDS 'Display flag' C D=' '
->ACTION DZDFZI
-
->COMMAND SH_FZINFO
->GUIDANCE
-Show Fz information for file open on Unit CHLUN
->Parameters
-CHLUN 'Unit number' C D=' '
->ACTION DZDFZS
-
->COMMAND LIST_NTUPLE
->GUIDANCE
-List currently marked variables
->ACTION DZDPNT
-
->COMMAND FILL_NTUPLE
->GUIDANCE
-Read events from FZfile and fill Ntuple
-RZPATH may contain the directory in an (open)
-Rzfile to receive the Ntuple.
-Option: 'R' Rewind file before filling
->Parameters
-LUN 'Unit number' I
-NTUPID 'Id for Ntuple' I D=99
-CNAME 'Ntuple title' C D='Zbrowse'
-RZPATH 'Dir of Rzfile' C D=' '
-NEVENT 'Number of events' I D=100000
-CHOPT 'Option' C D='.'
->ACTION DZDFNT
-
->COMMAND SHOW_STORE
->GUIDANCE
-Call DZSTOR, CHSTOR is given in format:Store01
-Default: Div 2 of current Store
->Parameters
-CHSTO 'Store name' C D=' '
->ACTION DZDSHD
-
->COMMAND SHOW_DIV
->GUIDANCE
-Call DZDDIV, CHDIV is given in format:Store01/Div03.
-Default: Div 2 of current Store
->Parameters
-CHDIV 'Div name' C D=' '
->ACTION DZDSHD
-
->COMMAND COL_GARB
->GUIDANCE
-Call MZGARB for selected division
->Parameters
-CHDIV 'Div name' C D=' '
->ACTION DZDSHD
-
->COMMAND SNAP_DIV
->GUIDANCE
-Call DZSNAP, CHDIV is given in format:Store01/Div03.
-Default: Div 2 of current Store
->Parameters
-CHDIV 'Div name' C D=' '
->ACTION DZDSHD
-
->COMMAND VERIFY_DIV
->GUIDANCE
-Call DZVERI, CHDIV is given in format:Store01/Div03.
-Default: Div 2 of current Store
->Parameters
-CHDIV 'Div name' C D=' '
-CHOPT 'Option' C D='CLSU'
->ACTION DZDSHD
-
-************************************************************************
-
diff --git a/src/graflib/dzdoc/cdf/zbrdef.c b/src/graflib/dzdoc/cdf/zbrdef.c
deleted file mode 100644
index 6254a86..0000000
--- a/src/graflib/dzdoc/cdf/zbrdef.c
+++ /dev/null
@@ -1,1840 +0,0 @@
-*
-* $Id: zbrdef.c,v 1.1.1.1 1996/03/04 16:12:52 mclareni Exp $
-*
-* $Log: zbrdef.c,v $
-* Revision 1.1.1.1 1996/03/04 16:12:52 mclareni
-* Dzdoc/Zebpack
-*
-*
-* This directory was created from dzdoc.car patch zbrdef
-/*
- * This file has been generated by the KUIP compiler. Do NOT change it!
- *
- * KUIP version: 921023 Generation date: Wed Mar 2 15:58:46 1994
-
- *
- * Input file: DZDOCCDF.CDF
- */
-
-#if !defined(F77_LCASE) && !defined(F77_UCASE) && !defined(F77_USCORE)
-# if defined(CRAY) || defined(IBM370) || defined(vms)
-# define F77_UCASE
-# else
-# if ( defined(apollo) || defined(__apollo) ) && defined(APOFTN)
-# define F77_LCASE
-# else
-# define F77_USCORE
-# endif
-# endif
-#endif
-
-typedef int IntFunc();
-typedef char** pCharFunc();
-typedef void SUBROUTINE();
-#ifdef IBM370
-# pragma linkage(SUBROUTINE,FORTRAN)
-#endif
-
-typedef unsigned long KmPixmap; /* Pixmap from <X11/X.h> */
- typedef void *KmWidget; /* Widget from <X11/Intrinsic.h> */
- typedef void *KmCalldata; /* XmAnyCallbackStruct from <Motif/Xm.h> */
- /* */
- typedef enum { /* */
- BRACT_OPEN = 0, /* */
- BRACT_ROOT = 1, /* */
- BRACT_CONT = 2, /* */
- BRACT_GRAF = 3 /* */
- } BrActTag; /* */
- /* */
- typedef enum { /* */
- BrActUpdate = 0x01, /* browser window has to be updated ('!') */
- BrActSeparator = 0x02, /* put separator in menu ('/') */
- BrActToggle = 0x04, /* register as toggle button */
- BrActToggleOn = 0x08, /* toggle state is on */
- BrActSensitive = 0x10 /* button is sensitive */
- } BrActFlag; /* */
- /* */
- typedef struct _BrAction { /* */
- struct _BrAction *next; /* link to next action binding */
- BrActFlag flags; /* */
- char *text; /* text line in menu */
- char *user_text; /* user text overriding CDF text (malloced)*/
- char *accel; /* accelerator */
- char *exec; /* action commands */
- SUBROUTINE *call_F; /* action routine */
- IntFunc *call_C; /* action function */
- BrActTag tag; /* for which window the action is defined */
- struct _BrClass *class; /* pointer to BrClass in case of open menu */
- } BrAction; /* */
- /* */
- typedef struct _BrClass { /* */
- struct _BrClass *next; /* link to next browsable class */
- char *name; /* unique identifier name */
- char *title; /* title for popup menu (maybe NULL) */
- SUBROUTINE *scan_km_F; /* user function scanning the directory */
- pCharFunc *scan_km_C; /* user function scanning the directory */
- SUBROUTINE *scan_br_F; /* user function scanning for browsables */
- pCharFunc *scan_br_C; /* user function scanning for browsables */
- BrAction *root; /* list of actions in root window */
- BrAction *open; /* list of actions in open menu */
- } BrClass; /* */
- /* */
-
-typedef struct _KmIcon { /* */
- struct _KmIcon *next; /* link to next icon */
- char *name; /* unique identifier name */
- int width; /* width of the pixmap */
- int height; /* height of the pixmap */
- char *bitmap; /* bitmap data */
- KmPixmap pix; /* filled in Motif part */
- KmPixmap hi_pix; /* high lighted pixmap */
- } KmIcon; /* */
- /* */
- typedef struct _KmClass { /* */
- struct _KmClass *next; /* link to next object class */
- int is_dir; /* flag if class has is a directory */
- char *name; /* unique identifier name */
- char *title; /* title for popup menu (maybe NULL) */
- char *big_icon; /* name of the big icon */
- KmIcon *bicon; /* pointer to the big icon structure */
- char *sm_icon; /* name of the small icon */
- KmIcon *sicon; /* pointer to the small icon structure */
- SUBROUTINE *user_icon_F; /* user function to return icon bitmap */
- IntFunc *user_icon_C; /* user function to return icon bitmap */
- BrAction *cont; /* list of actions in content window */
- BrAction *graf; /* list of actions in graphics window */
- int obj_count; /* number of objects in content window */
- } KmClass; /* */
- /* */
- typedef enum { /* */
- KmButtSensitive = 0x00, /* sensitive button */
- KmButtNonSensitive = 0x01, /* non-sensitive button ('NS') */
- KmButtToggleSensitive = 0x02, /* toggle-sensitive button ('TS') */
- KmButtSensitivityMask = 0x03, /* mask for sensitivity type */
- KmButtSeparator = 0x04 /* put separator in menu ('/') */
- } KmButtFlag; /* */
- /* */
- typedef struct _KmButton { /* */
- struct _KmButton *next; /* button label or menu item */
- char *label; /* button label or menu item */
- char *menu; /* menu name or NULL for buttons */
- KmButtFlag flags; /* sensitivity type etc. */
- SUBROUTINE *action_F; /* Fortran routine called with (LABEL,MENU)*/
- IntFunc *action_C; /* C function called with (label,menu) */
- KmWidget widget; /* Motif widget ID */
- } KmButton; /* */
-
-extern struct { /*
- */ /* indirect calls to avoid linking HIGZ
- */ IntFunc *graf_info_C; /* pass display, open and close
- (ixmotif) */ SUBROUTINE *graf_size_F; /* resize window (IGRSIZ)
- */ SUBROUTINE *graf_pick_F; /* identifying graphics objects
- (IGOBJ) */ SUBROUTINE *graf_attr_F; /* set attributes (IGSET)
- */ SUBROUTINE *graf_close_F; /* close workstation (ICLWK)
- */ /* optional routines for Motif customization
- */ pCharFunc *user_FallBk_C; /* get application fallbacks
- */ IntFunc *user_TopWid_C; /* pass toplevel widget
- identifiers */ } klnkaddr; /*
- */
-
-typedef enum { /* */
- KmFLAG_FORGET = 0x01, /* last value is not kept for Motif panels */
- KmFLAG_MINUS = 0x02, /* -VALUE is not an abbrev for CHOPT=VALUE */
- KmFLAG_QUOTE = 0x04, /* do not remove quotes */
- KmFLAG_VARARG = 0x08 /* append additional args to this param. */
- } KmParFlag; /* */
- /* */
- typedef enum { /* */
- KmTYPE_CHAR = 'C', /* character string */
- KmTYPE_FILE = 'F', /* file name */
- KmTYPE_INT = 'I', /* integer */
- KmTYPE_OPTION = 'O', /* option */
- KmTYPE_REAL = 'R' /* real */
- } KmParType; /* */
- /* */
- typedef struct { /* file name */
- char *filter_default; /* filter wildcard */
- char *filter_current; /* current filter */
- } KmParFile; /* */
- /* */
- typedef struct { /* */
- char *range_lower; /* lower value of range */
- char *range_upper; /* upper value of range */
- char *slider_lower; /* lower limit for slider */
- char *slider_upper; /* upper limit for slider */
- int decimals; /* number of decimals used for slider */
- } KmParInt; /* */
- /* */
- typedef struct { /* option */
- char **text; /* explanations (parallel to range_value) */
- int *mutex; /* mutex group to which text belongs */
- int *radio; /* radio group to which text belongs */
- } KmParOption; /* */
- /* */
- typedef KmParInt KmParReal; /* real and int have the same fields */
- /* */
- typedef struct { /* */
- char *name; /* parameter name */
- int abbrev; /* minimum length that name is recognized */
- char *prompt; /* prompt string */
- char *dfault; /* default value */
- char *last; /* last value for Motif panel (malloced) */
- int width; /* width of input field */
- int range_count; /* number of items in range_value */
- char **range_value; /* list of allowed values */
- int select_count; /* number of items in select_count */
- char **select_value; /* list of values for selection box */
- KmParFlag flags; /* special flags */
- KmParType type; /* parameter type */
- void *ptype; /* structure pointer selected by type */
- } KmParameter; /* */
-
-typedef struct _KmCommand { /* */
- struct _KmCommand *next; /* link to next command */
- char *path; /* command path */
- char *name; /* command name */
- int hidden; /* flag if command is invisible */
- int level; /* depth of submenus */
- int total; /* total number of parameters */
- int mandatory; /* number of mandatory parameters */
- KmParameter **par; /* list of total parameter descriptions */
- int list_par; /* index+1 of parameter taking a list */
- int xcount; /* count number of action calls */
- SUBROUTINE *action_F; /* action routine */
- IntFunc *action_C; /* action routine */
- SUBROUTINE *user_help_F; /* user help routine */
- IntFunc *user_help_C; /* user help routine */
- int nguidance; /* number of lines in guidance text */
- char **guidance; /* help text */
- int argc; /* number of arguments entered */
- char **argv; /* argc argument values */
- char *argline; /* argument line as entered */
- int *argoffs; /* argc offsets into argline for KUGETE */
- } KmCommand; /* */
- /* */
- typedef struct _KmMenu { /* */
- struct _KmMenu *next; /* link to next menu */
- struct _KmMenu *down; /* link to submenu */
- char *path; /* path of parent menu */
- char *name; /* menu name */
- int level; /* depth of submenus */
- KmCommand *cmds; /* link to first command */
- int nguidance; /* number of lines in guidance text */
- char **guidance; /* help text */
- } KmMenu; /* */
-
-#ifdef F77_LCASE
-# define zbrdef_ zbrdef
-# define dzdskd_ dzdskd
-# define dzddad_ dzddad
-# define dzdedd_ dzdedd
-# define dzdorf_ dzdorf
-# define dzdsha_ dzdsha
-# define dzdshd_ dzdshd
-# define dzdfnt_ dzdfnt
-# define dzdfzs_ dzdfzs
-# define dzdfzi_ dzdfzi
-# define dzdfll_ dzdfll
-# define dzdrwf_ dzdrwf
-# define dzdcfz_ dzdcfz
-# define dzdpev_ dzdpev
-# define dzdcrz_ dzdcrz
-# define dzdsfb_ dzdsfb
-# define dzdsfk_ dzdsfk
-# define dzdgky_ dzdgky
-# define dzdsrs_ dzdsrs
-# define dzdspi_ dzdspi
-# define dzdzeb_ dzdzeb
-# define dzdb08_ dzdb08
-# define dzdb07_ dzdb07
-# define dzdb06_ dzdb06
-# define dzdb05_ dzdb05
-# define dzdb04_ dzdb04
-# define dzdb03_ dzdb03
-# define dzdb01_ dzdb01
-# define dzdb18_ dzdb18
-# define dzdb17_ dzdb17
-# define dzdb16_ dzdb16
-# define dzdb15_ dzdb15
-# define dzdb14_ dzdb14
-# define dzdb13_ dzdb13
-# define dzdb12_ dzdb12
-# define dzdb11_ dzdb11
-# define igrsiz_ igrsiz
-# define igobj_ igobj
-# define igset_ igset
-# define iclwk_ iclwk
-#endif
-
-#ifdef F77_UCASE
-# define zbrdef_ ZBRDEF
-# define dzdskd_ DZDSKD
-# define dzddad_ DZDDAD
-# define dzdedd_ DZDEDD
-# define dzdorf_ DZDORF
-# define dzdsha_ DZDSHA
-# define dzdshd_ DZDSHD
-# define dzdfnt_ DZDFNT
-# define dzdfzs_ DZDFZS
-# define dzdfzi_ DZDFZI
-# define dzdfll_ DZDFLL
-# define dzdrwf_ DZDRWF
-# define dzdcfz_ DZDCFZ
-# define dzdpev_ DZDPEV
-# define dzdcrz_ DZDCRZ
-# define dzdsfb_ DZDSFB
-# define dzdsfk_ DZDSFK
-# define dzdgky_ DZDGKY
-# define dzdsrs_ DZDSRS
-# define dzdspi_ DZDSPI
-# define dzdzeb_ DZDZEB
-# define dzdb08_ DZDB08
-# define dzdb07_ DZDB07
-# define dzdb06_ DZDB06
-# define dzdb05_ DZDB05
-# define dzdb04_ DZDB04
-# define dzdb03_ DZDB03
-# define dzdb01_ DZDB01
-# define dzdb18_ DZDB18
-# define dzdb17_ DZDB17
-# define dzdb16_ DZDB16
-# define dzdb15_ DZDB15
-# define dzdb14_ DZDB14
-# define dzdb13_ DZDB13
-# define dzdb12_ DZDB12
-# define dzdb11_ DZDB11
-# define igrsiz_ IGRSIZ
-# define igobj_ IGOBJ
-# define igset_ IGSET
-# define iclwk_ ICLWK
-#endif
-
-#ifdef IBM370
-# pragma linkage(ZBRDEF,FORTRAN)
-# pragma linkage(DZDSKD,FORTRAN)
-# pragma linkage(DZDDAD,FORTRAN)
-# pragma linkage(DZDEDD,FORTRAN)
-# pragma linkage(DZDORF,FORTRAN)
-# pragma linkage(DZDSHA,FORTRAN)
-# pragma linkage(DZDSHD,FORTRAN)
-# pragma linkage(DZDFNT,FORTRAN)
-# pragma linkage(DZDFZS,FORTRAN)
-# pragma linkage(DZDFZI,FORTRAN)
-# pragma linkage(DZDFLL,FORTRAN)
-# pragma linkage(DZDRWF,FORTRAN)
-# pragma linkage(DZDCFZ,FORTRAN)
-# pragma linkage(DZDPEV,FORTRAN)
-# pragma linkage(DZDCRZ,FORTRAN)
-# pragma linkage(DZDSFB,FORTRAN)
-# pragma linkage(DZDSFK,FORTRAN)
-# pragma linkage(DZDGKY,FORTRAN)
-# pragma linkage(DZDSRS,FORTRAN)
-# pragma linkage(DZDSPI,FORTRAN)
-# pragma linkage(DZDZEB,FORTRAN)
-# pragma linkage(DZDB08,FORTRAN)
-# pragma linkage(DZDB07,FORTRAN)
-# pragma linkage(DZDB06,FORTRAN)
-# pragma linkage(DZDB05,FORTRAN)
-# pragma linkage(DZDB04,FORTRAN)
-# pragma linkage(DZDB03,FORTRAN)
-# pragma linkage(DZDB01,FORTRAN)
-# pragma linkage(DZDB18,FORTRAN)
-# pragma linkage(DZDB17,FORTRAN)
-# pragma linkage(DZDB16,FORTRAN)
-# pragma linkage(DZDB15,FORTRAN)
-# pragma linkage(DZDB14,FORTRAN)
-# pragma linkage(DZDB13,FORTRAN)
-# pragma linkage(DZDB12,FORTRAN)
-# pragma linkage(DZDB11,FORTRAN)
-# pragma linkage(IGRSIZ,FORTRAN)
-# pragma linkage(IGOBJ,FORTRAN)
-# pragma linkage(IGSET,FORTRAN)
-# pragma linkage(ICLWK,FORTRAN)
-#endif
-
-extern void zbrdef_();
-extern void dzdskd_();
-extern void dzddad_();
-extern void dzdedd_();
-extern void dzdorf_();
-extern void dzdsha_();
-extern void dzdshd_();
-extern void dzdfnt_();
-extern void dzdfzs_();
-extern void dzdfzi_();
-extern void dzdfll_();
-extern void dzdrwf_();
-extern void dzdcfz_();
-extern void dzdpev_();
-extern void dzdcrz_();
-extern void dzdsfb_();
-extern void dzdsfk_();
-extern void dzdgky_();
-extern void dzdsrs_();
-extern void dzdspi_();
-extern void dzdzeb_();
-extern void dzdb08_();
-extern void dzdb07_();
-extern void dzdb06_();
-extern void dzdb05_();
-extern void dzdb04_();
-extern void dzdb03_();
-extern void dzdb01_();
-extern void dzdb18_();
-extern void dzdb17_();
-extern void dzdb16_();
-extern void dzdb15_();
-extern void dzdb14_();
-extern void dzdb13_();
-extern void dzdb12_();
-extern void dzdb11_();
-extern void igrsiz_();
-extern void igobj_();
-extern void igset_();
-extern void iclwk_();
-
-extern int ixmotif();
-
-void zbrdef_()
-{
-
-static char *_DZDOC_Set_par_NEW_WINDOW_CNEWIN_range[] = { "No", "Yes" };
-static KmParameter _DZDOC_Set_par_NEW_WINDOW_CNEWIN = { "CNEWIN", 6,
- "Open new windows", "Yes", (char*)0, 8, 2,
- _DZDOC_Set_par_NEW_WINDOW_CNEWIN_range, 2,
- _DZDOC_Set_par_NEW_WINDOW_CNEWIN_range, (KmParFlag)0, KmTYPE_CHAR, (void*)0
- };
-static KmParameter *_DZDOC_Set_par_NEW_WINDOW_parameters[] = {
- &_DZDOC_Set_par_NEW_WINDOW_CNEWIN };
-static char *_DZDOC_Set_par_NEW_WINDOW_guidance[] = {
- "Select if output of DZDISP etc. should go in a new window or",
- "be displayed on the terminal (KXTERM)." };
-static KmCommand _DZDOC_Set_par_NEW_WINDOW = { (KmCommand*)0,
- "/DZDOC/Set_par/NEW_WINDOW", "NEW_WINDOW", 0, 2, 1, 1,
- _DZDOC_Set_par_NEW_WINDOW_parameters, 0, 0, dzdskd_, (IntFunc*)0,
- (SUBROUTINE*)0, (IntFunc*)0, 2, _DZDOC_Set_par_NEW_WINDOW_guidance, 0,
- (char**)0, (char*)0, (int*)0 };
-
-static KmParameter _DZDOC_Set_par_DZSHOW_OPT_CDZOPT = { "CDZOPT", 6,
- "DZSHOW option", " ", (char*)0, 20, 0, (char**)0, 0, (char**)0, (KmParFlag)0,
- KmTYPE_CHAR, (void*)0 };
-static KmParameter *_DZDOC_Set_par_DZSHOW_OPT_parameters[] = {
- &_DZDOC_Set_par_DZSHOW_OPT_CDZOPT };
-static char *_DZDOC_Set_par_DZSHOW_OPT_guidance[] = {
- "CDZOPT Option when calling DZSHOW" };
-static KmCommand _DZDOC_Set_par_DZSHOW_OPT = { &_DZDOC_Set_par_NEW_WINDOW,
- "/DZDOC/Set_par/DZSHOW_OPT", "DZSHOW_OPT", 0, 2, 1, 1,
- _DZDOC_Set_par_DZSHOW_OPT_parameters, 0, 0, dzdskd_, (IntFunc*)0,
- (SUBROUTINE*)0, (IntFunc*)0, 1, _DZDOC_Set_par_DZSHOW_OPT_guidance, 0,
- (char**)0, (char*)0, (int*)0 };
-
-static char *_DZDOC_Set_par_REF_LINKS_CREFLN_range[] = { "No", "Yes" };
-static KmParameter _DZDOC_Set_par_REF_LINKS_CREFLN = { "CREFLN", 6,
- "Follow reference links", "Yes", (char*)0, 8, 2,
- _DZDOC_Set_par_REF_LINKS_CREFLN_range, 2,
- _DZDOC_Set_par_REF_LINKS_CREFLN_range, (KmParFlag)0, KmTYPE_CHAR, (void*)0 };
-static KmParameter *_DZDOC_Set_par_REF_LINKS_parameters[] = {
- &_DZDOC_Set_par_REF_LINKS_CREFLN };
-static char *_DZDOC_Set_par_REF_LINKS_guidance[] = {
- "Select if reference links should be followed" };
-static KmCommand _DZDOC_Set_par_REF_LINKS = { &_DZDOC_Set_par_DZSHOW_OPT,
- "/DZDOC/Set_par/REF_LINKS", "REF_LINKS", 0, 2, 1, 1,
- _DZDOC_Set_par_REF_LINKS_parameters, 0, 0, dzdskd_, (IntFunc*)0,
- (SUBROUTINE*)0, (IntFunc*)0, 1, _DZDOC_Set_par_REF_LINKS_guidance, 0,
- (char**)0, (char*)0, (int*)0 };
-
-static KmParInt _DZDOC_Set_par_BROWSEKEY_IKDSP1_type = { (char*)0,
- (char*)0, (char*)0, (char*)0, 0 };
-static KmParameter _DZDOC_Set_par_BROWSEKEY_IKDSP1 = { "IKDSP1", 6,
- "Key to display", "1", (char*)0, 8, 0, (char**)0, 0, (char**)0, (KmParFlag)0,
- KmTYPE_INT, &_DZDOC_Set_par_BROWSEKEY_IKDSP1_type };
-static KmParInt _DZDOC_Set_par_BROWSEKEY_IKDSP2_type = { (char*)0,
- (char*)0, (char*)0, (char*)0, 0 };
-static KmParameter _DZDOC_Set_par_BROWSEKEY_IKDSP2 = { "IKDSP2", 6,
- "Key to display", "2", (char*)0, 8, 0, (char**)0, 0, (char**)0, (KmParFlag)0,
- KmTYPE_INT, &_DZDOC_Set_par_BROWSEKEY_IKDSP2_type };
-static KmParInt _DZDOC_Set_par_BROWSEKEY_ICYDSP_type = { (char*)0,
- (char*)0, (char*)0, (char*)0, 0 };
-static KmParameter _DZDOC_Set_par_BROWSEKEY_ICYDSP = { "ICYDSP", 6,
- "Cycle to display", "1000000", (char*)0, 8, 0, (char**)0, 0, (char**)0,
- (KmParFlag)0, KmTYPE_INT, &_DZDOC_Set_par_BROWSEKEY_ICYDSP_type };
-static KmParameter *_DZDOC_Set_par_BROWSEKEY_parameters[] = {
- &_DZDOC_Set_par_BROWSEKEY_IKDSP1, &_DZDOC_Set_par_BROWSEKEY_IKDSP2,
- &_DZDOC_Set_par_BROWSEKEY_ICYDSP };
-static char *_DZDOC_Set_par_BROWSEKEY_guidance[] = {
- "Select the two keys and the cycle to be shown by the browser." };
-static KmCommand _DZDOC_Set_par_BROWSEKEY = { &_DZDOC_Set_par_REF_LINKS,
- "/DZDOC/Set_par/BROWSEKEY", "BROWSEKEY", 0, 2, 3, 3,
- _DZDOC_Set_par_BROWSEKEY_parameters, 0, 0, dzdskd_, (IntFunc*)0,
- (SUBROUTINE*)0, (IntFunc*)0, 1, _DZDOC_Set_par_BROWSEKEY_guidance, 0,
- (char**)0, (char*)0, (int*)0 };
-
-static char *_DZDOC_Set_par_WORKSTATION_CCACT_range[] = { "No", "Yes" };
-static KmParameter _DZDOC_Set_par_WORKSTATION_CCACT = { "CCACT", 5,
- "Activate workstation", "No", (char*)0, 8, 2,
- _DZDOC_Set_par_WORKSTATION_CCACT_range, 2,
- _DZDOC_Set_par_WORKSTATION_CCACT_range, (KmParFlag)0, KmTYPE_CHAR, (void*)0
- };
-static KmParInt _DZDOC_Set_par_WORKSTATION_IWKID_type = { (char*)0,
- (char*)0, (char*)0, (char*)0, 0 };
-static KmParameter _DZDOC_Set_par_WORKSTATION_IWKID = { "IWKID", 5,
- "Use workstation Id", "1", (char*)0, 8, 0, (char**)0, 0, (char**)0,
- (KmParFlag)0, KmTYPE_INT, &_DZDOC_Set_par_WORKSTATION_IWKID_type };
-static KmParameter *_DZDOC_Set_par_WORKSTATION_parameters[] = {
- &_DZDOC_Set_par_WORKSTATION_CCACT, &_DZDOC_Set_par_WORKSTATION_IWKID };
-static char *_DZDOC_Set_par_WORKSTATION_guidance[] = {
- "Enable/disable workstation activation.",
- "DZDOC may optionally use a different window (workstation IWKID)." };
-static KmCommand _DZDOC_Set_par_WORKSTATION = { &_DZDOC_Set_par_BROWSEKEY,
- "/DZDOC/Set_par/WORKSTATION", "WORKSTATION", 0, 2, 2, 2,
- _DZDOC_Set_par_WORKSTATION_parameters, 0, 0, dzdskd_, (IntFunc*)0,
- (SUBROUTINE*)0, (IntFunc*)0, 2, _DZDOC_Set_par_WORKSTATION_guidance, 0,
- (char**)0, (char*)0, (int*)0 };
-
-static char *_DZDOC_Set_par_BANKCOLOR_COLBNK_range[] = { "Yes", "No" };
-static KmParameter _DZDOC_Set_par_BANKCOLOR_COLBNK = { "COLBNK", 6,
- "Color bank display", "Yes", (char*)0, 8, 2,
- _DZDOC_Set_par_BANKCOLOR_COLBNK_range, 2,
- _DZDOC_Set_par_BANKCOLOR_COLBNK_range, (KmParFlag)0, KmTYPE_CHAR, (void*)0 };
-static KmParInt _DZDOC_Set_par_BANKCOLOR_IBCCOL_type = { (char*)0,
- (char*)0, (char*)0, (char*)0, 0 };
-static KmParameter _DZDOC_Set_par_BANKCOLOR_IBCCOL = { "IBCCOL", 6,
- "Color for bank center", "7", (char*)0, 8, 0, (char**)0, 0, (char**)0,
- (KmParFlag)0, KmTYPE_INT, &_DZDOC_Set_par_BANKCOLOR_IBCCOL_type };
-static KmParInt _DZDOC_Set_par_BANKCOLOR_IBDCOL_type = { (char*)0,
- (char*)0, (char*)0, (char*)0, 0 };
-static KmParameter _DZDOC_Set_par_BANKCOLOR_IBDCOL = { "IBDCOL", 6,
- "Color for data box", "3", (char*)0, 8, 0, (char**)0, 0, (char**)0,
- (KmParFlag)0, KmTYPE_INT, &_DZDOC_Set_par_BANKCOLOR_IBDCOL_type };
-static KmParameter *_DZDOC_Set_par_BANKCOLOR_parameters[] = {
- &_DZDOC_Set_par_BANKCOLOR_COLBNK, &_DZDOC_Set_par_BANKCOLOR_IBCCOL,
- &_DZDOC_Set_par_BANKCOLOR_IBDCOL };
-static char *_DZDOC_Set_par_BANKCOLOR_guidance[] = {
- "Choose if bank display should be colored.",
- "Color indexes for bank center and box." };
-static KmCommand _DZDOC_Set_par_BANKCOLOR = { &_DZDOC_Set_par_WORKSTATION,
- "/DZDOC/Set_par/BANKCOLOR", "BANKCOLOR", 0, 2, 3, 1,
- _DZDOC_Set_par_BANKCOLOR_parameters, 0, 0, dzdskd_, (IntFunc*)0,
- (SUBROUTINE*)0, (IntFunc*)0, 2, _DZDOC_Set_par_BANKCOLOR_guidance, 0,
- (char**)0, (char*)0, (int*)0 };
-
-static KmParameter _DZDOC_File_DIR_ADD_CHDIR = { "CHDIR", 5, "Directory name",
- " ", (char*)0, 20, 0, (char**)0, 0, (char**)0, (KmParFlag)0, KmTYPE_CHAR,
- (void*)0 };
-static KmParameter *_DZDOC_File_DIR_ADD_parameters[] = {
- &_DZDOC_File_DIR_ADD_CHDIR };
-static char *_DZDOC_File_DIR_ADD_guidance[] = {
- "Add a directory into search path when looking for",
- "bank documention files. (max 10 dirs allowed)" };
-static KmCommand _DZDOC_File_DIR_ADD = { (KmCommand*)0,
- "/DZDOC/File/DIR_ADD", "DIR_ADD", 0, 2, 1, 1, _DZDOC_File_DIR_ADD_parameters,
- 0, 0, dzddad_, (IntFunc*)0, (SUBROUTINE*)0, (IntFunc*)0, 2,
- _DZDOC_File_DIR_ADD_guidance, 0, (char**)0, (char*)0, (int*)0 };
-
-static KmParameter _DZDOC_File_EDIT_DOC_CHBANK = { "CHBANK", 6,
- "Bank Hol_Id ", " ", (char*)0, 20, 0, (char**)0, 0, (char**)0, (KmParFlag)0,
- KmTYPE_CHAR, (void*)0 };
-static KmParameter _DZDOC_File_EDIT_DOC_CHUPID = { "CHUPID", 6,
- "UpBank Hol_Id", " ", (char*)0, 20, 0, (char**)0, 0, (char**)0, (KmParFlag)0,
- KmTYPE_CHAR, (void*)0 };
-static char *_DZDOC_File_EDIT_DOC_CHOPT_range[] = { "Rz", "Ascii", "Memory" };
-static char *_DZDOC_File_EDIT_DOC_CHOPT_text[] = { (char*)0, (char*)0,
- (char*)0 };
-static KmParOption _DZDOC_File_EDIT_DOC_CHOPT_type = {
- _DZDOC_File_EDIT_DOC_CHOPT_text, (int*)0, (int*)0 };
-static KmParameter _DZDOC_File_EDIT_DOC_CHOPT = { "CHOPT", 5, "Option ",
- "Rz", (char*)0, 8, 3, _DZDOC_File_EDIT_DOC_CHOPT_range, 3,
- _DZDOC_File_EDIT_DOC_CHOPT_range, (KmParFlag)0, KmTYPE_OPTION,
- &_DZDOC_File_EDIT_DOC_CHOPT_type };
-static KmParameter _DZDOC_File_EDIT_DOC_CHFILE = { "CHFILE", 6,
- "File name ", " ", (char*)0, 20, 0, (char**)0, 0, (char**)0, (KmParFlag)0,
- KmTYPE_CHAR, (void*)0 };
-static KmParInt _DZDOC_File_EDIT_DOC_STORE_type = { (char*)0, (char*)0,
- (char*)0, (char*)0, 0 };
-static KmParameter _DZDOC_File_EDIT_DOC_STORE = { "STORE", 5, "Store ",
- "0", (char*)0, 8, 0, (char**)0, 0, (char**)0, (KmParFlag)0, KmTYPE_INT,
- &_DZDOC_File_EDIT_DOC_STORE_type };
-static KmParInt _DZDOC_File_EDIT_DOC_DIV_type = { (char*)0, (char*)0,
- (char*)0, (char*)0, 0 };
-static KmParameter _DZDOC_File_EDIT_DOC_DIV = { "DIV", 3, "Division ",
- "2", (char*)0, 8, 0, (char**)0, 0, (char**)0, (KmParFlag)0, KmTYPE_INT,
- &_DZDOC_File_EDIT_DOC_DIV_type };
-static KmParameter *_DZDOC_File_EDIT_DOC_parameters[] = {
- &_DZDOC_File_EDIT_DOC_CHBANK, &_DZDOC_File_EDIT_DOC_CHUPID,
- &_DZDOC_File_EDIT_DOC_CHOPT, &_DZDOC_File_EDIT_DOC_CHFILE,
- &_DZDOC_File_EDIT_DOC_STORE, &_DZDOC_File_EDIT_DOC_DIV };
-static char *_DZDOC_File_EDIT_DOC_guidance[] = {
- "Edit documentation for selected bank. The source may be", "taken from:",
- " - an (open) RZ documentation file",
- " - an Ascii file in current dir or one added by DIR_ADD",
- " - a template of a bank in memory (Store and div must be given)",
- "In the case of 'Ascii' the file name may explicitly be given in CHFILE,",
- "if CHFILE = ' ' it is defaulted to 'CHBANK_CHUPID.dzdoc'." };
-static KmCommand _DZDOC_File_EDIT_DOC = { &_DZDOC_File_DIR_ADD,
- "/DZDOC/File/EDIT_DOC", "EDIT_DOC", 0, 2, 6, 6,
- _DZDOC_File_EDIT_DOC_parameters, 0, 0, dzdedd_, (IntFunc*)0, (SUBROUTINE*)0,
- (IntFunc*)0, 7, _DZDOC_File_EDIT_DOC_guidance, 0, (char**)0, (char*)0,
- (int*)0 };
-
-static KmParameter _DZDOC_File_OPEN_DOC_CHDOCB = { "CHDOCB", 6, "File name",
- " ", (char*)0, 20, 0, (char**)0, 0, (char**)0, (KmParFlag)0, KmTYPE_CHAR,
- (void*)0 };
-static char *_DZDOC_File_OPEN_DOC_CHOPT_range[] = { "R", "N", "U", "L" };
-static char *_DZDOC_File_OPEN_DOC_CHOPT_text[] = { (char*)0, (char*)0,
- (char*)0, (char*)0 };
-static KmParOption _DZDOC_File_OPEN_DOC_CHOPT_type = {
- _DZDOC_File_OPEN_DOC_CHOPT_text, (int*)0, (int*)0 };
-static KmParameter _DZDOC_File_OPEN_DOC_CHOPT = { "CHOPT", 5, "Options", "R",
- (char*)0, 8, 4, _DZDOC_File_OPEN_DOC_CHOPT_range, 4,
- _DZDOC_File_OPEN_DOC_CHOPT_range, (KmParFlag)0, KmTYPE_OPTION,
- &_DZDOC_File_OPEN_DOC_CHOPT_type };
-static KmParameter *_DZDOC_File_OPEN_DOC_parameters[] = {
- &_DZDOC_File_OPEN_DOC_CHDOCB, &_DZDOC_File_OPEN_DOC_CHOPT };
-static char *_DZDOC_File_OPEN_DOC_guidance[] = {
- "Open (RZ) file with bank documentation in",
- "Readonly (default), New or Update mode",
- "Option L: List contents (RZLDIR) (file must be open)" };
-static KmCommand _DZDOC_File_OPEN_DOC = { &_DZDOC_File_EDIT_DOC,
- "/DZDOC/File/OPEN_DOC", "OPEN_DOC", 0, 2, 2, 1,
- _DZDOC_File_OPEN_DOC_parameters, 0, 0, dzdorf_, (IntFunc*)0, (SUBROUTINE*)0,
- (IntFunc*)0, 3, _DZDOC_File_OPEN_DOC_guidance, 0, (char**)0, (char*)0,
- (int*)0 };
-
-static KmParameter _DZDOC_Bankdisplay_SURVEY_CHBANK = { "CHBANK", 6,
- "Bank Hol_Id", " ", (char*)0, 20, 0, (char**)0, 0, (char**)0, (KmParFlag)0,
- KmTYPE_CHAR, (void*)0 };
-static KmParInt _DZDOC_Bankdisplay_SURVEY_NID_type = { (char*)0, (char*)0,
- (char*)0, (char*)0, 0 };
-static KmParameter _DZDOC_Bankdisplay_SURVEY_NID = { "NID", 3,
- "Num Id ", "0", (char*)0, 8, 0, (char**)0, 0, (char**)0, (KmParFlag)0,
- KmTYPE_INT, &_DZDOC_Bankdisplay_SURVEY_NID_type };
-static KmParInt _DZDOC_Bankdisplay_SURVEY_STORE_type = { (char*)0,
- (char*)0, (char*)0, (char*)0, 0 };
-static KmParameter _DZDOC_Bankdisplay_SURVEY_STORE = { "STORE", 5,
- "Store ", "0", (char*)0, 8, 0, (char**)0, 0, (char**)0, (KmParFlag)0,
- KmTYPE_INT, &_DZDOC_Bankdisplay_SURVEY_STORE_type };
-static KmParInt _DZDOC_Bankdisplay_SURVEY_DIV_type = { (char*)0, (char*)0,
- (char*)0, (char*)0, 0 };
-static KmParameter _DZDOC_Bankdisplay_SURVEY_DIV = { "DIV", 3,
- "Division ", "2", (char*)0, 8, 0, (char**)0, 0, (char**)0, (KmParFlag)0,
- KmTYPE_INT, &_DZDOC_Bankdisplay_SURVEY_DIV_type };
-static KmParameter _DZDOC_Bankdisplay_SURVEY_CHUPID = { "CHUPID", 6,
- "UpBank Hol_Id", " ", (char*)0, 20, 0, (char**)0, 0, (char**)0, (KmParFlag)0,
- KmTYPE_CHAR, (void*)0 };
-static KmParameter *_DZDOC_Bankdisplay_SURVEY_parameters[] = {
- &_DZDOC_Bankdisplay_SURVEY_CHBANK, &_DZDOC_Bankdisplay_SURVEY_NID,
- &_DZDOC_Bankdisplay_SURVEY_STORE, &_DZDOC_Bankdisplay_SURVEY_DIV,
- &_DZDOC_Bankdisplay_SURVEY_CHUPID };
-static char *_DZDOC_Bankdisplay_SURVEY_guidance[] = {
- "Call DZSURV for selected bank" };
-static KmCommand _DZDOC_Bankdisplay_SURVEY = { (KmCommand*)0,
- "/DZDOC/Bankdisplay/SURVEY", "SURVEY", 0, 2, 5, 1,
- _DZDOC_Bankdisplay_SURVEY_parameters, 0, 0, dzdsha_, (IntFunc*)0,
- (SUBROUTINE*)0, (IntFunc*)0, 1, _DZDOC_Bankdisplay_SURVEY_guidance, 0,
- (char**)0, (char*)0, (int*)0 };
-
-static KmParameter _DZDOC_Bankdisplay_DOCUMENTATION_CHBANK = { "CHBANK", 6,
- "Bank Hol_Id", " ", (char*)0, 20, 0, (char**)0, 0, (char**)0, (KmParFlag)0,
- KmTYPE_CHAR, (void*)0 };
-static KmParInt _DZDOC_Bankdisplay_DOCUMENTATION_NID_type = { (char*)0,
- (char*)0, (char*)0, (char*)0, 0 };
-static KmParameter _DZDOC_Bankdisplay_DOCUMENTATION_NID = { "NID", 3,
- "Num Id ", "0", (char*)0, 8, 0, (char**)0, 0, (char**)0, (KmParFlag)0,
- KmTYPE_INT, &_DZDOC_Bankdisplay_DOCUMENTATION_NID_type };
-static KmParInt _DZDOC_Bankdisplay_DOCUMENTATION_STORE_type = { (char*)0,
- (char*)0, (char*)0, (char*)0, 0 };
-static KmParameter _DZDOC_Bankdisplay_DOCUMENTATION_STORE = { "STORE", 5,
- "Store ", "0", (char*)0, 8, 0, (char**)0, 0, (char**)0, (KmParFlag)0,
- KmTYPE_INT, &_DZDOC_Bankdisplay_DOCUMENTATION_STORE_type };
-static KmParInt _DZDOC_Bankdisplay_DOCUMENTATION_DIV_type = { (char*)0,
- (char*)0, (char*)0, (char*)0, 0 };
-static KmParameter _DZDOC_Bankdisplay_DOCUMENTATION_DIV = { "DIV", 3,
- "Division ", "2", (char*)0, 8, 0, (char**)0, 0, (char**)0, (KmParFlag)0,
- KmTYPE_INT, &_DZDOC_Bankdisplay_DOCUMENTATION_DIV_type };
-static KmParameter _DZDOC_Bankdisplay_DOCUMENTATION_CHUPID = { "CHUPID", 6,
- "UpBank Hol_Id", " ", (char*)0, 20, 0, (char**)0, 0, (char**)0, (KmParFlag)0,
- KmTYPE_CHAR, (void*)0 };
-static KmParameter *_DZDOC_Bankdisplay_DOCUMENTATION_parameters[] = {
- &_DZDOC_Bankdisplay_DOCUMENTATION_CHBANK,
- &_DZDOC_Bankdisplay_DOCUMENTATION_NID,
- &_DZDOC_Bankdisplay_DOCUMENTATION_STORE,
- &_DZDOC_Bankdisplay_DOCUMENTATION_DIV,
- &_DZDOC_Bankdisplay_DOCUMENTATION_CHUPID };
-static char *_DZDOC_Bankdisplay_DOCUMENTATION_guidance[] = {
- "Show documentation for selected bank" };
-static KmCommand _DZDOC_Bankdisplay_DOCUMENTATION = {
- &_DZDOC_Bankdisplay_SURVEY, "/DZDOC/Bankdisplay/DOCUMENTATION",
- "DOCUMENTATION", 0, 2, 5, 1, _DZDOC_Bankdisplay_DOCUMENTATION_parameters, 0,
- 0, dzdsha_, (IntFunc*)0, (SUBROUTINE*)0, (IntFunc*)0, 1,
- _DZDOC_Bankdisplay_DOCUMENTATION_guidance, 0, (char**)0, (char*)0, (int*)0 };
-
-static KmParameter _DZDOC_Bankdisplay_SYSTEMWORDS_CHBANK = { "CHBANK", 6,
- "Bank Hol_Id", " ", (char*)0, 20, 0, (char**)0, 0, (char**)0, (KmParFlag)0,
- KmTYPE_CHAR, (void*)0 };
-static KmParInt _DZDOC_Bankdisplay_SYSTEMWORDS_NID_type = { (char*)0,
- (char*)0, (char*)0, (char*)0, 0 };
-static KmParameter _DZDOC_Bankdisplay_SYSTEMWORDS_NID = { "NID", 3,
- "Num Id ", "0", (char*)0, 8, 0, (char**)0, 0, (char**)0, (KmParFlag)0,
- KmTYPE_INT, &_DZDOC_Bankdisplay_SYSTEMWORDS_NID_type };
-static KmParInt _DZDOC_Bankdisplay_SYSTEMWORDS_STORE_type = { (char*)0,
- (char*)0, (char*)0, (char*)0, 0 };
-static KmParameter _DZDOC_Bankdisplay_SYSTEMWORDS_STORE = { "STORE", 5,
- "Store ", "0", (char*)0, 8, 0, (char**)0, 0, (char**)0, (KmParFlag)0,
- KmTYPE_INT, &_DZDOC_Bankdisplay_SYSTEMWORDS_STORE_type };
-static KmParInt _DZDOC_Bankdisplay_SYSTEMWORDS_DIV_type = { (char*)0,
- (char*)0, (char*)0, (char*)0, 0 };
-static KmParameter _DZDOC_Bankdisplay_SYSTEMWORDS_DIV = { "DIV", 3,
- "Division ", "2", (char*)0, 8, 0, (char**)0, 0, (char**)0, (KmParFlag)0,
- KmTYPE_INT, &_DZDOC_Bankdisplay_SYSTEMWORDS_DIV_type };
-static KmParameter _DZDOC_Bankdisplay_SYSTEMWORDS_CHUPID = { "CHUPID", 6,
- "UpBank Hol_Id", " ", (char*)0, 20, 0, (char**)0, 0, (char**)0, (KmParFlag)0,
- KmTYPE_CHAR, (void*)0 };
-static KmParameter *_DZDOC_Bankdisplay_SYSTEMWORDS_parameters[] = {
- &_DZDOC_Bankdisplay_SYSTEMWORDS_CHBANK, &_DZDOC_Bankdisplay_SYSTEMWORDS_NID,
- &_DZDOC_Bankdisplay_SYSTEMWORDS_STORE, &_DZDOC_Bankdisplay_SYSTEMWORDS_DIV,
- &_DZDOC_Bankdisplay_SYSTEMWORDS_CHUPID };
-static char *_DZDOC_Bankdisplay_SYSTEMWORDS_guidance[] = {
- "Show system words and links for selected bank" };
-static KmCommand _DZDOC_Bankdisplay_SYSTEMWORDS = {
- &_DZDOC_Bankdisplay_DOCUMENTATION, "/DZDOC/Bankdisplay/SYSTEMWORDS",
- "SYSTEMWORDS", 0, 2, 5, 1, _DZDOC_Bankdisplay_SYSTEMWORDS_parameters, 0, 0,
- dzdsha_, (IntFunc*)0, (SUBROUTINE*)0, (IntFunc*)0, 1,
- _DZDOC_Bankdisplay_SYSTEMWORDS_guidance, 0, (char**)0, (char*)0, (int*)0 };
-
-static KmParameter _DZDOC_Bankdisplay_DZSHOW_CONT_CHBANK = { "CHBANK", 6,
- "Bank Hol_Id", " ", (char*)0, 20, 0, (char**)0, 0, (char**)0, (KmParFlag)0,
- KmTYPE_CHAR, (void*)0 };
-static KmParInt _DZDOC_Bankdisplay_DZSHOW_CONT_NID_type = { (char*)0,
- (char*)0, (char*)0, (char*)0, 0 };
-static KmParameter _DZDOC_Bankdisplay_DZSHOW_CONT_NID = { "NID", 3,
- "Num Id ", "0", (char*)0, 8, 0, (char**)0, 0, (char**)0, (KmParFlag)0,
- KmTYPE_INT, &_DZDOC_Bankdisplay_DZSHOW_CONT_NID_type };
-static KmParInt _DZDOC_Bankdisplay_DZSHOW_CONT_STORE_type = { (char*)0,
- (char*)0, (char*)0, (char*)0, 0 };
-static KmParameter _DZDOC_Bankdisplay_DZSHOW_CONT_STORE = { "STORE", 5,
- "Store ", "0", (char*)0, 8, 0, (char**)0, 0, (char**)0, (KmParFlag)0,
- KmTYPE_INT, &_DZDOC_Bankdisplay_DZSHOW_CONT_STORE_type };
-static KmParInt _DZDOC_Bankdisplay_DZSHOW_CONT_DIV_type = { (char*)0,
- (char*)0, (char*)0, (char*)0, 0 };
-static KmParameter _DZDOC_Bankdisplay_DZSHOW_CONT_DIV = { "DIV", 3,
- "Division ", "2", (char*)0, 8, 0, (char**)0, 0, (char**)0, (KmParFlag)0,
- KmTYPE_INT, &_DZDOC_Bankdisplay_DZSHOW_CONT_DIV_type };
-static KmParameter _DZDOC_Bankdisplay_DZSHOW_CONT_CHUPID = { "CHUPID", 6,
- "UpBank Hol_Id", " ", (char*)0, 20, 0, (char**)0, 0, (char**)0, (KmParFlag)0,
- KmTYPE_CHAR, (void*)0 };
-static KmParameter *_DZDOC_Bankdisplay_DZSHOW_CONT_parameters[] = {
- &_DZDOC_Bankdisplay_DZSHOW_CONT_CHBANK, &_DZDOC_Bankdisplay_DZSHOW_CONT_NID,
- &_DZDOC_Bankdisplay_DZSHOW_CONT_STORE, &_DZDOC_Bankdisplay_DZSHOW_CONT_DIV,
- &_DZDOC_Bankdisplay_DZSHOW_CONT_CHUPID };
-static char *_DZDOC_Bankdisplay_DZSHOW_CONT_guidance[] = {
- "Show contents of bank by DZSHOW (no documentation)" };
-static KmCommand _DZDOC_Bankdisplay_DZSHOW_CONT = {
- &_DZDOC_Bankdisplay_SYSTEMWORDS, "/DZDOC/Bankdisplay/DZSHOW_CONT",
- "DZSHOW_CONT", 0, 2, 5, 1, _DZDOC_Bankdisplay_DZSHOW_CONT_parameters, 0, 0,
- dzdsha_, (IntFunc*)0, (SUBROUTINE*)0, (IntFunc*)0, 1,
- _DZDOC_Bankdisplay_DZSHOW_CONT_guidance, 0, (char**)0, (char*)0, (int*)0 };
-
-static KmParameter _DZDOC_Bankdisplay_CONTENTS_CHBANK = { "CHBANK", 6,
- "Bank Hol_Id", " ", (char*)0, 20, 0, (char**)0, 0, (char**)0, (KmParFlag)0,
- KmTYPE_CHAR, (void*)0 };
-static KmParInt _DZDOC_Bankdisplay_CONTENTS_NID_type = { (char*)0,
- (char*)0, (char*)0, (char*)0, 0 };
-static KmParameter _DZDOC_Bankdisplay_CONTENTS_NID = { "NID", 3,
- "Num Id ", "0", (char*)0, 8, 0, (char**)0, 0, (char**)0, (KmParFlag)0,
- KmTYPE_INT, &_DZDOC_Bankdisplay_CONTENTS_NID_type };
-static KmParInt _DZDOC_Bankdisplay_CONTENTS_STORE_type = { (char*)0,
- (char*)0, (char*)0, (char*)0, 0 };
-static KmParameter _DZDOC_Bankdisplay_CONTENTS_STORE = { "STORE", 5,
- "Store ", "0", (char*)0, 8, 0, (char**)0, 0, (char**)0, (KmParFlag)0,
- KmTYPE_INT, &_DZDOC_Bankdisplay_CONTENTS_STORE_type };
-static KmParInt _DZDOC_Bankdisplay_CONTENTS_DIV_type = { (char*)0,
- (char*)0, (char*)0, (char*)0, 0 };
-static KmParameter _DZDOC_Bankdisplay_CONTENTS_DIV = { "DIV", 3,
- "Division ", "2", (char*)0, 8, 0, (char**)0, 0, (char**)0, (KmParFlag)0,
- KmTYPE_INT, &_DZDOC_Bankdisplay_CONTENTS_DIV_type };
-static KmParameter _DZDOC_Bankdisplay_CONTENTS_CHUPID = { "CHUPID", 6,
- "UpBank Hol_Id", " ", (char*)0, 20, 0, (char**)0, 0, (char**)0, (KmParFlag)0,
- KmTYPE_CHAR, (void*)0 };
-static KmParameter *_DZDOC_Bankdisplay_CONTENTS_parameters[] = {
- &_DZDOC_Bankdisplay_CONTENTS_CHBANK, &_DZDOC_Bankdisplay_CONTENTS_NID,
- &_DZDOC_Bankdisplay_CONTENTS_STORE, &_DZDOC_Bankdisplay_CONTENTS_DIV,
- &_DZDOC_Bankdisplay_CONTENTS_CHUPID };
-static char *_DZDOC_Bankdisplay_CONTENTS_guidance[] = {
- "Show contents of bank documented." };
-static KmCommand _DZDOC_Bankdisplay_CONTENTS = {
- &_DZDOC_Bankdisplay_DZSHOW_CONT, "/DZDOC/Bankdisplay/CONTENTS", "CONTENTS",
- 0, 2, 5, 1, _DZDOC_Bankdisplay_CONTENTS_parameters, 0, 0, dzdsha_,
- (IntFunc*)0, (SUBROUTINE*)0, (IntFunc*)0, 1,
- _DZDOC_Bankdisplay_CONTENTS_guidance, 0, (char**)0, (char*)0, (int*)0 };
-
-static KmParameter _DZDOC_Bankdisplay_TREE_CHBANK = { "CHBANK", 6,
- "Bank Hol_Id", " ", (char*)0, 20, 0, (char**)0, 0, (char**)0, (KmParFlag)0,
- KmTYPE_CHAR, (void*)0 };
-static KmParInt _DZDOC_Bankdisplay_TREE_NID_type = { (char*)0, (char*)0,
- (char*)0, (char*)0, 0 };
-static KmParameter _DZDOC_Bankdisplay_TREE_NID = { "NID", 3, "Num Id ",
- "0", (char*)0, 8, 0, (char**)0, 0, (char**)0, (KmParFlag)0, KmTYPE_INT,
- &_DZDOC_Bankdisplay_TREE_NID_type };
-static KmParInt _DZDOC_Bankdisplay_TREE_STORE_type = { (char*)0, (char*)0,
- (char*)0, (char*)0, 0 };
-static KmParameter _DZDOC_Bankdisplay_TREE_STORE = { "STORE", 5,
- "Store ", "0", (char*)0, 8, 0, (char**)0, 0, (char**)0, (KmParFlag)0,
- KmTYPE_INT, &_DZDOC_Bankdisplay_TREE_STORE_type };
-static KmParInt _DZDOC_Bankdisplay_TREE_DIV_type = { (char*)0, (char*)0,
- (char*)0, (char*)0, 0 };
-static KmParameter _DZDOC_Bankdisplay_TREE_DIV = { "DIV", 3, "Division ",
- "2", (char*)0, 8, 0, (char**)0, 0, (char**)0, (KmParFlag)0, KmTYPE_INT,
- &_DZDOC_Bankdisplay_TREE_DIV_type };
-static KmParameter _DZDOC_Bankdisplay_TREE_CHUPID = { "CHUPID", 6,
- "UpBank Hol_Id", " ", (char*)0, 20, 0, (char**)0, 0, (char**)0, (KmParFlag)0,
- KmTYPE_CHAR, (void*)0 };
-static KmParameter *_DZDOC_Bankdisplay_TREE_parameters[] = {
- &_DZDOC_Bankdisplay_TREE_CHBANK, &_DZDOC_Bankdisplay_TREE_NID,
- &_DZDOC_Bankdisplay_TREE_STORE, &_DZDOC_Bankdisplay_TREE_DIV,
- &_DZDOC_Bankdisplay_TREE_CHUPID };
-static char *_DZDOC_Bankdisplay_TREE_guidance[] = {
- "Show bank tree for selected bank" };
-static KmCommand _DZDOC_Bankdisplay_TREE = { &_DZDOC_Bankdisplay_CONTENTS,
- "/DZDOC/Bankdisplay/TREE", "TREE", 0, 2, 5, 1,
- _DZDOC_Bankdisplay_TREE_parameters, 0, 0, dzdsha_, (IntFunc*)0,
- (SUBROUTINE*)0, (IntFunc*)0, 1, _DZDOC_Bankdisplay_TREE_guidance, 0,
- (char**)0, (char*)0, (int*)0 };
-
-static KmParameter _DZDOC_BROWSE_VERIFY_DIV_CHDIV = { "CHDIV", 5, "Div name",
- " ", (char*)0, 20, 0, (char**)0, 0, (char**)0, (KmParFlag)0, KmTYPE_CHAR,
- (void*)0 };
-static KmParOption _DZDOC_BROWSE_VERIFY_DIV_CHOPT_type = { (char**)0, (int*)0,
- (int*)0 };
-static KmParameter _DZDOC_BROWSE_VERIFY_DIV_CHOPT = { "CHOPT", 5, "Option",
- "CLSU", (char*)0, 20, 0, (char**)0, 0, (char**)0, (KmParFlag)0,
- KmTYPE_OPTION, &_DZDOC_BROWSE_VERIFY_DIV_CHOPT_type };
-static KmParameter *_DZDOC_BROWSE_VERIFY_DIV_parameters[] = {
- &_DZDOC_BROWSE_VERIFY_DIV_CHDIV, &_DZDOC_BROWSE_VERIFY_DIV_CHOPT };
-static char *_DZDOC_BROWSE_VERIFY_DIV_guidance[] = {
- "Call DZVERI, CHDIV is given in format:Store01/Div03.",
- "Default: Div 2 of current Store" };
-static KmCommand _DZDOC_BROWSE_VERIFY_DIV = { (KmCommand*)0,
- "/DZDOC/BROWSE/VERIFY_DIV", "VERIFY_DIV", 0, 2, 2, 2,
- _DZDOC_BROWSE_VERIFY_DIV_parameters, 0, 0, dzdshd_, (IntFunc*)0,
- (SUBROUTINE*)0, (IntFunc*)0, 2, _DZDOC_BROWSE_VERIFY_DIV_guidance, 0,
- (char**)0, (char*)0, (int*)0 };
-
-static KmParameter _DZDOC_BROWSE_SNAP_DIV_CHDIV = { "CHDIV", 5, "Div name",
- " ", (char*)0, 20, 0, (char**)0, 0, (char**)0, (KmParFlag)0, KmTYPE_CHAR,
- (void*)0 };
-static KmParameter *_DZDOC_BROWSE_SNAP_DIV_parameters[] = {
- &_DZDOC_BROWSE_SNAP_DIV_CHDIV };
-static char *_DZDOC_BROWSE_SNAP_DIV_guidance[] = {
- "Call DZSNAP, CHDIV is given in format:Store01/Div03.",
- "Default: Div 2 of current Store" };
-static KmCommand _DZDOC_BROWSE_SNAP_DIV = { &_DZDOC_BROWSE_VERIFY_DIV,
- "/DZDOC/BROWSE/SNAP_DIV", "SNAP_DIV", 0, 2, 1, 1,
- _DZDOC_BROWSE_SNAP_DIV_parameters, 0, 0, dzdshd_, (IntFunc*)0,
- (SUBROUTINE*)0, (IntFunc*)0, 2, _DZDOC_BROWSE_SNAP_DIV_guidance, 0,
- (char**)0, (char*)0, (int*)0 };
-
-static KmParameter _DZDOC_BROWSE_COL_GARB_CHDIV = { "CHDIV", 5, "Div name",
- " ", (char*)0, 20, 0, (char**)0, 0, (char**)0, (KmParFlag)0, KmTYPE_CHAR,
- (void*)0 };
-static KmParameter *_DZDOC_BROWSE_COL_GARB_parameters[] = {
- &_DZDOC_BROWSE_COL_GARB_CHDIV };
-static char *_DZDOC_BROWSE_COL_GARB_guidance[] = {
- "Call MZGARB for selected division" };
-static KmCommand _DZDOC_BROWSE_COL_GARB = { &_DZDOC_BROWSE_SNAP_DIV,
- "/DZDOC/BROWSE/COL_GARB", "COL_GARB", 0, 2, 1, 1,
- _DZDOC_BROWSE_COL_GARB_parameters, 0, 0, dzdshd_, (IntFunc*)0,
- (SUBROUTINE*)0, (IntFunc*)0, 1, _DZDOC_BROWSE_COL_GARB_guidance, 0,
- (char**)0, (char*)0, (int*)0 };
-
-static KmParameter _DZDOC_BROWSE_SHOW_DIV_CHDIV = { "CHDIV", 5, "Div name",
- " ", (char*)0, 20, 0, (char**)0, 0, (char**)0, (KmParFlag)0, KmTYPE_CHAR,
- (void*)0 };
-static KmParameter *_DZDOC_BROWSE_SHOW_DIV_parameters[] = {
- &_DZDOC_BROWSE_SHOW_DIV_CHDIV };
-static char *_DZDOC_BROWSE_SHOW_DIV_guidance[] = {
- "Call DZDDIV, CHDIV is given in format:Store01/Div03.",
- "Default: Div 2 of current Store" };
-static KmCommand _DZDOC_BROWSE_SHOW_DIV = { &_DZDOC_BROWSE_COL_GARB,
- "/DZDOC/BROWSE/SHOW_DIV", "SHOW_DIV", 0, 2, 1, 1,
- _DZDOC_BROWSE_SHOW_DIV_parameters, 0, 0, dzdshd_, (IntFunc*)0,
- (SUBROUTINE*)0, (IntFunc*)0, 2, _DZDOC_BROWSE_SHOW_DIV_guidance, 0,
- (char**)0, (char*)0, (int*)0 };
-
-static KmParameter _DZDOC_BROWSE_SHOW_STORE_CHSTO = { "CHSTO", 5,
- "Store name", " ", (char*)0, 20, 0, (char**)0, 0, (char**)0, (KmParFlag)0,
- KmTYPE_CHAR, (void*)0 };
-static KmParameter *_DZDOC_BROWSE_SHOW_STORE_parameters[] = {
- &_DZDOC_BROWSE_SHOW_STORE_CHSTO };
-static char *_DZDOC_BROWSE_SHOW_STORE_guidance[] = {
- "Call DZSTOR, CHSTOR is given in format:Store01",
- "Default: Div 2 of current Store" };
-static KmCommand _DZDOC_BROWSE_SHOW_STORE = { &_DZDOC_BROWSE_SHOW_DIV,
- "/DZDOC/BROWSE/SHOW_STORE", "SHOW_STORE", 0, 2, 1, 1,
- _DZDOC_BROWSE_SHOW_STORE_parameters, 0, 0, dzdshd_, (IntFunc*)0,
- (SUBROUTINE*)0, (IntFunc*)0, 2, _DZDOC_BROWSE_SHOW_STORE_guidance, 0,
- (char**)0, (char*)0, (int*)0 };
-
-static KmParInt _DZDOC_BROWSE_FILL_NTUPLE_LUN_type = { (char*)0, (char*)0,
- (char*)0, (char*)0, 0 };
-static KmParameter _DZDOC_BROWSE_FILL_NTUPLE_LUN = { "LUN", 3, "Unit number",
- (char*)0, (char*)0, 8, 0, (char**)0, 0, (char**)0, (KmParFlag)0, KmTYPE_INT,
- &_DZDOC_BROWSE_FILL_NTUPLE_LUN_type };
-static KmParInt _DZDOC_BROWSE_FILL_NTUPLE_NTUPID_type = { (char*)0,
- (char*)0, (char*)0, (char*)0, 0 };
-static KmParameter _DZDOC_BROWSE_FILL_NTUPLE_NTUPID = { "NTUPID", 6,
- "Id for Ntuple", "99", (char*)0, 8, 0, (char**)0, 0, (char**)0, (KmParFlag)0,
- KmTYPE_INT, &_DZDOC_BROWSE_FILL_NTUPLE_NTUPID_type };
-static KmParameter _DZDOC_BROWSE_FILL_NTUPLE_CNAME = { "CNAME", 5,
- "Ntuple title", "Zbrowse", (char*)0, 20, 0, (char**)0, 0, (char**)0,
- (KmParFlag)0, KmTYPE_CHAR, (void*)0 };
-static KmParameter _DZDOC_BROWSE_FILL_NTUPLE_RZPATH = { "RZPATH", 6,
- "Dir of Rzfile", " ", (char*)0, 20, 0, (char**)0, 0, (char**)0, (KmParFlag)0,
- KmTYPE_CHAR, (void*)0 };
-static KmParInt _DZDOC_BROWSE_FILL_NTUPLE_NEVENT_type = { (char*)0,
- (char*)0, (char*)0, (char*)0, 0 };
-static KmParameter _DZDOC_BROWSE_FILL_NTUPLE_NEVENT = { "NEVENT", 6,
- "Number of events", "100000", (char*)0, 8, 0, (char**)0, 0, (char**)0,
- (KmParFlag)0, KmTYPE_INT, &_DZDOC_BROWSE_FILL_NTUPLE_NEVENT_type };
-static KmParOption _DZDOC_BROWSE_FILL_NTUPLE_CHOPT_type = { (char**)0,
- (int*)0, (int*)0 };
-static KmParameter _DZDOC_BROWSE_FILL_NTUPLE_CHOPT = { "CHOPT", 5, "Option",
- " ", (char*)0, 20, 0, (char**)0, 0, (char**)0, (KmParFlag)0, KmTYPE_OPTION,
- &_DZDOC_BROWSE_FILL_NTUPLE_CHOPT_type };
-static KmParameter *_DZDOC_BROWSE_FILL_NTUPLE_parameters[] = {
- &_DZDOC_BROWSE_FILL_NTUPLE_LUN, &_DZDOC_BROWSE_FILL_NTUPLE_NTUPID,
- &_DZDOC_BROWSE_FILL_NTUPLE_CNAME, &_DZDOC_BROWSE_FILL_NTUPLE_RZPATH,
- &_DZDOC_BROWSE_FILL_NTUPLE_NEVENT, &_DZDOC_BROWSE_FILL_NTUPLE_CHOPT };
-static char *_DZDOC_BROWSE_FILL_NTUPLE_guidance[] = {
- "Read events from FZfile and fill Ntuple",
- "RZPATH may contain the directory in an (open)",
- "Rzfile to receive the Ntuple.", "Option: 'R' Rewind file before filling" };
-static KmCommand _DZDOC_BROWSE_FILL_NTUPLE = { &_DZDOC_BROWSE_SHOW_STORE,
- "/DZDOC/BROWSE/FILL_NTUPLE", "FILL_NTUPLE", 0, 2, 6, 6,
- _DZDOC_BROWSE_FILL_NTUPLE_parameters, 0, 0, dzdfnt_, (IntFunc*)0,
- (SUBROUTINE*)0, (IntFunc*)0, 4, _DZDOC_BROWSE_FILL_NTUPLE_guidance, 0,
- (char**)0, (char*)0, (int*)0 };
-
-static KmParameter _DZDOC_BROWSE_SH_FZINFO_CHLUN = { "CHLUN", 5,
- "Unit number", " ", (char*)0, 20, 0, (char**)0, 0, (char**)0, (KmParFlag)0,
- KmTYPE_CHAR, (void*)0 };
-static KmParameter *_DZDOC_BROWSE_SH_FZINFO_parameters[] = {
- &_DZDOC_BROWSE_SH_FZINFO_CHLUN };
-static char *_DZDOC_BROWSE_SH_FZINFO_guidance[] = {
- "Show Fz information for file open on Unit CHLUN" };
-static KmCommand _DZDOC_BROWSE_SH_FZINFO = { &_DZDOC_BROWSE_FILL_NTUPLE,
- "/DZDOC/BROWSE/SH_FZINFO", "SH_FZINFO", 0, 2, 1, 1,
- _DZDOC_BROWSE_SH_FZINFO_parameters, 0, 0, dzdfzs_, (IntFunc*)0,
- (SUBROUTINE*)0, (IntFunc*)0, 1, _DZDOC_BROWSE_SH_FZINFO_guidance, 0,
- (char**)0, (char*)0, (int*)0 };
-
-static KmParameter _DZDOC_BROWSE_GET_PDS_CHLUN = { "CHLUN", 5, "Unit number",
- " ", (char*)0, 20, 0, (char**)0, 0, (char**)0, (KmParFlag)0, KmTYPE_CHAR,
- (void*)0 };
-static KmParameter _DZDOC_BROWSE_GET_PDS_CHDS = { "CHDS", 4, "Display flag",
- " ", (char*)0, 20, 0, (char**)0, 0, (char**)0, (KmParFlag)0, KmTYPE_CHAR,
- (void*)0 };
-static KmParameter *_DZDOC_BROWSE_GET_PDS_parameters[] = {
- &_DZDOC_BROWSE_GET_PDS_CHLUN, &_DZDOC_BROWSE_GET_PDS_CHDS };
-static char *_DZDOC_BROWSE_GET_PDS_guidance[] = {
- "Read the pending d/s into memory" };
-static KmCommand _DZDOC_BROWSE_GET_PDS = { &_DZDOC_BROWSE_SH_FZINFO,
- "/DZDOC/BROWSE/GET_PDS", "GET_PDS", 0, 2, 2, 1,
- _DZDOC_BROWSE_GET_PDS_parameters, 0, 0, dzdfzi_, (IntFunc*)0, (SUBROUTINE*)0,
- (IntFunc*)0, 1, _DZDOC_BROWSE_GET_PDS_guidance, 0, (char**)0, (char*)0,
- (int*)0 };
-
-static KmParameter _DZDOC_BROWSE_GET_HEADER_CHLUN = { "CHLUN", 5,
- "Unit number", " ", (char*)0, 20, 0, (char**)0, 0, (char**)0, (KmParFlag)0,
- KmTYPE_CHAR, (void*)0 };
-static KmParameter _DZDOC_BROWSE_GET_HEADER_CHDS = { "CHDS", 4,
- "Display flag", " ", (char*)0, 20, 0, (char**)0, 0, (char**)0, (KmParFlag)0,
- KmTYPE_CHAR, (void*)0 };
-static KmParameter *_DZDOC_BROWSE_GET_HEADER_parameters[] = {
- &_DZDOC_BROWSE_GET_HEADER_CHLUN, &_DZDOC_BROWSE_GET_HEADER_CHDS };
-static char *_DZDOC_BROWSE_GET_HEADER_guidance[] = {
- "Read next User header into memory" };
-static KmCommand _DZDOC_BROWSE_GET_HEADER = { &_DZDOC_BROWSE_GET_PDS,
- "/DZDOC/BROWSE/GET_HEADER", "GET_HEADER", 0, 2, 2, 1,
- _DZDOC_BROWSE_GET_HEADER_parameters, 0, 0, dzdfzi_, (IntFunc*)0,
- (SUBROUTINE*)0, (IntFunc*)0, 1, _DZDOC_BROWSE_GET_HEADER_guidance, 0,
- (char**)0, (char*)0, (int*)0 };
-
-static KmParameter _DZDOC_BROWSE_GET_EVENT_CHLUN = { "CHLUN", 5,
- "Unit number", " ", (char*)0, 20, 0, (char**)0, 0, (char**)0, (KmParFlag)0,
- KmTYPE_CHAR, (void*)0 };
-static KmParameter _DZDOC_BROWSE_GET_EVENT_CHDS = { "CHDS", 4, "Display flag",
- " ", (char*)0, 20, 0, (char**)0, 0, (char**)0, (KmParFlag)0, KmTYPE_CHAR,
- (void*)0 };
-static KmParameter *_DZDOC_BROWSE_GET_EVENT_parameters[] = {
- &_DZDOC_BROWSE_GET_EVENT_CHLUN, &_DZDOC_BROWSE_GET_EVENT_CHDS };
-static char *_DZDOC_BROWSE_GET_EVENT_guidance[] = {
- "Read next d/s into memory and display it, if CHDS = 'D'" };
-static KmCommand _DZDOC_BROWSE_GET_EVENT = { &_DZDOC_BROWSE_GET_HEADER,
- "/DZDOC/BROWSE/GET_EVENT", "GET_EVENT", 0, 2, 2, 1,
- _DZDOC_BROWSE_GET_EVENT_parameters, 0, 0, dzdfzi_, (IntFunc*)0,
- (SUBROUTINE*)0, (IntFunc*)0, 1, _DZDOC_BROWSE_GET_EVENT_guidance, 0,
- (char**)0, (char*)0, (int*)0 };
-
-static KmParameter _DZDOC_BROWSE_FZ_LOG_LEVEL_CHLUN = { "CHLUN", 5,
- "Unit number", " ", (char*)0, 20, 0, (char**)0, 0, (char**)0, (KmParFlag)0,
- KmTYPE_CHAR, (void*)0 };
-static KmParInt _DZDOC_BROWSE_FZ_LOG_LEVEL_LOGL_type = { "-3", "4", "-3",
- "4", 0 };
-static KmParameter _DZDOC_BROWSE_FZ_LOG_LEVEL_LOGL = { "LOGL", 4, "Log level",
- (char*)0, (char*)0, 2, 0, (char**)0, 0, (char**)0, (KmParFlag)0, KmTYPE_INT,
- &_DZDOC_BROWSE_FZ_LOG_LEVEL_LOGL_type };
-static KmParameter *_DZDOC_BROWSE_FZ_LOG_LEVEL_parameters[] = {
- &_DZDOC_BROWSE_FZ_LOG_LEVEL_CHLUN, &_DZDOC_BROWSE_FZ_LOG_LEVEL_LOGL };
-static char *_DZDOC_BROWSE_FZ_LOG_LEVEL_guidance[] = {
- "Set logging level for FZ file" };
-static KmCommand _DZDOC_BROWSE_FZ_LOG_LEVEL = { &_DZDOC_BROWSE_GET_EVENT,
- "/DZDOC/BROWSE/FZ_LOG_LEVEL", "FZ_LOG_LEVEL", 0, 2, 2, 2,
- _DZDOC_BROWSE_FZ_LOG_LEVEL_parameters, 0, 0, dzdfll_, (IntFunc*)0,
- (SUBROUTINE*)0, (IntFunc*)0, 1, _DZDOC_BROWSE_FZ_LOG_LEVEL_guidance, 0,
- (char**)0, (char*)0, (int*)0 };
-
-static KmParameter _DZDOC_BROWSE_REWIND_FZ_CHLUN = { "CHLUN", 5,
- "Unit number", " ", (char*)0, 20, 0, (char**)0, 0, (char**)0, (KmParFlag)0,
- KmTYPE_CHAR, (void*)0 };
-static KmParameter *_DZDOC_BROWSE_REWIND_FZ_parameters[] = {
- &_DZDOC_BROWSE_REWIND_FZ_CHLUN };
-static char *_DZDOC_BROWSE_REWIND_FZ_guidance[] = { "Rewind FZ file" };
-static KmCommand _DZDOC_BROWSE_REWIND_FZ = { &_DZDOC_BROWSE_FZ_LOG_LEVEL,
- "/DZDOC/BROWSE/REWIND_FZ", "REWIND_FZ", 0, 2, 1, 1,
- _DZDOC_BROWSE_REWIND_FZ_parameters, 0, 0, dzdrwf_, (IntFunc*)0,
- (SUBROUTINE*)0, (IntFunc*)0, 1, _DZDOC_BROWSE_REWIND_FZ_guidance, 0,
- (char**)0, (char*)0, (int*)0 };
-
-static KmParameter _DZDOC_BROWSE_CLOSE_FZ_CHLUN = { "CHLUN", 5, "Unit number",
- " ", (char*)0, 20, 0, (char**)0, 0, (char**)0, (KmParFlag)0, KmTYPE_CHAR,
- (void*)0 };
-static KmParameter *_DZDOC_BROWSE_CLOSE_FZ_parameters[] = {
- &_DZDOC_BROWSE_CLOSE_FZ_CHLUN };
-static char *_DZDOC_BROWSE_CLOSE_FZ_guidance[] = { "Close FZ file" };
-static KmCommand _DZDOC_BROWSE_CLOSE_FZ = { &_DZDOC_BROWSE_REWIND_FZ,
- "/DZDOC/BROWSE/CLOSE_FZ", "CLOSE_FZ", 0, 2, 1, 1,
- _DZDOC_BROWSE_CLOSE_FZ_parameters, 0, 0, dzdcfz_, (IntFunc*)0,
- (SUBROUTINE*)0, (IntFunc*)0, 1, _DZDOC_BROWSE_CLOSE_FZ_guidance, 0,
- (char**)0, (char*)0, (int*)0 };
-
-static KmParInt _DZDOC_BROWSE_PUT_EVENT_LUNFOU_type = { (char*)0, (char*)0,
- (char*)0, (char*)0, 0 };
-static KmParameter _DZDOC_BROWSE_PUT_EVENT_LUNFOU = { "LUNFOU", 6,
- "Unit number", "0", (char*)0, 8, 0, (char**)0, 0, (char**)0, (KmParFlag)0,
- KmTYPE_INT, &_DZDOC_BROWSE_PUT_EVENT_LUNFOU_type };
-static KmParameter _DZDOC_BROWSE_PUT_EVENT_CHBANK = { "CHBANK", 6,
- "Bank Hol_Id", " ", (char*)0, 20, 0, (char**)0, 0, (char**)0, (KmParFlag)0,
- KmTYPE_CHAR, (void*)0 };
-static KmParOption _DZDOC_BROWSE_PUT_EVENT_CHOPT_type = { (char**)0, (int*)0,
- (int*)0 };
-static KmParameter _DZDOC_BROWSE_PUT_EVENT_CHOPT = { "CHOPT", 5,
- "Option for FZOUT", " ", (char*)0, 20, 0, (char**)0, 0, (char**)0,
- (KmParFlag)0, KmTYPE_OPTION, &_DZDOC_BROWSE_PUT_EVENT_CHOPT_type };
-static KmParameter _DZDOC_BROWSE_PUT_EVENT_CHEAD = { "CHEAD", 5,
- "Write user header", "Yes", (char*)0, 20, 0, (char**)0, 0, (char**)0,
- (KmParFlag)0, KmTYPE_CHAR, (void*)0 };
-static KmParameter *_DZDOC_BROWSE_PUT_EVENT_parameters[] = {
- &_DZDOC_BROWSE_PUT_EVENT_LUNFOU, &_DZDOC_BROWSE_PUT_EVENT_CHBANK,
- &_DZDOC_BROWSE_PUT_EVENT_CHOPT, &_DZDOC_BROWSE_PUT_EVENT_CHEAD };
-static char *_DZDOC_BROWSE_PUT_EVENT_guidance[] = {
- "Write bank tree to FZFILE read by GET_EVENT, if CHBANK /= ' '",
- "the hollerith Id of the top bank is checked first" };
-static KmCommand _DZDOC_BROWSE_PUT_EVENT = { &_DZDOC_BROWSE_CLOSE_FZ,
- "/DZDOC/BROWSE/PUT_EVENT", "PUT_EVENT", 0, 2, 4, 1,
- _DZDOC_BROWSE_PUT_EVENT_parameters, 0, 0, dzdpev_, (IntFunc*)0,
- (SUBROUTINE*)0, (IntFunc*)0, 2, _DZDOC_BROWSE_PUT_EVENT_guidance, 0,
- (char**)0, (char*)0, (int*)0 };
-
-static KmParameter _DZDOC_BROWSE_CLOSE_RZ_CHPATH = { "CHPATH", 6,
- "Rz directory", " ", (char*)0, 20, 0, (char**)0, 0, (char**)0, (KmParFlag)0,
- KmTYPE_CHAR, (void*)0 };
-static KmParameter *_DZDOC_BROWSE_CLOSE_RZ_parameters[] = {
- &_DZDOC_BROWSE_CLOSE_RZ_CHPATH };
-static char *_DZDOC_BROWSE_CLOSE_RZ_guidance[] = { "Close RZ file" };
-static KmCommand _DZDOC_BROWSE_CLOSE_RZ = { &_DZDOC_BROWSE_PUT_EVENT,
- "/DZDOC/BROWSE/CLOSE_RZ", "CLOSE_RZ", 0, 2, 1, 1,
- _DZDOC_BROWSE_CLOSE_RZ_parameters, 0, 0, dzdcrz_, (IntFunc*)0,
- (SUBROUTINE*)0, (IntFunc*)0, 1, _DZDOC_BROWSE_CLOSE_RZ_guidance, 0,
- (char**)0, (char*)0, (int*)0 };
-
-static KmParameter _DZDOC_BROWSE_FILT_BANKS_CIDMSK = { "CIDMSK", 6,
- "Mask Hol Id", " ", (char*)0, 20, 0, (char**)0, 0, (char**)0,
- (KmParFlag)0, KmTYPE_CHAR, (void*)0 };
-static KmParInt _DZDOC_BROWSE_FILT_BANKS_NIDMSK_type = { (char*)0,
- (char*)0, (char*)0, (char*)0, 0 };
-static KmParameter _DZDOC_BROWSE_FILT_BANKS_NIDMSK = { "NIDMSK", 6,
- "Numerical Id", "0", (char*)0, 8, 0, (char**)0, 0, (char**)0, (KmParFlag)0,
- KmTYPE_INT, &_DZDOC_BROWSE_FILT_BANKS_NIDMSK_type };
-static KmParameter *_DZDOC_BROWSE_FILT_BANKS_parameters[] = {
- &_DZDOC_BROWSE_FILT_BANKS_CIDMSK, &_DZDOC_BROWSE_FILT_BANKS_NIDMSK };
-static char *_DZDOC_BROWSE_FILT_BANKS_guidance[] = {
- "Set a mask on hollerith and/or numerical Id of a bank.",
- "The wildcard character is * or blank (i.e. CIDMSK = ' '", "selects all).",
- "Example: C**S , display all banks with Id starting with C",
- "and ending with S.",
- "If NIDMSK /= 0 display only banks with this numerical Id." };
-static KmCommand _DZDOC_BROWSE_FILT_BANKS = { &_DZDOC_BROWSE_CLOSE_RZ,
- "/DZDOC/BROWSE/FILT_BANKS", "FILT_BANKS", 0, 2, 2, 2,
- _DZDOC_BROWSE_FILT_BANKS_parameters, 0, 0, dzdsfb_, (IntFunc*)0,
- (SUBROUTINE*)0, (IntFunc*)0, 6, _DZDOC_BROWSE_FILT_BANKS_guidance, 0,
- (char**)0, (char*)0, (int*)0 };
-
-static KmParInt _DZDOC_BROWSE_FILT_KEY_IKEYNR_type = { (char*)0, (char*)0,
- (char*)0, (char*)0, 0 };
-static KmParameter _DZDOC_BROWSE_FILT_KEY_IKEYNR = { "IKEYNR", 6,
- "Keyword number", "1", (char*)0, 8, 0, (char**)0, 0, (char**)0, (KmParFlag)0,
- KmTYPE_INT, &_DZDOC_BROWSE_FILT_KEY_IKEYNR_type };
-static KmParInt _DZDOC_BROWSE_FILT_KEY_IVALUE_type = { (char*)0, (char*)0,
- (char*)0, (char*)0, 0 };
-static KmParameter _DZDOC_BROWSE_FILT_KEY_IVALUE = { "IVALUE", 6,
- "Integer value", "0", (char*)0, 8, 0, (char**)0, 0, (char**)0, (KmParFlag)0,
- KmTYPE_INT, &_DZDOC_BROWSE_FILT_KEY_IVALUE_type };
-static KmParameter _DZDOC_BROWSE_FILT_KEY_CVALUE = { "CVALUE", 6,
- "Char*4 (hollerith) value", " ", (char*)0, 20, 0, (char**)0, 0, (char**)0,
- (KmParFlag)0, KmTYPE_CHAR, (void*)0 };
-static char *_DZDOC_BROWSE_FILT_KEY_CHOPT_range[] = { "Int", "Char", "Reset" };
-static char *_DZDOC_BROWSE_FILT_KEY_CHOPT_text[] = { (char*)0, (char*)0,
- (char*)0 };
-static KmParOption _DZDOC_BROWSE_FILT_KEY_CHOPT_type = {
- _DZDOC_BROWSE_FILT_KEY_CHOPT_text, (int*)0, (int*)0 };
-static KmParameter _DZDOC_BROWSE_FILT_KEY_CHOPT = { "CHOPT", 5, "Option",
- "Int", (char*)0, 8, 3, _DZDOC_BROWSE_FILT_KEY_CHOPT_range, 3,
- _DZDOC_BROWSE_FILT_KEY_CHOPT_range, (KmParFlag)0, KmTYPE_OPTION,
- &_DZDOC_BROWSE_FILT_KEY_CHOPT_type };
-static char *_DZDOC_BROWSE_FILT_KEY_CHYENO_range[] = { "NO", "YES" };
-static KmParameter _DZDOC_BROWSE_FILT_KEY_CHYENO = { "CHYENO", 6,
- "List keys with Append opt", "NO", (char*)0, 8, 2,
- _DZDOC_BROWSE_FILT_KEY_CHYENO_range, 2, _DZDOC_BROWSE_FILT_KEY_CHYENO_range,
- (KmParFlag)0, KmTYPE_CHAR, (void*)0 };
-static KmParameter *_DZDOC_BROWSE_FILT_KEY_parameters[] = {
- &_DZDOC_BROWSE_FILT_KEY_IKEYNR, &_DZDOC_BROWSE_FILT_KEY_IVALUE,
- &_DZDOC_BROWSE_FILT_KEY_CVALUE, &_DZDOC_BROWSE_FILT_KEY_CHOPT,
- &_DZDOC_BROWSE_FILT_KEY_CHYENO };
-static char *_DZDOC_BROWSE_FILT_KEY_guidance[] = {
- "Set a filter on keywords (max first 9),",
- "Keys created with the A option may be shown", "optionally." };
-static KmCommand _DZDOC_BROWSE_FILT_KEY = { &_DZDOC_BROWSE_FILT_BANKS,
- "/DZDOC/BROWSE/FILT_KEY", "FILT_KEY", 0, 2, 5, 5,
- _DZDOC_BROWSE_FILT_KEY_parameters, 0, 0, dzdsfk_, (IntFunc*)0,
- (SUBROUTINE*)0, (IntFunc*)0, 3, _DZDOC_BROWSE_FILT_KEY_guidance, 0,
- (char**)0, (char*)0, (int*)0 };
-
-static KmParameter _DZDOC_BROWSE_SH_RZLDIR_CHPATH = { "CHPATH", 6,
- "Rz directory", " ", (char*)0, 20, 0, (char**)0, 0, (char**)0, (KmParFlag)0,
- KmTYPE_CHAR, (void*)0 };
-static KmParameter *_DZDOC_BROWSE_SH_RZLDIR_parameters[] = {
- &_DZDOC_BROWSE_SH_RZLDIR_CHPATH };
-static char *_DZDOC_BROWSE_SH_RZLDIR_guidance[] = { "List directory (RZLDIR)"
- };
-static KmCommand _DZDOC_BROWSE_SH_RZLDIR = { &_DZDOC_BROWSE_FILT_KEY,
- "/DZDOC/BROWSE/SH_RZLDIR", "SH_RZLDIR", 0, 2, 1, 1,
- _DZDOC_BROWSE_SH_RZLDIR_parameters, 0, 0, dzdgky_, (IntFunc*)0,
- (SUBROUTINE*)0, (IntFunc*)0, 1, _DZDOC_BROWSE_SH_RZLDIR_guidance, 0,
- (char**)0, (char*)0, (int*)0 };
-
-static KmParameter _DZDOC_BROWSE_SH_KEY_DEF_CHPATH = { "CHPATH", 6,
- "Rz directory", " ", (char*)0, 20, 0, (char**)0, 0, (char**)0, (KmParFlag)0,
- KmTYPE_CHAR, (void*)0 };
-static KmParameter *_DZDOC_BROWSE_SH_KEY_DEF_parameters[] = {
- &_DZDOC_BROWSE_SH_KEY_DEF_CHPATH };
-static char *_DZDOC_BROWSE_SH_KEY_DEF_guidance[] = { "Show tags of keys" };
-static KmCommand _DZDOC_BROWSE_SH_KEY_DEF = { &_DZDOC_BROWSE_SH_RZLDIR,
- "/DZDOC/BROWSE/SH_KEY_DEF", "SH_KEY_DEF", 0, 2, 1, 1,
- _DZDOC_BROWSE_SH_KEY_DEF_parameters, 0, 0, dzdgky_, (IntFunc*)0,
- (SUBROUTINE*)0, (IntFunc*)0, 1, _DZDOC_BROWSE_SH_KEY_DEF_guidance, 0,
- (char**)0, (char*)0, (int*)0 };
-
-static KmParameter _DZDOC_BROWSE_SH_KEY_CHPATH = { "CHPATH", 6,
- "Rz directory", " ", (char*)0, 20, 0, (char**)0, 0, (char**)0, (KmParFlag)0,
- KmTYPE_CHAR, (void*)0 };
-static KmParameter _DZDOC_BROWSE_SH_KEY_CHKNUM = { "CHKNUM", 6,
- "Key sequential num", " ", (char*)0, 20, 0, (char**)0, 0, (char**)0,
- (KmParFlag)0, KmTYPE_CHAR, (void*)0 };
-static KmParameter *_DZDOC_BROWSE_SH_KEY_parameters[] = {
- &_DZDOC_BROWSE_SH_KEY_CHPATH, &_DZDOC_BROWSE_SH_KEY_CHKNUM };
-static char *_DZDOC_BROWSE_SH_KEY_guidance[] = { "Show key words" };
-static KmCommand _DZDOC_BROWSE_SH_KEY = { &_DZDOC_BROWSE_SH_KEY_DEF,
- "/DZDOC/BROWSE/SH_KEY", "SH_KEY", 0, 2, 2, 2,
- _DZDOC_BROWSE_SH_KEY_parameters, 0, 0, dzdgky_, (IntFunc*)0, (SUBROUTINE*)0,
- (IntFunc*)0, 1, _DZDOC_BROWSE_SH_KEY_guidance, 0, (char**)0, (char*)0,
- (int*)0 };
-
-static KmParameter _DZDOC_BROWSE_GET_KEY_CHPATH = { "CHPATH", 6,
- "Rz directory", " ", (char*)0, 20, 0, (char**)0, 0, (char**)0, (KmParFlag)0,
- KmTYPE_CHAR, (void*)0 };
-static KmParameter _DZDOC_BROWSE_GET_KEY_CHKNUM = { "CHKNUM", 6,
- "Key sequential num", " ", (char*)0, 20, 0, (char**)0, 0, (char**)0,
- (KmParFlag)0, KmTYPE_CHAR, (void*)0 };
-static KmParameter *_DZDOC_BROWSE_GET_KEY_parameters[] = {
- &_DZDOC_BROWSE_GET_KEY_CHPATH, &_DZDOC_BROWSE_GET_KEY_CHKNUM };
-static char *_DZDOC_BROWSE_GET_KEY_guidance[] = {
- "Read d/s of a RZ key into memory" };
-static KmCommand _DZDOC_BROWSE_GET_KEY = { &_DZDOC_BROWSE_SH_KEY,
- "/DZDOC/BROWSE/GET_KEY", "GET_KEY", 0, 2, 2, 2,
- _DZDOC_BROWSE_GET_KEY_parameters, 0, 0, dzdgky_, (IntFunc*)0, (SUBROUTINE*)0,
- (IntFunc*)0, 1, _DZDOC_BROWSE_GET_KEY_guidance, 0, (char**)0, (char*)0,
- (int*)0 };
-
-static KmParameter _DZDOC_BROWSE_SHOW_RZS_CHPATH = { "CHPATH", 6,
- "Rz directory", " ", (char*)0, 20, 0, (char**)0, 0, (char**)0, (KmParFlag)0,
- KmTYPE_CHAR, (void*)0 };
-static KmParameter *_DZDOC_BROWSE_SHOW_RZS_parameters[] = {
- &_DZDOC_BROWSE_SHOW_RZS_CHPATH };
-static char *_DZDOC_BROWSE_SHOW_RZS_guidance[] = { "Show status of a RZ file"
- };
-static KmCommand _DZDOC_BROWSE_SHOW_RZS = { &_DZDOC_BROWSE_GET_KEY,
- "/DZDOC/BROWSE/SHOW_RZS", "SHOW_RZS", 0, 2, 1, 1,
- _DZDOC_BROWSE_SHOW_RZS_parameters, 0, 0, dzdsrs_, (IntFunc*)0,
- (SUBROUTINE*)0, (IntFunc*)0, 1, _DZDOC_BROWSE_SHOW_RZS_guidance, 0,
- (char**)0, (char*)0, (int*)0 };
-
-static KmParInt _DZDOC_BROWSE_PT_VECT_IDBANK_type = { (char*)0, (char*)0,
- (char*)0, (char*)0, 0 };
-static KmParameter _DZDOC_BROWSE_PT_VECT_IDBANK = { "IDBANK", 6,
- "Int Bank Id (DONT TOUCH)", "0", (char*)0, 8, 0, (char**)0, 0, (char**)0,
- (KmParFlag)0, KmTYPE_INT, &_DZDOC_BROWSE_PT_VECT_IDBANK_type };
-static KmParInt _DZDOC_BROWSE_PT_VECT_IDHIST_type = { (char*)0, (char*)0,
- (char*)0, (char*)0, 0 };
-static KmParameter _DZDOC_BROWSE_PT_VECT_IDHIST = { "IDHIST", 6,
- "Histogram Id", "12345", (char*)0, 8, 0, (char**)0, 0, (char**)0,
- (KmParFlag)0, KmTYPE_INT, &_DZDOC_BROWSE_PT_VECT_IDHIST_type };
-static KmParameter _DZDOC_BROWSE_PT_VECT_CHVECT = { "CHVECT", 6,
- "Vector Name", " ", (char*)0, 20, 0, (char**)0, 0, (char**)0, (KmParFlag)0,
- KmTYPE_CHAR, (void*)0 };
-static KmParInt _DZDOC_BROWSE_PT_VECT_IFWORD_type = { (char*)0, (char*)0,
- (char*)0, (char*)0, 0 };
-static KmParameter _DZDOC_BROWSE_PT_VECT_IFWORD = { "IFWORD", 6, "First word",
- "0", (char*)0, 8, 0, (char**)0, 0, (char**)0, (KmParFlag)0, KmTYPE_INT,
- &_DZDOC_BROWSE_PT_VECT_IFWORD_type };
-static KmParInt _DZDOC_BROWSE_PT_VECT_ILWORD_type = { (char*)0, (char*)0,
- (char*)0, (char*)0, 0 };
-static KmParameter _DZDOC_BROWSE_PT_VECT_ILWORD = { "ILWORD", 6, "Last word",
- "0", (char*)0, 8, 0, (char**)0, 0, (char**)0, (KmParFlag)0, KmTYPE_INT,
- &_DZDOC_BROWSE_PT_VECT_ILWORD_type };
-static char *_DZDOC_BROWSE_PT_VECT_CHOPT_range[] = { "DRAW", "PLOT", " " };
-static char *_DZDOC_BROWSE_PT_VECT_CHOPT_text[] = { (char*)0, (char*)0,
- (char*)0 };
-static KmParOption _DZDOC_BROWSE_PT_VECT_CHOPT_type = {
- _DZDOC_BROWSE_PT_VECT_CHOPT_text, (int*)0, (int*)0 };
-static KmParameter _DZDOC_BROWSE_PT_VECT_CHOPT = { "CHOPT", 5, "Option",
- "DRAW", (char*)0, 8, 3, _DZDOC_BROWSE_PT_VECT_CHOPT_range, 3,
- _DZDOC_BROWSE_PT_VECT_CHOPT_range, (KmParFlag)0, KmTYPE_OPTION,
- &_DZDOC_BROWSE_PT_VECT_CHOPT_type };
-static KmParameter *_DZDOC_BROWSE_PT_VECT_parameters[] = {
- &_DZDOC_BROWSE_PT_VECT_IDBANK, &_DZDOC_BROWSE_PT_VECT_IDHIST,
- &_DZDOC_BROWSE_PT_VECT_CHVECT, &_DZDOC_BROWSE_PT_VECT_IFWORD,
- &_DZDOC_BROWSE_PT_VECT_ILWORD, &_DZDOC_BROWSE_PT_VECT_CHOPT };
-static char *_DZDOC_BROWSE_PT_VECT_guidance[] = {
- "Put bank contents into a vector,",
- "If CHVECT is blank name is taken from hollerith Id.",
- "If IFWORD and ILWORD are 0 all data words are taken.",
- "With option PLOT the values are filled in a histogram",
- "which is then plotted (see VECTOR/PLOT), DRAW interprets",
- "the data words as histogram contents (VECTOR/DRAW)." };
-static KmCommand _DZDOC_BROWSE_PT_VECT = { &_DZDOC_BROWSE_SHOW_RZS,
- "/DZDOC/BROWSE/PT_VECT", "PT_VECT", 0, 2, 6, 6,
- _DZDOC_BROWSE_PT_VECT_parameters, 0, 0, dzdspi_, (IntFunc*)0, (SUBROUTINE*)0,
- (IntFunc*)0, 6, _DZDOC_BROWSE_PT_VECT_guidance, 0, (char**)0, (char*)0,
- (int*)0 };
-
-static KmParInt _DZDOC_BROWSE_SH_MODIFY_IDBANK_type = { (char*)0, (char*)0,
- (char*)0, (char*)0, 0 };
-static KmParameter _DZDOC_BROWSE_SH_MODIFY_IDBANK = { "IDBANK", 6,
- "Int Bank Id (DONT TOUCH)", "0", (char*)0, 8, 0, (char**)0, 0, (char**)0,
- (KmParFlag)0, KmTYPE_INT, &_DZDOC_BROWSE_SH_MODIFY_IDBANK_type };
-static KmParInt _DZDOC_BROWSE_SH_MODIFY_IFWORD_type = { (char*)0, (char*)0,
- (char*)0, (char*)0, 0 };
-static KmParameter _DZDOC_BROWSE_SH_MODIFY_IFWORD = { "IFWORD", 6,
- "First word", " ", (char*)0, 8, 0, (char**)0, 0, (char**)0, (KmParFlag)0,
- KmTYPE_INT, &_DZDOC_BROWSE_SH_MODIFY_IFWORD_type };
-static KmParInt _DZDOC_BROWSE_SH_MODIFY_ILWORD_type = { (char*)0, (char*)0,
- (char*)0, (char*)0, 0 };
-static KmParameter _DZDOC_BROWSE_SH_MODIFY_ILWORD = { "ILWORD", 6,
- "Last word", " ", (char*)0, 8, 0, (char**)0, 0, (char**)0, (KmParFlag)0,
- KmTYPE_INT, &_DZDOC_BROWSE_SH_MODIFY_ILWORD_type };
-static KmParameter _DZDOC_BROWSE_SH_MODIFY_IVALUE = { "IVALUE", 6,
- "Integer value", " ", (char*)0, 20, 0, (char**)0, 0, (char**)0, (KmParFlag)0,
- KmTYPE_CHAR, (void*)0 };
-static KmParReal _DZDOC_BROWSE_SH_MODIFY_RVALUE_type = { (char*)0, (char*)0,
- (char*)0, (char*)0, 0 };
-static KmParameter _DZDOC_BROWSE_SH_MODIFY_RVALUE = { "RVALUE", 6,
- "Real value", "0.", (char*)0, 12, 0, (char**)0, 0, (char**)0, (KmParFlag)0,
- KmTYPE_REAL, &_DZDOC_BROWSE_SH_MODIFY_RVALUE_type };
-static KmParameter _DZDOC_BROWSE_SH_MODIFY_CVALUE = { "CVALUE", 6,
- "Char*4 value", " ", (char*)0, 20, 0, (char**)0, 0, (char**)0, (KmParFlag)0,
- KmTYPE_CHAR, (void*)0 };
-static KmParameter *_DZDOC_BROWSE_SH_MODIFY_parameters[] = {
- &_DZDOC_BROWSE_SH_MODIFY_IDBANK, &_DZDOC_BROWSE_SH_MODIFY_IFWORD,
- &_DZDOC_BROWSE_SH_MODIFY_ILWORD, &_DZDOC_BROWSE_SH_MODIFY_IVALUE,
- &_DZDOC_BROWSE_SH_MODIFY_RVALUE, &_DZDOC_BROWSE_SH_MODIFY_CVALUE };
-static char *_DZDOC_BROWSE_SH_MODIFY_guidance[] = {
- "Modify data words of bank. Data words IFWORD -",
- "ILWORD will be filled with IVALUE, RVALUE or CVALUE",
- "depending on the type given in the IO-Char.",
- "If more than 1 word are modified the type of the", "first taken.",
- "The integer value is interpreted as hexadecimal if",
- "preceeded by $ or 16x.", "If ILWORD=0 its set to IFWORD.", "HINT+WARNING:",
- "If the dataword offset is <=0 you can modify system words",
- "on your own risk." };
-static KmCommand _DZDOC_BROWSE_SH_MODIFY = { &_DZDOC_BROWSE_PT_VECT,
- "/DZDOC/BROWSE/SH_MODIFY", "SH_MODIFY", 0, 2, 6, 6,
- _DZDOC_BROWSE_SH_MODIFY_parameters, 0, 0, dzdspi_, (IntFunc*)0,
- (SUBROUTINE*)0, (IntFunc*)0, 11, _DZDOC_BROWSE_SH_MODIFY_guidance, 0,
- (char**)0, (char*)0, (int*)0 };
-
-static KmParInt _DZDOC_BROWSE_SH_DROP_IDBANK_type = { (char*)0, (char*)0,
- (char*)0, (char*)0, 0 };
-static KmParameter _DZDOC_BROWSE_SH_DROP_IDBANK = { "IDBANK", 6,
- "Int Bank Id (DONT TOUCH)", "0", (char*)0, 8, 0, (char**)0, 0, (char**)0,
- (KmParFlag)0, KmTYPE_INT, &_DZDOC_BROWSE_SH_DROP_IDBANK_type };
-static KmParOption _DZDOC_BROWSE_SH_DROP_CHOPT_type = { (char**)0, (int*)0,
- (int*)0 };
-static KmParameter _DZDOC_BROWSE_SH_DROP_CHOPT = { "CHOPT", 5,
- "Option for MZDROP", " ", (char*)0, 20, 0, (char**)0, 0, (char**)0,
- (KmParFlag)0, KmTYPE_OPTION, &_DZDOC_BROWSE_SH_DROP_CHOPT_type };
-static KmParameter *_DZDOC_BROWSE_SH_DROP_parameters[] = {
- &_DZDOC_BROWSE_SH_DROP_IDBANK, &_DZDOC_BROWSE_SH_DROP_CHOPT };
-static char *_DZDOC_BROWSE_SH_DROP_guidance[] = { "Drop bank (tree)" };
-static KmCommand _DZDOC_BROWSE_SH_DROP = { &_DZDOC_BROWSE_SH_MODIFY,
- "/DZDOC/BROWSE/SH_DROP", "SH_DROP", 0, 2, 2, 2,
- _DZDOC_BROWSE_SH_DROP_parameters, 0, 0, dzdspi_, (IntFunc*)0, (SUBROUTINE*)0,
- (IntFunc*)0, 1, _DZDOC_BROWSE_SH_DROP_guidance, 0, (char**)0, (char*)0,
- (int*)0 };
-
-static KmParInt _DZDOC_BROWSE_SH_FOUT_IDBANK_type = { (char*)0, (char*)0,
- (char*)0, (char*)0, 0 };
-static KmParameter _DZDOC_BROWSE_SH_FOUT_IDBANK = { "IDBANK", 6,
- "Int Bank Id (DONT TOUCH)", "0", (char*)0, 8, 0, (char**)0, 0, (char**)0,
- (KmParFlag)0, KmTYPE_INT, &_DZDOC_BROWSE_SH_FOUT_IDBANK_type };
-static KmParInt _DZDOC_BROWSE_SH_FOUT_LUNFOU_type = { (char*)0, (char*)0,
- (char*)0, (char*)0, 0 };
-static KmParameter _DZDOC_BROWSE_SH_FOUT_LUNFOU = { "LUNFOU", 6,
- "Unit number", "0", (char*)0, 8, 0, (char**)0, 0, (char**)0, (KmParFlag)0,
- KmTYPE_INT, &_DZDOC_BROWSE_SH_FOUT_LUNFOU_type };
-static KmParameter _DZDOC_BROWSE_SH_FOUT_CHBANK = { "CHBANK", 6, "Holl Id",
- " ", (char*)0, 20, 0, (char**)0, 0, (char**)0, (KmParFlag)0, KmTYPE_CHAR,
- (void*)0 };
-static KmParOption _DZDOC_BROWSE_SH_FOUT_CHOPT_type = { (char**)0, (int*)0,
- (int*)0 };
-static KmParameter _DZDOC_BROWSE_SH_FOUT_CHOPT = { "CHOPT", 5,
- "Option for FZOUT", " ", (char*)0, 20, 0, (char**)0, 0, (char**)0,
- (KmParFlag)0, KmTYPE_OPTION, &_DZDOC_BROWSE_SH_FOUT_CHOPT_type };
-static KmParameter _DZDOC_BROWSE_SH_FOUT_CHEAD = { "CHEAD", 5,
- "Write user header", "Yes", (char*)0, 20, 0, (char**)0, 0, (char**)0,
- (KmParFlag)0, KmTYPE_CHAR, (void*)0 };
-static KmParameter *_DZDOC_BROWSE_SH_FOUT_parameters[] = {
- &_DZDOC_BROWSE_SH_FOUT_IDBANK, &_DZDOC_BROWSE_SH_FOUT_LUNFOU,
- &_DZDOC_BROWSE_SH_FOUT_CHBANK, &_DZDOC_BROWSE_SH_FOUT_CHOPT,
- &_DZDOC_BROWSE_SH_FOUT_CHEAD };
-static char *_DZDOC_BROWSE_SH_FOUT_guidance[] = { "Write bank tree to FZFILE"
- };
-static KmCommand _DZDOC_BROWSE_SH_FOUT = { &_DZDOC_BROWSE_SH_DROP,
- "/DZDOC/BROWSE/SH_FOUT", "SH_FOUT", 0, 2, 5, 5,
- _DZDOC_BROWSE_SH_FOUT_parameters, 0, 0, dzdspi_, (IntFunc*)0, (SUBROUTINE*)0,
- (IntFunc*)0, 1, _DZDOC_BROWSE_SH_FOUT_guidance, 0, (char**)0, (char*)0,
- (int*)0 };
-
-static KmParInt _DZDOC_BROWSE_MARK_NT_IDBANK_type = { (char*)0, (char*)0,
- (char*)0, (char*)0, 0 };
-static KmParameter _DZDOC_BROWSE_MARK_NT_IDBANK = { "IDBANK", 6,
- "Int Bank Id (DONT TOUCH)", "0", (char*)0, 8, 0, (char**)0, 0, (char**)0,
- (KmParFlag)0, KmTYPE_INT, &_DZDOC_BROWSE_MARK_NT_IDBANK_type };
-static char *_DZDOC_BROWSE_MARK_NT_CHOPT_range[] = { "Single", "Array" };
-static char *_DZDOC_BROWSE_MARK_NT_CHOPT_text[] = { (char*)0, (char*)0 };
-static KmParOption _DZDOC_BROWSE_MARK_NT_CHOPT_type = {
- _DZDOC_BROWSE_MARK_NT_CHOPT_text, (int*)0, (int*)0 };
-static KmParameter _DZDOC_BROWSE_MARK_NT_CHOPT = { "CHOPT", 5,
- "Single variable or array", "Array", (char*)0, 8, 2,
- _DZDOC_BROWSE_MARK_NT_CHOPT_range, 2, _DZDOC_BROWSE_MARK_NT_CHOPT_range,
- (KmParFlag)0, KmTYPE_OPTION, &_DZDOC_BROWSE_MARK_NT_CHOPT_type };
-static KmParInt _DZDOC_BROWSE_MARK_NT_IWORDF_type = { (char*)0, (char*)0,
- (char*)0, (char*)0, 0 };
-static KmParameter _DZDOC_BROWSE_MARK_NT_IWORDF = { "IWORDF", 6,
- "First word number", "0", (char*)0, 8, 0, (char**)0, 0, (char**)0,
- (KmParFlag)0, KmTYPE_INT, &_DZDOC_BROWSE_MARK_NT_IWORDF_type };
-static KmParInt _DZDOC_BROWSE_MARK_NT_IWORDL_type = { (char*)0, (char*)0,
- (char*)0, (char*)0, 0 };
-static KmParameter _DZDOC_BROWSE_MARK_NT_IWORDL = { "IWORDL", 6,
- "Last word number", "0", (char*)0, 8, 0, (char**)0, 0, (char**)0,
- (KmParFlag)0, KmTYPE_INT, &_DZDOC_BROWSE_MARK_NT_IWORDL_type };
-static KmParameter _DZDOC_BROWSE_MARK_NT_CHNAME = { "CHNAME", 6,
- "Mnemonic (variable name)", " ", (char*)0, 20, 0, (char**)0, 0, (char**)0,
- (KmParFlag)0, KmTYPE_CHAR, (void*)0 };
-static KmParameter _DZDOC_BROWSE_MARK_NT_COPT = { "COPT", 4, "Option", " ",
- (char*)0, 20, 0, (char**)0, 0, (char**)0, (KmParFlag)0, KmTYPE_CHAR,
- (void*)0 };
-static KmParameter *_DZDOC_BROWSE_MARK_NT_parameters[] = {
- &_DZDOC_BROWSE_MARK_NT_IDBANK, &_DZDOC_BROWSE_MARK_NT_CHOPT,
- &_DZDOC_BROWSE_MARK_NT_IWORDF, &_DZDOC_BROWSE_MARK_NT_IWORDL,
- &_DZDOC_BROWSE_MARK_NT_CHNAME, &_DZDOC_BROWSE_MARK_NT_COPT };
-static char *_DZDOC_BROWSE_MARK_NT_guidance[] = {
- "Mark data word(s) for Ntuple. An explicit word number",
- "or range of words may be given, in this case CHNAME is",
- "only used as a tag.",
- "If blank its defaulted to: Bankid+IWORD (8 Characters)",
- "If IWORDF is 0, it is assumed that a bank doc is available,",
- "and CHNAME is the name of a variable in the doc.",
- "If used with the option \"array\" all values with this name",
- "in the bank will be filled (max. 100)",
- "CHBANK: internal bank numbering, dont touch",
- "CHOPT: Switch between single variables and arrays.",
- " 'single' mark a single (scalar) variable",
- " 'array' put each occurence of a variable in bank",
- " into an array and call HFNT once per event", "IWORDF:",
- " if > 0 data", " -1 length of bank (not yet implemented)",
- " -2 number of links (nyi)",
- " -5 numerical Id of bank (nyi)",
- " -10 the link offset (Jbias of bank in Upbank) (nyi)", "IWORDL:",
- " > IWORDF last word to be marked (only with \"array\")",
- "Option: 'L' loop on all other links (Jbias) to this bank",
- " in Upbank or on all next banks if it is part",
- " of a linear structure (nyi)" };
-static KmCommand _DZDOC_BROWSE_MARK_NT = { &_DZDOC_BROWSE_SH_FOUT,
- "/DZDOC/BROWSE/MARK_NT", "MARK_NT", 0, 2, 6, 6,
- _DZDOC_BROWSE_MARK_NT_parameters, 0, 0, dzdspi_, (IntFunc*)0, (SUBROUTINE*)0,
- (IntFunc*)0, 24, _DZDOC_BROWSE_MARK_NT_guidance, 0, (char**)0, (char*)0,
- (int*)0 };
-
-static char *_DZDOC_BROWSE_guidance[] = {
- "The commands in this menu are accessible only via the browser",
- "since they need as argument an identification given internally",
- "by the callback routine." };
-static KmMenu _DZDOC_BROWSE = { (KmMenu*)0, (KmMenu*)0, "/DZDOC/BROWSE",
- "BROWSE", 2, &_DZDOC_BROWSE_MARK_NT, 3, _DZDOC_BROWSE_guidance };
-static KmMenu _DZDOC_Bankdisplay = { &_DZDOC_BROWSE, (KmMenu*)0,
- "/DZDOC/Bankdisplay", "Bankdisplay", 2, &_DZDOC_Bankdisplay_TREE, 0,
- (char**)0 };
-static KmMenu _DZDOC_File = { &_DZDOC_Bankdisplay, (KmMenu*)0, "/DZDOC/File",
- "File", 2, &_DZDOC_File_OPEN_DOC, 0, (char**)0 };
-static char *_DZDOC_Set_par_guidance[] = { "Set various parameters:",
- "Enable/disable workstation activation.",
- "Select the two keys and the cycle to be shown by the browser.",
- "DZDOC may optionally use a different window (workstation IWKID).",
- "for its output.", "CDZOPT Option when calling DZSHOW" };
-static KmMenu _DZDOC_Set_par = { &_DZDOC_File, (KmMenu*)0, "/DZDOC/Set_par",
- "Set_par", 2, &_DZDOC_Set_par_BANKCOLOR, 6, _DZDOC_Set_par_guidance };
-static char *_DZDOC_HELP_ZEBRA_guidance[] = {
- ". *** The Zebra-Browser ***", "",
- "Selecting \"Zebra\" from the KUIP object browser will display",
- "an icon for each Zebra store, for each open Fzfile and each",
- "open Rzfile. A store is named with its number plus the name",
- "given to MZSTOR with slashes (/) replaced by underscores (_).",
- "A Fzfile is named with the logical unit number, a Rzfile with",
- "the top directory given to it by RZFILE.", "", "",
- "Double click in the store symbol will display icons for the",
- "divisions in this store, clicking the divisions will display",
- "the banks im this divisions, clicking a bank will show the",
- "tree for this bank in the graphics window (see DZDISP).",
- "Popup menus (use right mouse key) are provided which allow to",
- "print information on stores, divisions and banks (DZSTOR,",
- "DZSNAP, DZSURV). The layout of banks in divisions can be",
- "shown graphically by the command 'Display_division'.", "", "",
- "Double click in the FZfile symbol will read the next data",
- "structure from the file into division 1 of store 0 and",
- "display the bank tree for the top bank in the graphics",
- "window. A popup menu allows to read the User header only,",
- "to display information (see FZINFO) on the file or close the",
- "file. Trying to read beyond End of Data will force the",
- "file to be rewound to avoid exit via ZFATAL.", "", "",
- "Double click in the RZfile symbol will display directories",
- "and/or keys contained in the file. Double click on a key",
- "symbol will read the data structure for this key into",
- "division 1 of store 0 and display the bank tree for the",
- "top bank in ths graphics window. Show status (RZSTAT) and",
- "close are accessible by a popup menu.", "",
- ". **** Embedded DZDOC ****", "",
- "The Zebra browser popup menus give access to parts of the",
- "DZDOC package. DZDOC allows to describe Zebra banks (linkage",
- "and data words) with a defined format.",
- "It puts this description into a Rzfile for direct access",
- "and makes it available to DZDISP which can then display the",
- "data words of a bank together with their meaning.", "", "",
- "Opening, updating and using of the Rzfile can be done in the",
- "same session. The file is opened via the menu item",
- "'Open_bank_doc_Rzfile', one has to choose if it should be",
- "opened 'New' for 'Update' or 'Readonly'.",
- "Information can put into the file using the item",
- "'Put_doc_into_Rzfile', for more information see help for this", "command.",
- "", "An alternative way is to use the item 'Edit_documentation' in",
- "the popup menu associated with each bank (in the browser or",
- "graphics window). In this case the editor is called with the",
- "documentation contained in an (open) Rzfile if it is there.",
- "If not a template with the documentation generated from the",
- "selected bank in memory is presented in the editor.",
- "If the file gets modified the documentation will be put into",
- "the Rzfile if it is open for update. Note that the file",
- "naming convention uses the hollerith Id of a bank",
- "concatinated with the Id of its up-bank ('none' for a top",
- "bank) with the extension '.dzdoc'.", "", "",
- ". **** Vector/histogram filling ****", "",
- "The data words of a bank may be copied into a KUIP vector which",
- "is optionally directly plotted or drawn (VECTOR/PLOT or DRAW).",
- "This is done from the popup menu in the graphics or Icon",
- "display of the ZEBRA banks. The vectors may then further be",
- "manipulated by all the commands of the vector package.",
- "This only works within paw++ where the VECTOR facilities are", "linked in.",
- "", "", ". **** Ntuple filling ****", "",
- "A simple facility is provided to mark words in a data structure",
- "read from an FZ-file for filling into a Ntuple. The entries may",
- "be scalar variables (i.e. one value of a bank) or arrays.",
- "Marking of data words may be done explicitly giving the absolute",
- "offset in a bank (a range in case of an array) or symbolically",
- "if a (correct) documentation for the bank is available. In the",
- "second case all values of a variable (max 100) in a bank are",
- "extracted and filled into the Ntuple.", "",
- "The marking is done from the popup menu associated to banks in",
- "the graphics display, the system finds and remembers the links",
- "to the bank.", "",
- "Filling is controlled from the popup menu for the FZ-file icon.",
- "For further details consult the Help items for these commands." };
-static KmCommand _DZDOC_HELP_ZEBRA = { (KmCommand*)0, "/DZDOC/HELP_ZEBRA",
- "HELP_ZEBRA", 0, 1, 0, 0, (KmParameter**)0, 0, 0, (SUBROUTINE*)0,
- (IntFunc*)0, (SUBROUTINE*)0, (IntFunc*)0, 95, _DZDOC_HELP_ZEBRA_guidance, 0,
- (char**)0, (char*)0, (int*)0 };
-
-static KmMenu _DZDOC = { (KmMenu*)0, &_DZDOC_Set_par, "/DZDOC", "DZDOC", 1,
- &_DZDOC_HELP_ZEBRA, 0, (char**)0 };
-static BrAction brclass_1_root_5 = { (BrAction*)0, (BrActFlag)16,
- "Display bank tree", (char*)0, (char*)0, "DZDOC/BANKDISPLAY/TREE",
- (SUBROUTINE*)0, (IntFunc*)0, BRACT_ROOT, (BrClass*)0 };
-static BrAction brclass_1_root_4 = { &brclass_1_root_5, (BrActFlag)16,
- "Put doc into Rzfile", (char*)0, (char*)0, "DZDOC/FILE/EDIT_DOC",
- (SUBROUTINE*)0, (IntFunc*)0, BRACT_ROOT, (BrClass*)0 };
-static BrAction brclass_1_root_3 = { &brclass_1_root_4, (BrActFlag)16,
- "Add doc directory", (char*)0, (char*)0, "DZDOC/FILE/DIR_ADD",
- (SUBROUTINE*)0, (IntFunc*)0, BRACT_ROOT, (BrClass*)0 };
-static BrAction brclass_1_root_2 = { &brclass_1_root_3, (BrActFlag)16,
- "Open bank doc Rzfile", (char*)0, (char*)0, "DZDOC/FILE/OPEN_DOC",
- (SUBROUTINE*)0, (IntFunc*)0, BRACT_ROOT, (BrClass*)0 };
-static BrAction brclass_1_root_1 = { &brclass_1_root_2, (BrActFlag)16, "List",
- (char*)0, (char*)0, (char*)0, (SUBROUTINE*)0, (IntFunc*)0, BRACT_ROOT,
- (BrClass*)0 };
-static BrClass brclass_1 = { (BrClass*)0, "Zebra", " ", dzdzeb_,
- (pCharFunc*)0, (SUBROUTINE*)0, (pCharFunc*)0, &brclass_1_root_1, (BrAction*)0
- };
-
-static BrAction kmclass_7_cont_8 = { (BrAction*)0, (BrActFlag)16,
- "Close Fzfile", (char*)0, (char*)0, "BROWSE/CLOSE_FZ [that]",
- (SUBROUTINE*)0, (IntFunc*)0, BRACT_CONT, (BrClass*)0 };
-static BrAction kmclass_7_cont_7 = { &kmclass_7_cont_8, (BrActFlag)16,
- "Rewind Fzfile", (char*)0, (char*)0, "BROWSE/REWIND_FZ [that]",
- (SUBROUTINE*)0, (IntFunc*)0, BRACT_CONT, (BrClass*)0 };
-static BrAction kmclass_7_cont_6 = { &kmclass_7_cont_7, (BrActFlag)16,
- "Set logging level", (char*)0, (char*)0, "BROWSE/FZ_LOG_LEVEL [that]",
- (SUBROUTINE*)0, (IntFunc*)0, BRACT_CONT, (BrClass*)0 };
-static BrAction kmclass_7_cont_5 = { &kmclass_7_cont_6, (BrActFlag)16,
- "Show Fzfile info", (char*)0, (char*)0, "BROWSE/SH_FZINFO [that]",
- (SUBROUTINE*)0, (IntFunc*)0, BRACT_CONT, (BrClass*)0 };
-static BrAction kmclass_7_cont_4 = { &kmclass_7_cont_5, (BrActFlag)16,
- "Fill Ntuple", (char*)0, (char*)0, "BROWSE/FILL_NTUPLE [that]",
- (SUBROUTINE*)0, (IntFunc*)0, BRACT_CONT, (BrClass*)0 };
-static BrAction kmclass_7_cont_3 = { &kmclass_7_cont_4, (BrActFlag)16,
- "Get the pending d/s ", (char*)0, (char*)0, "BROWSE/GET_PDS [that] D",
- (SUBROUTINE*)0, (IntFunc*)0, BRACT_CONT, (BrClass*)0 };
-static BrAction kmclass_7_cont_2 = { &kmclass_7_cont_3, (BrActFlag)16,
- "Get user header", (char*)0, (char*)0, "BROWSE/GET_HEAD [that] D",
- (SUBROUTINE*)0, (IntFunc*)0, BRACT_CONT, (BrClass*)0 };
-static BrAction kmclass_7_cont_1 = { &kmclass_7_cont_2, (BrActFlag)16,
- "Get event (head + d/s)", (char*)0, (char*)0, "BROWSE/GET_EVENT [that] D",
- (SUBROUTINE*)0, (IntFunc*)0, BRACT_CONT, (BrClass*)0 };
-static KmClass kmclass_7 = { (KmClass*)0, 0, "FZ", "Fzfiles", "fzfile",
- (KmIcon*)0, "sm_dir", (KmIcon*)0, (SUBROUTINE*)0, (IntFunc*)0,
- &kmclass_7_cont_1, (BrAction*)0, 0 };
-
-static BrAction kmclass_6_cont_4 = { (BrAction*)0, (BrActFlag)16,
- "Set filter on keys", (char*)0, (char*)0, "BROWSE/FILT_KEY", (SUBROUTINE*)0,
- (IntFunc*)0, BRACT_CONT, (BrClass*)0 };
-static BrAction kmclass_6_cont_3 = { &kmclass_6_cont_4, (BrActFlag)16,
- "Show key words", (char*)0, (char*)0, "BROWSE/SH_KEY [path] [that]",
- (SUBROUTINE*)0, (IntFunc*)0, BRACT_CONT, (BrClass*)0 };
-static BrAction kmclass_6_cont_2 = { &kmclass_6_cont_3, (BrActFlag)16,
- "Show key definition", (char*)0, (char*)0,
- "BROWSE/SH_KEY_DEF [path]/[this]", (SUBROUTINE*)0, (IntFunc*)0, BRACT_CONT,
- (BrClass*)0 };
-static BrAction kmclass_6_cont_1 = { &kmclass_6_cont_2, (BrActFlag)16,
- "Read key into memory", (char*)0, (char*)0, "BROWSE/GET_KEY [path] [that]",
- (SUBROUTINE*)0, (IntFunc*)0, BRACT_CONT, (BrClass*)0 };
-static KmClass kmclass_6 = { &kmclass_7, 0, "key", "Keys", "big_key",
- (KmIcon*)0, "sm_key", (KmIcon*)0, (SUBROUTINE*)0, (IntFunc*)0,
- &kmclass_6_cont_1, (BrAction*)0, 0 };
-
-static BrAction kmclass_5_cont_4 = { (BrAction*)0, (BrActFlag)16,
- "Set filter on keys", (char*)0, (char*)0, "BROWSE/FILT_KEY", (SUBROUTINE*)0,
- (IntFunc*)0, BRACT_CONT, (BrClass*)0 };
-static BrAction kmclass_5_cont_3 = { &kmclass_5_cont_4, (BrActFlag)16,
- "Show key definition", (char*)0, (char*)0,
- "BROWSE/SH_KEY_DEF [path]/[this]", (SUBROUTINE*)0, (IntFunc*)0, BRACT_CONT,
- (BrClass*)0 };
-static BrAction kmclass_5_cont_2 = { &kmclass_5_cont_3, (BrActFlag)16,
- "List directory (RZLDIR)", (char*)0, (char*)0,
- "BROWSE/SH_RZLDIR [path]/[this]", (SUBROUTINE*)0, (IntFunc*)0, BRACT_CONT,
- (BrClass*)0 };
-static BrAction kmclass_5_cont_1 = { &kmclass_5_cont_2, (BrActFlag)16, "List",
- (char*)0, (char*)0, (char*)0, (SUBROUTINE*)0, (IntFunc*)0, BRACT_CONT,
- (BrClass*)0 };
-static KmClass kmclass_5 = { &kmclass_6, 1, "rzdir", "Rz-directory", "rzdir",
- (KmIcon*)0, "sm_dir", (KmIcon*)0, (SUBROUTINE*)0, (IntFunc*)0,
- &kmclass_5_cont_1, (BrAction*)0, 0 };
-
-static BrAction kmclass_4_cont_3 = { (BrAction*)0, (BrActFlag)16,
- "Show status", (char*)0, (char*)0, "BROWSE/SHOW_RZS [this]", (SUBROUTINE*)0,
- (IntFunc*)0, BRACT_CONT, (BrClass*)0 };
-static BrAction kmclass_4_cont_2 = { &kmclass_4_cont_3, (BrActFlag)16,
- "Close Rzfile", (char*)0, (char*)0, "BROWSE/CLOSE_RZ [this]", (SUBROUTINE*)0,
- (IntFunc*)0, BRACT_CONT, (BrClass*)0 };
-static BrAction kmclass_4_cont_1 = { &kmclass_4_cont_2, (BrActFlag)16, "List",
- (char*)0, (char*)0, (char*)0, (SUBROUTINE*)0, (IntFunc*)0, BRACT_CONT,
- (BrClass*)0 };
-static KmClass kmclass_4 = { &kmclass_5, 1, "rzfil", "Rzfile", "rzfile",
- (KmIcon*)0, "sm_dir", (KmIcon*)0, (SUBROUTINE*)0, (IntFunc*)0,
- &kmclass_4_cont_1, (BrAction*)0, 0 };
-
-static BrAction kmclass_3_cont_11 = { (BrAction*)0, (BrActFlag)16,
- "Write fo FZ file", (char*)0, (char*)0, "BROWSE/SH_FOUT [that]",
- (SUBROUTINE*)0, (IntFunc*)0, BRACT_CONT, (BrClass*)0 };
-static BrAction kmclass_3_cont_10 = { &kmclass_3_cont_11, (BrActFlag)16,
- "Drop bank (tree)", (char*)0, (char*)0, "BROWSE/SH_DROP [that]",
- (SUBROUTINE*)0, (IntFunc*)0, BRACT_CONT, (BrClass*)0 };
-static BrAction kmclass_3_cont_9 = { &kmclass_3_cont_10, (BrActFlag)16,
- "Modify data words", (char*)0, (char*)0, "BROWSE/SH_MODIFY [that]",
- (SUBROUTINE*)0, (IntFunc*)0, BRACT_CONT, (BrClass*)0 };
-static BrAction kmclass_3_cont_8 = { &kmclass_3_cont_9, (BrActFlag)16,
- "Edit documention", (char*)0, (char*)0, " ", dzdb08_, (IntFunc*)0,
- BRACT_CONT, (BrClass*)0 };
-static BrAction kmclass_3_cont_7 = { &kmclass_3_cont_8, (BrActFlag)16,
- "Show documention", (char*)0, (char*)0, " ", dzdb07_, (IntFunc*)0,
- BRACT_CONT, (BrClass*)0 };
-static BrAction kmclass_3_cont_6 = { &kmclass_3_cont_7, (BrActFlag)16,
- "Put into vector", (char*)0, (char*)0, "BROWSE/PT_VECT [that]",
- (SUBROUTINE*)0, (IntFunc*)0, BRACT_CONT, (BrClass*)0 };
-static BrAction kmclass_3_cont_5 = { &kmclass_3_cont_6, (BrActFlag)16,
- "Survey bank tree", (char*)0, (char*)0, " ", dzdb06_, (IntFunc*)0,
- BRACT_CONT, (BrClass*)0 };
-static BrAction kmclass_3_cont_4 = { &kmclass_3_cont_5, (BrActFlag)16,
- "Show system words", (char*)0, (char*)0, " ", dzdb05_, (IntFunc*)0,
- BRACT_CONT, (BrClass*)0 };
-static BrAction kmclass_3_cont_3 = { &kmclass_3_cont_4, (BrActFlag)16,
- "DZ Show contents", (char*)0, (char*)0, " ", dzdb04_, (IntFunc*)0,
- BRACT_CONT, (BrClass*)0 };
-static BrAction kmclass_3_cont_2 = { &kmclass_3_cont_3, (BrActFlag)16,
- "Show cont documentd", (char*)0, (char*)0, " ", dzdb03_, (IntFunc*)0,
- BRACT_CONT, (BrClass*)0 };
-static BrAction kmclass_3_cont_1 = { &kmclass_3_cont_2, (BrActFlag)16,
- "Display bank tree", (char*)0, (char*)0, " ", dzdb01_, (IntFunc*)0,
- BRACT_CONT, (BrClass*)0 };
-static BrAction kmclass_3_graf_13 = { (BrAction*)0, (BrActFlag)16,
- "Write fo FZ file", (char*)0, (char*)0, "BROWSE/SH_FOUT -[this]",
- (SUBROUTINE*)0, (IntFunc*)0, BRACT_GRAF, (BrClass*)0 };
-static BrAction kmclass_3_graf_12 = { &kmclass_3_graf_13, (BrActFlag)16,
- "Drop bank (tree)", (char*)0, (char*)0, "BROWSE/SH_DROP -[this]",
- (SUBROUTINE*)0, (IntFunc*)0, BRACT_GRAF, (BrClass*)0 };
-static BrAction kmclass_3_graf_11 = { &kmclass_3_graf_12, (BrActFlag)16,
- "Modify data words", (char*)0, (char*)0, "BROWSE/SH_MODIFY -[this]",
- (SUBROUTINE*)0, (IntFunc*)0, BRACT_GRAF, (BrClass*)0 };
-static BrAction kmclass_3_graf_10 = { &kmclass_3_graf_11, (BrActFlag)16,
- "Mark for Ntuple", (char*)0, (char*)0, "BROWSE/MARK_NT -[this]",
- (SUBROUTINE*)0, (IntFunc*)0, BRACT_GRAF, (BrClass*)0 };
-static BrAction kmclass_3_graf_9 = { &kmclass_3_graf_10, (BrActFlag)16,
- "Edit documention", (char*)0, (char*)0, " ", dzdb18_, (IntFunc*)0,
- BRACT_GRAF, (BrClass*)0 };
-static BrAction kmclass_3_graf_8 = { &kmclass_3_graf_9, (BrActFlag)16,
- "Show documention", (char*)0, (char*)0, " ", dzdb17_, (IntFunc*)0,
- BRACT_GRAF, (BrClass*)0 };
-static BrAction kmclass_3_graf_7 = { &kmclass_3_graf_8, (BrActFlag)16,
- "Put into vector", (char*)0, (char*)0, "BROWSE/PT_VECT -[this]",
- (SUBROUTINE*)0, (IntFunc*)0, BRACT_GRAF, (BrClass*)0 };
-static BrAction kmclass_3_graf_6 = { &kmclass_3_graf_7, (BrActFlag)16,
- "Survey bank tree", (char*)0, (char*)0, " ", dzdb16_, (IntFunc*)0,
- BRACT_GRAF, (BrClass*)0 };
-static BrAction kmclass_3_graf_5 = { &kmclass_3_graf_6, (BrActFlag)16,
- "Show sytem words", (char*)0, (char*)0, " ", dzdb15_, (IntFunc*)0,
- BRACT_GRAF, (BrClass*)0 };
-static BrAction kmclass_3_graf_4 = { &kmclass_3_graf_5, (BrActFlag)16,
- "DZ Show contents", (char*)0, (char*)0, " ", dzdb14_, (IntFunc*)0,
- BRACT_GRAF, (BrClass*)0 };
-static BrAction kmclass_3_graf_3 = { &kmclass_3_graf_4, (BrActFlag)16,
- "Show cont documentd", (char*)0, (char*)0, " ", dzdb13_, (IntFunc*)0,
- BRACT_GRAF, (BrClass*)0 };
-static BrAction kmclass_3_graf_2 = { &kmclass_3_graf_3, (BrActFlag)16,
- "More down banks", (char*)0, (char*)0, " ", dzdb12_, (IntFunc*)0, BRACT_GRAF,
- (BrClass*)0 };
-static BrAction kmclass_3_graf_1 = { &kmclass_3_graf_2, (BrActFlag)16,
- "Display bank tree", (char*)0, (char*)0, " ", dzdb11_, (IntFunc*)0,
- BRACT_GRAF, (BrClass*)0 };
-static KmClass kmclass_3 = { &kmclass_4, 0, "BANK", "Banks", "big_bank",
- (KmIcon*)0, "sm_key", (KmIcon*)0, (SUBROUTINE*)0, (IntFunc*)0,
- &kmclass_3_cont_1, &kmclass_3_graf_1, 0 };
-
-static BrAction kmclass_2_cont_6 = { (BrAction*)0, (BrActFlag)16,
- "Set filter for banks", (char*)0, (char*)0, "BROWSE/FILT_BANKS",
- (SUBROUTINE*)0, (IntFunc*)0, BRACT_CONT, (BrClass*)0 };
-static BrAction kmclass_2_cont_5 = { &kmclass_2_cont_6, (BrActFlag)16,
- "Collect garbage", (char*)0, (char*)0, "BROWSE/COL_GARB [this]",
- (SUBROUTINE*)0, (IntFunc*)0, BRACT_CONT, (BrClass*)0 };
-static BrAction kmclass_2_cont_4 = { &kmclass_2_cont_5, (BrActFlag)16,
- "Verify division", (char*)0, (char*)0, "BROWSE/VERIFY_DIV [this]",
- (SUBROUTINE*)0, (IntFunc*)0, BRACT_CONT, (BrClass*)0 };
-static BrAction kmclass_2_cont_3 = { &kmclass_2_cont_4, (BrActFlag)16,
- "Snap division", (char*)0, (char*)0, "BROWSE/SNAP_DIV [this]",
- (SUBROUTINE*)0, (IntFunc*)0, BRACT_CONT, (BrClass*)0 };
-static BrAction kmclass_2_cont_2 = { &kmclass_2_cont_3, (BrActFlag)16,
- "Display division", (char*)0, (char*)0, "BROWSE/SHOW_DIV [this]",
- (SUBROUTINE*)0, (IntFunc*)0, BRACT_CONT, (BrClass*)0 };
-static BrAction kmclass_2_cont_1 = { &kmclass_2_cont_2, (BrActFlag)16, "List",
- (char*)0, (char*)0, (char*)0, (SUBROUTINE*)0, (IntFunc*)0, BRACT_CONT,
- (BrClass*)0 };
-static KmClass kmclass_2 = { &kmclass_3, 1, "DIV", "Divisions", "big_div",
- (KmIcon*)0, "sm_key", (KmIcon*)0, (SUBROUTINE*)0, (IntFunc*)0,
- &kmclass_2_cont_1, (BrAction*)0, 0 };
-
-static BrAction kmclass_1_cont_2 = { (BrAction*)0, (BrActFlag)16,
- "Show store DZSTOR", (char*)0, (char*)0, "SHOW_STORE [this]", (SUBROUTINE*)0,
- (IntFunc*)0, BRACT_CONT, (BrClass*)0 };
-static BrAction kmclass_1_cont_1 = { &kmclass_1_cont_2, (BrActFlag)16, "List",
- (char*)0, (char*)0, (char*)0, (SUBROUTINE*)0, (IntFunc*)0, BRACT_CONT,
- (BrClass*)0 };
-static KmClass kmclass_1 = { &kmclass_2, 1, "STORE", "Stores", "big_store",
- (KmIcon*)0, "sm_dir", (KmIcon*)0, (SUBROUTINE*)0, (IntFunc*)0,
- &kmclass_1_cont_1, (BrAction*)0, 0 };
-
-static char kmicons_13_bitmap[] = { 255, 255, 15, 1, 0, 8, 1, 0, 12, 81, 85,
- 13, 169, 170, 14, 1, 21, 12, 41, 128, 14, 81, 85, 13, 169, 170, 14, 81, 85,
- 13, 169, 170, 14, 81, 85, 13, 169, 170, 14, 81, 85, 13, 253, 255, 15, 255,
- 255, 15 };
-static KmIcon kmicons_13 = { (KmIcon*)0, "sm_dir", 20, 16, kmicons_13_bitmap,
- (KmPixmap)0, (KmPixmap)0 };
-
-static char kmicons_12_bitmap[] = { 255, 255, 15, 1, 0, 8, 1, 0, 12, 169, 170,
- 14, 241, 255, 13, 25, 0, 15, 241, 255, 13, 217, 182, 15, 177, 109, 13, 153,
- 36, 15, 241, 255, 13, 217, 182, 15, 177, 109, 13, 249, 255, 15, 145, 36, 13,
- 185, 109, 15, 241, 255, 13, 169, 170, 14, 253, 255, 15, 255, 255, 15 };
-static KmIcon kmicons_12 = { &kmicons_13, "sm_key", 20, 20, kmicons_12_bitmap,
- (KmPixmap)0, (KmPixmap)0 };
-
-static char kmicons_11_bitmap[] = { 255, 255, 255, 63, 1, 0, 0, 32, 1, 0, 0,
- 48, 169, 170, 170, 58, 81, 85, 85, 53, 249, 255, 255, 63, 17, 0, 0, 52, 25,
- 0, 0, 60, 241, 255, 255, 55, 89, 85, 181, 62, 49, 51, 19, 52, 25, 17, 49, 60,
- 241, 255, 255, 55, 89, 85, 181, 62, 49, 51, 19, 52, 25, 17, 49, 60, 241, 255,
- 255, 55, 89, 85, 181, 62, 49, 51, 19, 52, 25, 17, 49, 60, 241, 255, 255, 55,
- 89, 85, 181, 62, 49, 51, 19, 52, 25, 17, 49, 60, 49, 51, 19, 52, 249, 255,
- 255, 63, 81, 85, 85, 53, 169, 170, 170, 58, 253, 255, 255, 63, 255, 255, 255,
- 63 };
-static KmIcon kmicons_11 = { &kmicons_12, "big_key1", 30, 30,
- kmicons_11_bitmap, (KmPixmap)0, (KmPixmap)0 };
-
-static char kmicons_10_bitmap[] = { 0, 240, 7, 0, 0, 14, 56, 0, 128, 1, 192,
- 0, 64, 224, 3, 1, 32, 252, 31, 2, 16, 254, 63, 4, 8, 255, 127, 8, 136, 255,
- 255, 8, 196, 255, 255, 17, 228, 255, 255, 19, 228, 255, 255, 19, 226, 31,
- 252, 39, 242, 15, 248, 39, 242, 15, 248, 39, 242, 15, 248, 39, 242, 15, 248,
- 39, 242, 15, 248, 39, 226, 31, 252, 39, 228, 255, 255, 19, 228, 255, 255, 19,
- 196, 255, 255, 17, 136, 255, 255, 8, 8, 255, 127, 8, 16, 254, 63, 4, 32, 252,
- 31, 2, 64, 224, 3, 1, 128, 1, 192, 0, 0, 14, 56, 0, 0, 240, 7, 0, 0, 0, 0, 0
- };
-static KmIcon kmicons_10 = { &kmicons_11, "big_tape", 30, 30,
- kmicons_10_bitmap, (KmPixmap)0, (KmPixmap)0 };
-
-static char kmicons_9_bitmap[] = { 255, 255, 255, 63, 1, 0, 0, 32, 1, 0, 0,
- 32, 1, 0, 0, 32, 1, 254, 255, 33, 1, 255, 255, 35, 129, 255, 255, 35, 193,
- 255, 255, 35, 225, 255, 255, 35, 241, 255, 255, 35, 241, 31, 252, 35, 241,
- 143, 248, 35, 241, 7, 240, 35, 241, 199, 241, 35, 241, 71, 241, 35, 241, 199,
- 241, 35, 241, 23, 244, 35, 241, 15, 248, 35, 241, 31, 252, 35, 241, 255, 255,
- 35, 241, 255, 255, 35, 241, 255, 255, 35, 241, 255, 255, 35, 241, 255, 255,
- 35, 241, 255, 255, 35, 225, 255, 255, 33, 1, 0, 0, 32, 1, 0, 0, 32, 1, 0, 0,
- 32, 255, 255, 255, 63 };
-static KmIcon kmicons_9 = { &kmicons_10, "big_cart", 30, 30, kmicons_9_bitmap,
- (KmPixmap)0, (KmPixmap)0 };
-
-static char kmicons_8_bitmap[] = { 255, 255, 255, 63, 1, 0, 0, 32, 1, 0, 0,
- 32, 249, 15, 0, 32, 1, 0, 0, 32, 1, 0, 0, 32, 249, 255, 3, 32, 1, 0, 0, 32,
- 1, 0, 0, 32, 249, 255, 127, 32, 1, 0, 0, 32, 1, 0, 0, 32, 1, 0, 0, 32, 193,
- 127, 254, 35, 193, 127, 254, 35, 193, 0, 128, 35, 193, 0, 192, 33, 193, 0,
- 224, 32, 193, 15, 112, 32, 193, 15, 112, 32, 193, 0, 56, 32, 193, 0, 28, 32,
- 193, 0, 14, 32, 193, 0, 254, 35, 193, 0, 254, 35, 1, 0, 0, 32, 1, 0, 0, 32,
- 1, 0, 0, 32, 1, 0, 0, 32, 255, 255, 255, 63 };
-static KmIcon kmicons_8 = { &kmicons_9, "big_fzfile", 30, 30,
- kmicons_8_bitmap, (KmPixmap)0, (KmPixmap)0 };
-
-static char kmicons_7_bitmap[] = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 6, 0, 24, 0,
- 255, 255, 31, 128, 255, 255, 31, 192, 6, 0, 30, 120, 6, 96, 27, 248, 255,
- 255, 25, 248, 255, 255, 24, 24, 6, 96, 24, 24, 6, 96, 24, 24, 6, 96, 24, 24,
- 255, 255, 31, 152, 6, 96, 28, 88, 6, 96, 26, 56, 0, 96, 25, 248, 255, 255,
- 24, 24, 6, 96, 24, 24, 254, 255, 31, 24, 255, 255, 31, 152, 7, 96, 28, 216,
- 6, 96, 30, 120, 0, 96, 27, 248, 255, 255, 1, 248, 255, 255, 0, 24, 0, 96, 0,
- 24, 0, 96, 0, 24, 0, 96, 0, 0, 0, 0, 0, 0, 0, 0, 0 };
-static KmIcon kmicons_7 = { &kmicons_8, "big_store", 30, 30, kmicons_7_bitmap,
- (KmPixmap)0, (KmPixmap)0 };
-
-static char kmicons_6_bitmap[] = { 255, 255, 255, 63, 129, 0, 0, 32, 129, 1,
- 0, 32, 193, 3, 0, 32, 65, 6, 0, 32, 161, 12, 0, 32, 49, 56, 0, 32, 25, 252,
- 240, 39, 137, 230, 127, 36, 205, 51, 99, 44, 45, 57, 115, 62, 25, 155, 49,
- 59, 1, 158, 57, 41, 1, 156, 153, 53, 1, 236, 248, 37, 1, 220, 93, 52, 1, 44,
- 207, 50, 1, 26, 128, 50, 1, 14, 128, 34, 1, 14, 128, 34, 1, 6, 128, 33, 1, 7,
- 192, 33, 1, 0, 0, 32, 225, 255, 255, 47, 49, 0, 0, 46, 249, 255, 255, 43, 89,
- 0, 0, 43, 89, 0, 0, 43, 25, 0, 0, 35, 255, 255, 255, 63 };
-static KmIcon kmicons_6 = { &kmicons_7, "big_bank", 30, 30, kmicons_6_bitmap,
- (KmPixmap)0, (KmPixmap)0 };
-
-static char kmicons_5_bitmap[] = { 255, 255, 255, 63, 1, 0, 0, 32, 1, 0, 0,
- 32, 241, 31, 252, 39, 249, 31, 254, 39, 253, 23, 255, 37, 37, 20, 9, 37, 5,
- 4, 1, 33, 5, 4, 1, 33, 1, 0, 0, 32, 1, 0, 0, 32, 1, 0, 0, 32, 241, 31, 252,
- 39, 249, 31, 254, 39, 253, 23, 255, 37, 37, 20, 9, 37, 5, 4, 1, 33, 5, 4, 1,
- 33, 1, 0, 0, 32, 1, 0, 0, 32, 1, 0, 0, 32, 1, 0, 0, 32, 241, 31, 252, 39,
- 249, 31, 254, 39, 253, 23, 255, 37, 37, 20, 9, 37, 5, 4, 1, 33, 5, 4, 1, 33,
- 1, 0, 0, 32, 255, 255, 255, 63 };
-static KmIcon kmicons_5 = { &kmicons_6, "big_div", 30, 30, kmicons_5_bitmap,
- (KmPixmap)0, (KmPixmap)0 };
-
-static char kmicons_4_bitmap[] = { 0, 0, 0, 192, 224, 31, 0, 192, 120, 240,
- 255, 207, 24, 192, 255, 207, 12, 128, 255, 207, 140, 135, 255, 207, 196, 15,
- 255, 207, 196, 31, 255, 207, 196, 31, 255, 207, 196, 31, 255, 207, 196, 15,
- 255, 207, 140, 135, 255, 207, 12, 0, 255, 207, 28, 0, 254, 207, 124, 16, 252,
- 207, 252, 63, 248, 207, 252, 127, 240, 207, 252, 255, 224, 207, 252, 255,
- 193, 207, 252, 255, 131, 207, 252, 255, 3, 207, 252, 255, 1, 206, 252, 255,
- 0, 206, 252, 63, 0, 207, 252, 31, 128, 207, 252, 31, 193, 207, 252, 159, 231,
- 207, 252, 159, 241, 207, 0, 248, 127, 192, 0, 0, 0, 192 };
-static KmIcon kmicons_4 = { &kmicons_5, "big_key", 30, 30, kmicons_4_bitmap,
- (KmPixmap)0, (KmPixmap)0 };
-
-static char kmicons_3_bitmap[] = { 255, 255, 255, 63, 1, 0, 0, 32, 1, 0, 0,
- 48, 169, 170, 170, 58, 81, 85, 85, 53, 169, 170, 170, 58, 1, 84, 21, 48, 1,
- 168, 10, 48, 81, 1, 64, 53, 169, 2, 160, 58, 81, 85, 85, 53, 169, 170, 170,
- 58, 209, 95, 255, 52, 233, 31, 255, 58, 209, 92, 117, 53, 233, 174, 186, 58,
- 209, 87, 93, 53, 233, 174, 174, 58, 209, 92, 255, 52, 233, 186, 255, 58, 81,
- 85, 85, 53, 253, 255, 255, 63, 255, 255, 255, 63 };
-static KmIcon kmicons_3 = { &kmicons_4, "rzdir", 30, 23, kmicons_3_bitmap,
- (KmPixmap)0, (KmPixmap)0 };
-
-static char kmicons_2_bitmap[] = { 0, 0, 0, 224, 254, 3, 0, 224, 254, 3, 8,
- 224, 6, 0, 20, 224, 6, 0, 62, 224, 126, 0, 85, 224, 126, 128, 255, 224, 6,
- 192, 213, 225, 6, 96, 127, 227, 6, 160, 239, 227, 6, 32, 251, 226, 6, 80, 94,
- 227, 6, 168, 180, 226, 0, 68, 89, 227, 0, 140, 170, 226, 0, 20, 93, 227, 254,
- 37, 174, 226, 254, 69, 91, 227, 192, 149, 169, 226, 224, 164, 92, 227, 112,
- 136, 174, 226, 56, 144, 91, 225, 28, 160, 169, 224, 14, 192, 89, 224, 254,
- 129, 42, 224, 254, 1, 28, 224, 0, 0, 8, 224, 0, 0, 0, 224, 0, 0, 0, 224, 255,
- 255, 255, 255 };
-static KmIcon kmicons_2 = { &kmicons_3, "fzfile", 30, 30, kmicons_2_bitmap,
- (KmPixmap)0, (KmPixmap)0 };
-
-static char kmicons_1_bitmap[] = { 1, 254, 255, 255, 252, 0, 0, 224, 254, 1,
- 8, 224, 134, 1, 20, 224, 134, 1, 62, 224, 254, 0, 85, 224, 126, 128, 255,
- 224, 102, 192, 213, 225, 230, 96, 127, 227, 198, 161, 239, 227, 134, 33, 251,
- 226, 0, 80, 94, 227, 1, 168, 180, 226, 1, 68, 89, 227, 1, 140, 170, 226, 0,
- 20, 93, 243, 254, 37, 174, 242, 254, 69, 91, 243, 192, 133, 169, 242, 224,
- 132, 92, 243, 112, 136, 174, 242, 56, 144, 91, 241, 28, 160, 169, 240, 14,
- 192, 89, 240, 254, 128, 42, 240, 254, 1, 28, 240, 0, 0, 8, 240, 1, 0, 0, 240,
- 1, 224, 255, 255, 255, 255, 255, 255 };
-static KmIcon kmicons_1 = { &kmicons_2, "rzfile", 30, 30, kmicons_1_bitmap,
- (KmPixmap)0, (KmPixmap)0 };
-
- klnkmenu( &_DZDOC, 921023 );
- klnkbrcl( &brclass_1, 921023 );
- klnkkmcl( &kmclass_1, 921023 );
- klnkicon( &kmicons_1, 921023 );
- klnkaddr.graf_info_C = ixmotif;
- klnkaddr.graf_size_F = igrsiz_;
- klnkaddr.graf_pick_F = igobj_;
- klnkaddr.graf_attr_F = igset_;
- klnkaddr.graf_close_F = iclwk_;
-}
-
-
diff --git a/src/graflib/dzdoc/doc/history/Makefile.in b/src/graflib/dzdoc/doc/history/Makefile.in
deleted file mode 100644
index e7f4b49..0000000
--- a/src/graflib/dzdoc/doc/history/Makefile.in
+++ /dev/null
@@ -1,63 +0,0 @@
-#
-# dzdoc/dzebpack/Makefile.in - compiles and archives the source code in this directory.
-# It is invoked by Makefile.xxxxx in the above directory, where xxxxx is the name of the library.
-# Generated by car2cvs $Revision: 1.1.1.1 $ (nk)
-#
-# $Id: Makefile.in,v 1.1.1.1 1996/03/04 16:12:53 mclareni Exp $
-#
-# $Log: Makefile.in,v $
-# Revision 1.1.1.1 1996/03/04 16:12:53 mclareni
-# Dzdoc/Zebpack
-#
-#
-
-MAKE = gmake
-SHELL = /bin/sh
-srcdir = @srcdir@
-VPATH = @srcdir@
-MACHINE = @MACHINE@
-
-ifeq "$(srcdir)" "."
- absrcdir = $(shell pwd)
-else
- absrcdir = $(srcdir)
-endif
-
-OBJS=
-
-LIBRARY=dummy
-ifeq "$(LIBRARY)" "dummy"
- OBJS=
-endif
-.SUFFIXES: .cdf
-
-.PHONY:dummy production vaxsrc vaxcom debug clean distclean realclean TAGS depend fort_depend c_depend cc_depend
- @
-
-dummy::
- @echo Run Makefile in the parent directory
-
-debug production:$(OBJS)
- @test "$(LIBRARY)" = "dummy" || test "`echo *.o`" = "*.o" || ($(AR) rvs $(LIBRARY) *.o;$(RM) *.o)
-
-vaxsrc:$(VAX_FORTRAN_SOURCES)
- @
-
-vaxcom:$(VAX_COMS)
- @
-
-clean:
- @rm -f *.o *.bak
-
-distclean:clean
- @rm -f Makefile Makefile.obj
-
-realclean:
- @rm -f *~ #*
-
-TAGS:$(absrcdir)/*[Fch]
- @$(ETAGS) -f $(dir $(LIBRARY))/TAGS.$(LIBRARY_NAME) $(absrcdir)/*[Fch]
-
-
-
-
diff --git a/src/graflib/dzdoc/doc/history/copyright b/src/graflib/dzdoc/doc/history/copyright
deleted file mode 100644
index 9a07289..0000000
--- a/src/graflib/dzdoc/doc/history/copyright
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: copyright,v 1.1.1.1 1996/03/04 16:12:53 mclareni Exp $
-*
-* $Log: copyright,v $
-* Revision 1.1.1.1 1996/03/04 16:12:53 mclareni
-* Dzdoc/Zebpack
-*
-*
-************************************************************************
-* *
-* DZDOC -- ZEBRA data structure documentation system *
-* *
-* CERN program library entry Q101 *
-* *
-* Copyright CERN, Geneva 1987 *
-* *
-* Copyright and any other appropriate legal protection of these *
-* computer programs and associated documentation reserved in all *
-* countries of the world. *
-* *
-************************************************************************
-
diff --git a/src/graflib/dzdoc/doc/history/v100.dat b/src/graflib/dzdoc/doc/history/v100.dat
deleted file mode 100644
index 664728e..0000000
--- a/src/graflib/dzdoc/doc/history/v100.dat
+++ /dev/null
@@ -1,11 +0,0 @@
-*
-* $Id: v100.dat,v 1.1.1.1 1996/03/04 16:12:53 mclareni Exp $
-*
-* $Log: v100.dat,v $
-* Revision 1.1.1.1 1996/03/04 16:12:53 mclareni
-* Dzdoc/Zebpack
-*
-*
-* Version 1.00 910305 22.45
-C- Introduction of DZDOC v4.70
-C
diff --git a/src/graflib/dzdoc/doc/history/v101.dat b/src/graflib/dzdoc/doc/history/v101.dat
deleted file mode 100644
index d4d57fe..0000000
--- a/src/graflib/dzdoc/doc/history/v101.dat
+++ /dev/null
@@ -1,15 +0,0 @@
-*
-* $Id: v101.dat,v 1.1.1.1 1996/03/04 16:12:53 mclareni Exp $
-*
-* $Log: v101.dat,v $
-* Revision 1.1.1.1 1996/03/04 16:12:53 mclareni
-* Dzdoc/Zebpack
-*
-*
-* Version 1.01 910816 13.20
-C- Introduction of DZDOC v4.75
-C- Introduction of DZDOC v4.76 on 910728 21.40
-C- Introduction of DZDOC v4.91 on 910816 13.20
-C
-C- Suppress dummy RZEBRA section; it will stay in ZEBRA
-C
diff --git a/src/graflib/dzdoc/doc/history/v102.dat b/src/graflib/dzdoc/doc/history/v102.dat
deleted file mode 100644
index bc7174c..0000000
--- a/src/graflib/dzdoc/doc/history/v102.dat
+++ /dev/null
@@ -1,13 +0,0 @@
-*
-* $Id: v102.dat,v 1.1.1.1 1996/03/04 16:12:53 mclareni Exp $
-*
-* $Log: v102.dat,v $
-* Revision 1.1.1.1 1996/03/04 16:12:53 mclareni
-* Dzdoc/Zebpack
-*
-*
-* Version 1.02 920310 6.45
-C- Introduction of DZDOC v5.01 on 920304 3.30
-C
-C- P=DZEDIT, D=MFTOPS declaration of POLYMARKER_TYPE was left out
-C
diff --git a/src/graflib/dzdoc/doc/history/v103.dat b/src/graflib/dzdoc/doc/history/v103.dat
deleted file mode 100644
index 8951578..0000000
--- a/src/graflib/dzdoc/doc/history/v103.dat
+++ /dev/null
@@ -1,13 +0,0 @@
-*
-* $Id: v103.dat,v 1.1.1.1 1996/03/04 16:12:53 mclareni Exp $
-*
-* $Log: v103.dat,v $
-* Revision 1.1.1.1 1996/03/04 16:12:53 mclareni
-* Dzdoc/Zebpack
-*
-*
-* Version 1.03 920717 21.15
-C- Introduction of DZDOC v5.05 on 920715 20.15
-C
-C- P=DZEDIT, D=RZFRA Correct unit assignment
-C
diff --git a/src/graflib/dzdoc/doc/history/v104.dat b/src/graflib/dzdoc/doc/history/v104.dat
deleted file mode 100644
index 1c153d0..0000000
--- a/src/graflib/dzdoc/doc/history/v104.dat
+++ /dev/null
@@ -1,11 +0,0 @@
-*
-* $Id: v104.dat,v 1.1.1.1 1996/03/04 16:12:53 mclareni Exp $
-*
-* $Log: v104.dat,v $
-* Revision 1.1.1.1 1996/03/04 16:12:53 mclareni
-* Dzdoc/Zebpack
-*
-*
-* Version 1.04 921217 22.00
-C- Introduction of DZDOC v5.30 on 921206 6.00
-C
diff --git a/src/graflib/dzdoc/doc/history/v105.dat b/src/graflib/dzdoc/doc/history/v105.dat
deleted file mode 100644
index f44a1e8..0000000
--- a/src/graflib/dzdoc/doc/history/v105.dat
+++ /dev/null
@@ -1,11 +0,0 @@
-*
-* $Id: v105.dat,v 1.1.1.1 1996/03/04 16:12:53 mclareni Exp $
-*
-* $Log: v105.dat,v $
-* Revision 1.1.1.1 1996/03/04 16:12:53 mclareni
-* Dzdoc/Zebpack
-*
-*
-* Version 1.05 930301 16.15
-C- Introduction of DZDOC v5.51 on 930301 16.15
-C
diff --git a/src/graflib/dzdoc/doc/history/v106.dat b/src/graflib/dzdoc/doc/history/v106.dat
deleted file mode 100644
index 0e877bf..0000000
--- a/src/graflib/dzdoc/doc/history/v106.dat
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: v106.dat,v 1.1.1.1 1996/03/04 16:12:53 mclareni Exp $
-*
-* $Log: v106.dat,v $
-* Revision 1.1.1.1 1996/03/04 16:12:53 mclareni
-* Dzdoc/Zebpack
-*
-*
-* Version 1.06 930928 15.15
-C- Add QMLNX flag IF=BSLASH
-C- Introduction of DZDOC v5.60/02 on 930928 15.15
-C
diff --git a/src/graflib/dzdoc/doc/history/v107.dat b/src/graflib/dzdoc/doc/history/v107.dat
deleted file mode 100644
index 69bf8d0..0000000
--- a/src/graflib/dzdoc/doc/history/v107.dat
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: v107.dat,v 1.1.1.1 1996/03/04 16:12:53 mclareni Exp $
-*
-* $Log: v107.dat,v $
-* Revision 1.1.1.1 1996/03/04 16:12:53 mclareni
-* Dzdoc/Zebpack
-*
-*
-* Version 1.07 950221 11.00
-C- Introduction of DZDOC v5.94 on 950221 11.00
-C- HTML output implemented in DZEDIT
-C
diff --git a/src/graflib/dzdoc/dzdkern/Imakefile b/src/graflib/dzdoc/dzdkern/Imakefile
deleted file mode 100644
index e248a19..0000000
--- a/src/graflib/dzdoc/dzdkern/Imakefile
+++ /dev/null
@@ -1,5 +0,0 @@
-SRCS_F= dzd00t.F dzd0nt.F dzd0tt.F dzdbk1.F dzdbkc.F dzdcar.F \ @@\
- dzdco1.F dzdcod.F dzdcrd.F dzdeos.F dzdggi.F dzdini.F dzdlin.F \ @@\
- dzdlo1.F dzdndc.F dzdnum.F dzdocm.F dzdsco.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/graflib/dzdoc/dzdkern/dzd00t.F b/src/graflib/dzdoc/dzdkern/dzd00t.F
deleted file mode 100644
index 5320d02..0000000
--- a/src/graflib/dzdoc/dzdkern/dzd00t.F
+++ /dev/null
@@ -1,62 +0,0 @@
-*
-* $Id: dzd00t.F,v 1.1.1.1 1996/03/04 16:12:55 mclareni Exp $
-*
-* $Log: dzd00t.F,v $
-* Revision 1.1.1.1 1996/03/04 16:12:55 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZD00T
-************************************************************************
-*. *
-*...DZD00T decodes the text part of a line of input *
-*. *
-*. DZD00T assumes that the characters on the input line have to be *
-*. interpreted as text. Therefore the first and last non-blank chars. *
-*. are located. Then the text is copied to vector IHTXT. *
-*. The text is supposed to start after the first blank series. *
-*. If the line, apart from the beginning is all blank, NWTXT = 0 *
-*. and NWTXT = 0. *
-*. *
-*. CALLS : INDEXC,INDXBC,UCTOH *
-*. CALLED : DZDCAR *
-*. COMMON : DZDINC,DZDTYP *
-*. *
-*. AUTHOR : M. Goossens DD/US *
-*. VERSION : 1.01(8) / 9 Jul 1986 *
-*. *
-*.**********************************************************************
- SAVE
-#include "dzdoc/bkwrp.inc"
-
- 1001 CONTINUE
-
-*.. Find the first non-blank after the first blank series
-
- IFSBLK = INDEX(CARD,' ')
- ITXBEG = INDEXC(CARD(IFSBLK:),' ') + IFSBLK - 1
- IF (ITXBEG.LT.IFSBLK) THEN
-*-- No text given
- NWTXT = 0
- ELSE
-*-- Text given
- ITXEND = INDXBC(CARD,' ')
- NHTXT = ITXEND-ITXBEG+1
- IF (NHTXT.EQ.1.AND.CARD(ITXBEG:ITXBEG).EQ.')') THEN
-C- Same text as for previous entry
- IHTXT(1) = IDEMTX
- NWTXT = 1
- ELSE
- NWTXT = (NHTXT+3)/4
- CALL UCTOH(CARD(ITXBEG:),IHTXT,4,NHTXT)
-C- Flag lines ending with slashes
- IF (CARD(ITXEND:ITXEND).EQ.'/') THEN
- ISLASH = 1
- ELSE
- ISLASH = 0
- ENDIF
- ENDIF
- ENDIF
-
- 999 END
diff --git a/src/graflib/dzdoc/dzdkern/dzd0nt.F b/src/graflib/dzdoc/dzdkern/dzd0nt.F
deleted file mode 100644
index ae1f245..0000000
--- a/src/graflib/dzdoc/dzdkern/dzd0nt.F
+++ /dev/null
@@ -1,101 +0,0 @@
-*
-* $Id: dzd0nt.F,v 1.1.1.1 1996/03/04 16:12:55 mclareni Exp $
-*
-* $Log: dzd0nt.F,v $
-* Revision 1.1.1.1 1996/03/04 16:12:55 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZD0NT
-************************************************************************
-*. *
-*...DZD0NT returns number and text information via /DZDTYP/ *
-*. *
-*. DZD0NT assumes that the characters on the input line have to be *
-*. interpreted as a number (* accepted) and text. *
-*. The nb. is supposed to be delimited by the first and second blank *
-*. field, while the text starts after the second blank field. *
-*. The absence of either of the tag/text field is indicated by a *
-*. character count equal to zero *
-*. *
-*. CALLS : INDEXC,INDXBC,DZDNDC,UCTOH *
-*. CALLED : DZDCAR *
-*. COMMON : DZDINC,DZDTYP *
-*. *
-*. AUTHOR : M. Goossens DD/US *
-*. VERSION : 1.01(8) / 9 Jul 1986 *
-*. *
-*.**********************************************************************
- SAVE
-#include "dzdoc/bkwrp.inc"
-#include "dzdoc/bknuparq.inc"
- 1001 CONTINUE
-
-*.. Find the first non-blank after the first blank series
-
- IFSBLK = INDEX(CARD,' ')
- NUMBEG = INDEXC(CARD(IFSBLK:),' ') + IFSBLK - 1
- IF (NUMBEG.LT.IFSBLK) THEN
-*-- No tag and hence no text given
- INUM1 = 0
- INUM2 = 0
- NWTXT = 0
- ELSE
-*-- Number given
- NUMEND = INDEX(CARD(NUMBEG:),' ')
- IF (NUMEND.EQ.0) THEN
-*-- No second blank field --> only number?
-*-- Is it a valid number
- CALL DZDNDC(CARD(NUMBEG:LNCARD),INUM1)
- IF (INUM1.NE.INUTGQ) THEN
-C- Real number found
- NWTAG = 0
- ELSE
-C- Tag instead of number
- NHTAG = LNCARD - NUMBEG + 1
- NWTAG = (NHTAG+3)/4
- CALL UCTOH(CARD(NUMBEG:),IHTAG,4,NHTAG)
- NWTXT = 0
- ENDIF
- ELSE
- NUMEND = NUMBEG + NUMEND - 2
-*-- Second blank field found
-*-- Is it a valid number
- CALL DZDNDC(CARD(NUMBEG:NUMEND),INUM1)
- IF (INUM1.NE.INUTGQ) THEN
-C- Real number found
- NWTAG = 0
- ELSE
-C- Tag instead of number
- NHTAG = NUMEND - NUMBEG + 1
- NWTAG = (NHTAG+3)/4
- CALL UCTOH(CARD(NUMBEG:),IHTAG,4,NHTAG)
- ENDIF
- ITXBEG = INDEXC(CARD(NUMEND+1:),' ') + NUMEND
- IF (ITXBEG.EQ.NUMEND) THEN
-*-- No text given
- NWTXT = 0
- ELSE
-*-- Text given
- ITXEND = INDXBC(CARD,' ')
- NHTXT = ITXEND-ITXBEG+1
- IF (NHTXT.EQ.1.AND.CARD(ITXBEG:ITXBEG).EQ.')') THEN
-C- Same text as for previous entry
- IHTXT(1) = IDEMTX
- NWTXT = 1
- ELSE
- NWTXT = (NHTXT+3)/4
- CALL UCTOH(CARD(ITXBEG:),IHTXT,4,NHTXT)
-C- Flag lines ending with slashes
- IF (CARD(ITXEND:ITXEND).EQ.'/') THEN
- ISLASH = 1
- ELSE
- ISLASH = 0
- ENDIF
- ENDIF
- ENDIF
- ENDIF
- ENDIF
-
- 999 END
diff --git a/src/graflib/dzdoc/dzdkern/dzd0tt.F b/src/graflib/dzdoc/dzdkern/dzd0tt.F
deleted file mode 100644
index e726efc..0000000
--- a/src/graflib/dzdoc/dzdkern/dzd0tt.F
+++ /dev/null
@@ -1,92 +0,0 @@
-*
-* $Id: dzd0tt.F,v 1.1.1.1 1996/03/04 16:12:56 mclareni Exp $
-*
-* $Log: dzd0tt.F,v $
-* Revision 1.1.1.1 1996/03/04 16:12:56 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZD0TT
-************************************************************************
-*. *
-*...DZD0TT returns tag and text information via /DZDTYP/ *
-*. *
-*. DZD0TT assumes that the characters on the input line have to be *
-*. interpreted as tags and text. *
-*. The tag is supposed to be delimited by the first and second blank *
-*. field, while the text starts after the second blank field. *
-*. The absence of either of the tag/text field is indicated by a *
-*. character count equal to zero *
-*. *
-*. CALLS : INDEXC,INDXBC,UCTOH *
-*. CALLED : DZDCAR *
-*. COMMON : DZDINC,DZDTYP *
-*. *
-*. AUTHOR : M. Goossens DD/US *
-*. VERSION : 1.01(9) / 9 Jul 1986 *
-*. *
-*.**********************************************************************
- SAVE
-#include "dzdoc/bkwrp.inc"
-
- 1001 CONTINUE
-
-*.. Find the first non-blank after the first blank series
-
- IFSBLK = INDEX(CARD,' ')
- ITGBEG = INDEXC(CARD(IFSBLK:),' ') + IFSBLK - 1
- IF (ITGBEG.LT.IFSBLK) THEN
-*-- No tag and hence no text given
- NWTAG = 0
- NWTXT = 0
- ELSE
-*-- Tag given
- ITGEND = INDEX(CARD(ITGBEG:),' ')
- IF (ITGEND.EQ.0) THEN
-*-- No second blank field --> no explicit text
-*-- use information both for text and tag fields
- NHTAG = LNCARD - ITGBEG + 1
- NWTAG = (NHTAG+3)/4
- CALL UCTOH(CARD(ITGBEG:),IHTAG,4,NHTAG)
- NHTXT = NHTAG
- NWTXT = NWTAG
- CALL UCTOH(CARD(ITGBEG:),IHTXT,4,NHTXT)
- ELSE
- NHTAG = ITGEND - 1
- NWTAG = (NHTAG+3)/4
- IF (NHTAG.EQ.1.AND.CARD(ITGBEG:ITGBEG).EQ.'*') THEN
-*-- If tag is * only --> ignore tag (none desired)
- CONTINUE
- ELSE
- CALL UCTOH(CARD(ITGBEG:),IHTAG,4,NHTAG)
- ENDIF
- ITGEND = ITGBEG + NHTAG
-*-- Second blank field found -- Hunt for start of text
- ITXBEG = INDEXC(CARD(ITGEND+1:),' ') + ITGEND
- IF (ITXBEG.EQ.ITGEND) THEN
-*-- No text given
- NWTXT = 0
- ELSE
-*-- Text given
- ITXEND = INDXBC(CARD,' ')
- NHTXT = ITXEND-ITXBEG+1
- IF (NHTXT.EQ.1.AND.CARD(ITXBEG:ITXBEG).EQ.')') THEN
-C- Same text as for previous entry
- IHTXT(1) = IDEMTX
- NWTXT = 1
- ELSE
- NWTXT = (NHTXT+3)/4
- CALL UCTOH(CARD(ITXBEG:),IHTXT,4,NHTXT)
-C- Flag lines ending with slashes
- IF (CARD(ITXEND:ITXEND).EQ.'/') THEN
- ISLASH = 1
- ELSE
- ISLASH = 0
- ENDIF
- ENDIF
- ENDIF
- ENDIF
- ENDIF
-
- 999 END
diff --git a/src/graflib/dzdoc/dzdkern/dzdbk1.F b/src/graflib/dzdoc/dzdkern/dzdbk1.F
deleted file mode 100644
index e7aa71c..0000000
--- a/src/graflib/dzdoc/dzdkern/dzdbk1.F
+++ /dev/null
@@ -1,317 +0,0 @@
-*
-* $Id: dzdbk1.F,v 1.1.1.1 1996/03/04 16:12:56 mclareni Exp $
-*
-* $Log: dzdbk1.F,v $
-* Revision 1.1.1.1 1996/03/04 16:12:56 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDBK1(CHBANK,LUNL,IFLAG)
- CHARACTER*8 CHBANK
-
- CHARACTER*16 CTEMP
- CHARACTER*60 CGET, SPACES
- EXTERNAL SPACES
- CHARACTER*1 CC
- CHARACTER*16 CNL,CNS,CND,CNZ
- CHARACTER*6 CIOC
- CHARACTER*4 CFLINK,CLLINK
- SAVE CFLINK,CLLINK
- INTEGER KEYVEC(2)
-#include "dzdoc/bkwrp.inc"
-#include "dzdoc/tapes.inc"
-* From DZEBRA
-#include "zebra/zbcdk.inc"
-
- CALL UCTOH(CHBANK(1:4),KEYVEC(1),4,4)
- IDHBK = KEYVEC(1)
- CALL UCTOH(CHBANK(5:8),KEYVEC(2),4,4)
- ICYCLE = 100000
- LQBKD1=0
- CALL RZIN(0,LQBKD1,2,KEYVEC,ICYCLE,' ')
- IF(LQBKD1.EQ.0 .OR. IQUEST(1) .NE. 0)THEN
- WRITE(LUNL,*)'* no doc for ',CHBANK
- GOTO 999
- ENDIF
-* WRITE(*,'(A,A4)')' Bank ID= ',IQ(KQSP+LQBKD1+1)
- NWGEN=IQ(KQSP+LQBKD1+11)
-* WRITE(*,*)' NWGEN',NWGEN
- IP0 =LQBKD1+KQSP+1
-* keep seq for declarations
- ILCB=INDXBC(CHBANK(1:4),' ')
- IF(IFLAG.EQ. 1)THEN
- WRITE(LUNL,'(A)')'+KEEP,DECL'//CHBANK(1:ILCB)
- CALL DZDPLN(LUNL,'INTEGER L'//CHBANK(1:ILCB),2)
- CFLINK=CHBANK(1:ILCB)
- CLLINK=CFLINK
- GOTO 999
- ENDIF
- IF(IFLAG.EQ. 5)THEN
- CALL DZDPLN(LUNL,
- & 'COMMON/LK'//CHBANK(1:ILCB)//'/L'//CHBANK(1:ILCB),2)
- CFLINK=CHBANK(1:ILCB)
- CLLINK=CFLINK
- GOTO 999
- ENDIF
- IF(IFLAG.EQ.2 .OR. IFLAG.EQ.6)THEN
- CALL DZDPLN(LUNL,',L'//CHBANK(1:ILCB),1)
- IF(IFLAG.EQ.6)CLLINK=CHBANK(1:ILCB)
- GOTO 999
- ENDIF
-
- IF(IFLAG.EQ. 7)THEN
- WRITE(LUNL,'(A)')'+KEEP,DECLMM'//CHBANK(1:ILCB)
- CALL DZDPLN(LUNL,
- & 'INTEGER MM'//CHBANK(1:ILCB)//'(5)',2)
- GOTO 999
- ENDIF
- IF(IFLAG.EQ. 9)THEN
- CALL DZDPLN(LUNL,
- & 'COMMON/MM'//CHBANK(1:ILCB)//'/MM'//CHBANK(1:ILCB),2)
- GOTO 999
- ENDIF
- IF(IFLAG.EQ.8)THEN
- CALL DZDPLN(LUNL,
- & ',MM'//CHBANK(1:ILCB)//'(5)',1)
- GOTO 999
- ENDIF
- IF(IFLAG.EQ.10)THEN
- CALL DZDPLN(LUNL,
- & ',MM'//CHBANK(1:ILCB),1)
- GOTO 999
- ENDIF
-*
- IF(IFLAG.EQ.11)THEN
- WRITE(LUNL,'(A)')'+KEEP,FILLMM'//CHBANK(1:ILCB)
- ENDIF
-
- IF(IFLAG.EQ.3 .OR. IFLAG .EQ. 13)THEN
- IF(IFLAG.EQ.3)THEN
- WRITE(LUNL,'(A)')'+KEEP,BOOK'//CHBANK(1:ILCB)
- ELSE
- WRITE(LUNL,'(A)')'+KEEP,LIFT'//CHBANK(1:ILCB)
- ENDIF
-* div index
- CALL DZDGGI(IQ(IP0),'DV',' ',CGET,IFC,ILC)
-* WRITE(*,*)CGET(IFC:ILC)
- IF(IFC .EQ.0)THEN
- IFC=1
- ILC=1
- CGET(IFC:IFC)='0'
- ENDIF
- CALL DZDPLN(LUNL,'CALL MZLINK('//CGET(IFC:ILC)//','
- & //''''//CHBANK(1:ILCB)//''''
- & //',L'//CFLINK//',L'//CFLINK//',L'//CLLINK//')',2)
- CALL DZDPLN(LUNL,' ',99)
- ENDIF
- IF( IFLAG.EQ. 3 .OR. IFLAG.EQ. 4
- & .OR. IFLAG.EQ.13 .OR. IFLAG.EQ.14)THEN
-* write a comment line
- CALL DZDGGI(IQ(IP0),'CL',' ',CGET,IFC,ILC)
-* skip HID
- IFC=IFC+4
- IF(IFC.LE.ILC)WRITE(LUNL,'(A)')'* '//CGET(IFC:ILC)
- ENDIF
-
- CALL DZDGGI(IQ(IP0),'ND',' ',CND,IFC,ILC)
- IF(IFC .EQ.0 .OR. CND(1:1).EQ.'0')THEN
- CND='0'
- CIOC='2'
- ELSE
-* IO char
- CALL DZDGGI(IQ(IP0),'IO',' ',CGET,IFC,ILC)
- IF(ILC.LE.0)THEN
- CALL DZDDOC(0,0,CHBANK,'I',1,10000,6,CGET,NKEEPS)
- IFC=INDXNC(CGET)
- IF(IFC.LE.0)GOTO 991
- ILC=LNBLNK(CGET)
- IF(ILC.GT.IFC)IFC=1
- ENDIF
- IF(IFC.EQ.ILC)THEN
-* just one character given (0,1,2,3,4,5,B,I,F,D,H)
- CC=CGET(IFC:IFC)
- IF(CC.EQ.'B')THEN
- CC='1'
- ELSEIF(CC.EQ.'I')THEN
- CC='2'
- ELSEIF(CC.EQ.'F')THEN
- CC='3'
- ELSEIF(CC.EQ.'D')THEN
- CC='4'
- ELSEIF(CC.EQ.'H')THEN
- CC='5'
- ENDIF
-* is it a number from 0-5?
- IF(INDEXN(CC).EQ.1)THEN
- READ(CC,'(I1)')IIOC
- IF(IIOC.GT.5)GOTO 991
- ELSE
- GOTO 991
- ENDIF
- CIOC=CC
- ELSE
-* more then one char given call MZFORM
- CIOC='IO'//CHBANK(1:ILCB)
- IF(IFLAG.LE.2)CALL DZDPLN(LUNL,','//CIOC,1)
- ENDIF
- ILCIO=INDXBC(CIOC,' ')
- ENDIF
-
-* come back to MZFORM
- IF( IFLAG.EQ.3 .OR. IFLAG.EQ.4
- & .OR.IFLAG.EQ.11 .OR. IFLAG.EQ.12)THEN
- IF(IFC.LT.ILC)THEN
-* remove ' '
- II=INDEX(CGET(IFC:ILC),'''')
- IF(II.GT.0)THEN
- CGET(IFC+II-1:IFC+II-1)=' '
- II=INDEX(CGET(IFC:ILC),'''')
- IF(II.GT.0)CGET(IFC+II-1:IFC+II-1)=' '
- ENDIF
- CGET(IFC:ILC)=SPACES(CGET(IFC:ILC),1)
- ILC=MAX(1,LNBLNK(CGET(IFC:ILC))+IFC-1)
- CALL DZDPLN(LUNL,
- & 'CALL MZFORM('''//CHBANK(1:ILCB)
- & //''','''//CGET(IFC:ILC)
- & //''','//CIOC//')',2)
- ENDIF
- ENDIF
-
-* get and remember parameters needed after JBIAS
-
- CALL DZDGGI(IQ(IP0),'NL',' ',CNL,IFCNL,ILCNL)
- IF(IFCNL.EQ.0)THEN
- IFCNL=1
- ILCNL=1
- CNL='0'
- ENDIF
- CALL DZDGGI(IQ(IP0),'NS',' ',CNS,IFCNS,ILCNS)
- IF(IFCNS.EQ.0)THEN
- IFCNS=1
- ILCNS=1
- CNS='0'
- ENDIF
-
- CALL DZDGGI(IQ(IP0),'ND',' ',CND,IFCND,ILCND)
- IF(IFCND .EQ.0)THEN
- IFCND=1
- ILCND=1
- CND='0'
- ENDIF
-
-* fill bank descriptor vector if MZLIFTs req
-
- IF(IFLAG.EQ.11 .OR. IFLAG.EQ.12)THEN
- CALL DZDPLN(LUNL,
- & 'CALL UCTOH('//''''//CHBANK(1:ILCB)//''''//',MM'
- & //CHBANK(1:ILCB)//',4,4)',2)
- CALL DZDPLN(LUNL,
- & 'MM'//CHBANK(1:ILCB)//'(2) = '//CNL(IFCNL:ILCNL),2)
- CALL DZDPLN(LUNL,
- & 'MM'//CHBANK(1:ILCB)//'(3) = '//CNS(IFCNS:ILCNS),2)
- CALL DZDPLN(LUNL,
- & 'MM'//CHBANK(1:ILCB)//'(4) = '//CND(IFCND:ILCND),2)
- CALL DZDPLN(LUNL,
- & 'MM'//CHBANK(1:ILCB)//'(5) = '//CIOC(1:ILCIO),2)
-
- GOTO 999
- ENDIF
-
- CALL DZDGGI(IQ(IP0),'NZ',' ',CNZ,IFC,ILC)
- IF(IFC .EQ.0)CNZ='0'
-* div index
- CALL DZDGGI(IQ(IP0),'DV',' ',CGET,IFC,ILC)
-* WRITE(*,*)CGET(IFC:ILC)
- IF(IFC .EQ.0)THEN
- IFC=1
- ILC=1
- CGET(IFC:IFC)='0'
- ENDIF
-
- IF(IFLAG.EQ.3 .OR. IFLAG.EQ.4)
- & CALL DZDPLN(LUNL,'CALL MZBOOK(',2)
-
- IF(IFLAG.EQ.13 .OR. IFLAG.EQ.14)
- & CALL DZDPLN(LUNL,'CALL MZLIFT(',2)
- CALL DZDPLN(LUNL,CGET(IFC:ILC),1)
-* link to lifted bank
- CALL DZDPLN(LUNL,',L'//CHBANK(1:ILCB),1)
-* up bank
- CALL DZDGGI(IQ(IP0),'UP',' ',CGET,IFC,ILC)
-* WRITE(*,*)CGET(IFC:ILC)
- IF(IFC.LE.0)THEN
- WRITE(LUNL,*)' No Up-bank given'
- GOTO 999
- ENDIF
- ILCU1=INDXBC(CGET(IFC:IFC+3),' ')-1
- CALL CLTOU(CGET(IFC:IFC+ILCU1))
- CALL DZDPLN(LUNL,',L'//CGET(IFC:IFC+ILCU1),1)
-
-* Jbias
- IF(ILC.LE.4)THEN
-* no JBIAS given
- IF(CGET(IFC:IFC+ILCU1).EQ.'NONE')THEN
-* is it top bank?
- ILC=IFC+4
- CGET(ILC:ILC)='1'
- ELSE
-
-* find it in up bank
- CTEMP(1:4) = CHBANK(5:8)
- CTEMP(5:8) = '****'
- NFKEY = 0
-5 CONTINUE
- CALL DZDWCS(CTEMP,KEYVEC,NFKEY)
- IF(KEYVEC(1) .EQ. 0)GOTO 100
- CALL DZDPIN(KEYVEC,'RBG')
- IF(IQUEST(1) .NE. 0)GOTO 100
- LUPD = IQUEST(11)
-
-* find link offset in up-bank
-
- NSUP = IQ(KQSP+LUPD+5)
- DO 10 I=1,NSUP
- IF(IQ(KQSP+LUPD+10+I) .EQ. IDHBK)THEN
- CGET(1:4)=' '
- WRITE(CGET(1:10),'(I10)')-I
- IFC=INDEXC(CGET,' ')-4
- ILC=10
- GOTO 20
- ENDIF
-10 CONTINUE
-* try next
- GOTO 5
-100 WRITE(LUNL,*)'JBIAS not found'
- ENDIF
-20 CONTINUE
- IF(LUPD.NE.0)CALL MZDROP(0,LUPD,' ')
- LUPD=0
- ENDIF
- CALL DZDPLN(LUNL,','//CGET(IFC+4:ILC),1)
-
- IF(IFLAG.EQ.3 .OR. IFLAG.EQ.4)THEN
-* CHID
- CALL DZDPLN(LUNL,','''//CHBANK(1:ILCB)//'''',1)
-* NL,NS,ND
- CALL DZDPLN(LUNL,','//CNL,1)
- CALL DZDPLN(LUNL,','//CNS,1)
- CALL DZDPLN(LUNL,','//CND,1)
-* IOC
- CALL DZDPLN(LUNL,','//CIOC(1:ILCIO),1)
- ENDIF
- IF(IFLAG.EQ.13 .OR. IFLAG.EQ.14)THEN
- CALL DZDPLN(LUNL,',MM'//CHBANK(1:ILCB),1)
- ENDIF
-* NZ
- CALL DZDPLN(LUNL,','//CNZ,1)
- CALL DZDPLN(LUNL,')',1)
- CALL DZDPLN(LUNL,' ',99)
- GOTO 999
-991 WRITE(LUNL,*)'Illegal or no IO Char given', CGET(IFC:ILC)
-999 CONTINUE
- IF(LQBKD1 .NE. 0)CALL MZDROP(0,LQBKD1,' ')
- LQBKD1=0
- END
-
-***********************************************************************
diff --git a/src/graflib/dzdoc/dzdkern/dzdbkc.F b/src/graflib/dzdoc/dzdkern/dzdbkc.F
deleted file mode 100644
index ae04dbd..0000000
--- a/src/graflib/dzdoc/dzdkern/dzdbkc.F
+++ /dev/null
@@ -1,705 +0,0 @@
-*
-* $Id: dzdbkc.F,v 1.1.1.1 1996/03/04 16:12:53 mclareni Exp $
-*
-* $Log: dzdbkc.F,v $
-* Revision 1.1.1.1 1996/03/04 16:12:53 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDBKC(*)
-************************************************************************
-*. *
-*...DZDBKC master routine for decoding bank descriptor cards *
-*. *
-*. *
-*. BANKS L : QBKD *
-*. BANKS M : QBKD,QBKM *
-*. CALLS : DZDCAR,DZDEOS,IFROMC,INDXBC,MZCHLS,MZIOBK,MZLIFT,MZPUSH *
-*. CALLS : UCTOH,ZBINSR *
-*. CALLED : DZDOCM *
-*. COMMON : DZDINC,DZDOCC,DZDSOC,DZDTAP,DZDTYP,MZCN,MZDROP,RZOUT *
-*. *
-*. AUTHOR : M. Goossens DD/US
-*. *
-*. VERSION : 2.03(36) / 27 Sep 1987 *
-*. *
-*.**********************************************************************
- SAVE
-C- Min. nb. of words in bank for push and nb. of words pushed
- PARAMETER (MBPSHQ=30,NBPSHQ=200)
-#include "dzdoc/docparq.inc"
-#include "dzdoc/bkwrp.inc"
-#include "dzdoc/tapes.inc"
-#include "dzdoc/title.inc"
-
- CHARACTER CIDBK*4
- INTEGER MBKBKD(6),IUIDEM
-
-*------OTTO- KEY vector for RZIN/RZOUT
-
- INTEGER KEYVEC(2)
-#include "dzdoc/bknuparq.inc"
-#include "zebra/bkfoparq.inc"
-#include "dzdoc/linout.inc"
-* From DZEBRA
-#include "zebra/zbcdk.inc"
-#include "dzdoc/bkstparq.inc"
-#include "dzdoc/bktgparq.inc"
-#include "dzdoc/bktgdatq.inc"
- DATA MBKBKD/0,0,0,500,0,0/ , IFIRST/0/
-
- 1001 CONTINUE
- IF (IFIRST.EQ.0) THEN
-*-- Initialization of the name constants
-*-- Get the bank NAME vector for the documenation banks
-*-- complete by describing its structure as counters at the
-*-- bank beginning and then self-describing sectors.
- CALL UCTOH ('QBKD',MBKBKD,4,4)
- CALL MZIOBK(MBKBKD,5,'1H 19I -S')
- IFIRST=1
- ENDIF
-
- 10 NBNKS = NBNKS +1
- CIDBK = CARD(5:8)
-* no blanks allowed on IDBK
- IPBL=INDEX(CIDBK,' ')
- IF(IPBL.GT.0 .AND. IPBL.LT.4)CIDBK(IPBL+1:)=' '
- IUIDEM=0
- CALL UCTOH(CIDBK,IDBK,4,4)
-* WRITE(LUNOUT,'(A,A)')' Formatting ',CIDBK
-
-*---OTTO-- set KEY(2) = blank, force no formatting
- LFORCE=1
- CALL UCTOH('NONE',IHIDUP,4,4)
-
- LIDBK = LZFIND(0,LDQBKD,IDBK,MBIDHQ)
-
-* allow same bank Id more than once
-
-* IF (LIDBK.EQ.0) THEN
-
-*-- Create a new text buffer bank
- MBKBKD(1)=IDBK
- CALL MZLIFT(0,LQBKD,LDQBKD,1,MBKBKD,0)
-*-- Number of words in use
- IQ(KQSP+LQBKD+MBUSEQ) = NBHEAQ
-*-- Number of words in header
- IQ(KQSP+LQBKD+MBHEAQ) = NBHEAQ
-*-- Introduce encoded name
- IQ(KQSP+LQBKD+MBIDHQ) = IDBK
-*-- Introduce the creation sequence number as IDN
- IQWIDN(KQSP+LQBKD) = NBNKS
-
-* ELSE
-*-- Text bank for given bank identifier already exists
-* WRITE(LUNOUT,'(''0DZDOC -- Changing existing descriptor '',
-* X ''presently not supported'')')
-* GO TO 998
-* ENDIF
- ISTOLD = ISGENQ
- ISTATE = ISGENQ
-*-- Get hold of text accompanying bank identifier
- ISLASH = 0
- CALL DZD00T
-*-- Hollerith word count
- INSERT = NBHEAQ + 1
-*-- Insert the field indicating id = 0 and tag = 1 word
- IQ(KQSP+LQBKD+INSERT) = IFOINQ+JFOSEQ*(NBDSCQ-1)
- IQ(KQSP+LQBKD+INSERT+MBPATQ) = 1
- INSERT = INSERT + NBDSCQ
- IICONT = INSERT
-*-- Then introduce the bank Hollerith id. and the text
- IQ(KQSP+LQBKD+INSERT) = IFOHOQ+JFOSEQ*(NWTXT+1)
- INSERT = INSERT + 1
- CALL UCTOH(CIDBK,IQ(KQSP+LQBKD+INSERT),4,4)
- INSERT = INSERT + 1
- IF (NWTXT.GT.0) CALL UCOPY(IHTXT,IQ(KQSP+LQBKD+INSERT),NWTXT)
- IISLSH = ISLASH
- ITGLST = NWTXT + 2
-*-- Update the number of words in use
- IQ(KQSP+LQBKD+MBUSEQ) = IQ(KQSP+LQBKD+MBUSEQ) + ITGLST + NBDSCQ
- IQ(KQSP+LQBKD+MBGENQ) = IQ(KQSP+LQBKD+MBGENQ) + ITGLST + NBDSCQ
-
- DO 500 ICARD = 1,99999
-C
-*-- Read the bank description cards one by one
-C
- CALL DZDCRD(LUNIN,CARD,IRC)
- IF(IRC.NE.0)GOTO 20
-* READ (LUNIN,'(A)',END=20) CARD
- IRETUR=0
- GOTO 21
-20 CONTINUE
-* force output of doc at EOF
- IRETUR=1
- CARD(1:2)=' '
-21 CONTINUE
- IF (CARD(1:2).NE.'*B' .OR. CARD(3:4).EQ.'..') THEN
-* end of doc for one bank, output doc
- IF(IUIDEM.NE.0)THEN
-* idem tag given, get bank and replace Up-bank Id
- KEYVEC(1) = IDBK
- KEYVEC(2)=IUIDEM
- IF (IFLOPT(MPOSRQ).NE.0) THEN
-* its in a RZ-file
- IF(LDQBKD.NE.0)CALL MZDROP(0,LDQBKD,'.')
- LDQBKD=0
- ICYCLE = 1000000
- CALL RZIN(0,LSAME,2,KEYVEC,ICYCLE,' ')
- IF(LSAME.EQ.0 .OR. IQUEST(1) .NE. 0)THEN
- WRITE(LUNOUT,'(A,2A4)')
- & ' Cant find Idem for: ',KEYVEC
- GOTO 998
- ENDIF
- GOTO 29
- ENDIF
-* its in a linear chain of banks
- LSAME=LDQBKD
-25 CONTINUE
- IF (IQ(KQSP+LSAME-4).NE.IDBK
- & .OR. IQ(KQSP+LSAME-5).NE.IUIDEM)THEN
- LSAME=LQ(KQSP+LSAME)
- IF(LSAME.NE.0)THEN
- GOTO 25
- ELSE
- GOTO 50
- ENDIF
- ENDIF
-* bank found , delete the template, copy IDEM
- CALL MZDROP(0,LQBKD,'.')
- LQBKD=0
- CALL MZCOPY(0,LSAME,2,LDQBKD,1,' ')
- LSAME=LDQBKD
-
-29 CONTINUE
-* find Up-bank info
-* DO 50 IGEN = 1,NNGENQ
- II = NBHEAQ + 1
- 30 IF (II-NBHEAQ.GT.IQ(KQSP+LSAME+MBGENQ)) GO TO 50
-*-- Integer self-describing sector?
- IF (MOD(IQ(KQSP+LSAME+II),JFOSEQ).NE.IFOINQ)THEN
-*-- Not an integer self-describing sector --> skip
- II = II + IQ(KQSP+LSAME+II)/JFOSEQ + 1
- IF (II-NBHEAQ.GT.IQ(KQSP+LSAME+MBGENQ)) THEN
- GO TO 50
- ELSE
- GO TO 30
- ENDIF
- ENDIF
-*-- Integer self-describing sector: look at info id.
- INTAG = IBITS(IQ(KQSP+LSAME+II+1),ICHIDQ,NCHIDQ)
-
- IF (INTAG.NE.ITGUPQ) THEN
-*-- Not yet the id. needed --> continue
- II = II + IQ(KQSP+LSAME+II)/JFOSEQ + 1
- IF (II-NBHEAQ.GT.IQ(KQSP+LSAME+MBGENQ)) THEN
- GO TO 50
- ELSE
- GO TO 30
- ENDIF
- ENDIF
-*-- Upbank tag found, skip to text
- II = II + IQ(KQSP+LSAME+II)/JFOSEQ + 1
- IF (MOD(IQ(KQSP+LSAME+II),JFOSEQ).NE.IFOHOQ)THEN
-* not Holl section, fatal
- WRITE(LUNOUT,*)' No Bank Id found'
- GOTO 998
- ENDIF
-* replace Up-bank
- IQ(KQSP+LSAME+II+1)=IHIDUP
- LQBKD=LSAME
- GOTO 51
-50 CONTINUE
- WRITE(LUNOUT,'(A,2A4)')
- & ' Cant find Idem for: ',KEYVEC
- GOTO 998
-51 CONTINUE
- ENDIF
-*
-C-- Trim the bank to its minimal size
- CALL MZPUSH(0,LQBKD,0,
- X IQ(KQSP+LQBKD+MBUSEQ)-IQWND(KQSP+LQBKD),'I')
- IQ(KQSP+LQBKD-5)=IHIDUP
- IF (IFLOPT(MPOSRQ).NE.0) THEN
-*---------- Write the bank description to the RZ file
-
-*----OTTO---
- KEYVEC(1) = IDBK
- KEYVEC(2) = IHIDUP
-* CALL RZLDIR(' ',' ')
- CALL RZOUT(0,LQBKD,KEYVEC,ICY,'.')
- IF (IQUEST(1).NE.0) THEN
- WRITE(LUNOUT,'(''0Problem Writing Bank '',
- X ''Descriptor '',A,'' to RZ file'')') CIDBK
- GO TO 998
- ENDIF
- CALL MZDROP(0,LQBKD,'.')
- LQBKD=0
- ENDIF
- IF(CARD(1:2).NE.'*B')THEN
- GO TO 999
- ELSE
- GO TO 10
- ENDIF
- ELSEIF(CARD(3:3).EQ.'.') THEN
-*---------- It is a command or continuation --> decode according
-*---------- characters 4 and 5
- CALL DZDCAR(ICARD,*998)
-
-*---OTTO-- look if its up-bank, set KEY(2) = up-bank
-
- IF(IDTAG .EQ. ITGUPQ)IHIDUP = IHTAG(1)
- IF(IDTAG .EQ. ITGIDQ)THEN
- IUIDEM = IHTAG(1)
- ENDIF
-
-*-- Still enough room in bank to include information ?
- IF(IQWND(KQSP+LQBKD)-IQ(KQSP+LQBKD+MBUSEQ).LT.MBPSHQ) THEN
- CALL MZPUSH(0,LQBKD,0,NBPSHQ,'I')
- ENDIF
-C-------- First descriptor card
- IF (ICONT.EQ.0) THEN
-*------ New card tag. Which is the new state identifier?
- IF (ISTATE.EQ.ISGENQ) THEN
-*---- General information: enter in front part of bank
- II = NBHEAQ + 1
- DO 200 I=1,99999
- IF(II-NBHEAQ.GT.IQ(KQSP+LQBKD+MBGENQ)) THEN
- GO TO 210
- ENDIF
-*-- Integer self-describing sector?
- IF (MOD(IQ(KQSP+LQBKD+II),JFOSEQ).NE.IFOINQ)
- X THEN
-*-- Not an integer self-describing sector --> skip
- II = II + IQ(KQSP+LQBKD+II)/JFOSEQ + 1
- IF(II-NBHEAQ.GT.IQ(KQSP+LQBKD+MBGENQ))THEN
- GO TO 210
- ELSE
- GO TO 200
- ENDIF
- ENDIF
-*-- Integer self-describing sector: look at card id.
- INTAG=IBITS(IQ(KQSP+LQBKD+II+1),ICHIDQ,NCHIDQ)
- IF (INTAG.NE.IDTAG) THEN
-*-- Not yet the id. needed --> continue
- II = II + IQ(KQSP+LQBKD+II)/JFOSEQ + 1
- IF(II-NBHEAQ.GT.IQ(KQSP+LQBKD+MBGENQ))THEN
- GO TO 210
- ELSE
- GO TO 200
- ENDIF
- ELSE
-*-- Duplicated tag
- WRITE(LUNOUT,
- X '(''0'',I6,3X,A,/,'' ?? Duplicated tag '',
- X A,'' Scan abandoned'')')
- X ICARD,CARD,CBKTAC(IDTAG)
- GO TO 998
- ENDIF
- 200 CONTINUE
-*-- Introduce new information
- 210 INSERT = II
-*-- Memorize tag sector for multiple choice bit
- ISTEER = II
-*-- Get the information to copy
- IQ(KQSP+LQBKD+INSERT+MBPATQ) = 0
- ITGTYP = IBKTAC(MBKAGQ,IDTAG)
- IF (ITGTYP.EQ.IBKAMQ) THEN
-*-- Number possible
- IF (INUM1.NE.INUTGQ) THEN
-*-- Fill the descriptor fields
- IQ(KQSP+LQBKD+INSERT+MBIX1Q) = INUM1
- ELSE
- IQ(KQSP+LQBKD+INSERT+MBIX1Q) = NWTAG
- IQ(KQSP+LQBKD+INSERT+MBPATQ) = 3
- ENDIF
- ELSEIF (ITGTYP.EQ.IBKANQ) THEN
-*-- Only text
- CONTINUE
- ELSE
-*-- Indicate length of tag
- IQ(KQSP+LQBKD+INSERT+MBPATQ) = ITGTYP
- ENDIF
-
-*-- Set the identifier flag
- CALL CBYT(IDTAG,1,
- X IQ(KQSP+LQBKD+INSERT+MBPATQ),ICHIDQ+1,NCHIDQ)
-* CALL MVBITS(IDTAG,0,NCHIDQ,
-* X IQ(KQSP+LQBKD+INSERT+MBPATQ),ICHIDQ)
-*-- Get the self-describing sector right
- IQ(KQSP+LQBKD+INSERT) = IFOINQ + JFOSEQ*(NBDSCQ-1)
-*-- Memorize the bitted pattern word
- IPAT = IQ(KQSP+LQBKD+INSERT+MBPATQ)
- INSERT = INSERT + NBDSCQ
-*-- Memorize the entry's address (for continuation)
- IICONT = INSERT
-*-- Flag to signal presence Hollerith data last tag
- ITGLST = 0
-*-- When there is tag info
- IF (IBITS(IPAT,ICHTGQ,NCHTGQ).NE.0) THEN
-*-- Nb. of words for tag field
- IF (ITGTYP.EQ.IBKAMQ) THEN
- NTAG = NWTAG
- ELSE
- NTAG = ITGTYP
- ENDIF
-*-- Hollerith word count
- IQ(KQSP+LQBKD+INSERT) = IFOHOQ+JFOSEQ*NTAG
- CALL UCOPY(IHTAG,IQ(KQSP+LQBKD+INSERT+1),NTAG)
- ITGLST = NTAG + 1
- INSERT = INSERT + ITGLST
- ENDIF
- IF (NWTXT.GT.0) THEN
-*-- Hollerith word count
- IF (ITGLST.EQ.0) THEN
- IQ(KQSP+LQBKD+INSERT) =IFOHOQ+JFOSEQ*NWTXT
- ITGLST = 1
- INSERT = INSERT + 1
- ELSE
- IQ(KQSP+LQBKD+IICONT) =
- X IQ(KQSP+LQBKD+IICONT) + JFOSEQ*NWTXT
- ENDIF
- CALL UCOPY(IHTXT,IQ(KQSP+LQBKD+INSERT),NWTXT)
- ITGLST = ITGLST + NWTXT
- INSERT = INSERT + NWTXT
- ENDIF
-*-- Update the number of words in use
- IQ(KQSP+LQBKD+MBUSEQ) = IQ(KQSP+LQBKD+MBUSEQ) +
- X INSERT - II
- IQ(KQSP+LQBKD+MBGENQ) = IQ(KQSP+LQBKD+MBGENQ) +
- X INSERT - II
- ELSE
-*------ Link, status-bits or data description
- IF (ISTOLD.NE.ISTATE) THEN
-*-- Start of new description
- 250 IF (ISTATE.EQ.ISLINQ) THEN
- IF (IQ(KQSP+LQBKD+MBLINQ).NE.0) THEN
- WRITE(LUNOUT,
- X '(''0'',I6,3X,A,/,'' ?? Duplicated '',
- X ''link descriptor'',
- X '' -- scan abandoned'')') ICARD,CARD
- GO TO 998
- ELSEIF ((IQ(KQSP+LQBKD+MBRLIQ).NE.0).OR.
- X (IQ(KQSP+LQBKD+MBBITQ).NE.0).OR.
- X (IQ(KQSP+LQBKD+MBDATQ).NE.0)) THEN
- WRITE(LUNOUT,
- X '(''0'',I6,3X,A,/,'' ?? LINK '',
- X ''descriptor out of order'',
- X '' -- scan abandoned'')') ICARD,CARD
- GO TO 998
- ENDIF
- INSERT = NBHEAQ + IQ(KQSP+LQBKD+MBGENQ) + 1
- ELSEIF (ISTATE.EQ.ISRLIQ) THEN
- IF (IQ(KQSP+LQBKD+MBRLIQ).NE.0) THEN
- WRITE(LUNOUT,
- X '(''0'',I6,3X,A,/,'' ?? Duplicated '',
- X ''ref link descriptor -- '',
- X ''scan abandoned'')') ICARD,CARD
- GO TO 998
- ELSEIF ((IQ(KQSP+LQBKD+MBDATQ).NE.0) .OR.
- X (IQ(KQSP+LQBKD+MBBITQ).NE.0))THEN
- WRITE(LUNOUT,
- X '(''0'',I6,3X,A,/,'' ?? RefLink desc'',
- X '' out of order - scan abandoned'')')
- X ICARD,CARD
- GO TO 998
- ENDIF
- INSERT = NBHEAQ + IQ(KQSP+LQBKD+MBGENQ) +
- X IQ(KQSP+LQBKD+MBLINQ) + 1
- ELSEIF (ISTATE.EQ.ISBITQ) THEN
- IF (IQ(KQSP+LQBKD+MBBITQ).NE.0) THEN
- WRITE(LUNOUT,
- X '(''0'',I6,3X,A,/,'' ?? Duplicated '',
- X ''status bit descriptor -- '',
- X ''scan abandoned'')') ICARD,CARD
- GO TO 998
- ELSEIF (IQ(KQSP+LQBKD+MBDATQ).NE.0) THEN
- WRITE(LUNOUT,
- X '(''0'',I6,3X,A,/,'' ?? BIT descriptor'',
- X '' out of order - scan abandoned'')')
- X ICARD,CARD
- GO TO 998
- ENDIF
- INSERT = NBHEAQ + IQ(KQSP+LQBKD+MBGENQ) +
- X IQ(KQSP+LQBKD+MBRLIQ) +
- X IQ(KQSP+LQBKD+MBLINQ) + 1
- ELSEIF (ISTATE.EQ.ISDATQ) THEN
- IF (IQ(KQSP+LQBKD+MBDATQ).NE.0) THEN
- WRITE(LUNOUT,
- X '(''0'',I6,3X,A,/,'' ?? Duplicated '',
- X ''data part descriptor -- '',
- X ''scan abandoned'')') ICARD,CARD
- GO TO 998
- ENDIF
- INSERT = NBHEAQ + IQ(KQSP+LQBKD+MBGENQ) +
- X IQ(KQSP+LQBKD+MBLINQ) +
- X IQ(KQSP+LQBKD+MBRLIQ) +
- X IQ(KQSP+LQBKD+MBBITQ) + 1
- ELSE
- WRITE(LUNOUT,
- X '(''0'',I6,3X,A,/,'' ?? Invalid state '',
- X I3)') ISTATE
- GO TO 500
- ENDIF
-*-- Memorize and zero state variables
- IREPLO = 0
- IREPLV = 0
- ISTOLD = ISTATE
- GO TO 500
- ENDIF
-*-- Get the information to copy
- II = INSERT
-*-- For repetition series
- IF (IREPLV.GT.IREPLO) THEN
-*-- Repetition field descriptor
- IQ(KQSP+LQBKD+INSERT+MBPATQ) = 0
-*-- Fill the descriptor fields
- IF (INUM1.NE.INUTGQ) THEN
-*-- Actual number
- IQ(KQSP+LQBKD+INSERT+MBIX1Q) = INUM1
- ELSE
-*-- Text field
- IQ(KQSP+LQBKD+INSERT+MBIX1Q)=-JFOSEQ*NWTAG
- ENDIF
-*-- Set the identifier flag
- CALL CBYT(IDTAG,1,
- & IQ(KQSP+LQBKD+INSERT+MBPATQ), ICHIDQ+1,NCHIDQ)
-*-- and introduce the repetition level
- CALL CBYT(IREPLV,1,
- X IQ(KQSP+LQBKD+INSERT+MBPATQ),IRPLVQ+1,NRPLVQ)
-*-- Get the self-describing sector right
- IQ(KQSP+LQBKD+INSERT)=IFOINQ+JFOSEQ*(NBDSCQ-1)
- INSERT = INSERT + NBDSCQ
- IICONT = INSERT
- IF (INUM1.EQ.INUTGQ) THEN
-*-- Hollerith word count
- IQ(KQSP+LQBKD+INSERT) = IFOHOQ+JFOSEQ*NWTAG
- INSERT = INSERT + 1
- CALL UCOPY
- X (IHTAG,IQ(KQSP+LQBKD+INSERT),NWTAG)
- INSERT = INSERT + NWTAG
- ITGLST = NWTAG + 1
- ELSE
- ITGLST = 0
- ENDIF
- IF (NWTXT.GT.0) THEN
-*-- Hollerith word count
- IF (ITGLST.EQ.0) THEN
- IQ(KQSP+LQBKD+INSERT) =IFOHOQ+JFOSEQ*NWTXT
- ITGLST = 1
- INSERT = INSERT + 1
- ELSE
- IQ(KQSP+LQBKD+IICONT) =
- X IQ(KQSP+LQBKD+IICONT) + JFOSEQ*NWTXT
- ENDIF
- CALL UCOPY
- X (IHTXT,IQ(KQSP+LQBKD+INSERT),NWTXT)
- ITGLST = ITGLST + NWTXT
- INSERT = INSERT + NWTXT
- ENDIF
- IREPLO = IREPLV
- ELSE
-*-- Memorize tag sector for multiple choice bit
- ISTEER = INSERT
-*-- Fill out the tag fields
- IQ(KQSP+LQBKD+INSERT+MBPATQ) = NWTENQ
- IQ(KQSP+LQBKD+INSERT+MBIX1Q) = INUM1
- IQ(KQSP+LQBKD+INSERT+MBIX2Q) = INUM2
-*-- Introduce the tag identifier
- CALL CBYT(IDTAG,1,
- X IQ(KQSP+LQBKD+INSERT+MBPATQ),ICHIDQ+1,NCHIDQ)
-
-*-- and introduce the repetition level
- CALL CBYT(IREPLV,1,
- X IQ(KQSP+LQBKD+INSERT+MBPATQ),IRPLVQ+1,NRPLVQ)
-*-- Get the self-describing sector right
- IQ(KQSP+LQBKD+INSERT) = IFOINQ +
- X JFOSEQ*(NBDSCQ-1)
- INSERT = INSERT + NBDSCQ
-*-- Memorize the entry's address (for continuation)
- IICONT = INSERT
-*-- Nb. of words for tag field
-*-- Hollerith word count
- IQ(KQSP+LQBKD+INSERT) = IFOHOQ+JFOSEQ*NWTENQ
- CALL UCOPY
- X (IHTAG,IQ(KQSP+LQBKD+INSERT+1),NWTENQ)
- ITGLST = NWTENQ + 1
- INSERT = INSERT + ITGLST
-*-- Entries with non-numeric fields
- IF (INUM1.LE.-JFOSEQ) THEN
- NWN1 = -INUM1/JFOSEQ
- IQ(KQSP+LQBKD+IICONT) =
- X IQ(KQSP+LQBKD+IICONT) - INUM1
- CALL UCOPY
- X (IHNUM1,IQ(KQSP+LQBKD+INSERT),NWN1)
- ITGLST = ITGLST + NWN1
- INSERT = INSERT + NWN1
- ENDIF
- IF (INUM2.LE.-JFOSEQ) THEN
- NWN2 = -INUM2/JFOSEQ
- IQ(KQSP+LQBKD+IICONT) =
- X IQ(KQSP+LQBKD+IICONT) - INUM2
- CALL UCOPY
- X (IHNUM2,IQ(KQSP+LQBKD+INSERT),NWN2)
- ITGLST = ITGLST + NWN2
- INSERT = INSERT + NWN2
- ENDIF
- IF (NWTXT.GT.0) THEN
-*-- Hollerith word count
- IQ(KQSP+LQBKD+IICONT) =
- X IQ(KQSP+LQBKD+IICONT) + JFOSEQ*NWTXT
- CALL UCOPY
- X (IHTXT,IQ(KQSP+LQBKD+INSERT),NWTXT)
- ITGLST = ITGLST + NWTXT
- INSERT = INSERT + NWTXT
- ENDIF
- ENDIF
-*-- Update the number of words in use
- IQ(KQSP+LQBKD+MBUSEQ) =
- X IQ(KQSP+LQBKD+MBUSEQ) + INSERT - II
- IQ(KQSP+LQBKD+MBGENQ+ISTATE-1) =
- X IQ(KQSP+LQBKD+MBGENQ+ISTATE-1) + INSERT - II
- ENDIF
-*-- Memorize the presence or otherwise of a closing '/'
- IISLSH = ISLASH
- ELSE
-*-- Continuation card
- IF (NWTXT.EQ.0) GO TO 500
- INSERT = IICONT
- NWPREV = ITGLST
-*-- Was there already text written?
- IF (ITGLST.EQ.0) THEN
- IQ(KQSP+LQBKD+INSERT) = IFOHOQ+JFOSEQ*NWTXT
- INSERT = INSERT + 1
- ITGLST = 1
- ELSE
- INSERT = INSERT + ITGLST
- IF (IISLSH.NE.0 .OR. LFORCE.NE.0) THEN
-*-- Line feed desired --> add special word
- IQ(KQSP+LQBKD+INSERT) = IILFLF
- IQ(KQSP+LQBKD+IICONT) =
- X IQ(KQSP+LQBKD+IICONT) + JFOSEQ
- INSERT = INSERT + 1
- ITGLST = ITGLST + 1
- ENDIF
- IQ(KQSP+LQBKD+IICONT) =
- X IQ(KQSP+LQBKD+IICONT) + JFOSEQ*NWTXT
- ENDIF
- CALL UCOPY(IHTXT,IQ(KQSP+LQBKD+INSERT),NWTXT)
- ITGLST = ITGLST + NWTXT
- INSERT = INSERT + NWTXT
-*-- Memorize the presence or otherwise of a closing '/'
- IISLSH = ISLASH
-*-- Update the number of words in use
- IQ(KQSP+LQBKD+MBUSEQ) = IQ(KQSP+LQBKD+MBUSEQ) +
- X INSERT - (IICONT+NWPREV)
- IQ(KQSP+LQBKD+MBGENQ+ISTATE-1) =
- X IQ(KQSP+LQBKD+MBGENQ+ISTATE-1) +INSERT-(IICONT+NWPREV)
- ENDIF
- GO TO 500
- ELSEIF(CARD(3:3).EQ.'/') THEN
-*---------- It is a end of sequence indicator -> decode according
-*---------- characters 4 and 5 and take appropriate action
- ICONT = 0
- CALL DZDEOS(*998)
- IF (IREPLV.LT.IREPLO) THEN
-*-- Decrease of repetition level
- IPAT = 0
-*-- Set the End Of Sequence bit
- IQ(KQSP+LQBKD+INSERT+MBPATQ) = IBSET(IPAT,IBEOSQ)
-*-- Introduce the tag identifier
- CALL CBYT(ITGREQ,1,
- X IQ(KQSP+LQBKD+INSERT+MBPATQ),ICHIDQ+1,NCHIDQ)
-* CALL MVBITS(ITGREQ,0,NCHIDQ,
-* X IQ(KQSP+LQBKD+INSERT+MBPATQ),ICHIDQ)
-*-- and introduce the repetition level
- CALL CBYT(IREPLV,1,
- X IQ(KQSP+LQBKD+INSERT+MBPATQ),IRPLVQ+1,NRPLVQ)
-* CALL MVBITS(IREPLV,0,NRPLVQ,
-* X IQ(KQSP+LQBKD+INSERT+MBPATQ),IRPLVQ)
-*-- Get the self-describing sector right
- IQ(KQSP+LQBKD+INSERT) = IFOINQ + JFOSEQ*(NBEOSQ-1)
- INSERT = INSERT + NBEOSQ
- IREPLO = IREPLV
-*-- Update the number of words in use
- IQ(KQSP+LQBKD+MBUSEQ) = IQ(KQSP+LQBKD+MBUSEQ) + NBEOSQ
- IQ(KQSP+LQBKD+MBGENQ+ISTATE-1) =
- X IQ(KQSP+LQBKD+MBGENQ+ISTATE-1) + NBEOSQ
- ENDIF
- ELSEIF(CARD(3:3).EQ.'=') THEN
-*---------- Multiple choice for single entry
- ICONT = 0
-*-- Check whether choice possible for entry
- IF(IBKTAC(MBKAHQ,IDTAG).EQ.IBKAYQ.OR.ISTATE.NE.ISGENQ)THEN
-*-- OK -- Set choice bit
- IPAT = IQ(KQSP+LQBKD+ISTEER+MBPATQ)
- IQ(KQSP+LQBKD+ISTEER+MBPATQ) = IBSET(IPAT,ICHBTQ)
-*-- Parse the input first input line
- ELSE
-*-- Choice not allowed
- WRITE(LUNOUT,'(''0'',I6,3X,A,/,
- X '' ?? No choice allowed for present tag -- '',
- X ''scan abandoned'')') ICARD,CARD
- GO TO 998
- ENDIF
-*-- Decode the first line of input for the multiple choice
- IF (ISTATE.EQ.ISGENQ) THEN
- IDECOD = IBKTAC(MBKAGQ,IDTAG)
- IF (IDECOD.EQ.IBKANQ) THEN
-*-- Text only
- CALL DZD00T
- ELSEIF(IDECOD.EQ.IBKAMQ) THEN
-*-- Number field
- CALL DZD0NT
- ELSE
-*-- Standard tag field
- CALL DZD0TT
- ENDIF
- ELSE
-*-- Standard tag field
- CALL DZD0TT
- ENDIF
-*-- Memorize the entry's address (for continuation)
- IICONT = INSERT
-*-- Nb. of words for tag field (Hollerith word count)
- IQ(KQSP+LQBKD+INSERT) = IFOHOQ+JFOSEQ*NWTENQ
- CALL UCOPY(IHTAG,IQ(KQSP+LQBKD+INSERT+1),NWTENQ)
- ITGLST = NWTENQ + 1
- INSERT = INSERT + ITGLST
- IF (NWTXT.GT.0) THEN
-*-- Hollerith word count
- IQ(KQSP+LQBKD+IICONT) = IQ(KQSP+LQBKD+IICONT)
- X + JFOSEQ*NWTXT
- CALL UCOPY(IHTXT,IQ(KQSP+LQBKD+INSERT),NWTXT)
- ITGLST = ITGLST + NWTXT
- INSERT = INSERT + NWTXT
- ENDIF
-*-- Update the number of words in use
- IQ(KQSP+LQBKD+MBUSEQ) =IQ(KQSP+LQBKD+MBUSEQ)+INSERT-IICONT
- IQ(KQSP+LQBKD+MBGENQ+ISTATE-1) =
- X IQ(KQSP+LQBKD+MBGENQ+ISTATE-1) + INSERT - IICONT
-*-- Memorize the presence or otherwise of a closing '/'
- IISLSH = ISLASH
- ELSE
-*---------- Abnormal end (unrecognized card)
-*---------- Generate end of bank descriptor exit
- WRITE(LUNOUT,'(''0?? ? The following card interrupts a '',
- X ''valid bank descriptor sequence since it is not of '',
- X ''the form *B. or *B/ in columns 1/3'',/,1X,A)') CARD
- GO TO 600
- ENDIF
- 500 CONTINUE
-
-*-- End of present bank descriptor
-*-- Finalize bank entry and return
-
- 600 CONTINUE
-*-- NORMAL EXIT
- GO TO 999
-*-- ABNORMAL END
- 998 CONTINUE
- WRITE(LUNOUT,'(A,A)')' Previous error occured in: ',CIDBK
- RETURN 1
- 999 RETURN IRETUR
- END
diff --git a/src/graflib/dzdoc/dzdkern/dzdcar.F b/src/graflib/dzdoc/dzdkern/dzdcar.F
deleted file mode 100644
index 076107d..0000000
--- a/src/graflib/dzdoc/dzdkern/dzdcar.F
+++ /dev/null
@@ -1,138 +0,0 @@
-*
-* $Id: dzdcar.F,v 1.1.1.1 1996/03/04 16:12:54 mclareni Exp $
-*
-* $Log: dzdcar.F,v $
-* Revision 1.1.1.1 1996/03/04 16:12:54 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDCAR(ICARD,*)
-************************************************************************
-*. *
-*...DZDCAR interprets the tag fields of the bank descriptor cards *
-*. *
-*. Characters 4 and 5 of the input line are tested against all possible*
-*. tags. If a valid tag is found, consistency checks are made. *
-*. If no valid tag line interpretation is possible, the line is treated*
-*. as a continuation line of the previous tag with pure text. *
-*. *
-*. INPUT: *
-*. ------ *
-*. ICARD : Integer containing sequence number of card being read *
-*. *
-*. CALLS : DZD0NT,DZD0TT,DZD00T,DZDNUM,UCTOH,VBLANK *
-*. CALLED : DZDBKC *
-*. COMMON : DZDINC,DZDTAP,DZDTYP *
-*. *
-*. AUTHOR : M. Goossens DD/US *
-*. VERSION : 2.01(22) / 27 Aug 1986 *
-*. *
-*.**********************************************************************
- SAVE
-#include "dzdoc/bkstparq.inc"
-#include "dzdoc/bktgparq.inc"
-#include "dzdoc/bkwrp.inc"
-#include "dzdoc/tapes.inc"
- CHARACTER CTAG*2
-#include "dzdoc/bktgdatq.inc"
- 1001 CONTINUE
- ISLASH = 0
- CALL VBLANK(IHTAG,LNCAR4)
- CALL VBLANK(IHTXT,LNCAR4)
-
- IF (CARD(4:4).EQ.' ') THEN
-*-- Continuation field
-
-*-- Get first and last non-blank characters and fill IHTXT vector
-
- ITXBEG = INDEXC(CARD(5:),' ') + 4
- IF (ITXBEG.EQ.4) THEN
-C- Empty text field
- NWTXT = 0
- NWTXT = 0
- ELSE
-*-- If user defined line-feed respect his layout
-*Otto 21-jul-89
-**
-* IF (IISLSH.NE.0) THEN
-* ITXBEG = 5
-* ELSE
-*-- Force at least one blank before first word
- ITXBEG = ITXBEG - 1
-* ENDIF
- ITXEND = INDXBC(CARD,' ')
- NHTXT = ITXEND - ITXBEG + 1
- NWTXT = (NHTXT+3)/4
- CALL UCTOH(CARD(ITXBEG:),IHTXT,4,NHTXT)
- IF (CARD(ITXEND:ITXEND).EQ.'/') THEN
- ISLASH = 1
- ELSE
- ISLASH = 0
- ENDIF
- ENDIF
- NWTAG = 0
- NWTAG = 0
- ICONT = 1
- GO TO 999
- ENDIF
-
-*-- Loop over possible tags to choose the one needed
-
- ICONT = 0
- CTAG = CARD(4:5)
- DO 100 I=1,ITGIDQ
- IF (CTAG.EQ.CBKTAC(I)) THEN
-*-- Get state
- IF (IBKTAC(MBKASQ,I).EQ.ISREPQ) THEN
-C- Increment rep level
- IF (IREPLV.EQ.IRLVMQ) THEN
- WRITE(LUNOUT,'(''0'',I6,3X,A,/,
- X '' ??Too many (>10) repetition levels '',
- X ''-- scan abandoned'')') ICARD,CARD
- GO TO 998
- ENDIF
- IREPLV = IREPLV + 1
- ELSEIF (IBKTAC(MBKASQ,I).EQ.ISCHOQ) THEN
-C- Flag start of choice section
- ISCHLO = 0
- ELSE
-C- Reinitialize ISTATE
- ISTATE = IBKTAC(MBKASQ,I)
- ENDIF
- IDTAG = I
- IDECOD = IBKTAC(MBKAGQ,I)
- IF (IDECOD.EQ.IBKANQ) THEN
-C- Text only
- CALL DZD00T
- ELSEIF(IDECOD.EQ.IBKAMQ) THEN
-C- Number field
- CALL DZD0NT
- ELSEIF(IDECOD.EQ.IBKASQ) THEN
-C- Special decoding required
- CONTINUE
- ELSE
-C- Standard tag field
- CALL DZD0TT
- ENDIF
- GO TO 999
- ENDIF
- 100 CONTINUE
-
-*-- Fallen through DO loop --> it should be a description of entries
-
- IF (ISTATE.GT.ISGENQ) THEN
- CALL DZDNUM(*998)
- IDTAG = ITGENQ
-C- Standard tag field
- CALL DZD0TT
- GO TO 999
- ELSE
- WRITE(LUNOUT,'(''0'',I6,3X,A,/,
- X '' ?? Invalid tag '',A,
- X '' -- scan abandoned'')') ICARD,CARD,CTAG
- GO TO 998
- ENDIF
-
- 998 RETURN 1
- 999 END
diff --git a/src/graflib/dzdoc/dzdkern/dzdco1.F b/src/graflib/dzdoc/dzdkern/dzdco1.F
deleted file mode 100644
index 55f9a13..0000000
--- a/src/graflib/dzdoc/dzdkern/dzdco1.F
+++ /dev/null
@@ -1,214 +0,0 @@
-*
-* $Id: dzdco1.F,v 1.1.1.1 1996/03/04 16:12:56 mclareni Exp $
-*
-* $Log: dzdco1.F,v $
-* Revision 1.1.1.1 1996/03/04 16:12:56 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDCO1(CHKEY,IFLAG,CHOPTI,CHPRE,LUN,IFI,ILI)
- CHARACTER*8 CHKEY,CHBANK,CHOPT
- CHARACTER*(*) CHOPTI,CHPRE
-* IFLAG: 1 make keeps for INTEGER declarations
-* 2 continue INTEGER decl
-* 3 make keeps for booking +KEEP..
-* 4 contiue booking no +KEEP..
-* 5 COMMON with header
-* 6 continue COMMON
-* 7 make keeps for MMIDBK fill bank descriptor v
-* 8 continue with MMIDBK
-* 13 gen MZLIFT instead of MZBOOK
-* 14 continue MZLIFT
-* CHOPT: 'I' Integer declarations for booking
-* 'C' Common statements for booking
-* 'B' calls to MZBOOK
-* 'L' Integer declarations for linkoffsets
-* 'P' Parameter statements for linkoffsets
-* 'A' link assigment statements
-* 'K' keep seq for data word offsets
-* 'D' Integer decl for data word offsets
-* 'O' Parameter statements for data word offsets
-* 'N' follow next links
-
- INTEGER KEY(2),KEYI(2)
-#include "dzdoc/bkwrp.inc"
-*----
- CALL UCTOH(CHKEY,KEY,4,8)
- NC=MIN(LNBLNK(CHOPTI),8)
- CHOPT=CHOPTI(1:NC)
- CALL DZDPIN(KEY,'RBG')
- IF(IQUEST(1) .NE. 0)THEN
- WRITE(LUN,*)'* ',CHKEY,' not found'
- GOTO 999
- ENDIF
- LDOC = IQUEST(11)
-* IDHTB=KEY(1)
- CHBANK = CHKEY
- CALL CLTOU(CHBANK)
- ILCP=MAX(INDXBC(CHPRE,' '),1)
-
-* top bank
-
- CALL DZDLFT(LDOC,LLTOP,LT,1)
- IF (IFLAG.LT.100)THEN
- CALL DZDBK1(CHBANK,LUN,IFLAG)
- ELSEIF(IFLAG.GE.101 .AND. IFLAG.LE.102)THEN
- CALL DZDLO1(CHBANK,CHPRE,LUN,IFLAG-100)
- ELSEIF(IFLAG.GE.103 .AND. IFLAG.LE.104)THEN
- CALL DZDLO1(CHBANK,CHPRE,LUN,IFLAG-100)
- ELSEIF(IFLAG.EQ.105)THEN
- ILCB=INDXBC(CHBANK(1:4),' ')
- ILCU=INDXBC(CHBANK(5:8),' ')+4
- WRITE(LUN,'(A)')'+KEEP,LASS'//CHBANK(1:ILCB)
- IF(CHBANK(5:8).NE.'NONE')WRITE(LUN,'(6X,10A)')
- & 'L',CHBANK(1:ILCB),'=LQ(L',CHBANK(5:ILCU)
- & ,'-',CHPRE(1:ILCP),CHBANK(1:ILCB),')'
- ELSEIF(IFLAG .EQ. 201)THEN
- NKEEPS = 0
- CALL DZDDOC(0,0,CHBANK,'KD'//CHOPT,
- & IFI,ILI,LUN,CHPRE,NKEEPS)
- ELSEIF(IFLAG .EQ. 203)THEN
- NKEEPS = 0
- CALL DZDDOC(0,0,CHBANK,'KO'//CHOPT,
- & IFI,ILI,LUN,CHPRE,NKEEPS)
- ENDIF
-
- IF(INDEX(CHOPT,'T').EQ.0)GOTO 999
-
-150 CONTINUE
-*
-*
-* init links
-*
- LORIG = LT
- LUP = LT
- L = LT
-
-* get next down link
-
-11 CONTINUE
- JB = LUP - LORIG + 1
- NS = IQ(KQSP+LUP-2)
-*
-12 CONTINUE
- IF(JB .LE. NS)THEN
-
- IDHD = IQ(KQSP+LDOC+10+JB)
- IF(IDHD .NE. 0)THEN
- KEYI(1) = IDHD
- KEYI(2) = IQ(KQSP+LDOC+7)
- CALL DZDPIN(KEYI,'RGB')
- IF(IQUEST(1) .NE. 0)THEN
- JB=JB+1
- GOTO 12
- ELSE
- LDOC= IQUEST(11)
- CALL DZDLFT(LDOC,L,LD,-JB)
- CALL UHTOC(KEYI,4,CHBANK,8)
- IF (IFLAG.LT.100)THEN
- CALL DZDBK1(CHBANK,LUN,IFLAG+1)
- ELSEIF(IFLAG.GE.101 .AND. IFLAG.LE.104)THEN
- CALL DZDLO1(CHBANK,CHPRE,LUN,IFLAG-100+1)
- ELSEIF(IFLAG.EQ.105)THEN
- ILCB=INDXBC(CHBANK(1:4),' ')
- ILCU=INDXBC(CHBANK(5:8),' ')+4
- WRITE(LUN,'(6X,10A)')
- & 'L',CHBANK(1:ILCB),'=LQ(L',CHBANK(5:ILCU)
- & ,'-',CHPRE(1:ILCP),CHBANK(1:ILCB),')'
- ELSEIF(IFLAG .EQ. 201)THEN
- CALL DZDDOC(0,0,CHBANK,'KD'//CHOPT,
- & IFI,ILI,LUN,CHPRE,NKEEPS)
- ELSEIF(IFLAG .EQ. 203)THEN
- CALL DZDDOC(0,0,CHBANK,'KO'//CHOPT,
- & IFI,ILI,LUN,CHPRE,NKEEPS)
- ENDIF
-* has it a next bank?
- IDHN = IQ(KQSP+LDOC+10)
- IF(IDHN.NE.0 .AND. INDEX(CHOPT,'N').NE.0)THEN
- KEYI(1) = IDHN
- CALL DZDPIN(KEYI,'RGB')
- IF(IQUEST(1).EQ.0)THEN
- LDOC=IQUEST(11)
- CALL UHTOC(KEYI,4,CHBANK,8)
- CALL DZDLFT(LDOC,LD,LN,0)
- IF (IFLAG.LT.100)THEN
- CALL DZDBK1(CHBANK,LUN,IFLAG+1)
- ELSEIF(IFLAG.GE.101 .AND. IFLAG.LE.104)THEN
- CALL DZDLO1(CHBANK,CHPRE,LUN,IFLAG-99)
- ELSEIF(IFLAG.EQ.105)THEN
- ILCB=INDXBC(CHBANK(1:4),' ')
- ILCU=INDXBC(CHBANK(5:8),' ')+4
- WRITE(LUN,'(6X,10A)')
- & 'L',CHBANK(1:ILCB),'=LQ(L',
- & CHBANK(5:ILCU)
- & ,'-',CHPRE(1:ILCP),CHBANK(1:ILCB),')'
- ELSEIF(IFLAG .EQ. 201)THEN
- CALL DZDDOC(0,0,CHBANK,'KD'//CHOPT,
- & IF1,IL1,LUN,CHPRE,NKEEPS)
- ELSEIF(IFLAG .EQ. 203)THEN
- CALL DZDDOC(0,0,CHBANK,'KO'//CHOPT,
- & IF1,IL1,LUN,CHPRE,NKEEPS)
- ENDIF
- ENDIF
- ENDIF
- ENDIF
- ELSE
- JB=JB+1
- GOTO 12
- ENDIF
-
-* go down
-
- LUP = LD
- LORIG = LD
- L = LD
- GOTO 11
- ENDIF
-
-* look if it is end of a linear structure
-* i.e. origin and up link are in different banks
-
-13 CONTINUE
- LUP = LQ(KQSP+L+1)
- LORIG = LQ(KQSP+L+2)
-
-* look if back at top bank
-
- IF(LUP .LE. 1) GOTO 14
-* IF(IQ(KQSP+LUP-4).EQ.IDHUP .AND. IQ(KQSP+L-4).EQ.IDHTB)GOTO 14
-
- NSU = IQ(KQSP+LUP-2)
- IF(LORIG .GE. LUP .OR. LORIG .LT. LUP-NSU)THEN
-
-* its different, step back
-
- L = LORIG
- GOTO 13
- ENDIF
-
-* go up
-
- L = LUP
- LUU = LQ(KQSP+L+1)
- IF(LUU .LE. 2)THEN
- KEYI(2) = KEY(2)
- ELSE
- KEYI(2) = IQ(KQSP+LUU-4)
- ENDIF
- KEYI(1) = IQ(KQSP+L-4)
- CALL DZDPIN(KEYI,'RGB')
- LDOC = IQUEST(11)
- GOTO 11
-
-* all done, but top bank
-
-14 CONTINUE
-999 CONTINUE
- IF(LLTOP.NE.0)THEN
- CALL MZDROP(0,LLTOP,'L')
- LLTOP=0
- ENDIF
- END
-
-********************************************************************
diff --git a/src/graflib/dzdoc/dzdkern/dzdcod.F b/src/graflib/dzdoc/dzdkern/dzdcod.F
deleted file mode 100644
index 31fd498..0000000
--- a/src/graflib/dzdoc/dzdkern/dzdcod.F
+++ /dev/null
@@ -1,128 +0,0 @@
-*
-* $Id: dzdcod.F,v 1.1.1.1 1996/03/04 16:12:56 mclareni Exp $
-*
-* $Log: dzdcod.F,v $
-* Revision 1.1.1.1 1996/03/04 16:12:56 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDCOD(CHBANK,CWHATI,CHOPT,CHPRE,LUN,IFI,ILI)
- CHARACTER*8 CHBANK
- CHARACTER*4 CWHATI,CWHAT
- CHARACTER*(*) CHOPT,CHPRE
-
- CHARACTER*2 CHOINT
-
-* CWHAT: 'BANK', 'LINK', 'DATA'
-
-* CHOPT: 'B' mzbook 'BANK'
-* 'L' mzlift 'BANK'
-* 'A' 'LINK' assignments
-* 'O' 'DATA' word offsets or 'LINK' offsets
-* 'N' no parameter statements
-* 'T' do it for a bank tree
-* '2' skip first 2 char for data words
-* 'R' put REAL
-* 'C' put COMMON/CO..../
-* 'H' piut CALL HBNAME...
-
-* IFLAG: 1 - 99 things concerning 'BANK'
-
-* 1 make keeps for INTEGER declarations
-* 2 continue INTEGER decl
-* 3 make keeps for booking +KEEP..
-* 4 contiue booking no +KEEP..
-* 5 COMMON with header
-* 6 continue COMMON
-* 7 make INTEGER for MMIDBK bank descriptor vector
-* 8 continue with MMIDBK
-* 9 make COMMON for MMIDBK
-* 10 continue with MMIDBK
-* 11 fill bank descriptor vector MMIDBK
-* 12 continue with MMIDBK
-* 13 gen MZLIFT instead of MZBOOK
-* 14 continue MZLIFT
-*
-* 101 - 199 things concerning 'LINK'
-
-* 101 INTEGER decl start
-* 102 continue
-* 103 PARAMETER start
-* 104 continue
-* 105 link assignments start
-* 106 continue
-*
-* 201 - 299 things concerning 'DATA'
-
-* 201 data word offsets INTEGER decl
-* 203 PARAMETER
-
- IF(INDEX(CHOPT,'T').GT.0)THEN
- CHOINT='T'
- ELSE
- CHOINT='S'
- ENDIF
- CWHAT=CWHATI
- CALL CLTOU(CWHAT)
- IF(CWHAT.EQ.'BANK')THEN
-
-* do INTEGER declarations (links)
- CALL DZDCO1(CHBANK,1,CHOINT,' ',LUN,IFI,ILI)
-* finish line with decl
- CALL DZDPLN(LUN,' ',99)
-* COMMON declarations (links)
- CALL DZDCO1(CHBANK,5,CHOINT,' ',LUN,IFI,ILI)
-* finish line
- CALL DZDPLN(LUN,' ',99)
- IF(INDEX(CHOPT,'L').NE.0)THEN
-* do INTEGER decl for MMIDBK
- CALL DZDCO1(CHBANK,7,CHOINT,' ',LUN,IFI,ILI)
- CALL DZDPLN(LUN,' ',99)
-* do COMMON decl for MMIDBK
- CALL DZDCO1(CHBANK,9,CHOINT,' ',LUN,IFI,ILI)
- CALL DZDPLN(LUN,' ',99)
-* fill MMIDBK
- CALL DZDCO1(CHBANK,11,CHOINT,' ',LUN,IFI,ILI)
- CALL DZDPLN(LUN,' ',99)
-* do MZLIFTs
- CALL DZDCO1(CHBANK,13,CHOINT,' ',LUN,IFI,ILI)
- CALL DZDPLN(LUN,' ',99)
- ELSE
-* do MZBOOKS
- CALL DZDCO1(CHBANK,3,CHOINT,' ',LUN)
-* finish line with bookings
- CALL DZDPLN(LUN,' ',99)
- ENDIF
- ELSEIF(CWHAT.EQ.'LINK')THEN
- IF(INDEX(CHOPT,'O').NE.0)THEN
-* INTEGER statement (Linkoffsets)
- CALL DZDCO1(CHBANK,101,CHOINT,CHPRE,LUN,IFI,ILI)
-* finish line
- CALL DZDPLN(LUN,' ',99)
-* PARAMETER statement
- CALL DZDCO1(CHBANK,103,CHOINT,CHPRE,LUN,IFI,ILI)
-* finish line
- CALL DZDPLN(LUN,')',1)
- CALL DZDPLN(LUN,' ',99)
- ELSEIF(INDEX(CHOPT,'A').NE.0)THEN
-* link assignment statements
- CALL DZDCO1(CHBANK,105,CHOINT,CHPRE,LUN,IFI,ILI)
- ENDIF
- ELSEIF(CWHAT.EQ.'DATA')THEN
-* data word offsets INTEGER statements
- CALL DZDCO1(CHBANK,201,CHOPT,CHPRE,LUN,IFI,ILI)
- CALL DZDPLN(LUN,' ',99)
-* data word offsets PARAMETER
- IF(INDEX(CHOPT,'N').EQ.0 .AND.
- + INDEX(CHOPT,'=').EQ.0 .AND.
- + INDEX(CHOPT,'C').EQ.0 .AND.
- + INDEX(CHOPT,'H').EQ.0 )THEN
- CALL DZDCO1(CHBANK,203,CHOPT,CHPRE,LUN,IFI,ILI)
- CALL DZDPLN(LUN,')',1)
- CALL DZDPLN(LUN,' ',99)
- ENDIF
- ENDIF
- CALL DZDPLN(0,' ',0)
- END
-***********************************************************************
diff --git a/src/graflib/dzdoc/dzdkern/dzdcrd.F b/src/graflib/dzdoc/dzdkern/dzdcrd.F
deleted file mode 100644
index 26c0a2b..0000000
--- a/src/graflib/dzdoc/dzdkern/dzdcrd.F
+++ /dev/null
@@ -1,39 +0,0 @@
-*
-* $Id: dzdcrd.F,v 1.1.1.1 1996/03/04 16:12:53 mclareni Exp $
-*
-* $Log: dzdcrd.F,v $
-* Revision 1.1.1.1 1996/03/04 16:12:53 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDCRD(LUN,STRING,IRC)
- CHARACTER*(*) STRING
- INTEGER LUN,IRC
- SAVE
-* read a character string form LUN
- IRC=0
-#if defined(CERNLIB_QMIBM)
- READ(LUN,NUM=NBYT,END=10,ERR=20)STRING
- STRING(NBYT+1:)=' '
-#endif
-#if !defined(CERNLIB_QMIBM)
- READ(LUN,'(A)',END=10,ERR=20)STRING
-#endif
-* remove tabs
- ITABCO=0
- DO 5 I=1,LNBLNK(STRING)
- IF(ICHAR(STRING(I:I)).EQ.9)THEN
- IF(ITABCO.EQ.0)THEN
- WRITE(*,*)'Ignore tabs in: ',STRING
- ITABCO=ITABCO+1
- ENDIF
- STRING(I:I)=' '
- ENDIF
- 5 CONTINUE
- GOTO 99
-10 IRC=-1
-20 IRC=IRC-1
-99 RETURN
- END
-***********************************************************************
diff --git a/src/graflib/dzdoc/dzdkern/dzdeos.F b/src/graflib/dzdoc/dzdkern/dzdeos.F
deleted file mode 100644
index ac9cbd9..0000000
--- a/src/graflib/dzdoc/dzdkern/dzdeos.F
+++ /dev/null
@@ -1,127 +0,0 @@
-*
-* $Id: dzdeos.F,v 1.1.1.1 1996/03/04 16:12:54 mclareni Exp $
-*
-* $Log: dzdeos.F,v $
-* Revision 1.1.1.1 1996/03/04 16:12:54 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDEOS(*)
-************************************************************************
-*. *
-*...DZDEOS interprets the tag fields for the end of fields *
-*. *
-*. Characters 4 and 5 of the input line are tested against all possible*
-*. tags. If a valid tag is found, consistency checks are made. *
-*. If no valid tag line interpretation is possible, the line is *
-*. considered to end the highest precedence tag field. *
-*. *
-*. CALLS : none *
-*. CALLED : DZDBKC *
-*. COMMON : DZDINC,DZDTYP *
-*. *
-*. AUTHOR : M. Goossens DD/US *
-*. VERSION : 1.02(9) / 9 Jul 1986 *
-*. *
-*.**********************************************************************
- SAVE
-#include "dzdoc/bkstparq.inc"
-#include "dzdoc/bktgparq.inc"
-#include "dzdoc/bkwrp.inc"
-#include "dzdoc/tapes.inc"
- CHARACTER CTAG*2
-#include "dzdoc/bktgdatq.inc"
-
- 1001 CONTINUE
- CTAG = CARD(4:5)
-
- IF (CARD(4:4).EQ.' ') THEN
-*-- End present highest precedence field
-C-- ===============================================================
-C- I States Precedence Action I
-C- I-------------------------------------------------------------I
-C- I CHOICE 4 close CHOICE bracket I
-C- I REPETITION 3 decrement REP level I
-C- I BIT/DATA/LINK 2 close BI/DA/LI field I
-C- I GENERAL 1 end of bank descr. I
-C-- ===============================================================
- IF (IREPLV.GT.0) THEN
-C- Precedence 3 --> decrement repetition level
- IREPLV = IREPLV - 1
- ELSEIF (ISTATE.EQ.ISBITQ.OR.ISTATE.EQ.ISDATQ.OR.
- X ISTATE.EQ.ISLINQ ) THEN
-C- Precedence 2 --> decrease to GEN level
- ISTATE = ISGENQ
- ELSEIF (ISTATE.EQ.ISGENQ) THEN
-C- Precedence 1 --> end of bank description
- ISTATE = 0
- ELSE
-C- Invalid state
- WRITE(LUNOUT,'(''0?? *B/ card indicating general EOS'',
- X '' but invalid state : ISTATE = '',I10)') ISTATE
- GO TO 998
- ENDIF
- ELSEIF (CTAG.EQ.CBKTAC(ITGBIQ)) THEN
-*-- End of status bit field
- IF (ISTATE.NE.ISBITQ) THEN
-*-- We were NOT inside a BIT description field -> ignore EOS
- WRITE(LUNOUT,'(''0?? *B/BI card indicating end of bit '',
- X ''description field found and not inside bit field'')')
- GO TO 998
- ELSE
- ISTATE = ISGENQ
- ENDIF
- ELSEIF (CTAG.EQ.CBKTAC(ITGDAQ)) THEN
-*-- End of data field
- IF (ISTATE.NE.ISDATQ) THEN
-*-- We were NOT inside a DATA description field -> ignore EOS
- WRITE(LUNOUT,'(''0?? *B/DA card indicating end of data'',
- X '' description field found and not inside data field'')')
- GO TO 998
- ELSE
- ISTATE = ISGENQ
- ENDIF
- ELSEIF (CTAG.EQ.CBKTAC(ITGLIQ)) THEN
-*-- End of link field
- IF (ISTATE.NE.ISLINQ) THEN
-*-- We were NOT inside a LINK description field -> ignore EOS
- WRITE(LUNOUT,'(''0?? *B/LI card indicating end of link'',
- X '' description field found and not inside link field'')')
- GO TO 998
- ELSE
- ISTATE = ISGENQ
- ENDIF
- ELSEIF (CTAG.EQ.CBKTAC(ITGRLQ)) THEN
-*-- End of ref link field
- IF (ISTATE.NE.ISRLIQ) THEN
-*-- We were NOT inside a RLINK description field -> ignore EOS
- WRITE(LUNOUT,'(''0?? *B/RL indicating end of Rlink'',
- X '' description found and not inside Rlink field'')')
- GO TO 998
- ELSE
- ISTATE = ISGENQ
- ENDIF
- ELSEIF (CTAG.EQ.CBKTAC(ITGREQ)) THEN
-*-- End of repetition field
- IF (IREPLV.EQ.0) THEN
-*-- We were NOT inside a REP field -> ignore EOS
- WRITE(LUNOUT,'(''0?? *B/RE card indicating end of '',
- X ''REP field found and not inside REP field'')')
- GO TO 998
- ELSE
- IREPLV = IREPLV - 1
- ENDIF
- ELSE
-*-- No recognized tag -- IGNORE EOS
- WRITE(LUNOUT,'(''0?? '',A,'' card indicating end of '',
- X ''sequence for unrecognized tag field'')') CARD(1:5)
- GO TO 998
- ENDIF
-
- GO TO 999
-
-*-- Continuation card
- 998 RETURN 1
-
- 999 END
diff --git a/src/graflib/dzdoc/dzdkern/dzdggi.F b/src/graflib/dzdoc/dzdkern/dzdggi.F
deleted file mode 100644
index 82334fe..0000000
--- a/src/graflib/dzdoc/dzdkern/dzdggi.F
+++ /dev/null
@@ -1,120 +0,0 @@
-*
-* $Id: dzdggi.F,v 1.3 2003/02/03 14:54:49 mclareni Exp $
-*
-* $Log: dzdggi.F,v $
-* Revision 1.3 2003/02/03 14:54:49 mclareni
-* Recent f90 compilers prefer * for assumed size arrays
-*
-* Revision 1.2 1997/03/14 14:20:28 mclareni
-* WNT mods
-*
-* Revision 1.1.1.1.2.1 1997/01/21 11:24:55 mclareni
-* All mods for Winnt 96a on winnt branch
-*
-* Revision 1.1.1.1 1996/03/04 16:12:57 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDGGI(INFVEC,CTAGRQ,CLINK,COUT,IFC,ILC)
- INTEGER INFVEC(*)
- CHARACTER*2 CTAGRQ, CTAGIN
- CHARACTER*4 CLINK,CLINKI
- CHARACTER*8 CINT
- CHARACTER*(*) COUT
- INTEGER LENINF
-#include "dzdoc/dzdocobk.inc"
-*-- Text and order for general information
-*-- Additional offset for *REP card on output
-#include "dzdoc/docparq.inc"
-#include "dzdoc/bknuparq.inc"
-#include "zebra/bkfoparq.inc"
-#include "dzdoc/bkstparq.inc"
-#include "dzdoc/bktgparq.inc"
-#include "dzdoc/bktgdatq.inc"
-
- IFC=0
- ILC=0
- COUT = ' '
- LCOUT=LEN(COUT)
- IF(CTAGRQ.NE.'LI' .AND. CTAGRQ.NE.'DA')THEN
- II=INFVEC(MBHEAQ)+1
- LENINF=INFVEC(MBGENQ)+II
- ELSE IF(CTAGRQ.EQ.'LI')THEN
- II=INFVEC(MBGENQ)+INFVEC(MBHEAQ)+1
- LENINF=INFVEC(MBLINQ)+II
- ENDIF
- IF(LENINF.LE.1)GOTO 999
-* loop through general info and find tag
-
-1 CONTINUE
-
- IF(II.GE.LENINF)GOTO 999
- NW = INFVEC(II)/16
- IT = MOD(INFVEC(II),16)
-* WRITE(*,*)'New section,IT,NW',IT,NW
-* if not Integer section continue
- IF(IT.NE.2)THEN
- IF(IT.EQ.5)THEN
-* WRITE(*,*)' Hollerith section:'
-* WRITE(*,'(80A4)')(INFVEC(II+K),K=1,NW)
- ENDIF
- II = II + NW + 1
- GOTO 1
- ENDIF
-* WRITE(*,'(A,Z9)')' Tag word(hex)',INFVEC(II+1)
-* decode word containing tag ..
- LOWBIT=IAND(INFVEC(II+1),1023)
-* WRITE(*,*)' bits 0-9 ',LOWBIT
- INTAG=IBITS(INFVEC(II+1),ICHIDQ,NCHIDQ)
-* the comment on *B..BANK comment is special(ID=0)
- IF(INTAG.EQ.0)THEN
- CTAGIN='CL'
- ELSE
- CTAGIN=CBKTAC(INTAG)
- ENDIF
-* find position of tag
-3 CONTINUE
-* WRITE(*,'(A,I5,X,A)')'INTAG ',INTAG,CBKTAC(INTAG)
-* WRITE(*,*)' REST OF INTEGER WORDS',(INFVEC(II+K),K=2,NW)
- IF(CTAGIN.EQ.CTAGRQ .OR. CTAGRQ.EQ.'LI')THEN
- IF(LOWBIT.EQ.0)THEN
-* info given as Integer in following word
- IF(INFVEC(II+2).LT.0)THEN
- CINT=' NNNNNN'
- IFC = 3
- ELSE
- WRITE(CINT,'(I8)')INFVEC(II+2)
- IFC=INDEXN(CINT)
- ENDIF
- NC1 = MIN(LCOUT,LEN(CINT)-IFC+1)
- COUT(1:NC1)=CINT(IFC:IFC+NC1-1)
- ENDIF
-* is there any holl text left
- II = II+NW+1
- NW = INFVEC(II)/16
- IF(NW.LE.0)GOTO 4
- IT = MOD(INFVEC(II),16)
- IF(IT.EQ.5)THEN
-* if its link look if it matches
- IF(CTAGRQ.EQ.'LI')THEN
- CALL UHTOC(INFVEC(II+1),4,CLINKI,4)
- IF(CLINKI.NE.CLINK)THEN
- GOTO 4
- ELSE
- II=II+2
- NW=NW-2
- ENDIF
- ENDIF
- NC = MIN(LCOUT,NW*4)
- CALL UHTOC(INFVEC(II+1),4,COUT,NC)
- ENDIF
- IFC=INDEXC(COUT,' ')
- ILC=INDXBC(COUT,' ')
- GOTO 999
- ENDIF
-4 II= II+NW+1
- GOTO 1
-999 CONTINUE
- END
-************************************************************************
diff --git a/src/graflib/dzdoc/dzdkern/dzdini.F b/src/graflib/dzdoc/dzdkern/dzdini.F
deleted file mode 100644
index 818c1c6..0000000
--- a/src/graflib/dzdoc/dzdkern/dzdini.F
+++ /dev/null
@@ -1,81 +0,0 @@
-*
-* $Id: dzdini.F,v 1.2 1996/04/02 22:24:29 thakulin Exp $
-*
-* $Log: dzdini.F,v $
-* Revision 1.2 1996/04/02 22:24:29 thakulin
-* Remove extra SAVE statement (all variables already under generic
-* SAVE).
-*
-* Revision 1.1.1.1 1996/03/04 16:12:54 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDINI
-************************************************************************
-*. *
-*...DZDINI initializes the DZDOC package *
-*. *
-*. SUBROUTINE DZDINI *
-*. *
-*. *
-*. THE FOLLOWING LOGICAL UNITS MUST BE DEFINED *
-*. =========================================== *
-*. Input on cards on unit LUNIN *
-*. Output for logging on unit LUNOUT *
-*. User defined unit on unit LUNUSR *
-*. Can contain the bank and program description, tables,...*
-*. *
-*. CALLS : MZIOBK,MZLIFT,MZLINK,UCTOH *
-*. CALLED : DZDOCM *
-*. COMMON : DZDBSC,DZDBSN,DZDOCC,DZDPAC,DZDPRC,DZDRPC,DZDRPN,DZDSOC *
-*. COMMON : DZDSON,DZDTAP,DZDTIC,DZDTIN,DZDTYP,DZDUSC,DZDUSN *
-*. *
-*. AUTHOR : M. Goossens DD/US *
-*. VERSION : 2.01(17) / 1 Sep 1986 *
-*. *
-*.**********************************************************************
- SAVE
-
-#include "dzdoc/bkwrp.inc"
-#include "dzdoc/tapes.inc"
-#include "dzdoc/title.inc"
-#include "dzdoc/docparq.inc"
- DOUBLE PRECISION DATE,TIME
- INTEGER INIFLG
- DATA INIFLG/0/
-
-
-*----OTTO
- IF(INIFLG.NE.0)GOTO 999
- INIFLG=1
- LUNOUT = 6
- IF (LUNUSR.EQ.0) LUNUSR = LUNOUT
-
-*-- Initialize COMMON DZDTYP
-
- ISTATE = 0
- IDTAG = 0
- ICONT = 0
- ISLASH = 0
- IREPLV = 0
- CALL UCTOH (')()(',IDEMTX,4,4)
- CALL UCTOH ('$LF/',IILFLF,4,4)
- INUM1 = 0
- INUM2 = 0
- NBNKS = 0
- NWTAG = 0
- NHTAG = 0
- NWTXT = 0
- NHTXT = 0
-
-*-- Go to the primary store and declare the DZDOC link area
-
- CALL MZSDIV (0,-1)
- CALL MZLINK (0,'/DZDOCC/',LDQBKD,LQBKD,LDUMMY)
-
- CALL DATIMH(DATE,TIME)
- CALL UHTOC(DATE,4,CDATE,8)
- CALL UHTOC(TIME,4,CTIME,8)
-
- 999 END
diff --git a/src/graflib/dzdoc/dzdkern/dzdlin.F b/src/graflib/dzdoc/dzdkern/dzdlin.F
deleted file mode 100644
index 928a82d..0000000
--- a/src/graflib/dzdoc/dzdkern/dzdlin.F
+++ /dev/null
@@ -1,155 +0,0 @@
-*
-* $Id: dzdlin.F,v 1.1.1.1 1996/03/04 16:12:54 mclareni Exp $
-*
-* $Log: dzdlin.F,v $
-* Revision 1.1.1.1 1996/03/04 16:12:54 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDLIN
-************************************************************************
-*. *
-*...DZDLIN prepares the text part of the bank descriptor for output *
-*. *
-*. DZDLIN uses the information encoded in Hollerith form in a ZEBRA *
-*. bank to output it in a structured form on the output line. *
-*. *
-*. CALLS : INDXBC,SPACES *
-*. CALLED : DZDOCO *
-*. COMMON : CDLINE,DZDOCC,DZDTAP,IDLINE *
-*. *
-*. AUTHOR : M. Goossens DD/US *
-*. VERSION : 1.02(14) / 9 Jul 1986 *
-*. *
-*.**********************************************************************
- SAVE
-
-#include "dzdoc/bkwrp.inc"
-#include "dzdoc/linout.inc"
-#include "dzdoc/tapes.inc"
-* From DZEBRA
-#include "zebra/zbcdk.inc"
-C-- Working vector for text treatment
- PARAMETER (NWORKQ=256)
- CHARACTER CWORK*(NWORKQ),SPACES*(NWORKQ)
- DATA CWORK/' '/
-
-C- INFORM: Flag: 1 Do not format line (blanks are significant)
-C- 0 Collapse multiple blanks to one blank
-C- Specifying line-feeds induces the INFORM=1 setting
-C- hence allowing the user to specify his own page layout
-
- 1001 CONTINUE
- INFORM = 0
- 10 NWORKF = MIN((NWORKQ-IEWORK)/4,NWHOLL)
-*-- Copy text to working buffer up to end or linefeed
- DO 50 IH=0,NWORKF-1
- IF (IQ(KQSP+LQBKD+INSERT+IH).EQ.IILFLF) THEN
- CALL UHTOC(IQ(KQSP+LQBKD+INSERT),4,
- X CWORK(IEWORK+1:),4*IH)
- INFORM = 1
- IEWORK = IEWORK + 4*IH
- NWHOLL = NWHOLL - IH - 1
- INSERT = INSERT + IH + 1
-*-- Drop slash at end of text
- IEWORK = INDXBC(CWORK(:IEWORK),' ')
- IF (CWORK(IEWORK:IEWORK).EQ.'/')
- X IEWORK=INDXBC(CWORK(:IEWORK-1),' ')
-*---- Start transfer from working buffer to output
- 20 IF (IEWORK.GT.NOUTF) THEN
-*-- Output as much as possible and cut at blank
- DO 30 IW = NOUTF,1,-1
- IF (CWORK(IW:IW).EQ.' ') THEN
-*-- Blank found -- cut sentence
- IEND = IW
- GO TO 40
- ENDIF
- 30 CONTINUE
-*-- Fallen through do loop - cut at end
- IEND = NOUTF
- 40 COUT(INLINE:) = CWORK(1:IEND)
- IEWORK = IEWORK - IEND
-*-- Copy remaining information in COUT forward
- CWORK(1:) = CWORK(IEND+1:)
- ELSE
-*-- Enough room on output line to contain info
- COUT(INLINE:) = CWORK(1:IEWORK)
- IEWORK = 0
- ENDIF
-*-- Empty the text buffer
- IF(IFLOPT(MPOSBQ).EQ.0)THEN
- IF (IFLOPT(MPOSIQ).NE.0)COUT(1:3)='*B.'
- WRITE (LUNUSR,'(A)') COUT
- ENDIF
- IF (IEWORK.GT.0) THEN
- COUT = ' '
- GO TO 20
- ENDIF
- IF (NWHOLL.GT.0) THEN
- COUT = ' '
- GO TO 10
- ELSE
- GO TO 999
- ENDIF
- ENDIF
- 50 CONTINUE
-
-*---- Fallen through do loop and no linefeed found
-
- CALL UHTOC(IQ(KQSP+LQBKD+INSERT),4,CWORK(IEWORK+1:),4*NWORKF)
- IEWORK = IEWORK + 4*NWORKF
- NWHOLL = NWHOLL - NWORKF
- INSERT = INSERT + NWORKF
-*-- Fine the last significant character
- IEWORK = INDXBC(CWORK(1:IEWORK),' ')
- IF (IEWORK.EQ.0) THEN
-*-- Empty the text buffer
- IF(IFLOPT(MPOSBQ).EQ.0) THEN
- IF (IFLOPT(MPOSIQ).NE.0)COUT(1:3)='*B.'
- WRITE (LUNUSR,'(A)') COUT
- ENDIF
- COUT = ' '
- GO TO 999
- ELSE
- IF(CWORK(IEWORK:IEWORK).EQ.'/')INFORM=1
- ENDIF
- IF (INFORM.NE.0) THEN
-*-- Blanks are significant on last line
- INFORM = 0
- ELSE
-*-- Blanks not significant, hence collapse multiple blanks to 1
- CWORK = SPACES(CWORK(:IEWORK),1)
- IEWORK = INDXBC(CWORK(1:IEWORK),' ')
- ENDIF
-*---- Start transfer from working buffer to output
- 110 IF (IEWORK.GT.NOUTF) THEN
-*-- Output as much as possible and cut at blank
- DO 120 IW = NOUTF,1,-1
- IF (CWORK(IW:IW).EQ.' ') THEN
-*-- Blank found -- cut sentence
- IEND = IW
- GO TO 130
- ENDIF
- 120 CONTINUE
-*-- Fallen through do loop - cut at end
- IEND = NOUTF
- 130 COUT(INLINE:) = CWORK(1:IEND)
- IEWORK = IEWORK - IEND
-*-- Copy remaining information in COUT forward
- CWORK(1:) = CWORK(IEND+1:)
- ELSE
-*-- Enough room on output line to contain info
- COUT(INLINE:) = CWORK(1:IEWORK)
- IEWORK = 0
- ENDIF
-*-- Empty the text buffer
- IF(IFLOPT(MPOSBQ).EQ.0)THEN
- IF (IFLOPT(MPOSIQ).NE.0)COUT(1:3)='*B.'
- WRITE (LUNUSR,'(A)') COUT
- ENDIF
- COUT = ' '
- IF (NWHOLL.GT.0) GO TO 10
- IF (IEWORK.GT.0) GO TO 110
-
- 999 END
diff --git a/src/graflib/dzdoc/dzdkern/dzdlo1.F b/src/graflib/dzdoc/dzdkern/dzdlo1.F
deleted file mode 100644
index fc19149..0000000
--- a/src/graflib/dzdoc/dzdkern/dzdlo1.F
+++ /dev/null
@@ -1,93 +0,0 @@
-*
-* $Id: dzdlo1.F,v 1.1.1.1 1996/03/04 16:12:56 mclareni Exp $
-*
-* $Log: dzdlo1.F,v $
-* Revision 1.1.1.1 1996/03/04 16:12:56 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDLO1(CHBANK,CHPRE,LUNL,IFLAG)
- CHARACTER*8 CHBANK,CTEMP
- CHARACTER*(*) CHPRE
-* IFLAG: 1 INTEGER statement with 'INTEGER'
-* 2 continued
-* 3 PARAMETER statement
-* 4 continued
- CHARACTER*4 CHB,CHPINT
- INTEGER KEYVEC(2)
-#include "dzdoc/bkwrp.inc"
-#include "dzdoc/tapes.inc"
-* From DZEBRA
-#include "zebra/zbcdk.inc"
- INTEGER IFITEM
- SAVE IFITEM
- DATA IFITEM/0/
-
- CALL UCTOH(CHBANK(1:4),KEYVEC(1),4,4)
- CALL UCTOH(CHBANK(5:8),KEYVEC(2),4,4)
- CALL DZDPIN(KEYVEC,'RBG')
- IF(IQUEST(1) .NE. 0)THEN
- WRITE(*,*)' Bank not found ',CHBANK
- GOTO 999
- ENDIF
- ILCP=INDXBC(CHPRE,' ')
- IF(ILCP.LE.0)THEN
- CHPINT='LO'
- ILCP=2
- ELSE
- ILCP = MIN(ILCP,LEN(CHPINT))
- CHPINT=CHPRE(1:ILCP)
- ENDIF
-* IFITEM=0
- LUPD = IQUEST(11)
-
-* find link offset in up-bank
-
- NSUP = IQ(KQSP+LUPD+5)
- IF(NSUP .LE. 0)GOTO 999
-
- IF(IFLAG.LE.2)THEN
-
- IF(IFLAG.EQ.1)THEN
- IFITEM=0
- WRITE(LUNL,'(A)')'+KEEP,LKOFF'//CHBANK(1:4)
- CALL DZDPLN(LUNL,'INTEGER',2)
- ENDIF
- DO 10 I=1,NSUP
- IF(IQ(KQSP+LUPD+10+I).EQ.0)GOTO 10
- CALL UHTOC(IQ(KQSP+LUPD+10+I),4,CHB,4)
- ILC=INDXBC(CHB,' ')
- IF(ILC .LE.0)GOTO 10
- IF(IFITEM.EQ.0)THEN
- CALL DZDPLN(LUNL,' '//CHPINT(1:ILCP)//CHB(1:ILC),1)
- IFITEM=1
- ELSE
- CALL DZDPLN(LUNL,','//CHPINT(1:ILCP)//CHB(1:ILC),1)
- ENDIF
-10 CONTINUE
- ELSE
- IF(IFLAG.EQ.3)THEN
- CALL DZDPLN(LUNL,'PARAMETER(',2)
- IFITEM=0
- ENDIF
- DO 20 I=1,NSUP
- IF(IQ(KQSP+LUPD+10+I).EQ.0)GOTO 20
- CALL UHTOC(IQ(KQSP+LUPD+10+I),4,CHB,4)
- ILC=INDXBC(CHB,' ')
- IF(ILC .LE.0)GOTO 20
- IF(IFITEM.EQ.0)THEN
- IFITEM=1
- ELSE
- CALL DZDPLN(LUNL,',',1)
- ENDIF
- CALL DZDPLN(LUNL,CHPINT(1:ILCP)//CHB(1:ILC),1)
- WRITE(CTEMP,'(I8)')I
- IFC=INDEXC(CTEMP,' ')
- CALL DZDPLN(LUNL,'='//CTEMP(IFC:),1)
-20 CONTINUE
- ENDIF
-* CALL DZDPLN(LUNL,')',0)
-* CALL DZDPLN(LUNL,' ',99)
-999 END
-***************************************************************
diff --git a/src/graflib/dzdoc/dzdkern/dzdndc.F b/src/graflib/dzdoc/dzdkern/dzdndc.F
deleted file mode 100644
index d04b34b..0000000
--- a/src/graflib/dzdoc/dzdkern/dzdndc.F
+++ /dev/null
@@ -1,72 +0,0 @@
-*
-* $Id: dzdndc.F,v 1.2 1996/04/02 22:24:30 thakulin Exp $
-*
-* $Log: dzdndc.F,v $
-* Revision 1.2 1996/04/02 22:24:30 thakulin
-* Remove extra SAVE statement (all variables already under generic
-* SAVE).
-*
-* Revision 1.1.1.1 1996/03/04 16:12:54 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDNDC(CHAR,NUMBER)
-************************************************************************
-*. *
-*...DZDNDC decodes a character variable as a number *
-*. *
-*. The value NUMBER returned is an integer corresponding to the *
-*. character representation of CHAR. *
-*. The detection of a non-numeric character gives an alternate return *
-*. *
-*. INPUT: *
-*. ------ *
-*. CHAR : CHARACTER variable containing the text to be decoded *
-*. OUTPUT: *
-*. ------- *
-*. NUMBER : Integer corresponding to number interpretation of CHAR *
-*. *
-*. CALLS : none *
-*. CALLED : DZD0NT,DZDNUM *
-*. COMMON : none *
-*. *
-*. AUTHOR : M. Goossens DD/US *
-*. VERSION : 1.01(4) / 9 Jul 1986 *
-*. *
-*.**********************************************************************
- SAVE
-#include "dzdoc/bknuparq.inc"
- CHARACTER *(*) CHAR
- DATA INIT/0/
-
- IF (INIT.EQ.0) THEN
- IZERO = ICHAR('0')
- ININE = ICHAR('9')
- INIT = 1
- ENDIF
-
- 1001 CONTINUE
- LCHAR = LEN(CHAR)
-*-- Is the only character a star (indicating any number)?
- IF (LCHAR.EQ.1) THEN
- IF (CHAR(1:1).EQ.'*') THEN
- NUMBER = INUINQ
- GO TO 999
- ENDIF
- ENDIF
-
-*.. Start of decoding
- NUMBER = 0
-*-- Beginning of loop over characters
- DO 100 I = 1,LCHAR
- IICHAR = ICHAR(CHAR(I:I))
- IF (IICHAR.LT.IZERO.OR.IICHAR.GT.ININE) GO TO 998
- NUMBER = 10*NUMBER + IICHAR - IZERO
- 100 CONTINUE
-*-- End of loop over characters
- GO TO 999
-*-- Non-numeric field
- 998 NUMBER = INUTGQ
-
- 999 END
diff --git a/src/graflib/dzdoc/dzdkern/dzdnum.F b/src/graflib/dzdoc/dzdkern/dzdnum.F
deleted file mode 100644
index 5efc864..0000000
--- a/src/graflib/dzdoc/dzdkern/dzdnum.F
+++ /dev/null
@@ -1,98 +0,0 @@
-*
-* $Id: dzdnum.F,v 1.1.1.1 1996/03/04 16:12:54 mclareni Exp $
-*
-* $Log: dzdnum.F,v $
-* Revision 1.1.1.1 1996/03/04 16:12:54 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDNUM(*)
-************************************************************************
-*. *
-*...DZDNUM identifies and decodes numeric tag fields. *
-*. *
-*. After a first search through the possible tags for the DZDOC bank *
-*. description, DZDNUM tries and interpret the tag as one or two *
-*. numbers. Possible values are a number, a * and a hyphen, separating *
-*. the two fields (if present). *
-*. When the number interpretation is impossible, the alternate return *
-*. is taken, else the numbers are written to INUM1/2 in /DZDTYP/ *
-*. *
-*. CALLS : DZDNDC *
-*. CALLED : DZDCAR *
-*. COMMON : DZDINC *
-*. *
-*. AUTHOR : M. Goossens DD/US *
-*. VERSION : 1.01(5) / 9 Jul 1986 *
-*. *
-*.**********************************************************************
- SAVE
-#include "zebra/bkfoparq.inc"
-#include "dzdoc/bknuparq.inc"
-#include "dzdoc/bkwrp.inc"
-#include "dzdoc/tapes.inc"
-
- 1001 CONTINUE
-*.. Find the length of the tag (delimited by the first blank)
-
- IBLANK = INDEX(CARD,' ')
-
-C- Tag too long
- IF (IBLANK.EQ.0) GO TO 998
-
-*-- Possible numeric tag --> start parsing
-
- IBLANK = IBLANK - 1
-*-- Range interpretation
- IMINUS = INDEX(CARD(:IBLANK),'-')
- IF (IMINUS.EQ.0) THEN
-*-- Only one number possible
- CALL DZDNDC(CARD(4:IBLANK),INUM1)
- INUM2 = 0
- IF (INUM1.EQ.INUTGQ) THEN
-*-- Non-numeric range specification
- INUM1 = IBLANK/4
- CALL VBLANK(IHNUM1,INUM1)
- CALL UCTOH(CARD(4:),IHNUM1,4,IBLANK-3)
- INUM1 = -INUM1*JFOSEQ
- ENDIF
- ELSE
-*-- Two numbers possible
-C- First field not filled in
- IF (IMINUS.EQ.4) GO TO 998
-C- First number
- CALL DZDNDC(CARD(4:IMINUS-1),INUM1)
- IF (INUM1.EQ.INUTGQ) THEN
-*-- Non-numeric range specification
- INUM1 = (IMINUS-1)/4
- CALL VBLANK(IHNUM1,INUM1)
- CALL UCTOH(CARD(4:),IHNUM1,4,IMINUS-4)
- INUM1 = -INUM1*JFOSEQ
- ENDIF
-C- Second number
- IF (IMINUS.EQ.IBLANK) THEN
-C- Indefinite second number
- INUM2 = INUINQ
- ELSE
-C- Get second number
- CALL DZDNDC(CARD(IMINUS+1:IBLANK),INUM2)
- IF (INUM2.EQ.0) GO TO 998
- IF (INUM2.EQ.INUTGQ) THEN
-*-- Non-numeric range specification
- INUM2 = (IBLANK-IMINUS+3)/4
- CALL VBLANK(IHNUM2,INUM2)
- CALL UCTOH(CARD(IMINUS+1:),IHNUM2,4,IBLANK-IMINUS)
- INUM2 = -INUM2*JFOSEQ
- ENDIF
- ENDIF
- ENDIF
-
-*-- Success -- The number interpretation holds
- GO TO 999
-*-- Failure -- The number interpretation is impossible
- 998 WRITE(LUNOUT,'(''0?? Entry descriptor has invalid structure'',
- X /,1X,A)') CARD
- RETURN 1
-
- 999 END
diff --git a/src/graflib/dzdoc/dzdkern/dzdocm.F b/src/graflib/dzdoc/dzdkern/dzdocm.F
deleted file mode 100644
index 6161758..0000000
--- a/src/graflib/dzdoc/dzdkern/dzdocm.F
+++ /dev/null
@@ -1,83 +0,0 @@
-*
-* $Id: dzdocm.F,v 1.1.1.1 1996/03/04 16:12:55 mclareni Exp $
-*
-* $Log: dzdocm.F,v $
-* Revision 1.1.1.1 1996/03/04 16:12:55 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDOCM(LUNINP,LUNPRO,CHOPT)
-************************************************************************
-*. *
-*...DZDOCM is the master routine of the DZDOC package *
-*. *
-*. SUBROUTINE DZDOCM(LUNPRO,CHOPT) *
-*. *
-*. DZDOCM is the main user subroutine called from the main program *
-*. It reads the input file on stream LUNIN, and decodes it *
-*. according to given key words. *
-*. Bank descriptor cards start with *B in columns 1 and 2. *
-*. All other cards are ignored. *
-*. The structural information associated with these various data *
-*. items is stored in ZEBRA data structures for later retrieval. *
-*. *
-*. INPUT: *
-*. ------
-*. LUNINP : Unit for bank descriptor cards *
-*. LUNPRO : Output unit for diagnostics *
-*. If LUNPRO= 0 then the default unit LUNOUT (6) is used *
-*. CHOPT : 'I' Only initialize the DZDOC system - Do not read cards *
-*. 'R' Write each bank descriptor as a separate entry into *
-*. the CWD of the declared RZ file with a key the bank *
-*. name (RZ file must be write accessible i.e. the file *
-*. must have been declared using RZMAKE or RZFILE) *
-*. *
-*. CALLS : DZDASM,DZDBKC,BNKSUM,CONSUM,DZDINI,LENNOC *
-*. CALLS : INDEXC,REFSUM,REPSUM,USRSUM *
-*. CALLED : User called (DZMAIN) *
-*. COMMON : DZDBSC,DZDBSN,DZDINC,DZDPAC,DZDPNC,DZDPRC,DZDRPC *
-*. COMMON : DZDRPN,DZDTAP,DZDTIN,DZDTOK,DZDTYP,DZDUSC,DZDUSN,QUEST *
-*. *
-*. AUTHOR : M. Goossens DD/US *
-*. VERSION : 2.04(36) / 1 Dec 1987 *
-*. *
-*.**********************************************************************
- SAVE
- CHARACTER*(*) CHOPT
-#include "zebra/bkfoparq.inc"
-#include "dzdoc/bkwrp.inc"
-#include "dzdoc/tapes.inc"
-#include "dzdoc/title.inc"
-#include "dzdoc/linout.inc"
-* From DZEBRA
-#include "zebra/zbcdk.inc"
-
-*-- Define which options are desired
- CALL DZDSCO(CHOPT,IFLOPT)
-
-*-- Initialize the system and calculate IO descriptors when needed
-
- LUNUSR = LUNPRO
- LUNIN = LUNINP
- CALL DZDINI
-C Only initialization desired
- IF (IFLOPT(MPOSIQ).NE.0) GO TO 999
- CALL MZIOCH(JIOPBK,1,'5I -H')
-
- 1001 CONTINUE
-
-*-- Read new card and take action depending on first characters
-
- CALL DZDCRD(LUNIN,CARD,IRC)
- IF(IRC.NE.0)GOTO 999
-* READ (LUNIN,'(A)',END=999) CARD
-
- IF (CARD(1:4).EQ.'*B..') THEN
-*---- *B.. CARD. -- Beginning of bank descriptor
- CALL DZDBKC(*999)
- ENDIF
-
- GO TO 1001
-
- 999 END
diff --git a/src/graflib/dzdoc/dzdkern/dzdsco.F b/src/graflib/dzdoc/dzdkern/dzdsco.F
deleted file mode 100644
index 9833b76..0000000
--- a/src/graflib/dzdoc/dzdkern/dzdsco.F
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: dzdsco.F,v 1.1.1.1 1996/03/04 16:12:56 mclareni Exp $
-*
-* $Log: dzdsco.F,v $
-* Revision 1.1.1.1 1996/03/04 16:12:56 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDSCO(CHOPT,IFLOPT)
- INTEGER IFLOPT(26)
- CHARACTER*(*) CHOPT
- CHARACTER*26 CALPHA
- PARAMETER (CALPHA='ABCDEFGHIJKLMNOPQRSTUVWXYZ')
- DO 10 I=1,26
- 10 IFLOPT(I) = 0
- DO 20 I=1,LEN(CHOPT)
- II = INDEX(CALPHA,CHOPT(I:I))
- IF(II.GT.0)IFLOPT(II)=II
- 20 CONTINUE
- END
-*************************************************************
diff --git a/src/graflib/dzdoc/dzdoc/Imakefile b/src/graflib/dzdoc/dzdoc/Imakefile
deleted file mode 100644
index 792ce54..0000000
--- a/src/graflib/dzdoc/dzdoc/Imakefile
+++ /dev/null
@@ -1,6 +0,0 @@
-INCLUDES= bkfoparq.inc bknuparq.inc bkstparq.inc bktgdatq.inc \ @@\
- bktgparq.inc bkwrp.inc bslash1.inc bslash2.inc docparq.inc \ @@\
- dzdocc.inc dzdocobk.inc linout.inc nonewl1.inc nonewl2.inc \ @@\
- tapes.inc title.inc pilot.h
-
-InstallIncludes($(INCLUDES),$(CERN_INCLUDEDIR),dzdoc)
diff --git a/src/graflib/dzdoc/dzdoc/bkfoparq.inc b/src/graflib/dzdoc/dzdoc/bkfoparq.inc
deleted file mode 100644
index 0eae432..0000000
--- a/src/graflib/dzdoc/dzdoc/bkfoparq.inc
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: bkfoparq.inc,v 1.1.1.1 1996/03/04 16:12:58 mclareni Exp $
-*
-* $Log: bkfoparq.inc,v $
-* Revision 1.1.1.1 1996/03/04 16:12:58 mclareni
-* Dzdoc/Zebpack
-*
-*
-#ifndef CERNLIB_DZDOC_BKFOPARQ_INC
-#define CERNLIB_DZDOC_BKFOPARQ_INC
-*
-* Description of the bank IO characteristic codes
-*
-* bkfoparq.inc
-*
-
-C-- Definition of the bank IO characteristic types (MZBOOK/MZLIFT)
-
-C-- Undefined --> bank cannot be transported
- PARAMETER ( IFOUNQ = 0)
-C-- Bit pattern
- PARAMETER ( IFOBIQ = 1)
-C-- Integer
- PARAMETER ( IFOINQ = 2)
-C-- Floating point
- PARAMETER ( IFOFLQ = 3)
-C-- Double precision
- PARAMETER ( IFODOQ = 4)
-C-- Hollerith
- PARAMETER ( IFOHOQ = 5)
-C-- Self describing sector
- PARAMETER ( IFOSEQ = 7)
-C-- Retrieve by name
- PARAMETER ( IFONAQ = 9)
-C-- Copy from linear chain
- PARAMETER ( IFOLIQ = 11)
-C-- Multiplication factor for self-describing sector
- PARAMETER ( JFOSEQ = 16)
-
-
-#endif
diff --git a/src/graflib/dzdoc/dzdoc/bknuparq.inc b/src/graflib/dzdoc/dzdoc/bknuparq.inc
deleted file mode 100644
index dfc57d8..0000000
--- a/src/graflib/dzdoc/dzdoc/bknuparq.inc
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: bknuparq.inc,v 1.1.1.1 1996/03/04 16:12:58 mclareni Exp $
-*
-* $Log: bknuparq.inc,v $
-* Revision 1.1.1.1 1996/03/04 16:12:58 mclareni
-* Dzdoc/Zebpack
-*
-*
-#ifndef CERNLIB_DZDOC_BKNUPARQ_INC
-#define CERNLIB_DZDOC_BKNUPARQ_INC
-*
-* Description of the number special identifiers
-*
-* bknuparq.inc
-*
-
-C-- Indefinite (* given in number field)
- PARAMETER ( INUINQ = -1)
-C-- Tag (non-numeric description given in number field)
- PARAMETER ( INUTGQ = -2)
-
-
-#endif
diff --git a/src/graflib/dzdoc/dzdoc/bkstparq.inc b/src/graflib/dzdoc/dzdoc/bkstparq.inc
deleted file mode 100644
index a4484fb..0000000
--- a/src/graflib/dzdoc/dzdoc/bkstparq.inc
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: bkstparq.inc,v 1.1.1.1 1996/03/04 16:12:58 mclareni Exp $
-*
-* $Log: bkstparq.inc,v $
-* Revision 1.1.1.1 1996/03/04 16:12:58 mclareni
-* Dzdoc/Zebpack
-*
-*
-#ifndef CERNLIB_DZDOC_BKSTPARQ_INC
-#define CERNLIB_DZDOC_BKSTPARQ_INC
-*
-* Description of the bank state parameters bank parser
-*
-* bkstparq.inc
-*
-
-C-- General information
- PARAMETER ( ISGENQ = 1)
-C-- Link description
- PARAMETER ( ISLINQ = ISGENQ+1)
-C-- ref Link description
- PARAMETER ( ISRLIQ = ISLINQ+1)
-C-- Status bit description
- PARAMETER ( ISBITQ = ISRLIQ+1)
-C-- Data description
- PARAMETER ( ISDATQ = ISBITQ+1)
-C-- Choice section
- PARAMETER ( ISCHOQ = 16)
-C-- Repetition section
- PARAMETER ( ISREPQ = 32)
-
-
-#endif
diff --git a/src/graflib/dzdoc/dzdoc/bktgdatq.inc b/src/graflib/dzdoc/dzdoc/bktgdatq.inc
deleted file mode 100644
index 4b3ff82..0000000
--- a/src/graflib/dzdoc/dzdoc/bktgdatq.inc
+++ /dev/null
@@ -1,140 +0,0 @@
-*
-* $Id: bktgdatq.inc,v 1.1.1.1 1996/03/04 16:12:58 mclareni Exp $
-*
-* $Log: bktgdatq.inc,v $
-* Revision 1.1.1.1 1996/03/04 16:12:58 mclareni
-* Dzdoc/Zebpack
-*
-*
-#ifndef CERNLIB_DZDOC_BKTGDATQ_INC
-#define CERNLIB_DZDOC_BKTGDATQ_INC
-*
-*
-* bktgdatq.inc
-*
- CHARACTER CBKTAC(ITGIDQ)*2
- DIMENSION IBKTAC(NBKACQ,ITGIDQ)
-
-C-- AUthor
- DATA CBKTAC(ITGAUQ) / 'AU' /
- DATA IBKTAC(MBKASQ,ITGAUQ) / ISGENQ /
- DATA IBKTAC(MBKAGQ,ITGAUQ) / IBKANQ /
- DATA IBKTAC(MBKARQ,ITGAUQ) / IBKANQ /
- DATA IBKTAC(MBKAHQ,ITGAUQ) / IBKANQ /
-C-- BIt (status)
- DATA CBKTAC(ITGBIQ) / 'BI' /
- DATA IBKTAC(MBKASQ,ITGBIQ) / ISBITQ /
- DATA IBKTAC(MBKAGQ,ITGBIQ) / IBKANQ /
- DATA IBKTAC(MBKARQ,ITGBIQ) / IBKAYQ /
- DATA IBKTAC(MBKAHQ,ITGBIQ) / IBKAYQ /
-C-- CHoice section
- DATA CBKTAC(ITGCHQ) / 'CH' /
- DATA IBKTAC(MBKASQ,ITGCHQ) / ISCHOQ /
- DATA IBKTAC(MBKAGQ,ITGCHQ) / IBKASQ /
- DATA IBKTAC(MBKARQ,ITGCHQ) / IBKANQ /
- DATA IBKTAC(MBKAHQ,ITGCHQ) / IBKANQ /
-C-- DAta section
- DATA CBKTAC(ITGDAQ) / 'DA' /
- DATA IBKTAC(MBKASQ,ITGDAQ) / ISDATQ /
- DATA IBKTAC(MBKAGQ,ITGDAQ) / IBKANQ /
- DATA IBKTAC(MBKARQ,ITGDAQ) / IBKAYQ /
- DATA IBKTAC(MBKAHQ,ITGDAQ) / IBKAYQ /
-C-- Division
- DATA CBKTAC(ITGDVQ) / 'DV' /
- DATA IBKTAC(MBKASQ,ITGDVQ) / ISGENQ /
- DATA IBKTAC(MBKAGQ,ITGDVQ) / 2 /
- DATA IBKTAC(MBKARQ,ITGDVQ) / IBKANQ /
- DATA IBKTAC(MBKAHQ,ITGDVQ) / IBKAYQ /
-C-- LInk section
- DATA CBKTAC(ITGLIQ) / 'LI' /
- DATA IBKTAC(MBKASQ,ITGLIQ) / ISLINQ /
- DATA IBKTAC(MBKAGQ,ITGLIQ) / IBKANQ /
- DATA IBKTAC(MBKARQ,ITGLIQ) / IBKAYQ /
- DATA IBKTAC(MBKAHQ,ITGLIQ) / IBKAYQ /
-C-- RLink section
- DATA CBKTAC(ITGRLQ) / 'RL' /
- DATA IBKTAC(MBKASQ,ITGRLQ) / ISRLIQ /
- DATA IBKTAC(MBKAGQ,ITGRLQ) / IBKANQ /
- DATA IBKTAC(MBKARQ,ITGRLQ) / IBKAYQ /
- DATA IBKTAC(MBKAHQ,ITGRLQ) / IBKAYQ /
-C-- Numerical Identifier
- DATA CBKTAC(ITGNIQ) / 'NI' /
- DATA IBKTAC(MBKASQ,ITGNIQ) / ISGENQ /
- DATA IBKTAC(MBKAGQ,ITGNIQ) / IBKAMQ /
- DATA IBKTAC(MBKARQ,ITGNIQ) / IBKANQ /
- DATA IBKTAC(MBKAHQ,ITGNIQ) / IBKANQ /
-C-- Number of Data words
- DATA CBKTAC(ITGNDQ) / 'ND' /
- DATA IBKTAC(MBKASQ,ITGNDQ) / ISGENQ /
- DATA IBKTAC(MBKAGQ,ITGNDQ) / IBKAMQ /
- DATA IBKTAC(MBKARQ,ITGNDQ) / IBKANQ /
- DATA IBKTAC(MBKAHQ,ITGNDQ) / IBKANQ /
-C-- Total Number of Links
- DATA CBKTAC(ITGNLQ) / 'NL' /
- DATA IBKTAC(MBKASQ,ITGNLQ) / ISGENQ /
- DATA IBKTAC(MBKAGQ,ITGNLQ) / IBKAMQ /
- DATA IBKTAC(MBKARQ,ITGNLQ) / IBKANQ /
- DATA IBKTAC(MBKAHQ,ITGNLQ) / IBKANQ /
-C-- Number of Structural links
- DATA CBKTAC(ITGNSQ) / 'NS' /
- DATA IBKTAC(MBKASQ,ITGNSQ) / ISGENQ /
- DATA IBKTAC(MBKAGQ,ITGNSQ) / IBKAMQ /
- DATA IBKTAC(MBKARQ,ITGNSQ) / IBKANQ /
- DATA IBKTAC(MBKAHQ,ITGNSQ) / IBKANQ /
-C-- NeXt link
- DATA CBKTAC(ITGNXQ) / 'NX' /
- DATA IBKTAC(MBKASQ,ITGNXQ) / ISGENQ /
- DATA IBKTAC(MBKAGQ,ITGNXQ) / 1 /
- DATA IBKTAC(MBKARQ,ITGNXQ) / IBKANQ /
- DATA IBKTAC(MBKAHQ,ITGNXQ) / IBKAYQ /
-C-- ORigin link
- DATA CBKTAC(ITGORQ) / 'OR' /
- DATA IBKTAC(MBKASQ,ITGORQ) / ISGENQ /
- DATA IBKTAC(MBKAGQ,ITGORQ) / 1 /
- DATA IBKTAC(MBKARQ,ITGORQ) / IBKANQ /
- DATA IBKTAC(MBKAHQ,ITGORQ) / IBKAYQ /
-C-- REpetition section
- DATA CBKTAC(ITGREQ) / 'RE' /
- DATA IBKTAC(MBKASQ,ITGREQ) / ISREPQ /
- DATA IBKTAC(MBKAGQ,ITGREQ) / IBKAMQ /
- DATA IBKTAC(MBKARQ,ITGREQ) / IBKAYQ /
- DATA IBKTAC(MBKAHQ,ITGREQ) / IBKAYQ /
-C-- STore
- DATA CBKTAC(ITGSTQ) / 'ST' /
- DATA IBKTAC(MBKASQ,ITGSTQ) / ISGENQ /
- DATA IBKTAC(MBKAGQ,ITGSTQ) / 2 /
- DATA IBKTAC(MBKARQ,ITGSTQ) / IBKANQ /
- DATA IBKTAC(MBKAHQ,ITGSTQ) / IBKAYQ /
-C-- UP link
- DATA CBKTAC(ITGUPQ) / 'UP' /
- DATA IBKTAC(MBKASQ,ITGUPQ) / ISGENQ /
- DATA IBKTAC(MBKAGQ,ITGUPQ) / 1 /
- DATA IBKTAC(MBKARQ,ITGUPQ) / IBKANQ /
- DATA IBKTAC(MBKAHQ,ITGUPQ) / IBKAYQ /
-C-- VErsion
- DATA CBKTAC(ITGVEQ) / 'VE' /
- DATA IBKTAC(MBKASQ,ITGVEQ) / ISGENQ /
- DATA IBKTAC(MBKAGQ,ITGVEQ) / IBKANQ /
- DATA IBKTAC(MBKARQ,ITGVEQ) / IBKANQ /
- DATA IBKTAC(MBKAHQ,ITGVEQ) / IBKANQ /
-C-- NZERO number of data words preset to 0
- DATA CBKTAC(ITGNZQ) / 'NZ' /
- DATA IBKTAC(MBKASQ,ITGNZQ) / ISGENQ /
- DATA IBKTAC(MBKAGQ,ITGNZQ) / IBKAMQ /
- DATA IBKTAC(MBKARQ,ITGNZQ) / IBKANQ /
- DATA IBKTAC(MBKAHQ,ITGNZQ) / IBKANQ /
-C-- IO characteristics
- DATA CBKTAC(ITGIOQ) / 'IO' /
- DATA IBKTAC(MBKASQ,ITGIOQ) / ISGENQ /
- DATA IBKTAC(MBKAGQ,ITGIOQ) / IBKANQ /
- DATA IBKTAC(MBKARQ,ITGIOQ) / IBKANQ /
- DATA IBKTAC(MBKAHQ,ITGIOQ) / IBKANQ /
-C-- IDEM
- DATA CBKTAC(ITGIDQ) / 'ID' /
- DATA IBKTAC(MBKASQ,ITGIDQ) / ISGENQ /
- DATA IBKTAC(MBKAGQ,ITGIDQ) / 1 /
- DATA IBKTAC(MBKARQ,ITGIDQ) / IBKANQ /
- DATA IBKTAC(MBKAHQ,ITGIDQ) / IBKAYQ /
-
-
-#endif
diff --git a/src/graflib/dzdoc/dzdoc/bktgparq.inc b/src/graflib/dzdoc/dzdoc/bktgparq.inc
deleted file mode 100644
index f9ccc18..0000000
--- a/src/graflib/dzdoc/dzdoc/bktgparq.inc
+++ /dev/null
@@ -1,90 +0,0 @@
-*
-* $Id: bktgparq.inc,v 1.1.1.1 1996/03/04 16:12:58 mclareni Exp $
-*
-* $Log: bktgparq.inc,v $
-* Revision 1.1.1.1 1996/03/04 16:12:58 mclareni
-* Dzdoc/Zebpack
-*
-*
-#ifndef CERNLIB_DZDOC_BKTGPARQ_INC
-#define CERNLIB_DZDOC_BKTGPARQ_INC
-*
-* Description of the bank tag parameters bank parser
-*
-* bktgparq.inc
-*
-
-
-C-- Description of the action flags
-
-C- Code for NO entry
- PARAMETER (IBKANQ = -1)
-C- Code for YES entry
- PARAMETER (IBKAYQ = -2)
-C- Flag for numeric tag field
- PARAMETER (IBKAMQ = -3)
-C- Flag for special decoding(CHOICE tag)
- PARAMETER (IBKASQ = -9)
-
-C-- Description of the action fields
-
-C- Offset of state information
- PARAMETER (MBKASQ = 1)
-C- Offset of tag flag (1,2 words , numeric)
- PARAMETER (MBKAGQ = MBKASQ+1)
-C- Offset of repetition flag
- PARAMETER (MBKARQ = MBKAGQ+1)
-C- Offset of choice flag
- PARAMETER (MBKAHQ = MBKARQ+1)
-C- Number of action fields
- PARAMETER (NBKACQ = MBKAHQ)
-
-C---- Identifiers of various card tags
-
-C-- AUthor
- PARAMETER (ITGAUQ = 1)
-C-- BIt (status)
- PARAMETER (ITGBIQ = ITGAUQ+1)
-C-- CHoice section
- PARAMETER (ITGCHQ = ITGBIQ+1)
-C-- DAta section
- PARAMETER (ITGDAQ = ITGCHQ+1)
-C-- Division
- PARAMETER (ITGDVQ = ITGDAQ+1)
-C-- LInk section
- PARAMETER (ITGLIQ = ITGDVQ+1)
-C-- RLink section
- PARAMETER (ITGRLQ = ITGLIQ+1)
-C-- Number of data words (ND)
- PARAMETER (ITGNDQ = ITGRLQ+1)
-C-- Total Number of Links (NL)
- PARAMETER (ITGNLQ = ITGNDQ+1)
-C-- Number of Structural links (NS)
- PARAMETER (ITGNSQ = ITGNLQ+1)
-C-- NeXt link
- PARAMETER (ITGNXQ = ITGNSQ+1)
-C-- ORigin link
- PARAMETER (ITGORQ = ITGNXQ+1)
-C-- REpetition section
- PARAMETER (ITGREQ = ITGORQ+1)
-C-- STore
- PARAMETER (ITGSTQ = ITGREQ+1)
-C-- UP link
- PARAMETER (ITGUPQ = ITGSTQ+1)
-C-- VErsion
- PARAMETER (ITGVEQ = ITGUPQ+1)
-C-- Entry
- PARAMETER (ITGENQ = ITGVEQ+1)
-C-- NZERO words to preset to zero
- PARAMETER (ITGNZQ = ITGENQ+1)
-C-- IO characteristics
- PARAMETER (ITGIOQ = ITGNZQ+1)
-C-- Numerical identifier
- PARAMETER (ITGNIQ = ITGIOQ+1)
-C-- IDem qualifier
- PARAMETER (ITGIDQ = ITGNIQ+1)
-C-- Tag length for entry
- PARAMETER (NWTENQ = 2)
-
-
-#endif
diff --git a/src/graflib/dzdoc/dzdoc/bkwrp.inc b/src/graflib/dzdoc/dzdoc/bkwrp.inc
deleted file mode 100644
index c90022f..0000000
--- a/src/graflib/dzdoc/dzdoc/bkwrp.inc
+++ /dev/null
@@ -1,72 +0,0 @@
-*
-* $Id: bkwrp.inc,v 1.1.1.1 1996/03/04 16:12:59 mclareni Exp $
-*
-* $Log: bkwrp.inc,v $
-* Revision 1.1.1.1 1996/03/04 16:12:59 mclareni
-* Dzdoc/Zebpack
-*
-*
-#ifndef CERNLIB_DZDOC_BKWRP_INC
-#define CERNLIB_DZDOC_BKWRP_INC
-*
-*
-* bkwrp.inc
-*
- PARAMETER (LNCARD=80 , LNCAR4=LNCARD/4)
- CHARACTER CARD*(LNCARD)
- COMMON /DZDINC/ CARD
-
- PARAMETER (IRLVMQ = 10)
-
-C-- DESCRIPTION OF COMMON DZDTYP
-C- ============================
-
-C-- Common DZDTYP contains the decoded information corresponding to
-C-- one "CARD" image in variable CARD. Is contains also the back-up
-C-- i.e. the old valus of the status flags to treat continuation info
-
-C-- VARIABLE DESCRIPTION
-C- ======== ===========
-C ISTATE Code of state for last valid card ID
-C IDTAG Code of character identification of card
-C ICONT Card is continuation of previous one
-C ISLASH Flag set when last character of CARD is '/'
-C This character is used to generate a line feed
-C for multi-line entries
-C IISLSH Value of ISLASH for previous CARD
-C IREPLV Repetition level
-C IREPLO Old repetition level
-C ISCHLO Old CHOICE section flag
-C IDEMTX Hollerith code for text as previous entry (DZDINI)
-C IILFLF Hollerith code for line feed (DZDINI)
-C INUM1 First number if number interpretation possible
-C IHNUM1 Vector containing the Hollerith representation
-C of the first number field (if non-numeric)
-C INUM1 then contains -16* number of words used
-C INUM2 Second number if number interpretation possible
-C IHNUM2 Vector containing the Hollerith representation
-C of the second number field (if non-numeric)
-C INUM2 then contains -16* number of words used
-C NBNKS Number of bank descriptors present
-C NHTAG Number of characters in the tag field of the card
-C This field can also correspond to a declared
-C numeric field with a non-numeric entry
-C NWTAG Number of 4-byte machine words needed for the tag
-C IHTAG Vector containing the Hollerith representation
-C of the tag field of the card
-C NHTXT Number of characters in the text field of the card
-C NWTAG Number of 4-byte machine words needed for the text
-C IHTAG Vector containing the Hollerith representation
-C of the text field of the card
-
- COMMON/DZDTYP/ISTATE,IDTAG,ICONT,ISLASH,IISLSH,IREPLV,IREPLO,
- X IDEMTX,IILFLF,INUM1,IHNUM1(LNCAR4),INUM2,IHNUM2(LNCAR4),
- X NBNKS,NHTAG,NWTAG,IHTAG(LNCAR4),NHTXT,NWTXT,IHTXT(LNCAR4)
-
-#include "dzdoc/dzdocc.inc"
-
-#include "zebra/mqsys.inc"
-#include "zebra/qequ.inc"
-#include "zebra/mzcn.inc"
-
-#endif
diff --git a/src/graflib/dzdoc/dzdoc/bslash1.inc b/src/graflib/dzdoc/dzdoc/bslash1.inc
deleted file mode 100644
index 8cc5f59..0000000
--- a/src/graflib/dzdoc/dzdoc/bslash1.inc
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: bslash1.inc,v 1.1.1.1 1996/03/04 16:12:57 mclareni Exp $
-*
-* $Log: bslash1.inc,v $
-* Revision 1.1.1.1 1996/03/04 16:12:57 mclareni
-* Dzdoc/Zebpack
-*
-*
-#ifndef CERNLIB_DZDOC_BSLASH1_INC
-#define CERNLIB_DZDOC_BSLASH1_INC
-*
-*
-* bslash1.inc
-*
- CHARACTER*(*) BS
- PARAMETER (BS='\')
-
-#endif
diff --git a/src/graflib/dzdoc/dzdoc/bslash2.inc b/src/graflib/dzdoc/dzdoc/bslash2.inc
deleted file mode 100644
index 8cecc10..0000000
--- a/src/graflib/dzdoc/dzdoc/bslash2.inc
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: bslash2.inc,v 1.1.1.1 1996/03/04 16:12:57 mclareni Exp $
-*
-* $Log: bslash2.inc,v $
-* Revision 1.1.1.1 1996/03/04 16:12:57 mclareni
-* Dzdoc/Zebpack
-*
-*
-#ifndef CERNLIB_DZDOC_BSLASH2_INC
-#define CERNLIB_DZDOC_BSLASH2_INC
-*
-*
-* bslash2.inc
-*
- CHARACTER*(*) BS
- PARAMETER (BS='\\')
-
-#endif
diff --git a/src/graflib/dzdoc/dzdoc/docparq.inc b/src/graflib/dzdoc/dzdoc/docparq.inc
deleted file mode 100644
index 63151dc..0000000
--- a/src/graflib/dzdoc/dzdoc/docparq.inc
+++ /dev/null
@@ -1,109 +0,0 @@
-*
-* $Id: docparq.inc,v 1.1.1.1 1996/03/04 16:12:58 mclareni Exp $
-*
-* $Log: docparq.inc,v $
-* Revision 1.1.1.1 1996/03/04 16:12:58 mclareni
-* Dzdoc/Zebpack
-*
-*
-#ifndef CERNLIB_DZDOC_DOCPARQ_INC
-#define CERNLIB_DZDOC_DOCPARQ_INC
-*
-* Definitions for DZDOC
-*
-* docparq.inc
-*
-C
-C---- PARAMETER definitions for DZDOC
-C
-C-- Offset of DOWN bank for text buffers in master DOC babk
- PARAMETER (MDOCDQ = -1)
-C-- Offset of number of words used
- PARAMETER (MDCENQ = 1 )
-
-C---- Description of the documentation bank
-C =====================================
-
-C-- Bank header part
-C ----------------
-C-- Number of words in the header
- PARAMETER (NBHEAQ = 20)
-C-- Offset of encoded bank IDH
- PARAMETER (MBIDHQ = 1)
-C-- Offset of number of words in use
- PARAMETER (MBUSEQ = MBIDHQ+1)
-C-- Offset of number of words in the header
- PARAMETER (MBHEAQ = MBUSEQ+1)
-C-- Offset of total number of links
- PARAMETER (MBNNDQ = MBHEAQ+1)
-C-- Offset of number of structural links
- PARAMETER (MBNNLQ = MBNNDQ+1)
-C-- Offset of number of data words
- PARAMETER (MBNNSQ = MBNNLQ+1)
-
-C-- Offset of number of words with general information
- PARAMETER (MBGENQ = 11)
-C-- Offset of number of words describing the links
- PARAMETER (MBLINQ = MBGENQ+1)
-C-- Offset of number of words describing the ref links
- PARAMETER (MBRLIQ = MBLINQ+1)
-C-- Offset of number of words describing the status bits
- PARAMETER (MBBITQ = MBRLIQ+1)
-C-- Offset of number of words describing the data words
- PARAMETER (MBDATQ = MBBITQ+1)
-
-C--- Bank Description pointers and flags
-C--- ===================================
-
-C-- Normal entry
-C ------------
-C-- Number of words in bank description pointers and flag section
- PARAMETER (NBDSCQ = 4)
-C-- Offset of pattern word inside section
- PARAMETER (MBPATQ = 1)
-C-- Offset of the two index words inside the section
- PARAMETER (MBIX1Q = MBPATQ+1 , MBIX2Q = MBIX1Q+1)
-
-C-- End of sequence
-C ---------------
-C-- Number of words in bank description for end of sequence entry
- PARAMETER (NBEOSQ = 2)
-
-C-- Descriptor for normal entry
-C ---------------------------
-C-- Start bit and number of bits for tag information
- PARAMETER (ICHTGQ = 0 , NCHTGQ = 2)
-C-- Multiple choice bit
- PARAMETER (ICHBTQ = 2)
-C-- Start bit and number of bits for identifier information
- PARAMETER (ICHIDQ = 10 , NCHIDQ = 5)
-C-- Start bit and number of bits for REP. level information
- PARAMETER (IRPLVQ = ICHIDQ+NCHIDQ , NRPLVQ = 4)
-C-- Bit for end-of-sequence flag
- PARAMETER (IBEOSQ = IRPLVQ+NRPLVQ)
-
-C-- Descriptor for CHOICE tag
-C -------------------------
-
-C-- Number of words for CHOICE flag descriptor
- PARAMETER (NCDSCQ = 4)
-C-- Offset of pattern word inside section
- PARAMETER (MCPATQ = 1)
-
-C-- Offset of the word offset in the bank and its contents
- PARAMETER (MCWOFQ = MCPATQ+1 , MCWCOQ = MCWOFQ+1)
-
-C-- Bit flags choice by number (dynamic sector)
- PARAMETER (ICNUMQ = 0 )
-C-- Bit flags choice by format (self describing sector)
- PARAMETER (ICFORQ = ICNUMQ + 1)
-C-- Bit flags choice by contents
- PARAMETER (ICCONQ = ICFORQ + 1)
-C-- Offset of self description information and width
- PARAMETER (ICSELQ = 10, NCSELQ=4)
-C-- Offset of selection byte fields in word and width
- PARAMETER (ICBY1Q = ICSELQ+NCSELQ, NCBYTQ=8)
- PARAMETER (ICBY2Q = ICBY1Q+NCBYTQ)
-
-
-#endif
diff --git a/src/graflib/dzdoc/dzdoc/dzdocc.inc b/src/graflib/dzdoc/dzdoc/dzdocc.inc
deleted file mode 100644
index 843d4fd..0000000
--- a/src/graflib/dzdoc/dzdoc/dzdocc.inc
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: dzdocc.inc,v 1.1.1.1 1996/03/04 16:12:58 mclareni Exp $
-*
-* $Log: dzdocc.inc,v $
-* Revision 1.1.1.1 1996/03/04 16:12:58 mclareni
-* Dzdoc/Zebpack
-*
-*
-#ifndef CERNLIB_DZDOC_DZDOCC_INC
-#define CERNLIB_DZDOC_DZDOCC_INC
-*
-*
-* dzdocc.inc
-*
- INTEGER LDQBKD,LBQBKD,LDOC,LLTOP,LQBKD,LQBKD1,
- & LUP,LORIG,LSAME,LNEW,LT,LD1,LD2,
- & LUPD,LTD,LDD1,LDUMMY
-
- COMMON /DZDOCC/LDQBKD,LBQBKD,LDOC,LLTOP,LQBKD,LQBKD1,
- & LUP,LORIG,LSAME,LNEW,LT,LD1,LD2,
- & LUPD,LTD,LDD1,LDUMMY
-
-#endif
diff --git a/src/graflib/dzdoc/dzdoc/dzdocobk.inc b/src/graflib/dzdoc/dzdoc/dzdocobk.inc
deleted file mode 100644
index eaca929..0000000
--- a/src/graflib/dzdoc/dzdoc/dzdocobk.inc
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: dzdocobk.inc,v 1.1.1.1 1996/03/04 16:12:59 mclareni Exp $
-*
-* $Log: dzdocobk.inc,v $
-* Revision 1.1.1.1 1996/03/04 16:12:59 mclareni
-* Dzdoc/Zebpack
-*
-*
-#ifndef CERNLIB_DZDOC_DZDOCOBK_INC
-#define CERNLIB_DZDOC_DZDOCOBK_INC
-*
-* Parameter values for the link description bank
-*
-* dzdocobk.inc
-*
-C-- Offset for NL, NS and ND for bank being described
- PARAMETER (MONLQ = 1 , MONSQ = MONLQ+1 , MONDQ = MONSQ+1)
-C-- Offset for Hollerith identifier of bank
- PARAMETER (MOIDHQ = 7)
-C-- Offset of ORigin, UP and NeXt links
- PARAMETER (MOORQ = 8 , MOUPQ = MOORQ+1 , MONXQ = MOUPQ+1)
-C-- Offset for 0th address of links of bank
- PARAMETER (MOLK0Q = MONXQ)
-C-- Offset in IQUEST of return address for link description bank
- PARAMETER (MOQUEQ = 11)
-
-#endif
diff --git a/src/graflib/dzdoc/dzdoc/linout.inc b/src/graflib/dzdoc/dzdoc/linout.inc
deleted file mode 100644
index 5ec4c83..0000000
--- a/src/graflib/dzdoc/dzdoc/linout.inc
+++ /dev/null
@@ -1,43 +0,0 @@
-*
-* $Id: linout.inc,v 1.1.1.1 1996/03/04 16:12:59 mclareni Exp $
-*
-* $Log: linout.inc,v $
-* Revision 1.1.1.1 1996/03/04 16:12:59 mclareni
-* Dzdoc/Zebpack
-*
-*
-#ifndef CERNLIB_DZDOC_LINOUT_INC
-#define CERNLIB_DZDOC_LINOUT_INC
-*
-*
-* linout.inc
-*
-C-- Parameters and commons defining the output line
-
-C-- Output vector
- PARAMETER (NOUTQ=80)
- CHARACTER COUT*(NOUTQ)
-C-- Definition of fields on output line
- PARAMETER (IOTAGQ=12,IOENTQ=21,NOENTQ=NOUTQ-IOENTQ+1)
- PARAMETER (INDENQ=2,NENTIQ=10)
-
- COMMON/CDLINE/COUT
- COMMON/IDLINE/IEWORK,IFLOPT(26),INLINE,INSERT,NOUTF,NWHOLL
-C-- Description of the variables in common CDLINE and IDLINE
-C Identifier Description
-C ========== ===========
-C COUT Character variable representing the output line
-C IEWORK Pointer to the last position occupied in the work
-C variable CWORK (Subr. DZDLIN)
-C IFLOPT (26) Integer array with value non-zero for each option
-C set (used by DZDOCO and DZDOCS for transmitting the
-C options to its daughter routines)
-C INLINE Offset of the start of the information in COUT
-C INSERT Pointer to the current text field being treated in
-C the ZEBRA bank
-C NOUTF Number of columns available on the output line
-C to contain the text information
-C NWHOLL Number of words in the ZEBRA bank containing the
-C text information and remaining to be treated
-
-#endif
diff --git a/src/graflib/dzdoc/dzdoc/nonewl1.inc b/src/graflib/dzdoc/dzdoc/nonewl1.inc
deleted file mode 100644
index 9b91e80..0000000
--- a/src/graflib/dzdoc/dzdoc/nonewl1.inc
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: nonewl1.inc,v 1.1.1.1 1996/03/04 16:12:57 mclareni Exp $
-*
-* $Log: nonewl1.inc,v $
-* Revision 1.1.1.1 1996/03/04 16:12:57 mclareni
-* Dzdoc/Zebpack
-*
-*
-#ifndef CERNLIB_DZDOC_NONEWL1_INC
-#define CERNLIB_DZDOC_NONEWL1_INC
-*
-*
-* nonewl1.inc
-*
- CHARACTER*(*) NONEWL
- PARAMETER (NONEWL=' ')
-
-#endif
diff --git a/src/graflib/dzdoc/dzdoc/nonewl2.inc b/src/graflib/dzdoc/dzdoc/nonewl2.inc
deleted file mode 100644
index f5e4e3f..0000000
--- a/src/graflib/dzdoc/dzdoc/nonewl2.inc
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: nonewl2.inc,v 1.1.1.1 1996/03/04 16:12:57 mclareni Exp $
-*
-* $Log: nonewl2.inc,v $
-* Revision 1.1.1.1 1996/03/04 16:12:57 mclareni
-* Dzdoc/Zebpack
-*
-*
-#ifndef CERNLIB_DZDOC_NONEWL2_INC
-#define CERNLIB_DZDOC_NONEWL2_INC
-*
-*
-* nonewl2.inc
-*
- CHARACTER*(*) NONEWL
- PARAMETER (NONEWL=',$')
-
-#endif
diff --git a/src/graflib/dzdoc/dzdoc/pilot.h b/src/graflib/dzdoc/dzdoc/pilot.h
deleted file mode 100644
index af67a82..0000000
--- a/src/graflib/dzdoc/dzdoc/pilot.h
+++ /dev/null
@@ -1,27 +0,0 @@
-#ifndef CERNLIB_QTRHOLL
-#define CERNLIB_QTRHOLL
-#endif
-
-#ifndef CERNLIB_GCGTOAD
-#define CERNLIB_GCGTOAD
-#endif
-#if defined(CERNLIB_MSDOS)
-#ifndef CERNLIB_F2C
-#define CERNLIB_F2C
-#endif
-#endif
-#if defined(CERNLIB_UNIX)
-#ifndef CERNLIB_BSLASH
-#define CERNLIB_BSLASH
-#endif
-#endif
-#if defined(CERNLIB_WINNT)||defined(CERNLIB_F2C)||defined(CERNLIB_QMALPH)
-#ifndef CERNLIB_BSLASH
-#define CERNLIB_BSLASH
-#endif
-#endif
-#if !defined(CERNLIB_QMIBM)
-#ifndef CERNLIB_NONEWL
-#define CERNLIB_NONEWL
-#endif
-#endif
diff --git a/src/graflib/dzdoc/dzdoc/tapes.inc b/src/graflib/dzdoc/dzdoc/tapes.inc
deleted file mode 100644
index 8094b83..0000000
--- a/src/graflib/dzdoc/dzdoc/tapes.inc
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: tapes.inc,v 1.1.1.1 1996/03/04 16:12:59 mclareni Exp $
-*
-* $Log: tapes.inc,v $
-* Revision 1.1.1.1 1996/03/04 16:12:59 mclareni
-* Dzdoc/Zebpack
-*
-*
-#ifndef CERNLIB_DZDOC_TAPES_INC
-#define CERNLIB_DZDOC_TAPES_INC
-*
-*
-* tapes.inc
-*
- COMMON /DZDTAP/ LUNIN,LUNOUT,LUNUSR
-
-#endif
diff --git a/src/graflib/dzdoc/dzdoc/title.inc b/src/graflib/dzdoc/dzdoc/title.inc
deleted file mode 100644
index 94f63ab..0000000
--- a/src/graflib/dzdoc/dzdoc/title.inc
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: title.inc,v 1.1.1.1 1996/03/04 16:12:59 mclareni Exp $
-*
-* $Log: title.inc,v $
-* Revision 1.1.1.1 1996/03/04 16:12:59 mclareni
-* Dzdoc/Zebpack
-*
-*
-#ifndef CERNLIB_DZDOC_TITLE_INC
-#define CERNLIB_DZDOC_TITLE_INC
-*
-*
-* title.inc
-*
- CHARACTER CDATE*8,CTIME*8
- COMMON /DZDTIC/CDATE,CTIME
-
-#endif
diff --git a/src/graflib/dzdoc/dzdraw/Imakefile b/src/graflib/dzdoc/dzdraw/Imakefile
deleted file mode 100644
index 32bd2f3..0000000
--- a/src/graflib/dzdoc/dzdraw/Imakefile
+++ /dev/null
@@ -1,19 +0,0 @@
-SRCS_F= dzdase.F dzdb01.F dzdbi1.F dzdbit.F dzdbnk.F dzdbok.F \ @@\
- dzdbox.F dzdcdi.F dzdcfz.F dzdckc.F dzdcld.F dzdcrz.F dzdcti.F \ @@\
- dzddad.F dzddaw.F dzddec.F dzddhp.F dzddiv.F dzddoc.F dzddtr.F \ @@\
- dzddwd.F dzdedd.F dzdent.F dzdfio.F dzdfla.F dzdfll.F dzdfnt.F \ @@\
- dzdfzi.F dzdfzs.F dzdgdo.F dzdgds.F dzdgdv.F dzdgen.F dzdget.F \ @@\
- dzdgfl.F dzdgiv.F dzdgky.F dzdglk.F dzdgnz.F dzdgpl.F dzdgr1.F \ @@\
- dzdgrc.F dzdgrz.F dzdgst.F dzdgtr.F dzdhea.F dzdhlp.F dzdhlr.F \ @@\
- dzdhlv.F dzdhtm.F dzdibr.F dzdifa.F dzdinb.F dzdioc.F dzdird.F \ @@\
- dzdirz.F dzdisp.F dzdlbx.F dzdlft.F dzdlfx.F dzdli2.F dzdlnk.F \ @@\
- dzdlpe.F dzdmnt.F dzdmrz.F dzdnbk.F dzdndi.F dzdnfz.F dzdntd.F \ @@\
- dzdoco.F dzdorf.F dzdpar.F dzdpdl.F dzdpev.F dzdpin.F dzdpla.F \ @@\
- dzdpln.F dzdprv.F dzdprw.F dzdpsc.F dzdpto.F dzdpuv.F dzdra1.F \ @@\
- dzdra2.F dzdraw.F dzdrot.F dzdrwf.F dzdsbx.F dzdsdo.F dzdsfb.F \ @@\
- dzdsfk.F dzdsh1.F dzdsha.F dzdshd.F dzdskd.F dzdspi.F dzdsrs.F \ @@\
- dzdst1.F dzdstk.F dzdsvp.F dzdsy1.F dzdsyw.F dzdtm1.F dzdtmp.F \ @@\
- dzdtre.F dzdtxt.F dzdudd.F dzdurz.F dzdwcs.F dzdwtr.F dzdzeb.F \ @@\
- dze2ht.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/graflib/dzdoc/dzdraw/dzdase.F b/src/graflib/dzdoc/dzdraw/dzdase.F
deleted file mode 100644
index 687d7c9..0000000
--- a/src/graflib/dzdoc/dzdraw/dzdase.F
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: dzdase.F,v 1.1.1.1 1996/03/04 16:13:02 mclareni Exp $
-*
-* $Log: dzdase.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:02 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDASE
- CHARACTER*80 CHFILE, CMD
-#include "dzdzbrinc.inc"
- INTEGER ISTAT
- CALL KSVPAR(CHFILE, CMD)
-* WRITE(*,*)'DZDASE: File: ',CHFILE(1:LENOCC(CHFILE)),
-* &' Command: ',CMD(1:LENOCC(CMD))
-
- IF (INDEX(CHFILE,'.scratch').NE.0)THEN
- CALL KUOPEN(LUPTMP,CHFILE,'UNKNOWN',ISTAT)
- IF(ISTAT.EQ.0)CALL KICLOS(LUPTMP,'DELETE',ISTAT)
- ELSE IF (INDEX(CHFILE,'.dzdoc') .NE.0)THEN
- CALL DZDUDD(CHFILE)
- ELSE
- WRITE(*,*)'DZDASE: Unknown file:',CHFILE
- ENDIF
- END
-*********************************************************************
diff --git a/src/graflib/dzdoc/dzdraw/dzdb01.F b/src/graflib/dzdoc/dzdraw/dzdb01.F
deleted file mode 100644
index 088cab7..0000000
--- a/src/graflib/dzdoc/dzdraw/dzdb01.F
+++ /dev/null
@@ -1,82 +0,0 @@
-*
-* $Id: dzdb01.F,v 1.1.1.1 1996/03/04 16:13:02 mclareni Exp $
-*
-* $Log: dzdb01.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:02 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDB01(CBROBJ,CBRCLS,CPATH,CTHIS,CKMCLS,CTHAT,CLONG)
- CHARACTER*(*) CBROBJ,CBRCLS,CPATH,CTHIS,CKMCLS,CTHAT,CLONG
-*
- CALL IZCTOI(CTHAT,IBANK)
- GOTO 10
- ENTRY DZDB11(CTHIS,CKMCLS)
- CALL IZCTOI(CTHIS,IBANK)
- IBANK=-IBANK
-10 CALL DZDSP1(IBANK,'SH_TREE')
- RETURN
-
- ENTRY DZDB12(CTHIS,CKMCLS)
- CALL IZCTOI(CTHIS,IBANK)
- IBANK=-IBANK
- CALL DZDSP1(IBANK,'SH_MORE')
- RETURN
-*
- ENTRY DZDB03(CBROBJ,CBRCLS,CPATH,CTHIS,CKMCLS,CTHAT,CLONG)
- CALL IZCTOI(CTHAT,IBANK)
- GOTO 30
- ENTRY DZDB13(CTHIS,CKMCLS)
- CALL IZCTOI(CTHIS,IBANK)
- IBANK=-IBANK
-30 CALL DZDSP1(IBANK,'SH_CONT')
- RETURN
-*
- ENTRY DZDB04(CBROBJ,CBRCLS,CPATH,CTHIS,CKMCLS,CTHAT,CLONG)
- CALL IZCTOI(CTHAT,IBANK)
- GOTO 40
- ENTRY DZDB14(CTHIS,CKMCLS)
- CALL IZCTOI(CTHIS,IBANK)
- IBANK=-IBANK
-40 CALL DZDSP1(IBANK,'DZSH_CONT')
- RETURN
-*
- ENTRY DZDB05(CBROBJ,CBRCLS,CPATH,CTHIS,CKMCLS,CTHAT,CLONG)
- CALL IZCTOI(CTHAT,IBANK)
- GOTO 50
- ENTRY DZDB15(CTHIS,CKMCLS)
- CALL IZCTOI(CTHIS,IBANK)
- IBANK=-IBANK
-50 CALL DZDSP1(IBANK,'SH_SYS')
- RETURN
-*
- ENTRY DZDB06(CBROBJ,CBRCLS,CPATH,CTHIS,CKMCLS,CTHAT,CLONG)
- CALL IZCTOI(CTHAT,IBANK)
- GOTO 60
- ENTRY DZDB16(CTHIS,CKMCLS)
- CALL IZCTOI(CTHIS,IBANK)
- IBANK=-IBANK
-60 CALL DZDSP1(IBANK,'SH_SURVEY')
- RETURN
-*
- ENTRY DZDB07(CBROBJ,CBRCLS,CPATH,CTHIS,CKMCLS,CTHAT,CLONG)
- CALL IZCTOI(CTHAT,IBANK)
- GOTO 70
- ENTRY DZDB17(CTHIS,CKMCLS)
- CALL IZCTOI(CTHIS,IBANK)
- IBANK=-IBANK
-70 CALL DZDSP1(IBANK,'SH_DOC')
- RETURN
-*
- ENTRY DZDB08(CBROBJ,CBRCLS,CPATH,CTHIS,CKMCLS,CTHAT,CLONG)
- CALL IZCTOI(CTHAT,IBANK)
- GOTO 80
- ENTRY DZDB18(CTHIS,CKMCLS)
- CALL IZCTOI(CTHIS,IBANK)
- IBANK=-IBANK
-80 CALL DZDSP1(IBANK,'DC_EDIT')
- RETURN
-
- END
-*********************************************************************
diff --git a/src/graflib/dzdoc/dzdraw/dzdbi1.F b/src/graflib/dzdoc/dzdraw/dzdbi1.F
deleted file mode 100644
index 61b12ce..0000000
--- a/src/graflib/dzdoc/dzdraw/dzdbi1.F
+++ /dev/null
@@ -1,54 +0,0 @@
-*
-* $Id: dzdbi1.F,v 1.1.1.1 1996/03/04 16:13:10 mclareni Exp $
-*
-* $Log: dzdbi1.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:10 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDBI1(CTEMP,IFWID,NBITS, IQPRNT)
-*.
-*...DZDBI1 write headline for bitwise dump indicating the bit positions
-*.
-*. INPUT : CTEMP character array as working space
-*. IFWID field width
-*. NBITS number of bits
-*. IQPRNT printing unit
-*. OUTPUT :
-*.
-*. CALLED : DZDBIT
-*.
-*. AUTHOR : O.Schaile
-*. VERSION : 1.00
-*. CREATED : 11-Dec-87
-*.**********************************************************************
-*.
- CHARACTER*(*) CTEMP
-*----
- ICLINE = 10+NBITS*IFWID
- IP = 9 + IFWID
- DO 10 I=1,ICLINE
- 10 CTEMP(I:I) = '-'
- WRITE(IQPRNT,10000)CTEMP(1:ICLINE)
- CTEMP(1:ICLINE) = ' '
- DO 20 I=1,NBITS
- IDIG = I/10
- IF(IDIG .NE. 0)WRITE(CTEMP(IP:IP),10100)IDIG
- IP = IP + IFWID
- 20 CONTINUE
- WRITE(IQPRNT,10000)CTEMP(1:ICLINE)
- CTEMP(1:ICLINE) = ' '
- IP = 9 + IFWID
- DO 30 I=1,NBITS
- IDIG = MOD(I,10)
- WRITE(CTEMP(IP:IP),10100)IDIG
- IP = IP + IFWID
- 30 CONTINUE
- WRITE(IQPRNT,10000)CTEMP(1:ICLINE)
- DO 40 I=1,ICLINE
- 40 CTEMP(I:I) = '-'
- WRITE(IQPRNT,10000)CTEMP(1:ICLINE)
-10000 FORMAT(' ',A)
-10100 FORMAT(I1)
- END
diff --git a/src/graflib/dzdoc/dzdraw/dzdbit.F b/src/graflib/dzdoc/dzdraw/dzdbit.F
deleted file mode 100644
index c4e19dc..0000000
--- a/src/graflib/dzdoc/dzdraw/dzdbit.F
+++ /dev/null
@@ -1,82 +0,0 @@
-*
-* $Id: dzdbit.F,v 1.1.1.1 1996/03/04 16:13:10 mclareni Exp $
-*
-* $Log: dzdbit.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:10 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDBIT(IXSTOR,L,IFIRST,ILAST,IFWID,IZERO)
-*.
-*...DZDBIT bitwise dump of data words
-*.
-*. INPUT : IXSTOR store index
-*. L link to bank to be dumped
-*. IFIRST first word to dump
-*. ILAST last word
-*. IFWID field width
-*. IZERO if /=0 print also 0 values
-*. COMMON :
-*. SEQUENCE : MZCA MZCB QSTORE ZEBQ ZUNIT
-*. CALLS : DZDBI1
-*. CALLED : DZDDAW
-*.
-*. REPORT CONDITIONS
-*.
-*. AUTHOR : O.Schaile
-*. VERSION : 1.00
-*. CREATED : 11-Dec-87
-*.**********************************************************************
-*.
-*
-#include "zebra/zebq.inc"
-#include "zebra/mzca.inc"
-#include "zebra/mzcb.inc"
-#include "zebra/zunit.inc"
-#include "dzdchv.inc"
-*
- PARAMETER (MAXLPP=10)
- CHARACTER*132 CTEMP
-*----
-#include "zebra/qstore.inc"
- IF(ILAST .NE. 0)THEN
- IL1 = ILAST
- ELSE
- IL1 = IQ(KQS+L-1)
- ENDIF
- IF(IFIRST .LE. 0)THEN
- IF1=1
- ELSE
- IF1=IFIRST
- ENDIF
- IF(IF1 .GT. IL1)THEN
- ISTEP = -1
- ELSE
- ISTEP = 1
- ENDIF
- IF(IFWID .GT. 3)IFWID = 3
- IF(IFWID .LT. 1)IFWID = 1
- ICLINE = 10+32*IFWID
- NL = MAXLPP + 1
- DO 20 I=IF1,IL1,ISTEP
- IF(NL .GT. MAXLPP)THEN
- CALL DZDBI1(CTEMP,IFWID,32,IQPRNT)
- NL = 0
- ENDIF
- NL = NL + 1
- IP = 9 + IFWID
- CTEMP(1:ICLINE) = ' '
- WRITE(CTEMP(1:6),10200)I,' | '
- DO 10 K=1,32
- IDIG = JBYT(IQ(KQS+L+I),K,1)
- IF(IDIG .NE. 0 .OR. IZERO .NE. 0)WRITE(CTEMP(IP:IP),10100)IDIG
- IP = IP+IFWID
- 10 CONTINUE
- WRITE(IQPRNT,10000)CTEMP(1:ICLINE)
- 20 CONTINUE
- 30 CONTINUE
-10000 FORMAT(' ',A)
-10100 FORMAT(I1)
-10200 FORMAT(I6,A3)
- END
diff --git a/src/graflib/dzdoc/dzdraw/dzdbnk.F b/src/graflib/dzdoc/dzdraw/dzdbnk.F
deleted file mode 100644
index 882e598..0000000
--- a/src/graflib/dzdoc/dzdraw/dzdbnk.F
+++ /dev/null
@@ -1,450 +0,0 @@
-*
-* $Id: dzdbnk.F,v 1.1.1.1 1996/03/04 16:13:09 mclareni Exp $
-*
-* $Log: dzdbnk.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:09 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDBNK(LB,IB,L,X0, Y0, DX, DY, HID, HIDNX, HIDU,
- & NID, ND)
-*.
-*...DZDBNK draw a bank (center, data box, next bank)
-*.
-*. INPUT : X0, Y0 lower left corner of bank center
-*. DX length of the box for data
-*. DY thickness of bank
-*. HID hollerith Id of bank
-*. HIDNX hollerith Id of next bank
-*. HIDU hollerith Id of up - bank
-*. NID numerical Id of bank
-*. ND number of data words
-*. OUTPUT : none
-*.
-*. COMMON :
-*. SEQUENCE : DZDCHV DZDPRM
-*. CALLS : DZDBOX DZDGDS DZDLI2 DZDTXT
-*. CALLED : DZDRA2
-*.
-*. AUTHOR : O.Schaile
-*. VERSION : 1.00
-*. CREATED : 11-Dec-87
-*.**********************************************************************
-*.
- CHARACTER*4 HID, HIDNX,HIDU
- INTEGER IB(9),LB(9)
- CHARACTER*8 CHKEY
- CHARACTER*12 CHFORM,CTEMP3
- CHARACTER*40 CTITL
- CHARACTER*20 CHNID,HIDPR,CHND
-#include "zebra/mzbits.inc"
-#include "dzdprm.inc"
-#include "dzdchv.inc"
-#include "dzdzbrinc.inc"
- INTEGER ITITLE(4),IFC,ILC,IFORM,IST,IEND
- REAL XPOL(6),YPOL(6)
-* shaded box of center
- X0D = X0 + 2.5*GRIDX
-*10/2 X0D = X0 + GRIDX
- IF(LTDISP(ISTUSE).NE.0)THEN
- IF(NLKUSE.GE.IB(LTDISP(ISTUSE)-3))THEN
-* WRITE(*,*)'DZDBNK: Too many banks'
- ELSE
- NLKUSE=NLKUSE+1
- CALL IGPID(1,'BANK',NLKUSE,' ')
- LB(LTDISP(ISTUSE)-NLKUSE)= L
- ENDIF
- ENDIF
- IF(LFCOL.NE.0)THEN
- ICOL=IBCCOL
- IFILL=1
- ELSE
- ICOL=-1
- IFILL=0
- ENDIF
- IF(LFCOL.NE.0 .OR. LTDISP(ISTUSE).NE.0 .AND. IFLDIR.EQ.0)
- & CALL DZDIFA(X0,X0D,Y0,Y0+DY,IFILL,ICOL)
-
- CALL IGQ('LWID',WIDL)
- CALL ISLWSC(5.)
-* CALL DZDBOX(X0,X0D,Y0,Y0+DY,1000*IFLDIR+3)
- CALL DZDBOX(X0,X0D,Y0,Y0+DY,1000*IFLDIR)
- CALL ISLWSC(WIDL)
-
-*10/2 CALL DZDBOX(X0,X0D,Y0,Y0+DY,1000*IFLDIR+3)
-
-* with option 'B' => IFLDIR = 1, (directory tree)
-* take text in data from bank itself
-* and dont write Id, ND ..
-
- IF(IFLDIR .NE. 0)THEN
-* RZ-directory
- IF(IB(L+1) .EQ. 1)THEN
-* box for data area
-* CALL IGBOX(X0D, X0D+DX, Y0, Y0+DY)
- CALL DZDBOX(X0D, X0D+DX, Y0, Y0+DY,1000)
-* get characters fitting in CLINE from end of bank or all
- LC = LEN(CLINE)
- LC4 = LC/4
- NWNAME = IB(L-1)-IB(L+2)
- IF(NWNAME .GT. LC4)THEN
- IFW = IB(L+2)+NWNAME-LC4+1
- NC = LC
- ELSE
- IFW=IB(L+2)+1
- NC = NWNAME*4
- ENDIF
- CLINE = ' '
- CALL UHTOC(IB(L+IFW),4,CLINE,NC)
-* get subdir name starting from /
- ILC = INDXBC(CLINE(1:NC),' ')
- IF(ILC.LE.0)ILC=NC
- ISL = INDEXB(CLINE(1:NC),'/')
- IF(ISL.LE.1)THEN
- ISL=1
- ELSE
- IF(CLINE(ISL-1:ISL-1).EQ.'/')ISL=ISL-1
- ENDIF
- NC = ILC - ISL + 1
- XT= X0D + DX + 0.5 * GRIDX
- YT= Y0 + 0.6*DY
-* CALL DZDTXT('Dir:',4,XT,YT,CSIZE,0.,1)
- YT = YT - 1.1*CSIZE
- CALL DZDTXT(CLINE(ISL:ILC),NC,XT,YT,CSIZE,0.,1)
- NKEY = IB(L+3)
-* tagwords
- NWKEY=IB(L+4)
- XT= X0D + 0.5*DX
- YT= Y0 + 0.5*DY
- NCH=0
- IF(LUDORZ.NE.0)THEN
- CTITL=' '
- CALL CLTOU(CLINE)
- CALL DZDIRD(LUDORZ,CLINE,CTITL,1)
-* WRITE(*,*)' DZDBNK: ',CTITL
- NCH=LENOCC(CTITL)
- IF(NCH.GT.0)
- & CALL DZDTXT(CTITL(1:NCH),NCH,XT,YT,CSIZE,0.,2)
- ENDIF
- IF(NCH.EQ.0)THEN
- WRITE(CLINE,'(A,I5,A,I6)')
- & ' Keys:',NKEY,' Keywords',NWKEY
- CALL DZDTXT(CLINE(1:32),32,XT,YT,CSIZE,0.,2)
- ENDIF
- IF(NWKEY.GT.0 .AND. NKEY .GT.0 .AND. IFLPKY.GT.0)THEN
- IOFFKT = 7 + (NWKEY+3)/4
- NWKEY1=MIN(NWKEY,5)
- IPL=2
- CLINE = ' '
- DO 10 K=1,NWKEY1
- CALL UHTOC(IB(L+IOFFKT),4,CHKEY,8)
-* right align
- ILC = INDXBC(CHKEY,' ')
- IS = 8-ILC
- CLINE(IPL+IS:)=CHKEY(1:ILC)
- IPL = IPL+9
- IOFFKT=IOFFKT+2
-10 CONTINUE
- XT=X0+1.5*GRIDX+CSIZE
- YT=Y0-GRIDY+.5*CSIZE
- IPL = IPL-1
-* print keynames
- CALL DZDTXT(CLINE(1:IPL),IPL,XT,YT,CSIZE,0.,1)
- ENDIF
- ENDIF
-* its a key
- IF(IB(L+1).EQ.2)THEN
- CALL DZDBOX(X0D, X0D+DX, Y0, Y0+DY,0)
- NWKEY = IB(L+6)
- NSKEY = 6+(NWKEY+3)/4
- NWKEY1 = MIN(NWKEY,12)
- CALL UHTOC(IB(L+7),4,CHFORM,NWKEY1)
- IPL = 1
- CLINE = ' '
- DO 20 K=1,NWKEY1
- IF(CHFORM(K:K).EQ.'I')THEN
- IVALU=IB(L+NSKEY+K)
-* look for its tag
- LUDIR=LB(L+1)
- IOFFKT = 7 + (NWKEY+3)/4 + (K-1)*2
- CALL UHTOC(IB(LUDIR+IOFFKT),4,CHKEY,8)
- IF(CHKEY(1:6).EQ.'TSTAMP')THEN
- CALL RZDATE(IVALU,IDATE1,ITIME1,1)
- WRITE(CTEMP3,'(I7,A,I4)')IDATE1,'/',ITIME1
- ELSE
- WRITE(CTEMP3,'(I12)')IVALU
- ENDIF
-* WRITE(CLINE(IPL:),'(I9)')IB(L+NSKEY+K)
- ELSEIF(CHFORM(K:K).EQ.'H'.OR.CHFORM(K:K).EQ.'A')THEN
- WRITE(CTEMP3,'('' '',A4)')IB(L+NSKEY+K)
-* WRITE(CLINE(IPL:),'('' '',A4)')IB(L+NSKEY+K)
- ELSEIF(CHFORM(K:K).EQ.'B')THEN
- WRITE(CTEMP3,'(Z12)')IB(L+NSKEY+K)
-* WRITE(CLINE(IPL:),'(Z9)')IB(L+NSKEY+K)
- ENDIF
- IFC=INDEXC(CTEMP3,' ')
- IF(IFC.LE.0)IFC=12
- NC1=12-IFC
-* max 36 characters fit in box
- IF(IPL+NC1.GT.36)GOTO 21
- CLINE(IPL:IPL+NC1)=CTEMP3(IFC:12)
- IPL = IPL+NC1+2
-20 CONTINUE
-21 CONTINUE
- IPL = IPL-1
- XT = X0+GRIDX+0.5*CSIZE
- YT = Y0+.25*CSIZE
- CALL DZDTXT(CLINE(1:IPL),IPL,XT,YT,CSIZE,0.,1)
-
- WRITE(CLINE,'(A,I7)')'ND=',IB(L+5)
- XT= X0D + DX + 0.5 * GRIDX
- YT= Y0 + DY - CSIZE
- CALL DZDTXT(CLINE(1:10),10,XT,YT,CSIZE,0.,1)
- CALL RZDATE(IB(L+2),IDATE1,ITIME1,1)
- WRITE(CLINE,'(A,I6,A,I4)')'TS: ',IDATE1,'/',ITIME1
- YT = YT-1.5*CSIZE
- CALL DZDTXT(CLINE(1:15),15,XT,YT,CSIZE,0.,1)
- IFORM=JBYT(IB(L+2),1,3)
- IF(IFORM.NE.0)THEN
- XT=X0
- YT=Y0+0.8*DY
- CALL DZDTXT('V',1,XT,YT,CSIZE,0.,1)
- ENDIF
- XT=X0-2.5*GRIDX
- YT=Y0
- WRITE(CLINE(1:5),'(I5)')IB(L+3)
- CLINE(1:1)='S'
- CALL DZDTXT(CLINE(1:5),7,XT,YT,CSIZE,0.,1)
- YT=Y0+1.5*CSIZE
- WRITE(CLINE(1:5),'(I5)')IB(L+4)
- CLINE(1:1)='C'
- CALL DZDTXT(CLINE(1:5),5,XT,YT,CSIZE,0.,1)
- ENDIF
- GOTO 999
- ENDIF
-
-* ZEBRA bank
-
- IF(JBIT(IB(L),IQDROP).EQ.0)THEN
- ISHFLG = 0
- ELSE
- ISHFLG=3
- ENDIF
-* CALL IGBOX(X0D, X0D+DX, Y0, Y0+DY)
- IF(LFCOL.NE.0)THEN
- ICOL=IBDCOL
- IFILL=1
- ELSE
- ICOL=-1
- IFILL=0
- ENDIF
- IF(LFCOL.NE.0 .OR. LTDISP(ISTUSE).NE.0)
- & CALL DZDIFA(X0D, X0D+DX, Y0, Y0+DY,IFILL,ICOL)
- CALL DZDBOX(X0D, X0D+DX, Y0, Y0+DY,ISHFLG)
- CALL IGPID(1,'DUMMY',99,' ')
-* next bank
- IF(HIDNX .NE. ' ')THEN
- XPOL(1) = X0D + DX
- XPOL(2) = XPOL(1)+ 1.5*GRIDX
- XPOL(3) = XPOL(2)+ GRIDX
- XPOL(4) =XPOL(2)
- XPOL(5) =XPOL(1)
- XPOL(6) =XPOL(1)
- YPOL(1) = Y0
- YPOL(2) = YPOL(1)
- YPOL(3) = YPOL(2)+DY/2.
- YPOL(4) = YPOL(1)+DY
- YPOL(5) = YPOL(4)
- YPOL(6) = YPOL(1)
-
- IF(LTDISP(ISTUSE).NE.0)THEN
- IF(NLKUSE.GE.IB(LTDISP(ISTUSE)-3))THEN
-* WRITE(*,*)'DZDBNK: Too many banks'
- ELSE
- NLKUSE=NLKUSE+1
- CALL IGPID(1,'BANK',NLKUSE,' ')
- LB(LTDISP(ISTUSE)-NLKUSE)= LB(L)
- ENDIF
- ENDIF
- IF(LTDISP(ISTUSE).NE.0 .OR. LFCOL.NE.0)THEN
-* cyan
- CALL ISFACI(IBCCOL)
- CALL IFA(6,XPOL,YPOL)
- ENDIF
- CALL DZDGPL(6,XPOL,YPOL)
- HIDPR=HIDNX
- IF(IFLRZF .GT. 0 .AND. IFRCAR.EQ.0)THEN
-* has it a next bank
- LNEXT=LB(L)
- IF(LNEXT.LE.2)GOTO 35
- LUPUP=LB(LNEXT+1)
- IF(LUPUP.LE.2)THEN
- CHKEY(5:8)='NONE'
- ELSE
- CALL UHTOC(IB(LUPUP-4),4,CHKEY(5:8),4)
- ENDIF
- CALL UHTOC(IB(LNEXT-4),4,CHKEY(1:4),4)
- CALL DZDGDS(CHKEY,' ',CLINE,NLT)
- IF(NLT .LE. 0)GOTO 35
-* look if descriptor should be taken from bank
- IFC=INDEX(CLINE,'HID at D')
- IF(IFC.LE.0)GOTO 35
- IFC=IFC+5
- CALL DZDGFL(CLINE(IFC:),IST,IEND)
- IF(IST.EQ.0 .OR. IEND .LT.IST)GOTO 35
- IEND=MIN(IEND,ND)
- NC=MIN(IEND-IST+1,5)*4
- LNEXT=LB(L)
- CALL UHTOC(IB(LNEXT+IST),4,HIDPR,NC)
- ENDIF
-35 CONTINUE
- XT=0.5*(XPOL(1)+XPOL(2)+0.5*GRIDX)
- YT=YPOL(3)
- CALL DZDTXT(HIDPR,4,XT,YT,CSIZE,0.,2)
- CALL IGPID(1,'DUMMY',99,' ')
- ENDIF
- CHND=' '
- CHNID=' '
- HIDPR=HID
- ISTA=5
-
-* descriptor in data box
-
- IF(IFLRZF .GT. 0)THEN
- CHKEY(1:4)=HID
- CHKEY(5:8)=HIDU
- CALL DZDGDS(CHKEY,' ',CLINE,NLT)
-*
- IF(NLT .GT. 0)THEN
-
-* look if descriptor should be taken from bank
-
- IF(IFRCAR.GT.0)GOTO 60
- IFC=INDEX(CLINE,'HID at D')
- IF(IFC.LE.0)GOTO 40
- IF(IFC.EQ.1)ISTA=1
- IFC=IFC+5
- CALL DZDGFL(CLINE(IFC:),IST,IEND)
- IF(IST.GT.0 .AND. IEND .GE.IST)THEN
- IEND=MIN(IEND,ND)
- NCOPY=MIN(IEND-IST+1,5)
- CALL UHTOC(IB(L+IST),4,HIDPR,NCOPY*4)
- ENDIF
-40 CONTINUE
-
- IFC=INDEX(CLINE,'ND at D')
- IF(IFC.LE.0)GOTO 45
- IF(IFC.EQ.1)ISTA=1
- IFC=IFC+4
- CALL DZDGFL(CLINE(IFC:),IST,IEND)
- IF(IST.GT.0 .AND. IEND .GE.IST)THEN
- IEND=MIN(IEND,ND)
- NCOPY=MIN(IEND-IST+1,5)
- CALL UHTOC(IB(L+IST),4,CHND,NCOPY*4)
- ENDIF
-45 CONTINUE
-
- IFC=INDEX(CLINE,'NID at D')
- IF(IFC.LE.0)GOTO 50
- IF(IFC.EQ.1)ISTA=1
- IFC=IFC+5
- CALL DZDGFL(CLINE(IFC:),IST,IEND)
- IF(IST.GT.0 .AND. IEND .GE.IST)THEN
- IEND=MIN(IEND,ND)
- NCOPY=MIN(IEND-IST+1,5)
- CALL UHTOC(IB(L+IST),4,CHNID,NCOPY*4)
- ENDIF
-50 CONTINUE
-
- IFC=INDEX(CLINE,'TITLE at D')
- IF(IFC.LE.0)GOTO 60
- IF(IFC.EQ.1)ISTA=1
- IFC=IFC+7
- CALL DZDGFL(CLINE(IFC:),IST,IEND)
- IFORM=0
- IFC=INDEX(CLINE(ILC+1:),'FORM')
- IF(IFC.NE.0)THEN
- IFC=IFC+ILC+4
- IF(CLINE(IFC:IFC).EQ.'Z')THEN
- IFORM=1
- ENDIF
- ENDIF
- CLINE(ISTA:)=' '
- IEND=MIN(IEND,ND)
- NCOPY=MIN(IEND-IST+1,10)
- IF(NCOPY.LE.0)GOTO 60
- IF(IFORM.EQ.1)THEN
- CALL ZITOH(IB(L+IST),ITITLE,NCOPY)
- CALL UHTOC(ITITLE,4,CLINE(ISTA:),NCOPY*4)
- ELSE
- CALL UHTOC(IB(L+IST),4,CLINE(ISTA:),NCOPY*4)
- ENDIF
-60 CONTINUE
- XT= X0D + 0.5*DX
- YT= Y0 + 0.5*DY
-* centered
- IALG = 2
- NCM =1.5*DX/CSIZE
- CALL DZDTXT(CLINE,NCM,XT,YT
- & ,CSIZE,0.,IALG)
- ENDIF
- ENDIF
-
-
-* # of data in bank
- XT = X0D + DX
- YT = Y0 + DY + 0.1*CSIZE
-* ! right adjust
- IALG = 3
- CLINE=' '
- IF(CHND.EQ.' ')THEN
- IF(ND .GE. 0)THEN
- WRITE(CLINE,'(I10)')ND
- ELSE
- WRITE(CLINE,'(10A)')' **'
- ENDIF
- IFC = INDEXC(CLINE,' ')
- IFC = IFC - 3
- IF(IFC .LT. 1) IFC = 1
- CLINE(IFC:IFC+2) = 'ND='
- ILC=10
- ELSE
- IFC=1
- ILC=LNBLNK(CHND)
- CLINE(1:ILC)=CHND(1:ILC)
- ENDIF
- CALL DZDTXT(CLINE(IFC:ILC)
- & ,ILC-IFC+1,XT,YT,CSIZE,0.,IALG)
-
-* numerical ID
-
- IF(IFRCAR .EQ. 0)THEN
- IALG=1
- YT=Y0+1.1*DY
- XT=X0+GRIDX
- CLINE=' '
- IF(CHNID.EQ.' ')THEN
- WRITE(CLINE,'(I14)')NID
- IFC = INDEXC(CLINE,' ')
- IFC=MAX(IFC-4,1)
- CLINE(IFC:IFC+2)='NID'
- ILC=14
- ELSE
- IFC=1
- ILC=LNBLNK(CHNID)
- CLINE(1:ILC)=CHNID(1:ILC)
- ENDIF
- CALL DZDTXT(CLINE(IFC:ILC)
- & ,ILC-IFC+1,XT,YT,CSIZE,0.,IALG)
- ENDIF
-
-* bank name (Hollerith ID)
-
- XT= X0 + 1.25*GRIDX
- YT= Y0 + 0.5*DY
- IALG=2
- CALL DZDTXT(HIDPR,20,XT,YT,CSIZE,0.,IALG)
-
-999 END
-************************************************************************
diff --git a/src/graflib/dzdoc/dzdraw/dzdbok.F b/src/graflib/dzdoc/dzdraw/dzdbok.F
deleted file mode 100644
index 29b8dd5..0000000
--- a/src/graflib/dzdoc/dzdraw/dzdbok.F
+++ /dev/null
@@ -1,94 +0,0 @@
-*
-* $Id: dzdbok.F,v 1.1.1.1 1996/03/04 16:13:17 mclareni Exp $
-*
-* $Log: dzdbok.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:17 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDBOK(IXSTOR,MAXK,CHOPTD,L,JB,LRET)
- INTEGER IXSTOR,MAXK,JB, L(9),LRET(9)
- CHARACTER*(*) CHOPTD
-
-* book a bank for the directory CDIR
-* bank format for a directory:
-* IFLAG (=1), OFFSET-TO-NAME, NKEYS, NWKEY,NDIR,NQUOTA
-* KEYFORM((NWKEY+3)/4), KEYTAG (2*NWKEY), NAME
-
-#include "zebra/zunit.inc"
-#include "zebra/rzcl.inc"
-#include "zebra/rzk.inc"
-#include "dzdchv.inc"
- PARAMETER (MAXKEY=100)
- CHARACTER*8 CHTAG(MAXKEY)
- CHARACTER*80 CURDIR
- INTEGER MMBK(7)
-
- CALL RZKEYD(NWKEY,CLINE,CHTAG)
-* get full name of current directory
- CALL RZCDIR(CURDIR,'R')
-
- IF(LCDIR.EQ.0)GO TO 999
- LK = IQ(KQS+LCDIR+KLK)
- NK = IQ(KQS+LCDIR+KNKEYS)
- NWKEY= IQ(KQS+LCDIR+KNWKEY)
-* get total number of key entries (all cycles)
- NCTOT=0
- DO 5 I=1,NK
- LKC=LK+(NWKEY+1)*(I-1)
- LCYC=IQ(KQS+LCDIR+LKC)
- 6 NCTOT=NCTOT+1
- LCOLD = JBYT(IQ(KQS+LCDIR+LCYC ), 1,16)
- IF(LCOLD.NE.0)THEN
- LCYC=LCOLD
- GO TO 6
- ENDIF
- 5 CONTINUE
-
- NDIRS = IQUEST(9)
- ILC = INDXBC(CURDIR,' ')
- NDNAME = (ILC+3) / 4
- NEXTRA = 6 + (NWKEY+3)/4 + 2*NWKEY
- ND = NDNAME+NEXTRA
- CALL UCTOH('RDIR',MMBK(1),4,4)
- MMBK(2) = NDIRS+NCTOT+1
- MMBK(3) = MMBK(2)
- MMBK(4) = ND
- CALL MZIOBK(MMBK,7,'6I -H')
- IF(JB .GT. 0)THEN
- JB1 = JB
- ELSE
- JB1 = JB-IQ(KQS+L(1)+3)
- ENDIF
- CALL MZLIFT(IXSTOR,LRET(1),L(1),JB1,MMBK,0)
-#include "zebra/qstore.inc"
- IQ(KQS+LRET(1)+1) = 1
- IQ(KQS+LRET(1)+2) = NEXTRA
- CALL UCOPY(IQUEST(7),IQ(KQS+LRET(1)+3),4)
- CALL UCTOH(CLINE,IQ(KQS+LRET(1)+7),4,NWKEY)
- KP = 7 + (NWKEY+3)/4
- DO 10 K=1,NWKEY
- CALL UCTOH(CHTAG(K),IQ(KQS+LRET(1)+KP),4,8)
- KP = KP+2
- 10 CONTINUE
-* store full name
- CALL UCTOH(CURDIR,IQ(KQS+LRET(1)+NEXTRA+1),4,NDNAME*4)
-
- IF(NK.LE.0)GOTO 999
- IF(NK.GT.MAXK)THEN
- IF(IQPRNT.EQ.6)CALL IGTERM
- IF(INDEX(CHOPTD,'W').NE.0)
- & WRITE(IQPRNT,*)' Dir: ',CURDIR(1:32),' has',
- & NK,' keys, will show only last',MAXK
- NK1=NK-MAXK+1
- ELSE
- NK1=1
- ENDIF
-
-* taken from RZKEYS
-
- CALL DZDSTK(IXSTOR,NK1,NK,LRET(1))
- 999 RETURN
- END
-
diff --git a/src/graflib/dzdoc/dzdraw/dzdbox.F b/src/graflib/dzdoc/dzdraw/dzdbox.F
deleted file mode 100644
index 306a09d..0000000
--- a/src/graflib/dzdoc/dzdraw/dzdbox.F
+++ /dev/null
@@ -1,175 +0,0 @@
-*
-* $Id: dzdbox.F,v 1.1.1.1 1996/03/04 16:13:14 mclareni Exp $
-*
-* $Log: dzdbox.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:14 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDBOX(X0,X1,Y0,Y1,INTS)
-*.
-*...DZDBOX draw a box with possible shading
-*.
-*. INPUT : X0,X1,Y0,Y1 the coordinates for the box
-*. INTS fill area index (0=hollow)
-*.
-*. CALLS : GFA GPL GSFACI GSFAIS
-*. CALLED : DZDRA2, DZDBNK, DZDHEA, DZDLBX, DZDSBX
-*.
-*. AUTHOR : O.Schaile
-*. VERSION : 1.00
-*. CREATED : 11-Dec-87
-*. Modification Log.
-*. 20-Feb-90 : O.Schaile
-*. add LATEX
-*. 12-Dec-90 : O.Schaile
-*. add PostScript
-*.
-*.**********************************************************************
-*.
-#include "dzdprm.inc"
-#if defined(CERNLIB_BSLASH)
-#include "dzdoc/bslash2.inc"
-#endif
-#if !defined(CERNLIB_BSLASH)
-#include "dzdoc/bslash1.inc"
-#endif
- REAL X(7),Y(7)
- CHARACTER*24 CCINT
-*----
- NP=5
- ISTYLE = MOD(INTS,1000)
- IFLDIA = MOD(INTS/1000,10)
- IF(IFLDIA .EQ. 0)THEN
- IF(IFOMED.LE.2)THEN
- NP = 5
- X(1) = X0
- X(2) = X1
- X(3) = X(2)
- X(4) = X(1)
- X(5) = X(1)
- Y(1) = Y0
- Y(2) = Y(1)
- Y(3) = Y1
- Y(4) = Y(3)
- Y(5) = Y(1)
- ELSEIF(IFOMED.EQ.3)THEN
- X(1)= X0*PAGECM
- X(2)=(X1-X0)*PAGECM
- Y(1)= Y0*PAGECM
- Y(2)=(Y1-Y0)*PAGECM
- WRITE(LUNGRA,'(A,4(F5.2,A))')
- + BS//'p(',X(1),',',Y(1),'){'//BS//'f(',X(2),',',
- + Y(2),'){ }}'
- IF(INTS.GT.0)THEN
-* shade
- NL=Y(2)/0.05
- WRITE(LUNGRA,'(A,2(F5.2,A),I3,A,F5.2,A)')
- + BS//'mup(',X(1),',',Y(1)+0.05,')(0.,0.05){'
- + ,NL,'}{'//BS//'l(1,0){',X(2),'}}'
- ENDIF
- GOTO 999
- ENDIF
- ELSE
- DX = X1-X0
- DY = Y1-Y0
- IF(DX .LE. DY)THEN
-* square <>
- IF(IFOMED.EQ.3)THEN
- X(1)=(X0+0.5*DX)*PAGECM
- Y(1)=(Y0+0.5*DY)*PAGECM
- IF(DX.LT.DY-0.1*DY)THEN
- WRITE(LUNGRA,'(A,2(F5.2,A))')
- & BS//'p(',X(1),',',Y(1),'){'//BS//'m(0,0)[c] {'
- & //BS//'large $ '//BS//'diamondsuit $}}'
- ELSE
- WRITE(LUNGRA,'(A,2(F5.2,A))')
- & BS//'p(',X(1),',',Y(1),'){'//BS//'m(0,0)[c] {'
- & //BS//'LARGE $ '//BS//'diamondsuit $}}'
- WRITE(LUNGRA,'(A,2(F5.2,A))')
- & BS//'p(',X(1),',',Y(1),'){'//BS//'m(0,0)[c] {'
- & //BS//'large $ '//BS//'diamondsuit $}}'
- WRITE(LUNGRA,'(A,2(F5.2,A))')
- & BS//'p(',X(1),',',Y(1),'){'//BS//'m(0,0)[c] {$ '
- & //BS//'diamondsuit $}}'
- ENDIF
- GOTO 999
- ENDIF
-
- NP = 5
- X(1) = X0
- Y(1) = Y0+0.5*DY
- X(2) = X0+0.5*DX
- Y(2) = Y0
- X(3) = X1
- Y(3) = Y(1)
- X(4) = X(2)
- Y(4) = Y1
- X(5) = X(1)
- Y(5) = Y(1)
- ELSE
-* ____
-* <____>
-
- IF(IFOMED.EQ.3)THEN
- X(1)=(X0+0.61*DY)*PAGECM
- X(2)=(X1-X0-1.22*DY)*PAGECM
- Y(1)=Y0*PAGECM
- Y(2)=(Y0+DY)*PAGECM
- WRITE(LUNGRA,'(A,2(F5.2,A),F5.2,A)')
- & BS//'p(',X(1),',',Y(1),'){'//BS//'l(1,0){',X(2),'}}'
- WRITE(LUNGRA,'(A,2(F5.2,A),F5.2,A)')
- & BS//'p(',X(1),',',Y(2),'){'//BS//'l(1,0){',X(2),'}}'
- X(1)=(X0+0.16*DY)*PAGECM
- Y(1)=0.5*(Y(1)+Y(2))
- WRITE(LUNGRA,'(A,2(F5.2,A),F5.2,A)')
- & BS//'p(',X(1),',',Y(1),'){'//BS//'m(0,0)[c]{'
- & //BS//'huge $<$}}'
- X(1)=(X0+DX-0.16*DY)*PAGECM
- WRITE(LUNGRA,'(A,2(F5.2,A),F5.2,A)')
- & BS//'p(',X(1),',',Y(1),'){'//BS//'m(0,0)[c]{'
- & //BS//'huge $>$}}'
- GOTO 999
- ENDIF
- NP = 7
- DY2 = 0.5*DY
- X(1) = X0
- Y(1) = Y0+DY2
- X(2) = X0+DY2
- Y(2) = Y0
- X(3) = X1-DY2
- Y(3) = Y0
- X(4) = X1
- Y(4) = Y(1)
- X(5) = X(3)
- Y(5) = Y1
- X(6) = X(2)
- Y(6) = Y1
- X(7) = X(1)
- Y(7) = Y(1)
- ENDIF
- ENDIF
- IF(INTS .GT. 0)THEN
- IF(IFOMED.LT.2 .AND. LFCOL.EQ.0)THEN
- CALL ISFAIS(ISTYLE)
- CALL ISFACI(1)
- CALL IFA(NP,X,Y)
- ELSEIF(IFOMED.EQ.2)THEN
- IF(PAMM10.LE.0.001)PAMM10=70.
- DO 20 I=1,NP
- IX=X(I)*PAMM10
- IY=Y(I)*PAMM10
- IF(I.EQ.1)THEN
- WRITE(CCINT,'(2I9,A)')IX,IY,' m'
- ELSE
- WRITE(CCINT,'(2I9,A)')IX,IY,' d'
- ENDIF
- CALL DZDPLN(LUNGRA,CCINT,-1)
-20 CONTINUE
- CALL DZDPLN(LUNGRA,'cl 0.95 sg fill 0. sg ',0)
- ENDIF
- ENDIF
- CALL DZDGPL(NP,X,Y)
- 999 END
-***********************************************************************
diff --git a/src/graflib/dzdoc/dzdraw/dzdcdi.F b/src/graflib/dzdoc/dzdraw/dzdcdi.F
deleted file mode 100644
index a46ff1a..0000000
--- a/src/graflib/dzdoc/dzdraw/dzdcdi.F
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: dzdcdi.F,v 1.1.1.1 1996/03/04 16:13:06 mclareni Exp $
-*
-* $Log: dzdcdi.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:06 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDCDI
-* IMPLICIT NONE
-* change cwd
- INTEGER NCH
- CHARACTER*128 CWDINT
- CALL KUGETS(CWDINT,NCH)
- IF(NCH.EQ.0)THEN
- CALL RZCDIR(CWDINT, 'R')
- WRITE(*,*)'Cwd: ',CWDINT
- ELSE
- IF (CWDINT(1:8).EQ.'//RzDir/')THEN
- CALL RZCDIR('//'//CWDINT(9:), ' ')
- ELSE IF(CWDINT(1:2).EQ.'//')THEN
- CALL RZCDIR(CWDINT, ' ')
- ELSE IF(CWDINT(1:1).EQ.'/')THEN
- CALL RZCDIR('/'//CWDINT, ' ')
- ELSE
- CALL RZCDIR('//'//CWDINT, ' ')
- ENDIF
- ENDIF
- RETURN
- END
-***********************************************************************
diff --git a/src/graflib/dzdoc/dzdraw/dzdcfz.F b/src/graflib/dzdoc/dzdraw/dzdcfz.F
deleted file mode 100644
index c730de9..0000000
--- a/src/graflib/dzdoc/dzdraw/dzdcfz.F
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: dzdcfz.F,v 1.1.1.1 1996/03/04 16:13:05 mclareni Exp $
-*
-* $Log: dzdcfz.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:05 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDCFZ
-* IMPLICIT NONE
- INTEGER INFLUN,INFSTA, INFOFZ(40)
- COMMON/FZSTAT/ INFLUN,INFSTA, INFOFZ
- INTEGER NCH, LUN
- CHARACTER*4 CHLUN
- LOGICAL BTEST
-
- CALL KUGETC(CHLUN,NCH)
- IF(NCH.LE.0)GOTO 999
- CALL DZDCTI(CHLUN,LUN)
- CALL FZINFO(LUN)
- IF(INFLUN.NE.LUN)THEN
- WRITE(*,*)'FZ file not open, LUN:',LUN
- GOTO 999
- ENDIF
- IF(BTEST(INFSTA,11))THEN
- CALL FZENDO(LUN,'T')
- ELSE
- CALL FZENDI(LUN,'T')
- ENDIF
- CLOSE(LUN)
-999 END
-***********************************************************************
diff --git a/src/graflib/dzdoc/dzdraw/dzdchv.inc b/src/graflib/dzdoc/dzdraw/dzdchv.inc
deleted file mode 100644
index bfd170a..0000000
--- a/src/graflib/dzdoc/dzdraw/dzdchv.inc
+++ /dev/null
@@ -1,13 +0,0 @@
-*
-* $Id: dzdchv.inc,v 1.1.1.1 1996/03/04 16:13:00 mclareni Exp $
-*
-* $Log: dzdchv.inc,v $
-* Revision 1.1.1.1 1996/03/04 16:13:00 mclareni
-* Dzdoc/Zebpack
-*
-*
-*
-* dzdchv.inc
-*
- CHARACTER*256 CLINE
- COMMON/DZDCHV/CLINE
diff --git a/src/graflib/dzdoc/dzdraw/dzdckc.F b/src/graflib/dzdoc/dzdraw/dzdckc.F
deleted file mode 100644
index 537a0db..0000000
--- a/src/graflib/dzdoc/dzdraw/dzdckc.F
+++ /dev/null
@@ -1,84 +0,0 @@
-*
-* $Id: dzdckc.F,v 1.1.1.1 1996/03/04 16:13:15 mclareni Exp $
-*
-* $Log: dzdckc.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:15 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDCKC(XC,YC,X0,Y0,LB,IB,L,IFL)
-*.
-*...DZDCKC check where the locator points to in a bank
-*.
-*. INPUT : XC, YC position of the locator
-*. X0, Y0 position of bank (center)
-*. LB, IB the array containing the ZEBRA store
-*. as used in the call to MZSTOR
-*. L link to bank
-*. OUTPUT :
-*. L link to possible next bank
-*. IFL flag indicating where locator is(see DZDGET)
-*.
-*. COMMON :
-*. SEQUENCE : DZDPRM
-*. CALLED : DZDRA2
-*.
-*. AUTHOR : O.Schaile
-*. VERSION : 1.00
-*. CREATED : 11-Dec-87
-*.**********************************************************************
-*.
- INTEGER LB(999),IB(999)
-#include "dzdprm.inc"
- LOGICAL DZDINB
- EXTERNAL DZDINB
-*--
- IF(X0+2.*DXTB .LE. XRANGE .AND. LB(L) .NE. 0)THEN
-* make its a bit smaller
- DXX=DXTB-3.*GRIDX
- ELSE
- DXX=DXTB
- ENDIF
- XLBC=2.5*GRIDX
- IFL = 0
- NS = IB(L-2)
- IF(NS .LT. 4) NS = 4
- IF(DZDINB(XC,YC,
- + X0-FLOAT(NS)*DXLK,X0,Y0,Y0+DYB))THEN
- IFL = 2
- GOTO 10
- ENDIF
-*10/2
- IF(DZDINB(XC,YC,
- + X0,X0+XLBC,Y0,Y0+DYB))THEN
- IFL = 1
- GOTO 10
- ENDIF
- IF(DZDINB(XC,YC,
- + X0,X0+GRIDX,Y0+DYB,Y0+2.*DYB))THEN
- IFL = 5
- GOTO 10
- ENDIF
- IF(DZDINB(XC,YC,
- + X0+XLBC,X0+XLBC+DXX,Y0+DYB,Y0+2.*DYB))THEN
- IFL = 6
- GOTO 10
- ENDIF
- IF(DZDINB(XC,YC,
- + X0+XLBC,X0+XLBC+DXX,Y0,Y0+DYB))THEN
- IFL = 3
- GOTO 10
- ENDIF
-*10/2
- IF(LB(L) .NE. 0)THEN
- IF(DZDINB(XC,YC,
- + X0+XLBC+DXX+0.5*GRIDX,X0+XLBC+DXX+20.*GRIDX,Y0,Y0+DYB))THEN
- IFL = 4
- L = LB(L)
- ENDIF
- ENDIF
- 10 CONTINUE
- RETURN
- END
-***********************************************************************
diff --git a/src/graflib/dzdoc/dzdraw/dzdcld.F b/src/graflib/dzdoc/dzdraw/dzdcld.F
deleted file mode 100644
index de41a1b..0000000
--- a/src/graflib/dzdoc/dzdraw/dzdcld.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: dzdcld.F,v 1.1.1.1 1996/03/04 16:13:19 mclareni Exp $
-*
-* $Log: dzdcld.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:19 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDCLD
-* close RZ doc file
-#include "dzdzbrinc.inc"
- CHARACTER*80 CDSAVE
- IF(LUDOCB.LE.0)THEN
-* WRITE(*,*)' No Doc-file open'
- ELSE
- CALL RZCDIR(CDSAVE,'R')
- CALL RZCDIR(CTDDOC,' ')
- CALL RZFREE('RZFILE')
- CALL RZEND(CTDDOC(3:))
- CALL RZCDIR(CDSAVE,' ')
-* WRITE(*,'(A,A)')' Closing bank doc'
- CLOSE(UNIT=LUDOCB)
- LUDOCB=0
- ENDIF
- END
diff --git a/src/graflib/dzdoc/dzdraw/dzdcrz.F b/src/graflib/dzdoc/dzdraw/dzdcrz.F
deleted file mode 100644
index d24e48c..0000000
--- a/src/graflib/dzdoc/dzdraw/dzdcrz.F
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: dzdcrz.F,v 1.1.1.1 1996/03/04 16:13:05 mclareni Exp $
-*
-* $Log: dzdcrz.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:05 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDCRZ
-* IMPLICIT NONE
-#include "dzdzbrinc.inc"
- INTEGER NCH, IFC, INDEXC
- CHARACTER*20 CHPATH
-
- CALL KUGETC(CHPATH,NCH)
- IF(NCH.LE.0)GOTO 999
- IFC=INDEX(CHPATH,'R_')
- IF(IFC.LE.0)IFC=INDEXC(CHPATH,'/')-2
- CALL RZCLOS(CHPATH(IFC+2:),' ')
- IF(INDEX(CHPATH(IFC+2:),'RZDOC').NE.0)CTDDOC=' '
-* CALL RZCLOS('//'//CHPATH(IFC+2:),' ')
-999 END
-***********************************************************************
diff --git a/src/graflib/dzdoc/dzdraw/dzdcti.F b/src/graflib/dzdoc/dzdraw/dzdcti.F
deleted file mode 100644
index e3e406c..0000000
--- a/src/graflib/dzdoc/dzdraw/dzdcti.F
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: dzdcti.F,v 1.1.1.1 1996/03/04 16:13:08 mclareni Exp $
-*
-* $Log: dzdcti.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:08 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDCTI(CHIN,IVAL)
- CHARACTER*(*) CHIN
- CHARACTER*4 CHFORM
- CHARACTER*1 CHF1
- IVAL = 0
- IF(CHIN .NE. ' ')THEN
- IFC = INDEXC(CHIN,' ')
- IF(IFC.LE.0)IFC=1
- IF(CHIN(IFC:IFC).EQ.'$')THEN
- IFC=IFC+1
- CHF1='Z'
- ELSE
- CHF1='I'
- ENDIF
- ILC = INDXBC(CHIN,' ')
- IF(ILC.LE.0)ILC=12
- NC=ILC-IFC+1
- IF(NC.GT.9)THEN
- WRITE(CHFORM,'(A,I2,A)') '('//CHF1,NC,')'
- ELSE
- WRITE(CHFORM,'(A,I1,A)') '('//CHF1,NC,')'
- ENDIF
- READ(CHIN(IFC:ILC),CHFORM,ERR=999)IVAL
- ENDIF
- 999 END
diff --git a/src/graflib/dzdoc/dzdraw/dzddad.F b/src/graflib/dzdoc/dzdraw/dzddad.F
deleted file mode 100644
index be50cad..0000000
--- a/src/graflib/dzdoc/dzdraw/dzddad.F
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: dzddad.F,v 1.1.1.1 1996/03/04 16:13:01 mclareni Exp $
-*
-* $Log: dzddad.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:01 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDDAD
-* add dir to search path
-* IMPLICIT NONE
-#include "dzdzbrinc.inc"
- INTEGER NCH
- CHARACTER*80 CHFILE
-*
- CALL KUGETS(CHFILE,NCH)
- IF(NCH.LE.0)THEN
- WRITE(*,*)'No file name given'
- GOTO 999
- ENDIF
- IF(CHFILE(NCH:NCH).NE.'/')THEN
- CHFILE(NCH+1:NCH+1)='/'
- ENDIF
- IF(NDIADD.LT.MDIADD)THEN
- NDIADD=NDIADD+1
- CDIADD(NDIADD)=CHFILE
- ELSE
- WRITE(*,*)'No more adds allowed, max =',MDIADD
- ENDIF
-999 END
-
-*********************************************************************
diff --git a/src/graflib/dzdoc/dzdraw/dzddaw.F b/src/graflib/dzdoc/dzdraw/dzddaw.F
deleted file mode 100644
index 451b3bd..0000000
--- a/src/graflib/dzdoc/dzdraw/dzddaw.F
+++ /dev/null
@@ -1,51 +0,0 @@
-*
-* $Id: dzddaw.F,v 1.1.1.1 1996/03/04 16:13:10 mclareni Exp $
-*
-* $Log: dzddaw.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:10 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDDAW(IXSTOR, L, CHOPT, IFIRST, ILAST)
-*.
-*...DZDDAW dump data words
-*.
-*. INPUT : IXSTOR store index
-*. L link to bank to be dumped
-*. CHOPT character option as for DZSHOW
-*. with the following extensions:
-*. 'W' indicates bitwise dump with qualifiers
-*. '0' bit values 0 are prtd as 0 (blank otherwise)
-*. '1' or '2' or '3' is the field width
-*. i.e. '2' selects one space between the bits
-*. IFIRST first word to dump
-*. ILAST last word
-*. OUTPUT :
-*.
-*. CALLS : DZDBIT DZSHOW UOPTC
-*. CALLED : DZDISP
-*.
-*. AUTHOR : O.Schaile
-*. VERSION : 1.00
-*. CREATED : 11-Dec-87
-*.**********************************************************************
-*.
-*
- CHARACTER*(*) CHOPT
-*
- IF(L .LE. 0)THEN
- GOTO 10
- ENDIF
- IF(INDEX(CHOPT,'W') .EQ. 0)THEN
- CALL DZSHOW(' DZSHOW called from DZDISP',
- + IXSTOR, L,CHOPT,1,0,IFIRST,ILAST)
- ELSE
- IF(INDEX(CHOPT,'1') .NE. 0)IFWID = 1
- IF(INDEX(CHOPT,'2') .NE. 0)IFWID = 2
- IF(INDEX(CHOPT,'3') .NE. 0)IFWID = 3
- I0= INDEX(CHOPT,'0')
- CALL DZDBIT(IXSTOR,L,IFIRST,ILAST,IFWID,I0)
- ENDIF
- 10 CONTINUE
- END
diff --git a/src/graflib/dzdoc/dzdraw/dzddec.F b/src/graflib/dzdoc/dzdraw/dzddec.F
deleted file mode 100644
index 92ab1a4..0000000
--- a/src/graflib/dzdoc/dzdraw/dzddec.F
+++ /dev/null
@@ -1,35 +0,0 @@
-*
-* $Id: dzddec.F,v 1.1.1.1 1996/03/04 16:13:08 mclareni Exp $
-*
-* $Log: dzddec.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:08 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDDEC(CPRMPT,IVAL)
- CHARACTER*(*) CPRMPT
- CHARACTER*12 CTEMP
- CHARACTER*4 CHFORM
- 10 CONTINUE
- CTEMP = ' '
- CALL KUPROC(CPRMPT,CTEMP,NCH)
- IF(NCH.LE.0)GOTO 999
- IF(CTEMP .NE. ' ')THEN
- ILC = INDXBC(CTEMP,' ')
- IF(ILC.GT.9)ILC=9
- IFC=INDEX(CTEMP,'$')
- IF(IFC.LE.0)THEN
- IFC=1
- WRITE(CHFORM,'(A,I1,A)') '(I',ILC,')'
- ELSE
- IFC=IFC+1
- WRITE(CHFORM,'(A,I1,A)') '(Z',ILC,')'
- ENDIF
- READ(CTEMP(IFC:ILC),CHFORM,ERR=20 )IVAL
- ENDIF
- GOTO 999
- 20 CONTINUE
- WRITE(*,*)' Input conversion error, please retype'
- GOTO 10
- 999 END
diff --git a/src/graflib/dzdoc/dzdraw/dzddhp.F b/src/graflib/dzdoc/dzdraw/dzddhp.F
deleted file mode 100644
index b922d06..0000000
--- a/src/graflib/dzdoc/dzdraw/dzddhp.F
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: dzddhp.F,v 1.1.1.1 1996/03/04 16:13:01 mclareni Exp $
-*
-* $Log: dzddhp.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:01 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDDHP
- END
-*********************************************************************
diff --git a/src/graflib/dzdoc/dzdraw/dzddiv.F b/src/graflib/dzdoc/dzdraw/dzddiv.F
deleted file mode 100644
index 346608d..0000000
--- a/src/graflib/dzdoc/dzdraw/dzddiv.F
+++ /dev/null
@@ -1,626 +0,0 @@
-*
-* $Id: dzddiv.F,v 1.1.1.1 1996/03/04 16:13:15 mclareni Exp $
-*
-* $Log: dzddiv.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:15 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDDIV(IXDIVP,LDUMMY,RZPATH,CHOPT,
- + IWDISP, IWMETA, ILOCNR, IWKTYP)
-*.
-*...DZDDIV see long write-up
-*.
-*. INPUT : IXXDIVP Division index
-*. LDUMMY Not yet used
-*. RZPATH Pathname in RZ-file for bank documentation
-*. CHOPT Character option
-*. 'I' interactive,
-*. 'P' print addresses of of banks
-*. 'N' dont activate workstation (done by caller)
-*. 'M' write also the menu boxes to metafile
-*. 'C' use color
-*. IWDISP workstation Id for display (screen)
-*. IWMETA Id for possible metafile (0 if none)
-*. ILOCNR locator number for cursor input
-*. IWKTYP workstation type
-*.
-*. OUTPUT :
-*.
-*. COMMON : DZDVAR
-*. SEQUENCE : MZBITS MZCA MZCB MZCC MZCN QUEST ZEBQ
-*. CALLS : DZDBOX DZDISP DZDST1 DZDTXT GACWK GCLRWK GDAWK GPL
-*. CALLS : GQCNTN GRQLC GSELNT GUWK
-*. CALLS : MZSDIV SBYT UHTOC UOPTC gacwk
-*. CALLED : USER
-*.
-*. REPORT CONDITIONS
-*.
-*. AUTHOR : O. Schaile
-*. VERSION : 1.00
-*. CREATED : 3-Feb-88
-*. LAST MOD : 20-Feb-88
-*.
-*. Modification Log.
-*.
-*. Implement division list
-*.
-*.**********************************************************************
-*.
- CHARACTER*(*) CHOPT,RZPATH
-*
-#include "zebra/mzbits.inc"
-#include "zebra/quest.inc"
- REAL RQUEST(100)
- EQUIVALENCE (IQUEST,RQUEST)
-#include "zebra/zebq.inc"
-#include "zebra/mzca.inc"
-#include "zebra/mzcb.inc"
-#include "zebra/mzcc.inc"
-#include "zebra/mzcn.inc"
-#include "zebra/zunit.inc"
-#include "dzdprm.inc"
-*.
-#include "dzdzbrinc.inc"
-#if defined(CERNLIB_BSLASH)
-#include "dzdoc/bslash2.inc"
-#endif
-#if !defined(CERNLIB_BSLASH)
-#include "dzdoc/bslash1.inc"
-#endif
- LOGICAL DZDINB
- EXTERNAL DZDINB
- CHARACTER*8 CFWBLO
- CHARACTER*8 CTEMP,CTEMP1,CTEMP2,CHOPT1
- CHARACTER*2 CDIV
- PARAMETER(NITEM=5)
- CHARACTER*16 CHITEM(NITEM)
- CHARACTER*32 CDIVLI(20),CSTOLI(16),CTITLE
- INTEGER IDIVLI(20),ISTOLI(16)
- CHARACTER*1 CMMENU
- REAL RVALQ(11)
- PARAMETER (NROWS=40)
- COMMON/DZDVAR/X0,DX,Y0,DY,GRYDDV, CSDDV,
- + LENBLO, XENBLO, NROWAC, IPRTFL
- DIMENSION IXDIVP(9), X(3), Y(3),XDIV(2,20),YDIV(2,20)
- LOGICAL REQINP,LACTWK
- INTEGER INIFLG
- SAVE IFIRST,ILAST,IPCSEQ, INIFLG
- DATA IFIRST,ILAST/0,-1/ , IPCSEQ/0/, INIFLG/0/
-
- CALL IGQWK(IWDISP,'OPEN',RVALQ)
- IF(RVALQ(1).LT.1.)THEN
- WRITE(*,*)'DZDDIV: Workstation', IWDISP, ' not open'
- RETURN
- ENDIF
- IF(INIFLG.EQ.0)THEN
- IDVERS=0
- INIFLG=1
- CALL DZDIBR
- ENDIF
- IPRTFL = INDEX(CHOPT,'P')
- IF(INDEX(CHOPT,'N').NE. 0)THEN
- LACTWK = .FALSE.
- ELSE
- LACTWK=.TRUE.
- ENDIF
- KWTYP=IWKTYP
-* compose option for DZDISP
- IPOPT = 1
- CHOPT1 = 'V'
- IF(INDEX(CHOPT,'N').NE.0)THEN
- IPOPT=IPOPT+1
- CHOPT1(IPOPT:IPOPT)='N'
- ENDIF
- IF(INDEX(CHOPT,'M').NE.0)THEN
- IPOPT=IPOPT+1
- CHOPT1(IPOPT:IPOPT)='M'
- ENDIF
- IF(INDEX(CHOPT,'C').NE.0)THEN
- IPOPT=IPOPT+1
- CHOPT1(IPOPT:IPOPT)='C'
- ENDIF
- IXIN = IXDIVP(1)
- XRANGE = 20.
- YRANGE = 20.
- CALL IGRNG( XRANGE, YRANGE)
- RYRX = XRANGE
- IF(LACTWK)THEN
- CALL IACWK(IWDISP)
- ENDIF
- CMMENU=' '
-
- 10 CONTINUE
- CALL MZSDIV (IXIN,0)
- CALL UZERO(XDIV,1,40)
-
- IST = JQSTOR
-* default to div 2
- IF(JQDIVI .EQ. 0)THEN
- IXIN=IXIN+2
- CALL MZSDIV(IXIN,1)
- ENDIF
- IF(INIFLG.EQ.0)THEN
- IDVERS=0
- INIFLG=1
- ENDIF
-* links for the browser
- IF(INDEX(CHOPT,'D').NE. 0)THEN
- IF(LTDFLG(IST).EQ.0)THEN
- CALL MZLINK(IXIN,'DZDDIS',
- & LTDISP(IST),LTDISP(IST),LTDISP(IST))
- LTDFLG(IST)=1
- IIST=0
- CALL SBYT(IST,IIST,27,6)
- DO 6 K=21,24
-6 CALL MZXREF(IXIN,K+IIST,'A')
- ENDIF
- IF(LTDISP(IST).NE.0)THEN
- CALL MZDROP(IXIN,LTDISP(IST),' ')
- LTDISP(IST)=0
- ENDIF
- NLKUSE=0
-* get number of banks in division
- NUMB=0
- LGOP=0
-15 CALL DZDNBK(IXIN,LGOP,LBNK,LFW,LLW,IDH,IDRFLG)
- LGOP=LBNK
- IF(LBNK.NE.0)THEN
-* dropped?
-* IF(IDRFLG.EQ.0)NUMB = NUMB+1
- NUMB = NUMB+1
- GOTO 15
- ENDIF
- NUMB=NUMB+5
- IIST=20
- CALL SBYT(IST,IIST,27,6)
- CALL MZBOOK(IIST,LTDISP(IST),LTDISP(IST),1,'ZBR1',NUMB,0,0,0,0)
- ISTUSE=IST
- ENDIF
-
- CALL MZSDIV (IXIN,0)
- NWSTOR = LQSTA(KQT+21)
- XWSTOR = NWSTOR
-
- METAFL = 0
-
-* 20 CONTINUE
-
- LSTA = LQSTA(KQT+JQDIVI)
- LEND = LQEND(KQT+JQDIVI)
- IFW = LSTA
- ILW = LEND
- IFW1 = IFW + 1
- ILW1 = ILW
- 20 CONTINUE
- CALL MZSDIV (IXIN,1)
- LENGLQ = ILW - IFW
-* activate and clear workstations
- XRANGE = 20.
- YRANGE = 20.
- CALL IGRNG( XRANGE, YRANGE)
- RYRX=XRANGE
-* CALL HPLNEW
- CALL ICLRWK(0,0)
- IF(IWMETA .GT. 0 .AND. METAFL .EQ. 1)THEN
-* CALL IDAWK(IWDISP)
- CALL IACWK(IWMETA)
- CALL IGRNG( XRANGE, YRANGE)
- CALL ISLN(1)
- CMMENU='M'
- CALL ICLRWK(0,0)
- CALL ISFASI(-103)
- ELSEIF(IFOMED.NE.3)THEN
- CALL ICLRWK(IWDISP,1)
- CALL ISFASI(-5)
- ENDIF
-
- GRYDDV = RYRX/FLOAT(NROWS)
- GRXDDV = GRYDDV
- NROWHD = 6
- NROWBO = 3
-
- CSDDV = 0.6 * GRYDDV
- DY = 0.8 * GRYDDV
- X0 = 0.08 * RYRX
- X2 = 0.98 * RYRX
- DX = X2-X0
-
-* draw top box for store
-
- Y0 = GRYDDV * FLOAT(NROWS-1)
- Y0STOR = Y0 - GRYDDV-DY/2.
- CALL UHTOC(IQTABV(KQT+11),4,CTEMP,8)
- WRITE(CTEMP1,'(I8)')NWSTOR
- CALL DZDTXT(
- + 'Store '//CTEMP//' Length(Words) '//CTEMP1, 0
- + ,X0+.5*DX, Y0+0.5*DY, 1.5*CSDDV, 0., 2)
-
- CALL MZSDIV (IXIN,1)
- CALL UHTOC(IQDN1(KQT+JQDIVI),4,CTEMP(1:4),4)
- CALL UHTOC(IQDN2(KQT+JQDIVI),4,CTEMP(5:8),4)
- WRITE(CTEMP1,'(I8)')IFW1
- WRITE(CTEMP2,'(I8)')ILW1
- WRITE(CDIV,'(I2)')JQDIVI
- YT = GRYDDV * (FLOAT(NROWS-NROWHD+1)+0.5)
- CALL DZDTXT(
- + 'Div '//CDIV//' '//CTEMP//' range '//CTEMP1//' - '//CTEMP2, 0
- + ,X0+.5*DX, YT,1.2*CSDDV,0.,2)
- CALL DZDBOX(X0,X2,Y0STOR,Y0STOR+DY,0)
- CALL DZDBOX(X0,X2,Y0STOR,Y0STOR+DY,0)
-
-* Y0 for the first box for banks
-
- Y0 = GRYDDV * FLOAT(NROWS-NROWHD)
-
-* loop on divisions
-
- DO 30 I=1,20
- CALL MZSDIV (IXIN,1)
- IFAD = LQSTA(KQT+I)
- ILAD = LQEND(KQT+I)
- IF(IFAD .NE. 0 .AND. IFAD .NE. ILAD)THEN
- Y(1) = Y0STOR
- Y(2) = Y0STOR+DY
- XL = X0+DX*FLOAT(IFAD)/XWSTOR
- X(1) = XL
- X(2) = XL
- XDIV(1,I)=XL
- CALL DZDGPL(2,X,Y)
- CALL MZSDIV (IXIN,1)
- IF(I .EQ. JQDIVI)THEN
- Y(2) = Y0+2.*DY
- X(2) = X0
- Y(3) = Y(2) - DY
- X(3) = X(2)
- CALL DZDGPL(3,X,Y)
- CALL MZSDIV (IXIN,1)
- Y(2) = Y0STOR + DY
- X(2) = XL
- ENDIF
- XR = X0+DX*FLOAT(ILAD)/XWSTOR
- X(1) = XR
- X(2) = XR
- XDIV(2,I)=XR
- CALL DZDGPL(2,X,Y)
- IF(INDEX(CHOPT,'C').NE.0)
- & CALL DZDIFA(XL,XR,Y(1),Y(2),1,3)
- CALL MZSDIV (IXIN,1)
- IF(I .EQ. JQDIVI)THEN
- Y(2) = Y0+2.*DY
- X(2) = X2
- Y(3) = Y(2) - DY
- X(3) = X(2)
- CALL DZDGPL(3,X,Y)
- CALL MZSDIV (IXIN,1)
- Y(2) = Y0STOR+DY
- X(2) = XR
- ENDIF
- CALL UHTOC(IQDN1(KQT+I),4,CTEMP(1:4),4)
- CALL UHTOC(IQDN2(KQT+I),4,CTEMP(5:8),4)
- Y(1) = Y0STOR + DY/2.
- Y(2) = Y(1)
- X(1) = XL
- X(2) = XR
- XM = 0.5*(XL+XR)
- IF(XR-XL .GT. 6.*CSDDV)THEN
-* CALL DZDTXT(CTEMP,0,XM,Y(1),CSDDV,0.,2)
- CALL MZSDIV (IXIN,1)
- X(2) = XM-3.*CSDDV
- CALL DZDGPL(2,X,Y)
- X(1) = XM+3.*CSDDV
- X(2) = XR
- CALL DZDGPL(2,X,Y)
- ELSE
-* CALL DZDTXT(CTEMP,0,XM,Y(1)-GRYDDV,CSDDV,0.,2)
- CALL DZDGPL(2,X,Y)
- ENDIF
- ENDIF
- 30 CONTINUE
-
- CALL MZSDIV (IXIN,1)
- IF(LENGLQ .LE. 1) GOTO 70
-
- LENBLO = LENGLQ/(NROWS-NROWHD-NROWBO-1)
- NLDIV = 1
- 40 CONTINUE
- NLDIV = NLDIV * 10
- IF(LENBLO .GT. 10*NLDIV)GOTO 40
- LENBLO = (LENBLO+NLDIV) / NLDIV * NLDIV
-
- NROWAC = NROWS
- XENBLO = LENBLO
- 50 CONTINUE
- LENLAS = LENGLQ - LENBLO*(NROWAC-1)
- IF(LENLAS .LT. 0)THEN
- NROWAC = NROWAC - 1
- GOTO 50
- ENDIF
-
-* draw boxes containing the banks
-
- X1B = X0
- X2B = X2
- Y1B = Y0 - (FLOAT(NROWAC-1)+.1)*GRYDDV
- Y2B = Y0 + DY - 0.1*GRYDDV
-
- DO 60 I=1,NROWAC
- Y1 = Y0 - (FLOAT(I-1)+0.1)*GRYDDV
- Y2 = Y1 + DY
- IF(I .NE. NROWAC)THEN
- X22 = X0+DX
- ELSE
- X22 = X0 + DX*FLOAT(LENLAS)/XENBLO
- ENDIF
- CALL DZDBOX(X0,X22,Y1,Y2,0)
- IFWBLO = (I-1)*LENBLO+1+IFW
- WRITE(CFWBLO,'(I8)')IFWBLO
- XT = .04
- CALL DZDTXT(CFWBLO,0,X0-0.5*CSDDV,Y1+0.1*CSDDV,CSDDV,0.,3)
- CALL MZSDIV (IXIN,1)
- 60 CONTINUE
-
- REQINP = .FALSE.
- CALL DZDST1(IXIN,IFW,ILW,REQINP,PX,PY,
- + LRET,IFARET,ILARET,CHOPT)
-
- 70 CONTINUE
-
-* is interactive version required ?
- IF(INDEX(CHOPT,'I') .EQ. 0)GOTO 220
- GRYMEN = 1./FLOAT(NROWS)
- GRXMEN = GRYMEN
-
-* build the menu
-
- X0MEN=0.1*GRXMEN
- Y0MEN=0.1*GRYMEN
- X1MEN=X0MEN+8.*GRXMEN
- Y1MEN=Y0MEN+FLOAT(NITEM)*0.9*GRYMEN
- CHITEM(1)='Quit'
- CHITEM(2)='Zoom'
- IF(IWMETA.GT.0)THEN
- CHITEM(3)='>Plotfi'
- ELSE
- CHITEM(3)=' '
- ENDIF
- CHITEM(4)='Help'
- CHITEM(5)='LaTeX'
-* display only
- CALL IGMENU(0,' ',X0MEN,X1MEN,Y0MEN,Y1MEN,
- + 0,CTEMP,NITEM,CHITEM,
- + CTEMP,CTEMP,ICHOIC,'DT'//CMMENU)
- ICHOIC=0
-
-* fix x-locations where menus go
-
- X0DIVL=X1MEN + 0.1*GRXMEN
- Y0DIVL=0.1*GRYMEN
- X1DIVL=X0DIVL+16.*GRXMEN
-
- X0STOL=X1DIVL + 0.1*GRXMEN
- Y0STOL=0.1*GRYMEN
- X1STOL=X0STOL+16.*GRXMEN
-
- IPDIV=0
- IPSTO=0
-
-* loop here and execute commands
-
- 90 CONTINUE
-
-* division list
-
- CALL UHTOC(IQTABV(KQT+11),4,CTEMP,8)
- WRITE(CTEMP1,'(I8)')NWSTOR
- CTITLE='Store '//CTEMP//' Len'//CTEMP1
- DO 100 I=1,20
- YDIV(1,I) = 0.
- YDIV(2,I) = 0.
- IFAD = LQSTA(KQT+I)
- ILAD = LQEND(KQT+I)
- IF(IFAD .NE. 0 .AND. IFAD .NE. ILAD)THEN
- YDIV(1,I) = Y0STOR - FLOAT(I+1)*GRYMEN
- YDIV(2,I) = YDIV(1,I)+DY
- CALL UHTOC(IQDN1(KQT+I),4,CTEMP(1:4),4)
- CALL UHTOC(IQDN2(KQT+I),4,CTEMP(5:8),4)
- WRITE(CDIV,'(I2)')I
- LW=ILAD-IFAD+1
- WRITE(CTEMP1,'(I8)')LW
- IPDIV=IPDIV+1
- IDIVLI(IPDIV)=I
- CDIVLI(IPDIV)= 'Div '//CDIV//' '//CTEMP//' length'//CTEMP1
-
- ENDIF
- 100 CONTINUE
-* display the division list
-
- Y1DIVL=Y0DIVL+FLOAT(IPDIV+1)*0.9*GRYMEN
- CALL IGMENU(0,CTITLE,X0DIVL,X1DIVL,Y0DIVL,Y1DIVL, 0,CTEMP,IPDIV,
- +CDIVLI, CTEMP,CTEMP,ICHOIC,'D'//CMMENU)
-
-* store list
-
- DO 130 I=1,NQSTOR+1
- IIST = 0
- CALL SBYT(I-1,IIST,27,6)
- CALL MZSDIV(IIST,-7)
- NWST1 = LQSTA(KQT+21)
- CALL UHTOC(IQTABV(KQT+11),4,CTEMP,8)
- WRITE(CTEMP1,'(I8)')NWST1
- WRITE(CDIV,'(I2)')I-1
- IPSTO=IPSTO+1
- ISTOLI(IPSTO)=I-1
- CSTOLI(IPSTO)= 'Store '//CDIV//' '//CTEMP//' length'//CTEMP1
-
- 130 CONTINUE
- CALL MZSDIV(IXIN,-7)
-
-* display the store list
-
- Y1STOL=Y0STOL+FLOAT(IPSTO+1)*0.9*GRYMEN
- CALL IGMENU(0,'Stores',X0STOL,X1STOL,Y0STOL,Y1STOL, 0,CTEMP,
- +IPSTO,CSTOLI, CTEMP,CTEMP,ICHOIC,'D'//CMMENU)
-
-
-* ENDIF
- IF(IWMETA .GT. 0 .AND. METAFL .EQ. 1)THEN
- CALL IDAWK(IWMETA)
- CMMENU=' '
-* CALL IACWK(IWDISP)
- METAFL = 2
- CALL IGMENU(0,' ',X0MEN,X1MEN,Y0MEN,Y1MEN, 0,CTEMP,NITEM,
- + CHITEM, CTEMP,CTEMP,ICHOIC,'DT'//CMMENU)
-
- ICHOIC=0
- ENDIF
- IF(IFOMED.EQ.3)THEN
- WRITE(LUNGRA,'(A)')' } '//BS//'ep'
- IFOMED=1
- ENDIF
-
- 160 CONTINUE
-* quit
-
- IF(ICHOIC.EQ.1)GOTO 220
-
-* Help
- IF(ICHOIC.EQ.4)THEN
- CALL DZDHLV
- GOTO 80
- ENDIF
-
-* LaTeX output
-
- IF(ICHOIC.EQ.5 .AND. METAFL.EQ.0)THEN
- LUNGRA=IQPRNT
- PAGECM=14./20.
- IFOMED=3
- WRITE(LUNGRA,'(A)')
- & ' '//BS//'bp(14,14)(0, 0) {'//BS//'small '//BS//'sf '
- GOTO 10
- ENDIF
-
-* write on metafile
-
- IF(IWMETA .GT. 0 .AND. METAFL .EQ. 0
- +.AND. ICHOIC.EQ.3)THEN
- METAFL = 1
- GOTO 20
- ENDIF
-
-* zoom
-
- IF(ICHOIC.EQ.2)THEN
- IFAD = 0
- ILAD = 0
- IPNT = 0
- REQINP = .TRUE.
- 170 CONTINUE
- CALL IRQLC(IWDISP,ILOCNR,ISTAT,NTR,PX,PY)
- IF(ISTAT.EQ.0)GOTO 220
-* quit
- IF(.NOT. DZDINB(PX,PY,X1B,X2B,Y1B,Y2B))GOTO 180
- CALL DZDST1(IXIN,IFW,ILW,REQINP,PX,PY,
- & LRET,IFARET,ILARET,CHOPT)
-
- IF(LRET .EQ. 0)GOTO 180
- IF(IFAD .EQ. 0)THEN
- IFAD = IFARET
- ELSE
- IF(IFARET .LT. IFAD)IFAD = IFARET
- ENDIF
- IF(ILARET .GT. ILAD)ILAD = ILARET
- IPNT = IPNT + 1
- IF(IPNT .LT. 2)THEN
- GOTO 170
- ELSE
- GOTO 190
- ENDIF
- 180 CONTINUE
- WRITE(*,*)' Locator not inside bank'
- GOTO 170
- 190 CONTINUE
- METAFL = 0
- IFW = IFAD
- ILW = ILAD
- GOTO 20
- ENDIF
-
-* request inputs
-
-* the main menu
-
- 80 CONTINUE
-
- CALL IGMENU(0,'Choose',X0MEN,X1MEN,Y0MEN,Y1MEN,
- + 0,CTEMP,NITEM,CHITEM,
- + CTEMP,CTEMP,ICHOIC,'HCT')
- IF(ICHOIC.EQ.-1000)GOTO 220
- IF(ICHOIC.NE.0)GOTO 160
-
-* the division list
- IF(IPDIV.GT.0)THEN
- CALL IGMENU(0,CTITLE,X0DIVL,X1DIVL,Y0DIVL,Y1DIVL, 0,CTEMP,
- + IPDIV,CDIVLI, CTEMP,CTEMP,ICHOIC,'CN')
-
- IF(ICHOIC.GT.0 .AND. ICHOIC.LE.20)THEN
- IXIN=IDIVLI(ICHOIC)
- CALL SBYT(IST, IXIN,27,6)
- GOTO 10
- ENDIF
- ENDIF
-
- IF(IPSTO.NE.0)THEN
- CALL IGMENU(0,'Stores',X0STOL,X1STOL,Y0STOL,Y1STOL,
- + 0,CTEMP,IPSTO,CSTOLI,
- + CTEMP,CTEMP,ICHOIC,'CN')
- IF(ICHOIC.GT.0 .AND.ICHOIC.LE.16)THEN
- I=ISTOLI(ICHOIC)
- IXIN=2
- CALL SBYT(I,IXIN,27,6)
- METAFL = 0
- GOTO 10
- ENDIF
- ENDIF
- PX=RQUEST(11)*XRANGE
- PY=RQUEST(12)*YRANGE
- 200 CONTINUE
-* in store box
-
- IF(DZDINB(PX,PY,X0,X2,Y0STOR,Y0STOR+DY))THEN
- DO 210 I=1,20
- IF(PX .GT. XDIV(1,I) .AND. PX .LE. XDIV(2,I))THEN
- IXIN = I
- CALL SBYT(IST, IXIN,27,6)
- METAFL = 0
- GOTO 10
- ENDIF
- 210 CONTINUE
- WRITE(*,*)' No active division'
- GOTO 80
- ENDIF
-
-* in division area
-
- IF(DZDINB(PX,PY,X1B,X2B,Y1B,Y2B))THEN
- REQINP = .TRUE.
- CALL DZDST1(IXIN,IFW,ILW,REQINP,PX,PY,
- & LRET,IFARET,ILARET,CHOPT)
-
- IF(LRET .NE. 0)THEN
- IF(LACTWK)CALL IDAWK(IWDISP)
- CALL DZDISP(IXIN,LRET,RZPATH,CHOPT1, IWDISP, IWMETA,
- + ILOCNR, IWKTYP)
- IF(LACTWK)CALL IACWK(IWDISP)
- IF(IFQUIT .NE. 0)GOTO 220
- ENDIF
- GOTO 20
- ENDIF
- GOTO 80
- 220 CONTINUE
- IF(LACTWK)THEN
- CALL IDAWK(IWDISP)
- ENDIF
- END
diff --git a/src/graflib/dzdoc/dzdraw/dzddoc.F b/src/graflib/dzdoc/dzdraw/dzddoc.F
deleted file mode 100644
index e1d2509..0000000
--- a/src/graflib/dzdoc/dzdraw/dzddoc.F
+++ /dev/null
@@ -1,1552 +0,0 @@
-*
-* $Id: dzddoc.F,v 1.2 1997/03/14 14:20:32 mclareni Exp $
-*
-* $Log: dzddoc.F,v $
-* Revision 1.2 1997/03/14 14:20:32 mclareni
-* WNT mods
-*
-* Revision 1.1.1.1.2.1 1997/01/21 11:24:57 mclareni
-* All mods for Winnt 96a on winnt branch
-*
-* Revision 1.1.1.1 1996/03/04 16:13:17 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDDOC(IXSTOR,L,CHBANK,CHOPT,IF1,IL1,LUN,CHPF,NKEEPS)
-*.
-*. INPUT : IXSTOR store index
-*. L link to bank to be dumped
-*. CHOPT character option
-*. 'U' suppress list of UNDEFIND
-*. 'K' Keep sequences
-*. 'D' INTEGER statements for data offsets
-*. 'O' Parameter statements for data offsets
-*. 'Z' force hexadecimal (DZSHOW)
-*. 'T' list also pure Character banks 1 word/line
-*. 'C' list value only (useful for output read by
-*. another program
-*. '=' list as IQ(LCHBANK(1)+IOFF)=value
-*. 'R' try to recover from incomplete doc
-*. 'V' return data word values into VVAR
-*. 'P' return path to data word into VVAR
-*. 'I' return IO char into CHPF
-*. 'E' examine, check range
-*. IFIRST first word to dump
-*. ILAST last word
-*. LUN output unit
-*. CHPF prefix when making FORTRAN code (data words)
-*. NKEEPS # of data words for which offsets
-*. have been gen
-*. OUTPUT :
-*.
-*. CALLS : DZSHOW UOPTC ,MZDROP,RZIN,UCTOH, DZSHOW
-*. CALLED : DZDISP, USER
-*.
-*. AUTHOR : O.Schaile
-*. VERSION : 1.00
-*. CREATED : 7-Aug-88
-*. LAST MOD : 18-OCT-92
-*.**********************************************************************
- CHARACTER*(*) CHOPT, CHPF
- CHARACTER*40 CHPFI
- CHARACTER*8 CHBANK
- INTEGER KEYVEC(2), IWHOLL, NLSKIP,IDELAY
- CHARACTER*11 CVAL, CVALSA
- CHARACTER*21 CLOOP
- CHARACTER*1 COPTDZ
- CHARACTER*80 CLINE, CLINSA, CLINDE
- CHARACTER*8 CVAR, CVAR1
- CHARACTER*12 CTEMP
- SAVE LUNINT, IOCH
- PARAMETER (LUNINV=41)
- LOGICAL NEWVAL,KEEPSQ,INHOLL,REPEND, NEWPNT, LRECOV, ENDED
-* pointer stuff
- INTEGER MAXP, IPOINT
- PARAMETER (MAXP=200)
- CHARACTER*8 CVARP, CHREPC
- CHARACTER*8 CPOINT(MAXP)
- INTEGER POINT(MAXP),NPOINT(MAXP), IWDOC,IWDOCO,IWORD, IF11,IL11,
- + NSTYP, IPCHPF
- CHARACTER*1 CHARIO,CHARIS
- CHARACTER*7 CHARIA
- CHARACTER*32 CVARNM
-
-* for returning values
- INTEGER VVAR(100), NVAL,ITY, MAXVAL
- INTEGER VALINT
- REAL VALREA
- EQUIVALENCE (VALINT,VALREA)
- CHARACTER*8 CVREQ
- LOGICAL REPATH, NOTFIL
- CHARACTER*13 SPACES
- EXTERNAL SPACES
-#if defined(CERNLIB_NONEWL)
-#include "dzdoc/nonewl2.inc"
-#endif
-#if !defined(CERNLIB_NONEWL)
-#include "dzdoc/nonewl1.inc"
-#endif
-*
-#include "dzdoc/bkwrp.inc"
-#include "dzdoc/tapes.inc"
-* From DZEBRA
-#include "zebra/zbcdk.inc"
-#include "zebra/zunit.inc"
-#include "dzdprm.inc"
-#include "dzdoc/linout.inc"
-#include "dzdoc/docparq.inc"
- CHARACTER CQSTAK*13,CQINFO*40
- PARAMETER (NLICHQ=130,NSTCHQ=8,NDVCHQ=8,NBKCHQ=4 )
- CHARACTER CQLINE*(NLICHQ),CQMAP(10)*(NLICHQ)
- CHARACTER CQSTOR*(NSTCHQ),CQDIV*(NDVCHQ),CQID*(NBKCHQ)
- COMMON /DZC1CH/ CQSTOR,CQDIV,CQID,CQMAP,CQSTAK,CQINFO
- EQUIVALENCE (CQLINE,CQMAP)
-#include "dzdoc/bknuparq.inc"
-#include "zebra/bkfoparq.inc"
-#include "dzdoc/bkstparq.inc"
-#include "dzdoc/bktgparq.inc"
-#include "dzdoc/bktgdatq.inc"
-*
- DATA CHARIA/'BIFDHUR'/
- DATA LUNINT/0/
-*------
- IENTRY=1
- ITY=0
- IF11=IF1
- IL11=IL1
- IF(INDEX(CHOPT,'K').NE.0 .OR. INDEX(CHOPT,'I').NE.0)THEN
- KEEPSQ=.TRUE.
- ELSE
-#include "zebra/qstore.inc"
- IF(IL11.GT.IQ(KQS+L-1))IL11=IQ(KQS+L-1)
- KEEPSQ=.FALSE.
- ENDIF
- NSTYP=0
- CHARIS=' '
- CHARIO=' '
- IF(INDEX(CHOPT,'D').NE.0)THEN
- IF(INDEX(CHOPT,'R').NE.0)THEN
- CHARIO='R'
- ELSE
- CHARIO='I'
- ENDIF
- ENDIF
- IF(INDEX(CHOPT,'I').NE.0)THEN
- IPCHPF=1
- CHPF=' '
- ELSE
- CALL UCTOH(CHBANK,KEYVEC,4,8)
- ENDIF
- LUC = LUN
- REPATH=.FALSE.
- MAXVAL=0
- GOTO 2
-
- ENTRY DZDGVA(IXSTOR, L, CHOPT,CVREQ,NVAL,VVAR,ITYYY)
- IF(L.EQ.0)GOTO 990
-#include "zebra/qstore.inc"
- LUC = 6
- IF11=1
- IL11=IQ(KQS+L-1)
- MAXVAL=NVAL
- NVAL=0
- IENTRY=2
- ITY=-1
- IPREP0=0
- IPREP1=0
- IPDRE0=0
- IPDRE1=0
- NOTFIL=.TRUE.
- IF(INDEX(CHOPT,'P').NE.0)THEN
- REPATH=.TRUE.
- ELSE
- REPATH=.FALSE.
- ENDIF
- KEYVEC(1)=IQ(KQS+L-4)
- LUP=LQ(KQS+L+1)
- IF(LUP.NE.0)THEN
- KEYVEC(2)=IQ(KQS+LUP-4)
- ELSE
- CALL UCTOH('NONE',KEYVEC(2),4,4)
- ENDIF
-
-2 LUNINT = LUNINV
- LUNSAV = IQPRNT
- IDENTF=0
- IWDOCO=0
- NEXTRA=0
- IMBED2=0
- IOCH = -1
- IPOINT=0
- DO 5 I=1,MAXP
- POINT(I) = -1
- CPOINT(I) = ' '
-5 NPOINT(I) = -1
-
-* IREPC=-2
- IPRKEE=0
- NLSKIP=0
- IDELAY=0
- CLINSA=' '
- LCLINE = LEN(CLINE)
- IPLINE = 1
- INHOLL = .FALSE.
- IF(INDEX(CHOPT,'R').NE.0)THEN
- LRECOV=.TRUE.
- ELSE
- LRECOV=.FALSE.
- ENDIF
- ENDED =.FALSE.
- REPEND=.FALSE.
- NEWPNT=.FALSE.
- IF(KEEPSQ)THEN
- NBLENG = IL1
- ELSE
- NBLENG = IQ(KQS+L-1)
- KEEPSQ=.FALSE.
-* CALL CLTOU(CHOPT)
- IF(INDEX(CHOPT,'Z').NE.0)THEN
- COPTDZ='Z'
- ELSE
- COPTDZ=' '
- ENDIF
- CALL UCTOH ('$LF/',IILFLF,4,4)
- ENDIF
- IF(INDEX(CHOPT,'C').NE.0 .AND. .NOT.KEEPSQ)THEN
- IQPRNT=LUC
- IW1=IF11
- GOTO 90
- ENDIF
- IF(INDEX(CHOPT,'I').EQ.0)
- +CALL DZDGDO(0,LQBKD1,KEYVEC,CLINE,IFC,ILC,ICYCLE)
- IF(LQBKD1.EQ.0)THEN
- IF(KEEPSQ .OR. INDEX(CHOPT,'V').NE.0)THEN
- WRITE(LUC,'(A)')'* No documentation for '//CHBANK(1:4)
- GOTO 990
- ENDIF
- NDATA = 0
- ELSE
-
- IF(ICYCLE.LT.0)WRITE(LUC,'(A)')
- & ' **** Requested version not found ****'
- IPDATA = IQ(KQS+LQBKD1+MBHEAQ) + IQ(KQS+LQBKD1+MBGENQ)
- + +IQ(KQS+LQBKD1+MBLINQ) + IQ(KQS+LQBKD1+MBRLIQ)
- & +IQ(KQS+LQBKD1+MBBITQ) + 1
- IP1 = 0
- IP2 = 0
- IC1 = 0
- IC2 = 0
- IWORD = 0
- IWORDR=0
- IREPL=0
- IFREPL = 0
- CHREPC=' '
- ILOWRC=0
- IUPERC=0
- LOOPC1=-1
- LOOPC2=-1
- IPFORM=0
- ICFORM=0
- IMFORM=0
- LALILE=0
- IP = KQS+LQBKD1+IPDATA
- IPSAVE=IP
- NDATA = IQ(KQS+LQBKD1+MBDATQ)
- ENDIF
-
- IF(INDEX(CHOPT,'Q').EQ.0 .AND.
- & INDEX(CHOPT,'V').EQ.0 .AND.
- & .NOT.KEEPSQ)THEN
- IF(INDEX(CHOPT,'E').EQ.0)THEN
- WRITE(LUC,'(10A)')
- &' -------- Data of Bank/UpBank: ',CHBANK(1:4),'/',CHBANK(5:8),
- & ' Doc Version: ',CLINE(IFC:ILC), ' ----------'
- ELSE
- WRITE(LUC,'(10A)')
- & ' Checking data of Bank/UpBank: ',CHBANK(1:4),'/',CHBANK(5:8)
- ENDIF
- ENDIF
-
- IF(NDATA.GT.0)THEN
- IC9 = 10
- ELSE
- IQPRNT = LUC
- IW1 = IF11
- WRITE(LUC,'(A)')
- + '* Data words not documented for '//CHBANK(1:4)
- IF(KEEPSQ .OR. INDEX(CHOPT,'V').NE.0)THEN
- GOTO 990
- ELSE
- GOTO 90
- ENDIF
- ENDIF
- LDATUM = IP + NDATA
- IWDOC = 0
-
-* IF(.NOT.KEEPSQ) WRITE(LUC,*)' '
-*
-* IF11,IL11 first, last word to be doc'td
-* IWORD current word in data
-* IWORDR current word in rep section
-* IWDOC word announced in documentation
-* IWDOCO remember announced word (for cont lines)
-* IP pointer in documentation
-* IP1 remember IP for start of rep lev 1
-* IP2 remember IP for start of rep lev 2
-* IC1,IC2 repetition counter 1, 2
-* IT type of info in doc
-* 2 integer
-* 5 holl
-* NW # of words in doc
-* IDENT ITGREQ describe rep
-* ITGENQ describe seq # of data
-* NEWVAL if false: cont card
-* INHOLL holl text in data words started
-* IPFORM pointer to a key descriptor format (see RZ)
-* LOOPC1 or LOOPC2)loop counters in rep section
-*
-
-
- 10 CONTINUE
- IF(IP .GE. LDATUM)THEN
- IF(.NOT.KEEPSQ)THEN
- IQPRNT = LUC
- ENDED=.TRUE.
- NEWVAL=.TRUE.
- IP=IPSAVE
- ENDIF
- IF(KEEPSQ)GOTO 990
- ENDIF
- IT = MOD(IQ(IP),16)
- NW = IQ(IP)/16
-* WRITE(*,*)' IT,NW,IP ',IT,NW,IP
- IF(NW .LE. 0)THEN
- WRITE(LUC,'(A,2I9)')' Illegal NW at IPDATA ',NW,IPDATA
- GOTO 990
- ENDIF
-
-* start hollerith sector
-
- IF(IT .EQ. 5)THEN
-* WRITE(*,*)' IDENTF= ',IDENTF
-* try to get rep count name and range
- IF(KEEPSQ .AND. ABS(IDENTF).EQ. ITGREQ)THEN
- NCH=MIN(NW*4,LEN(CLINE))
- CLINE=' '
- CALL UHTOC(IQ(IP+1),4,CLINE,NCH)
- NCH=LNBLNK(CLINE)
- ICOLON=INDEX(CLINE(1:8),':')+1
- CHREPC=CLINE(ICOLON:8)
- IFC=INDEX(CLINE,'[')
- ILC=INDEX(CLINE,']')
- IFC=IFC+1
- ILC=ILC-1
- NC=INDEX(CLINE(IFC:ILC),',')
- IF(NC.EQ.0)NC=INDEX(CLINE(IFC:ILC),':')
- IF(IFC.GT.1 .AND. ILC.GT.IFC+2 .AND. NC.NE.0)THEN
- ILC1=IFC+NC-2
- IFC2=ILC1+2
- CALL DZDCTI(CLINE(IFC:ILC1),ILOWRC)
- CALL DZDCTI(CLINE(IFC2:ILC),IUPERC)
- ENDIF
- ENDIF
- IF(IDENTF .NE. ITGENQ) GOTO 80
-
-* rep count = 0 calc from data word
-* IF(IREPC .EQ. 0)GOTO 80
-
- IF( IWORD+1 .NE. IWDOC
- + .AND. IP1+IP2 .EQ. 0
- + .AND. IWDOC .NE. IWDOCO )THEN
- IWDOCO = -1
- ENDIF
-
-* rep section ended already?
-
- IF(REPEND)GOTO 80
-
-* look if more words documented then announced
-
- IF(NEXTRA.LT.0 .AND. LRECOV)THEN
- IF(IWDOC.GT.ABS(NEXTRA))THEN
- GOTO 80
- ENDIF
- ENDIF
-
-* is it not continuation card for same item
-* or not a start of rep section
-
- NEWVAL = .FALSE.
-* WRITE(*,*)'IWDOCO ,IWDOC, IWORD', IWDOCO ,IWDOC, IWORD
- IF(IWDOCO .NE. IWDOC .OR. IWDOCO .LE. 0 .OR. NEWPNT)THEN
- IWORD = IWORD+1
- IWORDR = IWORDR+1
- NEWVAL = .TRUE.
- ENDIF
-* remember possible repetition count
- IVALLW = IQ(KQS+L+IWORD)
-
- IF(IWORD .GT. IL11)GOTO 990
- IF(IWORD .LT. IF11)GOTO 80
-
-* look if all words are hollerith
-
- IF(IOCH .LT. 0)THEN
- NIO = JBYT(IQ(KQS+L),19,4)
- NL = IQ(KQS+L-3)
- IOFFBS = - (NIO + NL + 8 + 1)
- IOCH = JBYT(IQ(KQS+L+IOFFBS),17,16)
- IF(IOCH .EQ. 5 .AND. INDEX(CHOPT,'Z').EQ. 0
- + .AND. INDEX(CHOPT,'T').EQ. 0)THEN
- IF(.NOT.KEEPSQ)THEN
- WRITE(LUC,'(1X,2A4,1X,100(15A4/7X))')
- + (IQ(IP+K),K=1,NW)
- WRITE(LUC,'(A)')'---- '
- ENDIF
- NEWVAL = .TRUE.
- ENDIF
- ENDIF
-
-* loop here if all words are hollerith
-
- 20 CONTINUE
-* empty text buffer at end
- IF(IWORD .GT. IL11)THEN
- IF(IPLINE .GT. 1)THEN
- IF(.NOT.KEEPSQ)
- + WRITE(LUC,'(14X,A)')CLINE(1:IPLINE-1)
- IPLINE = 1
- ENDIF
- GOTO 990
- ENDIF
-
-* get the printed value from CQLINE of DZSHOW (Quiet option)
- IF(NEWVAL .AND.
- & .NOT.KEEPSQ .OR.
- & (NEWVAL .AND. INDEX(CHOPT,'V').NE.0 .AND. ITY.EQ.-1)
- & )THEN
- IF(IC9 .GE. 9 .OR. NEWPNT)THEN
- CALL DZSHOW(' ',IXSTOR, L,COPTDZ//'Q',1,0,IWORD,IWORD+8)
- IC9 = 1
- ELSE
- IC9 = IC9+1
- ENDIF
- IBV1 = IC9*12
- IBV2 = IBV1+10
- CVAL = CQLINE(IBV1:IBV2)
- CVALSA=CVAL
- ELSE
- CVAL = ' '
- ENDIF
-* collect text on CLINE
- IF(IOCH .EQ. 5 .AND.
- + INDEX(CHOPT,'Z').EQ.0 .AND.
- + INDEX(CHOPT,'T').EQ. 0 )THEN
- IF(IPLINE .GE. LCLINE)THEN
- IF(.NOT.KEEPSQ)
- + WRITE(LUC,'(14X,A)')CLINE(1:IPLINE-1)
- IPLINE = 1
- ENDIF
- CLINE(IPLINE:IPLINE+3)=CVAL(8:11)
- IPLINE = IPLINE+4
- IF(INHOLL)THEN
- IWORD = IWORD+1
- GOTO 20
- ELSE
- INHOLL = .TRUE.
- CVAL = ' '
- ENDIF
- ELSE
-
-* output other then pure text, empty text buffer
-
- IF(IPLINE .GT. 1)THEN
- IF(.NOT.KEEPSQ .AND.INDEX(CHOPT,'V').EQ.0)
- & WRITE(LUC,'(14X,A)')CLINE(1:IPLINE-1)
- IPLINE= 1
- ENDIF
- INHOLL = .FALSE.
- ENDIF
-
- CALL UHTOC(IQ(IP+1),4,CVAR,8)
-
-* return value?
-
- IF(INDEX(CHOPT,'V').NE.0)THEN
- IF(CVAR.EQ.CVREQ)THEN
-* find data type
- IF(ITY.LT.0)THEN
- IF (INDEX(CVAL,'"').NE.0)THEN
- ITY=5
- ELSE IF(INDEX(CVAL,'.').NE.0)THEN
- ITY=3
- ELSE
- ITY=2
- ENDIF
- ENDIF
-* return path only?
- IF(REPATH)THEN
- IF(NOTFIL)THEN
- NOTFIL=.FALSE.
- NVAL=NVAL+1
- IF(IREPL.LE.1)THEN
- VVAR(NVAL)=IWORD-IPREP0
- ELSE
- VVAR(NVAL)=IWORD-IPREP1
- ENDIF
- ENDIF
- ELSE
- IF(ITY.EQ.5)THEN
- WRITE(*,*)'Holleriths not yet supported'
- ITY=5
- GOTO 80
- ENDIF
- NVAL=NVAL+1
- VVAR(NVAL)=IQ(KQS+L+IWORD)
- ENDIF
- ENDIF
- IF(NVAL.EQ.MAXVAL)THEN
- IF(MAXVAL.GT.1)WRITE(*,*)
- & 'Max number of values reached', MAXVAL
- GOTO 990
- ELSE
- GOTO 80
- ENDIF
- ENDIF
-
- CVAR1 = CVAR
- CALL CLTOU(CVAR1)
-
-* conVert it by ZITOH?
-
- IF (CVAR1(1:2).EQ.'Z:')THEN
- CALL ZITOH(IQ(KQS+L+IWORD),IWHOLL,1)
- CVAL=' '
- CALL UHTOC(IWHOLL,4,CVAL,4)
-* format of a Key descriptor
- ELSE IF(CVAR1(1:2).EQ.'F:')THEN
- IF(IPFORM.EQ.0)IPFORM=KQS+L+IWORD
- DO 15 I=1,10
- IFM=JBYT(IQ(KQS+L+IWORD),(I-1)*3+1,3)
- IF (IFM.EQ.1)THEN
- CVAL(I:I)='I'
- IMFORM=IMFORM+1
- ELSE IF(IFM.EQ.3)THEN
- CVAL(I:I)='H'
- IMFORM=IMFORM+1
- ELSE
- CVAL(I:I)=' '
- ENDIF
- CVAL(11:11)=' '
-15 CONTINUE
- ELSE IF(CVAR1(1:2).EQ.'K:')THEN
- ICFORM=ICFORM+1
- IF(ICFORM.GT.IMFORM)ICFORM=1
- IFC2=ICFORM/10
- IFC1=MOD(ICFORM,10)
- IF(IFC1.EQ.0)THEN
- IFC1=10
- IFC2=IFC2-1
- ENDIF
- IFM=JBYT(IQ(IPFORM+IFC2),(IFC1-1)*3+1,3)
- IF(IFM.EQ.3)THEN
- CALL ZITOH(IQ(KQS+L+IWORD),IWHOLL,1)
- CVAL=' '
- CALL UHTOC(IWHOLL,4,CVAL,4)
- ENDIF
- ELSE IF(CVAR1(1:2).EQ.'B:')THEN
- WRITE(CVAL,'(Z9)')IQ(KQS+L+IWORD)
- CVALSA=CVAL
- ELSE IF(CVAR1(1:2).EQ.'D:')THEN
- CALL RZDATE(IQ(KQS+L+IWORD),IDATX,ITIMX,1)
- WRITE(CVAL(1:6),'(I6)')MOD(IDATX,1000000)
- WRITE(CVAL(8:11),'(I4)')MOD(ITIMX,10000)
- CVAL(7:7)='/'
- ENDIF
-* pointer stuff
-
-* look if a label is reached
-
- IF(NEWPNT .OR. .NOT. NEWVAL)THEN
- NEWPNT=.FALSE.
- ELSE
- IF(IPOINT.GT.0)THEN
- DO I=1,IPOINT
- IF(IWORD.EQ.POINT(I) .AND. NPOINT(I).NE.0)THEN
-* skip in doc until label is found
- IF(ENDED)ENDED=.FALSE.
- IPP=IPSAVE
- NWP=-1
-21 IPP=IPP+NWP+1
- IF(IPP.GE.LDATUM)THEN
- WRITE(*,*)'No label found for : ',CPOINT(I)
- GOTO 26
- ENDIF
- ITP = MOD(IQ(IPP),16)
- NWP = IQ(IPP)/16
- IF(ITP.NE.5)GOTO 21
- CALL UHTOC(IQ(IPP+1),4,CVARP,8)
- CALL CLTOU(CVARP)
- IF(CVARP(1:2).NE.'L:')GOTO 21
-
- IF(CVARP(3:).EQ.CPOINT(I)(3:))THEN
-* remember for later in case identical lines are skipped
- WRITE(CLINDE,'(2A4,13X,14A4)')
- + (IQ(IPP+K),K=1,NWP)
- IDELAY=1
- IP=IPP+NWP+1
- NEWPNT=.TRUE.
-* end a possible infinite repetition
- IF(IFREPL.EQ.0)THEN
- IWORD=IWORD-1
- ELSE
- IWORD=IWORD-1
- IFREPL=0
- ENDIF
-* WRITE(*,*)'Label found',IWORD,' ',CPOINT(I)
- IWDOCO=-1
- GOTO 10
- ELSE
- GOTO 21
- ENDIF
- ENDIF
- ENDDO
- IF(ENDED)THEN
- IW1=IWORD
- GOTO 90
- ENDIF
- ENDIF
- ENDIF
-
-* is the pointer bit coded in cont card?
- IF(INDEX(CVALSA,'.').NE.0)THEN
- IF(Q(KQS+L+IWORD).GT.0. .AND. Q(KQS+L+IWORD).LT.1000000.)THEN
- IBVAL=Q(KQS+L+IWORD)
- ELSE
- IBVAL=0
- ENDIF
- ELSE
- IBVAL=IQ(KQS+L+IWORD)
- ENDIF
- IF(.NOT.NEWVAL)THEN
- IF(CVAR1(2:4).EQ.':BI')THEN
- READ(CVAR1(5:6),'(I2)',ERR=40 )I1BIT
- IF(I1BIT.GT.31)GOTO 24
- READ(CVAR1(7:8),'(I2)',ERR=24 )I2BIT
- IF(I2BIT.GT.31)GOTO 24
- IF(I2BIT.LT.I1BIT)GOTO 24
- IBVAL = JBYT(IQ(KQS+L+IWORD),I1BIT+1,I2BIT-I1BIT+1)
- IF(INDEX(CHOPT,'Z').NE.0)THEN
- WRITE(CVAL,'(Z11)')IBVAL
- ELSE
- WRITE(CVAL,'(I11)')IBVAL
- ENDIF
-* get the name
- IF(NW.LT.3)THEN
- CTEMP='XXXXXX'
- ELSE
- NCH=MIN(NW-2,2)*4
- IF(NCH.GT.6)NCH=6
- CALL UHTOC(IQ(IP+3),4,CTEMP,NCH)
-* embedded space
- IPSP=INDEX(CTEMP,' ')
- IF(IPSP.NE.0)CTEMP(IPSP:)=' '
- ENDIF
- CVAR1(3:8)=CTEMP
- ENDIF
- ENDIF
-
-24 CONTINUE
-
-* if it is a pointer or rep count of it, remember its value
-
- IF(CVAR1(1:2).EQ.'P:' .OR. CVAR1(1:2).EQ.'N:')THEN
-* already there?
- IF(IPOINT.GT.0)THEN
- DO I=1,IPOINT
- IF(CPOINT(I).EQ.CVAR1)THEN
-* IF(CVAR1(1:2).EQ.'P:')THEN
-* IF(POINT(I).GE.0)THEN
-* IF(POINT(I) .LT. IQ(KQS+L+IWORD))
-* & POINT(I)=IQ(KQS+L+IWORD)
-* WRITE(*,*)'Ambigous pointer: ', CPOINT(I)
-* ELSE
-* POINT(I)=IBVAL
-* GOTO 25
-* ENDIF
-* ELSE
- IF(CVAR1(1:2).EQ.'N:')THEN
- IF(NPOINT(I).GE.0)THEN
- WRITE(*,*)'Ambigous rep count: ', CPOINT(I)
- ELSE
-* may be a simple expression of the value
- CALL DZDGRC(IQ(IP),2,IBVAL,IREPC,NEXTRA,
- & IDUMMY,0,NDUMMY)
- IF(IREPC.GT.0)IBVAL=IREPC
- NPOINT(I)=IBVAL
- GOTO 25
- ENDIF
- ENDIF
- ENDIF
- ENDDO
- ENDIF
- IPOINT=IPOINT+1
- IF(IPOINT.GT.MAXP)THEN
- WRITE(*,*)'Too many pointers:',IPOINT
- ELSE
- CPOINT(IPOINT)=CVAR1
- IF(CVAR1(1:2).EQ.'P:')THEN
- POINT (IPOINT)=IBVAL
-* does it point to same as previous
- IF(IPOINT.GT.1)THEN
- DO I=1,IPOINT-1
- IF(POINT(I).EQ.POINT(IPOINT)
- & .AND. POINT(I).NE.0)THEN
- POINT(I)=-1
- WRITE(*,*)'Pointer: ',CPOINT(I),
- & ' overwritten by: ',CPOINT(IPOINT)
- ENDIF
- ENDDO
- ENDIF
- ELSE
-* may be a simple expression of the value
- CALL DZDGRC(IQ(IP),2,IBVAL,IREPC,NEXTRA,
- & IDUMMY,0,NDUMMY)
- IF(IREPC.GT.0)IBVAL=IREPC
- NPOINT (IPOINT)=IBVAL
- ENDIF
- ENDIF
-25 CONTINUE
- ENDIF
-
-26 CONTINUE
-
-* pointer stuff end
-
-* if cont line then look if its mask, bitvalue or choice
- LENMSK=0
- IF(.NOT.NEWVAL)THEN
-* wildchar mask
- IF(CVAR(1:8) .EQ. 'WILDCHAR' .OR.
- & CVAR(1:4) .EQ. 'MASK')THEN
- IF(KEEPSQ)GOTO 80
-* get the mask
- IF(NW.LT.3)THEN
-* no mask provided
- GOTO 80
- ELSE
- CVAR1 = ' '
- CTEMP=' '
- NCH=MIN(NW-2,2)*4
- IF(NCH.GT.11)NCH=11
- CALL UHTOC(IQ(IP+3),4,CTEMP,NCH)
-* embedded space
- NCH=INDEX(CTEMP,' ')-1
- IF(NCH.LE.0)NCH=11
- LENMSK=NCH
- CTEMP(NCH+1:)=' '
-* look if it matches
- DO 28 I=11,1,-1
-* mask ended?
- IF(NCH.LE.0)THEN
- IF(CVALSA(I:I).EQ. ' ')THEN
- GOTO 29
- ELSE
- GOTO 80
- ENDIF
- ENDIF
-* value ended, is rest of mask *?
- IF(CVALSA(I:I).EQ. ' ')THEN
- DO 27 J=NCH,1,-1
- IF(CTEMP(J:J).NE.'*')GOTO 80
-27 CONTINUE
- GOTO 29
- ENDIF
- IF(CTEMP(NCH:NCH).EQ.'*')GOTO 28
- IF(CTEMP(NCH:NCH).NE.CVALSA(I:I))GOTO 80
-28 NCH=NCH-1
-29 CONTINUE
-* all matched, does it still fit on line?
- NCH=(NW-2)*4
- IF(NCH+LALILE-LENMSK.GT.80)GOTO 50
-
- CLINE=' '
- CALL UHTOC(IQ(IP+3),4,CLINE,NCH)
- NCH=LENOCC(CLINE)
- LALILE=LALILE+NCH-LENMSK
- WRITE(LUC,'(A'//NONEWL//')')CLINE(LENMSK+1:NCH)
- LENMSK=0
- GOTO 80
- ENDIF
- ENDIF
-
-* choice
- IF(CVAR(1:6) .EQ. 'BITVAL')THEN
- IF(KEEPSQ)GOTO 80
- READ(CVAR(7:8),'(I2)')IBIT
- IF(IAND(IQ(KQS+L+IWORD),ISHFT(1,IBIT)).EQ.0)THEN
- GOTO 80
- ELSE
- CVAR1 = ' '
- GOTO 50
- ENDIF
- ENDIF
-* choice starts with C, and
-* contains only numbers or _ + -
-*
- IF(CVAR(1:1).EQ.'C')THEN
- ILC = INDXBC(CVAR,' ')
- IF(ILC.LE.1)GOTO 40
- IFNUM = 2
- DO 30 K=2,ILC
- IF(INDXNC(CVAR(K:K)) .NE. 0
- + .AND. CVAR(K:K) .NE. '_'
- + .AND. CVAR(K:K) .NE. '-'
- + .AND. CVAR(K:K) .NE. '+')GOTO 40
- IF(CVAR(K:K) .EQ. '_')IFNUM=K+1
- 30 CONTINUE
- IF(IFNUM.GT.ILC)GOTO 40
- IF(KEEPSQ)GOTO 80
- READ(CVAR(IFNUM:ILC),'(I8)')IVAL
- IF(INDEX(CVALSA,'.').NE.0)THEN
- IBVAL=Q(KQS+L+IWORD)
- ELSE
- IBVAL=IQ(KQS+L+IWORD)
- ENDIF
- IF(IBVAL .NE. IVAL)THEN
- GOTO 80
- ELSE
- CVAR1 = ' '
- GOTO 50
- ENDIF
- ENDIF
- IF(CVAR(1:4).EQ.'BITS')THEN
- READ(CVAR(5:6),'(I2)',ERR=40 )I1BIT
- IF(I1BIT.GT.31)GOTO 40
- READ(CVAR(7:8),'(I2)',ERR=40 )I2BIT
- IF(I2BIT.GT.31)GOTO 40
- IF(I2BIT.LT.I1BIT)GOTO 40
- IBVAL = JBYT(IQ(KQS+L+IWORD),I1BIT+1,I2BIT-I1BIT+1)
- IF(INDEX(CHOPT,'Z').NE.0)THEN
- WRITE(CVAL,'(Z11)')IBVAL
- ELSE
- WRITE(CVAL,'(I11)')IBVAL
- ENDIF
- ENDIF
- ENDIF
- 40 CONTINUE
-*
- 50 CONTINUE
- IF(IWORD .LT. IF11)GOTO 80
- IF(CVAR .EQ. 'UNDEFIND' .AND. INDEX(CHOPT,'U').NE. 0)GOTO 80
- IF(KEEPSQ)THEN
-* generate FORTRAN code
- IF(NEWVAL .AND. CVAR.NE.'UNDEFIND')THEN
- ILC = INDXBC(CVAR,' ')
-* suppress D:, P: etc
- IFNCOL=MAX(1,INDEX(CVAR(1:ILC),':')+1)
-* get IO-char
- NCH=MIN((NW-2)*4,60)
- CLINE=' '
- CALL UHTOC(IQ(IP+3),4,CLINE,NCH)
- ICOLON=INDEX(CLINE,'IO:')
- IF(ICOLON.NE.0)THEN
-* skip space
- ICOLON=ICOLON+2+INDEXC(CLINE(ICOLON:),' ')
- CHARIO=CLINE(ICOLON:ICOLON)
- IF(CHARIO.EQ.'U')CHARIO='B'
- IF(CHARIO.EQ.'R')CHARIO='F'
- IOLCHA=ICOLON+INDEX(CLINE(ICOLON:),' ')-1
- ENDIF
- IF(INDEX(CHOPT,'I').NE.0)THEN
- IF(ICOLON.NE.0)THEN
- IF(INDEX(CHARIA,CHARIO).EQ.0)THEN
- WRITE(*,*)'Illegal IO-char: ',CHARIO
- CHPF=' '
- GOTO 995
- ENDIF
- IF(CHARIO.EQ.CHARIS)THEN
- NSTYP=NSTYP+1
- ELSE
- IF(NSTYP.NE.0)THEN
- CALL DZDFIO(CHPF,IPCHPF,NSTYP,CHARIS)
- IF(IPCHPF.LE.0)GOTO 995
- ENDIF
- NSTYP=1
- ENDIF
- ELSE
- IF(NSTYP.GT.0)THEN
- NSTYP=NSTYP+1
- ELSE
- WRITE(*,*)'No IO-char given yet'
- ENDIF
- ENDIF
-* end of get IO-char
- ELSE
-* if parameter statements required force Integers
- IF(INDEX(CHOPT,'p').NE.0) CHARIO='I'
-* data word offsets, assignments
- ISKC=INDEXN(CHOPT)
-* skip first ISKCC characters in data word name
- IF(ISKC.NE.0)THEN
- CALL DZDCTI(CHOPT(ISKC:ISKC),ISKCC)
- IFNCOL=MIN(IFNCOL+ISKCC,ILC)
- ENDIF
-* prepare pre or postfix
- ILPF = MIN(LNBLNK(CHPF),LEN(CHPFI))
- IF(ILPF.GT.0)THEN
- CHPFI(1:ILPF)=CHPF(1:ILPF)
- ELSE
- IF(INDEX(CHOPT,'=').NE.0)THEN
- IF(IREPL.GT.0)THEN
- CHPFI='(I)= Q(NOFF+'
- IF(CHARIO.EQ.'I')CHPFI(5:5)='I'
- ILPF=12
- ELSE
- CHPFI='= Q(NOFF+'
- IF(CHARIO.EQ.'I')CHPFI(2:2)='I'
- ILPF=9
- ENDIF
- ELSE IF((INDEX(CHOPT,'C').NE.0 .OR.
- + INDEX(CHOPT,'H').NE.0)
- + .AND.IREPL.GT.0)THEN
- IF(CHREPC.EQ.' ')THEN
- CHPFI='(MW)'
- ELSE
- CHPFI='('//CHREPC(1:2)//')'
- ENDIF
- ILPF=4
- ENDIF
- ENDIF
- IF(ILPF.GT.0)THEN
- IF(INDEX(CHOPT,'Z').EQ.0 .AND.
- + INDEX(CHOPT,'=').EQ.0 .AND.
- + INDEX(CHPFI,'(').EQ.0)THEN
- CVARNM(1:ILPF)=CHPFI(1:ILPF)
- CVARNM(ILPF+1:)=CVAR(IFNCOL:ILC)
- ELSE
- CVARNM(1:ILC-IFNCOL+1)=CVAR(IFNCOL:ILC)
- CVARNM(ILC-IFNCOL+2:)=CHPFI(1:ILPF)
- ENDIF
- ILC=ILC-IFNCOL+1+ILPF
- ELSE
- CVARNM=CVAR(IFNCOL:ILC)
- ILC=ILC-IFNCOL+1
- ENDIF
- WRITE(CVAR1,'(I8)')IWORDR
- IFC = INDEXN(CVAR1)
- IF(INDEX(CHOPT,'=').NE.0)THEN
-* data assignments
- IF(NKEEPS.EQ.0)THEN
- ILC1 = INDXBC(CHBANK(1:4),' ')
- IF(IPRKEE.LE.0)THEN
- IPRKEE=IPRKEE+1
- WRITE(LUC,'(A)')
- + 'C +KEEP,'//'DAASS'//CHBANK(1:ILC1)
- ENDIF
- ENDIF
- CALL DZDPLN(LUC,
- + CVARNM(1:ILC)//CVAR1(IFC:8)//')',2)
- ELSE IF(INDEX(CHOPT,'D').NE.0)THEN
-* declarations, commons
- IF(NKEEPS.EQ.0)THEN
- ILC1 = INDXBC(CHBANK(1:4),' ')
- IF(IPRKEE.LE.0)THEN
- IPRKEE=IPRKEE+1
- WRITE(LUC,'(A)')
- + 'C +KEEP,'//'DAOFF'//CHBANK(1:ILC1)
- ENDIF
- IF(INDEX(CHOPT,'C').NE.0)THEN
-* commons
- IF(CHPFI(1:1).EQ.'(' .AND.
- + CHPFI(ILPF:ILPF).EQ.')')THEN
-* parameter statement for dimension
- CALL DZDPLN(LUC,'INTEGER ',2)
- CHPFI(1:1)=' '
- CALL DZDPLN(LUC,CHPFI(1:ILPF-1),1)
- CHPFI(1:1)='('
- CALL DZDPLN(LUC,'PARAMETER (',2)
- CALL DZDPLN(LUC,CHPFI(2:ILPF-1)//'=',1)
- IF(IUPERC.GT.0)THEN
- WRITE(CTEMP,'(I12)')IUPERC
- IFC=INDEXC(CTEMP,' ')
- CALL DZDPLN(LUC,CTEMP(IFC:)//')',1)
- ELSE
- CALL DZDPLN(LUC,'? )',1)
- ENDIF
- ENDIF
- CALL DZDPLN(LUC,
- + 'COMMON/CO'//CHBANK(1:ILC1)//'/',2)
- CALL DZDPLN(LUC,
- + ' '//CVARNM(1:ILC),1)
- ILC=0
- ENDIF
- IF(INDEX(CHOPT,'H').NE.0)THEN
-* hbname
- CALL DZDPLN(LUC,
- + 'CALL HBNAME (ID'//CHBANK(1:ILC1)//
- + ','''//CHBANK(1:ILC1)//''',',2)
-* if its an array fill dimension first
- IF(CHPFI(1:1).EQ.'(' .AND.
- + CHPFI(ILPF:ILPF).EQ.')')THEN
- CALL DZDPLN(LUC,
- + CHPFI(2:ILPF-1)//','''//CHPFI(2:ILPF-1),1)
- IF(IUPERC.GT.0)THEN
- WRITE(CTEMP,'(I12)')ILOWRC
- IFC=INDEXC(CTEMP,' ')
- CALL DZDPLN(LUC,'['//CTEMP(IFC:),1)
- WRITE(CTEMP,'(I12)')IUPERC
- IFC=INDEXC(CTEMP,' ')
- CALL DZDPLN(LUC,
- + ','//CTEMP(IFC:)//']',1)
- ELSE
- CALL DZDPLN(LUC,'[0,??]',1)
- ENDIF
- ELSE
- CALL DZDPLN(LUC,
- + CVARNM(1:ILC)//',''',1)
- CALL DZDPLN(LUC,CVARNM(1:ILC),1)
- ILC=0
- ENDIF
- ENDIF
- ENDIF
- IF(INDEX(CHOPT,'C').EQ.0 .AND.
- + INDEX(CHOPT,'H').EQ.0)THEN
- IF(CHARIO.NE.CHARIS)THEN
- IF(CHARIO.EQ.'F')THEN
- CALL DZDPLN(LUC,'REAL ',2)
- ELSE
- CALL DZDPLN(LUC,'INTEGER ',2)
- ENDIF
- CALL DZDPLN(LUC,
- + ' '//CVARNM(1:ILC),1)
- ILC=0
- ENDIF
- ENDIF
- IF(ILC.GT.0)THEN
- CALL DZDPLN(LUC,
- + ','//CVARNM(1:ILC),1)
- ENDIF
- IF(INDEX(CHOPT,'H').NE.0)THEN
- IF(ICOLON.GT.1)THEN
- CALL DZDPLN(LUC,':'//CLINE(ICOLON:IOLCHA),1)
- ENDIF
- ENDIF
- ELSE
-* PARAMETER statements
- IF(NKEEPS.EQ.0)THEN
- CALL DZDPLN(LUC,'PARAMETER(',2)
- ELSE
- CALL DZDPLN(LUC,',',1)
- ENDIF
- CALL DZDPLN(LUC,
- + CVARNM(1:ILC)//'='//CVAR1(IFC:8)
- + ,1)
- ENDIF
- NKEEPS = NKEEPS+1
- CHARIS=CHARIO
- ENDIF
- ENDIF
- ELSE
- MC1 = MIN(NW,17)
- MC=MC1
- DO 60 K=3,MC1
- IF(IQ(IP+K).EQ.IILFLF)THEN
- MC=K-1
- GOTO 70
- ENDIF
- 60 CONTINUE
- 70 CONTINUE
-* examine/check value against range
- IF(INDEX(CHOPT,'E').NE.0)THEN
-* get [ , ]
- NCH=MIN((NW-2)*4,LEN(CLINE))
- CLINE=' '
- CALL UHTOC(IQ(IP+3),4,CLINE,NCH)
- IFC=INDEX(CLINE,'[')
- ILC=INDEX(CLINE,']')
- IFC=IFC+1
- ILC=ILC-1
- NC=INDEX(CLINE(IFC:ILC),',')
- IF(NC.EQ.0)NC=INDEX(CLINE(IFC:ILC),':')
- IF(IFC.EQ.1 .OR. ILC.LE.0 .OR. NC.EQ.0)THEN
- WRITE(LUC,'(A,I6)')
- + 'No range defined for word:',IWORD
- GOTO 80
- ENDIF
- ILC1=IFC+NC-2
- IFC2=ILC1+2
- IOUT=0
- IF(INDEX( CVAL,'.').EQ.0)THEN
-* INTEGER
- IF(CLINE(IFC:IFC).NE.'*')THEN
- CALL DZDCTI(CLINE(IFC:ILC1),IVAL1)
- IF(IQ(KQS+L+IWORD).LT.IVAL1)THEN
- IOUT=1
- ELSE IF(CLINE(IFC2:IFC2).NE.'*')THEN
- CALL DZDCTI(CLINE(IFC2:ILC),IVAL2)
- IF(IQ(KQS+L+IWORD).GT.IVAL2)IOUT=1
- ENDIF
- ENDIF
- IF(IOUT.GT.0)THEN
- WRITE(LUC,'(A,I10,A,I6,A,2(I10,A))')
- + CVAR1,IQ(KQS+L+IWORD),' at:',IWORD,
- + ' out of range [', IVAL1,',' ,IVAL2,']'
- ENDIF
- ELSE
- IF(CLINE(IFC:IFC).NE.'*')THEN
- CALL IZCTOR(CLINE(IFC:ILC1),VAL1)
- IF(Q(KQS+L+IWORD).LT.VAL1)THEN
- IOUT=1
- ELSE IF(CLINE(IFC2:IFC2).NE.'*')THEN
- CALL IZCTOR(CLINE(IFC2:ILC),VAL2)
- IF(Q(KQS+L+IWORD).GT.VAL2)IOUT=1
- ENDIF
- ENDIF
- IF(IOUT.GT.0)THEN
- WRITE(LUC,'(A,E10.4,A,I6,A,2(E10.4,A))')
- + CVAR1,Q(KQS+L+IWORD),' at:',IWORD,
- + ' out of range [', VAL1,',' ,VAL2,']'
- ENDIF
- ENDIF
-* print the value
- ELSE IF(INDEX(CHOPT,'=').EQ.0)THEN
-* fill in a possible index
- CLOOP=CVAR1
- IF(LOOPC1.GT.0)THEN
- CLOOP(9:9)='('
- CLOOP(21:21)=')'
- WRITE(CLOOP(10:14),'(I5)')LOOPC1
- IF(LOOPC2.GT.0)THEN
- CLOOP(15:15)=','
- WRITE(CLOOP(16:20),'(I5)')LOOPC2
- ENDIF
- CLOOP=SPACES(CLOOP,0)
- ENDIF
-* indent
- NCLOOP=LENOCC(CLOOP)
- IF(NCLOOP.LE.12)THEN
- NCLOOP=12
- ELSE IF(NCLOOP.LE.16)THEN
- NCLOOP=16
- ENDIF
- CLINE=' '
- WRITE(CLINE,'(1X,I5)')IWORD
-
- CLINE(9:9+NCLOOP-1)=CLOOP(1:NCLOOP)
- CLINE(9+NCLOOP:9+NCLOOP+10)=CVAL
- MC=(MC-2)*4
- MC=MIN(MC,LEN(CLINE)-21-NCLOOP)
- CALL UHTOC(IQ(IP+3),4,CLINE(22+NCLOOP-LENMSK:),MC)
-* remove leading part if its MASK
- IF(LENMSK.GT.0)CLINE(1:22+NCLOOP-1)=' '
- IF(CLINE (9+NCLOOP-1:MC+35).NE.
- & CLINSA(9+NCLOOP-1:MC+35))THEN
- IF(NLSKIP.GT.0)THEN
- WRITE(LUC,'(/26X,A,I5,A)')'---',NLSKIP,
- & ' lines with same value skipped ---'
-* IF(IDELAY.LE.0)WRITE(LUC,'(A)')' '
- NLSKIP=0
- ENDIF
- IF(IDELAY.GT.0)THEN
- WRITE(LUC,'(/11X,A)')CLINDE
- IDELAY=IDELAY-1
- ENDIF
- LALILE=LENOCC(CLINE)
- WRITE(LUC,'(/A'//NONEWL//')')CLINE(1:LALILE)
-* only if bank has more then 100 words
- IF(NBLENG.GT.100)CLINSA(1:MC+35)=CLINE(1:MC+35)
- ELSE
- NLSKIP=NLSKIP+1
- ENDIF
- ELSE
- IF(INDEX( CVAL,'.').EQ.0)THEN
- WRITE(LUC,'(6X,A,A4,A,A8,A,A11)')
- + 'IQ(L',CHBANK(1:4), '+', CVAR1, ') = ', CVAL
- ELSE
- WRITE(LUC,'(6X,A,A4,A,A8,A,A11)')
- + 'Q(L',CHBANK(1:4), '+', CVAR1, ') = ', CVAL
- ENDIF
- ENDIF
- ENDIF
- GOTO 80
- ENDIF
-
-* end of hollerith sector
-
- IF(IT .NE. 2)THEN
- WRITE(LUC,'(/A,2I9)')' Unexpected IT,NW ',IT,NW
- WRITE(LUC,'(1X,100Z8)')(IQ(IP+K),K=1,NW)
- GOTO 80
- ENDIF
-
-* start of integer sector
-* i.e. word # documented or rep level change
-
-* WRITE(*,'(1X,Z8,100I8)')(IQ(IP+K),K=1,NW)
- ICHOIC = IQ(IP+1)
-* IBIT13 = JBYT(ICHOIC,1,3)
- IDENTF = JBYT(ICHOIC,11,5)
- IF(KEEPSQ )THEN
- IF(IREPL.NE.JBYT(ICHOIC,16,3))THEN
- IF(INDEX(CHOPT,'C').NE.0)NKEEPS=0
- IF(INDEX(CHOPT,'H').NE.0)THEN
- IF(NKEEPS.GT.0)CALL DZDPLN(LUC,''')',1)
- NKEEPS=0
- ENDIF
- ENDIF
- ENDIF
-
- IREPL=JBYT(ICHOIC,16,3)
-* IESEQ = JBYT(ICHOIC,19,1)
-* WRITE(*,*)' IBIT13, IDENTF, IREPL, IESEQ',
-* & IBIT13, IDENTF, IREPL, IESEQ
-* remember sequence number of data word documented
- IWDOCO = IWDOC
- IF(IDENTF .EQ. ITGENQ)THEN
-* remember start of rep section in doc
- IF(IC1.GT.0 .AND. IP1 .EQ. 0)IP1 =IP
- IF(IC2.GT.0 .AND. IP2 .EQ. 0)IP2 =IP
- IWDOC = IQ(IP+2)
- GOTO 80
- ENDIF
-
-* repetition level
-
- IF(IDENTF .EQ. ITGREQ)THEN
- IF(REPEND)THEN
- REPEND=.FALSE.
- ELSE
- IF(KEEPSQ)IWORDR=0
- ENDIF
-* end of infinite rep loop (IFREPL=1), check if doc is uptodate
-
- IF(IFREPL.NE.0 .AND. NEXTRA.EQ.0 .AND. LRECOV
- & .AND. IMBED2.EQ.0 .AND. NW.EQ.1 .AND. IREPL.EQ.0)THEN
- NTRIAL=0
- NDREST=IQ(L+KQS-1)-IWORIF
- NNREP=FLOAT(NDREST)/FLOAT(IWDOC)+0.5
-74 NDEXT=NDREST-IWDOC*NNREP
- IF(NDEXT.NE.0 .AND. NNREP.GT.0)THEN
- NEXTRA=NDEXT/NNREP
- IF(NNREP*NEXTRA.EQ.NDEXT)THEN
- IF(INDEX(CHOPT,'Q').EQ.0)
- & CALL DZDPRW(LUC,NEXTRA+IWDOC)
- ELSE
- IF(NTRIAL.EQ.0)THEN
- NNREP=NNREP+1
- NTRIAL=1
- GOTO 74
- ELSEIF(NTRIAL.EQ.1)THEN
- NNREP=NNREP-2
- NTRIAL=-1
- GOTO 74
- ELSE
- NEXTRA=0
- ENDIF
- ENDIF
- ELSE
- NEXTRA=0
- ENDIF
- IF(NEXTRA.LT.0)THEN
- WRITE(LUC,'(/A,I5,A)')
- & ' Ignore last',-NEXTRA,' words'
- IWORD=IWORD+NEXTRA
- IWORDR=IWORDR+NEXTRA
-* force new retrieval of formatted values
- IC9=10
- NEXTRA=-(NEXTRA+IWDOC)
- ENDIF
- IF(NEXTRA.EQ.0 .AND. NDEXT.NE.0)THEN
- CALL DZDPRW(LUC,-1000000)
- ENDIF
- ENDIF
-* look if enough data words are documented for this section
- IF(NEXTRA.GT.0 .AND. LRECOV)THEN
- DO 75 II=IWORD+1,IWORD+NEXTRA
- CALL DZSHOW(' ',IXSTOR, L,COPTDZ//'Q',1,0,II,II)
- CVAL = CQLINE(12:22)
- IF(INDEX(CHOPT,'C').EQ.0)THEN
- IF(INDEX(CHOPT,'Q').EQ.0)
- & WRITE(LUC,'(/1X,I5,16X,A11,A)') II, CVAL,
- & ' not documented'
- ELSE
- WRITE(LUC,'(A11)')CVAL
- ENDIF
- 75 CONTINUE
- IWORD=IWORD+NEXTRA
- IWORDR=IWORDR+NEXTRA
-* force new retrieval of formatted values
- IC9=10
- ENDIF
-
-*
-76 IWDOC = -1
-
-* end of rep level
-
- IF(NW .EQ. 1)THEN
-
- IF(IREPL .EQ. 1)THEN
-* end rep lev 2
- IF(REPATH)THEN
- IF(IP.NE.IPDRE1)THEN
- IF(IPRL1.LE.0)THEN
- NVAL=-1
- GOTO 990
- ENDIF
- VVAR(IPRL2)=IWORD-IPREP1
- IPRL2=0
- IPDRE1=IP
- IF(NOTFIL)THEN
- NVAL=NVAL+1
- VVAR(NVAL)=0
- ENDIF
- ENDIF
- IPREP1=IWORD
- ENDIF
- IC2 = IC2 -1
- LOOPC2=LOOPC2+1
-* IREPC=-2
- IF(IC2 .GT. 0)THEN
- IP = IP2
- IDENTF = ITGENQ
- GOTO 10
- ENDIF
- LOOPC2=-1
- NEXTRA=0
- GOTO 80
- ELSE
- IF(IREPL .EQ. 0)THEN
- IF(REPATH)THEN
-* all done
- IF(IP.NE.IPDRE0)THEN
- IF(IPRL1.LE.0)THEN
- NVAL=-1
- GOTO 990
- ENDIF
- VVAR(IPRL1)=IWORD-IPREP0
- IPDRE0=IP
- IPRL1=0
- IF(NOTFIL)THEN
- NVAL=NVAL+1
- VVAR(NVAL)=0
- ENDIF
- ENDIF
- IF(.NOT.NOTFIL)GOTO 990
- IPREP0=IWORD
- ENDIF
- IC1=IC1-1
- LOOPC1=LOOPC1+1
-* IREPC=-2
- IF(IC1 .GT. 0)THEN
- IF(KEEPSQ)GOTO 990
- IP = IP1
- IDENTF = ITGENQ
- GOTO 10
- ENDIF
- LOOPC1=-1
- NEXTRA=0
- IMBED2=0
- GOTO 80
- ELSE
- WRITE(LUC,'(/A,I9)')' Illegal end of rep at',IP
- GOTO 990
- ENDIF
- ENDIF
- ENDIF
-
-* start of rep
-
- IREPC = IQ(IP+2)
-
-* return path?
-
- IF(REPATH)THEN
- NVAL=NVAL+1
-* offset from previous to start of rep
- VVAR(NVAL)= - (IWORD-IPREP0)
-* remember start of section
- IF(IREPL.EQ.2)THEN
- IPREP1=IWORD
- ELSE
- IPREP0=IWORD
- ENDIF
- NVAL=NVAL+1
- VVAR(NVAL)=4
- NVAL=NVAL+1
- VVAR(NVAL)=IREPC
- MGEVAL=MAXVAL-NVAL
- ELSE
- MGEVAL=0
- ENDIF
-
- IF(IREPC.LT.0 .AND. .NOT. KEEPSQ)THEN
-* was it given in previous data word?
- ITP = MOD(IQ(IP+NW+1),16)
- NWP = IQ(IP+NW+1)/16
- NCOP=MIN(15,NWP)*4
- IF(ITP.EQ.5)THEN
- CLINE=' '
- CALL UHTOC(IQ(IP+NW+2),4,CLINE,NCOP)
- IF(CLINE(1:2).EQ.'N:'.AND.IPOINT.GT.0)THEN
- DO I=1,IPOINT
- NCH=LENOCC(CPOINT(I))
- IF(CPOINT(I)(1:NCH).EQ.CLINE(1:NCH))THEN
- IREPC=NPOINT(I)
- IF(LENOCC(CLINE).GT.NCH)THEN
- IVALRC=IREPC
- IF(REPATH)THEN
- CALL DZDGR1
- & (CLINE(NCH+1:),IVALRC,IREPC,NEX,
- & VVAR(NVAL+1),MGEVAL,NGEVAL)
- ELSE
- CALL DZDGR1
- & (CLINE(NCH+1:),IVALRC,IREPC,NEX,
- & IDUMMY,0,NDUMMY)
- ENDIF
- ENDIF
- GOTO 77
- ENDIF
- ENDDO
- ENDIF
- ENDIF
-
-* try to get rep count from variable
-
- IF(REPATH)THEN
- CALL DZDGRC(IQ(IP+NW+1),0,IVALLW,IREPC,NEXTRA,
- & VVAR(NVAL+1),MGEVAL,NGEVAL)
- IF(NGEVAL.LE.0)THEN
- VVAR(NVAL)=1000000
- ELSE
- VVAR(NVAL-1)=VVAR(NVAL-1)+NGEVAL
- NVAL=NVAL+NGEVAL
- ENDIF
- ELSE
- CALL DZDGRC(IQ(IP+NW+1),0,IVALLW,IREPC,NEXTRA,
- & IDUMMY,0,NDUMMY)
- ENDIF
-
- IF(NEXTRA.LT.0 .AND.INDEX(CHOPT,'Q').EQ.0 .AND. LRECOV)
- & CALL DZDPRW(LUC,NEXTRA)
- IF(NEXTRA.GT.0 .AND. LRECOV)THEN
- IF(INDEX(CHOPT,'Q').EQ.0)WRITE(*,*)
- & ' WARNING: Assume EXTRA',NEXTRA,' words not documented'
- ENDIF
-
- IF(IREPC.EQ.0)THEN
- REPEND=.TRUE.
- ENDIF
- ENDIF
-77 CONTINUE
-
- IF(REPATH)THEN
- NVAL=NVAL+1
- IF(IREPL.EQ.1)THEN
- IPRL1=NVAL
- ELSE
- IPRL2=NVAL
- ENDIF
- ENDIF
-
- IF(IREPL.EQ.1)THEN
- IP1 = 0
- LOOPC1=1
- IC1 = IREPC
-* IC1 = IQ(IP+2)
- IF(IC1 .LT. 0)THEN
- IF(IFREPL .EQ. 0)THEN
- IF(KEEPSQ)THEN
- IC1 = 1
- ELSE
-* variable (infinite)rep
- IFREPL =1
- IC1 = 10000000
- ENDIF
- IDENTF = -ITGREQ
- IF(NEWPNT)THEN
- IWORIF=IWORD+1
- ELSE
- IWORIF=IWORD
- ENDIF
- ELSE
- WRITE(LUC,'(/A,I9)')
- & ' Illegal var Rep count at ',IP
- GOTO 990
- ENDIF
- ENDIF
- GOTO 80
- ELSE
- IF(IREPL.EQ.2)THEN
- IP2 = 0
- LOOPC2=1
- IC2 = IREPC
-* flag imbedded rep level 2
- IMBED2=1
-* IC2 = IQ(IP+2)
- IF(IC2 .LT. 0)THEN
- WRITE(LUC,'(/A,I9)')
- & ' Illegal var Rep count at ',IP
- GOTO 990
- ENDIF
- ELSE
- WRITE(LUC,'(/A,I9)')' Repl>2 at ',IP
- GOTO 990
- ENDIF
- ENDIF
- ENDIF
-
- 80 CONTINUE
- IP = IP+NW+1
- IF(IWORD.LT.IL11 .OR. IP.LT.LDATUM)THEN
- GOTO 10
- ELSE
- GOTO 990
- ENDIF
-
- 90 CONTINUE
- IF(NLSKIP.GT.0)THEN
- WRITE(LUC,'(/A,I5,A)')' ---',NLSKIP,
- & ' identical lines skipped ---'
- NLSKIP=0
- ELSE
- WRITE(LUC,'(/A)')' '
- ENDIF
- DO 100 IWORD=IW1,IL11
- CALL DZSHOW(' ',IXSTOR, L,COPTDZ//'Q',1,0,IWORD,IWORD)
- CVAL = CQLINE(12:22)
- IF(INDEX(CHOPT,'C').EQ.0)THEN
- WRITE(LUC,'(1X,I5,16X,A11)') IWORD, CVAL
- ELSE
- WRITE(LUC,'(A11)')CVAL
- ENDIF
- 100 CONTINUE
-
- 990 CONTINUE
- IF( .NOT. KEEPSQ)THEN
- IF(NLSKIP.GT.0)THEN
- WRITE(LUC,'(/A,I5,A)')' ---',NLSKIP,
- & ' identical lines skipped ---'
- NLSKIP=0
- ELSE
- WRITE(LUC,'(/A)')
- & '-----------------------------------------------------------'
- ENDIF
- ENDIF
- 995 CONTINUE
- IF(INDEX(CHOPT,'I').NE.0 .AND. NSTYP.GT.0)THEN
- CALL DZDFIO(CHPF,IPCHPF,NSTYP,CHARIS)
- ENDIF
- IF(KEEPSQ .AND. INDEX(CHOPT,'H').NE.0 .AND. NKEEPS.GT.0)THEN
- CALL DZDPLN(LUC,''')',1)
- ENDIF
- IF(LQBKD1.NE.0 .AND.INDEX(CHOPT,'I').EQ.0)THEN
- CALL MZDROP(0,LQBKD1,'L')
- LQBKD1=0
- ENDIF
- IF (IENTRY.EQ.2) ITYYY=ITY
- IQPRNT =LUNSAV
- END
-*********************************************************************
diff --git a/src/graflib/dzdoc/dzdraw/dzddtr.F b/src/graflib/dzdoc/dzdraw/dzddtr.F
deleted file mode 100644
index a7e397d..0000000
--- a/src/graflib/dzdoc/dzdraw/dzddtr.F
+++ /dev/null
@@ -1,223 +0,0 @@
-*
-* $Id: dzddtr.F,v 1.1.1.1 1996/03/04 16:13:19 mclareni Exp $
-*
-* $Log: dzddtr.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:19 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDDTR(ISTORE,LIN,LUNS,LUNL,LUNM,IWMETA,ITMETA,CHOPT)
- CHARACTER*(*) CHOPT
-*. 'P' PostScript
-*. 'C' colored
-*. 'N' opening and closing WS is done by caller
-*. 'T' D/S generated from documentation
-*. 'R' Rz-file with documentation available
-*. 'B' draw boxes as <>
-*. '1' draw banks od 1 level only if not the
-*. complete 2nd level fits
-*. 'M' mark subtree complete (avoid drawing
-*. subtrees more then once (T implies M)
- CHARACTER*7 CTEMP
-* CHARACTER*4 CHODRW
- CHARACTER*8 CTEMP1
- CHARACTER*80 CLINE
-#include "dzdprm.inc"
-#include "zebra/zunit.inc"
-#include "dzdoc/bkwrp.inc"
-#if defined(CERNLIB_BSLASH)
-#include "dzdoc/bslash2.inc"
-#endif
-#if !defined(CERNLIB_BSLASH)
-#include "dzdoc/bslash1.inc"
-#endif
- LOGICAL DOPDOC, NOTDON
- INTEGER MALD
- PARAMETER (MALD=50)
- INTEGER IPCSEQ,ILABEL, IALD(2,MALD), IPALD, LALD, LGO, L
- DATA IPCSEQ/0/,ILABEL/0/
-
- PAGECM=14./20.
- IFOMED=0
- LFCSAV=LFCOL
- IF(INDEX(CHOPT,'C').NE.0)THEN
- LFCOL=1
- ELSE
- LFCOL=0
- ENDIF
- CALL ISFASI(-103)
-* IF(INDEX(CHOPT,'1').NE.0)THEN
-* CHODRW='RT1'
-* ELSE
-* CHODRW='RT'
-* ENDIF
- IF(INDEX(CHOPT,'0').NE.0)ILABEL=0
- YBSING = 0.85
-* WRITE(IQPRNT,'(A,A4)') ' Draw tree below: ',IQ(KQS+L-4)
- NBK = 0
- NBDOCT = 0
- IPALD=0
- LALD=0
- CALL UZERO(IALD,1,2*MALD)
-
- L=-LIN
- 10 CONTINUE
- LGO=L
- CALL DZDWTR(ISTORE,LGO,L)
- IF(L.EQ.LIN)WRITE(IQPRNT,'(A,A4)')' Draw tree below: ',IQ(KQS+L-4)
- IF(L .NE. 0)THEN
- ILKACT = 0
-
-20 CONTINUE
- CALL UHTOC(IQ(L+KQS-4),4,CTEMP(1:4),4)
- WRITE(CTEMP(5:7),'(I3.3)')IPCSEQ
- CTEMP1(1:4) = CTEMP(1:4)
- ILKSAV = ILKACT
- CALL DZDRA1(ISTORE,L,ILKACT,CHOPT,
- & 0.,0.,.TRUE.,IFLCUR,YTOP,YBOTTM)
- LU = LQ(KQS+L+1)
- IF(LU .GT. 1)THEN
- CALL UHTOC(IQ(KQS+LU-4),4,CTEMP1(5:8),4)
- ELSE
- CTEMP1(5:8) = 'NONE'
- ENDIF
-
-* remember complete subtrees
- IF(ILKACT.GT.0)THEN
- ILLAST=ILKACT
- ELSE
- ILLAST=IQ(KQS+L-2)
- ENDIF
- DO 25 I=ILKSAV+1,ILLAST
- IF(IAND(IQ(LQ(L+KQS-I)+KQS),ALDBIT).NE.0)THEN
- IPALD=IPALD+1
- IF(IPALD.GT.MALD)IPALD=1
- IF(LALD.LT.MALD) LALD=LALD+1
- IALD(1,IPALD) = IQ(LQ(L+KQS-I)+KQS-4)
- IALD(2,IPALD) = IQ(L +KQS-4)
- ENDIF
-25 CONTINUE
-
-* check for complete subtree
- NOTDON=.TRUE.
- DO 26 I=1,LALD
- IF(IQ(L +KQS-4).EQ. IALD(1,I) .AND.
- & IQ(LU+KQS-4).EQ. IALD(2,I))THEN
- NOTDON=.FALSE.
- GOTO 27
- ENDIF
-26 CONTINUE
-27 CONTINUE
-
- ILKACT = ILKSAV
-* output part
- IF( (YBOTTM .LT. YBSING
- & .OR. ILKACT.GT.0)
- & .AND.NOTDON) THEN
- IPCSEQ=IPCSEQ+1
- IF(IPCSEQ. GT. 999)IPCSEQ=1
- IFBL = INDEX(CTEMP(1:4),' ')
- IF(IFBL .GT. 0 .AND. IFBL .LE. 4)THEN
- DO 30 I=IFBL,4
-30 CTEMP(I:I)='X'
- ENDIF
- IXMM=140
- IYMM=(1.-YBOTTM)*140.
- WRITE(CLINE,'(A,2I5)')
- + '%%PICTURE '//CTEMP(1:7),-IXMM,IYMM
- IF(INDEX(CHOPT,'P').EQ.0)THEN
- XAPA = .1465
- IF(INDEX(CHOPT,'N').EQ.0)CALL IACWK(IWMETA)
- CALL IGRNG(XAPA*100.,XAPA*100.*(1.-YBOTTM))
- CALL ICLRWK(IWMETA,1)
- IF(ITMETA.EQ. -111)THEN
- CALL IPPSTR(CLINE(1:28))
- CALL IPPSTR('@ ')
- ENDIF
- ELSEIF(INDEX(CHOPT,'P').NE.0 .OR.
- + LUNM.GT.0)THEN
- IF(LUNM.GT.0)THEN
- IFOMED=2
- PAMM10=73.25
- IPCSIZ=0
- LUNGRA=LUNM
- CALL DZDPLN(LUNGRA,CLINE,0)
- CALL DZDPLN(LUNGRA,' ',-99)
- ENDIF
- CALL ICLRWK(0,0)
- CALL DZDRAW(0,L,ILKACT,CHOPT)
- IF(LUNM.GT.0)THEN
- CALL DZDPLN(LUNGRA,' ',-99)
-* CALL DZDPLN(LUNGRA,' showpage',0)
- CALL DZDPLN(LUNGRA,' ',-99)
- ENDIF
- ENDIF
- IF(LUNS .GT. 0)THEN
- CALL DZDGDS(CTEMP1,' ',CLINE,NLT)
- IF(NLT .LE. 0)THEN
- CLINE = ' '
- NLT=1
- ENDIF
- IF(IFOMED.LE.2)THEN
- WRITE(LUNS,'(A,I3.3,A)') '<FIG ID=T'
- + ,IPCSEQ,'>'
- WRITE(LUNS,'(A,A,A)')'<PICTURE NAME='
- + ,CTEMP,'S>'
- WRITE(LUNS,'(A,A,A/A)')'<FIGCAP>',CTEMP1(1:4)
- + ,' ',CLINE(1:NLT)
- WRITE(LUNS,'(A)')'</FIG>'
- ENDIF
- ENDIF
- ENDIF
-* dont write documentation more than once if:
-* more than one picture needed and for next-banks
-* with the same Holl Id
- LN=LQ(KQS+L)
- IF(ILKACT.NE.0)THEN
- DOPDOC=.FALSE.
- ELSE
- DOPDOC=.TRUE.
- IF(LN.NE.0)THEN
- IF(IQ(KQS+LN-4).EQ.IQ(KQS+L-4))THEN
- DOPDOC=.FALSE.
- ENDIF
- ENDIF
- ENDIF
- IF(DOPDOC)THEN
- IF(LU.EQ.0)THEN
- IF(IQ(KQS+L-1).GE.4)THEN
- CALL UHTOC(IQ(KQS+L+4),4,CTEMP1(5:8),4)
- ELSE
- CTEMP1(5:8)='NONE'
- ENDIF
- ENDIF
- CALL DZDGDS(CTEMP1,' ',CLINE,NLT)
- IF(NLT .GT. 0)THEN
- NBDOCT=NBDOCT+1
- ILC=INDXBC(CLINE,' ')
- ELSE
- ILC=0
- ENDIF
- NBK = NBK + 1
- IF(LUNL.GT.0)WRITE(LUNL,'(A)')CTEMP1
-* IF(LU.EQ.0)CTEMP1(5:8)='****'
-* output part
- IF(LUNS.GT.0)THEN
- WRITE(LUNS,'(A)')'<LISTING>'
- CALL DZDOCO(LUNS,CTEMP1,'RH')
- WRITE(LUNS,'(A)')'</LISTING>'
- WRITE(LUNS,'(A,A)')'<I1>',CTEMP1(1:4)
- ENDIF
- ENDIF
- IF(ILKACT .NE. 0)GOTO 20
- GOTO 10
- ENDIF
-*
- WRITE(IQPRNT,'(A,I8,A)')' Total # of banks in tree: ',NBK
- WRITE(IQPRNT,'(A,I8,A)')' # of documented banks ',NBDOCT
- CALL ISFASI(-5)
- LFCOL=LFCSAV
- IFOMED=0
- END
-*********************************************************************
diff --git a/src/graflib/dzdoc/dzdraw/dzddwd.F b/src/graflib/dzdoc/dzdraw/dzddwd.F
deleted file mode 100644
index 7462b67..0000000
--- a/src/graflib/dzdoc/dzdraw/dzddwd.F
+++ /dev/null
@@ -1,58 +0,0 @@
-*
-* $Id: dzddwd.F,v 1.1.1.1 1996/03/04 16:13:17 mclareni Exp $
-*
-* $Log: dzddwd.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:17 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDDWD(IXSTOR, L, CHOPT, IFIRST, ILAST,LUN)
-*.
-*...DZDDWD dump data words with documentation
-*.
-*. INPUT : IXSTOR store index
-*. L link to bank to be dumped
-*. CHOPT character option
-*. 'S' short display, variable name only
-*. 'U' suppress list of UNDEFD
-*. 'K' generate keep sequences
-*. IFIRST first word to dump
-*. ILAST last word
-*. LUN output unit
- CHARACTER*(*) CHOPT
- CHARACTER*8 CHBANK
-#include "dzdoc/bkwrp.inc"
-#include "dzdoc/tapes.inc"
-* From DZEBRA
-#include "zebra/zbcdk.inc"
-#include "dzdprm.inc"
-#include "zebra/qstore.inc"
- CALL DZDGDV(CHOPT,IDVERS)
- ENTRY DZDDW1(IXSTOR, L, CHOPT, IFIRST, ILAST,LUN)
- IF(L .LE. 0)THEN
- GOTO 999
- ENDIF
- IL1 = IQ(KQS+L-1)
- IF(ILAST .GT. 0)IL1 = MIN(IL1,ILAST)
- IF(IFIRST.GT.0)THEN
- IF1 = MIN(IFIRST,IL1)
- ELSE
- IF1 = 1
- ENDIF
-
- CALL UHTOC(IQ(KQS+L-4),4,CHBANK,4)
- LUP = LQ(KQS+L+1)
- IF(LUP .GT. 2)THEN
- CALL UHTOC(IQ(KQS+LUP-4),4,CHBANK(5:),4)
- ELSE
- CHBANK(5:8)='NONE'
- ENDIF
- IF(JBIT(IQ(KQS+L),IQDROP).NE.0)THEN
- WRITE(LUN,'(A)')' Bank '//CHBANK(1:4)//' is dropped'
- ELSE
- CALL DZDDOC(IXSTOR,L,CHBANK,CHOPT,IF1,IL1,LUN,' ',NDUMMY)
- ENDIF
-999 END
-
-************************************************************************
diff --git a/src/graflib/dzdoc/dzdraw/dzdedd.F b/src/graflib/dzdoc/dzdraw/dzdedd.F
deleted file mode 100644
index 99674d4..0000000
--- a/src/graflib/dzdoc/dzdraw/dzdedd.F
+++ /dev/null
@@ -1,199 +0,0 @@
-*
-* $Id: dzdedd.F,v 1.1.1.1 1996/03/04 16:13:02 mclareni Exp $
-*
-* $Log: dzdedd.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:02 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDEDD
-#include "dzdzbrinc.inc"
- INTEGER IQUEST(100)
- COMMON/QUEST/IQUEST
-#include "zebra/zebq.inc"
-#include "zebra/mzca.inc"
-#include "zebra/mzcb.inc"
-#include "zebra/mzcc.inc"
-#include "zebra/mzcn.inc"
-#include "zebra/mzbits.inc"
- INTEGER IHID(2),NCH,NCHB,NCHU,NCHO,NCHF, IDIV, ISTORE, LGO
- INTEGER IDIVIN,LTMP, LIN, IXDIV, LL, LUP
- LOGICAL EXST
- CHARACTER*8 CHKEY
- CHARACTER*6 CHOPT, CHEXT
- CHARACTER*1 CHOTMP
- CHARACTER*80 CHFILE, CHFULL, SPACES
-*--
- CALL DZDIBR
- CALL RZCDIR(CWDSAV,'R')
- IXDIV=0
- LTMP=0
- CHKEY=' '
- CALL KUGETC(CHKEY(1:4),NCHB)
- CALL KUGETC(CHKEY(5:8),NCHU)
- IF(INDEX(CHKEY(5:8),'*').NE.0)NCHU=0
- IF(NCHU.LE.0)CHKEY(5:8)='****'
- CALL KUGETS(CHOPT,NCHO)
- CALL KUGETS(CHFILE,NCHF)
- CALL KUGETI(ISTORE)
- CALL KUGETI(IDIV)
- CHOTMP='T'
- GOTO 5
-
-* entry if called from browser
-
- ENTRY DZDED1(IDIVIN,LIN)
-
- CHOTMP=' '
- CALL DZDIBR
- CALL RZCDIR(CWDSAV,'R')
- LTMP=LIN
- IXDIV=IDIVIN
- ISTORE=JBYT(IXDIV,27,6)
- NCHF=0
- NCHB=4
- CALL MZSDIV(IXDIV,1)
-* get HID of bank and up bank
- IHID(1)=IQ(LIN+KQS-4)
- CALL UHTOC(IHID(1),4,CHKEY,4)
- IF(LQ(LIN+KQS+1).EQ.0)THEN
- CHKEY(5:8)='NONE'
- CALL UCTOH(CHKEY(5:8),IHID(2),4,4)
- ELSE
- IHID(2)=IQ(LQ(LIN+KQS+1)+KQS-4)
- CALL UHTOC(IHID(2),4,CHKEY(5:8),4)
- ENDIF
-* look if doc is in Rzfile
- CHOPT='Memory'
- IF(CTDDOC.NE.' ')THEN
- CALL RZCDIR(CTDDOC,' ')
- ICYCLE=1000000
- CALL RZIN(0,LL,2,IHID,ICYCLE,'C')
- IF(IQUEST(1).EQ.0)THEN
- CHOPT='Rz'
- ENDIF
- ENDIF
-5 CONTINUE
-
- IF(NCHF.LE.0)THEN
- IF(NCHB.LE.0)THEN
- WRITE(*,*)'No bank nore file name given'
- GOTO 999
- ENDIF
- CHFILE(1:4)=CHKEY(1:4)
- IF(NCHU.GT.0)THEN
- CHFILE(5:9)='_'//CHKEY(5:8)
- ELSE
- CHFILE(5:9)=' '
- ENDIF
- CHFILE(10:)='.dzdoc'
- ENDIF
- CHFILE=SPACES(CHFILE,0)
- CALL CUTOL(CHFILE)
- LUNTMP=LUPTMP
- IF(CHOPT.NE.'Ascii')THEN
- CALL KUOPEN(LUNTMP,CHFILE,'UNKNOWN',ISTAT)
- IF(ISTAT.NE.0)THEN
- WRITE(*,'(A)')'Cannot open '//CHFILE
- LUNTMP=6
- GOTO 999
- ENDIF
- ENDIF
- IF (CHOPT.EQ.'Rz')THEN
- CALL DZDSDO(0,0,LUNTMP,CHKEY,'IR')
-
- ELSE IF(CHOPT.EQ.'Ascii')THEN
-
- IF(INDEX(CHFILE,'.').NE.0)THEN
- CHEXT=' '
- ELSE
- CHEXT='.dzdoc'
- ENDIF
- NCH=LENOCC(CHFILE)
- DO 10 I=0,NDIADD
-* look on CWD
- IF(I.EQ.0)THEN
- CHFULL=CHFILE(1:NCH)//CHEXT
- ELSE
- NCH1=LENOCC(CDIADD(I))
- CHFULL=CDIADD(I)(1:NCH1)//CHFILE(1:NCH)//CHEXT
- ENDIF
- INQUIRE(FILE=CHFULL, EXIST=EXST)
- IF(EXST)THEN
- CHFILE=CHFULL
- GOTO 30
- ENDIF
-10 CONTINUE
- WRITE(*,*)'File not found: ', CHFILE
-
- ELSE IF(CHOPT.EQ.'Memory')THEN
- IF(LTMP.NE.0)THEN
- LZEBLK(3,ISTORE)=LTMP
- GOTO 25
- ENDIF
- CALL UCTOH(CHKEY(1:4),IHID(1),4,4)
- CALL UCTOH(CHKEY(5:8),IHID(2),4,4)
- IF(IXDIV.EQ.0)THEN
- IF(ISTORE.LT.0 .OR. ISTORE.GT.16)ISTORE=0
- IF(IDIV.LE.0 .OR. IDIV.GT.20)IDIV=2
- IXDIV=IDIV
- CALL SBYT(ISTORE,IXDIV,27,6)
- CALL MZSDIV(IXDIV,1)
- ENDIF
-* init link area for this store
- IF(LZEFLG(ISTORE).EQ.0)THEN
- CALL MZLINK(IXDIV,'DZDZEB',
- & LZEBLK(1,ISTORE),LZEBLK(3,ISTORE),LZEBLK(3,ISTORE))
- LZEFLG(ISTORE)=1
- IIST=0
- CALL SBYT(ISTORE,IIST,27,6)
- DO 6 K=21,24
-6 CALL MZXREF(IXDIV,K+IIST,'A')
- ENDIF
-
-* find the bank
-
- LGO=0
-20 CONTINUE
- LZEBLK(3,ISTORE)=LZFIDH(IXDIV,IHID(1),LGO)
- IF(LZEBLK(3,ISTORE).EQ.0)THEN
- WRITE(*,'(A,I3,A,I3)')
- & 'Bank not found in Store',ISTORE,' Division',IDIV
- GOTO 999
- ENDIF
-* look for Upbank
- IF(NCHU.NE.0)THEN
- LGO=LZEBLK(3,ISTORE)
- LUP= LQ(LZEBLK(3,ISTORE)+1+KQS)
- IF(CHKEY(5:8).EQ.'NONE' .AND. LUP .NE. 0)GOTO 20
- IF(LUP.EQ.0)THEN
- WRITE(*,'(A,A,I3,A,I3)')
- & 'Bank not found in Store',ISTORE,' Division',IDIV
- GOTO 999
- ENDIF
- IF(IQ(LUP-4+KQS).NE.IHID(2))GOTO 20
- ENDIF
-25 CALL DZDTMP(IXDIV,LZEBLK(3,ISTORE),LUNTMP,CHOTMP//'AVDS')
- ELSE
- WRITE(*,*)'Unknown option ',CHOPT
- GOTO 999
- ENDIF
-
-30 CONTINUE
- CLOSE(LUNTMP)
- LUNTMP=0
- IF(EDITSV)THEN
- CALL KUESVR(CHFILE, ISTAT)
- ELSE
- CALL KUEDIT(CHFILE, ISTAT)
- IF(ISTAT.NE.0)THEN
- WRITE(*,*)'No mods made, dont put into Rz-file'
- GOTO 999
- ENDIF
- CALL DZDUDD(CHFILE)
- ENDIF
-999 CALL RZCDIR(CWDSAV,' ')
- END
-
-*********************************************************************
diff --git a/src/graflib/dzdoc/dzdraw/dzdent.F b/src/graflib/dzdoc/dzdraw/dzdent.F
deleted file mode 100644
index 52cc391..0000000
--- a/src/graflib/dzdoc/dzdraw/dzdent.F
+++ /dev/null
@@ -1,554 +0,0 @@
-*
-* $Id: dzdent.F,v 1.1.1.1 1996/03/04 16:13:18 mclareni Exp $
-*
-* $Log: dzdent.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:18 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDENT
-************************************************************************
-*. *
-*...DZDENT outputs the link,data and status bit information for a bank *
-*. *
-*. DZDENT is a daugther routine of DZDOCO *
-*. It prints the information about the link, status bit and data *
-*. part of a given bank identifier *
-*. *
-*. BANKS R : QBKD *
-*. CALLS : DZDLIN,INDXBC *
-*. CALLED : DZDOCO *
-*. COMMON : DZDOCC,DZDTAP,MZCN *
-*. *
-*. AUTHOR : M. Goossens DD/US *
-*. VERSION : 2.03(47) / 11 Oct 1987 *
-*. *
-*. UPDATE : 21 Mar 1988 *
-*. BY : O.Schaile *
-*. Allow return of all described links if B-option is *
-*. given (rather then only announced one) *
-*. Use link in link area (LBQBKD, LQBKD) for all references *
-*. Suppress printing at various places if B-option given *
-*. 3 Dec 88
-*. simplify SGML, remove all SGML from this routine
-*. 21-Nov-95 PN: Z option supress data description dump *
-*.**********************************************************************
-C SAVE
-
-#include "dzdoc/bkwrp.inc"
-#include "dzdoc/tapes.inc"
-* From DZEBRA
-#include "zebra/zbcdk.inc"
-#include "dzdoc/linout.inc"
- LOGICAL BTEST, LTHERE, RTHERE,BTHERE,DTHERE
-*-- General information
- CHARACTER CFORM*4
-#include "dzdoc/docparq.inc"
-#include "dzdoc/dzdocobk.inc"
-#include "dzdoc/bknuparq.inc"
-#include "zebra/bkfoparq.inc"
-#include "dzdoc/bkstparq.inc"
-#include "dzdoc/bktgparq.inc"
-#include "dzdoc/bktgdatq.inc"
-
- LTHERE=.FALSE.
- RTHERE=.FALSE.
- BTHERE=.FALSE.
- DTHERE=.FALSE.
- 10 CONTINUE
-
-*-- Loop over the link, status bit and data information
-
- II = NBHEAQ
- IF (IFLOPT(MPOSBQ).NE.0) THEN
-*-- Link description bank option
-*-- Number of links announced
- NLLINK = IQ(KQSP+LBQBKD+MONLQ)
- NSLINK = IQ(KQSP+LBQBKD+MONSQ)
- NLLL = MAX(NLLINK,NSLINK)
-*-- Get the number ow words required in the bank
- NLPUSH = NLLL + MOLK0Q - IQWND(KQSP+LBQBKD)
-*-- If number of link > 0 -- Push bank, otherwise noopt
-
-*--- OTTO allow return of non announced links
-
-*-- CALL DZVERI('Before MZPUSH',0,'CFLSU')
- IF (NLLL.GE.0) CALL MZPUSH(0,LBQBKD,0,NLPUSH,'I')
-*-- PRINT '('' NLLINK NLPUSH '',2I5)',NLLINK,NLPUSH
-*-- CALL DZSHOW('After PUSH',0,L,' ',0,0,0,0)
-*-- Local working variables
-*-- 0th address and max. nb. entries in link description bank
-* MBLK0 = KQSP + LBQBKD + MOLK0Q
- NBLMAX = IQWND(KQSP+LBQBKD) - MOLK0Q
-
- IHLPUT = 0
-
- ENDIF
- ITAG = IOTAGQ
- IF (IFLOPT(MPOSIQ).NE.0) THEN
- IREP = 0
- ELSE
- IREP = 5
- ENDIF
-
- DO 120 I=MBLINQ,MBDATQ
- IF (IFLOPT(MPOSBQ).NE.0.AND.I.NE.MBLINQ) GO TO 120
- II = II + IQ(KQSP+LQBKD+I-1)
- INSERT = II + 1
- IREPLO = 0
- INDENT = 0
- IF (I.EQ.MBLINQ .AND. IFLOPT(MPOSBQ).EQ.0) THEN
- IF (IQ(KQSP+LQBKD+I).GT.0) THEN
- IF (IFLOPT(MPOSIQ).NE.0) THEN
- WRITE(LUNUSR,'(''*B.LINK'')')
- LTHERE=.TRUE.
- ELSE
- WRITE(LUNUSR,'
- + (T15,''---------- Description of the '',
- + ''links ----------'') ')
- ENDIF
- ELSE
-C-- No link description
- GO TO 120
- ENDIF
-
- ELSEIF (I.EQ.MBRLIQ) THEN
- IF (IQ(KQSP+LQBKD+I).GT.0) THEN
- IF (IFLOPT(MPOSIQ).NE.0) THEN
- RTHERE=.TRUE.
- IF(LTHERE)THEN
- WRITE(LUNUSR,'(''*B/LINK'')')
- LTHERE=.FALSE.
- ENDIF
- WRITE(LUNUSR,'(''*B.RLINK'')')
- ELSE
- WRITE(LUNUSR,'
- + (T15,''---------- Description of the '',
- + ''Reference links ----------'') ')
- ENDIF
- ELSE
-C-- No ref link description
- GO TO 120
- ENDIF
-
- ELSEIF (I.EQ.MBBITQ) THEN
- IF (IQ(KQSP+LQBKD+I).GT.0) THEN
- IF (IFLOPT(MPOSIQ).NE.0) THEN
- WRITE(LUNUSR,'(''*B.BI'')')
- BTHERE=.TRUE.
- IF(LTHERE)THEN
- WRITE(LUNUSR,'(''*B/LINK'')')
- LTHERE=.FALSE.
- ENDIF
- IF(RTHERE)THEN
- WRITE(LUNUSR,'(''*B/RLINK'')')
- RTHERE=.FALSE.
- ENDIF
- ELSE
- WRITE(LUNUSR,'
- + (T15,''---------- Description of the '',
- + ''status bits ----------'') ')
- ENDIF
- ELSE
-C-- No status bit description
- GO TO 120
- ENDIF
- ELSEIF (I.EQ.MBDATQ) THEN
- IF (IQ(KQSP+LQBKD+I).GT.0 .AND. IFLOPT(MPOSZQ).EQ.0) THEN
- IF (IFLOPT(MPOSIQ).NE.0) THEN
- WRITE(LUNUSR,'(''*B.DATA'')')
- DTHERE=.TRUE.
- IF(LTHERE)THEN
- WRITE(LUNUSR,'(''*B/LINK'')')
- LTHERE=.FALSE.
- ENDIF
- IF(RTHERE)THEN
- WRITE(LUNUSR,'(''*B/RLINK'')')
- RTHERE=.FALSE.
- ENDIF
- IF(BTHERE)THEN
- WRITE(LUNUSR,'(''*B/BI'')')
- BTHERE=.FALSE.
- ENDIF
- ELSE
- WRITE(LUNUSR,'
- + (T15,''---------- Description of the '',
- + ''data words ----------'') ')
- ENDIF
- ELSE
-C-- No data description
- GO TO 120
- ENDIF
- ENDIF
- 20 IF (INSERT.GT.II+IQ(KQSP+LQBKD+I)) GO TO 100
- JTAG = IQ(KQSP+LQBKD+INSERT+MBPATQ)
- NWTAG = IBITS(JTAG,ICHTGQ,NCHTGQ)
- ICHOIC = IBITS(JTAG,ICHBTQ,1)
- IDTAG = IBITS(JTAG,ICHIDQ,NCHIDQ)
- IREPLV = IBITS(JTAG,IRPLVQ,NRPLVQ)
- IF (IREPLO.LT.IREPLV) THEN
-*---- Repetition field descriptor
-*-- Start of higher level
- IF (IFLOPT(MPOSIQ).NE.0) THEN
- COUT = '*B.REP '
- INDENT = 8
- ELSE
- INDENT = IREPLO*INDENQ
- COUT = ' '
- COUT(INDENT+2:)='--REP level='//
- + CHAR(ICHAR('0')+IREPLV)
- ENDIF
-
-*1810 IF (IREPLO.EQ.0)THEN
-*1810 COUT(INDENT+2:)='-- Do I = 1,'
-*1810 ELSE IF(IREPLO.EQ.1)THEN
-*1810 COUT(INDENT+2:)='-- Do K = 1,'
-*1810 ELSE
-*1810 COUT(INDENT+2:)='-- Do J = 1,'
-*1810 ENDIF
- IREPLO = IREPLV
- INUM1 = IQ(KQSP+LQBKD+INSERT+MBIX1Q)
- IF (INUM1.GT.0) THEN
-*-- Given as real number
- WRITE(COUT(ITAG+IREP+INDENT:),'(I8)') INUM1
- ELSEIF (INUM1.EQ.INUINQ) THEN
-*-- Indefinite (variable) number
- COUT(ITAG+IREP+INDENT:) = 'infinite'
- ELSE
-*-- Information is in form of Hollerith text
- NWTAG = -INUM1/JFOSEQ
- ENDIF
-*-- Skip I self-describing sector
- INSERT = INSERT + NBDSCQ
-*-- If not Hollerith self-describing sector -- SKIP
- IF (MOD(IQ(KQSP+LQBKD+INSERT),JFOSEQ).NE.IFOHOQ) THEN
- IF (NWTAG.GT.0) THEN
-*-- Inconsistency: Tag announced and non present
- WRITE(LUNUSR,'(''0?? DZDENT: Inconsistency: '',
- + ''Tag information announced and non present'')')
- GO TO 130
- ENDIF
- IF(IFLOPT(MPOSBQ).EQ.0)THEN
-* IF (INUM1.NE.0)
- WRITE(LUNUSR,'(A)') COUT
- ENDIF
- GO TO 20
- ENDIF
-*-- Total number of Hollerith words
- NWHOLL = IQ(KQSP+LQBKD+INSERT)/JFOSEQ
- INSERT = INSERT + 1
-*-- When there is tag info
- IF (NWTAG.GT.0) THEN
-*-- Numbers given as Hollerith text
- INLINE=ITAG+IREP+INDENT
- CALL UHTOC(IQ(KQSP+LQBKD+INSERT),4,
- + COUT(INLINE:),NWTAG*4)
- INSERT = INSERT + NWTAG
- NWHOLL = NWHOLL - NWTAG
- ENDIF
-*-- Is there some text left
- IF (NWHOLL.GT.0) THEN
-*-- More text in the buffer
- INLINE = INLINE+NWTAG*4
-* INLINE = IOENTQ + IREP + INDENT
- IEWORK = 0
- NOUTF = NOUTQ - INLINE + 1
- CALL DZDLIN
- ELSE
- IF(IFLOPT(MPOSBQ).EQ.0)WRITE(LUNUSR,'(A)') COUT
- ENDIF
-
-*------------------ End of loop over Hollerith text
- INDENT = IREPLV*INDENQ
- ELSEIF (IREPLO.GT.IREPLV) THEN
-*---- End of repetition field
- IF (IFLOPT(MPOSBQ) .EQ. 0)THEN
-*-- Level goes down --> close present level
- INDENT = IREPLV*INDENQ
- IF (IFLOPT(MPOSIQ).NE.0) THEN
- COUT = '*B/REP '
- ELSE
- COUT = ' '
- COUT(INDENT+2:)='--REP level='//
- + CHAR(ICHAR('0')+IREPLO)//' -- End --'
-*1810 COUT(INDENT+2:)='-- End Do -----------------------'
- ENDIF
- WRITE (LUNUSR,'(A)') COUT
- ENDIF
- IREPLO = IREPLV
-*-- Cross check on EOFS flag
- IF (.NOT.BTEST(JTAG,IBEOSQ)) THEN
- WRITE (LUNUSR,'(''0?? DZDENT- Illegal repetition''
- + ,'' level counting (only 1 item allowed'')')
-* WRITE (LUNOUT,'(''0?? DZDENT -- Illegal repetition''
-* X ,'' level counting (only 1 item allowed'')')
-
- GO TO 130
- ELSE
-*-- Skip I self-describing sector
- INSERT = INSERT + NBEOSQ
- ENDIF
- ELSE
-*---- Entry documentation
- INUM1 = IQ(KQSP+LQBKD+INSERT+MBIX1Q)
- INUM2 = IQ(KQSP+LQBKD+INSERT+MBIX2Q)
- IF (INUM1.GT.0) THEN
-*-- Get number of characters in INUM1
- ICH = INUM1
- DO 30 IW1=1,8
- ICH = ICH/10
- IF (ICH.EQ.0) GO TO 40
- 30 CONTINUE
- IW1 = 8
- 40 ENDIF
- IF (INUM2.GT.0) THEN
-*-- Get number of characters in INUM2
- ICH = INUM2
- DO 50 IW2=1,8
- ICH = ICH/10
- IF (ICH.EQ.0) GO TO 60
- 50 CONTINUE
- IW2 = 8
- 60 ENDIF
-*-- Indent for each new repetition level
- COUT = ' '
- IF (IFLOPT(MPOSIQ).NE.0) THEN
- COUT='*B.'
- INLINE=3
- IW1=IW1-1
- ELSE
- COUT = ' '
- INLINE = INDENT*INDENQ
- ENDIF
- IF (INUM2.EQ.0) THEN
-*-- Case of only one number given
- IF (INUM1.GE.0) THEN
-*-- Given as real number
- CFORM = '(I'//CHAR(ICHAR('1')+IW1)//')'
- WRITE(COUT(INLINE+1:),CFORM) INUM1
- INLINE = INLINE + IW1 + 1
- ELSEIF (INUM1.EQ.INUINQ) THEN
-*-- Indefinite (variable) number
- INLINE = INLINE + 1
- COUT(INLINE:) = '*'
- ENDIF
- ELSE
-*-- Case of two numbers
- IF (INUM1.GE.0) THEN
-*-- Given as real number
- CFORM = '(I'//CHAR(ICHAR('1')+IW1)//')'
- WRITE(COUT(INLINE+1:),CFORM) INUM1
- INLINE = INLINE + IW1 + 1
- ELSEIF (INUM1.EQ.INUINQ) THEN
-*-- Indefinite (variable) number
- INLINE = INLINE + 1
- COUT(INLINE:) = '*'
- ENDIF
- IF (INUM2.GE.0) THEN
-*-- Given as real number
- INLINE = INLINE + 1
- COUT(INLINE:INLINE) = '-'
- CFORM = '(I'//CHAR(ICHAR('0')+IW2)//')'
- WRITE(COUT(INLINE+1:),CFORM) INUM2
- INLINE = INLINE + IW2
- ELSEIF (INUM2.EQ.INUINQ) THEN
-*-- Indefinite (variable) number
- COUT(INLINE+1:INLINE+2) = '-*'
- INLINE = INLINE + 2
- ENDIF
- ENDIF
-*-- Skip I self-describing sector
- INSERT = INSERT + NBDSCQ
-*-- If not Hollerith self-describing sector -- SKIP
- IF (MOD(IQ(KQSP+LQBKD+INSERT),JFOSEQ).NE.IFOHOQ) THEN
-* WRITE(LUNOUT,'(''0?? DZDENT -- Incomplete data'')')
- WRITE(LUNUSR,'(''0?? DZDENT -- Incomplete data'')')
- WRITE(LUNUSR,'(A,A4)')' Previous error occured in',
- + IQ(KQSP+LBQBKD+MOIDHQ)
- GO TO 20
- ENDIF
-*-- Total number of Hollerith words
- NWHOLL = IQ(KQSP+LQBKD+INSERT)/JFOSEQ
- IITAG = INSERT + 1
- INSERT = IITAG
- IF (INUM2.EQ.0) THEN
-*-- Case of only one number given
- IF (INUM1.LE.-JFOSEQ) THEN
-*-- Information is in form of Hollerith text
- NWN1 = -INUM1/JFOSEQ
- CALL UHTOC(IQ(KQSP+LQBKD+INSERT+NWTAG),4,
- + COUT(INLINE+1:),NWN1*4)
- INLINE = INDXBC(COUT(:INLINE+NWN1*4),' ')
- INSERT = INSERT + NWN1
- NWHOLL = NWHOLL - NWN1
- ENDIF
- ELSE
-*-- Case of two numbers
- IF (INUM1.LE.-JFOSEQ) THEN
-*-- Information is in form of Hollerith text
- NWN1 = -INUM1/JFOSEQ
- CALL UHTOC(IQ(KQSP+LQBKD+INSERT+NWTAG),4,
- + COUT(INLINE+1:),NWN1*4)
- INLINE = INDXBC(COUT(:INLINE+NWN1*4),' ')
- INSERT = INSERT + NWN1
- NWHOLL = NWHOLL - NWN1
- ENDIF
- IF (INUM2.LE.-JFOSEQ) THEN
-*-- Information is in form of Hollerith text
- INLINE = INLINE + 1
- COUT(INLINE:INLINE) = '-'
- NWN2 = -INUM2/JFOSEQ
- CALL UHTOC(IQ(KQSP+LQBKD+INSERT+NWTAG),4,
- + COUT(INLINE+1:),NWN2*4)
- INLINE = INDXBC(COUT(:INLINE+NWN2*4),' ')
- INSERT = INSERT + NWN2
- NWHOLL = NWHOLL - NWN2
- ENDIF
- ENDIF
- INLINE = INDENT + ITAG
-
-*-- Special case for the link descriptor bank
-
- IF (IFLOPT(MPOSBQ).EQ.0) GO TO 90
-*-- Update pointer in input bank and test tag information
- INSERT = INSERT + NWHOLL
- LENBKD = IQWND(LBQBKD+KQSP)
- IF (NWTAG.LE.0) GO TO 20
-*-- Now cases for link numbers
- IF (INUM1.LE.0) GO TO 20
- IF (INUM2.LT.INUINQ) THEN
- GO TO 20
- ELSEIF (INUM2.EQ.INUINQ) THEN
-*-- Undefined --> Fill bank up to end and exit
- DO 70 IINUM=INUM1,NBLMAX
- 70 IQ(KQSP + LBQBKD + MOLK0Q+IINUM) =
- + IQ(KQSP+LQBKD+IITAG)
- GO TO 120
- ELSEIF (INUM2.EQ.0) THEN
-*-- Only one number given - Inside allowed offsets?
- IF(INUM1+MOLK0Q .GT. LENBKD)THEN
- NLPUSH=INUM1+MOLK0Q - LENBKD
- CALL MZPUSH(0,LBQBKD,0,NLPUSH,'I')
- ENDIF
- IQ(KQSP + LBQBKD + MOLK0Q+INUM1)=
- + IQ(KQSP+LQBKD+IITAG)
- IF(INUM1 .GT. IHLPUT)IHLPUT = INUM1
- ELSE
-*-- Range of numbers given - Inside allowed offsets?
- DO 80 IINUM=MIN(INUM1,NBLMAX),MIN(INUM2,NBLMAX)
- 80 IQ(KQSP + LBQBKD + MOLK0Q+IINUM) =
- + IQ(KQSP+LQBKD+IITAG)
- ENDIF
- GO TO 20
- 90 CONTINUE
-*-- When there is tag info <===========
- IF (NWTAG.GT.0) THEN
-*-- Numbers given as Hollerith text
- CALL UHTOC(IQ(KQSP+LQBKD+IITAG),4,
- + COUT(INLINE:),MIN(NENTIQ-2,NWTAG*4))
-*1810
- IF(INDEX(COUT,'L:').NE.0)THEN
- IF (IFLOPT(MPOSIQ).NE.0) THEN
- COUT(1:4) = '*B.*'
- ELSE
- WRITE(LUNUSR,'(A)')' '
- COUT(1:INDEX(COUT,'L:')-1)='--Label:'
- ENDIF
- ENDIF
- INSERT = INSERT + NWTAG
-*-- Is there some text left
- NWHOLL = NWHOLL - NWTAG
- ENDIF
-*-- Remaining text
- IF (NWHOLL.GT.0) THEN
-*-- Copy text according to output type desired
- INLINE = IOENTQ + INDENT
- IF (NWHOLL.EQ.1.AND.IQ(KQSP+LQBKD+INSERT).EQ.IDEMTX)
- + THEN
-*-- Repetition of the previous line
- COUT(INLINE:) = ' idem'
- INSERT = INSERT + 1
- NWHOLL = 0
- IF(IFLOPT(MPOSBQ).EQ.0)WRITE(LUNUSR,'(A)') COUT
- ELSE
- IEWORK = 0
- NOUTF = NOUTQ - INLINE + 1
-*-- General case with text
- CALL DZDLIN
- ENDIF
- ELSE
-*-- For tags only
- IF(IFLOPT(MPOSBQ).EQ.0)WRITE(LUNUSR,'(A)') COUT
-*------------------ End of field with text information
- ENDIF
-*--------------- Multiple choice present ?
- IF (ICHOIC.NE.0) THEN
-*-- Still more text to read?
- IF (MOD(IQ(KQSP+LQBKD+INSERT),JFOSEQ).EQ.IFOHOQ) THEN
-*-- Indent for each new repetition level
- COUT = ' '
- INLINE = INDENT + ITAG
-*-- Total number of Hollerith words
- NWHOLL = IQ(KQSP+LQBKD+INSERT)/JFOSEQ
- IITAG = INSERT + 1
- INSERT = IITAG
-*-- ============== Alternative choice for entry ==============
- GO TO 90
-*-- >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
- ENDIF
- ENDIF
-*-------------- End of entry (repetition or information tag) [below 110]
- ENDIF
- GO TO 20
-*-- Close the description level if needed
- 100 CONTINUE
- IF(IFLOPT(MPOSBQ) .EQ. 0)THEN
- DO 110 IR=IREPLV,1,-1
- IF (IFLOPT(MPOSIQ).NE.0) THEN
- COUT = '*B/REP '
- INDENT = 10
- ELSE
- INDENT = (IR-1)*INDENQ
- COUT = ' '
- COUT(INDENT+2:)='--REP level='//
- + CHAR(ICHAR('0')+IR)//' -- End --'
-*1810 COUT(INDENT+2:)='-- End Do -----------------------'
- ENDIF
- WRITE (LUNUSR,'(A)') COUT
- 110 CONTINUE
- ENDIF
- IF(LTHERE)THEN
- WRITE(LUNUSR,'(''*B/LINK'')')
- LTHERE=.FALSE.
- ENDIF
- IF(RTHERE)THEN
- WRITE(LUNUSR,'(''*B/RLINK'')')
- RTHERE=.FALSE.
- ENDIF
- IF(BTHERE)THEN
- WRITE(LUNUSR,'(''*B/BI'')')
- BTHERE=.FALSE.
- ENDIF
- IF(DTHERE)THEN
- WRITE(LUNUSR,'(''*B/DATA'')')
- DTHERE=.FALSE.
- ENDIF
-*---------- End of loop over link/status bits/data info (400)
- 120 CONTINUE
-
- GOTO 140
-
- 130 CONTINUE
-
- WRITE(LUNOUT,'(A,A4)')' Previous error occured in: ',
- + IQ(KQSP+LQBKD+1)
-
- 140 CONTINUE
-
-*--- OTTO tell highest link number
-
- IQ(LBQBKD+KQSP+5) = IHLPUT
- IQUEST(MOQUEQ) = LBQBKD
-
- END
diff --git a/src/graflib/dzdoc/dzdraw/dzdfio.F b/src/graflib/dzdoc/dzdraw/dzdfio.F
deleted file mode 100644
index ab4ad6c..0000000
--- a/src/graflib/dzdoc/dzdraw/dzdfio.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: dzdfio.F,v 1.1.1.1 1996/03/04 16:13:17 mclareni Exp $
-*
-* $Log: dzdfio.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:17 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDFIO(CHPF,IPCHPF,NSTYP,CHARIO)
- CHARACTER*(*)CHPF
- CHARACTER*1 CHARIO
- CHARACTER*4 CHFORM
- NCHPF=LEN(CHPF)
- NC=LOG10(FLOAT(NSTYP))+1
- IF(IPCHPF+NC+2.GT.NCHPF.OR.NC.GT.9)THEN
- WRITE(*,*)'IO-char too long'
- CHPF=' '
- GOTO 999
- ENDIF
- WRITE(CHFORM,'(A,I1,A)')'(I',NC,')'
- WRITE(CHPF(IPCHPF:),CHFORM)NSTYP
- CHPF(IPCHPF+NC:IPCHPF+NC)=CHARIO
- IPCHPF=IPCHPF+NC+2
- 999 END
-*********************************************************************
diff --git a/src/graflib/dzdoc/dzdraw/dzdfla.F b/src/graflib/dzdoc/dzdraw/dzdfla.F
deleted file mode 100644
index ef3c930..0000000
--- a/src/graflib/dzdoc/dzdraw/dzdfla.F
+++ /dev/null
@@ -1,44 +0,0 @@
-*
-* $Id: dzdfla.F,v 1.1.1.1 1996/03/04 16:13:09 mclareni Exp $
-*
-* $Log: dzdfla.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:09 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDFLA(X,Y,AL,AA)
-*.
-*...DZDFLA draw an arrow
-*.
-*. INPUT : X,Y coordinates of arrow
-*. AL length
-*. AA angle
-*. CALLS : DZDGPL
-*. CALLED : DZDLI2
-*.
-*. AUTHOR : O.Schaile
-*. VERSION : 1.00
-*. CREATED : 11-Dec-87
-*.**********************************************************************
-*.
-*
- REAL XF(4),YF(4)
- PARAMETER (DEGRAD = 0.0174533)
-*
- XF(1) = X
- YF(1) = Y
- XF(4) = X
- YF(4) = Y
- AN1=AA+20.
- AN1 = AN1*DEGRAD
- XF(2)=X-AL*COS(AN1)
- YF(2)=Y-AL*SIN(AN1)
-*
- AN1=AA- 20.
- AN1 = AN1*DEGRAD
- XF(3)=X-AL*COS(AN1)
- YF(3)=Y-AL*SIN(AN1)
- CALL DZDGPL(4,XF,YF)
- END
-************************************************************************
diff --git a/src/graflib/dzdoc/dzdraw/dzdfll.F b/src/graflib/dzdoc/dzdraw/dzdfll.F
deleted file mode 100644
index 4c9815f..0000000
--- a/src/graflib/dzdoc/dzdraw/dzdfll.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: dzdfll.F,v 1.1.1.1 1996/03/04 16:13:05 mclareni Exp $
-*
-* $Log: dzdfll.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:05 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDFLL
-* IMPLICIT NONE
- INTEGER NCH, LUN, LOGL
- CHARACTER*4 CHLUN
-
- CALL KUGETC(CHLUN,NCH)
- IF(NCH.LE.0)GOTO 999
- CALL DZDCTI(CHLUN,LUN)
- CALL KUGETI(LOGL)
- CALL FZLOGL(LUN,LOGL)
-999 END
-***********************************************************************
diff --git a/src/graflib/dzdoc/dzdraw/dzdfnt.F b/src/graflib/dzdoc/dzdraw/dzdfnt.F
deleted file mode 100644
index 770c9aa..0000000
--- a/src/graflib/dzdoc/dzdraw/dzdfnt.F
+++ /dev/null
@@ -1,248 +0,0 @@
-*
-* $Id: dzdfnt.F,v 1.1.1.1 1996/03/04 16:13:04 mclareni Exp $
-*
-* $Log: dzdfnt.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:04 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDFNT
-#include "zebra/mqsys.inc"
-#include "dzdzbrinc.inc"
- INTEGER MAXS, MAXV
- PARAMETER (MAXS=10, MAXV=100, MAXAN=5)
- COMMON/DZDNTS/ ISVAR(MAXS), IVVAR(MAXV+1,MAXAN)
-
- REAL XNTVAL(MAXS)
- EQUIVALENCE(ISVAR,XNTVAL)
-*--
- INTEGER IAFLAG(MAXS)
- INTEGER NTUPID,MAXEV,NEVENT, NCOLS, NCOLV
- & , LL, IXDIV,ISTORE,I,LD,NSTEPS, ITYPE
- & , IWORDF, IWORDL, NVAL, IP, ISTEER
- CHARACTER*8 CNAME, CTAG(MAXS)
- CHARACTER*4 CHOPT
- CHARACTER*2 CTYPE
- CHARACTER*50 CPATH
- LOGICAL HEXIST
-*--
- ISTEER=0
- GOTO 5
-
- ENTRY DZDPNT
- ISTEER=1
-
- 5 IXDIV=0
- ISTORE=ISTNTU
- CALL SBYT(ISTORE,IXDIV,27,6)
- CALL MZSDIV(IXDIV,-7)
- LL=LZEBLK(2,ISTORE)
- IF(LL.EQ.0)THEN
- WRITE(*,*)'Nothing marked for Ntuple'
- GOTO 999
- ENDIF
- NCOLS=0
- NCOLV=0
-
- IF(ISTEER.EQ.1)GOTO 10
-
- CALL KUGETI(LUN)
- CALL KUGETI(NTUPID)
- IF(HEXIST(NTUPID))THEN
- WRITE(*,*)'Id exists already',NTUPID
- GOTO 999
- ENDIF
- CALL KUGETC(CNAME,NCH)
- CALL KUGETC(CPATH,NCH)
- CALL KUGETI(MAXEV)
- IF(MAXEV.LE.0)MAXEV=100
- CALL KUGETC(CHOPT,NCH)
- IF(INDEX(CHOPT,'R').NE.0)CALL FZENDI(LUN,'I')
- IF(CTDDOC.NE.' ')CALL RZCDIR(CWDSAV,'R')
-
-* CALL HBNT(NTUPID,CNAME,CPATH)
-
-* get tags
-
-10 CONTINUE
- NSTEPS=IQ(KQS+LL+5)
-* variable type (if <0 its array)
- ITYPE= IQ(KQS+LL+NSTEPS+8)
- IF (ABS(ITYPE).EQ.3)THEN
- CTYPE=':R'
- ELSE IF(ABS(ITYPE).EQ.5)THEN
- CTYPE=':C'
- ELSE
- CTYPE=':I'
- ENDIF
-* CALL UHTOC(IQ(KQS+LL+1),4,CTAG,8)
-
-* currently only single variables
-
-* IF(ITYPE.GT.0)THEN
- IF(NCOLS.GE.MAXS)THEN
- WRITE(*,*)'No more space for single variable'
- GOTO 15
- ENDIF
- NCOLS=NCOLS+1
- IF(ITYPE.GT.0)THEN
- IAFLAG(NCOLS)=0
- ELSE
- IAFLAG(NCOLS)=1
- ENDIF
- CALL UHTOC(IQ(KQS+LL+1),4,CTAG(NCOLS),8)
-* WRITE(CVAR,'(A,(I2.2))')'VA',NCOLS
-* CALL HBNAME(NTUPID,CVAR,ISVAR(NCOLS),CTAG//CTYPE)
-* ELSE
-* IF(NCOLV.GE.MAXAN)THEN
-* WRITE(*,*)'No more space for array variable'
-* GOTO 15
-* ENDIF
-* NCOLV=NCOLV+1
-* WRITE(CVAR,'(A,(I2.2))')'VA',NCOLV
-* CHFORM= 'N_'//CTAG//'[1,100],'
-* & //CTAG//'('//'N_'//CTAG//')'//CTYPE
-* CHFORM=SPACES( CHFORM,0)
-* NCH=LENOCC(CHFORM)
-* CALL HBNAME(NTUPID,CVAR,IVVAR(1,NCOLV),CHFORM(1:NCH))
-* ENDIF
- IF(ISTEER.EQ.1)THEN
- WRITE(*,*)'Name: '//CTAG(NCOLS)//' type: '//CTYPE
- ENDIF
-15 LL=LQ(KQS+LL)
- IF(LL.NE.0)GOTO 10
-
- IF(ISTEER.EQ.1)GOTO 999
-
- CALL HBOOKN(NTUPID,CNAME,NCOLS,CPATH,100*NCOLS,CTAG)
- NEVENT=0
-20 CONTINUE
-
- IF(LZEBLK(1,ISTORE).NE.0)CALL MZDROP(IXDIV,LZEBLK(1,ISTORE),' ')
- LZEBLK(1,ISTORE)=0
- NUH=NUHMAX
- CALL FZIN(LUN,IXDIV,LZEBLK(1,ISTORE),1,' ',NUH,IUHEAD)
- IF(IQUEST(1).NE.0)THEN
- IF(IQUEST(1).GE.3 .AND. IQUEST(1).LE.6)THEN
- WRITE(*,*)'FZIN: End of file reached, rewind it'
- CALL FZENDI(LUN,'I')
- GOTO 999
- ELSE
- WRITE(*,*)'Error from FZIN', IQUEST(1)
- GOTO 20
- ENDIF
- ENDIF
- IF(LZEBLK(1,ISTORE).EQ.0)THEN
- WRITE(*,*)'FZIN: No d/s found'
- GOTO 20
- ENDIF
-
- LL=LZEBLK(2,ISTORE)
- NCOLS=0
- NCOLV=0
-
-* currently only single variables, RESET VECTORS
-
- DO 26 I=1,MAXAN
- DO 26 J=1,MAXV+1
-26 IVVAR(J,I)=0
-
-* loop on columns
-
-25 CONTINUE
- NSTEPS=IQ(KQS+LL+5)
- ITYPE= IQ(KQS+LL+NSTEPS+8)
-
- CALL UHTOC(IQ(KQS+LL+1),4,CTAG,8)
-* IF(ITYPE.GT.0)THEN
- IF(NCOLS.GE.MAXS)GOTO 30
- NCOLS=NCOLS+1
-* ELSE
- IF(ITYPE.LT.0)THEN
- IF(NCOLV.GE.MAXAN)GOTO 30
- NCOLV=NCOLV+1
- ENDIF
- LD=LZEBLK(1,ISTORE)
-
-* find the bank
- IF(NSTEPS.LE.0)GOTO 36
- DO 35 K=NSTEPS+5,6,-1
- IF(IQ(KQS+LL+K).EQ.0)THEN
- LD=LQ(KQS+LD)
- ELSE
- LD=LQ(KQS+LD-IQ(KQS+LL+K))
- ENDIF
- IF(LD.EQ.0)THEN
- WRITE(*,*)'Requested bank not found'
- GOTO 30
- ENDIF
-35 CONTINUE
-
-* is offset given explicitly?
-36 IWORDF=IQ(KQS+LL+NSTEPS+6)
- IWORDL=IQ(KQS+LL+NSTEPS+7)
- IF(ITYPE.GT.0)THEN
-* scalar case
- IF(IWORDF.GT.0)THEN
- ISVAR(NCOLS) = IQ(KQS+LD+IWORDF)
- ELSE
- NVAL=1
- IF(CTDDOC.NE.' ')CALL RZCDIR(CTDDOC,' ')
- CALL DZDGVA(IXDIV,LD,'VQ',CTAG(NCOLS),NVAL,ISVAR(NCOLS),ITY)
- ENDIF
- ELSE
-* array
- IF(IWORDF.GT.0)THEN
- IF(IWORDL.LT.IWORDF)IWORDL=IWORDF
- IF(IWORDL-IWORDF.GT.MAXV)IWORDL=IWORDF+MAXV-1
- IVVAR(1,NCOLV)=IWORDL-IWORDF+1
- IP=1
- DO 37 I=IWORDF,IWORDL
- IP=IP+1
-37 IVVAR(IP,NCOLV) = IQ(KQS+LD+I)
- ELSE
- NVAL=MAXV
- IF(CTDDOC.NE.' ')CALL RZCDIR(CTDDOC,' ')
- CALL DZDGVA(IXDIV,LD,'VQ',CTAG(NCOLS)
- & ,NVAL,IVVAR(2,NCOLV),ITY)
- IVVAR(1,NCOLV)=NVAL
- ENDIF
- ENDIF
-30 LL=LQ(KQS+LL)
- IF(LL.NE.0)GOTO 25
-
-40 CONTINUE
-
-* currently only single variables
- MVAL=1
- IF(NCOLV.GT.0)THEN
- DO 45 I=1,NCOLV
- IF(IVVAR(1,I).GT.MVAL)MVAL=IVVAR(1,I)
-45 CONTINUE
- ENDIF
- DO 60 I=2,MVAL+1
- NVAL=0
- DO 50 J=1,NCOLS
- IF(IAFLAG(J).NE.0)THEN
- NVAL=NVAL+1
- IF(ABS(ITYPE).EQ.2)THEN
- XNTVAL(J)=IVVAR(I,NVAL)
- ELSE
- ISVAR(J)=IVVAR(I,NVAL)
- ENDIF
- ELSE
- IF(ABS(ITYPE).EQ.2)THEN
- XNTVAL(J)=ISVAR(J)
- ENDIF
- ENDIF
-50 CONTINUE
-60 CALL HFN(NTUPID,XNTVAL)
-
-* CALL HFNT(NTUPID)
- NEVENT=NEVENT+1
- IF(NEVENT.LT.MAXEV)GOTO 20
- IF(CTDDOC.NE.' ')CALL RZCDIR(CWDSAV,' ')
-
-999 END
-***********************************************************************
diff --git a/src/graflib/dzdoc/dzdraw/dzdfzi.F b/src/graflib/dzdoc/dzdraw/dzdfzi.F
deleted file mode 100644
index b175867..0000000
--- a/src/graflib/dzdoc/dzdraw/dzdfzi.F
+++ /dev/null
@@ -1,113 +0,0 @@
-*
-* $Id: dzdfzi.F,v 1.1.1.1 1996/03/04 16:13:04 mclareni Exp $
-*
-* $Log: dzdfzi.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:04 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDFZI
-#include "zebra/mqsys.inc"
-#include "dzdzbrinc.inc"
- INTEGER NCH, KNUMB, ISTORE, IIST, MMBK(20)
- CHARACTER*1 CHOPT,CHDS
- CHARACTER*2 CRET
- CHARACTER*80 CMD
- CHARACTER*10 CKNUMB, CMFZIN(5)
- DATA CMFZIN/'S_of_Run', 'E_of_Run','Zebra_EOF', 'Sys_EOF',
- & 'Sys_EOD'/
- CALL KUGETC(CKNUMB,NCH)
- IF(NCH.LE.0)GOTO 999
- CALL DZDCTI(CKNUMB,KNUMB)
- IF(KNUMB.LE.0)GOTO 999
- CALL KUPATL(CMD,NCH)
- IF (INDEX(CMD,'_HEAD').NE.0)THEN
- CHOPT='S'
- ELSE IF(INDEX(CMD,'_PDS').NE.0)THEN
- CHOPT='A'
- ELSE
- CHOPT=' '
- ENDIF
- CALL KUGETC(CHDS,NCH)
- ISTORE=0
- IIST = 1
- CALL SBYT(ISTORE,IIST,27,6)
-* init link area for store 0
-
- IF(LZEFLG(ISTORE).EQ.0)THEN
- CALL MZLINK(IIST,'DZDZEB',
- & LZEBLK(1,ISTORE),LZEBLK(3,ISTORE),LZEBLK(3,ISTORE))
- LZEFLG(ISTORE)=1
- ENDIF
- IF(LZEBLK(1,ISTORE).NE.0)CALL MZDROP(IIST,LZEBLK(1,ISTORE),' ')
- LZEBLK(1,ISTORE)=0
- NUH=NUHMAX
- CALL FZIN(KNUMB,IIST,LZEBLK(1,ISTORE),1,CHOPT,NUH,IUHEAD)
- IF(IQUEST(1).NE.0)THEN
- IF (IQUEST(1).GE.1 .AND. IQUEST(1).LE.5)THEN
- WRITE(*,*)'FZIN:', CMFZIN(IQUEST(1))
- ELSE IF(IQUEST(1).EQ.6)THEN
- WRITE(*,*)'Try ro read beyond EOD, rewind unit',KNUMB
- CALL FZENDI(KNUMB,'I')
-* CLOSE(KNUMB)
- ELSE
- WRITE(*,*)'Error from FZIN', IQUEST(1)
- ENDIF
- NUH=0
- IF(ABS(IQUEST(1)).GT.9)THEN
- IQRET=SIGN(9,IQUEST(1))
- ELSE
- IQRET=IQUEST(1)
- ENDIF
- ELSE
- IQRET=0
- IF(INDEX(CHOPT,'S').NE.0 .OR. LZEBLK(1,ISTORE).EQ.0)THEN
- IF(INDEX(CHOPT,'S').EQ.0 .AND. LZEBLK(1,ISTORE).EQ.0)
- & WRITE(*,*)'FZIN: Link to d/s is 0!'
- WRITE(*,*)
- & 'FZIN, User header only, words read:',NUH
- IF(NUH.GT.0)THEN
- CALL UCTOH('USHD',MMBK(1),4,4)
- MMBK(2)=0
- MMBK(3)=0
- MMBK(4)=NUH
- MMBK(5)=0
- IF(IQUEST(20).GT.0)THEN
- CALL UCOPY(IQUEST(21),MMBK(5),IQUEST(20))
- ENDIF
- CALL MZLIFT(IIST,LZEBLK(1,ISTORE),LZEBLK(1,ISTORE),1,
- & MMBK,0)
- CALL UCOPY(IUHEAD,IQ(LZEBLK(1,ISTORE)+KQSP+1),NUH)
- INMFLG=1
- ENDIF
- ELSE
-* IF(IQUEST(14).EQ.0)THEN
-* WRITE(*,*)
-* & 'FZIN: d/s is empty'
-* GOTO 999
-* ENDIF
- INMFLG=2
- WRITE(*,*)
- & 'FZIN, Words read: ',IQUEST(14), ' into Store 0, Div 1'
- IF(NUH.GT.0)THEN
- NWIOCH=IQUEST(20)
- WRITE(*,*)
- & 'FZIN, NWIOCH=',NWIOCH
- IF(NWIOCH.GT.0)THEN
- CALL UCOPY(IQUEST(21),IOCHRD,MIN(NWIOCH,10))
- ENDIF
- ENDIF
- ENDIF
- IF(CHDS.EQ.'D')THEN
- CALL IZPICT('DZDISP','SQ')
- CALL IZPICT('DZDISP','M')
- CALL ISTXFP(6,0)
- CALL DZDISP(IIST,LZEBLK(1,ISTORE),CTDDOC,'D'//CCOL//CCACT,
- & IWKZEB,IWMZEB,ILOZEB, 0)
- ENDIF
- ENDIF
- WRITE(CRET,'(I2)')IQRET
- CALL KUEXEC('ALIAS/CREATE IQUEST_1 '//CRET)
- 999 END
-**********************************************************************
diff --git a/src/graflib/dzdoc/dzdraw/dzdfzs.F b/src/graflib/dzdoc/dzdraw/dzdfzs.F
deleted file mode 100644
index 9ae3c27..0000000
--- a/src/graflib/dzdoc/dzdraw/dzdfzs.F
+++ /dev/null
@@ -1,48 +0,0 @@
-*
-* $Id: dzdfzs.F,v 1.1.1.1 1996/03/04 16:13:06 mclareni Exp $
-*
-* $Log: dzdfzs.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:06 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDFZS
-* IMPLICIT NONE
- INTEGER NCH, INFLUN,INFSTA, INFOFZ(40), LUN,
- & MEDIU, IFIFO, IDAFO, IACMO, IRWMO
- INTEGER JBYT
- COMMON/FZSTAT/ INFLUN,INFSTA, INFOFZ
- CHARACTER*4 CHLUN
- CHARACTER*8 MEDTYP(0:6),FIFTYP(0:4), DAFTYP(0:1),ACMTYP(0:3),
- & RWMODE(0:3)
- DATA MEDTYP/'disk','tape', 'K disk','usertape','C disk',
- & 'tape, ch','memory'/
- DATA FIFTYP/'native','Xchange','Direct a','memory','Alpha'/
- DATA DAFTYP/'native','exchange'/
- DATA ACMTYP/'Fortran','Yspecial','L C-lib','C chann'/
- DATA RWMODE/' ','R ','W ','RW'/
-
- CALL KUGETC(CHLUN,NCH)
- IF(NCH.LE.0)GOTO 999
- CALL DZDCTI(CHLUN,LUN)
- CALL FZINFO(LUN)
- IF(INFLUN.NE.LUN)THEN
- WRITE(*,*)'Error from FZINFO'
- GOTO 999
- ENDIF
- WRITE(*,*)'***** FzInfo for file open on unit: ',LUN,' *****'
- MEDIU=JBYT(INFSTA,1,3)
- WRITE(*,*)'Medium : ',MEDTYP(MEDIU)
- IFIFO=JBYT(INFSTA,4,3)
- WRITE(*,*)'File Format : ',FIFTYP(IFIFO)
- IDAFO=JBYT(INFSTA,7,1)
- WRITE(*,*)'Data Format : ',DAFTYP(IDAFO)
- IACMO=JBYT(INFSTA,8,3)
- WRITE(*,*)'Access mode : ',ACMTYP(IACMO)
- IRWMO=JBYT(INFSTA,11,2)
- WRITE(*,*)'Open for : ',RWMODE(IRWMO)
- WRITE(*,*)'Log level : ',INFOFZ(4)
- WRITE(*,*)'Words read/wr: ',INFOFZ(19)*10000000+ INFOFZ(20)
-999 END
-***********************************************************************
diff --git a/src/graflib/dzdoc/dzdraw/dzdgdo.F b/src/graflib/dzdoc/dzdraw/dzdgdo.F
deleted file mode 100644
index f067b16..0000000
--- a/src/graflib/dzdoc/dzdraw/dzdgdo.F
+++ /dev/null
@@ -1,93 +0,0 @@
-*
-* $Id: dzdgdo.F,v 1.1.1.1 1996/03/04 16:13:17 mclareni Exp $
-*
-* $Log: dzdgdo.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:17 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDGDO(IXST,L,KEYVEC,CLINE,IFC,ILC,ICYCLE)
-#include "dzdoc/bkwrp.inc"
-* From DZEBRA
-#include "zebra/zbcdk.inc"
-#include "zebra/zunit.inc"
-#include "dzdprm.inc"
- INTEGER KEYVEC(2)
- CHARACTER*(*) CLINE
- IC1000 = 10000000
- IDVER1=IDVERS
- NCYCLE=-10
- CLINE=' '
- IFC=1
- ILC=1
-2 CALL RZIN(IXST,L,2,KEYVEC,IC1000,'DC')
- IF (IQUEST(1).NE.0 .OR. L .EQ. 0)GOTO 5
- NWGEN=IQ(KQS+L+11)
-* WRITE(*,*)' NWGEN',NWGEN
- IP0 = L+KQS+1
- CALL DZDGGI(IQ(IP0),'VE',' ',CLINE,IFC,ILC)
- IF(IDVER1.EQ.0)GOTO 5
- IF(IC1000.LT.1000000)THEN
- IF(IQUEST(6).NE.IC1000)THEN
- IDVDOC=0
-*** is this ok?
- GOTO 25
- ENDIF
- ENDIF
- IF(NCYCLE.LT.-1)NCYCLE=IQUEST(50)-1
-* only 1 cycle stored
- IF(NCYCLE.LT.0)THEN
- IF(IFC.EQ.0)THEN
- IFC=1
- ILC=1
- ENDIF
- GOTO 5
- ENDIF
-25 IF(IDVER1.NE.0)THEN
-* no version tag present
- IF(IFC.LE.0)THEN
- IDVDOC=0
- GOTO 4
- ENDIF
-* convert to integer,remove dots
- IPC=IFC-1
- DO 3 IC=IFC,ILC
-* is it a number?
- IF(INDEXN(CLINE(IC:IC)).NE.0)THEN
- IPC=IPC+1
- CLINE(IPC:IPC)=CLINE(IC:IC)
- ENDIF
-3 CONTINUE
- IF(IPC.GE.IFC)THEN
- CALL DZDCTI(CLINE(IFC:IPC),IDVDOC)
- ILC=IPC
- ELSE
- IDVDOC=0
- ENDIF
-4 IF(IDVDOC.EQ.IDVER1)THEN
- ICYCLE=IQUEST(6)
- GOTO 5
- ELSE
- NCYCLE=NCYCLE-1
- IF(NCYCLE.LT.0)THEN
- ICYCLE=-1
- IF(IDVER1.GT.IDVDOC)THEN
-* last cycle again
- IC1000=10000000
- IDVER1=0
- ELSE
- GOTO 5
- ENDIF
- ELSE
- IC1000=IQUEST(6)-1
- ENDIF
- IF(L.NE.0)CALL MZDROP(IXST,L,'L')
- L=0
- GOTO 2
- ENDIF
- ENDIF
-5 CONTINUE
- IF(IDVERS.EQ.0)ICYCLE=0
- END
-***********************************************************************
diff --git a/src/graflib/dzdoc/dzdraw/dzdgds.F b/src/graflib/dzdoc/dzdraw/dzdgds.F
deleted file mode 100644
index c45b859..0000000
--- a/src/graflib/dzdoc/dzdraw/dzdgds.F
+++ /dev/null
@@ -1,67 +0,0 @@
-*
-* $Id: dzdgds.F,v 1.1.1.1 1996/03/04 16:13:17 mclareni Exp $
-*
-* $Log: dzdgds.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:17 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDGDS(CHBANK,CHOPT,CLINE,NLT)
-
-*...DZDGDS returns the bank descriptor in CLINE
-
- CHARACTER*80 CLINE
-
- CHARACTER CHBANK*(*), CHOPT
-
-*------OTTO- KEY vector for RZIN/RZOUT
-
- INTEGER KEYVEC(2)
-
-#include "dzdoc/bkwrp.inc"
-#include "dzdoc/tapes.inc"
-* From DZEBRA
-#include "zebra/zbcdk.inc"
-#include "dzdoc/linout.inc"
-#include "dzdoc/docparq.inc"
-#include "dzdoc/bknuparq.inc"
-#include "zebra/bkfoparq.inc"
-#include "dzdoc/bkstparq.inc"
-#include "dzdoc/bktgparq.inc"
-#include "dzdoc/bktgdatq.inc"
-
-*-- One particular bank descriptor desired
-
- CLINE = ' '
- CALL UCTOH(CHBANK,KEYVEC(1),4,4)
-*-- Read information in CWD on RZ file
-
- NCHA = LEN(CHBANK)
- IF(NCHA .GE. 8)THEN
- CALL UCTOH(CHBANK(5:),KEYVEC(2),4,4)
- ELSE
- CALL UCTOH('NONE',KEYVEC(2),4,4)
- ENDIF
- I1000=100000
- CALL RZIN(0,LQBKD,2,KEYVEC,I1000,'D')
- IF (IQUEST(1).NE.0 .OR. LQBKD .EQ. 0)THEN
- NLT = 0
- GOTO 999
- ENDIF
- INSERT = 25
- CLINE = 'XX'
- NCHOLL = (IQ(KQSP+LQBKD+INSERT)/16 - 1)*4
- IF(NCHOLL .GT. 0)THEN
- IF(NCHOLL .GT. 80)NCHOLL = 80
- INSERT = 27
- CALL UHTOC(IQ(KQSP+LQBKD+INSERT),4,CLINE,NCHOLL)
- IILF=INDEX(CLINE,'$LF')
- IF(IILF.NE.0)CLINE(IILF:)=' '
- NLT = INDXBC(CLINE,' ')
-* WRITE(*,*)' NCHOLL,NLT,LQBKD ', NCHOLL,NLT,LQBKD
- ENDIF
- CALL MZDROP(0,LQBKD,' ')
- LQBKD=0
- 999 END
-***********************************************************************
diff --git a/src/graflib/dzdoc/dzdraw/dzdgdv.F b/src/graflib/dzdoc/dzdraw/dzdgdv.F
deleted file mode 100644
index 5490bbe..0000000
--- a/src/graflib/dzdoc/dzdraw/dzdgdv.F
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: dzdgdv.F,v 1.1.1.1 1996/03/04 16:13:07 mclareni Exp $
-*
-* $Log: dzdgdv.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:07 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDGDV(CHOPT,IDVERS)
- CHARACTER*(*) CHOPT
- IVPOS=INDEX(CHOPT,'V')
- IF(IVPOS.NE.0)THEN
- IVPOS=IVPOS+1
- IFNUM=INDEXN(CHOPT(IVPOS:))
- IF(IFNUM.NE.1)THEN
- IDVERS=0
- ELSE
- ILNUM=INDXNC(CHOPT(IVPOS:))
- IF(ILNUM.NE.0)THEN
- ILNUM=ILNUM+IVPOS-1
- ELSE
- ILNUM=LEN(CHOPT)
- ENDIF
- CALL DZDCTI(CHOPT(IVPOS:ILNUM),IDVERS)
- ENDIF
- ELSE
- IDVERS=0
- ENDIF
- RETURN
- END
-
diff --git a/src/graflib/dzdoc/dzdraw/dzdgen.F b/src/graflib/dzdoc/dzdraw/dzdgen.F
deleted file mode 100644
index d885be0..0000000
--- a/src/graflib/dzdoc/dzdraw/dzdgen.F
+++ /dev/null
@@ -1,276 +0,0 @@
-*
-* $Id: dzdgen.F,v 1.1.1.1 1996/03/04 16:13:18 mclareni Exp $
-*
-* $Log: dzdgen.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:18 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDGEN
-************************************************************************
-*. *
-*...DZDGEN outputs the general information for a given bank identifier *
-*. *
-*. DZDGEN is a daughter routine of DZDOCO *
-*. It handles the first part (general information) for a given bank *
-*. by printing (SGML, Line Printer output) or creating the link *
-*. descriptor bank QBLK. *
-*. *
-*. BANKS L : QBLK *
-*. BANKS R : QBKD *
-*. CALLS : DZDLIN *
-*. CALLED : DZDOCO *
-*. COMMON : DZDOCC,DZDTAP,MZCN,MZLIFT *
-*. *
-*. AUTHOR : M. Goossens DD/US *
-*. VERSION : 2.03(36) / 27 Sep 1987 *
-*. *
-*. UPDATE : 21 Mar 1988 *
-*. BY : O.Schaile *
-*. Use link in link area (LBQBKD, LQBKD) for all references *
-*. Suppress printing at various places if B-option given *
-*.**********************************************************************
-C SAVE
-
-#include "dzdoc/bkwrp.inc"
-#include "dzdoc/tapes.inc"
-* From DZEBRA
-#include "zebra/zbcdk.inc"
-#include "dzdoc/linout.inc"
-*-- Link description bank MZLIFT vector
-*-- OTTO MBKBKD => 7 dim
- INTEGER MBKBKD(7)
-#include "dzdoc/dzdocobk.inc"
-*-- Text and order for general information
- PARAMETER (NNGENQ=14)
- CHARACTER COGEN(NNGENQ)*10,CIGEN(NNGENQ)*2
- INTEGER IIGEN(NNGENQ),IOBGEN(NNGENQ)
-*-- Additional offset for *REP card on output
- PARAMETER (IREPQ=4)
-#include "dzdoc/docparq.inc"
-#include "dzdoc/bknuparq.inc"
-#include "zebra/bkfoparq.inc"
-#include "dzdoc/bkstparq.inc"
-#include "dzdoc/bktgparq.inc"
-#include "dzdoc/bktgdatq.inc"
-
-*-- Order and text for the various general information items
- DATA IIGEN /0,ITGNIQ,ITGAUQ,ITGVEQ,ITGSTQ,ITGDVQ,ITGNLQ,
- + ITGNSQ,ITGNDQ,ITGNXQ,ITGUPQ,ITGORQ,ITGIOQ,ITGNZQ/
- DATA COGEN /' Bank IDH',' NumericId',' Author',' Version',
- + ' Store',' Division',
- + ' NL',' NS',' ND',' Next',' Up',' Origin',
- + ' IO-Charac',' NZERO' /
- DATA CIGEN /'.','NI','AU','VE','ST','DV',
- + 'NL','NS','ND','NX','UP','OR',
- + 'IO','NZ'/
-
- DATA IOBGEN / MOIDHQ,0,0,0,0,0,MONLQ,
- + MONSQ,MONDQ,MONXQ,MOUPQ,MOORQ,
- + 0,0/
-
- DATA MBKBKD/0,0,0,50,0,0,0/ , IFIRST/0/
-
- 10 CONTINUE
-* ITAG = 0
- IF (IFIRST.EQ.0) THEN
-*-- Initialization of the name constants
-*-- Get the bank NAME vector for the documenation banks
-*-- complete by describing its structure as counters at the
-*-- bank beginning and then self-describing sectors.
- CALL UCTOH ('QBLK',MBKBKD,4,4)
- CALL MZIOBK(MBKBKD,5,'6I -H')
- IFIRST = 1
- ENDIF
-
- IF (IFLOPT(MPOSBQ).NE.0) THEN
- IQUEST(MOQUEQ) = 0
- CALL MZLIFT(0,LBQBKD,LBQBKD,1,MBKBKD,0)
-* CALL UZERO(IQ,KQSP+LBQBKD+1,KQSP+LBQBKD+MBKBKD(4))
- DO 20 I=KQSP+LBQBKD,KQSP+LBQBKD+MBKBKD(4)-1
- 20 IQ(I+1)=0
- ENDIF
-
-*-- Loop over the front part of the bank to get the general info
-
- DO 50 IGEN = 1,NNGENQ
- II = NBHEAQ + 1
-*-- Look through the general info to see whether something exists
- 30 IF (II-NBHEAQ.GT.IQ(KQSP+LQBKD+MBGENQ)) GO TO 50
-*-- Integer self-describing sector?
- IF (MOD(IQ(KQSP+LQBKD+II),JFOSEQ).NE.IFOINQ)THEN
-*-- Not an integer self-describing sector --> skip
- II = II + IQ(KQSP+LQBKD+II)/JFOSEQ + 1
- IF (II-NBHEAQ.GT.IQ(KQSP+LQBKD+MBGENQ)) THEN
- GO TO 50
- ELSE
- GO TO 30
- ENDIF
- ENDIF
-*-- Integer self-describing sector: look at info id.
- INTAG = IBITS(IQ(KQSP+LQBKD+II+1),ICHIDQ,NCHIDQ)
- IF (INTAG.NE.IIGEN(IGEN)) THEN
-*-- Not yet the id. needed --> continue
- II = II + IQ(KQSP+LQBKD+II)/JFOSEQ + 1
- IF (II-NBHEAQ.GT.IQ(KQSP+LQBKD+MBGENQ)) THEN
- GO TO 50
- ELSE
- GO TO 30
- ENDIF
- ENDIF
-*---------- End of loop to locate general information tag (to label 10)
-*-- Tag found --> output information
- ITAG = IOTAGQ
- IF (IFLOPT(MPOSBQ).NE.0) THEN
-C- Skip information if not needed
- IF (IOBGEN(IGEN).EQ.0) GO TO 50
- ELSE
- IF (IFLOPT(MPOSIQ).NE.0) THEN
- COUT = '*B.'//CIGEN(IGEN)
- IF(IGEN.EQ.1)ITAG=5
- ELSE
- COUT = COGEN(IGEN)
- ENDIF
- ENDIF
-*-- Read information
- INSERT = II
- IF (INTAG.GT.0) THEN
- ITGTYP = IBKTAC(MBKAGQ,INTAG)
- ELSE
-*-- Protection for identifier info (INTAG = 0)
- ITGTYP = ITGUPQ
- ENDIF
- IPATAG = IBITS(IQ(KQSP+LQBKD+INSERT+MBPATQ),ICHTGQ,NCHTGQ)
- ICHOIC = IBITS(IQ(KQSP+LQBKD+INSERT+MBPATQ),ICHBTQ,1)
- NWTAG = 0
- IF (ITGTYP.EQ.IBKAMQ) THEN
-*-- Number possible
- IF (IPATAG.EQ.0) THEN
-*-- Explicit number
- INUM1 = IQ(KQSP+LQBKD+INSERT+MBIX1Q)
- IF (INUM1.GE.0) THEN
-*-- Given as real number
- WRITE(COUT(ITAG:),'(I8)') INUM1
- ELSEIF (INUM1.EQ.INUINQ) THEN
-*-- Indefinite (variable) number
- COUT(ITAG:) = 'variable'
- ELSEIF (INUM1.LE.-JFOSEQ) THEN
-*-- Numbers given as Hollerith text
- NWTAG = -INUM1/JFOSEQ
- ENDIF
- ELSE
-*-- Character tag
- NWTAG = IQ(KQSP+LQBKD+INSERT+MBIX1Q)
- INUM1 = -1
- ENDIF
-*-- In case of link description bank
- IF (IFLOPT(MPOSBQ).NE.0) THEN
-
-*-- OTTO 19-MAR-88 if NL,NS,ND is given as name, mark it variable
-
- IF (IIGEN(IGEN) .EQ. ITGNLQ
- + .OR. IIGEN(IGEN) .EQ. ITGNSQ
- + .OR. IIGEN(IGEN) .EQ. ITGNDQ) THEN
- IQ(KQSP+LBQBKD+IOBGEN(IGEN)) = INUM1
- GOTO 50
- ENDIF
- ENDIF
- ELSEIF (ITGTYP.EQ.IBKANQ) THEN
-*-- Only text
- CONTINUE
- ELSE
-*-- Indicate length of tag
- NWTAG = IPATAG
- ENDIF
-*-- Skip I self-describing sector
- INSERT = INSERT + NBDSCQ
-*-- If not Hollerith self-describing sector -- SKIP
- IF (MOD(IQ(KQSP+LQBKD+INSERT),JFOSEQ).NE.IFOHOQ) THEN
- IF (NWTAG.GT.0) THEN
-*-- Inconsistency: Tag announced and non present
- WRITE(LUNOUT,'(''0?? DZDGEN: Inconsistency: '',
- + ''Tag information announced and non present'')')
- WRITE(LUNUSR,'(''0?? DZDGEN: Inconsistency: '',
- + ''Tag information announced and non present'')')
- GO TO 999
- ENDIF
- IF (INUM1.NE.0) THEN
-*-- If something present
- IF (IFLOPT(MPOSBQ).NE.0) THEN
- IQ(KQSP+LBQBKD+IOBGEN(IGEN)) = INUM1
- GO TO 50
- ELSE
- IF (IFLOPT(MPOSIQ).NE.0)COUT(1:3)='*B.'
- WRITE(LUNUSR,'(A)') COUT
- ENDIF
- ENDIF
- GO TO 50
- ENDIF
-*-- Total number of Hollerith words <==========================
- 40 NWHOLL = IQ(KQSP+LQBKD+INSERT)/JFOSEQ
-*
- INSERT = INSERT + 1
-*-- When there is tag info
- IF (NWTAG.GT.0) THEN
-*-- In case of link description bank --> Copy and continue
- IF (IFLOPT(MPOSBQ).NE.0) THEN
-
-*-- OTTO 19-MAR-88 if NL,NS,ND is given as name, mark it variable
-
- IF (MOD(IQ(KQSP+LQBKD+INSERT-1),JFOSEQ).EQ.IFOHOQ
- + .AND.
- + (IIGEN(IGEN) .EQ. ITGNLQ
- + .OR. IIGEN(IGEN) .EQ. ITGNSQ
- + .OR. IIGEN(IGEN) .EQ. ITGNDQ) ) THEN
- IQ(KQSP+LBQBKD+IOBGEN(IGEN)) = -1
- ELSE
- IQ(KQSP+LBQBKD+IOBGEN(IGEN)) =
- + IQ(KQSP+LQBKD+INSERT)
- ENDIF
- GO TO 50
- ENDIF
-*-- Hollerith word count
- CALL UHTOC(IQ(KQSP+LQBKD+INSERT),4,COUT(ITAG:),NWTAG*4)
- INSERT = INSERT + NWTAG
- NWHOLL = NWHOLL - NWTAG
- ENDIF
-*-- Is there some text left
- IF(IFLOPT(MPOSBQ) .EQ. 0)THEN
- IF (NWHOLL.GT.0) THEN
-*-- Copy text
- IF (IFLOPT(MPOSIQ).NE.0
- & .AND. LENOCC(COUT).LT.IOTAGQ) THEN
- INLINE = IOTAGQ
- ELSE
- INLINE = IOENTQ
- ENDIF
- IEWORK = 0
- NOUTF = NOUTQ - INLINE + 1
-*-- As long as there is text
- CALL DZDLIN
- ELSE
-*-- No text to write --> output line as it is
- IF (IFLOPT(MPOSIQ).NE.0)COUT(1:3)='*B.'
- WRITE(LUNUSR,'(A)') COUT
-*-------------- End of field for Hollerith text
- ENDIF
- ENDIF
-*--------------- Multiple choice present ?
- IF (ICHOIC.NE.0) THEN
-*-- Still more text to read?
- IF (MOD(IQ(KQSP+LQBKD+INSERT),JFOSEQ).EQ.IFOHOQ) THEN
-*-- Indent for each new repetition level
- COUT = ' '
- ITAG = IOTAGQ
-*-- ============== Alternative choice for entry ==============
- GO TO 40
-*-- >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
- ENDIF
- ENDIF
-*---------- End of loop over general information tags to be printed (100)
- 50 CONTINUE
-
-*-- Close the description level if needed
-
- 999 END
diff --git a/src/graflib/dzdoc/dzdraw/dzdget.F b/src/graflib/dzdoc/dzdraw/dzdget.F
deleted file mode 100644
index d232c80..0000000
--- a/src/graflib/dzdoc/dzdraw/dzdget.F
+++ /dev/null
@@ -1,75 +0,0 @@
-*
-* $Id: dzdget.F,v 1.1.1.1 1996/03/04 16:13:08 mclareni Exp $
-*
-* $Log: dzdget.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:08 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDGET(IXSTOR,LTOP, ILKACT
- + ,CHOPT,IWDISP, ILOCNR, LSEL, IFLCUR, PX, PY)
-*.
-*...DZDGET get locator input from workstation IWDISP
-*.
-*. INPUT : IXSTOR Store index
-*. LTOP Link to top bank to be displayed
-*. ILKACT the link where drawing of down banks starts
-*. CHOPT Character option (not yet used)
-*. IWDISP workstation Id for display (screen)
-*. ILOCNR locator number for cursor input
-*. OUTPUT : LSEL link to a selected bank
-*. IFLCUR flag indicating where locator points to:
-*. -1 : break was hit (right mouse button)
-*. 0 : not inside a bank
-*. 1 : in the (shaded bank center
-*. 2 : in the link field
-*. 3 : in the data box
-*. 4 : in the next link arrow
-*. 5 : in a square above the bank center
-*. 6 : above the data box
-*. PX,PY coordinates of the locator
-*. COMMON :
-*. SEQUENCE : DZDPRM
-*. CALLS : DZDRA1 GINLC GQCNTN GQNT GQWKT GRQLC GSELNT
-*. CALLED : DZDISP, USER
-*.
-*. AUTHOR : O.Schaile
-*. VERSION : 1.00
-*. CREATED : 11-Dec-87
-*.**********************************************************************
-*.
- CHARACTER*(*) CHOPT
-#include "dzdprm.inc"
- LOGICAL DZDINB
- LOGICAL REQINP
- EXTERNAL DZDINB
- SAVE PXR,PYR
- INTEGER IPET
- DATA IPET/1/
- DATA PXR,PYR/0.,0./
-*----
- LSEL = 0
- NT = 1
- CALL ISELNT(NT)
- IF(PX .LT. 0.001)THEN
- PX = XRANGE/2.
- PY = YRANGE/2.
- ENDIF
- CALL IRQLC(IWDISP,ILOCNR,ISTAT,NTU,PX,PY)
- IF(ISTAT.EQ.0)THEN
- IFLCUR=-1
- GOTO 10
- ENDIF
- PXR = PX
- PYR = PY
- REQINP = .TRUE.
- LSAVE = LTOP
- CALL DZDRA1(IXSTOR,LTOP,ILKACT
- + ,CHOPT, PX, PY, REQINP,IFLCUR,YTOP,YBOTTM)
- LSEL = LTOP
- LTOP = LSAVE
- 10 CONTINUE
- RETURN
- END
-***********************************************************************
diff --git a/src/graflib/dzdoc/dzdraw/dzdgfl.F b/src/graflib/dzdoc/dzdraw/dzdgfl.F
deleted file mode 100644
index fce7148..0000000
--- a/src/graflib/dzdoc/dzdraw/dzdgfl.F
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: dzdgfl.F,v 1.1.1.1 1996/03/04 16:13:09 mclareni Exp $
-*
-* $Log: dzdgfl.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:09 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDGFL(CLINE,IST,IEND)
- CHARACTER*(*) CLINE
- IST=0
- IEND=0
-* point after (
- IFC=INDEX(CLINE(1:),'(')
- IF(IFC.LE.0)GOTO 999
- IFC=IFC+1
- ILC=INDEX(CLINE(IFC:),':')
- IF(ILC.LE.0)GOTO 999
- ILC=ILC+IFC-2
- CALL DZDCTI(CLINE(IFC:ILC),IST)
- IF(IST.LE.0)GOTO 999
-* point after :
- IFC=ILC+2
- ILC=INDXNC(CLINE(IFC:))
- IF(ILC.LE.0)THEN
- ILC=LNBLNK(CLINE)
- ELSE
- ILC=ILC+IFC-2
- ENDIF
- CALL DZDCTI(CLINE(IFC:ILC),IEND)
-999 CONTINUE
- END
-************************************************************************
diff --git a/src/graflib/dzdoc/dzdraw/dzdgiv.F b/src/graflib/dzdoc/dzdraw/dzdgiv.F
deleted file mode 100644
index 8895585..0000000
--- a/src/graflib/dzdoc/dzdraw/dzdgiv.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: dzdgiv.F,v 1.1.1.1 1996/03/04 16:13:18 mclareni Exp $
-*
-* $Log: dzdgiv.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:18 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDGIV(CV,IV,NCV)
- CHARACTER*(*) CV
-* try to read an INTEGER from CV
- CHARACTER*4 CHFORM
- IV=0
- NCV=0
-* first non blank
- IFNB=INDEXC(CV,' ')
- ILC=LENOCC(CV)
-* last numeric
- NCV=INDXNC(CV(IFNB:))+IFNB-2
- IF(NCV.LE.0)NCV=ILC+IFNB-1
- IF(NCV.LT.IFNB)GOTO 999
- WRITE(CHFORM,'(A,I1,A)') '(I',NCV-IFNB+1,')'
- READ(CV(IFNB:NCV),CHFORM,ERR=999)IV
-999 END
-***********************************************************************
diff --git a/src/graflib/dzdoc/dzdraw/dzdgky.F b/src/graflib/dzdoc/dzdraw/dzdgky.F
deleted file mode 100644
index 4594441..0000000
--- a/src/graflib/dzdoc/dzdraw/dzdgky.F
+++ /dev/null
@@ -1,89 +0,0 @@
-*
-* $Id: dzdgky.F,v 1.1.1.1 1996/03/04 16:13:04 mclareni Exp $
-*
-* $Log: dzdgky.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:04 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDGKY
-* IMPLICIT NONE
- INTEGER IQUEST(100)
- COMMON/QUEST/IQUEST
-#include "dzdzbrinc.inc"
- INTEGER NCH, KNUMB, ISTORE, IIST, IFC, IC, NPAR, NWKEY, I
- CHARACTER*80 CHPATH
- CHARACTER*80 CHSAVE
- CHARACTER*10 CKNUMB, CMD, CHFORM
- CHARACTER*8 CHTAG(10)
-*--
- CALL KUPATL(CMD,NPAR)
-
- CALL KUGETC(CHPATH,NCH)
- IF(NCH.LE.0)GOTO 999
- IF(CMD.NE.'SH_KEY_DEF' .AND. CMD.NE.'SH_RZLDIR')THEN
- CALL KUGETC(CKNUMB,NCH)
- IF(NCH.LE.0)GOTO 999
- CALL DZDCTI(CKNUMB,KNUMB)
- IF(KNUMB.LE.0)GOTO 999
- ENDIF
- ISTORE=0
- IIST = 1
- CALL SBYT(ISTORE,IIST,27,6)
-* init link area for store 0
-
- IF(LZEFLG(ISTORE).EQ.0)THEN
- CALL MZLINK(IIST,'DZDZEB',
- & LZEBLK(1,ISTORE),LZEBLK(3,ISTORE),LZEBLK(3,ISTORE))
- LZEFLG(ISTORE)=1
- ENDIF
- IF(LZEBLK(1,ISTORE).NE.0)CALL MZDROP(IIST,LZEBLK(1,ISTORE),' ')
- LZEBLK(1,ISTORE)=0
- IFC=INDEX(CHPATH,'R_')
- IF(IFC.LE.0)GOTO 999
- CALL RZCDIR(CHSAVE,'R')
- IC=1000000
- CALL RZCDIR('//'//CHPATH(IFC+2:),' ')
- IF(CMD.EQ.'SH_RZLDIR')THEN
- IF(IAPPFL.NE.0)THEN
- CALL RZLDIR(' ','A')
- ELSE
- CALL RZLDIR(' ',' ')
- ENDIF
- ELSE IF(CMD.EQ.'GET_KEY')THEN
- CALL RZIN(IIST,LZEBLK(1,ISTORE),1,KNUMB,IC,'S')
- IF(IQUEST(1).NE.0)THEN
- WRITE(*,*)'Error from RZIN',IQUEST(1)
- ELSE
- WRITE(*,*)
- & 'RZIN, words read: ',IQUEST(12), ' into Store 0, Div 1'
- CALL IZPICT('DZDISP','SQ')
- CALL IZPICT('DZDISP','M')
- CALL ISTXFP(6,0)
- CALL DZDISP(IIST,LZEBLK(1,ISTORE),CTDDOC,'D'//CCOL//CCACT,
- & IWKZEB,IWMZEB,ILOZEB, 0)
- ENDIF
- ELSE
- CALL RZKEYD(NWKEY,CHFORM,CHTAG)
- WRITE(*,*)'Total keywords:', NWKEY
- NWKEY=MIN(NWKEY,9)
- IF(CMD.EQ.'SH_KEY_DEF')THEN
- WRITE(*,*)' Nr Form Tag'
- DO 10 I=1,NWKEY
-10 WRITE(*,'(I4,A,A,A,A)')I,' ',CHFORM(I:I),' ',CHTAG(I)
- ELSE
- CALL RZIN(0,LL,0,KNUMB,0,'CS')
- WRITE(*,*)' Nr Tag Value'
- DO 20 I=1,NWKEY
- IF(CHFORM(I:I).EQ.'H' .OR. CHFORM(I:I).EQ.'A')THEN
- WRITE(*,'(I3,A,A,A,A)')I,' ',CHTAG(I),' ',IQUEST(20+I)
- ELSE
- WRITE(*,'(I3,A,A,A,I11)')I,' ',CHTAG(I),' ',IQUEST(20+I)
- ENDIF
-20 CONTINUE
- ENDIF
- ENDIF
- CALL RZCDIR(CHSAVE,' ')
- 999 END
-***********************************************************************
diff --git a/src/graflib/dzdoc/dzdraw/dzdglk.F b/src/graflib/dzdoc/dzdraw/dzdglk.F
deleted file mode 100644
index b7a1961..0000000
--- a/src/graflib/dzdoc/dzdraw/dzdglk.F
+++ /dev/null
@@ -1,47 +0,0 @@
-*
-* $Id: dzdglk.F,v 1.1.1.1 1996/03/04 16:13:09 mclareni Exp $
-*
-* $Log: dzdglk.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:09 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- INTEGER FUNCTION DZDGLK(LB,IB,L,JB)
-#include "dzdprm.inc"
- INTEGER LB(*),IB(*),L,JB,LL,I,MAXP,IC
- SAVE MAXP
- CHARACTER*4 CHID
- DATA MAXP/3/
- LL=LB(L-JB)
-* check only ref links
- IF(JB.LE.IB(L-2))GOTO 900
- IF(IDREFL.EQ.0)GOTO 889
- IF(LL.NE.0)THEN
- IF( IB(LL-1).LT.0 .OR. IB(LL-1).GT.65000
- + .OR.IB(LL-2).LT.0 .OR. IB(LL-2).GT.65000
- + .OR.IB(LL-3).LT.0 .OR. IB(LL-3).GT.65000)THEN
- GOTO 888
- ENDIF
- CALL UHTOC(IB(LL-4),4,CHID,4)
- DO 10 I=1,4
- IC=ICHAR(CHID(I:I))
- IF(IC.GE.ICHAR('A').AND.IC.LE.ICHAR('Z'))GOTO 10
- IF(IC.GE.ICHAR('a').AND.IC.LE.ICHAR('z'))GOTO 10
- IF(IC.GE.ICHAR('0').AND.IC.LE.ICHAR('9'))GOTO 10
- GOTO 888
- 10 CONTINUE
- ENDIF
- GOTO 900
- 888 CONTINUE
- IF(MAXP.GE.0)THEN
- WRITE(*,'(A,I6,A,I6)')
- + ' Link ',LL, ' seems not to point to a bank, Jbias: ',JB
- IF(MAXP.EQ.0)WRITE(*,'(A)')' Will stop printing this message'
- MAXP=MAXP-1
- ENDIF
- 889 LL=0
- 900 DZDGLK=LL
- RETURN
- END
-******************************************************************
diff --git a/src/graflib/dzdoc/dzdraw/dzdgnz.F b/src/graflib/dzdoc/dzdraw/dzdgnz.F
deleted file mode 100644
index 270bd7b..0000000
--- a/src/graflib/dzdoc/dzdraw/dzdgnz.F
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: dzdgnz.F,v 1.1.1.1 1996/03/04 16:13:09 mclareni Exp $
-*
-* $Log: dzdgnz.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:09 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDGNZ(LB,IB,LD,JB1,NLDON1,NBLEV, NULEV, NBLEVD)
- INTEGER LB(999),IB(999),LD,NLDON1,NBLEV, NULEV, NBLEVD, K
-* get # of live down banks and highest live bank (2 levels)
- NBLEV=0
- NULEV=0
- NLDON1=0
- NBLEVD=0
- IF(IB(LD-3).GT.0 .AND. JB1.LE.IB(LD-3))THEN
- DO 30 K=JB1,IB(LD-3)
- LDD = LB(LD-K)
- IF(LDD .NE. 0)THEN
- IF(K.EQ.1)NLDON1 = 1
- NBLEV = NBLEV + 1
- NULEV=K
-* next level
- IF(IB(LDD-3).GT.0)THEN
- DO 25 J=1,IB(LDD-3)
-25 IF(LB(LDD-J).NE.0)NBLEVD=NBLEVD+1
- ENDIF
- ENDIF
- 30 CONTINUE
- ENDIF
- END
-******************************************************************
diff --git a/src/graflib/dzdoc/dzdraw/dzdgpl.F b/src/graflib/dzdoc/dzdraw/dzdgpl.F
deleted file mode 100644
index 7962334..0000000
--- a/src/graflib/dzdoc/dzdraw/dzdgpl.F
+++ /dev/null
@@ -1,99 +0,0 @@
-*
-* $Id: dzdgpl.F,v 1.1.1.1 1996/03/04 16:13:13 mclareni Exp $
-*
-* $Log: dzdgpl.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:13 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDGPL(N,X,Y)
- REAL X(9),Y(9)
-#include "dzdprm.inc"
-#if defined(CERNLIB_BSLASH)
-#include "dzdoc/bslash2.inc"
-#endif
-#if !defined(CERNLIB_BSLASH)
-#include "dzdoc/bslash1.inc"
-#endif
- CHARACTER*24 CCINT
- N1=IABS(N)
- IF(IFOMED.EQ.3)THEN
- DO 10 I=1,N1-1
- DX=X(I+1)-X(I)
- DY=Y(I+1)-Y(I)
- DL = ABS(DX)*PAGECM
- IF(ABS(DX).LT.0.001)THEN
- IX=0
- IF(DY.GE.0.)THEN
- IY=1
- ELSE
- IY=-1
- ENDIF
- DL=ABS(DY)*PAGECM
- ELSEIF(ABS(DY).LT.0.001)THEN
- IY=0
- IF(DX.GE.0.)THEN
- IX=1
- ELSE
- IX=-1
- ENDIF
- ELSE
- IF(ABS(DX).GT.ABS(DY))THEN
- ISL=(ABS(DX)+0.01)/ABS(DY)
- IF(ISL.GT.6)ISL=6
- IF(DX.GE.0.)THEN
- IX=ISL
- ELSE
- IX=-ISL
- ENDIF
- IF(DY.GE.0.)THEN
- IY=1
- ELSE
- IY=-1
- ENDIF
- ELSE
- ISL=(ABS(DY)+0.01)/ABS(DX)
- IF(ISL.GT.6)ISL=6
- IF(DX.GE.0.)THEN
- IX=1
- ELSE
- IX=-1
- ENDIF
- IF(DY.GE.0.)THEN
- IY=ISL
- ELSE
- IY=-ISL
- ENDIF
- ENDIF
- ENDIF
- IF(I.EQ.N1-1 .AND.N.LT.0)THEN
- WRITE(LUNGRA,'(A,2(F5.2,A),2(I2,A),F5.2,A)')
- & BS//'p(', X(I)*PAGECM, ',', Y(I)*PAGECM,' ){'//BS//'v(',
- & IX,',',IY,'){',DL,'}}'
- ELSE
- WRITE(LUNGRA,'(A,2(F5.2,A),2(I2,A),F5.2,A)')
- & BS//'p(',X(I)*PAGECM,',',Y(I)*PAGECM,'){'//BS//'l(',
- & IX,',',IY,'){',DL,'}}'
- ENDIF
-10 CONTINUE
- GOTO 999
-* PostScript
- ELSEIF(IFOMED.EQ.2)THEN
- IF(PAMM10.LE.0.001)PAMM10=70.
- DO 20 I=1,N1
- IX=X(I)*PAMM10
- IY=Y(I)*PAMM10
- IF(I.EQ.1)THEN
- WRITE(CCINT,'(2I9,A)')IX,IY,' m'
- ELSE
- WRITE(CCINT,'(2I9,A)')IX,IY,' d'
- ENDIF
- CALL DZDPLN(LUNGRA,CCINT,-1)
-20 CONTINUE
- CALL DZDPLN(LUNGRA,' s',-1)
- ENDIF
- CALL IPL(N1,X,Y)
-999 END
-
-************************************************************************
diff --git a/src/graflib/dzdoc/dzdraw/dzdgr1.F b/src/graflib/dzdoc/dzdraw/dzdgr1.F
deleted file mode 100644
index 378e8ee..0000000
--- a/src/graflib/dzdoc/dzdraw/dzdgr1.F
+++ /dev/null
@@ -1,75 +0,0 @@
-*
-* $Id: dzdgr1.F,v 1.1.1.1 1996/03/04 16:13:18 mclareni Exp $
-*
-* $Log: dzdgr1.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:18 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDGR1(CL,IVAL,IREPC,NEXTRA,IVR,MV,NV)
- CHARACTER*(*) CL
- INTEGER IVAL,IREPC,NEXTRA,IVR(2),MV,NV, IFILIT
- IREPC=IVAL
- NC=LENOCC(CL)
- IP = 0
- 10 IP=IP+1
-* need at least 2 characters
- IF(IP.GE.NC)GOTO 999
-* operator expected: + - * /
-
- IF(CL(IP:IP).EQ.' ')GOTO 10
- IF(CL(IP:IP).EQ.'!')GOTO 999
- CALL DZDGIV(CL(IP+1:80),IV,NCV)
- IF(IV.LE.0)GOTO 999
- NEXTRA=0
- IFILIT=0
- IF(MV.GT.0 .AND. NV.LT.MV)THEN
- NV=NV+1
- IFILIT=1
- IVR(NV)=IV
- ENDIF
- IF (CL(IP:IP).EQ.'+')THEN
- IFLEXT=0
- IREPC=IREPC+IV
- IF(IFILIT.NE.0)IFILIT=1
- ELSEIF(CL(IP:IP).EQ.'-')THEN
- IREPC=IREPC-IV
- IFLEXT=0
- IF(IFILIT.NE.0)IFILIT=2
- ELSEIF(CL(IP:IP).EQ.'*')THEN
- IREPC=IREPC*IV
- IFLEXT=0
- IF(IFILIT.NE.0)IFILIT=3
- ELSEIF(CL(IP:IP).EQ.'/')THEN
- IREPCS=IREPC
- IREPC=IREPC/IV
- IF(IFILIT.NE.0)IFILIT=4
-* IREPC=FLOAT(IREPC)/FLOAT(IV)+0.5
-* is rep count integer?
- IF(IFLEXT.EQ.1)THEN
- NREST=IREPCS-IREPC*IV
- IF(IREPC.GT.0)THEN
- NEXTRA=NREST/IREPC
- IF(NEXTRA.NE.0)THEN
- IF(NEXTRA*IREPC.NE.NREST)THEN
- NEXTRA=-1000000
- IREPC=-1
- ELSE
- IF(NEXTRA.LT.0)THEN
- NEXTRA=-IREPCS/IREPC
- ENDIF
- ENDIF
- ENDIF
- ELSE
- IREPC=-1
- ENDIF
- ENDIF
- ELSE
- IREPC=-1
- GOTO 999
- ENDIF
- IF(IFILIT.NE.0)CALL SBYT(IFILIT,IVR(NV),25,8)
- IP=IP+NCV
- GOTO 10
- 999 END
diff --git a/src/graflib/dzdoc/dzdraw/dzdgrc.F b/src/graflib/dzdoc/dzdraw/dzdgrc.F
deleted file mode 100644
index 212aed6..0000000
--- a/src/graflib/dzdoc/dzdraw/dzdgrc.F
+++ /dev/null
@@ -1,48 +0,0 @@
-*
-* $Id: dzdgrc.F,v 1.1.1.1 1996/03/04 16:13:18 mclareni Exp $
-*
-* $Log: dzdgrc.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:18 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDGRC(IVDOC,IOFF,IVAL,IREPC,NEXTRA,IVR,MV,NV)
-
- INTEGER IVDOC(2),IVAL,IREPC,NEXTRA,IVR(2),MV,NV
- CHARACTER*80 CL
-
-* IVDOC contains next sector of bank doc
-* IOFF offset where expression might start (0, for *REP, 2 N:NREP
-* IVAL value of last documented word, possibly
-* containing the repetition count
-* IREPC returned value
-
- IF(MV.GT.0)NV=0
- IREPC = -1
- IFLEXT=1
- NEXTRA=0
-* is it holl section?
- IT = MOD(IVDOC(1),16)
- IF(IT.NE.5)GOTO 999
- NC = IVDOC(1)/16*4
- IF(NC.GT.80)GOTO 999
- CALL UHTOC(IVDOC(2+IOFF),4,CL,NC)
- IF(CL(1:4).NE.'BITS')GOTO 999
- READ(CL(5:6),'(I2)',ERR=999)IB1
- IF(IB1.GT.31)GOTO 999
- READ(CL(7:8),'(I2)',ERR=999)IB2
- IF(IB2.GT.31 .OR. IB2.LT.IB1)GOTO 999
- IREPC = JBYT(IVAL,IB1+1,IB2-IB1+1)
- IF(MV.GE.1)THEN
- NV=NV+1
- IVR(NV)=IB1
- CALL SBYT(IB2,IVR(NV),17,16)
- ENDIF
-* only single value given
- IF(NC.LE.8)GOTO 999
-* decode expression
- IVAL=IREPC
- CALL DZDGR1(CL(9:),IVAL,IREPC,NEXTRA,IVR,MV,NV)
- 999 END
-************************************************************************
diff --git a/src/graflib/dzdoc/dzdraw/dzdgrz.F b/src/graflib/dzdoc/dzdraw/dzdgrz.F
deleted file mode 100644
index 367232a..0000000
--- a/src/graflib/dzdoc/dzdraw/dzdgrz.F
+++ /dev/null
@@ -1,114 +0,0 @@
-*
-* $Id: dzdgrz.F,v 1.1.1.1 1996/03/04 16:13:16 mclareni Exp $
-*
-* $Log: dzdgrz.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:16 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDGRZ(IXSTOR,LTOP,MKEYS,LUN,CHOPTD)
- INTEGER IXSTOR,LTOP,MKEYS,LUN
- CHARACTER*(*) CHOPTD
-#include "zebra/zebq.inc"
-#include "zebra/mzca.inc"
-#include "zebra/mzcb.inc"
-#include "zebra/zunit.inc"
-#if defined(CERNLIB_BSLASH)
-#include "dzdoc/bslash2.inc"
-#endif
-#if !defined(CERNLIB_BSLASH)
-#include "dzdoc/bslash1.inc"
-#endif
- COMMON/DZDLK3/LNKLOC(3,0:15)
- COMMON/QUEST/IQUEST(100)
- PARAMETER (MSTACK = 100)
- INTEGER STACK(MSTACK), IP
- PARAMETER (MAXDIR=500)
- CHARACTER*16 CHDIR(MAXDIR)
- CHARACTER*80 CURDIR
-
-* bank formats:
-
-* for a directory:
-* IFLAG (=1), OFFSET-TO-NAME, NKEYS, NWKEY,NDIR,NQUOTA
-* KEYFORM((NWKEY+3)/4), KEYTAG (2*NWKEY), NAME
-
-* for a key
-* FLAG (=2), TSTAMP,CYCLE,NDATA,NWKEYS,KEYDEF((NWKEYS+3/4)),
-* KEYS(NWKEYS)
-#include "zebra/qstore.inc"
- IST = JQSTOR
- CALL MZLINT(IXSTOR,'/DSDLK3/',
- +LNKLOC(1,IST),LNKLOC(3,IST),LNKLOC(3,IST))
-* IS stackpointer
-* IP counts subdirectories
-
- ISTART = 0
- IS = 1
- STACK(IS) = 0
- CALL RZCDIR(CURDIR,'R')
-* WRITE(IQPRNT,*)' Start at ',CURDIR
-
- 10 CONTINUE
-
- CALL RZRDIR(MAXDIR,CHDIR,NDIRS)
- IF(NDIRS .GT. MAXDIR)THEN
- IF(IQPRNT.EQ.6)CALL IGTERM
- WRITE(IQPRNT,*)' NDIR > MAXDIR ',NDIRS,MAXDIR
- NDIRS = MAXDIR
- ENDIF
- IF(ISTART .EQ. 0)THEN
- CALL DZDBOK(IXSTOR,MKEYS,CHOPTD,LTOP,1,LNKLOC(3,IST))
- IF(INDEX(CHOPTD,'T').NE.0)THEN
- CALL RZCDIR(CURDIR,'R')
- WRITE(LUN,'(A)')CURDIR
- WRITE(LUN,'(A)')' *---'
- ENDIF
- ISTART = 1
- ENDIF
-
-* next subdirectory
-
- IP= STACK(IS) + 1
-
- IF(IP.GT.NDIRS)THEN
-* all done in this dir
- IF(IS.EQ.1)THEN
-* and back at top
-* WRITE(IQPRNT,*)'All done'
- GOTO 20
- ENDIF
-* step back
- IS = IS - 1
- CALL RZCDIR(BS,' ')
-#include "zebra/qstore.inc"
- LNKLOC(3,IST) = LQ(KQS+LNKLOC(3,IST)+1)
- GOTO 10
- ELSE
-* go down
- CALL RZCDIR(CHDIR(IP),' ')
-* WRITE(IQPRNT,*)'Enter dir: ',CHDIR(IP),' IS,IP ',IS,IP
-* CALL RZRDIR(MAXDIR,CHDIR,NDIRS)
-* remember old position
- STACK(IS) = IP
-* move stack pointer
- IS = IS+1
- IF(IS.GE.MSTACK)THEN
- IF(IQPRNT.EQ.6)CALL IGTERM
- WRITE(IQPRNT,*)'Stack overflow ',IS
- GOTO 20
- ENDIF
- STACK(IS) = 0
- CALL DZDBOK(IXSTOR,MKEYS,CHOPTD,
- & LNKLOC(3,IST),-IP,LNKLOC(3,IST))
- IF(INDEX(CHOPTD,'T').NE.0)THEN
- CALL RZCDIR(CURDIR,'R')
- WRITE(LUN,'(A)')CURDIR
- WRITE(LUN,'(A)')' *---'
- ENDIF
- GOTO 10
- ENDIF
- 20 CONTINUE
- LNKLOC(1,IST) = 0
- END
diff --git a/src/graflib/dzdoc/dzdraw/dzdgst.F b/src/graflib/dzdoc/dzdraw/dzdgst.F
deleted file mode 100644
index a5279fa..0000000
--- a/src/graflib/dzdoc/dzdraw/dzdgst.F
+++ /dev/null
@@ -1,44 +0,0 @@
-*
-* $Id: dzdgst.F,v 1.1.1.1 1996/03/04 16:13:08 mclareni Exp $
-*
-* $Log: dzdgst.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:08 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDGST(CTEMP,X,Y,CS,NC,IWDISP)
-*.
-*...DZDGST Get a character string from keyboard
-*.
-*. INPUT : CTEMP Initial string
-*. X, Y Coordinates for initial string
-*. CS character size
-*. IWDISP workstation Id
-*. OUTPUT : CTEMP the typed string
-*. NC number of characters returned
-*.
-*. CALLS : DZDTXT GINST GQCNTN GQNT GQWKT GRQST GSTXCI
-*. CALLED : DZDISP
-*.
-*. AUTHOR : O.Schaile
-*. VERSION : 1.00
-*. CREATED : 11-Dec-87
-*.*********************************************************************
-*.
- CHARACTER*(*) CTEMP
- SAVE INIFLG
- DATA INIFLG/0/
-*---
- IFC = INDEXC(CTEMP,' ')
- IF(IFC .LE. 0)IFC = 1
- NC = LEN(CTEMP) - IFC + 1
- CALL ISTXCI(0)
- CALL DZDTXT(CTEMP(IFC:),NC,X,Y,CS,0.,2)
- CALL ISTXCI(1)
- CTEMP = ' '
- IDEV = 1
- CALL IRQST(IWDISP,IDEV,ISTAT,NCC,CTEMP)
- NC = INDXBC(CTEMP,' ')
- CALL DZDTXT(CTEMP(1:NC),NC,X,Y,CS,0.,2)
- END
diff --git a/src/graflib/dzdoc/dzdraw/dzdgtr.F b/src/graflib/dzdoc/dzdraw/dzdgtr.F
deleted file mode 100644
index 3897bb8..0000000
--- a/src/graflib/dzdoc/dzdraw/dzdgtr.F
+++ /dev/null
@@ -1,253 +0,0 @@
-*
-* $Id: dzdgtr.F,v 1.1.1.1 1996/03/04 16:13:19 mclareni Exp $
-*
-* $Log: dzdgtr.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:19 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDGTR(CHKEY,CHOPT,LTOPD)
- CHARACTER*8 CHKEY
- CHARACTER*(*) CHOPT
-* CHOPT:
- INTEGER KEY(2),KEYI(2),KEYIN(2)
-#include "dzdoc/bkwrp.inc"
-*----- End of Seq
- CHARACTER*12 CTEMP
-*----
- CALL UCTOH('NONE',IDNONE,4,4)
- CALL UCTOH('NOTU',IDNOTU,4,4)
- CALL UCTOH(CHKEY,KEY,4,8)
- CALL DZDPIN(KEY,'RBG')
- IF(IQUEST(1) .NE. 0)THEN
- LTOPD = 0
- GOTO 999
- ENDIF
- LDOC = IQUEST(11)
- IDHTB=KEY(1)
-
-* are there down links
-
-* highest number of documented down banks
-
- NSBD = IQ(KQSP+LDOC+5)
- NS = IQ(KQSP+LDOC+2)
- IF(NS.LT.0 .AND. NSBD .GT. IQ(KQSP+LDOC+2))NS = NSBD
-
-* get up link
-
- CALL UHTOC(IQ(KQSP+LDOC+9),4,CTEMP,4)
- CALL CLTOU(CTEMP(1:4))
- IF (CTEMP(1:4) .NE. 'NONE')THEN
-
-* get doc for up-bank
-
- CTEMP(5:8) = '****'
- NFKEY = 0
- 10 CONTINUE
- CALL DZDWCS(CTEMP,KEYI,NFKEY)
- IF(KEYI(1) .EQ. 0)GOTO 40
-* IF(KEYI(2) .NE. IDHTB)GOTO 5
- CALL DZDPIN(KEYI,'RBG')
- IF(IQUEST(1) .NE. 0)GOTO 40
- LUPD = IQUEST(11)
-
-* find link offset in up-bank
-
- NSUP = IQ(KQSP+LUPD+5)
- DO 20 I=1,NSUP
- IF(IQ(KQSP+LUPD+10+I) .EQ. IDHTB)THEN
- JBIAS = I
- GOTO 30
- ENDIF
- 20 CONTINUE
-
-* not found, go and try next
-
- GOTO 10
-
- 30 CONTINUE
-
-* lift up - bank
-
- CALL DZDLFT(LUPD,LLTOP,LUP,1)
- IDHUP = KEYI(1)
-
-* lift bank itself and continue with down banks
-
- CALL DZDLFT(LDOC,LUP,LT,-JBIAS)
-* has it a next bank?
- IDHN = IQ(KQSP+LDOC+10)
- IF(IDHN.NE.0 .AND. IDHN .NE. IDNONE)THEN
- KEYI(1) = IDHN
- CALL DZDPIN(KEYI,'RGB')
- IF(IQUEST(1).EQ.0)THEN
- LDOC=IQUEST(11)
- CALL DZDLFT(LDOC,LT,LN,0)
- ENDIF
- ENDIF
- GOTO 50
- ENDIF
-
-
- 40 CONTINUE
-
-* no up-bank found, lift bank as top bank
-
- CALL DZDLFT(LDOC,LLTOP,LT,1)
- CALL UCTOH('NONE',IDHUP,4,4)
- 50 CONTINUE
-
-*
-*
-* init links
-*
- NBK = 0
- LORIG = LT
- LUP = LT
-
- IF(NS .EQ. 0)GOTO 90
- LD2 = LT
-
-* get next down link
-
- 60 CONTINUE
- JB = LUP - LORIG + 1
- NS = IQ(KQSP+LUP-2)
-*
- 70 CONTINUE
- IF(JB .LE. NS)THEN
-
- IDHD = IQ(KQSP+LDOC+10+JB)
- IF(IDHD .NE. 0)THEN
-* IF(IDHD.EQ.IDSTOP)THEN
-* WRITE(*,'(A,A4)')' Bank reached: ',IDSTOP
-* ENDIF
- KEYI(1) = IDHD
- KEYI(2) = IQ(KQSP+LDOC+7)
- CALL DZDPIN(KEYI,'RGB')
- IF(IQUEST(1) .NE. 0)THEN
- IF(KEYI(1).NE.IDNOTU)THEN
- CALL UHTOC(KEYI(1),4,CTEMP(1:4),4)
- CALL DZDLFX(LD2,-JB,CTEMP(1:4))
- ENDIF
- JB=JB+1
- GOTO 70
- ELSE
- LDOC= IQUEST(11)
- CALL DZDLFT(LDOC,LD2,LD1,-JB)
-* has it a next bank?
- LN=0
- NBBOOK=0
- LDD1=LD1
- IDHN = IQ(KQSP+LDOC+10)
- IF(IDHN.NE.0)THEN
-75 CALL UHTOC(IDHN,4,CTEMP,4)
- CALL CLTOU(CTEMP(1:4))
- IF(CTEMP(1:4).NE.'NONE')THEN
- KEYIN(1) = IDHN
- KEYIN(2) = KEYI(2)
- CALL DZDPIN(KEYIN,'RGB')
- NBBOOK=NBBOOK+1
- IF(IQUEST(1).EQ.0)THEN
- LDOC=IQUEST(11)
- CALL DZDLFT(LDOC,LD1,LN,0)
- IF(IQ(KQSP+LDOC+10).NE.0)THEN
- IF(IQ(KQSP+LDOC+10).NE.IDHN)THEN
- IDHN=IQ(KQSP+LDOC+10)
- LD1=LN
- GOTO 75
- ENDIF
- ENDIF
- ENDIF
- ENDIF
- ENDIF
-* restore old doc
- IF(NBBOOK.GT.0)THEN
- CALL DZDPIN(KEYI,'RGB')
- LDOC=IQUEST(11)
- LD1=LDD1
- ENDIF
- ENDIF
- ELSE
- JB=JB+1
- GOTO 70
- ENDIF
-
-* go down
-
- LUP = LD1
- LORIG = LD1
- LD2 = LD1
- GOTO 60
- ENDIF
-
-* has it a next bank
-
- LN=LQ(KQSP+LUP)
- IF(LN .NE. 0)THEN
-* follow only if HIDs different and doc is there?
- IF(IQ(KQSP+LUP-4).NE.IQ(KQSP+LN-4))THEN
- KEYI(1) = IQ(KQSP+LN-4)
- KEYI(2) = IQ(KQSP+LQ(KQSP+LUP+1)-4)
- CALL DZDPIN(KEYI,'RGB')
- IF(IQUEST(1) .EQ. 0)THEN
- LDOC=IQUEST(11)
- LUP = LN
- LORIG = LN
- L = LN
- LD2=LN
- GOTO 60
- ENDIF
- ENDIF
- ENDIF
-* look if it is end of a linear structure
-* i.e. origin and up link are in different banks
-
- 80 CONTINUE
- LUP = LQ(KQSP+LD2+1)
- LORIG = LQ(KQSP+LD2+2)
-
-* look if back at top bank
-
- IF(LUP .LE. 1) GOTO 90
- IF(IQ(KQSP+LUP-4).EQ.IDHUP .AND. IQ(KQSP+LD2-4).EQ.IDHTB)GOTO 90
-
- NSU = IQ(KQSP+LUP-2)
- IF(LORIG .GE. LUP .OR. LORIG .LT. LUP-NSU)THEN
-
-* its different, step back
-
- NBK = NBK + 1
- LD2 = LORIG
- GOTO 80
- ENDIF
-
-* go up
-
- NBK = NBK + 1
- LD2 = LUP
- LUU = LQ(KQSP+LD2+1)
- IF(LUU .LE. 2)THEN
- KEYI(2) = KEY(2)
- ELSE
- KEYI(2) = IQ(KQSP+LUU-4)
- ENDIF
- KEYI(1) = IQ(KQSP+LD2-4)
- CALL DZDPIN(KEYI,'RGB')
- LDOC = IQUEST(11)
- GOTO 60
-
-* all done, but top bank
-
- 90 CONTINUE
-*
- NBK = NBK + 1
- LTOPD = LT
- IQUEST(11) = LTOPD
- IQUEST(1) = 0
-*
-* WRITE(*,'(A,I8)')' DZDGTR: Total # of banks in tree: ',NBK
- 999 END
-***********************************************************************
diff --git a/src/graflib/dzdoc/dzdraw/dzdhea.F b/src/graflib/dzdoc/dzdraw/dzdhea.F
deleted file mode 100644
index 8af614f..0000000
--- a/src/graflib/dzdoc/dzdraw/dzdhea.F
+++ /dev/null
@@ -1,203 +0,0 @@
-*
-* $Id: dzdhea.F,v 1.1.1.1 1996/03/04 16:13:12 mclareni Exp $
-*
-* $Log: dzdhea.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:12 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDHEA(LB,IB,L)
-*.
-*...DZDHEA draw the top bank + its up bank and link in between
-*.
-*. INPUT : LB, IB the array containing the ZEBRA store
-*. as used in the call to MZSTOR
-*. L link to bank
-*. OUTPUT : none
-*.
-*. SEQUENCE : DZDPRM
-*. CALLS : DZDBNK DZDBOX DZDLI2 DZDPAR DZDTXT
-*. CALLED : DZDRA2
-*.
-*. AUTHOR : O.Schaile
-*. VERSION : 1.00
-*. CREATED : 11-Dec-87
-*.**********************************************************************
-*.
- INTEGER LB(999),IB(999)
-*
-#include "dzdprm.inc"
-#include "dzdchv.inc"
-#include "dzdzbrinc.inc"
-*
- REAL XPOL(10), YPOL(10)
-*
- CHARACTER*4 HIDBK, HIDUP, HIDNX
- CHARACTER*8 CHKEY
- CHARACTER*10 CTEMP
-*
-* get parameters
- CALL DZDPAR(LB,IB,L,
- & HIDBK, NUMID, HIDUP, HIDNX, JBIAS, NL, NS, ND)
- CALL CLTOU(HIDUP)
- IF(IFRCAR.NE.0 .AND. HIDUP.EQ.'NONE')THEN
-* look true up-bank in 4. word
- CONTINUE
- ENDIF
-* box for UP bank
- IF(LTDISP(ISTUSE).NE.0)THEN
- IF(NLKUSE.GE.IB(LTDISP(ISTUSE)-3))THEN
-* WRITE(*,*)'DZDHEA: Too many banks'
- ELSE
- NLKUSE=NLKUSE+1
- CALL IGPID(1,'BANK',NLKUSE,' ')
- LB(LTDISP(ISTUSE)-NLKUSE)= LB(L+1)
- ENDIF
- ENDIF
- IF(LFCOL.NE.0)THEN
- ICOL=IBCCOL
- IFILL=1
- ELSE
- ICOL=-1
- IFILL=0
- ENDIF
- IF(LTDISP(ISTUSE).NE.0 .OR. LFCOL.NE.0)
- & CALL DZDIFA(X0UB, X0UB+DXUB, Y0UB, Y0UB+DYB,IFILL,ICOL)
-
-* CALL IGBOX(X0UB, X0UB+DXUB, Y0UB, Y0UB+DYB)
- CALL DZDBOX(X0UB, X0UB+DXUB, Y0UB, Y0UB+DYB,1000*IFLDIR+0)
-* CALL IGPID(1,'DUMMY',99,' ')
-
- IF(IFLDIR.EQ.0 .OR. HIDUP .EQ. 'NONE')THEN
-* left
-* XT= X0UB + 0.25*CSIZE
-* YT= Y0UB + 0.15*CSIZE
-* IALG = 1
-* left
- XT= X0UB + 0.5*DXUB
- YT= Y0UB + 0.5*DYB
-* centered
- IALG = 2
-* IF(LFCOL.NE.0)THEN
-* CALL ISTXCI(1)
-* ENDIF
- CTEMP=HIDUP
- NC=4
- IF(IFLRZF .GT. 0 .AND. IFRCAR.EQ.0)THEN
-* has it a upbank
- LUP=LB(L+1)
- IF(LUP.LE.2)GOTO 40
- LUPUP=LB(LUP+1)
- IF(LUPUP.LE.2)THEN
- CHKEY(5:8)='NONE'
- ELSE
- CALL UHTOC(IB(LUPUP-4),4,CHKEY(5:8),4)
- ENDIF
- CALL UHTOC(IB(LUP-4),4,CHKEY(1:4),4)
- CALL DZDGDS(CHKEY,' ',CLINE,NLT)
- IF(NLT .LE. 0)GOTO 40
-* look if descriptor should be taken from bank
- IFC=INDEX(CLINE,'HID at D')
- IF(IFC.LE.0)GOTO 40
- IFC=IFC+5
- CALL DZDGFL(CLINE(IFC:),IST,IEND)
- IF(IST.EQ.0 .OR. IEND .LT.IST)GOTO 40
- IEND=MIN(IEND,ND)
- NC=MIN(IEND-IST+1,5)*4
- CALL UHTOC(IB(LUP+IST),4,CTEMP,NC)
- ENDIF
- 40 CONTINUE
-
- CALL DZDTXT(CTEMP,NC,XT,YT,0.9*CSIZE,0.,IALG)
-* IF(LFCOL.NE.0)THEN
-* CALL ISTXCI(1)
-* ENDIF
-* link bias in up bank
- IF(JBIAS .NE. 0)THEN
- IF(JBIAS .GT. 0)THEN
- WRITE(CTEMP,'(I10)')JBIAS
- ELSE
- IF(JBIAS .EQ. -1)THEN
- CTEMP='linear str'
- ELSE
- CTEMP=' '
- ENDIF
- ENDIF
- IALG = 3
- XT = X0UB - 0.5*CSIZE
- YT = Y0UB + 0.5*DYB + 0.5*CSIZE
- CALL DZDTXT(CTEMP,10,XT,YT,
- & CSIZE,0.,IALG)
- ENDIF
- ELSE
-* get name of mother directory
-* get characters fitting in CLINE from end of bank or all
- LC = LEN(CLINE)
- LC4 = LC/4
- NWNAME = IB(L-1)-IB(L+2)
- IF(NWNAME .GT. LC4)THEN
- IFW = IB(L+2)+NWNAME-LC4+1
- NC = LC
- ELSE
- IFW=IB(L+2)+1
- NC = NWNAME*4
- ENDIF
- CALL UHTOC(IB(L+IFW),4,CLINE,NC)
-* get subdir name starting from /
- ISL2 = INDEXB(CLINE(1:NC),'/')
- IF(ISL2.GT.0)THEN
- ISL2 = ISL2-1
- ISL1 = INDEXB(CLINE(1:ISL2),'/')
- IF(ISL1.LE.1)THEN
- ISL1 = 1
- ELSE
- IF(CLINE(ISL1-1:ISL1-1).EQ.'/')ISL1=ISL1-1
- ENDIF
- NC=ISL2-ISL1+1
- XT=X0UB+DXUB+0.5*CSIZE
- YT=Y0UB
- CALL DZDTXT(CLINE(ISL1:ISL2),NC,XT,YT,CSIZE,0.,1)
- ENDIF
- ENDIF
-* link from Up bank to top bank
- XPOL(1) = X0UB
- YPOL(1) = Y0UB + 0.5*DYB
- XPOL(2) = X0TB + 0.5*DXB
- YPOL(2) = YPOL(1)
- XPOL(3) = XPOL(2)
- YPOL(3) = Y0TB + DYB
- XPOL(4) = ARRLEN
- YPOL(4) = 270.
- CALL DZDLI2(4,XPOL,YPOL,0)
-* draw the bank
-*12/2
-* try to fit a next bank
-
- IF(X0TB+2.*DXTB .LE. XRANGE .AND. HIDNX.NE.' ')THEN
- DXX=DXTB-2.5*GRIDX
- HIDNX=' '
- CALL DZDBNK(LB,IB,L,
- + X0TB, Y0TB, DXX, DYB, HIDBK, HIDNX,HIDUP,
- + NUMID, ND)
- LD=LB(L)
- CALL DZDPAR(LB,IB,LD,
- + HIDBK, NUMID, HIDUP, HIDNX, JBIAS, NL, NS, ND)
- CALL DZDBNK(LB,IB,LD,
- + X0TB+DXX+3.*GRIDX, Y0TB, DXX, DYB, HIDBK, HIDNX,HIDUP,
- + NUMID, ND)
- XPOL(1) = X0TB+DXX+2.5*GRIDX
- YPOL(1) = Y0TB + 0.5*DYB
- XPOL(2) = X0TB+DXX+3.*GRIDX
- YPOL(2) = YPOL(1)
- XPOL(3) = ARRLEN
- YPOL(3) = 0.
- CALL DZDLI2(3,XPOL,YPOL,0)
-
- ELSE
- CALL DZDBNK(LB,IB,L,
- & X0TB, Y0TB, DXTB, DYB, HIDBK, HIDNX,HIDUP,
- & NUMID, ND)
- ENDIF
- END
-**********************************************************************
diff --git a/src/graflib/dzdoc/dzdraw/dzdhlp.F b/src/graflib/dzdoc/dzdraw/dzdhlp.F
deleted file mode 100644
index 37efb19..0000000
--- a/src/graflib/dzdoc/dzdraw/dzdhlp.F
+++ /dev/null
@@ -1,74 +0,0 @@
-*
-* $Id: dzdhlp.F,v 1.1.1.1 1996/03/04 16:13:07 mclareni Exp $
-*
-* $Log: dzdhlp.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:07 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDHLP
- WRITE(*,'(10(A/))')
- &' -----------------------------------------',
- &' Activate locator at the following places:',
- &' -----------------------------------------',
- &' In shaded bank center => go down the tree',
- &' In Up-bank box: => go up the tree',
- &' In Next-link arrow => step in linear structure',
- &' Above shaded center => display documentation',
- &' if no doc exists print a template',
- &' Just left of center => display system words',
- &' In the big data box => DZSHOW the bank',
- &' Above big data box => display data words with doc',
- &' In Continue box => continue drawing down banks'
- WRITE(*,'(10(A/))')
- &' ------------',
- &' Doc Version:',
- &' ------------',
- &' An INTEGER number >= 0',
- & 'If it is >0 then:',
- &' Decode the version field in the bank documentation',
- &' when showing data words with doc and try to find requested one',
- &' Possible dots in the documentation are ignored,',
- &' i.e. 1.4.5 is equivalent to 145',
- &' When displaying documentation all versions will be shown'
-
- WRITE(*,'(10(A/))')
- &' ----------------------------------',
- &' Parameters (DZSHOW, DZDDWD, DZDTMP):',
- &' ----------------------------------',
- &' DZDOC-Opt:',
- &' character option,see ZEBRA-manual (Z=hexadecimal)',
- &' plus the following:',
- &' W1,W2,W3 bitwise dump with 1,2,3 field width',
- &' W0 also display bit values = 0',
- &' C display only contents of data (no doc,no seq#',
- &' useful if data should read by a program'
- WRITE(*,'(10(A/))')
- &' FIRST first and last data word to dump',
- &' LAST if 0 all data are dumped',
- &' UNIT = 6 => standard output (screen)',
- &' otherwise on file FORxxx, xxx = UNIT',
- &' if UNIT changes a previous file is closed'
-
- WRITE(*,'(10(A/))')
- &' DZDTMP-Opt: char-option for Doc-template',
- &' T do it for tree below selected bank ',
- &' L follow next links ',
- &' A generate Author tag ',
- &' V generate Version tag ',
- &' D generate Division tag ',
- &' A generate Store tag '
-
- WRITE(*,'(10(A/))')
- &' --------------------',
- &' Modify data in banks',
- &' --------------------',
- &' You may modify data in the currently selected bank',
- &' REAL values should contain a . (dot), they are read',
- &' with F12.5, INTEGERs are read as hex,if they are preceeded',
- &' by a $. System words may be modified by selecting FIRST',
- &' and LAST word zero or negative, its however your own risk!!.'
- RETURN
- END
-***********************************************************************
diff --git a/src/graflib/dzdoc/dzdraw/dzdhlr.F b/src/graflib/dzdoc/dzdraw/dzdhlr.F
deleted file mode 100644
index d2174dd..0000000
--- a/src/graflib/dzdoc/dzdraw/dzdhlr.F
+++ /dev/null
@@ -1,36 +0,0 @@
-*
-* $Id: dzdhlr.F,v 1.1.1.1 1996/03/04 16:13:17 mclareni Exp $
-*
-* $Log: dzdhlr.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:17 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDHLR
-#include "zebra/zunit.inc"
- IF(IQPRNT.EQ.6)CALL IGTERM
- WRITE(*,'(10(A/))')
- &' -----------------------------------------',
- &' Directories are displayed like diamond shaped',
- &' boxes, keys as rectangular boxes',
- &' the sequence number and cycle of keys are',
- &' displayed left of the shaded box (S SNr, C CNr)',
- &' if the key contains a vector its marked with a V',
- &' if not all keys are displayed, the most recent ones',
- &' are shown'
-
- WRITE(*,'(15(A/))')
- &' -----------------------------------------',
- &' Activate locator at the following places:',
- &' -----------------------------------------',
- &' In shaded diamond => go down the tree',
- &' In Up-dir diamond => go up the tree',
- &' In the big dir-box => list directory',
- &' In the big key-box => input d/s (call RZIN',
- &' Above key-box => list complete Key info',
- &' In Continue box => continue drawing dirs/keys',
- &' keys or dirs may be skipped by',
- &' modifying Key/Dir-SeqNr'
- END
-***********************************************************************
diff --git a/src/graflib/dzdoc/dzdraw/dzdhlv.F b/src/graflib/dzdoc/dzdraw/dzdhlv.F
deleted file mode 100644
index de0b272..0000000
--- a/src/graflib/dzdoc/dzdraw/dzdhlv.F
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: dzdhlv.F,v 1.1.1.1 1996/03/04 16:13:15 mclareni Exp $
-*
-* $Log: dzdhlv.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:15 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDHLV
- WRITE(*,'(10(A/))')
- &' -----------------------------------------',
- &' Activate locator at the following places:',
- &' -----------------------------------------',
- &' ',
- &' In divisions display => call DZDISP for choosen bank',
- &' In store display (at top) => call DZDDIV for choosen div',
- &' In Zoom - box => zoom selected region of div',
- &' 2 locator inputs are expected',
- &' In the menu boxes to select stores and divisions'
- END
-**********************************************************************
diff --git a/src/graflib/dzdoc/dzdraw/dzdhtm.F b/src/graflib/dzdoc/dzdraw/dzdhtm.F
deleted file mode 100644
index efb9e4c..0000000
--- a/src/graflib/dzdoc/dzdraw/dzdhtm.F
+++ /dev/null
@@ -1,193 +0,0 @@
-*
-* $Id: dzdhtm.F,v 1.1.1.1 1996/03/04 16:13:19 mclareni Exp $
-*
-* $Log: dzdhtm.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:19 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDHTM(ISTORE,L,CFLAG)
-*
-* walk through a d/s at L and write doc in html
-* CFLAG 'S' one bank only
-* 'T' bank tree (default)
-* 'N' no data words
-* 'P' plain text (no hyperlinks)
-*
-C+SEQ,ZUNIT.
-#include "zebra/zebq.inc"
-#include "zebra/mzca.inc"
-#include "zebra/mzcb.inc"
-C++CDE,ZBCDK. From DZEBRA
-C++SEQ,DZDPRM
-C++SEQ,DZDOCC.
- CHARACTER*(*) CFLAG
- CHARACTER*16 CLTOP
- INTEGER L,LN,LGO,LRET,LDOWN, IFC,ILC, IHNONE, LUN
- PARAMETER (LUN=65)
- CHARACTER*8 ANCHOR
- CHARACTER*80 CGET
- CHARACTER*4 CLINK
- CHARACTER*5 CSUFFI
- CHARACTER*16 CLDOWN
- CHARACTER*16 DZE2US
- INTEGER KEYVEC(2)
-*---
- CALL MZSDIV(ISTORE,-7)
- CALL UCTOH('NONE',IHNONE,4,4)
- IF(INDEX(CFLAG,'P').EQ. 0)THEN
- CSUFFI='.html'
- ELSE
- CSUFFI='.txt'
- ENDIF
- WRITE(CLTOP,'(A4,I7.7,A)')IQ(KQS+L-4),L,CSUFFI
- CLTOP=DZE2US(CLTOP)
- OPEN(LUN,FILE=CLTOP)
-* CALL KUOPEN(LUN,CLTOP,'UNKNOWN',IRET)
- IF(LQ(KQS+L+1).EQ.0)THEN
- CLTOP=' '
- ELSE
- WRITE(CLTOP,'(A4,I7.7,A)')
- + IQ(KQS+LQ(KQS+L+1)-4),LQ(KQS+L+1),CSUFFI
- CLTOP=DZE2US(CLTOP)
- ENDIF
- IF(INDEX(CFLAG,'P').EQ. 0)THEN
- WRITE(LUN,'(A)')'<html>'
- WRITE(LUN,'(A)')'<head>'
- WRITE(LUN,'(A)')'<body>'
- WRITE(LUN,'(A)')'<isindex>'
- WRITE(LUN,'(A)')'</head>'
- WRITE(LUN,'(A)')'<body>'
- WRITE(LUN,'(A)')'<pre>'
- ENDIF
- LRET=-L
- 20 CONTINUE
- LGO=LRET
- CALL DZDWTR(ISTORE,LGO,LRET)
- IF(LRET.NE.0)THEN
-* WRITE(*,'(A,A4,I10)')'Found ',IQ(KQS+LRET-4),LRET
- KEYVEC(1)=IQ(KQS+LRET-4)
- IF(LQ(KQS+LRET+1).GT.1)THEN
- KEYVEC(2)=IQ(KQS+LQ(KQS+LRET+1)-4)
- ELSE
- KEYVEC(2)=IHNONE
- ENDIF
- I1000=100000
- LQBKD=0
- CALL RZIN(0,LQBKD,2,KEYVEC,I1000,'D')
- IF (LQBKD .EQ. 0)THEN
- NLT = 0
- NLU = 0
- WRITE(*,'(A,A4)')'No doc for bank ',KEYVEC(1)
- ELSE
- IP0=KQSP+LQBKD+1
-
- CALL DZDGGI(IQ(IP0),'CL',' ',CGET,IFC,ILC)
- WRITE(ANCHOR,'(I8.8)')LRET
- IF(INDEX(CFLAG,'P').EQ. 0)
- + WRITE(LUN,'(A)')'<a name="L'//ANCHOR//'"><b>'
- IF(ILC.GT.0)WRITE(LUN,'(A)')
- + 'Bank IDH '//CGET(1:4)//' '//CGET(5:ILC)
- IF(INDEX(CFLAG,'P').EQ. 0)
- + WRITE(LUN,'(A)')'</b></a>'
- CALL DZDGGI(IQ(IP0),'AU',' ',CGET,IFC,ILC)
- IF(ILC.GT.0)WRITE(LUN,'(A,A,A)')'Author(s) ',CGET(IFC:ILC)
- CALL DZDGGI(IQ(IP0),'VE',' ',CGET,IFC,ILC)
- IF(ILC.GT.0)WRITE(LUN,'(A,A,A)')'Version ',CGET(IFC:ILC)
- NID=IQ(KQS+LRET-5)
- WRITE(LUN,'(A,I6)')'NumId ',NID
- NL=IQ(KQS+LRET-3)
- NS=IQ(KQS+LRET-2)
- WRITE(LUN,'(A,I6)')'Str Links ',NS
- NR=NL-NS
- WRITE(LUN,'(A,I6)')'Ref Links ',NR
- ND=IQ(KQS+LRET-1)
- WRITE(LUN,'(A,I6)')'NData ',ND
- NIO = JBYT(IQ(KQS+LRET),19,4)
- IOFFBS = - (NIO + NL + 8 + 1)
- CALL DZDIOC(IQ(KQS+LRET+IOFFBS),CGET,ILC)
- IF(ILC.GT.0)WRITE(LUN,'(A,A,A)')'IO-Char ',CGET(1:ILC)
-
- WRITE(LUN,'(A)')'---------- System links ----------'
- CALL UHTOC(KEYVEC(2),4,CLINK,4)
- IF(CLINK.NE.'NONE')THEN
- IF(INDEX(CFLAG,'P').EQ. 0)THEN
- WRITE(ANCHOR,'(I8.8)')LQ(KQS+LRET+1)
-* is it very first bank
- IF(LRET.EQ.L)THEN
- NCH=LNBLNK(CLTOP)
- WRITE(LUN,'(A,A)')'Up-Link '//
- + '<a href="'//CLTOP(1:NCH)//'#L'//ANCHOR//'"><b>'//
- + CLINK//'</b></a>'
- ELSE
- WRITE(LUN,'(A,A)')'Up-Link '//
- + '<a href="#L'//ANCHOR//'"><b>'//
- + CLINK//'</b></a>'
-
- ENDIF
- ELSE
- WRITE(LUN,'(A,A)')'Up-Link '//CLINK
- ENDIF
-* handle Origin link eventually
- ELSE
- WRITE(LUN,'(A,A)')'Up-Link '//CLINK
- ENDIF
- LN=LQ(KQS+LRET)
- IF(LN.NE.0)THEN
- CALL UHTOC(IQ(KQS+LN-4),4,CLINK,4)
- IF(INDEX(CFLAG,'P').EQ. 0)THEN
- WRITE(ANCHOR,'(I8.8)')LN
- WRITE(LUN,'(A,A)')'Next-Link '//
- + '<a href="#L'//ANCHOR//'"><b>'//
- + CLINK//'</b></a>'
- ELSE
- WRITE(LUN,'(A,A)')'Next-Link '//CLINK
- ENDIF
- ENDIF
- IF(NS.GT.0)THEN
- WRITE(LUN,'(A)')'--------- Struct links ----------'
- DO I=1,NS
- LDOWN=LQ(KQS+LRET-I)
- IF(LDOWN.NE.0)THEN
- CALL UHTOC(IQ(KQS+LDOWN-4),4,CLINK,4)
- CALL DZDGGI(IQ(IP0),'LI',CLINK,CGET,IFC,ILC)
- IF(INDEX(CFLAG,'P').EQ. 0)THEN
- WRITE(ANCHOR,'(I8.8)')LDOWN
- IF(INDEX(CFLAG,'S').NE.0)THEN
- WRITE(CLDOWN,'(A4,I7.7,A5)')
- + CLINK,LDOWN,'.html'
- CLDOWN=DZE2US(CLDOWN)
- WRITE(LUN,'(I6,A)')I,
- + ' <a href="'//CLDOWN//'#L'//
- + ANCHOR//'"><b>'//
- + CLINK//'</b></a> '//CGET(1:ILC)
- ELSE
- WRITE(LUN,'(I6,A)')I,
- + ' <a href="#L'//
- + ANCHOR//'"><b>'//
- + CLINK//'</b></a> '//CGET(1:ILC)
- ENDIF
- ELSE
- WRITE(LUN,'(I6,A)')I,CLINK//' '//CGET(1:ILC)
- ENDIF
- ENDIF
- ENDDO
- ENDIF
- IF(ND.GT.0 .AND. INDEX(CFLAG,'N').EQ. 0)THEN
- CALL DZDDWD(ISTORE,LRET,' ',1,ND,LUN)
- ENDIF
- CALL MZDROP(0,LQBKD,' ')
- LQBKD=0
- ENDIF
- IF(INDEX(CFLAG,'S').EQ.0)GOTO 20
- ENDIF
- IF(INDEX(CFLAG,'P').EQ. 0)THEN
- WRITE(LUN,'(A)')'</pre>'
- WRITE(LUN,'(A)')'</body>'
- WRITE(LUN,'(A)')'</html>'
- ENDIF
- 999 CONTINUE
- RETURN
- END
-*******************************************************************
diff --git a/src/graflib/dzdoc/dzdraw/dzdibr.F b/src/graflib/dzdoc/dzdraw/dzdibr.F
deleted file mode 100644
index ee8dfeb..0000000
--- a/src/graflib/dzdoc/dzdraw/dzdibr.F
+++ /dev/null
@@ -1,93 +0,0 @@
-*
-* $Id: dzdibr.F,v 1.1.1.1 1996/03/04 16:13:01 mclareni Exp $
-*
-* $Log: dzdibr.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:01 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDIBR
-*
-* init Zebra browser
-*
- LOGICAL KUQSVR
-#include "dzdzbrinc.inc"
-#include "dzdprm.inc"
- INTEGER INIFLG
- SAVE INIFLG
- EXTERNAL DZDASE
- DATA INIFLG/0/
- IF(INIFLG.NE.0)GOTO 999
-* CALL DZDLUN(LUPTMP,IERR)
-* IF(IERR.NE.0)THEN
-* WRITE(*,*)'Error finding free LUN',IERR
- LUPTMP=67
-* ENDIF
-* CALL DZDLUN(LPDOCB,IERR)
-* IF(IERR.NE.0)THEN
-* WRITE(*,*)'Error finding free LUN',IERR
- LPDOCB=68
-* ENDIF
-* CALL DZDLUN(LPDOCS,IERR)
-* IF(IERR.NE.0)THEN
-* WRITE(*,*)'Error finding free LUN',IERR
- LPDOCS=69
-* ENDIF
- WRITE(*,*)'Init Zebra browser, it will use units:',
- & 65, LUPTMP, LPDOCB, LPDOCS
- CTDDOC=' '
- CWDSAV=' '
- CIDMSK=' '
- CHOPD1=' '
- NUH=0
- INMFLG=0
- LUNTMP=0
- LUDOCB=0
- INIFLG=1
- IWKZEB=1
- IWMZEB=0
- ILOZEB=1
- IDOCFL=0
- NDIADD=0
- NIDMSK=0
- NKYMSK=0
- IAPPFL=0
- DO 3 I=1,9
-3 KACMSK(I)=0
- IBCCOL=7
- IBDCOL=3
- IKDSP1=1
- IKDSP2=2
- ICYDSP=1000000
- IDREFL=1
- CCOL ='C'
- CCACT ='N'
- GRIDSC=1.
- IDZTFO=0
- IDZTPR=0
- LNEWWI=.TRUE.
- EDITSV=KUQSVR()
- IF(EDITSV)THEN
- CALL KUEUSR(DZDASE)
- ELSE
- WRITE(*,*)'No edit server available, will use KUEDIT'
- ENDIF
- NLKUSE=0
- ISTUSE=0
- IACTST=0
- DO 5 IST=0,15
- LZEFLG(IST)=0
- LTDFLG(IST)=0
-5 LTBFLG(IST)=0
-999 END
-*********************************************************************
-*+DECK,DZDLUN.
-* SUBROUTINE DZDLUN(LUN,IERR)
-* INTEGER LUN,IERR
-*--
-* IERR=0
-* CALL PALUNF(11,3,LUN)
-* IF(LUN.LE.0)IERR=-1
-* END
-*********************************************************************
diff --git a/src/graflib/dzdoc/dzdraw/dzdifa.F b/src/graflib/dzdoc/dzdraw/dzdifa.F
deleted file mode 100644
index 9b3a347..0000000
--- a/src/graflib/dzdoc/dzdraw/dzdifa.F
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: dzdifa.F,v 1.1.1.1 1996/03/04 16:13:14 mclareni Exp $
-*
-* $Log: dzdifa.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:14 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDIFA(X0, X0D, Y0, Y0D, IFAIS, ICOL)
- REAL X0, X0D, Y0, Y0D, XPOL(5),YPOL(5)
- XPOL(1)=X0
- XPOL(2)=X0D
- XPOL(3)=X0D
- XPOL(4)=X0
- XPOL(5)=X0
- XPOL(1)=X0
- YPOL(1)=Y0
- YPOL(2)=Y0
- YPOL(3)=Y0D
- YPOL(4)=Y0D
- YPOL(5)=Y0
- CALL ISFAIS(IFAIS)
- IF(ICOL.GE.0)CALL ISFACI(ICOL)
- CALL IFA(5,XPOL,YPOL)
- CALL ISPLCI(1)
- CALL IPL(5,XPOL,YPOL)
- END
-************************************************************************
diff --git a/src/graflib/dzdoc/dzdraw/dzdinb.F b/src/graflib/dzdoc/dzdraw/dzdinb.F
deleted file mode 100644
index ff6b0a8..0000000
--- a/src/graflib/dzdoc/dzdraw/dzdinb.F
+++ /dev/null
@@ -1,30 +0,0 @@
-*
-* $Id: dzdinb.F,v 1.1.1.1 1996/03/04 16:13:09 mclareni Exp $
-*
-* $Log: dzdinb.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:09 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- LOGICAL FUNCTION DZDINB(PX,PY, X0,X1,Y0,Y1)
-*.
-*...DZDINB look if PX, PY are in a box
-*.
-*. INPUT : PX,PY coordinates to be checked
-*. X0,X1,Y0,Y1 coordinates of box
-*. OUTPUT : DZDINB = .TRUE. if PX,PY are in box
-*.
-*. AUTHOR : O.Schaile
-*. VERSION : 1.00
-*. CREATED : 11-Dec-87
-*.**********************************************************************
-*.
- IF(PX .GE. X0 .AND. PX .LE. X1
- & .AND. PY .GE. Y0 .AND. PY .LE. Y1)THEN
- DZDINB = .TRUE.
- ELSE
- DZDINB = .FALSE.
- ENDIF
- END
-************************************************************************
diff --git a/src/graflib/dzdoc/dzdraw/dzdioc.F b/src/graflib/dzdoc/dzdraw/dzdioc.F
deleted file mode 100644
index 5dab008..0000000
--- a/src/graflib/dzdoc/dzdraw/dzdioc.F
+++ /dev/null
@@ -1,69 +0,0 @@
-*
-* $Id: dzdioc.F,v 1.1.1.1 1996/03/04 16:13:07 mclareni Exp $
-*
-* $Log: dzdioc.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:07 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDIOC(IOW,CQLINE,NCH)
- CHARACTER*(*) CQLINE
- INTEGER IOW(9)
- COMMON/QUEST/IQUEST(100)
-#include "zebra/mzioc.inc"
-* BANK FORMAT PARAMETERS (IO CHARACERISTIC)
-#include "zebra/bkfoparq.inc"
- CHARACTER KFOTYP(0:11)*1
- DATA KFOTYP /'U','B','I','F','D','H','*','S','*','N','*','L'/
- CALL MZIOCR(IOW)
- MAXNCH=LEN(CQLINE)
- CQLINE=' '
- IPOS = 1
- DO 100 JFOCUR = 1,JFOEND,2
- IF (JFOCUR.EQ.JFOREP+1) THEN
- WRITE(CQLINE(IPOS:IPOS+1),'(''/ '')')
- IPOS = IPOS + 2
- IF(IPOS.GE.MAXNCH)GOTO 888
- ENDIF
- ITYPE = MFO(JFOCUR)
- IF (ITYPE.EQ.IFOSEQ) THEN
- WRITE(CQLINE(IPOS:IPOS+1),'(''*'',A1)') KFOTYP(ITYPE)
- IPOS = IPOS + 3
- IF(IPOS.GE.MAXNCH)GOTO 888
- GO TO 100
- ENDIF
- NWSEC = MFO(JFOCUR+1)
- ITYPE = MIN(ITYPE,8)
- IF (NWSEC.LT.0) THEN
- WRITE(CQLINE(IPOS:IPOS+1),'(''-'',A1)') KFOTYP(ITYPE)
- IPOS = IPOS + 3
- IF(IPOS.GE.MAXNCH)GOTO 888
- ELSEIF (NWSEC.EQ.0) THEN
- WRITE(CQLINE(IPOS:IPOS+1),'(''*'',A1)') KFOTYP(ITYPE)
- IPOS = IPOS + 3
- IF(IPOS.GE.MAXNCH)GOTO 888
- ELSE
- DO 10 I=1,100
- IF(NWSEC.EQ.0) GO TO 20
- IQUEST(I)=MOD(NWSEC,10)
- NWSEC = NWSEC/10
- 10 CONTINUE
- 20 DO 30 J=1,I-1
- WRITE(CQLINE(IPOS:IPOS),'(I1)') IQUEST(I-J)
- IPOS = IPOS + 1
- IF(IPOS.GE.MAXNCH)GOTO 888
- 30 CONTINUE
- WRITE(CQLINE(IPOS:IPOS),'(A1)') KFOTYP(ITYPE)
- IPOS = IPOS + 2
- IF(IPOS.GE.MAXNCH)GOTO 888
- ENDIF
- 100 CONTINUE
- NCH=IPOS-1
- GOTO 999
- 888 CONTINUE
- CQLINE=' too complicated (long)'
- NCH=22
- 999 RETURN
- END
-********************************************************************
diff --git a/src/graflib/dzdoc/dzdraw/dzdird.F b/src/graflib/dzdoc/dzdraw/dzdird.F
deleted file mode 100644
index 156aaa1..0000000
--- a/src/graflib/dzdoc/dzdraw/dzdird.F
+++ /dev/null
@@ -1,65 +0,0 @@
-*
-* $Id: dzdird.F,v 1.1.1.1 1996/03/04 16:13:16 mclareni Exp $
-*
-* $Log: dzdird.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:16 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDIRD(LDUNIT,CDIR,COUT,IFLAG)
-
- INTEGER LDUNIT,IFLAG
- CHARACTER*(*) CDIR,COUT
- CHARACTER*80 CLINE
-
-* simple implementation of doc
-* IFLAG = 0: print doc
-* 1: return first line in COUT
-
-* WRITE(*,*)LDUNIT,IFLAG,CDIR
- IF(LDUNIT.LE.0 .AND. IFLAG.LE.0)GOTO 99
- IF(CDIR(1:2).NE.'//')GOTO 99
- LENDIR=LENOCC(CDIR)
- REWIND LDUNIT
- ISLASH = INDEX(CDIR(3:),'/')
- IF(ISLASH.EQ.0)THEN
- GOTO 99
- ELSE
- ISLASH=ISLASH+2
- ENDIF
- INDOC=0
-1 CALL DZDCRD(LDUNIT,CLINE,IRC)
- IF(IRC.NE.0)GOTO 99
-*1 READ(LDUNIT,'(A)',END=99)CLINE
- IF(INDOC.GT.0)THEN
- IF(CLINE(1:1).EQ.'/')THEN
- GOTO 99
- ELSE
- GOTO 5
- ENDIF
- ENDIF
- IF(CLINE(1:1).NE.'/')GOTO 1
- CALL CLTOU(CLINE)
- LENLIN=LENOCC(CLINE)
- ISLASH=LENDIR-LENLIN+1
- IF(ISLASH.LE.0)GOTO 1
- IF(INDEX(CDIR(ISLASH:LENDIR),CLINE(1:LENLIN)).EQ.0)GOTO 1
-
- INDOC=1
- IF(IFLAG.EQ.1)THEN
- COUT=' '
- CALL DZDCRD(LDUNIT,COUT,IRC)
- IF(IRC.NE.0)GOTO 99
-* READ(LDUNIT,'(A)',END=99)COUT
-* WRITE(*,*)COUT
- GOTO 99
- ENDIF
-* PRINT THE LINE
-5 LENLIN=LENOCC(CLINE)
- WRITE(*,*)CLINE(1:LENLIN)
- GOTO 1
-99 RETURN
- END
-
-**********************************************************************
diff --git a/src/graflib/dzdoc/dzdraw/dzdirz.F b/src/graflib/dzdoc/dzdraw/dzdirz.F
deleted file mode 100644
index 0fdcd43..0000000
--- a/src/graflib/dzdoc/dzdraw/dzdirz.F
+++ /dev/null
@@ -1,570 +0,0 @@
-*
-* $Id: dzdirz.F,v 1.1.1.1 1996/03/04 16:13:16 mclareni Exp $
-*
-* $Log: dzdirz.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:16 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDIRZ(IDIVIS,LDATA,JB,
- + RZPATH,CHOPT, IWDISP, IWMETA, ILOCNR)
-*.
-*...DZDDIR
-*.
-*. INPUT : IXSTOR Store index
-*. LDATA Link where to put data structure (RZIN)
-*. JB Jbias
-*. RZPATH RZ - directory to treat
-*. CHOPT Character option:
-*. 'N' dont activate workstation (done by caller)
-*. 'M' write on metafile also the menu boxes
-*. 'S' dont drop d/s at return
-*. 'A' display all keys (100000)
-*. 'T' template (2 lines/dir => LUN)
-*. 'H' headline for key names in display
-*. 'DU10' doc is on seq file unit 10
-*. 'NK5' show max 5 keys
-*. 'LU11' output to LUN 11
-*. 'W' print warning if more keys then asked for
-*.
-*. IWDISP workstation Id for display (screen)
-*. IWMETA Id for possible metafile (0 if none)
-*. ILOCNR locator number for cursor input
-*.
-*. OUTPUT : none
-*.
-*. COMMON :
-*. SEQUENCE : DZDCHV DZDPRM MZCA MZCB QSTORE ZEBQ ZUNIT
-*. CALLS : DZDBOX DZDGET DZDGST DZDOCO DZDSYW
-*. CALLS : DZDTXT GACWK GCLRWK GDAWK GQCNTN GQNT
-*. CALLS : GSELNT RZCDIR UHTOC
-*. CALLED : USER
-*.
-*. AUTHOR : O.Schaile
-*. VERSION : 1.00
-*. CREATED : 11-Dec-87
-*. LAST MOD : 4-Jun-88 O.Schaile
-*.
-*. Modification Log.
-*. 4.Jun-88 Save LTOP, LRET by MZLINT
-*.
-*.**********************************************************************
-*.
- CHARACTER*(*) RZPATH, CHOPT
-*
-#include "zebra/zebq.inc"
-#include "zebra/mzca.inc"
-#include "zebra/mzcb.inc"
- COMMON/QUEST/RQUEST(100)
- INTEGER IQUEST(100)
- EQUIVALENCE(RQUEST,IQUEST)
-#include "zebra/zunit.inc"
-#include "dzdprm.inc"
-#include "dzdchv.inc"
-#if defined(CERNLIB_BSLASH)
-#include "dzdoc/bslash2.inc"
-#endif
-#if !defined(CERNLIB_BSLASH)
-#include "dzdoc/bslash1.inc"
-#endif
-* COMMON/DZDLK2/LAREF(2),LSEL,LSEL1
- COMMON/DZDLK2/LNKLOC(5,0:15)
- LOGICAL DZDINB
- EXTERNAL DZDINB
-*
- CHARACTER*12 CTEMP ,CHOPT1
- CHARACTER*4 CHOPRZ
- CHARACTER*8 CHKEY
- CHARACTER*120 RZPSAV, RZPINT
- PARAMETER(NMITEM=7)
- CHARACTER*16 CHITEM(NMITEM),CHUSER(2)
- CHARACTER*8 CMENU
- PARAMETER (NMODMN=2)
- CHARACTER*8 CMODUS(2)
- CHARACTER*20 CMODTI
- CHARACTER*12 CMODMN(NMODMN)
- CHARACTER*12 CMODVA(NMODMN)
- CHARACTER*12 CMODDF(NMODMN)
- CHARACTER*1 CMMENU
- REAL RVALQ(11)
-*
- INTEGER IFIRST,ILAST,MKEYS,MOLDK
- LOGICAL LACTWK
- SAVE INIFLG, METAFL,IPCSEQ, IOPFIL,ICYCLE,MKEYS
- SAVE RZPSAV
- DATA IFIRST/0/, ILAST/0/, MKEYS/10/
- DATA INIFLG/0/, IPCSEQ/0/, IOPFIL /0/
-*----
- CALL IGQWK(IWDISP,'OPEN',RVALQ)
- IF(RVALQ(1).LT.1.)THEN
- WRITE(*,*)'DZDIRZ: Workstation', IWDISP, ' not open'
- RETURN
- ENDIF
- IF(INDEX(CHOPT,'A').NE.0)THEN
- MKEYS = 100000
- ELSE
- MKEYS=5
- ENDIF
- LFCOL=0
- IXSTOR=IDIVIS
-#include "zebra/qstore.inc"
- IST = JQSTOR
- IF(LNKLOC(1,IST).EQ.0 .OR. INIFLG.EQ.0)
- & CALL MZLINT(IXSTOR,'/DSDLK2/',
- + LNKLOC(1,IST),LNKLOC(5,IST),LNKLOC(5,IST))
- INIFLG=1
- CHOPT1 = ' '
-* look if a unit for documentation is there
- LUDORZ=0
- LENOPT=LENOCC(CHOPT)
- IFCD=INDEX(CHOPT,'DU')
- IF(IFCD.NE.0)THEN
- CALL DZDGIV(CHOPT(IFCD+2:),LUDORZ,NN)
- ENDIF
-* unit for log output
- LLUNIT=6
- IFCL=INDEX(CHOPT,'LU')
- IF(IFCL.NE.0)THEN
- CALL DZDGIV(CHOPT(IFCL+2:),LLUNIT,NN)
- IF(LLUNIT.LE.0)LLUNIT=6
- ENDIF
-* number of keys to show
- IFCN=INDEX(CHOPT,'NK')
- IF(IFCN.NE.0)THEN
- CALL DZDGIV(CHOPT(IFCN+2:),NNK,NN)
- IF(NNK.NE.0)MKEYS=NNK
- ENDIF
- IF(IFCD.NE.0)LENOPT=IFCD-1
- IF(IFCL.NE.0.AND.IFCL.LT.LENOPT-1)LENOPT=IFCL-1
- IF(IFCN.NE.0.AND.IFCN.LT.LENOPT-1)LENOPT=IFCN-1
-* WRITE(*,*)'IFCD,IFCL,IFCN,LENOPT',IFCD,IFCL,IFCN,LENOPT
- IF(LENOPT .GT. 0)THEN
- CHOPT1(1:)=CHOPT(1:LENOPT)
- ELSE
- CHOPT1=' '
- ENDIF
-* LENOPT = LENOPT+1
- CALL CLTOU(CHOPT1(1:LENOPT))
-
-* CHOPT1(LENOPT:LENOPT) = 'B'
- IF(INDEX(CHOPT1,'N').NE. 0)THEN
- LACTWK = .FALSE.
- ELSE
- LACTWK=.TRUE.
- ENDIF
- IFLPKY=INDEX(CHOPT1,'H')
- NT = 0
- ICYCLE=1000000
- CHOPRZ=' '
- XRANGE = 20.
- YRANGE = 20.
- CALL IGRNG( XRANGE, YRANGE)
- IF(LACTWK)CALL IACWK(IWDISP)
- CMENU='DHCT'
- CMMENU=' '
- GRIDX = GRIDSC*XRANGE/32.
- GRIDY = GRIDX
- YBOTTM=0.
- MOLDK=MKEYS
-* look if dir changed
- IF(INDEX(CHOPT1,'S').NE.0 .AND. LNKLOC(4,IST).NE.0)THEN
- LNKLOC(3,IST)= LNKLOC(4,IST)
- LCSAV=LENOCC(RZPSAV)
- LCPATH=LENOCC(RZPATH)
- RZPINT(1:LCPATH)=RZPATH(1:LCPATH)
- CALL CLTOU(RZPINT(1:LCPATH))
- CALL CLTOU(RZPSAV(1:LCSAV))
- IF(INDEX(RZPINT(1:LCPATH),RZPSAV(1:LCSAV)).LE.0)THEN
-* not part, force new
- GOTO 9
- ELSE
-* exactly same?
- IF(LCSAV.EQ.LCPATH)GOTO 8
- RZPINT(LCPATH+1:)=' '
- LL=LNKLOC(3,IST)
- IF(LCPATH.GT.LCSAV+1)THEN
- LCACT=LCSAV+2
-* set link to selected dir
-5 CONTINUE
- LASTC=INDEX(RZPINT(LCACT:),'/')
- IF(LASTC.EQ.0)THEN
- LASTC=LCPATH
- ELSE
- LASTC=LASTC+LCACT-1
- ENDIF
-* is selected dir there?
- NL=IQ(LL+KQS-2)
- IF(NL.LE.0)GOTO 9
- DO 6 IL=1,NL
- LLD=LQ(LL+KQS-IL)
- IF(LLD.EQ.0)GOTO 6
-* is it dir
- IF(IQ(LLD+KQS+1).NE.1)GOTO 6
- IOFFNA=IQ(LLD+KQS+2)
- NC=(IQ(LLD+KQS-1)-IOFFNA)*4
- CALL UHTOC(IQ(LLD+KQS+IOFFNA+1),4,CLINE,NC)
- CALL CLTOU(CLINE(1:NC))
- NC=LENOCC(CLINE(1:NC))
- IF(CLINE(1:NC).EQ.RZPINT(1:NC))THEN
- IF(LASTC.EQ.LCPATH)THEN
- LNKLOC(3,IST)=LLD
- GOTO 8
- ENDIF
-* go down in tree
- LL=LLD
- LCACT=LASTC+2
- GOTO 5
- ENDIF
-6 CONTINUE
-* fallen trough loop, not found
- GOTO 9
- ENDIF
- ENDIF
- ELSE
- GOTO 9
- ENDIF
-*
-8 ILKACT = 0
- METAFL = 0
- GOTO 10
-
-9 CONTINUE
- MOLDK=-1
- RZPSAV=RZPATH
-
-10 CONTINUE
- IF(MKEYS.NE.MOLDK)THEN
- CALL RZCDIR(RZPSAV,' ')
- IF(LNKLOC(4,IST).NE.0)CALL MZDROP(IXSTOR,LNKLOC(4,IST),' ')
- LNKLOC(4,IST)=0
- CALL DZDGRZ(IXSTOR,LNKLOC(3,IST),MKEYS,LLUNIT,CHOPT1)
- LNKLOC(4,IST) = LNKLOC(3,IST)
- MOLDK=MKEYS
- ILKACT = 0
- METAFL = 0
- ENDIF
-
-* clear workstations
- IF(IWMETA .GT. 0 .AND. METAFL .EQ. 1)THEN
-* CALL IDAWK(IWDISP)
- CALL IACWK(IWMETA)
- CMMENU='M'
- ILKACT = ILKSAV
- IF(INDEX(CHOPT,'M').EQ.0)THEN
- CALL ISWKWN(IWMETA,0.,1.,YBOTTM,1.)
- XAPA = .1465
- CALL ISWKVP(IWMETA,0.,XAPA,0.,XAPA*(1.-YBOTTM))
- ENDIF
- CMENU='DT'
- CALL ICLRWK(0,0)
-* CALL ICLRWK(IWMETA,1)
- CALL ISFASI(-103)
- IPCSEQ=IPCSEQ+1
- IF(IPCSEQ. GT. 999)IPCSEQ=1
- CTEMP(1:4)='RDIR'
- WRITE(CTEMP(5:7),'(I3.3)')IPCSEQ
- ELSEIF(IFOMED.NE.3)THEN
- CALL ICLRWK(IWDISP,1)
- CALL ISFASI(-5)
- ENDIF
-
- ILKSAV = ILKACT
- CALL DZDRA1(IXSTOR, LNKLOC(3,IST), ILKACT
- + , 'B'//CHOPT1,XCUR1,YCUR1,.FALSE.,IFLCUR,YTOP,YBOTTM)
- CALL MZSDIV(IXSTOR,-7)
- CLINE = 'CWD: '
- CALL RZCDIR(CLINE(6:),'R')
- ILC = INDXBC(CLINE,' ')
- CALL DZDTXT(CLINE(1:ILC),
- + ILC,.25* GRIDX,YRANGE - 2.*CSIZE,1.5*CSIZE,0.,1)
-*
- IF(IWMETA .GT. 0 .AND. METAFL .EQ. 1
- + .AND. INDEX(CHOPT,'M').EQ. 0)THEN
- CALL IDAWK(IWMETA)
- CMMENU=' '
-* CALL IACWK(IWDISP)
- CMENU='DHCT'
- METAFL = 0
- ENDIF
-
-* get locator input and take action
-
- 20 CONTINUE
- ILKUSE = ILKSAV
-* build the menus
-
- GRIDX=GRIDSC*1./32.
- GRIDY=GRIDX
-
- X0MEN=.1*GRIDX
- Y0MEN= .1*GRIDY
- X1MEN=X0MEN+6.5*GRIDX
- Y1MEN=Y0MEN+FLOAT(NMITEM+1)*0.8*GRIDY
- CHITEM(1) = 'Quit'
- IF(INDEX(CHOPT1,'S').NE.0)THEN
- CHITEM(2)='Drop+Quit'
- ELSE
- CHITEM(2)=' '
- ENDIF
- IF(ILKACT.GT.0)THEN
- CHITEM(3)='Continue'
- ELSE
- CHITEM(3)=' '
- ENDIF
- CHITEM(4)='>Plotfile'
- CHITEM(5)='More keys'
- CHITEM(6)='Help'
- CHITEM(7)='LaTeX'
- CHUSER(1)=' '
- CHUSER(2)=' '
-* for more keys to input
- X0MODM=X1MEN+0.1*GRIDX
- Y0MODM=0.1*GRIDY
- X1MODM=X0MODM+12.*GRIDX
- Y1MODM=Y0MODM+FLOAT(NMODMN+2)*0.8*GRIDY
- CMODTI='Show more keys (CWD)'
- CMODMN(1) = 'First key '
- CMODDF(1) = '0'
- CMODMN(2) = 'Last key '
- CMODDF(2) = '0'
- CMODUS(1)='Quit'
- CMODUS(2)='Execute'
-
-* display the menu
- 30 CONTINUE
-
- CALL IGMENU(0,'Choice',X0MEN,X1MEN,Y0MEN,Y1MEN,
- + 0,CHUSER,NMITEM,CHITEM,
- + CTEMP,CTEMP,ICHOIC,'D'//CMMENU)
-
- IF(IWMETA .GT. 0 .AND. METAFL .EQ. 1)THEN
- METAFL=2
- CALL ICLRWK(IWMETA,0)
- CALL IDAWK(IWMETA)
- CMMENU=' '
-* CALL IACWK(IWDISP)
- CMENU='DHCT'
- GOTO 30
- ENDIF
-
- IF(IFOMED.EQ.3)THEN
- WRITE(LUNGRA,'(A)')' } '//BS//'ep'
- IFOMED=1
- ENDIF
-
- CALL IGMENU(0,'Choice',X0MEN,X1MEN,Y0MEN,Y1MEN,
- + 0,CHUSER,NMITEM,CHITEM,
- + CTEMP,CTEMP,ICHOIC,'CH')
- LNKLOC(5,IST) = LNKLOC(3,IST)
- IF(ICHOIC.EQ.-1000)GOTO 50
- IF(ICHOIC.NE.0)GOTO 35
- IF(ICHOIC.LE.0)THEN
- PX=RQUEST(11)*XRANGE
- PY=RQUEST(12)*YRANGE
- LNKLOC(5,IST) = LNKLOC(3,IST)
- CALL DZDRA1(IXSTOR, LNKLOC(3,IST), ILKUSE
- + , CHOPT1,PX,PY,.TRUE.,IFLCUR,YTOP,YBOTTM)
-*
- CALL MZSDIV(IXSTOR,-7)
- LSAVE = LNKLOC(3,IST)
- LNKLOC(3,IST) = LNKLOC(5,IST)
- LNKLOC(5,IST) = LSAVE
- GOTO 40
- ELSE
- LNKLOC(5,IST)=LNKLOC(3,IST)
- ENDIF
-* quit
-
-35 CONTINUE
- IF(ICHOIC.EQ.1)GOTO 50
- IF(ICHOIC.EQ.2)THEN
- IF(INDEX(CHOPT1,'S').NE.0)THEN
- GOTO 50
- ELSE
- GOTO 30
- ENDIF
- ENDIF
-* help
-
- IF(ICHOIC.EQ.6)THEN
- CALL DZDHLR
- GOTO 30
- ENDIF
-
-* continue with down banks
-
- IF(ILKACT.GT.0 .AND. ICHOIC.EQ.3)THEN
- LNKLOC(3,IST) = LNKLOC(5,IST)
- METAFL = 0
- GOTO 10
- ENDIF
-
-* LaTeX output
-
- IF(ICHOIC.EQ.7 .AND. METAFL.EQ.0)THEN
- LUNGRA=IQPRNT
- PAGECM=14./20.
- IFOMED=3
- WRITE(LUNGRA,'(A)')
- & ' '//BS//'bp(14,14)(0, 0) '//BS//
- & 'thicklines {'//BS//'small '//BS//'sf '
- GOTO 10
- ENDIF
-
-* write on metafile
-
- IF(ICHOIC.EQ.4 .AND. IWMETA.GT.0 .AND. METAFL.EQ.0)THEN
- METAFL = 1
- GOTO 10
- ENDIF
-
- IF(ICHOIC.EQ.5)THEN
- CMODVA(1)=' '
- CMODVA(2)=' '
- CALL IGMENU(0,CMODTI,X0MODM,X1MODM,Y0MODM,Y1MODM, 2,CMODUS,
- + NMODMN,CMODMN, CMODDF,CMODVA,ICHOIC,'CPD'//CMMENU)
-
-* quit?
- IF(ICHOIC.EQ.-1)GOTO 30
- IF(ICHOIC.EQ.-1000)GOTO 30
- CALL DZDCTI(CMODVA(1),N1)
- CALL DZDCTI(CMODVA(2),N2)
- IF(N1.GT.N2)THEN
- WRITE(6,*)' N2> N2'
- GOTO 30
- ENDIF
- CALL DZDSTK(IXSTOR,N1,N2,LNKLOC(5,IST))
- GOTO 30
- ENDIF
-
- 40 CONTINUE
-
-* very top bank selected
-* WRITE(*,*)IFLCUR,LNKLOC(5,IST)
- IF(IFLCUR .EQ. 1 .AND. LNKLOC(5,IST) .LE. 2)GOTO 50
-
-* set current working directory
- IF(IQ(KQS+LNKLOC(5,IST)+1) .EQ. 1)THEN
- NEXTRA = IQ(KQS+LNKLOC(5,IST)+2)
- NC = (IQ(KQS+LNKLOC(5,IST)-1)-NEXTRA)*4
- IF(NC.GT.LEN(CLINE))THEN
- WRITE(*,*)' Directory name too long ',NC
- GOTO 20
- ENDIF
- CLINE=' '
- CALL UHTOC(IQ(KQS+LNKLOC(5,IST)+NEXTRA+1),4,CLINE,NC)
- CALL RZCDIR(CLINE,' ')
-* go up or down
- IF(IFLCUR .EQ. 1 .OR. IFLCUR .EQ. 4)THEN
- IF(LNKLOC(3,IST) .NE. LNKLOC(5,IST))METAFL = 0
- LNKLOC(3,IST) = LNKLOC(5,IST)
- ILKACT = 0
- GOTO 10
- ENDIF
-* directory listing
- IF(IFLCUR .EQ. 3)THEN
- CALL RZLDIR(' ','A')
-* CMENU='HCT'
- GOTO 30
- ENDIF
-* print documentation
- IF(IFLCUR .EQ. 5 .OR. IFLCUR .EQ. 6 )THEN
- CALL CLTOU(CLINE)
- CALL DZDIRD(LUDORZ,CLINE,CLINE,0)
- GOTO 30
- ENDIF
- ENDIF
-* its in a key - box
- IF(IQ(KQS+LNKLOC(5,IST)+1) .EQ. 2)THEN
-* find directory of this key and set it
- LUP = LQ(KQS+LNKLOC(5,IST)+1)
- IF(LUP.EQ.0)GOTO 30
- NEXTRA = IQ(KQS+LUP+2)
- NC = (IQ(KQS+LUP-1)-NEXTRA)*4
- IF(NC.GT.LEN(CLINE))THEN
- WRITE(*,*)' Directory name too long ',NC
- GOTO 20
- ENDIF
- CLINE=' '
- CALL UHTOC(IQ(KQS+LUP+NEXTRA+1),4,CLINE,NC)
- CALL RZCDIR(CLINE,' ')
- IF(IFLCUR.EQ.3)THEN
- IFORM=JBYT(IQ(KQS+LNKLOC(5,IST)+2),1,3)
- IF(IFORM.NE.0)THEN
- WRITE(*,*)
- & ' Key contains a vector (see RZVOUT), format:',IFORM
- ENDIF
- KEYSEQ=IQ(KQS+LNKLOC(5,IST)+3)
- ICYCLE=IQ(KQS+LNKLOC(5,IST)+4)
- CALL RZIN(IDIVIS,LDATA,JB,KEYSEQ,ICYCLE,'S')
- IF(IQUEST(1).NE.0)THEN
- WRITE(*,*)'Error from RZIN,IQUEST(1)',IQUEST(1)
- LDATA=0
- ELSE
- WRITE(*,'(I6,A,A4)')
- & IQUEST(12),' words read, Top bank: ',IQ(KQS+LDATA-4)
- IF(INDEX(CHOPT1,'K').NE.0)THEN
- LUP = LQ(KQS+LNKLOC(5,IST)+1)
- NWK =IQ(KQS+LUP+4)
- NWKEYD=(NWK+3)/4
- IPKVAL =7+NWKEYD
- CALL MZBOOK(IDIVIS,LDATA,LDATA,0,'KEYW',0,0,NWK,0,0)
- CALL UCOPY(IQ(KQS+LNKLOC(5,IST)+IPKVAL),
- & IQ(KQS+LDATA+1),NWK)
- LDATA=LQ(KQS+LDATA+2)
-* update screen with cwd return to caller
-* CLINE = 'CWD: '
-* CALL RZCDIR(CLINE(6:),'R')
- ILC = INDXBC(CLINE,' ')
- CALL DZDTXT('CWD: '//CLINE(1:ILC),
- + ILC,.25* GRIDX,YRANGE - 2.*CSIZE,1.5*CSIZE,0.,1)
- GOTO 50
- ENDIF
- ENDIF
- ILKACT = 0
- GOTO 10
- ELSE
- NWK =IQ(KQS+LUP+4)
- NWKEYD=(NWK+3)/4
- NWK = MIN(NWK,400)
- IPKTAG =7+NWKEYD
- IPKVAL =7+NWKEYD
- WRITE(*,*)' Current directory: ',CLINE(1:NC)
- WRITE(*,*)' Tag Type Value'
- CALL UHTOC(IQ(KQS+LUP+7),4,CLINE,NWK)
- IPKTAG =7+NWKEYD
- IPKVAL =7+NWKEYD
- DO 45 IWK=1,NWK
- CALL UHTOC(IQ(KQS+LUP+IPKTAG) ,4,CHKEY,8)
- IVAL=IQ(KQS+LNKLOC(5,IST)+IPKVAL)
- IF(CLINE(IWK:IWK).EQ.'I')THEN
- IF(CHKEY(1:6).EQ.'TSTAMP')THEN
- CALL RZDATE(IVAL,IDATE1,ITIME1,1)
- WRITE(CTEMP,'(I6,A,I4)')IDATE1,'/',ITIME1
- ELSE
- CTEMP=' '
- ENDIF
- WRITE(*,'(1X,A,A,I11,2X,A)')
- & CHKEY,' Int',IVAL,CTEMP(1:11)
- ELSE
- WRITE(*,'(1X,A,A,A4)')
- & CHKEY,' Hol ',IVAL
- ENDIF
- IPKTAG=IPKTAG+2
- IPKVAL=IPKVAL+1
-45 CONTINUE
-* CALL DZDPTO(IWKTYP)
- ENDIF
- ENDIF
- GOTO 30
-
- 50 CONTINUE
- IF(INDEX(CHOPT1,'S').EQ.0 .OR. ICHOIC.EQ.2)THEN
- IF(LNKLOC(4,IST).NE.0)CALL MZDROP(IXSTOR,LNKLOC(4,IST),' ')
- LNKLOC(1,IST) = 0
- ENDIF
- IF(LACTWK) CALL IDAWK(IWDISP)
- RETURN
- END
-**********************************************************************
diff --git a/src/graflib/dzdoc/dzdraw/dzdisp.F b/src/graflib/dzdoc/dzdraw/dzdisp.F
deleted file mode 100644
index 64f596d..0000000
--- a/src/graflib/dzdoc/dzdraw/dzdisp.F
+++ /dev/null
@@ -1,672 +0,0 @@
-*
-* $Id: dzdisp.F,v 1.1.1.1 1996/03/04 16:13:06 mclareni Exp $
-*
-* $Log: dzdisp.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:06 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDISP(IXSTOR,LTOPIN,
- + RZPATH,CHOPT, IWDISP, IWMETA, ILOCNR, IWKTYP)
-*.
-*...DZDISP
-*.
-*. INPUT : IXSTOR Store index
-*. LTOPIN Link to top bank to be displayed
-*. RZPATH Pathname in RZ-file for bank documentation
-*. CHOPT Character option:
-*. 'N' dont activate workstation (done by caller)
-*. 'M' write on metafile also the menu boxes
-*. 'V' caller is DZDDIV
-*. 'W' call GSWKVP and GSWKWN
-*. 'L' return link of selected bank to caller
-*. in LTOPIN
-*. 'Q' handle "Modify data" as "Quit"
-*. 'D' draw the picture only, no locator requested
-*. 'G' continue with down banks
-*. IWDISP workstation Id for display (screen)
-*. IWMETA Id for possible metafile (0 if none)
-*. ILOCNR locator number for cursor input
-*. IWKTYP workstation type
-*.
-*. OUTPUT : none
-*.
-*. COMMON :
-*. SEQUENCE : DZDCHV DZDPRM MZCA MZCB QSTORE ZEBQ ZUNIT
-*. CALLS : DZDBOX DZDDAW DZDGET DZDGST DZDOCO DZDRAW DZDSYW
-*. CALLS : DZDTXT GACWK GCLRWK GDAWK GQCNTN GQNT
-*. CALLS : GSELNT RZCDIR UHTOC
-*. CALLED : USER
-*.
-*. AUTHOR : O.Schaile
-*. VERSION : 1.00
-*. CREATED : 11-Dec-87
-*. LAST MOD : 24-Dec-91 O.Schaile
-*.
-*. Modification Log.
-*. 4.Jun-88 Save LTOP, LRET by MZLINT
-*.
-*.**********************************************************************
-*.
- CHARACTER*(*) RZPATH, CHOPT
-*
-#include "zebra/zebq.inc"
-#include "zebra/mzca.inc"
-#include "zebra/mzcb.inc"
- INTEGER IQUEST(100)
- REAL RQUEST(100)
- EQUIVALENCE (IQUEST,RQUEST)
- COMMON/QUEST/RQUEST
-#include "zebra/zunit.inc"
-#include "dzdprm.inc"
-#include "dzdchv.inc"
-#if defined(CERNLIB_BSLASH)
-#include "dzdoc/bslash2.inc"
-#endif
-#if !defined(CERNLIB_BSLASH)
-#include "dzdoc/bslash1.inc"
-#endif
- CHARACTER CQSTAK*13,CQINFO*40
- PARAMETER (NLICHQ=130,NSTCHQ=8,NDVCHQ=8,NBKCHQ=4 )
- CHARACTER CQLINE*(NLICHQ),CQMAP(10)*(NLICHQ)
- CHARACTER CQSTOR*(NSTCHQ),CQDIV*(NDVCHQ),CQID*(NBKCHQ)
- COMMON /DZC1CH/ CQSTOR,CQDIV,CQID,CQMAP,CQSTAK,CQINFO
- EQUIVALENCE (CQLINE,CQMAP)
-* COMMON/DZDLK1/LAREF(2),LTOP,LSEL
- COMMON/DZDLK1/LNKLOC(4,0:15)
-#include "dzdzbrinc.inc"
- LOGICAL DZDINB
- EXTERNAL DZDINB
-*
- CHARACTER*12 CTEMP ,CHOPT1
- CHARACTER*4 CHOPDZ
- CHARACTER*100 CWDCUR
- CHARACTER*8 CHKEY,CHOPTM
- REAL RVALQ(11)
- PARAMETER(NMITEM=9, NPAR=6)
- CHARACTER*16 CHITEM(NMITEM),CHUSER(2),
- +CPNAME(NPAR), CPVAL(NPAR), CPDEF(NPAR)
- CHARACTER*8 CMENU
- PARAMETER (NMODMN=3)
- CHARACTER*8 CMODUS(2)
- CHARACTER*20 CMODTI
- CHARACTER*12 CMODMN(NMODMN)
- CHARACTER*12 CMODVA(NMODMN)
- CHARACTER*12 CMODDF(NMODMN)
- CHARACTER*1 CMMENU
-*
- INTEGER IFIRST,ILAST,KEYV(2), ITFONT,ITPREC, ILKACT,
- & LSAVE, INIFLG
- LOGICAL LACTWK,REQINP,NEWFIL
-* SAVE NEWFIL
-* SAVE INIFLG, METAFL,IPCSEQ, IOPFIL, ITFONT,ITPREC, ILKACT, LSAVE
-
- SAVE
-
- DATA NEWFIL/.TRUE./
- DATA IFIRST/0/, ILAST/0/, ITFONT/1/,ITPREC/0/
- DATA INIFLG/0/, IPCSEQ/0/, IOPFIL /0/
- DATA CHOPDZ/' '/,CHOPTM/'ADVS'/
-*----
- IF(LTOPIN.EQ.0)THEN
- WRITE(*,*)'DZDISP: Ltopin = 0'
- RETURN
- ENDIF
- CALL IGQWK(IWDISP,'OPEN',RVALQ)
- IF(RVALQ(1).LT.1. .AND. INDEX(CHOPT,'D').EQ.0)THEN
- WRITE(*,*)'DZDISP: Workstation', IWDISP, ' not open'
- RETURN
- ENDIF
-#include "zebra/qstore.inc"
- IST = JQSTOR
- IF(LTOPIN.NE.LSAVE)ILKACT=0
- LSAVE=LTOPIN
- IF(INDEX(CHOPT,'G').EQ.0) ILKACT = 0
-
- IF(INIFLG.EQ.0)THEN
- IDVERS=0
- INIFLG=1
- CALL DZDIBR
-* set values for menus
- GRIDX=GRIDSC*1./32.
- GRIDY=GRIDX
- CMMENU=' '
- X0MEN=1.-5.1*GRIDX
- Y0MEN= FLOAT(NPAR+2)*0.8*GRIDY
- X1MEN=X0MEN+5.*GRIDX
- Y1MEN=Y0MEN+FLOAT(NMITEM)*0.8*GRIDY
- X0PAR=1.- 10.1*GRIDX
- Y0PAR=0.1*GRIDY
- X1PAR=X0PAR+10.*GRIDX
- Y1PAR=Y0PAR+FLOAT(NPAR+1)*0.8*GRIDY
- X0MODM=X0PAR-14.1*GRIDX
- Y0MODM=0.1*GRIDY
- X1MODM=X0MODM+14.*GRIDX
- Y1MODM=Y0MODM+FLOAT(NMODMN+2)*0.8*GRIDY
- CMODUS(1) = 'Quit'
- CMODUS(2) = 'Execute'
- ENDIF
- CALL MZLINT(IXSTOR,'/DSDLK1/',
- +LNKLOC(1,IST),LNKLOC(3,IST),LNKLOC(4,IST))
- LNKLOC(3,IST) = LTOPIN
-
- IF(INDEX(CHOPT,'D').NE. 0)THEN
-* links for the browser
- IF(LTDFLG(IST).EQ.0)THEN
- CALL MZLINK(IXSTOR,'/DZDLKP/',
- & LTDISP(IST),LTDISP(IST),LTDISP(IST))
- LTDFLG(IST)=1
- IIST=0
- CALL SBYT(IST,IIST,27,6)
- DO 6 K=21,24
-6 CALL MZXREF(IXSTOR,K+IIST,'A')
- ENDIF
- NLKUSE=0
- IF(LTDISP(IST).NE.0)THEN
- IF(LTOPIN.EQ.LTDISP(IST))THEN
- WRITE(*,*)'Cant show this bank, owned by ZBROWSE'
- GOTO 175
- ENDIF
- CALL MZDROP(IXSTOR,LTDISP(IST),' ')
- LTDISP(IST)=0
- ENDIF
- IIST=20
- CALL SBYT(IST,IIST,27,6)
- CALL MZBOOK(IIST,LTDISP(IST),LTDISP(IST),1,'ZBR1',50,0,0,0,0)
- ISTUSE=IST
- ENDIF
- IF(INDEX(CHOPT,'C').NE. 0)THEN
- LFCOL=1
- ELSE
- LFCOL=0
- ENDIF
- CHOPT1 = ' '
- ILC = INDXBC(CHOPT,' ')
- IF(ILC .GT. 0)THEN
- CHOPT1(1:)=CHOPT(1:ILC)
- ENDIF
- ILC = ILC+1
- IF(RZPATH .NE. ' ')THEN
- CHOPT1(ILC:ILC) = 'R'
- CALL RZCDIR(CWDCUR,'R')
- CALL RZCDIR(RZPATH,' ')
- ENDIF
- IF(INDEX(CHOPT,'N').NE. 0)THEN
- LACTWK = .FALSE.
- ELSE
- LACTWK=.TRUE.
- ENDIF
-
- IFRDDV = INDEX(CHOPT,'V')
- CALL DZDGDV(CHOPT,IDV1)
- IF(IDV1.NE.0)IDVERS=IDV1
- XRANGE = 20.
- YRANGE = 20.
- CALL IGRNG( XRANGE, YRANGE)
-
- YBOTTM=0.
- IOPFIL=IQPRNT
- IF(LACTWK)CALL IACWK(IWDISP)
- METAFL = 0
- 10 CONTINUE
-* clear workstations
- CALL ICLRWK(0,0)
-* CALL HPLNEW
- IF(IWMETA .GT. 0 .AND. METAFL .EQ. 1)THEN
-* IF(IWDISP.NE.0)CALL IDAWK(IWDISP)
- CALL IACWK(IWMETA)
- CMMENU='M'
- ILKACT=ILKSAV
- IF(INDEX(CHOPT,'M').EQ.0)THEN
- IF(INDEX(CHOPT,'W').NE.0)THEN
- XAPA = .1465
- CALL ISWKWN(IWMETA,0.,1.,YBOTTM,1.)
- CALL ISWKVP(IWMETA,0.,XAPA,0.,XAPA*(1.-YBOTTM))
- ENDIF
- ENDIF
- CMENU='DT'
- CALL ICLRWK(0,0)
-* CALL ICLRWK(IWMETA,1)
- CALL ISFASI(-103)
- IPCSEQ=IPCSEQ+1
- IF(IPCSEQ. GT. 999)IPCSEQ=1
- CALL UHTOC(IQ(LNKLOC(3,IST)+KQS-4),4,CTEMP(1:4),4)
- WRITE(CTEMP(5:7),'(I3.3)')IPCSEQ
- ELSEIF(IFOMED.NE.3)THEN
- CALL ICLRWK(IWDISP,1)
- CALL ISFASI(-5)
- ENDIF
- ILKSAV = ILKACT
- CALL DZDRA1(IXSTOR, LNKLOC(3,IST), ILKACT
- + , CHOPT1,XCUR1,YCUR1,.FALSE.,IFLC,YTOP,YBOTTM)
-
-* with Motif the rest is done outside
-
- IF(INDEX(CHOPT,'D').NE.0)GOTO 170
-*
- CALL MZSDIV(IXSTOR,-7)
- IF(IWMETA .GT. 0 .AND. METAFL .EQ. 1 .AND. INDEX(CHOPT,'M').EQ.
- +0)GOTO 20
- LNKLOC(4,IST) = 0
- NT = 0
- IF(IWMETA .GT. 0 .AND. METAFL .EQ. 1
- + .AND. INDEX(CHOPT,'M').EQ. 0)THEN
- CALL IDAWK(IWMETA)
- CMMENU=' '
-* CALL IACWK(IWDISP)
- METAFL = 0
- ENDIF
-
-* get locator input and take action
-
- 20 CONTINUE
-
- ILKUSE = ILKSAV
- CHITEM(1) = 'Quit'
- IF(IFRDDV.NE.0)THEN
- CHITEM(2)='=>DZDDIV'
- ELSE
- CHITEM(2)=' '
- ENDIF
- IF(ILKACT.GT.0)THEN
- CHITEM(3)='Continue'
- ELSE
- CHITEM(3)=' '
- ENDIF
- IF(IWMETA.GT.0)CHITEM(4)='=>Plotf'
- CALL UHTOC(IQ(LNKLOC(3,IST)+KQS-4),4,CTEMP(1:4),4)
- CHITEM(5)='Modi '//CTEMP(1:4)
- CHITEM(6)='Drop '//CTEMP(1:4)
- CHITEM(7)='Help'
- CHITEM(8)='LaTeX'
- CHITEM(9)='TextStyl'
- CHUSER(1) = ' '
- CHUSER(2) = ' '
- CPNAME(1)='DZSHOW-O'
- CPDEF(1) = CHOPDZ
- CPNAME(2)='First W'
- CALL DZDPLA(IFIRST,CPDEF(2))
- CPNAME(3)='Last W'
- CALL DZDPLA(ILAST,CPDEF(3))
- CPNAME(4)='Unit-Nr'
- CALL DZDPLA(IQPRNT,CPDEF(4))
- CPNAME(5)='DZDTMP-O'
- CPDEF(5)=CHOPTM
- CPNAME(6)='DocVers'
- CALL DZDPLA(IDVERS,CPDEF(6))
-
-* display the menu
-
- 30 CONTINUE
- CALL IGMENU(0,'Choose',X0MEN,X1MEN,Y0MEN,Y1MEN,
- + 0,CHUSER,NMITEM,CHITEM,
- + CTEMP,CTEMP,ICHOIC,'DR'//CMMENU)
-
-* build the parameter menu
-* display the menu
- CALL IGMENU(0,'Parameters',X0PAR,X1PAR,Y0PAR,Y1PAR,
- + 0,CHUSER,NPAR,CPNAME,
- + CPDEF,CPVAL,ICHOIC,'PDR'//CMMENU)
-
- IF(IWMETA .GT. 0 .AND. METAFL .EQ. 1)THEN
- METAFL=2
- CALL IDAWK(IWMETA)
- CMMENU=' '
-* CALL IACWK(IWDISP)
- CMENU='DHCT'
- GOTO 30
- ENDIF
-
- IF(IFOMED.EQ.3)THEN
- WRITE(LUNGRA,'(A)')' } '//BS//'ep'
- IFOMED=1
- ENDIF
-
- LNKLOC(4,IST) = LNKLOC(3,IST)
-* request choice
- CALL IGMENU(0,'Choose',X0MEN,X1MEN,Y0MEN,Y1MEN,
- + 0,CHUSER,NMITEM,CHITEM,
- + CTEMP,CTEMP,ICHOIC,'RCH')
- IF(ICHOIC.EQ.-1000)ICHOIC=1
- IF(ICHOIC.NE.0)GOTO 70
-
- CALL IGMENU(0,'Parameter',X0PAR,X1PAR,Y0PAR,Y1PAR,
- + 0,CHUSER,NPAR,CPNAME,
- + CPDEF,CPVAL,ICHOIC,'RPCN')
-
- CHOPDZ=CPVAL(1)(1:4)
- CALL CLTOU(CHOPDZ)
- CHOPTM=CPVAL(5)(1:8)
- CALL DZDCTI(CPVAL(2),IFIRST)
- CALL DZDCTI(CPVAL(3),ILAST)
- CALL DZDCTI(CPVAL(4),IQPRNT)
- CALL DZDCTI(CPVAL(6),IDVERS)
- IF(IQPRNT .NE. IOPFIL)THEN
- IF(IOPFIL.NE.6 .AND. IOPFIL.NE.0)THEN
- CLOSE(UNIT=IOPFIL)
- ENDIF
- NEWFIL=.TRUE.
- IF(IQPRNT.NE.6 .AND. IQPRNT.NE.0)THEN
- CTEMP(1:3)='FOR'
- WRITE(CTEMP(4:6),'(I3.3)')IQPRNT
- CALL KUOPEN(IQPRNT, CTEMP(1:6)//'.dat','UNKNOWN',ISTAT)
- IF(ISTAT.EQ.0)THEN
- WRITE(*,*)' Output will go on file: ',CTEMP(1:6)//'.dat'
- ELSE
- WRITE(*,*)' Error opening print file'
- IQPRNT=6
- ENDIF
- ENDIF
- IOPFIL = IQPRNT
- ENDIF
- 50 CONTINUE
- DO 60 I=1,NPAR
- 60 CPDEF(I)=CPVAL(I)
-
- IF(ICHOIC.LE.0)THEN
- PX=RQUEST(11)*XRANGE
- PY=RQUEST(12)*YRANGE
-* WRITE(*,*)RQUEST(11),RQUEST(12)
- CMENU='HCD'
- REQINP = .TRUE.
- LNKLOC(4,IST) = LNKLOC(3,IST)
- CALL DZDRA1(IXSTOR,LNKLOC(3,IST),ILKUSE
- + ,CHOPT1, PX, PY, REQINP,IFLCUR,YTOP,YBOTTM)
- CALL MZSDIV(IXSTOR,-7)
- LSAVE = LNKLOC(3,IST)
- LNKLOC(3,IST) = LNKLOC(4,IST)
- LNKLOC(4,IST) = LSAVE
- ENDIF
-
- 70 CONTINUE
-
-* quit
-
- IF(ICHOIC.EQ.1)THEN
- IF(IFRDDV.NE.0)THEN
- IFQUIT=1
- ELSE
- IFQUIT=0
- ENDIF
- GOTO 170
- ENDIF
-
-* help
-
- IF(ICHOIC.EQ.7)THEN
- CALL DZDHLP
- CALL DZDPTO(IWKTYP)
- GOTO 20
- ENDIF
-* => DZDDIV
- IF(IFRDDV .NE. 0 .AND. ICHOIC.EQ.2)THEN
- IFQUIT=0
- GOTO 170
- ENDIF
-
-* continue with down banks
-
- IF(ILKACT .NE. 0 .AND. ICHOIC.EQ.3)THEN
- LNKLOC(3,IST) = LNKLOC(4,IST)
- METAFL = 0
- GOTO 10
- ENDIF
-
-* LaTeX output
-
- IF(ICHOIC.EQ.8 .AND. METAFL.EQ.0)THEN
- LUNGRA=IQPRNT
- PAGECM=14./20.
- IFOMED=3
- IF(NEWFIL)THEN
- NEWFIL=.FALSE.
- CALL DZDLPE(LUNGRA)
- ENDIF
- WRITE(LUNGRA,'(A)')
- & ' '//BS//'bp(14,14)(0, 0) '//BS//'thicklines {'
- & //BS//'small '//BS//'sf '
- GOTO 10
- ENDIF
-
- IF(IFOMED.EQ.3)THEN
- WRITE(LUNGRA,'(A)')' } '//BS//'ep'
- IFOMED=1
- ENDIF
-
-* write on metafile
-
- IF(ICHOIC.EQ.4 .AND. IWMETA .GT. 0 .AND. METAFL .EQ. 0)THEN
- METAFL = 1
- IFOMED=1
- GOTO 10
- ENDIF
-
-* Drop bank + dependents
- IF(ICHOIC.EQ.6)THEN
-* build the menu
- WRITE(CMODTI,'(A,A4)') 'Drop Bank/Tree ',IQ(LNKLOC(3,IST)+KQS-
- + 4)
- CALL IGMENU(0,CMODTI,X0MODM,X1MODM,Y0MODM,Y1MODM, 2,CMODUS,0,
- + CMODMN, CMODDF,CMODVA,ICHOIC,'CDR'//CMMENU)
-
-* quit?
- IF(ICHOIC.EQ.-1 .OR.ICHOIC.EQ.-1000)GOTO 80
- IF(ICHOIC.GE.0)GOTO 80
- CALL MZDROP(IXSTOR,LNKLOC(3,IST),' ')
- LNKLOC(3,IST)=0
- 80 CALL IGMENU(0,CMODTI,X0MODM,X1MODM,Y0MODM,Y1MODM, 2,CMODUS,0,
- + CMODMN, CMODDF,CMODVA,ICHOIC,'DR'//CMMENU)
-
- GOTO 10
- ENDIF
-
-* Modify data word
- IF(ICHOIC.EQ.5)THEN
- IF(INDEX(CHOPT,'Q').NE.0)THEN
- IF(IFRDDV.NE.0)THEN
- IFQUIT=1
- ELSE
- IFQUIT=0
- ENDIF
- GOTO 170
- ENDIF
-* build the menu
- CMODMN(1) = 'First word '
- CMODDF(1) = '1'
- CMODMN(2) = 'Last word '
- CMODDF(2) = '1'
- CMODMN(3) = 'New value '
- CMODDF(3) = ' '
- CMODVA(1)=' '
- CMODVA(2)=' '
- CMODVA(3)=' '
- WRITE(CMODTI,'(A,A4)') 'Modify data in ',IQ(LNKLOC(3,IST)+KQS-
- + 4)
- 90 CALL IGMENU(0,CMODTI,X0MODM,X1MODM,Y0MODM,Y1MODM, 2,CMODUS,
- + NMODMN,CMODMN, CMODDF,CMODVA,ICHOIC,'CPDR'//CMMENU)
-
-* quit?
- IF(ICHOIC.EQ.-1)GOTO 150
- IF(ICHOIC.EQ.-1000)GOTO 150
- IF(ICHOIC.GE.0)GOTO 90
- CALL DZDCTI(CMODVA(1),N1)
- IF(N1.GT.IQ(LNKLOC(3,IST)+KQS-1))THEN
- WRITE(6,*)' N1 bigger ND'
- GOTO 150
- ENDIF
- CALL DZDCTI(CMODVA(2),N2)
- IF(N2.GT.IQ(LNKLOC(3,IST)+KQS-1) .OR.N2 .LT. N1)THEN
-
- WRITE(6,*)' N2 > ND or N2 < N1'
- GOTO 150
- ENDIF
-* get old value
- IF(N1.GT.0)THEN
- CALL DZSHOW(' ',IXSTOR, LNKLOC(3,IST),'Q',1,0,N1,N1)
- ELSE
- WRITE(CQLINE(12:22),'(I11)') IQ(LNKLOC(3,IST)+KQS+N1)
-
- ENDIF
- IF(INDEX(CQLINE(12:22),'"').NE.0)THEN
- IOTYP=5
- ELSEIF(INDEX(CQLINE(12:22),'.').NE.0)THEN
- IOTYP=3
- ELSE
- IOTYP=2
- ENDIF
- IF(N1.EQ.N2)THEN
- WRITE(6,'(A,I6,A,A,A,Z9)') ' Word: ',N1,' Old value was: ',
- + CQLINE(12:22) ,' Hex:',IQ(LNKLOC(3,IST)+KQS+N1)
-
- ELSE
- CALL DZSHOW('Old values were: ', IXSTOR, LNKLOC(3,IST),' ',
- + 1,0,N1,N2)
- ENDIF
- IF(IOTYP.EQ.5)THEN
- IFC=INDEXC(CMODVA(3),' ')
- IF(IFC.GT.0)THEN
- CTEMP(1:4)=CMODVA(3)(IFC:IFC+3)
- ELSE
- CTEMP(1:4)=' '
- ENDIF
- DO 100 K=N1,N2
- 100 CALL UCTOH(CTEMP(1:4),IQ(LNKLOC(3,IST)+KQS+K),4,4)
- ELSEIF(IOTYP.EQ.3)THEN
- READ(CMODVA(3),'(F12.5)',ERR=140)REALVL
- DO 110 K=N1,N2
- 110 Q(LNKLOC(3,IST)+KQS+K)=REALVL
- ELSE
- CALL DZDCTI(CMODVA(3),INTEVL)
- DO 120 K=N1,N2
- 120 IQ(LNKLOC(3,IST)+KQS+K)=INTEVL
- ENDIF
- CMODDF(1)=CMODVA(1)
- CMODDF(2)=CMODVA(2)
- CMODDF(3)=CMODVA(3)
- GOTO 150
- 140 WRITE(6,'(A,A)')' Illegal real number ',CMODVA(3)
-
- 150 CALL IGMENU(0,CMODTI,X0MODM,X1MODM,Y0MODM,Y1MODM, 2,CMODUS,
- + NMODMN,CMODMN, CMODDF,CMODVA,ICHOIC,'E')
-
- GOTO 30
- ENDIF
-
-* text style
- IF(ICHOIC.EQ.9)THEN
-* build the menu
- CMODMN(1) = 'TextFont '
- WRITE(CMODDF(1),'(I5)')ITFONT
- CMODMN(2) = 'Prec '
- WRITE(CMODDF(2),'(I5)')ITPREC
- CMODMN(3) = 'SizeFact'
- WRITE(CMODDF(3),'(F5.2)')CSFACT
- CMODVA(1)=' '
- CMODVA(2)=' '
- CMODVA(3)=' '
- WRITE(CMODTI,'(A)') 'Set Text font+size '
- 95 CALL IGMENU(0,CMODTI,X0MODM,X1MODM,Y0MODM,Y1MODM, 2,CMODUS,
- + NMODMN,CMODMN, CMODDF,CMODVA,ICHOIC,'CPDR'//CMMENU)
-
-* quit?
- IF(ICHOIC.EQ.-1)GOTO 155
- IF(ICHOIC.EQ.-1000)GOTO 155
- IF(ICHOIC.GE.0)GOTO 95
- CALL DZDCTI(CMODVA(1),ITFONT)
- CALL DZDCTI(CMODVA(2),ITPREC)
- READ(CMODVA(3),'(F12.5)',ERR=145)CSFACT
- CALL ISTXFP(ITFONT,ITPREC)
- GOTO 155
- 145 WRITE(*,'(A,A)')' Illegal real number ',CMODVA(3)
-
- 155 CALL IGMENU(0,CMODTI,X0MODM,X1MODM,Y0MODM,Y1MODM, 2,CMODUS,
- + NMODMN,CMODMN, CMODDF,CMODVA,ICHOIC,'E')
-
- GOTO 30
- ENDIF
-
-* very top bank selected
-
- IF(IFLCUR .EQ. 1 .AND. LNKLOC(4,IST) .LE. 2)THEN
- IFQUIT=0
- GOTO 170
- ENDIF
-* display a bank or next bank selected
- IF(IFLCUR .EQ. 1 .OR. IFLCUR .EQ. 4)THEN
- IF(LNKLOC(3,IST) .NE. LNKLOC(4,IST))METAFL = 0
- LNKLOC(3,IST) = LNKLOC(4,IST)
- ILKACT = 0
- GOTO 10
- ENDIF
-* force DZDDWD with 'C' option
-* and DZDAW with W option
- IF(IFLCUR.EQ.3 .AND. INDEX(CHOPDZ,'C').NE.0)IFLCUR=6
- IF(IFLCUR.EQ.6 .AND. INDEX(CHOPDZ,'W').NE.0)IFLCUR=3
- IF(IFLCUR .EQ. 2)THEN
- CALL DZDSYW(IXSTOR,LNKLOC(4,IST),IQPRNT)
-* display links and system words
- ELSEIF(IFLCUR .EQ. 3)THEN
-* display data words
- LL=LNKLOC(4,IST)
- IF(IFIRST.LE.0)IFIRST=1
- IF(ILAST.GT.IQ(LL+KQS-1))ILAST=IQ(LL+KQS-1)
- IF(IFIRST.GT.ILAST)IFIRST=ILAST
- CALL DZDDAW(IXSTOR,LNKLOC(4,IST),CHOPDZ,IFIRST,ILAST)
- ELSEIF(IFLCUR .EQ. 5)THEN
-* display documentation + or make template for it
- WRITE(IQPRNT,'(A)')' '
- IDTEMP=1
- IF(RZPATH .NE. ' ')THEN
- KEYV(1)=IQ(KQS+LNKLOC(4,IST)-4)
- CALL UHTOC(KEYV(1),4,CHKEY,4)
- LUP = LQ(KQS+LNKLOC(4,IST)+1)
- IF(LUP .GT. 2)THEN
- KEYV(2)=IQ(KQS+LUP-4)
- CALL UHTOC(KEYV(2),4,CHKEY(5:8),4)
- ELSE
- CHKEY(5:8) = 'NONE'
- CALL UCTOH(CHKEY(5:8) ,KEYV(2),4,4)
- ENDIF
- ICYCLE=0
- CALL RZIN(0,LL,2,KEYV,ICYCLE,'C')
- IF(IQUEST(1).EQ.0)THEN
- IF(IDVERS.NE.0)THEN
- CALL DZDOCO(IQPRNT,CHKEY,'OR')
- ELSE
- CALL DZDOCO(IQPRNT,CHKEY,'R')
- ENDIF
- IDTEMP=0
- ENDIF
- ENDIF
- IF(IDTEMP.EQ.1)THEN
- CALL DZDTMP(IXSTOR,LNKLOC(4,IST),IQPRNT,CHOPTM)
- ENDIF
- ELSEIF(IFLCUR .EQ. 6)THEN
-* display data words with documentation
- IF(RZPATH .NE. ' ')THEN
- CALL DZDDW1(IXSTOR,LNKLOC(4,IST),
- & CHOPDZ,IFIRST,ILAST,IQPRNT)
- ELSE
- WRITE(*,*)' Sorry, no doc available'
- ENDIF
- ENDIF
- 160 CONTINUE
- CALL DZDPTO(IWKTYP)
- GOTO 30
- 170 CONTINUE
- IF(RZPATH .NE. ' ')THEN
- CALL RZCDIR(CWDCUR,' ')
- ENDIF
- IFWORD = IFIRST
- ILWORD = ILAST
- IF(INDEX(CHOPT,'L').NE.0)THEN
- IF(LNKLOC(4,IST).NE.0)THEN
- LTOPIN=LNKLOC(4,IST)
- ENDIF
- ENDIF
- 175 LNKLOC(1,IST) = 0
- IF(LACTWK) CALL IDAWK(IWDISP)
- RETURN
- END
-
diff --git a/src/graflib/dzdoc/dzdraw/dzdlbx.F b/src/graflib/dzdoc/dzdraw/dzdlbx.F
deleted file mode 100644
index cd4ebe1..0000000
--- a/src/graflib/dzdoc/dzdraw/dzdlbx.F
+++ /dev/null
@@ -1,55 +0,0 @@
-*
-* $Id: dzdlbx.F,v 1.1.1.1 1996/03/04 16:13:12 mclareni Exp $
-*
-* $Log: dzdlbx.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:12 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDLBX(X0,Y0,IFL,ILL,NSREAL)
-*.
-*...DZDLBX draw a link box indicating a range of links
-*.
-*. INPUT : X0, Y0 position for the box
-*. IFL,ILL first, last link number
-*. SEQUENCE : DZDCHV DZDPRM
-*. CALLS : DZDBOX DZDTXT
-*. CALLED : DZDRA2
-*.
-*. AUTHOR : O.Schaile
-*. VERSION : 1.00
-*. CREATED : 11-Dec-87
-*.********************************************************************
-*.
-#include "dzdprm.inc"
-#include "dzdchv.inc"
-*
- IF(IFL.GT.0 .AND. ILL.GT.0 .AND. ILL.LT.IFL)GOTO 999
- IF(ILL.GT.NSREAL)CALL ISLN(3)
- CALL DZDBOX(X0-4.*DXLK, X0, Y0, Y0+DYB,1000*IFLDIR+0)
- IF(ILL.GT.NSREAL)CALL ISLN(1)
- CLINE=' '
- WRITE(CLINE(73:80),'(I8)')IFL
- IS = INDEXC(CLINE,' ')
- CLINE(IS-2:IS-1) = '..'
- IS = IS - 2
- IF(ILL .LT. 0)THEN
- CLINE(IS-2:IS-1)= '**'
- ELSE
- WRITE(CLINE(IS-8:IS-1),'(I8)')ILL
- ENDIF
- IS = INDEXC(CLINE,' ')
- IF(IS .EQ. 0)IS = 1
-* left
-* XT= X0-4.*DXLK+0.1*CSIZE
-* YT= Y0 + 0.15*CSIZE
-* IALG=1
-* left
- XT= X0-2.*DXLK
- YT= Y0 + 0.5*DYB
-* centered
- IALG = 2
- CALL DZDTXT(CLINE(IS:),80-IS+1,XT,YT,CSIZE,0.,IALG)
-999 END
-**********************************************************************
diff --git a/src/graflib/dzdoc/dzdraw/dzdlft.F b/src/graflib/dzdoc/dzdraw/dzdlft.F
deleted file mode 100644
index 7b3a76b..0000000
--- a/src/graflib/dzdoc/dzdraw/dzdlft.F
+++ /dev/null
@@ -1,51 +0,0 @@
-*
-* $Id: dzdlft.F,v 1.1.1.1 1996/03/04 16:13:18 mclareni Exp $
-*
-* $Log: dzdlft.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:18 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDLFT(LDESC,LP,L,JB)
-#include "dzdoc/bkwrp.inc"
- DIMENSION IDSBNK(5)
-
- IDSBNK(1) = IQ(KQSP+LDESC+7)
- NSA=IQ(KQSP+LDESC+2)
- IF(NSA .GE. 0)THEN
- IDSBNK(3) = NSA
- ELSE
- IDSBNK(3) = 1
- ENDIF
- NLDOC = IQ(KQSP+LDESC+5)
- IF(NLDOC .GT. IDSBNK(3)) THEN
- IF(NSA.LT.0)THEN
- IDSBNK(3)=NLDOC
- IQ(KQSP+LDESC+2)=-1
- IQ(KQSP+LDESC+1)=-1
-* ELSE
-* IDSBNK(3)=MAX(NSA,NLDOC)
- ENDIF
- ENDIF
- IF(IQ(KQSP+LDESC+1) .GE. 0)THEN
- IDSBNK(2) = IQ(KQSP+LDESC+1)
- ELSE
- IDSBNK(2) = 1
- ENDIF
- IF(IDSBNK(2) .LT. IDSBNK(3))IDSBNK(2)=IDSBNK(3)
- IF(JB.EQ.1)THEN
- IDSBNK(4)=4
- ELSE
- IDSBNK(4) = 3
- ENDIF
- IDSBNK(5) = 2
- CALL MZLIFT(0,L,LP,JB,IDSBNK,0)
- IQ(KQSP+L+1) = IQ(KQSP+LDESC+3)
- IQ(KQSP+L+2) = IQ(KQSP+LDESC+2)
- IQ(KQSP+L+3) = IQ(KQSP+LDESC+1)
- IF(JB.EQ.1)THEN
- IQ(KQSP+L+4) = IQ(KQSP+LDESC+9)
- ENDIF
- END
-***********************************************************************
diff --git a/src/graflib/dzdoc/dzdraw/dzdlfx.F b/src/graflib/dzdoc/dzdraw/dzdlfx.F
deleted file mode 100644
index 089f0ca..0000000
--- a/src/graflib/dzdoc/dzdraw/dzdlfx.F
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: dzdlfx.F,v 1.1.1.1 1996/03/04 16:13:18 mclareni Exp $
-*
-* $Log: dzdlfx.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:18 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDLFX(LP,JB,CHID)
- CHARACTER*(*) CHID
-#include "dzdoc/bkwrp.inc"
- CALL MZBOOK(0,L,LP,JB,CHID,0,0,3,2,0)
- IQ(KQSP+L+1) = -1
- IQ(KQSP+L+2) = -1
- IQ(KQSP+L+3) = -1
- END
-***********************************************************************
diff --git a/src/graflib/dzdoc/dzdraw/dzdli2.F b/src/graflib/dzdoc/dzdraw/dzdli2.F
deleted file mode 100644
index 992fee2..0000000
--- a/src/graflib/dzdoc/dzdraw/dzdli2.F
+++ /dev/null
@@ -1,40 +0,0 @@
-*
-* $Id: dzdli2.F,v 1.1.1.1 1996/03/04 16:13:12 mclareni Exp $
-*
-* $Log: dzdli2.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:12 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDLI2(N,XP,YP,IATT)
-*.
-*...DZDLI2 draw a polyline with optionally an arrow at the end
-*.
-*. INPUT : N number of coordinates (
-*. XP, YP x-y values of polyline for (1..N-1)
-*. XP(N),YP(N) parameters for the arrow
-*.
-*. CALLS : DZDFLA GPL
-*. CALLED : DZDBNK, DZDHEA, DZDLNK
-*.
-*. AUTHOR : O.Schaile
-*. VERSION : 1.00
-*. CREATED : 11-Dec-87
-*.********************************************************************
-*.
-#include "dzdprm.inc"
- REAL XP(2), YP(2)
- IF(N .LE. 1)GOTO 10
- IF(IFOMED.EQ.3)THEN
- N1=-N+1
- CALL DZDGPL(N1,XP,YP)
- GOTO 10
- ENDIF
- CALL DZDGPL(N-1,XP,YP)
- IF(XP(N) .GT. 1.E-10)THEN
- CALL DZDFLA(XP(N-1),YP(N-1),XP(N),YP(N))
- ENDIF
- 10 CONTINUE
- END
-***********************************************************************
diff --git a/src/graflib/dzdoc/dzdraw/dzdlnk.F b/src/graflib/dzdoc/dzdraw/dzdlnk.F
deleted file mode 100644
index 5279ea9..0000000
--- a/src/graflib/dzdoc/dzdraw/dzdlnk.F
+++ /dev/null
@@ -1,47 +0,0 @@
-*
-* $Id: dzdlnk.F,v 1.1.1.1 1996/03/04 16:13:12 mclareni Exp $
-*
-* $Log: dzdlnk.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:12 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDLNK(X01, Y01, X02, Y02, ILINK, NSREAL)
-*.
-*...DZDLNK draw a linkbox + the link to a bank
-*.
-*. INPUT : X01, Y01 position of link box
-*. X02, Y02 the endpoint of the link
-*. ILINK the link number
-*. NSREAL number of structural links
-*. SEQUENCE : DZDPRM
-*. CALLS : DZDLI2 DZDSBX
-*. CALLED : DZDRA2
-*.
-*. AUTHOR : O.Schaile
-*. VERSION : 1.00
-*. CREATED : 11-Dec-87
-*.**********************************************************************
-*.
-#include "dzdprm.inc"
- REAL XPOL(10), YPOL(10)
-*----
-* box for link in mother bank
- CALL DZDSBX(X01,Y01,ILINK,NSREAL)
-* line to bank
- XPOL(1) = X01 + 0.5*DXLK
- YPOL(1) = Y01
- XPOL(2) = XPOL(1)
- YPOL(2) = Y02 + DYB + 0.5*GRIDY
- XPOL(3) = X02 + 0.5 * DXB
- YPOL(3) = YPOL(2)
- XPOL(4) = XPOL(3)
- YPOL(4) = Y02 + DYB
- XPOL(5) = ARRLEN
- YPOL(5) = 270.
- IF(ILINK.GT.NSREAL)CALL ISLN(3)
- CALL DZDLI2(5,XPOL,YPOL,0)
- IF(ILINK.GT.NSREAL)CALL ISLN(1)
- END
-**********************************************************************
diff --git a/src/graflib/dzdoc/dzdraw/dzdlpe.F b/src/graflib/dzdoc/dzdraw/dzdlpe.F
deleted file mode 100644
index 590bf2a..0000000
--- a/src/graflib/dzdoc/dzdraw/dzdlpe.F
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: dzdlpe.F,v 1.1.1.1 1996/03/04 16:13:07 mclareni Exp $
-*
-* $Log: dzdlpe.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:07 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDLPE(LUNSGM)
-#if defined(CERNLIB_BSLASH)
-#include "dzdoc/bslash2.inc"
-#endif
-#if !defined(CERNLIB_BSLASH)
-#include "dzdoc/bslash1.inc"
-#endif
- WRITE(LUNSGM,'(15(1A/))')
- +BS//'setlength{'//BS//'unitlength}{1cm}',
- +BS//'newcommand{'//BS//'p}{'//BS//'put}',
- +BS//'newcommand{'//BS//'mup}{'//BS//'multiput}',
- +BS//'newcommand{'//BS//'f}{'//BS//'framebox}',
- +BS//'newcommand{'//BS//'m}{'//BS//'makebox}',
- +BS//'renewcommand{'//BS//'l}{'//BS//'line}',
- +BS//'renewcommand{'//BS//'v}{'//BS//'vector}',
- +BS//'newcommand{'//BS//'bp}{'//BS//'begin{picture}}',
- +BS//'newcommand{'//BS//'ep}{'//BS//'end{picture}}'
- RETURN
- END
-***********************************************************************
diff --git a/src/graflib/dzdoc/dzdraw/dzdmnt.F b/src/graflib/dzdoc/dzdraw/dzdmnt.F
deleted file mode 100644
index 840c1f6..0000000
--- a/src/graflib/dzdoc/dzdraw/dzdmnt.F
+++ /dev/null
@@ -1,188 +0,0 @@
-*
-* $Id: dzdmnt.F,v 1.1.1.1 1996/03/04 16:13:05 mclareni Exp $
-*
-* $Log: dzdmnt.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:05 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDMNT(IXDIV,LIN)
- INTEGER IXDIV,LIN
-#include "zebra/mqsys.inc"
-*--
- CHARACTER CQSTAK*13,CQINFO*40
- PARAMETER (NLICHQ=130,NSTCHQ=8,NDVCHQ=8,NBKCHQ=4 )
- CHARACTER CQLINE*(NLICHQ),CQMAP(10)*(NLICHQ)
- CHARACTER CQSTOR*(NSTCHQ),CQDIV*(NDVCHQ),CQID*(NBKCHQ)
- COMMON /DZC1CH/ CQSTOR,CQDIV,CQID,CQMAP,CQSTAK,CQINFO
- EQUIVALENCE (CQLINE,CQMAP)
-*--
-#include "dzdzbrinc.inc"
- INTEGER MAXS, MAXV
- PARAMETER (MAXS=10, MAXV=100, MAXAN=5)
- COMMON/DZDNTS/ ISVAR(MAXS), IVVAR(MAXV+1,MAXAN)
-
- REAL XNTVAL(MAXS)
- EQUIVALENCE(ISVAR,XNTVAL)
-*--
-* INTEGER IAFLAG(MAXS)
- INTEGER NCOLV, NVAL, NP
- SAVE NCOLV
-*--
- INTEGER IWORDF, IWORDL, NCH, NSTEPS, LUP, LORIG, L, LL
- & ,IOCH, INIFLG, NSU, ITYPE
- SAVE INIFLG, IOCH
- CHARACTER*8 CNAME, SPACES, VTYPE
- CHARACTER*4 CHOPT
- DATA INIFLG/0/
-*---
- IF(INIFLG.EQ.0)THEN
- INIFLG=1
- CALL MZIOCH(IOCH,1,'4H -I')
- NCOLV=0
- ENDIF
- CALL MZSDIV(IXDIV,-7)
- ISTORE = JBYT(IXDIV,27,6)
-
-* init link area for store
-
- IF(LZEFLG(ISTORE).EQ.0)THEN
- CALL MZLINK(IXDIV,'DZDZEB',
- & LZEBLK(1,ISTORE),LZEBLK(3,ISTORE),LZEBLK(3,ISTORE))
- LZEFLG(ISTORE)=1
- ENDIF
-
- CALL KUGETC(VTYPE,NCH)
- CALL CLTOU(VTYPE)
- CALL KUGETI(IWORDF)
- CALL KUGETI(IWORDL)
- CALL KUGETC(CNAME,NCH)
-* CALL KUGETC(CHLOOP,NCH)
- CALL KUGETC(CHOPT,NCH)
-
- IF(IWORDF.EQ.0 .AND. CNAME.EQ.' ')THEN
- WRITE(*,*)'No variable defined'
- GOTO 999
- ENDIF
-* new set of ntuples?
- IF(INDEX(CHOPT,'N').NE.0)THEN
- IF(LZEBLK(2,ISTORE).NE.0)THEN
- CALL MZDROP(IXDIV,LZEBLK(2,ISTORE),'L')
- LZEBLK(2,ISTORE)=0
- ISTNTU=0
- ENDIF
- NCOLV=0
- CALL KUPVAL('MARK_NT','COPT',0,0.,' ','D')
- ENDIF
-* find data type
- IF(IWORDF.GT.0)THEN
- IF(IQ(KQS+LIN-1).LT.IWORDF .OR.IQ(KQS+LIN-1).LT.IWORDL)THEN
- WRITE(*,*)'Bank has only',IQ(KQS+LIN-1),' data words'
- GOTO 999
- ENDIF
- CALL DZSHOW(' ',IXDIV, LIN,'Q',1,0,IWORDF,IWORDF)
- IF (INDEX(CQLINE(13:24),'"').NE.0)THEN
- ITYPE=5
- ELSE IF(INDEX(CQLINE(13:24),'.').NE.0)THEN
- ITYPE=3
- ELSE
- ITYPE=2
- ENDIF
- NVAL=0
- ELSE
- IF(NCOLV.LT.MAXAN)THEN
- NCOLV=NCOLV+1
- NVAL=MAXV
- CALL DZDGVA(IXDIV,LIN,'VQP',CNAME,NVAL,IVVAR(2,NCOLV),ITYPE)
- IF(ITYPE.LE.0)THEN
- WRITE(*,'(A,A)')CNAME,' not found'
- GOTO 999
- ENDIF
- ELSE
- WRITE(*,*)'Max number of array type Ntuple reached:',NCOLV
- GOTO 999
- ENDIF
- ENDIF
- IF(LZEBLK(2,ISTORE).EQ.0)THEN
- ISTNTU=ISTORE
- ELSE
- IF(ISTNTU.NE.ISTORE)THEN
- WRITE(*,*)'Variable is not in store',ISTNTU
- GOTO 999
- ENDIF
- ENDIF
-
-* get number of steps back
-
- L=LIN
- NSTEPS=0
-10 CONTINUE
- LUP=LQ(KQS+L+1)
- IF(LUP.NE.0)THEN
- NSTEPS=NSTEPS+1
- LORIG=LQ(KQS+L+2)
- L=LUP
- IF(LORIG .GT. 2)THEN
- NSU = IQ(KQS+LUP-2)
- IF(LORIG .GT. LUP .OR. LORIG .LT. LUP-NSU) L=LORIG
- ENDIF
- GOTO 10
- ENDIF
-
-* book a bank to store the path etc
-
- NP=ABS(NVAL)+1
- CALL MZBOOK(IXDIV,LL,LZEBLK(2,ISTORE),1,'PATH',
- & 0,0,NP+NSTEPS+8,IOCH,0)
- IF(CNAME.NE.' ')THEN
- CALL UCTOH(CNAME,IQ(KQS+LL+1),4,8)
- ELSE
- WRITE(CNAME,'(I8)')IWORDF
- CALL UHTOC(IQ(KQS+LIN-4),4,CNAME,4)
- CNAME=SPACES(CNAME,0)
- CALL UCTOH(CNAME,IQ(KQS+LL+1),4,8)
- ENDIF
- IQ(KQS+LL+3)=IQ(KQS+LIN-4)
- IF(LQ(KQS+LIN+1).NE.0)THEN
- IQ(KQS+LL+4)=IQ(KQS+LQ(KQS+LIN+1)-4)
- ELSE
- CALL UCTOH('NONE',IQ(KQS+LL+4),4,4)
- ENDIF
- IQ(KQS+LL+5)=NSTEPS
-
-* fill the path
-
- L=LIN
- NSTEPS=6
-20 CONTINUE
- LUP=LQ(KQS+L+1)
- IF(LUP.NE.0)THEN
- LORIG=LQ(KQS+L+2)
- IF(LORIG .GT. 2)THEN
- NSU = IQ(KQS+LUP-2)
- IF(LORIG .GT. LUP .OR. LORIG .LT. LUP-NSU)THEN
- JB = 0
- ELSE
- JB = LUP-LORIG
- ENDIF
- IQ(KQS+LL+NSTEPS)=JB
- NSTEPS=NSTEPS+1
- ENDIF
- IF(JB.EQ.0)THEN
- L=LORIG
- ELSE
- L=LUP
- ENDIF
- GOTO 20
- ENDIF
- IQ(KQS+LL+NSTEPS)=IWORDF
-* IQ(KQS+LL+NSTEPS+1)=IWORDL
- IF(INDEX(VTYPE,'ARR').NE.0 .OR.
- & INDEX(VTYPE,'MUL').NE.0)ITYPE=-ITYPE
- IQ(KQS+LL+NSTEPS+2)=ITYPE
- IQ(KQS+LL+NSTEPS+3)=NVAL
- IF(NVAL.GT.0)CALL UCOPY(IVVAR(2,NCOLV),IQ(KQS+LL+NSTEPS+4),NVAL)
-999 END
-
-***********************************************************************
diff --git a/src/graflib/dzdoc/dzdraw/dzdmrz.F b/src/graflib/dzdoc/dzdraw/dzdmrz.F
deleted file mode 100644
index fb46ae6..0000000
--- a/src/graflib/dzdoc/dzdraw/dzdmrz.F
+++ /dev/null
@@ -1,81 +0,0 @@
-*
-* $Id: dzdmrz.F,v 1.1.1.1 1996/03/04 16:13:19 mclareni Exp $
-*
-* $Log: dzdmrz.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:19 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDMRZ(LUNSRC,LUNRZF,CHDOC,CHRZFI,CHSUB,IRET)
- INTEGER LUNSRC,LUNRZF,IRET
- CHARACTER*(*) CHDOC,CHRZFI,CHSUB
- COMMON/QUEST/IQUEST(100)
-#include "dzdoc/dzdocc.inc"
- INTEGER NWKEY,MAXKEY,LRECL,NKEYS,ICYCLE
- PARAMETER(NWKEY = 2,MAXKEY=2000,LRECL=256)
- INTEGER KEYS(NWKEY,MAXKEY), IC1000
- CHARACTER*8 CHTAG(2)
- CHARACTER*4 CHIDBK,CHIDUP
- LOGICAL EXST
- DATA CHTAG/'Bank-ID','Bank-ID'/
- CALL DZDINI
-* CALL DZEZER
-
- IRET=0
- CALL RZCDIR('//RZDOC',' ')
- CALL RZSTAT('//RZDOC',2,'Q')
- IF(IQUEST(11).LE.0)THEN
- INQUIRE(FILE=CHRZFI, EXIST=EXST)
- IF(EXST)THEN
- WRITE(*,*)'RZ-file exists already, rename or delete it'
- IRET=1
- GOTO 30
- ENDIF
- CALL RZOPEN(LUNRZF,'RZDOC',CHRZFI,'NX',LRECL,IRET)
- IF(IRET.NE.0)GOTO 30
- CALL RZMAKE(LUNRZF,'RZDOC',2,'HH',CHTAG,5000,'X')
- ELSE
-* WRITE(*,*)'RZ-file was already open'
- IRET=0
- ENDIF
- IRET=0
- IF(CHSUB .NE. ' ')THEN
- CALL RZMDIR(CHSUB,2,'HH',CHTAG)
- CALL RZCDIR(CHSUB,' ')
- ENDIF
-
- IF(CHDOC.EQ.' ')GOTO 30
- IC1000=1000000
- CALL KUOPEN(LUNSRC,CHDOC,'OLD',IRET)
-
-*-- Read the input file and build the RZ file
-
- CALL DZDOCM(LUNSRC,0,'R')
- CLOSE(UNIT=LUNSRC)
- CALL RZSAVE
-
-C-- Check the RZ file
-* CALL RZSTAT(' ',9,' ')
-* CALL RZLDIR(' ',' ')
-
- CALL RZKEYS(2,MAXKEY,KEYS,NKEYS)
- WRITE(6,'(I6,A)')NKEYS, ' keys entered into RZ-file'
- LBQBKD = 0
- DO 10 I=1,NKEYS
-* IF(LBQBKD .NE. 0)THEN
-* CALL MZDROP(0,LBQBKD,' ')
-* LBQBKD = 0
-* ENDIF
- CALL RZIN(0,LBQBKD,2,KEYS(1,I),IC1000,'C')
- ICYCLE = IQUEST(6)
- IF(ICYCLE .NE. 1)THEN
- CALL UHTOC(KEYS(1,I),4,CHIDBK,4)
- CALL UHTOC(KEYS(2,I),4,CHIDUP,4)
- WRITE(*,'(A,A,A,A)') CHIDBK,'/',CHIDUP,
- + ' Multiply defined entry'
- ENDIF
- 10 CONTINUE
- 30 CONTINUE
- END
-***********************************************************************
diff --git a/src/graflib/dzdoc/dzdraw/dzdnbk.F b/src/graflib/dzdoc/dzdraw/dzdnbk.F
deleted file mode 100644
index f8218eb..0000000
--- a/src/graflib/dzdoc/dzdraw/dzdnbk.F
+++ /dev/null
@@ -1,122 +0,0 @@
-*
-* $Id: dzdnbk.F,v 1.1.1.1 1996/03/04 16:13:16 mclareni Exp $
-*
-* $Log: dzdnbk.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:16 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDNBK(IXDIVP,LGOP,LBNK,LFW,LLW,IDH,IDRFLG)
-
-*.
-*...DZDNBK
-*.
-*. FIND NEXT BANK IN DIV. IXDIV AFTER BANK AT LGOP
-*.
-*. INPUT : IXDIVP division index
-*. LGOP link to bank to start with
-*.
-*. OUTPUT : LBNK link to bank (0 if not found)
-*. LFW, LLW first, last address of bank
-*. IDH hollerith Id of bank
-*. IDRFLG drop flag (1 if dropped)
-*.
-*. COMMON :
-*. SEQUENCE : MZBITS MZCA MZCB MZCC MZCN QUEST ZEBQ
-*. CALLS : MZCHLN MZCHLS MZSDIV ZFATAL
-*. CALLED :
-*.
-*. AUTHOR : O. Schaile
-*. VERSION : 1.00
-*. CREATED : 3-Feb-88
-*.**********************************************************************
-*.
-
-*
-#include "zebra/mzbits.inc"
-#include "zebra/quest.inc"
-#include "zebra/zebq.inc"
-#include "zebra/mzca.inc"
-#include "zebra/mzcb.inc"
-#include "zebra/mzcc.inc"
-#include "zebra/mzcn.inc"
-C-------------- END CDE --------------
- DIMENSION IXDIVP(9), LGOP(9)
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HDZDN, 4HBK /
-
- IXIN = IXDIVP(1)
-* IDH = IDHP(1)
-* IDN = IDNP(1)
- LGO = LGOP(1)
-
- CALL MZSDIV (IXIN,1)
- LSTA = LQSTA(KQT+JQDIVI)
- IQNX = LSTA
- LEND = LQEND(KQT+JQDIVI)
-
- IF (LGO.EQ.0) GO TO 10
-
- IF (LGO.LT.LSTA) GO TO 50
- IF (LGO.GE.LEND) GO TO 50
-
- CALL MZCHLS (-7,LGO)
-* IF (IQFOUL.NE.0) GO TO 92
-
- IF(IQFOUL.NE.0)THEN
- WRITE(*,*)' Error from MZCHLS, IQFOUL',IQFOUL
- WRITE(*,'(A)')IQ(KQS+LGO-4)
- WRITE(*,*)' Dump around link (-+10)'
- WRITE(*,'(4(5Z9/))')(IQ(KQS+LGO+K),K=-10,10)
- ENDIF
-
- 10 LN = IQNX
- IF (LN.GE.LEND) GO TO 20
- CALL MZCHLN (-7,LN)
- IF (IQFOUL.NE.0) GO TO 30
- IF (IQND.LT.0) GO TO 10
-* IF (IQ(KQS+IQLS-5).NE.IDN) GO TO 31
-* IF (IQID.NE.IDH) GO TO 31
- IF (JBIT(IQ(KQS+IQLS),IQDROP).NE.0)THEN
- IDRFLG = 1
- ELSE
- IDRFLG = 0
- ENDIF
- ND = IQ(KQS+IQLS-1)
- NIO = JBYT(IQ(KQS+IQLS),19,4)
- NL = IQ(KQS+IQLS-3)
- NSYS = NIO + NL + 10
- LFW = IQLS - NL - NIO - 1
- LLW = LFW + NSYS + ND
- IDH = IQID
- LBNK = IQLS
- RETURN
-
- 20 LBNK = 0
- RETURN
-
-C------ ERROR CONDITIONS
-
- 30 NQCASE = 1
- NQFATA = 1
- IQUEST(17) = LN
- 40 NQCASE = NQCASE + 1
- 50 NQCASE = NQCASE + 1
- NQFATA = NQFATA + 6
- IQUEST(11) = IXIN
- IQUEST(12) = IDH
- IQUEST(13) = 0
- IQUEST(14) = LGO
- IQUEST(15) = LSTA
- IQUEST(16) = LEND
-*
- WRITE(*,*)' Problems in DZDNBK, NQCASE, IQUEST(11:17)'
- WRITE(*,*) NQCASE, (IQUEST(K),K=11,17)
- WRITE(*,*)' Error from MZCHLS, IQFOUL',IQFOUL
- WRITE(*,'(A)')IQ(KQS+LGO-4)
- WRITE(*,*)' Dump around link (-+20)'
- WRITE(*,'(100(5Z9/))')(IQ(KQS+LGO+K),K=-20,20)
- GOTO 20
- END
-***********************************************************************
diff --git a/src/graflib/dzdoc/dzdraw/dzdndi.F b/src/graflib/dzdoc/dzdraw/dzdndi.F
deleted file mode 100644
index d9b382c..0000000
--- a/src/graflib/dzdoc/dzdraw/dzdndi.F
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: dzdndi.F,v 1.1.1.1 1996/03/04 16:13:03 mclareni Exp $
-*
-* $Log: dzdndi.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:03 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDNDI(CDIR,ICONT,IRET)
-* IMPLICIT NONE
- CHARACTER*(*) CDIR
- INTEGER MAXDIR
- PARAMETER (MAXDIR=100)
- INTEGER ICONT,JCONT,IRET, IP, NDIR, I
- SAVE JCONT, IP, NDIR
- CHARACTER*16 CDIRS(MAXDIR)
- SAVE CDIRS
- DATA JCONT,NDIR /0, 0/
-*
- IF(ICONT.EQ.0)THEN
-* new dir requested
- DO I=1,MAXDIR
- CDIRS(I)= ' '
- ENDDO
- CALL RZRDIR(MAXDIR,CDIRS,NDIR)
- ICONT=0
- IP=0
- ENDIF
- IF(IP.GE.NDIR)THEN
- CDIR=' '
- ICONT=0
- IRET=0
- ELSE
- IP=IP+1
- ICONT=ICONT+1
- CDIR=CDIRS(IP)
- IRET=0
- ENDIF
-999 END
-***********************************************************************
diff --git a/src/graflib/dzdoc/dzdraw/dzdnfz.F b/src/graflib/dzdoc/dzdraw/dzdnfz.F
deleted file mode 100644
index 26b6750..0000000
--- a/src/graflib/dzdoc/dzdraw/dzdnfz.F
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: dzdnfz.F,v 1.1.1.1 1996/03/04 16:13:03 mclareni Exp $
-*
-* $Log: dzdnfz.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:03 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDNFZ(CDIR,CLUN,ICONT,IRET)
-#include "zebra/mqsys.inc"
-#include "zebra/eqlqf.inc"
- CHARACTER*(*) CDIR,CLUN
- INTEGER ICONT,IRET, LFZ
- SAVE LFZ
-
-* get next top directory (FZfile)
-
- IF(ICONT.EQ.0)THEN
- IF(LQFS.EQ.0)THEN
- ICONT=0
- IRET=-2
- GOTO 999
- ELSE
- LFZ=LQFS
- ENDIF
- ELSE
- LFZ=LQ(KQSP+LFZ)
- ENDIF
-
- IF(LFZ.EQ.0)THEN
- ICONT=0
- IRET=-1
- ELSE
- ICONT=ICONT+1
- IRET=0
- WRITE(CDIR,'(I2.2)')IQ(KQSP+LFZ-5)
- WRITE(CLUN,'(I2)')IQ(KQSP+LFZ-5)
- ENDIF
-999 END
-***********************************************************************
diff --git a/src/graflib/dzdoc/dzdraw/dzdntd.F b/src/graflib/dzdoc/dzdraw/dzdntd.F
deleted file mode 100644
index afd23b0..0000000
--- a/src/graflib/dzdoc/dzdraw/dzdntd.F
+++ /dev/null
@@ -1,52 +0,0 @@
-*
-* $Id: dzdntd.F,v 1.1.1.1 1996/03/04 16:13:03 mclareni Exp $
-*
-* $Log: dzdntd.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:03 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDNTD(CDIR,CLUN,ICONT,IRET)
-#include "zebra/rzcl.inc"
-
- CHARACTER*(*) CDIR,CLUN
- INTEGER ICONT,IRET, LRZ, IWHOLL(4), INIFLG,IDHRZ
- SAVE INIFLG, LRZ,IDHRZ
- DATA INIFLG/0/
- IF(INIFLG.EQ.0)THEN
- INIFLG=1
- CALL UCTOH('RZ ',IDHRZ,4,4)
- ENDIF
-
-* get next top directory (RZfile)
-
- IF(ICONT.EQ.0)THEN
- IF(LQRS.EQ.0)THEN
- ICONT=0
- IRET=-2
- GOTO 999
- ELSE
- LRZ=LQRS
- ENDIF
- ELSE
- LRZ=LQ(KQSP+LRZ)
- ENDIF
-
-20 IF(LRZ.EQ.0)THEN
- ICONT=0
- IRET=-1
- ELSE
-* is it really 'RZ' (or 'RZ0')
- IF(IQ(KQSP+LRZ-4).NE.IDHRZ)THEN
- LRZ=LQ(KQSP+LRZ)
- GOTO 20
- ENDIF
- ICONT=ICONT+1
- IRET=0
- CALL ZITOH(IQ(KQSP+LRZ+1),IWHOLL,4)
- CALL UHTOC(IWHOLL,4,CDIR,16)
- WRITE(CLUN,'(I2)')IQ(KQSP+LRZ-5)
- ENDIF
-999 END
-***********************************************************************
diff --git a/src/graflib/dzdoc/dzdraw/dzdoco.F b/src/graflib/dzdoc/dzdraw/dzdoco.F
deleted file mode 100644
index 0dc4f34..0000000
--- a/src/graflib/dzdoc/dzdraw/dzdoco.F
+++ /dev/null
@@ -1,333 +0,0 @@
-*
-* $Id: dzdoco.F,v 1.1.1.1 1996/03/04 16:13:18 mclareni Exp $
-*
-* $Log: dzdoco.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:18 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDOCO(LUNBNK,CHBANK,CHOPT)
-************************************************************************
-*. *
-*...DZDOCO outputs bank descriptor information in different forms *
-*. *
-*. DZDOCO uses the bank description system bank to provide *
-*. printed information about one or more banks in a store in several *
-*. user chosen formats. *
-*. *
-*. SUBROUTINE DZDOCO(LUNBNK,CHBANK,CHOPT) *
-*. *
-*. INPUT: *
-*. ------ *
-*. LUNBNK : Unit number of file where the bank descriptor has *
-*. to be written. *
-*. LUNBNK = 0 means the standard output unit LUNOUT *
-*. CHBANK : Character variable containing the name of the bank to *
-*. be documented. *
-*. CHOPT : Character variable containing the options desired *
-
-*. 'A' : All banks in the given store (CHBANK not used) *
-*. 'O' : List all old cycles *
-*. 'P' : Printer file (80 colums wide) -- Default *
-*. 'R' : Read information from RZ file on CWD *
-*. 'S' : SGML tagged output
-*. 'H' : highlight headline SGML
-*. 'L' : highlight headline Latex
-*. 'N' : dont write headline
-*. 'I' : Input format for DZDOCM
-*. *
-*. BANKS R : QBKD,QBKM *
-*. CALLS : DZDENT,DZDGEN,MZCHLS,RZIN,ZBINSR *
-*. CALLED : User called (DZMAIN) *
-*. COMMON : DZDOCC,DZDTAP,MZCN *
-*. *
-*. AUTHOR : M. Goossens DD/US *
-*. VERSION : 2.04(35) / 1 Dec 1987 *
-*. *
-*.**********************************************************************
- CHARACTER CHBANK*(*),CHOPT*(*)
- INTEGER KEYVEC(2)
- CHARACTER*8 CHKEYI
- PARAMETER (NCHDES=60)
- CHARACTER*(NCHDES) CHDESC
- CHARACTER*3 CMONTH(12)
- LOGICAL LWILDC
-#if defined(CERNLIB_BSLASH)
-#include "dzdoc/bslash2.inc"
-#endif
-#if !defined(CERNLIB_BSLASH)
-#include "dzdoc/bslash1.inc"
-#endif
-#include "dzdoc/bkwrp.inc"
-#include "dzdoc/tapes.inc"
-* From DZEBRA
-#include "zebra/zbcdk.inc"
-#include "dzdoc/linout.inc"
-#include "dzdoc/docparq.inc"
-#include "dzdoc/bknuparq.inc"
-#include "zebra/bkfoparq.inc"
-#include "dzdoc/bkstparq.inc"
-#include "dzdoc/bktgparq.inc"
-#include "dzdoc/bktgdatq.inc"
-
- DATA CMONTH/'Jan','Feb','Mar','Apr','May','Jun',
- + 'Jul','Aug','Sep','Oct','Nov','Dec'/
-*------
- 10 CONTINUE
-
-* CALL DZSHOW('After bank parsing',0,LDQBKD,'BLV',0,0,0,0)
-
-*-- Define which options are desired
- CALL DZDSCO(CHOPT,IFLOPT)
-
- IF (IFLOPT(MPOSSQ).NE.0) THEN
- IFLOPT(MPOSPQ) = 0
- ENDIF
-
-* IF (IFLOPT(MPOSGQ).NE.0) THEN
-* X '' Sorry I stop here'')')
-* GO TO 999
-* ENDIF
-
-*-- Which output unit is desired
-
- IF(IFLOPT(MPOSGQ) .EQ. 0)THEN
- IF (LUNBNK.EQ.0) THEN
- LUNUSR = LUNOUT
- ELSE
- LUNUSR = LUNBNK
- ENDIF
- ENDIF
-
- NLISTD = 0
-
-*---OTTO--- Cant currently use 'R' option with 'A'
-
- IF ( IFLOPT(MPOSAQ).NE.0
- + .AND.IFLOPT(MPOSRQ).EQ.0 ) THEN
-
- IF (LDQBKD.EQ.0) THEN
- WRITE(LUNOUT,'(''0DZDOCO No bank descriptor data structure'',
- + /,'' Sorry I stop here'')')
- GO TO 999
- ENDIF
-*-- Order the linear chain of bank descriptors
- CALL ZSORTH(0,LDQBKD,MBIDHQ)
-
-*-- All known identifiers desired
- LQBKD = LDQBKD
- 20 IF (LQBKD.EQ.0) GO TO 999
-*-- Loop over all bank identifiers
- CALL MZCHLS(0,LQBKD)
- IF (IQFOUL.NE.0) THEN
-*-- Invalid bank descriptor bank
- WRITE(LUNOUT,
- + '(''0DZDOCO -- Documentation bank at address'',I10,
- + '' invalid'')') LQBKD
- ELSE
- WRITE(LUNUSR,'(40('' *''))')
-*-- Treat the general information
- CALL DZDGEN
-*-- Output the link, status bit and data information
- CALL DZDENT
- ENDIF
- LQBKD = LQ(KQSP+LQBKD)
-*-- LOOP ===================================================
- GO TO 20
-*-- LOOP ===================================================
- ELSE
-*-- One particular bank descriptor desired
-
- CALL UCTOH(CHBANK,IDBK,4,4)
-
- IF (IFLOPT(MPOSRQ).EQ.0) GOTO 45
-
-*-- Read information in CWD on RZ file
-
-*-- --OTTO---- get name of up-bank
-
- LWILDC = .FALSE.
- IF(IFLOPT(MPOSAQ) .EQ. 0)THEN
- KEYVEC(1) = IDBK
- NCHA = LEN(CHBANK)
-*-- wildcard ??
- IF(INDEX(CHBANK,'*') .NE. 0)THEN
- CHKEYI(1:4) = CHBANK(1:4)
- LWILDC = .TRUE.
- ENDIF
-
-*-- if only one word there force wildcard for second
-
- IF(NCHA .GE. 8)THEN
- CHKEYI(5:8) = CHBANK(5:8)
- CALL UCTOH(CHBANK(5:),KEYVEC(2),4,4)
- ELSE
- CHKEYI(1:4) = CHBANK(1:4)
- CHKEYI(5:8) = '****'
- LWILDC = .TRUE.
- ENDIF
- ELSE
-*-- 'A'll option given => wildcard all
-
- CHKEYI = '********'
- LWILDC = .TRUE.
- ENDIF
- NFKEY = 0
-
-*-- loop on wildcards
-
- 30 CONTINUE
-
- IF(LWILDC)THEN
- CALL DZDWCS(CHKEYI,KEYVEC,NFKEY)
- IF(KEYVEC(1) .EQ. 0)GOTO 999
-* IF(KEYVEC(1) .EQ. 0 .AND. NLISTD .GT. 0)GOTO 999
- ENDIF
-
-*--- if all cycles required, get number of cycles
-
- ICYCLE = 1000000
- IF(IFLOPT(MPOSOQ) .NE. 0)THEN
- CALL RZIN(0,LDQBKD,2,KEYVEC,ICYCLE,'C')
- LQBKD = LDQBKD
- NCYCLE = IQUEST(50)
- ICYCLE = 1
- ELSE
- NCYCLE = 0
- ENDIF
-
-*-- is graphics option required
-
- IF(IFLOPT(MPOSGQ) .NE. 0)THEN
- WRITE(LUNOUT,*)'Not implemtented',
- + ' use DZDGTR,DZDGTR instead'
-* CALL DZDOCG(LUNBNK,KEYVEC,CHOPT)
- IF(LWILDC) GOTO 30
- ENDIF
-
-*-- loop on cycles, if required
-
- 40 CONTINUE
-
- CALL RZIN(0,LDQBKD,2,KEYVEC,ICYCLE,'D')
- LQBKD = LDQBKD
- ICYCLE = ICYCLE + 1
-
-*-- if all cycles needed loop until all found
-
- IF(NCYCLE .GT. 0 .AND. IQUEST(1) .NE. 0)THEN
- GOTO 40
- ENDIF
- IF (IQUEST(1).NE.0) LQBKD = 0
- NCYCLE = NCYCLE - 1
- CALL RZDATE(IQUEST(14), IDATE, ITIME,1)
- GOTO 46
-
- 45 CONTINUE
-*-- Find the information in memory
- IF (LDQBKD.EQ.0) THEN
- WRITE(LUNOUT,'(''0DZDOCO No bank descriptor data '',
- + ''structure'',/,'' Sorry I stop here'')')
- GO TO 999
- ENDIF
- LQBKD = LZFIND(0,LDQBKD,IDBK,MBIDHQ)
-
-46 CONTINUE
-
-* WRITE(LUNOUT,'(A,A4)')' DZDOCO for :',KEYVEC(1)
-
- IF (LQBKD.EQ.0) THEN
-*-- No bank present for bank identifier
- IF(CHBANK(1:4).NE.'NOTU')THEN
- WRITE(LUNUSR,'(A,A,A,A)')
- + ' '//CHBANK(1:4),'/',CHBANK(5:8),' No doc '
- IF(LUNOUT.NE.LUNUSR)
- + WRITE(LUNOUT,'(A,A,A,A)')
- + ' '//CHBANK(1:4),'/',CHBANK(5:8),' No doc '
- ENDIF
- GO TO 999
- ELSE
-*-- Get address of documentation bank
- CALL MZCHLS(0,LQBKD)
- IF (IQFOUL.NE.0) THEN
- WRITE(LUNOUT,
- + '(''0DZDOCO -- Documentation bank for identifier '',A,
- + '' invalid'')') CHBANK
- ELSE
-
-*--OTTO----
- CALL UHTOC(KEYVEC,4,CHBANK,8)
- IF(IFLOPT(MPOSBQ) .EQ. 0. AND.
- & IFLOPT(MPOSIQ) .EQ. 0.)THEN
- IF(IFLOPT(MPOSSQ) .EQ. 0)THEN
- NCHOLL = (IQ(KQSP+LDQBKD+25)/16 - 1)*4
- IF(NCHOLL .GT. 0)THEN
- IF(NCHOLL .GT. NCHDES)NCHOLL = NCHDES
- CALL UHTOC(IQ(KQSP+LDQBKD+27),
- + 4,CHDESC,NCHOLL)
- IF(NCHOLL.LT.NCHDES)
- + CHDESC(NCHOLL+1:NCHDES) =' '
- ELSE
- CHDESC=' '
- ENDIF
- IF(IFLOPT(MPOSNQ).EQ.0)THEN
- WRITE(LUNUSR,'(/,'' '',78(''-''))')
- IF(IFLOPT(MPOSHQ).NE.0)THEN
- WRITE(LUNUSR,'(A)')'</LISTING>'
- WRITE(LUNUSR,'(A)')'<HP2>| '
- + //CHBANK(1:4)
- + //' | '//CHDESC//'</HP2>'
- WRITE(LUNUSR,'(A)')'<LISTING>'
- ELSEIF(IFLOPT(MPOSLQ).NE.0)THEN
- WRITE(LUNUSR,'(A)')'{'//BS//'Large'
- WRITE(LUNUSR,'(A)')'| '//CHBANK(1:4)
- + //' | '//CHDESC//'}'
- ELSE
- WRITE(LUNUSR,'(A)')'| '//CHBANK(1:4)
- + //' | '//CHDESC
- ENDIF
- ENDIF
- IYEAR=IDATE/10000
- IMONTH = MOD(IDATE/100,100)
- IDAY = MOD(IDATE,100)
- IHOUR = ITIME/100
- IMIN= MOD(ITIME,100)
- WRITE(LUNUSR,'('' '',46(''-''),
- + A,I2,A,A,A,I2,I3,A,I2)')
- + ' entered file at ',IDAY,'-',CMONTH(IMONTH),
- + '-',IYEAR,IHOUR,':',IMIN
- ELSE
- WRITE(LUNUSR,'(A,A,A,A)')
- + '<H1 N="',CHBANK(1:4),'">'
- WRITE(LUNUSR,'(A,A)')'<I1>',CHBANK(1:4)
- WRITE(LUNUSR,'(A)')'<LISTING>'
- ENDIF
- ENDIF
-*---/OTTO
-*-- Treat the general information
- CALL DZDGEN
-*-- Output the link, status bit and data information
- CALL DZDENT
- NLISTD = NLISTD + 1
- IF(IFLOPT(MPOSBQ) .EQ. 0)THEN
- IF(IFLOPT(MPOSSQ) .NE. 0)THEN
- WRITE(LUNUSR,'(A)')'</LISTING>'
- ENDIF
- ENDIF
- ENDIF
-*&&&&& 6-Apr-92
- CALL MZDROP(0,LQBKD,'L')
- LQBKD=0
-
-*-- look for next cycle
-
- IF(NCYCLE .GT. 0)GOTO 40
-
-*-- wild card search ??
-
- IF(LWILDC) GOTO 30
- ENDIF
- ENDIF
-
- 999 END
diff --git a/src/graflib/dzdoc/dzdraw/dzdorf.F b/src/graflib/dzdoc/dzdraw/dzdorf.F
deleted file mode 100644
index 84b32c4..0000000
--- a/src/graflib/dzdoc/dzdraw/dzdorf.F
+++ /dev/null
@@ -1,110 +0,0 @@
-*
-* $Id: dzdorf.F,v 1.1.1.1 1996/03/04 16:13:01 mclareni Exp $
-*
-* $Log: dzdorf.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:01 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDORF
-* IMPLICIT NONE
- INTEGER IQUEST(100)
- COMMON/QUEST/IQUEST
-#include "dzdzbrinc.inc"
- CHARACTER*1 CMINIT
- CHARACTER*80 CHDOCB
- SAVE CHDOCB, CMINIT
-*--
- INTEGER NCH, NCH1, IRET, IERR, IFLAG, LENOCC
-
- CHARACTER*80 CHFILE
- CHARACTER*4 CHOPT, CHOPT1
-*--
- IFLAG=0
- CALL DZDIBR
- CALL RZCDIR(CWDSAV,'R')
- CALL KUGETS(CHFILE,NCH)
- CALL KUGETC(CHOPT,NCH1)
- IF(INDEX(CHOPT,'L').NE.0)THEN
- IF(CTDDOC.NE.' ')THEN
- CALL RZCDIR(CTDDOC,' ')
- CALL RZLDIR(' ',' ')
- ELSE
- WRITE(*,*)'No Rz doc file open'
- ENDIF
- GOTO 999
- ENDIF
- IF(NCH.LE.0)THEN
- WRITE(*,*)'No file name given'
- GOTO 999
- ENDIF
- CMINIT='R'
- IF(NCH.LE.0)THEN
- CHOPT=' '
- ELSE
- IF( INDEX(CHOPT,'U').NE.0
- & .OR. INDEX(CHOPT,'N').NE.0
- & .OR. INDEX(CHOPT,'1').NE.0)CMINIT='U'
- ENDIF
- CHDOCB=CHFILE
- GOTO 10
-
- ENTRY DZDOR1(CHOPT1,IERR)
-
- IFLAG=1
- IERR=0
- CALL RZCDIR(CWDSAV,'R')
- CHOPT=CHOPT1
- IF( INDEX(CHOPT,'U').NE.0
- & .OR. INDEX(CHOPT,'N').NE.0
- & .OR. INDEX(CHOPT,'1').NE.0)THEN
- IF(CMINIT .NE. 'U')THEN
- WRITE(*,*)
- & 'No documentation RZ-file open for update'
- IERR=1
- GOTO 999
- ENDIF
- ENDIF
-
-10 CONTINUE
-
-* close if already open
-
- CALL DZDCLD
- CTDDOC='//RZDOC'
-*
- IF (INDEX(CHOPT,'N').NE.0)THEN
- CALL DZDMRZ(LPDOCS,LPDOCB,' ',CHDOCB,' ',IRET)
- IF(IRET.NE.0)GOTO 888
- LUDOCB=LPDOCB
- ELSE IF(INDEX(CHOPT,'U').NE.0)THEN
- CALL DZDURZ(LPDOCS,LPDOCB,' ',CHDOCB,' ',IRET)
- IF(IRET.NE.0)GOTO 888
- LUDOCB=LPDOCB
- ELSE
-* IDOCFL=1
- GOTO 777
- ENDIF
-* dont leave it open in update mode
- IF(IFLAG.EQ.0)THEN
- LUDOCB=LPDOCB
- CALL DZDCLD
- ELSE
- GOTO 999
- ENDIF
-777 LUDOCB=LPDOCB
- CALL RZOPEN(LPDOCB,CTDDOC(3:),CHDOCB,' ',256,IRET)
- IF(IRET.EQ.0)THEN
- CALL RZFILE(LPDOCB,CTDDOC(3:),' ')
- GOTO 999
- ENDIF
-888 CONTINUE
- CTDDOC=' '
- WRITE(*,*)' Error opening bank doc',IRET
- IDOCFL=0
- IF(IFLAG.EQ.1)IERR=IRET
-999 CONTINUE
- IF(LENOCC(CWDSAV).GT.0)CALL RZCDIR(CWDSAV,' ')
- END
-*********************************************************************
diff --git a/src/graflib/dzdoc/dzdraw/dzdpar.F b/src/graflib/dzdoc/dzdraw/dzdpar.F
deleted file mode 100644
index b7bddff..0000000
--- a/src/graflib/dzdoc/dzdraw/dzdpar.F
+++ /dev/null
@@ -1,73 +0,0 @@
-*
-* $Id: dzdpar.F,v 1.1.1.1 1996/03/04 16:13:12 mclareni Exp $
-*
-* $Log: dzdpar.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:12 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDPAR(LB,IB,L,
- & HID, NID, HIDUP, HIDNX, JB, NL, NS, ND)
-*.
-*...DZDPAR get parameters for a bank
-*.
-*. INPUT : LB, IB the array containing the ZEBRA store
-*. as used in the call to MZSTOR
-*. L link to bank
-*. OUTPUT : HID Id of bank
-*. HIDUP Id of up-bank
-*. HIDNX Id of next bank
-*. JB JBIAS link offset
-*. NL,NS,ND number of struc links,tot links,data words
-*.
-*. CALLS : UHTOC
-*. CALLED : DZDRA2, DZDHEA
-*.
-*. AUTHOR : O.Schaile
-*. VERSION : 1.00
-*. CREATED : 11-Dec-87
-*. LAST MOD : 18-Mar-88
-*.
-*. Modification Log.
-*. 18-Mar-88 implement input from doc file
-*.**********************************************************************
-*.
-#include "dzdprm.inc"
- CHARACTER*4 HID,HIDUP,HIDNX
- INTEGER LB(999), IB(999)
- NS = IB(L-2)
- IF(IFRCAR .EQ. 0)THEN
- ND = IB(L-1)
- NL = IB(L-3)
- ELSE
- ND = IB(L+1)
- NL = IB(L+3)
- ENDIF
- NID =IB(L-5)
- CALL UHTOC(IB(L-4),4,HID,4)
- LUPB = LB(L+1)
- IF(LUPB .GT. 2)THEN
- CALL UHTOC(IB(LUPB-4),4,HIDUP,4)
- ELSE
- HIDUP = 'NONE'
- ENDIF
- IF(LB(L) .NE. 0)THEN
- CALL UHTOC(IB(LB(L)-4),4,HIDNX,4)
- ELSE
- HIDNX = ' '
- ENDIF
- LORIGB = LB(L+2)
- IF(LORIGB .GT. 2 .AND. LUPB .NE. 0)THEN
- NSU = IB(LUPB-2)
- IF(LORIGB .GT. LUPB .OR.
- & LORIGB .LT. LUPB-NSU)THEN
- JB = -1
- ELSE
- JB = LUPB-LORIGB
- ENDIF
- ELSE
- JB = 0
- ENDIF
- END
-**********************************************************************
diff --git a/src/graflib/dzdoc/dzdraw/dzdpdl.F b/src/graflib/dzdoc/dzdraw/dzdpdl.F
deleted file mode 100644
index ef58bbf..0000000
--- a/src/graflib/dzdoc/dzdraw/dzdpdl.F
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: dzdpdl.F,v 1.1.1.1 1996/03/04 16:13:07 mclareni Exp $
-*
-* $Log: dzdpdl.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:07 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDPDL(LUN,CST,N)
- CHARACTER*(*) CST
- CHARACTER*12 CTEMP
- WRITE(CTEMP,'(I12)')N
- IFC=INDEXC(CTEMP,' ')
- WRITE(LUN,'(A,A)')CST,CTEMP(IFC:)
- END
-
-***********************************************************************
diff --git a/src/graflib/dzdoc/dzdraw/dzdpev.F b/src/graflib/dzdoc/dzdraw/dzdpev.F
deleted file mode 100644
index 49265c2..0000000
--- a/src/graflib/dzdoc/dzdraw/dzdpev.F
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: dzdpev.F,v 1.1.1.1 1996/03/04 16:13:02 mclareni Exp $
-*
-* $Log: dzdpev.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:02 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDPEV
-#include "dzdzbrinc.inc"
-
- IF(LZEBLK(1,0).EQ.0 .AND. NUH .LE.0)THEN
- WRITE(*,*)'Nothing in memory'
- ELSE
- CALL DZDSH1(1,LZEBLK(1,0),'_FOUT')
- ENDIF
- END
-*********************************************************************
diff --git a/src/graflib/dzdoc/dzdraw/dzdpin.F b/src/graflib/dzdoc/dzdraw/dzdpin.F
deleted file mode 100644
index accb16d..0000000
--- a/src/graflib/dzdoc/dzdraw/dzdpin.F
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: dzdpin.F,v 1.1.1.1 1996/03/04 16:13:18 mclareni Exp $
-*
-* $Log: dzdpin.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:18 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDPIN(KEY,CHOPT)
- CHARACTER*(*)CHOPT
- INTEGER KEY(2)
-#include "dzdoc/linout.inc"
-#include "dzdoc/bkwrp.inc"
-
- CALL DZDSCO(CHOPT,IFLOPT)
- IF(LBQBKD.NE.0)CALL MZDROP(0,LBQBKD,'I')
- LBQBKD=0
- CALL RZIN(0,LDQBKD,2,KEY,100000,'D')
- LQBKD = LDQBKD
- IF(IQUEST(1) .NE. 0)GOTO 10
-* WRITE(LUNOUT,'(A,2A4)')' DZDPIN for: ',KEY
- IF(LBQBKD.NE.0)CALL MZDROP(0,LBQBKD,'I')
- LBQBKD=0
- CALL DZDGEN
- CALL DZDENT
- CALL MZDROP(0,LDQBKD,'I')
- LDQBKD=0
- 10 CONTINUE
- END
-***********************************************************************
diff --git a/src/graflib/dzdoc/dzdraw/dzdpla.F b/src/graflib/dzdoc/dzdraw/dzdpla.F
deleted file mode 100644
index 6b14fe7..0000000
--- a/src/graflib/dzdoc/dzdraw/dzdpla.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: dzdpla.F,v 1.1.1.1 1996/03/04 16:13:08 mclareni Exp $
-*
-* $Log: dzdpla.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:08 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDPLA(IVAL,COUT)
- CHARACTER*(*) COUT
- CHARACTER*9 CTEMP
- COUT=' '
- WRITE(CTEMP,'(I9)')IVAL
- IFNB=INDEXC(CTEMP,' ')
- NC=9-IFNB+1
- COUT(1:NC)=CTEMP(IFNB:9)
- END
-
-
-***********************************************************************
diff --git a/src/graflib/dzdoc/dzdraw/dzdpln.F b/src/graflib/dzdoc/dzdraw/dzdpln.F
deleted file mode 100644
index 8263da4..0000000
--- a/src/graflib/dzdoc/dzdraw/dzdpln.F
+++ /dev/null
@@ -1,118 +0,0 @@
-*
-* $Id: dzdpln.F,v 1.1.1.1 1996/03/04 16:13:18 mclareni Exp $
-*
-* $Log: dzdpln.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:18 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDPLN(LUN,CVAR,NEWFLG)
-* put CVAR into output line
-* NEWFLG: 1: start new or continue FORTRAN
-* 2: force new line (FORTRAN)
-* 99: output last line (FORTRAN)
-* 0: start new or continue (col 1, no blank suppress)
-* -1: dito but suppress all but 1 blank
-* -2: force new line (keep blanks)
-* -3: dito suppress blanks
-* -99: last line
-*
- CHARACTER*(*) CVAR
- PARAMETER (NCL=80)
- CHARACTER*(NCL) CL
- SAVE CL
- SAVE IP
- DATA IP/1/
-*
- IF(NEWFLG.GT.0)THEN
- ICOL1=7
- NCLINE=72
- ELSE
- ICOL1=1
- NCLINE=80
- ENDIF
- IF(LUN.LE.0)THEN
- IP=1
- GOTO 999
- ENDIF
-* force new line
- IF(ABS(NEWFLG).GT.1)THEN
- IF(IP.GT.ICOL1 .OR.
- & (IP.EQ.ICOL1.AND.CL(ICOL1:ICOL1).NE.' '))THEN
- IP=IP-1
- IF(CL(IP:IP).EQ.' ')IP=IP-1
- IF(IP.GT.NCL)IP=NCL
- WRITE(LUN,'(A)')CL(1:IP)
- ENDIF
- CL=' '
- IP=ICOL1
- IF(ABS(NEWFLG).EQ.99)GOTO 999
- ENDIF
- NC=LEN(CVAR)
- IF(NC.LE.0)GOTO 999
-* remove trailing blanks
- ILC = INDXBC(CVAR(1:NC),' ')
- IF(ILC.GT.0)NC=ILC
- IF(NEWFLG.EQ.-1 .OR. NEWFLG.EQ.-3)THEN
- ILC=NC
- IFC=INDEXC(CVAR(1:ILC),' ')
- IF(IFC.EQ.0)GOTO 999
-* find # of char, keep 1 blank
- IBL=0
- NC=0
- DO 10 I=IFC,ILC
- IF(CVAR(I:I).NE.' ')THEN
- NC=NC+1
- IBL=0
- ELSE
- IF(IBL.EQ.0)NC=NC+1
- IBL=IBL+1
- ENDIF
-10 CONTINUE
- ENDIF
-* insert one blank if not FORTRAN
- IF(NEWFLG.LE.0)THEN
- IF(IP.GT.1 .AND. IP.LE.NCLINE)THEN
- CL(IP:IP)=' '
- IP=IP+1
- ENDIF
- ENDIF
-* does it fit on line
-
- IF(IP+NC-1.GT.NCLINE)THEN
- IP=IP-1
- IF(CL(IP:IP).EQ.' ')IP=IP-1
- IF(IP.GT.NCL)IP=NCL
- WRITE(LUN,'(A)')CL(1:IP)
- CL=' '
- IF(NEWFLG.GT.0)CL(6:6)='+'
- IP=ICOL1
- ENDIF
- IF(NEWFLG.EQ.-1 .OR. NEWFLG.EQ.-3)THEN
- DO 20 I=IFC,ILC
- IF(CVAR(I:I).NE.' ')THEN
- CL(IP:IP)=CVAR(I:I)
- IP=IP+1
- IBL=0
- ELSE
- IF(IBL.EQ.0)THEN
- CL(IP:IP)=' '
- IP=IP+1
- ENDIF
- IBL=IBL+1
- ENDIF
-20 CONTINUE
-* add a blank
-* IF(IP.LE.NCLINE)THEN
-* CL(IP:IP)=' '
-* IP=IP+1
-* ENDIF
- ELSE
- IPL = IP+NC-1
- CL(IP:IPL)=CVAR(1:NC)
- IP = IPL+1
- ENDIF
-999 END
-
-************************************************************************
diff --git a/src/graflib/dzdoc/dzdraw/dzdprm.inc b/src/graflib/dzdoc/dzdraw/dzdprm.inc
deleted file mode 100644
index 829aa0f..0000000
--- a/src/graflib/dzdoc/dzdraw/dzdprm.inc
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: dzdprm.inc,v 1.1.1.1 1996/03/04 16:13:00 mclareni Exp $
-*
-* $Log: dzdprm.inc,v $
-* Revision 1.1.1.1 1996/03/04 16:13:00 mclareni
-* Dzdoc/Zebpack
-*
-*
-*
-* dzdprm.inc
-*
- INTEGER ALDBIT
- PARAMETER (ALDBIT=1)
- INTEGER IFLRZF,IFRCAR
- & ,IFQUIT, IFLDIR, IFWORD,ILWORD, IDVERS
- & ,IFOMED,LUNGRA,KWTYP,KWID,IPCSIZ,LUDORZ
- & ,LULIRZ, IFLPKY, LFCOL, IBCCOL,IBDCOL,IDREFL
- & ,IDZTFO,IDZTPR
- REAL XRANGE,YRANGE,GRIDX,GRIDY,DXTB,DXUB,DXLK, DYB, DXB
- & ,X0HEAD, Y0HEAD, X0TB, Y0TB, X0UB, Y0UB
- & ,RADBUB, CSIZE, CSFACT, ARRLEN,PAGECM,PAMM10,GRIDSC
-
- COMMON/DZDPRM/XRANGE,YRANGE,GRIDX,GRIDY,DXTB,DXUB,DXLK, DYB, DXB
- & ,X0HEAD, Y0HEAD, X0TB, Y0TB, X0UB, Y0UB
- & ,RADBUB, CSIZE, CSFACT, ARRLEN,IFLRZF,IFRCAR
- & ,IFQUIT, IFLDIR, IFWORD,ILWORD, IDVERS
- & ,IFOMED,LUNGRA,KWTYP,KWID,PAGECM,PAMM10,GRIDSC,IPCSIZ,LUDORZ
- & ,LULIRZ, IFLPKY, LFCOL, IBCCOL,IBDCOL,IDREFL
- & ,IDZTFO,IDZTPR
diff --git a/src/graflib/dzdoc/dzdraw/dzdprv.F b/src/graflib/dzdoc/dzdraw/dzdprv.F
deleted file mode 100644
index f0df8e4..0000000
--- a/src/graflib/dzdoc/dzdraw/dzdprv.F
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: dzdprv.F,v 1.2 2000/03/31 14:09:51 mclareni Exp $
-*
-* $Log: dzdprv.F,v $
-* Revision 1.2 2000/03/31 14:09:51 mclareni
-* Increase the minor version to 05
-*
-* Revision 1.1.1.1 1996/03/04 16:13:06 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDPRV
-* print first 28 characters of TITLE
- WRITE(*,100)
-100 FORMAT(10H Starting ,
- + ' DZDOC 6.00/05 Q101'
- +)
- END
diff --git a/src/graflib/dzdoc/dzdraw/dzdprw.F b/src/graflib/dzdoc/dzdraw/dzdprw.F
deleted file mode 100644
index dd72698..0000000
--- a/src/graflib/dzdoc/dzdraw/dzdprw.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: dzdprw.F,v 1.1.1.1 1996/03/04 16:13:17 mclareni Exp $
-*
-* $Log: dzdprw.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:17 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
-
- SUBROUTINE DZDPRW(LUC,NW)
- WRITE(LUC,'(A)')
- & ' WARNING: # of docd words doesnt match # of data,'
- IF(ABS(NW).NE.1000000)THEN
- WRITE(LUC,'(A,I5)')
- & ' Assume length of rep section is:',ABS(NW)
- ELSE
- WRITE(LUC,'(A)')' cant resolve it'
- ENDIF
- END
-*********************************************************************
diff --git a/src/graflib/dzdoc/dzdraw/dzdpsc.F b/src/graflib/dzdoc/dzdraw/dzdpsc.F
deleted file mode 100644
index d0a949f..0000000
--- a/src/graflib/dzdoc/dzdraw/dzdpsc.F
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: dzdpsc.F,v 1.1.1.1 1996/03/04 16:13:19 mclareni Exp $
-*
-* $Log: dzdpsc.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:19 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDPSC(ISTORE,LEV,CF)
-* draw bank tree below LEV in store ISTORE in PostScript format
-* into file CF
- INTEGER LEV
- INTEGER LUNTRE, IRET
- PARAMETER (LUNTRE=65)
- CHARACTER*(*) CF
- CALL KUOPEN(LUNTRE,CF,'UNKNOWN',IRET)
- CALL IOPWK(2,LUNTRE,-111)
- CALL IDAWK(1)
- CALL IACWK(2)
- CALL RZCDIR('//RZDOC',' ')
- CALL DZDDTR(ISTORE,LEV,0,0,0,2,-111,'MPR')
- CALL IUWK(0,1)
- CALL IDAWK(2)
- CALL IACWK(1)
- CALL ICLWK(2)
- END
diff --git a/src/graflib/dzdoc/dzdraw/dzdpto.F b/src/graflib/dzdoc/dzdraw/dzdpto.F
deleted file mode 100644
index 4cc3ea5..0000000
--- a/src/graflib/dzdoc/dzdraw/dzdpto.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: dzdpto.F,v 1.1.1.1 1996/03/04 16:13:15 mclareni Exp $
-*
-* $Log: dzdpto.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:15 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDPTO(IWTYP)
- CHARACTER*4 ANYCHA
- IF(IWTYP.EQ.7878 .OR.
- & IWTYP.EQ. 0 .OR.
- & IWTYP.EQ.7800 .OR.
- & IWTYP.EQ. 221 .OR.
- & IWTYP.EQ. 101 .OR.
- & IWTYP.EQ. 103 .OR.
- & IWTYP.EQ. 121 .OR.
- & IWTYP.EQ. 123 .OR.
- & IWTYP.EQ. 125 .OR.
- & IWTYP.EQ.1020 .OR.
- & IWTYP.EQ.1021 .OR.
- & IWTYP.EQ.1030)THEN
-
- CALL KUPROC(' Return to continue',ANYCHA,NCH)
- ENDIF
- END
-***********************************************************************
diff --git a/src/graflib/dzdoc/dzdraw/dzdpuv.F b/src/graflib/dzdoc/dzdraw/dzdpuv.F
deleted file mode 100644
index 6ba1fee..0000000
--- a/src/graflib/dzdoc/dzdraw/dzdpuv.F
+++ /dev/null
@@ -1,79 +0,0 @@
-*
-* $Id: dzdpuv.F,v 1.1.1.1 1996/03/04 16:13:04 mclareni Exp $
-*
-* $Log: dzdpuv.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:04 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDPUV(IXDIV,LIN)
-#include "zebra/mqsys.inc"
-*--
- CHARACTER CQSTAK*13,CQINFO*40
- PARAMETER (NLICHQ=130,NSTCHQ=8,NDVCHQ=8,NBKCHQ=4 )
- CHARACTER CQLINE*(NLICHQ),CQMAP(10)*(NLICHQ)
- CHARACTER CQSTOR*(NSTCHQ),CQDIV*(NDVCHQ),CQID*(NBKCHQ)
- COMMON /DZC1CH/ CQSTOR,CQDIV,CQID,CQMAP,CQSTAK,CQINFO
- EQUIVALENCE (CQLINE,CQMAP)
-*--
- INTEGER IWORDF, IWORDL, IXDIV, LIN, IDHIST
- CHARACTER*8 CNAME, SPACES, CDHIST
- CHARACTER*4 CHOPT
- CHARACTER*1 CTYPE
-*--
- CALL MZSDIV(IXDIV,-7)
- CALL KUGETI(IDHIST)
- IF(IDHIST.LE.0)IDHIST=12345
- WRITE(CDHIST,'(I8)')IDHIST
- CALL KUGETC(CNAME,NCH)
- CALL KUGETI(IWORDF)
- CALL KUGETI(IWORDL)
- CALL KUGETC(CHOPT,NCH)
- CALL CLTOU(CHOPT)
-
- IF(IWORDF.LE.0)IWORDF=1
- IF(IWORDL.LE.0)IWORDL=IQ(KQS+LIN-1)
- IF(CNAME.EQ.' ')THEN
- CALL UHTOC(IQ(KQS+LIN-4),4,CNAME,4)
- WRITE(CNAME(5:8),'(I4)',ERR=10)IQ(KQS+LIN-5)
- GOTO 11
-10 CONTINUE
- CNAME(5:8)='9999'
-11 CONTINUE
- CNAME=SPACES(CNAME,0)
- ENDIF
-* get type
- CALL DZSHOW(' ',IXDIV, LIN,'Q',1,0,IWORDF,IWORDF)
- IF (INDEX(CQLINE(13:24),'"').NE.0)THEN
- CTYPE='H'
- CHOPT=' '
- WRITE(*,*)'Warning: Type is hollerith, dont draw or plot it'
- ELSE IF(INDEX(CQLINE(13:24),'.').NE.0)THEN
- CTYPE=' '
- ELSE
- CTYPE='I'
- ENDIF
-
-* check type of last
-
- CALL DZSHOW(' ',IXDIV, LIN,'Q',1,0,IWORDL,IWORDL)
- IF (INDEX(CQLINE(13:24),'"').NE.0)THEN
- IF(CTYPE.NE.'H')GOTO 888
- ELSE IF(INDEX(CQLINE(13:24),'.').NE.0)THEN
- IF(CTYPE.NE.' ')GOTO 888
- ELSE
- IF(CTYPE.NE.'I')GOTO 888
- ENDIF
-
- IF(CTYPE.NE.' ')THEN
- CALL KUVEC(CNAME,IQ(KQS+LIN+IWORDF),IWORDL-IWORDF+1,'W'//CTYPE)
- ELSE
- CALL KUVEC(CNAME,Q(KQS+LIN+IWORDF),IWORDL-IWORDF+1,'W')
- ENDIF
- IF(CHOPT.EQ.'PLOT') CALL KUEXEL('VECT/PLOT '//CNAME//CDHIST)
- IF(CHOPT.EQ.'DRAW') CALL KUEXEL('VECT/DRAW '//CNAME//CDHIST)
- GOTO 999
-888 WRITE(*,*)'Warning: Type of first and last word differ, refused'
-999 END
-***********************************************************************
diff --git a/src/graflib/dzdoc/dzdraw/dzdra1.F b/src/graflib/dzdoc/dzdraw/dzdra1.F
deleted file mode 100644
index 4dfaa22..0000000
--- a/src/graflib/dzdoc/dzdraw/dzdra1.F
+++ /dev/null
@@ -1,47 +0,0 @@
-*
-* $Id: dzdra1.F,v 1.1.1.1 1996/03/04 16:13:08 mclareni Exp $
-*
-* $Log: dzdra1.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:08 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDRA1(IXSTOR,LTOP, ILKACT
- & ,CHOPT, XCUR, YCUR, REQINP,IFLCUR,YTOP,YBOTTM)
-*.
-*...DZDRA1 interface routine DZDRAW => DZDRA2
-*. and DZDGET => DZDRA2
-*. to hide ZEBRA internals from DZDRA2
-*.
-*. INPUT : IXSTOR Store index
-*. LTOP Link to top bank to be displayed
-*. ILKACT the link where drawing of down banks starts
-*. CHOPT Character option (not yet used)
-*. REQINP indicates if picture should be drawn by
-*. DZDRA2 or locator input is requested
-*. OUTPUT : XCUR,YCUR coordinates of locator
-*. IFLCUR flag indicating where locator is
-*. COMMON :
-*. SEQUENCE : MZCA MZCB QSTORE ZEBQ ZUNIT
-*. CALLS : DZDRA2
-*. CALLED : DZDRAW, DZDGET
-*.
-*. AUTHOR : O.Schaile
-*. VERSION : 1.00
-*. CREATED : 11-Dec-87
-*.**********************************************************************
-*.
- CHARACTER*(*) CHOPT
- LOGICAL REQINP
-*
-#include "zebra/zebq.inc"
-#include "zebra/mzca.inc"
-#include "zebra/mzcb.inc"
-#include "zebra/zunit.inc"
-#include "zebra/qstore.inc"
- CALL DZDRA2(IXSTOR,LQ(KQS+1), IQ(KQS+1),LTOP,ILKACT
- & ,CHOPT, XCUR, YCUR, REQINP, IFLCUR,YTOP,YBOTTM)
- RETURN
- END
-************************************************************************
diff --git a/src/graflib/dzdoc/dzdraw/dzdra2.F b/src/graflib/dzdoc/dzdraw/dzdra2.F
deleted file mode 100644
index 6f9e177..0000000
--- a/src/graflib/dzdoc/dzdraw/dzdra2.F
+++ /dev/null
@@ -1,454 +0,0 @@
-*
-* $Id: dzdra2.F,v 1.1.1.1 1996/03/04 16:13:08 mclareni Exp $
-*
-* $Log: dzdra2.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:08 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDRA2(IXSTOR,LB,IB,L,ILKACT
- + ,CHOPT, XCUR, YCUR, REQINP, IFLCUR,YTOP,YBOTTM)
-*.
-*...DZDRA2 draw a data structure on open workstation(s) or
-*. request input of locator assuming the picture
-*. has previously drawn (with (REQINP=.FALSE.)
-*. in the second case the picture is redrawn only
-*. virtually
-*.
-*. INPUT : IXSTOR Store index
-*. LB, IB the array containing the ZEBRA store
-*. as used in the call to MZSTOR
-*. L Link to top bank to be displayed
-*. ILKACT the link where drawing of down banks starts
-*. CHOPT Character option:
-*. 'N' opening and closing WS is done by caller
-*. 'T' D/S generated from documentation
-*. 'R' Rz-file with documentation available
-*. 'B' draw boxes as <>
-*. '1' draw banks od 1 level only if not the
-*. complete 2nd level fits
-*. 'M' mark subtree complete
-*. REQINP indicates if picture should be drawn
-*. physically or locator input is requested
-*. OUTPUT : XCUR,YCUR coordinates of locator
-*. IFLCUR flag indicating where locator is(see DZDGET)
-*. COMMON :
-*. SEQUENCE : DZDPRM
-*. CALLS : DZDBNK DZDCKC DZDHEA DZDLBX DZDLNK DZDPAR DZDSBX GQCNTN
-*. CALLS : GQNT GSASF GSELNT GSPLCI
-*. CALLED : DZDRA1
-*.
-*. AUTHOR : O.Schaile
-*. VERSION : 1.00
-*. CREATED : 11-Dec-87
-*. LAST MOD : 3-Dec-93
-*.
-*. Modification Log.
-*. 18-Mar-88 implement input from doc file
-*. 2-OCT-90 skip more then 4 zero down links in picture
-*. 3-Dec-93 check for valid link (DZDGLK)
-*.**********************************************************************
-*.
-*
- INTEGER LB(999),IB(999)
- CHARACTER*(*) CHOPT
- LOGICAL REQINP
-#include "dzdprm.inc"
- INTEGER LREF(-1:4,0:15)
- COMMON/DZDLKA/LREF
- INTEGER INIFLG, IST, DZDGLK
- SAVE INIFLG
- REAL XPOL(3),YPOL(3)
-*
- CHARACTER*4 HIDDW, HIDUPX, HIDNXX, HIDNXN
- LOGICAL DZDINB
- EXTERNAL DZDINB
- DATA INIFLG/0/
-*
-*----
- IF(L.EQ.0)THEN
- WRITE(*,*)'DZDRA2: Ltopin = 0'
- RETURN
- ENDIF
- IST = JBYT(IXSTOR,27,6)
-
- CALL MZLINT(IXSTOR,'/DZDLKA/'
- &,LREF(-1,IST),LREF(1,IST),LREF(4,IST))
- IF(INIFLG.EQ.0)THEN
- INIFLG=1
- CSFACT=1.
- ENDIF
- IFMASC = INDEX(CHOPT,'M')
- IFRCAR = INDEX(CHOPT,'T')
- IF(IFRCAR.NE.0)IFMASC=1
- IFLRZF = INDEX(CHOPT,'R')
- IFLDIR = INDEX(CHOPT,'B')
- XRANGE = 20.
- YRANGE = 20.
-* IFOMED=3 : LaTex
- IF(IFOMED.NE.3)THEN
- CALL IGRNG( XRANGE, YRANGE)
- CALL ISLN(1)
- CALL ISLWSC(3.)
- CALL ISTXCI(1)
- CALL ISPLCI(1)
- IF(IDZTFO.NE.0)CALL ISTXFP(IDZTFO,IDZTPR)
- ENDIF
- GRIDX = GRIDSC*XRANGE/32.
- GRIDY = GRIDX
-* L = LTOP
- IFLCUR = 0
- 10 CONTINUE
-*
- NS = IB(L-2)
- NL = IB(L-3)
- IF(ILKACT .LE. 0 .OR. ILKACT .GT. NL)THEN
- ILD1 = 1
- ELSE
- ILD1 = ILKACT
- ENDIF
- NBLEV1=0
- MNZERO=0
- DO 20 I=ILD1,NL
- IF(LB(L-I) .NE. 0)THEN
- NBLEV1 = NBLEV1+1
- MNZERO=I
- ENDIF
- 20 CONTINUE
- NULEV1=MNZERO
- MNZERO=MNZERO+1-ILD1
- NBTOT=NBLEV1
-
- Y0 = YRANGE
- DXTB = 11. * GRIDX
- DXUB = 2. * GRIDX
- DXLK = GRIDX/2
- DXB = GRIDX
- DYB = GRIDY
- X0HEAD = GRIDX
- Y0HEAD = Y0 - GRIDY
-
-*11/2 X0TB = 11. * GRIDX
-
- XNBK= MIN(MNZERO,13)
-* need space for a big box?
- IF(ILKACT.GT.0)XNBK=XNBK+4
- X0TB = (1. + 0.5*XNBK) * GRIDX
- IF(IFMASC.NE.0)X0TB=X0TB+2.* GRIDX
- IF(NBLEV1.GT.13)X0TB=X0TB+2.*GRIDX
-
- Y0TB = Y0 - 4. * GRIDY
- X0UB = X0TB + DXTB - 2. * GRIDX
- Y0UB = Y0TB + 2. * GRIDY
-* CSIZE = 0.2* GRIDY
-* CSIZE = 0.4 * GRIDY
- CSIZE=0.5 * GRIDY * CSFACT
- ARRLEN = GRIDX/4.
-* # of first level down banks to be drawn
-* # of grid points available
- NGRIDY = YRANGE/GRIDY
-* need 5 gridunits for top bank, 2 units for down banks
- NBKODM = (NGRIDY-6)/2
- X0LK = X0TB
- Y0DB = Y0TB
- IF(REQINP)THEN
-* is cursor in up-bank
- IF(DZDINB(XCUR,YCUR,
- + X0UB, X0UB+DXUB,Y0UB,Y0UB+DYB))THEN
- L = LB(L+1)
- IFLCUR = 1
- GOTO 90
- ENDIF
- CALL DZDCKC(XCUR,YCUR,X0TB,Y0TB,LB,IB,L,IFLCUR)
- IF(IFLCUR .GT. 0)THEN
-* LTOP = L
- GOTO 90
- ENDIF
- ELSE
- CALL DZDHEA(LB,IB,L)
- IF(ILKACT .GT. 1)THEN
- IF(IFLDIR.EQ.0)THEN
- CALL DZDLBX(X0TB,Y0TB,1,ILKACT-1,NS)
- ELSE
- CALL DZDBOX(X0TB-4.*DXLK,X0TB,Y0TB,Y0TB+DYB,1000)
- ENDIF
- X0LK = X0TB-4.*DXLK
- ENDIF
- ENDIF
- IF(ILKACT .LE. 0)THEN
- ILD1 = 1
- ELSE
- ILD1 = ILKACT
- ENDIF
-
-* total number of live banks 2 levels deep
- CALL DZDGNZ(LB,IB,L,ILD1,NLL1,NBLEV1, NULEV1, NBLEVD)
- NLIVET=NBLEV1+NBLEVD
- IF(INDEX(CHOPT,'1').EQ.0)NLIVET=0
-* loop on down first level down banks (until label 70)
-
- ILLEV1=ILD1
-25 CONTINUE
-
-* all done?
- IF(ILLEV1.GT.NL)GOTO 75
-
- LREF(1,IST) = DZDGLK(LB,IB,L,ILLEV1)
- X0LK = X0LK - DXLK
-* link zero draw just the little box
- IF(LREF(1,IST) .EQ. 0)THEN
- IF(.NOT. REQINP)THEN
-* look if more then 4 zero links are there, skip them
- NL0=0
- DO 26 I=ILLEV1,NL
- IF(LB(L-I).NE.0)GOTO 27
-26 NL0=NL0+1
-
-* all rest = 0
- GOTO 70
-
-27 IF(NL0.GT.4)THEN
- IF(ILLEV1+NL0.GT.NL)GOTO 75
- X0LK=X0LK+DXLK
- IF(IFLDIR.EQ.0)THEN
- CALL DZDLBX(X0LK,Y0TB,ILLEV1,ILLEV1+NL0-1,NS)
- ELSE
- CALL DZDBOX(X0LK-4.*DXLK,X0LK,Y0TB,Y0TB+DYB,1000)
- ENDIF
- ILLEV1=ILLEV1+NL0
- X0LK=X0LK-4.*DXLK
- GOTO 25
- ELSE
- CALL DZDSBX(X0LK,Y0TB,ILLEV1,NS)
- ENDIF
- ENDIF
- GOTO 70
- ENDIF
-* mark for subtree complete
- IF(IFMASC.NE.0)IB(LREF(1,IST))=IOR(IB(LREF(1,IST)),ALDBIT)
-
-* get the parameter for this down bank
- CALL DZDPAR(LB,IB,LREF(1,IST),
- + HIDDW, NUMIDD, HIDUPX, HIDNXX, JBIASX, NLD, NSD, NDD)
- X0LEV1 = X0TB + 2.*DXB
- Y0DB = Y0DB - 2.*GRIDY
-
-* arrived at bottom of paper?
-
- IF(Y0DB .LT. 1.*GRIDY)THEN
- X0LB = X0LK + DXLK
- IF(.NOT. REQINP)THEN
- IF(ILLEV1.EQ.NL)THEN
- CALL DZDSBX(X0LB,Y0TB,ILLEV1,NS)
- ELSE
- CALL DZDLBX(X0LB,Y0TB,ILLEV1,NL,NS)
- ENDIF
- ENDIF
- ILKACT = ILLEV1
- GOTO 90
- ENDIF
-*
- IF(REQINP)THEN
- CALL DZDCKC(XCUR,YCUR,X0LEV1,Y0DB,LB,IB,LREF(1,IST),IFLCUR)
- IF(IFLCUR .GT. 0)THEN
- L = LREF(1,IST)
- GOTO 90
- ENDIF
- ELSE
- NRL = NLD - NSD
-*12/2
-* try to fit a next bank
-
- IF(X0LEV1+2.*DXTB .LE. XRANGE .AND. HIDNXX.NE.' ')THEN
-* make it a bit smaller
- DXX=DXTB-3.*GRIDX
-* HIDNXX=' '
-* draw the bank
- CALL DZDBNK(LB,IB,LREF(1,IST),
- + X0LEV1, Y0DB, DXX, DYB, HIDDW, ' ',HIDUPX,
-* + X0LEV1, Y0DB, DXX, DYB, HIDDW, HIDNXX,HIDUPX,
- + NUMIDD, NDD)
-* now the next bank
- LREF(1,IST)=LB(LREF(1,IST))
- CALL DZDPAR(LB,IB,LREF(1,IST),
- + HIDDW, NUMIDD, HIDUPX, HIDNXN, JBIASX, NNN, NSD, NDD)
-* if its documentation only 1 next bank was booked assume more
- IF(IFRCAR.NE.0 .AND. HIDNXN.EQ.' ')HIDNXN=HIDNXX
- CALL DZDBNK(LB,IB,LREF(1,IST),
- + X0LEV1+DXX+3.*GRIDX, Y0DB, DXX, DYB, HIDDW, HIDNXN,HIDUPX,
- + NUMIDD, NDD)
- XPOL(1) = X0LEV1+DXX+2.5*GRIDX
- YPOL(1) = Y0DB + 0.5*DYB
- XPOL(2) = X0LEV1+DXX+3.*GRIDX
- YPOL(2) = YPOL(1)
- XPOL(3) = ARRLEN
- YPOL(3) = 0.
- CALL DZDLI2(3,XPOL,YPOL,0)
- ELSE
- CALL DZDBNK(LB,IB,LREF(1,IST),
- + X0LEV1, Y0DB, DXTB, DYB, HIDDW, HIDNXX,HIDUPX,
- + NUMIDD, NDD)
- ENDIF
- LREF(1,IST) = LB(L-ILLEV1)
-* link to bank
- CALL DZDLNK(X0LK, Y0TB, X0LEV1, Y0DB, ILLEV1, NS)
- ENDIF
-
-* count number of non zero down links at level 2
-
- CALL DZDGNZ(LB,IB,LREF(1,IST),1,NLDON1,NBLEV2, NULEV2, NN)
-
- Y0LEV1= Y0DB
-
-* make sure:
-* highest non zero link <= MALEV2 (avoid crossings)
-* not more than NBKODM (13) in total
- MALEV2=4+ILLEV1
- IF(ILLEV1.EQ.NULEV1)MALEV2=MAX(MALEV2,8)
- IF(NBLEV2.GT.0 .AND.
- & NLIVET .LE. NBKODM .AND.
- & NBTOT+NBLEV2 .LE. NBKODM .AND.
- & (NULEV2.LE.MALEV2 .OR.
- & (NLDON1.EQ.1 .AND. NBLEV2.EQ.1)))THEN
-
-* total number of banks we have to draw
- NBTOT=NBTOT+NBLEV2
-
-* draw the links at down level 2
-
- DO 50 ILLEV2=1,NULEV2
- CALL DZDTRE(LB,IB,LREF(1,IST),
- & ILLEV2,X0LEV1,Y0LEV1,Y0DB,
- & REQINP,L,XCUR,YCUR,IFLCUR,0)
- IF(REQINP .AND.IFLCUR .GT. 0)GOTO 90
-
- LREF(2,IST)=DZDGLK(LB,IB,LREF(1,IST),ILLEV2)
- IF(LREF(2,IST).EQ.0) GOTO 50
-
-* can we fit another level?
-
- X0LEV2=X0LEV1+4.*DXLK
- XRIGEN=X0LEV2+8.*DXLK+DXTB
- CALL DZDGNZ(LB,IB,LREF(2,IST),1,NLDON1,NBLEV3, NULEV3,NN)
- IF(NULEV3.EQ.0) GOTO 50
- MALEV3=4+ILLEV2
- IF(ILLEV2.EQ.NULEV2)MALEV3=MAX(MALEV3,8)
-
- Y0LEV2= Y0DB
- IF(XRIGEN.LT.XRANGE .AND.
- & NBLEV3.GT.0 .AND.
- & NBTOT+NBLEV3 .LE. NBKODM .AND.
- & (NULEV3.LE.MALEV3 .OR.
- & (NLDON1.EQ.1 .AND. NBLEV3.EQ.1)))THEN
- NBTOT=NBTOT+NBLEV3
-
-* draw the links at down level 3
-
- DO 45 ILLEV3=1,NULEV3
- CALL DZDTRE(LB,IB,LREF(2,IST),
- & ILLEV3,X0LEV2,Y0LEV2,Y0DB,
- & REQINP,L,XCUR,YCUR,IFLCUR,0)
- IF(REQINP .AND. IFLCUR .GT. 0)GOTO 90
-
- LREF(3,IST)=DZDGLK(LB,IB,LREF(2,IST),ILLEV3)
- IF(LREF(3,IST).EQ.0) GOTO 45
-
-* yet another one?
-
- X0LEV3=X0LEV2+4.*DXLK
- XRIGEN=X0LEV3+8.*DXLK+DXTB
- CALL DZDGNZ(LB,IB,LREF(3,IST),1,
- & NLDON1,NBLEV4,NULEV4,NN)
- IF(NULEV4.EQ.0) GOTO 45
- Y0LEV3= Y0DB
- MALEV4=4+ILLEV3
- IF(ILLEV3.EQ.NULEV3)MALEV4=MAX(MALEV4,8)
- IF(XRIGEN.LT.XRANGE .AND.
- & NBLEV4.GT.0 .AND.
- & NBTOT+NBLEV4 .LE. NBKODM .AND.
- & (NULEV4.LE.MALEV4 .OR.
- & (NLDON1.EQ.1 .AND. NBLEV4.EQ.1)))THEN
- NBTOT=NBTOT+NBLEV4
-
-* draw the links at down level 4
-
- DO 40 ILLEV4=1,NULEV4
- CALL DZDTRE(LB,IB,LREF(3,IST),
- & ILLEV4,X0LEV3,Y0LEV3,Y0DB,
- & REQINP,L,XCUR,YCUR,IFLCUR,1)
- IF(REQINP .AND. IFLCUR .GT. 0)GOTO 90
-* end level 4
-40 CONTINUE
-
- ELSE
- IF(.NOT.REQINP)CALL DZDLBX(X0LEV3,Y0LEV3,1,NULEV4,
- & IB(LREF(3,IST)-3))
-* mark for subtree not complete
- IF(IFMASC.NE.0)
- & IB(LREF(1,IST))=IAND(IB(LREF(1,IST)),NOT(ALDBIT))
- ENDIF
-* end level 3
-45 CONTINUE
-
- ELSE
- IF(.NOT.REQINP)CALL DZDLBX(X0LEV2,Y0LEV2,1,NULEV3,
- & IB(LREF(2,IST)-3))
-* mark for subtree not complete
- IF(IFMASC.NE.0)
- & IB(LREF(1,IST))=IAND(IB(LREF(1,IST)),NOT(ALDBIT))
- ENDIF
-
-* end level 2
-50 CONTINUE
-
-* adjust X0 at down level 1
- X01 = X0LEV1 - FLOAT(NULEV2+1)*DXLK
-
- IF(.NOT. REQINP .AND. IFMASC .NE. 0 .AND. IB(L+2) .LT. 0)THEN
- CALL DZDSBX(X01,Y0LEV1,ILLEV1,NSD)
-* mark for subtree not complete
- IF(IFMASC.NE.0)
- & IB(LREF(1,IST))=IAND(IB(LREF(1,IST)),NOT(ALDBIT))
- ENDIF
- ELSE
-
-* only indicate links of down bank
- IF(NSD .NE. 0 .AND. .NOT.REQINP )THEN
- IF(IFRCAR .NE. 0 .AND. IB(LREF(1,IST)+2) .LT. 0)THEN
- NS1 = -1
- ELSE
- NS1 = NSD
- ENDIF
-* only if its doc or if links are not 0
- IF(IFRCAR .NE. 0 .OR. NBLEV2.GT.0)
- & CALL DZDLBX(X0LEV1, Y0DB, 1,NS1,NSD)
- ENDIF
-* mark for subtree not complete
- IF(IFMASC.NE.0)
- & IB(LREF(1,IST))=IAND(IB(LREF(1,IST)),NOT(ALDBIT))
- ENDIF
-
- 70 CONTINUE
- ILLEV1=ILLEV1+1
- GOTO 25
-
-* end loop down banks
-
-75 CONTINUE
-
- X0LK = X0LK - DXLK
- IF(IFRCAR .NE. 0 .AND. IB(L+2) .LT. 0)THEN
- IF(.NOT. REQINP)THEN
- CALL DZDSBX(X0LK,Y0TB,-1,NSD)
- ENDIF
- ENDIF
- 80 CONTINUE
- ILKACT = 0
- 90 CONTINUE
-* deactivate link area
- LREF(-1,IST) = 0
- YBOTTM = Y0DB/YRANGE
- IF (YBOTTM .LT. 0.)YBOTTM = 0.
- END
-******************************************************************
diff --git a/src/graflib/dzdoc/dzdraw/dzdraw.F b/src/graflib/dzdoc/dzdraw/dzdraw.F
deleted file mode 100644
index 423eeca..0000000
--- a/src/graflib/dzdoc/dzdraw/dzdraw.F
+++ /dev/null
@@ -1,39 +0,0 @@
-*
-* $Id: dzdraw.F,v 1.1.1.1 1996/03/04 16:13:08 mclareni Exp $
-*
-* $Log: dzdraw.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:08 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDRAW(IXSTOR,LTOP,ILKACT
- & ,CHOPT)
-*.
-*...DZDRAW draw a data structure on open workstations(s)
-*.
-*. INPUT : IXSTOR Store index
-*. LTOP Link to top bank to be displayed
-*. ILKACT the link where drawing of down banks starts
-*. CHOPT Character option
-*. 'R' discriptor Rz-file available
-*. OUTPUT : none
-*.
-*. CALLS : DZDRA1
-*. CALLED : DZDISP, USER
-*.
-*. AUTHOR : O.Schaile
-*. VERSION : 1.00
-*. CREATED : 11-Dec-87
-*.**********************************************************************
-*.
- CHARACTER*(*) CHOPT
- LOGICAL REQINP
-*---
- REQINP = .FALSE.
- CALL DZDRA1(IXSTOR,LTOP, ILKACT
- & ,CHOPT, XCUR, YCUR, REQINP,IFLCUR,YTOP,YBOTTM)
- RETURN
- END
-*
-************************************************************************
diff --git a/src/graflib/dzdoc/dzdraw/dzdrot.F b/src/graflib/dzdoc/dzdraw/dzdrot.F
deleted file mode 100644
index 035c030..0000000
--- a/src/graflib/dzdoc/dzdraw/dzdrot.F
+++ /dev/null
@@ -1,30 +0,0 @@
-*
-* $Id: dzdrot.F,v 1.1.1.1 1996/03/04 16:13:15 mclareni Exp $
-*
-* $Log: dzdrot.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:15 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDROT(X0,Y0,X1,Y1,ANG)
-*.
-*...DZDROT rotate X0, Y0 counterclockwise around origin
-*.
-*. INPUT : X0, Y0 points to be rotated
-*. OUTPUT : X1, Y1 the rotated points
-*. ANG rotation angle (in degree)
-*.
-*. AUTHOR : O.Schaile
-*. VERSION : 1.00
-*. CREATED : 11-Dec-87
-*.
- PARAMETER (DEGRAD = 0.0174533)
- AN1 = ANG*DEGRAD
- XX = X0 * COS(AN1) - Y0 * SIN(AN1)
- YY = X0 * SIN(AN1) + Y0 * COS(AN1)
- X1=XX
- Y1=YY
- END
-*
-************************************************************************
diff --git a/src/graflib/dzdoc/dzdraw/dzdrwf.F b/src/graflib/dzdoc/dzdraw/dzdrwf.F
deleted file mode 100644
index 23fd108..0000000
--- a/src/graflib/dzdoc/dzdraw/dzdrwf.F
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: dzdrwf.F,v 1.1.1.1 1996/03/04 16:13:05 mclareni Exp $
-*
-* $Log: dzdrwf.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:05 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDRWF
-* IMPLICIT NONE
- INTEGER NCH, LUN
- CHARACTER*4 CHLUN
-
- CALL KUGETC(CHLUN,NCH)
- IF(NCH.LE.0)GOTO 999
- CALL DZDCTI(CHLUN,LUN)
- CALL FZENDI(LUN,'I')
-999 END
-***********************************************************************
diff --git a/src/graflib/dzdoc/dzdraw/dzdsbx.F b/src/graflib/dzdoc/dzdraw/dzdsbx.F
deleted file mode 100644
index ba30d21..0000000
--- a/src/graflib/dzdoc/dzdraw/dzdsbx.F
+++ /dev/null
@@ -1,56 +0,0 @@
-*
-* $Id: dzdsbx.F,v 1.1.1.1 1996/03/04 16:13:12 mclareni Exp $
-*
-* $Log: dzdsbx.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:12 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDSBX(X0,Y0,IL,NSREAL)
-*.
-*...DZDSBX draw a link box with one link
-*.
-*. INPUT : X0,X1,Y0,Y1 coordinates of the box
-*. IL link number
-*. CS character size
-*.
-*. SEQUENCE : DZDCHV
-*. CALLS : DZDBOX DZDTXT
-*. CALLED : DZDRA2, DZDLNK
-*.
-*. AUTHOR : O.Schaile
-*. VERSION : 1.00
-*. CREATED : 11-Dec-87
-*. LAST MOD : 18-Mar-88
-*.
-*. Modification Log.
-*. 18-Mar-88: include possible negative IL
-*.**********************************************************************
-*.
-#include "dzdprm.inc"
-#include "dzdchv.inc"
- IF(IL.GT.NSREAL)CALL ISLN(3)
- CALL DZDBOX(X0,X0+DXLK,Y0,Y0+DYB,1000*IFLDIR+0)
- IF(IL.GT.NSREAL)CALL ISLN(1)
- IF(IFLDIR .NE. 0)GOTO 999
- IF(IL .GT. 0)THEN
- IL1=MOD(IL,10)
- WRITE(CLINE,'(I8)')IL1
- ELSE
- IFC = 8
- CLINE(1:IFC)= ' *'
- ENDIF
- IFC = INDEXC(CLINE,' ')
-* left
-* XT = X0+0.05*CSIZE
-* YT = Y0+0.15*CSIZE
-* IALG=1
-* left
- XT = X0+DXLK*0.5
- YT = Y0+DYB*0.5
- IALG = 2
- CALL DZDTXT(CLINE(IFC:8),8-IFC+1
- & ,XT,YT,CSIZE,0.,IALG)
-999 END
-**********************************************************************
diff --git a/src/graflib/dzdoc/dzdraw/dzdsdo.F b/src/graflib/dzdoc/dzdraw/dzdsdo.F
deleted file mode 100644
index 7eb61b3..0000000
--- a/src/graflib/dzdoc/dzdraw/dzdsdo.F
+++ /dev/null
@@ -1,52 +0,0 @@
-*
-* $Id: dzdsdo.F,v 1.1.1.1 1996/03/04 16:13:01 mclareni Exp $
-*
-* $Log: dzdsdo.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:01 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDSDO(IST,L,LUN,CHKEYI,CHOPT)
- CHARACTER*(*) CHOPT, CHKEYI
-#include "zebra/zebq.inc"
-#include "zebra/mzca.inc"
-#include "zebra/mzcb.inc"
-#include "zebra/mzcc.inc"
-#include "zebra/mzcn.inc"
-#include "zebra/zunit.inc"
-#include "dzdzbrinc.inc"
- INTEGER KEYV(2), LUP, LUSAVE
- CHARACTER*8 CHKEY
- SAVE LUSAVE
-*---
- CALL DZDIBR
-* display documentation
- IF(CTDDOC .NE. ' ')THEN
- CALL RZCDIR(CWDSAV,'R')
- LUSAVE=IQPRNT
- IQPRNT=LUN
- IF(CHKEYI(1:1).EQ.' ')THEN
- CALL MZSDIV(IST,-7)
- KEYV(1)=IQ(KQS+L-4)
- CALL UHTOC(KEYV(1),4,CHKEY,4)
- LUP = LQ(KQS+L+1)
- IF(LUP .GT. 2)THEN
- KEYV(2)=IQ(KQS+LUP-4)
- CALL UHTOC(KEYV(2),4,CHKEY(5:8),4)
- ELSE
- CHKEY(5:8) = 'NONE'
- CALL UCTOH(CHKEY(5:8) ,KEYV(2),4,4)
- ENDIF
- ELSE
- CHKEY=CHKEYI
- ENDIF
- CALL DZDOCO(IQPRNT,CHKEY,CHOPT)
- IQPRNT=LUSAVE
- CALL RZCDIR(CWDSAV,' ')
- ELSE
- WRITE(*,*)'No documentation file open'
- ENDIF
- END
-
-*********************************************************************
diff --git a/src/graflib/dzdoc/dzdraw/dzdsfb.F b/src/graflib/dzdoc/dzdraw/dzdsfb.F
deleted file mode 100644
index f19b4f3..0000000
--- a/src/graflib/dzdoc/dzdraw/dzdsfb.F
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: dzdsfb.F,v 1.1.1.1 1996/03/04 16:13:04 mclareni Exp $
-*
-* $Log: dzdsfb.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:04 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDSFB
-* IMPLICIT NONE
-#include "dzdzbrinc.inc"
- CHARACTER*4 CHMASK
- INTEGER NCH,I
- CALL KUGETC(CHMASK,NCH)
- IF(NCH.GT.0)THEN
- CIDMSK=CHMASK
- DO 10 I=1,4
-10 IF(CIDMSK(I:I).EQ.'*')CIDMSK(I:I)=' '
- ELSE
- CIDMSK=' '
- ENDIF
- CALL KUGETI(NIDMSK)
- END
-***********************************************************************
diff --git a/src/graflib/dzdoc/dzdraw/dzdsfk.F b/src/graflib/dzdoc/dzdraw/dzdsfk.F
deleted file mode 100644
index ccfd29e..0000000
--- a/src/graflib/dzdoc/dzdraw/dzdsfk.F
+++ /dev/null
@@ -1,45 +0,0 @@
-*
-* $Id: dzdsfk.F,v 1.1.1.1 1996/03/04 16:13:04 mclareni Exp $
-*
-* $Log: dzdsfk.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:04 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDSFK
-* IMPLICIT NONE
-#include "dzdzbrinc.inc"
- CHARACTER*4 CVALUE,CHYENO
- CHARACTER*8 CHOPT
- INTEGER NCH,NCH1, IVALUE, IKEYNR
- CALL KUGETI(IKEYNR)
- IF(IKEYNR.LE.0 .OR. IKEYNR.GT.9)THEN
- WRITE(*,*)'Illegal key, must be 0<key<10'
- GOTO 999
- ENDIF
- CALL KUGETI(IVALUE)
- CALL KUGETC(CVALUE,NCH)
- CALL KUGETC(CHOPT,NCH1)
- CALL KUGETC(CHYENO,NCH1)
- IF(CHYENO.EQ.'YES')THEN
- IAPPFL=1
- ELSE
- IAPPFL=0
- ENDIF
- IF (CHOPT.EQ.'RESET')THEN
- KACMSK(IKEYNR)=0
- ELSE IF (CHOPT.EQ.'CHAR')THEN
- CALL UHTOC(CVALUE,KEYMSK(IKEYNR),4,4)
- KACMSK(IKEYNR)=1
- ELSE
- KEYMSK(IKEYNR)=IVALUE
- KACMSK(IKEYNR)=1
- ENDIF
- NCH=0
- DO 10 I=1,9
- IF(KACMSK(I).NE.0)NCH=NCH+1
-10 CONTINUE
- NKYMSK=NCH
-999 END
-***********************************************************************
diff --git a/src/graflib/dzdoc/dzdraw/dzdsh1.F b/src/graflib/dzdoc/dzdraw/dzdsh1.F
deleted file mode 100644
index 5e2e928..0000000
--- a/src/graflib/dzdoc/dzdraw/dzdsh1.F
+++ /dev/null
@@ -1,211 +0,0 @@
-*
-* $Id: dzdsh1.F,v 1.1.1.1 1996/03/04 16:13:02 mclareni Exp $
-*
-* $Log: dzdsh1.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:02 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDSH1(IXDIV,LIN,CMD)
- INTEGER IXDIV,LIN
- CHARACTER*(*) CMD
-#include "dzdzbrinc.inc"
-#include "zebra/zebq.inc"
-#include "zebra/zunit.inc"
-#include "zebra/mzca.inc"
-#include "zebra/mzcb.inc"
-#include "zebra/mzcc.inc"
-#include "zebra/mzcn.inc"
-#include "zebra/mzbits.inc"
- INTEGER INFLUN,INFSTA, INFOFZ(40)
- COMMON/FZSTAT/ INFLUN,INFSTA, INFOFZ
-*--
- CHARACTER CQSTAK*13,CQINFO*40
- PARAMETER (NLICHQ=130,NSTCHQ=8,NDVCHQ=8,NBKCHQ=4 )
- CHARACTER CQLINE*(NLICHQ),CQMAP(10)*(NLICHQ)
- CHARACTER CQSTOR*(NSTCHQ),CQDIV*(NDVCHQ),CQID*(NBKCHQ)
- COMMON /DZC1CH/ CQSTOR,CQDIV,CQID,CQMAP,CQSTAK,CQINFO
- EQUIVALENCE (CQLINE,CQMAP)
-*--
- CHARACTER*1 CHMORE
- CHARACTER*4 CHDROP, CVALUE, CHYENO
- CHARACTER*12 CINTV
- CHARACTER*30 CTEMP
- INTEGER IDH, LL, LUSAVE, NC, N1, N2, K, I16X, IOTYP
- REAL RVALUE
- LOGICAL BTEST
- SAVE LUSAVE
-*
- LUSAVE=IQPRNT
- IF(CTDDOC.NE.' ')THEN
- CALL RZCDIR(CWDSAV,'R')
- CALL RZCDIR(CTDDOC,' ')
- ENDIF
- CTEMP='dzdoc.scratch'
- LUNTMP=0
- IF(
- & INDEX(CMD,'_TREE') .EQ.0 .AND.
- & INDEX(CMD,'MARK_NT').EQ.0 .AND.
- & INDEX(CMD,'_MORE') .EQ.0 .AND.
- & INDEX(CMD,'_DROP') .EQ.0 .AND.
- & INDEX(CMD,'_FOUT') .EQ.0 .AND.
- & INDEX(CMD,'_MODIFY').EQ.0 .AND.
- & INDEX(CMD,'_VECT') .EQ.0)THEN
- IF(LNEWWI)THEN
- LUNTMP=LUPTMP
- CALL KUOPEN(LUNTMP,CTEMP,'UNKNOWN',ISTAT)
- IQPRNT=LUNTMP
- ELSE
- IQPRNT=6
- LUNTMP=6
- ENDIF
- ENDIF
- IF (INDEX(CMD,'_CONT').NE.0)THEN
- IF(CTDDOC.NE.' ' .AND. INDEX(CMD,'DZ').EQ.0)THEN
- CALL DZDDWD(IXDIV,LIN,CHOPD1,0,0,LUNTMP)
- ELSE
- CALL DZSHOW(' ', IXDIV,LIN,
- & CHOPD1,0,0,0,0)
- ENDIF
- ELSE IF(INDEX(CMD,'_TREE').NE.0 .OR. INDEX(CMD,'_MORE').NE.0)THEN
- CALL IZPICT('DZDISP','SQ')
- CALL IZPICT('DZDISP','M')
- CALL MZSDIV(IXDIV,-7)
-* it is dropped meanwhile?
-
- LL=LIN
- IF(JBIT(IQ(LL+KQS),IQDROP).NE.0)THEN
- WRITE(*,*)'Bank got dropped meanwhile'
- GOTO 999
- ENDIF
-* CALL IACWK(IWKZEB)
- IF(INDEX(CMD,'_MORE').NE.0)THEN
- CHMORE='G'
- ELSE
- CHMORE=' '
- ENDIF
- CALL ISTXFP(6,0)
- CALL DZDISP(IXDIV,LIN,CTDDOC,'D'//CHMORE//CCOL//CCACT,
- & IWKZEB,IWMZEB,ILOZEB, 0)
-* CALL IUWK(0,1)
-* CALL IDAWK(IWKZEB)
-
- ELSE IF(INDEX(CMD,'_FOUT').NE.0)THEN
- CALL KUGETI(LUNFOU)
- CALL FZINFO(LUNFOU)
- IF(INFLUN.NE.LUNFOU)THEN
- WRITE(*,*)'FZ file not open, LUN:',LUNFOU
- GOTO 999
- ENDIF
- IF(.NOT.BTEST(INFSTA,11))THEN
- WRITE(*,*)'No write permission on LUN:',LUNFOU
- GOTO 999
- ENDIF
- CALL KUGETC(CVALUE,NC)
- IF(NC.GT.0)THEN
- CALL UCTOH(CVALUE,IDH,4,4)
- IF(IDH.NE.IQ(LIN+KQS-4))THEN
- WRITE(*,*)'Skip bank(tree): ',CVALUE
- GOTO 999
- ENDIF
- ENDIF
- CALL KUGETC(CHDROP,NC)
- CALL KUGETC(CHYENO,NC)
- IF(CHYENO(1:1).EQ.'Y')THEN
- NUHOUT=NUH
- ELSE
- NUHOUT=0
- ENDIF
- IF(LIN.EQ.0 .OR. INMFLG.EQ.1)THEN
-* header only
- CHDROP='Z'
- ENDIF
- IF(LIN .EQ. 0 .AND. NUHOUT.EQ.0)THEN
- WRITE(*,*)'No d/s .AND. no header'
- GOTO 999
- ENDIF
- CALL FZOUT(LUNFOU,IXDIV,LIN,1,CHDROP,IOCHRD,NUHOUT,IUHEAD)
-
- ELSE IF(INDEX(CMD,'_DROP').NE.0)THEN
- CALL KUGETC(CHDROP,NC)
- CALL MZDROP(IXDIV,LIN,CHDROP)
-
- ELSE IF(INDEX(CMD,'_MODIFY').NE.0)THEN
- CALL KUGETI(N1)
- CALL KUGETI(N2)
- IF(N2.EQ.0)N2=N1
- CALL KUGETC(CINTV,NC)
- CALL KUGETR(RVALUE)
- CALL KUGETS(CVALUE,NC)
- IF(N1.GT.IQ(LIN+KQS-1))THEN
- WRITE(*,*)' N1 bigger ND'
- GOTO 999
- ENDIF
- IF(N2.GT.IQ(LIN+KQS-1) .OR.N2 .LT. N1)THEN
- WRITE(*,*)' N2 > ND or N2 < N1'
- GOTO 999
- ENDIF
-* get old value
- IF(N1.GT.0)THEN
- CALL DZSHOW(' ',IXDIV, LIN,'Q',1,0,N1,N1)
- ELSE
- WRITE(CQLINE(12:22),'(I11)') IQ(LIN+KQS+N1)
- ENDIF
- IF(INDEX(CQLINE(12:22),'"').NE.0)THEN
- IOTYP=5
- ELSEIF(INDEX(CQLINE(12:22),'.').NE.0)THEN
- IOTYP=3
- ELSEIF(N1.EQ.-4 .AND. N2.EQ.-4)THEN
- IOTYP=5
- ELSE
- IOTYP=2
- ENDIF
- IF(N1.EQ.N2)THEN
- WRITE(6,'(A,I6,A,A,A,Z9)') ' Word: ',N1,' Old value was: ',
- + CQLINE(12:22) ,' Hex:',IQ(LIN+KQS+N1)
- ELSE
- CALL DZSHOW('Old values were: ', IXDIV, LIN,' ',
- + 1,0,N1,N2)
- ENDIF
- IF(IOTYP.EQ.5)THEN
- DO 100 K=N1,N2
- 100 CALL UCTOH(CVALUE,IQ(LIN+KQS+K),4,4)
- ELSEIF(IOTYP.EQ.3)THEN
- DO 110 K=N1,N2
- 110 Q(LIN+KQS+K)=RVALUE
- ELSE
- I16X=INDEX(CINTV,'16X')
- IF(I16X.NE.0) CINTV(I16X:I16X+2)=' $'
- CALL DZDCTI(CINTV,INTEVL)
- DO 120 K=N1,N2
- 120 IQ(LIN+KQS+K)=INTEVL
- ENDIF
- ELSE IF(INDEX(CMD,'_SYS').NE.0)THEN
- CALL DZDSYW(IXDIV, LIN, LUNTMP)
- ELSE IF(INDEX(CMD,'_DOC').NE.0)THEN
- CALL DZDSDO(IXDIV, LIN,LUNTMP,' ' ,'R')
- ELSE IF(INDEX(CMD,'_EDIT').NE.0)THEN
- CALL DZDED1(IXDIV, LIN)
-* CALL DZDSDO(IXDIV, LIN,LUNTMP,' ' ,'IR')
- ELSE IF(INDEX(CMD,'MARK_NT').NE.0)THEN
- CALL DZDMNT(IXDIV, LIN)
- ELSE IF(INDEX(CMD,'SURVEY').NE.0)THEN
- CALL DZSURV('--- Zbrowse ----', IXDIV, LIN)
- ELSE IF(INDEX(CMD,'_VECT').NE.0)THEN
- CALL DZDPUV(IXDIV, LIN)
- ENDIF
-
- IF(LUNTMP.EQ.LUPTMP)THEN
- CLOSE(LUNTMP)
- LUNTMP=0
- IF(EDITSV)THEN
- CALL KUESVR(CTEMP, ISTAT)
- ELSE
- CALL KUEDIT(CTEMP, ISTAT)
- ENDIF
- ENDIF
-999 IQPRNT=LUSAVE
- IF(CTDDOC.NE.' ')CALL RZCDIR(CWDSAV,' ')
- END
-*********************************************************************
diff --git a/src/graflib/dzdoc/dzdraw/dzdsha.F b/src/graflib/dzdoc/dzdraw/dzdsha.F
deleted file mode 100644
index 048de62..0000000
--- a/src/graflib/dzdoc/dzdraw/dzdsha.F
+++ /dev/null
@@ -1,76 +0,0 @@
-*
-* $Id: dzdsha.F,v 1.1.1.1 1996/03/04 16:13:01 mclareni Exp $
-*
-* $Log: dzdsha.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:01 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDSHA
-#include "dzdzbrinc.inc"
-#include "zebra/zebq.inc"
-#include "zebra/mzca.inc"
-#include "zebra/mzcb.inc"
-#include "zebra/mzcc.inc"
-#include "zebra/mzcn.inc"
-#include "zebra/mzbits.inc"
- INTEGER IHID, IUPHID, NID, IDIV, ISTORE, LGO, LUP, NPAR
- CHARACTER*4 CHID, CUPHID
- CHARACTER*80 CMD
-*--
- CALL DZDIBR
- CALL KUGETC(CHID,NCH)
- IF(NCH.EQ.0)THEN
- WRITE(*,*)'No bank Id given'
- GOTO 999
- ENDIF
- CALL KUPATL(CMD,NPAR)
- CALL UCTOH(CHID,IHID,4,4)
- CALL KUGETI(NID)
- CALL KUGETI(ISTORE)
- IF(ISTORE.LT.0 .OR. ISTORE.GT.16)ISTORE=0
- CALL KUGETI(IDIV)
- IF(IDIV.LE.0 .OR. IDIV.GT.20)IDIV=2
- CUPHID=' '
- CALL KUGETC(CUPHID,NCH)
- IF(CUPHID.NE.' ')CALL UCTOH(CUPHID,IUPHID,4,4)
-
- IXDIV=IDIV
- CALL SBYT(ISTORE,IXDIV,27,6)
- CALL MZSDIV(IXDIV,1)
-* init link area for this store
- IF(LZEFLG(ISTORE).EQ.0)THEN
- CALL MZLINK(IXDIV,'DZDZEB',
- & LZEBLK(1,ISTORE),LZEBLK(3,ISTORE),LZEBLK(3,ISTORE))
- LZEFLG(ISTORE)=1
- ENDIF
-
-* find the bank
-
- LGO=0
-10 CONTINUE
- IF(NID.EQ.0)THEN
- LZEBLK(3,ISTORE)=LZFIDH(IXDIV,IHID,LGO)
- ELSE
- LZEBLK(3,ISTORE)=LZFID(IXDIV,IHID,NID,LGO)
- ENDIF
- IF(LZEBLK(3,ISTORE).EQ.0)THEN
- WRITE(*,'(A,A,I3,A,I3)')
- & CHID,' not found in Store',ISTORE,' Division',IDIV
- GOTO 999
- ENDIF
- IF(CUPHID.NE.' ')THEN
- LGO=LZEBLK(3,ISTORE)
- LUP= LQ(LZEBLK(3,ISTORE)+1+KQS)
- IF(CUPHID.EQ.'NONE' .AND. LUP .NE. 0)GOTO 10
- IF(LUP.EQ.0)THEN
- WRITE(*,'(A,A,I3,A,I3)')
- & CHID,' not found in Store',ISTORE,' Division',IDIV
- GOTO 999
- ENDIF
- IF(IQ(LUP-4+KQS).NE.IUPHID)GOTO 10
- ENDIF
- CALL DZDSH1(IXDIV,LZEBLK(3,ISTORE),'_'//CMD)
-999 END
-*********************************************************************
diff --git a/src/graflib/dzdoc/dzdraw/dzdshd.F b/src/graflib/dzdoc/dzdraw/dzdshd.F
deleted file mode 100644
index b1b3ebd..0000000
--- a/src/graflib/dzdoc/dzdraw/dzdshd.F
+++ /dev/null
@@ -1,53 +0,0 @@
-*
-* $Id: dzdshd.F,v 1.1.1.1 1996/03/04 16:13:03 mclareni Exp $
-*
-* $Log: dzdshd.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:03 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDSHD
-#include "dzdzbrinc.inc"
- INTEGER NCH, IST, IXDIV, NPAR
- CHARACTER*80 CTEMP
- CHARACTER*4 CHOPT
- CHARACTER*80 CMD
-*--
- IF(CTDDOC.NE.' ')CALL RZCDIR(CWDSAV,'R')
- CALL DZDIBR
- CALL KUPATL(CMD,NPAR)
- CALL KUGETC(CTEMP,NCH)
- IST=IACTST
- IXDIV=2
-
- IF(NCH.NE.0)THEN
- IF (INDEX(CTEMP,'DIV').NE.0)THEN
- IFC=INDEX(CTEMP,'DIV')+3
- READ(CTEMP(IFC:IFC+1),'(I2)') IXDIV
- ENDIF
- IF (INDEX(CTEMP,'STORE').NE.0)THEN
- IFC=INDEX(CTEMP,'STORE')+5
- READ(CTEMP(IFC:IFC+1),'(I2)') IST
- ENDIF
- ENDIF
- CALL SBYT(IST,IXDIV,27,6)
- IF (CMD.EQ.'SHOW_STORE')THEN
- CALL DZSTOR('------ Zbrowse------',IXDIV)
- ELSE IF(CMD.EQ.'SNAP_DIV')THEN
- CALL DZSNAP('------ Zbrowse------',IXDIV,' ')
- ELSE IF(CMD.EQ.'VERIFY_DIV')THEN
- CALL KUGETC(CHOPT,NCH)
- CALL DZVERI('------ Zbrowse------',IXDIV,CHOPT)
- ELSE IF(CMD.EQ.'SHOW_DIV')THEN
- CALL IZPICT('DZDISP','SQ')
- CALL IZPICT('DZDISP','M')
- CALl ISTXFP(6,0)
- CALL DZDDIV(IXDIV,LBANKI,CTDDOC,'D'//CCOL//CCACT,
- & IWKZEB,IWMZEB,ILOZEB, 0)
- ELSE IF(CMD.EQ.'COL_GARB')THEN
- CALL MZGARB(IXDIV,0)
- ENDIF
- IF(CTDDOC.NE.' ')CALL RZCDIR(CWDSAV,' ')
- END
-***********************************************************************
diff --git a/src/graflib/dzdoc/dzdraw/dzdskd.F b/src/graflib/dzdoc/dzdraw/dzdskd.F
deleted file mode 100644
index 2733511..0000000
--- a/src/graflib/dzdoc/dzdraw/dzdskd.F
+++ /dev/null
@@ -1,62 +0,0 @@
-*
-* $Id: dzdskd.F,v 1.1.1.1 1996/03/04 16:13:04 mclareni Exp $
-*
-* $Log: dzdskd.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:04 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDSKD
-* IMPLICIT NONE
-#include "dzdzbrinc.inc"
-#include "dzdprm.inc"
- CHARACTER*3 CYENO
- CHARACTER*12 CMD
- INTEGER NCH
- CALL DZDIBR
- CALL KUPATL(CMD,NPAR)
- IF(CMD.EQ.'BANKCOLOR')THEN
- CALL KUGETC(CYENO,NCH)
- IF(INDEX(CYENO,'Y').NE.0)THEN
- CCOL='C'
- ELSE
- CCOL=' '
- ENDIF
- CALL KUGETI(IBCCOL)
- CALL KUGETI(IBDCOL)
- ELSE IF(CMD.EQ.'GEOMFONT')THEN
- CALL KUGETR(GRIDSC)
- CALL KUGETI(IDZTFO)
- CALL KUGETI(IDZTPR)
- ELSE IF(CMD.EQ.'WORKSTATION')THEN
- CALL KUGETC(CYENO,NCH)
- IF(INDEX(CYENO,'Y').NE.0)THEN
- CCACT=' '
- ELSE
- CCACT='N'
- ENDIF
- CALL KUGETI(IWKZEB)
- ELSE IF(CMD.EQ.'REF_LINKS')THEN
- CALL KUGETC(CYENO,NCH)
- IF(INDEX(CYENO,'Y').NE.0)THEN
- IDREFL=1
- ELSE
- IDREFL=0
- ENDIF
- ELSE IF(CMD.EQ.'BROWSEKEY')THEN
- CALL KUGETI(IKDSP1)
- CALL KUGETI(IKDSP2)
- CALL KUGETI(ICYDSP)
- ELSE IF(CMD.EQ.'DZSHOW_OPT')THEN
- CALL KUGETC(CHOPD1,NCH)
- ELSE IF(CMD.EQ.'NEW_WINDOW')THEN
- CALL KUGETC(CYENO,NCH)
- IF(INDEX(CYENO,'Y').NE.0)THEN
- LNEWWI=.TRUE.
- ELSE
- LNEWWI=.FALSE.
- ENDIF
- ENDIF
- END
-***********************************************************************
diff --git a/src/graflib/dzdoc/dzdraw/dzdspi.F b/src/graflib/dzdoc/dzdraw/dzdspi.F
deleted file mode 100644
index ea6eb91..0000000
--- a/src/graflib/dzdoc/dzdraw/dzdspi.F
+++ /dev/null
@@ -1,55 +0,0 @@
-*
-* $Id: dzdspi.F,v 1.1.1.1 1996/03/04 16:13:02 mclareni Exp $
-*
-* $Log: dzdspi.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:02 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDSPI
-#include "dzdzbrinc.inc"
-#include "zebra/zebq.inc"
-#include "zebra/mzca.inc"
-#include "zebra/mzcb.inc"
-#include "zebra/mzcc.inc"
-#include "zebra/mzcn.inc"
-#include "zebra/mzbits.inc"
- INTEGER IBANK, IBANK1, IIST,NPAR
- CHARACTER*80 CMD
- CHARACTER*(*) CMD1
-*--
- CALL KUGETI(IBANK)
- IF(IBANK.EQ.0)GOTO 999
- CALL KUPATL(CMD,NPAR)
- GOTO 10
-
- ENTRY DZDSP1(IBANK1,CMD1)
- CMD=CMD1
- IBANK=IBANK1
-10 CONTINUE
- CALL DZDIBR
- IIST=0
- IF(IBANK.LT.0)THEN
-* coming from graphics display
- IBANK=-IBANK
- IF(NLKUSE.EQ.0)GOTO 999
- IF(IBANK .GT. NLKUSE) GOTO 888
- CALL SBYT(ISTUSE,IIST,27,6)
- CALL MZSDIV(IIST,-7)
- IF(LQ(LTDISP(ISTUSE)+KQS-IBANK).NE.0)
- & CALL DZDSH1(IIST,LQ(LTDISP(ISTUSE)+KQS-IBANK),CMD)
- ELSE
-* coming from browser
- CALL SBYT(IACTST,IIST,27,6)
- CALL MZSDIV(IIST,-7)
- IF(IBANK.GT.IQ(LTBROW(IACTST)+KQS-3))GOTO 888
- IIST=IQ(LTBROW(IACTST)+KQS+1)
- CALL MZSDIV(IIST,-7)
- IF(LQ(LTBROW(IACTST)+KQS-IBANK).NE.0)
- & CALL DZDSH1(IIST,LQ(LTBROW(IACTST)+KQS-IBANK),CMD)
- ENDIF
- GOTO 999
-888 WRITE(*,*)'Invalid bank id given', IBANK
-999 END
-*********************************************************************
diff --git a/src/graflib/dzdoc/dzdraw/dzdsrs.F b/src/graflib/dzdoc/dzdraw/dzdsrs.F
deleted file mode 100644
index eb7c398..0000000
--- a/src/graflib/dzdoc/dzdraw/dzdsrs.F
+++ /dev/null
@@ -1,38 +0,0 @@
-*
-* $Id: dzdsrs.F,v 1.1.1.1 1996/03/04 16:13:05 mclareni Exp $
-*
-* $Log: dzdsrs.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:05 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDSRS
-#include "zebra/zunit.inc"
-#include "dzdzbrinc.inc"
- INTEGER NCH, IFC, LUSAVE, INDEXC,ISTAT
- CHARACTER*20 CHPATH
-
- CALL KUGETC(CHPATH,NCH)
- IF(NCH.LE.0)GOTO 999
- IFC=INDEX(CHPATH,'R_')
- IF(IFC.LE.0)IFC=INDEXC(CHPATH,'/')-2
- LUSAVE=IQPRNT
- LUNTMP=LUPTMP
- CALL KUOPEN(LUNTMP,'dzdoc.scratch1','UNKNOWN',ISTAT)
- IQPRNT=LUNTMP
- CALL RZSTAT('//'//CHPATH(IFC+2:),100,' ')
- CLOSE(LUNTMP)
- LUNTMP=0
- IF(EDITSV)THEN
- CALL KUESVR('dzdoc.scratch1', ISTAT)
- ELSE
- CALL KUEDIT('dzdoc.scratch1', ISTAT)
- LUNTMP=LUPTMP
- CALL KUOPEN(LUNTMP,'dzdoc.scratch1','UNKNOWN',ISTAT)
- IF(ISTAT.EQ.0)CALL KICLOS(LUNTMP,'DELETE',ISTAT)
- LUNTMP=0
- ENDIF
- IQPRNT=LUSAVE
-999 END
-***********************************************************************
diff --git a/src/graflib/dzdoc/dzdraw/dzdst1.F b/src/graflib/dzdoc/dzdraw/dzdst1.F
deleted file mode 100644
index 06e97ef..0000000
--- a/src/graflib/dzdoc/dzdraw/dzdst1.F
+++ /dev/null
@@ -1,291 +0,0 @@
-*
-* $Id: dzdst1.F,v 1.1.1.1 1996/03/04 16:13:15 mclareni Exp $
-*
-* $Log: dzdst1.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:15 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
-
- SUBROUTINE DZDST1(IXIN,IFW,ILW,REQINP,XC,YC,
- + LRET,IFARET,ILARET,CHOPT)
- CHARACTER*(*) CHOPT
-*.
-*...DZDST1
-*.
-*. INPUT : IXIN division index
-*. IFW first word in division to display
-*. ILW last word
-*. REQINP return link to bank where locator
-*. points to, dont do display
-*. XC,YC position of locator
-*.
-*. OUTPUT : LRET link to bank
-*. IFARET first address of selected bank
-*. ILARET last address of selected bank
-
-*.
-*. COMMON : DZDVAR
-*. SEQUENCE :
-*. CALLS : DZDBOX DZDNBK UHTOC
-*. CALLED : DZDDIV
-*.
-*. AUTHOR : O. Schaile
-*. VERSION : 1.00
-*. CREATED : 3-Feb-88
-*.**********************************************************************
-*.
-#include "zebra/zebq.inc"
-#include "zebra/mzca.inc"
-#include "zebra/mzcb.inc"
-#include "zebra/mzcc.inc"
-#include "zebra/mzcn.inc"
-*.
-#include "dzdzbrinc.inc"
- LOGICAL REQINP
- CHARACTER*4 CHIDBK
- COMMON/DZDVAR/X0,DX,Y0,DY,GRYDDV, CSDDV,
- + LENBLO, XENBLO, NCOLAC, IPRTFL
- REAL X(2),Y(2), XB(5),YB(5)
- INTEGER IHIDBK
-
- DY2 = DY/2.
- LGO = 0
- LRET = 0
- IF(INDEX(CHOPT,'D').NE.0)THEN
- NLL=IQ(LTDISP(ISTUSE)+KQS-3)
- LQ(LTDISP(ISTUSE)+KQS-NLL)= 0
- ENDIF
- 10 CONTINUE
-
- CALL MZSDIV (IXIN,1)
- IF(INDEX(CHOPT,'D').NE.0)THEN
- LGO= LQ(LTDISP(ISTUSE)+KQS-NLL)
- ENDIF
- CALL DZDNBK(IXIN, LGO ,LL,IFADR,ILA,IHIDBK,IDRFLG)
- IF(LL .EQ. 0)GOTO 999
- ISHADE = 3
- IF(INDEX(CHOPT,'D').NE.0)THEN
- LQ(LTDISP(ISTUSE)+KQS-NLL) = LL
- ELSE
- LGO=LL
- ENDIF
- IF(IFADR .GE. ILW) GOTO 10
- IF(ILA .LE. IFW) GOTO 10
- IFADD = IFADR - IFW
- ILADD1 = ILA - IFW
- IF(IFADD .LT. 0)IFADD = 0
-
-* left boundary
- IBL1 = IFADD/LENBLO + 1
- IW1 = IFADD-(IBL1-1)*LENBLO
- XW1 = FLOAT(IW1)/XENBLO*DX+X0
- X(1) = XW1
- X(2) = X(1)
- Y(1) = Y0 - (FLOAT(IBL1-1)+0.1)*GRYDDV
- Y(2) = Y(1) + DY
-
- IF(REQINP)THEN
-
-* cursor above bank or left and above?
-
- IF(YC .GT. Y(2))GOTO 30
- IF(YC .GT. Y(1) .AND. XC .LT. X(1))GOTO 30
- ELSE
- CALL DZDGPL(2,X,Y)
- ENDIF
-* right boundary
- IBL2 = ILADD1/LENBLO + 1
- IW2 = ILADD1-(IBL2-1)*LENBLO
- XW2 = FLOAT(IW2)/XENBLO*DX+X0
- X(1) = XW2
- X(2) = X(1)
- Y(1) = Y0 - (FLOAT(IBL2-1)+0.1)*GRYDDV
- Y(2) = Y(1) + DY
- IF(REQINP)THEN
-
-* cursor below bank or right and below?
-
- IF(YC .LT. Y(1))GOTO 30
- IF(YC .LT. Y(2) .AND. XC .GT. X(1))GOTO 30
- LRET = LL
- IFARET = IFADR
- ILARET = ILA
- GOTO 999
- ENDIF
- IF(IPRTFL .GT. 0)
- + WRITE(*,'(1X,A4,1X,2I10)')IHIDBK,IFADR,ILA
-
- CALL DZDGPL(2,X,Y)
- Y(1) = Y(1) + DY2
- Y(2) = Y(1)
- X(1) = XW1
-* left and right boundaries are not in same line
- IF(IBL1 .NE. IBL2)THEN
- DX1 = X0 + DX - XW1
- DX2 = XW2 - X0
-* fill smaller gap with a line
- IF(DX1 .GT. DX2)THEN
- X(1) = X0
- IF(INDEX(CHOPT,'C').NE.0)THEN
- IF(IDRFLG .NE. 0)THEN
- ICOL=2
- ELSE
- ICOL=3
- ENDIF
- CALL DZDIFA(X(1),X(2),
- + Y(1)-DY2,Y(1)+DY2,1,ICOL)
- ELSE
- IF(IDRFLG .NE. 0)THEN
- CALL DZDBOX(X(1),X(2),
- + Y(1)-DY2,Y(1)+DY2,ISHADE)
- ELSE
- CALL DZDGPL(2,X,Y)
- ENDIF
- ENDIF
- DXBDDV = DX1
- X(1) = XW1
- X(2) = X0+DX
- Y(1) = Y0 - (FLOAT(IBL1-1)+0.1)*GRYDDV+DY2
- Y(2) = Y(1)
- XW2 = X0 + DX
- ELSE
- X(2) = X0 + DX
- Y(1) = Y0 - (FLOAT(IBL1-1)+0.1)*GRYDDV+DY2
- Y(2) = Y(1)
- IF(INDEX(CHOPT,'C').NE.0)THEN
- IF(IDRFLG .NE. 0)THEN
- ICOL=2
- ELSE
- ICOL=3
- ENDIF
- CALL DZDIFA(X(1),X(2),
- + Y(1)-DY2,Y(1)+DY2,1,ICOL)
- ELSE
- IF(IDRFLG .NE. 0)THEN
- CALL DZDBOX(X(1),X(2),
- + Y(1)-DY2,Y(1)+DY2,ISHADE)
- ELSE
- CALL DZDGPL(2,X,Y)
- ENDIF
- ENDIF
- Y(1) = Y0 - (FLOAT(IBL2-1)+0.1)*GRYDDV+DY2
- Y(2) = Y(1)
- DXBDDV = DX2
- X(1) = X0
- X(2) = XW2
- XW1 = X0
- ENDIF
- ELSE
- DXBDDV = XW2 - XW1
- ENDIF
-
-* look if text fits in gap
-
- NCHFIT = DXBDDV/CSDDV
- IF(NCHFIT .LE. 0)THEN
- IF(INDEX(CHOPT,'C').NE.0)THEN
- IF(IDRFLG .NE. 0)THEN
- ICOL=2
- ELSE
- ICOL=3
- ENDIF
- CALL DZDIFA(X(1),X(2),
- + Y(1)-DY2,Y(1)+DY2,1,ICOL)
- ELSE
- IF(IDRFLG .NE. 0)THEN
- CALL DZDBOX(X(1),X(2),
- + Y(1)-DY2,Y(1)+DY2,ISHADE)
- ELSE
- CALL DZDGPL(2,X,Y)
- ENDIF
- ENDIF
- GOTO 30
- ENDIF
-
-* mark bank for browser
-
- CALL MZSDIV (IXIN,1)
- IF(INDEX(CHOPT,'D').NE.0)THEN
- IF(NLKUSE.GE.IQ(LTDISP(ISTUSE)+KQS-3))THEN
- WRITE(*,*)'DZDDIV: Too many banks',NLKUSE+1
- ELSE
- NLKUSE=NLKUSE+1
- LQ(LTDISP(ISTUSE)+KQS-NLKUSE)= LQ(LTDISP(ISTUSE)+KQS-NLL)
- CALL IGPID(1,'BANK',NLKUSE,' ')
- ENDIF
- ENDIF
- XB(1)=X(1)
- YB(1)=Y(1)-DY2
- XB(2)=X(2)
- YB(2)=YB(1)
- XB(3)=X(2)
- YB(3)=Y(1)+DY2
- XB(4)=XB(1)
- YB(4)=YB(3)
- XB(5)=XB(1)
- YB(5)=YB(1)
- CALL ISFAIS(0)
- CALL IFA(5,XB,YB)
-
- XT = .5*(X(1)+X(2))
- YT = Y(1)
- IF(INDEX(CHOPT,'C').NE.0)THEN
- IF(IDRFLG .NE. 0)THEN
- ICOL=2
- ELSE
- ICOL=3
- ENDIF
- CALL DZDIFA(XW1,XW2,Y(1)-DY2,Y(1)+DY2,1,ICOL)
- ELSE
- IF(IDRFLG .EQ. 0)THEN
- IF(NCHFIT .GT. 4)THEN
- X(1) = XW1
- X(2) = XT-2.*CSDDV
- CALL DZDGPL(2,X,Y)
- X(1) = XT+2.*CSDDV
- X(2) = XW2
- CALL DZDGPL(2,X,Y)
- ENDIF
- ELSE
- CALL DZDBOX(XW1,XW2,Y(1)-DY2,Y(1)+DY2,ISHADE)
- ENDIF
- ENDIF
- NCH = MIN(NCHFIT,4)
- CALL UHTOC(IHIDBK,4,CHIDBK,4)
- CALL DZDTXT(CHIDBK(1:NCH),0,XT,YT,CSDDV,0.,2)
-
- NEXTRA = IBL2 - IBL1 - 1
- IF(NEXTRA .GT. 0)THEN
- X(1) = X0
- X(2) = X(1) + DX
- DO 20 IBL = IBL1+1, IBL2-1
- Y(1) = Y0 - (FLOAT(IBL-1)+0.1)*GRYDDV+DY2
- Y(2) = Y(1)
- IF(INDEX(CHOPT,'C').NE.0)THEN
- IF(IDRFLG .NE. 0)THEN
- ICOL=2
- ELSE
- ICOL=3
- ENDIF
- CALL DZDIFA(X(1),X(2),
- + Y(1)-DY2,Y(1)+DY2,1,ICOL)
- ELSE
- IF(IDRFLG .NE. 0)THEN
- CALL DZDBOX(X(1),X(2),
- + Y(1)-DY2,Y(1)+DY2,ISHADE)
- ELSE
- CALL DZDGPL(2,X,Y)
- ENDIF
- ENDIF
- 20 CONTINUE
- ENDIF
- 30 CONTINUE
-
- GOTO 10
- 999 CONTINUE
-* WRITE(*,*)'DZDST1, NLKUSE',NLKUSE
-
-*
- END
diff --git a/src/graflib/dzdoc/dzdraw/dzdstk.F b/src/graflib/dzdoc/dzdraw/dzdstk.F
deleted file mode 100644
index cc7f8f7..0000000
--- a/src/graflib/dzdoc/dzdraw/dzdstk.F
+++ /dev/null
@@ -1,74 +0,0 @@
-*
-* $Id: dzdstk.F,v 1.1.1.1 1996/03/04 16:13:17 mclareni Exp $
-*
-* $Log: dzdstk.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:17 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDSTK(IXSTOR,NK1,NK2,LRET)
- INTEGER LRET(9)
-#include "zebra/rzcl.inc"
-#include "zebra/rzk.inc"
- IF(NK1.GT.NK2)GOTO 999
- IF(LCDIR.EQ.0)GO TO 999
- LCOLD=0
- LK = IQ(KQS+LCDIR+KLK)
- NK = IQ(KQS+LCDIR+KNKEYS)
- NWKEY= IQ(KQS+LCDIR+KNWKEY)
- IF(NK1.LT.1)NK1=1
- IF(NK2.GT.NK)NK2=NK
-* remove previously booked banks
- NL = IQ(KQS+LRET(1)-1)
-#include "zebra/qstore.inc"
-* book a bank for each key
-* format:
-* FLAG (=2), TSTAMP, KEYSEQ, CYCLE, NDATA, NWKEYS,
-* KEYDEF((NWKEYS+3/4)), KEYS(NWKEYS)
- IF(NK.LE.0)GOTO 999
- ND = NWKEY+6+(NWKEY+3)/4
-
-* taken from RZKEYS
- NC=0
- DO 20 I=NK,1,-1
- IF(I.LT.NK1)GOTO 999
- K=LK+(NWKEY+1)*(I-1)
- LCYC=IQ(KQS+LCDIR+K)
- 30 NC=NC+1
- IF(I.GT.NK2 .OR. I.LT. NK1)GOTO 26
- IF(LQ(KQS+LRET(1)-NC).NE.0)GOTO 26
- LCOLD = JBYT(IQ(KQS+LCDIR+LCYC ), 1,16)
- ITSTAM=IQ(KQS+LCDIR+LCYC+1)
- IC = JBYT(IQ(KQS+LCDIR+LCYC+3),21,12)
- NW = JBYT(IQ(KQS+LCDIR+LCYC+3), 1,20)
-#include "zebra/qstore.inc"
- CALL MZBOOK(IXSTOR,LL,LRET(1),-NC,'RKEY',0,0,ND,0,0)
- LL=LQ(KQS+LRET(1)-NC)
- IQ(KQS+LL+1) = 2
- IQ(KQS+LL+2) = ITSTAM
- IQ(KQS+LL+3) = I
- IQ(KQS+LL+4) = IC
- IQ(KQS+LL+5) = NW
- IQ(KQS+LL+6) = NWKEY
- NWF=(NWKEY+3)/4
- CALL UCOPY(IQ(KQS+LRET(1)+7),IQ(KQS+LL+7),NWF)
- NFKEY = 5+(NWKEY+3)/4+1
-* CALL UCOPY(IQ(KQS+LCDIR+LKC+1),IQ(KQS+LL+NFKEY),NWKEY)
- DO 25 J=1,NWKEY
- IKDES=(J-1)/10
- IKBIT1=3*J-30*IKDES-2
- IF(JBYT(IQ(KQS+LCDIR+KKDES+IKDES),IKBIT1,3).LT.3)THEN
- IQ(KQS+LL+NFKEY+J)=IQ(KQS+LCDIR+K+J)
- ELSE
- CALL ZITOH(IQ(KQS+LCDIR+K+J),IQ(KQS+LL+NFKEY+J),1)
- ENDIF
- 25 CONTINUE
- 26 IF(LCOLD.NE.0)THEN
- LCYC=LCOLD
- GO TO 30
- ENDIF
- 20 CONTINUE
- 999 RETURN
- END
-
diff --git a/src/graflib/dzdoc/dzdraw/dzdsvp.F b/src/graflib/dzdoc/dzdraw/dzdsvp.F
deleted file mode 100644
index 44f4402..0000000
--- a/src/graflib/dzdoc/dzdraw/dzdsvp.F
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: dzdsvp.F,v 1.1.1.1 1996/03/04 16:13:15 mclareni Exp $
-*
-* $Log: dzdsvp.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:15 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDSVP(IWID)
- REAL SMALER,DISPSZ(4)
- CALL IGQWK(IWID,'MXDS',DISPSZ)
- SMALER=MIN(DISPSZ(1),DISPSZ(2))
- CALL ISWKVP(IWID,0.,SMALER,0.,SMALER)
- END
-************************************************************************
diff --git a/src/graflib/dzdoc/dzdraw/dzdsy1.F b/src/graflib/dzdoc/dzdraw/dzdsy1.F
deleted file mode 100644
index cb97994..0000000
--- a/src/graflib/dzdoc/dzdraw/dzdsy1.F
+++ /dev/null
@@ -1,131 +0,0 @@
-*
-* $Id: dzdsy1.F,v 1.1.1.1 1996/03/04 16:13:10 mclareni Exp $
-*
-* $Log: dzdsy1.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:10 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDSY1(LB,IB, L,LUNPRT)
-*.
-*...DZDSY1
-*.
-*. INPUT : LB, IB the array containing the ZEBRA store
-*. as used in the call to MZSTOR
-*. L link to bank to be dumped
-*. LUNPRT unit for printing
-*. OUTPUT :
-*.
-*. CALLS : UHTOC
-*. CALLED : DZDSYW
-*.
-*. AUTHOR : O.Schaile
-*. VERSION : 1.00
-*. CREATED : 11-Dec-87
-*. Last mod : 3 -Oct-90
-*.**********************************************************************
-*.
-#include "zebra/mzbits.inc"
-#include "dzdchv.inc"
- INTEGER LB(999), IB(999)
-*
- CHARACTER*10 CTEMP
- CHARACTER*4 CHID
-*
- IF(L .LE. 0)THEN
- GOTO 40
- ENDIF
- WRITE(LUNPRT,'(A)')' '
- WRITE(LUNPRT,'(A)')' System words + links'
- NIO = JBYT(IB(L),19,4)
- NL = IB(L-3)
- IOFFBS = - (NIO + NL + 8 + 1)
- WRITE(LUNPRT,10200)' Offset to Bank-Centre',
- &JBYT(IB(L+IOFFBS),1,16)
- CALL DZDIOC(IB(L+IOFFBS),CLINE,NCH)
- WRITE(LUNPRT,10050)' I/O characteristic',CLINE(1:NCH)
- CLINE=' '
- IF(JBIT(IB(L),IQDROP).NE.0)CLINE(1:8) =' dropped'
- IF(JBIT(IB(L),IQMARK).NE.0)CLINE(9:16)=' marked'
- IF(JBIT(IB(L),IQCRIT).NE.0)CLINE(17:21)=' crit'
- IF(JBIT(IB(L),IQMARK).NE.0)CLINE(22:26)=' sysx'
- WRITE(LUNPRT,10010)' Bank status word (HEX)',IB(L),CLINE(1:26)
- WRITE(LUNPRT,10200)' Link to the bank',L
- CALL UHTOC(IB(L-4),4,CTEMP,4)
- CHID = CTEMP(1:4)
- WRITE(LUNPRT,10100)' Hollerith ID',CTEMP(1:4)
- WRITE(LUNPRT,10200)' Numerical ID',IB(L-5)
- WRITE(LUNPRT,10200)' Total number of links',IB(L-3)
- NS = IB(L-2)
- WRITE(LUNPRT,10200)' Number of structural links',NS
- WRITE(LUNPRT,10200)' Number of data words',IB(L-1)
- LN = LB(L)
- IF(LN .GT. 1)THEN
- CALL UHTOC(IB(LN-4),4,CTEMP,4)
- ELSE
- CTEMP = ' '
- ENDIF
- WRITE(LUNPRT,10300)' Next link ',LN,CTEMP(1:4)
- LUP = LB(L+1)
- IF(LUP .GT. 1)THEN
- CALL UHTOC(IB(LUP-4),4,CTEMP,4)
- ELSE
- CTEMP = ' '
- ENDIF
- WRITE(LUNPRT,10300)' Up - link ',LUP,CTEMP(1:4)
- LORIG = LB(L+2)
-* IF(LORIG .GT. 1)THEN
-* NSU = IB(LUP-2)
-* IF(LORIG .GE. LUP .OR. LORIG .LT. LUP-NSU)THEN
-* IF(LUP.GT.1)THEN
-* CTEMP='linear str'
-* ELSE
-* CTEMP='top bank '
-* ENDIF
-* ELSE
-* JB = LUP - LORIG
-* WRITE(CTEMP,'(A,I5)')'JBIAS =',JB
-* ENDIF
-* ELSE
-* IF(LORIG.EQ.0 .AND. LUP.EQ.0)THEN
-* CTEMP='stand alone'
-* ELSE
-* CTEMP = ' '
-* ENDIF
-* ENDIF
- WRITE(LUNPRT,10300)' Origin link ',LORIG,CTEMP(1:4)
- CTEMP = ' '
- IF(NS .GT. 0)THEN
- DO 20 I=1,NS
- LI = LB(L-I)
- IF(LI .NE. 0)THEN
- CALL UHTOC(IB(LI-4),4,CTEMP,4)
- ELSE
- CTEMP = ' '
- ENDIF
- WRITE(LUNPRT,10400)I, '. down link ',LI,CTEMP(1:4)
- 20 CONTINUE
- ENDIF
- NR = IB(L-3) - NS
- IF(NR .GT. 0)THEN
- DO 30 I=1,NR
- LI = LB(L-NS-I)
- IF(LI .NE. 0)THEN
- CALL UHTOC(IB(LI-4),4,CTEMP,4)
- ELSE
- CTEMP = ' '
- ENDIF
- WRITE(LUNPRT,10400)I, '. ref link ',LI,CTEMP
- 30 CONTINUE
- ENDIF
-10000 FORMAT(A,T30,Z9)
-10010 FORMAT(A,T30,Z9,A)
-10050 FORMAT(A,T30,A)
-10100 FORMAT(A,T30,' ',A)
-10200 FORMAT(A,T30,I9)
-10300 FORMAT(A,T30,I9,' ',A)
-10400 FORMAT(' ',I5,A,T30,I9,' ',A)
-10500 FORMAT(' ',I2,A,T30,Z9)
- 40 CONTINUE
- END
diff --git a/src/graflib/dzdoc/dzdraw/dzdsyw.F b/src/graflib/dzdoc/dzdraw/dzdsyw.F
deleted file mode 100644
index 0999fb7..0000000
--- a/src/graflib/dzdoc/dzdraw/dzdsyw.F
+++ /dev/null
@@ -1,38 +0,0 @@
-*
-* $Id: dzdsyw.F,v 1.1.1.1 1996/03/04 16:13:10 mclareni Exp $
-*
-* $Log: dzdsyw.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:10 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDSYW(IXSTOR, L, LUNPRT)
-*.
-*...DZDSYW dump system words and links, interface routine to
-*. hide ZEBRA internals from DZDSY1
-*.
-*. INPUT : IXSTOR store index
-*. L link to bank to be dumped
-*. LUNPRT unit for printing
-*.
-*. COMMON :
-*. SEQUENCE : MZCA MZCB QSTORE ZEBQ ZUNIT
-*. CALLS : DZDSY1
-*. CALLED : DZDISP
-*.
-*. AUTHOR : O.Schaile
-*. VERSION : 1.00
-*. CREATED : 11-Dec-87
-*.**********************************************************************
-*.
-*
-#include "zebra/zebq.inc"
-#include "zebra/mzca.inc"
-#include "zebra/mzcb.inc"
-#include "zebra/zunit.inc"
-#include "zebra/qstore.inc"
- CALL DZDSY1(LQ(KQS+1),IQ(KQS+1),L, LUNPRT)
- RETURN
- END
-************************************************************************
diff --git a/src/graflib/dzdoc/dzdraw/dzdtm1.F b/src/graflib/dzdoc/dzdraw/dzdtm1.F
deleted file mode 100644
index 563ec0e..0000000
--- a/src/graflib/dzdoc/dzdraw/dzdtm1.F
+++ /dev/null
@@ -1,210 +0,0 @@
-*
-* $Id: dzdtm1.F,v 1.1.1.1 1996/03/04 16:13:07 mclareni Exp $
-*
-* $Log: dzdtm1.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:07 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDTM1(L,LUN,CHOPT)
- CHARACTER*(*) CHOPT
-#include "zebra/zebq.inc"
-#include "zebra/mzca.inc"
-#include "zebra/mzcb.inc"
-#include "zebra/mzcc.inc"
-#include "zebra/mzioc.inc"
-* BANK FORMAT PARAMETERS (IO CHARACERISTIC)
-#include "zebra/bkfoparq.inc"
-*--------
- CHARACTER*4 CHBANK,CHUP
- CHARACTER*12 CTEMP
- CHARACTER*60 CLINE
-
- IFC=1
- IOPTAQ=INDEX(CHOPT,'A')
- IOPTDQ=INDEX(CHOPT,'D')
- IOPTSQ=INDEX(CHOPT,'S')
- IOPTVQ=INDEX(CHOPT,'V')
-* holl Id of bank
- CALL UHTOC(IQ(KQS+L-4),4,CHBANK,4)
- WRITE(LUN,
- & '(''+DECK,'',A,''.'',20(''-''),'' '',A,
- & '' '',30(''-'') )' )
- & CHBANK,CHBANK
- WRITE(LUN,'(A)')'*B..'//CHBANK//' Template only'
- IF(IOPTAQ.NE.0)THEN
- WRITE(LUN,'(A,A)')'*B.AU Nomen nescio'
- ENDIF
- IF(IOPTVQ.NE.0)THEN
- WRITE(LUN,'(A)')'*B.VE 1.00'
- ENDIF
-
- IF(IOPTSQ.NE.0)THEN
- CALL UHTOC(IQTABV(KQT+11),4,CTEMP,8)
- CTEMP(9:)=' '
- WRITE(LUN,'(A)')'*B.ST '//CTEMP
- ENDIF
-
- IF(IOPTDQ.NE.0)THEN
- DO 3 IDIV=1,20
- IFAD = LQSTA(KQT+IDIV)
- ILAD = LQEND(KQT+IDIV)
- IF(L.GE.IFAD.AND.L.LE.ILAD)THEN
- CALL UHTOC(IQDN1(KQT+IDIV),4,CTEMP(1:4),4)
- CALL UHTOC(IQDN2(KQT+IDIV),4,CTEMP(5:8),4)
- CTEMP(9:)=' '
- WRITE(LUN,'(A)')'*B.DV '//CTEMP
- GOTO 4
- ENDIF
-3 CONTINUE
- WRITE(*,*)'division not found, L',L
-4 CONTINUE
- ENDIF
- NL = IQ(KQS+L-3)
- CALL DZDPDL(LUN,'*B.NL ',NL)
- NS=IQ(KQS+L-2)
- CALL DZDPDL(LUN,'*B.NS ',NS)
- ND=IQ(KQS+L-1)
- CALL DZDPDL(LUN,'*B.ND ',ND)
-
-* IO-characteristic
- NIO = JBYT(IQ(KQS+L),19,4)
- IOFFBS = - (NIO + NL + 8 + 1)
- CALL DZDIOC(IQ(KQS+L+IOFFBS),CLINE,NCH)
- WRITE(LUN,'(A,A)')'*B.IO ',CLINE(1:NCH)
-
-* IOBYTE = JBYT(IQ(KQS+L+IOFFBS),17,16)
-* IF(NIO.GT.0 .OR. IOBYTE.GT.7)THEN
-* IDSAME=0
-* ELSE IF(IOBYTE.EQ.0)THEN
-* IDSAME=1
-* ELSE
-* IDSAME=1
-* ENDIF
-
-* holl Id of UP bank
-
- LU = LQ(KQS+L+1)
- CTEMP=' '
- IF(LU.GT.2)THEN
- CALL UHTOC(IQ(KQS+LU-4),4,CHUP,4)
- LO = LQ(KQS+L+2)
- NSUP=IQ(KQS+LU-2)
- JB1= LU-LO
- IF(JB1.GT.0 .AND. JB1.LE.NSUP)THEN
- WRITE(CTEMP,'(I12)')-JB1
- IFC=INDEXC(CTEMP,' ')
- ENDIF
- ELSE
- CHUP='NONE'
- ENDIF
- WRITE(LUN,'(A)')'*B.UP '//CHUP//' '//CTEMP(IFC:)
-
-* holl Id of NEXT bank
-
- L1 = LQ(KQS+L)
- IF(L1.GT.2)THEN
- CALL UHTOC(IQ(KQS+L1-4),4,CHBANK,4)
- WRITE(LUN,'(A)')'*B.NX '//CHBANK
- ENDIF
-
-* down links
-
- IF(NS.GT.0)THEN
- WRITE(LUN,'(A)')'*B.LINK'
-* all the same ?
- IF(NS.GT.1)THEN
- ILSAME=1
- L1 = LQ(KQS+L-1)
- ID1 = IQ(KQS+L1-4)
- DO 5 I=2,NS
- L1 = LQ(KQS+L-I)
- IF(L1.NE.0)THEN
- IF(ID1.NE.IQ(KQS+L1-4))THEN
- ILSAME=0
- GOTO 6
- ENDIF
- ENDIF
-5 CONTINUE
- ELSE
- ILSAME=0
- ENDIF
-6 CONTINUE
- IF(ILSAME.EQ.1)THEN
- CALL DZDPDL(LUN,'*B.REP ',NS)
- NS=1
- ENDIF
- DO 10 I=1,NS
- L1 = LQ(KQS+L-I)
- IF(L1.NE.0)THEN
- WRITE(CTEMP,'(I12)')I
- IFC=INDEXC(CTEMP,' ')
- CALL UHTOC(IQ(KQS+L1-4),4,CHBANK,4)
- WRITE(LUN,'(A,T10,A)')'*B.'//CTEMP(IFC:),CHBANK
- ENDIF
-10 CONTINUE
- IF(ILSAME.EQ.1)WRITE(LUN,'(A)')'*B/REP'
- WRITE(LUN,'(A)')'*B/LINK'
- ENDIF
-
-* data words
-
- IREPTR=0
- IF(ND.GT.0)THEN
- WRITE(LUN,'(A)')'*B.DATA'
- NDSEQ=0
-* go through cracked IO-char in array MFO
- DO 100 JFOCUR = 1,JFOEND,2
- IF (JFOCUR.EQ.JFOREP+1) THEN
-* start of trailing region (/)
- WRITE(LUN,'(A)')'*B.REP FOREVER'
- IREPTR=1
- ENDIF
- ITYPE = MFO(JFOCUR)
-
-* is this the same as NWSEC<0??
-* IF (ITYPE.EQ.IFOSEQ) THEN
-* ENDIF
-
- NWSEC = MFO(JFOCUR+1)
- ITYPE = MIN(ITYPE,8)
- IF (NWSEC.LT.0) THEN
-* indefinite length sector (-) (all same kind)
- NREST=ND-NDSEQ
- CALL DZDPDL(LUN,'*B.REP ',NREST)
- CALL DZDPDL(LUN,'*B.',NDSEQ+1)
- WRITE(LUN,'(A)')'*B/REP'
- GOTO 101
- ELSEIF (NWSEC.EQ.0 .OR. ITYPE.EQ.IFOSEQ) THEN
-* dynamic sector (*) (current data word = rep count
- CALL DZDPDL(LUN,'*B.',NDSEQ+1)
- NDSEQ=NDSEQ+1
- WRITE(LUN,'(A)')
- & '*B.REP BITS0031 ! previous word = rep count'
- CALL DZDPDL(LUN,'*B.',NDSEQ+1)
- NDSEQ=NDSEQ+1
- WRITE(LUN,'(A)')'*B/REP'
- ELSE
-* fixed length sector
- IF(NWSEC.GT.10)THEN
- CALL DZDPDL(LUN,'*B.REP ',NWSEC)
- CALL DZDPDL(LUN,'*B.',NDSEQ+1)
- WRITE(LUN,'(A)')'*B/REP'
- NDSEQ=NDSEQ+NWSEC
- ELSE
- DO 90 I=1,NWSEC
- NDSEQ=NDSEQ+1
- CALL DZDPDL(LUN,'*B.',NDSEQ)
- 90 CONTINUE
- ENDIF
- ENDIF
- 100 CONTINUE
- IF(IREPTR.EQ.1)WRITE(LUN,'(A)')'*B/REP'
- 101 CONTINUE
- WRITE(LUN,'(A)')'*B/DATA'
- ENDIF
- WRITE(LUN,'(A)')'*B/'
-999 RETURN
- END
-**********************************************************************
diff --git a/src/graflib/dzdoc/dzdraw/dzdtmp.F b/src/graflib/dzdoc/dzdraw/dzdtmp.F
deleted file mode 100644
index 8d833f8..0000000
--- a/src/graflib/dzdoc/dzdraw/dzdtmp.F
+++ /dev/null
@@ -1,131 +0,0 @@
-*
-* $Id: dzdtmp.F,v 1.1.1.1 1996/03/04 16:13:07 mclareni Exp $
-*
-* $Log: dzdtmp.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:07 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDTMP(IXSTOR,LT,LUN,CHOPT)
-
-*. generate templates of bank doc for a bank or a whole tree
-*
-*. INPUT : IXSTOR Store index
-*. LT Link to top bank
-*. CHOPT Character option:
-*. CHOPT option:
-*. 'L' follow next links
-*. 'T' do it for a bank tree
-*. 'A' fill author tag
-*. 'V' fill version tag
-*. 'S' fill store tag
-*. 'D' fill division tag
-*.
-*. OUTPUT : none
-*.
-*. AUTHOR : O.Schaile
-*. VERSION : 1.00
-*. CREATED : 25-Jan-91
-*. LAST MOD :
-*.
-*.
-*.**********************************************************************
-*.
- CHARACTER*(*) CHOPT
-*
-#include "zebra/zebq.inc"
-#include "zebra/mzca.inc"
-#include "zebra/mzcb.inc"
- IF (JBYT(IXSTOR,27,6).NE.JQSTOR) CALL MZSDIV (IXSTOR,-7)
-*--------
-* IOPTAQ=INDEX(CHOPT,'A')
- IOPTLQ=INDEX(CHOPT,'L')
- IOPTTQ=INDEX(CHOPT,'T')
-* NBK=0
-*
-* init links
-*
- L=LT
- LORIG = L
- LUP = L
- LFROM = LQ(KQS+L+1)
-
-* get next down link
- 10 CONTINUE
-
- JB = LUP - LORIG + 1
- NS = IQ(KQS+LUP -2)
- IF(JB .EQ. 1)THEN
-* treat this bank
-* NBK=NBK+1
- CALL DZDTM1(L,LUN,CHOPT)
- IF(IOPTTQ.EQ.0)GOTO 60
- ENDIF
-*
- 40 CONTINUE
- IF(JB .LE. NS)THEN
-
-* go down
- LD1 = LQ(KQS+ L - JB)
-* look if this link is used
- IF(LD1 .EQ. 0)THEN
- JB = JB + 1
- GOTO 40
- ENDIF
-* if previous down bank was same => skip
- IF(JB.GT.1)THEN
- LD2 = LQ(KQS+ L - JB +1)
- IF(LD2.NE.0)THEN
- IF(IQ(KQS+LD1-4).EQ.IQ(KQS+LD2-4))THEN
- JB = JB + 1
- GOTO 40
- ENDIF
- ENDIF
- ENDIF
- LUP = LD1
- LORIG = LD1
- L = LD1
- GOTO 10
- ENDIF
-
-* look if its linear structure
-
- IF(IOPTLQ.NE.0)THEN
- LN = LQ(KQS+L)
- IF(LN .NE. 0)THEN
- LUP = LN
- LORIG = LN
- L = LN
- GOTO 10
- ENDIF
- ENDIF
-* look if it is end of a linear structure
-* i.e. origin and up link are in different banks
-
- 50 CONTINUE
- LUP = LQ(KQS+L+1)
- LORIG = LQ(KQS+L+2)
-
-* look if back at top bank
-
- IF(LUP .LE. 1) GOTO 60
-
-* look if it would move above top bank
-
- IF(LUP .EQ. LFROM) GOTO 60
-
- NSU = IQ(KQS+LUP-2)
- IF(LORIG .GE. LUP .OR. LORIG .LT. LUP-NSU)THEN
-* its different, step back
- L = LORIG
- GOTO 50
- ENDIF
-* go up
- L = LUP
- GOTO 10
-* all done, but top bank
- 60 CONTINUE
-* WRITE(IQPRNT,'(A,I8,A)')' Total # of banks treated: ',NBK
- 999 END
-*****************************************************************
diff --git a/src/graflib/dzdoc/dzdraw/dzdtre.F b/src/graflib/dzdoc/dzdraw/dzdtre.F
deleted file mode 100644
index 868b0a9..0000000
--- a/src/graflib/dzdoc/dzdraw/dzdtre.F
+++ /dev/null
@@ -1,69 +0,0 @@
-*
-* $Id: dzdtre.F,v 1.1.1.1 1996/03/04 16:13:09 mclareni Exp $
-*
-* $Log: dzdtre.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:09 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDTRE(LB,IB,LD,ILINK,XPOSB,YPOSB,Y0DB,
- & REQINP,L,XCUR,YCUR,IFLCUR, ILLFLG)
- INTEGER IB(*),LB(*),LD, L, IFLCUR, DZDGLK
- REAL XPOSB,YPOSB,XCUR,YCUR
- LOGICAL REQINP
-#include "dzdprm.inc"
- CHARACTER*4 HID, HIDUXX, HIDNXX
-*---
- CALL DZDGNZ(LB,IB,LD,1,NLDON1,NBLEV, NULEV,NN)
- NSD=IB(LD-2)
- XPOSDB = XPOSB + 4.*DXLK
-* draw up to the highest non zero link
- LDD = DZDGLK(LB,IB,LD,ILINK)
- X01 = XPOSB - FLOAT(ILINK)*DXLK
- IF(LDD .EQ. 0)THEN
- IF(.NOT. REQINP)THEN
-* draw the little box for the link
- CALL DZDSBX(X01,YPOSB,ILINK,NSD)
- ENDIF
- GOTO 90
- ENDIF
- Y0DB = Y0DB - 2.*GRIDY
- IF(REQINP)THEN
- CALL DZDCKC(XCUR,YCUR,XPOSDB,Y0DB,LB,IB,LDD,IFLCUR)
- IF(IFLCUR .GT. 0)L = LDD
- GOTO 90
- ELSE
- CALL DZDPAR(LB,IB,LDD,
- + HID, NID, HIDUXX, HIDNXX, JBIASX, NLDD, NSDD, NDDD)
- CALL DZDBNK(LB,IB,LDD,
- + XPOSDB,Y0DB,DXTB,DYB,HID,HIDNXX,HIDUXX,
- + NID, NDDD)
-* restore link
- LDD = LB(LD-ILINK)
- CALL DZDLNK(X01,YPOSB,XPOSDB,Y0DB,ILINK, NSD)
- ENDIF
-
-* is it lowest bank then indicate links if not 0
-
- IF(ILLFLG.NE.0)THEN
- CALL DZDGNZ(LB,IB,LDD,1,NLDON1,NBLEV, NULEV,NN)
- IF(NULEV.GT.0)THEN
- CALL DZDLBX(XPOSDB,Y0DB,1,NULEV,NULEV)
- ENDIF
- ENDIF
-
-* if only 1 link given draw a box indicating # of links
- IF(ILINK.EQ. 1 .AND. NBLEV.EQ.1 .AND. .NOT. REQINP)THEN
- IF(IFRCAR .NE. 0 .AND. IB(LD+2) .LT. 0)THEN
- NS1 = -1
- ELSE
- NS1 = NSD
- ENDIF
- IF(NS1.NE.1 .AND. IFRCAR .NE. 0)THEN
- CALL DZDLBX(XPOSB-DXLK, YPOSB, 2,NS1,NSD)
- ENDIF
-* GOTO 70
- ENDIF
- 90 END
-******************************************************************
diff --git a/src/graflib/dzdoc/dzdraw/dzdtxt.F b/src/graflib/dzdoc/dzdraw/dzdtxt.F
deleted file mode 100644
index 1c38520..0000000
--- a/src/graflib/dzdoc/dzdraw/dzdtxt.F
+++ /dev/null
@@ -1,164 +0,0 @@
-*
-* $Id: dzdtxt.F,v 1.1.1.1 1996/03/04 16:13:15 mclareni Exp $
-*
-* $Log: dzdtxt.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:15 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDTXT(CHT,NCM,X0,Y0,CS,ANG,IALG)
-*.
-*...DZDTXT output a text string
-*.
-*. INPUT : CHT string containing the text
-*. NCM max number of characters to be printed
-*. X0,Y0 position of the text
-*. CS character size
-*. ANG angle
-*. IALG alignment (1 left, 2 centered, 3 right)
-*.
-*. CALLS : DZDROT GSCHH GSCHUP GSTXAL GTX
-*. CALLED : many
-*.
-*. AUTHOR : O.Schaile
-*. VERSION : 1.00
-*. CREATED : 11-Dec-87
-*. Modification Log.
-*. 20-Feb-90 : O.Schaile
-*. add LATEX
-*. 12-Dec-90 : O.Schaile
-*. add PostScript
-*.
-*.**********************************************************************
-*.
-#include "dzdprm.inc"
-#if defined(CERNLIB_BSLASH)
-#include "dzdoc/bslash2.inc"
-#endif
-#if !defined(CERNLIB_BSLASH)
-#include "dzdoc/bslash1.inc"
-#endif
- CHARACTER*(*) CHT
- CHARACTER*4 CCENT(3)
- CHARACTER*24 CCINT
- CHARACTER*128 CLINEI
- REAL CTXFP(2)
- LOGICAL NONZAN
- DATA CCENT/'[bl]','[c]','[br]'/
-*
- NC = LENOCC(CHT)
- IF(NCM.GT.0)NC = MIN(NC,NCM)
- NC=MIN(NC,132)
- ILC = INDXBC(CHT(1:NC),' ')
- IF(ILC.NE.0)NC=ILC
- IF(IFOMED.EQ.3)THEN
- CLINEI(1:NC)=CHT(1:NC)
- IF(IALG.LT.1 .OR. IALG.GT. 3)THEN
- IALGI=1
- ELSE
- IALGI=IALG
- ENDIF
- XT=X0*PAGECM
- YT=Y0*PAGECM
- WRITE(LUNGRA,'(A,2(F5.2,A),A,A)')
- & BS//'p(', XT, ',', YT, '){'//BS//'m(0,0)',
- & CCENT(IALGI), '{'
- WRITE(LUNGRA,'(A)')CLINEI(1:NC)
- WRITE(LUNGRA,'(A)')'}}'
- GOTO 999
- ELSEIF(IFOMED.EQ.2)THEN
-* PostScript, check for ( )
- IOUT=0
- DO 10 I=1,NC
- IOUT=IOUT+1
- IF(CHT(I:I).EQ.'(' .OR. CHT(I:I).EQ.')')THEN
- CLINEI(IOUT:IOUT)=BS
- IOUT=IOUT+1
- ENDIF
- CLINEI(IOUT:IOUT)=CHT(I:I)
-10 CONTINUE
- NC=IOUT
- IPCS=CS*PAMM10*1.1
- IF(IPCS.EQ.0)IPCS=40
- IF(IPCS.NE.IPCSIZ)THEN
- IPCSIZ=IPCS
- WRITE(CCINT,'(A,I4,A)')'H ',IPCS,' sf '
- CALL DZDPLN(LUNGRA,CCINT,-1)
- ENDIF
- CALL DZDPLN(LUNGRA,' n',-1)
- IX=X0*PAMM10
- IY=Y0*PAMM10
- IF(IALG.EQ.2)IY=IY-IPCSIZ/2
- CCINT=' '
- WRITE(CCINT,'(2I8)')IX,IY
- IF(IALG.EQ.2 .OR. IALG.EQ.3)THEN
- CCINT(18:18)='0'
- ELSE
- CCINT(18:18)='m'
- ENDIF
- CALL DZDPLN(LUNGRA,CCINT,-1)
- CALL DZDPLN(LUNGRA,'(',0)
- CALL DZDPLN(LUNGRA,CLINEI(1:NC),0)
- CALL DZDPLN(LUNGRA,')',0)
- IF(IALG.EQ.2)THEN
- CALL DZDPLN(LUNGRA,' cs ',0)
- ELSEIF(IALG.EQ.3)THEN
- CALL DZDPLN(LUNGRA,' rs ',0)
- ELSE
- CALL DZDPLN(LUNGRA,' sh ',0)
- ENDIF
- GOTO 999
- ENDIF
-
- XT = 0.
- YT = 0.
- CTXFP(2)=-999.
- CLINEI(1:NC)=CHT(1:NC)
- IF(INDEX(CLINEI(1:NC),'[').NE.0 .OR.
- & INDEX(CLINEI(1:NC),'"').NE.0 .OR.
- & INDEX(CLINEI(1:NC),'^').NE.0 .OR.
- & INDEX(CLINEI(1:NC),'?').NE.0)THEN
- CALL IGQ('TXFP',CTXFP)
- IFONT=-ABS(CTXFP(1))
- CALL ISTXFP(IFONT,1)
-* CALL IGSET('TXFP',10.*CTXFP(1)+1.)
- CALL IGSET('PASS',3.)
- ENDIF
- CALL ISCHH(CS)
- IF(IALG .EQ. 1)CALL ISTXAL(0,0)
- IF(IALG .EQ. 2)CALL ISTXAL(2,3)
- IF(IALG .EQ. 3)CALL ISTXAL(3,0)
- IF(ABS(ANG) .GT. 1.E-10)THEN
- A1 = ANG +90.
- IF(A1 .GT. 360.)A1 = A1-360.
- NONZAN = .TRUE.
- XT = 0.
- YT = 1.
- CALL DZDROT(XT,YT,XT,YT,A1)
- CALL ISCHUP(XT,YT)
- ELSE
- NONZAN = .FALSE.
- ENDIF
-*
-*
- IF(NONZAN)THEN
- CALL DZDROT(XT,YT,XTT,YTT,ANG)
- XTT=XTT+X0
- YTT=YTT+Y0
- ELSE
- XTT = XT+X0
- YTT = YT+Y0
- ENDIF
-*
-* WRITE(*,*)' DZDTXT: ',CLINEI(1:NC)
- IF(NC.GT.0)CALL ITX(XTT,YTT,CLINEI(1:NC))
-* CALL IUWK(0,1)
- IF(NONZAN)THEN
- CALL ISCHUP(0.,1.)
- ENDIF
- IF(CTXFP(2).GT.-999.)THEN
- CALL IGSET('TXFP',10.*CTXFP(1)+CTXFP(2))
- ENDIF
-999 END
-************************************************************************
diff --git a/src/graflib/dzdoc/dzdraw/dzdudd.F b/src/graflib/dzdoc/dzdraw/dzdudd.F
deleted file mode 100644
index 0a13f8c..0000000
--- a/src/graflib/dzdoc/dzdraw/dzdudd.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: dzdudd.F,v 1.1.1.1 1996/03/04 16:13:02 mclareni Exp $
-*
-* $Log: dzdudd.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:02 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDUDD(CHFILE)
- CHARACTER*(*) CHFILE
- INTEGER IRET
-#include "dzdzbrinc.inc"
- CALL DZDOR1('U',IRET)
- IF(IRET.NE.0)GOTO 999
- CALL DZDURZ(LPDOCS,LPDOCB,CHFILE,' ',' ',IRET)
- CALL RZCDIR(CTDDOC,' ')
- CALL RZSAVE
- CALL DZDOR1('R',IRET)
-999 END
-*********************************************************************
diff --git a/src/graflib/dzdoc/dzdraw/dzdurz.F b/src/graflib/dzdoc/dzdraw/dzdurz.F
deleted file mode 100644
index c8584a6..0000000
--- a/src/graflib/dzdoc/dzdraw/dzdurz.F
+++ /dev/null
@@ -1,133 +0,0 @@
-*
-* $Id: dzdurz.F,v 1.1.1.1 1996/03/04 16:13:19 mclareni Exp $
-*
-* $Log: dzdurz.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:19 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDURZ(LUNSRC,LUNRZF, CHDOC,CHRZFI,CHSUB, IRET)
- INTEGER LUNSRC,LUNRZF,IRET
- CHARACTER*(*) CHDOC,CHRZFI,CHSUB
- COMMON/QUEST/IQUEST(100)
-#include "zebra/zebq.inc"
-#include "zebra/mzca.inc"
-#include "zebra/mzcb.inc"
-#include "zebra/mzcc.inc"
-#include "zebra/mzcn.inc"
-#include "dzdoc/dzdocc.inc"
- INTEGER NWKEY,MAXKEY,LRECL,NKEYS,NKEYSB, NUPD, NCYCLE
- PARAMETER(NWKEY = 2,MAXKEY=2000,LRECL=256 )
- INTEGER KEYS(NWKEY,MAXKEY), KEYSBF(NWKEY,MAXKEY),
- & NOLDCY(MAXKEY), MARKUP(MAXKEY)
-
- CHARACTER*8 CHTAG(NWKEY)
- DATA CHTAG/'Bank-ID','Bank-ID'/
- CALL DZDINI
- IRET=0
- IC1000=1000000
-*
- CALL RZSTAT('//RZDOC',2,'Q')
- IF(IQUEST(11).LE.0)THEN
- CALL RZOPEN(LUNRZF,'RZDOC',CHRZFI,'U',LRECL,IRET)
- IF(IRET .NE. 0)GOTO 50
- CALL RZFILE(LUNRZF,'RZDOC','U')
- ELSE
-* WRITE(*,*)'RZ-file was already open'
- ENDIF
-
- IF(CHDOC.EQ.' ')GOTO 50
- CALL RZCDIR('//RZDOC',' ')
- IF(CHSUB .NE. ' ')THEN
- CALL RZCDIR(CHSUB,' ')
- IF(IQUEST(1) .NE. 0)THEN
- WRITE(*,'(A,A)')'Will create: ',CHSUB
- CALL RZMDIR(CHSUB,NWKEY,'HH',CHTAG)
- CALL RZCDIR(CHSUB,' ')
- ENDIF
- ENDIF
- CALL KUOPEN(LUNSRC,CHDOC,'OLD',IRET)
- IF(IRET .NE. 0)GOTO 50
-
- CALL RZKEYS(NWKEY,MAXKEY,KEYSBF,NKEYSB)
- DO 10 I=1,NKEYSB
- CALL RZIN(0,LBQBKD,2,KEYSBF(1,I),IC1000,'C')
- NOLDCY(I) = IQUEST(6)
- 10 CONTINUE
-
- CALL DZDOCM(LUNSRC,0,'R')
- CLOSE(UNIT=LUNSRC)
-* CALL RZLDIR(' ',' ')
-
- CALL RZKEYS(NWKEY,MAXKEY,KEYS,NKEYS)
- NUPD = 0
- NEWKEY = 0
- LBQBKD=0
- LDQBKD=0
- MAXCYC = 1
- DO 30 I=1,NKEYSB
- CALL RZIN(0,LBQBKD,2,KEYS(1,I),IC1000,'C')
- NCYCLE = IQUEST(6)
- IF( KEYS(1,I) .NE. KEYSBF(1,I) .OR.KEYS(2,I) .NE. KEYSBF(2,I))
- + THEN
- WRITE(*,'(A,I5)')
- + ' Order of keys changed at',I
- GOTO 30
- ELSE
- IF(NCYCLE .EQ. NOLDCY(I))THEN
- MARKUP(I) = 0
- GOTO 30
- ENDIF
- ENDIF
- MARKUP(I) = 1
- IF(LBQBKD .NE. 0)THEN
- CALL MZDROP(0,LBQBKD,' ')
- LBQBKD = 0
- ENDIF
- CALL RZIN(0,LBQBKD,2,KEYS(1,I),IC1000,'D')
- IF(IQUEST(6) .GT. MAXCYC)MAXCYC = IQUEST(6)
- IF(LDQBKD .NE. 0)THEN
- CALL MZDROP(0,LDQBKD,' ')
- LDQBKD = 0
- ENDIF
- CALL RZIN(0,LDQBKD,2,KEYS(1,I),NOLDCY(I),'D')
- ND = IQ(LBQBKD+KQSP-1)
- IF(ND .NE. IQ(LDQBKD+KQSP-1))THEN
- NUPD = NUPD + 1
- WRITE(*,'(A,2A4)')' Update Key: ',KEYS(1,I),KEYS(2,I)
- GOTO 30
- ENDIF
- DO 20 K=1,ND
- IF(IQ(LBQBKD+KQSP+K) .NE. IQ(LDQBKD+KQSP+K))THEN
- NUPD = NUPD + 1
- WRITE(*,'(A,2A4)')' Update Key: ',KEYS(1,I),KEYS(2,
- + I)
- GOTO 30
- ENDIF
- 20 CONTINUE
-
- MARKUP(I) = 0
- CALL RZDELK(KEYS(1,I), IC1000, ' ')
-
- 30 CONTINUE
-
- NEWKEY = NKEYS - NKEYSB
- IF(NKEYS .GT. NKEYSB)THEN
- DO 40 I=NKEYSB+1,NKEYS
- WRITE(*,'(A,2A4)')' Add Key: ',KEYS(1,I),KEYS(2,I)
- 40 MARKUP(I) = 1
- ENDIF
- IF(LDQBKD .NE. 0)THEN
- CALL MZDROP(0,LDQBKD,' ')
- LDQBKD = 0
- ENDIF
- IF(LBQBKD .NE. 0)THEN
- CALL MZDROP(0,LBQBKD,' ')
- LBQBKD = 0
- ENDIF
- WRITE(*,'(I6,A)')NEWKEY,' key(s) added'
- WRITE(*,'(I6,A)')NUPD ,' key(s) updated'
- 50 CONTINUE
- END
-**********************************************************************
diff --git a/src/graflib/dzdoc/dzdraw/dzdwcs.F b/src/graflib/dzdoc/dzdraw/dzdwcs.F
deleted file mode 100644
index 2b7cc7e..0000000
--- a/src/graflib/dzdoc/dzdraw/dzdwcs.F
+++ /dev/null
@@ -1,53 +0,0 @@
-*
-* $Id: dzdwcs.F,v 1.1.1.1 1996/03/04 16:13:18 mclareni Exp $
-*
-* $Log: dzdwcs.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:18 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDWCS(CKEYWC, IHKEYR, NFKEY)
-#include "zebra/rzcl.inc"
-#include "zebra/rzk.inc"
- CHARACTER*(*) CKEYWC
- DIMENSION IHKEYR(2)
- INTEGER INKEY(2)
- CHARACTER*8 CHINKY
-*
-*-----------------------------------------------------------------------
-*
-
- IQUEST(1)=0
- IHKEYR(1) = 0
- IF(NFKEY .LT. 1)NFKEY = 1
-
- IF(LQRS.EQ.0)GO TO 999
- IF(LQRS.EQ.0)GO TO 999
- IF(LCDIR.EQ.0)GO TO 999
- LK = IQ(KQSP+LCDIR+KLK)
- NK = IQ(KQSP+LCDIR+KNKEYS)
- NWK= IQ(KQSP+LCDIR+KNWKEY)
- IF(NWK .NE. 2)GOTO 999
- IF(NFKEY .GT. NK )GOTO 999
- NCH = LEN(CKEYWC)
- IF(NCH .GT. 8)NCH = 8
-*
- N1 = NFKEY
- DO 30 I=N1,NK
- K=LK+(NWK+1)*(I-1)
- DO 10 J=1,2
- CALL ZITOH(IQ(KQSP+LCDIR+K+J),INKEY(J),1)
- 10 CONTINUE
- CALL UHTOC(INKEY(1),4,CHINKY,NCH)
- DO 20 IC = 1,NCH
- IF(CKEYWC(IC:IC) .EQ. '*')GOTO 20
- IF(CKEYWC(IC:IC) .NE. CHINKY(IC:IC))GOTO 30
- 20 CONTINUE
- NFKEY = I+1
- IHKEYR(1) = INKEY(1)
- IHKEYR(2) = INKEY(2)
- GOTO 999
- 30 CONTINUE
-*
- 999 END
diff --git a/src/graflib/dzdoc/dzdraw/dzdwtr.F b/src/graflib/dzdoc/dzdraw/dzdwtr.F
deleted file mode 100644
index 68f2cdb..0000000
--- a/src/graflib/dzdoc/dzdraw/dzdwtr.F
+++ /dev/null
@@ -1,85 +0,0 @@
-*
-* $Id: dzdwtr.F,v 1.1.1.1 1996/03/04 16:13:19 mclareni Exp $
-*
-* $Log: dzdwtr.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:19 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDWTR(ISTORE,L,LRET)
-*
-* walk through a d/s at L, return link to the next bank in LRET
-#include "zebra/zebq.inc"
-#include "zebra/mzca.inc"
-#include "zebra/mzcb.inc"
- INTEGER L,LIN,LRET,JB
- INTEGER LORIG, LUP, LFROM
- SAVE LORIG, LUP, LFROM
-*---
- CALL MZSDIV(ISTORE,-7)
-* init links and return
- IF(L.LT.0)THEN
- LRET=-L
- LORIG = LRET
- LUP = LRET
- LFROM = LQ(KQS+LRET+1)
- GOTO 90
- ENDIF
-*
- LIN=L
- JB = LUP - LORIG + 1
- 10 CONTINUE
- NS = IQ(KQS+LUP -2)
- IF(JB .LE. NS)THEN
-* go down
- LD1 = LQ(KQS+ LIN - JB)
-* look if this link is used
- IF(LD1 .EQ. 0)THEN
- JB = JB + 1
- GOTO 10
- ENDIF
- LUP = LD1
- LORIG = LD1
- LRET = LD1
- GOTO 90
- ENDIF
-
-* look if its part of linear structure
-
- LN = LQ(KQS+LIN)
- IF(LN .NE. 0)THEN
- LUP = LN
- LORIG = LN
- LRET = LN
- GOTO 90
- ENDIF
-
-* look if it is end of a linear structure
-* i.e. origin and up link are in different banks
-
- 50 CONTINUE
- LUP = LQ(KQS+LIN+1)
- LORIG = LQ(KQS+LIN+2)
-* look if back at top bank or if it would move above top bank
- IF(LUP .LE. 1 .OR. LUP .EQ. LFROM) THEN
- LRET=0
- GOTO 99
- ENDIF
- NSU = IQ(KQS+LUP-2)
- IF(LORIG .GE. LUP .OR. LORIG .LT. LUP-NSU)THEN
-* its different, step back
- LIN = LORIG
- GOTO 50
- ENDIF
-* go up
- LRET = LUP
- 90 CONTINUE
- JB = LUP - LORIG + 1
- IF(JB.NE.1) THEN
- LIN=LRET
- GOTO 10
- ENDIF
- 99 CONTINUE
- END
-***********************************************************************
diff --git a/src/graflib/dzdoc/dzdraw/dzdzbrinc.inc b/src/graflib/dzdoc/dzdraw/dzdzbrinc.inc
deleted file mode 100644
index 8268c5a..0000000
--- a/src/graflib/dzdoc/dzdraw/dzdzbrinc.inc
+++ /dev/null
@@ -1,39 +0,0 @@
-*
-* $Id: dzdzbrinc.inc,v 1.1.1.1 1996/03/04 16:13:00 mclareni Exp $
-*
-* $Log: dzdzbrinc.inc,v $
-* Revision 1.1.1.1 1996/03/04 16:13:00 mclareni
-* Dzdoc/Zebpack
-*
-*
-*
-* dzdzbrinc.inc
-*
- INTEGER LTBROW(0:15),LTBFLG(0:15), IACTST
- INTEGER LTDISP(0:15),LTDFLG(0:15),NLKUSE, ISTUSE
- INTEGER LZEBLK(3,0:15),LZEFLG(0:15), ISTNTU
- COMMON/DZDBRO/ LTBROW, LTBFLG, IACTST,
- & LTDISP, LTDFLG, ISTUSE, NLKUSE,
- & LZEBLK ,LZEFLG, ISTNTU
- LOGICAL EDITSV, LNEWWI
- PARAMETER (NUHMAX=400,NIOMAX=10)
- INTEGER
- & IWKZEB, IWMZEB, ILOZEB, IDOCFL, NDIADD,
- & IKDSP1, IKDSP2, ICYDSP, LUNTMP, LUDOCB,
- & LUPTMP, LPDOCB, LPDOCS, NIDMSK,
- & KEYMSK(9),KACMSK(9), NKYMSK, IAPPFL,
- & IUHEAD(NUHMAX), NUH, IOCHRD(NIOMAX), NWIOCH, INMFLG
-
- COMMON/DZDGRU/
- & IWKZEB, IWMZEB, ILOZEB, IDOCFL, NDIADD, EDITSV,
- & IKDSP1, IKDSP2, ICYDSP, LUDOCB, LUNTMP, LUPTMP, LPDOCB, LPDOCS,
- & NIDMSK, KACMSK, KEYMSK, NKYMSK, IAPPFL, IUHEAD, NUH,
- & IOCHRD, NWIOCH, INMFLG, LNEWWI
- INTEGER MDIADD
- PARAMETER (MDIADD=10)
- CHARACTER*80 CDIADD(MDIADD), CWDSAV
- COMMON/DZDIAD/ CDIADD
- CHARACTER*7 CTDDOC
- CHARACTER*1 CCOL, CCACT
- CHARACTER*4 CIDMSK, CHOPD1
- COMMON/DZDRZD/ CWDSAV,CIDMSK,CTDDOC, CCOL, CCACT, CHOPD1
diff --git a/src/graflib/dzdoc/dzdraw/dzdzeb.F b/src/graflib/dzdoc/dzdraw/dzdzeb.F
deleted file mode 100644
index 779385b..0000000
--- a/src/graflib/dzdoc/dzdraw/dzdzeb.F
+++ /dev/null
@@ -1,366 +0,0 @@
-*
-* $Id: dzdzeb.F,v 1.1.1.1 1996/03/04 16:13:00 mclareni Exp $
-*
-* $Log: dzdzeb.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:00 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZDZEB(BRNAME,BRCLAS,BRPATH,OBNAME,OBCLAS,STEXT,LTEXT)
- CHARACTER*(*) BRNAME,BRCLAS,BRPATH,OBNAME,OBCLAS,STEXT,LTEXT
-#include "zebra/mzbits.inc"
-#include "zebra/zebq.inc"
-#include "zebra/mzca.inc"
-#include "zebra/mzcb.inc"
-#include "zebra/mzcc.inc"
-#include "zebra/mzcn.inc"
-#include "zebra/zunit.inc"
-#include "dzdzbrinc.inc"
-*
- INTEGER IQUEST(100)
- COMMON/QUEST/IQUEST
-
- CHARACTER*16 CHTITL
- CHARACTER*8 CTEMP
- CHARACTER*2 CDIV
- INTEGER ICSTOR,ICDIV,IIST,IST, LGOP, IXDIV, IDH, NUMB, INIFLG
- CHARACTER*8 CHTAG(100)
- CHARACTER*100 CHFORM
- CHARACTER*80 CHPATH
- CHARACTER*1 CF
- CHARACTER*40 CHKEY, SPACES
- CHARACTER*256 LBRPAT
- INTEGER ICONTT,ICONTF,ICONTD,ICONTK,IRET, NCH, NWKEY, I, IP,ISAVD
- SAVE ICONTT,ICONTF, ICONTD, ICONTK,ISAVD, NWKEY
- SAVE ICSTOR,ICDIV, LGOP, NUMB, NID, INIFLG
- SAVE CHTAG, CHFORM, CHPATH
- DATA ICSTOR,ICDIV, INIFLG,ICONTT,ICONTF, ICONTD, ICONTK ,ISAVD
- & /0,0,0,0,0,0,0,0/
-
-*
-* Browser interface to return stores, div, banks, RZ and FZ files
-*
- IF(INIFLG.EQ.0)THEN
- CALL DZDIBR
- INIFLG=1
- ENDIF
-
-* the top page: Stores, RZfiles, FZfiles
-
- IF(BRPATH.EQ.' ')THEN
- IF(OBNAME.EQ.' ') THEN
- ICSTOR=0
- ICONTT=0
- ICONTF=0
- ICONTD=0
- ICONTK=0
- ENDIF
- OBNAME=' '
- IF(ICSTOR.GE.0)THEN
- ICSTOR=ICSTOR+1
- IF(ICSTOR.LE.NQSTOR+1)THEN
-* return stores
- IIST = 0
- CALL SBYT(ICSTOR-1,IIST,27,6)
- CALL MZSDIV(IIST,-7)
- CALL UHTOC(IQTABV(KQT+11),4,CTEMP,8)
- DO 26 I=1,8
- IF(CTEMP(I:I).EQ.'/')CTEMP(I:I)='_'
-26 CONTINUE
- WRITE(CDIV,'(I2.2)')ICSTOR-1
- OBNAME= 'M_'//'Store'//CDIV//'.'//CTEMP
- STEXT=' '
- LTEXT='Store'
- OBCLAS='STORE'
- GOTO 999
- ELSE
- ICSTOR=-1
- ENDIF
- ENDIF
-* Rzfiles
- IF(ICONTT.GE.0)THEN
-* next top directory (RZFILE)
- CALL DZDNTD(CHTITL,STEXT,ICONTT,IRET)
- IF(ICONTT.EQ.0)THEN
- ICONTT=-1
- ELSEIF(IRET.EQ.0)THEN
- OBCLAS='rzfil'
- OBNAME='R_'//CHTITL
- LTEXT='Rz_file'
- GOTO 999
- ENDIF
- ENDIF
-* Fzfiles
- IF(ICONTF.GE.0)THEN
-* next Fzfile
- CALL DZDNFZ(CHTITL,STEXT,ICONTF,IRET)
- IF(ICONTF.EQ.0)THEN
- ICONTF=-1
- ELSEIF(IRET.EQ.0)THEN
- OBCLAS='FZ'
- OBNAME='F_'//CHTITL
- LTEXT='Fzfile'
- GOTO 999
- ENDIF
- ENDIF
-
- GOTO 999
-* end of top page
- ENDIF
-
-* skip leading /
-
- IF(BRPATH(1:1).EQ.'/')THEN
- IFC=2
- ELSE
- IFC=1
- ENDIF
-
-* is it MZ or RZ of FZ
-
- IF(BRPATH(IFC:IFC+1).EQ.'R_')GOTO 100
- IF(BRPATH(IFC:IFC+1).EQ.'F_')GOTO 200
-
-* do MZ stuff
-
- IF (INDEX(BRPATH,'Div').NE.0)THEN
- IFC=INDEX(BRPATH,'Div')+3
- READ(BRPATH(IFC:IFC+1),'(I2)') IXDIV
- IFC=INDEX(BRPATH,'Store')
- IF(IFC.GT.0)THEN
- IFC=IFC+5
-* switch to store + division
- READ(BRPATH(IFC:IFC+1),'(I2)') IST
- ELSE
- WRITE(*,*)'Incomplete path specified: ',BRPATH
- GOTO 999
- ENDIF
- CALL SBYT(IST,IXDIV,27,6)
- CALL MZSDIV(IXDIV,1)
-* banks
- IF(OBNAME.EQ.' ') THEN
- LGOP=0
- NUMB=0
- IF(LTBROW(IACTST).NE.0)THEN
- IIST=0
- CALL SBYT(IACTST,IIST,27,6)
- CALL MZSDIV(IIST,-7)
- CALL MZDROP(IIST,LTBROW(IACTST),' ')
- LTBROW(IACTST)=0
- ENDIF
- CALL MZSDIV(IXDIV,1)
- IACTST=IST
-* get number of banks
- NUMB=0
-5 CALL DZDNBK(IXDIV,LGOP,LBNK,LFW,LLW,IDH,IDRFLG)
- LGOP=LBNK
- IF(LBNK.NE.0)THEN
-* dropped?
- IF(IDRFLG.EQ.0)NUMB = NUMB+1
- GOTO 5
- ENDIF
- IIST=0
- CALL SBYT(IST,IIST,27,6)
- IXD20=IIST+20
- IF(LTBFLG(IST).EQ.0)THEN
- CALL MZLINK(IIST,'DZDLNT',
- & LTBROW(IST),LTBROW(IST),LTBROW(IST))
- LTBFLG(IST)=1
- DO 6 K=21,24
-6 CALL MZXREF(IXD20,K+IIST,'A')
- ENDIF
- NUMB=NUMB+1
- CALL MZBOOK(IXD20,LTBROW(IST),LTBROW(IST),1,
- & 'ZBRO',NUMB,0,1,2,0)
- IQ(LTBROW(IST)+KQS+1)=IXDIV
- NUMB=0
- ENDIF
- OBNAME=' '
- STEXT=' '
- LTEXT='Bank'
- OBCLAS='BANK'
-10 CALL DZDNBK(IXDIV,LGOP,LBNK,LFW,LLW,IDH,IDRFLG)
- LGOP=LBNK
- IF(LBNK.NE.0)THEN
-* dropped?
- IF(IDRFLG.NE.0)GOTO 10
- NID=IQ(LBNK+KQS-5)
- IF(NIDMSK.NE.0)THEN
- IF(NID.NE.NIDMSK)GOTO 10
- ENDIF
- CALL UHTOC(IDH,4,OBNAME,4)
-* check mask
- IF(CIDMSK.NE.' ')THEN
- DO 15 I=1,4
- IF(CIDMSK(I:I).NE.' ')THEN
- IF(CIDMSK(I:I).NE.OBNAME(I:I))THEN
- OBNAME(1:4)=' '
- GOTO 10
- ENDIF
- ENDIF
-15 CONTINUE
- ENDIF
-
- NUMB = NUMB+1
- WRITE(STEXT,'(I8)')NUMB
-
- LQ(LTBROW(IST)+KQS-NUMB)=LBNK
- WRITE(CTEMP,'(I8)')NID
- IFC=INDEXN(CTEMP,' ')
- IFC=MAX(IFC,1)
- ILC=LENOCC(OBNAME)+1
- OBNAME(ILC:ILC)='.'
- ILC=ILC+1
- OBNAME(ILC:)=CTEMP(IFC:)
- ILC=LENOCC(OBNAME)
- WRITE(CTEMP,'(I8)')NUMB
- IFC=INDEXN(CTEMP,' ')
- IFC=MAX(IFC,1)
- OBNAME(ILC+1:ILC+1)=' '
- OBNAME(ILC+2:)=CTEMP(IFC:)
- GOTO 999
- ENDIF
- ELSE IF (INDEX(BRPATH,'Store').NE.0)THEN
- IFC=INDEX(BRPATH,'Store')+5
-* switch to store
- READ(BRPATH(IFC:IFC+1),'(I2)') IST
- IIST = 0
- CALL SBYT(IST,IIST,27,6)
- CALL MZSDIV(IIST,-7)
- IACTST=IST
-* divisions
- IF(OBNAME.EQ.' ') THEN
- ICDIV=0
- ENDIF
- OBNAME=' '
-20 ICDIV=ICDIV+1
- IF(ICDIV.LE.20)THEN
- IFAD = LQSTA(KQT+ICDIV)
- ILAD = LQEND(KQT+ICDIV)
- IF(IFAD .NE. 0 .AND. IFAD .NE. ILAD)THEN
- CALL UHTOC(IQDN1(KQT+ICDIV),4,CTEMP(1:4),4)
- CALL UHTOC(IQDN2(KQT+ICDIV),4,CTEMP(5:8),4)
- DO 25 I=1,8
- IF(CTEMP(I:I).EQ.'/')CTEMP(I:I)='_'
-25 CONTINUE
- WRITE(CDIV,'(I2.2)')ICDIV
- OBNAME= 'Div'//CDIV//'.'//CTEMP
- STEXT='Div'
- LTEXT='Division'
- OBCLAS='DIV'
- GOTO 999
- ELSE
- GOTO 20
- ENDIF
- ENDIF
- ENDIF
-* end of MZ stuff
- GOTO 999
-
-100 CONTINUE
-
-* RZ stuff
-* save current directory
- IF(ISAVD.EQ.0)THEN
- CALL RZCDIR(CHPATH,'R')
- ISAVD=1
- ENDIF
- IF(BRPATH.NE.' ')THEN
- IF(ISAVD.EQ.1)THEN
- LBRPAT = '//'//BRPATH(IFC+2:LENOCC(BRPATH))
- CALL RZCDIR(LBRPAT,' ')
- ISAVD=2
- ENDIF
- IF(OBNAME.EQ.' ') THEN
- ICONTD=0
- ICONTK=0
- ENDIF
- ENDIF
- OBNAME=' '
- CHTITL=' '
- IF(ICONTD.GE.0)THEN
-* next ord directory
- CALL DZDNDI(CHTITL,ICONTD,IRET)
- IF(ICONTD.EQ.0)THEN
- ICONTD=-1
- ELSEIF(IRET.EQ.0)THEN
- OBCLAS='rzdir'
- OBNAME=CHTITL
- STEXT='d'
- LTEXT='directory'
- GOTO 888
- ENDIF
- ENDIF
-* next key
-105 ICONTK=ICONTK+1
- ICYCLE=ICYDSP
- CALL RZIN(0,LL,2,ICONTK,ICYCLE,'CS')
- IF(IQUEST(1).EQ.0)THEN
-* dont show if append mode ?
- IF(IAPPFL.EQ.0 .AND. IAND(IQUEST(14),8).NE.0)GOTO 105
-* look for mask
-
- IF(NKYMSK.GT.0)THEN
- NWKEY=MIN(IQUEST(8),9)
- DO 106 I = 1,NWKEY
- IF(KACMSK(I).NE.0)THEN
- IF(KEYMSK(I).NE.IQUEST(20+I))GOTO 105
- ENDIF
-106 CONTINUE
- ENDIF
- IF(ISAVD.EQ.2)THEN
- CALL RZKEYD(NWKEY,CHFORM,CHTAG)
- ISAVD=3
- ENDIF
-* NWKEY=MIN(NWKEY,2)
- CHKEY=' '
- IP=1
- IF(IKDSP1.LE.0 .OR. IKDSP1.GT. NWKEY)THEN
- IK1=1
- ELSE
- IK1=IKDSP1
- ENDIF
- IF(IKDSP2.LE.0 .OR. IKDSP2.GT. NWKEY)THEN
- IK2=2
- ELSE
- IK2=IKDSP2
- ENDIF
- DO 110 I=1,NWKEY
- IF(I.NE.IK1 .AND. I.NE.IK2)GOTO 110
- CF=CHFORM(I:I)
- IF(CF.EQ.'A' .OR. CF.EQ.'H')THEN
- CALL UHTOC(IQUEST(20+I),4,CHKEY(IP:IP+3),4)
- IF(I.LT.NWKEY .AND. CF.EQ.'H')CHKEY(IP+4:IP+4)='_'
- ELSE
- WRITE(CHKEY(IP:IP+10),'(I11)')IQUEST(20+I)
- IF(I.LT.NWKEY)CHKEY(IP+11:IP+11)='_'
- ENDIF
-110 IP=IP+12
- CHKEY=SPACES(CHKEY,0)
- NCH=LENOCC(CHKEY)
- WRITE(CHKEY(NCH+2:),'(I10)')ICONTK
- CHKEY = SPACES(CHKEY,1)
- OBNAME = CHKEY
- OBCLAS = 'KEY'
- CALL RZDATE(IQUEST(14),IDATE,ITIME,1)
- WRITE(LTEXT,'(I6,A,I4)')IDATE,'/',ITIME
- WRITE(STEXT,'(I10)')ICONTK
- ELSE
- CALL RZCDIR(CHPATH,' ')
- ISAVD=0
- OBNAME = ' '
- ENDIF
-
-* 888 CALL RZCDIR(CHPATH,' ')
-888 CONTINUE
-
-* end of RZ stuff
-
-200 CONTINUE
-
-* FZ stuff
-
-999 CONTINUE
- END
-*********************************************************************
diff --git a/src/graflib/dzdoc/dzdraw/dze2ht.F b/src/graflib/dzdoc/dzdraw/dze2ht.F
deleted file mode 100644
index 0d65dea..0000000
--- a/src/graflib/dzdoc/dzdraw/dze2ht.F
+++ /dev/null
@@ -1,332 +0,0 @@
-*
-* $Id: dze2ht.F,v 1.1.1.1 1996/03/04 16:13:19 mclareni Exp $
-*
-* $Log: dze2ht.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:19 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZE2HT(LUNIN,LUNUSE, FLAG, UPUP1)
- IMPLICIT NONE
-
- INTEGER LUNIN,LUNUSE
- CHARACTER*80 CFOUT
- CHARACTER*4 UPUP1
- INTEGER FLAG
-*
-* convert DZEDIT SGML to HTML, plug in links
-*
-* flag: Steering flag:
-* 0 make all hyperlinks internal only
-* 1 add file name in first up bank
-* 2 add file names in all links
-* 3 as 2 and make 1 file/bank
-* upup1: Id of Upbank of Upbank of top bank
-*
-* output file name(s): BankId//UpId.html
-*
-* Author: O.Schaile
-*
- INTEGER ML, MS
- PARAMETER (ML=2000, MS=5000)
- CHARACTER*132 CB(ML), CL
- CHARACTER*8 CSTACK(MS), CLIST(MS)
- CHARACTER*4 BANKID, UPID, UPUPID, DOWNID
- CHARACTER*13 CF
- CHARACTER*4 DZE2US
- INTEGER IPBKID,IPUP,IPLSTA,IPLLAS, ISTAT, IP, IPSTAC,I,J,K,NC
- + ,INDEXA,INDEXN,INDEXC,LNBLNK, IS, NUP,NCUPID,NCCF,IPLIST
- + ,LUNOUT, NBANKS, NFILES
- LOGICAL EOF, IGNORE
-*---
- IF(UPUP1.EQ.' ')THEN
- UPUP1='NONE'
- ELSE
- UPUP1=DZE2US(UPUP1)
- ENDIF
- EOF=.FALSE.
- IGNORE=.FALSE.
- NUP = 0
- NBANKS=0
- NFILES=0
- LUNOUT=0
-
-* Run through files and find all banks
- IPBKID=0
- IPUP=0
- IPLIST=0
-* 10 READ(LUNIN,'(A)',END=50)CL
-10 CALL DZDCRD(LUNIN,CL,ISTAT)
- IF(ISTAT.NE.0)GOTO 50
- IF(CL(2:9).EQ.'Bank IDH')THEN
- IPBKID=1
- CB(1)=CL
- BANKID=CL(12:15)
- ELSE IF(CL(2:5).EQ.'Up ')THEN
- IF(IPBKID.EQ.0)THEN
- WRITE(*,*)'Prescan: Upbank appears before bank'
- GOTO 999
- ENDIF
- UPID=CL(12:15)
- BANKID=DZE2US(BANKID)
- UPID =DZE2US(UPID)
- IPLIST=IPLIST+1
- IF(IPLIST.GT.MS)THEN
- WRITE(*,*)'Too many banks',IPLIST
- GOTO 999
- ENDIF
- CLIST(IPLIST)=BANKID//UPID
- IPBKID=0
- ENDIF
- GOTO 10
-
- 50 CONTINUE
-
- REWIND(LUNIN)
-* LOOP ON BANKS
-
- IPSTAC=0
- 100 CONTINUE
- IP=0
- IPBKID=0
- IPUP=0
- IPLSTA=0
- IPLLAS=0
-* 110 READ(LUNIN,'(A)',END=150)CL
- 110 CALL DZDCRD(LUNIN,CL,ISTAT)
- IF(ISTAT.NE.0)GOTO 150
-* IGNORE ALL CONTROL LINES
- IF(CL(1:4).EQ.'<FIG')IGNORE=.TRUE.
- IF(CL(1:5).EQ.'</FIG')IGNORE=.FALSE.
- IF(IGNORE)GOTO 110
- IF(CL(1:1).EQ.'<')GOTO 110
- IF(CL(1:2).EQ.' |')GOTO 110
- IF(CL(1:11).EQ.' ----------')GOTO 110
-* GET HERE FOR START OF A NEW BANK
- 115 CONTINUE
- IF(CL(2:9).EQ.'Bank IDH')THEN
-* ONE FILE/BANK
- IF(FLAG.GE.3)THEN
- IF(LUNOUT.NE.0)THEN
- CLOSE(LUNOUT)
- LUNOUT=0
- ENDIF
- ENDIF
- IF(IPBKID.NE.0)THEN
- NBANKS=NBANKS+1
- IF(IPLSTA.NE.0 .AND. IPLLAS.EQ.0)IPLLAS=IP
- IPSTAC=IPSTAC+1
- IF(IPSTAC.GT.MS)THEN
- WRITE(*,*)'Too many banks'
- GOTO 999
- ENDIF
-*
- NCUPID=LNBLNK(UPID)
- BANKID=DZE2US(BANKID)
- UPID =DZE2US(UPID)
- IF(LUNOUT.LE.0)THEN
- LUNOUT=LUNUSE
- CALL CUTOL(CFOUT)
-#if !defined(CERNLIB_QMIBM)
- CFOUT=BANKID//UPID//'.html'
- CALL KUOPEN(LUNOUT,CFOUT(1:LNBLNK(CFOUT)),
- + 'UNKNOWN',ISTAT)
-#endif
-#if defined(CERNLIB_QMIBM)
- CFOUT=BANKID//UPID//' html'
- CALL FILEINF(ISTAT,'LRECL',256,'RECFM','V')
- OPEN(LUNOUT,FILE='/'//CFOUT(1:LNBLNK(CFOUT)),
- + ACCESS='SEQUENTIAL',
- + STATUS='UNKNOWN',FORM='FORMATTED',IOSTAT=ISTAT)
-#endif
- NFILES=NFILES+1
- WRITE(LUNOUT,'(A)')'<html>'
- WRITE(LUNOUT,'(A)')'<head>'
- WRITE(LUNOUT,'(A)')'<body>'
- WRITE(LUNOUT,'(A)')'<isindex>'
- WRITE(LUNOUT,'(A)')'</head>'
- WRITE(LUNOUT,'(A)')'<body>'
- WRITE(LUNOUT,'(A)')'<pre>'
- ENDIF
- CSTACK(IPSTAC)=BANKID//UPID
- DO I=1,IP
- NC = LNBLNK(CB(I))
- IF(I.EQ.IPBKID)THEN
- WRITE(LUNOUT,'(A)')'<hr>'
- WRITE(LUNOUT,'(A)')'<a name="'
- + //BANKID//UPID//'"><b>'//
- + CB(I)(1:NC)//'</b></a>'
- ELSE IF(I.EQ.IPUP .AND. UPID.NE.'NONE')THEN
-* FIRST FIND UP BANK OF IT
- IF(IPSTAC.EQ.1 .AND. UPUP1.NE.' ')THEN
- UPUPID=UPUP1
- ELSE
- UPUPID='NONE'
- IF(IPSTAC.GT.1)THEN
- DO K=IPSTAC-1,1,-1
- IF(CSTACK(K)(1:4).EQ.UPID)THEN
- UPUPID=CSTACK(K)(5:8)
- GOTO 120
- ENDIF
- ENDDO
- 120 CONTINUE
- ENDIF
- ENDIF
- IF((FLAG.GE.1 .AND. NUP .EQ.0) .OR.
- + FLAG.GE.2) THEN
- CF=UPID//UPUPID//'.html'
- CALL CUTOL(CF)
- NCCF=LNBLNK(CF)
- ELSE
- NCCF=0
- ENDIF
- NUP=NUP+1
- NC=MAX(NC,16)
- IF(NCCF.GT.0)THEN
- WRITE(LUNOUT,'(A)')' Up <a href="'//
- + CF//'#'//UPID//UPUPID//
- + '"><b>'//CB(I)(12:15)//'</b></a>'//
- + CB(I)(16:NC)
- ELSE
- WRITE(LUNOUT,'(A)')' Up <a href="'//
- + '#'//upid//upupid//
- + '"><b>'//CB(I)(12:15)//'</b></a>'//
- + CB(I)(16:NC)
- ENDIF
- ELSEIF(IPLSTA.NE.0.AND.I.GE.IPLSTA.AND.I.LE.IPLLAS)THEN
- IS=INDEXC(CB(I),' ')
- IF(IS.LE.0)GOTO 145
-* is it an integer, i.e. only numbers or space?
- DO 126 J=IS,IS+4
- IF(CB(I)(J:J).NE.' ')THEN
- IF(INDEXN(CB(I)(J:J)).NE.1)GOTO 130
- ENDIF
-126 CONTINUE
-* READ(CB(I)(IS:IS+4),'(I5)',ERR=130)K
-* yes, where does name start?
- IS = INDEXA(CB(I))
- IF(IS.LE.0)THEN
- WRITE (*,*)' Down link has no name ', BANKID, UPID
- WRITE(*,*) CB(I)
- IS=10
- ENDIF
- DOWNID=CB(I)(IS:IS+3)
- DOWNID=DZE2US(DOWNID)
- IF(FLAG.GE.2)THEN
- CF=DOWNID//BANKID//'.html'
- CALL CUTOL(CF)
- NCCF=13
- ELSE
- NCCF=0
- ENDIF
- IF(NCCF.GT.0)THEN
- NC=MAX(NC,IS+4)
- WRITE(LUNOUT,'(A)')CB(I)(1:IS-1)//
- + '<a href="'//CF//'#'//
- + DOWNID//BANKID//'"><b>'//
- + CB(I)(IS:IS+3)//'</b></a>'//
- + CB(I)(IS+4:NC)
- ELSE
-* is there doc?
- DO K=1,IPLIST
- IF(CLIST(K).EQ.DOWNID//BANKID)THEN
- WRITE(LUNOUT,'(A)')CB(I)(1:IS-1)//
- + '<a href="#'//
- + DOWNID//BANKID//'"><b>'//
- + CB(I)(IS:IS+3)//'</b></a>'//
- + CB(I)(IS+4:NC)
- GOTO 125
- ENDIF
- ENDDO
-* fallen through do loop, no doc there
- WRITE(LUNOUT,'(A)')CB(I)(1:IS-1)//
- + '<a href="nodoc.html"><b>'//
- + CB(I)(IS:IS+3)//'</b></a>'//
- + CB(I)(IS+4:NC)
- WRITE(*,'(A)')' No doc for: '
- + //DOWNID//' '//BANKID//
- + ' will make a reference to: "nodoc.html"'
- 125 CONTINUE
- ENDIF
- GOTO 140
- 130 CONTINUE
- NC=MAX(NC,1)
- WRITE(LUNOUT,'(A)')CB(I)(1:NC)
- 140 CONTINUE
- ELSE
- NC=MAX(NC,1)
- WRITE(LUNOUT,'(A)')CB(I)(1:NC)
- ENDIF
- 145 CONTINUE
- ENDDO
- IF(EOF) GOTO 900
- IPBKID=0
- IP=0
- IPBKID=0
- IPUP=0
- IPLSTA=0
- IPLLAS=0
- ENDIF
- IP=IP+1
- CB(IP)=CL
- IPBKID=IP
- BANKID=CL(12:15)
- CALL CLTOU(BANKID)
- ELSE IF(CL(2:5).EQ.'Up ')THEN
- IF(IPUP.NE.0)THEN
- WRITE(*,*)'More then 1 Up bank'
- GOTO 999
- ENDIF
- IP=IP+1
- CB(IP)=CL
- IPUP=IP
- UPID=CL(12:15)
- CALL CLTOU(UPID)
- ELSE IF(INDEX(CL,'Description of the links') .NE. 0)THEN
- IF(IPLSTA.NE.0)THEN
- WRITE(*,*)'More then 1 Link block start'
- GOTO 999
- ENDIF
- IP=IP+1
- CB(IP)=CL
- IPLSTA=IP+1
- ELSE IF(INDEX(CL,'Description of the data') .NE. 0)THEN
- IF(IPLLAS.NE.0)THEN
- WRITE(*,*)'More then 1 Link block end'
- GOTO 999
- ENDIF
- IP=IP+1
- CB(IP)=CL
- IPLLAS=IP-1
- ELSE
- IP=IP+1
- CB(IP)=CL
- ENDIF
- GOTO 110
- 150 EOF=.TRUE.
-* DO THE LAST BANK
- CL(2:9)='Bank IDH'
- GOTO 115
-
-900 CONTINUE
- WRITE(LUNOUT,'(A)')'</pre>'
- WRITE(LUNOUT,'(A)')'</body>'
- WRITE(LUNOUT,'(A)')'</html>'
- CLOSE(LUNIN)
- CLOSE(LUNOUT)
-999 END
-
- CHARACTER*(*) FUNCTION DZE2US(CH)
- CHARACTER*(*) CH
- DO I=1,LEN(CH)
- IF(CH(I:I).EQ.' ')THEN
- DZE2US(I:I)='_'
- ELSE
- DZE2US(I:I)=CH(I:I)
- ENDIF
- ENDDO
- RETURN
- END
-************************************************************************
-
diff --git a/src/graflib/dzdoc/dzdraw/qstore.inc b/src/graflib/dzdoc/dzdraw/qstore.inc
deleted file mode 100644
index 001aeb2..0000000
--- a/src/graflib/dzdoc/dzdraw/qstore.inc
+++ /dev/null
@@ -1,13 +0,0 @@
-*
-* $Id: qstore.inc,v 1.1.1.1 1996/03/04 16:13:00 mclareni Exp $
-*
-* $Log: qstore.inc,v $
-* Revision 1.1.1.1 1996/03/04 16:13:00 mclareni
-* Dzdoc/Zebpack
-*
-*
-*
-* qstore.inc
-*
- IF (JBYT(IXSTOR,27,6).NE.JQSTOR) CALL MZSDIV (IXSTOR,-7)
-***********************************************************************
diff --git a/src/graflib/dzdoc/dzedit/Imakefile b/src/graflib/dzdoc/dzedit/Imakefile
deleted file mode 100644
index 34ff8f4..0000000
--- a/src/graflib/dzdoc/dzedit/Imakefile
+++ /dev/null
@@ -1,26 +0,0 @@
-#define IHaveCDF
-
-SRCS_F= dzebkk.F dzechf.F dzechk.F dzecpp.F dzedel.F dzedff.F \ @@\
- dzedof.F dzedrw.F dzedrz.F dzedsp.F dzehpe.F dzelal.F \ @@\
- dzelas.F dzelin.F dzelof.F dzemrz.F dzenpg.F dzeop1.F dzeopl.F \ @@\
- dzeppa.F dzepsb.F dzepur.F dzeqit.F dzerds.F dzesgp.F dzeurz.F \ @@\
- dzewem.F dzezer.F
-
-SRCS_CDF= dzeditcdf.cdf
-
-DefinePackageLibrary(dzdoc)
-
-#ifdef CERNLIB_HPUX
-FORTRANOPTIONS+= -WF,-P
-#endif
-
-SubdirLibraryTarget(dzdoc,NullParameter)
-
-#ifdef CERNLIB_VAXVMS
-NeedTcpipLib
-#endif
-
-CernlibFortranProgramTarget(dzeX11,dzedit.o,$(PACKAGE_LIB),$(PACKAGE_LIB),graflib/X11 packlib)
-
-InstallProgram(dzeX11,$(CERN_BINDIR))
-InstallScript(dzedit,$(CERN_BINDIR))
diff --git a/src/graflib/dzdoc/dzedit/dzebkk.F b/src/graflib/dzdoc/dzedit/dzebkk.F
deleted file mode 100644
index a404b0a..0000000
--- a/src/graflib/dzdoc/dzedit/dzebkk.F
+++ /dev/null
@@ -1,48 +0,0 @@
-*
-* $Id: dzebkk.F,v 1.1.1.1 1996/03/04 16:13:23 mclareni Exp $
-*
-* $Log: dzebkk.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:23 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZEBKK
- CHARACTER*8 CHOPTB,CHCMD
- CHARACTER*2 CHOPTI
-#include "dzeditkeep.inc"
-
-* make keep sequences for bank booking
-
- IF(LUNRZ.EQ.0)THEN
- WRITE(LUNOUT,*)' No RZ-file open'
- GOTO 999
- ENDIF
- CALL KUGETC(CHBSBK,NCHA)
- CALL KUGETC(CHBSUP,NCHA)
- CALL KUGETS(CHLIST,NCLIST)
- CALL KUGETC(CHOPTB,NCOPT)
- CALL KUPATL(CHCMD,NPAR)
- IF(NCLIST .NE. 0)THEN
- LUNLST=LUPLST
- IF(ILSTOP .EQ. 0)THEN
- CALL KUOPEN(LUNLST,CHLIST,'UNKNOWN',ISTAT)
- ILSTOP = 1
- ENDIF
- ELSE
- LUNLST=6
- ENDIF
- IF(INDEX(CHOPTB,'S').EQ.0)THEN
- CHOPTI='T '
- ELSE
- CHOPTI=' '
- ENDIF
- IF( INDEX(CHOPTB,'L').EQ. 0)THEN
- IF(CHCMD.EQ.'BOOK')THEN
- CHOPTI(2:2)='B'
- ELSE
- CHOPTI(2:2)='L'
- ENDIF
- ENDIF
- CALL DZDCOD(CHBSBK//CHBSUP,'BANK',CHOPTI//CHOPTB,' ',LUNLST,0,0)
- 999 END
diff --git a/src/graflib/dzdoc/dzedit/dzechf.F b/src/graflib/dzdoc/dzedit/dzechf.F
deleted file mode 100644
index 7f44b6d..0000000
--- a/src/graflib/dzdoc/dzedit/dzechf.F
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: dzechf.F,v 1.1.1.1 1996/03/04 16:13:23 mclareni Exp $
-*
-* $Log: dzechf.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:23 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZECHF
-#include "dzeditkeep.inc"
- LUNCOM=LUPCOM
- CALL KUOPEN(LUNCOM,CHCOMP,'OLD',ISTAT)
- IF(ISTAT.NE.0)THEN
- WRITE(LUNOUT,*)' Error opening ',CHCOMP
- ELSE
- CALL DZECHK
- ENDIF
- END
-***********************************************************************
diff --git a/src/graflib/dzdoc/dzedit/dzechk.F b/src/graflib/dzdoc/dzedit/dzechk.F
deleted file mode 100644
index 9c3c5ad..0000000
--- a/src/graflib/dzdoc/dzedit/dzechk.F
+++ /dev/null
@@ -1,72 +0,0 @@
-*
-* $Id: dzechk.F,v 1.1.1.1 1996/03/04 16:13:23 mclareni Exp $
-*
-* $Log: dzechk.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:23 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZECHK
-#include "dzeditkeep.inc"
- INTEGER KEYVEC(2)
-* compare contents of RZfile with contents of CHCOMP
-
- NFKEY = 1
- NONCON = 0
- NENTRY=0
- WRITE(LUNLST,'(A)')' Diagnostics:'
-5 CALL DZDCRD(LUNCOM,CHKEYC,IRC)
- IF(IRC.NE.0)GOTO 6
-* 5 READ(LUNCOM,'(A)',END=6)CHKEYC
- NENTRY=NENTRY+1
- GOTO 5
-6 CONTINUE
- REWIND LUNCOM
- CALL MZBOOK(0,LTAUX,LTAUX,1,'DZEC',0,0,2*NENTRY,2,-1)
- IP=-1
- DO 7 I=1,NENTRY
- CALL DZDCRD(LUNCOM,CHKEYC,IRC)
-* READ(LUNCOM,'(A)')CHKEYC
- CALL CLTOU(CHKEYC)
- IP=IP+2
- CALL UCTOH(CHKEYC,IQ(LTAUX+IP),4,8)
-7 CONTINUE
-
- 10 CONTINUE
- CALL DZDWCS('********',KEYVEC,NFKEY)
- IF(KEYVEC(1) .EQ. 0)THEN
- IF(NONCON .EQ. 0)WRITE(*,*)' None'
- GOTO 888
- ENDIF
-* CALL UHTOC(KEYVEC(1),4,CHKEY(1:4),4)
-* CALL UHTOC(KEYVEC(2),4,CHKEY(5:8),4)
- IFOUND = 0
- IP=-1
-* 20 READ(LUNCOM,'(A)',END=30 )CHKEYC
-* CALL CLTOU(CHKEYC)
-* CALL CLTOU(CHKEY)
-20 IP=IP+2
- IF(IP .GE. 2*NENTRY)GOTO 30
- IF(KEYVEC(1).NE.IQ(LTAUX+IP))GOTO 20
- IF(KEYVEC(2).NE.IQ(LTAUX+IP+1))GOTO 20
-* IF(CHKEY .NE. CHKEYC)GOTO 20
- IF(IFOUND .NE. 0)THEN
- WRITE(LUNLST,'(A,A4,A,A4,A)')' ',KEYVEC(1),'/',KEYVEC(2),
- + ' Multiply used:'
- NONCON = NONCON+1
- ENDIF
- IFOUND = 1
- GOTO 20
- 30 CONTINUE
- IF(IFOUND .EQ. 0)THEN
- WRITE(LUNLST,'(A,A4,A,A4,A)')' ',KEYVEC(1),'/',KEYVEC(2),
- + ' Not connected: '
- NONCON=NONCON+1
- ENDIF
-* REWIND LUNCOM
- GOTO 10
- 888 CONTINUE
- IF(LTAUX.NE.0)CALL MZDROP(0,LTAUX,' ')
- LTAUX=0
- 999 END
diff --git a/src/graflib/dzdoc/dzedit/dzecpp.F b/src/graflib/dzdoc/dzedit/dzecpp.F
deleted file mode 100644
index 0df2882..0000000
--- a/src/graflib/dzdoc/dzedit/dzecpp.F
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: dzecpp.F,v 1.1.1.1 1996/03/04 16:13:24 mclareni Exp $
-*
-* $Log: dzecpp.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:24 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZECPP(LUNIN,LUNOUT)
- CHARACTER*80 CLINE
- COMMON/DZDPPC/CLINE
- 10 CONTINUE
- CALL DZDCRD(LUNIN,CLINE,IRC)
- IF(IRC.NE.0)GOTO 30
-* READ(LUNIN,'(A)',END=30 )CLINE
- IF(CLINE(1:1).EQ.'%')THEN
- IF(CLINE(1:9).EQ.'%%PICTURE')THEN
- GOTO 30
- ELSE
- GOTO 10
- ENDIF
- ELSE
- ILC = INDXBC(CLINE,' ')
- WRITE(LUNOUT,'(A)')CLINE(1:ILC)
- GOTO 10
- ENDIF
- 30 CONTINUE
- END
-
-**********************************************************************
diff --git a/src/graflib/dzdoc/dzedit/dzedel.F b/src/graflib/dzdoc/dzedit/dzedel.F
deleted file mode 100644
index 8639c30..0000000
--- a/src/graflib/dzdoc/dzedit/dzedel.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: dzedel.F,v 1.1.1.1 1996/03/04 16:13:22 mclareni Exp $
-*
-* $Log: dzedel.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:22 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZEDEL
-* delete
-#include "dzeditkeep.inc"
- CHARACTER*4 CHDOPT
- INTEGER KEYDEL(2)
- CALL KUGETC(CHBSBK,NCHA)
- IF(NCHA.LT.4)CHBSBK(NCHA:4)=' '
- CALL KUGETC(CHBSUP,NCHA)
- IF(NCHA.LT.4)CHBSUP(NCHA:4)=' '
- CALL UCTOH(CHBSBK,KEYDEL(1),4,4)
- CALL UCTOH(CHBSUP,KEYDEL(2),4,4)
- CALL KUGETI(ICYCLE)
- CALL KUGETC(CHDOPT,NCLOPT)
- CALL RZDELK(KEYDEL,ICYCLE,CHDOPT)
-* IF(IQUEST(1).NE.0)WRITE(*,*)' Key/cycle not found'
- WRITE(*,*)' Maximum number of cycles deleted:',IQUEST(11)
- END
-**********************************************************************
-
diff --git a/src/graflib/dzdoc/dzedit/dzedff.F b/src/graflib/dzdoc/dzedit/dzedff.F
deleted file mode 100644
index 2988b4b..0000000
--- a/src/graflib/dzdoc/dzedit/dzedff.F
+++ /dev/null
@@ -1,44 +0,0 @@
-*
-* $Id: dzedff.F,v 1.1.1.1 1996/03/04 16:13:23 mclareni Exp $
-*
-* $Log: dzedff.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:23 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZEDFF
-#include "dzeditkeep.inc"
-#if defined(CERNLIB_BSLASH)
-#include "dzdoc/bslash2.inc"
-#endif
-#if !defined(CERNLIB_BSLASH)
-#include "dzdoc/bslash1.inc"
-#endif
-
-* set default parameters
-
- CALL KUCMD ('DZEDIT',' ','SW')
-
- CALL KUPVAL('CREATEDOC' ,'CHCARD',0,0.,CHCARD,'D')
- CALL KUPVAL('CREATEDOC' ,'CHRZF',0,0.,CHRZF,'D')
- CALL KUPVAL('UPDATEDOC' ,'CHCARD',0,0.,CHCARD,'D')
- CALL KUPVAL('UPDATEDOC' ,'CHRZF',0,0.,CHRZF,'D')
- CALL KUPVAL('UPDATEDOC' ,'CHSUBD',0,0.,CHSUBD,'D')
- CALL KUPVAL('OPENRZFILE' ,'CHRZF',0,0.,CHRZF,'D')
- CALL KUPVAL('DRAWONETREE' ,'CHMETA',0,0.,CHMETA,'D')
- CALL KUPVAL('DRAWONETREE' ,'CHSGML',0,0.,CHSGML,'D')
- CALL KUPVAL('DRAWONETREE' ,'CTITLE',0,0.,CTITLE,'D')
- CALL KUPVAL('DRAWONETREE' ,'CHOPT',0,0.,'P','D')
- CALL KUPVAL('DRAWALL' ,'CHMETA',0,0.,CHMETA,'D')
- CALL KUPVAL('DRAWALL' ,'CHSGML',0,0.,CHSGML,'D')
- CALL KUPVAL('DRAWALL' ,'CTITLE',0,0.,CTITLE,'D')
- CALL KUPVAL('DRAWALL' ,'CHOPT',0,0.,'P','D')
- CALL KUPVAL('LISTONEBANK' ,'CHLIST',0,0.,CHLIST,'D')
- CALL KUPVAL('LISTONEBANK' ,'CHBSBK',0,0.,CHBSBK,'D')
- CALL KUPVAL('LISTONEBANK' ,'CHBSUP',0,0.,CHBSUP,'D')
- CALL KUPVAL('LISTALL' ,'CHLIST',0,0.,CHLIST,'D')
- CALL KUCMD (BS,' ','SW')
- END
-
-***********************************************************************
diff --git a/src/graflib/dzdoc/dzedit/dzedit.F b/src/graflib/dzdoc/dzedit/dzedit.F
deleted file mode 100644
index e6c45da..0000000
--- a/src/graflib/dzdoc/dzedit/dzedit.F
+++ /dev/null
@@ -1,154 +0,0 @@
-*
-* $Id: dzedit.F,v 1.2 1997/03/14 14:20:36 mclareni Exp $
-*
-* $Log: dzedit.F,v $
-* Revision 1.2 1997/03/14 14:20:36 mclareni
-* WNT mods
-*
-* Revision 1.1.1.1.2.1 1997/01/21 11:25:01 mclareni
-* All mods for Winnt 96a on winnt branch
-*
-* Revision 1.1.1.1 1996/03/04 16:13:20 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- PROGRAM DZEDMA
-#include "dzeditkeep.inc"
- LOGICAL INTRAC
- CHARACTER*128 CSCRAT
-* INTEGER MZLIST(4)
-* DATA MZLIST/3,0,3,3/
-* EXTERNAL IGTERM
-#if defined(CERNLIB_QMIBM)
- CALL INITC()
-#endif
- CALL DZDPRV
- CALL DZDIBR
-C-- Declare the primary store
-
-C-- Declare the primary store
-C-- OPEN(3,FILE='zebra.log',STATUS='UNKNOWN')
-C-- WRITE(3,*)'***** Dzedit: Zebra log *****'
-C-- CALL DATIME(IDATE0,ITI)
-C-- WRITE(3,*)'It is now: ',IDATE0,ITI
-C-- CALL MZEBRA(MZLIST)
-
- CALL MZEBRA(-3)
- CALL MZSTOR (IXDZDS,'/MYCOMM/',' ',IDFENC,LQ,LQ,
- + LQ,LQ(2000),LQ(NWDOCQ))
-
-* CALL MZLOGL(IXDZDS,2)
- CALL MZLINK(0,'DZDEDL',LTOP,LUP,LSUPL)
- CALL MZPAW(NWPAW,' ')
- CALL KUINIT(NWKUIP)
-* CALL KUTERM(IGTERM)
- CALL DZEDEF
- CALL DZEZER
- IQUITF=0
- CALL KUEXEC('SET/PROMPT ''DZEDIT>''')
- CALL KUEXEC('EXEC dzedit.kumac')
-
- IF(IQUITF.GT.0)GOTO 900
-
- LUNLAS=LUPLAS
- CALL KUOPEN(LUNLAS,'dzedit.las','OLD', ISTAT)
- IF(ISTAT .EQ. 0)THEN
- CALL DZDCRD(LUNLAS,CHRZF,IRC)
- IF(IRC.NE.0)GOTO 20
- CALL DZDCRD(LUNLAS,CHCARD,IRC)
- IF(IRC.NE.0)GOTO 20
- CALL DZDCRD(LUNLAS,CHFZF,IRC)
- IF(IRC.NE.0)GOTO 20
- CALL DZDCRD(LUNLAS,CTITLE,IRC)
- IF(IRC.NE.0)GOTO 20
- CALL DZDCRD(LUNLAS,CHFZFI,IRC)
- IF(IRC.NE.0)GOTO 20
-
-* READ(LUNLAS,'(A)',END=20)CHRZF
-* READ(LUNLAS,'(A)',END=20)CHCARD
-* READ(LUNLAS,'(A)',END=20)CHFZF
-* READ(LUNLAS,'(A)',END=20)CTITLE
-* READ(LUNLAS,'(A)',END=20)CHFZFI
- ENDIF
- 20 CONTINUE
- CLOSE(LUNLAS)
- LUNLAS=0
- LUNGKS=LUPGKS
- CALL KUOPEN(LUNGKS,'grapherr.lis','UNKNOWN',ISTAT)
- CALL IGINIT(NWHIGZ)
- IF(INTRAC( ))THEN
- CALL IGWKTY(IWKTYP)
- ELSE
- IWKTYP=0
- ENDIF
- IERFIL = 6
- CALL IGSSE(LUNGKS,IWKTYP)
- IF(IWKTYP .NE. 0)THEN
- CALL ISTXFP(1,0)
- IOPWKF=1
-* CALL IDAWK(1)
- ELSE
- IWKID=0
- CALL IGRNG(20.,20.)
- ENDIF
- IF(IWKID.NE.0)THEN
- LUNPLO=LUPPLO
- CALL KUOPEN(LUNPLO,'dzedit.ps','UNKNOWN',ISTAT)
- ITYPLO=-111
- CALL IOPWK(IWMETA,LUNPLO,ITYPLO)
- CALL IGRNG(20.,20.)
- ELSE
- LUNPLO=0
- ENDIF
- CALL DZEDFF
- CALL IGSA(1)
- CALL KUWHAG
-
-900 CONTINUE
- IF(LUNMET .NE. 0)CALL ICLWK(INTWST)
- IF(LUNPLO .NE. 0)CALL ICLWK(IWMETA)
- IF(LUNPLO.NE.0)THEN
- CALL KICLOS(LUNPLO,' ',ISTAT)
- CALL KUOPEN(LUNPLO,'dzedit.ps','UNKNOWN',ISTAT)
- DO 910 I=1,1000
- READ(LUNPLO,'(A)',END=920)CSCRAT
- IF(INDEX(CSCRAT,' Zone').NE.0)THEN
- CALL KICLOS(LUNPLO,' ',ISTAT)
- GOTO 930
- ENDIF
-910 CONTINUE
-920 CALL KICLOS(LUNPLO,'DELETE',ISTAT)
-930 CONTINUE
- ENDIF
- IF(LUNGKS.NE.0)THEN
- CALL KUOPEN(LUNGKS,'grapherr.lis','UNKNOWN',ISTAT)
- CALL KICLOS(LUNGKS,'DELETE',ISTAT)
- ENDIF
- IF(LUNSGM .GT. 0)CALL DZEWEM(LUNSGM)
- IF(ISGMOP .NE. 0)THEN
- IF(LUNLST .GT. 0)CALL DZEWEM(LUNLST)
- ENDIF
- IF(IPOSTF.NE.0)THEN
- IF(ILSTOP.EQ.0)THEN
- LUNLIS=LUPLIS
- CALL KUOPEN(LUNLIS,CHLIST,'UNKNOWN',ISTAT)
- ELSE
- REWIND(LUNLIS)
- ENDIF
- REWIND(LUNSC1)
- CALL DZESGP(LUNSC1,0,LUNLIS,0)
- ENDIF
- LUNLAS=LUPLAS
- CALL KUOPEN(LUNLAS,'dzedit.las','UNKNOWN',ISTAT)
- WRITE(LUNLAS,'(A)')CHRZF
- WRITE(LUNLAS,'(A)')CHCARD
- WRITE(LUNLAS,'(A)')CHFZF
- WRITE(LUNLAS,'(A)')CTITLE
- WRITE(LUNLAS,'(A)')CHFZFI
- CALL RZCDIR('//RZDOC',' ')
- IF(IRWRZF.GT.1)CALL RZFREE('rzfile')
- CALL RZCLOS(' ','A')
- STOP 'DZEDIT: Normal exit'
- END
-*********************************************************************
diff --git a/src/graflib/dzdoc/dzedit/dzedit.com b/src/graflib/dzdoc/dzedit/dzedit.com
deleted file mode 100644
index b762eda..0000000
--- a/src/graflib/dzdoc/dzedit/dzedit.com
+++ /dev/null
@@ -1,110 +0,0 @@
-$! ***************************************************************
-$! * *
-$! * DZEDIT.COM v1.03 *
-$! * *
-$! * User Interface to DZEDIT *
-$! * Author: M.Marquina 92/02/11 *
-$! * *
-$! * Mods Date Comments *
-$! * MARQUINA 93/12/02 Add /DISPLAY, fix /TCPIP *
-$! * MARQUINA 93/10/25 New location of GKS-based modules *
-$! * MARQUINA 92/07/22 There is no TCP/IP version *
-$! * *
-$! ***************************************************************
-$ SAY :== WRITE/SYMBOL SYS$OUTPUT
-$ blk=" "
-$ ver="PRO"
-$ If F$TYPE(CERN_LEVEL).nes."" Then ver =CERN_LEVEL
-$! --- Find out if GKS is available to choose correct default driver
-$ RDIR =F$TRNLNM("CERN",,0)
-$ gkslib=RDIR-"]"+"gks."+ver+".lib]gks.olb"
-$ drv="GKS"
-$ If F$SEARCH(gkslib).eqs."" Then drv="X11"
-$
-$ popt=" "
-$ do =" "
-$
-$ SHNAME=F$ENVIRONMENT("PROCEDURE")
-$ SHDIR=F$PARSE(SHNAME,,,"DEVICE")+F$PARSE(SHNAME,,,"DIRECTORY")
-$
-$ If F$SEARCH("''SHDIR'F$TCPIP.COM").eqs.""
-$ Then Say "You need the new function F$TCPIP.COM from CERN"
-$ Exit
-$ Endif
-$ @'SHDIR'F$TCPIP
-$ tcpvs=F$ELEMENT(0," ",TCPIP_ENV)
-$ trs =F$ELEMENT(1," ",TCPIP_ENV)
-$
-$
-$ If p2.nes.""
-$ Then no=0
-$ O_DO:
-$ no=no+1
-$ opt=F$ELEMENT(no,"/",p2)
-$ If opt.eqs."/" Then Goto O_END
-$ add=1
-$ If F$LOCATE(opt,"PRO NEW OLD").lt.11
-$ Then ver=opt
-$ add=0
-$ Endif
-$ If F$LOCATE(opt,"GKS DGKS X11").lt.12
-$ Then drv=opt
-$ add=0
-$ Endif
-$ If F$EXTRACT(0,4,opt).eqs."HOST"
-$ Then node=F$EXTRACT(5,F$LENGTH(opt)-5,opt)
-$ add=0
-$ Endif
-$ If F$EXTRACT(0,7,opt).eqs."DISPLAY"
-$ Then node=F$EXTRACT(8,F$LENGTH(opt)-8,opt)
-$ add=0
-$ Endif
-$ If opt.eqs."DECNET"
-$ Then trs="DECNET"
-$ add=0
-$ Endif
-$ If opt.eqs."TCPIP"
-$ Then add=0
-$ trs="TCPIP"
-$ Endif
-$ If opt.eqs."TEST"
-$ Then do ="Say "
-$ add=0
-$ Endif
-$ If add.eq.1 Then popt=popt+"/"+opt
-$ Goto O_DO
-$ O_END:
-$ Endif
-$ DISPLAY_ON=0
-$ If drv.eqs."X11".or.drv.eqs."PP"
-$ Then If F$TYPE(node).eqs."".and.F$TRNLNM("DECW$DISPLAY").eqs.""
-$ Then node=F$ELEMENT(3," ",TCPIP_ENV)
-$ trs =F$ELEMENT(4," ",TCPIP_ENV)
-$ Endif
-$ If F$TYPE(node).nes."" Then If node.nes."-" Then DISPLAY_ON=1
- If DISPLAY_ON Then set display/create/transport='trs'/node='node'
-$ If trs.eqs."DECNET" Then tcpvs=trs
-$ Endif
-$ tcppg=""
-$!If tcpvs.nes."DECNET".and.drv.nes."PP" Then tcppg="_"+F$EXTRACT(0,1,tcpvs)
-$
-$ pgm=RDIR-"]"+ver+"."
-$ If drv.eqs."GKS" Then pgm=pgm+"gks"
-$ pgm=pgm+"exe]dze"+drv+tcppg+".exe"
-$ If F$SEARCH(pgm).eqs.""
-$ Then Say blk
-$ Say blk,"The ",ver," version of DZEDIT-",drv,"/",tcpvs
-$ Say blk,"is not available on this system"
-$ Say blk
-$ Exit
-$ Else If ver.nes."PRO"
-$ Then Say blk
-$ Say blk,"Calling ",ver," version of DZEDIT-",drv,"/",tcpvs,"..."
-$ Say blk
-$ Endif
-$ Endif
-$ pawpgm :== "$"'pgm''popt'
-$ deassign sys$input
-$ 'do' pawpgm
-$ deletex/sym/global pawpgm
-$ Exit
diff --git a/src/graflib/dzdoc/dzedit/dzedit.script b/src/graflib/dzdoc/dzedit/dzedit.script
deleted file mode 100755
index 8e408dd..0000000
--- a/src/graflib/dzdoc/dzedit/dzedit.script
+++ /dev/null
@@ -1,46 +0,0 @@
-#!/bin/sh
-# **********************************************************************
-# * DZEDIT SHELL v1.02 *
-# * *
-# * Shell driver to the different versions of DZEDIT *
-# * *
-# * Author: M.Marquina 91/04/10 *
-# * Mods Date Commments *
-# * MARQUINA 91/08/15 Access DZEDIT-GKS directly from GKS_ROOT *
-# * 91/12/14 Correct local SUN host *
-# * *
-# **********************************************************************
-
- SHOPT="d:h:v:"
-#SEQ,GETOPTD.
- drv="X11" ; hst="0"
- [ -z "$CERN" ] && CERN="/cern"
- [ -z "$CERN_LEVEL" ] && ver="pro" || ver="$CERN_LEVEL"
-
- while [ $# -gt 0 ]
- do case $1 in
- -d) drv=$2 ; shift ;;
- -h) hst=$2 ; shift ;;
- -v) ver=$2 ; shift ;;
- --) shift ; break ;;
- *) break ;;
- esac
- shift
- done
-
- GDIR=$CERN/$ver/bin
- if [ "$drv" = "GKS" ] ; then
- [ -z "$GKS_ROOT" ] && GKS_ROOT="$CERN/gks/$ver"
- [ -z "$GKS" ] && . $CERN/gks/$ver/mgr/gksstart.sh
-# inlib $GKS_INLIB
- GDIR=$CERN/gks/$ver/bin
- fi
- if [ "$drv" = "X11" ] ; then
- DISPLAY="$hst:0" ; export DISPLAY
- fi
- if [ "$ver" != "pro" ] ; then
- echo
- echo " Calling $ver version of dzedit-$drv..."
- echo
- fi
- $GDIR/dze$drv $*
diff --git a/src/graflib/dzdoc/dzedit/dzeditcdf.cdf b/src/graflib/dzdoc/dzedit/dzeditcdf.cdf
deleted file mode 100644
index 086d273..0000000
--- a/src/graflib/dzdoc/dzedit/dzeditcdf.cdf
+++ /dev/null
@@ -1,354 +0,0 @@
-*
-* $Id: dzeditcdf.cdf,v 1.1.1.1 1996/03/04 16:13:24 mclareni Exp $
-*
-* $Log: dzeditcdf.cdf,v $
-* Revision 1.1.1.1 1996/03/04 16:13:24 mclareni
-* Dzdoc/Zebpack
-*
-*
-
->NAME DZEDEF
->MENU DZEDIT
->GUIDANCE
-Maintain the DZDOC data base
-
->COMMAND CREATEDOC
->GUIDANCE
-Create a new RZ-file from documentation card image file
->PARAMETERS
-CHCARD 'Input card image file' C
-CHRZF 'Output RZ-file' C
->ACTION DZEMRZ
-
->COMMAND UPDATEDOC
->GUIDANCE
-Update an existing RZ-file with new documentation, this command
-can also be used to put the documentation into any subdirectory
-of an existing RZ-file.
->PARAMETERS
-CHCARD 'Input card image file' C
-CHRZF 'Output RZ-file' C
-+
-CHSUBD 'Subdirectory name (blank=topdir)' C
->ACTION DZEURZ
-
->COMMAND OPENRZFILE
->GUIDANCE
-Open an existing RZ-file for later use with list/draw/export commands
-(the file will be READONLY unless the 'U'=update option is given)
->PARAMETERS
-CHRZF 'Input RZ-file' C
-+
-CHOOPT 'Option for RZFILE (U=Update)' C D='X'
->ACTION DZEOPL
-
->COMMAND CLOSERZFILE
->GUIDANCE
-Close an open RZ-file.
->ACTION DZDCLD
-
->COMMAND PURGEKEY
->GUIDANCE
-Purge cycles of all keys keeping the last NKEEP.
-If NKEEP < 0 keep just the highest cycle.
->PARAMETERS
-+
-NKEEP 'Number of cycles to be kept' I D=-1
->ACTION DZEPUR
-
->COMMAND DELETEKEY
->GUIDANCE
-Delete a key specifying BankId and UpBankId and cycle number.
- ICYCLE >= highest: delete highest cycle,
- = 0: delete lowest cycle,
- = -1, -2 : delete highest-1, -2..
-Options:
- 'C': delete all cycles
- 'K': delete all keys,
- 'S': delete all cycles smaller ICYCLE.
- (See also ZEBRA users guide: RZDELK)
->PARAMETERS
-CHBSBK 'Hollerith Id of selected bank' C
-CHBSUP 'Hollerith Id of its up-bank' C
-+
-ICYCLE 'Cycle number' I D=0
-CHDOPT 'Delete option' C D='C'
->ACTION DZEDEL
-
->COMMAND LISTDIRECTORY
->GUIDANCE
-List directory of an existing RZ-file
->PARAMETERS
-CHRZF 'Input RZ-file' C
->ACTION DZEDRZ
-
->COMMAND LISTONEBANK
->GUIDANCE
-List documentation for a selected bank or a group of banks.
-An '*' (asterix) may be used as wild card character.
-Exactly two times 4 characters are needed to define bank and up-bank.
-only the last cycle of one entry is listed regardless of its date.
-List of all cycles or selection by date of entering the RZ-file may
-also be choosen. The date is an integer of the form YYMMDD.
-List option:
- 'P' PostScript file (default: simple text file)
- 'I' use format of the bank descriptor cards
- (i.e. Input to CREATEDOC)
-
->PARAMETERS
-CHBSBK 'Hollerith Id of selected bank' C
-CHBSUP 'Hollerith Id of its up-bank' C
-+
-CHLIST 'File for listing' C D=' '
-CHLOPT 'List option: P=PostScript, I=Input' C D=' '
-CHOYNO 'List all cycles ' C D='NO' R='NO,YES'
-IDATCH 'List only after date' I D=0
->ACTION DZELSG
-
->COMMAND LISTALL
->GUIDANCE
-List documentation for all banks
-List option:
- 'P' PostScript file (default: simple text file)
- 'I' use format of the bank descriptor cards
- (i.e. Input to CREATEDOC)
->PARAMETERS
-+
-CHLIST 'File for listing' C D=' '
-CHLOPT 'List option: P=PostScript, I=Input' C D=' '
-CHOYNO 'List all cycles ' C D='NO' R='NO,YES'
-IDATCH 'List only after date' I D=0
->ACTION DZELAL
-
->COMMAND HTML
->GUIDANCE
-List documentation in HTML format to be used by WWW.
-Use wildcard '****' 'NONE' as Bankid / Upid to get all banks done.
-List option:
- '1' put all into 1 single file, default is 1 file/bank
-
->PARAMETERS
-CHBSBK 'Hollerith Id of selected bank' C
-CHBSUP 'Hollerith Id of its up-bank' C
-+
-CHOPT 'Option: 1 = 1 single file' C D=' '
->ACTION DZEHTM
-
->COMMAND DRAWONETREE
->GUIDANCE
-Draw tree below a selected bank. All banks belonging to the
-tree will be actually lifted in memory each with three data
-words. Word 1, 2, 3 are the number of data words, links and
-structural links as described in the documentation, a -1 indicates
-a variable number. A global title may be given which appears
-on the front page of the document.
-Output option:
- 'P' PostScript file (default)
- 'Q' quiet i.e. generate no output files
- 'C' check consistency
- 'M' Put as many down banks as posibble on one picture
- (Per default 2nd level are only drawn if all fit)
-
->PARAMETERS
-CHBSBK 'Hollerith Id of selected bank' C
-CHBSUP 'Hollerith Id of its up-bank' C
-+
-CHMETA 'Name of temp plot file' C D=' '
-CHSGML 'Name of temp text-file' C D=' '
-CHPOST 'Name of PostScript file' C D=' '
-CHOPT 'Option (P=PostScript) ' C D=' '
-CTITLE 'Global title' C D='ZEBRA-Datastructures'
->ACTION DZEDRW
-
->COMMAND DRAWALL
->GUIDANCE
-Draw tree below all top banks (i.e. banks having 'NONE' as
-Up-bank. This also checks the consistency and completeness
-of the documentation if option 'N' is not given.
-Output option:
- 'P' or ' ' PostScript file
- 'Q' no output (check only)
- 'S' suppress confirmation
- 'M' Put as many down banks as posibble on one picture
- (Per default 2nd level are only drawn if all fit)
->PARAMETERS
-+
-CHMETA 'Name of temp plot file' C D=' '
-CHSGML 'Name of temp text-file' C D=' '
-CHPOST 'Name of PostScript file' C D=' '
-CHOPT 'Output:P=PostScript, N nocheck) ' C D=' '
-CTITLE 'Global title' C D='ZEBRA-Datastructures'
->ACTION DZEDRA
-
->COMMAND DZDISP
->GUIDANCE
-Display the last generated tree if graphics is available. Note
-that the number of data words is three for each bank. Their
-contents indicates the documented number of data words and links.
-Use option C to get colored display.
->PARAMETERS
-+
-CHOPT 'Options: C = use Color' C D=' '
->ACTION DZEDSP
-
->COMMAND DZDDIV
->GUIDANCE
-Call DZDDIV
->PARAMETERS
-+
-CHOPT 'Options: C = use Color' C D=' '
->ACTION DZEDSP
-
->COMMAND DZDIRZ
->GUIDANCE
-Call DZDIRZ, display RZ-directory tree
->PARAMETERS
-+
-CHOPT 'Options: C = use Color' C D=' '
->ACTION DZEDSP
-
-
->COMMAND DZEQUIT
->GUIDANCE
-Set flag to quit when returning from exec dzedit.kumac
->ACTION DZEQIT
-
->MENU MAKECODE
->GUIDANCE
-Generate PATCHY KEEP sequences containing FORTRAN code. With option
-'S' only the selected bank is treated, with option 'T' all banks
-in the selected tree are treated. The KEEP sequences are named
-with the hollerith Ids of the bank(trees) prefixed by mnemonics
-like BOOK, LKOFF, DAOFF etc.
-
->COMMAND DATAOFFSETS
->GUIDANCE
-Generate sequences of data word offsets for a selected bank (Option 'S')
-or bank tree (Option 'T'). The names may optionally concatenated with
-a max 8 character mnemonic like 'DO_'
-With option 'Z' CHPFIX is appended, prefixed otherwise.
-
-Option 'p' makes PARAMETER statements with offsets.
-
-Option 'N' suppresses PARAMETER statements.
-
-'2' allows to skip the first 2 char in data word name. (Allowed 1-9)
-Option '=' (with '1')produces: IDATA4(I)=IQ(NOFF+4),
-the sequence: '(I)=IQ(NOFF+' may be replaced by CHPFIX
-
-Option 'C' produces COMMON/COBKID/...
-
-Option 'H' produces CALL HBNAME(...
-
-Example: a data word documented like this:
- *B.4 IDATA4 This is the 4th data word
- would produce (when putting CHPFIX to 'DO_':
- INTEGER DO_IDATA4
- PARAMETER (DO_IDATA4=4)
-
->PARAMETERS
-CHBSBK 'Hollerith Id of selected bank' C
-CHBSUP 'Hollerith Id of its up-bank' C
-+
-CHLIST 'File for listing' C D=' '
-CHPFIX 'Prefix for data offset' C D=' '
-CHOPTD 'Option, S single bank' C D='Tp'
-IFW 'First word' I D=1
-ILW 'Last word' I D=1000
->ACTION DZEDOF
-
->COMMAND LINKOFFSETS
->GUIDANCE
-Generate sequences of link offsets for a selected bank (Option 'S')
-or tree (Option 'T').
-Exactly two times 4 characters are needed to define bank and up-bank.
-The variable generated is named CHPFIX concatenated with the
-bank Id.
-Example: if a link to bank IDBK is described like this:
- *B.LINK
- ...
- *B.7 IDBK Bank containing anything
- would produce:
- INTEGER LOIDBK
- PARAMETER (LOIDBK=7)
->PARAMETERS
-CHBSBK 'Hollerith Id of selected bank' C
-CHBSUP 'Hollerith Id of its up-bank' C
-+
-CHLIST 'File for listing' C D=' '
-CHPFIX 'Prefix to BankId' C D='LO'
-CHOPTL 'Option, S single bank' C D='T'
->ACTION DZELOF
-
->COMMAND LINKASSIGNMENT
->GUIDANCE
-Generate sequences of link assignment statements for selected
-bank (Option 'S') or tree (option 'T').
-Exactly two times 4 characters are needed to define bank and up-bank.
-The assumed linkoffset is named CHPFIX concatenated with the
-bank Id.
-Example: if a link to bank IDBK with Up-bank IDUP is described like:
- *B.UP IDUP
- *B.LINK
- ...
- *B.7 IDBK Bank containing anything
- would produce:
- INTEGER LOIDBK
-
- LOIDBK=LQ(LOIDUP-7)
-
->PARAMETERS
-CHBSBK 'Hollerith Id of selected bank' C
-CHBSUP 'Hollerith Id of its up-bank' C
-+
-CHLIST 'File for listing' C D=' '
-CHPFIX 'Prefix to BankId' C D='LO'
-CHOPTL 'Option, S single bank' C D='T'
->ACTION DZELAS
-
->COMMAND BOOK
-
->GUIDANCE
-Generate code to book a bank (Option 'S') or bank tree (Option 'T').
-With option 'B' (default) calls to MZBOOK are generated, with 'L'
-calls to MZLIFT. For MZLIFT the bank parameters are put into arrays
-MMIDBK which go into an own KEEP sequence.
-The link to the bank 'BANK' is named LBANK, the uplink is assumed LUPBK,
-if the up-bank is called UPBK.
-For LBANK the declaration "INTEGER LBANK" is generated, for LUPBK it
-is assumed to be done already. A call to MZFORM is generated if not
-all data words are of the same type.
-The link offset (JBIAS) is taken from the card *B.UP UPBK -JBIAS, if
-JBIAS is given. If it is not given it is searched for in the
-documentation of the Up-bank. If UPBK is "NONE" it is set to +1.
-The following defaults are taken if the corresponding parameter is
-not explicitly documented:
- IXDIV: 0 (i.e. div 2 in store 0)
- JBIAS: no default
- NL: 0
- NS: 0
- ND: 0
- IOChar: no default, except if ND=0
- NZERO: 0
->PARAMETERS
-CHBSBK 'Hollerith Id of selected bank' C
-CHBSUP 'Hollerith Id of its up-bank' C
-+
-CHLIST 'File for listing' C D=' '
-CHOPTB 'Option, S single bank' C D='TB'
->ACTION DZEBKK
-
->COMMAND LIFT
-
->GUIDANCE
-Generate code to lift a bank (Option 'S') or bank tree (Option 'T').
-With option 'L' (default) calls to MZLIFT are generated, with 'B'
-calls to MZBOOK. See also GUIDANCE for BOOK.
->PARAMETERS
-CHBSBK 'Hollerith Id of selected bank' C
-CHBSUP 'Hollerith Id of its up-bank' C
-+
-CHLIST 'File for listing' C D=' '
-CHOPTB 'Option, S single bank' C D='TL'
->ACTION DZEBKK
-
diff --git a/src/graflib/dzdoc/dzedit/dzeditkeep.inc b/src/graflib/dzdoc/dzedit/dzeditkeep.inc
deleted file mode 100644
index 7142a14..0000000
--- a/src/graflib/dzdoc/dzedit/dzeditkeep.inc
+++ /dev/null
@@ -1,63 +0,0 @@
-*
-* $Id: dzeditkeep.inc,v 1.1.1.1 1996/03/04 16:13:19 mclareni Exp $
-*
-* $Log: dzeditkeep.inc,v $
-* Revision 1.1.1.1 1996/03/04 16:13:19 mclareni
-* Dzdoc/Zebpack
-*
-*
-*
-* dzeditkeep.inc
-*
-C-- The number of words needed in the store
- PARAMETER (NWDOCQ = 400000)
- COMMON/MYCOMM/IDFENC(1),LQ(NWDOCQ)
- DIMENSION IQ(NWDOCQ-9)
- EQUIVALENCE (IQ(1),LQ(9))
-
- PARAMETER(NWKEY = 2,MAXKEY=2000)
- COMMON/DZDEDP/IWKID,ICONID,IWKTYP,ILOCNR,
- & IDATCH,ITIMCH,IXDZDS,IMODEG,
- & KEYS(NWKEY,MAXKEY),
- & MARKUP(MAXKEY),
- & INTWST,
- & IWMETA, ITYMET, IERFIL,
- & LUNOUT, LUNMET, LUNSGM, LUNLST,
- & LUNCOM, LUNLAS, LUNRZ, LUNCAR, LUNGKS, LUNLIS, LUNSCR,
- & LUNPOS, LUNPIC, LUNEXE,LUNSC1, LUNPLO, LUNFZF, LUNHTM
- & IC1000, IOPWKF, ISGMOP, ILSTOP, ISCROP, IPOSTF,
- & IRWRZF, IQUITF
-
- INTEGER LUPOUT, LUPMET, LUPSGM, LUPLST,
- &LUPCOM, LUPLAS, LUPRZ, LUPCAR, LUPGKS, LUPLIS, LUPSCR,
- &LUPPOS, LUPPIC, LUPEXE,LUPSC1, LUPPLO, LUPFZF, LUPHTM
-
- PARAMETER (LUPOUT=6, LUPMET=61, LUPSGM=62, LUPLST=63,
- &LUPCOM=64, LUPLAS=65, LUPRZ=32, LUPCAR=33, LUPGKS=68,
- &LUPLIS=69, LUPSCR=70,
- &LUPPOS=71, LUPPIC=72, LUPEXE=73,LUPSC1=74, LUPPLO=75,
- &LUPFZF=76, LUPHTM=77)
-
- CHARACTER*8 CHOPDZ, CHKEY, CHBSEL, CHDZED, CHKEYC
- CHARACTER*64 CHRZF, CHCARD, CHLIST,CHMETA,CHSGML,
- & CHCOMP, CHSUBD, CHFZF, CHPOST, CTITLE,CHFZFI
- CHARACTER*4 CTT,CHIDBK,CHIDUP, CHBSBK, CHBSUP,
- & ANYCHA, CTEMP,
- & CHLOPT
-
- COMMON/DZDEDC/ CHKEY,CHBSEL,CHDZED,CHKEYC,
- & CHRZF, CHCARD, CHLIST,CHMETA,CHSGML,
- & CHCOMP, CHSUBD, CHFZF, CHPOST, CTITLE,
- & CHOPDZ,CTT,CHIDBK,CHIDUP, CHBSBK, CHBSUP,
- & ANYCHA, CTEMP,
- & CHLOPT, CHFZFI
- LOGICAL LISTAC,LISTSG,LISTTO, LSINGL,LWILDC
- COMMON/DZDPRL/LISTAC,LISTSG,LISTTO, LWILDC,
- & LSINGL
-
- COMMON/DZDEDL/LTOP,LTAUX,LUP,LT,LD1,LD2,LSUPL
- PARAMETER (NWPAW=100000,NWKUIP=30000,NWHIGZ=30000)
- COMMON/PAWC/IXPAW,IXHBOO,IXKUIP,IXHIGZ,PAW(NWPAW)
- COMMON/QUEST/IQUEST(100)
- COMMON /ZUNIT/ IQREAD,IQPRNT,IQPR2,IQLOG,IQPNCH,IQTTIN,IQTYPE
-
diff --git a/src/graflib/dzdoc/dzedit/dzedof.F b/src/graflib/dzdoc/dzedit/dzedof.F
deleted file mode 100644
index e97da6b..0000000
--- a/src/graflib/dzdoc/dzedit/dzedof.F
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: dzedof.F,v 1.1.1.1 1996/03/04 16:13:23 mclareni Exp $
-*
-* $Log: dzedof.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:23 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZEDOF
-#include "dzeditkeep.inc"
- CHARACTER*32 CHPFIX
- CHARACTER*8 CHOPTD
-
-* make keep sequences for data offsets
-
- IF(LUNRZ.EQ.0)THEN
- WRITE(LUNOUT,*)' No RZ-file open'
- GOTO 999
- ENDIF
- CALL KUGETC(CHBSBK,NCHA)
- CALL KUGETC(CHBSUP,NCHA)
- CALL KUGETS(CHLIST,NCLIST)
- CALL KUGETC(CHPFIX,NCHA)
- CALL KUGETC(CHOPTD,NCHA)
- IPPARA=INDEX(CHOPTD,'P')
- IF(IPPARA.NE.0)CHOPTD(IPPARA:IPPARA)='p'
- CALL KUGETI(IFI)
- CALL KUGETI(ILI)
- IF(NCLIST .NE. 0)THEN
- LUNLST=LUPLST
- IF(ILSTOP .EQ. 0)THEN
- CALL KUOPEN(LUNLST,CHLIST,'UNKNOWN',ISTAT)
- ILSTOP = 1
- ENDIF
- ELSE
- LUNLST=6
- ENDIF
- CALL DZDCOD(CHBSBK//CHBSUP,'DATA',
- + 'O'//CHOPTD,CHPFIX,LUNLST,IFI,ILI)
- 999 END
diff --git a/src/graflib/dzdoc/dzedit/dzedrw.F b/src/graflib/dzdoc/dzedit/dzedrw.F
deleted file mode 100644
index d8a7358..0000000
--- a/src/graflib/dzdoc/dzedit/dzedrw.F
+++ /dev/null
@@ -1,402 +0,0 @@
-*
-* $Id: dzedrw.F,v 1.2 1997/03/14 14:20:36 mclareni Exp $
-*
-* $Log: dzedrw.F,v $
-* Revision 1.2 1997/03/14 14:20:36 mclareni
-* WNT mods
-*
-* Revision 1.1.1.1.2.1 1997/01/21 11:25:01 mclareni
-* All mods for Winnt 96a on winnt branch
-*
-* Revision 1.1.1.1 1996/03/04 16:13:22 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZEDRW
-#include "dzeditkeep.inc"
-#if defined(CERNLIB_BSLASH)
-#include "dzdoc/bslash2.inc"
-#endif
-#if !defined(CERNLIB_BSLASH)
-#include "dzdoc/bslash1.inc"
-#endif
- CHARACTER*1 COPDTR,COPDT1
- CHARACTER*4 CHOPT, UPUPID
- PARAMETER (MXWILD=50)
- CHARACTER*8 CHWILD(MXWILD)
- INTEGER IIDATE(2),IITIME(2), KEYVEC(2)
- INTEGER IOPTP,IOPTL,IOPTC, IFLAG
-
-* graphics output
-
- CALL KUGETC(CHBSBK,NCHA)
- CALL KUGETC(CHBSUP,NCHA)
- CHBSEL(1:4) = CHBSBK
- CHBSEL(5:8) = CHBSUP
- IFLAG=1
- GOTO 10
-
- ENTRY DZEDRA
-* graphics for all top banks
- CHBSEL = '****NONE'
- IFLAG=2
-
- 10 CONTINUE
- CALL KUGETS(CHMETA,NCMETA)
- CALL KUGETS(CHSGML,NCSGML)
- CALL KUGETS(CHPOST,NCPOST)
- CALL KUGETC(CHOPT,NCPYNO)
- CALL KUGETS(CTITLE,NCTITL)
- GOTO 15
-
-* HTML
-
- ENTRY DZEHTM
- CALL KUGETC(CHBSBK,NCHA)
- CALL KUGETC(CHBSUP,NCHA)
- NCMETA=0
- NCSGML=0
- NCPOST=0
- NCTITL=0
- CHBSEL(1:4) = CHBSBK
- CHBSEL(5:8) = CHBSUP
- CALL KUGETC(CHOPT,NCPYNO)
- IFLAG=3
-* GOTO 15
-
-15 CONTINUE
- CALL KUCMD ('DZEDIT',' ','SW')
- CALL KUPVAL('DRAWONETREE','CHBSBK',0,0.,CHBSBK,'D')
- CALL KUPVAL('DRAWONETREE','CHBSUP',0,0.,CHBSUP,'D')
- CALL KUPVAL('LISTONEBANK','CHBSBK',0,0.,CHBSBK,'D')
- CALL KUPVAL('LISTONEBANK','CHBSUP',0,0.,CHBSUP,'D')
- CALL KUCMD (BS,' ','SW')
-
- IF(LUNRZ.EQ.0)THEN
- WRITE(LUNOUT,*)' No RZ-file open'
- GOTO 999
- ENDIF
- IOPTP=0
- IOPTL=0
- COPDTR='0'
-* select algorithm for 2nd level down banks
- IF(INDEX(CHOPT,'M').NE.0)THEN
- COPDT1=' '
- ELSE
- COPDT1='1'
- ENDIF
- IF(INDEX(CHOPT,'Q').NE.0)THEN
- IOPTQ=1
- ELSE
- IOPTQ=0
- ENDIF
- IF(INDEX(CHOPT,'P').NE.0)THEN
- IOPTP=1
- ELSEIF(INDEX(CHOPT,'L').NE.0)THEN
- IOPTL=1
- ENDIF
- IF(IOPTP.EQ.0 .AND. IOPTL.EQ.0 .AND. IFLAG.NE.3)THEN
-* WRITE(*,*)' Will use PostScript format'
- IOPTP=1
- ENDIF
-
- IF(INDEX(CHBSEL,'*').NE.0)THEN
- NFKEY = 0
- IP = 0
- LWILDC = .TRUE.
- IF(INDEX(CHOPT,'N').EQ.0)THEN
- IOPTC=1
- ELSE
- IOPTC=0
- ENDIF
- CALL CLTOU(CHBSEL)
- 20 CALL DZDWCS(CHBSEL,KEYVEC,NFKEY)
- IF(KEYVEC(1) .NE. 0)THEN
- IP = IP+1
- CALL UHTOC(KEYVEC,4,CHWILD(IP),8)
- IF(IP .LT. MXWILD)GOTO 20
- ENDIF
- IF(IP .EQ. 0)THEN
- WRITE(*,*)' No bank found'
- GOTO 999
- ENDIF
- WRITE(*,*)' The following banks will be treated:'
- DO 30 I=1,IP
- WRITE(*,*)' ',CHWILD(I)
- 30 CONTINUE
- IF(INDEX(CHOPT,'S').EQ.0)THEN
- CALL KUPROC(' Is this ok?',ANYCHA,NCH)
- IF(ANYCHA(1:1) .NE. 'Y' .OR. NCH .LE. 0)GOTO 999
- ENDIF
- IP1 = IP
- ELSE
- LWILDC = .FALSE.
- IF(INDEX(CHOPT,'C').NE.0)THEN
- IOPTC=1
- ELSE
- IOPTC=0
- ENDIF
- ENDIF
- IP = 0
-* loop on top banks
- 40 CONTINUE
- IF(LWILDC)THEN
- IP = IP+1
-* if done, go and check the file
- IF(IP .GT. IP1) GOTO 60
- CHBSEL = CHWILD(IP)
- ENDIF
-* form the name for the output file
- IF(IOPTP .NE. 0 .AND. NCPOST .EQ. 0)THEN
- NCPOST = INDXBC(CHBSEL(1:4),' ')
- CHPOST=CHBSEL(1:NCPOST)//'.ps'
- NCPOST=NCPOST+3
- CALL CUTOL(CHPOST)
- ENDIF
-
- IF(LTOP .NE. 0)CALL MZDROP(IXDZDS,LTOP,'L')
- LTOP=0
- CALL DZDGTR(CHBSEL,'GR',LTOP)
- IF(LTOP .LE. 0)THEN
- WRITE(*,*)' Error from DZDGTR'
- IF(LTOP.EQ.0)THEN
- WRITE(*,*)' tree not found'
- ELSEIF(LTOP .EQ.-1)THEN
- WRITE(*,*)' bank has no down links'
- LTOP=0
- ENDIF
- IF(LWILDC)THEN
- GOTO 40
- ELSE
- GOTO 999
- ENDIF
- ENDIF
- ILCM = INDXBC(CHBSEL(1:4),' ')
- IF(LUNCOM.EQ.0)THEN
- LUNCOM=LUPCOM
- CALL KUOPEN(LUNCOM,CHBSEL(1:ILCM)//'.scratch',
- & 'UNKNOWN',ISTAT)
- ENDIF
- IF(LUNSGM .EQ. 0 .AND. IOPTQ.EQ.0)THEN
- ILCM = INDXBC(CHBSEL(1:4),' ')
- IF(NCMETA .EQ. 0)THEN
- IF(IOPTL.EQ.0)THEN
- CHMETA=CHBSEL(1:ILCM)//'.metaf'
- CALL CUTOL(CHMETA)
- ENDIF
- ENDIF
- IF(NCSGML .EQ. 0)THEN
- IF(IOPTL.EQ.0)THEN
- CHSGML=CHBSEL(1:ILCM)//'.sgml'
- ELSE
- CHSGML=CHBSEL(1:ILCM)//'.tex'
- ENDIF
- CALL CUTOL(CHSGML)
- ENDIF
- IF(IOPTL.EQ.0)THEN
- LUNMET=LUPMET
- CALL KUOPEN(LUNMET,CHMETA,'UNKNOWN',ISTAT)
- ENDIF
- LUNSGM=LUPSGM
- CALL KUOPEN(LUNSGM,CHSGML,'UNKNOWN',ISTAT)
- IF(IOPTL.EQ.0)THEN
- WRITE(LUNSGM,'(A)')'<!DOCTYPE SGMLGUID>'
- WRITE(LUNSGM,'(A)') '<SET TAG=FIG ITEM=FONT VALUE=TEXT>'
-
- WRITE(LUNSGM,'(A)') '<SET TAG=LISTING ITEM=FONT VALUE='
- + //'MINUTE>'
- WRITE(LUNSGM,'(A)') '<SET TAG=LISTING ITEM=PLACE VALUE=ANY>'
-
- WRITE(LUNSGM,'(A)') '<SET TAG=FIG ITEM=PLACE VALUE=INLINE>'
-
- WRITE(LUNSGM,'(A)') '<GDOC>'
- WRITE(LUNSGM,'(A)') '<TITLEP>'
- IF(NCTITL.GT.0)THEN
- WRITE(LUNSGM,'(A,A)') '<TITLE>',CTITLE
- WRITE(LUNSGM,'(A)') '<TITLE>*'
- ENDIF
- WRITE(LUNSGM,'(A)') '<TITLE>ZEBRA bank documentation'
- WRITE(LUNSGM,'(A)') '<TITLE>from '
- WRITE(LUNSGM,'(A,A)')'<TITLE>', CHRZF
- WRITE(LUNSGM,'(A)') '<TITLE> banks below: '
- ENDIF
- IF(LWILDC)THEN
- DO 50 I=1,IP1
- IF(IOPTL.EQ.0)THEN
- WRITE(LUNSGM,'(2A)')'<TITLE>',CHWILD(I)(1:4)
- ELSE
- WRITE(LUNSGM,'(2A)') BS//BS,CHWILD(I)(1:4)
- ENDIF
- 50 CONTINUE
- ELSE
- IF(IOPTL.EQ.0)THEN
- WRITE(LUNSGM,'(2A)')'<TITLE>',CHBSEL(1:4)
- ELSE
- WRITE(LUNSGM,'(2A)') BS//BS,CHBSEL(1:4)
- ENDIF
- ENDIF
- IF(IOPTP.EQ.0)THEN
- IF(IOPTL.EQ.0)THEN
- WRITE(LUNSGM,'(A)') '<AUTHOR>generated by DZEDIT - '
- + //'DZDOC'
- WRITE(LUNSGM,'(A)') '<DATE>'
- ELSE
- WRITE(LUNSGM,'(A)')
- + '} '//BS//'author {printed by DZEDIT - '
- + //'DZDOC at}'
- ENDIF
- ELSE
- CALL DATIMH(IIDATE,IITIME)
- WRITE(LUNSGM,'(A,2A4)')'<TITLE>',IIDATE
- ENDIF
- IF(IOPTL.EQ.0)THEN
- WRITE(LUNSGM,'(A)') '</TITLEP>'
- WRITE(LUNSGM,'(A)') '<BODY>'
- ELSE
- WRITE(LUNSGM,'(10(A/))')
- + BS//'maketitle',BS//'pagebreak'
- ENDIF
- ENDIF
- LD1 = LTOP
-
-* deactivate screen
-
- IF(IWKID.NE.0 .AND. IOPWKF .NE.0)THEN
- CALL IDAWK(IWKID)
- ENDIF
- CALL DZDDTR(0,LTOP,LUNSGM,LUNCOM,LUNMET,
- + INTWST,ITYMET,COPDT1//'PRT')
- LTOP = LD1
- CALL MZGARB(2,0)
-
-* activate screen again
- IF(IWKID.NE.0 .AND. IOPWKF .NE.0)THEN
- CALL IACWK(IWKID)
- ENDIF
-* if all required loop on top banks
-
- IF(LWILDC) GOTO 40
-
- 60 CONTINUE
- REWIND LUNCOM
- IF(IOPTC.NE.0)THEN
- CALL DZECHK
- ENDIF
-* output part
-
-* html
-
- IF(IFLAG.EQ.3)THEN
- LUNSGM=LUPSGM
- REWIND(LUNSGM)
- IF(INDEX(CHBSEL,'*').NE.0)THEN
- UPUPID='NONE'
- ELSE
-* find Up Bank
- NFKEY = 0
- IP = 0
- CHBSEL=CHBSEL(5:8)//'****'
- 21 CALL DZDWCS(CHBSEL,KEYVEC,NFKEY)
- IF(KEYVEC(1) .NE. 0)THEN
- IP = IP+1
- CALL UHTOC(KEYVEC,4,CHWILD(IP),8)
- IF(IP .LT. MXWILD)GOTO 21
- ENDIF
- IF(IP .EQ. 0)THEN
- UPUPID='NONE'
- ELSE IF(IP.EQ.1)THEN
- UPUPID=CHWILD(1)(5:8)
- ELSE
- WRITE(*,*)
- + 'Up bank is not unique, please make your choice'
- DO 31 I=1,IP
- 31 WRITE(*,*)' ',CHWILD(I)(5:8)
- WRITE(*,*)'Up bank?'
- READ(*,'(A4)')UPUPID
- ENDIF
- IF(INDEX(CHOPT,'1').NE.0)THEN
- IPF=1
- ELSE
- IPF=3
- ENDIF
- LUNHTM=LUPHTM
- CALL DZE2HT(LUNSGM,LUNHTM,IPF,UPUPID)
- LUNHTM=0
- ENDIF
-* open so it can be deleted later
- LUNMET=LUPMET
-* CALL KUOPEN(LUNMET,CHMETA,'UNKNOWN',ISTAT)
- GOTO 999
- ENDIF
-
- IF(IOPTQ.NE.0)GOTO 999
-
- IF(IOPTL.EQ.0)THEN
- IF(LUNMET.NE.0)CLOSE(LUNMET)
- LUNMET = 0
- ELSE
- REWIND LUNCOM
- CALL DZELIN(LUNCOM,LUNSGM)
- WRITE(LUNSGM,'(A)')BS//'end{document}'
- CLOSE(LUNSGM)
- LUNSGM=0
- WRITE(*,'(A,A)')' LaTeX output on: ',CHSGML
- GOTO 999
- ENDIF
- CALL DZEWEM(LUNSGM)
- CLOSE(LUNSGM)
- LUNSGM=0
- IF(IOPTP .NE. 0)THEN
- LUNPOS=LUPPOS
- CALL KUOPEN(LUNPOS,CHPOST,'UNKNOWN',ISTAT)
- LUNMET=LUPMET
- CALL KUOPEN(LUNMET,CHMETA,'OLD',ISTAT)
- LUNSGM=LUPSGM
- CALL KUOPEN(LUNSGM,CHSGML,'OLD',ISTAT)
- CALL DZESGP(LUNSGM,LUNMET,LUNPOS, 0)
-* open it again R/W, otherwise IBM cant DELETE it
- CLOSE(LUNSGM)
- CLOSE(LUNMET)
- IF(INDEX(CHOPT,'K').EQ.0)THEN
- CALL KUOPEN(LUNSGM,CHSGML,'UNKNOWN',ISTAT)
- CALL KUOPEN(LUNMET,CHMETA,'UNKNOWN',ISTAT)
- ELSE
- LUNSGM=0
- LUNMET=0
- ENDIF
- CLOSE(LUNPOS)
- LUNPOS=0
- WRITE(*,'(A,A)')' PostScript output on: ',CHPOST
- ENDIF
-999 CONTINUE
- IF(LUNCOM.NE.0)THEN
- IF(INDEX(CHOPT,'K').EQ.0)THEN
- CALL KICLOS(LUNCOM,'DELETE',ISTAT)
- ELSE
- CALL KICLOS(LUNCOM,' ',ISTAT)
- ENDIF
- LUNCOM=0
- ENDIF
- IF(LUNSGM.NE.0)THEN
- IF(INDEX(CHOPT,'K').EQ.0)THEN
- CALL KICLOS(LUNSGM,'DELETE',ISTAT)
- ENDIF
- LUNSGM=0
- ENDIF
- IF(LUNPIC.NE.0)THEN
- IF(INDEX(CHOPT,'K').EQ.0)THEN
- CALL KICLOS(LUNPIC,'DELETE',ISTAT)
- ELSE
- CALL KICLOS(LUNPIC,' ',ISTAT)
- ENDIF
- LUNPIC=0
- ENDIF
- IF(LUNMET.NE.0)THEN
- IF(INDEX(CHOPT,'K').EQ.0)THEN
- CALL KICLOS(LUNMET,'DELETE',ISTAT)
- ENDIF
- LUNMET=0
- ENDIF
- CALL DZDPLN(0,' ',0)
- END
diff --git a/src/graflib/dzdoc/dzedit/dzedrz.F b/src/graflib/dzdoc/dzedit/dzedrz.F
deleted file mode 100644
index c446c62..0000000
--- a/src/graflib/dzdoc/dzedit/dzedrz.F
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: dzedrz.F,v 1.1.1.1 1996/03/04 16:13:21 mclareni Exp $
-*
-* $Log: dzedrz.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:21 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZEDRZ
-
-* list directory of RZ-file
-#include "dzeditkeep.inc"
-
- IF(LUNRZ.EQ.0)THEN
- WRITE(LUNOUT,*)' No RZ-file open'
- ELSE
- CALL RZLDIR(' ',' ')
- ENDIF
- CONTINUE
- END
-
-***********************************************************************
-
diff --git a/src/graflib/dzdoc/dzedit/dzedsp.F b/src/graflib/dzdoc/dzedit/dzedsp.F
deleted file mode 100644
index b52d429..0000000
--- a/src/graflib/dzdoc/dzedit/dzedsp.F
+++ /dev/null
@@ -1,48 +0,0 @@
-*
-* $Id: dzedsp.F,v 1.1.1.1 1996/03/04 16:13:23 mclareni Exp $
-*
-* $Log: dzedsp.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:23 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZEDSP
-* call DZDDIV or DZDISP
-#include "dzeditkeep.inc"
- CHARACTER*32 CHCMD
- CHARACTER*4 CDZDOP,COCMD
-
- IF(IWKTYP .LE. 0)THEN
- WRITE(LUNOUT,*)' No graphics available, sorry'
- GOTO 999
- ENDIF
- CALL KUPATL(CHCMD,NPAR)
- CALL KUGETC(COCMD,NCH)
- IF(INDEX(COCMD,'C').NE.0)THEN
- CDZDOP='CMNI'
- ELSE
- CDZDOP='MNI'
- ENDIF
- IF(IXHIGZ.EQ.0)THEN
- IF(IOPWKF .EQ. 0)THEN
- CALL IOPWK(IWKID,ICONID,IWKTYP)
- CALL ISTXFP(1,0)
- IOPWKF = 1
- ENDIF
- ENDIF
- IF(CHCMD.EQ.'DZDISP')THEN
- IF(LTOP.EQ.0)GOTO 999
- CALL ISTXFP(6,0)
- CALL DZDISP(IXDZDS,LTOP,CHDZED,CDZDOP, IWKID,IWMETA,ILOCNR,
- + IWKTYP)
- ELSEIF(CHCMD.EQ.'DZDIRZ')THEN
- CALL DZDIRZ(IXDZDS,LTOP,1,CHDZED,CDZDOP, IWKID,
- + IWMETA,ILOCNR)
- ELSE
- CALL ISTXFP(6,0)
- CALL DZDDIV(IXDZDS,LTOP,CHDZED,CDZDOP, IWKID,IWMETA,ILOCNR,
- + IWKTYP)
- ENDIF
- CALL IGTERM
- 999 END
diff --git a/src/graflib/dzdoc/dzedit/dzehpe.F b/src/graflib/dzdoc/dzedit/dzehpe.F
deleted file mode 100644
index 961de6c..0000000
--- a/src/graflib/dzdoc/dzedit/dzehpe.F
+++ /dev/null
@@ -1,36 +0,0 @@
-*
-* $Id: dzehpe.F,v 1.1.1.1 1996/03/04 16:13:24 mclareni Exp $
-*
-* $Log: dzehpe.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:24 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZEHPE(LUN)
- WRITE(LUN,'(9(A/),A)')
- & '%!PS-Adobe-2.0'
- &,'%! DZEDIT/PostScript Metafile'
- &,'/d {lineto} def /m {moveto} def /t {translate} def'
- &,'/sw {stringwidth} def /r {rotate} def /rl {roll} def'
- &,'/rd {rlineto} def /rm {rmoveto} def /gr {grestore} def'
- &,'/lw {setlinewidth} def /sd {setdash} def'
- &,'/s {stroke} def /rgb {setrgbcolor} def'
- &,'/cl {closepath} def /sf {scalefont setfont} def'
- &,'/oshow {gsave [] 0 sd true charpath stroke gr} def'
- &,'/cs {gsave dup sw pop 2 div neg 5 -1 rl 5 -1 rl t 3 -1'
- &,' rl r 0 m show gr} def'
- WRITE(LUN,'(8(A/),A)')
- & '/rs {gsave dup sw pop neg 5 -1 rl 5 -1 rl t 3 -1 rl r'
- &,' 0 m show gr} def'
- &,'/ocs {gsave dup sw pop 2 div neg 5 -1 rl 5 -1 rl t 3 -1'
- &,' rl r 0 m oshow gr} def'
- &,'/ors {gsave dup sw pop neg 5 -1 rl 5 -1 rl t 3 -1 rl r'
- &,' 0 m oshow gr} def'
- &,'/H /Helvetica-Bold findfont def'
- &,'/C /Courier findfont def'
- &,'/n {newpath} def'
- &,'/sh {show} def'
- &,'/sg {setgray} def'
- END
-****************************************************************
diff --git a/src/graflib/dzdoc/dzedit/dzeindex.inc b/src/graflib/dzdoc/dzedit/dzeindex.inc
deleted file mode 100644
index 37f3729..0000000
--- a/src/graflib/dzdoc/dzedit/dzeindex.inc
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: dzeindex.inc,v 1.1.1.1 1996/03/04 16:13:19 mclareni Exp $
-*
-* $Log: dzeindex.inc,v $
-* Revision 1.1.1.1 1996/03/04 16:13:19 mclareni
-* Dzdoc/Zebpack
-*
-*
-*
-* dzeindex.inc
-*
- PARAMETER (MAXBNK=2000)
- CHARACTER*4 CINDEX(MAXBNK)
- COMMON/DZEIDC/CINDEX
- INTEGER IORD(MAXBNK),IPINDX(MAXBNK)
- COMMON/DZEIDI/IORD,IPINDX
-
diff --git a/src/graflib/dzdoc/dzedit/dzelal.F b/src/graflib/dzdoc/dzedit/dzelal.F
deleted file mode 100644
index 3ae8dc1..0000000
--- a/src/graflib/dzdoc/dzedit/dzelal.F
+++ /dev/null
@@ -1,139 +0,0 @@
-*
-* $Id: dzelal.F,v 1.1.1.1 1996/03/04 16:13:22 mclareni Exp $
-*
-* $Log: dzelal.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:22 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZELAL
-#include "dzeditkeep.inc"
-#if defined(CERNLIB_BSLASH)
-#include "dzdoc/bslash2.inc"
-#endif
-#if !defined(CERNLIB_BSLASH)
-#include "dzdoc/bslash1.inc"
-#endif
- CHARACTER*4 CKEY1,CKEY2, CHOYNO
-
- LSINGL=.FALSE.
- GOTO 10
-
- ENTRY DZELSG
- LSINGL = .TRUE.
- CALL KUGETC(CHBSBK,NCHA)
- CALL KUGETC(CHBSUP,NCHA1)
-
- 10 CONTINUE
- IF(LUNRZ.EQ.0)THEN
- WRITE(LUNOUT,*)' No RZ-file open'
- GOTO 999
- ENDIF
- CALL KUGETS(CHLIST,NCLIST)
- CALL KUGETC(CHLOPT,NCLOPT)
- CALL KUGETC(CHOYNO,NCOYNO)
-
- IF(INDEX(CHLOPT,'P').NE.0 .OR. INDEX(CHLOPT,'H').NE.0)THEN
- IF(ISCROP .EQ. 0)THEN
- LUNSC1=LUPSC1
- CALL KUOPEN(LUNSC1,'dzedit.scrat1','UNKNOWN',ISTAT)
- LUNLST = LUNSC1
- ISCROP = 1
- ENDIF
- IF(INDEX(CHLOPT,'P').NE.0)THEN
- IPOSTF = 1
- IF(NCLIST.LE.0)THEN
- IF(LSINGL)THEN
- CHLIST=CHBSBK(1:NCHA)//'_'//CHBSBK(1:NCHA)//'.ps'
- ELSE
- CHLIST='DZEDIT_LIST.ps'
- ENDIF
- ENDIF
- ENDIF
- ELSE
- IF(NCLIST .NE. 0)THEN
- LUNLST=LUPLST
- IF(ILSTOP .EQ. 0)THEN
- CALL KUOPEN(LUNLST,CHLIST,'UNKNOWN',ISTAT)
- ILSTOP = 1
- ENDIF
- ELSE
- LUNLST=6
- ENDIF
- ENDIF
- IF(INDEX(CHLOPT,'S').NE.0
- + .OR. IPOSTF.NE.0
- + .AND. ISGMOP.EQ.0)THEN
- ISGMOP = 1
- WRITE(LUNLST,'(A)')'<!DOCTYPE SGMLGUID>'
- WRITE(LUNLST,'(A)')'<SET TAG=H1 ITEM=NAME VALUE="BankId">'
- WRITE(LUNLST,'(A)')'<GDOC>'
- WRITE(LUNLST,'(A)')'<TITLEP>'
- WRITE(LUNLST,'(A)')'<TITLE>ZEBRA BANK DOCUMENTATION'
- WRITE(LUNLST,'(A)')'<TITLE> FROM '
- WRITE(LUNLST,'(A)')'<TITLE>'//CHRZF
- WRITE(LUNLST,'(A)')'<DATE>'
- WRITE(LUNLST,'(A)')'</TITLEP>'
- WRITE(LUNLST,'(A)')'<BODY>'
- ENDIF
-
-* IQPRNT = LUNLST
- CHBSEL(1:4) = CHBSBK
- CHBSEL(5:8) = CHBSUP
- CHOPDZ = 'R'
- IF(INDEX(CHLOPT,'S').NE.0 .OR. IPOSTF.NE.0) CHOPDZ(3:3) = 'S'
- IF(CHOYNO(1:1).EQ. 'Y') CHOPDZ(4:4) = 'O'
- IF(INDEX(CHLOPT,'I').NE.0)CHOPDZ(5:5) = 'I'
- CALL KUCMD ('DZEDIT',' ','SW')
- CALL KUPVAL('DRAWONETREE','CHBSBK',0,0.,CHBSBK,'D')
- CALL KUPVAL('DRAWONETREE','CHBSUP',0,0.,CHBSUP,'D')
- CALL KUPVAL('LISTONEBANK','CHBSBK',0,0.,CHBSBK,'D')
- CALL KUPVAL('LISTONEBANK','CHBSUP',0,0.,CHBSUP,'D')
- CALL KUCMD (BS,' ','SW')
- IF(LSINGL)THEN
- CALL DZDOCO(LUNLST,CHBSEL,CHOPDZ)
- GOTO 999
- ENDIF
- CALL RZKEYS(NWKEY,MAXKEY,KEYS,NKEYS)
- DO 5 I=1,NKEYS
- 5 MARKUP(I) = I
- II = 1000000
- CALL RZIN(IXDZDS,LSUPL,2,KEYS(1,1),II,'C')
- DO 30 I=1,NKEYS-1
- DO 20 K=I+1,NKEYS
- CALL UHTOC(KEYS(1,I),4,CKEY1,4)
- CALL UHTOC(KEYS(1,K),4,CKEY2,4)
- IF( LLE(CKEY1, CKEY2))GOTO 20
- KEYSAV = KEYS(1,I)
- KEYS(1,I) = KEYS(1,K)
- KEYS(1,K) = KEYSAV
- KEYSAV = KEYS(2,I)
- KEYS(2,I) = KEYS(2,K)
- KEYS(2,K) = KEYSAV
- KEYSAV = MARKUP(I)
- MARKUP(I) = MARKUP(K)
- MARKUP(K) = KEYSAV
-
- 20 CONTINUE
- 30 CONTINUE
- IF(LISTSG) CHOPDZ(3:3) = 'S'
- DO 40 I=1,NKEYS
- IF(LSINGL .AND. MARKUP(I) .EQ. 0)GOTO 40
- IF(IDATCH .GT. 0 .OR. ITIMCH .GT. 0)THEN
- II = 1000000
- CALL RZIN(IXDZDS,LSUPL,2,KEYS(1,I),II,'C')
- IF(IQUEST(50) .LE. 0)GOTO 40
- CALL RZDATE(IQUEST(71),IDATE,ITIME,1)
- IF(IDATCH .GT. 0 .AND. IDATE .LT. IDATCH)GOTO 40
- IF(ITIMCH .GT. 0 .AND. ITIME .LT. ITIMCH)GOTO 40
- ENDIF
- CALL UHTOC(KEYS(1,I),4,CHKEY(1:4),4)
- CALL UHTOC(KEYS(2,I),4,CHKEY(5:8),4)
- IF(INDEX(CHLOPT,'I').NE.0)WRITE(LUNLST,'(A,A,A,A)')
- & '******************************************* ',
- & CHKEY(1:4),' / ',CHKEY(5:8)
- CALL DZDOCO(LUNLST,CHKEY,CHOPDZ)
- 40 CONTINUE
- 999 END
-***********************************************************************
diff --git a/src/graflib/dzdoc/dzedit/dzelas.F b/src/graflib/dzdoc/dzedit/dzelas.F
deleted file mode 100644
index 813e752..0000000
--- a/src/graflib/dzdoc/dzedit/dzelas.F
+++ /dev/null
@@ -1,36 +0,0 @@
-*
-* $Id: dzelas.F,v 1.1.1.1 1996/03/04 16:13:22 mclareni Exp $
-*
-* $Log: dzelas.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:22 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZELAS
-#include "dzeditkeep.inc"
- CHARACTER*32 CHPFIX
- CHARACTER*4 CHOPTL
-
-* make keep sequences for link assignments
-
- IF(LUNRZ.EQ.0)THEN
- WRITE(LUNOUT,*)' No RZ-file open'
- GOTO 999
- ENDIF
- CALL KUGETC(CHBSBK,NCHA)
- CALL KUGETC(CHBSUP,NCHA)
- CALL KUGETS(CHLIST,NCLIST)
- CALL KUGETC(CHPFIX,NCHA)
- CALL KUGETC(CHOPTL,NCHA)
- IF(NCLIST .NE. 0)THEN
- LUNLST=LUPLST
- IF(ILSTOP .EQ. 0)THEN
- CALL KUOPEN(LUNLST,CHLIST,'UNKNOWN',ISTAT)
- ILSTOP = 1
- ENDIF
- ELSE
- LUNLST=6
- ENDIF
- CALL DZDCOD(CHBSBK//CHBSUP,'LINK','A'//CHOPTL,CHPFIX,LUNLST,0,0)
- 999 END
diff --git a/src/graflib/dzdoc/dzedit/dzelin.F b/src/graflib/dzdoc/dzedit/dzelin.F
deleted file mode 100644
index 3ce2c06..0000000
--- a/src/graflib/dzdoc/dzedit/dzelin.F
+++ /dev/null
@@ -1,45 +0,0 @@
-*
-* $Id: dzelin.F,v 1.1.1.1 1996/03/04 16:13:22 mclareni Exp $
-*
-* $Log: dzelin.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:22 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZELIN(LUNIND,LO)
-#include "dzeindex.inc"
-#if defined(CERNLIB_BSLASH)
-#include "dzdoc/bslash2.inc"
-#endif
-#if !defined(CERNLIB_BSLASH)
-#include "dzdoc/bslash1.inc"
-#endif
- NIND=0
- DO 10 I=1,MAXBNK
- CALL DZDCRD(LUNIND,CINDEX(I),IRC)
- IF(IRC.NE.0)GOTO 20
-* READ(LUNIND,'(A4)',END=20)CINDEX(I)
- IORD(I)=I
-10 NIND=NIND+1
- WRITE(*,*)'More than ',MAXBNK,' banks, cant make index'
- GOTO 100
-20 CONTINUE
- IF(NIND .LE. 0)GOTO 100
- DO 30 I=1,NIND-1
- DO 30 K=I+1,NIND
- I1 = IORD(I)
- K1 = IORD(K)
- IF(LLE(CINDEX(I1),CINDEX(K1)))GOTO 30
- IORD(K) = I1
- IORD(I) = K1
- 30 CONTINUE
- WRITE(LO,'(A)')BS//'twocolumn[Index]'
- DO 40 I=1,NIND
- WRITE(LO,'(A,A,A,I4.4,A)')BS//'parbox{4cm}{',CINDEX(IORD(I)),
- & ' '//BS//'dotfill '//BS//'pageref{',IORD(i),'}}'//BS//BS
-40 CONTINUE
-100 CONTINUE
- RETURN
- END
-
diff --git a/src/graflib/dzdoc/dzedit/dzelof.F b/src/graflib/dzdoc/dzedit/dzelof.F
deleted file mode 100644
index 0efb57f..0000000
--- a/src/graflib/dzdoc/dzedit/dzelof.F
+++ /dev/null
@@ -1,36 +0,0 @@
-*
-* $Id: dzelof.F,v 1.1.1.1 1996/03/04 16:13:22 mclareni Exp $
-*
-* $Log: dzelof.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:22 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZELOF
-#include "dzeditkeep.inc"
- CHARACTER*32 CHPFIX
- CHARACTER*8 CHOPTL
-
-* make keep sequences for lin offets
-
- IF(LUNRZ.EQ.0)THEN
- WRITE(LUNOUT,*)' No RZ-file open'
- GOTO 999
- ENDIF
- CALL KUGETC(CHBSBK,NCHA)
- CALL KUGETC(CHBSUP,NCHA)
- CALL KUGETS(CHLIST,NCLIST)
- CALL KUGETC(CHPFIX,NCPFIX)
- CALL KUGETC(CHOPTL,NCOPT)
- IF(NCLIST .NE. 0)THEN
- LUNLST=LUPLST
- IF(ILSTOP .EQ. 0)THEN
- CALL KUOPEN(LUNLST,CHLIST,'UNKNOWN',ISTAT)
- ILSTOP = 1
- ENDIF
- ELSE
- LUNLST=6
- ENDIF
- CALL DZDCOD(CHBSBK//CHBSUP,'LINK','O'//CHOPTL,CHPFIX,LUNLST,0,0)
- 999 END
diff --git a/src/graflib/dzdoc/dzedit/dzemrz.F b/src/graflib/dzdoc/dzedit/dzemrz.F
deleted file mode 100644
index bf92846..0000000
--- a/src/graflib/dzdoc/dzedit/dzemrz.F
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: dzemrz.F,v 1.1.1.1 1996/03/04 16:13:21 mclareni Exp $
-*
-* $Log: dzemrz.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:21 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZEMRZ
-
-C-- Make a new RZ file
-
-#include "dzeditkeep.inc"
-#if defined(CERNLIB_BSLASH)
-#include "dzdoc/bslash2.inc"
-#endif
-#if !defined(CERNLIB_BSLASH)
-#include "dzdoc/bslash1.inc"
-#endif
-* open files
-
- CALL KUGETS(CHCARD,NCHA)
- CALL KUGETS(CHRZF,NCHA)
- CALL KUCMD('DZEDIT',' ','SW')
- CALL KUPVAL('LISTDIRECTORY','CHRZF',0,0.,CHRZF,'D')
- CALL KUPVAL('OPENRZFILE','CHRZF',0,0.,CHRZF,'D')
- CALL KUCMD (BS,' ','SW')
- CALL DZDMRZ(LUPCAR,LUPRZ,CHCARD,CHRZF,CHSUBD,IRET)
- IF(IRET.EQ.0)LUNRZ=LUPRZ
- END
-*************************************************************
diff --git a/src/graflib/dzdoc/dzedit/dzenpg.F b/src/graflib/dzdoc/dzedit/dzenpg.F
deleted file mode 100644
index c2ddc6d..0000000
--- a/src/graflib/dzdoc/dzedit/dzenpg.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: dzenpg.F,v 1.1.1.1 1996/03/04 16:13:24 mclareni Exp $
-*
-* $Log: dzenpg.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:24 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZENPG(IPAGE)
-#include "dzesgpkeep.inc"
- CHARACTER*28 CCINT
- IPAGE = IPAGE + 1
- WRITE(CCINT,'(A,2I5)')'%%Page:',IPAGE,IPAGE
- CALL DZDPLN(LUOUT,'/saveobj save def',-3)
- CALL DZDPLN(LUOUT,CCINT,-3)
- WRITE(CCINT,'(2F8.5,A)')SCALE,SCALE,' scale'
- CALL DZDPLN(LUOUT,CCINT,-3)
- CALL DZDPLN(LUOUT,' [] 0 setdash',-1)
- CALL DZDPLN(LUOUT,' 1 setlinewidth',-1)
- CALL DZDPLN(LUOUT,'H 40 sf',-1)
- WRITE(CCINT,'(2I5,A,I5,A)')IXPAGE/2,MARGB -2*ISPACE,
- & ' 0 (-',IPAGE,'-) cs'
- CALL DZDPLN(LUOUT,CCINT,-3)
- WRITE(CCINT,'(A,I5,A)')'C ',ICSIZE,' sf'
- CALL DZDPLN(LUOUT,CCINT,-3)
- END
-****************************************************************
diff --git a/src/graflib/dzdoc/dzedit/dzeop1.F b/src/graflib/dzdoc/dzedit/dzeop1.F
deleted file mode 100644
index 35d79da..0000000
--- a/src/graflib/dzdoc/dzedit/dzeop1.F
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: dzeop1.F,v 1.1.1.1 1996/03/04 16:13:22 mclareni Exp $
-*
-* $Log: dzeop1.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:22 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZEOP1(CHOPTO,ISTAT)
- CHARACTER*(*) CHOPTO
- CHARACTER*4 CDUMMY
-* open RZ file
-#include "dzeditkeep.inc"
- IF(LUNRZ.EQ.0)THEN
- LRECL = 256
- IF(INDEX(CHOPTO,'U').EQ.0)THEN
- IRWRZF = 1
- ELSE
- IRWRZF = 2
- ENDIF
- LUNRZ=LUPRZ
- CALL RZOPEN(LUNRZ,CDUMMY,CHRZF,CHOPTO,LRECL,ISTAT)
- IF(ISTAT.NE. 0)THEN
- WRITE(*,*)'Error opening ',CHRZF
- LUNRZ=0
- GOTO 10
- ENDIF
- CALL DZDINI
- CHDZED = '//RZDOC'
- CALL RZFILE(LUNRZ,CHDZED(3:),CHOPTO)
- IF(CHSUBD .NE. ' ')THEN
- CALL RZCDIR(CHSUBD,' ')
- ENDIF
-* CALL RZLOGL(LUNRZ,2)
- ELSE
- WRITE(*,*)' ',CHRZF(1:LNBLNK(CHRZF)), ' already open '
- ENDIF
- 10 CONTINUE
- END
-***********************************************************************
diff --git a/src/graflib/dzdoc/dzedit/dzeopl.F b/src/graflib/dzdoc/dzedit/dzeopl.F
deleted file mode 100644
index 2a23fd4..0000000
--- a/src/graflib/dzdoc/dzedit/dzeopl.F
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: dzeopl.F,v 1.1.1.1 1996/03/04 16:13:21 mclareni Exp $
-*
-* $Log: dzeopl.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:21 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZEOPL
-* open RZ file
-#include "dzeditkeep.inc"
- CHARACTER*4 CHOOPT
- CALL KUGETS(CHRZF,NCHA)
- CALL KUGETC(CHOOPT,NCHA)
- CALL DZEOP1(CHOOPT,ISTAT)
- END
-
-**********************************************************************
-
diff --git a/src/graflib/dzdoc/dzedit/dzeppa.F b/src/graflib/dzdoc/dzedit/dzeppa.F
deleted file mode 100644
index 933b725..0000000
--- a/src/graflib/dzdoc/dzedit/dzeppa.F
+++ /dev/null
@@ -1,44 +0,0 @@
-*
-* $Id: dzeppa.F,v 1.1.1.1 1996/03/04 16:13:24 mclareni Exp $
-*
-* $Log: dzeppa.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:24 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZEPPA(LUN,CPN,IXW,IYW)
- CHARACTER*80 CLINE
- COMMON/DZDPPC/CLINE
- CHARACTER*7 CPN
- INTEGER IFIRST
- DATA IFIRST/0/
- IF(IFIRST.EQ.0)THEN
- CLINE = ' '
- IFIRST = 1
- REWIND(LUN)
- ENDIF
- IXW = 0
- IYW = 0
- IF(CLINE(11:17).EQ.CPN)THEN
- GOTO 20
- ELSE
- REWIND(LUN)
- ENDIF
-
- 10 CONTINUE
- CALL DZDCRD(LUN,CLINE,IRC)
- IF(IRC.NE.0)GOTO 30
-* READ(LUN,'(A)',END=30 )CLINE
- IF(CLINE(1:1).NE.'%')GOTO 10
- IF(CLINE(1:9).EQ.'%%PICTURE')THEN
- IF(CLINE(11:17).EQ.CPN)THEN
- GOTO 20
- ENDIF
- ENDIF
- GOTO 10
- 20 CONTINUE
- READ(CLINE(18:27),'(2I5)')IXW,IYW
- 30 CONTINUE
- END
-***********************************************************************
diff --git a/src/graflib/dzdoc/dzedit/dzepsb.F b/src/graflib/dzdoc/dzedit/dzepsb.F
deleted file mode 100644
index 8259b09..0000000
--- a/src/graflib/dzdoc/dzedit/dzepsb.F
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: dzepsb.F,v 1.1.1.1 1996/03/04 16:13:24 mclareni Exp $
-*
-* $Log: dzepsb.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:24 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZEPSB(IX1,IY1,IX2,IY2,LUOUT)
- CHARACTER*20 CCINT
- CALL DZDPLN(LUOUT,' n',-2)
- WRITE(CCINT,10)IX1,IY1,' m'
- CALL DZDPLN(LUOUT,CCINT,-1)
- WRITE(CCINT,10)IX2,IY1,' d'
- CALL DZDPLN(LUOUT,CCINT,-1)
- WRITE(CCINT,10)IX2,IY2,' d'
- CALL DZDPLN(LUOUT,CCINT,-1)
- WRITE(CCINT,10)IX1,IY2,' d'
- CALL DZDPLN(LUOUT,CCINT,-1)
- WRITE(CCINT,10)IX1,IY1,' d'
- CALL DZDPLN(LUOUT,CCINT,-1)
- CALL DZDPLN(LUOUT,' s',0)
- WRITE(LUOUT,*)' s'
-10 FORMAT(2I8,A)
- END
-****************************************************************
diff --git a/src/graflib/dzdoc/dzedit/dzepur.F b/src/graflib/dzdoc/dzedit/dzepur.F
deleted file mode 100644
index eee33e8..0000000
--- a/src/graflib/dzdoc/dzedit/dzepur.F
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: dzepur.F,v 1.1.1.1 1996/03/04 16:13:21 mclareni Exp $
-*
-* $Log: dzepur.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:21 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZEPUR
-* purge
-#include "dzeditkeep.inc"
- CALL KUGETI(NKEEP)
- CALL RZPURG(NKEEP)
-* WRITE(*,*)' Maximum number of cycles purged:',IQUEST(11)
- END
-***********************************************************************
-
diff --git a/src/graflib/dzdoc/dzedit/dzeqit.F b/src/graflib/dzdoc/dzedit/dzeqit.F
deleted file mode 100644
index 644cdbe..0000000
--- a/src/graflib/dzdoc/dzedit/dzeqit.F
+++ /dev/null
@@ -1,15 +0,0 @@
-*
-* $Id: dzeqit.F,v 1.1.1.1 1996/03/04 16:13:20 mclareni Exp $
-*
-* $Log: dzeqit.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:20 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZEQIT
-#include "dzeditkeep.inc"
- CALL KUEXEC('EXIT')
- IQUITF=1
- END
-*********************************************************************
diff --git a/src/graflib/dzdoc/dzedit/dzerds.F b/src/graflib/dzdoc/dzedit/dzerds.F
deleted file mode 100644
index 7e1eba1..0000000
--- a/src/graflib/dzdoc/dzedit/dzerds.F
+++ /dev/null
@@ -1,15 +0,0 @@
-*
-* $Id: dzerds.F,v 1.1.1.1 1996/03/04 16:13:23 mclareni Exp $
-*
-* $Log: dzerds.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:23 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZERDS
-* read a data structure from FZ-file
- WRITE(*,*)'Read from FZ-file not supported'
- END
-*********************************************************************
-
diff --git a/src/graflib/dzdoc/dzedit/dzesgp.F b/src/graflib/dzdoc/dzedit/dzesgp.F
deleted file mode 100644
index f8e27a6..0000000
--- a/src/graflib/dzdoc/dzedit/dzesgp.F
+++ /dev/null
@@ -1,352 +0,0 @@
-*
-* $Id: dzesgp.F,v 1.2 1997/03/14 14:20:37 mclareni Exp $
-*
-* $Log: dzesgp.F,v $
-* Revision 1.2 1997/03/14 14:20:37 mclareni
-* WNT mods
-*
-* Revision 1.1.1.1.2.1 1997/01/21 11:25:13 mclareni
-* All mods for Winnt 96a on winnt branch
-*
-* Revision 1.1.1.1 1996/03/04 16:13:23 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZESGP(LUSGML,LUPPIC,LUNOUT,IOPT)
-#include "dzesgpkeep.inc"
-#if defined(CERNLIB_BSLASH)
-#include "dzdoc/bslash2.inc"
-#endif
-#if !defined(CERNLIB_BSLASH)
-#include "dzdoc/bslash1.inc"
-#endif
- CHARACTER*7 CPNAME
- CHARACTER*24 CCINT
- CHARACTER*80 CTEXT
- CHARACTER*100 CTEMP
-#include "dzeindex.inc"
-
- LUOUT = LUNOUT
-
-* units for PostScript are points: = 1/72 inch
-* we use 1/10 mm => scale .283464 (72/254)
- SCALE = 72./254.
-
- IXPAGE = 2100
- IYPAGE = 2960
- ITOP = 2700
- MARGL = 200
- MARGR = 200
- MARGB = 200
- MARGT = 200
-
- ICSIZE = 30
- ISPACE = 30
-
-* the PostScript preample
-
- CALL DZEHPE(LUOUT)
- CALL DZDPLN(LUOUT,'%%Page: 0 0',-3)
- IX = MARGL
- IY = ITOP
- IPAGE = 0
- NL = 0
- IFIG = 0
- NIND = 0
-
-* loop on lines
-
- 30 CONTINUE
- CALL DZDCRD(LUSGML,CTEXT,IRC)
- IF(IRC.NE.0)GOTO 70
-* READ(LUSGML,'(A)',END=70 )CTEXT
- IF(CTEXT(1:1) .NE. '<')GOTO 50
-
-* tab section returns after </TAB>
- IF(CTEXT(1:4).EQ.'<TAB')THEN
- GOTO 30
- ENDIF
-
-* title
-
- IF(CTEXT(1:8).EQ.'<TITLEP>')THEN
- CALL DZDPLN(LUOUT,' /saveobj save def',-3)
- WRITE(CCINT,'(2F8.5,A)')SCALE,SCALE,' scale'
- CALL DZDPLN(LUOUT,CCINT,-3)
- CALL DZDPLN(LUOUT,' H 50 sf',0)
- GOTO 30
- ENDIF
- IF(CTEXT(1:8).EQ.'</TITLEP')THEN
- CALL DZDPLN(LUOUT,' saveobj restore ',-3)
- CALL DZDPLN(LUOUT,' showpage',-2)
- CALL DZENPG(IPAGE)
- IX = MARGL
- IY = ITOP
- GOTO 30
- ENDIF
- IF(CTEXT(1:4).EQ.'<TIT')THEN
- IY = IY-100
- ILC =INDXBC(CTEXT,' ')
- WRITE(CCINT,'(2I5,A)')IXPAGE/2,IY, ' 0 ('
- CALL DZDPLN(LUOUT,CCINT,-3)
- CALL DZDPLN(LUOUT,CTEXT(8:ILC),0)
- CALL DZDPLN(LUOUT,') cs',0)
- GOTO 30
- ENDIF
- IF(CTEXT(1:4).EQ.'<AUT')THEN
- IY = IY-150
- ILC =INDXBC(CTEXT,' ')
- WRITE(CCINT,'(2I5,2A)')IXPAGE/2,IY, ' 0 ('
- CALL DZDPLN(LUOUT,CCINT,-3)
- CALL DZDPLN(LUOUT,CTEXT(8:ILC),0)
- CALL DZDPLN(LUOUT,') cs',0)
- GOTO 30
- ENDIF
-
-* remember page where bank descriptor starts
-
- IF(CTEXT(1:4).EQ.'<LIS')THEN
- ISPAGE = IPAGE
- IF(IY.LT.MARGB+6*ISPACE)THEN
- CALL DZDPLN(LUOUT,' saveobj restore ',-3)
- CALL DZDPLN(LUOUT,'showpage',-2)
- CALL DZENPG(IPAGE)
- IY = ITOP
- ENDIF
- GOTO 30
- ENDIF
-*
- IF(CTEXT(1:3).EQ.'<H1')THEN
- ISPAGE = IPAGE
- IF(IY.LT.MARGB+6*ISPACE)THEN
- CALL DZDPLN(LUOUT,' saveobj restore ',-3)
- CALL DZDPLN(LUOUT,'showpage',-2)
- CALL DZENPG(IPAGE)
- IY = ITOP
- ELSE
- IY = IY-40
- ENDIF
- CALL DZDPLN(LUOUT,' H 40 sf',-2)
- WRITE(CCINT,'(2I5,A)')IX,IY,' m'
- CALL DZDPLN(LUOUT,CCINT,-1)
- INN = INDEX(CTEXT,'"')+1
- IF(INN .NE. 0)THEN
- ILN = INN+INDEX(CTEXT(INN:80),'"')-2
- IF(ILN.LT.INN)ILN=INN
- CALL DZDPLN(LUOUT,'(BankId: ',-2)
- CALL DZDPLN(LUOUT,CTEXT(INN:ILN),0)
- CALL DZDPLN(LUOUT,') sh',0)
-
- ELSE
- IFC = INDEX(CTEXT,'>')+1
- ILC = INDXBC(CTEXT,' ')
- IF(ILC.LT.IFC)ILC=IFC
- CALL DZDPLN(LUOUT,'(',-2)
- CALL DZDPLN(LUOUT,CTEXT(IFC:ILC),0)
- CALL DZDPLN(LUOUT,') sh',0)
- ENDIF
- IY = IY-40
- WRITE(CCINT,'(I8)')ICSIZE
- CALL DZDPLN(LUOUT,'C '//CCINT(1:8)//' sf',-3)
- GOTO 30
- ENDIF
-* entry in index
- IF(CTEXT(1:4).EQ.'<I1>')THEN
- NIND = NIND + 1
- CINDEX(NIND) = CTEXT(5:8)
- IPINDX(NIND) = ISPAGE
- IORD(NIND)=NIND
- GOTO 30
- ENDIF
-* figure ID
- IF(CTEXT(1:7).EQ.'<FIG ID')THEN
- GOTO 30
- ENDIF
-* --enter a picture
- IF(CTEXT(1:4).EQ.'<PIC')THEN
- IFIG = IFIG + 1
- CPNAME = CTEXT(15:21)
- CALL DZEPPA(LUPPIC,CPNAME,IXWID,IYWID)
- IF(IXWID.EQ.0)THEN
- WRITE(*,'(A,A)')' PICTURE not found: ',CPNAME
- GOTO 30
- ENDIF
-* does it fit on page
- IYWID = IYWID*10+100
- IF(IYWID .GT. IYPAGE-MARGB)THEN
- WRITE(*,*)' Picture too big ',IXWID,IYWID
- GOTO 30
- ENDIF
- CALL DZDPLN(LUOUT,' ',-99)
- IF(IY-IYWID .LT. MARGB)THEN
- CALL DZDPLN(LUOUT,' saveobj restore ',-3)
- CALL DZDPLN(LUOUT,' showpage',-2)
- CALL DZENPG(IPAGE)
- IY = ITOP
- ENDIF
-
- IYSH = IY - 1450
- IPBOT = IY - IYWID
- IPTOP = IY
- IY = IY - IYWID - 2*ISPACE
- IXOFF = 150
- CALL DZEPSB(MARGL,IPBOT,IXPAGE-MARGR,IPTOP,LUOUT)
- CALL DZDPLN(LUOUT,' /graphobj save def() pop',-2)
-* CALL DZDPLN(LUOUT,' gsave',-2)
- WRITE(CCINT,'(2I8,A)')IXOFF,IYSH,' t'
- CALL DZDPLN(LUOUT,CCINT,-3)
- CALL DZDPLN(LUOUT,' /scale {} def ',-2)
- CALL DZDPLN(LUOUT,' /showpage {} def ',-2)
- CALL DZDPLN(LUOUT,' ',-99)
- CALL DZECPP(LUPPIC,LUOUT)
- CALL DZDPLN(LUOUT,' graphobj restore',-2)
-* CALL DZDPLN(LUOUT,' gr ',-2)
- CALL DZDPLN(LUOUT,' ',-99)
- GOTO 30
- ENDIF
-* figure caption
- IF(CTEXT(1:5).EQ.'<FIGC')THEN
- CTEMP(1:4) = CTEXT(9:12)
- ILCFC = 4
- NLFC = 0
- 40 CONTINUE
- CALL DZDCRD(LUSGML,CTEXT,IRC)
- IF(IRC.NE.0)GOTO 70
-* READ(LUSGML,'(A)',END=70 )CTEXT
- IF(CTEXT(1:4).EQ.'</FI')THEN
- CALL DZDPLN(LUOUT,' H 40 sf',-2)
- WRITE(CCINT,'(2I8,A)')MARGL+50,IPBOT+20,' m'
- CALL DZDPLN(LUOUT,CCINT,-1)
- WRITE(CCINT(1:4),'(I4)')IFIG
- CALL DZDPLN(LUOUT,
- & '(Fig.:'//CCINT(1:4)//' '//CTEMP(1:4)//') sh',-2)
- CALL DZDPLN(LUOUT,' H 30 sf',-2)
- CALL DZDPLN(LUOUT,' 50 0 rm',-2)
- DO 45 I=5,ILCFC
- IF(CTEMP(I:I).EQ.'(' .OR. CTEMP(I:I).EQ.')')CTEMP(I:I)=' '
-45 CONTINUE
- CALL DZDPLN(LUOUT,'('//CTEMP(5:ILCFC)//') sh',0)
- WRITE(CCINT,'(A,I8,A)')'C ',ICSIZE,' sf'
- CALL DZDPLN(LUOUT,CCINT,-3)
- GOTO 30
- ENDIF
- NLFC = NLFC+1
- IF(NLFC .EQ. 1)THEN
- ILCFC = INDXBC(CTEXT,' ')
- IF(ILCFC .GT. LEN(CTEMP)-5)ILCFC = LEN(CTEMP)-5
- CTEMP(5:)=' '//CTEXT(1:ILCFC)
- ILCFC = ILCFC+5
- ENDIF
- GOTO 40
- ENDIF
-* ignore other control lines
- IF(CTEXT(1:1).EQ.'<' .AND. CTEXT(1:3).NE.'<HP')GOTO 30
-
- 50 CONTINUE
-
- ILC = INDXBC(CTEXT,' ')
- IF(ILC.LE.0)GOTO 30
- NC = ILC
-* IBO = 0
-* IBC = 0
- IF( INDEX(CTEXT(1:ILC),'(').NE.0
- &.OR.INDEX(CTEXT(1:ILC),')').NE.0)THEN
- ILC=0
- DO 60 I=1,NC
- ILC=ILC+1
- IF(ILC.GT.99)GOTO 61
- IF(CTEXT(I:I).EQ.'(' .OR. CTEXT(I:I).EQ.')')THEN
- CTEMP(ILC:ILC)=BS
- ILC=ILC+1
- ENDIF
- CTEMP(ILC:ILC)=CTEXT(I:I)
-60 CONTINUE
-61 CONTINUE
- ELSE
- CTEMP(1:ILC)=CTEXT(1:ILC)
- ENDIF
- IF(IY .LE. MARGB)THEN
- IY = ITOP
- CALL DZDPLN(LUOUT,' saveobj restore ',-3)
- CALL DZDPLN(LUOUT,' showpage',-2)
- CALL DZENPG(IPAGE)
- NL = 0
- ENDIF
- IF(CTEXT(1:3).EQ.'<HP')THEN
- CALL DZDPLN(LUOUT,' H 40 sf',-2)
- IFC = INDEX(CTEXT,'>')+1
- ILC1 = INDEXB(CTEXT,'<')-1
- IF (ILC1.NE.0)ILC=ILC1
- ELSE
- IFC=1
- ENDIF
- WRITE(CCINT,'(2I8,A)')IX,IY,' m'
- CALL DZDPLN(LUOUT,CCINT,-1)
- CALL DZDPLN(LUOUT,'(',0)
- CALL DZDPLN(LUOUT,CTEMP(IFC:ILC),0)
- CALL DZDPLN(LUOUT,') sh',0)
- IF(CTEXT(1:3).EQ.'<HP')THEN
- WRITE(CCINT,'(A,I8,A)')'C ',ICSIZE,' sf'
- CALL DZDPLN(LUOUT,CCINT,-1)
- ENDIF
- NL = NL+1
- IY = IY - ISPACE
- GOTO 30
- 70 CONTINUE
- IF(NL.GT.0)THEN
- CALL DZDPLN(LUOUT,' saveobj restore ',-3)
- CALL DZDPLN(LUOUT,' showpage',0)
- ENDIF
- WRITE(*,*)NIND, ' banks documented with ',IFIG,' pictures on ',
- + IPAGE,' pages'
- IF(NIND .LE. 0)GOTO 100
-
- DO 80 I=1,NIND-1
- DO 80 K=I+1,NIND
- I1 = IORD(I)
- K1 = IORD(K)
- IF(LLE(CINDEX(I1),CINDEX(K1)))GOTO 80
- IORD(K) = I1
- IORD(I) = K1
- 80 CONTINUE
- DO 90 I=1,NIND
- IF(I.EQ.1)GOTO 85
-84 K = IORD(I)
- WRITE(CCINT,'(2I8,A)')IX,IY,' m'
- CALL DZDPLN(LUOUT,CCINT,-1)
- CALL DZDPLN(LUOUT,'(',0)
- CALL DZDPLN(LUOUT,CINDEX(K),0)
- CALL DZDPLN(LUOUT,') sh',0)
- WRITE(CCINT,'(2I8,A)')IX+150,IY,' m'
- CALL DZDPLN(LUOUT,CCINT,-1)
- WRITE(CCINT(1:5),'(I5)')IPINDX(K)
- CALL DZDPLN(LUOUT,'('//CCINT(1:5)//') sh',0)
- IY = IY - 50
- IF(MOD(I,50).EQ.0)THEN
- IY = ITOP-100
- IX = IX + 400
- ENDIF
- IF(I.EQ.1)GOTO 90
-85 IF(I.EQ.1 .OR. MOD(I,200).EQ.0)THEN
- IF(MOD(I,200).EQ.0)CALL DZDPLN(LUOUT,' showpage',0)
- IPAGE=IPAGE+1
- WRITE(CCINT,'(A,2I5)')'%%Page:',IPAGE,IPAGE
- CALL DZDPLN(LUOUT,CCINT,-3)
- WRITE(CCINT,'(2F8.5,A)')SCALE,SCALE,' scale'
- CALL DZDPLN(LUOUT,CCINT,-3)
- CALL DZDPLN(LUOUT,' [] 0 setdash',-1)
- CALL DZDPLN(LUOUT,' 1 setlinewidth',-1)
- CALL DZDPLN(LUOUT,'H 40 sf',-1)
- WRITE(CCINT,'(2I5,A,A,A)')IXPAGE/2,ITOP+4*ISPACE, ' 0 ('
- + //'Index) cs'
- CALL DZDPLN(LUOUT,CCINT,-1)
- IY = ITOP - 100
- IX = MARGL
- IF(I.EQ.1)GOTO 84
- ENDIF
- 90 CONTINUE
- CALL DZDPLN(LUOUT,' showpage',-2)
- CALL DZDPLN(LUOUT,' ',-99)
- 100 CONTINUE
- END
diff --git a/src/graflib/dzdoc/dzedit/dzesgpkeep.inc b/src/graflib/dzdoc/dzedit/dzesgpkeep.inc
deleted file mode 100644
index 4f9164b..0000000
--- a/src/graflib/dzdoc/dzedit/dzesgpkeep.inc
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: dzesgpkeep.inc,v 1.1.1.1 1996/03/04 16:13:20 mclareni Exp $
-*
-* $Log: dzesgpkeep.inc,v $
-* Revision 1.1.1.1 1996/03/04 16:13:20 mclareni
-* Dzdoc/Zebpack
-*
-*
-*
-* dzesgpkeep.inc
-*
- COMMON/DZESGM/ICSIZE,ISPACE,ITOP,IXPAGE,IYPAGE,
- & MARGL,MARGR,MARGB,MARGT,
- & SCALE,
- & LUMETA,LUOUT,LUSGM
-******************** END OF KEEP ***********************
diff --git a/src/graflib/dzdoc/dzedit/dzeurz.F b/src/graflib/dzdoc/dzedit/dzeurz.F
deleted file mode 100644
index 60f0126..0000000
--- a/src/graflib/dzdoc/dzedit/dzeurz.F
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: dzeurz.F,v 1.1.1.1 1996/03/04 16:13:20 mclareni Exp $
-*
-* $Log: dzeurz.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:20 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZEURZ
-#include "dzeditkeep.inc"
-#if defined(CERNLIB_BSLASH)
-#include "dzdoc/bslash2.inc"
-#endif
-#if !defined(CERNLIB_BSLASH)
-#include "dzdoc/bslash1.inc"
-#endif
-
-C-- Update existing RZ file
-
-* get parameter from KUIP command line
-
- CALL KUGETS(CHCARD,NCHA)
- IF(NCHA.LE.0)GOTO 999
- CALL KUGETS(CHRZF,NCHA)
- IF(NCHA.LE.0)GOTO 999
- CALL KUCMD('DZEDIT',' ','SW')
- CALL KUPVAL('LISTDIRECTORY','CHRZF',0,0.,CHRZF,'D')
- CALL KUPVAL('OPENRZFILE','CHRZF',0,0.,CHRZF,'D')
- CALL KUCMD (BS,' ','SW')
- CALL DZDURZ(LUPCAR,LUPRZ,CHCARD,CHRZF,CHSUBD,IRET)
- IF(IRET.EQ.0)LUNRZ=LUPRZ
-999 END
-*********************************************************************
diff --git a/src/graflib/dzdoc/dzedit/dzewem.F b/src/graflib/dzdoc/dzedit/dzewem.F
deleted file mode 100644
index 0abaa6e..0000000
--- a/src/graflib/dzdoc/dzedit/dzewem.F
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: dzewem.F,v 1.1.1.1 1996/03/04 16:13:22 mclareni Exp $
-*
-* $Log: dzewem.F,v $
-* Revision 1.1.1.1 1996/03/04 16:13:22 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZEWEM(LUNSGM)
- WRITE(LUNSGM,'(A)')'</BODY>'
- WRITE(LUNSGM,'(A)')'<BACKM>'
- WRITE(LUNSGM,'(A)')'<INDEX>'
- WRITE(LUNSGM,'(A)')'</BACKM>'
- WRITE(LUNSGM,'(A)')'</GDOC>'
- END
diff --git a/src/graflib/dzdoc/dzedit/dzezer.F b/src/graflib/dzdoc/dzedit/dzezer.F
deleted file mode 100644
index 8559a2e..0000000
--- a/src/graflib/dzdoc/dzedit/dzezer.F
+++ /dev/null
@@ -1,69 +0,0 @@
-*
-* $Id: dzezer.F,v 1.2 1996/05/09 14:40:55 cernlib Exp $
-*
-* $Log: dzezer.F,v $
-* Revision 1.2 1996/05/09 14:40:55 cernlib
-* correct path for include file
-*
-* Revision 1.1.1.1 1996/03/04 16:13:20 mclareni
-* Dzdoc/Zebpack
-*
-*
-#include "dzdoc/pilot.h"
- SUBROUTINE DZEZER
-#include "dzeditkeep.inc"
-#include "dzdraw/dzdprm.inc"
- INTEGER INIFLG
- SAVE INIFLG
- DATA INIFLG/0/
-*
- IF(INIFLG.NE.0)GOTO 999
- INIFLG=1
- LUNOUT=LUPOUT
- LUNMET=0
- LUNSGM=0
- LUNLST=6
- LUNCOM=0
- LUNLAS=0
- LUNRZ=0
- LUNCAR=0
- LUNGKS=0
- LUNLIS=0
- LUNSCR=0
- LUNPOS=0
- LUNPIC=0
- LUNEXE=0
- LUNSC1=0
- LUNPLO=0
- IWKID = 1
- ICONID = 6
- IWMETA = 2
- INTWST = 4
- ITYMET = 4
-* ITYPLO = 4
- ILOCNR = 1
- ITIMCH = 0
- IDATCH = 0
- IBCCOL=7
- IBDCOL=3
-* IHATCH = -5
- LISTAC = .FALSE.
- LISTSG = .FALSE.
- LISTTO = .FALSE.
- CHDZED = ' '
-* LOGLV = -2
- ISGMOP = 0
- ILSTOP = 0
- ISCROP = 0
- IPOSTF = 0
- CHLIST =' '
- CHBSBK= ' '
- CHBSUP= '****'
- CHSUBD = ' '
- CHMETA = ' '
- CHSGML = ' '
- CHCOMP = ' '
- CTITLE = 'ZEBRA-Datastructures'
- IC1000 = 1000000
-999 END
-***********************************************************************
diff --git a/src/graflib/dzdoc/dzeditcdf/dzeditcd.cdf b/src/graflib/dzdoc/dzeditcdf/dzeditcd.cdf
deleted file mode 100644
index 6ee7f73..0000000
--- a/src/graflib/dzdoc/dzeditcdf/dzeditcd.cdf
+++ /dev/null
@@ -1,831 +0,0 @@
-*
-* $Id: dzeditcd.cdf,v 1.1.1.1 1996/03/04 16:13:25 mclareni Exp $
-*
-* $Log: dzeditcd.cdf,v $
-* Revision 1.1.1.1 1996/03/04 16:13:25 mclareni
-* Dzdoc/Zebpack
-*
-*
-* This directory was created from dzdoc.car patch dzedef
-/*
- * This file has been generated by the KUIP compiler. Do NOT change it!
- *
- * KUIP version: 921023 Generation date: Wed Mar 2 15:23:03 1994
-
- *
- * Input file: DZEDITCD.CDF
- */
-
-#if !defined(F77_LCASE) && !defined(F77_UCASE) && !defined(F77_USCORE)
-# if defined(CRAY) || defined(IBM370) || defined(vms)
-# define F77_UCASE
-# else
-# if ( defined(apollo) || defined(__apollo) ) && defined(APOFTN)
-# define F77_LCASE
-# else
-# define F77_USCORE
-# endif
-# endif
-#endif
-
-typedef int IntFunc();
-typedef char** pCharFunc();
-typedef void SUBROUTINE();
-#ifdef IBM370
-# pragma linkage(SUBROUTINE,FORTRAN)
-#endif
-
-typedef unsigned long KmPixmap; /* Pixmap from <X11/X.h> */
- typedef void *KmWidget; /* Widget from <X11/Intrinsic.h> */
- typedef void *KmCalldata; /* XmAnyCallbackStruct from <Motif/Xm.h> */
- /* */
- typedef enum { /* */
- BRACT_OPEN = 0, /* */
- BRACT_ROOT = 1, /* */
- BRACT_CONT = 2, /* */
- BRACT_GRAF = 3 /* */
- } BrActTag; /* */
- /* */
- typedef enum { /* */
- BrActUpdate = 0x01, /* browser window has to be updated ('!') */
- BrActSeparator = 0x02, /* put separator in menu ('/') */
- BrActToggle = 0x04, /* register as toggle button */
- BrActToggleOn = 0x08, /* toggle state is on */
- BrActSensitive = 0x10 /* button is sensitive */
- } BrActFlag; /* */
- /* */
- typedef struct _BrAction { /* */
- struct _BrAction *next; /* link to next action binding */
- BrActFlag flags; /* */
- char *text; /* text line in menu */
- char *user_text; /* user text overriding CDF text (malloced)*/
- char *accel; /* accelerator */
- char *exec; /* action commands */
- SUBROUTINE *call_F; /* action routine */
- IntFunc *call_C; /* action function */
- BrActTag tag; /* for which window the action is defined */
- struct _BrClass *class; /* pointer to BrClass in case of open menu */
- } BrAction; /* */
- /* */
- typedef struct _BrClass { /* */
- struct _BrClass *next; /* link to next browsable class */
- char *name; /* unique identifier name */
- char *title; /* title for popup menu (maybe NULL) */
- SUBROUTINE *scan_km_F; /* user function scanning the directory */
- pCharFunc *scan_km_C; /* user function scanning the directory */
- SUBROUTINE *scan_br_F; /* user function scanning for browsables */
- pCharFunc *scan_br_C; /* user function scanning for browsables */
- BrAction *root; /* list of actions in root window */
- BrAction *open; /* list of actions in open menu */
- } BrClass; /* */
- /* */
-
-typedef struct _KmIcon { /* */
- struct _KmIcon *next; /* link to next icon */
- char *name; /* unique identifier name */
- int width; /* width of the pixmap */
- int height; /* height of the pixmap */
- char *bitmap; /* bitmap data */
- KmPixmap pix; /* filled in Motif part */
- KmPixmap hi_pix; /* high lighted pixmap */
- } KmIcon; /* */
- /* */
- typedef struct _KmClass { /* */
- struct _KmClass *next; /* link to next object class */
- int is_dir; /* flag if class has is a directory */
- char *name; /* unique identifier name */
- char *title; /* title for popup menu (maybe NULL) */
- char *big_icon; /* name of the big icon */
- KmIcon *bicon; /* pointer to the big icon structure */
- char *sm_icon; /* name of the small icon */
- KmIcon *sicon; /* pointer to the small icon structure */
- SUBROUTINE *user_icon_F; /* user function to return icon bitmap */
- IntFunc *user_icon_C; /* user function to return icon bitmap */
- BrAction *cont; /* list of actions in content window */
- BrAction *graf; /* list of actions in graphics window */
- int obj_count; /* number of objects in content window */
- } KmClass; /* */
- /* */
- typedef enum { /* */
- KmButtSensitive = 0x00, /* sensitive button */
- KmButtNonSensitive = 0x01, /* non-sensitive button ('NS') */
- KmButtToggleSensitive = 0x02, /* toggle-sensitive button ('TS') */
- KmButtSensitivityMask = 0x03, /* mask for sensitivity type */
- KmButtSeparator = 0x04 /* put separator in menu ('/') */
- } KmButtFlag; /* */
- /* */
- typedef struct _KmButton { /* */
- struct _KmButton *next; /* button label or menu item */
- char *label; /* button label or menu item */
- char *menu; /* menu name or NULL for buttons */
- KmButtFlag flags; /* sensitivity type etc. */
- SUBROUTINE *action_F; /* Fortran routine called with (LABEL,MENU)*/
- IntFunc *action_C; /* C function called with (label,menu) */
- KmWidget widget; /* Motif widget ID */
- } KmButton; /* */
-
-extern struct { /*
- */ /* indirect calls to avoid linking HIGZ
- */ IntFunc *graf_info_C; /* pass display, open and close
- (ixmotif) */ SUBROUTINE *graf_size_F; /* resize window (IGRSIZ)
- */ SUBROUTINE *graf_pick_F; /* identifying graphics objects
- (IGOBJ) */ SUBROUTINE *graf_attr_F; /* set attributes (IGSET)
- */ SUBROUTINE *graf_close_F; /* close workstation (ICLWK)
- */ /* optional routines for Motif customization
- */ pCharFunc *user_FallBk_C; /* get application fallbacks
- */ IntFunc *user_TopWid_C; /* pass toplevel widget
- identifiers */ } klnkaddr; /*
- */
-
-typedef enum { /* */
- KmFLAG_FORGET = 0x01, /* last value is not kept for Motif panels */
- KmFLAG_MINUS = 0x02, /* -VALUE is not an abbrev for CHOPT=VALUE */
- KmFLAG_QUOTE = 0x04, /* do not remove quotes */
- KmFLAG_VARARG = 0x08 /* append additional args to this param. */
- } KmParFlag; /* */
- /* */
- typedef enum { /* */
- KmTYPE_CHAR = 'C', /* character string */
- KmTYPE_FILE = 'F', /* file name */
- KmTYPE_INT = 'I', /* integer */
- KmTYPE_OPTION = 'O', /* option */
- KmTYPE_REAL = 'R' /* real */
- } KmParType; /* */
- /* */
- typedef struct { /* file name */
- char *filter_default; /* filter wildcard */
- char *filter_current; /* current filter */
- } KmParFile; /* */
- /* */
- typedef struct { /* */
- char *range_lower; /* lower value of range */
- char *range_upper; /* upper value of range */
- char *slider_lower; /* lower limit for slider */
- char *slider_upper; /* upper limit for slider */
- int decimals; /* number of decimals used for slider */
- } KmParInt; /* */
- /* */
- typedef struct { /* option */
- char **text; /* explanations (parallel to range_value) */
- int *mutex; /* mutex group to which text belongs */
- int *radio; /* radio group to which text belongs */
- } KmParOption; /* */
- /* */
- typedef KmParInt KmParReal; /* real and int have the same fields */
- /* */
- typedef struct { /* */
- char *name; /* parameter name */
- int abbrev; /* minimum length that name is recognized */
- char *prompt; /* prompt string */
- char *dfault; /* default value */
- char *last; /* last value for Motif panel (malloced) */
- int width; /* width of input field */
- int range_count; /* number of items in range_value */
- char **range_value; /* list of allowed values */
- int select_count; /* number of items in select_count */
- char **select_value; /* list of values for selection box */
- KmParFlag flags; /* special flags */
- KmParType type; /* parameter type */
- void *ptype; /* structure pointer selected by type */
- } KmParameter; /* */
-
-typedef struct _KmCommand { /* */
- struct _KmCommand *next; /* link to next command */
- char *path; /* command path */
- char *name; /* command name */
- int hidden; /* flag if command is invisible */
- int level; /* depth of submenus */
- int total; /* total number of parameters */
- int mandatory; /* number of mandatory parameters */
- KmParameter **par; /* list of total parameter descriptions */
- int list_par; /* index+1 of parameter taking a list */
- int xcount; /* count number of action calls */
- SUBROUTINE *action_F; /* action routine */
- IntFunc *action_C; /* action routine */
- SUBROUTINE *user_help_F; /* user help routine */
- IntFunc *user_help_C; /* user help routine */
- int nguidance; /* number of lines in guidance text */
- char **guidance; /* help text */
- int argc; /* number of arguments entered */
- char **argv; /* argc argument values */
- char *argline; /* argument line as entered */
- int *argoffs; /* argc offsets into argline for KUGETE */
- } KmCommand; /* */
- /* */
- typedef struct _KmMenu { /* */
- struct _KmMenu *next; /* link to next menu */
- struct _KmMenu *down; /* link to submenu */
- char *path; /* path of parent menu */
- char *name; /* menu name */
- int level; /* depth of submenus */
- KmCommand *cmds; /* link to first command */
- int nguidance; /* number of lines in guidance text */
- char **guidance; /* help text */
- } KmMenu; /* */
-
-#ifdef F77_LCASE
-# define dzedef_ dzedef
-# define dzebkk_ dzebkk
-# define dzelas_ dzelas
-# define dzelof_ dzelof
-# define dzedof_ dzedof
-# define dzeqit_ dzeqit
-# define dzedsp_ dzedsp
-# define dzedra_ dzedra
-# define dzedrw_ dzedrw
-# define dzelal_ dzelal
-# define dzelsg_ dzelsg
-# define dzedrz_ dzedrz
-# define dzedel_ dzedel
-# define dzepur_ dzepur
-# define dzdcld_ dzdcld
-# define dzeopl_ dzeopl
-# define dzeurz_ dzeurz
-# define dzemrz_ dzemrz
-#endif
-
-#ifdef F77_UCASE
-# define dzedef_ DZEDEF
-# define dzebkk_ DZEBKK
-# define dzelas_ DZELAS
-# define dzelof_ DZELOF
-# define dzedof_ DZEDOF
-# define dzeqit_ DZEQIT
-# define dzedsp_ DZEDSP
-# define dzedra_ DZEDRA
-# define dzedrw_ DZEDRW
-# define dzelal_ DZELAL
-# define dzelsg_ DZELSG
-# define dzedrz_ DZEDRZ
-# define dzedel_ DZEDEL
-# define dzepur_ DZEPUR
-# define dzdcld_ DZDCLD
-# define dzeopl_ DZEOPL
-# define dzeurz_ DZEURZ
-# define dzemrz_ DZEMRZ
-#endif
-
-#ifdef IBM370
-# pragma linkage(DZEDEF,FORTRAN)
-# pragma linkage(DZEBKK,FORTRAN)
-# pragma linkage(DZELAS,FORTRAN)
-# pragma linkage(DZELOF,FORTRAN)
-# pragma linkage(DZEDOF,FORTRAN)
-# pragma linkage(DZEQIT,FORTRAN)
-# pragma linkage(DZEDSP,FORTRAN)
-# pragma linkage(DZEDRA,FORTRAN)
-# pragma linkage(DZEDRW,FORTRAN)
-# pragma linkage(DZELAL,FORTRAN)
-# pragma linkage(DZELSG,FORTRAN)
-# pragma linkage(DZEDRZ,FORTRAN)
-# pragma linkage(DZEDEL,FORTRAN)
-# pragma linkage(DZEPUR,FORTRAN)
-# pragma linkage(DZDCLD,FORTRAN)
-# pragma linkage(DZEOPL,FORTRAN)
-# pragma linkage(DZEURZ,FORTRAN)
-# pragma linkage(DZEMRZ,FORTRAN)
-#endif
-
-extern void dzedef_();
-extern void dzebkk_();
-extern void dzelas_();
-extern void dzelof_();
-extern void dzedof_();
-extern void dzeqit_();
-extern void dzedsp_();
-extern void dzedra_();
-extern void dzedrw_();
-extern void dzelal_();
-extern void dzelsg_();
-extern void dzedrz_();
-extern void dzedel_();
-extern void dzepur_();
-extern void dzdcld_();
-extern void dzeopl_();
-extern void dzeurz_();
-extern void dzemrz_();
-
-void dzedef_()
-{
-
-static KmParameter _DZEDIT_MAKECODE_LIFT_CHBSBK = { "CHBSBK", 6,
- "Hollerith Id of selected bank", (char*)0, (char*)0, 20, 0, (char**)0, 0,
- (char**)0, (KmParFlag)0, KmTYPE_CHAR, (void*)0 };
-static KmParameter _DZEDIT_MAKECODE_LIFT_CHBSUP = { "CHBSUP", 6,
- "Hollerith Id of its up-bank", (char*)0, (char*)0, 20, 0, (char**)0, 0,
- (char**)0, (KmParFlag)0, KmTYPE_CHAR, (void*)0 };
-static KmParameter _DZEDIT_MAKECODE_LIFT_CHLIST = { "CHLIST", 6,
- "File for listing", " ", (char*)0, 20, 0, (char**)0, 0, (char**)0,
- (KmParFlag)0, KmTYPE_CHAR, (void*)0 };
-static KmParOption _DZEDIT_MAKECODE_LIFT_CHOPTB_type = { (char**)0, (int*)0,
- (int*)0 };
-static KmParameter _DZEDIT_MAKECODE_LIFT_CHOPTB = { "CHOPTB", 6,
- "Option, S single bank", "TL", (char*)0, 20, 0, (char**)0, 0, (char**)0,
- (KmParFlag)0, KmTYPE_OPTION, &_DZEDIT_MAKECODE_LIFT_CHOPTB_type };
-static KmParameter *_DZEDIT_MAKECODE_LIFT_parameters[] = {
- &_DZEDIT_MAKECODE_LIFT_CHBSBK, &_DZEDIT_MAKECODE_LIFT_CHBSUP,
- &_DZEDIT_MAKECODE_LIFT_CHLIST, &_DZEDIT_MAKECODE_LIFT_CHOPTB };
-static char *_DZEDIT_MAKECODE_LIFT_guidance[] = {
- "Generate code to lift a bank (Option 'S') or bank tree (Option 'T').",
- "With option 'L' (default) calls to MZLIFT are generated, with 'B'",
- "calls to MZBOOK. See also GUIDANCE for BOOK." };
-static KmCommand _DZEDIT_MAKECODE_LIFT = { (KmCommand*)0,
- "/DZEDIT/MAKECODE/LIFT", "LIFT", 0, 2, 4, 2,
- _DZEDIT_MAKECODE_LIFT_parameters, 0, 0, dzebkk_, (IntFunc*)0, (SUBROUTINE*)0,
- (IntFunc*)0, 3, _DZEDIT_MAKECODE_LIFT_guidance, 0, (char**)0, (char*)0,
- (int*)0 };
-
-static KmParameter _DZEDIT_MAKECODE_BOOK_CHBSBK = { "CHBSBK", 6,
- "Hollerith Id of selected bank", (char*)0, (char*)0, 20, 0, (char**)0, 0,
- (char**)0, (KmParFlag)0, KmTYPE_CHAR, (void*)0 };
-static KmParameter _DZEDIT_MAKECODE_BOOK_CHBSUP = { "CHBSUP", 6,
- "Hollerith Id of its up-bank", (char*)0, (char*)0, 20, 0, (char**)0, 0,
- (char**)0, (KmParFlag)0, KmTYPE_CHAR, (void*)0 };
-static KmParameter _DZEDIT_MAKECODE_BOOK_CHLIST = { "CHLIST", 6,
- "File for listing", " ", (char*)0, 20, 0, (char**)0, 0, (char**)0,
- (KmParFlag)0, KmTYPE_CHAR, (void*)0 };
-static KmParOption _DZEDIT_MAKECODE_BOOK_CHOPTB_type = { (char**)0, (int*)0,
- (int*)0 };
-static KmParameter _DZEDIT_MAKECODE_BOOK_CHOPTB = { "CHOPTB", 6,
- "Option, S single bank", "TB", (char*)0, 20, 0, (char**)0, 0, (char**)0,
- (KmParFlag)0, KmTYPE_OPTION, &_DZEDIT_MAKECODE_BOOK_CHOPTB_type };
-static KmParameter *_DZEDIT_MAKECODE_BOOK_parameters[] = {
- &_DZEDIT_MAKECODE_BOOK_CHBSBK, &_DZEDIT_MAKECODE_BOOK_CHBSUP,
- &_DZEDIT_MAKECODE_BOOK_CHLIST, &_DZEDIT_MAKECODE_BOOK_CHOPTB };
-static char *_DZEDIT_MAKECODE_BOOK_guidance[] = {
- "Generate code to book a bank (Option 'S') or bank tree (Option 'T').",
- "With option 'B' (default) calls to MZBOOK are generated, with 'L'",
- "calls to MZLIFT. For MZLIFT the bank parameters are put into arrays",
- "MMIDBK which go into an own KEEP sequence.",
- "The link to the bank 'BANK' is named LBANK, the uplink is assumed LUPBK,",
- "if the up-bank is called UPBK.",
- "For LBANK the declaration \"INTEGER LBANK\" is generated, for LUPBK it",
- "is assumed to be done already. A call to MZFORM is generated if not",
- "all data words are of the same type.",
- "The link offset (JBIAS) is taken from the card *B.UP UPBK -JBIAS, if",
- "JBIAS is given. If it is not given it is searched for in the",
- "documentation of the Up-bank. If UPBK is \"NONE\" it is set to +1.",
- "The following defaults are taken if the corresponding parameter is",
- "not explicitly documented:", " IXDIV: 0 (i.e. div 2 in store 0)",
- " JBIAS: no default", " NL: 0", " NS: 0", " ND: 0",
- " IOChar: no default, except if ND=0", " NZERO: 0" };
-static KmCommand _DZEDIT_MAKECODE_BOOK = { &_DZEDIT_MAKECODE_LIFT,
- "/DZEDIT/MAKECODE/BOOK", "BOOK", 0, 2, 4, 2,
- _DZEDIT_MAKECODE_BOOK_parameters, 0, 0, dzebkk_, (IntFunc*)0, (SUBROUTINE*)0,
- (IntFunc*)0, 21, _DZEDIT_MAKECODE_BOOK_guidance, 0, (char**)0, (char*)0,
- (int*)0 };
-
-static KmParameter _DZEDIT_MAKECODE_LINKASSIGNMENT_CHBSBK = { "CHBSBK", 6,
- "Hollerith Id of selected bank", (char*)0, (char*)0, 20, 0, (char**)0, 0,
- (char**)0, (KmParFlag)0, KmTYPE_CHAR, (void*)0 };
-static KmParameter _DZEDIT_MAKECODE_LINKASSIGNMENT_CHBSUP = { "CHBSUP", 6,
- "Hollerith Id of its up-bank", (char*)0, (char*)0, 20, 0, (char**)0, 0,
- (char**)0, (KmParFlag)0, KmTYPE_CHAR, (void*)0 };
-static KmParameter _DZEDIT_MAKECODE_LINKASSIGNMENT_CHLIST = { "CHLIST", 6,
- "File for listing", " ", (char*)0, 20, 0, (char**)0, 0, (char**)0,
- (KmParFlag)0, KmTYPE_CHAR, (void*)0 };
-static KmParameter _DZEDIT_MAKECODE_LINKASSIGNMENT_CHPFIX = { "CHPFIX", 6,
- "Prefix to BankId", "LO", (char*)0, 20, 0, (char**)0, 0, (char**)0,
- (KmParFlag)0, KmTYPE_CHAR, (void*)0 };
-static KmParOption _DZEDIT_MAKECODE_LINKASSIGNMENT_CHOPTL_type = { (char**)0,
- (int*)0, (int*)0 };
-static KmParameter _DZEDIT_MAKECODE_LINKASSIGNMENT_CHOPTL = { "CHOPTL", 6,
- "Option, S single bank", "T", (char*)0, 20, 0, (char**)0, 0, (char**)0,
- (KmParFlag)0, KmTYPE_OPTION, &_DZEDIT_MAKECODE_LINKASSIGNMENT_CHOPTL_type };
-static KmParameter *_DZEDIT_MAKECODE_LINKASSIGNMENT_parameters[] = {
- &_DZEDIT_MAKECODE_LINKASSIGNMENT_CHBSBK,
- &_DZEDIT_MAKECODE_LINKASSIGNMENT_CHBSUP,
- &_DZEDIT_MAKECODE_LINKASSIGNMENT_CHLIST,
- &_DZEDIT_MAKECODE_LINKASSIGNMENT_CHPFIX,
- &_DZEDIT_MAKECODE_LINKASSIGNMENT_CHOPTL };
-static char *_DZEDIT_MAKECODE_LINKASSIGNMENT_guidance[] = {
- "Generate sequences of link assignment statements for selected",
- "bank (Option 'S') or tree (option 'T').",
- "Exactly two times 4 characters are needed to define bank and up-bank.",
- "The assumed linkoffset is named CHPFIX concatenated with the", "bank Id.",
- "Example: if a link to bank IDBK with Up-bank IDUP is described like:",
- " *B.UP IDUP", " *B.LINK", " ...",
- " *B.7 IDBK Bank containing anything", " would produce:",
- " INTEGER LOIDBK", " LOIDBK=LQ(LOIDUP-7)" };
-static KmCommand _DZEDIT_MAKECODE_LINKASSIGNMENT = { &_DZEDIT_MAKECODE_BOOK,
- "/DZEDIT/MAKECODE/LINKASSIGNMENT", "LINKASSIGNMENT", 0, 2, 5, 2,
- _DZEDIT_MAKECODE_LINKASSIGNMENT_parameters, 0, 0, dzelas_, (IntFunc*)0,
- (SUBROUTINE*)0, (IntFunc*)0, 13, _DZEDIT_MAKECODE_LINKASSIGNMENT_guidance, 0,
- (char**)0, (char*)0, (int*)0 };
-
-static KmParameter _DZEDIT_MAKECODE_LINKOFFSETS_CHBSBK = { "CHBSBK", 6,
- "Hollerith Id of selected bank", (char*)0, (char*)0, 20, 0, (char**)0, 0,
- (char**)0, (KmParFlag)0, KmTYPE_CHAR, (void*)0 };
-static KmParameter _DZEDIT_MAKECODE_LINKOFFSETS_CHBSUP = { "CHBSUP", 6,
- "Hollerith Id of its up-bank", (char*)0, (char*)0, 20, 0, (char**)0, 0,
- (char**)0, (KmParFlag)0, KmTYPE_CHAR, (void*)0 };
-static KmParameter _DZEDIT_MAKECODE_LINKOFFSETS_CHLIST = { "CHLIST", 6,
- "File for listing", " ", (char*)0, 20, 0, (char**)0, 0, (char**)0,
- (KmParFlag)0, KmTYPE_CHAR, (void*)0 };
-static KmParameter _DZEDIT_MAKECODE_LINKOFFSETS_CHPFIX = { "CHPFIX", 6,
- "Prefix to BankId", "LO", (char*)0, 20, 0, (char**)0, 0, (char**)0,
- (KmParFlag)0, KmTYPE_CHAR, (void*)0 };
-static KmParOption _DZEDIT_MAKECODE_LINKOFFSETS_CHOPTL_type = { (char**)0,
- (int*)0, (int*)0 };
-static KmParameter _DZEDIT_MAKECODE_LINKOFFSETS_CHOPTL = { "CHOPTL", 6,
- "Option, S single bank", "T", (char*)0, 20, 0, (char**)0, 0, (char**)0,
- (KmParFlag)0, KmTYPE_OPTION, &_DZEDIT_MAKECODE_LINKOFFSETS_CHOPTL_type };
-static KmParameter *_DZEDIT_MAKECODE_LINKOFFSETS_parameters[] = {
- &_DZEDIT_MAKECODE_LINKOFFSETS_CHBSBK, &_DZEDIT_MAKECODE_LINKOFFSETS_CHBSUP,
- &_DZEDIT_MAKECODE_LINKOFFSETS_CHLIST, &_DZEDIT_MAKECODE_LINKOFFSETS_CHPFIX,
- &_DZEDIT_MAKECODE_LINKOFFSETS_CHOPTL };
-static char *_DZEDIT_MAKECODE_LINKOFFSETS_guidance[] = {
- "Generate sequences of link offsets for a selected bank (Option 'S')",
- "or tree (Option 'T').",
- "Exactly two times 4 characters are needed to define bank and up-bank.",
- "The variable generated is named CHPFIX concatenated with the", "bank Id.",
- "Example: if a link to bank IDBK is described like this:",
- " *B.LINK", " ...",
- " *B.7 IDBK Bank containing anything", " would produce:",
- " INTEGER LOIDBK", " PARAMETER (LOIDBK=7)" };
-static KmCommand _DZEDIT_MAKECODE_LINKOFFSETS = {
- &_DZEDIT_MAKECODE_LINKASSIGNMENT, "/DZEDIT/MAKECODE/LINKOFFSETS",
- "LINKOFFSETS", 0, 2, 5, 2, _DZEDIT_MAKECODE_LINKOFFSETS_parameters, 0, 0,
- dzelof_, (IntFunc*)0, (SUBROUTINE*)0, (IntFunc*)0, 12,
- _DZEDIT_MAKECODE_LINKOFFSETS_guidance, 0, (char**)0, (char*)0, (int*)0 };
-
-static KmParameter _DZEDIT_MAKECODE_DATAOFFSETS_CHBSBK = { "CHBSBK", 6,
- "Hollerith Id of selected bank", (char*)0, (char*)0, 20, 0, (char**)0, 0,
- (char**)0, (KmParFlag)0, KmTYPE_CHAR, (void*)0 };
-static KmParameter _DZEDIT_MAKECODE_DATAOFFSETS_CHBSUP = { "CHBSUP", 6,
- "Hollerith Id of its up-bank", (char*)0, (char*)0, 20, 0, (char**)0, 0,
- (char**)0, (KmParFlag)0, KmTYPE_CHAR, (void*)0 };
-static KmParameter _DZEDIT_MAKECODE_DATAOFFSETS_CHLIST = { "CHLIST", 6,
- "File for listing", " ", (char*)0, 20, 0, (char**)0, 0, (char**)0,
- (KmParFlag)0, KmTYPE_CHAR, (void*)0 };
-static KmParameter _DZEDIT_MAKECODE_DATAOFFSETS_CHPFIX = { "CHPFIX", 6,
- "Prefix for data offset", " ", (char*)0, 20, 0, (char**)0, 0, (char**)0,
- (KmParFlag)0, KmTYPE_CHAR, (void*)0 };
-static KmParOption _DZEDIT_MAKECODE_DATAOFFSETS_CHOPTD_type = { (char**)0,
- (int*)0, (int*)0 };
-static KmParameter _DZEDIT_MAKECODE_DATAOFFSETS_CHOPTD = { "CHOPTD", 6,
- "Option, S single bank", "T", (char*)0, 20, 0, (char**)0, 0, (char**)0,
- (KmParFlag)0, KmTYPE_OPTION, &_DZEDIT_MAKECODE_DATAOFFSETS_CHOPTD_type };
-static KmParInt _DZEDIT_MAKECODE_DATAOFFSETS_IFW_type = { (char*)0,
- (char*)0, (char*)0, (char*)0, 0 };
-static KmParameter _DZEDIT_MAKECODE_DATAOFFSETS_IFW = { "IFW", 3,
- "First word", "1", (char*)0, 8, 0, (char**)0, 0, (char**)0, (KmParFlag)0,
- KmTYPE_INT, &_DZEDIT_MAKECODE_DATAOFFSETS_IFW_type };
-static KmParInt _DZEDIT_MAKECODE_DATAOFFSETS_ILW_type = { (char*)0,
- (char*)0, (char*)0, (char*)0, 0 };
-static KmParameter _DZEDIT_MAKECODE_DATAOFFSETS_ILW = { "ILW", 3, "Last word",
- "1000", (char*)0, 8, 0, (char**)0, 0, (char**)0, (KmParFlag)0, KmTYPE_INT,
- &_DZEDIT_MAKECODE_DATAOFFSETS_ILW_type };
-static KmParameter *_DZEDIT_MAKECODE_DATAOFFSETS_parameters[] = {
- &_DZEDIT_MAKECODE_DATAOFFSETS_CHBSBK, &_DZEDIT_MAKECODE_DATAOFFSETS_CHBSUP,
- &_DZEDIT_MAKECODE_DATAOFFSETS_CHLIST, &_DZEDIT_MAKECODE_DATAOFFSETS_CHPFIX,
- &_DZEDIT_MAKECODE_DATAOFFSETS_CHOPTD, &_DZEDIT_MAKECODE_DATAOFFSETS_IFW,
- &_DZEDIT_MAKECODE_DATAOFFSETS_ILW };
-static char *_DZEDIT_MAKECODE_DATAOFFSETS_guidance[] = {
- "Generate sequences of data word offsets for a selected bank (Option 'S')",
- "or bank tree (Option 'T'). The names may optionally concatenated with",
- "a max 8 character mnemonic like 'DO_'",
- "With option 'Z' CHPFIX is appended, prefixed otherwise.",
- "Option 'N' suppresses PARAMETER statements.",
- "'2' allows to skip the first 2 char in data word name. (Allowed 1-9)",
- "Option '=' (with '1')produces: IDATA4(I)=IQ(NOFF+4),",
- "the sequence: '(I)=IQ(NOFF+' may be replaced by CHPFIX",
- "Example: a data word documented like this:",
- " *B.4 IDATA4 This is the 4th data word",
- " would produce (when putting CHPFIX to 'DO_':",
- " INTEGER DO_IDATA4", " PARAMETER (DO_IDATA4=4)" };
-static KmCommand _DZEDIT_MAKECODE_DATAOFFSETS = {
- &_DZEDIT_MAKECODE_LINKOFFSETS, "/DZEDIT/MAKECODE/DATAOFFSETS", "DATAOFFSETS",
- 0, 2, 7, 2, _DZEDIT_MAKECODE_DATAOFFSETS_parameters, 0, 0, dzedof_,
- (IntFunc*)0, (SUBROUTINE*)0, (IntFunc*)0, 13,
- _DZEDIT_MAKECODE_DATAOFFSETS_guidance, 0, (char**)0, (char*)0, (int*)0 };
-
-static char *_DZEDIT_MAKECODE_guidance[] = {
- "Generate PATCHY KEEP sequences containing FORTRAN code. With option",
- "'S' only the selected bank is treated, with option 'T' all banks",
- "in the selected tree are treated. The KEEP sequences are named",
- "with the hollerith Ids of the bank(trees) prefixed by mnemonics",
- "like BOOK, LKOFF, DAOFF etc." };
-static KmMenu _DZEDIT_MAKECODE = { (KmMenu*)0, (KmMenu*)0,
- "/DZEDIT/MAKECODE", "MAKECODE", 2, &_DZEDIT_MAKECODE_DATAOFFSETS, 5,
- _DZEDIT_MAKECODE_guidance };
-static char *_DZEDIT_DZEQUIT_guidance[] = {
- "Set flag to quit when returning from exec dzedit.kumac" };
-static KmCommand _DZEDIT_DZEQUIT = { (KmCommand*)0, "/DZEDIT/DZEQUIT",
- "DZEQUIT", 0, 1, 0, 0, (KmParameter**)0, 0, 0, dzeqit_, (IntFunc*)0,
- (SUBROUTINE*)0, (IntFunc*)0, 1, _DZEDIT_DZEQUIT_guidance, 0, (char**)0,
- (char*)0, (int*)0 };
-
-static KmParOption _DZEDIT_DZDIRZ_CHOPT_type = { (char**)0, (int*)0, (int*)0 };
-static KmParameter _DZEDIT_DZDIRZ_CHOPT = { "CHOPT", 5,
- "Options: C = use Color", " ", (char*)0, 20, 0, (char**)0, 0, (char**)0,
- (KmParFlag)0, KmTYPE_OPTION, &_DZEDIT_DZDIRZ_CHOPT_type };
-static KmParameter *_DZEDIT_DZDIRZ_parameters[] = { &_DZEDIT_DZDIRZ_CHOPT };
-static char *_DZEDIT_DZDIRZ_guidance[] = {
- "Call DZDIRZ, display RZ-directory tree" };
-static KmCommand _DZEDIT_DZDIRZ = { &_DZEDIT_DZEQUIT, "/DZEDIT/DZDIRZ",
- "DZDIRZ", 0, 1, 1, 0, _DZEDIT_DZDIRZ_parameters, 0, 0, dzedsp_, (IntFunc*)0,
- (SUBROUTINE*)0, (IntFunc*)0, 1, _DZEDIT_DZDIRZ_guidance, 0, (char**)0,
- (char*)0, (int*)0 };
-
-static KmParOption _DZEDIT_DZDDIV_CHOPT_type = { (char**)0, (int*)0, (int*)0 };
-static KmParameter _DZEDIT_DZDDIV_CHOPT = { "CHOPT", 5,
- "Options: C = use Color", " ", (char*)0, 20, 0, (char**)0, 0, (char**)0,
- (KmParFlag)0, KmTYPE_OPTION, &_DZEDIT_DZDDIV_CHOPT_type };
-static KmParameter *_DZEDIT_DZDDIV_parameters[] = { &_DZEDIT_DZDDIV_CHOPT };
-static char *_DZEDIT_DZDDIV_guidance[] = { "Call DZDDIV" };
-static KmCommand _DZEDIT_DZDDIV = { &_DZEDIT_DZDIRZ, "/DZEDIT/DZDDIV",
- "DZDDIV", 0, 1, 1, 0, _DZEDIT_DZDDIV_parameters, 0, 0, dzedsp_, (IntFunc*)0,
- (SUBROUTINE*)0, (IntFunc*)0, 1, _DZEDIT_DZDDIV_guidance, 0, (char**)0,
- (char*)0, (int*)0 };
-
-static KmParOption _DZEDIT_DZDISP_CHOPT_type = { (char**)0, (int*)0, (int*)0 };
-static KmParameter _DZEDIT_DZDISP_CHOPT = { "CHOPT", 5,
- "Options: C = use Color", " ", (char*)0, 20, 0, (char**)0, 0, (char**)0,
- (KmParFlag)0, KmTYPE_OPTION, &_DZEDIT_DZDISP_CHOPT_type };
-static KmParameter *_DZEDIT_DZDISP_parameters[] = { &_DZEDIT_DZDISP_CHOPT };
-static char *_DZEDIT_DZDISP_guidance[] = {
- "Display the last generated tree if graphics is available. Note",
- "that the number of data words is three for each bank. Their",
- "contents indicates the documented number of data words and links.",
- "Use option C to get colored display." };
-static KmCommand _DZEDIT_DZDISP = { &_DZEDIT_DZDDIV, "/DZEDIT/DZDISP",
- "DZDISP", 0, 1, 1, 0, _DZEDIT_DZDISP_parameters, 0, 0, dzedsp_, (IntFunc*)0,
- (SUBROUTINE*)0, (IntFunc*)0, 4, _DZEDIT_DZDISP_guidance, 0, (char**)0,
- (char*)0, (int*)0 };
-
-static KmParameter _DZEDIT_DRAWALL_CHMETA = { "CHMETA", 6,
- "Name of temp plot file", " ", (char*)0, 20, 0, (char**)0, 0, (char**)0,
- (KmParFlag)0, KmTYPE_CHAR, (void*)0 };
-static KmParameter _DZEDIT_DRAWALL_CHSGML = { "CHSGML", 6,
- "Name of temp text-file", " ", (char*)0, 20, 0, (char**)0, 0, (char**)0,
- (KmParFlag)0, KmTYPE_CHAR, (void*)0 };
-static KmParameter _DZEDIT_DRAWALL_CHPOST = { "CHPOST", 6,
- "Name of PostScript file", " ", (char*)0, 20, 0, (char**)0, 0, (char**)0,
- (KmParFlag)0, KmTYPE_CHAR, (void*)0 };
-static KmParOption _DZEDIT_DRAWALL_CHOPT_type = { (char**)0, (int*)0, (int*)0
- };
-static KmParameter _DZEDIT_DRAWALL_CHOPT = { "CHOPT", 5,
- "Output:P=PostScript, L=Latex, N nocheck) ", " ", (char*)0, 20, 0, (char**)0,
- 0, (char**)0, (KmParFlag)0, KmTYPE_OPTION, &_DZEDIT_DRAWALL_CHOPT_type };
-static KmParameter _DZEDIT_DRAWALL_CTITLE = { "CTITLE", 6, "Global title",
- "ZEBRA-Datastructures", (char*)0, 20, 0, (char**)0, 0, (char**)0,
- (KmParFlag)0, KmTYPE_CHAR, (void*)0 };
-static KmParameter *_DZEDIT_DRAWALL_parameters[] = { &_DZEDIT_DRAWALL_CHMETA,
- &_DZEDIT_DRAWALL_CHSGML, &_DZEDIT_DRAWALL_CHPOST, &_DZEDIT_DRAWALL_CHOPT,
- &_DZEDIT_DRAWALL_CTITLE };
-static char *_DZEDIT_DRAWALL_guidance[] = {
- "Draw tree below all top banks (i.e. banks having 'NONE' as",
- "Up-bank. This also checks the consistency and completeness",
- "of the documentation if option 'N' is not given.", "Output option:",
- " 'P' or ' ' PostScript file",
- " 'L' Latex file",
- " 'Q' no output (check only)",
- " 'S' suppress confirmation",
- " 'M' Put as many down banks as posibble on one picture",
- " (Per default 2nd level are only drawn if all fit)" };
-static KmCommand _DZEDIT_DRAWALL = { &_DZEDIT_DZDISP, "/DZEDIT/DRAWALL",
- "DRAWALL", 0, 1, 5, 0, _DZEDIT_DRAWALL_parameters, 0, 0, dzedra_,
- (IntFunc*)0, (SUBROUTINE*)0, (IntFunc*)0, 10, _DZEDIT_DRAWALL_guidance, 0,
- (char**)0, (char*)0, (int*)0 };
-
-static KmParameter _DZEDIT_DRAWONETREE_CHBSBK = { "CHBSBK", 6,
- "Hollerith Id of selected bank", (char*)0, (char*)0, 20, 0, (char**)0, 0,
- (char**)0, (KmParFlag)0, KmTYPE_CHAR, (void*)0 };
-static KmParameter _DZEDIT_DRAWONETREE_CHBSUP = { "CHBSUP", 6,
- "Hollerith Id of its up-bank", (char*)0, (char*)0, 20, 0, (char**)0, 0,
- (char**)0, (KmParFlag)0, KmTYPE_CHAR, (void*)0 };
-static KmParameter _DZEDIT_DRAWONETREE_CHMETA = { "CHMETA", 6,
- "Name of temp plot file", " ", (char*)0, 20, 0, (char**)0, 0, (char**)0,
- (KmParFlag)0, KmTYPE_CHAR, (void*)0 };
-static KmParameter _DZEDIT_DRAWONETREE_CHSGML = { "CHSGML", 6,
- "Name of temp text-file", " ", (char*)0, 20, 0, (char**)0, 0, (char**)0,
- (KmParFlag)0, KmTYPE_CHAR, (void*)0 };
-static KmParameter _DZEDIT_DRAWONETREE_CHPOST = { "CHPOST", 6,
- "Name of PostScript file", " ", (char*)0, 20, 0, (char**)0, 0, (char**)0,
- (KmParFlag)0, KmTYPE_CHAR, (void*)0 };
-static KmParOption _DZEDIT_DRAWONETREE_CHOPT_type = { (char**)0, (int*)0,
- (int*)0 };
-static KmParameter _DZEDIT_DRAWONETREE_CHOPT = { "CHOPT", 5,
- "Option (P=PostScript L=Latex) ", " ", (char*)0, 20, 0, (char**)0, 0,
- (char**)0, (KmParFlag)0, KmTYPE_OPTION, &_DZEDIT_DRAWONETREE_CHOPT_type };
-static KmParameter _DZEDIT_DRAWONETREE_CTITLE = { "CTITLE", 6, "Global title",
- "ZEBRA-Datastructures", (char*)0, 20, 0, (char**)0, 0, (char**)0,
- (KmParFlag)0, KmTYPE_CHAR, (void*)0 };
-static KmParameter *_DZEDIT_DRAWONETREE_parameters[] = {
- &_DZEDIT_DRAWONETREE_CHBSBK, &_DZEDIT_DRAWONETREE_CHBSUP,
- &_DZEDIT_DRAWONETREE_CHMETA, &_DZEDIT_DRAWONETREE_CHSGML,
- &_DZEDIT_DRAWONETREE_CHPOST, &_DZEDIT_DRAWONETREE_CHOPT,
- &_DZEDIT_DRAWONETREE_CTITLE };
-static char *_DZEDIT_DRAWONETREE_guidance[] = {
- "Draw tree below a selected bank. All banks belonging to the",
- "tree will be actually lifted in memory each with three data",
- "words. Word 1, 2, 3 are the number of data words, links and",
- "structural links as described in the documentation, a -1 indicates",
- "a variable number. A global title may be given which appears",
- "on the front page of the document.", "Output option:",
- " 'P' PostScript file (default)",
- " 'L' Latex file",
- " 'Q' quiet i.e. generate no output files",
- " 'C' check consistency",
- " 'M' Put as many down banks as posibble on one picture",
- " (Per default 2nd level are only drawn if all fit)" };
-static KmCommand _DZEDIT_DRAWONETREE = { &_DZEDIT_DRAWALL,
- "/DZEDIT/DRAWONETREE", "DRAWONETREE", 0, 1, 7, 2,
- _DZEDIT_DRAWONETREE_parameters, 0, 0, dzedrw_, (IntFunc*)0, (SUBROUTINE*)0,
- (IntFunc*)0, 13, _DZEDIT_DRAWONETREE_guidance, 0, (char**)0, (char*)0,
- (int*)0 };
-
-static KmParameter _DZEDIT_LISTALL_CHLIST = { "CHLIST", 6, "File for listing",
- " ", (char*)0, 20, 0, (char**)0, 0, (char**)0, (KmParFlag)0, KmTYPE_CHAR,
- (void*)0 };
-static KmParameter _DZEDIT_LISTALL_CHLOPT = { "CHLOPT", 6,
- "List option: P=PostScript, I=Input", " ", (char*)0, 20, 0, (char**)0, 0,
- (char**)0, (KmParFlag)0, KmTYPE_CHAR, (void*)0 };
-static char *_DZEDIT_LISTALL_CHOYNO_range[] = { "NO", "YES" };
-static KmParameter _DZEDIT_LISTALL_CHOYNO = { "CHOYNO", 6,
- "List all cycles ", "NO", (char*)0, 8, 2, _DZEDIT_LISTALL_CHOYNO_range, 2,
- _DZEDIT_LISTALL_CHOYNO_range, (KmParFlag)0, KmTYPE_CHAR, (void*)0 };
-static KmParInt _DZEDIT_LISTALL_IDATCH_type = { (char*)0, (char*)0,
- (char*)0, (char*)0, 0 };
-static KmParameter _DZEDIT_LISTALL_IDATCH = { "IDATCH", 6,
- "List only after date", "0", (char*)0, 8, 0, (char**)0, 0, (char**)0,
- (KmParFlag)0, KmTYPE_INT, &_DZEDIT_LISTALL_IDATCH_type };
-static KmParameter *_DZEDIT_LISTALL_parameters[] = { &_DZEDIT_LISTALL_CHLIST,
- &_DZEDIT_LISTALL_CHLOPT, &_DZEDIT_LISTALL_CHOYNO, &_DZEDIT_LISTALL_IDATCH };
-static char *_DZEDIT_LISTALL_guidance[] = {
- "List documentation for all banks", "List option:",
- " 'P' PostScript file (default: simple text file)",
- " 'I' use format of the bank descriptor cards",
- " (i.e. Input to CREATEDOC)" };
-static KmCommand _DZEDIT_LISTALL = { &_DZEDIT_DRAWONETREE, "/DZEDIT/LISTALL",
- "LISTALL", 0, 1, 4, 0, _DZEDIT_LISTALL_parameters, 0, 0, dzelal_,
- (IntFunc*)0, (SUBROUTINE*)0, (IntFunc*)0, 5, _DZEDIT_LISTALL_guidance, 0,
- (char**)0, (char*)0, (int*)0 };
-
-static KmParameter _DZEDIT_LISTONEBANK_CHBSBK = { "CHBSBK", 6,
- "Hollerith Id of selected bank", (char*)0, (char*)0, 20, 0, (char**)0, 0,
- (char**)0, (KmParFlag)0, KmTYPE_CHAR, (void*)0 };
-static KmParameter _DZEDIT_LISTONEBANK_CHBSUP = { "CHBSUP", 6,
- "Hollerith Id of its up-bank", (char*)0, (char*)0, 20, 0, (char**)0, 0,
- (char**)0, (KmParFlag)0, KmTYPE_CHAR, (void*)0 };
-static KmParameter _DZEDIT_LISTONEBANK_CHLIST = { "CHLIST", 6,
- "File for listing", " ", (char*)0, 20, 0, (char**)0, 0, (char**)0,
- (KmParFlag)0, KmTYPE_CHAR, (void*)0 };
-static KmParameter _DZEDIT_LISTONEBANK_CHLOPT = { "CHLOPT", 6,
- "List option: P=PostScript, I=Input", " ", (char*)0, 20, 0, (char**)0, 0,
- (char**)0, (KmParFlag)0, KmTYPE_CHAR, (void*)0 };
-static char *_DZEDIT_LISTONEBANK_CHOYNO_range[] = { "NO", "YES" };
-static KmParameter _DZEDIT_LISTONEBANK_CHOYNO = { "CHOYNO", 6,
- "List all cycles ", "NO", (char*)0, 8, 2,
- _DZEDIT_LISTONEBANK_CHOYNO_range, 2, _DZEDIT_LISTONEBANK_CHOYNO_range,
- (KmParFlag)0, KmTYPE_CHAR, (void*)0 };
-static KmParInt _DZEDIT_LISTONEBANK_IDATCH_type = { (char*)0, (char*)0,
- (char*)0, (char*)0, 0 };
-static KmParameter _DZEDIT_LISTONEBANK_IDATCH = { "IDATCH", 6,
- "List only after date", "0", (char*)0, 8, 0, (char**)0, 0, (char**)0,
- (KmParFlag)0, KmTYPE_INT, &_DZEDIT_LISTONEBANK_IDATCH_type };
-static KmParameter *_DZEDIT_LISTONEBANK_parameters[] = {
- &_DZEDIT_LISTONEBANK_CHBSBK, &_DZEDIT_LISTONEBANK_CHBSUP,
- &_DZEDIT_LISTONEBANK_CHLIST, &_DZEDIT_LISTONEBANK_CHLOPT,
- &_DZEDIT_LISTONEBANK_CHOYNO, &_DZEDIT_LISTONEBANK_IDATCH };
-static char *_DZEDIT_LISTONEBANK_guidance[] = {
- "List documentation for a selected bank or a group of banks.",
- "An '*' (asterix) may be used as wild card character.",
- "Exactly two times 4 characters are needed to define bank and up-bank.",
- "only the last cycle of one entry is listed regardless of its date.",
- "List of all cycles or selection by date of entering the RZ-file may",
- "also be choosen. The date is an integer of the form YYMMDD.",
- "List option:", " 'P' PostScript file (default: simple text file)",
- " 'I' use format of the bank descriptor cards",
- " (i.e. Input to CREATEDOC)" };
-static KmCommand _DZEDIT_LISTONEBANK = { &_DZEDIT_LISTALL,
- "/DZEDIT/LISTONEBANK", "LISTONEBANK", 0, 1, 6, 2,
- _DZEDIT_LISTONEBANK_parameters, 0, 0, dzelsg_, (IntFunc*)0, (SUBROUTINE*)0,
- (IntFunc*)0, 10, _DZEDIT_LISTONEBANK_guidance, 0, (char**)0, (char*)0,
- (int*)0 };
-
-static KmParameter _DZEDIT_LISTDIRECTORY_CHRZF = { "CHRZF", 5,
- "Input RZ-file", (char*)0, (char*)0, 20, 0, (char**)0, 0, (char**)0,
- (KmParFlag)0, KmTYPE_CHAR, (void*)0 };
-static KmParameter *_DZEDIT_LISTDIRECTORY_parameters[] = {
- &_DZEDIT_LISTDIRECTORY_CHRZF };
-static char *_DZEDIT_LISTDIRECTORY_guidance[] = {
- "List directory of an existing RZ-file" };
-static KmCommand _DZEDIT_LISTDIRECTORY = { &_DZEDIT_LISTONEBANK,
- "/DZEDIT/LISTDIRECTORY", "LISTDIRECTORY", 0, 1, 1, 1,
- _DZEDIT_LISTDIRECTORY_parameters, 0, 0, dzedrz_, (IntFunc*)0, (SUBROUTINE*)0,
- (IntFunc*)0, 1, _DZEDIT_LISTDIRECTORY_guidance, 0, (char**)0, (char*)0,
- (int*)0 };
-
-static KmParameter _DZEDIT_DELETEKEY_CHBSBK = { "CHBSBK", 6,
- "Hollerith Id of selected bank", (char*)0, (char*)0, 20, 0, (char**)0, 0,
- (char**)0, (KmParFlag)0, KmTYPE_CHAR, (void*)0 };
-static KmParameter _DZEDIT_DELETEKEY_CHBSUP = { "CHBSUP", 6,
- "Hollerith Id of its up-bank", (char*)0, (char*)0, 20, 0, (char**)0, 0,
- (char**)0, (KmParFlag)0, KmTYPE_CHAR, (void*)0 };
-static KmParInt _DZEDIT_DELETEKEY_ICYCLE_type = { (char*)0, (char*)0,
- (char*)0, (char*)0, 0 };
-static KmParameter _DZEDIT_DELETEKEY_ICYCLE = { "ICYCLE", 6, "Cycle number",
- "0", (char*)0, 8, 0, (char**)0, 0, (char**)0, (KmParFlag)0, KmTYPE_INT,
- &_DZEDIT_DELETEKEY_ICYCLE_type };
-static KmParameter _DZEDIT_DELETEKEY_CHDOPT = { "CHDOPT", 6, "Delete option",
- "C", (char*)0, 20, 0, (char**)0, 0, (char**)0, (KmParFlag)0, KmTYPE_CHAR,
- (void*)0 };
-static KmParameter *_DZEDIT_DELETEKEY_parameters[] = {
- &_DZEDIT_DELETEKEY_CHBSBK, &_DZEDIT_DELETEKEY_CHBSUP,
- &_DZEDIT_DELETEKEY_ICYCLE, &_DZEDIT_DELETEKEY_CHDOPT };
-static char *_DZEDIT_DELETEKEY_guidance[] = {
- "Delete a key specifying BankId and UpBankId and cycle number.",
- " ICYCLE >= highest: delete highest cycle,",
- " = 0: delete lowest cycle,",
- " = -1, -2 : delete highest-1, -2..", "Options:",
- " 'C': delete all cycles", " 'K': delete all keys,",
- " 'S': delete all cycles smaller ICYCLE.",
- " (See also ZEBRA users guide: RZDELK)" };
-static KmCommand _DZEDIT_DELETEKEY = { &_DZEDIT_LISTDIRECTORY,
- "/DZEDIT/DELETEKEY", "DELETEKEY", 0, 1, 4, 2, _DZEDIT_DELETEKEY_parameters,
- 0, 0, dzedel_, (IntFunc*)0, (SUBROUTINE*)0, (IntFunc*)0, 9,
- _DZEDIT_DELETEKEY_guidance, 0, (char**)0, (char*)0, (int*)0 };
-
-static KmParInt _DZEDIT_PURGEKEY_NKEEP_type = { (char*)0, (char*)0,
- (char*)0, (char*)0, 0 };
-static KmParameter _DZEDIT_PURGEKEY_NKEEP = { "NKEEP", 5,
- "Number of cycles to be kept", "-1", (char*)0, 8, 0, (char**)0, 0, (char**)0,
- (KmParFlag)0, KmTYPE_INT, &_DZEDIT_PURGEKEY_NKEEP_type };
-static KmParameter *_DZEDIT_PURGEKEY_parameters[] = { &_DZEDIT_PURGEKEY_NKEEP
- };
-static char *_DZEDIT_PURGEKEY_guidance[] = {
- "Purge cycles of all keys keeping the last NKEEP.",
- "If NKEEP < 0 keep just the highest cycle." };
-static KmCommand _DZEDIT_PURGEKEY = { &_DZEDIT_DELETEKEY, "/DZEDIT/PURGEKEY",
- "PURGEKEY", 0, 1, 1, 0, _DZEDIT_PURGEKEY_parameters, 0, 0, dzepur_,
- (IntFunc*)0, (SUBROUTINE*)0, (IntFunc*)0, 2, _DZEDIT_PURGEKEY_guidance, 0,
- (char**)0, (char*)0, (int*)0 };
-
-static char *_DZEDIT_CLOSERZFILE_guidance[] = { "Close an open RZ-file." };
-static KmCommand _DZEDIT_CLOSERZFILE = { &_DZEDIT_PURGEKEY,
- "/DZEDIT/CLOSERZFILE", "CLOSERZFILE", 0, 1, 0, 0, (KmParameter**)0, 0, 0,
- dzdcld_, (IntFunc*)0, (SUBROUTINE*)0, (IntFunc*)0, 1,
- _DZEDIT_CLOSERZFILE_guidance, 0, (char**)0, (char*)0, (int*)0 };
-
-static KmParameter _DZEDIT_OPENRZFILE_CHRZF = { "CHRZF", 5, "Input RZ-file",
- (char*)0, (char*)0, 20, 0, (char**)0, 0, (char**)0, (KmParFlag)0,
- KmTYPE_CHAR, (void*)0 };
-static KmParameter _DZEDIT_OPENRZFILE_CHOOPT = { "CHOOPT", 6,
- "Option for RZFILE (U=Update)", "X", (char*)0, 20, 0, (char**)0, 0,
- (char**)0, (KmParFlag)0, KmTYPE_CHAR, (void*)0 };
-static KmParameter *_DZEDIT_OPENRZFILE_parameters[] = {
- &_DZEDIT_OPENRZFILE_CHRZF, &_DZEDIT_OPENRZFILE_CHOOPT };
-static char *_DZEDIT_OPENRZFILE_guidance[] = {
- "Open an existing RZ-file for later use with list/draw/export commands",
- "(the file will be READONLY unless the 'U'=update option is given)" };
-static KmCommand _DZEDIT_OPENRZFILE = { &_DZEDIT_CLOSERZFILE,
- "/DZEDIT/OPENRZFILE", "OPENRZFILE", 0, 1, 2, 1,
- _DZEDIT_OPENRZFILE_parameters, 0, 0, dzeopl_, (IntFunc*)0, (SUBROUTINE*)0,
- (IntFunc*)0, 2, _DZEDIT_OPENRZFILE_guidance, 0, (char**)0, (char*)0, (int*)0
- };
-
-static KmParameter _DZEDIT_UPDATEDOC_CHCARD = { "CHCARD", 6,
- "Input card image file", (char*)0, (char*)0, 20, 0, (char**)0, 0, (char**)0,
- (KmParFlag)0, KmTYPE_CHAR, (void*)0 };
-static KmParameter _DZEDIT_UPDATEDOC_CHRZF = { "CHRZF", 5, "Output RZ-file",
- (char*)0, (char*)0, 20, 0, (char**)0, 0, (char**)0, (KmParFlag)0,
- KmTYPE_CHAR, (void*)0 };
-static KmParameter _DZEDIT_UPDATEDOC_CHSUBD = { "CHSUBD", 6,
- "Subdirectory name (blank=topdir)", (char*)0, (char*)0, 20, 0, (char**)0, 0,
- (char**)0, (KmParFlag)0, KmTYPE_CHAR, (void*)0 };
-static KmParameter *_DZEDIT_UPDATEDOC_parameters[] = {
- &_DZEDIT_UPDATEDOC_CHCARD, &_DZEDIT_UPDATEDOC_CHRZF,
- &_DZEDIT_UPDATEDOC_CHSUBD };
-static char *_DZEDIT_UPDATEDOC_guidance[] = {
- "Update an existing RZ-file with new documentation, this command",
- "can also be used to put the documentation into any subdirectory",
- "of an existing RZ-file." };
-static KmCommand _DZEDIT_UPDATEDOC = { &_DZEDIT_OPENRZFILE,
- "/DZEDIT/UPDATEDOC", "UPDATEDOC", 0, 1, 3, 2, _DZEDIT_UPDATEDOC_parameters,
- 0, 0, dzeurz_, (IntFunc*)0, (SUBROUTINE*)0, (IntFunc*)0, 3,
- _DZEDIT_UPDATEDOC_guidance, 0, (char**)0, (char*)0, (int*)0 };
-
-static KmParameter _DZEDIT_CREATEDOC_CHCARD = { "CHCARD", 6,
- "Input card image file", (char*)0, (char*)0, 20, 0, (char**)0, 0, (char**)0,
- (KmParFlag)0, KmTYPE_CHAR, (void*)0 };
-static KmParameter _DZEDIT_CREATEDOC_CHRZF = { "CHRZF", 5, "Output RZ-file",
- (char*)0, (char*)0, 20, 0, (char**)0, 0, (char**)0, (KmParFlag)0,
- KmTYPE_CHAR, (void*)0 };
-static KmParameter *_DZEDIT_CREATEDOC_parameters[] = {
- &_DZEDIT_CREATEDOC_CHCARD, &_DZEDIT_CREATEDOC_CHRZF };
-static char *_DZEDIT_CREATEDOC_guidance[] = {
- "Create a new RZ-file from documentation card image file" };
-static KmCommand _DZEDIT_CREATEDOC = { &_DZEDIT_UPDATEDOC,
- "/DZEDIT/CREATEDOC", "CREATEDOC", 0, 1, 2, 2, _DZEDIT_CREATEDOC_parameters,
- 0, 0, dzemrz_, (IntFunc*)0, (SUBROUTINE*)0, (IntFunc*)0, 1,
- _DZEDIT_CREATEDOC_guidance, 0, (char**)0, (char*)0, (int*)0 };
-
-static char *_DZEDIT_guidance[] = { "Maintain the DZDOC data base" };
-static KmMenu _DZEDIT = { (KmMenu*)0, &_DZEDIT_MAKECODE, "/DZEDIT", "DZEDIT",
- 1, &_DZEDIT_CREATEDOC, 1, _DZEDIT_guidance };
- klnkmenu( &_DZEDIT, 921023 );
-}
-
-
diff --git a/src/graflib/higz/Imakefile b/src/graflib/higz/Imakefile
deleted file mode 100644
index 5207d03..0000000
--- a/src/graflib/higz/Imakefile
+++ /dev/null
@@ -1,27 +0,0 @@
-DoIncludePackage(higz)
-
-#define IHaveSubdirs
-#define PassCDebugFlags
-
-
-LIBDIRS= iz ig ig3 ih ipost ifalco menu ged ikernel higzcc
-
-SUBDIRS= $(LIBDIRS) examples igks higz
-
-TopOfPackage(higzX11)
-
-SubdirLibraryTarget(grafX11,$(LIBDIRS))
-
-InstallLibrary(grafX11,$(CERN_LIBDIR))
-
-TestSubdirs(examples)
-
-#ifdef CERNLIB_VAXVMS
-tree grafdgks install.lib:: Makefile.dgks
-BuildNamedMakefileTarget(Makefile.dgks,Imakefile.dgks,-DCERNLIB_DECGKS)
-NamedTargetSubdirs(tree,./,checking,-f Makefile.dgks,tree)
-NamedTargetSubdirs(grafdgks,./,building grafdgks,-f Makefile.dgks,grafdgks)
-NamedTargetSubdirs(install.lib,./,installing grafdgks,-f Makefile.dgks,install.lib)
-#endif
-
-InstallIncludeSubdirs(higz)
diff --git a/src/graflib/higz/Imakefile.dgks b/src/graflib/higz/Imakefile.dgks
deleted file mode 100644
index eb0cec9..0000000
--- a/src/graflib/higz/Imakefile.dgks
+++ /dev/null
@@ -1,23 +0,0 @@
-DoIncludePackage(higz)
-
-/* include rules for subdirs explicitely #define IHaveSubdirs
- */
-
-#define PassCDebugFlags
-
-IMAKE_DEFINES= -DCERNLIB_DECGKS
-
-LIBDIRS= iz ig ig3 ih ipost menu ged igks higzcc
-
-SUBDIRS= $(LIBDIRS)
-
-TopOfPackage(higzdgks)
-
-SubdirExtraLibraryTarget(grafdgks,NullParameter,$(LIBDIRS),dgks)
-
-InstallLibrary(grafdgks,$(CERN_LIBDIR))
-
-MakeSubdirsNamedMakefiles($(SUBDIRS),tree,dgks)
-
-BuildNamedMakefileTarget(Makefile.dgks,Imakefile.dgks,-DCERNLIB_DECGKS)
-
diff --git a/src/graflib/higz/doc/Versions/v1_02 b/src/graflib/higz/doc/Versions/v1_02
deleted file mode 100644
index c0e1284..0000000
--- a/src/graflib/higz/doc/Versions/v1_02
+++ /dev/null
@@ -1,112 +0,0 @@
-*
-* $Id: v1_02,v 1.1.1.1 1996/02/14 13:10:20 mclareni Exp $
-*
-* $Log: v1_02,v $
-* Revision 1.1.1.1 1996/02/14 13:10:20 mclareni
-* Higz
-*
-*
-*CMZ : 09/02/95 15.51.10 by O.Couet
-*-- Author :
-*
-*::> VERSION 1.02/00 880420
-*
-* 27/03/87 New version of IZMERG the option 'D' is available
-*
-* 27/03/87 The routine IRQLC fills the COMMON /QUEST/ with the window
-* and viewport parameters. For more precision see the comments
-* at the beginning of the routine
-*
-* 30/03/87 New version of IGAXIS with beautiful ticks marks and labels
-*
-* 01/04/87 A new version of IZMERG
-*
-* 02/04/87 First implementation of IGRAPH
-*
-* 06/04/87 New format in the option SHOW in IGSET
-*
-* 07/04/87 Correction of IGARC in case of R1=R2 and PHIMIN=PHIMAX
-*
-* 13/04/87 Corrections for IBM/VM
-*
-* 13/04/87 New version of IGRAPH for Fill Area
-*
-* 13/04/87 New picture structure : Control bank.
-*
-* 16/04/87 The routine IGSA is implemented
-*
-* 21/04/87 New internal coding of the control bank
-*
-* 22/04/87 Polyline with two points and marker with one point are stored
-* in a compact way
-*
-* 23/04/87 Line type from 12 to 15 are available . They are independent from
-* the basic graphics package . For this line types the Basic Segment
-* Length may be sets with the routine IGSET
-*
-* 11/05/87 Implementation of the routines IGSG and IGSA for IBM
-*
-* 20/05/87 First version of IGPIE
-*
-* 27/05/87 Modifications for the GTS_GRAL version of GKS
-*
-* 27/05/87 The routine IGRNG is available. This routine maps the workstation
-* window onto the whole screen and select the normalization
-* transformation number 1 according to the XSIZ and YSIZ parameters
-*
-* 12/06/87 Mods in IGAXIS to solve rounding problems for log axis
-*
-* 17/06/87 New error routine IGERR
-*
-* 18/06/87 Bar charts implemented in IGRAPH (option "B")
-*
-* 26/06/87 Changes in routine IGMETA (variable IWTYPE was reset!)
-*
-* 30/06/87 Bug corrected in IZPICT when GFLAG=.FALSE.
-*
-* 02/07/87 Bug corrected when ZFLAG=.TRUE. and GFLAG=.FALSE.
-*
-* 16/07/87 Bars attributes in IGRAPH are now stored in the data structure.
-*
-* 29/07/87 RBOF,RBWD are returned in RQUEST(1) and RQUEST(2) after a call
-* to IGRAPH with option 'B'
-*
-* 06/08/87 Some bugs in IGRAPH are corrected
-*
-* 10/08/87 New version of IGRAPH with new options "L" and "M"
-*
-* 12/08/87 IZGRAP corrected according to the new version of IGRAPH
-*
-* 13/08/87 IGRAPH is now IGHIST (cf. doc) and IZGRAP is now IZHIST.
-* The old option "A" is now the option "F" for "Fill area"
-*
-* 13/08/87 The angle of IGARC are now in degrees
-*
-* 20/08/87 Changes in IGAXIS (temporary variable CHTEMP)
-*
-* 28/09/87 New version of IGAXIS: option I (Integer labeling). Correction
-* in IGSET : BARO can be .LT.0.
-*
-* 05/10/87 The routines IGSA and IGSG have the "Workstation Type" as input
-* parameter.
-*
-* 20/10/87 The routine IZRIOS is replaced by the routines IZIN, IZOUT, IZSCR
-*
-* 28/10/87 This file contains now the PATCH MENU and the PATCH GED
-*
-* 30/11/87 A priority system is available between the normalization
-* transformation. The last selected transformation by ISELNT
-* has the higher priority. In case of overlaping of the
-* transformations the transformations with the higher priority
-* is choosen by IRQLC .
-*
-* 04/01/88 Modifications to IGRAP1. Normalization in X and Y
-*
-* 04/03/88 Mods in the IZ routine (IZHIST)
-*
-* 30/03/88 Bug corrected in IPM
-*
-* 18/04/88 Changes in HICDES to run on CRAY
-*
-* 24/05/88 Mods in IGMETA
-*
diff --git a/src/graflib/higz/doc/Versions/v1_03 b/src/graflib/higz/doc/Versions/v1_03
deleted file mode 100644
index 12ef594..0000000
--- a/src/graflib/higz/doc/Versions/v1_03
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: v1_03,v 1.1.1.1 1996/02/14 13:10:20 mclareni Exp $
-*
-* $Log: v1_03,v $
-* Revision 1.1.1.1 1996/02/14 13:10:20 mclareni
-* Higz
-*
-*
-*CMZ : 09/02/95 15.51.10 by O.Couet
-*-- Author :
-*
-*::> VERSION 1.03/00 880906
-*
-* Changes in IGINIT and IGEND
-* Structure for GMR,UISDC,DI3000 versions introduced.
-* New patches IGKS,IGMR,IGKS3D
-* New PILOT patches for master versions.
-* ZEBRA flag introduced (if Z option not wanted)
-* The new attribute: Axis Wire Length is reachable via IGSET
-* PATCH,HIGZEXAM introduced
-*
diff --git a/src/graflib/higz/doc/Versions/v1_04 b/src/graflib/higz/doc/Versions/v1_04
deleted file mode 100644
index 2e66cd6..0000000
--- a/src/graflib/higz/doc/Versions/v1_04
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: v1_04,v 1.1.1.1 1996/02/14 13:10:20 mclareni Exp $
-*
-* $Log: v1_04,v $
-* Revision 1.1.1.1 1996/02/14 13:10:20 mclareni
-* Higz
-*
-*
-*CMZ : 09/02/95 15.51.10 by O.Couet
-*-- Author :
-*
-*::> VERSION 1.04/00 881104
-*
-* New routine IUWK
-* Changes in IGRNG (call to IUWK)
-* IPM changed to GPM in routine IPL (recursivity from IPM)
-* Bug corrected in IZSCHU.
-* DECGKS version introduced.
-* PostScript Interface introduced (-111=Portrait -112=Landscape).
-* Character height and position of the PostScript Font are OK.
-* Minor bugs corrected.
-* Bugs corrected in IZGED in order to be called in STYLE G of PAW
-* The alphanumeric axis labels are now stored in the ZEBRA structure
-* The clipping is supported in the PostScript interface
-* The menu position in IGMENU are given in % of the screen size
-* Improvement in IGMENU and IZGED (Menu FILES introduced).
-* Line width introduced in IZGED
-* Bug corrected in IGAXIS in case of NDIV.LE.3
-* Bug corrected in IGSET if AWLN<0
-* Error with a local ZEBRA link corrected in IZGED
-* Bug corrected in IZLBL
-* New option 'M' in IGAXIS
-*
diff --git a/src/graflib/higz/doc/Versions/v1_05 b/src/graflib/higz/doc/Versions/v1_05
deleted file mode 100644
index 9a70657..0000000
--- a/src/graflib/higz/doc/Versions/v1_05
+++ /dev/null
@@ -1,77 +0,0 @@
-*
-* $Id: v1_05,v 1.1.1.1 1996/02/14 13:10:20 mclareni Exp $
-*
-* $Log: v1_05,v $
-* Revision 1.1.1.1 1996/02/14 13:10:20 mclareni
-* Higz
-*
-*
-*CMZ : 10/07/91 19.40.26 by Rene Brun
-*-- Author :
-*
-*
- Routine PAWWID deleted. Replaced by HIGZ routine IGWKTY
-*
-*::> VERSION 1.05/04 890403 8.30
-*
-* New menu /NETWORK with 2 new commands RLOGIN and RSHELL
-* New routines RLOGIN and RSHELL
-* Interface for the ZEBRA server ZS rewritten
-* Call to PACSEL added in PANTUP (for lego and contour)
-* Changes in PANTUP (avoid 2 passes when ID exists)
-* ==>Important change in HGETID and HGETNT
-* If current directory is not //PAWC, then ID in /PAWC/
-* is always deleted and HRIN called
-* H/plot ID always gets a copy from Current Directory
-* IDOLD not used anymore
-* More information given in the HELP of Ntuple/Plot.
-* New command PAVE
-* LOCATE command returns CONTENT of channel/cell
-* Hbook functions HX and HXY callable from COMIS
-*
-*::> VERSION 1.05/03 890301 18.57
-*
-* Changes for IWK in PAWWID,PANTUP
-* Changes in PAGPRI (Dim for XLOG changed to 800 from 200)
-* Changes in Command Fit/Function (additional parameters)
-* Sequence NTSCAN renamed PCSCAN
-* (Version never released)
-*
-*
-*::> VERSION 1.05/02 890124 16.07
-*
-*
-* New sequences PCPATL,PCCHAR and PCFUNC
-* Use above sequences instead of local variables
-* KUGETI(ID) changed to PAGETI(ID). New routine PAGETI
-* ID='*' means ID='0'
-* All local variables SAVEd
-* List of COMIS routines printed by ENTRY PAWCSH
-* Protections in PAHFIT and PAWSEL
-* New command DDIR to delete a directory
-* Command ARROW can draw a double arrow
-* CDF modified
-* Modified HBOOK sequence HCDIRE introduced.
-* HFNAME filled with file name
-* Sequence HPL1 deleted. Use HPLOPT(opt,-1) instead
-* Protections in HGETID,HGETNT and PAWROP
-* Automatic setting of workstation type on Apollos
-* Changes in PANTUP for automatic binning
-* New command Ntuple/Merge
-* New routines PAMERG,PAMER1 and PAMER2
-* NUPD changed from 30000 to 1000000
-*
-*::> VERSION 1.05/01 881221 14.05
-*
-* Unused variables or commons deleted.
-* Routine PAWUSR called with an argument in PAWINT and PAEXIT
-* Changes in PAWFOP for IBM (IOFILE01 instead of IOFILE1)
-* Routine VECDEF called from PAWDEF and not from KUINIT
-* New routine PAHELP
-* Mods in CDF for new HELP facility (PAHELP)
-* New routine PACLOS (FILEDEF CLEAR on VM)
-* New routines PAOPEN,PAREAD,PAWRIT (callable from COMIS)
-* New PATCH,CDF introduced
-* ZLOWNT,ZUPNT introduced in /PAWNTU/
-* Changes in PANTUP (LOSTAT) and 40 bins for 2-Dim
-*
diff --git a/src/graflib/higz/doc/Versions/v1_06 b/src/graflib/higz/doc/Versions/v1_06
deleted file mode 100644
index 6e62733..0000000
--- a/src/graflib/higz/doc/Versions/v1_06
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: v1_06,v 1.1.1.1 1996/02/14 13:10:20 mclareni Exp $
-*
-* $Log: v1_06,v $
-* Revision 1.1.1.1 1996/02/14 13:10:20 mclareni
-* Higz
-*
-*
-*CMZ : 10/07/91 19.40.26 by Rene Brun
-*-- Author :
-*
-*::> VERSION 1.06/00 890629 12.25
-*
-* Bug corrected in PAWROP (VAX)
-* Bug corrected in HPROJ0 (double counting in MASKs)
-* Bug corrected in HPROJA (remove CALL PAWFCI)
-* Routine KUTIME added in PAWCS
-* Routine HPLOC added in PAWCS
-* Routine HDERIV added in PAWCS
-* Bug corrected in PAWUWF (comma missing in case of V_..)
-* Common blocks /QUEST/ and /KCWORK/ added to PAWCS
-* Changes for log/log scales in PAFUNC
-* CALL KUTERM(IGTERM) added in PAWINT (to empty graphics buffers)
-* Changes in PACSEL and PANTUP (when typing CSEL CB)
-* test .LE. changed to.EQ. after KUGETV (for ? vector)
-* BATCH version introduced
-* New routine PAWARG (NOLOG,BATCH,BATCHF)
-*
diff --git a/src/graflib/higz/doc/Versions/v1_07 b/src/graflib/higz/doc/Versions/v1_07
deleted file mode 100644
index ff6c9a3..0000000
--- a/src/graflib/higz/doc/Versions/v1_07
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: v1_07,v 1.1.1.1 1996/02/14 13:10:20 mclareni Exp $
-*
-* $Log: v1_07,v $
-* Revision 1.1.1.1 1996/02/14 13:10:20 mclareni
-* Higz
-*
-*
-*CMZ : 10/07/91 19.40.26 by Rene Brun
-*-- Author :
-*
-*::> VERSION 1.07/00 891010 18.23
-*
-*
-* Correction in PAFUNC (option 'S')
-* Number of Ntuple variables extended to 512
-* Bug fixed in PAHFIT
-* PAHFIT modified for the new HFITGA,EX,PO
-* New commands Histo/Fit and Vector/Fit
-* Correction in PAFUNC for LOGY scales
-* Changes in HGETID fir status word bit 5 of HBOOK
-* New routine PALOGS for PAW monitoring
-* Changes in PAMAIN (PAW$LOGON on VAX,etc)
-* RSHELL writes on LOUT
-* Command Picture/SCR activated.
-* Added Interactive Minuit to HFITH/HFITV.
-* PAHIST modified to call HPLTAB for sub-ranges.
-* Mods in PAFORT and PASIGM to permit calling
-* COMIS or SIGMA in KUIP macros.
-* CDF modified
-* PAWROP. Automatic LRECL on VAX.
-* Ranges in CONTOUR,LEGO,SURFACE.
-
diff --git a/src/graflib/higz/doc/Versions/v1_08 b/src/graflib/higz/doc/Versions/v1_08
deleted file mode 100644
index 73d4ec5..0000000
--- a/src/graflib/higz/doc/Versions/v1_08
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: v1_08,v 1.1.1.1 1996/02/14 13:10:20 mclareni Exp $
-*
-* $Log: v1_08,v $
-* Revision 1.1.1.1 1996/02/14 13:10:20 mclareni
-* Higz
-*
-*
-*CMZ : 10/07/91 19.40.26 by Rene Brun
-*-- Author :
-*
-*::> VERSION 1.09/00 900124 10.42
-*
-* Fix bug in PAMERG
-* Command Ntuple/Plot can now book/fill a Profile histogram
-* if option 'P' is given.
-*
-*::> VERSION 1.08/00 891220 18.47
-*
-* New parameter in command CONTOUR to plot user contours
-* When option 'E' is selected in Ntuple/Plot, HBARX is
-* automatically called for the output histogram
-* New routines HCDIR and HGIVEN in PAWCS
-* Command NULL now based on HPLFRA from HPLOT
-* This allow the redefinition of LOG/LIN scales
-* on a LIN/LOG scale frame.
-* Special connection ID for GKS metafiles 4011-->4230
-*
-
diff --git a/src/graflib/higz/doc/Versions/v1_09 b/src/graflib/higz/doc/Versions/v1_09
deleted file mode 100644
index f5e5a94..0000000
--- a/src/graflib/higz/doc/Versions/v1_09
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: v1_09,v 1.1.1.1 1996/02/14 13:10:20 mclareni Exp $
-*
-* $Log: v1_09,v $
-* Revision 1.1.1.1 1996/02/14 13:10:20 mclareni
-* Higz
-*
-*
-*CMZ : 09/02/95 15.51.10 by O.Couet
-*-- Author :
-*
-*::> VERSION 1.09/00 891219 15.24
-*
-* Bugs corrected in IZHIST in case of not equidistant bins
-* Correction for CRAY in IGSET (NINT used in TXAL)
-* Correction in IUWK (PATCH IGKS) to call IPUWK even if GFLAG=.FALSE.
-* New version of clear for PostScript (see IZCLRD)
-* Accents are available in PostScript
-* New PostScript metafile type -2xx with 132 characters per lines
-* Telnetg : Protections added in IMFIN and IMFOUT (if XMIN=XMAX)
-* Bug corrected in IPINIT (CALL IZSELN is added)
-* In IGTABL, the contour plot can now drawn a given set of altitudes
-* Changes in IGTABL to allow scaling change on Lego plots
-* New routine IPTEXT (called by IZTX) in PATCH IPOST to draw the
-* PostScript text like IGTEXT if 0 < Font < -25 and Precision = 1
-*
diff --git a/src/graflib/higz/doc/Versions/v1_10 b/src/graflib/higz/doc/Versions/v1_10
deleted file mode 100644
index fc37d43..0000000
--- a/src/graflib/higz/doc/Versions/v1_10
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: v1_10,v 1.1.1.1 1996/02/14 13:10:20 mclareni Exp $
-*
-* $Log: v1_10,v $
-* Revision 1.1.1.1 1996/02/14 13:10:20 mclareni
-* Higz
-*
-*
-*CMZ : 10/07/91 19.40.26 by Rene Brun
-*-- Author :
-*
-*::> VERSION 1.10/00 901107 14.12
-*
-* Option LOGX and LOGY available for 2D histos and Ntuples
-* The command MAX works now on 2D histograms
-* Bug corrected in PAGPRI (command HIST in case of non
-* equidistants bins)
-* New application : SLIDE
-* Mods in installation craddle
-* Bug corrected in FUN/PLOT in case of option same
-* New commands:
-* /FUNCTION/DRAW UFUNC [ CHOPT ]
-* /FUNCTION/ANGLE [ THETA PHI ]
-* /FUNCTION/RANGE [ XLOW XUP YLOW YUP ZLOW ZUP ]
-* /GRAPHICS/ATTRIBUTES/PALETTE PALNB [ NEL LIST ]
-* /GRAPHICS/WORKSTATION IWKID [ CHOPT IWTYP ]
-* /NTUPLE/LINTRA IDN [ CHOPT NEVENT IFIRST NVARS VARLIS ]
-* Commands modified, in order to take care of the new 3D
-* plots facilities of HIGZ:
-* /HISTOGRAM/2D_PLOT/LEGO [ ID THETA PHI CHOPT ]
-* /HISTOGRAM/2D_PLOT/SURFACE [ ID THETA PHI CHOPT ]
-* /HISTOGRAM/PLOT [ ID CHOPT ]
-*
diff --git a/src/graflib/higz/doc/Versions/v1_11 b/src/graflib/higz/doc/Versions/v1_11
deleted file mode 100644
index 26462da..0000000
--- a/src/graflib/higz/doc/Versions/v1_11
+++ /dev/null
@@ -1,66 +0,0 @@
-*
-* $Id: v1_11,v 1.1.1.1 1996/02/14 13:10:20 mclareni Exp $
-*
-* $Log: v1_11,v $
-* Revision 1.1.1.1 1996/02/14 13:10:20 mclareni
-* Higz
-*
-*
-*CMZ : 24/07/91 17.55.48 by Rene Brun
-*-- Author :
-*
-*::> VERSION 1.11/03 910708 14.44
-*
-* New routine HCOPYP to copy a projection into a 1-dim hist.
-* Ex: If ID=20 contains a PROX and 20 SLIX, then
-* H/copy 20.prox 1 copy PROX from 20 inti ID=1
-* H/copy 20.slix.12 12 copy SLIX.12 into ID=12
-*
-* Bug corrected in GET/Abscisa (C.Erd)
-* New versions of LOCATE and VLOCATE using the sample mode
-* facility of the X11 version of HIGZ.
-* Protection in PAFITV to avoid to draw a bar chart if 'B'
-* (Bounds) is selected in V/FIT.
-*
-* Corrections for NEWLIB version (Harald Butenschoen,DESY)
-* in routines PAMAIN,PAHIO,PAOPEN,PAWFOP
-*
-* New routines HMAXIM,HMINIM,HMAX,HMIN,HNORMA,HREND in PAWCS
-* New routine HGFIT in PAWCS
-* Buffer size for COMIS increased from 5000 to 10000 words
-*
-* Bug corrected in PASCA1 whem masks are used
-*
-* Change in PANTUP for Ntuple/Read on VM
-*
-* First version of PAW_MOTIF: Flag MOTIF introduced and
-* new patches FPMOTIF and CPMOTIF.
-*
-*::> VERSION 1.11/02 910307 11.55
-*
-* Bug corrected in command Ntuple/Lintra
-* Rename parameter CHOPT to OPTION in command Ntuple/Plot
-* Memory mapping implemented in command GLOBAL
-* (requires mapping routines from HBOOK and KUIP)
-*
-*::> VERSION 1.11/01 910225 8.40
-*
-* Changes in PILOT,PATCH *PAW
-* Changes in RLOGIN to allow hostnames up to 16 characters
-*
-*::> VERSION 1.11/00 910214 18.30
-*
-* New COMMON HIGRAF introduced in PAWCS. This allows to
-* access the points used by the command GRAPH with
-* option 'C' in a COMIS program.
-* New option 'F' in the command GRAPH. The command GRAPH
-* with option 'C' or 'CF' allows now to draw closed
-* contours.
-*
-* Correction in PAGKSA: LIST change in PALETTE
-* Upgrade of command SCAN. It is now possible to scan
-* expressions of the original variables.
-* In the command CONTOUR, IFLAG is now replaced by CHOPT.
-* This allow to superimpose contour plots. This mod is
-* compatible with the previous version.
-*
diff --git a/src/graflib/higz/doc/Versions/v1_12 b/src/graflib/higz/doc/Versions/v1_12
deleted file mode 100644
index 7300d7e..0000000
--- a/src/graflib/higz/doc/Versions/v1_12
+++ /dev/null
@@ -1,15 +0,0 @@
-*
-* $Id: v1_12,v 1.1.1.1 1996/02/14 13:10:19 mclareni Exp $
-*
-* $Log: v1_12,v $
-* Revision 1.1.1.1 1996/02/14 13:10:19 mclareni
-* Higz
-*
-*
-*CMZ : 03/03/92 14.15.24 by O.Couet
-*-- Author : Rene Brun 02/09/91
-*
-*::> VERSION 1.12/00 910902 11.17
-*
-* Changes in PAFITH to add option E in fit commands
-*
diff --git a/src/graflib/higz/doc/Versions/v1_13 b/src/graflib/higz/doc/Versions/v1_13
deleted file mode 100644
index 01fa950..0000000
--- a/src/graflib/higz/doc/Versions/v1_13
+++ /dev/null
@@ -1,50 +0,0 @@
-*
-* $Id: v1_13,v 1.1.1.1 1996/02/14 13:10:19 mclareni Exp $
-*
-* $Log: v1_13,v $
-* Revision 1.1.1.1 1996/02/14 13:10:19 mclareni
-* Higz
-*
-*
-*CMZ : 14/07/92 13.29.42 by Rene Brun
-*-- Author : O.Couet 03/03/92
-*
-*::> VERSION 1.13/01 920306 9.49
-*
-* Bugs corrected in PAWUWF (changes in PAWIDN)
-* LINTRA command revisited. Sequence EQULIN replaced by PCLINT
-*
-*::> VERSION 1.13/00 920303 14.00
-*
-* First version of the $KUMACS PATCH.
-* Bug corrected in PAWFCU (A.Nathaniel)
-* Default values for X and Y in command TICKS are changed
-* to 1.E30.
-*
-* Bug corrected in PAWFCU (bug submitted by W.Mueller GSI)
-* Description : If one wants to fill with NTUPLE/PROJECT a
-* histogram with both a cut C and a weight W
-* one can use a command like
-* NTU/PROJ 10 100.exp W*(C)
-* e.g. NTU/PROJ 10 100.x a*(y>0)
-* which will increment at x with weight a if y>0.
-* This works fine, but the very similar case with two
-* conditions
-* NTU/PROJ 10 100.exp W*(C1)*(C2)
-* never increments the histogram no matter what the
-* conditions are. (bug corrected by Andy Cox)
-*
-* Many new routines added in PAWCS
-* (Most of the HBOOK user callable routines)
-*
-* IGTERM is called in the PAWEX macros.
-*
-* Mod in PAHIST to take care of the option "3" and "4" in the
-* command SURFACE
-*
-* New routines PANT3D, PANTAX and PANTPM to plot Ntuple in 3D
-* (G.Richards)
-* In the comand CUTS, the parameter CHOPT is now called OPTION
-*
-* More details on PAW version 1.13/00 are given in PAW.NEWS113
-*
diff --git a/src/graflib/higz/doc/Versions/v1_14 b/src/graflib/higz/doc/Versions/v1_14
deleted file mode 100644
index 162552b..0000000
--- a/src/graflib/higz/doc/Versions/v1_14
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: v1_14,v 1.1.1.1 1996/02/14 13:10:19 mclareni Exp $
-*
-* $Log: v1_14,v $
-* Revision 1.1.1.1 1996/02/14 13:10:19 mclareni
-* Higz
-*
-*
-*CMZ : 20/10/92 10.03.08 by O.Couet
-*-- Author : Rene Brun 14/07/92
-*
-*::> VERSION 1.14/01 920715 9.31
-*
-* Change in PAWLOC, ISTAT is now tested just after the call
-* to IRQLC (koellner at lbl.Bitnet).
-*
-*::> VERSION 1.14/00 920714 13.29
-*
-* Routine PMLOCA removed from FPMOTIF (it was not used).
-* Bug corrected in PANT3D LOGX was tested instead of LOGZ.
-* The polymarker color index in now reset in PANTPM.
-* Bug corrected in PAHIST: angles not used in H/PLOT
-* Routines ERF,ERFC,FREQ,PROB added to list of callable routines
-* from COMIS in PAWCS.
-* Commons /HCFITS/ and /HCFITD/ added to PAWCS.
-* bug corrected in PAMASK for option CLOSE (L option in <MZDROP)
-* bug corrected in PAHIST: ANGLEs not used for 2D histos
-* without subranges.
-* Bug corrected in PAHIST (side effect of the previous correction)
-* slices were ignored in HISTO/PLOT ID.SLIX.
-*
diff --git a/src/graflib/higz/doc/Versions/v1_15 b/src/graflib/higz/doc/Versions/v1_15
deleted file mode 100644
index 3dbb7ce..0000000
--- a/src/graflib/higz/doc/Versions/v1_15
+++ /dev/null
@@ -1,40 +0,0 @@
-*
-* $Id: v1_15,v 1.1.1.1 1996/02/14 13:10:19 mclareni Exp $
-*
-* $Log: v1_15,v $
-* Revision 1.1.1.1 1996/02/14 13:10:19 mclareni
-* Higz
-*
-*
-*CMZ : 1.15/03 22/07/92 12.17.38 by O.Couet
-*-- Author : O.Couet 14/07/92
-*
-*::> VERSION 1.15/03 920722 12.17
-*
-* Bug corrected in IGSEE and ITX at the PATCHY level (MSDOS
-* flag side effect).
-* Change in IGINIT: the alpha numeric labels are now initialized
-* with ' '. And in IGLBL: if the label list has N<50 labels, the
-* labels form N+1 to 50 are reset to ' '.
-* Bug fixed in IGADID: the IZPUSH parameter was not correct.
-*
-*::> VERSION 1.15/02 920717 14.25
-*
-* Bug fixed in lego and surface drawing: on VM legos with a small
-* range on X or Y axis were shifted. some variables needed
-* to be in DOUBLE PRECISION in the IH PATCH (on VM).
-*
-*::> VERSION 1.15/01 920715 10.00
-*
-* Change in IGCHWK. In the case of GKS OPND and LUNWIN were not
-* initialized <GUNTER at CERNVM>.
-* Change in IRQLC for ATCGKS (call to GPREC) (koellner at lbl.Bitnet).
-*
-*::> VERSION 1.15/00 920714 16.29
-*
-* New flag GKSIBM for the native version of GKS on IBM RS6000.
-* To install this version of HIGZ the following selection are
-* needed: +USE,*HIGZ,IBMRT,GKSIBM. (Roger Howard <RH2 at CERNVM>).
-* Mods in X11INT for IBM/VM: the static variable are now initialised
-* with a "long NULL" (LNULL).
-*
diff --git a/src/graflib/higz/doc/Versions/v1_16 b/src/graflib/higz/doc/Versions/v1_16
deleted file mode 100644
index ba33a13..0000000
--- a/src/graflib/higz/doc/Versions/v1_16
+++ /dev/null
@@ -1,137 +0,0 @@
-*
-* $Id: v1_16,v 1.1.1.1 1996/02/14 13:10:19 mclareni Exp $
-*
-* $Log: v1_16,v $
-* Revision 1.1.1.1 1996/02/14 13:10:19 mclareni
-* Higz
-*
-*
-*CMZ : 1.16/13 01/02/93 14.50.45 by Rene Brun
-*-- Author : O.Couet 23/07/92
-*
-*::> VERSION 1.16/13 930201 14.50
-*
-*
-* Inprovments in the X11 fonts management. 4 fonts are kept in
-* memory in order to avoid too many fonts loading.
-*
-*::> VERSION 1.16/12 930126 10.15
-*
-* Bug fixed in IPDLIN. Some line where missing in PS file
-* if they were too small.
-* Improvements in IPTEXT. The PostScript text was always visible
-* even if the text position was outside the paper.
-*
-*::> VERSION 1.16/11 930122 9.40
-*
-* Bug fix in IPZONE for the marker type 1 size.
-*
-*::> VERSION 1.16/10 930118 15.57
-*
-* Mods in IPTEXT in the ' ' and \040 management.
-* Improvments in the intermediate label drawing in case of
-* LOG axis. the rule is now: If 1 =< WMIN <100 and
-* Log(WMAX/WMIN) <2, some intermediate label are drawn.
-*
-*::> VERSION 1.16/09 930112 11.26
-*
-* Changes in IKFNTX: on IBM/VM only non proportional fonts are
-* used in the X11 version because for the proportional fonts
-* the text width is not correctly computed.
-* Bug fixed in IZPM: In PostScript files, invalid marker types
-* produce points.
-* Improvments in IGTAB5 in order to have the size of the axis
-* value, the size of the axis tick marks and the offset of the
-* values independant of the viewing angles in the surface and
-* lego plots drawing.
-* Bug fixed in IGTAB2: in case of LOGZ option the position of the
-* contour plot was not correct with the SURF3 option of IGTABL.
-*
-*::> VERSION 1.16/08 930106 11.16
-*
-* A few bugs fixed in the DI3000 PATCH <MARRAFINO at FNPSP>
-* Mods in x11int in the graphics context used to draw the
-* rubberbanding cursor: it is now more portable
-* jank at sunra1.cern.ch or jank at cernvm (Werner Jank)
-* Mods in the PostScript driver for EPS files: a new dictionnary
-* is defined in order to be included in WORD.<SCHRODER at CERNVM>
-* Mods in the PostScript driver for EPS files: the new dictionnary
-* was too small.
-* Changes in IZPICT. The options C, O, and D can be invoked in the
-* same CALL to IZPICT.
-* Mods in IGHIST. The 1Dim histogram with 1 or 2 bins are not plotted
-* with a marker or with a line but according to the current
-* option choosen.
-*
-*::> VERSION 1.16/07 921126 11.40
-*
-* Bug corrected in IZHIST: The value give to IZPUSH was not
-* correct in case of non equidistant bins.
-* New version of the routine ixmotif. New routine ixminit to
-* initialize the Motif call backs from IOPWK.
-* Mods in IHSDRL (IH) to avoid precision problems on NEXT.
-* New version of the routine IGMESS calling the routine IGXMES
-* which allows a more flexible usage of the X11 windows.
-* Mod in ixopnwi: if the window name begins with '-' the extension
-* ' @ machine_name' is not added to the window title.
-* Mods in the MSDOS driver in the routines IGWKTY, IGSG, IOPWK
-* and MAPCOL to support SuperVGA 800x600 with 16 colors screen
-* (Dr.Valery Fine LCTA/JINR Dubna).
-*
-*::> VERSION 1.16/06 921030 11.04
-*
-* Changes in IGAXIS. With LOG scale, intermediate division
-* are ploted if one one decade is visible. This implies also
-* mods in IZRTOC.
-* Bug fixed in IPTEXT. The @ mechanism to escape control characters
-* was wrong for <, >, ", #, ?, !, & and $.
-* New sequence HIPICK use in IGPID and IGPICK.
-* Default FONT and PRECISION change to 0,2 in IGSET.
-*
-*::> VERSION 1.16/05 921013 16.26
-*
-* Changes in IGAXIS secondary and tertiary axis divisions are
-* optimized like the primary divisions.
-* Changes in the MacIntosh driver (fill area management) (C.Delaat).
-* Bug fixed in the IKERNEL PATCH: With the FALCO driver, some
-* attributes (FACI, FAIS etc...) where not correctly stored in
-* the ZEBRA data structure.
-*
-*::> VERSION 1.16/04 921009 13.53
-*
-* Some fixes in the Macintosh driver (Cees Delaat).
-* New option 'Q' in IZPICT.
-* Changes in the X11 interface. The routine ixmotif allows to
-* manage several window in a motif program. The routine ixopnwi
-* has one additional parameter IFLAG.
-* New flag APOF77 for the f77 apollo compiler.
-* New flag QX_SC and QXNO_SC to add or not an "_" in the C routines.
-* Bug fixed: the PostScript marker size is now reset in IPZONE.
-* Some changes in IGAXI3 in order to get a better automatic
-* labeling of the axis.
-* Changes in IPTEXT: the control characters can be escaped with '@'.
-*
-*::> VERSION 1.16/03 920824 9.44
-*
-* Bug fixed in IZSELN: the graphics editor didn't work. This
-* was a side effect of the introduction of IGPID (Lee Roberts).
-* Bug fixed in the routine IRQST for GL: the blank was forgotten.
-* (Lee Roberts).
-*
-*::> VERSION 1.16/02 920820 10.06
-*
-* Mods in x11int. The window is raised by ixupdwi only
-* if necessary.
-* New version of PostScript text (routine IPTEXT in PATCH IPOST)..
-* (P.Juillot CRN Strasbourg <JUILLOT at CERNVM).
-*
-*::> VERSION 1.16/01 920818 11.03
-*
-* Mods in the Mac interface (Cees de Laat)
-* Bug fixed in x11int (ixsetco) the RGB value were not stored.
-* Bug fixed in IGAXIS in the optimization of the secondary divisions.
-*
-*::> VERSION 1.16/00 920723 13.57
-*
-* Change in IGAXIS for the TOP->DOWN labels.
-*
diff --git a/src/graflib/higz/doc/Versions/v1_17 b/src/graflib/higz/doc/Versions/v1_17
deleted file mode 100644
index 61f160d..0000000
--- a/src/graflib/higz/doc/Versions/v1_17
+++ /dev/null
@@ -1,44 +0,0 @@
-*
-* $Id: v1_17,v 1.1.1.1 1996/02/14 13:10:19 mclareni Exp $
-*
-* $Log: v1_17,v $
-* Revision 1.1.1.1 1996/02/14 13:10:19 mclareni
-* Higz
-*
-*
-*CMZ : 1.17/03 22/03/93 10.04.38 by O.Couet
-*-- Author : O.Couet 24/02/93
-*
-*::> VERSION 1.17/03 930322 10.04
-*
-* The maximal number of NTs is now 100.
-* The routine XGetCGValues is not used for VAX machines (x11int).
-* A cross cursor is displayed together with the cross-air (x11int).
-* The line type of the contour plots is controled with IGSET LTYP
-* when all the contours are drawn with the same line type (IGTABL)
-* Bug fixed in IFA3: NGRAF was not initialized.
-*
-*::> VERSION 1.17/02 930309 11.58
-*
-* Improvements in the GDDM driver. This version may be used on
-* IBM 3192G terminals, IBM 5080 stations and corresponding
-* emulators (notable the Macintosh version of tn3270).
-* The modifications have been contributed by J.Salicio/CIEMAT.
-*
-*::> VERSION 1.17/01 930302 12.20
-*
-* Bug fixed in IKERNEL/IOPWK: in case of "Invalid Workstation type"
-* INOPWK wasn't decremented.
-* Mods in IGWKTY: when '?' is typed by the user, the metafile
-* types are not displayed.
-*
-*::> VERSION 1.17/00 930224 15.51
-*
-* Improvments in IGAXIS: If the intermediate labels in LOG scale
-* overlap each other, they are not drawn. The position of the
-* exponants is now better in case of LOG scale.
-* New routine IZGRAP to store the IGRAPH primitive.
-* New option Z in IGRAPH.
-* Improvments in IGAXIS: If the intermediate labels in LOG scale
-* are drawn if YMAX < 10000.
-*
diff --git a/src/graflib/higz/doc/Versions/v1_18 b/src/graflib/higz/doc/Versions/v1_18
deleted file mode 100644
index fec27e2..0000000
--- a/src/graflib/higz/doc/Versions/v1_18
+++ /dev/null
@@ -1,99 +0,0 @@
-*
-* $Id: v1_18,v 1.1.1.1 1996/02/14 13:10:19 mclareni Exp $
-*
-* $Log: v1_18,v $
-* Revision 1.1.1.1 1996/02/14 13:10:19 mclareni
-* Higz
-*
-*
-*CMZ : 1.18/10 22/06/93 17.28.47 by O.Couet
-*-- Author : O.Couet 30/04/93
-*
-*::> VERSION 1.18/10 930622 17.28
-*
-* In the FALCO driver the marker type 3 (*) in known. This implies
-* mods in IGPM.
-* Mod in IGAXIS to have a better alignment for the vertical right
-* labeled axis.
-* Line type for FALCO implemented (merlant at csnvs1.in2p3.fr).
-* Bug fixed in ISCHH (patch IKERNEL): in case of FALCO, CHHE was
-* not stored in the pictures.
-*
-*::> VERSION 1.18/09 930611 9.40
-*
-* Bug fixed in ICLWK in case one the workstation was a PS file.
-* New version of IGTABL and IGTAB6 to allow POL etc.. with
-* Gouraud shading surfaces.
-*
-*::> VERSION 1.18/08 10/06/93 17.50.50
-*
-* In IKERNEL/IOPWK for the X11 version the string :0.0 is append after
-* the display name/adress only if ":" is not yet in the name.
-* New primitive ICA to draw cell arrays.
-* Remove bug in IGSSE (introduced with the changes for DECGKS)
-*
-*::> VERSION 1.18/07 930601 17.22
-*
-* Changes in IKERNEL/IOPWK for the X11 version to allow to change
-* the HIGZ window name. In higz_windows.dat after the adress
-* of the host it is possible to give the window name.
-*
-*::> VERSION 1.18/06 930528 9.32
-*
-* Improvment in IPSCOL (set the PostScript Color): if the color is
-* black, the operator "setgray" is used instead of "setrgbcolor"
-* because on some color printers black is better with "setgray".
-*
-*::> VERSION 1.18/05 930527 15.01
-*
-* LINUX version introduced. <balashov at main1.jinr.dubna.su>
-* New version of hidden line removal algorithm for Polar, Cylindrical,
-* and Sperical coordinates.
-* Bug fixed in IGTCCH: CHBUF is now erased before to be filled.
-*
-*::> VERSION 1.18/04 930526 14.08
-*
-* Bug fixed in IKFILE: on IBM/VM the string CCHOST was too long.
-*
-*::> VERSION 1.18/03 930525 17.06
-*
-* Mods for the GKSGRAL,NEWLIB version in IGSA, IGSG ad IGWKTY
-* (Harald Butenschoen)
-*
-*::> VERSION 1.18/02 930525 10.13
-*
-* The string CHHOST in HIKERC was too small it is now 80 characters.
-* (mjk at illini.physics.utah.edu)
-* "IF=" on PATCH cards.
-* In the X11 driver, the class hint is now equal to "HIGZ" (W.Brueckner).
-*
-*::> VERSION 1.18/01 930511 17.24
-*
-* The X11 mode to draw the cursor in ixreqlo is define according to
-* the XServerVendor output.
-* In IGMETA, if LUN=999, the metafile is deactivated AND closed.
-* New routine IGMETN to set the metafile name. It is usefull for
-* some HIGZ version (ATCGKS, MSDOS ...)
-* Mods in IH routine to have the angle on the first coordinate with
-* Polar, Cylindrical and Spherical reprsentations.
-* Bug fixed in ntmgt: #include <stdio.h> was missing for SUN
-* New routine IGTCCH to translate IGTEXT control characters (in a string)
-* into their printable version.
-*
-*::> VERSION 1.18/00 930430 12.57
-*
-* New C deck NTMGT to manage dynamically the NT. Now used only with X11.
-* Mods in IZPICT and IZSELN: The NT banks have now the same name in order
-* to describe there structure with dzdoc.
-* In IGTEXT, XW,YW and WDTH are now initialized to 0.
-* Mods in various routines for DECGKS on VAX (Lynn Garren <GARREN at FNPSP>).
-* Now the number of colors in HILUT is 256.
-* New options POL, CYL, SPH, and PSD in IGTABL.
-* Sequences are now splited in hicdes, and QFTITLECH is used to set
-* the version number.
-* Logarithmic scales on X and Y axis are now available for Lego and Surface
-* plots. It implies mods in many routines around IGTABL and also
-* in IGAXIS: with options W and G the label were not correct.
-* The X11 mode to draw the cursor in ixreqlo is now "GXxor" which seems
-* to work in a better way than "GXinvert".
-*
diff --git a/src/graflib/higz/doc/Versions/v1_19 b/src/graflib/higz/doc/Versions/v1_19
deleted file mode 100644
index 36cd8e6..0000000
--- a/src/graflib/higz/doc/Versions/v1_19
+++ /dev/null
@@ -1,124 +0,0 @@
-*
-* $Id: v1_19,v 1.1.1.1 1996/02/14 13:10:19 mclareni Exp $
-*
-* $Log: v1_19,v $
-* Revision 1.1.1.1 1996/02/14 13:10:19 mclareni
-* Higz
-*
-*
-*CMZ : 1.19/17 22/10/93 17.59.07 by O.Couet
-*-- Author : O.Couet 28/06/93
-*
-*::> VERSION 1.19/17 22/10/93 17.59.07
-*
-* Mods in IGRAP1 in order to draw Curves with in infinite number
-* of point (ZEBRA banks replace HIGRAF common block). Mods also
-* in IGRAPH to take advantage of the new version of IGRAP1.
-*
-*::> VERSION 1.19/16 22/10/93 09.34.26
-*
-* Bug fixed in IZGRAP in case the original data are in a zebra bank.
-* The format in IZPICT (for the listing) are now I5 instead of I2.
-*
-*::> VERSION 1.19/15 12/10/93 12.10.10
-*
-* Bug fixed in IGAXIS (case NULL 9.999 10).
-* Optimization in IGAXIS. In case of overlap, the alphanumeric labels
-* are rotated.
-* Mods in IGTABL, IZTABL and IZDNB to allow 2D plots with more than 999
-* bins (with subranges).
-*
-*::> VERSION 1.19/14 07/10/93 15.33.40
-*
-* Flag NOVAGKS suppressed.
-* Useless pilot patches *GKSGRAL, *DECGKS, *SUNGKS, *GPR, *GL, *X11 and
-* *DI3000 are removed. The installation of HIGZ should be done with
-* the pilot patch *HIGZ.
-* For DecStation Color, GXinvert should be use for rubberbanding.
-*
-*::> VERSION 1.19/13 01/10/93 10.54.59
-*
-* Speed improvments in IPM4ID (3-4 times faster).
-* Mods in IGWKTY. For UNIX machines wokstation type read is done via
-* a C routine (IXGETL) in order to allow:
-* $ paw < filename
-* or
-* $ cat filename | paw
-*
-*::> VERSION 1.19/12 28/09/93 17.37.09
-*
-* Bug fixed in IZGRAP: The BASL attributes was not flaged.
-* Bug fixed in IRQST for FALCO: the output parameter L was not correct.
-* IGSG is now called in ISLN for the FALCO driver.
-* New routine IPM4ID to draw NT/PLOT id.x%y%z%t
-*
-*::> VERSION 1.19/11 27/09/93 11.59.25
-*
-* In IGTCCH the character % is translated into '"Y#'
-*
-*::> VERSION 1.19/10 15/09/93 11.16.41
-*
-* Changes in IGTAB5, and IGTABL to be able to define the log option
-* from the calling sequence and not via COMMON.
-* Bug fixed in IZMERG.
-*
-*::> VERSION 1.19/09 06/09/93 11.29.16
-*
-* Mods in IGRAPH: when it was called with an invalid CHOPT (for
-* example '?'), a blank CHOPT was stored in the picture and
-* the image produced with IZPICT was different from the original.
-* Bug fixed in IKBOX. For the 7879 driver and solid filled areas,
-* IGHATC was not called correctly.
-*
-*::> VERSION 1.19/08 03/09/93 17.08.41
-*
-* Flag QMALPH added in *HIGZ.
-* The routine ixgetwi in x11int is now a FORTRAN callable routine.
-*
-*::> VERSION 1.19/07 31/08/93 09.39.07
-*
-* Mods in the PATCH IMAC: New version of imacplo an f_readwi.
-* The deck imacevl is now obsolete.
-*
-*::> VERSION 1.19/06 27/08/93 17.15.44
-*
-* Improvments in the vertical centering of rotated texts. This
-* implies mods in the ITX routines (IKERNEL, IGKS and IDI3000)
-* and in the routine IPTEXT.
-* Small Improvments in the 3d function drawing (PATCH IH).
-*
-*::> VERSION 1.19/05 26/08/93 11.58.10
-*
-* Improvments in the 3d function drawing (PATCH IH). It is
-* also possible to draw with hidden lines removal.
-*
-*::> VERSION 1.19/04 25/08/93 10.19.48
-*
-* Changes for CONVEX (V.Balashov).
-* Bug fixed in IOPKS in the pathes IGKS an IDI3000: The string
-* CHVERS was not initialized.
-*
-*::> VERSION 1.19/03 24/08/93 12.03.26
-*
-* New flag WINNT introduced.
-* In IGTEXT, IA is saved for MACMPW (Cees Delaat).
-* Lot of changes in the IMAC PATCH (Cees Delaat).
-*
-*::> VERSION 1.19/02 930729 13.07
-*
-* Unreachable code suppressed in IGTAB6.
-* IF=HIGZEXAM on +PATCH,HIGZEXAM.
-* CHDEFT has now 256 in IGMENU (instead of 80). (Roger Ruber
-* RUBER at JPNKEKVX.BITNET)
-* Bug fixed in IPDEF for the not A4 landscape PS file.
-*
-*::> VERSION 1.19/01 930705 12.42
-*
-* Protection added in IGMENU if the multiple choices ended with ','.
-*
-*::> VERSION 1.19/00 930628 12.14
-*
-* Protection added in IPTEXT: if the text size is less or equal
-* to zero, a RETURN is performed.
-* The EPS files contain now a showpage.
-*
diff --git a/src/graflib/higz/doc/Versions/v1_20 b/src/graflib/higz/doc/Versions/v1_20
deleted file mode 100644
index a705008..0000000
--- a/src/graflib/higz/doc/Versions/v1_20
+++ /dev/null
@@ -1,107 +0,0 @@
-*
-* $Id: v1_20,v 1.1.1.1 1996/02/14 13:10:19 mclareni Exp $
-*
-* $Log: v1_20,v $
-* Revision 1.1.1.1 1996/02/14 13:10:19 mclareni
-* Higz
-*
-*
-*CMZ : 1.20/11 28/02/94 11.26.52 by O.Couet
-*-- Author : O.Couet 02/11/93
-*
-*::> VERSION 1.20/11 28/02/94 11.26.52
-*
-* Bugs fixed in IGTABL (default parameter values initialization).
-* IGERR was called in IGWKTY without LUNERR and LUNOUT initialized.
-* Update in IZHIST to take into account the new 'Z' option of IGHIST.
-*
-*::> VERSION 1.20/10 21/02/94 11.15.35
-*
-* Mods in IGTEXT, IKFNTX *HIGZ and *HIGZEXAM for Windows-NT (Valery Fine)
-* New option 'Z' in IGHIST. Like in IGRAPH, if it is selected, the vectors
-* X and Y are taken into PAWC at the adresses IQUEST(81) and IQUEST(82).
-* This protect agains the ZEBRA garbage collections.
-*
-*::> VERSION 1.20/09 26/01/94 09.21.23
-*
-* IGPICK is now able to pick IGARC.
-* Mod in IXOPNDS (x11int): The display was reopen for each window.
-* The READ in IGWKTY is in FORTRAN (IXGETL under the flag CCREAD) because
-* KUIP do the READ in FORTRAN (cf FFREAD).
-* Mod in ISTXFP for the FALCO driver.
-*
-*::> VERSION 1.20/08 20/01/94 11.30.15
-*
-* The 3D is available (ISWN3, ISVP3) for the X11 only. ntmgt should be
-* used also with the GKS version.
-* New routine IXDOGIF to produce gif files. It is available only if
-* if the FLAG GIF is selected.
-* Correction in IKERNEL/IPM: The marker size was not linear
-*
-*::> VERSION 1.20/07 17/01/94 18.06.42
-*
-* Mods in the FALCO driver: John Clement
-* Protection added in IZDIPI. (LN)
-* IXCLSDS perform immediatly a return if display=NULL
-* Bug fixed in IHPVIE (a RETURN was missing).
-* Mods in IOPWK, IGWKTY, IGINIT and IKFILE to be able to call
-* IGWKTY before or after IGINIT.
-*
-*::> VERSION 1.20/06 07/01/94 18.38.19
-*
-* Mod in IGXMES for IBM/VM.
-* New 3D routines: ISWN3 and ISVP3. See the HIGZ manual for more details
-* Protection added in IHSDRL (if NT > NTMAX).
-* Mods in IGTABL to use the new 3D routines
-* Mods for FALCO driver: John Clement, Rice University
-* <CLEMENT at physics.rice.edu>. I some places, test like IWTYPE.EQ.7878
-* should be IGIWTY(IWKID).EQ.7878
-*
-*::> VERSION 1.20/05 08/12/93 09.33.04
-*
-* Bug fixed in IGAXIS. In some cases (it seems very rarely because
-* the code has not change in this part since at least 3 years)
-* in the test:
-* IF((X00-XONE).GT.EPSIL) GOTO 150
-* EPSIL was to big. Now the test is:
-* IF(X00.GT.XONE) GOTO 150
-* and in fact that is what is needed in this case.
-* Changes in rotated to avoid warnings with /com/cc on APOLLO.
-*
-*::> VERSION 1.20/04 26/11/93 13.42.06
-*
-* Fix in higzcc/rotated for IBM/VM: The text width returned for
-* lowercase is 0. Now it is protected.
-* New routine IGDWK to Get the Default WorKstation type. This
-* routine is called by IGWKTY.
-*
-*::> VERSION 1.20/03 23/11/93 11.44.01
-*
-* Mods in IGCOLM in order to support default position and color map.
-* The xvertext package to rotate and scale X11 fonts is now available
-* in higzcc/rotated (Alan Richardson(mppa3 at uk.ac.sussex.syma))
-* Now the X11 fonts are managed as follows:
-* font=xx precision=0 : X11 font a rotated
-* font=xx precision=1 : IGTEXT is used on the screen
-* font=xx precision=2 : X11 font a rotated and scaled.
-* Fix in higzcc/rotated for IBM/VM.
-* Protection added in ixgetge: sometimes (for instance after a CTRL-C),
-* XGetGeometry returns wrong values. In this case the previous "good
-* values" are used.
-*
-*::> VERSION 1.20/02 08/11/93 09.53.03
-*
-* IXSELWI is now called in IACWK (X11) to be sure the window
-* in active even if IGTERM is not called.
-*
-*::> VERSION 1.20/01 03/11/93 11.12.27
-*
-* The unused routine IGPHSL is now removed.
-* The PATCH IGKS3D is removed (not used and not documented). The
-* related routines in IG and the corresding KEEP in HICDES are
-* also removed.
-*
-*::> VERSION 1.20/00 02/11/93 17.44.57
-*
-* Some unused sequences are removed.
-*
diff --git a/src/graflib/higz/doc/Versions/v1_21 b/src/graflib/higz/doc/Versions/v1_21
deleted file mode 100644
index 1b7e636..0000000
--- a/src/graflib/higz/doc/Versions/v1_21
+++ /dev/null
@@ -1,147 +0,0 @@
-*
-* $Id: v1_21,v 1.1.1.1 1996/02/14 13:10:19 mclareni Exp $
-*
-* $Log: v1_21,v $
-* Revision 1.1.1.1 1996/02/14 13:10:19 mclareni
-* Higz
-*
-*
-*CMZ : 1.21/12 25/10/94 13.47.25 by O.Couet
-*-- Author : O.Couet 30/03/94
-*
-*::> VERSION 1.21/12 25/10/94 13.47.24
-*
-* Bug fixed in IPIOUT: the I7 format was too small. It is now I15.
-*
-*::> VERSION 1.21/11 21/10/94 12.01.27
-*
-* Improvement in IGAXIS in case of integer labelling. The optimization
-* provide by IGAXI0 is better than the one provide by IGAXI4. When
-* integer labelling is required, IGAXI0 is invoke first and only
-* if the result is not an integer labelling, IGAXI4 is invoked.
-*
-*::> VERSION 1.21/10 17/10/94 15.08.15
-*
-* VIDQQ is now removed from IGINIT because it is now in igvers.
-* Mods IGAXIS to have a better drawing of label like 10^xxx: Now we
-* take into account the length of the exponant to avoid
-* overlapping text. (improvement suggested by Mike Kelsey).
-* New option HWCO in IGQWK to return the number of hardware colours
-* available.
-*
-*::> VERSION 1.21/09 27/09/94 17.41.14
-*
-* In IGPICK, TA_IND was not declared as an INTEGER. It is now
-* replaced by ITAIND.
-* Mods in X11INT: VAX machines was asumed to be X11R3 now
-* they are consider as X11R4 (at least) machines. APOLLO machines
-* are still consider as X11R3 machines.
-* Bug fixed in IACWK (X11 version). The line width set was not the
-* same as the one set by ISLWSC.
-* Bug fixed in ICLKS. This routine close all the workstations still
-* open. It was looping on ILOPWK but this list was changed by
-* ICLWK, so ICLKS tried to close a non opened workstation. Now
-* ILOPWK is copied in an intermediate array.
-* Mods in IRQST/GPR. A small editor is now available.
-* (Robert Franchisseur robert at ramses.ibp.fr)
-* New C routine igvers to return the current HIGZ version. It is
-* used by the PAW command BUGREPORT
-* Precision problem in LOG scale has been solved (hopefully) in
-* IGAXIS. (XMNLOG-IH1).GT.EPSIL is now (XMNLOG-IH1).GT.0.. This
-* problem has been reflected in the pawdemo file.
-* Protection added in ISTXAL (IKERNEL): ixsetta was called even
-* with GFLAG=.FALSE.
-* New option 'X' in IGZSET to turn OFF the 'Z' mode without changing
-* the 'G' mode (used in HPLOPT).
-* New set of pattern in the X11 driver.
-* The Fill Pattern from 1 to 25 are now available also on PS files.
-* be careful with GhostView because to many filled areas with
-* such patterns can block this program.
-* Speed optimization in the PS file writing (a factor 3.6). A fast
-* writting routine has been introduced (IPPSTF entry point of
-* IPPSTR). In IPIOUT some code of IPPSTR is now inlined. IPDRAW
-* call has been replaced by two IPIOUT calls. The speed up gained
-* is the following (a 100x100 scatter plot):
-* Real time 00:01:08 (Old version)
-* Real time 00:00:34 (new IPIOUT)
-* Real time 00:00:22 (IPPSTF and inline in IPIOUT)
-* Real time 00:00:19 (suppress IPDRAW in IZPM)
-*
-*::> VERSION 1.21/08 22/07/94 15.22.13
-*
-* New routine IXWARP in x11int to move the pointer at a given
-* position (Adeyemi Adesanya).
-* New routine IZPAVE to store IGPAVE as a macro primitive. It implies
-* also mods in IZDNB and IGPICK.
-* Mods in IGRAP1 (push the LX and LY banks) in order to draw
-* filled area in one go.
-* Changes in IGPICK to pick text (Yemi)
-* A blank was missing in IPFON (DECS only)
-*
-*::> VERSION 1.21/07 30/06/94 14.56.15
-*
-* Protection added in IKFILE (ERR=999 in the last READ).
-* New routine IXQPTR in x11int to query the current pointer
-* position (Adeyemi Adesanya).
-* Mods in IGTAB5 to return in QUEST the axis positions (useful
-* for HPLOT to draw the axis titles).
-*
-*::> VERSION 1.21/06 27/06/94 18.21.00
-*
-* Mods in IZFILE to take into account the new option 'N' of RZMAKE.
-* Mods in IGTABL and IGTAB2 in order to close the surface plots
-* when the options POL, CYL, SPH or PSD are used.
-* Bug fixed in ixreqlo (x11int) when a button was pressed, the
-* cursor was undefined but not set to NULL (now it is).
-*
-*::> VERSION 1.21/05 17/06/94 17.41.08
-*
-* Bug fixed in IXCLSDS (X11INT): isdisp was not reset.
-* (Thierry MOUTHUY, <mouthuy at marpix1.in2p3.fr>).
-* New options 'E' and 'C' in IGZSET.
-* New options 'FB' and 'BB' in IGTABL.
-*
-*::> VERSION 1.21/04 10/06/94 15.05.39
-*
-* New option 'K' in IGHIST (histogram are pacKed like in HBOOK).
-* Fix in X11INT/ixreqst: in some cases, the '?' cursor was not
-* set correctly.
-* Protection added in IZPM and IGAXIS: when IGTEXT is called with
-* option 'S', the ANGLE parameter should be initialize to 0.
-* Optimization in IGAXIS to avoid identical labels on the same
-* axis (IF1 and IF2 too small), and to avoid x10^0.
-* In the sequence HIATT, all the variables are now declared.
-*
-*::> VERSION 1.21/03 06/06/94 13.34.58
-*
-* New version of IZPM (PS driver) to have shorter files.
-* Mods in IKFNTX to have a better maping between X11 and PS fonts.
-* Interface to GKSBx (CMZ flag: GKSBX).
-* Mods in IGKS and IDI3000 to use the C management of the NTs.
-* The cursor is reset after a request locator in sample mode (X11).
-* Mods is IPTEXT: the "stwn" value is now printed in I6.
-* Bug fixed in IGSA (FALCO version): it was a side effect of the
-* last mod apply for GPR (bug reported by Andrea Parri).
-*
-*::> VERSION 1.21/02 19/05/94 10.09.37
-*
-* Bug fixed in IGAXIS (precision problem on IBM/VM). This was a side
-* effect of the fix made in the version 1.20/05 for the X00 and
-* XONE comparison. Now the variable XMNSAV is not used, only XMNLOG
-* is used.
-* Bug fixed in IGSA (GPR version). GPR_RELEASE_DISPLAY was not
-* called if no workstation was opened.
-* Bug fixed in the PostScript driver: if EPS is selected and if the
-* BoundingBox is not yet in the file, the clipping cannot be set.
-*
-*::> VERSION 1.21/01 11/05/94 18.57.56
-*
-* New option 'W' in IGPXMP (write a pixmap in a bitmap file).
-* Major changes in the PostScript driver: the clipping is now
-* managed in the PS file itself.
-*
-*::> VERSION 1.21/00 30/03/94 18.14.42
-*
-* IGINIT: If GKSIBM is selected, METDEF = 3
-* In IGSA (DECGKS), '\' is now BSLASH (AlphaVMS).
-*
diff --git a/src/graflib/higz/doc/Versions/v1_22 b/src/graflib/higz/doc/Versions/v1_22
deleted file mode 100644
index 677aa00..0000000
--- a/src/graflib/higz/doc/Versions/v1_22
+++ /dev/null
@@ -1,127 +0,0 @@
-*
-* $Id: v1_22,v 1.1.1.1 1996/02/14 13:10:19 mclareni Exp $
-*
-* $Log: v1_22,v $
-* Revision 1.1.1.1 1996/02/14 13:10:19 mclareni
-* Higz
-*
-*
-*CMZ : 1.22/11 07/04/95 10.46.41 by O.Couet
-*-- Author : O.Couet 10/11/94
-*
-*::> VERSION 1.22/11 07/04/95 10.46.41
-*
-* Bug fixed in IGPAVE: The coordinates was not stored in the correct
-* order.
-*
-*::> VERSION 1.22/10 05/04/95 15.48.50
-*
-* Fix in IZTX: the IGTEXT call (for PS) was not done with GFLAG=.TRUE.
-*
-* 05/04/95 11.03.50
-* Bug fixed in IGAXIS. When the axis is close to the vertical a test
-* XMIN = XMAX was done. Now we compare the difference to EPSIL.
-*
-* 03/04/95 17.08.19
-* Fix in IPPATT: the trailing blank before the continuation line in
-* the middle of a character string are removed on VAXes.
-*
-* 03/04/95 10.36.54
-* Bug fixed in //HIGZ/IKERNEL/IRQLC. After the MAIL option removal
-* the SAMPLE variable was not initialized (a +SELF was missing).
-*
-*::> VERSION 1.22/09 23/03/95 15.25.29
-*
-* Bug fixed in IPL (all the versions): The clipping on line type
-* greater than 12 was not correct.
-*
-* 09/03/95 16.17.22
-* Mods in IGTABL and IGHCXY to drawn the errors (color) correctly for
-* 1D histos.
-*
-*::> VERSION 1.22/08 09/03/95 14.09.16
-*
-* New option E in IGTABL. This option allows to draw the error
-* on 2D histograms. Used with S1, S2, etc the colors are mapped
-* on the errors not on the content.
-*
-* 27/02/95 17.41.51
-* The MAIL option (telnetg) has bin removed from the installation
-* cradle *HIGZ.
-*
-* 24/02/95 16.57.11
-* Misplaced RETURN in IGWWK (options 2BUF and HWCO).
-*
-* 24/02/95 15.46.45
-* Bug fixed in IGTAB4: Th background color for surface was not correct
-* if, for example, BCOL=1102.
-*
-* 22/02/95 12.05.12
-* All the ONtuple material has been moved in the OBSOLETE patch.
-*
-* 14/02/95 10.43.48
-* Bug fixed in IKBOX for the FALCO driver. IGSG was missing.
-*
-*::> VERSION 1.22/07 09/02/95 17.03.34
-*
-* Bug fixed in IPTEXT. Some arrays was accessed with wrong indeces.
-*
-* 07/02/95 10.10.51
-* Mod in IPEND: In some cases (for example NEXT at the end of a macro)
-* a PS file was terminated like an EPS file.
-*
-*::> VERSION 1.22/06 03/02/95 12.15.27
-*
-* Bug fixed in IPTEXT: in some case the text was cutted in the middle
-* of an octal code.
-*
-*::> VERSION 1.22/05 30/01/95 11.02.06
-*
-* Bug fixed in IZSCLI. The PostScript clipping was stored in
-* the LaTex file (-777).
-*
-* 27/01/95 16.28.10
-*
-* Better drawing of the ARC border. Patch IG: IGARC2 IGARC3 IGARC4
-*
-*::> VERSION 1.22/04 25/01/95 17.50.08
-*
-* New routine IXMOVWI to move an X11 window.
-*
-* 25/01/95 15.44.18
-*
-* New option WIID in IGQWK to return the window identifier associated
-* to a given workstation ID.
-*
-* Bug fixed in ixgetwi (x11int): It was not working for several
-* windows.
-*
-*::> VERSION 1.22/03 06/01/95 15.29.04
-*
-* ISWN3 is called in IGTABL instead of IHSVIE. If IHSVIE is called,
-* a sequence like:
-* call hplfr3(0.,4.,0.,1.,0.,1.,30.,30.,'WBF')
-* lego 20
-* does not work because the window (ISWN3) is not normalized after
-* the call to HPLFR3.
-* Protection added in ISVP3 and ISWN3
-*
-*::> VERSION 1.22/02 05/01/95 15.10.45
-*
-* Mods in IZSCLI, IPINIT, IPZONE: The clipping is now set only
-* if IPZONE has been called. Otherwise some clipping problems
-* can append if there is several zones in the PS file
-* Mod in IPDEF: atend is replaced by (atend).
-*
-*::> VERSION 1.22/01 15/11/94 15.57.56
-*
-* Modif in IGAXIS to have the correct label alignment (L,R,C) for
-* vertical axis. I the previous version it was set to Left always
-* if the axis was drawn TOP do DOWN. IGCOLM also been modified
-* accordingly.
-*
-*::> VERSION 1.22/00 10/11/94 11.49.51
-*
-* Modif in the definition of the clipping for PostScript to avoid
-* side effect in FrameMaker.
-*
diff --git a/src/graflib/higz/doc/Versions/v1_23 b/src/graflib/higz/doc/Versions/v1_23
deleted file mode 100644
index e577378..0000000
--- a/src/graflib/higz/doc/Versions/v1_23
+++ /dev/null
@@ -1,130 +0,0 @@
-*
-* $Id: v1_23,v 1.1.1.1 1996/02/14 13:10:19 mclareni Exp $
-*
-* $Log: v1_23,v $
-* Revision 1.1.1.1 1996/02/14 13:10:19 mclareni
-* Higz
-*
-*
-*CMZ : 11/01/96 17.24.46 by O.Couet
-*-- Author : O.Couet 05/05/95
-*
-* 11/01/96 17.23.40 by O.Couet
-* Mods in IGTABL: the box plot is now proportional to the surface
-* of the bin.
-*
-*::> VERSION 1.23/06 07/12/95 16.10.56
-*
-* New routine IGGIF which call ixdogif to generate gif files
-*
-* 06/12/95 15.21.14 by O.Couet
-* It is now possible to load a GIF file in the HIGZ window.
-*
-* 04/12/95 16.08.02 by O.Couet
-* ZBUFFER is now available in X11 and PS modes
-*
-* 30/11/95 15.27.00 by O.Couet
-* The patch OBSOLETE is now removed (ONT).
-*
-* 22/11/95 10.38.53 by O.Couet
-* __stdcall added in the fortran callable C routines under the flags
-* TKTCL and WINNT.
-*
-* 22/11/95 10.14.20 by O.Couet
-* TkHIGZ added in HIGZCC (flaged with TKTCL,WINNT).
-*
-* 15/11/95 09.28.50 by O.Couet
-* The GIFencode routine is suppressed. It is recommended to use
-* xwpick instead.
-*
-* 10/11/95 10.51.30 by O.Couet
-* Mods in IGCOLM
-*
-* 01/11/95 14.05.51 by O.Couet
-* Mods in IMAC (Cees Th. de Laat)
-*
-*::> VERSION 1.23/05 18/10/95 10.14.00
-*
-* In x11int, size_hints and wm_hints are memset to 0.
-*
-* 17/10/95 18.22.29 by O.Couet
-* New routine IGELLI to draw an ellipse.
-*
-* 11/10/95 17.26.20 by O.Couet
-* The default value of CHHE in igset is now 0.28 (like in HPLOT).
-*
-* 04/10/95 17.40.07 by O.Couet
-* IRAST was not initialized in IGTABL
-*
-* 02/10/95 17.14.30 by O.Couet
-* TK_WINDOWS flag in x11int
-*
-*::> VERSION 1.23/04 28/09/95 09.54.20
-*
-* Mods in x11int: free the colors before defining a new one.
-*
-*::> VERSION 1.23/03 20/09/95 14.08.27
-*
-* Bug fixed in IZPM. The marker types different from 1 to 5 produced
-* some PS output in the LaTex files.
-*
-* 05/09/95 15.03.33
-* A +SELF was missing in ISTXAL in IKERNEL
-*
-* 04/09/95 12.17.57
-* Fixes in IGOBJ and IGPICK for the picking in PAW++
-*
-* 01/09/95 09.45.00
-* IKFILE crashed if the file higz_windows.dat was r/w protected.
-*
-*::> VERSION 1.23/02 30/08/95 18.20.27
-*
-* Bug fixed in IZDNB: the alpha numeric labels was not stored
-* in the picture in case of IZMERG.
-*
-* 30/08/95 13.44.39
-* The test of validity on window size in IGSSE is now a
-* .LT.0 test instead of .LE.0 test
-*
-* 29/08/95 11.43.13
-* The PASS attribute is now use as line width for the PS
-* hollow fonts.
-*
-* 15/08/95 17.39.19
-* IKFNTX called IXSETTF as a subroutine, rather than an
-* integer function in the MSDOS part.
-*
-* 07/06/95 17.36.31
-* %%BeginProlog and %%EndProlog was misplaced in PS files.
-*
-* 01/06/95 16.16.50
-* Xflush is now called at the end of ixreqlo (x11int) to be
-* sure that rubberdanding line has been erased.
-*
-* 30/05/95 09.45.20
-* Bug fixed in igaxis: The alignment of the exponent was
-* not correct on the axis drawn on the right of the plots.
-*
-*::> VERSION 1.23/01 24/05/95 11.13.21
-*
-* The "gsave" an "grestore" are now managed via the routine
-* IPSVRT which count the number of gsave in the variable NBSAVE.
-* This allows to write the correct number of grestore at the
-* end of the PS file.
-*
-* 08/05/95 11.51.44
-* New MSDOS version (Valery Fine)
-*
-*::> VERSION 1.23/00 05/05/95 15.25.21
-*
-* In IZGRAP and IZHIST, BORD was not consider as a possible
-* attribute for graphs and histograms.
-*
-* 10/04/95 17.50.26
-* Bug fixed in IGPICK for the picking of IGTABL.
-*
-* 10/04/95 10.39.58
-* New version of IGOBJ which looks in all the NTs if nothing is found
-* in the one the user picked in. A new routine to scan the NTs in a
-* picture has been created for that (IZGNNT).
-*
diff --git a/src/graflib/higz/doc/kumacs/help b/src/graflib/higz/doc/kumacs/help
deleted file mode 100644
index 73ed375..0000000
--- a/src/graflib/higz/doc/kumacs/help
+++ /dev/null
@@ -1,38 +0,0 @@
-*
-* $Id: help,v 1.1.1.1 1996/02/14 13:10:18 mclareni Exp $
-*
-* $Log: help,v $
-* Revision 1.1.1.1 1996/02/14 13:10:18 mclareni
-* Higz
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_higz/pilot.h"
-*CMZ : 1.13/00 06/02/92 15.14.55 by O.Couet
-*-- Author : O.Couet 04/10/91
- Macro HELP
-*
- Mess ' '
- Mess ' The installation procedure of the PAW library is:'
- Mess ' '
- Mess ' CMZ -INSTALL PAW LIB_NAM SRC_DIR OPTIONS'
- Mess ' '
- Mess ' Where :'
- Mess ' '
- Mess ' LIB_NAM is the library name'
- Mess ' '
- Mess ' SRC_DIR is the source directory name'
- Mess ' '
- Mess ' OPTIONS :'
- Mess ' - DEBUG compile with debug option'
- Mess ' '
- Mess ' The installation procedure of the PAW examples is:'
- Mess ' '
- Mess ' CMZ -INSTALL PAW DIR example'
- Mess ' '
- Mess ' Where :'
- Mess ' '
- Mess ' DIR is the directory where the example will be installed'
- Mess ' '
-*
- Return
diff --git a/src/graflib/higz/doc/kumacs/install b/src/graflib/higz/doc/kumacs/install
deleted file mode 100644
index 6816eea..0000000
--- a/src/graflib/higz/doc/kumacs/install
+++ /dev/null
@@ -1,135 +0,0 @@
-*
-* $Id: install,v 1.1.1.1 1996/02/14 13:10:19 mclareni Exp $
-*
-* $Log: install,v $
-* Revision 1.1.1.1 1996/02/14 13:10:19 mclareni
-* Higz
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_higz/pilot.h"
-*CMZ : 2.07/06 11/07/95 17.46.47 by O.Couet
-*-- Author : O.Couet 04/10/91
- Macro INSTALL 1=X 2=ftn 3=X 4=X
-*
- If [1]='?' Then
- Exec help
- Goto END
- Endif
- File hbook
- Pilot *hbook
- Rel hbook
-*
-* Set the FORTRAN extension
-*
- Case $MACHINE In
- (APOLLO) Alias/Create ext ftn
- (IBM) Alias/Create ext fortran
- (VAX) Alias/Create ext for
- (*) Alias/Create ext f
- Endcase
-*
-* LIBRARY Library name
-* CODEDIR Source code directory
-*
- LIBRARY = $Lower([1])
- CODEDIR = $Lower([2])
-*
-* Install the examples
-*
- If [CODEDIR]='example' Then
- Select $MACHINE
- Set [LIBRARY]/*.kumac -D
- Ctot -Y //paw/paxmac/*
- Set [LIBRARY]/*.ext -D
- Ctot //paw/paxfor/*
- Set [LIBRARY]/*.dat -D
- Ctot //paw/paxdat/*
- Goto END
- Endif
-*
- D = FALSE
- M = FALSE
- Do I = 3,[#]
- Case $Upper([%I]) In
- (DEBUG) D = TRUE
- (MOTIF) M = TRUE
- Endcase
- Enddo
-*
- Mess ' '
- Mess Installation of PAWLIB on $MACHINE _
- starting at $DATE $TIME .
- Mess ' '
-*
- Set [CODEDIR]/paw.sh -XADCL
-*
-* Set up the library name
-*
- If [LIBRARY] = 'x' Then
- Set [CODEDIR]/$cmzfile.a -L
- Else
- Set [LIBRARY] -L
- Endif
-*
- If [D] = TRUE Then
- Case $MACHINE In
- (APOLLO) D=' -dba'
- (HPUX,SGI,SUN,DECS,IBMRT) D=' -g'
- (VAX) D='/NOOP/DEB'
- Endcase
- Else
- D=' '
- Endif
-*
- If [M] = TRUE Then
- Sel MOTIF
- Endif
-*
-* Set up the FORTRAN compiling options
-*
- Set FORTRAN -LAN
- Set [CODEDIR]/*.ext -F
- Case $MACHINE In
- (APOLLO) Set '/com/ftn $compfile//[D]//' -indexl -save' -C
- (HPUX) Set 'f77 -c'//[D]//' +ppu $compfile' -C
- (SUN) Set 'f77 -c'//[D]//' -O $compfile' -C
- (IBMRT) Set 'xlf -c'//[D]//' -qextname $compfile' -C
- (SGI,DECS) Set 'f77 -c'//[D]//' $compfile G 3' -C
- (VAX) Set 'FOR'//[D]//' $compfile' -C
- Endcase
-*
-* Select the options
-*
- Select $MACHINE
-*
- Pilot *PAW
-*
-* CMZ, FORTRAN, Library ...
-*
- Set
- seq
- Cfl -P
-*
-* Motif Part
-*
- If [M] = FALSE Goto END
- Set C -LAN
- Set [CODEDIR]/*.c -F
-*
- if $MACHINE = HPUX Then
- OPTC = ' -z -DSYSV -Aa -D_HPUX_SOURCE'
- X11H = ' -I/usr/include/X11R4'
- XMH = ' -I/usr/include/Motif1.1'
- Set 'cc -c'//[D]//[OPTC]//[X11H]//[XMH]//' $compfile' -C
- Endif
- if $MACHINE = IBMRT Then
- Set 'cc -c'//[D]//' $compfile' -C
- Endif
-*
- Pilot *PAW
- Set
- Cfl -P
-*
-END:
- Return
diff --git a/src/graflib/higz/examples/Imakefile b/src/graflib/higz/examples/Imakefile
deleted file mode 100644
index 8c73718..0000000
--- a/src/graflib/higz/examples/Imakefile
+++ /dev/null
@@ -1,16 +0,0 @@
-SRCS_F= hiex1.F hiex2.F hiex3.F hiex4.F hiex5.F hiex6.F
-
-SubdirLibraryTarget(higztlib,NullParameter)
-
-DefinePackageLibrary(higztlib)
-
-#ifndef CERNLIB_WINNT
-CernlibFortranProgramTarget(higzex,higzex.o,$(PACKAGE_LIB),$(PACKAGE_LIB),graflib/X11 packlib)
-#else
-CernlibFortranProgramTarget(higzex,higzex.o,$(PACKAGE_LIB),$(PACKAGE_LIB),graflib)
-#endif
-
-test:
- @echo "----------------------------------------"
- @echo "test for higz is interactive"
- @echo "----------------------------------------"
diff --git a/src/graflib/higz/examples/hiex1.F b/src/graflib/higz/examples/hiex1.F
deleted file mode 100644
index 583b662..0000000
--- a/src/graflib/higz/examples/hiex1.F
+++ /dev/null
@@ -1,85 +0,0 @@
-*
-* $Id: hiex1.F,v 1.1.1.1 1996/02/14 13:10:20 mclareni Exp $
-*
-* $Log: hiex1.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:20 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.18/01 05/05/93 13.47.55 by O.Couet
-*-- Author :
- SUBROUTINE HIEX1
-*.==========>
-*. Example of basic HIGZ. Polylines and fill areas
-*..=========>
-*
- COMMON /QUEST/ RQUEST(100)
- DIMENSION XZ(86),YZ(86)
- DATA XZ/
- + 0.6250,0.6875,0.9063,0.7500,0.7500,0.6875,0.6250,0.6875
- + ,0.7500,0.8750,0.9688,1.0313,1.1563,1.2500,1.3125,1.5000
- + ,1.6875,1.9375,2.0000,2.1250,2.1875,2.1875,2.2500,2.2500
- + ,2.4375,2.4375,2.4688,2.5313,2.5313,2.5000,2.6250,2.6250
- + ,2.7500,2.7188,2.7188,2.7188,2.9375,3.4375,3.7500,4.0625
- + ,4.1250,4.0625,4.1250,4.1875,4.3125,4.3125,4.3125,4.3438
- + ,4.3125,4.4375,4.5000,4.4375,4.4375,4.5625,4.5938,4.7188
- + ,4.7813,4.7500,4.5313,4.5000,4.6250,4.6875,4.7188,4.7500
- + ,4.8750,4.9625,4.9063,4.7500,4.6875,4.6563,4.3750,3.6875
- + ,3.0625,2.8125,2.4375,2.0313,1.6563,1.4688,1.3438,1.3750
- + ,1.4375,1.2500,1.1250,1.0000,0.8750,0.6250/
- DATA YZ/
- + 4.8750,4.6563,4.3750,4.1250,3.8750,3.6250,3.4375,3.3125
- + ,3.1875,3.1563,3.2188,3.3438,3.5000,3.5938,3.6875,3.5625
- + ,3.3125,3.0938,2.8438,2.7000,2.2188,1.8750,1.2813,1.0625
- + ,1.0625,1.8750,2.5000,2.4688,2.1875,1.9688,1.5000,1.2500
- + ,1.2500,1.5313,2.0625,2.6250,2.5938,2.6563,2.7500,3.0000
- + ,2.7188,2.1250,1.6563,1.4375,1.4688,1.6250,2.0313,2.3125
- + ,2.6250,2.3125,2.0625,1.6250,1.5000,1.5000,1.6250,2.0313
- + ,2.3125,2.5000,2.7500,2.9375,3.2500,3.6250,3.2500,2.8125
- + ,2.6250,2.6875,3.0625,3.5625,3.8750,4.0625,4.1875,4.1250
- + ,4.0313,4.0938,4.0625,4.2500,4.4875,4.5000,4.4688,4.6875
- + ,4.8750,4.7188,4.5250,4.4688,4.7188,4.8750/
- DATA NZ/86/
-*
-* Define the size of the Picture in cm
-*
- CALL ICLRWK(0,1)
- CALL IGRNG(14.5,14.5)
- R = RQUEST(11)
- XL = RQUEST(12)
- YB = RQUEST(13)
- CALL IGBOX(0.,14.5,0.,14.5)
- CALL IGTEXT(7.25,13.5,'HIGZ example 1',0.6,0.,'C')
-*
-* Define a new Normalization transformation for each new object
-* The viewports are set in the centimeter space defined by IGRNG
-*
- CALL ISWN(10,0.,5.,0.,5.)
- CALL ISVP(10,0.5*R+XL,6.5*r+XL,6.5*R+YB,11.5*r+YB)
- CALL ISELNT(10)
- CALL IPL(NZ,XZ,YZ)
-*
- CALL ISWN(20,0.,5.,0.,5.)
- CALL ISVP(20,7.5*R+XL,14.*r+XL,6.5*R+YB,11.5*r+YB)
- CALL ISELNT(20)
- CALL ISMK(29)
- CALL IPM(NZ-1,XZ,YZ)
- CALL IPL(NZ ,XZ,YZ)
-*
- CALL ISWN(30,0.,5.,0.,5.)
- CALL ISVP(30,0.5*R+XL,6.5*r+XL,0.5*R+YB,5.5*r+YB)
- CALL ISELNT(30)
- CALL ISFAIS(3)
- CALL ISFASI(256)
- CALL IFA(NZ-1,XZ,YZ)
-*
- CALL ISWN(40,0.,5.,0.,5.)
- CALL ISVP(40,7.5*R+XL,14.*r+XL,0.5*R+YB,5.5*r+YB)
- CALL ISELNT(40)
- CALL ISFASI(290)
- CALL IFA(NZ-1,XZ,YZ)
- CALL ISFAIS(0)
- CALL IFA(NZ-1,XZ,YZ)
-*
- END
diff --git a/src/graflib/higz/examples/hiex2.F b/src/graflib/higz/examples/hiex2.F
deleted file mode 100644
index 5650942..0000000
--- a/src/graflib/higz/examples/hiex2.F
+++ /dev/null
@@ -1,90 +0,0 @@
-*
-* $Id: hiex2.F,v 1.1.1.1 1996/02/14 13:10:21 mclareni Exp $
-*
-* $Log: hiex2.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:21 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.15/00 10/07/92 09.47.37 by O.Couet
-*-- Author :
- SUBROUTINE HIEX2
-*.==========>
-*. Example to plot the table of HIGZ software characters
-*..=========>
-*
- CHARACTER*6 KD1,KD2
- CHARACTER*45 KDG
- CHARACTER*3 KTEXT
- CHARACTER*1 CHOPT
- DIMENSION XPOS(6),X(5),Y(5)
- DATA KD1/' < < <'/
- DATA KD2/' [[""'/
- DATA KDG/'ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789.,+-*/=()'/
- DATA XLONG,YTOP/16.,24./
- DATA SIZE,ANGLE/0.3,0./
-*
- CALL IGRNG(20.,24.)
- CALL ICLRWK(0,1)
-*
- XW = XLONG/12.
- DO 10 I = 1,6
- XPOS(I) = (2*I-1)*XW + 2.5
- 10 CONTINUE
-*
-* Draw the frame
-*
- YLONG = 46*1.5*SIZE + 5*1.5*SIZE
- X(1) = XPOS(1) - XW
- X(2) = XPOS(6) + XW
- X(3) = X(2)
- X(4) = X(1)
- X(5) = X(1)
- Y(1) = YTOP
- Y(2) = Y(1)
- Y(3) = Y(1) - YLONG
- Y(4) = Y(3)
- Y(5) = Y(1)
- CALL IPL(5,X,Y)
- DO 20 I = 1,5
- X(1) = XPOS(I) + XW
- X(2) = X(1)
- Y(1) = YTOP
- Y(2) = Y(1) - YLONG
- CALL IPL(2,X,Y)
- 20 CONTINUE
- X(1) = XPOS(1) - XW
- X(2) = XPOS(6) + XW
- Y(1) = YTOP - 5.*SIZE
- Y(2) = Y(1)
- CALL IPL(2,X,Y)
-*
-* Draw box titles
-*
- Y1 = YTOP - 2.*SIZE
- Y2 = Y1 - 2.*SIZE
- CHOPT='C'
- CALL IGTEXT(XPOS(1),Y1,'Upper' ,SIZE,ANGLE,CHOPT)
- CALL IGTEXT(XPOS(1),Y2,'Roman' ,SIZE,ANGLE,CHOPT)
- CALL IGTEXT(XPOS(2),Y1,'Lower' ,SIZE,ANGLE,CHOPT)
- CALL IGTEXT(XPOS(2),Y2,'Roman' ,SIZE,ANGLE,CHOPT)
- CALL IGTEXT(XPOS(3),Y1,'Upper' ,SIZE,ANGLE,CHOPT)
- CALL IGTEXT(XPOS(3),Y2,'Greek' ,SIZE,ANGLE,CHOPT)
- CALL IGTEXT(XPOS(4),Y1,'L<OWER' ,SIZE,ANGLE,CHOPT)
- CALL IGTEXT(XPOS(4),Y2,'G<REEK' ,SIZE,ANGLE,CHOPT)
- CALL IGTEXT(XPOS(5),Y1,'U<PPER' ,SIZE,ANGLE,CHOPT)
- CALL IGTEXT(XPOS(5),Y2,'Special',SIZE,ANGLE,CHOPT)
- CALL IGTEXT(XPOS(6),Y1,'Lower' ,SIZE,ANGLE,CHOPT)
- CALL IGTEXT(XPOS(6),Y2,'Special',SIZE,ANGLE,CHOPT)
-*
- YP = YTOP - 6.*SIZE
- DO 40 I = 1,45
- YP = YP - 1.5*SIZE
- DO 30 J = 1,6
- KTEXT=KD1(J:J)//KD2(J:J)//KDG(I:I)
- CALL IGTEXT(XPOS(J),YP,KTEXT,SIZE,ANGLE,CHOPT)
- 30 CONTINUE
- 40 CONTINUE
-*
- END
diff --git a/src/graflib/higz/examples/hiex3.F b/src/graflib/higz/examples/hiex3.F
deleted file mode 100644
index 9bf0f28..0000000
--- a/src/graflib/higz/examples/hiex3.F
+++ /dev/null
@@ -1,98 +0,0 @@
-*
-* $Id: hiex3.F,v 1.1.1.1 1996/02/14 13:10:21 mclareni Exp $
-*
-* $Log: hiex3.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:21 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.16/01 18/08/92 10.33.40 by O.Couet
-*-- Author :
- SUBROUTINE HIEX3
-*.==========>
-*. Advanced example to draw text
-*. (based on a PAW macro from W.Walk)
-*..=========>
-*
- DIMENSION X(3),Y(3)
-*
- CALL IGRNG(14.6,18.)
- CALL ICLRWK(0,1)
- CALL IGBOX(0.,14.6,0.,18.)
- CALL IGSET('PASS',10.)
- CALL IGSET('CSHI',0.005)
- CALL ISFAIS(1)
- CALL ISTXCI(1)
- CALL ISTXFP(-13,1)
- CALL ISCHH(0.6)
- CALL ISTXAL(2,0)
- CALL ITX(7.3,17.,'Exclusive Toponium Decays')
- CALL ISTXFP(0,2)
- CALL ISFACI(1)
- CALL IGBOX(5.,7.,15.,14.9)
- CALL IGBOX(5.,7.,3.,2.9)
- CALL IGBOX(3.,5.,14.,13.9)
- CALL IGBOX(3.,5.,2.,1.9)
- CALL IGBOX(10.,12.,13.,12.9)
- CALL IGBOX(10.,12.,12.,11.9)
- CALL IGBOX(10.,12.,11.,10.9)
- CALL IGBOX(6.,8.,12.4,12.3)
- CALL ISPLCI(3)
- X(1)=6.
- X(2)=11.
- X(3)=6.
- Y(1)=15.
- Y(2)=13.
- Y(3)=3.
- CALL IPL(3,X,Y)
- Y(2)=12.
- CALL IPL(3,X,Y)
- Y(2)=11.
- CALL IPL(3,X,Y)
- CALL ISPLCI(2)
- X(2)=4.
- Y(2)=14.
- CALL IPL(3,X,Y)
- Y(2)=2.
- CALL IPL(3,X,Y)
- CALL ISPLCI(4)
- X(2)=X(3)
- Y(2)=1.5
- CALL IPL(2,X(2),Y(2))
- X(1)=X(2)-0.2
- X(3)=X(2)+0.2
- Y(1)=Y(2)+0.3
- Y(3)=Y(1)
- CALL IPL(3,X,Y)
- CALL ISTXCI(4)
- CALL IGTEXT(6.,0.5,'e^+!e^-! or [m]^+![m]^-!',0.5,0.,'C')
- CALL IGTEXT(6.,15.2,'2^3!S?1--!',0.5,0.,'C')
- CALL IGTEXT(6.,3.2,'1^3!S?1--!',0.5,0.,'C')
- CALL IGTEXT(11.,13.2,'1^3!P?2++!',0.5,0.,'C')
- CALL IGTEXT(11.,12.2,'1^3!P?1++!',0.5,0.,'C')
- CALL IGTEXT(11.,11.2,'1^3!P?0++!',0.5,0.,'C')
- CALL IGTEXT(7.,12.6,'1^1!P?1+-!',0.5,0.,'C')
- CALL IGTEXT(4.,14.2,'2^1!S?0-+!',0.5,0.,'C')
- CALL IGTEXT(4., 2.2,'1^1!S?0-+!',0.5,0.,'C')
- CALL ISTXCI(6)
- CALL IGTEXT(4.5,15.,'[Q]?2S!',0.5,0.,'R')
- CALL IGTEXT(7.5,2.75,'[Q]?1S! (80 GeV)',0.5,0.,'L')
- CALL IGTEXT(2.5,13.75,'[c]?t!&^,!',0.5,0.,'R')
- CALL IGTEXT(2.5,1.75,'[c]?t!',0.5,0.,'R')
- CALL IGTEXT(12.5,13.,'[h]^2!&?t!',0.5,0.,'L')
- CALL IGTEXT(12.5,12.,'[h]^1!&?t!',0.5,0.,'L')
- CALL IGTEXT(12.5,11.,'[h]^0!&?t!',0.5,0.,'L')
- CALL ISTXCI(3)
- CALL IGTEXT(1.,9.,'E1',0.5,0.,'C')
- CALL ISTXCI(2)
- CALL IGTEXT(3.,9.,'M1',0.5,0.,'C')
- CALL ISTXCI(3)
- CALL IGTEXT(8.8,14.8,'100 MeV',0.4,0.,'L')
- CALL IGTEXT(8.5,6.,'800 MeV',0.4,0.,'L')
- CALL ISTXCI(6)
- CALL IGTEXT(9.4,14.2,'BR 2"Y',0.3,0.,'L')
- CALL IGTEXT(8.9,5.4,'BR 30"Y',0.3,0.,'L')
- CALL IGSET('*',0.)
-*
- END
diff --git a/src/graflib/higz/examples/hiex4.F b/src/graflib/higz/examples/hiex4.F
deleted file mode 100644
index ae503f4..0000000
--- a/src/graflib/higz/examples/hiex4.F
+++ /dev/null
@@ -1,53 +0,0 @@
-*
-* $Id: hiex4.F,v 1.1.1.1 1996/02/14 13:10:21 mclareni Exp $
-*
-* $Log: hiex4.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:21 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.18/01 06/05/93 12.14.48 by O.Couet
-*-- Author :
- SUBROUTINE HIEX4
-*.==========>
-*. Examples of graphs, histograms and pie charts
-*..=========>
-*
- COMMON /QUEST/ RQUEST(100)
- DIMENSION X(10),Y(10),V(10)
- DATA Y/2.,3.,5.,4.,7.,10.,11.,9.,10.,4./
- DATA X/0.,16.,8*0./
- DATA V/-1.5,1.,2.,4.,4.5,6.,9.,10.,14.,17./
-*
- CALL IGRNG(15.,18.)
- R = RQUEST(11)
- XL = RQUEST(12)
- YB = RQUEST(13)
- CALL ICLRWK(0,1)
- CALL ISTXFP(-13,1)
-*
- CALL ISWN(10,0.,18.,-1.,12.)
- CALL ISVP(10,8.*R+XL,14.*R+XL,11.*R+YB,17.*R+YB)
- CALL ISELNT(10)
- CALL ISMK(29)
- CALL IGHIST(10,X,Y,'AHCP')
-*
- CALL ISWN(20,0.,18.,0.,12.)
- CALL ISVP(20,R+XL,7.*R+XL,11.*R+YB,17.*R+YB)
- CALL ISELNT(20)
- CALL IGHIST(10,X,Y,'AB')
-*
- CALL ISWN(30,-4.,19.,-1.,13.)
- CALL ISVP(30,R+XL,14.*R+XL,R+YB,10.*R+YB)
- CALL ISELNT(30)
- CALL IGAXIS(-3.,19.,1.,1.,-3.,19.,20510,' ')
- CALL IGSET('LASI',0.5)
- CALL IGAXIS(-3.,-3.,1.,12.,1.,12.,510,'H')
- CALL ISMK(21)
- CALL IGRAPH(10,V,Y,'LP')
- CALL ISLN(2)
- CALL IGRAPH(10,V,Y,'C')
- CALL IGSET('*',0.)
-*
- END
diff --git a/src/graflib/higz/examples/hiex5.F b/src/graflib/higz/examples/hiex5.F
deleted file mode 100644
index 418ac62..0000000
--- a/src/graflib/higz/examples/hiex5.F
+++ /dev/null
@@ -1,47 +0,0 @@
-*
-* $Id: hiex5.F,v 1.1.1.1 1996/02/14 13:10:21 mclareni Exp $
-*
-* $Log: hiex5.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:21 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.15/00 10/07/92 09.47.38 by O.Couet
-*-- Author :
- SUBROUTINE HIEX5
-*.==========>
-*. Example using HIGZ and GKS metafiles
-*..=========>
-*
-*
-* Open HIGZ metafile
-* and repeat previous examples
-*
- PRINT *,' WRITING HIGZ METAFILE'
- CALL IGZSET('Z')
- CALL IZOPEN(1,'Pictures','higz.rz','AN',1024,ISTAT)
- CALL IZPICT('ZEBRA','M')
- CALL HIEX1
- CALL IZPICT('SOFT-TABLE','M')
- CALL HIEX2
- CALL IZPICT('TOPONIUM','M')
- CALL HIEX3
- CALL IZPICT('GRAPH','M')
- CALL HIEX4
- CALL IZOUT('GRAPH',ICYCLE)
- CALL IGSA (1)
-*
-* Open GKS metafile
-* and repeat previous examples
-*
- PRINT *,' WRITING GKS METAFILE (BE PATIENT !)'
- CALL IGZSET('G')
- CALL IGMETA(-10,0)
- CALL HIEX1
- CALL HIEX2
- CALL HIEX3
- CALL HIEX4
- CALL IGMETA(0,0)
-*
- END
diff --git a/src/graflib/higz/examples/hiex6.F b/src/graflib/higz/examples/hiex6.F
deleted file mode 100644
index 2790003..0000000
--- a/src/graflib/higz/examples/hiex6.F
+++ /dev/null
@@ -1,48 +0,0 @@
-*
-* $Id: hiex6.F,v 1.1.1.1 1996/02/14 13:10:21 mclareni Exp $
-*
-* $Log: hiex6.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:21 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.15/00 10/07/92 09.47.38 by O.Couet
-*-- Author :
- SUBROUTINE HIEX6
-*.==========>
-*. Example to show how to display pictures in HIGZ files
-*. Invokes the HIGZ editor.
-*..=========>
- CHARACTER*10 STR
- DATA ICYCLE/999/
-*
-* List contents of the ZEBRA/RZ file
-*
- CALL RZLDIR(' ',' ')
-*
-* Read some pictures into memory and display
-*
- CALL IGSET('AURZ',0.)
- CALL IZIN('ZEBRA',ICYCLE)
- CALL IZPICT('ZEBRA','D')
- CALL IRQST(1,1,ISTAT,NCH,STR)
- CALL IZIN('TOPONIUM',ICYCLE)
- CALL IZPICT('TOPONIUM','D')
- CALL IRQST(1,1,ISTAT,NCH,STR)
-*
-* Edit PICT4
-* Select options in the graphics menu
-* For example select the item ARROW in the
-* menu 'PRIMITIVES', select the type of arrow
-* by clicking in the box 'ATTR' and try to superimpose
-* a double-arrow on the picture.
-* Try to change the font and the font size for the top graphs
-* Note that the HIGZ graphics editor can be invoked
-* from PAW (PICTURE/MODIFY command).
-*
- CALL IZGED('GRAPH',' ')
-*
- END
-
-
diff --git a/src/graflib/higz/examples/higzex.F b/src/graflib/higz/examples/higzex.F
deleted file mode 100644
index 1a00710..0000000
--- a/src/graflib/higz/examples/higzex.F
+++ /dev/null
@@ -1,98 +0,0 @@
-*
-* $Id: higzex.F,v 1.2 1997/03/14 14:26:04 mclareni Exp $
-*
-* $Log: higzex.F,v $
-* Revision 1.2 1997/03/14 14:26:04 mclareni
-* WNT mods
-*
-* Revision 1.1.1.1.2.1 1997/01/21 11:25:16 mclareni
-* All mods for Winnt 96a on winnt branch
-*
-* Revision 1.1.1.1 1996/02/14 13:10:20 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.15/00 10/07/92 09.47.37 by O.Couet
-*-- Author :
- PROGRAM HIGZEX
-*.==========>
-*.
-*. HIGZ TEST PROGRAM
-*.
-*..=========>
- COMMON/PAWC/H(20000)
- LOGICAL INTRAC
- CHARACTER*80 STR
- CHARACTER*(*) HZFILE
-#if (defined(CERNLIB_IBM))&&(!defined(CERNLIB_PSCRIPT))
- PARAMETER (HZFILE='/HIGZ METAFILE')
-#endif
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB_PSCRIPT))
- PARAMETER (HZFILE='/HIGZ PS')
-#endif
-#if (!defined(CERNLIB_IBM))&&(!defined(CERNLIB_PSCRIPT))
- PARAMETER (HZFILE='higz.metafile')
-#endif
-#if (!defined(CERNLIB_IBM))&&(defined(CERNLIB_PSCRIPT))
- PARAMETER (HZFILE='higz.ps')
-#endif
-
-*.___________________________________________
-*
-#if defined(CERNLIB_IBM)
- CALL ERRSET(151,999,-1)
-#endif
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB_X11))
- CALL INITC()
-#endif
- OPEN(10,FILE=HZFILE,FORM='FORMATTED',STATUS='UNKNOWN')
- CALL MZEBRA(-3)
- CALL MZPAW(20000,' ')
- CALL IGINIT(0)
- IF(.NOT.INTRAC())THEN
- INTER=0
- KWTYPE=0
- ELSE
- CALL IGWKTY(KWTYPE)
- INTER=1
- ENDIF
- CALL IGSSE(6,KWTYPE)
- IF(INTER.EQ.0)GOTO 10
- CALL HIEX1
- CALL IRQST(1,1,ISTAT,NCH,STR)
-*
-* Switch to alpha mode. Note that IGSSE has preset the
-* workstation identifier to 1
-*
- CALL IGSA (1)
-*
- PRINT *, ' Example 1 completed'
- CALL HIEX2
- CALL IRQST(1,1,ISTAT,NCH,STR)
- CALL IGSA (1)
- PRINT *, ' Example 2 completed'
-*
- CALL HIEX3
- CALL IRQST(1,1,ISTAT,NCH,STR)
- CALL IGSA (1)
- PRINT *, ' Example 3 completed'
-*
- CALL HIEX4
- CALL IRQST(1,1,ISTAT,NCH,STR)
- CALL IGSA (1)
- PRINT *, ' Example 4 completed'
-*
- 10 CALL HIEX5
- IF(INTER.EQ.0)GOTO 20
- CALL IGSA (1)
- PRINT *, ' Example 5 completed'
-*
-* Replay some pictures from the HIGZ metafile
-*
- CALL HIEX6
- CALL IGSA (1)
- PRINT *, ' Example 6 completed'
-*
- 20 CALL IGEND
- END
diff --git a/src/graflib/higz/ged/Imakefile b/src/graflib/higz/ged/Imakefile
deleted file mode 100644
index 2d60385..0000000
--- a/src/graflib/higz/ged/Imakefile
+++ /dev/null
@@ -1,14 +0,0 @@
-SRCS_F= iealpt.F iearc.F iearro.F ieaxis.F iebox.F iecpa.F \ @@\
- iedele.F iefa.F iefbox.F iegrid.F iemaca.F iemaxa.F iemboa.F \ @@\
- iemfaa.F iemfba.F iemhia.F iemopr.F iempla.F iempma.F iemsta.F \ @@\
- iemtxa.F iepave.F iepl.F iepm.F iepop.F iestx.F ietx.F iewin.F \ @@\
- igbord.F igccol.F igcfai.F igclwn.F igex.F igfirs.F iggrid.F \ @@\
- igicol.F igifai.F iginme.F igline.F igplot.F igreq.F izged.F \ @@\
- izpick.F izpiwi.F izpkfa.F izpkpl.F izundo.F
-
-#ifdef CERNLIB_SUN
-SpecialFortranLibObjectRule(iecpa,iecpa,NullParameter,NullParameter)
-SpecialFortranLibObjectRule(izged,izged,NullParameter,NullParameter)
-#endif
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/graflib/higz/ged/Imakefile.dgks b/src/graflib/higz/ged/Imakefile.dgks
deleted file mode 100644
index e6ea48b..0000000
--- a/src/graflib/higz/ged/Imakefile.dgks
+++ /dev/null
@@ -1,13 +0,0 @@
-SRCS_F= iealpt.F iearc.F iearro.F ieaxis.F iebox.F iecpa.F \ @@\
- iedele.F iefa.F iefbox.F iegrid.F iemaca.F iemaxa.F iemboa.F \ @@\
- iemfaa.F iemfba.F iemhia.F iemopr.F iempla.F iempma.F iemsta.F \ @@\
- iemtxa.F iepave.F iepl.F iepm.F iepop.F iestx.F ietx.F iewin.F \ @@\
- igbord.F igccol.F igcfai.F igclwn.F igex.F igfirs.F iggrid.F \ @@\
- igicol.F igifai.F iginme.F igline.F igplot.F igreq.F izged.F \ @@\
- izpick.F izpiwi.F izpkfa.F izpkpl.F izundo.F
-
-SubdirExtraLibraryTarget(NullParameter,NullParameter,NullParameter,dgks)
-
-VersionFortranObjectRule(dgks,NullParameter,-DCERNLIB_DECGKS)
-
-BuildNamedMakefileTarget(Makefile.dgks,Imakefile.dgks,-DCERNLIB_DECGKS)
diff --git a/src/graflib/higz/ged/iealpt.F b/src/graflib/higz/ged/iealpt.F
deleted file mode 100644
index 6b16049..0000000
--- a/src/graflib/higz/ged/iealpt.F
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: iealpt.F,v 1.1.1.1 1996/02/14 13:10:21 mclareni Exp $
-*
-* $Log: iealpt.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:21 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.06/03 16/12/88 14.00.39 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE IEALPT(X,Y)
-*.===========>
-*.
-*. Align couple of point if they are very close in X or Y
-*.
-*..==========> (O.Couet)
-#include "higz/hiatt.inc"
- PARAMETER (RALGN=0.008)
- DIMENSION X(*),Y(*)
-*.______________________________________
-*
- DX=(RWXMAX-RWXMIN)*RALGN
- DY=(RWYMAX-RWYMIN)*RALGN
- IF(ABS(X(2)-X(1)).LT.DX)THEN
- X(2)=X(1)
- ENDIF
- IF(ABS(Y(2)-Y(1)).LT.DY)THEN
- Y(2)=Y(1)
- ENDIF
-*
- END
diff --git a/src/graflib/higz/ged/iearc.F b/src/graflib/higz/ged/iearc.F
deleted file mode 100644
index e77bd2a..0000000
--- a/src/graflib/higz/ged/iearc.F
+++ /dev/null
@@ -1,180 +0,0 @@
-*
-* $Id: iearc.F,v 1.2 1996/09/25 14:56:58 couet Exp $
-*
-* $Log: iearc.F,v $
-* Revision 1.2 1996/09/25 14:56:58 couet
-* - GPR driver removed
-*
-* Revision 1.1.1.1 1996/02/14 13:10:21 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.12/15 16/07/91 10.13.22 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE IEARC(ICF,ICHOIO)
-*.===========>
-*.
-*..==========> (O.Couet)
-#include "higz/hiques.inc"
-#include "higz/hiatt.inc"
-#include "higz/higed.inc"
-#include "higz/hiflag.inc"
-#include "higz/hiloc.inc"
- CHARACTER*4 CHVAL(15)
-*.______________________________________
-*
- ICHOIO=0
- 10 IPLACE=2
- CALL IGREQ(21,3,16,IPLACE,ICHOIC,CHVAL)
- IF(ICHOIC.EQ.-1000)GOTO 10
-*
- 20 X(1)=RQUEST(13)
- Y(1)=RQUEST(14)
- XN=RQUEST(11)
- YN=RQUEST(12)
- NTLOC=IQUEST(10)
-*
- IF(IPLACE.EQ.3)GOTO 10
-*
- IF(IPLACE.EQ.1)THEN
- ICF=1
- ICHOIO=ICHOIC
- RETURN
- ENDIF
-*
- IF(ICHOIC.EQ.-1)THEN
- CALL IEMACA(IPLACE,ICHOIC)
- GOTO 20
- ENDIF
-*
- IF(ICHOIC.EQ.-2)THEN
- CALL IGCLES
- CALL IZPICT(EDIPIC,'D')
- CALL IEGRID
- GOTO 10
- ENDIF
-*
- IF(ICHOIC.EQ.-3)THEN
- CALL IZUNDO
- GOTO 10
- ENDIF
-*
- IF(ICHOIC.GE.1)THEN
- ICF=2
- ICHOIO=ICHOIC
- RETURN
- ENDIF
-*
- ZFLAG=.TRUE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- CALL ISELNT(NTLOC)
- CALL IGGRID(X(1),Y(1))
- CALL IGPLOT(X(1),Y(1))
-#if defined(CERNLIB_GL)||defined(CERNLIB_X11)
- 30 CALL IGLOC(31,NTLOC,IBN,XNDC,YNDC,X(2),Y(2))
-#endif
-#if (!defined(CERNLIB_GL))&&(!defined(CERNLIB_X11))
- 30 CALL IGLOC(41,NTLOC,IBN,XNDC,YNDC,X(2),Y(2))
-#endif
- IF(IBN.EQ.0)GOTO 10
- CALL IGGRID(X(2),Y(2))
- CALL IEALPT(X(1),Y(1))
- OLDXP=XN
- OLDYP=YN
- IF(NTLOC.NE.INTR)GOTO 30
- CALL IGPLOT(X(2),Y(2))
- 40 CALL IGLOC(41,NTLOC,IBN,XNDC,YNDC,X(3),Y(3))
- IF(IBN.EQ.0)THEN
- XC=X(1)
- YC=Y(1)
- R1=SQRT((X(2)-X(1))**2+(Y(2)-Y(1))**2)
- R2=R1
- PHIMIN=0.
- PHIMAX=0.
- GOTO 60
- ELSE
- CALL IGGRID(X(3),Y(3))
- CALL IEALPT(X(2),Y(2))
- OLDXP=XN
- OLDYP=YN
- ENDIF
- IF(NTLOC.NE.INTR)GOTO 40
- CALL IGPLOT(X(3),Y(3))
-*
- 50 CALL IGLOC(31,NTLOC,IBN,XNDC,YNDC,X(4),Y(4))
- IF(IBN.EQ.0)THEN
- XC=X(1)
- YC=Y(1)
- R1=SQRT((X(2)-X(1))**2+(Y(2)-Y(1))**2)
- R2=R1
- R3=SQRT((X(3)-X(1))**2+(Y(3)-Y(1))**2)
- DELTA = Y(2) - Y(1)
- IF (DELTA .NE. 0) THEN
- DELTA = SIGN(MIN(1.0,ABS(DELTA/R1)),DELTA)
- PHIMIN=(ASIN(DELTA)*180.)/3.1415926
- IF(X(2).LT.X(1)) THEN
- PHIMIN=180-PHIMIN
- ELSE IF(Y(2).LT.Y(1)) THEN
- PHIMIN=PHIMIN+360
- END IF
- ELSE
- PHIMIN = 0.0
- END IF
-*
- DELTA = Y(3) - Y(1)
- IF (DELTA .NE. 0) THEN
- DELTA = SIGN(MIN(1.0,ABS(DELTA/R3)),DELTA)
- PHIMAX=(ASIN(DELTA)*180.)/3.1415926
- IF(X(3).LT.X(1)) THEN
- PHIMAX=180-PHIMAX
- ELSE IF(Y(3).LT.Y(1)) THEN
- PHIMAX=PHIMAX+360
- END IF
- ELSE
- PHIMAX = 0.0
- END IF
- GOTO 60
- ELSE
- XC=X(1)
- YC=Y(1)
- R1=SQRT((X(2)-X(1))**2+(Y(2)-Y(1))**2)
- R2=SQRT((X(4)-X(1))**2+(Y(4)-Y(1))**2)
- R3=SQRT((X(3)-X(1))**2+(Y(3)-Y(1))**2)
- DELTA = Y(2) - Y(1)
- IF (DELTA .NE. 0) THEN
- DELTA = SIGN(MIN(1.0,ABS(DELTA/R1)),DELTA)
- PHIMIN=(ASIN(DELTA)*180.)/3.1415926
- IF(X(2).LT.X(1)) THEN
- PHIMIN=180-PHIMIN
- ELSE IF(Y(2).LT.Y(1)) THEN
- PHIMIN=PHIMIN+360
- END IF
- ELSE
- PHIMIN = 0.0
- END IF
-*
- DELTA = Y(3) - Y(1)
- IF (DELTA .NE. 0) THEN
- DELTA = SIGN(MIN(1.0,ABS(DELTA/R3)),DELTA)
- PHIMAX=(ASIN(DELTA)*180.)/3.1415926
- IF(X(3).LT.X(1)) THEN
- PHIMAX=180-PHIMAX
- ELSE IF(Y(3).LT.Y(1)) THEN
- PHIMAX=PHIMAX+360
- END IF
- ELSE
- PHIMAX = 0.0
- END IF
- CALL IGGRID(X(4),Y(4))
- ENDIF
-*
- 60 CALL ISFAIS(ICACFI)
- CALL ISFASI(ICACFS)
- CALL ISFACI(ICACFC)
- CALL ISPLCI(ICACLC)
- CALL IGSET('BORD',FLOAT(ICACBO))
- CALL IGARC(XC,YC,R1,R2,PHIMIN,PHIMAX)
- GOTO 10
-*
- END
diff --git a/src/graflib/higz/ged/iearro.F b/src/graflib/higz/ged/iearro.F
deleted file mode 100644
index d21b39a..0000000
--- a/src/graflib/higz/ged/iearro.F
+++ /dev/null
@@ -1,195 +0,0 @@
-*
-* $Id: iearro.F,v 1.1.1.1 1996/02/14 13:10:21 mclareni Exp $
-*
-* $Log: iearro.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:21 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.07/01 19/07/89 10.47.23 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE IEARRO(ICF,ICHOIO)
-*.===========>
-*.
-*..==========> (O.Couet)
-#include "higz/hiques.inc"
-#include "higz/hiatt.inc"
-#include "higz/higed.inc"
-#include "higz/hiflag.inc"
- CHARACTER*32 CHVAL(15)
- CHARACTER*12 CHTEMP
- DIMENSION UU(3),VV(3),UU1(3),VV1(3)
-*.______________________________________
-*
- ICHOIO=0
- 10 IPLACE=2
- ZFLAG=.TRUE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- NTSAV=INTR
- CALL ISELNT(1)
- CALL IGREQ(21,3,16,IPLACE,ICHOIC,CHVAL)
- IF(ICHOIC.EQ.-1000)GOTO 10
-*
- 20 X(1)=RQUEST(13)
- Y(1)=RQUEST(14)
- CALL IGGRID(X(1),Y(1))
- NTLOC=IQUEST(10)
-*
- 40 IF(IPLACE.EQ.1)THEN
- ICF=1
- ICHOIO=ICHOIC
- CALL ISELNT(NTSAV)
- RETURN
- ENDIF
-*
- IF(IPLACE.EQ.3)GOTO 10
-*
- IF(ICHOIC.EQ.-1)THEN
- TITLE(3)='ARROW ATTRIBUTES'
- CHITEM(1,3)='Arrow size'
- CHITEM(2,3)='Double arrow'
- CHITEM(3,3)='Filled arrow'
- CHITEM(4,3)='Fill area color'
- CHITEM(5,3)='Line color'
- CHITEM(6,3)='Fill interior style'
- CHITEM(7,3)='Fill style index'
- CHITEM(8,3)='Line type'
- CALL IZRTOC(RCARSI,CHDEF(1))
- CHDEF(2)=CHDOAR
- CHDEF(3)=CHAFL
- CHDEF(4)=CHARFC
- CHDEF(5)=CHARLC
- CHDEF(6)=CHARFI
- CALL IZITOC(ICARFS,CHDEF(7))
- CALL IZITOC(ICARLN,CHDEF(8))
- IPLACE=3
- CALL ISELNT(1)
- CALL IGREQ(299,0,8,IPLACE,ICHOIC,CHVAL)
- ICHOIO=ICHOIC
- ICF=IPLACE
- CALL IZCTOR(CHVAL(1),RCARSI)
- CALL IGFIRS(CHDOAR,CHVAL(2))
- CALL IGFIRS(CHAFL,CHVAL(3))
- CALL IGFIRS(CHARFC,CHVAL(4))
- CALL IGFIRS(CHARLC,CHVAL(5))
- CALL IGFIRS(CHARFI,CHVAL(6))
- ICARFC=IGICOL(CHVAL(4))
- ICARLC=IGICOL(CHVAL(5))
- ICARFI=IGIFAI(CHVAL(6))
- CHTEMP=CHVAL(7)
- CALL IZCTOI(CHTEMP,ICARFS)
- CHTEMP=CHVAL(8)
- CALL IZCTOI(CHTEMP,ICARLN)
- GOTO 20
- ENDIF
-*
- IF(ICHOIC.EQ.-2)THEN
- CALL IGCLES
- CALL IZPICT(EDIPIC,'D')
- CALL IEGRID
- GOTO 10
- ENDIF
-*
- IF(ICHOIC.EQ.-3)THEN
- CALL IZUNDO
- GOTO 10
- ENDIF
-*
- IF(ICHOIC.GE.1)THEN
- ICF=2
- ICHOIO=ICHOIC
- CALL ISELNT(NTSAV)
- RETURN
- ENDIF
-*
- I=2
- ZFLAG=.TRUE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- IF(NTLOC.NE.1)THEN
- I=1
- ENDIF
- CALL ISELNT(1)
- ZFLAG=.FALSE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- CALL IGPLOT(X(1),Y(1))
- 50 CALL IGLOC(41,NTLOC,IBN,XNDC,YNDC,X(I),Y(I))
- IF(IBN.EQ.1)THEN
- IF(NTLOC.NE.1)GOTO 50
- IF(I.EQ.1)GOTO 51
- CALL IGGRID(X(I),Y(I))
- CALL IEALPT(X(I-1),Y(I-1))
- CALL IGLINE(X(I-1),X(I),Y(I-1),Y(I))
- 51 I=I+1
- GOTO 50
- ENDIF
-*
- ZFLAG=.FALSE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- GFLAG=.TRUE.
- CALL IZSAV
- CALL ISPLCI(0)
- CALL ISLN(1)
- CALL IPL(I-1,X,Y)
- CALL IZSET
- ZFLAG=.TRUE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- CALL ISPLCI(ICARLC)
- CALL ISFACI(ICARFC)
- CALL ISFAIS(ICARFI)
- CALL ISFASI(ICARFS)
- CALL ISLN(ICARLN)
- IF(RCARSI.LE.0.)GOTO 10
- TGAR=0.6
- FSIN=0.
- FCOS=1.
- XL=SQRT((X(I-1)-X(I-2))**2 + (Y(I-1)-Y(I-2))**2)
- IF(XL.GT.0.)THEN
- FSIN=(Y(I-1)-Y(I-2))/XL
- FCOS=(X(I-1)-X(I-2))/XL
- ENDIF
- UU(1)=X(I-2)+(XL-RCARSI)*FCOS-RCARSI*TGAR*FSIN
- UU(3)=X(I-2)+(XL-RCARSI)*FCOS+RCARSI*TGAR*FSIN
- VV(1)=Y(I-2)+(XL-RCARSI)*FSIN+RCARSI*TGAR*FCOS
- VV(3)=Y(I-2)+(XL-RCARSI)*FSIN-RCARSI*TGAR*FCOS
- UU(2)=X(I-1)
- VV(2)=Y(I-1)
- IF(INDEX(CHVAL(3),'Y').NE.0)THEN
- CALL IFA(3,UU,VV)
- ELSE
- CALL IPL(3,UU,VV)
- ENDIF
- IF(INDEX(CHVAL(2),'Y').NE.0)THEN
- TGAR=0.6
- FSIN=0.
- FCOS=1.
- XL=SQRT((X(1)-X(2))**2 + (Y(1)-Y(2))**2)
- IF(XL.GT.0.)THEN
- FSIN=(Y(1)-Y(2))/XL
- FCOS=(X(1)-X(2))/XL
- ENDIF
- UU1(1)=X(2)+(XL-RCARSI)*FCOS-RCARSI*TGAR*FSIN
- UU1(3)=X(2)+(XL-RCARSI)*FCOS+RCARSI*TGAR*FSIN
- VV1(1)=Y(2)+(XL-RCARSI)*FSIN+RCARSI*TGAR*FCOS
- VV1(3)=Y(2)+(XL-RCARSI)*FSIN-RCARSI*TGAR*FCOS
- UU1(2)=X(1)
- VV1(2)=Y(1)
- IF(INDEX(CHVAL(3),'Y').NE.0)THEN
- CALL IFA(3,UU1,VV1)
- ELSE
- CALL IPL(3,UU1,VV1)
- ENDIF
- ENDIF
- IF(INDEX(CHVAL(3),'Y').NE.0)THEN
- X(I-1)=(UU(3)+UU(1))/2.
- Y(I-1)=(VV(3)+VV(1))/2.
- IF(INDEX(CHVAL(2),'Y').NE.0)THEN
- X(1)=(UU1(3)+UU1(1))/2.
- Y(1)=(VV1(3)+VV1(1))/2.
- ENDIF
- ENDIF
- CALL IPL(I-1,X,Y)
- 70 CONTINUE
- GOTO 10
-*
- END
diff --git a/src/graflib/higz/ged/ieaxis.F b/src/graflib/higz/ged/ieaxis.F
deleted file mode 100644
index 15ce5f9..0000000
--- a/src/graflib/higz/ged/ieaxis.F
+++ /dev/null
@@ -1,99 +0,0 @@
-*
-* $Id: ieaxis.F,v 1.1.1.1 1996/02/14 13:10:21 mclareni Exp $
-*
-* $Log: ieaxis.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:21 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.07/01 19/07/89 10.47.24 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE IEAXIS(ICF,ICHOIO)
-*.===========>
-*.
-*..==========> (O.Couet)
-#include "higz/hiques.inc"
-#include "higz/hiatt.inc"
-#include "higz/higed.inc"
-#include "higz/hiflag.inc"
- CHARACTER*4 CHVAL(15)
-*.______________________________________
-*
- ICHOIO=0
- 201 IPLACE=2
- CALL IGREQ(21,3,16,IPLACE,ICHOIC,CHVAL)
- IF(ICHOIC.EQ.-1000)GOTO 201
-*
- 203 X(1)=RQUEST(13)
- Y(1)=RQUEST(14)
- NTLOC=IQUEST(10)
-*
- IF(IPLACE.EQ.3)GOTO 201
-*
- IF(IPLACE.EQ.1)THEN
- ICF=1
- ICHOIO=ICHOIC
- RETURN
- ENDIF
-*
- IF(ICHOIC.EQ.-1)THEN
- CALL IEMAXA(IPLACE,ICHOIC)
- GOTO 203
- ENDIF
-*
- IF(ICHOIC.EQ.-2)THEN
- CALL IGCLES
- CALL IZPICT(EDIPIC,'D')
- CALL IEGRID
- GOTO 201
- ENDIF
-*
- IF(ICHOIC.EQ.-3)THEN
- CALL IZUNDO
- GOTO 201
- ENDIF
-*
- IF(ICHOIC.GE.1)THEN
- ICF=2
- ICHOIO=ICHOIC
- RETURN
- ENDIF
-*
- ZFLAG=.TRUE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- CALL ISELNT(NTLOC)
- CALL IGGRID(X(1),Y(1))
- CALL IGPLOT(X(1),Y(1))
- CALL IGLOC(41,NTLOC,IBN,XNDC,YNDC,X(2),Y(2))
- IF(IBN.EQ.1)THEN
- IF(NTLOC.NE.INTR)GOTO 202
- CALL IGGRID(X(2),Y(2))
- CALL IEALPT(X,Y)
- CALL IGLINE(X(1),X(2),Y(1),Y(2))
- GOTO 202
- ELSE
- GOTO 201
- ENDIF
-*
- 202 ZFLAG=.FALSE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- CALL IZSAV
- CALL ISPLCI(0)
- CALL ISLN(1)
- CALL IPL(2,X,Y)
- CALL IZSET
-*
- ZFLAG=.TRUE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- CALL ISELNT(NTLOC)
- CALL IGSET('TMSI',RCAXTS)
- CALL IGSET('LASI',RCAXLS)
- CALL IGSET('LAOF',RCAXLO)
- CALL ISLN(ICAXLN)
- CALL ISPLCI(ICAXLC)
- CALL ISTXFP(ICAXLF,ICAXLP)
- CALL IGAXIS(X(1),X(2),Y(1),Y(2),RCAXW1,RCAXW2,ICAXND,CHOPAX)
- GOTO 201
-*
- END
diff --git a/src/graflib/higz/ged/iebox.F b/src/graflib/higz/ged/iebox.F
deleted file mode 100644
index ff3b40e..0000000
--- a/src/graflib/higz/ged/iebox.F
+++ /dev/null
@@ -1,82 +0,0 @@
-*
-* $Id: iebox.F,v 1.1.1.1 1996/02/14 13:10:21 mclareni Exp $
-*
-* $Log: iebox.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:21 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.07/01 19/07/89 10.47.24 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE IEBOX(ICF,ICHOIO)
-*.===========>
-*.
-*..==========> (O.Couet)
-#include "higz/hiques.inc"
-#include "higz/hiatt.inc"
-#include "higz/higed.inc"
-#include "higz/hiflag.inc"
- CHARACTER*4 CHVAL(15)
-*.______________________________________
-*
- ICHOIO=0
- 201 IPLACE=2
- CALL IGREQ(21,3,16,IPLACE,ICHOIC,CHVAL)
- IF(ICHOIC.EQ.-1000)GOTO 201
-*
- 203 X(1)=RQUEST(13)
- Y(1)=RQUEST(14)
- NTLOC=IQUEST(10)
-*
- IF(IPLACE.EQ.3)GOTO 201
-*
- IF(IPLACE.EQ.1)THEN
- ICF=1
- ICHOIO=ICHOIC
- RETURN
- ENDIF
-*
- IF(ICHOIC.EQ.-1)THEN
- CALL IEMBOA(IPLACE,ICHOIC)
- GOTO 203
- ENDIF
-*
- IF(ICHOIC.EQ.-2)THEN
- CALL IGCLES
- CALL IZPICT(EDIPIC,'D')
- CALL IEGRID
- GOTO 201
- ENDIF
-*
- IF(ICHOIC.EQ.-3)THEN
- CALL IZUNDO
- GOTO 201
- ENDIF
-*
- IF(ICHOIC.GE.1)THEN
- ICF=2
- ICHOIO=ICHOIC
- RETURN
- ENDIF
-*
- ZFLAG=.TRUE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- CALL ISELNT(NTLOC)
- CALL IGGRID(X(1),Y(1))
- ZFLAG=.FALSE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- CALL IGPLOT(X(1),Y(1))
- ZFLAG=.TRUE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- 202 CALL IGLOC(51,NTLOC,IBN,XNDC,YNDC,X(2),Y(2))
- IF(NTLOC.NE.INTR)GOTO 202
- CALL IGGRID(X(2),Y(2))
- CALL ISFAIS(ICBOIS)
- CALL ISFASI(ICBOSI)
- CALL ISFACI(ICBOCI)
- CALL IGSET('BORD',FLOAT(ICBOBO))
- CALL IGBOX(X(1),X(2),Y(1),Y(2))
- GOTO 201
-*
- END
diff --git a/src/graflib/higz/ged/iecpa.F b/src/graflib/higz/ged/iecpa.F
deleted file mode 100644
index 44c47a6..0000000
--- a/src/graflib/higz/ged/iecpa.F
+++ /dev/null
@@ -1,587 +0,0 @@
-*
-* $Id: iecpa.F,v 1.1.1.1 1996/02/14 13:10:22 mclareni Exp $
-*
-* $Log: iecpa.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:22 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.07/01 19/07/89 10.47.24 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE IECPA(ICF,ICHOIO)
-*.===========>
-*.
-*. Change the attributes of an existing primitive
-*.
-*..==========> (O.Couet)
-#include "higz/hipaw.inc"
-#include "higz/higed.inc"
-#include "higz/hiaca.inc"
-#include "higz/hiflag.inc"
-#include "higz/hicode.inc"
- DIMENSION IOPT(30)
- LOGICAL CHOFLA
- CHARACTER*8 SNAME
- CHARACTER*16 CHVALL
- CHARACTER*1 CHAXIS(22),CHHIST(14),CHTEXT(3)
- CHARACTER*80 STR
- CHARACTER*4 CHVAL(15)
- DATA CHAXIS /'G','B','A','V','+','-','U','P','O'
- +, 'R','L','C','=','.','H','D','Y','T'
- +, 'W','S','N','I'/
- DATA CHHIST /'H','F','C','*','R','1','B','N','L'
- +, 'P','A','G','X','Y'/
- DATA CHTEXT /'L','C','R'/
-*.______________________________________
-*
- ICHOIO=0
- 10 IPLACE=2
- CALL IGREQ(21,3,16,IPLACE,ICHOIC,CHVAL)
- IF(IPLACE.EQ.3)GOTO 10
- IF(IPLACE.EQ.1)THEN
- ICF=1
- ICHOIO=ICHOIC
- RETURN
- ENDIF
- IF(ICHOIC.EQ.-1000)GOTO 10
- IF(ICHOIC.EQ.-1)GOTO 10
- IF(ICHOIC.EQ.-2)THEN
- CALL IGCLES
- CALL IZPICT(EDIPIC,'D')
- CALL IEGRID
- GOTO 10
- ENDIF
- IF(ICHOIC.EQ.-3)THEN
- CALL IZUNDO
- GOTO 10
- ENDIF
- IF(ICHOIC.GE.1)THEN
- ICF=2
- ICHOIO=ICHOIC
- RETURN
- ENDIF
-*
- ZFLAG=.TRUE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- GFLAG=.TRUE.
- CHOFLA=.FALSE.
- ICHOPT=0
- CALL IZPICK(NT,SNAME,NPRIM,'N')
- IF(NPRIM.LE.0)GOTO 90
- LN=IZGNTP(NT)
- IF(LN.EQ.0)GOTO 90
- ZFLAG=.TRUE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- CALL ISELNT(NT)
- IDIAA=IZGADR(LHNT,8)
- IDRAA=IZGADR(LHNT,9)
-*
- IPRICO=ABS(IZGCOD(LHNT,NPRIM))
- IF(IPRICO.EQ.IFACO)THEN
- CALL IZSCAN(LHNT,IFAICO,IADRAT,-1,IPOS)
- IF(IPOS.NE.0)THEN
- ICFAIS=IZGADR(LHNT,IPOS)-100000
- ELSE
- ICFAIS=IQ(LHI+IDIAA+IFAICO-80)
- ENDIF
- CALL IGCFAI(ICFAIS,CHVALL)
- CALL IGFIRS(CHFAIS,CHVALL)
- CALL IZSCAN(LHNT,IFASCO,IADRAT,-1,IPOS)
- IF(IPOS.NE.0)THEN
- ICFASI=IZGADR(LHNT,IPOS)-100000
- ELSE
- ICFASI=IQ(LHI+IDIAA+IFASCO-80)
- ENDIF
- CALL IZSCAN(LHNT,IFACCO,IADRAT,-1,IPOS)
- IF(IPOS.NE.0)THEN
- ICFACI=IZGADR(LHNT,IPOS)-100000
- ELSE
- ICFACI=IQ(LHI+IDIAA+IFACCO-80)
- ENDIF
- CALL IGCCOL(ICFACI,CHVALL)
- CALL IGFIRS(CHFAC,CHVALL)
- CALL IEMFAA(IPLACE,ICHOIO)
- CALL IZCFA(IFAICO,1)
- CALL IZCFA(IFASCO,1)
- CALL IZCFA(IFACCO,1)
-*
- ELSEIF(IPRICO.EQ.IARCCO)THEN
- CALL IZSCAN(LHNT,IFAICO,IADRAT,-1,IPOS)
- IF(IPOS.NE.0)THEN
- ICACFI=IZGADR(LHNT,IPOS)-100000
- ELSE
- ICACFI=IQ(LHI+IDIAA+IFAICO-80)
- ENDIF
- CALL IGCFAI(ICACFI,CHVALL)
- CALL IGFIRS(CHACIS,CHVALL)
- CALL IZSCAN(LHNT,IFASCO,IADRAT,-1,IPOS)
- IF(IPOS.NE.0)THEN
- ICACFS=IZGADR(LHNT,IPOS)-100000
- ELSE
- ICACFS=IQ(LHI+IDIAA+IFASCO-80)
- ENDIF
- CALL IZSCAN(LHNT,IFACCO,IADRAT,-1,IPOS)
- IF(IPOS.NE.0)THEN
- ICACFC=IZGADR(LHNT,IPOS)-100000
- ELSE
- ICACFC=IQ(LHI+IDIAA+IFACCO-80)
- ENDIF
- CALL IGCCOL(ICACFC,CHVALL)
- CALL IGFIRS(CHACFC,CHVALL)
- CALL IZSCAN(LHNT,IPLCCO,IADRAT,-1,IPOS)
- IF(IPOS.NE.0)THEN
- ICACLC=IZGADR(LHNT,IPOS)-100000
- ELSE
- ICACLC=IQ(LHI+IDIAA+IPLCCO-80)
- ENDIF
- CALL IGCCOL(ICACLC,CHVALL)
- CALL IGFIRS(CHACLC,CHVALL)
- CALL IZSCAN(LHNT,IBORCO,IADRAT,-1,IPOS)
- IF(IPOS.NE.0)THEN
- ICACBO=IZGADR(LHNT,IPOS)-100000
- ELSE
- ICACBO=IQ(LHI+IDIAA+IBORCO-80)
- ENDIF
- IF(ICACBO.EQ.1)THEN
- CHACBO='Yes,No'
- ELSE
- CHACBO='No,Yes'
- ENDIF
- CALL IEMACA(IPLACE,ICHOIO)
- CALL IZCFA(IFAICO,1)
- CALL IZCFA(IFASCO,1)
- CALL IZCFA(ILNCO,1)
- CALL IZCFA(ILWSCO,1)
- CALL IZCFA(IPLCCO,1)
- CALL IZCFA(IFACCO,1)
- CALL IZCFA(IBORCO,1)
-*
- ELSEIF(IPRICO.EQ.IAXICO)THEN
- CALL IZSCAN(LHNT,IPLCCO,IADRAT,-1,IPOS)
- IF(IPOS.NE.0)THEN
- ICAXLC=IZGADR(LHNT,IPOS)-100000
- ELSE
- ICAXLC=IQ(LHI+IDIAA+IPLCCO-80)
- ENDIF
- CALL IGCCOL(ICAXLC,CHVALL)
- CALL IGFIRS(CHAXLC,CHVALL)
- CALL IZSCAN(LHNT,ILNCO,IADRAT,-1,IPOS)
- IF(IPOS.NE.0)THEN
- ICAXLN=IZGADR(LHNT,IPOS)-100000
- ELSE
- ICAXLN=IQ(LHI+IDIAA+ILNCO-80)
- ENDIF
- CALL IZSCAN(LHNT,ITMSCO,IADRAT,-1,IPOS)
- IF(IPOS.NE.0)THEN
- RCAXTS=Q(LHF+IZGADR(LHNT,IPOS))
- ELSE
- RCAXTS=Q(LHF+IDRAA+ITMSCO-50)
- ENDIF
- CALL IZSCAN(LHNT,IALHCO,IADRAT,-1,IPOS)
- IF(IPOS.NE.0)THEN
- RCAXLS=Q(LHF+IZGADR(LHNT,IPOS))
- ELSE
- RCAXLS=Q(LHF+IDRAA+IALHCO-50)
- ENDIF
- CALL IZSCAN(LHNT,IALDCO,IADRAT,-1,IPOS)
- IF(IPOS.NE.0)THEN
- RCAXLO=Q(LHF+IZGADR(LHNT,IPOS))
- ELSE
- RCAXLO=Q(LHF+IDRAA+IALDCO-50)
- ENDIF
- CALL IZSCAN(LHNT,ITXFCO,IADRAT,-1,IPOS)
- IF(IPOS.NE.0)THEN
- IFPTEM=IZGADR(LHNT,IPOS)-100000
- ELSE
- IFPTEM=IQ(LHI+IDIAA+ITXFCO-80)
- ENDIF
- ICAXLF=INT(IFPTEM/10)
- ICAXLP=MOD(IFPTEM,10)
- ICHOPT=IACHOP
- STR=' '
- DO 20 I=1,22
- IF(JBIT(ICHOPT,I).NE.0)THEN
- CHOPAX=CHAXIS(I)//STR
- STR=CHOPAX
- ENDIF
- 20 CONTINUE
- CALL IEMAXA(IPLACE,ICHOIO)
- CALL UOPTC(CHOPAX,'GBAV+-UPORLC=.HDYTWSNI',IOPT)
- DO 30 I=1,22
- IF(IOPT(I).NE.0)CALL SBIT1(ICHOPT,I)
- 30 CONTINUE
- CALL IZCFA(IPLCCO,1)
- CALL IZCFA(ILNCO,1)
- CALL IZCFA(ILWSCO,1)
- CALL IZCFA(ITMSCO,1)
- CALL IZCFA(IALHCO,1)
- CALL IZCFA(IALDCO,1)
- CALL IZCFA(ITXCCO,1)
- CALL IZCFA(ITXFCO,1)
- CALL IZCFA(IGTSCO,1)
- CALL IZCFA(IGTWCO,1)
- CHOFLA=.TRUE.
-*
- ELSEIF(IPRICO.EQ.IBXCO)THEN
- CALL IZSCAN(LHNT,IFAICO,IADRAT,-1,IPOS)
- IF(IPOS.NE.0)THEN
- ICBOIS=IZGADR(LHNT,IPOS)-100000
- ELSE
- ICBOIS=IQ(LHI+IDIAA+IFAICO-80)
- ENDIF
- CALL IGCFAI(ICBOIS,CHVALL)
- CALL IGFIRS(CHBOIS,CHVALL)
- CALL IZSCAN(LHNT,IFASCO,IADRAT,-1,IPOS)
- IF(IPOS.NE.0)THEN
- ICBOSI=IZGADR(LHNT,IPOS)-100000
- ELSE
- ICBOSI=IQ(LHI+IDIAA+IFASCO-80)
- ENDIF
- CALL IZSCAN(LHNT,IFACCO,IADRAT,-1,IPOS)
- IF(IPOS.NE.0)THEN
- ICBOCI=IZGADR(LHNT,IPOS)-100000
- ELSE
- ICBOCI=IQ(LHI+IDIAA+IFACCO-80)
- ENDIF
- CALL IGCCOL(ICBOCI,CHVALL)
- CALL IGFIRS(CHBOC,CHVALL)
- CALL IZSCAN(LHNT,IBORCO,IADRAT,-1,IPOS)
- IF(IPOS.NE.0)THEN
- ICBOBO=IZGADR(LHNT,IPOS)-100000
- ELSE
- ICBOBO=IQ(LHI+IDIAA+IBORCO-80)
- ENDIF
- CHBOBO='No,Yes'
- IF(ICBOBO.EQ.1)CHBOBO='Yes,No'
- CALL IEMBOA(IPLACE,ICHOIO)
- CALL IZCFA(IFAICO,1)
- CALL IZCFA(IFASCO,1)
- CALL IZCFA(IFACCO,1)
- CALL IZCFA(IBORCO,1)
-*
- ELSEIF(IPRICO.EQ.IFBXCO)THEN
- CALL IZSCAN(LHNT,IFAICO,IADRAT,-1,IPOS)
- IF(IPOS.NE.0)THEN
- ICFBIS=IZGADR(LHNT,IPOS)-100000
- ELSE
- ICFBIS=IQ(LHI+IDIAA+IFAICO-80)
- ENDIF
- CALL IGCFAI(ICFBIS,CHVALL)
- CALL IGFIRS(CHFBIS,CHVALL)
- CALL IZSCAN(LHNT,IFASCO,IADRAT,-1,IPOS)
- IF(IPOS.NE.0)THEN
- ICFBSI=IZGADR(LHNT,IPOS)-100000
- ELSE
- ICFBSI=IQ(LHI+IDIAA+IFASCO-80)
- ENDIF
- CALL IZSCAN(LHNT,IFACCO,IADRAT,-1,IPOS)
- IF(IPOS.NE.0)THEN
- ICFBCI=IZGADR(LHNT,IPOS)-100000
- ELSE
- ICFBCI=IQ(LHI+IDIAA+IFACCO-80)
- ENDIF
- CALL IGCCOL(ICFBCI,CHVALL)
- CALL IGFIRS(CHFBC,CHVALL)
- CALL IZSCAN(LHNT,IBORCO,IADRAT,-1,IPOS)
- IF(IPOS.NE.0)THEN
- ICFBBO=IZGADR(LHNT,IPOS)-100000
- ELSE
- ICFBBO=IQ(LHI+IDIAA+IBORCO-80)
- ENDIF
- CHFBBO='No,Yes'
- IF(ICFBBO.EQ.1)CHFBBO='Yes,No'
- CALL IEMFBA(IPLACE,ICHOIO)
- CALL IZCFA(IFAICO,1)
- CALL IZCFA(IFASCO,1)
- CALL IZCFA(IFACCO,1)
- CALL IZCFA(IBORCO,1)
-*
- ELSEIF(IPRICO.EQ.IHISCO)THEN
- CALL IZSCAN(LHNT,IBOFCO,IADRAT,-1,IPOS)
- IF(IPOS.NE.0)THEN
- RCBOF=Q(LHF+IZGADR(LHNT,IPOS))
- ELSE
- RCBOF=Q(LHF+IDRAA+IBOFCO-50)
- ENDIF
- CALL IZSCAN(LHNT,IBWDCO,IADRAT,-1,IPOS)
- IF(IPOS.NE.0)THEN
- RCBWD=Q(LHF+IZGADR(LHNT,IPOS))
- ELSE
- RCBWD=Q(LHF+IDRAA+IBWDCO-50)
- ENDIF
- CALL IZSCAN(LHNT,ILNCO,IADRAT,-1,IPOS)
- IF(IPOS.NE.0)THEN
- ICHILN=IZGADR(LHNT,IPOS)-100000
- ELSE
- ICHILN=IQ(LHI+IDIAA+ILNCO-80)
- ENDIF
- CALL IZSCAN(LHNT,IPLCCO,IADRAT,-1,IPOS)
- IF(IPOS.NE.0)THEN
- ICHIPC=IZGADR(LHNT,IPOS)-100000
- ELSE
- ICHIPC=IQ(LHI+IDIAA+IPLCCO-80)
- ENDIF
- CALL IGCCOL(ICHIPC,CHVALL)
- CALL IGFIRS(CHHIPC,CHVALL)
- CALL IZSCAN(LHNT,IFAICO,IADRAT,-1,IPOS)
- IF(IPOS.NE.0)THEN
- ICHIFI=IZGADR(LHNT,IPOS)-100000
- ELSE
- ICHIFI=IQ(LHI+IDIAA+IFAICO-80)
- ENDIF
- CALL IGCFAI(ICHIFI,CHVALL)
- CALL IGFIRS(CHHIIS,CHVALL)
- CALL IZSCAN(LHNT,IFASCO,IADRAT,-1,IPOS)
- IF(IPOS.NE.0)THEN
- ICHIFS=IZGADR(LHNT,IPOS)-100000
- ELSE
- ICHIFS=IQ(LHI+IDIAA+IFASCO-80)
- ENDIF
- CALL IZSCAN(LHNT,IFACCO,IADRAT,-1,IPOS)
- IF(IPOS.NE.0)THEN
- ICHIFC=IZGADR(LHNT,IPOS)-100000
- ELSE
- ICHIFC=IQ(LHI+IDIAA+IFACCO-80)
- ENDIF
- CALL IGCCOL(ICHIFC,CHVALL)
- CALL IGFIRS(CHHIFC,CHVALL)
- ICHOPT=IACHOP
- STR=' '
- DO 40 I=1,14
- IF(JBIT(ICHOPT,I).NE.0)THEN
- CHOPHI=CHHIST(I)//STR
- STR=CHOPHI
- ENDIF
- 40 CONTINUE
- CALL IEMHIA(IPLACE,ICHOIO)
- CALL UOPTC(CHOPHI,'HFS*R1BNLMA',IOPT)
- DO 50 I=1,11
- IF(IOPT(I).NE.0)CALL SBIT1(ICHOPT,I)
- 50 CONTINUE
- CALL IZCFA(IBOFCO,1)
- CALL IZCFA(IBWDCO,1)
- CALL IZCFA(ILNCO,1)
- CALL IZCFA(ILWSCO,1)
- CALL IZCFA(IPLCCO,1)
- CALL IZCFA(IFAICO,1)
- CALL IZCFA(IFASCO,1)
- CALL IZCFA(IFACCO,1)
- CHOFLA=.TRUE.
-*
- ELSEIF(IPRICO.EQ.IPLCO.OR.IPRICO.EQ.IPL2CO)THEN
- CALL IZSCAN(LHNT,ILNCO,IADRAT,-1,IPOS)
- IF(IPOS.NE.0)THEN
- ICLN=IZGADR(LHNT,IPOS)-100000
- ELSE
- ICLN=IQ(LHI+IDIAA+ILNCO-80)
- ENDIF
- CALL IZSCAN(LHNT,ILWSCO,IADRAT,-1,IPOS)
- IF(IPOS.NE.0)THEN
- RCLWSC=Q(LHF+IZGADR(LHNT,IPOS))
- ELSE
- RCLWSC=Q(LHF+IDRAA+ILWSCO-50)
- ENDIF
- CALL IZSCAN(LHNT,IPLCCO,IADRAT,-1,IPOS)
- IF(IPOS.NE.0)THEN
- ICPLCI=IZGADR(LHNT,IPOS)-100000
- ELSE
- ICPLCI=IQ(LHI+IDIAA+IPLCCO-80)
- ENDIF
- CALL IGCCOL(ICPLCI,CHVALL)
- CALL IGFIRS(CHPLC,CHVALL)
- CALL IEMPLA(IPLACE,ICHOIO)
- CALL IZCFA(ILNCO,1)
- CALL IZCFA(ILWSCO,1)
- CALL IZCFA(IPLCCO,1)
-*
- ELSEIF(IPRICO.EQ.IPMCO.OR.IPRICO.EQ.IPM1CO)THEN
- CALL IZSCAN(LHNT,IMKCO,IADRAT,-1,IPOS)
- IF(IPOS.NE.0)THEN
- ICMK=IZGADR(LHNT,IPOS)-100000
- ELSE
- ICMK=IQ(LHI+IDIAA+IMKCO-80)
- ENDIF
- CALL IZSCAN(LHNT,IMKSCO,IADRAT,-1,IPOS)
- IF(IPOS.NE.0)THEN
- RCMKSC=Q(LHF+IZGADR(LHNT,IPOS))
- ELSE
- RCMKSC=Q(LHF+IDRAA+IMKSCO-50)
- ENDIF
- CALL IZSCAN(LHNT,IPMCCO,IADRAT,-1,IPOS)
- IF(IPOS.NE.0)THEN
- ICPMCI=IZGADR(LHNT,IPOS)-100000
- ELSE
- ICPMCI=IQ(LHI+IDIAA+IPMCCO-80)
- ENDIF
- CALL IGCCOL(ICPMCI,CHVALL)
- CALL IGFIRS(CHPMC,CHVALL)
- CALL IEMPMA(IPLACE,ICHOIO)
- CALL IZCFA(IMKCO,1)
- CALL IZCFA(IMKSCO,1)
- CALL IZCFA(IPMCCO,1)
-*
- ELSEIF(IPRICO.EQ.IGTXCO)THEN
- CALL IZSCAN(LHNT,ITXCCO,IADRAT,-1,IPOS)
- IF(IPOS.NE.0)THEN
- ICSTCI=IZGADR(LHNT,IPOS)-100000
- ELSE
- ICSTCI=IQ(LHI+IDIAA+ITXCCO-80)
- ENDIF
- CALL IGCCOL(ICSTCI,CHVALL)
- CALL IGFIRS(CHSTC,CHVALL)
- CALL IZSCAN(LHNT,IGTWCO,IADRAT,-1,IPOS)
- IF(IPOS.NE.0)THEN
- ICSTPA=IZGADR(LHNT,IPOS)-100000
- ELSE
- ICSTPA=IQ(LHI+IDIAA+IGTWCO-80)
- ENDIF
- CALL IZSCAN(LHNT,IGTSCO,IADRAT,-1,IPOS)
- IF(IPOS.NE.0)THEN
- RCSTSH=Q(LHF+IZGADR(LHNT,IPOS))
- ELSE
- RCSTSH=Q(LHF+IDRAA+IGTSCO-50)
- ENDIF
- ICHOPT=IACHOP
- STR=' '
- DO 60 I=1,3
- IF(JBIT(ICHOPT,I).NE.0)THEN
- CHOPST=CHTEXT(I)//STR
- STR=CHOPST
- ENDIF
- 60 CONTINUE
- CALL IEMSTA(IPLACE,ICHOIO)
- CALL UOPTC(CHOPST,'LCR',IOPT)
- DO 70 I=1,3
- IF(IOPT(I).NE.0)CALL SBIT1(ICHOPT,I)
- 70 CONTINUE
- CALL IZCFA(ITXCCO,1)
- CALL IZCFA(IGTSCO,1)
- CALL IZCFA(IGTWCO,1)
- CHOFLA=.TRUE.
-*
- ELSEIF(IPRICO.EQ.ITXCO)THEN
- CALL IZSCAN(LHNT,ITXCCO,IADRAT,-1,IPOS)
- IF(IPOS.NE.0)THEN
- ICTXCI=IZGADR(LHNT,IPOS)-100000
- ELSE
- ICTXCI=IQ(LHI+IDIAA+ITXCCO-80)
- ENDIF
- CALL IGCCOL(ICTXCI,CHVALL)
- CALL IGFIRS(CHTXC,CHVALL)
- CALL IZSCAN(LHNT,ICHHCO,IADRAT,-1,IPOS)
- IF(IPOS.NE.0)THEN
- RCTXSI=Q(LHF+IZGADR(LHNT,IPOS))
- ELSE
- RCTXSI=Q(LHF+IDRAA+ICHHCO-50)
- ENDIF
- CALL IZSCAN(LHNT,ITXFCO,IADRAT,-1,IPOS)
- IF(IPOS.NE.0)THEN
- IFPTEM=IZGADR(LHNT,IPOS)-100000
- ELSE
- IFPTEM=IQ(LHI+IDIAA+ITXFCO-80)
- ENDIF
- ICTXFT=INT(IFPTEM/10)
- ICTXPR=ABS(MOD(IFPTEM,10))
- CALL IZSCAN(LHNT,ITXACO,IADRAT,-1,IPOS)
- IF(IPOS.NE.0)THEN
- ITATEM=IZGADR(LHNT,IPOS)-100000
- ELSE
- ITATEM=IQ(LHI+IDIAA+ITXACO-80)
- ENDIF
- ICTXAH=INT(ITATEM/10)
- ICTXAV=MOD(ITATEM,10)
- CALL IEMTXA(IPLACE,ICHOIO)
- CALL IZCFA(ITXCCO,1)
- CALL IZCFA(ITXACO,1)
- CALL IZCFA(ICHHCO,1)
- CALL IZCFA(IANGCO,1)
- CALL IZCFA(ITXFCO,1)
- CALL IZCFA(IGTSCO,1)
- CALL IZCFA(IGTWCO,1)
- ENDIF
-*
-* Change in the data structure
-*
- IF(IQ(LHNT+NPRIM).GT.0)THEN
- IF(CHOFLA)THEN
- IF(IZPUSH(4,0,0,'IECPA').NE.0)GOTO 90
- CALL IZSTCC(INOPCO,INTPTR)
- IQ(LHI+INTPTR)=2
- IQ(LHI+INTPTR+1)=IZGADR(LHNT,NPRIM)
- IQ(LHI+INTPTR+2)=NPRIM
- IQ(LHI+INTPTR+3)=ICHOPT
- CALL IZINCI(4)
- IQ(LHNT+NPRIM)=-(1000000*IZGCOD(LHNT,NPRIM)+ITBPTR-1)
- ELSE
- IF(IZPUSH(3,0,0,'IECPA').NE.0)GOTO 90
- CALL IZSTCC(INOPCO,INTPTR)
- IQ(LHI+INTPTR)=1
- IQ(LHI+INTPTR+1)=IZGADR(LHNT,NPRIM)
- IQ(LHI+INTPTR+2)=NPRIM
- CALL IZINCI(3)
- IQ(LHNT+NPRIM)=-(1000000*IZGCOD(LHNT,NPRIM)+ITBPTR-1)
- ENDIF
- ELSE
- IADRI2=ABS(IZGADR(LHNT,NPRIM))
- IADRI3=IADRI2
- 80 IF(IQ(LHNT+IADRI2).LT.0)THEN
- IADRI2=ABS(IZGADR(LHNT,IADRI2))
- IADRI3=IADRI2
- GOTO 80
- ENDIF
- IADRI2=IZGADR(LHNT,IADRI2)
- IF(CHOFLA)THEN
- IF(IZPUSH(4,0,0,'IECPA').NE.0)GOTO 90
- CALL IZSTCC(INOPCO,INTPTR)
- IQ(LHI+INTPTR)=2
- IQ(LHI+INTPTR+1)=IADRI2
- IQ(LHI+INTPTR+2)=IADRI3
- IQ(LHI+INTPTR+3)=ICHOPT
- CALL IZINCI(4)
- IQ(LHNT+IADRI3)=-(1000000*IZGCOD(LHNT,IADRI3)+ITBPTR-1)
- ELSE
- IF(IZPUSH(3,0,0,'IECPA').NE.0)GOTO 90
- CALL IZSTCC(INOPCO,INTPTR)
- IQ(LHI+INTPTR)=1
- IQ(LHI+INTPTR+1)=IADRI2
- IQ(LHI+INTPTR+2)=IADRI3
- CALL IZINCI(3)
- IQ(LHNT+IADRI3)=-(1000000*IZGCOD(LHNT,IADRI3)+ITBPTR-1)
- ENDIF
- ENDIF
-*
-* Change on the screen
-*
- CALL IZSAV
- ZFLAG=.FALSE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- GFLAG=.TRUE.
- LNDECO=LHNT
- LIDECO=LDI
- LFDECO=LDF
- LCDECO=LDC
- CALL IZDATT(0,NPRIM)
- CALL ISFACI(0)
- CALL ISTXCI(0)
- CALL ISPLCI(0)
- CALL ISPMCI(0)
- CALL ISFAIS(1)
- CALL ISLN(1)
- CALL IZDNB(LHNT,LDI,LDF,LDC,NPRIM,-1)
- CALL IZSET
- ZFLAG=.FALSE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- LNDECO=LHNT
- LIDECO=LDI
- LFDECO=LDF
- LCDECO=LDC
- CALL IZDATT(0,NPRIM)
- CALL IZDNB(LHNT,LDI,LDF,LDC,NPRIM,1)
-*
- 90 ZFLAG=.TRUE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- GFLAG=.TRUE.
- GOTO 10
-*
- END
diff --git a/src/graflib/higz/ged/iedele.F b/src/graflib/higz/ged/iedele.F
deleted file mode 100644
index 5024e73..0000000
--- a/src/graflib/higz/ged/iedele.F
+++ /dev/null
@@ -1,114 +0,0 @@
-*
-* $Id: iedele.F,v 1.1.1.1 1996/02/14 13:10:22 mclareni Exp $
-*
-* $Log: iedele.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:22 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.07/01 19/07/89 10.47.25 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE IEDELE(ICF,ICHOIO)
-*.===========>
-*.
-*..==========> (O.Couet)
-#include "higz/hipaw.inc"
-#include "higz/hiflag.inc"
-#include "higz/hicode.inc"
-#include "higz/higed.inc"
- CHARACTER*8 SNAME
- CHARACTER*4 CHVAL(15)
-*.______________________________________
-*
- ICHOIO=0
- 10 IPLACE=2
- CALL IGREQ(21,3,16,IPLACE,ICHOIC,CHVAL)
- IF(IPLACE.EQ.3)GOTO 10
- IF(IPLACE.EQ.1)THEN
- ICF=1
- ICHOIO=ICHOIC
- RETURN
- ENDIF
- IF(ICHOIC.EQ.-1000)GOTO 10
- IF(ICHOIC.EQ.-1)GOTO 10
- IF(ICHOIC.EQ.-2)THEN
- CALL IGCLES
- CALL IZPICT(EDIPIC,'D')
- CALL IEGRID
- GOTO 10
- ENDIF
- IF(ICHOIC.EQ.-3)THEN
- CALL IZUNDO
- GOTO 10
- ENDIF
- IF(ICHOIC.GE.1)THEN
- ICF=2
- ICHOIO=ICHOIC
- RETURN
- ENDIF
-*
- ZFLAG=.TRUE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- GFLAG=.TRUE.
- CALL IZPICK(NT,SNAME,NPRIM,'N')
- IF(NPRIM.LE.0)GOTO 30
- LN=IZGNTP(NT)
- IF(LN.EQ.0)GOTO 30
- CALL ISELNT(NT)
-*
-* Delete on the screen
-*
- CALL IZSAV
- ZFLAG=.FALSE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- LNDECO=LHNT
- LIDECO=LDI
- LFDECO=LDF
- LCDECO=LDC
- CALL IZDATT(0,NPRIM)
- CALL ISFACI(0)
- CALL ISTXCI(0)
- CALL ISPLCI(0)
- CALL ISPMCI(0)
- CALL ISFAIS(1)
- CALL ISLN(1)
- CALL IZDNB(LHNT,LHI,LHF,LHC,NPRIM,-1)
- ZFLAG=.TRUE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
-*
-* Delete in the data structure
-*
- IF(IQ(LHNT+NPRIM).GT.0)THEN
- IF(IZPUSH(3,0,0,'IEDELE').NE.0)GOTO 30
- CALL IZSTCC(INOPCO,INTPTR)
- IQ(LHI+INTPTR)=0
- IQ(LHI+INTPTR+1)=IZGADR(LHNT,NPRIM)
- IQ(LHI+INTPTR+2)=NPRIM
- CALL IZINCI(3)
- IQ(LHNT+NPRIM)=-(1000000*IZGCOD(LHNT,NPRIM)+ITBPTR-1)
- ELSE
- IADRI2=ABS(IZGADR(LHNT,NPRIM))
- IADRI3=IADRI2
- 20 IF(IQ(LHNT+IADRI2).LT.0)THEN
- IADRI2=ABS(IZGADR(LHNT,IADRI2))
- IADRI3=IADRI2
- GOTO 20
- ENDIF
- IADRI2=IZGADR(LHNT,IADRI2)
- IF(IZPUSH(3,0,0,'IEDELE').NE.0)GOTO 30
- CALL IZSTCC(INOPCO,INTPTR)
- IQ(LHI+INTPTR)=0
- IQ(LHI+INTPTR+1)=IADRI2
- IQ(LHI+INTPTR+2)=IADRI3
- CALL IZINCI(3)
- IQ(LHNT+IADRI3)=-(1000000*IZGCOD(LHNT,IADRI3)+ITBPTR-1)
- ENDIF
-*
- 30 CALL IZSET
- ZFLAG=.TRUE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- GFLAG=.TRUE.
- GOTO 10
-*
- END
diff --git a/src/graflib/higz/ged/iefa.F b/src/graflib/higz/ged/iefa.F
deleted file mode 100644
index caa2b2e..0000000
--- a/src/graflib/higz/ged/iefa.F
+++ /dev/null
@@ -1,96 +0,0 @@
-*
-* $Id: iefa.F,v 1.1.1.1 1996/02/14 13:10:22 mclareni Exp $
-*
-* $Log: iefa.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:22 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.07/01 19/07/89 10.47.25 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE IEFA(ICF,ICHOIO)
-*.===========>
-*.
-*..==========> (O.Couet)
-#include "higz/hiques.inc"
-#include "higz/hiatt.inc"
-#include "higz/higed.inc"
-#include "higz/hiflag.inc"
- CHARACTER*4 CHVAL(15)
-*.______________________________________
-*
- ICHOIO=0
- 201 IPLACE=2
- CALL IGREQ(21,3,16,IPLACE,ICHOIC,CHVAL)
- IF(ICHOIC.EQ.-1000)GOTO 201
-*
- 203 X(1)=RQUEST(13)
- Y(1)=RQUEST(14)
- NTLOC=IQUEST(10)
-*
- IF(IPLACE.EQ.3)GOTO 201
-*
- IF(IPLACE.EQ.1)THEN
- ICF=1
- ICHOIO=ICHOIC
- RETURN
- ENDIF
-*
- IF(ICHOIC.EQ.-1)THEN
- CALL IEMFAA(IPLACE,ICHOIC)
- GOTO 203
- ENDIF
-*
- IF(ICHOIC.EQ.-2)THEN
- CALL IGCLES
- CALL IZPICT(EDIPIC,'D')
- CALL IEGRID
- GOTO 201
- ENDIF
-*
- IF(ICHOIC.EQ.-3)THEN
- CALL IZUNDO
- GOTO 201
- ENDIF
-*
- IF(ICHOIC.GE.1)THEN
- ICF=2
- ICHOIO=ICHOIC
- RETURN
- ENDIF
-*
- I=2
- CALL ISELNT(NTLOC)
- CALL IGGRID(X(1),Y(1))
- CALL IGPLOT(X(1),Y(1))
- 202 CALL IGLOC(41,NTLOC,IBN,XNDC,YNDC,X(I),Y(I))
- IF(IBN.EQ.1)THEN
- IF(NTLOC.NE.INTR)GOTO 202
- CALL IGGRID(X(I),Y(I))
- CALL IEALPT(X(I-1),Y(I-1))
- CALL IGLINE(X(I-1),X(I),Y(I-1),Y(I))
- I=I+1
- GOTO 202
- ELSE
- IF(I.LE.3)GOTO 201
- ZFLAG=.FALSE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- CALL IZSAV
- CALL IGLINE(X(I-1),X(1),Y(I-1),Y(1))
- CALL ISPLCI(0)
- CALL ISLN(1)
- X(I)=X(1)
- Y(I)=Y(1)
- CALL IPL(I,X,Y)
- CALL IZSET
- ZFLAG=.TRUE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- CALL ISFAIS(ICFAIS)
- CALL ISFASI(ICFASI)
- CALL ISFACI(ICFACI)
- CALL IFA(I-1,X,Y)
- GOTO 201
- ENDIF
-*
- END
diff --git a/src/graflib/higz/ged/iefbox.F b/src/graflib/higz/ged/iefbox.F
deleted file mode 100644
index f8a2781..0000000
--- a/src/graflib/higz/ged/iefbox.F
+++ /dev/null
@@ -1,98 +0,0 @@
-*
-* $Id: iefbox.F,v 1.1.1.1 1996/02/14 13:10:22 mclareni Exp $
-*
-* $Log: iefbox.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:22 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.07/01 19/07/89 10.47.25 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE IEFBOX(ICF,ICHOIO)
-*.===========>
-*.
-*..==========> (O.Couet)
-#include "higz/hiques.inc"
-#include "higz/hiatt.inc"
-#include "higz/higed.inc"
-#include "higz/hiflag.inc"
- CHARACTER*4 CHVAL(15)
-*.______________________________________
-*
- ICHOIO=0
- 201 IPLACE=2
- CALL IGREQ(21,3,16,IPLACE,ICHOIC,CHVAL)
- IF(ICHOIC.EQ.-1000)GOTO 201
-*
- 203 X(1)=RQUEST(13)
- Y(1)=RQUEST(14)
- NTLOC=IQUEST(10)
-*
- IF(IPLACE.EQ.3)GOTO 201
-*
- IF(IPLACE.EQ.1)THEN
- ICF=1
- ICHOIO=ICHOIC
- RETURN
- ENDIF
-*
- IF(ICHOIC.EQ.-1)THEN
- CALL IEMFBA(IPLACE,ICHOIC)
- GOTO 203
- ENDIF
-*
- IF(ICHOIC.EQ.-2)THEN
- CALL IGCLES
- CALL IZPICT(EDIPIC,'D')
- CALL IEGRID
- GOTO 201
- ENDIF
-*
- IF(ICHOIC.EQ.-3)THEN
- CALL IZUNDO
- GOTO 201
- ENDIF
-*
- IF(ICHOIC.GE.1)THEN
- ICF=2
- ICHOIO=ICHOIC
- RETURN
- ENDIF
-*
- CALL ISELNT(NTLOC)
- CALL IGGRID(X(1),Y(1))
- CALL IGPLOT(X(1),Y(1))
- CALL IZSAV
-*
- ZFLAG=.FALSE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- CALL ISFAIS(0)
- CALL ISFACI(1)
- CALL IGSET('BORD',1.)
- I=2
- 202 CALL IGLOC(51,NTLOC,IBN,XNDC,YNDC,X(I),Y(I))
- IF(NTLOC.NE.INTR)GOTO 202
- CALL IGGRID(X(I),Y(I))
- I=I+1
- CALL IGBOX(X(1),X(2),Y(1),Y(2))
- 204 CALL IGLOC(1,NTLOC,IBN,XNDC,YNDC,X(I),Y(I))
- IF(NTLOC.NE.INTR)GOTO 204
- CALL IGGRID(X(I),Y(I))
- I=I+1
- CALL IGPLOT(X(3),Y(3))
- 205 CALL IGLOC(51,NTLOC,IBN,XNDC,YNDC,X(I),Y(I))
- IF(NTLOC.NE.INTR)GOTO 205
- CALL IGGRID(X(I),Y(I))
- CALL IGBOX(X(3),X(4),Y(3),Y(4))
- ZFLAG=.TRUE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
-*
- CALL ISFAIS(ICFBIS)
- CALL ISFASI(ICFBSI)
- CALL ISFACI(ICFBCI)
- CALL IGSET('BORD',FLOAT(ICBOBO))
- CALL IGFBOX(X(1),X(2),Y(1),Y(2),X(3),X(4),Y(3),Y(4))
- GOTO 201
-*
- END
diff --git a/src/graflib/higz/ged/iegrid.F b/src/graflib/higz/ged/iegrid.F
deleted file mode 100644
index b1d970f..0000000
--- a/src/graflib/higz/ged/iegrid.F
+++ /dev/null
@@ -1,47 +0,0 @@
-*
-* $Id: iegrid.F,v 1.1.1.1 1996/02/14 13:10:22 mclareni Exp $
-*
-* $Log: iegrid.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:22 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.07/01 19/07/89 10.26.11 by O.Couet
-*-- Author : O.Couet 19/07/89
- SUBROUTINE IEGRID
-*.===========>
-*.
-*. Draws the grid if needed.
-*.
-*..==========> (O.Couet)
-#include "higz/hiatt.inc"
-#include "higz/hiflag.inc"
-#include "higz/higed.inc"
-*.______________________________________
-*
- IF((IXSTEP*IXFACT.EQ.0).OR.(IYSTEP*IYFACT.EQ.0))RETURN
- ZFLAG=.FALSE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- CALL ISMK(1)
- CALL ISPMCI(1)
- XSTDX=(RWXMAX-RWXMIN)/FLOAT(IXSTEP*IXFACT)
- YSTDY=(RWYMAX-RWYMIN)/FLOAT(IYSTEP*IYFACT)
- NBPM=1
- DO 20 I=0,(IXSTEP*IXFACT)
- XPMVAL=RWXMIN+I*XSTDX
- DO 10 J=0,(IYSTEP*IYFACT)
- X(NBPM)=XPMVAL
- Y(NBPM)=RWYMIN+J*YSTDY
- IF(NBPM.EQ.100)THEN
- CALL IPM(NBPM,X,Y)
- NBPM=0
- ENDIF
- NBPM=NBPM+1
- 10 CONTINUE
- 20 CONTINUE
- CALL IPM(NBPM,X,Y)
- ZFLAG=.TRUE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
-*
- END
diff --git a/src/graflib/higz/ged/iemaca.F b/src/graflib/higz/ged/iemaca.F
deleted file mode 100644
index 28e7e76..0000000
--- a/src/graflib/higz/ged/iemaca.F
+++ /dev/null
@@ -1,62 +0,0 @@
-*
-* $Id: iemaca.F,v 1.1.1.1 1996/02/14 13:10:22 mclareni Exp $
-*
-* $Log: iemaca.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:22 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.06/03 09/01/89 11.49.21 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE IEMACA(ICF,ICHOIO)
-*.===========>
-*.
-*..==========> (O.Couet)
-#include "higz/higed.inc"
-#include "higz/hiflag.inc"
- CHARACTER*32 CHVAL(5)
-*.______________________________________
-*
- TITLE(3)='ARC ATTRIBUTES'
- CHITEM(1,3)='Fill area interior style'
- CHITEM(2,3)='Fill area style index'
- CHITEM(3,3)='Arc border'
- CHITEM(4,3)='Line color'
- CHITEM(5,3)='Fill area color'
-*
- CHDEF(1)=CHACIS
- CALL IZITOC(ICACFS,CHDEF(2))
- CHDEF(3)=CHACBO
- CHDEF(4)=CHACLC
- CHDEF(5)=CHACFC
-*
- IPLACE=3
- CALL IGREQ(270,0,5,IPLACE,ICHOIC,CHVAL)
- ICHOIO=ICHOIC
- ICF=IPLACE
-*
- ZFLAG=.TRUE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- GFLAG=.TRUE.
- CALL IGFIRS(CHACIS,CHVAL(1))
- ICACFI=IGIFAI(CHVAL(1))
- CALL IZCTOI(CHVAL(2),ICACFS)
- CALL IGFIRS(CHACBO,CHVAL(3))
- IF(CHVAL(3).EQ.'No')THEN
- ICACBO=0
- ELSE
- ICACBO=1
- ENDIF
- CALL IGFIRS(CHACLC,CHVAL(4))
- ICACLC=IGICOL(CHVAL(4))
- CALL IGFIRS(CHACFC,CHVAL(5))
- ICACFC=IGICOL(CHVAL(5))
-*
- CALL ISFAIS(ICACFI)
- CALL ISFASI(ICACFS)
- CALL ISFACI(ICACFC)
- CALL ISPLCI(ICACLC)
- CALL IGSET('BORD',FLOAT(ICACBO))
-*
- END
diff --git a/src/graflib/higz/ged/iemaxa.F b/src/graflib/higz/ged/iemaxa.F
deleted file mode 100644
index 6f630b4..0000000
--- a/src/graflib/higz/ged/iemaxa.F
+++ /dev/null
@@ -1,81 +0,0 @@
-*
-* $Id: iemaxa.F,v 1.1.1.1 1996/02/14 13:10:22 mclareni Exp $
-*
-* $Log: iemaxa.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:22 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.06/03 09/01/89 11.49.21 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE IEMAXA(ICF,ICHOIO)
-*.===========>
-*.
-*..==========> (O.Couet)
-#include "higz/higed.inc"
-#include "higz/hiflag.inc"
- CHARACTER*80 CHVAL(11)
-*.______________________________________
-*
- TITLE(3)='AXIS ATTRIBUTES'
- CHITEM(1,3)='CHOPT'
- CHITEM(2,3)='WMIN'
- CHITEM(3,3)='WMAX'
- CHITEM(4,3)='Number of divisions'
- CHITEM(5,3)='Tick marks size'
- CHITEM(6,3)='Labels size'
- CHITEM(7,3)='Labels offset'
- CHITEM(8,3)='Axis color'
- CHITEM(9,3)='Axis line type'
- CHITEM(10,3)='Labels font'
- CHITEM(11,3)='Labels precision'
-*
- CHDEF(1)=CHOPAX
- CHDEF(2)=' '
- CHDEF(3)=' '
- CHDEF(4)=' '
- CALL IZRTOC(RCAXTS,CHDEF(5))
- CALL IZRTOC(RCAXLS,CHDEF(6))
- CALL IZRTOC(RCAXLO,CHDEF(7))
- CHDEF(8)=CHAXLC
- CALL IZITOC(ICAXLN,CHDEF(9))
- CALL IZITOC(ICAXLF,CHDEF(10))
- CALL IZITOC(ICAXLP,CHDEF(11))
-*
- IPLACE=3
- CALL IGREQ(260,0,11,IPLACE,ICHOIC,CHVAL)
- ICHOIO=ICHOIC
- ICF=IPLACE
-*
- CALL CLTOU(CHVAL(1))
- CHOPAX=CHVAL(1)
- CALL IZCTOR(CHVAL(2),X1)
- CALL IZCTOR(CHVAL(3),X2)
- IF(X1.NE.X2)THEN
- RCAXW1=X1
- RCAXW2=X2
- ENDIF
- IF(CHVAL(4).NE.' ')THEN
- CALL IZCTOI(CHVAL(4),ICAXND)
- ENDIF
- CALL IZCTOR(CHVAL(5),RCAXTS)
- CALL IZCTOR(CHVAL(6),RCAXLS)
- CALL IZCTOR(CHVAL(7),RCAXLO)
- CALL IGFIRS(CHAXLC,CHVAL(8))
- ICAXLC=IGICOL(CHVAL(8))
- CALL IZCTOI(CHVAL(9),ICAXLN)
- CALL IZCTOI(CHVAL(10),ICAXLF)
- CALL IZCTOI(CHVAL(11),ICAXLP)
-*
- ZFLAG=.TRUE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- GFLAG=.TRUE.
- CALL IGSET('TMSI',RCAXTS)
- CALL IGSET('LASI',RCAXLS)
- CALL IGSET('LAOF',RCAXLO)
- CALL ISLN(ICAXLN)
- CALL ISPLCI(ICAXLC)
- CALL ISTXFP(ICAXLF,ICAXLP)
-*
- END
diff --git a/src/graflib/higz/ged/iemboa.F b/src/graflib/higz/ged/iemboa.F
deleted file mode 100644
index d696f2b..0000000
--- a/src/graflib/higz/ged/iemboa.F
+++ /dev/null
@@ -1,57 +0,0 @@
-*
-* $Id: iemboa.F,v 1.1.1.1 1996/02/14 13:10:22 mclareni Exp $
-*
-* $Log: iemboa.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:22 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.06/03 09/01/89 11.49.21 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE IEMBOA(ICF,ICHOIO)
-*.===========>
-*.
-*..==========> (O.Couet)
-#include "higz/higed.inc"
-#include "higz/hiflag.inc"
- CHARACTER*80 CHVAL(4)
-*.______________________________________
-*
- TITLE(3)='BOX ATTRIBUTES'
- CHITEM(1,3)='Box interior style'
- CHITEM(2,3)='Box style index'
- CHITEM(3,3)='Box color index'
- CHITEM(4,3)='Border'
-*
- CHDEF(1)=CHBOIS
- CALL IZITOC(ICBOSI,CHDEF(2))
- CHDEF(3)=CHBOC
- CHDEF(4)=CHBOBO
-*
- IPLACE=3
- CALL IGREQ(270,0,4,IPLACE,ICHOIC,CHVAL)
- ICHOIO=ICHOIC
- ICF=IPLACE
-*
- CALL IGFIRS(CHBOIS,CHVAL(1))
- ICBOIS=IGIFAI(CHVAL(1))
- CALL IZCTOI(CHVAL(2),ICBOSI)
- CALL IGFIRS(CHBOC,CHVAL(3))
- ICBOCI=IGICOL(CHVAL(3))
- CALL IGFIRS(CHBOBO,CHVAL(4))
- IF(CHVAL(4).EQ.'No')THEN
- ICBOBO=0
- ELSE
- ICBOBO=1
- ENDIF
-*
- ZFLAG=.TRUE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- GFLAG=.TRUE.
- CALL ISFAIS(ICBOIS)
- CALL ISFASI(ICBOSI)
- CALL ISFACI(ICBOCI)
- CALL IGSET('BORD',FLOAT(ICBOBO))
-*
- END
diff --git a/src/graflib/higz/ged/iemfaa.F b/src/graflib/higz/ged/iemfaa.F
deleted file mode 100644
index b5beeee..0000000
--- a/src/graflib/higz/ged/iemfaa.F
+++ /dev/null
@@ -1,48 +0,0 @@
-*
-* $Id: iemfaa.F,v 1.1.1.1 1996/02/14 13:10:22 mclareni Exp $
-*
-* $Log: iemfaa.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:22 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.06/03 09/01/89 11.49.21 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE IEMFAA(ICF,ICHOIO)
-*.===========>
-*.
-*..==========> (O.Couet)
-#include "higz/higed.inc"
-#include "higz/hiflag.inc"
- CHARACTER*80 CHVAL(3)
-*.______________________________________
-*
- TITLE(3)='FILL AREA ATTRIBUTES'
- CHITEM(1,3)='Fill area interior style'
- CHITEM(2,3)='Fill area style index'
- CHITEM(3,3)='Fill area color index'
-*
- CHDEF(1)=CHFAIS
- CALL IZITOC(ICFASI,CHDEF(2))
- CHDEF(3)=CHFAC
-*
- IPLACE=3
- CALL IGREQ(220,0,3,IPLACE,ICHOIC,CHVAL)
- ICHOIO=ICHOIC
- ICF=IPLACE
-*
- CALL IGFIRS(CHFAIS,CHVAL(1))
- ICFAIS=IGIFAI(CHVAL(1))
- CALL IZCTOI(CHVAL(2),ICFASI)
- CALL IGFIRS(CHFAC,CHVAL(3))
- ICFACI=IGICOL(CHVAL(3))
-*
- ZFLAG=.TRUE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- GFLAG=.TRUE.
- CALL ISFAIS(ICFAIS)
- CALL ISFASI(ICFASI)
- CALL ISFACI(ICFACI)
-*
- END
diff --git a/src/graflib/higz/ged/iemfba.F b/src/graflib/higz/ged/iemfba.F
deleted file mode 100644
index 2ec7cbc..0000000
--- a/src/graflib/higz/ged/iemfba.F
+++ /dev/null
@@ -1,57 +0,0 @@
-*
-* $Id: iemfba.F,v 1.1.1.1 1996/02/14 13:10:22 mclareni Exp $
-*
-* $Log: iemfba.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:22 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.06/03 09/01/89 11.49.22 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE IEMFBA(ICF,ICHOIO)
-*.===========>
-*.
-*..==========> (O.Couet)
-#include "higz/higed.inc"
-#include "higz/hiflag.inc"
- CHARACTER*80 CHVAL(4)
-*.______________________________________
-*
- TITLE(3)='FRAME BOX ATTRIBUTES'
- CHITEM(1,3)='Frame Box interior style'
- CHITEM(2,3)='Frame Box style index'
- CHITEM(3,3)='Frame Box color index'
- CHITEM(4,3)='Frame Box Border'
-*
- CHDEF(1)=CHFBIS
- CALL IZITOC(ICFBSI,CHDEF(2))
- CHDEF(3)=CHFBC
- CHDEF(4)=CHFBBO
-*
- IPLACE=3
- CALL IGREQ(280,0,4,IPLACE,ICHOIC,CHVAL)
- ICHOIO=ICHOIC
- ICF=IPLACE
-*
- CALL IGFIRS(CHFBIS,CHVAL(1))
- ICFBIS=IGIFAI(CHVAL(1))
- CALL IZCTOI(CHVAL(2),ICFBSI)
- CALL IGFIRS(CHFBC,CHVAL(3))
- ICFBCI=IGICOL(CHVAL(3))
- CALL IGFIRS(CHFBBO,CHVAL(4))
- IF(CHVAL(4).EQ.'No')THEN
- ICFBBO=0
- ELSE
- ICFBBO=1
- ENDIF
-*
- ZFLAG=.TRUE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- GFLAG=.TRUE.
- CALL ISFAIS(ICFBIS)
- CALL ISFASI(ICFBSI)
- CALL ISFACI(ICFBCI)
- CALL IGSET('BORD',FLOAT(ICFBBO))
-*
- END
diff --git a/src/graflib/higz/ged/iemhia.F b/src/graflib/higz/ged/iemhia.F
deleted file mode 100644
index 0b780e7..0000000
--- a/src/graflib/higz/ged/iemhia.F
+++ /dev/null
@@ -1,72 +0,0 @@
-*
-* $Id: iemhia.F,v 1.1.1.1 1996/02/14 13:10:22 mclareni Exp $
-*
-* $Log: iemhia.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:22 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.06/03 09/01/89 11.49.22 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE IEMHIA(ICF,ICHOIO)
-*.===========>
-*.
-*..==========> (O.Couet)
-#include "higz/higed.inc"
-#include "higz/hiflag.inc"
- CHARACTER*32 CHVAL(8)
-*.______________________________________
-*
- TITLE(3)='HISTOGRAM ATTRIBUTES'
- CHITEM(1,3)='CHOPT'
- CHITEM(2,3)='Bars offset'
- CHITEM(3,3)='Bars width'
- CHITEM(4,3)='Histogram line type'
- CHITEM(5,3)='Histogram line color'
- CHITEM(6,3)='Histogram fill color'
- CHITEM(7,3)='Histogram interior style'
- CHITEM(8,3)='Histogram style index'
-*
- CHDEF(1)=CHOPHI
- CALL IZRTOC(RCBOF,CHDEF(2))
- CALL IZRTOC(RCBWD,CHDEF(3))
- CALL IZITOC(ICHILN,CHDEF(4))
- CHDEF(5)=CHHIPC
- CHDEF(6)=CHHIFC
- CHDEF(7)=CHHIIS
- CALL IZITOC(ICHIFS,CHDEF(8))
-*
- IPLACE=3
- CALL IGREQ(700,0,8,IPLACE,ICHOIC,CHVAL)
- ICHOIO=ICHOIC
- ICF=IPLACE
-*
- ZFLAG=.TRUE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- GFLAG=.TRUE.
- CALL CLTOU(CHVAL(1))
- CHOPHI=CHVAL(1)
- CALL IZCTOR(CHVAL(2),RCBOF)
- CALL IZCTOR(CHVAL(3),RCBWD)
- CALL IZCTOI(CHVAL(4),ICHILN)
- CALL IGFIRS(CHHIPC,CHVAL(5))
- ICHIPC=IGICOL(CHVAL(5))
- CALL IGFIRS(CHHIFC,CHVAL(6))
- ICHIFC=IGICOL(CHVAL(6))
- CALL IGFIRS(CHHIIS,CHVAL(7))
- ICHIFI=IGIFAI(CHVAL(7))
- IF(ICHIFI.NE.0.AND.INDEX(CHOPHI,'F').EQ.0)THEN
- CHOPHI=CHOPHI(1:LENOCC(CHOPHI))//'F'
- ENDIF
- CALL IZCTOI(CHVAL(8),ICHIFS)
-*
- CALL IGSET('BARO',RCBOF)
- CALL IGSET('BARW',RCBWD)
- CALL ISLN(ICHILN)
- CALL ISPLCI(ICHIPC)
- CALL ISFACI(ICHIFC)
- CALL ISFAIS(ICHIFI)
- CALL ISFASI(ICHIFS)
-*
- END
diff --git a/src/graflib/higz/ged/iemopr.F b/src/graflib/higz/ged/iemopr.F
deleted file mode 100644
index 3ca3d6f..0000000
--- a/src/graflib/higz/ged/iemopr.F
+++ /dev/null
@@ -1,145 +0,0 @@
-*
-* $Id: iemopr.F,v 1.1.1.1 1996/02/14 13:10:23 mclareni Exp $
-*
-* $Log: iemopr.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:23 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.07/01 19/07/89 10.47.25 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE IEMOPR(ICF,ICHOIO)
-*.===========>
-*.
-*. Move an existing primitive
-*.
-*..==========> (O.Couet)
-#include "higz/hipaw.inc"
-#include "higz/hiatt.inc"
-#include "higz/hiflag.inc"
-#include "higz/hicode.inc"
-#include "higz/higed.inc"
- CHARACTER*8 SNAME
- CHARACTER*4 CHVAL(15)
-*.______________________________________
-*
- ICHOIO=0
- 10 IPLACE=2
- CALL IGREQ(21,3,16,IPLACE,ICHOIC,CHVAL)
- IF(IPLACE.EQ.3)GOTO 10
- IF(IPLACE.EQ.1)THEN
- ICF=1
- ICHOIO=ICHOIC
- RETURN
- ENDIF
- IF(ICHOIC.EQ.-1000)GOTO 10
- IF(ICHOIC.EQ.-1)GOTO 10
- IF(ICHOIC.EQ.-2)THEN
- CALL IGCLES
- CALL IZPICT(EDIPIC,'D')
- CALL IEGRID
- GOTO 10
- ENDIF
- IF(ICHOIC.EQ.-3)THEN
- CALL IZUNDO
- GOTO 10
- ENDIF
- IF(ICHOIC.GE.1)THEN
- ICF=2
- ICHOIO=ICHOIC
- RETURN
- ENDIF
-*
- ZFLAG=.TRUE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- GFLAG=.TRUE.
- CALL IZPICK(NT,SNAME,NPRIM,'N')
- IF(NPRIM.LE.0)GOTO 50
-*
- LN=IZGNTP(NT)
- IF(LN.EQ.0)GOTO 50
- CALL ISELNT(NT)
- X(1)=RQUEST(13)
- Y(1)=RQUEST(14)
- CALL IGGRID(X(1),Y(1))
- 30 CALL IGLOC(41,NTLOC,IBN,XNDC,YNDC,X(2),Y(2))
- IF(IBN.EQ.0)GOTO 50
- IF(NTLOC.NE.INTR)GOTO 30
- CALL IGGRID(X(2),Y(2))
- CALL IEALPT(X,Y)
- DX=X(2)-X(1)
- DY=Y(2)-Y(1)
-*
-* Delete on the screen
-*
- CALL IZSAV
- ZFLAG=.FALSE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- LNDECO=LHNT
- LIDECO=LDI
- LFDECO=LDF
- LCDECO=LDC
- CALL IZDATT(0,NPRIM)
- CALL ISFACI(0)
- CALL ISTXCI(0)
- CALL ISPLCI(0)
- CALL ISPMCI(0)
- CALL ISFAIS(1)
- CALL ISLN(1)
- CALL IZDNB(LHNT,LDI,LDF,LDC,NPRIM,-1)
- ZFLAG=.TRUE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
-*
-* Change in the data structure
-*
- IF(IQ(LHNT+NPRIM).GT.0)THEN
- IF(IZPUSH(3,2,0,'IEMOPR').NE.0)GOTO 50
- CALL IZSTCC(INOPCO,INTPTR)
- IQ(LHI+INTPTR)=3000000+IFLPTR
- IQ(LHI+INTPTR+1)=IZGADR(LHNT,NPRIM)
- IQ(LHI+INTPTR+2)=NPRIM
- CALL IZINCI(3)
- Q(LHF+IFLPTR)=DX
- Q(LHF+IFLPTR+1)=DY
- CALL IZINCF(2)
- IQ(LHNT+NPRIM)=-(1000000*IZGCOD(LHNT,NPRIM)+ITBPTR-1)
- ELSE
- IADRI2=ABS(IZGADR(LHNT,NPRIM))
- IADRI3=IADRI2
- 40 IF(IQ(LHNT+IADRI2).LT.0)THEN
- IADRI2=ABS(IZGADR(LHNT,IADRI2))
- IADRI3=IADRI2
- GOTO 40
- ENDIF
- IADRI2=IZGADR(LHNT,IADRI2)
- IF(IZPUSH(3,2,0,'IEMOPR').NE.0)GOTO 50
- CALL IZSTCC(INOPCO,INTPTR)
- IQ(LHI+INTPTR)=3000000+IFLPTR
- IQ(LHI+INTPTR+1)=IADRI2
- IQ(LHI+INTPTR+2)=IADRI3
- CALL IZINCI(3)
- Q(LHF+IFLPTR)=DX
- Q(LHF+IFLPTR+1)=DY
- CALL IZINCF(2)
- IQ(LHNT+IADRI3)=-(1000000*IZGCOD(LHNT,IADRI3)+ITBPTR-1)
- ENDIF
-*
-* Change on the screen
-*
- CALL IZSET
- ZFLAG=.FALSE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- LNDECO=LHNT
- LIDECO=LDI
- LFDECO=LDF
- LCDECO=LDC
- CALL IZDATT(0,NPRIM)
- CALL IZDNB(LHNT,LDI,LDF,LDC,NPRIM,1)
-*
- 50 ZFLAG=.TRUE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- GFLAG=.TRUE.
- GOTO 10
-*
- END
diff --git a/src/graflib/higz/ged/iempla.F b/src/graflib/higz/ged/iempla.F
deleted file mode 100644
index 3619d65..0000000
--- a/src/graflib/higz/ged/iempla.F
+++ /dev/null
@@ -1,47 +0,0 @@
-*
-* $Id: iempla.F,v 1.1.1.1 1996/02/14 13:10:23 mclareni Exp $
-*
-* $Log: iempla.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:23 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.06/03 09/01/89 11.49.22 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE IEMPLA(ICF,ICHOIO)
-*.===========>
-*.
-*..==========> (O.Couet)
-#include "higz/higed.inc"
-#include "higz/hiflag.inc"
- CHARACTER*80 CHVAL(3)
-*.______________________________________
-*
- TITLE(3)='POLYLINE ATTRIBUTES'
- CHITEM(1,3)='Polyline style'
- CHITEM(2,3)='Line width scale factor'
- CHITEM(3,3)='Polyline color index'
-*
- CALL IZITOC(ICLN,CHDEF(1))
- CALL IZRTOC(RCLWSC,CHDEF(2))
- CHDEF(3)=CHPLC
-*
- IPLACE=3
- CALL IGREQ(230,0,3,IPLACE,ICHOIC,CHVAL)
- ICHOIO=ICHOIC
- ICF=IPLACE
-*
- CALL IZCTOI(CHVAL(1),ICLN)
- CALL IZCTOR(CHVAL(2),RCLWSC)
- CALL IGFIRS(CHPLC,CHVAL(3))
- ICPLCI=IGICOL(CHVAL(3))
-*
- ZFLAG=.TRUE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- GFLAG=.TRUE.
- CALL ISLN(ICLN)
- CALL ISLWSC(RCLWSC)
- CALL ISPLCI(ICPLCI)
-*
- END
diff --git a/src/graflib/higz/ged/iempma.F b/src/graflib/higz/ged/iempma.F
deleted file mode 100644
index 11ecd33..0000000
--- a/src/graflib/higz/ged/iempma.F
+++ /dev/null
@@ -1,47 +0,0 @@
-*
-* $Id: iempma.F,v 1.1.1.1 1996/02/14 13:10:23 mclareni Exp $
-*
-* $Log: iempma.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:23 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.06/03 09/01/89 11.49.22 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE IEMPMA(ICF,ICHOIO)
-*.===========>
-*.
-*..==========> (O.Couet)
-#include "higz/higed.inc"
-#include "higz/hiflag.inc"
- CHARACTER*80 CHVAL(3)
-*.______________________________________
-*
- TITLE(3)='POLYMARKER ATTRIBUTES'
- CHITEM(1,3)='Polymarker type'
- CHITEM(2,3)='Polymarker color index'
- CHITEM(3,3)='Polymarker scale factor'
-*
- CALL IZITOC(ICMK,CHDEF(1))
- CHDEF(2)=CHPMC
- CALL IZRTOC(RCMKSC,CHDEF(3))
-*
- IPLACE=3
- CALL IGREQ(240,0,3,IPLACE,ICHOIC,CHVAL)
- ICHOIO=ICHOIC
- ICF=IPLACE
-*
- CALL IZCTOI(CHVAL(1),ICMK)
- CALL IGFIRS(CHPMC,CHVAL(2))
- ICPMCI=IGICOL(CHVAL(2))
- CALL IZCTOR(CHVAL(3),RCMKSC)
-*
- ZFLAG=.TRUE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- GFLAG=.TRUE.
- CALL ISMK(ICMK)
- CALL ISPMCI(ICPMCI)
- CALL ISMKSC(RCMKSC)
-*
- END
diff --git a/src/graflib/higz/ged/iemsta.F b/src/graflib/higz/ged/iemsta.F
deleted file mode 100644
index ea4803f..0000000
--- a/src/graflib/higz/ged/iemsta.F
+++ /dev/null
@@ -1,63 +0,0 @@
-*
-* $Id: iemsta.F,v 1.1.1.1 1996/02/14 13:10:23 mclareni Exp $
-*
-* $Log: iemsta.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:23 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.06/05 01/03/89 11.51.52 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE IEMSTA(ICF,ICHOIO)
-*.===========>
-*.
-*..==========> (O.Couet)
-#include "higz/higed.inc"
-#include "higz/hiflag.inc"
- CHARACTER*32 CHVAL(7)
-*.______________________________________
-*
- TITLE(3)='SOFTWARE TEXT'
- CHITEM(1,3)='Text to be drawn'
- CHITEM(2,3)='Text size'
- CHITEM(3,3)='Text angle'
- CHITEM(4,3)='Text shift'
- CHITEM(5,3)='Text color index'
- CHITEM(6,3)='Text pass'
- CHITEM(7,3)='CHOPT'
-*
- CHDEF(1)=CCST
- CALL IZRTOC(RCSTSI,CHDEF(2))
- CALL IZRTOC(RCSTAN,CHDEF(3))
- CALL IZRTOC(RCSTSH,CHDEF(4))
- CHDEF(5)=CHSTC
- CALL IZITOC(ICSTPA,CHDEF(6))
- CHDEF(7)=CHOPST
-*
- IPLACE=3
- ZFLAG=.TRUE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- CALL ISELNT(1)
- CALL IGREQ(1000,0,7,IPLACE,ICHOIC,CHVAL)
- ICHOIO=ICHOIC
- ICF=IPLACE
-*
- CALL IGFIRS(CHSTC,CHVAL(5))
- ICSTCI=IGICOL(CHVAL(5))
- CCST=CHVAL(1)
- CALL IZCTOR(CHVAL(2),RCSTSI)
- CALL IZCTOR(CHVAL(3),RCSTAN)
- CALL IZCTOR(CHVAL(4),RCSTSH)
- CALL IZCTOI(CHVAL(6),ICSTPA)
- CALL CLTOU(CHVAL(7))
- CHOPST=CHVAL(7)
-*
- ZFLAG=.TRUE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- GFLAG=.TRUE.
- CALL IGSET('CSHI',RCSTSH)
- CALL IGSET('PASS',FLOAT(ICSTPA))
- CALL ISTXCI(ICSTCI)
-*
- END
diff --git a/src/graflib/higz/ged/iemtxa.F b/src/graflib/higz/ged/iemtxa.F
deleted file mode 100644
index 56b1559..0000000
--- a/src/graflib/higz/ged/iemtxa.F
+++ /dev/null
@@ -1,67 +0,0 @@
-*
-* $Id: iemtxa.F,v 1.1.1.1 1996/02/14 13:10:23 mclareni Exp $
-*
-* $Log: iemtxa.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:23 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.06/03 09/01/89 11.49.22 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE IEMTXA(ICF,ICHOIO)
-*.===========>
-*.
-*..==========> (O.Couet)
-#include "higz/higed.inc"
-#include "higz/hiflag.inc"
- CHARACTER*32 CHVAL(8)
-*.______________________________________
-*
- TITLE(3)='TEXT'
- CHITEM(1,3)='Text to be drawn'
- CHITEM(2,3)='Text size'
- CHITEM(3,3)='Text angle'
- CHITEM(4,3)='Text font'
- CHITEM(5,3)='Text precision'
- CHITEM(6,3)='Text color'
- CHITEM(7,3)='Horizontal alignment'
- CHITEM(8,3)='Vertical alignment'
-*
- CHDEF(1)=CCTX
- CALL IZRTOC(RCTXSI,CHDEF(2))
- CALL IZRTOC(RCTXAN,CHDEF(3))
- CALL IZITOC(ICTXFT,CHDEF(4))
- CALL IZITOC(ICTXPR,CHDEF(5))
- CHDEF(6)=CHTXC
- CALL IZITOC(ICTXAH,CHDEF(7))
- CALL IZITOC(ICTXAV,CHDEF(8))
-*
- IPLACE=3
- ZFLAG=.TRUE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- CALL ISELNT(1)
- CALL IGREQ(1001,0,8,IPLACE,ICHOIC,CHVAL)
- ICHOIO=ICHOIC
- ICF=IPLACE
-*
- CALL IGFIRS(CHTXC,CHVAL(6))
- ICTXCI=IGICOL(CHVAL(6))
- CCTX=CHVAL(1)
- CALL IZCTOR(CHVAL(2),RCTXSI)
- CALL IZCTOR(CHVAL(3),RCTXAN)
- CALL IZCTOI(CHVAL(4),ICTXFT)
- CALL IZCTOI(CHVAL(5),ICTXPR)
- CALL IZCTOI(CHVAL(7),ICTXAH)
- CALL IZCTOI(CHVAL(8),ICTXAV)
-*
- ZFLAG=.TRUE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- GFLAG=.TRUE.
- CALL IGSET('TANG',RCTXAN)
- CALL ISCHH(RCTXSI)
- CALL ISTXFP(ICTXFT,ICTXPR)
- CALL ISTXCI(ICTXCI)
- CALL ISTXAL(ICTXAH,ICTXAV)
-*
- END
diff --git a/src/graflib/higz/ged/iepave.F b/src/graflib/higz/ged/iepave.F
deleted file mode 100644
index d711c1f..0000000
--- a/src/graflib/higz/ged/iepave.F
+++ /dev/null
@@ -1,102 +0,0 @@
-*
-* $Id: iepave.F,v 1.1.1.1 1996/02/14 13:10:23 mclareni Exp $
-*
-* $Log: iepave.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:23 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.07/01 19/07/89 10.47.25 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE IEPAVE(ICF,ICHOIO)
-*.===========>
-*.
-*..==========> (O.Couet)
-#include "higz/hiques.inc"
-#include "higz/hiatt.inc"
-#include "higz/higed.inc"
-#include "higz/hiflag.inc"
- CHARACTER*32 CHVAL(15)
-*.______________________________________
-*
- ICHOIO=0
- 10 IPLACE=2
- ZFLAG=.TRUE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- NTSAV=INTR
- CALL ISELNT(1)
- CALL IGREQ(21,3,16,IPLACE,ICHOIC,CHVAL)
- IF(ICHOIC.EQ.-1000)GOTO 10
-*
- 20 X(1)=RQUEST(13)
- Y(1)=RQUEST(14)
- CALL IGGRID(X(1),Y(1))
- NTLOC=IQUEST(10)
-*
- 30 IF(IPLACE.EQ.1)THEN
- ICF=1
- ICHOIO=ICHOIC
- CALL ISELNT(NTSAV)
- RETURN
- ENDIF
-*
- IF(IPLACE.EQ.3)GOTO 10
-*
- IF(ICHOIC.EQ.-1)THEN
- TITLE(3)='PAVING-BLOCK ATTRIBUTES'
- CHITEM(1,3)='Boxe style'
- CHITEM(2,3)='Frame style'
- CHITEM(3,3)='Frame size'
- CHITEM(4,3)='Options'
- CALL IZITOC(ICPBST,CHDEF(1))
- CALL IZITOC(ICPFST,CHDEF(2))
- CALL IZRTOC(RCDZPV,CHDEF(3))
- CHDEF(4)=CHOPPV
- IPLACE=3
- CALL IGREQ(298,0,4,IPLACE,ICHOIC,CHVAL)
- ICHOIO=ICHOIC
- ICF=IPLACE
- CALL IZCTOI(CHVAL(1),ICPBST)
- CALL IZCTOI(CHVAL(2),ICPFST)
- CALL IZCTOR(CHVAL(3),RCDZPV)
- CHOPPV=CHVAL(4)
- GOTO 20
- ENDIF
-*
- IF(ICHOIC.EQ.-2)THEN
- CALL IGCLES
- CALL IZPICT(EDIPIC,'D')
- CALL IEGRID
- GOTO 10
- ENDIF
-*
- IF(ICHOIC.EQ.-3)THEN
- CALL IZUNDO
- GOTO 10
- ENDIF
-*
- IF(ICHOIC.GE.1)THEN
- ICF=2
- ICHOIO=ICHOIC
- CALL ISELNT(NTSAV)
- RETURN
- ENDIF
-*
-
- ZFLAG=.TRUE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- CALL ISELNT(NTLOC)
- CALL IGGRID(X(1),Y(1))
- ZFLAG=.FALSE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- CALL IGPLOT(X(1),Y(1))
- ZFLAG=.TRUE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- 40 CALL IGLOC(51,NTLOC,IBN,XNDC,YNDC,X(2),Y(2))
- IF(NTLOC.NE.INTR)GOTO 40
- CALL IGGRID(X(2),Y(2))
- CALL IGPAVE(X(1),X(2),Y(1),Y(2),RCDZPV,ICPBST,ICPFST,CHOPPV)
- GOTO 10
-*
- END
diff --git a/src/graflib/higz/ged/iepl.F b/src/graflib/higz/ged/iepl.F
deleted file mode 100644
index cf71b9f..0000000
--- a/src/graflib/higz/ged/iepl.F
+++ /dev/null
@@ -1,100 +0,0 @@
-*
-* $Id: iepl.F,v 1.1.1.1 1996/02/14 13:10:23 mclareni Exp $
-*
-* $Log: iepl.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:23 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.07/01 19/07/89 10.47.26 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE IEPL(ICF,ICHOIO)
-*.===========>
-*.
-*..==========> (O.Couet)
-#include "higz/hiques.inc"
-#include "higz/hiatt.inc"
-#include "higz/higed.inc"
-#include "higz/hiflag.inc"
- CHARACTER*4 CHVAL(15)
-*.______________________________________
-*
- ICHOIO=0
- 201 IPLACE=2
- CALL IGREQ(21,3,16,IPLACE,ICHOIC,CHVAL)
- IF(ICHOIC.EQ.-1000)GOTO 201
- 203 X(1)=RQUEST(13)
- Y(1)=RQUEST(14)
- NTLOC=IQUEST(10)
-*
- IF(IPLACE.EQ.3)GOTO 201
-*
- IF(IPLACE.EQ.1)THEN
- ICF=1
- ICHOIO=ICHOIC
- RETURN
- ENDIF
-*
- IF(ICHOIC.EQ.-1)THEN
- CALL IEMPLA(IPLACE,ICHOIC)
- GOTO 203
- ENDIF
-*
- IF(ICHOIC.EQ.-2)THEN
- CALL IGCLES
- CALL IZPICT(EDIPIC,'D')
- CALL IEGRID
- GOTO 201
- ENDIF
-*
- IF(ICHOIC.EQ.-3)THEN
- CALL IZUNDO
- GOTO 201
- ENDIF
-*
- IF(ICHOIC.GE.1)THEN
- ICF=2
- ICHOIO=ICHOIC
- RETURN
- ENDIF
-*
- I=2
- ZFLAG=.TRUE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- CALL ISELNT(NTLOC)
- CALL IGGRID(X(1),Y(1))
- CALL IGPLOT(X(1),Y(1))
- ZFLAG=.FALSE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- 202 CALL IGLOC(41,NTLOC,IBN,XNDC,YNDC,X(I),Y(I))
- IF(IBN.EQ.1)THEN
- IF(NTLOC.NE.INTR)GOTO 202
- CALL IGGRID(X(I),Y(I))
- CALL IEALPT(X(I-1),Y(I-1))
- CALL IGLINE(X(I-1),X(I),Y(I-1),Y(I))
- I=I+1
- GOTO 202
- ELSE
- IF(I.LE.2)GOTO 201
- ZFLAG=.FALSE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- CALL IZSAV
- CALL IGLINE(X(I-1),X(1),Y(I-1),Y(1))
- CALL ISPLCI(0)
- CALL ISLN(1)
- X(I)=X(1)
- Y(I)=Y(1)
- CALL IPL(I,X,Y)
- CALL IZSET
- ZFLAG=.TRUE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- GFLAG=.TRUE.
- CALL ISLN(ICLN)
- CALL ISLWSC(RCLWSC)
- CALL ISPLCI(ICPLCI)
- CALL IPL(I-1,X,Y)
- GOTO 201
- ENDIF
-*
- END
diff --git a/src/graflib/higz/ged/iepm.F b/src/graflib/higz/ged/iepm.F
deleted file mode 100644
index 8d3bc07..0000000
--- a/src/graflib/higz/ged/iepm.F
+++ /dev/null
@@ -1,92 +0,0 @@
-*
-* $Id: iepm.F,v 1.1.1.1 1996/02/14 13:10:23 mclareni Exp $
-*
-* $Log: iepm.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:23 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.07/01 19/07/89 10.47.26 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE IEPM(ICF,ICHOIO)
-*.===========>
-*.
-*..==========> (O.Couet)
-#include "higz/hiques.inc"
-#include "higz/hiatt.inc"
-#include "higz/higed.inc"
-#include "higz/hiflag.inc"
- CHARACTER*4 CHVAL(15)
-*.______________________________________
-*
- ICHOIO=0
- 201 IPLACE=2
- CALL IGREQ(21,3,16,IPLACE,ICHOIC,CHVAL)
- IF(ICHOIC.EQ.-1000)GOTO 201
- 203 X(1)=RQUEST(13)
- Y(1)=RQUEST(14)
- NTLOC=IQUEST(10)
-*
- IF(IPLACE.EQ.3)GOTO 201
-*
- IF(IPLACE.EQ.1)THEN
- ICF=1
- ICHOIO=ICHOIC
- RETURN
- ENDIF
-*
- IF(ICHOIC.EQ.-1)THEN
- CALL IEMPMA(IPLACE,ICHOIC)
- GOTO 203
- ENDIF
-*
- IF(ICHOIC.EQ.-2)THEN
- CALL IGCLES
- CALL IZPICT(EDIPIC,'D')
- CALL IEGRID
- GOTO 201
- ENDIF
-*
- IF(ICHOIC.EQ.-3)THEN
- CALL IZUNDO
- GOTO 201
- ENDIF
-*
- IF(ICHOIC.GE.1)THEN
- ICF=2
- ICHOIO=ICHOIC
- RETURN
- ENDIF
-*
- ZFLAG=.TRUE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- CALL ISELNT(NTLOC)
- CALL IGGRID(X(1),Y(1))
- ZFLAG=.FALSE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- GFLAG=.TRUE.
- CALL ISMK(ICMK)
- CALL ISPMCI(ICPMCI)
- CALL IPM(1,X(1),Y(1))
- I=2
- 202 CALL IGLOC(21,NTLOC,IBN,XNDC,YNDC,X(I),Y(I))
- IF(IBN.EQ.1)THEN
- IF(NTLOC.NE.INTR)GOTO 202
- CALL IGGRID(X(I),Y(I))
- CALL IPM(1,X(I),Y(I))
- I=I+1
- GOTO 202
- ELSE
- ZFLAG=.TRUE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- GFLAG=.FALSE.
- CALL ISMK(ICMK)
- CALL ISPMCI(ICPMCI)
- CALL ISMKSC(RCMKSC)
- CALL IPM(I-1,X,Y)
- GFLAG=.TRUE.
- GOTO 201
- ENDIF
-*
- END
diff --git a/src/graflib/higz/ged/iepop.F b/src/graflib/higz/ged/iepop.F
deleted file mode 100644
index cacd60f..0000000
--- a/src/graflib/higz/ged/iepop.F
+++ /dev/null
@@ -1,71 +0,0 @@
-*
-* $Id: iepop.F,v 1.1.1.1 1996/02/14 13:10:23 mclareni Exp $
-*
-* $Log: iepop.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:23 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.07/01 19/07/89 10.47.26 by O.Couet
-*-- Author : O.Couet 16/01/89
- SUBROUTINE IEPOP(ICF,ICHOIO)
-*.===========>
-*.
-*..==========> (O.Couet)
-#include "higz/hipaw.inc"
-#include "higz/hiflag.inc"
-#include "higz/higed.inc"
- CHARACTER*8 SNAME
- CHARACTER*4 CHVAL(15)
-*.______________________________________
-*
- ICHOIO=0
- 10 IPLACE=2
- CALL IGREQ(21,3,16,IPLACE,ICHOIC,CHVAL)
- IF(IPLACE.EQ.3)GOTO 10
- IF(IPLACE.EQ.1)THEN
- ICF=1
- ICHOIO=ICHOIC
- RETURN
- ENDIF
- IF(ICHOIC.EQ.-1000)GOTO 10
- IF(ICHOIC.EQ.-1)GOTO 10
- IF(ICHOIC.EQ.-2)THEN
- CALL IGCLES
- CALL IZPICT(EDIPIC,'D')
- CALL IEGRID
- GOTO 10
- ENDIF
- IF(ICHOIC.EQ.-3)THEN
- GOTO 10
- ENDIF
- IF(ICHOIC.GE.1)THEN
- ICF=2
- ICHOIO=ICHOIC
- RETURN
- ENDIF
-*
- ZFLAG=.TRUE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- GFLAG=.TRUE.
- CALL IZPICK(NT,SNAME,NPRIM,'N')
- IF(NPRIM.LE.0)GOTO 30
- LN=IZGNTP(NT)
- IF(LN.EQ.0)GOTO 30
- CALL ISELNT(NT)
-*
- CALL IZSAV
- LNDECO=LHNT
- LIDECO=LDI
- LFDECO=LDF
- LCDECO=LDC
- CALL IZDATT(0,NPRIM)
- CALL IZDNB(LHNT,LHI,LHF,LHC,NPRIM,1)
- IQ(LHNT+NPRIM)=1000000
-*
- 30 CALL IZSET
- GOTO 10
-*
- END
-
diff --git a/src/graflib/higz/ged/iestx.F b/src/graflib/higz/ged/iestx.F
deleted file mode 100644
index 69e63a2..0000000
--- a/src/graflib/higz/ged/iestx.F
+++ /dev/null
@@ -1,73 +0,0 @@
-*
-* $Id: iestx.F,v 1.1.1.1 1996/02/14 13:10:23 mclareni Exp $
-*
-* $Log: iestx.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:23 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.06/03 09/01/89 13.29.51 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE IESTX(ICF,ICHOIO)
-*.===========>
-*.
-*..==========> (O.Couet)
-#include "higz/hipaw.inc"
-#include "higz/higed.inc"
-#include "higz/hiflag.inc"
-*.______________________________________
-*
- 10 CALL IEMSTA(IPLACE,ICHOIC)
-*
- IF(ICHOIC.EQ.-1000)THEN
- ICF=2
- ICHOIO=ICHOIC
- RETURN
- ENDIF
-*
- X(1)=RQUEST(13)
- Y(1)=RQUEST(14)
-*
- LN=LQ(LPICD-1)
- DO 20 I=1,IQ(LPICD+8)
- IF(LN.EQ.0)GOTO 10
- IF(IQ(LN+1).NE.0.AND.IQ(LN+1).NE.1)THEN
- CALL ISELNT(IQ(LN+1))
- ENDIF
- LN=LQ(LN)
- 20 CONTINUE
-*
- IF(IPLACE.EQ.1)THEN
- ICF=1
- ICHOIO=ICHOIC
- RETURN
- ENDIF
-*
- IF(IPLACE.EQ.2)THEN
- ICF=2
- ICHOIO=ICHOIC
- RETURN
- ENDIF
-*
- ZFLAG=.TRUE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- GFLAG=.TRUE.
- CALL ISELNT(1)
- CALL IGGRID(X(1),Y(1))
- CALL IGSET('CSHI',RCSTSH)
- CALL IGSET('PASS',FLOAT(ICSTPA))
- CALL ISTXCI(ICSTCI)
- CALL IGTEXT(X(1),Y(1),CCST,RCSTSI,RCSTAN,CHOPST)
-*
- LN=LQ(LPICD-1)
- DO 30 I=1,IQ(LPICD+8)
- IF(LN.EQ.0)GOTO 10
- IF(IQ(LN+1).NE.0.AND.IQ(LN+1).NE.1)THEN
- CALL ISELNT(IQ(LN+1))
- ENDIF
- LN=LQ(LN)
- 30 CONTINUE
- GOTO 10
-*
- END
diff --git a/src/graflib/higz/ged/ietx.F b/src/graflib/higz/ged/ietx.F
deleted file mode 100644
index d7423cc..0000000
--- a/src/graflib/higz/ged/ietx.F
+++ /dev/null
@@ -1,75 +0,0 @@
-*
-* $Id: ietx.F,v 1.1.1.1 1996/02/14 13:10:23 mclareni Exp $
-*
-* $Log: ietx.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:23 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.06/03 09/01/89 13.29.50 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE IETX(ICF,ICHOIO)
-*.===========>
-*.
-*..==========> (O.Couet)
-#include "higz/hipaw.inc"
-#include "higz/higed.inc"
-#include "higz/hiflag.inc"
-*.______________________________________
-*
- 10 CALL IEMTXA(IPLACE,ICHOIC)
-*
- IF(ICHOIC.EQ.-1000)THEN
- ICF=2
- ICHOIO=ICHOIC
- RETURN
- ENDIF
-*
- X(1)=RQUEST(13)
- Y(1)=RQUEST(14)
-*
- LN=LQ(LPICD-1)
- DO 20 I=1,IQ(LPICD+8)
- IF(LN.EQ.0)GOTO 10
- IF(IQ(LN+1).NE.0.AND.IQ(LN+1).NE.1)THEN
- CALL ISELNT(IQ(LN+1))
- ENDIF
- LN=LQ(LN)
- 20 CONTINUE
-*
- IF(IPLACE.EQ.1)THEN
- ICF=1
- ICHOIO=ICHOIC
- RETURN
- ENDIF
-*
- IF(IPLACE.EQ.2)THEN
- ICF=2
- ICHOIO=ICHOIC
- RETURN
- ENDIF
-*
- ZFLAG=.TRUE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- GFLAG=.TRUE.
- CALL ISELNT(1)
- CALL IGGRID(X(1),Y(1))
- CALL IGSET('TANG',RCTXAN)
- CALL ISCHH(RCTXSI)
- CALL ISTXFP(ICTXFT,ICTXPR)
- CALL ISTXCI(ICTXCI)
- CALL ISTXAL(ICTXAH,ICTXAV)
- CALL ITX(X(1),Y(1),CCTX)
-*
- LN=LQ(LPICD-1)
- DO 30 I=1,IQ(LPICD+8)
- IF(LN.EQ.0)GOTO 10
- IF(IQ(LN+1).NE.0.AND.IQ(LN+1).NE.1)THEN
- CALL ISELNT(IQ(LN+1))
- ENDIF
- LN=LQ(LN)
- 30 CONTINUE
- GOTO 10
-*
- END
diff --git a/src/graflib/higz/ged/iewin.F b/src/graflib/higz/ged/iewin.F
deleted file mode 100644
index a478550..0000000
--- a/src/graflib/higz/ged/iewin.F
+++ /dev/null
@@ -1,106 +0,0 @@
-*
-* $Id: iewin.F,v 1.1.1.1 1996/02/14 13:10:23 mclareni Exp $
-*
-* $Log: iewin.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:23 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.19/10 15/09/93 10.06.31 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE IEWIN(ICF,ICHOIO)
-*.===========>
-*.
-*..==========> (O.Couet)
-#include "higz/hiques.inc"
-#include "higz/hiatt.inc"
-#include "higz/higed.inc"
-#include "higz/hiflag.inc"
- CHARACTER*12 CINTR
- CHARACTER*32 CHVAL(5)
- CHARACTER*20 CCEWX1,CCEWX2,CCEWY1,CCEWY2,CCENT
-*.______________________________________
-*
- ICENT=100
- 21 ICENT=ICENT+1
-#if (!defined(CERNLIB_NTC))&&(!defined(CERNLIB_X11))
- CALL IZGNT(ICENT,IFIND,IAWV,IPRIO,IHPRIO)
- IF(IFIND.NE.0)GOTO 21
-#endif
-#if defined(CERNLIB_NTC)||defined(CERNLIB_X11)
- IF(IGNSCU(ICENT).NE.0)GOTO 21
-#endif
- RCEWX1=0.
- RCEWX2=1.
- RCEWY1=0.
- RCEWY2=1.
- CALL IZITOC(ICENT,CCENT)
- CALL IZRTOC(RCEWX1,CCEWX1)
- CALL IZRTOC(RCEWX2,CCEWX2)
- CALL IZRTOC(RCEWY1,CCEWY1)
- CALL IZRTOC(RCEWY2,CCEWY2)
- TITLE(3)='CURRENT WINDOW PARAMETERS'
- CHITEM(1,3)='NT'
- CHITEM(2,3)='XMIN'
- CHITEM(3,3)='XMAX'
- CHITEM(4,3)='YMIN'
- CHITEM(5,3)='YMAX'
- CHDEF(1)=CCENT
- CHDEF(2)=CCEWX1
- CHDEF(3)=CCEWX2
- CHDEF(4)=CCEWY1
- CHDEF(5)=CCEWY2
- IPLACE=3
- CALL IGREQ(310,0,5,IPLACE,ICHOIC,CHVAL)
-*
- IF(ICHOIC.EQ.-1000)THEN
- ICF=2
- ICHOIO=ICHOIC
- RETURN
- ENDIF
-*
- IF(IPLACE.EQ.1)THEN
- ICF=1
- ICHOIO=ICHOIC
- RETURN
- ENDIF
-*
- IF(IPLACE.EQ.2)THEN
- ICF=2
- ICHOIO=ICHOIC
- RETURN
- ENDIF
-*
- CALL IZCTOI(CHVAL(1),ICENT)
- CALL IZCTOR(CHVAL(2),RCEWX1)
- CALL IZCTOR(CHVAL(3),RCEWX2)
- CALL IZCTOR(CHVAL(4),RCEWY1)
- CALL IZCTOR(CHVAL(5),RCEWY2)
- X(1)=RQUEST(11)/REDIT
- Y(1)=RQUEST(12)/REDIT
- CALL IGPLOT(X(1),Y(1))
- CALL IGLOC(51,NTLOC,IBN,X(2),Y(2),XWC,YWC)
- IF(IBN.EQ.0)RETURN
-*
- X(2)=X(2)/REDIT
- Y(2)=Y(2)/REDIT
- ZFLAG=.TRUE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- GFLAG=.TRUE.
- CALL ISWN(ICENT,RCEWX1,RCEWX2,RCEWY1,RCEWY2)
- CALL IGEX(X(1),X(2))
- CALL IGEX(Y(1),Y(2))
- CALL ISVP(ICENT,X(1),X(2),Y(1),Y(2))
- CALL ISELNT(ICENT)
- CALL IZITOC(ICENT,CINTR)
- CHUSKE(1,2)=CINTR
- IPLACE=2
- CALL IGMENU(0,TITLE(IPLACE)
- +, XPM(1,IPLACE),XPM(2,IPLACE)
- +, YPM(1,IPLACE),YPM(2,IPLACE)
- +, NBU(IPLACE),CHUSKE(1,IPLACE)
- +, NBITEM(IPLACE),CHITEM(1,IPLACE)
- +, CHDEF,CHVAL,1,'UTW')
-*
- END
diff --git a/src/graflib/higz/ged/igbord.F b/src/graflib/higz/ged/igbord.F
deleted file mode 100644
index 5e7f366..0000000
--- a/src/graflib/higz/ged/igbord.F
+++ /dev/null
@@ -1,77 +0,0 @@
-*
-* $Id: igbord.F,v 1.1.1.1 1996/02/14 13:10:23 mclareni Exp $
-*
-* $Log: igbord.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:23 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.07/01 15/06/89 17.36.38 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE IGBORD(NTB,X1,X2,Y1,Y2,ILNTY)
-*.===========>
-*.
-*. This routine draws the curent NT border
-*.
-*..==========> (O.Couet)
-#include "higz/hiatt.inc"
-#include "higz/hiflag.inc"
- DIMENSION X(5),Y(5)
- LOGICAL ZFS,GFS
-*.______________________________________
-*
- CALL IZSAV
- NTSAV=INTR
- ZFS=ZFLAG
- GFS=GFLAG
- ZFLAG=.FALSE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- GFLAG=.TRUE.
- X(1)=X1
- X(2)=X1
- X(3)=X2
- X(4)=X2
- X(5)=X1
- Y(1)=Y1
- Y(2)=Y2
- Y(3)=Y2
- Y(4)=Y1
- Y(5)=Y1
-*
- IF(NTB.EQ.0)THEN
- X(1)=0.
- X(2)=0.
- X(3)=1.
- X(4)=1.
- X(5)=0.
- Y(1)=0.
- Y(2)=(RDWYMA-RDWYMI)*REDIT
- Y(3)=(RDWYMA-RDWYMI)*REDIT
- Y(4)=0.
- Y(5)=0.
- ENDIF
- CALL ISELNT(NTB)
- CALL ISFACI(0)
- CALL ISFAIS(1)
- CALL ISTXFP(0,2)
- CALL IGBOX(X1,X2,Y1,Y2)
- CALL IGAXIS(X1,X2,Y1,Y1,X1,X2,1,'NB')
- CALL IGAXIS(X1,X1,Y1,Y2,Y1,Y2,1,'NB')
- IF(NTB.EQ.NTSAV)THEN
- CALL ISMKSC(2.)
- CALL ISMK(29)
- XP=(X2-X1)/2
- YP=(Y2-Y1)/2
- CALL IPM(1,XP,YP)
- ENDIF
- CALL ISPLCI(1)
- CALL ISLN(ILNTY)
- CALL IPL(5,X,Y)
- CALL IZSET
- CALL ISELNT(NTSAV)
- ZFLAG=ZFS
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- GFLAG=GFS
-*
- END
diff --git a/src/graflib/higz/ged/igccol.F b/src/graflib/higz/ged/igccol.F
deleted file mode 100644
index 225fc58..0000000
--- a/src/graflib/higz/ged/igccol.F
+++ /dev/null
@@ -1,39 +0,0 @@
-*
-* $Id: igccol.F,v 1.1.1.1 1996/02/14 13:10:23 mclareni Exp $
-*
-* $Log: igccol.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:23 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.11/00 05/11/90 17.05.57 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE IGCCOL(IVAL,CHVALI)
-*.===========>
-*.
-*. Convert color index in color name
-*.
-*..==========> (O.Couet)
- CHARACTER*(*) CHVALI
-*.______________________________________
-*
- IF(IVAL.EQ.2)CHVALI='Red'
- IF(IVAL.EQ.3)CHVALI='Green'
- IF(IVAL.EQ.4)CHVALI='Blue'
-#if !defined(CERNLIB_DECGKS)
- IF(IVAL.EQ.0)CHVALI='Black'
- IF(IVAL.EQ.1)CHVALI='White'
- IF(IVAL.EQ.5)CHVALI='Yellow'
- IF(IVAL.EQ.6)CHVALI='Magenta'
- IF(IVAL.EQ.7)CHVALI='Cyan'
-#endif
-#if defined(CERNLIB_DECGKS)
- IF(IVAL.EQ.0)CHVALI='White'
- IF(IVAL.EQ.1)CHVALI='Black'
- IF(IVAL.EQ.6)CHVALI='Magenta'
- IF(IVAL.EQ.5)CHVALI='Cyan'
- IF(IVAL.EQ.7)CHVALI='Yellow'
-#endif
-*
- END
diff --git a/src/graflib/higz/ged/igcfai.F b/src/graflib/higz/ged/igcfai.F
deleted file mode 100644
index 5a705dd..0000000
--- a/src/graflib/higz/ged/igcfai.F
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: igcfai.F,v 1.1.1.1 1996/02/14 13:10:23 mclareni Exp $
-*
-* $Log: igcfai.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:23 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.06/03 16/12/88 14.00.46 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE IGCFAI(IVAL,CHVALI)
-*.===========>
-*.
-*..==========> (O.Couet)
- CHARACTER*(*) CHVALI
-*.______________________________________
-*
- IF(IVAL.EQ.1)CHVALI='Solid'
- IF(IVAL.EQ.0)CHVALI='Hollow'
- IF(IVAL.EQ.2)CHVALI='Pattern'
- IF(IVAL.EQ.3)CHVALI='Hatch'
-*
- END
diff --git a/src/graflib/higz/ged/igclwn.F b/src/graflib/higz/ged/igclwn.F
deleted file mode 100644
index a2c5b78..0000000
--- a/src/graflib/higz/ged/igclwn.F
+++ /dev/null
@@ -1,54 +0,0 @@
-*
-* $Id: igclwn.F,v 1.1.1.1 1996/02/14 13:10:23 mclareni Exp $
-*
-* $Log: igclwn.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:23 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.06/03 16/12/88 14.00.46 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE IGCLWN(NTCL)
-*.===========>
-*.
-*. This routine clears the window NTCL
-*.
-*..==========> (O.Couet)
-#include "higz/hipaw.inc"
-#include "higz/hiflag.inc"
- LOGICAL ZFS,GFS
-*.______________________________________
-*
- IF(NTCL.EQ.0)THEN
- CALL IGCLES
- RETURN
- ELSE
- CALL IZSAV
- ZFS=ZFLAG
- GFS=GFLAG
- ZFLAG=.TRUE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- GFLAG=.TRUE.
-*
- CALL ISELNT(NTCL)
- IF(LHNT.EQ.0)RETURN
- ZFLAG=.FALSE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
-*
- IWVA=IQ(LHNT+2)
- X1CL=Q(LHF+IWVA)
- X2CL=Q(LHF+IWVA+1)
- Y1CL=Q(LHF+IWVA+2)
- Y2CL=Q(LHF+IWVA+3)
- CALL IGSET('BORD',0.)
- CALL ISFACI(0)
- CALL ISFAIS(1)
- CALL IGBOX(X1CL,X2CL,Y1CL,Y2CL)
- CALL IZSET
- ZFLAG=ZFS
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- GFLAG=GFS
- ENDIF
-*
- END
diff --git a/src/graflib/higz/ged/igex.F b/src/graflib/higz/ged/igex.F
deleted file mode 100644
index eedca63..0000000
--- a/src/graflib/higz/ged/igex.F
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: igex.F,v 1.1.1.1 1996/02/14 13:10:24 mclareni Exp $
-*
-* $Log: igex.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:24 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.06/03 16/12/88 14.00.46 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE IGEX(X1,X2)
-*.===========>
-*.
-*. This routine exchange X1 and X2 in order than X2 > X1 .
-*.
-*..==========> (O.Couet)
- IF(X2.LT.X1)THEN
- XT=X2
- X2=X1
- X1=XT
- ENDIF
-*
- END
diff --git a/src/graflib/higz/ged/igfirs.F b/src/graflib/higz/ged/igfirs.F
deleted file mode 100644
index 8045125..0000000
--- a/src/graflib/higz/ged/igfirs.F
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: igfirs.F,v 1.1.1.1 1996/02/14 13:10:24 mclareni Exp $
-*
-* $Log: igfirs.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:24 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.06/05 27/02/89 14.13.05 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE IGFIRS(CHDEF,STRING)
-*.===========>
-*.
-*. This routine puts the STRING in the first place in CHDEF.
-*.
-*..==========> (O.Couet)
- CHARACTER*(*) CHDEF,STRING
- CHARACTER*80 CHINT,CHINT2
-*.______________________________________
-*
- ILEN1=LENOCC(CHDEF)
- ILEN2=LENOCC(STRING)
- I1=INDEX(CHDEF,STRING(1:ILEN2))
- CHINT=' '
- CHINT2=' '
- IF(I1.EQ.1)RETURN
- CHINT=CHDEF(I1:ILEN1)
- II2=LENOCC(CHINT)
- CHINT2=CHDEF(1:I1-2)
- I2=LENOCC(CHINT2)
- CHDEF=CHINT(1:II2)//','//CHINT2(1:I2)
-*
- END
diff --git a/src/graflib/higz/ged/iggrid.F b/src/graflib/higz/ged/iggrid.F
deleted file mode 100644
index 8dfa5e2..0000000
--- a/src/graflib/higz/ged/iggrid.F
+++ /dev/null
@@ -1,30 +0,0 @@
-*
-* $Id: iggrid.F,v 1.1.1.1 1996/02/14 13:10:24 mclareni Exp $
-*
-* $Log: iggrid.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:24 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.07/01 19/07/89 10.28.17 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE IGGRID(XG,YG)
-*.===========>
-*.
-*. Align a point on the current defined grid.
-*. This routine do nothing if no grid is defined.
-*.
-*..==========> (O.Couet)
-#include "higz/higed.inc"
-#include "higz/hiatt.inc"
-*.______________________________________
-*
- IF((IXSTEP*IXFACT.NE.0).AND.(IYSTEP*IYFACT.NE.0))THEN
- XGDX=(RWXMAX-RWXMIN)/FLOAT(IXSTEP*IXFACT)
- YGDY=(RWYMAX-RWYMIN)/FLOAT(IYSTEP*IYFACT)
- XG=FLOAT(INT((XG+(0.5*XGDX))/XGDX))*XGDX
- YG=FLOAT(INT((YG+(0.5*YGDY))/YGDY))*YGDY
- ENDIF
-*
- END
diff --git a/src/graflib/higz/ged/igicol.F b/src/graflib/higz/ged/igicol.F
deleted file mode 100644
index 6f9c893..0000000
--- a/src/graflib/higz/ged/igicol.F
+++ /dev/null
@@ -1,40 +0,0 @@
-*
-* $Id: igicol.F,v 1.1.1.1 1996/02/14 13:10:24 mclareni Exp $
-*
-* $Log: igicol.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:24 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.11/00 05/11/90 17.05.58 by O.Couet
-*-- Author : O.Couet
- INTEGER FUNCTION IGICOL(CHVALI)
-*.===========>
-*.
-*. Convert color name in color index
-*.
-*..==========> (O.Couet)
- CHARACTER*(*) CHVALI
-*.______________________________________
-*
- IGICOL=0
- IF(CHVALI(1:LENOCC(CHVALI)).EQ.'Red')IGICOL=2
- IF(CHVALI(1:LENOCC(CHVALI)).EQ.'Green')IGICOL=3
- IF(CHVALI(1:LENOCC(CHVALI)).EQ.'Blue')IGICOL=4
-#if !defined(CERNLIB_DECGKS)
- IF(CHVALI(1:LENOCC(CHVALI)).EQ.'Black')IGICOL=0
- IF(CHVALI(1:LENOCC(CHVALI)).EQ.'White')IGICOL=1
- IF(CHVALI(1:LENOCC(CHVALI)).EQ.'Yellow')IGICOL=5
- IF(CHVALI(1:LENOCC(CHVALI)).EQ.'Magenta')IGICOL=6
- IF(CHVALI(1:LENOCC(CHVALI)).EQ.'Cyan')IGICOL=7
-#endif
-#if defined(CERNLIB_DECGKS)
- IF(CHVALI(1:LENOCC(CHVALI)).EQ.'White')IGICOL=0
- IF(CHVALI(1:LENOCC(CHVALI)).EQ.'Black')IGICOL=1
- IF(CHVALI(1:LENOCC(CHVALI)).EQ.'Magenta')IGICOL=6
- IF(CHVALI(1:LENOCC(CHVALI)).EQ.'Cyan')IGICOL=5
- IF(CHVALI(1:LENOCC(CHVALI)).EQ.'Yellow')IGICOL=7
-#endif
-*
- END
diff --git a/src/graflib/higz/ged/igifai.F b/src/graflib/higz/ged/igifai.F
deleted file mode 100644
index 9cbdb39..0000000
--- a/src/graflib/higz/ged/igifai.F
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: igifai.F,v 1.1.1.1 1996/02/14 13:10:24 mclareni Exp $
-*
-* $Log: igifai.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:24 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.06/05 27/02/89 14.13.56 by O.Couet
-*-- Author : O.Couet
- INTEGER FUNCTION IGIFAI(CHVALI)
-*.===========>
-*.
-*..==========> (O.Couet)
- CHARACTER*(*) CHVALI
-*.______________________________________
-*
- IGIFAI=0
- IF(CHVALI(1:LENOCC(CHVALI)).EQ.'Solid')IGIFAI=1
- IF(CHVALI(1:LENOCC(CHVALI)).EQ.'Hollow')IGIFAI=0
- IF(CHVALI(1:LENOCC(CHVALI)).EQ.'Pattern')IGIFAI=2
- IF(CHVALI(1:LENOCC(CHVALI)).EQ.'Hatch')IGIFAI=3
-*
- END
diff --git a/src/graflib/higz/ged/iginme.F b/src/graflib/higz/ged/iginme.F
deleted file mode 100644
index 29ec474..0000000
--- a/src/graflib/higz/ged/iginme.F
+++ /dev/null
@@ -1,227 +0,0 @@
-*
-* $Id: iginme.F,v 1.1.1.1 1996/02/14 13:10:24 mclareni Exp $
-*
-* $Log: iginme.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:24 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.07/00 25/04/89 11.28.33 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE IGINME
-*.===========>
-*.
-*. This routine initialize the menu package and the
-*. default primitives attributes of the editor.
-*.
-*..==========> (O.Couet)
-#include "higz/higed.inc"
-#include "higz/hiflag.inc"
- LOGICAL ZFS,GFS
-*.______________________________________
-*
- ZFS=ZFLAG
- GFS=GFLAG
- ZFLAG=.FALSE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- GFLAG=.TRUE.
-*
-* Polyline
-*
- ICPLCI=1
- ICLN=1
- RCLWSC=1.
- CALL ISPLCI(ICPLCI)
- CALL ISLWSC(RCLWSC)
- CALL ISLN(ICLN)
- CHPLC='White,Black,Red,Green,Blue,Magenta,Cyan,Yellow'
-*
-* Fill area
-*
- ICFACI=1
- ICFAIS=0
-#if defined(CERNLIB_GKSGRAL)
- ICFASI=-3
-#endif
-#if !defined(CERNLIB_GKSGRAL)
- ICFASI=1
-#endif
- CALL ISFACI(ICFACI)
- CALL ISFAIS(ICFAIS)
- CALL ISFASI(ICFASI)
- CHFAC='White,Black,Red,Green,Blue,Magenta,Cyan,Yellow'
- CHFAIS='Hollow,Solid,Pattern,Hatch'
-*
-* Polymarker
-*
- ICPMCI=1
- ICMK=3
- RCMKSC=1.
- CALL ISMKSC(RCMKSC)
- CALL ISPMCI(ICPMCI)
- CALL ISMK(ICMK)
- CHPMC='White,Black,Red,Green,Blue,Magenta,Cyan,Yellow'
-*
-* Text
-*
- ICTXCI=1
- RCTXAN=0.
- RCTXSI=.5
- ICTXFT=0
- ICTXPR=2
- ICTXCI=1
- ICTXAH=0
- ICTXAV=0
- CALL IGSET('TANG',0.)
- CALL ISCHH(RCTXSI)
- CALL ISTXFP(1,0)
- CALL ISTXCI(ICTXCI)
- CALL ISTXAL(ICTXAH,ICTXAV)
- CCTX=' '
- CHTXC='White,Black,Red,Green,Blue,Magenta,Cyan,Yellow'
-*
-* Histogram
-*
- CHOPHI='HF'
- RCBOF=0.250
- RCBWD=0.500
- ICHILN=1
- ICHIPC=1
- ICHIFC=1
- ICHIFI=0
-#if defined(CERNLIB_GKSGRAL)
- ICHIFS=-3
-#endif
-#if !defined(CERNLIB_GKSGRAL)
- ICHIFS=1
-#endif
- CHHIIS='Hollow,Solid,Pattern,Hatch'
- CHHIFC='White,Black,Red,Green,Blue,Magenta,Cyan,Yellow'
- CHHIPC='White,Black,Red,Green,Blue,Magenta,Cyan,Yellow'
- CALL IGSET('BARO',0.250)
- CALL IGSET('BARW',0.500)
-*
-* Software text
-*
- RCSTAN=0.
- RCSTSI=.5
- ICSTPA=1
- RCSTSH=0.
- CHOPST='L'
- ICSTCI=1
- CCST=' '
- CALL IGSET('CSHI',RCSTSH)
- CALL IGSET('PASS',FLOAT(ICSTPA))
- CHSTC='White,Black,Red,Green,Blue,Magenta,Cyan,Yellow'
-*
-* Boxe
-*
- ICBOCI=1
- ICBOIS=0
-#if defined(CERNLIB_GKSGRAL)
- ICBOSI=-3
-#endif
-#if !defined(CERNLIB_GKSGRAL)
- ICBOSI=1
-#endif
- ICBOBO=1
- CHBOC='White,Black,Red,Green,Blue,Magenta,Cyan,Yellow'
- CHBOIS='Hollow,Solid,Pattern,Hatch'
- CHBOBO='Yes,No'
- CALL IGSET('BORD',1.)
-*
-* Frame boxe
-*
- ICFBCI=1
- ICFBIS=0
-#if defined(CERNLIB_GKSGRAL)
- ICFBSI=-3
-#endif
-#if !defined(CERNLIB_GKSGRAL)
- ICFBSI=1
-#endif
- ICFBBO=1
- CHFBC='White,Black,Red,Green,Blue,Magenta,Cyan,Yellow'
- CHFBIS='Hollow,Solid,Pattern,Hatch'
- CHFBBO='Yes,No'
-*
-* Arrow
-*
- RCARSI=.4
- CHDOAR='No,Yes'
- CHAFL='No,Yes'
- ICARLC=1
- ICARFC=1
- ICARFI=0
-#if defined(CERNLIB_GKSGRAL)
- ICARFS=-3
-#endif
-#if !defined(CERNLIB_GKSGRAL)
- ICARFS=1
-#endif
- ICARLN=1
- CHARFC='White,Black,Red,Green,Blue,Magenta,Cyan,Yellow'
- CHARLC='White,Black,Red,Green,Blue,Magenta,Cyan,Yellow'
- CHARFI='Hollow,Solid,Pattern,Hatch'
-*
-* Pave
-*
- ICPBST=0
-#if defined(CERNLIB_GKSGRAL)
- ICPFST=-3
-#endif
-#if !defined(CERNLIB_GKSGRAL)
- ICPFST=1
-#endif
- RCDZPV=0.5
- CHOPPV='TR'
-*
-* Axis
-*
- RCAXTS=0.1
- RCAXLS=0.1
- RCAXLO=0.1
- RCAXW1=0.
- RCAXW2=1.
- ICAXND=10
- ICAXLN=1
- ICAXLC=1
- ICAXLF=1
- ICAXLP=0
- CHOPAX=' '
- CHAXLC='White,Black,Red,Green,Blue,Magenta,Cyan,Yellow'
-*
-* Arc
-*
- ICACFI=0
-#if defined(CERNLIB_GKSGRAL)
- ICACFS=-3
-#endif
-#if !defined(CERNLIB_GKSGRAL)
- ICACFS=1
-#endif
- ICACBO=1
- ICACLC=1
- ICACFC=1
- CHACIS='Hollow,Solid,Pattern,Hatch'
- CHACLC='White,Black,Red,Green,Blue,Magenta,Cyan,Yellow'
- CHACFC='White,Black,Red,Green,Blue,Magenta,Cyan,Yellow'
- CHACBO='Yes,No'
-*
-* Grid
-*
- IXSTEP=0
- IYSTEP=0
- IXFACT=1
- IYFACT=1
-*
- DO 10 I=1,3
- ICUCHO(I)=0
- ICUMEN(I)=0
- 10 CONTINUE
-*
- ZFLAG=ZFS
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- GFLAG=GFS
- END
diff --git a/src/graflib/higz/ged/igline.F b/src/graflib/higz/ged/igline.F
deleted file mode 100644
index aa25205..0000000
--- a/src/graflib/higz/ged/igline.F
+++ /dev/null
@@ -1,43 +0,0 @@
-*
-* $Id: igline.F,v 1.1.1.1 1996/02/14 13:10:24 mclareni Exp $
-*
-* $Log: igline.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:24 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.06/03 16/12/88 14.00.47 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE IGLINE(XS,XE,YS,YE)
-*.===========>
-*.
-*. Draw a line between two points
-*.
-*..==========> (O.Couet)
-#include "higz/hiflag.inc"
- DIMENSION X(2),Y(2)
- LOGICAL GFS,ZFS
-*.______________________________________
-*
- GFS=GFLAG
- ZFS=ZFLAG
- ZFLAG=.FALSE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- GFLAG=.TRUE.
-*
- CALL IZSAV
- X(1)=XS
- X(2)=XE
- Y(1)=YS
- Y(2)=YE
- CALL ISLN(1)
- CALL ISPLCI(1)
- CALL IPL(2,X,Y)
- CALL IZSET
-*
- ZFLAG=ZFS
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- GFLAG=GFS
-*
- END
diff --git a/src/graflib/higz/ged/igplot.F b/src/graflib/higz/ged/igplot.F
deleted file mode 100644
index 4c9c2f7..0000000
--- a/src/graflib/higz/ged/igplot.F
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: igplot.F,v 1.1.1.1 1996/02/14 13:10:24 mclareni Exp $
-*
-* $Log: igplot.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:24 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.10/00 28/02/90 11.47.02 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE IGPLOT(X,Y)
-*.===========>
-*.
-*. Plot a blank point at the position X,Y
-*.
-*..==========> (O.Couet)
-#include "higz/hiflag.inc"
- LOGICAL ZFS
-*.______________________________________
-*
- ZFS=ZFLAG
- ZFLAG=.FALSE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- CALL IZSAV
- CALL ISMK(1)
- CALL ISPMCI(1)
- CALL IPM(1,X,Y)
- CALL IZSET
- ZFLAG=ZFS
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
-*
- END
diff --git a/src/graflib/higz/ged/igreq.F b/src/graflib/higz/ged/igreq.F
deleted file mode 100644
index 3f4871c..0000000
--- a/src/graflib/higz/ged/igreq.F
+++ /dev/null
@@ -1,173 +0,0 @@
-*
-* $Id: igreq.F,v 1.1.1.1 1996/02/14 13:10:24 mclareni Exp $
-*
-* $Log: igreq.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:24 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.10/03 07/06/90 14.38.29 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE IGREQ(MN,NBUSE,NBI,IPLAC,ICHOIC,CHVAL)
-*.===========>
-*.
-*..==========> (O.Couet)
-#include "higz/higed.inc"
-#include "higz/hiflag.inc"
-#include "higz/hiatt.inc"
- PARAMETER (CHSIZ=0.025)
- CHARACTER*(*) CHVAL(NBI)
- CHARACTER*8 CHOPT
- LOGICAL ZFS,GFS
-*.______________________________________
-*
- ZFS=ZFLAG
- GFS=GFLAG
- ZFLAG=.FALSE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- GFLAG=.TRUE.
-*
- IPLACE=IPLAC
- NBITEM(IPLACE)=NBI
- NBU(IPLACE)=NBUSE
- CHOPT=' '
-*
- IF(NBU(IPLACE).NE.0)THEN
- INC=1
- ELSE
- INC=0
- ENDIF
-*
- IF(IPLACE.EQ.1)THEN
- XPM(1,1)=REDIT+0.005
- XPM(2,1)=1.-0.015
- YPM(2,1)=1.-0.015
- YPM(1,1)=YPM(2,1)-CHSIZ*(NBI+INC)
- ENDIF
- IF(IPLACE.EQ.2)THEN
- XPM(1,2)=XPM(1,1)
- XPM(2,2)=XPM(2,1)
- YPM(2,2)=YPM(1,1)-0.03
- YPM(1,2)=YPM(2,2)-CHSIZ*(NBI+INC)
- ENDIF
- IF(IPLACE.EQ.3)THEN
- XPM(1,3)=0.001
- XPM(2,3)=REDIT-0.015
- YPM(2,3)=YPM(2,1)
- YPM(1,3)=YPM(2,1)-CHSIZ*(NBI+INC)
- IF(YPM(1,3).LT.REDIT+0.005)YPM(1,3)=REDIT+0.005
- ENDIF
-*
- DO 10 I=IPLACE+1,3
- IF(ICUMEN(I).NE.0)THEN
- CALL IGMENU(0,TITLE(I)
- +, XPM(1,I),XPM(2,I)
- +, YPM(1,I),YPM(2,I)
- +, NBU(I),CHUSKE(1,I)
- +, NBITEM(I),CHITEM(1,I)
- +, CHDEF,CHVAL,ICHOI,'EW')
- ICUMEN(I)=0
- ICUCHO(I)=0
- ENDIF
- 10 CONTINUE
-*
- IF((ICUMEN(IPLACE).EQ.MN))THEN
- CHOPT(1:3)='WT '
- ELSE
- CHOPT(1:3)='DWT'
- ICUMEN(IPLACE)=MN
- ENDIF
- IF(IPLACE.EQ.3)CHOPT(4:4)='P'
- IF(JBIT(ISOF,1).NE.0)CHOPT(5:5)='S'
- IF(JBIT(ISOF,2).NE.0)CHOPT(6:6)='A'
-*
- CALL IGMENU(0,TITLE(IPLACE)
- +,XPM(1,IPLACE),XPM(2,IPLACE)
- +,YPM(1,IPLACE),YPM(2,IPLACE)
- +,NBU(IPLACE),CHUSKE(1,IPLACE)
- +,NBITEM(IPLACE),CHITEM(1,IPLACE)
- +,CHDEF,CHVAL,ICHOI,CHOPT)
-*
- IF(IPLACE.EQ.3)THEN
- CALL IGMENU(0,TITLE(IPLACE)
- +, XPM(1,IPLACE),XPM(2,IPLACE)
- +, YPM(1,IPLACE),YPM(2,IPLACE)
- +, NBU(IPLACE),CHUSKE(1,IPLACE)
- +, NBITEM(IPLACE),CHITEM(1,IPLACE)
- +, CHDEF,CHVAL,ICHOI,'CPRT')
- ELSE
- ICHOI=ICUCHO(IPLACE)
- CALL IGMENU(0,TITLE(IPLACE)
- +, XPM(1,IPLACE),XPM(2,IPLACE)
- +, YPM(1,IPLACE),YPM(2,IPLACE)
- +, NBU(IPLACE),CHUSKE(1,IPLACE)
- +, NBITEM(IPLACE),CHITEM(1,IPLACE)
- +, CHDEF,CHVAL,ICHOI,'CHRT')
- ENDIF
-*
-* Picked outside the menu
-*
- IF(ICHOI.EQ.0)THEN
- ILOOP=IPLACE-1
- DO 30 I=ILOOP,1,-1
- CALL IGMENU(0,TITLE(I)
- + , XPM(1,I),XPM(2,I)
- +, YPM(1,I),YPM(2,I)
- +, NBU(I),CHUSKE(1,I)
- +, NBITEM(I),CHITEM(1,I)
- +, CHDEF,CHVAL,ICHOI,'CNT')
- IF(ICHOI.NE.0)THEN
- IPLACE=I
- DO 20 J=3,IPLACE+1,-1
- IF(ICUMEN(J).NE.0)THEN
- CALL IGMENU(0,TITLE(J)
- +, XPM(1,J),XPM(2,J)
- +, YPM(1,J),YPM(2,J)
- +, NBU(J),CHUSKE(1,J)
- +, NBITEM(J),CHITEM(1,J)
- +, CHDEF,CHVAL,ICHOI,'EW')
- ICUMEN(J)=0
- ICUCHO(J)=0
- ENDIF
- 20 CONTINUE
- ICHOI=ICUCHO(IPLACE)
- CALL IGMENU(0,TITLE(I)
- + , XPM(1,I),XPM(2,I)
- +, YPM(1,I),YPM(2,I)
- +, NBU(I),CHUSKE(1,I)
- +, NBITEM(I),CHITEM(1,I)
- +, CHDEF,CHVAL,ICHOI,'TCNH')
- IPLAC=IPLACE
- GOTO 40
- ENDIF
- 30 CONTINUE
- IF(ICHOI.EQ.0)THEN
- IPLAC=0
- ENDIF
- GOTO 50
- ENDIF
-*
-* Picked into the title bar
-*
- IF(ICHOI.EQ.-100)THEN
- ICHOI=-1000
- ENDIF
-*
- 40 IF(ICHOI.GT.0)ICUCHO(IPLACE)=ICHOI
- 50 ICHOIC=ICHOI
-*
- IF(ICHOI.LT.0.AND.ICHOI.GT.-100)THEN
- CALL IGMENU(0,TITLE(IPLACE)
- +, XPM(1,IPLACE),XPM(2,IPLACE)
- +, YPM(1,IPLACE),YPM(2,IPLACE)
- +, NBU(IPLACE),CHUSKE(1,IPLACE)
- +, NBITEM(IPLACE),CHITEM(1,IPLACE)
- +, CHDEF,CHVAL,ABS(ICHOI),'UT')
- ENDIF
-*
- ZFLAG=ZFS
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- GFLAG=GFS
-*
- END
diff --git a/src/graflib/higz/ged/izged.F b/src/graflib/higz/ged/izged.F
deleted file mode 100644
index ea13c22..0000000
--- a/src/graflib/higz/ged/izged.F
+++ /dev/null
@@ -1,758 +0,0 @@
-*
-* $Id: izged.F,v 1.1.1.1 1996/02/14 13:10:24 mclareni Exp $
-*
-* $Log: izged.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:24 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.12/08 28/03/91 12.13.41 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE IZGED(PNAMEI,CHOPT)
-*.===========>
-*.
-*. This routine invokes the graphics editor .
-*.
-*. CHOPT='S': Software character for the menus.
-*. CHOPT='A': shAdow mode is used.
-*.
-*..==========> (O.Couet)
-#include "higz/hipaw.inc"
-#include "higz/hiatt.inc"
-#include "higz/hiflag.inc"
-#include "higz/higed.inc"
-#include "higz/hiatnb.inc"
-#include "higz/hisved.inc"
-#include "higz/hicode.inc"
- CHARACTER*(*) PNAMEI,CHOPT
- CHARACTER*32 CHVAL(15)
- CHARACTER*20 MERPIC,PRIPIC,SHOPIC,REAPIC,PNAME
- CHARACTER*12 CINTR
- DIMENSION IOPT(2)
- EQUIVALENCE (IOPT(1),IOPTS),(IOPT(2),IOPTA)
- LOGICAL ZFS
- DIMENSION RATVAL(NBRATT)
- EQUIVALENCE (RATVAL(1),RMKSC)
- DIMENSION IATVAL(NBIATT)
- EQUIVALENCE (IATVAL(1),IPLCI)
-#include "higz/hiatnm.inc"
-*.______________________________________
-*
- CALL UOPTC(CHOPT,'SA',IOPT)
- PNAME=PNAMEI
-*
-* Adressing pictures by number
-*
- INUM=IGASCI(PNAME(1:1))
- IF(49.LE.INUM.AND.INUM.LE.57)THEN
- READ (PNAME,'(I15)',ERR=20 ) INUM
- IF(INUM.GT.NBPICT)THEN
- CALL IGERR('Number of pictures is not so big','IZGED')
- RETURN
- ENDIF
- LP=LQ(LHIGZ)
- DO 10 I=1,INUM-1
- LP=LQ(LP)
- 10 CONTINUE
- LCH=LQ(LP-4)
- CALL UHTOC(IQ(LCH+1),4,PNAME,IQ(LP+1))
- GOTO 30
- 20 CALL IGERR('PNAME must begin with a letter','IZGED')
- RETURN
- ENDIF
- 30 CONTINUE
-*
- DO 40 I=1,NBIATT
- ISAVED(I)=IATVAL(I)
- 40 CONTINUE
- DO 50 I=1,NBRATT
- RSAVED(I)=RATVAL(I)
- 50 CONTINUE
-*
-* Encoding ISOF
-*
- ISOF=0
- IF(IOPTS.NE.0)CALL SBIT1(ISOF,1)
- IF(IOPTA.NE.0)CALL SBIT1(ISOF,2)
-*
- WX1S=RDWXMI
- WX2S=RDWXMA
- WY1S=RDWYMI
- WY2S=RDWYMA
- VX1S=RDVXMI
- VX2S=RDVXMA
- VY1S=RDVYMI
- VY2S=RDVYMA
- IF(RMDSX.GE.RMDSY)THEN
- CALL ISWKWN(IDID,0.,1.,0.,RMDSY/RMDSX)
- ELSE
- CALL ISWKWN(IDID,0.,RMDSX/RMDSY,0.,1.)
- ENDIF
- CALL ISWKVP(IDID,0.,RMDSX,0.,RMDSY)
-*
- ZFLAG=.FALSE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- GFLAG=.TRUE.
- REDITS=REDIT
- CALL IGSRAP(0.)
- CALL ICLRWK(1,1)
- ZFLAG=.TRUE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- CALL IGSRAP(4./5.)
- CALL IGCLES
-*
-* Check the validity of the picture name
-*
- IF(IZRPIP(PNAME).GT.0)THEN
- CALL IZPICT(PNAME,'DC')
- EDIPIC=PNAME
- ELSE
- IF(PNAME.NE.' ')THEN
- CALL IZPICT(PNAME,'M')
- EDIPIC=PNAME
- ELSE
- CALL IZPICT(EDIPIC,'R')
- IF(EDIPIC.NE.' ')THEN
- CALL IZPICT(EDIPIC,'DC')
- ELSE
- EDIPIC='PICTGED'
- CALL IZPICT(EDIPIC,'M')
- CALL IZPICT(EDIPIC,'C')
- ENDIF
- ENDIF
- ENDIF
-*
-* Initialization
-*
- CALL IGINME
- ZFLAG=.TRUE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
-*
-* Put the UNDO vode in all the NT banks
-* to protect the initial contains of the
-* picture
-*
- LNT=LQ(LPICT-1)
- DO 60 I=1,IQ(LPICT+8)
- IF(LNT.EQ.0)GOTO 70
- IQ(LNT+IQ(LNT+4))=1000000*IUNDCO
- IQ(LNT+4)=IQ(LNT+4)+1
- IF(LNT.EQ.LHNT)ITBPTR=ITBPTR+1
- LNT=LQ(LNT)
- 60 CONTINUE
-*
-* Select the NT with the higher priority
-*
- 70 IHNTR=IQ(IZGNGT(LPICT,IZGHNP(LPICT)-1)+1)
- CALL ISELNT(IHNTR)
-*.______________________________________
-*
-* Start with the GED menu mode
-*
- 80 TITLE(1)='MAIN MENU'
- CHITEM(1,1)='|Primitives'
- CHITEM(2,1)='|Windows'
- CHITEM(3,1)='|Pictures'
- CHITEM(4,1)='|Files'
- CHUSKE(1,1)='Exit'
- IPLACE=1
- CALL IGREQ(11,1,4,IPLACE,ICHOIC,CHVAL)
-*
- 90 CONTINUE
-*
- IF(ICHOIC.EQ.-1)GOTO 270
-*
- IF(ICHOIC.EQ.-1000)GOTO 80
-*
- IF(ICHOIC.EQ.1)GOTO 100
-*
- IF(ICHOIC.EQ.2)GOTO 140
-*
- IF(ICHOIC.EQ.3)GOTO 220
-*
- IF(ICHOIC.EQ.4)GOTO 260
-*
- GOTO 80
-*.______________________________________
-*
-* Primitives Menu
-*
- 100 TITLE(2)='PRIMITIVES'
- CHITEM(1,2)='Software text'
- CHITEM(2,2)='Text'
- CHITEM(3,2)='Fill area'
- CHITEM(4,2)='Polyline'
- CHITEM(5,2)='Polymarker'
- CHITEM(6,2)='Axis'
- CHITEM(7,2)='Arc'
- CHITEM(8,2)='Box'
- CHITEM(9,2)='Paving-block'
- CHITEM(10,2)='Frame box'
- CHITEM(11,2)='Arrow'
- CHITEM(12,2)='|Change Att.'
- CHITEM(13,2)='|Delete'
- CHITEM(14,2)='|Move'
- CHITEM(15,2)='|Front'
- CHITEM(16,2)='Grid'
- CHUSKE(1,2)='Att.'
- CHUSKE(2,2)='Redr.'
- CHUSKE(3,2)='Undo'
- IPLACE=2
- CALL IGREQ(21,3,16,IPLACE,ICHOIC,CHVAL)
-*
- 110 CONTINUE
-*
- IF(IPLACE.EQ.1)GOTO 90
-*
- IF(ICHOIC.EQ.-1)GOTO 100
-*
- IF(ICHOIC.EQ.-1000)GOTO 100
-*
- IF(ICHOIC.EQ.-2)THEN
- CALL IGCLES
- CALL IZPICT(EDIPIC,'D')
- CALL IEGRID
- GOTO 100
- ENDIF
-*
- IF(ICHOIC.EQ.-3)THEN
- CALL IZUNDO
- GOTO 100
- ENDIF
-*
- IF(ICHOIC.EQ.1)THEN
- CALL IESTX(ICF,ICHOIC)
- IF(ICHOIC.NE.0)THEN
- IF(ICF.EQ.1)GOTO 90
- IF(ICF.EQ.2)GOTO 110
- ENDIF
- ENDIF
-*
- IF(ICHOIC.EQ.2)THEN
- CALL IETX(ICF,ICHOIC)
- IF(ICHOIC.NE.0)THEN
- IF(ICF.EQ.1)GOTO 90
- IF(ICF.EQ.2)GOTO 110
- ENDIF
- ENDIF
-*
- IF(ICHOIC.EQ.3)THEN
- CALL IEFA(ICF,ICHOIC)
- IF(ICHOIC.NE.0)THEN
- IF(ICF.EQ.1)GOTO 90
- IF(ICF.EQ.2)GOTO 110
- ENDIF
- ENDIF
-*
- IF(ICHOIC.EQ.4)THEN
- CALL IEPL(ICF,ICHOIC)
- IF(ICHOIC.NE.0)THEN
- IF(ICF.EQ.1)GOTO 90
- IF(ICF.EQ.2)GOTO 110
- ENDIF
- ENDIF
-*
- IF(ICHOIC.EQ.5)THEN
- CALL IEPM(ICF,ICHOIC)
- IF(ICHOIC.NE.0)THEN
- IF(ICF.EQ.1)GOTO 90
- IF(ICF.EQ.2)GOTO 110
- ENDIF
- ENDIF
-*
- IF(ICHOIC.EQ.6)THEN
- CALL IEAXIS(ICF,ICHOIC)
- IF(ICHOIC.NE.0)THEN
- IF(ICF.EQ.1)GOTO 90
- IF(ICF.EQ.2)GOTO 110
- ENDIF
- ENDIF
-*
- IF(ICHOIC.EQ.7)THEN
- CALL IEARC(ICF,ICHOIC)
- IF(ICHOIC.NE.0)THEN
- IF(ICF.EQ.1)GOTO 90
- IF(ICF.EQ.2)GOTO 110
- ENDIF
- ENDIF
-*
- IF(ICHOIC.EQ.8)THEN
- CALL IEBOX(ICF,ICHOIC)
- IF(ICHOIC.NE.0)THEN
- IF(ICF.EQ.1)GOTO 90
- IF(ICF.EQ.2)GOTO 110
- ENDIF
- ENDIF
-*
- IF(ICHOIC.EQ.9)THEN
- CALL IEPAVE(ICF,ICHOIC)
- IF(ICHOIC.NE.0)THEN
- IF(ICF.EQ.1)GOTO 90
- IF(ICF.EQ.2)GOTO 110
- ENDIF
- ENDIF
-*
- IF(ICHOIC.EQ.10)THEN
- CALL IEFBOX(ICF,ICHOIC)
- IF(ICHOIC.NE.0)THEN
- IF(ICF.EQ.1)GOTO 90
- IF(ICF.EQ.2)GOTO 110
- ENDIF
- ENDIF
-*
- IF(ICHOIC.EQ.11)THEN
- CALL IEARRO(ICF,ICHOIC)
- IF(ICHOIC.NE.0)THEN
- IF(ICF.EQ.1)GOTO 90
- IF(ICF.EQ.2)GOTO 110
- ENDIF
- ENDIF
-*
- IF(ICHOIC.EQ.12)THEN
- CALL IECPA(ICF,ICHOIC)
- IF(ICHOIC.NE.0)THEN
- IF(ICF.EQ.1)GOTO 90
- IF(ICF.EQ.2)GOTO 110
- ENDIF
- ENDIF
-*
- IF(ICHOIC.EQ.13)THEN
- CALL IEDELE(ICF,ICHOIC)
- IF(ICHOIC.NE.0)THEN
- IF(ICF.EQ.1)GOTO 90
- IF(ICF.EQ.2)GOTO 110
- ENDIF
- ENDIF
-*
- IF(ICHOIC.EQ.14)THEN
- CALL IEMOPR(ICF,ICHOIC)
- IF(ICHOIC.NE.0)THEN
- IF(ICF.EQ.1)GOTO 90
- IF(ICF.EQ.2)GOTO 110
- ENDIF
- ENDIF
-*
- IF(ICHOIC.EQ.15)THEN
- CALL IEPOP(ICF,ICHOIC)
- IF(ICHOIC.NE.0)THEN
- IF(ICF.EQ.1)GOTO 90
- IF(ICF.EQ.2)GOTO 110
- ENDIF
- ENDIF
-*
- IF(ICHOIC.EQ.16)THEN
- TITLE(3)='GRID ATTRIBUTES'
- CHITEM(1,3)='X Step'
- CHITEM(2,3)='Y Step'
- CHITEM(3,3)='X Factor'
- CHITEM(4,3)='Y Factor'
- CHITEM(5,3)='Grid'
- IPLACE=3
- IF(IXSTEP.EQ.0.AND.IYSTEP.EQ.0)THEN
- IXSTEP=RWXMAX
- IYSTEP=RWYMAX
- ENDIF
- CALL IZITOC(IXSTEP,CHDEF(1))
- CALL IZITOC(IYSTEP,CHDEF(2))
- CALL IZITOC(IXFACT,CHDEF(3))
- CALL IZITOC(IYFACT,CHDEF(4))
- CHDEF(5)='Yes,No'
- CALL IGREQ(217,0,5,IPLACE,ICHOIC,CHVAL)
- IF(IPLACE.EQ.1)GOTO 90
- IF(IPLACE.EQ.2)GOTO 110
- CALL IZCTOI(CHVAL(1),IXSTEP)
- CALL IZCTOI(CHVAL(2),IYSTEP)
- CALL IZCTOI(CHVAL(3),IXFACT)
- CALL IZCTOI(CHVAL(4),IYFACT)
- IF(CHVAL(5).EQ.'No')THEN
- IXFACT=0
- GOTO 100
- ENDIF
- IF(IXSTEP.EQ.0.AND.IYSTEP.NE.0)IXSTEP=IYSTEP
- IF(IXSTEP.NE.0.AND.IYSTEP.EQ.0)IYSTEP=IXSTEP
- IF(IXSTEP.EQ.0.AND.IYSTEP.EQ.0)GOTO 100
- IF(IXFACT.EQ.0.AND.IYFACT.NE.0)IXFACT=IYFACT
- IF(IXFACT.NE.0.AND.IYFACT.EQ.0)IYFACT=IXFACT
- IF(IXFACT.EQ.0.AND.IYFACT.EQ.0)GOTO 100
- CALL IEGRID
- ENDIF
-*
- GOTO 100
-*.______________________________________
-*
-* Windows Menu
-*
- 140 TITLE(2)='WINDOWS'
- CHITEM(1,2)='|Create'
- CHITEM(2,2)=' '
- CHITEM(3,2)='Select'
- CHITEM(4,2)='Move'
- CHITEM(5,2)='Show'
- CHITEM(6,2)='Push behind'
- CHITEM(7,2)=' '
- CHITEM(8,2)=' '
- CALL IZITOC(INTR,CINTR)
- CHUSKE(1,2)=CINTR
- CHUSKE(2,2)='Redraw'
- IPLACE=2
- CALL IGREQ(31,2,8,IPLACE,ICHOIC,CHVAL)
-*
- 150 CONTINUE
-*
- IF(IPLACE.EQ.1)GOTO 90
-*
- IF(ICHOIC.EQ.-1000)GOTO 140
-*
- IF(ICHOIC.EQ.-1)GOTO 140
-*
- IF(ICHOIC.EQ.-2)THEN
- CALL IGCLES
- CALL IZPICT(EDIPIC,'D')
- CALL IEGRID
- GOTO 140
- ENDIF
-*
- IF(ICHOIC.EQ.1)THEN
- CALL IEWIN(ICF,ICHOIC)
- IF(ICHOIC.NE.0)THEN
- IF(ICF.EQ.1)GOTO 90
- IF(ICF.EQ.2)GOTO 150
- ENDIF
- ENDIF
-*
- IF(ICHOIC.EQ.2)THEN
- ENDIF
-*
- IF(ICHOIC.EQ.3)THEN
- IPLACE=2
- 160 CALL IGREQ(31,2,8,IPLACE,ICHOIC,CHVAL)
- IF(IPLACE.EQ.1)GOTO 90
- IF(ICHOIC.NE.0)GOTO 150
- ZFLAG=.TRUE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- CALL ISELNT(IQUEST(10))
- CALL IZITOC(IQUEST(10),CINTR)
- CHUSKE(1,2)=CINTR
- IPLACE=2
- CALL IGMENU(0,TITLE(IPLACE)
- +, XPM(1,IPLACE),XPM(2,IPLACE)
- +, YPM(1,IPLACE),YPM(2,IPLACE)
- +, NBU(IPLACE),CHUSKE(1,IPLACE)
- +, NBITEM(IPLACE),CHITEM(1,IPLACE)
- +, CHDEF,CHVAL,1,'UWT')
- GOTO 160
- ENDIF
-*
- IF(ICHOIC.EQ.4)THEN
- 170 IF(INTR.EQ.0)GOTO 140
- INTSAV=INTR
- CALL ISELNT(0)
- IPLACE=2
- CALL IGREQ(31,2,8,IPLACE,ICHOIC,CHVAL)
- IF(IPLACE.EQ.1)THEN
- ZFLAG=.TRUE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- CALL ISELNT(INTSAV)
- GOTO 90
- ENDIF
- IF(ICHOIC.NE.0)THEN
- ZFLAG=.TRUE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- CALL ISELNT(INTSAV)
- GOTO 150
- ENDIF
- X(1)=RQUEST(13)
- Y(1)=RQUEST(14)
- IPLACE=2
- CALL IGREQ(31,2,8,IPLACE,ICHOIC,CHVAL)
- IF(IPLACE.EQ.1)THEN
- ZFLAG=.TRUE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- CALL ISELNT(INTSAV)
- GOTO 90
- ENDIF
- IF(ICHOIC.NE.0)THEN
- ZFLAG=.TRUE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- CALL ISELNT(INTSAV)
- GOTO 150
- ENDIF
- X(2)=RQUEST(13)
- Y(2)=RQUEST(14)
- ZFS=ZFLAG
- CALL IGCLWN(INTSAV)
- CALL IGEX(X(1),X(2))
- CALL IGEX(Y(1),Y(2))
- ZFLAG=.TRUE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- CALL ISVP(INTSAV,X(1),X(2),Y(1),Y(2))
- CALL ISELNT(INTSAV)
- ZFLAG=.FALSE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- LN=IZGNTP(INTSAV)
- CALL IZDNB(LN,LDI,LDF,LDC,0,0)
- ZFLAG=ZFS
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- GOTO 170
- ENDIF
-*
- IF(ICHOIC.EQ.5)THEN
- NGT=0
- LN=IZGNGT(LPICD,NGT)
- DO 190 I=1,IQ(LPICD+8)
- IF(LN.EQ.0)GOTO 140
- IWVA=IQ(LN+2)
- INTN=IQ(LN+1)
- ILNTY=1
- IF(INTN.EQ.INTR)ILNTY=2
- IF(INTN.EQ.0)GOTO 180
- CALL IGBORD(INTN
- +, Q(LDF+IWVA)
- +, Q(LDF+IWVA+1)
- +, Q(LDF+IWVA+2)
- +, Q(LDF+IWVA+3)
- +, ILNTY)
- 180 NGT=IQ(LN+3)
- LN=IZGNGT(LPICD,NGT)
- 190 CONTINUE
- ENDIF
-*
- IF(ICHOIC.EQ.6)THEN
- NGT=0
- LN=IZGNGT(LPICD,NGT)
- DO 200 I=1,IQ(LPICD+8)-1
- IF(LN.EQ.0)GOTO 210
- NGT=IQ(LN+3)
- CALL ISELNT(IQ(LN+1))
- LN=IZGNGT(LPICT,NGT)
- 200 CONTINUE
- 210 IHNTR=IQ(IZGNGT(LPICT,IZGHNP(LPICT)-1)+1)
- CALL IZITOC(IHNTR,CINTR)
- CHUSKE(1,2)=CINTR
- IPLACE=2
- CALL IGMENU(0,TITLE(IPLACE)
- +, XPM(1,IPLACE),XPM(2,IPLACE)
- +, YPM(1,IPLACE),YPM(2,IPLACE)
- +, NBU(IPLACE),CHUSKE(1,IPLACE)
- +, NBITEM(IPLACE),CHITEM(1,IPLACE)
- +, CHDEF,CHVAL,1,'UTW')
- CALL ISELNT(IHNTR)
- ENDIF
-*
- IF(ICHOIC.EQ.7)THEN
- IPLACE=2
- CALL IGREQ(31,2,8,IPLACE,ICHOIC,CHVAL)
- IF(IPLACE.EQ.1)GOTO 90
- IF(ICHOIC.GE.1)GOTO 150
- LPCOP=LPICD
- LNTCOP=IZGNTP(IQUEST(10))
- ENDIF
-*
- GOTO 140
-*.______________________________________
-*
-* Pictures Menu
-*
- 220 TITLE(2)='PICTURES'
- CHITEM(1,2)='List'
- CHITEM(2,2)='Protect'
- CHITEM(3,2)='Merge'
- CHITEM(4,2)='Create'
- CHITEM(5,2)='Select'
- CHITEM(6,2)='Next'
- CHITEM(7,2)='Print struct.'
- CHITEM(8,2)='Show'
- CHUSKE(1,2)=EDIPIC
- IPLACE=2
- CALL IGREQ(41,1,8,IPLACE,ICHOIC,CHVAL)
-*
- 230 CONTINUE
-*
- IF(IPLACE.EQ.1)GOTO 90
-*
- IF(ICHOIC.EQ.-1.OR.ICHOIC.EQ.-1000)GOTO 220
-*
- IF(ICHOIC.EQ.1)THEN
- CALL IZPICT(' ','L')
- GOTO 220
- ENDIF
-*
- IF(ICHOIC.EQ.2)THEN
- LNT=LQ(LPICT-1)
- DO 240 I=1,IQ(LPICT+8)
- IF(LNT.EQ.0)GOTO 220
- IQ(LNT+IQ(LNT+4))=1000000*IUNDCO
- IQ(LNT+4)=IQ(LNT+4)+1
- IF(LNT.EQ.LHNT)ITBPTR=ITBPTR+1
- LNT=LQ(LNT)
- 240 CONTINUE
- ENDIF
-*
- IF(ICHOIC.EQ.3)THEN
- TITLE(3)=' '
- CHITEM(1,3)='Picture Name ?'
- IPLACE=3
- CHDEF(1)=' '
- CALL IGREQ(42,0,1,IPLACE,ICHOIC,MERPIC)
- IF(IPLACE.EQ.1)GOTO 90
- IF(IPLACE.EQ.2)GOTO 230
- IF(IZRPIP(MERPIC).LE.0)GOTO 220
- CALL CLTOU(MERPIC)
- INTSAV=INTR
- CALL ISELNT(0)
- IPLACE=2
- CALL IGREQ(41,1,8,IPLACE,ICHOIC,CHVAL)
- IF(IPLACE.EQ.1)THEN
- CALL ISELNT(INTSAV)
- GOTO 90
- ENDIF
- IF(ICHOIC.NE.0)THEN
- CALL ISELNT(INTSAV)
- GOTO 230
- ENDIF
- X(1)=RQUEST(13)
- Y(1)=RQUEST(14)
- IPLACE=2
- CALL IGREQ(41,1,8,IPLACE,ICHOIC,CHVAL)
- IF(IPLACE.EQ.1)THEN
- CALL ISELNT(INTSAV)
- GOTO 90
- ENDIF
- IF(ICHOIC.NE.0)THEN
- CALL ISELNT(INTSAV)
- GOTO 230
- ENDIF
- X(2)=RQUEST(13)
- Y(2)=RQUEST(14)
- CALL IGEX(X(1),X(2))
- CALL IGEX(Y(1),Y(2))
- CALL IZMERG(MERPIC,X(1),Y(1),X(2)-X(1),' ')
- ENDIF
-*
- IF(ICHOIC.EQ.4)THEN
- TITLE(3)=' '
- CHITEM(1,3)='Picture Name ?'
- IPLACE=3
- CHDEF(1)=' '
- CALL IGREQ(42,0,1,IPLACE,ICHOIC,EDIPIC)
- CALL CLTOU(EDIPIC)
- CALL IZPICT(EDIPIC,'M')
- CALL IGCLES
- CALL ISELNT(0)
- GOTO 250
- ENDIF
-*
- IF(ICHOIC.EQ.5)THEN
- TITLE(3)=' '
- CHITEM(1,3)='Picture Name ?'
- IPLACE=3
- CHDEF(1)=' '
- CALL IGREQ(42,0,1,IPLACE,ICHOIC,PRIPIC)
- CALL CLTOU(PRIPIC)
- IF(IPLACE.EQ.1)GOTO 90
- IF(IPLACE.EQ.2)GOTO 230
- IF(IZRPIP(PRIPIC).LE.0)GOTO 220
- EDIPIC=PRIPIC
- CALL IZPICT(EDIPIC,'C')
- CALL IGCLES
- CALL IZPICT(EDIPIC,'D')
- GOTO 250
- ENDIF
-*
- IF(ICHOIC.EQ.6)THEN
- CALL IGCLES
- CALL IZPICT(' ','N')
- CALL IZPICT(' ','D')
- CALL IZPICT(EDIPIC,'R')
- GOTO 250
- ENDIF
-*
- IF(ICHOIC.EQ.7)THEN
- TITLE(3)=' '
- CHITEM(1,3)='Picture Name ?'
- IPLACE=3
- CHDEF(1)=EDIPIC
- CALL IGREQ(42,0,1,IPLACE,ICHOIC,PRIPIC)
- CALL CLTOU(PRIPIC)
- CALL IZPICT(PRIPIC,'P')
- GOTO 220
- ENDIF
-*
- IF(ICHOIC.EQ.8)THEN
- TITLE(3)=' '
- CHITEM(1,3)='Picture Name ?'
- IPLACE=3
- CHDEF(1)=' '
- CALL IGREQ(42,0,1,IPLACE,ICHOIC,SHOPIC)
- IF(IPLACE.EQ.1)GOTO 90
- IF(IPLACE.EQ.2)GOTO 230
- IF(IZRPIP(SHOPIC).LE.0)GOTO 220
- CALL CLTOU(SHOPIC)
- CALL IGSRAP(.3)
- CALL IGCLES
- CALL IZPICT(SHOPIC,'D')
- CALL IZPICT(EDIPIC,'C')
- CALL IGSRAP(.8)
- GOTO 220
- ENDIF
-*
- GOTO 220
- 250 CONTINUE
- CHUSKE(1,2)=EDIPIC(1:LENOCC(EDIPIC))
- IPLACE=2
- CALL IGMENU(0,TITLE(IPLACE),XPM(1,IPLACE),XPM(2,IPLACE),
- +YPM(1,IPLACE),YPM(2,IPLACE),NBU(IPLACE),CHUSKE(1,IPLACE)
- +,NBITEM(IPLACE),CHITEM(1,IPLACE),CHDEF,CHVAL,1,'UTW')
- GOTO 220
-*.______________________________________
-*
-* Files Menu
-*
- 260 TITLE(2)='FILES'
- CHITEM(1,2)='Save Picture'
- CHITEM(2,2)='Read Picture'
- IPLACE=2
- CALL IGREQ(51,0,2,IPLACE,ICHOIC,CHVAL)
-*
- IF(IPLACE.EQ.1)GOTO 90
-*
- IF(ICHOIC.EQ.-1.OR.ICHOIC.EQ.-1000)GOTO 260
-*
- IF(ICHOIC.EQ.1)THEN
- CALL IZPIWI(EDIPIC)
- CALL IZOUT(EDIPIC,ICYCLE)
- GOTO 260
- ENDIF
-*
- IF(ICHOIC.EQ.2)THEN
- TITLE(3)=' '
- CHITEM(1,3)='Picture Name ?'
- IPLACE=3
- CHDEF(1)=' '
- CALL IGREQ(42,0,1,IPLACE,ICHOIC,REAPIC)
- CALL CLTOU(PRIPIC)
- CALL IZIN(REAPIC,9999)
- GOTO 260
- ENDIF
-*
- GOTO 260
-*.______________________________________
-*
-* End with the Graphics Editor
-*
- 270 CALL ISWKWN(IDID,WX1S,WX2S,WY1S,WY2S)
- CALL ISWKVP(IDID,VX1S,VX2S,VY1S,VY2S)
- CALL IGSRAP(0.)
- CALL ICLRWK(0,0)
- CALL IGSRAP(REDITS)
- DO 280 I=1,NBIATT
- CALL IGSET(CHIATT(I),FLOAT(ISAVED(I)))
- 280 CONTINUE
- DO 290 I=1,NBRATT
- CALL IGSET(CHRATT(I),RSAVED(I))
- 290 CONTINUE
- CALL IGSRAP(0.)
- CALL IZPIWI(EDIPIC)
-*
- END
diff --git a/src/graflib/higz/ged/izpick.F b/src/graflib/higz/ged/izpick.F
deleted file mode 100644
index ad2914d..0000000
--- a/src/graflib/higz/ged/izpick.F
+++ /dev/null
@@ -1,394 +0,0 @@
-*
-* $Id: izpick.F,v 1.1.1.1 1996/02/14 13:10:24 mclareni Exp $
-*
-* $Log: izpick.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:24 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.06/05 27/02/89 15.05.46 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE IZPICK(NT,SNAME,NPRIM,CHOPT)
-*.===========>
-*.
-*. This subroutine returns the pathname of a structure .
-*.
-*. _Input parameters:
-*.
-*. INTEGER NT : Transformation number .
-*. CHARACTER CHOPT : Type of object to be picked .
-*.
-*. _Output parameters:
-*.
-*. CHARACTER SNAME : Structure name .
-*. INTEGER NPRIM : Adress of the primitive in the NT bank.
-*.
-*..==========> (O.Couet)
-#include "higz/hipaw.inc"
-#include "higz/hicode.inc"
-#include "higz/hiatt.inc"
-#include "higz/hiaca.inc"
-#include "higz/hiflag.inc"
- CHARACTER*(*) SNAME,CHOPT
- DIMENSION IOPT(1)
- DIMENSION X(10),Y(10)
- EQUIVALENCE (IOPTN,IOPT(1))
-*.______________________________________
-*
- CALL UOPTC (CHOPT,'N',IOPT)
- NPRIM=0
- SNAME=' '
- IF(LPICD.LE.0)GOTO 100
- LPSAV=LPICD
- CALL IZSCPI(LPICD)
-*
- IF(IOPTN.NE.0)THEN
- PX=RQUEST(13)
- PY=RQUEST(14)
- NT=IQUEST(10)
- IBN=1
- ELSE
- CALL IGLOC(1,NT,IBN,XNDC,YNDC,PX,PY)
- ENDIF
- IF(IBN.EQ.0)GOTO 100
-*
- LN=IZGNTP(NT)
- IF(LN.EQ.0)GOTO 100
- ZFLAG=.TRUE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- CALL ISELNT(NT)
- IREPTR=9
- IIAA=IZGADR(LHNT,8)
- IRAA=IZGADR(LHNT,9)
-*
- TEXTHE=Q(LHF+IRAA+ICHHCO-50)
- IALG=IQ(LHI+IIAA+ITXACO-80)
- IALH=INT(IALG/10.)
- DX=0.
- DY=0.
-*
- 10 IREPTR=IREPTR+1
- IADRI5=IREPTR
- ICHOPT=-1
- KATT=0
- IF(IREPTR.EQ.IQ(LHNT+4))GOTO 100
- ICOD=IZGCOD(LHNT,IREPTR)
- IADRI=IZGADR(LHNT,IREPTR)
-*
- IF(ICOD.LT.0)THEN
- NBNOP=1
- IADRI2=ABS(IZGADR(LHNT,IREPTR))
- 20 IF(IQ(LHNT+IADRI2).LT.0)THEN
- NBNOP=NBNOP+1
- IADRI2=ABS(IZGADR(LHNT,IADRI2))
- GOTO 20
- ENDIF
- IADRI2=IZGADR(LHNT,IADRI2)
- DO 40 I=1,NBNOP
- IF(IQ(LHI+IADRI2).EQ.0)GOTO 10
- IF(IZGCOD(LHI,IADRI2).EQ.3)THEN
- IADRI4=IZGADR(LHI,IADRI2)
- DX=DX+Q(LHF+IADRI4)
- DY=DY+Q(LHF+IADRI4+1)
- ENDIF
- IF(IQ(LHI+IADRI2).EQ.1.AND.KATT.EQ.0)THEN
- IADRI5=ABS(IZGADR(LHNT,IQ(LHI+IADRI2+2)))
- CALL IZSCAN(LHNT,IANGCO,IADRI5,-1,IPOS)
- IF(IPOS.EQ.0)GOTO 30
- IRR=IZGADR(LHNT,IPOS)
- CALL IZSCAN(LHNT,ITXACO,IADRI5,-1,IPOS)
- IF(IPOS.EQ.0)GOTO 30
- IALAD=IZGADR(LHNT,IPOS)-100000
- IALH=INT(IALAD/100)
- CALL IZSCAN(LHNT,ICHHCO,IADRI5,-1,IPOS)
- IF(IPOS.EQ.0)GOTO 30
- IACHH=IZGADR(LHNT,IPOS)
- TEXTHE=Q(LHF+IACHH)
- 30 KATT=1
- ENDIF
- IF(IQ(LHI+IADRI2).EQ.2.AND.KATT.EQ.0)THEN
- IADRI5=ABS(IZGADR(LHNT,IQ(LHI+IADRI2+2)))
- ICHOPT=IQ(LHI+IADRI2+3)
- KATT=1
- ENDIF
- IADRI2=IQ(LHI+IADRI2+1)
- 40 CONTINUE
- IADRI=IADRI2
- ICOD=ABS(ICOD)
- ENDIF
-*
- IF(ICOD.EQ.ICHHCO)THEN
- TEXTHE=Q(LHF+IADRI)
- ENDIF
-*
- IF(ICOD.EQ.IANGCO)THEN
- ENDIF
-*
- IF(ICOD.EQ.ITXACO)THEN
- IALH=INT((IADRI-100000)/100)
- ENDIF
-*______________ Polyline
- IF(ICOD.EQ.IPLCO)THEN
- IADRF=IQ(LHI+IADRI)
- N=IQ(LHI+IADRI+1)
- IF(DX.NE.0..OR.DY.NE.0.)THEN
- DO 50 I=0,N-1
- Q(LHF+IADRF+I)=Q(LHF+IADRF+I)+DX
- Q(LHF+IADRF+I+N)=Q(LHF+IADRF+I+N)+DY
- 50 CONTINUE
- ENDIF
- IF(IZPKPL(PX,PY,N
- +, Q(LHF+IADRF),Q(LHF+IADRF+N)).NE.0)THEN
- NPRIM=IREPTR
- IADRAT=IADRI5
- ENDIF
- IF(DX.NE.0..OR.DY.NE.0.)THEN
- DO 60 I=0,N-1
- Q(LHF+IADRF+I)=Q(LHF+IADRF+I)-DX
- Q(LHF+IADRF+I+N)=Q(LHF+IADRF+I+N)-DY
- 60 CONTINUE
- ENDIF
- DX=0.
- DY=0.
- GOTO 10
- ENDIF
-*______________ Polyline with 2 points
- IF(ICOD.EQ.IPL2CO)THEN
- IADRF=IADRI
- X(1)=Q(LHF+IADRF)+DX
- X(2)=Q(LHF+IADRF+1)+DX
- Y(1)=Q(LHF+IADRF+2)+DY
- Y(2)=Q(LHF+IADRF+3)+DY
- IF(IZPKPL(PX,PY,2,X,Y).NE.0)THEN
- NPRIM=IREPTR
- IADRAT=IADRI5
- ENDIF
- DX=0.
- DY=0.
- GOTO 10
- ENDIF
-*______________ Polymarker
- IF(ICOD.EQ.IPMCO)THEN
- IADRF=IADRI
- S=1
- IF(REDIT.NE.0)THEN
- S=REDIT
- ENDIF
- DX=(S*0.01875*(RQUEST(21)-RQUEST(20)))/(RQUEST(31)-RQUEST(30))
- DY=(S*0.01875*(RQUEST(23)-RQUEST(22)))/(RQUEST(33)-RQUEST(32))
- DO 70 I=1,IQ(LHI+IADRI+1)
- XPMM=Q(LHF+IADRF+I-1)
- YPMM=Q(LHF+IADRF+I+N-1)
- IF(PX.GE.(XPMM-DX).AND.PX.LE.(XPMM+DX)
- + .AND.
- + PY.GE.(YPMM-DY).AND.PY.LE.(YPMM+DY))THEN
- NPRIM=IREPTR
- IADRAT=IADRI5
- DX=0.
- DY=0.
- GOTO 10
- ENDIF
- 70 CONTINUE
- DX=0.
- DY=0.
- GOTO 10
- ENDIF
-*______________ Axis
- IF(ICOD.EQ.IAXICO)THEN
- IADRF=IQ(LHI+IADRI)
- X(1)=Q(LHF+IADRF)+DX
- X(2)=Q(LHF+IADRF+1)+DX
- Y(1)=Q(LHF+IADRF+2)+DY
- Y(2)=Q(LHF+IADRF+3)+DY
- IF(IZPKPL(PX,PY,2,X,Y).NE.0)THEN
- NPRIM=IREPTR
- IADRAT=IADRI5
- IF(ICHOPT.NE.-1)THEN
- IACHOP=ICHOPT
- ELSE
- IACHOP=IQ(LHI+IADRI+2)
- ENDIF
- ENDIF
- DX=0.
- DY=0.
- GOTO 10
- ENDIF
-*______________ Fill area
- IF(ICOD.EQ.IFACO)THEN
- IADRF=IQ(LHI+IADRI)
- N=IQ(LHI+IADRI+1)
- IF(DX.NE.0..OR.DY.NE.0.)THEN
- DO 80 I=0,N-1
- Q(LHF+IADRF+I)=Q(LHF+IADRF+I)+DX
- Q(LHF+IADRF+I+N)=Q(LHF+IADRF+I+N)+DY
- 80 CONTINUE
- ENDIF
- IF(IZPKFA(PX,PY,N
- +, Q(LHF+IADRF),Q(LHF+IADRF+N)).NE.0)THEN
- NPRIM=IREPTR
- IADRAT=IADRI5
- ENDIF
- IF(DX.NE.0..OR.DY.NE.0.)THEN
- DO 90 I=0,N-1
- Q(LHF+IADRF+I)=Q(LHF+IADRF+I)-DX
- Q(LHF+IADRF+I+N)=Q(LHF+IADRF+I+N)-DY
- 90 CONTINUE
- ENDIF
- DX=0.
- DY=0.
- GOTO 10
- ENDIF
-*______________ Boxes
- IF(ICOD.EQ.IBXCO)THEN
- IADRF=IADRI
- X(1)=Q(LHF+IADRF)+DX
- X(2)=Q(LHF+IADRF)+DX
- X(3)=Q(LHF+IADRF+1)+DX
- X(4)=Q(LHF+IADRF+1)+DX
- Y(1)=Q(LHF+IADRF+2)+DY
- Y(2)=Q(LHF+IADRF+3)+DY
- Y(3)=Q(LHF+IADRF+3)+DY
- Y(4)=Q(LHF+IADRF+2)+DY
- IF(IZPKFA(PX,PY,4,X,Y).NE.0)THEN
- NPRIM=IREPTR
- IADRAT=IADRI5
- ENDIF
- DX=0.
- DY=0.
- GOTO 10
- ENDIF
-*______________ Text
- IF(ICOD.EQ.ITXCO)THEN
- IADRF=IQ(LHI+IADRI)
- NCHP=IQ(LHI+IADRI+2)
- X(1)=Q(LHF+IADRF)+DX
- Y(1)=Q(LHF+IADRF+1)+DY
- IF(IALH.EQ.2)THEN
- X(1)=Q(LHF+IADRF)-((NCHP/2)*TEXTHE)+DX
- ENDIF
- IF(IALH.EQ.3)THEN
- X(1)=Q(LHF+IADRF)-(NCHP*TEXTHE)+DX
- ENDIF
- X(2)=X(1)
- Y(2)=Y(1)+TEXTHE
- X(3)=X(1)+NCHP*TEXTHE
- Y(3)=Y(2)
- X(4)=X(3)
- Y(4)=Y(1)
- IF(IZPKFA(PX,PY,4,X,Y).NE.0)THEN
- NPRIM=IREPTR
- IADRAT=IADRI5
- ENDIF
- DX=0.
- DY=0.
- GOTO 10
- ENDIF
-*______________ IGTEXT
- IF(ICOD.EQ.IGTXCO)THEN
- IF(ICHOPT.LT.0)THEN
- ICHOPT=IQ(LHI+IADRI+3)
- ENDIF
- IADRF=IQ(LHI+IADRI)
- NCHP=IQ(LHI+IADRI+2)
- SSIZE=Q(LHF+IADRF+2)
- X(1)=Q(LHF+IADRF)+DX
- Y(1)=Q(LHF+IADRF+1)+DY
- IF(JBIT(ICHOPT,2).NE.0)THEN
- X(1)=Q(LHF+IADRF)-((NCHP/2)*SSIZE)+DX
- ENDIF
- IF(JBIT(ICHOPT,3).NE.0)THEN
- X(1)=Q(LHF+IADRF)-(NCHP*SSIZE)+DX
- ENDIF
- X(2)=X(1)
- Y(2)=Y(1)+SSIZE
- X(3)=X(1)+NCHP*SSIZE
- Y(3)=Y(2)
- X(4)=X(3)
- Y(4)=Y(1)
- IF(IZPKFA(PX,PY,4,X,Y).NE.0)THEN
- NPRIM=IREPTR
- IADRAT=IADRI5
- IACHOP=ICHOPT
- ENDIF
- DX=0.
- DY=0.
- GOTO 10
- ENDIF
-*______________ Frame boxes
- IF(ICOD.EQ.IFBXCO)THEN
- IADRF=IADRI
- X(1)=Q(LHF+IADRF)+DX
- X(2)=Q(LHF+IADRF)+DX
- X(3)=Q(LHF+IADRF+1)+DX
- X(4)=Q(LHF+IADRF+1)+DX
- X(5)=Q(LHF+IADRF)+DX
- X(6)=Q(LHF+IADRF+4)+DX
- X(7)=Q(LHF+IADRF+5)+DX
- X(8)=Q(LHF+IADRF+5)+DX
- X(9)=Q(LHF+IADRF+4)+DX
- X(10)=Q(LHF+IADRF+4)+DX
- Y(1)=Q(LHF+IADRF+2)+DY
- Y(2)=Q(LHF+IADRF+3)+DY
- Y(3)=Q(LHF+IADRF+3)+DY
- Y(4)=Q(LHF+IADRF+2)+DY
- Y(5)=Q(LHF+IADRF+2)+DY
- Y(6)=Q(LHF+IADRF+6)+DY
- Y(7)=Q(LHF+IADRF+6)+DY
- Y(8)=Q(LHF+IADRF+7)+DY
- Y(9)=Q(LHF+IADRF+7)+DY
- Y(10)=Q(LHF+IADRF+6)+DY
- IF(IZPKFA(PX,PY,10,X,Y).NE.0)THEN
- NPRIM=IREPTR
- IADRAT=IADRI5
- ENDIF
- DX=0.
- DY=0.
- GOTO 10
- ENDIF
-*______________ Histograms
- IF(ICOD.EQ.IHISCO)THEN
- IADRF=IQ(LHI+IADRI)
- NN=2
- IF(JBIT(IQ(LHI+IADRI+2),8).NE.0)THEN
- NN=IQ(LHI+IADRI+1)+1
- ENDIF
- IF(JBIT(IQ(LHI+IADRI+2),5).NE.0)THEN
-C CALL IGHIST(IQ(LIDECO+IADRI+1)
-C +, Q(LFDECO+IADRF+NN)
-C +, Q(LFDECO+IADRF)
-C +, CHOPT)
- DX=0.
- DY=0.
- GOTO 10
- ELSE
-C CALL IGHIST(IQ(LIDECO+IADRI+1)
-C +, Q(LFDECO+IADRF)
-C +, Q(LFDECO+IADRF+NN)
-C +, CHOPT)
- IF(PX.GE.Q(LHF+IADRF).AND.PX.LE.Q(LHF+IADRF+NN-1))THEN
- XINT=(Q(LHF+IADRF+NN-1)-Q(LHF+IADRF)) /IQ(LHI+IADRI+
- + 1)
- INDEX=(PX-Q(LHF+IADRF))/XINT
- IF(Q(LHF+IADRF+NN+INDEX).GE.PY)THEN
- NPRIM=IREPTR
- IADRAT=IADRI5
- IF(ICHOPT.NE.-1)THEN
- IACHOP=ICHOPT
- ELSE
- IACHOP=IQ(LHI+IADRI+2)
- ENDIF
- ENDIF
- ENDIF
- DX=0.
- DY=0.
- GOTO 10
- ENDIF
- ENDIF
- DX=0.
- DY=0.
- GOTO 10
-*
- 100 CALL IZSCPI(LPSAV)
-*
- END
diff --git a/src/graflib/higz/ged/izpiwi.F b/src/graflib/higz/ged/izpiwi.F
deleted file mode 100644
index fcf2f93..0000000
--- a/src/graflib/higz/ged/izpiwi.F
+++ /dev/null
@@ -1,54 +0,0 @@
-*
-* $Id: izpiwi.F,v 1.1.1.1 1996/02/14 13:10:24 mclareni Exp $
-*
-* $Log: izpiwi.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:24 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.10/00 16/02/90 10.52.35 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE IZPIWI(PNAME)
-*.===========>
-*.
-*. This routine wipe the picture PNAME after editing.
-*.
-*..==========> (O.Couet)
-#include "higz/hipaw.inc"
-#include "higz/hicode.inc"
- CHARACTER*(*) PNAME
-*.______________________________________
-*
- CALL IZCOPY(PNAME,'PICWIP','C')
-*
-* Delete the trailing attributes codes at the end
-* of each NT bank. This codes are not necessary because
-* there is no primitives after.
-*
- CALL IZPICT('PICWIP','C')
- N=IQ(LPICT+8)
- LN=LQ(LPICT-1)
- DO 30 I=1,N
- CALL ISELNT(IQ(LN+1))
- 10 IF(ITBPTR.EQ.10)GOTO 20
- IKCODE=IZGCOD(LHNT,ITBPTR-1)
- IF(IKCODE.GE.49)THEN
- IQ(LHNT+ITBPTR-1)=0
- ITBPTR=ITBPTR-1
- IQ(LHNT+4)=ITBPTR
- CALL IZCFA(IKCODE,1)
- GOTO 10
- ELSEIF(IKCODE.EQ.IUNDCO)THEN
- IQ(LHNT+ITBPTR-1)=0
- ITBPTR=ITBPTR-1
- IQ(LHNT+4)=ITBPTR
- GOTO 10
- ENDIF
- 20 LN=LQ(LHNT)
- IF(LN.EQ.0)GOTO 40
- 30 CONTINUE
-*
- 40 CALL IZPICT(PNAME,'S')
- CALL IZCOPY('PICWIP',PNAME,'R')
- END
diff --git a/src/graflib/higz/ged/izpkfa.F b/src/graflib/higz/ged/izpkfa.F
deleted file mode 100644
index 29e7c62..0000000
--- a/src/graflib/higz/ged/izpkfa.F
+++ /dev/null
@@ -1,114 +0,0 @@
-*
-* $Id: izpkfa.F,v 1.1.1.1 1996/02/14 13:10:24 mclareni Exp $
-*
-* $Log: izpkfa.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:24 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.14/09 21/05/92 14.57.26 by O.Couet
-*-- Author : O.Couet
- FUNCTION IZPKFA(XCUR,YCUR,N,XP,YP)
-*.===========>
-*.
-*. This function decides if a given fill area is picked or not .
-*. If picked IZPKFA=1
-*. If not picked IZPKFA=0
-*.
-*. _Input parameters:
-*.
-*. REAL XCUR : X coordinate of the cursor
-*. REAL YCUR : Y coordinate of the cursor
-*. INTEGER N : Number of point in the fill area
-*. REAL XP(N) YP(N) : Fill area coordinates
-*.
-*..==========> (O.Couet)
- DIMENSION XLI(100),XP(*),YP(*)
-*.______________________________________
-*
- IZPKFA=0
- NBI=0
-*
- DO 10 I=2,N+1
- I2=I
- I1=I-1
- IF(I.EQ.N+1)I2=1
-*
-* Line segment parallel to oy
-*
- IF(XP(I1).EQ.XP(I2))THEN
- IF(YP(I1).LT.YP(I2))THEN
- YI=YP(I1)
- YIP=YP(I2)
- ELSE
- YI=YP(I2)
- YIP=YP(I1)
- ENDIF
- IF((YI.LT.YCUR).AND.(YCUR.LT.YIP))THEN
- NBI=NBI+1
- XLI(NBI)=XP(I1)
- ENDIF
- GOTO 10
- ENDIF
-*
-* Line segment parallel to ox
-*
- IF(YP(I1).EQ.YP(I2))THEN
- IF(YP(I1).EQ.YCUR)THEN
- NBI=NBI+1
- XLI(NBI)=XP(I1)
- NBI=NBI+1
- XLI(NBI)=XP(I2)
- ENDIF
- GOTO 10
- ENDIF
-*
-* Other line segment
-*
- A=(YP(I1)-YP(I2))/(XP(I1)-XP(I2))
- B=(YP(I2)*XP(I1)-XP(I2)*YP(I1))/(XP(I1)-XP(I2))
- IF(XP(I1).LT.XP(I2))THEN
- XI=XP(I1)
- XIP=XP(I2)
- ELSE
- XI=XP(I2)
- XIP=XP(I1)
- ENDIF
- XIN=(YCUR-B)/A
- IF((XI.LT.XIN).AND.(XIN.LT.XIP))THEN
- NBI=NBI+1
- XLI(NBI)=XIN
- ENDIF
- 10 CONTINUE
-*
-* Sorting of the x coordinates intersections
-*
- INV=0
- M=NBI-1
- 20 CONTINUE
- DO 30 I=1,M
- IF(XLI(I+1).LT.XLI(I))THEN
- INV=INV+1
- RLL=XLI(I)
- XLI(I)=XLI(I+1)
- XLI(I+1)=RLL
- ENDIF
- 30 CONTINUE
- M=M-1
- IF(INV.EQ.0)GOTO 40
- INV=0
- GOTO 20
-*
-* Place of the x cursor coordinates
-*
- 40 NB=0
- DO 50 I=1,NBI
- IF(XCUR.LT.XLI(I))GOTO 60
- NB=NB+1
- 50 CONTINUE
- 60 IF(MOD(NB,2).NE.0)THEN
- IZPKFA=1
- ENDIF
-*
- END
diff --git a/src/graflib/higz/ged/izpkpl.F b/src/graflib/higz/ged/izpkpl.F
deleted file mode 100644
index 1ef0900..0000000
--- a/src/graflib/higz/ged/izpkpl.F
+++ /dev/null
@@ -1,120 +0,0 @@
-*
-* $Id: izpkpl.F,v 1.1.1.1 1996/02/14 13:10:24 mclareni Exp $
-*
-* $Log: izpkpl.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:24 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.06/03 16/12/88 14.00.51 by O.Couet
-*-- Author : O.Couet
- FUNCTION IZPKPL (XCUR,YCUR,N,XP,YP)
-*.===========>
-*.
-*. This routine decides if a given polyline is picked or not .
-*. If picked IZPKPL=1
-*. If not picked IZPKPL=0
-*.
-*. _Input parameters:
-*.
-*. REAL XCUR : X coordinate of the cursor
-*. REAL YCUR : Y coordinate of the cursor
-*. INTEGER N : Number of point in the polyline
-*. REAL XP(N) YP(N) : Polyline coordinates
-*.
-*..==========> (O.Couet)
-#include "higz/hipaw.inc"
-#include "higz/hiatt.inc"
- DIMENSION XP(*),YP(*)
-*.______________________________________
-*
- S=1
- IF(REDIT.NE.0)THEN
- S=REDIT
- ENDIF
- DX=(S*0.01875*(RQUEST(21)-RQUEST(20)))/(RQUEST(31)-RQUEST(30))
- DY=(S*0.01875*(RQUEST(23)-RQUEST(22)))/(RQUEST(33)-RQUEST(32))
- NM=N-1
- IZPKPL=0
- BM=YCUR-DY
- BP=YCUR+DY
- AM=XCUR-DX
- AP=XCUR+DX
- DO 10 I=1,NM
- I1=I
- I2=I+1
-*
-* Line segment parallel to oy
-*
- IF(XP(I1).EQ.XP(I2))THEN
- IF((AM.LE.XP(I1)).AND.(XP(I2).LE.AP))THEN
- IF(YP(I1).LE.YP(I2))THEN
- YI=YP(I1)
- YIP=YP(I2)
- ELSE
- YI=YP(I2)
- YIP=YP(I1)
- ENDIF
- IF((YI.LE.YCUR).AND.(YCUR.LE.YIP))THEN
- IZPKPL=1
- RETURN
- ENDIF
- ENDIF
- GOTO 10
- ENDIF
-*
-* Line segment paralel to ox
-*
- IF(YP(I1).EQ.YP(I2))THEN
- IF((BM.LE.YP(I1)).AND.(YP(I1).LE.BP))THEN
- IF(XP(I1).LE.XP(I2))THEN
- XI=XP(I1)
- XIP=XP(I2)
- ELSE
- XI=XP(I2)
- XIP=XP(I1)
- ENDIF
- IF((XI.LE.XCUR).AND.(XCUR.LE.XIP))THEN
- IZPKPL=1
- RETURN
- ENDIF
- ENDIF
- GOTO 10
- ENDIF
-*
-* Other line segment
-*
- A=(YP(I1)-YP(I2))/(XP(I1)-XP(I2))
- B=(YP(I2)*XP(I1)-XP(I2)*YP(I1))/(XP(I1)-XP(I2))
- IF(XP(I1).LE.XP(I2))THEN
- XI=XP(I1)
- XIP=XP(I2)
- ELSE
- XI=XP(I2)
- XIP=XP(I1)
- ENDIF
- IF((XI.LE.XCUR).AND.(XCUR.LE.XIP))THEN
- AA=A*XCUR+B
- IF((BM.LE.AA).AND.(AA.LE.BP))THEN
- IZPKPL=1
- RETURN
- ENDIF
- ENDIF
- IF(YP(I1).LE.YP(I2))THEN
- YI=YP(I1)
- YIP=YP(I2)
- ELSE
- YI=YP(I2)
- YIP=YP(I1)
- ENDIF
- IF((YI.LE.YCUR).AND.(YCUR.LE.YIP))THEN
- BB=(YCUR-B)/A
- IF((AM.LE.BB).AND.(BB.LE.AP))THEN
- IZPKPL=1
- RETURN
- ENDIF
- ENDIF
- 10 CONTINUE
-*
- END
diff --git a/src/graflib/higz/ged/izundo.F b/src/graflib/higz/ged/izundo.F
deleted file mode 100644
index a33031a..0000000
--- a/src/graflib/higz/ged/izundo.F
+++ /dev/null
@@ -1,62 +0,0 @@
-*
-* $Id: izundo.F,v 1.1.1.1 1996/02/14 13:10:25 mclareni Exp $
-*
-* $Log: izundo.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:25 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.06/03 11/01/89 12.01.49 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE IZUNDO
-*.===========>
-*.
-*..==========> (O.Couet)
-#include "higz/hipaw.inc"
-#include "higz/hiatt.inc"
-#include "higz/hicode.inc"
-#include "higz/hiflag.inc"
-*.______________________________________
-*
- ZFLAG=.FALSE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- GFLAG=.TRUE.
-*
- 10 IF(ITBPTR.EQ.10)GOTO 30
- IKCODE=IZGCOD(LHNT,ITBPTR-1)
- IF(IKCODE.EQ.IUNDCO)GOTO 30
-*
- IF(IKCODE.EQ.1)THEN
- IADRI=IZGADR(LHNT,ITBPTR-1)
- IADRNT=IQ(LHI+IADRI+2)
- IQ(LHNT+IADRNT)=ABS(1000000*IZGCOD(LHNT,IADRNT))
- + +IQ(LHI+IADRI+1)
- IQ(LHNT+ITBPTR-1)=0
- ITBPTR=ITBPTR-1
- IQ(LHNT+4)=ITBPTR
- GOTO 20
- ENDIF
-*
- IF(IKCODE.GE.50)THEN
- IQ(LHNT+ITBPTR-1)=0
- ITBPTR=ITBPTR-1
- IQ(LHNT+4)=ITBPTR
- CALL IZCFA(IKCODE,1)
- GOTO 10
- ENDIF
-*
- IF(IKCODE.LT.50)THEN
- IQ(LHNT+ITBPTR-1)=0
- ITBPTR=ITBPTR-1
- IQ(LHNT+4)=ITBPTR
- ENDIF
-*
- 20 CALL IGCLWN(INTR)
- CALL IZDNB(LHNT,LDI,LDF,LDC,0,0)
-*
- 30 ZFLAG=.TRUE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- GFLAG=.TRUE.
- END
-
diff --git a/src/graflib/higz/higz/Imakefile b/src/graflib/higz/higz/Imakefile
deleted file mode 100644
index 1e9b6e0..0000000
--- a/src/graflib/higz/higz/Imakefile
+++ /dev/null
@@ -1,16 +0,0 @@
-INCLUDES= di3dev.inc di3met.inc di3seg.inc dicdes.inc \ @@\
- glibm.inc glsgi.inc golden.inc grex.inc hcequi.inc hclevl.inc \ @@\
- hcligh.inc hcline.inc hcmctr.inc hcmcub.inc hcphi.inc \ @@\
- hcrast.inc hcscrn.inc hctnor.inc hczbuf.inc hczcli.inc \ @@\
- hczpor.inc hczwin.inc hi3d.inc hiaadr.inc hiaca.inc hiatnb.inc \ @@\
- hiatnm.inc hiatt.inc hibit.inc hibitvax.inc hicode.inc \ @@\
- hicont.inc hiconv.inc hicur.inc hifc1.inc hifc2.inc hifc3.inc \ @@\
- hifc6.inc hiflag.inc hiflat.inc higed.inc higraf.inc hihid.inc \ @@\
- hihist.inc hikern.inc hilabs.inc hilink.inc hiloc.inc hilun.inc hilut.inc \ @@\
- himail.inc himdos.inc himenu.inc himet2.inc himeta.inc \ @@\
- hint.inc hipack.inc hipaw.inc hiphig.inc hipick.inc hipost.inc \ @@\
- hiques.inc hisava.inc hisave.inc hisved.inc hivers.inc \ @@\
- hiwcdc.inc hiwcps.inc icmtop.inc ihdes.inc kerdes.inc \ @@\
- msdes.inc phigsdes.inc pinum.inc pnvmax.inc pilot.h
-
-InstallIncludes($(INCLUDES),$(CERN_INCLUDEDIR),higz)
diff --git a/src/graflib/higz/higz/di3dev.inc b/src/graflib/higz/higz/di3dev.inc
deleted file mode 100644
index 2a11988..0000000
--- a/src/graflib/higz/higz/di3dev.inc
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: di3dev.inc,v 1.1.1.1 1996/02/14 13:10:16 mclareni Exp $
-*
-* $Log: di3dev.inc,v $
-* Revision 1.1.1.1 1996/02/14 13:10:16 mclareni
-* Higz
-*
-*
-#ifndef CERNLIB_HIGZ_DI3DEV_INC
-#define CERNLIB_HIGZ_DI3DEV_INC
-*
-*
-* di3dev.inc
-*
-#if defined(CERNLIB_DI3000)
- LOGICAL ENTRY_FLAG
- COMMON /DI3DEV/ ENTRY_FLAG
-
-#endif
-
-#endif
diff --git a/src/graflib/higz/higz/di3met.inc b/src/graflib/higz/higz/di3met.inc
deleted file mode 100644
index bb8f915..0000000
--- a/src/graflib/higz/higz/di3met.inc
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: di3met.inc,v 1.1.1.1 1996/02/14 13:10:16 mclareni Exp $
-*
-* $Log: di3met.inc,v $
-* Revision 1.1.1.1 1996/02/14 13:10:16 mclareni
-* Higz
-*
-*
-#ifndef CERNLIB_HIGZ_DI3MET_INC
-#define CERNLIB_HIGZ_DI3MET_INC
-*
-*
-* di3met.inc
-*
-#if defined(CERNLIB_DI3000)
- CHARACTER*30 METNAM
- COMMON /DI3MET/ METNAM
-
-#endif
-
-#endif
diff --git a/src/graflib/higz/higz/di3seg.inc b/src/graflib/higz/higz/di3seg.inc
deleted file mode 100644
index bf4ee30..0000000
--- a/src/graflib/higz/higz/di3seg.inc
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: di3seg.inc,v 1.1.1.1 1996/02/14 13:10:16 mclareni Exp $
-*
-* $Log: di3seg.inc,v $
-* Revision 1.1.1.1 1996/02/14 13:10:16 mclareni
-* Higz
-*
-*
-#ifndef CERNLIB_HIGZ_DI3SEG_INC
-#define CERNLIB_HIGZ_DI3SEG_INC
-*
-*
-* di3seg.inc
-*
-#if defined(CERNLIB_DI3000)
- LOGICAL SEGOPN
- COMMON /DI3SEG/ SEGOPN
-
-#endif
-
-#endif
diff --git a/src/graflib/higz/higz/dicdes.inc b/src/graflib/higz/higz/dicdes.inc
deleted file mode 100644
index 93db933..0000000
--- a/src/graflib/higz/higz/dicdes.inc
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: dicdes.inc,v 1.1.1.1 1996/02/14 13:10:16 mclareni Exp $
-*
-* $Log: dicdes.inc,v $
-* Revision 1.1.1.1 1996/02/14 13:10:16 mclareni
-* Higz
-*
-*
-#ifndef CERNLIB_HIGZ_DICDES_INC
-#define CERNLIB_HIGZ_DICDES_INC
-*
-* COMMONS FOR HIGZ-DI3000 INTERFACE
-#if defined(CERNLIB_DI3000)
-*CMZ : 1.14/04 23/03/92 10.37.27 by Unknown
-*-- Author :
-#endif
-
-#endif
diff --git a/src/graflib/higz/higz/glibm.inc b/src/graflib/higz/higz/glibm.inc
deleted file mode 100644
index 79754ac..0000000
--- a/src/graflib/higz/higz/glibm.inc
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: glibm.inc,v 1.1.1.1 1996/02/14 13:10:18 mclareni Exp $
-*
-* $Log: glibm.inc,v $
-* Revision 1.1.1.1 1996/02/14 13:10:18 mclareni
-* Higz
-*
-*
-#ifndef CERNLIB_HIGZ_GLIBM_INC
-#define CERNLIB_HIGZ_GLIBM_INC
-*
-*
-* glibm.inc
-*
-#if (defined(CERNLIB_KERNEL))&&(!defined(CERNLIB_MSDOS))
-#if (defined(CERNLIB_GL))&&(defined(CERNLIB_IBMRT))
- INCLUDE 'gl/fgl.h'
- INCLUDE 'gl/fdevice.h'
-
-#endif
-#endif
-
-#endif
diff --git a/src/graflib/higz/higz/glsgi.inc b/src/graflib/higz/higz/glsgi.inc
deleted file mode 100644
index bdb747c..0000000
--- a/src/graflib/higz/higz/glsgi.inc
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: glsgi.inc,v 1.1.1.1 1996/02/14 13:10:17 mclareni Exp $
-*
-* $Log: glsgi.inc,v $
-* Revision 1.1.1.1 1996/02/14 13:10:17 mclareni
-* Higz
-*
-*
-#ifndef CERNLIB_HIGZ_GLSGI_INC
-#define CERNLIB_HIGZ_GLSGI_INC
-*
-*
-* glsgi.inc
-*
-#if (defined(CERNLIB_KERNEL))&&(!defined(CERNLIB_MSDOS))
-#if (defined(CERNLIB_GL))&&(defined(CERNLIB_SGI))
-#include <fgl.h>
-#include <fdevice.h>
-
-#endif
-#endif
-
-#endif
diff --git a/src/graflib/higz/higz/golden.inc b/src/graflib/higz/higz/golden.inc
deleted file mode 100644
index 26006e4..0000000
--- a/src/graflib/higz/higz/golden.inc
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: golden.inc,v 1.1.1.1 1996/02/14 13:10:18 mclareni Exp $
-*
-* $Log: golden.inc,v $
-* Revision 1.1.1.1 1996/02/14 13:10:18 mclareni
-* Higz
-*
-*
-#ifndef CERNLIB_HIGZ_GOLDEN_INC
-#define CERNLIB_HIGZ_GOLDEN_INC
-*
-*
-* golden.inc
-*
-#if defined(CERNLIB_MSDOS)
-C--
-C-- PARAMETERS FOR SURFER META-FILE
-C
- INTEGER PA,MA,TR,PS,SC,SS,SP
- PARAMETER (NJOB = 7)
- PARAMETER (PA=1,MA=2,TR=3,PS=4,SC=5,SS=6,SP=7)
-
- PARAMETER (LBUF=256)
- COMMON /GOLDEN/ LUNG(9), NREC, M_OPEN, BIMODE, BUFFER(LBUF/4)
- *, IPOINT, SYMFIL,COOR(4), LOCK, FRADEL
- LOGICAL BIMODE, M_OPEN, LOCK, FRADEL
- CHARACTER*80 SYMFIL
- CHARACTER*512 CHMBUF
- EQUIVALENCE (BUFFER,CHMBUF)
-#endif
-
-#endif
diff --git a/src/graflib/higz/higz/grex.inc b/src/graflib/higz/higz/grex.inc
deleted file mode 100644
index 5c04976..0000000
--- a/src/graflib/higz/higz/grex.inc
+++ /dev/null
@@ -1,61 +0,0 @@
-*
-* $Id: grex.inc,v 1.1.1.1 1996/02/14 13:10:18 mclareni Exp $
-*
-* $Log: grex.inc,v $
-* Revision 1.1.1.1 1996/02/14 13:10:18 mclareni
-* Higz
-*
-*
-#ifndef CERNLIB_HIGZ_GREX_INC
-#define CERNLIB_HIGZ_GREX_INC
-*
-*
-* grex.inc
-*
-#if defined(CERNLIB_MSDOS)
-C INCLUDE 'GREX.FH'
-C INCLUDE 'DOS.FH'
- integer get_video_mode
- integer video_configuration
- integer graphics_mode
- integer super_vga
- integer clear
- integer get_device_limits
- integer move
- integer draw
- integer get_cursor
- integer get_clip_limits
- integer set_clip_limits
- integer graphic_text
- integer locate
- integer pause
- integer delete_graphics
- integer beep
- integer set_xor
- integer write_string
- integer set_color
- integer vga_palette
- integer define_color
- integer filled_rectangle
- integer filled_ellipse
- integer open_ellipse
- integer linewi
- integer ixsetfs
- integer setpat
- integer polfil
- integer set_pixel
- integer set_dash
- integer move_cursor
- integer init_mouse
- integer get_mouse
- integer set_mouse
- integer set_mp_ratio
- integer set_palette
- integer magnify_text
- integer text_mode
- integer write_screen
- integer display_off
- integer display_on
-#endif
-
-#endif
diff --git a/src/graflib/higz/higz/hcequi.inc b/src/graflib/higz/higz/hcequi.inc
deleted file mode 100644
index 6fc7ada..0000000
--- a/src/graflib/higz/higz/hcequi.inc
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: hcequi.inc,v 1.2 1998/09/25 09:23:54 mclareni Exp $
-*
-* $Log: hcequi.inc,v $
-* Revision 1.2 1998/09/25 09:23:54 mclareni
-* Modifications for the Mklinux port flagged by CERNLIB_PPC
-*
-* Revision 1.1.1.1 1996/02/14 13:10:17 mclareni
-* Higz
-*
-*
-#ifndef CERNLIB_HIGZ_HCEQUI_INC
-#define CERNLIB_HIGZ_HCEQUI_INC
-*
-*
-* hcequi.inc
-*
-#if defined(CERNLIB_VAX)||defined(CERNLIB_DECS)||(defined(CERNLIB_LINUX) && !defined(CERNLIB_PPC))
- PARAMETER (I2EQUI=2)
-#endif
-#if (!defined(CERNLIB_VAX))&&(!defined(CERNLIB_DECS))&&(!(defined(CERNLIB_LINUX) && !defined(CERNLIB_PPC)))
- PARAMETER (I2EQUI=1)
-#endif
-
-#endif
diff --git a/src/graflib/higz/higz/hclevl.inc b/src/graflib/higz/higz/hclevl.inc
deleted file mode 100644
index 7a3b2ff..0000000
--- a/src/graflib/higz/higz/hclevl.inc
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: hclevl.inc,v 1.1.1.1 1996/02/14 13:10:17 mclareni Exp $
-*
-* $Log: hclevl.inc,v $
-* Revision 1.1.1.1 1996/02/14 13:10:17 mclareni
-* Higz
-*
-*
-#ifndef CERNLIB_HIGZ_HCLEVL_INC
-#define CERNLIB_HIGZ_HCLEVL_INC
-*
-*
-* hclevl.inc
-*
- PARAMETER (LLEV=256)
- COMMON /HCLEVL/ NLEV,FUNLEV(LLEV+1),ICLEV(LLEV+2)
-
-#endif
diff --git a/src/graflib/higz/higz/hcligh.inc b/src/graflib/higz/higz/hcligh.inc
deleted file mode 100644
index 1df23bc..0000000
--- a/src/graflib/higz/higz/hcligh.inc
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: hcligh.inc,v 1.1.1.1 1996/02/14 13:10:17 mclareni Exp $
-*
-* $Log: hcligh.inc,v $
-* Revision 1.1.1.1 1996/02/14 13:10:17 mclareni
-* Higz
-*
-*
-#ifndef CERNLIB_HIGZ_HCLIGH_INC
-#define CERNLIB_HIGZ_HCLIGH_INC
-*
-*
-* hcligh.inc
-*
- PARAMETER (LLIGHT = 4)
- COMMON /HCLIGH/ LOFF,YDL,YLS(LLIGHT),VLS(3,LLIGHT),QA,QD,QS,NQS
-
-#endif
diff --git a/src/graflib/higz/higz/hcline.inc b/src/graflib/higz/higz/hcline.inc
deleted file mode 100644
index 64396c6..0000000
--- a/src/graflib/higz/higz/hcline.inc
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: hcline.inc,v 1.1.1.1 1996/02/14 13:10:17 mclareni Exp $
-*
-* $Log: hcline.inc,v $
-* Revision 1.1.1.1 1996/02/14 13:10:17 mclareni
-* Higz
-*
-*
-#ifndef CERNLIB_HIGZ_HCLINE_INC
-#define CERNLIB_HIGZ_HCLINE_INC
-*
-*
-* hcline.inc
-*
- PARAMETER (LLINES=200)
- COMMON /HCLINE/ NLINES,ILLEVL(LLINES),PLINES(3,2,LLINES)
-
-#endif
diff --git a/src/graflib/higz/higz/hcmctr.inc b/src/graflib/higz/higz/hcmctr.inc
deleted file mode 100644
index 06c6137..0000000
--- a/src/graflib/higz/higz/hcmctr.inc
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: hcmctr.inc,v 1.2 2002/05/22 09:16:20 couet Exp $
-*
-* $Log: hcmctr.inc,v $
-* Revision 1.2 2002/05/22 09:16:20 couet
-* - the dimension of ABCD was wrong
-*
-* Revision 1.1.1.1 1996/02/14 13:10:17 mclareni
-* Higz
-*
-*
-#ifndef CERNLIB_HIGZ_HCMCTR_INC
-#define CERNLIB_HIGZ_HCMCTR_INC
-*
-*
-* hcmctr.inc
-*
- PARAMETER (NISO = 4, NMAXP = NISO*13, NMAXT = NISO*12)
- REAL XYZ(3,NMAXP),XYZN(3,NMAXP),GRAD(3,NMAXP)
- REAL DTRIA(6,NMAXT),ABCD(4,NMAXT)
- INTEGER ITRIA(3,NMAXT),IATTR(NMAXT),IORDER(NMAXT)
- COMMON /HCMCTR/ XYZ,XYZN,GRAD,DTRIA,ABCD,ITRIA,IATTR,IORDER
-
-#endif
diff --git a/src/graflib/higz/higz/hcmcub.inc b/src/graflib/higz/higz/hcmcub.inc
deleted file mode 100644
index d9adee7..0000000
--- a/src/graflib/higz/higz/hcmcub.inc
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: hcmcub.inc,v 1.1.1.1 1996/02/14 13:10:17 mclareni Exp $
-*
-* $Log: hcmcub.inc,v $
-* Revision 1.1.1.1 1996/02/14 13:10:17 mclareni
-* Higz
-*
-*
-#ifndef CERNLIB_HIGZ_HCMCUB_INC
-#define CERNLIB_HIGZ_HCMCUB_INC
-*
-*
-* hcmcub.inc
-*
- COMMON /HCMCUB/ P8(3,8),F8(8),G8(3,8)
-
-#endif
diff --git a/src/graflib/higz/higz/hcphi.inc b/src/graflib/higz/higz/hcphi.inc
deleted file mode 100644
index e748941..0000000
--- a/src/graflib/higz/higz/hcphi.inc
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: hcphi.inc,v 1.1.1.1 1996/02/14 13:10:17 mclareni Exp $
-*
-* $Log: hcphi.inc,v $
-* Revision 1.1.1.1 1996/02/14 13:10:17 mclareni
-* Higz
-*
-*
-#ifndef CERNLIB_HIGZ_HCPHI_INC
-#define CERNLIB_HIGZ_HCPHI_INC
-*
-*
-* hcphi.inc
-*
- PARAMETER (NPMAX=180)
- COMMON /HCPHI/ APHI(NPMAX+3)
-
-#endif
diff --git a/src/graflib/higz/higz/hcrast.inc b/src/graflib/higz/higz/hcrast.inc
deleted file mode 100644
index 08a9b44..0000000
--- a/src/graflib/higz/higz/hcrast.inc
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: hcrast.inc,v 1.1.1.1 1996/02/14 13:10:16 mclareni Exp $
-*
-* $Log: hcrast.inc,v $
-* Revision 1.1.1.1 1996/02/14 13:10:16 mclareni
-* Higz
-*
-*
-#ifndef CERNLIB_HIGZ_HCRAST_INC
-#define CERNLIB_HIGZ_HCRAST_INC
-*
-*
-* hcrast.inc
-*
- PARAMETER (NBW=30, L1=NBW/2, L2=(NBW+1)/2)
- PARAMETER (LMASK=(NBW+1)*L1+(NBW-L1*2)*L2)
- INTEGER IRAST(4),JMASK(NBW),MASK(LMASK)
- COMMON /HCRAST/ NXRAST,NYRAST,XRAST,DXRAST,YRAST,DYRAST,
- & IFRAST,JRAST,IRAST,JMASK,MASK
-
-#endif
diff --git a/src/graflib/higz/higz/hcscrn.inc b/src/graflib/higz/higz/hcscrn.inc
deleted file mode 100644
index bfb1f52..0000000
--- a/src/graflib/higz/higz/hcscrn.inc
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: hcscrn.inc,v 1.1.1.1 1996/02/14 13:10:16 mclareni Exp $
-*
-* $Log: hcscrn.inc,v $
-* Revision 1.1.1.1 1996/02/14 13:10:16 mclareni
-* Higz
-*
-*
-#ifndef CERNLIB_HIGZ_HCSCRN_INC
-#define CERNLIB_HIGZ_HCSCRN_INC
-*
-*
-* hcscrn.inc
-*
- PARAMETER (NSLIC=1000, NTMAX=100)
- COMMON /HCSCRN/ TN(4,3),TB(4,3),
- & NT,X0,DX,U(2,NSLIC),D(2,NSLIC),T(2,NTMAX)
-
-#endif
diff --git a/src/graflib/higz/higz/hctnor.inc b/src/graflib/higz/higz/hctnor.inc
deleted file mode 100644
index b8b981c..0000000
--- a/src/graflib/higz/higz/hctnor.inc
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: hctnor.inc,v 1.1.1.1 1996/02/14 13:10:16 mclareni Exp $
-*
-* $Log: hctnor.inc,v $
-* Revision 1.1.1.1 1996/02/14 13:10:16 mclareni
-* Higz
-*
-*
-#ifndef CERNLIB_HIGZ_HCTNOR_INC
-#define CERNLIB_HIGZ_HCTNOR_INC
-*
-*
-* hctnor.inc
-*
- COMMON /HCTNOR/ TNORM(4,3),TBACK(4,3)
-
-#endif
diff --git a/src/graflib/higz/higz/hczbuf.inc b/src/graflib/higz/higz/hczbuf.inc
deleted file mode 100644
index 8eddcc2..0000000
--- a/src/graflib/higz/higz/hczbuf.inc
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: hczbuf.inc,v 1.1.1.1 1996/02/14 13:10:17 mclareni Exp $
-*
-* $Log: hczbuf.inc,v $
-* Revision 1.1.1.1 1996/02/14 13:10:17 mclareni
-* Higz
-*
-*
-#ifndef CERNLIB_HIGZ_HCZBUF_INC
-#define CERNLIB_HIGZ_HCZBUF_INC
-*
-*
-* hczbuf.inc
-*
- INTEGER*2 IBUFF(1)
- COMMON /HCZBUF/ KXSCR,KYSCR,JSCRN,JZBUF,IBUFF
-
-#endif
diff --git a/src/graflib/higz/higz/hczcli.inc b/src/graflib/higz/higz/hczcli.inc
deleted file mode 100644
index 7cb4d1f..0000000
--- a/src/graflib/higz/higz/hczcli.inc
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: hczcli.inc,v 1.1.1.1 1996/02/14 13:10:17 mclareni Exp $
-*
-* $Log: hczcli.inc,v $
-* Revision 1.1.1.1 1996/02/14 13:10:17 mclareni
-* Higz
-*
-*
-#ifndef CERNLIB_HIGZ_HCZCLI_INC
-#define CERNLIB_HIGZ_HCZCLI_INC
-*
-*
-* hczcli.inc
-*
- COMMON /HCZCLI/ KX1CLI,KX2CLI,KY1CLI,KY2CLI
-
-#endif
diff --git a/src/graflib/higz/higz/hczpor.inc b/src/graflib/higz/higz/hczpor.inc
deleted file mode 100644
index 041c8e5..0000000
--- a/src/graflib/higz/higz/hczpor.inc
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: hczpor.inc,v 1.1.1.1 1996/02/14 13:10:17 mclareni Exp $
-*
-* $Log: hczpor.inc,v $
-* Revision 1.1.1.1 1996/02/14 13:10:17 mclareni
-* Higz
-*
-*
-#ifndef CERNLIB_HIGZ_HCZPOR_INC
-#define CERNLIB_HIGZ_HCZPOR_INC
-*
-*
-* hczpor.inc
-*
- COMMON /HCZPOR/ IXP1,IXP2,IYP1,IYP2,IZP1,IZP2
-
-#endif
diff --git a/src/graflib/higz/higz/hczwin.inc b/src/graflib/higz/higz/hczwin.inc
deleted file mode 100644
index c75fd4c..0000000
--- a/src/graflib/higz/higz/hczwin.inc
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: hczwin.inc,v 1.1.1.1 1996/02/14 13:10:17 mclareni Exp $
-*
-* $Log: hczwin.inc,v $
-* Revision 1.1.1.1 1996/02/14 13:10:17 mclareni
-* Higz
-*
-*
-#ifndef CERNLIB_HIGZ_HCZWIN_INC
-#define CERNLIB_HIGZ_HCZWIN_INC
-*
-*
-* hczwin.inc
-*
- COMMON /HCZWIN/ XW1,XW2,YW1,YW2,ZW1,ZW2
-
-#endif
diff --git a/src/graflib/higz/higz/hi3d.inc b/src/graflib/higz/higz/hi3d.inc
deleted file mode 100644
index e39a45d..0000000
--- a/src/graflib/higz/higz/hi3d.inc
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: hi3d.inc,v 1.1.1.1 1996/02/14 13:10:13 mclareni Exp $
-*
-* $Log: hi3d.inc,v $
-* Revision 1.1.1.1 1996/02/14 13:10:13 mclareni
-* Higz
-*
-*
-#ifndef CERNLIB_HIGZ_HI3D_INC
-#define CERNLIB_HIGZ_HI3D_INC
-*
-*
-* hi3d.inc
-*
-*CMZ : 1.23/06 14/11/95 10.18.18 by O.Couet
-*-- Author : O.Couet 20/12/93
- COMMON /HI3D/ AWNX,BWNX,CWNX,DWNX,
- + AWNY,BWNY,CWNY,DWNY,
- + AWNZ,BWNZ,CWNZ,DWNZ
-
-#endif
diff --git a/src/graflib/higz/higz/hiaadr.inc b/src/graflib/higz/higz/hiaadr.inc
deleted file mode 100644
index 997745c..0000000
--- a/src/graflib/higz/higz/hiaadr.inc
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: hiaadr.inc,v 1.1.1.1 1996/02/14 13:10:13 mclareni Exp $
-*
-* $Log: hiaadr.inc,v $
-* Revision 1.1.1.1 1996/02/14 13:10:13 mclareni
-* Higz
-*
-*
-#ifndef CERNLIB_HIGZ_HIAADR_INC
-#define CERNLIB_HIGZ_HIAADR_INC
-*
-* Attributes adresses in the current picture
-*
-* hiaadr.inc
-*
-*CMZ : 1.18/00 23/04/93 17.27.56 by O.Couet
-*-- Author :
- COMMON /HIAADR/ IATADR(60)
-
-
-#endif
diff --git a/src/graflib/higz/higz/hiaca.inc b/src/graflib/higz/higz/hiaca.inc
deleted file mode 100644
index 84f1f8a..0000000
--- a/src/graflib/higz/higz/hiaca.inc
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: hiaca.inc,v 1.1.1.1 1996/02/14 13:10:14 mclareni Exp $
-*
-* $Log: hiaca.inc,v $
-* Revision 1.1.1.1 1996/02/14 13:10:14 mclareni
-* Higz
-*
-*
-#ifndef CERNLIB_HIGZ_HIACA_INC
-#define CERNLIB_HIGZ_HIACA_INC
-*
-*
-* hiaca.inc
-*
-*CMZ : 1.18/00 23/04/93 17.27.57 by O.Couet
-*-- Author :
- COMMON/HIACA/ IACHOP,IADRAT
-
-
-#endif
diff --git a/src/graflib/higz/higz/hiatnb.inc b/src/graflib/higz/higz/hiatnb.inc
deleted file mode 100644
index 7dfb0dd..0000000
--- a/src/graflib/higz/higz/hiatnb.inc
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: hiatnb.inc,v 1.1.1.1 1996/02/14 13:10:13 mclareni Exp $
-*
-* $Log: hiatnb.inc,v $
-* Revision 1.1.1.1 1996/02/14 13:10:13 mclareni
-* Higz
-*
-*
-#ifndef CERNLIB_HIGZ_HIATNB_INC
-#define CERNLIB_HIGZ_HIATNB_INC
-*
-* Number of INTEGER and REAL attributes
-*
-* hiatnb.inc
-*
-*CMZ : 1.18/00 23/04/93 17.27.56 by O.Couet
-*-- Author :
- PARAMETER (NBRATT=12,NBIATT=13)
-
-
-#endif
diff --git a/src/graflib/higz/higz/hiatnm.inc b/src/graflib/higz/higz/hiatnm.inc
deleted file mode 100644
index 3a5b43a..0000000
--- a/src/graflib/higz/higz/hiatnm.inc
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: hiatnm.inc,v 1.1.1.1 1996/02/14 13:10:13 mclareni Exp $
-*
-* $Log: hiatnm.inc,v $
-* Revision 1.1.1.1 1996/02/14 13:10:13 mclareni
-* Higz
-*
-*
-#ifndef CERNLIB_HIGZ_HIATNM_INC
-#define CERNLIB_HIGZ_HIATNM_INC
-*
-* Attributes names
-*
-* hiatnm.inc
-*
-*CMZ : 1.18/00 23/04/93 17.27.56 by O.Couet
-*-- Author :
- CHARACTER*4 CHRATT(NBRATT),CHIATT(NBIATT)
- DATA CHRATT /'MSCF','LWID','BASL','TANG','CHHE','CSHI'
- +, 'BARO','BARW','AWLN','TMSI','LASI','LAOF'/
- DATA CHIATT /'PLCI','LTYP','PMCI','MTYP','FACI','FAIS'
- +, 'FASI','TXCI','TXAL','TXFP','PASS','BORD'
- +, 'NLIN'/
-
-
-#endif
diff --git a/src/graflib/higz/higz/hiatt.inc b/src/graflib/higz/higz/hiatt.inc
deleted file mode 100644
index 4261e66..0000000
--- a/src/graflib/higz/higz/hiatt.inc
+++ /dev/null
@@ -1,46 +0,0 @@
-*
-* $Id: hiatt.inc,v 1.1.1.1 1996/02/14 13:10:13 mclareni Exp $
-*
-* $Log: hiatt.inc,v $
-* Revision 1.1.1.1 1996/02/14 13:10:13 mclareni
-* Higz
-*
-*
-#ifndef CERNLIB_HIGZ_HIATT_INC
-#define CERNLIB_HIGZ_HIATT_INC
-*
-* Attributes list
-*
-* hiatt.inc
-*
-*CMZ : 1.23/06 20/11/95 16.43.50 by O.Couet
-*-- Author :
- INTEGER INTR,IWTYPE,IDID,IDTY,ILOPWK(10),IWTYL(10),INOPWK
- +, IWINID(10),IPICT,ICLIP,NT0PRI,IPLCI,ILN,IPMCI,IMK,IFACI
- +, IFAIS,IFASI,ITXCI,ITXALG,IFTPR,INPASS,IBORD,INLINE
- +, INTATT(17),IFONT,IPREC,ITXALH,ITXALV,IDIM,INBCOL,IZBUF
- REAL XRATIO,YRATIO,RWXMIN,RWXMAX,RWYMIN,RWYMAX,RVXMIN,RVXMAX
- +, RVYMIN,RVYMAX,RDWXMI,RDWXMA,RDWYMI,RDWYMA,RDVXMI,RDVXMA
- +, RDVYMI,RDVYMA,RMDSX,RMDSY,XWKSIZ(10),YWKSIZ(10),WKMAX(10)
- +, XWKR(10),YWKR(10),XWKW1(10),YWKW1(10),XWKV1(10),YWKV1(10)
- +, XWKW2(10),YWKW2(10),XWKV2(10),YWKV2(10),REDIT,RMKSC,RLWSC
- +, RBSL,RANGLE,RCHH,RCSHIF,RBOF,RBWD,RAWL,RTMS,RALH,RALD
- +, REAATT(18),RCHUX,RCHUY
- LOGICAL ACWKFL(10),NODRFL(10)
- COMMON /HIATT/ INTR,XRATIO,YRATIO
- +,RWXMIN,RWXMAX,RWYMIN,RWYMAX,RVXMIN,RVXMAX,RVYMIN,RVYMAX
- +,RDWXMI,RDWXMA,RDWYMI,RDWYMA,RDVXMI,RDVXMA,RDVYMI,RDVYMA
- +,RMDSX ,RMDSY ,IWTYPE,IDID ,IDTY
- +,ILOPWK,ACWKFL,NODRFL,IWTYL ,INOPWK
- +,XWKSIZ,YWKSIZ,WKMAX ,IWINID,XWKR ,YWKR
- +,XWKW1 ,YWKW1 ,XWKV1 ,YWKV1
- +,XWKW2 ,YWKW2 ,XWKV2 ,YWKV2
- +,IPICT ,ICLIP ,REDIT,NT0PRI
- +,RMKSC ,RLWSC ,RBSL ,RANGLE,RCHH ,RCSHIF,RBOF ,RBWD
- +,RAWL ,RTMS ,RALH ,RALD ,REAATT
- +,IPLCI ,ILN ,IPMCI ,IMK ,IFACI ,IFAIS ,IFASI ,ITXCI
- +,ITXALG,IFTPR ,INPASS,IBORD ,INLINE,INTATT
- +,IFONT ,IPREC ,ITXALH,ITXALV,RCHUX ,RCHUY
- +,IDIM ,INBCOL,IZBUF
-
-#endif
diff --git a/src/graflib/higz/higz/hibit.inc b/src/graflib/higz/higz/hibit.inc
deleted file mode 100644
index c23ecbf..0000000
--- a/src/graflib/higz/higz/hibit.inc
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: hibit.inc,v 1.1.1.1 1996/02/14 13:10:16 mclareni Exp $
-*
-* $Log: hibit.inc,v $
-* Revision 1.1.1.1 1996/02/14 13:10:16 mclareni
-* Higz
-*
-*
-#ifndef CERNLIB_HIGZ_HIBIT_INC
-#define CERNLIB_HIGZ_HIBIT_INC
-*
-*
-* hibit.inc
-*
-*CMZ : 1.18/00 23/04/93 17.27.57 by O.Couet
-*-- Author :
-#if defined(CERNLIB_VAX)
-#include "higz/hibitvax.inc"
-#endif
-*
-
-#endif
diff --git a/src/graflib/higz/higz/hibitvax.inc b/src/graflib/higz/higz/hibitvax.inc
deleted file mode 100644
index c99623c..0000000
--- a/src/graflib/higz/higz/hibitvax.inc
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: hibitvax.inc,v 1.1.1.1 1996/02/14 13:10:16 mclareni Exp $
-*
-* $Log: hibitvax.inc,v $
-* Revision 1.1.1.1 1996/02/14 13:10:16 mclareni
-* Higz
-*
-*
-#ifndef CERNLIB_HIGZ_HIBITVAX_INC
-#define CERNLIB_HIGZ_HIBITVAX_INC
-*
-*
-* hibitvax.inc
-*
-*CMZ : 1.18/00 23/04/93 17.27.57 by O.Couet
-*-- Author :
- JBIT (IZW,IZP)=JIBITS (IZW,IZP-1,1)
- JBYT (IZW,IZP,NZB)=JIBITS (IZW,IZP-1,NZB)
-
-#endif
diff --git a/src/graflib/higz/higz/hicode.inc b/src/graflib/higz/higz/hicode.inc
deleted file mode 100644
index 4b7ec11..0000000
--- a/src/graflib/higz/higz/hicode.inc
+++ /dev/null
@@ -1,30 +0,0 @@
-*
-* $Id: hicode.inc,v 1.2 1996/11/20 15:15:32 couet Exp $
-*
-* $Log: hicode.inc,v $
-* Revision 1.2 1996/11/20 15:15:32 couet
-* *** empty log message ***
-*
-* Revision 1.1.1.1 1996/02/14 13:10:14 mclareni
-* Higz
-*
-*
-#ifndef CERNLIB_HIGZ_HICODE_INC
-#define CERNLIB_HIGZ_HICODE_INC
-*
-* Attributes codes
-*
-* hicode.inc
-*
-*-- Author : O.Couet
- PARAMETER (INOPCO=1 ,IUNDCO=2 ,IPICO1=3 ,IPICO2=4 ,IMIDCO=5
- +,IHISCO=6 ,IPM1CO=7 ,IPL2CO=8 ,IPLCO =9 ,IPMCO =10,IFACO =11
- +,ITXCO =12,IBXCO =13,IFBXCO=14,IARCCO=15,IAXICO=16,IGTXCO=17
- +,IMLCO =18,ILBLCO=19,ITABCO=20,IGRACO=21,IPAVCO=22
- +,ICRCO =48,ICLICO=49
- +,IMKSCO=50,ILWSCO=51,IBSLCO=52,IANGCO=53,ICHHCO=54,IGTSCO=55
- +,IBOFCO=56,IBWDCO=57,IAWLCO=58,ITMSCO=59,IALHCO=60,IALDCO=61
- +,IPLCCO=80,ILNCO =81,IPMCCO=82,IMKCO =83,IFACCO=84,IFAICO=85
- +,IFASCO=86,ITXCCO=87,ITXACO=88,ITXFCO=89,IGTWCO=90,IBORCO=91
- +,INLICO=92)
-#endif
diff --git a/src/graflib/higz/higz/hicont.inc b/src/graflib/higz/higz/hicont.inc
deleted file mode 100644
index 1ca5b19..0000000
--- a/src/graflib/higz/higz/hicont.inc
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: hicont.inc,v 1.1.1.1 1996/02/14 13:10:15 mclareni Exp $
-*
-* $Log: hicont.inc,v $
-* Revision 1.1.1.1 1996/02/14 13:10:15 mclareni
-* Higz
-*
-*
-#ifndef CERNLIB_HIGZ_HICONT_INC
-#define CERNLIB_HIGZ_HICONT_INC
-*
-*
-* hicont.inc
-*
-*CMZ : 1.18/00 23/04/93 17.27.57 by O.Couet
-*-- Author :
- COMMON /HICONT/ DZ,ZMIN,ZMAX
-
-
-#endif
diff --git a/src/graflib/higz/higz/hiconv.inc b/src/graflib/higz/higz/hiconv.inc
deleted file mode 100644
index 37b5df4..0000000
--- a/src/graflib/higz/higz/hiconv.inc
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: hiconv.inc,v 1.1.1.1 1996/02/14 13:10:15 mclareni Exp $
-*
-* $Log: hiconv.inc,v $
-* Revision 1.1.1.1 1996/02/14 13:10:15 mclareni
-* Higz
-*
-*
-#ifndef CERNLIB_HIGZ_HICONV_INC
-#define CERNLIB_HIGZ_HICONV_INC
-*
-*
-* hiconv.inc
-*
-*CMZ : 1.18/00 23/04/93 17.27.57 by O.Couet
-*-- Author :
- COMMON /HICONV/ X1MIN,X1MAX,Y1MIN,Y1MAX,X2MIN,X2MAX,Y2MIN,Y2MAX
-
-
-#endif
diff --git a/src/graflib/higz/higz/hicur.inc b/src/graflib/higz/higz/hicur.inc
deleted file mode 100644
index be1789f..0000000
--- a/src/graflib/higz/higz/hicur.inc
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: hicur.inc,v 1.1.1.1 1996/02/14 13:10:14 mclareni Exp $
-*
-* $Log: hicur.inc,v $
-* Revision 1.1.1.1 1996/02/14 13:10:14 mclareni
-* Higz
-*
-*
-#ifndef CERNLIB_HIGZ_HICUR_INC
-#define CERNLIB_HIGZ_HICUR_INC
-*
-*
-* hicur.inc
-*
-*CMZ : 1.18/00 23/04/93 17.27.57 by O.Couet
-*-- Author :
- COMMON /HICUR/ HICDIR
- CHARACTER*32 HICDIR
-
-
-#endif
diff --git a/src/graflib/higz/higz/hifc1.inc b/src/graflib/higz/higz/hifc1.inc
deleted file mode 100644
index 40de1d7..0000000
--- a/src/graflib/higz/higz/hifc1.inc
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: hifc1.inc,v 1.1.1.1 1996/02/14 13:10:13 mclareni Exp $
-*
-* $Log: hifc1.inc,v $
-* Revision 1.1.1.1 1996/02/14 13:10:13 mclareni
-* Higz
-*
-*
-#ifndef CERNLIB_HIGZ_HIFC1_INC
-#define CERNLIB_HIGZ_HIFC1_INC
-*
-*
-* hifc1.inc
-*
-*CMZ : 1.20/08 18/01/94 14.30.07 by O.Couet
-*-- Author : O.Couet 18/01/94
- COMMON/HIFC1/ISFL
-
-#endif
diff --git a/src/graflib/higz/higz/hifc2.inc b/src/graflib/higz/higz/hifc2.inc
deleted file mode 100644
index af9167e..0000000
--- a/src/graflib/higz/higz/hifc2.inc
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: hifc2.inc,v 1.1.1.1 1996/02/14 13:10:13 mclareni Exp $
-*
-* $Log: hifc2.inc,v $
-* Revision 1.1.1.1 1996/02/14 13:10:13 mclareni
-* Higz
-*
-*
-#ifndef CERNLIB_HIGZ_HIFC2_INC
-#define CERNLIB_HIGZ_HIFC2_INC
-*
-*
-* hifc2.inc
-*
-*CMZ : 1.20/08 18/01/94 14.25.59 by O.Couet
-*-- Author : O.Couet 18/01/94
- COMMON/HIFC2/FX,FY,XMIN,XMAX,YMIN,YMAX,IXMIN,IXMAX,IYMIN,IYMAX
-
-#endif
diff --git a/src/graflib/higz/higz/hifc3.inc b/src/graflib/higz/higz/hifc3.inc
deleted file mode 100644
index 127608a..0000000
--- a/src/graflib/higz/higz/hifc3.inc
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: hifc3.inc,v 1.1.1.1 1996/02/14 13:10:12 mclareni Exp $
-*
-* $Log: hifc3.inc,v $
-* Revision 1.1.1.1 1996/02/14 13:10:12 mclareni
-* Higz
-*
-*
-#ifndef CERNLIB_HIGZ_HIFC3_INC
-#define CERNLIB_HIGZ_HIFC3_INC
-*
-*
-* hifc3.inc
-*
-*CMZ : 1.20/08 18/01/94 14.30.32 by O.Couet
-*-- Author : O.Couet 18/01/94
- COMMON/HIFC3/XL,YL,FLAG1
-
-#endif
diff --git a/src/graflib/higz/higz/hifc6.inc b/src/graflib/higz/higz/hifc6.inc
deleted file mode 100644
index 92fa187..0000000
--- a/src/graflib/higz/higz/hifc6.inc
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: hifc6.inc,v 1.1.1.1 1996/02/14 13:10:13 mclareni Exp $
-*
-* $Log: hifc6.inc,v $
-* Revision 1.1.1.1 1996/02/14 13:10:13 mclareni
-* Higz
-*
-*
-#ifndef CERNLIB_HIGZ_HIFC6_INC
-#define CERNLIB_HIGZ_HIFC6_INC
-*
-*
-* hifc6.inc
-*
-*CMZ : 1.20/08 18/01/94 14.29.45 by O.Couet
-*-- Author : O.Couet 18/01/94
- COMMON/HIFC6/ISCR,IPOUT,JPIN,MFL
-
-#endif
diff --git a/src/graflib/higz/higz/hiflag.inc b/src/graflib/higz/higz/hiflag.inc
deleted file mode 100644
index 4f4649c..0000000
--- a/src/graflib/higz/higz/hiflag.inc
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: hiflag.inc,v 1.2 2005/10/28 12:37:57 couet Exp $
-*
-* $Log: hiflag.inc,v $
-* Revision 1.2 2005/10/28 12:37:57 couet
-* - SVG driver, workstation type -779
-*
-* Revision 1.1.1.1 1996/02/14 13:10:13 mclareni
-* Higz
-*
-*
-#ifndef CERNLIB_HIGZ_HIFLAG_INC
-#define CERNLIB_HIGZ_HIFLAG_INC
-*
-*
-* hiflag.inc
-*
-*CMZ : 1.21/05 16/06/94 14.37.23 by O.Couet
-*-- Author :
- COMMON /HIFLAG/ GFLAG,GLFLAG,ZFLAG,PFLAG,MFLAG,TFLAG
- +,ASFLAG,GRFLAG,AXFLAG,CFLAG,VFLAG
- LOGICAL GFLAG,GLFLAG,ZFLAG,PFLAG,MFLAG,TFLAG
- +,ASFLAG,GRFLAG,AXFLAG,CFLAG,VFLAG
-
-
-#endif
diff --git a/src/graflib/higz/higz/hiflat.inc b/src/graflib/higz/higz/hiflat.inc
deleted file mode 100644
index ba7c1ef..0000000
--- a/src/graflib/higz/higz/hiflat.inc
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: hiflat.inc,v 1.1.1.1 1996/02/14 13:10:13 mclareni Exp $
-*
-* $Log: hiflat.inc,v $
-* Revision 1.1.1.1 1996/02/14 13:10:13 mclareni
-* Higz
-*
-*
-#ifndef CERNLIB_HIGZ_HIFLAT_INC
-#define CERNLIB_HIGZ_HIFLAT_INC
-*
-* Attributes control flags
-*
-* hiflat.inc
-*
-*CMZ : 1.18/00 23/04/93 17.27.57 by O.Couet
-*-- Author :
- COMMON /HIFLAT/
- + KMKSC,KLWSC,KBSL ,KTANG,KCHH ,KTXSH
- +,KBOF ,KBWD ,KAWL ,KTMS ,KALH ,KALD
- +,KRFLAG(18)
- +,KPLCI,KLN ,KPMCI,KMK ,KFACI,KFAIS
- +,KFASI,KTXCI,KTXAL,KFONT,KTXPA,KBOR
- +,KNLIN
- +,KIFLAG(17)
-
-
-#endif
diff --git a/src/graflib/higz/higz/higed.inc b/src/graflib/higz/higz/higed.inc
deleted file mode 100644
index 687a4c0..0000000
--- a/src/graflib/higz/higz/higed.inc
+++ /dev/null
@@ -1,44 +0,0 @@
-*
-* $Id: higed.inc,v 1.1.1.1 1996/02/14 13:10:14 mclareni Exp $
-*
-* $Log: higed.inc,v $
-* Revision 1.1.1.1 1996/02/14 13:10:14 mclareni
-* Higz
-*
-*
-#ifndef CERNLIB_HIGZ_HIGED_INC
-#define CERNLIB_HIGZ_HIGED_INC
-*
-*
-* higed.inc
-*
-*CMZ : 1.18/00 23/04/93 17.27.57 by O.Couet
-*-- Author :
- COMMON /HIGED/ XPM(2,3),YPM(2,3),ICUMEN(3),ICUCHO(3),NBU(3)
- +,NBITEM(3),ISOF,ICPLCI,ICLN,ICFACI,ICFAIS,ICFASI,ICBOCI,ICBOIS
- +,ICBOSI,ICBOBO,ICFBCI,ICFBIS,ICFBSI,ICFBBO,ICPMCI,ICMK,RCMKSC
- +,RCSTAN,RCSTSI,ICSTPA,RCSTSH,ICSTCI,RCTXAN,RCTXSI,ICTXFT,ICTXPR
- +,ICTXCI,ICTXAH,ICTXAV,RCBOF,RCBWD,ICHILN,ICHIPC,ICHIFC,ICHIFI
- +,ICHIFS,RCARSI,ICARLC,ICARFC,ICARFI,ICARFS,ICARLN,RCAXTS,RCAXLS
- +,RCAXLO,RCAXW1,RCAXW2,ICAXND,ICAXLN,ICAXLC,ICAXLF,ICAXLP,ICACFI
- +,ICACFS,ICACBO,ICACLC,ICACFC,RCLWSC,X(100),Y(100)
- +,IXSTEP,IYSTEP,IXFACT,IYFACT,ICPBST,ICPFST,RCDZPV
- CHARACTER*32 TITLE(3)
- CHARACTER*20 CHUSKE(20,3)
- CHARACTER*32 CHITEM(20,3)
- CHARACTER*80 CHDEF(20)
- CHARACTER*32 CHOPST,CHOPAX,CHOPHI,CHOPPV
- CHARACTER*80 CCST,CCTX
- CHARACTER*80 CHFAC,CHPLC,CHTXC,CHPMC,CHFAIS,CHHIFC,CHHIPC,CHARFC
- + ,CHARLC,CHARFI,CHBOC,CHBOIS,CHFBC,CHFBIS,CHSTC,CHHIIS
- + ,CHAXLC,CHACIS,CHACLC,CHACFC
- CHARACTER*8 CHDOAR,CHBOBO,CHFBBO,CHAFL,CHACBO
- CHARACTER*80 EDIPIC
- COMMON /HIGEDC/ TITLE,CHUSKE,CHITEM,CHDEF,CHOPST,CHOPAX,CHOPHI
- +,CCST,CCTX,CHFAC,CHPLC,CHTXC,CHPMC,CHFAIS,CHHIFC,CHHIPC,CHARFC
- +,CHARLC,CHARFI,CHBOC,CHBOIS,CHFBC,CHFBIS,CHSTC,CHHIIS,CHAXLC
- +,CHACIS,CHACLC,CHACFC,CHDOAR,CHBOBO,CHFBBO,CHAFL,CHACBO,EDIPIC
- +,CHOPPV
-
-
-#endif
diff --git a/src/graflib/higz/higz/higraf.inc b/src/graflib/higz/higz/higraf.inc
deleted file mode 100644
index 420d10a..0000000
--- a/src/graflib/higz/higz/higraf.inc
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: higraf.inc,v 1.1.1.1 1996/02/14 13:10:15 mclareni Exp $
-*
-* $Log: higraf.inc,v $
-* Revision 1.1.1.1 1996/02/14 13:10:15 mclareni
-* Higz
-*
-*
-#ifndef CERNLIB_HIGZ_HIGRAF_INC
-#define CERNLIB_HIGZ_HIGRAF_INC
-*
-*
-* higraf.inc
-*
-*CMZ : 1.23/06 14/11/95 10.22.09 by O.Couet
-*-- Author :
- PARAMETER (NPMAX=500)
- COMMON /HIGRAF/ NGRAF,XGRAF(NPMAX),YGRAF(NPMAX)
- COMMON /HIGRA3/ ZGRAF(NPMAX)
-
-#endif
diff --git a/src/graflib/higz/higz/hihid.inc b/src/graflib/higz/higz/hihid.inc
deleted file mode 100644
index f618c8c..0000000
--- a/src/graflib/higz/higz/hihid.inc
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: hihid.inc,v 1.1.1.1 1996/02/14 13:10:17 mclareni Exp $
-*
-* $Log: hihid.inc,v $
-* Revision 1.1.1.1 1996/02/14 13:10:17 mclareni
-* Higz
-*
-*
-#ifndef CERNLIB_HIGZ_HIHID_INC
-#define CERNLIB_HIGZ_HIHID_INC
-*
-*
-* hihid.inc
-*
- PARAMETER (MAXSTK=10)
- COMMON /HIHID/ REFWRD(MAXSTK),ZMINST,ZMAXST
- +,IXFCHA(MAXSTK),IYFCHA(MAXSTK),IXNCHA(MAXSTK),IYNCHA(MAXSTK)
- +,ISTCOL(MAXSTK),ISTCO2(MAXSTK),ISTCOT,ISTCOB,IADRES(MAXSTK)
- +,NIDS,XSTP,YSTP,XLAB1,YLAB1,XLAB2,YLAB2,IDRGR,RLEGBO,RLEGBW
- +,I4AXI,ISYS,ILOGX,ILOGY,XVAL1,XVAL2,YVAL1,YVAL2,RINRAD,DANG
-
-#endif
diff --git a/src/graflib/higz/higz/hihist.inc b/src/graflib/higz/higz/hihist.inc
deleted file mode 100644
index 5e9eec5..0000000
--- a/src/graflib/higz/higz/hihist.inc
+++ /dev/null
@@ -1,35 +0,0 @@
-*
-* $Id: hihist.inc,v 1.2 2001/10/17 14:36:53 couet Exp $
-*
-* $Log: hihist.inc,v $
-* Revision 1.2 2001/10/17 14:36:53 couet
-* - The WORK buffers were too small and the follwoing macro didn't not
-* work for more that 101 points:
-*
-* vec/del *
-* n = [1]
-* vec/cr time([n])
-* vec/cr etime([n]) r [n]*0.0
-* vec/cr y([n]) r
-* vec/cr ey([n]) r [n]*0.7
-* do i = 1, [n]
-* vec/input time([i]) [i]
-* vec/input y([i]) $eval(3.0+0.01*[i])
-* enddo
-* null -10 160 0 10
-* hplot/errors time y etime ey [n] 20 0.1 3
-*
-* Revision 1.1.1.1 1996/02/14 13:10:15 mclareni
-* Higz
-*
-*
-#ifndef CERNLIB_HIGZ_HIHIST_INC
-#define CERNLIB_HIGZ_HIHIST_INC
-*
-*
-* hihist.inc
-*
-*CMZ : 1.18/00 23/04/93 17.27.57 by O.Couet
-*-- Author :
- COMMON /HIHIST/ XWORK(1004),YWORK(1004),XWORKL(1004),YWORKL(1004)
-#endif
diff --git a/src/graflib/higz/higz/hikern.inc b/src/graflib/higz/higz/hikern.inc
deleted file mode 100644
index 28fa292..0000000
--- a/src/graflib/higz/higz/hikern.inc
+++ /dev/null
@@ -1,134 +0,0 @@
-*
-* $Id: hikern.inc,v 1.3 1998/01/28 14:34:07 couet Exp $
-*
-* $Log: hikern.inc,v $
-* Revision 1.3 1998/01/28 14:34:07 couet
-* - GGDM driver removed
-*
-* Revision 1.2 1996/09/25 14:57:09 couet
-* - GPR driver removed
-*
-* Revision 1.1.1.1 1996/02/14 13:10:17 mclareni
-* Higz
-*
-*
-#ifndef CERNLIB_HIGZ_HIKERN_INC
-#define CERNLIB_HIGZ_HIKERN_INC
-*
-* COMMON BLOCK for the GL interface
-*
-* hikern.inc
-*
-#if (defined(CERNLIB_KERNEL))&&(!defined(CERNLIB_MSDOS))
-#if defined(CERNLIB_GL)
-#if defined(CERNLIB_SGI)
-#include "higz/glsgi.inc"
-#endif
-#if defined(CERNLIB_IBMRT)
-#include "higz/glibm.inc"
-#endif
- PARAMETER (IBUFSI=1000)
- COMMON /HIKERN/ WKSC(10),WINSIZ(4),IPOS(2,IBUFSI),IXX,IYY,ICURWK
- +,LOINS,ICURCI(10),IOFCOL,IXLOCO,IYLOCO,LUNWIN
- LOGICAL LOINS
- INTEGER WINSIZ,WINID
- INTEGER*2 IVAL
- COMMON /HIKERC/ FILEN
- CHARACTER*80 FILEN
-
-#endif
-#endif
-*
-* COMMON BLOCK for the X11 interface
-*
-* hikern.inc
-*
-#if (defined(CERNLIB_KERNEL))&&(!defined(CERNLIB_MSDOS))
-#if (defined(CERNLIB_X11))&&(!defined(CERNLIB_WINNT))
- PARAMETER (IBUFSI=1000)
- COMMON /HIKERN/ WKSC(10),ICURWK,WINSIZ(4)
- +,IPOS(2,IBUFSI),LUNWIN,THX11,IFPX11,RMAGN
- INTEGER WINSIZ
- INTEGER*2 IPOS
- COMMON /HIKERC/ CHHOST,FILEN,FX11
- CHARACTER*80 CHHOST,FILEN,FX11
-
-#endif
-#endif
-*
-* COMMON BLOCK for the Windows NT interface
-*
-#if (defined(CERNLIB_KERNEL))&&(!defined(CERNLIB_MSDOS))
-#if defined(CERNLIB_WINNT)
- PARAMETER (IBUFSI=1000)
- COMMON /HIKERN/ WKSC(10),ICURWK,WINSIZ(4)
- +,IPOS(2,IBUFSI),LUNWIN,THX11,IFPX11
- INTEGER WINSIZ
- COMMON /HIKERC/ CHHOST,FILEN,FX11
- CHARACTER*80 CHHOST,FILEN,FX11
-
-#endif
-#endif
-*
-* COMMON BLOCK for the MacIntosh interface
-*
-* hikern.inc
-*
-#if (defined(CERNLIB_KERNEL))&&(!defined(CERNLIB_MSDOS))
-#if defined(CERNLIB_MACMPW)
- PARAMETER (IBUFSI=1000)
- COMMON /HIKERN/ WKSC(10),ICURWK,WINSIZ(4)
- +,IPOS(2,IBUFSI),LUNWIN
- INTEGER WINSIZ
- COMMON /HIKERC/ FILEN
- CHARACTER*80 FILEN
-
-#endif
-#endif
-* COMMON BLOCK for the NDP_PC interface
-*
-* hikern.inc
-*
-#if defined(CERNLIB_MSDOS)
-#if defined(CERNLIB_NDP)
-#include "higz/grex.inc"
- PARAMETER (IBUFSI=1000)
- PARAMETER (ISURF= 18)
- PARAMETER (IRIS = 17)
-
-#include "higz/golden.inc"
-
- COMMON /HIKERN/ WKSC(10),WINSIZ(4),IPOS(IBUFSI,2),IXX,IYY,ICURWK
- +,LOINS,ICURCI(10),IOFCOL,IXLOCO,IYLOCO,IWKNB,LUNMET(10)
- *, MAX_COLOR(10), IER, DASH_PATTERN(16), video_system(4)
- *, PAL, ISTEP, MAG_X, MAG_Y, MOUSE, IXSAVE(10), IYSAVE(10)
- LOGICAL LOINS, MOUSE
- INTEGER WINSIZ,WINID,video_system
- CHARACTER*4 DASH_PATTERN
- CHARACTER PAL(20)
-C--- INTEGER STRWID
-#endif
-#endif
-* COMMON BLOCK for the NDP_PC interface
-#if defined(CERNLIB_MSDOS)
-#if !defined(CERNLIB_NDP)
-#include "higz/grex.inc"
- PARAMETER (IBUFSI=1000)
- PARAMETER (ISURF= 18)
- PARAMETER (IRIS = 17)
-
-#include "higz/golden.inc"
-
- COMMON /HIKERN/ WKSC(10),WINSIZ(4),IPOS(2,IBUFSI),IXX,IYY,ICURWK
- +,LOINS,ICURCI(10),IOFCOL,IXLOCO,IYLOCO,IWKNB,LUNMET(10)
- *, MAX_COLOR(10), IER, DASH_PATTERN(16), video_system(4)
- *, PAL, ISTEP, MAG_X, MAG_Y, MOUSE, IXSAVE(10), IYSAVE(10)
- LOGICAL LOINS, MOUSE
- INTEGER WINSIZ,WINID,video_system
- CHARACTER*4 DASH_PATTERN
- CHARACTER PAL(20)
-C--- INTEGER STRWID
-#endif
-#endif
-
-#endif
diff --git a/src/graflib/higz/higz/hilabs.inc b/src/graflib/higz/higz/hilabs.inc
deleted file mode 100644
index 61ea0ba..0000000
--- a/src/graflib/higz/higz/hilabs.inc
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: hilabs.inc,v 1.1.1.1 1996/02/14 13:10:14 mclareni Exp $
-*
-* $Log: hilabs.inc,v $
-* Revision 1.1.1.1 1996/02/14 13:10:14 mclareni
-* Higz
-*
-*
-#ifndef CERNLIB_HIGZ_HILABS_INC
-#define CERNLIB_HIGZ_HILABS_INC
-*
-*
-* hilabs.inc
-*
-*CMZ : 1.18/00 23/04/93 17.27.57 by O.Couet
-*-- Author :
- PARAMETER (MAXLAB=100)
- CHARACTER*32 HILABS
- COMMON/HILBL1/NHILAB
- COMMON/HILBL2/HILABS(MAXLAB)
-
-
-#endif
diff --git a/src/graflib/higz/higz/hilink.inc b/src/graflib/higz/higz/hilink.inc
deleted file mode 100644
index 6be6931..0000000
--- a/src/graflib/higz/higz/hilink.inc
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id:
-*
-* $Log:
-*
-#ifndef CERNLIB_HIGZ_HILINK_INC
-#define CERNLIB_HIGZ_HILINK_INC
-*
-*
-* hilink.inc
-*
-*-- Author : O.Couet
- COMMON /HILINK/ LHIGZ,LCG,LWV
- +, LPICT,LHNT0,LHI,LHF,LHC,LHNT,LHNTLA
- +, LPICD,LDNT0,LDI,LDF,LDC,LDNT,LDNTLA
- +, LPIC2,L2NT0,L2I,L2F,L2C,L2NT,L2NTLA
- +, LNDECO,LIDECO,LFDECO,LCDECO
- +, LPSAV,LPCOP,LNTCOP,LSTACK(10),LAST
-#endif
diff --git a/src/graflib/higz/higz/hiloc.inc b/src/graflib/higz/higz/hiloc.inc
deleted file mode 100644
index d313f82..0000000
--- a/src/graflib/higz/higz/hiloc.inc
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: hiloc.inc,v 1.1.1.1 1996/02/14 13:10:15 mclareni Exp $
-*
-* $Log: hiloc.inc,v $
-* Revision 1.1.1.1 1996/02/14 13:10:15 mclareni
-* Higz
-*
-*
-#ifndef CERNLIB_HIGZ_HILOC_INC
-#define CERNLIB_HIGZ_HILOC_INC
-*
-*
-* hiloc.inc
-*
-*CMZ : 1.18/00 23/04/93 17.27.57 by O.Couet
-*-- Author :
- COMMON /HILOC/ OLDXP,OLDYP
-
-
-#endif
diff --git a/src/graflib/higz/higz/hilun.inc b/src/graflib/higz/higz/hilun.inc
deleted file mode 100644
index 5cb0c01..0000000
--- a/src/graflib/higz/higz/hilun.inc
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: hilun.inc,v 1.1.1.1 1996/02/14 13:10:13 mclareni Exp $
-*
-* $Log: hilun.inc,v $
-* Revision 1.1.1.1 1996/02/14 13:10:13 mclareni
-* Higz
-*
-*
-#ifndef CERNLIB_HIGZ_HILUN_INC
-#define CERNLIB_HIGZ_HILUN_INC
-*
-*
-* hilun.inc
-*
-*CMZ : 1.18/00 23/04/93 17.27.56 by O.Couet
-*-- Author :
- COMMON /HILUN/ LUNIN,LUNOUT,LUNERR
-
-
-#endif
diff --git a/src/graflib/higz/higz/hilut.inc b/src/graflib/higz/higz/hilut.inc
deleted file mode 100644
index 984ae65..0000000
--- a/src/graflib/higz/higz/hilut.inc
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: hilut.inc,v 1.2 2005/10/28 12:37:57 couet Exp $
-*
-* $Log: hilut.inc,v $
-* Revision 1.2 2005/10/28 12:37:57 couet
-* - SVG driver, workstation type -779
-*
-* Revision 1.1.1.1 1996/02/14 13:10:15 mclareni
-* Higz
-*
-*
-#ifndef CERNLIB_HIGZ_HILUT_INC
-#define CERNLIB_HIGZ_HILUT_INC
-*
-*
-* hilut.inc
-*
-*CMZ : 1.18/00 23/04/93 17.27.57 by O.Couet
-*-- Author :
- PARAMETER (NBCLUT=1024)
- COMMON /HILUT/ REDLUT(NBCLUT),GRNLUT(NBCLUT),BLULUT(NBCLUT)
-
-
-#endif
diff --git a/src/graflib/higz/higz/himail.inc b/src/graflib/higz/higz/himail.inc
deleted file mode 100644
index 75a2058..0000000
--- a/src/graflib/higz/higz/himail.inc
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: himail.inc,v 1.2 1996/04/16 08:11:17 couet Exp $
-*
-* $Log: himail.inc,v $
-* Revision 1.2 1996/04/16 08:11:17 couet
-* delete blank lines
-*
-* Revision 1.1.1.1 1996/02/14 13:10:15 mclareni
-* Higz
-*
-*
-#ifndef CERNLIB_HIGZ_HIMAIL_INC
-#define CERNLIB_HIGZ_HIMAIL_INC
-*
-*
-* himail.inc
-*
-*CMZ : 1.18/00 23/04/93 17.27.57 by O.Couet
-*-- Author :
- COMMON /HIMAIC/ CHMAIL,CHOPTM,CHCTRL,CHEOR,ALIGN2
- CHARACTER*2 CHCTRL
- CHARACTER*1 CHEOR,ALIGN2
- CHARACTER*80 CHMAIL,CHOPTM
-#endif
diff --git a/src/graflib/higz/higz/himdos.inc b/src/graflib/higz/higz/himdos.inc
deleted file mode 100644
index e748d08..0000000
--- a/src/graflib/higz/higz/himdos.inc
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: himdos.inc,v 1.1.1.1 1996/02/14 13:10:14 mclareni Exp $
-*
-* $Log: himdos.inc,v $
-* Revision 1.1.1.1 1996/02/14 13:10:14 mclareni
-* Higz
-*
-*
-#ifndef CERNLIB_HIGZ_HIMDOS_INC
-#define CERNLIB_HIGZ_HIMDOS_INC
-*
-*
-* himdos.inc
-*
-*CMZ : 1.18/00 23/04/93 17.27.57 by O.Couet
-*-- Author :
- COMMON /HIMDOS/ IPICNM,SCMETA
-
-#endif
diff --git a/src/graflib/higz/higz/himenu.inc b/src/graflib/higz/higz/himenu.inc
deleted file mode 100644
index 29ffa68..0000000
--- a/src/graflib/higz/higz/himenu.inc
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: himenu.inc,v 1.1.1.1 1996/02/14 13:10:14 mclareni Exp $
-*
-* $Log: himenu.inc,v $
-* Revision 1.1.1.1 1996/02/14 13:10:14 mclareni
-* Higz
-*
-*
-#ifndef CERNLIB_HIGZ_HIMENU_INC
-#define CERNLIB_HIGZ_HIMENU_INC
-*
-*
-* himenu.inc
-*
-*CMZ : 1.18/00 23/04/93 17.27.57 by O.Couet
-*-- Author :
- COMMON /HIMENU/ Y3,Y4,YT,XSIZ,YSIZ,RINT,REDLOC,NBCHOI,ICUCH,DEC
- +,OTH,TH,XPOS(2),YPOS(2),IRSU,ILSU,XM,XML,XMR,YSTEP,XP,YP
- +,XOPT,IPARA,ISOFT,NBUSER,UTH,USIZ,ISEGM(100),MENNUM
-
-
-#endif
diff --git a/src/graflib/higz/higz/himet2.inc b/src/graflib/higz/higz/himet2.inc
deleted file mode 100644
index 4e54085..0000000
--- a/src/graflib/higz/higz/himet2.inc
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: himet2.inc,v 1.1.1.1 1996/02/14 13:10:14 mclareni Exp $
-*
-* $Log: himet2.inc,v $
-* Revision 1.1.1.1 1996/02/14 13:10:14 mclareni
-* Higz
-*
-*
-#ifndef CERNLIB_HIGZ_HIMET2_INC
-#define CERNLIB_HIGZ_HIMET2_INC
-*
-*
-* himet2.inc
-*
-*CMZ : 1.18/00 23/04/93 17.27.57 by O.Couet
-*-- Author :
- COMMON /HIMET2/ ITGKS,METDEF,IFUSER
-
-
-#endif
diff --git a/src/graflib/higz/higz/himeta.inc b/src/graflib/higz/higz/himeta.inc
deleted file mode 100644
index 19f8993..0000000
--- a/src/graflib/higz/higz/himeta.inc
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: himeta.inc,v 1.1.1.1 1996/02/14 13:10:14 mclareni Exp $
-*
-* $Log: himeta.inc,v $
-* Revision 1.1.1.1 1996/02/14 13:10:14 mclareni
-* Higz
-*
-*
-#ifndef CERNLIB_HIGZ_HIMETA_INC
-#define CERNLIB_HIGZ_HIMETA_INC
-*
-*
-* himeta.inc
-*
-*CMZ : 1.18/00 23/04/93 17.27.57 by O.Couet
-*-- Author :
- COMMON /HIMETA/ IDMETA,XMFACT,YMFACT,TEKACT,METACT,FILOPN
- LOGICAL TEKACT,METACT,FILOPN
- COMMON /HIMETC/ CHMETA
- CHARACTER*24 CHMETA
-#if defined(CERNLIB_MSDOS)
-#include "higz/himdos.inc"
-#endif
-
-
-#endif
diff --git a/src/graflib/higz/higz/hint.inc b/src/graflib/higz/higz/hint.inc
deleted file mode 100644
index f764db7..0000000
--- a/src/graflib/higz/higz/hint.inc
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: hint.inc,v 1.1.1.1 1996/02/14 13:10:13 mclareni Exp $
-*
-* $Log: hint.inc,v $
-* Revision 1.1.1.1 1996/02/14 13:10:13 mclareni
-* Higz
-*
-*
-#ifndef CERNLIB_HIGZ_HINT_INC
-#define CERNLIB_HIGZ_HINT_INC
-*
-*
-* hint.inc
-*
-*CMZ : 1.18/00 23/04/93 17.27.56 by O.Couet
-*-- Author :
- PARAMETER (INWDNT=2)
- PARAMETER (NBNTMX=100)
- COMMON /HINT/ NTSTOR(INWDNT*NBNTMX+1),WNVPST(8*NBNTMX)
-
-
-#endif
diff --git a/src/graflib/higz/higz/hipack.inc b/src/graflib/higz/higz/hipack.inc
deleted file mode 100644
index 4cd22af..0000000
--- a/src/graflib/higz/higz/hipack.inc
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: hipack.inc,v 1.1.1.1 1996/02/14 13:10:15 mclareni Exp $
-*
-* $Log: hipack.inc,v $
-* Revision 1.1.1.1 1996/02/14 13:10:15 mclareni
-* Higz
-*
-*
-#ifndef CERNLIB_HIGZ_HIPACK_INC
-#define CERNLIB_HIGZ_HIPACK_INC
-*
-*
-* hipack.inc
-*
-*CMZ : 1.22/08 24/02/95 17.10.52 by O.Couet
-*-- Author :
- COMMON /HIPACK/ NCX,NCY,IPACK,ILOG,ZLOW,ZHIGH,IDIM1,IOPTER
-
-
-#endif
diff --git a/src/graflib/higz/higz/hipaw.inc b/src/graflib/higz/higz/hipaw.inc
deleted file mode 100644
index 304ea21..0000000
--- a/src/graflib/higz/higz/hipaw.inc
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: hipaw.inc,v 1.2 2001/12/07 14:57:44 couet Exp $
-*
-* $Log: hipaw.inc,v $
-* Revision 1.2 2001/12/07 14:57:44 couet
-* - HILINK common block move to the hilink.inc include file.
-*
-* Revision 1.1.1.1 1996/02/14 13:10:13 mclareni
-* Higz
-*
-*
-#ifndef CERNLIB_HIGZ_HIPAW_INC
-#define CERNLIB_HIGZ_HIPAW_INC
-*
-*
-* hipaw.inc
-*
-*-- Author : O.Couet
- COMMON /PAWC/ NWPAW,IXPAWC,IHBOOK,IXHIGZ,IXKU,IFENCE(5)
- +, LMAIN, IPAW(9989)
- DIMENSION IQ(2),Q(2),LQ(8000)
- EQUIVALENCE (Q(1),IQ(1),LQ(9)),(LQ(1),LMAIN)
- COMMON /QUEST/ IQUEST(100)
- DIMENSION RQUEST(100)
- EQUIVALENCE (IQUEST(1),RQUEST(1))
-#include "higz/hilink.inc"
- COMMON /HIPTR/ ITBPTR,INTPTR,IFLPTR,ISTPTR
- +, IIAPTR,IRAPTR
- COMMON /HISIZE/ INSIZ,IISIZ,IFSIZ,ISSIZ
- +, IRNSIZ,IRISIZ,IRFSIZ,IRSSIZ
- COMMON /HINUM/ NBPICT,INBNT,INBLEV
-#endif
diff --git a/src/graflib/higz/higz/hiphig.inc b/src/graflib/higz/higz/hiphig.inc
deleted file mode 100644
index 6053daa..0000000
--- a/src/graflib/higz/higz/hiphig.inc
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: hiphig.inc,v 1.1.1.1 1996/02/14 13:10:18 mclareni Exp $
-*
-* $Log: hiphig.inc,v $
-* Revision 1.1.1.1 1996/02/14 13:10:18 mclareni
-* Higz
-*
-*
-#ifndef CERNLIB_HIGZ_HIPHIG_INC
-#define CERNLIB_HIGZ_HIPHIG_INC
-*
-* COMMON BLOCK for the PHIGS interface
-*
-* hiphig.inc
-*
-#if defined(CERNLIB_PHIGS)
- COMMON /HIPHIG/ LOSTOP,LOSTEX,ICSTN
- LOGICAL LOSTOP,LOSTEX
-#endif
-
-#endif
diff --git a/src/graflib/higz/higz/hipick.inc b/src/graflib/higz/higz/hipick.inc
deleted file mode 100644
index 57a35b0..0000000
--- a/src/graflib/higz/higz/hipick.inc
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: hipick.inc,v 1.1.1.1 1996/02/14 13:10:16 mclareni Exp $
-*
-* $Log: hipick.inc,v $
-* Revision 1.1.1.1 1996/02/14 13:10:16 mclareni
-* Higz
-*
-*
-#ifndef CERNLIB_HIGZ_HIPICK_INC
-#define CERNLIB_HIGZ_HIPICK_INC
-*
-*
-* hipick.inc
-*
-*CMZ : 1.18/00 23/04/93 17.27.57 by O.Couet
-*-- Author :
- PARAMETER (LEVLEN=16)
- COMMON /HIPICK/ CHLVL,CHLVL2
- CHARACTER*(LEVLEN) CHLVL,CHLVL2
-
-
-#endif
diff --git a/src/graflib/higz/higz/hipost.inc b/src/graflib/higz/higz/hipost.inc
deleted file mode 100644
index 521dda9..0000000
--- a/src/graflib/higz/higz/hipost.inc
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: hipost.inc,v 1.3 2005/10/28 12:37:57 couet Exp $
-*
-* $Log: hipost.inc,v $
-* Revision 1.3 2005/10/28 12:37:57 couet
-* - SVG driver, workstation type -779
-*
-* Revision 1.2 1999/07/21 15:48:10 couet
-* - Improvements in PS Patterns drawing
-*
-* Revision 1.1.1.1 1996/02/14 13:10:15 mclareni
-* Higz
-*
-*
-#ifndef CERNLIB_HIGZ_HIPOST_INC
-#define CERNLIB_HIGZ_HIPOST_INC
-*
-*
-* hipost.inc
-*
-*-- Author : O.Couet
- COMMON /HIPOST/ X1V,X2V,Y1V,Y2V,X1W,X2W,Y1W,Y2W,FX,FY
- +,LUNPS,LENBUF,IPSCI,PSRED,PSGRN,PSBLU,IPSMSC
- +,IPSLT,IPSLW,IPSWID,IPSI,IPSWTY,IPTWTY,LENBMX,IPATD
- +,XVP1,XVP2,YVP1,YVP2,XVS1,XVS2,YVS1,YVS2,XPSR,YPSR
- +,NX,NY,IXZ,IYZ,MODE,NPAGES,IPCLIP,IPDXC,IPDYC,IPXC,IPYC
- +,LOPRT,LOBB,LOCLR,LOPRNG,LOSCLI,LOZONE,NBSAVE,NBSAV0
- +,IYSVG
- LOGICAL LOPRT,LOBB,LOCLR,LOPRNG,LOSCLI,LOZONE
- COMMON /HIPOSC/ STRBUF,BSLASH,ALIGN1
- CHARACTER*132 STRBUF
- CHARACTER*1 BSLASH
- CHARACTER*3 ALIGN1
-#endif
diff --git a/src/graflib/higz/higz/hiques.inc b/src/graflib/higz/higz/hiques.inc
deleted file mode 100644
index ff62f26..0000000
--- a/src/graflib/higz/higz/hiques.inc
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: hiques.inc,v 1.1.1.1 1996/02/14 13:10:13 mclareni Exp $
-*
-* $Log: hiques.inc,v $
-* Revision 1.1.1.1 1996/02/14 13:10:13 mclareni
-* Higz
-*
-*
-#ifndef CERNLIB_HIGZ_HIQUES_INC
-#define CERNLIB_HIGZ_HIQUES_INC
-*
-*
-* hiques.inc
-*
-*CMZ : 1.18/00 23/04/93 17.27.56 by O.Couet
-*-- Author :
- COMMON /QUEST/ IQUEST(100)
- DIMENSION RQUEST(100)
- EQUIVALENCE (IQUEST(1),RQUEST(1))
-
-
-#endif
diff --git a/src/graflib/higz/higz/hisava.inc b/src/graflib/higz/higz/hisava.inc
deleted file mode 100644
index ac4b097..0000000
--- a/src/graflib/higz/higz/hisava.inc
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: hisava.inc,v 1.1.1.1 1996/02/14 13:10:14 mclareni Exp $
-*
-* $Log: hisava.inc,v $
-* Revision 1.1.1.1 1996/02/14 13:10:14 mclareni
-* Higz
-*
-*
-#ifndef CERNLIB_HIGZ_HISAVA_INC
-#define CERNLIB_HIGZ_HISAVA_INC
-*
-*
-* hisava.inc
-*
-*CMZ : 1.18/00 23/04/93 17.27.57 by O.Couet
-*-- Author :
- COMMON /HISAVA/ ISAVA(NBIATT),RSAVA(NBRATT)
-
-
-#endif
diff --git a/src/graflib/higz/higz/hisave.inc b/src/graflib/higz/higz/hisave.inc
deleted file mode 100644
index cb9fabc..0000000
--- a/src/graflib/higz/higz/hisave.inc
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: hisave.inc,v 1.1.1.1 1996/02/14 13:10:14 mclareni Exp $
-*
-* $Log: hisave.inc,v $
-* Revision 1.1.1.1 1996/02/14 13:10:14 mclareni
-* Higz
-*
-*
-#ifndef CERNLIB_HIGZ_HISAVE_INC
-#define CERNLIB_HIGZ_HISAVE_INC
-*
-*
-* hisave.inc
-*
-*CMZ : 1.18/00 23/04/93 17.27.57 by O.Couet
-*-- Author :
- COMMON /HISAVE/ ISAVE(NBIATT),RSAVE(NBRATT),ISVNT,WNVPSV(8)
-
-
-#endif
diff --git a/src/graflib/higz/higz/hisved.inc b/src/graflib/higz/higz/hisved.inc
deleted file mode 100644
index 1b10bf2..0000000
--- a/src/graflib/higz/higz/hisved.inc
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: hisved.inc,v 1.1.1.1 1996/02/14 13:10:14 mclareni Exp $
-*
-* $Log: hisved.inc,v $
-* Revision 1.1.1.1 1996/02/14 13:10:14 mclareni
-* Higz
-*
-*
-#ifndef CERNLIB_HIGZ_HISVED_INC
-#define CERNLIB_HIGZ_HISVED_INC
-*
-*
-* hisved.inc
-*
-*CMZ : 1.18/00 23/04/93 17.27.57 by O.Couet
-*-- Author :
- COMMON /HISVED/ ISAVED(NBIATT),RSAVED(NBRATT)
-
-
-#endif
diff --git a/src/graflib/higz/higz/hivers.inc b/src/graflib/higz/higz/hivers.inc
deleted file mode 100644
index 6435c87..0000000
--- a/src/graflib/higz/higz/hivers.inc
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: hivers.inc,v 1.1.1.1 1996/02/14 13:10:13 mclareni Exp $
-*
-* $Log: hivers.inc,v $
-* Revision 1.1.1.1 1996/02/14 13:10:13 mclareni
-* Higz
-*
-*
-#ifndef CERNLIB_HIGZ_HIVERS_INC
-#define CERNLIB_HIGZ_HIVERS_INC
-*
-*
-* hivers.inc
-*
-*CMZ : 1.18/00 23/04/93 17.50.07 by O.Couet
-*-- Author :
- COMMON /HIVERS/ CHVERS
- CHARACTER*8 CHVERS
-*
-* hivers.inc
-*
-#if defined(CERNLIB_MSDOS)
- character*52 CHVERS
- DATA
- * CHVERS /' 1.14/13D (FineSoft,JINR, fine at main2.jinr.dubna.su)'/
-#endif
-
-#endif
diff --git a/src/graflib/higz/higz/hiwcdc.inc b/src/graflib/higz/higz/hiwcdc.inc
deleted file mode 100644
index 547784c..0000000
--- a/src/graflib/higz/higz/hiwcdc.inc
+++ /dev/null
@@ -1,79 +0,0 @@
-*
-* $Id: hiwcdc.inc,v 1.3 1998/01/28 14:34:09 couet Exp $
-*
-* $Log: hiwcdc.inc,v $
-* Revision 1.3 1998/01/28 14:34:09 couet
-* - GGDM driver removed
-*
-* Revision 1.2 1996/09/25 14:57:10 couet
-* - GPR driver removed
-*
-* Revision 1.1.1.1 1996/02/14 13:10:17 mclareni
-* Higz
-*
-*
-#ifndef CERNLIB_HIGZ_HIWCDC_INC
-#define CERNLIB_HIGZ_HIWCDC_INC
-*
-* Convert WC to DC for the GL interface
-*
-* hiwcdc.inc
-*
-#if (defined(CERNLIB_KERNEL))&&(!defined(CERNLIB_MSDOS))
-#if defined(CERNLIB_GL)
- IXWCDC(U)=INT(WKSC(IWKNB)*(RVXMIN+XRATIO*(U-RWXMIN)))
- IYWCDC(V)=INT(WKSC(IWKNB)*(RVYMIN+YRATIO*(V-RWYMIN)))
-
-#endif
-#endif
-*
-* Convert WC to DC for X11
-*
-* hiwcdc.inc
-*
-#if (defined(CERNLIB_KERNEL))&&(!defined(CERNLIB_MSDOS))
-#if (defined(CERNLIB_X11))&&(defined(CERNLIB_VAX))
- IXWCDC(U)=MAX(MIN(XWKV1(IWKNB)+
- +XWKR(IWKNB)*(XRATIO*(U-RWXMIN)+RVXMIN-XWKW1(IWKNB))
- +,32767.),-32766.)
- IYWCDC(V)=MAX(MIN(YWKSIZ(IWKNB)-(YWKV1(IWKNB)+
- +YWKR(IWKNB)*(YRATIO*(V-RWYMIN)+RVYMIN-YWKW1(IWKNB)))
- +,32767.),-32766.)
-
-#endif
-#endif
-*
-* Convert WC to DC for X11
-*
-#if (defined(CERNLIB_KERNEL))&&(!defined(CERNLIB_MSDOS))
-#if (defined(CERNLIB_X11))&&(!defined(CERNLIB_VAX))
- IXWCDC(U)=XWKV1(IWKNB)+
- +XWKR(IWKNB)*(XRATIO*(U-RWXMIN)+RVXMIN-XWKW1(IWKNB))
- IYWCDC(V)=YWKSIZ(IWKNB)-(YWKV1(IWKNB)+
- +YWKR(IWKNB)*(YRATIO*(V-RWYMIN)+RVYMIN-YWKW1(IWKNB)))
-
-#endif
-#endif
-*
-* Convert WC to DC for MacIntosh
-*
-* hiwcdc.inc
-*
-#if (defined(CERNLIB_KERNEL))&&(!defined(CERNLIB_MSDOS))
-#if defined(CERNLIB_MACMPW)
- IXWCDC(U)=WKSC(IWKNB)*(RVXMIN+XRATIO*(U-RWXMIN))
- IYWCDC(V)=YWKSIZ(IWKNB)-WKSC(IWKNB)*(RVYMIN+YRATIO*(V-RWYMIN))
-#endif
-#endif
-*
-* Convert WC to DC for the PC AT 386/486 interface
-*
-* hiwcdc.inc
-*
-#if defined(CERNLIB_MSDOS)
- IXWCDC(U)=NINT(WKSC(IWKNB)*(RVXMIN+XRATIO*(U-RWXMIN)))
- IYWCDC(V)=NINT(YWKSIZ(IWKNB)
- * -WKSC(IWKNB)*(RVYMIN+YRATIO*(V-RWYMIN)))
-#endif
-
-#endif
diff --git a/src/graflib/higz/higz/hiwcps.inc b/src/graflib/higz/higz/hiwcps.inc
deleted file mode 100644
index 2fc8beb..0000000
--- a/src/graflib/higz/higz/hiwcps.inc
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: hiwcps.inc,v 1.1.1.1 1996/02/14 13:10:15 mclareni Exp $
-*
-* $Log: hiwcps.inc,v $
-* Revision 1.1.1.1 1996/02/14 13:10:15 mclareni
-* Higz
-*
-*
-#ifndef CERNLIB_HIGZ_HIWCPS_INC
-#define CERNLIB_HIGZ_HIWCPS_INC
-*
-*
-* hiwcps.inc
-*
-*CMZ : 1.18/00 23/04/93 17.27.57 by O.Couet
-*-- Author :
- IXWCPS(U)=NINT(4.*WKMAX(IPSI)*(FX*(U-X1W)+X1V))
- IYWCPS(V)=NINT(4.*WKMAX(IPSI)*(FY*(V-Y1W)+Y1V))
-
-#endif
diff --git a/src/graflib/higz/higz/hiwcsv.inc b/src/graflib/higz/higz/hiwcsv.inc
deleted file mode 100644
index fdf839a..0000000
--- a/src/graflib/higz/higz/hiwcsv.inc
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: hiwcsv.inc,v 1.1 2006/08/31 13:55:47 couet Exp $
-*
-* $Log: hiwcsv.inc,v $
-* Revision 1.1 2006/08/31 13:55:47 couet
-* - Needed for the SVG driver
-*
-* Revision 1.1.1.1 1996/02/14 13:10:15 mclareni
-* Higz
-*
-*
-#ifndef CERNLIB_HIGZ_HIWCSV_INC
-#define CERNLIB_HIGZ_HIWCSV_INC
-*
-*
-* hiwcps.inc
-*
-*-- Author : O.Couet
- IXWCSV(U)=NINT(WKMAX(IPSI)*(FX*(U-X1W)+X1V))
- IYWCSV(V)=IYSVG-NINT(WKMAX(IPSI)*(FY*(V-Y1W)+Y1V))
-
-#endif
diff --git a/src/graflib/higz/higz/icmtop.inc b/src/graflib/higz/higz/icmtop.inc
deleted file mode 100644
index 3bf760f..0000000
--- a/src/graflib/higz/higz/icmtop.inc
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: icmtop.inc,v 1.1.1.1 1996/02/14 13:10:15 mclareni Exp $
-*
-* $Log: icmtop.inc,v $
-* Revision 1.1.1.1 1996/02/14 13:10:15 mclareni
-* Higz
-*
-*
-#ifndef CERNLIB_HIGZ_ICMTOP_INC
-#define CERNLIB_HIGZ_ICMTOP_INC
-*
-*
-* icmtop.inc
-*
-*CMZ : 1.18/00 23/04/93 17.27.57 by O.Couet
-*-- Author :
- ICMTOP(U)=NINT(72.*U/2.54)
-
-#endif
diff --git a/src/graflib/higz/higz/ihdes.inc b/src/graflib/higz/higz/ihdes.inc
deleted file mode 100644
index fd5fb34..0000000
--- a/src/graflib/higz/higz/ihdes.inc
+++ /dev/null
@@ -1,15 +0,0 @@
-*
-* $Id: ihdes.inc,v 1.1.1.1 1996/02/14 13:10:16 mclareni Exp $
-*
-* $Log: ihdes.inc,v $
-* Revision 1.1.1.1 1996/02/14 13:10:16 mclareni
-* Higz
-*
-*
-#ifndef CERNLIB_HIGZ_IHDES_INC
-#define CERNLIB_HIGZ_IHDES_INC
-*
-*CMZ : 1.19/05 26/08/93 09.41.02 by O.Couet
-*-- Author :
-
-#endif
diff --git a/src/graflib/higz/higz/kerdes.inc b/src/graflib/higz/higz/kerdes.inc
deleted file mode 100644
index aabf085..0000000
--- a/src/graflib/higz/higz/kerdes.inc
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: kerdes.inc,v 1.1.1.1 1996/02/14 13:10:17 mclareni Exp $
-*
-* $Log: kerdes.inc,v $
-* Revision 1.1.1.1 1996/02/14 13:10:17 mclareni
-* Higz
-*
-*
-#ifndef CERNLIB_HIGZ_KERDES_INC
-#define CERNLIB_HIGZ_KERDES_INC
-*
-#if (defined(CERNLIB_KERNEL))&&(!defined(CERNLIB_MSDOS))
-*CMZ : 1.20/07 13/01/94 18.14.47 by O.Couet
-*-- Author :
-#endif
-
-#endif
diff --git a/src/graflib/higz/higz/msdes.inc b/src/graflib/higz/higz/msdes.inc
deleted file mode 100644
index 87848b4..0000000
--- a/src/graflib/higz/higz/msdes.inc
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: msdes.inc,v 1.1.1.1 1996/02/14 13:10:18 mclareni Exp $
-*
-* $Log: msdes.inc,v $
-* Revision 1.1.1.1 1996/02/14 13:10:18 mclareni
-* Higz
-*
-*
-#ifndef CERNLIB_HIGZ_MSDES_INC
-#define CERNLIB_HIGZ_MSDES_INC
-*
-#if defined(CERNLIB_MSDOS)
-*CMZ : 1.14/13 03/07/92 12.05.59 by O.Couet
-*-- Author :
-#endif
-
-#endif
diff --git a/src/graflib/higz/higz/phigsdes.inc b/src/graflib/higz/higz/phigsdes.inc
deleted file mode 100644
index c63eda0..0000000
--- a/src/graflib/higz/higz/phigsdes.inc
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: phigsdes.inc,v 1.1.1.1 1996/02/14 13:10:18 mclareni Exp $
-*
-* $Log: phigsdes.inc,v $
-* Revision 1.1.1.1 1996/02/14 13:10:18 mclareni
-* Higz
-*
-*
-#ifndef CERNLIB_HIGZ_PHIGSDES_INC
-#define CERNLIB_HIGZ_PHIGSDES_INC
-*
-#if defined(CERNLIB_PHIGS)
-*CMZ : 1.18/02 12/05/93 09.27.30 by O.Couet
-*-- Author :
-#endif
-
-#endif
diff --git a/src/graflib/higz/higz/pilot.h b/src/graflib/higz/higz/pilot.h
deleted file mode 100644
index 83039ed..0000000
--- a/src/graflib/higz/higz/pilot.h
+++ /dev/null
@@ -1,158 +0,0 @@
-#if defined(CERNLIB_GKSGRAL) || defined(CERNLIB_MKGS) \
- || defined(CERNLIB_PLOT10GKS) || defined(CERNLIB_UNIGKS) \
- || defined(CERNLIB_DECGKS) || defined(CERNLIB_GK2000) \
- || defined(CERNLIB_ATCGKS) || defined(CERNLIB_GKSBX)
-#ifndef CERNLIB_GKS
-#define CERNLIB_GKS
-#endif
-#endif
-
-#ifndef CERNLIB_GKS
-
-#ifndef CERNLIB_X11
-#define CERNLIB_X11
-#endif
-
-#ifndef CERNLIB_FALCO
-#define CERNLIB_FALCO
-#endif
-
-#endif
-
-#ifndef CERNLIB_NTC
-#define CERNLIB_NTC
-#endif
-
-#ifndef CERNLIB_PSCRIPT
-#define CERNLIB_PSCRIPT
-#endif
-
-#ifndef CERNLIB_ZEBRA
-#define CERNLIB_ZEBRA
-#endif
-
-#if defined(CERNLIB_ALPHA)
-#ifndef CERNLIB_VAX
-#define CERNLIB_VAX
-#endif
-#endif
-
-#if defined(CERNLIB_WINNT) || defined(CERNLIB_TK_WINDOWS)
-#ifndef CERNLIB_X11
-#define CERNLIB_X11
-#endif
-#endif
-
-#if (defined(CERNLIB_MSDOS) || defined(CERNLIB_LINUX) ) && !defined(CERNLIB_WINNT)
-#ifndef CERNLIB_F2C
-#define CERNLIB_F2C
-#endif
-#endif
-
-#if defined(CERNLIB_SUN) || defined(CERNLIB_SGI) || \
- defined(CERNLIB_DECS) || defined(CERNLIB_IBMRT) || \
- defined(CERNLIB_HPUX) || \
- defined(CERNLIB_IPSC) || \
- defined(CERNLIB_F2C) || defined(CERNLIB_QMALPH) || \
- defined(CERNLIB_WINNT)
-#ifndef CERNLIB_BSLASH
-#define CERNLIB_BSLASH
-#endif
-#endif
-
-#ifdef CERNLIB_QFMSOFT
-#ifdef CERNLIB_BSLASH
-#undef CERNLIB_BSLASH
-#endif
-#endif
-
-#if defined(CERNLIB_SUNGKS) || defined(CERNLIB_GKSIBM)
-#ifndef CERNLIB_GKSGRAL
-#define CERNLIB_GKSGRAL
-#endif
-#endif
-
-#if defined(CERNLIB_GKSGRAL) || defined(CERNLIB_MGKS) || \
- defined(CERNLIB_PLOT10GKS) || defined(CERNLIB_UNIGKS) || \
- defined(CERNLIB_DECGKS) || defined(CERNLIB_GK2000) || \
- defined(CERNLIB_ATCGKS) || defined(CERNLIB_GKSBX)
-#ifndef CERNLIB_GKS
-#define CERNLIB_GKS
-#endif
-#endif
-
-#if defined(CERNLIB_MSDOS)
-#ifndef CERNLIB_CIPACK
-#define CERNLIB_CIPACK
-#endif
-#ifndef CERNLIB_GL
-#define CERNLIB_GL
-#endif
-#endif
-
-#if defined(CERNLIB_X11)
-#ifndef CERNLIB_ZBUF
-#define CERNLIB_ZBUF
-#endif
-
-#if !defined(CERNLIB_GIF) && !defined(CERNLIB_WINNT)
-#define CERNLIB_GIF
-#endif
-#endif
-
-#if defined(CERNLIB_GL) || \
- defined(CERNLIB_X11) || \
- defined(CERNLIB_MACMPW) || \
- defined(CERNLIB_MSDOS) || \
- defined(CERNLIB_WINNT)
-#ifndef CERNLIB_KERNEL
-#define CERNLIB_KERNEL
-#endif
-#endif
-
-#if defined(CERNLIB_CRAY) || defined(CERNLIB_VAX) || \
- defined(CERNLIB_IBM)
-#ifndef CERNLIB_QXNO_SC
-#define CERNLIB_QXNO_SC
-#endif
-#endif
-
-#if defined(CERNLIB_SGI) || defined(CERNLIB_IBMRT) || \
- defined(CERNLIB_SUN) || defined(CERNLIB_CONVEX) || \
- defined(CERNLIB_DECS) || defined(CERNLIB_AIX370) || \
- defined(CERNLIB_HPUX) || \
- defined(CERNLIB_NEXT) || defined(CERNLIB_CONVEX) || \
- defined(CERNLIB_F2C)
-#ifndef CERNLIB_QX_SC
-#define CERNLIB_QX_SC
-#endif
-#endif
-
-#ifdef CERNLIB_MSSTDCALL
-# ifndef CERNLIB_QXCAPT
-# define CERNLIB_QXCAPT
-# endif
-#define type_of_call __stdcall
-#endif
-
-#ifndef type_of_call
-# define type_of_call
-#endif
-
-#if defined(CERNLIB_PHIGS)
-#ifndef CERNLIB_NOVERS
-#define CERNLIB_NOVERS
-#endif
-#endif
-
-#if (defined(CERNLIB_CONVEX)) && (!defined(CERNLIB_SINGLE))
-#ifndef CERNLIB_CVX
-#define CERNLIB_CVX
-#endif
-#endif
-
-#if (defined(CERNLIB_CONVEX)) && (!defined(CERNLIB_SINGLE))
-#ifndef CERNLIB_CVY
-#define CERNLIB_CVY
-#endif
-#endif
diff --git a/src/graflib/higz/higz/pinum.inc b/src/graflib/higz/higz/pinum.inc
deleted file mode 100644
index 9b99ca8..0000000
--- a/src/graflib/higz/higz/pinum.inc
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: pinum.inc,v 1.1.1.1 1996/02/14 13:10:18 mclareni Exp $
-*
-* $Log: pinum.inc,v $
-* Revision 1.1.1.1 1996/02/14 13:10:18 mclareni
-* Higz
-*
-*
-#ifndef CERNLIB_HIGZ_PINUM_INC
-#define CERNLIB_HIGZ_PINUM_INC
-*
-*
-* pinum.inc
-*
-#if defined(CERNLIB_MSDOS)
- PARAMETER (PI=3.1415926, PI2 = 2*PI)
-#endif
-
-#endif
diff --git a/src/graflib/higz/higz/pnvmax.inc b/src/graflib/higz/higz/pnvmax.inc
deleted file mode 100644
index 13d616b..0000000
--- a/src/graflib/higz/higz/pnvmax.inc
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: pnvmax.inc,v 1.1.1.1 1996/02/14 13:10:17 mclareni Exp $
-*
-* $Log: pnvmax.inc,v $
-* Revision 1.1.1.1 1996/02/14 13:10:17 mclareni
-* Higz
-*
-*
-#ifndef CERNLIB_HIGZ_PNVMAX_INC
-#define CERNLIB_HIGZ_PNVMAX_INC
-*
-*
-* pnvmax.inc
-*
- PARAMETER (NVMAX=20)
-
-#endif
diff --git a/src/graflib/higz/higzcc/Imakefile b/src/graflib/higz/higzcc/Imakefile
deleted file mode 100644
index 7907cee..0000000
--- a/src/graflib/higz/higzcc/Imakefile
+++ /dev/null
@@ -1,39 +0,0 @@
-DoIncludePackage(higz)
-#include "pilot.h"
-
-SRCS_C= igvers.c
-
-#if defined(CERNLIB_FALCO) && !defined(CERNLIB_VAX)
-SRCS_C := $(SRCS_C) falint.c
-#endif
-
-#if defined(CERNLIB_GIF)
-SRCS_C := $(SRCS_C) gifdecode.c gifencode.c imgpickpalette.c imgscaling.c
-#endif
-
-#if defined(CERNLIB_UNIX) && defined(CERNLIB_CCREAD)
-SRCS_C := $(SRCS_C) ixgetl.c
-#endif
-
-#if defined(CERNLIB_NTC)
-SRCS_C := $(SRCS_C) ntmgt.c
-#endif
-
-#if defined(CERNLIB_X11) && !defined(CERNLIB_WINNT)
-SRCS_C := $(SRCS_C) rotated.c x11int.c
-#endif
-
-#if defined(CERNLIB_TKTCL)
-SRCS_C := $(SRCS_C) tkhigz.c
-#endif
-
-#if defined(CERNLIB_ZBUF)
-SRCS_C := $(SRCS_C) zbuffer.c
-#endif
-
-#if defined(CERNLIB_X11)
-INCLUDES:= $(INCLUDES) X11Includes
-#endif
-
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/graflib/higz/higzcc/Imakefile.dgks b/src/graflib/higz/higzcc/Imakefile.dgks
deleted file mode 100644
index eff676a..0000000
--- a/src/graflib/higz/higzcc/Imakefile.dgks
+++ /dev/null
@@ -1,45 +0,0 @@
-DoIncludePackage(higz)
-#include "pilot.h"
-
-SRCS_C= igvers.c
-
-#if defined(CERNLIB_FALCO) && !defined(CERNLIB_VAX)
-SRCS_C := $(SRCS_C) falint.c
-#endif
-
-#if defined(CERNLIB_GIF)
-SRCS_C := $(SRCS_C) gifdecode.c gifencode.c imgpickpalette.c
-#endif
-
-#if defined(CERNLIB_UNIX) && defined(CERNLIB_CCREAD)
-SRCS_C := $(SRCS_C) ixgetl.c
-#endif
-
-#if defined(CERNLIB_NTC)
-SRCS_C := $(SRCS_C) ntmgt.c
-#endif
-
-#if defined(CERNLIB_X11) && !defined(CERNLIB_WINNT)
-SRCS_C := $(SRCS_C) rotated.c x11int.c
-#endif
-
-#if defined(CERNLIB_TKTCL)
-SRCS_C := $(SRCS_C) tkhigz.c
-#endif
-
-#if defined(CERNLIB_ZBUF)
-SRCS_C := $(SRCS_C) zbuffer.c
-#endif
-
-#if defined(CERNLIB_X11)
-INCLUDES:= $(INCLUDES) X11Includes
-#endif
-
-
-SubdirExtraLibraryTarget(NullParameter,NullParameter,NullParameter,dgks)
-
-VersionFortranObjectRule(dgks,NullParameter,-DCERNLIB_DECGKS)
-
-DefaultCObjectRule(dgks)
-
-BuildNamedMakefileTarget(Makefile.dgks,Imakefile.dgks,-DCERNLIB_DECGKS)
diff --git a/src/graflib/higz/higzcc/falint.c b/src/graflib/higz/higzcc/falint.c
deleted file mode 100644
index 760aa79..0000000
--- a/src/graflib/higz/higzcc/falint.c
+++ /dev/null
@@ -1,50 +0,0 @@
-/*
- * $Id: falint.c,v 1.4 1997/10/23 12:29:51 mclareni Exp $
- *
- * $Log: falint.c,v $
- * Revision 1.4 1997/10/23 12:29:51 mclareni
- * NT mods
- *
- * Revision 1.2 1997/03/14 14:22:27 mclareni
- * WNT mods
- *
- * Revision 1.1.1.1.2.1 1997/01/21 11:25:21 mclareni
- * All mods for Winnt 96a on winnt branch
- *
- * Revision 1.1.1.1 1996/02/14 13:10:25 mclareni
- * Higz
- *
- */
-#include "higz/pilot.h"
-#if (defined(CERNLIB_FALCO))&&(!defined(CERNLIB_VAX))
-/*CMZ : 1.23/06 22/11/95 10.36.54 by O.Couet*/
-/*-- Author :*/
-/*
- * C code for HIGZ/FALCO interface
- */
-#ifdef CERNLIB_WINNT
-# include <io.h>
-#endif
-#if defined(CERNLIB_CRAY)
-#define ifput1 IFPUT1
-#endif
-#if defined(CERNLIB_QX_SC)
-#define ifput1 ifput1_
-#endif
-#if (defined(CERNLIB_TKTCL))&&(defined(CERNLIB_WINNT)) || defined(CERNLIB_QFMSOFT)
-#define ifput1 __stdcall IFPUT1
-#endif
-
-static char lbout [256];
-
-void ifput1(bout,ipout)
-int *bout;
-int *ipout;
- {
- int i;
-
- for (i=0 ; i < *ipout ; i++)
- lbout[i] = (char)(bout[i]);
- write(1, lbout, *ipout);
-}
-#endif
diff --git a/src/graflib/higz/higzcc/gifdecode.c b/src/graflib/higz/higzcc/gifdecode.c
deleted file mode 100644
index ec82526..0000000
--- a/src/graflib/higz/higzcc/gifdecode.c
+++ /dev/null
@@ -1,316 +0,0 @@
-/*
- * $Id: gifdecode.c,v 1.1.1.1 1996/02/14 13:10:25 mclareni Exp $
- *
- * $Log: gifdecode.c,v $
- * Revision 1.1.1.1 1996/02/14 13:10:25 mclareni
- * Higz
- *
- */
-#include "higz/pilot.h"
-#if defined(CERNLIB_GIF)
-/*CMZ : 1.23/06 30/11/95 10.45.47 by O.Couet*/
-/*-- Author : O.Couet 30/11/95*/
-#include <stdio.h>
-#include <string.h>
-
-
-#define BITS 12 /* largest code size */
-#define TSIZE 4096 /* tables size */
-
-typedef unsigned char byte;
-
-static int Prefix[TSIZE]; /* prefix table */
-static byte Suffix[TSIZE]; /* suffix table */
-static byte OutCode[TSIZE]; /* output stack */
-
-static byte *ptr1, /* pointer to GIF array */
- *ptr2; /* pointer to PIX array */
-
-static int CurCodeSize, /* current number of bits per code */
- CurMaxCode; /* maximum code, given CurCodeSize */
-
-static long CurBit; /* current bit in GIF image data */
-
-/***************************************************************
- * *
- ***************************************************************/
-static int ReadCode()
-{
- static long b3[3], CurByte;
- static byte lblk;
- int shift, nbyte;
- long OldByte;
-
- if (CurBit == -1) {
- lblk = 0;
- CurByte = -1;
- }
-
- CurBit += CurCodeSize;
- OldByte = CurByte;
- CurByte = CurBit/8;
- nbyte = CurByte - OldByte;
- shift = 17 + (CurBit%8) - CurCodeSize;
- while (nbyte-- > 0) {
- if (lblk == 0) {
- lblk = *ptr1++;
- if (lblk == 0) return -1;
- }
- b3[0] = b3[1];
- b3[1] = b3[2];
- b3[2] = *ptr1++;
- lblk--;
- }
- return (((b3[0]+0x100*b3[1]+0x10000*b3[2])>>shift) & (CurMaxCode-1));
-}
-
-/***************************************************************
- * *
- ***************************************************************/
-static void OutPixel(pix)
- byte pix;
-{
- *ptr2++ = pix;
-}
-
-/***************************************************************
- * *
- * Name: GIFinfo Date: 03.10.94 *
- * *
- * Function: Get information on GIF image *
- * *
- * Input: GIFarr[] - compressed image in GIF format *
- * *
- * Output: Width - image width *
- * Height - image height *
- * Ncols - number of colors *
- * return - 0 - if O.K. *
- * 1 - if error *
- * *
- ***************************************************************/
-int GIFinfo(GIFarr, Width, Height, Ncols)
- byte *GIFarr;
- int *Width,*Height,*Ncols;
-{
- byte b;
-
- ptr1 = GIFarr;
-
- /* R E A D H E A D E R */
-
- if (strncmp((char *)GIFarr,"GIF87a",6) && strncmp((char *)GIFarr,"GIF89a",6))
- {
- fprintf(stderr,"\nGIFinfo: not a GIF\n");
- return 1;
- }
-
- ptr1 += 6;
-
- ptr1 += 2; /* screen width ... ignore */
- ptr1 += 2; /* screen height ... ignore */
-
- b = *ptr1++;
- *Ncols = 1 << ((b & 7) + 1);
- if ((b & 0x80) == 0) { /* is there color map? */
- fprintf(stderr,"\nGIFinfo: warning! no color map\n");
- *Ncols = 0;
- }
-
- ++ptr1; /* background color ... ignore */
- b = *ptr1++; /* supposed to be NULL */
- if (b) {
- fprintf(stderr,"\nGIFdecode: bad screen descriptor\n");
- return 1;
- }
-
- ptr1 += (*Ncols) * 3; /* skip color map */
-
- b = *ptr1++; /* image separator */
- if (b != ',') {
- fprintf(stderr,"\nGIFinfo: no image separator\n");
- return 1;
- }
-
- ptr1 += 2; /* left offset ... ignore */
- ptr1 += 2; /* top offset ... ignore */
- b = *ptr1++; /* image width */
- *Width = b + 0x100*(*ptr1++);
- b = *ptr1++; /* image height */
- *Height = b + 0x100*(*ptr1++);
- return 0;
-}
-
-/***************************************************************
- * *
- * Name: GIFdecode Date: 06.10.92 *
- * *
- * Function: Decode image from GIF array *
- * *
- * Input: GIFarr[] - compressed image in GIF format *
- * *
- * Output: PIXarr[] - image (byte per pixel) *
- * Width - image width *
- * Height - image height *
- * Ncols - number of colors *
- * R[] - red components *
- * G[] - green components *
- * B[] - blue components *
- * return - 0 - if O.K. *
- * 1 - if error *
- * *
- ***************************************************************/
-int GIFdecode(GIFarr, PIXarr, Width, Height, Ncols, R, G, B)
- byte *GIFarr,*PIXarr,*R,*G,*B;
- int *Width,*Height,*Ncols;
-{
- byte b, /* working variable */
- FinChar; /* final character */
-
- int i, /* working variable for loops */
- BitsPixel, /* number of bits per pixel */
- IniCodeSize, /* initial number of bits per code */
- ClearCode, /* reset code */
- EOFCode, /* end of file code */
- FreeCode, /* first unused entry */
- CurCode, /* current code */
- InCode, /* input code */
- OldCode, /* previous code */
- PixMask, /* mask for pixel */
- OutCount; /* output stack counter */
-
- long Npix; /* number of pixels */
-
- ptr1 = GIFarr;
- ptr2 = PIXarr;
-
- /* R E A D H E A D E R */
- if (strncmp((char *)GIFarr,"GIF87a",6) && strncmp((char *)GIFarr,"GIF89a",6))
- {
- fprintf(stderr,"\nGIFinfo: not a GIF\n");
- return 1;
- }
-
- ptr1 += 6;
-
- ptr1 += 2; /* screen width ... ignore */
- ptr1 += 2; /* screen height ... ignore */
-
- b = *ptr1++;
- BitsPixel = (b & 7) + 1; /* # of bits per pixel */
- *Ncols = 1 << BitsPixel;
- PixMask = (*Ncols) - 1; /* mask for pixel code */
- if ((b & 0x80) == 0) { /* is there color map? */
- fprintf(stderr,"\nGIFdecode: warning! no color map\n");
- *Ncols = 0;
- }
-
- ++ptr1; /* background color ... ignore */
- b = *ptr1++; /* supposed to be NULL */
- if (b) {
- fprintf(stderr,"\nGIFdecode: bad screen descriptor\n");
- return 1;
- }
-
- for (i=0; i<(*Ncols); i++) { /* global color map */
- R[i] = *ptr1++;
- G[i] = *ptr1++;
- B[i] = *ptr1++;
- }
-
- b = *ptr1++; /* image separator */
- if (b != ',') {
- fprintf(stderr,"\nGIFdecode: no image separator\n");
- return 1;
- }
-
- ptr1 += 2; /* left offset ... ignore */
- ptr1 += 2; /* top offset ... ignore */
- b = *ptr1++; /* image width */
- *Width = b + 0x100*(*ptr1++);
- b = *ptr1++; /* image height */
- *Height = b + 0x100*(*ptr1++);
-
- b = *ptr1++; /* local colors, interlace */
- if ((b & 0xc0) != 0) {
- fprintf(stderr,
- "\nGIFdecode: unexpected item (local colors or interlace)\n");
- return 1;
- }
-
- IniCodeSize = *ptr1++;
- CurCodeSize = ++IniCodeSize;
- CurMaxCode = (1 << IniCodeSize);
- ClearCode = (1 << (IniCodeSize - 1));
- EOFCode = ClearCode + 1;
- FreeCode = ClearCode + 2;
-
- /* D E C O D E I M A G E */
-
- Npix =(long) (*Width) * (*Height);
- OutCount = 0;
- CurBit = -1;
- CurCode = ReadCode();
- while (Npix > 0) {
-
- if (CurCode < 0) {
- fprintf(stderr,"\nGIFdecode: corrapted GIF (zero block length)\n");
- return 1;
- }
-
- if (CurCode == EOFCode) {
- fprintf(stderr,"\nGIFdecode: corrapted GIF (unexpected EOF)\n");
- return 1;
- }
-
- if (CurCode == ClearCode) { /* clear code ... reset */
-
- CurCodeSize = IniCodeSize;
- CurMaxCode = (1 << IniCodeSize);
- FreeCode = ClearCode + 2;
- OldCode = CurCode = ReadCode();
- FinChar = CurCode;
- OutPixel(FinChar);
- Npix--;
-
- } else { /* image code */
-
- InCode = CurCode;
- if (CurCode >= FreeCode) {
- CurCode = OldCode;
- OutCode[OutCount++] = FinChar;
- }
- while (CurCode > PixMask) { /* build output pixel chain */
- if (OutCount >= TSIZE) {
- fprintf(stderr,"\nGIFdecode: corrapted GIF (big output count)\n");
- return 1;
- }
- OutCode[OutCount++] = Suffix[CurCode];
- CurCode = Prefix[CurCode];
- }
- FinChar = CurCode;
- OutCode[OutCount++] = FinChar;
-
- for (i=OutCount-1; i>=0; i--) { /* put out pixel chain */
- OutPixel(OutCode[i]);
- Npix--;
- }
- OutCount = 0;
-
- Prefix[FreeCode] = OldCode; /* build the tables */
- Suffix[FreeCode] = FinChar;
- OldCode = InCode;
-
- FreeCode++; /* move pointer */
- if (FreeCode >= CurMaxCode) {
- if (CurCodeSize < BITS) {
- CurCodeSize++;
- CurMaxCode *= 2;
- }
- }
- }
- CurCode = ReadCode();
- }
- return 0;
-}
-
-#endif
diff --git a/src/graflib/higz/higzcc/gifencode.c b/src/graflib/higz/higzcc/gifencode.c
deleted file mode 100644
index cd00c48..0000000
--- a/src/graflib/higz/higzcc/gifencode.c
+++ /dev/null
@@ -1,315 +0,0 @@
-/*
- * $Id: gifencode.c,v 1.1.1.1 1996/02/14 13:10:25 mclareni Exp $
- *
- * $Log: gifencode.c,v $
- * Revision 1.1.1.1 1996/02/14 13:10:25 mclareni
- * Higz
- *
- */
-#include "higz/pilot.h"
-#if defined(CERNLIB_GIF)
-/*CMZ : 1.21/10 04/10/94 14.25.09 by O.Couet*/
-/*-- Author : E.Chernyaev 19/01/94*/
-#include <stdio.h>
-#include <stdlib.h>
-
-#ifdef __STDC__
-#define ARGS(alist) alist
-#else
-#define ARGS(alist) ()
-#endif
-
-#define BITS 12 /* largest code size */
-#define THELIMIT 4096 /* NEVER generate this */
-#define HSIZE 5003 /* hash table size */
-#define SHIFT 4 /* shift for hashing */
-
-#define put_byte(A) (*put_b)((byte)(A)); Nbyte++
-
-typedef unsigned char byte;
-
-static long HashTab [HSIZE]; /* hash table */
-static int CodeTab [HSIZE]; /* code table */
-
-static int BitsPixel, /* number of bits per pixel */
- IniCodeSize, /* initial number of bits per code */
- CurCodeSize, /* current number of bits per code */
- CurMaxCode, /* maximum code, given CurCodeSize */
- ClearCode, /* reset code */
- EOFCode, /* end of file code */
- FreeCode; /* first unused entry */
-
-static long Nbyte;
-static void (*put_b) ARGS((byte));
-
-static void output ARGS((int));
-static void char_init();
-static void char_out ARGS((int));
-static void char_flush();
-static void put_short ARGS((int));
-
-/***********************************************************************
- * *
- * Name: GIFencode Date: 02.10.92 *
- * Author: E.Chernyaev (IHEP/Protvino) Revised: *
- * *
- * Function: GIF compression of the image *
- * *
- * Input: Width - image width (must be >= 8) *
- * Height - image height (must be >= 8) *
- * Ncol - number of colors *
- * R[] - red components *
- * G[] - green components *
- * B[] - blue components *
- * ScLine[] - array for scan line (byte per pixel) *
- * get_scline - user routine to read scan line: *
- * get_scline(y, Width, ScLine) *
- * pb - user routine for "put_byte": pb(b) *
- * *
- * Return: size of GIF *
- * *
- ***********************************************************************/
-long GIFencode(Width, Height, Ncol, R, G, B, ScLine, get_scline, pb)
- int Width, Height, Ncol;
- byte R[], G[], B[], ScLine[];
- void (*get_scline) ARGS((int, int, byte *)), (*pb) ARGS((byte));
-{
- long CodeK;
- int ncol, i, x, y, disp, Code, K;
-
- /* C H E C K P A R A M E T E R S */
-
- if (Width <= 0 || Width > 4096 || Height <= 0 || Height > 4096) {
- fprintf(stderr,
- "\nGIFencode: incorrect image size: %d x %d\n", Width, Height);
- return 0;
- }
-
- if (Ncol <= 0 || Ncol > 256) {
- fprintf(stderr,"\nGIFencode: wrong number of colors: %d\n", Ncol);
- return 0;
- }
-
- /* I N I T I A L I S A T I O N */
-
- put_b = pb;
- Nbyte = 0;
- char_init(); /* initialise "char_..." routines */
-
- /* F I N D # O F B I T S P E R P I X E L */
-
- BitsPixel = 1;
- if (Ncol > 2) BitsPixel = 2;
- if (Ncol > 4) BitsPixel = 3;
- if (Ncol > 8) BitsPixel = 4;
- if (Ncol > 16) BitsPixel = 5;
- if (Ncol > 32) BitsPixel = 6;
- if (Ncol > 64) BitsPixel = 7;
- if (Ncol > 128) BitsPixel = 8;
-
- ncol = 1 << BitsPixel;
- IniCodeSize = BitsPixel;
- if (BitsPixel <= 1) IniCodeSize = 2;
-
- /* W R I T E H E A D E R */
-
- put_byte('G'); /* magic number: GIF87a */
- put_byte('I');
- put_byte('F');
- put_byte('8');
- put_byte('7');
- put_byte('a');
-
- put_short(Width); /* screen size */
- put_short(Height);
-
- K = 0x80; /* yes, there is a color map */
- K |= (8-1)<<4; /* OR in the color resolution */
- K |= (BitsPixel - 1); /* OR in the # of bits per pixel */
- put_byte(K);
-
- put_byte(0); /* background color */
- put_byte(0); /* future expansion byte */
-
- for (i=0; i<Ncol; i++) { /* global colormap */
- put_byte(R[i]);
- put_byte(G[i]);
- put_byte(B[i]);
- }
- for (; i<ncol; i++) {
- put_byte(0);
- put_byte(0);
- put_byte(0);
- }
-
- put_byte(','); /* image separator */
- put_short(0); /* left offset of image */
- put_short(0); /* top offset of image */
- put_short(Width); /* image size */
- put_short(Height);
- put_byte(0); /* no local colors, no interlace */
- put_byte(IniCodeSize); /* initial code size */
-
- /* L W Z C O M P R E S S I O N */
-
- CurCodeSize = ++IniCodeSize;
- CurMaxCode = (1 << (IniCodeSize)) - 1;
- ClearCode = (1 << (IniCodeSize - 1));
- EOFCode = ClearCode + 1;
- FreeCode = ClearCode + 2;
- output(ClearCode);
- for (y=0; y<Height; y++) {
- (*get_scline)(y, Width, ScLine);
- x = 0;
- if (y == 0)
- Code = ScLine[x++];
- while(x < Width) {
- K = ScLine[x++]; /* next symbol */
- CodeK = ((long) K << BITS) + Code; /* set full code */
- i = (K << SHIFT) ^ Code; /* xor hashing */
-
- if (HashTab[i] == CodeK) { /* full code found */
- Code = CodeTab[i];
- continue;
- }
- else if (HashTab[i] < 0 ) /* empty slot */
- goto NOMATCH;
-
- disp = HSIZE - i; /* secondary hash */
- if (i == 0) disp = 1;
-
-PROBE:
- if ((i -= disp) < 0)
- i += HSIZE;
-
- if (HashTab[i] == CodeK) { /* full code found */
- Code = CodeTab[i];
- continue;
- }
-
- if (HashTab[i] > 0) /* try again */
- goto PROBE;
-
-NOMATCH:
- output(Code); /* full code not found */
- Code = K;
-
- if (FreeCode < THELIMIT) {
- CodeTab[i] = FreeCode++; /* code -> hashtable */
- HashTab[i] = CodeK;
- }
- else
- output(ClearCode);
- }
- }
- /* O U T P U T T H E R E S T */
-
- output(Code);
- output(EOFCode);
- put_byte(0); /* zero-length packet (EOF) */
- put_byte(';'); /* GIF file terminator */
-
- return (Nbyte);
-}
-
-static unsigned long cur_accum;
-static int cur_bits;
-static int a_count;
-static char accum[256];
-static unsigned long masks[] = { 0x0000,
- 0x0001, 0x0003, 0x0007, 0x000F,
- 0x001F, 0x003F, 0x007F, 0x00FF,
- 0x01FF, 0x03FF, 0x07FF, 0x0FFF,
- 0x1FFF, 0x3FFF, 0x7FFF, 0xFFFF };
-
-/***************************************************************
- * *
- * Name: output Date: 02.10.92 *
- * *
- * Function: output GIF code *
- * *
- * Input: code - GIF code *
- * *
- ***************************************************************/
-static void output(code)
- int code;
-{
- /* O U T P U T C O D E */
-
- cur_accum &= masks[cur_bits];
- if (cur_bits > 0)
- cur_accum |= ((long)code << cur_bits);
- else
- cur_accum = code;
- cur_bits += CurCodeSize;
- while( cur_bits >= 8 ) {
- char_out( (unsigned int) (cur_accum & 0xFF) );
- cur_accum >>= 8;
- cur_bits -= 8;
- }
-
- /* R E S E T */
-
- if (code == ClearCode ) {
- memset((char *) HashTab, -1, sizeof(HashTab));
- FreeCode = ClearCode + 2;
- CurCodeSize = IniCodeSize;
- CurMaxCode = (1 << (IniCodeSize)) - 1;
- }
-
- /* I N C R E A S E C O D E S I Z E */
-
- if (FreeCode > CurMaxCode ) {
- CurCodeSize++;
- if ( CurCodeSize == BITS )
- CurMaxCode = THELIMIT;
- else
- CurMaxCode = (1 << (CurCodeSize)) - 1;
- }
-
- /* E N D O F F I L E : write the rest of the buffer */
-
- if( code == EOFCode ) {
- while( cur_bits > 0 ) {
- char_out( (unsigned int)(cur_accum & 0xff) );
- cur_accum >>= 8;
- cur_bits -= 8;
- }
- char_flush();
- }
-}
-
-static void char_init()
-{
- a_count = 0;
- cur_accum = 0;
- cur_bits = 0;
-}
-
-static void char_out(c)
- int c;
-{
- accum[a_count++] = c;
- if (a_count >= 254)
- char_flush();
-}
-
-static void char_flush()
-{
- int i;
-
- if (a_count == 0) return;
- put_byte(a_count);
- for (i=0; i<a_count; i++) {
- put_byte(accum[i]);
- }
- a_count = 0;
-}
-
-static void put_short(word)
- int word;
-{
- put_byte(word & 0xFF);
- put_byte((word>>8) & 0xFF);
-}
-#endif
diff --git a/src/graflib/higz/higzcc/igvers.c b/src/graflib/higz/higzcc/igvers.c
deleted file mode 100644
index b2abbf2..0000000
--- a/src/graflib/higz/higzcc/igvers.c
+++ /dev/null
@@ -1,134 +0,0 @@
-/*
- * $Id: igvers.c,v 1.38 2004/06/10 07:55:22 couet Exp $
- *
- * $Log: igvers.c,v $
- * Revision 1.38 2004/06/10 07:55:22 couet
- * - 1.29/04
- *
- * Revision 1.37 2003/07/23 09:48:18 couet
- * - 1.29/03
- *
- * Revision 1.36 2003/03/18 13:39:13 couet
- * - 1.29/02
- *
- * Revision 1.35 2003/02/17 10:02:29 couet
- * - 1.29/01
- *
- * Revision 1.34 2002/12/04 10:58:39 couet
- * - 1.29/00
- *
- * Revision 1.33 2002/05/22 09:18:47 couet
- * - 1.28/07
- *
- * Revision 1.32 2002/05/16 15:32:11 couet
- * - 1.28/06
- *
- * Revision 1.31 2002/04/04 10:21:28 couet
- * - 1.28/05
- *
- * Revision 1.30 2002/03/18 16:23:41 couet
- * - 1.28/04
- *
- * Revision 1.29 2001/12/07 15:52:27 couet
- * - 1.28/03
- *
- * Revision 1.28 2001/11/23 16:09:25 couet
- * - 1.28/02
- *
- * Revision 1.27 2001/10/17 14:42:54 couet
- * - 1.28/01
- *
- * Revision 1.26 2001/10/08 16:18:06 couet
- * - 1.28/00
- *
- * Revision 1.25 2001/05/31 08:08:24 couet
- * - 1.27/03
- *
- * Revision 1.24 2000/08/29 14:04:06 couet
- * - 1.27/02
- *
- * Revision 1.23 2000/07/14 15:18:59 couet
- * - 1.27/01
- *
- * Revision 1.22 2000/04/03 15:41:39 couet
- * - 1.27/00
- *
- * Revision 1.21 1999/10/20 14:16:52 couet
- * - 1.26/04
- *
- * Revision 1.20 1999/10/13 12:35:28 couet
- * - 1.26/03
- *
- * Revision 1.19 1999/10/06 14:05:19 couet
- * - 1.26/02
- *
- * Revision 1.18 1999/06/21 16:48:37 couet
- * - 1.26/01
- *
- * Revision 1.17 1999/05/06 06:59:21 couet
- * - version 1.26/00 to tag the following bug fixe in x11int.c:
- * "MapNotify is not supported by all the X11 emulators (problem on Mac !!!)"
- *
- * Revision 1.16 1999/01/07 15:31:27 couet
- * - 1.25/05
- *
- * Revision 1.15 1998/12/07 13:45:23 couet
- * - 1.25/04
- *
- * Revision 1.14 1998/11/16 11:13:28 couet
- * - 1.25/03
- *
- * Revision 1.13 1998/11/13 10:52:29 couet
- * - 1.25/02
- *
- * Revision 1.12 1998/11/10 09:27:12 couet
- * - Y2K
- *
- * Revision 1.11 1998/05/26 09:22:54 couet
- * - 1.25/01
- *
- * Revision 1.10 1998/04/09 13:07:38 couet
- * - Compilation date removed from the vidqq string: it was meaningless
- *
- * Revision 1.9 1998/01/27 14:09:15 couet
- * - 1.24/03
- *
- * Revision 1.8 1997/11/24 15:40:34 couet
- * - 1.24/02
- *
- * Revision 1.7 1997/06/20 15:13:41 couet
- * - 1.24/01
- *
- * Revision 1.6 1997/04/22 08:45:14 couet
- * - 1.24/00
- *
- * Revision 1.5 1997/01/30 10:06:19 couet
- * - version ++
- *
- * Revision 1.4 1996/11/20 15:16:01 couet
- * - version++
- *
- * Revision 1.3 1996/04/23 08:36:50 couet
- *
- * Revision 1.2 1996/02/14 15:18:18 couet
- * The version number was not correct in igvers (CMZ corrupted it).
- *
- * Revision 1.1.1.1 1996/02/14 13:10:25 mclareni
- * Higz
- *
- */
-#include "higz/pilot.h"
-
-static char vidqq[] =
-"@(#)HIGZ 1.29/04 10/06/2004 10:00:00";
-
-/*
- * Return the static version string for HIGZ
- */
-
-char *
-igvers()
-{
- /* skip the 4 char that contain the "what" string */
- return &vidqq[4];
-}
diff --git a/src/graflib/higz/higzcc/imgpickpalette.c b/src/graflib/higz/higzcc/imgpickpalette.c
deleted file mode 100644
index 9419d63..0000000
--- a/src/graflib/higz/higzcc/imgpickpalette.c
+++ /dev/null
@@ -1,168 +0,0 @@
-/*
- * $Id: imgpickpalette.c,v 1.5 1998/11/13 13:19:53 couet Exp $
- *
- * $Log: imgpickpalette.c,v $
- * Revision 1.5 1998/11/13 13:19:53 couet
- * - removed unused variables.
- *
- * Revision 1.4 1998/11/13 10:49:05 couet
- * - New version of the routine imgpickpalette coming from a C++ version
- * from Fons Rademakers. This version allows to work on TrueColor
- * devices. ixdogif in x11int.c has been modified in order to use this
- * new version of imgpickpalette. Protections have been added in
- * ixdogif to prevent some crashes when one try to create a gif after
- * a window resizing or when the program (for example PAW) started
- * with a workstation type equal to 0. All the static arrays in ixdogif
- * have been converted into dynamic one.
- *
- * Revision 1.3 1996/03/19 16:10:28 couet
- * The variable "window" is now compared with 0 instead of NULL.
- *
- * Revision 1.2 1996/03/19 15:27:36 couet
- * The variable "window" is now compared with (Window)NULL instead of NULL.
- * Some compilers need this cast.
- *
- * Revision 1.1.1.1 1996/02/14 13:10:26 mclareni
- * Higz
- *
- */
-#include "higz/pilot.h"
-#if defined(CERNLIB_GIF)
-#include <X11/Xlib.h>
-#include <stdio.h>
-
-void CollectImageColors(unsigned long, unsigned long **, int *, int *);
-int FindColor(unsigned long, unsigned long *, int);
-
-/******************************************************************************
- * *
- * Name: ImgPickPalette Date: 12.11.98 *
- * Author: F.Rademakers Revised: *
- * Converted in C by O.Couet *
- * *
- * Returns in R G B the ncol colors of the palette used by the image. *
- * The image pixels are changed to index values in these R G B arrays. *
- * This produces a colormap with only the used colors (so even on displays *
- * with more than 8 planes we will be able to create GIF's when the image *
- * contains no more than 256 different colors). If it does contain more *
- * colors we will have to use GIFquantize to reduce the number of colors. *
- * The R G B arrays must be deleted by the caller. *
- * *
- ******************************************************************************/
-void ImgPickPalette(display, image, ncol, R, G, B)
-Display *display;
-XImage *image;
-int *ncol, **R, **G, **B;
-{
- unsigned long *orgcolors, pixel;
- int maxcolors, ncolors;
- int x, y, i, theScr, idx;
- XColor *xcol;
- Colormap theMap;
-
-/*
- * collect different image colors
- */
- maxcolors = 0;
- ncolors = 0;
- for (x = 0; x < image->width; x++) {
- for (y = 0; y < image->height; y++) {
- pixel = XGetPixel(image, x, y);
- CollectImageColors(pixel, &orgcolors, &ncolors, &maxcolors);
- }
- }
-
-/*
- * get RGB values belonging to pixels
- */
- xcol = (XColor *) malloc(ncolors*sizeof(XColor));
-
- for (i = 0; i < ncolors; i++) {
- xcol[i].pixel = orgcolors[i];
- xcol[i].red = xcol[i].green = xcol[i].blue = 0;
- xcol[i].flags = DoRed || DoGreen || DoBlue;
- }
-
- theScr = DefaultScreen(display);
- theMap = DefaultColormap(display, theScr);
-
- XQueryColors(display, theMap, xcol, ncolors);
-
-/*
- * create RGB arrays and store RGB's for each color and set number of colors
- * (space must be delete by caller)
- */
- *R = (int *) malloc(ncolors*sizeof(int));
- *G = (int *) malloc(ncolors*sizeof(int));
- *B = (int *) malloc(ncolors*sizeof(int));
-
- for (i = 0; i < ncolors; i++) {
- (*R)[i] = xcol[i].red;
- (*G)[i] = xcol[i].green;
- (*B)[i] = xcol[i].blue;
- }
- *ncol = ncolors;
-
-/*
- * update image with indices (pixels) into the new RGB colormap
- */
- for (x = 0; x < (int) image->width; x++) {
- for (y = 0; y < (int) image->height; y++) {
- pixel = XGetPixel(image, x, y);
- idx = FindColor(pixel, orgcolors, ncolors);
- XPutPixel(image, x, y, idx);
- }
- }
-
-/*
- * cleanup
- */
- free(xcol);
- free(orgcolors);
-}
-
-/*
- * Collects in orgcolors all different original image colors.
- */
-void CollectImageColors(pixel, orgcolors, ncolors, maxcolors)
-unsigned long pixel, **orgcolors;
-int *ncolors, *maxcolors;
-{
- int i;
-
- if (*maxcolors == 0) {
- *ncolors = 0;
- *maxcolors = 100;
- *orgcolors = (unsigned long *) malloc ((*maxcolors)*sizeof(unsigned long));
- }
-
- for (i = 0; i < *ncolors; i++) {
- if (pixel == (*orgcolors)[i]) return;
- }
-
- if ((*ncolors) >= (*maxcolors)) {
- *orgcolors = (unsigned long *) realloc(*orgcolors,
- (*maxcolors)*2*sizeof(unsigned long));
- *maxcolors *= 2;
- }
-
- (*orgcolors)[(*ncolors)] = pixel;
- (*ncolors)++;
-}
-
-/*
- * Returns index in orgcolors (and new_colors) for pixel.
- */
-int FindColor(pixel, orgcolors, ncolors)
-unsigned long pixel, *orgcolors;
-int ncolors;
-{
- int i;
- for (i = 0; i < ncolors; i++)
- if (pixel == orgcolors[i]) return i;
-
- printf("**** Error: did not find color, should never happen! \n");
-
- return 0;
-}
-#endif
diff --git a/src/graflib/higz/higzcc/imgscaling.c b/src/graflib/higz/higzcc/imgscaling.c
deleted file mode 100644
index 4897863..0000000
--- a/src/graflib/higz/higzcc/imgscaling.c
+++ /dev/null
@@ -1,56 +0,0 @@
-/*
- * $Id: imgscaling.c,v
- *
- * $Log: imgscaling.c,v $
- * Revision 1.1 1998/11/16 09:36:55 couet
- * - new procedure to scale bitmap images.
- *
- *
- */
-#include "higz/pilot.h"
-#if defined(CERNLIB_GIF)
-#include <X11/Xlib.h>
-#include <stdio.h>
-
-XImage * ImgScaling(Display *, XImage *, int, int);
-
-/******************************************************************************
- * *
- * Name: ImgScaling Date: 13.11.98 *
- * Author: O.Couet Revised: *
- * *
- * Transforms an XImage into a other one in a other scale. *
- * *
- ******************************************************************************/
-XImage * ImgScaling(display, image, new_width, new_height)
-Display *display;
-XImage *image;
-int new_width, new_height;
-{
-XImage *new_image;
-int old_width, old_height;
-float xratio, yratio;
-int x, y, xo, yo;
-unsigned long pixel;
-
- new_image = XGetImage( display, RootWindow( display, DefaultScreen(display)),
- 0, 0, new_width, new_height, AllPlanes, ZPixmap);
-
- old_width = image->width;
- old_height = image->height;
-
- xratio = (float)(old_width)/(float)(new_width);
- yratio = (float)(old_height)/(float)(new_height);
-
- for (x = 0; x < new_width; x++) {
- for (y = 0; y < new_height; y++) {
- xo = (int)(xratio*(float)x);
- yo = (int)(yratio*(float)y);
- pixel = XGetPixel(image, xo, yo);
- XPutPixel(new_image, x, y, pixel);
- }
- }
-
- return new_image;
-}
-#endif
diff --git a/src/graflib/higz/higzcc/ixgetl.c b/src/graflib/higz/higzcc/ixgetl.c
deleted file mode 100644
index 3bf63a7..0000000
--- a/src/graflib/higz/higzcc/ixgetl.c
+++ /dev/null
@@ -1,93 +0,0 @@
-/*
- * $Id: ixgetl.c,v 1.3 1997/09/02 15:30:30 mclareni Exp $
- *
- * $Log: ixgetl.c,v $
- * Revision 1.3 1997/09/02 15:30:30 mclareni
- * WINNT corrections
- *
- * Revision 1.2 1997/03/14 14:22:28 mclareni
- * WNT mods
- *
- * Revision 1.1.1.1.2.1 1997/01/21 11:25:22 mclareni
- * All mods for Winnt 96a on winnt branch
- *
- * Revision 1.1.1.1 1996/02/14 13:10:26 mclareni
- * Higz
- *
- */
-#include "higz/pilot.h"
-#if (defined(CERNLIB_UNIX))&&(defined(CERNLIB_CCREAD))
-/*CMZ : 1.23/06 22/11/95 10.38.33 by O.Couet*/
-/*-- Author : O.Couet 30/09/93*/
-/*
- * C routine to read a character string on stdin.
- */
-
-#include <stdio.h>
-#include <stdlib.h>
-
-#if defined(CERNLIB_QX_SC)
-#define ixgetl ixgetl_
-#endif
-#if defined(CERNLIB_CRAY)
-#define ixgetl IXGETL
-#endif
-#if (defined(CERNLIB_TKTCL))&&(defined(CERNLIB_WINNT)) || defined(CERNLIB_MSSTDCALL)
-#define ixgetl __stdcall IXGETL
-#endif
-
-#define SMALLBUF_SIZE 200
-
-#ifndef CERNLIB_MSSTDCALL
- void ixgetl(lline, chline)
-#else
- void ixgetl(lline, len_lline, chline)
- int len_lline;
-#endif
-
-char *chline;
-int *lline;
-{
- static char *buf;
- static int bufsize = 0;
- int ch, pos;
-
- if (bufsize == 0)
- {
- bufsize = 80;
- buf = (char*) calloc(bufsize + 1, sizeof(char));
- }
-
- for (pos = 0; (ch = getc(stdin)) != EOF && ch != '\n'; buf[pos++] = ch)
- {
- if (pos == bufsize)
- {
- bufsize *= 2;
- buf = (char*) realloc(buf, (bufsize + 1)*sizeof(char));
- }
- }
- buf[pos] = '\0';
-
- /* If we have a huge buffer from the last call and now have a
- * short line, try to dump the excess.
- */
- if (pos <= SMALLBUF_SIZE && bufsize > 5000)
- {
- char *smallbuf;
-
- if ((smallbuf = (char*)realloc(buf,(SMALLBUF_SIZE+1)*sizeof(char))) != NULL)
- {
- buf = smallbuf;
- bufsize = SMALLBUF_SIZE;
- }
- }
-
- if (pos == 0 && ch == EOF) {
- *lline = 0;
- chline = '\0';
- } else {
- *lline = pos;
- strcpy (chline, buf);
- }
-}
-#endif
diff --git a/src/graflib/higz/higzcc/ntmgt.c b/src/graflib/higz/higzcc/ntmgt.c
deleted file mode 100644
index 31458b0..0000000
--- a/src/graflib/higz/higzcc/ntmgt.c
+++ /dev/null
@@ -1,452 +0,0 @@
-/*
- * $Id: ntmgt.c,v 1.2 1997/03/14 14:22:28 mclareni Exp $
- *
- * $Log: ntmgt.c,v $
- * Revision 1.2 1997/03/14 14:22:28 mclareni
- * WNT mods
- *
- * Revision 1.1.1.1.2.1 1997/01/21 11:25:22 mclareni
- * All mods for Winnt 96a on winnt branch
- *
- * Revision 1.1.1.1 1996/02/14 13:10:26 mclareni
- * Higz
- *
- */
-#include "higz/pilot.h"
-#if defined(CERNLIB_NTC)
-/*CMZ : 1.23/06 22/11/95 10.36.05 by O.Couet*/
-/*-- Author : O.Couet*/
-/******************************************************************************
- * *
- * Dynamic Normalisation Transformation management package. *
- * *
- * ignint: Initiate the Normalisation Transformation management *
- * igncre: Create a new Normalisation Transformation *
- * ignscu: Set the Current Normalisation Transformation *
- * igndel: Delete the Current Normalisation Transformation *
- * igngar: Delete the NT with a priority less than Priority *
- * ignspr: Set the Priority of the Current Normalisation Transformation *
- * ignswn: Set the Window of the Current Normalisation Transformation *
- * ignsvp: Set the Viewport of the Current Normalisation Transformation *
- * ignnxt: Set the NEXT Normalisation Transformation as the curreny one *
- * ignget: Get the Current Normalisation Transformation parameters *
- * igns3w: Set the 3D Window of the Current Normalisation Transformation *
- * igns3v: Set the 3D Viewport of the Current Normalisation Transformation *
- * igng3d: Get the Current 3D Normalisation Transformation parameters *
- * *
- ******************************************************************************/
-
-#include <stdlib.h>
-#include <stdio.h>
-
-#if defined(CERNLIB_QX_SC)
-#define ignint ignint_
-#define igncre igncre_
-#define igndel igndel_
-#define igngar igngar_
-#define ignspr ignspr_
-#define ignswn ignswn_
-#define ignsvp ignsvp_
-#define ignget ignget_
-#define igns3w igns3w_
-#define igns3v igns3v_
-#define ignscu ignscu_
-#define ignnxt ignnxt_
-#define igng3d igng3d_
-#endif
-
-#if defined(CERNLIB_QXCAPT)
-#define ignint IGNINT
-#define igncre IGNCRE
-#define igndel IGNDEL
-#define igngar IGNGAR
-#define ignspr IGNSPR
-#define ignswn IGNSWN
-#define ignsvp IGNSVP
-#define ignget IGNGET
-#define igns3w IGNS3W
-#define igns3v IGNS3V
-#define ignscu IGNSCU
-#define ignnxt IGNNXT
-#define igng3d IGNG3D
-#endif
-
-#if defined(CERNLIB_IBM)
-#pragma linkage (ignint ,FORTRAN)
-#pragma linkage (igncre ,FORTRAN)
-#pragma linkage (igndel ,FORTRAN)
-#pragma linkage (igngar ,FORTRAN)
-#pragma linkage (ignspr ,FORTRAN)
-#pragma linkage (ignswn ,FORTRAN)
-#pragma linkage (ignsvp ,FORTRAN)
-#pragma linkage (ignget ,FORTRAN)
-#pragma linkage (igns3w ,FORTRAN)
-#pragma linkage (igns3v ,FORTRAN)
-#pragma linkage (ignscu ,FORTRAN)
-#pragma linkage (ignnxt ,FORTRAN)
-#pragma linkage (igng3d ,FORTRAN)
-#endif
-
-
-typedef struct _NT NT;
-struct _NT {
- int ID;
- int Priority;
- float X1_Window;
- float X2_Window;
- float Y1_Window;
- float Y2_Window;
- float X1_Viewport;
- float X2_Viewport;
- float Y1_Viewport;
- float Y2_Viewport;
- int Is_3D;
- float X1_3D_Window;
- float X2_3D_Window;
- float Y1_3D_Window;
- float Y2_3D_Window;
- float Z1_3D_Window;
- float Z2_3D_Window;
- float X1_3D_Viewport;
- float X2_3D_Viewport;
- float Y1_3D_Viewport;
- float Y2_3D_Viewport;
- float Phi;
- float Theta;
- float Psi;
- int Perspective;
- NT *Previous_NT;
- NT *Next_NT;
-};
-
-static NT *NT_Root = NULL;
-static NT *NT_Last = NULL;
-static NT *NT_Current = NULL;
-static NT *NT_Save = NULL;
-static int Highest_Priority = 0;
-
-/******************************************************************************
- * *
- * Initiate the Normalisation Transformation management *
- * *
- ******************************************************************************/
- void type_of_call ignint()
- {
- NT_Root = (NT *) calloc(1, sizeof(NT));
- NT_Root->ID = 0;
- NT_Root->Priority = 1;
- NT_Root->X1_Window = 0.0;
- NT_Root->X2_Window = 1.0;
- NT_Root->Y1_Window = 0.0;
- NT_Root->Y2_Window = 1.0;
- NT_Root->X1_Viewport = 0.0;
- NT_Root->X2_Viewport = 1.0;
- NT_Root->Y1_Viewport = 0.0;
- NT_Root->Y2_Viewport = 1.0;
- NT_Root->Is_3D = 0;
- NT_Root->X1_3D_Window = 0.0;
- NT_Root->X2_3D_Window = 1.0;
- NT_Root->Y1_3D_Window = 0.0;
- NT_Root->Y2_3D_Window = 1.0;
- NT_Root->Z1_3D_Window = 0.0;
- NT_Root->Z2_3D_Window = 1.0;
- NT_Root->X1_3D_Viewport = 0.0;
- NT_Root->X2_3D_Viewport = 1.0;
- NT_Root->Y1_3D_Viewport = 0.0;
- NT_Root->Y2_3D_Viewport = 1.0;
- NT_Root->Phi = 30.0;
- NT_Root->Theta = 30.0;
- NT_Root->Psi = 0.0;
- NT_Root->Perspective = 0;
- NT_Root->Next_NT = NT_Root;
- NT_Root->Previous_NT = NT_Root;
- NT_Current = NT_Root;
- NT_Last = NT_Root;
- }
-
-/******************************************************************************
- * *
- * Create a new Normalisation Transformation *
- * *
- ******************************************************************************/
- void type_of_call igncre(ID)
- int *ID;
- {
- NT_Current = (NT *) calloc(1, sizeof(NT));
- NT_Current->ID = *ID;
- NT_Current->Priority = 1;
- NT_Current->X1_Window = 0.0;
- NT_Current->X2_Window = 1.0;
- NT_Current->Y1_Window = 0.0;
- NT_Current->Y2_Window = 1.0;
- NT_Current->X1_Viewport = 0.0;
- NT_Current->X2_Viewport = 1.0;
- NT_Current->Y1_Viewport = 0.0;
- NT_Current->Y2_Viewport = 1.0;
- NT_Current->Is_3D = 0;
- NT_Current->X1_3D_Window = 0.0;
- NT_Current->X2_3D_Window = 1.0;
- NT_Current->Y1_3D_Window = 0.0;
- NT_Current->Y2_3D_Window = 1.0;
- NT_Current->Z1_3D_Window = 0.0;
- NT_Current->Z2_3D_Window = 1.0;
- NT_Current->X1_3D_Viewport = 0.0;
- NT_Current->X2_3D_Viewport = 1.0;
- NT_Current->Y1_3D_Viewport = 0.0;
- NT_Current->Y2_3D_Viewport = 1.0;
- NT_Current->Phi = 30.0;
- NT_Current->Theta = 30.0;
- NT_Current->Psi = 0.0;
- NT_Current->Perspective = 0;
- NT_Current->Next_NT = NT_Root;
- NT_Current->Previous_NT = NT_Last;
-
- NT_Last->Next_NT = NT_Current;
- NT_Root->Previous_NT = NT_Current;
- NT_Last = NT_Current;
- }
-
-/******************************************************************************
- * *
- * Set the Current Normalisation Transformation *
- * Returns 1 if NT already exits 0 otherwise *
- * *
- ******************************************************************************/
- int type_of_call ignscu(ID)
- int *ID;
- {
- if ( NT_Current->ID == *ID) return 1;
- NT_Save = NT_Current;
- while ( NT_Current->Next_NT != NT_Save) {
- NT_Current = NT_Current->Next_NT;
- if ( NT_Current->ID == *ID) return 1;
- }
- return 0;
- }
-
-/******************************************************************************
- * *
- * Delete the Current Normalisation Transformation *
- * *
- ******************************************************************************/
- void type_of_call igndel()
- {
- if ( NT_Current == NT_Root) return;
- NT_Save = NT_Current->Previous_NT;
- NT_Save->Next_NT = NT_Current->Next_NT;
- NT_Save = NT_Current->Next_NT;
- NT_Save->Previous_NT = NT_Current->Previous_NT;
- free (NT_Current);
- NT_Current = NT_Save;
- NT_Last = NT_Root->Previous_NT;
- }
-
-/******************************************************************************
- * *
- * Delete the Normalisation Transformation with a priority less than Priority *
- * *
- ******************************************************************************/
- void type_of_call igngar(Priority)
- int *Priority;
- {
- NT_Current = NT_Root->Next_NT;
- while ( NT_Current != NT_Root) {
- if(NT_Current->Priority < *Priority) {
- igndel();
- } else {
- NT_Current = NT_Current->Next_NT;
- }
- }
- }
-
-/******************************************************************************
- * *
- * Set the Priority of the Current Normalisation Transformation *
- * *
- ******************************************************************************/
- void type_of_call ignspr(Priority)
- int *Priority;
- {
- NT_Current->Priority = *Priority;
- if ( *Priority > Highest_Priority) Highest_Priority = *Priority;
- }
-
-/******************************************************************************
- * *
- * Set the Window of the Current Normalisation Transformation *
- * *
- ******************************************************************************/
- void type_of_call ignswn(X1_Window, X2_Window, Y1_Window, Y2_Window)
- float *X1_Window;
- float *X2_Window;
- float *Y1_Window;
- float *Y2_Window;
- {
- NT_Current->X1_Window = *X1_Window;
- NT_Current->X2_Window = *X2_Window;
- NT_Current->Y1_Window = *Y1_Window;
- NT_Current->Y2_Window = *Y2_Window;
- }
-
-/******************************************************************************
- * *
- * Set the Viewport of the Current Normalisation Transformation *
- * *
- ******************************************************************************/
- void type_of_call ignsvp(X1_Viewport, X2_Viewport, Y1_Viewport, Y2_Viewport)
- float *X1_Viewport;
- float *X2_Viewport;
- float *Y1_Viewport;
- float *Y2_Viewport;
- {
- NT_Current->X1_Viewport = *X1_Viewport;
- NT_Current->X2_Viewport = *X2_Viewport;
- NT_Current->Y1_Viewport = *Y1_Viewport;
- NT_Current->Y2_Viewport = *Y2_Viewport;
- }
-
-/******************************************************************************
- * *
- * Set the NEXT Normalisation Transformation as the current one *
- * init=1 define the beginning of the loop *
- * init=0 set the next NT current *
- * This routine returns 1 when the loop is finished 0 otherwise *
- * *
- ******************************************************************************/
- int type_of_call ignnxt(init)
- int *init;
- {
- if ( *init == 1 ) {
- NT_Save = NT_Current;
- return 0;
- } else {
- NT_Current = NT_Current->Next_NT;
- if ( NT_Current == NT_Save ) {
- return 1;
- } else {
- return 0;
- }
- }
- }
-
-/******************************************************************************
- * *
- * Get the Current 2D Normalisation Transformation parameters *
- * *
- ******************************************************************************/
- void type_of_call ignget(NTID, Priority, H_Priority,
- X1_Window, X2_Window, Y1_Window, Y2_Window,
- X1_Viewport, X2_Viewport, Y1_Viewport, Y2_Viewport, Is_3D)
- int *NTID;
- int *Priority;
- int *H_Priority;
- float *X1_Window;
- float *X2_Window;
- float *Y1_Window;
- float *Y2_Window;
- float *X1_Viewport;
- float *X2_Viewport;
- float *Y1_Viewport;
- float *Y2_Viewport;
- int *Is_3D;
- {
- *H_Priority = Highest_Priority;
- *NTID = NT_Current->ID;
- *Priority = NT_Current->Priority;
- *X1_Window = NT_Current->X1_Window;
- *X2_Window = NT_Current->X2_Window;
- *Y1_Window = NT_Current->Y1_Window;
- *Y2_Window = NT_Current->Y2_Window;
- *X1_Viewport = NT_Current->X1_Viewport;
- *X2_Viewport = NT_Current->X2_Viewport;
- *Y1_Viewport = NT_Current->Y1_Viewport;
- *Y2_Viewport = NT_Current->Y2_Viewport;
- *Is_3D = NT_Current->Is_3D;
- }
-
-/******************************************************************************
- * *
- * Set the 3D Window of the Current Normalisation Transformation *
- * *
- ******************************************************************************/
- void type_of_call igns3w(X1_3D_Window, X2_3D_Window,
- Y1_3D_Window, Y2_3D_Window,
- Z1_3D_Window, Z2_3D_Window,
- Phi, Theta, Psi)
- float *X1_3D_Window;
- float *X2_3D_Window;
- float *Y1_3D_Window;
- float *Y2_3D_Window;
- float *Z1_3D_Window;
- float *Z2_3D_Window;
- float *Phi;
- float *Theta;
- float *Psi;
- {
- NT_Current->Is_3D = 1;
- NT_Current->X1_3D_Window = *X1_3D_Window;
- NT_Current->X2_3D_Window = *X2_3D_Window;
- NT_Current->Y1_3D_Window = *Y1_3D_Window;
- NT_Current->Y2_3D_Window = *Y2_3D_Window;
- NT_Current->Z1_3D_Window = *Z1_3D_Window;
- NT_Current->Z2_3D_Window = *Z2_3D_Window;
- NT_Current->Phi = *Phi;
- NT_Current->Theta = *Theta;
- NT_Current->Psi = *Psi;
- }
-
-/******************************************************************************
- * *
- * Set the 3D Viewport of the Current Normalisation Transformation *
- * *
- ******************************************************************************/
- void type_of_call igns3v(X1_3D_Viewport, X2_3D_Viewport, Y1_3D_Viewport, Y2_3D_Viewport)
- float *X1_3D_Viewport;
- float *X2_3D_Viewport;
- float *Y1_3D_Viewport;
- float *Y2_3D_Viewport;
- {
- NT_Current->Is_3D = 1;
- NT_Current->X1_3D_Viewport = *X1_3D_Viewport;
- NT_Current->X2_3D_Viewport = *X2_3D_Viewport;
- NT_Current->Y1_3D_Viewport = *Y1_3D_Viewport;
- NT_Current->Y2_3D_Viewport = *Y2_3D_Viewport;
- }
-
-/******************************************************************************
- * *
- * Get the Current 3D Normalisation Transformation parameters *
- * *
- ******************************************************************************/
- void type_of_call igng3d(X1_3D_Window, X2_3D_Window, Y1_3D_Window, Y2_3D_Window,
- Z1_3D_Window, Z2_3D_Window, Phi, Theta, Psi,
- X1_3D_Viewport, X2_3D_Viewport, Y1_3D_Viewport, Y2_3D_Viewport)
- float *X1_3D_Window;
- float *X2_3D_Window;
- float *Y1_3D_Window;
- float *Y2_3D_Window;
- float *Z1_3D_Window;
- float *Z2_3D_Window;
- float *Phi;
- float *Theta;
- float *Psi;
- float *X1_3D_Viewport;
- float *X2_3D_Viewport;
- float *Y1_3D_Viewport;
- float *Y2_3D_Viewport;
- {
- *X1_3D_Window = NT_Current->X1_3D_Window;
- *X2_3D_Window = NT_Current->X2_3D_Window;
- *Y1_3D_Window = NT_Current->Y1_3D_Window;
- *Y2_3D_Window = NT_Current->Y2_3D_Window;
- *Z1_3D_Window = NT_Current->Z1_3D_Window;
- *Z2_3D_Window = NT_Current->Z2_3D_Window;
- *Phi = NT_Current->Phi;
- *Theta = NT_Current->Theta;
- *Psi = NT_Current->Psi;
- *X1_3D_Viewport = NT_Current->X1_3D_Viewport;
- *X2_3D_Viewport = NT_Current->X2_3D_Viewport;
- *Y1_3D_Viewport = NT_Current->Y1_3D_Viewport;
- *Y2_3D_Viewport = NT_Current->Y2_3D_Viewport;
- }
-#endif
diff --git a/src/graflib/higz/higzcc/rotated.c b/src/graflib/higz/higzcc/rotated.c
deleted file mode 100644
index c291bbd..0000000
--- a/src/graflib/higz/higzcc/rotated.c
+++ /dev/null
@@ -1,1631 +0,0 @@
-/*
- * $Id: rotated.c,v 1.2 1998/01/30 15:22:04 couet Exp $
- *
- * $Log: rotated.c,v $
- * Revision 1.2 1998/01/30 15:22:04 couet
- * - APOLLO version removed
- *
- * Revision 1.1.1.1 1996/02/14 13:10:26 mclareni
- * Higz
- *
- */
-#include "higz/pilot.h"
-#if (defined(CERNLIB_X11))&&(!defined(CERNLIB_WINNT))
-/*CMZ : 1.23/06 22/11/95 10.13.12 by O.Couet*/
-/*-- Author : O.Couet 17/11/93*/
-/* ********************************************************************** *
- *
- * xvertext 5.0, Copyright (c) 1993 Alan Richardson (mppa3 at uk.ac.sussex.syma)
- *
- * Alignment definition modified by O.Couet.
- * Mods IBM/VM by O.Couet.
- *
- * Permission to use, copy, modify, and distribute this software and its
- * documentation for any purpose and without fee is hereby granted, provided
- * that the above copyright notice appear in all copies and that both the
- * copyright notice and this permission notice appear in supporting
- * documentation. All work developed as a consequence of the use of
- * this program should duly acknowledge such use. No representations are
- * made about the suitability of this software for any purpose. It is
- * provided "as is" without express or implied warranty.
- *
- * ********************************************************************** */
-
-#include <X11/Xlib.h>
-#include <X11/Xutil.h>
-#include <X11/Xatom.h>
-#include <stdio.h>
-#include <math.h>
-
-/* ************************************************************************ *
- *
- * Header file for the `xvertext 5.0' routines.
- *
- * Copyright (c) 1993 Alan Richardson (mppa3 at uk.ac.sussex.syma)
- *
- * ************************************************************************ */
-
-#ifndef _XVERTEXT_INCLUDED_
-#define _XVERTEXT_INCLUDED_
-
-
-#define XV_VERSION 5.0
-#define XV_COPYRIGHT \
- "xvertext routines Copyright (c) 1993 Alan Richardson"
-
-/* ---------------------------------------------------------------------- */
-
-/* text alignment */
-
-#define NONE 0
-#define TLEFT 1
-#define TCENTRE 2
-#define TRIGHT 3
-#define MLEFT 4
-#define MCENTRE 5
-#define MRIGHT 6
-#define BLEFT 7
-#define BCENTRE 8
-#define BRIGHT 9
-
-#if defined(CERNLIB_VAX)
-#define X11R3
-#endif
-
-/* ---------------------------------------------------------------------- */
-
-/* this shoulf be C++ compliant, thanks to
- vlp at latina.inesc.pt (Vasco Lopes Paulo) */
-
-#if defined(__cplusplus) || defined(c_plusplus)
-
-extern "C" {
-float XRotVersion(char*, int);
-void XRotSetMagnification(float);
-void XRotSetBoundingBoxPad(int);
-int XRotDrawString(Display*, XFontStruct*, float,
- Drawable, GC, int, int, char*);
-int XRotDrawImageString(Display*, XFontStruct*, float,
- Drawable, GC, int, int, char*);
-int XRotDrawAlignedString(Display*, XFontStruct*, float,
- Drawable, GC, int, int, char*, int);
-int XRotDrawAlignedImageString(Display*, XFontStruct*, float,
- Drawable, GC, int, int, char*, int);
-XPoint *XRotTextExtents(Display*, XFontStruct*, float,
- int, int, char*, int);
-}
-
-#else
-#if defined(CERNLIB_IBM)
-#define XRotDrawString XRDS
-#define XRotDrawImageString XRDIS
-#define XRotDrawAlignedString XRDAS
-#define XRotDrawAlignedImageString XRDAIS
-#endif
-extern float XRotVersion();
-extern void XRotSetMagnification();
-extern void XRotSetBoundingBoxPad();
-extern int XRotDrawString();
-extern int XRotDrawImageString();
-extern int XRotDrawAlignedString();
-extern int XRotDrawAlignedImageString();
-extern XPoint *XRotTextExtents();
-
-#endif /* __cplusplus */
-
-/* ---------------------------------------------------------------------- */
-
-#endif /* _XVERTEXT_INCLUDED_ */
-
-/* ---------------------------------------------------------------------- */
-
-/* Make sure cache size is set */
-
-#ifndef CACHE_SIZE_LIMIT
-#define CACHE_SIZE_LIMIT 0
-#endif /*CACHE_SIZE_LIMIT */
-
-/* Make sure a cache method is specified */
-
-#ifndef CACHE_XIMAGES
-#ifndef CACHE_BITMAPS
-#define CACHE_BITMAPS
-#endif /*CACHE_BITMAPS*/
-#endif /*CACHE_XIMAGES*/
-
-/* ---------------------------------------------------------------------- */
-
-/* Debugging macros */
-
-#ifdef DEBUG
-static int debug=1;
-#else
-static int debug=0;
-#endif /*DEBUG*/
-
-#define DEBUG_PRINT1(a) if (debug) printf (a)
-#define DEBUG_PRINT2(a, b) if (debug) printf (a, b)
-#define DEBUG_PRINT3(a, b, c) if (debug) printf (a, b, c)
-#define DEBUG_PRINT4(a, b, c, d) if (debug) printf (a, b, c, d)
-#define DEBUG_PRINT5(a, b, c, d, e) if (debug) printf (a, b, c, d, e)
-
-/* ---------------------------------------------------------------------- */
-
-#ifndef M_PI
-#define M_PI 3.14159265358979323846
-#endif
-
-/* ---------------------------------------------------------------------- */
-
-/* A structure holding everything needed for a rotated string */
-
-typedef struct rotated_text_item_template {
- Pixmap bitmap;
- XImage *ximage;
-
- char *text;
- char *font_name;
- Font fid;
- float angle;
- int align;
- float magnify;
-
- int cols_in;
- int rows_in;
- int cols_out;
- int rows_out;
-
- int nl;
- int max_width;
- float *corners_x;
- float *corners_y;
-
- long int size;
- int cached;
-
- struct rotated_text_item_template *next;
-} RotatedTextItem;
-
-RotatedTextItem *first_text_item=NULL;
-
-/* ---------------------------------------------------------------------- */
-
-/* A structure holding current magnification and bounding box padding */
-
-static struct style_template {
- float magnify;
- int bbx_pad;
-} style={
- 1.,
- 0
- };
-
-/* ---------------------------------------------------------------------- */
-
-static char *my_strdup();
-static char *my_strtok();
-
-float XRotVersion();
-void XRotSetMagnification();
-void XRotSetBoundingBoxPad();
-int XRotDrawString();
-int XRotDrawImageString();
-int XRotDrawAlignedString();
-int XRotDrawAlignedImageString();
-XPoint *XRotTextExtents();
-
-static XImage *MakeXImage();
-static int XRotPaintAlignedString();
-static int XRotDrawHorizontalString();
-static RotatedTextItem *XRotRetrieveFromCache();
-static RotatedTextItem *XRotCreateTextItem();
-static void XRotAddToLinkedList();
-static void XRotFreeTextItem();
-static XImage *XRotMagnifyImage();
-
-/**************************************************************************/
-/* Routine to mimic `strdup()' (some machines don't have it) */
-/**************************************************************************/
-
-static char *my_strdup(str)
- char *str;
-{
- char *s;
-
- if(str==NULL) return NULL;
-
- s=(char *)malloc((unsigned)(strlen(str)+1));
- if(s!=NULL) strcpy(s, str);
-
- return s;
-}
-
-#if defined(CERNLIB_IBM)
-/**************************************************************************/
-/* return uppercase version of a string, but don't change the string */
-/**************************************************************************/
-char *LtoU( str )
- char *str;
-{
- char *strout;
- if( str != NULL ) {
- char *p;
- strout=my_strdup(str);
- for( p = strout; *p != '\0'; p++ )
- if( islower( *p ) )
- *p = toupper( *p );
- }
- return strout;
-}
-#endif
-
-/**************************************************************************/
-/* Routine to replace `strtok' : this one returns a zero length string if */
-/* it encounters two consecutive delimiters */
-/**************************************************************************/
-
-static char *my_strtok(str1, str2)
- char *str1, *str2;
-{
- char *ret;
- int i, j, stop;
- static int start, len;
- static char *stext;
-
- if(str2==NULL) return NULL;
-
- /* initialise if str1 not NULL */
- if(str1!=NULL) {
- start=0;
- stext=str1;
- len=strlen(str1);
- }
-
- /* run out of tokens ? */
- if(start>=len) return NULL;
-
- /* loop through characters */
- for(i=start; i<len; i++) {
- /* loop through delimiters */
- stop=0;
- for(j=0; j<strlen(str2); j++)
- if(stext[i]==str2[j])
- stop=1;
-
- if(stop) break;
- }
-
- stext[i]='\0';
-
- ret=stext+start;
-
- start=i+1;
-
- return ret;
-}
-
-/**************************************************************************/
-/* Return version/copyright information */
-/**************************************************************************/
-
-float XRotVersion(str, n)
- char *str;
- int n;
-{
- if(str!=NULL) strncpy(str, XV_COPYRIGHT, n);
- return XV_VERSION;
-}
-
-/**************************************************************************/
-/* Set the font magnification factor for all subsequent operations */
-/**************************************************************************/
-
-void XRotSetMagnification(m)
- float m;
-{
- if(m>0.) style.magnify=m;
-}
-
-/**************************************************************************/
-/* Set the padding used when calculating bounding boxes */
-/**************************************************************************/
-
-void XRotSetBoundingBoxPad(p)
- int p;
-{
- if(p>=0) style.bbx_pad=p;
-}
-
-/**************************************************************************/
-/* Create an XImage structure and allocate memory for it */
-/**************************************************************************/
-
-static XImage *MakeXImage(dpy, w, h)
- Display *dpy;
- int w, h;
-{
- XImage *I;
- char *data;
-
- /* reserve memory for image */
- data=(char *)calloc((unsigned)(((w-1)/8+1)*h), 1);
- if(data==NULL) return NULL;
-
- /* create the XImage */
- I=XCreateImage(dpy, DefaultVisual(dpy, DefaultScreen(dpy)), 1, XYBitmap,
- 0, data, w, h, 8, 0);
- if(I==NULL) return NULL;
-
- I->byte_order=I->bitmap_bit_order=MSBFirst;
- return I;
-}
-
-/**************************************************************************/
-/* A front end to XRotPaintAlignedString: */
-/* -no alignment, no background */
-/**************************************************************************/
-
-int XRotDrawString(dpy, font, angle, drawable, gc, x, y, str)
- Display *dpy;
- XFontStruct *font;
- float angle;
- Drawable drawable;
- GC gc;
- int x, y;
- char *str;
-{
- return (XRotPaintAlignedString(dpy, font, angle, drawable, gc,
- x, y, str, NONE, 0));
-}
-
-/**************************************************************************/
-/* A front end to XRotPaintAlignedString: */
-/* -no alignment, paints background */
-/**************************************************************************/
-
-int XRotDrawImageString(dpy, font, angle, drawable, gc, x, y, str)
- Display *dpy;
- XFontStruct *font;
- float angle;
- Drawable drawable;
- GC gc;
- int x, y;
- char *str;
-{
- return(XRotPaintAlignedString(dpy, font, angle, drawable, gc,
- x, y, str, NONE, 1));
-}
-
-/**************************************************************************/
-/* A front end to XRotPaintAlignedString: */
-/* -does alignment, no background */
-/**************************************************************************/
-
-int XRotDrawAlignedString(dpy, font, angle, drawable, gc, x, y, text, align)
- Display *dpy;
- XFontStruct *font;
- float angle;
- Drawable drawable;
- GC gc;
- int x, y;
- char *text;
- int align;
-{
- return(XRotPaintAlignedString(dpy, font, angle, drawable, gc,
- x, y, text, align, 0));
-}
-
-/**************************************************************************/
-/* A front end to XRotPaintAlignedString: */
-/* -does alignment, paints background */
-/**************************************************************************/
-
-int XRotDrawAlignedImageString(dpy, font, angle, drawable, gc, x, y, text,
- align)
- Display *dpy;
- XFontStruct *font;
- float angle;
- Drawable drawable;
- GC gc;
- int x, y;
- char *text;
- int align;
-{
- return(XRotPaintAlignedString(dpy, font, angle, drawable, gc,
- x, y, text, align, 1));
-}
-
-/**************************************************************************/
-/* Aligns and paints a rotated string */
-/**************************************************************************/
-
-static int XRotPaintAlignedString(dpy, font, angle, drawable, gc, x, y, text,
- align, bg)
- Display *dpy;
- XFontStruct *font;
- float angle;
- Drawable drawable;
- GC gc;
- int x, y;
- char *text;
- int align;
- int bg;
-{
- int i;
- GC my_gc;
- int xp, yp;
- float hot_x, hot_y;
- float hot_xp, hot_yp;
- float sin_angle, cos_angle;
- RotatedTextItem *item;
- Pixmap bitmap_to_paint;
-
- /* return early for NULL/empty strings */
- if(text==NULL)
- return 0;
-
- if(strlen(text)==0) return 0;
-
- /* manipulate angle to 0<=angle<360 degrees */
- while(angle<0)
- angle+=360;
-
- while(angle>=360)
- angle-=360;
-
- angle*=M_PI/180;
-
- /* horizontal text made easy */
- if(angle==0. && style.magnify==1.)
- return(XRotDrawHorizontalString(dpy, font, drawable, gc, x, y,
- text, align, bg));
-
- /* get a rotated bitmap */
- item=XRotRetrieveFromCache(dpy, font, angle, text, align);
- if(item==NULL) return (int)NULL;
-
- /* this gc has similar properties to the user's gc */
- my_gc=XCreateGC(dpy, drawable, NULL, 0);
- XCopyGC(dpy, gc, GCForeground|GCBackground|GCFunction|GCPlaneMask,
- my_gc);
-
- /* alignment : which point (hot_x, hot_y) relative to bitmap centre
- coincides with user's specified point? */
-
- /* y position */
- if(align==TLEFT || align==TCENTRE || align==TRIGHT)
- hot_y=(float)item->rows_in/2*style.magnify;
- else if(align==MLEFT || align==MCENTRE || align==MRIGHT)
- {
- /* Modify by O.Couet to have Bottom alignment without font->descent */
- /* hot_y=0; */
- hot_y=-((float)item->rows_in/4-(float)font->descent)*style.magnify;
- }
- else if(align==BLEFT || align==BCENTRE || align==BRIGHT)
- {
- /* Modify by O.Couet to have Bottom alignment without font->descent */
- /* hot_y=-(float)item->rows_in/2*style.magnify; */
- hot_y=-((float)item->rows_in/2-(float)font->descent)*style.magnify;
- }
- else
- hot_y=-((float)item->rows_in/2-(float)font->descent)*style.magnify;
-
- /* x position */
- if(align==TLEFT || align==MLEFT || align==BLEFT || align==NONE)
- hot_x=-(float)item->max_width/2*style.magnify;
- else if(align==TCENTRE || align==MCENTRE || align==BCENTRE)
- hot_x=0;
- else
- hot_x=(float)item->max_width/2*style.magnify;
-
- /* pre-calculate sin and cos */
- sin_angle=sin(angle);
- cos_angle=cos(angle);
-
- /* rotate hot_x and hot_y around bitmap centre */
- hot_xp= hot_x*cos_angle - hot_y*sin_angle;
- hot_yp= hot_x*sin_angle + hot_y*cos_angle;
-
- /* text background will be drawn using XFillPolygon */
- if(bg) {
- GC depth_one_gc;
- XPoint *xpoints;
- Pixmap empty_stipple;
-
- /* reserve space for XPoints */
- xpoints=(XPoint *)malloc((unsigned)(4*item->nl*sizeof(XPoint)));
- if(!xpoints) return 1;
-
- /* rotate corner positions */
- for(i=0; i<4*item->nl; i++) {
- xpoints[i].x=(float)x + ( (item->corners_x[i]-hot_x)*cos_angle +
- (item->corners_y[i]+hot_y)*sin_angle);
- xpoints[i].y=(float)y + (-(item->corners_x[i]-hot_x)*sin_angle +
- (item->corners_y[i]+hot_y)*cos_angle);
- }
-
- /* we want to swap foreground and background colors here;
- XGetGCValues() is only available in R4+ */
-
- empty_stipple=XCreatePixmap(dpy, drawable, 1, 1, 1);
-
- depth_one_gc=XCreateGC(dpy, empty_stipple, NULL, 0);
- XSetForeground(dpy, depth_one_gc, 0);
- XFillRectangle(dpy, empty_stipple, depth_one_gc, 0, 0, 2, 2);
-
- XSetStipple(dpy, my_gc, empty_stipple);
- XSetFillStyle(dpy, my_gc, FillOpaqueStippled);
-
- XFillPolygon(dpy, drawable, my_gc, xpoints, 4*item->nl, Nonconvex,
- CoordModeOrigin);
-
- /* free our resources */
- free((char *)xpoints);
- XFreeGC(dpy, depth_one_gc);
- XFreePixmap(dpy, empty_stipple);
- }
-
- /* where should top left corner of bitmap go ? */
- xp=(float)x-((float)item->cols_out/2 +hot_xp);
- yp=(float)y-((float)item->rows_out/2 -hot_yp);
-
- /* by default we draw the rotated bitmap, solid */
- bitmap_to_paint=item->bitmap;
-
- /* handle user stippling */
-#ifndef X11R3
- {
- GC depth_one_gc;
- XGCValues values;
- Pixmap new_bitmap, inverse;
-
- /* try and get some GC properties */
- if(XGetGCValues(dpy, gc,
- GCStipple|GCFillStyle|GCForeground|GCBackground|
- GCTileStipXOrigin|GCTileStipYOrigin,
- &values)) {
-
- /* only do this if stippling requested */
- if((values.fill_style==FillStippled ||
- values.fill_style==FillOpaqueStippled) && !bg) {
-
- /* opaque stipple: draw rotated text in background colour */
- if(values.fill_style==FillOpaqueStippled) {
- XSetForeground(dpy, my_gc, values.background);
- XSetFillStyle(dpy, my_gc, FillStippled);
- XSetStipple(dpy, my_gc, item->bitmap);
- XSetTSOrigin(dpy, my_gc, xp, yp);
- XFillRectangle(dpy, drawable, my_gc, xp, yp,
- item->cols_out, item->rows_out);
- XSetForeground(dpy, my_gc, values.foreground);
- }
-
- /* this will merge the rotated text and the user's stipple */
- new_bitmap=XCreatePixmap(dpy, drawable,
- item->cols_out, item->rows_out, 1);
-
- /* create a GC */
- depth_one_gc=XCreateGC(dpy, new_bitmap, NULL, 0);
- XSetForeground(dpy, depth_one_gc, 1);
- XSetBackground(dpy, depth_one_gc, 0);
-
- /* set the relative stipple origin */
- XSetTSOrigin(dpy, depth_one_gc,
- values.ts_x_origin-xp, values.ts_y_origin-yp);
-
- /* fill the whole bitmap with the user's stipple */
- XSetStipple(dpy, depth_one_gc, values.stipple);
- XSetFillStyle(dpy, depth_one_gc, FillOpaqueStippled);
- XFillRectangle(dpy, new_bitmap, depth_one_gc,
- 0, 0, item->cols_out, item->rows_out);
-
- /* set stipple origin back to normal */
- XSetTSOrigin(dpy, depth_one_gc, 0, 0);
-
- /* this will contain an inverse copy of the rotated text */
- inverse=XCreatePixmap(dpy, drawable,
- item->cols_out, item->rows_out, 1);
-
- /* invert text */
- XSetFillStyle(dpy, depth_one_gc, FillSolid);
- XSetFunction(dpy, depth_one_gc, GXcopyInverted);
- XCopyArea(dpy, item->bitmap, inverse, depth_one_gc,
- 0, 0, item->cols_out, item->rows_out, 0, 0);
-
- /* now delete user's stipple everywhere EXCEPT on text */
- XSetForeground(dpy, depth_one_gc, 0);
- XSetBackground(dpy, depth_one_gc, 1);
- XSetStipple(dpy, depth_one_gc, inverse);
- XSetFillStyle(dpy, depth_one_gc, FillStippled);
- XSetFunction(dpy, depth_one_gc, GXcopy);
- XFillRectangle(dpy, new_bitmap, depth_one_gc,
- 0, 0, item->cols_out, item->rows_out);
-
- /* free resources */
- XFreePixmap(dpy, inverse);
- XFreeGC(dpy, depth_one_gc);
-
- /* this is the new bitmap */
- bitmap_to_paint=new_bitmap;
- }
- }
- }
-#endif /*X11R3*/
-
- /* paint text using stipple technique */
- XSetFillStyle(dpy, my_gc, FillStippled);
- XSetStipple(dpy, my_gc, bitmap_to_paint);
- XSetTSOrigin(dpy, my_gc, xp, yp);
- XFillRectangle(dpy, drawable, my_gc, xp, yp,
- item->cols_out, item->rows_out);
-
- /* free our resources */
- XFreeGC(dpy, my_gc);
-
- /* stippled bitmap no longer needed */
- if(bitmap_to_paint!=item->bitmap)
- XFreePixmap(dpy, bitmap_to_paint);
-
-#ifdef CACHE_XIMAGES
- XFreePixmap(dpy, item->bitmap);
-#endif /*CACHE_XIMAGES*/
-
- /* if item isn't cached, destroy it completely */
- if(!item->cached)
- XRotFreeTextItem(dpy,item);
-
- /* we got to the end OK! */
- return 0;
-}
-
-/**************************************************************************/
-/* Draw a horizontal string in a quick fashion */
-/**************************************************************************/
-
-static int XRotDrawHorizontalString(dpy, font, drawable, gc, x, y, text,
- align, bg)
- Display *dpy;
- XFontStruct *font;
- Drawable drawable;
- GC gc;
- int x, y;
- char *text;
- int align;
- int bg;
-{
- GC my_gc;
- int nl=1, i;
- int height;
- int xp, yp;
- char *str1, *str2, *str3;
- char *str2_a="\0", *str2_b="\n\0";
- int dir, asc, desc;
- XCharStruct overall;
-
- DEBUG_PRINT1("**\nHorizontal text.\n");
-
- /* this gc has similar properties to the user's gc (including stipple) */
- my_gc=XCreateGC(dpy, drawable, NULL, 0);
- XCopyGC(dpy, gc,
- GCForeground|GCBackground|GCFunction|GCStipple|GCFillStyle|
- GCTileStipXOrigin|GCTileStipYOrigin|GCPlaneMask, my_gc);
- XSetFont(dpy, my_gc, font->fid);
-
- /* count number of sections in string */
- if(align!=NONE)
- for(i=0; i<strlen(text)-1; i++)
- if(text[i]=='\n')
- nl++;
-
- /* ignore newline characters if not doing alignment */
- if(align==NONE)
- str2=str2_a;
- else
- str2=str2_b;
-
- /* overall font height */
- height=font->ascent+font->descent;
-
- /* y position */
- if(align==TLEFT || align==TCENTRE || align==TRIGHT)
- yp=y+font->ascent;
- else if(align==MLEFT || align==MCENTRE || align==MRIGHT)
- {
- /* Modify by O.Couet to have Middle alignment without font->descent */
- /* yp=y-nl*height/2+font->ascent; */
- yp=y-nl*(height-font->descent)/2+font->ascent;
- }
- else if(align==BLEFT || align==BCENTRE || align==BRIGHT)
- {
- /* Modify by O.Couet to have Bottom alignment without font->descent */
- /* yp=y-nl*height+font->ascent; */
- yp=y-nl*(height-font->descent)+font->ascent;
- }
- else
- yp=y;
-
- str1=my_strdup(text);
- if(str1==NULL) return 1;
-
- str3=my_strtok(str1, str2);
-
- /* loop through each section in the string */
- do {
-#if !defined(CERNLIB_IBM)
- XTextExtents(font, str3, strlen(str3), &dir, &asc, &desc,
- &overall);
-#endif
-#if defined(CERNLIB_IBM)
- XTextExtents(font, LtoU(str3), strlen(str3), &dir, &asc, &desc,
- &overall);
-#endif
-
- /* where to draw section in x ? */
- if(align==TLEFT || align==MLEFT || align==BLEFT || align==NONE)
- xp=x;
- else if(align==TCENTRE || align==MCENTRE || align==BCENTRE)
- xp=x-overall.rbearing/2;
- else
- xp=x-overall.rbearing;
-
- /* draw string onto bitmap */
- if(!bg)
- XDrawString(dpy, drawable, my_gc, xp, yp, str3, strlen(str3));
- else
- XDrawImageString(dpy, drawable, my_gc, xp, yp, str3, strlen(str3));
-
- /* move to next line */
- yp+=height;
-
- str3=my_strtok((char *)NULL, str2);
- }
- while(str3!=NULL);
-
- free(str1);
- XFreeGC(dpy, my_gc);
-
- return 0;
-}
-
-/**************************************************************************/
-/* Query cache for a match with this font/text/angle/alignment */
-/* request, otherwise arrange for its creation */
-/**************************************************************************/
-
-static RotatedTextItem *XRotRetrieveFromCache(dpy, font, angle, text, align)
- Display *dpy;
- XFontStruct *font;
- float angle;
- char *text;
- int align;
-{
- Font fid;
- char *font_name;
- unsigned long name_value;
- RotatedTextItem *item=NULL;
- RotatedTextItem *i1=first_text_item;
-
- /* get font name, if it exists */
- if(XGetFontProperty(font, XA_FONT, &name_value)) {
- DEBUG_PRINT1("got font name OK\n");
- font_name=XGetAtomName(dpy, name_value);
- fid=0;
- }
-#ifdef CACHE_FID
- /* otherwise rely (unreliably?) on font ID */
- else {
- DEBUG_PRINT1("can't get fontname, caching FID\n");
- font_name=NULL;
- fid=font->fid;
- }
-#else
- /* not allowed to cache font ID's */
- else {
- DEBUG_PRINT1("can't get fontname, can't cache\n");
- font_name=NULL;
- fid=0;
- }
-#endif /*CACHE_FID*/
-
- /* look for a match in cache */
-
- /* matching formula:
- identical text;
- identical fontname (if defined, font ID's if not);
- angles close enough (<0.00001 here, could be smaller);
- HORIZONTAL alignment matches, OR it's a one line string;
- magnifications the same */
-
- while(i1 && !item) {
- /* match everything EXCEPT fontname/ID */
- if(strcmp(text, i1->text)==0 &&
- fabs(angle-i1->angle)<0.00001 &&
- style.magnify==i1->magnify &&
- (i1->nl==1 ||
- ((align==0)?9:(align-1))%3==
- ((i1->align==0)?9:(i1->align-1))%3)) {
-
- /* now match fontname/ID */
- if(font_name!=NULL && i1->font_name!=NULL) {
- if(strcmp(font_name, i1->font_name)==0) {
- item=i1;
- DEBUG_PRINT1("Matched against font names\n");
- }
- else
- i1=i1->next;
- }
-#ifdef CACHE_FID
- else if(font_name==NULL && i1->font_name==NULL) {
- if(fid==i1->fid) {
- item=i1;
- DEBUG_PRINT1("Matched against FID's\n");
- }
- else
- i1=i1->next;
- }
-#endif /*CACHE_FID*/
- else
- i1=i1->next;
- }
- else
- i1=i1->next;
- }
-
- if(item)
- DEBUG_PRINT1("**\nFound target in cache.\n");
- if(!item)
- DEBUG_PRINT1("**\nNo match in cache.\n");
-
- /* no match */
- if(!item) {
- /* create new item */
- item=XRotCreateTextItem(dpy, font, angle, text, align);
- if(!item)
- return NULL;
-
- /* record what it shows */
- item->text=my_strdup(text);
-
- /* fontname or ID */
- if(font_name!=NULL) {
- item->font_name=my_strdup(font_name);
- item->fid=0;
- }
- else {
- item->font_name=NULL;
- item->fid=fid;
- }
-
- item->angle=angle;
- item->align=align;
- item->magnify=style.magnify;
-
- /* cache it */
- XRotAddToLinkedList(dpy, item);
- }
-
- if(font_name)
- XFree(font_name);
-
- /* if XImage is cached, need to recreate the bitmap */
-
-#ifdef CACHE_XIMAGES
- {
- GC depth_one_gc;
-
- /* create bitmap to hold rotated text */
- item->bitmap=XCreatePixmap(dpy, DefaultRootWindow(dpy),
- item->cols_out, item->rows_out, 1);
-
- /* depth one gc */
- depth_one_gc=XCreateGC(dpy, item->bitmap, NULL, 0);
- XSetBackground(dpy, depth_one_gc, 0);
- XSetForeground(dpy, depth_one_gc, 1);
-
- /* make the text bitmap from XImage */
- XPutImage(dpy, item->bitmap, depth_one_gc, item->ximage, 0, 0, 0, 0,
- item->cols_out, item->rows_out);
-
- XFreeGC(dpy, depth_one_gc);
- }
-#endif /*CACHE_XIMAGES*/
-
- return item;
-}
-
-/**************************************************************************/
-/* Create a rotated text item */
-/**************************************************************************/
-
-static RotatedTextItem *XRotCreateTextItem(dpy, font, angle, text, align)
- Display *dpy;
- XFontStruct *font;
- float angle;
- char *text;
- int align;
-{
- RotatedTextItem *item;
- Pixmap canvas;
- GC font_gc;
- XImage *I_in;
- register int i, j;
- char *str1, *str2, *str3;
- char *str2_a="\0", *str2_b="\n\0";
- int height;
- int byte_w_in, byte_w_out;
- int xp, yp;
- float sin_angle, cos_angle;
- int it, jt;
- float di, dj;
- int ic=0;
- float xl, xr, xinc;
- int byte_out;
- int dir, asc, desc;
- XCharStruct overall;
- int old_cols_in=0, old_rows_in=0;
-
- /* allocate memory */
- item=(RotatedTextItem *)malloc((unsigned)sizeof(RotatedTextItem));
- if(!item)
- return NULL;
-
- /* count number of sections in string */
- item->nl=1;
- if(align!=NONE)
- for(i=0; i<strlen(text)-1; i++)
- if(text[i]=='\n')
- item->nl++;
-
- /* ignore newline characters if not doing alignment */
- if(align==NONE)
- str2=str2_a;
- else
- str2=str2_b;
-
- /* find width of longest section */
- str1=my_strdup(text);
- if(str1==NULL) return NULL;
-
- str3=my_strtok(str1, str2);
-
-#if !defined(CERNLIB_IBM)
- XTextExtents(font, str3, strlen(str3), &dir, &asc, &desc,
- &overall);
-#endif
-#if defined(CERNLIB_IBM)
- XTextExtents(font, LtoU(str3), strlen(str3), &dir, &asc, &desc,
- &overall);
-#endif
-
- item->max_width=overall.rbearing;
-
- /* loop through each section */
- do {
- str3=my_strtok((char *)NULL, str2);
-
- if(str3!=NULL) {
-#if !defined(CERNLIB_IBM)
- XTextExtents(font, str3, strlen(str3), &dir, &asc, &desc,
- &overall);
-#endif
-#if defined(CERNLIB_IBM)
- XTextExtents(font, LtoU(str3), strlen(str3), &dir, &asc, &desc,
- &overall);
-#endif
- if(overall.rbearing>item->max_width)
- item->max_width=overall.rbearing;
- }
- }
- while(str3!=NULL);
-
- free(str1);
-
- /* overall font height */
- height=font->ascent+font->descent;
-
- /* dimensions horizontal text will have */
- item->cols_in=item->max_width;
- item->rows_in=item->nl*height;
-
- /* bitmap for drawing on */
- canvas=XCreatePixmap(dpy, DefaultRootWindow(dpy),
- item->cols_in, item->rows_in, 1);
-
- /* create a GC for the bitmap */
- font_gc=XCreateGC(dpy, canvas, NULL, 0);
- XSetBackground(dpy, font_gc, 0);
- XSetFont(dpy, font_gc, font->fid);
-
- /* make sure the bitmap is blank */
- XSetForeground(dpy, font_gc, 0);
- XFillRectangle(dpy, canvas, font_gc, 0, 0,
- item->cols_in+1, item->rows_in+1);
- XSetForeground(dpy, font_gc, 1);
-
- /* pre-calculate sin and cos */
- sin_angle=sin(angle);
- cos_angle=cos(angle);
-
- /* text background will be drawn using XFillPolygon */
- item->corners_x=
- (float *)malloc((unsigned)(4*item->nl*sizeof(float)));
- if(!item->corners_x)
- return NULL;
-
- item->corners_y=
- (float *)malloc((unsigned)(4*item->nl*sizeof(float)));
- if(!item->corners_y)
- return NULL;
-
- /* draw text horizontally */
-
- /* start at top of bitmap */
- yp=font->ascent;
-
- str1=my_strdup(text);
- if(str1==NULL) return NULL;
-
- str3=my_strtok(str1, str2);
-
- /* loop through each section in the string */
- do {
-#if !defined(CERNLIB_IBM)
- XTextExtents(font, str3, strlen(str3), &dir, &asc, &desc,
- &overall);
-#endif
-#if defined(CERNLIB_IBM)
- XTextExtents(font, LtoU(str3), strlen(str3), &dir, &asc, &desc,
- &overall);
-#endif
-
- /* where to draw section in x ? */
- if(align==TLEFT || align==MLEFT || align==BLEFT || align==NONE)
- xp=0;
- else if(align==TCENTRE || align==MCENTRE || align==BCENTRE)
- xp=(item->max_width-overall.rbearing)/2;
- else
- xp=item->max_width-overall.rbearing;
-
- /* draw string onto bitmap */
- XDrawString(dpy, canvas, font_gc, xp, yp, str3, strlen(str3));
-
- /* keep a note of corner positions of this string */
- item->corners_x[ic]=((float)xp-(float)item->cols_in/2)*style.magnify;
- item->corners_y[ic]=((float)(yp-font->ascent)-(float)item->rows_in/2)
- *style.magnify;
- item->corners_x[ic+1]=item->corners_x[ic];
- item->corners_y[ic+1]=item->corners_y[ic]+(float)height*style.magnify;
- item->corners_x[item->nl*4-1-ic]=item->corners_x[ic]+
- (float)overall.rbearing*style.magnify;
- item->corners_y[item->nl*4-1-ic]=item->corners_y[ic];
- item->corners_x[item->nl*4-2-ic]=
- item->corners_x[item->nl*4-1-ic];
- item->corners_y[item->nl*4-2-ic]=item->corners_y[ic+1];
-
- ic+=2;
-
- /* move to next line */
- yp+=height;
-
- str3=my_strtok((char *)NULL, str2);
- }
- while(str3!=NULL);
-
- free(str1);
-
- /* create image to hold horizontal text */
- I_in=MakeXImage(dpy, item->cols_in, item->rows_in);
- if(I_in==NULL)
- return NULL;
-
- /* extract horizontal text */
- XGetSubImage(dpy, canvas, 0, 0, item->cols_in, item->rows_in,
- 1, XYPixmap, I_in, 0, 0);
- I_in->format=XYBitmap;
-
- /* magnify horizontal text */
- if(style.magnify!=1.) {
- I_in=XRotMagnifyImage(dpy, I_in);
-
- old_cols_in=item->cols_in;
- old_rows_in=item->rows_in;
- item->cols_in=(float)item->cols_in*style.magnify;
- item->rows_in=(float)item->rows_in*style.magnify;
- }
-
- /* how big will rotated text be ? */
- item->cols_out=fabs((float)item->rows_in*sin_angle) +
- fabs((float)item->cols_in*cos_angle) +0.99999 +2;
-
- item->rows_out=fabs((float)item->rows_in*cos_angle) +
- fabs((float)item->cols_in*sin_angle) +0.99999 +2;
-
- if(item->cols_out%2==0)
- item->cols_out++;
-
- if(item->rows_out%2==0)
- item->rows_out++;
-
- /* create image to hold rotated text */
- item->ximage=MakeXImage(dpy, item->cols_out, item->rows_out);
- if(item->ximage==NULL)
- return NULL;
-
- byte_w_in=(item->cols_in-1)/8+1;
- byte_w_out=(item->cols_out-1)/8+1;
-
- /* we try to make this bit as fast as possible - which is why it looks
- a bit over-the-top */
-
- /* vertical distance from centre */
- dj=0.5-(float)item->rows_out/2;
-
- /* where abouts does text actually lie in rotated image? */
- if(angle==0 || angle==M_PI/2 ||
- angle==M_PI || angle==3*M_PI/2) {
- xl=0;
- xr=(float)item->cols_out;
- xinc=0;
- }
- else if(angle<M_PI) {
- xl=(float)item->cols_out/2+
- (dj-(float)item->rows_in/(2*cos_angle))/
- tan(angle)-2;
- xr=(float)item->cols_out/2+
- (dj+(float)item->rows_in/(2*cos_angle))/
- tan(angle)+2;
- xinc=1./tan(angle);
- }
- else {
- xl=(float)item->cols_out/2+
- (dj+(float)item->rows_in/(2*cos_angle))/
- tan(angle)-2;
- xr=(float)item->cols_out/2+
- (dj-(float)item->rows_in/(2*cos_angle))/
- tan(angle)+2;
-
- xinc=1./tan(angle);
- }
-
- /* loop through all relevent bits in rotated image */
- for(j=0; j<item->rows_out; j++) {
-
- /* no point re-calculating these every pass */
- di=(float)((xl<0)?0:(int)xl)+0.5-(float)item->cols_out/2;
- byte_out=(item->rows_out-j-1)*byte_w_out;
-
- /* loop through meaningful columns */
- for(i=((xl<0)?0:(int)xl);
- i<((xr>=item->cols_out)?item->cols_out:(int)xr); i++) {
-
- /* rotate coordinates */
- it=(float)item->cols_in/2 + ( di*cos_angle + dj*sin_angle);
- jt=(float)item->rows_in/2 - (-di*sin_angle + dj*cos_angle);
-
- /* set pixel if required */
- if(it>=0 && it<item->cols_in && jt>=0 && jt<item->rows_in)
- if((I_in->data[jt*byte_w_in+it/8] & 128>>(it%8))>0)
- item->ximage->data[byte_out+i/8]|=128>>i%8;
-
- di+=1;
- }
- dj+=1;
- xl+=xinc;
- xr+=xinc;
- }
- XDestroyImage(I_in);
-
- if(style.magnify!=1.) {
- item->cols_in=old_cols_in;
- item->rows_in=old_rows_in;
- }
-
-
-#ifdef CACHE_BITMAPS
-
- /* create a bitmap to hold rotated text */
- item->bitmap=XCreatePixmap(dpy, DefaultRootWindow(dpy),
- item->cols_out, item->rows_out, 1);
-
- /* make the text bitmap from XImage */
- XPutImage(dpy, item->bitmap, font_gc, item->ximage, 0, 0, 0, 0,
- item->cols_out, item->rows_out);
-
- XDestroyImage(item->ximage);
-
-#endif /*CACHE_BITMAPS*/
-
- XFreeGC(dpy, font_gc);
- XFreePixmap(dpy, canvas);
-
- return item;
-}
-
-/**************************************************************************/
-/* Adds a text item to the end of the cache, removing as many items */
-/* from the front as required to keep cache size below limit */
-/**************************************************************************/
-
-static void XRotAddToLinkedList(dpy, item)
- Display *dpy;
- RotatedTextItem *item;
-{
-
- static long int current_size=0;
- static RotatedTextItem *last=NULL;
- RotatedTextItem *i1=first_text_item, *i2;
-
-#ifdef CACHE_BITMAPS
-
- /* I don't know how much memory a pixmap takes in the server -
- probably this + a bit more we can't account for */
-
- item->size=((item->cols_out-1)/8+1)*item->rows_out;
-
-#else
-
- /* this is pretty much the size of a RotatedTextItem */
-
- item->size=((item->cols_out-1)/8+1)*item->rows_out +
- sizeof(XImage) + strlen(item->text) +
- item->nl*8*sizeof(float) + sizeof(RotatedTextItem);
-
- if(item->font_name!=NULL)
- item->size+=strlen(item->font_name);
- else
- item->size+=sizeof(Font);
-
-#endif /*CACHE_BITMAPS */
-
-#ifdef DEBUG
- /* count number of items in cache, for debugging */
- {
- int i=0;
-
- while(i1) {
- i++;
- i1=i1->next;
- }
- DEBUG_PRINT2("Cache has %d items.\n", i);
- i1=first_text_item;
- }
-#endif
-
- DEBUG_PRINT4("current cache size=%ld, new item=%ld, limit=%ld\n",
- current_size, item->size, CACHE_SIZE_LIMIT*1024);
-
- /* if this item is bigger than whole cache, forget it */
- if(item->size>CACHE_SIZE_LIMIT*1024) {
- DEBUG_PRINT1("Too big to cache\n\n");
- item->cached=0;
- return;
- }
-
- /* remove elements from cache as needed */
- while(i1 && current_size+item->size>CACHE_SIZE_LIMIT*1024) {
-
- DEBUG_PRINT2("Removed %d bytes\n", i1->size);
-
- if(i1->font_name!=NULL)
- DEBUG_PRINT5(" (`%s'\n %s\n angle=%f align=%d)\n",
- i1->text, i1->font_name, i1->angle, i1->align);
-
-#ifdef CACHE_FID
- if(i1->font_name==NULL)
- DEBUG_PRINT5(" (`%s'\n FID=%ld\n angle=%f align=%d)\n",
- i1->text, i1->fid, i1->angle, i1->align);
-#endif /*CACHE_FID*/
-
- current_size-=i1->size;
-
- i2=i1->next;
-
- /* free resources used by the unlucky item */
- XRotFreeTextItem(dpy, i1);
-
- /* remove it from linked list */
- first_text_item=i2;
- i1=i2;
- }
-
- /* add new item to end of linked list */
- if(first_text_item==NULL) {
- item->next=NULL;
- first_text_item=item;
- last=item;
- }
- else {
- item->next=NULL;
- last->next=item;
- last=item;
- }
-
- /* new cache size */
- current_size+=item->size;
-
- item->cached=1;
-
- DEBUG_PRINT1("Added item to cache.\n");
-}
-
-/**************************************************************************/
-/* Free the resources used by a text item */
-/**************************************************************************/
-
-static void XRotFreeTextItem(dpy, item)
- Display *dpy;
- RotatedTextItem *item;
-{
- free(item->text);
-
- if(item->font_name!=NULL)
- free(item->font_name);
-
- free((char *)item->corners_x);
- free((char *)item->corners_y);
-
-#ifdef CACHE_BITMAPS
- XFreePixmap(dpy, item->bitmap);
-#else
- XDestroyImage(item->ximage);
-#endif /* CACHE_BITMAPS */
-
- free((char *)item);
-}
-
-/**************************************************************************/
-/* Magnify an XImage using bilinear interpolation */
-/**************************************************************************/
-
-static XImage *XRotMagnifyImage(dpy, ximage)
- Display *dpy;
- XImage *ximage;
-{
- int i, j;
- float x, y;
- float u,t;
- XImage *I_out;
- int cols_in, rows_in;
- int cols_out, rows_out;
- register int i2, j2;
- float z1, z2, z3, z4;
- int byte_width_in, byte_width_out;
- float mag_inv;
-
- /* size of input image */
- cols_in=ximage->width;
- rows_in=ximage->height;
-
- /* size of final image */
- cols_out=(float)cols_in*style.magnify;
- rows_out=(float)rows_in*style.magnify;
-
- /* this will hold final image */
- I_out=MakeXImage(dpy, cols_out, rows_out);
- if(I_out==NULL)
- return NULL;
-
- /* width in bytes of input, output images */
- byte_width_in=(cols_in-1)/8+1;
- byte_width_out=(cols_out-1)/8+1;
-
- /* for speed */
- mag_inv=1./style.magnify;
-
- y=0.;
-
- /* loop over magnified image */
- for(j2=0; j2<rows_out; j2++) {
- x=0;
- j=y;
-
- for(i2=0; i2<cols_out; i2++) {
- i=x;
-
- /* bilinear interpolation - where are we on bitmap ? */
- /* right edge */
- if(i==cols_in-1 && j!=rows_in-1) {
- t=0;
- u=y-(float)j;
-
- z1=(ximage->data[j*byte_width_in+i/8] & 128>>(i%8))>0;
- z2=z1;
- z3=(ximage->data[(j+1)*byte_width_in+i/8] & 128>>(i%8))>0;
- z4=z3;
- }
- /* top edge */
- else if(i!=cols_in-1 && j==rows_in-1) {
- t=x-(float)i;
- u=0;
-
- z1=(ximage->data[j*byte_width_in+i/8] & 128>>(i%8))>0;
- z2=(ximage->data[j*byte_width_in+(i+1)/8] & 128>>((i+1)%8))>0;
- z3=z2;
- z4=z1;
- }
- /* top right corner */
- else if(i==cols_in-1 && j==rows_in-1) {
- u=0;
- t=0;
-
- z1=(ximage->data[j*byte_width_in+i/8] & 128>>(i%8))>0;
- z2=z1;
- z3=z1;
- z4=z1;
- }
- /* somewhere `safe' */
- else {
- t=x-(float)i;
- u=y-(float)j;
-
- z1=(ximage->data[j*byte_width_in+i/8] & 128>>(i%8))>0;
- z2=(ximage->data[j*byte_width_in+(i+1)/8] & 128>>((i+1)%8))>0;
- z3=(ximage->data[(j+1)*byte_width_in+(i+1)/8] &
- 128>>((i+1)%8))>0;
- z4=(ximage->data[(j+1)*byte_width_in+i/8] & 128>>(i%8))>0;
- }
-
- /* if interpolated value is greater than 0.5, set bit */
- if(((1-t)*(1-u)*z1 + t*(1-u)*z2 + t*u*z3 + (1-t)*u*z4)>0.5)
- I_out->data[j2*byte_width_out+i2/8]|=128>>i2%8;
-
- x+=mag_inv;
- }
- y+=mag_inv;
- }
-
- /* destroy original */
- XDestroyImage(ximage);
-
- /* return big image */
- return I_out;
-}
-
-/**************************************************************************/
-/* Calculate the bounding box some text will have when painted */
-/**************************************************************************/
-
-XPoint *XRotTextExtents(dpy, font, angle, x, y, text, align)
- Display *dpy;
- XFontStruct *font;
- float angle;
- int x, y;
- char *text;
- int align;
-{
- register int i;
- char *str1, *str2, *str3;
- char *str2_a="\0", *str2_b="\n\0";
- int height;
- float sin_angle, cos_angle;
- int nl, max_width;
- int cols_in, rows_in;
- float hot_x, hot_y;
- XPoint *xp_in, *xp_out;
- int dir, asc, desc;
- XCharStruct overall;
-
- /* manipulate angle to 0<=angle<360 degrees */
- while(angle<0)
- angle+=360;
-
- while(angle>360)
- angle-=360;
-
- angle*=M_PI/180;
-
- /* count number of sections in string */
- nl=1;
- if(align!=NONE)
- for(i=0; i<strlen(text)-1; i++)
- if(text[i]=='\n')
- nl++;
-
- /* ignore newline characters if not doing alignment */
- if(align==NONE)
- str2=str2_a;
- else
- str2=str2_b;
-
- /* find width of longest section */
- str1=my_strdup(text);
- if(str1==NULL) return NULL;
-
- str3=my_strtok(str1, str2);
-
-#if !defined(CERNLIB_IBM)
- XTextExtents(font, str3, strlen(str3), &dir, &asc, &desc,
- &overall);
-#endif
-#if defined(CERNLIB_IBM)
- XTextExtents(font, LtoU(str3), strlen(str3), &dir, &asc, &desc,
- &overall);
-#endif
-
- max_width=overall.rbearing;
-
- /* loop through each section */
- do {
- str3=my_strtok((char *)NULL, str2);
-
- if(str3!=NULL) {
-#if !defined(CERNLIB_IBM)
- XTextExtents(font, str3, strlen(str3), &dir, &asc, &desc,
- &overall);
-#endif
-#if defined(CERNLIB_IBM)
- XTextExtents(font, LtoU(str3), strlen(str3), &dir, &asc, &desc,
- &overall);
-#endif
-
- if(overall.rbearing>max_width)
- max_width=overall.rbearing;
- }
- }
- while(str3!=NULL);
-
- free(str1);
-
- /* overall font height */
- height=font->ascent+font->descent;
-
- /* dimensions horizontal text will have */
- cols_in=max_width;
- rows_in=nl*height;
-
- /* pre-calculate sin and cos */
- sin_angle=sin(angle);
- cos_angle=cos(angle);
-
- /* y position */
- if(align==TLEFT || align==TCENTRE || align==TRIGHT)
- hot_y=(float)rows_in/2*style.magnify;
- else if(align==MLEFT || align==MCENTRE || align==MRIGHT)
- hot_y=0;
- else if(align==BLEFT || align==BCENTRE || align==BRIGHT)
- hot_y=-(float)rows_in/2*style.magnify;
- else
- hot_y=-((float)rows_in/2-(float)font->descent)*style.magnify;
-
- /* x position */
- if(align==TLEFT || align==MLEFT || align==BLEFT || align==NONE)
- hot_x=-(float)max_width/2*style.magnify;
- else if(align==TCENTRE || align==MCENTRE || align==BCENTRE)
- hot_x=0;
- else
- hot_x=(float)max_width/2*style.magnify;
-
- /* reserve space for XPoints */
- xp_in=(XPoint *)malloc((unsigned)(5*sizeof(XPoint)));
- if(!xp_in)
- return NULL;
-
- xp_out=(XPoint *)malloc((unsigned)(5*sizeof(XPoint)));
- if(!xp_out)
- return NULL;
-
- /* bounding box when horizontal, relative to bitmap centre */
- xp_in[0].x=-(float)cols_in*style.magnify/2-style.bbx_pad;
- xp_in[0].y= (float)rows_in*style.magnify/2+style.bbx_pad;
- xp_in[1].x= (float)cols_in*style.magnify/2+style.bbx_pad;
- xp_in[1].y= (float)rows_in*style.magnify/2+style.bbx_pad;
- xp_in[2].x= (float)cols_in*style.magnify/2+style.bbx_pad;
- xp_in[2].y=-(float)rows_in*style.magnify/2-style.bbx_pad;
- xp_in[3].x=-(float)cols_in*style.magnify/2-style.bbx_pad;
- xp_in[3].y=-(float)rows_in*style.magnify/2-style.bbx_pad;
- xp_in[4].x=xp_in[0].x;
- xp_in[4].y=xp_in[0].y;
-
- /* rotate and translate bounding box */
- for(i=0; i<5; i++) {
- xp_out[i].x=(float)x + ( ((float)xp_in[i].x-hot_x)*cos_angle +
- ((float)xp_in[i].y+hot_y)*sin_angle);
- xp_out[i].y=(float)y + (-((float)xp_in[i].x-hot_x)*sin_angle +
- ((float)xp_in[i].y+hot_y)*cos_angle);
- }
-
- free((char *)xp_in);
-
- return xp_out;
-}
-#endif
diff --git a/src/graflib/higz/higzcc/tkhigz.c b/src/graflib/higz/higzcc/tkhigz.c
deleted file mode 100644
index 765e503..0000000
--- a/src/graflib/higz/higzcc/tkhigz.c
+++ /dev/null
@@ -1,491 +0,0 @@
-/*
- * $Id: tkhigz.c,v 1.1.1.1 1996/02/14 13:10:26 mclareni Exp $
- *
- * $Log: tkhigz.c,v $
- * Revision 1.1.1.1 1996/02/14 13:10:26 mclareni
- * Higz
- *
- */
-#include "higz/pilot.h"
-#if defined(CERNLIB_TKTCL)
-/*CMZ : 1.23/06 22/11/95 10.12.40 by O.Couet*/
-/*-- Author : O.Couet 22/11/95*/
-/*
- * tkHigz.c --
- *
- * This module implements a widget for higz to draw in.
- * Several widgets can exist but only one is the active one
- * and will be used to draw in.
- * Based on the Square widget.
- *
- * Copyright (c) 1991-1993 The Regents of the University of California.
- * All rights reserved.
- *
- * Permission is hereby granted, without written agreement and without
- * license or royalty fees, to use, copy, modify, and distribute this
- * software and its documentation for any purpose, provided that the
- * above copyright notice and the following two paragraphs appear in
- * all copies of this software.
- *
- * IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY FOR
- * DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT
- * OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE UNIVERSITY OF
- * CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- *
- * THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES,
- * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
- * AND FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS
- * ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO
- * PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
- */
-
-#include "higz/cfortran.h"
-#if !defined(VMS) && !defined(_WINDOWS)
-#include "higz/tkConfig.h"
-#endif
-#include "higz/tk.h"
-
-/*
- * A data structure of the following type is kept for each higz
- * widget managed by this file:
- */
-
-typedef struct {
- Tk_Window tkwin; /* Window that embodies the higz. NULL
- * means window has been deleted but
- * widget record hasn't been cleaned up yet. */
- Display *display; /* X's token for the window's display. */
- Tcl_Interp *interp; /* Interpreter associated with widget. */
-
- /*
- * Information used when displaying widget:
- */
-
- Tk_3DBorder bgBorder; /* Used for drawing background. */
- Tk_3DBorder fgBorder; /* For drawing by higz. */
- int relief; /* Indicates whether window as a whole is
- * raised, sunken, or flat. */
- GC gc; /* Graphics context for copying from
- * off-screen pixmap onto screen. */
- int updatePending; /* Non-zero means a call to HigzDisplay
- * has already been scheduled. */
- int height; /* The height of the plot window */
- int width; /* The width of the plot window */
- int higzwin; /* Higz win id */
-} Higz;
-
-/*
- * Information used for argv parsing.
- */
-
-static Tk_ConfigSpec configSpecs[] = {
- {TK_CONFIG_BORDER, "-background", "background", "Background",
- "#cdb79e", Tk_Offset(Higz, bgBorder), TK_CONFIG_COLOR_ONLY},
- {TK_CONFIG_BORDER, "-background", "background", "Background",
- "white", Tk_Offset(Higz, bgBorder), TK_CONFIG_MONO_ONLY},
- {TK_CONFIG_SYNONYM, "-bg", "background", (char *) NULL,
- (char *) NULL, 0, 0},
- {TK_CONFIG_SYNONYM, "-fg", "foreground", (char *) NULL,
- (char *) NULL, 0, 0},
- {TK_CONFIG_BORDER, "-foreground", "foreground", "Foreground",
- "#b03060", Tk_Offset(Higz, fgBorder), TK_CONFIG_COLOR_ONLY},
- {TK_CONFIG_BORDER, "-foreground", "foreground", "Foreground",
- "black", Tk_Offset(Higz, fgBorder), TK_CONFIG_MONO_ONLY},
- {TK_CONFIG_PIXELS, "-height", "height", "Height",
- "400", Tk_Offset(Higz, height), 0},
- {TK_CONFIG_PIXELS, "-width", "width", "Width",
- "400", Tk_Offset(Higz, width), 0},
- {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
- (char *) NULL, 0, 0}
-};
-
-/*
- * Forward declarations for procedures defined later in this file:
- */
-
-static int HigzConfigure _ANSI_ARGS_((Tcl_Interp *interp,
- Higz *higzPtr, int argc, char **argv,
- int flags));
-static void HigzDestroy _ANSI_ARGS_((ClientData clientData));
-static void HigzDisplay _ANSI_ARGS_((ClientData clientData));
-static void HigzEventProc _ANSI_ARGS_((ClientData clientData,
- XEvent *eventPtr));
-static int HigzWidgetCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *, int argc, char **argv));
-
-PROTOCCALLSFFUN0(INT,OPENHIGZWINDOW,openhigzwindow);
-#define OPENHIGZWINDOW \
- CCALLSFFUN0(OPENHIGZWINDOW,openhigzwindow)
-
-#define SELECTHIGZWINDOW(I) \
- CCALLSFSUB1(SELECTHIGZWINDOW,selecthigzwindow,INT,I)
-
-
-/*
- * Global variable to keep track of currently active Higz widget
- * (yes we should not do global vars, maybe removed later
- */
-
-static char * higz_current;
-
-
-/*
- *--------------------------------------------------------------
- *
- * HigzCmd --
- *
- * This procedure is invoked to process the "higz" Tcl
- * command. It creates a new "higz" widget.
- *
- * Results:
- * A standard Tcl result.
- *
- * Side effects:
- * A new widget is created and configured.
- *
- *--------------------------------------------------------------
- */
-
-int
-HigzCmd(clientData, interp, argc, argv)
- ClientData clientData; /* Main window associated with
- * interpreter. */
- Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
-{
- Tk_Window main = (Tk_Window) clientData;
- Higz *higzPtr;
- Tk_Window tkwin;
-
- if (argc < 2) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " pathName ?options?\"", (char *) NULL);
- return TCL_ERROR;
- }
-
- tkwin = Tk_CreateWindowFromPath(interp, main, argv[1], (char *) NULL);
- if (tkwin == NULL) {
- return TCL_ERROR;
- }
- Tk_SetClass(tkwin, "Higz");
-
- /*
- * Allocate and initialize the widget record.
- */
-
- higzPtr = (Higz *) ckalloc(sizeof(Higz));
- higzPtr->tkwin = tkwin;
- higzPtr->display = Tk_Display(tkwin);
- higzPtr->interp = interp;
- higzPtr->bgBorder = NULL;
- higzPtr->fgBorder = NULL;
- higzPtr->relief = TK_RELIEF_FLAT;
- higzPtr->gc = None;
- higzPtr->updatePending = 0;
-
- Tk_MakeWindowExist( tkwin );
-
- Tk_CreateEventHandler(higzPtr->tkwin, ExposureMask|StructureNotifyMask,
- HigzEventProc, (ClientData) higzPtr);
- Tcl_CreateCommand(interp, Tk_PathName(higzPtr->tkwin), HigzWidgetCmd,
- (ClientData) higzPtr, (void (*)()) NULL);
- if (HigzConfigure(interp, higzPtr, argc-2, argv+2, 0) != TCL_OK) {
- Tk_DestroyWindow(higzPtr->tkwin);
- return TCL_ERROR;
- }
-
- ixsdswi( higzPtr->display, Tk_WindowId(higzPtr->tkwin) );
- higzPtr->higzwin = OPENHIGZWINDOW;
-
- interp->result = Tk_PathName(higzPtr->tkwin);
- return TCL_OK;
-}
-
-/*
- *--------------------------------------------------------------
- *
- * HigzWidgetCmd --
- *
- * This procedure is invoked to process the Tcl command
- * that corresponds to a widget managed by this module.
- * See the user documentation for details on what it does.
- *
- * Results:
- * A standard Tcl result.
- *
- * Side effects:
- * See the user documentation.
- *
- *--------------------------------------------------------------
- */
-
-static int
-HigzWidgetCmd(clientData, interp, argc, argv)
- ClientData clientData; /* Information about higz widget. */
- Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
-{
- Higz *higzPtr = (Higz *) clientData;
- int result = TCL_OK;
- int length;
- char c;
-
- if (argc < 2) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " option ?arg arg ...?\"", (char *) NULL);
- return TCL_ERROR;
- }
- Tk_Preserve((ClientData) higzPtr);
- c = argv[1][0];
- length = strlen(argv[1]);
- if ((c == 'c') && (strncmp(argv[1], "configure", length) == 0)) {
- if (argc == 2) {
- result = Tk_ConfigureInfo(interp, higzPtr->tkwin, configSpecs,
- (char *) higzPtr, (char *) NULL, 0);
- } else if (argc == 3) {
- result = Tk_ConfigureInfo(interp, higzPtr->tkwin, configSpecs,
- (char *) higzPtr, argv[2], 0);
- } else {
- result = HigzConfigure(interp, higzPtr, argc-2, argv+2,
- TK_CONFIG_ARGV_ONLY);
- }
- } else if ((c == 's') && (strncmp(argv[1], "select", length) == 0)) {
- if ( argc != 2 ) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " select\"", (char *) NULL);
- goto error;
- }
-
- if ( higz_current != 0 ) {
- strcpy( interp->result, higz_current );
- free( higz_current );
- }
-
- higz_current = strdup( Tk_PathName( higzPtr->tkwin ) );
- SELECTHIGZWINDOW( higzPtr->higzwin );
-
- } else if ((c == 'g') && (strncmp(argv[1], "geometry", length) == 0)) {
- Window root;
- int xval, yval;
- unsigned int wval, hval, border, depth;
-
- XGetGeometry( higzPtr->display, Tk_WindowId(higzPtr->tkwin),
- &root, &xval, &yval, &wval, &hval, &border, &depth );
-
- printf( "x=%d y=%d w=%d h=%d b=%d d=%d\n", xval, yval, wval, hval,
- border, depth );
- } else {
- Tcl_AppendResult(interp, "bad option \"", argv[1],
- "\": must be configure, position, or size", (char *) NULL);
- goto error;
- }
- if (!higzPtr->updatePending) {
- Tk_DoWhenIdle(HigzDisplay, (ClientData) higzPtr);
- higzPtr->updatePending = 1;
- }
- Tk_Release((ClientData) higzPtr);
- return result;
-
- error:
- Tk_Release((ClientData) higzPtr);
- return TCL_ERROR;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * HigzConfigure --
- *
- * This procedure is called to process an argv/argc list in
- * conjunction with the Tk option database to configure (or
- * reconfigure) a higz widget.
- *
- * Results:
- * The return value is a standard Tcl result. If TCL_ERROR is
- * returned, then interp->result contains an error message.
- *
- * Side effects:
- * Configuration information, such as colors, border width,
- * etc. get set for higzPtr; old resources get freed,
- * if there were any.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-HigzConfigure(interp, higzPtr, argc, argv, flags)
- Tcl_Interp *interp; /* Used for error reporting. */
- Higz *higzPtr; /* Information about widget. */
- int argc; /* Number of valid entries in argv. */
- char **argv; /* Arguments. */
- int flags; /* Flags to pass to
- * Tk_ConfigureWidget. */
-{
- if (Tk_ConfigureWidget(interp, higzPtr->tkwin, configSpecs,
- argc, argv, (char *) higzPtr, flags) != TCL_OK) {
- return TCL_ERROR;
- }
-
- /*
- * Set the background for the window and create a graphics context
- * for use during redisplay.
- */
-
- Tk_SetWindowBackground(higzPtr->tkwin,
- Tk_3DBorderColor(higzPtr->bgBorder)->pixel);
- if ( higzPtr->gc == None ) {
- XGCValues gcValues;
- gcValues.function = GXcopy;
- gcValues.graphics_exposures = False;
- higzPtr->gc = Tk_GetGC(higzPtr->tkwin,
- GCFunction|GCGraphicsExposures, &gcValues);
- }
-
- /*
- * Register the desired geometry for the window. Then arrange for
- * the window to be redisplayed.
- */
-
- Tk_GeometryRequest(higzPtr->tkwin, higzPtr->width, higzPtr->height);
- if (!higzPtr->updatePending) {
- Tk_DoWhenIdle(HigzDisplay, (ClientData) higzPtr);
- higzPtr->updatePending = 1;
- }
- return TCL_OK;
-}
-
-/*
- *--------------------------------------------------------------
- *
- * HigzEventProc --
- *
- * This procedure is invoked by the Tk dispatcher for various
- * events on higzs.
- *
- * Results:
- * None.
- *
- * Side effects:
- * When the window gets deleted, internal structures get
- * cleaned up. When it gets exposed, it is redisplayed.
- *
- *--------------------------------------------------------------
- */
-
-static void
-HigzEventProc(clientData, eventPtr)
- ClientData clientData; /* Information about window. */
- XEvent *eventPtr; /* Information about event. */
-{
- Higz *higzPtr = (Higz *) clientData;
- Tk_Window tkwin = higzPtr->tkwin;
-
-#define IGRSIZ(IWKID) \
- CCALLSFSUB1(IGRSIZ,igrsiz,INT,IWKID)
-
- if (eventPtr->type == Expose) {
- if (!higzPtr->updatePending) {
- Tk_DoWhenIdle(HigzDisplay, (ClientData) higzPtr);
- higzPtr->updatePending = 1;
- }
- } else if (eventPtr->type == ConfigureNotify) {
-
- Window root;
- int xval, yval, wiid;
- unsigned int wval, hval, border, depth;
- float rval;
-
- XGetGeometry( higzPtr->display, Tk_WindowId(higzPtr->tkwin),
- &root, &xval, &yval, &wval, &hval, &border, &depth );
-
- IGRSIZ( higzPtr->higzwin );
-
- if (!higzPtr->updatePending) {
- Tk_DoWhenIdle(HigzDisplay, (ClientData) higzPtr);
- higzPtr->updatePending = 1;
- }
-
- } else if (eventPtr->type == DestroyNotify) {
- Tcl_DeleteCommand(higzPtr->interp, Tk_PathName(higzPtr->tkwin));
- higzPtr->tkwin = NULL;
- if (higzPtr->updatePending) {
- Tk_CancelIdleCall(HigzDisplay, (ClientData) higzPtr);
- }
- Tk_EventuallyFree((ClientData) higzPtr, HigzDestroy);
- }
-}
-
-/*
- *--------------------------------------------------------------
- *
- * HigzDisplay --
- *
- * This procedure redraws the contents of a higz window.
- * It is invoked as a do-when-idle handler, so it only runs
- * when there's nothing else for the application to do.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Information appears on the screen.
- *
- *--------------------------------------------------------------
- */
-
-static void
-HigzDisplay(clientData)
- ClientData clientData; /* Information about window. */
-{
- Higz *higzPtr = (Higz *) clientData;
- Tk_Window tkwin = higzPtr->tkwin;
- Drawable d;
-
- higzPtr->updatePending = 0;
- if (!Tk_IsMapped(tkwin)) {
- return;
- } else {
-#ifdef _WINDOWS
-#define IXUPDWI(I) \
- CCALLSFSUB1(IXUPDWI,ixupdwi,INT,I)
- IXUPDWI( 1 );
-#endif
- }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * HigzDestroy --
- *
- * This procedure is invoked by Tk_EventuallyFree or Tk_Release
- * to clean up the internal structure of a higz at a safe time
- * (when no-one is using it anymore).
- *
- * Results:
- * None.
- *
- * Side effects:
- * Everything associated with the higz is freed up.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-HigzDestroy(clientData)
- ClientData clientData; /* Info about higz widget. */
-{
- Higz *higzPtr = (Higz *) clientData;
-
-#define ICLWK(IWK) CCALLSFSUB1(ICLWK,iclwk,INT,IWK)
-
- ICLWK(higzPtr->higzwin);
- Tk_FreeOptions(configSpecs, (char *) higzPtr, higzPtr->display, 0);
- if (higzPtr->gc != None) {
- Tk_FreeGC(higzPtr->display, higzPtr->gc);
- }
- ckfree((char *) higzPtr);
-}
-#endif
diff --git a/src/graflib/higz/higzcc/x11int.c b/src/graflib/higz/higzcc/x11int.c
deleted file mode 100644
index 9a186a0..0000000
--- a/src/graflib/higz/higzcc/x11int.c
+++ /dev/null
@@ -1,3494 +0,0 @@
-/*
- * $Id: x11int.c,v 1.20 2000/07/08 06:19:30 couet Exp $
- *
- * $Log: x11int.c,v $
- * Revision 1.20 2000/07/08 06:19:30 couet
- * - with an external window as parent, the position of the window created by
- * ixopnwi was not correct.
- *
- * Revision 1.19 1999/04/01 09:20:24 couet
- * - MapNotify is not supported by all the X11 emulators (problem on Mac !!!)
- *
- * Revision 1.18 1999/01/08 14:07:10 couet
- * - imgscaling prototype only in GIF is selected
- *
- * Revision 1.17 1999/01/08 13:56:56 couet
- * - prototype for imgscaling
- *
- * Revision 1.16 1998/11/16 11:11:17 couet
- * - ixdogif can scale pictures
- *
- * Revision 1.15 1998/11/13 14:13:23 couet
- * - uses image size instead of window size in ixdogif
- *
- * Revision 1.14 1998/11/13 10:49:07 couet
- * - New version of the routine imgpickpalette coming from a C++ version
- * from Fons Rademakers. This version allows to work on TrueColor
- * devices. ixdogif in x11int.c has been modified in order to use this
- * new version of imgpickpalette. Protections have been added in
- * ixdogif to prevent some crashes when one try to create a gif after
- * a window resizing or when the program (for example PAW) started
- * with a workstation type equal to 0. All the static arrays in ixdogif
- * have been converted into dynamic one.
- *
- * Revision 1.13 1998/11/11 16:23:39 couet
- * - Protection added in ixdogif in case the Visual is TrueColor
- *
- * Revision 1.12 1998/10/28 10:05:37 couet
- * - a printf (debug) has been removed
- *
- * Revision 1.10 1998/01/30 15:22:06 couet
- * - APOLLO version removed
- *
- * Revision 1.9 1997/06/20 15:07:19 couet
- * - protection added in ixdogif in case the output file (gif) cannot be open.
- *
- * Revision 1.8 1997/04/22 08:42:57 couet
- * - The delete option in the WM top left button is disabled because it stopped
- * the application.
- *
- * Revision 1.7 1996/10/16 13:50:50 couet
- * - Remaining defined colors are freed in ixclsds
- *
- * Revision 1.6 1996/04/23 08:36:54 couet
- * - The test on "display" in ixopnds was not correct. In the case of Paw++
- * the display is set outside the ixopnds routine and in that case the
- * graphics contexts was not initialized. Now the variable isdisp is tested.
- *
- * Revision 1.5 1996/04/19 16:23:52 maartenb
- * - Use XFreeFontNames() to free fontlist
- *
- * Revision 1.4 1996/04/19 13:23:00 couet
- * - free(fontlist) was misplaced
- *
- * Revision 1.3 1996/04/19 12:10:31 couet
- * - Free fontlist to avoid memory leak
- *
- * Revision 1.2 1996/04/18 14:36:12 couet
- * - ixopnds exit with return code 0 if the display is already open.
- *
- * - Modify the way the fonts are managed to avoid memory leak.
- *
- * Revision 1.1.1.1 1996/02/14 13:10:26 mclareni
- * Higz
- *
- */
-#include "higz/pilot.h"
-#if (defined(CERNLIB_X11))&&(!defined(CERNLIB_WINNT))
-
-/******************************************************************************
- * *
- *-- Author : O.Couet *
- * *
- * Fortran interface to X11 window routines for HIGZ *
- * *
- ******************************************************************************/
-
-#include <stdio.h>
-#include <string.h>
-#include <stdlib.h>
-#include <ctype.h>
-#include <math.h>
-#if defined(CERNLIB_CRAY)
-#include <fortran.h>
-#endif
-#if defined(CERNLIB_VAX)
-#include <descrip.h>
-#include <lnmdef.h>
-#include <types.h>
-#include <socket.h> /* for gethostname() */
-#define CADDR_T /* defined in types.h would be redefined in Xlib.h */
-#include <decw$include/Xlib.h>
-#include <decw$include/Xutil.h>
-#include <decw$include/Xatom.h>
-#include <decw$include/cursorfont.h>
-#include <decw$include/keysym.h>
-#endif
-#if defined(CERNLIB_IBM)
-#include <types.h>
-#endif
-#if !defined(CERNLIB_VAX)
-#include <X11/Xlib.h>
-#include <X11/Xutil.h>
-#include <X11/Xatom.h>
-#include <X11/cursorfont.h>
-#include <X11/keysym.h>
-#endif
-#if defined(CERNLIB_CRAY)
-#define ixclip IXCLIP
-#define ixclrwi IXCLRWI
-#define ixclsds IXCLSDS
-#define ixclswi IXCLSWI
-#define ixflare IXFLARE
-#define ixgetge IXGETGE
-#define ixgetpl IXGETPL
-#define ixgetht IXGETHT
-#define ixgetwi IXGETWI
-#define ixline IXLINE
-#define ixmarke IXMARKE
-#define ixnocli IXNOCLI
-#define ixopnds IXOPNDS
-#define ixopnwi IXOPNWI
-#define ixreqlo IXREQLO
-#define ixqptr IXQPTR
-#define ixwarp IXWARP
-#define ixreqst IXREQST
-#define ixselwi IXSELWI
-#define ixsetco IXSETCO
-#define ixsetfc IXSETFC
-#define ixsetfs IXSETFS
-#define ixsetlc IXSETLC
-#define ixsetln IXSETLN
-#define ixsetls IXSETLS
-#define ixsetmc IXSETMC
-#define ixsetms IXSETMS
-#define ixsetta IXSETTA
-#define ixsettc IXSETTC
-#define ixsettf IXSETTF
-#define ixtext IXTEXT
-#define ixupdwi IXUPDWI
-#define ixbox IXBOX
-#define ixtxtl IXTXTL
-#define ixdrmde IXDRMDE
-#define ixsync IXSYNC
-#define ixsethn IXSETHN
-#define ixopnpx IXOPNPX
-#define ixclpx IXCLPX
-#define ixcppx IXCPPX
-#define ixrmpx IXRMPX
-#define ixwipx IXWIPX
-#define ixclrpx IXCLRPX
-#define ixs2buf IXS2BUF
-#define ixq2buf IXQ2BUF
-#define ixwrpx IXWRPX
-#define ixrsiz IXRSIZ
-#define ixsavwi IXSAVWI
-#define ixsetwi IXSETWI
-#define ixrscwi IXRSCWI
-#define ixmovwi IXMOVWI
-#define ixminit IXMINIT
-#define ixca IXCA
-#endif
-#if (defined(CERNLIB_CRAY))&&(defined(CERNLIB_GIF))
-#define ixdogif IXDOGIF
-#define ixldgif IXLDGIF
-#endif
-#if defined(CERNLIB_IBM)
-#pragma linkage (ixclip ,FORTRAN)
-#pragma linkage (ixclrwi,FORTRAN)
-#pragma linkage (ixclsds,FORTRAN)
-#pragma linkage (ixclswi,FORTRAN)
-#pragma linkage (ixflare,FORTRAN)
-#pragma linkage (ixgetge,FORTRAN)
-#pragma linkage (ixgetpl,FORTRAN)
-#pragma linkage (ixgetht,FORTRAN)
-#pragma linkage (ixgetwi,FORTRAN)
-#pragma linkage (ixline ,FORTRAN)
-#pragma linkage (ixmarke,FORTRAN)
-#pragma linkage (ixnocli,FORTRAN)
-#pragma linkage (ixopnds,FORTRAN)
-#pragma linkage (ixopnwi,FORTRAN)
-#pragma linkage (ixreqlo,FORTRAN)
-#pragma linkage (ixqptr ,FORTRAN)
-#pragma linkage (ixwarp ,FORTRAN)
-#pragma linkage (ixreqst,FORTRAN)
-#pragma linkage (ixselwi,FORTRAN)
-#pragma linkage (ixsetco,FORTRAN)
-#pragma linkage (ixsetfc,FORTRAN)
-#pragma linkage (ixsetfs,FORTRAN)
-#pragma linkage (ixsetlc,FORTRAN)
-#pragma linkage (ixsetln,FORTRAN)
-#pragma linkage (ixsetls,FORTRAN)
-#pragma linkage (ixsetmc,FORTRAN)
-#pragma linkage (ixsetms,FORTRAN)
-#pragma linkage (ixsetta,FORTRAN)
-#pragma linkage (ixsettc,FORTRAN)
-#pragma linkage (ixsettf,FORTRAN)
-#pragma linkage (ixtext ,FORTRAN)
-#pragma linkage (ixupdwi,FORTRAN)
-#pragma linkage (ixbox ,FORTRAN)
-#pragma linkage (ixtxtl ,FORTRAN)
-#pragma linkage (ixdrmde,FORTRAN)
-#pragma linkage (ixsync ,FORTRAN)
-#pragma linkage (ixsethn,FORTRAN)
-#pragma linkage (ixopnpx,FORTRAN)
-#pragma linkage (ixclpx ,FORTRAN)
-#pragma linkage (ixcppx ,FORTRAN)
-#pragma linkage (ixrmpx ,FORTRAN)
-#pragma linkage (ixwipx ,FORTRAN)
-#pragma linkage (ixclrpx,FORTRAN)
-#pragma linkage (ixs2buf,FORTRAN)
-#pragma linkage (ixq2buf,FORTRAN)
-#pragma linkage (ixwrpx ,FORTRAN)
-#pragma linkage (ixrsiz ,FORTRAN)
-#pragma linkage (ixsavwi,FORTRAN)
-#pragma linkage (ixsetwi,FORTRAN)
-#pragma linkage (ixrscwi,FORTRAN)
-#pragma linkage (ixmovwi,FORTRAN)
-#pragma linkage (ixminit,FORTRAN)
-#pragma linkage (ixca ,FORTRAN)
-#define XRotDrawString XRDS
-#define XRotDrawImageString XRDIS
-#define XRotDrawAlignedString XRDAS
-#define XRotDrawAlignedImageString XRDAIS
-#endif
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB_GIF))
-#pragma linkage (ixdogif,FORTRAN)
-#pragma linkage (ixldgif,FORTRAN)
-#endif
-#if defined(CERNLIB_QX_SC)
-#define ixclip ixclip_
-#define ixclrwi ixclrwi_
-#define ixclsds ixclsds_
-#define ixclswi ixclswi_
-#define ixflare ixflare_
-#define ixgetge ixgetge_
-#define ixgetpl ixgetpl_
-#define ixgetht ixgetht_
-#define ixgetwi ixgetwi_
-#define ixline ixline_
-#define ixmarke ixmarke_
-#define ixnocli ixnocli_
-#define ixopnds ixopnds_
-#define ixopnwi ixopnwi_
-#define ixreqlo ixreqlo_
-#define ixqptr ixqptr_
-#define ixwarp ixwarp_
-#define ixreqst ixreqst_
-#define ixselwi ixselwi_
-#define ixsetco ixsetco_
-#define ixsetfc ixsetfc_
-#define ixsetfs ixsetfs_
-#define ixsetlc ixsetlc_
-#define ixsetln ixsetln_
-#define ixsetls ixsetls_
-#define ixsetmc ixsetmc_
-#define ixsetms ixsetms_
-#define ixsetta ixsetta_
-#define ixsettc ixsettc_
-#define ixsettf ixsettf_
-#define ixtext ixtext_
-#define ixupdwi ixupdwi_
-#define ixbox ixbox_
-#define ixtxtl ixtxtl_
-#define ixdrmde ixdrmde_
-#define ixsync ixsync_
-#define ixsethn ixsethn_
-#define ixopnpx ixopnpx_
-#define ixclpx ixclpx_
-#define ixcppx ixcppx_
-#define ixrmpx ixrmpx_
-#define ixwipx ixwipx_
-#define ixclrpx ixclrpx_
-#define ixs2buf ixs2buf_
-#define ixq2buf ixq2buf_
-#define ixwrpx ixwrpx_
-#define ixrsiz ixrsiz_
-#define ixsavwi ixsavwi_
-#define ixsetwi ixsetwi_
-#define ixrscwi ixrscwi_
-#define ixmovwi ixmovwi_
-#define ixminit ixminit_
-#define ixca ixca_
-#endif
-#if (defined(CERNLIB_QX_SC))&&(defined(CERNLIB_GIF))
-#define ixdogif ixdogif_
-#define ixldgif ixldgif_
-#endif
-#if (defined(CERNLIB_TKTCL))&&(defined(CERNLIB_WINNT))
-#define ixclip __stdcall IXCLIP
-#define ixclrwi __stdcall IXCLRWI
-#define ixclsds __stdcall IXCLSDS
-#define ixclswi __stdcall IXCLSWI
-#define ixflare __stdcall IXFLARE
-#define ixgetge __stdcall IXGETGE
-#define ixgetpl __stdcall IXGETPL
-#define ixgetht __stdcall IXGETHT
-#define ixgetwi __stdcall IXGETWI
-#define ixline __stdcall IXLINE
-#define ixmarke __stdcall IXMARKE
-#define ixnocli __stdcall IXNOCLI
-#define ixopnds __stdcall IXOPNDS
-#define ixopnwi __stdcall IXOPNWI
-#define ixreqlo __stdcall IXREQLO
-#define ixqptr __stdcall IXQPTR
-#define ixwarp __stdcall IXWARP
-#define ixreqst __stdcall IXREQST
-#define ixselwi __stdcall IXSELWI
-#define ixsetco __stdcall IXSETCO
-#define ixsetfc __stdcall IXSETFC
-#define ixsetfs __stdcall IXSETFS
-#define ixsetlc __stdcall IXSETLC
-#define ixsetln __stdcall IXSETLN
-#define ixsetls __stdcall IXSETLS
-#define ixsetmc __stdcall IXSETMC
-#define ixsetms __stdcall IXSETMS
-#define ixsetta __stdcall IXSETTA
-#define ixsettc __stdcall IXSETTC
-#define ixsettf __stdcall IXSETTF
-#define ixtext __stdcall IXTEXT
-#define ixupdwi __stdcall IXUPDWI
-#define ixbox __stdcall IXBOX
-#define ixtxtl __stdcall IXTXTL
-#define ixdrmde __stdcall IXDRMDE
-#define ixsync __stdcall IXSYNC
-#define ixsethn __stdcall IXSETHN
-#define ixopnpx __stdcall IXOPNPX
-#define ixclpx __stdcall IXCLPX
-#define ixcppx __stdcall IXCPPX
-#define ixrmpx __stdcall IXRMPX
-#define ixwipx __stdcall IXWIPX
-#define ixclrpx __stdcall IXCLRPX
-#define ixs2buf __stdcall IXS2BUF
-#define ixq2buf __stdcall IXQ2BUF
-#define ixwrpx __stdcall IXWRPX
-#define ixrsiz __stdcall IXRSIZ
-#define ixsavwi __stdcall IXSAVWI
-#define ixsetwi __stdcall IXSETWI
-#define ixrscwi __stdcall IXRSCWI
-#define ixmovwi __stdcall IXMOVWI
-#define ixminit __stdcall IXMINIT
-#define ixca __stdcall IXCA
-#endif
-#if (defined(CERNLIB_TKTCL))&&(defined(CERNLIB_WINNT))&&(defined(CERNLIB_GIF))
-#define ixdogif __stdcall IXDOGIF
-#define ixldgif __stdcall IXLDGIF
-#endif
-
-#define max(a,b) ((a) > (b) ? (a) : (b))
-#define min(a,b) ((a) < (b) ? (a) : (b))
-
-#define forever while(1)
-#define LNULL 0L
-
-#define MAXWN 20 /* maximum number of windows */
-static struct {
- int open; /* 1 if the window is open, 0 if not */
- int motif; /* 1 if the window is a motif window */
- Drawable motif_window; /* adress of the Motif window */
- int double_buffer; /* 1 if the double buffer is on, 0 if not */
- Drawable drawing; /* drawing area, equal to window or buffer */
- Drawable window; /* X11 window */
- Drawable buffer; /* pixmap used for double buffer */
- int width; /* width of the window */
- int height; /* height of the window */
- int clip; /* 1 if the clipping is on */
- int xclip; /* x coordinate of the clipping rectangle */
- int yclip; /* y coordinate of the clipping rectangle */
- int wclip; /* width of the clipping rectangle */
- int hclip; /* height of the clipping rectangle */
-} windows[MAXWN], /* windows : list of the opened windows */
- *cws, *tws, *sws; /* cws : pointer to the current window */
- /* tws : temporary pointer */
- /* sws : saved window (ixsavwi ixsetwi) */
-
-Drawable oldwin; /* allows to save the current opened window */
-static int ispix = 0; /* if ispix=1 a pixmap has been opened */
-
-static XClassHint class_hints = {"higz", "HIGZ"}; /* Class name is HIGZ */
-
-static Display *display;
-static int isdisp = 0; /* if isdisp=1 the display has been opened */
-static Screen *screen;
-static int screen_number;
-static char hname[132]; /* host name */
-static char vendor[132]; /* output of XServerVendor */
-
-static Window (*motif_open) (); /* external routine to open a motif window */
-static void (*motif_init) (); /* external routine to init a motif window */
-static void (*motif_close) (); /* external routine to close a motif window */
-
-static int external_int = 0;
-static Drawable external_window;
-
-static int do_raise = 0; /* if do_raise =1 cws is raised in ixupdwi */
-
-/*
- * colors[1] : foreground also used for b/w screen
- * colors[0] : background also used for b/w screen
- * colors[2..MAXCOL-1] : colors which can be set by IXSETCO
- */
-static int colored; /* Flag if color screen */
-static Colormap colormap; /* Maba's Colormap */
-
-#define MAXCOL 256
-static struct {
- int defined;
- unsigned long pixel;
- float red;
- float green;
- float blue;
-} colors[MAXCOL] = {0, 0, 1., 1., 1.};
-
-/*
- * Primitives Graphic Contexts global for all windows
- */
-#define MAXGC 7
-static GC gclist[MAXGC];
-static GC *gcline = &gclist[0]; /* Polylines */
-static GC *gcmark = &gclist[1]; /* Polymarker */
-static GC *gcfill = &gclist[2]; /* Fill areas */
-static GC *gctext = &gclist[3]; /* Text */
-static GC *gcinvt = &gclist[4]; /* Inverse text */
-static GC *gcdash = &gclist[5]; /* Dashed lines */
-static GC *gcpxmp = &gclist[6]; /* Pixmap management */
-
-static unsigned long gc_mask = GCForeground | GCBackground;
-static XGCValues gc_return;
-
-/*
- * Input echo Graphic Context global for all windows
- */
-static GC gcecho; /* input echo */
-static XGCValues gcechov;
-
-static int fill_hollow; /* Flag if fill style is hollow */
-static Pixmap fill_pattern = (Pixmap)LNULL; /* Fill pattern */
-static int current_fasi = 0; /* Current fill area style index */
-static int text_align = 0; /* Align text left, center, right */
-
-/*
- * Text management
- */
-#define MAXFONT 4
-static struct {
- XFontStruct *id;
- char name[80]; /* font name */
-} font[MAXFONT]; /* list of fonts loaded */
-static XFontStruct *text_font; /* current font */
-static int current_font_number = 0; /* current font number in font[] */
-
-/*
- * keep style values for line GC
- */
-static int line_width = 0;
-static int line_style = LineSolid;
-static int cap_style = CapButt;
-static int join_style = JoinMiter;
-static char dash_list[4];
-static int dash_length = 0;
-static int dash_offset = 0;
-
-/*
- * event masks
- */
-static unsigned long mouse_mask = ButtonPressMask | ButtonReleaseMask |
- EnterWindowMask | LeaveWindowMask |
- PointerMotionMask | KeyPressMask |
- KeyReleaseMask;
-static unsigned long keybd_mask = ButtonPressMask | KeyPressMask |
- EnterWindowMask | LeaveWindowMask;
-
-/*
- * last cursor positions
- */
-static int xloc = 0;
-static int yloc = 0;
-static int xlocp = 0;
-static int ylocp = 0;
-
-/*
- * data to create an invisible cursor
- */
-static char null_cursor_bits[] = {
-0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
-static Cursor null_cursor = (Cursor)LNULL;
-
-/*
- * data to create fill area interior style
- */
-#if defined(CERNLIB_TK_WINDOWS)
-#define Hatches_type static unsigned char
-#endif
-#if !defined(CERNLIB_TK_WINDOWS)
-#define Hatches_type static char
-#endif
-
-Hatches_type p1_bits[] = {
- 0xaa, 0xaa, 0x55, 0x55, 0xaa, 0xaa, 0x55, 0x55, 0xaa, 0xaa, 0x55, 0x55,
- 0xaa, 0xaa, 0x55, 0x55, 0xaa, 0xaa, 0x55, 0x55, 0xaa, 0xaa, 0x55, 0x55,
- 0xaa, 0xaa, 0x55, 0x55, 0xaa, 0xaa, 0x55, 0x55};
-Hatches_type p2_bits[] = {
- 0x44, 0x44, 0x11, 0x11, 0x44, 0x44, 0x11, 0x11, 0x44, 0x44, 0x11, 0x11,
- 0x44, 0x44, 0x11, 0x11, 0x44, 0x44, 0x11, 0x11, 0x44, 0x44, 0x11, 0x11,
- 0x44, 0x44, 0x11, 0x11, 0x44, 0x44, 0x11, 0x11};
-Hatches_type p3_bits[] = {
- 0x00, 0x00, 0x44, 0x44, 0x00, 0x00, 0x11, 0x11, 0x00, 0x00, 0x44, 0x44,
- 0x00, 0x00, 0x11, 0x11, 0x00, 0x00, 0x44, 0x44, 0x00, 0x00, 0x11, 0x11,
- 0x00, 0x00, 0x44, 0x44, 0x00, 0x00, 0x11, 0x11};
-Hatches_type p4_bits[] = {
- 0x80, 0x80, 0x40, 0x40, 0x20, 0x20, 0x10, 0x10, 0x08, 0x08, 0x04, 0x04,
- 0x02, 0x02, 0x01, 0x01, 0x80, 0x80, 0x40, 0x40, 0x20, 0x20, 0x10, 0x10,
- 0x08, 0x08, 0x04, 0x04, 0x02, 0x02, 0x01, 0x01};
-Hatches_type p5_bits[] = {
- 0x20, 0x20, 0x40, 0x40, 0x80, 0x80, 0x01, 0x01, 0x02, 0x02, 0x04, 0x04,
- 0x08, 0x08, 0x10, 0x10, 0x20, 0x20, 0x40, 0x40, 0x80, 0x80, 0x01, 0x01,
- 0x02, 0x02, 0x04, 0x04, 0x08, 0x08, 0x10, 0x10};
-Hatches_type p6_bits[] = {
- 0x44, 0x44, 0x44, 0x44, 0x44, 0x44, 0x44, 0x44, 0x44, 0x44, 0x44, 0x44,
- 0x44, 0x44, 0x44, 0x44, 0x44, 0x44, 0x44, 0x44, 0x44, 0x44, 0x44, 0x44,
- 0x44, 0x44, 0x44, 0x44, 0x44, 0x44, 0x44, 0x44};
-Hatches_type p7_bits[] = {
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0xff, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0xff, 0xff, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0xff,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0xff};
-Hatches_type p8_bits[] = {
- 0x11, 0x11, 0xb8, 0xb8, 0x7c, 0x7c, 0x3a, 0x3a, 0x11, 0x11, 0xa3, 0xa3,
- 0xc7, 0xc7, 0x8b, 0x8b, 0x11, 0x11, 0xb8, 0xb8, 0x7c, 0x7c, 0x3a, 0x3a,
- 0x11, 0x11, 0xa3, 0xa3, 0xc7, 0xc7, 0x8b, 0x8b};
-Hatches_type p9_bits[] = {
- 0x10, 0x10, 0x10, 0x10, 0x28, 0x28, 0xc7, 0xc7, 0x01, 0x01, 0x01, 0x01,
- 0x82, 0x82, 0x7c, 0x7c, 0x10, 0x10, 0x10, 0x10, 0x28, 0x28, 0xc7, 0xc7,
- 0x01, 0x01, 0x01, 0x01, 0x82, 0x82, 0x7c, 0x7c};
-Hatches_type p10_bits[] = {
- 0x10, 0x10, 0x10, 0x10, 0x10, 0x10, 0xff, 0xff, 0x01, 0x01, 0x01, 0x01,
- 0x01, 0x01, 0xff, 0xff, 0x10, 0x10, 0x10, 0x10, 0x10, 0x10, 0xff, 0xff,
- 0x01, 0x01, 0x01, 0x01, 0x01, 0x01, 0xff, 0xff};
-Hatches_type p11_bits[] = {
- 0x08, 0x08, 0x49, 0x49, 0x2a, 0x2a, 0x1c, 0x1c, 0x2a, 0x2a, 0x49, 0x49,
- 0x08, 0x08, 0x00, 0x00, 0x80, 0x80, 0x94, 0x94, 0xa2, 0xa2, 0xc1, 0xc1,
- 0xa2, 0xa2, 0x94, 0x94, 0x80, 0x80, 0x00, 0x00};
-Hatches_type p12_bits[] = {
- 0x1c, 0x1c, 0x22, 0x22, 0x41, 0x41, 0x41, 0x41, 0x41, 0x41, 0x22, 0x22,
- 0x1c, 0x1c, 0x00, 0x00, 0xc1, 0xc1, 0x22, 0x22, 0x14, 0x14, 0x14, 0x14,
- 0x14, 0x14, 0x22, 0x22, 0xc1, 0xc1, 0x00, 0x00};
-Hatches_type p13_bits[] = {
- 0x01, 0x01, 0x82, 0x82, 0x44, 0x44, 0x28, 0x28, 0x10, 0x10, 0x28, 0x28,
- 0x44, 0x44, 0x82, 0x82, 0x01, 0x01, 0x82, 0x82, 0x44, 0x44, 0x28, 0x28,
- 0x10, 0x10, 0x28, 0x28, 0x44, 0x44, 0x82, 0x82};
-Hatches_type p14_bits[] = {
- 0xff, 0xff, 0x11, 0x10, 0x11, 0x10, 0x11, 0x10, 0xf1, 0x1f, 0x11, 0x11,
- 0x11, 0x11, 0x11, 0x11, 0xff, 0x11, 0x01, 0x11, 0x01, 0x11, 0x01, 0x11,
- 0xff, 0xff, 0x01, 0x10, 0x01, 0x10, 0x01, 0x10};
-Hatches_type p15_bits[] = {
- 0x22, 0x22, 0x55, 0x55, 0x22, 0x22, 0x00, 0x00, 0x88, 0x88, 0x55, 0x55,
- 0x88, 0x88, 0x00, 0x00, 0x22, 0x22, 0x55, 0x55, 0x22, 0x22, 0x00, 0x00,
- 0x88, 0x88, 0x55, 0x55, 0x88, 0x88, 0x00, 0x00};
-Hatches_type p16_bits[] = {
- 0x0e, 0x0e, 0x11, 0x11, 0xe0, 0xe0, 0x00, 0x00, 0x0e, 0x0e, 0x11, 0x11,
- 0xe0, 0xe0, 0x00, 0x00, 0x0e, 0x0e, 0x11, 0x11, 0xe0, 0xe0, 0x00, 0x00,
- 0x0e, 0x0e, 0x11, 0x11, 0xe0, 0xe0, 0x00, 0x00};
-Hatches_type p17_bits[] = {
- 0x44, 0x44, 0x22, 0x22, 0x11, 0x11, 0x00, 0x00, 0x44, 0x44, 0x22, 0x22,
- 0x11, 0x11, 0x00, 0x00, 0x44, 0x44, 0x22, 0x22, 0x11, 0x11, 0x00, 0x00,
- 0x44, 0x44, 0x22, 0x22, 0x11, 0x11, 0x00, 0x00};
-Hatches_type p18_bits[] = {
- 0x11, 0x11, 0x22, 0x22, 0x44, 0x44, 0x00, 0x00, 0x11, 0x11, 0x22, 0x22,
- 0x44, 0x44, 0x00, 0x00, 0x11, 0x11, 0x22, 0x22, 0x44, 0x44, 0x00, 0x00,
- 0x11, 0x11, 0x22, 0x22, 0x44, 0x44, 0x00, 0x00};
-Hatches_type p19_bits[] = {
- 0xe0, 0x03, 0x98, 0x0c, 0x84, 0x10, 0x42, 0x21, 0x42, 0x21, 0x21, 0x42,
- 0x19, 0x4c, 0x07, 0xf0, 0x19, 0x4c, 0x21, 0x42, 0x42, 0x21, 0x42, 0x21,
- 0x84, 0x10, 0x98, 0x0c, 0xe0, 0x03, 0x80, 0x00};
-Hatches_type p20_bits[] = {
- 0x22, 0x22, 0x11, 0x11, 0x11, 0x11, 0x11, 0x11, 0x22, 0x22, 0x44, 0x44,
- 0x44, 0x44, 0x44, 0x44, 0x22, 0x22, 0x11, 0x11, 0x11, 0x11, 0x11, 0x11,
- 0x22, 0x22, 0x44, 0x44, 0x44, 0x44, 0x44, 0x44};
-Hatches_type p21_bits[] = {
- 0xf1, 0xf1, 0x10, 0x10, 0x10, 0x10, 0x10, 0x10, 0x1f, 0x1f, 0x01, 0x01,
- 0x01, 0x01, 0x01, 0x01, 0xf1, 0xf1, 0x10, 0x10, 0x10, 0x10, 0x10, 0x10,
- 0x1f, 0x1f, 0x01, 0x01, 0x01, 0x01, 0x01, 0x01};
-Hatches_type p22_bits[] = {
- 0x8f, 0x8f, 0x08, 0x08, 0x08, 0x08, 0x08, 0x08, 0xf8, 0xf8, 0x80, 0x80,
- 0x80, 0x80, 0x80, 0x80, 0x8f, 0x8f, 0x08, 0x08, 0x08, 0x08, 0x08, 0x08,
- 0xf8, 0xf8, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80};
-Hatches_type p23_bits[] = {
- 0xAA, 0xAA, 0x55, 0x55, 0x6a, 0x6a, 0x74, 0x74, 0x78, 0x78, 0x74, 0x74,
- 0x6a, 0x6a, 0x55, 0x55, 0xAA, 0xAA, 0x55, 0x55, 0x6a, 0x6a, 0x74, 0x74,
- 0x78, 0x78, 0x74, 0x74, 0x6a, 0x6a, 0x55, 0x55};
-Hatches_type p24_bits[] = {
- 0x80, 0x00, 0xc0, 0x00, 0xea, 0xa8, 0xd5, 0x54, 0xea, 0xa8, 0xd5, 0x54,
- 0xeb, 0xe8, 0xd5, 0xd4, 0xe8, 0xe8, 0xd4, 0xd4, 0xa8, 0xe8, 0x54, 0xd5,
- 0xa8, 0xea, 0x54, 0xd5, 0xfc, 0xff, 0xfe, 0xff};
-Hatches_type p25_bits[] = {
- 0x80, 0x00, 0xc0, 0x00, 0xe0, 0x00, 0xf0, 0x00, 0xff, 0xf0, 0xff, 0xf0,
- 0xfb, 0xf0, 0xf9, 0xf0, 0xf8, 0xf0, 0xf8, 0x70, 0xf8, 0x30, 0xff, 0xf0,
- 0xff, 0xf8, 0xff, 0xfc, 0xff, 0xfe, 0xff, 0xff};
-
-
-#define MAXMK 100
-static struct {
- int type;
- int n;
- XPoint xy[MAXMK];
-} marker; /* point list to draw marker */
-
-#if defined(CERNLIB_GIF)
-XImage * ImgScaling(Display *, XImage *, int, int);
-#endif
-
-/*
- * Set input on or off
- */
-void
- setinput(inp)
-int inp;
-{
- XSetWindowAttributes attributes;
- unsigned long attr_mask = 0;
-
- if( inp == 1 ) {
- attributes.event_mask = mouse_mask | keybd_mask;
- attr_mask |= CWEventMask;
- XChangeWindowAttributes ( display, cws->window, attr_mask, &attributes);
- }
- else {
- attr_mask = 0;
- attributes.event_mask = NoEventMask;
- attr_mask |= CWEventMask;
- XChangeWindowAttributes ( display, cws->window, attr_mask, &attributes);
- }
-}
-
-
-/*
- * set the foreground color in GC
- */
-void
- setcolor( gc, ci )
-GC gc;
-int ci;
-{
- if( colored && ( ci < 0 || ci >= MAXCOL || !colors[ci].defined ) )
- {
- ci = 0;
- }
- else if (!colored && ci < 0 )
- {
- ci = 0;
- }
- else if (!colored && ci > 0 )
- {
- ci = 1;
- }
-
- XSetForeground( display, gc, colors[ci].pixel );
-
- /* make sure that foreground and background are different */
-#if (!defined(CERNLIB_TK_WINDOWS))
- if ( XGetGCValues( display, gc, gc_mask, &gc_return) ) {
- if ( gc_return.foreground == gc_return.background )
- XSetBackground( display, gc, colors[!ci].pixel );
- } else {
- printf("**** Error: Cannot get GC values \n");
- }
-#endif
-}
-
-
-/*
- * return null terminated and blank trimmed string
- */
-char*
- string( s, l )
-char *s;
-int l;
-{
- static char str[256];
- int i;
-
- if( l >= sizeof( str ) )
- l = sizeof( str ) - 1;
-
- for( i = 0; i < l; i++ )
- str[i] = s[i];
- while( l > 0 && str[l-1] == ' ' )
- l--;
-
- str[l] = '\0';
- return( str );
-}
-
-#if defined(CERNLIB_TK_WINDOWS)
-void ixsgc(gc)
- GC gc;
-{
- gclist[0] = *gcline = gc;
- gclist[1] = *gcmark = gc;
- gclist[2] = *gcfill = gc;
- gclist[3] = *gctext = gc;
- gclist[4] = *gcinvt = gc;
- gclist[5] = *gcdash = gc;
- gclist[6] = *gcpxmp = gc;
-}
-
-void ixdsdb()
-{
- XCopyArea( display, cws->drawing, cws->window,
- *gcpxmp, 0, 0, cws->width, cws->height, 0, 0 );
-}
-#endif
-
-#if defined(CERNLIB_IBM)
-int isascii(c)
-int c;
-{
-return(isprint(c)||iscntrl(c));
-}
-#endif
-
-
-/*
- * Allows to set the DISPLAY and the WINDOW address
- * from outside HIGZ (ie a MOTIF program).
- */
-void
- ixsdswi( dsp , win )
- Display *dsp;
- Window win;
-{
- external_int = 1;
- external_window = win;
- display = dsp;
-}
-
-/*
- * Allows KUIP to give to HIGZ the adress of three routines:
- * 1) motif_open : to open a KUIP motif window
- * 2) motif_init : to initalize a KUIP motif window (add the callbacks)
- * 3) motif_close : to close a KUIP motif window
- */
-void
- ixmotif( dsp , open, init, close)
- Display *dsp;
- Window (*open)();
- void (*init)();
- void (*close)();
-{
- display = dsp;
- motif_open = open;
- motif_init = init;
- motif_close = close;
-}
-
-
-/*
- * SUBROUTINE IXMINIT(WID)
- * INTEGER WID : Window ID
- *
- * Initialize the Motif windows (add the callbacks)
- */
-void
- ixminit(wid)
- int *wid;
-{
- if (motif_init != NULL) (*motif_init) (*wid+1);
-}
-
-
-/*
- * SUBROUTINE IXSETHN(LENHST,HOST)
- * INTEGER LENHST : host name length
- * CHARACTER*(*) HOST : host name
- *
- * Set host name (fill global variable hname)
- */
-void
- ixsethn( lenhst,
-#if defined(CERNLIB_CRAY)
- fcd_host )
-_fcd fcd_host;
-#endif
-#if defined(CERNLIB_VAX)
- dsc_host )
-struct dsc$descriptor_s *dsc_host;
-#endif
-#if defined(CERNLIB_TK_WINDOWS)
- host,lenhost )
-char *host;
-int lenhost;
-#endif
-#if (!defined(CERNLIB_CRAY))&&(!defined(CERNLIB_VAX))&&(!defined(CERNLIB_TK_WINDOWS))
- host )
-char *host;
-#endif
-int *lenhst;
-{
-#if defined(CERNLIB_CRAY)
- char *host = _fcdtocp( fcd_host );
-#endif
-#if defined(CERNLIB_VAX)
- char *host = dsc_host->dsc$a_pointer;
-#endif
-
-strcpy (hname,string( host, *lenhst ));
-}
-
-
-/*
- * INTEGER FUNCTION IXOPNDS(LENHST,HOST)
- * INTEGER LENHST : host name length
- * CHARACTER*(*) HOST : host name
- *
- * Open the display. Return -1 if the opening fails
- */
-int
- ixopnds( lenhst,
-#if defined(CERNLIB_CRAY)
- fcd_host )
-_fcd fcd_host;
-#endif
-#if defined(CERNLIB_VAX)
- dsc_host )
-struct dsc$descriptor_s *dsc_host;
-#endif
-#if defined(CERNLIB_TK_WINDOWS)
- host, lenhost )
-char *host;
-int lenhost;
-#endif
-#if (!defined(CERNLIB_CRAY))&&(!defined(CERNLIB_VAX))&&(!defined(CERNLIB_TK_WINDOWS))
- host )
-char *host;
-#endif
-int *lenhst;
-{
-#if defined(CERNLIB_CRAY)
- char *host = _fcdtocp( fcd_host );
-#endif
-#if defined(CERNLIB_VAX)
- char *host = dsc_host->dsc$a_pointer;
-#endif
- Pixmap pixmp1,pixmp2;
- XColor fore,back;
- char **fontlist;
- int fontcount;
- int i;
- extern char *getenv();
-
-/*
- * Try to open the DISPLAY
- */
- if ( !isdisp ) {
- if( display == NULL ) {
-#if !defined(CERNLIB_VAX)
- if( *lenhst == 0 ) {
- display = XOpenDisplay( getenv( "DISPLAY" ) );
- } else {
- display = XOpenDisplay( string( host, *lenhst ));
- }
-#endif
-#if defined(CERNLIB_VAX)
- display = XOpenDisplay( string( host, *lenhst ));
-#endif
- if( display == NULL ) return( -1 );
- }
- } else {
- return( 0 );
- }
-
- screen_number = DefaultScreen( display );
- screen = ScreenOfDisplay( display, screen_number);
- colored = DisplayPlanes( display, screen_number ) > 1;
-
- if (colored) colormap = DefaultColormap( display, screen_number);
-
- /* colors[1].defined = 1; default foreground */
- colors[1].pixel = BlackPixel( display, screen_number );
- /* colors[0].defined = 1; default background */
- colors[0].pixel = WhitePixel( display, screen_number );
-
-/*
- * Inquire the the XServer Vendor
- */
-#if !defined(CERNLIB_TK_WINDOWS)
- strcpy (vendor,XServerVendor(display));
-#endif
-#if defined(CERNLIB_TK_WINDOWS)
- strcpy(vendor,"Microsoft");
-#endif
-
-/*
- * Create primitives graphic contexts
- */
- for ( i = 0; i < MAXGC; i++ )
- gclist[i] = XCreateGC( display, RootWindow( display, screen_number ),
- 0, NULL );
-#if (!defined(CERNLIB_TK_WINDOWS))
- if ( XGetGCValues( display, *gctext, gc_mask, &gc_return) ) {
- XSetForeground( display, *gcinvt, gc_return.background );
- XSetBackground( display, *gcinvt, gc_return.foreground );
- } else {
- printf("**** Error: Cannot get GC values \n");
- }
-#endif
-
-/*
- * Create input echo graphic context
- */
- gcechov.foreground = BlackPixel( display, screen_number );
- gcechov.background = WhitePixel( display, screen_number );
- if(strstr(vendor,"Hewlett")) {
- gcechov.function = GXxor;
- } else {
- gcechov.function = GXinvert;
- }
- gcecho = XCreateGC( display, RootWindow( display, screen_number ),
- GCForeground | GCBackground | GCFunction,
- &gcechov );
-/*
- * Load a default Font
- */
-#if !defined(CERNLIB_TK_WINDOWS)
- for ( i = 0; i < MAXFONT; i++ ) {
- font[i].id = NULL;
- strcpy( font[i].name, " " );
- }
- fontlist = XListFonts( display, "*courier*", 1, &fontcount );
- if ( fontcount != 0 ) {
- font[current_font_number].id = XLoadQueryFont( display, fontlist[0] );
- text_font = font[current_font_number].id;
- strcpy( font[current_font_number].name, "*courier*" );
- current_font_number++;
- XFreeFontNames(fontlist);
- } else {
- printf("No default font loaded \n");
- }
-#endif
-/*
- * Create a null cursor
- */
- pixmp1 = XCreateBitmapFromData(display,
- RootWindow( display, screen_number ),
- null_cursor_bits, 16, 16);
- pixmp2 = XCreateBitmapFromData(display,
- RootWindow( display, screen_number ),
- null_cursor_bits, 16, 16);
- null_cursor = XCreatePixmapCursor(display,pixmp1,pixmp2,&fore,&back,0,0);
-
- isdisp = 1;
- return( 0 );
-}
-
-
-/*
- * INTEGER FUNCTION IXOPNWI(X,Y,W,H,LENTIT,TITLE,FLAG)
- * INTEGER X,Y : initial window position
- * INTEGER W,H : initial window width and height
- * INTEGER LENTIT : title length
- * CHARACTER*(*) TITLE : window title
- * INTEGER FLAG : FLAG<>1 allows to open a non MOTIF window
- * even if ixmotif has been called.
- *
- * Open window and returns window number which can be used with IXSELWIN
- * return -1 if window creation fails
- */
-int
- ixopnwi( x, y, w, h, lentit,
-#if defined(CERNLIB_CRAY)
- fcd_title, flag )
-_fcd fcd_title;
-#endif
-#if defined(CERNLIB_VAX)
- dsc_title, flag )
-struct dsc$descriptor_s *dsc_title;
-#endif
-#if defined(CERNLIB_TK_WINDOWS)
- title, lentitle, flag )
-char *title;
-int lentitle;
-#endif
-#if (!defined(CERNLIB_CRAY))&&(!defined(CERNLIB_VAX))&&(!defined(CERNLIB_TK_WINDOWS))
- title, flag )
-char *title;
-#endif
-int *x, *y;
-int *w, *h;
-int *lentit;
-int *flag;
-{
-#if defined(CERNLIB_CRAY)
- char *title = _fcdtocp( fcd_title );
-#endif
-#if defined(CERNLIB_VAX)
- char *title = dsc_title->dsc$a_pointer;
-#endif
- XSetWindowAttributes attributes;
- unsigned long attr_mask = 0;
- char long_title[256];
- char host_name[64];
- XWMHints wm_hints;
- XSizeHints size_hints;
- Atom atm[1];
- Status istat;
- int wid;
- int xval, yval;
- unsigned int wval, hval, border, depth;
- Window root;
-
- if (external_int == 1) {
- XGetGeometry( display, external_window, &root,
- &xval, &yval, &wval, &hval, &border, &depth );
- xval = 0;
- yval = 0;
- }
- else {
- xval = *x;
- yval = *y;
- wval = *w;
- hval = *h;
- }
-
-/*
- * Select next free window number
- */
- for ( wid = 0; wid < MAXWN; wid++ )
- if ( !windows[wid].open ) {
- windows[wid].open = 1;
- cws = &windows[wid];
- break;
- }
-/*
- * Create a Motif window
- */
- if (motif_open != NULL && *flag == 0) {
- cws->motif_window = (*motif_open) (wid+1, xval, yval, wval, hval);
- if ( !cws->motif_window ) return( -1 );
- XGetGeometry( display, cws->motif_window, &root,
- &xval, &yval, &wval, &hval, &border, &depth );
- }
-
- if ( wid == MAXWN ) return( -1 );
-/*
- * Create window
- */
- attributes.background_pixel = colors[0].pixel;
- attr_mask |= CWBackPixel;
- attributes.border_pixel = colors[1].pixel;
- attr_mask |= CWBorderPixel;
- attributes.event_mask = NoEventMask;
- attr_mask |= CWEventMask;
- attributes.backing_store = Always;
- attr_mask |= CWBackingStore;
- if ( colored ) {
- attributes.colormap = colormap;
- attr_mask |= CWColormap;
- }
- if (motif_open != NULL && *flag == 0) {
- cws->window = XCreateWindow(display, cws->motif_window,
- xval, yval, wval, hval, 0, CopyFromParent,
- InputOutput, CopyFromParent,
- attr_mask, &attributes );
- cws->motif = 1;
- } else {
- if (external_int == 1) {
-#if !defined(CERNLIB_TK_WINDOWS)
- cws->window = XCreateWindow(display, external_window,
- xval, yval, wval, hval, 0, CopyFromParent,
- InputOutput, CopyFromParent,
- attr_mask, &attributes );
-#endif
-#if defined(CERNLIB_TK_WINDOWS)
- cws->window = external_window;
-#endif
- external_int = 0;
- cws->motif = 1;
- cws->motif_window = external_window;
- } else {
- cws->motif = 0;
- cws->window = XCreateWindow(display,
- RootWindow( display, screen_number),
- xval, yval, wval, hval, 1, CopyFromParent,
- InputOutput, CopyFromParent,
- attr_mask, &attributes );
- strcpy( long_title, string( title, *lentit ) );
- if (long_title[0] != '-') {
- strcat( long_title, " @ " );
-#if !defined(CERNLIB_TK_WINDOWS)
- gethostname( host_name, sizeof( host_name ) );
-#endif
-#if defined(CERNLIB_TK_WINDOWS)
- strcat( long_title, " Win95 ");
-#endif
- strcat( long_title, host_name );
- } else {
- long_title[0] = ' ';
- }
-#if !defined(CERNLIB_TK_WINDOWS)
- XStoreName( display, cws->window, long_title );
-#endif
- XSetIconName( display, cws->window, long_title );
- }
- }
-/*
- * Set window manager hints
- */
-#if !defined(CERNLIB_TK_WINDOWS)
- memset( &wm_hints, 0, sizeof(wm_hints));
- wm_hints.flags = InputHint;
- wm_hints.input = False; /* don't grab input focus */
- XSetWMHints( display, cws->window, &wm_hints );
-#endif
-/*
- * Set window size hints
- */
-#if !defined(CERNLIB_TK_WINDOWS)
- memset( &size_hints, 0, sizeof(size_hints));
- size_hints.flags = USPosition | USSize;
- size_hints.x = xval;
- size_hints.y = yval;
- size_hints.width = wval;
- size_hints.height = hval;
- XSetNormalHints( display, cws->window, &size_hints );
-#endif
-/*
- * Define the position and size of the window
- * Map the window
- */
-#if !defined(CERNLIB_TK_WINDOWS)
- XMoveWindow( display, cws->window, xval, yval );
- XResizeWindow( display, cws->window, wval, hval );
- XMapWindow( display, cws->window );
-/*
- * Wait until the window is mapped (MapNotify)
- * This is not supported by all the X11 emulators (problem on Mac !!!)
- *
- XSelectInput(display, cws->window, StructureNotifyMask);
- forever {
- XEvent event;
- XNextEvent( display, &event);
- if (event.type == MapNotify) break;
- }
- */
- XFlush( display );
-#endif
-/*
- * Set the Class Hint
- */
-#if !defined(CERNLIB_TK_WINDOWS)
- XSetClassHint(display, cws->window, &class_hints);
-#endif
-/*
- * Set Window Manager Protocols
- */
-#if !defined(CERNLIB_TK_WINDOWS)
- atm[0] = XInternAtom(display, "WM_DELETE_WINDOW", False);
- istat = XSetWMProtocols(display, cws->window, atm, 1);
-#endif
-/*
- * Initialise the window structure
- */
- cws->drawing = cws->window;
- cws->buffer = (Drawable)NULL;
- cws->double_buffer = (int)NULL;
- cws->clip = (int)NULL;
- cws->width = wval;
- cws->height = hval;
-
- return( wid );
-}
-
-/*
- * SUBROUTINE IXRSCWI(WID, W, H)
- * INTEGER WID : Window identifier.
- * INTEGER W : Width
- * INTEGER H : Heigth
- *
- * Rescale the window WID
- */
-void
- ixrscwi(wid, w, h)
- int *wid;
- int *w;
- int *h;
-{
- int i;
-
- tws = &windows[*wid];
- if (!tws->open) return;
-
- XResizeWindow( display, tws->window, *w, *h );
-
- if( tws->double_buffer ) {
- XFreePixmap(display,tws->buffer);
- tws->buffer = XCreatePixmap(display, RootWindow( display, screen_number),
- *w, *h, DefaultDepth(display,screen_number));
- for( i = 0; i < MAXGC; i++ ) XSetClipMask( display, gclist[i], None );
- setcolor( *gcpxmp, 0);
- XFillRectangle( display, tws->buffer, *gcpxmp, 0, 0, *w, *h);
- setcolor( *gcpxmp, 1);
- tws->drawing = tws->buffer;
- }
- tws->width = *w;
- tws->height = *h;
-}
-
-/*
- * SUBROUTINE IXMOVWI(WID, X, Y)
- * INTEGER WID : Window identifier.
- * INTEGER X : Width
- * INTEGER Y : Heigth
- *
- * Move the window WID
- */
-void
- ixmovwi(wid, x, y)
- int *wid;
- int *x;
- int *y;
-{
- int i;
-
- tws = &windows[*wid];
- if (!tws->open) return;
-
- XMoveWindow( display, tws->window, *x, *y );
-}
-
-void
- ix2bon()
-{
- int i;
-
- if (tws->double_buffer) return;
- tws->buffer = XCreatePixmap(display, RootWindow( display, screen_number),
- tws->width, tws->height, DefaultDepth(display,screen_number));
- for( i = 0; i < MAXGC; i++ ) XSetClipMask( display, gclist[i], None );
- XCopyArea( display, tws->window, tws->buffer,
- *gcpxmp, 0, 0, tws->width, tws->height, 0, 0 );
- tws->double_buffer = 1;
- tws->drawing = tws->buffer;
- return;
-}
-
-void
- ix2boff()
-{
- if (!tws->double_buffer) return;
- XFreePixmap(display,tws->buffer);
- tws->double_buffer = 0;
- tws->drawing = tws->window;
- return;
-}
-
-/*
- * SUBROUTINE IXS2BUF(WID,MODE)
- * INTEGER WID : Window identifier.
- * 999 means all the opened windows.
- * INTEGER MODE : 1 double buffer is on
- * 0 double buffer is off
- *
- * Set the double buffer on/off on window WID.
- */
-void
- ixs2buf( wid, mode )
- int *wid;
- int *mode;
-{
- int i;
-
- if ( *wid == 999 ) {
- for ( i = 0; i < MAXWN; i++ ) {
- tws = &windows[i];
- if (tws->open) {
- switch ( *mode ) {
- case 1 :
- ix2bon();
- break;
- default:
- ix2boff();
- break;
- }
- }
- }
- } else {
- tws = &windows[*wid];
- if (!tws->open) return;
- switch ( *mode ) {
- case 1 :
- ix2bon();
- return;
- default:
- ix2boff();
- return;
- }
- }
-}
-
-/*
- * SUBROUTINE IXQ2BUF(WID)
- * INTEGER WID : Window identifier.
- *
- * Query the double buffer value for the window WID.
- */
-int
- ixq2buf( wid )
- int *wid;
-{
- tws = &windows[*wid];
- if (!tws->open) {
- return -1;
- } else {
- return tws->double_buffer;
- }
-}
-
-/*
- * INTEGER FUNCTION IXOPNPX(W, H)
- * INTEGER W,H : Width and height of the pixmap.
- *
- * Open a new pixmap.
- */
-int
- ixopnpx(w, h)
-int *w, *h;
-{
- Drawable pixtemp;
- Window root;
- unsigned int wval, hval;
- int xx, yy, i ;
- unsigned int ww, hh, border, depth;
- wval = *w;
- hval = *h;
-
- oldwin = cws->drawing;
- pixtemp = XCreatePixmap(display, RootWindow( display, screen_number),
- wval, hval, DefaultDepth(display,screen_number));
- ispix = 1;
- XGetGeometry( display, pixtemp, &root, &xx, &yy, &ww, &hh, &border, &depth );
-
- for( i = 0; i < MAXGC; i++ )
- XSetClipMask( display, gclist[i], None );
-
- setcolor( *gcpxmp, 0);
- XFillRectangle( display, pixtemp, *gcpxmp,0 ,0 ,ww ,hh);
- setcolor( *gcpxmp, 1);
-
- cws->drawing = pixtemp;
- return ( pixtemp );
-}
-
-
-/*
- * SUBROUTINE IXCLRPX(PIX)
- * INTEGER PIX : Pixmap address
- *
- * Clear the pixmap PIX.
- */
-void
- ixclrpx(pix )
-Drawable *pix;
-{
- Window root;
- int xx, yy;
- unsigned int ww, hh, border, depth;
- XGetGeometry( display, *pix, &root, &xx, &yy, &ww, &hh, &border, &depth );
- setcolor( *gcpxmp, 0);
- XFillRectangle( display, *pix, *gcpxmp,0 ,0 ,ww ,hh);
- setcolor( *gcpxmp, 1);
- XFlush( display );
-}
-
-
-/*
- * SUBROUTINE IXCLPX
- *
- * Close the current opened pixmap.
- */
-void
- ixclpx()
-{
- XFlush( display );
- cws->drawing = oldwin;
- ispix = 0;
-}
-
-
-/*
- * SUBROUTINE IXCPPX(PIX, XPOS, YPOS)
- * INTEGER PIX : Pixmap address
- * INTEGER XPOS, YPOS : Pixmap Position
- *
- * Copy the pixmap PIX at the position XPOS YPOS.
- */
-void
- ixcppx(pix, xpos, ypos)
-Drawable *pix;
-int *xpos, *ypos;
-{
- Window root;
- int xx, yy;
- unsigned int ww, hh, border, depth;
- XGetGeometry( display, *pix, &root, &xx, &yy, &ww, &hh, &border, &depth );
- XCopyArea(display,*pix,cws->drawing,*gcpxmp,0,0,ww,hh,*xpos,*ypos);
- XFlush( display );
-}
-
-
-/*
- * SUBROUTINE IXWRPX(PIX,W,H,LENNAME,PXNAME)
- * INTEGER PIX : Pixmap address
- * INTEGER W,H : Width and height of the pixmap.
- * INTEGER LENNAME : pixmap name length
- * CHARACTER*(*) PXNAME: pixmap name
- *
- * Write the pixmap IPX in the bitmap file PXNAME.
- */
-void
- ixwrpx(pix, w, h, lenname,
-#if defined(CERNLIB_CRAY)
- fcd_pxname )
-_fcd fcd_pxname;
-#endif
-#if defined(CERNLIB_VAX)
- dsc_pxname )
-struct dsc$descriptor_s *dsc_pxname;
-#endif
-#if defined(CERNLIB_TK_WINDOWS)
- pxname, lenpxname )
-char *pxname;
-int lenpxname;
-#endif
-#if (!defined(CERNLIB_CRAY))&&(!defined(CERNLIB_VAX))&&(!defined(CERNLIB_TK_WINDOWS))
- pxname )
-char *pxname;
-#endif
-Drawable *pix;
-int *w, *h;
-int *lenname;
-{
-#if defined(CERNLIB_CRAY)
- char *pxname = _fcdtocp( fcd_pxname );
-#endif
-#if defined(CERNLIB_VAX)
- char *pxname = dsc_pxname->dsc$a_pointer;
-#endif
- unsigned int wval, hval;
- wval = *w;
- hval = *h;
-#if !defined(CERNLIB_TK_WINDOWS)
- XWriteBitmapFile(display,string(pxname,*lenname),*pix,wval,hval,-1,-1);
-#endif
-}
-
-
-/*
- * SUBROUTINE IXWIPX(PIX, XPOS, YPOS)
- * INTEGER PIX : Pixmap address
- * INTEGER XPOS, YPOS : Position in the current window
- *
- * Copy the area at the position XPOS YPOS in the current
- * window in the pixmap PIX. The area copied has the size
- * of the pixmap PIX.
- */
-void
- ixwipx(pix, xpos, ypos )
-Drawable *pix;
-int *xpos, *ypos;
-{
- Window root;
- int xx, yy;
- unsigned int ww, hh, border, depth;
- XGetGeometry( display, *pix, &root, &xx, &yy, &ww, &hh, &border, &depth );
- XCopyArea(display,cws->drawing,*pix,*gcpxmp,*xpos,*ypos,ww,hh,0,0);
- XFlush( display );
-}
-
-
-/*
- * SUBROUTINE IXRMPX(PIX)
- * INTEGER PIX : Pixmap adress
- *
- * Remove the pixmap PIX.
- */
-void
- ixrmpx(pix)
-Drawable *pix;
-{
- XFreePixmap(display,*pix);
-}
-
-
-/*
- * SUBROUTINE IXCLSDS
- *
- * Delete all windows and close connection
- */
-void
- ixclsds()
-{
- int Motif = (int)NULL;
- int i;
-
- if (display == NULL) return;
-
- for ( i = 0; i < MAXFONT; i++ ) {
- if ( font[i].id ) {
- XFreeFont ( display, font[i].id);
- font[i].id = NULL;
- }
- }
-
- for ( i = 0; i < MAXWN; i++ ) {
- windows[i].open = 0;
- if ( windows[i].motif ) Motif = 1;
- }
-
- for ( i = 0; i < MAXCOL; i++ ) {
- if( colors[i].defined == 1 ) {
- colors[i].defined = 0;
- XFreeColors(display, colormap, &colors[i].pixel, 1, (int)NULL);
- }
- }
-
-#if !defined(CERNLIB_TK_WINDOWS)
- if(display != NULL && Motif == (int)NULL) XCloseDisplay( display );
-#endif
- display = NULL;
- cws = NULL;
- tws = NULL;
- isdisp = 0;
-}
-
-
-/*
- * SUBROUTINE IXCLSWI
- *
- * Delete current window
- */
-void
- ixclswi()
-{
- int wid;
-
- XDestroyWindow( display, cws->window );
-
- if( cws->double_buffer ) XFreePixmap( display, cws->buffer);
-
- if (cws->motif && motif_close != NULL) {
- for( wid = 0; wid < MAXWN; wid++ ) {
- if (cws->motif_window == windows[wid].motif_window) {
- (*motif_close) (wid+1);
- break; }
- }
- }
-
- XFlush( display );
-
- cws->open = (int)NULL;
-
- for( wid = 0; wid < MAXWN; wid++ )
- if( windows[wid].open ) {
- cws = &windows[wid];
- return;
- }
-
-#if !defined(CERNLIB_TK_WINDOWS)
- ixclsds(); /* no open window left */
-#endif
-#if defined(CERNLIB_TK_WINDOWS)
- IXCLSDS(); /* no open window left */
-#endif
-}
-
-
-/*
- * SUBROUTINE IXSELWI(WID)
- * INTEGER WID : window number returned by IXOPNWI
- *
- * Select window to which subsequent output is directed
- */
-void
- ixselwi( wid )
-int *wid;
-{
- XRectangle region;
- int i;
-
- if( *wid < 0 || *wid >= MAXWN || !windows[*wid].open ) return;
-
- cws = &windows[*wid];
-
- if ( cws->clip && !ispix && !cws->double_buffer ) {
- region.x = cws->xclip;
- region.y = cws->yclip;
- region.width = cws->wclip;
- region.height = cws->hclip;
-#if !defined(CERNLIB_TK_WINDOWS)
- for( i = 0; i < MAXGC; i++ )
- XSetClipRectangles( display, gclist[i], 0, 0, ®ion, 1, YXBanded );
-#endif
- } else {
- for( i = 0; i < MAXGC; i++ )
- XSetClipMask( display, gclist[i], None );
- }
-}
-
-
-/*
- * SUBROUTINE IXSAVWI
- *
- * Save the adress of the current active window
- */
-void
- ixsavwi()
-{
- sws = cws;
-}
-
-
-/*
- * SUBROUTINE IXSETWI
- *
- * Restore the adress of the saved window
- */
-void
- ixsetwi()
-{
- cws = sws;
-}
-
-
-/*
- * SUBROUTINE IXGETGE(WID,X,Y,W,H)
- * INTEGER WID : window identifier
- * INTEGER X,Y : window position (output)
- * INTEGER W,H : window size (output)
- *
- * Return position and size of window wid
- * if wid < 0 the size of the display is returned
- */
-void
- ixgetge( wid, x, y, w, h )
-int *wid;
-int *x, *y;
-unsigned int *w, *h;
-{
- Window temp_win;
- if( *wid < 0 ) {
- *x = 0;
- *y = 0;
- *w = DisplayWidth(display,screen_number);
- *h = DisplayHeight(display,screen_number);
- } else {
- Window root;
- unsigned int border, depth;
- unsigned int width, height;
-
- tws = &windows[*wid];
-#if defined(CERNLIB_TK_WINDOWS)
- XGetGeometry(display, tws->window, &root, x, y,
- &width, &height, &border, &depth);
-#endif
-#if !defined(CERNLIB_TK_WINDOWS)
- XGetGeometry(display, tws->drawing, &root, x, y,
- &width, &height, &border, &depth);
- (void) XTranslateCoordinates (display, tws->window,
- RootWindow( display, screen_number),
- 0, 0, x, y, &temp_win);
-#endif
- if( width > 0 && height > 0 ) {
- tws->width = width;
- tws->height = height;
- }
- if( width > 1 && height > 1 ) {
- *w=tws->width-1;
- *h=tws->height-1;
- } else {
- *w=1;
- *h=1;
- }
- }
-}
-
-
-/*
- * SUBROUTINE IXGETPL(NPLANES)
- * INTEGER NPLANES : number of bit planes
- *
- * Get maximum number of planes
- */
-void
- ixgetpl(nplanes)
-int *nplanes;
-{
- *nplanes = DisplayPlanes( display, screen_number );
-}
-
-
-/*
- * SUBROUTINE IXRSIZ(WID)
- * INTEGER WID : window to be resized
- *
- * Resize the current window if necessary
- */
-void
- ixrsiz(wid)
-int *wid;
-{
- int i;
- int xval, yval;
- Window root;
- unsigned int wval, hval, border, depth;
-
- tws = &windows[*wid];
-
- if( !tws->motif ) return;
-
- XGetGeometry( display, tws->motif_window, &root,
- &xval, &yval, &wval, &hval, &border, &depth );
- XResizeWindow( display, tws->window, wval, hval );
-
- if( tws->double_buffer ) {
- XFreePixmap(display,tws->buffer);
- tws->buffer = XCreatePixmap(display, RootWindow( display, screen_number),
- wval, hval, DefaultDepth(display,screen_number));
- for( i = 0; i < MAXGC; i++ ) XSetClipMask( display, gclist[i], None );
- setcolor( *gcpxmp, 0);
- XFillRectangle( display, tws->buffer, *gcpxmp, 0, 0, wval, hval);
- setcolor( *gcpxmp, 1);
- tws->drawing = tws->buffer;
- }
- tws->width = wval;
- tws->height = hval;
-}
-
-
-/*
- * SUBROUTINE IXGETHT(IL,CHHOST)
- * INTEGER IL : host name length (output)
- * CHARACTER*(*) CHHOST : host name (output)
- *
- * Return the host name given with IGWKTY.
- */
-void
- ixgetht (il, chhost)
- int *il;
- char *chhost; /* host name */
-{
- *il = strlen (hname);
- strcpy (chhost, hname);
-}
-
-
-/*
- * SUBROUTINE IXGETWI(WKID,IDG)
- * INTEGER WKID : Workstation identifier (input)
- * INTEGER IDG : Window identifier (output)
- *
- * Return the X11 window identifier according to the
- * Window id returned by IXOPNWI.
- */
-void
- ixgetwi (wkid, idg)
- int *wkid;
- Window *idg;
-{
- *idg = windows[*wkid].window;
-}
-
-
-/*
- * SUBROUTINE IXCLRWI
- *
- * Clear current window
- */
-void
- ixclrwi()
-{
-
- if ( !ispix && !cws->double_buffer ) {
- XSetWindowBackground( display, cws->drawing, colors[0].pixel );
- XClearWindow( display, cws->drawing );
- } else {
- setcolor( *gcpxmp, 0);
- XFillRectangle( display, cws->drawing, *gcpxmp,
- 0, 0, cws->width, cws->height );
- setcolor( *gcpxmp, 1);
- }
- do_raise = 1;
- XFlush( display );
-}
-
-
-/*
- * SUBROUTINE IXUPDWI(MODE)
- * INTEGER MODE : (1) or (11) The window is raised
- * (0) or (10) The window is not raised
- * (0) or (1) no synchonisation between client and server
- * (10) or (11) synchonisation between client and server
- *
- * Update display and raise current window to top of stack.
- * Synchronise client and server once (not permanent).
- * Copy the pixmap cws->buffer on the window cws-> window
- * if the double buffer is on.
- */
-void
- ixupdwi(mode)
- int *mode;
-{
- if ( *mode == 1 || *mode == 11 ) {
- if ( do_raise ) {
- XRaiseWindow( display, cws->window );
- do_raise = 0;
- }
- }
- if ( cws->double_buffer ) {
- XCopyArea( display, cws->drawing, cws->window,
- *gcpxmp, 0, 0, cws->width, cws->height, 0, 0 );
- }
- if ( *mode == 0 || *mode == 1 ) {
- XFlush( display );
- } else {
- XSync( display ,0);
- }
-}
-
-
-/*
- * SUBROUTINE IXCLIP(WID,X,Y,W,H)
- * INTEGER WID : Window indentifier
- * INTEGER X,Y : origin of clipping rectangle
- * INTEGER W,H : size of clipping rectangle;
- *
- * Set clipping region for the window wid
- */
-void
- ixclip( wid, x, y, w, h )
-int *wid;
-int *x, *y;
-int *w, *h;
-{
- XRectangle region;
- int i;
-
- tws = &windows[*wid];
- tws->xclip = *x;
- tws->yclip = *y;
- tws->wclip = *w;
- tws->hclip = *h;
- tws->clip = 1;
- if ( cws->clip && !ispix && !cws->double_buffer ) {
- region.x = cws->xclip;
- region.y = cws->yclip;
- region.width = cws->wclip;
- region.height = cws->hclip;
-#if !defined(CERNLIB_TK_WINDOWS)
- for( i = 0; i < MAXGC; i++ )
- XSetClipRectangles( display, gclist[i], 0, 0, ®ion, 1, YXBanded );
-#endif
- }
-}
-
-
-/*
- * SUBROUTINE IXNOCLI(WID)
- * INTEGER WID : Window indentifier
- *
- * Switch off the clipping for the window wid
- */
-void
- ixnocli(wid)
-int *wid;
-{
- int i;
-
- tws = &windows[*wid];
- tws->clip = (int)NULL;
-
- for( i = 0; i < MAXGC; i++ )
- XSetClipMask( display, gclist[i], None );
-}
-
-
-/*
- * SUBROUTINE IXSETCO(CINDEX,R,G,B)
- * INTEGER CINDEX : color index
- * REAL R,G,B : red, green, blue intensities between 0.0 and 1.0
- *
- * Set color intensities for given color index
- */
-#define BIGGEST_RGB_VALUE 65535
-
-void
- ixsetco( cindex, r, g, b )
-int *cindex;
-float *r, *g, *b;
-{
- XColor xcol;
-
- if( colored && *cindex >= 0 && *cindex < MAXCOL ) {
- xcol.red = (unsigned short)( *r * BIGGEST_RGB_VALUE );
- xcol.green = (unsigned short)( *g * BIGGEST_RGB_VALUE );
- xcol.blue = (unsigned short)( *b * BIGGEST_RGB_VALUE );
- xcol.flags = DoRed || DoGreen || DoBlue;
- if( colors[*cindex].defined == 1 ) {
- colors[*cindex].defined = 0;
- XFreeColors(display, colormap, &colors[*cindex].pixel, 1, (int)NULL);
- }
- if( XAllocColor( display, colormap, &xcol ) != (Status)NULL ) {
- colors[*cindex].defined = 1;
- colors[*cindex].pixel = xcol.pixel;
- colors[*cindex].red = *r;
- colors[*cindex].green = *g;
- colors[*cindex].blue = *b;
- }
- }
-}
-
-
-void
- ixgetcol( index, r, g, b )
-int index; /* input */
-float *r, *g, *b; /* output */
-{
- *r = colors[index].red;
- *g = colors[index].green;
- *b = colors[index].blue;
- return ;
-}
-
-
-/*
- * SUBROUTINE IXSETLN(WIDTH)
- * INTEGER WIDTH : line width in pixels
- *
- * Set line width
- */
-void
- ixsetln( width )
-int *width;
-{
- if( *width == 1) {
- line_width = 0;
- }
- else {
- line_width = *width;
- }
- XSetLineAttributes( display, *gcline, line_width,
- line_style, cap_style, join_style );
- XSetLineAttributes( display, *gcdash, line_width,
- line_style, cap_style, join_style );
-}
-
-
-/*
- * SUBROUTINE IXSETLS(N,DASH)
- * INTEGER N : length of dash list
- * INTEGER DASH(N) : dash segment lengths
- *
- * Set line style:
- * if N.LE.0 use solid lines
- * if N.GT.0 use dashed lines described by DASH(N)
- * e.g. N=4,DASH=(6,3,1,3) gives a dashed-dotted line with dash length 6
- * and a gap of 7 between dashes
- */
-void
- ixsetls( n, dash )
-int *n;
-int *dash;
-{
- if( *n <= 0 ) {
- line_style = LineSolid;
- XSetLineAttributes( display, *gcline, line_width,
- line_style, cap_style, join_style );
- }
- else {
- int i, j;
- dash_length = 0;
- for( i = 0, j = 0; i < sizeof( dash_list ); i++ ) {
- dash_list[i] = dash[j];
- dash_length += dash_list[i];
- if( ++j >= *n ) j = 0;
- }
- dash_offset = 0;
- line_style = LineOnOffDash;
- XSetLineAttributes( display, *gcdash, line_width,
- line_style, cap_style, join_style );
- }
-}
-
-
-/*
- * SUBROUTINE IXSETLC(CINDEX)
- * INTEGER CINDEX : color index defined my IXSETCO
- *
- * Set color index for lines
- */
-void
- ixsetlc( cindex )
-int *cindex;
-{
- setcolor( *gcline, *cindex );
- setcolor( *gcdash, *cindex );
-}
-
-
-/*
- * SUBROUTINE IXLINE(N,XY)
- * INTEGER N : number of points
- * INTEGER*2 XY(2,N) : list of points
- *
- * Draw a line through all points
- */
-void
- ixline( n, xy )
-int *n;
-XPoint *xy;
-{
- if ( *n > 1 )
- {
- if( line_style == LineSolid )
- XDrawLines( display, cws->drawing, *gcline, xy, *n, CoordModeOrigin );
- else {
- int i;
-#if !defined(CERNLIB_TK_WINDOWS)
- XSetDashes( display, *gcdash,
- dash_offset, dash_list, sizeof( dash_list ) );
-#endif
- XDrawLines( display, cws->drawing, *gcdash, xy, *n, CoordModeOrigin );
-
- /* calculate length of line to update dash offset */
- for( i = 1; i < *n; i++ ) {
- int dx = xy[i].x - xy[i-1].x;
- int dy = xy[i].y - xy[i-1].y;
- if( dx < 0 ) dx = - dx;
- if( dy < 0 ) dy = - dy;
- dash_offset += dx > dy ? dx : dy;
- }
- dash_offset %= dash_length;
- }
- }
- else
- {
- int px,py;
- px=xy[0].x;
- py=xy[0].y;
-#if defined(CERNLIB_TK_WINDOWS)
- XDrawPoints(display, cws->drawing,
- line_style == LineSolid ? *gcline : *gcdash,
- xy, *n, CoordModeOrigin );
-#endif
-#if !defined(CERNLIB_TK_WINDOWS)
- XDrawPoint(display, cws->drawing,
- line_style == LineSolid ? *gcline : *gcdash, px, py);
-#endif
- }
- do_raise = 1;
-}
-
-
-/*
- * SUBROUTINE IXSETMS(TYPE,N,XY)
- * INTEGER TYPE : marker type
- * INTEGER N : length of marker description
- * INTEGER*2 XY(2,N) : list of points describing marker shape
- *
- * Set marker style:
- * if N.EQ.0 marker is a single point
- * if TYPE.EQ.0 marker is hollow circle of diameter N
- * if TYPE.EQ.1 marker is filled circle of diameter N
- * if TYPE.EQ.2 marker is a hollow polygon describe by line XY
- * if TYPE.EQ.3 marker is a filled polygon describe by line XY
- * if TYPE.EQ.4 marker is described by segmented line XY
- * e.g. TYPE=4,N=4,XY=(-3,0,3,0,0,-3,0,3) sets a plus shape of 7x7 pixels
- */
-void
- ixsetms( type, n, xy )
-int *type;
-int *n;
-XPoint *xy;
-{
- int i;
-
- marker.type = *type;
- marker.n = *n < MAXMK ? *n : MAXMK;
- if( marker.type >= 2 )
- for( i = 0; i < marker.n; i++ )
- marker.xy[i] = xy[i];
-}
-
-
-/*
- * SUBROUTINE IXSETMC(CINDEX)
- * INTEGER CINDEX : color index defined my IXSETCO
- *
- * Set color index for markers
- */
-void
- ixsetmc( cindex )
-int *cindex;
-{
- setcolor( *gcmark, *cindex );
-}
-
-
-/*
- * SUBROUTINE IXMARKE(N,XY)
- * INTEGER N : number of points
- * INTEGER*2 XY(2,N) : list of points
- *
- * Draw a marker at each point
- */
-void
- ixmarke( n, xy )
-int *n;
-XPoint *xy;
-{
- do_raise = 1;
- if( marker.n <= 0 )
- XDrawPoints( display, cws->drawing, *gcmark, xy, *n, CoordModeOrigin );
- else {
- int r = marker.n / 2;
- int m;
-
- for( m = 0; m < *n; m++ ) {
- int hollow = 0;
-
- switch( marker.type ) {
- int i;
-
- case 0: /* hollow circle */
- XDrawArc( display, cws->drawing, *gcmark,
- xy[m].x - r, xy[m].y - r, marker.n, marker.n, 0, 360 * 64 );
- break;
-
- case 1: /* filled circle */
- XFillArc( display, cws->drawing, *gcmark,
- xy[m].x - r, xy[m].y - r, marker.n, marker.n, 0, 360 * 64 );
- break;
-
- case 2: /* hollow polygon */
- hollow = 1;
- case 3: /* filled polygon */
- for( i = 0; i < marker.n; i++ ) {
- marker.xy[i].x += xy[m].x;
- marker.xy[i].y += xy[m].y;
- }
- if( hollow )
- XDrawLines( display, cws->drawing, *gcmark,
- marker.xy, marker.n, CoordModeOrigin );
- else
- XFillPolygon( display, cws->drawing, *gcmark,
- marker.xy, marker.n, Nonconvex, CoordModeOrigin );
- for( i = 0; i < marker.n; i++ ) {
- marker.xy[i].x -= xy[m].x;
- marker.xy[i].y -= xy[m].y;
- }
- break;
-
- case 4: /* segmented line */
- for( i = 0; i < marker.n; i += 2 )
- XDrawLine( display, cws->drawing, *gcmark,
- xy[m].x + marker.xy[i].x, xy[m].y + marker.xy[i].y,
- xy[m].x + marker.xy[i+1].x, xy[m].y + marker.xy[i+1].y );
- break;
- }
- }
- }
-}
-
-
-/*
- * SUBROUTINE IXSETFS(STYLE,FASI)
- * INTEGER STYLE : fill area interior style hollow or solid
- *
- * Set fill area style
- */
-void
- ixsetfs( style, fasi )
-int *style;
-int *fasi;
-{
-
- switch( *style ) {
-
- case 1: /* solid */
- fill_hollow = 0;
- XSetFillStyle( display, *gcfill, FillSolid );
- break;
-
- case 2: /* pattern */
- fill_hollow = 1;
- break;
-
- case 3: /* hatch */
- fill_hollow = 0;
- XSetFillStyle( display, *gcfill, FillStippled );
- if( *fasi != current_fasi ) {
- if( fill_pattern != (Pixmap)NULL ) {
- XFreePixmap( display, fill_pattern );
- fill_pattern = (Pixmap)NULL;
- }
- switch( *fasi ) {
- case 1: fill_pattern = XCreateBitmapFromData(display,
- RootWindow( display, screen_number), p1_bits, 16, 16);
- break;
- case 2: fill_pattern = XCreateBitmapFromData(display,
- RootWindow( display, screen_number), p2_bits, 16, 16);
- break;
- case 3: fill_pattern = XCreateBitmapFromData(display,
- RootWindow( display, screen_number), p3_bits, 16, 16);
- break;
- case 4: fill_pattern = XCreateBitmapFromData(display,
- RootWindow( display, screen_number), p4_bits, 16, 16);
- break;
- case 5: fill_pattern = XCreateBitmapFromData(display,
- RootWindow( display, screen_number), p5_bits, 16, 16);
- break;
- case 6: fill_pattern = XCreateBitmapFromData(display,
- RootWindow( display, screen_number), p6_bits, 16, 16);
- break;
- case 7: fill_pattern = XCreateBitmapFromData(display,
- RootWindow( display, screen_number), p7_bits, 16, 16);
- break;
- case 8: fill_pattern = XCreateBitmapFromData(display,
- RootWindow( display, screen_number), p8_bits, 16, 16);
- break;
- case 9: fill_pattern = XCreateBitmapFromData(display,
- RootWindow( display, screen_number), p9_bits, 16, 16);
- break;
- case 10:fill_pattern = XCreateBitmapFromData(display,
- RootWindow( display, screen_number), p10_bits, 16, 16);
- break;
- case 11:fill_pattern = XCreateBitmapFromData(display,
- RootWindow( display, screen_number), p11_bits, 16, 16);
- break;
- case 12:fill_pattern = XCreateBitmapFromData(display,
- RootWindow( display, screen_number), p12_bits, 16, 16);
- break;
- case 13:fill_pattern = XCreateBitmapFromData(display,
- RootWindow( display, screen_number), p13_bits, 16, 16);
- break;
- case 14:fill_pattern = XCreateBitmapFromData(display,
- RootWindow( display, screen_number), p14_bits, 16, 16);
- break;
- case 15:fill_pattern = XCreateBitmapFromData(display,
- RootWindow( display, screen_number), p15_bits, 16, 16);
- break;
- case 16:fill_pattern = XCreateBitmapFromData(display,
- RootWindow( display, screen_number), p16_bits, 16, 16);
- break;
- case 17:fill_pattern = XCreateBitmapFromData(display,
- RootWindow( display, screen_number), p17_bits, 16, 16);
- break;
- case 18:fill_pattern = XCreateBitmapFromData(display,
- RootWindow( display, screen_number), p18_bits, 16, 16);
- break;
- case 19:fill_pattern = XCreateBitmapFromData(display,
- RootWindow( display, screen_number), p19_bits, 16, 16);
- break;
- case 20:fill_pattern = XCreateBitmapFromData(display,
- RootWindow( display, screen_number), p20_bits, 16, 16);
- break;
- case 21:fill_pattern = XCreateBitmapFromData(display,
- RootWindow( display, screen_number), p21_bits, 16, 16);
- break;
- case 22:fill_pattern = XCreateBitmapFromData(display,
- RootWindow( display, screen_number), p22_bits, 16, 16);
- break;
- case 23:fill_pattern = XCreateBitmapFromData(display,
- RootWindow( display, screen_number), p23_bits, 16, 16);
- break;
- case 24:fill_pattern = XCreateBitmapFromData(display,
- RootWindow( display, screen_number), p24_bits, 16, 16);
- break;
- case 25:fill_pattern = XCreateBitmapFromData(display,
- RootWindow( display, screen_number), p25_bits, 16, 16);
- break;
- default: fill_pattern = XCreateBitmapFromData(display,
- RootWindow( display, screen_number), p2_bits, 16, 16);
- break;
- }
- XSetStipple( display, *gcfill, fill_pattern );
- current_fasi = *fasi;
- }
- break;
-
- default:
- fill_hollow = 1;
- }
-}
-
-
-/*
- * SUBROUTINE IXSETFC(CINDEX)
- * INTEGER CINDEX : color index defined my IXSETCO
- *
- * Set color index for fill areas
- */
-void
- ixsetfc( cindex )
-int *cindex;
-{
- setcolor( *gcfill, *cindex );
-
- /* invalidate fill pattern */
- if( fill_pattern != (Pixmap)NULL ) {
- XFreePixmap( display, fill_pattern );
- fill_pattern = (Pixmap)NULL;
- }
-}
-
-
-/*
- * SUBROUTINE IXFLARE(N,XY)
- * INTEGER N : number of points
- * INTEGER*2 XY(2,N) : list of points
- *
- * Fill area described by polygon
- */
-void
- ixflare( n, xy )
-int *n;
-XPoint *xy;
-{
- if( fill_hollow )
- XDrawLines( display, cws->drawing, *gcfill, xy, *n, CoordModeOrigin );
-
- else {
- XFillPolygon( display, cws->drawing, *gcfill,
- xy, *n, Nonconvex, CoordModeOrigin );
- }
- do_raise = 1;
-}
-
-
-/*
- * SUBROUTINE IXSETTA(TXALH,TXALV)
- * INTEGER TXALH : horizontal text alignment
- * INTEGER TXALV : vertical text alignment
- */
-void
- ixsetta( txalh, txalv )
-int *txalh;
-int *txalv;
-{
- switch ( *txalh ) {
-
- case 0 :
- case 1 : switch ( *txalv) {
- case 0 : text_align = 7;
- break;
- case 1 :
- case 2 : text_align = 1;
- break;
- case 3 : text_align = 4;
- break;
- }
- break;
- case 2 : switch ( *txalv) {
- case 0 : text_align = 8;
- break;
- case 1 :
- case 2 : text_align = 2;
- break;
- case 3 : text_align = 5;
- break;
- }
- break;
- case 3 : switch ( *txalv) {
- case 0 : text_align = 9;
- break;
- case 1 :
- case 2 : text_align = 3;
- break;
- case 3 : text_align = 6;
- break;
- }
- break;
- }
-}
-
-
-/*
- * FUNCTION IXSETTF(MODE,LENFNT,FONTNAME)
- * INTEGER MODE : loading flag
- * MODE=0 : search if the font exist
- * MODE=1 : search the font and load it if it exist
- * INTEGER LENFNT : font name length
- * CHARACTER*(*) FONT : font name
- *
- * Set text font to specified name. This function returns 0 if
- * the specified font is found, 1 if not.
- */
-int
- ixsettf( mode, lenfnt,
-#if defined(CERNLIB_CRAY)
- fcd_fontname )
-_fcd fcd_fontname;
-#endif
-#if defined(CERNLIB_VAX)
- dsc_fontname )
-struct dsc$descriptor_s *dsc_fontname;
-#endif
-#if defined(CERNLIB_TK_WINDOWS)
- fontname, lenfontname )
-char *fontname;
-int lenfontname;
-#endif
-#if (!defined(CERNLIB_CRAY))&&(!defined(CERNLIB_VAX))&&(!defined(CERNLIB_TK_WINDOWS))
- fontname )
-char *fontname;
-#endif
-int *mode;
-int *lenfnt;
-{
-#if defined(CERNLIB_CRAY)
- char *fontname = _fcdtocp( fcd_fontname );
-#endif
-#if defined(CERNLIB_VAX)
- char *fontname = dsc_fontname->dsc$a_pointer;
-#endif
- char **fontlist;
- int fontcount;
- int i;
-
- if ( *mode != 0 ) {
- for ( i = 0; i < MAXFONT; i++ ) {
- if (strcmp(string( fontname, *lenfnt ), font[i].name) == 0) {
- text_font = font[i].id;
- XSetFont( display, *gctext, text_font->fid);
- XSetFont( display, *gcinvt, text_font->fid);
- return(0);
- }
- }
- }
-
-#if !defined(CERNLIB_TK_WINDOWS)
- fontlist = XListFonts( display, string( fontname, *lenfnt ), 1, &fontcount);
-#endif
-#if defined(CERNLIB_TK_WINDOWS)
- fontcount =0;
-#endif
-
- if ( fontcount != 0 ) {
- if ( *mode != 0 ) {
- if ( font[current_font_number].id )
- XFreeFont ( display, font[current_font_number].id);
- font[current_font_number].id = XLoadQueryFont( display, fontlist[0]);
- text_font = font[current_font_number].id;
- XSetFont( display, *gctext, text_font->fid);
- XSetFont( display, *gcinvt, text_font->fid);
- strcpy (font[current_font_number].name,string( fontname, *lenfnt ));
- current_font_number++;
- if ( current_font_number == MAXFONT ) current_font_number = 0;
- }
- XFreeFontNames(fontlist);
- return(0);
- }
- else {
- return(1);
- }
-}
-
-
-/*
- * SUBROUTINE IXSETTC(CINDEX)
- * INTEGER CINDEX : color index defined my IXSETCO
- *
- * Set color index for text
- */
-void
- ixsettc( cindex )
-int *cindex;
-{
- setcolor( *gctext, *cindex );
-
-#if (!defined(CERNLIB_TK_WINDOWS))
- if ( XGetGCValues( display, *gctext, gc_mask, &gc_return) ) {
- XSetForeground( display, *gcinvt, gc_return.background );
- XSetBackground( display, *gcinvt, gc_return.foreground );
- } else {
- printf("**** Error: Cannot get GC values \n");
- }
-#endif
- XSetBackground( display, *gctext, colors[0].pixel );
-}
-
-
-/*
- * SUBROUTINE IXTEXT(MODE,X,Y,ANGLE,MGN,LENTXT,TEXT)
- * INTEGER MODE : drawing mode
- * MODE=0 : the background is not drawn
- * MODE=1 : the background is drawn
- * INTEGER X,Y : text position
- * REAL ANGLE : text angle
- * REAL MGN : magnification factor
- * INTEGER LENTXT : text length
- * CHARACTER*(*) TEXT : text string
- *
- * Draw a text string using current font
- */
-void
- ixtext( mode, x, y, angle, mgn, lentxt,
-#if defined(CERNLIB_CRAY)
- fcd_text )
-_fcd fcd_text;
-#endif
-#if defined(CERNLIB_VAX)
- dsc_text )
-struct dsc$descriptor_s *dsc_text;
-#endif
-#if defined(CERNLIB_TK_WINDOWS)
- text, lentext )
-char *text;
-int lentext;
-#endif
-#if (!defined(CERNLIB_CRAY))&&(!defined(CERNLIB_VAX))&&(!defined(CERNLIB_TK_WINDOWS))
- text )
-char *text;
-#endif
-int *mode;
-int *x, *y;
-float *angle;
-float *mgn;
-int *lentxt;
-{
-#if defined(CERNLIB_CRAY)
- char *text = _fcdtocp( fcd_text );
-#endif
-#if defined(CERNLIB_VAX)
- char *text = dsc_text->dsc$a_pointer;
-#endif
-
-#if !defined(CERNLIB_TK_WINDOWS)
- XRotSetMagnification(*mgn);
-
- switch ( *mode ) {
-
- case 0 : XRotDrawAlignedString( display, text_font, *angle,
- cws->drawing, *gctext, *x, *y, string(text,*lentxt), text_align );
- break;
-
- case 1 : XRotDrawAlignedImageString( display, text_font, *angle,
- cws->drawing, *gctext, *x, *y, string(text,*lentxt), text_align );
- break;
-
- default: break;
- }
- do_raise = 1;
-#endif
-}
-
-
-/*
- * SUBROUTINE IXTXTL(IW,IH,LMESS,MESS)
- * INTEGER IW : text width
- * INTEGER IH : text height
- * INTEGER LMES : message length
- * CHARACTER*(*) MESS : message
- *
- * Return the size of a character string
- */
-void
- ixtxtl( w, h, lmess,
-#if defined(CERNLIB_CRAY)
- fcd_mess )
-_fcd fcd_mess;
-#endif
-#if defined(CERNLIB_VAX)
- dsc_mess )
-struct dsc$descriptor_s *dsc_mess;
-#endif
-#if defined(CERNLIB_TK_WINDOWS)
- mess, lenmess )
-char *mess;
-int lenmess;
-#endif
-#if (!defined(CERNLIB_CRAY))&&(!defined(CERNLIB_VAX))&&(!defined(CERNLIB_TK_WINDOWS))
- mess )
-char *mess;
-#endif
-int *lmess;
-int *w;
-int *h;
-{
-#if defined(CERNLIB_CRAY)
- char *mess = _fcdtocp( fcd_mess );
-#endif
-#if defined(CERNLIB_VAX)
- char *mess = dsc_mess->dsc$a_pointer;
-#endif
- *w = XTextWidth( text_font, mess, *lmess );
- *h = text_font->ascent;
-}
-
-
-/*
- * SUBROUTINE IXBOX(X1,X2,Y1,Y2,MODE)
- * INTEGER X1,Y1 : left down corner
- * INTEGER X2,Y2 : right up corner
- * INTEGER MODE : drawing mode
- *
- * MODE=0 hollow
- * MODE=1 solid
- *
- * Draw a box
- */
-void
- ixbox( x1, x2, y1, y2, mode)
-int *x1, *x2, *y1, *y2;
-int *mode;
-{
- switch ( *mode ) {
-
- case 0 : XDrawRectangle( display, cws->drawing, *gcline,
- min(*x1,*x2), min(*y1,*y2),
- abs(*x2-*x1), abs(*y2-*y1));
- break;
-
- case 1 : XFillRectangle( display, cws->drawing, *gcfill,
- min(*x1,*x2), min(*y1,*y2),
- abs(*x2-*x1), abs(*y2-*y1));
- break;
-
- default: break;
- }
- do_raise = 1;
-}
-
-
-/*
- * SUBROUTINE IXCA(X1,X2,Y1,Y2,NX,NY,IC)
- * INTEGER X1,Y1 : left down corner
- * INTEGER X2,Y2 : right up corner
- * INTEGER NX,NY : array size
- * INTEGER IC : array
- *
- * Draw a cell array. The drawing is done with the pixel presicion
- * if (X2-X1)/NX (or Y) is not a exact pixel number the position of
- * the top rigth corner may be wrong.
- */
-void
- ixca(x1, x2, y1, y2, nx, ny, ic)
-int *x1, *x2, *y1, *y2, *nx, *ny;
-int ic[];
-{
- int i,j,icol,ix,iy,w,h,current_icol;
-
- current_icol = -1;
- w = max((*x2-*x1)/(*nx),1);
- h = max((*y1-*y2)/(*ny),1);
- ix = *x1;
-
- for ( i=0; i<*nx; i++ ) {
- iy = *y1-h;
- for ( j=0; j<*ny; j++ ) {
- icol = ic[i+(*nx*j)];
- if(icol != current_icol){
- XSetForeground( display, *gcfill, colors[icol].pixel );
- current_icol = icol;
- }
- XFillRectangle( display, cws->drawing, *gcfill, ix, iy, w, h);
- iy = iy-h;
- }
- ix = ix+w;
- }
-}
-
-
-/*
- * SUBROUTINE IXDRMDE(MODE)
- * INTEGER MODE : drawing mode
- *
- * MODE=1 copy
- * MODE=2 xor
- * MODE=3 invert
- * MODE=4 set the suitable mode for cursor echo accordinf to
- * the vendor.
- *
- * Set the drawing mode
- */
-void
- ixdrmde( mode )
- int *mode;
-{
- int i;
- switch ( *mode ) {
-
- case 1 :
- for ( i = 0; i < MAXGC; i++ ) XSetFunction( display, gclist[i], GXcopy);
- break;
-
- case 2 :
- for ( i = 0; i < MAXGC; i++ ) XSetFunction( display, gclist[i], GXxor);
- break;
-
- case 3 :
- for ( i = 0; i < MAXGC; i++ ) XSetFunction( display, gclist[i], GXinvert);
- break;
-
- case 4 :
- if(strstr(vendor,"Hewlett")) {
- for ( i = 0; i < MAXGC; i++ ) XSetFunction( display, gclist[i], GXinvert);
- } else {
- for ( i = 0; i < MAXGC; i++ ) XSetFunction( display, gclist[i], GXxor);
- }
- break;
-
- default: break;
- }
-}
-
-
-/*
- * SUBROUTINE IXSYNC(MODE)
- * INTEGER MODE : synchronisation on/off
- *
- * MODE=1 on
- * MODE<>0 off
- *
- * Set synchronisation on or off
- */
-void
- ixsync( mode )
- int *mode;
-{
- switch ( *mode ) {
-
- case 1 :
- XSynchronize(display,1);
- break;
-
- default:
- XSynchronize(display,0);
- break;
- }
-}
-
-
-/*
- * SUBROUTINE IXQPTR(IX,IY)
- *
- * Output parameters:
- *
- * INTEGER IX : X coordinate of pointer
- * INTEGER IY : Y coordinate of pointer
- * (both coordinates are relative to the origin of the root window)
- */
-void ixqptr( ix, iy )
-int *ix,*iy;
-{
- Window idg;
-
- Window root_return,child_return;
- int win_x_return,win_y_return;
- int root_x_return,root_y_return;
- unsigned int mask_return;
-
- XQueryPointer(display,cws->window,&root_return,
- &child_return,&root_x_return,&root_y_return,&win_x_return,
- &win_y_return,&mask_return);
-
- *ix = (int)root_x_return;
- *iy = (int)root_y_return;
-
-}
-
-
-/*
- * SUBROUTINE IXWARP(IX,IY)
- *
- * Input parameters:
- *
- * INTEGER IX : New X coordinate of pointer
- * INTEGER IY : New Y coordinate of pointer
- * (both coordinates are relative to the origin of the current window)
- */
-void ixwarp( ix, iy )
-int *ix,*iy;
-{
-#if !defined(CERNLIB_TK_WINDOWS)
- XWarpPointer(display,0,cws->window,0,0,0,0,*ix,*iy);
-#endif
-}
-
-
-/*
- * INTEGER FUNCTION IXREQLO(MODE,CTYP,X,Y)
- * INTEGER X,Y : cursor position out moment of button press (output)
- * INTEGER CTYP : cursor type (input)
- *
- * CTYP=1 tracking cross
- * CTYP=2 cross-hair
- * CTYP=3 rubber circle
- * CTYP=4 rubber band
- * CTYP=5 rubber rectangle
- *
- * INTEGER MODE : input mode
- *
- * MODE=0 request
- * MODE=1 sample
- *
- * Request locator:
- * return button number 1 = left is pressed
- * 2 = middle is pressed
- * 3 = right is pressed
- * in sample mode:
- * 11 = left is released
- * 12 = middle is released
- * 13 = right is released
- * -1 = nothing is pressed or released
- * -2 = leave the window
- * else = keycode (keyboard is pressed)
- */
-int
- ixreqlo( mode, ctyp, x, y )
-int *mode, *ctyp, *x, *y;
-{
- static Cursor cursor = (Cursor)LNULL;
- XEvent event;
- int button_press;
- int radius;
-
- setinput(1);
-
-/*
- * Change the cursor shape
- */
- if( cursor == (Cursor)NULL ) {
-#if defined(CERNLIB_TK_WINDOWS)
- XDefineCursor( display, cws->window, null_cursor );
- XSetForeground( display, gcecho, colors[0].pixel );
-#endif
-#if !defined(CERNLIB_TK_WINDOWS)
- if( *ctyp > 1 ) {
- XDefineCursor( display, cws->window, null_cursor );
- XSetForeground( display, gcecho, colors[0].pixel );
- } else {
- cursor = XCreateFontCursor( display, XC_crosshair );
- XDefineCursor( display, cws->window, cursor );
- }
-#endif
- }
-
-/*
- * Event loop
- */
- button_press = 0;
-
- while ( button_press == 0 ) {
-
- switch ( *ctyp ) {
-
- case 1 : break;
-
- case 2 : XDrawLine( display, cws->window, gcecho,
- xloc, 0, xloc, cws->height);
- XDrawLine( display, cws->window, gcecho,
- 0, yloc, cws->width, yloc);
- break;
-
- case 3 : radius = (int) sqrt((double)((xloc-xlocp)*(xloc-xlocp)+
- (yloc-ylocp)*(yloc-ylocp)));
- XDrawArc( display, cws->window, gcecho,
- xlocp-radius, ylocp-radius,
- 2*radius, 2*radius, 0, 23040);
-
- case 4 : XDrawLine( display, cws->window, gcecho,
- xlocp, ylocp, xloc, yloc);
- break;
-
- case 5 : XDrawRectangle( display, cws->window, gcecho,
- min(xlocp,xloc), min(ylocp,yloc),
- abs(xloc-xlocp), abs(yloc-ylocp));
- break;
-
- default: break;
- }
-
- while ( XEventsQueued( display, QueuedAlready) > 1) {
- XNextEvent( display, &event);
- }
- XWindowEvent( display, cws->window, mouse_mask, &event );
-
- switch ( *ctyp ) {
-
- case 1 : break;
-
- case 2 : XDrawLine( display, cws->window, gcecho,
- xloc, 0, xloc, cws->height);
- XDrawLine( display, cws->window, gcecho,
- 0, yloc, cws->width, yloc);
- break;
-
- case 3 : radius = (int) sqrt((double)((xloc-xlocp)*(xloc-xlocp)+
- (yloc-ylocp)*(yloc-ylocp)));
- XDrawArc( display, cws->window, gcecho,
- xlocp-radius, ylocp-radius,
- 2*radius, 2*radius, 0, 23040);
-
- case 4 : XDrawLine( display, cws->window, gcecho,
- xlocp, ylocp, xloc, yloc);
- break;
-
- case 5 : XDrawRectangle( display, cws->window, gcecho,
- min(xlocp,xloc), min(ylocp,yloc),
- abs(xloc-xlocp), abs(yloc-ylocp));
- break;
-
- default: break;
- }
-
- xloc = event.xbutton.x;
- yloc = event.xbutton.y;
-
- switch ( event.type ) {
-
- case LeaveNotify :
- if( *mode == 0 ) {
- forever {
- XNextEvent( display, &event);
- if( event.type == EnterNotify ) break;
- }
- } else {
- button_press = -2;
- }
- break;
-
- case ButtonPress :
- button_press = event.xbutton.button ;
- xlocp = event.xbutton.x;
- ylocp = event.xbutton.y;
-#if !defined(CERNLIB_TK_WINDOWS)
- XUndefineCursor( display, cws->window );
-#endif
- cursor = (Cursor)NULL;
- break;
-
- case ButtonRelease :
- if( *mode == 1 ) {
- button_press = 10+event.xbutton.button ;
- xlocp = event.xbutton.x;
- ylocp = event.xbutton.y;
- }
- break;
-
- case KeyPress :
- if( *mode == 1 ) {
- button_press = event.xkey.keycode;
- xlocp = event.xbutton.x;
- ylocp = event.xbutton.y;
- }
- break;
-
- case KeyRelease :
- if( *mode == 1 ) {
- button_press = -event.xkey.keycode;
- xlocp = event.xbutton.x;
- ylocp = event.xbutton.y;
- }
- break;
-
- default : break;
- }
-
- if( *mode == 1 ) {
- if( button_press == 0 )
- button_press = -1;
- break;
- }
- }
- *x = event.xbutton.x;
- *y = event.xbutton.y;
- setinput(0);
- XFlush( display );
- return( button_press );
-}
-
-
-/*
- * INTEGER FUNCTION IXREQST(X,Y,LEN,TEXT)
- * INTEGER X,Y : position where text is displayed
- * INTEGER LEN : text length
- * CHARACTER*(*) TEXT : text displayed (input), edited text (output)
- *
- * Request string:
- * text is displayed and can be edited with Emacs-like keybinding
- * return termination code (0 for ESC, 1 for RETURN)
- */
-int
- ixreqst( x, y, len_text,
-#if defined(CERNLIB_CRAY)
- fcd_text )
-_fcd fcd_text;
-#endif
-#if defined(CERNLIB_VAX)
- dsc_text )
-struct dsc$descriptor_s *dsc_text;
-#endif
-#if defined(CERNLIB_TK_WINDOWS)
- text, lentext )
-char *text;
-int lentext;
-#endif
-#if (!defined(CERNLIB_CRAY))&&(!defined(CERNLIB_VAX))&&(!defined(CERNLIB_TK_WINDOWS))
- text )
-char *text;
-#endif
-int *len_text;
-int *x, *y;
-{
-#if defined(CERNLIB_CRAY)
- char *text = _fcdtocp( fcd_text );
-#endif
-#if defined(CERNLIB_VAX)
- char *text = dsc_text->dsc$a_pointer;
-#endif
- static Cursor cursor = (Cursor)LNULL;
- static int percent = 0; /* bell volume */
- Window focuswindow;
- int focusrevert;
- XEvent event;
- KeySym keysym;
- int key = -1;
- int nt; /* defined length of text */
- int pt; /* cursor position in text */
-
- setinput(1);
-
- /* change the cursor shape */
- if( cursor == (Cursor)NULL ) {
- XKeyboardState kbstate;
-#if !defined(CERNLIB_TK_WINDOWS)
- cursor = XCreateFontCursor( display, XC_question_arrow );
- XGetKeyboardControl( display, &kbstate );
- percent = kbstate.bell_percent;
-#endif
-#if defined(CERNLIB_TK_WINDOWS)
- cursor = (Cursor) NULL;
- percent = 100;
-#endif
- }
- if( cursor != (Cursor)NULL )
- XDefineCursor( display, cws->window, cursor );
- for( nt = *len_text; nt > 0 && text[nt-1] == ' '; nt-- );
- pt = nt;
- XGetInputFocus( display, &focuswindow, &focusrevert );
- XSetInputFocus( display, cws->window, focusrevert, CurrentTime );
- while( key < 0 ) {
- char keybuf[8];
- char nbytes;
- int dx;
- int i;
- XDrawImageString( display, cws->window, *gctext,
- *x, *y, text, nt );
- dx = XTextWidth( text_font, text, nt );
- XDrawImageString( display, cws->window, *gctext,
- *x + dx, *y, " ", 1 );
- dx = pt == 0 ? 0 : XTextWidth( text_font, text, pt );
- XDrawImageString( display, cws->window, *gcinvt,
- *x + dx, *y, pt < *len_text ? &text[pt] : " ", 1 );
- XWindowEvent( display, cws->window, keybd_mask, &event );
- switch( event.type ) {
- case ButtonPress:
- case EnterNotify:
- XSetInputFocus( display, cws->window, focusrevert, CurrentTime );
- break;
- case LeaveNotify:
- XSetInputFocus( display, focuswindow, focusrevert, CurrentTime );
- break;
- case KeyPress:
- nbytes = XLookupString( &event.xkey, keybuf, sizeof( keybuf ),
- &keysym, NULL );
- switch( keysym ) { /* map cursor keys */
- case XK_Left:
- keybuf[0] = '\002'; /* Control-B */
- nbytes = 1;
- break;
- case XK_Right:
- keybuf[0] = '\006'; /* Control-F */
- nbytes = 1;
- break;
- }
- if( nbytes == 1 ) {
- if( isascii( keybuf[0] ) && isprint( keybuf[0] ) ) {
- /* insert character */
- if( nt < *len_text )
- nt++;
- for( i = nt - 1; i > pt; i-- )
- text[i] = text[i-1];
- if( pt < *len_text ) {
- text[pt] = keybuf[0];
- pt++;
- }
- }
- else
- switch( keybuf[0] ) {
- /* Emacs-like editing keys */
-
- case '\010': /* backspace */
- case '\177': /* delete */
- /* delete backward */
- if( pt > 0 ) {
- for( i = pt; i < nt; i++ )
- text[i-1] = text[i];
- text[nt-1] = ' ';
- nt--;
- pt--;
- }
- break;
- case '\001': /* ^A */
- /* beginning of line */
- pt = 0;
- break;
- case '\002': /* ^B */
- /* move backward */
- if( pt > 0 )
- pt--;
- break;
- case '\004': /* ^D */
- /* delete forward */
- if( pt > 0 ) {
- for( i = pt; i < nt; i++ )
- text[i-1] = text[i];
- text[nt-1] = ' ';
- pt--;
- }
- break;
- case '\005': /* ^E */
- /* end of line */
- pt = nt;
- break;
-
- case '\006': /* ^F */
- /* move forward */
- if( pt < nt )
- pt++;
- break;
- case '\013': /* ^K */
- /* delete to end of line */
- for( i = pt; i < nt; i++ )
- text[i] = ' ';
- nt = pt;
- break;
- case '\024': /* ^T */
- /* transpose */
- if( pt > 0 ) {
- char c = text[pt];
- text[pt] = text[pt-1];
- text[pt-1] = c;
- }
- break;
- case '\012': /* newline */
- case '\015': /* return */
- key = 1;
- break;
- case '\033': /* escape */
- key = 0;
- break;
-
- default:
- XBell( display, percent );
- }
- }
- }
- }
- XSetInputFocus( display, focuswindow, focusrevert, CurrentTime );
-
- if( cursor != (Cursor)NULL ) {
-#if !defined(CERNLIB_TK_WINDOWS)
- XUndefineCursor( display, cws->window );
-#endif
- cursor = (Cursor)LNULL;
- }
-
- setinput(0);
-
- return( key );
-}
-
-#define MAX_SEGMENT 20
-void ixput_image(offset,itran,x0,y0,nx,ny,xmin,ymin,xmax,ymax,image)
- int offset,itran,x0,y0,nx,ny,xmin,ymin,xmax,ymax;
- unsigned char *image;
-{
- int i, n, x, y, xcur, x1, x2, y1, y2;
- unsigned char *jimg, *jbase, icol;
- int nlines[256];
- XSegment lines[256][MAX_SEGMENT];
-
- for (i=0; i<256; i++) nlines[i] = 0;
-
- x1 = x0 + xmin; y1 = y0 + ny - ymax - 1;
- x2 = x0 + xmax; y2 = y0 + ny - ymin - 1;
- jbase = image + (ymin-1)*nx + xmin;
-
- for (y=y2; y>=y1; y--) {
- xcur = x1; jbase += nx;
- for (jimg = jbase, icol = *jimg++, x=x1+1; x<=x2; jimg++, x++) {
- if (icol != *jimg) {
- if (icol != itran) {
- n = nlines[icol]++;
- lines[icol][n].x1 = xcur; lines[icol][n].y1 = y;
- lines[icol][n].x2 = x-1; lines[icol][n].y2 = y;
- if (nlines[icol] == MAX_SEGMENT) {
- setcolor(*gcline,(int)icol+offset);
- XDrawSegments(display,cws->drawing,*gcline,&lines[icol][0],
- MAX_SEGMENT);
- nlines[icol] = 0;
- }
- }
- icol = *jimg; xcur = x;
- }
- }
- if (icol != itran) {
- n = nlines[icol]++;
- lines[icol][n].x1 = xcur; lines[icol][n].y1 = y;
- lines[icol][n].x2 = x-1; lines[icol][n].y2 = y;
- if (nlines[icol] == MAX_SEGMENT) {
- setcolor(*gcline,(int)icol+offset);
- XDrawSegments(display,cws->drawing,*gcline,&lines[icol][0],
- MAX_SEGMENT);
- nlines[icol] = 0;
- }
- }
- }
-
- for (i=0; i<256; i++) {
- if (nlines[i] != 0) {
- setcolor(*gcline,i+offset);
- XDrawSegments(display,cws->drawing,*gcline,&lines[i][0],nlines[i]);
- }
- }
-}
-
-#if defined(CERNLIB_GIF)
-/*
- * SUBROUTINE IXLDGIF(X0, Y0, LEN, FILE)
- * INTEGER LEN : file name length
- * CHARACTER*(*) FILE : file name
- * INTEGER X0 Y0 : position
- *
- * Load the gif a file in the current active window.
- */
-void ixldgif (x0, y0, len,
-#endif
-#if (defined(CERNLIB_GIF))&&(defined(CERNLIB_CRAY))
- fcd_file )
-_fcd fcd_file;
-#endif
-#if (defined(CERNLIB_GIF))&&(defined(CERNLIB_VAX))
- dsc_file )
-struct dsc$descriptor_s *dsc_file;
-#endif
-#if (defined(CERNLIB_GIF))&&(defined(CERNLIB_TK_WINDOWS))
- file, lenfile )
-char *file;
-int lenfile;
-#endif
-#if (defined(CERNLIB_GIF))&&(!defined(CERNLIB_CRAY))&&(!defined(CERNLIB_VAX))&&(!defined(CERNLIB_TK_WINDOWS))
- file )
-char *file;
-#endif
-#if defined(CERNLIB_GIF)
-int *len;
-int *x0,*y0;
-{
-#endif
-#if (defined(CERNLIB_GIF))&&(defined(CERNLIB_CRAY))
- char *file = _fcdtocp( fcd_file );
-#endif
-#if (defined(CERNLIB_GIF))&&(defined(CERNLIB_VAX))
- char *file = dsc_file->dsc$a_pointer;
-#endif
-#if defined(CERNLIB_GIF)
- FILE *fd;
- long filesize;
- unsigned char *GIFarr, *PIXarr, R[256], G[256], B[256], *j1, *j2, icol;
- int i, j, k, width, height, ncolor, irep, offset;
- float rr, gg, bb;
-
- fd = fopen(string(file,*len), "r");
- if (!fd) {
- fprintf(stderr,"ixldgif: unable to open GIF file\n");
- return;
- }
-
- fseek(fd, 0L, 2);
- filesize = ftell(fd);
- fseek(fd, 0L, 0);
-
- if (!(GIFarr = (unsigned char *) calloc(filesize+256,1))) {
- fprintf(stderr,"ixldgif: unable to allocate array for gif\n");
- return;
- }
-
- if (fread(GIFarr, filesize, 1, fd) != 1) {
- fprintf(stderr,"ixldgif: GIF file read failed\n");
- return;
- }
-
- irep = GIFinfo(GIFarr, &width, &height, &ncolor);
- if (irep != 0) return;
-
- if (!(PIXarr = (unsigned char *) calloc((long)(width*height),1))) {
- fprintf(stderr,"ixldgif: unable to allocate array for image\n");
- return;
- }
-
- irep = GIFdecode(GIFarr, PIXarr, &width, &height, &ncolor, R, G, B);
- if (irep != 0) return;
-
- /* S E T P A L E T T E */
-
- offset = 8;
-
- for (i=0; i<ncolor; i++) {
- rr = R[i]/255.;
- gg = G[i]/255.;
- bb = B[i]/255.;
- j = i+offset;
- ixsetco(&j,&rr,&gg,&bb);
- }
-
- /* O U T P U T I M A G E */
-
- for (i=1; i<=height/2; i++) {
- j1 = PIXarr + (i-1)*width;
- j2 = PIXarr + (height-i)*width;
- for (k=0; k<width; k++) {
- icol = *j1; *j1++ = *j2; *j2++ = icol;
- }
- }
- ixput_image(offset,-1,*x0,*y0,width,height,0,0,width-1,height-1,PIXarr);
-}
-
-typedef unsigned char byte; /* type used by subroutines to code&decode GIF*/
-XImage *image; /* temporary unit for GIFencode() */
-FILE *out; /* output/input file for animation */
-static int first = 0;
-
-/*
- * subroutines for GIFencode()
- */
-
-void
- get_scline( y, width, scline )
- int y, width;
- byte scline[];
-{
-int i;
-for(i=0;i< width;i++)
- scline[i] = XGetPixel( image, i, y);
-}
-
-
-void
- put_byte( b)
- byte b;
-{
- if( ferror(out) == 0) fputc( b, out);
-}
-
-/*
- * SUBROUTINE IXDOGIF( NW, NH, LEN , FILE)
- * INTEGER NW : New width (if != 0)
- * INTEGER NH : New height (if != 0)
- * INTEGER LEN : File name lenght
- * CHARACTER FILE : File name
- *
- * Writes the current window into a GIF file
- *
- *
- */
-void
- ixdogif( nw, nh, len,
-#endif
-#if (defined(CERNLIB_GIF))&&(defined(CERNLIB_CRAY))
- fcd_file )
-_fcd fcd_file;
-#endif
-#if (defined(CERNLIB_GIF))&&(defined(CERNLIB_VAX))
- dsc_file )
-struct dsc$descriptor_s *dsc_file;
-#endif
-#if (defined(CERNLIB_GIF))&&(defined(CERNLIB_TK_WINDOWS))
- file, lenfile )
-char *file;
-int lenfile;
-#endif
-#if (defined(CERNLIB_GIF))&&(!defined(CERNLIB_CRAY))&&(!defined(CERNLIB_VAX))&&(!defined(CERNLIB_TK_WINDOWS))
- file )
-char *file;
-#endif
-#if defined(CERNLIB_GIF)
- int *nw, *nh;
- int *len;
-{
-#endif
-#if (defined(CERNLIB_GIF))&&(defined(CERNLIB_CRAY))
- char *file = _fcdtocp( fcd_file );
-#endif
-#if (defined(CERNLIB_GIF))&&(defined(CERNLIB_VAX))
- char *file = dsc_file->dsc$a_pointer;
-#endif
-#if defined(CERNLIB_GIF)
-
-XImage *imgtmp;
-byte *scline;
-byte *r, *g, *b;
-int *R, *G, *B;
-int ncol, maxcol, i;
-char file_name[80];
-
-Window root;
-int xx, yy;
-unsigned int ww, hh, border, depth;
-
- if (!display) {
- printf("**** Error: No X11 window opened. \n");
- return;
- }
-
- XGetGeometry( display, cws->drawing, &root, &xx, &yy, &ww, &hh,
- &border, &depth );
- if (ww != cws->width || hh != cws->height) {
- printf("**** Error: Empty window. Nothing to convert. \n");
- return;
- }
-
- imgtmp = XGetImage( display, cws->drawing, 0, 0,
- cws->width, cws->height,
- AllPlanes, ZPixmap);
-
- if (*nw > 0 && *nh > 0) {
- image = ImgScaling(display, imgtmp, *nw, *nh);
- } else {
- image = imgtmp;
- }
-
- ImgPickPalette( display, image, &ncol, &R, &G, &B);
-
- r = (byte *) malloc(256*sizeof(byte));
- g = (byte *) malloc(256*sizeof(byte));
- b = (byte *) malloc(256*sizeof(byte));
-
- maxcol = 0;
- for(i=0;i<ncol;i++) {
- if (maxcol < R[i] ) maxcol = R[i];
- if (maxcol < G[i] ) maxcol = G[i];
- if (maxcol < B[i] ) maxcol = B[i];
- r[i] = 0; g[i] = 0; b[i] = 0;
- }
-
- if( maxcol != 0) {
- for( i=0;i<ncol;i++) {
- r[i] = R[i] * 255/maxcol;
- g[i] = G[i] * 255/maxcol;
- b[i] = B[i] * 255/maxcol;
- }
- }
-
- sprintf( file_name, "%s", string(file, *len));
-
- out = fopen ( file_name, "w+");
-
- scline = (byte *) malloc(image->width*sizeof(byte));
-
- if (out) {
- GIFencode( image->width, image->height,
- ncol, r, g, b, scline, get_scline, put_byte);
- fclose( out );
- } else {
- printf("**** Error: Cannot open file \n");
- }
-
- XFree(image);
- free(R); free(G); free(B); free(r); free(g); free(b); free(scline);
-}
-#endif
-#endif
diff --git a/src/graflib/higz/higzcc/zbuffer.c b/src/graflib/higz/higzcc/zbuffer.c
deleted file mode 100644
index a28a17b..0000000
--- a/src/graflib/higz/higzcc/zbuffer.c
+++ /dev/null
@@ -1,1523 +0,0 @@
-/*
- * $Id: zbuffer.c,v 1.4 1998/09/25 09:23:59 mclareni Exp $
- *
- * $Log: zbuffer.c,v $
- * Revision 1.4 1998/09/25 09:23:59 mclareni
- * Modifications for the Mklinux port flagged by CERNLIB_PPC
- *
- * Revision 1.3 1997/03/14 14:22:29 mclareni
- * WNT mods
- *
- * Revision 1.2.2.1 1997/01/21 11:25:23 mclareni
- * All mods for Winnt 96a on winnt branch
- *
- * Revision 1.2 1996/03/08 14:56:19 cernlib
- * Correct ippfst and put_string macro for vms. There was infinite recursion.
- *
- * Revision 1.1.1.1 1996/02/14 13:10:27 mclareni
- * Higz
- *
- */
-#include "higz/pilot.h"
-#if defined(CERNLIB_ZBUF)
-/*CMZ : 2.07/20 12/12/95 10.19.50 by O.Couet*/
-/*-- Author : O.Couet*/
-/***********************************************************************
- * *
- * Name: Z-buffer Date: 15.08.95 *
- * Revised: *
- * Author: Evgeni Chernyaev (chernaev at mx.ihep.su) *
- * *
- * Contents (C interface): *
- * Zbuf_Init - initialize Z-buffer *
- * Zbuf_Clear - clear screen *
- * Zbuf_Clip - set cliping window *
- * Zbuf_World - set world min-max scope *
- * Zbuf_Pixel - draw point *
- * Zbuf_Line - draw line *
- * Zbuf_Fill - fill area *
- * Zbuf_Spectr - set spectrum for Gouraud shading *
- * Zbuf_Shade - fill area using Gouraud shading *
- * Zbuf_XFlush - flush Z-image to X Windows window (HIGZ) *
- * Zbuf_Print - print Z-image on terminal screen (for debug) *
- * Zbuf_PostScript - output Z-image to PostScript *
- * *
- * (FORTRAN interface): *
- * IREP=IHZINI(NX,NY,NZ) *
- * CALL IHZCLE(ICOL) *
- * CALL IHZCLI(XMIN,YMIN,XMAX,YMAX) *
- * CALL IHZWRD(XMIN,YMIN,ZMIN,XMAX,YMAX,ZMAX) *
- * CALL IHZPNT(ICOL,X,Y,Z) *
- * CALL IHZLIN(ICOL,X1,Y1,Z1,X2,Y2,Z2) *
- * CALL IHZFIL(ICOL,N,X,Y,Z) *
- * CALL IHZSPE(NL,FMIN,FMAX,ICOL) *
- * CALL IHZSHA(N,X,Y,Z,F) *
- * CALL IHZTOX(ITRAN,X0,Y0) *
- * CALL IHZPRN() *
- * CALL IHZPS(IFGRAY,IFROTATE,XMIN,YMIN,XMAX,YMAX,NCOL,R,G,B) *
- * *
- ***********************************************************************/
-#include <stdio.h>
-#include <stdlib.h>
-#include <string.h>
-
-#ifdef __STDC__
-#define ARGS(alist) alist
-#else
-#define ARGS(alist) ()
-#endif
-
-typedef unsigned char byte;
-
-/* F O R T R A N I N T E R F A C E - M A I N R O U T I N E S*/
-
-#if defined(CERNLIB_QX_SC)
-#define ihzini ihzini_
-#define ihzcle ihzcle_
-#define ihzcli ihzcli_
-#define ihzwrd ihzwrd_
-#define ihzpix ihzpix_
-#define ihzlin ihzlin_
-#define ihzfil ihzfil_
-#define ihzspe ihzspe_
-#define ihzsha ihzsha_
-#define ihztox ihztox_
-#define ihzprn ihzprn_
-#define ihzps ihzps_
-#define ippfst ippfst_
-#endif
-#if defined(CERNLIB_QXCAPT)
-#define ihzini IHZINI
-#define ihzcle IHZCLE
-#define ihzcli IHZCLI
-#define ihzwrd IHZWRD
-#define ihzpix IHZPIX
-#define ihzlin IHZLIN
-#define ihzfil IHZFIL
-#define ihzspe IHZSPE
-#define ihzsha IHZSHA
-#define ihztox IHZTOX
-#define ihzprn IHZPRN
-#define ihzps IHZPS
-#define ippfst IPPFST
-#endif
-#if defined(CERNLIB_IBM)
-#pragma linkage (ihzini ,FORTRAN)
-#pragma linkage (ihzcle ,FORTRAN)
-#pragma linkage (ihzcli ,FORTRAN)
-#pragma linkage (ihzwrd ,FORTRAN)
-#pragma linkage (ihzpix ,FORTRAN)
-#pragma linkage (ihzlin ,FORTRAN)
-#pragma linkage (ihzfil ,FORTRAN)
-#pragma linkage (ihzspe ,FORTRAN)
-#pragma linkage (ihzsha ,FORTRAN)
-#pragma linkage (ihztox ,FORTRAN)
-#pragma linkage (ihzprn ,FORTRAN)
-#define linkage (ihzps ,FORTRAN)
-#define linkage (ippfst ,FORTRAN)
-#endif
-
-
-/* U S E F U L M A C R O S*/
-
-#define SWAP(A,B,C) C = A; A = B; B = C
-#define MIN(A,B) (A < B ? A : B)
-#define MAX(A,B) (A > B ? A : B)
-
-/* G L O B A L V A R I A B L E S A N D D E F I N I T I O N S*/
-
-#if defined(CERNLIB_VAX)||defined(CERNLIB_DECS)||defined(CERNLIB_MSDOS)||defined(CERNLIB_WINNT)||(defined(CERNLIB_LINUX) && !defined(CERNLIB_PPC))
-#define Z_OFFSET 1 /* offset for short* on int (machine depended) */
-#define C_OFFSET 2 /* offset for byte* on int (machine depended) */
-#endif
-#if (!defined(CERNLIB_VAX))&&(!defined(CERNLIB_DECS))&&(!defined(CERNLIB_MSDOS))&&(!defined(CERNLIB_WINNT))&&(!(defined(CERNLIB_LINUX) && !defined(CERNLIB_PPC)))
-#define Z_OFFSET 0 /* offset for short* on int (machine depended) */
-#define C_OFFSET 1 /* offset for byte* on int (machine depended) */
-#endif
-#define MAXSIZE 4096 /* max size of z-screen */
-#define LMAX 50 /* max number of edges in polygon */
-
-struct EDGE {
- short x; /* X of 1st node & current X */
- short y; /* Y of 1st node */
- int z; /* Z of 1st node & current Z */
- int c; /* Colour of 1st node & current Colour */
- short xx; /* X of 2nd node & X increment */
- short yy; /* Y of 2nd node */
- int zz; /* Z of 2nd node & Z increment */
- int cc; /* Colour of 2nd node & Colour increment */
- short test; /* current parameter */
- short dxsign; /* sign of X increment */
-};
-
-static int Zstat = 0; /* status of z-buffer */
-
-static short *Zbuf; /* z-buffer */
-static byte *Zimg; /* image */
-
-static float XWmin, YWmin, ZWmin,
- XWmax, YWmax, ZWmax; /* world min-max scope */
-static long Nalloc=0; /* size of allocated memory */
-static short Nx, Ny, Nz; /* z-image size */
-static short Xmin, Ymin, Xmax, Ymax; /* cliping rectangle */
-static int IXmin, IYmin,
- IXmax, IYmax; /* area occupated by image */
-static int IBack=-1; /* background colour */
-static float Fmin, Fmax; /* min, max lightness */
-static int Nlevel, FstCol; /* number of levels, 1st colour */
-
-static struct EDGE edge[LMAX], *jedge[LMAX];
-static int Nedge, xscan[LMAX], zscan[LMAX], cscan[LMAX];
-
-/***********************************************************************
- * *
- * E X T E R N A L R O U T I N E S *
- * *
- ***********************************************************************/
-
-void ixput_image ARGS((int,int,int,int,int,int,int,int,int,int,byte*));
-
-#if defined(CERNLIB_VAX)
-#include <descrip.h>
-#define ippfst_vms(s1) \
- do { extern void ippfst(struct dsc$descriptor_s*); \
- struct dsc$descriptor_s s1_dsc; \
- s1_dsc.dsc$b_dtype = DSC$K_DTYPE_T; \
- s1_dsc.dsc$b_class = DSC$K_CLASS_S; \
- s1_dsc.dsc$a_pointer = s1; \
- s1_dsc.dsc$w_length = strlen(s1); \
- ippfst(&s1_dsc); } while(0)
-#endif
-#if !defined(CERNLIB_VAX)
-#define zippfst(s1) \
- ippfst(s1,strlen(s1))
-#endif
-
-#ifdef CERNLIB_WINNT
-/***********************************************************************
- * Dummy routine for Windows NT *
- ***********************************************************************/
-void ixput_image(offset,itran,x0,y0,nx,ny,xmin,ymin,xmax,ymax,image)
- int offset,itran,x0,y0,nx,ny,xmin,ymin,xmax,ymax;
- unsigned char *image;
-{
-}
-#endif
-
-/***********************************************************************
- * *
- * I N T E R N A L R O U T I N E S *
- * *
- ***********************************************************************
- * *
- * Name: Zbuf_WtoS Date: 15.08.95 *
- * Author: E.Chernyaev (IHEP/Protvino) Revised: *
- * *
- * Function: Transform coordinates of point from world to screen *
- * *
- * Input: XW, YW, ZW - world coodinates of point *
- * Output: XS, YS, ZS - screen coordinates of point *
- * *
- ***********************************************************************/
-static void Zbuf_WtoS(XW, YW, ZW, XS, YS, ZS)
- float XW, YW, ZW;
- int *XS,*YS,*ZS;
-{
- int x, y;
-
- *XS = ((XW - XWmin)/(XWmax-XWmin)) * Nx;
- *YS = ((YW - YWmin)/(YWmax-YWmin)) * Ny;
- *ZS = ((ZW - ZWmin)/(ZWmax-ZWmin)) * Nz * 65536;
- IXmin = MIN(IXmin,*XS); IXmax = MAX(IXmax,*XS);
- IYmin = MIN(IYmin,*YS); IYmax = MAX(IYmax,*YS);
-}
-
-/***********************************************************************
- * *
- * Name: Zbuf_FtoC Date: 15.08.95 *
- * Author: E.Chernyaev (IHEP/Protvino) Revised: *
- * *
- * Function: Translate function value to colour index *
- * *
- * Input: F - function value *
- * *
- * Output: ICOL - extended colour index *
- * *
- ***********************************************************************/
-static void Zbuf_FtoC(F, ICOL)
- float F;
- int *ICOL;
-{
- *ICOL = (((F - Fmin)/(Fmax - Fmin))*Nlevel + FstCol) * 65536;
-}
-
-/***********************************************************************
- * *
- * Name: Zbuf_GetEdges Date: 15.08.95 *
- * Author: E.Chernyaev (IHEP/Protvino) Revised: *
- * *
- * Function: Get edges of the polygon *
- * *
- * Input: N - number of edges *
- * X(*),Y(*),Z(*) - coordinates of nodes *
- * F1(*) - function values at nodes *
- * ifval - flag: 1 - copy function values *
- * 0 - do not copy *
- * *
- ***********************************************************************/
-static void Zbuf_GetEdges(N, X, Y, Z, F, ifval)
- int N, ifval;
- float *X,*Y,*Z,*F;
-{
- int i, n;
- int i1, x1, y1, z1, icol1;
- int i2, x2, y2, z2, icol2;
- byte *jcol,*jcol1,*jcol2;
-
- Nedge = 0;
-
- /* C H E C K N U M B E R O F E D G E S */
-
- n = N;
- if (n < 0 || n > LMAX) {
- fprintf(stderr,"Zbuf_GetEdges: wrong n. of edges=%d (max=%d)\n",n,LMAX);
- return;
- }
-
- /* S K I P H O R I Z O N T A L E D G E S */
- /* S E T R I G H T O R I E N T A T I O N O F E D G E S */
-
- n = icol1 = icol2 = 0;
- for (i=0; i < N; i++) {
- i1 = i; i2 = i+1; if (i2 == N) i2 = 0;
- Zbuf_WtoS(X[i1], Y[i1], Z[i1], &x1, &y1, &z1);
- if (ifval) Zbuf_FtoC(F[i1], &icol1);
- Zbuf_WtoS(X[i2], Y[i2], Z[i2], &x2, &y2, &z2);
- if (ifval) Zbuf_FtoC(F[i2], &icol2);
- if (y1 == y2) continue;
- if (y1 < Ymin && y2 < Ymin) continue;
- if (y1 > Ymax && y2 > Ymax) continue;
- if (y2 > y1) {
- edge[n].x = x1; edge[n].y = y1; edge[n].z = z1; edge[n].c = icol1;
- edge[n].xx = x2; edge[n].yy = y2; edge[n].zz = z2; edge[n].cc = icol2;
- }else{
- edge[n].x = x2; edge[n].y = y2; edge[n].z = z2; edge[n].c = icol2;
- edge[n].xx = x1; edge[n].yy = y1; edge[n].zz = z1; edge[n].cc = icol1;
- }
- n++;
- }
- Nedge = n;
-}
-
-/***********************************************************************
- * *
- * Name: Zbuf_MinMax Date: 15.08.95 *
- * Author: E.Chernyaev (IHEP/Protvino) Revised: *
- * *
- * Function: Find surrounding box (min-max scope) *
- * *
- * Output: XMIN,XMAX,YMIN,YMAX - min-max scope *
- * *
- ***********************************************************************/
-static void Zbuf_MinMax(XMIN, XMAX, YMIN, YMAX)
- int *XMIN,*XMAX,*YMIN,*YMAX;
-{
- int i, xmin, xmax, ymin, ymax;
-
- xmin = xmax = edge[1].x; ymin = ymax = edge[1].y;
- for (i=0; i<Nedge; i++) {
- if (xmin > edge[i].x) xmin = edge[i].x;
- if (xmax < edge[i].x) xmax = edge[i].x;
- if (xmin > edge[i].xx) xmin = edge[i].xx;
- if (xmax < edge[i].xx) xmax = edge[i].xx;
- if (ymin > edge[i].y) ymin = edge[i].y;
- if (ymax < edge[i].yy) ymax = edge[i].yy;
- }
- *XMIN = xmin; *XMAX = xmax; *YMIN = ymin; *YMAX = ymax;
-}
-
-/***********************************************************************
- * *
- * Name: Zbuf_SortEdges Date: 15.08.95 *
- * Author: E.Chernyaev (IHEP/Protvino) Revised: *
- * *
- * Function: Sort edges along Y *
- * *
- ***********************************************************************/
-static void Zbuf_SortEdges()
-{
- int i, k;
- struct EDGE *jcur;
-
- for (i=0; i<Nedge; i++) { jedge[i] = &edge[i]; }
- for (i=0; i<Nedge-1; i++) {
- if (jedge[i+1]->y >= jedge[i]->y) continue;
- for (k=i+1; k>0; k--) {
- if (jedge[k]->y >= jedge[k-1]->y) break;
- SWAP(jedge[k],jedge[k-1],jcur);
- }
- }
-}
-
-/***********************************************************************
- * *
- * Name: Zbuf_InitEdges Date: 15.08.95 *
- * Author: E.Chernyaev (IHEP/Protvino) Revised: *
- * *
- * Function: Initialize edges for polygon filling *
- * *
- ***********************************************************************/
-static void Zbuf_InitEdges()
-{
- int i, dx, dy;
-
- for (i=0; i<Nedge; i++) {
- dx = edge[i].xx - edge[i].x;
- dy = edge[i].yy - edge[i].y;
- if (dx < 0) { edge[i].dxsign = -1; dx = -dx;} else { edge[i].dxsign = 1;}
- edge[i].xx = dx;
- if (dx <= dy) {
- edge[i].test = -(dy+1)/2;
- edge[i].zz = (edge[i].zz - edge[i].z) / dy;
- edge[i].cc = (edge[i].cc - edge[i].c) / dy;
- }else{
- edge[i].test = -dx;
- edge[i].zz = (edge[i].zz - edge[i].z) / dx;
- edge[i].cc = (edge[i].cc - edge[i].c) / dx;
- }
- }
-}
-
-/***********************************************************************
- * *
- * M A I N R O U T I N E S - C I N T E R F A C E *
- * *
- ***********************************************************************
- * *
- * Name: Zbuf_Init Date: 15.08.95 *
- * Author: E.Chernyaev (IHEP/Protvino) Revised: *
- * *
- * Function: Initialize Z-buffer *
- * *
- * Input: NX,NY,NZ - dimensions of Z-buffer *
- * *
- * Return: 0 - O.K. *
- * 1 - error during initialization *
- * *
- ***********************************************************************/
-int Zbuf_Init(NX, NY, NZ)
- int NX, NY, NZ;
-{
- Zstat = 0;
-
- /* C H E C K P A R A M E T E R S */
-
- if (NX <= 0 || NX > MAXSIZE ||
- NY <= 0 || NY > MAXSIZE ||
- NZ <= 0 || NZ > MAXSIZE ) {
- fprintf(stderr,"Zbuf_Init: wrong z-buffer dimensions: %d %d %d\n",
- NX,NY,NZ);
- return 1;
- }
-
- Nx = NX; Ny = NY; Nz = NZ;
- Xmin = 0; Ymin = 0; Xmax = Nx - 1; Ymax = Ny - 1;
- IXmin = Xmax+1; IYmin = Ymax+1; IXmax = Xmin-1; IYmax = Ymin-1;
-
- /* A L L O C A T E Z - B U F F E R */
-
- if ((long)Nx * (long)Ny > Nalloc) {
-
- if (Nalloc != 0) {
- free((char *) Zbuf);
- free((char *) Zimg);
- }
-
- Zbuf = (short *) malloc (Nx*Ny*sizeof(short));
- if (!Zbuf) {
- fprintf(stderr,"Zbuf_Init: can not allocate z-buffer\n");
- return 1;
- }
-
- Zimg = (byte *) malloc (Nx*Ny*sizeof(byte));
- if (!Zimg) {
- fprintf(stderr,"Zbuf_Init: can not allocate image\n");
- return 1;
- }
-
- Nalloc = (long)Nx * (long)Ny;
- }
-
- Zstat = 1;
- return 0;
-}
-
-/***********************************************************************
- * *
- * Name: Zbuf_Clear Date: 15.08.95 *
- * Author: E.Chernyaev (IHEP/Protvino) Revised: *
- * *
- * Function: Clear screen *
- * *
- * Input: ICOL - background colour *
- * *
- ***********************************************************************/
-void Zbuf_Clear(ICOL)
- int ICOL;
-{
- int y,nx;
-
- if (!Zstat) return;
- if (IBack != ICOL) {
- memset ((char *)Zbuf, (char)0, Nx*Ny*sizeof(short));
- memset ((char *)Zimg, (char)(ICOL & 0xff), Nx*Ny);
- IBack = ICOL;
- }else{
- IXmin = MAX(IXmin,Xmin); IYmin = MAX(IYmin,Ymin);
- IXmax = MIN(IXmax,Xmax); IYmax = MIN(IYmax,Ymax);
- nx = IXmax - IXmin + 1;
- for (y=IYmin; y<=IYmax; y++) {
- memset ( (char *)(Zbuf+y*Nx+IXmin), (char)0, nx*sizeof(short));
- memset ( (char *)(Zimg+y*Nx+IXmin), (char)(ICOL & 0xff), nx);
- }
- }
- IXmin = Xmax+1; IYmin = Ymax+1; IXmax = Xmin-1; IYmax = Ymin-1;
-}
-
-/***********************************************************************
- * *
- * Name: Zbuf_Clip Date: 15.08.95 *
- * Author: E.Chernyaev (IHEP/Protvino) Revised: *
- * *
- * Function: Set cliping window *
- * *
- * Input: XMIN, YMIN, XMAX, YMAX - clipping rectangle *
- * *
- ***********************************************************************/
-void Zbuf_Clip(XMIN, YMIN, XMAX, YMAX)
- int XMIN, YMIN, XMAX, YMAX;
-{
- if (!Zstat) return;
- Xmin = MAX(XMIN,0); Xmax = MIN(XMAX,Nx-1);
- Ymin = MAX(YMIN,0); Ymax = MIN(YMAX,Ny-1);
-}
-
-/***********************************************************************
- * *
- * Name: Zbuf_World Date: 15.08.95 *
- * Author: E.Chernyaev (IHEP/Protvino) Revised: *
- * *
- * Function: Set world min-max scope *
- * *
- * Input: XMIN, XMAX, YMIN, YMAX, ZMIN, ZMAX - world min-max scope *
- * *
- ***********************************************************************/
-void Zbuf_World(XMIN, YMIN, ZMIN, XMAX, YMAX, ZMAX)
- float XMIN, YMIN, ZMIN, XMAX, YMAX, ZMAX;
-{
- float d;
-
- XWmin = XMIN; YWmin = YMIN; ZWmin = ZMIN;
- XWmax = XMAX; YWmax = YMAX; ZWmax = ZMAX;
- if (XWmin >= XWmax || YWmin >= YWmax || ZWmin >= ZWmax) {
- fprintf(stderr,"Zbuf_World: error in min-max scope\n");
- }
- d = 0.5 * (XWmax-XWmin) / (Nx-1); XWmin -= d; XWmax += d;
- d = 0.5 * (YWmax-YWmin) / (Ny-1); YWmin -= d; YWmax += d;
- d = 0.5 * (ZWmax-ZWmin) / (Nz-1); ZWmin -= d; ZWmax += d;
-}
-
-/***********************************************************************
- * *
- * Name: Zbuf_Point Date: 15.08.95 *
- * Author: E.Chernyaev (IHEP/Protvino) Revised: *
- * *
- * Function: Draw point (Z-buffer) *
- * *
- * Input: ICOL - colour *
- * X,Y,Z - coordinates of the point *
- * *
- ***********************************************************************/
-void Zbuf_Point(ICOL, X, Y, Z)
- int ICOL;
- float X, Y, Z;
-{
- int x, y, z, k;
- byte *jimg;
- short *jbuf, zz;
-
- /* C H E C K P A R A M E T E R S */
-
- if (!Zstat) return;
- Zbuf_WtoS(X, Y, Z, &x, &y, &z);
- if (x < Xmin || x > Xmax || y < Ymin || y > Ymax) return;
-
- /* D R A W P I X E L */
-
- k = y * Nx + x;
- jimg = Zimg + k;
- jbuf = Zbuf + k;
- zz = z / 65536;
- if (*jbuf <= zz) { *jbuf = zz; *jimg = ICOL & 0xff; }
-}
-
-/***********************************************************************
- * *
- * Name: Zbuf_Line Date: 15.08.95 *
- * Author: E.Chernyaev (IHEP/Protvino) Revised: *
- * *
- * Function: Draw line (Z-buffer) *
- * *
- * Input: ICOL - colour *
- * X1,Y1,Z1 - 1st point of the line *
- * X2,Y2,Z2 - 2nd point of the line *
- * *
- ***********************************************************************/
-void Zbuf_Line(ICOL, X1, Y1, Z1, X2, Y2, Z2)
- int ICOL;
- float X1, Y1, Z1, X2, Y2, Z2;
-{
- int x1, y1, z1, x2, y2, z2;
- int dx, dy, dz, dmax, dxdx, dydy, dxsign;
- int t, xcur, ycur, zcur, xlim1, xlim2;
- byte *jimg, icol;
- short *jbuf, *jend, *jzcur ;
-
- if (!Zstat) return;
-
- /* T R A N S F O R M C O O R D I N A T E S */
-
- icol = ICOL & 0xff;
- if (Y2 > Y1) {
- Zbuf_WtoS(X1, Y1, Z1, &x1, &y1, &z1);
- Zbuf_WtoS(X2, Y2, Z2, &x2, &y2, &z2);
- }else{
- Zbuf_WtoS(X1, Y1, Z1, &x2, &y2, &z2);
- Zbuf_WtoS(X2, Y2, Z2, &x1, &y1, &z1);
- }
-
- /* S E T S O M E P R E D E F I N I T I O N S */
-
- dxsign = x1 > x2 ? -1 : 1;
- dx = x1 > x2 ? x1 - x2 : x2 - x1;
- dxdx = dx + dx;
- dy = y2 - y1;
- dydy = dy + dy;
- dmax = MAX(dx,dy);
- t = -dmax;
- if (dmax > 0) dz = (z2 - z1) / dmax;
-
- zcur = z1+65536;
- jzcur = (short *) &zcur + Z_OFFSET;
-
- jimg = Zimg + y1*Nx + x1;
- jbuf = Zbuf + y1*Nx + x1;
- jend = Zbuf + y2*Nx + x2;
-
- /* I S L I N E F U L L Y I N S I D E W I N D O W ? */
-
- if (y1 >= Ymin && y2 <= Ymax &&
- x1 >= Xmin && x1 <= Xmax &&
- x2 >= Xmin && x2 <= Xmax) {
-
- /* D R A W P O I N T */
- if ( dmax == 0) {
- if (z1 < z2) zcur = z2+65536;
- if (*jbuf <= *jzcur) { *jbuf = *jzcur; *jimg = icol; }
- return;
- }
-
- /* D R A W L I N E */
-
- if (dx >= dy) {
- while (jbuf != jend) {
- if (*jbuf <= *jzcur) { *jbuf = *jzcur; *jimg = icol; }
- if ((t += dydy) >= 0) { t -= dxdx; jbuf += Nx; jimg += Nx; }
- jbuf += dxsign; jimg += dxsign; zcur += dz;
- }
- }else{
- while (jbuf != jend) {
- if (*jbuf <= *jzcur) { *jbuf = *jzcur; *jimg = icol; }
- if ((t += dxdx) >= 0) { t -= dydy; jbuf += dxsign; jimg += dxsign; }
- jbuf += Nx; jimg += Nx; zcur += dz;
- }
- }
- if (*jbuf <= *jzcur) { *jbuf = *jzcur; *jimg = icol; }
-
- }else{
-
- if (y1 > Ymax || y2 < Ymin) return;
- if (x1 < Xmin && x2 < Xmin) return;
- if (x1 > Xmax && x2 > Xmax) return;
- xcur = dxsign*x1;
- ycur = y1;
- if (x2 >= x1) {
- xlim1 = Xmin; xlim2 = Xmax;
- }else{
- xlim1 = -Xmax; xlim2 = -Xmin;
- }
-
- /* D R A W C L I P P E D L I N E */
-
- if (dx >= dy) {
- while (jbuf != jend) {
- if (ycur > Ymax || xcur > xlim2) return;
- if (ycur >= Ymin && xcur >= xlim1)
- if (*jbuf <= *jzcur) { *jbuf = *jzcur; *jimg = icol; }
- if ((t += dydy) >= 0)
- { t -= dxdx; jbuf += Nx; jimg += Nx; ycur++; }
- jbuf += dxsign; jimg += dxsign; xcur++; zcur += dz;
- }
- }else{
- while (jbuf != jend) {
- if (ycur > Ymax || xcur > xlim2) return;
- if (ycur >= Ymin && xcur >= xlim1)
- if (*jbuf <= *jzcur) { *jbuf = *jzcur; *jimg = icol; }
- if ((t += dxdx) >= 0)
- { t -= dydy; jbuf += dxsign; jimg += dxsign; xcur++; }
- jbuf += Nx; jimg += Nx; ycur++; zcur += dz;
- }
- }
- if (ycur > Ymax || xcur > xlim2) return;
- if (ycur < Ymin || xcur < xlim1) return;
- if (*jbuf <= *jzcur) { *jbuf = *jzcur; *jimg = icol; }
- }
-}
-
-/***********************************************************************
- * *
- * Name: Zbuf_Fill Date: 15.08.95 *
- * Author: E.Chernyaev (IHEP/Protvino) Revised: *
- * *
- * Function: Fill area (Z-buffer) *
- * *
- * Input: ICOL - colour *
- * N - number of edges *
- * X(*),Y(*),Z(*) - coordinates of nodes *
- * *
- ***********************************************************************/
-void Zbuf_Fill(ICOL, N, X, Y, Z)
- int ICOL, N;
- float *X,*Y,*Z;
-{
- int i, k, step, istart, nx, xcur, ycur, zcur, dz;
- int xmin, xmax, ymin, ymax;
- byte icol,*jimg,*jimg_base;
- short dx, dy, *jzcur,*jbuf,*jend,*jbuf_base;
- struct EDGE *jcur;
-
- if (!Zstat) return;
-
- /* P R E P A R A T O R Y S T U F F */
-
- Zbuf_GetEdges (N, X, Y, Z, (float *) NULL, 0);
- if (Nedge == 0 ) return;
-
- Zbuf_MinMax (&xmin, &xmax, &ymin, &ymax);
- if (xmin > Xmax || xmax < Xmin) return;
- if (ymax > Ymax) ymax = Ymax;
-
- Zbuf_SortEdges();
- Zbuf_InitEdges();
-
- /* F I L L P O L Y G O N : L O O P A L O N G S C A N L I N E S */
-
- icol = ICOL & 0xff;
- jzcur = (short *) &zcur + Z_OFFSET;
- istart = 0;
- for (ycur=ymin; ycur<=ymax; ycur++) {
- nx = 0;
- /* P R E P A R E X I N T E R S E C T I O N S */
- for (i=istart; i<Nedge; i++) {
- jcur = jedge[i];
- if (jcur->y > ycur) break;
- if (jcur->yy <= ycur) {
- if (i == istart) istart++;
- }else{
- xscan[nx] = jcur->x; zscan[nx] = jcur->z; nx++;
- dx = jcur->xx;
- dy = jcur->yy - jcur->y;
- if (dx <= dy ) {
- jcur->z += jcur->zz;
- if ((jcur->test += dx) >= 0) {
- jcur->test -= dy;
- jcur->x += jcur->dxsign;
- }
- }else{
- step = dx/dy;
- if ((jcur->test += step*dy) >= 0) {
- jcur->test -= dx;
- }else{
- jcur->test += dy - dx; step++;
- }
- jcur->x += jcur->dxsign * step;
- jcur->z += jcur->zz * step;
- }
- }
- }
- if (ycur < Ymin) continue;
-
- /* S O R T I N T E R S E C T I O N P O I N T S A L O N G X */
- for (i=0; i<nx-1; i++) {
- if (xscan[i+1] >= xscan[i]) continue;
- for (k=i+1; k>0; k--) {
- if (xscan[k] >= xscan[k-1]) break;
- SWAP(xscan[k],xscan[k-1],xcur);
- SWAP(zscan[k],zscan[k-1],zcur);
- }
- }
-
- /* F I L L S P A N S */
- jimg_base = Zimg + ycur*Nx;
- jbuf_base = Zbuf + ycur*Nx;
- for (i=0; i<nx; i+=2) {
- if ((xmin = xscan[i]) > Xmax) break;
- if ((xmax = xscan[i+1]) < Xmin) continue;
- if (xmin == xmax) {
- jimg = jimg_base + xmin;
- jbuf = jbuf_base + xmin;
- zcur = MAX(zscan[i],zscan[i+1]);
- if (*jbuf <= *jzcur) { *jbuf = *jzcur; *jimg = icol; }
- }else{
- zcur = zscan[i];
- dz = (zscan[i+1] - zcur) / (xmax - xmin);
- if (xmin < Xmin) { zcur += dz * (Xmin-xmin); xmin = Xmin; }
- if (xmax > Xmax) xmax = Xmax;
- jimg = jimg_base + xmin;
- jbuf = jbuf_base + xmin;
- jend = jbuf_base + xmax;
- while (jbuf != jend) {
- if (*jbuf <= *jzcur) { *jbuf = *jzcur; *jimg = icol; }
- jbuf++; jimg++; zcur += dz;
- }
- if (*jbuf <= *jzcur) { *jbuf = *jzcur; *jimg = icol; }
- }
- }
- }
-}
-
-/***********************************************************************
- * *
- * Name: Zbuf_Spectr Date: 15.08.95 *
- * Author: E.Chernyaev (IHEP/Protvino) Revised: *
- * *
- * Function: Set colour spectrum for Gouraud shading *
- * *
- * Input: NL - number of levels *
- * FMIN - min lightness *
- * FMAX - max lightness *
- * ICOL - colour index of 1st level *
- * *
- ***********************************************************************/
-void Zbuf_Spectr(NL, FMIN, FMAX, ICOL)
- int NL, ICOL;
- float FMIN, FMAX;
-{
- Nlevel = NL;
- Fmin = FMIN;
- Fmax = FMAX + (FMAX-FMIN)*0.001;
- FstCol = ICOL;
-}
-
-/***********************************************************************
- * *
- * Name: Zbuf_Shade Date: 15.08.95 *
- * Author: E.Chernyaev (IHEP/Protvino) Revised: *
- * *
- * Function: Gouraud shading (Z-buffer) *
- * *
- * Input: N - number of edges *
- * X(*),Y(*),Z(*) - coordinates of nodes *
- * F(*) - function values (lightness) at nodes *
- * *
- ***********************************************************************/
-void Zbuf_Shade(N, X, Y, Z, F)
- int N;
- float *X,*Y,*Z,*F;
-{
- int i, k, step, istart, nx, ccur, xcur, ycur, zcur, dc, dz;
- int xmin, xmax, ymin, ymax;
- byte *jccur,*jimg,*jimg_base;
- short dx, dy, *jzcur,*jbuf, *jend,*jbuf_base;
- struct EDGE *jcur;
-
- if (!Zstat) return;
-
- /* P R E P A R A T O R Y S T U F F */
-
- Zbuf_GetEdges (N, X, Y, Z, F, 1);
- if (Nedge == 0 ) return;
-
- Zbuf_MinMax (&xmin, &xmax, &ymin, &ymax);
- if (xmin > Xmax || xmax < Xmin) return;
- if (ymax > Ymax) ymax = Ymax;
-
- Zbuf_SortEdges();
- Zbuf_InitEdges();
-
- /* F I L L P O L Y G O N : L O O P A L O N G S C A N L I N E S */
-
- jccur = (byte *) &ccur + C_OFFSET;
- jzcur = (short *) &zcur + Z_OFFSET;
- istart = 0;
- for (ycur=ymin; ycur<=ymax; ycur++) {
- nx = 0;
- /* P R E P A R E X I N T E R S E C T I O N S */
- for (i=istart; i<Nedge; i++) {
- jcur = jedge[i];
- if (jcur->y > ycur) break;
- if (jcur->yy <= ycur) {
- if (i == istart) istart++;
- }else{
- xscan[nx] = jcur->x; zscan[nx] = jcur->z; cscan[nx] = jcur->c; nx++;
- dx = jcur->xx;
- dy = jcur->yy - jcur->y;
- if (dx <= dy ) {
- jcur->z += jcur->zz;
- jcur->c += jcur->cc;
- if ((jcur->test += dx) >= 0) {
- jcur->test -= dy;
- jcur->x += jcur->dxsign;
- }
- }else{
- step = dx/dy;
- if ((jcur->test += step*dy) >= 0) {
- jcur->test -= dx;
- }else{
- jcur->test += dy - dx; step++;
- }
- jcur->x += jcur->dxsign * step;
- jcur->z += jcur->zz * step;
- jcur->c += jcur->cc * step;
- }
- }
- }
- if (ycur < Ymin) continue;
-
- /* S O R T I N T E R S E C T I O N P O I N T S A L O N G X */
- for (i=0; i<nx-1; i++) {
- if (xscan[i+1] >= xscan[i]) continue;
- for (k=i+1; k>0; k--) {
- if (xscan[k] >= xscan[k-1]) break;
- SWAP(xscan[k],xscan[k-1],xcur);
- SWAP(zscan[k],zscan[k-1],zcur);
- SWAP(cscan[k],cscan[k-1],ccur);
- }
- }
-
- /* F I L L S P A N S */
- jimg_base = Zimg + ycur*Nx;
- jbuf_base = Zbuf + ycur*Nx;
- for (i=0; i<nx; i+=2) {
- if ((xmin = xscan[i]) > Xmax) break;
- if ((xmax = xscan[i+1]) < Xmin) continue;
- if (xmin == xmax) {
- jimg = jimg_base + xmin;
- jbuf = jbuf_base + xmin;
- if (zscan[i] > zscan[i+1]) {
- zcur = zscan[i]; ccur = cscan[i];
- }else{
- zcur = zscan[i+1]; ccur = cscan[i+1];
- }
- if (*jbuf <= *jzcur) { *jbuf = *jzcur; *jimg = *jccur; }
- }else{
- zcur = zscan[i];
- dz = (zscan[i+1] - zcur) / (xmax - xmin);
- ccur = cscan[i];
- dc = (cscan[i+1] - ccur) / (xmax - xmin);
- if (xmin < Xmin) {
- zcur += dz * (Xmin-xmin); ccur += dc * (Xmin-xmin); xmin = Xmin;
- }
- if (xmax > Xmax) xmax = Xmax;
- jimg = jimg_base + xmin;
- jbuf = jbuf_base + xmin;
- jend = jbuf_base + xmax;
- while (jbuf != jend) {
- if (*jbuf <= *jzcur) { *jbuf = *jzcur; *jimg = *jccur; }
- jbuf++; jimg++; zcur += dz; ccur += dc;
- }
- if (*jbuf <= *jzcur) { *jbuf = *jzcur; *jimg = *jccur; }
- }
- }
- }
-}
-
-/***********************************************************************
- * *
- * Name: Zbuf_XFlush Date: 15.08.95 *
- * Author: E.Chernyaev (IHEP/Protvino) Revised: *
- * *
- * Function: Flush Z-image to X Windows screen *
- * *
- * Input: ITRAN - index of transparent colour, if necessary, or -1 *
- * X0, Y0 - coordinates of upper-left corner of the image *
- * *
- ***********************************************************************/
-void Zbuf_XFlush(ITRAN, X0, Y0)
- int ITRAN, X0, Y0;
-{
- IXmin = MAX(IXmin,Xmin); IYmin = MAX(IYmin,Ymin);
- IXmax = MIN(IXmax,Xmax); IYmax = MIN(IYmax,Ymax);
- ixput_image(0,ITRAN,X0,Y0,Nx,Ny,IXmin,IYmin,IXmax,IYmax,Zimg);
-}
-
-/***********************************************************************
- * *
- * Name: Zbuf_Print Date: 15.08.95 *
- * Author: E.Chernyaev (IHEP/Protvino) Revised: *
- * *
- * Function: Print contents of z-image to the screen *
- * *
- ***********************************************************************/
-void Zbuf_Print()
-{
- int ix, iy, z;
- short *jbuf;
- byte *jimg, icol;
-
- printf("Z-Screen: %d x %d\n",Nx,Ny);
-
- if (!Zstat) {
- fprintf(stderr,"Zbuf_Print: z-buffer is not initialized\n");
- return;
- }
-
- for (iy=0; iy<Ny; iy++) {
- jbuf = Zbuf + Nx*(Ny-iy-1);
- jimg = Zimg + Nx*(Ny-iy-1);
- for (ix=0; ix<Nx; ix++) {
- icol = *jimg++;
- z = *jbuf++;
-/*
- if (icol == 0) { printf(" ."); } else { printf("%2d",icol); }
-*/
- if (icol == 0) { printf(" ."); } else { printf("%2d",z); }
- }
- printf("\n");
- }
-}
-
-/***********************************************************************
- * *
- * O U T P U T T O P O S T S C R I P T *
- * *
- * Output LZW compressed Z-buffer image to PostScript. *
- * The code is based on PS_LZWencode.c routine from xwpick-2.21 *
- * *
- ***********************************************************************/
-
-static char s[80];
-
-#if !defined(CERNLIB_VAX)
-#define put_string zippfst(&s[0])
-#else
-#define put_string ippfst_vms(&s[0])
-#endif
-
-/***********************************************************************
- * *
- * Name: ASCII85encode Date: 05.11.93 *
- * Author: E.Chernyaev (IHEP/Protvino) Revised: 20.04.95 *
- * *
- * Function: ASCII85 encode and output byte buffer *
- * *
- * Input: k - number of bytes *
- * Buf - byte buffer *
- * *
- ***********************************************************************/
-static void ASCII85encode(k, Buf)
- int k;
- byte Buf[];
-{
- unsigned long Value;
- int i, j, n;
- char *js;
-
- if (k == 0) return;
- js = s;
- for (j=0; j<k; j+=4) {
- Value = Buf[j]*256*256*256;
- if (j+1 < k) Value += Buf[j+1]*256*256;
- if (j+2 < k) Value += Buf[j+2]*256;
- if (j+3 < k) Value += Buf[j+3];
- if (j == 0) {
- if ( (char) (Value / (85*85*85*85) + 33) == '%') *js++ = ' ';
- }
- for (n=4; n>=0; n--) {
- *(js+n) = Value % 85 + 33;
- Value /= 85;
- }
- if (k-j < 4) {
- js += k-j+1;
- }else{
- js += 5;
- }
- }
- *js = '\0'; put_string;
-}
-
-#define BITS 12 /* largest code size */
-#define HSIZE 5003 /* hash table size */
-#define SHIFT 4 /* shift for hashing */
-#define CLEARCODE 256 /* Clear Code */
-#define EOD 257 /* End Of Data code */
-#define PIXS 170000 /* largest # of pixels */
-
-/***********************************************************************
- * *
- * Name: PutCode Date: 05.11.93 *
- * Author: E.Chernyaev (IHEP/Protvino) Revised: *
- * *
- * Function: Put out code (LZW encoding) *
- * *
- * Input: Code - code *
- * CodeSize - codesize *
- * *
- ***********************************************************************/
-static void PutCode(Code, CodeSize)
- int Code, CodeSize;
-{
- static int k, PartA, PartB, SizeA, SizeB;
- static int mask[] = { 0x0000, 0x0001, 0x0003, 0x0007, 0x000F,
- 0x001F, 0x003F, 0x007F, 0x00FF,
- 0x01FF, 0x03FF, 0x07FF, 0x0FFF };
- static byte Accum[56];
- if (Code == -1) {
- k = 0;
- PartA = 0;
- SizeA = 0;
- return;
- }
-
- PartB = Code;
- SizeB = CodeSize;
-
- while (SizeB >= 8) {
- SizeB = SizeA + SizeB - 8;
- Accum[k++] = PartA | (PartB >> SizeB);
- if (k == 56) {
- ASCII85encode(k,Accum);
- k = 0;
- }
- PartB &= mask[SizeB];
- SizeA = 0;
- PartA = 0;
- }
-
- SizeA = SizeB;
- PartA = PartB << (8-SizeB);
- if (Code == EOD) {
- if (SizeA != 0) Accum[k++] = PartA;
- ASCII85encode(k, Accum);
- }
-}
-
-/***********************************************************************
- * *
- * Name: EncodeData Date: 27.11.95 *
- * Author: E.Chernyaev (IHEP/Protvino) Revised: *
- * *
- * Function: Lelpel-Ziv Welch encoding of an image *
- * *
- * Input: Ncol - number of colours *
- * R[] - red components *
- * G[] - green components *
- * B[] - blue components *
- * *
- ***********************************************************************/
-static void EncodeData(Ncol, R, G, B)
- int Ncol;
- float *R,*G,*B;
-{
- int i, k, x, y, disp, Code, K, r, g, b;
- long CodeK, Npix;
- char **q,*js;
- int FreeCode, CurCodeSize, CurMaxCode;
- byte *ScLine;
-
- long HashTab [HSIZE]; /* hash table */
- int CodeTab [HSIZE]; /* code table */
-
- /* O U T P U T P A L E T T E */
-
- js = s;
- for (k=0; k<Ncol; k++) {
- r = R[k] * 256.; r = MAX(r,0); r = MIN(r,255);
- g = G[k] * 256.; g = MAX(g,0); g = MIN(g,255);
- b = B[k] * 256.; b = MAX(b,0); b = MIN(b,255);
- sprintf(js,"%02x%02x%02x",r,g,b);
- js += 6;
- if (k % 10 == 9) {
- put_string; js = s;
- }else{
- sprintf(js++," ");
- }
- }
- for (k=Ncol; k<256; k++) {
- sprintf(js,"000000");
- js += 6;
- if (k % 10 == 9) {
- put_string; js = s;
- }else{
- sprintf(js++," ");
- }
- }
- put_string;
-
- /* L W Z C O M P R E S S I O N */
-
- PutCode(-1, 0);
- FreeCode = CLEARCODE + 2;
- CurCodeSize = 9;
- CurMaxCode = 511;
- memset((char *) HashTab, -1, sizeof(HashTab));
- PutCode(CLEARCODE, CurCodeSize); /* 1st - clear code */
- Npix = 0;
- for (y=0; y<Ny; y++) {
- ScLine = Zimg + (Ny-1-y)*Nx;
- x = 0;
- if (y == 0) Code = ScLine[x++];
- while(x < Nx) {
- K = ScLine[x++]; /* next symbol */
- Npix++;
- CodeK = ((long) K << BITS) + Code; /* set full code */
- k = (K << SHIFT) ^ Code; /* xor hashing */
-
- if (HashTab[k] == CodeK) { /* full code found */
- Code = CodeTab[k];
- continue;
- }
- else if (HashTab[k] < 0 ) /* empty slot */
- goto NOMATCH;
-
- disp = HSIZE - k; /* secondary hash */
- if (k == 0) disp = 1;
-
-PROBE:
- if ((k -= disp) < 0)
- k += HSIZE;
-
- if (HashTab[k] == CodeK) { /* full code found */
- Code = CodeTab[k];
- continue;
- }
-
- if (HashTab[k] > 0) /* try again */
- goto PROBE;
-
-NOMATCH: /* full code not found */
- PutCode(Code, CurCodeSize);
- Code = K;
- if (FreeCode == CurMaxCode) {
- CurCodeSize++;
- CurMaxCode = CurMaxCode*2 + 1;
- }
-
- if (CurCodeSize <= BITS && Npix <= PIXS) {
- CodeTab[k] = FreeCode++; /* code -> hashtable */
- HashTab[k] = CodeK;
- }else{
- if (CurCodeSize > BITS) CurCodeSize = BITS;
- PutCode(CLEARCODE, CurCodeSize);
- memset((char *) HashTab, -1, sizeof(HashTab));
- FreeCode = CLEARCODE + 2;
- CurCodeSize = 9;
- CurMaxCode = 511;
- Npix = 0;
- }
- }
- }
- /* O U T P U T T H E R E S T */
-
- PutCode(Code, CurCodeSize);
- if (FreeCode == CurMaxCode && CurCodeSize != BITS)
- CurCodeSize++;
- PutCode(EOD, CurCodeSize);
- sprintf(s,"~>"); put_string;
-}
-
-/***********************************************************************
- * *
- * Name: Zbuf_PostScript Date: 26.11.95 *
- * Author: E.Chernyaev (IHEP/Protvino) Revised: *
- * *
- * Function: Output LZW compressed Z-buffer image to PostScript *
- * *
- * Input: IFGRAY - gray flag: set it when grayscale image is needed *
- * IFROTATE - rotation flag: set it for landscape mode *
- * XMIN,YMIN,XMAX,YMAX - image dimensions on page (in PS points)*
- * NCOL - number of colours *
- * R[] - red components *
- * G[] - green components *
- * B[] - blue components *
- * *
- ***********************************************************************/
-void Zbuf_PostScript(IFGRAY,IFROTATE,XMIN,YMIN,XMAX,YMAX,NCOL,R,G,B)
- int IFGRAY,IFROTATE,XMIN,YMIN,XMAX,YMAX,NCOL;
- float *R,*G,*B;
-{
- char **q;
-
- static char *HeaderEPS[] = {
- "%***********************************************************************",
- "%* *",
- "%* Function: Display a Lempel-Ziv Welch (LZW) encoded color image. *",
- "%* This is an Encapsulated PostScript file suitable for any *",
- "% kind of PostScript printer: Level I/II, color/grayscale...*",
- "%* *",
- "%* Author: Evgeni CHERNYAEV (chernaev at vxcern.cern.ch) *",
- "%* *",
- "%***********************************************************************",
- "gsave",
- "%***********************************************************************",
- "%* Image Description *",
- "%***********************************************************************",
- NULL,
- };
-
- static char *CommonPart[] = {
- "/IfColor systemdict /colorimage known {true} {false} ifelse def",
- "GRAYneeded {/IfColor false def} if",
- "/IfLevel2 systemdict /filter known systemdict /setcolorspace known and",
- " {true} {false} ifelse def",
- "%***********************************************************************",
- "% Procedures *",
- "%***********************************************************************",
- "userdict /Table known not userdict /StrArray known not or",
- "{/Table 4096 array def /StrArray 10 array def} if",
- "/InLine 71 string def",
- "/BinCodes 112 string def",
- "/CurBit 0 def /FreeCode 258 def /CurCodeSize 9 def /CurMask 511 def",
- "/incr IfColor {3} {1} ifelse def",
- "IfLevel2 not {/setcolorspace null def /filter null def} if",
- "%***********************************************************************",
- "/ReadLine { % Read Next Data Line (ASCII85 decode) *",
- "%***********************************************************************",
- " BinCodes 0 BinCodes 56 56 getinterval putinterval",
- " currentfile InLine readline pop pop",
- " InLine 0 get 255 and 32 eq {/kk 1 def} {/kk 0 def} ifelse",
- " 1 1 14 {",
- " /i exch 1 sub def",
- " /k i 5 mul kk add def",
- " /c1 InLine k get 33 sub 255 and def",
- " /rest c1 1868977 mul",
- " InLine k 1 add get 33 sub 255 and 614125 mul add",
- " InLine k 2 add get 33 sub 255 and 7225 mul add",
- " InLine k 3 add get 33 sub 255 and 85 mul add",
- " InLine k 4 add get 33 sub 255 and add def",
- " /k i 4 mul 56 add def",
- " BinCodes k c1 3 mul rest 16777216 idiv add 255 and put",
- " /rest rest 16777216 mod def",
- " BinCodes k 1 add rest 65536 idiv put",
- " BinCodes k 2 add rest 256 idiv 255 and put",
- " BinCodes k 3 add rest 255 and put",
- " } for",
- "} bind def",
- "%***********************************************************************",
- "/ReadCode { % Read next code *",
- "%***********************************************************************",
- " /CurByte CurBit 8 idiv def",
- " /CurCode",
- " BinCodes CurByte get 8 bitshift",
- " BinCodes CurByte 1 add get add 8 bitshift",
- " BinCodes CurByte 2 add get add",
- " CurCodeSize CurBit 7 and add 24 sub bitshift CurMask and def",
- " /CurBit CurBit CurCodeSize add dup 448 ge {ReadLine 448 sub} if def",
- "} bind def",
- "%***********************************************************************",
- "/DecodeCode { % Decode CurCode *",
- "%***********************************************************************",
- " ReadCode CurCode 256 eq {",
- " /FreeCode 258 def /CurCodeSize 9 def /CurMask 511 def",
- " /StrInd -1 def /Lrest 0 def ReadCode",
- " }{",
- " L Lrest gt {",
- " /StrInd StrInd 1 add def /Lrest 65535 def",
- " StrArray StrInd get null eq {StrArray StrInd 65535 string put} if",
- " /CurStr StrArray StrInd get def",
- " } if",
- " Table FreeCode CurStr 65535 Lrest sub L getinterval",
- " dup 0 Table OldCode get putinterval",
- " dup L incr sub Table",
- " CurCode FreeCode lt {CurCode} {OldCode} ifelse get",
- " 0 incr getinterval putinterval put",
- " /Lrest Lrest L sub def /FreeCode FreeCode 1 add def",
- " FreeCode CurMask ge CurCodeSize 12 lt and {",
- " /CurCodeSize CurCodeSize 1 add def",
- " /CurMask CurMask 1 bitshift 1 add def",
- " } if",
- " } ifelse",
- " /OldCode CurCode def",
- " Table CurCode get dup length incr add /L exch def",
- "} bind def",
- "%***********************************************************************",
- "/DisplayImage { % Display a LZW-encoded color image *",
- "%***********************************************************************",
- " /DelX Xmax Xmin sub def",
- " /DelY Ymax Ymin sub def",
- " Xmin Ymin translate",
- " DelX DelY scale",
- " /Palette currentfile 768 string readhexstring pop def",
- " currentfile InLine readline pop pop",
- " IfColor not {",
- " 0 1 255 {",
- " Palette exch dup /i exch 3 mul def",
- " Palette i 0 add get 0.299 mul",
- " Palette i 1 add get 0.587 mul add",
- " Palette i 2 add get 0.114 mul add cvi put",
- " } for",
- " /Palette Palette 0 256 getinterval def",
- " } if",
- " /Matr IfRotate",
- " {[0 colomns rows 0 0 0]} {[colomns 0 0 rows neg 0 rows]} ifelse def",
- " IfLevel2 {",
- " [/Indexed IfColor {/DeviceRGB} {/DeviceGray} ifelse 255 Palette]",
- " setcolorspace",
- " /infile currentfile /ASCII85Decode filter /LZWDecode filter def",
- " 8 dict",
- " dup /ImageType 1 put",
- " dup /Width colomns put",
- " dup /Height rows put",
- " dup /BitsPerComponent 8 put",
- " dup /ImageMatrix Matr put",
- " dup /Interpolate false put",
- " dup /Decode [0 255] put",
- " dup /DataSource infile put image",
- " }{",
- " 0 1 255 {",
- " Table exch dup incr mul Palette exch incr getinterval put",
- " } for",
- " ReadLine ReadLine",
- " colomns rows 8 Matr {DecodeCode}",
- " IfColor {false 3 colorimage} {image} ifelse",
- " } ifelse",
- "} bind def",
- "%***********************************************************************",
- "%* Image decoding *",
- "%***********************************************************************",
- "DisplayImage",
- NULL,
- };
-
- /* C H E C K P A R A M E T E R S */
-
- if (!Zstat) return;
- if (NCOL <= 0 || NCOL > 256) {
- fprintf(stderr,"Zbuf_PostScript: wrong number of colors: %d\n",NCOL);
- return;
- }
-
- /* O U T P U T H E A D E R */
-
- for (q=HeaderEPS;*q; q++) {
- sprintf(s,"%s",*q); put_string;
- }
-
- /* I M A G E D E S C R I P T I O N */
-
- sprintf(s,"/colomns %d def /rows %d def",Nx,Ny); put_string;
-
- if (IFGRAY) {
- sprintf(s,"/GRAYneeded true def"); put_string;
- }else{
- sprintf(s,"/GRAYneeded false def"); put_string;
- }
- if (IFROTATE) {
- sprintf(s,"/IfRotate true def"); put_string;
- }else{
- sprintf(s,"/IfRotate false def"); put_string;
- }
- sprintf(s,"/Xmin %d def /Ymin %d def /Xmax %d def /Ymax %d def",
- XMIN,YMIN,XMAX,YMAX); put_string;
-
- /* O U T P U T P O S T S C R I P T C O D E */
-
- for (q=CommonPart; *q; q++) {
- sprintf(s,"%s",*q); put_string;
- }
-
- /* O U T P U T E N C O D E D D A T A */
-
- EncodeData(NCOL, R, G, B);
-
- sprintf(s,"grestore"); put_string;
-}
-
-/***********************************************************************
- * *
- * M A I N R O U T I N E S - F O R T R A N I N T E R F A C E *
- * *
- ***********************************************************************
- * *
- * Name: FORTRAN interface routines Date: 15.11.95 *
- * Author: E.Chernyaev (IHEP/Protvino) Revised: *
- * *
- * Contents: IREP=IHZINI(NX,NY,NZ) *
- * CALL IHZCLE(ICOL) *
- * CALL IHZCLI(XMIN,YMIN,XMAX,YMAX) *
- * CALL IHZWRD(XMIN,YMIN,ZMIN,XMAX,YMAX,ZMAX) *
- * CALL IHZPNT(ICOL,X,Y,Z) *
- * CALL IHZLIN(ICOL,X1,Y1,Z1,X2,Y2,Z2) *
- * CALL IHZFIL(ICOL,N,X,Y,Z) *
- * CALL IHZSPE(NL,FMIN,FMAX,ICOL) *
- * CALL IHZSHA(N,X,Y,Z,F) *
- * CALL IHZTOX(X0,Y0) *
- * CALL IHZPRN() *
- * CALL IHZPS(IFGRAY,IFROTATE,XMIN,YMIN,XMAX,YMAX,NCOL,R,G,B)*
- * *
- ***********************************************************************/
-int type_of_call ihzini(NX, NY, NZ)
- int *NX,*NY,*NZ;
-{ return Zbuf_Init(*NX,*NY,*NZ); }
-
-void type_of_call ihzcle(ICOL)
- int *ICOL;
-{ Zbuf_Clear(*ICOL); }
-
-void type_of_call ihzcli(XMIN, YMIN, XMAX, YMAX)
- int *XMIN,*YMIN,*XMAX,*YMAX;
-{ Zbuf_Clip(*XMIN,*YMIN,*XMAX,*YMAX);}
-
-void type_of_call ihzwrd(XMIN, YMIN, ZMIN, XMAX, YMAX, ZMAX)
- float *XMIN,*YMIN,*ZMIN,*XMAX,*YMAX,*ZMAX;
-{ Zbuf_World(*XMIN,*YMIN,*ZMIN,*XMAX,*YMAX,*ZMAX); }
-
-void type_of_call ihzpnt(ICOL, X, Y, Z)
- int *ICOL;
- float *X,*Y,*Z;
-{ Zbuf_Point(*ICOL,*X,*Y,*Z); }
-
-void type_of_call ihzlin(ICOL, X1, Y1, Z1, X2, Y2, Z2)
- int *ICOL;
- float *X1,*Y1,*Z1,*X2,*Y2,*Z2;
-{ Zbuf_Line(*ICOL,*X1,*Y1,*Z1,*X2,*Y2,*Z2); }
-
-void type_of_call ihzfil(ICOL, N, X, Y, Z)
- int *ICOL,*N;
- float *X,*Y,*Z;
-{ Zbuf_Fill(*ICOL,*N, X, Y, Z); }
-
-void type_of_call ihzspe(NL, FMIN, FMAX, ICOL)
- int *NL,*ICOL;
- float *FMIN,*FMAX;
-{ Zbuf_Spectr(*NL,*FMIN,*FMAX,*ICOL); }
-
-void type_of_call ihzsha(N, X, Y, Z, F)
- int *N;
- float *X,*Y,*Z,*F;
-{ Zbuf_Shade(*N, X, Y, Z, F); }
-
-void type_of_call ihztox(IBACK, X0, Y0)
- int *IBACK,*X0,*Y0;
-{ Zbuf_XFlush(*IBACK,*X0,*Y0); }
-
-void ihzprn()
-{ Zbuf_Print(); }
-
-void type_of_call ihzps(IFGRAY, IFROTATE, XMIN, YMIN, XMAX, YMAX, NCOL, R, G, B)
- int *IFGRAY,*IFROTATE,*XMIN,*YMIN,*XMAX,*YMAX,*NCOL;
- float *R,*G,*B;
-{ Zbuf_PostScript(*IFGRAY,*IFROTATE,*XMIN,*YMIN,*XMAX,*YMAX,*NCOL, R, G, B); }
-
-/* E N D O F Z - B U F F E R*/
-#endif
diff --git a/src/graflib/higz/idi3000/Imakefile b/src/graflib/higz/idi3000/Imakefile
deleted file mode 100644
index cde60f5..0000000
--- a/src/graflib/higz/idi3000/Imakefile
+++ /dev/null
@@ -1,8 +0,0 @@
-SRCS_F= iacwk.F iclks.F iclrwk.F iclwk.F idawk.F ifa.F \ @@\
- igmeta.F igrng.F igsa.F igsg.F iopks.F iopwk.F ipl.F ipm.F \ @@\
- irqlc.F irqst.F ischh.F ischup.F isclip.F iscr.F iselnt.F \ @@\
- isfaci.F isfais.F isfasi.F isln.F islwsc.F ismk.F ismksc.F \ @@\
- isplci.F ispmci.F istxal.F istxci.F istxfp.F isvp.F iswkvp.F \ @@\
- iswkwn.F iswn.F itx.F iuwk.F rgtohs.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/graflib/higz/idi3000/iacwk.F b/src/graflib/higz/idi3000/iacwk.F
deleted file mode 100644
index 9cb5518..0000000
--- a/src/graflib/higz/idi3000/iacwk.F
+++ /dev/null
@@ -1,66 +0,0 @@
-*
-* $Id: iacwk.F,v 1.1.1.1 1996/02/14 13:10:27 mclareni Exp $
-*
-* $Log: iacwk.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:27 mclareni
-* Higz
-*
-*
-#if defined(CERNLIB_DI3000)
-#include "higz/pilot.h"
-*CMZ : 1.06/06 09/03/89 15.02.57 by O.Couet
-*-- Author :
- SUBROUTINE IACWK(WKID)
-*.===========>
-*.
-*. Purpose:
-*. --------
-*. Select a display device
-*.
-*. DI-3000 access:
-*. ---------------
-*. CALL JDEVON (DEVICE)
-*.
-*. Parameters:
-*. -----------
-*. DEVICE [ INTEGER; Input ]
-*.
-*. - Display device to be selected.
-*.
-*..==========> (O.Couet, H.Johnstad, L.Roberts)
-#include "higz/himeta.inc"
-#include "higz/hiatt.inc"
- INTEGER WKID
- INTEGER*4 MAXDEV
- PARAMETER (MAXDEV = 9)
- INTEGER*4 DEVICES(0:MAXDEV)
- EQUIVALENCE (ILOPWK,DEVICES)
-#include "higz/di3seg.inc"
-*.______________________________________
-*
- IF(WKID.LT.0)THEN
- CALL IGERR('Workstation identifier less than 0','IACWK')
- RETURN
- ENDIF
-*
-* Select a display device
-*
- IF (DEVICES(WKID).EQ.1) THEN
- IF (SEGOPN) THEN
- CALL JCLOSE
- SEGOPN =.FALSE.
- ENDIF
- CALL JDEVON (WKID)
- DEVICES(WKID) = 2
- INOPWK=INOPWK+1
- IF (WKID.EQ.0) THEN
- METACT = .TRUE.
- ELSE
- TEKACT = .TRUE.
- ENDIF
- ELSE IF (DEVICES(WKID).EQ.0) THEN
- CALL IGERR('Workstation not initialized','IACWK')
- ENDIF
-*
- END
-#endif
diff --git a/src/graflib/higz/idi3000/iclks.F b/src/graflib/higz/idi3000/iclks.F
deleted file mode 100644
index 6e7e9eb..0000000
--- a/src/graflib/higz/idi3000/iclks.F
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: iclks.F,v 1.1.1.1 1996/02/14 13:10:27 mclareni Exp $
-*
-* $Log: iclks.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:27 mclareni
-* Higz
-*
-*
-#if defined(CERNLIB_DI3000)
-#include "higz/pilot.h"
-*CMZ : 1.06/06 09/03/89 15.02.58 by O.Couet
-*-- Author :
- SUBROUTINE ICLKS
-*.===========>
-*.
-*. Purpose:
-*. --------
-*. Terminate DI-3000.
-*. User does not need to call this routine, but should call IGEND directly.
-*.
-*..==========> (O.Couet, H.Johnstad, L.Roberts)
-#include "higz/di3dev.inc"
-*.______________________________________
-*
- IF (ENTRY_FLAG) CALL JEND
- ENTRY_FLAG = .FALSE.
-*
- END
-#endif
diff --git a/src/graflib/higz/idi3000/iclrwk.F b/src/graflib/higz/idi3000/iclrwk.F
deleted file mode 100644
index 291708c..0000000
--- a/src/graflib/higz/idi3000/iclrwk.F
+++ /dev/null
@@ -1,50 +0,0 @@
-*
-* $Id: iclrwk.F,v 1.1.1.1 1996/02/14 13:10:28 mclareni Exp $
-*
-* $Log: iclrwk.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:28 mclareni
-* Higz
-*
-*
-#if defined(CERNLIB_DI3000)
-#include "higz/pilot.h"
-*CMZ : 1.12/11 12/04/91 16.31.42 by O.Couet
-*-- Author :
- SUBROUTINE ICLRWK(WKID,ICOFL)
-*.===========>
-*.
-*. Purpose:
-*. --------
-*. Force an explicit new frame action on all initalized
-*. display devices
-*.
-*. Parameters:
-*. -----------
-*. No parameters
-*. JFRAME may not be called while a segment is OPEN.
-*.
-*..==========> (O.Couet, H.Johnstad, L.Roberts)
-#include "higz/hiflag.inc"
- INTEGER WKID
-#include "higz/di3seg.inc"
-*.______________________________________
-*
- IF(IGIWTY(WKID).LT.0)GOTO 20
- IF(GFLAG)THEN
- CALL IGSG(0)
- IF(WKID.GE.0)THEN
- IF (SEGOPN) THEN
- CALL JUPDAT
- CALL JCLOSE
- SEGOPN =.FALSE.
- ENDIF
- CALL JFRAME
- ENDIF
- ENDIF
- 20 CONTINUE
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_PSCRIPT)||defined(CERNLIB_MAIL)
- IF(GLFLAG)CALL IZCLRD
-#endif
-*
- END
-#endif
diff --git a/src/graflib/higz/idi3000/iclwk.F b/src/graflib/higz/idi3000/iclwk.F
deleted file mode 100644
index 40ea690..0000000
--- a/src/graflib/higz/idi3000/iclwk.F
+++ /dev/null
@@ -1,76 +0,0 @@
-*
-* $Id: iclwk.F,v 1.1.1.1 1996/02/14 13:10:28 mclareni Exp $
-*
-* $Log: iclwk.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:28 mclareni
-* Higz
-*
-*
-#if defined(CERNLIB_DI3000)
-#include "higz/pilot.h"
-*CMZ : 1.16/08 11/12/92 10.06.37 by O.Couet
-*-- Author :
- SUBROUTINE ICLWK(WKID)
-*.===========>
-*.
-*. Purpose:
-*. --------
-*. Terminate a display device
-*.
-*. DI-3000 access:
-*. ---------------
-*. CALL JDEND (DEVICE)
-*.
-*. Parameters:
-*. -----------
-*. DEVICE [ INTEGER; Input ]
-*.
-*. - Display device to be terminated.
-*.
-*..==========> (O.Couet, H.Johnstad, L.Roberts)
-#include "higz/himeta.inc"
-#include "higz/hiatt.inc"
-#include "higz/hiflag.inc"
-#if defined(CERNLIB_PSCRIPT)
-#include "higz/hipost.inc"
-#endif
- INTEGER WKID
- INTEGER*4 MAXDEV
- PARAMETER (MAXDEV = 9)
- INTEGER*4 DEVICES(0:MAXDEV)
- EQUIVALENCE (ILOPWK,DEVICES)
-#include "higz/di3seg.inc"
-*.______________________________________
-*
-#if defined(CERNLIB_PSCRIPT)
- IF(IGIWTY(WKID).LT.0)THEN
- CALL IPEND
- GOTO 1
- ENDIF
-#endif
-*
- CALL IGSG (0)
- 1 IF (SEGOPN) THEN
- CALL JUPDAT
- CALL JCLOSE
- SEGOPN = .FALSE.
- ENDIF
- IF (DEVICES(WKID).NE.0) THEN
- IF (DEVICES(WKID).EQ.2) THEN
- CALL JFRAME
- CALL JDEVOF(WKID)
- INOPWK=INOPWK-1
- ENDIF
- CALL JDEND(WKID)
- DEVICES(WKID) = 0
- IF (WKID.EQ.0) THEN
- METACT = .FALSE.
- ELSE
- TEKACT = .FALSE.
- DO 10 I = 1 , MAXDEV
- 10 TEKACT = TEKACT .OR. (DEVICES(I).NE.0)
- ENDIF
- ENDIF
-*
- END
-#endif
diff --git a/src/graflib/higz/idi3000/idawk.F b/src/graflib/higz/idi3000/idawk.F
deleted file mode 100644
index 1970589..0000000
--- a/src/graflib/higz/idi3000/idawk.F
+++ /dev/null
@@ -1,71 +0,0 @@
-*
-* $Id: idawk.F,v 1.1.1.1 1996/02/14 13:10:28 mclareni Exp $
-*
-* $Log: idawk.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:28 mclareni
-* Higz
-*
-*
-#if defined(CERNLIB_DI3000)
-#include "higz/pilot.h"
-*CMZ : 1.06/06 09/03/89 15.02.58 by O.Couet
-*-- Author :
- SUBROUTINE IDAWK(WKID)
-*.===========>
-*.
-*. Purpose:
-*. --------
-*. Deselect a display device.
-*.
-*. DI-3000 access:
-*. ---------------
-*. CALL JDEVOF (DEVICE)
-*.
-*. Parameters:
-*. -----------
-*. DEVICE [ INTEGER; Input ]
-*.
-*. - Display device to be deselected.
-*.
-*..==========> (O.Couet, H.Johnstad, L.Roberts)
-#include "higz/himeta.inc"
-#include "higz/hiflag.inc"
-#include "higz/hiatt.inc"
- INTEGER WKID
- INTEGER*4 MAXDEV
- PARAMETER (MAXDEV = 9)
- INTEGER*4 DEVICES(0:MAXDEV)
- EQUIVALENCE (ILOPWK,DEVICES)
-#include "higz/di3seg.inc"
-*.______________________________________
-*
- IF(IGIWTY(WKID).LT.0)THEN
- PFLAG=.FALSE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- RETURN
- ENDIF
-C
-C ***** Deselect DEVICE, disabling output to
-C ***** and input from DEVICE
-C
- IF (SEGOPN) THEN
- CALL JUPDAT
- CALL JCLOSE
- SEGOPN = .FALSE.
- ENDIF
- IF (DEVICES(WKID).EQ.2) THEN
- CALL JFRAME
- CALL JDEVOF(WKID)
- DEVICES(WKID) = 1
- INOPWK=INOPWK-1
- IF (WKID.EQ.0) THEN
- METACT = .FALSE.
- ELSE
- TEKACT = .FALSE.
- DO 10 I = 1 , MAXDEV
- 10 TEKACT = TEKACT .OR. (DEVICES(I).NE.0)
- ENDIF
- ENDIF
-*
- END
-#endif
diff --git a/src/graflib/higz/idi3000/ifa.F b/src/graflib/higz/idi3000/ifa.F
deleted file mode 100644
index 4902503..0000000
--- a/src/graflib/higz/idi3000/ifa.F
+++ /dev/null
@@ -1,65 +0,0 @@
-*
-* $Id: ifa.F,v 1.1.1.1 1996/02/14 13:10:28 mclareni Exp $
-*
-* $Log: ifa.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:28 mclareni
-* Higz
-*
-*
-#if defined(CERNLIB_DI3000)
-#include "higz/pilot.h"
-*CMZ : 1.12/11 12/04/91 16.33.18 by O.Couet
-*-- Author :
- SUBROUTINE IFA(N,X,Y)
-*.===========>
-*.
-*. Purpose:
-*. --------
-*. Output a polygon.
-*.
-*. ***** Define closed area polygon of N points; move to the first point,
-*. ***** contiguous draws through the following points, and an implicit
-*. ***** draw from the Nth point back to the first point.
-*.
-*.
-*. DI-3000 access:
-*. ---------------
-*. CALL JPOLGN (X, Y, N)
-*.
-*. Parameters:
-*. -----------
-*.
-*. X, Y [ REAL; Array; Input ]
-*.
-*. - The arrays of world coordinates defining the polygon
-*.
-*. N [ INTEGER; Input ]
-*.
-*. - The number of points in the polygon. The above parameters
-*. should be DIMENSIONed to at least N in the calling routine
-*.
-*..==========> (O.Couet, H.Johnstad, L.Roberts)
-#include "higz/hiflag.inc"
-#include "higz/hiatt.inc"
- REAL X(1),Y(1)
-#include "higz/di3seg.inc"
-*.______________________________________
-*
- IF(IFAIS.EQ.3.AND.IFASI.GE.100)THEN
- CALL IGFA(N,X,Y)
- ELSE
- IF(GFLAG)THEN
- CALL IGSG(0)
- IF (.NOT. SEGOPN) THEN
- CALL JOPEN
- SEGOPN=.TRUE.
- ENDIF
- CALL JPOLGN (X, Y, N)
- ENDIF
- ENDIF
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_PSCRIPT)||defined(CERNLIB_MAIL)
- IF(GLFLAG)CALL IZFA(N,X,Y)
-#endif
-*
- END
-#endif
diff --git a/src/graflib/higz/idi3000/igmeta.F b/src/graflib/higz/idi3000/igmeta.F
deleted file mode 100644
index ffa9f07..0000000
--- a/src/graflib/higz/idi3000/igmeta.F
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: igmeta.F,v 1.1.1.1 1996/02/14 13:10:28 mclareni Exp $
-*
-* $Log: igmeta.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:28 mclareni
-* Higz
-*
-*
-#if defined(CERNLIB_DI3000)
-#include "higz/pilot.h"
-*CMZ : 1.07/01 06/06/89 09.20.39 by O.Couet
-*-- Author :
- SUBROUTINE IGMETA (IUNIT,METAFL)
-*.===========>
-*.
-*. To OPEN, activate, deactivate and close metafile or screen
-*.
-*..==========> (O.Couet, H.Johnstad, L.Roberts)
-#include "higz/hiatt.inc"
- INTEGER WKID
- INTEGER*4 MAXDEV
- PARAMETER (MAXDEV = 9)
- INTEGER*4 DEVICES(0:MAXDEV)
- EQUIVALENCE (ILOPWK,DEVICES)
-*._____________________________
-*
-*
- WKID = METAFL
- IF (IUNIT.EQ.0) THEN
- CALL IDAWK(WKID)
- IF (WKID.NE.IDID) CALL ICLWK(WKID)
- ELSE IF (IUNIT.EQ.1) THEN
- CALL IOPWK(WKID,0,WKID)
- CALL IACWK(WKID)
- ELSE
- CALL IGERR('Invalid ON/OFF flag (0/1)','IGMETA')
- ENDIF
-*
- 999 END
-
-#endif
diff --git a/src/graflib/higz/idi3000/igrng.F b/src/graflib/higz/idi3000/igrng.F
deleted file mode 100644
index 4596298..0000000
--- a/src/graflib/higz/idi3000/igrng.F
+++ /dev/null
@@ -1,243 +0,0 @@
-*
-* $Id: igrng.F,v 1.1.1.1 1996/02/14 13:10:28 mclareni Exp $
-*
-* $Log: igrng.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:28 mclareni
-* Higz
-*
-*
-#if defined(CERNLIB_DI3000)
-#include "higz/pilot.h"
-*CMZ : 1.07/01 06/06/89 09.18.17 by O.Couet
-*-- Author :
- SUBROUTINE IGRNG(XSIZ,YSIZ)
-*.==========>
-*.
-*. This routines returns the screen range and map the workstation window
-*. on the whole screen. If the screen is not a square a part of the NDC space
-*. is not visible .
-*.
-*. _Input parameters:
-*.
-*. INTEGER WKID : Worsktation identifier .
-*. REAL XMAX YMAX : Screen range .
-*.
-*..=========> (O.Couet, H.Johnstad, L.Roberts)
-#include "higz/hipaw.inc"
-#if defined(CERNLIB_MAIL)
-#include "higz/himail.inc"
-#endif
-#if defined(CERNLIB_MAIL)
-#include "higz/hiflag.inc"
-#endif
-#include "higz/hiatt.inc"
-#include "higz/himeta.inc"
- INTEGER*4 MAXDEV
- PARAMETER (MAXDEV = 9)
- INTEGER*4 DEVICES(0:MAXDEV)
- EQUIVALENCE (ILOPWK,DEVICES)
-
-#include "higz/di3seg.inc"
- INTEGER WKID
- REAL XMAX,YMAX
- INTEGER LIST
- DIMENSION LIST(4)
- REAL MAXDIM(4)
- LOGICAL PHYS
-*.______________________________________
-*
-#if defined(CERNLIB_MAIL)
-*
-* Mail option
-*
- IF(MFLAG)THEN
- WRITE (CHMAIL,'(I3,2E16.7)') 201,XSIZ,YSIZ
- CALL IMWRIT(1)
- READ (5,'(5E15.6)') RQUEST(11),RQUEST(12),RQUEST(13)
- +, RQUEST(14),RQUEST(15)
- CALL IMWRIT(5)
- MFLAG=.FALSE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- CALL ISWN(1,0.,XSIZ,0.,YSIZ)
- CALL ISVP(1,RQUEST(12),RQUEST(14)+RQUEST(12)
- +, RQUEST(13),RQUEST(15)+RQUEST(13))
- CALL ISELNT(1)
- MFLAG=.TRUE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- RETURN
- ENDIF
-#endif
-*
- IF(XSIZ.LE.0..OR.YSIZ.LE.0.)THEN
- CALL IGERR('X size and Y size must be positive','IGRNG')
- GO TO 999
- ENDIF
- IF(SEGOPN) THEN
- CALL JCLOSE
- SEGOPN = .FALSE.
- ENDIF
- CALL IUWK(IDID,1)
-*
-* Perform calculations for primary workstation (IDID).
-*
- IF(TEKACT.OR.METACT)THEN
-*
-* DETERMINE IF THE DEVICE IS CAPABLE OF PHYSICAL SIZING AND
-* THE PHYSICAL SIZE OF THE VIEWPORT
-*
- WKID = IDID
- IF (WKID.NE.0) THEN
- CALL JIQDIM(WKID,PHYS,MAXDIM)
- XMIN = MAXDIM(1)
- XMAX = MAXDIM(2)
- YMIN = MAXDIM(3)
- YMAX = MAXDIM(4)
- ELSE
- CALL JIQDEV(WKID,20,LIST)
- XMIN = FLOAT(LIST(1))
- XMAX = FLOAT(LIST(2))
- YMIN = FLOAT(LIST(3))
- YMAX = FLOAT(LIST(4))
- ENDIF
-*
-* SET THE ORIENTATION OF THE MAXIMUMS RETURNED SINCE NOT ALL
-* DEVICES REFER TO THE LOWER LEFT AS X0PHY, Y0PHY AND UPPER RIGHT
-* AS X1PHY, Y1PHY.
-*
- IF (XMIN .GT. XMAX) THEN
- TEMP = XMIN
- XMIN = XMAX
- XMAX = TEMP
- ENDIF
- IF (YMIN .GT. YMAX) THEN
- TEMP = YMIN
- YMIN = YMAX
- YMAX = TEMP
- ENDIF
-*
- IF (WKID.NE.0) CALL ISWKVP(WKID,XMIN,XMAX,YMIN,YMAX)
-*
-* Ecran horizontal
-*
- IF(XMAX.GE.YMAX)THEN
- XWKWN=1.
- YWKWN=YMAX/XMAX
- CALL ISWKWN(WKID,0.,1.,0.,YWKWN)
- ELSE
-*
-* Ecran vertical
-*
- YWKWN=1.
- XWKWN=XMAX/YMAX
- CALL ISWKWN(WKID,0.,XWKWN,0.,1.)
- ENDIF
- ENDIF
-*
-* Perform calculations for secondary workstations.
-*
- IF(TEKACT.OR.METACT)THEN
-*
-* DETERMINE IF THE DEVICE IS CAPABLE OF PHYSICAL SIZING AND
-* THE PHYSICAL SIZE OF THE VIEWPORT
-*
- DO 100 WKID = 0,MAXDEV
- IF ((DEVICES(WKID).NE.0).AND.(DEVICES(WKID).NE.IDID)) THEN
- IF (WKID.NE.0) THEN
- CALL JIQDIM(WKID,PHYS,MAXDIM)
- XMINT = MAXDIM(1)
- XMAXT = MAXDIM(2)
- YMINT = MAXDIM(3)
- YMAXT = MAXDIM(4)
- ELSE
- CALL JIQDEV(WKID,20,LIST)
- XMINT = FLOAT(LIST(1))
- XMAXT = FLOAT(LIST(2))
- YMINT = FLOAT(LIST(3))
- YMAXT = FLOAT(LIST(4))
- ENDIF
-C
-C SET THE ORIENTATION OF THE MAXIMUMS RETURNED SINCE NOT ALL
-C DEVICES REFER TO THE LOWER LEFT AS X0PHY, Y0PHY AND UPPER RIGHT
-C AS X1PHY, Y1PHY.
-C
- IF (XMINT .GT. XMAXT) THEN
- TEMP = XMINT
- XMINT = XMAXT
- XMAXT = TEMP
- ENDIF
- IF (YMINT .GT. YMAXT) THEN
- TEMP = YMINT
- YMINT = YMAXT
- YMAXT = TEMP
- ENDIF
-*
- IF (WKID.NE.0) THEN
- IF ((XMAXT/XMAX).GE.(YMAXT/YMAX)) THEN
- CALL ISWKVP(WKID,
- + MAX(0.5*(XMAXT-(XMAX/YMAX)*YMAXT),XMINT),
- + MIN(0.5*(XMAXT+(XMAX/YMAX)*YMAXT),XMAXT),
- + YMINT,YMAXT)
- ELSE
- CALL ISWKVP(WKID,XMINT,XMAXT,
- + MAX(0.5*(YMAXT-(YMAX/XMAX)*XMAXT),YMINT),
- + MIN(0.5*(YMAXT+(YMAX/XMAX)*XMAXT),YMAXT))
- ENDIF
- ENDIF
-*
-* Ecran horizontal
-*
- IF(XMAX.GE.YMAX)THEN
- CALL ISWKWN(WKID,0.,1.,0.,YWKWN)
- ELSE
-*
-* Ecran vertical
-*
- CALL ISWKWN(WKID,0.,XWKWN,0.,1.)
- ENDIF
- ENDIF
- 100 CONTINUE
- ENDIF
-*
-* Transformation no 1 : cm <---> espace ecran
-*
- IF (XSIZ.LT.YSIZ) THEN
- XNCM=YWKWN*XSIZ/YSIZ
- YNCM=YWKWN
- DXWN=(XWKWN-XNCM)/2.
- IF(DXWN.LT.0.)THEN
- XNCM=XWKWN
- DXWN=0.
- YNCM=XWKWN*YSIZ/XSIZ
- DYWN=(YWKWN-YNCM)/2.
- XYTWN=XWKWN/XSIZ
- ELSE
- DYWN=0.
- XYTWN=YWKWN/YSIZ
- ENDIF
- ELSE
- XNCM=XWKWN
- YNCM=XWKWN*YSIZ/XSIZ
- DYWN=(YWKWN-YNCM)/2.
- IF(DYWN.LT.0.)THEN
- YNCM=YWKWN
- DYWN=0.
- XNCM=YWKWN*XSIZ/YSIZ
- DXWN=(XWKWN-XNCM)/2.
- XYTWN=YWKWN/YSIZ
- ELSE
- DXWN=0.
- XYTWN=XWKWN/XSIZ
- ENDIF
- ENDIF
-*
- CALL ISWN(1,0.,XSIZ,0.,YSIZ)
- CALL ISVP(1,DXWN,XNCM+DXWN,DYWN,YNCM+DYWN)
- CALL ISELNT(1)
- RQUEST(11)=XYTWN
- RQUEST(12)=DXWN
- RQUEST(13)=DYWN
- RQUEST(14)=XNCM
- RQUEST(15)=YNCM
-*
- 999 END
-#endif
diff --git a/src/graflib/higz/idi3000/igsa.F b/src/graflib/higz/idi3000/igsa.F
deleted file mode 100644
index 8246a22..0000000
--- a/src/graflib/higz/idi3000/igsa.F
+++ /dev/null
@@ -1,92 +0,0 @@
-*
-* $Id: igsa.F,v 1.1.1.1 1996/02/14 13:10:28 mclareni Exp $
-*
-* $Log: igsa.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:28 mclareni
-* Higz
-*
-*
-#if defined(CERNLIB_DI3000)
-#include "higz/pilot.h"
-*CMZ : 1.08/00 10/10/89 09.27.38 by O.Couet
-*-- Author :
- SUBROUTINE IGSA(IIWK)
-*.===========>
-*.
-*. Purpose:
-*. --------
-*.
-*. IGSA switches a raster terminal from graphics to alpha mode.
-*. The terminal must be an activated HIGZ workstation.This is done by
-*. prompting the user who should respond by typing RETURN or any
-*. character string followed by return.
-*.
-*..==========> (O.Couet, H.Johnstad, L.Roberts)
-#include "higz/hilun.inc"
-#include "higz/hiatt.inc"
-#include "higz/hiques.inc"
-#include "higz/hiflag.inc"
-#include "higz/di3dev.inc"
-*
- INTEGER*4 MAXDEV
- PARAMETER (MAXDEV = 9)
- INTEGER*4 DEVICES(0:MAXDEV)
- EQUIVALENCE (ILOPWK,DEVICES)
-*.______________________________________
-*
-#if defined(CERNLIB_IBM)
- INTEGER IDDRV
-#endif
-#if defined(CERNLIB_VAX)
- LOGICAL START /.TRUE./
- CHARACTER*6 LOGNAM
- CHARACTER*80 STRING
- INTEGER LENGTH
- CHARACTER*3 DRIVER(MAXDEV)
- SAVE START,DRIVER
-
- IF (START) THEN
- START=.FALSE.
-
-* Translate YD%DRV logical names to obtain devices.
-
- DO 100 I=1,MAXDEV
- WRITE(LOGNAM,'(A2,I1,A3)') 'YD',I,'DRV'
- STATUS = LIB$SYS_TRNLOG(LOGNAM,LENGTH,STRING)
- DRIVER(I) = STRING(LENGTH-6:LENGTH-4)
- 100 CONTINUE
- END IF
-#endif
- IF(GRFLAG)THEN
- IF (ENTRY_FLAG) CALL JUPDAT
- GRFLAG=.FALSE.
- IWK=IIWK
- IF(IWK.EQ.0)IWK=IDID
- IF(IQUEST(100).EQ.-1)THEN
- IQUEST(100)=0
- ENDIF
- IF (DEVICES(IWK).NE.0) THEN
-#if defined(CERNLIB_VAX)
- IF (DRIVER(IWK).EQ.'COD') THEN
- WRITE(LUNOUT,'(1X,A1)') CHAR(24)
- ELSEIF (
- + (DRIVER(IWK).EQ.'240').OR.(DRIVER(IWK).EQ.'24Y').OR.
- + (DRIVER(IWK).EQ.'241').OR.(DRIVER(IWK).EQ.'24Z').OR.
- + (DRIVER(IWK).EQ.'330').OR.(DRIVER(IWK).EQ.'340')
- + ) THEN
- WRITE(LUNOUT,'(1X,A2)') CHAR(27)//'\'
- ELSEIF (DRIVER(IWK).EQ.'HDS') THEN
- WRITE(LUNOUT,'(1X,A15)') CHAR(27)//'[?38l'//
- + CHAR(27)//'='//CHAR(27)//'<'//CHAR(27)//'[?1h'
- ELSEIF (DRIVER(IWK).EQ.'MAC') THEN
- WRITE(LUNOUT,'(1X,A4)') CHAR(27)//'%!2'
- ENDIF
-#endif
-#if defined(CERNLIB_IBM)
-* Insert proper code here!
-#endif
- ENDIF
- ENDIF
-*
- END
-#endif
diff --git a/src/graflib/higz/idi3000/igsg.F b/src/graflib/higz/idi3000/igsg.F
deleted file mode 100644
index 2fb3a20..0000000
--- a/src/graflib/higz/idi3000/igsg.F
+++ /dev/null
@@ -1,83 +0,0 @@
-*
-* $Id: igsg.F,v 1.1.1.1 1996/02/14 13:10:28 mclareni Exp $
-*
-* $Log: igsg.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:28 mclareni
-* Higz
-*
-*
-#if defined(CERNLIB_DI3000)
-#include "higz/pilot.h"
-*CMZ : 1.08/00 10/10/89 09.27.39 by O.Couet
-*-- Author :
- SUBROUTINE IGSG(IIWK)
-*.===========>
-*.
-*. Purpose:
-*. --------
-*.
-*. IGSG switches a raster terminal from alpha to graphics mode .
-*. The terminal must be an activated HIGZ workstation .
-*.
-*..==========> (O.Couet, H.Johnstad, L.Roberts)
-#include "higz/hilun.inc"
-#include "higz/hiatt.inc"
-#include "higz/hiflag.inc"
-#include "higz/di3dev.inc"
-*
- INTEGER*4 MAXDEV
- PARAMETER (MAXDEV = 9)
- INTEGER*4 DEVICES(0:MAXDEV)
- EQUIVALENCE (ILOPWK,DEVICES)
-*.______________________________________
-*
-#if defined(CERNLIB_VAX)
- LOGICAL START /.TRUE./
- CHARACTER*6 LOGNAM
- CHARACTER*80 STRING
- INTEGER LENGTH
- CHARACTER*3 DRIVER(MAXDEV)
- SAVE START,DRIVER
-
- IF (START) THEN
- START=.FALSE.
-
-* Translate YD%DRV logical names to obtain devices.
-
- DO 100 I=1,MAXDEV
- WRITE(LOGNAM,'(A2,I1,A3)') 'YD',I,'DRV'
- STATUS = LIB$SYS_TRNLOG(LOGNAM,LENGTH,STRING)
- DRIVER(I) = STRING(LENGTH-6:LENGTH-4)
- 100 CONTINUE
- END IF
-#endif
- IF(.NOT.GRFLAG)THEN
- GRFLAG=.TRUE.
- IWK=IIWK
- IF(IWK.EQ.0)IWK=IDID
- IF (DEVICES(IWK).NE.0) THEN
-#if defined(CERNLIB_VAX)
- IF (DRIVER(IWK).EQ.'COD') THEN
-* Do nothing.
- ELSEIF (
- + (DRIVER(IWK).EQ.'240').OR.(DRIVER(IWK).EQ.'24Y').OR.
- + (DRIVER(IWK).EQ.'241').OR.(DRIVER(IWK).EQ.'24Z').OR.
- + (DRIVER(IWK).EQ.'330').OR.(DRIVER(IWK).EQ.'340')
- + ) THEN
-* Do nothing.
- ELSEIF (DRIVER(IWK).EQ.'HDS') THEN
- WRITE(LUNOUT,'(1X,A6,$)') CHAR(27)//'[?38h'
- ELSEIF (DRIVER(IWK).EQ.'MAC') THEN
- WRITE(LUNOUT,'(1X,A8,$)') CHAR(27)//'%!0'//
- + CHAR(27)//'LV0'
- ENDIF
-#endif
-#if defined(CERNLIB_IBM)
-* Insert proper code here!
-#endif
- ENDIF
- ENDIF
-*
- END
-
-#endif
diff --git a/src/graflib/higz/idi3000/iopks.F b/src/graflib/higz/idi3000/iopks.F
deleted file mode 100644
index bc0b488..0000000
--- a/src/graflib/higz/idi3000/iopks.F
+++ /dev/null
@@ -1,63 +0,0 @@
-*
-* $Id: iopks.F,v 1.1.1.1 1996/02/14 13:10:28 mclareni Exp $
-*
-* $Log: iopks.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:28 mclareni
-* Higz
-*
-*
-#if defined(CERNLIB_DI3000)
-#include "higz/pilot.h"
-*CMZ : 1.20/06 08/12/93 10.14.24 by O.Couet
-*-- Author :
- SUBROUTINE IOPKS(ERRFIL)
-*.===========>
-*.
-*. Purpose:
-*. --------
-*. Initialization is done by IGSSE and will not be repeated.
-*. ***** ***** ***** User *MUST* call IGSSE. ***** ***** *****
-*. This routine further sets the debug log file and graphics level
-*.
-*. DI-3000 access:
-*. ---------------
-*. CALL JFILES ! Override default for logical unit
-*. CALL JSETDB ! Set the DI3000 graphics debugging level
-*.
-*..==========> (O.Couet, H.Johnstad, L.Roberts)
-#include "higz/di3dev.inc"
-#include "higz/di3met.inc"
-#include "higz/hivers.inc"
- CHARACTER*16 TCARD
- INTEGER ERRDEB
- INTEGER ERRFIL
-*.______________________________________
-*
- CALL UHTOC(
- + 40H CPP_TITLE
-#if !defined(CERNLIB_CRAY)
- +,4,TCARD,16)
-#endif
-#if defined(CERNLIB_CRAY)
- +,8,TCARD,16)
-#endif
- CHVERS = TCARD(9:16)
-*
- IF (.NOT.ENTRY_FLAG) THEN
- CALL JBEGIN
- ENTRY_FLAG = .TRUE.
- ENDIF
- CALL JFILES (1, 0, ERRFIL)
- CALL JSETER (0)
-
-#if defined(CERNLIB_VAX)
- IF (ICHAR(METNAM(1:1)).EQ.0) METNAM = 'HIGZ.METAFILE'
-#endif
-#if defined(CERNLIB_IBM)
- IF (ICHAR(METNAM(1:1)).EQ.0) METNAM = 'HIGZ METAFILE'
-#endif
- CALL JFSOPN (3, 0, 0, METNAM)
-*
- END
-#endif
-#include "higz/TITLE.higz"
diff --git a/src/graflib/higz/idi3000/iopwk.F b/src/graflib/higz/idi3000/iopwk.F
deleted file mode 100644
index 6ac6caf..0000000
--- a/src/graflib/higz/idi3000/iopwk.F
+++ /dev/null
@@ -1,61 +0,0 @@
-*
-* $Id: iopwk.F,v 1.1.1.1 1996/02/14 13:10:28 mclareni Exp $
-*
-* $Log: iopwk.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:28 mclareni
-* Higz
-*
-*
-#if defined(CERNLIB_DI3000)
-#include "higz/pilot.h"
-*CMZ : 1.12/16 14/08/91 12.10.00 by O.Couet
-*-- Author :
- SUBROUTINE IOPWK(WKID,CONID,WTYPE)
-*.===========>
-*.
-*. Purpose:
-*. --------
-*. Initialize a display device
-*.
-*..==========> (O.Couet, H.Johnstad, L.Roberts)
-#include "higz/hiatt.inc"
-#include "higz/himeta.inc"
- INTEGER WKID,CONID,WTYPE
- INTEGER*4 MAXDEV
- PARAMETER (MAXDEV = 9)
- INTEGER*4 DEVICES(0:MAXDEV)
- EQUIVALENCE (ILOPWK,DEVICES)
-#include "higz/di3seg.inc"
-*.______________________________________
-*
- IF(WKID.LT.0)THEN
- CALL IGERR('Workstation identifier less than 0','IOPWK')
- RETURN
- ENDIF
-*
-* PostScript Metafile
-*
- IF(WTYPE.LT.0)THEN
- CALL IPINIT(WKID,ABS(CONID),WTYPE)
- RETURN
- ENDIF
-*
- IF (DEVICES(WKID).EQ.0) THEN
- INOPWK=INOPWK+1
- DEVICES(WKID)=1
- ICONID=CONID
-*
- IF (SEGOPN) THEN
- CALL JCLOSE
- SEGOPN =.FALSE.
- ENDIF
- CALL JDINIT (WKID)
- IF (WKID.EQ.0) THEN
- METACT = .TRUE.
- ELSE
- TEKACT = .TRUE.
- ENDIF
- ENDIF
-*
- END
-#endif
diff --git a/src/graflib/higz/idi3000/ipl.F b/src/graflib/higz/idi3000/ipl.F
deleted file mode 100644
index 6021687..0000000
--- a/src/graflib/higz/idi3000/ipl.F
+++ /dev/null
@@ -1,204 +0,0 @@
-*
-* $Id: ipl.F,v 1.1.1.1 1996/02/14 13:10:28 mclareni Exp $
-*
-* $Log: ipl.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:28 mclareni
-* Higz
-*
-*
-#if defined(CERNLIB_DI3000)
-#include "higz/pilot.h"
-*CMZ : 1.22/09 23/03/95 15.21.39 by O.Couet
-*-- Author :
- SUBROUTINE IPL(N,X,Y)
-*.===========>
-*.
-*. Purpose:
-*. --------
-*. Define a connected sequence of visible lines.
-*.
-*. DI-3000 access:
-*. ---------------
-*. CALL JPOLY (X, Y, N)
-*.
-*. Parameters:
-*. -----------
-*. X, Y [ REAL; Array; Input ]
-*.
-*. - The arrays of world coordinates defining the polyline.
-*.
-*. N [ INTEGER; Input ]
-*.
-*. - The number of points in the connected line sequence.
-*.
-*. *NOTE* : The above array parameters must be DIMENSIONed to at
-*. least N in the calling program.
-*.
-*..==========> (O.Couet, H.Johnstad, L.Roberts)
-#include "higz/hiatt.inc"
-#include "higz/hiflag.inc"
-#include "higz/di3seg.inc"
- DIMENSION X(N),Y(N),XX(2),YY(2),XDOT(2),YDOT(2)
- LOGICAL ZSAV
- EQUIVALENCE (XOLD,XX(1)),(XNEW,XX(2))
- EQUIVALENCE (YOLD,YY(1)),(YNEW,YY(2))
- DATA XLSTEP,SMIN/0.2,0.0002/
-*.______________________________________
-*
- IF(N.LE.1)GOTO 999
- IF((ILN.GE.12).AND.(GFLAG.OR.PFLAG))THEN
- CALL IGSG(0)
- ZSAV=ZFLAG
- ZFLAG=.FALSE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- NTSAV=INTR
- RATIO1=(RVXMAX-RVXMIN)/(RWXMAX-RWXMIN)
- RATIO2=(RVYMAX-RVYMIN)/(RWYMAX-RWYMIN)
- RWX1=RWXMIN
- RWY1=RWYMIN
- RVX1=RVXMIN
- RVY1=RVYMIN
- RVX2=RVXMAX
- RVY2=RVYMAX
- XLSTEP=RBSL
- SMIN=0.001*XLSTEP
- CALL ISELNT(0)
- ILNS=ILN
- CALL ISLN(1)
- IF((XLSTEP.LE.0.).OR.(XLSTEP.GT.1))XLSTEP=0.01
-*
-* Possibly dashed lines drawn
-*
- 10 MODE=1
- IDOT=0
- SRES=XLSTEP
-*
- DO 90 I=2,N
- XOLD=RATIO1*(X(I-1)-RWX1)+RVX1
- YOLD=RATIO2*(Y(I-1)-RWY1)+RVY1
-*
- DXSTEP=RATIO1*(X(I)-RWX1)+RVX1-XOLD
- DYSTEP=RATIO2*(Y(I)-RWY1)+RVY1-YOLD
- ADX=ABS(DXSTEP)
- ADY=ABS(DYSTEP)
- IF(ADX.LE.SMIN)THEN
- STEP=ADY
- DSX=0.
- DSY=SIGN(1.,DYSTEP)
- GOTO 20
- ENDIF
- IF(ADY.LE.SMIN)THEN
- STEP=ADX
- DSX=SIGN(1.,DXSTEP)
- DSY=0.
- GOTO 20
- ENDIF
- STEP=SQRT(DXSTEP*DXSTEP+DYSTEP*DYSTEP)
- DSX=DXSTEP/STEP
- DSY=DYSTEP/STEP
- 20 IF(STEP.LE.0.)GO TO 90
- DRES=STEP
-*
- 30 ST=SRES
- IF(ST.GT.DRES)ST=DRES
- SRES=SRES-ST
- DRES=DRES-ST
- XNEW=XOLD+ST*DSX
- YNEW=YOLD+ST*DSY
-*
- IF(ICLIP.EQ.1)THEN
- ICL=IGCLIP(XX,YY,RVX1,RVX2,RVY1,RVY2)
- IF(ICL.EQ.0)GOTO 80
- ENDIF
-*
- GO TO (40 ,40 ,50 ,60 ,70 ),ILNS-10
-*
-* Dashed line _ _ _ _ _ _ _
-*
- 40 CONTINUE
- IF (.NOT. SEGOPN) THEN
- CALL JOPEN
- SEGOPN = .TRUE.
- ENDIF
- IF (MODE .NE. 0) THEN
-#if defined(CERNLIB_PSCRIPT)
- IF(PFLAG)CALL IZPL(2,XX,YY)
-#endif
- IF(GFLAG)THEN
- CALL JMOVE(XX(1),YY(1))
- CALL JPOLY(XX,YY,2)
- ENDIF
- ENDIF
- GO TO 80
-*
-* Dash-dot line _._._._._.
-*
- 50 IF(MODE.EQ.0)GO TO 70
- IF (.NOT. SEGOPN) THEN
- CALL JOPEN
- SEGOPN=.TRUE.
- ENDIF
-#if defined(CERNLIB_PSCRIPT)
- IF(PFLAG)CALL IZPL(2,XX,YY)
-#endif
- IF(GFLAG)THEN
- CALL JMOVE(XX(1),YY(1))
- CALL JPOLY(XX,YY,2)
- ENDIF
- GO TO 80
-*
-* Dot-blank . . . . . . .
-*
- 60 IF(MODE.EQ.0)GO TO 80
-*
-* Dotted line ............
-*
- 70 IF (SRES.LT.0.5*XLSTEP) IDOT=IDOT+1
- IF (IDOT.NE.1) GOTO 80
- XDOT(1) = XNEW - (0.5*XLSTEP-SRES)*DSX
- YDOT(1) = YNEW - (0.5*XLSTEP-SRES)*DSY
- MTS=IMK
- MCOL=IPMCI
- RMSC=RMKSC
- CALL ISMKSC(RLWSC)
- CALL ISMK(1)
- CALL ISPMCI(IPLCI)
- IF(GFLAG)CALL JPMARK(XDOT,YDOT,1)
-#if defined(CERNLIB_PSCRIPT)
- IF(PFLAG)CALL IZPM(1,XDOT,YDOT)
-#endif
- CALL ISMKSC(RMSC)
- CALL ISMK(MTS)
- CALL ISPMCI(MCOL)
-*
- 80 XOLD=XNEW
- YOLD=YNEW
- IF(SRES.LE.SMIN)THEN
- IDOT=0
- SRES=XLSTEP
- MODE=MODE+1
- IF(MODE.EQ.2)MODE=0
- ENDIF
- IF(DRES.GT.SMIN)GO TO 30
- 90 CONTINUE
- CALL ISELNT(NTSAV)
- CALL ISLN(ILNS)
- ZFLAG=ZSAV
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- ELSE
- IF(GFLAG)THEN
- CALL IGSG(0)
- IF (.NOT. SEGOPN) THEN
- CALL JOPEN
- SEGOPN=.TRUE.
- ENDIF
- CALL JMOVE (X(1),Y(1))
- CALL JPOLY (X, Y, N)
- ENDIF
- ENDIF
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_PSCRIPT)||defined(CERNLIB_MAIL)
- IF(GLFLAG)CALL IZPL(N,X,Y)
-#endif
-*
- 999 END
-#endif
diff --git a/src/graflib/higz/idi3000/ipm.F b/src/graflib/higz/idi3000/ipm.F
deleted file mode 100644
index 6cfa858..0000000
--- a/src/graflib/higz/idi3000/ipm.F
+++ /dev/null
@@ -1,53 +0,0 @@
-*
-* $Id: ipm.F,v 1.1.1.1 1996/02/14 13:10:28 mclareni Exp $
-*
-* $Log: ipm.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:28 mclareni
-* Higz
-*
-*
-#if defined(CERNLIB_DI3000)
-#include "higz/pilot.h"
-*CMZ : 1.18/10 21/06/93 11.11.11 by O.Couet
-*-- Author :
- SUBROUTINE IPM(N,X,Y)
-*.===========>
-*.
-*. This routines draws markers .
-*.
-*. _Input parameters:
-*.
-*. INTEGER N : Number of markers .
-*. REAL X(N) : Markers X coordinates .
-*. REAL Y(N) : Markers Y coordinates .
-*.
-*..==========> (O.Couet, H.Johnstad, L.Roberts)
-#include "higz/hiatt.inc"
-#include "higz/hiflag.inc"
-#include "higz/di3seg.inc"
- REAL X(N),Y(N)
-*.______________________________________
-*
- IF((N.LE.0).OR.(IMK.GT.31))GOTO 999
-*
- IF(GFLAG.OR.PFLAG)THEN
- CALL IGSG(0)
- IF(IMK.LT.20)THEN
- IF(.NOT.GFLAG)GOTO 20
- IF (.NOT. SEGOPN) THEN
- CALL JOPEN
- SEGOPN=.TRUE.
- ENDIF
- CALL JPMARK(X,Y,N)
- ELSE
- CALL IGPM(N,X,Y,IMK)
- ENDIF
- ENDIF
-*
- 20 CONTINUE
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_PSCRIPT)||defined(CERNLIB_MAIL)
- IF(GLFLAG)CALL IZPM(N,X,Y)
-#endif
-*
- 999 END
-#endif
diff --git a/src/graflib/higz/idi3000/irqlc.F b/src/graflib/higz/idi3000/irqlc.F
deleted file mode 100644
index 7930633..0000000
--- a/src/graflib/higz/idi3000/irqlc.F
+++ /dev/null
@@ -1,228 +0,0 @@
-*
-* $Id: irqlc.F,v 1.2 1998/01/30 15:22:11 couet Exp $
-*
-* $Log: irqlc.F,v $
-* Revision 1.2 1998/01/30 15:22:11 couet
-* - APOLLO version removed
-*
-* Revision 1.1.1.1 1996/02/14 13:10:29 mclareni
-* Higz
-*
-*
-#if defined(CERNLIB_DI3000)
-#include "higz/pilot.h"
-*CMZ : 1.21/03 01/06/94 13.38.23 by O.Couet
-*-- Author :
- SUBROUTINE IRQLC(WKID,LCN,STATUS,TNR,XLOC,YLOC)
-*.===========>
-*.
-*. This routine returns the graphic cursor position in WC space in
-*. XLOC and YLOC . The same position in the NDC space is available in
-*. RQUEST(11) and RQUEST(12) . The normalization tranformation number
-*. is returned in TNR . After a call to IRQLC the window coordinates
-*. are available in RQUEST(20), RQUEST(21), RQUEST(22), and RQUEST(23).
-*. The viewport coordinates are available in RQUEST(30), RQUEST(31),
-*. RQUEST(32), and RQUEST(33). This routine computed the XLOC and YLOC
-*. value according to value of the REDIT factor, but the value of
-*. RQUEST(11) and RQUEST(12) do not care about the value of REDIT.
-*. The REDIT factor is usefull for the graphics editor and the menu
-*. mode of KUIP. The values of XLOC and YLOC are computed with the
-*. parameters stored in the NT storage (HINT) if ZEBRA is not used, or
-*. if there no displayed picture. If an HIGZ picture is displayed,
-*. only the NT existing in this picture are used to compute the values
-*. of XLOC and YLOC.
-*.
-*. _Input parameters:
-*.
-*. INTEGER WKID : Workstation identifier .
-*. INTEGER LCN : Input device number .
-*. If LCN>10 then LCN=10*IPET+LNDNR
-*. INTEGER STATUS : Return status: 0=BREAK, 1=OK .
-*.
-*. _Output parameters:
-*.
-*. INTEGER TNR : Normalization transformation number .
-*. REAL XLOC YLOC : Cursor position in WC space .
-*.
-*..==========> (O.Couet)
-#if defined(CERNLIB_ZEBRA)
-#include "higz/hipaw.inc"
-#endif
-#if !defined(CERNLIB_ZEBRA)
-#include "higz/hiques.inc"
-#endif
-#include "higz/hint.inc"
-#include "higz/hiloc.inc"
-#include "higz/hiatt.inc"
-#if defined(CERNLIB_MAIL)
-#include "higz/himail.inc"
-#endif
-#if defined(CERNLIB_MAIL)
-#include "higz/hiflag.inc"
-#endif
- INTEGER WKID,LCDNR,STATUS,TNR,NNT
- INTEGER INPFCT,IECHO,IBUTTN
- CHARACTER*80 STR(4)
-*.______________________________________
-*
-#if defined(CERNLIB_MAIL)
-*
-* MAIL option
-*
- IF(MFLAG)THEN
- WRITE (CHMAIL,'(3I3)') 555,WKID,LCN
- CALL IMWRIT(1)
- READ (5,'(2I5,2E16.7)') STATUS,TNR,XLOC,YLOC
- CALL IMWRIT(5)
- RETURN
- ENDIF
-#endif
-*
- CALL IGSG(0)
- LCDNR=MOD(LCN,10)
- IPET=1
- LOCDEV=1
- INPFCT=2
- IECHO=1
- LSTR=0
- CALL JPECHO(WKID,INPFCT,LOCDEV,OLDXP,OLDYP)
- CALL JIENAB(WKID,INPFCT,LOCDEV)
- CALL JLOCAT(WKID,LOCDEV,IECHO,IBUTTN,RQUEST(11),RQUEST(12))
- IF(IBUTTN.EQ.3) THEN
- STATUS = 0
- ELSE
- STATUS = 1
- ENDIF
- OLDXP=RQUEST(11)
- OLDYP=RQUEST(12)
-*
- SCALE=1.
- IF(REDIT.NE.0.)SCALE=REDIT
-*
- RQUEST(20)=0.
- RQUEST(21)=1.
- RQUEST(22)=0.
- RQUEST(23)=1.
- RQUEST(30)=0.
- RQUEST(31)=1.
- RQUEST(32)=0.
- RQUEST(33)=1.
- TNR=0
- XLOC=(RQUEST(11)+RDWXMI*REDIT)/SCALE
- YLOC=(RQUEST(12)+RDWYMI*REDIT)/SCALE
-#if defined(CERNLIB_ZEBRA)
-*
-* There is displayed picture
-*
- IF(LPICD.GT.0)THEN
- IPRIOO=IQ(LDNT0+3)
- NBNT=IQ(LPICD+8)-1
- LN=LQ(LDNT0)
- DO 10 I=1,NBNT
- IAWV=LDF+IQ(LN+2)
- IPRION=IQ(LN+3)
- RQUEST(20)=Q(IAWV)
- RQUEST(21)=Q(IAWV+1)
- RQUEST(22)=Q(IAWV+2)
- RQUEST(23)=Q(IAWV+3)
- RQUEST(30)=Q(IAWV+4)
- RQUEST(31)=Q(IAWV+5)
- RQUEST(32)=Q(IAWV+6)
- RQUEST(33)=Q(IAWV+7)
- IF((RQUEST(30)*SCALE-(RDWXMI*REDIT).LE.RQUEST(11)).AND.
- + (RQUEST(11).LE.RQUEST(31)*SCALE-(RDWXMI*REDIT)).AND.
- + (RQUEST(32)*SCALE-(RDWYMI*REDIT).LE.RQUEST(12)).AND.
- + (RQUEST(12).LE.RQUEST(33)*SCALE-(RDWYMI*REDIT)))THEN
- IF(IPRION.GT.IPRIOO)THEN
- XLOC=((((RQUEST(11)+(RDWXMI*REDIT))/SCALE)
- + -RQUEST(30))
- + /(RQUEST(31)-RQUEST(30)))
- + *(RQUEST(21)-RQUEST(20))
- + +RQUEST(20)
- YLOC=((((RQUEST(12)+(RDWYMI*REDIT))/SCALE)
- + -RQUEST(32))
- + /(RQUEST(33)-RQUEST(32)))
- + *(RQUEST(23)-RQUEST(22))
- + +RQUEST(22)
- TNR=IQ(LN+1)
- IPRIOO=IPRION
- ENDIF
- ENDIF
- LN=LQ(LN)
- IF(LN.EQ.0)RETURN
- 10 CONTINUE
- RETURN
- ENDIF
-#endif
-#if !defined(CERNLIB_NTC)
-*
-* The computing of XLOC and YLOC in done with the parameters
-* stored in HINT.
-*
- NBNT=NTSTOR(1)
- IPRIOO=NT0PRI
- DO 20 I=1,NBNT
- NNT=NTSTOR(2*I)
- CALL IZGNT(NNT,IFIND,IAWV,IPRION,IHPRIO)
- RQUEST(20)=WNVPST(IAWV)
- RQUEST(21)=WNVPST(IAWV+1)
- RQUEST(22)=WNVPST(IAWV+2)
- RQUEST(23)=WNVPST(IAWV+3)
- RQUEST(30)=WNVPST(IAWV+4)
- RQUEST(31)=WNVPST(IAWV+5)
- RQUEST(32)=WNVPST(IAWV+6)
- RQUEST(33)=WNVPST(IAWV+7)
- IF((RQUEST(30)*SCALE-(RDWXMI*REDIT).LE.RQUEST(11)).AND.
- + (RQUEST(11).LE.RQUEST(31)*SCALE-(RDWXMI*REDIT)).AND.
- + (RQUEST(32)*SCALE-(RDWYMI*REDIT).LE.RQUEST(12)).AND.
- + (RQUEST(12).LE.RQUEST(33)*SCALE-(RDWYMI*REDIT)))THEN
- IF(IPRION.GT.IPRIOO)THEN
- XLOC=((((RQUEST(11)+(RDWXMI*REDIT))/SCALE)
- + -RQUEST(30))
- + /(RQUEST(31)-RQUEST(30)))
- + *(RQUEST(21)-RQUEST(20))
- + +RQUEST(20)
- YLOC=((((RQUEST(12)+(RDWYMI*REDIT))/SCALE)
- + -RQUEST(32))
- + /(RQUEST(33)-RQUEST(32)))
- + *(RQUEST(23)-RQUEST(22))
- + +RQUEST(22)
- TNR=NNT
- IPRIOO=IPRION
- ENDIF
- ENDIF
- 20 CONTINUE
-#endif
-#if defined(CERNLIB_NTC)
- IPRIOO = NT0PRI
- IEND = IGNNXT(1)
- 30 IF(IEND.EQ.0)THEN
- CALL IGNGET(NNT,IPRION,IHPRIO
- +, RQUEST(20),RQUEST(21),RQUEST(22),RQUEST(23)
- +, RQUEST(30),RQUEST(31),RQUEST(32),RQUEST(33),I3D)
- IF((RQUEST(30)*SCALE-(RDWXMI*REDIT).LE.RQUEST(11)).AND.
- + (RQUEST(11).LE.RQUEST(31)*SCALE-(RDWXMI*REDIT)).AND.
- + (RQUEST(32)*SCALE-(RDWYMI*REDIT).LE.RQUEST(12)).AND.
- + (RQUEST(12).LE.RQUEST(33)*SCALE-(RDWYMI*REDIT)))THEN
- IF(IPRION.GT.IPRIOO)THEN
- XLOC=((((RQUEST(11)+(RDWXMI*REDIT))/SCALE)
- + -RQUEST(30))
- + /(RQUEST(31)-RQUEST(30)))
- + *(RQUEST(21)-RQUEST(20))
- + +RQUEST(20)
- YLOC=((((RQUEST(12)+(RDWYMI*REDIT))/SCALE)
- + -RQUEST(32))
- + /(RQUEST(33)-RQUEST(32)))
- + *(RQUEST(23)-RQUEST(22))
- + +RQUEST(22)
- ITNRI=NNT
- IPRIOO=IPRION
- ENDIF
- ENDIF
- IEND = IGNNXT(0)
- GOTO 30
- ENDIF
-#endif
-*
- END
-#endif
diff --git a/src/graflib/higz/idi3000/irqst.F b/src/graflib/higz/idi3000/irqst.F
deleted file mode 100644
index eea2fed..0000000
--- a/src/graflib/higz/idi3000/irqst.F
+++ /dev/null
@@ -1,103 +0,0 @@
-*
-* $Id: irqst.F,v 1.1.1.1 1996/02/14 13:10:29 mclareni Exp $
-*
-* $Log: irqst.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:29 mclareni
-* Higz
-*
-*
-#if defined(CERNLIB_DI3000)
-#include "higz/pilot.h"
-*CMZ : 1.10/00 15/01/90 09.38.41 by O.Couet
-*-- Author :
- SUBROUTINE IRQST(WKID,STDNR,STATUS,L,STR)
-*.===========>
-*.
-*. Purpose:
-*. --------
-*. Request and return input from a STRING input device.
-*.
-*. DI-3000 access:
-*. ---------------
-*. CALL JKEYBS (DEVICE, PHYDEV, ECHOLV, MAXCHR, STRING, ACTUAL)
-*.
-*. Parameters:
-*. -----------
-*. DEVICE
-*. - Currently selected display device
-*.
-*. PHYDEV
-*. - Integer defining the physical input device on DEVICE that is to be
-*. used for obtaining KEYBOARD input
-*.
-*. ECHOLV
-*. - Echo level for echoing KEYBOARD input (=0 No echo, =1 KEYBOARD string
-*. is displayed, =2 KEYBOARD string is output onto a display DEVICE
-*. other than the display device of DEVICE
-*.
-*. MAXCHR
-*. - Maximum number of characters that will fit into the text array
-*. STRING, must be passed from the calling program, max=254
-*.
-*. STRING
-*. - The character string returned by the KEYBOARD input function
-*.
-*. ACTUAL
-*. - The actual number of characters read in by the KEYBOARD input
-*. function
-*.
-*.
-*..==========> (O.Couet, H.Johnstad, L.Roberts)
-#if defined(CERNLIB_MAIL)
-#include "higz/himail.inc"
-#endif
-#if defined(CERNLIB_MAIL)
-#include "higz/hiflag.inc"
-#endif
- INTEGER WKID,STATUS,L
- CHARACTER*(*) STR
- INTEGER DEVICE, PHYDEV, ECHOLV, MAXCHR, ACTUAL, INPFCT
- CHARACTER *254 STRING
-
- INTEGER NKEYBD
-*.______________________________________
-*
-#if defined(CERNLIB_MAIL)
-*
-* MAIL option
-*
- IF(MFLAG)THEN
- WRITE (CHMAIL,'(3I3)') 556,IWKID,ISTD
- CALL IMWRIT(1)
- READ (5,'(2I5,A)') ISTAT,L,STR
- CALL IMWRIT(5)
- RETURN
- ENDIF
-#endif
-*
- CALL IGSG(0)
-C
-C ***** Enable KEYBOARD device
-C
- DEVICE = ABS(WKID)
- CALL JIQDEV(DEVICE,45,NKEYBD)
- IF (NKEYBD.NE.0) THEN
-
- INPFCT = 4
- PHYDEV = 1
- ECHOLV = 0
- MAXCHR = 254
-
- CALL JIENAB(DEVICE,INPFCT,PHYDEV)
-
-C ***** Get STRING from device
-
- STRING = ' '
- CALL JKEYBS (DEVICE, PHYDEV, ECHOLV, MAXCHR, STRING, ACTUAL)
- L = ACTUAL
- STR = STRING
- STATUS = 1
- ENDIF
-*
- END
-#endif
diff --git a/src/graflib/higz/idi3000/ischh.F b/src/graflib/higz/idi3000/ischh.F
deleted file mode 100644
index 400b1fc..0000000
--- a/src/graflib/higz/idi3000/ischh.F
+++ /dev/null
@@ -1,53 +0,0 @@
-*
-* $Id: ischh.F,v 1.1.1.1 1996/02/14 13:10:29 mclareni Exp $
-*
-* $Log: ischh.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:29 mclareni
-* Higz
-*
-*
-#if defined(CERNLIB_DI3000)
-#include "higz/pilot.h"
-*CMZ : 1.06/06 09/03/89 15.44.26 by O.Couet
-*-- Author :
- SUBROUTINE ISCHH(CHH)
-*.===========>
-*.
-*. Purpose:
-*. --------
-*. Set the dimensions of the character box.
-*.
-*. DI-3000 access:
-*. ---------------
-*. CALL JSIZE (CXSIZE, CYSIZE)
-*.
-*. Parameters:
-*. -----------
-*. CXSIZE, CYSIZE [ REAL; Input ]
-*.
-*. - The new value for the character box SIZE.
-*. NOTE : Both CXSIZE anC CYSIZE must be greater than 0.0.
-*.
-*..==========> (O.Couet, H.Johnstad, L.Roberts)
-#include "higz/hiatt.inc"
-#if defined(CERNLIB_ZEBRA)
-#include "higz/hicode.inc"
-#endif
-#include "higz/hiflag.inc"
-#include "higz/di3seg.inc"
-*.______________________________________
-*
- RCHH=CHH
- IF (GFLAG) THEN
- IF (.NOT. SEGOPN) THEN
- CALL JOPEN
- SEGOPN=.TRUE.
- ENDIF
- CALL JSIZE (CHH,CHH)
- ENDIF
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_MAIL)
- IF(GLFLAG)CALL IZATT(ICHHCO)
-#endif
-*
- END
-#endif
diff --git a/src/graflib/higz/idi3000/ischup.F b/src/graflib/higz/idi3000/ischup.F
deleted file mode 100644
index a1730dc..0000000
--- a/src/graflib/higz/idi3000/ischup.F
+++ /dev/null
@@ -1,72 +0,0 @@
-*
-* $Id: ischup.F,v 1.1.1.1 1996/02/14 13:10:29 mclareni Exp $
-*
-* $Log: ischup.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:29 mclareni
-* Higz
-*
-*
-#if defined(CERNLIB_DI3000)
-#include "higz/pilot.h"
-*CMZ : 1.06/06 09/03/89 15.44.26 by O.Couet
-*-- Author :
- SUBROUTINE ISCHUP(CHUX,CHUY)
-*.===========>
-*.
-*. Purpose:
-*. --------
-*. Set the current character plane vector text attribute.
-*.
-*. DI-3000 access:
-*. ---------------
-*. CALL JPLANE (CXPLAN, CYPLAN, CZPLAN)
-*.
-*. Parameters:
-*. -----------
-*. CXPLAN, CYPLAN, CZPLAN [ REAL; Input ]
-*.
-*. - The character plane vector of subsequent text primitives
-*. within the currently OPEN segment.
-*.
-*. *NOTE* : At least one of (CXPLAN, CYPLAN, CZPLAN) must not
-*. be equal to 0.0.
-*.
-*..==========> (O.Couet, H.Johnstad, L.Roberts)
-#include "higz/hiatt.inc"
-#if defined(CERNLIB_ZEBRA)
-#include "higz/hicode.inc"
-#endif
-#include "higz/hiflag.inc"
-#include "higz/di3seg.inc"
-*.______________________________________
-*
- RCHUX=CHUX
- RCHUY=CHUY
- IF (GFLAG) THEN
- IF (.NOT. SEGOPN) THEN
- CALL JOPEN
- SEGOPN=.TRUE.
- ENDIF
- CALL JBASE (CHUY, -CHUX, 0.)
- CALL JPLANE (CHUX, CHUY, 0.)
- ENDIF
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_MAIL)
- IF((RCHUX.EQ.0.).AND.(RCHUY.EQ.1.))THEN
- RANGLE=0.
- ELSEIF((RCHUX.EQ.-1.).AND.(RCHUY.EQ.0.))THEN
- RANGLE=90.
- ELSEIF((RCHUX.EQ.0.).AND.(RCHUY.EQ.-1.))THEN
- RANGLE=180.
- ELSEIF((RCHUX.EQ.1.).AND.(RCHUY.EQ.0.))THEN
- RANGLE=270.
- ELSE
- RANGLE=((ACOS(RCHUX/SQRT(RCHUX**2+RCHUY**2))*180.)
- + /3.14159)-90.
- IF(RCHUY.LT.0.)RANGLE=180.-RANGLE
- IF(ABS(RANGLE).LE.0.01)RANGLE=0.
- ENDIF
- IF(GLFLAG)CALL IZATT(IANGCO)
-#endif
-*
- END
-#endif
diff --git a/src/graflib/higz/idi3000/isclip.F b/src/graflib/higz/idi3000/isclip.F
deleted file mode 100644
index a4af9d9..0000000
--- a/src/graflib/higz/idi3000/isclip.F
+++ /dev/null
@@ -1,62 +0,0 @@
-*
-* $Id: isclip.F,v 1.1.1.1 1996/02/14 13:10:29 mclareni Exp $
-*
-* $Log: isclip.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:29 mclareni
-* Higz
-*
-*
-#if defined(CERNLIB_DI3000)
-#include "higz/pilot.h"
-*CMZ : 1.21/01 11/05/94 13.30.36 by O.Couet
-*-- Author :
- SUBROUTINE ISCLIP(CLSW)
-*.===========>
-*.
-*. Purpose:
-*. --------
-*. Set the indicator for clipping at the boundaries of
-*. the normalization transformation viewport.
-*.
-*. DI-3000 access:
-*. ---------------
-*. CALL JWCLIP (LVALUE)
-*.
-*. Parameters:
-*. ___________
-*. LVALUE
-*. - Logical flag indicating whether or not subsequent output primitives
-*. are to be clipped to the boundaries of the clipping window on the
-*. viewplane.
-*.
-*. LVALUE = .TRUE. ---> enable window clipping
-*. LVALUE = .FALSE. ---> disable window clipping
-*.
-*. *NOTE* : If window clipping is suppressed and world coordiantes
-*. data exceed the window boundaries, the resultant display
-*. device image is unpredictable and device dependent
-*.
-*. *NOTE* : DI-3000 disables clipping by default
-*.
-*..==========> (O.Couet, H.Johnstad, L.Roberts)
-#include "higz/hiatt.inc"
-#include "higz/hiflag.inc"
-#include "higz/di3seg.inc"
- INTEGER CLSW
-*.______________________________________
-*
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_PSCRIPT)||defined(CERNLIB_MAIL)
- IF(GLFLAG)CALL IZSCLI(CLSW)
-#endif
- IF(CLSW.EQ.ICLIP)RETURN
- ICLIP=CLSW
- IF(GFLAG)THEN
- IF(SEGOPN) THEN
- CALL JCLOSE
- SEGOPN = .FALSE.
- ENDIF
- CALL JWCLIP(CLSW.EQ.1)
- ENDIF
-*
- END
-#endif
diff --git a/src/graflib/higz/idi3000/iscr.F b/src/graflib/higz/idi3000/iscr.F
deleted file mode 100644
index d1f2425..0000000
--- a/src/graflib/higz/idi3000/iscr.F
+++ /dev/null
@@ -1,76 +0,0 @@
-*
-* $Id: iscr.F,v 1.1.1.1 1996/02/14 13:10:29 mclareni Exp $
-*
-* $Log: iscr.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:29 mclareni
-* Higz
-*
-*
-#if defined(CERNLIB_DI3000)
-#include "higz/pilot.h"
-*CMZ : 1.16/08 10/12/92 09.29.34 by O.Couet
-*-- Author :
- SUBROUTINE ISCR(IWKID,ICI,CR,CG,CB)
-*.===========>
-*.
-*. Purpose:
-*. --------
-*. Set color primitive attribute.
-*.
-*. DI-3000 access:
-*. ---------------
-*. CALL JCOLOR (CVALUE)
-*.
-*. Parameters:
-*. -----------
-*. CVALUE [ INTEGER; Input ]
-*.
-*. - The new value for the color index.
-*.
-*. NOTE : CVALUE must be in the range 0...32767.
-*.
-*. 0 - "Normal" for the DEVICE
-*. 1 - Red
-*. 2 - Green
-*. 3 - Yellow
-*. 4 - Blue
-*. 5 - Magenta
-*. 6 - Cyan
-*. 7 - White
-*. 8 - Black
-*. 9 - Complement of the "normal" DEVICE color
-*.
-*..==========> (O.Couet, H.Johnstad, L.Roberts)
-#include "higz/hiflag.inc"
-#include "higz/hilut.inc"
- INTEGER CVALUE(1),HUE(1),SAT(1),LIGHT(1)
- INTEGER MAP(0:7)
- DATA MAP / 9, 0, 1, 2, 4, 3, 5, 6 /
-*.______________________________________
-*
- I=MIN(NBCLUT-1,ABS(ICI))+1
- REDLUT(I)=CR
- GRNLUT(I)=CG
- BLULUT(I)=CB
- CALL IGSG(0)
- IF(GFLAG)THEN
-C
-C Perform GKS-->DI3000 mapping for color indices 0-7.
-C
- IF((ICI.GE.0).AND.(ICI.LE.7))THEN
- CVALUE(1)=MAP(ICI)
- ELSE
- CVALUE(1)=ICI
- ENDIF
-C
-C Transform RGB --> HSL. Use routine provided by C. O'Reilly.
-C
- CALL RGTOHS( CR, CG, CB, HUE, SAT, LIGHT)
- CALL JCOTBL(IWKID,1,CVALUE,HUE,SAT,LIGHT)
- ENDIF
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_MAIL)
- IF(GLFLAG)CALL IZSCOR(IWKID,ICI,CR,CG,CB)
-#endif
-*
- END
-#endif
diff --git a/src/graflib/higz/idi3000/iselnt.F b/src/graflib/higz/idi3000/iselnt.F
deleted file mode 100644
index d60dde1..0000000
--- a/src/graflib/higz/idi3000/iselnt.F
+++ /dev/null
@@ -1,169 +0,0 @@
-*
-* $Id: iselnt.F,v 1.1.1.1 1996/02/14 13:10:29 mclareni Exp $
-*
-* $Log: iselnt.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:29 mclareni
-* Higz
-*
-*
-#if defined(CERNLIB_DI3000)
-#include "higz/pilot.h"
-*CMZ : 1.21/03 01/06/94 13.29.03 by O.Couet
-*-- Author :
- SUBROUTINE ISELNT(NT)
-*.===========>
-*.
-*. Purpose:
-*. --------
-*. Select a normalization transformation as the
-*. transformation.
-*.
-*. DI-3000 access:
-*. ---------------
-*. ***** ***** *****
-*.
-*..==========> (O.Couet, H.Johnstad, L.Roberts)
-#include "higz/hint.inc"
-#include "higz/hiflag.inc"
-#include "higz/hiatt.inc"
-#include "higz/di3seg.inc"
-*.______________________________________
-*
- SCALE=1.
- IF(REDIT.NE.0.)SCALE=REDIT
-*
-#if !defined(CERNLIB_NTC)
- CALL IZGNT(NT,IFIND,IAWV,IPRIO,IHPRIO)
-*
-* Transformation No 0
-*
- IF(NT.EQ.0)THEN
- NT0PRI=IHPRIO+1
- RWXMIN=0.
- RWYMIN=0.
- RWXMAX=1.
- RWYMAX=1.
- RVXMIN=0.
- RVYMIN=0.
- RVXMAX=1.
- RVYMAX=1.
- IF(GFLAG)THEN
- IF(SEGOPN)THEN
- CALL JCLOSE
- SEGOPN=.FALSE.
- ENDIF
- CALL JWINDO(RWXMIN
- +, RWXMAX
- +, RWYMIN
- +, RWYMAX)
- CALL JVPORT(RVXMIN*SCALE-(RDWXMI*REDIT)
- +, RVXMAX*SCALE-(RDWXMI*REDIT)
- +, RVYMIN*SCALE-(RDWYMI*REDIT)
- +, RVYMAX*SCALE-(RDWYMI*REDIT))
- ENDIF
- GOTO 10
- ENDIF
-*
-* NT exits in the main transformation storage
-*
- IF(IFIND.NE.0)THEN
- RWXMIN=WNVPST(IAWV)
- RWYMIN=WNVPST(IAWV+2)
- RWXMAX=WNVPST(IAWV+1)
- RWYMAX=WNVPST(IAWV+3)
- RVXMIN=WNVPST(IAWV+4)
- RVYMIN=WNVPST(IAWV+6)
- RVXMAX=WNVPST(IAWV+5)
- RVYMAX=WNVPST(IAWV+7)
- NTSTOR(IFIND)=IHPRIO+1
- IF(GFLAG)THEN
- IF(SEGOPN)THEN
- CALL JCLOSE
- SEGOPN=.FALSE.
- ENDIF
- CALL JWINDO(RWXMIN
- +, RWXMAX
- +, RWYMIN
- +, RWYMAX)
- CALL JVPORT(RVXMIN*SCALE-(RDWXMI*REDIT)
- +, RVXMAX*SCALE-(RDWXMI*REDIT)
- +, RVYMIN*SCALE-(RDWYMI*REDIT)
- +, RVYMAX*SCALE-(RDWYMI*REDIT))
- ENDIF
-*
-* NT does not exit in the main transformation storage
-*
- ELSE
- RWXMIN=0.
- RWYMIN=0.
- RWXMAX=1.
- RWYMAX=1.
- RVXMIN=0.
- RVYMIN=0.
- RVXMAX=1.
- RVYMAX=1.
- IF(GFLAG)THEN
- IF(SEGOPN)THEN
- CALL JCLOSE
- SEGOPN=.FALSE.
- ENDIF
- CALL JWINDO(RWXMIN
- +, RWXMAX
- +, RWYMIN
- +, RWYMAX)
- CALL JVPORT(RVXMIN*SCALE-(RDWXMI*REDIT)
- +, RVXMAX*SCALE-(RDWXMI*REDIT)
- +, RVYMIN*SCALE-(RDWYMI*REDIT)
- +, RVYMAX*SCALE-(RDWYMI*REDIT))
- ENDIF
- NBNT=NTSTOR(1)
- IF(NBNT+1.GT.NBNTMX)THEN
- CALL IGERR('Too many normalisation transformation','ISELNT')
- RETURN
- ENDIF
- NTSTOR(2*NBNT+2)=NT
- NTSTOR(2*NBNT+3)=IHPRIO+1
- WNVPST(8*NBNT+1)=0.
- WNVPST(8*NBNT+2)=1.
- WNVPST(8*NBNT+3)=0.
- WNVPST(8*NBNT+4)=1.
- WNVPST(8*NBNT+5)=0.
- WNVPST(8*NBNT+6)=1.
- WNVPST(8*NBNT+7)=0.
- WNVPST(8*NBNT+8)=1.
- NTSTOR(1)=NTSTOR(1)+1
- ENDIF
-*
- 10 CONTINUE
-#endif
-#if defined(CERNLIB_NTC)
- IF(IGNSCU(NT).EQ.0)CALL IGNCRE(NT)
- CALL IGNGET(I0,I1,IHPRIO
- +, RWXMIN,RWXMAX,RWYMIN,RWYMAX
- +, RVXMIN,RVXMAX,RVYMIN,RVYMAX,I3D)
- CALL IGNSPR(IHPRIO+1)
- IF(GFLAG)THEN
- IF(SEGOPN)THEN
- CALL JCLOSE
- SEGOPN=.FALSE.
- ENDIF
- CALL JWINDO(RWXMIN
- +, RWXMAX
- +, RWYMIN
- +, RWYMAX)
- CALL JVPORT(RVXMIN*SCALE-(RDWXMI*REDIT)
- +, RVXMAX*SCALE-(RDWXMI*REDIT)
- +, RVYMIN*SCALE-(RDWYMI*REDIT)
- +, RVYMAX*SCALE-(RDWYMI*REDIT))
- ENDIF
- IF(I3D.NE.0)CALL IGSVIE
-*
-#endif
-#if (defined(CERNLIB_ZEBRA)||defined(CERNLIB_PSCRIPT)||defined(CERNLIB_MAIL))&&(!defined(CERNLIB_3D))
- IF(GLFLAG)CALL IZSELN(NT)
-#endif
- INTR=NT
- CALL ISCLIP(ICLIP)
-*
- END
-#endif
diff --git a/src/graflib/higz/idi3000/isfaci.F b/src/graflib/higz/idi3000/isfaci.F
deleted file mode 100644
index db916be..0000000
--- a/src/graflib/higz/idi3000/isfaci.F
+++ /dev/null
@@ -1,77 +0,0 @@
-*
-* $Id: isfaci.F,v 1.1.1.1 1996/02/14 13:10:29 mclareni Exp $
-*
-* $Log: isfaci.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:29 mclareni
-* Higz
-*
-*
-#if defined(CERNLIB_DI3000)
-#include "higz/pilot.h"
-*CMZ : 1.07/00 29/05/89 12.16.42 by O.Couet
-*-- Author :
- SUBROUTINE ISFACI(ICOLI)
-*.===========>
-*.
-*. Purpose:
-*. --------
-*. Set the polygon interior color and intensity attributes.
-*.
-*. DI-3000 access:
-*. ---------------
-*. CALL JPIDEX (CCOLOR, CINTEN)
-*.
-*. Parameters:
-*. -----------
-*. CCOLOR [ INTEGER; Input ]
-*.
-*. - The new value for the polygon interior color.
-*.
-*. NOTE : CCOLOR must be in the range 0...32767.
-*.
-*. CINTEN [ INTEGER; Input ]
-*.
-*. - The new value for the polygon interior intensity.
-*.
-*. NOTE : CINTEN must be in the range 0...32767.
-*.
-*..==========> (O.Couet, H.Johnstad, L.Roberts)
-#include "higz/hiatt.inc"
-#if defined(CERNLIB_ZEBRA)
-#include "higz/hicode.inc"
-#endif
-#include "higz/hiflag.inc"
-#include "higz/di3seg.inc"
- INTEGER CCOLOR, RANGEC(2)
- INTEGER STYLE
- INTEGER MAP(0:7)
- DATA MAP / 9, 0, 1, 2, 4, 5, 6, 3 /
- DATA RANGEC /0, 32767/
-*.______________________________________
-*
- IFACI=ICOLI
- IF (GFLAG) THEN
-C
-C Perform GKS-->DI3000 mapping for color indices 0-7.
-C
- IF((ICOLI.GE.0).AND.(ICOLI.LE.7))THEN
- CCOLOR=MAP(ICOLI)
- ELSE
- CCOLOR=ICOLI
- ENDIF
- IF((CCOLOR.LT.RANGEC(1)).OR.(CCOLOR.GT.RANGEC(2))) CCOLOR=0
- CALL J1IGET (11, STYLE)
- CALL J1IGET (13, CINTEN)
- IF (.NOT. SEGOPN) THEN
- CALL JOPEN
- SEGOPN=.TRUE.
- ENDIF
- IF (STYLE .NE. 1) CALL JPINTR (1)
- CALL JPIDEX (CCOLOR, CINTEN)
- ENDIF
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_MAIL)
- IF(GLFLAG)CALL IZATT(IFACCO)
-#endif
-*
- END
-#endif
diff --git a/src/graflib/higz/idi3000/isfais.F b/src/graflib/higz/idi3000/isfais.F
deleted file mode 100644
index 65c8eac..0000000
--- a/src/graflib/higz/idi3000/isfais.F
+++ /dev/null
@@ -1,69 +0,0 @@
-*
-* $Id: isfais.F,v 1.1.1.1 1996/02/14 13:10:29 mclareni Exp $
-*
-* $Log: isfais.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:29 mclareni
-* Higz
-*
-*
-#if defined(CERNLIB_DI3000)
-#include "higz/pilot.h"
-*CMZ : 1.08/00 29/09/89 10.21.04 by O.Couet
-*-- Author :
- SUBROUTINE ISFAIS(INTS)
-*.===========>
-*.
-*. Purpose:
-*. --------
-*. Set the interior style attribute.
-*.
-*. DI-3000 access:
-*. ---------------
-*. CALL JPINTR (CVALUE)
-*.
-*. Parameters:
-*. -----------
-*. CVALUE [ INTEGER; Input ]
-*.
-*. - The new value for the polygon interior style.
-*.
-*. NOTE : CVALUE must be in the range 0...32767.
-*.
-*..==========> (O.Couet, H.Johnstad, L.Roberts)
-#include "higz/hiatt.inc"
-#if defined(CERNLIB_ZEBRA)
-#include "higz/hicode.inc"
-#endif
-#include "higz/hiflag.inc"
-#include "higz/di3seg.inc"
-*.______________________________________
-*
- IF((INTS.LT.0).OR.(INTS.GT.3))THEN
- CALL IGERR('Fill area interior style must be > -1 and < 4'
- +, 'ISFAIS')
- RETURN
- ENDIF
- IFAIS=INTS
- IF (GFLAG) THEN
- IF (.NOT. SEGOPN) THEN
- CALL JOPEN
- SEGOPN=.TRUE.
- ENDIF
- CALL JPEDGE(0)
- IF (INTS.EQ.0) THEN
- CALL JPINTR(0)
- ELSE
- CALL JPINTR(1)
- IF (INTS.EQ.1) THEN
- CALL ISFASI(47)
- ELSE
- CALL ISFASI(IFASI)
- ENDIF
- ENDIF
- ENDIF
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_MAIL)
- IF(GLFLAG)CALL IZATT(IFAICO)
-#endif
-*
- END
-#endif
diff --git a/src/graflib/higz/idi3000/isfasi.F b/src/graflib/higz/idi3000/isfasi.F
deleted file mode 100644
index a8f0216..0000000
--- a/src/graflib/higz/idi3000/isfasi.F
+++ /dev/null
@@ -1,83 +0,0 @@
-*
-* $Id: isfasi.F,v 1.1.1.1 1996/02/14 13:10:29 mclareni Exp $
-*
-* $Log: isfasi.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:29 mclareni
-* Higz
-*
-*
-#if defined(CERNLIB_DI3000)
-#include "higz/pilot.h"
-*CMZ : 1.07/01 20/07/89 10.12.07 by O.Couet
-*-- Author :
- SUBROUTINE ISFASI(ISTYL)
-*.===========>
-*.
-*. Purpose:
-*. --------
-*. Set the polygon interior style attribute, color
-*. and intensity.
-*.
-*. DI-3000 access:
-*. ---------------
-*. CALL JPINTR (CVALUE)
-*.
-*. Parameters:
-*. -----------
-*. CVALUE [ INTEGER; Input ]
-*.
-*. - The new value for the polygon interior style.
-*. style is reset to CVALUE.
-*.
-*. NOTE : CVALUE must be in the range 0...32767.
-*.
-*. The styles are:
-*.
-*. 0 - empty (the polygon is not filled)
-*. 1 - the polygon is solid filled using the current
-*. polygon interior index values (JPIDEX).
-*. 2..32767 - the index of a device dependent pattern to be
-*. used for filling the polygon.
-*.
-*. NOTE : The polygon edge style is set by JPEDGE.
-*.
-*. NOTE : JBEGIN sets the deafult interior style to 0.
-*.
-*..==========> (O.Couet, H.Johnstad, L.Roberts)
-#include "higz/hiatt.inc"
-#if defined(CERNLIB_ZEBRA)
-#include "higz/hicode.inc"
-#endif
-#include "higz/hiflag.inc"
-#include "higz/di3seg.inc"
- INTEGER CVALUE, CCOLOR, STYLE
- INTEGER MAP(20)
- DATA MAP / 44, 43, 45, 46,
- + 41, 35, 42, 36,
- + 32, 31, 33, 34,
- + 29, 23, 30, 24,
- + 20, 19, 21, 22/
-*.______________________________________
-*
- IFASI=ISTYL
- IF (GFLAG) THEN
- IF (.NOT. SEGOPN) THEN
- CALL JOPEN
- SEGOPN=.TRUE.
- ENDIF
- IF ((ISTYL.LE.-101).AND.(ISTYL.GE.-120)) THEN
- CVALUE = MAP(ABS(ISTYL)-100)
- ELSE
- CVALUE = ABS(MOD(ISTYL,48))
- ENDIF
- CALL J1IGET(11, STYLE)
- IF (STYLE.NE.1) CALL JPINTR(1)
- CALL J1IGET(12, CCOLOR)
- CALL JPIDEX (CCOLOR, CVALUE)
- ENDIF
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_MAIL)
- IF(GLFLAG)CALL IZATT(IFASCO)
-#endif
-*
- END
-#endif
diff --git a/src/graflib/higz/idi3000/isln.F b/src/graflib/higz/idi3000/isln.F
deleted file mode 100644
index 196d5b3..0000000
--- a/src/graflib/higz/idi3000/isln.F
+++ /dev/null
@@ -1,68 +0,0 @@
-*
-* $Id: isln.F,v 1.1.1.1 1996/02/14 13:10:29 mclareni Exp $
-*
-* $Log: isln.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:29 mclareni
-* Higz
-*
-*
-#if defined(CERNLIB_DI3000)
-#include "higz/pilot.h"
-*CMZ : 1.07/01 14/09/89 11.10.48 by O.Couet
-*-- Author :
- SUBROUTINE ISLN(LTYPE)
-*.===========>
-*.
-*. Purpose:
-*. --------
-*. Set the linestyle primitive attribute.
-*.
-*. DI-3000 access:
-*. ---------------
-*. CALL JLSTYL (CVALUE)
-*.
-*. Parameters:
-*. -----------
-*. CVALUE [ INTEGER; Input ]
-*.
-*. - The new value for the linestyle.
-*.
-*. NOTE : CVALUE must be in the range 0...32767.
-*.
-*..==========> (O.Couet, H.Johnstad, L.Roberts)
-#include "higz/hiatt.inc"
-#if defined(CERNLIB_ZEBRA)
-#include "higz/hicode.inc"
-#endif
-#include "higz/hiflag.inc"
-#include "higz/di3seg.inc"
- INTEGER VALUE
-*.______________________________________
-*
- ILN=LTYPE
- IF (LTYPE.EQ.1) THEN
- VALUE = 0
- ELSE IF (LTYPE.EQ.2) THEN
- VALUE = 2
- ELSE IF (LTYPE.EQ.3) THEN
- VALUE = 1
- ELSE IF (LTYPE.EQ.4) THEN
- VALUE = 3
- ELSE IF ((LTYPE.GE.12).AND.(LTYPE.LE.15)) THEN
- VALUE = 0
- ELSE
- VALUE = ABS(MOD(LTYPE,32768))
- ENDIF
- IF (GFLAG) THEN
- IF (.NOT. SEGOPN) THEN
- CALL JOPEN
- SEGOPN=.TRUE.
- ENDIF
- CALL JLSTYL (VALUE)
- ENDIF
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_MAIL)
- IF(GLFLAG)CALL IZATT(ILNCO)
-#endif
-*
- END
-#endif
diff --git a/src/graflib/higz/idi3000/islwsc.F b/src/graflib/higz/idi3000/islwsc.F
deleted file mode 100644
index efbad21..0000000
--- a/src/graflib/higz/idi3000/islwsc.F
+++ /dev/null
@@ -1,67 +0,0 @@
-*
-* $Id: islwsc.F,v 1.1.1.1 1996/02/14 13:10:29 mclareni Exp $
-*
-* $Log: islwsc.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:29 mclareni
-* Higz
-*
-*
-#if defined(CERNLIB_DI3000)
-#include "higz/pilot.h"
-*CMZ : 1.07/01 26/06/89 11.03.38 by O.Couet
-*-- Author :
- SUBROUTINE ISLWSC(WIDTH)
-*.===========>
-*.
-*. Purpose:
-*. --------
-*. Set the linewidth primitive attribute.
-*.
-*. DI-3000 access:
-*. ---------------
-*. CALL JLWIDE (CVALUE)
-*.
-*. Parameters:
-*. -----------
-*. CVALUE [ INTEGER; Input ]
-*.
-*. - The new value for the linewidth.
-*.
-*. *NOTE* : CVALUE must be in the range 0...32767.
-*. Default linewidth = 16383 (midrange)
-*.
-*..==========> (O.Couet, H.Johnstad, L.Roberts)
-#include "higz/hiatt.inc"
-#if defined(CERNLIB_ZEBRA)
-#include "higz/hicode.inc"
-#endif
-#include "higz/hiflag.inc"
-#include "higz/di3seg.inc"
- INTEGER CVALUE, MIDRNG, RANGE(2)
- DATA RANGE(1), RANGE(2), MIDRNG /0, 32767, 16383/
-*.______________________________________
-*
- RLWSC=WIDTH
- IF (GFLAG) THEN
- IF (WIDTH.LE.1.0) THEN
- CVALUE = INT(WIDTH*FLOAT(MIDRNG))
- ELSE
- CVALUE = MIDRNG + INT(0.25*(WIDTH-1.0)*FLOAT(MIDRNG-1))
- ENDIF
- IF (CVALUE.LT.RANGE(1)) THEN
- CVALUE = RANGE(1)
- ELSE IF (CVALUE.GT.RANGE(2)) THEN
- CVALUE = RANGE(2)
- ENDIF
- IF (.NOT. SEGOPN) THEN
- CALL JOPEN
- SEGOPN=.TRUE.
- ENDIF
- CALL JLWIDE (CVALUE)
- ENDIF
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_MAIL)
- IF(GLFLAG)CALL IZATT(ILWSCO)
-#endif
-*
- END
-#endif
diff --git a/src/graflib/higz/idi3000/ismk.F b/src/graflib/higz/idi3000/ismk.F
deleted file mode 100644
index b8c490e..0000000
--- a/src/graflib/higz/idi3000/ismk.F
+++ /dev/null
@@ -1,63 +0,0 @@
-*
-* $Id: ismk.F,v 1.1.1.1 1996/02/14 13:10:29 mclareni Exp $
-*
-* $Log: ismk.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:29 mclareni
-* Higz
-*
-*
-#if defined(CERNLIB_DI3000)
-#include "higz/pilot.h"
-*CMZ : 1.07/00 29/05/89 12.18.25 by O.Couet
-*-- Author :
- SUBROUTINE ISMK(MTYPE)
-*.===========>
-*.
-*. Purpose:
-*. --------
-*. Set the marker symbol.
-*.
-*. DI-3000 access:
-*. ---------------
-*. CALL JCMARK (CVALUE)
-*.
-*. Parameters:
-*. -----------
-*. CVALUE [ INTEGER; Input ]
-*.
-*. - The new value for the marker symbol.
-*.
-*. *NOTE* : CVALUE must be in the range 1...32767.
-*. *NOTE* : The marker SIZE cannot be changed in DI-3000.
-*.
-*. Marker numbers 1..5 are the same on all graphics devices:
-*.
-*. 1 - point or dot .
-*. 2 - plus sign +
-*. 3 - asterisk *
-*. 4 - capital letter O
-*. 5 - capital letter X
-*.
-*..==========> (O.Couet, H.Johnstad, L.Roberts)
-#include "higz/hiatt.inc"
-#if defined(CERNLIB_ZEBRA)
-#include "higz/hicode.inc"
-#endif
-#include "higz/hiflag.inc"
-#include "higz/di3seg.inc"
-*.______________________________________
-*
- IMK=MTYPE
- IF (GFLAG) THEN
- IF (.NOT. SEGOPN) THEN
- CALL JOPEN
- SEGOPN=.TRUE.
- ENDIF
- CALL JCMARK(MTYPE)
- ENDIF
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_MAIL)
- IF(GLFLAG)CALL IZATT(IMKCO)
-#endif
-*
- END
-#endif
diff --git a/src/graflib/higz/idi3000/ismksc.F b/src/graflib/higz/idi3000/ismksc.F
deleted file mode 100644
index cc26465..0000000
--- a/src/graflib/higz/idi3000/ismksc.F
+++ /dev/null
@@ -1,48 +0,0 @@
-*
-* $Id: ismksc.F,v 1.1.1.1 1996/02/14 13:10:29 mclareni Exp $
-*
-* $Log: ismksc.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:29 mclareni
-* Higz
-*
-*
-#if defined(CERNLIB_DI3000)
-#include "higz/pilot.h"
-*CMZ : 1.06/06 09/03/89 15.50.20 by O.Couet
-*-- Author :
- SUBROUTINE ISMKSC(RMSCF)
-*.===========>
-*.
-*. Purpose:
-*. --------
-*. Set the marker scale factor.
-*.
-*. DI-3000 access:
-*. ---------------
-*. The marker SIZE cannot be changed in DI-3000.
-*. See JCMARK
-*.
-*. Parameters:
-*. -----------
-*. No parameters.
-*.
-*..==========> (O.Couet, H.Johnstad, L.Roberts)
-#include "higz/hiatt.inc"
-#if defined(CERNLIB_ZEBRA)
-#include "higz/hicode.inc"
-#endif
-#include "higz/hiflag.inc"
-*.______________________________________
-*
- IF(RMSCF.EQ.RMKSC)RETURN
-*
-* The marker size cannot be changed in DI-3000
-* But this marker size is usefull fo the HIGZ markers
-*
- RMKSC=RMSCF
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_MAIL)
- IF(GLFLAG)CALL IZATT(IMKSCO)
-#endif
-*
- END
-#endif
diff --git a/src/graflib/higz/idi3000/isplci.F b/src/graflib/higz/idi3000/isplci.F
deleted file mode 100644
index 1f08482..0000000
--- a/src/graflib/higz/idi3000/isplci.F
+++ /dev/null
@@ -1,79 +0,0 @@
-*
-* $Id: isplci.F,v 1.1.1.1 1996/02/14 13:10:29 mclareni Exp $
-*
-* $Log: isplci.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:29 mclareni
-* Higz
-*
-*
-#if defined(CERNLIB_DI3000)
-#include "higz/pilot.h"
-*CMZ : 1.16/08 10/12/92 09.30.04 by O.Couet
-*-- Author :
- SUBROUTINE ISPLCI(ICOLI)
-*.===========>
-*.
-*. Purpose:
-*. --------
-*. Set color primitive attribute
-*.
-*. DI-3000 access:
-*. ---------------
-*. CALL JCOLOR (CVALUE)
-*.
-*. Parameters:
-*. -----------
-*.
-*. CVALUE [ INTEGER; Input ]
-*.
-*. - The new value for the color index.
-*.
-*. NOTE : CVALUE must be in the range 0...32767.
-*.
-*. 0 - "Nornal" for the device
-*. 1 - Red
-*. 2 - Green
-*. 3 - Yellow
-*. 4 - Blue
-*. 5 - Magenta
-*. 6 - Cyan
-*. 7 - White
-*. 8 - Black
-*. 9 - Complement of the "normal" device color
-*.
-*..==========> (O.Couet, H.Johnstad, L.Roberts)
-#include "higz/hiatt.inc"
-#if defined(CERNLIB_ZEBRA)
-#include "higz/hicode.inc"
-#endif
-#include "higz/hiflag.inc"
-#include "higz/di3seg.inc"
- INTEGER CVALUE, RANGE(2)
- INTEGER MAP(0:7)
- DATA MAP / 9, 0, 1, 2, 4, 3, 5, 6 /
- DATA RANGE(1), RANGE(2) /0, 32767/
-*.______________________________________
-*
- IPLCI=ICOLI
- IF (GFLAG) THEN
-C
-C Perform GKS-->DI3000 mapping for color indices 0-7.
-C
- IF((ICOLI.GE.0).AND.(ICOLI.LE.7))THEN
- CVALUE=MAP(ICOLI)
- ELSE
- CVALUE=ICOLI
- ENDIF
- IF((CVALUE.LT.RANGE(1)).OR.(CVALUE.GT.RANGE(2))) CVALUE=0
- IF (.NOT. SEGOPN) THEN
- CALL JOPEN
- SEGOPN=.TRUE.
- ENDIF
- CALL JCOLOR (CVALUE)
- ENDIF
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_MAIL)
- IF(GLFLAG)CALL IZATT(IPLCCO)
-#endif
-*
- END
-#endif
diff --git a/src/graflib/higz/idi3000/ispmci.F b/src/graflib/higz/idi3000/ispmci.F
deleted file mode 100644
index 634ee65..0000000
--- a/src/graflib/higz/idi3000/ispmci.F
+++ /dev/null
@@ -1,60 +0,0 @@
-*
-* $Id: ispmci.F,v 1.1.1.1 1996/02/14 13:10:29 mclareni Exp $
-*
-* $Log: ispmci.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:29 mclareni
-* Higz
-*
-*
-#if defined(CERNLIB_DI3000)
-#include "higz/pilot.h"
-*CMZ : 1.06/07 04/04/89 10.37.31 by O.Couet
-*-- Author :
- SUBROUTINE ISPMCI(ICOLI)
-*.===========>
-*.
-*. Purpose:
-*. --------
-*. Set the polymarker color index.
-*.
-*. DI-3000 access:
-*. ---------------
-*. In DI-3000 one sets current/color primitive attribute.
-*. Use JCOLOR as in HIGZ routine ISCR
-*.
-*..==========> (O.Couet, H.Johnstad, L.Roberts)
-#include "higz/hiatt.inc"
-#if defined(CERNLIB_ZEBRA)
-#include "higz/hicode.inc"
-#endif
-#include "higz/hiflag.inc"
-#include "higz/di3seg.inc"
- INTEGER CVALUE, RANGE(2)
- INTEGER MAP(0:7)
- DATA MAP / 9, 0, 1, 2, 4, 5, 6, 3 /
- DATA RANGE(1), RANGE(2) /0, 32767/
-*.______________________________________
-*
- IPMCI=ICOLI
- IF (GFLAG) THEN
-C
-C Perform GKS-->DI3000 mapping for color indeces 0-7.
-C
- IF((ICOLI.GE.0).AND.(ICOLI.LE.7))THEN
- CVALUE=MAP(ICOLI)
- ELSE
- CVALUE=ICOLI
- ENDIF
- IF((CVALUE.LT.RANGE(1)).OR.(CVALUE.GT.RANGE(2))) CVALUE=0
- IF (.NOT. SEGOPN) THEN
- CALL JOPEN
- SEGOPN=.TRUE.
- ENDIF
- CALL JCOLOR (CVALUE)
- ENDIF
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_MAIL)
- IF(GLFLAG)CALL IZATT(IPMCCO)
-#endif
-*
- END
-#endif
diff --git a/src/graflib/higz/idi3000/istxal.F b/src/graflib/higz/idi3000/istxal.F
deleted file mode 100644
index f3b4131..0000000
--- a/src/graflib/higz/idi3000/istxal.F
+++ /dev/null
@@ -1,86 +0,0 @@
-*
-* $Id: istxal.F,v 1.1.1.1 1996/02/14 13:10:29 mclareni Exp $
-*
-* $Log: istxal.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:29 mclareni
-* Higz
-*
-*
-#if defined(CERNLIB_DI3000)
-#include "higz/pilot.h"
-*CMZ : 1.07/00 29/05/89 12.18.49 by O.Couet
-*-- Author :
- SUBROUTINE ISTXAL(JTXALH,JTXALV)
-*.===========>
-*.
-*. Purpose:
-*. --------
-*. Set current character string justification text attribute.
-*.
-*. DI-3000 access:
-*. ---------------
-*. CALL JJUST (CHORIZ, CVERT)
-*.
-*. Parameters:
-*. -----------
-*. CHORIZ [ INTEGER; Input ]
-*.
-*. - The horizontal character string justification of subsequent
-*. text primitives within the currently OPEN segment.
-*.
-*. *NOTE* : CHORIZ must be in the range 1 to 3.
-*.
-*. CVERT [ INTEGER; Input ]
-*.
-*. - The vertical character string justification of subsequent
-*. text primitives within the currently OPEN segment.
-*.
-*. *NOTE* : CVERT must be in the range 1 to 3.
-*.
-*..==========> (O.Couet, H.Johnstad, L.Roberts)
-#include "higz/hiatt.inc"
-#if defined(CERNLIB_ZEBRA)
-#include "higz/hicode.inc"
-#endif
-#include "higz/hiflag.inc"
- INTEGER CHORIZ, CVERT
-#include "higz/di3seg.inc"
-*.______________________________________
-*
- ITXALH=JTXALH
- ITXALV=JTXALV
- IF (GFLAG) THEN
-*
-* Convert GKS text alignment numbers into DI3000 text alignment numbers.
-*
- IF (JTXALH.EQ.0) THEN
- CHORIZ = 1
- ELSE
- CHORIZ = JTXALH
- ENDIF
- IF (JTXALV.EQ.0) THEN
- CVERT = 1
- ELSE IF (JTXALV.EQ.1) THEN
- CVERT = 3
- ELSE IF (JTXALV.EQ.2) THEN
- CVERT = 3
- ELSE IF (JTXALV.EQ.3) THEN
- CVERT = 2
- ELSE IF (JTXALV.EQ.4) THEN
- CVERT = 1
- ELSE IF (JTXALV.EQ.5) THEN
- CVERT = 1
- ENDIF
- IF (.NOT. SEGOPN) THEN
- CALL JOPEN
- SEGOPN=.TRUE.
- ENDIF
- CALL JJUST (CHORIZ,CVERT)
- ENDIF
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_MAIL)
- ITXALG=10*JTXALH+JTXALV
- IF(GLFLAG)CALL IZATT(ITXACO)
-#endif
-*
- END
-#endif
diff --git a/src/graflib/higz/idi3000/istxci.F b/src/graflib/higz/idi3000/istxci.F
deleted file mode 100644
index be103f0..0000000
--- a/src/graflib/higz/idi3000/istxci.F
+++ /dev/null
@@ -1,61 +0,0 @@
-*
-* $Id: istxci.F,v 1.1.1.1 1996/02/14 13:10:29 mclareni Exp $
-*
-* $Log: istxci.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:29 mclareni
-* Higz
-*
-*
-#if defined(CERNLIB_DI3000)
-#include "higz/pilot.h"
-*CMZ : 1.06/07 04/04/89 10.38.12 by O.Couet
-*-- Author :
- SUBROUTINE ISTXCI(ICOLI)
-*.===========>
-*.
-*. Purpose:
-*. --------
-*. Set the text color index
-*.
-*. DI-3000 access:
-*. ---------------
-*. DI-3000 sets current/color primitive attribute.
-*. Use JCOLOR via HIGZ routine ISCR.
-*. CVALUE must be in the range 0...32767
-*.
-*..==========> (O.Couet, H.Johnstad, L.Roberts)
-#include "higz/hiatt.inc"
-#if defined(CERNLIB_ZEBRA)
-#include "higz/hicode.inc"
-#endif
-#include "higz/hiflag.inc"
-#include "higz/di3seg.inc"
- INTEGER CVALUE, RANGE(2)
- INTEGER MAP(0:7)
- DATA MAP / 9, 0, 1, 2, 4, 5, 6, 3 /
- DATA RANGE(1), RANGE(2) /0, 32767/
-*.______________________________________
-*
- ITXCI=ICOLI
- IF (GFLAG) THEN
-C
-C Perform GKS-->DI3000 mapping for color indices 0-7.
-C
- IF((ICOLI.GE.0).AND.(ICOLI.LE.7))THEN
- CVALUE=MAP(ICOLI)
- ELSE
- CVALUE=ICOLI
- ENDIF
- IF((CVALUE.LT.RANGE(1)).OR.(CVALUE.GT.RANGE(2))) CVALUE=0
- IF (.NOT. SEGOPN) THEN
- CALL JOPEN
- SEGOPN=.TRUE.
- ENDIF
- CALL JCOLOR (CVALUE)
- ENDIF
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_MAIL)
- IF(GLFLAG)CALL IZATT(ITXCCO)
-#endif
-*
- END
-#endif
diff --git a/src/graflib/higz/idi3000/istxfp.F b/src/graflib/higz/idi3000/istxfp.F
deleted file mode 100644
index cb1137c..0000000
--- a/src/graflib/higz/idi3000/istxfp.F
+++ /dev/null
@@ -1,108 +0,0 @@
-*
-* $Id: istxfp.F,v 1.1.1.1 1996/02/14 13:10:30 mclareni Exp $
-*
-* $Log: istxfp.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:30 mclareni
-* Higz
-*
-*
-#if defined(CERNLIB_DI3000)
-#include "higz/pilot.h"
-*CMZ : 1.07/01 14/09/89 11.13.34 by O.Couet
-*-- Author :
- SUBROUTINE ISTXFP(JJFONT,JPREC)
-*.===========>
-*.
-*. Purpose:
-*. --------
-*. Set character font text attribute.
-*.
-*. DI-3000 access:
-*. ---------------
-*. CALL JFONT (CVALUE)
-*.
-*. Parameters:
-*. -----------
-*. CVALUE [ INTEGER; Input ]
-*.
-*. - The new value for the character font.
-*.
-*. *NOTE* : CVALUE must be in the range 1...32767.
-*. GKS: CFONT must be in the range 1...30
-*. GKS: CPREC must be in the range 1...4
-*.
-*..==========> (O.Couet, H.Johnstad, L.Roberts)
-#include "higz/hiatt.inc"
-#if defined(CERNLIB_ZEBRA)
-#include "higz/hicode.inc"
-#endif
-#include "higz/hiflag.inc"
-#include "higz/di3seg.inc"
- INTEGER CFONT
-*.______________________________________
-*
- IFONT=JJFONT
- IPREC=JPREC
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_MAIL)
- IFTPR=10*JJFONT+ISIGN(1,JJFONT)*JPREC
- IF(GLFLAG)CALL IZATT(ITXFCO)
-#endif
- IF (JJFONT.LT.0) THEN
- IF (JJFONT.EQ.-1) THEN
- CFONT=1
- ELSEIF (JJFONT.EQ.-2) THEN
- CFONT=3
- ELSEIF (JJFONT.EQ.-3) THEN
- CFONT=5
- ELSEIF (JJFONT.EQ.-4) THEN
- CFONT=7
- ELSEIF (JJFONT.EQ.-5) THEN
- CFONT=6
- ELSEIF (JJFONT.EQ.-6) THEN
- CFONT=8
- ELSEIF (JJFONT.EQ.-101) THEN
- CFONT=2
- ELSEIF (JJFONT.EQ.-102) THEN
- CFONT=4
- ELSEIF (JJFONT.EQ.-103) THEN
- CFONT=6
- ELSEIF (JJFONT.EQ.-104) THEN
- CFONT=8
- ELSEIF (JJFONT.EQ.-105) THEN
- CFONT=6
- ELSEIF (JJFONT.EQ.-106) THEN
- CFONT=8
- ELSEIF (JJFONT.EQ.-107) THEN
- CFONT=11
- ELSEIF (JJFONT.EQ.-108) THEN
- CFONT=12
- ELSEIF (JJFONT.EQ.-109) THEN
- CFONT=15
- ELSEIF (JJFONT.EQ.-110) THEN
- CFONT=17
- ELSEIF (JJFONT.EQ.-201) THEN
- CFONT=1
- ELSEIF (JJFONT.EQ.-202) THEN
- CFONT=3
- ELSEIF (JJFONT.EQ.-203) THEN
- CFONT=5
- ELSEIF (JJFONT.EQ.-204) THEN
- CFONT=7
- ELSE
- CFONT=1
- ENDIF
- ELSEIF ((JJFONT.EQ.0).AND.(JPREC.EQ.2)) THEN
- RETURN
- ELSE
- CFONT=MAX(MOD(JJFONT,32768),1)
- ENDIF
- IF (GFLAG) THEN
- IF (.NOT. SEGOPN) THEN
- CALL JOPEN
- SEGOPN=.TRUE.
- ENDIF
- CALL JFONT (CFONT)
- ENDIF
-*
- END
-#endif
diff --git a/src/graflib/higz/idi3000/isvp.F b/src/graflib/higz/idi3000/isvp.F
deleted file mode 100644
index 7594ad1..0000000
--- a/src/graflib/higz/idi3000/isvp.F
+++ /dev/null
@@ -1,135 +0,0 @@
-*
-* $Id: isvp.F,v 1.1.1.1 1996/02/14 13:10:30 mclareni Exp $
-*
-* $Log: isvp.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:30 mclareni
-* Higz
-*
-*
-#if defined(CERNLIB_DI3000)
-#include "higz/pilot.h"
-*CMZ : 1.22/03 06/01/95 11.28.36 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE ISVP(NT,XX1,XX2,YY1,YY2)
-*.===========>
-*.
-*. Purpose:
-*. --------
-*. Define the boundaries of the virtual coordinate system viewport
-*.
-*. DI-3000 access:
-*. ---------------
-*. CALL JVPORT (VXMIN, VMAX, VYMIN, VYMAX)
-*.
-*. Parameters:
-*. -----------
-*. VXMIN, VXMAX [ REAL; Input ]
-*.
-*. - The minimum and maximum virtual coordinate system viewport
-*. boundaries in the X-direction
-*.
-*. VYMIN, VYMAX [ REAL; Input ]
-*.
-*. - The minimum and maximum virtual coordinate system viewport
-*. boundaries in the Y-direction
-*.
-*. NOTE: One of the two boundary pairs must be equal (-1.0, 1.0)
-*.
-*..==========> (O.Couet, H.Johnstad, L.Roberts)
-#include "higz/hint.inc"
-#include "higz/hiflag.inc"
-#include "higz/hiatt.inc"
-#include "higz/di3seg.inc"
-*.______________________________________
-*
-* Verify the viewport parameters
-*
- X1 = XX1
- X2 = XX2
- Y1 = YY1
- Y2 = YY2
- IF((X1.LT.0).OR.(X1.GT.1)
- + .OR.
- + (X2.LT.0).OR.(X2.GT.1)
- + .OR.
- + (Y1.LT.0).OR.(Y1.GT.1)
- + .OR.
- + (Y2.LT.0).OR.(Y2.GT.1)
- + .OR.
- + (Y1.GE.Y2).OR.(X1.GE.X2))THEN
- CALL IGERR('Invalid viewport definition','ISVP')
- RETURN
- ENDIF
-*
- IF(NT.EQ.0)RETURN
-*
- SCALE = 1.
- IF(REDIT.NE.0.)SCALE = REDIT
-#if !defined(CERNLIB_NTC)
-*
- CALL IZGNT(NT,IFIND,IAWV,IPRIO,IHPRIO)
-*
-* NT exits in the main transformation storage
-*
- IF(IFIND.NE.0)THEN
- IF((INTR.EQ.NT).AND.GFLAG)THEN
- IF(GFLAG)THEN
- IF(SEGOPN) THEN
- CALL JCLOSE
- SEGOPN = .FALSE.
- ENDIF
- CALL JVPORT (X1,X2,Y1,Y2)
- ENDIF
- RVXMIN = X1
- RVYMIN = Y1
- RVXMAX = X2
- RVYMAX = Y2
- ENDIF
- WNVPST(IAWV+4) = X1
- WNVPST(IAWV+5) = X2
- WNVPST(IAWV+6) = Y1
- WNVPST(IAWV+7) = Y2
-*
-* NT does not exit in the main transformation storage
-*
- ELSE
- NBNT = NTSTOR(1)
- IF(NBNT+1.GT.NBNTMX)THEN
- CALL IGERR('Too many normalisation transformation','ISVP')
- RETURN
- ENDIF
- NTSTOR(2*NBNT+2) = NT
- WNVPST(8*NBNT+1) = 0.
- WNVPST(8*NBNT+2) = 1.
- WNVPST(8*NBNT+3) = 0.
- WNVPST(8*NBNT+4) = 1.
- WNVPST(8*NBNT+5) = X1
- WNVPST(8*NBNT+6) = X2
- WNVPST(8*NBNT+7) = Y1
- WNVPST(8*NBNT+8) = Y2
- NTSTOR(1) = NTSTOR(1)+1
- ENDIF
-#endif
-#if defined(CERNLIB_NTC)
- IF(IGNSCU(NT).NE.0)THEN
- IF((INTR.EQ.NT).AND.GFLAG)THEN
- IF(GFLAG)THEN
- IF(SEGOPN) THEN
- CALL JCLOSE
- SEGOPN = .FALSE.
- ENDIF
- CALL JVPORT (X1,X2,Y1,Y2)
- ENDIF
- RVXMIN = X1
- RVYMIN = Y1
- RVXMAX = X2
- RVYMAX = Y2
- ENDIF
- ELSE
- CALL IGNCRE(NT)
- ENDIF
- CALL IGNSVP(X1,X2,Y1,Y2)
-#endif
-*
- END
-#endif
diff --git a/src/graflib/higz/idi3000/iswkvp.F b/src/graflib/higz/idi3000/iswkvp.F
deleted file mode 100644
index 43c06bd..0000000
--- a/src/graflib/higz/idi3000/iswkvp.F
+++ /dev/null
@@ -1,55 +0,0 @@
-*
-* $Id: iswkvp.F,v 1.1.1.1 1996/02/14 13:10:30 mclareni Exp $
-*
-* $Log: iswkvp.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:30 mclareni
-* Higz
-*
-*
-#if defined(CERNLIB_DI3000)
-#include "higz/pilot.h"
-*CMZ : 1.06/03 21/12/88 18.27.21 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE ISWKVP(WKID,X1,X2,Y1,Y2)
-*.===========>
-*.
-*. Purpose:
-*. --------
-*. Set the workstation transformation window.
-*.
-*. DI-3000 access:
-*. ---------------
-*. CALL JVPORT (VXMIN, VXMAX, VYMIN, VXMAX)
-*.
-*. VXMIN, VXMAX [ REAL; Input ]
-*. - The minimum and maximum virtual coordinate system
-*. vieport boundaries in the X-direction
-*.
-*. VYMIN, VYMAX [ REAL; Input ]
-*. - The minimum and maximum virtual coordinate system
-*. vieport boundaries in the Y-direction
-*.
-*.
-*..==========> (O.Couet, H.Johnstad, L.Roberts)
-#include "higz/hiflag.inc"
-#include "higz/hiatt.inc"
- INTEGER WKID
-#include "higz/di3seg.inc"
-*.______________________________________
-*
- RDVXMI=X1
- RDVXMA=X2
- RDVYMI=Y1
- RDVYMA=Y2
- IF(IGIWTY(WKID).LT.0)RETURN
-*
- IF(GFLAG)THEN
- IF (SEGOPN) THEN
- CALL JCLOSE
- SEGOPN = .FALSE.
- ENDIF
- CALL JDEVVP (WKID, X1, X2, Y1, Y2)
- ENDIF
-*
- END
-#endif
diff --git a/src/graflib/higz/idi3000/iswkwn.F b/src/graflib/higz/idi3000/iswkwn.F
deleted file mode 100644
index 7e9b9ec..0000000
--- a/src/graflib/higz/idi3000/iswkwn.F
+++ /dev/null
@@ -1,73 +0,0 @@
-*
-* $Id: iswkwn.F,v 1.1.1.1 1996/02/14 13:10:30 mclareni Exp $
-*
-* $Log: iswkwn.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:30 mclareni
-* Higz
-*
-*
-#if defined(CERNLIB_DI3000)
-#include "higz/pilot.h"
-*CMZ : 1.06/03 21/12/88 18.27.21 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE ISWKWN(WKID,X1,X2,Y1,Y2)
-*.===========>
-*.
-*. Purpose:
-*. --------
-*. Set the workstation transformation window
-*.
-*. DI-3000 access:
-*. ---------------
-*. CALL JDEVWN (DSPDEV, VXMIN, VXMAX, VYMIN, VYMAX)
-*.
-*. DSPDEV
-*. - The identifer of the display device for
-*. which the device window is being defined
-*.
-*. VXMIN, VXMAX
-*. - The minimum and maximum devcie window boundaries
-*. in the X-direction in virtual coordinates.
-*. VXMIN and VXMAX must be in the range:
-*. (-1.0 .le. XMIN .le. XMAX .le 1.0)
-*.
-*. VYMIN, VYMAX
-*. - The minimum and maximum devcie window boundaries
-*. in the Y-direction in virtual coordinates.
-*. VYMIN and VYMAX must be in the range:
-*. (-1.0 .le. YMIN .le. YMAY .le 1.0)
-*.
-*..==========> (O.Couet, H.Johnstad, L.Roberts)
-#include "higz/hiflag.inc"
-#include "higz/hiatt.inc"
- INTEGER WKID
-#include "higz/di3seg.inc"
-*.______________________________________
-*
- IF((X1.LT.0.).OR.(X1.GT.1.)
- + .OR.
- + (X2.LT.0.).OR.(X2.GT.1.)
- + .OR.
- + (Y1.LT.0.).OR.(Y1.GT.1.)
- + .OR.
- + (Y2.LT.0.).OR.(Y2.GT.1.))THEN
- CALL IGERR('Bad window or viewport size','ISWKWN')
- RETURN
- ENDIF
-*
- RDWXMI=X1
- RDWXMA=X2
- RDWYMI=Y1
- RDWYMA=Y2
- IF(IGIWTY(WKID).LT.0)RETURN
-*
- IF(GFLAG)THEN
- IF (SEGOPN) THEN
- CALL JCLOSE
- SEGOPN = .FALSE.
- ENDIF
- CALL JDEVWN (WKID, X1, X2, Y1, Y2)
- ENDIF
-*
- END
-#endif
diff --git a/src/graflib/higz/idi3000/iswn.F b/src/graflib/higz/idi3000/iswn.F
deleted file mode 100644
index 49bdcc7..0000000
--- a/src/graflib/higz/idi3000/iswn.F
+++ /dev/null
@@ -1,104 +0,0 @@
-*
-* $Id: iswn.F,v 1.1.1.1 1996/02/14 13:10:30 mclareni Exp $
-*
-* $Log: iswn.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:30 mclareni
-* Higz
-*
-*
-#if defined(CERNLIB_DI3000)
-#include "higz/pilot.h"
-*CMZ : 1.21/03 01/06/94 13.31.40 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE ISWN(NT,XX1,XX2,YY1,YY2)
-*.===========>
-*.
-*. Purpose:
-*. --------
-*. Set the window coordinates of the transformation NT
-*.
-*. DI-3000 access:
-*. ---------------
-*. ***** ***** *****
-*.
-*..==========> (O.Couet, H.Johnstad, L.Roberts)
-#include "higz/hint.inc"
-#include "higz/hiflag.inc"
-#include "higz/hiatt.inc"
-#include "higz/di3seg.inc"
-*.______________________________________
-*
- IF(NT.EQ.0)RETURN
-*
- X1 = XX1
- X2 = XX2
- Y1 = YY1
- Y2 = YY2
-*
-#if !defined(CERNLIB_NTC)
- CALL IZGNT(NT,IFIND,IAWV,IPRIO,IHPRIO)
-*
-* NT exits in the main transformation storage
-*
- IF(IFIND.NE.0)THEN
- IF((INTR.EQ.NT).AND.GFLAG)THEN
- IF (GFLAG) THEN
- IF(SEGOPN) THEN
- CALL JCLOSE
- SEGOPN = .FALSE.
- ENDIF
- CALL JWINDO (X1, X2, Y1, Y2)
- ENDIF
- RWXMIN = X1
- RWYMIN = Y1
- RWXMAX = X2
- RWYMAX = Y2
- ENDIF
- WNVPST(IAWV) = X1
- WNVPST(IAWV+1) = X2
- WNVPST(IAWV+2) = Y1
- WNVPST(IAWV+3) = Y2
-*
-* NT does not exit in the main transformation storage
-*
- ELSE
- NBNT=NTSTOR(1)
- IF(NBNT+1.GT.NBNTMX)THEN
- CALL IGERR('Too many normalisation transformation','ISWN')
- RETURN
- ENDIF
- NTSTOR(2*NBNT+2) = NT
- WNVPST(8*NBNT+1) = X1
- WNVPST(8*NBNT+2) = X2
- WNVPST(8*NBNT+3) = Y1
- WNVPST(8*NBNT+4) = Y2
- WNVPST(8*NBNT+5) = 0.
- WNVPST(8*NBNT+6) = 1.
- WNVPST(8*NBNT+7) = 0.
- WNVPST(8*NBNT+8) = 1.
- NTSTOR(1) = NTSTOR(1)+1
- ENDIF
-#endif
-#if defined(CERNLIB_NTC)
- IF(IGNSCU(NT).NE.0)THEN
- IF((INTR.EQ.NT).AND.GFLAG)THEN
- IF(GFLAG)THEN
- IF(SEGOPN) THEN
- CALL JCLOSE
- SEGOPN = .FALSE.
- ENDIF
- CALL JWINDO (X1, X2, Y1, Y2)
- ENDIF
- RWXMIN = X1
- RWYMIN = Y1
- RWXMAX = X2
- RWYMAX = Y2
- ENDIF
- ELSE
- CALL IGNCRE(NT)
- ENDIF
- CALL IGNSWN(X1,X2,Y1,Y2)
-#endif
-*
- END
-#endif
diff --git a/src/graflib/higz/idi3000/itx.F b/src/graflib/higz/idi3000/itx.F
deleted file mode 100644
index 0b4fd85..0000000
--- a/src/graflib/higz/idi3000/itx.F
+++ /dev/null
@@ -1,96 +0,0 @@
-*
-* $Id: itx.F,v 1.1.1.1 1996/02/14 13:10:30 mclareni Exp $
-*
-* $Log: itx.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:30 mclareni
-* Higz
-*
-*
-#if defined(CERNLIB_DI3000)
-#include "higz/pilot.h"
-*CMZ : 1.19/06 27/08/93 13.43.36 by O.Couet
-*-- Author :
- SUBROUTINE ITX(X,Y,CHARS)
-*.===========>
-*.
-*. Purpose:
-*. --------
-*. Output a graphics arts quality text string as an output primnitive
-*.
-*. DI-3000 access:
-*. ---------------
-*. CALL JHSTRG (STRING)
-*.
-*. Parameters:
-*. -----------
-*. STRING [ CHARACTER; Input ]
-*.
-*. - The literal string to be output as a graphic arts quality text
-*. primitive.
-*.
-*. *NOTE* : The current position is unchanged when JHSTRG returns
-*. to the calling program.
-*.
-*..==========> (O.Couet, H.Johnstad, L.Roberts)
-#include "higz/hiflag.inc"
-#include "higz/hiatt.inc"
- CHARACTER*(*) CHARS
- CHARACTER*1 CHOPT
- LOGICAL ZFSAV,PFSAV
-#include "higz/di3seg.inc"
-*.______________________________________
-*
- ILEN=LENOCC(CHARS)
- IF(ILEN.EQ.0)RETURN
- IF(GFLAG)THEN
- CALL IGSG(0)
- IF((IFONT.EQ.0.AND.IPREC.EQ.2).OR.
- + (IFONT.LT.0.AND.IFONT.GT.-25.AND.IPREC.EQ.1))THEN
- IF((ITXALH.EQ.0).OR.(ITXALH.EQ.1))CHOPT='L'
- IF(ITXALH.EQ.2)THEN
- CHOPT = 'C'
- ELSEIF(ITXALH.EQ.3)THEN
- CHOPT = 'R'
- ELSE
- CHOPT = 'L'
- ENDIF
- IF((ITXALV.EQ.2).OR.(ITXALV.EQ.1))THEN
- YY = Y-RCHH*COS((3.14159/180.)*RANGLE)
- XX = X+RCHH*SIN((3.14159/180.)*RANGLE)
- ELSEIF(ITXALV.EQ.3)THEN
- YY = Y-(RCHH/2.)*COS((3.14159/180.)*RANGLE)
- XX = X+(RCHH/2.)*SIN((3.14159/180.)*RANGLE)
- ELSE
- YY = Y
- XX = X
- ENDIF
- ZFSAV = ZFLAG
- ZFLAG = .FALSE.
- PFSAV = PFLAG
- PFLAG = .FALSE.
- GLFLAG = (ZFLAG.OR.PFLAG.OR.MFLAG)
- CALL IGTEXT(XX,YY,CHARS,RCHH,RANGLE,CHOPT)
- ZFLAG = ZFSAV
- PFLAG = PFSAV
- GLFLAG = (ZFLAG.OR.PFLAG.OR.MFLAG)
- ELSE
- IF (.NOT. SEGOPN) THEN
- CALL JOPEN
- SEGOPN=.TRUE.
- ENDIF
- CALL JMOVE (X, Y)
- IF (IPREC.EQ.0) THEN
- CALL J1STRG (CHARS (1:ILEN))
- ELSEIF (IPREC.EQ.1) THEN
- CALL J2STRG (CHARS (1:ILEN))
- ELSE
- CALL JHSTRG (CHARS (1:ILEN))
- ENDIF
- ENDIF
- ENDIF
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_PSCRIPT)||defined(CERNLIB_MAIL)
- IF(GLFLAG)CALL IZTX(X,Y,CHARS(1:ILEN))
-#endif
-*
- END
-#endif
diff --git a/src/graflib/higz/idi3000/iuwk.F b/src/graflib/higz/idi3000/iuwk.F
deleted file mode 100644
index 31d6be9..0000000
--- a/src/graflib/higz/idi3000/iuwk.F
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: iuwk.F,v 1.1.1.1 1996/02/14 13:10:30 mclareni Exp $
-*
-* $Log: iuwk.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:30 mclareni
-* Higz
-*
-*
-#if defined(CERNLIB_DI3000)
-#include "higz/pilot.h"
-*CMZ : 1.12/16 13/08/91 16.29.43 by O.Couet
-*-- Author :
- SUBROUTINE IUWK(IWKID,IRFLG)
- IF (IRFLG.NE.0) CALL JUPDAT
- END
-#endif
diff --git a/src/graflib/higz/idi3000/rgtohs.F b/src/graflib/higz/idi3000/rgtohs.F
deleted file mode 100644
index 7cdd7a6..0000000
--- a/src/graflib/higz/idi3000/rgtohs.F
+++ /dev/null
@@ -1,85 +0,0 @@
-*
-* $Id: rgtohs.F,v 1.1.1.1 1996/02/14 13:10:30 mclareni Exp $
-*
-* $Log: rgtohs.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:30 mclareni
-* Higz
-*
-*
-#if defined(CERNLIB_DI3000)
-#include "higz/pilot.h"
-*CMZ : 1.06/03 21/12/88 18.27.22 by O.Couet
-*-- Author :
- SUBROUTINE RGTOHS (RED, GREEN, BLUE, HUE, SATUR, LIGHT)
-*.===========>
-*.
-*. Convert RGB to HSL
-*.
-*..==========> (L.Roberts)
-C
-C
- REAL RED, GREEN, BLUE
- INTEGER HUE, SATUR, LIGHT
-C
- REAL RNORM, GNORM, BNORM, MINVAL, MAXVAL, MSUM, MDIFF
- REAL RLIGHT, RHUE, RSATUR
-C
-C ***** CONVERT RGB TO HSL
-C
-C
-C ***** Find the maximum and minimum of the RGB values.
-C
- MINVAL = MIN (RED, GREEN, BLUE)
- MAXVAL = MAX (RED, GREEN, BLUE)
-C
-C ***** Find the normalized RGB values.
-C
- RNORM = 0.0
- GNORM = 0.0
- BNORM = 0.0
- MDIFF = MAXVAL - MINVAL
- MSUM = MAXVAL + MINVAL
- IF (MAXVAL .EQ. MINVAL) GO TO 1000
- RNORM = (MAXVAL - RED) / MDIFF
- GNORM = (MAXVAL - GREEN) / MDIFF
- BNORM = (MAXVAL - BLUE) / MDIFF
-C
- 1000 CONTINUE
-C
-C ***** Calculate the lightness.
-C
- RLIGHT = MSUM / 2.0
-C
-C ***** If the maximum and minimum RGB values are equal,
-C ***** then the saturation and hue are both 0.
-C
- IF (MAXVAL .NE. MINVAL) GO TO 2000
- RSATUR = 0.0
- RHUE = 0.0
- GO TO 3000
-C
- 2000 CONTINUE
-C
-C ***** Calculate the saturation.
-C
- IF (RLIGHT .LE. 0.5) RSATUR = MDIFF / MSUM
- IF (RLIGHT .GT. 0.5) RSATUR = MDIFF / (2.0 - MSUM)
-C
-C ***** Calculate the hue.
-C
- IF (RED .EQ. MAXVAL) RHUE = 60.0 * (2.0 + BNORM - GNORM)
- IF (GREEN .EQ. MAXVAL) RHUE = 60.0 * (4.0 + RNORM - BNORM)
- IF (BLUE .EQ. MAXVAL) RHUE = 60.0 * (6.0 + GNORM - RNORM)
-C
- 3000 CONTINUE
- IF (RHUE .GT. 360.0) RHUE = RHUE - 360.0
-C
- HUE = IFIX(RHUE)
- LIGHT = IFIX(RLIGHT * 32767.0)
- SATUR = IFIX(RSATUR * 32767.0)
-C
-99999 CONTINUE
-C
- RETURN
- END
-#endif
diff --git a/src/graflib/higz/ifalco/Imakefile b/src/graflib/higz/ifalco/Imakefile
deleted file mode 100644
index 29ad38c..0000000
--- a/src/graflib/higz/ifalco/Imakefile
+++ /dev/null
@@ -1,15 +0,0 @@
-DoIncludePackage(higz)
-#include "pilot.h"
-
-#if defined(CERNLIB_FALCO)
-SRCS_F= ifclip.F ifclr.F ifdraw.F ifdrw9.F ifinit.F ifmov6.F \ @@\
- ifmov9.F ifmove.F ifpl.F ifput.F ifscur.F ifswin.F \ @@\
- ifvwin.F
-
-#if defined(CERNLIB_VAX) || defined(CERNLIB_IBM)
-SRCS_F:= $(SRCS_F) ifput1.F
-#endif
-
-#endif
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/graflib/higz/ifalco/ifclip.F b/src/graflib/higz/ifalco/ifclip.F
deleted file mode 100644
index 327eaec..0000000
--- a/src/graflib/higz/ifalco/ifclip.F
+++ /dev/null
@@ -1,62 +0,0 @@
-*
-* $Id: ifclip.F,v 1.2 1996/03/07 17:38:07 couet Exp $
-*
-* $Log: ifclip.F,v $
-* Revision 1.2 1996/03/07 17:38:07 couet
-* IFALCO selection was wrong
-*
-* Revision 1.1.1.1 1996/02/14 13:10:30 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.20/08 18/01/94 14.28.19 by O.Couet
-*-- Author :
- SUBROUTINE IFCLIP(X1,Y1,X2,Y2,FLAG)
-#include "higz/hifc2.inc"
- LOGICAL FLAG
- IF (X1.LT.X2) THEN
- IF (X1.LT.XMIN) THEN
- Y1=Y1+(XMIN-X1)*(Y2-Y1)/(X2-X1)
- X1=XMIN
- END IF
- IF (XMAX.LT.X2) THEN
- Y2=Y2-(X2-XMAX)*(Y2-Y1)/(X2-X1)
- X2=XMAX
- END IF
- END IF
- IF (X2.LT.X1) THEN
- IF (X2.LT.XMIN) THEN
- Y2=Y2+(XMIN-X2)*(Y1-Y2)/(X1-X2)
- X2=XMIN
- END IF
- IF (XMAX.LT.X1) THEN
- Y1=Y1-(X1-XMAX)*(Y1-Y2)/(X1-X2)
- X1=XMAX
- END IF
- END IF
- FLAG=.TRUE.
- IF (Y1.LT.YMIN.AND.Y2.LT.YMIN) RETURN
- IF (YMAX.LT.Y1.AND.YMAX.LT.Y2) RETURN
- FLAG=.FALSE.
- IF (Y1.LT.Y2) THEN
- IF (Y1.LT.YMIN) THEN
- X1=X1+(YMIN-Y1)*(X2-X1)/(Y2-Y1)
- Y1=YMIN
- END IF
- IF (YMAX.LT.Y2) THEN
- X2=X2-(Y2-YMAX)*(X2-X1)/(Y2-Y1)
- Y2=YMAX
- END IF
- END IF
- IF (Y2.LT.Y1) THEN
- IF (Y2.LT.YMIN) THEN
- X2=X2+(YMIN-Y2)*(X1-X2)/(Y1-Y2)
- Y2=YMIN
- END IF
- IF (YMAX.LT.Y1) THEN
- X1=X1-(Y1-YMAX)*(X1-X2)/(Y1-Y2)
- Y1=YMAX
- END IF
- END IF
- END
diff --git a/src/graflib/higz/ifalco/ifclr.F b/src/graflib/higz/ifalco/ifclr.F
deleted file mode 100644
index b812f33..0000000
--- a/src/graflib/higz/ifalco/ifclr.F
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: ifclr.F,v 1.2 1996/03/07 17:38:08 couet Exp $
-*
-* $Log: ifclr.F,v $
-* Revision 1.2 1996/03/07 17:38:08 couet
-* IFALCO selection was wrong
-*
-* Revision 1.1.1.1 1996/02/14 13:10:30 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.13/09 11/12/91 18.16.59 by O.Couet
-*-- Author : O.Couet 11/12/91
- SUBROUTINE IFCLR(IWTYP)
- IF(IWTYP.EQ.7878)THEN
- CALL IFPUT(29)
- CALL IFPUT(27)
- CALL IFPUT(12)
- CALL IFPUT(0)
- CALL IFPUT(31)
- CALL IFPUT(24)
- CALL IFPUT(0)
- ELSEIF(IWTYP.EQ.7879)THEN
- CALL IGSG(0)
- CALL IFPUT(27)
- CALL IFPUT(12)
- CALL IFPUT(0)
- CALL IGSA(0)
- ENDIF
- END
diff --git a/src/graflib/higz/ifalco/ifdraw.F b/src/graflib/higz/ifalco/ifdraw.F
deleted file mode 100644
index d7fc569..0000000
--- a/src/graflib/higz/ifalco/ifdraw.F
+++ /dev/null
@@ -1,43 +0,0 @@
-*
-* $Id: ifdraw.F,v 1.2 1996/03/07 17:38:08 couet Exp $
-*
-* $Log: ifdraw.F,v $
-* Revision 1.2 1996/03/07 17:38:08 couet
-* IFALCO selection was wrong
-*
-* Revision 1.1.1.1 1996/02/14 13:10:30 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.20/08 18/01/94 14.31.23 by O.Couet
-*-- Author : O.Couet 11/01/91
- SUBROUTINE IFDRAW(X,Y)
-#include "higz/hifc2.inc"
-#include "higz/hifc3.inc"
- LOGICAL FLAG1
- LOGICAL FLAG2,FLAG3
- XS=XL
- YS=YL
- FLAG2=FLAG1
- XL=X
- YL=Y
- FLAG1=X.LT.XMIN.OR.XMAX.LT.X.OR.Y.LT.YMIN.OR.YMAX.LT.Y
- IF (FLAG2.AND.FLAG1) THEN
- IF (XS.LT.XMIN.AND.X.LT.XMIN) RETURN
- IF (XMAX.LT.XS.AND.XMAX.LT.X) RETURN
- IF (YS.LT.YMIN.AND.Y.LT.YMIN) RETURN
- IF (YMAX.LT.YS.AND.YMAX.LT.Y) RETURN
- END IF
- XT=X
- YT=Y
- FLAG3=.FALSE.
- IF (FLAG2.OR.FLAG1) CALL IFCLIP(XS,YS,XT,YT,FLAG3)
- IF (FLAG3) RETURN
- IF (FLAG2) CALL IFMOV6(XS,YS)
- IX=IFIX(FX*(XT-XMIN)+.5)+IXMIN
- IY=IFIX(FY*(YT-YMIN)+.5)+IYMIN
- CALL IFDRW9(IX,IY)
- XD=IX
- YD=IY
- END
diff --git a/src/graflib/higz/ifalco/ifdrw9.F b/src/graflib/higz/ifalco/ifdrw9.F
deleted file mode 100644
index 33fc33b..0000000
--- a/src/graflib/higz/ifalco/ifdrw9.F
+++ /dev/null
@@ -1,57 +0,0 @@
-*
-* $Id: ifdrw9.F,v 1.2 1996/03/07 17:38:09 couet Exp $
-*
-* $Log: ifdrw9.F,v $
-* Revision 1.2 1996/03/07 17:38:09 couet
-* IFALCO selection was wrong
-*
-* Revision 1.1.1.1 1996/02/14 13:10:30 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.20/08 18/01/94 14.33.00 by O.Couet
-*-- Author :
- SUBROUTINE IFDRW9(IX,IY)
-#include "higz/hifc1.inc"
-#include "higz/hifc6.inc"
- DATA IYLL,IXHL,IYXL/-1,-1,-1/
- IF (IX.LT.0) RETURN
- IF (IY.LT.0) RETURN
- IF (131071.LT.IX) RETURN
- IF (ISFL.EQ.0) RETURN
- IXN=IX/128
- IYN=IY/128
- IXH=IXN/32
- IXL=IXN-32*IXH
- IYH=IYN/32
- IYL=IYN-32*IYH
- CALL IFPUT(IYH+32)
- IF (ISCR.EQ.4) THEN
- IYX=4*((IY-128*IYN)/32)+(IX-128*IXN)/32
- IF (IYX.NE.IYXL) CALL IFPUT(IYX+96)
- IF (IYX.NE.IYXL.OR.IYL.NE.IYLL.OR.IXH.NE.IXHL) THEN
- CALL IFPUT(IYL+96)
- IYLL=IYL
- END IF
- IYXL=IYX
- ELSE
- IF (IYL.NE.IYLL.OR.IXH.NE.IXHL) THEN
- CALL IFPUT(IYL+96)
- IYLL=IYL
- END IF
- END IF
- IF (IXH.NE.IXHL) THEN
- CALL IFPUT(IXH+32)
- IXHL=IXH
- END IF
- CALL IFPUT(IXL+64)
- IF (240.LT.IPOUT) THEN
- CALL IFPUT(0)
- CALL IFPUT(29)
- CALL IFPUT(IYH+32)
- CALL IFPUT(IYL+96)
- CALL IFPUT(IXH+32)
- CALL IFPUT(IXL+64)
- END IF
- END
diff --git a/src/graflib/higz/ifalco/ifinit.F b/src/graflib/higz/ifalco/ifinit.F
deleted file mode 100644
index 0d2763c..0000000
--- a/src/graflib/higz/ifalco/ifinit.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: ifinit.F,v 1.2 1996/03/07 17:38:10 couet Exp $
-*
-* $Log: ifinit.F,v $
-* Revision 1.2 1996/03/07 17:38:10 couet
-* IFALCO selection was wrong
-*
-* Revision 1.1.1.1 1996/02/14 13:10:30 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.20/08 18/01/94 14.33.00 by O.Couet
-*-- Author :
- SUBROUTINE IFINIT
-#include "higz/hifc1.inc"
-#include "higz/hifc6.inc"
-#if defined(CERNLIB_VAX)
- CALL IFIOI
-#endif
- ISFL=1
- ISCR=0
- IPOUT=0
- CALL IFVWIN(0.,131071.,0.,100160.)
- CALL IFSWIN(0,131071,0,100160)
- END
diff --git a/src/graflib/higz/ifalco/ifmov6.F b/src/graflib/higz/ifalco/ifmov6.F
deleted file mode 100644
index 18bf6d6..0000000
--- a/src/graflib/higz/ifalco/ifmov6.F
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: ifmov6.F,v 1.2 1996/03/07 17:38:11 couet Exp $
-*
-* $Log: ifmov6.F,v $
-* Revision 1.2 1996/03/07 17:38:11 couet
-* IFALCO selection was wrong
-*
-* Revision 1.1.1.1 1996/02/14 13:10:31 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.20/08 18/01/94 14.28.19 by O.Couet
-*-- Author :
- SUBROUTINE IFMOV6(X,Y)
-#include "higz/hifc2.inc"
- IX=IFIX(FX*(X-XMIN)+.5)+IXMIN
- IY=IFIX(FY*(Y-YMIN)+.5)+IYMIN
- CALL IFMOV9(IX,IY)
- XD=IX
- YD=IY
- END
diff --git a/src/graflib/higz/ifalco/ifmov9.F b/src/graflib/higz/ifalco/ifmov9.F
deleted file mode 100644
index e23cecb..0000000
--- a/src/graflib/higz/ifalco/ifmov9.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: ifmov9.F,v 1.2 1996/03/07 17:38:12 couet Exp $
-*
-* $Log: ifmov9.F,v $
-* Revision 1.2 1996/03/07 17:38:12 couet
-* IFALCO selection was wrong
-*
-* Revision 1.1.1.1 1996/02/14 13:10:31 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.20/08 18/01/94 14.33.00 by O.Couet
-*-- Author :
- SUBROUTINE IFMOV9(IX,IY)
-#include "higz/hifc1.inc"
-#include "higz/hifc6.inc"
- MFL=1
- IF (ISFL.NE.0) CALL IFPUT(29)
- CALL IFDRW9(IX,IY)
- END
diff --git a/src/graflib/higz/ifalco/ifmove.F b/src/graflib/higz/ifalco/ifmove.F
deleted file mode 100644
index 1213441..0000000
--- a/src/graflib/higz/ifalco/ifmove.F
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: ifmove.F,v 1.2 1996/03/07 17:38:13 couet Exp $
-*
-* $Log: ifmove.F,v $
-* Revision 1.2 1996/03/07 17:38:13 couet
-* IFALCO selection was wrong
-*
-* Revision 1.1.1.1 1996/02/14 13:10:31 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.20/08 18/01/94 14.31.23 by O.Couet
-*-- Author :
- SUBROUTINE IFMOVE(X,Y)
-#include "higz/hifc2.inc"
-#include "higz/hifc3.inc"
- LOGICAL FLAG1
- XL=X
- YL=Y
- FLAG1=X.LT.XMIN.OR.XMAX.LT.X.OR.Y.LT.YMIN.OR.YMAX.LT.Y
- IF (FLAG1) RETURN
- CALL IFMOV6(X,Y)
- END
diff --git a/src/graflib/higz/ifalco/ifpl.F b/src/graflib/higz/ifalco/ifpl.F
deleted file mode 100644
index d6869be..0000000
--- a/src/graflib/higz/ifalco/ifpl.F
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: ifpl.F,v 1.2 1996/03/07 17:38:14 couet Exp $
-*
-* $Log: ifpl.F,v $
-* Revision 1.2 1996/03/07 17:38:14 couet
-* IFALCO selection was wrong
-*
-* Revision 1.1.1.1 1996/02/14 13:10:31 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.13/09 17/12/91 13.44.59 by O.Couet
-*-- Author : O.Couet 11/12/91
- SUBROUTINE IFPL(N,X,Y)
-#include "higz/hiatt.inc"
- DIMENSION X(*),Y(*)
- XFALCO=(RVXMIN+XRATIO*(X(1)-RWXMIN))
- YFALCO=(RVYMIN+YRATIO*(Y(1)-RWYMIN))
- CALL IFMOVE(XFALCO,YFALCO)
- DO 10 I=2,N
- XFALCO=(RVXMIN+XRATIO*(X(I)-RWXMIN))
- YFALCO=(RVYMIN+YRATIO*(Y(I)-RWYMIN))
- CALL IFDRAW(XFALCO,YFALCO)
- 10 CONTINUE
- CALL IFPUT(0)
- END
diff --git a/src/graflib/higz/ifalco/ifput.F b/src/graflib/higz/ifalco/ifput.F
deleted file mode 100644
index fe7b0bf..0000000
--- a/src/graflib/higz/ifalco/ifput.F
+++ /dev/null
@@ -1,42 +0,0 @@
-*
-* $Id: ifput.F,v 1.2 1996/03/07 17:38:15 couet Exp $
-*
-* $Log: ifput.F,v $
-* Revision 1.2 1996/03/07 17:38:15 couet
-* IFALCO selection was wrong
-*
-* Revision 1.1.1.1 1996/02/14 13:10:31 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.20/08 18/01/94 14.37.09 by O.Couet
-*-- Author :
- SUBROUTINE IFPUT(N)
-#include "higz/hifc6.inc"
-#if defined(CERNLIB_IBM)||defined(CERNLIB_VAX)
- LOGICAL*1 BOUT(256)
-#endif
-#if (!defined(CERNLIB_IBM))&&(!defined(CERNLIB_VAX))
- INTEGER BOUT(256)
-#endif
- SAVE BOUT
- IPOUT=IPOUT+1
- BOUT(IPOUT)=N
-#if defined(CERNLIB_IBM)
- IF (N.EQ.127) THEN
-* Ignore deletes
- BOUT(IPOUT)=27
- IPOUT=IPOUT+1
- BOUT(IPOUT)=63
- END IF
-#endif
-* If Char is <= 0 then we output the line.
- IF (N.GT.0) RETURN
- BOUT(IPOUT)=31
-* If Char = 0 then switch to alpha mode, else just output.
- IF (N.EQ.-1) IPOUT=IPOUT-1
- IF (2.LT.IPOUT) CALL IFPUT1(BOUT,IPOUT)
- BOUT(1)=29
- IPOUT=1
- END
diff --git a/src/graflib/higz/ifalco/ifput1.F b/src/graflib/higz/ifalco/ifput1.F
deleted file mode 100644
index 16a1edb..0000000
--- a/src/graflib/higz/ifalco/ifput1.F
+++ /dev/null
@@ -1,45 +0,0 @@
-*
-* $Id: ifput1.F,v 1.3 1996/03/12 08:29:23 cernlib Exp $
-*
-* $Log: ifput1.F,v $
-* Revision 1.3 1996/03/12 08:29:23 cernlib
-* Compile ifput1.F only on VAX and IBM.
-*
-* Revision 1.2 1996/03/07 17:38:16 couet
-* IFALCO selection was wrong
-*
-* Revision 1.1.1.1 1996/02/14 13:10:31 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.14/04 23/03/92 10.37.37 by Unknown
-*-- Author :
-#if defined(CERNLIB_VAX)
- SUBROUTINE IFPUT1(BOUT,IPOUT)
- LOGICAL*1 BOUT(256)
- INTEGER SYS$ASSIGN,SYS$QIOW,STAT(2)
- N=SYS$QIOW(,%VAL(ICHAN),%VAL(304),
- *%REF(STAT),,,%REF(BOUT),%VAL(IPOUT),,,,)
- RETURN
- ENTRY IFIOI
- N=SYS$ASSIGN('SYS$OUTPUT',ICHAN,,)
- END
-#endif
-#if defined(CERNLIB_IBM)
- SUBROUTINE IFPUT1(ICOUNT,BUFF)
- INTEGER BUFF(1)
- INTEGER*2 I1,I3,I4
- INTEGER*4 IT
- LOGICAL*1 LT(4),LBUFF(256)
- EQUIVALENCE (IT,LT(1))
- DO 10 I=1,ICOUNT
- IT=BUFF(I)
- LBUFF(I)=LT(4)
- 10 CONTINUE
- I1=2
- I3=ICOUNT
- CALL TIF71(I1,LBUFF,I3,I4)
- ISTAT=I4
- END
-#endif
diff --git a/src/graflib/higz/ifalco/ifscur.F b/src/graflib/higz/ifalco/ifscur.F
deleted file mode 100644
index 1c4170b..0000000
--- a/src/graflib/higz/ifalco/ifscur.F
+++ /dev/null
@@ -1,45 +0,0 @@
-*
-* $Id: ifscur.F,v 1.2 1996/03/07 17:38:18 couet Exp $
-*
-* $Log: ifscur.F,v $
-* Revision 1.2 1996/03/07 17:38:18 couet
-* IFALCO selection was wrong
-*
-* Revision 1.1.1.1 1996/02/14 13:10:31 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.20/09 21/01/94 09.41.48 by O.Couet
-*-- Author : John Clement 18/01/94
- SUBROUTINE IFSCUR(ICHR,XLOC,YLOC)
-#include "higz/hifc2.inc"
- CHARACTER*16 STR
- ICHR=0
-* Setup to find end of input
- STR=' '
-* Put into GIN mode
- CALL IFPUT(27)
- CALL IFPUT(26)
- CALL IFPUT(-1)
- ISIZ=0
-* Read the GIN string (Echoing is suppressed)
- READ(*,'(A)',END=99,ERR=99) STR
- 10 CONTINUE
-* IF <CR> pressed (Note it will be echoed now)
- IF (STR.EQ.' ') THEN
- READ(*,'(A)',END=99,ERR=99) STR(2:)
- 20 CONTINUE
- ENDIF
-* Find end of input
- ISIZ=INDEX(STR(2:),' ')
- IF (ISIZ.NE.5) RETURN
-* Now get workstation Viewport coordinates.
- XLOC=128*(32*MOD(ICHAR(STR(2:2)),32)+MOD(ICHAR(STR(3:3)),32))
- YLOC=128*(32*MOD(ICHAR(STR(4:4)),32)+MOD(ICHAR(STR(5:5)),32))
-* Now get Workstation window coordinates.
- XLOC=(XLOC-IXMIN)/FX+XMIN
- YLOC=(YLOC-IYMIN)/FY+YMIN
- ICHR=ICHAR(STR(1:1))
- 99 CALL IFPUT(0)
- END
diff --git a/src/graflib/higz/ifalco/ifswin.F b/src/graflib/higz/ifalco/ifswin.F
deleted file mode 100644
index 402d52b..0000000
--- a/src/graflib/higz/ifalco/ifswin.F
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: ifswin.F,v 1.2 1996/03/07 17:38:19 couet Exp $
-*
-* $Log: ifswin.F,v $
-* Revision 1.2 1996/03/07 17:38:19 couet
-* IFALCO selection was wrong
-*
-* Revision 1.1.1.1 1996/02/14 13:10:31 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.20/08 18/01/94 14.28.19 by O.Couet
-*-- Author :
- SUBROUTINE IFSWIN(N1,N2,N3,N4)
-#include "higz/hifc2.inc"
- IXMIN=N1
- IXMAX=N2
- IYMIN=N3
- IYMAX=N4
- FX=FLOAT(IXMAX-IXMIN)/(XMAX-XMIN)
- FY=FLOAT(IYMAX-IYMIN)/(YMAX-YMIN)
- END
diff --git a/src/graflib/higz/ifalco/ifvwin.F b/src/graflib/higz/ifalco/ifvwin.F
deleted file mode 100644
index f597951..0000000
--- a/src/graflib/higz/ifalco/ifvwin.F
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: ifvwin.F,v 1.2 1996/03/07 17:38:19 couet Exp $
-*
-* $Log: ifvwin.F,v $
-* Revision 1.2 1996/03/07 17:38:19 couet
-* IFALCO selection was wrong
-*
-* Revision 1.1.1.1 1996/02/14 13:10:31 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.20/08 18/01/94 14.28.19 by O.Couet
-*-- Author :
- SUBROUTINE IFVWIN(P1,P2,P3,P4)
-#include "higz/hifc2.inc"
- XMIN=P1
- XMAX=P2
- YMIN=P3
- YMAX=P4
- FX=FLOAT(IXMAX-IXMIN)/(XMAX-XMIN)
- FY=FLOAT(IYMAX-IYMIN)/(YMAX-YMIN)
- END
diff --git a/src/graflib/higz/ig/Imakefile b/src/graflib/higz/ig/Imakefile
deleted file mode 100644
index 766f3c4..0000000
--- a/src/graflib/higz/ig/Imakefile
+++ /dev/null
@@ -1,42 +0,0 @@
-DoIncludePackage(higz)
-#include "pilot.h"
-
-SRCS_F= ica.F igadid.F igarc.F igarc1.F igarc2.F igarc3.F \ @@\
- igarc4.F igasci.F igaxi0.F igaxi1.F igaxi2.F igaxi3.F igaxi4.F \ @@\
- igaxis.F igbox.F igcell.F igchwk.F igcles.F igcli1.F igclip.F \ @@\
- igcolm.F igconv.F igdate.F igdwk.F igelli.F igend.F igerr.F \ @@\
- igfa.F igfbox.F iggfin.F iggif.F ighatc.F ighcx.F ighcxy.F \ @@\
- ighis1.F ighist.F ighr01.F ightor.F iginit.F igiwin.F igiwty.F \ @@\
- iglbl.F iglev.F igloc.F igloc2.F igm100.F igmess.F \ @@\
- igmetn.F igparf.F igpave.F igphst.F igpick.F igpid.F \ @@\
- igpie.F igpkfa.F igpkpl.F igpkpm.F igpm.F igpxmp.F igq.F \ @@\
- igqwk.F igrap1.F igrap2.F igraph.F igrtoh.F \ @@\
- igset.F igset1.F igsrap.F igsse.F igstr.F igsvie.F igtab1.F \ @@\
- igtab2.F igtab3.F igtab4.F igtab5.F igtab6.F igtabl.F igtcch.F \ @@\
- igterm.F igtext.F igwkty.F igzset.F iml.F ipm4id.F \ @@\
- ipmid.F
-
-
-#ifndef CERNLIB_WINNT
-SRCS_F := $(SRCS_F) igxmes.F
-#endif
-
-#if !defined(CERNLIB_DI3000)
-SRCS_F := $(SRCS_F) igmeta.F igrng.F
-#endif
-
-#if defined(CERNLIB_X11)
-SRCS_F := $(SRCS_F) igobj.F igrsiz.F
-#endif
-
-
-#ifdef CERNLIB_NEXT
-SpecialFortranLibObjectRule(igtext,igtext,NullParameter,NullParameter)
-#endif
-
-#ifdef CERNLIB_HPUX
-SpecialFortranLibObjectRule(igwkty,igwkty,"-WF,-P" $(FDEBUGFLAGS),NullParameter)
-#endif
-
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/graflib/higz/ig/Imakefile.dgks b/src/graflib/higz/ig/Imakefile.dgks
deleted file mode 100644
index e11224b..0000000
--- a/src/graflib/higz/ig/Imakefile.dgks
+++ /dev/null
@@ -1,32 +0,0 @@
-DoIncludePackage(higz)
-#include "pilot.h"
-
-SRCS_F= ica.F igadid.F igarc.F igarc1.F igarc2.F igarc3.F \ @@\
- igarc4.F igasci.F igaxi0.F igaxi1.F igaxi2.F igaxi3.F igaxi4.F \ @@\
- igaxis.F igbox.F igcell.F igchwk.F igcles.F igcli1.F igclip.F \ @@\
- igcolm.F igconv.F igdate.F igdwk.F igelli.F igend.F igerr.F \ @@\
- igfa.F igfbox.F iggfin.F iggif.F ighatc.F ighcx.F ighcxy.F \ @@\
- ighis1.F ighist.F ighr01.F ightor.F iginit.F igiwin.F igiwty.F \ @@\
- iglbl.F iglev.F igloc.F igloc2.F igm100.F igmess.F \ @@\
- igmetn.F igparf.F igpave.F igphst.F igpick.F igpid.F \ @@\
- igpie.F igpkfa.F igpkpl.F igpkpm.F igpm.F igpxmp.F igq.F \ @@\
- igqwk.F igrap1.F igrap2.F igraph.F igrtoh.F \ @@\
- igset.F igset1.F igsrap.F igsse.F igstr.F igsvie.F igtab1.F \ @@\
- igtab2.F igtab3.F igtab4.F igtab5.F igtab6.F igtabl.F igtcch.F \ @@\
- igterm.F igtext.F igwkty.F igxmes.F igzset.F iml.F ipm4id.F \ @@\
- ipmid.F
-
-#if !defined(CERNLIB_DI3000)
-SRCS_F := $(SRCS_F) igmeta.F igrng.F
-#endif
-
-#if defined(CERNLIB_X11)
-SRCS_F := $(SRCS_F) igobj.F igrsiz.F
-#endif
-
-
-SubdirExtraLibraryTarget(NullParameter,NullParameter,NullParameter,dgks)
-
-VersionFortranObjectRule(dgks,NullParameter,-DCERNLIB_DECGKS)
-
-BuildNamedMakefileTarget(Makefile.dgks,Imakefile.dgks,-DCERNLIB_DECGKS)
diff --git a/src/graflib/higz/ig/ica.F b/src/graflib/higz/ig/ica.F
deleted file mode 100644
index 0bdeb55..0000000
--- a/src/graflib/higz/ig/ica.F
+++ /dev/null
@@ -1,80 +0,0 @@
-*
-* $Id: ica.F,v 1.1.1.1 1996/02/14 13:10:31 mclareni Exp $
-*
-* $Log: ica.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:31 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.18/08 04/06/93 15.09.57 by O.Couet
-*-- Author : O.Couet 04/06/93
- SUBROUTINE ICA(X1,X2,Y1,Y2,NX,NY,IV,CHOPT)
-*.===========>
-*.
-*. Draws a CELL array
-*.
-*. _Input parameters:
-*.
-*. REAL X1,Y1 : Left down corner (in WC).
-*. REAL X2,Y2 : Right up corner (in WC).
-*. INTEGER NX,NY : Array dimensions
-*. INTEGER IV(NX,NY) : Array to be drawn (array of colors)
-*. CHARACTER CHOPT : Option
-*. 'P' Pixel precision (IXCA is called).
-*.
-*..==========> (O.Couet)
-#if defined(CERNLIB_X11)
-#include "higz/hiatt.inc"
-#endif
- CHARACTER*(*) CHOPT
- DIMENSION IV(NX,NY)
-*.______________________________________
-*
-#if defined(CERNLIB_X11)
-#include "higz/hiwcdc.inc"
-#endif
-*
- IF(INDEX(CHOPT,'P').NE.0)THEN
-#if defined(CERNLIB_X11)
- DO 10 IWKNB=1,INOPWK
- IF(NODRFL(IWKNB))GOTO 10
- CALL IGSG(IWKNB)
- IX1 = IXWCDC(X1)
- IX2 = IXWCDC(X2)
- IY1 = IYWCDC(Y1)
- IY2 = IYWCDC(Y2)
- CALL IXCA(IX1,IX2,IY1,IY2,NX,NY,IV)
- 10 CONTINUE
-#endif
- ELSE
- CALL IGSET('FAIS',1.)
- CALL IGSET('BORD',0.)
- DX = (X2-X1)/NX
- DY = (Y2-Y1)/NY
- X1B = X1
- X2B = X1+DX
-*
- DO 30 I = 1, NX
- Y1B = Y1
- Y2B = Y1+DY
- ICOL = IV(I,1)
- CALL ISFACI(ICOL)
- DO 20 J = 2, NY
- IF(IV(I,J).EQ.ICOL)THEN
- Y2B = Y2B+DY
- ELSE
- CALL IGBOX(X1B,X2B,Y1B,Y2B)
- ICOL = IV(I,J)
- CALL ISFACI(ICOL)
- Y1B = Y2B
- Y2B = Y2B+DY
- ENDIF
- 20 CONTINUE
- CALL IGBOX(X1B,X2B,Y1B,Y2B)
- X1B = X2B
- X2B = X2B+DX
- 30 CONTINUE
- ENDIF
-*
- END
diff --git a/src/graflib/higz/ig/igadid.F b/src/graflib/higz/ig/igadid.F
deleted file mode 100644
index 1e403cf..0000000
--- a/src/graflib/higz/ig/igadid.F
+++ /dev/null
@@ -1,30 +0,0 @@
-*
-* $Id: igadid.F,v 1.1.1.1 1996/02/14 13:10:31 mclareni Exp $
-*
-* $Log: igadid.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:31 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.15/03 22/07/92 11.29.26 by O.Couet
-*-- Author : O.Couet 25/05/92
- SUBROUTINE IGADID(LEVEL,N,ID)
-*.===========>
-*.
-*..==========> (O.Couet)
-#include "higz/hipaw.inc"
-#include "higz/hicode.inc"
- DIMENSION ID(*)
-*.______________________________________
-*
- IF(LPICT.LT.0)RETURN
- IF(IZPUSH(N+1,0,0,'IGADID').NE.0)RETURN
- CALL IZSTCC(IMIDCO,INTPTR)
- IQ(LHI+INTPTR)=LEVEL
- DO 10 I=1,N
- IQ(LHI+INTPTR+I)=ID(I)
- 10 CONTINUE
- CALL IZINCI(N+1)
-*
- END
diff --git a/src/graflib/higz/ig/igarc.F b/src/graflib/higz/ig/igarc.F
deleted file mode 100644
index b6fb101..0000000
--- a/src/graflib/higz/ig/igarc.F
+++ /dev/null
@@ -1,54 +0,0 @@
-*
-* $Id: igarc.F,v 1.1.1.1 1996/02/14 13:10:31 mclareni Exp $
-*
-* $Log: igarc.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:31 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.13/09 06/12/91 17.15.23 by O.Couet
-*-- Author :
- SUBROUTINE IGARC(X,Y,R1,R2,PHI1,PHI2)
-*.===========>
-*.
-*. This routine draws an arc . If R1 not equal R2 the area between the two
-*. arcs of radius R1 and R2 is filled according to the fill area interior style
-*. index and the fill area style index .
-*.
-*. _Input parameters:
-*.
-*. REAL X,Y : Center of the arc .
-*. REAL R1 : First radius .
-*. REAL R2 : Second radius .
-*. REAL PHI1 : First angle in degrees.
-*. REAL PHI2 : Second angle in degrees.
-*.
-*..==========> (O.Couet R.Nierhaus)
-#include "higz/hiflag.inc"
-*.______________________________________
-*
- PHI1R=(3.14159*PHI1)/180.
- PHI2R=(3.14159*PHI2)/180.
- IF(GFLAG.OR.PFLAG)THEN
- PHI3=PHI2R
- IF(PHI1R.EQ.0..AND.PHI3.EQ.0.)PHI3=2.*3.14159
- IF(R1.EQ.R2)THEN
- CALL IGARC1(X,Y,R1,PHI1R,PHI3)
- ELSEIF(R1.EQ.0.)THEN
- IF(PHI1R.EQ.0..AND.PHI2R.EQ.0.)THEN
- CALL IGARC2(X,Y,R2)
- ELSE
- CALL IGARC3(X,Y,R2,PHI1R,PHI3)
- ENDIF
- ELSEIF(R1.GT.R2)THEN
- CALL IGARC4(X,Y,R2,R1,PHI1R,PHI3)
- ELSE
- CALL IGARC4(X,Y,R1,R2,PHI1R,PHI3)
- ENDIF
- ENDIF
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_MAIL)
- IF(GLFLAG)CALL IZARC(X,Y,R1,R2,PHI1,PHI2)
-#endif
-*
- END
diff --git a/src/graflib/higz/ig/igarc1.F b/src/graflib/higz/ig/igarc1.F
deleted file mode 100644
index 8f73555..0000000
--- a/src/graflib/higz/ig/igarc1.F
+++ /dev/null
@@ -1,49 +0,0 @@
-*
-* $Id: igarc1.F,v 1.1.1.1 1996/02/14 13:10:31 mclareni Exp $
-*
-* $Log: igarc1.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:31 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.13/09 06/12/91 17.15.23 by O.Couet
-*-- Author :
- SUBROUTINE IGARC1(XC,YC,R,PHI1,PHI2)
-*.===========>
-*.
-*. Underlaying routine for IGARC .
-*.
-*..==========> (O.Couet R.Nierhaus)
-#include "higz/higraf.inc"
-#include "higz/hiflag.inc"
- LOGICAL ZFSAV
- PARAMETER (PI=3.1415926,PI2=2*PI)
-*.______________________________________
-*
-
- ANGLE=PHI2-PHI1
- IF(ANGLE.LT.0.)ANGLE=PI2+ANGLE
- NPOINT=INT(99.*ANGLE/PI2+.5)
- NPOINT=MAX(1,NPOINT)
- DELTA=ANGLE/FLOAT(NPOINT)
- XX=COS(PHI1)
- YY=SIN(PHI1)
- TCOS=COS(DELTA)
- TSIN=SIN(DELTA)
- NPOINT=NPOINT+1
- DO 10 I=1,NPOINT
- XGRAF(I)=XC+R*XX
- YGRAF(I)=YC+R*YY
- XXX=XX*TCOS-YY*TSIN
- YY=XX*TSIN+YY*TCOS
- XX=XXX
- 10 CONTINUE
- ZFSAV=ZFLAG
- ZFLAG=.FALSE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- CALL IPL(NPOINT,XGRAF,YGRAF)
- ZFLAG=ZFSAV
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
-*
- END
diff --git a/src/graflib/higz/ig/igarc2.F b/src/graflib/higz/ig/igarc2.F
deleted file mode 100644
index aa5d8a6..0000000
--- a/src/graflib/higz/ig/igarc2.F
+++ /dev/null
@@ -1,55 +0,0 @@
-*
-* $Id: igarc2.F,v 1.1.1.1 1996/02/14 13:10:32 mclareni Exp $
-*
-* $Log: igarc2.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:32 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.22/05 27/01/95 16.04.37 by O.Couet
-*-- Author :
- SUBROUTINE IGARC2(XC,YC,R)
-*.===========>
-*.
-*. Underlaying routine for IGARC .
-*.
-*..==========> (O.Couet R.Nierhaus)
-#include "higz/higraf.inc"
-#include "higz/hiatt.inc"
-#include "higz/hiflag.inc"
- LOGICAL ZFSAV
-*.______________________________________
-*
- NPOINT = 99
- DELTA = 2.*3.14159/FLOAT(NPOINT)
- XX = 1.
- YY = 0.
- TCOS = COS(DELTA)
- TSIN = SIN(DELTA)
-*
- DO 10 I=1,NPOINT
- XGRAF(I) = XC+R*XX
- YGRAF(I) = YC+R*YY
- XXX = XX*TCOS-YY*TSIN
- YY = XX*TSIN+YY*TCOS
- XX = XXX
- 10 CONTINUE
-*
- ZFSAV = ZFLAG
- ZFLAG = .FALSE.
- GLFLAG = (ZFLAG.OR.PFLAG.OR.MFLAG)
-*
- CALL IFA(NPOINT,XGRAF,YGRAF)
-*
- IF((IBORD.NE.0).AND.(IFAIS.NE.0))THEN
- NPOINT = NPOINT+1
- XGRAF(NPOINT) = XGRAF(1)
- YGRAF(NPOINT) = YGRAF(1)
- CALL IPL(NPOINT,XGRAF,YGRAF)
- ENDIF
-*
- ZFLAG = ZFSAV
- GLFLAG = (ZFLAG.OR.PFLAG.OR.MFLAG)
-*
- END
diff --git a/src/graflib/higz/ig/igarc3.F b/src/graflib/higz/ig/igarc3.F
deleted file mode 100644
index 5a8cb04..0000000
--- a/src/graflib/higz/ig/igarc3.F
+++ /dev/null
@@ -1,65 +0,0 @@
-*
-* $Id: igarc3.F,v 1.1.1.1 1996/02/14 13:10:32 mclareni Exp $
-*
-* $Log: igarc3.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:32 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.22/05 27/01/95 16.17.28 by O.Couet
-*-- Author :
- SUBROUTINE IGARC3(XC,YC,R,PHI1,PHI2)
-*.===========>
-*.
-*. Underlaying routine for IGARC .
-*.
-*..==========> (O.Couet R.Nierhaus)
-#include "higz/higraf.inc"
-#include "higz/hiatt.inc"
-#include "higz/hiflag.inc"
- LOGICAL ZFSAV
- PARAMETER (PI=3.1415926,PI2=2*PI)
-*.______________________________________
-*
- ANGLE = PHI2-PHI1
- IF (ANGLE.LT.0.) ANGLE = PI2+ANGLE
- NPOINT = INT(99.*ANGLE/PI2+.5)
- NPOINT = MAX(1,NPOINT)
- DELTA = ANGLE/FLOAT(NPOINT)
- XX = COS(PHI1)
- YY = SIN(PHI1)
- TCOS = COS(DELTA)
- TSIN = SIN(DELTA)
-*
- XGRAF(1) = XC
- YGRAF(1) = YC
- DO 10 I=2,NPOINT+2
- XGRAF(I) = XC+R*XX
- YGRAF(I) = YC+R*YY
- XXX = XX*TCOS-YY*TSIN
- YY = XX*TSIN+YY*TCOS
- XX = XXX
- 10 CONTINUE
-*
- ZFSAV = ZFLAG
- ZFLAG = .FALSE.
- GLFLAG = (ZFLAG.OR.PFLAG.OR.MFLAG)
-*
- CALL IFA(NPOINT+2,XGRAF,YGRAF)
-*
- IF((IBORD.NE.0).AND.(IFAIS.NE.0))THEN
- NPL = NPOINT+3
- IF (NPL.LE.NPMAX) THEN
- XGRAF(NPL) = XGRAF(1)
- YGRAF(NPL) = YGRAF(1)
- CALL IPL(NPL,XGRAF,YGRAF)
- ELSE
- CALL IGERR('Too many points','IGARC')
- ENDIF
- ENDIF
-*
- ZFLAG = ZFSAV
- GLFLAG = (ZFLAG.OR.PFLAG.OR.MFLAG)
-*
- END
diff --git a/src/graflib/higz/ig/igarc4.F b/src/graflib/higz/ig/igarc4.F
deleted file mode 100644
index ac5f931..0000000
--- a/src/graflib/higz/ig/igarc4.F
+++ /dev/null
@@ -1,72 +0,0 @@
-*
-* $Id: igarc4.F,v 1.1.1.1 1996/02/14 13:10:32 mclareni Exp $
-*
-* $Log: igarc4.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:32 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.22/05 27/01/95 16.04.37 by O.Couet
-*-- Author :
- SUBROUTINE IGARC4(XC,YC,R1,R2,PHI1,PHI2)
-*.===========>
-*.
-*. Underlaying routine for IGARC .
-*.
-*..==========> (O.Couet R.Nierhaus)
-#include "higz/higraf.inc"
-#include "higz/hiflag.inc"
-#include "higz/hiatt.inc"
- LOGICAL ZFSAV
- PARAMETER (PI=3.1415926,PI2=2*PI)
- PARAMETER (EPSIL=0.0001)
-*.______________________________________
-*
- ANGLE = PHI2-PHI1
- IF (ANGLE.LT.0.) ANGLE=PI2+ANGLE
- NPOINT = INT((99./2.-1)*ANGLE/PI2+.5)
- NPOINT = MAX(1,NPOINT)
- DELTA = ANGLE/FLOAT(NPOINT)
- XX = COS(PHI1)
- YY = SIN(PHI1)
- TCOS = COS(DELTA)
- TSIN = SIN(DELTA)
-*
- DO 10 I=1,NPOINT+1
- XGRAF(I) = XC+R1*XX
- YGRAF(I) = YC+R1*YY
- XGRAF(2*NPOINT+3-I) = XC+R2*XX
- YGRAF(2*NPOINT+3-I) = YC+R2*YY
- XXX = XX*TCOS-YY*TSIN
- YY = XX*TSIN+YY*TCOS
- XX = XXX
- 10 CONTINUE
-*
- ZFSAV = ZFLAG
- ZFLAG = .FALSE.
- GLFLAG = (ZFLAG.OR.PFLAG.OR.MFLAG)
-*
- CALL IFA(2*NPOINT+2,XGRAF,YGRAF)
-*
- IF ((IBORD.NE.0).AND.(IFAIS.NE.0)) THEN
- IF (ABS(XGRAF(1)-XGRAF(NPOINT+1)).GT.EPSIL.OR.
- + ABS(YGRAF(1)-YGRAF(NPOINT+1)).GT.EPSIL) THEN
- NPL = 2*NPOINT+3
- IF (NPL.LE.NPMAX) THEN
- XGRAF(NPL) = XGRAF(1)
- YGRAF(NPL) = YGRAF(1)
- CALL IPL(NPL,XGRAF,YGRAF)
- ELSE
- CALL IGERR('Too many points','IGARC')
- ENDIF
- ELSE
- CALL IPL(NPOINT+1,XGRAF,YGRAF)
- CALL IPL(NPOINT+1,XGRAF(NPOINT+2),YGRAF(NPOINT+2))
- ENDIF
- ENDIF
-*
- ZFLAG = ZFSAV
- GLFLAG = (ZFLAG.OR.PFLAG.OR.MFLAG)
-*
- END
diff --git a/src/graflib/higz/ig/igasci.F b/src/graflib/higz/ig/igasci.F
deleted file mode 100644
index b1e0d0b..0000000
--- a/src/graflib/higz/ig/igasci.F
+++ /dev/null
@@ -1,45 +0,0 @@
-*
-* $Id: igasci.F,v 1.1.1.1 1996/02/14 13:10:32 mclareni Exp $
-*
-* $Log: igasci.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:32 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.12/08 28/03/91 11.53.12 by O.Couet
-*-- Author : O.Couet 28/03/91
- INTEGER FUNCTION IGASCI(CC)
-*.===========>
-*.
-*. Return the ASCII code of the printable characters
-*.
-*..==========> (O.Couet)
- CHARACTER*1 CC
-#if defined(CERNLIB_IBM)
- DIMENSION IEB(95)
- DATA IEB /
- + 64, 90,127,123, 91,108, 80,125, 77, 93, 92, 78,107, 96, 75, 97,
- +240,241,242,243,244,245,246,247,248,249,122, 94, 76,126,110,111,
- +124,193,194,195,196,197,198,199,200,201,209,210,211,212,213,214,
- +215,216,217,226,227,228,229,230,231,232,233,173,224,189, 95,109,
- +121,129,130,131,132,133,134,135,136,137,145,146,147,148,149,150,
- +151,152,153,162,163,164,165,166,167,168,169,192, 79,208,161/
-#endif
-*.______________________________________
-*
- IC=ICHAR(CC)
-#if defined(CERNLIB_IBM)
- IGASCI=32
- DO 10 I=1,95
- IF(IEB(I).EQ.IC)THEN
- IGASCI=31+I
- RETURN
- ENDIF
- 10 CONTINUE
-#endif
-#if !defined(CERNLIB_IBM)
- IGASCI=IC
-#endif
-*
- END
diff --git a/src/graflib/higz/ig/igaxi0.F b/src/graflib/higz/ig/igaxi0.F
deleted file mode 100644
index d56fd05..0000000
--- a/src/graflib/higz/ig/igaxi0.F
+++ /dev/null
@@ -1,37 +0,0 @@
-*
-* $Id: igaxi0.F,v 1.1.1.1 1996/02/14 13:10:32 mclareni Exp $
-*
-* $Log: igaxi0.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:32 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.16/04 09/10/92 13.46.16 by O.Couet
-*-- Author :
- SUBROUTINE IGAXI0(A1,A2,NAA,BL,BH,NB,BWID)
-*.==========>
-*.
-*. Get reasonable values for tick marks & ensure they are
-*. not plotted beyond allowed limits
-*.
-*. _Input parameters:
-*.
-*. REAL A1,A2 : Old WMIN,WMAX .
-*. REAL BL,BH : New WMIN,WMAX .
-*. INTEGER NAA : Old NDIV .
-*. INTEGER NB : New NDIV .
-*.
-*..=========>
- CALL IGAXI3(A1,A2,NAA,BL,BH,NB,BWID)
- ATEST=BWID*0.0001
- IF(ABS(BL-A1).GE.ATEST)THEN
- BL=BL+BWID
- NB=NB-1
- ENDIF
- IF(ABS(BH-A2).GE.ATEST)THEN
- BH=BH-BWID
- NB=NB-1
- ENDIF
-*
- END
diff --git a/src/graflib/higz/ig/igaxi1.F b/src/graflib/higz/ig/igaxi1.F
deleted file mode 100644
index 173ba5a..0000000
--- a/src/graflib/higz/ig/igaxi1.F
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: igaxi1.F,v 1.1.1.1 1996/02/14 13:10:33 mclareni Exp $
-*
-* $Log: igaxi1.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:33 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.06/03 17/10/88 13.48.10 by Rene Brun
-*-- Author :
- SUBROUTINE IGAXI1(X,Y,CFI,SFI,XT,YT,U,V)
-*.==========>
-*.
-*. Underlaying routine IGAXIS .
-*.
-*..=========>
- U=CFI*X-SFI*Y+XT
- V=SFI*X+CFI*Y+YT
-*
- END
-
-
diff --git a/src/graflib/higz/ig/igaxi2.F b/src/graflib/higz/ig/igaxi2.F
deleted file mode 100644
index 2262ae6..0000000
--- a/src/graflib/higz/ig/igaxi2.F
+++ /dev/null
@@ -1,30 +0,0 @@
-*
-* $Id: igaxi2.F,v 1.1.1.1 1996/02/14 13:10:33 mclareni Exp $
-*
-* $Log: igaxi2.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:33 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.13/01 10/09/91 11.42.17 by O.Couet
-*-- Author :
- SUBROUTINE IGAXI2(LABEL,ISTA,IEND)
-*.===========>
-*.
-*. Find start (ISTA) and end (IEND) of a label (LABEL).
-*.
-*..==========> (C.E.Vandoni)
- CHARACTER*(*) LABEL
-*.______________________________________
-*
- IEND=LENOCC(LABEL)
- DO 10 I=1,IEND
- KK=I
- ISTA=INDEX('1234567890-+.',LABEL(I:I))
- IF(ISTA.NE.0)GOTO 20
- 10 CONTINUE
- CALL IGERR('Attempt to draw a blank label','IGAXIS')
- 20 ISTA=KK
-*
- END
diff --git a/src/graflib/higz/ig/igaxi3.F b/src/graflib/higz/ig/igaxi3.F
deleted file mode 100644
index ff40b6e..0000000
--- a/src/graflib/higz/ig/igaxi3.F
+++ /dev/null
@@ -1,82 +0,0 @@
-*
-* $Id: igaxi3.F,v 1.1.1.1 1996/02/14 13:10:33 mclareni Exp $
-*
-* $Log: igaxi3.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:33 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.16/04 09/10/92 13.48.31 by O.Couet
-*-- Author :
- SUBROUTINE IGAXI3(A1,A2,NAA,BL,BH,NB,BWID)
-*.==========>
-*.
-*. Adjust binsiz
-*.
-*..=========>
- AL=MIN(A1,A2)
- AH=MAX(A1,A2)
- IF(AL.EQ.AH)AH=AL+1.
-*
-* IF NAA .EQ. -1 , program uses bwid input from
-* calling routine
-*
- IF(NAA.EQ.-1)GOTO 80
- 10 NA=MAX(NAA,2)
- IF(NA.LT.1)NA=1
-*
-* Get nominal bin width in expon form
-*
- 20 AWID=(AH-AL)/FLOAT(NA)
- JLOG=LOG10(AWID)
- IF(AWID.LE.1.0)JLOG=JLOG-1
- SIGFIG=AWID*(10.00**(-JLOG))
-*
-* Round mantissa up to 1, 2, 2.5, 5, or 10
-*
- IF(SIGFIG.GT.1.0)GOTO 30
- SIGRND=1.0
- GOTO 70
- 30 IF(SIGFIG.GT.2.0)GOTO 40
- SIGRND=2.0
- GOTO 70
- 40 IF(SIGFIG.GT.2.5)GOTO 50
- SIGRND=2.5
- GOTO 70
- 50 IF(SIGFIG.GT.5.0)GOTO 60
- SIGRND=5.0
- GOTO 70
- 60 SIGRND=1.0
- JLOG=JLOG + 1
- 70 CONTINUE
- BWID=SIGRND*10.0**JLOG
- GOTO 90
-*
-* Get new bounds from new width BWID
-*
- 80 IF(BWID.LE.0.)GOTO 10
- 90 CONTINUE
- ALB=AL/BWID
- LWID=ALB
- IF(ALB.LT.0.0)LWID=LWID-1
- BL=SIGRND*FLOAT(LWID)*10.**JLOG
- ALB=AH/BWID+1.00001
- KWID=ALB
- IF(ALB.LT.0.0)KWID=KWID-1
- BH=SIGRND*FLOAT(KWID)*10.**JLOG
- NB=KWID-LWID
- IF(NAA.GT.5)GOTO 100
- IF(NAA.EQ.-1)RETURN
-*
-* Request for one bin is difficult case
-*
- IF(NAA.GT.1.OR.NB.EQ.1)RETURN
- BWID=BWID*2.0
- NB=1
- RETURN
- 100 IF(2*NB.NE.NAA)RETURN
- NA=NA+1
- GOTO 20
-*
- END
diff --git a/src/graflib/higz/ig/igaxi4.F b/src/graflib/higz/ig/igaxi4.F
deleted file mode 100644
index 1cfaae7..0000000
--- a/src/graflib/higz/ig/igaxi4.F
+++ /dev/null
@@ -1,65 +0,0 @@
-*
-* $Id: igaxi4.F,v 1.1.1.1 1996/02/14 13:10:33 mclareni Exp $
-*
-* $Log: igaxi4.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:33 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.06/03 09/12/88 10.33.29 by O.Couet
-*-- Author :
- SUBROUTINE IGAXI4(A1,A2,NAA,BL,BH,NB,BWID)
-*.==========>
-*.
-*. This routine adjusts the bining of the axis
-*. in order to have integer value for labelling.
-*.
-*. _Input parameters:
-*.
-*. REAL A1,A2 : Old WMIN,WMAX .
-*. REAL BL,BH : New WMIN,WMAX .
-*. INTEGER NAA : Old NDIV (primary divisions)
-*. INTEGER NB : New NDIV .
-*.
-*..=========>
-*
- BWID=ABS(A2-A1)/NAA
- IF(BWID.LE.1.)THEN
- BWID=1.
- BL=INT(A1)
- ELSE
- IWID=INT(BWID/5)+1
- BWID=5.*IWID
- BL=INT(A1/BWID)*BWID
-*
-* We determine BL to have one tick mark at 0
-* if there are negative labels.
-*
- IF(A1.LT.0.)THEN
- IC=0
- 10 IC=IC+1
- RBL=BL/BWID
- IBL=INT(BL/BWID)
- IF(((RBL-IBL).NE.0.).AND.(IC.LE.IWID))THEN
- BL=BL-5.
- GOTO 10
- ENDIF
- ENDIF
- ENDIF
- BH=INT(A2)
-*
- NB=0
- XB=BL
- 20 XB=XB+BWID
- IF(XB.LE.BH)THEN
- NB=NB+1
- GOTO 20
- ENDIF
-*
- BH=XB-BWID
-*
- 99 RETURN
- END
-
-
diff --git a/src/graflib/higz/ig/igaxis.F b/src/graflib/higz/ig/igaxis.F
deleted file mode 100644
index 267ef1e..0000000
--- a/src/graflib/higz/ig/igaxis.F
+++ /dev/null
@@ -1,1384 +0,0 @@
-*
-* $Id: igaxis.F,v 1.6 1999/10/06 13:51:58 couet Exp $
-*
-* $Log: igaxis.F,v $
-* Revision 1.6 1999/10/06 13:51:58 couet
-* - Some optimisations to draw intermediate labels in log scale on vertical axis
-* are commented. They produce a wrong labels alignment. The reason why they have
-* been put there have not been found i.e. every things looks fine without these
-* lines. Nevertheless they are just commented. A test in the PAW suite will be
-* added to cover this part of code.
-*
-* Revision 1.5 1998/12/01 15:48:25 couet
-* - Clean up: commented lines of code removed
-*
-* Revision 1.4 1998/01/27 14:06:11 couet
-* *** empty log message ***
-*
-* Revision 1.3 1996/05/08 14:44:19 couet
-* - The test XMIN-XMAX < EPSIL to see if the axis is vertival
-* was wrong because XMIN-MAX can be small (<EPSIL) but the axis
-* horizontal. So the test XMIN=XMAX is put back.
-*
-* Revision 1.2 1996/04/18 08:40:05 couet
-* FLEXE was not initialized
-*
-* Revision 1.1.1.1 1996/02/14 13:10:33 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.23/02 30/05/95 09.20.35 by O.Couet
-*-- Author :
- SUBROUTINE IGAXIS(RXMI,RXMA,RYMI,RYMA,RWMI,RWMA,NNDI,CHOPT)
-*.==============>
-*.
-*. Draws an axis and/or stores it in the data structure,
-*. according to the option selected by IGZSET.
-*.
-*. _Input parameters:
-*.
-*. REAL RXMI : X origin coordinate in WC space.
-*. REAL RXMA : X end axis coordinate in WC space.
-*. REAL RYMI : Y origin coordinate in WC space.
-*. REAL RYMA : Y end axis coordinate in WC space.
-*. REAL RWMI : Lowest value for the tick mark
-*. labels written on the axis.
-*. REAL RWMA : Highest value for the tick mark labels
-*. written on the axis.
-*. INTEGER NNDI : Number of divisions.
-*.
-*. NNDI=N1 + 100*N2 + 10000*N3
-*. N1=number of 1st divisions.
-*. N2=number of 2nd divisions.
-*. N3=number of 3rd divisions.
-*. e.g.:
-*. NNDI=0 --> no tick marks.
-*. NNDI=2 --> 2 divisions, one tick mark in the middle
-*. of the axis.
-*.
-*. CHARACTER CHOPT : Options (see bellow).
-*.
-*. CHOPT='G': loGarithmic scale, default is linear.
-*. CHOPT='B': Blank axis. Useful to superpose axis.
-*. CHOPT='A': An arrow is drawn at the end(WMAX) of the axis.
-*.
-*. Orientation of tick marks on axis.
-*. ----------------------------------
-*.
-*. Tick marks are normally drawn on the positive side of the axis,
-*. however, if X0=X1, then negative.
-*.
-*. CHOPT='+': tick marks are drawn on Positive side. (default)
-*. CHOPT='-': tick mark are drawn on the negative side.
-*. i.e: '+-' --> tick marks are drawn on both sides of the axis.
-*. CHOPT='U': Unlabeled axis, default is labeled.
-*.
-*. Position of labels on axis.
-*. ---------------------------
-*.
-*. Labels are normally drawn on side opposite to tick marks.
-*. However:
-*.
-*. CHOPT='=': on Equal side
-*.
-*. Orientation of labels on axis.
-*. ------------------------------
-*.
-*. Labels are normally drawn parallel to the axis.
-*. However if X0=X1, then Orthogonal
-*. if Y0=Y1, then Parallel
-*.
-*. CHOPT='P': Parallel to the axis
-*. CHOPT='O': Orthogonal to the axis (Top to Down).
-*. CHOPT='0': Orthogonal to the axis (Down to Top).
-*.
-*. Position of labels on tick marks.
-*. ---------------------------------
-*.
-*. Labels are centered on tick marks.
-*. However , if X0=X1, then they are right adjusted.
-*.
-*. CHOPT='R': labels are Right adjusted on tick mark.
-*. (default is centered)
-*. CHOPT='L': labels are Left adjusted on tick mark.
-*. CHOPT='C': labels are Centered on tick mark.
-*. CHOPT='M': In the Middle of the divisions.
-*. CHOPT='V': Tick mark are drawn verticaly
-*.
-*. Direction of labels.
-*. --------------------
-*.
-*. Default is RIGHT
-*.
-*. CHOPT='Y': Down
-*.
-*. Format of labels.
-*. -----------------
-*.
-*. Blank characters are stripped, and then the
-*. label is correctly aligned. the dot, if last
-*. character of the string, is also stripped, unless
-*.
-*. CHOPT='.' Dot obligatory
-*.
-*. In the following, we have some parameters, like
-*. tick marks length and characters height (in percentage
-*. of the length of the axis (WC))
-*. The default values are as follows:
-*.
-*. Primary tick marks: 3.0 %
-*. Secondary tick marks: 1.5 %
-*. Third order tick marks: .75 %
-*.
-*. Length of the arrow: 3.0 %
-*. Width of the arrow: .75 %
-*.
-*. Characters height for labels: 2%
-*. Characters spacing (related to height): 40%
-*.
-*. Labels offset: 4.0 %
-*.
-*. Type of labels.
-*. ---------------
-*.
-*. Labels are normally numeric. However, alphanumeric labels
-*. can be drawn. The value are stored in HILABS (see IGLBL)
-*.
-*. CHOPT='T': Alphanumeric labels .
-*.
-*. Optional grid.
-*. --------------
-*.
-*. CHOPT='W': cross-Wire
-*.
-*. Intrinsic parameters.
-*. ---------------------
-*.
-*. CHOPT='S': Tick marks Size
-*. CHOPT='H': Labels Height
-*. CHOPT='D': Distance labels-axis
-*.
-*. Axis bining optimization.
-*. -------------------------
-*.
-*. By default the axis bining is optimized .
-*.
-*. CHOPT='N': No bining optimization
-*. CHOPT='I': Integer labelling
-*.
-*. CHOPT='X': The axis is not drawn, and the number of divisions,
-*. the smallest and bigest labels are returned
-*.
-*.============> (O.Couet C.E.Vandoni N.Cremel-Somon)
-#include "higz/hiflag.inc"
-#include "higz/hiatt.inc"
-#include "higz/hilabs.inc"
-#if defined(CERNLIB_MAIL)
-#include "higz/himail.inc"
-#endif
- COMMON /AXSIZ/ CHAXSZ
- LOGICAL ZFSAV
- LOGICAL FLEXE,FLEXPO,FLEXNE,INTLOG
- DIMENSION ATICK (3), NN(3),XPL(4),YPL(4)
- DIMENSION IOPT(25)
- EQUIVALENCE (IOPTG,IOPT(1)) , (IOPTB,IOPT(2))
- EQUIVALENCE (IOPTA,IOPT(3)) , (IOPTV,IOPT(4))
- EQUIVALENCE (IOPTPL,IOPT(5)) , (IOPTN,IOPT(6))
- EQUIVALENCE (IOPTU,IOPT(7)) , (IOPTP,IOPT(8))
- EQUIVALENCE (IOPTO,IOPT(9)) , (IOPTR,IOPT(10))
- EQUIVALENCE (IOPTL,IOPT(11)) , (IOPTC,IOPT(12))
- EQUIVALENCE (IOPTEQ,IOPT(13)), (IOPTDO,IOPT(14))
- EQUIVALENCE (IOPTH,IOPT(15)) , (IOPTD,IOPT(16))
- EQUIVALENCE (IOPTY,IOPT(17)) , (IOPTT,IOPT(18))
- EQUIVALENCE (IOPTW,IOPT(19)) , (IOPTS,IOPT(20))
- EQUIVALENCE (IOPTNN,IOPT(21)), (IOPTI,IOPT(22))
- EQUIVALENCE (IOPTM,IOPT(23)) , (IOPT0,IOPT(24))
- EQUIVALENCE (IOPTX,IOPT(25))
- CHARACTER*(*) CHOPT
- CHARACTER*32 LABEL
- CHARACTER*8 CODED
- CHARACTER*36 CHTEMP
-* Set the labels precision
- PARAMETER(NCAR=5)
- DATA EPSIL /0.00001/
-*.______________________________________
-*
- XMIN=RXMI
- XMAX=RXMA
- YMIN=RYMI
- YMAX=RYMA
- WMIN=RWMI
- WMAX=RWMA
- NDIV=NNDI
-*
- CALL UOPTC(CHOPT,'GBAV+-UPORLC=.HDYTWSNIM0X',IOPT)
-#if defined(CERNLIB_MAIL)
- CHOPTM=CHOPT
-#endif
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_MAIL)
- IF(GLFLAG)CALL IZAXIS(XMIN,XMAX,YMIN,YMAX,WMIN,WMAX,NDIV,IOPT)
-#endif
- IF((.NOT.GFLAG).AND.(.NOT.PFLAG))RETURN
- ZFSAV=ZFLAG
- ZFLAG=.FALSE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
-*
-* Set the grid lenght
-*
- IGRITY=ILN
- GRIL1=0.
- IF(IOPTW.NE.0)THEN
- GRILEN=RAWL
- GRIL1=GRILEN
- ENDIF
-*
-* Determine number of divisions 1, 2 and 3
-*
- N = NDIV
- N3A = N/10000
- N = N-N3A*10000
- N2A = N/100
- N1A = N-N2A*100
- NN(3) = MAX(N3A,1)
- NN(2) = MAX(N2A,1)*NN(3)
- NN(1) = MAX(N1A,1)*NN(2)+1
- LOOP = NN(1)
-*
-* Axis bining optimization is ignored if:
-* - the first and the last label are equal
-* - the number of divisions is 0
-* - less than 1 primary division is requested
-* - logarithmic scale is requested
-*
- IF((WMIN.EQ.WMAX).OR.(NDIV.EQ.0).OR.
- + (N1A.LE.1).OR.(IOPTG.NE.0))THEN
- IOPTNN = 1
- IOPTI = 0
- ENDIF
-*
-* Axis bining optimization
-*
- IF(((WMAX-WMIN).LT.1.).AND.(IOPTI.NE.0))THEN
- CALL IGERR('Option "I" not available','IGAXIS')
- IOPTI=0
- ENDIF
- IF(IOPTNN.EQ.0.OR.IOPTI.NE.0)THEN
-*
-* Primary divisions optimization
-*
-* The optimization provide by IGAXI0 is better than the one provide
-* by IGAXI4. When integer labelling is required, IGAXI0 is invoke first
-* and only if the result is not an integer labelling, IGAXI4 is invoked.
-*
- CALL IGAXI0(WMIN,WMAX,N1A,BL,BH,NB,BWID)
- IF(IOPTI.NE.0)THEN
- IF(BL.NE.FLOAT(INT(BL)).OR.BWID.NE.FLOAT(INT(BWID)))THEN
- CALL IGAXI4(WMIN,WMAX,N1A,BL,BH,NB,BWID)
- ENDIF
- ENDIF
- IF((WMIN-BL).GT.EPSIL)THEN
- BL = BL+BWID
- NB = NB-1
- ENDIF
- IF((BH-WMAX).GT.EPSIL)THEN
- BH = BH-BWID
- NB = NB-1
- ENDIF
- IF(XMAX.EQ.XMIN)THEN
- RTYW = (YMAX-YMIN)/(WMAX-WMIN)
- XXMIN = XMIN
- XXMAX = XMAX
- YYMIN = RTYW*(BL-WMIN)+YMIN
- YYMAX = RTYW*(BH-WMIN)+YMIN
- ELSE
- RTXW = (XMAX-XMIN)/(WMAX-WMIN)
- XXMIN = RTXW*(BL-WMIN)+XMIN
- XXMAX = RTXW*(BH-WMIN)+XMIN
- IF(YMAX.EQ.YMIN)THEN
- YYMIN = YMIN
- YYMAX = YMAX
- ELSE
- ALFA = (YMAX-YMIN)/(XMAX-XMIN)
- BETA = (YMIN*XMAX-YMAX*XMIN)/(XMAX-XMIN)
- YYMIN = ALFA*XXMIN+BETA
- YYMAX = ALFA*XXMAX+BETA
- ENDIF
- ENDIF
- WMIN = BL
- WMAX = BH
-*
-* Secondary divisions optimization
-*
- NB2 = N2A
- IF(IOPTNN.EQ.0.AND.N2A.GT.1.AND.BWID.GT.0.)THEN
- CALL IGAXI0(WMIN,WMIN+BWID,N2A,BL2,BH2,NB2,BWID2)
- ENDIF
-*
-* Tertiary divisions optimization
-*
- NB3 = N3A
- IF(IOPTNN.EQ.0.AND.N3A.GT.1.AND.BWID2.GT.0.)THEN
- CALL IGAXI0(BL2,BL2+BWID2,N3A,BL3,BH3,NB3,BWID3)
- ENDIF
-*
- N1AOLD = N1A
- NN1OLD = NN(1)
- N1A = NB
- NN(3) = MAX(NB3,1)
- NN(2) = MAX(NB2,1)*NN(3)
- NN(1) = MAX(N1A,1)*NN(2)+1
- LOOP = NN(1)
- ENDIF
-*
-* Coordinates are normalized
-*
- RATIO1 = (RVXMAX-RVXMIN)/(RWXMAX-RWXMIN)
- RATIO2 = (RVYMAX-RVYMIN)/(RWYMAX-RWYMIN)
- X0 = RATIO1*(XMIN-RWXMIN)+RVXMIN
- X1 = RATIO1*(XMAX-RWXMIN)+RVXMIN
- Y0 = RATIO2*(YMIN-RWYMIN)+RVYMIN
- Y1 = RATIO2*(YMAX-RWYMIN)+RVYMIN
- IF(XMIN.NE.XMAX)THEN
- GRILEN = RATIO2*(GRIL1-RWYMIN)+RVYMIN-Y0
- ELSE
- GRILEN = RATIO1*(GRIL1-RWXMIN)+RVXMIN-X0
- ENDIF
- IF((IOPTNN.EQ.0).OR.(IOPTI.NE.0))THEN
- XX0 = RATIO1*(XXMIN-RWXMIN)+RVXMIN
- XX1 = RATIO1*(XXMAX-RWXMIN)+RVXMIN
- YY0 = RATIO2*(YYMIN-RWYMIN)+RVYMIN
- YY1 = RATIO2*(YYMAX-RWYMIN)+RVYMIN
- IF(XMIN.NE.XMAX)THEN
- GRILEN = RATIO2*(GRIL1-RWYMIN)+RVYMIN-YY0
- ELSE
- GRILEN = RATIO1*(GRIL1-RWXMIN)+RVXMIN-XX0
- ENDIF
- ENDIF
-*
- IF((X0.EQ.X1).AND.(Y0.EQ.Y1))THEN
- CALL IGERR('Length of axis is zero','IGAXIS')
- GOTO 220
- ENDIF
-*
-* Return WMIN, WMAX and the number of primary divisions
-*
- IF(IOPTX.NE.0)THEN
- RWMI = WMIN
- RWMA = WMAX
- NNDI = N1A
- GOTO 220
- ENDIF
-*
- ICTR = INTR
- CHSIZ = RCHH
- CHUPXV = RCHUX
- CHUPYV = RCHUY
- IALH = ITXALH
- IALV = ITXALV
- ILNV = ILN
- ICLIPV = ICLIP
-*
- CALL ISCLIP(0)
- CALL ISELNT(0)
- CALL ISLN(1)
-*
- TICK = .03
- ARROL = 0.03
- ARROW = 0.0075
- CHEI = .02
- OFFSEL = .04
-*
- FLEXE = .FALSE.
-*
-* Calculate length of axis
-*
- AXLEN = SQRT((X1-X0)*(X1-X0)+(Y1-Y0)*(Y1-Y0))
- IF(AXLEN.EQ.0)THEN
- CALL IGERR('Length of axis is zero','IGAXIS')
- GOTO 210
- ENDIF
- IF((IOPTNN.EQ.0).OR.(IOPTI.NE.0))THEN
- AXLENN = SQRT((XX1-XX0)*(XX1-XX0)+(YY1-YY0)*(YY1-YY0))
- AXLEN0 = SQRT((XX0-X0)*(XX0-X0)+(YY0-Y0)*(YY0-Y0))
- AXLEN1 = SQRT((X1-XX1)*(X1-XX1)+(Y1-YY1)*(Y1-YY1))
- IF(AXLENN.LT.EPSIL)THEN
- IOPTNN = 1
- IOPTI = 0
- WMIN = RWMI
- WMAX = RWMA
- N1A = N1AOLD
- NN(1) = NN1OLD
- LOOP = NN(1)
- ENDIF
- ENDIF
-*
-* Calculate cosine of angle
-*
- PHI = ATAN2((Y1-Y0),(X1-X0))
- COSFI = COS(PHI)
- SINFI = SIN(PHI)
- ACOSFI = ABS(COSFI)
- ASINFI = ABS(SINFI)
- IF(ACOSFI.LE.EPSIL)THEN
- ACOSFI = 0.
- COSFI = 0.
- ENDIF
- IF(ASINFI.LE.EPSIL)THEN
- ASINFI = 0.
- SINFI = 0.
- ENDIF
- RATIO3 = (ASINFI*RATIO1)+(ACOSFI*RATIO2)
- IF(IOPTV.NE.0)RATIO3 = RATIO2
-*
-* MSIDE positive, tick marks on positive side
-* MSIDE negative, tick marks on negative side
-* MSIDE zero, tick marks on both sides
-* Default is positive except for vertical axis
-*
- MSIDE=1
- IF((X0.EQ.X1).AND.(Y1.GT.Y0))MSIDE=-1
- IF(IOPTPL.EQ.1)MSIDE=1
- IF(IOPTN.EQ.1)MSIDE=-1
- IF((IOPTPL+IOPTN).EQ.2)MSIDE=0
-*
- LSIDE=-MSIDE
- IF(IOPTEQ.EQ.1)LSIDE=MSIDE
- IF((IOPTPL+IOPTN).EQ.2)THEN
- LSIDE=-1
- IF(IOPTEQ.EQ.1)LSIDE=1
- ENDIF
- XLSIDE=LSIDE
- XMSIDE=MSIDE
-*
-* Tick marks size
-*
- SITIC=SIGN(1.0,XMSIDE)
- IF((IOPTS.EQ.1).AND.(RTMS.GT.0))THEN
- TMS=RATIO3*RTMS
- ATICK(1)=SITIC*TMS
- ELSE
- ATICK(1)=SITIC*TICK*AXLEN
- ENDIF
-*
- ATICK(2)=ATICK(1)/2.
- ATICK(3)=ATICK(2)/2.
-*
-* Arrow size
-*
- ARROLE=ARROL*AXLEN
- ARROWI=ARROW*AXLEN
-*
-* Set the side of the grid
-*
- IF((X0.EQ.X1).AND.(Y1.GT.Y0))THEN
- SIWIR=-1
- ELSE
- SIWIR=1
- ENDIF
-*
-* Draw the axis if needed...
-*
- RLWSCS=RLWSC
- CALL ISLWSC(1.)
- IF(IOPTB.EQ.0)THEN
- XPL(1)=X0
- XPL(2)=X1
- YPL(1)=Y0
- YPL(2)=Y1
- CALL IPL(2,XPL,YPL)
- ENDIF
-*
-* Draw the arrow if needed...
-*
- IF(IOPTA.NE.0)THEN
- XPL(1)=X1
- XPL(4)=X1
- YPL(1)=Y1
- YPL(4)=Y1
- P=AXLEN-ARROLE
- CALL IGAXI1 (P,-ARROWI,COSFI,SINFI,X0,Y0,XPL(2),YPL(2))
- CALL IGAXI1 (P,ARROWI,COSFI,SINFI,X0,Y0,XPL(3),YPL(3))
- CALL IPL(4,XPL,YPL)
- ENDIF
- CALL ISLWSC(RLWSCS)
-*
-* Now the line have the text color (ticks marks)
-*
- IPLCIS=IPLCI
- CALL ISPLCI(ITXCI)
-*
-* No bining
-*
- IF(NDIV.EQ.0)GOTO 210
- IF(WMIN.EQ.WMAX)THEN
- CALL IGERR('WMIN=WMAX (cf. HIGZ doc.)','IGAXIS')
- GOTO 210
- ENDIF
-*
-* Labels preparation:
-*
-* Now determine character height
-* (if LOGICAL AXFLAG=.TRUE. then we take the same
-* size than for the previous axe, stocked in
-* CHAXSZ (COMMON /AXSIZ/).
-*
- IF(.NOT.AXFLAG)THEN
- IF((IOPTH.EQ.0).OR.(RALH.LT.0)) THEN
- CHHEI=CHEI*AXLEN
- ELSE
- IF(X0.NE.X1) THEN
- CHHEI=RATIO3*RALH
- ELSE
- CHHEI=RATIO2*RALH
- ENDIF
- ENDIF
- CHAXSZ=CHHEI
- ELSE
- CHHEI=CHAXSZ
- ENDIF
- CALL ISCHH (CHHEI)
-*
-* Now determine the labels orientation in case of overlaps
-* (with alphanumeric labels for horizontal axis).
-*
- IF(IOPT0.EQ.0.AND.IOPTO.EQ.0.AND.IOPTY.EQ.0)THEN
- IF(IOPTT.NE.0.AND.YMIN.EQ.YMAX)THEN
- BINWDH = 0.9*(AXLEN/FLOAT(N1A))
- TEXTW = 0.
- DO 10 I=1,NHILAB
- CALL IGTEXT(0.,0.,HILABS(I),CHHEI,TEXTW,'S')
- IF(TEXTW.GT.BINWDH)THEN
- IOPT0 = 1
- IOPTR = 1
- IOPTC = 0
- IOPTL = 0
- GOTO 20
- ENDIF
- 10 CONTINUE
- ENDIF
- ENDIF
-*
-* Now determine orientation of labels on axis
-*
- 20 IF(COSFI.GT.0.)THEN
- CALL ISCHUP(-SINFI,COSFI)
- ELSE
- CALL ISCHUP(SINFI,-COSFI)
- ENDIF
- IF(X0.EQ.X1) CALL ISCHUP(0.,1.)
- IF(IOPTV.NE.0)CALL ISCHUP(0.,1.)
- IF(IOPTP.NE.0)CALL ISCHUP(-SINFI,COSFI)
- IF(IOPTO.NE.0)CALL ISCHUP(COSFI,SINFI)
- IF(IOPT0.NE.0)CALL IGSET('TANG',90.)
-*
-* Now determine text alignment
-*
- IALX=2
- IALY=0
- IF(X0.EQ.X1)IALX=3
- IF(Y0.NE.Y1)IALY=3
- IF(IOPTC.EQ.1)IALX=2
- IF(IOPTR.EQ.1)IALX=3
- IF(IOPTL.EQ.1)IALX=1
- CALL ISTXAL(IALX,IALY)
-*
-* Position of labels in Y
-*
- SILAB=SIGN(1.0,XLSIDE)
- IF((IOPTD.EQ.1).AND.(RALD.GE.0))THEN
- ALD=RATIO3*RALD
- YLAB=SILAB*ALD
- ELSE
- IF(IOPTG.EQ.0)THEN
- YLAB=SILAB*OFFSEL*AXLEN
- ELSE
- YLAB=SILAB*OFFSEL*AXLEN*1.3
- ENDIF
- ENDIF
-*
-* Draw the linear tick marks if needed...
-*
- IF(IOPTG.EQ.0)THEN
- IF(NDIV.NE.0)THEN
- IF((IOPTNN.NE.0).AND.(IOPTI.EQ.0))THEN
- DXTICK=AXLEN/(LOOP-1.)
- ELSE
- DXTICK=AXLENN/(LOOP-1.)
- ENDIF
- DO 30 K=0,LOOP-1
- L=3
- IF(MOD(K,NN(3)).EQ.0)L=2
- IF(MOD(K,NN(2)).EQ.0)L=1
- XTICK=K*DXTICK
- YTICK=0.
- IF(MSIDE.EQ.0)YTICK=YTICK-ATICK(L)
- IF((IOPTNN.NE.0).AND.(IOPTI.EQ.0))THEN
- CALL IGAXI1(XTICK,YTICK,COSFI,SINFI,X0,Y0
- + ,XPL(2),YPL(2))
- CALL IGAXI1(XTICK,ATICK(L),COSFI,SINFI,X0,Y0
- + ,XPL(1),YPL(1))
- ELSE
- CALL IGAXI1(XTICK,YTICK,COSFI,SINFI,XX0,YY0
- + ,XPL(2),YPL(2))
- CALL IGAXI1(XTICK,ATICK(L),COSFI,SINFI,XX0,YY0
- + ,XPL(1),YPL(1))
- ENDIF
- IF(IOPTV.NE.0)THEN
- IF((X0.NE.X1).AND.(Y0.NE.Y1))THEN
- IF(MSIDE.NE.0)THEN
- XPL(1)=XPL(2)
- IF(COSFI.GT.0)THEN
- YPL(1)=YPL(2)+ATICK(L)
- ELSE
- YPL(1)=YPL(2)-ATICK(L)
- ENDIF
- ELSE
- XML=(XPL(1)+XPL(2))/2.
- YML=(YPL(1)+YPL(2))/2.
- XPL(1)=XML
- XPL(2)=XML
- YPL(1)=YML+ATICK(L)
- YPL(2)=YML-ATICK(L)
- ENDIF
- ENDIF
- ENDIF
- IF(ABS(XPL(2)-X0).LT.EPSIL.AND.
- + ABS(YPL(2)-Y0).LT.EPSIL.AND.
- + IOPTA.NE.0)GOTO 30
- IF(ABS(XPL(2)-X1).LT.EPSIL.AND.
- + ABS(YPL(2)-Y1).LT.EPSIL.AND.
- + IOPTA.NE.0)GOTO 30
- CALL IPL(2,XPL,YPL)
-*
- IF(IOPTW.NE.0)THEN
- IF(L.EQ.1)THEN
- IF((IOPTNN.NE.0).AND.(IOPTI.EQ.0))THEN
- CALL IGAXI1(XTICK,0.,COSFI
- + ,SINFI,X0,Y0
- + ,XPL(2),YPL(2))
- CALL IGAXI1(XTICK,SIWIR*GRILEN
- + ,COSFI,SINFI,X0,Y0
- + ,XPL(1),YPL(1))
- ELSE
- CALL IGAXI1(XTICK,0.,COSFI
- + ,SINFI,XX0,YY0
- + ,XPL(2),YPL(2))
- CALL IGAXI1(XTICK,SIWIR*GRILEN
- + ,COSFI,SINFI,XX0,YY0
- + ,XPL(1),YPL(1))
- ENDIF
- CALL ISLN(IGRITY)
- CALL IPL(2,XPL,YPL)
- CALL ISLN(1)
- ENDIF
- ENDIF
-*
- 30 CONTINUE
-*
- XTICK0=0.
- XTICK1=XTICK
-*
- IF(((IOPTNN.EQ.0).OR.(IOPTI.NE.0)).AND.(AXLEN0.NE.0))THEN
- LOOP0=INT(AXLEN0/DXTICK)
- DO 40 K=0,LOOP0
- L=3
- IF(MOD(K,NN(3)).EQ.0)L=2
- IF(MOD(K,NN(2)).EQ.0)L=1
- YTICK0=0.
- IF(MSIDE.EQ.0)YTICK0=YTICK0-ATICK(L)
- CALL IGAXI1(XTICK0,YTICK0,COSFI,SINFI,XX0,YY0
- + ,XPL(2),YPL(2))
- CALL IGAXI1(XTICK0,ATICK(L),COSFI,SINFI,XX0,YY0
- + ,XPL(1),YPL(1))
- IF(IOPTV.NE.0)THEN
- IF((X0.NE.X1).AND.(Y0.NE.Y1))THEN
- IF(MSIDE.NE.0)THEN
- XPL(1)=XPL(2)
- IF(COSFI.GT.0)THEN
- YPL(1)=YPL(2)+ATICK(L)
- ELSE
- YPL(1)=YPL(2)-ATICK(L)
- ENDIF
- ELSE
- XML=(XPL(1)+XPL(2))/2.
- YML=(YPL(1)+YPL(2))/2.
- XPL(1)=XML
- XPL(2)=XML
- YPL(1)=YML+ATICK(L)
- YPL(2)=YML-ATICK(L)
- ENDIF
- ENDIF
- ENDIF
- CALL IPL(2,XPL,YPL)
-*
- IF(IOPTW.NE.0)THEN
- IF(L.EQ.1)THEN
- CALL IGAXI1(XTICK0,0.
- + ,COSFI,SINFI,XX0,YY0
- + ,XPL(2),YPL(2))
- CALL IGAXI1(XTICK0,SIWIR*GRILEN
- + ,COSFI,SINFI,XX0,YY0
- + ,XPL(1),YPL(1))
- CALL ISLN(IGRITY)
- CALL IPL(2,XPL,YPL)
- CALL ISLN(1)
- ENDIF
- ENDIF
-*
- XTICK0=XTICK0-DXTICK
- 40 CONTINUE
- ENDIF
-*
- IF(((IOPTNN.EQ.0).OR.(IOPTI.NE.0)).AND.(AXLEN1.NE.0))THEN
- LOOP1=INT(AXLEN1/DXTICK)
- DO 50 K=0,LOOP1
- L=3
- IF(MOD(K,NN(3)).EQ.0)L=2
- IF(MOD(K,NN(2)).EQ.0)L=1
- YTICK1=0.
- IF(MSIDE.EQ.0)YTICK1=YTICK1-ATICK(L)
- CALL IGAXI1(XTICK1,YTICK1,COSFI,SINFI,XX0,YY0
- + ,XPL(2),YPL(2))
- CALL IGAXI1(XTICK1,ATICK(L),COSFI,SINFI,XX0,YY0
- + ,XPL(1),YPL(1))
- IF(IOPTV.NE.0)THEN
- IF((X0.NE.X1).AND.(Y0.NE.Y1))THEN
- IF(MSIDE.NE.0)THEN
- XPL(1)=XPL(2)
- IF(COSFI.GT.0)THEN
- YPL(1)=YPL(2)+ATICK(L)
- ELSE
- YPL(1)=YPL(2)-ATICK(L)
- ENDIF
- ELSE
- XML=(XPL(1)+XPL(2))/2.
- YML=(YPL(1)+YPL(2))/2.
- XPL(1)=XML
- XPL(2)=XML
- YPL(1)=YML+ATICK(L)
- YPL(2)=YML-ATICK(L)
- ENDIF
- ENDIF
- ENDIF
- CALL IPL(2,XPL,YPL)
-*
- IF(IOPTW.NE.0)THEN
- IF(L.EQ.1)THEN
- CALL IGAXI1(XTICK1,0.
- + ,COSFI,SINFI,XX0,YY0
- + ,XPL(2),YPL(2))
- CALL IGAXI1(XTICK1,SIWIR*GRILEN
- + ,COSFI,SINFI,XX0,YY0
- + ,XPL(1),YPL(1))
- CALL ISLN(IGRITY)
- CALL IPL(2,XPL,YPL)
- CALL ISLN(1)
- ENDIF
- ENDIF
-*
- XTICK1=XTICK1+DXTICK
- 50 CONTINUE
- ENDIF
- ENDIF
- ENDIF
-*
-* Draw the numeric labels if needed...
-*
- IF(IOPTU.EQ.0)THEN
- IF(IOPTG.EQ.0)THEN
- IF(N1A.NE.0)THEN
-*
-* Spacing of labels
-*
- IF((WMIN.EQ.WMAX).OR.(NDIV.EQ.0))THEN
- CALL IGERR('WMIN=WMAX or NDIV=0 (cf. HIGZ doc.)'
- + ,'IGAXIS')
- GOTO 210
- ENDIF
- WLAB=WMIN
- DWLAB=(WMAX-WMIN)/FLOAT(N1A)
- IF((IOPTNN.NE.0).AND.(IOPTI.EQ.0))THEN
- DXLAB=AXLEN/(N1A)
- ELSE
- DXLAB=AXLENN/(N1A)
- ENDIF
-*
-* Here we have to decide what format to generate
-* (for numeric labels only)
-*
- IF(IOPTT.EQ.0)THEN
-*
-* Test the magnitude, decide format
-*
- FLEXE=.FALSE.
- NEXE=0
- FLEXPO=.FALSE.
- FLEXNE=.FALSE.
- WW=MAX(ABS(WMIN),ABS(WMAX))
-*
-* First case : (WMAX-WMIN)/N1A less than 0.001
-* (0.001 precision of 5 (NCAR) characters). Then we use x 10 n
-* format. If AF >=0 x10 n cannot be used
-*
- IF((ABS(WMAX-WMIN)/N1A).LT.0.00099)THEN
- AF = LOG10(WW)+EPSIL
- IF(AF.GE.0.)GOTO 60
- FLEXE = .TRUE.
- NEXE = INT(AF)
- IEXE = IABS(NEXE)
- WLAB = WLAB*(10.**IEXE)
- DWLAB = DWLAB*(10.**IEXE)
- IF1 = NCAR
- IF2 = NCAR-2
- GOTO 110
- ENDIF
-*
- 60 IF(WW.GE.1.)THEN
- AF=LOG10(WW)
- ELSE
- AF=LOG10(WW*0.0001)
- ENDIF
- AF=AF+EPSIL
- NF=AF+1.0
- IF(NF.GT.NCAR)FLEXPO=.TRUE.
- IF(NF.LT.(-NCAR))FLEXNE=.TRUE.
-*
-* Use x 10 n format.
-*
- IF(FLEXPO)THEN
- FLEXE=.TRUE.
- 70 IF(WW.GT.(10**(NCAR-1)))THEN
- NEXE=NEXE+1
- WW=WW/10.
- WLAB=WLAB/10.
- DWLAB=DWLAB/10.
- GOTO 70
- ENDIF
- ENDIF
-*
- IF(FLEXNE)THEN
- FLEXE=.TRUE.
- RNE=1./10.**(NCAR-2)
- 80 IF(WW.LT.RNE)THEN
- NEXE=NEXE-1
- WW=WW*10.
- WLAB=WLAB*10.
- DWLAB=DWLAB*10.
- GOTO 80
- ENDIF
- ENDIF
-*
- NA=0
- DO 90 I=NCAR-1,1,-1
- ECAR=10**I
- IF(ABS(WW).LT.ECAR)NA=NCAR-I
- 90 CONTINUE
- NDYN=N1A
- 100 IF(NDYN.NE.0)THEN
- IF((ABS((WMAX-WMIN)/NDYN).LE.0.999).AND.
- + (NA.LT.(NCAR-2)))THEN
- NA=NA+1
- NDYN=NDYN/10
- GOTO 100
- ENDIF
- ENDIF
-*
-* FORTRAN 77 internal write
-*
- IF2 = NA
- IF1 = MAX(NF+NA,NCAR)+1
-*
- 110 IF(MIN(WMIN,WMAX).LT.0.)IF1 = IF1+1
- IF1 = MIN(IF1,32)
-*
-* In some cases, IF1 and IF2 are too small....
-*
- 120 IF(DWLAB.lt.10.**FLOAT(-IF2))THEN
- IF1 = IF1+1
- IF2 = IF2+1
- GOTO 120
- ENDIF
-*
- WRITE (CODED,'(2H(F,I2,1H.,I2,1H))') IF1,IF2
-*
- ENDIF
-*
-* Here we draw labels
-*
- IF(IOPTM.NE.0)THEN
- ILOOP=N1A-1
- ELSE
- ILOOP=N1A
- ENDIF
- DO 150 K=0,ILOOP
- XLAB=DXLAB*K
- IF(IOPTM.NE.0)THEN
- XLAB=XLAB+(DXLAB/2.)
- ENDIF
-*
- IF(IOPTT.EQ.0)THEN
- WRITE(LABEL,CODED)WLAB
- WLAB=WLAB+DWLAB
-*
-* Here we eliminate the blanks around the label.
-*
- CALL IGAXI2(LABEL,ISTA,IEND)
-*
-* Here we check if '.' is preceded by a number.
-*
- CHTEMP=' '
- IF(LABEL(ISTA:ISTA).EQ.'.')
- + CHTEMP='0'//LABEL(ISTA:IEND)
- IF(LABEL(ISTA:ISTA+1).EQ.'-.')
- + CHTEMP='-0'//LABEL(ISTA+1:IEND)
- IF(CHTEMP.NE.' ')THEN
- LABEL=CHTEMP
- ISTA=1
- IEND=LENOCC(LABEL)
- ENDIF
-*
-* Here we eliminate the non significiant 0 after '.'
-*
- 130 IF(LABEL(IEND:IEND).EQ.'0')THEN
- IEND=IEND-1
- GOTO 130
- ENDIF
-*
-* Here we eliminate the dot, unless dot is forced.
-*
- IF(LABEL(IEND:IEND).EQ.'.')THEN
- IF(IOPTDO.EQ.0)IEND=IEND-1
- ENDIF
- ENDIF
-*
-* Here we generate labels (numeric or alphanumeric).
-*
- IF((IOPTNN.NE.0).AND.(IOPTI.EQ.0))THEN
- CALL IGAXI1 (XLAB,YLAB,COSFI,SINFI,X0,Y0,XX,YY)
- ELSE
- CALL IGAXI1 (XLAB,YLAB,COSFI,SINFI,XX0,YY0,XX,YY)
- ENDIF
- IF((Y0.EQ.Y1).AND.(IOPTO.EQ.0).AND.(IOPT0.EQ.0))THEN
- IF(LSIDE.LT.0)THEN
- YY=YY-CHHEI
- ENDIF
- ENDIF
- IF(IOPTV.NE.0)THEN
- IF((X0.NE.X1).AND.(Y0.NE.Y1))THEN
- IF((IOPTNN.NE.0).AND.(IOPTI.EQ.0))THEN
- CALL IGAXI1 (XLAB,0.,COSFI,SINFI,X0,Y0,XX,YY)
- ELSE
- CALL IGAXI1 (XLAB,0.,COSFI,SINFI,XX0,YY0,XX,
- + YY)
- ENDIF
- IF(COSFI.GT.0)THEN
- YY=YY+YLAB
- XX=XX+((FLOAT(IEND-ISTA+1)*RCHH)/2)*SINFI
- ELSE
- YY=YY-YLAB
- XX=XX-((FLOAT(IEND-ISTA+1)*RCHH)/2)*SINFI
- ENDIF
- ENDIF
- ENDIF
- IF((IOPTY.EQ.0).OR.(X0.EQ.X1))THEN
- IF(IOPTT.EQ.0)THEN
- IF(ISTA.GT.IEND)THEN
- CHTEMP=' '
- ELSE
- CHTEMP=LABEL(ISTA:IEND)
- ENDIF
- CALL ITX(XX,YY,CHTEMP)
- ELSE
- IF(K+1.GT.NHILAB)THEN
- CHTEMP=' '
- ELSE
- CHTEMP=HILABS(K+1)
- ENDIF
- CALL ITX(XX,YY,CHTEMP)
- ENDIF
- ELSE
-*
-* Text alignment is down
-*
- IF(IOPTT.EQ.0)THEN
- LNLEN=IEND-ISTA+1
- ELSE
- IF(K+1.GT.NHILAB)THEN
- LNLEN=0
- ELSE
- LNLEN=LENOCC(HILABS(K+1))
- ENDIF
- ENDIF
- DO 140 L=1,LNLEN
- IF(IOPTT.EQ.0)THEN
- CHTEMP=LABEL(ISTA+L-1:ISTA+L-1)
- ELSE
- IF(LNLEN.EQ.0)THEN
- CHTEMP=' '
- ELSE
- CHTEMP=HILABS(K+1)(L:L)
- ENDIF
- ENDIF
- CALL ITX(XX,YY,CHTEMP)
- YY=YY-(CHHEI*1.3)
- 140 CONTINUE
- ENDIF
- 150 CONTINUE
-*
-* Here we use the format x 10 ** n
-*
- IF(FLEXE.AND.IOPTT.EQ.0.AND.NEXE.NE.0) THEN
- WRITE(LABEL,'(I3)')NEXE
- IF(X0.NE.X1)THEN
- XFCT=XLAB
- YFCT=YLAB-3*CHHEI
- ELSE
- XFCT=XLAB+3*CHHEI
- YFCT=YLAB
- ENDIF
- CALL IGAXI2(LABEL,ISTA,IEND)
- DEXPY=CHHEI
- IF((NEXE.LE.0).OR.(Y0.EQ.Y1))THEN
- DEXPX=2*CHHEI
- ELSE
- DEXPX=CHHEI
- ENDIF
- IF(COSFI.GT.0)THEN
- XEXP=XFCT+DEXPX
- YEXP=YFCT+DEXPY
- ELSE
- XEXP=XFCT-DEXPX
- YEXP=YFCT-DEXPY
- ENDIF
- IF(X0.EQ.X1)THEN
- IF(Y0.LT.Y1)THEN
- XEXP=XFCT+0.5*DEXPX
- YEXP=YFCT-DEXPY
- ELSE
- XEXP=XFCT-DEXPX
- YEXP=YFCT+DEXPY
- ENDIF
- ENDIF
- IF((IOPTNN.NE.0).AND.(IOPTI.EQ.0))THEN
- CALL IGAXI1 (XFCT,YFCT,COSFI,SINFI,X0,Y0,XX,YY)
- CALL IGAXI1 (XEXP,YEXP,COSFI,SINFI,X0,Y0 ,XEXPT,
- + YEXPT)
- ELSE
- CALL IGAXI1 (XFCT,YFCT,COSFI,SINFI,XX0,YY0,XX,YY)
- CALL IGAXI1 (XEXP,YEXP,COSFI,SINFI,XX0,YY0 ,XEXPT,
- + YEXPT)
- ENDIF
- IF(NEXE.NE.1)THEN
- XX = XX-(IEND-ISTA)*(CHHEI*0.5)
- CALL ITX(XX,YY,'x 10')
- CALL ISCHH (CHHEI*0.8)
- CHTEMP=LABEL(ISTA:IEND)
- IF(X0.EQ.X1.AND.IOPTL.NE.0)XEXPT=XX+3.5*CHHEI
- CALL ITX(XEXPT,YEXPT,CHTEMP)
- CALL ISCHH (CHHEI)
- ELSE
- CALL ITX(XX,YY,'x 10')
- ENDIF
- ENDIF
-*
- ENDIF
- ENDIF
- ENDIF
-*
-* Log axis
-*
- IF(IOPTG.NE.0)THEN
- IF(NDIV.NE.0)THEN
- IF((WMIN.EQ.WMAX).OR.(NDIV.EQ.0)) THEN
- CALL IGERR('WMIN=WMAX or NDIV=0 (cf. HIGZ doc.)'
- + ,'IGAXIS')
- GOTO 210
- ENDIF
- IF(WMIN.LE.0.) THEN
- CALL IGERR('Negative logarithmic axis','IGAXIS')
- GOTO 210
- ENDIF
- IF(WMAX.LE.0.) THEN
- CALL IGERR('Negative logarithmic axis','IGAXIS')
- GOTO 210
- ENDIF
- XMNLOG = LOG10(WMIN)
- IF(XMNLOG.GT.0.)THEN
- XMNLOG = XMNLOG+1.E-6
- ELSE
- XMNLOG = XMNLOG-1.E-6
- ENDIF
- X00 = 0.
- X11 = AXLEN
- H2 = LOG10(WMAX)
- H2SAV = H2
- IF(H2.GT.0.)THEN
- H2 = H2+1.E-6
- ELSE
- H2 = H2-1.E-6
- ENDIF
- IH1 = IFIX(XMNLOG)
- IH2 = 1+IFIX(H2)
- NBININ = IH2-IH1+1
- AXMUL = (X11-X00)/(H2SAV-XMNLOG)
-*
-* If:
-* a) The number of decades is less than two.
-* and
-* b) 1 =< WMIN and WMAX =<10000
-* and
-* c) There is no labels overlap.
-* then some intermediate label are drawn (INTLOG=.TRUE).
-*
- INTLOG = .FALSE.
- IF(LOG10(WMAX/WMIN).LT.2..AND.
- + WMIN.GE.0.01.AND.WMAX.LE.10000.)INTLOG = .TRUE.
- SMALD = (LOG10(1./0.9)/LOG10(WMAX/WMIN))*AXLEN
- IF(XMIN.EQ.XMAX.AND.SMALD.LE.CHHEI)INTLOG = .FALSE.
- IF(YMIN.EQ.YMAX)THEN
- TEXTW = 0.
- CALL IGTEXT(0.,0.,'0.01',CHHEI,TEXTW,'S')
- IF(0.5*TEXTW.GT.SMALD)INTLOG = .FALSE.
- ENDIF
-*
-* Plot decade and intermediate tick marks
-*
- I = IH1-2
- NLAB = IH1
- IF ((XMNLOG.GT.0.).AND.
- + ((XMNLOG-FLOAT(IH1)).GT.0.)) NLAB = NLAB+1
- DO 190 J=1,NBININ
-*
-* Plot decade
-*
- I = I+1
- R = FLOAT(I)
- IF(Y0.EQ.Y1.AND.J.EQ.1)YLAB=YLAB-CHHEI*0.65
- XONE=X00+AXMUL*(R-XMNLOG)
- IF(X00.GT.XONE) GOTO 160
- IF(XONE.GT.X11) GOTO 200
- XTWO=XONE
- Y=0.
- IF(MSIDE.EQ.0)Y=Y-ATICK(1)
- CALL IGAXI1(XONE,Y,COSFI,SINFI,X0,Y0,XPL(2),YPL(2))
- CALL IGAXI1(XTWO,ATICK(1),COSFI,SINFI,X0,Y0
- + ,XPL(1),YPL(1))
- IF(IOPTV.NE.0)THEN
- IF((X0.NE.X1).AND.(Y0.NE.Y1))THEN
- IF(MSIDE.NE.0)THEN
- XPL(1)=XPL(2)
- IF(COSFI.GT.0)THEN
- YPL(1)=YPL(2)+ATICK(1)
- ELSE
- YPL(1)=YPL(2)-ATICK(1)
- ENDIF
- ELSE
- XML=(XPL(1)+XPL(2))/2.
- YML=(YPL(1)+YPL(2))/2.
- XPL(1)=XML
- XPL(2)=XML
- YPL(1)=YML+ATICK(1)
- YPL(2)=YML-ATICK(1)
- ENDIF
- ENDIF
- ENDIF
- CALL IPL(2,XPL,YPL)
-*
- IF(IOPTW.NE.0)THEN
- CALL IGAXI1(XONE,0.,COSFI,SINFI,X0,Y0,XPL(2),YPL(2))
- CALL IGAXI1(XONE,SIWIR*GRILEN,COSFI,SINFI,X0,Y0
- + ,XPL(1),YPL(1))
- CALL ISLN(IGRITY)
- CALL IPL(2,XPL,YPL)
- CALL ISLN(1)
- ENDIF
-*
- IF(IOPTU.EQ.0) THEN
-*
-* Here we generate labels (numeric only).
-*
- IF(INTLOG)THEN
- RLAB = 10.**FLOAT(NLAB)
- CALL IZRTOC(RLAB,LABEL)
- CALL IGAXI2(LABEL,ISTA,IEND)
- IF(LABEL(IEND:IEND).EQ.'.')IEND = IEND-1
- ELSE
- WRITE(LABEL,'(I3)')NLAB
- CALL IGAXI2(LABEL,ISTA,IEND)
- ENDIF
- DEXPY=CHHEI
- IF(NLAB.GT.0)THEN
- DEXPX=1.25*CHHEI
- ELSE
- DEXPX=2.25*CHHEI
- ENDIF
- IF(COSFI.GT.0)THEN
- XEXP=XONE+DEXPX
- YEXP=YLAB+DEXPY
- ELSE
- XEXP=XONE-DEXPX
- YEXP=YLAB-DEXPY
- ENDIF
- IF(Y0.EQ.Y1.AND.NLAB.LT.0)XEXP=XONE+0.5*DEXPX
- IF(X0.EQ.X1)THEN
- IF(Y0.LT.Y1)THEN
- XEXP=XONE+0.5*DEXPX
- YEXP=YLAB-DEXPY
- ELSE
- XEXP=XONE-DEXPX
- YEXP=YLAB+DEXPY
- ENDIF
- ENDIF
- CALL IGAXI1 (XONE,YLAB,COSFI,SINFI,X0,Y0,XX,YY)
- CALL IGAXI1 (XEXP,YEXP,COSFI,SINFI,X0,Y0,XEXPT,YEXPT)
- IF((Y0.EQ.Y1).AND.(IOPTO.EQ.0).AND.(IOPT0.EQ.0))THEN
- IF(LSIDE.LT.0)THEN
- YY=YY-CHHEI
- YEXPT=YEXPT-CHHEI
- ENDIF
- ENDIF
- IF(IOPTV.NE.0)THEN
- IF((X0.NE.X1).AND.(Y0.NE.Y1))THEN
- XEXPT=XX+0.5*DEXPX
- YEXPT=YY+DEXPY
- ENDIF
- ENDIF
- IF(X0.EQ.X1.AND.IOPTL.NE.0)XEXPT=XX+2.*CHHEI
- IF(N1A.EQ.0)GOTO 210
- KMOD=NBININ/N1A
- IF(KMOD.EQ.0)KMOD=1000000
- IF((NBININ.LE.N1A)
- + .OR.(J.EQ.1)
- + .OR.(J.EQ.NBININ)
- + .OR.((NBININ.GT.N1A)
- + .AND.(MOD(J,KMOD).EQ.0)))THEN
- IF((NLAB.NE.0).AND.(NLAB.NE.1))THEN
- IF(INTLOG)THEN
- CHTEMP=LABEL(ISTA:IEND)
- CALL ITX(XX,YY,CHTEMP)
- ELSE
- XX = XX-(IEND-ISTA)*(CHHEI*0.5)
- CALL ITX(XX,YY,'10')
- CALL ISCHH (CHHEI*0.8)
- CHTEMP=LABEL(ISTA:IEND)
- CALL ITX(XEXPT,YEXPT,CHTEMP)
- CALL ISCHH (CHHEI)
- ENDIF
- ENDIF
- IF(NLAB.EQ.0)CALL ITX(XX,YY,'1')
- IF(NLAB.EQ.1)CALL ITX(XX,YY,'10')
- ENDIF
- NLAB=NLAB+1
- ENDIF
- 160 CONTINUE
-*
- DO 180 K=2,9
-*
-* Plot intermediate tick marks
-*
- XONE=X00+AXMUL*(LOG10(FLOAT(K))+FLOAT(I)-XMNLOG)
- IF(X00.GT.XONE) GOTO 180
- IF(XONE.GT.X11) GOTO 200
- Y=0.
- IF(MSIDE .NE. 0) GOTO 170
- Y=Y-ATICK(2)
- 170 CONTINUE
- XTWO=XONE
- CALL IGAXI1(XONE,Y,COSFI,SINFI
- + ,X0,Y0,XPL(2),YPL(2))
- CALL IGAXI1(XTWO,ATICK(2),COSFI,SINFI,X0,Y0
- + ,XPL(1),YPL(1))
- IF(IOPTV.NE.0)THEN
- IF((X0.NE.X1).AND.(Y0.NE.Y1))THEN
- IF(MSIDE.NE.0)THEN
- XPL(1)=XPL(2)
- IF(COSFI.GT.0)THEN
- YPL(1)=YPL(2)+ATICK(2)
- ELSE
- YPL(1)=YPL(2)-ATICK(2)
- ENDIF
- ELSE
- XML=(XPL(1)+XPL(2))/2.
- YML=(YPL(1)+YPL(2))/2.
- XPL(1)=XML
- XPL(2)=XML
- YPL(1)=YML+ATICK(2)
- YPL(2)=YML-ATICK(2)
- ENDIF
- ENDIF
- ENDIF
- IDN=N1A*2
- IF((NBININ.LE.IDN).OR.
- + ((NBININ.GT.IDN).AND.(K.EQ.5)))THEN
- CALL IPL(2,XPL,YPL)
-*
-* Draw the intermediate LOG labels if requested
-*
- IF(INTLOG.AND.IOPTU.EQ.0)THEN
- RLAB=FLOAT(K)*(10.**FLOAT(NLAB-1))
- CALL IZRTOC(RLAB,CHTEMP)
- LNLEN=LENOCC(CHTEMP)
- IF(CHTEMP(LNLEN:LNLEN).EQ.'.')LNLEN=LNLEN-1
- CALL IGAXI1 (XONE,YLAB,COSFI,SINFI,X0,Y0,XX,YY)
-CCC IF((X0.EQ.X1).AND.(IOPTP.EQ.0))THEN
-CCC IF(LSIDE.LT.0)THEN
-CCC IF(NLAB.EQ.0)THEN
-CCC NCH=1
-CCC ELSE
-CCC NCH=2
-CCC ENDIF
-CCC XX=XX+NCH*CHHEI
-CCC ENDIF
-CCC ENDIF
- IF((Y0.EQ.Y1).AND.(IOPTO.EQ.0)
- + .AND.(IOPT0.EQ.0))THEN
- IF(LSIDE.LT.0)THEN
- YY=YY-CHHEI
- ENDIF
- ENDIF
- IF(IOPTV.NE.0)THEN
- IF((X0.NE.X1).AND.(Y0.NE.Y1))THEN
- CALL IGAXI1(XONE,YLAB,COSFI,SINFI,X0,Y0
- +, XX,YY)
- IF(COSFI.GT.0)THEN
- YY=YY+YLAB
- ELSE
- YY=YY-YLAB
- ENDIF
- ENDIF
- ENDIF
- CALL ITX(XX,YY,CHTEMP(1:LNLEN))
- ENDIF
-*
-* Draw the intermediate LOG grid if only three decades are requested
-*
- IF(IOPTW.NE.0.AND.NBININ.LE.5)THEN
- CALL IGAXI1(XONE,0.,COSFI,SINFI,X0,Y0,XPL(2)
- +, YPL(2))
- CALL IGAXI1(XONE,SIWIR*GRILEN,COSFI,SINFI,X0,Y0
- +, XPL(1),YPL(1))
- CALL ISLN(IGRITY)
- CALL IPL(2,XPL,YPL)
- CALL ISLN(1)
- ENDIF
-*
- ENDIF
- 180 CONTINUE
- 190 CONTINUE
- 200 CONTINUE
- ENDIF
- ENDIF
-*
- 210 CONTINUE
- CALL ISELNT(ICTR)
- CALL ISCHH(CHSIZ)
- CALL ISCHUP(CHUPXV,CHUPYV)
- CALL ISTXAL(IALH,IALV)
- CALL ISLN(ILNV)
- CALL ISPLCI(IPLCIS)
- CALL ISCLIP(ICLIPV)
- 220 ZFLAG=ZFSAV
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
-*
- END
diff --git a/src/graflib/higz/ig/igbox.F b/src/graflib/higz/ig/igbox.F
deleted file mode 100644
index 4bc85e3..0000000
--- a/src/graflib/higz/ig/igbox.F
+++ /dev/null
@@ -1,73 +0,0 @@
-*
-* $Id: igbox.F,v 1.2 1996/09/25 14:57:17 couet Exp $
-*
-* $Log: igbox.F,v $
-* Revision 1.2 1996/09/25 14:57:17 couet
-* - GPR driver removed
-*
-* Revision 1.1.1.1 1996/02/14 13:10:33 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.23/05 17/10/95 18.11.00 by O.Couet
-*-- Author :
- SUBROUTINE IGBOX(X1,X2,Y1,Y2)
-*.===========>
-*.
-*. This routine draws a boxe. The boxe is drawn according to the
-*. current fill area attributes .
-*.
-*. _Input parameters:
-*.
-*. REAL X1,Y1 : Left down corner (in WC) .
-*. REAL X2,Y2 : Right up corner (in WC) .
-*.
-*..==========> (O.Couet)
-#include "higz/hiflag.inc"
-#if (!defined(CERNLIB_GL))&&(!defined(CERNLIB_X11))&&(!defined(CERNLIB_FALCO))
-#include "higz/hiatt.inc"
- DIMENSION X(5),Y(5)
-#endif
- LOGICAL ZFSAV,PFSAV
-*.______________________________________
-*
- ZFSAV=ZFLAG
- PFSAV=PFLAG
- ZFLAG=.FALSE.
- PFLAG=.FALSE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
-#if defined(CERNLIB_GL)||defined(CERNLIB_X11)||defined(CERNLIB_FALCO)||defined(CERNLIB_MACMPW)
- CALL IKBOX(X1,X2,Y1,Y2)
-#endif
-#if (!defined(CERNLIB_GL))&&(!defined(CERNLIB_X11))&&(!defined(CERNLIB_FALCO))&&(!defined(CERNLIB_MACMPW))
- X(1)=X1
- X(2)=X2
- X(3)=X2
- X(4)=X1
- X(5)=X1
- Y(1)=Y1
- Y(2)=Y1
- Y(3)=Y2
- Y(4)=Y2
- Y(5)=Y1
- ILNOLD=ILN
- IF(GFLAG.OR.PFLAG)THEN
- IF(IFAIS.NE.0)THEN
- CALL IFA(4,X,Y)
- ENDIF
- IF(IFAIS.EQ.0.OR.IBORD.NE.0)THEN
- CALL ISLN(1)
- CALL IPL(5,X,Y)
- CALL ISLN(ILNOLD)
- ENDIF
- ENDIF
-#endif
- ZFLAG=ZFSAV
- PFLAG=PFSAV
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_PSCRIPT)||defined(CERNLIB_MAIL)
- IF(GLFLAG)CALL IZBOX(X1,X2,Y1,Y2)
-#endif
-*
- END
diff --git a/src/graflib/higz/ig/igcell.F b/src/graflib/higz/ig/igcell.F
deleted file mode 100644
index 018eea8..0000000
--- a/src/graflib/higz/ig/igcell.F
+++ /dev/null
@@ -1,86 +0,0 @@
-*
-* $Id: igcell.F,v 1.1.1.1 1996/02/14 13:10:33 mclareni Exp $
-*
-* $Log: igcell.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:33 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.22/08 27/02/95 17.22.05 by O.Couet
-*-- Author : O.Couet 11/09/89
- REAL FUNCTION IGCELL(NX,NY,V,I,J,IOPT)
-*.==========>
-*.
-*. Returns the value of cell defined by I and J according to the
-*. value of NPAR PAR and CHOPT given to IGTABL. If IOPT=1 the content
-*. of the cell I,J is returned, if IOPT=2 the error on the cell I,J is
-*. returned. The data can come from an HBOOK histogram (IPACK=1), from
-*. an HIGZ picture (IPACK=2) or from a FORTRAN array (IPACK=0).
-*.
-*..=========> (O.Couet)
-#include "higz/hipack.inc"
-#include "higz/hipaw.inc"
- DIMENSION V(NX,1)
- REAL IGHCXY
-*.___________________________________________
-*
-*
-* Get the content of the cell I,J (IOPT=1)
-*
- IF (IOPT.EQ.1) THEN
- IF (IPACK.EQ.1) THEN
- IGCELL = IGHCXY(INT(V(1,1)),I,J,1)
- ELSEIF (IPACK.EQ.2) THEN
- IF (IDIM1.NE.0) THEN
- IGCELL = Q(INT(V(1,1))+I)
- ELSE
- IGCELL = Q(INT(V(1,1))+(J-1)*NX+I)
- ENDIF
- ELSE
- IF (IDIM1.NE.0) THEN
- IGCELL = V(I,1)
- ELSE
- IGCELL = V(I,J)
- ENDIF
- ENDIF
-*
-* Adjust the content to ZHIGH and ZLOW
-*
- IF( ZHIGH.GT.ZLOW) THEN
- IF (IGCELL.GT.ZHIGH) IGCELL = ZHIGH
- IF (IGCELL.LT.ZLOW) IGCELL = ZLOW
- ENDIF
- ENDIF
-*
-* Get the error on the cell I,J (IOPT=2)
-*
- IF (IOPT.EQ.2) THEN
- IF (IPACK.EQ.1) THEN
- IGCELL = IGHCXY(INT(V(1,1)),I,J,2)
- ELSEIF (IPACK.EQ.2) THEN
- IF (IDIM1.NE.0) THEN
- IGCELL = SQRT(ABS(Q(INT(V(1,1))+I)))
- ELSE
- IGCELL = SQRT(ABS(Q(INT(V(1,1))+(J-1)*NX+I)))
- ENDIF
- ELSE
- IF (IDIM1.NE.0) THEN
- IGCELL = SQRT(ABS(V(I,1)))
- ELSE
- IGCELL = SQRT(ABS(V(I,J)))
- ENDIF
- ENDIF
- ENDIF
-*
-* LOG scale is required
-*
- IF (ILOG.NE.0) THEN
- IF (IGCELL.GT.0.) THEN
- IGCELL = LOG10(IGCELL)
- ELSE
- IGCELL = ZLOW
- ENDIF
- ENDIF
-*
- END
diff --git a/src/graflib/higz/ig/igchwk.F b/src/graflib/higz/ig/igchwk.F
deleted file mode 100644
index 686ed08..0000000
--- a/src/graflib/higz/ig/igchwk.F
+++ /dev/null
@@ -1,137 +0,0 @@
-*
-* $Id: igchwk.F,v 1.5 1998/01/30 15:22:16 couet Exp $
-*
-* $Log: igchwk.F,v $
-* Revision 1.5 1998/01/30 15:22:16 couet
-* - APOLLO version removed
-*
-* Revision 1.4 1998/01/28 14:34:20 couet
-* - GGDM driver removed
-*
-* Revision 1.3 1997/10/23 12:29:53 mclareni
-* NT mods
-*
-* Revision 1.2 1996/09/25 14:57:18 couet
-* - GPR driver removed
-*
-* Revision 1.1.1.1 1996/02/14 13:10:33 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.19/03 23/08/93 11.16.51 by O.Couet
-*-- Author : O.Couet 28/01/92
- SUBROUTINE IGCHWK(IWTYP,IX,IY,IW,IH)
-*.===========>
-*.
-*. This routine allows to change the workstation type parameters
-*. in the file higz_windows.dat.
-*.
-*..==========>
-#if defined(CERNLIB_KERNEL)
-#include "higz/hikern.inc"
-#endif
- CHARACTER*64 UHOME
- CHARACTER*128 TNAME
- LOGICAL INIT,OPND,EXIST1
- SAVE INIT,LUHOME,UHOME
- CHARACTER*48 CHWKTY(10)
-#if !defined(CERNLIB_KERNEL)||defined(CERNLIB_MSDOS)
- CHARACTER*80 FILEN
-#endif
-#if defined(CERNLIB_CRAY)
- INTEGER GETENV
-#endif
-#if (defined(CERNLIB_X11))&&(defined(CERNLIB_IBM))&&(!defined(CERNLIB_IBMMVS))
- CHARACTER*3 CHLUN
-#endif
- DATA INIT /.FALSE./
- DATA LUHOME /0/
- DATA UHOME /' '/
-*.______________________________________
-*
-#if (defined(CERNLIB_KERNEL))&&(!defined(CERNLIB_MSDOS))
- LUNWIN=20
- DO 10 I=20,99
- INQUIRE(UNIT=I,OPENED=OPND)
- IF(.NOT.OPND)THEN
- LUNWIN=I
- OPND=.TRUE.
- GOTO 20
- ENDIF
- 10 CONTINUE
-#endif
-#if (!defined(CERNLIB_KERNEL))&&(defined(CERNLIB_GKS)||defined(CERNLIB_DI3000))
- LUNWIN=0
- OPND=.FALSE.
-#endif
-*
- IF(.NOT.OPND)RETURN
-*
-#if defined(CERNLIB_IBM)
- 20 FILEN='/HIGZWIN DATA A'
-#endif
-#if (!defined(CERNLIB_IBM))&&(!defined(CERNLIB_IPSC))
- 20 FILEN='higz_windows.dat'
-#endif
-#if defined(CERNLIB_IPSC)
- 20 FILEN='higz_windows'
-#endif
-#if !defined(CERNLIB_IBM)
-*
- INQUIRE(FILE=FILEN,EXIST=EXIST1)
- IF(.NOT.EXIST1)THEN
-*
- IF (.NOT.INIT) THEN
-#endif
-#if defined(CERNLIB_UNIX)||defined(CERNLIB_CRAY)
- UHOME=' '
- CALL GETENVF('HOME',UHOME)
-#endif
-#if defined(CERNLIB_VAX)
- UHOME='SYS$LOGIN:'
-#endif
-#if !defined(CERNLIB_IBM)
- LUHOME=LENOCC(UHOME)
-#endif
-#if (!defined(CERNLIB_VAX))&&(!defined(CERNLIB_IBM))
- IF (UHOME(LUHOME:LUHOME) .NE. '/'
-#ifdef CERNLIB_WINNT
- * .OR. UHOME(LUHOME:LUHOME) .NE. '\'
-#endif
- * ) THEN
- LUHOME=LUHOME+1
- UHOME(LUHOME:LUHOME)='/'
- ENDIF
-#endif
-#if !defined(CERNLIB_IBM)
- INIT=.TRUE.
- ENDIF
-*
- TNAME = FILEN
- FILEN = UHOME(1:LUHOME)//TNAME
- ENDIF
-#endif
-*
- 30 INQUIRE(FILE=FILEN,EXIST=EXIST1)
- IF(EXIST1)THEN
- OPEN(UNIT=LUNWIN,FILE=FILEN,FORM='FORMATTED',STATUS='OLD'
- +, IOSTAT=ISTA)
- ELSE
- RETURN
- ENDIF
-*
- DO 40 I=1,10
- READ(LUNWIN,'(A)')CHWKTY(I)
- 40 CONTINUE
- CLOSE(LUNWIN)
- OPEN(UNIT=LUNWIN,FILE=FILEN,FORM='FORMATTED',STATUS='UNKNOWN'
- +, IOSTAT=ISTA)
- WRITE(CHWKTY(IWTYP), '(1X,I4.4,1X,I4.4,1X,I4.4,1X,I4.4)')IX,IY,
- +IW,IH
- DO 50 I=1,10
- WRITE(LUNWIN,'(A)',ERR=999)CHWKTY(I)
- 50 CONTINUE
- CLOSE(LUNWIN)
-*
- 999 END
diff --git a/src/graflib/higz/ig/igcles.F b/src/graflib/higz/ig/igcles.F
deleted file mode 100644
index 5e39a85..0000000
--- a/src/graflib/higz/ig/igcles.F
+++ /dev/null
@@ -1,65 +0,0 @@
-*
-* $Id: igcles.F,v 1.1.1.1 1996/02/14 13:10:33 mclareni Exp $
-*
-* $Log: igcles.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:33 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.18/00 05/04/93 10.44.38 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE IGCLES
-*.===========>
-*.
-*. This routine clears the editing space
-*.
-*..==========> (O.Couet)
-#include "higz/hiatt.inc"
-#include "higz/hiflag.inc"
- DIMENSION X(3),Y(3)
- LOGICAL ZFS,GFS,PFS
-*.______________________________________
-*
- CALL IZSAV
- ZFS=ZFLAG
- GFS=GFLAG
- PFS=PFLAG
- ZFLAG=.FALSE.
- PFLAG=.FALSE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- GFLAG=.TRUE.
-*
- ICLIPS=ICLIP
- REDITS=REDIT
- CALL IGSRAP(0.)
- CALL ISCLIP(0)
- CALL ISELNT(0)
-*
- CALL IGQWK(1,'MXDS',X)
- X2CL=MIN(X(1)/X(2),1.)*REDITS
- Y2CL=MIN(X(2)/X(1),1.)*REDITS
- X(1)=0.
- X(2)=X2CL
- X(3)=X2CL
- Y(1)=Y2CL
- Y(2)=Y2CL
- Y(3)=0.
- CALL IGSET('BORD',0.)
- CALL ISFACI(0)
- CALL ISFAIS(1)
- CALL ISLN(1)
- CALL ISPLCI(1)
- CALL IGBOX(0.,X2CL,0.,Y2CL)
- CALL IPL(3,X,Y)
-*
- CALL IGSRAP(REDITS)
- CALL ISCLIP(ICLIPS)
- CALL IZSET
- ZFLAG=ZFS
- PFLAG=PFS
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- GFLAG=GFS
-*
- END
-
diff --git a/src/graflib/higz/ig/igcli1.F b/src/graflib/higz/ig/igcli1.F
deleted file mode 100644
index f774f41..0000000
--- a/src/graflib/higz/ig/igcli1.F
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: igcli1.F,v 1.1.1.1 1996/02/14 13:10:33 mclareni Exp $
-*
-* $Log: igcli1.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:33 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.07/01 24/07/89 16.45.24 by O.Couet
-*-- Author : O.Couet 24/07/89
- FUNCTION IGCLI1(X,Y,XCL1,XCL2,YCL1,YCL2)
-*.===========>
-*.
-*. Compute the endpoint codes for IGCLIP.
-*.
-*..==========> (O.Couet)
- IGCLI1=0
- ICODE=0
- IF(X.LT.XCL1)CALL SBIT1(ICODE,1)
- IF(X.GT.XCL2)CALL SBIT1(ICODE,2)
- IF(Y.LT.YCL1)CALL SBIT1(ICODE,3)
- IF(Y.GT.YCL2)CALL SBIT1(ICODE,4)
- IGCLI1=ICODE
-*
- END
-
diff --git a/src/graflib/higz/ig/igclip.F b/src/graflib/higz/ig/igclip.F
deleted file mode 100644
index 1ba341e..0000000
--- a/src/graflib/higz/ig/igclip.F
+++ /dev/null
@@ -1,93 +0,0 @@
-*
-* $Id: igclip.F,v 1.1.1.1 1996/02/14 13:10:34 mclareni Exp $
-*
-* $Log: igclip.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:34 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.10/01 10/05/90 17.32.50 by O.Couet
-*-- Author : O.Couet 24/07/89
- FUNCTION IGCLIP(X,Y,XCLIPL,XCLIPR,YCLIPB,YCLIPT)
-*.===========>
-*.
-*. Clipping routine: Cohen Sutherland algorithm.
-*. If IGCLIP=0 the segment is outside the boundary.
-*.
-*. _Input parameters:
-*.
-*. REAL X(2),Y(2) : Segment coordinates
-*. REAL XCLIPL,XCLIPR,YCLIPB,YCLIPT : Clipping boundary
-*.
-*. _Output parameters:
-*.
-*. REAL X(2),Y(2) : New segment coordinates
-*.
-*. If IQUEST(50).NE.0 after a call to this function, the
-*. line has been clipped.
-*.
-*..==========> (O.Couet)
-#include "higz/hiques.inc"
- DIMENSION X(2),Y(2)
- PARAMETER (P=10000.)
-*.______________________________________
-*
- IGCLIP=0
-*
- DO 10 I=1,2
- IF(ABS(XCLIPL-X(I)).LE.ABS((XCLIPR-XCLIPL)/P))X(I)=XCLIPL
- IF(ABS(XCLIPR-X(I)).LE.ABS((XCLIPR-XCLIPL)/P))X(I)=XCLIPR
- IF(ABS(YCLIPB-Y(I)).LE.ABS((YCLIPT-YCLIPB)/P))Y(I)=YCLIPB
- IF(ABS(YCLIPT-Y(I)).LE.ABS((YCLIPT-YCLIPB)/P))Y(I)=YCLIPT
- 10 CONTINUE
-*
-* Compute the first endpoint codes.
-*
- ICODE1=IGCLI1(X(1),Y(1),XCLIPL,XCLIPR,YCLIPB,YCLIPT)
- ICODE2=IGCLI1(X(2),Y(2),XCLIPL,XCLIPR,YCLIPB,YCLIPT)
-*
- IQUEST(50)=0
- 20 IF((ICODE1+ICODE2).EQ.0)GOTO 30
- IQUEST(50)=1
-*
-* The line lies entirely outside the clipping boundary
-*
- IF(IAND(ICODE1,ICODE2).NE.0)THEN
- IGCLIP=0
- RETURN
- ENDIF
-*
-* The line is subdivide into several parts
-*
- IC=ICODE1
- IF(IC.EQ.0)IC=ICODE2
- IF(JBIT(IC,1).NE.0)THEN
- YT=Y(1)+(Y(2)-Y(1))*(XCLIPL-X(1))/(X(2)-X(1))
- XT=XCLIPL
- ENDIF
- IF(JBIT(IC,2).NE.0)THEN
- YT=Y(1)+(Y(2)-Y(1))*(XCLIPR-X(1))/(X(2)-X(1))
- XT=XCLIPR
- ENDIF
- IF(JBIT(IC,3).NE.0)THEN
- XT=X(1)+(X(2)-X(1))*(YCLIPB-Y(1))/(Y(2)-Y(1))
- YT=YCLIPB
- ENDIF
- IF(JBIT(IC,4).NE.0)THEN
- XT=X(1)+(X(2)-X(1))*(YCLIPT-Y(1))/(Y(2)-Y(1))
- YT=YCLIPT
- ENDIF
- IF(IC.EQ.ICODE1)THEN
- X(1)=XT
- Y(1)=YT
- ICODE1=IGCLI1(XT,YT,XCLIPL,XCLIPR,YCLIPB,YCLIPT)
- ELSE
- X(2)=XT
- Y(2)=YT
- ICODE2=IGCLI1(XT,YT,XCLIPL,XCLIPR,YCLIPB,YCLIPT)
- ENDIF
- GOTO 20
- 30 IGCLIP=1
-*
- END
diff --git a/src/graflib/higz/ig/igcolm.F b/src/graflib/higz/ig/igcolm.F
deleted file mode 100644
index 34c2cd8..0000000
--- a/src/graflib/higz/ig/igcolm.F
+++ /dev/null
@@ -1,202 +0,0 @@
-*
-* $Id: igcolm.F,v 1.2 2002/04/04 10:18:20 couet Exp $
-*
-* $Log: igcolm.F,v $
-* Revision 1.2 2002/04/04 10:18:20 couet
-* - new routine IGCOL1 allowing to modify the number of axis divisions on
-* the axis color palette
-*
-* Revision 1.1.1.1 1996/02/14 13:10:34 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.23/06 10/11/95 09.45.01 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE IGCOLM(X1I,X2I,Y1I,Y2I,IC1,IC2,ZMIN,ZMAX,CHOPT)
-#include "higz/hiatt.inc"
- CHARACTER*(*) CHOPT
- CHARACTER*8 CHOPAX
- DIMENSION IC2(*),IOPT(9)
- EQUIVALENCE (IOPTC,IOPT(1)),(IOPTB,IOPT(2))
- EQUIVALENCE (IOPTA,IOPT(3)),(IOPTH,IOPT(4))
- EQUIVALENCE (IOPTP,IOPT(5)),(IOPTG,IOPT(6))
- EQUIVALENCE (IOPTL,IOPT(7)),(IOPTR,IOPT(8))
- EQUIVALENCE (IOPTT,IOPT(9))
- DIMENSION LUT(8)
- COMMON /HICOLM/ NDIVZ
- DATA NDIVZ /10/
- DATA LUT /0,5,7,3,6,2,4,1/
-*.______________________________________
-*
- CALL UOPTC(CHOPT,'CBAHPGLRT',IOPT)
- X1 = X1I
- X2 = X2I
- Y1 = Y1I
- Y2 = Y2I
-*
- IF(IOPTL.NE.0)THEN
- IF(INBCOL.GT.8)THEN
- IC1=8
- IC2(1)=INBCOL
- ELSE
- IC1=0
- IC2(1)=7
- ENDIF
- ENDIF
-*
- IF(X1.EQ.X2.OR.Y1.EQ.Y2)THEN
- XX = 0.01*(RWXMAX-RWXMIN)
- X1 = RWXMAX+XX
- X2 = RWXMAX+4.*XX
- Y1 = RWYMIN
- Y2 = RWYMAX
- ENDIF
-*
- IF(IOPTP.NE.0)THEN
- N=IC1
- ELSE
- N=IC2(1)-IC1+1
- ENDIF
- DY=(Y2-Y1)/FLOAT(N)
- DX=(X2-X1)/FLOAT(N)
-*
-* Draw the levels with colors
-*
- IF(IOPTC.NE.0)THEN
- CALL IGSET('BORD',0.)
- CALL IGSET('PLCI',1.)
- CALL IGSET('FAIS',1.)
- DO 10 I=1,N
- IF(IOPTP.NE.0)THEN
- ICOL=IC2(I)
- ELSE
- ICOL=IC1+I-1
- ENDIF
- IF(ICOL.LE.7.AND.IOPTP.EQ.0)THEN
- CALL ISFACI(LUT(ICOL+1))
- ELSE
- CALL ISFACI(ICOL)
- ENDIF
- IF(IOPTH.NE.0)THEN
- CALL IGBOX(X1+DX*FLOAT(I-1),X1+DX*FLOAT(I),Y1,Y2)
- ELSE
- CALL IGBOX(X1,X2,Y1+DY*FLOAT(I-1),Y1+DY*FLOAT(I))
- ENDIF
- 10 CONTINUE
- CALL IGSET('BORD',0.)
- CALL IGSET('FAIS',0.)
- CALL IGBOX(X1,X2,Y1,Y2)
- ENDIF
-*
-* Draw the levels with boxes
-*
- IF(IOPTB.NE.0)THEN
- IF(IOPTH.NE.0)THEN
- YS=(Y2-Y1)/(2.*FLOAT(N))
- XS=DX/(2.*FLOAT(N))
- ELSE
- XS=(X2-X1)/(2.*FLOAT(N))
- YS=DY/(2.*FLOAT(N))
- ENDIF
- DO 20 I=1,N
- ST=FLOAT(N-I)
- IF(IOPTH.NE.0)THEN
- CALL IGBOX(X1+DX*FLOAT(I-1)+ST*XS,X1+DX*FLOAT(I)-ST*XS
- +, Y1+ST*YS,Y2-ST*YS)
- ELSE
- CALL IGBOX(X1+ST*XS,X2-ST*XS
- +, Y1+DY*FLOAT(I-1)+ST*YS,Y1+DY*FLOAT(I)-ST*YS)
- ENDIF
- 20 CONTINUE
- ENDIF
-*
-* Draw the axis
-*
- IF(IOPTA.NE.0)THEN
- IF(IOPTH.NE.0)THEN
- CALL IGSET('TMSI',Y2-Y1)
- IF(IOPTG.NE.0)THEN
- IF(ZMAX.GT.0.)THEN
- ZMING = ZMIN
- IF(ZMIN.LE.0.)ZMING = 0.001*ZMAX
- IF(IOPTT.NE.0)THEN
- CHOPAX = '-DHSG'
- XX1 = X1
- XX2 = X2
- YY1 = Y2
- YY2 = Y2
- ELSE
- CHOPAX = 'DHSG'
- XX1 = X1
- XX2 = X2
- YY1 = Y1
- YY2 = Y1
- ENDIF
- ENDIF
- ELSE
- IF(IOPTT.NE.0)THEN
- CHOPAX = '-DHS'
- XX1 = X1
- XX2 = X2
- YY1 = Y2
- YY2 = Y2
- ELSE
- CHOPAX = 'DHS'
- XX1 = X1
- XX2 = X2
- YY1 = Y1
- YY2 = Y1
- ENDIF
- ENDIF
- ELSE
- CALL IGSET('TMSI',X2-X1)
- IF(IOPTG.NE.0)THEN
- IF(ZMAX.GT.0.)THEN
- ZMING = ZMIN
- IF(ZMIN.LE.0.)ZMING = 0.001*ZMAX
- IF(IOPTR.NE.0)THEN
- CHOPAX = 'DHSGR'
- XX1 = X2
- XX2 = X2
- YY1 = Y1
- YY2 = Y2
- ELSE
- CHOPAX = 'DHS+GL'
- XX1 = X2
- XX2 = X2
- YY1 = Y1
- YY2 = Y2
- ENDIF
- ENDIF
- ELSE
- IF(IOPTR.NE.0)THEN
- CHOPAX = 'DHSR'
- XX1 = X1
- XX2 = X1
- YY1 = Y1
- YY2 = Y2
- ELSE
- CHOPAX = 'DHS+L'
- XX1 = X2
- XX2 = X2
- YY1 = Y1
- YY2 = Y2
- ENDIF
- ENDIF
- ENDIF
- IF (NDIVZ.LT.0) THEN
- CHOPAX(8:8) = 'N'
- NDIV = -NDIVZ
- ELSE
- NDIV = NDIVZ
- ENDIF
- CALL IGAXIS(XX1,XX2,YY1,YY2,ZMIN,ZMAX,NDIV,CHOPAX)
- ENDIF
-*
- END
-
- SUBROUTINE IGCOL1(NDIVZI)
- COMMON /HICOLM/ NDIVZ
- NDIVZ = MOD(NDIVZI,100)
- END
diff --git a/src/graflib/higz/ig/igconv.F b/src/graflib/higz/ig/igconv.F
deleted file mode 100644
index a20fc82..0000000
--- a/src/graflib/higz/ig/igconv.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: igconv.F,v 1.1.1.1 1996/02/14 13:10:34 mclareni Exp $
-*
-* $Log: igconv.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:34 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.10/00 24/04/90 12.07.19 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE IGCONV(N,X,Y)
-*.===========>
-*.
-*. Convert X and Y coordinates from X1 to X2 2D repere
-*.
-*..==========> (O.Couet)
-#include "higz/hiconv.inc"
- DIMENSION X(*),Y(*)
-*.______________________________________
-*
- DO 10 I=1,N
- X(I)=((X(I)-X1MIN)*(X2MAX-X2MIN))/(X1MAX-X1MIN)+X2MIN
- Y(I)=((Y(I)-Y1MIN)*(Y2MAX-Y2MIN))/(Y1MAX-Y1MIN)+Y2MIN
- 10 CONTINUE
- END
diff --git a/src/graflib/higz/ig/igdate.F b/src/graflib/higz/ig/igdate.F
deleted file mode 100644
index ee1ebb9..0000000
--- a/src/graflib/higz/ig/igdate.F
+++ /dev/null
@@ -1,56 +0,0 @@
-*
-* $Id: igdate.F,v 1.4 1998/11/06 16:30:38 couet Exp $
-*
-* $Log: igdate.F,v $
-* Revision 1.4 1998/11/06 16:30:38 couet
-* - Should pass Y2K without problems ...
-*
-* Revision 1.3 1998/01/30 15:22:17 couet
-* - APOLLO version removed
-*
-* Revision 1.2 1997/03/14 14:23:14 mclareni
-* WNT mods
-*
-* Revision 1.1.1.1.2.1 1997/01/21 11:25:27 mclareni
-* All mods for Winnt 96a on winnt branch
-*
-* Revision 1.1.1.1 1996/02/14 13:10:34 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.14/11 30/06/92 11.01.57 by O.Couet
-*-- Author : O.Couet 31/10/90
- SUBROUTINE IGDATE(CHDT)
-*.===========>
-*.
-*. Gives the date
-*.
-*. _Output parameters:
-*.
-*. CHARACTER CHDT : Date
-*.
-*..==========> (O.Couet)
- COMMON /SLATE/ ISL(40)
- CHARACTER*8 DAYDAT,DAYTIM
- CHARACTER*(*) CHDT
-*.______________________________________
-*
- CALL DATIME(ID,IT)
- IYEAR = ISL(1)
- IMONTH = ISL(2)
- IDAY = ISL(3)
- IHOUR = ISL(4)
- IMIN = ISL(5)
-*
- CHDT = ' '
- WRITE (CHDT(1:4),'(I4.4)') IYEAR
- CHDT(5:5) = '/'
- WRITE (CHDT(6:7),'(I2.2)') IMONTH
- CHDT(8:8) = '/'
- WRITE (CHDT(9:10),'(I2.2)') IDAY
- WRITE (CHDT(14:15),'(I2.2)') IHOUR
- CHDT(16:16) = '.'
- WRITE (CHDT(17:18),'(I2.2)') IMIN
-*
- END
diff --git a/src/graflib/higz/ig/igdwk.F b/src/graflib/higz/ig/igdwk.F
deleted file mode 100644
index ee0d4dc..0000000
--- a/src/graflib/higz/ig/igdwk.F
+++ /dev/null
@@ -1,129 +0,0 @@
-*
-* $Id: igdwk.F,v 1.4 1998/01/30 15:22:17 couet Exp $
-*
-* $Log: igdwk.F,v $
-* Revision 1.4 1998/01/30 15:22:17 couet
-* - APOLLO version removed
-*
-* Revision 1.3 1998/01/28 14:34:21 couet
-* - GGDM driver removed
-*
-* Revision 1.2 1996/09/25 14:57:19 couet
-* - GPR driver removed
-*
-* Revision 1.1.1.1 1996/02/14 13:10:34 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.23/01 08/05/95 11.34.18 by O.Couet
-*-- Author : O.Couet 26/11/93
- SUBROUTINE IGDWK(IWKTY)
-*.===========>
-*.
-*. This routine returns the default workstation type.
-*.
-*..==========> (O.Couet)
-#if defined(CERNLIB_MSDOS)
- CHARACTER*16 CHTMP
-#endif
-#if (defined(CERNLIB_DECGKS))&&(defined(CERNLIB_VAX))
- CHARACTER*12 STRING
- INCLUDE '($SSDEF)'
-#endif
-#if (defined(CERNLIB_DECGKS))&&(defined(CERNLIB_DECS))
- CHARACTER*12 STRING
-#endif
-*.______________________________________
-*
-#if (defined(CERNLIB_SGI)||defined(CERNLIB_HPUX)||defined(CERNLIB_IBMRT)||defined(CERNLIB_SUN)||defined(CERNLIB_DECS))&&(defined(CERNLIB_GKSGRAL))&&(!defined(CERNLIB_GKSIBM))
- IWKTY = 32120
-#endif
-#if (defined(CERNLIB_IBMRT))&&(defined(CERNLIB_GKSIBM))
- IWKTY = 6
-#endif
-#if defined(CERNLIB_BATCH)
- IWKTY = 1
-#endif
-#if (defined(CERNLIB_GL)||defined(CERNLIB_X11)||defined(CERNLIB_MACMPW))&&(!defined(CERNLIB_MSDOS))
- IWKTY = 1
-#endif
-#if (defined(CERNLIB_MSDOS))&&(defined(CERNLIB_NDP))
- IWKTY = VIDEO_CONFIGURATION(VIDEO_SYSTEM)
- IF(IWKTY .GE. 18) THEN
- CALL GETENVF('SVGA_MODE',CHTMP)
- IF(CHTMP .NE. ' ')THEN
- READ(CHTMP,*,ERR = 5) I
- IWKTY = I
- ENDIF
- ENDIF
- 5 CONTINUE
-#endif
-#if (defined(CERNLIB_MSDOS))&&(!defined(CERNLIB_NDP))
- IWKTY = 18
-#endif
-#if (defined(CERNLIB_FALCO))&&(!defined(CERNLIB_KERNEL))
- IWKTY = 7878
-#endif
-#if (defined(CERNLIB_SUN))&&(defined(CERNLIB_SUNGKS))
- IWKTY = 4
-#endif
-#if (defined(CERNLIB_VAX))&&(defined(CERNLIB_GKSGRAL))&&(!defined(CERNLIB_ATCGKS))
- IWKTY = 7878
-#endif
-#if (defined(CERNLIB_VAX))&&(defined(CERNLIB_ATCGKS))
- IWKTY = 2602
-#endif
-#if (defined(CERNLIB_SUN))&&(defined(CERNLIB_ATCGKS))
- IWKTY = 5350
-#endif
-#if (defined(CERNLIB_VAX))&&(defined(CERNLIB_DECGKS))&&(!defined(CERNLIB_WINDOWS))
- IF (SS$_NORMAL.EQ.LIB$SYS_TRNLOG('GKS$WSTYPE',LENGTH,STRING)) THEN
- IF(STRING(1:2).EQ.'%X') THEN
- READ(STRING(3:LENGTH),'(Z8)') IWKTY
- ELSE
- READ(STRING(1:LENGTH),*) IWKTY
- ENDIF
- ELSE
- IWKTY = 14
- ENDIF
-#endif
-#if (defined(CERNLIB_VAX))&&(defined(CERNLIB_DECGKS))&&(defined(CERNLIB_WINDOWS))
- IWKTY = 211
-#endif
-#if (defined(CERNLIB_DECGKS))&&(defined(CERNLIB_DECS))
- CALL GETENV('GKS3Dwstype',STRING)
- LENGTH = LENOCC(STRING)
- IF(LENGTH.GT.0)THEN
- READ(STRING(1:LENGTH),*)IWKTY
- ELSE
- IWKTY=211
- ENDIF
- IWKTY = IWKTY
-#endif
-#if (defined(CERNLIB_VAX))&&(!defined(CERNLIB_GKSGRAL))&&(!defined(CERNLIB_DECGKS))&&(!defined(CERNLIB_ATCGKS))&&(defined(CERNLIB_GKS))
- IWKTY = 301400
-#endif
-#if (defined(CERNLIB_IBM)||defined(CERNLIB_AIX370)||defined(CERNLIB_ALLIANT))&&(defined(CERNLIB_GKSGRAL))&&(!defined(CERNLIB_NEWLIB))
- IWKTY = 7878
-#endif
-#if (defined(CERNLIB_GKSGRAL))&&(defined(CERNLIB_NEWLIB))
- IWKTY = 5003
-#endif
-#if (defined(CERNLIB_IBM)||defined(CERNLIB_AIX370))&&(!defined(CERNLIB_GKSGRAL))&&(defined(CERNLIB_GKS))
- IWKTY = 301400
-#endif
-#if (defined(CERNLIB_DI3000))&&(defined(CERNLIB_IBM))
- IWKTY = 1
-#endif
-#if (defined(CERNLIB_DI3000))&&(!defined(CERNLIB_IBM))
- IWKTY = 1
-#endif
-#if defined(CERNLIB_GKSBX)
- IWKTY = 8811
-#endif
-#if defined(CERNLIB_PHIGS)
- IWKTY = 8887
-#endif
-*
- END
diff --git a/src/graflib/higz/ig/igelli.F b/src/graflib/higz/ig/igelli.F
deleted file mode 100644
index 04a4247..0000000
--- a/src/graflib/higz/ig/igelli.F
+++ /dev/null
@@ -1,113 +0,0 @@
-*
-* $Id: igelli.F,v 1.3 1999/06/21 16:45:21 couet Exp $
-*
-* $Log: igelli.F,v $
-* Revision 1.3 1999/06/21 16:45:21 couet
-* - An ellipse with FAIS.NE.0, had an axis drawn.
-*
-* Revision 1.2 1998/03/20 15:46:06 couet
-* - The ELLIPSE command always draw the ellipse with the first angle equal to
-* zero even if a non zero value is given.
-*
-* null 0 10 0 10
-* ellipse 5 5 4 2 90 270
-*
-* Some improvements have also be done in the ELLIPSE drawing:
-*
-* nul 0 10 0 10 ; elli 5 5 2 4 1 360 30
-* set bord 1
-* nul 0 10 0 10 ; elli 5 5 2 4 1 360 30
-* set fais 1
-* set faci 2
-* nul 0 10 0 10 ; elli 5 5 2 4 1 360 30
-*
-* Revision 1.1.1.1 1996/02/14 13:10:34 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.23/05 17/10/95 18.17.05 by O.Couet
-*-- Author : O.Couet 17/10/95
- SUBROUTINE IGELLI(XCI,YCI,RXI,RYI,PHIMIN,PHIMAI,THETA)
-*.===========>
-*.
-*. Draw an ellipse in the current NT
-*. (original code: Ellipse macro from Michael Kelsey)
-*.
-*. Draws an ellipse in the current normalization transformation.
-*. The parameter THETA rotates the ellipse major and minor axes
-*. (RX and RY) relative to the coordinates by the given angle.
-*.
-*. _Input parameters:
-*.
-*. REAL XC : X coord of centre.
-*. REAL YC : Y coord of centre.
-*. REAL RX : X radius of ellipse.
-*. REAL RY : Y radius of ellipse.
-*. REAL PHIMIN : Minimum angle (degrees).
-*. REAL PHIMAX : Maximum angle (degrees).
-*. REAL THETA : Rotation of axes of (degrees).
-*.
-*..==========>
-#include "higz/higraf.inc"
-#include "higz/hiatt.inc"
- PARAMETER (PI=3.1415926)
-*.______________________________________
-*
- XC = XCI
- YC = YCI
- RX = RXI
- RY = RYI
- IF (RY.EQ.0.) RY = RX
-*
- PHIMAX = PHIMAI
- IF (PHIMAX.GT.360.) PHIMAX = MOD(PHIMAX,360.)
- NP = INT(PHIMAX-PHIMIN)+1
- DPHI = (PHIMAX-PHIMIN)/NP
-*
- DO 10 I=1,NP
- PHI = (PI/180.)*(I*DPhi+PHIMIN)
- XGRAF(I) = RX*COS(Phi)
- YGRAF(I) = RY*SIN(Phi)
- 10 CONTINUE
-*
- If (THETA.NE.0) THEN
- TH = THETA*PI/180.
- Do 20 I=1,NP
- X = XGRAF(I)
- Y = YGRAF(I)
- XGRAF(I) = X*COS(Th)-Y*SIN(Th)
- YGRAF(I) = X*SIN(Th)+Y*COS(Th)
- 20 CONTINUE
- ENDIF
-*
- DO 30 I=1,NP
- XGRAF(I) = XGRAF(I)+XC
- YGRAF(I) = YGRAF(I)+YC
- 30 CONTINUE
-*
- NPT = NP
- IF (PHIMIN.EQ.0.AND.PHIMAX.EQ.360) THEN
- NPT = NP+1
- XGRAF(NPT) = XGRAF(1)
- YGRAF(NPT) = YGRAF(1)
- ELSE
- IF (IFAIS.NE.0.OR.IBORD.NE.0) THEN
- NPT = NP+2
- XGRAF(NPT-1) = XC
- YGRAF(NPT-1) = YC
- XGRAF(NPT) = XGRAF(1)
- YGRAF(NPT) = YGRAF(1)
- ENDIF
- ENDIF
-*
- IF (IFAIS.NE.0) CALL IFA(NPT,XGRAF,YGRAF)
-*
- IF (IFAIS.EQ.0.OR.IBORD.NE.0) Then
- ILNOLD = ILN
- CALL ISLN(1)
- CALL IPL (NPT,XGRAF,YGRAF)
- CALL ISLN(ILNOLD)
- ENDIF
-*
- END
diff --git a/src/graflib/higz/ig/igend.F b/src/graflib/higz/ig/igend.F
deleted file mode 100644
index bb1b99c..0000000
--- a/src/graflib/higz/ig/igend.F
+++ /dev/null
@@ -1,71 +0,0 @@
-*
-* $Id: igend.F,v 1.1.1.1 1996/02/14 13:10:34 mclareni Exp $
-*
-* $Log: igend.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:34 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.20/02 03/11/93 11.47.49 by O.Couet
-*-- Author :
- SUBROUTINE IGEND
-*.===========>
-*.
-*. This routine end an HIGZ cession .
-*.
-*..==========> (O.Couet)
-#if defined(CERNLIB_GKS)
-#include "higz/hiatt.inc"
-#endif
-#if defined(CERNLIB_DI3000)
-#include "higz/di3seg.inc"
-#endif
-#if defined(CERNLIB_DI3000)
-#include "higz/di3dev.inc"
-#endif
-#if defined(CERNLIB_DI3000)
- INTEGER*4 MAXDEV
- PARAMETER (MAXDEV = 9)
- INTEGER*4 DEVICES(0:MAXDEV)
- EQUIVALENCE (ILOPWK,DEVICES)
-#endif
-*.______________________________________
-*
-#if defined(CERNLIB_FALCO)
- CALL IGSA(0)
-#endif
-#if defined(CERNLIB_GKS)
- INOP=INOPWK
- DO 10 I=1,INOP
- CALL IGQWK(ILOPWK(I),'ACTI',RVAL)
- IF(RVAL.NE.0.)THEN
- CALL IDAWK(ILOPWK(I))
- ENDIF
- CALL ICLWK(ILOPWK(I))
- 10 CONTINUE
-#endif
-#if defined(CERNLIB_DI3000)
- IF (ENTRY_FLAG) CALL JUPDAT
- IF (SEGOPN) THEN
- CALL JCLOSE
- SEGOPN = .FALSE.
- ENDIF
- DO 10 I=0,MAXDEV
- IF (DEVICES(I).NE.0) THEN
- IF (DEVICES(I).EQ.2) THEN
- IF (I.GT.0) CALL IGSG(I)
- CALL JDEVOF(I)
- ENDIF
- CALL JDEND(I)
- DEVICES(I) = 0
- ENDIF
- 10 CONTINUE
-#endif
- CALL ICLKS
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_MAIL)
- CALL IZEND
-#endif
- CALL IGINIT(-1)
-*
- END
diff --git a/src/graflib/higz/ig/igerr.F b/src/graflib/higz/ig/igerr.F
deleted file mode 100644
index 62451a3..0000000
--- a/src/graflib/higz/ig/igerr.F
+++ /dev/null
@@ -1,64 +0,0 @@
-*
-* $Id: igerr.F,v 1.1.1.1 1996/02/14 13:10:34 mclareni Exp $
-*
-* $Log: igerr.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:34 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.13/07 04/11/91 16.28.50 by O.Couet
-*-- Author :
- SUBROUTINE IGERR(ERRTEX,RNAME)
-*.===========>
-*.
-*. This prints on the screen the error message (ERRTEX) and
-*. the routine name (RNAME). This routine sets also IQUEST(1)
-*. to 1. If RNAME equal ' ' only a warning is printed and
-*. IQUEST(1) is sets to 0.
-*.
-*. _Input parameters:
-*.
-*. INTEGER ERRTEX : Error text .
-*. CHARACTER RNAME : Routine name .
-*.
-*..==========> (O.Couet)
-#include "higz/hilun.inc"
-#include "higz/hiques.inc"
- CHARACTER*(*) RNAME,ERRTEX
- CHARACTER*80 CHTEXT
- LOGICAL OPND
- SAVE IFIRST
- DATA IFIRST /1/
-*.___________________________________________
-*
- IF(IFIRST.NE.0.AND.LUNERR.NE.LUNOUT)THEN
- INQUIRE(UNIT=LUNERR,OPENED=OPND)
- IF(.NOT.OPND)THEN
-#if defined(CERNLIB_IBM)
- OPEN(LUNERR,FILE='/HIGZ ERR',
- + FORM='FORMATTED',STATUS='UNKNOWN')
-#endif
-#if !defined(CERNLIB_IBM)
- OPEN(LUNERR,FILE='higz.err',
- + FORM='FORMATTED',STATUS='UNKNOWN')
-#endif
- ENDIF
- ENDIF
- IFIRST=0
- CALL IGSA(0)
- NR=LENOCC(RNAME)
- NE=LENOCC(ERRTEX)
- IF(NR.GT.1)THEN
- CHTEXT=' ***** ERROR in '//RNAME(1:NR)//' : '//ERRTEX(1:NE)
- NC=NE+NR+20
- IQUEST(1)=1
- ELSE
- CHTEXT=' *** '//ERRTEX(1:NE)
- NC=NE+6
- IQUEST(1)=0
- ENDIF
-*
- WRITE(LUNERR,'(A)')CHTEXT(1:NC)
-*
- END
diff --git a/src/graflib/higz/ig/igfa.F b/src/graflib/higz/ig/igfa.F
deleted file mode 100644
index f08677f..0000000
--- a/src/graflib/higz/ig/igfa.F
+++ /dev/null
@@ -1,84 +0,0 @@
-*
-* $Id: igfa.F,v 1.1.1.1 1996/02/14 13:10:34 mclareni Exp $
-*
-* $Log: igfa.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:34 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.08/00 05/10/89 10.14.18 by O.Couet
-*-- Author : O.Couet 27/09/89
- SUBROUTINE IGFA(N,X,Y)
-*.===========>
-*.
-*. This routine draws a fill area with HIGZ hatch style.
-*. The convention for the Hatch is the following:
-*.
-*. CALL ISFAIS(3)
-*. CALL ISFASI(ijk)
-*.
-*. i (1-9) : specify the space between each hatch
-*. 1 = 1/2mm 9 = 6mm
-*.
-*. j (0-9) : specify angle between 0 and 90 degrees
-*.
-*. 0 = 0
-*. 1 = 10
-*. 2 = 20
-*. 3 = 30
-*. 4 = 45
-*. 5 = Not drawn
-*. 6 = 60
-*. 7 = 70
-*. 8 = 80
-*. 9 = 90
-*.
-*. k (0-9) : specify angle between 90 and 180 degrees
-*. 0 = 180
-*. 1 = 170
-*. 2 = 160
-*. 3 = 150
-*. 4 = 135
-*. 5 = Not drawn
-*. 6 = 120
-*. 7 = 110
-*. 8 = 100
-*. 9 = 90
-*.
-*. _Input parameters:
-*.
-*. INTEGER N : Number of points .
-*. REAL X(N) : X coordinates .
-*. REAL Y(N) : Y coordinates .
-*.
-*..==========> (O.Couet)
-#include "higz/hiatt.inc"
-#include "higz/hiflag.inc"
- DIMENSION X(*),Y(*)
- DIMENSION ANG1(10),ANG2(10)
- LOGICAL ZFSAV,MFSAV
- DATA ANG1 / 0., 10., 20., 30., 45.,5., 60., 70., 80., 90./
- DATA ANG2 /180.,170.,160.,150.,135.,5.,120.,110.,100., 90./
-*.______________________________________
-*
- ZFSAV=ZFLAG
- MFSAV=MFLAG
- ZFLAG=.FALSE.
- MFLAG=.FALSE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
-*
- IDSPA=INT(IFASI/100)
- IANG2=INT((IFASI-100*IDSPA)/10)
- IANG1=MOD(IFASI,10)
- DY=0.003*FLOAT(IDSPA)
- IANG1=IANG1+1
- IANG2=IANG2+1
- IF(ANG1(IANG1).NE.5.)CALL IGHATC(DY,ANG1(IANG1),N,X,Y)
- IF(ANG2(IANG2).NE.5.)CALL IGHATC(DY,ANG2(IANG2),N,X,Y)
-*
- ZFLAG=ZFSAV
- MFLAG=MFSAV
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
-*
- END
diff --git a/src/graflib/higz/ig/igfbox.F b/src/graflib/higz/ig/igfbox.F
deleted file mode 100644
index c5ff75d..0000000
--- a/src/graflib/higz/ig/igfbox.F
+++ /dev/null
@@ -1,95 +0,0 @@
-*
-* $Id: igfbox.F,v 1.1.1.1 1996/02/14 13:10:34 mclareni Exp $
-*
-* $Log: igfbox.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:34 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.15/00 03/07/92 13.16.33 by O.Couet
-*-- Author :
- SUBROUTINE IGFBOX(X1,X2,Y1,Y2,X3,X4,Y3,Y4)
-*.===========>
-*.
-*. This routine draws a frame boxe . The frame is drawn according to the
-*. current fill area attributes .
-*.
-*. _Input parameters:
-*.
-*. INTEGER X1,Y1 : Left down corner coordinates of the inside boxe
-*. of the frame .
-*. INTEGER X2,Y2 : Right up corner coordinates of the inside boxe
-*. of the frame .
-*. INTEGER X3,Y3 : Left down corner coordinates of the outside boxe
-*. of the frame .
-*. INTEGER X4,Y4 : Right up corner coordinates of the outside boxe
-*. of the frame .
-*.
-*..==========> (O.Couet)
-#include "higz/hiflag.inc"
-#include "higz/hiatt.inc"
- DIMENSION X(12),Y(12)
- INTEGER ILNSAV
- LOGICAL ZFSAV
-*.______________________________________
-*
- IF(X1 .LE. X2)THEN
- XIN1 = X1
- XIN2 = X2
- ELSE
- XIN1 = X2
- XIN2 = X1
- ENDIF
- IF(X3.LE.X4)THEN
- XIN3 = X3
- XIN4 = X4
- ELSE
- XIN3 = X4
- XIN4 = X3
- ENDIF
- X(1)=XIN1
- X(2)=XIN1
- X(3)=XIN2
- X(4)=XIN2
- X(5)=XIN1
- X(6)=XIN1
- X(7)=XIN3
- X(8)=XIN3
- X(9)=XIN4
- X(10)=XIN4
- X(11)=XIN3
- X(12)=XIN3
-*
- Y(1)=(Y1+Y2)/2
- Y(2)=Y2
- Y(3)=Y2
- Y(4)=Y1
- Y(5)=Y1
- Y(6)=Y(1)
- Y(7)=Y(1)
- Y(8)=Y3
- Y(9)=Y3
- Y(10)=Y4
- Y(11)=Y4
- Y(12)=Y(1)
- IF(GFLAG.OR.PFLAG)THEN
- ZFSAV=ZFLAG
- ZFLAG=.FALSE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- IF(IFAIS.NE.0)CALL IFA(12,X,Y)
- IF((IFAIS.EQ.0).OR.(IBORD.NE.0))THEN
- ILNSAV=ILN
- CALL ISLN(1)
- CALL IPL(6,X,Y)
- CALL IPL(6,X(7),Y(7))
- CALL ISLN(ILNSAV)
- ENDIF
- ZFLAG=ZFSAV
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- ENDIF
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_MAIL)
- IF(GLFLAG)CALL IZFBOX(X1,X2,Y1,Y2,X3,X4,Y3,Y4)
-#endif
-*
- END
diff --git a/src/graflib/higz/ig/iggfin.F b/src/graflib/higz/ig/iggfin.F
deleted file mode 100644
index 3d50b9f..0000000
--- a/src/graflib/higz/ig/iggfin.F
+++ /dev/null
@@ -1,39 +0,0 @@
-*
-* $Id: iggfin.F,v 1.1.1.1 1996/02/14 13:10:34 mclareni Exp $
-*
-* $Log: iggfin.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:34 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.15/00 06/07/92 18.33.16 by O.Couet
-*-- Author : O.Couet 24/10/90
- SUBROUTINE IGGFIN(IFINO)
-*.===========>
-*.
-*. Get a Free INdex in the color table for stacked legos.
-*.
-*..==========> (O.Couet)
-#include "higz/hihid.inc"
-#include "higz/hilut.inc"
- SAVE IFIN
- DATA IFIN /7/
-*.______________________________________
-*
- IFINO1=IFIN
- 10 IFINO1=IFINO1+1
- IF(IFINO1.GT.NBCLUT)THEN
- IFINO1=7
- GOTO 10
- ENDIF
- IF(IFINO1.EQ.ISTCOT)GOTO 10
- IF(IFINO1.EQ.ISTCOB)GOTO 10
- DO 20 I=1,NIDS+1
- IF(IFINO1.EQ.ISTCOL(I))GOTO 10
- IF(IFINO1.EQ.ISTCO2(I))GOTO 10
- 20 CONTINUE
- IFIN=IFINO1
- IFINO=IFINO1
-*
- END
diff --git a/src/graflib/higz/ig/iggif.F b/src/graflib/higz/ig/iggif.F
deleted file mode 100644
index bf99b7a..0000000
--- a/src/graflib/higz/ig/iggif.F
+++ /dev/null
@@ -1,67 +0,0 @@
-*
-* $Id: iggif.F,v 1.4 2000/08/29 14:01:43 couet Exp $
-*
-* $Log: iggif.F,v $
-* Revision 1.4 2000/08/29 14:01:43 couet
-* - An error message in printed when this routine is not used in the X11
-* version of HIGZ.
-*
-* Revision 1.3 1998/11/16 11:11:24 couet
-* - ixdogif can scale pictures
-*
-* Revision 1.2 1996/02/19 16:17:05 couet
-* The include file containing the inline functions IXWCDC and IYWCDC was
-* missing in the IGGIF routine.
-*
-* Revision 1.1.1.1 1996/02/14 13:10:41 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 2.07/20 10/01/96 13.29.50 by O.Couet
-*-- Author : O.Couet 07/12/95
- SUBROUTINE IGGIF(IWKID,X,Y,CHNAME,CHOPT)
-*.==============>
-*.
-*. Generate/load a GIF file with/in the current X11 window.
-*.
-*. _Input parameters:
-*.
-*. CHARACTER CHNAME : GIF file name.
-*.
-*.============> (O.Couet)
-#if defined(CERNLIB_GIF)
-#include "higz/hiatt.inc"
-#endif
- CHARACTER*(*) CHNAME,CHOPT
-*.______________________________________
-*
-#if defined(CERNLIB_GIF)
-#include "higz/hiwcdc.inc"
-#endif
-#if defined(CERNLIB_GIF)
- ILEN = LENOCC(CHNAME)
- CALL IXSAVWI
- IW = IWINID(IGIWIN(IWKID))
- CALL IXSELWI(IW)
- IWKNB = IGIWIN(IWKID)
-*
- IF (INDEX(CHOPT,'M').NE.0) THEN
- IX = INT(X)
- IY = INT(Y)
- CALL IXDOGIF(IX,IY,ILEN,CHNAME(1:ILEN))
- ENDIF
-*
- IF (INDEX(CHOPT,'L').NE.0) THEN
- IX = IXWCDC(X)
- IY = IYWCDC(Y)
- CALL IXLDGIF(IX,IY,ILEN,CHNAME(1:ILEN))
- ENDIF
-*
- CALL IXSETWI
-#endif
-#if !defined(CERNLIB_GIF)
- CALL IGERR('Only HIGZ/X11 can do GIF files','IGGIF')
-#endif
-*
- END
diff --git a/src/graflib/higz/ig/ighatc.F b/src/graflib/higz/ig/ighatc.F
deleted file mode 100644
index 838e82e..0000000
--- a/src/graflib/higz/ig/ighatc.F
+++ /dev/null
@@ -1,178 +0,0 @@
-*
-* $Id: ighatc.F,v 1.1.1.1 1996/02/14 13:10:34 mclareni Exp $
-*
-* $Log: ighatc.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:34 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.13/06 24/10/91 10.46.02 by O.Couet
-*-- Author :
- SUBROUTINE IGHATC(DY,ANGLE,N,XP,YP)
-*.===========>
-*.
-*. This routine draw hatches inclined with the
-*. angle ANGLE and spaced of DY in normalized device
-*. coordinates in the surface defined by N,XP,YP.
-*.
-*..==========> (O.Couet)
-#include "higz/hiatt.inc"
-#include "higz/hiflag.inc"
- PARAMETER (PI = 3.1415926,EPSIL=0.0001)
- DIMENSION XLI(100),XLH(2),YLH(2),XP(N),YP(N),XT(2),YT(2)
- DOUBLE PRECISION XT, YT, A, B, XI, XIP, XIN
- REAL LL
- LOGICAL ZSAV
-*.___________________________________________
-*
- RATIO1=(RVXMAX-RVXMIN)/(RWXMAX-RWXMIN)
- RATIO2=(RVYMAX-RVYMIN)/(RWYMAX-RWYMIN)
- RVX=RVXMIN
- RVY=RVYMIN
- RVX2=RVXMAX
- RVY2=RVYMAX
- RWX=RWXMIN
- RWY=RWYMIN
-*
- IPLCIS=IPLCI
- ILNS=ILN
- RLWSAV=RLWSC
- CALL ISPLCI(IFACI)
- CALL ISLN(1)
- CALL ISLWSC(1.)
- ZSAV=ZFLAG
- ZFLAG=.FALSE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
-*
- ANGR=PI*(180-ANGLE)/180.
- SINA=SIN(ANGR)
- COSA=COS(ANGR)
- IF(ABS(COSA).LE.EPSIL)COSA=0.
- IF(ABS(SINA).LE.EPSIL)SINA=0.
- SINB=-SINA
- COSB=COSA
-*
-* Search YMIN and YMAX
-*
- YMIN=1.
- YMAX=0.
- DO 10 I=1,N
- X=RATIO1*(XP(I)-RWXMIN)+RVXMIN
- Y=RATIO2*(YP(I)-RWYMIN)+RVYMIN
- YROT=SINA*X+COSA*Y
- IF(YROT.GT.YMAX)YMAX=YROT
- IF(YROT.LT.YMIN)YMIN=YROT
- 10 CONTINUE
- YMAX=FLOAT(INT(YMAX/DY))*DY
-*
- NTSAV=INTR
- CALL ISELNT(0)
-*
- DO 70 YCUR=YMAX,YMIN,-DY
- NBI=0
- DO 20 I=2,N+1
- I2=I
- I1=I-1
- IF(I.EQ.N+1)I2=1
- X1=RATIO1*(XP(I1)-RWX)+RVX
- Y1=RATIO2*(YP(I1)-RWY)+RVY
- X2=RATIO1*(XP(I2)-RWX)+RVX
- Y2=RATIO2*(YP(I2)-RWY)+RVY
- XT(1)=COSA*X1-SINA*Y1
- YT(1)=SINA*X1+COSA*Y1
- XT(2)=COSA*X2-SINA*Y2
- YT(2)=SINA*X2+COSA*Y2
-*
-* Line segment parallel to oy
-*
- IF(XT(1).EQ.XT(2))THEN
- IF(YT(1).LT.YT(2))THEN
- YI=YT(1)
- YIP=YT(2)
- ELSE
- YI=YT(2)
- YIP=YT(1)
- ENDIF
- IF((YI.LE.YCUR).AND.(YCUR.LT.YIP))THEN
- NBI=NBI+1
- XLI(NBI)=XT(1)
- ENDIF
- GOTO 20
- ENDIF
-*
-* Line segment parallel to ox
-*
- IF(YT(1).EQ.YT(2))THEN
- IF(YT(1).EQ.YCUR)THEN
- NBI=NBI+1
- XLI(NBI)=XT(1)
- NBI=NBI+1
- XLI(NBI)=XT(2)
- ENDIF
- GOTO 20
- ENDIF
-*
-* Other line segment
-*
- A=(YT(1)-YT(2))/(XT(1)-XT(2))
- B=(YT(2)*XT(1)-XT(2)*YT(1))/(XT(1)-XT(2))
- IF(XT(1).LT.XT(2))THEN
- XI=XT(1)
- XIP=XT(2)
- ELSE
- XI=XT(2)
- XIP=XT(1)
- ENDIF
- XIN=(YCUR-B)/A
- IF ((XI.LE.XIN).AND.(XIN.LT.XIP).AND.
- + (MIN(YT(1),YT(2)).LE.YCUR).AND.
- + (YCUR.LT.MAX(YT(1),YT(2))))THEN
- NBI=NBI+1
- XLI(NBI)=XIN
- ENDIF
- 20 CONTINUE
-*
-* Sorting of the x coordinates intersections
-*
- INV=0
- M=NBI-1
- 30 CONTINUE
- DO 40 I=1,M
- IF(XLI(I+1).LT.XLI(I))THEN
- INV=INV+1
- LL=XLI(I)
- XLI(I)=XLI(I+1)
- XLI(I+1)=LL
- ENDIF
- 40 CONTINUE
- M=M-1
- IF(INV.EQ.0)GOTO 50
- INV=0
- GOTO 30
-*
-* Draw the hatches
-*
- 50 IF(MOD(NBI,2).NE.0)GOTO 70
-*
- DO 60 I=1,NBI,2
- XLH(1)=COSB*XLI(I)-SINB*YCUR
- YLH(1)=SINB*XLI(I)+COSB*YCUR
- XLH(2)=COSB*XLI(I+1)-SINB*YCUR
- YLH(2)=SINB*XLI(I+1)+COSB*YCUR
-*
-* Clipping on the current viewport
-*
- IF(IGCLIP(XLH,YLH,RVX,RVX2,RVY,RVY2).NE.0)THEN
- CALL IPL(2,XLH,YLH)
- ENDIF
- 60 CONTINUE
- 70 CONTINUE
-*
- CALL ISELNT(NTSAV)
- CALL ISPLCI(IPLCIS)
- CALL ISLN(ILNS)
- CALL ISLWSC(RLWSAV)
- ZFLAG=ZSAV
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- END
diff --git a/src/graflib/higz/ig/ighcx.F b/src/graflib/higz/ig/ighcx.F
deleted file mode 100644
index 3d30036..0000000
--- a/src/graflib/higz/ig/ighcx.F
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: ighcx.F,v 1.1.1.1 1996/02/14 13:10:34 mclareni Exp $
-*
-* $Log: ighcx.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:34 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.21/04 07/06/94 09.55.36 by O.Couet
-*-- Author :
- REAL FUNCTION IGHCX(LSCAT,ICX)
-*.==========>
-*. Returns the value of bin number icx
-*..=========> ( R.Brun )
-#include "higz/hipaw.inc"
- PARAMETER(KNBIT=1,KCON1=9)
-*.___________________________________________
-*
- NB = IQ(LSCAT+KNBIT)
- IF(NB.LE.0)NB = 32
- NW = 32/NB
- IF(NW.NE.1)THEN
- L1 = ICX*NB
- NBITH = 32-MOD(32,NB)
- L2 = MOD(L1,NBITH)+1
- L1 = LSCAT+KCON1+L1/NBITH
- IGHCX = JBYT(IQ(L1),L2,NB)
- ELSE
- IGHCX = Q(LSCAT+KCON1+ICX)
- ENDIF
-*
- END
diff --git a/src/graflib/higz/ig/ighcxy.F b/src/graflib/higz/ig/ighcxy.F
deleted file mode 100644
index d446aa3..0000000
--- a/src/graflib/higz/ig/ighcxy.F
+++ /dev/null
@@ -1,93 +0,0 @@
-*
-* $Id: ighcxy.F,v 1.1.1.1 1996/02/14 13:10:34 mclareni Exp $
-*
-* $Log: ighcxy.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:34 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.22/09 09/03/95 15.49.40 by O.Couet
-*-- Author :
- REAL FUNCTION IGHCXY(LSCAT,ICX,ICY,IOPT)
-*.==========>
-*.
-*. Returns the value of cell defined by ICX and ICY if IOPT=1. Returns
-*. the error associated with the cell defined by ICX and ICY if IOPT=2.
-*.
-*..=========> (O.Couet)
-#include "higz/hipaw.inc"
-#include "higz/hipack.inc"
- PARAMETER(KNBIT=1,KCON2=3,KCON1=9)
-*.___________________________________________
-*
- NB = IQ(LSCAT+KNBIT)
- IF (NB.LE.0) NB = 32
- NW = 32/NB
-*
- IF (IDIM1.NE.0) THEN
-*
-* 1D histos
-*
- IF (NW.NE.1) THEN
- L1 = ICX*NB
- NBITH = 32-MOD(32,NB)
- L2 = MOD(L1,NBITH)+1
- L1 = LSCAT+KCON1+L1/NBITH
- IGHCXY = JBYT(IQ(L1),L2,NB)
- ELSE
- IGHCXY = Q(LSCAT+KCON1+ICX)
- ENDIF
-*
-* If IOPT=2, then get error
-*
- IF(IOPT.EQ.2) THEN
- LW = LQ(LSCAT)
- IF (LW.NE.0) THEN
-*
-* Error is packed in histogram
-*
- IGHCXY = SQRT(Q(LW+ICX))
- ELSE
-*
-* Error must be calculated as SQRT contents
-*
- IGHCXY = SQRT(ABS(IGHCXY))
- ENDIF
- ENDIF
- ELSE
-*
-* 2D histos
-*
-* First get contents
-*
- J = (NCY-ICY+1)*(NCX+2)
- L2 = ICX+J
- L1 = L2/NW+LSCAT+KCON2
- IF (NW.NE.1) THEN
- L2 = (NW-1-MOD(L2,NW))*NB +1
- IGHCXY = JBYT(IQ(L1),L2,NB)
- ELSE
- IGHCXY = Q(L1)
- ENDIF
-*
-* If IOPT=2, then get error
-*
- IF(IOPT.EQ.2) THEN
- LW = LQ(LSCAT)
- IF (LW.NE.0) THEN
-*
-* Error is packed in histogram
-*
- IOFF = (ICY-1)*NCX+ICX
- IGHCXY = SQRT(Q(LW+IOFF))
- ELSE
-*
-* Error must be calculated as SQRT contents
-*
- IGHCXY = SQRT(ABS(IGHCXY))
- ENDIF
- ENDIF
- ENDIF
-*
- END
diff --git a/src/graflib/higz/ig/ighis1.F b/src/graflib/higz/ig/ighis1.F
deleted file mode 100644
index 69f289f..0000000
--- a/src/graflib/higz/ig/ighis1.F
+++ /dev/null
@@ -1,48 +0,0 @@
-*
-* $Id: ighis1.F,v 1.1.1.1 1996/02/14 13:10:34 mclareni Exp $
-*
-* $Log: ighis1.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:34 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.07/01 13/07/89 14.34.05 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE IGHIS1(N,IOPTG,IOPTX,IOPTY)
-*.===========>
-*.
-*. Take the LOG10 of XWORK and YWORK according to the value of
-*. IOPT and put it in XWORKL and YWORKL.
-*.
-*. _Input parameters:
-*.
-*. INTEGER N : Number of channels in XWORK and in YWORK.
-*. INTEGER IOPT : IGHIST options.
-*.
-*..==========> (O.Couet)
-#include "higz/hiatt.inc"
-#include "higz/hihist.inc"
-*.______________________________________
-*
- DO 10 I=1,N
- XWORKL(I)=XWORK(I)
- YWORKL(I)=YWORK(I)
- IF(IOPTG.NE.0.AND.IOPTX.NE.0)THEN
- IF(XWORKL(I).GT.0.)THEN
- XWORKL(I)=LOG10(XWORKL(I))
- ELSE
- XWORKL(I)=RWXMIN
- ENDIF
- ENDIF
- IF(IOPTG.NE.0.AND.IOPTY.NE.0)THEN
- IF(YWORKL(I).GT.0.)THEN
- YWORKL(I)=LOG10(YWORKL(I))
- ELSE
- YWORKL(I)=RWYMIN
- ENDIF
- ENDIF
-
- 10 CONTINUE
-*
- END
diff --git a/src/graflib/higz/ig/ighist.F b/src/graflib/higz/ig/ighist.F
deleted file mode 100644
index 22f4c52..0000000
--- a/src/graflib/higz/ig/ighist.F
+++ /dev/null
@@ -1,946 +0,0 @@
-*
-* $Id: ighist.F,v 1.2 2001/10/08 16:12:45 couet Exp $
-*
-* $Log: ighist.F,v $
-* Revision 1.2 2001/10/08 16:12:45 couet
-* - When a HIST/PLOT command (in PAW) is performed with the option S with
-* markers or lines, if the 2nd bin of the histogram is outside the plot
-* frame, the 1st bin is clipped too even if it is inside. The following
-* PAW macro illustrate the problem:
-*
-* v/cr a(5) r 1 0 1 0.5 1
-* set mtyp 20
-* 1d 100 ' ' 5 0. 5.
-* put/cont 100 a
-* null 0. 5. .1 1.5
-* h/pl 100 s
-* h/pl 100 sp
-* h/pl 100 sl
-*
-* Some "clipping code" in IGHIST was causing this problem. This code was
-* not necessary since the clipping is correctly handled elsewhere in HIGZ
-* for all the basic primitives. So this code has been commented and it now
-* works. For the time being we leave the commented code in the routine in
-* case some unwanted side effects would appear. We do not have find any for
-* the time being.
-*
-* Revision 1.1.1.1 1996/02/14 13:10:35 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.21/04 09/06/94 14.25.04 by O.Couet
-*-- Author :
- SUBROUTINE IGHIST(N,X,Y,CHOPT)
-*.===========>
-*.
-*. Draws all sorts of 1 dimensional graphs :
-*. - statistical graphs (histogram, bars or columns charts,
-*. - smoothed curved obtained with spline functions.
-*.
-*. _Input parameters:
-*.
-*. INTEGER N : Number of channels in X or in Y.
-*. REAL X(N) or X(2) : X coordinates or (XMIN,XMAX) (WC space).
-*. REAL Y(N) or Y(2) : Y coordinates or (YMIN,YMAX) (WC space).
-*. CHARACTER*(*) CHOPT : Option.
-*.
-*. CHOPT='R' : Graph is drawn horizontaly, parallel to X axis.
-*. (default is vertically, parallel to Y axis)
-*. If option R is selected the user must give:
-*. 2 values for Y (Y(1)=YMIN and Y(2)=YMAX)
-*. N values for X, one for each channel.
-*. Otherwise the user must give:
-*. N values for Y, one for each channel.
-*. 2 values for X (X(1)=XMIN and X(2)=XMAX)
-*.
-*. CHOPT='L' : A simple polyline beetwen every points is drawn
-*.
-*. CHOPT='H' : An Histogram with equidistant bins is drawn
-*. as a polyline.
-*.
-*. CHOPT='F' : An histogram with equidistant bins is drawn
-*. as a fill area. Contour is not drawn unless
-*. CHOPT='H' is also selected..
-*.
-*. CHOPT='N' : Non equidistant bins (default is equidistant)
-*. If N is the number of channels array X and Y
-*. must be dimensionned as follow:
-*. If option R is not selected (default) then
-*. the user must give:
-*. (N+1) values for X (limits of channels).
-*. N values for Y, one for each channel.
-*. Otherwise the user must give:
-*. (N+1) values for Y (limits of channels).
-*. N values for X, one for each channel.
-*.
-*. CHOPT='F1': Idem as 'F' except that fill area is no more
-*. reparted arround axis X=0 or Y=0 .
-*.
-*. CHOPT='C' : A smooth Curve is drawn.
-*.
-*. CHOPT='*' : A Star is plotted at the center of each bin.
-*.
-*. CHOPT='P' : Idem with the current marker
-*.
-*. CHOPT='B' : A Bar chart with equidistant bins is drawn as fill
-*. areas (Contours are drawn).
-*.
-*. CHOPT='GX': LOGX
-*.
-*. CHOPT='GY': LOGY
-*.
-*. CHOPT='Z' : The vectors X and Y are taken into PAWC at the
-*. adresses IQUEST(81) and IQUEST(82)
-*.
-*. CHOPT='K' : Data are pacKed like in HBOOK. In this case, Y is
-*. at the adress IQUEST(82) in PAWC. Note that with
-*. this option exclude option N and option R. This
-*. option is usefull with very big histograms (>100000
-*. bins). Such histo cannot be stored in pictures.
-*.
-*..==========> (O.Couet N.Cremel-Somon)
-#include "higz/hipaw.inc"
-#include "higz/hiflag.inc"
-#include "higz/hiatt.inc"
-#if defined(CERNLIB_MAIL)
-#include "higz/himail.inc"
-#endif
-#include "higz/hihist.inc"
-#if !defined(CERNLIB_MGKS)
- PARAMETER (NPMAX=204,NPMXFA=99)
-#endif
-#if defined(CERNLIB_MGKS)
- PARAMETER (NPMAX=204,NPMXFA=204)
-#endif
- DIMENSION X(*),Y(*)
- CHARACTER*(*) CHOPT
- CHARACTER*8 CHOPA
- REAL IGHCX
- EQUIVALENCE (LXADR,L2NTLA),(LYADR,LDNTLA)
- LOGICAL ZFSAV,FRSTFA
- DIMENSION IOPT(14)
- EQUIVALENCE (IOPTH ,IOPT(1)) , (IOPTF ,IOPT(2))
- EQUIVALENCE (IOPTC ,IOPT(3)) , (IOPTST,IOPT(4))
- EQUIVALENCE (IOPTR ,IOPT(5)) , (IOPT1,IOPT(6))
- EQUIVALENCE (IOPTB ,IOPT(7)) , (IOPTN,IOPT(8))
- EQUIVALENCE (IOPTL ,IOPT(9)) , (IOPTP,IOPT(10))
- EQUIVALENCE (IOPTA ,IOPT(11)), (IOPTG ,IOPT(12))
- EQUIVALENCE (IOPTX ,IOPT(13)), (IOPTY ,IOPT(14))
-*.______________________________________
-*
- IQUEST(1)=0
- IF(N.LE.0)THEN
- CALL IGERR(' Number of points is invalid','IGHIST')
- RETURN
- ENDIF
-*
- CALL UOPTC(CHOPT,'HFC*R1BNLPAGXY',IOPT)
-*
-* If necessary the adresses of the vectors are saved in
-* a link area.
-*
- IFIRST = 1
- ILAST = N
- IOPTZ = 0
- IOPTK = 0
- IF(INDEX(CHOPT,'Z').NE.0)THEN
- LXADR = IQUEST(81)
- LYADR = IQUEST(82)
- IOPTZ = 1
- ENDIF
- IF(INDEX(CHOPT,'K').NE.0)THEN
- LYADR = IQUEST(82)
- IFIRST = IQUEST(83)
- ILAST = IQUEST(84)
- IOPTK = 1
- ENDIF
- NBINS = ILAST-IFIRST+1
-*
-#if defined(CERNLIB_MAIL)
- CHOPTM = CHOPT
-#endif
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_MAIL)
- IF(GLFLAG.AND.IOPTK.EQ.0)CALL IZHIST(N,X,Y,IOPT,IOPTZ)
-#endif
- IF((.NOT.GFLAG).AND.(.NOT.PFLAG))RETURN
- ZFSAV = ZFLAG
- ZFLAG = .FALSE.
- GLFLAG = (ZFLAG.OR.PFLAG.OR.MFLAG)
-*
-* Draw the Axis with a fixed number of division: 510
-*
- IF(IOPTA.NE.0)THEN
- ILNOLD = ILN
- IFAOLD = IFAIS
- CALL ISLN(1)
- CALL ISFAIS(0)
- CALL IGBOX(RWXMIN,RWXMAX,RWYMIN,RWYMAX)
- CALL ISLN(ILNOLD)
- CALL ISFAIS(IFAOLD)
- AXFLAG = .FALSE.
- CHOPA = ' '
- RWMIN = RWXMIN
- RWMAX = RWXMAX
- IF(IOPTG.NE.0.AND.IOPTX.NE.0)THEN
- RWMIN = 10**RWXMIN
- RWMAX = 10**RWXMAX
- CHOPA = 'G'
- ENDIF
- CALL IGAXIS(RWXMIN,RWXMAX,RWYMIN,RWYMIN,RWMIN,RWMAX,510,CHOPA)
- AXFLAG = .TRUE.
- CHOPA = ' '
- RWMIN = RWYMIN
- RWMAX = RWYMAX
- IF(IOPTG.NE.0.AND.IOPTY.NE.0)THEN
- RWMIN = 10**RWYMIN
- RWMAX = 10**RWYMAX
- CHOPA = 'G'
- ENDIF
- CALL IGAXIS(RWXMIN,RWXMIN,RWYMIN,RWYMAX,RWMIN,RWMAX,510,CHOPA)
- AXFLAG = .FALSE.
- ENDIF
-*
-* Min-Max scope
-*
- IF(IOPTR.EQ.0)THEN
- IF(IOPTZ.NE.0)THEN
- WMIN = Q(LXADR)
- WMAX = Q(LXADR+1)
- ELSE
- WMIN = X(1)
- WMAX = X(2)
- ENDIF
- ELSE
- IF(IOPTZ.NE.0)THEN
- WMIN = Q(LYADR)
- WMAX = Q(LYADR+1)
- ELSE
- WMIN = Y(1)
- WMAX = Y(2)
- ENDIF
- ENDIF
- IF(IOPTN.EQ.0)DELTA = (WMAX-WMIN)/NBINS
-*
-* Draw the Histogram with a Fill Area
-*
- IF((IOPTF.NE.0).AND.(IOPTC.EQ.0))THEN
- FRSTFA = .TRUE.
- IF(IOPTR.EQ.0)THEN
- XWORK(1) = WMIN
- IF(IOPT1.EQ.0)THEN
- YWORK(1) = MAX(0.,RWYMIN)
- ELSE
- YWORK(1) = RWYMIN
- ENDIF
- NPT = 2
- DO 10 J=IFIRST,ILAST
- IF(IOPTN.EQ.0)THEN
- XWORK(NPT) = XWORK(NPT-1)
- XWORK(NPT+1) = WMIN+((J-IFIRST+1)*DELTA)
- ELSE
- IF(IOPTZ.NE.0)THEN
- XJ1 = Q(LXADR+J)
- XJ = Q(LXADR+J-1)
- ELSE
- XJ1 = X(J+1)
- XJ = X(J)
- ENDIF
- IF(XJ1.LT.XJ)THEN
- IF(J.NE.ILAST)THEN
- CALL IGERR('X must be in increasing order'
- + ,'IGHIST')
- ELSE
- CALL IGERR('X must have N+1 values with '
- + //'option N' ,'IGHIST')
- ENDIF
- GOTO 110
- ENDIF
- IF(IOPTZ.NE.0)THEN
- XWORK(NPT) = Q(LXADR+J-1)
- XWORK(NPT+1) = Q(LXADR+J)
- ELSE
- XWORK(NPT) = X(J)
- XWORK(NPT+1) = X(J+1)
- ENDIF
- ENDIF
- IF(IOPTZ.NE.0)THEN
- YWORK(NPT) = Q(LYADR+J-1)
- YWORK(NPT+1) = Q(LYADR+J-1)
- ELSEIF(IOPTK.NE.0)THEN
- YWORK(NPT) = IGHCX(LYADR,J)
- YWORK(NPT+1) = IGHCX(LYADR,J)
- ELSE
- YWORK(NPT) = Y(J)
- YWORK(NPT+1) = Y(J)
- ENDIF
- NPT = NPT+2
- IF(J.EQ.ILAST)THEN
- XWORK(NPT) = XWORK(NPT-1)
- YWORK(NPT) = YWORK(1)
- CALL IGHIS1(NPT,IOPTG,IOPTX,IOPTY)
- CALL IFA(NPT,XWORKL,YWORKL)
- IF(IBORD.NE.0)THEN
- IF(.NOT.FRSTFA)YWORKL(1) = YLAST
- CALL IPL(NPT-1,XWORKL,YWORKL)
- ENDIF
- GOTO 10
- ENDIF
- IF(NPT.GE.NPMXFA)THEN
- XWORK(NPT) = XWORK(NPT-1)
- YWORK(NPT) = YWORK(1)
- CALL IGHIS1(NPT,IOPTG,IOPTX,IOPTY)
- CALL IFA(NPT,XWORKL,YWORKL)
- IF(IBORD.NE.0)THEN
- IF(.NOT.FRSTFA)YWORKL(1) = YLAST
- CALL IPL(NPT-1,XWORKL,YWORKL)
- FRSTFA = .FALSE.
- ENDIF
- YLAST = YWORKL(NPT-1)
- XWORK(1) = XWORK(NPT)
- NPT = 2
- ENDIF
- 10 CONTINUE
- ELSE
- YWORK(1) = WMIN
- IF(IOPT1.EQ.0)THEN
- XWORK(1) = MAX(0.,RWXMIN)
- ELSE
- XWORK(1) = RWXMIN
- ENDIF
- NPT = 2
- DO 20 J=IFIRST,ILAST
- IF(IOPTN.EQ.0)THEN
- YWORK(NPT) = YWORK(NPT-1)
- YWORK(NPT+1) = WMIN+((J-IFIRST+1)*DELTA)
- ELSE
- IF(IOPTZ.NE.0)THEN
- YJ1 = Q(LYADR+J)
- YJ = Q(LYADR+J-1)
- ELSE
- YJ1 = Y(J+1)
- YJ = Y(J)
- ENDIF
- IF(YJ1.LT.YJ)THEN
- IF(J.NE.ILAST)THEN
- CALL IGERR('Y must be in increasing order'
- + ,'IGHIST')
- ELSE
- CALL IGERR('Y must have N+1 values with '
- + //'option N' ,'IGHIST')
- ENDIF
- GOTO 110
- ENDIF
- IF(IOPTZ.NE.0)THEN
- YWORK(NPT) = Q(LYADR+J-1)
- YWORK(NPT+1) = Q(LYADR+J)
- ELSE
- YWORK(NPT) = Y(J)
- YWORK(NPT+1) = Y(J+1)
- ENDIF
- ENDIF
- IF(IOPTZ.NE.0)THEN
- XWORK(NPT) = Q(LXADR+J-1)
- XWORK(NPT+1) = Q(LXADR+J-1)
- ELSE
- XWORK(NPT) = X(J)
- XWORK(NPT+1) = X(J)
- ENDIF
- NPT = NPT+2
- IF(J.EQ.ILAST)THEN
- YWORK(NPT) = YWORK(NPT-1)
- XWORK(NPT) = XWORK(1)
- CALL IGHIS1(NPT,IOPTG,IOPTX,IOPTY)
- CALL IFA(NPT,XWORKL,YWORKL)
- IF(IBORD.NE.0)THEN
- IF(.NOT.FRSTFA)YWORKL(1) = YLAST
- CALL IPL(NPT-1,XWORKL,YWORKL)
- ENDIF
- GOTO 20
- ENDIF
- IF(NPT.GE.NPMXFA)THEN
- YWORK(NPT) = YWORK(NPT-1)
- XWORK(NPT) = XWORK(1)
- CALL IGHIS1(NPT,IOPTG,IOPTX,IOPTY)
- CALL IFA(NPT,XWORKL,YWORKL)
- IF(IBORD.NE.0)THEN
- IF(.NOT.FRSTFA)YWORKL(1) = YLAST
- CALL IPL(NPT-1,XWORKL,YWORKL)
- FRSTFA = .FALSE.
- ENDIF
- YLAST = YWORKL(NPT-1)
- YWORK(1) = YWORK(NPT)
- NPT = 2
- ENDIF
- 20 CONTINUE
- ENDIF
- ENDIF
-*
-* Draw a standard Histogram (default)
-*
- IF((IOPTH.NE.0).OR.(CHOPT.EQ.' '))THEN
- IF(IOPTR.EQ.0)THEN
- XWORK(1) = WMIN
- YWORK(1) = MAX(0.,RWYMIN)
- YWMIN = YWORK(1)
- NPT = 2
- DO 30 I=IFIRST,ILAST
- IF(IOPTN.EQ.0)THEN
- XWORK(NPT) = XWORK(NPT-1)
- XWORK(NPT+1) = WMIN+((I-IFIRST+1)*DELTA)
- ELSE
- IF(IOPTZ.NE.0)THEN
- XI1 = Q(LXADR+I)
- XI = Q(LXADR+I-1)
- ELSE
- XI1 = X(I+1)
- XI = X(I)
- ENDIF
- IF(XI1.LT.XI)THEN
- IF(I.NE.ILAST)THEN
- CALL IGERR('X must be in increasing order'
- + ,'IGHIST')
- ELSE
- CALL IGERR('X must have N+1 values with '
- + //'option N' ,'IGHIST')
- ENDIF
- GOTO 110
- ENDIF
- IF(IOPTZ.NE.0)THEN
- XWORK(NPT) = Q(LXADR+I-1)
- XWORK(NPT+1) = Q(LXADR+I)
- ELSE
- XWORK(NPT) = X(I)
- XWORK(NPT+1) = X(I+1)
- ENDIF
- ENDIF
- IF(IOPTZ.NE.0)THEN
- YWORK(NPT) = Q(LYADR+I-1)
- YWORK(NPT+1) = Q(LYADR+I-1)
- ELSEIF(IOPTK.NE.0)THEN
- YWORK(NPT) = IGHCX(LYADR,I)
- YWORK(NPT+1) = IGHCX(LYADR,I)
- ELSE
- YWORK(NPT) = Y(I)
- YWORK(NPT+1) = Y(I)
- ENDIF
- NPT = NPT+2
- IF(I.EQ.ILAST)THEN
- XWORK(NPT) = XWORK(NPT-1)
- YWORK(NPT) = YWMIN
- CALL IGHIS1(NPT,IOPTG,IOPTX,IOPTY)
- CALL IPL(NPT,XWORKL,YWORKL)
- GOTO 30
- ENDIF
- IF(NPT.GE.NPMAX)THEN
- CALL IGHIS1(NPT-1,IOPTG,IOPTX,IOPTY)
- CALL IPL(NPT-1,XWORKL,YWORKL)
- XWORK(1) = XWORK(NPT-1)
- YWORK(1) = YWORK(NPT-1)
- NPT = 2
- ENDIF
- 30 CONTINUE
- ELSE
- YWORK(1) = WMIN
- XWORK(1) = MAX(0.,RWXMIN)
- XWMIN = XWORK(1)
- NPT = 2
- DO 40 I=IFIRST,ILAST
- IF(IOPTN.EQ.0)THEN
- YWORK(NPT) = YWORK(NPT-1)
- YWORK(NPT+1) = WMIN+((I-IFIRST+1)*DELTA)
- ELSE
- IF(IOPTZ.NE.0)THEN
- YI1 = Q(LYADR+I)
- YI = Q(LYADR+I-1)
- ELSE
- YI1 = Y(I+1)
- YI = Y(I)
- ENDIF
- IF(YI1.LT.YI)THEN
- IF(I.NE.ILAST)THEN
- CALL IGERR('Y must be in increasing order'
- + ,'IGHIST')
- ELSE
- CALL IGERR('Y must have N+1 values with '
- + //'option N' ,'IGHIST')
- ENDIF
- GOTO 110
- ENDIF
- IF(IOPTZ.NE.0)THEN
- YWORK(NPT) = Q(LYADR+I-1)
- YWORK(NPT+1) = Q(LYADR+I)
- ELSE
- YWORK(NPT) = Y(I)
- YWORK(NPT+1) = Y(I+1)
- ENDIF
- ENDIF
- IF(IOPTZ.NE.0)THEN
- XWORK(NPT) = Q(LXADR+I-1)
- XWORK(NPT+1) = Q(LXADR+I-1)
- ELSE
- XWORK(NPT) = X(I)
- XWORK(NPT+1) = X(I)
- ENDIF
- NPT = NPT+2
- IF(I.EQ.ILAST)THEN
- YWORK(NPT) = YWORK(NPT-1)
- XWORK(NPT) = XWMIN
- CALL IGHIS1(NPT,IOPTG,IOPTX,IOPTY)
- CALL IPL(NPT,XWORKL,YWORKL)
- GOTO 40
- ENDIF
- IF(NPT.GE.NPMAX)THEN
- CALL IGHIS1(NPT-1,IOPTG,IOPTX,IOPTY)
- CALL IPL(NPT-1,XWORKL,YWORKL)
- XWORK(1) = XWORK(NPT-1)
- YWORK(1) = YWORK(NPT-1)
- NPT = 2
- ENDIF
- 40 CONTINUE
- ENDIF
- ENDIF
-*
-* Draw the histogram with a smooth Curve. The computing
-* of the smoothing is done by the routine IGRAP1
-*
- IF(IOPTC.NE.0)THEN
- IF(IOPTF.EQ.0)THEN
- ITYPS = 1
- ELSE
- IF(IOPT1.EQ.0)THEN
- ITYPS = 2
- ELSE
- ITYPS = 3
- ENDIF
- ENDIF
- IF(IOPTR.EQ.0)THEN
- NPT = 0
- DO 50 I=IFIRST,ILAST
- NPT = NPT+1
- IF(IOPTN.EQ.0)THEN
- XWORK(NPT) = WMIN+(I-IFIRST)*DELTA+0.5*DELTA
- ELSE
- IF(IOPTZ.NE.0)THEN
- XI1 = Q(LXADR+I)
- XI = Q(LXADR+I-1)
- ELSE
- XI1 = X(I+1)
- XI = X(I)
- ENDIF
- IF(XI1.LT.XI)THEN
- IF(I.NE.ILAST)THEN
- CALL IGERR('X must be in increasing order'
- + ,'IGHIST')
- ELSE
- CALL IGERR('X must have N+1 values with '
- + //'option N' ,'IGHIST')
- ENDIF
- GOTO 110
- ENDIF
- IF(IOPTZ.NE.0)THEN
- XWORK(NPT) = Q(LXADR+I-1)+
- + (Q(LXADR+I)-Q(LXADR+I-1))/2.
- ELSE
- XWORK(NPT) = X(I)+(X(I+1)-X(I))/2.
- ENDIF
- ENDIF
- IF(IOPTZ.NE.0)THEN
- YWORK(NPT) = Q(LYADR+I-1)
- ELSEIF(IOPTK.NE.0)THEN
- YWORK(NPT) = IGHCX(LYADR,I)
- ELSE
- YWORK(NPT) = Y(I)
- ENDIF
- CALL IGHIS1(NPT,IOPTG,IOPTX,IOPTY)
- IF((YWORKL(NPT).LT.RWYMIN).OR.(YWORKL(NPT).GT.RWYMAX))
- + THEN
- IF(NPT.GT.2)THEN
- CALL IGHIS1(NPT,IOPTG,IOPTX,IOPTY)
- CALL IGRAP1(XWORKL,YWORKL,NPT,ITYPS)
- ENDIF
- XWORK(1) = XWORK(NPT)
- YWORK(1) = YWORK(NPT)
- NPT = 1
- GOTO 50
- ENDIF
- IF(NPT.GE.50)THEN
- CALL IGHIS1(50,IOPTG,IOPTX,IOPTY)
- CALL IGRAP1(XWORKL,YWORKL,50,ITYPS)
- XWORK(1) = XWORK(NPT)
- YWORK(1) = YWORK(NPT)
- NPT = 1
- ENDIF
- 50 CONTINUE
- IF(NPT.GT.1)THEN
- CALL IGHIS1(NPT,IOPTG,IOPTX,IOPTY)
- CALL IGRAP1(XWORKL,YWORKL,NPT,ITYPS)
- ENDIF
- ELSE
- ITYPS = ITYPS+10
- NPT = 0
- DO 60 I=IFIRST,ILAST
- NPT = NPT+1
- IF(IOPTN.EQ.0)THEN
- YWORK(NPT) = WMIN+(I-IFIRST)*DELTA+0.5*DELTA
- ELSE
- IF(IOPTZ.NE.0)THEN
- YI1 = Q(LYADR+I)
- YI = Q(LYADR+I-1)
- ELSE
- YI1 = Y(I+1)
- YI = Y(I)
- ENDIF
- IF(YI1.LT.YI)THEN
- IF(I.NE.ILAST)THEN
- CALL IGERR('Y must be in increasing order'
- + ,'IGHIST')
- ELSE
- CALL IGERR('Y must have N+1 values with '
- + //'option N' ,'IGHIST')
- ENDIF
- GOTO 110
- ENDIF
- IF(IOPTZ.NE.0)THEN
- YWORK(NPT) = Q(LYADR+I-1)+
- + (Q(LYADR+I)-Q(LYADR+I-1))/2.
- ELSE
- YWORK(NPT) = Y(I)+(Y(I+1)-Y(I))/2.
- ENDIF
- ENDIF
- IF(IOPTZ.NE.0)THEN
- XWORK(NPT) = Q(LXADR+I-1)
- ELSE
- XWORK(NPT) = X(I)
- ENDIF
- CALL IGHIS1(NPT,IOPTG,IOPTX,IOPTY)
- IF((XWORKL(NPT).LT.RWXMIN).OR.(XWORKL(NPT).GT.RWXMAX))
- + THEN
- IF(NPT.GT.2)THEN
- CALL IGHIS1(NPT,IOPTG,IOPTX,IOPTY)
- CALL IGRAP1(XWORKL,YWORKL,NPT,ITYPS)
- ENDIF
- XWORK(1) = XWORK(NPT)
- YWORK(1) = YWORK(NPT)
- NPT = 1
- GOTO 60
- ENDIF
- IF(NPT.GE.50)THEN
- CALL IGHIS1(50,IOPTG,IOPTX,IOPTY)
- CALL IGRAP1(XWORKL,YWORKL,50,ITYPS)
- XWORK(1) = XWORK(NPT)
- YWORK(1) = YWORK(NPT)
- NPT = 1
- ENDIF
- 60 CONTINUE
- IF(NPT.GT.1)THEN
- CALL IGHIS1(NPT,IOPTG,IOPTX,IOPTY)
- CALL IGRAP1(XWORKL,YWORKL,NPT,ITYPS)
- ENDIF
- ENDIF
- ENDIF
-*
-* Draw the histogram with a simple line
-*
- IOPTPK = 0
- IF((IOPTST.NE.0).OR.(IOPTP.NE.0))IOPTPK=1
- IF((IOPTPK.NE.0).OR.(IOPTL.NE.0))THEN
- IMKOLD = IMK
- IF(IOPTST.NE.0)CALL ISMK(3)
- WMINST = WMIN+DELTA/2.
- IF(IOPTR.EQ.0)THEN
- NPT = 0
- DO 70 I=IFIRST,ILAST
- NPT = NPT+1
- IF(IOPTN.EQ.0)THEN
- XWORK(NPT) = WMINST+(I-IFIRST)*DELTA
- ELSE
- IF(IOPTZ.NE.0)THEN
- XI1 = Q(LXADR+I)
- XI = Q(LXADR+I-1)
- ELSE
- XI1 = X(I+1)
- XI = X(I)
- ENDIF
- IF(XI1.LT.XI)THEN
- IF(I.NE.ILAST)THEN
- CALL IGERR('X must be in increasing order'
- + ,'IGHIST')
- ELSE
- CALL IGERR('X must have N+1 values with '
- + //'option N' ,'IGHIST')
- ENDIF
- GOTO 110
- ENDIF
- IF(IOPTZ.NE.0)THEN
- XWORK(NPT) = Q(LXADR+I-1)+
- + (Q(LXADR+I)-Q(LXADR+I-1))/2.
- ELSE
- XWORK(NPT) = X(I)+(X(I+1)-X(I))/2.
- ENDIF
- ENDIF
- IF(IOPTZ.NE.0)THEN
- YWORK(NPT) = Q(LYADR+I-1)
- ELSEIF(IOPTK.NE.0)THEN
- YWORK(NPT) = IGHCX(LYADR,I)
- ELSE
- YWORK(NPT) = Y(I)
- ENDIF
-CCC IF((YWORK(NPT).LT.RWYMIN).OR.(YWORK(NPT).GT.RWYMAX))
-CCC + THEN
-CCC IF(NPT.GT.2)THEN
-CCC IF(IOPTPK.NE.0)THEN
-CCC CALL IGHIS1(NPT,IOPTG,IOPTX,IOPTY)
-CCC CALL IPM(NPT,XWORKL,YWORKL)
-CCC ENDIF
-CCC IF(IOPTL.NE.0)THEN
-CCC CALL IGHIS1(NPT,IOPTG,IOPTX,IOPTY)
-CCC CALL IPL(NPT,XWORKL,YWORKL)
-CCC ENDIF
-CCC ENDIF
-CCC XWORK(1) = XWORK(NPT)
-CCC YWORK(1) = YWORK(NPT)
-CCC NPT = 1
-CCC GOTO 70
-CCC ENDIF
- IF(NPT.GE.50)THEN
- IF(IOPTPK.NE.0)THEN
- CALL IGHIS1(50,IOPTG,IOPTX,IOPTY)
- CALL IPM(50,XWORKL,YWORKL)
- ENDIF
- IF(IOPTL.NE.0)THEN
- CALL IGHIS1(50,IOPTG,IOPTX,IOPTY)
- CALL IPL(50,XWORKL,YWORKL)
- ENDIF
- XWORK(1) = XWORK(NPT)
- YWORK(1) = YWORK(NPT)
- NPT = 1
- ENDIF
- 70 CONTINUE
- IF(IOPTPK.NE.0.AND.NPT.GT.0)THEN
- CALL IGHIS1(NPT,IOPTG,IOPTX,IOPTY)
- CALL IPM(NPT,XWORKL,YWORKL)
- ENDIF
- IF(IOPTL.NE.0.AND.NPT.GT.1)THEN
- CALL IGHIS1(NPT,IOPTG,IOPTX,IOPTY)
- CALL IPL(NPT,XWORKL,YWORKL)
- ENDIF
- ELSE
- NPT = 0
- DO 80 I=IFIRST,ILAST
- NPT = NPT+1
- IF(IOPTN.EQ.0)THEN
- YWORK(NPT) = WMINST+(I-IFIRST)*DELTA
- ELSE
- IF(IOPTZ.NE.0)THEN
- YI1 = Q(LYADR+I)
- YI = Q(LYADR+I-1)
- ELSE
- YI1 = Y(I+1)
- YI = Y(I)
- ENDIF
- IF(YI1.LT.YI)THEN
- IF(I.NE.ILAST)THEN
- CALL IGERR('Y must be in increasing order'
- + ,'IGHIST')
- ELSE
- CALL IGERR('Y must have N+1 values with '
- + //'option N' ,'IGHIST')
- ENDIF
- GOTO 110
- ENDIF
- IF(IOPTZ.NE.0)THEN
- YWORK(NPT) = Q(LYADR+I-1)+
- + (Q(LYADR+I)-Q(LYADR+I-1))/2.
- ELSE
- YWORK(NPT) = Y(I)+(Y(I+1)-Y(I))/2.
- ENDIF
- ENDIF
- IF(IOPTZ.NE.0)THEN
- XWORK(NPT) = Q(LXADR+I-1)
- ELSE
- XWORK(NPT) = X(I)
- ENDIF
-CCC IF((XWORK(NPT).LT.RWXMIN).OR.(XWORK(NPT).GT.RWXMAX))
-CCC + THEN
-CCC IF(NPT.GT.2)THEN
-CCC IF(IOPTPK.NE.0)THEN
-CCC CALL IGHIS1(NPT,IOPTG,IOPTX,IOPTY)
-CCC CALL IPM(NPT,XWORKL,YWORKL)
-CCC ENDIF
-CCC IF(IOPTL.NE.0)THEN
-CCC CALL IGHIS1(NPT,IOPTG,IOPTX,IOPTY)
-CCC CALL IPL(NPT,XWORKL,YWORKL)
-CCC ENDIF
-CCC ENDIF
-CCC XWORK(1) = XWORK(NPT)
-CCC YWORK(1) = YWORK(NPT)
-CCC NPT = 1
-CCC GOTO 80
-CCC ENDIF
- IF(NPT.GE.50)THEN
- IF(IOPTPK.NE.0)THEN
- CALL IGHIS1(50,IOPTG,IOPTX,IOPTY)
- CALL IPM(50,XWORKL,YWORKL)
- ENDIF
- IF(IOPTL.NE.0)THEN
- CALL IGHIS1(50,IOPTG,IOPTX,IOPTY)
- CALL IPL(50,XWORKL,YWORKL)
- ENDIF
- XWORK(1) = XWORK(NPT)
- YWORK(1) = YWORK(NPT)
- NPT = 1
- ENDIF
- 80 CONTINUE
- IF(IOPTPK.NE.0.AND.NPT.GT.0)THEN
- CALL IGHIS1(NPT,IOPTG,IOPTX,IOPTY)
- CALL IPM(NPT,XWORKL,YWORKL)
- ENDIF
- IF(IOPTL.NE.0.AND.NPT.GT.1)THEN
- CALL IGHIS1(NPT,IOPTG,IOPTX,IOPTY)
- CALL IPL(NPT,XWORKL,YWORKL)
- ENDIF
- ENDIF
- CALL ISMK(IMKOLD)
- ENDIF
-*
-* Draw the histogram as a bar chart
-*
- IF(IOPTB.NE.0)THEN
- IF(IOPTN.EQ.0)THEN
- OFFS = DELTA*RBOF
- DBAR = DELTA*RBWD
- ELSE
- IF(IOPTR.EQ.0)THEN
- IF(IOPTZ.NE.0)THEN
- OFFS = (Q(LXADR+1)-Q(LXADR))*RBOF
- DBAR = (Q(LXADR+1)-Q(LXADR))*RBWD
- ELSE
- OFFS = (X(2)-X(1))*RBOF
- DBAR = (X(2)-X(1))*RBWD
- ENDIF
- ELSE
- IF(IOPTZ.NE.0)THEN
- OFFS = (Q(LYADR+1)-Q(LYADR))*RBOF
- DBAR = (Q(LYADR+1)-Q(LYADR))*RBWD
- ELSE
- OFFS = (Y(2)-Y(1))*RBOF
- DBAR = (Y(2)-Y(1))*RBWD
- ENDIF
- ENDIF
- ENDIF
- IBOLD = IBORD
- CALL IGSET('BORD',1.)
- IF(IOPTR.EQ.0)THEN
- XLOW = WMIN+OFFS
- XHIGH = WMIN+OFFS+DBAR
- IF(IOPT1.EQ.0)THEN
- YLOW = MAX(0.,RWYMIN)
- ELSE
- YLOW = RWYMIN
- ENDIF
- DO 90 I=IFIRST,ILAST
- IF(IOPTZ.NE.0)THEN
- YHIGH = Q(LYADR+I-1)
- ELSEIF(IOPTK.NE.0)THEN
- YHIGH = IGHCX(LYADR,I)
- ELSE
- YHIGH = Y(I)
- ENDIF
- XWORK(1) = XLOW
- YWORK(1) = YLOW
- XWORK(2) = XHIGH
- YWORK(2) = YHIGH
- CALL IGHIS1(2,IOPTG,IOPTX,IOPTY)
- CALL IGBOX(XWORKL(1),XWORKL(2),YWORKL(1),YWORKL(2))
- IF(IOPTN.EQ.0)THEN
- XLOW = XLOW+DELTA
- XHIGH = XHIGH+DELTA
- ELSE
- IF(I.LT.ILAST)THEN
- IF(IOPTZ.NE.0)THEN
- XI1 = Q(LXADR+I)
- XI = Q(LXADR+I-1)
- ELSE
- XI1 = X(I+1)
- XI = X(I)
- ENDIF
- IF(XI1.LT.XI)THEN
- CALL IGERR('X must be in increasing order'
- + ,'IGHIST')
- GOTO 110
- ENDIF
- IF(IOPTZ.NE.0)THEN
- OFFS = (Q(LXADR+I+1)-Q(LXADR+I))*RBOF
- DBAR = (Q(LXADR+I+1)-Q(LXADR+I))*RBWD
- XLOW = Q(LXADR+I)+OFFS
- XHIGH = Q(LXADR+I)+OFFS+DBAR
- ELSE
- OFFS = (X(I+2)-X(I+1))*RBOF
- DBAR = (X(I+2)-X(I+1))*RBWD
- XLOW = X(I+1)+OFFS
- XHIGH = X(I+1)+OFFS+DBAR
- ENDIF
- ENDIF
- ENDIF
- 90 CONTINUE
- ELSE
- YLOW = WMIN+OFFS
- YHIGH = WMIN+OFFS+DBAR
- IF(IOPT1.EQ.0)THEN
- XLOW = MAX(0.,RWXMIN)
- ELSE
- XLOW = RWXMIN
- ENDIF
- DO 100 I=IFIRST,ILAST
- IF(IOPTZ.NE.0)THEN
- XHIGH = Q(LXADR+I-1)
- ELSE
- XHIGH = X(I)
- ENDIF
- XWORK(1) = XLOW
- YWORK(1) = YLOW
- XWORK(2) = XHIGH
- YWORK(2) = YHIGH
- CALL IGHIS1(2,IOPTG,IOPTX,IOPTY)
- CALL IGBOX(XWORKL(1),XWORKL(2),YWORKL(1),YWORKL(2))
- CALL IGBOX(XLOW,XHIGH,YLOW,YHIGH)
- IF(IOPTN.EQ.0)THEN
- YLOW = YLOW+DELTA
- YHIGH = YHIGH+DELTA
- ELSE
- IF(I.LT.ILAST)THEN
- IF(IOPTZ.NE.0)THEN
- YI1 = Q(LYADR+I)
- YI = Q(LYADR+I-1)
- ELSE
- YI1 = Y(I+1)
- YI = Y(I)
- ENDIF
- IF(YI1.LT.YI)THEN
- CALL IGERR('Y must be in increasing order'
- + ,'IGHIST')
- GOTO 110
- ENDIF
- IF(IOPTZ.NE.0)THEN
- OFFS = (Q(LYADR+I+1)-Q(LYADR+I))*RBOF
- DBAR = (Q(LYADR+I+1)-Q(LYADR+I))*RBWD
- YLOW = Q(LYADR+I)+OFFS
- YHIGH = Q(LYADR+I)+OFFS+DBAR
- ELSE
- OFFS = (Y(I+2)-Y(I+1))*RBOF
- DBAR = (Y(I+2)-Y(I+1))*RBWD
- YLOW = Y(I+1)+OFFS
- YHIGH = Y(I+1)+OFFS+DBAR
- ENDIF
- ENDIF
- ENDIF
- 100 CONTINUE
- ENDIF
- CALL IGSET('BORD',FLOAT(IBOLD))
- ENDIF
-*
- 110 ZFLAG = ZFSAV
- GLFLAG = (ZFLAG.OR.PFLAG.OR.MFLAG)
-*
- END
diff --git a/src/graflib/higz/ig/ighr01.F b/src/graflib/higz/ig/ighr01.F
deleted file mode 100644
index 42f1e04..0000000
--- a/src/graflib/higz/ig/ighr01.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: ighr01.F,v 1.1.1.1 1996/02/14 13:10:35 mclareni Exp $
-*
-* $Log: ighr01.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:35 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.12/07 22/03/91 09.15.59 by O.Couet
-*-- Author : O.Couet 08/06/90
- REAL FUNCTION IGHR01(RN1,RN2,HUEI)
- HUE=HUEI
- IF(HUE.GT.360.)HUE=HUE-360.
- IF(HUE.LT.0.)HUE=HUE+360.
- IF(HUE.LT.60.)THEN
- IGHR01=RN1+(RN2-RN1)*HUE/60.
- ELSEIF(HUE.LT.180.)THEN
- IGHR01=RN2
- ELSEIF(HUE.LT.240.)THEN
- IGHR01=RN1+(RN2-RN1)*(240.-HUE)/60.
- ELSE
- IGHR01=RN1
- ENDIF
- END
-
diff --git a/src/graflib/higz/ig/ightor.F b/src/graflib/higz/ig/ightor.F
deleted file mode 100644
index 89561a4..0000000
--- a/src/graflib/higz/ig/ightor.F
+++ /dev/null
@@ -1,43 +0,0 @@
-*
-* $Id: ightor.F,v 1.1.1.1 1996/02/14 13:10:35 mclareni Exp $
-*
-* $Log: ightor.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:35 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.11/00 23/10/90 14.08.31 by O.Couet
-*-- Author : O.Couet 08/06/90
- SUBROUTINE IGHTOR(RHI,RLI,RSI,R,G,B)
-*.===========>
-*.
-*. Convert HLS to RGB
-*.
-*..==========> (O.Couet)
- REAL IGHR01
-*.______________________________________
-*
- RH=MAX(MIN(RHI,360.),0.)
- RL=MAX(MIN(RLI,1.),0.)
- RS=MAX(MIN(RSI,1.),0.)
-*
- IF(RL.LE.0.5)THEN
- RM2=RL*(1.+RS)
- ELSE
- RM2=RL+RS-RL*RS
- ENDIF
-*
- RM1=2.*RL-RM2
-*
- IF(RS.EQ.0.)THEN
- R=RL
- G=RL
- B=RL
- ELSE
- R=IGHR01(RM1,RM2,RH+120.)
- G=IGHR01(RM1,RM2,RH)
- B=IGHR01(RM1,RM2,RH-120.)
- ENDIF
-*
- END
diff --git a/src/graflib/higz/ig/iginit.F b/src/graflib/higz/ig/iginit.F
deleted file mode 100644
index 2011b65..0000000
--- a/src/graflib/higz/ig/iginit.F
+++ /dev/null
@@ -1,358 +0,0 @@
-*
-* $Id: iginit.F,v 1.2 2005/10/28 12:38:08 couet Exp $
-*
-* $Log: iginit.F,v $
-* Revision 1.2 2005/10/28 12:38:08 couet
-* - SVG driver, workstation type -779
-*
-* Revision 1.1.1.1 1996/02/14 13:10:35 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.21/10 03/10/94 09.19.42 by O.Couet
-*-- Author :
- SUBROUTINE IGINIT(NWORDS)
-*.===========>
-*.
-*. This routine initializes HIGZ .
-*.
-*. _Input parameters:
-*.
-*. INTEGER NWORDS : Minimal space in the ZEBRA HIGZ division .
-*.
-*..==========> (O.Couet)
-#include "higz/hiflag.inc"
-#include "higz/hilun.inc"
-#include "higz/hiatt.inc"
-#include "higz/himet2.inc"
-#include "higz/himeta.inc"
-#include "higz/himenu.inc"
-#if (!defined(CERNLIB_NTC))&&(!defined(CERNLIB_X11))
-#include "higz/hint.inc"
-#endif
-#include "higz/hiloc.inc"
-#include "higz/hilut.inc"
-#include "higz/hihid.inc"
-#include "higz/hilabs.inc"
-#if defined(CERNLIB_X11)
-#include "higz/hikern.inc"
-#endif
-#if defined(CERNLIB_MAIL)
-#include "higz/himail.inc"
-#endif
-#if defined(CERNLIB_DI3000)
- INTEGER*4 MAXDEV
- PARAMETER (MAXDEV = 9)
- INTEGER*4 DEVICES(0:MAXDEV)
- EQUIVALENCE (ILOPWK,DEVICES)
-#endif
-*.______________________________________
-*
- LUNIN = 5
- LUNOUT = 6
- LUNERR = 6
-*
-#if defined(CERNLIB_ZEBRA)
- IF(NWORDS.GE.0)CALL IZINIT(NWORDS)
-#endif
-*
-* Flags initialisation
-*
-* ZFLAG = If .TRUE. the ZEBRA mode is on
-* GFLAG = If .TRUE. the graphic is on
-* CFLAG = If .TRUE. in the pictures, the attributes are stored
-* only if necessary
-* MFLAG = Mail flag (telnetg)
-* PFLAG = If .TRUE. PostScript or LaTeX or SVG metafile is active
-* TFLAG = If .TRUE. LaTeX metafile.
-* VFLAG = If .TRUE. SVG metafile.
-* GLFLAG = GLobal flag. If .TRUE. the IZ routines must be called
-* GRFLAG = Graphic flag (used by IGSG and IGSA)
-* ASFLAG = Automatic picture saving flag
-* AXFLAG = Axis flag (usefull for IGHIST and IGRAPH)
-* REDIT = Editing factor
-*
-#if defined(CERNLIB_BATCH)
- ZFLAG = .TRUE.
- GFLAG = .FALSE.
-#endif
-#if !defined(CERNLIB_BATCH)
- ZFLAG = .FALSE.
- GFLAG = .TRUE.
-#endif
- CFLAG = .TRUE.
- PFLAG = .FALSE.
- TFLAG = .FALSE.
- VFLAG = .FALSE.
- MFLAG = .FALSE.
- GRFLAG = .FALSE.
- ASFLAG = .FALSE.
- AXFLAG = .FALSE.
- GLFLAG = (ZFLAG.OR.PFLAG.OR.MFLAG)
- REDIT = 0.
-#if defined(CERNLIB_MAIL)
-*
-* MAIL option initialisation
-*
- CHCTRL = '``'
- CHEOR = '@'
- CHMAIL = ' '
-#endif
-*
-* METDEF = Default metafile type
-* IDMETA = Metafile identifier used by IGMETA
-* CHMETA = Current metafile name
-* ITGKS = Identifier of the underlaying Graphical Kernel System used
-*
- IFUSER = 0
-#if (defined(CERNLIB_GKSGRAL))&&(!defined(CERNLIB_SUNGKS)||!defined(CERNLIB_ATCGKS)||!defined(CERNLIB_GKSIBM))
- ITGKS = 1
- METDEF = 4
- IDMETA = 2
-#endif
-#if defined(CERNLIB_PLOT10GKS)
- ITGKS = 2
- METDEF = 300018
- IDMETA = 2
-#endif
-#if defined(CERNLIB_MGKS)
- ITGKS = 3
- METDEF = 300018
- IDMETA = 2
-#endif
-#if defined(CERNLIB_UNIGKS)
- ITGKS = 5
- METDEF = 1
- IDMETA = 2
-#endif
-#if defined(CERNLIB_SUNGKS)
- ITGKS = 6
- METDEF = 3
- IDMETA = 2
-#endif
-#if defined(CERNLIB_GKSIBM)
- ITGKS = 7
- METDEF = 3
- IDMETA = 2
-#endif
-#if defined(CERNLIB_DI3000)
- ITGKS = 11
- METDEF = 0
- IDMETA = 0
- CALL VZERO(DEVICES,MAXDEV+1)
-#endif
-#if (defined(CERNLIB_KERNEL)||defined(CERNLIB_FALCO)||defined(CERNLIB_BATCH))&&(!defined(CERNLIB_MSDOS))
- ITGKS = 12
- METDEF = -111
- IDMETA = 2
-#endif
-#if defined(CERNLIB_DECGKS)
- ITGKS = 13
- METDEF = 2
- IDMETA = 2
-#endif
-#if defined(CERNLIB_ATCGKS)
- ITGKS = 14
- METDEF = 10120
- IDMETA = 2
-#endif
-#if (defined(CERNLIB_PHIGS))&&(!defined(CERNLIB_KERNEL))&&(!defined(CERNLIB_FALCO))
- ITGKS = 15
- METDEF = 80795
- IDMETA = 2
-#endif
-#if defined(CERNLIB_GKSBX)
- ITGKS = 16
- METDEF = -111
- IDMETA = 2
-#endif
-#if defined(CERNLIB_MSDOS)
- IPICNM = 0
- ISURF = 18
- METDEF = ISURF
- ITGKS = 16
- IDMETA = 2
- SCMETA = 20.0
-#endif
- CHMETA = ' '
- TEKACT = .TRUE.
- METACT = .FALSE.
- FILOPN = .FALSE.
- XMFACT = 0.01
- YMFACT = 0.01
-*
-* Attributes initialisation
-*
- IDID = 1
- ICLIP = 1
- IFAISI = 0
-#if !defined(CERNLIB_DI3000)
- IFASI = 1
-#endif
-#if defined(CERNLIB_DI3000)
- IFASI = 0
-#endif
- ILN = 1
- RLWSC = 1.0
- RBSL = 0.01
- IMK = 1
- RMKSC = 1.0
- IPLCI = 1
- IPMCI = 1
- IFACI = 1
- ITXALH = 0
- ITXALV = 0
- ITXALG = 0
- RCHH = 0.28
- RCHUX = 0.0
- RCHUY = 1.0
- RANGLE = 0.0
- ITXCI = 1
- IFONT = 0
- IPREC = 2
- IFTPR = 2
- IBORD = 0
- INPASS = 1
- RCSHIF = 0.02
- RALH = 0.018
- RALD = 0.013
- RTMS = 0.019
- RBOF = 0.25
- RBWD = 0.5
- RAWL = 0.0
- INLINE = 40
- INBCOL = 8
- IDIM = 2
-*
-* Axis Alphanumeric Labels initialisation
-*
- DO 10 I=1,MAXLAB
- HILABS(I) = ' '
- 10 CONTINUE
-*
-* Initialise workstations parameters
-*
-* INOPWK = Number of opened workstations
-* ILOPWK = List of the workstation IDs of the opened workstations
-* IWTYL = List of the workstation types of the opened workstations
-* ACWKFL = List of flags. If TRUE the workstation is active
-* XWKSIZ = X size of the workstation
-* YWKSIZ = Y size of the workstation
-* XWKR = Workstation ratio on X
-* YWKR = Workstation ratio on Y
-* XWKWn = X worksation window value
-* YWKWn = Y worksation window value
-* XWKVn = X worksation viewport value
-* YWKVn = Y worksation viewport value
-* IWINID = Workstation window ID
-*
- INOPWK = 0
- DO 20 I=1,10
- ILOPWK(I) = 0
- IWTYL(I) = 0
- ACWKFL(I) = .FALSE.
- XWKSIZ(I) = 0.
- YWKSIZ(I) = 0.
- IWINID(I) = 0
- XWKR(I) = 1.
- YWKR(I) = 1.
- XWKW1(I) = 0.
- YWKW1(I) = 0.
- XWKV1(I) = 0.
- YWKV1(I) = 0.
- XWKW2(I) = 1.
- YWKW2(I) = 1.
- XWKV2(I) = 1.
- YWKV2(I) = 1.
- 20 CONTINUE
-*
- IPICT = 1
- NT0PRI = 1
-*
-* Default Normalisation Transformation
-*
- INTR = 0
- RWXMIN = 0.
- RWXMAX = 1.
- RWYMIN = 0.
- RWYMAX = 1.
- RVXMIN = 0.
- RVXMAX = 1.
- RVYMIN = 0.
- RVYMAX = 1.
- RDWXMI = 0.
- RDWYMI = 0.
- RDWXMA = 1.
- RDWYMA = 1.
-*
-* Initialisation for IRQLC
-*
- OLDXP = 0.
- OLDYP = 0.
-*
-* Initialisation for IGMENU
-*
- XPOS(1)=RDWXMA-0.21
- XPOS(2)=RDWXMA-0.01
- YPOS(1)=RDWYMA-0.71
- YPOS(2)=RDWYMA-0.01
-#if (defined(CERNLIB_GKS))&&(!defined(CERNLIB_MGKS))
- DO 30 I=1,100
- ISEGM(I)=0
- 30 CONTINUE
-#endif
-#if defined(CERNLIB_DI3000)
- DO 30 I=1,100
- ISEGM(I)=0
- 30 CONTINUE
-#endif
-*
-* Initialisation of the NT transformation storage
-*
-#if (!defined(CERNLIB_NTC))&&(!defined(CERNLIB_X11))
- NTSTOR(1)=0
-#endif
-#if defined(CERNLIB_NTC)||defined(CERNLIB_X11)
- CALL IGNINT
-#endif
-*
-* Initialisation of the number of stacked legos plots
-*
- NIDS=0
-*
-* Initialise the color table
-*
- REDLUT(1)=1.
- REDLUT(2)=0.
- REDLUT(3)=1.
- REDLUT(4)=0.
- REDLUT(5)=0.
- REDLUT(6)=1.
- REDLUT(7)=1.
- REDLUT(8)=0.
- GRNLUT(1)=1.
- GRNLUT(2)=0.
- GRNLUT(3)=0.
- GRNLUT(4)=1.
- GRNLUT(5)=0.
- GRNLUT(6)=1.
- GRNLUT(7)=0.
- GRNLUT(8)=1.
- BLULUT(1)=1.
- BLULUT(2)=0.
- BLULUT(3)=0.
- BLULUT(4)=0.
- BLULUT(5)=1.
- BLULUT(6)=0.
- BLULUT(7)=1.
- BLULUT(8)=1.
- DCOL=1./(NBCLUT-9)
- DO 60 I=9,NBCLUT
- GREY=1.-DCOL*(I-9)
- REDLUT(I)=GREY
- GRNLUT(I)=GREY
- BLULUT(I)=GREY
- 60 CONTINUE
-*
- END
diff --git a/src/graflib/higz/ig/igiwin.F b/src/graflib/higz/ig/igiwin.F
deleted file mode 100644
index 7d28364..0000000
--- a/src/graflib/higz/ig/igiwin.F
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: igiwin.F,v 1.1.1.1 1996/02/14 13:10:35 mclareni Exp $
-*
-* $Log: igiwin.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:35 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.09/00 31/10/89 14.50.24 by O.Couet
-*-- Author : O.Couet
- FUNCTION IGIWIN(IWKID)
-*.===========>
-*. IG Inquire Workstation INdex
-*..==========>
-#include "higz/hiatt.inc"
- IGIWIN=0
- DO 10 I=1,INOPWK
- IF(IWKID.EQ.ILOPWK(I))THEN
- IGIWIN=I
- RETURN
- ENDIF
- 10 CONTINUE
-*
- END
diff --git a/src/graflib/higz/ig/igiwty.F b/src/graflib/higz/ig/igiwty.F
deleted file mode 100644
index bd6c911..0000000
--- a/src/graflib/higz/ig/igiwty.F
+++ /dev/null
@@ -1,35 +0,0 @@
-*
-* $Id: igiwty.F,v 1.1.1.1 1996/02/14 13:10:35 mclareni Exp $
-*
-* $Log: igiwty.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:35 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.06/03 23/01/89 15.47.54 by O.Couet
-*-- Author :
- FUNCTION IGIWTY(IWKID)
-*.===========>
-*.
-*. This function return the workstation type of the workstation
-*. identified by IWKID .
-*.
-*. _Input parameters:
-*.
-*. INTEGER IWKID : Workstation identifier .
-*.
-*..==========> (O.Couet)
-#include "higz/hiatt.inc"
- PARAMETER (NBWKOP=10)
-*.______________________________________
-*
- IGIWTY=0
- DO 10 I=1,NBWKOP
- IF(IWKID.EQ.ILOPWK(I))THEN
- IGIWTY=IWTYL(I)
- RETURN
- ENDIF
- 10 CONTINUE
-*
- END
diff --git a/src/graflib/higz/ig/iglbl.F b/src/graflib/higz/ig/iglbl.F
deleted file mode 100644
index 570e1f0..0000000
--- a/src/graflib/higz/ig/iglbl.F
+++ /dev/null
@@ -1,45 +0,0 @@
-*
-* $Id: iglbl.F,v 1.1.1.1 1996/02/14 13:10:36 mclareni Exp $
-*
-* $Log: iglbl.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:36 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.16/09 07/01/93 15.37.36 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE IGLBL(NLBL,CHLBL)
-*.==========>
-*.
-*. To change the alphanumeric label of the axis.
-*.
-*. _Input parameters:
-*.
-*. INTEGER NLBL : Number of alphanumeric labels in CHLBL
-*. CHARACTER CHLBL : New value of the alphanumeric labels
-*.
-*..=========> (O.Couet)
-#include "higz/hiflag.inc"
-#include "higz/hilabs.inc"
- CHARACTER*(*) CHLBL(*)
-*._____________________________
-*
- IF(NLBL.LE.0.OR.NLBL.GT.MAXLAB)THEN
- CALL IGERR('Wrong number of labels','IGLBL')
- RETURN
- ENDIF
-*
- NHILAB = NLBL
- DO 10 I=1,NLBL
- HILABS(I) = CHLBL(I)
- 10 CONTINUE
- DO 20 I=NLBL+1,MAXLAB
- HILABS(I) = ' '
- 20 CONTINUE
-*
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_MAIL)
- IF(GLFLAG)CALL IZLBL
-#endif
-*
- END
diff --git a/src/graflib/higz/ig/iglev.F b/src/graflib/higz/ig/iglev.F
deleted file mode 100644
index 49c47f1..0000000
--- a/src/graflib/higz/ig/iglev.F
+++ /dev/null
@@ -1,66 +0,0 @@
-*
-* $Id: iglev.F,v 1.2 2002/03/18 14:18:08 couet Exp $
-*
-* $Log: iglev.F,v $
-* Revision 1.2 2002/03/18 14:18:08 couet
-* - The number of divisions when IHCSPE is called, must be positive.
-*
-* Revision 1.1.1.1 1996/02/14 13:10:36 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.13/09 16/01/92 15.50.38 by O.Couet
-*-- Author : O.Couet 16/01/92
- SUBROUTINE IGLEV(N,WMINI,WMAXI,ICOLOR,CHOPT)
-*.===========>
-*.
-*. This routines allows to initialize the level for the
-*. IH routines set. It can initialize the levels along the
-*. Z axis (CHOPT='A') or with a palette of colors (CHOPT='C')
-*.
-*. _Input parameters:
-*.
-*. INTEGER N : Number of levels
-*. REAL WMINI : minimum value on Z axis
-*. REAL WMAXI : maximum value on Z axis
-*. INTEGER ICOLOR : Array containing the palette
-*. CHARACTER : Option ('A' or 'C'). The two options
-*. are exclusive.
-*.
-*..==========> (O.Couet)
-#include "higz/higraf.inc"
- CHARACTER*(*) CHOPT
- DIMENSION ICOLOR(*)
-*.______________________________________
-*
- NDIVZ=N
- WMIN=WMINI
- WMAX=WMAXI
-*
-* Initialize the levels on the Z axis
-*
- IF(INDEX(CHOPT,'A').NE.0)THEN
- IF(NDIVZ.LT.0)THEN
- CALL IGAXIS(-1.,1.,-1.,1.,WMIN,WMAX,-NDIVZ,'XN')
- ELSE
- CALL IGAXIS(-1.,1.,-1.,1.,WMIN,WMAX,NDIVZ,'X')
- ENDIF
- CALL IHCSPE(ABS(NDIVZ),WMIN,WMAX,1,0,IREP)
- ENDIF
-*
-* Initialize the colour levels
-*
- IF(INDEX(CHOPT,'C').NE.0)THEN
- IF(NDIVZ.GE.NPMAX)THEN
- CALL IGERR('Too many levels','IGLEV')
- RETURN
- ENDIF
- DZ = (WMAX-WMIN)/FLOAT(NDIVZ)
- DO 10 I=1,NDIVZ-1
- YGRAF(I)=WMIN+DZ*FLOAT(I)
- 10 CONTINUE
- CALL IHCLEV(NDIVZ-1,YGRAF,ICOLOR,IREP)
- ENDIF
-*
- END
diff --git a/src/graflib/higz/ig/igloc.F b/src/graflib/higz/ig/igloc.F
deleted file mode 100644
index 3822293..0000000
--- a/src/graflib/higz/ig/igloc.F
+++ /dev/null
@@ -1,36 +0,0 @@
-*
-* $Id: igloc.F,v 1.1.1.1 1996/02/14 13:10:36 mclareni Exp $
-*
-* $Log: igloc.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:36 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.10/00 06/06/89 09.13.35 by O.Couet
-* No more special case for DI3000
-*-- Author : O.Couet
- SUBROUTINE IGLOC(ICURS,NT,IBN,XNDC,YNDC,XWC,YWC)
-*.===========>
-*.
-*. This routine returns the locator coordinates in the NDC space and in
-*. the WC space. If REDIT.NE.0 Or REDIT.NE.1 the XNDC and YNDC value are
-*. always returns like REDIT=1 or 0 but the XWC and YWC values are computed
-*. according to the value of REDIT.
-*.
-*..==========> (O.Couet)
-#include "higz/hiatt.inc"
-#include "higz/hiques.inc"
-*.______________________________________
-*
- CALL IRQLC(IDID,ICURS,ISTA,NNT,PX,PY)
- NT=NNT
- IBN=ISTA
- XWC=PX
- YWC=PY
- XNDC=RQUEST(11)
- YNDC=RQUEST(12)
-*
- END
-
-
diff --git a/src/graflib/higz/ig/igloc2.F b/src/graflib/higz/ig/igloc2.F
deleted file mode 100644
index 0fb4327..0000000
--- a/src/graflib/higz/ig/igloc2.F
+++ /dev/null
@@ -1,52 +0,0 @@
-*
-* $Id: igloc2.F,v 1.1.1.1 1996/02/14 13:10:36 mclareni Exp $
-*
-* $Log: igloc2.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:36 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.11/00 22/10/90 10.27.20 by O.Couet
-*-- Author :
- SUBROUTINE IGLOC2(IWKID,NT,XLOC1,YLOC1,XLOC2,YLOC2,ISTAT,CHOPT)
-*.===========>
-*.
-*. This routine returns the graphic cursor position in WC space of
-*. 2 points (XLOC1,YLOC1) AND (XLOC2,YLOC2) and the corresponding
-*. normalize transformation number NT.
-*. Rubber_banding option is used to visualize the area (box) delimited
-*. by the 2 points.
-*.
-*. _Input parameters:
-*.
-*. INTEGER WKID : Workstation identifier .
-*. CHARACTER CHOPT : Option flags
-*. CHOPT = ' ' NT is an output parameter
-*. CHOPT = 'P' NT is an input parameter
-*. CHOPT = 'L' Rubberbanding Line
-*.
-*. _Output parameters:
-*.
-*. INTEGER NT : Normalization transformation number .
-*. REAL XLOC1 YLOC1 : Cursor position in WC space of first point .
-*. REAL XLOC2 YLOC2 : Cursor position in WC space of second point .
-*. INTEGER ISTAT : Return status: 0=BREAK, 1=OK .
-*.
-*..==========> (R.Brun)
- CHARACTER*(*) CHOPT
-*.______________________________________
-*
- IF(INDEX(CHOPT,'P').NE.0)CALL ISELNT(NT)
- CALL IRQLC(IWKID,1,ISTAT,NT,XLOC1,YLOC1)
- IF(ISTAT.EQ.0)RETURN
-*
- IPET=51
- IF(INDEX(CHOPT,'L').NE.0)THEN
- IPET=41
- ENDIF
- CALL IRQLC(IWKID,IPET,ISTAT,NT2,XLOC2,YLOC2)
- IF(NT2.NE.NT)NT=0
-*
- END
-
diff --git a/src/graflib/higz/ig/igm100.F b/src/graflib/higz/ig/igm100.F
deleted file mode 100644
index f000c91..0000000
--- a/src/graflib/higz/ig/igm100.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: igm100.F,v 1.1.1.1 1996/02/14 13:10:36 mclareni Exp $
-*
-* $Log: igm100.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:36 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.12/00 12/02/91 12.22.25 by O.Couet
-*-- Author : O.Couet 12/02/91
- LOGICAL FUNCTION IGM100(METAFL)
-*
- IGM100=.FALSE.
-#if defined(CERNLIB_GKSGRAL)
- IF(METAFL.EQ.12201.OR.METAFL.EQ.12202.OR.METAFL.EQ.101.OR.
- + (METAFL.GE.4011.AND.METAFL.LE.4230).OR.
- + (METAFL.GE.14401.AND.METAFL.LE.14420))IGM100=.TRUE.
-#endif
-#if defined(CERNLIB_ATCGKS)
- IF((METAFL.GE.10100.AND.METAFL.LE.10300).OR.
- + (METAFL.GE.1500.AND.METAFL.LE.1505).OR.
- + (METAFL.GE.1900.AND.METAFL.LE.1905).OR.
- + (METAFL.GE.5300.AND.METAFL.LE.5350).OR.
- + (METAFL.GE.6300.AND.METAFL.LE.6307))IGM100=.TRUE.
-#endif
-*
- END
diff --git a/src/graflib/higz/ig/igmess.F b/src/graflib/higz/ig/igmess.F
deleted file mode 100644
index 195498a..0000000
--- a/src/graflib/higz/ig/igmess.F
+++ /dev/null
@@ -1,42 +0,0 @@
-*
-* $Id: igmess.F,v 1.1.1.1 1996/02/14 13:10:36 mclareni Exp $
-*
-* $Log: igmess.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:36 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.16/07 13/11/92 09.17.20 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE IGMESS(N,CHMESS,CHTIT,CHOPT)
-#if defined(CERNLIB_X11)
-#include "higz/hikern.inc"
-#endif
- CHARACTER*(*) CHMESS(N),CHTIT,CHOPT
- CHARACTER*12 CODED
-*.______________________________________
-*
-#if !defined(CERNLIB_X11)
- WRITE (CODED,'(''('',I2,''(X,A,/))'')') N
- IF(INDEX(CHOPT,'P').NE.0)WRITE (6,CODED)
- + (CHMESS(I)(1:LENOCC(CHMESS(I))+1),I=1,N)
-#endif
-#if defined(CERNLIB_X11)
-*
- IF(INDEX(CHOPT,'T').NE.0)THEN
- WRITE (CODED,'(''('',I2,''(X,A,/))'')') N
- IF(INDEX(CHOPT,'P').NE.0)WRITE (6,CODED)
- + (CHMESS(I)(1:LENOCC(CHMESS(I))+1),I=1,N)
- RETURN
- ENDIF
-*
- LENMAX=LENOCC(CHMESS(1))
- DO 10 I=2,N
- IF(LENOCC(CHMESS(I)).GT.LENMAX)LENMAX=LENOCC(CHMESS(I))
- 10 CONTINUE
- CALL IGXMES(0,0,LENMAX,N,CHMESS,CHTIT,CHOPT)
-*
-#endif
-*
- END
diff --git a/src/graflib/higz/ig/igmeta.F b/src/graflib/higz/ig/igmeta.F
deleted file mode 100644
index 0189dbc..0000000
--- a/src/graflib/higz/ig/igmeta.F
+++ /dev/null
@@ -1,157 +0,0 @@
-*
-* $Id: igmeta.F,v 1.1.1.1 1996/02/14 13:10:36 mclareni Exp $
-*
-* $Log: igmeta.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:36 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-#if !defined(CERNLIB_DI3000)
-*CMZ : 1.18/01 04/05/93 11.22.25 by O.Couet
-*-- Author :
- SUBROUTINE IGMETA (IIUNIT,METAFL)
-*.==========>
-*.
-*. To open, activate, deactivate and close metafile or screen
-*.
-*..=========>
-#include "higz/himeta.inc"
-#include "higz/himet2.inc"
-#include "higz/hiflag.inc"
-#if defined(CERNLIB_ATCGKS)
- CHARACTER*24 METAFILE
-#endif
-*._____________________________
-*
- IUNIT = IIUNIT
- IF(IIUNIT.EQ.999)IUNIT = 0
-*
-* Output to screen and metafile
-*
- IWKID=1
- IF (IUNIT.GT.0) THEN
- GFLAG=.TRUE.
- IF (.NOT.TEKACT) THEN
- CALL IACWK(IWKID)
- TEKACT=.TRUE.
- ENDIF
- IF (.NOT. METACT) THEN
- IF (.NOT. FILOPN) THEN
- IF(METAFL.NE.0)THEN
- IWT=METAFL
- ELSE
- IWT=METDEF
- ENDIF
-#if defined(CERNLIB_ATCGKS)
- IF(CHMETA.EQ.' ') THEN
- IF(IWT.EQ.10100)THEN
- METAFILE='cgmb.met'
- ELSEIF(IWT.EQ.10110)THEN
- METAFILE='cgmc.met'
- ELSEIF(IWT.EQ.10120)THEN
- METAFILE='cgmt.met'
- ELSEIF(IWT.GE.1500.AND.IWT.LE.1505)THEN
- METAFILE='talaris.higz'
- ELSEIF(IWT.GE.1900.AND.IWT.LE.1905)THEN
- METAFILE='postscr.higz'
- ELSEIF(IWT.GE.5300.AND.IWT.LE.5350)THEN
- METAFILE='x11.higz'
- ELSEIF(IWT.GE.6300.AND.IWT.LE.6307)THEN
- METAFILE='imagen.higz'
- ELSE
- METAFILE='printer.higz'
- ENDIF
- ELSE
- METAFILE=CHMETA
- ENDIF
- CALL GUESC050(IUNIT,METAFILE)
-#endif
- CALL IOPWK (IDMETA,IUNIT,IWT)
-#if !defined(CERNLIB_MSDOS)
- FILOPN = .TRUE.
-#endif
-#if defined(CERNLIB_MSDOS)
- IF(IWT.NE.METDEF)FILOPN = .TRUE.
-#endif
- ENDIF
- CALL IACWK(IDMETA)
- METACT = .TRUE.
- ENDIF
- RETURN
- ENDIF
-*
-* Output to screen only
-*
- IF(IUNIT.EQ.0)THEN
- CALL IGQWK(IWKID,'OPEN',RVAL)
- IF(RVAL.NE.0.)THEN
- GFLAG=.TRUE.
- IF (.NOT.TEKACT) THEN
- CALL IACWK(IWKID)
- TEKACT = .TRUE.
- ENDIF
- ENDIF
- IF (METACT) THEN
- CALL IDAWK(IDMETA)
- METACT = .FALSE.
- ENDIF
- IF(IIUNIT.EQ.999)THEN
- CALL ICLWK(IDMETA)
- FILOPN=.FALSE.
- ENDIF
- RETURN
- ENDIF
-*
-* Output to metafile file only
-*
- IF (TEKACT) THEN
- CALL IDAWK(IWKID)
- TEKACT = .FALSE.
- ENDIF
- IF (.NOT. METACT) THEN
- IF (.NOT. FILOPN) THEN
- IF(METAFL.NE.0)THEN
- IWT=METAFL
- ELSE
- IWT=METDEF
- ENDIF
-#if defined(CERNLIB_ATCGKS)
- IF(CHMETA.EQ.' ') THEN
- IF(IWT.EQ.10100)THEN
- METAFILE='cgmb.met'
- ELSEIF(IWT.EQ.10110)THEN
- METAFILE='cgmc.met'
- ELSEIF(IWT.EQ.10120)THEN
- METAFILE='cgmt.met'
- ELSEIF(IWT.GE.1500.AND.IWT.LE.1505)THEN
- METAFILE='talaris.higz'
- ELSEIF(IWT.GE.1900.AND.IWT.LE.1905)THEN
- METAFILE='postscr.higz'
- ELSEIF(IWT.GE.5300.AND.IWT.LE.5350)THEN
- METAFILE='x11.higz'
- ELSEIF(IWT.GE.6300.AND.IWT.LE.6307)THEN
- METAFILE='imagen.higz'
- ELSE
- METAFILE='printer.higz'
- ENDIF
- ELSE
- METAFILE=CHMETA
- ENDIF
- CALL GUESC050(-IUNIT,METAFILE)
-#endif
- CALL IOPWK (IDMETA,-IUNIT,IWT)
-#if !defined(CERNLIB_MSDOS)
- FILOPN = .TRUE.
-#endif
-#if defined(CERNLIB_MSDOS)
- IF(IWT.NE.METDEF)FILOPN = .TRUE.
-#endif
- ENDIF
- CALL IACWK(IDMETA)
- METACT = .TRUE.
- IF(IWT.LT.0)GFLAG=.FALSE.
- ENDIF
-*
- END
-#endif
diff --git a/src/graflib/higz/ig/igmetn.F b/src/graflib/higz/ig/igmetn.F
deleted file mode 100644
index dc0c1b0..0000000
--- a/src/graflib/higz/ig/igmetn.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: igmetn.F,v 1.1.1.1 1996/02/14 13:10:36 mclareni Exp $
-*
-* $Log: igmetn.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:36 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.18/01 04/05/93 13.26.22 by O.Couet
-*-- Author : O.Couet 04/05/93
- SUBROUTINE IGMETN(CHNAME)
-*.===========>
-*.
-*. Set the metafile name
-*.
-*..==========>
-#include "higz/himeta.inc"
- CHARACTER*(*) CHNAME
- CHMETA = CHNAME
- END
diff --git a/src/graflib/higz/ig/igobj.F b/src/graflib/higz/ig/igobj.F
deleted file mode 100644
index b266bda..0000000
--- a/src/graflib/higz/ig/igobj.F
+++ /dev/null
@@ -1,63 +0,0 @@
-*
-* $Id: igobj.F,v 1.1.1.1 1996/02/14 13:10:36 mclareni Exp $
-*
-* $Log: igobj.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:36 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-#if defined(CERNLIB_X11)
-*CMZ : 1.23/03 04/09/95 11.56.42 by O.Couet
-*-- Author : O.Couet 26/08/92
- SUBROUTINE IGOBJ(IX,IY,NBLEV,IPID,CHPID)
-*.===========>
-*.
-*. This routine return to KUIP/Motif the object picked
-*. on the HIGZ/X11 graphics window.
-*.
-*. _Input parameters:
-*.
-*. INTEGER IX,IY : Cursor position
-*. INTEGER NBLEV : Window number
-*.
-*. _Output parameters:
-*.
-*. INTEGER NBLEV : Number of level in the pick path
-*. INTEGER IPID(NBLEV) : Integer ID.
-*. CHARACTER CHPID(NBLEV) : Character ID. CHPID(1)=Class name
-*.
-*..==========>
- CHARACTER*(*) CHPID(*)
- DIMENSION IPID(*)
-*.______________________________________
-*
- X = FLOAT(IX)
- Y = FLOAT(IY)
- IWIN = NBLEV
- NBLEV = 0
- CALL IZPICT(' ','QO')
- CALL IRQLC(1,99,ISTAT,NT,X,Y)
- CALL IGPICK(NT,X,Y,NBLEV,CHPID,IPID,' ')
-*
- IF(NBLEV.EQ.0)THEN
- NT2 = 0
- 10 IF (NT2.NE.NT) THEN
- CALL ISELNT(NT2)
- X = FLOAT(IX)
- Y = FLOAT(IY)
- CALL IRQLC(1,99,ISTAT,NTT,X,Y)
- IF (NTT.EQ.NT2) THEN
- CALL IGPICK(NT2,X,Y,NBLEV,CHPID,IPID,' ')
- IF (NBLEV.NE.0) RETURN
- ENDIF
- ENDIF
- NT2 = IZGNNT(NT2)
- IF (NT2.GE.0) GOTO 10
- NBLEV = 1
- CHPID(1) = 'win'
- IPID(1) = IWIN
- ENDIF
-*
- END
-#endif
diff --git a/src/graflib/higz/ig/igparf.F b/src/graflib/higz/ig/igparf.F
deleted file mode 100644
index b736197..0000000
--- a/src/graflib/higz/ig/igparf.F
+++ /dev/null
@@ -1,48 +0,0 @@
-*
-* $Id: igparf.F,v 1.1.1.1 1996/02/14 13:10:36 mclareni Exp $
-*
-* $Log: igparf.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:36 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.20/00 01/11/93 10.24.15 by O.Couet
-*-- Author : G.Richards 06/12/91
- SUBROUTINE IGPARF(IARCH,CHOPT)
-#if defined(CERNLIB_PHIGS)
-#include "higz/hiatt.inc"
-#endif
- CHARACTER*(*) CHOPT
-#if defined(CERNLIB_PHIGS)
- IF (IDIM.NE.3) RETURN
-*
- IF (CHOPT.EQ.'S') THEN
- CALL PSCNRS (2,2)
- CALL POPARF (1,IARCH)
- CALL PARAST (1)
- CALL PCLARF (1)
- ENDIF
-*
- IF (CHOPT.EQ.'D') THEN
- CALL PSCNRS(1,1)
- CALL POPARF (1,IARCH)
- CALL PDASAR(1)
- CALL PCLARF (1)
- ENDIF
-*
- IF (CHOPT.EQ.'R') THEN
- CALL PSCNRS(2,2)
- CALL POPARF (1,IARCH)
- CALL PQSID(IN,IERR,INUM,ISTRID)
- ISTCNT=101
- DO 10 I=1,INUM
- CALL PQSID(I,IERR,INUM,ISTRID)
- IF (ISTRID.GT.ISTCNT) ISTCNT=ISTRID
- 10 CONTINUE
- ISTCNT=ISTCNT+1
- CALL PRAST (1)
- CALL PCLARF(1)
- ENDIF
-#endif
- END
diff --git a/src/graflib/higz/ig/igpave.F b/src/graflib/higz/ig/igpave.F
deleted file mode 100644
index 8956b9f..0000000
--- a/src/graflib/higz/ig/igpave.F
+++ /dev/null
@@ -1,299 +0,0 @@
-*
-* $Id: igpave.F,v 1.1.1.1 1996/02/14 13:10:37 mclareni Exp $
-*
-* $Log: igpave.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:37 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.22/11 07/04/95 10.07.30 by O.Couet
-*-- Author : O.Couet 28/03/89
- SUBROUTINE IGPAVE(X1I,X2I,Y1I,Y2I,DZ,ISBOX,ISFRAM,CHOPT)
-*.==============>
-*.
-*. Draw a paving-block (box with 3D effect). Useful for slides.
-*. ISBOX (ISFRAM) may be 1000+ICOLOR where ICOLOR is the color index
-*. of the box (frame), or 2000+IPAT where IPAT is the pattern index of
-*. the box (frame), otherwise the style index.
-*. If ISBOX(ISFRAM)=0, only the box contour is drawn with the current
-*. polyline attributes.
-*. By default the Top and the Right frame are drawn. CHOPT='TR'.
-*.
-*. _Input parameters:
-*.
-*. REAL X1I : X bottom left corner of box
-*. REAL X2I : X top right corner of box
-*. REAL Y1I : Y bottom left corner of box
-*. REAL Y2I : Y top right corner of box
-*. REAL DZ : Box width
-*. INTEGER ISBOX : Box style
-*. INTEGER ISFRAM : Frame style' I D=5
-*. CHARACTER CHOPT : Character option
-*. CHOPT='T' Top frame
-*. CHOPT='B' Bottom frame
-*. CHOPT='R' Right frame
-*. CHOPT='L' Left frame
-*. CHOPT='-' Negative sense
-*. CHOPT='S' Shadow
-*. CHOPT='P' Cut the shadow
-*. CHOPT='K' Key
-*. CHOPT='D' Delete (usefull for IGMENU)
-*.
-*.============> (O.Couet)
-#include "higz/hiatt.inc"
-#include "higz/hiflag.inc"
- DIMENSION IOPT(9)
- EQUIVALENCE (IOPTT,IOPT(1)),(IOPTB,IOPT(2))
- EQUIVALENCE (IOPTL,IOPT(3)),(IOPTR,IOPT(4))
- EQUIVALENCE (IOPTM,IOPT(5)),(IOPTS,IOPT(6))
- EQUIVALENCE (IOPTP,IOPT(7)),(IOPTK,IOPT(8))
- EQUIVALENCE (IOPTD,IOPT(9))
- CHARACTER*(*) CHOPT
- DIMENSION X(4),Y(4)
- LOGICAL ZFSAV
-*.______________________________________
-*
- CALL UOPTC(CHOPT,'TBLR-SPKD',IOPT)
- IF(CHOPT.EQ.' ')THEN
- IOPTT=1
- IOPTR=1
- ELSE
- IF((IOPTT+IOPTR+IOPTL+IOPTB).GE.3
- +.OR. (IOPTL+IOPTR).EQ.2
- +.OR. (IOPTT+IOPTB).EQ.2 )THEN
- CALL IGERR('Incompatible options, default is taken'
- +, 'IGPAVE')
- IOPTT=1
- IOPTR=1
- IOPTB=0
- IOPTL=0
- IOPTM=0
- ENDIF
- ENDIF
-*
-* Sort the PAVE coordinates.
-*
- IF (X1I.GT.X2I) THEN
- X1 = X2I
- X2 =X 1I
- ELSE
- X1 = X1I
- X2 = X2I
- ENDIF
- IF (Y1I.GT.Y2I) THEN
- Y1 = Y2I
- Y2 = Y1I
- ELSE
- Y1 = Y1I
- Y2 = Y2I
- ENDIF
-*
-* Store the PAVE inside the current picture.
-* The sorted coordinates are stored otherwise picking
-* is impossible.
-*
-#if defined(CERNLIB_ZEBRA)
- IF(GLFLAG)CALL IZPAVE(X1,X2,Y1,Y2,DZ,ISBOX,ISFRAM,IOPT)
-#endif
- IF((.NOT.GFLAG).AND.(.NOT.PFLAG))RETURN
- ZFSAV = ZFLAG
- ZFLAG = .FALSE.
- GLFLAG = (ZFLAG.OR.PFLAG.OR.MFLAG)
-*
-* Save the context
-*
- IBORDS = IBORD
- IFACIS = IFACI
- IFAISS = IFAIS
- IFASIS = IFASI
-*
-* Delete a Paving-Block
-*
- IF(IOPTD.NE.0)THEN
- CALL ISFACI(0)
- CALL ISPLCI(0)
- CALL ISFAIS(1)
- CALL ISLN(1)
- CALL IGSET('BORD',1.)
- GOTO 20
- ENDIF
-*
-* Draw the inside of the box
-*
- IF(ISBOX.EQ.0)THEN
- CALL ISFAIS(0)
- GOTO 10
- ENDIF
- IF(ISBOX.LT.1000)THEN
- CALL ISFAIS(3)
- CALL ISFASI(ISBOX)
- GOTO 10
- ENDIF
- IF(ISBOX.GE.1000.AND.ISBOX.LT.2000)THEN
- CALL ISFAIS(1)
- CALL ISFACI(ISBOX-1000)
- GOTO 10
- ENDIF
- IF(ISBOX.GE.2000)THEN
- CALL ISFAIS(2)
- CALL ISFASI(ISBOX-2000)
- ENDIF
- 10 CALL IGSET('BORD',0.)
- 20 CALL IGBOX(X1,X2,Y1,Y2)
- IF(IOPTD.NE.0)GOTO 30
-*
-* Draw the frame
-*
- IF(DZ.LE.0.)GOTO 40
- IF(ISFRAM.EQ.ISBOX)GOTO 30
- IF(ISFRAM.EQ.0)THEN
- CALL ISFAIS(0)
- GOTO 30
- ENDIF
- IF(ISFRAM.LT.1000)THEN
- CALL ISFAIS(3)
- CALL ISFASI(ISFRAM)
- CALL ISFACI(1)
- GOTO 30
- ENDIF
- IF(ISFRAM.GE.1000.AND.ISFRAM.LT.2000)THEN
- CALL ISFAIS(1)
- CALL ISFACI(ISFRAM-1000)
- GOTO 30
- ENDIF
- IF(ISFRAM.GE.2000)THEN
- CALL ISFAIS(2)
- CALL ISFASI(ISFRAM-2000)
- ENDIF
-*
- 30 DZ2=0.5*DZ
- IF(IOPTM.NE.0)THEN
- M = -1
- ELSE
- M = 1
- ENDIF
- IF(IOPTS.NE.0)THEN
- IS = 1
- ELSE
- IS = 0
- ENDIF
- IF(IOPTK.NE.0)THEN
- IS = 0
- M = 1
- IOPTP = 0
- IOPTS = 0
- K = -2
- ELSE
- K = 0
- ENDIF
-*
-* Top side
-*
- IF(IOPTT.NE.0.OR.IOPTK.NE.0)THEN
- IF(IOPTL.NE.0.AND.IOPTK.EQ.0)M=-1
- X(1)=X1+IS*M*DZ2
- X(2)=X1+M*DZ2+K*DZ2
- X(3)=X2+M*DZ2
- X(4)=X2+IS*M*DZ2
- Y(1)=Y2
- Y(2)=Y2+DZ2
- Y(3)=Y2+DZ2
- Y(4)=Y2
- IF(IOPTP.NE.0)THEN
- IF(M.GT.0)THEN
- X(3)=X2
- ELSE
- X(2)=X1
- ENDIF
- ENDIF
- IF(IOPTT.NE.0.OR.IOPTD.NE.0)CALL IFA(4,X,Y)
- IF(IOPTS.EQ.0)CALL IPL(4,X,Y)
- M=1
- ENDIF
-*
-* Bottom side
-*
- IF(IOPTB.NE.0.OR.IOPTK.NE.0)THEN
- IF(IOPTL.NE.0.AND.IOPTK.EQ.0)M=-1
- X(1)=X1+IS*M*DZ2
- X(2)=X1+M*DZ2+K*DZ2
- X(3)=X2+M*DZ2
- X(4)=X2+IS*M*DZ2
- Y(1)=Y1
- Y(2)=Y1-DZ2
- Y(3)=Y1-DZ2
- Y(4)=Y1
- IF(IOPTP.NE.0)THEN
- IF(M.GT.0)THEN
- X(3)=X2
- ELSE
- X(2)=X1
- ENDIF
- ENDIF
- IF(IOPTB.NE.0.OR.IOPTD.NE.0)CALL IFA(4,X,Y)
- IF(IOPTS.EQ.0)CALL IPL(4,X,Y)
- M=-1
- ENDIF
-*
-* Left side
-*
- IF(IOPTL.NE.0.OR.IOPTK.NE.0)THEN
- X(1)=X1
- X(2)=X1-DZ2
- X(3)=X1-DZ2
- X(4)=X1
- Y(1)=Y1+IS*M*DZ2
- Y(2)=Y1+M*DZ2
- Y(3)=Y2+M*DZ2-K*DZ2
- Y(4)=Y2+IS*M*DZ2
- IF(IOPTP.NE.0)THEN
- IF(M.GT.0)THEN
- Y(3)=Y2
- ELSE
- Y(2)=Y1
- ENDIF
- ENDIF
- IF(IOPTL.NE.0.OR.IOPTD.NE.0)CALL IFA(4,X,Y)
- IF(IOPTS.EQ.0)CALL IPL(4,X,Y)
- ENDIF
-*
-* Right side
-*
- IF(IOPTR.NE.0.OR.IOPTK.NE.0)THEN
- X(1)=X2
- X(2)=X2+DZ2
- X(3)=X2+DZ2
- X(4)=X2
- Y(1)=Y1+IS*M*DZ2
- Y(2)=Y1+M*DZ2
- Y(3)=Y2+M*DZ2-K*DZ2
- Y(4)=Y2+IS*M*DZ2
- IF(IOPTP.NE.0)THEN
- IF(M.GT.0)THEN
- Y(3)=Y2
- ELSE
- Y(2)=Y1
- ENDIF
- ENDIF
- IF(IOPTR.NE.0.OR.IOPTD.NE.0)CALL IFA(4,X,Y)
- IF(IOPTS.EQ.0)CALL IPL(4,X,Y)
- ENDIF
- IF(IOPTD.NE.0)GOTO 50
-*
-* Draw boundary of the box
-*
- 40 CALL ISFAIS(0)
- CALL IGSET('BORD',1.)
- CALL IGBOX(X1,X2,Y1,Y2)
-*
-* Restore the context
-*
- 50 CALL IGSET('BORD',FLOAT(IBORDS))
- CALL ISFACI(IFACIS)
- CALL ISFAIS(IFAISS)
- CALL ISFASI(IFASIS)
- ZFLAG = ZFSAV
- GLFLAG = (ZFLAG.OR.PFLAG.OR.MFLAG)
-*
- END
diff --git a/src/graflib/higz/ig/igphst.F b/src/graflib/higz/ig/igphst.F
deleted file mode 100644
index ea37a7b..0000000
--- a/src/graflib/higz/ig/igphst.F
+++ /dev/null
@@ -1,77 +0,0 @@
-*
-* $Id: igphst.F,v 1.1.1.1 1996/02/14 13:10:37 mclareni Exp $
-*
-* $Log: igphst.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:37 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.14/00 20/02/92 17.03.21 by O.Couet
-*-- Author : G.Richards
- SUBROUTINE IGPHST(RMIN,RMAX,THETA,PHI,UP,CHOPT)
-********************************************************************
-* Initalises (start) PHIGS and sets the structure id
-* sphere_id - structure id
-* NEW - to delelte or not to delete
-********************************************************************
-*
-#if defined(CERNLIB_PHIGS)
-#include "higz/hiatt.inc"
- CHARACTER*(*) CHOPT
- REAL RMIN(3),RMAX(3)
- PARAMETER (PI=3.14159)
- INTEGER NSNO
- REAL V(4,4)
- COMMON /NAMESET/ NSNO
-*.______________________________________
-*
- IF (IDIM.EQ.3) THEN
- RTHETA=THETA/180.*PI
- RPHI=PHI/180.*PI
- RUP=UP/180.*PI
- IF (CHOPT.NE.'S') THEN
- CALL IGPARF(12,'D')
- CALL POPST (101)
- CALL PADS (1,1)
- CALL PSVWI (1)
- CALL PLB (0)
- CALL PSIS (1)
-* Set label to locate the transformation matrix
- CALL PLB (1)
-* Set global matrix transformation
- SLX=(RMAX(1)-RMIN(1))
- SLY=(RMAX(2)-RMIN(2))
- SLZ=(RMAX(3)-RMIN(3))
- SLTX=-RMIN(1)/SLX
- SLTY=-RMIN(2)/SLY
- SLTZ=-RMIN(3)/SLZ
- MIDX=0.0
- MIDY=0.0
- MIDZ=0.0
- CALL PBLTM3
- + (MIDX,MIDY,MIDZ,SLTX,SLTY,SLTZ,0.0,0.0,0.0,
- + 1/SLX,1/SLY,1/SLZ,IERR,V)
- CALL PSLMT3(V,0)
-* Set default attributes
- CALL PSMKSC(.5)
- CALL PSMK(1)
- CALL PSPLCI(1)
-* Set annotation text attributes
- CALL PSTXFN(-3)
- CALL PSTXCI(1)
- CALL PSATCH(.009)
- CALL PSCHXP(1.)
- CALL PSATCU(0.,1.)
- CALL PSATP(0)
-* Set edge attributes
- CALL PLB (2)
- CALL PSEDFG (PON)
- CALL PCLST
- NSNO=3
- ELSE
- CALL IGPARF(12,'R')
- ENDIF
- ENDIF
-#endif
- END
diff --git a/src/graflib/higz/ig/igpick.F b/src/graflib/higz/ig/igpick.F
deleted file mode 100644
index 307d4ff..0000000
--- a/src/graflib/higz/ig/igpick.F
+++ /dev/null
@@ -1,467 +0,0 @@
-*
-* $Id: igpick.F,v 1.1.1.1 1996/02/14 13:10:37 mclareni Exp $
-*
-* $Log: igpick.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:37 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.23/03 01/09/95 17.03.58 by O.Couet
-*-- Author : O.Couet 22/05/92
- SUBROUTINE IGPICK(NT,XLOC,YLOC,NBLEV,CHPID,IPID,CHOPT)
-*.===========>
-*.
-*. See the help in the HIGZ manual
-*.
-*..==========> (O.Couet)
-#include "higz/hipaw.inc"
-#include "higz/hicode.inc"
-#include "higz/hipick.inc"
- PARAMETER (PI=3.14159265,DEGRAD=PI/180.)
- CHARACTER*(*) CHOPT
- CHARACTER*(*) CHPID(*)
- CHARACTER*80 TX_STR
- DIMENSION TX_PX(4),TX_PY(4)
- DIMENSION IPID(*)
- LOGICAL LOPICK,LOLVL
-*.______________________________________
-*
- IF(LPICD.LE.0)THEN
- IF(LPICT.GT.0)THEN
- LPICD = LPICT
- LDNT0 = LHNT0
- LDI = LHI
- LDF = LHF
- LDC = LHC
- ELSE
- NBLEV = 0
- RETURN
- ENDIF
- ENDIF
-*
-* Compute in LNDECO the bank adress of NT
-*
- LN = LQ(LPICD-1)
- LNDECO = 0
- DO 111 I=1,IQ(LPICD+8)
- IF(LN.EQ.0)GOTO 222
- IF(IQ(LN+1).EQ.NT)THEN
- LNDECO = LN
- GOTO 222
- ENDIF
- LN=LQ(LN)
- 111 CONTINUE
- RETURN
- 222 CONTINUE
-*
- LIDECO = LDI
- LFDECO = LDF
- LCDECO = LDC
-*
- IAW = IQ(LNDECO+2)
- DX = (Q(LFDECO+IAW+1)-Q(LFDECO+IAW))/200.
- DY = (Q(LFDECO+IAW+3)-Q(LFDECO+IAW+2))/200.
-*
- IREPTR = IQ(LNDECO+4)
- NBLEV = 0
- ICLEV = 999
- LOPICK = .FALSE.
- LOLVL = .FALSE.
- CHLVL = ' '
- IPILVL = 0
-*
-* IQUEST(60) --> Adress
-* IQUEST(61) --> Type
-*
- IQUEST(60) = 0
- IQUEST(61) = 0
-*
-* Scan the LNDECO bank
-*
- 1 IREPTR=IREPTR-1
- IF(IREPTR.EQ.9)RETURN
- IADRI=MOD(IQ(LNDECO+IREPTR),1000000)
-*
- GOTO (1,1,30,40,1
- +, 60,70,80,90,100,110,120,130,140,150,160,170,180,1
- +, 200,210,220,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1
- +, 1,1,1
- +, 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1
- +, 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1
- + ),INT(IQ(LNDECO+IREPTR)/1000000)
-*
-* Primitive ID with NAME
-*
- 30 IF(.NOT.LOPICK)GOTO 1
- IF(IQ(LIDECO+IADRI).GE.ICLEV)GOTO 1
- ICLEV = IQ(LIDECO+IADRI)
- IF(ICLEV.GT.NBLEV)NBLEV=ICLEV
- IPID(ICLEV) = IQ(LIDECO+IADRI+1)
- CALL UHTOC(IQ(LCDECO+IQ(LIDECO+IADRI+2)),4,CHLVL2,LEVLEN)
- CHPID(ICLEV) = CHLVL2(1:LEN(CHPID(ICLEV)))
- IF(ICLEV.EQ.1)THEN
- IF(LOLVL)THEN
- NBLEV = NBLEV+1
- IPID(NBLEV) = IPILVL
- CHPID(NBLEV) = CHLVL(1:LEN(CHPID(NBLEV)))
- ENDIF
- RETURN
- ENDIF
- GOTO 1
-*
-* Primitive ID without NAME
-*
- 40 IF(.NOT.LOPICK)GOTO 1
- IF(IQ(LIDECO+IADRI).GE.ICLEV)GOTO 1
- ICLEV = IQ(LIDECO+IADRI)
- IF(ICLEV.GT.NBLEV)NBLEV=ICLEV
- IPID(ICLEV) = IQ(LIDECO+IADRI+1)
- IF(ICLEV.EQ.1)THEN
- IF(LOLVL)THEN
- NBLEV = NBLEV+1
- IPID(NBLEV) = IPILVL
- CHPID(NBLEV) = CHLVL(1:LEN(CHPID(NBLEV)))
- ENDIF
- RETURN
- ENDIF
- GOTO 1
-*
-* Histograms
-*
- 60 IF(LOPICK)GOTO 1
- IADRF = IQ(LIDECO+IADRI)
- NBINS = IQ(LIDECO+IADRI+1)
- ICHOPT = IQ(LIDECO+IADRI+2)
-*
-* Non equidistant bins
-*
- IF(JBIT(ICHOPT,8).NE.0)THEN
- ELSE
-*
-* Equidistant bins
-*
- X1 = Q(LFDECO+IADRF)
- X2 = Q(LFDECO+IADRF+1)
- XLOCH = XLOC
- YLOCH = YLOC
- IF(JBIT(ICHOPT,12).NE.0)THEN
- IF(JBIT(ICHOPT,13).NE.0)XLOCH = 10**XLOC
- IF(JBIT(ICHOPT,14).NE.0)YLOCH = 10**YLOC
- ENDIF
- IF(XLOCH.GE.X1.AND.XLOCH.LE.X2)THEN
- N = NBINS*((XLOCH-X1)/(X2-X1))
- IF(YLOCH.LE.Q(LFDECO+IADRF+2+N))THEN
- LOLVL = .TRUE.
- IPILVL = N+1
- CHLVL = 'BIN'
- GOTO 500
- ENDIF
- ENDIF
- ENDIF
- GOTO 1
-*
-* Polymarker with one point
-*
- 70 IF(LOPICK)GOTO 1
- GOTO 1
-*
-* Polyline with two points
-*
- 80 IF(LOPICK)GOTO 1
- IP = IGPKPL(XLOC,YLOC,2,Q(LFDECO+IADRI),Q(LFDECO+IADRI+2),DX,DY)
- IF(IP.NE.0)GOTO 500
- GOTO 1
-*
-* Polyline
-*
- 90 IF(LOPICK)GOTO 1
- IADRF = IQ(LIDECO+IADRI)
- N = IQ(LIDECO+IADRI+1)
- IP = IGPKPL(XLOC,YLOC,N,Q(LFDECO+IADRF),Q(LFDECO+IADRF+N),DX,DY)
- IF(IP.NE.0)GOTO 500
- GOTO 1
-*
-* Polymarker
-*
- 100 IF(LOPICK)GOTO 1
- IADRF = IQ(LIDECO+IADRI)
- N = IQ(LIDECO+IADRI+1)
- IP = IGPKPM(XLOC,YLOC,N,Q(LFDECO+IADRF),Q(LFDECO+IADRF+N),DX,DY)
- IF(IP.NE.0)THEN
- IF(INT(IQ(LNDECO+IREPTR+1)/1000000).EQ.IMIDCO)THEN
- IADRID=MOD(IQ(LNDECO+IREPTR+1),1000000)
- ICLEV = IQ(LIDECO+IADRID)
- IF(ICLEV.GT.NBLEV)NBLEV=ICLEV
- IPID(ICLEV) = IQ(LIDECO+IADRID+IP)
- CHPID(ICLEV)='POINT'
- ENDIF
- GOTO 500
- ENDIF
- GOTO 1
-*
-* Fill area
-*
- 110 IF(LOPICK)GOTO 1
- IADRF = IQ(LIDECO+IADRI)
- N = IQ(LIDECO+IADRI+1)
- IP = IGPKFA(XLOC,YLOC,N,Q(LFDECO+IADRF),Q(LFDECO+IADRF+N))
- IF(IP.NE.0)GOTO 500
- GOTO 1
-*
-* Text (ITX)
-*
- 120 IF(LOPICK)GOTO 1
- ITAIND = 0
- TX_HGT = -99999.
- ITX_AL = -99999
- TX_WD = 0.
- 121 ITAIND = ITAIND + 1
- IF(ITAIND.EQ.9)THEN
-* Could not locate all the text attributes !
- GOTO 1
- ENDIF
-
- IF( (INT(IQ(LNDECO+IREPTR-ITAIND)/1000000).EQ.ICHHCO)
- + .AND.(TX_HGT.EQ.-99999.))
- + TX_HGT = Q(LFDECO+ MOD(IQ(LNDECO+IREPTR-ITAIND),1000000))
-
- IF( (INT(IQ(LNDECO+IREPTR-ITAIND)/1000000).EQ.ITXACO)
- + .AND.(ITX_AL.EQ.-99999))
- + ITX_AL = MOD(IQ(LNDECO+IREPTR-ITAIND),100000)
-
- IF((ITX_AL.EQ.-99999).OR.(TX_HGT.EQ.-99999.))GOTO 121
- IADRC = IQ(LIDECO+IADRI+1)
- ITX_CN = IQ(LIDECO+IADRI+2)
- CALL UHTOC(IQ(LCDECO+IADRC),4,TX_STR,ITX_CN)
- TX_STR = TX_STR(1:ITX_CN)
- TX_WD = ITX_CN * TX_HGT
- XPOS = Q(LFDECO+IQ(LIDECO+IADRI))
- YPOS = Q(LFDECO+IQ(LIDECO+IADRI)+1)
-
- IF(ITX_AL.LT.20)XMIN = XPOS
- IF((ITX_AL.GE.20).AND.(ITX_AL.LT.30))XMIN = XPOS - (TX_WD/2.)
- IF(ITX_AL.GE.30)XMIN = XPOS - TX_WD
- ITX_AL = MOD(ITX_AL,10)
- IF(ITX_AL.EQ.0)YMIN = YPOS
- IF((ITX_AL.EQ.1).OR.(ITX_AL.EQ.2))YMIN = YPOS - TX_HGT
- IF(ITX_AL.EQ.3)YMIN = YPOS - (TX_HGT/2.)
- XMAX = XMIN + TX_WD
- YMAX = YMIN + TX_HGT
- I = IREPTR
- 122 I = I - 1
- IF( (INT(IQ(LNDECO+I)/1000000).EQ.3).OR.(I.EQ.9))THEN
-* Could not find angle attribute for a text primitive!
- GOTO 1
- ENDIF
- IF(INT(IQ(LNDECO+I)/1000000).NE.IANGCO)GOTO 122
- I = MOD(IQ(LNDECO+I),1000000)
- TX_ANG = Q(LFDECO+I)
- TX_PX(1) = XMIN
- TX_PY(1) = YMIN
- TX_PX(2) = XMAX
- TX_PY(2) = YMIN
- TX_PX(3) = XMAX
- TX_PY(3) = YMAX
- TX_PX(4) = XMIN
- TX_PY(4) = YMAX
- DO 123 I = 1,4
- TX_PX(I) = (-XPOS) + TX_PX(I)
- TX_PY(I) = (-YPOS) + TX_PY(I)
- XTEMP = COS(DEGRAD*TX_ANG) * TX_PX(I) + (-SIN(DEGRAD*TX_ANG))
- + * TX_PY(I)
- YTEMP = SIN(DEGRAD*TX_ANG) * TX_PX(I) + COS(DEGRAD*TX_ANG) *
- + TX_PY(I)
- TX_PY(I) = YTEMP
- TX_PX(I) = XTEMP
- TX_PY(I) = TX_PY(I) + YPOS
- TX_PX(I) = TX_PX(I) + XPOS
- 123 CONTINUE
- IP = 0
- IP = IGPKFA(XLOC,YLOC,4,TX_PX(1),TX_PY(1))
- IF(IP.NE.0)THEN
- RQUEST(70) = TX_PX(1)
- RQUEST(71) = TX_PX(2)
- RQUEST(72) = TX_PX(3)
- RQUEST(73) = TX_PX(4)
- RQUEST(74) = TX_PY(1)
- RQUEST(75) = TX_PY(2)
- RQUEST(76) = TX_PY(3)
- RQUEST(77) = TX_PY(4)
- GOTO 500
- ENDIF
- GOTO 1
-*
-* Boxe
-*
- 130 IF(LOPICK)GOTO 1
- IF(XLOC.GE.Q(LFDECO+IADRI) .AND.
- + XLOC.LE.Q(LFDECO+IADRI+1).AND.
- + YLOC.GE.Q(LFDECO+IADRI+2).AND.
- + YLOC.LE.Q(LFDECO+IADRI+3))GOTO 500
- GOTO 1
-*
-* Frame box
-*
- 140 IF(LOPICK)GOTO 1
- IF( ((XLOC.GE.Q(LFDECO+IADRI)) .AND.
- + (XLOC.LE.Q(LFDECO+IADRI+1)) .AND.
- + (YLOC.GE.Q(LFDECO+IADRI+2)) .AND.
- + (YLOC.LE.Q(LFDECO+IADRI+3))) .AND.
-
- + ((XLOC.LE.Q(LFDECO+IADRI+4)) .OR.
- + (XLOC.GE.Q(LFDECO+IADRI+5)) .OR.
- + (YLOC.LE.Q(LFDECO+IADRI+6)) .OR.
- + (YLOC.GE.Q(LFDECO+IADRI+7))) ) GOTO 500
- GOTO 1
-*
-* Arc
-*
- 150 IF(LOPICK)GOTO 1
- SCALX = XLOC - Q(LFDECO+IADRI)
- SCALY = YLOC - Q(LFDECO+IADRI+1)
- PMAG = SQRT(SCALX**2 + SCALY**2)
- ANGLOC = ACOS( SCALX / PMAG)
- ANGLOC = (180.0/PI)*ANGLOC
- IF(SCALY.LT.0.0)ANGLOC = 360. - ANGLOC
-
- IF((Q(LFDECO+IADRI+2).EQ.Q(LFDECO+IADRI+3)).AND.
- +(ABS(PMAG-Q(LFDECO+IADRI+2)).LT. 0.05))
- +PMAG = Q(LFDECO+IADRI+2)
-
- IF(((PMAG.GE.Q(LFDECO+IADRI+2)).AND.
- + (PMAG.LE.Q(LFDECO+IADRI+3))).OR.
- + ((PMAG.LE.Q(LFDECO+IADRI+2)).AND.
- + (PMAG.GE.Q(LFDECO+IADRI+3))))THEN
- PHMIN = Q(LFDECO+IADRI+4)
- PHMAX = Q(LFDECO+IADRI+5)
- IF(PHMAX.GT.PHMIN)THEN
- IF( (ANGLOC.GE.PHMIN).AND.(ANGLOC.LE.PHMAX))GOTO 500
- ELSE
- IF(((ANGLOC.GE.0.).AND.(ANGLOC.LE.PHMAX)).OR.
- + ((ANGLOC.LE.360.).AND.(ANGLOC.GT.PHMIN)))GOTO 500
- ENDIF
- ENDIF
- GOTO 1
-*
-* Axis
-*
- 160 IF(LOPICK)GOTO 1
- IADRF=IQ(LIDECO+IADRI)
- IP=IGPKPL(XLOC,YLOC,2,Q(LFDECO+IADRF),Q(LFDECO+IADRF+2)
- +, 1.5*DX,1.5*DY)
- IF(IP.NE.0)GOTO 500
- GOTO 1
-*
-* Software characters
-*
- 170 IF(LOPICK)GOTO 1
- IADRF=IQ(LIDECO+IADRI)
- IADRC = IQ(LIDECO+IADRI+1)
- ITX_CN = IQ(LIDECO+IADRI+2)
- CALL UHTOC(IQ(LCDECO+IADRC),4,TX_STR,ITX_CN)
- TX_STR = TX_STR(1:ITX_CN)
- TX_HGT = Q(LFDECO+IADRF+2)
- TX_ANG = Q(LFDECO+IADRF+3)
- CALL IGTEXT(0.,0.,TX_STR,TX_HGT,TX_WD,'S')
- IGTOP = 1
- DO 171 I=1,3
- IF(JBIT(IQ(LIDECO+IADRI+3),I).NE.0)
- + IGTOP = I
- 171 CONTINUE
-
- IF(IGTOP.EQ.1)THEN
- ALOFF = 0.
- ELSEIF(IGTOP.EQ.2)THEN
- ALOFF = TX_WD / 2.
- ELSE
- ALOFF = TX_WD
- ENDIF
- XPOS = Q(LFDECO+IADRF)
- YPOS = Q(LFDECO+IADRF+1)
- TX_PY(1) = Q(LFDECO+IADRF+1)
- TX_PY(2) = Q(LFDECO+IADRF+1)
- TX_PY(3) = Q(LFDECO+IADRF+1)+TX_HGT
- TX_PY(4) = Q(LFDECO+IADRF+1)+TX_HGT
- TX_PX(1) = Q(LFDECO+IADRF) - ALOFF
- TX_PX(2) = Q(LFDECO+IADRF) + TX_WD - ALOFF
- TX_PX(3) = Q(LFDECO+IADRF) + TX_WD - ALOFF
- TX_PX(4) = Q(LFDECO+IADRF) - ALOFF
-*
- DO 172 I = 1,4
- TX_PX(I) = (-XPOS) + TX_PX(I)
- TX_PY(I) = (-YPOS) + TX_PY(I)
- XTEMP = COS(DEGRAD*TX_ANG) * TX_PX(I) + (-SIN(DEGRAD*TX_ANG))
- + * TX_PY(I)
- YTEMP = SIN(DEGRAD*TX_ANG) * TX_PX(I) + COS(DEGRAD*TX_ANG) *
- + TX_PY(I)
- TX_PY(I) = YTEMP
- TX_PX(I) = XTEMP
- TX_PY(I) = TX_PY(I) + YPOS
- TX_PX(I) = TX_PX(I) + XPOS
- 172 CONTINUE
- IP = 0
- IP = IGPKFA(XLOC,YLOC,4,TX_PX(1),TX_PY(1))
- IF(IP.NE.0)THEN
- RQUEST(70) = TX_PX(1)
- RQUEST(71) = TX_PX(2)
- RQUEST(72) = TX_PX(3)
- RQUEST(73) = TX_PX(4)
- RQUEST(74) = TX_PY(1)
- RQUEST(75) = TX_PY(2)
- RQUEST(76) = TX_PY(3)
- RQUEST(77) = TX_PY(4)
- GOTO 500
- ENDIF
- GOTO 1
-*
-* Multiline
-*
- 180 IF(LOPICK)GOTO 1
- GOTO 1
-*
-* Table
-*
- 200 IF(LOPICK)GOTO 1
- IF(XLOC.GE.Q(LFDECO+IAW) .AND.
- + XLOC.LE.Q(LFDECO+IAW+1).AND.
- + YLOC.GE.Q(LFDECO+IAW+2).AND.
- + YLOC.LE.Q(LFDECO+IAW+3))GOTO 500
- GOTO 1
-*
-* Graph
-*
- 210 IF(LOPICK)GOTO 1
- IADRF = IQ(LIDECO+IADRI)
- N = IQ(LIDECO+IADRI+1)
- ICHOPT = IQ(LIDECO+IADRI+2)
- IF(JBIT(ICHOPT,12).NE.0)THEN
- IP = IGPKFA(XLOC,YLOC,N,Q(LFDECO+IADRF),Q(LFDECO+IADRF+N))
- ELSE
- IP = IGPKPL(XLOC,YLOC,N,Q(LFDECO+IADRF),Q(LFDECO+IADRF+N)
- +, DX,DY)
- ENDIF
- IF(IP.NE.0)GOTO 500
- GOTO 1
-*
-* Pave
-*
- 220 IF(LOPICK)GOTO 1
- IADRF = IQ(LIDECO+IADRI)
- IF(XLOC.GE.Q(LFDECO+IADRF) .AND.
- + XLOC.LE.Q(LFDECO+IADRF+1).AND.
- + YLOC.GE.Q(LFDECO+IADRF+2).AND.
- + YLOC.LE.Q(LFDECO+IADRF+3))GOTO 500
- GOTO 1
-*
- 500 LOPICK = .TRUE.
- IQUEST(60) = IREPTR
- IQUEST(61) = INT(IQ(LNDECO+IREPTR)/1000000)
- IQUEST(62) = IADRI
- IQUEST(63) = IADRF
- IQUEST(64) = NBLEV
- RQUEST(80) = XLOC
- RQUEST(81) = YLOC
- GOTO 1
-*
- END
diff --git a/src/graflib/higz/ig/igpid.F b/src/graflib/higz/ig/igpid.F
deleted file mode 100644
index 3dcdda1..0000000
--- a/src/graflib/higz/ig/igpid.F
+++ /dev/null
@@ -1,85 +0,0 @@
-*
-* $Id: igpid.F,v 1.1.1.1 1996/02/14 13:10:37 mclareni Exp $
-*
-* $Log: igpid.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:37 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.16/06 29/10/92 14.01.00 by O.Couet
-*-- Author : O.Couet 21/05/92
- SUBROUTINE IGPID(ILEVI,CHPID,IPID,CHOPT)
-*.===========>
-*.
-*. This routine allows to put primitives identifiers
-*. in the HIGZ data structure.
-*.
-*. _Input parameters:
-*.
-*. INTEGER ILEVI : Level number
-*. CHARACTER CHPID : Primitives name
-*. INTEGER IPID : Primitives identifier
-*. CHARACTER CHOPT : Option
-*. CHOPT=' ' the level becomes LEVEL
-*. CHOPT='U' one level Up
-*. CHOPT='D' one level Down
-*. CHOPT='S' Same level
-*.
-*..==========> (O.Couet)
-#if defined(CERNLIB_ZEBRA)
-#include "higz/hipaw.inc"
-#endif
-#if defined(CERNLIB_ZEBRA)
-#include "higz/hicode.inc"
-#endif
-#if defined(CERNLIB_ZEBRA)
-#include "higz/hiflag.inc"
-#endif
-#if defined(CERNLIB_ZEBRA)
-#include "higz/hipick.inc"
-#endif
-#if defined(CERNLIB_ZEBRA)
- CHARACTER*(*) CHPID,CHOPT
- DIMENSION IOPT(3)
- EQUIVALENCE (IOPTU,IOPT(1)),(IOPTD,IOPT(2))
- EQUIVALENCE (IOPTS,IOPT(3))
-*.______________________________________
-*
- IF(.NOT.ZFLAG)RETURN
- CALL UOPTC(CHOPT,'UDS',IOPT)
-*
- ILEV = ILEVI
- IF(IOPTU.NE.0)ILEV = INBLEV-1
- IF(IOPTD.NE.0)ILEV = INBLEV+1
- IF(IOPTS.NE.0)ILEV = INBLEV
-*
- IF(LPICT.LT.0)RETURN
- IF(ILEV.GT.INBLEV+1)THEN
- CALL IGERR('Invalid level number','IGPID')
- RETURN
- ENDIF
- INBLEV = ILEV
- IQ(LHNT+5) = INBLEV
- ILEN = MIN(LENOCC(CHPID),LEVLEN)
- IF(ILEN.GT.0)THEN
- IF(IZPUSH(3,0,LEVLEN/2,'IGPID').NE.0)RETURN
- CALL IZSTCC(IPICO1,INTPTR)
- IQ(LHI+INTPTR) = ILEV
- IQ(LHI+INTPTR+1) = IPID
- IQ(LHI+INTPTR+2) = ISTPTR
- CALL IZINCI(3)
- CHLVL = ' '
- CHLVL(1:ILEN) = CHPID(1:ILEN)
- CALL UCTOH(CHLVL,IQ(LHC+ISTPTR),4,LEVLEN)
- CALL IZINCS(LEVLEN/2)
- ELSE
- IF(IZPUSH(2,0,0,'IGPID').NE.0)RETURN
- CALL IZSTCC(IPICO2,INTPTR)
- IQ(LHI+INTPTR) = ILEV
- IQ(LHI+INTPTR+1) = IPID
- CALL IZINCI(2)
- ENDIF
-#endif
-*
- END
diff --git a/src/graflib/higz/ig/igpie.F b/src/graflib/higz/ig/igpie.F
deleted file mode 100644
index c2fa92d..0000000
--- a/src/graflib/higz/ig/igpie.F
+++ /dev/null
@@ -1,151 +0,0 @@
-*
-* $Id: igpie.F,v 1.2 2001/05/31 07:33:59 couet Exp $
-*
-* $Log: igpie.F,v $
-* Revision 1.2 2001/05/31 07:33:59 couet
-* - The variable TXT was too small (12). Now it is 32.
-*
-* Revision 1.1.1.1 1996/02/14 13:10:37 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.12/14 25/06/91 14.32.31 by O.Couet
-*-- Author :
- SUBROUTINE IGPIE(X,Y,R,N,V,CHOPT,IAO,IAS,IAC)
-*.===========>
-*.
-*. To draw a PIE chart
-*.
-*..==========> (R.Nierhaus)
-#include "higz/hiatt.inc"
-#include "higz/hilabs.inc"
- DIMENSION V(1),IAO(1),IAS(1),IAC(1)
- CHARACTER*(*) CHOPT
- CHARACTER*12 TEXT
- CHARACTER*32 TXT
- DIMENSION PHI(51),JAS(50),IOPT(8)
- INTEGER SI
- EQUIVALENCE (IOPTO,IOPT(1)),(IOPTS,IOPT(2))
- EQUIVALENCE (IOPTC,IOPT(3)),(IOPTN,IOPT(4))
- EQUIVALENCE (IOPTP,IOPT(5)),(IOPTL,IOPT(6))
- EQUIVALENCE (IOPTH,IOPT(7)),(IOPTR,IOPT(8))
- DATA JAS/111,222,333,444,433,233,211,388,
- + 390,215,225,235,245,265,275,35*550/
-*.______________________________________
-*
- IF (N.LT.2.OR.N.GT.50) THEN
- CALL IGERR('Wrong number of values','IGPIE')
- RETURN
- ENDIF
- CALL UOPTC(CHOPT,'OSCNPLHR',IOPT)
- IF(IOPTS.EQ.0.AND.IOPTC.EQ.0)IOPTS=2
- IF(IOPTP.NE.0)IOPTN=0
- IF(IOPTL.NE.0)THEN
- IF(NHILAB.LT.N)THEN
- CALL IGERR('Not enough labels defined','IGPIE')
- IOPTL=0
- ENDIF
- IOPTN=0
- IOPTP=0
- ENDIF
- S=0.
- DO 10 I=1,N
- S=S+V(I)
- 10 CONTINUE
- F=2.*3.14159/S
- PHI(1)=0.
- DO 70 I=1,N
- PHI(I+1)=PHI(I)+F*V(I)
- PHI1=.5*(PHI(I)+PHI(I+1))
- IF (IOPTS.EQ.1) THEN
- JIABS=IABS(IAS(I))
- IS=JIABS/1000-1
- SI=MOD(JIABS,1000)
- IF(IAS(I).LT.0)SI=-SI
- IF (IS.LT.0) THEN
- CALL ISFAIS(3)
- ELSE
- CALL ISFAIS(IS)
- ENDIF
- IF(SI.NE.0)CALL ISFASI(SI)
- ELSEIF(IOPTS.EQ.2)THEN
- CALL ISFAIS(3)
- CALL ISFASI(JAS(I))
- ENDIF
- IF (IOPTC.NE.0) THEN
- CALL ISFACI(IAC(I))
- ENDIF
- IF (IOPTO.NE.0) THEN
- IF (IAO(I).EQ.0) THEN
- ALPHA=(180./3.14159)*PHI(I)
- BETA =(180./3.14159)*PHI(I+1)
- CALL IGARC(X,Y,0.,R,ALPHA,BETA)
- ELSE
- XX=X+.01*FLOAT(IAO(I))*R*COS(PHI1)
- YY=Y+.01*FLOAT(IAO(I))*R*SIN(PHI1)
- ALPHA=(180./3.14159)*PHI(I)
- BETA =(180./3.14159)*PHI(I+1)
- CALL IGARC(XX,YY,0.,R,ALPHA,BETA)
- ENDIF
- ELSE
- ALPHA=(180./3.14159)*PHI(I)
- BETA =(180./3.14159)*PHI(I+1)
- CALL IGARC(X,Y,0.,R,ALPHA,BETA)
- ENDIF
-*
- RR=R
- IF (IOPTO.NE.0) RR=R*(1.+.01*FLOAT(IAO(I)))
- IF(IOPTN.NE.0)THEN
- VAL=V(I)
- WRITE(TEXT,'(G12.6)')VAL
- ELSEIF(IOPTP.NE.0)THEN
- VAL=100.*V(I)/S+.0000001
- WRITE(TEXT,'(F5.1)')VAL
- ELSEIF(IOPTL.NE.0)THEN
- TXT=HILABS(I)
- GO TO 60
- ELSE
- GO TO 70
- ENDIF
- DO 20 J=1,12
- IF(TEXT(J:J).NE.' ')THEN
- I1=J
- GO TO 30
- ENDIF
- 20 CONTINUE
- I1=12
- 30 CONTINUE
- DO 40 J=12,I1,-1
- IF(TEXT(J:J).EQ.' '.OR.TEXT(J:J).EQ.'0')GO TO 40
- I2=J
- IF(TEXT(J:J).EQ.'.')I2=I2-1
- GO TO 50
- 40 CONTINUE
- 50 CONTINUE
- IF(I2.LT.I1)I2=I1
- TXT=TEXT(I1:I2)
- 60 IF(IOPTH.NE.0)THEN
- H=RCHH
- ELSE
- H=R/15.
- IF(N.GT.10)H=H/2.
- ENDIF
- TS=0.
- CALL IGTEXT(0.,0.,TXT,H,TS,'S')
- IF(IOPTR.NE.0)THEN
- CALL IGSET('TANG',(ALPHA+BETA)/2.)
- CALL IGSET('TXAL',3.)
- XX=X+COS(PHI1)*(1.05*RR+0.5*H)
- YY=Y+SIN(PHI1)*(1.05*RR+0.5*H)
- ELSE
- CALL IGSET('TANG',0.)
- CALL IGSET('TXAL',20.)
- XX=X+COS(PHI1)*(1.05*RR+0.5*TS)
- YY=Y+SIN(PHI1)*(1.05*RR+0.5*H) -0.5*H
- ENDIF
- CALL IGSET('CHHE',H)
- CALL ITX(XX,YY,TXT)
- 70 CONTINUE
-*
- END
diff --git a/src/graflib/higz/ig/igpkfa.F b/src/graflib/higz/ig/igpkfa.F
deleted file mode 100644
index 18a070f..0000000
--- a/src/graflib/higz/ig/igpkfa.F
+++ /dev/null
@@ -1,122 +0,0 @@
-*
-* $Id: igpkfa.F,v 1.1.1.1 1996/02/14 13:10:37 mclareni Exp $
-*
-* $Log: igpkfa.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:37 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.14/09 25/05/92 10.38.31 by O.Couet
-*-- Author : O.Couet
- FUNCTION IGPKFA(XCUR,YCUR,N,XP,YP)
-*.===========>
-*.
-*. This function decides if a given fill area is picked or not .
-*. If picked IGPKFA=1
-*. If not picked IGPKFA=0
-*.
-*. _Input parameters:
-*.
-*. REAL XCUR : X coordinate of the cursor
-*. REAL YCUR : Y coordinate of the cursor
-*. INTEGER N : Number of point in the fill area
-*. REAL XP(N) YP(N) : Fill area coordinates
-*.
-*..==========> (O.Couet)
-#include "higz/higraf.inc"
- DIMENSION XP(*),YP(*)
-*.______________________________________
-*
- IGPKFA=0
- NBI=0
-*
- DO 10 I=2,N+1
- I2=I
- I1=I-1
- IF(I.EQ.N+1)I2=1
-*
-* Line segment parallel to oy
-*
- IF(XP(I1).EQ.XP(I2))THEN
- IF(YP(I1).LT.YP(I2))THEN
- YI=YP(I1)
- YIP=YP(I2)
- ELSE
- YI=YP(I2)
- YIP=YP(I1)
- ENDIF
- IF((YI.LT.YCUR).AND.(YCUR.LT.YIP))THEN
- NBI=NBI+1
- IF(NBI.GT.NPMAX)GOTO 70
- XGRAF(NBI)=XP(I1)
- ENDIF
- GOTO 10
- ENDIF
-*
-* Line segment parallel to ox
-*
- IF(YP(I1).EQ.YP(I2))THEN
- IF(YP(I1).EQ.YCUR)THEN
- NBI=NBI+1
- IF(NBI.GT.NPMAX)GOTO 70
- XGRAF(NBI)=XP(I1)
- NBI=NBI+1
- IF(NBI.GT.NPMAX)GOTO 70
- XGRAF(NBI)=XP(I2)
- ENDIF
- GOTO 10
- ENDIF
-*
-* Other line segment
-*
- A=(YP(I1)-YP(I2))/(XP(I1)-XP(I2))
- B=(YP(I2)*XP(I1)-XP(I2)*YP(I1))/(XP(I1)-XP(I2))
- IF(XP(I1).LT.XP(I2))THEN
- XI=XP(I1)
- XIP=XP(I2)
- ELSE
- XI=XP(I2)
- XIP=XP(I1)
- ENDIF
- XIN=(YCUR-B)/A
- IF((XI.LT.XIN).AND.(XIN.LT.XIP))THEN
- NBI=NBI+1
- IF(NBI.GT.NPMAX)GOTO 70
- XGRAF(NBI)=XIN
- ENDIF
- 10 CONTINUE
-*
-* Sorting of the x coordinates intersections
-*
- INV=0
- M=NBI-1
- 20 CONTINUE
- DO 30 I=1,M
- IF(XGRAF(I+1).LT.XGRAF(I))THEN
- INV=INV+1
- RLL=XGRAF(I)
- XGRAF(I)=XGRAF(I+1)
- XGRAF(I+1)=RLL
- ENDIF
- 30 CONTINUE
- M=M-1
- IF(INV.EQ.0)GOTO 40
- INV=0
- GOTO 20
-*
-* Place of the x cursor coordinates
-*
- 40 NB=0
- DO 50 I=1,NBI
- IF(XCUR.LT.XGRAF(I))GOTO 60
- NB=NB+1
- 50 CONTINUE
- 60 IF(MOD(NB,2).NE.0)THEN
- IGPKFA=1
- ENDIF
- GOTO 999
-*
- 70 CALL IGERR('Too many points','IGPKFA')
-*
- 999 END
diff --git a/src/graflib/higz/ig/igpkpl.F b/src/graflib/higz/ig/igpkpl.F
deleted file mode 100644
index b749437..0000000
--- a/src/graflib/higz/ig/igpkpl.F
+++ /dev/null
@@ -1,114 +0,0 @@
-*
-* $Id: igpkpl.F,v 1.1.1.1 1996/02/14 13:10:37 mclareni Exp $
-*
-* $Log: igpkpl.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:37 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.14/09 26/05/92 13.57.05 by O.Couet
-*-- Author : O.Couet
- FUNCTION IGPKPL (XCUR,YCUR,N,XP,YP,DX,DY)
-*.===========>
-*.
-*. This routine decides if a given polyline is picked or not .
-*. If picked IGPKPL=1
-*. If not picked IGPKPL=0
-*.
-*. _Input parameters:
-*.
-*. REAL XCUR : X coordinate of the cursor
-*. REAL YCUR : Y coordinate of the cursor
-*. INTEGER N : Number of point in the polyline
-*. REAL XP(N) YP(N) : Polyline coordinates
-*. REAL DX DY : Picking box. If a point is inside
-*. this box, it is picked
-*.
-*..==========> (O.Couet)
- DIMENSION XP(*),YP(*)
-*.______________________________________
-*
- NM=N-1
- IGPKPL=0
- BM=YCUR-DY
- BP=YCUR+DY
- AM=XCUR-DX
- AP=XCUR+DX
- DO 10 I=1,NM
- I1=I
- I2=I+1
-*
-* Line segment parallel to oy
-*
- IF(XP(I1).EQ.XP(I2))THEN
- IF((AM.LE.XP(I1)).AND.(XP(I2).LE.AP))THEN
- IF(YP(I1).LE.YP(I2))THEN
- YI=YP(I1)
- YIP=YP(I2)
- ELSE
- YI=YP(I2)
- YIP=YP(I1)
- ENDIF
- IF((YI.LE.YCUR).AND.(YCUR.LE.YIP))THEN
- IGPKPL=1
- RETURN
- ENDIF
- ENDIF
- GOTO 10
- ENDIF
-*
-* Line segment paralel to ox
-*
- IF(YP(I1).EQ.YP(I2))THEN
- IF((BM.LE.YP(I1)).AND.(YP(I1).LE.BP))THEN
- IF(XP(I1).LE.XP(I2))THEN
- XI=XP(I1)
- XIP=XP(I2)
- ELSE
- XI=XP(I2)
- XIP=XP(I1)
- ENDIF
- IF((XI.LE.XCUR).AND.(XCUR.LE.XIP))THEN
- IGPKPL=1
- RETURN
- ENDIF
- ENDIF
- GOTO 10
- ENDIF
-*
-* Other line segment
-*
- A=(YP(I1)-YP(I2))/(XP(I1)-XP(I2))
- B=(YP(I2)*XP(I1)-XP(I2)*YP(I1))/(XP(I1)-XP(I2))
- IF(XP(I1).LE.XP(I2))THEN
- XI=XP(I1)
- XIP=XP(I2)
- ELSE
- XI=XP(I2)
- XIP=XP(I1)
- ENDIF
- IF((XI.LE.XCUR).AND.(XCUR.LE.XIP))THEN
- AA=A*XCUR+B
- IF((BM.LE.AA).AND.(AA.LE.BP))THEN
- IGPKPL=1
- RETURN
- ENDIF
- ENDIF
- IF(YP(I1).LE.YP(I2))THEN
- YI=YP(I1)
- YIP=YP(I2)
- ELSE
- YI=YP(I2)
- YIP=YP(I1)
- ENDIF
- IF((YI.LE.YCUR).AND.(YCUR.LE.YIP))THEN
- BB=(YCUR-B)/A
- IF((AM.LE.BB).AND.(BB.LE.AP))THEN
- IGPKPL=1
- RETURN
- ENDIF
- ENDIF
- 10 CONTINUE
-*
- END
diff --git a/src/graflib/higz/ig/igpkpm.F b/src/graflib/higz/ig/igpkpm.F
deleted file mode 100644
index cb15c57..0000000
--- a/src/graflib/higz/ig/igpkpm.F
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: igpkpm.F,v 1.1.1.1 1996/02/14 13:10:37 mclareni Exp $
-*
-* $Log: igpkpm.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:37 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.14/09 25/05/92 17.43.32 by O.Couet
-*-- Author : O.Couet
- FUNCTION IGPKPM(XCUR,YCUR,N,XP,YP,DX,DY)
-*.===========>
-*.
-*. This function decides if a given polymarker is picked or not .
-*. If picked IGPKPM=The picked point adress
-*. If not picked IGPKPM=0
-*.
-*. _Input parameters:
-*.
-*. REAL XCUR : X coordinate of the cursor
-*. REAL YCUR : Y coordinate of the cursor
-*. INTEGER N : Number of point in the polymarker
-*. REAL XP(N) YP(N) : Polymarker coordinates
-*. REAL DX DY : Picking box. If a point is inside
-*. this box, it is picked
-*.
-*..==========> (O.Couet)
- DIMENSION XP(*),YP(*)
-*.______________________________________
-*
- IGPKPM=0
-*
- DO 10 I=1,N
- IF((ABS(XP(I)-XCUR).LE.DX).AND.(ABS(YP(I)-YCUR).LE.DY))THEN
- IGPKPM=I
- RETURN
- ENDIF
- 10 CONTINUE
-*
- END
diff --git a/src/graflib/higz/ig/igpm.F b/src/graflib/higz/ig/igpm.F
deleted file mode 100644
index 3aff338..0000000
--- a/src/graflib/higz/ig/igpm.F
+++ /dev/null
@@ -1,64 +0,0 @@
-*
-* $Id: igpm.F,v 1.1.1.1 1996/02/14 13:10:37 mclareni Exp $
-*
-* $Log: igpm.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:37 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.18/10 21/06/93 11.05.42 by O.Couet
-*-- Author :
- SUBROUTINE IGPM(N,X,Y,ITYPE)
-*.===========>
-*.
-*. This routines draws markers 20 to 31.
-*.
-*. _Input parameters:
-*.
-*. INTEGER N : Number of markers .
-*. REAL X(N) : Markers X coordinates .
-*. REAL Y(N) : Markers Y coordinates .
-*. INTEGER ITYPE : Markers type.
-*.
-*..==========> (O.Couet)
-#include "higz/hiatt.inc"
-#include "higz/hiflag.inc"
- DIMENSION X(*),Y(*)
- LOGICAL ZFSAV,PFSAV
- CHARACTER*3 CHARS(12)
- REAL MKSIZE
- DATA CHARS/'"0 ','"1 ','"2 ','"3 ','"<0','"<1','"<2','"<3',
- + '"C ','"4 ','"<4','"<*'/
-*.______________________________________
-*
- IF(ITYPE.LT.20.OR.ITYPE.GT.31)RETURN
- ZFSAV = ZFLAG
- ZFLAG = .FALSE.
- PFSAV = PFLAG
- IF(.NOT.TFLAG)PFLAG=.FALSE.
- GLFLAG = (ZFLAG.OR.PFLAG.OR.MFLAG)
- NTSAV = INTR
- IPS = INPASS
- INPASS = 1
- ITXCIS = ITXCI
- CALL ISTXCI(IPMCI)
- MKSIZE = RMKSC*0.009
- SF = MKSIZE/2.
- DO 10 I=1,N
- IF(X(I).GT.RWXMAX.OR.X(I).LT.RWXMIN.OR.
- + Y(I).GT.RWYMAX.OR.Y(I).LT.RWYMIN)GOTO 10
- XV = (((RVXMAX-RVXMIN)*(X(I)-RWXMIN))/(RWXMAX-RWXMIN))+RVXMIN
- YV = (((RVYMAX-RVYMIN)*(Y(I)-RWYMIN))/(RWYMAX-RWYMIN))+RVYMIN
- YV = YV-SF
- CALL ISELNT(0)
- CALL IGTEXT(XV,YV,CHARS(ITYPE-19),MKSIZE,0.,'C')
- CALL ISELNT(NTSAV)
- 10 CONTINUE
- CALL ISTXCI(ITXCIS)
- INPASS = IPS
- ZFLAG = ZFSAV
- PFLAG = PFSAV
- GLFLAG = (ZFLAG.OR.PFLAG.OR.MFLAG)
-*
- END
diff --git a/src/graflib/higz/ig/igpxmp.F b/src/graflib/higz/ig/igpxmp.F
deleted file mode 100644
index f7f400b..0000000
--- a/src/graflib/higz/ig/igpxmp.F
+++ /dev/null
@@ -1,57 +0,0 @@
-*
-* $Id: igpxmp.F,v 1.1.1.1 1996/02/14 13:10:37 mclareni Exp $
-*
-* $Log: igpxmp.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:37 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.21/01 25/04/94 21.28.56 by O.Couet
-*-- Author : O.Couet 05/02/92
- SUBROUTINE IGPXMP(IPX,IX,IY,CHOPT)
-*.==============>
-*.
-*. X11 Pixmap manipulation.
-*.
-*. _Input parameters:
-*.
-*. INTEGER IPX : Pixmap identifier (input or output see CHOPT).
-*. INTEGER IX,IY : Pixmap size or position (see CHOPT).
-*. CHARACTER CHOPT : Character option.
-*. CHOPT='O' Open pixmap. IPX is an output parameter
-*. IX is the width and IY the height.
-*. CHOPT='R' Remove pixmap. IPX is an input parameter.
-*. CHOPT='D' Display pixmap. (IX,IY) is the position
-*. where the pixpmap has to be displayed.
-*. IPX is an input parameter.
-*. CHOPT='C' Close the current opened pixmap.
-*. CHOPT='S' Save the region of the current window at
-*. the position (IX,IY) in preopen pixmap IPX.
-*. CHOPT='E' Erase (clear) the pixmap IPX.
-*. CHOPT='W' Write the pixmap IPX into the file 'higz.bm'.
-*. IX is the width and IY the height. IPX is an
-*. input parameter.
-*.
-*.============> (O.Couet)
-#if defined(CERNLIB_X11)
- DIMENSION IOPT(7)
- EQUIVALENCE (IOPTO,IOPT(1)),(IOPTR,IOPT(2))
- EQUIVALENCE (IOPTD,IOPT(3)),(IOPTC,IOPT(4))
- EQUIVALENCE (IOPTS,IOPT(5)),(IOPTE,IOPT(6))
- EQUIVALENCE (IOPTW,IOPT(7))
- CHARACTER*(*) CHOPT
-*.______________________________________
-*
- CALL UOPTC(CHOPT,'ORDCSEW',IOPT)
-*
- IF (IOPTO.NE.0) IPX=IXOPNPX(IX,IY)
- IF (IOPTC.NE.0) CALL IXCLPX
- IF (IOPTS.NE.0) CALL IXWIPX(IPX,IX,IY)
- IF (IOPTD.NE.0) CALL IXCPPX(IPX,IX,IY)
- IF (IOPTR.NE.0) CALL IXRMPX(IPX)
- IF (IOPTE.NE.0) CALL IXCLRPX(IPX)
- IF (IOPTW.NE.0) CALL IXWRPX(IPX,IX,IY,7,'higz.bm')
-#endif
-*
- END
diff --git a/src/graflib/higz/ig/igq.F b/src/graflib/higz/ig/igq.F
deleted file mode 100644
index 703b855..0000000
--- a/src/graflib/higz/ig/igq.F
+++ /dev/null
@@ -1,194 +0,0 @@
-*
-* $Id: igq.F,v 1.1.1.1 1996/02/14 13:10:37 mclareni Exp $
-*
-* $Log: igq.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:37 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.23/00 20/04/95 09.57.34 by O.Couet
-*-- Author :
- SUBROUTINE IGQ(PNAME,RVAL)
-*.===========>
-*.
-*. This routine inquire the primitive attribute PNAME to the value VAL .
-*.
-*. _Input parameters:
-*.
-*. CHARACTER PNAME : Parameter name .
-*.
-*. PNAME='FAIS' RVAL=Fill Area Interior Style (0,1,2,3)
-*. PNAME='FASI' RVAL=Fill Area Style Index
-*. PNAME='LTYP' RVAL=Line TYPe
-*. PNAME='BASL' RVAL=BAsic Segment Length
-*. PNAME='LWID' RVAL=Line WIDth
-*. PNAME='MTYP' RVAL=Marker TYPe
-*. PNAME='MSCF' RVAL=Marker SCale Factor
-*. PNAME='PLCI' RVAL=PolyLine Color Index
-*. PNAME='PMCI' RVAL=PolyMarker Color Index
-*. PNAME='FACI' RVAL=Fill Area Color Index
-*. PNAME='TXCI' RVAL=TeXt Color Index
-*. PNAME='TXAL' RVAL(1)=Alignment horizontal
-*. RVAL(2)=Alignment vertical
-*. PNAME='CHHE' RVAL=CHaracter HEight)
-*. PNAME='TANG' RVAL=Text ANGle
-*. PNAME='TXFP' RVAL(1)=TeXt Font
-*. RVAL(2)=TeXt Precision
-*. PNAME='TMSI' RVAL=Tick Marks SIze (in WC)
-*. PNAME='LASI' RVAL=LAbels SIze (in WC)
-*. PNAME='LAOF' RVAL=LAbels OFfset
-*. PNAME='PASS' RVAL=IGTEXT Width
-*. PNAME='CSHI' RVAL=IGTEXT Shift
-*. PNAME='BORD' RVAL=Border for IGBOX, IGFBOX and IGARC (0=No , 1=Yes)
-*. PNAME='BARO' RVAL=IGHIST or IGRAPH BAR charts Offset (%)
-*. PNAME='BARW' RVAL=IGHIST or IGRAPH BAR charts Width (%)
-*. PNAME='AWLN' RVAL=Axis Wire LeNght
-*. PNAME='DIME' RVAL=2D or 3D
-*. PNAME='NCOL' RVAL=Number of entry in the COLor map.
-*. PNAME='RGB ' RVAL=R G B values
-*. PNAME='CLIP' RVAL=Clipping mode: 1.=on 0.=off
-*.
-*. _Output parameters:
-*.
-*. REAL RVAL : Parameter value .
-*.
-*..==========> (O.Couet)
-#include "higz/hiatt.inc"
-#include "higz/hilut.inc"
-#if defined(CERNLIB_GL)
-#include "higz/hikern.inc"
-#endif
- CHARACTER*(*) PNAME
- DIMENSION RVAL(*)
-#if defined(CERNLIB_GL)
- INTEGER*2 IR,IG,IB
-#endif
-*.______________________________________
-*
- IF(PNAME(1:4).EQ.'FAIS')THEN
- RVAL(1)=FLOAT(IFAIS)
- RETURN
- ENDIF
- IF(PNAME(1:4).EQ.'FASI')THEN
- RVAL(1)=FLOAT(IFASI)
- RETURN
- ENDIF
- IF(PNAME(1:4).EQ.'LTYP')THEN
- RVAL(1)=FLOAT(ILN)
- RETURN
- ENDIF
- IF(PNAME(1:4).EQ.'BASL')THEN
- RVAL(1)=RBSL
- RETURN
- ENDIF
- IF(PNAME(1:4).EQ.'LWID')THEN
- RVAL(1)=RLWSC
- RETURN
- ENDIF
- IF(PNAME(1:4).EQ.'MTYP')THEN
- RVAL(1)=IMK
- RETURN
- ENDIF
- IF(PNAME(1:4).EQ.'MSCF')THEN
- RVAL(1)=RMKSC
- RETURN
- ENDIF
- IF(PNAME(1:4).EQ.'PLCI')THEN
- RVAL(1)=FLOAT(IPLCI)
- RETURN
- ENDIF
- IF(PNAME(1:4).EQ.'PMCI')THEN
- RVAL(1)=FLOAT(IPMCI)
- RETURN
- ENDIF
- IF(PNAME(1:4).EQ.'FACI')THEN
- RVAL(1)=FLOAT(IFACI)
- RETURN
- ENDIF
- IF(PNAME(1:4).EQ.'TXCI')THEN
- RVAL(1)=FLOAT(ITXCI)
- RETURN
- ENDIF
- IF(PNAME(1:4).EQ.'TXAL')THEN
- RVAL(1)=FLOAT(ITXALH)
- RVAL(2)=FLOAT(ITXALV)
- RETURN
- ENDIF
- IF(PNAME(1:4).EQ.'CHHE')THEN
- RVAL(1)=RCHH
- RETURN
- ENDIF
- IF(PNAME(1:4).EQ.'TANG')THEN
- RVAL(1)=RANGLE
- RETURN
- ENDIF
- IF(PNAME(1:4).EQ.'TXFP')THEN
- RVAL(1)=FLOAT(IFONT)
- RVAL(2)=FLOAT(IPREC)
- RETURN
- ENDIF
- IF(PNAME(1:4).EQ.'TMSI')THEN
- RVAL(1)=RTMS
- RETURN
- ENDIF
- IF(PNAME(1:4).EQ.'LASI')THEN
- RVAL(1)=RALH
- RETURN
- ENDIF
- IF(PNAME(1:4).EQ.'LAOF')THEN
- RVAL(1)=RALD
- RETURN
- ENDIF
- IF(PNAME(1:4).EQ.'PASS')THEN
- RVAL(1)=FLOAT(INPASS)
- RETURN
- ENDIF
- IF(PNAME(1:4).EQ.'CSHI')THEN
- RVAL(1)=RCSHIF
- RETURN
- ENDIF
- IF(PNAME(1:4).EQ.'BORD')THEN
- RVAL(1)=FLOAT(IBORD)
- RETURN
- ENDIF
- IF(PNAME(1:4).EQ.'BARO')THEN
- RVAL(1)=RBOF
- RETURN
- ENDIF
- IF(PNAME(1:4).EQ.'BARW')THEN
- RVAL(1)=RBWD
- RETURN
- ENDIF
- IF(PNAME(1:4).EQ.'AWLN')THEN
- RVAL(1)=RAWL
- RETURN
- ENDIF
- IF(PNAME(1:4).EQ.'DIME')THEN
- RVAL(1)=FLOAT(IDIM)
- RETURN
- ENDIF
- IF(PNAME(1:4).EQ.'NCOL')THEN
- RVAL(1)=FLOAT(INBCOL)
- RETURN
- ENDIF
- IF(PNAME(1:4).EQ.'RGB ')THEN
- I=RVAL(1)+1
- IF(I.LE.NBCLUT)THEN
- RVAL(2)=REDLUT(I)
- RVAL(3)=GRNLUT(I)
- RVAL(4)=BLULUT(I)
- ELSE
- RVAL(2)=1.
- RVAL(3)=1.
- RVAL(4)=1.
- ENDIF
- RETURN
- ENDIF
- IF(PNAME(1:4).EQ.'CLIP')THEN
- RVAL(1)=FLOAT(ICLIP)
- RETURN
- ENDIF
- CALL IGERR('Unavailable option','IGQ')
-*
- END
diff --git a/src/graflib/higz/ig/igqwk.F b/src/graflib/higz/ig/igqwk.F
deleted file mode 100644
index 4331de4..0000000
--- a/src/graflib/higz/ig/igqwk.F
+++ /dev/null
@@ -1,283 +0,0 @@
-*
-* $Id: igqwk.F,v 1.3 1998/01/28 14:34:22 couet Exp $
-*
-* $Log: igqwk.F,v $
-* Revision 1.3 1998/01/28 14:34:22 couet
-* - GGDM driver removed
-*
-* Revision 1.2 1996/09/25 14:57:20 couet
-* - GPR driver removed
-*
-* Revision 1.1.1.1 1996/02/14 13:10:37 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.22/08 24/02/95 17.03.49 by O.Couet
-*-- Author :
- SUBROUTINE IGQWK(IWKID,PNAME,RVAL)
-*.===========>
-*.
-*. This routine returns in VAL the values of the parameters
-*. asked in PNAME.
-*.
-*. _Input parameters:
-*.
-*. INTEGER IWKID : Workstation identifier.
-*. CHARACTER PNAME : Parameter name .
-*.
-*. _Output parameters:
-*.
-*. REAL RVAL : Parameter value .
-*.
-*. +-------+---------------------------------------+-------------+
-*. | PNAME | RVAL Description | RVAL Lenght |
-*. +-------+---------------------------------------+-------------+
-*. |'MXDS' | Maximal display surface (XMAX YMAX) | 2 |
-*. +-------+---------------------------------------+-------------+
-*. |'NTNB' | Current NT number (NT) | 1 |
-*. +-------+---------------------------------------+-------------+
-*. |'NTWN' | Current window parameter | 4 |
-*. +-------+---------------------------------------+-------------+
-*. |'NTVP' | Current viewport parameter | 4 |
-*. +-------+---------------------------------------+-------------+
-*. |'DVOL' | Display volume in 3D (obsolete) | 3 |
-*. +-------+---------------------------------------+-------------+
-*. |'ACTI' | 1. if IWKID is active 0. if not | 1 |
-*. +-------+---------------------------------------+-------------+
-*. |'OPEN' | 1. if IWKID is open 0. if not | 1 |
-*. +-------+---------------------------------------+-------------+
-*. |'NBWK' | Number and list of open workstations | 11 |
-*. +-------+---------------------------------------+-------------+
-*. |'2BUF' | Double buffer value (X11 only) | 1 |
-*. +-------+---------------------------------------+-------------+
-*. |'HWCO' | Number of COlours suported by the | 1 |
-*. | | HardWare. If 2 it is a B&W screen. | |
-*. +-------+---------------------------------------+-------------+
-*. |'WIID' | Return the window identifier associa-| 1 |
-*. | | -ted to the workstation ID IWKID. | |
-*. +-------+---------------------------------------+-------------+
-*.
-*..==========> (O.Couet)
-#if defined(CERNLIB_KERNEL)
-#include "higz/hikern.inc"
-#endif
-#if defined(CERNLIB_KERNEL)||defined(CERNLIB_FALCO)
-#include "higz/hiques.inc"
-#endif
-#if defined(CERNLIB_PSCRIPT)
-#include "higz/hipost.inc"
-#endif
-#include "higz/hiatt.inc"
-#if defined(CERNLIB_MSDOS)
-#include "higz/himeta.inc"
-#endif
- CHARACTER*(*) PNAME
- DIMENSION RVAL(*)
-#if defined(CERNLIB_DECGKS)
- REAL*4 RDUMMY(4),VIEW(4)
-#endif
-*.______________________________________
-*
- IF(PNAME(1:4).EQ.'MXDS')THEN
-#if defined(CERNLIB_KERNEL)||defined(CERNLIB_BATCH)
- RMDSX=1.
- RMDSY=1.
-#endif
-#if defined(CERNLIB_KERNEL)||defined(CERNLIB_FALCO)
- IF(INOPWK.EQ.0)RETURN
- I=IGIWIN(IWKID)
- IF(I.EQ.0)THEN
- IQUEST(1)=1
- GOTO 20
- ENDIF
- IDTY=IGIWTY(IWKID)
-#endif
-#if defined(CERNLIB_PSCRIPT)
- IF(IDTY.LT.0)THEN
- IF(LOPRNG)THEN
- RVAL(1)=XPSR
- RVAL(2)=YPSR
- ELSE
- RVAL(1)=XWKSIZ(IPSI)
- RVAL(2)=YWKSIZ(IPSI)
- ENDIF
- RETURN
- ENDIF
-#endif
-#if (defined(CERNLIB_GL))&&(!defined(CERNLIB_MSDOS))
- CALL IGSG(I)
- CALL GETORI(IQUEST(10),IQUEST(11))
- CALL GETSIZ(IXX,IYY)
- CALL RESHAP
- CALL ORTHO2(0.,FLOAT(IXX-1),0.,FLOAT(IYY-1))
- XWKSIZ(I)=FLOAT(IXX)
- YWKSIZ(I)=FLOAT(IYY)
-#endif
-#if defined(CERNLIB_MSDOS)
- CALL IGSG(I)
- IF(ILOPWK(I).NE.IDMETA)THEN
- ELSE
- XWKSIZ(I)=10000.0
- YWKSIZ(I)=10000.0
- ENDIF
-#endif
-#if defined(CERNLIB_FALCO)
- ITY = IGIWTY(IWKID)
- IF(ITY.EQ.7878.OR.ITY.EQ.7879)THEN
- IQUEST(10) = 128000
- XWKSIZ(I) = 128000.
- IF(ITY.EQ.7878)THEN
- IQUEST(11) = 100000
- YWKSIZ(I) = 100000.
- ELSE
- IQUEST(11) = 101120
- YWKSIZ(I) = 101120.
- ENDIF
- GOTO 10
- ENDIF
-#endif
-#if defined(CERNLIB_X11)
- CALL IXGETGE(IWINID(I),WINSIZ(1),WINSIZ(2),WINSIZ(3),WINSIZ(4))
- IQUEST(10)=WINSIZ(1)
- IQUEST(11)=WINSIZ(2)
- XWKSIZ(I)=FLOAT(WINSIZ(3))
- YWKSIZ(I)=FLOAT(WINSIZ(4))
-#endif
-#if defined(CERNLIB_MACMPW)
- CALL IMGETGE(IWINID(I),WINSIZ(1),WINSIZ(2),WINSIZ(3),WINSIZ(4))
- IQUEST(10)=WINSIZ(1)
- IQUEST(11)=WINSIZ(2)
- XWKSIZ(I)=FLOAT(WINSIZ(3))
- YWKSIZ(I)=FLOAT(WINSIZ(4))
-#endif
-#if defined(CERNLIB_PHIGS)
- CALL PQDSP(IGIWTY(IWKID),IERR,IDC,RMDSX,RMDSY,ILX,ILY)
-#endif
-#if defined(CERNLIB_KERNEL)||defined(CERNLIB_FALCO)
- 10 CONTINUE
- RMDSX=XWKSIZ(I)
- RMDSY=YWKSIZ(I)
- WKMAX(I)=MAX(RMDSX,RMDSY)
- CALL IGSRAP(REDIT)
- 20 CONTINUE
-#endif
-#if defined(CERNLIB_MGKS)||defined(CERNLIB_PLOT10GKS)||defined(CERNLIB_UNIGKS)
- IERR=0
- CALL GQMDS(IGIWTY(IWKID),IERR,IDC,RMDSX,RMDSY,ILX,ILY)
-#endif
-#if defined(CERNLIB_GKSGRAL)||defined(CERNLIB_ATCGKS)||defined(CERNLIB_GKSBX)
- CALL GQDSP(IGIWTY(IWKID),IERR,IDC,RMDSX,RMDSY,ILX,ILY)
-#endif
-#if defined(CERNLIB_DECGKS)
- IF(MOD(IGIWTY(IWKID),256).LT.200)THEN
- CALL GQDSP(IGIWTY(IWKID),IERR,IDC,RMDSX,RMDSY,ILX,ILY)
- ELSE
- CALL GQWKT(1,IERR,ISTATE,RDUMMY,RDUMMY,VIEW,RDUMMY)
- RMDSX=VIEW(2)-VIEW(1)
- RMDSY=VIEW(4)-VIEW(3)
- ENDIF
-#endif
-#if defined(CERNLIB_UNIGKS)
- IF (IERR.EQ.31) THEN
- RMDSX=1.
- RMDSY=1.
- ENDIF
-#endif
- RVAL(1)=RMDSX
- RVAL(2)=RMDSY
- RETURN
- ENDIF
-*
- IF(PNAME(1:4).EQ.'NTNB')THEN
- RVAL(1)=FLOAT(INTR)
- RETURN
- ENDIF
-*
- IF(PNAME(1:4).EQ.'NTWN')THEN
- RVAL(1)=RWXMIN
- RVAL(2)=RWXMAX
- RVAL(3)=RWYMIN
- RVAL(4)=RWYMAX
- RETURN
- ENDIF
-*
- IF(PNAME(1:4).EQ.'NTVP')THEN
- RVAL(1)=RVXMIN
- RVAL(2)=RVXMAX
- RVAL(3)=RVYMIN
- RVAL(4)=RVYMAX
- RETURN
- ENDIF
-*
- IF(PNAME(1:4).EQ.'DVOL')THEN
- CALL IGERR('Obsolete option','IGQWK')
- RETURN
- ENDIF
-*
- IF(PNAME(1:4).EQ.'ACTI')THEN
- RVAL(1)=0.
- DO 30 I=1,INOPWK
- IF(IWKID.EQ.ILOPWK(I))THEN
- IF(ACWKFL(I))RVAL(1)=1.
- RETURN
- ENDIF
- 30 CONTINUE
- RETURN
- ENDIF
-*
- IF(PNAME(1:4).EQ.'OPEN')THEN
- RVAL(1)=0.
- DO 40 I=1,INOPWK
- IF(IWKID.EQ.ILOPWK(I))THEN
- RVAL(1)=1.
- RETURN
- ENDIF
- 40 CONTINUE
- RETURN
- ENDIF
-*
- IF(PNAME(1:4).EQ.'NBWK')THEN
- RVAL(1)=FLOAT(INOPWK)
- DO 50 I=1,INOPWK
- RVAL(I+1)=FLOAT(ILOPWK(I))
- 50 CONTINUE
- RETURN
- ENDIF
-*
- IF(PNAME(1:4).EQ.'2BUF')THEN
-#if defined(CERNLIB_X11)
- IWIN=IWINID(IGIWIN(IWKID))
- IVAL=IXQ2BUF(IWIN)
- RVAL(1)=FLOAT(IVAL)
-#endif
-#if !defined(CERNLIB_X11)
- RVAL(1)=0.
-#endif
- RETURN
- ENDIF
-*
- IF(PNAME(1:4).EQ.'HWCO')THEN
- RVAL(1) = 8.
-#if defined(CERNLIB_FALCO)
- ITY = IGIWTY(IWKID)
- IF(ITY.EQ.7878.OR.ITY.EQ.7879)THEN
- RVAL(1) = 2.
- RETURN
- ENDIF
-#endif
-#if defined(CERNLIB_X11)
- CALL IXGETPL(NPLAN)
- RVAL(1) = 2.**FLOAT(NPLAN)
-#endif
- RETURN
- ENDIF
-*
- IF(PNAME(1:4).EQ.'WIID')THEN
- RVAL(1) = FLOAT(IWINID(IGIWIN(IWKID)))
- RETURN
- ENDIF
-*
- CALL IGERR('Unavailable option','IGQWK')
-*
- END
diff --git a/src/graflib/higz/ig/igrap1.F b/src/graflib/higz/ig/igrap1.F
deleted file mode 100644
index de0b069..0000000
--- a/src/graflib/higz/ig/igrap1.F
+++ /dev/null
@@ -1,482 +0,0 @@
-*
-* $Id: igrap1.F,v 1.1.1.1 1996/02/14 13:10:38 mclareni Exp $
-*
-* $Log: igrap1.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:38 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.21/08 21/07/94 12.19.27 by O.Couet
-*-- Author :
- SUBROUTINE IGRAP1(X,Y,N,IITYP)
-*.===========>
-*.
-*. Underlaying routine for IGHIST Based on the CERN GD3 routine TVIPTE
-*.
-*. Author - Marlow etc. Modified by - P. Ward Date - 3.10.1973
-*.
-*. This routine draws a smooth tangentially continuous curve through
-*. the sequence of data points P(I) I=1,N where P(I)=(X(I),Y(I))
-*. the curve is approximated by a polygonal arc of short vectors .
-*. the data points can represent open curves, P(1).NE.P(N) or closed
-*. curves P(2).EQ.P(N) . If a tangential discontinuity at P(I) is
-*. required , then set P(I)=P(I+1) . loops are also allowed .
-*.
-*. Reference Marlow and Powell,Harwell report No.R.7092.1972
-*. MCCONALOGUE,Computer Journal VOL.13,NO4,NOV1970PP392 6
-*.
-*. _Input parameters:
-*.
-*. INTEGER N : Number of data points.
-*. REAL X(N) : Abscissa
-*. REAL Y(N) : Ordinate
-*.
-*.
-*. XDELT is the accuracy required in constructing the curve.
-*. if it is zero then the routine calculates a value other-
-*. wise it uses this value. (default is 0.0)
-*.
-*. JIPTE=0 No coordinate transformation
-*. =1 Transformation for graph in X direction
-*. =2 Transformation for graph in Y direction
-*. =3 Transformation for contour plotting (make square)
-*. KIPTE .LT. 0 Set JIPTE as GD3 routines wish
-*. .GE. 0 Set JIPTE=KIPTE (set by user)
-*.
-*. ITYP has different value according to CHOPT in IGHIST:
-*.
-*. CHOPT='S' ITYP=1
-*. CHOPT='SA' ITYP=2
-*. CHOPT='SA1' ITYP=3
-*. CHOPT='RS' ITYP=11
-*. CHOPT='RSA' ITYP=12
-*. CHOPT='RSA1' ITYP=13
-*.
-*..==========>
-#include "higz/hipaw.inc"
-#include "higz/hiatt.inc"
- DIMENSION X(N),Y(N)
- LOGICAL FLGIC,FLGIS,LOPTX
- EQUIVALENCE (LX,LSTACK(9)),(LY,LSTACK(10))
-*.______________________________________
-*
- NPMAX = N*10
- N2 = NPMAX-2
- IBKSIZ = N2
- CALL MZNEED(IXHIGZ,2*NPMAX+25,'G')
- IF (IQUEST(11).LT.0) THEN
- CALL IGERR('IGRAP1','Not enough space in memory')
- RETURN
- ENDIF
- IF(LX.NE.0)CALL MZDROP(IXHIGZ,LX,' ')
- IF(LY.NE.0)CALL MZDROP(IXHIGZ,LY,' ')
- CALL MZBOOK(IXHIGZ,LX,LX,1,'TMPX',0,0,NPMAX,3,0)
- CALL MZBOOK(IXHIGZ,LY,LY,1,'TMPY',0,0,NPMAX,3,0)
-*
-* Decode the type of curve according to
-* CHOPT of IGHIST.
-* ('S', 'SA', 'SA1' ,'XS', 'XSA', or 'XSA1')
-*
- ITYP = IITYP
- IF(ITYP.GE.1000)ITYP=ITYP-1000
- LOPTX = .FALSE.
- JTYP = ITYP-10
- IF(JTYP.GT.0)THEN
- KTYP = JTYP
- LOPTX = .TRUE.
- ELSE
- KTYP = ITYP
- ENDIF
- IF(KTYP.EQ.3)THEN
- XORG = RWXMIN
- YORG = RWYMIN
- ELSE
- XORG = MAX(0.,RWXMIN)
- YORG = MAX(0.,RWYMIN)
- ENDIF
-*
- MAXIT = 20
- DELT = 0.00055
-*
-* Scale data to the range 0-RATSIG in X, 0-1 in Y
-* where RATSIG is the ratio between the number of changes
-* of sign in Y divided by the number of changes of sign in X
-*
- SXMIN = X(1)
- SXMAX = X(1)
- SYMIN = Y(1)
- SYMAX = Y(1)
- SIX = 1.
- SIY = 1.
- DO 10 I=2,N
- IF(I.GT.2)THEN
- IF((X(I)-X(I-1))*(X(I-1)-X(I-2)).LT.0.)SIX=SIX+1.
- IF((Y(I)-Y(I-1))*(Y(I-1)-Y(I-2)).LT.0.)SIY=SIY+1.
- ENDIF
- IF(X(I).LT.SXMIN)SXMIN=X(I)
- IF(X(I).GT.SXMAX)SXMAX=X(I)
- IF(Y(I).LT.SYMIN)SYMIN=Y(I)
- IF(Y(I).GT.SYMAX)SYMAX=Y(I)
- 10 CONTINUE
- ICLOSE = 0
- DX1N = ABS(X(N)-X(1))
- DY1N = ABS(Y(N)-Y(1))
- CLO = 0.01
- IF(DX1N.LT.CLO*(SXMAX-SXMIN).AND.DY1N.LT.CLO*(SYMAX-SYMIN))
- + ICLOSE = 1
- IF(SXMIN.EQ.SXMAX)THEN
- XRAT = 1.
- ELSE
- IF(SIX.GT.1.)THEN
- RATSIG = SIY/SIX
- ELSE
- RATSIG = 20.
- ENDIF
- XRAT = RATSIG/(SXMAX-SXMIN)
- ENDIF
- IF(SYMIN.EQ.SYMAX)THEN
- YRAT = 1.
- ELSE
- YRAT = 1./(SYMAX-SYMIN)
- ENDIF
-*
- Q(LX+1) = X(1)
- Q(LY+1) = Y(1)
- DO 20 I=1,N
- X(I) = (X(I)-SXMIN)*XRAT
- Y(I) = (Y(I)-SYMIN)*YRAT
- 20 CONTINUE
-*
-* IFIN is minus one if we must draw a straight line from P(K-1)
-* to P(K). IFIN is one if the last call to IPL has .LT. N2
-* points. IFIN is zero otherwise. NPT counts the X and Y
-* coordinates in work . When NPT=N2 a call to IPL is made.
-*
- IFIN = 0
- NPT = 1
- K = 1
-*
-* Convert coordinates back to original system
-*
-*
-* Separate the set of data points into arcs P(K-1),P(K).
-* Calculate the direction cosines. first consider whether
-* there is a continuous tangent at the endpoints.
-*
- IF(ICLOSE.NE.0)GO TO 30
- IF(X(1).NE.X(N).OR.Y(1).NE.Y(N))GOTO 40
- IF(X(N-1).EQ.X(N).AND.Y(N-1).EQ.Y(N))GOTO 40
- IF(X(1).EQ.X(2).AND.Y(1).EQ.Y(2))GOTO 40
- 30 FLGIC = .FALSE.
- FLGIS = .TRUE.
-*
-* FLGIC is true if the curve is open and false if it is closed.
-* FLGIS is true in the main loop, but is false if there is
-* a deviation from the main loop.
-*
- KM=N-1
-*
-* Calculate direction cosines at P(1) using P(N-1),P(1),P(2).
-*
- GOTO 100
- 40 FLGIC = .TRUE.
- FLGIS = .FALSE.
-*
-* Skip excessive consecutive equal points.
-*
- 50 IF(K.GE.N)GOTO 380
- K=K+1
- IF(X(K).EQ.X(K-1).AND.Y(K).EQ.Y(K-1))GOTO 50
- 60 KM=K-1
- IF(K-N)90,70,380
- 70 IF(FLGIC)GOTO 80
-*
-* Calculate direction cosines at P(n) using P(N-1),P(N),P(2).
-*
- KP=2
- GOTO 130
- 80 IF(FLGIS)GOTO 150
-*
-* Draw a straight line from P(K-1) to P(K).
-*
- IFIN=-1
- GOTO 170
-*
-* Test whether P(K) is a cusp.
-*
- 90 IF(X(K).EQ.X(K+1).AND.Y(K).EQ.Y(K+1))GOTO 80
- 100 KP=K+1
- GOTO 130
-*
-* Branch if the next section of the curve begins at a cusp.
-*
- 110 IF(.NOT.FLGIS)GOTO 50
-*
-* Carry forward the direction cosines from the previous arc.
-*
- 120 CO=CT
- SO=ST
- K=K+1
- GOTO 60
-*
-* Calculate the direction cosines at P(K). If K=1 then
-* N-1 is used for K-1. If K=N then 2 is used for K+1.
-* direction cosines at P(K) obtained from P(K-1),P(K),P(K+1).
-*
- 130 DX1 = X(K)-X(KM)
- DY1 = Y(K)-Y(KM)
- DK1 = DX1**2+DY1**2
- DX2 = X(KP)-X(K)
- DY2 = Y(KP)-Y(K)
- DK2 = DX2**2+DY2**2
- CTU = DX1*DK2+DX2*DK1
- STU = DY1*DK2+DY2*DK1
- XNT = CTU**2+STU**2
- IF(XNT.GT.1.E-25)GOTO 140
-*
-* If both ctu and stu are zero,then default.This can
-* occur when P(K)=P(K+1). I.E. A loop.
-*
- CTU = DY1
- STU =-DX1
- XNT = DK1
-*
-* Normalise direction cosines.
-*
- 140 CT = CTU/SQRT(XNT)
- ST = STU/SQRT(XNT)
- IF(FLGIS)GOTO 160
-*
-* Direction cosines at P(K-1) obtained from P(K-1),P(K),P(K+1).
-*
- W3 = 2.*(DX1*DY2-DX2*DY1)
- CO = CTU+W3*DY1
- SO = STU-W3*DX1
- XNT = 1./SQRT(CO**2+SO**2)
- CO = CO*XNT
- SO = SO*XNT
- FLGIS = .TRUE.
- GOTO 170
-*
-* Direction cosines at P(K) obtained from P(K-2),P(K-1),P(K).
-*
- 150 W3 = 2.*(DX1*DY2-DX2*DY1)
- CT = CTU-W3*DY2
- ST = STU+W3*DX2
- XNT = 1./SQRT(CT**2+ST**2)
- CT = CT*XNT
- ST = ST*XNT
- FLGIS = .FALSE.
- GOTO 170
- 160 IF(K.LE.1)GOTO 120
-*
-* For the arc between P(K-1) and P(K) with direction cosines CO,
-* SO and CT,ST respectively, calculate the coefficients of the
-* parametric cubic represented by X(T) and Y(T) where
-* X(T)=XA*T**3 + XB*T**2 + CO*T + XO
-* Y(T)=YA*T**3 + YB*T**2 + SO*T + YO
-*
- 170 XO = X(K-1)
- YO = Y(K-1)
- DX = X(K)-XO
- DY = Y(K)-YO
-*
-* Initialise the values of X(TI),Y(TI) in XT and YT respectively.
-*
- XT = XO
- YT = YO
- IF(IFIN.LT.0)GOTO 350
- C = DX**2+DY**2
- A = CO+CT
- B = SO+ST
- R = DX*A+DY*B
- T = C*6./(SQRT(R**2+2.*(7.-CO*CT-SO*ST)*C)+R)
- XA = (A*T-2.*DX)/T**3
- XB = (3.*DX-(CO+A)*T)/T**2
- YA = (B*T-2.*DY)/T**3
- YB = (3.*DY-(SO+B)*T)/T**2
-*
-* If the curve is close to a straight line then use a straight
-* line between (XO,YO) and (XT,YT).
-*
- IF(.75*MAX(ABS(DX*SO-DY*CO),ABS(DX*ST-DY*CT)).LE.DELT)GOTO 340
-*
-* Calculate a set of values 0.EQ.T(0).LTCT(1).LT. ... .LT.T(M)=TC
-* such that polygonal arc joining X(T(J)),Y(T(J)) (J=0,1,..M)
-* is within the required accuracy of the curve
-*
- TJ = 0.
- U1 = YA*XB-YB*XA
- U2 = YB*CO-XB*SO
- U3 = SO*XA-YA*CO
-*
-* Given T(J), calculate T(J+1). The values of X(T(J)),
-* Y(T(J)) T(J) are contained in XT,YT and TJ respectively.
-*
- 180 S = T-TJ
- IW = -2
-*
-* Define IW here later.
-*
- P1 = (2.*U1)*TJ-U3
- P2 = (U1*TJ-U3)*3.*TJ+U2
- P3 = 3.*TJ*YA+YB
- P4 = (P3+YB)*TJ+SO
- P5 = 3.*TJ*XA+XB
- P6 = (P5+XB)*TJ+CO
-*
-* Test D(TJ,THETA). A is set to (Y(TJ+S)-Y(TJ))/S.B is
-* set to (X(TJ+S)-X(TJ))/S.
-*
- CC = 0.8209285
- ERR = 0.1209835
- 190 IW = IW-2
- 200 A = (S*YA+P3)*S+P4
- B = (S*XA+P5)*S+P6
-*
-* Set Z to PSI(D/DELTA)-CC.
-*
- W1 = -S*(S*U1+P1)
- W2 = S**2*U1-P2
- W3 = 1.5*W1+W2
-*
-* Set the estimate of (THETA-TJ)/S.Then set the numerator
-* of the expression (EQUATION 4.4)/S. Then set the square
-* of D(TJ,TJ+S)/DELT. Then replace Z by PSI(D/DELT)-CC.
-*
- STH = 0.5+SIGN(W1,W3)/(3.4*ABS(W1)+5.2*ABS(W3))
- Z = S*STH*(S-S*STH)*(W1*STH+W1+W2)
- Z = Z**2/((A**2+B**2)*(DELT**2))
- Z = (Z+2.642937)*Z/((.3715652*Z+3.063444)*Z+.2441889)-CC
-*
-* Branch if Z has been calculated
-*
- IF(IW.GT.0)GOTO 250
- IF(Z.GT.ERR)GOTO 240
- GOTO 220
- 210 IW=IW-2
- 220 IF(IW+2)230,190,290
-*
-* Last part of arc.
-*
- 230 XT = X(K)
- YT = Y(K)
- S = 0.
- GOTO 300
-*
-* Z(S). find a value of S where 0.LE.S.LE.SB such that
-* ABS(Z(S)).LT.ERR
-*
- 240 KP=0
- C=Z
- SB=S
- 250 CALL IGRAP2(KP,0.,SB,ERR,S,Z,MAXIT)
- IF(KP-2)260,210,370
- 260 IF(IW)270,280,200
-*
-* Set Z=Z(S) for S=0.
-*
- 270 Z=-CC
- IW=0
- GOTO 250
-*
-* Set Z=Z(S) for S=SB.
-*
- 280 Z=C
- IW=1
- GOTO 250
-*
-* Update TJ,XT and YT.
-*
- 290 XT=XT+S*B
- YT=YT+S*A
- TJ=S+TJ
- 300 NPT=NPT+1
-*
-* Convert coordinates to original system
-*
- Q(LX+NPT)=SXMIN+XT/XRAT
- Q(LY+NPT)=SYMIN+YT/YRAT
-*
-* If a fill area must be drawn and if the banks LX and
-* LY are too small they are enlarged in order to draw
-* the filled area in one go.
-*
- IF(NPT.LT.IBKSIZ)THEN
- GOTO 320
- ELSE
- IF(IITYP.GE.1000)THEN
- CALL MZPUSH(IXHIGZ,LX,0,N2,' ')
- CALL MZPUSH(IXHIGZ,LY,0,N2,' ')
- IBKSIZ = IBKSIZ+N2
- GOTO 320
- ELSE
- IF(KTYP.GT.1)THEN
- CALL MZPUSH(IXHIGZ,LX,0,N2,' ')
- CALL MZPUSH(IXHIGZ,LY,0,N2,' ')
- IBKSIZ = IBKSIZ+N2
- GOTO 320
- ENDIF
- ENDIF
- ENDIF
-*
-* Draw the graph
-*
- 310 CONTINUE
- IF(IITYP.GE.1000)THEN
- CALL IFA(NPT,Q(LX+1),Q(LY+1))
- IF(IBORD.NE.0)CALL IPL(NPT,Q(LX+1),Q(LY+1))
- ELSE
- IF(KTYP.GT.1)THEN
- IF(.NOT.LOPTX)THEN
- Q(LX+NPT+1)=Q(LX+NPT)
- Q(LX+NPT+2)=Q(LX+1)
- Q(LY+NPT+1)=YORG
- Q(LY+NPT+2)=YORG
- ELSE
- Q(LX+NPT+1)=XORG
- Q(LX+NPT+2)=XORG
- Q(LY+NPT+1)=Q(LY+NPT)
- Q(LY+NPT+2)=Q(LY+1)
- ENDIF
- CALL IFA(NPT+2,Q(LX+1),Q(LY+1))
- ENDIF
- CALL IPL(NPT,Q(LX+1),Q(LY+1))
- ENDIF
- NPT=1
- Q(LX+NPT)=SXMIN+XT/XRAT
- Q(LY+NPT)=SYMIN+YT/YRAT
- 320 IF(IFIN)360,330,390
- 330 IF(S)110,110,180
-*
-* Draw a straight line between (XO,YO) and (XT,YT)
-*
- 340 IFIN=-1
- 350 XT=XT+DX
- YT=YT+DY
- GOTO 300
- 360 IFIN=0
- GOTO 110
- 370 CALL IGERR('Attempt to plot outside plot limits'
- +,'IGRAPH')
- GOTO 230
-*
-* Prepare to clear out remaining short vectors before returning
-*
- 380 IFIN=1
- IF(NPT.GT.1)GOTO 310
-*
-* Convert coordinates back to original system
-*
- 390 DO 400 I=1,N
- X(I)=SXMIN+X(I)/XRAT
- Y(I)=SYMIN+Y(I)/YRAT
- 400 CONTINUE
-*
- CALL MZDROP(IXHIGZ,LX,' ')
- CALL MZDROP(IXHIGZ,LY,' ')
- LX = 0
- LY = 0
-*
- END
diff --git a/src/graflib/higz/ig/igrap2.F b/src/graflib/higz/ig/igrap2.F
deleted file mode 100644
index c190280..0000000
--- a/src/graflib/higz/ig/igrap2.F
+++ /dev/null
@@ -1,139 +0,0 @@
-*
-* $Id: igrap2.F,v 1.2 1997/11/24 15:29:51 couet Exp $
-*
-* $Log: igrap2.F,v $
-* Revision 1.2 1997/11/24 15:29:51 couet
-* - protection added against possible division by 0
-*
-* Revision 1.1.1.1 1996/02/14 13:10:38 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.13/03 30/09/91 14.46.39 by O.Couet
-*-- Author :
- SUBROUTINE IGRAP2(K,AZ,BZ,E2,X,Y,MAXIT)
-*.===========>
-*.
-*. Underlaying routine for IGHIST
-*. This subroutine finds a real zero of the continuous real
-*. function Y(X) in a given interval (A,B). See accompanying
-*. notes for details of the argument list and calling sequence
-*.
-*. Modified by - P. Ward Date - 24. 8.1973
-*.
-*..==========>
-*
- SAVE A,B,J1,IT,YA,YTEST,Y1,X1,J3,J2,H
-*.______________________________________
-*
- IF(K.GT.0) GOTO 30
-*
-* Calculate Y(X) at X=AZ.
-*
- A=AZ
- B=BZ
- X=A
- J1=1
- IT=1
- 10 K=J1
- 20 RETURN
-*
-* Test whether Y(X) is sufficiently small.
-*
- 30 IF(ABS(Y).GT.E2)GOTO 50
- 40 K=2
- GOTO 20
- 50 GOTO(60,70,100,170),J1
-*
-* Calculate Y(X) at X=BZ.
-*
- 60 YA=Y
- X=B
- J1=2
- GOTO 20
-*
-* Test whether the signs of Y(AZ) and Y(BZ) are different.
-* if not, begin the binary subdivision.
-*
- 70 IF(YA*Y.LT.0.)GOTO 120
- X1=A
- Y1=YA
- J1=3
- H=B-A
- J2=1
- 80 X2=A+0.5*H
- J3=1
-*
-* Check whether (MAXIT) function values have been calculated.
-*
- 90 IT=IT+1
- IF(IT.GE.MAXIT)GOTO 10
- X=X2
- GOTO 20
-*
-* Test whether a bracket has been found .
-* If not,continue the search
-*
- 100 IF(YA*Y.LT.0.)GOTO 120
- IF(J3.GE.J2)GOTO 110
- A=X
- YA=Y
- X2=X+H
- J3=J3+1
- GOTO 90
- 110 A=X1
- YA=Y1
- H=0.5*H
- J2=2.*J2
- GOTO 80
-*
-* The first bracket has been found.calculate the next X by the
-* secant method based on the bracket.
-*
- 120 B=X
- YB=Y
- J1=4
- 130 IF(ABS(YA).LE.ABS(YB))GOTO 140
- X1=A
- Y1=YA
- X=B
- Y=YB
- GOTO 150
- 140 X1=B
- Y1=YB
- X=A
- Y=YA
-*
-* Use the secant method based on the function values Y1 and Y.
-* check that X2 is inside the interval (A,B).
-*
- 150 IF (Y.EQ.Y1) GOTO 160
- X2=X-Y*(X-X1)/(Y-Y1)
- X1=X
- Y1=Y
- YTEST=0.5*MIN(ABS(YA),ABS(YB))
- IF((X2-A)*(X2-B).LT.0.)GOTO 90
-*
-* Calculate the next value of X by bisection . Check whether
-* the maximum accuracy has been achieved.
-*
- 160 X2=0.5*(A+B)
- YTEST=0.
- IF((X2-A)*(X2-B))90,40,40
-*
-* Revise the bracket (A,B).
-*
- 170 IF(YA*Y.GE.0.)GOTO 180
- B=X
- YB=Y
- GOTO 190
- 180 A=X
- YA=Y
-*
-* Use YTEST to decide the method for the next value of X.
-*
- 190 IF(YTEST.LE.0.)GOTO 130
- IF(ABS(Y)-YTEST)150,150,160
-*
- END
diff --git a/src/graflib/higz/ig/igraph.F b/src/graflib/higz/ig/igraph.F
deleted file mode 100644
index 2975b98..0000000
--- a/src/graflib/higz/ig/igraph.F
+++ /dev/null
@@ -1,459 +0,0 @@
-*
-* $Id: igraph.F,v 1.2 2001/10/17 14:36:57 couet Exp $
-*
-* $Log: igraph.F,v $
-* Revision 1.2 2001/10/17 14:36:57 couet
-* - The WORK buffers were too small and the follwoing macro didn't not
-* work for more that 101 points:
-*
-* vec/del *
-* n = [1]
-* vec/cr time([n])
-* vec/cr etime([n]) r [n]*0.0
-* vec/cr y([n]) r
-* vec/cr ey([n]) r [n]*0.7
-* do i = 1, [n]
-* vec/input time([i]) [i]
-* vec/input y([i]) $eval(3.0+0.01*[i])
-* enddo
-* null -10 160 0 10
-* hplot/errors time y etime ey [n] 20 0.1 3
-*
-* Revision 1.1.1.1 1996/02/14 13:10:38 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.21/09 19/08/94 10.47.03 by O.Couet
-*-- Author :
- SUBROUTINE IGRAPH(N,X,Y,CHOPT)
-*.===========>
-*.
-*. Draws one dimensional graphs. The aspect of the graph is done
-*. according to the value of the CHOPT.
-*.
-*. _Input parameters:
-*.
-*. INTEGER N : Number of channels in X or in Y.
-*. REAL X(N) or X(2) : X coordinates or (XMIN,XMAX) (WC space).
-*. REAL Y(N) or Y(2) : Y coordinates or (YMIN,YMAX) (WC space).
-*. CHARACTER*(*) CHOPT : Option.
-*.
-*. CHOPT='L' : A simple polyline beetwen every points is drawn
-*.
-*. CHOPT='F' : A fill area is drawn ('CF' draw a smooth fill area)
-*.
-*. CHOPT='A' : Axis are drawn around the graph
-*.
-*. CHOPT='C' : A smooth Curve is drawn
-*.
-*. CHOPT='*' : A Star is plotted at each point
-*.
-*. CHOPT='P' : Idem with the current marker
-*.
-*. CHOPT='B' : A Bar chart is drawn at each point
-*.
-*. CHOPT='1' : YLOW=RWYMIN
-*.
-*. CHOPT='GX': LOGX
-*.
-*. CHOPT='GY': LOGY
-*.
-*. CHOPT='Z' : The vectors X and Y are taken into PAWC at the
-*. adresses IQUEST(81) and IQUEST(82)
-*.
-*..==========> (O.Couet N.Cremel-Somon)
-#include "higz/hipaw.inc"
-#include "higz/hiflag.inc"
-#include "higz/hiatt.inc"
-#if defined(CERNLIB_MAIL)
-#include "higz/himail.inc"
-#endif
-#include "higz/hihist.inc"
- PARAMETER (NPMAX=1004)
- DIMENSION X(*),Y(*)
- CHARACTER*(*) CHOPT
- CHARACTER*8 CHOPA
- EQUIVALENCE (LXADR,L2NTLA),(LYADR,LDNTLA)
- LOGICAL ZFSAV
- DIMENSION IOPT(12)
- EQUIVALENCE (IOPTL ,IOPT(1)) , (IOPTA ,IOPT(2))
- EQUIVALENCE (IOPTC ,IOPT(3)) , (IOPTST,IOPT(4))
- EQUIVALENCE (IOPTP ,IOPT(5)) , (IOPTB ,IOPT(6))
- EQUIVALENCE (IOPTR ,IOPT(7)) , (IOPT1 ,IOPT(8))
- EQUIVALENCE (IOPTG ,IOPT(9)) , (IOPTX ,IOPT(10))
- EQUIVALENCE (IOPTY ,IOPT(11)), (IOPTF ,IOPT(12))
-*.______________________________________
-*
- IQUEST(1)=0
- IF(N.LE.0)THEN
- CALL IGERR(' Number of points is invalid','IGRAPH')
- RETURN
- ENDIF
-*
- CALL UOPTC(CHOPT,'LAC*PBR1GXYF',IOPT)
-*
-* If no "drawing" option is selected and if CHOPT<>' '
-* nothing is done.
-*
- IF(IOPTL+IOPTF+IOPTC+IOPTST+IOPTP+IOPTB.EQ.0)THEN
- IF(CHOPT.EQ.' ')THEN
- IOPTL=1
- ELSE
- RETURN
- ENDIF
- ENDIF
-*
-* If necessary the adresses of the vectors are saved in
-* a link area.
-*
- IF(INDEX(CHOPT,'Z').NE.0)THEN
- LXADR = IQUEST(81)
- LYADR = IQUEST(82)
- IOPTZ = 1
- ELSE
- IOPTZ = 0
- ENDIF
-*
-#if defined(CERNLIB_MAIL)
- CHOPTM=CHOPT
-#endif
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_MAIL)
- IF(GLFLAG)CALL IZGRAP(N,X,Y,IOPT,IOPTZ)
-#endif
- IF((.NOT.GFLAG).AND.(.NOT.PFLAG))RETURN
- ZFSAV = ZFLAG
- ZFLAG = .FALSE.
- GLFLAG = (ZFLAG.OR.PFLAG.OR.MFLAG)
-*
- IOPTCF = 0
- IF((IOPTC.NE.0).AND.(IOPTF.NE.0))THEN
- IOPTCF = 1
- IOPTF = 0
- ENDIF
-*
-* Draw the Axis with a fixed number of division: 510
-*
- IF(IOPTA.NE.0)THEN
- ILNOLD = ILN
- IFAOLD = IFAIS
- CALL ISLN(1)
- CALL ISFAIS(0)
- CALL IGBOX(RWXMIN,RWXMAX,RWYMIN,RWYMAX)
- CALL ISLN(ILNOLD)
- CALL ISFAIS(IFAOLD)
- AXFLAG = .FALSE.
- CHOPA = ' '
- RWMIN = RWXMIN
- RWMAX = RWXMAX
- IF(IOPTG.NE.0.AND.IOPTX.NE.0)THEN
- RWMIN = 10**RWXMIN
- RWMAX = 10**RWXMAX
- CHOPA = 'G'
- ENDIF
- CALL IGAXIS(RWXMIN,RWXMAX,RWYMIN,RWYMIN,RWMIN,RWMAX,510,CHOPA)
- AXFLAG = .TRUE.
- CHOPA = ' '
- RWMIN = RWYMIN
- RWMAX = RWYMAX
- IF(IOPTG.NE.0.AND.IOPTY.NE.0)THEN
- RWMIN = 10**RWYMIN
- RWMAX = 10**RWYMAX
- CHOPA = 'G'
- ENDIF
- CALL IGAXIS(RWXMIN,RWXMIN,RWYMIN,RWYMAX,RWMIN,RWMAX,510,CHOPA)
- AXFLAG = .FALSE.
- ENDIF
-*
-* Draw the graph with a polyline or a fill area
-* beetwen every point
-*
- IF((IOPTL.NE.0).OR.(IOPTF.NE.0))THEN
- IF(IOPTZ.NE.0)THEN
- XWORK(1) = Q(LXADR)
- YWORK(1) = Q(LYADR)
- X1 = Q(LXADR)
- XN = Q(LXADR+N-1)
- Y1 = Q(LYADR)
- YN = Q(LYADR+N-1)
- ELSE
- XWORK(1) = X(1)
- YWORK(1) = Y(1)
- X1 = X(1)
- XN = X(N)
- Y1 = Y(1)
- YN = Y(N)
- ENDIF
- NLOOP = N
- IF(IOPTF.NE.0.AND.(XN.NE.X1.OR.YN.NE.Y1))NLOOP = NLOOP+1
- NPT = 1
- DO 10 I=1,NLOOP
- NPT = NPT+1
- IF(I.GT.N)THEN
- XWORK(NPT) = XWORK(1)
- YWORK(NPT) = YWORK(1)
- ELSE
- IF(IOPTZ.NE.0)THEN
- XWORK(NPT) = Q(LXADR+I-1)
- YWORK(NPT) = Q(LYADR+I-1)
- ELSE
- XWORK(NPT) = X(I)
- YWORK(NPT) = Y(I)
- ENDIF
- ENDIF
- IF(NPT.EQ.NPMAX.OR.I.EQ.NLOOP)THEN
- CALL IGHIS1(NPT,IOPTG,IOPTX,IOPTY)
- IF(IOPTR.NE.0)THEN
- IF(IOPTF.NE.0)THEN
- CALL IFA(NPT,YWORKL,XWORKL)
- IF(IBORD.NE.0)CALL IPL(NPT,YWORKL,XWORKL)
- ELSE
- CALL IPL(NPT,YWORKL,XWORKL)
- ENDIF
- ELSE
- IF(IOPTF.NE.0)THEN
- CALL IFA(NPT,XWORKL,YWORKL)
- IF(IBORD.NE.0)CALL IPL(NPT,XWORKL,YWORKL)
- ELSE
- CALL IPL(NPT,XWORKL,YWORKL)
- ENDIF
- ENDIF
- XWORK(1) = XWORK(NPT)
- YWORK(1) = YWORK(NPT)
- NPT = 1
- ENDIF
- 10 CONTINUE
- ENDIF
-*
-* Draw the graph with a smooth Curve. The computing
-* of the smoothing is done by the routine IGRAP1
-*
- IF(IOPTC.NE.0)THEN
- IF(IOPTZ.NE.0)THEN
- X1 = Q(LXADR)
- XN = Q(LXADR+N-1)
- Y1 = Q(LYADR)
- YN = Q(LYADR+N-1)
- ELSE
- X1 = X(1)
- XN = X(N)
- Y1 = Y(1)
- YN = Y(N)
- ENDIF
- ITYPS = 1
- NLOOP = N
- IF(IOPTCF.NE.0)THEN
- ITYPS = ITYPS+1000
- IF(XN.NE.X1.OR.YN.NE.Y1)NLOOP = NLOOP+1
- ENDIF
- IF(IOPTR.EQ.0)THEN
- NPT = 0
- DO 20 I=1,NLOOP
- NPT = NPT+1
- IF(I.GT.N)THEN
- XWORK(NPT) = XWORK(1)
- YWORK(NPT) = YWORK(1)
- ELSE
- IF(IOPTZ.NE.0)THEN
- XWORK(NPT) = Q(LXADR+I-1)
- YWORK(NPT) = Q(LYADR+I-1)
- ELSE
- XWORK(NPT) = X(I)
- YWORK(NPT) = Y(I)
- ENDIF
- ENDIF
- CALL IGHIS1(NPT,IOPTG,IOPTX,IOPTY)
- IF(YWORKL(NPT).LT.RWYMIN.OR.YWORKL(NPT).GT.RWYMAX)THEN
- IF(NPT.GT.2)THEN
- CALL IGHIS1(NPT,IOPTG,IOPTX,IOPTY)
- CALL IGRAP1(XWORKL,YWORKL,NPT,ITYPS)
- ENDIF
- XWORK(1) = XWORK(NPT)
- YWORK(1) = YWORK(NPT)
- NPT=1
- GOTO 20
- ENDIF
- IF(NPT.GE.NPMAX)THEN
- CALL IGHIS1(NPT,IOPTG,IOPTX,IOPTY)
- CALL IGRAP1(XWORKL,YWORKL,NPT,ITYPS)
- XWORK(1) = XWORK(NPT)
- YWORK(1) = YWORK(NPT)
- NPT = 1
- ENDIF
- 20 CONTINUE
- IF(NPT.GT.1)THEN
- CALL IGHIS1(NPT,IOPTG,IOPTX,IOPTY)
- CALL IGRAP1(XWORKL,YWORKL,NPT,ITYPS)
- ENDIF
- ELSE
- ITYPS = ITYPS+10
- NPT = 0
- DO 30 I=1,NLOOP
- NPT=NPT+1
- IF(I.GT.N)THEN
- XWORK(NPT) = XWORK(1)
- YWORK(NPT) = YWORK(1)
- ELSE
- IF(IOPTZ.NE.0)THEN
- XWORK(NPT) = Q(LXADR+I-1)
- YWORK(NPT) = Q(LYADR+I-1)
- ELSE
- XWORK(NPT) = X(I)
- YWORK(NPT) = Y(I)
- ENDIF
- ENDIF
- CALL IGHIS1(NPT,IOPTG,IOPTX,IOPTY)
- IF(XWORKL(NPT).LT.RWXMIN.OR.XWORKL(NPT).GT.RWXMAX)THEN
- IF(NPT.GT.2)THEN
- CALL IGHIS1(NPT,IOPTG,IOPTX,IOPTY)
- CALL IGRAP1(XWORKL,YWORKL,NPT,ITYPS)
- ENDIF
- XWORK(1) = XWORK(NPT)
- YWORK(1) = YWORK(NPT)
- NPT=1
- GOTO 30
- ENDIF
- IF(NPT.GE.NPMAX)THEN
- CALL IGHIS1(NPT,IOPTG,IOPTX,IOPTY)
- CALL IGRAP1(XWORKL,YWORKL,NPT,ITYPS)
- XWORK(1) = XWORK(NPT)
- YWORK(1) = YWORK(NPT)
- NPT = 1
- ENDIF
- 30 CONTINUE
- IF(NPT.GT.1)THEN
- CALL IGHIS1(NPT,IOPTG,IOPTX,IOPTY)
- CALL IGRAP1(XWORKL,YWORKL,NPT,ITYPS)
- ENDIF
- ENDIF
- ENDIF
-*
-* Draw the graph with a '*' on every points
-*
- IF(IOPTST.NE.0)THEN
- IMKOLD = IMK
- CALL ISMK(3)
- NPT = 0
- DO 40 I=1,N
- NPT = NPT+1
- IF(IOPTZ.NE.0)THEN
- XWORK(NPT) = Q(LXADR+I-1)
- YWORK(NPT) = Q(LYADR+I-1)
- ELSE
- XWORK(NPT) = X(I)
- YWORK(NPT) = Y(I)
- ENDIF
- IF(NPT.EQ.NPMAX.OR.I.EQ.N)THEN
- CALL IGHIS1(NPT,IOPTG,IOPTX,IOPTY)
- IF(IOPTR.NE.0)THEN
- CALL IPM(NPT,YWORKL,XWORKL)
- ELSE
- CALL IPM(NPT,XWORKL,YWORKL)
- ENDIF
- NPT = 0
- ENDIF
- 40 CONTINUE
- CALL ISMK(IMKOLD)
- ENDIF
-*
-* Draw the graph with the current polymarker on
-* every points
-*
- IF(IOPTP.NE.0)THEN
- NPT = 0
- DO 50 I=1,N
- NPT = NPT+1
- IF(IOPTZ.NE.0)THEN
- XWORK(NPT) = Q(LXADR+I-1)
- YWORK(NPT) = Q(LYADR+I-1)
- ELSE
- XWORK(NPT) = X(I)
- YWORK(NPT) = Y(I)
- ENDIF
- IF(NPT.EQ.NPMAX.OR.I.EQ.N)THEN
- CALL IGHIS1(NPT,IOPTG,IOPTX,IOPTY)
- IF(IOPTR.NE.0)THEN
- CALL IPM(NPT,YWORKL,XWORKL)
- ELSE
- CALL IPM(NPT,XWORKL,YWORKL)
- ENDIF
- NPT = 0
- ENDIF
- 50 CONTINUE
- ENDIF
-*
-* Draw the graph as a bar chart
-*
- IF(IOPTB.NE.0)THEN
- IF(IOPTR.EQ.0)THEN
- IF(IOPTZ.NE.0)THEN
- BXMIN = VMIN(Q(LXADR),N)
- BXMAX = VMAX(Q(LXADR),N)
- ELSE
- BXMIN = VMIN(X,N)
- BXMAX = VMAX(X,N)
- ENDIF
- BDELTA = (BXMAX-BXMIN)/N
- ELSE
- IF(IOPTZ.NE.0)THEN
- BYMIN = VMIN(Q(LYADR),N)
- BYMAX = VMAX(Q(LYADR),N)
- ELSE
- BYMIN = VMIN(Y,N)
- BYMAX = VMAX(Y,N)
- ENDIF
- BDELTA = (BYMAX-BYMIN)/N
- ENDIF
- DBAR = BDELTA*RBWD*0.5
- IBOLD = IBORD
- CALL IGSET('BORD',1.)
- IF(IOPTR.EQ.0)THEN
- DO 60 I=1,N
- IF(IOPTZ.NE.0)THEN
- XLOW = Q(LXADR+I-1)-DBAR
- XHIGH = Q(LXADR+I-1)+DBAR
- YHIGH = Q(LYADR+I-1)
- ELSE
- XLOW = X(I)-DBAR
- XHIGH = X(I)+DBAR
- YHIGH = Y(I)
- ENDIF
- IF(IOPT1.EQ.0)THEN
- YLOW = MAX(0.,RWYMIN)
- ELSE
- YLOW = RWYMIN
- ENDIF
- XWORK(1) = XLOW
- YWORK(1) = YLOW
- XWORK(2) = XHIGH
- YWORK(2) = YHIGH
- CALL IGHIS1(2,IOPTG,IOPTX,IOPTY)
- CALL IGBOX(XWORKL(1),XWORKL(2),YWORKL(1),YWORKL(2))
- 60 CONTINUE
- ELSE
- DO 70 I=1,N
- IF(IOPTZ.NE.0)THEN
- XHIGH = Q(LXADR+I-1)
- YLOW = Q(LYADR+I-1)-DBAR
- YHIGH = Q(LYADR+I-1)+DBAR
- ELSE
- XHIGH = X(I)
- YLOW = Y(I)-DBAR
- YHIGH = Y(I)+DBAR
- ENDIF
- XLOW = MAX(0.,RWXMIN)
- XWORK(1) = XLOW
- YWORK(1) = YLOW
- XWORK(2) = XHIGH
- YWORK(2) = YHIGH
- CALL IGHIS1(2,IOPTG,IOPTX,IOPTY)
- CALL IGBOX(XWORKL(1),XWORKL(2),YWORKL(1),YWORKL(2))
- 70 CONTINUE
- ENDIF
- CALL IGSET('BORD',FLOAT(IBOLD))
- ENDIF
-*
- ZFLAG=ZFSAV
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
-*
- END
diff --git a/src/graflib/higz/ig/igrng.F b/src/graflib/higz/ig/igrng.F
deleted file mode 100644
index a024cde..0000000
--- a/src/graflib/higz/ig/igrng.F
+++ /dev/null
@@ -1,219 +0,0 @@
-*
-* $Id: igrng.F,v 1.1.1.1 1996/02/14 13:10:38 mclareni Exp $
-*
-* $Log: igrng.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:38 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-#if !defined(CERNLIB_DI3000)
-*CMZ : 1.21/03 31/05/94 14.59.57 by O.Couet
-*-- Author :
- SUBROUTINE IGRNG(XSIZI,YSIZI)
-*.==========>
-*.
-*. This routines returns the screen range and map the workstation
-*. window on the whole screen. If the screen is not a square a part
-*. of the NDC space is not visible .
-*.
-*. _Input parameters:
-*.
-*. REAL XSIZ YSIZ : Screen range .
-*.
-*..=========>
-#include "higz/hiques.inc"
-#include "higz/hiatt.inc"
-#include "higz/himeta.inc"
-#include "higz/hiflag.inc"
-#if defined(CERNLIB_MAIL)
-#include "higz/himail.inc"
-#endif
-#if defined(CERNLIB_PSCRIPT)
-#include "higz/hipost.inc"
-#endif
-#if defined(CERNLIB_DECGKS)
- REAL*4 RDUMMY(4),VIEW(4)
-#endif
- DIMENSION RVAL(2)
-*.______________________________________
-*
- XSIZ=XSIZI
- YSIZ=YSIZI
-#if defined(CERNLIB_MAIL)
-*
-* Mail option
-*
- IF(MFLAG)THEN
- WRITE (CHMAIL,'(I3,2E16.7)') 201,XSIZ,YSIZ
- CALL IMWRIT(1)
- READ (5,'(5E15.6)') XYTWN,DXWN,DYWN,XNCM,YNCM
- CALL IMWRIT(5)
- MFLAG=.FALSE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- CALL ISWN(1,0.,XSIZ,0.,YSIZ)
- CALL ISVP(1,DXWN,XNCM+DXWN,DYWN,YNCM+DYWN)
- CALL ISELNT(1)
- RQUEST(11)=XYTWN
- RQUEST(12)=DXWN
- RQUEST(13)=DYWN
- RQUEST(14)=XNCM
- RQUEST(15)=YNCM
- MFLAG=.TRUE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- RETURN
- ENDIF
-#endif
-*
- IF(XSIZ.LT.0..OR.YSIZ.LT.0.)THEN
- CALL IGERR('X size and Y size must be positive','IGRNG')
- RETURN
- ENDIF
-*
-* Initialise parameters
-*
- RVAL(1)=1.
- RVAL(2)=1.
- XWKWN=1.
- YWKWN=1.
- IWKID=1
-*
-* If output on metafile
-*
- IF (METACT.OR.PFLAG) THEN
- IERR=0
-#if defined(CERNLIB_MGKS)||defined(CERNLIB_PLOT10GKS)||defined(CERNLIB_UNIGKS)
- CALL GQMDS(IWTYPE,IERR,IDC,RVAL(1),RVAL(2),ILX,ILY)
-#endif
-#if defined(CERNLIB_GKSGRAL)||defined(CERNLIB_DECGKS)||defined(CERNLIB_ATCGKS)||defined(CERNLIB_GKSBX)
- CALL GQDSP(IWTYPE,IERR,IDC,RVAL(1),RVAL(2),ILX,ILY)
-#endif
-#if defined(CERNLIB_ATCGKS)
- IF(IERR.EQ.22)THEN
-#endif
-#if (defined(CERNLIB_GKSGRAL)||defined(CERNLIB_DECGKS))&&(!defined(CERNLIB_ATCGKS))
- IF(IERR.EQ.31)THEN
-#endif
-#if defined(CERNLIB_GKSGRAL)||defined(CERNLIB_DECGKS)||defined(CERNLIB_ATCGKS)
- RVAL(1)=1.
- RVAL(2)=1.
- ENDIF
-#endif
- XWKWN=MIN(1.,RVAL(1)/RVAL(2))
- YWKWN=MIN(1.,RVAL(2)/RVAL(1))
-#if defined(CERNLIB_PSCRIPT)
- IF(PFLAG)CALL IPRNG(XSIZ,YSIZ)
-#endif
- ENDIF
-*
-* If output on screen
-*
- IF(TEKACT)THEN
- IERR=0
-#if defined(CERNLIB_MGKS)||defined(CERNLIB_PLOT10GKS)||defined(CERNLIB_UNIGKS)
- CALL GQMDS(IWTYPE,IERR,IDC,RVAL(1),RVAL(2),ILX,ILY)
-#endif
-#if defined(CERNLIB_GKSGRAL)||defined(CERNLIB_ATCGKS)||defined(CERNLIB_GKSBX)
- CALL GQDSP(IWTYPE,IERR,IDC,RVAL(1),RVAL(2),ILX,ILY)
-#endif
-#if defined(CERNLIB_ATCGKS)
- IF(IERR.EQ.22)THEN
-#endif
-#if (defined(CERNLIB_GKSGRAL))&&(!defined(CERNLIB_ATCGKS))
- IF(IERR.EQ.31)THEN
-#endif
-#if defined(CERNLIB_GKSGRAL)||defined(CERNLIB_ATCGKS)
- RVAL(1)=1.
- RVAL(2)=1.
- ENDIF
-#endif
-#if defined(CERNLIB_KERNEL)||defined(CERNLIB_DECGKS)||defined(CERNLIB_PHIGS)||defined(CERNLIB_FALCO)
- CALL IGQWK(IWKID,'MXDS',RVAL)
-#endif
-*
- XWKWN=MIN(1.,RVAL(1)/RVAL(2))
- YWKWN=MIN(1.,RVAL(2)/RVAL(1))
- CALL ISWKWN(IWKID,0.,XWKWN,0.,YWKWN)
-#if !defined(CERNLIB_DECGKS)
- CALL ISWKVP(IWKID,0.,RVAL(1),0.,RVAL(2))
-#endif
-#if defined(CERNLIB_X11)
- DO 10 I=1,INOPWK
- IWKL = ILOPWK(I)
- CALL IGQWK(IWKL,'MXDS',RVAL)
- CALL ISWKWN(IWKL,0.,XWKWN,0.,YWKWN)
- CALL ISWKVP(IWKL,0.,RVAL(1),0.,RVAL(2))
- CALL IKUWK(IWKL)
- XMARG=0.
- YMARG=0.
- IF(RVAL(1).GT.XWKV2(I))XMARG = (RVAL(1)-XWKV2(I))/2.
- IF(RVAL(2).GT.YWKV2(I))YMARG = (RVAL(2)-YWKV2(I))/2.
- IF(XMARG.NE.0..OR.YMARG.NE.0.)THEN
- CALL ISWKVP(IWKL,XMARG,XWKV2(I)+XMARG
- +, YMARG,YWKV2(I)+YMARG)
- CALL IKUWK(IWKL)
- ENDIF
- 10 CONTINUE
-#endif
- ENDIF
-*
-* Transformation no 1 : cm <---> espace ecran
-*
- IF (XSIZ.LT.YSIZ) THEN
- XNCM=YWKWN*XSIZ/YSIZ
- YNCM=YWKWN
- DXWN=(XWKWN-XNCM)/2.
- IF(DXWN.LT.0.)THEN
- XNCM=XWKWN
- DXWN=0.
- YNCM=XWKWN*YSIZ/XSIZ
- DYWN=(YWKWN-YNCM)/2.
- XYTWN=XWKWN/XSIZ
- ELSE
- DYWN=0.
- XYTWN=YWKWN/YSIZ
- ENDIF
- ELSE
- XNCM=XWKWN
- YNCM=XWKWN*YSIZ/XSIZ
- DYWN=(YWKWN-YNCM)/2.
- IF(DYWN.LT.0.)THEN
- YNCM=YWKWN
- DYWN=0.
- XNCM=YWKWN*XSIZ/YSIZ
- DXWN=(XWKWN-XNCM)/2.
- XYTWN=YWKWN/YSIZ
- ELSE
- DXWN=0.
- XYTWN=XWKWN/XSIZ
- ENDIF
- ENDIF
-#if defined(CERNLIB_PSCRIPT)
-*
- IF(PFLAG)THEN
- XVS1=DXWN
- XVS2=XNCM+DXWN
- YVS1=DYWN
- YVS2=YNCM+DYWN
- ENDIF
-#endif
-*
- CALL ISWN(1,0.,XSIZ,0.,YSIZ)
- CALL ISVP(1,DXWN,XNCM+DXWN,DYWN,YNCM+DYWN)
- CALL ISELNT(1)
-#if (!defined(CERNLIB_SUNGKS))&&(!defined(CERNLIB_ATCGKS))
- IF (METACT) THEN
- CALL ISWKWN (IDMETA,DXWN,XNCM+DXWN,DYWN,YNCM+DYWN)
- CALL ISWKVP (IDMETA,0., XSIZ*XMFACT,0.,YSIZ*YMFACT)
- CALL IUWK (IDMETA,1)
- ENDIF
-#endif
-*
- RQUEST(11)=XYTWN
- RQUEST(12)=DXWN
- RQUEST(13)=DYWN
- RQUEST(14)=XNCM
- RQUEST(15)=YNCM
-*
- END
-#endif
diff --git a/src/graflib/higz/ig/igrsiz.F b/src/graflib/higz/ig/igrsiz.F
deleted file mode 100644
index 3c3f348..0000000
--- a/src/graflib/higz/ig/igrsiz.F
+++ /dev/null
@@ -1,52 +0,0 @@
-*
-* $Id: igrsiz.F,v 1.1.1.1 1996/02/14 13:10:38 mclareni Exp $
-*
-* $Log: igrsiz.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:38 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-#if defined(CERNLIB_X11)
-*CMZ : 1.15/00 13/07/92 17.19.17 by O.Couet
-*-- Author : O.Couet 14/06/91
- SUBROUTINE IGRSIZ(IWKID)
-*.===========>
-*.
-*. Resize the X11 window and display the current
-*. picture if it exists.
-*.
-*..==========> (O.Couet)
-#include "higz/hiatt.inc"
-#include "higz/hiques.inc"
- CHARACTER*(32) CHTEMP
-*.______________________________________
-*
- IW=IWINID(IGIWIN(IWKID))
- CALL IXRSIZ(IW)
- CALL IZPICT(CHTEMP,'R')
- IF(CHTEMP.NE.' ')THEN
- DO 10 I=1,INOPWK
- CALL IGQWK(ILOPWK(I),'ACTI',RQUEST(40+I))
- IF(ILOPWK(I).NE.IWKID)THEN
- CALL IDAWK(ILOPWK(I))
- ELSE
- CALL IACWK(IWKID)
- ENDIF
- 10 CONTINUE
- CALL IZPICT(CHTEMP,'D')
- DO 20 I=1,INOPWK
- IF(RQUEST(40+I).EQ.0.)THEN
- CALL IDAWK(ILOPWK(I))
- ELSE
- CALL IACWK(ILOPWK(I))
- ENDIF
- 20 CONTINUE
- CALL IXSAVWI
- CALL IXSELWI(IW)
- CALL IXUPDWI(1)
- CALL IXSETWI
- ENDIF
-*
- END
-#endif
diff --git a/src/graflib/higz/ig/igrtoh.F b/src/graflib/higz/ig/igrtoh.F
deleted file mode 100644
index dbd7352..0000000
--- a/src/graflib/higz/ig/igrtoh.F
+++ /dev/null
@@ -1,52 +0,0 @@
-*
-* $Id: igrtoh.F,v 1.1.1.1 1996/02/14 13:10:38 mclareni Exp $
-*
-* $Log: igrtoh.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:38 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.13/07 01/11/91 11.46.59 by O.Couet
-*-- Author :
- SUBROUTINE IGRTOH(RED,GREEN,BLUE,RHUE,RLIGHT,RSATUR)
-*.===========>
-*.
-*. Convert RGB to HSL
-*.
-*..==========> (L.Roberts)
- REAL RNORM, GNORM, BNORM, MINVAL, MAXVAL, MSUM, MDIFF
-*.______________________________________
-*
- MINVAL = MIN (RED, GREEN, BLUE)
- MAXVAL = MAX (RED, GREEN, BLUE)
-*
- RNORM = 0.0
- GNORM = 0.0
- BNORM = 0.0
- MDIFF = MAXVAL - MINVAL
- MSUM = MAXVAL + MINVAL
- IF(MAXVAL .NE. MINVAL)THEN
- RNORM = (MAXVAL - RED) / MDIFF
- GNORM = (MAXVAL - GREEN) / MDIFF
- BNORM = (MAXVAL - BLUE) / MDIFF
- ENDIF
-*
- RLIGHT = MSUM / 2.0
-*
- IF (MAXVAL.EQ.MINVAL)THEN
- RSATUR = 0.0
- RHUE = 0.0
- GOTO 30
- ENDIF
-*
- IF (RLIGHT .LE. 0.5) RSATUR = MDIFF / MSUM
- IF (RLIGHT .GT. 0.5) RSATUR = MDIFF / (2.0 - MSUM)
-*
- IF (RED .EQ. MAXVAL) RHUE = 60.0 * (6.0 + BNORM - GNORM)
- IF (GREEN .EQ. MAXVAL) RHUE = 60.0 * (2.0 + RNORM - BNORM)
- IF (BLUE .EQ. MAXVAL) RHUE = 60.0 * (4.0 + GNORM - RNORM)
-*
- 30 IF (RHUE .GT. 360.0) RHUE = RHUE - 360.0
-*
- END
diff --git a/src/graflib/higz/ig/igset.F b/src/graflib/higz/ig/igset.F
deleted file mode 100644
index 41934f3..0000000
--- a/src/graflib/higz/ig/igset.F
+++ /dev/null
@@ -1,490 +0,0 @@
-*
-* $Id: igset.F,v 1.1.1.1 1996/02/14 13:10:38 mclareni Exp $
-*
-* $Log: igset.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:38 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.23/06 20/11/95 17.05.29 by O.Couet
-*-- Author :
- SUBROUTINE IGSET(PNAME,RVAL)
-*.===========>
-*.
-*. This routine sets the parameter PNAME to the value VAL .
-*.
-*. _Input parameters:
-*.
-*. CHARACTER PNAME : Parameter name .
-*. REAL RVAL : Parameter value .
-*.
-*. PNAME='FAIS' VAL=Fill Area Interior Style (0,1,2,3)
-*. PNAME='FASI' VAL=Fill Area Style Index
-*. PNAME='LTYP' VAL=Line TYPe
-*. PNAME='BASL' VAL=BAsic Segment Length
-*. PNAME='LWID' VAL=Line WIDth
-*. PNAME='MTYP' VAL=Marker TYPe
-*. PNAME='MSCF' VAL=Marker SCale Factor
-*. PNAME='PLCI' VAL=PolyLine Color Index
-*. PNAME='PMCI' VAL=PolyMarker Color Index
-*. PNAME='FACI' VAL=Fill Area Color Index
-*. PNAME='TXCI' VAL=TeXt Color Index
-*. PNAME='TXAL' VAL=10*(alignment horizontal) + (alignment vertical)
-*. PNAME='CHHE' VAL=CHaracter HEight)
-*. PNAME='TANG' VAL=Text ANGle
-*. PNAME='TXFP' VAL=10*(TeXt Font) + (TeXt Precision)
-*. PNAME='TMSI' VAL=Tick Marks SIze (in WC)
-*. PNAME='LASI' VAL=LAbels SIze (in WC)
-*. PNAME='LAOF' VAL=LAbels OFfset
-*. PNAME='PASS' VAL=IGTEXT Width
-*. PNAME='CSHI' VAL=IGTEXT Shift
-*. PNAME='BORD' VAL=Border for IGBOX, IGFBOX and IGARC (0=No , 1=Yes)
-*. PNAME='BARO' VAL=IGHIST or IGRAPH BAR charts Offset (%)
-*. PNAME='BARW' VAL=IGHIST or IGRAPH BAR charts Width (%)
-*. PNAME='AWLN' VAL=Axis Wire LeNght
-*. PNAME='NLIN' VAL=Number of lines for 3D shapes.
-*.
-*. PNAME='*' All the default values are reset
-*. PNAME='PICT' VAL=Starting number for automatic naming of RZ pictures
-*. PNAME='AURZ' VAL=Automatic saving of pictures
-*. PNAME='SHOW' Shows the current values of the IGSET parameters
-*. PNAME='DIME' VAL=2D or 3D
-*. PNAME='NCOL' VAL=Number of entry in the COLor map.
-*. PNAME='DRMD' VAL=Drawing mode: 1.=copy 2.=xor
-*. PNAME='SYNC' VAL=Synchronise the graphics in X11 1.=yes 0.=no
-*. PNAME='CLIP' VAL=Clipping mode: 1.=on 0.=off
-*. PNAME='2BUF' VAL=10*(WKID)+(double buffer mode: 1.=on 0.=off)
-*. PNAME='ZBUF' VAL=Z-buffer mode: 1.=on 0.=off
-*.
-*. How to add an HIGZ attribute:
-*.
-*. .In HIATT: add a variable to store the attribute and
-*. supress one word in REAATT, if the attribute is REAL,
-*. or in INTATT if the attribute is INTEGER.
-*.
-*. .In HIATNB: increment by one NBRATT, if the attribute is REAL,
-*. or NBIATT if the attribute is INTEGER.
-*.
-*. .In HIATNM: add the IGSET name of the attribute in CHRATT,
-*. if the attribute is REAL, or in CHIATT, if the attribute
-*. is INTEGER.
-*.
-*. .In HIFLAT: add a variable to store the attribute flag and
-*. supress one word in KRFLAG, if the attribute is REAL,
-*. or in KIFLAG if the attribute is INTEGER
-*.
-*. .In HICODE: add a parameter to store the attribute code IATTCO.
-*. ( 49 < IATTCO < 80, if the attribute is REAL)
-*. ( 79 < IATTCO < 110 if the attribute is INTEGER)
-*.
-*. .Modify IGSET to take care about this attribute.
-*.
-*..==========> (O.Couet)
-#include "higz/hiatt.inc"
-#include "higz/hiflag.inc"
-#include "higz/hicode.inc"
-#include "higz/hilun.inc"
-#include "higz/hilut.inc"
- CHARACTER*4 PNAME
- CHARACTER*6 PZNAME
- CHARACTER*30 COMM
- REAL IGSET1
-*.______________________________________
-*
- VAL=RVAL
- IF(PNAME(1:4).EQ.'FAIS')THEN
- CALL ISFAIS(INT(VAL))
- RETURN
- ENDIF
- IF(PNAME(1:4).EQ.'FASI')THEN
- CALL ISFASI(INT(VAL))
- RETURN
- ENDIF
- IF(PNAME(1:4).EQ.'LTYP')THEN
- CALL ISLN(INT(VAL))
- RETURN
- ENDIF
- IF(PNAME(1:4).EQ.'BASL')THEN
- VAL=IGSET1(VAL)
- RBSL=VAL
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_MAIL)
- IF(GLFLAG)CALL IZATT(IBSLCO)
-#endif
- RETURN
- ENDIF
- IF(PNAME(1:4).EQ.'LWID')THEN
- VAL=IGSET1(VAL)
- CALL ISLWSC(VAL)
- RETURN
- ENDIF
- IF(PNAME(1:4).EQ.'MTYP')THEN
- CALL ISMK(INT(VAL))
- RETURN
- ENDIF
- IF(PNAME(1:4).EQ.'MSCF')THEN
- VAL=IGSET1(VAL)
- CALL ISMKSC(VAL)
- RETURN
- ENDIF
- IF(PNAME(1:4).EQ.'PLCI')THEN
- VAL=IGSET1(VAL)
- CALL ISPLCI(INT(VAL))
- RETURN
- ENDIF
- IF(PNAME(1:4).EQ.'PMCI')THEN
- VAL=IGSET1(VAL)
- CALL ISPMCI(INT(VAL))
- RETURN
- ENDIF
- IF(PNAME(1:4).EQ.'FACI')THEN
- VAL=IGSET1(VAL)
- CALL ISFACI(INT(VAL))
- RETURN
- ENDIF
- IF(PNAME(1:4).EQ.'TXCI')THEN
- VAL=IGSET1(VAL)
- CALL ISTXCI(INT(VAL))
- RETURN
- ENDIF
- IF(PNAME(1:4).EQ.'TXAL')THEN
- VAL=IGSET1(VAL)
- ITXA1=NINT(VAL/10.)
- ITXA2=NINT(VAL-10*ITXA1)
- CALL ISTXAL(ITXA1,ITXA2)
- RETURN
- ENDIF
- IF(PNAME(1:4).EQ.'CHHE')THEN
- VAL=IGSET1(VAL)
- CALL ISCHH(VAL)
- RETURN
- ENDIF
- IF(PNAME(1:4).EQ.'TANG')THEN
- CALL ISCHUP(COS(((VAL+90.)*3.14159)/180.)
- +, SIN(((VAL+90.)*3.14159)/180.))
- RETURN
- ENDIF
- IF(PNAME(1:4).EQ.'TXFP')THEN
- CALL ISTXFP(INT(VAL/10.)
- +, ABS(INT(VAL-10*INT(VAL/10.))))
- RETURN
- ENDIF
- IF(PNAME(1:4).EQ.'TMSI')THEN
- IF(VAL.EQ.RTMS)RETURN
- RTMS=VAL
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_MAIL)
- IF(GLFLAG)CALL IZATT(ITMSCO)
-#endif
- RETURN
- ENDIF
- IF(PNAME(1:4).EQ.'LASI')THEN
- VAL=IGSET1(VAL)
- IF(VAL.EQ.RALH)RETURN
- RALH=VAL
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_MAIL)
- IF(GLFLAG)CALL IZATT(IALHCO)
-#endif
- RETURN
- ENDIF
- IF(PNAME(1:4).EQ.'LAOF')THEN
- IF(VAL.EQ.RALD)RETURN
- RALD=VAL
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_MAIL)
- IF(GLFLAG)CALL IZATT(IALDCO)
-#endif
- RETURN
- ENDIF
- IF(PNAME(1:4).EQ.'PASS')THEN
- VAL=IGSET1(VAL)
- IF(INT(VAL).EQ.INPASS)RETURN
- INPASS=INT(VAL)
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_MAIL)
- IF(GLFLAG)CALL IZATT(IGTWCO)
-#endif
- RETURN
- ENDIF
- IF(PNAME(1:4).EQ.'CSHI')THEN
- VAL=IGSET1(VAL)
- IF(VAL.EQ.RCSHIF)RETURN
- RCSHIF=VAL
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_MAIL)
- IF(GLFLAG)CALL IZATT(IGTSCO)
-#endif
- RETURN
- ENDIF
- IF(PNAME(1:4).EQ.'BORD')THEN
- IF(INT(VAL).EQ.IBORD)RETURN
- IF(VAL.LT.0.)VAL=0.
- IF(VAL.GT.1.)VAL=1.
- IBORD=INT(VAL)
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_MAIL)
- IF(GLFLAG)CALL IZATT(IBORCO)
-#endif
- RETURN
- ENDIF
- IF(PNAME(1:4).EQ.'BARO')THEN
- IF(ABS(VAL).GT.1.)THEN
- CALL IGERR('BARO must verify -1. < "BARO" < 1.','IGSET')
- RETURN
- ENDIF
- RBOF=VAL
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_MAIL)
- IF(GLFLAG)CALL IZATT(IBOFCO)
-#endif
- RETURN
- ENDIF
- IF(PNAME(1:4).EQ.'BARW')THEN
- VAL=IGSET1(VAL)
- IF((VAL.GT.1.).OR.(VAL.LT.0.))THEN
- CALL IGERR('BARW must verify 0. < "BARW" < 1.','IGSET')
- RETURN
- ENDIF
- RBWD=VAL
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_MAIL)
- IF(GLFLAG)CALL IZATT(IBWDCO)
-#endif
- RETURN
- ENDIF
- IF(PNAME(1:4).EQ.'NLIN')THEN
- IF(INT(VAL).EQ.INLINE)RETURN
- INLINE=INT(IGSET1(VAL))
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_MAIL)
- IF(GLFLAG)CALL IZATT(INLICO)
-#endif
- RETURN
- ENDIF
- IF(PNAME(1:4).EQ.'PICT')THEN
- VAL=IGSET1(VAL)
- IPICT=INT(VAL)
- RETURN
- ENDIF
- IF(PNAME(1:4).EQ.'DIME')THEN
- IF((VAL.NE.2.).AND.(VAL.NE.3.))THEN
- CALL IGERR('DIME = 2 or DIME = 3','IGSET')
- RETURN
- ENDIF
- IDIM=INT(VAL)
- RETURN
- ENDIF
- IF(PNAME(1:4).EQ.'AURZ')THEN
- VAL=IGSET1(VAL)
- IF(VAL.NE.0.)THEN
- ASFLAG=.TRUE.
- ELSE
- ASFLAG=.FALSE.
- ENDIF
- RETURN
- ENDIF
- IF(PNAME(1:4).EQ.'AWLN')THEN
- RAWL=VAL
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_MAIL)
- IF(GLFLAG)CALL IZATT(IAWLCO)
-#endif
- RETURN
- ENDIF
- IF(PNAME(1:4).EQ.'NCOL')THEN
- VAL=IGSET1(VAL)
- IF(VAL.LE.0.)VAL=8.
- INBCOL=INT(VAL)
- IF(INBCOL.LE.NBCLUT.AND.INBCOL.GT.8)THEN
- DCOL=1./(INBCOL-8)
- DO 10 I=8,INBCOL
- GREY=1.-DCOL*(I-8)
- CALL ISCR(1,I,GREY,GREY,GREY)
- 10 CONTINUE
- ENDIF
- RETURN
- ENDIF
- IF(PNAME(1:4).EQ.'DRMD')THEN
-#if defined(CERNLIB_X11)
- CALL IXDRMDE(INT(VAL))
-#endif
- RETURN
- ENDIF
- IF(PNAME(1:4).EQ.'SYNC')THEN
-#if defined(CERNLIB_X11)
- CALL IXSYNC(INT(VAL))
-#endif
- RETURN
- ENDIF
- IF(PNAME(1:4).EQ.'CLIP')THEN
- CALL ISCLIP(INT(VAL))
- RETURN
- ENDIF
- IF(PNAME(1:4).EQ.'2BUF')THEN
-#if defined(CERNLIB_X11)
- IWID2B = INT(VAL/10.)
- IF(IWID2B.EQ.0)THEN
- I2BUF = MOD(INT(VAL),10)
- CALL IXS2BUF(999,I2BUF)
- RETURN
- ENDIF
- ITY = IGIWTY(IWID2B)
- IF(ITY.GT.0)THEN
- IF(ITY.EQ.7878.OR.ITY.EQ.7879)RETURN
- I2BUF = MOD(INT(VAL),10)
- IWIN = IWINID(IGIWIN(IWID2B))
- CALL IXS2BUF(IWIN,I2BUF)
- ENDIF
-#endif
- RETURN
- ENDIF
- IF(PNAME(1:4).EQ.'ZBUF')THEN
- IZBUF = INT(VAL)
- RETURN
- ENDIF
- IF(PNAME(1:1).EQ.'*')THEN
- CALL ISFAIS(0)
- CALL ISFASI(1)
- CALL ISLN(1)
- CALL ISLWSC(1.)
- CALL ISMK(1)
- CALL ISMKSC(1.)
- CALL ISPLCI(1)
- CALL ISPMCI(1)
- CALL ISFACI(1)
- CALL ISTXAL(0,0)
- CALL ISCHH(0.28)
- CALL ISCHUP(0.,1.)
- CALL ISTXCI(1)
- CALL ISTXFP(0,2)
- CALL ISCLIP(1)
- IBORD=0
- INPASS=1
- RCSHIF=0.02
- RALH=0.018
- RALD=0.013
- RTMS=0.019
- RBSL=0.01
- RBOF=0.25
- RBWD=0.5
- RAWL=0.0
- IDIM=2
- INLINE=40
- INBCOL=8
- IZBUF=0
- RETURN
- ENDIF
- IF(PNAME(1:4).EQ.'SHOW')THEN
- CALL IGSA(0)
- WRITE(LUNOUT,10100)
- WRITE(LUNOUT,10000)
- WRITE(LUNOUT,10200)
- WRITE(LUNOUT,10300)
- WRITE(LUNOUT,10200)
- PZNAME='FAIS '
- COMM='Fill area interior style'
- WRITE(LUNOUT,10400) PZNAME,IFAIS,0,COMM
- PZNAME='FASI '
- COMM='Fill area style index'
- WRITE(LUNOUT,10400) PZNAME,IFASI,1,COMM
- PZNAME='LTYP '
- COMM='Line type'
- WRITE(LUNOUT,10400) PZNAME,ILN,1,COMM
- PZNAME='BASL '
- COMM='Basic segment length (NDC)'
- WRITE(LUNOUT,10500) PZNAME,RBSL,0.01,COMM
- PZNAME='LWID '
- COMM='Line width'
- WRITE(LUNOUT,10500) PZNAME,RLWSC,1.,COMM
- PZNAME='MTYP '
- COMM='Marker type'
- WRITE(LUNOUT,10400) PZNAME,IMK,1,COMM
- PZNAME='MSCF '
- COMM='Marker scale factor'
- WRITE(LUNOUT,10500) PZNAME,RMKSC,1.,COMM
- PZNAME='PLCI '
- COMM='Polyline color index'
- WRITE(LUNOUT,10400) PZNAME,IPLCI,1,COMM
- PZNAME='PMCI '
- COMM='Polymarker color index'
- WRITE(LUNOUT,10400) PZNAME,IPMCI,1,COMM
- PZNAME='FACI '
- COMM='Fill area color index'
- WRITE(LUNOUT,10400) PZNAME,IFACI,1,COMM
- PZNAME='TXCI '
- COMM='Text color index'
- WRITE(LUNOUT,10400) PZNAME,ITXCI,1,COMM
- PZNAME='TXAL '
- COMM='Text alignment'
- WRITE(LUNOUT,10600) PZNAME,ITXALH,ITXALV,0,0,COMM
- PZNAME='CHHE '
- COMM='Character height'
- WRITE(LUNOUT,10500) PZNAME,RCHH,0.28,COMM
- PZNAME='TANG '
- COMM='Text angle'
- ANGLE=((ACOS(RCHUX/SQRT(RCHUX**2+RCHUY**2))*180.)
- + /3.14159)-90.
- IF(RCHUY.LT.0)ANGLE=360.-ANGLE
- WRITE(LUNOUT,10500) PZNAME,ANGLE,0.,COMM
- PZNAME='TXFP '
- COMM='Text font and precision'
- WRITE(LUNOUT,10600) PZNAME,IFONT,IPREC,0,2,COMM
- PZNAME='PICT '
- COMM='Current automatic number'
- WRITE(LUNOUT,10400) PZNAME,IPICT,1,COMM
- PZNAME='BORD '
- COMM='Border flag'
- WRITE(LUNOUT,10400) PZNAME,IBORD,0,COMM
- PZNAME='PASS '
- COMM='Number of pass in IGTEXT'
- WRITE(LUNOUT,10400) PZNAME,INPASS,1,COMM
- PZNAME='CSHI '
- COMM='IGTEXT shift'
- WRITE(LUNOUT,10500) PZNAME,RCSHIF,0.02,COMM
- PZNAME='LASI '
- COMM='Label axis size'
- WRITE(LUNOUT,10500) PZNAME,RALH,0.018,COMM
- PZNAME='LAOF '
- COMM='Label axis offset'
- WRITE(LUNOUT,10500) PZNAME,RALD,0.013,COMM
- PZNAME='TMSI '
- COMM='Tick marks size'
- WRITE(LUNOUT,10500) PZNAME,RTMS,0.019,COMM
- PZNAME='AWLN '
- COMM='Axis wire lenght'
- WRITE(LUNOUT,10500) PZNAME,RAWL,0.,COMM
- PZNAME='BARO '
- COMM='Offset of IGHIST (IGRAPH) bars'
- WRITE(LUNOUT,10500) PZNAME,RBOF,0.25,COMM
- PZNAME='BARW '
- COMM='Width of IGHIST (IGRAPH) bars'
- WRITE(LUNOUT,10500) PZNAME,RBWD,0.5,COMM
- PZNAME='NCOL '
- COMM='Number of COLors'
- WRITE(LUNOUT,10400) PZNAME,INBCOL,8,COMM
- PZNAME='CLIP '
- COMM='Clipping mode'
- WRITE(LUNOUT,10400) PZNAME,ICLIP,1,COMM
- PZNAME='NLIN '
- COMM='Number of line for 3D shapes'
- WRITE(LUNOUT,10400) PZNAME,INLINE,40,COMM
- PZNAME='AURZ '
- COMM='Automatic saving flag'
- I=0
- IF(ASFLAG)I=1
- WRITE(LUNOUT,10400) PZNAME,I,0,COMM
- PZNAME='DIME '
- COMM='Dimension used (2D or 3D)'
- WRITE(LUNOUT,10400) PZNAME,IDIM,2,COMM
- PZNAME='ZBUF '
- COMM='Z-Buffer (1=on or 0=off)'
- WRITE(LUNOUT,10400) PZNAME,IZBUF,0,COMM
- WRITE(LUNOUT,10200)
- RETURN
- ENDIF
- CALL IGERR('Unavailable option','IGSET')
-*
-10000 FORMAT(1X,'|',24X,'IGSET : Current values in use',24X,'|')
-10100 FORMAT(1X,'+',77(1H-),'+')
-10200 FORMAT(1X,'+',13(1H-),'+',15(1H-),'+',15(1H-),'+',31(1H-),'+')
-10300 FORMAT(1X,'| Parameter | Current value | Default value '
- +, '| Explanation |')
-10400 FORMAT(' |',4X,A,' |',I8,' | ',I8
- +,' | ',A,'|')
-10500 FORMAT(' |',4X,A,' | ',F9.3,' | ',F9.3
- +,' | ',A,'|')
-10600 FORMAT(' |',4X,A,' |',I8,I3,' | ',I8,I3
- +,' | ',A,'|')
-*
- END
diff --git a/src/graflib/higz/ig/igset1.F b/src/graflib/higz/ig/igset1.F
deleted file mode 100644
index 00ae60c..0000000
--- a/src/graflib/higz/ig/igset1.F
+++ /dev/null
@@ -1,30 +0,0 @@
-*
-* $Id: igset1.F,v 1.1.1.1 1996/02/14 13:10:38 mclareni Exp $
-*
-* $Log: igset1.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:38 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.06/03 09/12/88 10.33.39 by O.Couet
-*-- Author :
- REAL FUNCTION IGSET1(VALUE)
-*.===========>
-*.
-*. Underlaying for IGSET
-*.
-*. _Input parameters:
-*.
-*. REAL VALUE : Parameter value .
-*.
-*..==========> (O.Couet)
- RVALUE=VALUE
- IGSET1=RVALUE
- IF(RVALUE.LT.0)THEN
- CALL IGERR('Warning: Negative value (ABS is taken)','IGSET')
- IGSET1=ABS(RVALUE)
- ENDIF
-*
- END
-
diff --git a/src/graflib/higz/ig/igsrap.F b/src/graflib/higz/ig/igsrap.F
deleted file mode 100644
index 86d7f5d..0000000
--- a/src/graflib/higz/ig/igsrap.F
+++ /dev/null
@@ -1,70 +0,0 @@
-*
-* $Id: igsrap.F,v 1.1.1.1 1996/02/14 13:10:38 mclareni Exp $
-*
-* $Log: igsrap.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:38 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.14/11 26/06/92 14.55.46 by O.Couet
-*-- Author : O.Couet 26/10/88
- SUBROUTINE IGSRAP(R)
-*.===========>
-*.
-*. This routine allows to change the REDIT factor.
-*.
-*. _Input parameters:
-*.
-*. REAL R : New REDIT factor (If R.GE.0)
-*.
-*. _Output parameters:
-*.
-*. REAL R : Current REDIT factor (If R.LT.0)
-*.
-*..==========> (O.Couet)
-#if (defined(CERNLIB_KERNEL))&&(!defined(CERNLIB_BATCH))
-#include "higz/hikern.inc"
-#endif
-#if defined(CERNLIB_MAIL)
-#include "higz/himail.inc"
-#endif
-#if defined(CERNLIB_MAIL)
-#include "higz/hiflag.inc"
-#endif
-#include "higz/hiatt.inc"
-*.______________________________________
-*
-#if defined(CERNLIB_MAIL)
-*
- IF(MFLAG)THEN
- WRITE (CHMAIL,'(I3,E16.7)') 558,R
- CALL IMWRIT(1)
- IF(R.LT.0)READ (5,'(E16.7)') R
- CALL IMWRIT(5)
- RETURN
- ENDIF
-#endif
-*
- IF(R.LT.0)THEN
- R=REDIT
- RETURN
- ELSE
- REDIT=R
- IF(REDIT.EQ.1.)REDIT=0.
- ENDIF
-#if (defined(CERNLIB_KERNEL))&&(!defined(CERNLIB_BATCH))
-*
- DO 10 I=1,INOPWK
- WKSC(I)=REDIT
- IF(WKSC(I).LE.0)WKSC(I)=1.
- WKSC(I)=WKSC(I)*WKMAX(I)
-#endif
-#if defined(CERNLIB_X11)
- CALL IKUWK(ILOPWK(I))
-#endif
-#if (defined(CERNLIB_KERNEL))&&(!defined(CERNLIB_BATCH))
- 10 CONTINUE
-#endif
-*
- END
diff --git a/src/graflib/higz/ig/igsse.F b/src/graflib/higz/ig/igsse.F
deleted file mode 100644
index 390c971..0000000
--- a/src/graflib/higz/ig/igsse.F
+++ /dev/null
@@ -1,289 +0,0 @@
-*
-* $Id: igsse.F,v 1.1.1.1 1996/02/14 13:10:39 mclareni Exp $
-*
-* $Log: igsse.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:39 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.23/02 30/08/95 09.30.50 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE IGSSE(ERRFIL,WTYPE)
-*.===========>
-*.
-*. This routine initializes the standart graphic package environment .
-*.
-*. _Input parameters:
-*.
-*. INTEGER ERRFIL : Error file LUN .
-*. INTEGER WTYPE : Workstation type .
-*.
-*. The screen size is returned in IQUEST(11) and IQUEST(12) .
-*.
-*..==========> (O.Couet)
-#include "higz/hiques.inc"
-#include "higz/hiflag.inc"
-#include "higz/hiatt.inc"
-#include "higz/himeta.inc"
-#if defined(CERNLIB_MAIL)
-#include "higz/himail.inc"
-#endif
-#if defined(CERNLIB_MSDOS)
-#include "higz/hikern.inc"
-#endif
-#if defined(CERNLIB_DI3000)
- INTEGER*4 MAXDEV
- PARAMETER (MAXDEV = 9)
- INTEGER*4 DEVICES(0:MAXDEV)
- EQUIVALENCE (ILOPWK,DEVICES)
- DIMENSION LIST(4)
- REAL MAXDIM(4)
- LOGICAL PHYS
-#endif
- INTEGER ERRFIL,WKID,CONID,WTYPE
- LOGICAL ZFSAV
- DIMENSION RVAL(2)
-*.______________________________________
-*
-#if defined(CERNLIB_MAIL)
-*
-* Mail option
-*
- IF((WTYPE.LT.0) .AND.(WTYPE.NE.-111).AND.
- + (WTYPE.NE.-112).AND.(WTYPE.NE.-113))THEN
- GFLAG=.FALSE.
- ZFLAG=.FALSE.
- PFLAG=.FALSE.
- MFLAG=.TRUE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- WRITE (CHMAIL,'(I3,I5,I10)') 100,ERRFIL,-WTYPE
- CALL IMWRIT(1)
- READ (5,'(2E16.7)') RQUEST(11),RQUEST(12)
- CALL IMWRIT(5)
- RETURN
- ENDIF
-#endif
-*
- GFLAG =.TRUE.
- ZFSAV =ZFLAG
- ZFLAG =.FALSE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- IQUEST(100)=-1
-#if defined(CERNLIB_ATCGKS)
- CALL KNOMSG
-#endif
- IWTYPE=IABS(WTYPE)
- IF(IWTYPE.LE.0)TEKACT=.FALSE.
- IDTY=IWTYPE
-#if defined(CERNLIB_DI3000)
- IDID=IWTYPE
- WKID=IWTYPE
-#endif
-#if !defined(CERNLIB_DI3000)
- WKID=1
-#endif
- CALL IOPKS(ERRFIL)
-#if defined(CERNLIB_DECGKS)
- CONID=0
-#endif
-#if defined(CERNLIB_KERNEL)||defined(CERNLIB_FALCO)||defined(CERNLIB_PHIGS)||defined(CERNLIB_GKSBX)
- CONID=1
-#endif
-#if (defined(CERNLIB_GKSGRAL)||defined(CERNLIB_UNIGKS)||defined(CERNLIB_PLOT10GKS)||defined(CERNLIB_MGKS)||defined(CERNLIB_ATCGKS))&&(!defined(CERNLIB_GKSIBM))
- CONID=1
-#endif
-#if defined(CERNLIB_GKSIBM)
- CONID=-1
-#endif
-#if (defined(CERNLIB_GKSGRAL))&&(defined(CERNLIB_IBM))
- IF(WTYPE.LT.0)CONID=101
-#endif
-#if (defined(CERNLIB_GKSGRAL))&&(defined(CERNLIB_ALLIANT))
- IF(WTYPE.GT.0)CONID=6
-#endif
-#if (defined(CERNLIB_GKSGRAL))&&(defined(CERNLIB_NEWLIB))
- IF (WTYPE.GT.470000) THEN
- CONID=MOD(WTYPE,100)
- WTYPE=WTYPE/100
- ENDIF
- IF (WTYPE.EQ.7878) CONID=11
- IF (WTYPE.EQ.13001.OR.WTYPE.EQ.13002) CONID=101
- IWTYPE=WTYPE
- IDTY=IWTYPE
-#endif
-#if defined(CERNLIB_SUNGKS)
- IF(IWTYPE.EQ.3.OR.IWTYPE.EQ.6.OR.IWTYPE.EQ.7.OR.
- + IWTYPE.EQ.8.OR.IWTYPE.EQ.10)CONID=9
- IF(IWTYPE.EQ.4)CONID=0
-#endif
-#if !defined(CERNLIB_DI3000)
- IF(IWTYPE.GT.0)THEN
- CALL IOPWK(WKID,CONID,IWTYPE)
- CALL IACWK(WKID)
- CALL IGQWK(WKID,'MXDS',RVAL)
- IF((RMDSX.LT.0).OR.(RMDSY.LT.0))THEN
- CALL IGERR('Invalid workstation type','IGSSE')
- RETURN
- ENDIF
- ENDIF
- RDVXMI=0.
- RDVYMI=0.
- RDVXMA=RMDSX
- RDVYMA=RMDSY
- IF(IWTYPE.GT.0)THEN
- GRFLAG=.TRUE.
- RQUEST(11)=RMDSX
- RQUEST(12)=RMDSY
-#endif
-#if defined(CERNLIB_MSDOS)
- ISTEP = 4
- IXLOCO = 0
- IYLOCO = 0
- MOUSE = .FALSE.
- IF(INIT_MOUSE().GT.0)MOUSE=.TRUE.
- RDWXMI = 0.0
- RDWYMI = 0.0
- IF(WINSIZ(3).GE.WINSIZ(4))THEN
- RDWXMA = 1.0
- RDWYMA = RMDSY/RMDSX
- ELSE
- RDWYMA = 1.0
- RDWXMA = RMDSX/RMDSY
- ENDIF
-#endif
-#if !defined(CERNLIB_DI3000)
- CALL ISWKWN(1,RDWXMI,RDWXMA,RDWYMI,RDWYMA)
- CALL ISWKVP(1,RDVXMI,RDVXMA,RDVYMI,RDVYMA)
- ENDIF
-#endif
-#if defined(CERNLIB_DI3000)
- CONID=1
- CALL IOPWK(WKID,CONID,IWTYPE)
- CALL IACWK(WKID)
-*
-* Determine if the device is capable of physical sizing and
-* the physical size of the viewport
-*
- IF (WKID.NE.0) THEN
- CALL JIQDIM(WKID,PHYS,MAXDIM)
- RDVXMI=MAXDIM(1)
- RDVXMA=MAXDIM(2)
- RDVYMI=MAXDIM(3)
- RDVYMA=MAXDIM(4)
- ELSE
- CALL JIQDEV(WKID,20,LIST)
- RDVXMI=FLOAT(LIST(1))
- RDVXMA=FLOAT(LIST(2))
- RDVYMI=FLOAT(LIST(3))
- RDVYMA=FLOAT(LIST(4))
- ENDIF
-*
-* Set the orientation of the maximums returned since not all
-* devices refer to the lower left as x0phy, y0phy and upper right
-* as x1phy, y1phy.
-*
- IF (RDVXMI.GT.RDVXMA) THEN
- TEMP=RDVXMI
- RDVXMI=RDVXMA
- RDVXMA=TEMP
- ENDIF
- IF (RDVYMI .GT. RDVYMA) THEN
- TEMP=RDVYMI
- RDVYMI=RDVYMA
- RDVYMA=TEMP
- ENDIF
-*
-* Maximum display surface size
-*
- RMDSX=RDVXMA-RDVXMI
- RMDSY=RDVYMA-RDVYMI
- GRFLAG=.TRUE.
- RQUEST(11)=RDVXMA
- RQUEST(12)=RDVYMA
-*
- CALL JASPEK(WKID, RATIO)
- IF (RATIO .LE. 1.0) THEN
- RDWXMI=0.0
- RDWXMA=1.0
- RDWYMI=0.0
- RDWYMA=RATIO
- ELSE
- RDWXMI=0.0
- RDWXMA=1.0/RATIO
- RDWYMI=0.0
- RDWYMA=1.0
- ENDIF
- CALL ISWKWN(WKID,RDWXMI,RDWXMA,RDWYMI,RDWYMA)
- IF(WKID.NE.0)CALL ISWKVP(WKID,RDVXMI,RDVXMA,RDVYMI,RDVYMA)
-*
- IF((RDVXMA.LE.0).OR.(RDVYMA.LE.0))THEN
- CALL IGERR('Bad workstation type','IGSSE')
- RETURN
- ENDIF
-*
- CALL JDCOLR(0)
- CALL JDINTE(16383)
- CALL JDLSTY(0)
- CALL JDLWID(16383)
- CALL JDPEN(0)
- CALL JDPEDG(0)
- CALL JDPINT(0)
- CALL JDPIDX(0,0)
- IF(WKID.NE.0)CALL JPFSIM(WKID,1)
- CALL JDMARK(IMK)
- CALL JWCLIP(ICLIP.EQ.1)
-#endif
-#if defined(CERNLIB_GKS)
-*
- CALL GSCHH(RCHH)
- CALL GSCHUP(RCHUX,RCHUY)
- CALL GSTXAL(ITXALH,ITXALV)
- CALL GSFAIS(IFAIS)
- CALL GSMK(IMK)
- CALL GSLN(ILN)
- CALL GSLWSC(RLWSC)
- CALL GSPLCI(IPLCI)
- CALL GSPMCI(IPMCI)
- CALL GSFACI(IFACI)
- CALL GSTXCI(ITXCI)
- CALL GSCLIP(ICLIP)
-#endif
-#if (defined(CERNLIB_GKS))&&(!defined(CERNLIB_MGKS))
- CALL GSFASI(IFASI)
- CALL GSMKSC(RMKSC)
-#endif
-#if defined(CERNLIB_KERNEL)||defined(CERNLIB_SUNGKS)||defined(CERNLIB_GKSBX)
-*
-* Initialize the begining of the color table
-*
- GRFLAG=.FALSE.
- IF(IWTYPE.GT.0)THEN
- CALL IGSG(1)
- CALL ISCR(WKID,0,1.,1.,1.)
- CALL ISCR(WKID,1,0.,0.,0.)
- CALL ISCR(WKID,2,1.,0.,0.)
- CALL ISCR(WKID,3,0.,1.,0.)
- CALL ISCR(WKID,4,0.,0.,1.)
- CALL ISCR(WKID,5,1.,1.,0.)
- CALL ISCR(WKID,6,1.,0.,1.)
- CALL ISCR(WKID,7,0.,1.,1.)
-#endif
-#if defined(CERNLIB_MSDOS)
- CALL ISCR(WKID, 7,0.0,0.0,0.0)
- CALL ISCR(WKID, 8,0.5,0.5,0.5)
- CALL ISCR(WKID, 9,0.0,0.5,0.5)
- CALL ISCR(WKID,10,0.5,0.0,0.0)
- CALL ISCR(WKID,11,0.0,0.5,0.0)
- CALL ISCR(WKID,12,0.0,0.0,0.5)
- CALL ISCR(WKID,13,0.5,0.5,0.0)
- CALL ISCR(WKID,14,1.0,0.0,0.5)
- CALL ISCR(WKID,15,0.0,1.0,1.0)
-#endif
-#if defined(CERNLIB_KERNEL)||defined(CERNLIB_SUNGKS)||defined(CERNLIB_GKSBX)
- ENDIF
-#endif
- ZFLAG =ZFSAV
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
-*
- END
diff --git a/src/graflib/higz/ig/igstr.F b/src/graflib/higz/ig/igstr.F
deleted file mode 100644
index df15fee..0000000
--- a/src/graflib/higz/ig/igstr.F
+++ /dev/null
@@ -1,93 +0,0 @@
-*
-* $Id: igstr.F,v 1.1.1.1 1996/02/14 13:10:39 mclareni Exp $
-*
-* $Log: igstr.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:39 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.14/00 05/02/92 18.55.08 by O.Couet
-*-- Author : O.Couet 07/01/92
- SUBROUTINE IGSTR(ISTID,CHOPT)
-*.===========>
-*.
-*. This routine allows to manage PHIGS structures. If HIGZ
-*. is build without PHIGS, it just do nothing.
-*.
-*. _Input parameters:
-*.
-*. INTEGER IST : Structure identifier
-*. CHARACTER CHOPT : Option
-*.
-*. 'O' open structure ISTID
-*. 'N' open structure with name set
-*. 'C' close structure
-*. 'E' append structure ISTID in the current opened structure
-*. 'D' delete all structures
-*. 'P' post the structure on the active workstations
-*.
-*..==========> (O.Couet)
- CHARACTER*(*) CHOPT
-#if defined(CERNLIB_PHIGS)
-#include "higz/hiatt.inc"
-#include "higz/hiphig.inc"
- DIMENSION IOPT(6)
- EQUIVALENCE (IOPTO,IOPT(1)),(IOPTN,IOPT(2))
- EQUIVALENCE (IOPTC,IOPT(3)),(IOPTE,IOPT(4))
- EQUIVALENCE (IOPTD,IOPT(5)),(IOPTP,IOPT(6))
- COMMON /NAMESET/ NSNO
-*.______________________________________
-*
- CALL UOPTC(CHOPT,'ONCEDP',IOPT)
-*
- IF(IDIM.NE.3)RETURN
-*
-* Open a new structure ISTID
-*
- IF(IOPTO.NE.0)THEN
- CALL POPST(ISTID)
- LOSTOP=.TRUE.
- ENDIF
-*
-* Close the current opened structure (ISTID not used)
-*
- IF(IOPTC.NE.0)THEN
- CALL PCLST
- LOSTOP=.FALSE.
- ENDIF
-*
-* Extend the current opened structure with the stucture ISTID
-*
- IF (IOPTE.NE.0) THEN
- CALL PEXST(ISTID)
- ENDIF
-*
-* Open structure with name set
-*
- IF (IOPTN.NE.0) THEN
- CALL POPST(ISTID)
- CALL PADS(1,NSNO)
- NSNO=NSNO+1
- LOSTOP=.TRUE.
- ENDIF
-*
-* Post structure
-*
- IF(IOPTP.NE.0)THEN
- DO 10 I=1,INOPWK
- IF(IGIWTY(ILOPWK(I)).GT.0.AND.ACWKFL(I))THEN
- CALL PPOST(ILOPWK(I),ISTID,1.)
- ENDIF
- 10 CONTINUE
- ENDIF
-*
-* Delete all structures
-*
- IF(IOPTD.NE.0)THEN
- CALL PDAS
- LOSTEX=.FALSE.
- ENDIF
-*
-#endif
- END
diff --git a/src/graflib/higz/ig/igsvie.F b/src/graflib/higz/ig/igsvie.F
deleted file mode 100644
index 26759b8..0000000
--- a/src/graflib/higz/ig/igsvie.F
+++ /dev/null
@@ -1,67 +0,0 @@
-*
-* $Id: igsvie.F,v 1.1.1.1 1996/02/14 13:10:39 mclareni Exp $
-*
-* $Log: igsvie.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:39 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.23/06 24/11/95 09.57.08 by O.Couet
-*-- Author : O.Couet 31/05/94
- SUBROUTINE IGSVIE
-*.===========>
-*.
-*. This routine computes the 3D transformation according to
-*. the current 3D window and viewport. This routine is called
-*. by ISELNT.
-*.
-*..==========> (O.Couet)
-#include "higz/hi3d.inc"
-#include "higz/hctnor.inc"
-#if defined(CERNLIB_ZBUF)
-#include "higz/hiatt.inc"
-#endif
- DIMENSION RMIN(3),RMAX(3)
-*.______________________________________
-*
-#if defined(CERNLIB_ZBUF)
-#include "higz/hiwcdc.inc"
-#endif
- CALL IGNG3D(W3X1,W3X2,W3Y1,W3Y2,W3Z1,W3Z2
- +, PHI,THETA,PSI
- +, V3X1,V3X2,V3Y1,V3Y2)
- RMIN(1) = W3X1
- RMIN(2) = W3Y1
- RMIN(3) = W3Z1
- RMAX(1) = W3X2
- RMAX(2) = W3Y2
- RMAX(3) = W3Z2
-#if defined(CERNLIB_ZBUF)
- IF (IZBUF.NE.0) THEN
- IWKNB=1
- IZX = IXWCDC(V3X2)-IXWCDC(V3X1)
- IZY = IYWCDC(V3Y1)-IYWCDC(V3Y2)
- IZZ = MAX(IZX,IZY)
- CALL IHZINI(IZX,IZY,IZZ)
- CALL IHZWRD(V3X1,V3Y1,-1.,V3X2,V3Y2,1.)
- IFIRST = 1
- ENDIF
-#endif
- CALL IHSVIE(RMIN,RMAX,PHI,THETA,PSI,IREP)
- COEFX = (V3X2-V3X1)/2.
- AWNX = COEFX*TNORM(1,1)
- BWNX = COEFX*TNORM(2,1)
- CWNX = COEFX*TNORM(3,1)
- DWNX = COEFX+TNORM(4,1)+V3X1
- COEFY = (V3Y2-V3Y1)/2.
- AWNY = COEFY*TNORM(1,2)
- BWNY = COEFY*TNORM(2,2)
- CWNY = COEFY*TNORM(3,2)
- DWNY = COEFY+TNORM(4,2)+V3Y1
- AWNZ = TNORM(1,3)
- BWNZ = TNORM(2,3)
- CWNZ = TNORM(3,3)
- DWNZ = TNORM(4,3)
-*
- END
diff --git a/src/graflib/higz/ig/igtab1.F b/src/graflib/higz/ig/igtab1.F
deleted file mode 100644
index 107855e..0000000
--- a/src/graflib/higz/ig/igtab1.F
+++ /dev/null
@@ -1,55 +0,0 @@
-*
-* $Id: igtab1.F,v 1.1.1.1 1996/02/14 13:10:39 mclareni Exp $
-*
-* $Log: igtab1.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:39 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.09/00 07/12/89 16.18.00 by O.Couet
-*-- Author :
- INTEGER FUNCTION IGTAB1(ELEV1,ICONT1,X1,Y1,ELEV2,ICONT2,X2,Y2
- +, XARR,YARR,ITARR,NCONT)
-*.===========>
-*.
-*. Fill the matrix XARR YARR for Contour Plot
-*.
-*..==========> (O.Couet)
-#include "higz/hicont.inc"
- DIMENSION XARR(*),YARR(*),ITARR(*)
- LOGICAL VERT
-*.______________________________________
-*
- IF(X1.EQ.X2)THEN
- VERT=.TRUE.
- TLEN=Y2-Y1
- ELSE
- VERT=.FALSE.
- TLEN=X2-X1
- ENDIF
-*
- N=ICONT1+1
- TDIF=ELEV2-ELEV1
- I=1
- ICOUNT=0
- 10 IF(N.GT.ICONT2.OR.I.GT.102)GOTO 20
- ELEV=N*DZ/NCONT +ZMIN
- DIFF=ELEV-ELEV1
- PDIF=DIFF/TDIF
- XLEN=TLEN*PDIF
- IF(VERT)THEN
- XARR(I)=X1
- YARR(I)=Y1+XLEN
- ELSE
- XARR(I)=X1+XLEN
- YARR(I)=Y1
- ENDIF
- ITARR(I)=N
- ICOUNT=ICOUNT+1
- I=I+2
- N=N+1
- GOTO 10
- 20 IGTAB1=ICOUNT
-*
- END
diff --git a/src/graflib/higz/ig/igtab2.F b/src/graflib/higz/ig/igtab2.F
deleted file mode 100644
index 6fdd34e..0000000
--- a/src/graflib/higz/ig/igtab2.F
+++ /dev/null
@@ -1,125 +0,0 @@
-*
-* $Id: igtab2.F,v 1.1.1.1 1996/02/14 13:10:39 mclareni Exp $
-*
-* $Log: igtab2.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:39 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.22/08 24/02/95 17.12.10 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE IGTAB2(IA,IB,F,T)
-#include "higz/hipack.inc"
-#include "higz/hihid.inc"
-#include "higz/hicont.inc"
- DIMENSION F(3,4),T(4),IXADD(4),IYADD(4)
- REAL IGCELL
- DATA IXADD /0,1,1,0/
- DATA IYADD /0,0,1,1/
-*
- IXT = IA+IXFCHA(1)-1
- IYT = IB+IYFCHA(1)-1
-*
- XSTP2 = XSTP/2.
- YSTP2 = YSTP/2.
- IF(ILOGX.NE.0)THEN
- XLAB1L = LOG10(XLAB1)
- XLAB2L = LOG10(XLAB2)
- XVAL1L = LOG10(XVAL1)
- XVAL2L = LOG10(XVAL2)
- ELSE
- XLAB1L = XLAB1
- XLAB2L = XLAB2
- XVAL1L = XVAL1
- XVAL2L = XVAL2
- ENDIF
- IF(ILOGY.NE.0)THEN
- YLAB1L = LOG10(YLAB1)
- YLAB2L = LOG10(YLAB2)
- YVAL1L = LOG10(YVAL1)
- YVAL2L = LOG10(YVAL2)
- ELSE
- YLAB1L = YLAB1
- YLAB2L = YLAB2
- YVAL1L = YVAL1
- YVAL2L = YVAL2
- ENDIF
-*
- DO 10 I=1,4
- IXA = IXADD(I)
- IYA = IYADD(I)
-*
-* Compute the cell position in cartesian coordinates
-* and compute the LOG if necessary
-*
- F(1,I) = XLAB1+XSTP2+FLOAT(IA-1+IXA)*XSTP
- F(2,I) = YLAB1+YSTP2+FLOAT(IB-1+IYA)*YSTP
- IF(ILOGX.NE.0)THEN
- F(1,I) = LOG10(F(1,I))
- ENDIF
- IF(ILOGY.NE.0)THEN
- F(2,I) = LOG10(F(2,I))
- ENDIF
-*
-* Transform the cell position in the required coordinate system
-*
- IF(ISYS.EQ.2)THEN
- F(1,I) = 360.*(F(1,I)-XVAL1L)/(XVAL2L-XVAL1L)
- F(2,I) = (F(2,I)-YLAB1L)/(YLAB2L-YLAB1L)
- ELSEIF(ISYS.EQ.3)THEN
- F(1,I) = 360.*(F(1,I)-XVAL1L)/(XVAL2L-XVAL1L)
- ELSEIF(ISYS.EQ.4)THEN
- F(1,I) = 360.*(F(1,I)-XVAL1L)/(XVAL2L-XVAL1L)
- F(2,I) = 180.*(F(2,I)-YVAL1L)/(YVAL2L-YVAL1L)
- ELSEIF(ISYS.EQ.5)THEN
- F(1,I) = 360.*(F(1,I)-XVAL1L)/(XVAL2L-XVAL1L)
- F(2,I) = (180.-2.*DANG)*(F(2,I)-YVAL1L)/(YVAL2L-YVAL1L)+DANG
- ENDIF
-*
-* Get the content of the table. If the X index (ICX) is
-* greater than the X size of the table (NCX), that's mean
-* IGTABL tried to close the surface and in this case the
-* first channel should be used.
-*
- ICX = IXT+IXA
- IF(ICX.GT.NCX)ICX = 1
- IF(IPACK.NE.0)THEN
- F(3,I) = IGCELL(NCX,NCY,REFWRD(1),ICX,IYT+IYA,1)
- ELSE
- F(3,I) = IGCELL(NCX,NCY,REFWRD(IADRES(1)+1),ICX,IYT+IYA,1)
- ENDIF
-*
-* The colors on the surface can represent the content or
-* the errors.
-*
- IF (IOPTER.NE.0) THEN
- IF(IPACK.NE.0)THEN
- T(I) = IGCELL(NCX,NCY,REFWRD(1),ICX,IYT+IYA,2)
- ELSE
- T(I) = IGCELL(NCX,NCY,REFWRD(IADRES(1)+1),ICX,IYT+IYA,2)
- ENDIF
- ELSE
- T(I) = F(3,I)
- ENDIF
- 10 CONTINUE
-*
-* LOGZ is required...
-*
- IF(IDRGR.EQ.3)THEN
- DO 20 I=1,4
- IF(ILOG.NE.0.AND.ZMAXST.GT.0.)THEN
- F(3,I) = LOG10(ZMAXST)
- ELSE
- F(3,I) = ZMAXST
- ENDIF
- 20 CONTINUE
- ENDIF
-*
- IF(ISYS.GE.3)THEN
- DO 30 I=1,4
- F(3,I) = ((1.-RINRAD)*((F(3,I)-ZMIN)/(ZMAX-ZMIN)))+RINRAD
- 30 CONTINUE
- ENDIF
-*
- END
diff --git a/src/graflib/higz/ig/igtab3.F b/src/graflib/higz/ig/igtab3.F
deleted file mode 100644
index 334e96d..0000000
--- a/src/graflib/higz/ig/igtab3.F
+++ /dev/null
@@ -1,147 +0,0 @@
-*
-* $Id: igtab3.F,v 1.1.1.1 1996/02/14 13:10:39 mclareni Exp $
-*
-* $Log: igtab3.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:39 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.22/08 23/02/95 11.56.08 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE IGTAB3(IA,IB,NV,AB,VV,T)
-#include "higz/hipack.inc"
-#include "higz/hicont.inc"
-#include "higz/hihid.inc"
- DIMENSION AB(2,4),VV(*),T(4,*)
- REAL IGCELL
-*
- IXT = IA+IXFCHA(1)-1
- IYT = IB+IYFCHA(1)-1
-*
-* Compute the cell position in cartesian coordinates
-* and compute the LOG if necessary
-*
- AB(1,1) = XLAB1+(FLOAT(IA)-1.+RLEGBO)*XSTP
- AB(1,2) = AB(1,1)+XSTP*RLEGBW
- AB(2,1) = YLAB1+(FLOAT(IB)-1.+RLEGBO)*YSTP
- AB(2,3) = AB(2,1)+YSTP*RLEGBW
- IF(ILOGX.NE.0)THEN
- AB(1,1) = LOG10(AB(1,1))
- AB(1,2) = LOG10(AB(1,2))
- XLAB1L = LOG10(XLAB1)
- XLAB2L = LOG10(XLAB2)
- XVAL1L = LOG10(XVAL1)
- XVAL2L = LOG10(XVAL2)
- ELSE
- XLAB1L = XLAB1
- XLAB2L = XLAB2
- XVAL1L = XVAL1
- XVAL2L = XVAL2
- ENDIF
- IF(ILOGY.NE.0)THEN
- AB(2,1) = LOG10(AB(2,1))
- AB(2,3) = LOG10(AB(2,3))
- YLAB1L = LOG10(YLAB1)
- YLAB2L = LOG10(YLAB2)
- YVAL1L = LOG10(YVAL1)
- YVAL2L = LOG10(YVAL2)
- ELSE
- YLAB1L = YLAB1
- YLAB2L = YLAB2
- YVAL1L = YVAL1
- YVAL2L = YVAL2
- ENDIF
-*
-* Transform the cell position in the required coordinate system
-*
- IF(ISYS.EQ.2)THEN
- AB(1,1) = 360.*(AB(1,1)-XVAL1L)/(XVAL2L-XVAL1L)
- AB(1,2) = 360.*(AB(1,2)-XVAL1L)/(XVAL2L-XVAL1L)
- AB(2,1) = (AB(2,1)-YLAB1L)/(YLAB2L-YLAB1L)
- AB(2,3) = (AB(2,3)-YLAB1L)/(YLAB2L-YLAB1L)
- ELSEIF(ISYS.EQ.3)THEN
- AB(1,1) = 360.*(AB(1,1)-XVAL1L)/(XVAL2L-XVAL1L)
- AB(1,2) = 360.*(AB(1,2)-XVAL1L)/(XVAL2L-XVAL1L)
- ELSEIF(ISYS.EQ.4)THEN
- AB(1,1) = 360.*(AB(1,1)-XVAL1L)/(XVAL2L-XVAL1L)
- AB(1,2) = 360.*(AB(1,2)-XVAL1L)/(XVAL2L-XVAL1L)
- AB(2,1) = 180.*(AB(2,1)-YVAL1L)/(YVAL2L-YVAL1L)
- AB(2,3) = 180.*(AB(2,3)-YVAL1L)/(YVAL2L-YVAL1L)
- ELSEIF(ISYS.EQ.5)THEN
- AB(1,1) = 360.*(AB(1,1)-XVAL1L)/(XVAL2L-XVAL1L)
- AB(1,2) = 360.*(AB(1,2)-XVAL1L)/(XVAL2L-XVAL1L)
- AB(2,1) = (180.-2.*DANG)*(AB(2,1)-YVAL1L)/(YVAL2L-YVAL1L)+DANG
- AB(2,3) = (180.-2.*DANG)*(AB(2,3)-YVAL1L)/(YVAL2L-YVAL1L)+DANG
- ENDIF
-*
-* Complete the cell coordinates
-*
- AB(2,2) = AB(2,1)
- AB(1,3) = AB(1,2)
- AB(1,4) = AB(1,1)
- AB(2,4) = AB(2,3)
-*
-* Get the content of the table, and loop on the
-* stack if necessary.
-*
- IL=ILOG
- ILOG=0
- VV(1)=ZMIN
- IF(IPACK.NE.0)THEN
- VV(2)=IGCELL(NCX,NCY,REFWRD(1),IXT,IYT,1)
- ELSE
- VV(2)=IGCELL(NCX,NCY,REFWRD(IADRES(1)+1),IXT,IYT,1)
- ENDIF
- IF(NIDS.NE.0)THEN
- DO 10 I=2,NIDS+1
- IXT=IA+IXFCHA(I)-1
- IYT=IB+IYFCHA(I)-1
- IF(IPACK.NE.0)THEN
- VV(I+1)=IGCELL(NCX,NCY,REFWRD(I),IXT,IYT,1)+VV(I)
- ELSE
- VV(I+1)=IGCELL(NCX,NCY,REFWRD(IADRES(I)+1),IXT,IYT,1)
- + +VV(I)
- ENDIF
- VV(I+1)=MAX(ZMIN,VV(I+1))
- 10 CONTINUE
- ENDIF
-*
- NV=NIDS+2
- ILOG=IL
- DO 20 I=2,NV
- IF(ILOG.NE.0)THEN
- VV(I)=MAX(ZMIN,LOG10(VV(I)))
- ELSE
- VV(I)=MAX(ZMIN,VV(I))
- ENDIF
- 20 CONTINUE
-*
- IF(ILOG.EQ.0)THEN
- 30 I=3
- 40 IF(I.LE.NV)THEN
- IF(VV(I).LT.VV(I-1))THEN
- VV(I-1)=VV(I)
- GOTO 30
- ENDIF
- I=I+1
- GOTO 40
- ENDIF
- ENDIF
-*
-* For cylindrical, spherical and pseudo-rapidity, the content
-* is mapped onto the radius
-*
- IF(ISYS.GE.3)THEN
- DO 50 I=1,NV
- VV(I)=((1.-RINRAD)*((VV(I)-ZMIN)/(ZMAX-ZMIN)))+RINRAD
- 50 CONTINUE
- ENDIF
-*
- DO 70 I=1,NV
- DO 60 J=1,4
- T(J,I)=VV(I)
- 60 CONTINUE
- 70 CONTINUE
-*
- END
diff --git a/src/graflib/higz/ig/igtab4.F b/src/graflib/higz/ig/igtab4.F
deleted file mode 100644
index daecc5c..0000000
--- a/src/graflib/higz/ig/igtab4.F
+++ /dev/null
@@ -1,89 +0,0 @@
-*
-* $Id: igtab4.F,v 1.1.1.1 1996/02/14 13:10:39 mclareni Exp $
-*
-* $Log: igtab4.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:39 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.22/08 24/02/95 15.44.06 by O.Couet
-*-- Author : O.Couet 07/01/92
- SUBROUTINE IGTAB4(RMIN,RMAX,RBACK)
-*.===========>
-*.
-*. Set the correct window size for lego and surface plots.
-* And draw the background if necessary.
-*.
-*. _Input parameters:
-*.
-*. REAL RMIN(3), RMAX(3) : 3D coordinates of the box.
-*. REAL RBACK : Background colour
-*.
-*..==========> (O.Couet)
-#include "higz/hiatt.inc"
-#include "higz/hctnor.inc"
-#include "higz/higraf.inc"
- DIMENSION RMIN(*),RMAX(*)
- DIMENSION SMAX(2)
-*.______________________________________
-*
- DO 20 I=1,2
- SMAX(I) = TNORM(4,I)
- DO 10 K=1,3
- IF (TNORM(K,I) .LT. 0.) THEN
- SMAX(I) = SMAX(I) + TNORM(K,I)*RMIN(K)
- ELSE
- SMAX(I) = SMAX(I) + TNORM(K,I)*RMAX(K)
- ENDIF
- 10 CONTINUE
- 20 CONTINUE
- CALL ISWN(INTR,-SMAX(1),SMAX(1),-SMAX(2),SMAX(2))
- CALL ISELNT(INTR)
-*
-* Draw the background if necessary
-*
- IF(RBACK.GE.1000.)THEN
- R1=-1.
- R2=-1.
- R3=-1.
- XGRAF(2)=-SMAX(1)
- XGRAF(3)=-SMAX(1)
- XGRAF(5)=+SMAX(1)
- XGRAF(6)=+SMAX(1)
- YGRAF(1)=-SMAX(2)
- YGRAF(4)=+SMAX(2)
- YGRAF(2)=+SMAX(2)
- YGRAF(3)=-SMAX(2)
- YGRAF(6)=+SMAX(2)
- YGRAF(5)=-SMAX(2)
- DO 30 I=1,8
- X=((1.-R1)*RMIN(1)+(R1+1.)*RMAX(1))/2.
- Y=((1.-R2)*RMIN(2)+(R2+1.)*RMAX(2))/2.
- Z=((1.-R3)*RMIN(3)+(R3+1.)*RMAX(3))/2.
- XX=TNORM(1,1)*X+TNORM(2,1)*Y+TNORM(3,1)*Z+TNORM(4,1)
- YY=TNORM(1,2)*X+TNORM(2,2)*Y+TNORM(3,2)*Z+TNORM(4,2)
- IF(ABS(XX-XGRAF(2)).LE.0.0001)THEN
- IF(YGRAF(2).GE.YY)YGRAF(2)=YY
- IF(YGRAF(3).LE.YY)YGRAF(3)=YY
- ENDIF
- IF(ABS(XX-XGRAF(6)).LE.0.0001)THEN
- IF(YGRAF(6).GE.YY)YGRAF(6)=YY
- IF(YGRAF(5).LE.YY)YGRAF(5)=YY
- ENDIF
- IF(ABS(YY-YGRAF(1)).LE.0.0001)XGRAF(1)=XX
- IF(ABS(YY-YGRAF(4)).LE.0.0001)XGRAF(4)=XX
- R1=-R1
- IF(MOD(I,2).EQ.0)R2=-R2
- IF(I.GE.4)R3=1
- 30 CONTINUE
-*
- IFACS = IFACI
- CALL ISFAIS(1)
- ICOL=INT(RBACK-100.*FLOAT(INT(RBACK/100.)))
- CALL ISFACI(ICOL)
- CALL IFA(6,XGRAF,YGRAF)
- CALL ISFACI(IFACS)
- ENDIF
-*
- END
diff --git a/src/graflib/higz/ig/igtab5.F b/src/graflib/higz/ig/igtab5.F
deleted file mode 100644
index a7515f0..0000000
--- a/src/graflib/higz/ig/igtab5.F
+++ /dev/null
@@ -1,211 +0,0 @@
-*
-* $Id: igtab5.F,v 1.1.1.1 1996/02/14 13:10:39 mclareni Exp $
-*
-* $Log: igtab5.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:39 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.21/07 29/06/94 15.16.15 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE IGTAB5(RMIN,RMAX,ANG,PAR)
-*.===========>
-*.
-*. Draw the axis for lego and surface plots.
-*.
-*. _Input parameters:
-*.
-*. REAL RMIN(3) : MIN axis labels
-*. REAL RMAX(3) : MAX axis labels
-*. REAL ANG : Angle between X and Y axis
-*. REAL PAR(14) : Axis Parameters
-*. PAR(1) = NDVX
-*. PAR(2) = NDVY
-*. PAR(3) = NDVZ
-*. PAR(4) = XCOL
-*. PAR(5) = YCOL
-*. PAR(6) = ZCOL
-*. PAR(7) = XTIC
-*. PAR(8) = YTIC
-*. PAR(9) = ZTIC
-*. PAR(10) = VSIZ
-*. PAR(11) = VFON
-*. PAR(12) = XVAL
-*. PAR(13) = YVAL
-*. PAR(14) = ZVAL
-*. PAR(15) = XLOG
-*. PAR(16) = YLOG
-*. PAR(17) = ZLOG
-*.
-*. After a call to this routine, the axis position are returned
-*. in RQUEST(70-81).
-*.
-*..==========> (O.Couet)
-#include "higz/hipack.inc"
-#include "higz/hihid.inc"
-#include "higz/hiatt.inc"
-#include "higz/hiques.inc"
-#include "higz/hiatnb.inc"
-#include "higz/hisave.inc"
- DIMENSION PAR(*)
- CHARACTER*8 CHOPAX,CHOPAY,CHOPAZ
- REAL RMIN(3),RMAX(3),AV(3,8),R(3,8)
- REAL X1(3),X2(3),Y1(3),Y2(3),Z1(3),Z2(3)
- DOUBLE PRECISION RAD,COSA,SINA
- DATA EPSIL /0.001/
-*.______________________________________
-*
- IF(ISYS.GT.1)RETURN
-*
- RAD = ATAN(1.D0)*4./180.
- COSA = COS(ANG*RAD)
- SINA = SIN(ANG*RAD)
- CALL IHAXIV(RMIN,RMAX,ANG,AV,IX1,IX2,IY1,IY2,IZ1,IZ2)
- DO 10 I=1,8
- R(1,I) = AV(1,I) + AV(2,I)*COSA
- R(2,I) = AV(2,I)*SINA
- R(3,I) = AV(3,I)
- 10 CONTINUE
- CALL IHWTON(R(1,IX1),X1)
- CALL IHWTON(R(1,IX2),X2)
- CALL IHWTON(R(1,IY1),Y1)
- CALL IHWTON(R(1,IY2),Y2)
- CALL IHWTON(R(1,IZ1),Z1)
- CALL IHWTON(R(1,IZ2),Z2)
-*
-* Initialize the axis options
-*
- IF(X1(1).GT.X2(1))THEN
- CHOPAX = 'SDHV=+'
- ELSE
- CHOPAX = 'SDHV=-'
- ENDIF
- IF(Y1(1).GT.Y2(1))THEN
- CHOPAY = 'SDHV=+'
- ELSE
- CHOPAY = 'SDHV=-'
- ENDIF
- CHOPAZ = 'SDH+='
-*
-* Option LOG is required ?
-*
- IF(PAR(15).NE.0.)CHOPAX(8:8) = 'G'
- IF(PAR(16).NE.0.)CHOPAY(8:8) = 'G'
- IF(PAR(17).NE.0.)CHOPAZ(8:8) = 'G'
-*
-* Initialize the number of division. If the
-* number of divisions is negative, option 'N'
-* is required.
-*
- NDIVX = INT(PAR(1)+0.1)
- NDIVY = INT(PAR(2)+0.1)
- NDIVZ = INT(PAR(3)+0.1)
- IF(NDIVX.LT.0)THEN
- NDIVX = ABS(NDIVX)
- CHOPAX(7:7) = 'N'
- ENDIF
- IF(NDIVY.LT.0)THEN
- NDIVY = ABS(NDIVY)
- CHOPAY(7:7) = 'N'
- ENDIF
- IF(NDIVZ.LT.0)THEN
- NDIVZ = ABS(NDIVZ)
- CHOPAZ(7:7) = 'N'
- ENDIF
-*
-* Axis attributes setting
-* The variables SCALE allows to rescale the VSIZ
-* in order to have the same label size for all angles.
-*
- SCALEX = (RWXMAX-RWXMIN)/2.
- SCALEY = (RWYMAX-RWYMIN)/2.
- CALL IGSET('LWID',1.)
- CALL IGSET('PLCI',1.)
- CALL IGSET('TXFP',PAR(11))
- CALL IGSET('LASI',PAR(10)*SCALEY)
-*
-* X axis drawing
-*
- IF(ABS(X1(1)-X2(1)).GE.EPSIL.OR.ABS(X1(2)-X2(2)).GT.EPSIL)THEN
- CALL IGSET('TXCI',PAR(4)+0.1)
- CALL IGSET('TMSI',PAR(7)*SCALEY)
- CALL IGSET('LAOF',PAR(13)*SCALEY)
- IF(PAR(15).NE.0.)THEN
- BMIN=10**RMIN(1)
- BMAX=10**RMAX(1)
- ELSE
- BMIN=RMIN(1)
- BMAX=RMAX(1)
- ENDIF
- CALL IGAXIS(X1(1),X2(1),X1(2),X2(2),BMIN,BMAX,NDIVX,CHOPAX)
- RQUEST(70) = ((WNVPSV(2)-WNVPSV(1))/(RWXMAX-RWXMIN))
- + *(X1(1)-RWXMIN)+WNVPSV(1)
- RQUEST(71) = ((WNVPSV(2)-WNVPSV(1))/(RWXMAX-RWXMIN))
- + *(X2(1)-RWXMIN)+WNVPSV(1)
- RQUEST(72) = ((WNVPSV(4)-WNVPSV(3))/(RWYMAX-RWYMIN))
- + *(X1(2)-RWYMIN)+WNVPSV(3)
- RQUEST(73) = ((WNVPSV(4)-WNVPSV(3))/(RWYMAX-RWYMIN))
- + *(X2(2)-RWYMIN)+WNVPSV(3)
- ENDIF
-*
-* Y axis drawing
-*
- IF(ABS(Y1(1)-Y2(1)).GE.EPSIL.OR.ABS(Y1(2)-Y2(2)).GT.EPSIL)THEN
- CALL IGSET('TXCI',PAR(5)+0.1)
- CALL IGSET('TMSI',PAR(8)*SCALEY)
- CALL IGSET('LAOF',PAR(12)*SCALEY)
- IF(ABS(Z1(1)-Z2(1)).LT.EPSIL.AND. ABS(Z1(2)-Z2(2)).LT.EPSIL)
- + CHOPAY='SDH+=N'
- IF(IDIM1.NE.0)THEN
- CHOPAY='V=+UN'
- NDIVY=0
- ENDIF
- IF(ABS(Y1(1)-Y2(1)).LT.EPSIL)THEN
- Y2(1)=Y1(1)
- CALL IGSET('LAOF',PAR(14))
- ENDIF
- IF(PAR(16).NE.0.)THEN
- BMIN=10**RMIN(2)
- BMAX=10**RMAX(2)
- ELSE
- BMIN=RMIN(2)
- BMAX=RMAX(2)
- ENDIF
- CALL IGAXIS(Y1(1),Y2(1),Y1(2),Y2(2),BMIN,BMAX,NDIVY,CHOPAY)
- RQUEST(74) = ((WNVPSV(2)-WNVPSV(1))/(RWXMAX-RWXMIN))
- + *(Y1(1)-RWXMIN)+WNVPSV(1)
- RQUEST(75) = ((WNVPSV(2)-WNVPSV(1))/(RWXMAX-RWXMIN))
- + *(Y2(1)-RWXMIN)+WNVPSV(1)
- RQUEST(76) = ((WNVPSV(4)-WNVPSV(3))/(RWYMAX-RWYMIN))
- + *(Y1(2)-RWYMIN)+WNVPSV(3)
- RQUEST(77) = ((WNVPSV(4)-WNVPSV(3))/(RWYMAX-RWYMIN))
- + *(Y2(2)-RWYMIN)+WNVPSV(3)
- ENDIF
-*
-* Z axis drawing
-*
- IF(ABS(Z1(1)-Z2(1)).GE.EPSIL.OR.ABS(Z1(2)-Z2(2)).GT.EPSIL)THEN
- CALL IGSET('TXCI',PAR(5)+0.1)
- CALL IGSET('TMSI',PAR(9)*SCALEX)
- CALL IGSET('LAOF',PAR(14)*SCALEX)
- IF(PAR(17).NE.0.)THEN
- BMIN=10**RMIN(3)
- BMAX=10**RMAX(3)
- ELSE
- BMIN=RMIN(3)
- BMAX=RMAX(3)
- ENDIF
- CALL IGAXIS(Z1(1),Z2(1),Z1(2),Z2(2),BMIN,BMAX,NDIVZ,CHOPAZ)
- RQUEST(78) = ((WNVPSV(2)-WNVPSV(1))/(RWXMAX-RWXMIN))
- + *(Z1(1)-RWXMIN)+WNVPSV(1)
- RQUEST(79) = ((WNVPSV(2)-WNVPSV(1))/(RWXMAX-RWXMIN))
- + *(Z2(1)-RWXMIN)+WNVPSV(1)
- RQUEST(80) = ((WNVPSV(4)-WNVPSV(3))/(RWYMAX-RWYMIN))
- + *(Z1(2)-RWYMIN)+WNVPSV(3)
- RQUEST(81) = ((WNVPSV(4)-WNVPSV(3))/(RWYMAX-RWYMIN))
- + *(Z2(2)-RWYMIN)+WNVPSV(3)
- ENDIF
-*
- CALL ISLN(1)
- END
diff --git a/src/graflib/higz/ig/igtab6.F b/src/graflib/higz/ig/igtab6.F
deleted file mode 100644
index aa9109f..0000000
--- a/src/graflib/higz/ig/igtab6.F
+++ /dev/null
@@ -1,140 +0,0 @@
-*
-* $Id: igtab6.F,v 1.1.1.1 1996/02/14 13:10:39 mclareni Exp $
-*
-* $Log: igtab6.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:39 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.19/02 06/07/93 09.40.04 by O.Couet
-*-- Author : E.Chernyaev
- SUBROUTINE IGTAB6(IX,IY,FACE,T)
-************************************************************************
-* *
-* Function: Find part of surface with luminosity in the corners *
-* This routine is used for Gouraud shading *
-* *
-************************************************************************
-#include "higz/hipack.inc"
-#include "higz/hihid.inc"
- REAL FACE(3,4),T(4)
- REAL F(3,4,3,3),X(4,3,3),Y(4,3,3),Z(4,3,3)
- REAL AN(3,3,3),BN(3,2,2)
- INTEGER INCRX(3),INCRY(3)
-*-
- IPHI = 1
- RAD = ATAN(1.)*4./180.
-*
-** Find real cell indexes
-*
- IXT = IX + IXFCHA(1) - 1
- IYT = IY + IYFCHA(1) - 1
-*
-** Find increments of neighboring cells
-*
- INCRX(1) =-1
- INCRX(2) = 0
- INCRX(3) =+1
- IF (IXT .EQ. 1) INCRX(1) = 0
- IF (IXT .EQ. NCX-1) INCRX(3) = 0
- INCRY(1) =-1
- INCRY(2) = 0
- INCRY(3) =+1
- IF (IYT .EQ. 1) INCRY(1) = 0
- IF (IYT .EQ. NCY-1) INCRY(3) = 0
-*
-** Find neighboring faces
-*
- DO 120 J=1,3
- DO 110 I=1,3
- CALL IGTAB2(IX+INCRX(I),IY+INCRY(J),F(1,1,I,J),T)
- 110 CONTINUE
- 120 CONTINUE
-*
-** Set face
-*
- DO 220 K=1,4
- DO 210 I=1,3
- FACE(I,K) = F(I,K,2,2)
- 210 CONTINUE
- 220 CONTINUE
-*
-** Find coordinates and normales
-*
- DO 330 J=1,3
- DO 320 I=1,3
- DO 310 K=1,4
-* Polar
- IF (ISYS.EQ.2) THEN
- PHI = F(IPHI,K,I,J)*RAD
- R = F(3-IPHI,K,I,J)
- X(K,I,J) = R*COS(PHI)
- Y(K,I,J) = R*SIN(PHI)
- Z(K,I,J) = F(3,K,I,J)
-* Cylindrical
- ELSE IF (ISYS.EQ.3) THEN
- PHI = F(IPHI,K,I,J)*RAD
- R = F(3,K,I,J)
- X(K,I,J) = R*COS(PHI)
- Y(K,I,J) = R*SIN(PHI)
- Z(K,I,J) = F(3-IPHI,K,I,J)
-* Spherial
- ELSE IF (ISYS.EQ.4) THEN
- PHI = F(IPHI,K,I,J)*RAD
- TH = F(3-IPHI,K,I,J)*RAD
- R = F(3,K,I,J)
- X(K,I,J) = R*SIN(TH)*COS(PHI)
- Y(K,I,J) = R*SIN(TH)*SIN(PHI)
- Z(K,I,J) = R*COS(TH)
-* Pseudo ..
- ELSE IF (ISYS.EQ.5) THEN
- PHI = F(IPHI,K,I,J)*RAD
- TH = F(3-IPHI,K,I,J)*RAD
- R = F(3,K,I,J)
- X(K,I,J) = R*COS(PHI)
- Y(K,I,J) = R*SIN(PHI)
- Z(K,I,J) = R*COS(TH)/SIN(TH)
-* Carthesian
- ELSE
- X(K,I,J) = F(1,K,I,J)
- Y(K,I,J) = F(2,K,I,J)
- Z(K,I,J) = F(3,K,I,J)
- END IF
- 310 CONTINUE
- X1 = X(3,I,J) - X(1,I,J)
- X2 = X(4,I,J) - X(2,I,J)
- Y1 = Y(3,I,J) - Y(1,I,J)
- Y2 = Y(4,I,J) - Y(2,I,J)
- Z1 = Z(3,I,J) - Z(1,I,J)
- Z2 = Z(4,I,J) - Z(2,I,J)
- AN(1,I,J) = (Y1*Z2 - Y2*Z1)
- AN(2,I,J) = (Z1*X2 - Z2*X1)
- AN(3,I,J) = (X1*Y2 - X2*Y1)
- S = SQRT(AN(1,I,J)*AN(1,I,J)+
- + AN(2,I,J)*AN(2,I,J)+
- + AN(3,I,J)*AN(3,I,J))
- AN(1,I,J) = AN(1,I,J) / S
- AN(2,I,J) = AN(2,I,J) / S
- AN(3,I,J) = AN(3,I,J) / S
- 320 CONTINUE
- 330 CONTINUE
-*
-** Find average normales
-*
- DO 430 J=1,2
- DO 420 I=1,2
- DO 410 K=1,3
- BN(K,I,J) = AN(K,I,J)+AN(K,I+1,J)+AN(K,I+1,J+1)+AN(K,I,J+1)
- 410 CONTINUE
- 420 CONTINUE
- 430 CONTINUE
-*
-** Set luminosity
-*
- CALL IHLUMI(BN(1,1,1),T(1))
- CALL IHLUMI(BN(1,2,1),T(2))
- CALL IHLUMI(BN(1,2,2),T(3))
- CALL IHLUMI(BN(1,1,2),T(4))
-*
- END
diff --git a/src/graflib/higz/ig/igtabl.F b/src/graflib/higz/ig/igtabl.F
deleted file mode 100644
index c426738..0000000
--- a/src/graflib/higz/ig/igtabl.F
+++ /dev/null
@@ -1,1763 +0,0 @@
-*
-* $Id: igtabl.F,v 1.6 2003/07/23 09:40:07 couet Exp $
-*
-* $Log: igtabl.F,v $
-* Revision 1.6 2003/07/23 09:40:07 couet
-* - The minimum value was not computed correctly, in some cases, when the
-* option LOGZ was requested. The starting value for the minimum is
-* taken in the first bin of the histogram. If this value was negative or
-* null it was set as the minimum even if LOGZ was on. Later on the minimum
-* was set as 0.001*ZMAX instead as the smaller positive value of the
-* histogram. So depending on the contents of the first bin, the plot produced
-* looked different.
-*
-* Revision 1.5 1998/12/07 13:38:31 couet
-* - It is now possible to set the size of the characters in case of
-* option 'T' and 'C' (in percent of the bin heigh).
-*
-* Revision 1.4 1998/12/02 15:18:36 couet
-* - Text is drawn bigger with T option
-*
-* Revision 1.3 1998/12/01 15:48:28 couet
-* - Clean up: commented lines of code removed
-*
-* Revision 1.2 1996/08/06 15:14:11 couet
-* - When ZMIN = ZMAX for a contour plot with a set of levels, a division
-* by 0 occured.
-*
-* Revision 1.1.1.1 1996/02/14 13:10:39 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 2.07/20 11/01/96 17.22.42 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE IGTABL(NX,NY,V,NPAR,PAR,CHOPTI)
-*.===========>
-*.
-*. This routine draws a table according to the value of CHOPT. The PAR input
-*. parameter could be specified to change the aspect of the plot (see the des-
-*. -cription below). The position of the plot on the screen is given by the
-*. viewport of the current normalization transformation selected (the window
-*. is not used and could be anything).
-*.
-*. _Input parameters:
-*.
-*. INTEGER NX : Number of cells in X.
-*. INTEGER NY : Number of cells in Y.
-*. REAL V(NX,NY) : Contains of the cells.
-*. INTEGER NPAR : Number of parameters in PAR
-*. REAL PAR(NPAR) : Array of real parameter.
-*. If PAR(i)=0. or NPAR<i a default value is taken
-*. CHARACTER CHOPT : Options (see bellow).
-*.
-*. +-------+---------------------------------------------------------+---------+
-*. | CHOPT | Corresponding values of PAR | Default |
-*. +-------+---------------------------------------------------------+---------+
-*. | 'P' | Points (scatter plot) | |
-*. | | PAR(1) = Marker type | 1. |
-*. | | PAR(2) = Maximum number of random points per cell | 50. |
-*. | | PAR(3) = XMIN Minimal X-axis label | IXMIN |
-*. | | PAR(4) = XMAX Maximal Y-axis label | IXMAX |
-*. | | PAR(5) = YMIN Minimal Y-axis label | IYMIN |
-*. | | PAR(6) = YMAX Maximal Y-axis label | IYMAX |
-*. | | PAR(7) = ZMIN Minimal Z value | ZMIN |
-*. | | PAR(8) = ZMAX Maximal Z value | ZMAX |
-*. | | PAR(9) = 1000*IXMIN + IXMAX (Usefull for ZOOM) | 1-NX |
-*. | | PAR(10) = 1000*IYMIN + IYMAX (Usefull for ZOOM) | 1-NY |
-*. +-------+---------------------------------------------------------+---------+
-*. | 'B' | Boxes | |
-*. | | PAR(1) = ... | ... |
-*. | | PAR(2) = ... | ... |
-*. | | PAR(3) = XMIN Minimal X-axis label | IXMIN |
-*. | | PAR(4) = XMAX Maximal Y-axis label | IXMAX |
-*. | | PAR(5) = YMIN Minimal Y-axis label | IYMIN |
-*. | | PAR(6) = YMAX Maximal Y-axis label | IYMAX |
-*. | | PAR(7) = ZMIN Minimal Z value | ZMIN |
-*. | | PAR(8) = ZMAX Maximal Z value | ZMAX |
-*. | | PAR(9) = 1000*IXMIN + IXMAX (Usefull for ZOOM) | 1-NX |
-*. | | PAR(10) = 1000*IYMIN + IYMAX (Usefull for ZOOM) | 1-NY |
-*. +-------+---------------------------------------------------------+---------+
-*. | 'R' | aRrows | |
-*. | | PAR(1) = ... | ... |
-*. | | PAR(2) = ... | ... |
-*. | | PAR(3) = XMIN Minimal X-axis label | IXMIN |
-*. | | PAR(4) = XMAX Maximal Y-axis label | IXMAX |
-*. | | PAR(5) = YMIN Minimal Y-axis label | IYMIN |
-*. | | PAR(6) = YMAX Maximal Y-axis label | IYMAX |
-*. | | PAR(7) = ZMIN Minimal Z value | ZMIN |
-*. | | PAR(8) = ZMAX Maximal Z value | ZMAX |
-*. | | PAR(9) = 1000*IXMIN + IXMAX (Usefull for ZOOM) | 1-NX |
-*. | | PAR(10) = 1000*IYMIN + IYMAX (Usefull for ZOOM) | 1-NY |
-*. +-------+---------------------------------------------------------+---------+
-*. | 'C' | Contour plot | |
-*. | | PAR(1) = Nlevel (min=2 max=50) | 20. |
-*. | | PAR(2) = 0 use colour to distinguish contours | 0. |
-*. | | the line type use is 1. | |
-*. | | 1.XXX use line style to distinguish contours| |
-*. | | The color index used is XXX. | |
-*. | | 2.XXX line style and colour are the same for| |
-*. | | all contours. The color index used is XXX | |
-*. | | PAR(3) = XMIN Minimal X-axis label | IXMIN |
-*. | | PAR(4) = XMAX Maximal Y-axis label | IXMAX |
-*. | | PAR(5) = YMIN Minimal Y-axis label | IYMIN |
-*. | | PAR(6) = YMAX Maximal Y-axis label | IYMAX |
-*. | | PAR(7) = ZMIN Minimal Z value | ZMIN |
-*. | | PAR(8) = ZMAX Maximal Z value | ZMAX |
-*. | | PAR(9) = 1000*IXMIN + IXMAX (Usefull for ZOOM) | 1-NX |
-*. | | PAR(10) = 1000*IYMIN + IYMAX (Usefull for ZOOM) | 1-NY |
-*. | | PAR(11) = --+ | |
-*. | | . | | |
-*. | | . +-> Levels to be drawn | |
-*. | | . | | |
-*. | | PAR(NPAR) = --+ | |
-*. +-------+---------------------------------------------------------+---------+
-*. | 'COL' | COLour plot | |
-*. | | PAR(1) = 0 use the standard 8 colours | 0. |
-*. | | 1 use versacolor pattern table | |
-*. | | PAR(2) = ... | |
-*. | | PAR(3) = XMIN Minimal X-axis label | IXMIN |
-*. | | PAR(4) = XMAX Maximal Y-axis label | IXMAX |
-*. | | PAR(5) = YMIN Minimal Y-axis label | IYMIN |
-*. | | PAR(6) = YMAX Maximal Y-axis label | IYMAX |
-*. | | PAR(7) = ZMIN Minimal Z value | ZMIN |
-*. | | PAR(8) = ZMAX Maximal Z value | ZMAX |
-*. | | PAR(9) = 1000*IXMIN + IXMAX (Usefull for ZOOM) | 1-NX |
-*. | | PAR(10) = 1000*IYMIN + IYMAX (Usefull for ZOOM) | 1-NY |
-*. +-------+---------------------------------------------------------+---------+
-*. | 'T' | Table (Text) | |
-*. | | PAR(1) = Text size (in % of the bin Y width) | 0.3 |
-*. | | PAR(2) = ... | |
-*. | | PAR(3) = XMIN Minimal X-axis label | IXMIN |
-*. | | PAR(4) = XMAX Maximal Y-axis label | IXMAX |
-*. | | PAR(5) = YMIN Minimal Y-axis label | IYMIN |
-*. | | PAR(6) = YMAX Maximal Y-axis label | IYMAX |
-*. | | PAR(7) = ZMIN Minimal Z value | ZMIN |
-*. | | PAR(8) = ZMAX Maximal Z value | ZMAX |
-*. | | PAR(9) = 1000*IXMIN + IXMAX (Usefull for ZOOM) | 1-NX |
-*. | | PAR(10) = 1000*IYMIN + IYMAX (Usefull for ZOOM) | 1-NY |
-*. +-------+---------------------------------------------------------+---------+
-*. | 'K' | Character, the contains is one single character | |
-*. | | PAR(1) = Text size (in % of the bin Y width) | 0.3 |
-*. | | PAR(2) = ... | |
-*. | | PAR(3) = XMIN Minimal X-axis label | IXMIN |
-*. | | PAR(4) = XMAX Maximal Y-axis label | IXMAX |
-*. | | PAR(5) = YMIN Minimal Y-axis label | IYMIN |
-*. | | PAR(6) = YMAX Maximal Y-axis label | IYMAX |
-*. | | PAR(7) = ZMIN Minimal Z value | ZMIN |
-*. | | PAR(8) = ZMAX Maximal Z value | ZMAX |
-*. | | PAR(9) = 1000*IXMIN + IXMAX (Usefull for ZOOM) | 1-NX |
-*. | | PAR(10) = 1000*IYMIN + IYMAX (Usefull for ZOOM) | 1-NY |
-*. +-------+---------------------------------------------------------+---------+
-*. | 'L' | Lego (mode 0) | |
-*. | 'LB' | Lego same as L but take care with BARO and BARW | |
-*. | 'L1' | Lego with colors (mode 1) | |
-*. | 'L2' | Lego with colors (mode 2) | |
-*. | | PAR(1) = THETA | 30. |
-*. | | PAR(2) = PHI | 30. |
-*. | | PAR(3) = XMIN Minimal X-axis label | IXMIN |
-*. | | PAR(4) = XMAX Maximal Y-axis label | IXMAX |
-*. | | PAR(5) = YMIN Minimal Y-axis label. For 1D histos | IYMIN |
-*. | | PAR(5) is the HMAX of HPLOT | |
-*. | | PAR(6) = YMAX Maximal Y-axis label | IYMAX |
-*. | | PAR(7) = ZMIN Minimal Z value | ZMIN |
-*. | | PAR(8) = ZMAX Maximal Z value | ZMAX |
-*. | | PAR(9) = 1000*IXMIN + IXMAX (Usefull for ZOOM) | 1-NX |
-*. | | PAR(10) = 1000*IYMIN + IYMAX (Usefull for ZOOM) | 1-NY |
-*. +-------+---------------------------------------------------------+---------+
-*. | 'S' | Surface (mode 0) | |
-*. | 'S1' | Surface with colors (mode 1) | |
-*. | 'S2' | Surface with colors (mode 2) | |
-*. | 'S3' | Surface with line and color contour on top | |
-*. | 'S4' | Surface with Gouraud shading | |
-*. | | PAR(1) = THETA | 30. |
-*. | | PAR(2) = PHI | 30. |
-*. | | PAR(3) = XMIN Minimal X-axis label | IXMIN |
-*. | | PAR(4) = XMAX Maximal Y-axis label | IXMAX |
-*. | | PAR(5) = YMIN Minimal Y-axis label. For 1D histos | IYMIN |
-*. | | PAR(5) is the HMAX of HPLOT | |
-*. | | PAR(6) = YMAX Maximal Y-axis label | IYMAX |
-*. | | PAR(7) = ZMIN Minimal Z value | ZMIN |
-*. | | PAR(8) = ZMAX Maximal Z value | ZMAX |
-*. | | PAR(9) = 1000*IXMIN + IXMAX (Usefull for ZOOM) | 1-NX |
-*. | | PAR(10) = 1000*IYMIN + IYMAX (Usefull for ZOOM) | 1-NY |
-*. +-------+---------------------------------------------------------+---------+
-*. | | For legos and surfaces : | |
-*. | | PAR(11) = NDVX if = 0 the 3D axis are not drawn | 510. |
-*. | | This is used in HPLTAB to draw the | |
-*. | | contour plot with fill area. | |
-*. | | PAR(12) = NDVY | 510. |
-*. | | PAR(13) = NDVZ | 510. |
-*. | | PAR(14) = XCOL | 1. |
-*. | | PAR(15) = YCOL | 1. |
-*. | | PAR(16) = ZCOL if > 1000 the box is filled with ZCOL | 1. |
-*. | | PAR(17) = XTIC | 0.02 |
-*. | | PAR(18) = YTIC | 0.02 |
-*. | | PAR(19) = ZTIC | 0.02 |
-*. | | PAR(20) = VSIZ | 0.02 |
-*. | | PAR(21) = VFON | 2. |
-*. | | PAR(22) = XVAL | 0.02 |
-*. | | PAR(23) = YVAL | 0.02 |
-*. | | PAR(24) = ZVAL | 0.04 |
-*. | | PAR(25) = Color | |
-*. +-------+---------------------------------------------------------+---------+
-*. | 'POL' | Polar for LEGO and SURFACE | |
-*. +-------+---------------------------------------------------------+---------+
-*. | 'CYL' | Cylindrical for LEGO and SURFACE | |
-*. +-------+---------------------------------------------------------+---------+
-*. | 'SPH' | Spherical for LEGO and SURFACE | |
-*. +-------+---------------------------------------------------------+---------+
-*. | 'PSD' | Pseudo rapidity for LEGO and SURFACE | |
-*. +-------+---------------------------------------------------------+---------+
-*. | 'H' | Data are compacted like in HPLOT. In this case, V is | |
-*. | | not the matrix to be drawn but V(1) contains the HBOOK | |
-*. | | ZEBRA link to the histogram to be drawn. | |
-*. +-------+---------------------------------------------------------+---------+
-*. | 'I' | IGTABL is called from IZDNB. In this case, V is not the | |
-*. | | not the matrix to be drawn but V(1) contains the HIGZ | |
-*. | | adress in the picture data structure. | |
-*. +-------+---------------------------------------------------------+---------+
-*. | 'GX' | loG on X coordinates. A log WC should be defined before | |
-*. +-------+---------------------------------------------------------+---------+
-*. | 'GY' | loG on Y coordinates. A log WC should be defined before | |
-*. +-------+---------------------------------------------------------+---------+
-*. | 'GZ' | loG on Z coordinates | |
-*. +-------+---------------------------------------------------------+---------+
-*. | 'A' | 2nd vertical axis (legos and Surfaces only) | |
-*. | | axis (for the 2D representations) | |
-*. +-------+---------------------------------------------------------+---------+
-*. | '+' | For stacked histogram (legos) | |
-*. +-------+---------------------------------------------------------+---------+
-*. | 'Z' | Allows to display the Z scale | |
-*. +-------+---------------------------------------------------------+---------+
-*. | 'E' | Draw the errors (with colors) | |
-*. +-------+---------------------------------------------------------+---------+
-*. | 'FB' | With LEGO or SURFACE, it suppress the Front-Box | |
-*. | 'BB' | With LEGO or SURFACE, it suppress the Back-Box | |
-*. +-------+---------------------------------------------------------+---------+
-*.
-*. Remarks:
-*. If PAR(9) < 0, IXMIN=-PAR(9) and IXMAX=IQUEST(60)
-*. If PAR(10) < 0, IYMIN=-PAR(10) and IYMAX=IQUEST(61)
-*. For 1-Dim histograms, PAR(5) is the Y-Scale factor (HMAX of HPLOT)
-*.
-*..==========> (O.Couet)
-#include "higz/hipaw.inc"
-#include "higz/hiatt.inc"
-#if defined(CERNLIB_MAIL)
-#include "higz/himail.inc"
-#endif
-#include "higz/hiflag.inc"
-#include "higz/hipack.inc"
-#include "higz/hicont.inc"
-#include "higz/hihid.inc"
-#include "higz/hilut.inc"
-
- PARAMETER (YDIFF=1.,YLIGH1=10.)
- PARAMETER (QA=0.15,QD=0.15,QS=0.8,NQS=1)
-
- EXTERNAL IHDFL1,IHDFR1,IHDFL2,IHDFR2
- EXTERNAL IHDF02,IHDF03,IGTAB2,IGTAB3,IGTAB6
- REAL IGCELL
-
- CHARACTER*(*) CHOPTI
- DIMENSION PAR(*),V(*)
-
- PARAMETER (MAXCOL=8,MAXPAT=39)
- PARAMETER (NMAX=500)
- PARAMETER (NRASTX=1000,NRASTY=800)
-
- DIMENSION XBUF(NMAX),YBUF(NMAX)
- DIMENSION X(4),Y(4),ZC(4),IR(4),XARR(102),YARR(102),ITARR(102)
- DIMENSION LUT(MAXCOL),IPATRN(MAXPAT)
- DIMENSION IOPT(30),IOPT2(16)
- DIMENSION RVAL(4)
-
- EQUIVALENCE (IOPCOL,IOPT( 1))
- EQUIVALENCE (IOPTP ,IOPT( 2)),(IOPTB ,IOPT( 3))
- EQUIVALENCE (IOPTC ,IOPT( 4)),(IOPTT ,IOPT( 5))
- EQUIVALENCE (IOPTK ,IOPT( 6)),(IOPTL ,IOPT( 7))
- EQUIVALENCE (IOPTS ,IOPT( 8)),(IOPTH ,IOPT( 9))
- EQUIVALENCE (IOPTA ,IOPT(10)),(IOPTPP,IOPT(11))
- EQUIVALENCE (IOPTR ,IOPT(12)),(IOPTS1,IOPT(13))
- EQUIVALENCE (IOPTS2,IOPT(14)),(IOPTL1,IOPT(15))
- EQUIVALENCE (IOPTL2,IOPT(16)),(IOPTGZ,IOPT(17))
- EQUIVALENCE (IOPTGX,IOPT(18)),(IOPTGY,IOPT(19))
- EQUIVALENCE (IOPTBR,IOPT(20)),(IOPTZ ,IOPT(21))
- EQUIVALENCE (IOPTS3,IOPT(22)),(IOPTS4,IOPT(23))
- EQUIVALENCE (IOPPOL,IOPT(24)),(IOPCYL,IOPT(25))
- EQUIVALENCE (IOPSPH,IOPT(26)),(IOPPSD,IOPT(27))
- EQUIVALENCE (IOPTBB,IOPT(28)),(IOPTFB,IOPT(29))
- EQUIVALENCE (IOPTE ,IOPT(30))
-
- LOGICAL LTEST,ZFSAV
-
- CHARACTER*80 CHOPT
- CHARACTER*12 CHAT
- CHARACTER*40 CHK
-
- DIMENSION RSTRS(MAXSTK),RSTGS(MAXSTK),RSTBS(MAXSTK)
- SAVE RSTRS,RSTGS,RSTBS,NBCSAV
- SAVE RSTRBS,RSTGBS,RSTBBS
- SAVE RSTRTS,RSTGTS,RSTBTS
- DATA NBCSAV /0/
-
- DATA LUT /0,5,7,3,6,2,4,1/
- DATA IPATRN /20,28,36,44,52,64,48,64,72,82,
- + 89,91,95,98,104,105,112,116,126,
- + 131,147,156,159,160,168,174,175,
- + 178,182,184,199,215,221,227,228,
- + 230,235,246,236/
-*.______________________________________
-*
- IQUEST(1)=0
- IF(NX.LE.0.OR.NY.LT.0)THEN
- CALL IGERR('Invalid array dimension','IGTABL')
- RETURN
- ENDIF
-*
-* Determine options
-*
- CHOPT=CHOPTI
- IOPCOL=INDEX(CHOPT,'COL')
- IF(IOPCOL.GT.0)CHOPT(IOPCOL:IOPCOL+2)=' '
- IOPPOL=INDEX(CHOPT,'POL')
- IF(IOPPOL.GT.0)CHOPT(IOPPOL:IOPPOL+2)=' '
- IOPCYL=INDEX(CHOPT,'CYL')
- IF(IOPCYL.GT.0)CHOPT(IOPCYL:IOPCYL+2)=' '
- IOPSPH=INDEX(CHOPT,'SPH')
- IF(IOPSPH.GT.0)CHOPT(IOPSPH:IOPSPH+2)=' '
- IOPPSD=INDEX(CHOPT,'PSD')
- IF(IOPPSD.GT.0)CHOPT(IOPPSD:IOPPSD+2)=' '
- IOPTFB=INDEX(CHOPT,'FB')
- IF(IOPTFB.GT.0)CHOPT(IOPTFB:IOPTFB+1)=' '
- IOPTBB=INDEX(CHOPT,'BB')
- IF(IOPTBB.GT.0)CHOPT(IOPTBB:IOPTBB+1)=' '
- IOPTBR=INDEX(CHOPT,'LB')
- IF(IOPTBR.GT.0)CHOPT(IOPTBR:IOPTBR+1)=' L'
- IOPTS1=INDEX(CHOPT,'S1')
- IF(IOPTS1.GT.0)CHOPT(IOPTS1:IOPTS1+1)=' '
- IOPTS2=INDEX(CHOPT,'S2')
- IF(IOPTS2.GT.0)CHOPT(IOPTS2:IOPTS2+1)=' '
- IOPTS3=INDEX(CHOPT,'S3')
- IF(IOPTS3.GT.0)CHOPT(IOPTS3:IOPTS3+1)=' '
- IOPTS4=INDEX(CHOPT,'S4')
- IF(IOPTS4.GT.0)CHOPT(IOPTS4:IOPTS4+1)=' '
- IOPTL1=INDEX(CHOPT,'L1')
- IF(IOPTL1.GT.0)CHOPT(IOPTL1:IOPTL1+1)=' '
- IOPTL2=INDEX(CHOPT,'L2')
- IF(IOPTL2.GT.0)CHOPT(IOPTL2:IOPTL2+1)=' '
- IOPTGZ=INDEX(CHOPT,'GZ')
- IF(IOPTGZ.GT.0)CHOPT(IOPTGZ:IOPTGZ+1)=' '
- IOPTGX=INDEX(CHOPT,'GX')
- IF(IOPTGX.GT.0)CHOPT(IOPTGX:IOPTGX+1)=' '
- IOPTGY=INDEX(CHOPT,'GY')
- IF(IOPTGY.GT.0)CHOPT(IOPTGY:IOPTGY+1)=' '
- IOPTZ=INDEX(CHOPT,'Z')
- IF(IOPTZ.GT.0)CHOPT(IOPTZ:IOPTZ)=' '
- IOPTI=INDEX(CHOPT,'I')
- IF(IOPTI.GT.0)CHOPT(IOPTI:IOPTI)=' '
- IOPTE=INDEX(CHOPT,'E')
- IOPTER=IOPTE
- IF(IOPTE.GT.0)CHOPT(IOPTE:IOPTE)=' '
- CALL UOPTC(CHOPT,'PBCTKLSHA+R',IOPT(2))
- ILEGO = IOPTL+IOPTL1+IOPTL2
- ISURF = IOPTS+IOPTS1+IOPTS2+IOPTS3+IOPTS4
- I3D = ILEGO+ISURF
- IRAST = 0
-*
-* Try to find if a drawing option has been selected
-* if not the option 'P' is selected.
-*
- CALL UOPTC(CHOPT,'PBCTKLSR',IOPT2(2))
- IOPT2(1) =IOPCOL
- IOPT2(10)=IOPTS1
- IOPT2(11)=IOPTS2
- IOPT2(12)=IOPTL1
- IOPT2(13)=IOPTL2
- IOPT2(14)=IOPTS3
- IOPT2(15)=IOPTS4
- IOPT2(16)=IOPTE
- DO 10 I=1,16
- IF(IOPT2(I).NE.0)GOTO 20
- 10 CONTINUE
- IOPTP=1
- 20 CONTINUE
-*
-* Initialise the COMMON HIPACK (used by IGCELL)
-*
- NCX = NX
- NCY = NY
- IF(IOPTH.NE.0)THEN
- IPACK = 1
- ELSEIF(IOPTI.NE.0)THEN
- IPACK = 2
- ELSE
- IPACK = 0
- ENDIF
- IF(NCY.EQ.0)THEN
- IDIM1 = 1
- NCY = 1
- ELSE
- IDIM1 = 0
- ENDIF
- ILOG = 0
- ZLOW = 0.
- ZHIGH = 0.
- IF(NPAR.GE.8)THEN
- ZLOW = PAR(7)
- ZHIGH = PAR(8)
- ENDIF
-*
- I4AXI = IOPTA
- IF(IOPTBR.NE.0)THEN
- RLEGBO = RBOF
- RLEGBW = RBWD
- ELSE
- RLEGBO = 0.
- RLEGBW = 1.
- ENDIF
-#if defined(CERNLIB_MAIL)
-*
-* Z part and MAIL part
-*
- CHOPTM=CHOPTI
-#endif
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_MAIL)
- IF(GLFLAG)CALL IZTABL(NX,NY,V,NPAR,PAR,IOPT)
-#endif
- IF((.NOT.GFLAG).AND.(.NOT.PFLAG))RETURN
- ZFSAV=ZFLAG
- ZFLAG=.FALSE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
-*
-* Initialise the LOGX and LOGY option for 3D representations
-*
- IF(I3D.NE.0)THEN
- IF(IOPTGX.NE.0)THEN
- ILOGX = IOPTGX
- IOPTGX = 0
- ELSE
- ILOGX = 0
- ENDIF
- IF(IOPTGY.NE.0)THEN
- ILOGY = IOPTGY
- IOPTGY = 0
- ELSE
- ILOGY = 0
- ENDIF
- ENDIF
-*
-* Save the current environment and select
-* a logarithmic or normalized working space.
-*
- CALL IZSAV
- X(1)=RVXMIN
- X(2)=RVXMAX
- Y(1)=RVYMIN
- Y(2)=RVYMAX
- IF(IOPTGX.NE.0)THEN
- X(1)=RWXMIN
- X(2)=RWXMAX
- ENDIF
- IF(IOPTGY.NE.0)THEN
- Y(1)=RWYMIN
- Y(2)=RWYMAX
- ENDIF
- CALL ISWN(INTR,X(1),X(2),Y(1),Y(2))
- CALL ISELNT(INTR)
-*.______________________________________
-*
-* Compute some usefull parameters
-*
-* IXMIN = first chanel in X
-* IXMAX = last chanel in X
-* IYMIN = first chanel in Y
-* IYMAX = last chanel in Y
-* NXCHA = number of chanel in X
-* NYCHA = number of chanel in Y
-* XSTP = step in X
-* YSTP = step in Y
-* ZMIN = minimum of the array V(IXMIN:IXMAX,IYMIN:IYMAX)
-* ZMAX = maximum of the array V(IXMIN:IXMAX,IYMIN:IYMAX)
-* DZ = difference between ZMAX and ZMIN
-* HMAX = Margin on top of 1D histos (% of ZMAX)
-* RAD = Conversion from degrees to radians
-*
- IXMIN = 1
- IXMAX = NX
- IF(NPAR.GE.9)THEN
- IF(PAR(9).GT.0.)THEN
- IXMIN = INT(PAR(9)/1000)
- IXMAX = INT(PAR(9)-(1000*IXMIN))
- ELSEIF(PAR(9).LT.0.)THEN
- IXMIN = -PAR(9)
- IXMAX = IQUEST(60)
- ENDIF
- ENDIF
- IF(IDIM1.NE.0)THEN
- IYMIN = 0
- IYMAX = 0
- ELSE
- IYMIN = 1
- IYMAX = NY
- IF(NPAR.GE.10)THEN
- IF(PAR(10).GT.0.)THEN
- IYMIN = INT(PAR(10)/1000)
- IYMAX = INT(PAR(10)-(1000*IYMIN))
- ELSEIF(PAR(10).LT.0.)THEN
- IYMIN = -PAR(10)
- IYMAX = IQUEST(61)
- ENDIF
- ENDIF
- ENDIF
-*
-* In case of surfaces at least 2 channels are needed
-*
- IF(ISURF.NE.0)THEN
- IF(IXMAX.EQ.IXMIN)THEN
- IXMAX=IXMAX+1
- IF(IXMAX.GT.NX)THEN
- IXMAX=NX
- IXMIN=IXMIN-1
- ENDIF
- ENDIF
- IF(IYMAX.EQ.IYMIN)THEN
- IYMAX=IYMAX+1
- IF(IYMAX.GT.NY)THEN
- IYMAX=NY
- IYMIN=IYMIN-1
- ENDIF
- ENDIF
- ENDIF
-*
- NXCHA=IXMAX-IXMIN+1
- NYCHA=IYMAX-IYMIN+1
- IF(IXMIN.GT.IXMAX)THEN
- CALL IGERR('PAR(9) is not valid','IGTABL')
- GOTO 450
- ENDIF
- IF(IYMIN.GT.IYMAX.AND.NY.GT.0)THEN
- CALL IGERR('PAR(10) is not valid','IGTABL')
- GOTO 450
- ENDIF
- IF(IOPTGX.NE.0)THEN
- XSTP=(10**RWXMAX-10**RWXMIN)/FLOAT(IXMAX-IXMIN+1)
- ELSE
- XSTP=(RWXMAX-RWXMIN)/FLOAT(IXMAX-IXMIN+1)
- ENDIF
- IF(IOPTGY.NE.0)THEN
- YSTP=(10**RWYMAX-10**RWYMIN)/FLOAT(IYMAX-IYMIN+1)
- ELSE
- YSTP=(RWYMAX-RWYMIN)/FLOAT(IYMAX-IYMIN+1)
- ENDIF
-*
-* Compute ZMAX and ZMIN
-*
- IF(ZHIGH.NE.ZLOW)THEN
- ZMAX=ZHIGH
- ZMIN=ZLOW
- ELSE
- ZMIN=IGCELL(NX,NY,V,IXMIN,IYMIN,1)
- ZMAX=ZMIN
- DO 40 J=IYMIN,IYMAX
- DO 30 I=IXMIN,IXMAX
- Z=IGCELL(NX,NY,V,I,J,1)
- IF(IOPTGZ.NE.0)THEN
- IF(Z.GT.0)THEN
- IF(ZMIN.LE.0)THEN
- ZMIN = Z
- ELSE
- ZMIN=MIN(ZMIN,Z)
- ENDIF
- ENDIF
- ELSE
- ZMIN=MIN(ZMIN,Z)
- ENDIF
- ZMAX=MAX(ZMAX,Z)
- 30 CONTINUE
- 40 CONTINUE
- ENDIF
- IF(IOPTGZ.NE.0)THEN
- IF(ZMAX.GT.0.)THEN
- IF(ZMIN.LE.0.)ZMIN=0.001*ZMAX
- ZLOW=ZMIN
- ZHIGH=ZMAX
- ZMAX=LOG10(ZMAX)
- ZMIN=LOG10(ZMIN)
- ELSE
- CALL IGERR('Negative logarithmic axis','IGTABL')
- GOTO 450
- ENDIF
- ENDIF
- IF(ZMAX.EQ.ZMIN)THEN
- EPS=ABS(ZMAX*0.1)
- IF(EPS.EQ.0)EPS=0.1
- ZMAX=ZMAX+EPS
- ZMIN=ZMIN-EPS
- ENDIF
- DZ=ZMAX-ZMIN
- IF(DZ.LE.0.)THEN
- CALL IGERR('ZMAX < ZMIN','IGTABL')
- GOTO 450
- ENDIF
- RQUEST(11) = ZMIN
- RQUEST(12) = ZMAX
- ILOG = IOPTGZ
-*
- XK=RWXMIN
- YK=RWYMIN
- IF(IOPTGX.NE.0)XK=10**RWXMIN
- IF(IOPTGY.NE.0)YK=10**RWYMIN
-*
- HMAX=1.
- IF(IDIM1.NE.0)THEN
- HMAX=1.1
- IF(NPAR.GE.5)THEN
- IF(PAR(5).NE.0.)HMAX=1./PAR(5)
- ENDIF
- ENDIF
-*
- RAD = ATAN(1.)*4./180.
-*.______________________________________
-*
-* Store the stacked histograms parameters
-*
- IF(IOPTPP.NE.0)THEN
- NIDS=NIDS+1
- IF(NIDS.EQ.1)THEN
- XLAB1=FLOAT(IXMIN)
- XLAB2=FLOAT(IXMAX)
- YLAB1=FLOAT(IYMIN)
- YLAB2=FLOAT(IYMAX)
- IF(NPAR.GE.6)THEN
- IF(PAR(4).GT.PAR(3))THEN
- XLAB1=PAR(3)
- XLAB2=PAR(4)
- ENDIF
- IF(PAR(6).GT.PAR(5))THEN
- YLAB1=PAR(5)
- YLAB2=PAR(6)
- ENDIF
- ENDIF
- ENDIF
- IF(NIDS.EQ.10)THEN
- CALL IGERR('Too many stacked histograms','IGTABL')
- NIDS=9
- GOTO 450
- ENDIF
- IF(IPACK.NE.0)THEN
- LSTACK(NIDS)=INT(V(1))
- ELSE
- LSTACK(NIDS)=LOCF(V(1))
- ENDIF
- IXFCHA(NIDS)=IXMIN
- IYFCHA(NIDS)=IYMIN
- IXNCHA(NIDS)=NXCHA
- IYNCHA(NIDS)=NYCHA
- IF(NPAR.GE.25)THEN
- ISTCOL(NIDS)=PAR(25)
- ELSE
- ISTCOL(NIDS)=NIDS
- ENDIF
- GOTO 450
- ENDIF
-*.______________________________________
-*
-* Draw the table with a density of points (scatter plot)
-*
- IF(IOPTP.NE.0)THEN
- FACN=1.
- LTEST=.FALSE.
- IF(ZMAX.GE.50..OR.ZMAX.LT.1.)THEN
- FACN=49./DZ
- LTEST=.TRUE.
- ENDIF
- IPMNUM=0
- DO 80 J=IYMIN,IYMAX
- DO 70 I=IXMIN,IXMAX
- Z=IGCELL(NX,NY,V,I,J,1)-ZMIN
- IF(Z.EQ.0.)GOTO 60
- K=INT(Z*FACN)
- IF(LTEST)K=K+1
- IF(K.GT.0)THEN
- IF((K+IPMNUM).GE.NMAX)THEN
- CALL IPM(IPMNUM,XBUF,YBUF)
- IPMNUM=0
- ENDIF
- DO 50 LOOP=1,K
- XBUF(IPMNUM+LOOP)=(RNDM(LOOP)*XSTP)+XK
- IF(IOPTGX.NE.0)XBUF(IPMNUM+LOOP)=
- + LOG10(XBUF(IPMNUM+LOOP))
- YBUF(IPMNUM+LOOP)=(RNDM(LOOP)*YSTP)+YK
- IF(IOPTGY.NE.0)YBUF(IPMNUM+LOOP)=
- + LOG10(YBUF(IPMNUM+LOOP))
- 50 CONTINUE
- IPMNUM=IPMNUM+K
- ENDIF
- 60 XK=XK+XSTP
- 70 CONTINUE
- IF(IOPTGX.NE.0)THEN
- XK=10**RWXMIN
- ELSE
- XK=RWXMIN
- ENDIF
- YK=YK+YSTP
- 80 CONTINUE
- IF(IPMNUM.GT.0)CALL IPM(IPMNUM,XBUF,YBUF)
- GOTO 440
- ENDIF
-*.______________________________________
-*
-* Draw the table with proportional boxes
-*
- IF(IOPTB.NE.0)THEN
- XMID=XSTP/2.
- YMID=YSTP/2.
- DO 100 J=IYMIN,IYMAX
- DO 90 I=IXMIN,IXMAX
- Z=IGCELL(NX,NY,V,I,J,1)
- IF(Z.NE.ZMIN)THEN
- ZRATIO = SQRT((Z-ZMIN)/DZ)
- XU=(XMID*ZRATIO)+(XK+XMID)
- XL=2*(XK+XMID)-XU
- IF(IOPTGX.NE.0)THEN
- XU=LOG10(XU)
- XL=LOG10(XL)
- ENDIF
- YU=(YMID*ZRATIO)+(YK+YMID)
- YL=2*(YK+YMID)-YU
- IF(IOPTGY.NE.0)THEN
- YU=LOG10(YU)
- YL=LOG10(YL)
- ENDIF
- CALL IGBOX(XL,XU,YL,YU)
- ENDIF
- XK=XK+XSTP
- 90 CONTINUE
- IF(IOPTGX.NE.0)THEN
- XK=10**RWXMIN
- ELSE
- XK=RWXMIN
- ENDIF
- YK=YK+YSTP
- 100 CONTINUE
- GOTO 440
- ENDIF
-*.______________________________________
-*
-* Draw the table with arrows
-*
- IF(IOPTR.NE.0)THEN
- XRG=RVXMIN
- YRG=RVYMIN
- XLN=RVXMAX-RVXMIN
- YLN=RVYMAX-RVYMIN
- CX=(XLN/NXCHA-0.03)/2.
- CY=(YLN/NYCHA-0.03)/2.
- DN=1.E-30
- CALL ISLN(1)
- DO 130 ID=1,2
- DO 120 J=IYMIN,IYMAX
- DO 110 I=IXMIN,IXMAX
- IF(I.EQ.IXMIN)THEN
- DX=IGCELL(NX,NY,V,I+1,J,1)-IGCELL(NX,NY,V,I,J,1)
- ELSEIF(I.EQ.IXMAX)THEN
- DX=IGCELL(NX,NY,V,I,J,1)-IGCELL(NX,NY,V,I-1,J,1)
- ELSE
- DX=(IGCELL(NX,NY,V,I+1,J,1)-
- + IGCELL(NX,NY,V,I-1,J,1))/2
- ENDIF
- IF(J.EQ.IYMIN)THEN
- DY=IGCELL(NX,NY,V,I,J+1,1)-IGCELL(NX,NY,V,I,J,1)
- ELSEIF(J.EQ.IYMAX)THEN
- DY=IGCELL(NX,NY,V,I,J,1)-IGCELL(NX,NY,V,I,J-1,1)
- ELSE
- DY=(IGCELL(NX,NY,V,I,J+1,1)-
- + IGCELL(NX,NY,V,I,J-1,1))/2
- ENDIF
- IF(ID.EQ.1)THEN
- DN=MAX(DN,ABS(DX),ABS(DY))
- ELSEIF(ID.EQ.2)THEN
- XC=XRG+XLN*(FLOAT(I-IXMIN+1)-0.5)/NXCHA
- DXN=CX*DX/DN
- X1=XC-DXN
- X2=XC+DXN
- YC=YRG+YLN*(FLOAT(J-IYMIN+1)-0.5)/NYCHA
- DYN=CY*DY/DN
- Y1=YC-DYN
- Y2=YC+DYN
- XBUF(1)=X1
- XBUF(2)=X2
- YBUF(1)=Y1
- YBUF(2)=Y2
- IF(ABS(X2-X1).GT.1.E-2.OR.ABS(Y2-Y1).GT.1.E-2)THEN
- ANR=0.005*.5*SQRT(2/(DXN**2+DYN**2))
- SI=ANR*(DXN+DYN)
- CO=ANR*(DXN-DYN)
- XBUF(3)=X2-SI
- YBUF(3)=Y2+CO
- CALL IPL(3,XBUF,YBUF)
- XBUF(1)=X2
- XBUF(2)=X2-CO
- YBUF(1)=Y2
- YBUF(2)=Y2-SI
- CALL IPL(2,XBUF,YBUF)
- ELSE
- CALL IPL(2,XBUF,YBUF)
- ENDIF
- ENDIF
- 110 CONTINUE
- 120 CONTINUE
- 130 CONTINUE
- GOTO 440
- ENDIF
-*.______________________________________
-*
-* Draw the table with color levels
-*
- IF(IOPCOL.NE.0)THEN
- CALL ISFAIS(1)
- MAXCP=MAXCOL
- IF(INBCOL.GT.8)MAXCP=INBCOL-7
- IF(NPAR.GE.1)THEN
- IF(PAR(1).EQ.1.)THEN
- CALL ISFAIS(2)
- MAXCP=MAXPAT
- ENDIF
- ENDIF
- CALL IGSET('BORD',0.)
- DO 150 J=IYMIN,IYMAX
- DO 140 I=IXMIN,IXMAX
- Z=IGCELL(NX,NY,V,I,J,1)
- ICOL=INT(MAXCP*(Z-ZMIN)/DZ)
- IF(IFAIS.EQ.2)THEN
- CALL ISFASI(IPATRN(ICOL))
- ELSE
- IF(ICOL.GT.MAXCP-1)ICOL=MAXCP-1
- IF(INBCOL.GT.8)THEN
- CALL ISFACI(ICOL+8)
- ELSE
- CALL ISFACI(LUT(ICOL+1))
- ENDIF
- ENDIF
- XU=XK+XSTP
- XL=XK
- IF(IOPTGX.NE.0)THEN
- XU=LOG10(XU)
- XL=LOG10(XL)
- ENDIF
- YU=YK+YSTP
- YL=YK
- IF(IOPTGY.NE.0)THEN
- YU=LOG10(YU)
- YL=LOG10(YL)
- ENDIF
- CALL IGBOX(XL,XU,YL,YU)
- XK=XK+XSTP
- 140 CONTINUE
- IF(IOPTGX.NE.0)THEN
- XK=10**RWXMIN
- ELSE
- XK=RWXMIN
- ENDIF
- YK=YK+YSTP
- 150 CONTINUE
- CALL IGSET('BORD',1.)
- CALL ISFAIS(0)
- CALL ISPLCI(1)
- CALL IGBOX(RWXMIN,RWXMAX,RWYMIN,RWYMAX)
- IF(IOPTZ.NE.0)THEN
- XX=0.01*(RWXMAX-RWXMIN)
- IF(INBCOL.GT.8)THEN
- IC1=8
- IC2=INBCOL
- ELSE
- IC1=0
- IC2=7
- ENDIF
- CALL ISCLIP(0)
- IF(IOPTGZ.NE.0)THEN
- CALL IGCOLM(RWXMAX+XX,RWXMAX+4.*XX,RWYMIN,RWYMAX
- +, IC1,IC2,10.**ZMIN,10.**ZMAX,'CAG')
- ELSE
- CALL IGCOLM(RWXMAX+XX,RWXMAX+4.*XX,RWYMIN,RWYMAX
- +, IC1,IC2,ZMIN,ZMAX,'CA')
- ENDIF
- ENDIF
- GOTO 440
- ENDIF
-*.______________________________________
-*
-* Draw the table as a contour plot
-*
- IF(IOPTC.NE.0)THEN
- NCONT = 20
- ILNSAV = ILN
- CALL ISLN(1)
- IF(NPAR.GE.1)THEN
- IF(PAR(1).GE.2..AND.PAR(1).LE.50.)NCONT=INT(PAR(1))
- ENDIF
- ITYPE = 0
- ICOL = 1
- IF(NPAR.GE.2)THEN
- IF(PAR(2).GE.1..AND.PAR(2).LT.3.)THEN
- ITYPE = INT(PAR(2))
- ICOL = INT((PAR(2)-ITYPE)*1000.+0.5)
- IF(ICOL.LE.0)ICOL=1
- CALL ISPLCI(ICOL)
- IF(ITYPE.EQ.2)CALL ISLN(ILNSAV)
- ENDIF
- ENDIF
- IF(IXMAX.EQ.IXMIN.OR.IYMAX.EQ.IYMIN)THEN
- CALL IGERR('At least 2 channels are needed in contour',
- + 'IGTABL')
- GOTO 450
- ENDIF
- XSTP=(RWXMAX-RWXMIN)/FLOAT(IXMAX-IXMIN+1)
- YSTP=(RWYMAX-RWYMIN)/FLOAT(IYMAX-IYMIN+1)
- IEND=1
- IF(NPAR.GT.10)THEN
- IEND=NPAR-10
- NCONT=12
- ZMINS=ZMIN
- ZMAXS=ZMAX
- ENDIF
- DO 240 ICONT=1,IEND
- IF(NPAR.GT.10)THEN
- IF(PAR(ICONT+10).GT.ZMAXS.OR.PAR(ICONT+10).LT.ZMINS)THEN
- CALL IGERR('Z value outside limits','IGTABL')
- GOTO 450
- ENDIF
- ZMAX=ZMAXS
- ZMIN=PAR(ICONT+10)-(ZMAXS-PAR(ICONT+10))
- IF(ZMIN.LT.ZMINS)THEN
- ZMIN=ZMINS
- ZMAX=PAR(ICONT+10)+(PAR(ICONT+10)-ZMINS)
- ENDIF
- ZHIGH=ZMAX
- ZLOW=ZMIN
- DZ=ZMAX-ZMIN
- IF (DZ.EQ.0) THEN
- CALL IGERR('ZMIN = ZMAX ','IGTABL')
- GOTO 450
- ENDIF
- ENDIF
- DO 230 J=IYMIN,IYMAX-1
- Y(1)=FLOAT(J-IYMIN)*YSTP+RWYMIN+YSTP/2.
- Y(2)=Y(1)
- Y(3)=FLOAT(J-IYMIN+1)*YSTP+RWYMIN+YSTP/2.
- Y(4)=Y(3)
- DO 220 I=IXMIN,IXMAX-1
- ZC(1)=IGCELL(NX,NY,V,I,J,1)
- ZC(2)=IGCELL(NX,NY,V,I+1,J,1)
- ZC(3)=IGCELL(NX,NY,V,I+1,J+1,1)
- ZC(4)=IGCELL(NX,NY,V,I,J+1,1)
- IR(1)=INT((ZC(1)-ZMIN)*NCONT/DZ)
- IR(2)=INT((ZC(2)-ZMIN)*NCONT/DZ)
- IR(3)=INT((ZC(3)-ZMIN)*NCONT/DZ)
- IR(4)=INT((ZC(4)-ZMIN)*NCONT/DZ)
- IF(IR(1).NE.IR(2).OR.IR(2).NE.IR(3).OR.
- + IR(3).NE.IR(4).OR.IR(4).NE.IR(1))THEN
- X(1)=FLOAT(I-IXMIN)*XSTP+RWXMIN+XSTP/2.
- X(4)=X(1)
- X(2)=FLOAT(I-IXMIN+1)*XSTP+RWXMIN+XSTP/2.
- X(3)=X(2)
- N=LVMIN(ZC,4)
- LJ=1
- DO 160 IX=1,4
- M=MOD(N,4)+1
- LJ=LJ+2*IGTAB1(ZC(N),IR(N),X(N),Y(N),ZC(M),
- + IR(M),X(M),Y(M),XARR(LJ),YARR(LJ),ITARR(LJ),
- + NCONT)
- N=M
- 160 CONTINUE
- N=LVMIN(ZC,4)
- LJ=2
- DO 170 IX=1,4
- IF(N.EQ.1)THEN
- M=4
- ELSE
- M=N-1
- ENDIF
- LJ=LJ+2*IGTAB1(ZC(N),IR(N),X(N),Y(N),ZC(M),
- + IR(M),X(M),Y(M),XARR(LJ),YARR(LJ),ITARR(LJ),
- + NCONT)
- N=M
- 170 CONTINUE
-*
-* Re-order endpoints
-*
- DO 200 IX=1,LJ-5,2
- 180 IF(ITARR(IX).NE.ITARR(IX+1))THEN
- XSAVE=XARR(IX+1)
- YSAVE=YARR(IX+1)
- ITARS=ITARR(IX+1)
- DO 190 JX=IX,LJ-5,2
- XARR(JX+1)=XARR(JX+3)
- YARR(JX+1)=YARR(JX+3)
- ITARR(JX+1)=ITARR(JX+3)
- 190 CONTINUE
- XARR(LJ-2)=XSAVE
- YARR(LJ-2)=YSAVE
- ITARR(LJ-2)=ITARS
- GOTO 180
- ENDIF
- 200 CONTINUE
-*
- DO 210 IX=1,LJ-2,2
- IF(NPAR.GT.10)THEN
- IF(ITARR(IX).NE.6)THEN
- GOTO 210
- ELSE
- MODE=MAX(MOD(ICONT,5),1)
- ENDIF
- ELSE
- ICOL=(4*ITARR(IX))/NCONT+1
- IF(ITYPE.EQ.0)MODE=ICOL
- IF(ITYPE.EQ.1)THEN
- MODE=MOD(ICOL,5)
- IF(MODE.EQ.0)MODE=5
- ENDIF
- ENDIF
- IF(ITYPE.EQ.0)CALL ISPLCI(MODE)
- IF(ITYPE.EQ.1)CALL ISLN(MODE)
- CALL IPL(2,XARR(IX),YARR(IX))
- 210 CONTINUE
- ENDIF
- 220 CONTINUE
- 230 CONTINUE
- 240 CONTINUE
- GOTO 440
- ENDIF
-*.______________________________________
-*
-* Draw the table with the table content (INTEGER)
-*
- IF(IOPTT.NE.0)THEN
- XK=RWXMIN+XSTP/2.
- YK=RWYMIN+YSTP/2.
- XK0=XK
- IF(NPAR.GE.2)THEN
- TSIZ=YSTP*PAR(1)
- ELSE
- TSIZ=YSTP*0.3
- ENDIF
- CALL ISCHH(TSIZ)
- CALL ISTXAL(2,3)
- CALL IGSET('TANG',0.)
- DO 260 J=IYMIN,IYMAX
- DO 250 I=IXMIN,IXMAX
- Z=IGCELL(NX,NY,V,I,J,1)
- IC=INT(Z)
- IF(IC.NE.0)THEN
- CALL IZITOC(IC,CHAT)
- CALL ITX(XK,YK,CHAT)
- ENDIF
- XK=XK+XSTP
- 250 CONTINUE
- XK=XK0
- YK=YK+YSTP
- 260 CONTINUE
- GOTO 440
- ENDIF
-*.______________________________________
-*
-* Draw the table with one character per cell
-*
- IF(IOPTK.NE.0)THEN
- CHK='.+23456789ABCDEFGHIJKLMNOPQRSTUVWXYZ*'
- XK=RWXMIN+XSTP/2.
- YK=RWYMIN+YSTP/2.
- XK0=XK
- IF(NPAR.GE.2)THEN
- TSIZ=YSTP*PAR(1)
- ELSE
- TSIZ=YSTP*0.3
- ENDIF
- CALL ISCHH(TSIZ)
- CALL ISTXAL(2,3)
- CALL IGSET('TANG',0.)
- DO 280 J=IYMIN,IYMAX
- DO 270 I=IXMIN,IXMAX
- Z=IGCELL(NX,NY,V,I,J,1)
- IC=NINT(Z+0.5)
- IF(IC.GT.37)IC=37
- IF(IC.GT.0)CALL ITX(XK,YK,CHK(IC:IC))
- XK=XK+XSTP
- 270 CONTINUE
- XK=XK0
- YK=YK+YSTP
- 280 CONTINUE
- GOTO 440
- ENDIF
-*.______________________________________
-*
-* 3D representations
-*
- IF(I3D.LE.0)GOTO 450
- CALL ISCLIP(0)
-*
-* Restore the color map if necessary
-*
- IF(NBCSAV.NE.0)THEN
- DO 290 I=1,NBCSAV
- CALL ISCR(1,ISTCO2(I),RSTRS(I),RSTGS(I),RSTBS(I))
- 290 CONTINUE
- NBCSAV = 0
- ENDIF
- IF(ISTCOB.NE.0)THEN
- CALL ISCR(1,ISTCOB,RSTRBS,RSTGBS,RSTBBS)
- ISTCOB = 0
- ENDIF
- IF(ISTCOT.NE.0)THEN
- CALL ISCR(1,ISTCOT,RSTRTS,RSTGTS,RSTBTS)
- ISTCOT = 0
- ENDIF
-*
-* Define the labels on the axis
-*
- IF(NIDS.EQ.0)THEN
- XLAB1 = FLOAT(IXMIN)
- XLAB2 = FLOAT(IXMAX)
- YLAB1 = FLOAT(IYMIN)
- YLAB2 = FLOAT(IYMAX)
- IF(NPAR.GE.6)THEN
- IF(PAR(4).GT.PAR(3))THEN
- XLAB1 = PAR(3)
- XLAB2 = PAR(4)
- ENDIF
- IF(PAR(6).GT.PAR(5))THEN
- YLAB1 = PAR(5)
- YLAB2 = PAR(6)
- ENDIF
- ENDIF
- ZMINST = ZMIN
- ZMAXST = ZMAX
- IF(ILOG.NE.0)THEN
- ZMAXST = 10.**ZMAX
- ZMINST = 10.**ZMIN
- ENDIF
- IF(ILOGX.NE.0)THEN
- IF(XLAB2.GT.0.)THEN
- IF(XLAB1.LE.0.)XLAB1 = MIN(XLAB2/1000.,1.)
- ELSE
- ILOGX = 0
- ENDIF
- ENDIF
- IF(ILOGY.NE.0)THEN
- IF(YLAB2.GT.0.)THEN
- IF(YLAB1.LE.0.)YLAB1 = MIN(YLAB2/1000.,1.)
- ELSE
- ILOGY = 0
- ENDIF
- ENDIF
- ENDIF
-*
-* Initialize the axis parameter
-*
- XBUF(11) = 510.
- XBUF(12) = 510.
- XBUF(13) = 510.
- XBUF(14) = 1.
- XBUF(15) = 1.
- XBUF(16) = 1.
- XBUF(17) = 0.02
- XBUF(18) = 0.02
- XBUF(19) = 0.02
- XBUF(20) = 0.02
- XBUF(21) = 2.
- XBUF(22) = 0.02
- XBUF(23) = 0.02
- XBUF(24) = 0.04
- IF(NPAR.GT.10)THEN
- DO 300 I=11,NPAR
- XBUF(I) = PAR(I)
- 300 CONTINUE
- ENDIF
- XBUF(25) = ILOGX
- XBUF(26) = ILOGY
- XBUF(27) = ILOG
-*
-* Define the coordinate system
-*
-* ISYS = 1 : Cratesian Coordinate System
-* ISYS = 2 : Polar Coordinate System
-* ISYS = 3 : Cylindrical Coordinate System
-* ISYS = 4 : Spherical Coordinate System
-* ISYS = 5 : Pseudo rapidity
-* IRAST = 1 : "Raster screen" algorithm must be used
-* for hidden line drawing
-*
- ISYS = 1
- IF(IOPPOL.NE.0)ISYS = 2
- IF(IOPCYL.NE.0)ISYS = 3
- IF(IOPSPH.NE.0)ISYS = 4
- IF(IOPPSD.NE.0)ISYS = 5
- IF((IOPTL+IOPTS+IOPTS3).NE.0.AND.ISYS.GE.2)IRAST = 1
-*
-* Define viewing angles
-*
- THEDEG = 60.
- PHIDEG = -120.
- PSIDEG = 0.
- IF(NPAR.GE.2)THEN
- THEDEG = 90.-PAR(1)
- PHIDEG = -90.-PAR(2)
- ENDIF
-*
- IDRGR = 1
- IF(NPAR.GE.25)THEN
- ISTCOL(NIDS+1) = PAR(25)
- ELSE
- IF(IOPTL.NE.0)THEN
- ISTCOL(NIDS+1) = 1
- ELSE
- ISTCOL(NIDS+1) = 0
- ENDIF
- ENDIF
-*
-* Copy the color table in a INTEGER array. The
-* vector ITARR is used normally in the contour plot
-* algorithm so it can be used here without clashes.
-* If NPAR is less than 25 the LUT is used as the
-* color table.
-*
- IF(NPAR.GE.25)THEN
- MAXCP = 0
- DO 310 I=25,NPAR
- IF(I.GT.100)THEN
- CALL IGERR('Color table too big','IGTABL')
- GOTO 450
- ENDIF
- ITARR(I-24) = INT(PAR(I))
- MAXCP = MAXCP+1
- 310 CONTINUE
- ELSE
- MAXCP=MAXCOL
- DO 320 I=1,MAXCOL
- ITARR(I)=LUT(I)
- 320 CONTINUE
- ENDIF
-*
-* If the errors are required and if one of the color
-* option is required, the colors represent the color,
-* so the minimum and maximum of the errors has to be
-* computed.
-*
- IF (IOPTER.NE.0) THEN
- IF (IOPTS3+IOPTS1+IOPTS2+IOPTL2.NE.0) THEN
- Z1C = IGCELL(NX,NY,V,1,1,2)
- Z2C = Z1C
- DO 340 J=IYMIN,IXMAX
- DO 330 I=IXMIN,IXMAX
- ZE = IGCELL(NX,NY,V,I,J,2)
- IF (ZE.GT.Z2C) Z2C = ZE
- IF (ZE.LT.Z1C) Z1C = ZE
- 330 CONTINUE
- 340 CONTINUE
- ENDIF
- ELSE
- Z1C = ZMIN
- Z2C = ZMAX*HMAX
- ENDIF
- RQUEST(11) = Z1C
- RQUEST(12) = Z2C
-*
-* Create a buffer used by the "Raster screen" algorithm
-*
- IF(IRAST.NE.0)THEN
- IF(IPACK.NE.0)LWV=INT(V(1))
- NWNEED = (NRASTX*NRASTY)/30+1
- CALL MZNEED(IXHIGZ,NWNEED+25,'G')
- IF (IQUEST(11).LT.0) THEN
- CALL IGERR('IGTABL','Not enough space in memory')
- GOTO 450
- ENDIF
- IF(LCG.NE.0)CALL MZDROP(IXHIGZ,LCG,' ')
- CALL MZBOOK(IXHIGZ,LCG,LCG,1,'TEMP',0,0,NWNEED,3,0)
- IF(IPACK.NE.0)V(1)=FLOAT(LWV)
- ENDIF
-*
-* Initialise the adress NIDS+1 for IGCELL
-*
- IF(IPACK.NE.0)THEN
- REFWRD(NIDS+1)=V(1)
- ELSE
- LSTACK(NIDS+1)=LOCF(V(1))
- IADRES(NIDS+1)=LSTACK(NIDS+1)-LOCF(REFWRD)
- ENDIF
-*
-* XSTP = X step
-* XSTP = Y step
-* RINRAD = Inner radius for Polar, Cylindrical, and Spherical representations
-* DANG = Delta angle for PSD option
-*
- XSTP = (XLAB2-XLAB1)/FLOAT(NXCHA)
- YSTP = (YLAB2-YLAB1)/FLOAT(NYCHA)
- RINRAD = 0.5
- DANG = 10.
-*.______________________________________
-*
-* Plotting surfaces
-*
- IF(ISURF.NE.0)THEN
- IF(IOPTS2.NE.0.OR.IOPTS4.NE.0)IDRGR=0
- IF(IOPTS3.NE.0)IDRGR=3
- IXFCHA(1) = IXMIN
- IYFCHA(1) = IYMIN
- XVAL1 = XLAB1-(IXFCHA(1)-1)*XSTP
- XVAL2 = (NCX-NXCHA-IXFCHA(1)+1)*XSTP+XLAB2
- YVAL1 = YLAB1-(IYFCHA(1)-1)*YSTP
- YVAL2 = (NCY-NYCHA-IYFCHA(1)+1)*YSTP+YLAB2
- XBUF(1) = -1.
- YBUF(1) = 1.
- XBUF(2) = -1.
- YBUF(2) = 1.
- IF(IOPPOL.NE.0)THEN
- XBUF(3) = ZMIN
- YBUF(3) = ZMAX*HMAX
- ELSEIF(IOPCYL.NE.0)THEN
- IF(ILOGY.NE.0)THEN
- XBUF(3) = LOG10(YLAB1)
- YBUF(3) = LOG10(YLAB2)
- ELSE
- XBUF(3) = YLAB1
- YBUF(3) = YLAB2
- ENDIF
- PSIDEG = 90.
- ELSEIF(IOPSPH.NE.0)THEN
- XBUF(3) = -1.
- YBUF(3) = 1.
- PSIDEG = 90.
- ELSEIF(IOPPSD.NE.0)THEN
- XBUF(3) = -1./TAN(DANG*RAD)
- YBUF(3) = 1./TAN(DANG*RAD)
- PSIDEG = 90.
- ELSE
- IF(ILOGX.NE.0)THEN
- XBUF(1) = LOG10(XLAB1)
- YBUF(1) = LOG10(XLAB2)
- ELSE
- XBUF(1) = XLAB1
- YBUF(1) = XLAB2
- ENDIF
- IF(ILOGY.NE.0)THEN
- XBUF(2) = LOG10(YLAB1)
- YBUF(2) = LOG10(YLAB2)
- ELSE
- XBUF(2) = YLAB1
- YBUF(2) = YLAB2
- ENDIF
- XBUF(3) = ZMIN
- YBUF(3) = ZMAX*HMAX
- ENDIF
- CALL ISWN3(INTR
- +, XBUF(1),YBUF(1),XBUF(2),YBUF(2),XBUF(3),YBUF(3)
- +, PHIDEG,THEDEG,PSIDEG,' ')
- CALL ISELNT(INTR)
- CALL IGTAB4(XBUF,YBUF,XBUF(16))
-*
-* Close the surface in case of non cartesian coordinates.
-*
- IF(ISYS.GT.1.AND.IXMIN.EQ.1.AND.IXMAX.EQ.NX)NXCHA = NXCHA+1
-*
-* Draw the filled contour on top
-*
- IF(IOPTS3.NE.0)THEN
- CALL IGLEV(MAXCP,Z1C,Z2C,ITARR,'C')
- IF(IOPPOL.NE.0)THEN
- CALL IHSURP(1,NXCHA-1,NYCHA-1,IGTAB2,IHDF02,'BF')
- ELSEIF(IOPCYL.NE.0)THEN
- CALL IHSURR(1,NXCHA-1,NYCHA-1,IGTAB2,IHDF02,'BF')
- ELSEIF(IOPSPH.NE.0)THEN
- CALL IHSURS(0,1,NXCHA-1,NYCHA-1,IGTAB2,IHDF02,'BF')
- ELSEIF(IOPPSD.NE.0)THEN
- CALL IHSURS(1,1,NXCHA-1,NYCHA-1,IGTAB2,IHDF02,'BF')
- ELSE
- CALL IHSURC(90.,NXCHA-1,NYCHA-1,IGTAB2,IHDF02,'BF')
- ENDIF
- IDRGR=1
- ENDIF
-*
- IF(IRAST.NE.0)THEN
- CALL IHRINI(-1.1,-1.1,1.1,1.1,NRASTX,NRASTY,Q(LCG+1))
- ELSE
- CALL IHSINI(-1.1,1.1)
- ENDIF
-*
- IF((IOPTS1+IOPTS2+IOPTS4).NE.0)THEN
- CALL IGLEV(INT(XBUF(13)+0.1),XBUF(3),YBUF(3),0,'A')
- CALL ISPLCI(1)
- IF(ISYS.EQ.1.AND.IOPTBB.EQ.0)
- + CALL IHBBOX(XBUF,YBUF,90.,IHDFL1)
- ENDIF
-*
-* Gouraud Shading surface
-*
- IF(IOPTS4.NE.0)THEN
-* Define light palette
- RVAL(1)=FLOAT(IFACI)
- CALL IGQ('RGB ',RVAL)
- NBCS = INBCOL
- IF(INBCOL.LT.30)CALL IGSET('NCOL',30.)
- NCOL = MIN(20,INBCOL-8)
- ICOL1 = INBCOL-NCOL+1
- DCOL = 1./(2.*NCOL)
- CALL IGRTOH(RVAL(2),RVAL(3),RVAL(4),RHUE,RLIGHT,RSATUR)
- DO 350 I=ICOL1,ICOL1+NCOL-1
- CALL IGHTOR(RHUE,.4+FLOAT(I-ICOL1+1)*DCOL,RSATUR,R,G,B)
- CALL ISCR(1,I,R,G,B)
- 350 CONTINUE
-* Set light sources
- CALL IHLIGH(0,YDIFF, 0.,0.,0.,IREP)
- CALL IHLIGH(1,YLIGH1,1.,1.,1.,IREP)
- CALL IHPROP(QA,QD,QS,NQS,IREP)
- FMIN = YDIFF*QA
- FMAX = YDIFF*QA + (YLIGH1+0.1)*(QD+QS)
- CALL IHCSPE(NCOL,FMIN,FMAX,ICOL1,1,IREP)
- IF(IOPPOL.NE.0)THEN
- CALL IHSURP(1,NXCHA-1,NYCHA-1,IGTAB6,IHDF02,'BF')
- ELSEIF(IOPCYL.NE.0)THEN
- CALL IHSURR(1,NXCHA-1,NYCHA-1,IGTAB6,IHDF02,'BF')
- ELSEIF(IOPSPH.NE.0)THEN
- CALL IHSURS(0,1,NXCHA-1,NYCHA-1,IGTAB6,IHDF02,'BF')
- ELSEIF(IOPPSD.NE.0)THEN
- CALL IHSURS(1,1,NXCHA-1,NYCHA-1,IGTAB6,IHDF02,'BF')
- ELSE
- CALL IHSURC(90.,NXCHA-1,NYCHA-1,IGTAB6,IHDF02,'BF')
- ENDIF
- IF(NBCS.LE.8)CALL IGSET('NCOL',FLOAT(NBCS))
-*
-* Draw the surface
-*
- ELSE
- IF(IOPTS1+IOPTS2.NE.0)THEN
- CALL IGLEV(MAXCP,Z1C,Z2C,ITARR,'C')
- ELSE
- CALL IGLEV(INT(XBUF(13)+0.1),XBUF(3),YBUF(3),0,'A')
- ENDIF
- IF(IOPPOL.NE.0)THEN
- IF(IOPTS+IOPTS3.NE.0)
- + CALL IHSURP(1,NXCHA-1,NYCHA-1,IGTAB2,IHDFR1,'FB')
- IF(IOPTS1+IOPTS2.NE.0)
- + CALL IHSURP(1,NXCHA-1,NYCHA-1,IGTAB2,IHDF02,'BF')
- ELSEIF(IOPCYL.NE.0)THEN
- IF(IOPTS+IOPTS3.NE.0)
- + CALL IHSURR(1,NXCHA-1,NYCHA-1,IGTAB2,IHDFR1,'FB')
- IF(IOPTS1+IOPTS2.NE.0)
- + CALL IHSURR(1,NXCHA-1,NYCHA-1,IGTAB2,IHDF02,'BF')
- ELSEIF(IOPSPH.NE.0)THEN
- IF(IOPTS+IOPTS3.NE.0)
- + CALL IHSURS(0,1,NXCHA-1,NYCHA-1,IGTAB2,IHDFR1,'FB')
- IF(IOPTS1+IOPTS2.NE.0)
- + CALL IHSURS(0,1,NXCHA-1,NYCHA-1,IGTAB2,IHDF02,'BF')
- ELSEIF(IOPPSD.NE.0)THEN
- IF(IOPTS+IOPTS3.NE.0)
- + CALL IHSURS(1,1,NXCHA-1,NYCHA-1,IGTAB2,IHDFR1,'FB')
- IF(IOPTS1+IOPTS2.NE.0)
- + CALL IHSURS(1,1,NXCHA-1,NYCHA-1,IGTAB2,IHDF02,'BF')
- ELSE
- IF(IOPTS+IOPTS3.NE.0)
- + CALL IHSURC(90.,NXCHA-1,NYCHA-1,IGTAB2,IHDFL1,'FB')
- IF(IOPTS1+IOPTS2.NE.0)
- + CALL IHSURC(90.,NXCHA-1,NYCHA-1,IGTAB2,IHDF02,'BF')
- ENDIF
- ENDIF
-*
- IF(IOPTS+IOPTS3.NE.0)THEN
- CALL ISPLCI(1)
- IF(ISYS.EQ.1.AND.IOPTBB.EQ.0)
- + CALL IHBBOX(XBUF,YBUF,90.,IHDFL1)
- ENDIF
- IF(ISYS.EQ.1)THEN
- CALL IHSINI(-1.1,1.1)
- IF(IOPTFB.EQ.0)CALL IHFBOX(XBUF,YBUF,90.,IHDFL2)
- ENDIF
- IF(XBUF(11).NE.0.)CALL IGTAB5(XBUF,YBUF,90.,XBUF(11))
- GOTO 430
- ENDIF
-*.______________________________________
-*
-* Preparation for stacked legos plot
-*
- IXFCHA(NIDS+1)=IXMIN
- IYFCHA(NIDS+1)=IYMIN
- IF(ILOG.NE.0)ZMAXST=10.**ZMAX
- IF(ILOG.NE.0)ZMINST=10.**ZMIN
- IXNCHA(NIDS+1)=NXCHA
- IYNCHA(NIDS+1)=NYCHA
- DO 360 I=1,NIDS
- IF(IXNCHA(I).LT.NXCHA)NXCHA=IXNCHA(I)
- IF(IYNCHA(I).LT.NYCHA)NYCHA=IYNCHA(I)
- 360 CONTINUE
-*
-* Initialise the color indexes for lighting model (option L1 only)
-*
- IF(IOPTL1.NE.0)THEN
- IF(INBCOL.LE.2)THEN
- ISTCOT=ISTCOL(NIDS+1)
- ISTCOB=ISTCOL(1)
- DO 370 I=1,NIDS+1
- ISTCO2(I)=ISTCOL(I)
- 370 CONTINUE
- ELSE
- NBCSAV = NIDS+1
- DO 380 I=1,NBCSAV
- CALL IGGFIN(ISTCO2(I))
- RVAL(1) = FLOAT(ISTCO2(I))
- CALL IGQ('RGB ',RVAL)
- RSTRS(I) = RVAL(2)
- RSTGS(I) = RVAL(3)
- RSTBS(I) = RVAL(4)
- RVAL(1) = FLOAT(ISTCOL(I))
- CALL IGQ('RGB ',RVAL)
- CALL IGRTOH(RVAL(2),RVAL(3),RVAL(4),RHUE,RLIGHT,RSATUR)
- RLIGHT = RLIGHT*0.6
- CALL IGHTOR(RHUE,RLIGHT,RSATUR,RED,GREEN,BLUE)
- CALL ISCR(1,ISTCO2(I),RED,GREEN,BLUE)
- IF(I.EQ.1)THEN
- CALL IGGFIN(ISTCOB)
- RVAL(1) = ISTCOB
- CALL IGQ('RGB ',RVAL)
- RSTRBS = RVAL(2)
- RSTGBS = RVAL(3)
- RSTBBS = RVAL(4)
- RLIGHT=RLIGHT*1.4
- CALL IGHTOR(RHUE,RLIGHT,RSATUR,RED,GREEN,BLUE)
- CALL ISCR(1,ISTCOB,RED,GREEN,BLUE)
- ENDIF
- 380 CONTINUE
- CALL IGGFIN(ISTCOT)
- RVAL(1) = ISTCOT
- CALL IGQ('RGB ',RVAL)
- RSTRTS = RVAL(2)
- RSTGTS = RVAL(3)
- RSTBTS = RVAL(4)
- RLIGHT=RLIGHT*1.4
- CALL IGHTOR(RHUE,RLIGHT,RSATUR,RED,GREEN,BLUE)
- CALL ISCR(1,ISTCOT,RED,GREEN,BLUE)
- ENDIF
- ENDIF
-*
-* Initialise the NIDS first adress for IGCELL
-*
- DO 390 I=1,NIDS
- IF(IPACK.NE.0)THEN
- REFWRD(I)=FLOAT(LSTACK(I))
- ELSE
- IADRES(I)=LSTACK(I)-LOCF(REFWRD)
- ENDIF
- 390 CONTINUE
-*
-* Compute the ZMAX value for the complete stack
-*
- IF(NIDS.NE.0)THEN
- ZMINST=ZMAXST
- DO 420 J=1,NYCHA
- DO 410 I=1,NXCHA
- Z=0.
- ZLIN=0.
- DO 400 K=1,NIDS+1
- IXT=IXFCHA(K)+I-1
- IYT=IYFCHA(K)+J-1
- IF(IPACK.NE.0)THEN
- Z1=IGCELL(NCX,NCY,REFWRD(K),IXT,IYT,1)
- ELSE
- Z1=IGCELL(NCX,NCY,REFWRD(IADRES(K)+1),IXT,IYT,1)
- ENDIF
- Z=Z+Z1
- IF(ILOG.NE.0)ZLIN=ZLIN+10.**Z1
- 400 CONTINUE
- ZMAX=MAX(ZMAX,Z)
- ZMIN=MIN(ZMIN,Z)
- IF(ILOG.NE.0)THEN
- ZMAXST=MAX(ZMAXST,ZLIN)
- ZMAX=LOG10(ZMAXST)
- ZMINST=MIN(ZMINST,ZLIN)
- ZMIN=LOG10(ZMINST)
- ENDIF
- 410 CONTINUE
- 420 CONTINUE
- ENDIF
-*
-* Compute the values (for X and Y axis) on the bin 1 and NC
-*
- XVAL1 = XLAB1-(IXFCHA(1)-1)*XSTP
- XVAL2 = (NCX-NXCHA-IXFCHA(1)+1)*XSTP+XLAB2
- YVAL1 = YLAB1-(IYFCHA(1)-1)*YSTP
- YVAL2 = (NCY-NYCHA-IYFCHA(1)+1)*YSTP+YLAB2
-*.______________________________________
-*
-* Draw the Lego plot
-*
- IF(ILEGO.NE.0)THEN
- XBUF(1) = -1.
- YBUF(1) = 1.
- XBUF(2) = -1.
- YBUF(2) = 1.
- IF(ISYS.EQ.2)THEN
- XBUF(3) = ZMIN
- YBUF(3) = ZMAX*HMAX
- ELSEIF(ISYS.EQ.3)THEN
- IF(ILOGY.NE.0)THEN
- XBUF(3) = LOG10(YLAB1)
- YBUF(3) = LOG10(YLAB2)
- ELSE
- XBUF(3) = YLAB1
- YBUF(3) = YLAB2
- ENDIF
- PSIDEG = 90.
- ELSEIF(ISYS.EQ.4)THEN
- XBUF(3) = -1.
- YBUF(3) = 1.
- PSIDEG = 90.
- ELSEIF(ISYS.EQ.5)THEN
- XBUF(3) = -1./TAN(DANG*RAD)
- YBUF(3) = 1./TAN(DANG*RAD)
- PSIDEG = 90.
- ELSE
- IF(ILOGX.NE.0)THEN
- XBUF(1) = LOG10(XLAB1)
- YBUF(1) = LOG10(XLAB2)
- ELSE
- XBUF(1) = XLAB1
- YBUF(1) = XLAB2
- ENDIF
- IF(ILOGY.NE.0)THEN
- XBUF(2) = LOG10(YLAB1)
- YBUF(2) = LOG10(YLAB2)
- ELSE
- XBUF(2) = YLAB1
- YBUF(2) = YLAB2
- ENDIF
- XBUF(3) = ZMIN
- YBUF(3) = ZMAX*HMAX
- ENDIF
-*
- CALL IGLEV(INT(XBUF(13)+0.1),XBUF(3),YBUF(3),0,'A')
- CALL ISWN3(INTR
- +, XBUF(1),YBUF(1),XBUF(2),YBUF(2),XBUF(3),YBUF(3)
- +, PHIDEG,THEDEG,PSIDEG,' ')
- CALL ISELNT(INTR)
- CALL IGTAB4(XBUF,YBUF,XBUF(16))
-*
- IF(IRAST.NE.0)THEN
- CALL IHRINI(-1.1,-1.1,1.1,1.1,NRASTX,NRASTY,Q(LCG+1))
- ELSE
- CALL IHSINI(-1.1,1.1)
- ENDIF
-*
- IF((IOPTL1+IOPTL2).NE.0)THEN
- CALL ISPLCI(1)
- IF(ISYS.EQ.1.AND.IOPTBB.EQ.0)
- + CALL IHBBOX(XBUF,YBUF,90.,IHDFL1)
- ENDIF
- IF(IOPTL2.NE.0)CALL IGLEV(MAXCP,Z1C,Z2C,ITARR,'C')
-*
- IF(ISYS.EQ.2)THEN
- IF(IOPTL.NE.0) CALL IHLEGP(1,NXCHA,NYCHA,IGTAB3,IHDFR2,'FB')
- IF(IOPTL1.NE.0)CALL IHLEGP(1,NXCHA,NYCHA,IGTAB3,IHDF03,'BF')
- IF(IOPTL2.NE.0)CALL IHLEGP(1,NXCHA,NYCHA,IGTAB3,IHDF02,'BF')
- ELSEIF(ISYS.EQ.3)THEN
- IF(IOPTL.NE.0) CALL IHLEGR(1,NXCHA,NYCHA,IGTAB3,IHDFR2,'FB')
- IF(IOPTL1.NE.0)CALL IHLEGR(1,NXCHA,NYCHA,IGTAB3,IHDF03,'BF')
- IF(IOPTL2.NE.0)CALL IHLEGR(1,NXCHA,NYCHA,IGTAB3,IHDF02,'BF')
- ELSEIF(ISYS.EQ.4)THEN
- IF(IOPTL.NE.0)
- + CALL IHLEGS(0,1,NXCHA,NYCHA,IGTAB3,IHDFR2,'FB')
- IF(IOPTL1.NE.0)
- + CALL IHLEGS(0,1,NXCHA,NYCHA,IGTAB3,IHDF03,'BF')
- IF(IOPTL2.NE.0)
- + CALL IHLEGS(0,1,NXCHA,NYCHA,IGTAB3,IHDF02,'BF')
- ELSEIF(ISYS.EQ.5)THEN
- IF(IOPTL.NE.0)
- + CALL IHLEGS(1,1,NXCHA,NYCHA,IGTAB3,IHDFR2,'FB')
- IF(IOPTL1.NE.0)
- + CALL IHLEGS(1,1,NXCHA,NYCHA,IGTAB3,IHDF03,'BF')
- IF(IOPTL2.NE.0)
- + CALL IHLEGS(1,1,NXCHA,NYCHA,IGTAB3,IHDF02,'BF')
- ELSE
- IF(IOPTL.NE.0)
- + CALL IHLEGC(90.,NXCHA,NYCHA,IGTAB3,IHDFL2,'FB')
- IF(IOPTL1.NE.0)
- + CALL IHLEGC(90.,NXCHA,NYCHA,IGTAB3,IHDF03,'BF')
- IF(IOPTL2.NE.0)
- + CALL IHLEGC(90.,NXCHA,NYCHA,IGTAB3,IHDF02,'BF')
- ENDIF
-*
- IF(IOPTL.NE.0)THEN
- CALL ISPLCI(1)
- IF(ISYS.EQ.1.AND.IOPTBB.EQ.0)
- + CALL IHBBOX(XBUF,YBUF,90.,IHDFL1)
- ENDIF
- IF(ISYS.EQ.1)THEN
- CALL IHSINI(-1.1,1.1)
- IF(IOPTFB.EQ.0)CALL IHFBOX(XBUF,YBUF,90.,IHDFL2)
- ENDIF
- IF(XBUF(11).NE.0.)CALL IGTAB5(XBUF,YBUF,90.,XBUF(11))
- NIDS = 0
- GOTO 450
- ENDIF
-*.______________________________________
-*
-* Draw the colour table if required
-*
- 430 IF(IOPTZ.NE.0)THEN
- XX=0.01*(RWXMAX-RWXMIN)
- CALL ISCLIP(0)
- IF(IOPTGZ.NE.0)THEN
- CALL IGCOLM(RWXMAX+XX,RWXMAX+4.*XX,RWYMIN,RWYMAX
- +, MAXCP,ITARR,10.**Z1C,10.**Z2C,'CAPG')
- ELSE
- CALL IGCOLM(RWXMAX+XX,RWXMAX+4.*XX,RWYMIN,RWYMAX
- +, MAXCP,ITARR,Z1C,Z2C,'CAP')
- ENDIF
- GOTO 450
- ENDIF
-*.______________________________________
-*
-* Draw the axis for the 2D representation
-*
- 440 IF(IOPTA.NE.0)THEN
- CALL ISLN(1)
- CALL ISFAIS(0)
- CALL IGBOX(RWXMIN,RWXMAX,RWYMIN,RWYMAX)
- XLAB1=FLOAT(IXMIN)
- XLAB2=FLOAT(IXMAX)
- YLAB1=FLOAT(IYMIN)
- YLAB2=FLOAT(IYMAX)
- IF(NPAR.GE.6)THEN
- IF(PAR(4).GT.PAR(3))THEN
- XLAB1=PAR(3)
- XLAB2=PAR(4)
- ENDIF
- IF(PAR(6).GT.PAR(5))THEN
- YLAB1=PAR(5)
- YLAB2=PAR(6)
- ENDIF
- ENDIF
- AXFLAG=.FALSE.
- CHOPT=' '
- IF(IOPTGX.NE.0)CHOPT='G'
- CALL IGAXIS(RWXMIN,RWXMAX,RWYMIN,RWYMIN,XLAB1,XLAB2,510,
- + CHOPT)
- AXFLAG=.TRUE.
- CHOPT=' '
- IF(IOPTGY.NE.0)CHOPT='G'
- CALL IGAXIS(RWXMIN,RWXMIN,RWYMIN,RWYMAX,YLAB1,YLAB2,510,
- + CHOPT)
- AXFLAG=.FALSE.
- ENDIF
-*
-* Restore original graphic context
-*
- 450 IF(IRAST.NE.0)THEN
- CALL MZDROP(IXHIGZ,LCG,' ')
- LCG = 0
- ENDIF
- CALL IZSET
- ZFLAG=ZFSAV
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
-*
- END
diff --git a/src/graflib/higz/ig/igtcch.F b/src/graflib/higz/ig/igtcch.F
deleted file mode 100644
index 77e596b..0000000
--- a/src/graflib/higz/ig/igtcch.F
+++ /dev/null
@@ -1,71 +0,0 @@
-*
-* $Id: igtcch.F,v 1.1.1.1 1996/02/14 13:10:39 mclareni Exp $
-*
-* $Log: igtcch.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:39 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.19/11 17/09/93 13.48.15 by O.Couet
-*-- Author : O.Couet 11/05/93
- SUBROUTINE IGTCCH(CHTEXT)
-*.===========>
-*.
-*. This routine translate the IGTEXT control characters into
-*. IGTEXT printable characters.
-*.
-*. _Input/Output parameters:
-*.
-*. CHARACTER CHTEXT : String to be converted
-*.
-*..==========> (O.Couet)
- PARAMETER (LENBUF=132)
- CHARACTER*(*) CHTEXT
- CHARACTER*(LENBUF) CHBUF
-*.______________________________________
-*
- ILEN = LEN(CHTEXT)
- NCH = LENOCC(CHTEXT)
- IF(ILEN.GT.LENBUF)GOTO 20
- LMAX = LENBUF-3
- ICUR = 1
- CHBUF = ' '
- DO 10 I=1,NCH
- IF(ICUR.GT.LMAX)GOTO 20
- IF (CHTEXT(I:I).EQ.'<') THEN
- CHBUF(ICUR:) = '"L#'
- ELSEIF (CHTEXT(I:I).EQ.'>') THEN
- CHBUF(ICUR:) = '"G#'
- ELSEIF (CHTEXT(I:I).EQ.'#') THEN
- CHBUF(ICUR:) = '"F#'
- ELSEIF (CHTEXT(I:I).EQ.'$') THEN
- CHBUF(ICUR:) = '"D#'
- ELSEIF (CHTEXT(I:I).EQ.'[') THEN
- CHBUF(ICUR:) = '"M#'
- ELSEIF (CHTEXT(I:I).EQ.']') THEN
- CHBUF(ICUR:) = '"N#'
- ELSEIF (CHTEXT(I:I).EQ.'?') THEN
- CHBUF(ICUR:) = '"H#'
- ELSEIF (CHTEXT(I:I).EQ.'!') THEN
- CHBUF(ICUR:) = '"E#'
- ELSEIF (CHTEXT(I:I).EQ.'&') THEN
- CHBUF(ICUR:) = '"W#'
- ELSEIF (CHTEXT(I:I).EQ.':') THEN
- CHBUF(ICUR:) = '"J#'
- ELSEIF (CHTEXT(I:I).EQ.'%') THEN
- CHBUF(ICUR:) = '"Y#'
- ELSE
- CHBUF(ICUR:ICUR) = CHTEXT(I:I)
- ICUR = ICUR+1
- GOTO 10
- ENDIF
- ICUR = ICUR+3
- 10 CONTINUE
- CHTEXT = CHBUF(1:LENOCC(CHBUF))
- RETURN
-*
- 20 CONTINUE
- CALL IGERR('Length of the input string is too small',
- + 'IGTCCH')
- END
diff --git a/src/graflib/higz/ig/igterm.F b/src/graflib/higz/ig/igterm.F
deleted file mode 100644
index 191f04f..0000000
--- a/src/graflib/higz/ig/igterm.F
+++ /dev/null
@@ -1,60 +0,0 @@
-*
-* $Id: igterm.F,v 1.3 1996/04/16 08:12:23 couet Exp $
-*
-* $Log: igterm.F,v $
-* Revision 1.3 1996/04/16 08:12:23 couet
-* - rearange the #ifdef
-* - test on IZBUF was missing (the zbuffer is reactivated)
-*
-* Revision 1.2 1996/04/16 07:38:18 couet
-* The ZBUFER is temporarly deactivated for PS. It generated some
-* 'gr' out of context.
-*
-* Revision 1.1.1.1 1996/02/14 13:10:40 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.23/06 04/12/95 15.30.10 by O.Couet
-*-- Author : O.Couet 26/06/89
- SUBROUTINE IGTERM
-#include "higz/hiflag.inc"
-#if defined(CERNLIB_MAIL)
-#include "higz/himail.inc"
-#endif
-#if (defined(CERNLIB_ZBUF))&&(defined(CERNLIB_PSCRIPT))
-#include "higz/hipost.inc"
-#include "higz/hilut.inc"
-#include "higz/hiatt.inc"
-#include "higz/hiwcps.inc"
-#endif
-#if defined(CERNLIB_MAIL)
- IF(MFLAG)THEN
- WRITE (CHMAIL,'(I3)') 559
- CALL IMWRIT(4)
- RETURN
- ENDIF
-#endif
-#if defined(CERNLIB_GKS)
- CALL IUWK(0,0)
-#endif
-#if !defined(CERNLIB_GKS)
- CALL IUWK(0,1)
-#endif
- CALL IGSA(0)
-#if (defined(CERNLIB_X11))&&(defined(CERNLIB_ZBUF))&&(defined(CERNLIB_PSCRIPT))
- IF (PFLAG.AND.IZBUF.NE.0) THEN
- CALL IGNG3D(W3X1,W3X2,W3Y1,W3Y2,W3Z1,W3Z2
- +, PHI,THETA,PSI
- +, V3X1,V3X2,V3Y1,V3Y2)
- IXPS1 = IXWCPS(V3X1)
- IXPS2 = IXWCPS(V3X2)
- IYPS1 = IYWCPS(V3Y1)
- IYPS2 = IYWCPS(V3Y2)
- CALL IPPSTR('@')
- CALL IHZPS(0,0,IXPS1,IYPS1,IXPS2,IYPS2,
- + INBCOL,REDLUT,GRNLUT,BLULUT)
- CALL IPPFST('gr')
- ENDIF
-#endif
- END
diff --git a/src/graflib/higz/ig/igtext.F b/src/graflib/higz/ig/igtext.F
deleted file mode 100644
index 3597582..0000000
--- a/src/graflib/higz/ig/igtext.F
+++ /dev/null
@@ -1,3746 +0,0 @@
-*
-* $Id: igtext.F,v 1.5 1998/09/25 09:24:06 mclareni Exp $
-*
-* $Log: igtext.F,v $
-* Revision 1.5 1998/09/25 09:24:06 mclareni
-* Modifications for the Mklinux port flagged by CERNLIB_PPC
-*
-* Revision 1.4 1998/01/30 15:22:19 couet
-* - APOLLO version removed
-*
-* Revision 1.3 1997/03/14 14:23:15 mclareni
-* WNT mods
-*
-* Revision 1.2.2.1 1997/01/21 11:25:32 mclareni
-* All mods for Winnt 96a on winnt branch
-*
-* Revision 1.2 1996/04/02 22:26:07 thakulin
-* Add F90 style hex initializers of arrays for EPC Fortran.
-*
-* Revision 1.1.1.1 1996/02/14 13:10:40 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.20/10 31/01/94 10.52.10 by O.Couet
-*-- Author :
- SUBROUTINE IGTEXT(X,Y,KTEXT,SSIZE,ANGLE,CHOPT)
-*.===========>
-*.
-*. Routine to draw software characters using
-*. the H E R S H E Y character table .
-*.
-*. N.M. WOLCOTT, J. HILSENRATH
-*. A contribution to computer typesetting techniques
-*. table of coordinates for HERSHEY'S repertory
-*. of occidental type fonts and graphics symbols
-*. national bureau of standards
-*. special publication No. 424
-*. U.S. Government printing office,
-*. Washington, January 1976.
-*.
-*. Each x or y subcoordinate of each character
-*. is packed in 6 bits (HERSHEY VALUE+32)
-*. The number of coordinates in a word is
-*. machine dependent
-*.
-*. The program contained in deck HERSHEY
-*. is used to generate the table of packed values
-*. for a given computer
-*. COMDECK HERO20 to be used for machines
-*. with words having 60 bits or more
-*. COMDECK HERO12 to be used for machines
-*. with words having 36 bits
-*. and octal representation
-*. COMDECK HERO10 to be used for machines
-*. with words having 32 bits
-*. and octal representation
-*. COMDECK HERZ8 to be used for machines
-*. with words having 30 bits or more
-*. and hexadecimal representation
-*.
-*. _Input parameters:
-*.
-*. REAL X,Y : Coordinates for beginning of text .
-*. CHARACTER KTEXT : Text .
-*. INTEGER SSIZE : Text size .
-*. REAL ANGLE : The rotation angle in degrees .
-*. CHARACTER CHOPT : Option .
-*.
-*. CHOPT='L'eft .
-*. CHOPT='R'ight .
-*. CHOPT='C'enter .
-*. CHOPT='S' return text length in ANGLE.
-*.
-*.
-*..==========> (R.Brun O.Couet)
-#include "higz/hiatt.inc"
-#include "higz/hiflag.inc"
-#if defined(CERNLIB_MAIL)
-#include "higz/himail.inc"
-#endif
- LOGICAL ZFSAV
- CHARACTER*(*) KTEXT,CHOPT
- DIMENSION ITEXT(255),IFORT(73),ISPEC(11)
- EQUIVALENCE(ITEXT(1),IFORT(1)),(ITEXT(74),ISPEC(1))
- DIMENSION XP(40),YP(40),XXP(40),YYP(40),LGREEK(26)
- DIMENSION IOPT(4)
- EQUIVALENCE (IOPT(1),IOPTL),(IOPT(2),IOPTC),(IOPT(3),IOPTR)
- EQUIVALENCE (IOPT(4),IOPTS)
- SAVE IFIRST,IPASS,IGO,IFORT,ISPEC
-#if defined(CERNLIB_CDC)
- DIMENSION IA(64)
- DIMENSION ISTART(210),IX( 425),IY( 425)
- DIMENSION IX11( 36),IY11( 36)
- EQUIVALENCE (IX11(1),IX( 1)),(IY11(1),IY( 1))
- DIMENSION IX12( 36),IY12( 36)
- EQUIVALENCE (IX12(1),IX( 37)),(IY12(1),IY( 37))
- DIMENSION IX13( 36),IY13( 36)
- EQUIVALENCE (IX13(1),IX( 73)),(IY13(1),IY( 73))
- DIMENSION IX14( 36),IY14( 36)
- EQUIVALENCE (IX14(1),IX(109)),(IY14(1),IY(109))
- DIMENSION IX15( 36),IY15( 36)
- EQUIVALENCE (IX15(1),IX(145)),(IY15(1),IY(145))
- DIMENSION IX16( 36),IY16( 36)
- EQUIVALENCE (IX16(1),IX(181)),(IY16(1),IY(181))
- DIMENSION IX17( 36),IY17( 36)
- EQUIVALENCE (IX17(1),IX(217)),(IY17(1),IY(217))
- DIMENSION IX18( 36),IY18( 36)
- EQUIVALENCE (IX18(1),IX(253)),(IY18(1),IY(253))
- DIMENSION IX19( 36),IY19( 36)
- EQUIVALENCE (IX19(1),IX(289)),(IY19(1),IY(289))
- DIMENSION IX20( 36),IY20( 36)
- EQUIVALENCE (IX20(1),IX(325)),(IY20(1),IY(325))
- DIMENSION IX21( 36),IY21( 36)
- EQUIVALENCE (IX21(1),IX(361)),(IY21(1),IY(361))
- DIMENSION IX22( 29),IY22( 29)
- EQUIVALENCE (IX22(1),IX(397)),(IY22(1),IY(397))
-#endif
-#if defined(CERNLIB_CVX)||defined(CERNLIB_CRAY)
- DIMENSION IA(256)
- DIMENSION ISTART(210),IX( 425),IY( 425)
- DIMENSION IX11( 54),IY11( 54)
- EQUIVALENCE (IX11(1),IX( 1)),(IY11(1),IY( 1))
- DIMENSION IX12( 54),IY12( 54)
- EQUIVALENCE (IX12(1),IX( 55)),(IY12(1),IY( 55))
- DIMENSION IX13( 54),IY13( 54)
- EQUIVALENCE (IX13(1),IX(109)),(IY13(1),IY(109))
- DIMENSION IX14( 54),IY14( 54)
- EQUIVALENCE (IX14(1),IX(163)),(IY14(1),IY(163))
- DIMENSION IX15( 54),IY15( 54)
- EQUIVALENCE (IX15(1),IX(217)),(IY15(1),IY(217))
- DIMENSION IX16( 54),IY16( 54)
- EQUIVALENCE (IX16(1),IX(271)),(IY16(1),IY(271))
- DIMENSION IX17( 54),IY17( 54)
- EQUIVALENCE (IX17(1),IX(325)),(IY17(1),IY(325))
- DIMENSION IX18( 47),IY18( 47)
- EQUIVALENCE (IX18(1),IX(379)),(IY18(1),IY(379))
-#endif
-#if defined(CERNLIB_NORD)||defined(CERNLIB_HPUX)
- DIMENSION IA(256)
- SAVE IA
-#endif
-#if defined(CERNLIB_UNIVAC)
- DIMENSION IA(64)
-#endif
-#if defined(CERNLIB_NORD)||defined(CERNLIB_UNIVAC)||defined(CERNLIB_HPUX)
- DIMENSION ISTART(210),IX( 751),IY( 751)
- DIMENSION IX11( 90),IY11( 90)
- EQUIVALENCE (IX11(1),IX( 1)),(IY11(1),IY( 1))
- DIMENSION IX12( 90),IY12( 90)
- EQUIVALENCE (IX12(1),IX( 91)),(IY12(1),IY( 91))
- DIMENSION IX13( 90),IY13( 90)
- EQUIVALENCE (IX13(1),IX(181)),(IY13(1),IY(181))
- DIMENSION IX14( 90),IY14( 90)
- EQUIVALENCE (IX14(1),IX(271)),(IY14(1),IY(271))
- DIMENSION IX15( 90),IY15( 90)
- EQUIVALENCE (IX15(1),IX(361)),(IY15(1),IY(361))
- DIMENSION IX16( 90),IY16( 90)
- EQUIVALENCE (IX16(1),IX(451)),(IY16(1),IY(451))
- DIMENSION IX17( 90),IY17( 90)
- EQUIVALENCE (IX17(1),IX(541)),(IY17(1),IY(541))
- DIMENSION IX18( 90),IY18( 90)
- EQUIVALENCE (IX18(1),IX(631)),(IY18(1),IY(631))
- DIMENSION IX19( 31),IY19( 31)
- EQUIVALENCE (IX19(1),IX(721)),(IY19(1),IY(721))
-#endif
-#if (!defined(CERNLIB_CDC))&&(!defined(CERNLIB_CVX))&&(!defined(CERNLIB_CRAY))&&(!defined(CERNLIB_NORD))&&(!defined(CERNLIB_UNIVAC))&&(!defined(CERNLIB_HPUX))
- DIMENSION IA(256)
- DIMENSION ISTART(210),IX( 751),IY( 751)
- DIMENSION IX11(108),IY11(108)
- EQUIVALENCE (IX11(1),IX( 1)),(IY11(1),IY( 1))
- DIMENSION IX12(108),IY12(108)
- EQUIVALENCE (IX12(1),IX(109)),(IY12(1),IY(109))
- DIMENSION IX13(108),IY13(108)
- EQUIVALENCE (IX13(1),IX(217)),(IY13(1),IY(217))
- DIMENSION IX14(108),IY14(108)
- EQUIVALENCE (IX14(1),IX(325)),(IY14(1),IY(325))
- DIMENSION IX15(108),IY15(108)
- EQUIVALENCE (IX15(1),IX(433)),(IY15(1),IY(433))
- DIMENSION IX16(108),IY16(108)
- EQUIVALENCE (IX16(1),IX(541)),(IY16(1),IY(541))
- DIMENSION IX17(103),IY17(103)
- EQUIVALENCE (IX17(1),IX(649)),(IY17(1),IY(649))
-#endif
-#if defined(CERNLIB_IPSC)||defined(CERNLIB_ALLIANT)||defined(CERNLIB_MACMPW)
- SAVE IA
- DATA (IX11(I),I=1,50)/
- +'1969C7D6'X,'217DC699'X,'269E79A4'X,'00FDF864'X,'2185E716'X,
- +'0000003F'X,'1C6DA696'X,'2696489E'X,'27663966'X,'0000003F'X,
- +'238266D6'X,'269E79A5'X,'1A6DE864'X,'00000FD9'X,'3FA198D6'X,
- +'0003F8E3'X,'1B69B956'X,'279A485E'X,'1E8649A7'X,'00FD969B'X,
- +'208A5996'X,'1B69A6DD'X,'2692181D'X,'219269E7'X,'3F69B760'X,
- +'19FDD9D6'X,'00000FE7'X,'1A69B796'X,'2692175B'X,'229669E7'X,
- +'1965A6DE'X,'258DF71A'X,'1E8A59A6'X,'0000003F'X,'208E5996'X,
- +'1965A71F'X,'2381F71A'X,'239669A5'X,'3F69B7A0'X,'20FD8817'X,
- +'3F95BFE8'X,'19FD9655'X,'279E6962'X,'19FE2966'X,'279E6962'X,
- +'3F662966'X,'23967A16'X,'1969B75F'X,'1F75B699'X,'3FA27963'X/
- DATA (IX11(I), I=51,108)/
- +'19FD9655'X,'279A58E0'X,'208E59A7'X,'00000FD9'X,'1AFDA696'X,
- +'3F89AFE7'X,'0003F9DA'X,'1AFDA696'X,'3F89AFE7'X,'23967A16'X,
- +'1969B75F'X,'1F75B699'X,'28A27963'X,'00FE88FF'X,'27FD9655'X,
- +'3F9D9FE7'X,'00FE081C'X,'228E4918'X,'1A6DC7A0'X,'00000FDA'X,
- +'27FD9655'X,'3F9DEFD9'X,'1AFDA696'X,'00000FE6'X,'18FD8614'X,
- +'3F828FE0'X,'0003FA28'X,'19FD9655'X,'3F9E7FE7'X,'1969C795'X,
- +'1C699618'X,'279A489E'X,'249A7A28'X,'0003F7A2'X,'19FD9655'X,
- +'279E6962'X,'3F662966'X,'1969C795'X,'1C699618'X,'279A489E'X,
- +'249A7A28'X,'2787F7A2'X,'0000003F'X,'19FD9655'X,'279E6962'X,
- +'3F662966'X,'0003F9E0'X,'1E8A59D6'X,'1B69965B'X,'279A58DD'X,
- +'1B7A2967'X,'00000FD9'X,'19FE0818'X,'00000FE7'X,'1C699655'X,
- +'279A485F'X,'00000FE7'X,'28FE0617'X/
- DATA (IX12(I),I=1,50)/
- +'00000FE0'X,'20FDB594'X,'3F960FDB'X,'0003F96A'X,'27FE7656'X,
- +'00000FD9'X,'3F820617'X,'0003F828'X,'19FD99D6'X,'3F9D9FE7'X,
- +'20FD8817'X,'3F95BFE8'X,'19FD9655'X,'279E6962'X,'19FE2966'X,
- +'279E6962'X,'3F662966'X,'1AFDA696'X,'00000FE6'X,'20FD8817'X,
- +'3FA18FE8'X,'1AFDA696'X,'3F89AFE7'X,'0003F9DA'X,'19FD99D6'X,
- +'3F9D9FE7'X,'27FD9655'X,'3F9D9FE7'X,'1969C795'X,'1C699618'X,
- +'279A489E'X,'249A7A28'X,'2377F7A2'X,'0000003F'X,'00FE081C'X,
- +'27FD9655'X,'3F9DEFD9'X,'20FD8817'X,'00000FE8'X,'18FD8614'X,
- +'3F828FE0'X,'0003FA28'X,'19FD9655'X,'3F9E7FE7'X,'1DFE7657'X,
- +'3F9D9FE3'X,'1969C795'X,'1C699618'X,'279A489E'X,'249A7A28'X/
- DATA (IX12(I), I=51,108)/
- +'0003F7A2'X,'27FD9655'X,'3F9D9FE7'X,'19FD9655'X,'279E6962'X,
- +'3F662966'X,'3F660657'X,'2767F9D9'X,'0000003F'X,'19FE0818'X,
- +'00000FE7'X,'1B699657'X,'2081F79D'X,'259A79FF'X,'3F8218A3'X,
- +'1EFE0816'X,'1A65969B'X,'2696279B'X,'229669E7'X,'00000FDE'X,
- +'19FE7656'X,'00000FE7'X,'17FE0815'X,'1C6DA658'X,'2696485F'X,
- +'00FE9A27'X,'1969D656'X,'217DC699'X,'269E79A4'X,'0003F9E3'X,
- +'18FE0814'X,'3FA18FE8'X,'00FE081C'X,'1A69E79A'X,'268A279E'X,
- +'3F7A28A6'X,'22FDE796'X,'26966FE2'X,'1E8A59E7'X,'1B69965B'X,
- +'3F9E58DD'X,'258DD6D9'X,'229679E6'X,'1A6596DE'X,'0003F69B'X,
- +'20FE081B'X,'3F82181F'X,'27FDA856'X,'3FA1AFE0'X,'0003F9D9'X,
- +'3F628614'X,'1C6DA697'X,'2696489E'X,'20824966'X,'2181F83F'X,
- +'00000FE0'X,'2AA68A54'X,'23967A6A'X/
- DATA (IX13(I),I=1,50)/
- +'1D7A0862'X,'228E4FDC'X,'1B75E7E0'X,'175965D9'X,'0003F5D8'X,
- +'2181F81B'X,'207E0FE0'X,'0003F821'X,'2181F81B'X,'1F821FE0'X,
- +'1F821860'X,'0000003F'X,'3FA18A14'X,'1EFDD759'X,'3F91DFDE'X,
- +'0003F91D'X,'23FE2899'X,'3F8DCFE3'X,'0003F8DC'X,'3F6E56D8'X,
- +'256FF95B'X,'0000003F'X,'1E7E0899'X,'218607DE'X,'1F7E0FDF'X,
- +'218A2860'X,'218A285D'X,'3F81F7E0'X,'1F82185F'X,'2281F79E'X,
- +'0000003F'X,'22860799'X,'1F7E0862'X,'21860FE1'X,'1F79E7E0'X,
- +'1F79E7E3'X,'3F821860'X,'2181F7E1'X,'1E8218A2'X,'0000003F'X,
- +'3F81748F'X,'20C3F816'X,'0000003F'X,'1865C814'X,'1F75B658'X,
- +'27920FE0'X,'23967A28'X,'1F83F821'X,'22860FDE'X,'00FE27BF'X/
- DATA (IX13(I), I=51,108)/
- +'1C79F814'X,'1961865B'X,'20FE071A'X,'279648A1'X,'249A7A28'X,
- +'00000FE0'X,'1769E814'X,'299A283F'X,'2079A5FF'X,'208A6A7F'X,
- +'0000003F'X,'26922814'X,'26A29A68'X,'2387F864'X,'1F863924'X,
- +'1F75C71D'X,'1869C7FF'X,'1C6985D7'X,'1F83F81E'X,'22860FDE'X,
- +'00FE27BF'X,'28A6AA93'X,'208A49A7'X,'165D869E'X,'207D85D6'X,
- +'1C7A0861'X,'2379C6DB'X,'2AAA99E5'X,'0000003F'X,'27FE7655'X,
- +'00000FD9'X,'1DFDA998'X,'1A6DD79E'X,'2485D6DA'X,'228A3FE6'X,
- +'259A6963'X,'00000FE3'X,'258E2815'X,'2BAEAA67'X,'23967A6A'X,
- +'196DD7A2'X,'16555597'X,'1E75B657'X,'00000FE0'X,'1C71D7DC'X,
- +'248E17DD'X,'3F7E18E4'X,'1E7BF75D'X,'20FDF7FF'X,'3F861FE0'X,
- +'238FF8A2'X,'0000003F'X,'2491C71C'X,'3F75DFDC'X,'1F7FF79E'X,
- +'21FE083F'X,'3F8A2FE1'X,'0003F8E3'X/
- DATA (IX14(I),I=1,50)/
- +'2095B81B'X,'20FDD83F'X,'3F7E0FE3'X,'0003F860'X,'206E581B'X,
- +'20FE383F'X,'3F860FDD'X,'0003F7E0'X,'1A99C81A'X,'2083F824'X,
- +'20FDA83F'X,'3F920FDC'X,'0003F9A0'X,'3F9A9993'X,'17FE3A23'X,
- +'00000FE8'X,'3F8A0798'X,'20FE581B'X,'00000FE0'X,'3F697693'X,
- +'18FDD61D'X,'00000FE9'X,'3F8A0798'X,'20FE581B'X,'00000FE0'X,
- +'2181F81B'X,'00FDF821'X,'2181F81B'X,'00000FE0'X,'207E085B'X,
- +'3F7E0861'X,'00FD7A55'X,'1E822919'X,'2281E75D'X,'00000FE4'X,
- +'2281E719'X,'1E8228E3'X,'00000FDC'X,'00FE95D3'X,'17FE0813'X,
- +'00000FE9'X,'17FE95D3'X,'00000FE9'X,'1BFE0818'X,'3F6E5FE5'X,
- +'1D75E81B'X,'238E281E'X,'0003F822'X,'3F82079B'X,'2385F75B'X/
- DATA (IX14(I), I=51,108)/
- +'3F8DD8A3'X,'2385F75B'X,'2183F863'X,'1D7E18E3'X,'0000003F'X,
- +'21FE185B'X,'0003F91C'X,'207DD79B'X,'1F8228E2'X,'3F89EFDD'X,
- +'1D7A089B'X,'238A079D'X,'3F75E822'X,'1DFDF8DB'X,'00000FE3'X,
- +'1F75D7DB'X,'1F8638E1'X,'1F75D7FF'X,'3F8638E1'X,'1E8228DB'X,
- +'238A079D'X,'3F7A08A3'X,'26FE6997'X,'1B75F8A4'X,'1F75B69A'X,
- +'00FE6922'X,'1AFDA696'X,'258E179C'X,'218E59A6'X,'00FDA71E'X,
- +'1F8A4997'X,'1B69A6DD'X,'269227DD'X,'0000003F'X,'26FE6997'X,
- +'1B75F8A4'X,'1F75B69A'X,'00FE6922'X,'259A6697'X,'1B75F8A4'X,
- +'1F75B69A'X,'00FE6922'X,'2086395B'X,'3F91DFE0'X,'24966997'X,
- +'26FDD7E2'X,'1B75F8A4'X,'1F75B69A'X,'00FE6922'X,'1BFDB6D7'X,
- +'2696381E'X,'00000FE6'X,'208607DC'X,'3F820FDF'X,'218A181B'X,
- +'20861FE0'X,'0003F71E'X,'25FDB6D7'X/
- DATA (IX15(I),I=1,50)/
- +'3F99FFDB'X,'00FE081C'X,'15FD5551'X,'207DD698'X,'258E0FE0'X,
- +'3FAEBAA8'X,'1BFDB6D7'X,'2696381E'X,'00000FE6'X,'1A6DD7D7'X,
- +'227DD6DA'X,'269E79A4'X,'00FDF8A4'X,'1AFDA696'X,'258E179C'X,
- +'218E59A6'X,'00FDA71E'X,'26FE6997'X,'1B75F8A4'X,'1F75B69A'X,
- +'00FE6922'X,'1DFDD759'X,'3F96281E'X,'1F8A5998'X,'2379C6DC'X,
- +'229669A5'X,'00FDB71F'X,'2386081B'X,'3F91DFE5'X,'1E71B6D7'X,
- +'26FE68E1'X,'00000FE6'X,'26FE0698'X,'00000FE0'X,'20FDC615'X,
- +'3F920FDC'X,'0003F928'X,'26FE66D8'X,'00000FDB'X,'26FE0698'X,
- +'1969C7A0'X,'0000003F'X,'1BFDB998'X,'3F99BFE6'X,'1A6DD7D6'X,
- +'1E71A659'X,'289E58E0'X,'238A17FF'X,'3FA279A5'X,'1D7E18D7'X/
- DATA (IX15(I), I=51,108)/
- +'3F65A6DC'X,'269E7963'X,'20FE08E5'X,'24965922'X,'1C75F863'X,
- +'00000FDB'X,'1D71A617'X,'2086181F'X,'209A7A3F'X,'0003F75E'X,
- +'1B75F897'X,'1E71B69A'X,'259648A0'X,'1F7E08A4'X,'3F9A48A0'X,
- +'1F8A4958'X,'3F85E75D'X,'1C6DB761'X,'3F96385E'X,'1F7E0898'X,
- +'26FE68E0'X,'1B6DC7E2'X,'228A179C'X,'00FDE7E1'X,'1C6985D6'X,
- +'3F69C75D'X,'248A079C'X,'3F8A59A6'X,'1B657595'X,'1C6DB71C'X,
- +'248E17DD'X,'239669A5'X,'23860821'X,'0003FA25'X,'1D75E81A'X,
- +'3F8E281E'X,'27FD9757'X,'1D7E3966'X,'1F79CFDC'X,'3F9238A1'X,
- +'1E75B658'X,'3F6A0FE6'X,'1CFD7756'X,'217DD6DB'X,'259FF963'X,
- +'299E5924'X,'00000FEA'X,'1B71D697'X,'259A7FDA'X,'3F69D823'X,
- +'1F7E0898'X,'23FE68E0'X,'1F75D7A0'X,'1E8BF922'X,'2175B6DC'X,
- +'3F7A08A2'X,'1B71E818'X,'217DD71B'X/
- DATA (IX16(I),I=1,50)/
- +'259A6963'X,'00FE08A4'X,'23FDA795'X,'17FE6964'X,'00FE9719'X,
- +'1D71B6D7'X,'2696385F'X,'208A4966'X,'3F5DB71E'X,'1B75FA57'X,
- +'1E71B69A'X,'259648A0'X,'00FE18E4'X,'18FDE856'X,'00FE875A'X,
- +'1C6985D6'X,'1D6DB75D'X,'279A489F'X,'00000FE7'X,'1865B755'X,
- +'1F71A658'X,'28A27962'X,'1E822926'X,'00000FDB'X,'2375B657'X,
- +'27A3F9E5'X,'3F6196E5'X,'15FDC914'X,'1B6DA616'X,'1F75B69A'X,
- +'29A26922'X,'0000003F'X,'1761A714'X,'1D6D9617'X,'207E0FDF'X,
- +'289E58E1'X,'00FE69E8'X,'1BFE0818'X,'3F95BFE5'X,'00FE081E'X,
- +'209D9819'X,'2066783F'X,'0000003F'X,'22FDF7D9'X,'24925FE2'X,
- +'1C7A3965'X,'3F96475C'X,'2596475C'X,'1C75F8A4'X,'3F71D75C'X/
- DATA (IX16(I), I=51,108)/
- +'21FE081E'X,'21820FE1'X,'0003F821'X,'23FDE81B'X,'3F91DFE1'X,
- +'0003F91D'X,'3F6E56D8'X,'2386079C'X,'21860823'X,'21820FE3'X,
- +'0003F821'X,'279E6997'X,'20862926'X,'23FDD79F'X,'1E7E0862'X,
- +'1A65969C'X,'00000FDA'X,'2186081E'X,'21820FE0'X,'0003F821'X,
- +'2186081E'X,'20821FE0'X,'00FE0861'X,'3F95B958'X,'1FFDE79B'X,
- +'3F8DEFDF'X,'0003F8DE'X,'22FE185B'X,'3F89DFE2'X,'0003F89D'X,
- +'3F95B958'X,'256FF95B'X,'0000003F'X,'1E79F85A'X,'1E7FF860'X,
- +'1EFE087F'X,'1E82185F'X,'1E7E1860'X,'1EFE183F'X,'1E821FDF'X,
- +'00FE17DE'X,'228A17DB'X,'2287F7E0'X,'22FE07FF'X,'2281F7E1'X,
- +'2285F7E0'X,'22FDF83F'X,'2281FFE1'X,'00FDF862'X,'3F81A5D5'X,
- +'20A7F819'X,'0000003F'X,'217DE795'X,'1657F8A2'X,'1B69A658'X,
- +'269A58DD'X,'3FAEAA27'X,'1E7FFAD5'X/
- DATA (IX17(I),I=1,50)/
- +'3F86285F'X,'20FE0818'X,'3F860FDF'X,'1F83F85F'X,'1C7FF71E'X,
- +'248A183F'X,'20FE487F'X,'1EFD869C'X,'2483F61A'X,'268BFA26'X,
- +'1D7A0FE8'X,'1D7A0FDD'X,'238E283F'X,'3F8E283F'X,'20FE0818'X,
- +'3F820FE0'X,'2183F7E0'X,'20FE17FF'X,'2183F79F'X,'2281EFE2'X,
- +'1B71E83F'X,'2592283F'X,'2281E73F'X,'1C7A0FE4'X,'3F69965A'X,
- +'279A48A0'X,'1E73F9A7'X,'20FE48A0'X,'1969B75E'X,'20FDA618'X,
- +'279A58E2'X,'1BFE6A28'X,'3F96381D'X,'20FDF818'X,'3F85FFE1'X,
- +'28A268E0'X,'27A27967'X,'218E48E5'X,'1B75C75F'X,'196D9619'X,
- +'2075A618'X,'0000003F'X,'218A391A'X,'1D71C760'X,'1E821860'X,
- +'2385F75D'X,'00000FE4'X,'23FE375B'X,'00000FDD'X,'29AABAD7'X/
- DATA (IX17(I), I=51,103)/
- +'1A761926'X,'1A6175D8'X,'299A485D'X,'00FEBAEA'X,'24967A16'X,
- +'1C79F862'X,'1961865B'X,'217DE71B'X,'289E5922'X,'00000FE8'X,
- +'1969C7D9'X,'217DC699'X,'269E79A4'X,'00FDF864'X,'2699A69A'X,
- +'00000FDA'X,'209D9819'X,'0000003F'X,'2681A81A'X,'00000FE0'X,
- +'1D61E818'X,'288E581B'X,'0003F822'X,'239A3897'X,'23963FE2'X,
- +'00FE56BF'X,'1DFE081B'X,'3F8E281E'X,'00FE281E'X,'1D69D797'X,
- +'1D6DDFDE'X,'00FE66FF'X,'1DFE081B'X,'3F8E281E'X,'00FE281E'X,
- +'2182085E'X,'0003F821'X,'2186081E'X,'00000FE0'X,'2182085E'X,
- +'0003F821'X,'00FDC91B'X,'1F7E089D'X,'0003F8A0'X,'2186079C'X,
- +'0003F7A0'X,'00FE471A'X,'1CFE081A'X,'00000FE4'X,'1CFE471A'X,
- +'00000FE4'X,'1DFE081B'X,'3F763FE3'X/
- DATA (IY11(I),I=1,50)/
- +'1D61552A'X,'29A68960'X,'18760968'X,'00FD4515'X,'2951762A'X,
- +'0000003F'X,'1559866A'X,'18595514'X,'29A5F71A'X,'0000003F'X,
- +'1C71452A'X,'268E179D'X,'27A29A68'X,'00000FE5'X,'208A252A'X,
- +'0003FA54'X,'1C75452A'X,'2179C6DB'X,'29A689A3'X,'00FE59E8'X,
- +'145155EA'X,'2689D615'X,'26A29A68'X,'1C75F8A3'X,'3F89F75C'X,
- +'1482952A'X,'00000FD4'X,'195D552A'X,'2079D71B'X,'29A27962'X,
- +'22967A29'X,'1B71D7A0'X,'145155D9'X,'0000003F'X,'2181E6EA'X,
- +'1A6DE821'X,'15514557'X,'289606D7'X,'3F9A8A69'X,'14829529'X,
- +'3F8A2829'X,'1482952A'X,'1A616554'X,'1E81E75C'X,'258A07DE'X,
- +'3FA69A27'X,'1455766B'X,'1C657554'X,'29A26921'X,'3F926A29'X/
- DATA (IY11(I), I=51,108)/
- +'1482952A'X,'1C657554'X,'29A26921'X,'00000FE9'X,'14829529'X,
- +'2079E814'X,'0003FA69'X,'14829528'X,'3F79E814'X,'1455766B'X,
- +'1C657554'X,'29A26921'X,'21926A29'X,'00FE1860'X,'1482952B'X,
- +'3F79E829'X,'00FE9524'X,'289E4528'X,'249E8A69'X,'00000FE2'X,
- +'1482952A'X,'3FA5D822'X,'29829527'X,'00000FE9'X,'1482952C'X,
- +'20A54829'X,'0003FA54'X,'1482952B'X,'3FA54829'X,'195D552B'X,
- +'289A485C'X,'249A8A69'X,'155D9721'X,'0003F514'X,'1482952A'X,
- +'1B616554'X,'3F7DF79D'X,'195D552B'X,'289A485C'X,'249A8A69'X,
- +'155D9721'X,'2B960514'X,'0000003F'X,'1482952A'X,'1A616554'X,
- +'2079E75C'X,'0003FA5E'X,'145155EA'X,'1C6D95D5'X,'238607DD'X,
- +'28A69A26'X,'00000FE6'X,'14829528'X,'00000FD4'X,'289A352B'X,
- +'239A8A69'X,'00000FD4'X,'14829529'X/
- DATA (IY12(I),I=1,50)/
- +'00000FE9'X,'1482952C'X,'20A54829'X,'0003FA54'X,'1482952A'X,
- +'00000FE9'X,'20A5E529'X,'0003F794'X,'1482952A'X,'3FA69814'X,
- +'14829529'X,'3F8A2829'X,'1482952A'X,'1A616554'X,'1E81E75C'X,
- +'258A07DE'X,'3FA69A27'X,'14829527'X,'00000FD4'X,'14829529'X,
- +'3FA69829'X,'14829529'X,'2079E814'X,'0003FA69'X,'1482952A'X,
- +'3FA69814'X,'1482952B'X,'3F79E829'X,'195D552B'X,'289A485C'X,
- +'249A8A69'X,'155D9721'X,'1E7A0514'X,'0000003F'X,'00FE9524'X,
- +'1482952A'X,'3FA5D822'X,'14829529'X,'00000FE9'X,'1482952C'X,
- +'20A54829'X,'0003FA54'X,'1482952B'X,'3FA54829'X,'1E814529'X,
- +'3FA6981E'X,'195D552B'X,'289A485C'X,'249A8A69'X,'155D9721'X/
- DATA (IY12(I), I=51,108)/
- +'0003F514'X,'1482952B'X,'3F514829'X,'1482952A'X,'1B616554'X,
- +'3F7DF79D'X,'20A5E529'X,'29A60514'X,'0000003F'X,'14829528'X,
- +'00000FD4'X,'14557669'X,'296D7554'X,'14557660'X,'3F6D7554'X,
- +'1982952A'X,'2281D6DA'X,'228E4923'X,'1969B760'X,'00000FD9'X,
- +'2982952A'X,'00000FD4'X,'1A82952B'X,'2285F6DA'X,'1F8628E3'X,
- +'00FDA69B'X,'1E8A9A6A'X,'145155DA'X,'2279A5D5'X,'0003FA69'X,
- +'2082962C'X,'3FA69820'X,'00FF0424'X,'2279E6A6'X,'228A69A2'X,
- +'3F69A79E'X,'1082D42A'X,'1961782D'X,'145155D8'X,'1C6D95D5'X,
- +'208A07DD'X,'1F79C6D9'X,'29A268A0'X,'24966A29'X,'0003F9A5'X,
- +'27822525'X,'3F9E8A68'X,'1083042B'X,'2075D830'X,'0003F8E3'X,
- +'3FA605EC'X,'15598669'X,'18595514'X,'227DD71A'X,'28A689E0'X,
- +'00000FE7'X,'124D246C'X,'13450411'X/
- DATA (IY13(I),I=1,50)/
- +'2CA1C615'X,'1851282E'X,'2FB6BA24'X,'2DBAFC30'X,'0003FBEE'X,
- +'1C75C6E5'X,'29A2781B'X,'0003F9E8'X,'1C75C6E5'X,'28A6881B'X,
- +'2DB2AA27'X,'0000003F'X,'3FA605EC'X,'10830427'X,'20410830'X,
- +'0003FC30'X,'10830427'X,'20410830'X,'0003FC30'X,'2085D668'X,
- +'269A08A2'X,'0000003F'X,'14491427'X,'1D6D9616'X,'154D181F'X,
- +'1E71A617'X,'289A48A0'X,'20BEDAE9'X,'289E58E1'X,'30BEEB2A'X,
- +'0000003F'X,'14491427'X,'1D6D9616'X,'154D181F'X,'1E71A617'X,
- +'289A48A0'X,'20BEDAE9'X,'289E58E1'X,'30BEEB2A'X,'0000003F'X,
- +'209DB6F0'X,'29220A5C'X,'0000003F'X,'2179A5AC'X,'259A6963'X,
- +'1E696823'X,'269A58E1'X,'278E08E5'X,'2A9E382A'X,'00FEAAA0'X/
- DATA (IY13(I), I=51,108)/
- +'165D972C'X,'207595D6'X,'1C82A962'X,'175965D9'X,'258A0759'X,
- +'00000FEA'X,'2075856C'X,'20758560'X,'2BA23820'X,'2BA23820'X,
- +'0000003F'X,'269A58AC'X,'1E7E18E5'X,'1D7E07DE'X,'1659765B'X,
- +'1F75B657'X,'1F79E7E0'X,'269A58E1'X,'278A08A5'X,'2A9E282A'X,
- +'00FEAAA0'X,'1B6DC76D'X,'289A379C'X,'259E8A69'X,'1B720863'X,
- +'155155D9'X,'267DC657'X,'27A29A68'X,'0000003F'X,'1982766B'X,
- +'00000FE7'X,'19826668'X,'1C75D71A'X,'1A69965A'X,'258E2819'X,
- +'228E59A6'X,'00000FE2'X,'2592382B'X,'1F863925'X,'1C6DB71D'X,
- +'259648DD'X,'1D7E18E4'X,'1D71B6DC'X,'00000FE0'X,'217DD724'X,
- +'218E4923'X,'2071C75F'X,'227A085F'X,'1D823760'X,'208DD823'X,
- +'217E089E'X,'0000003F'X,'1C924724'X,'208DD81C'X,'237608DD'X,
- +'1D823760'X,'208DD823'X,'0003F8DD'X/
- DATA (IY14(I),I=1,50)/
- +'1A8E36A5'X,'1D822760'X,'208A0822'X,'0003F8A0'X,'2675D9A5'X,
- +'2381E8E0'X,'207A081E'X,'0003F7A0'X,'1E7A56A6'X,'1A8206A5'X,
- +'2081E820'X,'20960825'X,'0003F7A0'X,'208A07AD'X,'2082581B'X,
- +'00000FE0'X,'206976A8'X,'1881D61D'X,'00000FE9'X,'208A07AD'X,
- +'2082581B'X,'00000FE0'X,'209A99A8'X,'17823A23'X,'00000FE8'X,
- +'155155A5'X,'00FDA657'X,'28A689E5'X,'00000FE7'X,'27A29A25'X,
- +'3FB6CAA8'X,'00FF042B'X,'19552427'X,'2EAE789E'X,'00000FF0'X,
- +'19552427'X,'2EAE789E'X,'00000FF0'X,'00FE082D'X,'208295ED'X,
- +'00000FE0'X,'2381D76D'X,'00000FE3'X,'1D8266A8'X,'3F8DD823'X,
- +'2179C6E5'X,'1E863923'X,'0003F6DC'X,'3F91B765'X,'1C6DB725'X/
- DATA (IY14(I), I=51,108)/
- +'3F92481E'X,'1C6DB725'X,'1F7E07DE'X,'239248E0'X,'0000003F'X,
- +'1B8246E5'X,'0003F861'X,'1E79F6E5'X,'2492385F'X,'3F6DB823'X,
- +'1E71B6E5'X,'218E48E1'X,'3F85F79F'X,'1B8246E5'X,'00000FDB'X,
- +'1F79C6E5'X,'1B6DC79F'X,'248E07E0'X,'3F7E08E4'X,'208607A5'X,
- +'1E71B71E'X,'3F9248E1'X,'1E8296EA'X,'1E71B6DC'X,'29A268E1'X,
- +'00FE6A29'X,'1E829529'X,'1E71B6DC'X,'29A268E1'X,'00FE6A29'X,
- +'1B6DC7A9'X,'268E179C'X,'26A29A68'X,'0000003F'X,'1E82952A'X,
- +'1E71B6DC'X,'29A268E1'X,'00FE6A29'X,'1D7E1869'X,'1E71B6DC'X,
- +'29A268E1'X,'00FE6A29'X,'18554527'X,'3F6DB829'X,'2FBAB6EA'X,
- +'1E82FC30'X,'1E71B6DC'X,'29A268E1'X,'00FE6A29'X,'1F82952A'X,
- +'1F71B6DC'X,'00000FE9'X,'13515524'X,'3FA5B814'X,'13515525'X,
- +'2FB1B814'X,'0003FC30'X,'1B829528'X/
- DATA (IY15(I),I=1,50)/
- +'3FA61825'X,'00FE9524'X,'1F8296EF'X,'1F71B6DC'X,'1B71F829'X,
- +'3FA5F71B'X,'1F8296EA'X,'1F71B6DC'X,'00000FE9'X,'2179C6EA'X,
- +'29A689A3'X,'1E8639A8'X,'00FDB6DC'X,'1E8306E9'X,'1E71B6DC'X,
- +'29A268E1'X,'00FE6A29'X,'1E8306EA'X,'1E71B6DC'X,'29A268E1'X,
- +'00FE6A29'X,'218296E6'X,'3F6DB71E'X,'1B6DC7A9'X,'2286079C'X,
- +'29A26963'X,'00FE6A29'X,'29A25527'X,'3F6DB829'X,'29A256EA'X,
- +'1B825A29'X,'00000FE9'X,'1B8296E8'X,'00000FE9'X,'1B8296EB'X,
- +'20A5B829'X,'0003FA5B'X,'1B8296E9'X,'00000FE9'X,'1B8296E8'X,
- +'30C2FB69'X,'0000003F'X,'1B8296E9'X,'3FA6981B'X,'2079C6EB'X,
- +'29A689A3'X,'1B7A2968'X,'1E71B6E0'X,'3FA69A26'X,'1B5D552A'X/
- DATA (IY15(I), I=51,108)/
- +'20C2889E'X,'1B656514'X,'1D81D75C'X,'2796281E'X,'27A29A68'X,
- +'00000FE4'X,'1B6DC7AA'X,'2992075C'X,'2981E6E0'X,'0003FC2D'X,
- +'1E71B6E9'X,'29A27921'X,'208E6A29'X,'155D96DD'X,'3F5D5514'X,
- +'1B6DC768'X,'2086079C'X,'289A48A1'X,'3F9A8A69'X,'17595527'X,
- +'19819658'X,'258E075B'X,'2FB6BA67'X,'00FEEC30'X,'1B6DD7EA'X,
- +'20A6279C'X,'1B6DC7A2'X,'3FC2581D'X,'1B6DD7EA'X,'289A379C'X,
- +'23968A69'X,'145586E0'X,'1E6D8594'X,'0003F8A0'X,'289A26E5'X,
- +'3F967A69'X,'1C8296E9'X,'2181C6DB'X,'238A1821'X,'3FA29A68'X,
- +'16554528'X,'3FA5B829'X,'1F8306EB'X,'28A699E4'X,'226E08A6'X,
- +'27A69A26'X,'00000FE5'X,'2685B6E9'X,'2079B829'X,'3FA689A3'X,
- +'17595528'X,'19819658'X,'217DD6DA'X,'238A08A2'X,'2CAA89A4'X,
- +'3FC30BED'X,'2179C6E9'X,'29A689E4'X/
- DATA (IY16(I),I=1,50)/
- +'1D8239A8'X,'00FDB6DC'X,'1B8296EB'X,'1E8299A1'X,'00FDB6DC'X,
- +'289E4869'X,'239A8A69'X,'1B6DC760'X,'3FC2179C'X,'1E71B6EB'X,
- +'29A27921'X,'208E6A29'X,'00FDB71D'X,'1E8296EA'X,'00FDB6DC'X,
- +'1B6DD7EA'X,'299E479C'X,'1E8A6A29'X,'00000FDB'X,'227DD72B'X,
- +'29A689E5'X,'1D8239A8'X,'2685D6DB'X,'00000FF0'X,'2E75B6E9'X,
- +'1D6E0C30'X,'3FC2EAE0'X,'1F83052B'X,'1E71B6DD'X,'29A689A3'X,
- +'1B7A39A8'X,'0000003F'X,'227DC6EB'X,'28A69A25'X,'28961825'X,
- +'22968A69'X,'00FDB71F'X,'208266E8'X,'3F9A6820'X,'00FE56A2'X,
- +'18924627'X,'2871CA20'X,'0000003F'X,'1682A5A8'X,'1B69A82A'X,
- +'1A65969B'X,'208A179C'X,'248A075C'X,'249669A5'X,'3F9248E3'X/
- DATA (IY16(I), I=51,108)/
- +'1B8206E3'X,'24923820'X,'0003F8E3'X,'1A8256A6'X,'2079E825'X,
- +'0003F861'X,'3F9A06A8'X,'1C6DB725'X,'1F8207DE'X,'2492381E'X,
- +'0003F8E3'X,'176185E9'X,'1D698596'X,'178299E3'X,'289A3759'X,
- +'28A29AAA'X,'00000FE9'X,'1E7DF7A3'X,'2492381E'X,'0003F8E3'X,
- +'1E7DF7A3'X,'2392481E'X,'00FE7963'X,'3F9A06A8'X,'1682A5A5'X,
- +'2059682A'X,'0003FAAA'X,'1682A5A5'X,'2059682A'X,'0003FAAA'X,
- +'2085D668'X,'269A08A2'X,'0000003F'X,'1A6175A5'X,'1A5E079C'X,
- +'1881F720'X,'207DE71A'X,'289A48A1'X,'26824860'X,'26922829'X,
- +'00FEAA68'X,'1A6175A6'X,'1A5E079C'X,'1881F720'X,'207DE71A'X,
- +'289A48A1'X,'26824860'X,'26922829'X,'00FEAA68'X,'2095D769'X,
- +'2652099D'X,'0000003F'X,'145155EB'X,'26A205D5'X,'1865E8A4'X,
- +'1E6585D7'X,'20A26922'X,'29A20A28'X/
- DATA (IY17(I),I=1,50)/
- +'3FA29AAA'X,'218216E8'X,'20AA182A'X,'186E0AAA'X,'15620556'X,
- +'155986E0'X,'1B815620'X,'1A81B659'X,'196E06DA'X,'1A6A06D9'X,
- +'1D71B81B'X,'2075B820'X,'2075C6E0'X,'3F81D6E0'X,'1C8195E8'X,
- +'208E181E'X,'2A9E0AA7'X,'1582AAA0'X,'17560617'X,'185D8818'X,
- +'1C75C660'X,'1C75C660'X,'1D71D760'X,'2285E81D'X,'208A1822'X,
- +'208A285E'X,'228A08A1'X,'238228A1'X,'27A289E6'X,'238289E5'X,
- +'27A289E6'X,'288289E5'X,'3FA289E8'X,'2782A9E8'X,'20AAA82A'X,
- +'239A8A27'X,'1B7608A2'X,'155986DA'X,'1A6D8595'X,'228A075B'X,
- +'27A289A3'X,'0000003F'X,'23860826'X,'20863924'X,'1B6DC79F'X,
- +'248E179C'X,'00000FE4'X,'1D823765'X,'00000FE3'X,'218E6A2B'X/
- DATA (IY17(I), I=51,103)/
- +'1D71C75E'X,'238A17DE'X,'1F8A3924'X,'00FD869D'X,'238E282A'X,
- +'1C75E862'X,'2281F75C'X,'1E8628E3'X,'1F75C71D'X,'00000FE0'X,
- +'1F71A667'X,'279E6921'X,'1C7E1926'X,'00FD965A'X,'1A9A66A6'X,
- +'00000FDA'X,'18924627'X,'0000003F'X,'20AA05A6'X,'00000FD6'X,
- +'2175D5E8'X,'1D8678E7'X,'0003F5DD'X,'2281E769'X,'2281E823'X,
- +'00FE0820'X,'1E8266E5'X,'2079D69D'X,'00FDD6DD'X,'2281E769'X,
- +'2281E823'X,'00FE0820'X,'228256A5'X,'208A39A3'X,'00FE3963'X,
- +'1B6DC723'X,'0003F7DD'X,'239248E3'X,'00000FE3'X,'238E4923'X,
- +'0003F9E5'X,'00FE56A5'X,'2179C6A4'X,'0003F963'X,'2179C6A3'X,
- +'0003F963'X,'00FE0826'X,'20824726'X,'00000FE0'X,'2281E7A6'X,
- +'00000FE2'X,'1E823765'X,'3F89E822'X/
- DATA ISTART/
- + 1, 5, 7, 11, 15, 17, 21, 26, 28, 35, 40, 42, 47, 51, 55,
- + 58, 60, 65, 67, 68, 71, 73, 75, 78, 80, 85, 88, 94, 98,103,
- +105,108,110,113,115,117,119,121,126,128,130,133,135,137,143,
- +144,146,148,151,153,155,160,162,165,168,170,174,179,181,185,
- +189,191,192,195,204,206,209,210,215,222,225,229,230,233,236,
- +239,248,257,260,267,273,278,288,296,298,304,311,319,325,329,
- +333,338,341,344,347,350,352,354,356,357,360,363,364,366,368,
- +370,373,374,376,380,382,385,388,390,394,397,401,405,409,413,
- +417,419,424,427,429,432,434,435,439,442,446,450,454,456,460,
- +462,465,467,470,472,475,477,482,489,493,498,502,507,511,517,
- +519,523,525,530,533,539,543,546,550,554,556,560,565,568,573,
- +578,580,581,584,591,594,597,598,602,608,611,614,615,618,621,
- +624,632,640,643,650,663,682,691,696,698,703,709,713,715,717,
- +719,722,725,728,731,734,736,738,740,741,743,745,746,748,750/
-*
- DATA NBIT,NBITCH,NBITMX/32,8,30/
-#endif
-#if defined(CERNLIB_CDC)
- DATA IX11/
- +O"41373432313132343726",O"00773741444647474644",
- +O"00000000774141363426",O"46454442363433323226",
- +O"00000000774731434546",O"46474746454340463326",
- +O"00000077313233364144",O"00007743437750314326",
- +O"47464441363332334526",O"00773132333641444647",
- +O"33323233354042454626",O"41444647474644414035",
- +O"00000000007732333540",O"00000077473177354726",
- +O"46444135333232333626",O"31313233364245464747",
- +O"36424546464543373432",O"00000000000000000077",
- +O"31313234374043454626",O"43454646454340373432",
- +O"00000000007732333640",O"77453377504077304027",
- +O"47474645423177313125",O"47474645423177424546",
- +O"00000000007731424546",O"31323335374345475026",
- +O"77504745433735333231",O"47464543403177313125",
- +O"00000077314043454647",O"77423277473277323226",
- +O"00000000000000774732",O"77423277473277323226",
- +O"31323335374345475026",O"50504745433735333231",
- +O"00000000000077504377",O"77473177474777313125"/
- DATA IX12/
- +O"00000000000077404034",O"32333436404243444430",
- +O"00000000000000007732",O"77473677314777313125",
- +O"00000077463277323226",O"77405077403077303024",
- +O"00000000000000775050",O"77474777473177313125",
- +O"34323130303132343625",O"44464750504746444236",
- +O"00000000000000773642",O"47474645423177313125",
- +O"00000000007731424546",O"34323130303132343625",
- +O"44464750504746444236",O"00000000774741773642",
- +O"47474645423177313125",O"00007747407731424546",
- +O"33323131333642454726",O"33364245474746454335",
- +O"00000000000000007731",O"00000077473177404030",
- +O"47464441373432313125",O"00000000000000007747",
- +O"00000077405077403027",O"77454077334077332624",
- +O"00000000000000774552",O"00000077314777473126",
- +O"00007740507740403027",O"77473177473177314726",
- +O"77453377504077304027",O"47474645423177313125",
- +O"47474645423177424546",O"00000000007731424546",
- +O"00000077463277323226",O"77503077504077304027"/
- DATA IX13/
- +O"77423277473277323226",O"00000000000000774732",
- +O"77473177473177314726",O"77473177474777313125",
- +O"34323130303132343625",O"44464750504746444236",
- +O"00000000774335773642",O"00000000000077404034",
- +O"77473677314777313125",O"00000077504077304027",
- +O"77405077403077303024",O"00000000000000775050",
- +O"77474777473177313125",O"77473177433577473127",
- +O"34323130303132343625",O"44464750504746444236",
- +O"00000000000000773642",O"77473177474777313125",
- +O"47474645423177313125",O"00000000007731424546",
- +O"47317747317731403127",O"00000000000000000077",
- +O"00000077473177404030",O"40403736353332313127",
- +O"77404142434546474777",O"32313132333677404026",
- +O"42454647474645423633",O"00000000000000007736",
- +O"00000077473177473126",O"34333231302777404025",
- +O"00775150474645444137",O"41373432313132353126",
- +O"00007747434647474644",O"77503077503077404024",
- +O"00000000000077404034",O"46424236363232363632"/
- DATA IX14/
- +O"00000000007736424246",O"46454677424277363626",
- +O"33323131333642454747",O"45433533317747454335",
- +O"32313133364245474746",O"00000000000000773233",
- +O"77404140374077404033",O"77503277404777324126",
- +O"00000000000000774731",O"00000000007730503024",
- +O"46454442363433323227",O"41403740774040444546",
- +O"00000000000000007740",O"43454751525251505124",
- +O"42434477343536404142",O"27262627313335363740",
- +O"00000000000000772730",O"40374077404140374033",
- +O"00000000000000774041",O"37404177404140374033",
- +O"00000000773740414140",O"00000000007750305024",
- +O"77443577363677353531",O"00000000000000774435",
- +O"77433477434377424231",O"00000000000000774334",
- +O"45337745337733453330",O"00000000000000000077",
- +O"41414037363637404231",O"41424241403737407737",
- +O"77403737404142424135",O"42403736363740414137",
- +O"00000000000000000077",O"37374041424241403631",
- +O"37363637404141407741",O"77404141403736363743"/
- DATA IX15/
- +O"36404142424140373741",O"00000000000000000077",
- +O"40607740267740272217",O"00000000000000000077",
- +O"37353331303031344024",O"43454750504744407740",
- +O"42414077363740774041",O"00000000000077423677",
- +O"31303031333436374024",O"47454442414077403432",
- +O"00000077404446475050",O"51464240772732364024",
- +O"40424651774036322777",O"00000000000000000077",
- +O"46505151504644424024",O"37414344444341774144",
- +O"30323437773735343435",O"37407740363432302727",
- +O"00774236774241407736",O"40424446475051525223",
- +O"40373027262627303236",O"43363433333436404141",
- +O"00000000775252514745",O"00000077314777473125",
- +O"32333536363577324630",O"42424377464441353332",
- +O"00000077434546464543",O"53535251474543424025",
- +O"31333536424345475152",O"36353331272625252627",
- +O"00000000000000007740",O"44434137353434353734",
- +O"36367735357737414344",O"77414177404077373777",
- +O"00000000774343774242",O"77353577344444343434"/
- DATA IX16/
- +O"41774040773737773636",O"00007743437742427741",
- +O"40773540774045334033",O"00007741407737407743",
- +O"40774340774033454033",O"00007737407741407735",
- +O"40407740443246344032",O"77444077344077324077",
- +O"00000000000000774640",O"27774350437746514623",
- +O"00000000000000007750",O"40774540337742403630",
- +O"00000000000000007740",O"30773530357732273223",
- +O"00000000000000007751",O"40774540337742403630",
- +O"00000000000000007740",O"00773740414140374033",
- +O"00000077404140374033",O"77374041414037404133",
- +O"00000000000077275125",O"42403635353640424431",
- +O"00000000000000007744",O"36404243434240363431",
- +O"00000000000000007734",O"00000000000077512723",
- +O"00000077512777404023",O"00000077512777512723",
- +O"77334577453377404030",O"43434240363535364033",
- +O"00000000000000774042",O"00000000007740403633",
- +O"77433542434341373533",O"41407741434341373533",
- +O"00000000773537414343",O"00007744344177414133"/
- DATA IX17/
- +O"37404243424037353633",O"00000000007742367735",
- +O"43424036353536404233",O"00000000007735364042",
- +O"00000077433577374333",O"37414343413735353733",
- +O"77414343413735353777",O"43424036353640424333",
- +O"00000000007736404243",O"33353742444677464627",
- +O"00774644423735333232",O"45434136343277323226",
- +O"00773234364143454646",O"33323233353742444627",
- +O"00000000774644423735",O"33353742444677464627",
- +O"00774644423735333232",O"33353742444546463227",
- +O"00774644423735333232",O"77443577404041434533",
- +O"46773537424445464627",O"37353332323335374244",
- +O"00000000000077464442",O"46454340363377333327",
- +O"00000000000000007746",O"77404077374041403734",
- +O"40414177404142414033",O"00000000000000773436",
- +O"77463777334577333327",O"00000000000077404034",
- +O"40373532302577252521",O"77535352504543407740",
- +O"46454340363377333327",O"00000000000000007746",
- +O"42373533323233353727",O"00773742444647474644"/
- DATA IX18/
- +O"45434136343277323226",O"00773234364143454646",
- +O"33353742444677464627",O"00774644423735333232",
- +O"77454240363577353531",O"43363433343742454630",
- +O"00773334374245464645",O"77443577454341404033",
- +O"46774643413634333327",O"00000000000000007746",
- +O"00000077404677403230",O"77444077344077343025",
- +O"00000000000000774450",O"00000077334677463330",
- +O"31323436404677403230",O"00000000000000000077",
- +O"77463377463377334630",O"36343231313233353726",
- +O"43424137775047454340",O"00000000007750474645",
- +O"77313233343537414327",O"40774043454647474543",
- +O"34353741434445454442",O"00000000000000007733",
- +O"40414140373534323027",O"00007735364046475077",
- +O"36343332323335374227",O"37374042444545444240",
- +O"00000000007746444240",O"77413635353742444530",
- +O"77454341363433333541",O"46774643403737404230",
- +O"42424136343333343742",O"00000000000077363741",
- +O"77323435353432302726",O"77424546464442403634"/
- DATA IX19/
- +O"34333334343331272625",O"43454646454443413735",
- +O"00007750454341404041",O"77434240363535364032",
- +O"35374345464777313527",O"77444342413736347734",
- +O"77324077463635333130",O"41373533333477273526",
- +O"51474544444547774543",O"00000000000000007752",
- +O"45464777323334353227",O"00000000007732354043",
- +O"43774643403737404230",O"36427744423735353640",
- +O"77364042424135333334",O"41373534333334364030",
- +O"00774042444546464543",O"27774645444377323625",
- +O"00000000000077513431",O"46454341373534333327",
- +O"77273334364042444546",O"36343332323335375127",
- +O"00774143444545444240",O"00775035323077364126",
- +O"35333335353432302726",O"00000077474746444237",
- +O"37343231303031333525",O"36404244465050474542",
- +O"00000000000000007733",O"47507747454335333127",
- +O"00000000007730313345",O"33333230262577344424",
- +O"51504644423735333232",O"00000000000000000077",
- +O"35333130272730323424",O"50474543414037407737"/
- DATA IX20/
- +O"00000000000077464750",O"77453377453377404030",
- +O"00000000000077404036",O"40314740774047314031",
- +O"00000000000000000077",O"44444577424277373731",
- +O"77454435343436434545",O"34353742444545443534",
- +O"00000000007734353534",O"41404077414177404036",
- +O"00000000000000774041",O"77443577414377364033",
- +O"00000000000000774435",O"00000000007733453330",
- +O"41414040434341403634",O"00007740414140407743",
- +O"40414244464747464627",O"36374041424377353637",
- +O"00000077323231313234",O"41404077404141404036",
- +O"00000000000000774041",O"40404177404141404036",
- +O"00000000000077404141",O"00000000007745334530",
- +O"77433677373777363633",O"00000000000000774336",
- +O"77423577424277414133",O"00000000000000774235",
- +O"45337745337745334530",O"00000000000000000077",
- +O"36377741403636374132",O"36404141373677404177",
- +O"36774140773637414140",O"00774137363640417737",
- +O"42417737404242413733",O"42403737414277403777"/
- DATA IX21/
- +O"42773740774241373740",O"00773741424240377741",
- +O"40517740317740322725",O"00000000000000000077",
- +O"26257742424137363625",O"46464543353332323130",
- +O"36377753257753525047",O"00000000007741424137",
- +O"77414077374077404030",O"34377734363740774137",
- +O"40774441774442414077",O"44407730323677303234",
- +O"35364077504642775046",O"43434240773536407735",
- +O"00000000007743424077",O"77404077404077404030",
- +O"40774137774140773740",O"42403677424140773637",
- +O"45444240773334364077",O"34364077444240363477",
- +O"47464442407732313132",O"40774442403634774647",
- +O"40773230303132333536",O"33774650504746454342",
- +O"00000000007745434035",O"77413777414077374030",
- +O"47504745475050464340",O"33353435374143444345",
- +O"40353230303133313031",O"00000000000000000077",
- +O"35343435404142434432",O"43413735353640414140",
- +O"00000000000000007744",O"00000077354377433533",
- +O"32354144465152535327",O"51464441353230272730"/
- DATA IX22/
- +O"00000000000077535352",O"34363741424445475026",
- +O"41373634333130303133",O"00000077505047454442",
- +O"41373432313132343731",O"00773741444647474644",
- +O"00000077324646323232",O"00000000774047314031",
- +O"00000077404640324032",O"50434540333530364030",
- +O"00000000000000774042",O"43454377424346434227",
- +O"00000000000077453277",O"77434240363577404033",
- +O"00000000000077424036",O"35333577363532353627",
- +O"00000000000077463377",O"77434240363577404033",
- +O"00000000000077424036",O"00007740414140404136",
- +O"00000077404141404036",O"00007740414140404136",
- +O"00000000000077344433",O"00007742403737404235",
- +O"00007736404141403634",O"00000000000077443432",
- +O"00000077443477404032",O"00000077443477443432",
- +O"77354377433577404033"/
- DATA IY11/
- +O"51515045403530252452",O"00772424253035404550",
- +O"00000000775124273052",O"30262524242526303152",
- +O"00000000775151373432",O"46434136353434242452",
- +O"00000077454750515150",O"00007751244042422452",
- +O"41363433333435242452",O"00774547505151504643",
- +O"46423530252424252752",O"34353742434650515150",
- +O"00000000007742373534",O"00000077242440512452",
- +O"40363534333127252452",O"42454750515150474542",
- +O"24242527313334353640",O"00000000000000000077",
- +O"32333640414140363352",O"50454033272524242527",
- +O"00000000007746505151",O"77424240512440512451",
- +O"32302625242440512452",O"45424037363640363534",
- +O"00000000007751515047",O"34312725242425273153",
- +O"77444650515150464441",O"34312725242440512452",
- +O"00000077515150464441",O"40363640242440512451",
- +O"00000000000000775151",O"77363640242440512450",
- +O"34312725242425273153",O"41444650515150464441",
- +O"00000000000077414140",O"77363640512440512453"/
- DATA IY12/
- +O"00000000000077512444",O"44475051515047442450",
- +O"00000000000000007742",O"77513540422440512452",
- +O"00000077515140512447",O"40512440512440512454",
- +O"00000000000000775124",O"77512440512440512453",
- +O"50464441343127252453",O"25273134414446505151",
- +O"00000000000000772424",O"33302625242440512452",
- +O"00000000007737373635",O"50464441343127252453",
- +O"25273134414446505151",O"00000000775345402424",
- +O"32302625242440512452",O"00007751364036363534",
- +O"34333127252424252752",O"50515150464341403735",
- +O"00000000000000007746",O"00000077242440512450",
- +O"43465051515046432453",O"00000000000000007724",
- +O"00000077512440512451",O"40512440512440512454",
- +O"00000000000000775124",O"00000077512440512452",
- +O"00007736244051362451",O"77515140242440512452",
- +O"77424240512440512451",O"32302625242440512452",
- +O"45424037363640363534",O"00000000007751515047",
- +O"00000077242440512447",O"77515140512440512451"/
- DATA IY13/
- +O"40363640242440512451",O"00000000000000775151",
- +O"77515140242440512452",O"77363640512440512453",
- +O"50464441343127252453",O"25273134414446505151",
- +O"00000000773636402424",O"00000000000077512444",
- +O"77513540422440512452",O"00000077512440512451",
- +O"40512440512440512454",O"00000000000000775124",
- +O"77512440512440512453",O"77515140363640242451",
- +O"50464441343127252453",O"25273134414446505151",
- +O"00000000000000772424",O"77242440512440512453",
- +O"33302625242440512452",O"00000000007737373635",
- +O"51514024244051362451",O"00000000000000000077",
- +O"00000077242440512450",O"51332725242425273151",
- +O"77332725242425273140",O"42403533323140512452",
- +O"31323335404243444443",O"00000000000000007731",
- +O"00000077245140512452",O"42413733323240512453",
- +O"00773232333741424343",O"24242527323642515152",
- +O"00007751514236322725",O"77515140404040513054",
- +O"00000000000077602044",O"42424646424236363246"/
- DATA IY14/
- +O"00000000007732323636",O"31302740552040552052",
- +O"34333127252424252730",O"37363433314042403735",
- +O"44454650515150464240",O"00000000000000774645",
- +O"77475051504740422445",O"40353540602040602053",
- +O"00000000000000774343",O"00000000007751402754",
- +O"30262524242526303151",O"50515047404237353432",
- +O"00000000000000007747",O"23212020212223222154",
- +O"30242240565450343025",O"55565760605755535044",
- +O"00000000000000775756",O"51504740333435343345",
- +O"00000000000000774750",O"50515040333435343345",
- +O"00000000775554525047",O"00000000007751402754",
- +O"40202040602040602047",O"00000000000000776060",
- +O"40202040602040602047",O"00000000000000776060",
- +O"46464042424041353150",O"00000000000000000077",
- +O"35333130262422212047",O"36343230272523214037",
- +O"40575553515046444240",O"60575654525047454341",
- +O"00000000000000000077",O"35333130262422212047",
- +O"36343230272523214037",O"40575553515046444240"/
- DATA IY15/
- +O"60575654525047454341",O"00000000000000000077",
- +O"51104051344047333360",O"00000000000000000077",
- +O"45464645434136322654",O"46464543413632264043",
- +O"52474340524743404345",O"00000000000077525240",
- +O"40353127262627313454",O"27262627313440524542",
- +O"00000077524542403531",O"40353025404035302554",
- +O"53504340405350434040",O"00000000000000000077",
- +O"36374143454646454254",O"26262731333537403736",
- +O"37363637403735333127",O"47424042454646454341",
- +O"00775252405247424052",O"50464336343333343555",
- +O"33344041434547505151",O"46373431272524252731",
- +O"00000000774750515150",O"00000077473140473153",
- +O"34353534323140463150",O"45434240313232313132",
- +O"00000077424243454646",O"37414344454544434053",
- +O"45454443353433333435",O"35343333343537414344",
- +O"00000000000000007740",O"41434444434137353444",
- +O"42364041374034343537",O"40433540433540433540",
- +O"00000000774137404236",O"40433540343444443444"/
- DATA IY16/
- +O"35404335404335404335",O"00007743354043354043",
- +O"35404235403243433245",O"00007742404042404042",
- +O"43403643404635354645",O"00007736404036404036",
- +O"32404032453636453246",O"40454040454040364040",
- +O"00000000000000773640",O"40404540334042403655",
- +O"00000000000000007740",O"30403530354032273250",
- +O"00000000000000007751",O"40404540334042403655",
- +O"00000000000000007740",O"27404350434046514650",
- +O"00000000000000007750",O"00773231272524252645",
- +O"00000077475051504745",O"77555452504750515045",
- +O"00000000000077602053",O"56534742363125222047",
- +O"00000000000000007760",O"56534742363125222047",
- +O"00000000000000007760",O"00000000000077404055",
- +O"00000077404040512755",O"00000077434340353555",
- +O"77433540433540463250",O"36414344434136343345",
- +O"00000000000000773334",O"00000000007744333545",
- +O"77444440363433333445",O"37374037363433333445",
- +O"00000000774344444340",O"00007741413340443345"/
- DATA IY17/
- +O"44444341373636373345",O"00000000007733334043",
- +O"41434443413634333345",O"00000000007741373637",
- +O"00000077333340443345",O"33333436373736343345",
- +O"77374043444443403740",O"36343334364041403645",
- +O"00000000007744444341",O"36343333343640513352",
- +O"00774650515150464341",O"36343333343640512451",
- +O"00774650515150464341",O"46434136343333343651",
- +O"00000000774650515150",O"36343333343640512452",
- +O"00774650515150464341",O"36343333343537414151",
- +O"00774650515150464341",O"77333340513025242447",
- +O"36405760605756533352",O"51504643413634333334",
- +O"00000000000077465051",O"37343333343740512452",
- +O"00000000000000007751",O"77513340242324252444",
- +O"57543340242324252445",O"00000000000000776060",
- +O"77514140453340512450",O"00000000000077512444",
- +O"37343333343740513357",O"77513734333334374051",
- +O"37343333343740513352",O"00000000000000007751",
- +O"51515046434136343352",O"00773333343641434650"/
- DATA IY18/
- +O"36343333343640603351",O"00774650515150464341",
- +O"36343333343640603352",O"00774650515150464341",
- +O"77333334364140513346",O"42414036343333343651",
- +O"00774650515150464543",O"77333340515150452447",
- +O"33404550515150453352",O"00000000000000007751",
- +O"00000077513340513350",O"40513340513340513353",
- +O"00000000000000775133",O"00000077513340513351",
- +O"60605755513340513350",O"00000000000000000077",
- +O"77515140333340513351",O"51515046434036343353",
- +O"36343333403336424550",O"00000000007751515046",
- +O"40605042363327252452",O"35403535343331262424",
- +O"47505151504745424036",O"00000000000000007744",
- +O"51444035343333343652",O"00007760555140363340",
- +O"51504744413634333351",O"25273133354043465051",
- +O"00000000007727252424",O"40414036343333343550",
- +O"77465051515046444241",O"31403131302726252447",
- +O"57555351474543403533",O"00000000000077566060",
- +O"40514236343333353752",O"77604540353333343642"/
- DATA IY19/
- +O"50464336343333353752",O"24253033404345505151",
- +O"00007742403633302624",O"77454751515046423345",
- +O"41403433333440513351",O"77505151504342414041",
- +O"77513340512625242450",O"50515147443740603353",
- +O"47515150464233404246",O"00000000000000007745",
- +O"40363340514641333351",O"00000000007751504643",
- +O"31403131302726252450",O"43424042424137353332",
- +O"77606057555452504644",O"51515047444136343351",
- +O"00773333343540434650",O"36405146413340513353",
- +O"00000000000077333334",O"43465051515047444151",
- +O"77604136343333343540",O"51504744413634333353",
- +O"00773334354043465051",O"00773333343640513352",
- +O"51474436343333353752",O"00000077333642465051",
- +O"51515047454237353453",O"46413533333540434650",
- +O"00000000000000007760",O"35334060605635333351",
- +O"00000000007760565340",O"36343333353740602453",
- +O"33364346505151504643",O"00000000000000000077",
- +O"50515150454237343353",O"42455051515045414045"/
- DATA IY20/
- +O"00000000000077333437",O"77464640404040463350",
- +O"00000000000077453242",O"50343450403044443047",
- +O"00000000000000000077",O"33323240522640522650",
- +O"40424136343231313233",O"44454646454442403534",
- +O"00000000007744444343",O"44444340403340403343",
- +O"00000000000000774343",O"40363640453240453246",
- +O"00000000000000774141",O"00000000007746403250",
- +O"37404037363433333445",O"00007743434444434036",
- +O"35323026262730302751",O"50464335312740514743",
- +O"00000077515050515252",O"44444340363637373643",
- +O"00000000000000774343",O"43444440363637373643",
- +O"00000000000077474543",O"00000000007746403250",
- +O"40262640522640522645",O"00000000000000775252",
- +O"40262640522640522645",O"00000000000000775252",
- +O"46464042424041353150",O"00000000000000000077",
- +O"32274036343230272645",O"40373634323040373440",
- +O"46404441405046444241",O"00775251504644424051",
- +O"32274036343230272646",O"40373634323040373440"/
- DATA IY21/
- +O"46404441405046444241",O"00775251504644424051",
- +O"46244046354045353551",O"00000000000000000077",
- +O"46504027252424252753",O"36313027273031364244",
- +O"51504050504050464442",O"00000000007750515252",
- +O"40524140524140413350",O"25304025263033405252",
- +O"33402530402526303340",O"31334033323240333131",
- +O"35343340333232403331",O"40353433404035334040",
- +O"00000000007740353340",O"40434140363440312750",
- +O"25405252405247405247",O"30273040302725403027",
- +O"34353431403435343140",O"42413640353534353540",
- +O"40424241364042414042",O"43404242414242404241",
- +O"43405047454750504746",O"50405047454750504746",
- +O"00000000007750504750",O"40525240524740524750",
- +O"33354042424346505047",O"32333026252526303332",
- +O"47505046434242403533",O"00000000000000000077",
- +O"40414344444341404046",O"44434136343333343637",
- +O"00000000000000007744",O"00000077433540433545",
- +O"35343435364143465053",O"37424344444342413736"/
- DATA IY22/
- +O"00000000000077303235",O"34353641424343424052",
- +O"36414243434240373534",O"00000077403735343435",
- +O"47474644413734323147",O"00773131323437414446",
- +O"00000077323246463246",O"00000000773044443047",
- +O"00000077264052402646",O"35414743474135352750",
- +O"00000000000000772735",O"42403640434240363551",
- +O"00000000000077404040",O"40363532353640463345",
- +O"00000000000077353335",O"42403640434240363551",
- +O"00000000000077404040",O"40424346434240453245",
- +O"00000000000077434543",O"00007737353333343443",
- +O"00000077434344444343",O"00007747454343444443",
- +O"00000000000077453245",O"00007745434136343244",
- +O"00007745434136343243",O"00000000000077404046",
- +O"00000077404040443446",O"00000077424240363646",
- +O"77423640423640433545"/
- DATA ISTART/
- + 1, 3, 4, 6, 8, 9, 11, 14, 15, 19, 22, 23, 26, 28, 30,
- + 32, 33, 36, 37, 38, 40, 41, 42, 44, 45, 48, 50, 53, 55, 58,
- + 59, 61, 62, 64, 65, 66, 67, 68, 71, 72, 73, 75, 76, 77, 80,
- + 81, 82, 83, 85, 86, 87, 90, 91, 93, 95, 96, 98,101,102,104,
- +106,107,108,110,115,116,118,119,122,126,128,130,131,133,135,
- +137,142,147,149,153,156,159,164,168,169,172,176,180,183,185,
- +187,190,192,194,196,198,199,200,201,202,204,206,207,208,209,
- +210,212,213,214,216,217,219,221,222,224,226,228,230,232,234,
- +236,237,240,242,243,245,246,247,249,251,253,255,257,258,260,
- +261,263,264,266,267,269,270,273,277,279,282,284,287,289,292,
- +293,295,296,299,301,304,306,308,310,312,313,315,318,320,323,
- +326,327,328,330,334,336,338,339,341,344,346,348,349,351,353,
- +355,359,363,365,369,376,386,391,394,395,398,401,403,404,405,
- +406,408,410,412,414,416,417,418,419,420,421,422,423,424,425/
-*
- DATA NBIT,NBITCH,NBITMX/60,6,60/
-#endif
-#if defined(CERNLIB_IBM)||defined(CERNLIB_VAX)||defined(CERNLIB_AIX370)
- DATA IX11/
- +Z1969C7D6,Z217DC699,Z269E79A4,Z00FDF864,Z2185E716,Z0000003F,
- +Z1C6DA696,Z2696489E,Z27663966,Z0000003F,Z238266D6,Z269E79A5,
- +Z1A6DE864,Z00000FD9,Z3FA198D6,Z0003F8E3,Z1B69B956,Z279A485E,
- +Z1E8649A7,Z00FD969B,Z208A5996,Z1B69A6DD,Z2692181D,Z219269E7,
- +Z3F69B760,Z19FDD9D6,Z00000FE7,Z1A69B796,Z2692175B,Z229669E7,
- +Z1965A6DE,Z258DF71A,Z1E8A59A6,Z0000003F,Z208E5996,Z1965A71F,
- +Z2381F71A,Z239669A5,Z3F69B7A0,Z20FD8817,Z3F95BFE8,Z19FD9655,
- +Z279E6962,Z19FE2966,Z279E6962,Z3F662966,Z23967A16,Z1969B75F,
- +Z1F75B699,Z3FA27963,Z19FD9655,Z279A58E0,Z208E59A7,Z00000FD9,
- +Z1AFDA696,Z3F89AFE7,Z0003F9DA,Z1AFDA696,Z3F89AFE7,Z23967A16,
- +Z1969B75F,Z1F75B699,Z28A27963,Z00FE88FF,Z27FD9655,Z3F9D9FE7,
- +Z00FE081C,Z228E4918,Z1A6DC7A0,Z00000FDA,Z27FD9655,Z3F9DEFD9,
- +Z1AFDA696,Z00000FE6,Z18FD8614,Z3F828FE0,Z0003FA28,Z19FD9655,
- +Z3F9E7FE7,Z1969C795,Z1C699618,Z279A489E,Z249A7A28,Z0003F7A2,
- +Z19FD9655,Z279E6962,Z3F662966,Z1969C795,Z1C699618,Z279A489E,
- +Z249A7A28,Z2787F7A2,Z0000003F,Z19FD9655,Z279E6962,Z3F662966,
- +Z0003F9E0,Z1E8A59D6,Z1B69965B,Z279A58DD,Z1B7A2967,Z00000FD9,
- +Z19FE0818,Z00000FE7,Z1C699655,Z279A485F,Z00000FE7,Z28FE0617/
- DATA IX12/
- +Z00000FE0,Z20FDB594,Z3F960FDB,Z0003F96A,Z27FE7656,Z00000FD9,
- +Z3F820617,Z0003F828,Z19FD99D6,Z3F9D9FE7,Z20FD8817,Z3F95BFE8,
- +Z19FD9655,Z279E6962,Z19FE2966,Z279E6962,Z3F662966,Z1AFDA696,
- +Z00000FE6,Z20FD8817,Z3FA18FE8,Z1AFDA696,Z3F89AFE7,Z0003F9DA,
- +Z19FD99D6,Z3F9D9FE7,Z27FD9655,Z3F9D9FE7,Z1969C795,Z1C699618,
- +Z279A489E,Z249A7A28,Z2377F7A2,Z0000003F,Z00FE081C,Z27FD9655,
- +Z3F9DEFD9,Z20FD8817,Z00000FE8,Z18FD8614,Z3F828FE0,Z0003FA28,
- +Z19FD9655,Z3F9E7FE7,Z1DFE7657,Z3F9D9FE3,Z1969C795,Z1C699618,
- +Z279A489E,Z249A7A28,Z0003F7A2,Z27FD9655,Z3F9D9FE7,Z19FD9655,
- +Z279E6962,Z3F662966,Z3F660657,Z2767F9D9,Z0000003F,Z19FE0818,
- +Z00000FE7,Z1B699657,Z2081F79D,Z259A79FF,Z3F8218A3,Z1EFE0816,
- +Z1A65969B,Z2696279B,Z229669E7,Z00000FDE,Z19FE7656,Z00000FE7,
- +Z17FE0815,Z1C6DA658,Z2696485F,Z00FE9A27,Z1969D656,Z217DC699,
- +Z269E79A4,Z0003F9E3,Z18FE0814,Z3FA18FE8,Z00FE081C,Z1A69E79A,
- +Z268A279E,Z3F7A28A6,Z22FDE796,Z26966FE2,Z1E8A59E7,Z1B69965B,
- +Z3F9E58DD,Z258DD6D9,Z229679E6,Z1A6596DE,Z0003F69B,Z20FE081B,
- +Z3F82181F,Z27FDA856,Z3FA1AFE0,Z0003F9D9,Z3F628614,Z1C6DA697,
- +Z2696489E,Z20824966,Z2181F83F,Z00000FE0,Z2AA68A54,Z23967A6A/
- DATA IX13/
- +Z1D7A0862,Z228E4FDC,Z1B75E7E0,Z175965D9,Z0003F5D8,Z2181F81B,
- +Z207E0FE0,Z0003F821,Z2181F81B,Z1F821FE0,Z1F821860,Z0000003F,
- +Z3FA18A14,Z1EFDD759,Z3F91DFDE,Z0003F91D,Z23FE2899,Z3F8DCFE3,
- +Z0003F8DC,Z3F6E56D8,Z256FF95B,Z0000003F,Z1E7E0899,Z218607DE,
- +Z1F7E0FDF,Z218A2860,Z218A285D,Z3F81F7E0,Z1F82185F,Z2281F79E,
- +Z0000003F,Z22860799,Z1F7E0862,Z21860FE1,Z1F79E7E0,Z1F79E7E3,
- +Z3F821860,Z2181F7E1,Z1E8218A2,Z0000003F,Z3F81748F,Z20C3F816,
- +Z0000003F,Z1865C814,Z1F75B658,Z27920FE0,Z23967A28,Z1F83F821,
- +Z22860FDE,Z00FE27BF,Z1C79F814,Z1961865B,Z20FE071A,Z279648A1,
- +Z249A7A28,Z00000FE0,Z1769E814,Z299A283F,Z2079A5FF,Z208A6A7F,
- +Z0000003F,Z26922814,Z26A29A68,Z2387F864,Z1F863924,Z1F75C71D,
- +Z1869C7FF,Z1C6985D7,Z1F83F81E,Z22860FDE,Z00FE27BF,Z28A6AA93,
- +Z208A49A7,Z165D869E,Z207D85D6,Z1C7A0861,Z2379C6DB,Z2AAA99E5,
- +Z0000003F,Z27FE7655,Z00000FD9,Z1DFDA998,Z1A6DD79E,Z2485D6DA,
- +Z228A3FE6,Z259A6963,Z00000FE3,Z258E2815,Z2BAEAA67,Z23967A6A,
- +Z196DD7A2,Z16555597,Z1E75B657,Z00000FE0,Z1C71D7DC,Z248E17DD,
- +Z3F7E18E4,Z1E7BF75D,Z20FDF7FF,Z3F861FE0,Z238FF8A2,Z0000003F,
- +Z2491C71C,Z3F75DFDC,Z1F7FF79E,Z21FE083F,Z3F8A2FE1,Z0003F8E3/
- DATA IX14/
- +Z2095B81B,Z20FDD83F,Z3F7E0FE3,Z0003F860,Z206E581B,Z20FE383F,
- +Z3F860FDD,Z0003F7E0,Z1A99C81A,Z2083F824,Z20FDA83F,Z3F920FDC,
- +Z0003F9A0,Z3F9A9993,Z17FE3A23,Z00000FE8,Z3F8A0798,Z20FE581B,
- +Z00000FE0,Z3F697693,Z18FDD61D,Z00000FE9,Z3F8A0798,Z20FE581B,
- +Z00000FE0,Z2181F81B,Z00FDF821,Z2181F81B,Z00000FE0,Z207E085B,
- +Z3F7E0861,Z00FD7A55,Z1E822919,Z2281E75D,Z00000FE4,Z2281E719,
- +Z1E8228E3,Z00000FDC,Z00FE95D3,Z17FE0813,Z00000FE9,Z17FE95D3,
- +Z00000FE9,Z1BFE0818,Z3F6E5FE5,Z1D75E81B,Z238E281E,Z0003F822,
- +Z3F82079B,Z2385F75B,Z3F8DD8A3,Z2385F75B,Z2183F863,Z1D7E18E3,
- +Z0000003F,Z21FE185B,Z0003F91C,Z207DD79B,Z1F8228E2,Z3F89EFDD,
- +Z1D7A089B,Z238A079D,Z3F75E822,Z1DFDF8DB,Z00000FE3,Z1F75D7DB,
- +Z1F8638E1,Z1F75D7FF,Z3F8638E1,Z1E8228DB,Z238A079D,Z3F7A08A3,
- +Z26FE6997,Z1B75F8A4,Z1F75B69A,Z00FE6922,Z1AFDA696,Z258E179C,
- +Z218E59A6,Z00FDA71E,Z1F8A4997,Z1B69A6DD,Z269227DD,Z0000003F,
- +Z26FE6997,Z1B75F8A4,Z1F75B69A,Z00FE6922,Z259A6697,Z1B75F8A4,
- +Z1F75B69A,Z00FE6922,Z2086395B,Z3F91DFE0,Z24966997,Z26FDD7E2,
- +Z1B75F8A4,Z1F75B69A,Z00FE6922,Z1BFDB6D7,Z2696381E,Z00000FE6,
- +Z208607DC,Z3F820FDF,Z218A181B,Z20861FE0,Z0003F71E,Z25FDB6D7/
- DATA IX15/
- +Z3F99FFDB,Z00FE081C,Z15FD5551,Z207DD698,Z258E0FE0,Z3FAEBAA8,
- +Z1BFDB6D7,Z2696381E,Z00000FE6,Z1A6DD7D7,Z227DD6DA,Z269E79A4,
- +Z00FDF8A4,Z1AFDA696,Z258E179C,Z218E59A6,Z00FDA71E,Z26FE6997,
- +Z1B75F8A4,Z1F75B69A,Z00FE6922,Z1DFDD759,Z3F96281E,Z1F8A5998,
- +Z2379C6DC,Z229669A5,Z00FDB71F,Z2386081B,Z3F91DFE5,Z1E71B6D7,
- +Z26FE68E1,Z00000FE6,Z26FE0698,Z00000FE0,Z20FDC615,Z3F920FDC,
- +Z0003F928,Z26FE66D8,Z00000FDB,Z26FE0698,Z1969C7A0,Z0000003F,
- +Z1BFDB998,Z3F99BFE6,Z1A6DD7D6,Z1E71A659,Z289E58E0,Z238A17FF,
- +Z3FA279A5,Z1D7E18D7,Z3F65A6DC,Z269E7963,Z20FE08E5,Z24965922,
- +Z1C75F863,Z00000FDB,Z1D71A617,Z2086181F,Z209A7A3F,Z0003F75E,
- +Z1B75F897,Z1E71B69A,Z259648A0,Z1F7E08A4,Z3F9A48A0,Z1F8A4958,
- +Z3F85E75D,Z1C6DB761,Z3F96385E,Z1F7E0898,Z26FE68E0,Z1B6DC7E2,
- +Z228A179C,Z00FDE7E1,Z1C6985D6,Z3F69C75D,Z248A079C,Z3F8A59A6,
- +Z1B657595,Z1C6DB71C,Z248E17DD,Z239669A5,Z23860821,Z0003FA25,
- +Z1D75E81A,Z3F8E281E,Z27FD9757,Z1D7E3966,Z1F79CFDC,Z3F9238A1,
- +Z1E75B658,Z3F6A0FE6,Z1CFD7756,Z217DD6DB,Z259FF963,Z299E5924,
- +Z00000FEA,Z1B71D697,Z259A7FDA,Z3F69D823,Z1F7E0898,Z23FE68E0,
- +Z1F75D7A0,Z1E8BF922,Z2175B6DC,Z3F7A08A2,Z1B71E818,Z217DD71B/
- DATA IX16/
- +Z259A6963,Z00FE08A4,Z23FDA795,Z17FE6964,Z00FE9719,Z1D71B6D7,
- +Z2696385F,Z208A4966,Z3F5DB71E,Z1B75FA57,Z1E71B69A,Z259648A0,
- +Z00FE18E4,Z18FDE856,Z00FE875A,Z1C6985D6,Z1D6DB75D,Z279A489F,
- +Z00000FE7,Z1865B755,Z1F71A658,Z28A27962,Z1E822926,Z00000FDB,
- +Z2375B657,Z27A3F9E5,Z3F6196E5,Z15FDC914,Z1B6DA616,Z1F75B69A,
- +Z29A26922,Z0000003F,Z1761A714,Z1D6D9617,Z207E0FDF,Z289E58E1,
- +Z00FE69E8,Z1BFE0818,Z3F95BFE5,Z00FE081E,Z209D9819,Z2066783F,
- +Z0000003F,Z22FDF7D9,Z24925FE2,Z1C7A3965,Z3F96475C,Z2596475C,
- +Z1C75F8A4,Z3F71D75C,Z21FE081E,Z21820FE1,Z0003F821,Z23FDE81B,
- +Z3F91DFE1,Z0003F91D,Z3F6E56D8,Z2386079C,Z21860823,Z21820FE3,
- +Z0003F821,Z279E6997,Z20862926,Z23FDD79F,Z1E7E0862,Z1A65969C,
- +Z00000FDA,Z2186081E,Z21820FE0,Z0003F821,Z2186081E,Z20821FE0,
- +Z00FE0861,Z3F95B958,Z1FFDE79B,Z3F8DEFDF,Z0003F8DE,Z22FE185B,
- +Z3F89DFE2,Z0003F89D,Z3F95B958,Z256FF95B,Z0000003F,Z1E79F85A,
- +Z1E7FF860,Z1EFE087F,Z1E82185F,Z1E7E1860,Z1EFE183F,Z1E821FDF,
- +Z00FE17DE,Z228A17DB,Z2287F7E0,Z22FE07FF,Z2281F7E1,Z2285F7E0,
- +Z22FDF83F,Z2281FFE1,Z00FDF862,Z3F81A5D5,Z20A7F819,Z0000003F,
- +Z217DE795,Z1657F8A2,Z1B69A658,Z269A58DD,Z3FAEAA27,Z1E7FFAD5/
- DATA IX17/
- +Z3F86285F,Z20FE0818,Z3F860FDF,Z1F83F85F,Z1C7FF71E,Z248A183F,
- +Z20FE487F,Z1EFD869C,Z2483F61A,Z268BFA26,Z1D7A0FE8,Z1D7A0FDD,
- +Z238E283F,Z3F8E283F,Z20FE0818,Z3F820FE0,Z2183F7E0,Z20FE17FF,
- +Z2183F79F,Z2281EFE2,Z1B71E83F,Z2592283F,Z2281E73F,Z1C7A0FE4,
- +Z3F69965A,Z279A48A0,Z1E73F9A7,Z20FE48A0,Z1969B75E,Z20FDA618,
- +Z279A58E2,Z1BFE6A28,Z3F96381D,Z20FDF818,Z3F85FFE1,Z28A268E0,
- +Z27A27967,Z218E48E5,Z1B75C75F,Z196D9619,Z2075A618,Z0000003F,
- +Z218A391A,Z1D71C760,Z1E821860,Z2385F75D,Z00000FE4,Z23FE375B,
- +Z00000FDD,Z29AABAD7,Z1A761926,Z1A6175D8,Z299A485D,Z00FEBAEA,
- +Z24967A16,Z1C79F862,Z1961865B,Z217DE71B,Z289E5922,Z00000FE8,
- +Z1969C7D9,Z217DC699,Z269E79A4,Z00FDF864,Z2699A69A,Z00000FDA,
- +Z209D9819,Z0000003F,Z2681A81A,Z00000FE0,Z1D61E818,Z288E581B,
- +Z0003F822,Z239A3897,Z23963FE2,Z00FE56BF,Z1DFE081B,Z3F8E281E,
- +Z00FE281E,Z1D69D797,Z1D6DDFDE,Z00FE66FF,Z1DFE081B,Z3F8E281E,
- +Z00FE281E,Z2182085E,Z0003F821,Z2186081E,Z00000FE0,Z2182085E,
- +Z0003F821,Z00FDC91B,Z1F7E089D,Z0003F8A0,Z2186079C,Z0003F7A0,
- +Z00FE471A,Z1CFE081A,Z00000FE4,Z1CFE471A,Z00000FE4,Z1DFE081B,
- +Z3F763FE3/
- DATA IY11/
- +Z1D61552A,Z29A68960,Z18760968,Z00FD4515,Z2951762A,Z0000003F,
- +Z1559866A,Z18595514,Z29A5F71A,Z0000003F,Z1C71452A,Z268E179D,
- +Z27A29A68,Z00000FE5,Z208A252A,Z0003FA54,Z1C75452A,Z2179C6DB,
- +Z29A689A3,Z00FE59E8,Z145155EA,Z2689D615,Z26A29A68,Z1C75F8A3,
- +Z3F89F75C,Z1482952A,Z00000FD4,Z195D552A,Z2079D71B,Z29A27962,
- +Z22967A29,Z1B71D7A0,Z145155D9,Z0000003F,Z2181E6EA,Z1A6DE821,
- +Z15514557,Z289606D7,Z3F9A8A69,Z14829529,Z3F8A2829,Z1482952A,
- +Z1A616554,Z1E81E75C,Z258A07DE,Z3FA69A27,Z1455766B,Z1C657554,
- +Z29A26921,Z3F926A29,Z1482952A,Z1C657554,Z29A26921,Z00000FE9,
- +Z14829529,Z2079E814,Z0003FA69,Z14829528,Z3F79E814,Z1455766B,
- +Z1C657554,Z29A26921,Z21926A29,Z00FE1860,Z1482952B,Z3F79E829,
- +Z00FE9524,Z289E4528,Z249E8A69,Z00000FE2,Z1482952A,Z3FA5D822,
- +Z29829527,Z00000FE9,Z1482952C,Z20A54829,Z0003FA54,Z1482952B,
- +Z3FA54829,Z195D552B,Z289A485C,Z249A8A69,Z155D9721,Z0003F514,
- +Z1482952A,Z1B616554,Z3F7DF79D,Z195D552B,Z289A485C,Z249A8A69,
- +Z155D9721,Z2B960514,Z0000003F,Z1482952A,Z1A616554,Z2079E75C,
- +Z0003FA5E,Z145155EA,Z1C6D95D5,Z238607DD,Z28A69A26,Z00000FE6,
- +Z14829528,Z00000FD4,Z289A352B,Z239A8A69,Z00000FD4,Z14829529/
- DATA IY12/
- +Z00000FE9,Z1482952C,Z20A54829,Z0003FA54,Z1482952A,Z00000FE9,
- +Z20A5E529,Z0003F794,Z1482952A,Z3FA69814,Z14829529,Z3F8A2829,
- +Z1482952A,Z1A616554,Z1E81E75C,Z258A07DE,Z3FA69A27,Z14829527,
- +Z00000FD4,Z14829529,Z3FA69829,Z14829529,Z2079E814,Z0003FA69,
- +Z1482952A,Z3FA69814,Z1482952B,Z3F79E829,Z195D552B,Z289A485C,
- +Z249A8A69,Z155D9721,Z1E7A0514,Z0000003F,Z00FE9524,Z1482952A,
- +Z3FA5D822,Z14829529,Z00000FE9,Z1482952C,Z20A54829,Z0003FA54,
- +Z1482952B,Z3FA54829,Z1E814529,Z3FA6981E,Z195D552B,Z289A485C,
- +Z249A8A69,Z155D9721,Z0003F514,Z1482952B,Z3F514829,Z1482952A,
- +Z1B616554,Z3F7DF79D,Z20A5E529,Z29A60514,Z0000003F,Z14829528,
- +Z00000FD4,Z14557669,Z296D7554,Z14557660,Z3F6D7554,Z1982952A,
- +Z2281D6DA,Z228E4923,Z1969B760,Z00000FD9,Z2982952A,Z00000FD4,
- +Z1A82952B,Z2285F6DA,Z1F8628E3,Z00FDA69B,Z1E8A9A6A,Z145155DA,
- +Z2279A5D5,Z0003FA69,Z2082962C,Z3FA69820,Z00FF0424,Z2279E6A6,
- +Z228A69A2,Z3F69A79E,Z1082D42A,Z1961782D,Z145155D8,Z1C6D95D5,
- +Z208A07DD,Z1F79C6D9,Z29A268A0,Z24966A29,Z0003F9A5,Z27822525,
- +Z3F9E8A68,Z1083042B,Z2075D830,Z0003F8E3,Z3FA605EC,Z15598669,
- +Z18595514,Z227DD71A,Z28A689E0,Z00000FE7,Z124D246C,Z13450411/
- DATA IY13/
- +Z2CA1C615,Z1851282E,Z2FB6BA24,Z2DBAFC30,Z0003FBEE,Z1C75C6E5,
- +Z29A2781B,Z0003F9E8,Z1C75C6E5,Z28A6881B,Z2DB2AA27,Z0000003F,
- +Z3FA605EC,Z10830427,Z20410830,Z0003FC30,Z10830427,Z20410830,
- +Z0003FC30,Z2085D668,Z269A08A2,Z0000003F,Z14491427,Z1D6D9616,
- +Z154D181F,Z1E71A617,Z289A48A0,Z20BEDAE9,Z289E58E1,Z30BEEB2A,
- +Z0000003F,Z14491427,Z1D6D9616,Z154D181F,Z1E71A617,Z289A48A0,
- +Z20BEDAE9,Z289E58E1,Z30BEEB2A,Z0000003F,Z209DB6F0,Z29220A5C,
- +Z0000003F,Z2179A5AC,Z259A6963,Z1E696823,Z269A58E1,Z278E08E5,
- +Z2A9E382A,Z00FEAAA0,Z165D972C,Z207595D6,Z1C82A962,Z175965D9,
- +Z258A0759,Z00000FEA,Z2075856C,Z20758560,Z2BA23820,Z2BA23820,
- +Z0000003F,Z269A58AC,Z1E7E18E5,Z1D7E07DE,Z1659765B,Z1F75B657,
- +Z1F79E7E0,Z269A58E1,Z278A08A5,Z2A9E282A,Z00FEAAA0,Z1B6DC76D,
- +Z289A379C,Z259E8A69,Z1B720863,Z155155D9,Z267DC657,Z27A29A68,
- +Z0000003F,Z1982766B,Z00000FE7,Z19826668,Z1C75D71A,Z1A69965A,
- +Z258E2819,Z228E59A6,Z00000FE2,Z2592382B,Z1F863925,Z1C6DB71D,
- +Z259648DD,Z1D7E18E4,Z1D71B6DC,Z00000FE0,Z217DD724,Z218E4923,
- +Z2071C75F,Z227A085F,Z1D823760,Z208DD823,Z217E089E,Z0000003F,
- +Z1C924724,Z208DD81C,Z237608DD,Z1D823760,Z208DD823,Z0003F8DD/
- DATA IY14/
- +Z1A8E36A5,Z1D822760,Z208A0822,Z0003F8A0,Z2675D9A5,Z2381E8E0,
- +Z207A081E,Z0003F7A0,Z1E7A56A6,Z1A8206A5,Z2081E820,Z20960825,
- +Z0003F7A0,Z208A07AD,Z2082581B,Z00000FE0,Z206976A8,Z1881D61D,
- +Z00000FE9,Z208A07AD,Z2082581B,Z00000FE0,Z209A99A8,Z17823A23,
- +Z00000FE8,Z155155A5,Z00FDA657,Z28A689E5,Z00000FE7,Z27A29A25,
- +Z3FB6CAA8,Z00FF042B,Z19552427,Z2EAE789E,Z00000FF0,Z19552427,
- +Z2EAE789E,Z00000FF0,Z00FE082D,Z208295ED,Z00000FE0,Z2381D76D,
- +Z00000FE3,Z1D8266A8,Z3F8DD823,Z2179C6E5,Z1E863923,Z0003F6DC,
- +Z3F91B765,Z1C6DB725,Z3F92481E,Z1C6DB725,Z1F7E07DE,Z239248E0,
- +Z0000003F,Z1B8246E5,Z0003F861,Z1E79F6E5,Z2492385F,Z3F6DB823,
- +Z1E71B6E5,Z218E48E1,Z3F85F79F,Z1B8246E5,Z00000FDB,Z1F79C6E5,
- +Z1B6DC79F,Z248E07E0,Z3F7E08E4,Z208607A5,Z1E71B71E,Z3F9248E1,
- +Z1E8296EA,Z1E71B6DC,Z29A268E1,Z00FE6A29,Z1E829529,Z1E71B6DC,
- +Z29A268E1,Z00FE6A29,Z1B6DC7A9,Z268E179C,Z26A29A68,Z0000003F,
- +Z1E82952A,Z1E71B6DC,Z29A268E1,Z00FE6A29,Z1D7E1869,Z1E71B6DC,
- +Z29A268E1,Z00FE6A29,Z18554527,Z3F6DB829,Z2FBAB6EA,Z1E82FC30,
- +Z1E71B6DC,Z29A268E1,Z00FE6A29,Z1F82952A,Z1F71B6DC,Z00000FE9,
- +Z13515524,Z3FA5B814,Z13515525,Z2FB1B814,Z0003FC30,Z1B829528/
- DATA IY15/
- +Z3FA61825,Z00FE9524,Z1F8296EF,Z1F71B6DC,Z1B71F829,Z3FA5F71B,
- +Z1F8296EA,Z1F71B6DC,Z00000FE9,Z2179C6EA,Z29A689A3,Z1E8639A8,
- +Z00FDB6DC,Z1E8306E9,Z1E71B6DC,Z29A268E1,Z00FE6A29,Z1E8306EA,
- +Z1E71B6DC,Z29A268E1,Z00FE6A29,Z218296E6,Z3F6DB71E,Z1B6DC7A9,
- +Z2286079C,Z29A26963,Z00FE6A29,Z29A25527,Z3F6DB829,Z29A256EA,
- +Z1B825A29,Z00000FE9,Z1B8296E8,Z00000FE9,Z1B8296EB,Z20A5B829,
- +Z0003FA5B,Z1B8296E9,Z00000FE9,Z1B8296E8,Z30C2FB69,Z0000003F,
- +Z1B8296E9,Z3FA6981B,Z2079C6EB,Z29A689A3,Z1B7A2968,Z1E71B6E0,
- +Z3FA69A26,Z1B5D552A,Z20C2889E,Z1B656514,Z1D81D75C,Z2796281E,
- +Z27A29A68,Z00000FE4,Z1B6DC7AA,Z2992075C,Z2981E6E0,Z0003FC2D,
- +Z1E71B6E9,Z29A27921,Z208E6A29,Z155D96DD,Z3F5D5514,Z1B6DC768,
- +Z2086079C,Z289A48A1,Z3F9A8A69,Z17595527,Z19819658,Z258E075B,
- +Z2FB6BA67,Z00FEEC30,Z1B6DD7EA,Z20A6279C,Z1B6DC7A2,Z3FC2581D,
- +Z1B6DD7EA,Z289A379C,Z23968A69,Z145586E0,Z1E6D8594,Z0003F8A0,
- +Z289A26E5,Z3F967A69,Z1C8296E9,Z2181C6DB,Z238A1821,Z3FA29A68,
- +Z16554528,Z3FA5B829,Z1F8306EB,Z28A699E4,Z226E08A6,Z27A69A26,
- +Z00000FE5,Z2685B6E9,Z2079B829,Z3FA689A3,Z17595528,Z19819658,
- +Z217DD6DA,Z238A08A2,Z2CAA89A4,Z3FC30BED,Z2179C6E9,Z29A689E4/
- DATA IY16/
- +Z1D8239A8,Z00FDB6DC,Z1B8296EB,Z1E8299A1,Z00FDB6DC,Z289E4869,
- +Z239A8A69,Z1B6DC760,Z3FC2179C,Z1E71B6EB,Z29A27921,Z208E6A29,
- +Z00FDB71D,Z1E8296EA,Z00FDB6DC,Z1B6DD7EA,Z299E479C,Z1E8A6A29,
- +Z00000FDB,Z227DD72B,Z29A689E5,Z1D8239A8,Z2685D6DB,Z00000FF0,
- +Z2E75B6E9,Z1D6E0C30,Z3FC2EAE0,Z1F83052B,Z1E71B6DD,Z29A689A3,
- +Z1B7A39A8,Z0000003F,Z227DC6EB,Z28A69A25,Z28961825,Z22968A69,
- +Z00FDB71F,Z208266E8,Z3F9A6820,Z00FE56A2,Z18924627,Z2871CA20,
- +Z0000003F,Z1682A5A8,Z1B69A82A,Z1A65969B,Z208A179C,Z248A075C,
- +Z249669A5,Z3F9248E3,Z1B8206E3,Z24923820,Z0003F8E3,Z1A8256A6,
- +Z2079E825,Z0003F861,Z3F9A06A8,Z1C6DB725,Z1F8207DE,Z2492381E,
- +Z0003F8E3,Z176185E9,Z1D698596,Z178299E3,Z289A3759,Z28A29AAA,
- +Z00000FE9,Z1E7DF7A3,Z2492381E,Z0003F8E3,Z1E7DF7A3,Z2392481E,
- +Z00FE7963,Z3F9A06A8,Z1682A5A5,Z2059682A,Z0003FAAA,Z1682A5A5,
- +Z2059682A,Z0003FAAA,Z2085D668,Z269A08A2,Z0000003F,Z1A6175A5,
- +Z1A5E079C,Z1881F720,Z207DE71A,Z289A48A1,Z26824860,Z26922829,
- +Z00FEAA68,Z1A6175A6,Z1A5E079C,Z1881F720,Z207DE71A,Z289A48A1,
- +Z26824860,Z26922829,Z00FEAA68,Z2095D769,Z2652099D,Z0000003F,
- +Z145155EB,Z26A205D5,Z1865E8A4,Z1E6585D7,Z20A26922,Z29A20A28/
- DATA IY17/
- +Z3FA29AAA,Z218216E8,Z20AA182A,Z186E0AAA,Z15620556,Z155986E0,
- +Z1B815620,Z1A81B659,Z196E06DA,Z1A6A06D9,Z1D71B81B,Z2075B820,
- +Z2075C6E0,Z3F81D6E0,Z1C8195E8,Z208E181E,Z2A9E0AA7,Z1582AAA0,
- +Z17560617,Z185D8818,Z1C75C660,Z1C75C660,Z1D71D760,Z2285E81D,
- +Z208A1822,Z208A285E,Z228A08A1,Z238228A1,Z27A289E6,Z238289E5,
- +Z27A289E6,Z288289E5,Z3FA289E8,Z2782A9E8,Z20AAA82A,Z239A8A27,
- +Z1B7608A2,Z155986DA,Z1A6D8595,Z228A075B,Z27A289A3,Z0000003F,
- +Z23860826,Z20863924,Z1B6DC79F,Z248E179C,Z00000FE4,Z1D823765,
- +Z00000FE3,Z218E6A2B,Z1D71C75E,Z238A17DE,Z1F8A3924,Z00FD869D,
- +Z238E282A,Z1C75E862,Z2281F75C,Z1E8628E3,Z1F75C71D,Z00000FE0,
- +Z1F71A667,Z279E6921,Z1C7E1926,Z00FD965A,Z1A9A66A6,Z00000FDA,
- +Z18924627,Z0000003F,Z20AA05A6,Z00000FD6,Z2175D5E8,Z1D8678E7,
- +Z0003F5DD,Z2281E769,Z2281E823,Z00FE0820,Z1E8266E5,Z2079D69D,
- +Z00FDD6DD,Z2281E769,Z2281E823,Z00FE0820,Z228256A5,Z208A39A3,
- +Z00FE3963,Z1B6DC723,Z0003F7DD,Z239248E3,Z00000FE3,Z238E4923,
- +Z0003F9E5,Z00FE56A5,Z2179C6A4,Z0003F963,Z2179C6A3,Z0003F963,
- +Z00FE0826,Z20824726,Z00000FE0,Z2281E7A6,Z00000FE2,Z1E823765,
- +Z3F89E822/
- DATA ISTART/
- + 1, 5, 7, 11, 15, 17, 21, 26, 28, 35, 40, 42, 47, 51, 55,
- + 58, 60, 65, 67, 68, 71, 73, 75, 78, 80, 85, 88, 94, 98,103,
- +105,108,110,113,115,117,119,121,126,128,130,133,135,137,143,
- +144,146,148,151,153,155,160,162,165,168,170,174,179,181,185,
- +189,191,192,195,204,206,209,210,215,222,225,229,230,233,236,
- +239,248,257,260,267,273,278,288,296,298,304,311,319,325,329,
- +333,338,341,344,347,350,352,354,356,357,360,363,364,366,368,
- +370,373,374,376,380,382,385,388,390,394,397,401,405,409,413,
- +417,419,424,427,429,432,434,435,439,442,446,450,454,456,460,
- +462,465,467,470,472,475,477,482,489,493,498,502,507,511,517,
- +519,523,525,530,533,539,543,546,550,554,556,560,565,568,573,
- +578,580,581,584,591,594,597,598,602,608,611,614,615,618,621,
- +624,632,640,643,650,663,682,691,696,698,703,709,713,715,717,
- +719,722,725,728,731,734,736,738,740,741,743,745,746,748,750/
-*
- DATA NBIT,NBITCH,NBITMX/32,8,30/
-#endif
-#if defined(CERNLIB_NORD)||defined(CERNLIB_HPUX)
- DATA IX11/
- +3132343726B,4137343231B,4647474644B,0077374144B,4141363426B,
- +0000000077B,3433323226B,4645444236B,4731434546B,0000000077B,
- +4340463326B,4647474645B,3233364144B,0000007731B,7750314326B,
- +0000774343B,3332334526B,4746444136B,3641444647B,0077313233B,
- +4042454626B,3332323335B,4644414035B,4144464747B,7732333540B,
- +3177354726B,0000007747B,3232333626B,4644413533B,4245464747B,
- +3131323336B,4543373432B,3642454646B,0000000077B,4043454626B,
- +3131323437B,4340373432B,4345464645B,7732333640B,4077304027B,
- +7745337750B,3177313125B,4747464542B,3177424546B,4747464542B,
- +7731424546B,4345475026B,3132333537B,3735333231B,7750474543B,
- +3177313125B,4746454340B,4043454647B,0000007731B,3277323226B,
- +7742327747B,0000774732B,3277323226B,7742327747B,4345475026B,
- +3132333537B,3735333231B,5050474543B,0077504377B,4777313125B,
- +7747317747B,0077404034B,4243444430B,3233343640B,0000007732B,
- +4777313125B,7747367731B,3277323226B,0000007746B,3077303024B,
- +7740507740B,0000775050B,3177313125B,7747477747B,3132343625B,
- +3432313030B,4746444236B,4446475050B,0000773642B,3177313125B,
- +4747464542B,7731424546B,3132343625B,3432313030B,4746444236B/
- DATA IX12/
- +4446475050B,4741773642B,0000000077B,3177313125B,4747464542B,
- +7731424546B,0000774740B,3642454726B,3332313133B,4746454335B,
- +3336424547B,0000007731B,3177404030B,0000007747B,3432313125B,
- +4746444137B,0000007747B,5077403027B,0000007740B,4077332624B,
- +7745407733B,0000774552B,4777473126B,0000007731B,7740403027B,
- +0000774050B,3177314726B,7747317747B,4077304027B,7745337750B,
- +3177313125B,4747464542B,3177424546B,4747464542B,7731424546B,
- +3277323226B,0000007746B,4077304027B,7750307750B,3277323226B,
- +7742327747B,0000774732B,3177314726B,7747317747B,4777313125B,
- +7747317747B,3132343625B,3432313030B,4746444236B,4446475050B,
- +4335773642B,0000000077B,0077404034B,4777313125B,7747367731B,
- +4077304027B,0000007750B,3077303024B,7740507740B,0000775050B,
- +3177313125B,7747477747B,3577473127B,7747317743B,3132343625B,
- +3432313030B,4746444236B,4446475050B,0000773642B,4777313125B,
- +7747317747B,3177313125B,4747464542B,7731424546B,7731403127B,
- +4731774731B,0000000077B,3177404030B,0000007747B,3332313127B,
- +4040373635B,4546474777B,7740414243B,3677404026B,3231313233B,
- +4645423633B,4245464747B,0000007736B,3177473126B,0000007747B/
- DATA IX13/
- +2777404025B,3433323130B,4645444137B,0077515047B,3132353126B,
- +4137343231B,4647474644B,0000774743B,3077404024B,7750307750B,
- +0077404034B,3232363632B,4642423636B,7736424246B,4277363626B,
- +4645467742B,3642454747B,3332313133B,7747454335B,4543353331B,
- +4245474746B,3231313336B,0000773233B,4077404033B,7740414037B,
- +4777324126B,7750327740B,0000774731B,7730503024B,3433323227B,
- +4645444236B,4040444546B,4140374077B,0000007740B,5251505124B,
- +4345475152B,3536404142B,4243447734B,3335363740B,2726262731B,
- +0000772730B,4140374033B,4037407740B,0000774041B,4140374033B,
- +3740417740B,3740414140B,0000000077B,7750305024B,3677353531B,
- +7744357736B,0000774435B,4377424231B,7743347743B,0000774334B,
- +7733453330B,4533774533B,0000000077B,3637404231B,4141403736B,
- +3737407737B,4142424140B,4142424135B,7740373740B,3740414137B,
- +4240373636B,0000000077B,4241403631B,3737404142B,4141407741B,
- +3736363740B,3736363743B,7740414140B,4140373741B,3640414242B,
- +0000000077B,7740272217B,4060774026B,0000000077B,3031344024B,
- +3735333130B,4744407740B,4345475050B,3740774041B,4241407736B,
- +0077423677B,3436374024B,3130303133B,4077403432B,4745444241B/
- DATA IX14/
- +4446475050B,0000007740B,2732364024B,5146424077B,4036322777B,
- +4042465177B,0000000077B,4644424024B,4650515150B,4341774144B,
- +3741434444B,3735343435B,3032343777B,3432302727B,3740774036B,
- +4241407736B,0077423677B,5051525223B,4042444647B,2627303236B,
- +4037302726B,3436404141B,4336343333B,5252514745B,0000000077B,
- +4777473125B,0000007731B,3577324630B,3233353636B,4441353332B,
- +4242437746B,4546464543B,0000007743B,4543424025B,5353525147B,
- +4345475152B,3133353642B,2625252627B,3635333127B,0000007740B,
- +3434353734B,4443413735B,7737414344B,3636773535B,4077373777B,
- +7741417740B,4343774242B,0000000077B,4444343434B,7735357734B,
- +3737773636B,4177404077B,7742427741B,0000774343B,4045334033B,
- +4077354077B,7737407743B,0000774140B,4033454033B,4077434077B,
- +7741407735B,0000773740B,3246344032B,4040774044B,4077324077B,
- +7744407734B,0000774640B,7746514623B,2777435043B,0000007750B,
- +7742403630B,4077454033B,0000007740B,7732273223B,3077353035B,
- +0000007751B,7742403630B,4077454033B,0000007740B,4140374033B,
- +0077374041B,4140374033B,0000007740B,4037404133B,7737404141B,
- +0077275125B,3640424431B,4240363535B,0000007744B,4240363431B/
- DATA IX15/
- +3640424343B,0000007734B,0077512723B,2777404023B,0000007751B,
- +2777512723B,0000007751B,3377404030B,7733457745B,3535364033B,
- +4343424036B,0000774042B,7740403633B,4341373533B,7743354243B,
- +4341373533B,4140774143B,3537414343B,0000000077B,4177414133B,
- +0000774434B,4037353633B,3740424342B,7742367735B,3536404233B,
- +4342403635B,7735364042B,3577374333B,0000007743B,3735353733B,
- +3741434341B,3735353777B,7741434341B,3640424333B,4342403635B,
- +7736404243B,4677464627B,3335374244B,3735333232B,0077464442B,
- +3277323226B,4543413634B,4143454646B,0077323436B,3742444627B,
- +3332323335B,4644423735B,0000000077B,4677464627B,3335374244B,
- +3735333232B,0077464442B,4546463227B,3335374244B,3735333232B,
- +0077464442B,4041434533B,7744357740B,4445464627B,4677353742B,
- +3335374244B,3735333232B,0077464442B,3377333327B,4645434036B,
- +0000007746B,4041403734B,7740407737B,4142414033B,4041417740B,
- +0000773436B,4577333327B,7746377733B,0077404034B,2577252521B,
- +4037353230B,4543407740B,7753535250B,3377333327B,4645434036B,
- +0000007746B,3233353727B,4237353332B,4647474644B,0077374244B,
- +3277323226B,4543413634B,4143454646B,0077323436B,4677464627B/
- DATA IX16/
- +3335374244B,3735333232B,0077464442B,3577353531B,7745424036B,
- +3742454630B,4336343334B,4245464645B,0077333437B,4341404033B,
- +7744357745B,3634333327B,4677464341B,0000007746B,4677403230B,
- +0000007740B,4077343025B,7744407734B,0000774450B,4677463330B,
- +0000007733B,4677403230B,3132343640B,0000000077B,3377334630B,
- +7746337746B,3233353726B,3634323131B,5047454340B,4342413777B,
- +7750474645B,3537414327B,7731323334B,4647474543B,4077404345B,
- +4445454442B,3435374143B,0000007733B,3534323027B,4041414037B,
- +4046475077B,0000773536B,3335374227B,3634333232B,4545444240B,
- +3737404244B,7746444240B,3742444530B,7741363535B,3433333541B,
- +7745434136B,3737404230B,4677464340B,3333343742B,4242413634B,
- +0077363741B,3432302726B,7732343535B,4442403634B,7742454646B,
- +3331272625B,3433333434B,4443413735B,4345464645B,4341404041B,
- +0000775045B,3535364032B,7743424036B,4777313527B,3537434546B,
- +3736347734B,7744434241B,3635333130B,7732407746B,3477273526B,
- +4137353333B,4547774543B,5147454444B,0000007752B,3334353227B,
- +4546477732B,7732354043B,3737404230B,4377464340B,3735353640B,
- +3642774442B,4135333334B,7736404242B,3334364030B,4137353433B/
- DATA IX17/
- +4546464543B,0077404244B,4377323625B,2777464544B,0077513431B,
- +3534333327B,4645434137B,4042444546B,7727333436B,3335375127B,
- +3634333232B,4545444240B,0077414344B,3077364126B,0077503532B,
- +3432302726B,3533333535B,4746444237B,0000007747B,3031333525B,
- +3734323130B,5050474542B,3640424446B,0000007733B,4335333127B,
- +4750774745B,7730313345B,2577344424B,3333323026B,3735333232B,
- +5150464442B,0000000077B,2730323424B,3533313027B,4037407737B,
- +5047454341B,0077464750B,3377404030B,7745337745B,0077404036B,
- +4047314031B,4031474077B,0000000077B,4277373731B,4444457742B,
- +3436434545B,7745443534B,4545443534B,3435374244B,7734353534B,
- +4177404036B,4140407741B,0000774041B,4377364033B,7744357741B,
- +0000774435B,7733453330B,4341403634B,4141404043B,4140407743B,
- +0000774041B,4747464627B,4041424446B,4377353637B,3637404142B,
- +3231313234B,0000007732B,4141404036B,4140407740B,0000774041B,
- +4141404036B,4040417740B,0077404141B,7745334530B,3777363633B,
- +7743367737B,0000774336B,4277414133B,7742357742B,0000774235B,
- +7745334530B,4533774533B,0000000077B,3636374132B,3637774140B,
- +3677404177B,3640414137B,3637414140B,3677414077B,3640417737B/
- DATA IX18/
- +0077413736B,4242413733B,4241773740B,4277403777B,4240373741B,
- +4241373740B,4277374077B,4240377741B,0077374142B,7740322725B,
- +4051774031B,0000000077B,4137363625B,2625774242B,3332323130B,
- +4646454335B,7753525047B,3637775325B,7741424137B,4077404030B,
- +7741407737B,3740774137B,3437773436B,4442414077B,4077444177B,
- +3677303234B,4440773032B,4642775046B,3536407750B,3536407735B,
- +4343424077B,7743424077B,4077404030B,7740407740B,4140773740B,
- +4077413777B,4140773637B,4240367742B,3334364077B,4544424077B,
- +4240363477B,3436407744B,7732313132B,4746444240B,3634774647B,
- +4077444240B,3132333536B,4077323030B,4746454342B,3377465050B,
- +7745434035B,4077374030B,7741377741B,5050464340B,4750474547B,
- +4143444345B,3335343537B,3133313031B,4035323030B,0000000077B,
- +4142434432B,3534343540B,3640414140B,4341373535B,0000007744B,
- +4377433533B,0000007735B,5152535327B,3235414446B,3230272730B,
- +5146444135B,0077535352B,4445475026B,3436374142B,3130303133B,
- +4137363433B,5047454442B,0000007750B,3132343731B,4137343231B,
- +4647474644B,0077374144B,4646323232B,0000007732B,4047314031B,
- +0000000077B,4640324032B,0000007740B,3530364030B,5043454033B/
- DATA IX19/
- +0000774042B,4346434227B,4345437742B,0077453277B,3577404033B,
- +7743424036B,0077424036B,3532353627B,3533357736B,0077463377B,
- +3577404033B,7743424036B,0077424036B,4140404136B,0000774041B,
- +4141404036B,0000007740B,4140404136B,0000774041B,0077344433B,
- +3737404235B,0000774240B,4141403634B,0000773640B,0077443432B,
- +3477404032B,0000007744B,3477443432B,0000007744B,3577404033B,
- +7735437743B/
- DATA IY11/
- +3530252452B,5151504540B,3035404550B,0077242425B,5124273052B,
- +0000000077B,2526303152B,3026252424B,5151373432B,0000000077B,
- +3434242452B,4643413635B,4750515150B,0000007745B,4042422452B,
- +0000775124B,3435242452B,4136343333B,5151504643B,0077454750B,
- +2424252752B,4642353025B,4650515150B,3435374243B,7742373534B,
- +2440512452B,0000007724B,3127252452B,4036353433B,5150474542B,
- +4245475051B,3334353640B,2424252731B,0000000077B,4140363352B,
- +3233364041B,2524242527B,5045403327B,7746505151B,2440512451B,
- +7742424051B,2440512452B,3230262524B,3640363534B,4542403736B,
- +7751515047B,2425273153B,3431272524B,5150464441B,7744465051B,
- +2440512452B,3431272524B,5150464441B,0000007751B,2440512451B,
- +4036364024B,0000775151B,2440512450B,7736364024B,2425273153B,
- +3431272524B,5150464441B,4144465051B,0077414140B,2440512453B,
- +7736364051B,0077512444B,5047442450B,4447505151B,0000007742B,
- +2440512452B,7751354042B,5140512447B,0000007751B,2440512454B,
- +4051244051B,0000775124B,2440512453B,7751244051B,3127252453B,
- +5046444134B,4446505151B,2527313441B,0000772424B,2440512452B,
- +3330262524B,7737373635B,3127252453B,5046444134B,4446505151B/
- DATA IY12/
- +2527313441B,5345402424B,0000000077B,2440512452B,3230262524B,
- +4036363534B,0000775136B,2424252752B,3433312725B,4341403735B,
- +5051515046B,0000007746B,2440512450B,0000007724B,5046432453B,
- +4346505151B,0000007724B,2440512451B,0000007751B,2440512454B,
- +4051244051B,0000775124B,2440512452B,0000007751B,4051362451B,
- +0000773624B,2440512452B,7751514024B,2440512451B,7742424051B,
- +2440512452B,3230262524B,3640363534B,4542403736B,7751515047B,
- +2440512447B,0000007724B,2440512451B,7751514051B,2440512451B,
- +4036364024B,0000775151B,2440512452B,7751514024B,2440512453B,
- +7736364051B,3127252453B,5046444134B,4446505151B,2527313441B,
- +3636402424B,0000000077B,0077512444B,2440512452B,7751354042B,
- +2440512451B,0000007751B,2440512454B,4051244051B,0000775124B,
- +2440512453B,7751244051B,3640242451B,7751514036B,3127252453B,
- +5046444134B,4446505151B,2527313441B,0000772424B,2440512453B,
- +7724244051B,2440512452B,3330262524B,7737373635B,4051362451B,
- +5151402424B,0000000077B,2440512450B,0000007724B,2425273151B,
- +5133272524B,2425273140B,7733272524B,3140512452B,4240353332B,
- +4243444443B,3132333540B,0000007731B,5140512452B,0000007724B/
- DATA IY13/
- +3240512453B,4241373332B,3741424343B,0077323233B,3642515152B,
- +2424252732B,4236322725B,0000775151B,4040513054B,7751514040B,
- +0077602044B,4236363246B,4242464642B,7732323636B,2040552052B,
- +3130274055B,2424252730B,3433312725B,4042403735B,3736343331B,
- +5150464240B,4445465051B,0000774645B,4740422445B,7747505150B,
- +2040602053B,4035354060B,0000774343B,7751402754B,2526303151B,
- +3026252424B,4237353432B,5051504740B,0000007747B,2223222154B,
- +2321202021B,5450343025B,3024224056B,5755535044B,5556576060B,
- +0000775756B,3435343345B,5150474033B,0000774750B,3435343345B,
- +5051504033B,5554525047B,0000000077B,7751402754B,2040602047B,
- +4020204060B,0000776060B,2040602047B,4020204060B,0000776060B,
- +4041353150B,4646404242B,0000000077B,2422212047B,3533313026B,
- +2523214037B,3634323027B,5046444240B,4057555351B,5047454341B,
- +6057565452B,0000000077B,2422212047B,3533313026B,2523214037B,
- +3634323027B,5046444240B,4057555351B,5047454341B,6057565452B,
- +0000000077B,4047333360B,5110405134B,0000000077B,4136322654B,
- +4546464543B,3632264043B,4646454341B,4743404345B,5247434052B,
- +0077525240B,2627313454B,4035312726B,3440524542B,2726262731B/
- DATA IY14/
- +4542403531B,0000007752B,4035302554B,4035302540B,5350434040B,
- +5350434040B,0000000077B,4646454254B,3637414345B,3537403736B,
- +2626273133B,3735333127B,3736363740B,4646454341B,4742404245B,
- +5247424052B,0077525240B,3333343555B,5046433634B,4547505151B,
- +3334404143B,2524252731B,4637343127B,4750515150B,0000000077B,
- +3140473153B,0000007747B,3140463150B,3435353432B,3232313132B,
- +4543424031B,4243454646B,0000007742B,4544434053B,3741434445B,
- +3433333435B,4545444335B,3537414344B,3534333334B,0000007740B,
- +4137353444B,4143444443B,4034343537B,4236404137B,3540433540B,
- +4043354043B,4137404236B,0000000077B,3444443444B,4043354034B,
- +4335404335B,3540433540B,4043354043B,0000774335B,3243433245B,
- +3540423540B,4042404042B,0000774240B,4635354645B,4340364340B,
- +4036404036B,0000773640B,3636453246B,3240403245B,4040364040B,
- +4045404045B,0000773640B,4042403655B,4040454033B,0000007740B,
- +4032273250B,3040353035B,0000007751B,4042403655B,4040454033B,
- +0000007740B,4046514650B,2740435043B,0000007750B,2524252645B,
- +0077323127B,5051504745B,0000007747B,4750515045B,7755545250B,
- +0077602053B,3125222047B,5653474236B,0000007760B,3125222047B/
- DATA IY15/
- +5653474236B,0000007760B,0077404055B,4040512755B,0000007740B,
- +4340353555B,0000007743B,3540463250B,7743354043B,4136343345B,
- +3641434443B,0000773334B,7744333545B,3433333445B,7744444036B,
- +3433333445B,3737403736B,4344444340B,0000000077B,3340443345B,
- +0000774141B,3636373345B,4444434137B,7733334043B,3634333345B,
- +4143444341B,7741373637B,3340443345B,0000007733B,3736343345B,
- +3333343637B,4443403740B,7737404344B,4041403645B,3634333436B,
- +7744444341B,3640513352B,3634333334B,5150464341B,0077465051B,
- +3640512451B,3634333334B,5150464341B,0077465051B,3333343651B,
- +4643413634B,4650515150B,0000000077B,3640512452B,3634333334B,
- +5150464341B,0077465051B,3537414151B,3634333334B,5150464341B,
- +0077465051B,3025242447B,7733334051B,5756533352B,3640576060B,
- +3634333334B,5150464341B,0077465051B,3740512452B,3734333334B,
- +0000007751B,2324252444B,7751334024B,2324252445B,5754334024B,
- +0000776060B,3340512450B,7751414045B,0077512444B,3740513357B,
- +3734333334B,3334374051B,7751373433B,3740513352B,3734333334B,
- +0000007751B,4136343352B,5151504643B,3641434650B,0077333334B,
- +3640603351B,3634333334B,5150464341B,0077465051B,3640603352B/
- DATA IY16/
- +3634333334B,5150464341B,0077465051B,4140513346B,7733333436B,
- +3333343651B,4241403634B,5150464543B,0077465051B,5150452447B,
- +7733334051B,5150453352B,3340455051B,0000007751B,3340513350B,
- +0000007751B,3340513353B,4051334051B,0000775133B,3340513351B,
- +0000007751B,3340513350B,6060575551B,0000000077B,3340513351B,
- +7751514033B,4036343353B,5151504643B,3336424550B,3634333340B,
- +7751515046B,3327252452B,4060504236B,3331262424B,3540353534B,
- +4745424036B,4750515150B,0000007744B,3333343652B,5144403534B,
- +5140363340B,0000776055B,3634333351B,5150474441B,4043465051B,
- +2527313335B,7727252424B,3333343550B,4041403634B,5046444241B,
- +7746505151B,2726252447B,3140313130B,4543403533B,5755535147B,
- +0077566060B,3333353752B,4051423634B,3333343642B,7760454035B,
- +3333353752B,5046433634B,4345505151B,2425303340B,3633302624B,
- +0000774240B,5046423345B,7745475151B,3440513351B,4140343333B,
- +4342414041B,7750515150B,2625242450B,7751334051B,3740603353B,
- +5051514744B,4233404246B,4751515046B,0000007745B,4641333351B,
- +4036334051B,7751504643B,2726252450B,3140313130B,4137353332B,
- +4342404242B,5452504644B,7760605755B,4136343351B,5151504744B/
- DATA IY17/
- +3540434650B,0077333334B,3340513353B,3640514641B,0077333334B,
- +5047444151B,4346505151B,3333343540B,7760413634B,3634333353B,
- +5150474441B,4043465051B,0077333435B,3640513352B,0077333334B,
- +3333353752B,5147443634B,3642465051B,0000007733B,4237353453B,
- +5151504745B,3540434650B,4641353333B,0000007760B,5635333351B,
- +3533406060B,7760565340B,3740602453B,3634333335B,5151504643B,
- +3336434650B,0000000077B,4237343353B,5051515045B,5045414045B,
- +4245505151B,0077333437B,4040463350B,7746464040B,0077453242B,
- +3044443047B,5034345040B,0000000077B,2640522650B,3332324052B,
- +3231313233B,4042413634B,4442403534B,4445464645B,7744444343B,
- +3340403343B,4444434040B,0000774343B,3240453246B,4036364045B,
- +0000774141B,7746403250B,3433333445B,3740403736B,4444434036B,
- +0000774343B,2730302751B,3532302626B,2740514743B,5046433531B,
- +5050515252B,0000007751B,3637373643B,4444434036B,0000774343B,
- +3637373643B,4344444036B,0077474543B,7746403250B,2640522645B,
- +4026264052B,0000775252B,2640522645B,4026264052B,0000775252B,
- +4041353150B,4646404242B,0000000077B,3230272645B,3227403634B,
- +3040373440B,4037363432B,5046444241B,4640444140B,4644424051B/
- DATA IY18/
- +0077525150B,3230272646B,3227403634B,3040373440B,4037363432B,
- +5046444241B,4640444140B,4644424051B,0077525150B,4045353551B,
- +4624404635B,0000000077B,2424252753B,4650402725B,3031364244B,
- +3631302727B,4050464442B,5150405050B,7750515252B,4140413350B,
- +4052414052B,3033405252B,2530402526B,2526303340B,3340253040B,
- +3240333131B,3133403332B,3232403331B,3534334033B,4035334040B,
- +4035343340B,7740353340B,3440312750B,4043414036B,5247405247B,
- +2540525240B,2725403027B,3027304030B,3435343140B,3435343140B,
- +3534353540B,4241364035B,4042414042B,4042424136B,4242404241B,
- +4340424241B,4750504746B,4340504745B,4750504746B,5040504745B,
- +7750504750B,4740524750B,4052524052B,4346505047B,3335404242B,
- +2526303332B,3233302625B,4242403533B,4750504643B,0000000077B,
- +4341404046B,4041434444B,3333343637B,4443413634B,0000007744B,
- +3540433545B,0000007743B,4143465053B,3534343536B,4342413736B,
- +3742434444B,0077303235B,4343424052B,3435364142B,4240373534B,
- +3641424343B,3735343435B,0000007740B,3734323147B,4747464441B,
- +3437414446B,0077313132B,3246463246B,0000007732B,3044443047B,
- +0000000077B,4052402646B,0000007726B,4135352750B,3541474347B/
- DATA IY19/
- +0000772735B,4240363551B,4240364043B,0077404040B,3640463345B,
- +4036353235B,0077353335B,4240363551B,4240364043B,0077404040B,
- +4240453245B,4042434643B,0077434543B,3333343443B,0000773735B,
- +4344444343B,0000007743B,4343444443B,0000774745B,0077453245B,
- +4136343244B,0000774543B,4136343243B,0000774543B,0077404046B,
- +4040443446B,0000007740B,4240363646B,0000007742B,3640433545B,
- +7742364042B/
- DATA ISTART/
- + 1, 5, 7, 11, 15, 17, 21, 26, 28, 35, 40, 42, 47, 51, 55,
- + 58, 60, 65, 67, 68, 71, 73, 75, 78, 80, 85, 88, 94, 98,103,
- +105,108,110,113,115,117,119,121,126,128,130,133,135,137,143,
- +144,146,148,151,153,155,160,162,165,168,170,174,179,181,185,
- +189,191,192,195,204,206,209,210,215,222,225,229,230,233,236,
- +239,248,257,260,267,273,278,288,296,298,304,311,319,325,329,
- +333,338,341,344,347,350,352,354,356,357,360,363,364,366,368,
- +370,373,374,376,380,382,385,388,390,394,397,401,405,409,413,
- +417,419,424,427,429,432,434,435,439,442,446,450,454,456,460,
- +462,465,467,470,472,475,477,482,489,493,498,502,507,511,517,
- +519,523,525,530,533,539,543,546,550,554,556,560,565,568,573,
- +578,580,581,584,591,594,597,598,602,608,611,614,615,618,621,
- +624,632,640,643,650,663,682,691,696,698,703,709,713,715,717,
- +719,722,725,728,731,734,736,738,740,741,743,745,746,748,750/
-*
- DATA NBIT,NBITCH,NBITMX/32,8,30/
-#endif
-#if defined(CERNLIB_UNIVAC)
- DATA IX11/
- +"3132343726,"4137343231,"4647474644,"0077374144,"4141363426,
- +"0000000077,"3433323226,"4645444236,"4731434546,"0000000077,
- +"4340463326,"4647474645,"3233364144,"0000007731,"7750314326,
- +"0000774343,"3332334526,"4746444136,"3641444647,"0077313233,
- +"4042454626,"3332323335,"4644414035,"4144464747,"7732333540,
- +"3177354726,"0000007747,"3232333626,"4644413533,"4245464747,
- +"3131323336,"4543373432,"3642454646,"0000000077,"4043454626,
- +"3131323437,"4340373432,"4345464645,"7732333640,"4077304027,
- +"7745337750,"3177313125,"4747464542,"3177424546,"4747464542,
- +"7731424546,"4345475026,"3132333537,"3735333231,"7750474543,
- +"3177313125,"4746454340,"4043454647,"0000007731,"3277323226,
- +"7742327747,"0000774732,"3277323226,"7742327747,"4345475026,
- +"3132333537,"3735333231,"5050474543,"0077504377,"4777313125,
- +"7747317747,"0077404034,"4243444430,"3233343640,"0000007732,
- +"4777313125,"7747367731,"3277323226,"0000007746,"3077303024,
- +"7740507740,"0000775050,"3177313125,"7747477747,"3132343625,
- +"3432313030,"4746444236,"4446475050,"0000773642,"3177313125,
- +"4747464542,"7731424546,"3132343625,"3432313030,"4746444236/
- DATA IX12/
- +"4446475050,"4741773642,"0000000077,"3177313125,"4747464542,
- +"7731424546,"0000774740,"3642454726,"3332313133,"4746454335,
- +"3336424547,"0000007731,"3177404030,"0000007747,"3432313125,
- +"4746444137,"0000007747,"5077403027,"0000007740,"4077332624,
- +"7745407733,"0000774552,"4777473126,"0000007731,"7740403027,
- +"0000774050,"3177314726,"7747317747,"4077304027,"7745337750,
- +"3177313125,"4747464542,"3177424546,"4747464542,"7731424546,
- +"3277323226,"0000007746,"4077304027,"7750307750,"3277323226,
- +"7742327747,"0000774732,"3177314726,"7747317747,"4777313125,
- +"7747317747,"3132343625,"3432313030,"4746444236,"4446475050,
- +"4335773642,"0000000077,"0077404034,"4777313125,"7747367731,
- +"4077304027,"0000007750,"3077303024,"7740507740,"0000775050,
- +"3177313125,"7747477747,"3577473127,"7747317743,"3132343625,
- +"3432313030,"4746444236,"4446475050,"0000773642,"4777313125,
- +"7747317747,"3177313125,"4747464542,"7731424546,"7731403127,
- +"4731774731,"0000000077,"3177404030,"0000007747,"3332313127,
- +"4040373635,"4546474777,"7740414243,"3677404026,"3231313233,
- +"4645423633,"4245464747,"0000007736,"3177473126,"0000007747/
- DATA IX13/
- +"2777404025,"3433323130,"4645444137,"0077515047,"3132353126,
- +"4137343231,"4647474644,"0000774743,"3077404024,"7750307750,
- +"0077404034,"3232363632,"4642423636,"7736424246,"4277363626,
- +"4645467742,"3642454747,"3332313133,"7747454335,"4543353331,
- +"4245474746,"3231313336,"0000773233,"4077404033,"7740414037,
- +"4777324126,"7750327740,"0000774731,"7730503024,"3433323227,
- +"4645444236,"4040444546,"4140374077,"0000007740,"5251505124,
- +"4345475152,"3536404142,"4243447734,"3335363740,"2726262731,
- +"0000772730,"4140374033,"4037407740,"0000774041,"4140374033,
- +"3740417740,"3740414140,"0000000077,"7750305024,"3677353531,
- +"7744357736,"0000774435,"4377424231,"7743347743,"0000774334,
- +"7733453330,"4533774533,"0000000077,"3637404231,"4141403736,
- +"3737407737,"4142424140,"4142424135,"7740373740,"3740414137,
- +"4240373636,"0000000077,"4241403631,"3737404142,"4141407741,
- +"3736363740,"3736363743,"7740414140,"4140373741,"3640414242,
- +"0000000077,"7740272217,"4060774026,"0000000077,"3031344024,
- +"3735333130,"4744407740,"4345475050,"3740774041,"4241407736,
- +"0077423677,"3436374024,"3130303133,"4077403432,"4745444241/
- DATA IX14/
- +"4446475050,"0000007740,"2732364024,"5146424077,"4036322777,
- +"4042465177,"0000000077,"4644424024,"4650515150,"4341774144,
- +"3741434444,"3735343435,"3032343777,"3432302727,"3740774036,
- +"4241407736,"0077423677,"5051525223,"4042444647,"2627303236,
- +"4037302726,"3436404141,"4336343333,"5252514745,"0000000077,
- +"4777473125,"0000007731,"3577324630,"3233353636,"4441353332,
- +"4242437746,"4546464543,"0000007743,"4543424025,"5353525147,
- +"4345475152,"3133353642,"2625252627,"3635333127,"0000007740,
- +"3434353734,"4443413735,"7737414344,"3636773535,"4077373777,
- +"7741417740,"4343774242,"0000000077,"4444343434,"7735357734,
- +"3737773636,"4177404077,"7742427741,"0000774343,"4045334033,
- +"4077354077,"7737407743,"0000774140,"4033454033,"4077434077,
- +"7741407735,"0000773740,"3246344032,"4040774044,"4077324077,
- +"7744407734,"0000774640,"7746514623,"2777435043,"0000007750,
- +"7742403630,"4077454033,"0000007740,"7732273223,"3077353035,
- +"0000007751,"7742403630,"4077454033,"0000007740,"4140374033,
- +"0077374041,"4140374033,"0000007740,"4037404133,"7737404141,
- +"0077275125,"3640424431,"4240363535,"0000007744,"4240363431/
- DATA IX15/
- +"3640424343,"0000007734,"0077512723,"2777404023,"0000007751,
- +"2777512723,"0000007751,"3377404030,"7733457745,"3535364033,
- +"4343424036,"0000774042,"7740403633,"4341373533,"7743354243,
- +"4341373533,"4140774143,"3537414343,"0000000077,"4177414133,
- +"0000774434,"4037353633,"3740424342,"7742367735,"3536404233,
- +"4342403635,"7735364042,"3577374333,"0000007743,"3735353733,
- +"3741434341,"3735353777,"7741434341,"3640424333,"4342403635,
- +"7736404243,"4677464627,"3335374244,"3735333232,"0077464442,
- +"3277323226,"4543413634,"4143454646,"0077323436,"3742444627,
- +"3332323335,"4644423735,"0000000077,"4677464627,"3335374244,
- +"3735333232,"0077464442,"4546463227,"3335374244,"3735333232,
- +"0077464442,"4041434533,"7744357740,"4445464627,"4677353742,
- +"3335374244,"3735333232,"0077464442,"3377333327,"4645434036,
- +"0000007746,"4041403734,"7740407737,"4142414033,"4041417740,
- +"0000773436,"4577333327,"7746377733,"0077404034,"2577252521,
- +"4037353230,"4543407740,"7753535250,"3377333327,"4645434036,
- +"0000007746,"3233353727,"4237353332,"4647474644,"0077374244,
- +"3277323226,"4543413634,"4143454646,"0077323436,"4677464627/
- DATA IX16/
- +"3335374244,"3735333232,"0077464442,"3577353531,"7745424036,
- +"3742454630,"4336343334,"4245464645,"0077333437,"4341404033,
- +"7744357745,"3634333327,"4677464341,"0000007746,"4677403230,
- +"0000007740,"4077343025,"7744407734,"0000774450,"4677463330,
- +"0000007733,"4677403230,"3132343640,"0000000077,"3377334630,
- +"7746337746,"3233353726,"3634323131,"5047454340,"4342413777,
- +"7750474645,"3537414327,"7731323334,"4647474543,"4077404345,
- +"4445454442,"3435374143,"0000007733,"3534323027,"4041414037,
- +"4046475077,"0000773536,"3335374227,"3634333232,"4545444240,
- +"3737404244,"7746444240,"3742444530,"7741363535,"3433333541,
- +"7745434136,"3737404230,"4677464340,"3333343742,"4242413634,
- +"0077363741,"3432302726,"7732343535,"4442403634,"7742454646,
- +"3331272625,"3433333434,"4443413735,"4345464645,"4341404041,
- +"0000775045,"3535364032,"7743424036,"4777313527,"3537434546,
- +"3736347734,"7744434241,"3635333130,"7732407746,"3477273526,
- +"4137353333,"4547774543,"5147454444,"0000007752,"3334353227,
- +"4546477732,"7732354043,"3737404230,"4377464340,"3735353640,
- +"3642774442,"4135333334,"7736404242,"3334364030,"4137353433/
- DATA IX17/
- +"4546464543,"0077404244,"4377323625,"2777464544,"0077513431,
- +"3534333327,"4645434137,"4042444546,"7727333436,"3335375127,
- +"3634333232,"4545444240,"0077414344,"3077364126,"0077503532,
- +"3432302726,"3533333535,"4746444237,"0000007747,"3031333525,
- +"3734323130,"5050474542,"3640424446,"0000007733,"4335333127,
- +"4750774745,"7730313345,"2577344424,"3333323026,"3735333232,
- +"5150464442,"0000000077,"2730323424,"3533313027,"4037407737,
- +"5047454341,"0077464750,"3377404030,"7745337745,"0077404036,
- +"4047314031,"4031474077,"0000000077,"4277373731,"4444457742,
- +"3436434545,"7745443534,"4545443534,"3435374244,"7734353534,
- +"4177404036,"4140407741,"0000774041,"4377364033,"7744357741,
- +"0000774435,"7733453330,"4341403634,"4141404043,"4140407743,
- +"0000774041,"4747464627,"4041424446,"4377353637,"3637404142,
- +"3231313234,"0000007732,"4141404036,"4140407740,"0000774041,
- +"4141404036,"4040417740,"0077404141,"7745334530,"3777363633,
- +"7743367737,"0000774336,"4277414133,"7742357742,"0000774235,
- +"7745334530,"4533774533,"0000000077,"3636374132,"3637774140,
- +"3677404177,"3640414137,"3637414140,"3677414077,"3640417737/
- DATA IX18/
- +"0077413736,"4242413733,"4241773740,"4277403777,"4240373741,
- +"4241373740,"4277374077,"4240377741,"0077374142,"7740322725,
- +"4051774031,"0000000077,"4137363625,"2625774242,"3332323130,
- +"4646454335,"7753525047,"3637775325,"7741424137,"4077404030,
- +"7741407737,"3740774137,"3437773436,"4442414077,"4077444177,
- +"3677303234,"4440773032,"4642775046,"3536407750,"3536407735,
- +"4343424077,"7743424077,"4077404030,"7740407740,"4140773740,
- +"4077413777,"4140773637,"4240367742,"3334364077,"4544424077,
- +"4240363477,"3436407744,"7732313132,"4746444240,"3634774647,
- +"4077444240,"3132333536,"4077323030,"4746454342,"3377465050,
- +"7745434035,"4077374030,"7741377741,"5050464340,"4750474547,
- +"4143444345,"3335343537,"3133313031,"4035323030,"0000000077,
- +"4142434432,"3534343540,"3640414140,"4341373535,"0000007744,
- +"4377433533,"0000007735,"5152535327,"3235414446,"3230272730,
- +"5146444135,"0077535352,"4445475026,"3436374142,"3130303133,
- +"4137363433,"5047454442,"0000007750,"3132343731,"4137343231,
- +"4647474644,"0077374144,"4646323232,"0000007732,"4047314031,
- +"0000000077,"4640324032,"0000007740,"3530364030,"5043454033/
- DATA IX19/
- +"0000774042,"4346434227,"4345437742,"0077453277,"3577404033,
- +"7743424036,"0077424036,"3532353627,"3533357736,"0077463377,
- +"3577404033,"7743424036,"0077424036,"4140404136,"0000774041,
- +"4141404036,"0000007740,"4140404136,"0000774041,"0077344433,
- +"3737404235,"0000774240,"4141403634,"0000773640,"0077443432,
- +"3477404032,"0000007744,"3477443432,"0000007744,"3577404033,
- +"7735437743/
- DATA IY11/
- +"3530252452,"5151504540,"3035404550,"0077242425,"5124273052,
- +"0000000077,"2526303152,"3026252424,"5151373432,"0000000077,
- +"3434242452,"4643413635,"4750515150,"0000007745,"4042422452,
- +"0000775124,"3435242452,"4136343333,"5151504643,"0077454750,
- +"2424252752,"4642353025,"4650515150,"3435374243,"7742373534,
- +"2440512452,"0000007724,"3127252452,"4036353433,"5150474542,
- +"4245475051,"3334353640,"2424252731,"0000000077,"4140363352,
- +"3233364041,"2524242527,"5045403327,"7746505151,"2440512451,
- +"7742424051,"2440512452,"3230262524,"3640363534,"4542403736,
- +"7751515047,"2425273153,"3431272524,"5150464441,"7744465051,
- +"2440512452,"3431272524,"5150464441,"0000007751,"2440512451,
- +"4036364024,"0000775151,"2440512450,"7736364024,"2425273153,
- +"3431272524,"5150464441,"4144465051,"0077414140,"2440512453,
- +"7736364051,"0077512444,"5047442450,"4447505151,"0000007742,
- +"2440512452,"7751354042,"5140512447,"0000007751,"2440512454,
- +"4051244051,"0000775124,"2440512453,"7751244051,"3127252453,
- +"5046444134,"4446505151,"2527313441,"0000772424,"2440512452,
- +"3330262524,"7737373635,"3127252453,"5046444134,"4446505151/
- DATA IY12/
- +"2527313441,"5345402424,"0000000077,"2440512452,"3230262524,
- +"4036363534,"0000775136,"2424252752,"3433312725,"4341403735,
- +"5051515046,"0000007746,"2440512450,"0000007724,"5046432453,
- +"4346505151,"0000007724,"2440512451,"0000007751,"2440512454,
- +"4051244051,"0000775124,"2440512452,"0000007751,"4051362451,
- +"0000773624,"2440512452,"7751514024,"2440512451,"7742424051,
- +"2440512452,"3230262524,"3640363534,"4542403736,"7751515047,
- +"2440512447,"0000007724,"2440512451,"7751514051,"2440512451,
- +"4036364024,"0000775151,"2440512452,"7751514024,"2440512453,
- +"7736364051,"3127252453,"5046444134,"4446505151,"2527313441,
- +"3636402424,"0000000077,"0077512444,"2440512452,"7751354042,
- +"2440512451,"0000007751,"2440512454,"4051244051,"0000775124,
- +"2440512453,"7751244051,"3640242451,"7751514036,"3127252453,
- +"5046444134,"4446505151,"2527313441,"0000772424,"2440512453,
- +"7724244051,"2440512452,"3330262524,"7737373635,"4051362451,
- +"5151402424,"0000000077,"2440512450,"0000007724,"2425273151,
- +"5133272524,"2425273140,"7733272524,"3140512452,"4240353332,
- +"4243444443,"3132333540,"0000007731,"5140512452,"0000007724/
- DATA IY13/
- +"3240512453,"4241373332,"3741424343,"0077323233,"3642515152,
- +"2424252732,"4236322725,"0000775151,"4040513054,"7751514040,
- +"0077602044,"4236363246,"4242464642,"7732323636,"2040552052,
- +"3130274055,"2424252730,"3433312725,"4042403735,"3736343331,
- +"5150464240,"4445465051,"0000774645,"4740422445,"7747505150,
- +"2040602053,"4035354060,"0000774343,"7751402754,"2526303151,
- +"3026252424,"4237353432,"5051504740,"0000007747,"2223222154,
- +"2321202021,"5450343025,"3024224056,"5755535044,"5556576060,
- +"0000775756,"3435343345,"5150474033,"0000774750,"3435343345,
- +"5051504033,"5554525047,"0000000077,"7751402754,"2040602047,
- +"4020204060,"0000776060,"2040602047,"4020204060,"0000776060,
- +"4041353150,"4646404242,"0000000077,"2422212047,"3533313026,
- +"2523214037,"3634323027,"5046444240,"4057555351,"5047454341,
- +"6057565452,"0000000077,"2422212047,"3533313026,"2523214037,
- +"3634323027,"5046444240,"4057555351,"5047454341,"6057565452,
- +"0000000077,"4047333360,"5110405134,"0000000077,"4136322654,
- +"4546464543,"3632264043,"4646454341,"4743404345,"5247434052,
- +"0077525240,"2627313454,"4035312726,"3440524542,"2726262731/
- DATA IY14/
- +"4542403531,"0000007752,"4035302554,"4035302540,"5350434040,
- +"5350434040,"0000000077,"4646454254,"3637414345,"3537403736,
- +"2626273133,"3735333127,"3736363740,"4646454341,"4742404245,
- +"5247424052,"0077525240,"3333343555,"5046433634,"4547505151,
- +"3334404143,"2524252731,"4637343127,"4750515150,"0000000077,
- +"3140473153,"0000007747,"3140463150,"3435353432,"3232313132,
- +"4543424031,"4243454646,"0000007742,"4544434053,"3741434445,
- +"3433333435,"4545444335,"3537414344,"3534333334,"0000007740,
- +"4137353444,"4143444443,"4034343537,"4236404137,"3540433540,
- +"4043354043,"4137404236,"0000000077,"3444443444,"4043354034,
- +"4335404335,"3540433540,"4043354043,"0000774335,"3243433245,
- +"3540423540,"4042404042,"0000774240,"4635354645,"4340364340,
- +"4036404036,"0000773640,"3636453246,"3240403245,"4040364040,
- +"4045404045,"0000773640,"4042403655,"4040454033,"0000007740,
- +"4032273250,"3040353035,"0000007751,"4042403655,"4040454033,
- +"0000007740,"4046514650,"2740435043,"0000007750,"2524252645,
- +"0077323127,"5051504745,"0000007747,"4750515045,"7755545250,
- +"0077602053,"3125222047,"5653474236,"0000007760,"3125222047/
- DATA IY15/
- +"5653474236,"0000007760,"0077404055,"4040512755,"0000007740,
- +"4340353555,"0000007743,"3540463250,"7743354043,"4136343345,
- +"3641434443,"0000773334,"7744333545,"3433333445,"7744444036,
- +"3433333445,"3737403736,"4344444340,"0000000077,"3340443345,
- +"0000774141,"3636373345,"4444434137,"7733334043,"3634333345,
- +"4143444341,"7741373637,"3340443345,"0000007733,"3736343345,
- +"3333343637,"4443403740,"7737404344,"4041403645,"3634333436,
- +"7744444341,"3640513352,"3634333334,"5150464341,"0077465051,
- +"3640512451,"3634333334,"5150464341,"0077465051,"3333343651,
- +"4643413634,"4650515150,"0000000077,"3640512452,"3634333334,
- +"5150464341,"0077465051,"3537414151,"3634333334,"5150464341,
- +"0077465051,"3025242447,"7733334051,"5756533352,"3640576060,
- +"3634333334,"5150464341,"0077465051,"3740512452,"3734333334,
- +"0000007751,"2324252444,"7751334024,"2324252445,"5754334024,
- +"0000776060,"3340512450,"7751414045,"0077512444,"3740513357,
- +"3734333334,"3334374051,"7751373433,"3740513352,"3734333334,
- +"0000007751,"4136343352,"5151504643,"3641434650,"0077333334,
- +"3640603351,"3634333334,"5150464341,"0077465051,"3640603352/
- DATA IY16/
- +"3634333334,"5150464341,"0077465051,"4140513346,"7733333436,
- +"3333343651,"4241403634,"5150464543,"0077465051,"5150452447,
- +"7733334051,"5150453352,"3340455051,"0000007751,"3340513350,
- +"0000007751,"3340513353,"4051334051,"0000775133,"3340513351,
- +"0000007751,"3340513350,"6060575551,"0000000077,"3340513351,
- +"7751514033,"4036343353,"5151504643,"3336424550,"3634333340,
- +"7751515046,"3327252452,"4060504236,"3331262424,"3540353534,
- +"4745424036,"4750515150,"0000007744,"3333343652,"5144403534,
- +"5140363340,"0000776055,"3634333351,"5150474441,"4043465051,
- +"2527313335,"7727252424,"3333343550,"4041403634,"5046444241,
- +"7746505151,"2726252447,"3140313130,"4543403533,"5755535147,
- +"0077566060,"3333353752,"4051423634,"3333343642,"7760454035,
- +"3333353752,"5046433634,"4345505151,"2425303340,"3633302624,
- +"0000774240,"5046423345,"7745475151,"3440513351,"4140343333,
- +"4342414041,"7750515150,"2625242450,"7751334051,"3740603353,
- +"5051514744,"4233404246,"4751515046,"0000007745,"4641333351,
- +"4036334051,"7751504643,"2726252450,"3140313130,"4137353332,
- +"4342404242,"5452504644,"7760605755,"4136343351,"5151504744/
- DATA IY17/
- +"3540434650,"0077333334,"3340513353,"3640514641,"0077333334,
- +"5047444151,"4346505151,"3333343540,"7760413634,"3634333353,
- +"5150474441,"4043465051,"0077333435,"3640513352,"0077333334,
- +"3333353752,"5147443634,"3642465051,"0000007733,"4237353453,
- +"5151504745,"3540434650,"4641353333,"0000007760,"5635333351,
- +"3533406060,"7760565340,"3740602453,"3634333335,"5151504643,
- +"3336434650,"0000000077,"4237343353,"5051515045,"5045414045,
- +"4245505151,"0077333437,"4040463350,"7746464040,"0077453242,
- +"3044443047,"5034345040,"0000000077,"2640522650,"3332324052,
- +"3231313233,"4042413634,"4442403534,"4445464645,"7744444343,
- +"3340403343,"4444434040,"0000774343,"3240453246,"4036364045,
- +"0000774141,"7746403250,"3433333445,"3740403736,"4444434036,
- +"0000774343,"2730302751,"3532302626,"2740514743,"5046433531,
- +"5050515252,"0000007751,"3637373643,"4444434036,"0000774343,
- +"3637373643,"4344444036,"0077474543,"7746403250,"2640522645,
- +"4026264052,"0000775252,"2640522645,"4026264052,"0000775252,
- +"4041353150,"4646404242,"0000000077,"3230272645,"3227403634,
- +"3040373440,"4037363432,"5046444241,"4640444140,"4644424051/
- DATA IY18/
- +"0077525150,"3230272646,"3227403634,"3040373440,"4037363432,
- +"5046444241,"4640444140,"4644424051,"0077525150,"4045353551,
- +"4624404635,"0000000077,"2424252753,"4650402725,"3031364244,
- +"3631302727,"4050464442,"5150405050,"7750515252,"4140413350,
- +"4052414052,"3033405252,"2530402526,"2526303340,"3340253040,
- +"3240333131,"3133403332,"3232403331,"3534334033,"4035334040,
- +"4035343340,"7740353340,"3440312750,"4043414036,"5247405247,
- +"2540525240,"2725403027,"3027304030,"3435343140,"3435343140,
- +"3534353540,"4241364035,"4042414042,"4042424136,"4242404241,
- +"4340424241,"4750504746,"4340504745,"4750504746,"5040504745,
- +"7750504750,"4740524750,"4052524052,"4346505047,"3335404242,
- +"2526303332,"3233302625,"4242403533,"4750504643,"0000000077,
- +"4341404046,"4041434444,"3333343637,"4443413634,"0000007744,
- +"3540433545,"0000007743,"4143465053,"3534343536,"4342413736,
- +"3742434444,"0077303235,"4343424052,"3435364142,"4240373534,
- +"3641424343,"3735343435,"0000007740,"3734323147,"4747464441,
- +"3437414446,"0077313132,"3246463246,"0000007732,"3044443047,
- +"0000000077,"4052402646,"0000007726,"4135352750,"3541474347/
- DATA IY19/
- +"0000772735,"4240363551,"4240364043,"0077404040,"3640463345,
- +"4036353235,"0077353335,"4240363551,"4240364043,"0077404040,
- +"4240453245,"4042434643,"0077434543,"3333343443,"0000773735,
- +"4344444343,"0000007743,"4343444443,"0000774745,"0077453245,
- +"4136343244,"0000774543,"4136343243,"0000774543,"0077404046,
- +"4040443446,"0000007740,"4240363646,"0000007742,"3640433545,
- +"7742364042/
- DATA ISTART/
- + 1, 5, 7, 11, 15, 17, 21, 26, 28, 35, 40, 42, 47, 51, 55,
- + 58, 60, 65, 67, 68, 71, 73, 75, 78, 80, 85, 88, 94, 98,103,
- +105,108,110,113,115,117,119,121,126,128,130,133,135,137,143,
- +144,146,148,151,153,155,160,162,165,168,170,174,179,181,185,
- +189,191,192,195,204,206,209,210,215,222,225,229,230,233,236,
- +239,248,257,260,267,273,278,288,296,298,304,311,319,325,329,
- +333,338,341,344,347,350,352,354,356,357,360,363,364,366,368,
- +370,373,374,376,380,382,385,388,390,394,397,401,405,409,413,
- +417,419,424,427,429,432,434,435,439,442,446,450,454,456,460,
- +462,465,467,470,472,475,477,482,489,493,498,502,507,511,517,
- +519,523,525,530,533,539,543,546,550,554,556,560,565,568,573,
- +578,580,581,584,591,594,597,598,602,608,611,614,615,618,621,
- +624,632,640,643,650,663,682,691,696,698,703,709,713,715,717,
- +719,722,725,728,731,734,736,738,740,741,743,745,746,748,750/
-*
- DATA NBIT,NBITCH,NBITMX/36,6,30/
-#endif
-#if defined(CERNLIB_SUN)||defined(CERNLIB_SGI)||defined(CERNLIB_IBMRT)||defined(CERNLIB_DECS)||defined(CERNLIB_MSDOS)||defined(CERNLIB_LINUX)||defined(CERNLIB_CVY)||defined(CERNLIB_WINNT)
- SAVE IA
-# if defined(CERNLIB_F90) || defined(CERNLIB_QFEPC) || defined(CERNLIB_QFMSOFT)
- DATA (IX11(I),I=1,50)/
- +Z'1969C7D6',Z'217DC699',Z'269E79A4',Z'00FDF864',Z'2185E716',
- +Z'0000003F',Z'1C6DA696',Z'2696489E',Z'27663966',Z'0000003F',
- +Z'238266D6',Z'269E79A5',Z'1A6DE864',Z'00000FD9',Z'3FA198D6',
- +Z'0003F8E3',Z'1B69B956',Z'279A485E',Z'1E8649A7',Z'00FD969B',
- +Z'208A5996',Z'1B69A6DD',Z'2692181D',Z'219269E7',Z'3F69B760',
- +Z'19FDD9D6',Z'00000FE7',Z'1A69B796',Z'2692175B',Z'229669E7',
- +Z'1965A6DE',Z'258DF71A',Z'1E8A59A6',Z'0000003F',Z'208E5996',
- +Z'1965A71F',Z'2381F71A',Z'239669A5',Z'3F69B7A0',Z'20FD8817',
- +Z'3F95BFE8',Z'19FD9655',Z'279E6962',Z'19FE2966',Z'279E6962',
- +Z'3F662966',Z'23967A16',Z'1969B75F',Z'1F75B699',Z'3FA27963'/
- DATA (IX11(I), I=51,108)/
- +Z'19FD9655',Z'279A58E0',Z'208E59A7',Z'00000FD9',Z'1AFDA696',
- +Z'3F89AFE7',Z'0003F9DA',Z'1AFDA696',Z'3F89AFE7',Z'23967A16',
- +Z'1969B75F',Z'1F75B699',Z'28A27963',Z'00FE88FF',Z'27FD9655',
- +Z'3F9D9FE7',Z'00FE081C',Z'228E4918',Z'1A6DC7A0',Z'00000FDA',
- +Z'27FD9655',Z'3F9DEFD9',Z'1AFDA696',Z'00000FE6',Z'18FD8614',
- +Z'3F828FE0',Z'0003FA28',Z'19FD9655',Z'3F9E7FE7',Z'1969C795',
- +Z'1C699618',Z'279A489E',Z'249A7A28',Z'0003F7A2',Z'19FD9655',
- +Z'279E6962',Z'3F662966',Z'1969C795',Z'1C699618',Z'279A489E',
- +Z'249A7A28',Z'2787F7A2',Z'0000003F',Z'19FD9655',Z'279E6962',
- +Z'3F662966',Z'0003F9E0',Z'1E8A59D6',Z'1B69965B',Z'279A58DD',
- +Z'1B7A2967',Z'00000FD9',Z'19FE0818',Z'00000FE7',Z'1C699655',
- +Z'279A485F',Z'00000FE7',Z'28FE0617'/
- DATA (IX12(I),I=1,50)/
- +Z'00000FE0',Z'20FDB594',Z'3F960FDB',Z'0003F96A',Z'27FE7656',
- +Z'00000FD9',Z'3F820617',Z'0003F828',Z'19FD99D6',Z'3F9D9FE7',
- +Z'20FD8817',Z'3F95BFE8',Z'19FD9655',Z'279E6962',Z'19FE2966',
- +Z'279E6962',Z'3F662966',Z'1AFDA696',Z'00000FE6',Z'20FD8817',
- +Z'3FA18FE8',Z'1AFDA696',Z'3F89AFE7',Z'0003F9DA',Z'19FD99D6',
- +Z'3F9D9FE7',Z'27FD9655',Z'3F9D9FE7',Z'1969C795',Z'1C699618',
- +Z'279A489E',Z'249A7A28',Z'2377F7A2',Z'0000003F',Z'00FE081C',
- +Z'27FD9655',Z'3F9DEFD9',Z'20FD8817',Z'00000FE8',Z'18FD8614',
- +Z'3F828FE0',Z'0003FA28',Z'19FD9655',Z'3F9E7FE7',Z'1DFE7657',
- +Z'3F9D9FE3',Z'1969C795',Z'1C699618',Z'279A489E',Z'249A7A28'/
- DATA (IX12(I), I=51,108)/
- +Z'0003F7A2',Z'27FD9655',Z'3F9D9FE7',Z'19FD9655',Z'279E6962',
- +Z'3F662966',Z'3F660657',Z'2767F9D9',Z'0000003F',Z'19FE0818',
- +Z'00000FE7',Z'1B699657',Z'2081F79D',Z'259A79FF',Z'3F8218A3',
- +Z'1EFE0816',Z'1A65969B',Z'2696279B',Z'229669E7',Z'00000FDE',
- +Z'19FE7656',Z'00000FE7',Z'17FE0815',Z'1C6DA658',Z'2696485F',
- +Z'00FE9A27',Z'1969D656',Z'217DC699',Z'269E79A4',Z'0003F9E3',
- +Z'18FE0814',Z'3FA18FE8',Z'00FE081C',Z'1A69E79A',Z'268A279E',
- +Z'3F7A28A6',Z'22FDE796',Z'26966FE2',Z'1E8A59E7',Z'1B69965B',
- +Z'3F9E58DD',Z'258DD6D9',Z'229679E6',Z'1A6596DE',Z'0003F69B',
- +Z'20FE081B',Z'3F82181F',Z'27FDA856',Z'3FA1AFE0',Z'0003F9D9',
- +Z'3F628614',Z'1C6DA697',Z'2696489E',Z'20824966',Z'2181F83F',
- +Z'00000FE0',Z'2AA68A54',Z'23967A6A'/
- DATA (IX13(I),I=1,50)/
- +Z'1D7A0862',Z'228E4FDC',Z'1B75E7E0',Z'175965D9',Z'0003F5D8',
- +Z'2181F81B',Z'207E0FE0',Z'0003F821',Z'2181F81B',Z'1F821FE0',
- +Z'1F821860',Z'0000003F',Z'3FA18A14',Z'1EFDD759',Z'3F91DFDE',
- +Z'0003F91D',Z'23FE2899',Z'3F8DCFE3',Z'0003F8DC',Z'3F6E56D8',
- +Z'256FF95B',Z'0000003F',Z'1E7E0899',Z'218607DE',Z'1F7E0FDF',
- +Z'218A2860',Z'218A285D',Z'3F81F7E0',Z'1F82185F',Z'2281F79E',
- +Z'0000003F',Z'22860799',Z'1F7E0862',Z'21860FE1',Z'1F79E7E0',
- +Z'1F79E7E3',Z'3F821860',Z'2181F7E1',Z'1E8218A2',Z'0000003F',
- +Z'3F81748F',Z'20C3F816',Z'0000003F',Z'1865C814',Z'1F75B658',
- +Z'27920FE0',Z'23967A28',Z'1F83F821',Z'22860FDE',Z'00FE27BF'/
- DATA (IX13(I), I=51,108)/
- +Z'1C79F814',Z'1961865B',Z'20FE071A',Z'279648A1',Z'249A7A28',
- +Z'00000FE0',Z'1769E814',Z'299A283F',Z'2079A5FF',Z'208A6A7F',
- +Z'0000003F',Z'26922814',Z'26A29A68',Z'2387F864',Z'1F863924',
- +Z'1F75C71D',Z'1869C7FF',Z'1C6985D7',Z'1F83F81E',Z'22860FDE',
- +Z'00FE27BF',Z'28A6AA93',Z'208A49A7',Z'165D869E',Z'207D85D6',
- +Z'1C7A0861',Z'2379C6DB',Z'2AAA99E5',Z'0000003F',Z'27FE7655',
- +Z'00000FD9',Z'1DFDA998',Z'1A6DD79E',Z'2485D6DA',Z'228A3FE6',
- +Z'259A6963',Z'00000FE3',Z'258E2815',Z'2BAEAA67',Z'23967A6A',
- +Z'196DD7A2',Z'16555597',Z'1E75B657',Z'00000FE0',Z'1C71D7DC',
- +Z'248E17DD',Z'3F7E18E4',Z'1E7BF75D',Z'20FDF7FF',Z'3F861FE0',
- +Z'238FF8A2',Z'0000003F',Z'2491C71C',Z'3F75DFDC',Z'1F7FF79E',
- +Z'21FE083F',Z'3F8A2FE1',Z'0003F8E3'/
- DATA (IX14(I),I=1,50)/
- +Z'2095B81B',Z'20FDD83F',Z'3F7E0FE3',Z'0003F860',Z'206E581B',
- +Z'20FE383F',Z'3F860FDD',Z'0003F7E0',Z'1A99C81A',Z'2083F824',
- +Z'20FDA83F',Z'3F920FDC',Z'0003F9A0',Z'3F9A9993',Z'17FE3A23',
- +Z'00000FE8',Z'3F8A0798',Z'20FE581B',Z'00000FE0',Z'3F697693',
- +Z'18FDD61D',Z'00000FE9',Z'3F8A0798',Z'20FE581B',Z'00000FE0',
- +Z'2181F81B',Z'00FDF821',Z'2181F81B',Z'00000FE0',Z'207E085B',
- +Z'3F7E0861',Z'00FD7A55',Z'1E822919',Z'2281E75D',Z'00000FE4',
- +Z'2281E719',Z'1E8228E3',Z'00000FDC',Z'00FE95D3',Z'17FE0813',
- +Z'00000FE9',Z'17FE95D3',Z'00000FE9',Z'1BFE0818',Z'3F6E5FE5',
- +Z'1D75E81B',Z'238E281E',Z'0003F822',Z'3F82079B',Z'2385F75B'/
- DATA (IX14(I), I=51,108)/
- +Z'3F8DD8A3',Z'2385F75B',Z'2183F863',Z'1D7E18E3',Z'0000003F',
- +Z'21FE185B',Z'0003F91C',Z'207DD79B',Z'1F8228E2',Z'3F89EFDD',
- +Z'1D7A089B',Z'238A079D',Z'3F75E822',Z'1DFDF8DB',Z'00000FE3',
- +Z'1F75D7DB',Z'1F8638E1',Z'1F75D7FF',Z'3F8638E1',Z'1E8228DB',
- +Z'238A079D',Z'3F7A08A3',Z'26FE6997',Z'1B75F8A4',Z'1F75B69A',
- +Z'00FE6922',Z'1AFDA696',Z'258E179C',Z'218E59A6',Z'00FDA71E',
- +Z'1F8A4997',Z'1B69A6DD',Z'269227DD',Z'0000003F',Z'26FE6997',
- +Z'1B75F8A4',Z'1F75B69A',Z'00FE6922',Z'259A6697',Z'1B75F8A4',
- +Z'1F75B69A',Z'00FE6922',Z'2086395B',Z'3F91DFE0',Z'24966997',
- +Z'26FDD7E2',Z'1B75F8A4',Z'1F75B69A',Z'00FE6922',Z'1BFDB6D7',
- +Z'2696381E',Z'00000FE6',Z'208607DC',Z'3F820FDF',Z'218A181B',
- +Z'20861FE0',Z'0003F71E',Z'25FDB6D7'/
- DATA (IX15(I),I=1,50)/
- +Z'3F99FFDB',Z'00FE081C',Z'15FD5551',Z'207DD698',Z'258E0FE0',
- +Z'3FAEBAA8',Z'1BFDB6D7',Z'2696381E',Z'00000FE6',Z'1A6DD7D7',
- +Z'227DD6DA',Z'269E79A4',Z'00FDF8A4',Z'1AFDA696',Z'258E179C',
- +Z'218E59A6',Z'00FDA71E',Z'26FE6997',Z'1B75F8A4',Z'1F75B69A',
- +Z'00FE6922',Z'1DFDD759',Z'3F96281E',Z'1F8A5998',Z'2379C6DC',
- +Z'229669A5',Z'00FDB71F',Z'2386081B',Z'3F91DFE5',Z'1E71B6D7',
- +Z'26FE68E1',Z'00000FE6',Z'26FE0698',Z'00000FE0',Z'20FDC615',
- +Z'3F920FDC',Z'0003F928',Z'26FE66D8',Z'00000FDB',Z'26FE0698',
- +Z'1969C7A0',Z'0000003F',Z'1BFDB998',Z'3F99BFE6',Z'1A6DD7D6',
- +Z'1E71A659',Z'289E58E0',Z'238A17FF',Z'3FA279A5',Z'1D7E18D7'/
- DATA (IX15(I), I=51,108)/
- +Z'3F65A6DC',Z'269E7963',Z'20FE08E5',Z'24965922',Z'1C75F863',
- +Z'00000FDB',Z'1D71A617',Z'2086181F',Z'209A7A3F',Z'0003F75E',
- +Z'1B75F897',Z'1E71B69A',Z'259648A0',Z'1F7E08A4',Z'3F9A48A0',
- +Z'1F8A4958',Z'3F85E75D',Z'1C6DB761',Z'3F96385E',Z'1F7E0898',
- +Z'26FE68E0',Z'1B6DC7E2',Z'228A179C',Z'00FDE7E1',Z'1C6985D6',
- +Z'3F69C75D',Z'248A079C',Z'3F8A59A6',Z'1B657595',Z'1C6DB71C',
- +Z'248E17DD',Z'239669A5',Z'23860821',Z'0003FA25',Z'1D75E81A',
- +Z'3F8E281E',Z'27FD9757',Z'1D7E3966',Z'1F79CFDC',Z'3F9238A1',
- +Z'1E75B658',Z'3F6A0FE6',Z'1CFD7756',Z'217DD6DB',Z'259FF963',
- +Z'299E5924',Z'00000FEA',Z'1B71D697',Z'259A7FDA',Z'3F69D823',
- +Z'1F7E0898',Z'23FE68E0',Z'1F75D7A0',Z'1E8BF922',Z'2175B6DC',
- +Z'3F7A08A2',Z'1B71E818',Z'217DD71B'/
- DATA (IX16(I),I=1,50)/
- +Z'259A6963',Z'00FE08A4',Z'23FDA795',Z'17FE6964',Z'00FE9719',
- +Z'1D71B6D7',Z'2696385F',Z'208A4966',Z'3F5DB71E',Z'1B75FA57',
- +Z'1E71B69A',Z'259648A0',Z'00FE18E4',Z'18FDE856',Z'00FE875A',
- +Z'1C6985D6',Z'1D6DB75D',Z'279A489F',Z'00000FE7',Z'1865B755',
- +Z'1F71A658',Z'28A27962',Z'1E822926',Z'00000FDB',Z'2375B657',
- +Z'27A3F9E5',Z'3F6196E5',Z'15FDC914',Z'1B6DA616',Z'1F75B69A',
- +Z'29A26922',Z'0000003F',Z'1761A714',Z'1D6D9617',Z'207E0FDF',
- +Z'289E58E1',Z'00FE69E8',Z'1BFE0818',Z'3F95BFE5',Z'00FE081E',
- +Z'209D9819',Z'2066783F',Z'0000003F',Z'22FDF7D9',Z'24925FE2',
- +Z'1C7A3965',Z'3F96475C',Z'2596475C',Z'1C75F8A4',Z'3F71D75C'/
- DATA (IX16(I), I=51,108)/
- +Z'21FE081E',Z'21820FE1',Z'0003F821',Z'23FDE81B',Z'3F91DFE1',
- +Z'0003F91D',Z'3F6E56D8',Z'2386079C',Z'21860823',Z'21820FE3',
- +Z'0003F821',Z'279E6997',Z'20862926',Z'23FDD79F',Z'1E7E0862',
- +Z'1A65969C',Z'00000FDA',Z'2186081E',Z'21820FE0',Z'0003F821',
- +Z'2186081E',Z'20821FE0',Z'00FE0861',Z'3F95B958',Z'1FFDE79B',
- +Z'3F8DEFDF',Z'0003F8DE',Z'22FE185B',Z'3F89DFE2',Z'0003F89D',
- +Z'3F95B958',Z'256FF95B',Z'0000003F',Z'1E79F85A',Z'1E7FF860',
- +Z'1EFE087F',Z'1E82185F',Z'1E7E1860',Z'1EFE183F',Z'1E821FDF',
- +Z'00FE17DE',Z'228A17DB',Z'2287F7E0',Z'22FE07FF',Z'2281F7E1',
- +Z'2285F7E0',Z'22FDF83F',Z'2281FFE1',Z'00FDF862',Z'3F81A5D5',
- +Z'20A7F819',Z'0000003F',Z'217DE795',Z'1657F8A2',Z'1B69A658',
- +Z'269A58DD',Z'3FAEAA27',Z'1E7FFAD5'/
- DATA (IX17(I),I=1,50)/
- +Z'3F86285F',Z'20FE0818',Z'3F860FDF',Z'1F83F85F',Z'1C7FF71E',
- +Z'248A183F',Z'20FE487F',Z'1EFD869C',Z'2483F61A',Z'268BFA26',
- +Z'1D7A0FE8',Z'1D7A0FDD',Z'238E283F',Z'3F8E283F',Z'20FE0818',
- +Z'3F820FE0',Z'2183F7E0',Z'20FE17FF',Z'2183F79F',Z'2281EFE2',
- +Z'1B71E83F',Z'2592283F',Z'2281E73F',Z'1C7A0FE4',Z'3F69965A',
- +Z'279A48A0',Z'1E73F9A7',Z'20FE48A0',Z'1969B75E',Z'20FDA618',
- +Z'279A58E2',Z'1BFE6A28',Z'3F96381D',Z'20FDF818',Z'3F85FFE1',
- +Z'28A268E0',Z'27A27967',Z'218E48E5',Z'1B75C75F',Z'196D9619',
- +Z'2075A618',Z'0000003F',Z'218A391A',Z'1D71C760',Z'1E821860',
- +Z'2385F75D',Z'00000FE4',Z'23FE375B',Z'00000FDD',Z'29AABAD7'/
- DATA (IX17(I), I=51,103)/
- +Z'1A761926',Z'1A6175D8',Z'299A485D',Z'00FEBAEA',Z'24967A16',
- +Z'1C79F862',Z'1961865B',Z'217DE71B',Z'289E5922',Z'00000FE8',
- +Z'1969C7D9',Z'217DC699',Z'269E79A4',Z'00FDF864',Z'2699A69A',
- +Z'00000FDA',Z'209D9819',Z'0000003F',Z'2681A81A',Z'00000FE0',
- +Z'1D61E818',Z'288E581B',Z'0003F822',Z'239A3897',Z'23963FE2',
- +Z'00FE56BF',Z'1DFE081B',Z'3F8E281E',Z'00FE281E',Z'1D69D797',
- +Z'1D6DDFDE',Z'00FE66FF',Z'1DFE081B',Z'3F8E281E',Z'00FE281E',
- +Z'2182085E',Z'0003F821',Z'2186081E',Z'00000FE0',Z'2182085E',
- +Z'0003F821',Z'00FDC91B',Z'1F7E089D',Z'0003F8A0',Z'2186079C',
- +Z'0003F7A0',Z'00FE471A',Z'1CFE081A',Z'00000FE4',Z'1CFE471A',
- +Z'00000FE4',Z'1DFE081B',Z'3F763FE3'/
- DATA (IY11(I),I=1,50)/
- +Z'1D61552A',Z'29A68960',Z'18760968',Z'00FD4515',Z'2951762A',
- +Z'0000003F',Z'1559866A',Z'18595514',Z'29A5F71A',Z'0000003F',
- +Z'1C71452A',Z'268E179D',Z'27A29A68',Z'00000FE5',Z'208A252A',
- +Z'0003FA54',Z'1C75452A',Z'2179C6DB',Z'29A689A3',Z'00FE59E8',
- +Z'145155EA',Z'2689D615',Z'26A29A68',Z'1C75F8A3',Z'3F89F75C',
- +Z'1482952A',Z'00000FD4',Z'195D552A',Z'2079D71B',Z'29A27962',
- +Z'22967A29',Z'1B71D7A0',Z'145155D9',Z'0000003F',Z'2181E6EA',
- +Z'1A6DE821',Z'15514557',Z'289606D7',Z'3F9A8A69',Z'14829529',
- +Z'3F8A2829',Z'1482952A',Z'1A616554',Z'1E81E75C',Z'258A07DE',
- +Z'3FA69A27',Z'1455766B',Z'1C657554',Z'29A26921',Z'3F926A29'/
- DATA (IY11(I), I=51,108)/
- +Z'1482952A',Z'1C657554',Z'29A26921',Z'00000FE9',Z'14829529',
- +Z'2079E814',Z'0003FA69',Z'14829528',Z'3F79E814',Z'1455766B',
- +Z'1C657554',Z'29A26921',Z'21926A29',Z'00FE1860',Z'1482952B',
- +Z'3F79E829',Z'00FE9524',Z'289E4528',Z'249E8A69',Z'00000FE2',
- +Z'1482952A',Z'3FA5D822',Z'29829527',Z'00000FE9',Z'1482952C',
- +Z'20A54829',Z'0003FA54',Z'1482952B',Z'3FA54829',Z'195D552B',
- +Z'289A485C',Z'249A8A69',Z'155D9721',Z'0003F514',Z'1482952A',
- +Z'1B616554',Z'3F7DF79D',Z'195D552B',Z'289A485C',Z'249A8A69',
- +Z'155D9721',Z'2B960514',Z'0000003F',Z'1482952A',Z'1A616554',
- +Z'2079E75C',Z'0003FA5E',Z'145155EA',Z'1C6D95D5',Z'238607DD',
- +Z'28A69A26',Z'00000FE6',Z'14829528',Z'00000FD4',Z'289A352B',
- +Z'239A8A69',Z'00000FD4',Z'14829529'/
- DATA (IY12(I),I=1,50)/
- +Z'00000FE9',Z'1482952C',Z'20A54829',Z'0003FA54',Z'1482952A',
- +Z'00000FE9',Z'20A5E529',Z'0003F794',Z'1482952A',Z'3FA69814',
- +Z'14829529',Z'3F8A2829',Z'1482952A',Z'1A616554',Z'1E81E75C',
- +Z'258A07DE',Z'3FA69A27',Z'14829527',Z'00000FD4',Z'14829529',
- +Z'3FA69829',Z'14829529',Z'2079E814',Z'0003FA69',Z'1482952A',
- +Z'3FA69814',Z'1482952B',Z'3F79E829',Z'195D552B',Z'289A485C',
- +Z'249A8A69',Z'155D9721',Z'1E7A0514',Z'0000003F',Z'00FE9524',
- +Z'1482952A',Z'3FA5D822',Z'14829529',Z'00000FE9',Z'1482952C',
- +Z'20A54829',Z'0003FA54',Z'1482952B',Z'3FA54829',Z'1E814529',
- +Z'3FA6981E',Z'195D552B',Z'289A485C',Z'249A8A69',Z'155D9721'/
- DATA (IY12(I), I=51,108)/
- +Z'0003F514',Z'1482952B',Z'3F514829',Z'1482952A',Z'1B616554',
- +Z'3F7DF79D',Z'20A5E529',Z'29A60514',Z'0000003F',Z'14829528',
- +Z'00000FD4',Z'14557669',Z'296D7554',Z'14557660',Z'3F6D7554',
- +Z'1982952A',Z'2281D6DA',Z'228E4923',Z'1969B760',Z'00000FD9',
- +Z'2982952A',Z'00000FD4',Z'1A82952B',Z'2285F6DA',Z'1F8628E3',
- +Z'00FDA69B',Z'1E8A9A6A',Z'145155DA',Z'2279A5D5',Z'0003FA69',
- +Z'2082962C',Z'3FA69820',Z'00FF0424',Z'2279E6A6',Z'228A69A2',
- +Z'3F69A79E',Z'1082D42A',Z'1961782D',Z'145155D8',Z'1C6D95D5',
- +Z'208A07DD',Z'1F79C6D9',Z'29A268A0',Z'24966A29',Z'0003F9A5',
- +Z'27822525',Z'3F9E8A68',Z'1083042B',Z'2075D830',Z'0003F8E3',
- +Z'3FA605EC',Z'15598669',Z'18595514',Z'227DD71A',Z'28A689E0',
- +Z'00000FE7',Z'124D246C',Z'13450411'/
- DATA (IY13(I),I=1,50)/
- +Z'2CA1C615',Z'1851282E',Z'2FB6BA24',Z'2DBAFC30',Z'0003FBEE',
- +Z'1C75C6E5',Z'29A2781B',Z'0003F9E8',Z'1C75C6E5',Z'28A6881B',
- +Z'2DB2AA27',Z'0000003F',Z'3FA605EC',Z'10830427',Z'20410830',
- +Z'0003FC30',Z'10830427',Z'20410830',Z'0003FC30',Z'2085D668',
- +Z'269A08A2',Z'0000003F',Z'14491427',Z'1D6D9616',Z'154D181F',
- +Z'1E71A617',Z'289A48A0',Z'20BEDAE9',Z'289E58E1',Z'30BEEB2A',
- +Z'0000003F',Z'14491427',Z'1D6D9616',Z'154D181F',Z'1E71A617',
- +Z'289A48A0',Z'20BEDAE9',Z'289E58E1',Z'30BEEB2A',Z'0000003F',
- +Z'209DB6F0',Z'29220A5C',Z'0000003F',Z'2179A5AC',Z'259A6963',
- +Z'1E696823',Z'269A58E1',Z'278E08E5',Z'2A9E382A',Z'00FEAAA0'/
- DATA (IY13(I), I=51,108)/
- +Z'165D972C',Z'207595D6',Z'1C82A962',Z'175965D9',Z'258A0759',
- +Z'00000FEA',Z'2075856C',Z'20758560',Z'2BA23820',Z'2BA23820',
- +Z'0000003F',Z'269A58AC',Z'1E7E18E5',Z'1D7E07DE',Z'1659765B',
- +Z'1F75B657',Z'1F79E7E0',Z'269A58E1',Z'278A08A5',Z'2A9E282A',
- +Z'00FEAAA0',Z'1B6DC76D',Z'289A379C',Z'259E8A69',Z'1B720863',
- +Z'155155D9',Z'267DC657',Z'27A29A68',Z'0000003F',Z'1982766B',
- +Z'00000FE7',Z'19826668',Z'1C75D71A',Z'1A69965A',Z'258E2819',
- +Z'228E59A6',Z'00000FE2',Z'2592382B',Z'1F863925',Z'1C6DB71D',
- +Z'259648DD',Z'1D7E18E4',Z'1D71B6DC',Z'00000FE0',Z'217DD724',
- +Z'218E4923',Z'2071C75F',Z'227A085F',Z'1D823760',Z'208DD823',
- +Z'217E089E',Z'0000003F',Z'1C924724',Z'208DD81C',Z'237608DD',
- +Z'1D823760',Z'208DD823',Z'0003F8DD'/
- DATA (IY14(I),I=1,50)/
- +Z'1A8E36A5',Z'1D822760',Z'208A0822',Z'0003F8A0',Z'2675D9A5',
- +Z'2381E8E0',Z'207A081E',Z'0003F7A0',Z'1E7A56A6',Z'1A8206A5',
- +Z'2081E820',Z'20960825',Z'0003F7A0',Z'208A07AD',Z'2082581B',
- +Z'00000FE0',Z'206976A8',Z'1881D61D',Z'00000FE9',Z'208A07AD',
- +Z'2082581B',Z'00000FE0',Z'209A99A8',Z'17823A23',Z'00000FE8',
- +Z'155155A5',Z'00FDA657',Z'28A689E5',Z'00000FE7',Z'27A29A25',
- +Z'3FB6CAA8',Z'00FF042B',Z'19552427',Z'2EAE789E',Z'00000FF0',
- +Z'19552427',Z'2EAE789E',Z'00000FF0',Z'00FE082D',Z'208295ED',
- +Z'00000FE0',Z'2381D76D',Z'00000FE3',Z'1D8266A8',Z'3F8DD823',
- +Z'2179C6E5',Z'1E863923',Z'0003F6DC',Z'3F91B765',Z'1C6DB725'/
- DATA (IY14(I), I=51,108)/
- +Z'3F92481E',Z'1C6DB725',Z'1F7E07DE',Z'239248E0',Z'0000003F',
- +Z'1B8246E5',Z'0003F861',Z'1E79F6E5',Z'2492385F',Z'3F6DB823',
- +Z'1E71B6E5',Z'218E48E1',Z'3F85F79F',Z'1B8246E5',Z'00000FDB',
- +Z'1F79C6E5',Z'1B6DC79F',Z'248E07E0',Z'3F7E08E4',Z'208607A5',
- +Z'1E71B71E',Z'3F9248E1',Z'1E8296EA',Z'1E71B6DC',Z'29A268E1',
- +Z'00FE6A29',Z'1E829529',Z'1E71B6DC',Z'29A268E1',Z'00FE6A29',
- +Z'1B6DC7A9',Z'268E179C',Z'26A29A68',Z'0000003F',Z'1E82952A',
- +Z'1E71B6DC',Z'29A268E1',Z'00FE6A29',Z'1D7E1869',Z'1E71B6DC',
- +Z'29A268E1',Z'00FE6A29',Z'18554527',Z'3F6DB829',Z'2FBAB6EA',
- +Z'1E82FC30',Z'1E71B6DC',Z'29A268E1',Z'00FE6A29',Z'1F82952A',
- +Z'1F71B6DC',Z'00000FE9',Z'13515524',Z'3FA5B814',Z'13515525',
- +Z'2FB1B814',Z'0003FC30',Z'1B829528'/
- DATA (IY15(I),I=1,50)/
- +Z'3FA61825',Z'00FE9524',Z'1F8296EF',Z'1F71B6DC',Z'1B71F829',
- +Z'3FA5F71B',Z'1F8296EA',Z'1F71B6DC',Z'00000FE9',Z'2179C6EA',
- +Z'29A689A3',Z'1E8639A8',Z'00FDB6DC',Z'1E8306E9',Z'1E71B6DC',
- +Z'29A268E1',Z'00FE6A29',Z'1E8306EA',Z'1E71B6DC',Z'29A268E1',
- +Z'00FE6A29',Z'218296E6',Z'3F6DB71E',Z'1B6DC7A9',Z'2286079C',
- +Z'29A26963',Z'00FE6A29',Z'29A25527',Z'3F6DB829',Z'29A256EA',
- +Z'1B825A29',Z'00000FE9',Z'1B8296E8',Z'00000FE9',Z'1B8296EB',
- +Z'20A5B829',Z'0003FA5B',Z'1B8296E9',Z'00000FE9',Z'1B8296E8',
- +Z'30C2FB69',Z'0000003F',Z'1B8296E9',Z'3FA6981B',Z'2079C6EB',
- +Z'29A689A3',Z'1B7A2968',Z'1E71B6E0',Z'3FA69A26',Z'1B5D552A'/
- DATA (IY15(I), I=51,108)/
- +Z'20C2889E',Z'1B656514',Z'1D81D75C',Z'2796281E',Z'27A29A68',
- +Z'00000FE4',Z'1B6DC7AA',Z'2992075C',Z'2981E6E0',Z'0003FC2D',
- +Z'1E71B6E9',Z'29A27921',Z'208E6A29',Z'155D96DD',Z'3F5D5514',
- +Z'1B6DC768',Z'2086079C',Z'289A48A1',Z'3F9A8A69',Z'17595527',
- +Z'19819658',Z'258E075B',Z'2FB6BA67',Z'00FEEC30',Z'1B6DD7EA',
- +Z'20A6279C',Z'1B6DC7A2',Z'3FC2581D',Z'1B6DD7EA',Z'289A379C',
- +Z'23968A69',Z'145586E0',Z'1E6D8594',Z'0003F8A0',Z'289A26E5',
- +Z'3F967A69',Z'1C8296E9',Z'2181C6DB',Z'238A1821',Z'3FA29A68',
- +Z'16554528',Z'3FA5B829',Z'1F8306EB',Z'28A699E4',Z'226E08A6',
- +Z'27A69A26',Z'00000FE5',Z'2685B6E9',Z'2079B829',Z'3FA689A3',
- +Z'17595528',Z'19819658',Z'217DD6DA',Z'238A08A2',Z'2CAA89A4',
- +Z'3FC30BED',Z'2179C6E9',Z'29A689E4'/
- DATA (IY16(I),I=1,50)/
- +Z'1D8239A8',Z'00FDB6DC',Z'1B8296EB',Z'1E8299A1',Z'00FDB6DC',
- +Z'289E4869',Z'239A8A69',Z'1B6DC760',Z'3FC2179C',Z'1E71B6EB',
- +Z'29A27921',Z'208E6A29',Z'00FDB71D',Z'1E8296EA',Z'00FDB6DC',
- +Z'1B6DD7EA',Z'299E479C',Z'1E8A6A29',Z'00000FDB',Z'227DD72B',
- +Z'29A689E5',Z'1D8239A8',Z'2685D6DB',Z'00000FF0',Z'2E75B6E9',
- +Z'1D6E0C30',Z'3FC2EAE0',Z'1F83052B',Z'1E71B6DD',Z'29A689A3',
- +Z'1B7A39A8',Z'0000003F',Z'227DC6EB',Z'28A69A25',Z'28961825',
- +Z'22968A69',Z'00FDB71F',Z'208266E8',Z'3F9A6820',Z'00FE56A2',
- +Z'18924627',Z'2871CA20',Z'0000003F',Z'1682A5A8',Z'1B69A82A',
- +Z'1A65969B',Z'208A179C',Z'248A075C',Z'249669A5',Z'3F9248E3'/
- DATA (IY16(I), I=51,108)/
- +Z'1B8206E3',Z'24923820',Z'0003F8E3',Z'1A8256A6',Z'2079E825',
- +Z'0003F861',Z'3F9A06A8',Z'1C6DB725',Z'1F8207DE',Z'2492381E',
- +Z'0003F8E3',Z'176185E9',Z'1D698596',Z'178299E3',Z'289A3759',
- +Z'28A29AAA',Z'00000FE9',Z'1E7DF7A3',Z'2492381E',Z'0003F8E3',
- +Z'1E7DF7A3',Z'2392481E',Z'00FE7963',Z'3F9A06A8',Z'1682A5A5',
- +Z'2059682A',Z'0003FAAA',Z'1682A5A5',Z'2059682A',Z'0003FAAA',
- +Z'2085D668',Z'269A08A2',Z'0000003F',Z'1A6175A5',Z'1A5E079C',
- +Z'1881F720',Z'207DE71A',Z'289A48A1',Z'26824860',Z'26922829',
- +Z'00FEAA68',Z'1A6175A6',Z'1A5E079C',Z'1881F720',Z'207DE71A',
- +Z'289A48A1',Z'26824860',Z'26922829',Z'00FEAA68',Z'2095D769',
- +Z'2652099D',Z'0000003F',Z'145155EB',Z'26A205D5',Z'1865E8A4',
- +Z'1E6585D7',Z'20A26922',Z'29A20A28'/
- DATA (IY17(I),I=1,50)/
- +Z'3FA29AAA',Z'218216E8',Z'20AA182A',Z'186E0AAA',Z'15620556',
- +Z'155986E0',Z'1B815620',Z'1A81B659',Z'196E06DA',Z'1A6A06D9',
- +Z'1D71B81B',Z'2075B820',Z'2075C6E0',Z'3F81D6E0',Z'1C8195E8',
- +Z'208E181E',Z'2A9E0AA7',Z'1582AAA0',Z'17560617',Z'185D8818',
- +Z'1C75C660',Z'1C75C660',Z'1D71D760',Z'2285E81D',Z'208A1822',
- +Z'208A285E',Z'228A08A1',Z'238228A1',Z'27A289E6',Z'238289E5',
- +Z'27A289E6',Z'288289E5',Z'3FA289E8',Z'2782A9E8',Z'20AAA82A',
- +Z'239A8A27',Z'1B7608A2',Z'155986DA',Z'1A6D8595',Z'228A075B',
- +Z'27A289A3',Z'0000003F',Z'23860826',Z'20863924',Z'1B6DC79F',
- +Z'248E179C',Z'00000FE4',Z'1D823765',Z'00000FE3',Z'218E6A2B'/
- DATA (IY17(I), I=51,103)/
- +Z'1D71C75E',Z'238A17DE',Z'1F8A3924',Z'00FD869D',Z'238E282A',
- +Z'1C75E862',Z'2281F75C',Z'1E8628E3',Z'1F75C71D',Z'00000FE0',
- +Z'1F71A667',Z'279E6921',Z'1C7E1926',Z'00FD965A',Z'1A9A66A6',
- +Z'00000FDA',Z'18924627',Z'0000003F',Z'20AA05A6',Z'00000FD6',
- +Z'2175D5E8',Z'1D8678E7',Z'0003F5DD',Z'2281E769',Z'2281E823',
- +Z'00FE0820',Z'1E8266E5',Z'2079D69D',Z'00FDD6DD',Z'2281E769',
- +Z'2281E823',Z'00FE0820',Z'228256A5',Z'208A39A3',Z'00FE3963',
- +Z'1B6DC723',Z'0003F7DD',Z'239248E3',Z'00000FE3',Z'238E4923',
- +Z'0003F9E5',Z'00FE56A5',Z'2179C6A4',Z'0003F963',Z'2179C6A3',
- +Z'0003F963',Z'00FE0826',Z'20824726',Z'00000FE0',Z'2281E7A6',
- +Z'00000FE2',Z'1E823765',Z'3F89E822'/
-# else
- DATA (IX11(I),I=1,50)/
- +X'1969C7D6',X'217DC699',X'269E79A4',X'00FDF864',X'2185E716',
- +X'0000003F',X'1C6DA696',X'2696489E',X'27663966',X'0000003F',
- +X'238266D6',X'269E79A5',X'1A6DE864',X'00000FD9',X'3FA198D6',
- +X'0003F8E3',X'1B69B956',X'279A485E',X'1E8649A7',X'00FD969B',
- +X'208A5996',X'1B69A6DD',X'2692181D',X'219269E7',X'3F69B760',
- +X'19FDD9D6',X'00000FE7',X'1A69B796',X'2692175B',X'229669E7',
- +X'1965A6DE',X'258DF71A',X'1E8A59A6',X'0000003F',X'208E5996',
- +X'1965A71F',X'2381F71A',X'239669A5',X'3F69B7A0',X'20FD8817',
- +X'3F95BFE8',X'19FD9655',X'279E6962',X'19FE2966',X'279E6962',
- +X'3F662966',X'23967A16',X'1969B75F',X'1F75B699',X'3FA27963'/
- DATA (IX11(I), I=51,108)/
- +X'19FD9655',X'279A58E0',X'208E59A7',X'00000FD9',X'1AFDA696',
- +X'3F89AFE7',X'0003F9DA',X'1AFDA696',X'3F89AFE7',X'23967A16',
- +X'1969B75F',X'1F75B699',X'28A27963',X'00FE88FF',X'27FD9655',
- +X'3F9D9FE7',X'00FE081C',X'228E4918',X'1A6DC7A0',X'00000FDA',
- +X'27FD9655',X'3F9DEFD9',X'1AFDA696',X'00000FE6',X'18FD8614',
- +X'3F828FE0',X'0003FA28',X'19FD9655',X'3F9E7FE7',X'1969C795',
- +X'1C699618',X'279A489E',X'249A7A28',X'0003F7A2',X'19FD9655',
- +X'279E6962',X'3F662966',X'1969C795',X'1C699618',X'279A489E',
- +X'249A7A28',X'2787F7A2',X'0000003F',X'19FD9655',X'279E6962',
- +X'3F662966',X'0003F9E0',X'1E8A59D6',X'1B69965B',X'279A58DD',
- +X'1B7A2967',X'00000FD9',X'19FE0818',X'00000FE7',X'1C699655',
- +X'279A485F',X'00000FE7',X'28FE0617'/
- DATA (IX12(I),I=1,50)/
- +X'00000FE0',X'20FDB594',X'3F960FDB',X'0003F96A',X'27FE7656',
- +X'00000FD9',X'3F820617',X'0003F828',X'19FD99D6',X'3F9D9FE7',
- +X'20FD8817',X'3F95BFE8',X'19FD9655',X'279E6962',X'19FE2966',
- +X'279E6962',X'3F662966',X'1AFDA696',X'00000FE6',X'20FD8817',
- +X'3FA18FE8',X'1AFDA696',X'3F89AFE7',X'0003F9DA',X'19FD99D6',
- +X'3F9D9FE7',X'27FD9655',X'3F9D9FE7',X'1969C795',X'1C699618',
- +X'279A489E',X'249A7A28',X'2377F7A2',X'0000003F',X'00FE081C',
- +X'27FD9655',X'3F9DEFD9',X'20FD8817',X'00000FE8',X'18FD8614',
- +X'3F828FE0',X'0003FA28',X'19FD9655',X'3F9E7FE7',X'1DFE7657',
- +X'3F9D9FE3',X'1969C795',X'1C699618',X'279A489E',X'249A7A28'/
- DATA (IX12(I), I=51,108)/
- +X'0003F7A2',X'27FD9655',X'3F9D9FE7',X'19FD9655',X'279E6962',
- +X'3F662966',X'3F660657',X'2767F9D9',X'0000003F',X'19FE0818',
- +X'00000FE7',X'1B699657',X'2081F79D',X'259A79FF',X'3F8218A3',
- +X'1EFE0816',X'1A65969B',X'2696279B',X'229669E7',X'00000FDE',
- +X'19FE7656',X'00000FE7',X'17FE0815',X'1C6DA658',X'2696485F',
- +X'00FE9A27',X'1969D656',X'217DC699',X'269E79A4',X'0003F9E3',
- +X'18FE0814',X'3FA18FE8',X'00FE081C',X'1A69E79A',X'268A279E',
- +X'3F7A28A6',X'22FDE796',X'26966FE2',X'1E8A59E7',X'1B69965B',
- +X'3F9E58DD',X'258DD6D9',X'229679E6',X'1A6596DE',X'0003F69B',
- +X'20FE081B',X'3F82181F',X'27FDA856',X'3FA1AFE0',X'0003F9D9',
- +X'3F628614',X'1C6DA697',X'2696489E',X'20824966',X'2181F83F',
- +X'00000FE0',X'2AA68A54',X'23967A6A'/
- DATA (IX13(I),I=1,50)/
- +X'1D7A0862',X'228E4FDC',X'1B75E7E0',X'175965D9',X'0003F5D8',
- +X'2181F81B',X'207E0FE0',X'0003F821',X'2181F81B',X'1F821FE0',
- +X'1F821860',X'0000003F',X'3FA18A14',X'1EFDD759',X'3F91DFDE',
- +X'0003F91D',X'23FE2899',X'3F8DCFE3',X'0003F8DC',X'3F6E56D8',
- +X'256FF95B',X'0000003F',X'1E7E0899',X'218607DE',X'1F7E0FDF',
- +X'218A2860',X'218A285D',X'3F81F7E0',X'1F82185F',X'2281F79E',
- +X'0000003F',X'22860799',X'1F7E0862',X'21860FE1',X'1F79E7E0',
- +X'1F79E7E3',X'3F821860',X'2181F7E1',X'1E8218A2',X'0000003F',
- +X'3F81748F',X'20C3F816',X'0000003F',X'1865C814',X'1F75B658',
- +X'27920FE0',X'23967A28',X'1F83F821',X'22860FDE',X'00FE27BF'/
- DATA (IX13(I), I=51,108)/
- +X'1C79F814',X'1961865B',X'20FE071A',X'279648A1',X'249A7A28',
- +X'00000FE0',X'1769E814',X'299A283F',X'2079A5FF',X'208A6A7F',
- +X'0000003F',X'26922814',X'26A29A68',X'2387F864',X'1F863924',
- +X'1F75C71D',X'1869C7FF',X'1C6985D7',X'1F83F81E',X'22860FDE',
- +X'00FE27BF',X'28A6AA93',X'208A49A7',X'165D869E',X'207D85D6',
- +X'1C7A0861',X'2379C6DB',X'2AAA99E5',X'0000003F',X'27FE7655',
- +X'00000FD9',X'1DFDA998',X'1A6DD79E',X'2485D6DA',X'228A3FE6',
- +X'259A6963',X'00000FE3',X'258E2815',X'2BAEAA67',X'23967A6A',
- +X'196DD7A2',X'16555597',X'1E75B657',X'00000FE0',X'1C71D7DC',
- +X'248E17DD',X'3F7E18E4',X'1E7BF75D',X'20FDF7FF',X'3F861FE0',
- +X'238FF8A2',X'0000003F',X'2491C71C',X'3F75DFDC',X'1F7FF79E',
- +X'21FE083F',X'3F8A2FE1',X'0003F8E3'/
- DATA (IX14(I),I=1,50)/
- +X'2095B81B',X'20FDD83F',X'3F7E0FE3',X'0003F860',X'206E581B',
- +X'20FE383F',X'3F860FDD',X'0003F7E0',X'1A99C81A',X'2083F824',
- +X'20FDA83F',X'3F920FDC',X'0003F9A0',X'3F9A9993',X'17FE3A23',
- +X'00000FE8',X'3F8A0798',X'20FE581B',X'00000FE0',X'3F697693',
- +X'18FDD61D',X'00000FE9',X'3F8A0798',X'20FE581B',X'00000FE0',
- +X'2181F81B',X'00FDF821',X'2181F81B',X'00000FE0',X'207E085B',
- +X'3F7E0861',X'00FD7A55',X'1E822919',X'2281E75D',X'00000FE4',
- +X'2281E719',X'1E8228E3',X'00000FDC',X'00FE95D3',X'17FE0813',
- +X'00000FE9',X'17FE95D3',X'00000FE9',X'1BFE0818',X'3F6E5FE5',
- +X'1D75E81B',X'238E281E',X'0003F822',X'3F82079B',X'2385F75B'/
- DATA (IX14(I), I=51,108)/
- +X'3F8DD8A3',X'2385F75B',X'2183F863',X'1D7E18E3',X'0000003F',
- +X'21FE185B',X'0003F91C',X'207DD79B',X'1F8228E2',X'3F89EFDD',
- +X'1D7A089B',X'238A079D',X'3F75E822',X'1DFDF8DB',X'00000FE3',
- +X'1F75D7DB',X'1F8638E1',X'1F75D7FF',X'3F8638E1',X'1E8228DB',
- +X'238A079D',X'3F7A08A3',X'26FE6997',X'1B75F8A4',X'1F75B69A',
- +X'00FE6922',X'1AFDA696',X'258E179C',X'218E59A6',X'00FDA71E',
- +X'1F8A4997',X'1B69A6DD',X'269227DD',X'0000003F',X'26FE6997',
- +X'1B75F8A4',X'1F75B69A',X'00FE6922',X'259A6697',X'1B75F8A4',
- +X'1F75B69A',X'00FE6922',X'2086395B',X'3F91DFE0',X'24966997',
- +X'26FDD7E2',X'1B75F8A4',X'1F75B69A',X'00FE6922',X'1BFDB6D7',
- +X'2696381E',X'00000FE6',X'208607DC',X'3F820FDF',X'218A181B',
- +X'20861FE0',X'0003F71E',X'25FDB6D7'/
- DATA (IX15(I),I=1,50)/
- +X'3F99FFDB',X'00FE081C',X'15FD5551',X'207DD698',X'258E0FE0',
- +X'3FAEBAA8',X'1BFDB6D7',X'2696381E',X'00000FE6',X'1A6DD7D7',
- +X'227DD6DA',X'269E79A4',X'00FDF8A4',X'1AFDA696',X'258E179C',
- +X'218E59A6',X'00FDA71E',X'26FE6997',X'1B75F8A4',X'1F75B69A',
- +X'00FE6922',X'1DFDD759',X'3F96281E',X'1F8A5998',X'2379C6DC',
- +X'229669A5',X'00FDB71F',X'2386081B',X'3F91DFE5',X'1E71B6D7',
- +X'26FE68E1',X'00000FE6',X'26FE0698',X'00000FE0',X'20FDC615',
- +X'3F920FDC',X'0003F928',X'26FE66D8',X'00000FDB',X'26FE0698',
- +X'1969C7A0',X'0000003F',X'1BFDB998',X'3F99BFE6',X'1A6DD7D6',
- +X'1E71A659',X'289E58E0',X'238A17FF',X'3FA279A5',X'1D7E18D7'/
- DATA (IX15(I), I=51,108)/
- +X'3F65A6DC',X'269E7963',X'20FE08E5',X'24965922',X'1C75F863',
- +X'00000FDB',X'1D71A617',X'2086181F',X'209A7A3F',X'0003F75E',
- +X'1B75F897',X'1E71B69A',X'259648A0',X'1F7E08A4',X'3F9A48A0',
- +X'1F8A4958',X'3F85E75D',X'1C6DB761',X'3F96385E',X'1F7E0898',
- +X'26FE68E0',X'1B6DC7E2',X'228A179C',X'00FDE7E1',X'1C6985D6',
- +X'3F69C75D',X'248A079C',X'3F8A59A6',X'1B657595',X'1C6DB71C',
- +X'248E17DD',X'239669A5',X'23860821',X'0003FA25',X'1D75E81A',
- +X'3F8E281E',X'27FD9757',X'1D7E3966',X'1F79CFDC',X'3F9238A1',
- +X'1E75B658',X'3F6A0FE6',X'1CFD7756',X'217DD6DB',X'259FF963',
- +X'299E5924',X'00000FEA',X'1B71D697',X'259A7FDA',X'3F69D823',
- +X'1F7E0898',X'23FE68E0',X'1F75D7A0',X'1E8BF922',X'2175B6DC',
- +X'3F7A08A2',X'1B71E818',X'217DD71B'/
- DATA (IX16(I),I=1,50)/
- +X'259A6963',X'00FE08A4',X'23FDA795',X'17FE6964',X'00FE9719',
- +X'1D71B6D7',X'2696385F',X'208A4966',X'3F5DB71E',X'1B75FA57',
- +X'1E71B69A',X'259648A0',X'00FE18E4',X'18FDE856',X'00FE875A',
- +X'1C6985D6',X'1D6DB75D',X'279A489F',X'00000FE7',X'1865B755',
- +X'1F71A658',X'28A27962',X'1E822926',X'00000FDB',X'2375B657',
- +X'27A3F9E5',X'3F6196E5',X'15FDC914',X'1B6DA616',X'1F75B69A',
- +X'29A26922',X'0000003F',X'1761A714',X'1D6D9617',X'207E0FDF',
- +X'289E58E1',X'00FE69E8',X'1BFE0818',X'3F95BFE5',X'00FE081E',
- +X'209D9819',X'2066783F',X'0000003F',X'22FDF7D9',X'24925FE2',
- +X'1C7A3965',X'3F96475C',X'2596475C',X'1C75F8A4',X'3F71D75C'/
- DATA (IX16(I), I=51,108)/
- +X'21FE081E',X'21820FE1',X'0003F821',X'23FDE81B',X'3F91DFE1',
- +X'0003F91D',X'3F6E56D8',X'2386079C',X'21860823',X'21820FE3',
- +X'0003F821',X'279E6997',X'20862926',X'23FDD79F',X'1E7E0862',
- +X'1A65969C',X'00000FDA',X'2186081E',X'21820FE0',X'0003F821',
- +X'2186081E',X'20821FE0',X'00FE0861',X'3F95B958',X'1FFDE79B',
- +X'3F8DEFDF',X'0003F8DE',X'22FE185B',X'3F89DFE2',X'0003F89D',
- +X'3F95B958',X'256FF95B',X'0000003F',X'1E79F85A',X'1E7FF860',
- +X'1EFE087F',X'1E82185F',X'1E7E1860',X'1EFE183F',X'1E821FDF',
- +X'00FE17DE',X'228A17DB',X'2287F7E0',X'22FE07FF',X'2281F7E1',
- +X'2285F7E0',X'22FDF83F',X'2281FFE1',X'00FDF862',X'3F81A5D5',
- +X'20A7F819',X'0000003F',X'217DE795',X'1657F8A2',X'1B69A658',
- +X'269A58DD',X'3FAEAA27',X'1E7FFAD5'/
- DATA (IX17(I),I=1,50)/
- +X'3F86285F',X'20FE0818',X'3F860FDF',X'1F83F85F',X'1C7FF71E',
- +X'248A183F',X'20FE487F',X'1EFD869C',X'2483F61A',X'268BFA26',
- +X'1D7A0FE8',X'1D7A0FDD',X'238E283F',X'3F8E283F',X'20FE0818',
- +X'3F820FE0',X'2183F7E0',X'20FE17FF',X'2183F79F',X'2281EFE2',
- +X'1B71E83F',X'2592283F',X'2281E73F',X'1C7A0FE4',X'3F69965A',
- +X'279A48A0',X'1E73F9A7',X'20FE48A0',X'1969B75E',X'20FDA618',
- +X'279A58E2',X'1BFE6A28',X'3F96381D',X'20FDF818',X'3F85FFE1',
- +X'28A268E0',X'27A27967',X'218E48E5',X'1B75C75F',X'196D9619',
- +X'2075A618',X'0000003F',X'218A391A',X'1D71C760',X'1E821860',
- +X'2385F75D',X'00000FE4',X'23FE375B',X'00000FDD',X'29AABAD7'/
- DATA (IX17(I), I=51,103)/
- +X'1A761926',X'1A6175D8',X'299A485D',X'00FEBAEA',X'24967A16',
- +X'1C79F862',X'1961865B',X'217DE71B',X'289E5922',X'00000FE8',
- +X'1969C7D9',X'217DC699',X'269E79A4',X'00FDF864',X'2699A69A',
- +X'00000FDA',X'209D9819',X'0000003F',X'2681A81A',X'00000FE0',
- +X'1D61E818',X'288E581B',X'0003F822',X'239A3897',X'23963FE2',
- +X'00FE56BF',X'1DFE081B',X'3F8E281E',X'00FE281E',X'1D69D797',
- +X'1D6DDFDE',X'00FE66FF',X'1DFE081B',X'3F8E281E',X'00FE281E',
- +X'2182085E',X'0003F821',X'2186081E',X'00000FE0',X'2182085E',
- +X'0003F821',X'00FDC91B',X'1F7E089D',X'0003F8A0',X'2186079C',
- +X'0003F7A0',X'00FE471A',X'1CFE081A',X'00000FE4',X'1CFE471A',
- +X'00000FE4',X'1DFE081B',X'3F763FE3'/
- DATA (IY11(I),I=1,50)/
- +X'1D61552A',X'29A68960',X'18760968',X'00FD4515',X'2951762A',
- +X'0000003F',X'1559866A',X'18595514',X'29A5F71A',X'0000003F',
- +X'1C71452A',X'268E179D',X'27A29A68',X'00000FE5',X'208A252A',
- +X'0003FA54',X'1C75452A',X'2179C6DB',X'29A689A3',X'00FE59E8',
- +X'145155EA',X'2689D615',X'26A29A68',X'1C75F8A3',X'3F89F75C',
- +X'1482952A',X'00000FD4',X'195D552A',X'2079D71B',X'29A27962',
- +X'22967A29',X'1B71D7A0',X'145155D9',X'0000003F',X'2181E6EA',
- +X'1A6DE821',X'15514557',X'289606D7',X'3F9A8A69',X'14829529',
- +X'3F8A2829',X'1482952A',X'1A616554',X'1E81E75C',X'258A07DE',
- +X'3FA69A27',X'1455766B',X'1C657554',X'29A26921',X'3F926A29'/
- DATA (IY11(I), I=51,108)/
- +X'1482952A',X'1C657554',X'29A26921',X'00000FE9',X'14829529',
- +X'2079E814',X'0003FA69',X'14829528',X'3F79E814',X'1455766B',
- +X'1C657554',X'29A26921',X'21926A29',X'00FE1860',X'1482952B',
- +X'3F79E829',X'00FE9524',X'289E4528',X'249E8A69',X'00000FE2',
- +X'1482952A',X'3FA5D822',X'29829527',X'00000FE9',X'1482952C',
- +X'20A54829',X'0003FA54',X'1482952B',X'3FA54829',X'195D552B',
- +X'289A485C',X'249A8A69',X'155D9721',X'0003F514',X'1482952A',
- +X'1B616554',X'3F7DF79D',X'195D552B',X'289A485C',X'249A8A69',
- +X'155D9721',X'2B960514',X'0000003F',X'1482952A',X'1A616554',
- +X'2079E75C',X'0003FA5E',X'145155EA',X'1C6D95D5',X'238607DD',
- +X'28A69A26',X'00000FE6',X'14829528',X'00000FD4',X'289A352B',
- +X'239A8A69',X'00000FD4',X'14829529'/
- DATA (IY12(I),I=1,50)/
- +X'00000FE9',X'1482952C',X'20A54829',X'0003FA54',X'1482952A',
- +X'00000FE9',X'20A5E529',X'0003F794',X'1482952A',X'3FA69814',
- +X'14829529',X'3F8A2829',X'1482952A',X'1A616554',X'1E81E75C',
- +X'258A07DE',X'3FA69A27',X'14829527',X'00000FD4',X'14829529',
- +X'3FA69829',X'14829529',X'2079E814',X'0003FA69',X'1482952A',
- +X'3FA69814',X'1482952B',X'3F79E829',X'195D552B',X'289A485C',
- +X'249A8A69',X'155D9721',X'1E7A0514',X'0000003F',X'00FE9524',
- +X'1482952A',X'3FA5D822',X'14829529',X'00000FE9',X'1482952C',
- +X'20A54829',X'0003FA54',X'1482952B',X'3FA54829',X'1E814529',
- +X'3FA6981E',X'195D552B',X'289A485C',X'249A8A69',X'155D9721'/
- DATA (IY12(I), I=51,108)/
- +X'0003F514',X'1482952B',X'3F514829',X'1482952A',X'1B616554',
- +X'3F7DF79D',X'20A5E529',X'29A60514',X'0000003F',X'14829528',
- +X'00000FD4',X'14557669',X'296D7554',X'14557660',X'3F6D7554',
- +X'1982952A',X'2281D6DA',X'228E4923',X'1969B760',X'00000FD9',
- +X'2982952A',X'00000FD4',X'1A82952B',X'2285F6DA',X'1F8628E3',
- +X'00FDA69B',X'1E8A9A6A',X'145155DA',X'2279A5D5',X'0003FA69',
- +X'2082962C',X'3FA69820',X'00FF0424',X'2279E6A6',X'228A69A2',
- +X'3F69A79E',X'1082D42A',X'1961782D',X'145155D8',X'1C6D95D5',
- +X'208A07DD',X'1F79C6D9',X'29A268A0',X'24966A29',X'0003F9A5',
- +X'27822525',X'3F9E8A68',X'1083042B',X'2075D830',X'0003F8E3',
- +X'3FA605EC',X'15598669',X'18595514',X'227DD71A',X'28A689E0',
- +X'00000FE7',X'124D246C',X'13450411'/
- DATA (IY13(I),I=1,50)/
- +X'2CA1C615',X'1851282E',X'2FB6BA24',X'2DBAFC30',X'0003FBEE',
- +X'1C75C6E5',X'29A2781B',X'0003F9E8',X'1C75C6E5',X'28A6881B',
- +X'2DB2AA27',X'0000003F',X'3FA605EC',X'10830427',X'20410830',
- +X'0003FC30',X'10830427',X'20410830',X'0003FC30',X'2085D668',
- +X'269A08A2',X'0000003F',X'14491427',X'1D6D9616',X'154D181F',
- +X'1E71A617',X'289A48A0',X'20BEDAE9',X'289E58E1',X'30BEEB2A',
- +X'0000003F',X'14491427',X'1D6D9616',X'154D181F',X'1E71A617',
- +X'289A48A0',X'20BEDAE9',X'289E58E1',X'30BEEB2A',X'0000003F',
- +X'209DB6F0',X'29220A5C',X'0000003F',X'2179A5AC',X'259A6963',
- +X'1E696823',X'269A58E1',X'278E08E5',X'2A9E382A',X'00FEAAA0'/
- DATA (IY13(I), I=51,108)/
- +X'165D972C',X'207595D6',X'1C82A962',X'175965D9',X'258A0759',
- +X'00000FEA',X'2075856C',X'20758560',X'2BA23820',X'2BA23820',
- +X'0000003F',X'269A58AC',X'1E7E18E5',X'1D7E07DE',X'1659765B',
- +X'1F75B657',X'1F79E7E0',X'269A58E1',X'278A08A5',X'2A9E282A',
- +X'00FEAAA0',X'1B6DC76D',X'289A379C',X'259E8A69',X'1B720863',
- +X'155155D9',X'267DC657',X'27A29A68',X'0000003F',X'1982766B',
- +X'00000FE7',X'19826668',X'1C75D71A',X'1A69965A',X'258E2819',
- +X'228E59A6',X'00000FE2',X'2592382B',X'1F863925',X'1C6DB71D',
- +X'259648DD',X'1D7E18E4',X'1D71B6DC',X'00000FE0',X'217DD724',
- +X'218E4923',X'2071C75F',X'227A085F',X'1D823760',X'208DD823',
- +X'217E089E',X'0000003F',X'1C924724',X'208DD81C',X'237608DD',
- +X'1D823760',X'208DD823',X'0003F8DD'/
- DATA (IY14(I),I=1,50)/
- +X'1A8E36A5',X'1D822760',X'208A0822',X'0003F8A0',X'2675D9A5',
- +X'2381E8E0',X'207A081E',X'0003F7A0',X'1E7A56A6',X'1A8206A5',
- +X'2081E820',X'20960825',X'0003F7A0',X'208A07AD',X'2082581B',
- +X'00000FE0',X'206976A8',X'1881D61D',X'00000FE9',X'208A07AD',
- +X'2082581B',X'00000FE0',X'209A99A8',X'17823A23',X'00000FE8',
- +X'155155A5',X'00FDA657',X'28A689E5',X'00000FE7',X'27A29A25',
- +X'3FB6CAA8',X'00FF042B',X'19552427',X'2EAE789E',X'00000FF0',
- +X'19552427',X'2EAE789E',X'00000FF0',X'00FE082D',X'208295ED',
- +X'00000FE0',X'2381D76D',X'00000FE3',X'1D8266A8',X'3F8DD823',
- +X'2179C6E5',X'1E863923',X'0003F6DC',X'3F91B765',X'1C6DB725'/
- DATA (IY14(I), I=51,108)/
- +X'3F92481E',X'1C6DB725',X'1F7E07DE',X'239248E0',X'0000003F',
- +X'1B8246E5',X'0003F861',X'1E79F6E5',X'2492385F',X'3F6DB823',
- +X'1E71B6E5',X'218E48E1',X'3F85F79F',X'1B8246E5',X'00000FDB',
- +X'1F79C6E5',X'1B6DC79F',X'248E07E0',X'3F7E08E4',X'208607A5',
- +X'1E71B71E',X'3F9248E1',X'1E8296EA',X'1E71B6DC',X'29A268E1',
- +X'00FE6A29',X'1E829529',X'1E71B6DC',X'29A268E1',X'00FE6A29',
- +X'1B6DC7A9',X'268E179C',X'26A29A68',X'0000003F',X'1E82952A',
- +X'1E71B6DC',X'29A268E1',X'00FE6A29',X'1D7E1869',X'1E71B6DC',
- +X'29A268E1',X'00FE6A29',X'18554527',X'3F6DB829',X'2FBAB6EA',
- +X'1E82FC30',X'1E71B6DC',X'29A268E1',X'00FE6A29',X'1F82952A',
- +X'1F71B6DC',X'00000FE9',X'13515524',X'3FA5B814',X'13515525',
- +X'2FB1B814',X'0003FC30',X'1B829528'/
- DATA (IY15(I),I=1,50)/
- +X'3FA61825',X'00FE9524',X'1F8296EF',X'1F71B6DC',X'1B71F829',
- +X'3FA5F71B',X'1F8296EA',X'1F71B6DC',X'00000FE9',X'2179C6EA',
- +X'29A689A3',X'1E8639A8',X'00FDB6DC',X'1E8306E9',X'1E71B6DC',
- +X'29A268E1',X'00FE6A29',X'1E8306EA',X'1E71B6DC',X'29A268E1',
- +X'00FE6A29',X'218296E6',X'3F6DB71E',X'1B6DC7A9',X'2286079C',
- +X'29A26963',X'00FE6A29',X'29A25527',X'3F6DB829',X'29A256EA',
- +X'1B825A29',X'00000FE9',X'1B8296E8',X'00000FE9',X'1B8296EB',
- +X'20A5B829',X'0003FA5B',X'1B8296E9',X'00000FE9',X'1B8296E8',
- +X'30C2FB69',X'0000003F',X'1B8296E9',X'3FA6981B',X'2079C6EB',
- +X'29A689A3',X'1B7A2968',X'1E71B6E0',X'3FA69A26',X'1B5D552A'/
- DATA (IY15(I), I=51,108)/
- +X'20C2889E',X'1B656514',X'1D81D75C',X'2796281E',X'27A29A68',
- +X'00000FE4',X'1B6DC7AA',X'2992075C',X'2981E6E0',X'0003FC2D',
- +X'1E71B6E9',X'29A27921',X'208E6A29',X'155D96DD',X'3F5D5514',
- +X'1B6DC768',X'2086079C',X'289A48A1',X'3F9A8A69',X'17595527',
- +X'19819658',X'258E075B',X'2FB6BA67',X'00FEEC30',X'1B6DD7EA',
- +X'20A6279C',X'1B6DC7A2',X'3FC2581D',X'1B6DD7EA',X'289A379C',
- +X'23968A69',X'145586E0',X'1E6D8594',X'0003F8A0',X'289A26E5',
- +X'3F967A69',X'1C8296E9',X'2181C6DB',X'238A1821',X'3FA29A68',
- +X'16554528',X'3FA5B829',X'1F8306EB',X'28A699E4',X'226E08A6',
- +X'27A69A26',X'00000FE5',X'2685B6E9',X'2079B829',X'3FA689A3',
- +X'17595528',X'19819658',X'217DD6DA',X'238A08A2',X'2CAA89A4',
- +X'3FC30BED',X'2179C6E9',X'29A689E4'/
- DATA (IY16(I),I=1,50)/
- +X'1D8239A8',X'00FDB6DC',X'1B8296EB',X'1E8299A1',X'00FDB6DC',
- +X'289E4869',X'239A8A69',X'1B6DC760',X'3FC2179C',X'1E71B6EB',
- +X'29A27921',X'208E6A29',X'00FDB71D',X'1E8296EA',X'00FDB6DC',
- +X'1B6DD7EA',X'299E479C',X'1E8A6A29',X'00000FDB',X'227DD72B',
- +X'29A689E5',X'1D8239A8',X'2685D6DB',X'00000FF0',X'2E75B6E9',
- +X'1D6E0C30',X'3FC2EAE0',X'1F83052B',X'1E71B6DD',X'29A689A3',
- +X'1B7A39A8',X'0000003F',X'227DC6EB',X'28A69A25',X'28961825',
- +X'22968A69',X'00FDB71F',X'208266E8',X'3F9A6820',X'00FE56A2',
- +X'18924627',X'2871CA20',X'0000003F',X'1682A5A8',X'1B69A82A',
- +X'1A65969B',X'208A179C',X'248A075C',X'249669A5',X'3F9248E3'/
- DATA (IY16(I), I=51,108)/
- +X'1B8206E3',X'24923820',X'0003F8E3',X'1A8256A6',X'2079E825',
- +X'0003F861',X'3F9A06A8',X'1C6DB725',X'1F8207DE',X'2492381E',
- +X'0003F8E3',X'176185E9',X'1D698596',X'178299E3',X'289A3759',
- +X'28A29AAA',X'00000FE9',X'1E7DF7A3',X'2492381E',X'0003F8E3',
- +X'1E7DF7A3',X'2392481E',X'00FE7963',X'3F9A06A8',X'1682A5A5',
- +X'2059682A',X'0003FAAA',X'1682A5A5',X'2059682A',X'0003FAAA',
- +X'2085D668',X'269A08A2',X'0000003F',X'1A6175A5',X'1A5E079C',
- +X'1881F720',X'207DE71A',X'289A48A1',X'26824860',X'26922829',
- +X'00FEAA68',X'1A6175A6',X'1A5E079C',X'1881F720',X'207DE71A',
- +X'289A48A1',X'26824860',X'26922829',X'00FEAA68',X'2095D769',
- +X'2652099D',X'0000003F',X'145155EB',X'26A205D5',X'1865E8A4',
- +X'1E6585D7',X'20A26922',X'29A20A28'/
- DATA (IY17(I),I=1,50)/
- +X'3FA29AAA',X'218216E8',X'20AA182A',X'186E0AAA',X'15620556',
- +X'155986E0',X'1B815620',X'1A81B659',X'196E06DA',X'1A6A06D9',
- +X'1D71B81B',X'2075B820',X'2075C6E0',X'3F81D6E0',X'1C8195E8',
- +X'208E181E',X'2A9E0AA7',X'1582AAA0',X'17560617',X'185D8818',
- +X'1C75C660',X'1C75C660',X'1D71D760',X'2285E81D',X'208A1822',
- +X'208A285E',X'228A08A1',X'238228A1',X'27A289E6',X'238289E5',
- +X'27A289E6',X'288289E5',X'3FA289E8',X'2782A9E8',X'20AAA82A',
- +X'239A8A27',X'1B7608A2',X'155986DA',X'1A6D8595',X'228A075B',
- +X'27A289A3',X'0000003F',X'23860826',X'20863924',X'1B6DC79F',
- +X'248E179C',X'00000FE4',X'1D823765',X'00000FE3',X'218E6A2B'/
- DATA (IY17(I), I=51,103)/
- +X'1D71C75E',X'238A17DE',X'1F8A3924',X'00FD869D',X'238E282A',
- +X'1C75E862',X'2281F75C',X'1E8628E3',X'1F75C71D',X'00000FE0',
- +X'1F71A667',X'279E6921',X'1C7E1926',X'00FD965A',X'1A9A66A6',
- +X'00000FDA',X'18924627',X'0000003F',X'20AA05A6',X'00000FD6',
- +X'2175D5E8',X'1D8678E7',X'0003F5DD',X'2281E769',X'2281E823',
- +X'00FE0820',X'1E8266E5',X'2079D69D',X'00FDD6DD',X'2281E769',
- +X'2281E823',X'00FE0820',X'228256A5',X'208A39A3',X'00FE3963',
- +X'1B6DC723',X'0003F7DD',X'239248E3',X'00000FE3',X'238E4923',
- +X'0003F9E5',X'00FE56A5',X'2179C6A4',X'0003F963',X'2179C6A3',
- +X'0003F963',X'00FE0826',X'20824726',X'00000FE0',X'2281E7A6',
- +X'00000FE2',X'1E823765',X'3F89E822'/
-# endif
- DATA ISTART/
- + 1, 5, 7, 11, 15, 17, 21, 26, 28, 35, 40, 42, 47, 51, 55,
- + 58, 60, 65, 67, 68, 71, 73, 75, 78, 80, 85, 88, 94, 98,103,
- +105,108,110,113,115,117,119,121,126,128,130,133,135,137,143,
- +144,146,148,151,153,155,160,162,165,168,170,174,179,181,185,
- +189,191,192,195,204,206,209,210,215,222,225,229,230,233,236,
- +239,248,257,260,267,273,278,288,296,298,304,311,319,325,329,
- +333,338,341,344,347,350,352,354,356,357,360,363,364,366,368,
- +370,373,374,376,380,382,385,388,390,394,397,401,405,409,413,
- +417,419,424,427,429,432,434,435,439,442,446,450,454,456,460,
- +462,465,467,470,472,475,477,482,489,493,498,502,507,511,517,
- +519,523,525,530,533,539,543,546,550,554,556,560,565,568,573,
- +578,580,581,584,591,594,597,598,602,608,611,614,615,618,621,
- +624,632,640,643,650,663,682,691,696,698,703,709,713,715,717,
- +719,722,725,728,731,734,736,738,740,741,743,745,746,748,750/
-*
- DATA NBIT,NBITCH,NBITMX/32,8,30/
-#endif
-#if defined(CERNLIB_CVX)
- DATA IX11/
- +'217DC6991969C7D6'X,'00FDF864269E79A4'X,'0000003F2185E716'X,
- +'2696489E1C6DA696'X,'0000003F27663966'X,'269E79A5238266D6'X,
- +'00000FD91A6DE864'X,'0003F8E33FA198D6'X,'279A485E1B69B956'X,
- +'00FD969B1E8649A7'X,'1B69A6DD208A5996'X,'219269E72692181D'X,
- +'000000003F69B760'X,'00000FE719FDD9D6'X,'2692175B1A69B796'X,
- +'1965A6DE229669E7'X,'1E8A59A6258DF71A'X,'000000000000003F'X,
- +'1965A71F208E5996'X,'239669A52381F71A'X,'000000003F69B7A0'X,
- +'3F95BFE820FD8817'X,'279E696219FD9655'X,'279E696219FE2966'X,
- +'000000003F662966'X,'1969B75F23967A16'X,'3FA279631F75B699'X,
- +'279A58E019FD9655'X,'00000FD9208E59A7'X,'3F89AFE71AFDA696'X,
- +'000000000003F9DA'X,'3F89AFE71AFDA696'X,'1969B75F23967A16'X,
- +'28A279631F75B699'X,'0000000000FE88FF'X,'3F9D9FE727FD9655'X,
- +'0000000000FE081C'X,'1A6DC7A0228E4918'X,'0000000000000FDA'X,
- +'3F9DEFD927FD9655'X,'00000FE61AFDA696'X,'3F828FE018FD8614'X,
- +'000000000003FA28'X,'3F9E7FE719FD9655'X,'1C6996181969C795'X,
- +'249A7A28279A489E'X,'000000000003F7A2'X,'279E696219FD9655'X,
- +'000000003F662966'X,'1C6996181969C795'X,'249A7A28279A489E'X,
- +'0000003F2787F7A2'X,'279E696219FD9655'X,'0003F9E03F662966'X/
- DATA IX12/
- +'1B69965B1E8A59D6'X,'1B7A2967279A58DD'X,'0000000000000FD9'X,
- +'00000FE719FE0818'X,'279A485F1C699655'X,'0000000000000FE7'X,
- +'00000FE028FE0617'X,'3F960FDB20FDB594'X,'000000000003F96A'X,
- +'00000FD927FE7656'X,'0003F8283F820617'X,'3F9D9FE719FD99D6'X,
- +'3F95BFE820FD8817'X,'279E696219FD9655'X,'279E696219FE2966'X,
- +'000000003F662966'X,'00000FE61AFDA696'X,'3FA18FE820FD8817'X,
- +'3F89AFE71AFDA696'X,'000000000003F9DA'X,'3F9D9FE719FD99D6'X,
- +'3F9D9FE727FD9655'X,'1C6996181969C795'X,'249A7A28279A489E'X,
- +'0000003F2377F7A2'X,'0000000000FE081C'X,'3F9DEFD927FD9655'X,
- +'00000FE820FD8817'X,'3F828FE018FD8614'X,'000000000003FA28'X,
- +'3F9E7FE719FD9655'X,'3F9D9FE31DFE7657'X,'1C6996181969C795'X,
- +'249A7A28279A489E'X,'000000000003F7A2'X,'3F9D9FE727FD9655'X,
- +'279E696219FD9655'X,'000000003F662966'X,'2767F9D93F660657'X,
- +'000000000000003F'X,'00000FE719FE0818'X,'2081F79D1B699657'X,
- +'3F8218A3259A79FF'X,'1A65969B1EFE0816'X,'229669E72696279B'X,
- +'0000000000000FDE'X,'00000FE719FE7656'X,'1C6DA65817FE0815'X,
- +'00FE9A272696485F'X,'217DC6991969D656'X,'0003F9E3269E79A4'X,
- +'3FA18FE818FE0814'X,'0000000000FE081C'X,'268A279E1A69E79A'X/
- DATA IX13/
- +'000000003F7A28A6'X,'26966FE222FDE796'X,'1B69965B1E8A59E7'X,
- +'258DD6D93F9E58DD'X,'1A6596DE229679E6'X,'000000000003F69B'X,
- +'3F82181F20FE081B'X,'3FA1AFE027FDA856'X,'000000000003F9D9'X,
- +'000000003F628614'X,'2696489E1C6DA697'X,'2181F83F20824966'X,
- +'0000000000000FE0'X,'23967A6A2AA68A54'X,'228E4FDC1D7A0862'X,
- +'175965D91B75E7E0'X,'000000000003F5D8'X,'207E0FE02181F81B'X,
- +'000000000003F821'X,'1F821FE02181F81B'X,'0000003F1F821860'X,
- +'000000003FA18A14'X,'3F91DFDE1EFDD759'X,'000000000003F91D'X,
- +'3F8DCFE323FE2899'X,'000000000003F8DC'X,'256FF95B3F6E56D8'X,
- +'000000000000003F'X,'218607DE1E7E0899'X,'218A28601F7E0FDF'X,
- +'3F81F7E0218A285D'X,'2281F79E1F82185F'X,'000000000000003F'X,
- +'1F7E086222860799'X,'1F79E7E021860FE1'X,'3F8218601F79E7E3'X,
- +'1E8218A22181F7E1'X,'000000000000003F'X,'20C3F8163F81748F'X,
- +'000000000000003F'X,'1F75B6581865C814'X,'23967A2827920FE0'X,
- +'22860FDE1F83F821'X,'0000000000FE27BF'X,'1961865B1C79F814'X,
- +'279648A120FE071A'X,'00000FE0249A7A28'X,'299A283F1769E814'X,
- +'208A6A7F2079A5FF'X,'000000000000003F'X,'26A29A6826922814'X,
- +'1F8639242387F864'X,'1869C7FF1F75C71D'X,'1F83F81E1C6985D7'X/
- DATA IX14/
- +'00FE27BF22860FDE'X,'208A49A728A6AA93'X,'207D85D6165D869E'X,
- +'2379C6DB1C7A0861'X,'0000003F2AAA99E5'X,'00000FD927FE7655'X,
- +'1A6DD79E1DFDA998'X,'228A3FE62485D6DA'X,'00000FE3259A6963'X,
- +'2BAEAA67258E2815'X,'196DD7A223967A6A'X,'1E75B65716555597'X,
- +'0000000000000FE0'X,'248E17DD1C71D7DC'X,'1E7BF75D3F7E18E4'X,
- +'3F861FE020FDF7FF'X,'0000003F238FF8A2'X,'3F75DFDC2491C71C'X,
- +'21FE083F1F7FF79E'X,'0003F8E33F8A2FE1'X,'20FDD83F2095B81B'X,
- +'0003F8603F7E0FE3'X,'20FE383F206E581B'X,'0003F7E03F860FDD'X,
- +'2083F8241A99C81A'X,'3F920FDC20FDA83F'X,'000000000003F9A0'X,
- +'17FE3A233F9A9993'X,'0000000000000FE8'X,'20FE581B3F8A0798'X,
- +'0000000000000FE0'X,'18FDD61D3F697693'X,'0000000000000FE9'X,
- +'20FE581B3F8A0798'X,'0000000000000FE0'X,'00FDF8212181F81B'X,
- +'00000FE02181F81B'X,'3F7E0861207E085B'X,'0000000000FD7A55'X,
- +'2281E75D1E822919'X,'0000000000000FE4'X,'1E8228E32281E719'X,
- +'0000000000000FDC'X,'0000000000FE95D3'X,'00000FE917FE0813'X,
- +'00000FE917FE95D3'X,'3F6E5FE51BFE0818'X,'238E281E1D75E81B'X,
- +'000000000003F822'X,'000000003F82079B'X,'3F8DD8A32385F75B'X,
- +'2183F8632385F75B'X,'0000003F1D7E18E3'X,'0003F91C21FE185B'X/
- DATA IX15/
- +'1F8228E2207DD79B'X,'000000003F89EFDD'X,'238A079D1D7A089B'X,
- +'000000003F75E822'X,'00000FE31DFDF8DB'X,'1F8638E11F75D7DB'X,
- +'3F8638E11F75D7FF'X,'238A079D1E8228DB'X,'000000003F7A08A3'X,
- +'1B75F8A426FE6997'X,'00FE69221F75B69A'X,'258E179C1AFDA696'X,
- +'00FDA71E218E59A6'X,'1B69A6DD1F8A4997'X,'0000003F269227DD'X,
- +'1B75F8A426FE6997'X,'00FE69221F75B69A'X,'1B75F8A4259A6697'X,
- +'00FE69221F75B69A'X,'3F91DFE02086395B'X,'26FDD7E224966997'X,
- +'1F75B69A1B75F8A4'X,'0000000000FE6922'X,'2696381E1BFDB6D7'X,
- +'0000000000000FE6'X,'3F820FDF208607DC'X,'20861FE0218A181B'X,
- +'000000000003F71E'X,'3F99FFDB25FDB6D7'X,'0000000000FE081C'X,
- +'207DD69815FD5551'X,'3FAEBAA8258E0FE0'X,'2696381E1BFDB6D7'X,
- +'0000000000000FE6'X,'227DD6DA1A6DD7D7'X,'00FDF8A4269E79A4'X,
- +'258E179C1AFDA696'X,'00FDA71E218E59A6'X,'1B75F8A426FE6997'X,
- +'00FE69221F75B69A'X,'3F96281E1DFDD759'X,'2379C6DC1F8A5998'X,
- +'00FDB71F229669A5'X,'3F91DFE52386081B'X,'26FE68E11E71B6D7'X,
- +'0000000000000FE6'X,'00000FE026FE0698'X,'3F920FDC20FDC615'X,
- +'000000000003F928'X,'00000FDB26FE66D8'X,'1969C7A026FE0698'X,
- +'000000000000003F'X,'3F99BFE61BFDB998'X,'1E71A6591A6DD7D6'X/
- DATA IX16/
- +'238A17FF289E58E0'X,'000000003FA279A5'X,'3F65A6DC1D7E18D7'X,
- +'20FE08E5269E7963'X,'1C75F86324965922'X,'0000000000000FDB'X,
- +'2086181F1D71A617'X,'0003F75E209A7A3F'X,'1E71B69A1B75F897'X,
- +'1F7E08A4259648A0'X,'000000003F9A48A0'X,'3F85E75D1F8A4958'X,
- +'3F96385E1C6DB761'X,'26FE68E01F7E0898'X,'228A179C1B6DC7E2'X,
- +'0000000000FDE7E1'X,'3F69C75D1C6985D6'X,'3F8A59A6248A079C'X,
- +'1C6DB71C1B657595'X,'239669A5248E17DD'X,'0003FA2523860821'X,
- +'3F8E281E1D75E81A'X,'1D7E396627FD9757'X,'3F9238A11F79CFDC'X,
- +'3F6A0FE61E75B658'X,'217DD6DB1CFD7756'X,'299E5924259FF963'X,
- +'0000000000000FEA'X,'259A7FDA1B71D697'X,'000000003F69D823'X,
- +'23FE68E01F7E0898'X,'1E8BF9221F75D7A0'X,'3F7A08A22175B6DC'X,
- +'217DD71B1B71E818'X,'00FE08A4259A6963'X,'17FE696423FDA795'X,
- +'0000000000FE9719'X,'2696385F1D71B6D7'X,'3F5DB71E208A4966'X,
- +'1E71B69A1B75FA57'X,'00FE18E4259648A0'X,'00FE875A18FDE856'X,
- +'1D6DB75D1C6985D6'X,'00000FE7279A489F'X,'1F71A6581865B755'X,
- +'1E82292628A27962'X,'0000000000000FDB'X,'27A3F9E52375B657'X,
- +'000000003F6196E5'X,'1B6DA61615FDC914'X,'29A269221F75B69A'X,
- +'000000000000003F'X,'1D6D96171761A714'X,'289E58E1207E0FDF'X/
- DATA IX17/
- +'0000000000FE69E8'X,'3F95BFE51BFE0818'X,'0000000000FE081E'X,
- +'2066783F209D9819'X,'000000000000003F'X,'24925FE222FDF7D9'X,
- +'3F96475C1C7A3965'X,'1C75F8A42596475C'X,'000000003F71D75C'X,
- +'21820FE121FE081E'X,'000000000003F821'X,'3F91DFE123FDE81B'X,
- +'000000000003F91D'X,'000000003F6E56D8'X,'218608232386079C'X,
- +'0003F82121820FE3'X,'20862926279E6997'X,'1E7E086223FDD79F'X,
- +'00000FDA1A65969C'X,'21820FE02186081E'X,'000000000003F821'X,
- +'20821FE02186081E'X,'0000000000FE0861'X,'000000003F95B958'X,
- +'3F8DEFDF1FFDE79B'X,'000000000003F8DE'X,'3F89DFE222FE185B'X,
- +'000000000003F89D'X,'256FF95B3F95B958'X,'000000000000003F'X,
- +'1E7FF8601E79F85A'X,'1E82185F1EFE087F'X,'1EFE183F1E7E1860'X,
- +'00FE17DE1E821FDF'X,'2287F7E0228A17DB'X,'2281F7E122FE07FF'X,
- +'22FDF83F2285F7E0'X,'00FDF8622281FFE1'X,'20A7F8193F81A5D5'X,
- +'000000000000003F'X,'1657F8A2217DE795'X,'269A58DD1B69A658'X,
- +'1E7FFAD53FAEAA27'X,'000000003F86285F'X,'3F860FDF20FE0818'X,
- +'1C7FF71E1F83F85F'X,'20FE487F248A183F'X,'2483F61A1EFD869C'X,
- +'1D7A0FE8268BFA26'X,'238E283F1D7A0FDD'X,'000000003F8E283F'X,
- +'3F820FE020FE0818'X,'20FE17FF2183F7E0'X,'2281EFE22183F79F'X/
- DATA IX18/
- +'2592283F1B71E83F'X,'1C7A0FE42281E73F'X,'279A48A03F69965A'X,
- +'20FE48A01E73F9A7'X,'20FDA6181969B75E'X,'1BFE6A28279A58E2'X,
- +'000000003F96381D'X,'3F85FFE120FDF818'X,'27A2796728A268E0'X,
- +'1B75C75F218E48E5'X,'2075A618196D9619'X,'000000000000003F'X,
- +'1D71C760218A391A'X,'2385F75D1E821860'X,'0000000000000FE4'X,
- +'00000FDD23FE375B'X,'1A76192629AABAD7'X,'299A485D1A6175D8'X,
- +'0000000000FEBAEA'X,'1C79F86224967A16'X,'217DE71B1961865B'X,
- +'00000FE8289E5922'X,'217DC6991969C7D9'X,'00FDF864269E79A4'X,
- +'00000FDA2699A69A'X,'0000003F209D9819'X,'00000FE02681A81A'X,
- +'288E581B1D61E818'X,'000000000003F822'X,'23963FE2239A3897'X,
- +'0000000000FE56BF'X,'3F8E281E1DFE081B'X,'0000000000FE281E'X,
- +'1D6DDFDE1D69D797'X,'0000000000FE66FF'X,'3F8E281E1DFE081B'X,
- +'0000000000FE281E'X,'0003F8212182085E'X,'00000FE02186081E'X,
- +'0003F8212182085E'X,'0000000000FDC91B'X,'0003F8A01F7E089D'X,
- +'0003F7A02186079C'X,'0000000000FE471A'X,'00000FE41CFE081A'X,
- +'00000FE41CFE471A'X,'3F763FE31DFE081B'X/
- DATA IY11/
- +'29A689601D61552A'X,'00FD451518760968'X,'0000003F2951762A'X,
- +'185955141559866A'X,'0000003F29A5F71A'X,'268E179D1C71452A'X,
- +'00000FE527A29A68'X,'0003FA54208A252A'X,'2179C6DB1C75452A'X,
- +'00FE59E829A689A3'X,'2689D615145155EA'X,'1C75F8A326A29A68'X,
- +'000000003F89F75C'X,'00000FD41482952A'X,'2079D71B195D552A'X,
- +'22967A2929A27962'X,'145155D91B71D7A0'X,'000000000000003F'X,
- +'1A6DE8212181E6EA'X,'289606D715514557'X,'000000003F9A8A69'X,
- +'3F8A282914829529'X,'1A6165541482952A'X,'258A07DE1E81E75C'X,
- +'000000003FA69A27'X,'1C6575541455766B'X,'3F926A2929A26921'X,
- +'1C6575541482952A'X,'00000FE929A26921'X,'2079E81414829529'X,
- +'000000000003FA69'X,'3F79E81414829528'X,'1C6575541455766B'X,
- +'21926A2929A26921'X,'0000000000FE1860'X,'3F79E8291482952B'X,
- +'0000000000FE9524'X,'249E8A69289E4528'X,'0000000000000FE2'X,
- +'3FA5D8221482952A'X,'00000FE929829527'X,'20A548291482952C'X,
- +'000000000003FA54'X,'3FA548291482952B'X,'289A485C195D552B'X,
- +'155D9721249A8A69'X,'000000000003F514'X,'1B6165541482952A'X,
- +'000000003F7DF79D'X,'289A485C195D552B'X,'155D9721249A8A69'X,
- +'0000003F2B960514'X,'1A6165541482952A'X,'0003FA5E2079E75C'X/
- DATA IY12/
- +'1C6D95D5145155EA'X,'28A69A26238607DD'X,'0000000000000FE6'X,
- +'00000FD414829528'X,'239A8A69289A352B'X,'0000000000000FD4'X,
- +'00000FE914829529'X,'20A548291482952C'X,'000000000003FA54'X,
- +'00000FE91482952A'X,'0003F79420A5E529'X,'3FA698141482952A'X,
- +'3F8A282914829529'X,'1A6165541482952A'X,'258A07DE1E81E75C'X,
- +'000000003FA69A27'X,'00000FD414829527'X,'3FA6982914829529'X,
- +'2079E81414829529'X,'000000000003FA69'X,'3FA698141482952A'X,
- +'3F79E8291482952B'X,'289A485C195D552B'X,'155D9721249A8A69'X,
- +'0000003F1E7A0514'X,'0000000000FE9524'X,'3FA5D8221482952A'X,
- +'00000FE914829529'X,'20A548291482952C'X,'000000000003FA54'X,
- +'3FA548291482952B'X,'3FA6981E1E814529'X,'289A485C195D552B'X,
- +'155D9721249A8A69'X,'000000000003F514'X,'3F5148291482952B'X,
- +'1B6165541482952A'X,'000000003F7DF79D'X,'29A6051420A5E529'X,
- +'000000000000003F'X,'00000FD414829528'X,'296D755414557669'X,
- +'3F6D755414557660'X,'2281D6DA1982952A'X,'1969B760228E4923'X,
- +'0000000000000FD9'X,'00000FD42982952A'X,'2285F6DA1A82952B'X,
- +'00FDA69B1F8628E3'X,'145155DA1E8A9A6A'X,'0003FA692279A5D5'X,
- +'3FA698202082962C'X,'0000000000FF0424'X,'228A69A22279E6A6'X/
- DATA IY13/
- +'000000003F69A79E'X,'1961782D1082D42A'X,'1C6D95D5145155D8'X,
- +'1F79C6D9208A07DD'X,'24966A2929A268A0'X,'000000000003F9A5'X,
- +'3F9E8A6827822525'X,'2075D8301083042B'X,'000000000003F8E3'X,
- +'000000003FA605EC'X,'1859551415598669'X,'28A689E0227DD71A'X,
- +'0000000000000FE7'X,'13450411124D246C'X,'1851282E2CA1C615'X,
- +'2DBAFC302FB6BA24'X,'000000000003FBEE'X,'29A2781B1C75C6E5'X,
- +'000000000003F9E8'X,'28A6881B1C75C6E5'X,'0000003F2DB2AA27'X,
- +'000000003FA605EC'X,'2041083010830427'X,'000000000003FC30'X,
- +'2041083010830427'X,'000000000003FC30'X,'269A08A22085D668'X,
- +'000000000000003F'X,'1D6D961614491427'X,'1E71A617154D181F'X,
- +'20BEDAE9289A48A0'X,'30BEEB2A289E58E1'X,'000000000000003F'X,
- +'1D6D961614491427'X,'1E71A617154D181F'X,'20BEDAE9289A48A0'X,
- +'30BEEB2A289E58E1'X,'000000000000003F'X,'29220A5C209DB6F0'X,
- +'000000000000003F'X,'259A69632179A5AC'X,'269A58E11E696823'X,
- +'2A9E382A278E08E5'X,'0000000000FEAAA0'X,'207595D6165D972C'X,
- +'175965D91C82A962'X,'00000FEA258A0759'X,'207585602075856C'X,
- +'2BA238202BA23820'X,'000000000000003F'X,'1E7E18E5269A58AC'X,
- +'1659765B1D7E07DE'X,'1F79E7E01F75B657'X,'278A08A5269A58E1'X/
- DATA IY14/
- +'00FEAAA02A9E282A'X,'289A379C1B6DC76D'X,'1B720863259E8A69'X,
- +'267DC657155155D9'X,'0000003F27A29A68'X,'00000FE71982766B'X,
- +'1C75D71A19826668'X,'258E28191A69965A'X,'00000FE2228E59A6'X,
- +'1F8639252592382B'X,'259648DD1C6DB71D'X,'1D71B6DC1D7E18E4'X,
- +'0000000000000FE0'X,'218E4923217DD724'X,'227A085F2071C75F'X,
- +'208DD8231D823760'X,'0000003F217E089E'X,'208DD81C1C924724'X,
- +'1D823760237608DD'X,'0003F8DD208DD823'X,'1D8227601A8E36A5'X,
- +'0003F8A0208A0822'X,'2381E8E02675D9A5'X,'0003F7A0207A081E'X,
- +'1A8206A51E7A56A6'X,'209608252081E820'X,'000000000003F7A0'X,
- +'2082581B208A07AD'X,'0000000000000FE0'X,'1881D61D206976A8'X,
- +'0000000000000FE9'X,'2082581B208A07AD'X,'0000000000000FE0'X,
- +'17823A23209A99A8'X,'0000000000000FE8'X,'00FDA657155155A5'X,
- +'00000FE728A689E5'X,'3FB6CAA827A29A25'X,'0000000000FF042B'X,
- +'2EAE789E19552427'X,'0000000000000FF0'X,'2EAE789E19552427'X,
- +'0000000000000FF0'X,'0000000000FE082D'X,'00000FE0208295ED'X,
- +'00000FE32381D76D'X,'3F8DD8231D8266A8'X,'1E8639232179C6E5'X,
- +'000000000003F6DC'X,'000000003F91B765'X,'3F92481E1C6DB725'X,
- +'1F7E07DE1C6DB725'X,'0000003F239248E0'X,'0003F8611B8246E5'X/
- DATA IY15/
- +'2492385F1E79F6E5'X,'000000003F6DB823'X,'218E48E11E71B6E5'X,
- +'000000003F85F79F'X,'00000FDB1B8246E5'X,'1B6DC79F1F79C6E5'X,
- +'3F7E08E4248E07E0'X,'1E71B71E208607A5'X,'000000003F9248E1'X,
- +'1E71B6DC1E8296EA'X,'00FE6A2929A268E1'X,'1E71B6DC1E829529'X,
- +'00FE6A2929A268E1'X,'268E179C1B6DC7A9'X,'0000003F26A29A68'X,
- +'1E71B6DC1E82952A'X,'00FE6A2929A268E1'X,'1E71B6DC1D7E1869'X,
- +'00FE6A2929A268E1'X,'3F6DB82918554527'X,'1E82FC302FBAB6EA'X,
- +'29A268E11E71B6DC'X,'0000000000FE6A29'X,'1F71B6DC1F82952A'X,
- +'0000000000000FE9'X,'3FA5B81413515524'X,'2FB1B81413515525'X,
- +'000000000003FC30'X,'3FA618251B829528'X,'0000000000FE9524'X,
- +'1F71B6DC1F8296EF'X,'3FA5F71B1B71F829'X,'1F71B6DC1F8296EA'X,
- +'0000000000000FE9'X,'29A689A32179C6EA'X,'00FDB6DC1E8639A8'X,
- +'1E71B6DC1E8306E9'X,'00FE6A2929A268E1'X,'1E71B6DC1E8306EA'X,
- +'00FE6A2929A268E1'X,'3F6DB71E218296E6'X,'2286079C1B6DC7A9'X,
- +'00FE6A2929A26963'X,'3F6DB82929A25527'X,'1B825A2929A256EA'X,
- +'0000000000000FE9'X,'00000FE91B8296E8'X,'20A5B8291B8296EB'X,
- +'000000000003FA5B'X,'00000FE91B8296E9'X,'30C2FB691B8296E8'X,
- +'000000000000003F'X,'3FA6981B1B8296E9'X,'29A689A32079C6EB'X/
- DATA IY16/
- +'1E71B6E01B7A2968'X,'000000003FA69A26'X,'20C2889E1B5D552A'X,
- +'1D81D75C1B656514'X,'27A29A682796281E'X,'0000000000000FE4'X,
- +'2992075C1B6DC7AA'X,'0003FC2D2981E6E0'X,'29A279211E71B6E9'X,
- +'155D96DD208E6A29'X,'000000003F5D5514'X,'2086079C1B6DC768'X,
- +'3F9A8A69289A48A1'X,'1981965817595527'X,'2FB6BA67258E075B'X,
- +'0000000000FEEC30'X,'20A6279C1B6DD7EA'X,'3FC2581D1B6DC7A2'X,
- +'289A379C1B6DD7EA'X,'145586E023968A69'X,'0003F8A01E6D8594'X,
- +'3F967A69289A26E5'X,'2181C6DB1C8296E9'X,'3FA29A68238A1821'X,
- +'3FA5B82916554528'X,'28A699E41F8306EB'X,'27A69A26226E08A6'X,
- +'0000000000000FE5'X,'2079B8292685B6E9'X,'000000003FA689A3'X,
- +'1981965817595528'X,'238A08A2217DD6DA'X,'3FC30BED2CAA89A4'X,
- +'29A689E42179C6E9'X,'00FDB6DC1D8239A8'X,'1E8299A11B8296EB'X,
- +'0000000000FDB6DC'X,'239A8A69289E4869'X,'3FC2179C1B6DC760'X,
- +'29A279211E71B6EB'X,'00FDB71D208E6A29'X,'00FDB6DC1E8296EA'X,
- +'299E479C1B6DD7EA'X,'00000FDB1E8A6A29'X,'29A689E5227DD72B'X,
- +'2685D6DB1D8239A8'X,'0000000000000FF0'X,'1D6E0C302E75B6E9'X,
- +'000000003FC2EAE0'X,'1E71B6DD1F83052B'X,'1B7A39A829A689A3'X,
- +'000000000000003F'X,'28A69A25227DC6EB'X,'22968A6928961825'X/
- DATA IY17/
- +'0000000000FDB71F'X,'3F9A6820208266E8'X,'0000000000FE56A2'X,
- +'2871CA2018924627'X,'000000000000003F'X,'1B69A82A1682A5A8'X,
- +'208A179C1A65969B'X,'249669A5248A075C'X,'000000003F9248E3'X,
- +'249238201B8206E3'X,'000000000003F8E3'X,'2079E8251A8256A6'X,
- +'000000000003F861'X,'000000003F9A06A8'X,'1F8207DE1C6DB725'X,
- +'0003F8E32492381E'X,'1D698596176185E9'X,'289A3759178299E3'X,
- +'00000FE928A29AAA'X,'2492381E1E7DF7A3'X,'000000000003F8E3'X,
- +'2392481E1E7DF7A3'X,'0000000000FE7963'X,'000000003F9A06A8'X,
- +'2059682A1682A5A5'X,'000000000003FAAA'X,'2059682A1682A5A5'X,
- +'000000000003FAAA'X,'269A08A22085D668'X,'000000000000003F'X,
- +'1A5E079C1A6175A5'X,'207DE71A1881F720'X,'26824860289A48A1'X,
- +'00FEAA6826922829'X,'1A5E079C1A6175A6'X,'207DE71A1881F720'X,
- +'26824860289A48A1'X,'00FEAA6826922829'X,'2652099D2095D769'X,
- +'000000000000003F'X,'26A205D5145155EB'X,'1E6585D71865E8A4'X,
- +'29A20A2820A26922'X,'000000003FA29AAA'X,'20AA182A218216E8'X,
- +'15620556186E0AAA'X,'1B815620155986E0'X,'196E06DA1A81B659'X,
- +'1D71B81B1A6A06D9'X,'2075C6E02075B820'X,'000000003F81D6E0'X,
- +'208E181E1C8195E8'X,'1582AAA02A9E0AA7'X,'185D881817560617'X/
- DATA IY18/
- +'1C75C6601C75C660'X,'2285E81D1D71D760'X,'208A285E208A1822'X,
- +'238228A1228A08A1'X,'238289E527A289E6'X,'288289E527A289E6'X,
- +'000000003FA289E8'X,'20AAA82A2782A9E8'X,'1B7608A2239A8A27'X,
- +'1A6D8595155986DA'X,'27A289A3228A075B'X,'000000000000003F'X,
- +'2086392423860826'X,'248E179C1B6DC79F'X,'0000000000000FE4'X,
- +'00000FE31D823765'X,'1D71C75E218E6A2B'X,'1F8A3924238A17DE'X,
- +'0000000000FD869D'X,'1C75E862238E282A'X,'1E8628E32281F75C'X,
- +'00000FE01F75C71D'X,'279E69211F71A667'X,'00FD965A1C7E1926'X,
- +'00000FDA1A9A66A6'X,'0000003F18924627'X,'00000FD620AA05A6'X,
- +'1D8678E72175D5E8'X,'000000000003F5DD'X,'2281E8232281E769'X,
- +'0000000000FE0820'X,'2079D69D1E8266E5'X,'0000000000FDD6DD'X,
- +'2281E8232281E769'X,'0000000000FE0820'X,'208A39A3228256A5'X,
- +'0000000000FE3963'X,'0003F7DD1B6DC723'X,'00000FE3239248E3'X,
- +'0003F9E5238E4923'X,'0000000000FE56A5'X,'0003F9632179C6A4'X,
- +'0003F9632179C6A3'X,'0000000000FE0826'X,'00000FE020824726'X,
- +'00000FE22281E7A6'X,'3F89E8221E823765'X/
- DATA ISTART/
- + 1, 3, 4, 6, 8, 9, 11, 14, 15, 19, 22, 23, 26, 28, 30,
- + 32, 33, 36, 37, 38, 40, 41, 42, 44, 45, 48, 50, 53, 55, 58,
- + 59, 61, 62, 64, 65, 66, 67, 68, 71, 72, 73, 75, 76, 77, 80,
- + 81, 82, 83, 85, 86, 87, 90, 91, 93, 95, 96, 98,101,102,104,
- +106,107,108,110,115,116,118,119,122,126,128,130,131,133,135,
- +137,142,147,149,153,156,159,164,168,169,172,176,180,183,185,
- +187,190,192,194,196,198,199,200,201,202,204,206,207,208,209,
- +210,212,213,214,216,217,219,221,222,224,226,228,230,232,234,
- +236,237,240,242,243,245,246,247,249,251,253,255,257,258,260,
- +261,263,264,266,267,269,270,273,277,279,282,284,287,289,292,
- +293,295,296,299,301,304,306,308,310,312,313,315,318,320,323,
- +326,327,328,330,334,336,338,339,341,344,346,348,349,351,353,
- +355,359,363,365,369,376,386,391,394,395,398,401,403,404,405,
- +406,408,410,412,414,416,417,418,419,420,421,422,423,424,425/
-*
- DATA NBIT,NBITCH,NBITMX/64,8,60/
-#endif
-#if defined(CERNLIB_CRAY)
- DATA IX11/
- +41373432313132343726B,00773741444647474644B,00000000774141363426B,
- +46454442363433323226B,00000000774731434546B,46474746454340463326B,
- +00000077313233364144B,00007743437750314326B,47464441363332334526B,
- +00773132333641444647B,33323233354042454626B,41444647474644414035B,
- +00000000007732333540B,00000077473177354726B,46444135333232333626B,
- +31313233364245464747B,36424546464543373432B,00000000000000000077B,
- +31313234374043454626B,43454646454340373432B,00000000007732333640B,
- +77453377504077304027B,47474645423177313125B,47474645423177424546B,
- +00000000007731424546B,31323335374345475026B,77504745433735333231B,
- +47464543403177313125B,00000077314043454647B,77423277473277323226B,
- +00000000000000774732B,77423277473277323226B,31323335374345475026B,
- +50504745433735333231B,00000000000077504377B,77473177474777313125B,
- +00000000000077404034B,32333436404243444430B,00000000000000007732B,
- +77473677314777313125B,00000077463277323226B,77405077403077303024B,
- +00000000000000775050B,77474777473177313125B,34323130303132343625B,
- +44464750504746444236B,00000000000000773642B,47474645423177313125B,
- +00000000007731424546B,34323130303132343625B,44464750504746444236B,
- +00000000774741773642B,47474645423177313125B,00007747407731424546B/
- DATA IX12/
- +33323131333642454726B,33364245474746454335B,00000000000000007731B,
- +00000077473177404030B,47464441373432313125B,00000000000000007747B,
- +00000077405077403027B,77454077334077332624B,00000000000000774552B,
- +00000077314777473126B,00007740507740403027B,77473177473177314726B,
- +77453377504077304027B,47474645423177313125B,47474645423177424546B,
- +00000000007731424546B,00000077463277323226B,77503077504077304027B,
- +77423277473277323226B,00000000000000774732B,77473177473177314726B,
- +77473177474777313125B,34323130303132343625B,44464750504746444236B,
- +00000000774335773642B,00000000000077404034B,77473677314777313125B,
- +00000077504077304027B,77405077403077303024B,00000000000000775050B,
- +77474777473177313125B,77473177433577473127B,34323130303132343625B,
- +44464750504746444236B,00000000000000773642B,77473177474777313125B,
- +47474645423177313125B,00000000007731424546B,47317747317731403127B,
- +00000000000000000077B,00000077473177404030B,40403736353332313127B,
- +77404142434546474777B,32313132333677404026B,42454647474645423633B,
- +00000000000000007736B,00000077473177473126B,34333231302777404025B,
- +00775150474645444137B,41373432313132353126B,00007747434647474644B,
- +77503077503077404024B,00000000000077404034B,46424236363232363632B/
- DATA IX13/
- +00000000007736424246B,46454677424277363626B,33323131333642454747B,
- +45433533317747454335B,32313133364245474746B,00000000000000773233B,
- +77404140374077404033B,77503277404777324126B,00000000000000774731B,
- +00000000007730503024B,46454442363433323227B,41403740774040444546B,
- +00000000000000007740B,43454751525251505124B,42434477343536404142B,
- +27262627313335363740B,00000000000000772730B,40374077404140374033B,
- +00000000000000774041B,37404177404140374033B,00000000773740414140B,
- +00000000007750305024B,77443577363677353531B,00000000000000774435B,
- +77433477434377424231B,00000000000000774334B,45337745337733453330B,
- +00000000000000000077B,41414037363637404231B,41424241403737407737B,
- +77403737404142424135B,42403736363740414137B,00000000000000000077B,
- +37374041424241403631B,37363637404141407741B,77404141403736363743B,
- +36404142424140373741B,00000000000000000077B,40607740267740272217B,
- +00000000000000000077B,37353331303031344024B,43454750504744407740B,
- +42414077363740774041B,00000000000077423677B,31303031333436374024B,
- +47454442414077403432B,00000077404446475050B,51464240772732364024B,
- +40424651774036322777B,00000000000000000077B,46505151504644424024B,
- +37414344444341774144B,30323437773735343435B,37407740363432302727B/
- DATA IX14/
- +00774236774241407736B,40424446475051525223B,40373027262627303236B,
- +43363433333436404141B,00000000775252514745B,00000077314777473125B,
- +32333536363577324630B,42424377464441353332B,00000077434546464543B,
- +53535251474543424025B,31333536424345475152B,36353331272625252627B,
- +00000000000000007740B,44434137353434353734B,36367735357737414344B,
- +77414177404077373777B,00000000774343774242B,77353577344444343434B,
- +41774040773737773636B,00007743437742427741B,40773540774045334033B,
- +00007741407737407743B,40774340774033454033B,00007737407741407735B,
- +40407740443246344032B,77444077344077324077B,00000000000000774640B,
- +27774350437746514623B,00000000000000007750B,40774540337742403630B,
- +00000000000000007740B,30773530357732273223B,00000000000000007751B,
- +40774540337742403630B,00000000000000007740B,00773740414140374033B,
- +00000077404140374033B,77374041414037404133B,00000000000077275125B,
- +42403635353640424431B,00000000000000007744B,36404243434240363431B,
- +00000000000000007734B,00000000000077512723B,00000077512777404023B,
- +00000077512777512723B,77334577453377404030B,43434240363535364033B,
- +00000000000000774042B,00000000007740403633B,77433542434341373533B,
- +41407741434341373533B,00000000773537414343B,00007744344177414133B/
- DATA IX15/
- +37404243424037353633B,00000000007742367735B,43424036353536404233B,
- +00000000007735364042B,00000077433577374333B,37414343413735353733B,
- +77414343413735353777B,43424036353640424333B,00000000007736404243B,
- +33353742444677464627B,00774644423735333232B,45434136343277323226B,
- +00773234364143454646B,33323233353742444627B,00000000774644423735B,
- +33353742444677464627B,00774644423735333232B,33353742444546463227B,
- +00774644423735333232B,77443577404041434533B,46773537424445464627B,
- +37353332323335374244B,00000000000077464442B,46454340363377333327B,
- +00000000000000007746B,77404077374041403734B,40414177404142414033B,
- +00000000000000773436B,77463777334577333327B,00000000000077404034B,
- +40373532302577252521B,77535352504543407740B,46454340363377333327B,
- +00000000000000007746B,42373533323233353727B,00773742444647474644B,
- +45434136343277323226B,00773234364143454646B,33353742444677464627B,
- +00774644423735333232B,77454240363577353531B,43363433343742454630B,
- +00773334374245464645B,77443577454341404033B,46774643413634333327B,
- +00000000000000007746B,00000077404677403230B,77444077344077343025B,
- +00000000000000774450B,00000077334677463330B,31323436404677403230B,
- +00000000000000000077B,77463377463377334630B,36343231313233353726B/
- DATA IX16/
- +43424137775047454340B,00000000007750474645B,77313233343537414327B,
- +40774043454647474543B,34353741434445454442B,00000000000000007733B,
- +40414140373534323027B,00007735364046475077B,36343332323335374227B,
- +37374042444545444240B,00000000007746444240B,77413635353742444530B,
- +77454341363433333541B,46774643403737404230B,42424136343333343742B,
- +00000000000077363741B,77323435353432302726B,77424546464442403634B,
- +34333334343331272625B,43454646454443413735B,00007750454341404041B,
- +77434240363535364032B,35374345464777313527B,77444342413736347734B,
- +77324077463635333130B,41373533333477273526B,51474544444547774543B,
- +00000000000000007752B,45464777323334353227B,00000000007732354043B,
- +43774643403737404230B,36427744423735353640B,77364042424135333334B,
- +41373534333334364030B,00774042444546464543B,27774645444377323625B,
- +00000000000077513431B,46454341373534333327B,77273334364042444546B,
- +36343332323335375127B,00774143444545444240B,00775035323077364126B,
- +35333335353432302726B,00000077474746444237B,37343231303031333525B,
- +36404244465050474542B,00000000000000007733B,47507747454335333127B,
- +00000000007730313345B,33333230262577344424B,51504644423735333232B,
- +00000000000000000077B,35333130272730323424B,50474543414037407737B/
- DATA IX17/
- +00000000000077464750B,77453377453377404030B,00000000000077404036B,
- +40314740774047314031B,00000000000000000077B,44444577424277373731B,
- +77454435343436434545B,34353742444545443534B,00000000007734353534B,
- +41404077414177404036B,00000000000000774041B,77443577414377364033B,
- +00000000000000774435B,00000000007733453330B,41414040434341403634B,
- +00007740414140407743B,40414244464747464627B,36374041424377353637B,
- +00000077323231313234B,41404077404141404036B,00000000000000774041B,
- +40404177404141404036B,00000000000077404141B,00000000007745334530B,
- +77433677373777363633B,00000000000000774336B,77423577424277414133B,
- +00000000000000774235B,45337745337745334530B,00000000000000000077B,
- +36377741403636374132B,36404141373677404177B,36774140773637414140B,
- +00774137363640417737B,42417737404242413733B,42403737414277403777B,
- +42773740774241373740B,00773741424240377741B,40517740317740322725B,
- +00000000000000000077B,26257742424137363625B,46464543353332323130B,
- +36377753257753525047B,00000000007741424137B,77414077374077404030B,
- +34377734363740774137B,40774441774442414077B,44407730323677303234B,
- +35364077504642775046B,43434240773536407735B,00000000007743424077B,
- +77404077404077404030B,40774137774140773740B,42403677424140773637B/
- DATA IX18/
- +45444240773334364077B,34364077444240363477B,47464442407732313132B,
- +40774442403634774647B,40773230303132333536B,33774650504746454342B,
- +00000000007745434035B,77413777414077374030B,47504745475050464340B,
- +33353435374143444345B,40353230303133313031B,00000000000000000077B,
- +35343435404142434432B,43413735353640414140B,00000000000000007744B,
- +00000077354377433533B,32354144465152535327B,51464441353230272730B,
- +00000000000077535352B,34363741424445475026B,41373634333130303133B,
- +00000077505047454442B,41373432313132343731B,00773741444647474644B,
- +00000077324646323232B,00000000774047314031B,00000077404640324032B,
- +50434540333530364030B,00000000000000774042B,43454377424346434227B,
- +00000000000077453277B,77434240363577404033B,00000000000077424036B,
- +35333577363532353627B,00000000000077463377B,77434240363577404033B,
- +00000000000077424036B,00007740414140404136B,00000077404141404036B,
- +00007740414140404136B,00000000000077344433B,00007742403737404235B,
- +00007736404141403634B,00000000000077443432B,00000077443477404032B,
- +00000077443477443432B,77354377433577404033B/
- DATA IY11/
- +51515045403530252452B,00772424253035404550B,00000000775124273052B,
- +30262524242526303152B,00000000775151373432B,46434136353434242452B,
- +00000077454750515150B,00007751244042422452B,41363433333435242452B,
- +00774547505151504643B,46423530252424252752B,34353742434650515150B,
- +00000000007742373534B,00000077242440512452B,40363534333127252452B,
- +42454750515150474542B,24242527313334353640B,00000000000000000077B,
- +32333640414140363352B,50454033272524242527B,00000000007746505151B,
- +77424240512440512451B,32302625242440512452B,45424037363640363534B,
- +00000000007751515047B,34312725242425273153B,77444650515150464441B,
- +34312725242440512452B,00000077515150464441B,40363640242440512451B,
- +00000000000000775151B,77363640242440512450B,34312725242425273153B,
- +41444650515150464441B,00000000000077414140B,77363640512440512453B,
- +00000000000077512444B,44475051515047442450B,00000000000000007742B,
- +77513540422440512452B,00000077515140512447B,40512440512440512454B,
- +00000000000000775124B,77512440512440512453B,50464441343127252453B,
- +25273134414446505151B,00000000000000772424B,33302625242440512452B,
- +00000000007737373635B,50464441343127252453B,25273134414446505151B,
- +00000000775345402424B,32302625242440512452B,00007751364036363534B/
- DATA IY12/
- +34333127252424252752B,50515150464341403735B,00000000000000007746B,
- +00000077242440512450B,43465051515046432453B,00000000000000007724B,
- +00000077512440512451B,40512440512440512454B,00000000000000775124B,
- +00000077512440512452B,00007736244051362451B,77515140242440512452B,
- +77424240512440512451B,32302625242440512452B,45424037363640363534B,
- +00000000007751515047B,00000077242440512447B,77515140512440512451B,
- +40363640242440512451B,00000000000000775151B,77515140242440512452B,
- +77363640512440512453B,50464441343127252453B,25273134414446505151B,
- +00000000773636402424B,00000000000077512444B,77513540422440512452B,
- +00000077512440512451B,40512440512440512454B,00000000000000775124B,
- +77512440512440512453B,77515140363640242451B,50464441343127252453B,
- +25273134414446505151B,00000000000000772424B,77242440512440512453B,
- +33302625242440512452B,00000000007737373635B,51514024244051362451B,
- +00000000000000000077B,00000077242440512450B,51332725242425273151B,
- +77332725242425273140B,42403533323140512452B,31323335404243444443B,
- +00000000000000007731B,00000077245140512452B,42413733323240512453B,
- +00773232333741424343B,24242527323642515152B,00007751514236322725B,
- +77515140404040513054B,00000000000077602044B,42424646424236363246B/
- DATA IY13/
- +00000000007732323636B,31302740552040552052B,34333127252424252730B,
- +37363433314042403735B,44454650515150464240B,00000000000000774645B,
- +77475051504740422445B,40353540602040602053B,00000000000000774343B,
- +00000000007751402754B,30262524242526303151B,50515047404237353432B,
- +00000000000000007747B,23212020212223222154B,30242240565450343025B,
- +55565760605755535044B,00000000000000775756B,51504740333435343345B,
- +00000000000000774750B,50515040333435343345B,00000000775554525047B,
- +00000000007751402754B,40202040602040602047B,00000000000000776060B,
- +40202040602040602047B,00000000000000776060B,46464042424041353150B,
- +00000000000000000077B,35333130262422212047B,36343230272523214037B,
- +40575553515046444240B,60575654525047454341B,00000000000000000077B,
- +35333130262422212047B,36343230272523214037B,40575553515046444240B,
- +60575654525047454341B,00000000000000000077B,51104051344047333360B,
- +00000000000000000077B,45464645434136322654B,46464543413632264043B,
- +52474340524743404345B,00000000000077525240B,40353127262627313454B,
- +27262627313440524542B,00000077524542403531B,40353025404035302554B,
- +53504340405350434040B,00000000000000000077B,36374143454646454254B,
- +26262731333537403736B,37363637403735333127B,47424042454646454341B/
- DATA IY14/
- +00775252405247424052B,50464336343333343555B,33344041434547505151B,
- +46373431272524252731B,00000000774750515150B,00000077473140473153B,
- +34353534323140463150B,45434240313232313132B,00000077424243454646B,
- +37414344454544434053B,45454443353433333435B,35343333343537414344B,
- +00000000000000007740B,41434444434137353444B,42364041374034343537B,
- +40433540433540433540B,00000000774137404236B,40433540343444443444B,
- +35404335404335404335B,00007743354043354043B,35404235403243433245B,
- +00007742404042404042B,43403643404635354645B,00007736404036404036B,
- +32404032453636453246B,40454040454040364040B,00000000000000773640B,
- +40404540334042403655B,00000000000000007740B,30403530354032273250B,
- +00000000000000007751B,40404540334042403655B,00000000000000007740B,
- +27404350434046514650B,00000000000000007750B,00773231272524252645B,
- +00000077475051504745B,77555452504750515045B,00000000000077602053B,
- +56534742363125222047B,00000000000000007760B,56534742363125222047B,
- +00000000000000007760B,00000000000077404055B,00000077404040512755B,
- +00000077434340353555B,77433540433540463250B,36414344434136343345B,
- +00000000000000773334B,00000000007744333545B,77444440363433333445B,
- +37374037363433333445B,00000000774344444340B,00007741413340443345B/
- DATA IY15/
- +44444341373636373345B,00000000007733334043B,41434443413634333345B,
- +00000000007741373637B,00000077333340443345B,33333436373736343345B,
- +77374043444443403740B,36343334364041403645B,00000000007744444341B,
- +36343333343640513352B,00774650515150464341B,36343333343640512451B,
- +00774650515150464341B,46434136343333343651B,00000000774650515150B,
- +36343333343640512452B,00774650515150464341B,36343333343537414151B,
- +00774650515150464341B,77333340513025242447B,36405760605756533352B,
- +51504643413634333334B,00000000000077465051B,37343333343740512452B,
- +00000000000000007751B,77513340242324252444B,57543340242324252445B,
- +00000000000000776060B,77514140453340512450B,00000000000077512444B,
- +37343333343740513357B,77513734333334374051B,37343333343740513352B,
- +00000000000000007751B,51515046434136343352B,00773333343641434650B,
- +36343333343640603351B,00774650515150464341B,36343333343640603352B,
- +00774650515150464341B,77333334364140513346B,42414036343333343651B,
- +00774650515150464543B,77333340515150452447B,33404550515150453352B,
- +00000000000000007751B,00000077513340513350B,40513340513340513353B,
- +00000000000000775133B,00000077513340513351B,60605755513340513350B,
- +00000000000000000077B,77515140333340513351B,51515046434036343353B/
- DATA IY16/
- +36343333403336424550B,00000000007751515046B,40605042363327252452B,
- +35403535343331262424B,47505151504745424036B,00000000000000007744B,
- +51444035343333343652B,00007760555140363340B,51504744413634333351B,
- +25273133354043465051B,00000000007727252424B,40414036343333343550B,
- +77465051515046444241B,31403131302726252447B,57555351474543403533B,
- +00000000000077566060B,40514236343333353752B,77604540353333343642B,
- +50464336343333353752B,24253033404345505151B,00007742403633302624B,
- +77454751515046423345B,41403433333440513351B,77505151504342414041B,
- +77513340512625242450B,50515147443740603353B,47515150464233404246B,
- +00000000000000007745B,40363340514641333351B,00000000007751504643B,
- +31403131302726252450B,43424042424137353332B,77606057555452504644B,
- +51515047444136343351B,00773333343540434650B,36405146413340513353B,
- +00000000000077333334B,43465051515047444151B,77604136343333343540B,
- +51504744413634333353B,00773334354043465051B,00773333343640513352B,
- +51474436343333353752B,00000077333642465051B,51515047454237353453B,
- +46413533333540434650B,00000000000000007760B,35334060605635333351B,
- +00000000007760565340B,36343333353740602453B,33364346505151504643B,
- +00000000000000000077B,50515150454237343353B,42455051515045414045B/
- DATA IY17/
- +00000000000077333437B,77464640404040463350B,00000000000077453242B,
- +50343450403044443047B,00000000000000000077B,33323240522640522650B,
- +40424136343231313233B,44454646454442403534B,00000000007744444343B,
- +44444340403340403343B,00000000000000774343B,40363640453240453246B,
- +00000000000000774141B,00000000007746403250B,37404037363433333445B,
- +00007743434444434036B,35323026262730302751B,50464335312740514743B,
- +00000077515050515252B,44444340363637373643B,00000000000000774343B,
- +43444440363637373643B,00000000000077474543B,00000000007746403250B,
- +40262640522640522645B,00000000000000775252B,40262640522640522645B,
- +00000000000000775252B,46464042424041353150B,00000000000000000077B,
- +32274036343230272645B,40373634323040373440B,46404441405046444241B,
- +00775251504644424051B,32274036343230272646B,40373634323040373440B,
- +46404441405046444241B,00775251504644424051B,46244046354045353551B,
- +00000000000000000077B,46504027252424252753B,36313027273031364244B,
- +51504050504050464442B,00000000007750515252B,40524140524140413350B,
- +25304025263033405252B,33402530402526303340B,31334033323240333131B,
- +35343340333232403331B,40353433404035334040B,00000000007740353340B,
- +40434140363440312750B,25405252405247405247B,30273040302725403027B/
- DATA IY18/
- +34353431403435343140B,42413640353534353540B,40424241364042414042B,
- +43404242414242404241B,43405047454750504746B,50405047454750504746B,
- +00000000007750504750B,40525240524740524750B,33354042424346505047B,
- +32333026252526303332B,47505046434242403533B,00000000000000000077B,
- +40414344444341404046B,44434136343333343637B,00000000000000007744B,
- +00000077433540433545B,35343435364143465053B,37424344444342413736B,
- +00000000000077303235B,34353641424343424052B,36414243434240373534B,
- +00000077403735343435B,47474644413734323147B,00773131323437414446B,
- +00000077323246463246B,00000000773044443047B,00000077264052402646B,
- +35414743474135352750B,00000000000000772735B,42403640434240363551B,
- +00000000000077404040B,40363532353640463345B,00000000000077353335B,
- +42403640434240363551B,00000000000077404040B,40424346434240453245B,
- +00000000000077434543B,00007737353333343443B,00000077434344444343B,
- +00007747454343444443B,00000000000077453245B,00007745434136343244B,
- +00007745434136343243B,00000000000077404046B,00000077404040443446B,
- +00000077424240363646B,77423640423640433545B/
- DATA ISTART/
- + 1, 3, 4, 6, 8, 9, 11, 14, 15, 19, 22, 23, 26, 28, 30,
- + 32, 33, 36, 37, 38, 40, 41, 42, 44, 45, 48, 50, 53, 55, 58,
- + 59, 61, 62, 64, 65, 66, 67, 68, 71, 72, 73, 75, 76, 77, 80,
- + 81, 82, 83, 85, 86, 87, 90, 91, 93, 95, 96, 98,101,102,104,
- +106,107,108,110,115,116,118,119,122,126,128,130,131,133,135,
- +137,142,147,149,153,156,159,164,168,169,172,176,180,183,185,
- +187,190,192,194,196,198,199,200,201,202,204,206,207,208,209,
- +210,212,213,214,216,217,219,221,222,224,226,228,230,232,234,
- +236,237,240,242,243,245,246,247,249,251,253,255,257,258,260,
- +261,263,264,266,267,269,270,273,277,279,282,284,287,289,292,
- +293,295,296,299,301,304,306,308,310,312,313,315,318,320,323,
- +326,327,328,330,334,336,338,339,341,344,346,348,349,351,353,
- +355,359,363,365,369,376,386,391,394,395,398,401,403,404,405,
- +406,408,410,412,414,416,417,418,419,420,421,422,423,424,425/
-*
- DATA NBIT,NBITCH,NBITMX/64,8,60/
-#endif
- DATA IPASS/0/
-*
-* SET OF FORTRAN CHARACTERS (ON ANY KEYBOARD)
-*
-* DATA IFORT/1HA,1HB,1HC,1HD,1HE,1HF,1HG,1HH,1HI,1HJ,1HK,1HL,1HM,1HN
-* + ,1HO,1HP,1HQ,1HR,1HS,1HT,1HU,1HV,1HW,1HX,1HY,1HZ
-* + ,1H0,1H1,1H2,1H3,1H4,1H5,1H6,1H7,1H8,1H9
-* + ,1H.,1H,,1H/,1H(,1H),1H-,1H+,1H=,1H*,1H$,1H /
-*
-* SET OF CONTROL CHARACTERS (MAY BE KEYBOARD DEPENDENT)
-*
-* ISPEC(1)= ! GOTO NORMAL SCRIPT LEVEL( EXCLAMATION MARK)
-* ISPEC(2)= ? GOTO SUBSCRIPT (QUESTION MARK)
-* ISPEC(3) ^ GOTO SUPERSCRIPT (CIRCOMFLEX)
-* ISPEC(4) > GOTO UPPER CASE (GREATER THAN)
-* ISPEC(5) < GOTO LOWER CASE (LESS THAN)
-* ISPEC(6) [ GOTO GREEK (OPEN SQUARE BRACKET)
-* ISPEC(7) ] GOTO ROMAN (CLOSE SQUARE BRACKET)
-* ISPEC(8) & BACKSPACE ONE CHARACTER (AND)
-* ISPEC(9) " GOTO SPECIAL SYMBOLS (QUOTES)
-* ISPEC(10) # END OF SPECIAL SYMBOLS (NUMBER)
-* ISPEC(11) $ END OF SCAN CHARACTER (DOLLAR)
-*
-* DATA ISPEC/1H!,1H?,1H^,1H>,1H<,1H[,1H],1H&,1H",1H#,1H$/
-*
-* CORRESPONDENCE BETWEEN GREEK ALPHABET AND ROMAN ALPHABET
-*
- DATA LGREEK/1,2,7,4,5,21,3,22,9,9,10,11,12,13,15,16,8,17,18
- + ,19,20,22,24,14,23,6/
- DATA IFIRST/0/
-*.______________________________________
-*
-#include "higz/hibit.inc"
- CALL UOPTC(CHOPT,'LCRS',IOPT)
- IF(IOPTL.NE.0)IGO=-1
- IF(IOPTC.NE.0)IGO=0
- IF(IOPTR.NE.0)IGO=1
- IF(IOPTS.NE.0)THEN
- IGO=2
- GOTO 10
- ENDIF
-*
-#if defined(CERNLIB_MAIL)
- CHOPTM=CHOPT
-#endif
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_MAIL)
- IF(GLFLAG)CALL IZTEXT(X,Y,KTEXT,SSIZE,ANGLE,IOPT)
-#endif
- IF((.NOT.GFLAG).AND.(.NOT.PFLAG))RETURN
-*
- ZFSAV=ZFLAG
- ZFLAG=.FALSE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- IPLCIS=IPLCI
- ILNS=ILN
- RLWSAV=RLWSC
- CALL ISPLCI(ITXCI)
- CALL ISLN(1)
- CALL ISLWSC(1.)
-*
- 10 XMAX=99999.
- XLMAX=FLOARG(XMAX)
-*
- IF(IPASS.EQ.0)THEN
- IF(IFIRST.EQ.0)THEN
- CALL UCTOH('abcdefghijklmnopqrstuvwxyz',IFORT,1,26)
- CALL UCTOH('ABCDEFGHIJKLMNOPQRSTUVWXYZ',IFORT(27),1,26)
- CALL UCTOH('0123456789.,/()-+=*$ ',IFORT(53),1,21)
- CALL UCTOH('!?^><[]&"#$',ISPEC,1,11)
- IFIRST=1
- ENDIF
- IPASS=1
- DO 20 I=1,84
-#if (!defined(CERNLIB_VAX))&&(!defined(CERNLIB_DECS))&&(!defined(CERNLIB_MSDOS))&&(!(defined(CERNLIB_LINUX) && !defined(CERNLIB_PPC)))&&(!defined(CERNLIB_WINNT))
- LL=JBYT(ITEXT(I),NBIT-NBITCH+1,NBITCH)
-#endif
-#if defined(CERNLIB_VAX)||defined(CERNLIB_DECS)||defined(CERNLIB_MSDOS)||(defined(CERNLIB_LINUX) && !defined(CERNLIB_PPC))||defined(CERNLIB_WINNT)
- LL=MOD(ITEXT(I),256)
-#endif
- IA(LL+1)=I-26
- 20 CONTINUE
- ENDIF
-*
- ISPEC(11)=IFORT(46)
- SIZE=FLOARG(SSIZE)
-*
-* Unpacks text ,prepare angles and size
-*
- IGOP=IGO
- ILEN=LENOCC(KTEXT)
- IF(KTEXT(ILEN:ILEN).EQ.'$')ILEN=ILEN-1
- CALL UCTOH(KTEXT,ITEXT,1,ILEN)
- IF(ANGLE.EQ.0.)THEN
- SI=0.
- CO=1.
- ELSE
- THE=FLOARG(ANGLE)*3.141592/180.
- IF(IGO.GE.2)THE=0.
- SI=SIN(THE)
- CO=COS(THE)
- ENDIF
- XPP=FLOARG(X)
- YPP=FLOARG(Y)
-*
-* Set default values
-*
- 30 NDRAW = 0
- KL = 1
- KGREEK = 0
- KSPEC = 0
- SCALE = SIZE/21.
- RSCALE = SCALE
- IY0 = 9
- YOFF = 0.
- WTOT = 0.
- XW = 0.
- YW = 0.
- WDTH = 0.
-*
-* Start loop for each character to be drawn
-*
- DO 270 ICHAR=1,ILEN
-#if (!defined(CERNLIB_VAX))&&(!defined(CERNLIB_DECS))&&(!defined(CERNLIB_MSDOS))&&(!(defined(CERNLIB_LINUX) && !defined(CERNLIB_PPC)))&&(!defined(CERNLIB_WINNT))
- IG=JBYT(ITEXT(ICHAR),NBIT-NBITCH+1,NBITCH)
-#endif
-#if defined(CERNLIB_VAX)||defined(CERNLIB_DECS)||defined(CERNLIB_MSDOS)||(defined(CERNLIB_LINUX) && !defined(CERNLIB_PPC))||defined(CERNLIB_WINNT)
- IG=MOD(ITEXT(ICHAR),256)
-#endif
- IC=IA(IG+1)
- IBIT=1
- IDIF=1
-*
- IF(IC.GT.58)GOTO 260
- IF(IC.EQ.58)GOTO 280
- IF(IC.GT.47)GOTO 150
- IF(IC.EQ.47)GOTO 260
- IF(IC.EQ.46)GOTO 280
- IF(KSPEC.NE.0)GOTO 70
- IF(IC.GT.36)GOTO 50
- IF(IC.GT.26)GOTO 60
- IF(KGREEK.NE.0)GOTO 40
-*
-* Roman alphabet
-*
- IF(KL.LT.0)THEN
- IF(IC.LE.0)THEN
- ICHR=IC+141
- ELSE
- ICHR=IC+115
- ENDIF
- ELSE
- IF(IC.LE.0)THEN
- ICHR=IC+141
- ELSE
- ICHR=IC+10
- ENDIF
- ENDIF
- GOTO 80
-*
-* Greek alphabet
-*
- 40 IF(KL.LT.0)THEN
- IF(IC.LE.0)THEN
- ICHR=LGREEK(IC+26)+141
- ELSE
- ICHR=LGREEK(IC)+141
- ENDIF
- ELSE
- IF(IC.LE.0)THEN
- ICHR=LGREEK(IC+26)+141
- ELSE
- ICHR=LGREEK(IC)+36
- ENDIF
- ENDIF
- GOTO 80
-*
-* Mathematical symbols
-*
- 50 IF(KL.LT.0)THEN
- IF(IC.LE.0)THEN
- ICHR=191+IC
- ELSE
- ICHR=165+IC
- ENDIF
- ELSE
- IF(IC.LE.0)THEN
- ICHR=86+IC
- ELSE
- ICHR=60+IC
- ENDIF
- ENDIF
- GOTO 80
-*
-* Digits 0--->9
-*
- 60 IF(KL.LT.0)THEN
- IF(IC.LE.0)THEN
- ICHR=IC+105
- ELSE
- ICHR=IC+79
- ENDIF
- ELSE
- IF(IC.LE.0)THEN
- ICHR=IC
- ELSE
- ICHR=IC-26
- ENDIF
- ENDIF
- GOTO 80
-*
-* Special symbols
-*
- 70 IF(KL.LT.0)THEN
- IF(IC.LE.0)THEN
- ICHR=191+IC
- ELSE
- ICHR=165+IC
- ENDIF
- ELSE
- IF(IC.LE.0)THEN
- ICHR=191+IC
- ELSE
- ICHR=60+IC
- ENDIF
- ENDIF
-*
-* Define scale and prepare absolute coordinates of vectors
-*
- 80 IF(ICHR.LE.0)GOTO 260
- IF(ICHR.GT.210)GOTO 260
- IF(KSPEC.EQ.0)GOTO 100
- IF(ICHR.EQ.9.OR.ICHR.EQ.18)GOTO 100
-*
-* Redefine scale for special symbols
-*
- IW=ISTART(ICHR)
- KYMIN=100
- KYMAX=-100
- 90 IBIT=IBIT+6
- IF(IBIT.GE.NBITMX)THEN
- IBIT=1
- IW=IW+1
- ENDIF
-*
- KX=JBYT(IX(IW),IBIT,6)-32
- KY=JBYT(IY(IW),IBIT,6)-32
- IF(KX.NE.31)THEN
- IF(KY.GT.KYMAX)KYMAX=KY
- IF(KY.LT.KYMIN)KYMIN=KY
- GOTO 90
- ENDIF
-*
- IF(KY.NE.31)GOTO 90
- IY0=KYMAX
- DKY=KYMAX-KYMIN
- IF(DKY.EQ.0)DKY=21
- SCALE=SIZE/DKY
- RSCALE=SCALE
- IBIT=1
-*
- 100 IW=ISTART(ICHR)
-#if defined(CERNLIB_CDC)||defined(CERNLIB_CRAY)
- KX=JBYT(IX(IW),1,6)-32
- KY=JBYT(IY(IW),1,6)-32
-#endif
-#if (!defined(CERNLIB_CDC))&&(!defined(CERNLIB_CRAY))
- KX=MOD(IX(IW),64)-32
- KY=MOD(IY(IW),64)-32
-#endif
- WDTH=RSCALE*(KY-KX)
- IF(WTOT+WDTH.GT.XLMAX)GOTO 280
- WTOT=WTOT+WDTH
- IF(IGOP.NE.-1)NDRAW=1
- IF(IGOP.NE.-1)GOTO 270
- XW=WDTH*CO
- YW=WDTH*SI
- IX0=KX
- IF((KSPEC.NE.0).AND.(YOFF.NE.0))IY0=KY
- K=0
-*
- 110 IBIT=IBIT+6
- IDIF=IDIF*64
- IF(IBIT.GE.NBITMX)THEN
- IBIT=1
- IDIF=1
- IW=IW+1
- ENDIF
-#if defined(CERNLIB_CDC)||defined(CERNLIB_CRAY)
- KX=JBYT(IX(IW),IBIT,6)-32
- KY=JBYT(IY(IW),IBIT,6)-32
-#endif
-#if (!defined(CERNLIB_CDC))&&(!defined(CERNLIB_CRAY))
- KX=MOD(IX(IW)/IDIF,64)-32
- KY=MOD(IY(IW)/IDIF,64)-32
-#endif
- IF(KX.NE.31)THEN
- K=K+1
- KX=KX-IX0
- KY=IY0-KY
- XP(K)=KX*RSCALE*CO-(KY*RSCALE+YOFF)*SI+XPP
- YP(K)=KX*RSCALE*SI+(KY*RSCALE+YOFF)*CO+YPP
- GOTO 110
- ENDIF
-*
-* Draw part of symbol
-*
- IF(INPASS.LE.0)INPASS=1
- IF(MOD(INPASS,2).NE.0)THEN
- CALL IPL(K,XP,YP)
- III=(INPASS-1)/2
- ELSE
- III=INPASS/2
- ENDIF
- DO 140 IPASS=1,III
- DELTA=FLOAT(IPASS)*RCSHIF*SIZE
- DO 120 I=1,K
- XXP(I)=XP(I)-DELTA
- YYP(I)=YP(I)-DELTA
- 120 CONTINUE
- CALL IPL(K,XXP,YYP)
- DO 130 I=1,K
- XXP(I)=XP(I)+DELTA
- YYP(I)=YP(I)+DELTA
- 130 CONTINUE
- CALL IPL(K,XXP,YYP)
- 140 CONTINUE
- NDRAW=NDRAW+1
- IF(KY.NE.31)THEN
- K=0
- GOTO 110
- ENDIF
-*
-* Position cursor for next character
-*
- XPP=XPP+XW
- YPP=YPP+YW
- GOTO 270
-*
-* Control characters
-*
- 150 L1=IC-47
- GOTO (160,170,180,190,200,210,220,230,240,250),L1
-*
-* Normal level of script
-*
- 160 YOFF=0.
- RSCALE=SCALE
- GOTO 270
-*
-* Subscript
-*
- 170 YOFF=-0.25*SIZE
- RSCALE=0.5*SCALE
- GOTO 270
-*
-* Superscript
-*
- 180 YOFF=0.75*SIZE
- RSCALE=0.5*SCALE
- GOTO 270
-*
-* Upper case
-*
- 190 KL=1
- GOTO 270
-*
-* Lower case
-*
- 200 KL=-1
- GOTO 270
-*
-* Greek alphabet
-*
- 210 KGREEK=1
- GOTO 270
-*
-* End of greek alphabet
-*
- 220 KGREEK=0
- GOTO 270
-*
-* Backspace one character
-*
- 230 IF(NDRAW.LE.0)GOTO 270
- WTOT=WTOT-WDTH
- XPP=XPP-XW
- YPP=YPP-YW
- GOTO 270
-*
-* GOTO special symbols
-*
- 240 KSPEC=1
- GOTO 270
-*
-* End of special symbols
-*
- 250 KSPEC=0
- IY0=9
- SCALE=SIZE/21.
- RSCALE=SCALE
- IF(YOFF.NE.0)RSCALE=0.5*SCALE
- GOTO 270
-*
-* Blank space
-*
- 260 IF(NDRAW.LE.0)GOTO 270
- WDTH=10.*RSCALE
- XW=WDTH*CO
- YW=WDTH*SI
- IF(WTOT+WDTH.GT.XLMAX)GOTO 280
- WTOT=WTOT+WDTH
- XPP=XPP+XW
- YPP=YPP+YW
-*
- 270 CONTINUE
-*
-* Prepare parameters for a second pass if IGO.NE.-1
-*
- 280 IF(IGOP.EQ.-1)GOTO 310
- IF(IGOP.EQ.0)GOTO 290
- IF(IGOP.EQ.1)GOTO 300
-*
-* Return text length in angle
-*
- ANGLE=WTOT
- RETURN
-*
-* Text is centered on x,y
-*
- 290 XPP=X-0.5*WTOT*CO
- YPP=Y-0.5*WTOT*SI
- IGOP=-1
- GOTO 30
-*
-* Text is rigth adjusted on x,y
-*
- 300 XPP=X-WTOT*CO
- YPP=Y-WTOT*SI
- IGOP=-1
- GOTO 30
-*
- 310 CALL ISPLCI(IPLCIS)
- CALL ISLN(ILNS)
- CALL ISLWSC(RLWSAV)
- ZFLAG=ZFSAV
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- END
diff --git a/src/graflib/higz/ig/igwkty.F b/src/graflib/higz/ig/igwkty.F
deleted file mode 100644
index 5eb1c30..0000000
--- a/src/graflib/higz/ig/igwkty.F
+++ /dev/null
@@ -1,365 +0,0 @@
-*
-* $Id: igwkty.F,v 1.4 1998/01/30 15:22:22 couet Exp $
-*
-* $Log: igwkty.F,v $
-* Revision 1.4 1998/01/30 15:22:22 couet
-* - APOLLO version removed
-*
-* Revision 1.3 1998/01/28 14:34:23 couet
-* - GGDM driver removed
-*
-* Revision 1.2 1996/09/25 14:57:21 couet
-* - GPR driver removed
-*
-* Revision 1.1.1.1 1996/02/14 13:10:41 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.23/01 08/05/95 11.37.33 by O.Couet
-*-- Author : O.Couet 04/04/89
- SUBROUTINE IGWKTY(IWKTY)
-*.===========>
-*.
-*. This routine get the workstation type on the standard input
-*.
-*. _Output parameters:
-*.
-*. INTEGER IWKTY : Workstation identifier choosen interactively
-*.
-*..==========> (O.Couet)
-#if (!defined(CERNLIB_BATCH))
-#include "higz/hiatt.inc"
-#endif
-#if !defined(CERNLIB_BATCH)
-#include "higz/hiques.inc"
-#endif
-#if defined(CERNLIB_X11)||defined(CERNLIB_MSDOS)
-#include "higz/hikern.inc"
-#endif
-#if !defined(CERNLIB_BATCH)
- CHARACTER*48 CHMESS
- CHARACTER*24 CHREP
-#endif
-#if defined(CERNLIB_CCREAD)
- CHARACTER*24 CHCC
-#endif
-#if defined(CERNLIB_IBM)||defined(CERNLIB_AIX370)
- PARAMETER (LUNIN=5,LUNOUT=6)
-#endif
-#if (defined(CERNLIB_DI3000))&&(defined(CERNLIB_VAX))
- CHARACTER*6 DRIVER
- CHARACTER*40 STRING
- INCLUDE '($SSDEF)'
-#endif
-#if (defined(CERNLIB_DI3000))&&(defined(CERNLIB_IBM))
- INTEGER ARGLEN
- CHARACTER*100 ARGS
-#endif
-#if (defined(CERNLIB_DECGKS))&&(defined(CERNLIB_VAX))
- CHARACTER*12 STRING
- INCLUDE '($SSDEF)'
-#endif
-#if (defined(CERNLIB_DECGKS))&&(defined(CERNLIB_DECS))
- CHARACTER*12 STRING
-#endif
-#if (defined(CERNLIB_X11))&&(defined(CERNLIB_IBM))&&(!defined(CERNLIB_IBMMVS))
- CHARACTER*3 CHLUN
-#endif
-#if defined(CERNLIB_X11)
- CHARACTER*80 CHWKTY(10)
- LOGICAL LOHOST
-#endif
-#if (!defined(CERNLIB_BATCH))
- SAVE IFIRST
- DATA IFIRST /0/
-#endif
-*.______________________________________
-*
-#if (!defined(CERNLIB_BATCH))
- IF(IFIRST.NE.0)THEN
- IWKTY = IDTY
- RETURN
- ELSE
- IFIRST = 1
- ENDIF
-#endif
-#if (defined(CERNLIB_DI3000))&&(defined(CERNLIB_IBM))
- CALL GOPARM(ARGLEN,ARGS)
-#endif
-*
- CALL IGDWK(IWKTY)
- CHMESS = 'Workstation type (?=HELP) <CR>='
- LENC = LENOCC(CHMESS)+1
- CALL IZITOC(IWKTY,CHMESS(LENC:))
-*
-#if !defined(CERNLIB_BATCH)
- LENC = LENOCC(CHMESS)
-#endif
-#if (!defined(CERNLIB_IBM))&&(!defined(CERNLIB_AIX370))&&(!defined(CERNLIB_BATCH))
- 10 PRINT 10002, CHMESS(1:LENC)
-#endif
-#if defined(CERNLIB_IBM)||defined(CERNLIB_AIX370)
- 10 WRITE (LUNOUT,'('' '',A,'' :'')') CHMESS(1:LENC)
-#endif
-#if !defined(CERNLIB_BATCH)
- CHREP = ' '
-#endif
-#if defined(CERNLIB_CCREAD)
- CALL IXGETL(LCC,CHCC)
- CHREP = CHCC(1:LCC)
-#endif
-#if (!defined(CERNLIB_IBM))&&(!defined(CERNLIB_BATCH))
- READ 10003, CHREP
-#endif
-#if defined(CERNLIB_IBM)
- READ (LUNIN,'(A)',END=20) CHREP
-#endif
-#if !defined(CERNLIB_BATCH)
- IF(CHREP.EQ.' ')RETURN
- IF(INDEX(CHREP,'?').NE.0)THEN
- PRINT 10000
-#endif
-#if (defined(CERNLIB_DI3000))&&(defined(CERNLIB_VAX))
- DO 100 I=1,9
- WRITE(DRIVER,'(A2,Z1,A3)') 'YD',I,'DRV'
- IF (SS$_NORMAL.EQ.LIB$SYS_TRNLOG(DRIVER,ICHAR,STRING)) THEN
- IF (STRING(ICHAR-6:ICHAR-4).NE.'DRV')
- + PRINT 10001, I,STRING(ICHAR-6:ICHAR-4)
- ENDIF
- 100 CONTINUE
-#endif
-#if (defined(CERNLIB_DI3000))&&(defined(CERNLIB_IBM))
- CALL TRE0EU(ARGS,ARGLEN)
- I = 1
- J = 1
- 100 CONTINUE
- INDX = INDEX(ARGS(J:),'DRV')
- IF (INDX.NE.0) THEN
- PRINT 10001, I,ARGS(J+INDX+2:J+INDX+4)
- I = I+1
- J = J+INDX
- GOTO 100
- ELSE
- PRINT 10001, I,'DI3000 driver menu'
- ENDIF
- 200 CONTINUE
-#endif
-#if !defined(CERNLIB_BATCH)
- GOTO 10
- ENDIF
-#endif
-#if defined(CERNLIB_X11)
- IP = INDEX(CHREP,'.')
- LOHOST = .FALSE.
- IF(IP.NE.0)THEN
- LOHOST = .TRUE.
- IF(IP+1.GT.LENOCC(CHREP))THEN
- FX11 = ' '
- ELSE
- FX11 = CHREP(IP+1:LENOCC(CHREP))
- ENDIF
- CHREP(IP:) = ' '
- ENDIF
- IF(CHREP(1:1).EQ.'M'.OR.CHREP(1:1).EQ.'m')THEN
- CALL IXSETHN(LENOCC(FX11),FX11(1:LENOCC(FX11)))
- IWKTY = 999
- RETURN
- ENDIF
-#endif
-#if !defined(CERNLIB_BATCH)
- CALL IZCTOI(CHREP,IWK)
- IF(IQUEST(1).NE.0)THEN
- PRINT*, ' Invalid workstation type'
- GOTO 10
- ENDIF
- IWKTY = IWK
-#endif
-#if defined(CERNLIB_X11)
- IF(LOHOST)THEN
- CALL IKFILE(IWK)
- OPEN(UNIT=LUNWIN,FILE=FILEN,FORM='FORMATTED'
- +, STATUS='OLD',IOSTAT=ISTA)
- DO 30 I=1,10
- READ(LUNWIN,'(A)')CHWKTY(I)
- 30 CONTINUE
- CLOSE(LUNWIN,STATUS='DELETE')
-#endif
-#if (defined(CERNLIB_X11))&&(defined(CERNLIB_IBM))&&(!defined(CERNLIB_IBMMVS))
- WRITE(CHLUN,'(I3)')LUNWIN
- FILEN='FILEDEF '//CHLUN//' CLEAR'
- CALL VMCMS(FILEN,ISTAT)
- FILEN = '/HIGZWIN DATA A'
-#endif
-#if defined(CERNLIB_X11)
- OPEN(UNIT=LUNWIN,FILE=FILEN,FORM='FORMATTED'
- +, STATUS='NEW',IOSTAT=ISTA)
- DO 40 I=1,10
- IF(I.EQ.IWK)CHWKTY(I)(22:)=FX11
- WRITE(LUNWIN,'(A)')CHWKTY(I)(1:LENOCC(CHWKTY(I)))
- 40 CONTINUE
- CLOSE(LUNWIN)
-#endif
-#if (defined(CERNLIB_X11))&&(defined(CERNLIB_IBM))&&(!defined(CERNLIB_IBMMVS))
- WRITE(CHLUN,'(I3)')LUNWIN
- FILEN = 'FILEDEF '//CHLUN//' CLEAR'
- CALL VMCMS(FILEN,ISTAT)
- FILEN = '/HIGZWIN DATA A'
-#endif
-#if defined(CERNLIB_X11)
- ENDIF
-#endif
-#if !defined(CERNLIB_BATCH)
- RETURN
-#endif
-#if defined(CERNLIB_IBM)
-*
- 20 REWIND(LUNIN)
-#endif
-#if !defined(CERNLIB_BATCH)
-*
-10000 FORMAT(' ',/,' List of valid workstation types:',/,
-#endif
-#if (!defined(CERNLIB_DI3000))&&(!defined(CERNLIB_BATCH))
- +' 0: Alphanumeric terminal',/,
-#endif
-#if (defined(CERNLIB_GKSGRAL))&&(defined(CERNLIB_NEWLIB))
- +' 4714: X-Terminal'/
- +' 4725: Workstation/X-Terminal (2 Terminal Mode)'/
- +' 5003: IBM Graphics Terminal (e.g. 3192 G)',/,
- +' 7878: Falco Infinity Terminal',/,
- +' 470352: Atari-Workstation via 7171',/,
- +' 471352: Atari-Workstation via 7171 (full window)',/,
- +' 470353: Atari-Workstation via Terminal Server',/,
- +' 471353: Atari-Workstation via Terminal Server(full window)',/,
- +' 5005: Macintosh IBM Emulator',/,
- +' 5010: IBM 3820 Laserprinter LI1 (portrait-format)',/,
- +' 5020: IBM 3820 Laserprinter LI1 (landscape-format)',/,
- +' 5011: IBM Matrix-Printer PRINTER2',/,
- +' 13001: QMS Laserprinter L1 (portrait-Format)',/,
- +' 13002: QMS Laserprinter L1 (landscape-format)',/,
-#endif
-#if (defined(CERNLIB_GKSGRAL))&&(!defined(CERNLIB_SUNGKS))&&(!defined(CERNLIB_ATCGKS))&&(!defined(CERNLIB_NEWLIB))
- +' 101: Tektronix 4010, 4014',/,' 102: Tektronix 4012',/,
- +' 103: Tektronix 4014 with enhanced graphics option',/,
- +' 121: Tektronix 4107, 4207, Pericom MX2000',/,
- +' 122: Tektronix 4109',/,' 123: Tektronix 4111',/,
- +' 125: Tektronix 4113',/,' 127: Tektronix 4115, Pericom
- +MX8000',/,' 7800: MG600, MG200',/,' 7878: Falco, Pericom
- +Graph Pac (old Pericom)',/,' 1020: VT240',/,' 1030: VT340'
- +,/,' 8601-6: Vaxstation GPX',/,' 32120-9: X-Window',/,
-#endif
-#if defined(CERNLIB_DI3000)
- +' -1: Alphanumeric terminal',/,
- +' 0: DI3000 metafile',
-#endif
-#if defined(CERNLIB_DECGKS)
- +' 2: GKSM Output metafile',/,
- +' 7: CGM Output metafile',/,
- +' 13: VT240 color',/,
- +' 14: VT240 monochrome',/,
- +' 16: VT330 ',/,
- +' 17: VT340 color',/,
- +' 82: Tek 4107, 4207, Pericom MX2000',/,
- +' 41: Vaxstation',/,
- +' 211: Vaxstation running DECWindows',/,
- +' 38: LN03 Plus Laser Printer (Assign GKS$CONID)',/,
- +' 72: Tektronix 4014 Emulators',/,
- +' 61: Postscript Printers (Assign GKS$CONID)',/,
-#endif
-#if defined(CERNLIB_GK2000)
- +' 445: Vaxstation',/,
- +' 102: Tektronix 4014 Emulators',/,
- +' 105: Macintosh Tektronix 4014 Emulator',/,
- +' 191: Ramtek R25 4014 Emulator',/,
- +' 324: LN03 Plus Laser Printer',/,
- +' 601: Talaris Printers',/,
- +' 700: Postscript Printers',/,
-#endif
-#if (defined(CERNLIB_SUNGKS))&&(!defined(CERNLIB_ATCGKS))
- +' 3: GKS Metafile Output (ASCII)',/,
- +' 4: SUN Workstation',/,
- +' 6: HP-GL Output',/,
- +' 7: PostScript Output',/,
- +' 8: CGM Output',/,
- +' 10: GKS Metafile Output (binary)',/,
-#endif
-#if defined(CERNLIB_ATCGKS)
- +' 15nn: QMS Lasergrafix (TALARIS) 8.5x11',/,
- +' for TALARIS: Use PRINT/NOFORM/PASSALL <file>',/,
- +' 19nn: POSTSCRIPT 8.5x11 Printer',/,
- +' 23nn: Tektronix 4105 Terminals',/,
- +' 2400: Tektronix 4014 Terminal',/,
- +' 2501: Tektronix 4010 Terminal',/,
- +' 2502: C-ITOH Terminals (201,414)',/,
- +' 2503: Retrographics VT640',/,
- +' 2506: GRAPHON 140, 230 Terminal',/,
- +' 25nn: other Tektronix 4010 Types',/,
- +' 2600: DEC VT125 Terminal',/,
- +' 2602: DEC VT240 Terminal',/,
- +' 2603: DEC VT330 Terminal',/,
- +' 2605: DEC VT340 Color Terminal',/,
- +' 3100: Tektronix 4107 Terminal',/,
- +' 3102: Tektronix 4205 Terminal',/,
- +' 3104: Tektronix 4208 Terminal',/,
- +' 315n: 4107-4208 (software segments)',/,
- +' 4300: VAXstation II (not in Version 3.2)',/,
- +' 5300: X-Windows',/,
- +' 5350: X-Windows with refresh',/,
- +' 63nn: IMAGEN 8.5x11 Printer',/,
- +' 66nn: Tektronix 4510 Color Rasterizer',/,
- +' 10100: Binary Output CG Metafile',/,
- +' 10110: Character Output CG Metafile',/,
- +' 10120: Clear Text Output CG Metafile',/,
-#endif
-#if (defined(CERNLIB_GL)||defined(CERNLIB_X11)||defined(CERNLIB_MACMPW))&&(!defined(CERNLIB_MSDOS))
- +' 1-10: Describe in file higz_windows.dat',/,
-#endif
-#if (defined(CERNLIB_MSDOS))&&(defined(CERNLIB_NDP))
- +' 4: 320x200, 4 colors'/
- +' 5: 320x200, 4 colors'/
- +' 6: 640x200, 2 colors'/
- +' 13: 320x200, 16 colors'/
- +' 14: 640x200, 16 colors'/
- +' 15: 640x350, 2 colors'/
- +' 16: 640x350, 16 colors'/
- +' 17: 640x480, 2 colors'/
- +' 18: 640x480, 16 colors'/
- +' 19: 320x200,256 colors'/
- + /
- +' SuperVGA: 800x600 16 colors:'//
- +' 41: Tseng chipset 98: Video Seven '/
- +' 88: Paradise 100: Renaissance GRX '/
-#endif
-#if (defined(CERNLIB_MSDOS))&&(!defined(CERNLIB_NDP))
- +' >0: Graphics option is pre-selected by the'/,
- +' GO32 environment variable'/
-#endif
-#if defined(CERNLIB_X11)
- +' n.host: Open the display on host (1 < n < 10)',/,
-#endif
-#if defined(CERNLIB_FALCO)
- +' 7878: FALCO terminal',/,
- +' 7879: xterm',/,
-#endif
-#if defined(CERNLIB_GKSBX)
- +' 8811: GKSBx-X11',/,
-#endif
-#if defined(CERNLIB_PHIGS)
- +' 8887: GPHIGS-X11',/,' 7176: GPHIGS-GL',/,
- +' 8384: GPHIGS-Starbase',/,' 8871: GPHIGS-Xgl',/,
- +' 7188: GPEX',/,
-#endif
-#if !defined(CERNLIB_BATCH)
- +' ')
-#endif
-#if defined(CERNLIB_DI3000)
-10001 FORMAT(I8,': ',A)
-#endif
-#if (!defined(CERNLIB_IBM))&&(!defined(CERNLIB_AIX370))&&(!defined(CERNLIB_BATCH))
-10002 FORMAT(' ',A,' : ',$)
-#endif
-#if (!defined(CERNLIB_IBM))&&(!defined(CERNLIB_BATCH))
-10003 FORMAT(A)
-#endif
- END
diff --git a/src/graflib/higz/ig/igxmes.F b/src/graflib/higz/ig/igxmes.F
deleted file mode 100644
index 4a281ce..0000000
--- a/src/graflib/higz/ig/igxmes.F
+++ /dev/null
@@ -1,138 +0,0 @@
-*
-* $Id: igxmes.F,v 1.1.1.1 1996/02/14 13:10:41 mclareni Exp $
-*
-* $Log: igxmes.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:41 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.20/08 19/01/94 13.57.39 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE IGXMES(IX,IY,NC,N,CHMESS,CHTIT,CHOPT)
-#if defined(CERNLIB_X11)
-#include "higz/hikern.inc"
-#endif
- CHARACTER*(*) CHMESS(N),CHTIT,CHOPT
-#if defined(CERNLIB_X11)
- DIMENSION IOPT(4)
- EQUIVALENCE (IOPT(1) ,IOPTP),(IOPT(2) ,IOPTC)
- EQUIVALENCE (IOPT(3) ,IOPTD),(IOPT(4) ,IOPTL)
- CHARACTER*32 FX11M
- SAVE IOPEN,IDMES,IW,IH,FX11M,ISIZE,NLINE
- DATA IOPEN /0/
- DATA ISIZE /12/
- DATA IH /0/
-#endif
-*.______________________________________
-*
-#if defined(CERNLIB_X11)
- CALL UOPTC (CHOPT,'PCDL',IOPT)
-*
-* Print the array CHMESS and open the message
-* window if necessary.
-*
- IF(IOPTP.NE.0)THEN
- CALL IXSAVWI
-*
-* Open the window if necessary
-*
- IF(IOPEN.EQ.0)THEN
- NLINE=N
- 10 FX11M='-*-courier-bold-r-normal--'
- LONG=LENOCC(FX11M)
- CALL IZITOC(ISIZE,FX11M(LONG+1:))
- LONG=LENOCC(FX11M)+1
- FX11M(LONG:LONG)='*'
- IF(IXSETTF(1,LENOCC(FX11M),FX11M).NE.0)THEN
- IF(ISIZE.EQ.20)THEN
- CALL IGERR('X11 fonts not available','IGMESS')
- ISIZE=0
- RETURN
- ENDIF
- ISIZE=ISIZE+1
- GOTO 10
- ENDIF
-#endif
-#if (defined(CERNLIB_X11))&&(defined(CERNLIB_IBM))
- CALL CLTOU(CHMESS(1))
-#endif
-#if defined(CERNLIB_X11)
- CALL IXTXTL(IW,IH,NC,CHMESS(1))
-#endif
-#if (defined(CERNLIB_X11))&&(defined(CERNLIB_IBM))
- CALL CUTOL(CHMESS(1))
-#endif
-#if defined(CERNLIB_X11)
- WINSIZ(1) = IX
- WINSIZ(2) = IY
- WINSIZ(3) = IW+10
- WINSIZ(4) = NLINE*(IH+5)+5
- IF(IOPTL.NE.0)WINSIZ(1) = WINSIZ(1)-WINSIZ(3)
- IFLAG=1
- IDMES=IXOPNWI(WINSIZ(1),WINSIZ(2),WINSIZ(3),WINSIZ(4),
- + LENOCC(CHTIT),CHTIT,IFLAG)
- IF(IDMES.LT.0)THEN
- CALL IGERR('Can''t open WINDOW','IGMESS')
- RETURN
- ENDIF
- CALL IXS2BUF(IDMES,1)
- CALL IXUPDWI(1)
- IOPEN=1
- ENDIF
-*
-* Rescale the window if necessary
-*
- IF(N.GT.NLINE)THEN
- NLINE = N
- IWW = IW+10
- IHH = NLINE*(IH+5)+5
- CALL IXRSCWI(IDMES,IWW,IHH)
- ENDIF
-*
-* Perform the output
-*
- CALL IZSAVA
- CALL IXSELWI(IDMES)
- CALL IXNOCLI(IDMES)
- CALL IXCLRWI
- CALL ISTXAL(0,0)
- CALL ISTXCI(1)
- IF(ISIZE.NE.0)THEN
- IFPX11=IXSETTF(1,LENOCC(FX11M),FX11M)
- ELSE
- RETURN
- ENDIF
- IYT=5+IH
- DO 20 I=1,N
- CALL IXTEXT(0,5,IYT,0.,1.,NC,CHMESS(I))
- IYT=IYT+5+IH
- 20 CONTINUE
- CALL IXUPDWI(1)
- CALL IXSETWI
- CALL IZSETA
- ENDIF
-*
-* Close the message window.
-*
- IF(IOPTC.NE.0.AND.IOPEN.NE.0)THEN
- CALL IXSAVWI
- CALL IXSELWI(IDMES)
- CALL IXCLSWI
- CALL IXUPDWI(1)
- IOPEN=0
- CALL IXSETWI
- ENDIF
-*
-* Clear the message window.
-*
- IF(IOPTD.NE.0)THEN
- CALL IXSAVWI
- CALL IXSELWI(IDMES)
- CALL IXCLRWI
- CALL IXUPDWI(1)
- CALL IXSETWI
- ENDIF
-#endif
-*
- END
diff --git a/src/graflib/higz/ig/igzset.F b/src/graflib/higz/ig/igzset.F
deleted file mode 100644
index 35dfe5e..0000000
--- a/src/graflib/higz/ig/igzset.F
+++ /dev/null
@@ -1,80 +0,0 @@
-*
-* $Id: igzset.F,v 1.1.1.1 1996/02/14 13:10:41 mclareni Exp $
-*
-* $Log: igzset.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:41 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.21/09 14/09/94 15.50.32 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE IGZSET(CHOPT)
-*.===========>
-*.
-*. This routine sets the HIGZ working mode.
-*.
-*. _Input parameters:
-*.
-*. CHARACTER CHOPT : Option to be set .
-*.
-*. CHOPT='G'raphics mode ON
-*. CHOPT='Z'ebra mode ON, 'G' becomes OFF
-*. CHOPT='X' Zebra mode OFF and leave 'G'
-*. CHOPT='S'ave the current state of the FLAGS
-*. CHOPT='R'estore the last state saved
-*. CHOPT='E'xpand mode: in this mode attributes
-*. are stored in the pictures without checking
-*. if the current value is the same. This
-*. allows to have each primitive with its
-*. attributes.
-*. CHOPT='C'ompress (.NOT.'E')
-*.
-*..==========> (O.Couet)
-#include "higz/hiflag.inc"
- CHARACTER*(*) CHOPT
- DIMENSION IOPT(7)
- EQUIVALENCE (IOPTG,IOPT(1)) , (IOPTZ,IOPT(2))
- EQUIVALENCE (IOPTS,IOPT(3)) , (IOPTR,IOPT(4))
- EQUIVALENCE (IOPTE,IOPT(5)) , (IOPTC,IOPT(6))
- EQUIVALENCE (IOPTX,IOPT(7))
- LOGICAL ZFLAGS,GFLAGS
- SAVE ZFLAGS,GFLAGS
-*.______________________________________
-*
- CALL UOPTC(CHOPT,'GZSRECX',IOPT)
-*
- IF(IOPTE.NE.0)THEN
- CFLAG = .FALSE.
- RETURN
- ENDIF
- IF(IOPTC.NE.0)THEN
- CFLAG = .TRUE.
- RETURN
- ENDIF
-*
- IF(IOPTS.NE.0)THEN
- ZFLAGS = ZFLAG
- GFLAGS = GFLAG
- RETURN
- ENDIF
-*
- IF(IOPTX.NE.0)THEN
- ZFLAG = .FALSE.
- GOTO 10
- ENDIF
-*
- IF(IOPTR.NE.0)THEN
- IF (ZFLAGS) IOPTZ = 1
- IF (GFLAGS) IOPTG = 1
- ENDIF
-*
- GLFLAG = .FALSE.
- GFLAG = .FALSE.
- ZFLAG = .FALSE.
-*
- IF ((IOPTG.NE.0).AND.(.NOT.MFLAG)) GFLAG = .TRUE.
- IF (IOPTZ.NE.0) ZFLAG = .TRUE.
- 10 GLFLAG = (ZFLAG.OR.PFLAG.OR.MFLAG)
-*
- END
diff --git a/src/graflib/higz/ig/iml.F b/src/graflib/higz/ig/iml.F
deleted file mode 100644
index 0e51fdd..0000000
--- a/src/graflib/higz/ig/iml.F
+++ /dev/null
@@ -1,54 +0,0 @@
-*
-* $Id: iml.F,v 1.1.1.1 1996/02/14 13:10:41 mclareni Exp $
-*
-* $Log: iml.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:41 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.06/06 10/03/89 08.13.26 by O.Couet
-*-- Author :
- SUBROUTINE IML(N,X,Y)
-*.===========>
-*.
-*. This routine draws a multiline .
-*.
-*. _Input parameters:
-*.
-*. INTEGER N : Number of points in the polyline .
-*. REAL X(N) : X coordinates .
-*. REAL Y(N) : Y coordinates .
-*.
-*..==========> (O.Couet)
-#include "higz/hiflag.inc"
- DIMENSION X(*),Y(*)
- LOGICAL ZSAV
-*.______________________________________
-*
- IF(N.LT.2)THEN
- CALL IGERR('Invalid number of points','IML')
- RETURN
- ENDIF
-*
- NI=N
- IF(MOD(NI,2).NE.0)THEN
- NI=NI-1
- ENDIF
- NI=NI/2
- IF(GFLAG)THEN
- CALL IGSG(0)
- ZSAV=ZFLAG
- ZFLAG=.FALSE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- DO 10 I=1,NI
- CALL IPL(2,X(2*I-1),Y(2*I-1))
- 10 CONTINUE
- ZFLAG=ZSAV
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- ENDIF
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_MAIL)
- IF(GLFLAG)CALL IZML(N,X,Y)
-#endif
-*
- END
diff --git a/src/graflib/higz/ig/ipm4id.F b/src/graflib/higz/ig/ipm4id.F
deleted file mode 100644
index d7ad6dd..0000000
--- a/src/graflib/higz/ig/ipm4id.F
+++ /dev/null
@@ -1,55 +0,0 @@
-*
-* $Id: ipm4id.F,v 1.1.1.1 1996/02/14 13:10:41 mclareni Exp $
-*
-* $Log: ipm4id.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:41 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.23/06 14/11/95 10.26.40 by O.Couet
-*-- Author : O.Couet 28/09/93
- SUBROUTINE IPM4ID(N,X,Y,Z,C,CMIN,CMAX,LEVEL,ID)
-#include "higz/hiatt.inc"
-#include "higz/higraf.inc"
-#include "higz/hihist.inc"
-#include "higz/hi3d.inc"
-#include "higz/hiflag.inc"
- DIMENSION X(*),Y(*),Z(*),C(*),ID(*)
- DIMENSION IDD(NPMAX)
- EQUIVALENCE (XWORK(1),IDD(1))
-*
- IF(INBCOL.GT.8)THEN
- ICOFF = 8
- ELSE
- ICOFF = 1
- ENDIF
- DC = (CMAX-CMIN)/(INBCOL-ICOFF)
-*
- IF (IDIM.EQ.3) THEN
-#if defined(CERNLIB_PHIGS)
- CALL PPM3(N,X,Y,Z)
-#endif
- ELSE
- DO 20 IC=ICOFF,INBCOL-1
- NGRAF = 0
- CALL ISPMCI(IC)
- DO 10 I=1,N
- INCOL = INT((C(I)-CMIN)/DC)+ICOFF
- IF(INCOL.EQ.IC)THEN
- NGRAF = NGRAF+1
- XGRAF(NGRAF) = AWNX*X(I)+BWNX*Y(I)+CWNX*Z(I)+DWNX
- YGRAF(NGRAF) = AWNY*X(I)+BWNY*Y(I)+CWNY*Z(I)+DWNY
- ZGRAF(NGRAF) = AWNZ*X(I)+BWNZ*Y(I)+CWNZ*Z(I)+DWNZ
- IDD(NGRAF) = ID(I)
- ENDIF
- IF(NGRAF.EQ.NPMAX.OR.I.EQ.N)THEN
- CALL IPM(NGRAF,XGRAF,YGRAF)
- IF(ZFLAG)CALL IGADID(LEVEL,NGRAF,IDD)
- NGRAF = 0
- ENDIF
- 10 CONTINUE
- 20 CONTINUE
- ENDIF
-*
- END
diff --git a/src/graflib/higz/ig/ipmid.F b/src/graflib/higz/ig/ipmid.F
deleted file mode 100644
index d0a8412..0000000
--- a/src/graflib/higz/ig/ipmid.F
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: ipmid.F,v 1.1.1.1 1996/02/14 13:10:41 mclareni Exp $
-*
-* $Log: ipmid.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:41 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.14/09 25/05/92 17.37.57 by O.Couet
-*-- Author : O.Couet 25/05/92
- SUBROUTINE IPMID(N,X,Y,LEVEL,ID)
-*.===========>
-*.
-*..==========> (O.Couet)
-#include "higz/hiflag.inc"
- DIMENSION X(*),Y(*),ID(*)
-*.______________________________________
-*
- CALL IPM(N,X,Y)
- IF(ZFLAG)CALL IGADID(LEVEL,N,ID)
-*
- END
diff --git a/src/graflib/higz/ig3/Imakefile b/src/graflib/higz/ig3/Imakefile
deleted file mode 100644
index 8391695..0000000
--- a/src/graflib/higz/ig3/Imakefile
+++ /dev/null
@@ -1,6 +0,0 @@
-SRCS_F= iatr3.F ifa3.F igbrik.F igcone.F igcyl.F igsphe.F \ @@\
- igtcop.F igtini.F igtmul.F igtnor.F igtor.F igtran.F igtref.F \ @@\
- igtrot.F igtsca.F igttra.F ipl3.F ipm3.F ipm3id.F isvp3.F \ @@\
- iswn3.F itx3.F ifaf3.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/graflib/higz/ig3/Imakefile.dgks b/src/graflib/higz/ig3/Imakefile.dgks
deleted file mode 100644
index 34d4cb6..0000000
--- a/src/graflib/higz/ig3/Imakefile.dgks
+++ /dev/null
@@ -1,10 +0,0 @@
-SRCS_F= iatr3.F ifa3.F igbrik.F igcone.F igcyl.F igsphe.F \ @@\
- igtcop.F igtini.F igtmul.F igtnor.F igtor.F igtran.F igtref.F \ @@\
- igtrot.F igtsca.F igttra.F ipl3.F ipm3.F ipm3id.F isvp3.F \ @@\
- iswn3.F itx3.F
-
-SubdirExtraLibraryTarget(NullParameter,NullParameter,NullParameter,dgks)
-
-VersionFortranObjectRule(dgks,NullParameter,-DCERNLIB_DECGKS)
-
-BuildNamedMakefileTarget(Makefile.dgks,Imakefile.dgks,-DCERNLIB_DECGKS)
diff --git a/src/graflib/higz/ig3/iatr3.F b/src/graflib/higz/ig3/iatr3.F
deleted file mode 100644
index cb3edc6..0000000
--- a/src/graflib/higz/ig3/iatr3.F
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: iatr3.F,v 1.3 1998/01/28 11:21:46 couet Exp $
-*
-* $Log: iatr3.F,v $
-* Revision 1.3 1998/01/28 11:21:46 couet
-* - is in fact used. but should not be. Need a closer look to remove it
-*
-* Revision 1.1.1.1 1996/02/14 13:10:42 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.14/00 06/02/92 10.46.07 by O.Couet
-*-- Author : Gareth Richards 15/07/91
- SUBROUTINE IATR3(X,Y,Z,XX,YY,ZZ,TEXT)
-#include "higz/hiatt.inc"
- CHARACTER*(*) TEXT
- IF (IDIM.EQ.3) THEN
-#if defined(CERNLIB_PHIGS)
- CALL PATR3(X,Y,Z,XX,YY,ZZ,TEXT)
-#endif
- ENDIF
-*
- END
diff --git a/src/graflib/higz/ig3/ifa3.F b/src/graflib/higz/ig3/ifa3.F
deleted file mode 100644
index ccb1d1c..0000000
--- a/src/graflib/higz/ig3/ifa3.F
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: ifa3.F,v 1.1.1.1 1996/02/14 13:10:42 mclareni Exp $
-*
-* $Log: ifa3.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:42 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.23/06 21/11/95 16.22.46 by O.Couet
-*-- Author : O.Couet 06/01/92
- SUBROUTINE IFA3(N,X,Y,Z)
-#include "higz/hiatt.inc"
-#include "higz/higraf.inc"
-#include "higz/hi3d.inc"
- DIMENSION X(*),Y(*),Z(*)
- IF (IDIM.EQ.3) THEN
-#if defined(CERNLIB_PHIGS)
- CALL PFA3(N,X,Y,Z)
-#endif
- ELSE
- NGRAF = N
- IF(N.GT.NPMAX)THEN
- CALL IGERR('Too many points','IFA3')
- NGRAF = NPMAX
- ENDIF
- DO 10 I=1,NGRAF
- XGRAF(I) = AWNX*X(I)+BWNX*Y(I)+CWNX*Z(I)+DWNX
- YGRAF(I) = AWNY*X(I)+BWNY*Y(I)+CWNY*Z(I)+DWNY
- ZGRAF(I) = AWNZ*X(I)+BWNZ*Y(I)+CWNZ*Z(I)+DWNZ
- 10 CONTINUE
- IF (IZBUF.NE.0) THEN
-#if defined(CERNLIB_ZBUF)
- CALL IHZFIL(IFACI,NGRAF,XGRAF,YGRAF,ZGRAF)
-#endif
- ELSE
- CALL IFA(NGRAF,XGRAF,YGRAF)
- ENDIF
- ENDIF
-*
- END
diff --git a/src/graflib/higz/ig3/ifaf3.F b/src/graflib/higz/ig3/ifaf3.F
deleted file mode 100644
index 099601a..0000000
--- a/src/graflib/higz/ig3/ifaf3.F
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: ifaf3.F,v 1.1 1999/10/20 14:12:57 couet Exp $
-*
-* $Log: ifaf3.F,v $
-* Revision 1.1 1999/10/20 14:12:57 couet
-* - ifaf3.F needed in ig3
-*
-* Higz
-*
-*
-#include "higz/pilot.h"
- subroutine ifaf3(n,x,y,z,f)
-************************************************************************
-*
-************************************************************************
- real x(*),y(*),z(*),f(*),p(3)
- real xx(30),yy(30),zz(30)
-*-
- do i=1,n
- p(1) = x(i)
- p(2) = y(i)
- p(3) = z(i)
- call ihwton(p,p)
- xx(i) = p(1)
- yy(i) = p(2)
- zz(i) = p(3)
- end do
-
-* znorm = (xx(3)-xx(1))*(yy(4)-yy(2)) - (xx(4)-xx(2))*(yy(3)-yy(1))
-* if (znorm .le. 0) return
-
- call ihzsha(n,xx,yy,zz,f)
- end
-
diff --git a/src/graflib/higz/ig3/igbrik.F b/src/graflib/higz/ig3/igbrik.F
deleted file mode 100644
index a046fa8..0000000
--- a/src/graflib/higz/ig3/igbrik.F
+++ /dev/null
@@ -1,72 +0,0 @@
-*
-* $Id: igbrik.F,v 1.1.1.1 1996/02/14 13:10:42 mclareni Exp $
-*
-* $Log: igbrik.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:42 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 2.07/20 19/12/95 17.23.24 by O.Couet
-*-- Author :
- SUBROUTINE IGBRIK(LIGHT,T,DX,DY,DZ)
-************************************************************************
-* *
-* Name: IGBRIK Date: 10.12.95 *
-* Author: E.Chernyaev (IHEP/Protvino) Revised: *
-* *
-* Function: Draw 3D box *
-* *
-************************************************************************
- INTEGER IFACE(4,6)
- REAL T(4,3),P(3,8),ANORM(3,6),AN(3)
- REAL X(4),Y(4),Z(4),F(4)
- DATA IFACE /1,2,6,5, 2,3,7,6, 3,4,8,7, 4,1,5,8,
- + 4,3,2,1, 5,6,7,8/
- DATA ANORM /0.,-1.,0., 1.,0.,0., 0.,1.,0., -1.,0.,0.,
- + 0.,0.,-1., 0.,0.,1./
-*-
-** S E T V E R T I C E S
-*
- P(1,1) = 0.
- P(2,1) = 0.
- P(1,2) = DX
- P(2,2) = 0.
- P(1,3) = DX
- P(2,3) = DY
- P(1,4) = 0.
- P(2,4) = DY
- DO 100 I=1,4
- P(3,I) = 0.
- P(1,I+4) = P(1,I)
- P(2,I+4) = P(2,I)
- P(3,I+4) = DZ
- 100 CONTINUE
-*
-** T R A N S F O R M V E R T I C E S
-*
- DO 200 I=1,8
- CALL IGTRAN(P(1,I),T,P(1,I))
- 200 CONTINUE
-*
-** D R A W F A C E S
-*
- DO 320 I=1,6
- DO 310 K=1,4
- N = IFACE(K,I)
- X(K) = P(1,N)
- Y(K) = P(2,N)
- Z(K) = P(3,N)
- 310 CONTINUE
- IF (LIGHT .NE. 0) THEN
- CALL IGTNOR(ANORM(1,I),T,AN)
- CALL IHLUMI(AN,F(1))
- F(2) = F(1)
- F(3) = F(1)
- F(4) = F(1)
- CALL IFAF3(4,X,Y,Z,F)
- ELSE
- CALL IFA3(4,X,Y,Z)
- END IF
- 320 CONTINUE
- END
diff --git a/src/graflib/higz/ig3/igcone.F b/src/graflib/higz/ig3/igcone.F
deleted file mode 100644
index 1b7adfb..0000000
--- a/src/graflib/higz/ig3/igcone.F
+++ /dev/null
@@ -1,132 +0,0 @@
-*
-* $Id: igcone.F,v 1.1.1.1 1996/02/14 13:10:42 mclareni Exp $
-*
-* $Log: igcone.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:42 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 2.07/20 19/12/95 17.23.24 by O.Couet
-*-- Author :
- SUBROUTINE IGCONE(LIGHT,T,H,R1,R2,NSTEP)
-************************************************************************
-* *
-* Name: IGCONE Date: 10.12.95 *
-* Author: E.Chernyaev (IHEP/Protvino) Revised: *
-* *
-* Function: Draw cone *
-* *
-************************************************************************
- PARAMETER (NMAX=72)
- REAL T(4,3),P1(3,NMAX+1),P2(3,NMAX+1)
- REAL X(NMAX),Y(NMAX),Z(NMAX),F(NMAX),ANORM(3)
-*-
- IF (NSTEP.LT.3 .OR. NSTEP.GT.NMAX) RETURN
- ANG = ATAN(1.)*8. / NSTEP
-*
-** S E T V E R T I C E S
-*
- DO 100 I=1,NSTEP+1
- IF (I.EQ.1 .OR. I.EQ.NSTEP+1) THEN
- COSA = 1.
- SINA = 0.
- ELSE
- COSA = COS((I-1)*ANG)
- SINA = SIN((I-1)*ANG)
- END IF
- P1(1,I) = R1*COSA
- P1(2,I) = R1*SINA
- P1(3,I) = 0.
- P2(1,I) = R2*COSA
- P2(2,I) = R2*SINA
- P2(3,I) = H
- 100 CONTINUE
-*
-** T R A N S F O R M V E R T I C E S
-*
- DO 200 I=1,NSTEP+1
- CALL IGTRAN(P1(1,I),T,P1(1,I))
- CALL IGTRAN(P2(1,I),T,P2(1,I))
- 200 CONTINUE
-*
-** D R A W L O W E R F A C E
-*
- IF (R1 .NE. 0.) THEN
- IF (LIGHT .NE. 0) THEN
- ANORM(1) = 0.
- ANORM(2) = 0.
- ANORM(3) =-1.
- CALL IGTNOR(ANORM,T,ANORM)
- CALL IHLUMI(ANORM,F(1))
- END IF
- DO 310 I=1,NSTEP
- X(I) = P1(1,NSTEP+1-I)
- Y(I) = P1(2,NSTEP+1-I)
- Z(I) = P1(3,NSTEP+1-I)
- IF (LIGHT .NE. 0) F(I) = F(1)
- 310 CONTINUE
- IF (LIGHT .NE. 0) THEN
- CALL IFAF3(NSTEP,X,Y,Z,F)
- ELSE
- CALL IFA3(NSTEP,X,Y,Z)
- END IF
- END IF
-*
-** D R A W U P P E R F A C E
-*
- IF (R1 .NE. 0.) THEN
- IF (LIGHT .NE. 0) THEN
- ANORM(1) = 0.
- ANORM(2) = 0.
- ANORM(3) = 1.
- CALL IGTNOR(ANORM,T,ANORM)
- CALL IHLUMI(ANORM,F(1))
- END IF
- DO 320 I=1,NSTEP
- X(I) = P2(1,I)
- Y(I) = P2(2,I)
- Z(I) = P2(3,I)
- IF (LIGHT .NE. 0) F(I) = F(1)
- 320 CONTINUE
- IF (LIGHT .NE. 0) THEN
- CALL IFAF3(NSTEP,X,Y,Z,F)
- ELSE
- CALL IFA3(NSTEP,X,Y,Z)
- END IF
- END IF
-*
-** D R A W S I D E F A C E S
-*
- DO 400 I=1,NSTEP
- X(1) = P1(1,I)
- Y(1) = P1(2,I)
- Z(1) = P1(3,I)
- X(2) = P1(1,I+1)
- Y(2) = P1(2,I+1)
- Z(2) = P1(3,I+1)
- X(3) = P2(1,I+1)
- Y(3) = P2(2,I+1)
- Z(3) = P2(3,I+1)
- X(4) = P2(1,I)
- Y(4) = P2(2,I)
- Z(4) = P2(3,I)
- IF (LIGHT .NE. 0) THEN
- ANORM(1) = COS((I-1)*ANG)
- ANORM(2) = SIN((I-1)*ANG)
- ANORM(3) = 0.
- CALL IGTNOR(ANORM,T,ANORM)
- CALL IHLUMI(ANORM,F(1))
- F(4) = F(1)
- ANORM(1) = COS(I*ANG)
- ANORM(2) = SIN(I*ANG)
- ANORM(3) = 0.
- CALL IGTNOR(ANORM,T,ANORM)
- CALL IHLUMI(ANORM,F(2))
- F(3) = F(2)
- CALL IFAF3(4,X,Y,Z,F)
- ELSE
- CALL IFAF3(4,X,Y,Z)
- END IF
- 400 CONTINUE
- END
diff --git a/src/graflib/higz/ig3/igcyl.F b/src/graflib/higz/ig3/igcyl.F
deleted file mode 100644
index 4ceb124..0000000
--- a/src/graflib/higz/ig3/igcyl.F
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: igcyl.F,v 1.1.1.1 1996/02/14 13:10:42 mclareni Exp $
-*
-* $Log: igcyl.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:42 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 2.07/20 19/12/95 17.23.24 by O.Couet
-*-- Author :
- SUBROUTINE IGCYL(LIGHT,T,H,R,NSTEP)
-************************************************************************
-* *
-* Name: IGCYL Date: 10.12.95 *
-* Author: E.Chernyaev (IHEP/Protvino) Revised: *
-* *
-* Function: Draw cylinder *
-* *
-************************************************************************
- REAL T(4,3)
- CALL IGCONE(LIGHT,T,H,R,R,NSTEP)
- END
diff --git a/src/graflib/higz/ig3/igsphe.F b/src/graflib/higz/ig3/igsphe.F
deleted file mode 100644
index c8758fc..0000000
--- a/src/graflib/higz/ig3/igsphe.F
+++ /dev/null
@@ -1,99 +0,0 @@
-*
-* $Id: igsphe.F,v 1.1.1.1 1996/02/14 13:10:42 mclareni Exp $
-*
-* $Log: igsphe.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:42 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 2.07/20 19/12/95 17.23.24 by O.Couet
-*-- Author :
- SUBROUTINE IGSPHE(LIGHT,T,R,N1,N2)
-************************************************************************
-* *
-* Name: IGSPHE Date: 10.12.95 *
-* Author: E.Chernyaev (IHEP/Protvino) Revised: *
-* *
-* Function: Draw sphere *
-* *
-************************************************************************
- REAL T(4,3),P(3,4),ANORM(3,4),X(4),Y(4),Z(4),F(4)
-*-
- IF (N1.LT.2 .OR. N2.LT.3) RETURN
- RAD = ATAN(1.)*4./180.
- THETA = RAD*180./N1
- PHI = RAD*360./N2
- DO 400 ITHETA=1,N1
- COST1 = COS((ITHETA-1)*THETA)
- SINT1 = SIN((ITHETA-1)*THETA)
- COST2 = COS(ITHETA*THETA)
- SINT2 = SIN(ITHETA*THETA)
- IF (ITHETA .EQ. 1) THEN
- COST1 = 1.
- SINT1 = 0.
- END IF
- IF (ITHETA .EQ. N1) THEN
- COST2 =-1.
- SINT2 = 0.
- END IF
- DO 300 IPHI=1,N2
- COSP1 = COS((IPHI-1)*PHI)
- SINP1 = SIN((IPHI-1)*PHI)
- COSP2 = COS(IPHI*PHI)
- SINP2 = SIN(IPHI*PHI)
- IF (IPHI .EQ. 1) THEN
- COSP1 = 1.
- SINP1 = 0.
- END IF
- IF (IPHI .EQ. N2) THEN
- COSP2 = 1.
- SINP2 = 0.
- END IF
-*
-** F I N D N O R M A L E S
-*
- ANORM(1,1) = SINT1*COSP1
- ANORM(2,1) = SINT1*SINP1
- ANORM(3,1) = COST1
-
- ANORM(1,2) = SINT2*COSP1
- ANORM(2,2) = SINT2*SINP1
- ANORM(3,2) = COST2
-
- ANORM(1,3) = SINT2*COSP2
- ANORM(2,3) = SINT2*SINP2
- ANORM(3,3) = COST2
-
- ANORM(1,4) = SINT1*COSP2
- ANORM(2,4) = SINT1*SINP2
- ANORM(3,4) = COST1
-*
-** F I N D C O O R D I N A T E S O F V E R T I C E S
-*
- DO 120 I=1,4
- DO 110 K=1,3
- P(K,I) = ANORM(K,I)*R
- 110 CONTINUE
- CALL IGTRAN(P(1,I),T,P(1,I))
- 120 CONTINUE
-*
-** D R A W F A C E
-*
- DO 200 I=1,4
- X(I) = P(1,I)
- Y(I) = P(2,I)
- Z(I) = P(3,I)
- IF (LIGHT .NE. 0) THEN
- CALL IGTNOR(ANORM(1,I),T,ANORM(1,I))
- CALL IHLUMI(ANORM(1,I),F(I))
- END IF
- 200 CONTINUE
- IF (LIGHT .NE. 0) THEN
- CALL IFAF3(4,X,Y,Z,F)
- ELSE
- CALL IFA3(4,X,Y,Z)
- END IF
- 300 CONTINUE
- 400 CONTINUE
- END
diff --git a/src/graflib/higz/ig3/igtcop.F b/src/graflib/higz/ig3/igtcop.F
deleted file mode 100644
index fe9da01..0000000
--- a/src/graflib/higz/ig3/igtcop.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: igtcop.F,v 1.1.1.1 1996/02/14 13:10:42 mclareni Exp $
-*
-* $Log: igtcop.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:42 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 2.07/20 19/12/95 17.23.24 by O.Couet
-*-- Author :
- SUBROUTINE IGTCOP(T1,T2)
-************************************************************************
-* *
-* Name: IGTCOP Date: 04.12.95 *
-* Author: E.Chernyaev (IHEP/Protvino) Revised: *
-* *
-* Function: Copy transformation matrix T1 to transformation matrix T2 *
-* *
-************************************************************************
- REAL T1(4,3),T2(4,3)
-*-
- DO 200 K=1,4
- DO 100 I=1,3
- T2(K,I) = T1(K,I)
- 100 CONTINUE
- 200 CONTINUE
- END
diff --git a/src/graflib/higz/ig3/igtini.F b/src/graflib/higz/ig3/igtini.F
deleted file mode 100644
index 14b162a..0000000
--- a/src/graflib/higz/ig3/igtini.F
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: igtini.F,v 1.1.1.1 1996/02/14 13:10:42 mclareni Exp $
-*
-* $Log: igtini.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:42 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 2.07/20 19/12/95 17.23.24 by O.Couet
-*-- Author :
- SUBROUTINE IGTINI(T)
-************************************************************************
-* *
-* Name: IGTINI Date: 04.12.95 *
-* Author: E.Chernyaev (IHEP/Protvino) Revised: *
-* *
-* Function: Initialize matrix T by the identity transformation *
-* *
-************************************************************************
- REAL T(4,3)
-*-
- DO 200 I=1,3
- DO 100 K=1,4
- T(K,I) = 0.
- 100 CONTINUE
- T(I,I) = 1.
- 200 CONTINUE
- END
diff --git a/src/graflib/higz/ig3/igtmul.F b/src/graflib/higz/ig3/igtmul.F
deleted file mode 100644
index a4cb34a..0000000
--- a/src/graflib/higz/ig3/igtmul.F
+++ /dev/null
@@ -1,39 +0,0 @@
-*
-* $Id: igtmul.F,v 1.1.1.1 1996/02/14 13:10:42 mclareni Exp $
-*
-* $Log: igtmul.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:42 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 2.07/20 19/12/95 17.23.24 by O.Couet
-*-- Author :
- SUBROUTINE IGTMUL(T1,T2,T)
-************************************************************************
-* *
-* Name: IGTMUL Date: 04.12.95 *
-* Author: E.Chernyaev (IHEP/Protvino) Revised: *
-* *
-* Function: Multiply two transformation matrixes *
-* *
-************************************************************************
- REAL T1(4,3),T2(4,3),T(4,3)
- DOUBLE PRECISION DT1(4,4),DT2(4,3)
-*-
- DO 120 I=1,4
- DO 110 K=1,3
- DT1(I,K) = T1(I,K)
- DT2(I,K) = T2(I,K)
- 110 CONTINUE
- DT1(I,4) = 0.
- 120 CONTINUE
- DT1(4,4) = 1.
-*
- DO 220 I=1,4
- DO 210 K=1,3
- T(I,K) = DT1(I,1)*DT2(1,K) + DT1(I,2)*DT2(2,K) +
- + DT1(I,3)*DT2(3,K) + DT1(I,4)*DT2(4,K)
- 210 CONTINUE
- 220 CONTINUE
- END
diff --git a/src/graflib/higz/ig3/igtnor.F b/src/graflib/higz/ig3/igtnor.F
deleted file mode 100644
index 42ca505..0000000
--- a/src/graflib/higz/ig3/igtnor.F
+++ /dev/null
@@ -1,39 +0,0 @@
-*
-* $Id: igtnor.F,v 1.1.1.1 1996/02/14 13:10:43 mclareni Exp $
-*
-* $Log: igtnor.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:43 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 2.07/20 19/12/95 17.23.24 by O.Couet
-*-- Author :
- SUBROUTINE IGTNOR(ANORM1,T,ANORM2)
-************************************************************************
-* *
-* Name: IGTNOR Date: 04.12.95 *
-* Author: E.Chernyaev (IHEP/Protvino) Revised: *
-* *
-* Function: Transform normal ANORM1 to normal ANORM2 using matrix T *
-* *
-************************************************************************
- REAL ANORM1(3),ANORM2(3),T(4,3)
- DOUBLE PRECISION X,Y,Z,A1,A2,A3,B1,B2,B3,C1,C2,C3
-*-
- X = ANORM1(1)
- Y = ANORM1(2)
- Z = ANORM1(3)
- A1 = T(1,1)
- A2 = T(2,1)
- A3 = T(3,1)
- B1 = T(1,2)
- B2 = T(2,2)
- B3 = T(3,2)
- C1 = T(1,3)
- C2 = T(2,3)
- C3 = T(3,3)
- ANORM2(1) = X*(B2*C3-B3*C2) + Y*(B3*C1-B1*C3) + Z*(B1*C2-B2*C1)
- ANORM2(2) = X*(C2*A3-C3*A2) + Y*(C3*A1-C1*A3) + Z*(C1*A2-C2*A1)
- ANORM2(3) = X*(A2*B3-A3*B2) + Y*(A3*B1-A1*B3) + Z*(A1*B2-A2*B1)
- END
diff --git a/src/graflib/higz/ig3/igtor.F b/src/graflib/higz/ig3/igtor.F
deleted file mode 100644
index 2fa72ab..0000000
--- a/src/graflib/higz/ig3/igtor.F
+++ /dev/null
@@ -1,111 +0,0 @@
-*
-* $Id: igtor.F,v 1.1.1.1 1996/02/14 13:10:43 mclareni Exp $
-*
-* $Log: igtor.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:43 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 2.07/20 19/12/95 17.23.24 by O.Couet
-*-- Author :
- SUBROUTINE IGTOR(LIGHT,T,R1,R2,N1,N2)
-************************************************************************
-* *
-* Name: IGTOR Date: 10.12.95 *
-* Author: E.Chernyaev (IHEP/Protvino) Revised: *
-* *
-* Function: Draw torus *
-* *
-************************************************************************
- REAL T(4,3),P(3,4),ANORM(3,4),X(4),Y(4),Z(4),F(4)
-*-
- IF (N1.LT.3 .OR. N2.LT.3) RETURN
- RAD = ATAN(1.)*4./180.
- A = RAD*360./N1
- B = RAD*360./N2
- DO 400 I1=1,N1
- COSA1 = COS((I1-1)*A)
- SINA1 = SIN((I1-1)*A)
- COSA2 = COS(I1*A)
- SINA2 = SIN(I1*A)
- IF (I1 .EQ. 1) THEN
- COSA1 = 1.
- SINA1 = 0.
- END IF
- IF (I1 .EQ. N1) THEN
- COSA2 = 1.
- SINA2 = 0.
- END IF
- DO 300 I2=1,N2
- COSB1 = COS((I2-1)*B)
- SINB1 = SIN((I2-1)*B)
- COSB2 = COS(I2*B)
- SINB2 = SIN(I2*B)
- IF (I2 .EQ. 1) THEN
- COSB1 = 1.
- SINB1 = 0.
- END IF
- IF (I2 .EQ. N2) THEN
- COSB2 = 1.
- SINB2 = 0.
- END IF
-*
-** F I N D N O R M A L E S
-*
- ANORM(1,1) = COSA1*COSB1
- ANORM(2,1) = SINA1*COSB1
- ANORM(3,1) = SINB1
-
- ANORM(1,2) = COSA2*COSB1
- ANORM(2,2) = SINA2*COSB1
- ANORM(3,2) = SINB1
-
- ANORM(1,3) = COSA2*COSB2
- ANORM(2,3) = SINA2*COSB2
- ANORM(3,3) = SINB2
-
- ANORM(1,4) = COSA1*COSB2
- ANORM(2,4) = SINA1*COSB2
- ANORM(3,4) = SINB2
-*
-** F I N D C O O R D I N A T E S O F V E R T I C E S
-*
- P(1,1) = ANORM(1,1)*R2 + R1*COSA1
- P(2,1) = ANORM(2,1)*R2 + R1*SINA1
- P(3,1) = ANORM(3,1)*R2
-
- P(1,2) = ANORM(1,2)*R2 + R1*COSA2
- P(2,2) = ANORM(2,2)*R2 + R1*SINA2
- P(3,2) = ANORM(3,2)*R2
-
- P(1,3) = ANORM(1,3)*R2 + R1*COSA2
- P(2,3) = ANORM(2,3)*R2 + R1*SINA2
- P(3,3) = ANORM(3,3)*R2
-
- P(1,4) = ANORM(1,4)*R2 + R1*COSA1
- P(2,4) = ANORM(2,4)*R2 + R1*SINA1
- P(3,4) = ANORM(3,4)*R2
- DO 100 I=1,4
- CALL IGTRAN(P(1,I),T,P(1,I))
- 100 CONTINUE
-*
-** D R A W F A C E
-*
- DO 200 I=1,4
- X(I) = P(1,I)
- Y(I) = P(2,I)
- Z(I) = P(3,I)
- IF (LIGHT .NE. 0) THEN
- CALL IGTNOR(ANORM(1,I),T,ANORM(1,I))
- CALL IHLUMI(ANORM(1,I),F(I))
- END IF
- 200 CONTINUE
- IF (LIGHT .NE. 0) THEN
- CALL IFAF3(4,X,Y,Z,F)
- ELSE
- CALL IFA3(4,X,Y,Z)
- END IF
- 300 CONTINUE
- 400 CONTINUE
- END
diff --git a/src/graflib/higz/ig3/igtran.F b/src/graflib/higz/ig3/igtran.F
deleted file mode 100644
index a1874df..0000000
--- a/src/graflib/higz/ig3/igtran.F
+++ /dev/null
@@ -1,30 +0,0 @@
-*
-* $Id: igtran.F,v 1.1.1.1 1996/02/14 13:10:43 mclareni Exp $
-*
-* $Log: igtran.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:43 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 2.07/20 19/12/95 17.23.24 by O.Couet
-*-- Author :
- SUBROUTINE IGTRAN(P1,T,P2)
-************************************************************************
-* *
-* Name: IGTRAN Date: 04.12.95 *
-* Author: E.Chernyaev (IHEP/Protvino) Revised: *
-* *
-* Function: Transform point P1 to point P2 using matrix T *
-* *
-************************************************************************
- REAL P1(3),P2(3),T(4,3)
- DOUBLE PRECISION P(3)
-*-
- P(1) = P1(1)
- P(2) = P1(2)
- P(3) = P1(3)
- DO 100 I=1,3
- P2(I) = T(1,I)*P(1) + T(2,I)*P(2) + T(3,I)*P(3) + T(4,I)
- 100 CONTINUE
- END
diff --git a/src/graflib/higz/ig3/igtref.F b/src/graflib/higz/ig3/igtref.F
deleted file mode 100644
index 7e9a841..0000000
--- a/src/graflib/higz/ig3/igtref.F
+++ /dev/null
@@ -1,67 +0,0 @@
-*
-* $Id: igtref.F,v 1.1.1.1 1996/02/14 13:10:43 mclareni Exp $
-*
-* $Log: igtref.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:43 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 2.07/20 19/12/95 17.23.24 by O.Couet
-*-- Author :
- SUBROUTINE IGTREF(P,ANORM,T)
-************************************************************************
-* *
-* Name: IGTREF Date: 04.12.95 *
-* Author: E.Chernyaev (IHEP/Protvino) Revised: *
-* *
-* Function: Add to matrix T the reflection in a plane going though *
-* point P and whose normal is equal to ANORM *
-* *
-************************************************************************
- REAL P(3),ANORM(3),T(4,3)
- DOUBLE PRECISION A,B,C,D,S,DT1(4,4),DT2(4,3)
-*-
- A = ANORM(1)
- B = ANORM(2)
- C = ANORM(3)
- S = DSQRT(A*A+B*B+C*C)
- SS = S
- IF (SS .EQ. 0.) GOTO 999
- A = A/S
- B = B/S
- C = C/S
- D = -(A*P(1)+B*P(2)+C*P(3))
-*
- DT2(1,1) = -A*A + B*B + C*C
- DT2(2,1) = -2*A*B
- DT2(3,1) = -2*A*C
- DT2(4,1) = -2*A*D
-*
- DT2(1,2) = -2*A*B
- DT2(2,2) = A*A - B*B + C*C
- DT2(3,2) = -2*B*C
- DT2(4,2) = -2*B*D
-*
- DT2(1,3) = -2*A*C
- DT2(2,3) = -2*B*C
- DT2(3,3) = A*A + B*B - C*C
- DT2(4,3) = -2*C*D
- DO 120 I=1,4
-*
- DO 110 K=1,3
- DT1(I,K) = T(I,K)
- 110 CONTINUE
- DT1(I,4) = 0.
- 120 CONTINUE
- DT1(4,4) = 1.
-*
- DO 220 I=1,4
- DO 210 K=1,3
- T(I,K) = DT1(I,1)*DT2(1,K) + DT1(I,2)*DT2(2,K) +
- + DT1(I,3)*DT2(3,K) + DT1(I,4)*DT2(4,K)
- 210 CONTINUE
- 220 CONTINUE
-*
- 999 RETURN
- END
diff --git a/src/graflib/higz/ig3/igtrot.F b/src/graflib/higz/ig3/igtrot.F
deleted file mode 100644
index 9775bb8..0000000
--- a/src/graflib/higz/ig3/igtrot.F
+++ /dev/null
@@ -1,73 +0,0 @@
-*
-* $Id: igtrot.F,v 1.1.1.1 1996/02/14 13:10:43 mclareni Exp $
-*
-* $Log: igtrot.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:43 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 2.07/20 19/12/95 17.23.24 by O.Couet
-*-- Author :
- SUBROUTINE IGTROT(ANG,P1,P2,T)
-************************************************************************
-* *
-* Name: IGTROT Date: 04.12.95 *
-* Author: E.Chernyaev (IHEP/Protvino) Revised: *
-* *
-* Function: Add to matrix T the rotation though ANG (counterclockwise) *
-* around an axis P1->P2 *
-* *
-************************************************************************
- REAL P1(3),P2(3),T(4,3)
- DOUBLE PRECISION DX,DY,DZ,CX,CY,CZ,S,RAD,COSA,SINA
- DOUBLE PRECISION DT1(4,4),DT2(4,3)
-*-
- DX = P1(1)
- DY = P1(2)
- DZ = P1(3)
- CX = P2(1) - P1(1)
- CY = P2(2) - P1(2)
- CZ = P2(3) - P1(3)
- S = DSQRT(CX*CX + CY*CY + CZ*CZ)
- SS = S
- IF (SS .EQ. 0.) GOTO 999
- CX = CX / S
- CY = CY / S
- CZ = CZ / S
- RAD = DATAN(1.0D+00)*4./180.0
- COSA = DCOS(ANG*RAD)
- SINA = DSIN(ANG*RAD)
-*
- DT2(1,1) = COSA + (1.-COSA)*CX*CX
- DT2(2,1) = (1.-COSA)*CX*CY - SINA*CZ
- DT2(3,1) = (1.-COSA)*CX*CZ + SINA*CY
- DT2(4,1) = DX - DT2(1,1)*DX - DT2(2,1)*DY - DT2(3,1)*DZ
-*
- DT2(1,2) = (1.-COSA)*CY*CX + SINA*CZ
- DT2(2,2) = COSA + (1.-COSA)*CY*CY
- DT2(3,2) = (1.-COSA)*CY*CZ - SINA*CX
- DT2(4,2) = DY - DT2(1,2)*DX - DT2(2,2)*DY - DT2(3,2)*DZ
-*
- DT2(1,3) = (1.-COSA)*CZ*CX - SINA*CY
- DT2(2,3) = (1.-COSA)*CZ*CY + SINA*CX
- DT2(3,3) = COSA + (1.-COSA)*CZ*CZ
- DT2(4,3) = DZ - DT2(1,3)*DX - DT2(2,3)*DY - DT2(3,3)*DZ
-*
- DO 120 I=1,4
- DO 110 K=1,3
- DT1(I,K) = T(I,K)
- 110 CONTINUE
- DT1(I,4) = 0.
- 120 CONTINUE
- DT1(4,4) = 1.
-*
- DO 220 I=1,4
- DO 210 K=1,3
- T(I,K) = DT1(I,1)*DT2(1,K) + DT1(I,2)*DT2(2,K) +
- + DT1(I,3)*DT2(3,K) + DT1(I,4)*DT2(4,K)
- 210 CONTINUE
- 220 CONTINUE
-*
- 999 RETURN
- END
diff --git a/src/graflib/higz/ig3/igtsca.F b/src/graflib/higz/ig3/igtsca.F
deleted file mode 100644
index 7d8bfe9..0000000
--- a/src/graflib/higz/ig3/igtsca.F
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: igtsca.F,v 1.1.1.1 1996/02/14 13:10:43 mclareni Exp $
-*
-* $Log: igtsca.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:43 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 2.07/20 19/12/95 17.23.24 by O.Couet
-*-- Author :
- SUBROUTINE IGTSCA(SX,SY,SZ,T)
-************************************************************************
-* *
-* Name: IGTSCA Date: 04.12.95 *
-* Author: E.Chernyaev (IHEP/Protvino) Revised: *
-* *
-* Function: Add to matrix T the scaling transformation with factors *
-* SX, SY, SZ *
-* *
-************************************************************************
- REAL T(4,3)
-*-
- DO 100 I=1,4
- T(I,1) = T(I,1) * SX
- T(I,2) = T(I,2) * SY
- T(I,3) = T(I,3) * SZ
- 100 CONTINUE
- END
diff --git a/src/graflib/higz/ig3/igttra.F b/src/graflib/higz/ig3/igttra.F
deleted file mode 100644
index bf01dab..0000000
--- a/src/graflib/higz/ig3/igttra.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: igttra.F,v 1.1.1.1 1996/02/14 13:10:43 mclareni Exp $
-*
-* $Log: igttra.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:43 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 2.07/20 19/12/95 17.23.24 by O.Couet
-*-- Author :
- SUBROUTINE IGTTRA(DX,DY,DZ,T)
-************************************************************************
-* *
-* Name: IGTTRA Date: 04.12.95 *
-* Author: E.Chernyaev (IHEP/Protvino) Revised: *
-* *
-* Function: Add to matrix T the translation by DX, DY, DZ *
-* *
-************************************************************************
- REAL T(4,3)
-*-
- T(4,1) = T(4,1) + DX
- T(4,2) = T(4,2) + DY
- T(4,3) = T(4,3) + DZ
- END
diff --git a/src/graflib/higz/ig3/ipl3.F b/src/graflib/higz/ig3/ipl3.F
deleted file mode 100644
index ac2ed73..0000000
--- a/src/graflib/higz/ig3/ipl3.F
+++ /dev/null
@@ -1,47 +0,0 @@
-*
-* $Id: ipl3.F,v 1.1.1.1 1996/02/14 13:10:43 mclareni Exp $
-*
-* $Log: ipl3.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:43 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.23/06 21/11/95 15.35.07 by O.Couet
-*-- Author : O.Couet 06/01/92
- SUBROUTINE IPL3(N,X,Y,Z)
-#include "higz/hiatt.inc"
-#include "higz/higraf.inc"
-#include "higz/hi3d.inc"
- DIMENSION X(*),Y(*),Z(*)
- IF (IDIM.EQ.3) THEN
-#if defined(CERNLIB_PHIGS)
- CALL PPL3(N,X,Y,Z)
-#endif
- ELSE
- NGRAF = 0
- DO 20 I=1,N
- NGRAF = NGRAF+1
- XGRAF(NGRAF) = AWNX*X(I)+BWNX*Y(I)+CWNX*Z(I)+DWNX
- YGRAF(NGRAF) = AWNY*X(I)+BWNY*Y(I)+CWNY*Z(I)+DWNY
- ZGRAF(NGRAF) = AWNZ*X(I)+BWNZ*Y(I)+CWNZ*Z(I)+DWNZ
- IF(NGRAF.EQ.NPMAX.OR.I.EQ.N)THEN
- IF (IZBUF.NE.0) THEN
-#if defined(CERNLIB_ZBUF)
- DO 10 J=2,NGRAF
- CALL IHZLIN(IPLCI,XGRAF(J-1),YGRAF(J-1),ZGRAF(J-1)
- +, XGRAF(J) ,YGRAF(J) ,ZGRAF(J) )
- 10 CONTINUE
-#endif
- ELSE
- CALL IPL(NGRAF,XGRAF,YGRAF)
- ENDIF
- XGRAF(1) = XGRAF(NGRAF)
- YGRAF(1) = YGRAF(NGRAF)
- ZGRAF(1) = ZGRAF(NGRAF)
- NGRAF = 1
- ENDIF
- 20 CONTINUE
- ENDIF
-*
- END
diff --git a/src/graflib/higz/ig3/ipm3.F b/src/graflib/higz/ig3/ipm3.F
deleted file mode 100644
index de851d7..0000000
--- a/src/graflib/higz/ig3/ipm3.F
+++ /dev/null
@@ -1,35 +0,0 @@
-*
-* $Id: ipm3.F,v 1.1.1.1 1996/02/14 13:10:43 mclareni Exp $
-*
-* $Log: ipm3.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:43 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.23/06 14/11/95 10.26.40 by O.Couet
-*-- Author : O.Couet 06/01/92
- SUBROUTINE IPM3(N,X,Y,Z)
-#include "higz/hiatt.inc"
-#include "higz/higraf.inc"
-#include "higz/hi3d.inc"
- DIMENSION X(*),Y(*),Z(*)
- IF (IDIM.EQ.3) THEN
-#if defined(CERNLIB_PHIGS)
- CALL PPM3(N,X,Y,Z)
-#endif
- ELSE
- NGRAF=0
- DO 10 I=1,N
- NGRAF = NGRAF+1
- XGRAF(NGRAF) = AWNX*X(I)+BWNX*Y(I)+CWNX*Z(I)+DWNX
- YGRAF(NGRAF) = AWNY*X(I)+BWNY*Y(I)+CWNY*Z(I)+DWNY
- ZGRAF(NGRAF) = AWNZ*X(I)+BWNZ*Y(I)+CWNZ*Z(I)+DWNZ
- IF(NGRAF.EQ.NPMAX.OR.I.EQ.N)THEN
- CALL IPM(NGRAF,XGRAF,YGRAF)
- NGRAF = 0
- ENDIF
- 10 CONTINUE
- ENDIF
-*
- END
diff --git a/src/graflib/higz/ig3/ipm3id.F b/src/graflib/higz/ig3/ipm3id.F
deleted file mode 100644
index b2f67da..0000000
--- a/src/graflib/higz/ig3/ipm3id.F
+++ /dev/null
@@ -1,42 +0,0 @@
-*
-* $Id: ipm3id.F,v 1.1.1.1 1996/02/14 13:10:43 mclareni Exp $
-*
-* $Log: ipm3id.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:43 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.23/06 14/11/95 10.26.40 by O.Couet
-*-- Author : O.Couet 06/01/92
- SUBROUTINE IPM3ID(N,X,Y,Z,LEVEL,ID)
-#include "higz/hiatt.inc"
-#include "higz/higraf.inc"
-#include "higz/hihist.inc"
-#include "higz/hi3d.inc"
-#include "higz/hiflag.inc"
- DIMENSION X(*),Y(*),Z(*),ID(*)
- DIMENSION IDD(NPMAX)
- EQUIVALENCE (XWORK(1),IDD(1))
-*
- IF (IDIM.EQ.3) THEN
-#if defined(CERNLIB_PHIGS)
- CALL PPM3(N,X,Y,Z)
-#endif
- ELSE
- NGRAF = 0
- DO 10 I=1,N
- NGRAF = NGRAF+1
- XGRAF(NGRAF) = AWNX*X(I)+BWNX*Y(I)+CWNX*Z(I)+DWNX
- YGRAF(NGRAF) = AWNY*X(I)+BWNY*Y(I)+CWNY*Z(I)+DWNY
- ZGRAF(NGRAF) = AWNZ*X(I)+BWNZ*Y(I)+CWNZ*Z(I)+DWNZ
- IDD(NGRAF) = ID(I)
- IF(NGRAF.EQ.NPMAX.OR.I.EQ.N)THEN
- CALL IPM(NGRAF,XGRAF,YGRAF)
- IF(ZFLAG)CALL IGADID(LEVEL,NGRAF,IDD)
- NGRAF = 0
- ENDIF
- 10 CONTINUE
- ENDIF
-*
- END
diff --git a/src/graflib/higz/ig3/isvp3.F b/src/graflib/higz/ig3/isvp3.F
deleted file mode 100644
index 455597a..0000000
--- a/src/graflib/higz/ig3/isvp3.F
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: isvp3.F,v 1.1.1.1 1996/02/14 13:10:43 mclareni Exp $
-*
-* $Log: isvp3.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:43 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.22/03 06/01/95 13.24.56 by O.Couet
-*-- Author : O.Couet 20/12/93
- SUBROUTINE ISVP3(NT,X1,X2,Y1,Y2)
-*.===========>
-*.
-*. Define the 3D viewport (in 2D world coordinates)
-*.
-*. _Input parameters:
-*.
-*. INTEGER NT : Normalisation transformation number.
-*. REAL X1,X2,Y1,Y2 : 3D viewport.
-*.
-*..==========> (O.Couet)
-#if defined(CERNLIB_NTC)||defined(CERNLIB_X11)
-*
- IF ( X2.LE.X1 .OR. Y2.LE.Y1 ) THEN
- CALL IGERR ('Invalid 3D viewport definition','ISVP3')
- RETURN
- ENDIF
-*
- IF ( IGNSCU(NT) .EQ. 0 ) CALL IGNCRE (NT)
- CALL IGNS3V (X1,X2,Y1,Y2)
-#endif
- END
diff --git a/src/graflib/higz/ig3/iswn3.F b/src/graflib/higz/ig3/iswn3.F
deleted file mode 100644
index 7e575a2..0000000
--- a/src/graflib/higz/ig3/iswn3.F
+++ /dev/null
@@ -1,38 +0,0 @@
-*
-* $Id: iswn3.F,v 1.1.1.1 1996/02/14 13:10:43 mclareni Exp $
-*
-* $Log: iswn3.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:43 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.22/03 06/01/95 13.29.57 by O.Couet
-*-- Author : O.Couet 20/12/93
- SUBROUTINE ISWN3(NT,X1,X2,Y1,Y2,Z1,Z2,PHI,THETA,PSI,CHOPT)
-*.===========>
-*.
-*. Define the 3D window
-*.
-*. _Input parameters:
-*.
-*. INTEGER NT : Normalisation transformation number.
-*. REAL X1,X2,Y1,Y2,Z1,Z2 : 3D volume.
-*. REAL PHI,THETA,PSI : 3D vue angles.
-*. CHARACTER CHOPT : Options.
-*.
-*..==========> (O.Couet)
- CHARACTER*(*) CHOPT
-*.______________________________________
-*
-#if defined(CERNLIB_NTC)||defined(CERNLIB_X11)
-*
- IF ( X2.LE.X1. OR. Y2.LE.Y1. OR. Z2.LE.Z1 ) THEN
- CALL IGERR ('Invalid 3D window definition','ISWN3')
- RETURN
- ENDIF
-*
- IF ( IGNSCU(NT) .EQ. 0 ) CALL IGNCRE(NT)
- CALL IGNS3W (X1,X2,Y1,Y2,Z1,Z2,PHI,THETA,PSI)
-#endif
- END
diff --git a/src/graflib/higz/ig3/itx3.F b/src/graflib/higz/ig3/itx3.F
deleted file mode 100644
index 56258cc..0000000
--- a/src/graflib/higz/ig3/itx3.F
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: itx3.F,v 1.1.1.1 1996/02/14 13:10:43 mclareni Exp $
-*
-* $Log: itx3.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:43 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.23/06 14/11/95 10.26.40 by O.Couet
-*-- Author : O.Couet 07/05/92
- SUBROUTINE ITX3(X,Y,Z,TEXT)
-#include "higz/hi3d.inc"
- CHARACTER*(*) TEXT
- X2 = AWNX*X+BWNX*Y+CWNX*Z+DWNX
- Y2 = AWNY*X+BWNY*Y+CWNY*Z+DWNY
- Z2 = AWNZ*X+BWNZ*Y+CWNZ*Z+DWNZ
- CALL ITX(X2,Y2,TEXT)
-*
- END
diff --git a/src/graflib/higz/igks/Imakefile b/src/graflib/higz/igks/Imakefile
deleted file mode 100644
index 9842f33..0000000
--- a/src/graflib/higz/igks/Imakefile
+++ /dev/null
@@ -1,8 +0,0 @@
-SRCS_F= iacwk.F iclks.F iclrwk.F iclwk.F idawk.F ifa.F igsa.F \ @@\
- igsg.F igsgn.F iopks.F iopwk.F ipl.F ipm.F irqlc.F irqst.F \ @@\
- ischh.F ischup.F isclip.F iscr.F iselnt.F isfaci.F isfais.F \ @@\
- isfasi.F isln.F islwsc.F ismk.F ismksc.F isplci.F ispmci.F \ @@\
- istxal.F istxci.F istxfp.F isvp.F iswkvp.F iswkwn.F iswn.F \ @@\
- itx.F iuwk.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/graflib/higz/igks/Imakefile.dgks b/src/graflib/higz/igks/Imakefile.dgks
deleted file mode 100644
index f5354e2..0000000
--- a/src/graflib/higz/igks/Imakefile.dgks
+++ /dev/null
@@ -1,12 +0,0 @@
-SRCS_F= iacwk.F iclks.F iclrwk.F iclwk.F idawk.F ifa.F igsa.F \ @@\
- igsg.F igsgn.F iopks.F iopwk.F ipl.F ipm.F irqlc.F irqst.F \ @@\
- ischh.F ischup.F isclip.F iscr.F iselnt.F isfaci.F isfais.F \ @@\
- isfasi.F isln.F islwsc.F ismk.F ismksc.F isplci.F ispmci.F \ @@\
- istxal.F istxci.F istxfp.F isvp.F iswkvp.F iswkwn.F iswn.F \ @@\
- itx.F iuwk.F
-
-SubdirExtraLibraryTarget(NullParameter,NullParameter,NullParameter,dgks)
-
-VersionFortranObjectRule(dgks,NullParameter,-DCERNLIB_DECGKS)
-
-BuildNamedMakefileTarget(Makefile.dgks,Imakefile.dgks,-DCERNLIB_DECGKS)
diff --git a/src/graflib/higz/igks/iacwk.F b/src/graflib/higz/igks/iacwk.F
deleted file mode 100644
index 2967ce4..0000000
--- a/src/graflib/higz/igks/iacwk.F
+++ /dev/null
@@ -1,57 +0,0 @@
-*
-* $Id: iacwk.F,v 1.2 1996/06/05 10:20:28 cernlib Exp $
-*
-* $Log: iacwk.F,v $
-* Revision 1.2 1996/06/05 10:20:28 cernlib
-* Move pilot.h before the ifdef for GKS
-*
-* Revision 1.1.1.1 1996/02/14 13:10:43 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-#if defined(CERNLIB_GKS)
-*CMZ : 1.09/00 02/11/89 16.25.36 by O.Couet
-*-- Author :
- SUBROUTINE IACWK(IWKID)
-*.===========>
-*.
-*. This routine actives a workstation .
-*.
-*. _Input parameters:
-*.
-*. INTEGER IWKID : Workstation identifier .
-*.
-*..==========> (O.Couet)
-#include "higz/hiflag.inc"
-#include "higz/hiatt.inc"
-*.______________________________________
-*
- IF(IWKID.EQ.0)THEN
- CALL IGERR('Workstation identifier equal 0','IACWK')
- RETURN
- ENDIF
- DO 10 I=1,INOPWK
- IF(ILOPWK(I).EQ.IWKID)THEN
- ACWKFL(I)=.TRUE.
- GOTO 20
- ENDIF
- 10 CONTINUE
- CALL IGERR('Workstation is not open','IACWK')
- RETURN
- 20 CONTINUE
-#if defined(CERNLIB_PSCRIPT)
-*
- IF(IGIWTY(IWKID).LT.0)THEN
- PFLAG=.TRUE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- RETURN
- ENDIF
-#endif
-#if defined(CERNLIB_GKS)
-*
- CALL GACWK(IWKID)
-#endif
-*
- END
-#endif
diff --git a/src/graflib/higz/igks/iclks.F b/src/graflib/higz/igks/iclks.F
deleted file mode 100644
index 7ce0ad6..0000000
--- a/src/graflib/higz/igks/iclks.F
+++ /dev/null
@@ -1,30 +0,0 @@
-*
-* $Id: iclks.F,v 1.2 1996/06/05 10:20:30 cernlib Exp $
-*
-* $Log: iclks.F,v $
-* Revision 1.2 1996/06/05 10:20:30 cernlib
-* Move pilot.h before the ifdef for GKS
-*
-* Revision 1.1.1.1 1996/02/14 13:10:44 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-#if defined(CERNLIB_GKS)
-*CMZ : 1.06/04 27/01/89 16.40.30 by O.Couet
-*-- Author :
- SUBROUTINE ICLKS
-*.===========>
-*.
-*. This routine closes the graphic package .
-*.
-*..==========> (O.Couet)
-#include "higz/hiflag.inc"
-*.______________________________________
-*
-#if defined(CERNLIB_GKS)
- IF(GFLAG)CALL GCLKS
-#endif
-*
- END
-#endif
diff --git a/src/graflib/higz/igks/iclrwk.F b/src/graflib/higz/igks/iclrwk.F
deleted file mode 100644
index 57352db..0000000
--- a/src/graflib/higz/igks/iclrwk.F
+++ /dev/null
@@ -1,61 +0,0 @@
-*
-* $Id: iclrwk.F,v 1.2 1996/06/05 10:20:31 cernlib Exp $
-*
-* $Log: iclrwk.F,v $
-* Revision 1.2 1996/06/05 10:20:31 cernlib
-* Move pilot.h before the ifdef for GKS
-*
-* Revision 1.1.1.1 1996/02/14 13:10:44 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-#if defined(CERNLIB_GKS)
-*CMZ : 1.20/01 03/11/93 11.06.46 by O.Couet
-*-- Author :
- SUBROUTINE ICLRWK(WKID,COFL)
-*.===========>
-*.
-*. This routine clears the WKID workstation .
-*.
-*. _Input parameters:
-*.
-*. INTEGER WKID : Workstation identifier .
-*. INTEGER COFL : Control flag .
-*.
-*..==========> (O.Couet)
-#include "higz/hiflag.inc"
-#include "higz/hiatt.inc"
-#include "higz/himeta.inc"
- INTEGER WKID,COFL
-*.______________________________________
-*
- IF(IGIWTY(WKID).LT.0)GOTO 20
- IF(GFLAG)THEN
- CALL IGSG(0)
- IF(WKID.NE.0)THEN
- IF((REDIT.NE.0).AND.(REDIT.NE.1.))THEN
- CALL IGCLES
- ELSE
- CALL GCLRWK(WKID,COFL)
- ENDIF
- ELSE
- DO 10 I=1,INOPWK
- IF(IGIWTY(ILOPWK(I)).LT.0)GOTO 10
- IF(ILOPWK(I).EQ.1.AND..NOT.TEKACT)GO TO 10
- IF((REDIT.NE.0).AND.(REDIT.NE.1.))THEN
- CALL IGCLES
- ELSE
- CALL GCLRWK(ILOPWK(I),COFL)
- ENDIF
- 10 CONTINUE
- ENDIF
- CALL IGSGN
- ENDIF
- 20 CONTINUE
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_PSCRIPT)||defined(CERNLIB_MAIL)
- IF(GLFLAG)CALL IZCLRD
-#endif
-*
- END
-#endif
diff --git a/src/graflib/higz/igks/iclwk.F b/src/graflib/higz/igks/iclwk.F
deleted file mode 100644
index d8a5a2e..0000000
--- a/src/graflib/higz/igks/iclwk.F
+++ /dev/null
@@ -1,65 +0,0 @@
-*
-* $Id: iclwk.F,v 1.2 1996/06/05 10:20:31 cernlib Exp $
-*
-* $Log: iclwk.F,v $
-* Revision 1.2 1996/06/05 10:20:31 cernlib
-* Move pilot.h before the ifdef for GKS
-*
-* Revision 1.1.1.1 1996/02/14 13:10:44 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-#if defined(CERNLIB_GKS)
-*CMZ : 1.18/09 08/06/93 17.58.36 by O.Couet
-*-- Author :
- SUBROUTINE ICLWK(IWKID)
-*.===========>
-*.
-*. This routine closes the IWKID workstation .
-*.
-*. _Input parameters:
-*.
-*. INTEGER IWKID : Workstation identifier .
-*.
-*..==========> (O.Couet)
-#include "higz/hiatt.inc"
-#include "higz/hiflag.inc"
-#if defined(CERNLIB_PSCRIPT)
-#include "higz/hipost.inc"
-#endif
-#include "higz/himeta.inc"
-*.______________________________________
-*
- IF(IWKID.EQ.IDMETA.AND.FILOPN)FILOPN=.FALSE.
-#if defined(CERNLIB_PSCRIPT)
- IF(IGIWTY(IWKID).LT.0)THEN
- CALL IPEND
- GOTO 30
- ENDIF
-#endif
-#if defined(CERNLIB_GKS)
- CALL IGSG(0)
- CALL GCLWK(IWKID)
-#endif
-*
-* Update the open-workstation list
-*
- 30 CONTINUE
- DO 50 I=1,INOPWK
- IF(ILOPWK(I).EQ.IWKID)THEN
- INOPWK=INOPWK-1
- DO 40 J=I,INOPWK
- ILOPWK(J) = ILOPWK(J+1)
- IWTYL(J) = IWTYL(J+1)
-#if defined(CERNLIB_PSCRIPT)
- IF (IWTYL(J).LT.0) IPSI = J
-#endif
- ACWKFL(J) = ACWKFL(J+1)
- 40 CONTINUE
- RETURN
- ENDIF
- 50 CONTINUE
-*
- END
-#endif
diff --git a/src/graflib/higz/igks/idawk.F b/src/graflib/higz/igks/idawk.F
deleted file mode 100644
index 5857422..0000000
--- a/src/graflib/higz/igks/idawk.F
+++ /dev/null
@@ -1,53 +0,0 @@
-*
-* $Id: idawk.F,v 1.2 1996/06/05 10:20:32 cernlib Exp $
-*
-* $Log: idawk.F,v $
-* Revision 1.2 1996/06/05 10:20:32 cernlib
-* Move pilot.h before the ifdef for GKS
-*
-* Revision 1.1.1.1 1996/02/14 13:10:44 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-#if defined(CERNLIB_GKS)
-*CMZ : 1.13/07 06/11/91 09.21.16 by O.Couet
-*-- Author :
- SUBROUTINE IDAWK(IWKID)
-*.===========>
-*.
-*. This routine deactives the IWKID workstation .
-*.
-*. _Input parameters:
-*.
-*. INTEGER IWKID : Workstation identifier .
-*.
-*..==========> (O.Couet)
-#include "higz/hiflag.inc"
-#include "higz/hiatt.inc"
-*.______________________________________
-*
- DO 10 I=1,INOPWK
- IF(ILOPWK(I).EQ.IWKID.AND.ACWKFL(I))THEN
- ACWKFL(I)=.FALSE.
- GOTO 20
- ENDIF
- 10 CONTINUE
- CALL IGERR('Workstation is not active','IDAWK')
- RETURN
- 20 CONTINUE
-#if defined(CERNLIB_PSCRIPT)
-*
- IF(IGIWTY(IWKID).LT.0)THEN
- PFLAG=.FALSE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- RETURN
- ENDIF
-#endif
-#if defined(CERNLIB_GKS)
-*
- CALL GDAWK(IWKID)
-#endif
-*
- END
-#endif
diff --git a/src/graflib/higz/igks/ifa.F b/src/graflib/higz/igks/ifa.F
deleted file mode 100644
index 6f4012f..0000000
--- a/src/graflib/higz/igks/ifa.F
+++ /dev/null
@@ -1,51 +0,0 @@
-*
-* $Id: ifa.F,v 1.2 1996/06/05 10:20:32 cernlib Exp $
-*
-* $Log: ifa.F,v $
-* Revision 1.2 1996/06/05 10:20:32 cernlib
-* Move pilot.h before the ifdef for GKS
-*
-* Revision 1.1.1.1 1996/02/14 13:10:44 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-#if defined(CERNLIB_GKS)
-*CMZ : 1.12/11 12/04/91 16.32.20 by O.Couet
-*-- Author :
- SUBROUTINE IFA(N,X,Y)
-*.===========>
-*.
-*. This routine draws a fill area .
-*.
-*. _Input parameters:
-*.
-*. INTEGER N : Number of points .
-*. REAL X(N) : X coordinates .
-*. REAL Y(N) : Y coordinates .
-*.
-*..==========> (O.Couet)
-#include "higz/hiflag.inc"
-#include "higz/hiatt.inc"
- DIMENSION X(*),Y(*)
-*.______________________________________
-*
- IF(N.LT.3)THEN
- CALL IGERR('Invalid number of points','IFA')
- RETURN
- ENDIF
-*
- IF(IFAIS.EQ.3.AND.IFASI.GE.100)THEN
- CALL IGFA(N,X,Y)
- ELSE
- IF(GFLAG)THEN
- CALL IGSG(0)
- CALL GFA(N,X,Y)
- ENDIF
- ENDIF
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_PSCRIPT)||defined(CERNLIB_MAIL)
- IF(GLFLAG)CALL IZFA(N,X,Y)
-#endif
-*
- END
-#endif
diff --git a/src/graflib/higz/igks/igsa.F b/src/graflib/higz/igks/igsa.F
deleted file mode 100644
index ce36846..0000000
--- a/src/graflib/higz/igks/igsa.F
+++ /dev/null
@@ -1,243 +0,0 @@
-*
-* $Id: igsa.F,v 1.3 1998/01/30 15:22:28 couet Exp $
-*
-* $Log: igsa.F,v $
-* Revision 1.3 1998/01/30 15:22:28 couet
-* - APOLLO version removed
-*
-* Revision 1.2 1996/06/05 10:20:33 cernlib
-* Move pilot.h before the ifdef for GKS
-*
-* Revision 1.1.1.1 1996/02/14 13:10:44 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-#if defined(CERNLIB_GKS)
-*CMZ : 1.21/01 12/04/94 09.21.01 by O.Couet
-*-- Author :
- SUBROUTINE IGSA(IIWK)
-*.===========>
-*.
-*. IGSA switches a raster terminal from graphics to alpha mode.
-*. The terminal must be an activated HIGZ workstation.This is done by
-*. prompting the user who should respond by typing RETURN or any
-*. character string followed by return.
-*.
-*..==========>
-#if (defined(CERNLIB_GKSGRAL)||defined(CERNLIB_ATCGKS))&&(defined(CERNLIB_IBM)||defined(CERNLIB_VAX)||defined(CERNLIB_SUN)||defined(CERNLIB_ALLIANT))
-#include "higz/hiatt.inc"
-#include "higz/hiflag.inc"
-#include "higz/himeta.inc"
-#endif
-#if (defined(CERNLIB_GKSGRAL))&&(defined(CERNLIB_NEWLIB))
- INTEGER ATTYPE,ATTVAL
- CHARACTER*80 ISTR
- INTEGER IB(1)
- LOGICAL FIRST/.TRUE./
- SAVE FIRST
- REAL RX(1)
-#endif
-#if (defined(CERNLIB_GKSGRAL)||defined(CERNLIB_ATCGKS))&&(defined(CERNLIB_IBM)||defined(CERNLIB_VAX)||defined(CERNLIB_SUN)||defined(CERNLIB_ALLIANT))
- COMMON/QUEST/IQUEST(100)
- LOGICAL INTRAC
-*.______________________________________
-*
- IF(GRFLAG)THEN
- GRFLAG=.FALSE.
- IWK=IIWK
- IF(IWK.EQ.0)IWK=1
- IF(IQUEST(100).EQ.-1)THEN
- IQUEST(100)=0
- ENDIF
- IF(INTRAC(DUMMY))THEN
-#endif
-#if (defined(CERNLIB_GKSGRAL))&&(defined(CERNLIB_IBM)||defined(CERNLIB_VAX)||defined(CERNLIB_ALLIANT))&&(!defined(CERNLIB_ATCGKS))&&(!defined(CERNLIB_NEWLIB))
- IF(TEKACT)CALL GCGTOA(IWK)
-#endif
-#if (defined(CERNLIB_GKSGRAL))&&(defined(CERNLIB_NEWLIB))
- IF(TEKACT)THEN
-*
-* hold graphic to look at
-* wait for enter
-* ignore 1. entry (in alpha window)
-*
- IF (IWTYPE.EQ.5003.OR.IWTYPE.EQ.5005) THEN
- IF(.NOT.FIRST) THEN
- CALL ASREAD(ATTYPE,ATTVAL,ICOUNT)
- IB(1) = 2
- CALL GK5XAO (200, 1,IB, 1,RX,RX,IB ,IB )
- END IF
- FIRST = .FALSE.
- END IF
-*
-* send window switch sequence for FALCO (7878)
-*
- IF (IWTYPE.EQ.7878) THEN
- CALL GKC1AS(105,1,IB)
- CALL GKC1AW
- CALL ERASC1
- END IF
-*
-* CLEAR ALPHA WINDOW FOR IPS-ATARI
-*
- IF (IWTYPE.EQ.4703.OR.IWTYPE.EQ.4713) THEN
- CALL ERASD3
- END IF
- ENDIF
-#endif
-#if (defined(CERNLIB_ATCGKS))&&(defined(CERNLIB_VAX)||defined(CERNLIB_SUN))
- IF(TEKACT)CALL GUESC001(IWK,0)
-#endif
-#if (defined(CERNLIB_GKSGRAL)||defined(CERNLIB_ATCGKS))&&(defined(CERNLIB_IBM)||defined(CERNLIB_VAX)||defined(CERNLIB_SUN)||defined(CERNLIB_ALLIANT))
- ENDIF
- ENDIF
-#endif
-#if (defined(CERNLIB_PLOT10GKS))&&(defined(CERNLIB_IBM))
-#include "higz/hiatt.inc"
-#include "higz/hiflag.inc"
- COMMON/QUEST/IQUEST(100)
- CHARACTER*80 REPLY
- INTEGER WKID,LSTRI
- INTEGER T4107
- PARAMETER (IPG=301400,IMAC=301401,T4107=410700)
- LOGICAL INTRAC
- DATA PGSW/Z18/
-*.______________________________________
-*
-*
-*
- IF(GRFLAG)THEN
- GRFLAG=.FALSE.
- IWK=IIWK
- IF(IWK.EQ.0)IWK=1
- CALL GUWK(IWK,0)
- IF(IQUEST(100).EQ.-1)THEN
- IQUEST(100)=0
- ELSE
- CALL GRQST(IWK,1,IST,LSTRI,REPLY)
- ENDIF
- IF(INTRAC(DUMMY))THEN
- IF(IWTYPE.EQ.IMAC)THEN
- CALL HWRASC(1,PGSW)
- CALL HWRASC(1,PGSW)
- ELSEIF(IWTYPE.EQ.IPG)THEN
- CALL HWRASC(1,PGSW)
- ELSEIF(IWTYPE.EQ.T4107)THEN
- CALL HWRASC(1,27)
- CALL HWRASC(1,37)
- CALL HWRASC(1,33)
- CALL HWRASC(1,49)
- ENDIF
- CALL HTIMEO(500)
- ENDIF
- ENDIF
-#endif
-#if (defined(CERNLIB_UNIGKS))&&(defined(CERNLIB_IBM))
-*
-* W.Wojcik, CCIN2P3/Lyon 19/06/87 (WOJCIK at FRCPN11)
-*
-#include "higz/hiatt.inc"
-#include "higz/hiflag.inc"
-*
- CHARACTER*20 REPLY
- PARAMETER (LIFN=2,LRFN=1,LCFN=4,LDTR=4)
- DIMENSION IFN(LIFN)
- DIMENSION RFN(LRFN)
- CHARACTER*(LCFN) CFN
- CHARACTER*80 DTR(LDTR)
-*
-*
- IF (GRFLAG) THEN
- GRFLAG=.FALSE.
- IWK=IIWK
- IF(IWK.EQ.0)IWK=1
-*
-* Test if GKS is open...
-*
- CALL GQOPS(IFLG)
- IF (IFLG.EQ.0) GO TO 99
-*
- CALL GQWKC(IWK,IERR,ICONID,IWTYPE)
-*
-* GKS not in proper state
-*
- IF (IERR.EQ. 7) GOTO 99
-*
-* Specified workstation id is not valid
-*
- IF (IERR.EQ.20) GOTO 99
-*
-* Specified workstation is not open
-*
- IF (IERR.EQ.25) GOTO 99
-*
- CALL GUWK(IDID,0)
-*
- IFN(1)=IDID
- IFN(2)=3
- RFN(1)=3.
- CFN='BELL'
-*
- CALL GPREC(LIFN,IFN,LRFN,RFN,LCFN,CFN,LDTR,DTR)
- CALL GESC(11,LDTR,DTR)
-*
- CALL GRQST(IWK,1,IERR,LREPLY,REPLY)
-*
- IFN(1)=IDID
- IFN(2)=1
- RFN(1)=1.
- CFN='IGSA'
-*
- CALL GPREC(LIFN,IFN,LRFN,RFN,LCFN,CFN,LDTR,DTR)
- CALL GESC(11,LDTR,DTR)
-*
- ENDIF
-*
-#endif
-#if (defined(CERNLIB_DECGKS))&&(defined(CERNLIB_VAX))
-#include "higz/hiatt.inc"
-#include "higz/hiflag.inc"
-#include "higz/himeta.inc"
-#include "higz/hilun.inc"
- COMMON/QUEST/IQUEST(100)
- LOGICAL INTRAC
- CHARACTER*1 BSLASH
-*.______________________________________
-*
- IF(GRFLAG)THEN
- GRFLAG=.FALSE.
- IWK=IIWK
- IF(IWK.EQ.0)IWK=1
- IF(IQUEST(100).EQ.-1)THEN
- IQUEST(100)=0
- ENDIF
- IF(INTRAC(DUMMY))THEN
- IWK=IIWK
- IF(IWK.EQ.0)IWK=IDID
- IF(IQUEST(100).EQ.-1)THEN
- IQUEST(100)=0
- ENDIF
- IF(IWK.NE.0) THEN
- IF((IWK.EQ.13).OR.(IWK.EQ.14).OR.
- + (IWK.EQ.16).OR.(IWK.EQ.17)) THEN
-#endif
-#if (!defined(CERNLIB_BSLASH))&&(defined(CERNLIB_DECGKS))&&(defined(CERNLIB_VAX))
- BSLASH = '\'
-#endif
-#if (defined(CERNLIB_BSLASH))&&(defined(CERNLIB_DECGKS))&&(defined(CERNLIB_VAX))
- BSLASH = '\\'
-#endif
-#if (defined(CERNLIB_DECGKS))&&(defined(CERNLIB_VAX))
- WRITE(LUNOUT,'(1X,A2)') CHAR(27)//BSLASH
- ELSEIF ((IWK.EQ.72).OR.(IWK.EQ.82)) THEN
- WRITE(LUNOUT,'(1X,A1)') CHAR(24)
- ENDIF
- ENDIF
-*
- ENDIF
- ENDIF
-#endif
-*
- 99 END
-#endif
diff --git a/src/graflib/higz/igks/igsg.F b/src/graflib/higz/igks/igsg.F
deleted file mode 100644
index 0347185..0000000
--- a/src/graflib/higz/igks/igsg.F
+++ /dev/null
@@ -1,195 +0,0 @@
-*
-* $Id: igsg.F,v 1.4 1998/01/30 15:22:29 couet Exp $
-*
-* $Log: igsg.F,v $
-* Revision 1.4 1998/01/30 15:22:29 couet
-* - APOLLO version removed
-*
-* Revision 1.3 1998/01/28 14:34:31 couet
-* - GGDM driver removed
-*
-* Revision 1.2 1996/06/05 10:20:34 cernlib
-* Move pilot.h before the ifdef for GKS
-*
-* Revision 1.1.1.1 1996/02/14 13:10:44 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-#if defined(CERNLIB_GKS)
-*CMZ : 1.18/03 25/05/93 16.58.09 by O.Couet
-*-- Author :
- SUBROUTINE IGSG(IIWK)
-*.===========>
-*.
-*. IGSG switches a raster terminal from alpha to graphics mode .
-*. The terminal must be an activated HIGZ workstation .
-*.
-*..==========> (O.Couet)
-#if (defined(CERNLIB_GKSGRAL)||defined(CERNLIB_ATCGKS))&&(defined(CERNLIB_IBM)||defined(CERNLIB_VAX)||defined(CERNLIB_SUN)||defined(CERNLIB_ALLIANT))
-#include "higz/hiatt.inc"
-#include "higz/hiflag.inc"
-#include "higz/himeta.inc"
-#endif
-#if (defined(CERNLIB_GKSGRAL))&&(defined(CERNLIB_NEWLIB))
- INTEGER WKID
- INTEGER ATTYPE,ATTVAL
- CHARACTER*80 ISTR
- INTEGER IB(1)
- REAL RX(1)
-#endif
-#if (defined(CERNLIB_GKSGRAL)||defined(CERNLIB_ATCGKS))&&(defined(CERNLIB_IBM)||defined(CERNLIB_VAX)||defined(CERNLIB_SUN)||defined(CERNLIB_ALLIANT))
-*.______________________________________
-*
- IF(.NOT.GRFLAG)THEN
- GRFLAG=.TRUE.
- IWK=IIWK
- IF(IWK.EQ.0)IWK=1
-#endif
-#if (defined(CERNLIB_GKSGRAL))&&(defined(CERNLIB_IBM)||defined(CERNLIB_VAX)||defined(CERNLIB_ALLIANT))&&(!defined(CERNLIB_ATCGKS))&&(!defined(CERNLIB_NEWLIB))
- IF(TEKACT)CALL GCATOG(IWK)
-#endif
-#if (defined(CERNLIB_GKSGRAL))&&(defined(CERNLIB_NEWLIB))
- IF(TEKACT)THEN
-*
-* switch from alpha to graphic window
-*
- IF (IWTYPE.EQ.5003.OR.IWTYPE.EQ.5005) THEN
- IB(1) = 1
- CALL GK5XAO (200, 1,IB, 1,RX,RX,IB ,IB )
- END IF
-*
-* treatment for FALCO (7878)
-*
- IF (IWTYPE.EQ.7878) THEN
- CALL GKC1AS(106,1,IB)
- CALL GKC1AW
- ENDIF
- ENDIF
-#endif
-#if (defined(CERNLIB_ATCGKS))&&(defined(CERNLIB_VAX)||defined(CERNLIB_SUN))
- IF(TEKACT)CALL GUESC001(IWK,1)
-#endif
-#if (defined(CERNLIB_GKSGRAL)||defined(CERNLIB_ATCGKS))&&(defined(CERNLIB_IBM)||defined(CERNLIB_VAX)||defined(CERNLIB_SUN)||defined(CERNLIB_ALLIANT))
- ENDIF
-#endif
-#if (defined(CERNLIB_PLOT10GKS))&&(defined(CERNLIB_IBM))
-#include "higz/hiatt.inc"
-#include "higz/hiflag.inc"
- INTEGER T4107
- PARAMETER (IPG=301400,IMAC=301401,T4107=410700)
- DATA ESC/Z1B/,GS/Z1D/
-*.______________________________________
-*
- IF(.NOT.GRFLAG)THEN
- GRFLAG=.TRUE.
- IF(IWTYPE.EQ.IMAC)THEN
- CALL HWRAS(1,ESC)
- CALL HWRAS(1,GS)
- ELSEIF(IWTYPE.EQ.IPG)THEN
- CALL HWRAS(1,ESC)
- CALL HWRAS(1,GS)
- ELSEIF(IWTYPE.EQ.T4107)THEN
- CALL HWRASC(1,27)
- CALL HWRASC(1,37)
- CALL HWRASC(1,33)
- CALL HWRASC(1,48)
- ENDIF
- ENDIF
-#endif
-#if (defined(CERNLIB_UNIGKS))&&(defined(CERNLIB_IBM))
-* W.WOJCIK, CCIN2P3/LYON 19/06/87 (WOJCIK AT FRCPN11)
-#include "higz/hiatt.inc"
-#include "higz/hiflag.inc"
-*
- PARAMETER (LIFN=2,LRFN=1,LCFN=4,LDTR=4)
- DIMENSION IFN(LIFN)
- DIMENSION RFN(LRFN)
- CHARACTER*(LCFN) CFN
- CHARACTER*80 DTR(LDTR)
-*
- CHARACTER*80 MSG
- INTEGER NTLUN,NSEQ
-*
- DATA NTLUN,NSEQ/88,1/
-*
- IF (.NOT.GRFLAG) THEN
- GRFLAG=.TRUE.
-*
-* TEST IF GKS IS OPEN...
- IWK=IIWK
- IF(IWK.EQ.0)IWK=1
- CALL GQOPS(IFLG)
- IF (IFLG.EQ.0) GO TO 99
-*
- CALL GQWKC(IWK,IERR,ICONID,IWTYPE)
-* GKS NOT IN PROPER STATE
- IF (IERR.EQ. 7) GO TO 99
-* SPECIFIED WORKSTATION ID IS NOT VALID
- IF (IERR.EQ.20) GO TO 99
-* SPECIFIED WORKSTATION IS NOT OPEN
- IF (IERR.EQ.25) GO TO 99
-*
- IF (NSEQ .EQ. 1) THEN
- MSG='FI FT00F001 TERM'
- IF (NTLUN .GT. 9) THEN
- WRITE(MSG(6:7),FMT='(I2)') NTLUN
- ELSE
- WRITE(MSG(7:7),FMT='(I1)') NTLUN
- ENDIF
- CALL VMCMS(MSG,IRC)
- ENDIF
- READ(UNIT=NTLUN,FMT='(A)',END=11) MSG
- GO TO 22
- 11 NSEQ = NSEQ + 1
- MSG='FI FT00F001 TERM'
- IF (NTLUN .GT. 9) THEN
- WRITE(MSG(6:7),FMT='(I2)') NTLUN
- ELSE
- WRITE(MSG(7:7),FMT='(I1)') NTLUN
- ENDIF
- IF (NSEQ .GT. 99) THEN
- WRITE(MSG(9:11),FMT='(I3)') NSEQ
- ELSE IF (NSEQ .GT. 9) THEN
- WRITE(MSG(10:11),FMT='(I2)') NSEQ
- ELSE
- WRITE(MSG(11:11),FMT='(I1)') NSEQ
- ENDIF
- CALL VMCMS(MSG,IRC)
- 22 IRC=IOSCLR()
-*
- IFN(1)=IWK
- IFN(2)=2
- RFN(1)=2.
- CFN='IGSG'
-*
- CALL GPREC(LIFN,IFN,LRFN,RFN,LCFN,CFN,LDTR,DTR)
- CALL GESC(11,LDTR,DTR)
-*
- ENDIF
-#endif
-#if (defined(CERNLIB_DECGKS))&&(defined(CERNLIB_VAX))
-#include "higz/hiatt.inc"
-#include "higz/hiflag.inc"
-#include "higz/himeta.inc"
-#include "higz/hilun.inc"
-*.______________________________________
-*
- IF(.NOT.GRFLAG)THEN
- GRFLAG=.TRUE.
- IWK=IIWK
- IF(IWK.EQ.0)IWK=1
- IF(IWK.NE.0) THEN
- IF((IWK.EQ.13).OR.(IWK.EQ.14).OR.
- + (IWK.EQ.16).OR.(IWK.EQ.17)) THEN
- WRITE(LUNOUT,'(1X,A4)') CHAR(27)//'[2J'
- ELSEIF ((IWK.EQ.72).OR.(IWK.EQ.82)) THEN
- WRITE(LUNOUT,'(1X,A4)') CHAR(27)//'[2J'
- ENDIF
- ENDIF
-*
- ENDIF
-#endif
-*
- END
-#endif
diff --git a/src/graflib/higz/igks/igsgn.F b/src/graflib/higz/igks/igsgn.F
deleted file mode 100644
index 52bc3db..0000000
--- a/src/graflib/higz/igks/igsgn.F
+++ /dev/null
@@ -1,43 +0,0 @@
-*
-* $Id: igsgn.F,v 1.2 1996/06/05 10:20:35 cernlib Exp $
-*
-* $Log: igsgn.F,v $
-* Revision 1.2 1996/06/05 10:20:35 cernlib
-* Move pilot.h before the ifdef for GKS
-*
-* Revision 1.1.1.1 1996/02/14 13:10:44 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-#if defined(CERNLIB_GKS)
-*CMZ : 1.06/03 12/12/88 15.20.43 by O.Couet
-*-- Author :
- SUBROUTINE IGSGN
-*.===========>
-*.
-*. IGSGN send escape characters to clear workstation (T4107)
-*. The terminal must be an activated HIGZ workstation .
-*.
-*..==========> (O.Couet)
-#if (defined(CERNLIB_PLOT10GKS))&&(defined(CERNLIB_IBM))
-#include "higz/hiatt.inc"
-#include "higz/hiflag.inc"
- INTEGER T4107
- PARAMETER (T4107=410700)
- DIMENSION N(3),M(32)
- DATA N/31,27,12/
- DATA M/32*22/
-*.______________________________________
-*
- CALL IGSG(0)
- IF(IWTYPE.EQ.T4107)THEN
- CALL HWRASC(3,N)
- DO 10 I=1,8
- CALL HWRASC(32,M)
- 10 CONTINUE
- ENDIF
-#endif
-*
- END
-#endif
diff --git a/src/graflib/higz/igks/iopks.F b/src/graflib/higz/igks/iopks.F
deleted file mode 100644
index ec14712..0000000
--- a/src/graflib/higz/igks/iopks.F
+++ /dev/null
@@ -1,152 +0,0 @@
-*
-* $Id: iopks.F,v 1.33 2004/06/10 07:54:24 couet Exp $
-*
-* $Log: iopks.F,v $
-* Revision 1.33 2004/06/10 07:54:24 couet
-* *** empty log message ***
-*
-* Revision 1.32 2003/07/23 09:48:21 couet
-* - 1.29/03
-*
-* Revision 1.31 2003/03/18 13:39:37 couet
-* - 1.29/02
-*
-* Revision 1.30 2003/02/17 10:06:04 couet
-* - 1.29/01
-*
-* Revision 1.29 2002/12/04 11:00:49 couet
-* - 1.29/00
-*
-* Revision 1.28 2002/05/22 09:18:43 couet
-* - 1.28/07
-*
-* Revision 1.27 2002/05/16 15:32:14 couet
-* - 1.28/06
-*
-* Revision 1.26 2002/04/04 10:23:19 couet
-* - 1.28/05
-*
-* Revision 1.25 2002/03/18 16:25:11 couet
-* - 1.28/04
-*
-* Revision 1.24 2001/12/07 15:52:29 couet
-* - 1.28/03
-*
-* Revision 1.23 2001/11/23 16:09:32 couet
-* - 1.28/02
-*
-* Revision 1.22 2001/10/17 14:42:57 couet
-* - 1.28/01
-*
-* Revision 1.21 2001/10/08 16:18:09 couet
-* - 1.28/00
-*
-* Revision 1.20 2001/05/31 08:08:40 couet
-* - 1.27/03
-*
-* Revision 1.19 2000/08/29 14:04:08 couet
-* - 1.27/02
-*
-* Revision 1.18 2000/07/14 15:19:04 couet
-* - 1.27/01
-*
-* Revision 1.17 2000/04/03 15:41:42 couet
-* - 1.27/00
-*
-* Revision 1.16 1999/10/20 14:16:58 couet
-* - 1.26/04
-*
-* Revision 1.15 1999/10/13 12:35:39 couet
-* - 1.26/03
-*
-* Revision 1.14 1999/10/06 14:05:30 couet
-* - 1.26/02
-*
-* Revision 1.13 1999/06/21 16:48:40 couet
-* - 1.26/01
-*
-* Revision 1.12 1999/05/06 06:59:34 couet
-* - version 1.26/00 to tag the following bug fixe in x11int.c:
-* "MapNotify is not supported by all the X11 emulators (problem on Mac !!!)"
-*
-* Revision 1.11 1999/01/07 15:31:31 couet
-* - 1.25/05
-*
-* Revision 1.10 1998/12/07 13:45:27 couet
-* - 1.25/04
-*
-* Revision 1.9 1998/11/16 11:15:13 couet
-* *** empty log message ***
-*
-* Revision 1.8 1998/11/16 11:13:49 couet
-* - 1.25/03
-*
-* Revision 1.7 1998/11/13 10:52:34 couet
-* - 1.25/02
-*
-* Revision 1.6 1998/05/26 09:23:00 couet
-* - 1.25/01
-*
-* Revision 1.5 1998/04/09 13:08:14 couet
-* - new version
-*
-* Revision 1.4 1997/01/30 10:55:15 couet
-* - version 1.23/09
-*
-* Revision 1.3 1996/06/05 10:20:35 cernlib
-* Move pilot.h before the ifdef for GKS
-*
-* Revision 1.2 1996/04/11 15:22:09 cernlib
-* Correct title handling
-*
-* Revision 1.1.1.1 1996/02/14 13:10:44 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-#if defined(CERNLIB_GKS)
-*CMZ : 1.21/03 31/05/94 15.05.05 by O.Couet
-*-- Author : O.Couet 02/10/90
- SUBROUTINE IOPKS(ERRFIL)
-*.===========>
-*.
-*. This routine opens the HIGZ kernel system .
-*.
-*. _Input parameters:
-*.
-*. INTEGER ERRFIL : LUN for error file .
-*.
-*..==========> (O.Couet)
-#include "higz/hilun.inc"
-#include "higz/hivers.inc"
- CHARACTER*16 TCARD
- INTEGER ERRFIL,IASF(13)
- DATA IASF/13*1/
-*.______________________________________
-*
- CALL UHTOC(
- + 40HVERSION 1.29/04 10/06/04
-#if !defined(CERNLIB_CRAY)
- +,4,TCARD,16)
-#else
- +,8,TCARD,16)
-#endif
- CHVERS = TCARD(9:16)
-*
- LUNERR=ERRFIL
-#if defined(CERNLIB_GKSGRAL)||defined(CERNLIB_DECGKS)||defined(CERNLIB_UNIGKS)||defined(CERNLIB_ATCGKS)
- IBUFA=0
- CALL GOPKS(ERRFIL,IBUFA)
-#endif
-#if defined(CERNLIB_GKSBX)
- CALL GOPKS(ERRFIL,-1)
-#endif
-#if defined(CERNLIB_PLOT10GKS)||defined(CERNLIB_MGKS)
- CALL GOPKS(ERRFIL)
-#endif
-#if !defined(CERNLIB_MGKS)
- CALL GSASF(IASF)
-#endif
-*
- END
-#endif
diff --git a/src/graflib/higz/igks/iopwk.F b/src/graflib/higz/igks/iopwk.F
deleted file mode 100644
index 6d6feb5..0000000
--- a/src/graflib/higz/igks/iopwk.F
+++ /dev/null
@@ -1,129 +0,0 @@
-*
-* $Id: iopwk.F,v 1.2 1996/06/05 10:20:36 cernlib Exp $
-*
-* $Log: iopwk.F,v $
-* Revision 1.2 1996/06/05 10:20:36 cernlib
-* Move pilot.h before the ifdef for GKS
-*
-* Revision 1.1.1.1 1996/02/14 13:10:44 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-#if defined(CERNLIB_GKS)
-*CMZ : 1.18/00 16/04/93 09.54.05 by O.Couet
-*-- Author :
- SUBROUTINE IOPWK(WKID,CONID,WTYPE)
-*.===========>
-*.
-*. This routine opens an HIGZ workstation .
-*.
-*. _Input parameters:
-*.
-*. INTEGER WKID : Workstation identifier .
-*. INTEGER CONID : Connection identifier .
-*. INTEGER WTYPE : Workstation type .
-*.
-*..==========> (O.Couet)
-#include "higz/hiflag.inc"
-#include "higz/hiatt.inc"
-#if defined(CERNLIB_UNIGKS)
-#include "higz/hilun.inc"
- CHARACTER*80 MSG
-#endif
-#if defined(CERNLIB_SUNGKS)
- LOGICAL OPENED
-#endif
- INTEGER WKID,CONID,WTYPE
-*.______________________________________
-*
-*
- IF(WKID.EQ.0)THEN
- CALL IGERR('Workstation identifier equal 0','IOPWK')
- RETURN
- ENDIF
- INOPWK=INOPWK+1
- ILOPWK(INOPWK)=WKID
- IWTYL(INOPWK)=WTYPE
- ACWKFL(INOPWK)=.FALSE.
- ICONID=CONID
-#if defined(CERNLIB_PSCRIPT)
-*
-* PostScript Metafile
-*
- IF(WTYPE.LT.0)THEN
- CALL IPINIT(WKID,ABS(CONID),WTYPE)
- RETURN
- ENDIF
-*
-#endif
-#if (defined(CERNLIB_PLOT10GKS))&&(defined(CERNLIB_GKS))&&(!defined(CERNLIB_IBM))
- IF(WKID.LT.2)THEN
- CALL HGTCID('TT',IERROR,ICONID)
- ENDIF
-#endif
-#if (defined(CERNLIB_GKS))&&(defined(CERNLIB_UNIGKS))
-*
-* Is the workstation available ?
-*
- I=1
- CALL GQEWK(I,IERR,NUMB,IWTYP)
- MSG= ' HIGZ - ERROR XXX IN GQEWK CALL'
- WRITE(UNIT=MSG(19:21),FMT='(I3)') IERR
- IF(IERR.NE.0)GOTO 20
-*
- DO 10 I=1,NUMB
- CALL GQEWK(I,IERR,N,IWTYP)
- IF(IERR.NE.0)GOTO 20
- IF(WTYPE.EQ.IWTYP)GOTO 30
- 10 CONTINUE
-*
- MSG= ' HIGZ - WORKSTATION XXXXXX NOT AVAILABLE'
- WRITE(UNIT=MSG(25:30),FMT='(I6)') WTYPE
- 20 WRITE(UNIT=LUNERR,FMT='(A)') MSG
- CALL GECLKS
- STOP 12
-*
-* Is the workstation 'OUTIN' ?
-*
- 30 CALL GQWKCA(WTYPE,IERR,ICAT)
- IF (ICAT.NE.2) THEN
- MSG= ' HIGZ - WORKSTATION XXXXXX NOT OUTIN CATEGORY'
- WRITE(UNIT=MSG(25:30),FMT='(I6)') WTYPE
- WRITE(UNIT=LUNERR,FMT='(A)') MSG
- CALL GECLKS
- STOP 12
- ENDIF
-*
-#endif
-#if defined(CERNLIB_SUNGKS)
- IF(WTYPE.EQ.3)THEN
- INQUIRE(ICONID,OPENED=OPENED)
- IF(.NOT.OPENED)OPEN(ICONID,FILE='SunGKS.moasc')
- ELSEIF(WTYPE.EQ.6)THEN
- INQUIRE(ICONID,OPENED=OPENED)
- IF(.NOT.OPENED)OPEN(ICONID,FILE='SunGKS.hpgl')
- ELSEIF(WTYPE.EQ.7)THEN
- INQUIRE(ICONID,OPENED=OPENED)
- IF(.NOT.OPENED)OPEN(ICONID,FILE='SunGKS.postscript')
- ELSEIF(WTYPE.EQ.8)THEN
- INQUIRE(ICONID,OPENED=OPENED)
- IF(.NOT.OPENED)OPEN(ICONID,FILE='SunGKS.cgmo')
- ELSEIF(WTYPE.EQ.10)THEN
- INQUIRE(ICONID,OPENED=OPENED)
- IF(.NOT.OPENED)OPEN(ICONID,FILE='SunGKS.mobin')
- ENDIF
-#endif
-#if defined(CERNLIB_GKS)
- IF(GFLAG)THEN
- CALL GOPWK(WKID,ICONID,WTYPE)
- CALL GQCF(WTYPE,IERR,INBCOL,ICOLA,NPCI)
- ENDIF
-#endif
-#if (defined(CERNLIB_GKS))&&(defined(CERNLIB_DECGKS))
- IF(GFLAG.AND.WTYPE.GE.200
- + .AND.WTYPE.LE.100000) CALL GSWKVP(WKID,0.,0.2,0.,0.2)
-#endif
-*
- END
-#endif
diff --git a/src/graflib/higz/igks/ipl.F b/src/graflib/higz/igks/ipl.F
deleted file mode 100644
index 03706cd..0000000
--- a/src/graflib/higz/igks/ipl.F
+++ /dev/null
@@ -1,180 +0,0 @@
-*
-* $Id: ipl.F,v 1.2 1996/06/05 10:20:37 cernlib Exp $
-*
-* $Log: ipl.F,v $
-* Revision 1.2 1996/06/05 10:20:37 cernlib
-* Move pilot.h before the ifdef for GKS
-*
-* Revision 1.1.1.1 1996/02/14 13:10:44 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-#if defined(CERNLIB_GKS)
-*CMZ : 1.22/09 23/03/95 15.21.39 by O.Couet
-*-- Author :
- SUBROUTINE IPL(N,X,Y)
-*.===========>
-*.
-*. This routine draws a polyline . The line type from 12 to 15 are independent
-*. from the underlaying basic graphics package .
-*.
-*. _Input parameters:
-*.
-*. INTEGER N : Number of points in the polyline .
-*. REAL X(N) : X coordinates .
-*. REAL Y(N) : Y coordinates .
-*.
-*..==========> (O.Couet)
-#include "higz/hiatt.inc"
-#include "higz/hiflag.inc"
- DIMENSION X(*),Y(*),XX(2),YY(2)
- DIMENSION XDOT(2),YDOT(2)
- LOGICAL ZSAV
- EQUIVALENCE (XOLD,XX(1)),(XNEW,XX(2))
- EQUIVALENCE (YOLD,YY(1)),(YNEW,YY(2))
- DATA XLSTEP,SMIN/0.2,0.0002/
-*.______________________________________
-*
- IF(N.LT.2)THEN
- CALL IGERR('Invalid number of points','IPL')
- RETURN
- ENDIF
-*
- IF((ILN.GE.12).AND.(GFLAG.OR.PFLAG))THEN
- CALL IGSG(0)
- ZSAV=ZFLAG
- ZFLAG=.FALSE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- NTSAV=INTR
- RATIO1=(RVXMAX-RVXMIN)/(RWXMAX-RWXMIN)
- RATIO2=(RVYMAX-RVYMIN)/(RWYMAX-RWYMIN)
- RWX1=RWXMIN
- RWY1=RWYMIN
- RVX1=RVXMIN
- RVY1=RVYMIN
- RVX2=RVXMAX
- RVY2=RVYMAX
- XLSTEP=RBSL
- SMIN=0.001*XLSTEP
- CALL ISELNT(0)
- ILNS=ILN
- CALL ISLN(1)
- IF((XLSTEP.LE.0.).OR.(XLSTEP.GT.1))XLSTEP=0.01
-*
-* Possibly dashed lines drawn
-*
- 10 MODE=1
- IDOT=0
- SRES=XLSTEP
-*
- DO 90 I=2,N
- XOLD=RATIO1*(X(I-1)-RWX1)+RVX1
- YOLD=RATIO2*(Y(I-1)-RWY1)+RVY1
-*
- DXSTEP=RATIO1*(X(I)-RWX1)+RVX1-XOLD
- DYSTEP=RATIO2*(Y(I)-RWY1)+RVY1-YOLD
- ADX=ABS(DXSTEP)
- ADY=ABS(DYSTEP)
- IF(ADX.LE.SMIN)THEN
- STEP=ADY
- DSX=0.
- DSY=SIGN(1.,DYSTEP)
- GOTO 20
- ENDIF
- IF(ADY.LE.SMIN)THEN
- STEP=ADX
- DSX=SIGN(1.,DXSTEP)
- DSY=0.
- GOTO 20
- ENDIF
- STEP=SQRT(DXSTEP*DXSTEP+DYSTEP*DYSTEP)
- DSX=DXSTEP/STEP
- DSY=DYSTEP/STEP
- 20 IF(STEP.LE.0.)GO TO 90
- DRES=STEP
-*
- 30 ST=SRES
- IF(ST.GT.DRES)ST=DRES
- SRES=SRES-ST
- DRES=DRES-ST
- XNEW=XOLD+ST*DSX
- YNEW=YOLD+ST*DSY
-*
- IF(ICLIP.EQ.1)THEN
- ICL=IGCLIP(XX,YY,RVX1,RVX2,RVY1,RVY2)
- IF(ICL.EQ.0)GOTO 80
- ENDIF
-*
- GO TO (40 ,40 ,50 ,60 ,70 ),ILNS-10
-*
-* Dashed line _ _ _ _ _ _ _
-*
- 40 CONTINUE
- IF(MODE.NE.0)THEN
-#if defined(CERNLIB_PSCRIPT)
- IF(PFLAG)CALL IZPL(2,XX,YY)
-#endif
- IF(GFLAG)CALL GPL(2,XX,YY)
- ENDIF
- GO TO 80
-*
-* Dash-dot line _._._._._.
-*
- 50 IF(MODE.EQ.0)GO TO 70
-#if defined(CERNLIB_PSCRIPT)
- IF(PFLAG)CALL IZPL(2,XX,YY)
-#endif
- IF(GFLAG)CALL GPL(2,XX,YY)
- GO TO 80
-*
-* Dot-blank . . . . . . .
-*
- 60 IF(MODE.EQ.0)GO TO 80
-*
-* Dotted line ............
-*
- 70 IF (SRES.LT.0.5*XLSTEP) IDOT=IDOT+1
- IF (IDOT.NE.1) GOTO 80
- XDOT(1)=XNEW-(0.5*XLSTEP-SRES)*DSX
- YDOT(1)=YNEW-(0.5*XLSTEP-SRES)*DSY
- MTS=IMK
- MCOL=IPMCI
- RMSC=RMKSC
- CALL ISMKSC(RLWSC)
- CALL ISMK(1)
- CALL ISPMCI(IPLCI)
- IF(GFLAG)CALL IPM(1,XDOT,YDOT)
-#if defined(CERNLIB_PSCRIPT)
- IF(PFLAG)CALL IZPM(1,XDOT,YDOT)
-#endif
- CALL ISMKSC(RMSC)
- CALL ISMK(MTS)
- CALL ISPMCI(MCOL)
-*
- 80 XOLD=XNEW
- YOLD=YNEW
- IF(SRES.LE.SMIN)THEN
- IDOT=0
- SRES=XLSTEP
- MODE=MODE+1
- IF(MODE.EQ.2)MODE=0
- ENDIF
- IF(DRES.GT.SMIN)GO TO 30
- 90 CONTINUE
- CALL ISELNT(NTSAV)
- CALL ISLN(ILNS)
- ZFLAG=ZSAV
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- ELSE
- IF(GFLAG)THEN
- CALL IGSG(0)
- CALL GPL(N,X,Y)
- ENDIF
- ENDIF
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_PSCRIPT)||defined(CERNLIB_MAIL)
- IF(GLFLAG)CALL IZPL(N,X,Y)
-#endif
-*
- END
-#endif
diff --git a/src/graflib/higz/igks/ipm.F b/src/graflib/higz/igks/ipm.F
deleted file mode 100644
index 2c9e080..0000000
--- a/src/graflib/higz/igks/ipm.F
+++ /dev/null
@@ -1,54 +0,0 @@
-*
-* $Id: ipm.F,v 1.2 1996/06/05 10:20:37 cernlib Exp $
-*
-* $Log: ipm.F,v $
-* Revision 1.2 1996/06/05 10:20:37 cernlib
-* Move pilot.h before the ifdef for GKS
-*
-* Revision 1.1.1.1 1996/02/14 13:10:44 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-#if defined(CERNLIB_GKS)
-*CMZ : 1.18/10 21/06/93 11.10.53 by O.Couet
-*-- Author :
- SUBROUTINE IPM(N,X,Y)
-*.===========>
-*.
-*. This routines draws markers .
-*.
-*. _Input parameters:
-*.
-*. INTEGER N : Number of markers .
-*. REAL X(N) : Markers X coordinates .
-*. REAL Y(N) : Markers Y coordinates .
-*.
-*..==========> (O.Couet)
-#include "higz/hiatt.inc"
-#include "higz/hiflag.inc"
- DIMENSION X(*),Y(*)
-*.______________________________________
-*
- IF(N.LT.1)THEN
- CALL IGERR('Invalid number of points','IPM')
- RETURN
- ENDIF
-*
- IF(GFLAG.OR.PFLAG)THEN
- CALL IGSG(0)
- IF(IMK.LT.20)THEN
- IF(.NOT.GFLAG)GOTO 20
- CALL GPM(N,X,Y)
- ELSE
- CALL IGPM(N,X,Y,IMK)
- ENDIF
- ENDIF
-*
- 20 CONTINUE
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_PSCRIPT)||defined(CERNLIB_MAIL)
- IF(GLFLAG)CALL IZPM(N,X,Y)
-#endif
-*
- END
-#endif
diff --git a/src/graflib/higz/igks/irqlc.F b/src/graflib/higz/igks/irqlc.F
deleted file mode 100644
index 94722bd..0000000
--- a/src/graflib/higz/igks/irqlc.F
+++ /dev/null
@@ -1,274 +0,0 @@
-*
-* $Id: irqlc.F,v 1.3 1998/01/30 15:22:30 couet Exp $
-*
-* $Log: irqlc.F,v $
-* Revision 1.3 1998/01/30 15:22:30 couet
-* - APOLLO version removed
-*
-* Revision 1.2 1996/06/05 10:20:38 cernlib
-* Move pilot.h before the ifdef for GKS
-*
-* Revision 1.1.1.1 1996/02/14 13:10:44 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-#if defined(CERNLIB_GKS)
-*CMZ : 1.21/03 01/06/94 13.38.23 by O.Couet
-*-- Author :
- SUBROUTINE IRQLC(WKID,LCN,ISTAT,TNR,XLOC,YLOC)
-*.===========>
-*.
-*. This routine returns the graphic cursor position in WC space in
-*. XLOC and YLOC . The same position in the NDC space is available in
-*. RQUEST(11) and RQUEST(12) . The normalization tranformation number
-*. is returned in TNR . After a call to IRQLC the window coordinates are
-*. available in RQUEST(20), RQUEST(21), RQUEST(22), and RQUEST(23). The
-*. viewport coordinates are available in RQUEST(30), RQUEST(31),
-* RQUEST(32), and RQUEST(33). This routine computed the XLOC and YLOC
-*. value according to value of the REDIT factor, but the value of
-*. RQUEST(11) and RQUEST(12) do not care about the value of REDIT. The
-*. REDIT factor is usefull for the graphics editor and the menu mode of
-*. KUIP.
-*. The values of XLOC and YLOC are computed with the parameters stored
-*. in the NT storage (HINT) if ZEBRA is not used, or if there no
-*. displayed picture. If an HIGZ picture is displayed, only the NT
-*. existing in this picture are used to compute the values of XLOC and
-*. YLOC.
-*.
-*. _Input parameters:
-*.
-*. INTEGER WKID : Workstation identifier .
-*. INTEGER LCN : Input device number .
-*. If LCN>10 then LCN=10*IPET+LNDNR
-*.
-*. _Output parameters:
-*.
-*. INTEGER ISTAT : Return status: 0=BREAK, 1=OK .
-*. INTEGER TNR : Normalization transformation number .
-*. REAL XLOC YLOC : Cursor position in WC space .
-*.
-*..==========> (O.Couet)
-#if defined(CERNLIB_ZEBRA)
-#include "higz/hipaw.inc"
-#endif
-#if !defined(CERNLIB_ZEBRA)
-#include "higz/hiques.inc"
-#endif
-#if !defined(CERNLIB_NTC)
-#include "higz/hint.inc"
-#endif
-#include "higz/hiloc.inc"
-#include "higz/hiatt.inc"
-#if defined(CERNLIB_MAIL)
-#include "higz/himail.inc"
-#endif
-#if defined(CERNLIB_MAIL)
-#include "higz/hiflag.inc"
-#endif
- INTEGER WKID,TNR
- CHARACTER*80 STR(4)
-#if defined(CERNLIB_SUNGKS)
- DIMENSION IA(10),RA(10)
- CHARACTER*1 CA
-#endif
-*.______________________________________
-*
-#if defined(CERNLIB_MAIL)
-*
-* MAIL option
-*
- IF(MFLAG)THEN
- WRITE (CHMAIL,'(3I3)') 555,WKID,LCN
- CALL IMWRIT(1)
- READ (5,'(2I5,2E16.7)') ISTAT,TNR,XLOC,YLOC
- CALL IMWRIT(5)
- RETURN
- ENDIF
-*
-#endif
- CALL IGSG(0)
- LCDNR=MOD(LCN,10)
- IPET=1
- LOCDEV=1
-#if !defined(CERNLIB_SUNGKS)
- LSTR=0
-#endif
-#if defined(CERNLIB_SUNGKS)
- IF (IPET.LE.3) THEN
- IA(1)=1
- CALL GPREC(1,IA,0,RA,0,0,CA,4,IERR,LSTR,STR)
- ELSEIF (IPET.EQ.4) THEN
- IA(1)=1
- IA(2)=0
- IA(3)=0
- IA(4)=0
- IA(5)=1
- IA(6)=1
- IA(7)=0
- RA(1)=1
- CALL GPREC(7,ID1,1,RD1,0,0,CA,4,IERR,LSTR,STR)
- ELSEIF (IPET.EQ.5) THEN
- IA(1)=0
- IA(2)=1
- IA(3)=0
- IA(4)=0
- IA(5)=0
- IA(6)=1
- IA(7)=1
- IA(8)=0
- RA(1)=1
- CALL GPREC(8,ID1,1,RD1,0,0,CA,4,IERR,LSTR,STR)
- ENDIF
-#endif
-#if defined(CERNLIB_ATCGKS)
- CALL GPREC(0,,0,,0,,CA,4,IERR,LSTR,STR)
-#endif
-#if defined(CERNLIB_DECGKS)
- CALL GINLC(WKID,LOCDEV,0,OLDXP,OLDYP,IPET
- +, RDVXMI,RDVXMA,RDVYMI,RDVYMA,LSTR,STR)
- LCDNR=LOCDEV
-#endif
-#if !defined(CERNLIB_DECGKS)
- CALL GINLC(WKID,LOCDEV,0,OLDXP,OLDYP,IPET,0.,RMDSX,0.,RMDSY,
- + LSTR,STR)
-#endif
- CALL GRQLC(WKID,LCDNR,ISTAT,TNR,RQUEST(11),RQUEST(12))
- IF(ISTAT.EQ.0)THEN
- RQUEST(11)=OLDXP
- RQUEST(12)=OLDYP
- RETURN
- ENDIF
- OLDXP=RQUEST(11)
- OLDYP=RQUEST(12)
-*
- SCALE=1.
- IF(REDIT.NE.0.)SCALE=REDIT
-*
- RQUEST(20)=0.
- RQUEST(21)=1.
- RQUEST(22)=0.
- RQUEST(23)=1.
- RQUEST(30)=0.
- RQUEST(31)=1.
- RQUEST(32)=0.
- RQUEST(33)=1.
- TNR=0
- XLOC=(RQUEST(11)+RDWXMI*REDIT)/SCALE
- YLOC=(RQUEST(12)+RDWYMI*REDIT)/SCALE
-#if defined(CERNLIB_ZEBRA)
-*
-* There is displayed picture
-*
- IF(LPICD.GT.0)THEN
- IPRIOO=IQ(LDNT0+3)
- NBNT=IQ(LPICD+8)-1
- LN=LQ(LDNT0)
- DO 10 I=1,NBNT
- IAWV=LDF+IQ(LN+2)
- IPRION=IQ(LN+3)
- RQUEST(20)=Q(IAWV)
- RQUEST(21)=Q(IAWV+1)
- RQUEST(22)=Q(IAWV+2)
- RQUEST(23)=Q(IAWV+3)
- RQUEST(30)=Q(IAWV+4)
- RQUEST(31)=Q(IAWV+5)
- RQUEST(32)=Q(IAWV+6)
- RQUEST(33)=Q(IAWV+7)
- IF((RQUEST(30)*SCALE-(RDWXMI*REDIT).LE.RQUEST(11)).AND.
- + (RQUEST(11).LE.RQUEST(31)*SCALE-(RDWXMI*REDIT)).AND.
- + (RQUEST(32)*SCALE-(RDWYMI*REDIT).LE.RQUEST(12)).AND.
- + (RQUEST(12).LE.RQUEST(33)*SCALE-(RDWYMI*REDIT)))THEN
- IF(IPRION.GT.IPRIOO)THEN
- XLOC=((((RQUEST(11)+(RDWXMI*REDIT))/SCALE)
- + -RQUEST(30))
- + /(RQUEST(31)-RQUEST(30)))
- + *(RQUEST(21)-RQUEST(20))
- + +RQUEST(20)
- YLOC=((((RQUEST(12)+(RDWYMI*REDIT))/SCALE)
- + -RQUEST(32))
- + /(RQUEST(33)-RQUEST(32)))
- + *(RQUEST(23)-RQUEST(22))
- + +RQUEST(22)
- TNR=IQ(LN+1)
- IPRIOO=IPRION
- ENDIF
- ENDIF
- LN=LQ(LN)
- IF(LN.EQ.0)RETURN
- 10 CONTINUE
- RETURN
- ENDIF
-#endif
-#if !defined(CERNLIB_NTC)
-*
-* The computing of XLOC and YLOC in done with the parameters
-* stored in HINT.
-*
- NBNT=NTSTOR(1)
- IPRIOO=NT0PRI
- DO 20 I=1,NBNT
- NNT=NTSTOR(2*I)
- CALL IZGNT(NNT,IFIND,IAWV,IPRION,IHPRIO)
- RQUEST(20)=WNVPST(IAWV)
- RQUEST(21)=WNVPST(IAWV+1)
- RQUEST(22)=WNVPST(IAWV+2)
- RQUEST(23)=WNVPST(IAWV+3)
- RQUEST(30)=WNVPST(IAWV+4)
- RQUEST(31)=WNVPST(IAWV+5)
- RQUEST(32)=WNVPST(IAWV+6)
- RQUEST(33)=WNVPST(IAWV+7)
- IF((RQUEST(30)*SCALE-(RDWXMI*REDIT).LE.RQUEST(11)).AND.
- + (RQUEST(11).LE.RQUEST(31)*SCALE-(RDWXMI*REDIT)).AND.
- + (RQUEST(32)*SCALE-(RDWYMI*REDIT).LE.RQUEST(12)).AND.
- + (RQUEST(12).LE.RQUEST(33)*SCALE-(RDWYMI*REDIT)))THEN
- IF(IPRION.GT.IPRIOO)THEN
- XLOC=((((RQUEST(11)+(RDWXMI*REDIT))/SCALE)
- + -RQUEST(30))
- + /(RQUEST(31)-RQUEST(30)))
- + *(RQUEST(21)-RQUEST(20))
- + +RQUEST(20)
- YLOC=((((RQUEST(12)+(RDWYMI*REDIT))/SCALE)
- + -RQUEST(32))
- + /(RQUEST(33)-RQUEST(32)))
- + *(RQUEST(23)-RQUEST(22))
- + +RQUEST(22)
- TNR=NNT
- IPRIOO=IPRION
- ENDIF
- ENDIF
- 20 CONTINUE
-#endif
-#if defined(CERNLIB_NTC)
- IPRIOO = NT0PRI
- IEND = IGNNXT(1)
- 30 IF(IEND.EQ.0)THEN
- CALL IGNGET(NNT,IPRION,IHPRIO
- +, RQUEST(20),RQUEST(21),RQUEST(22),RQUEST(23)
- +, RQUEST(30),RQUEST(31),RQUEST(32),RQUEST(33),I3D)
- IF((RQUEST(30)*SCALE-(RDWXMI*REDIT).LE.RQUEST(11)).AND.
- + (RQUEST(11).LE.RQUEST(31)*SCALE-(RDWXMI*REDIT)).AND.
- + (RQUEST(32)*SCALE-(RDWYMI*REDIT).LE.RQUEST(12)).AND.
- + (RQUEST(12).LE.RQUEST(33)*SCALE-(RDWYMI*REDIT)))THEN
- IF(IPRION.GT.IPRIOO)THEN
- XLOC=((((RQUEST(11)+(RDWXMI*REDIT))/SCALE)
- + -RQUEST(30))
- + /(RQUEST(31)-RQUEST(30)))
- + *(RQUEST(21)-RQUEST(20))
- + +RQUEST(20)
- YLOC=((((RQUEST(12)+(RDWYMI*REDIT))/SCALE)
- + -RQUEST(32))
- + /(RQUEST(33)-RQUEST(32)))
- + *(RQUEST(23)-RQUEST(22))
- + +RQUEST(22)
- ITNRI=NNT
- IPRIOO=IPRION
- ENDIF
- ENDIF
- IEND = IGNNXT(0)
- GOTO 30
- ENDIF
-#endif
-*
- END
-#endif
diff --git a/src/graflib/higz/igks/irqst.F b/src/graflib/higz/igks/irqst.F
deleted file mode 100644
index 95297ae..0000000
--- a/src/graflib/higz/igks/irqst.F
+++ /dev/null
@@ -1,93 +0,0 @@
-*
-* $Id: irqst.F,v 1.2 1996/06/05 10:20:39 cernlib Exp $
-*
-* $Log: irqst.F,v $
-* Revision 1.2 1996/06/05 10:20:39 cernlib
-* Move pilot.h before the ifdef for GKS
-*
-* Revision 1.1.1.1 1996/02/14 13:10:44 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-#if defined(CERNLIB_GKS)
-*CMZ : 1.19/14 05/10/93 16.00.03 by O.Couet
-*-- Author :
- SUBROUTINE IRQST(IWKID,ISTD,ISTAT,L,STR)
-*.===========>
-*.
-*. This routine returns a character string typed on the keyboard .
-*. An initialise string is done with the parameters RQUEST(81),
-*. RQUEST(82), RQUEST(91), and RQUEST(92) given via the QUEST COMMON
-*. if IWKID is less than 0, Otherwise the initialise string is not done
-*.
-*. _Input parameters:
-*.
-*. INTEGER WKID : Workstation identifier .
-*. INTEGER ISTD : Locator device .
-*.
-*. _Output parameters:
-*.
-*. INTEGER ISTAT : Return status : 0=BREAK, 1=OK .
-*. INTEGER L : Number of characters returned .
-*. CHARACTER STR : Character string returned .
-*.
-*..==========> (O.Couet)
-#include "higz/hiques.inc"
-#if defined(CERNLIB_MAIL)
-#include "higz/himail.inc"
-#endif
-#if defined(CERNLIB_MAIL)
-#include "higz/hiflag.inc"
-#endif
- CHARACTER*(*) STR
-#if defined(CERNLIB_GKS)
- CHARACTER*80 STRGKS(4)
-#endif
-#if defined(CERNLIB_SUNGKS)
- DIMENSION IA(10), RA(10)
- CHARACTER CA*1
-#endif
-*.______________________________________
-*
-#if defined(CERNLIB_MAIL)
-*
-* MAIL option
-*
- IF(MFLAG)THEN
- WRITE (CHMAIL,'(3I3)') 556,ABS(IWKID),ISTD
- CALL IMWRIT(1)
- READ (5,'(2I5,A)') ISTAT,L,STR
- CALL IMWRIT(5)
- RETURN
- ENDIF
-*
-#endif
- CALL IGSG(0)
- IF(IWKID.LT.0)THEN
- IIWKID=ABS(IWKID)
- ELSE
- IIWKID=IWKID
- GOTO 10
- ENDIF
- ILEN=LENOCC(STR)
- INIPOS=MAX(1,ILEN)
-#if (defined(CERNLIB_GKS))&&(!defined(CERNLIB_SUNGKS))
- CALL GINST(IIWKID,1,ILEN,STR,1
- +, RQUEST(81),RQUEST(82),RQUEST(91),RQUEST(92)
- +, 32,INIPOS,0,STRGKS)
-#endif
-#if (defined(CERNLIB_GKS))&&(defined(CERNLIB_SUNGKS))
- IA(1)=1
- CALL GPREC(1,IA,0,RA,0,0,CA,4,IERR,LSTGKS,STRGKS)
- CALL GINST(IIWKID,1,ILEN,STR,1
- +, RQUEST(81),RQUEST(82),RQUEST(91),RQUEST(92)
- +, 32,INIPOS,LSTGKS,STRGKS)
-#endif
-#if defined(CERNLIB_GKS)
- 10 STR=' '
- CALL GRQST(IIWKID,ISTD,ISTAT,L,STR)
-#endif
-*
- END
-#endif
diff --git a/src/graflib/higz/igks/ischh.F b/src/graflib/higz/igks/ischh.F
deleted file mode 100644
index d26c199..0000000
--- a/src/graflib/higz/igks/ischh.F
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: ischh.F,v 1.2 1996/06/05 10:20:39 cernlib Exp $
-*
-* $Log: ischh.F,v $
-* Revision 1.2 1996/06/05 10:20:39 cernlib
-* Move pilot.h before the ifdef for GKS
-*
-* Revision 1.1.1.1 1996/02/14 13:10:44 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-#if defined(CERNLIB_GKS)
-*CMZ : 1.06/04 10/02/89 14.28.33 by O.Couet
-*-- Author :
- SUBROUTINE ISCHH(CHH)
-*.===========>
-*.
-*. This routine sets the character heigh .
-*.
-*. _Input parameters:
-*.
-*. INTEGER CHH : Character heigh .
-*.
-*..==========> (O.Couet)
-#include "higz/hiatt.inc"
-#if defined(CERNLIB_ZEBRA)
-#include "higz/hicode.inc"
-#endif
-#include "higz/hiflag.inc"
-*.______________________________________
-*
- IF(CHH.EQ.RCHH)RETURN
- RCHH=CHH
- IF(GFLAG)CALL GSCHH(CHH)
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_MAIL)
- IF(GLFLAG)CALL IZATT(ICHHCO)
-#endif
-*
- END
-#endif
diff --git a/src/graflib/higz/igks/ischup.F b/src/graflib/higz/igks/ischup.F
deleted file mode 100644
index d8dd582..0000000
--- a/src/graflib/higz/igks/ischup.F
+++ /dev/null
@@ -1,57 +0,0 @@
-*
-* $Id: ischup.F,v 1.2 1996/06/05 10:20:40 cernlib Exp $
-*
-* $Log: ischup.F,v $
-* Revision 1.2 1996/06/05 10:20:40 cernlib
-* Move pilot.h before the ifdef for GKS
-*
-* Revision 1.1.1.1 1996/02/14 13:10:44 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-#if defined(CERNLIB_GKS)
-*CMZ : 1.06/04 10/02/89 14.28.33 by O.Couet
-*-- Author :
- SUBROUTINE ISCHUP(CHUX,CHUY)
-*.===========>
-*.
-*. This routine sets the character up vector . This vector gives the text
-*. inclination .
-*.
-*. _Input parameters:
-*.
-*. REAL CHUX,CHUY : Character up vector coordinates .
-*.
-*..==========> (O.Couet)
-#include "higz/hiatt.inc"
-#if defined(CERNLIB_ZEBRA)
-#include "higz/hicode.inc"
-#endif
-#include "higz/hiflag.inc"
-*.______________________________________
-*
- IF((CHUX.EQ.RCHUX).AND.(CHUY.EQ.RCHUY))RETURN
- RCHUX=CHUX
- RCHUY=CHUY
- IF(GFLAG)CALL GSCHUP(CHUX,CHUY)
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_MAIL)
- IF((RCHUX.EQ.0.).AND.(RCHUY.EQ.1.))THEN
- RANGLE=0.
- ELSEIF((RCHUX.EQ.-1.).AND.(RCHUY.EQ.0.))THEN
- RANGLE=90.
- ELSEIF((RCHUX.EQ.0.).AND.(RCHUY.EQ.-1.))THEN
- RANGLE=180.
- ELSEIF((RCHUX.EQ.1.).AND.(RCHUY.EQ.0.))THEN
- RANGLE=270.
- ELSE
- RANGLE=((ACOS(RCHUX/SQRT(RCHUX**2+RCHUY**2))*180.)
- + /3.14159)-90.
- IF(RCHUY.LT.0.)RANGLE=180.-RANGLE
- IF(ABS(RANGLE).LE.0.01)RANGLE=0.
- ENDIF
- IF(GLFLAG)CALL IZATT(IANGCO)
-#endif
-*
- END
-#endif
diff --git a/src/graflib/higz/igks/isclip.F b/src/graflib/higz/igks/isclip.F
deleted file mode 100644
index b082056..0000000
--- a/src/graflib/higz/igks/isclip.F
+++ /dev/null
@@ -1,39 +0,0 @@
-*
-* $Id: isclip.F,v 1.2 1996/06/05 10:20:41 cernlib Exp $
-*
-* $Log: isclip.F,v $
-* Revision 1.2 1996/06/05 10:20:41 cernlib
-* Move pilot.h before the ifdef for GKS
-*
-* Revision 1.1.1.1 1996/02/14 13:10:45 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-#if defined(CERNLIB_GKS)
-*CMZ : 1.21/01 11/05/94 13.30.36 by O.Couet
-*-- Author :
- SUBROUTINE ISCLIP(CLSW)
-*.===========>
-*.
-*. This routine sets the window (in the world space) clipping on or off .
-*.
-*. _Input parameters:
-*.
-*. INTEGER CLSW : Clipping indicator .
-*.
-*..==========> (O.Couet)
-#include "higz/hiatt.inc"
-#include "higz/hiflag.inc"
- INTEGER CLSW
-*.______________________________________
-*
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_PSCRIPT)||defined(CERNLIB_MAIL)
- IF(GLFLAG)CALL IZSCLI(CLSW)
-#endif
- IF(CLSW.EQ.ICLIP)RETURN
- ICLIP=CLSW
- IF(GFLAG)CALL GSCLIP(CLSW)
-*
- END
-#endif
diff --git a/src/graflib/higz/igks/iscr.F b/src/graflib/higz/igks/iscr.F
deleted file mode 100644
index b72fa80..0000000
--- a/src/graflib/higz/igks/iscr.F
+++ /dev/null
@@ -1,45 +0,0 @@
-*
-* $Id: iscr.F,v 1.2 1996/06/05 10:20:41 cernlib Exp $
-*
-* $Log: iscr.F,v $
-* Revision 1.2 1996/06/05 10:20:41 cernlib
-* Move pilot.h before the ifdef for GKS
-*
-* Revision 1.1.1.1 1996/02/14 13:10:45 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-#if defined(CERNLIB_GKS)
-*CMZ : 1.10/01 04/05/90 10.43.35 by O.Couet
-*-- Author :
- SUBROUTINE ISCR(IWKID,ICI,CR,CG,CB)
-*.===========>
-*.
-*. This routine sets the color representation .
-*.
-*. _Input parameters:
-*.
-*. INTEGER WKID : Workstation identifier .
-*. INTEGER CI : Color index .
-*. REAL CR : Red .
-*. REAL CG : Green .
-*. REAL CB : Blue .
-*.
-*..==========> (O.Couet)
-#include "higz/hiflag.inc"
-#include "higz/hilut.inc"
-*.______________________________________
-*
- I=MIN(NBCLUT-1,ABS(ICI))+1
- REDLUT(I)=CR
- GRNLUT(I)=CG
- BLULUT(I)=CB
- CALL IGSG(0)
- IF(GFLAG)CALL GSCR(IWKID,ICI,CR,CG,CB)
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_MAIL)
- IF(GLFLAG)CALL IZSCOR(IWKID,ICI,CR,CG,CB)
-#endif
-*
- END
-#endif
diff --git a/src/graflib/higz/igks/iselnt.F b/src/graflib/higz/igks/iselnt.F
deleted file mode 100644
index 17b11cc..0000000
--- a/src/graflib/higz/igks/iselnt.F
+++ /dev/null
@@ -1,147 +0,0 @@
-*
-* $Id: iselnt.F,v 1.2 1996/06/05 10:20:42 cernlib Exp $
-*
-* $Log: iselnt.F,v $
-* Revision 1.2 1996/06/05 10:20:42 cernlib
-* Move pilot.h before the ifdef for GKS
-*
-* Revision 1.1.1.1 1996/02/14 13:10:45 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-#if defined(CERNLIB_GKS)
-*CMZ : 1.21/03 31/05/94 11.25.13 by O.Couet
-*-- Author :
- SUBROUTINE ISELNT(NT)
-*.===========>
-*.
-*. This routine selects the transformation number NT and its priority
-*. becomes the highest .
-*.
-*. _Input parameters:
-*.
-*. INTEGER NT : Normalization transformation number (0<=NT<NBNTMX).
-*.
-*..==========> (O.Couet)
-#if !defined(CERNLIB_NTC)
-#include "higz/hint.inc"
-#endif
-#include "higz/hiflag.inc"
-#include "higz/hiatt.inc"
-*.______________________________________
-*
- SCALE=1.
- IF(REDIT.NE.0.)SCALE=REDIT
-*
-#if !defined(CERNLIB_NTC)
- CALL IZGNT(NT,IFIND,IAWV,IPRIO,IHPRIO)
-*
-* Transformation No 0
-*
- IF(NT.EQ.0)THEN
- NT0PRI=IHPRIO+1
- RWXMIN=0.
- RWYMIN=0.
- RWXMAX=1.
- RWYMAX=1.
- RVXMIN=0.
- RVYMIN=0.
- RVXMAX=1.
- RVYMAX=1.
- IF(GFLAG)THEN
- CALL GSWN(1,RWXMIN,RWXMAX,RWYMIN,RWYMAX)
- CALL GSVP(1,RVXMIN*SCALE-(RDWXMI*REDIT)
- +, RVXMAX*SCALE-(RDWXMI*REDIT)
- +, RVYMIN*SCALE-(RDWYMI*REDIT)
- +, RVYMAX*SCALE-(RDWYMI*REDIT))
- CALL GSELNT(1)
- ENDIF
- GOTO 10
- ENDIF
-*
-* NT exits in the main transformation storage
-*
- IF(IFIND.NE.0)THEN
- RWXMIN=WNVPST(IAWV)
- RWYMIN=WNVPST(IAWV+2)
- RWXMAX=WNVPST(IAWV+1)
- RWYMAX=WNVPST(IAWV+3)
- RVXMIN=WNVPST(IAWV+4)
- RVYMIN=WNVPST(IAWV+6)
- RVXMAX=WNVPST(IAWV+5)
- RVYMAX=WNVPST(IAWV+7)
- NTSTOR(IFIND)=IHPRIO+1
- IF(GFLAG)THEN
- CALL GSWN(1,RWXMIN,RWXMAX,RWYMIN,RWYMAX)
- CALL GSVP(1,RVXMIN*SCALE-(RDWXMI*REDIT)
- +, RVXMAX*SCALE-(RDWXMI*REDIT)
- +, RVYMIN*SCALE-(RDWYMI*REDIT)
- +, RVYMAX*SCALE-(RDWYMI*REDIT))
- CALL GSELNT(1)
- ENDIF
-*
-* NT does not exit in the main transformation storage
-*
- ELSE
- RWXMIN=0.
- RWYMIN=0.
- RWXMAX=1.
- RWYMAX=1.
- RVXMIN=0.
- RVYMIN=0.
- RVXMAX=1.
- RVYMAX=1.
- IF(GFLAG)THEN
- CALL GSWN(1,RWXMIN,RWXMAX,RWYMIN,RWYMAX)
- CALL GSVP(1,RVXMIN*SCALE-(RDWXMI*REDIT)
- +, RVXMAX*SCALE-(RDWXMI*REDIT)
- +, RVYMIN*SCALE-(RDWYMI*REDIT)
- +, RVYMAX*SCALE-(RDWYMI*REDIT))
- CALL GSELNT(1)
- ENDIF
- NBNT=NTSTOR(1)
- IF(NBNT+1.GT.NBNTMX)THEN
- CALL IGERR('Too many normalisation transformation','ISELNT')
- RETURN
- ENDIF
- NTSTOR(2*NBNT+2)=NT
- NTSTOR(2*NBNT+3)=IHPRIO+1
- WNVPST(8*NBNT+1)=0.
- WNVPST(8*NBNT+2)=1.
- WNVPST(8*NBNT+3)=0.
- WNVPST(8*NBNT+4)=1.
- WNVPST(8*NBNT+5)=0.
- WNVPST(8*NBNT+6)=1.
- WNVPST(8*NBNT+7)=0.
- WNVPST(8*NBNT+8)=1.
- NTSTOR(1)=NTSTOR(1)+1
- ENDIF
- 10 CONTINUE
-*
-#endif
-#if defined(CERNLIB_NTC)
- IF(IGNSCU(NT).EQ.0)CALL IGNCRE(NT)
- CALL IGNGET(I0,I1,IHPRIO
- +, RWXMIN,RWXMAX,RWYMIN,RWYMAX
- +, RVXMIN,RVXMAX,RVYMIN,RVYMAX,I3D)
- CALL IGNSPR(IHPRIO+1)
- IF(GFLAG)THEN
- CALL GSWN(1,RWXMIN,RWXMAX,RWYMIN,RWYMAX)
- CALL GSVP(1,RVXMIN*SCALE-(RDWXMI*REDIT)
- +, RVXMAX*SCALE-(RDWXMI*REDIT)
- +, RVYMIN*SCALE-(RDWYMI*REDIT)
- +, RVYMAX*SCALE-(RDWYMI*REDIT))
- CALL GSELNT(1)
- ENDIF
- IF(I3D.NE.0)CALL IGSVIE
-*
-#endif
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_PSCRIPT)||defined(CERNLIB_MAIL)
- IF(GLFLAG)CALL IZSELN(NT)
-#endif
- INTR=NT
- CALL ISCLIP(ICLIP)
-*
- END
-#endif
diff --git a/src/graflib/higz/igks/isfaci.F b/src/graflib/higz/igks/isfaci.F
deleted file mode 100644
index e7f6f5b..0000000
--- a/src/graflib/higz/igks/isfaci.F
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: isfaci.F,v 1.2 1996/06/05 10:20:43 cernlib Exp $
-*
-* $Log: isfaci.F,v $
-* Revision 1.2 1996/06/05 10:20:43 cernlib
-* Move pilot.h before the ifdef for GKS
-*
-* Revision 1.1.1.1 1996/02/14 13:10:45 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-#if defined(CERNLIB_GKS)
-*CMZ : 1.06/04 10/02/89 14.28.34 by O.Couet
-*-- Author :
- SUBROUTINE ISFACI(ICOLI)
-*.===========>
-*.
-*. This routine sets the fill area color index .
-*.
-*. _Input parameters:
-*.
-*. INTEGER COLI : Fill area color index .
-*.
-*..==========> (O.Couet)
-#include "higz/hiatt.inc"
-#if defined(CERNLIB_ZEBRA)
-#include "higz/hicode.inc"
-#endif
-#include "higz/hiflag.inc"
-*.______________________________________
-*
- IF(ICOLI.EQ.IFACI)RETURN
- IFACI=ICOLI
- IF(GFLAG)CALL GSFACI(ICOLI)
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_MAIL)
- IF(GLFLAG)CALL IZATT(IFACCO)
-#endif
-*
- END
-#endif
diff --git a/src/graflib/higz/igks/isfais.F b/src/graflib/higz/igks/isfais.F
deleted file mode 100644
index 89d67ca..0000000
--- a/src/graflib/higz/igks/isfais.F
+++ /dev/null
@@ -1,51 +0,0 @@
-*
-* $Id: isfais.F,v 1.2 1996/06/05 10:20:43 cernlib Exp $
-*
-* $Log: isfais.F,v $
-* Revision 1.2 1996/06/05 10:20:43 cernlib
-* Move pilot.h before the ifdef for GKS
-*
-* Revision 1.1.1.1 1996/02/14 13:10:45 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-#if defined(CERNLIB_GKS)
-*CMZ : 1.06/04 10/02/89 14.28.34 by O.Couet
-*-- Author :
- SUBROUTINE ISFAIS(INTS)
-*.===========>
-*.
-*. This routine sets the fill area interior style .
-*.
-*. _Input parameters:
-*.
-*. INTEGER INTS : Interior style .
-*.
-*..==========> (O.Couet)
-#include "higz/hiatt.inc"
-#if defined(CERNLIB_ZEBRA)
-#include "higz/hicode.inc"
-#endif
-#include "higz/hiflag.inc"
-*.______________________________________
-*
- IF(INTS.EQ.IFAIS)RETURN
- IF((INTS.LT.0).OR.(INTS.GT.3))THEN
- CALL IGERR('Fill area interior style must be > -1 and < 4'
- +, 'ISFAIS')
- RETURN
- ENDIF
- IFAIS=INTS
-#if defined(CERNLIB_MGKS)
- IF(GFLAG.AND.(IFAIS.LE.1))CALL GSFAIS(INTS)
-#endif
-#if !defined(CERNLIB_MGKS)
- IF(GFLAG)CALL GSFAIS(INTS)
-#endif
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_MAIL)
- IF(GLFLAG)CALL IZATT(IFAICO)
-#endif
-*
- END
-#endif
diff --git a/src/graflib/higz/igks/isfasi.F b/src/graflib/higz/igks/isfasi.F
deleted file mode 100644
index e9fdcf3..0000000
--- a/src/graflib/higz/igks/isfasi.F
+++ /dev/null
@@ -1,46 +0,0 @@
-*
-* $Id: isfasi.F,v 1.2 1996/06/05 10:20:44 cernlib Exp $
-*
-* $Log: isfasi.F,v $
-* Revision 1.2 1996/06/05 10:20:44 cernlib
-* Move pilot.h before the ifdef for GKS
-*
-* Revision 1.1.1.1 1996/02/14 13:10:45 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-#if defined(CERNLIB_GKS)
-*CMZ : 1.06/04 10/02/89 14.28.34 by O.Couet
-*-- Author :
- SUBROUTINE ISFASI(ISTYL)
-*.===========>
-*.
-*. This routine sets the fill area style index .
-*.
-*. _Input parameters:
-*.
-*. INTEGER ISTYL : Style index .
-*.
-*..==========> (O.Couet)
-#include "higz/hiatt.inc"
-#if defined(CERNLIB_ZEBRA)
-#include "higz/hicode.inc"
-#endif
-#include "higz/hiflag.inc"
-*.______________________________________
-*
- IF(ISTYL.EQ.IFASI)RETURN
- IFASI=ISTYL
-#if defined(CERNLIB_MGKS)
- IF(GFLAG.AND.(IFASI.GE.2).AND.(IFASI.LE.3))CALL GSFAIS(IFASI)
-#endif
-#if !defined(CERNLIB_MGKS)
- IF(GFLAG)CALL GSFASI(ISTYL)
-#endif
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_MAIL)
- IF(GLFLAG)CALL IZATT(IFASCO)
-#endif
-*
- END
-#endif
diff --git a/src/graflib/higz/igks/isln.F b/src/graflib/higz/igks/isln.F
deleted file mode 100644
index cd5e6a7..0000000
--- a/src/graflib/higz/igks/isln.F
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: isln.F,v 1.2 1996/06/05 10:20:44 cernlib Exp $
-*
-* $Log: isln.F,v $
-* Revision 1.2 1996/06/05 10:20:44 cernlib
-* Move pilot.h before the ifdef for GKS
-*
-* Revision 1.1.1.1 1996/02/14 13:10:45 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-#if defined(CERNLIB_GKS)
-*CMZ : 1.06/04 10/02/89 14.28.34 by O.Couet
-*-- Author :
- SUBROUTINE ISLN(LTYPE)
-*.===========>
-*.
-*. This routine sets the line type .
-*.
-*. _Input parameters:
-*.
-*. INTEGER LTYPE : Line type .
-*.
-*..==========> (O.Couet)
-#include "higz/hiatt.inc"
-#if defined(CERNLIB_ZEBRA)
-#include "higz/hicode.inc"
-#endif
-#include "higz/hiflag.inc"
-*.______________________________________
-*
- IF(LTYPE.EQ.ILN)RETURN
- ILN=LTYPE
- IF(GFLAG)CALL GSLN(LTYPE)
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_MAIL)
- IF(GLFLAG)CALL IZATT(ILNCO)
-#endif
-*
- END
-#endif
diff --git a/src/graflib/higz/igks/islwsc.F b/src/graflib/higz/igks/islwsc.F
deleted file mode 100644
index d0e7cb0..0000000
--- a/src/graflib/higz/igks/islwsc.F
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: islwsc.F,v 1.2 1996/06/05 10:20:54 cernlib Exp $
-*
-* $Log: islwsc.F,v $
-* Revision 1.2 1996/06/05 10:20:54 cernlib
-* Move pilot.h before the ifdef for GKS
-*
-* Revision 1.1.1.1 1996/02/14 13:10:45 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-#if defined(CERNLIB_GKS)
-*CMZ : 1.06/04 10/02/89 14.28.34 by O.Couet
-*-- Author :
- SUBROUTINE ISLWSC(WIDTH)
-*.===========>
-*.
-*. The routine sets the line width scale factor .
-*.
-*. _Input parameters:
-*.
-*. REAL LWIDTH : Line width .
-*.
-*..==========> (O.Couet)
-#include "higz/hiatt.inc"
-#if defined(CERNLIB_ZEBRA)
-#include "higz/hicode.inc"
-#endif
-#include "higz/hiflag.inc"
-*.______________________________________
-*
- IF(WIDTH.EQ.RLWSC)RETURN
- RLWSC=WIDTH
- IF(GFLAG)CALL GSLWSC(WIDTH)
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_MAIL)
- IF(GLFLAG)CALL IZATT(ILWSCO)
-#endif
-*
- END
-#endif
diff --git a/src/graflib/higz/igks/ismk.F b/src/graflib/higz/igks/ismk.F
deleted file mode 100644
index 843c8f4..0000000
--- a/src/graflib/higz/igks/ismk.F
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: ismk.F,v 1.2 1996/06/05 10:20:55 cernlib Exp $
-*
-* $Log: ismk.F,v $
-* Revision 1.2 1996/06/05 10:20:55 cernlib
-* Move pilot.h before the ifdef for GKS
-*
-* Revision 1.1.1.1 1996/02/14 13:10:46 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-#if defined(CERNLIB_GKS)
-*CMZ : 1.10/02 28/05/90 10.30.19 by O.Couet
-*-- Author :
- SUBROUTINE ISMK(MTYPE)
-*.===========>
-*.
-*. This routine sets the marker type .
-*.
-*. _Input parameters:
-*.
-*. INTEGER MTYPE : Marker type .
-*.
-*..==========> (O.Couet)
-#include "higz/hiatt.inc"
-#if defined(CERNLIB_ZEBRA)
-#include "higz/hicode.inc"
-#endif
-#include "higz/hiflag.inc"
-*.______________________________________
-*
- IF(MTYPE.EQ.IMK.OR.MTYPE.GT.31)RETURN
- IMK=MTYPE
- IF(GFLAG)CALL GSMK(MTYPE)
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_MAIL)
- IF(GLFLAG)CALL IZATT(IMKCO)
-#endif
-*
- END
-#endif
diff --git a/src/graflib/higz/igks/ismksc.F b/src/graflib/higz/igks/ismksc.F
deleted file mode 100644
index 002ca00..0000000
--- a/src/graflib/higz/igks/ismksc.F
+++ /dev/null
@@ -1,43 +0,0 @@
-*
-* $Id: ismksc.F,v 1.2 1996/06/05 10:20:55 cernlib Exp $
-*
-* $Log: ismksc.F,v $
-* Revision 1.2 1996/06/05 10:20:55 cernlib
-* Move pilot.h before the ifdef for GKS
-*
-* Revision 1.1.1.1 1996/02/14 13:10:46 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-#if defined(CERNLIB_GKS)
-*CMZ : 1.06/04 10/02/89 14.28.34 by O.Couet
-*-- Author :
- SUBROUTINE ISMKSC(RMSCF)
-*.===========>
-*.
-*. This routine sets the marker scale factor .
-*.
-*. _Input parameters:
-*.
-*. REAL MSCF : Marker scale factor .
-*.
-*..==========> (O.Couet)
-#include "higz/hiatt.inc"
-#if defined(CERNLIB_ZEBRA)
-#include "higz/hicode.inc"
-#endif
-#include "higz/hiflag.inc"
-*.______________________________________
-*
- IF(RMSCF.EQ.RMKSC)RETURN
- RMKSC=RMSCF
-#if !defined(CERNLIB_MGKS)
- IF(GFLAG)CALL GSMKSC(RMSCF)
-#endif
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_MAIL)
- IF(GLFLAG)CALL IZATT(IMKSCO)
-#endif
-*
- END
-#endif
diff --git a/src/graflib/higz/igks/isplci.F b/src/graflib/higz/igks/isplci.F
deleted file mode 100644
index 7f36871..0000000
--- a/src/graflib/higz/igks/isplci.F
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: isplci.F,v 1.2 1996/06/05 10:20:56 cernlib Exp $
-*
-* $Log: isplci.F,v $
-* Revision 1.2 1996/06/05 10:20:56 cernlib
-* Move pilot.h before the ifdef for GKS
-*
-* Revision 1.1.1.1 1996/02/14 13:10:46 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-#if defined(CERNLIB_GKS)
-*CMZ : 1.06/04 10/02/89 14.28.34 by O.Couet
-*-- Author :
- SUBROUTINE ISPLCI(ICOLI)
-*.===========>
-*.
-*. This routine sets the polyline color index .
-*.
-*. _Input parameters:
-*.
-*. INTEGER COLI : Color index .
-*.
-*..==========> (O.Couet)
-#include "higz/hiatt.inc"
-#if defined(CERNLIB_ZEBRA)
-#include "higz/hicode.inc"
-#endif
-#include "higz/hiflag.inc"
-*.______________________________________
-*
- IF(ICOLI.EQ.IPLCI)RETURN
- IPLCI=ICOLI
- IF(GFLAG)CALL GSPLCI(ICOLI)
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_MAIL)
- IF(GLFLAG)CALL IZATT(IPLCCO)
-#endif
-*
- END
-#endif
diff --git a/src/graflib/higz/igks/ispmci.F b/src/graflib/higz/igks/ispmci.F
deleted file mode 100644
index 564271e..0000000
--- a/src/graflib/higz/igks/ispmci.F
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: ispmci.F,v 1.2 1996/06/05 10:20:57 cernlib Exp $
-*
-* $Log: ispmci.F,v $
-* Revision 1.2 1996/06/05 10:20:57 cernlib
-* Move pilot.h before the ifdef for GKS
-*
-* Revision 1.1.1.1 1996/02/14 13:10:46 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-#if defined(CERNLIB_GKS)
-*CMZ : 1.06/04 10/02/89 14.28.34 by O.Couet
-*-- Author :
- SUBROUTINE ISPMCI(ICOLI)
-*.===========>
-*.
-*. This routine sets the polymarker color index .
-*.
-*. _Input parameters:
-*.
-*. INTEGER COLI : Color index .
-*.
-*..==========> (O.Couet)
-#include "higz/hiatt.inc"
-#if defined(CERNLIB_ZEBRA)
-#include "higz/hicode.inc"
-#endif
-#include "higz/hiflag.inc"
-*.______________________________________
-*
- IF(ICOLI.EQ.IPMCI)RETURN
- IPMCI=ICOLI
- IF(GFLAG)CALL GSPMCI(ICOLI)
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_MAIL)
- IF(GLFLAG)CALL IZATT(IPMCCO)
-#endif
-*
- END
-#endif
diff --git a/src/graflib/higz/igks/istxal.F b/src/graflib/higz/igks/istxal.F
deleted file mode 100644
index 0113b3b..0000000
--- a/src/graflib/higz/igks/istxal.F
+++ /dev/null
@@ -1,44 +0,0 @@
-*
-* $Id: istxal.F,v 1.2 1996/06/05 10:20:57 cernlib Exp $
-*
-* $Log: istxal.F,v $
-* Revision 1.2 1996/06/05 10:20:57 cernlib
-* Move pilot.h before the ifdef for GKS
-*
-* Revision 1.1.1.1 1996/02/14 13:10:46 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-#if defined(CERNLIB_GKS)
-*CMZ : 1.06/04 10/02/89 14.28.34 by O.Couet
-*-- Author :
- SUBROUTINE ISTXAL(JTXALH,JTXALV)
-*.===========>
-*.
-*. This routine sets the text alignment .
-*.
-*. _Input parameters:
-*.
-*. INTEGER TXALH : Horizontal alignment .
-*. INTEGER TXALV : Vertical alignment .
-*.
-*..==========> (O.Couet)
-#include "higz/hiatt.inc"
-#if defined(CERNLIB_ZEBRA)
-#include "higz/hicode.inc"
-#endif
-#include "higz/hiflag.inc"
-*.______________________________________
-*
- IF((JTXALH.EQ.ITXALH).AND.(JTXALV.EQ.ITXALV))RETURN
- ITXALH=JTXALH
- ITXALV=JTXALV
- IF(GFLAG)CALL GSTXAL(JTXALH,JTXALV)
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_MAIL)
- ITXALG=10*JTXALH+JTXALV
- IF(GLFLAG)CALL IZATT(ITXACO)
-#endif
-*
- END
-#endif
diff --git a/src/graflib/higz/igks/istxci.F b/src/graflib/higz/igks/istxci.F
deleted file mode 100644
index 1fbb04c..0000000
--- a/src/graflib/higz/igks/istxci.F
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: istxci.F,v 1.2 1996/06/05 10:20:59 cernlib Exp $
-*
-* $Log: istxci.F,v $
-* Revision 1.2 1996/06/05 10:20:59 cernlib
-* Move pilot.h before the ifdef for GKS
-*
-* Revision 1.1.1.1 1996/02/14 13:10:46 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-#if defined(CERNLIB_GKS)
-*CMZ : 1.06/04 10/02/89 14.28.34 by O.Couet
-*-- Author :
- SUBROUTINE ISTXCI(ICOLI)
-*.===========>
-*.
-*. This routine sets the text color index .
-*.
-*. _Input parameters:
-*.
-*. INTEGER COLI : Color index .
-*.
-*..==========> (O.Couet)
-#include "higz/hiatt.inc"
-#if defined(CERNLIB_ZEBRA)
-#include "higz/hicode.inc"
-#endif
-#include "higz/hiflag.inc"
-*.______________________________________
-*
- IF(ICOLI.EQ.ITXCI)RETURN
- ITXCI=ICOLI
- IF(GFLAG)CALL GSTXCI(ICOLI)
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_MAIL)
- IF(GLFLAG)CALL IZATT(ITXCCO)
-#endif
-*
- END
-#endif
diff --git a/src/graflib/higz/igks/istxfp.F b/src/graflib/higz/igks/istxfp.F
deleted file mode 100644
index 299edd8..0000000
--- a/src/graflib/higz/igks/istxfp.F
+++ /dev/null
@@ -1,49 +0,0 @@
-*
-* $Id: istxfp.F,v 1.3 1998/01/30 15:22:31 couet Exp $
-*
-* $Log: istxfp.F,v $
-* Revision 1.3 1998/01/30 15:22:31 couet
-* - APOLLO version removed
-*
-* Revision 1.2 1996/06/05 10:21:00 cernlib
-* Move pilot.h before the ifdef for GKS
-*
-* Revision 1.1.1.1 1996/02/14 13:10:46 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-#if defined(CERNLIB_GKS)
-*CMZ : 1.06/06 16/03/89 08.58.19 by O.Couet
-* SUN Version available
-*-- Author :
- SUBROUTINE ISTXFP(JFONT,JPREC)
-*.===========>
-*.
-*. This routine sets the text font and precision .
-*.
-*. _Input parameters:
-*.
-*. INTEGER FONT : Text font .
-*. INTEGER PREC : Text precision .
-*.
-*..==========> (O.Couet)
-#include "higz/hiatt.inc"
-#if defined(CERNLIB_ZEBRA)
-#include "higz/hicode.inc"
-#endif
-#include "higz/hiflag.inc"
-*.______________________________________
-*
- IF((JFONT.EQ.IFONT).AND.(JPREC.EQ.IPREC))RETURN
- IFONT=JFONT
- IPREC=JPREC
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_MAIL)
- IFTPR=10*JFONT+ISIGN(1,JFONT)*JPREC
- IF(GLFLAG)CALL IZATT(ITXFCO)
-#endif
- IF((JFONT.EQ.0).AND.(JPREC.EQ.2))RETURN
- IF(GFLAG)CALL GSTXFP(JFONT,JPREC)
-*
- END
-#endif
diff --git a/src/graflib/higz/igks/isvp.F b/src/graflib/higz/igks/isvp.F
deleted file mode 100644
index 1a12dee..0000000
--- a/src/graflib/higz/igks/isvp.F
+++ /dev/null
@@ -1,123 +0,0 @@
-*
-* $Id: isvp.F,v 1.2 1996/06/05 10:21:01 cernlib Exp $
-*
-* $Log: isvp.F,v $
-* Revision 1.2 1996/06/05 10:21:01 cernlib
-* Move pilot.h before the ifdef for GKS
-*
-* Revision 1.1.1.1 1996/02/14 13:10:46 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-#if defined(CERNLIB_GKS)
-*CMZ : 1.22/03 06/01/95 11.28.12 by O.Couet
-*-- Author :
- SUBROUTINE ISVP(NT,XX1,XX2,YY1,YY2)
-*.===========>
-*.
-*. This routine sets the transformation normalisation viewport NT .
-*.
-*. _Input parameters:
-*.
-*. INTEGER NT : Normalization transformation number (0<=NT<NBNTMX).
-*. REAL X1,Y1 : X,Y down left corner viewport coordinates .
-*. REAL X2,Y2 : X,Y right up corner viewport coordinates .
-*.
-*..==========> (O.Couet)
-#if !defined(CERNLIB_NTC)
-#include "higz/hint.inc"
-#endif
-#include "higz/hiflag.inc"
-#include "higz/hiatt.inc"
-*.______________________________________
-*
-* Verify the viewport parameters
-*
- X1 = XX1
- X2 = XX2
- Y1 = YY1
- Y2 = YY2
- IF((X1.LT.0).OR.(X1.GT.1)
- + .OR.
- + (X2.LT.0).OR.(X2.GT.1)
- + .OR.
- + (Y1.LT.0).OR.(Y1.GT.1)
- + .OR.
- + (Y2.LT.0).OR.(Y2.GT.1)
- + .OR.
- + (Y1.GE.Y2).OR.(X1.GE.X2))THEN
- CALL IGERR('Invalid viewport definition','ISVP')
- RETURN
- ENDIF
- IF(NT.EQ.0)RETURN
-*
- SCALE = 1.
- IF(REDIT.NE.0.)SCALE = REDIT
-#if !defined(CERNLIB_NTC)
-*
- CALL IZGNT(NT,IFIND,IAWV,IPRIO,IHPRIO)
-*
-* NT exits in the main transformation storage
-*
- IF(IFIND.NE.0)THEN
- IF((INTR.EQ.NT).AND.GFLAG)THEN
- IF(GFLAG)THEN
- CALL GSVP(1
- +, X1*SCALE-(RDWXMI*REDIT)
- +, X2*SCALE-(RDWXMI*REDIT)
- +, Y1*SCALE-(RDWYMI*REDIT)
- +, Y2*SCALE-(RDWYMI*REDIT))
- ENDIF
- RVXMIN = X1
- RVYMIN = Y1
- RVXMAX = X2
- RVYMAX = Y2
- ENDIF
- WNVPST(IAWV+4) = X1
- WNVPST(IAWV+5) = X2
- WNVPST(IAWV+6) = Y1
- WNVPST(IAWV+7) = Y2
-*
-* NT does not exit in the main transformation storage
-*
- ELSE
- NBNT=NTSTOR(1)
- IF(NBNT+1.GT.NBNTMX)THEN
- CALL IGERR('Too many normalisation transformation','ISVP')
- RETURN
- ENDIF
- NTSTOR(2*NBNT+2) = NT
- WNVPST(8*NBNT+1) = 0.
- WNVPST(8*NBNT+2) = 1.
- WNVPST(8*NBNT+3) = 0.
- WNVPST(8*NBNT+4) = 1.
- WNVPST(8*NBNT+5) = X1
- WNVPST(8*NBNT+6) = X2
- WNVPST(8*NBNT+7) = Y1
- WNVPST(8*NBNT+8) = Y2
- NTSTOR(1) = NTSTOR(1)+1
- ENDIF
-#endif
-#if defined(CERNLIB_NTC)
- IF(IGNSCU(NT).NE.0)THEN
- IF((INTR.EQ.NT).AND.GFLAG)THEN
- IF(GFLAG)THEN
- CALL GSVP(1
- +, X1*SCALE-(RDWXMI*REDIT)
- +, X2*SCALE-(RDWXMI*REDIT)
- +, Y1*SCALE-(RDWYMI*REDIT)
- +, Y2*SCALE-(RDWYMI*REDIT))
- ENDIF
- RVXMIN = X1
- RVYMIN = Y1
- RVXMAX = X2
- RVYMAX = Y2
- ENDIF
- ELSE
- CALL IGNCRE(NT)
- ENDIF
- CALL IGNSVP(X1,X2,Y1,Y2)
-#endif
- END
-#endif
diff --git a/src/graflib/higz/igks/iswkvp.F b/src/graflib/higz/igks/iswkvp.F
deleted file mode 100644
index ed2379d..0000000
--- a/src/graflib/higz/igks/iswkvp.F
+++ /dev/null
@@ -1,44 +0,0 @@
-*
-* $Id: iswkvp.F,v 1.2 1996/06/05 10:21:02 cernlib Exp $
-*
-* $Log: iswkvp.F,v $
-* Revision 1.2 1996/06/05 10:21:02 cernlib
-* Move pilot.h before the ifdef for GKS
-*
-* Revision 1.1.1.1 1996/02/14 13:10:46 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-#if defined(CERNLIB_GKS)
-*CMZ : 1.06/03 12/12/88 15.20.46 by O.Couet
-*-- Author :
- SUBROUTINE ISWKVP(WKID,X1,X2,Y1,Y2)
-*.===========>
-*.
-*. This routine sets the workstation transformation viewport .
-*.
-*. _Input parameters:
-*.
-*. INTEGER WKID : Workstation identifier .
-*. REAL X1,Y1 : X,Y down left corner viewport coordinates .
-*. REAL X2,Y2 : X,Y right up corner viewport coordinates .
-*.
-*..==========> (O.Couet)
-#include "higz/hiflag.inc"
-#include "higz/hiatt.inc"
- INTEGER WKID
-*.______________________________________
-*
- RDVXMI=X1
- RDVXMA=X2
- RDVYMI=Y1
- RDVYMA=Y2
- IF(IGIWTY(WKID).LT.0)RETURN
-*
-#if defined(CERNLIB_GKS)
- IF(GFLAG)CALL GSWKVP(WKID,X1,X2,Y1,Y2)
-#endif
-*
- END
-#endif
diff --git a/src/graflib/higz/igks/iswkwn.F b/src/graflib/higz/igks/iswkwn.F
deleted file mode 100644
index 9d6ee41..0000000
--- a/src/graflib/higz/igks/iswkwn.F
+++ /dev/null
@@ -1,55 +0,0 @@
-*
-* $Id: iswkwn.F,v 1.2 1996/06/05 10:21:03 cernlib Exp $
-*
-* $Log: iswkwn.F,v $
-* Revision 1.2 1996/06/05 10:21:03 cernlib
-* Move pilot.h before the ifdef for GKS
-*
-* Revision 1.1.1.1 1996/02/14 13:10:46 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-#if defined(CERNLIB_GKS)
-*CMZ : 1.06/03 12/12/88 15.20.46 by O.Couet
-*-- Author :
- SUBROUTINE ISWKWN(WKID,X1,X2,Y1,Y2)
-*.===========>
-*.
-*. This routine sets the workstation transformation window .
-*.
-*. _Input parameters:
-*.
-*. INTEGER WKID : Workstation identifier .
-*. REAL X1,Y1 : X,Y down left corner window coordinates .
-*. REAL X2,Y2 : X,Y right up corner window coordinates .
-*.
-*..==========> (O.Couet)
-#include "higz/hiflag.inc"
-#include "higz/hiatt.inc"
- INTEGER WKID
-*.______________________________________
-*
- IF((X1.LT.0).OR.(X1.GT.1)
- + .OR.
- + (X2.LT.0).OR.(X2.GT.1)
- + .OR.
- + (Y1.LT.0).OR.(Y1.GT.1)
- + .OR.
- + (Y2.LT.0).OR.(Y2.GT.1))THEN
- CALL IGERR('Bad window or viewport size','ISWKWN')
- RETURN
- ENDIF
-*
- RDWXMI=X1
- RDWXMA=X2
- RDWYMI=Y1
- RDWYMA=Y2
- IF(IGIWTY(WKID).LT.0)RETURN
-*
-#if defined(CERNLIB_GKS)
- IF(GFLAG)CALL GSWKWN(WKID,X1,X2,Y1,Y2)
-#endif
-*
- END
-#endif
diff --git a/src/graflib/higz/igks/iswn.F b/src/graflib/higz/igks/iswn.F
deleted file mode 100644
index 4f21014..0000000
--- a/src/graflib/higz/igks/iswn.F
+++ /dev/null
@@ -1,96 +0,0 @@
-*
-* $Id: iswn.F,v 1.2 1996/06/05 10:21:04 cernlib Exp $
-*
-* $Log: iswn.F,v $
-* Revision 1.2 1996/06/05 10:21:04 cernlib
-* Move pilot.h before the ifdef for GKS
-*
-* Revision 1.1.1.1 1996/02/14 13:10:46 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-#if defined(CERNLIB_GKS)
-*CMZ : 1.21/03 01/06/94 10.40.05 by O.Couet
-*-- Author :
- SUBROUTINE ISWN(NT,XX1,XX2,YY1,YY2)
-*.===========>
-*.
-*. This routine sets the window coordinates of the transformation NT .
-*.
-*. _Input parameters:
-*.
-*. INTEGER NT : Normalization transformation number (0<=NT<NBNTMX).
-*. REAL X1,Y1 : X,Y down left corner window coordinates in WC space .
-*. REAL X2,Y2 : X,Y right up corner window coordinates in WC space .
-*.
-*..==========> (O.Couet)
-#if !defined(CERNLIB_NTC)
-#include "higz/hint.inc"
-#endif
-#include "higz/hiflag.inc"
-#include "higz/hiatt.inc"
-*.______________________________________
-*
- IF(NT.EQ.0)RETURN
-*
- X1 = XX1
- X2 = XX2
- Y1 = YY1
- Y2 = YY2
-*
-#if !defined(CERNLIB_NTC)
- CALL IZGNT(NT,IFIND,IAWV,IPRIO,IHPRIO)
-*
-* NT exits in the main transformation storage
-*
- IF(IFIND.NE.0)THEN
- IF((INTR.EQ.NT).AND.GFLAG)THEN
- IF(GFLAG)CALL GSWN(1,X1,X2,Y1,Y2)
- RWXMIN = X1
- RWYMIN = Y1
- RWXMAX = X2
- RWYMAX = Y2
- ENDIF
- WNVPST(IAWV) = X1
- WNVPST(IAWV+1) = X2
- WNVPST(IAWV+2) = Y1
- WNVPST(IAWV+3) = Y2
-*
-* NT does not exit in the main transformation storage
-*
- ELSE
- NBNT = NTSTOR(1)
- IF(NBNT+1.GT.NBNTMX)THEN
- CALL IGERR('Too many normalisation transformation','ISWN')
- RETURN
- ENDIF
- NTSTOR(2*NBNT+2) = NT
- WNVPST(8*NBNT+1) = X1
- WNVPST(8*NBNT+2) = X2
- WNVPST(8*NBNT+3) = Y1
- WNVPST(8*NBNT+4) = Y2
- WNVPST(8*NBNT+5) = 0.
- WNVPST(8*NBNT+6) = 1.
- WNVPST(8*NBNT+7) = 0.
- WNVPST(8*NBNT+8) = 1.
- NTSTOR(1) = NTSTOR(1)+1
- ENDIF
-#endif
-#if defined(CERNLIB_NTC)
- IF(IGNSCU(NT).NE.0)THEN
- IF((INTR.EQ.NT).AND.GFLAG)THEN
- IF(GFLAG)CALL GSWN(1,X1,X2,Y1,Y2)
- RWXMIN = X1
- RWYMIN = Y1
- RWXMAX = X2
- RWYMAX = Y2
- ENDIF
- ELSE
- CALL IGNCRE(NT)
- ENDIF
- CALL IGNSWN(X1,X2,Y1,Y2)
-#endif
-*
- END
-#endif
diff --git a/src/graflib/higz/igks/itx.F b/src/graflib/higz/igks/itx.F
deleted file mode 100644
index 480c725..0000000
--- a/src/graflib/higz/igks/itx.F
+++ /dev/null
@@ -1,76 +0,0 @@
-*
-* $Id: itx.F,v 1.2 1996/06/05 10:21:04 cernlib Exp $
-*
-* $Log: itx.F,v $
-* Revision 1.2 1996/06/05 10:21:04 cernlib
-* Move pilot.h before the ifdef for GKS
-*
-* Revision 1.1.1.1 1996/02/14 13:10:46 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-#if defined(CERNLIB_GKS)
-*CMZ : 1.19/14 05/10/93 16.00.03 by O.Couet
-*-- Author :
- SUBROUTINE ITX(X,Y,CHARS)
-*.===========>
-*.
-*. This routine draws a text at the position X,Y .
-*.
-*. _Input parameters:
-*.
-*. REAL X,Y : Position of the text .
-*. CHARACTER CHARS : Text .
-*.
-*..==========> (O.Couet)
-#include "higz/hiflag.inc"
-#include "higz/hiatt.inc"
- CHARACTER*(*) CHARS
- CHARACTER*1 CHOPT
- LOGICAL ZFSAV,PFSAV
-*.______________________________________
-*
- ILEN=LENOCC(CHARS)
- IF(ILEN.EQ.0)RETURN
- IF(GFLAG)THEN
- CALL IGSG(0)
- IF((IFONT.EQ.0.AND.IPREC.EQ.2).OR.
- + (IFONT.LT.0.AND.IFONT.GT.-25.AND.IPREC.EQ.1))THEN
- IF((ITXALH.EQ.0).OR.(ITXALH.EQ.1))CHOPT='L'
- IF(ITXALH.EQ.2)THEN
- CHOPT = 'C'
- ELSEIF(ITXALH.EQ.3)THEN
- CHOPT = 'R'
- ELSE
- CHOPT = 'L'
- ENDIF
- IF((ITXALV.EQ.2).OR.(ITXALV.EQ.1))THEN
- YY = Y-RCHH*COS((3.14159/180.)*RANGLE)
- XX = X+RCHH*SIN((3.14159/180.)*RANGLE)
- ELSEIF(ITXALV.EQ.3)THEN
- YY = Y-(RCHH/2.)*COS((3.14159/180.)*RANGLE)
- XX = X+(RCHH/2.)*SIN((3.14159/180.)*RANGLE)
- ELSE
- YY = Y
- XX = X
- ENDIF
- ZFSAV = ZFLAG
- ZFLAG = .FALSE.
- PFSAV = PFLAG
- PFLAG = .FALSE.
- GLFLAG = (ZFLAG.OR.PFLAG.OR.MFLAG)
- CALL IGTEXT(XX,YY,CHARS,RCHH,RANGLE,CHOPT)
- ZFLAG = ZFSAV
- PFLAG = PFSAV
- GLFLAG = (ZFLAG.OR.PFLAG.OR.MFLAG)
- ELSE
- CALL GTX(X,Y,CHARS(1:ILEN))
- ENDIF
- ENDIF
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_PSCRIPT)||defined(CERNLIB_MAIL)
- IF(GLFLAG)CALL IZTX(X,Y,CHARS(1:ILEN))
-#endif
-*
- END
-#endif
diff --git a/src/graflib/higz/igks/iuwk.F b/src/graflib/higz/igks/iuwk.F
deleted file mode 100644
index 536a78a..0000000
--- a/src/graflib/higz/igks/iuwk.F
+++ /dev/null
@@ -1,45 +0,0 @@
-*
-* $Id: iuwk.F,v 1.2 1996/06/05 10:21:05 cernlib Exp $
-*
-* $Log: iuwk.F,v $
-* Revision 1.2 1996/06/05 10:21:05 cernlib
-* Move pilot.h before the ifdef for GKS
-*
-* Revision 1.1.1.1 1996/02/14 13:10:46 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-#if defined(CERNLIB_GKS)
-*CMZ : 1.12/16 13/08/91 16.29.43 by O.Couet
-*-- Author :
- SUBROUTINE IUWK(IWKID,IRFLG)
-*.===========>
-*.
-*. Update workstation IWKID. Send all buffered output to the
-*. screen and process pending changes in the view.
-*.
-*. _Input parameters:
-*.
-*. INTEGER IWKID : Workstation identifier (0= all workstation)
-*. INTEGER IRFLG : Regeneration flag:
-*. 0 = postpone update workstation (GKS only)
-*. 1 = refresh entire display
-*. 2 = update current view
-*.
-*..==========> (O.Couet)
-#include "higz/hiflag.inc"
-#include "higz/hiatt.inc"
-*.______________________________________
-*
- IF(IWKID.NE.0)THEN
- IF(IGIWTY(IWKID).GT.0.AND.GFLAG)CALL GUWK(IWKID,IRFLG)
- ELSE
- DO 10 I=1,INOPWK
- IF(IGIWTY(ILOPWK(I)).GT.0.AND.GFLAG)
- + CALL GUWK(ILOPWK(I),IRFLG)
- 10 CONTINUE
- ENDIF
-*
- END
-#endif
diff --git a/src/graflib/higz/igold/Imakefile b/src/graflib/higz/igold/Imakefile
deleted file mode 100644
index 968c2c2..0000000
--- a/src/graflib/higz/igold/Imakefile
+++ /dev/null
@@ -1,4 +0,0 @@
-SRCS_F= golclo.F golini.F golwri.F iclrwk.F imfuwk.F mfotib.F \ @@\
- mfotrb.F moutbf.F mputbf.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/graflib/higz/igold/golclo.F b/src/graflib/higz/igold/golclo.F
deleted file mode 100644
index 1e80132..0000000
--- a/src/graflib/higz/igold/golclo.F
+++ /dev/null
@@ -1,72 +0,0 @@
-*
-* $Id: golclo.F,v 1.1.1.1 1996/02/14 13:10:47 mclareni Exp $
-*
-* $Log: golclo.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:47 mclareni
-* Higz
-*
-*
-#if defined(CERNLIB_MSDOS)
-#include "higz/pilot.h"
-*CMZ : 1.14/11 29/06/92 13.58.00 by Unknown
-*-- Author : V.Fine
- SUBROUTINE GOLCLO
-#include "higz/golden.inc"
-#include "higz/himeta.inc"
- DIMENSION PAR(2)
- INTEGER UNLINKF
- DATA PAR /0.0, 0.0/
-*
- IF (FILOPN) THEN
- CALL GOLWRI(MA,PAR,' ')
- CALL GOLWRI(SP,0,' ')
-*
-#if (!defined(CERNLIB_XIOPAK))&&(!defined(CERNLIB_CIPACK))
- IF (BIMODE) THEN
- LAST = LBUF - IPOINT + 1
- IF (LAST .LT. 13) LAST = LAST + LBUF
- L1 = LAST
- L2 = 0
- IF (LAST .GT. 256) THEN
- L1 = LAST/2
- L2 = LAST - L1
- END IF
- CALL MFOTIB(SS)
- CALL MFOTIB(L1-2)
- CALL MPUTBF('DEFAULT.SYM',11)
- IF (IPOINT .LE. LBUF) CHMBUF(IPOINT:LBUF) = ' '
- IPOINT = IPOINT + L1 - 11 - 2
- IF (L2 .GT. 0) THEN
- CALL MFOTIB(SS)
- CALL MFOTIB(L2-2)
- CALL MPUTBF('DEFAULT.SYM',11)
- END IF
- CALL MOUTBF
- END IF
-#endif
-#if defined(CERNLIB_XIOPAK)||defined(CERNLIB_CIPACK)
- IF (BIMODE) THEN
- CALL MOUTBF
-#endif
-#if defined(CERNLIB_XIOPACK)
- CALL XCLOSE(LUNG)
-#endif
-#if defined(CERNLIB_CIPACK)
- CALL CICLOS(LUNG)
- IF (FRADEL) then
- ISTAT = UNLINKF(chmeta)
- END IF
- ELSE
-#endif
- IF (FRADEL) THEN
- CLOSE(LUNG(1),STATUS='DELETE')
- ELSE
- CLOSE(LUNG(1),STATUS='KEEP')
- END IF
-#if defined(CERNLIB_XIOPAK)||defined(CERNLIB_CIPACK)
- END IF
-#endif
- FILOPN = .FALSE.
- END IF
- END
-#endif
diff --git a/src/graflib/higz/igold/golwri.F b/src/graflib/higz/igold/golwri.F
deleted file mode 100644
index 20421e7..0000000
--- a/src/graflib/higz/igold/golwri.F
+++ /dev/null
@@ -1,100 +0,0 @@
-*
-* $Id: golwri.F,v 1.1.1.1 1996/02/14 13:10:48 mclareni Exp $
-*
-* $Log: golwri.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:48 mclareni
-* Higz
-*
-*
-#if defined(CERNLIB_MSDOS)
-#include "higz/pilot.h"
-*CMZ : 1.14/11 29/06/92 13.58.00 by Unknown
-*-- Author : V.Fine
- SUBROUTINE GOLWRI(JOB,PAR,CHARS)
-*.
-*... GOLWRI(JOB,PAR,CHAR) - WRITE TO META-FILE ONE PRIMITIVE COMMAND
-*.
-*. JOB - CODE OF COMMAND
-*. PAR - ARRAY CONTANED PARAMETERS OF COMMAND
-*. CHAR - STRING PARAMETER
-*
-*. 06/11/91 03:47pm by Fine V.E. from JINR LCTA
-*.
-#include "higz/golden.inc"
-#include "higz/himeta.inc"
- DIMENSION PAR(4)
- CHARACTER*(*) CHARS
- EQUIVALENCE (PEN,IPEN)
-
- IF (JOB .GT. NJOB .OR. JOB .LE. 0 .OR. .NOT. FILOPN ) RETURN
-*
- PEN = PAR(1)
- IF (JOB .EQ. SP) THEN
- IF (IPEN .EQ. 0) THEN
- LOCK = .TRUE.
- ELSE
- LOCK = .FALSE.
-*--
-*-- CHANGE BLACK AND WHITE
-*
- IF (IPEN .EQ. 7) IPEN = 0
- END IF
- END IF
- IF (.NOT. LOCK .OR. JOB .EQ. SC .OR. JOB .EQ. SS) THEN
- IF (FRADEL .AND. (JOB .EQ. PS .OR. JOB .EQ. PA)) THEN
- FRADEL = .FALSE.
- END IF
-*--
-*-- DO
-*
- IF (BIMODE) THEN
- CALL MFOTIB(JOB)
- GO TO (10,10,10,20,10,40,50), JOB
-*
- 10 CONTINUE
- CALL MFOTRB(PAR(1))
- CALL MFOTRB(PAR(2))
- GO TO 140
-*
- 20 CONTINUE
- DO 30 I=1,4
- CALL MFOTRB(PAR(I))
- 30 CONTINUE
- 40 CONTINUE
- LCH = LENOCC(CHARS)
- CALL MFOTIB(LCH)
- CALL MPUTBF(CHARS,LCH)
- GO TO 140
-*
- 50 CONTINUE
- CALL MFOTIB(IPEN)
- ELSE
- GO TO (60 ,70 ,80 ,90 ,100,110,120), JOB
- 60 WRITE (LUNG(1),10000) 'PA',PAR(1),PAR(2)
- GO TO 140
- 70 WRITE (LUNG(1),10000) 'MA',PAR(1),PAR(2)
- GO TO 140
- 80 WRITE (LUNG(1),10000) 'TR',PAR(1),PAR(2)
- GO TO 140
- 90 CONTINUE
- WRITE(LUNG(1),10100) 'PS',(PAR(i),i=1,4),CHARS
- GO TO 140
- 100 CONTINUE
- WRITE(LUNG(1),10200) 'SC',PAR(1),PAR(2)
- GO TO 140
- 110 CONTINUE
- WRITE(LUNG(1),10300) 'SS ',CHARS
- GO TO 140
- 120 WRITE(LUNG(1),10400) 'SP ',IPEN
- 130 CONTINUE
- END IF
- END IF
-*
- 140 CONTINUE
-10000 FORMAT(A,1X,F6.0,1x,f6.0)
-10100 FORMAT(A,1X,3f7.0,G12.3,' "',A,'"')
-10200 FORMAT(A,1X,F10.6,1x,f10.6)
-10300 format(a,'"',A,'"')
-10400 FORMAT(A,I3)
- END
-#endif
diff --git a/src/graflib/higz/igold/iclrwk.F b/src/graflib/higz/igold/iclrwk.F
deleted file mode 100644
index 8758b05..0000000
--- a/src/graflib/higz/igold/iclrwk.F
+++ /dev/null
@@ -1,135 +0,0 @@
-*
-* $Id: iclrwk.F,v 1.1.1.1 1996/02/14 13:10:48 mclareni Exp $
-*
-* $Log: iclrwk.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:48 mclareni
-* Higz
-*
-*
-#if defined(CERNLIB_MSDOS)
-#include "higz/pilot.h"
-*CMZ : 1.18/01 04/05/93 17.56.14 by O.Couet
-*-- Author : V.Fine
- SUBROUTINE ICLRWK(IWKID,ICOFL)
- ENTRY GCLRWK(IWKID,ICOFL)
-#include "higz/hikern.inc"
-#include "higz/hiatt.inc"
-#include "higz/hiflag.inc"
-#include "higz/himeta.inc"
- CHARACTER CHPTNO*8
- DIMENSION RVAL(2)
-*
- IF(GFLAG)THEN
- IF(IWKID.EQ.0)THEN
- DO 20 I=1,INOPWK
- IF(NODRFL(I))GOTO 20
- ISAVE = IWKNB
- IWKNB = I
- CALL IGQWK(ILOPWK(I),'MXDS',RVAL)
- IF((REDIT.NE.0).AND.(REDIT.NE.1.))THEN
- CALL IGCLES
- ELSE
- CALL IGSG(I)
- CALL WINPOP
- CALL SETPAT(0)
- CALL COLOR(IOFCOL)
- ICURCI(I)=0
- CALL COLOR(IOFCOL)
- call setlin(1)
-C
- IXSAVE(I) = -1.0
- IYSAVE(I) = -1.0
-C
- IF (ILOPWK(I) .NE. IDMETA) then
- IER = CLEAR()
- ELSE
- IF (IWTYL(I) .EQ. ISURF) THEN
-*
-* Automatic naming of the meta-file of the picture
-*
- WRITE (CHPTNO,10000) IPICNM
- IPICNM=IPICNM+1
- NLAST=LENOCC(CHPTNO)
- NFIRST=1
- 10 IF(CHPTNO(NFIRST:NFIRST).EQ.' ')THEN
- NFIRST=NFIRST+1
- GOTO 10
- ENDIF
- CALL GOLCLO
- CHMETA = ' '
-#if defined(CERNLIB_ZEBRA)
- IF (ZFLAG) CALL IZPICT(chmeta,'G')
-#endif
- IF (chmeta .EQ. ' ') THEN
- chmeta='META'//CHPTNO(NFIRST:NLAST)//'.PLT'
- ELSE
- chmeta = chmeta(1:LENOCC(chmeta))//'.PLT'
- END IF
- LOCK = .FALSE.
- SYMFIL = 'DEFAULT.SYM'
- CALL GOLINI(LUNMET(I),chmeta,'BINARY')
- END IF
- END IF
- IF(IFAIS.GT.1)CALL SETPAT(IFASI)
- ENDIF
- 20 CONTINUE
- ELSE
- IWT=IGIWTY(IWKID)
- IF(IWT.LE.0)GOTO 40
- CALL IGQWK(IWKID,'MXDS',RVAL)
- IF((REDIT.NE.0).AND.(REDIT.NE.1.))THEN
- CALL IGCLES
- ELSE
- I=IGIWIN(IWKID)
- CALL IGSG(I)
- CALL WINPOP
- CALL SETPAT(0)
- CALL COLOR(IOFCOL)
- ICURCI(I)=0
- CALL COLOR(IOFCOL)
- call setlin(1)
- IXSAVE(I) = -1.0
- IYSAVE(I) = -1.0
- IF (ILOPWK(I) .NE. IDMETA) then
- IER = CLEAR()
- ELSE
- IF (IWTYL(I) .EQ. ISURF) THEN
-*
-* Automatic naming of the meta-file of the picture
-*
- WRITE (CHPTNO,10000) IPICNM
- IPICNM=IPICNM+1
- NLAST=LENOCC(CHPTNO)
- NFIRST=1
- 30 IF(CHPTNO(NFIRST:NFIRST).EQ.' ')THEN
- NFIRST=NFIRST+1
- GOTO 30
- ENDIF
-C===
- CALL GOLCLO
- CHMETA = ' '
-#if defined(CERNLIB_ZEBRA)
- IF (ZFLAG) CALL IZPICT(chmeta,'G')
-#endif
- IF (chmeta .EQ. ' ') THEN
- chmeta='META'//CHPTNO(NFIRST:NLAST)//'.PLT'
- ELSE
- chmeta = chmeta(1:LENOCC(chmeta))//'.PLT'
- END IF
-C===
- LOCK = .FALSE.
- SYMFIL = 'DEFAULT.SYM'
- CALL GOLINI(LUNMET(I),chmeta,'BINARY')
- END IF
- END IF
- IF(IFAIS.GT.1)CALL SETPAT(IFASI)
- ENDIF
- ENDIF
- ENDIF
- 40 CONTINUE
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_PSCRIPT)||defined(CERNLIB_MAIL)
- IF(GLFLAG)CALL IZCLRD
-#endif
-10000 FORMAT(I5)
- END
-#endif
diff --git a/src/graflib/higz/igold/imfuwk.F b/src/graflib/higz/igold/imfuwk.F
deleted file mode 100644
index 0fa2cec..0000000
--- a/src/graflib/higz/igold/imfuwk.F
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: imfuwk.F,v 1.1.1.1 1996/02/14 13:10:48 mclareni Exp $
-*
-* $Log: imfuwk.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:48 mclareni
-* Higz
-*
-*
-#if defined(CERNLIB_MSDOS)
-#include "higz/pilot.h"
-*CMZ : 1.14/11 29/06/92 13.58.00 by Unknown
-*-- Author : V.Fine
- SUBROUTINE IMFUWK(ITY)
-#include "higz/hiatt.inc"
-#include "higz/hikern.inc"
-#include "higz/himeta.inc"
- DIMENSION PAR(2)
- IF (ITY .EQ. ISURF) THEN
- DY=RDWYMA-RDWYMI
- DX=RDWXMA-RDWXMI
-*
- IF(DY.GT.DX)THEN
- PAR(1)=(RDVXMA)/DX
- ELSE
- PAR(1)=(RDVYMA)/DY
- ENDIF
- PAR(2) = PAR(1)/SCMETA
- SCMETA = PAR(1)
- PAR(1) = PAR(2)
- CALL GOLWRI(SC,PAR,' ')
- END IF
- END
-#endif
diff --git a/src/graflib/higz/igold/mfotib.F b/src/graflib/higz/igold/mfotib.F
deleted file mode 100644
index 9cebaca..0000000
--- a/src/graflib/higz/igold/mfotib.F
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: mfotib.F,v 1.1.1.1 1996/02/14 13:10:48 mclareni Exp $
-*
-* $Log: mfotib.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:48 mclareni
-* Higz
-*
-*
-#if defined(CERNLIB_MSDOS)
-#include "higz/pilot.h"
-*CMZ : 1.14/11 29/06/92 13.58.00 by Unknown
-*-- Author : V.Fine
- SUBROUTINE MFOTIB(IVAL)
-#include "higz/golden.inc"
-*
- CALL MPUTBF(char(ival),1)
- END
-#endif
diff --git a/src/graflib/higz/igold/mfotrb.F b/src/graflib/higz/igold/mfotrb.F
deleted file mode 100644
index 6f8e773..0000000
--- a/src/graflib/higz/igold/mfotrb.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: mfotrb.F,v 1.1.1.1 1996/02/14 13:10:48 mclareni Exp $
-*
-* $Log: mfotrb.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:48 mclareni
-* Higz
-*
-*
-#if defined(CERNLIB_MSDOS)
-#include "higz/pilot.h"
-*CMZ : 1.14/11 29/06/92 13.58.00 by Unknown
-*-- Author : V.Fine
- SUBROUTINE MFOTRB(VAL)
-#include "higz/golden.inc"
- CHARACTER*4 CWORK
- EQUIVALENCE (CWORK, WORK)
-*
- WORK = VAL
- CALL MPUTBF(CWORK,4)
- END
-#endif
diff --git a/src/graflib/higz/igold/moutbf.F b/src/graflib/higz/igold/moutbf.F
deleted file mode 100644
index 1fb6b47..0000000
--- a/src/graflib/higz/igold/moutbf.F
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: moutbf.F,v 1.1.1.1 1996/02/14 13:10:48 mclareni Exp $
-*
-* $Log: moutbf.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:48 mclareni
-* Higz
-*
-*
-#if defined(CERNLIB_MSDOS)
-#include "higz/pilot.h"
-*CMZ : 1.14/11 29/06/92 13.58.00 by Unknown
-*-- Author : V.Fine
- SUBROUTINE MOUTBF
-#include "higz/golden.inc"
-#if defined(CERNLIB_XIOPAK)
- CALL XOTBYF(LUNG,CHMBUF(:IPOINT-1),IPOINT-1)
-#endif
-#if defined(CERNLIB_CIPACK)
- CALL CIPUT(LUNG,CHMBUF(:IPOINT-1),IPOINT-1,ISTAT)
- IF (ISTAT .LT. 0) GO TO 10
-#endif
-#if (!defined(CERNLIB_XIOPAK))&&(!defined(CERNLIB_CIPACK))
- Write (LUNG(1), err=10 , rec=NREC) BUFFER
- CALL VFILL(BUFFER,LBUF/4,0)
-#endif
- NREC = NREC + 1
- RETURN
-#if !defined(CERNLIB_XIOPAK)
- 10 CONTINUE
- CALL IGERR('META FILE WRITE FAULT','MOUTBF')
-#endif
- END
-#endif
diff --git a/src/graflib/higz/igold/mputbf.F b/src/graflib/higz/igold/mputbf.F
deleted file mode 100644
index 0b7e97f..0000000
--- a/src/graflib/higz/igold/mputbf.F
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: mputbf.F,v 1.1.1.1 1996/02/14 13:10:48 mclareni Exp $
-*
-* $Log: mputbf.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:48 mclareni
-* Higz
-*
-*
-#if defined(CERNLIB_MSDOS)
-#include "higz/pilot.h"
-*CMZ : 1.14/11 29/06/92 13.58.00 by Unknown
-*-- Author : V.Fine
- SUBROUTINE MPUTBF(CHARST,LCH)
-#include "higz/golden.inc"
- CHARACTER*(*) CHARST
-*
- IF (LCH .LE. 0 .OR. LCH .GT. LENOCC(CHARST)) RETURN
- DO 10 I=1,LCH
- IF (IPOINT .EQ. LBUF+1) THEN
- CALL MOUTBF
- IPOINT = 1
- END IF
- CHMBUF(IPOINT:IPOINT) = CHARST(I:I)
- IPOINT = IPOINT + 1
- 10 CONTINUE
- END
-#endif
diff --git a/src/graflib/higz/ih/Imakefile b/src/graflib/higz/ih/Imakefile
deleted file mode 100644
index e6bd709..0000000
--- a/src/graflib/higz/ih/Imakefile
+++ /dev/null
@@ -1,11 +0,0 @@
-SRCS_F= ihaxiv.F ihbbox.F ihclev.F ihcspe.F ihdf01.F ihdf02.F \ @@\
- ihdf03.F ihdfl1.F ihdfl2.F ihdfr1.F ihdfr2.F iheran.F ihfbox.F \ @@\
- ihimpf.F ihiso.F ihlegc.F ihlegp.F ihlegr.F ihlegs.F ihligh.F \ @@\
- ihlumi.F ihmc00.F ihmc03.F ihmc04.F ihmc06.F ihmc07.F ihmc10.F \ @@\
- ihmc12.F ihmc13.F ihmcmp.F ihmcpp.F ihmctt.F ihmcub.F ihmcx.F \ @@\
- ihpff.F ihprop.F ihpvie.F ihrcle.F ihrfil.F ihrini.F ihrlin.F \ @@\
- ihroff.F ihsdrl.F ihsini.F ihsmdf.F ihsurc.F ihsurp.F ihsurr.F \ @@\
- ihsurs.F ihsvie.F ihwlin.F ihwphi.F ihwth.F ihwton.F ihwv01.F \ @@\
- ihwv02.F ihwvr1.F ihwvr2.F ihwwnn.F ihwzn.F ihzdep.F ihztst.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/graflib/higz/ih/Imakefile.dgks b/src/graflib/higz/ih/Imakefile.dgks
deleted file mode 100644
index 2083419..0000000
--- a/src/graflib/higz/ih/Imakefile.dgks
+++ /dev/null
@@ -1,15 +0,0 @@
-SRCS_F= ihaxiv.F ihbbox.F ihclev.F ihcspe.F ihdf01.F ihdf02.F \ @@\
- ihdf03.F ihdfl1.F ihdfl2.F ihdfr1.F ihdfr2.F iheran.F ihfbox.F \ @@\
- ihimpf.F ihiso.F ihlegc.F ihlegp.F ihlegr.F ihlegs.F ihligh.F \ @@\
- ihlumi.F ihmc00.F ihmc03.F ihmc04.F ihmc06.F ihmc07.F ihmc10.F \ @@\
- ihmc12.F ihmc13.F ihmcmp.F ihmcpp.F ihmctt.F ihmcub.F ihmcx.F \ @@\
- ihpff.F ihprop.F ihpvie.F ihrcle.F ihrfil.F ihrini.F ihrlin.F \ @@\
- ihroff.F ihsdrl.F ihsini.F ihsmdf.F ihsurc.F ihsurp.F ihsurr.F \ @@\
- ihsurs.F ihsvie.F ihwlin.F ihwphi.F ihwth.F ihwton.F ihwv01.F \ @@\
- ihwv02.F ihwvr1.F ihwvr2.F ihwwnn.F ihwzn.F ihzdep.F ihztst.F
-
-SubdirExtraLibraryTarget(NullParameter,NullParameter,NullParameter,dgks)
-
-VersionFortranObjectRule(dgks,NullParameter,-DCERNLIB_DECGKS)
-
-BuildNamedMakefileTarget(Makefile.dgks,Imakefile.dgks,-DCERNLIB_DECGKS)
diff --git a/src/graflib/higz/ih/ihaxiv.F b/src/graflib/higz/ih/ihaxiv.F
deleted file mode 100644
index 7111d5f..0000000
--- a/src/graflib/higz/ih/ihaxiv.F
+++ /dev/null
@@ -1,134 +0,0 @@
-*
-* $Id: ihaxiv.F,v 1.1.1.1 1996/02/14 13:10:48 mclareni Exp $
-*
-* $Log: ihaxiv.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:48 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.18/00 08/04/93 16.29.10 by O.Couet
-*-- Author :
- SUBROUTINE IHAXIV(RMIN,RMAX,ANG,AV,IX1,IX2,IY1,IY2,IZ1,IZ2)
-************************************************************************
-* *
-* IHAXIV Date: 20.09.90 *
-* Author: E. Chernyaev (IHEP/Protvino) Revised: *
-* *
-* Function: Define axis vertecies *
-* *
-* Input: RMIN(3) - min- *
-* RMAX(3) - max scope *
-* ANG - angle between X and Y axis *
-* *
-* Output: AV(3,8) - axis vertixes *
-* IX1 - 1st point of X-axis *
-* IX2 - 2nd point of X-axis *
-* IY1 - 1st point of Y-axis *
-* IY2 - 2nd point of Y-axis *
-* IZ1 - 1st point of Z-axis *
-* IZ2 - 2nd point of Z-axis *
-* *
-* 8 6 *
-* / \ /|\ *
-* 5 / \ 7 5 / | \ 7 *
-* |\ /| | | | *
-* THETA < 90 | \6/ | THETA > 90 | /2\ | *
-* (Top view) | | | (Bottom view) |/ \| *
-* 1 \ | /3 1 \ /3 *
-* \|/ \ / *
-* 2 4 *
-* *
-************************************************************************
-#include "higz/hcscrn.inc"
- REAL RMIN(3),RMAX(3),AV(3,8),P(2,4)
- DOUBLE PRECISION RAD,COSA,SINA
-*-
- RAD = ATAN(1.D0)*4./180.
- SINA = SIN(ANG*RAD)
- COSA = COS(ANG*RAD)
- P(1,1) = RMIN(1)
- P(2,1) = RMIN(2)
- P(1,2) = RMAX(1)
- P(2,2) = RMIN(2)
- P(1,3) = RMAX(1)
- P(2,3) = RMAX(2)
- P(1,4) = RMIN(1)
- P(2,4) = RMAX(2)
-* F I N D T H E M O S T L E F T P O I N T
- I1 = 1
- IF (TN(1,1) .LT. 0.) I1 = 2
- IF (TN(1,1)*COSA+TN(2,1)*SINA .LT. 0.) I1 = 5 - I1
-* S E T O T H E R P O I N T S
- I2 = MOD(I1,4) + 1
- I3 = MOD(I2,4) + 1
- I4 = MOD(I3,4) + 1
-*
-** S E T A X I S V E R T I X E S
-*
- AV(1,1) = P(1,I1)
- AV(2,1) = P(2,I1)
- AV(1,2) = P(1,I2)
- AV(2,2) = P(2,I2)
- AV(1,3) = P(1,I3)
- AV(2,3) = P(2,I3)
- AV(1,4) = P(1,I4)
- AV(2,4) = P(2,I4)
- DO 100 I=1,4
- AV(3,I) = RMIN(3)
- AV(1,I+4) = AV(1,I)
- AV(2,I+4) = AV(2,I)
- AV(3,I+4) = RMAX(3)
- 100 CONTINUE
-*
-** S E T A X I S
-*
- IF (AV(1,1) .EQ. AV(1,2)) IX = 2
- IF (AV(2,1) .EQ. AV(2,2)) IX = 1
- IY = 3 - IX
-* X - A X I S
- IX1 = IX
- IF (AV(1,IX) .GT. AV(1,IX+1)) IX1 = IX + 1
- IX2 = IX*2 - IX1 + 1
-* Y - A X I S
- IY1 = IY
- IF (AV(2,IY) .GT. AV(2,IY+1)) IY1 = IY + 1
- IY2 = IY*2 - IY1 + 1
-* Z - A X I S
- IZ1 = 1
- IZ2 = 5
-*
- IF (TN(3,3) .GE. 0.) GOTO 999
- K = (IX1-1)*3 + IX2
-* 11 12 13 21 22 23 31 32 33
- GOTO(999,212,999,221,999,223,999,232,999),K
- 212 IX1 = 4
- IX2 = 3
- GOTO 300
- 221 IX1 = 3
- IX2 = 4
- GOTO 300
- 223 IX1 = 1
- IX2 = 4
- GOTO 300
- 232 IX1 = 4
- IX2 = 1
- GOTO 300
-*
- 300 K = (IY1-1)*3 + IY2
-* 11 12 13 21 22 23 31 32 33
- GOTO(999,312,999,321,999,323,999,332,999),K
- 312 IY1 = 4
- IY2 = 3
- GOTO 999
- 321 IY1 = 3
- IY2 = 4
- GOTO 999
- 323 IY1 = 1
- IY2 = 4
- GOTO 999
- 332 IY1 = 4
- IY2 = 1
- GOTO 999
-*
- 999 END
diff --git a/src/graflib/higz/ih/ihbbox.F b/src/graflib/higz/ih/ihbbox.F
deleted file mode 100644
index 391fd01..0000000
--- a/src/graflib/higz/ih/ihbbox.F
+++ /dev/null
@@ -1,66 +0,0 @@
-*
-* $Id: ihbbox.F,v 1.1.1.1 1996/02/14 13:10:48 mclareni Exp $
-*
-* $Log: ihbbox.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:48 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.15/02 17/07/92 13.45.04 by O.Couet
-*-- Author :
- SUBROUTINE IHBBOX(RMIN,RMAX,ANG,DRFACE)
-************************************************************************
-* *
-* IHBBOX Date: 13.01.92 *
-* Author: E. Chernyaev (IHEP/Protvino) Revised: *
-* *
-* Function: Draw back surfaces of surrounding box *
-* *
-* References: IHAXIV *
-* *
-* Input: RMIN(3) - MIN - *
-* RMAX(3) - MAX scope *
-* ANG - angle between X and Y axis *
-* *
-* DRFACE(ICODES,XYZ,NP,IFACE,T) - routine for face drawing *
-* ICODES(*) - set of codes for this face *
-* NP - number of nodes in face *
-* IFACE(NP) - face *
-* T(NP) - additional function *
-* *
-************************************************************************
- REAL RMIN(3),RMAX(3),AV(3,8),R(3,8),TT(4)
- DOUBLE PRECISION RAD,COSA,SINA
- INTEGER ICODES(3),IFACE1(4),IFACE2(4)
- EXTERNAL DRFACE
- DATA IFACE1/1,4,8,5/,IFACE2/4,3,7,8/
-*-
- RAD = ATAN(1.D0)*4./180.
- COSA = COS(RAD*ANG)
- SINA = SIN(RAD*ANG)
- CALL IHAXIV(RMIN,RMAX,ANG,AV,IX1,IX2,IY1,IY2,IZ1,IZ2)
- DO 10 I=1,8
- R(1,I) = AV(1,I) + AV(2,I)*COSA
- R(2,I) = AV(2,I)*SINA
- R(3,I) = AV(3,I)
- 10 CONTINUE
-*
-** D R A W F O R W A R D F A C E S
-*
- ICODES(1) = 0
- ICODES(2) = 0
- ICODES(3) = 0
- TT(1) = R(3,IFACE1(1))
- TT(2) = R(3,IFACE1(2))
- TT(3) = R(3,IFACE1(3))
- TT(4) = R(3,IFACE1(4))
- CALL DRFACE(ICODES,R,4,IFACE1,TT)
- TT(1) = R(3,IFACE2(1))
- TT(2) = R(3,IFACE2(2))
- TT(3) = R(3,IFACE2(3))
- TT(4) = R(3,IFACE2(4))
- CALL DRFACE(ICODES,R,4,IFACE2,TT)
-*
- RETURN
- END
diff --git a/src/graflib/higz/ih/ihclev.F b/src/graflib/higz/ih/ihclev.F
deleted file mode 100644
index cc2ba0f..0000000
--- a/src/graflib/higz/ih/ihclev.F
+++ /dev/null
@@ -1,72 +0,0 @@
-*
-* $Id: ihclev.F,v 1.1.1.1 1996/02/14 13:10:48 mclareni Exp $
-*
-* $Log: ihclev.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:48 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.13/09 15/01/92 15.34.56 by O.Couet
-*-- Author :
- SUBROUTINE IHCLEV(NL,FL,ICL,IREP)
-************************************************************************
-* *
-* IHCLEV Date: 09.01.92 *
-* Author: E.Chernyaev (IHEP/Protvino) Revised: *
-* *
-* Function: Set correspondance between function and color levels *
-* *
-* Input: NL - number of levels *
-* FL(NL) - function levels *
-* ICL(NL+1) - colors for levels *
-* *
-* Output: IREP - reply: 0 O.K. *
-* -1 error in parameters: *
-* illegal number of levels *
-* function levels must be in increasing order *
-* negative color index *
-* *
-************************************************************************
-#include "higz/hclevl.inc"
- REAL FL(*)
- INTEGER ICL(*)
-*-
- IREP = 0
- IF (NL .EQ. 0) THEN
- NLEV = 0
- GOTO 999
- END IF
-*
-** C H E C K P A R A M E T E R S
-*
- IF (NL.LT.0 .OR. NL.GT.LLEV) GOTO 996
- DO 110 I=2,NL
- IF (FL(I) .LE. FL(I-1)) GOTO 997
- 110 CONTINUE
- DO 120 I=1,NL+1
- IF (ICL(I) .LT. 0) GOTO 998
- 120 CONTINUE
-*
-** S E T L E V E L S
-*
- NLEV = NL
- DO 210 I=1,NLEV
- FUNLEV(I) = FL(I)
- 210 CONTINUE
- DO 220 I=1,NLEV+1
- ICLEV(I) = ICL(I)
- 220 CONTINUE
- GOTO 999
-*
- 996 WRITE(*,*) 'IHCLEV: illegal number of levels'
- IREP =-1
- GOTO 999
- 997 WRITE(*,*) 'IHCLEV: function levels must be in increasing order'
- IREP =-1
- GOTO 999
- 998 WRITE(*,*) 'IHCLEV: negative color index'
- IREP =-1
- GOTO 999
- 999 RETURN
- END
diff --git a/src/graflib/higz/ih/ihcspe.F b/src/graflib/higz/ih/ihcspe.F
deleted file mode 100644
index 0a61297..0000000
--- a/src/graflib/higz/ih/ihcspe.F
+++ /dev/null
@@ -1,74 +0,0 @@
-*
-* $Id: ihcspe.F,v 1.1.1.1 1996/02/14 13:10:48 mclareni Exp $
-*
-* $Log: ihcspe.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:48 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.13/09 14/01/92 14.38.06 by O.Couet
-*-- Author :
- SUBROUTINE IHCSPE(NL,FMIN,FMAX,IC,IDC,IREP)
-************************************************************************
-* *
-* IHCSPE Date: 09.01.92 *
-* Author: E.Chernyaev (IHEP/Protvino) Revised: *
-* *
-* Function: Set spectr *
-* *
-* Input: NL - number of levels *
-* FMIN - MIN fuction value *
-* FMAX - MAX fuction value *
-* IC - initial color index (for 1st level) *
-* IDC - color index increment *
-* *
-* Output: IREP - reply: 0 O.K. *
-* -1 error in parameters *
-* F_max less than F_min *
-* illegal number of levels *
-* initial color index is negative *
-* color index increment must be positive *
-* *
-************************************************************************
-#include "higz/hclevl.inc"
-*-
- IREP = 0
- IF (NL .EQ. 0) THEN
- NLEV = 0
- GOTO 999
- END IF
-*
-** C H E C K P A R A M E T E R S
-*
- IF (FMAX .LE. FMIN) GOTO 995
- IF (NL.LT.0 .OR. NL.GT.LLEV) GOTO 996
- IF (IC .LT. 0) GOTO 997
- IF (IDC .LT. 0) GOTO 998
-*
-** S E T S P E C T R
-*
- DELF = (FMAX-FMIN) / NL
- NLEV =-(NL+1)
- DO 100 I=1,NL+1
- FUNLEV(I) = FMIN + (I-1)*DELF
- ICLEV(I+1) = IC + (I-1)*IDC
- 100 CONTINUE
- ICLEV(1) = ICLEV(2)
- ICLEV(NL+2) = ICLEV(NL+1)
- GOTO 999
-*
- 995 WRITE (*,*) 'IHCSPE: F_max less than F_min'
- IREP =-1
- GOTO 999
- 996 WRITE (*,*) 'IHCSPE: illegal number of levels'
- IREP =-1
- GOTO 999
- 997 WRITE (*,*) 'IHCSPE: initial color index is negative'
- IREP =-1
- GOTO 999
- 998 WRITE (*,*) 'IHCSPE: color index increment must be positive'
- IREP =-1
- GOTO 999
- 999 RETURN
- END
diff --git a/src/graflib/higz/ih/ihdf01.F b/src/graflib/higz/ih/ihdf01.F
deleted file mode 100644
index b202d82..0000000
--- a/src/graflib/higz/ih/ihdf01.F
+++ /dev/null
@@ -1,79 +0,0 @@
-*
-* $Id: ihdf01.F,v 1.1.1.1 1996/02/14 13:10:49 mclareni Exp $
-*
-* $Log: ihdf01.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:49 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.19/05 26/08/93 09.38.31 by O.Couet
-*-- Author :
- SUBROUTINE IHDF01(ICODES,XYZ,NP,IFACE,T)
-************************************************************************
-* *
-* IHDF01 Date: 17.09.90 *
-* Author: E. Chernyaev (IHEP/Protvino) Revised: 10.01.92 *
-* 15.08.93 *
-* Function: Draw face - 1st variant *
-* (2 colors: 1st for external surface, 2nd for internal) *
-* *
-* References: IHWTON *
-* *
-* Input: ICODES(*) - set of codes for the line (not used) *
-* ICODES(1) - IX *
-* ICODES(2) - IY *
-* XYZ(3,*) - coordinates of nodes *
-* NP - number of nodes *
-* IFACE(NP) - face *
-* T(NP) - additional function defined on this face *
-* (not used in this routine) *
-* *
-************************************************************************
- REAL XYZ(3,*),P3(2,12),X(13),Y(13),T(*)
- INTEGER ICODES(*),IFACE(*)
-*-
-** T R A N S F E R T O N O R M A L I S E D COORDINATES
-*
- IFNEG = 0
- DO 100 I=1,NP
- K = IFACE(I)
- IF (K .LT. 0) IFNEG = 1
- IF (K .LT. 0) K =-K
- CALL IHWTON(XYZ(1,K),P3(1,I))
- X(I) = P3(1,I)
- Y(I) = P3(2,I)
- 100 CONTINUE
-*
-** F I N D N O R M A L
-*
- Z = 0.
- DO 200 I=1,NP
- I1 = I
- I2 = I1 + 1
- IF (I2 .GT. NP) I2 = 1
- Z = Z + P3(2,I1)*P3(1,I2) - P3(1,I1)*P3(2,I2)
- 200 CONTINUE
-*
-** D R A W F A C E
-*
- IF (Z .GT. 0) CALL ISFACI(2)
- IF (Z .LE. 0) CALL ISFACI(3)
- CALL ISFAIS(1)
- CALL IFA(NP,X,Y)
-*
-** D R A W B O R D E R
-*
- IF (IFNEG .EQ. 0) THEN
- CALL ISFAIS(0)
- CALL ISFACI(1)
- CALL IFA(NP,X,Y)
- ELSE
- X(NP+1) = X(1)
- Y(NP+1) = Y(1)
- CALL ISPLCI(1)
- DO 300 I=1,NP
- IF (IFACE(I) .GT. 0) CALL IPL(2,X(I),Y(I))
- 300 CONTINUE
- END IF
- END
diff --git a/src/graflib/higz/ih/ihdf02.F b/src/graflib/higz/ih/ihdf02.F
deleted file mode 100644
index 1e68b8b..0000000
--- a/src/graflib/higz/ih/ihdf02.F
+++ /dev/null
@@ -1,53 +0,0 @@
-*
-* $Id: ihdf02.F,v 1.1.1.1 1996/02/14 13:10:49 mclareni Exp $
-*
-* $Log: ihdf02.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:49 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.13/09 27/01/92 16.47.04 by O.Couet
-*-- Author :
- SUBROUTINE IHDF02(ICODES,XYZ,NP,IFACE,T)
-************************************************************************
-* *
-* IHDF02 Date: 17.09.90 *
-* Author: E. Chernyaev (IHEP/Protvino) Revised: 10.01.92 *
-* *
-* Function: Draw face - 2nd option *
-* (fill in correspondance with function levels) *
-* *
-* References: IHWTON, IHPFF *
-* *
-* Input: ICODES(*) - set of codes for the line (not used) *
-* ICODES(1) - IX *
-* ICODES(2) - IY *
-* XYZ(3,*) - coordinates of nodes *
-* NP - number of nodes *
-* IFACE(NP) - face *
-* T(NP) - additional function defined on this face *
-* *
-************************************************************************
-#include "higz/hihid.inc"
- REAL XYZ(3,*),P3(3,12),X(12),Y(12),T(*)
- INTEGER ICODES(*),IFACE(*)
-*-
-** T R A N S F E R T O N O R M A L I S E D COORDINATES
-*
- DO 100 I=1,NP
- K = IFACE(I)
- CALL IHWTON(XYZ(1,K),P3(1,I))
- X(I) = P3(1,I)
- Y(I) = P3(2,I)
- 100 CONTINUE
-*
-** D R A W F A C E & B O R D E R
-*
- CALL IHPFF(NP,P3,T)
- IF(IDRGR.EQ.1)THEN
- CALL ISFACI(1)
- CALL ISFAIS(0)
- CALL IFA(NP,X,Y)
- ENDIF
- END
diff --git a/src/graflib/higz/ih/ihdf03.F b/src/graflib/higz/ih/ihdf03.F
deleted file mode 100644
index 4eb423d..0000000
--- a/src/graflib/higz/ih/ihdf03.F
+++ /dev/null
@@ -1,62 +0,0 @@
-*
-* $Id: ihdf03.F,v 1.1.1.1 1996/02/14 13:10:49 mclareni Exp $
-*
-* $Log: ihdf03.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:49 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.13/09 14/01/92 14.01.24 by O.Couet
-*-- Author :
- SUBROUTINE IHDF03(ICODES,XYZ,NP,IFACE,T)
-************************************************************************
-* *
-* IHDF03 Date: 17.09.90 *
-* Author: E. Chernyaev (IHEP/Protvino) Revised: 12.01.92 *
-* *
-* Function: Draw face - 3rd option *
-* (draw face for stacked lego plot) *
-* *
-* References: IHWTON *
-* *
-* Input: ICODES(*) - set of codes for the line *
-* ICODES(1) - IX coordinate of the line cell *
-* ICODES(2) - IY coordinate of the line cell *
-* ICODES(3) - lego number *
-* ICODES(4) - side: 1-face,2-right,3-back,4-left, *
-* 5-bottom, 6-top *
-* XYZ(3,*) - coordinates of nodes *
-* NP - number of nodes *
-* IFACE(NP) - face *
-* T(*) - additional function (not used here) *
-* *
-* *
-************************************************************************
-#include "higz/hihid.inc"
- REAL XYZ(3,*),X(4),Y(4),P3(3,4),T(*)
- INTEGER ICODES(4),IFACE(*)
-*-
- IF (ICODES(4).EQ.6) ICOL = ISTCOT
- IF (ICODES(4).EQ.5) ICOL = ISTCOB
- IF (ICODES(4).EQ.1) ICOL = ISTCOL(ICODES(3))
- IF (ICODES(4).EQ.2) ICOL = ISTCO2(ICODES(3))
- IF (ICODES(4).EQ.3) ICOL = ISTCOL(ICODES(3))
- IF (ICODES(4).EQ.4) ICOL = ISTCO2(ICODES(3))
- DO 100 I=1,NP
- K = IFACE(I)
- CALL IHWTON(XYZ(1,K),P3(1,I))
- X(I) = P3(1,I)
- Y(I) = P3(2,I)
- 100 CONTINUE
-*
- CALL ISFAIS(1)
- CALL ISFACI(ICOL)
- CALL IFA(NP,X,Y)
- IF(IDRGR.NE.0)THEN
- CALL ISLN(1)
- CALL ISFAIS(0)
- CALL ISFACI(1)
- CALL IFA(NP,X,Y)
- ENDIF
- END
diff --git a/src/graflib/higz/ih/ihdfl1.F b/src/graflib/higz/ih/ihdfl1.F
deleted file mode 100644
index 924b03e..0000000
--- a/src/graflib/higz/ih/ihdfl1.F
+++ /dev/null
@@ -1,99 +0,0 @@
-*
-* $Id: ihdfl1.F,v 1.1.1.1 1996/02/14 13:10:49 mclareni Exp $
-*
-* $Log: ihdfl1.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:49 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.13/09 17/01/92 18.23.27 by O.Couet
-*-- Author :
- SUBROUTINE IHDFL1(ICODES,XYZ,NP,IFACE,TT)
-************************************************************************
-* *
-* IHDFL1 Date: 10.01.92 *
-* Author: E. Chernyaev (IHEP/Protvino) Revised: *
-* *
-* Function: Draw face - 1st variant for "MOVING SCREEN" algorithm *
-* (draw face with level lines) *
-* *
-* References: IHWLIN, IHWTON, IHSDRL, IHSMDF *
-* *
-* Input: ICODES(*) - set of codes for the line (not used) *
-* ICODES(1) - IX *
-* ICODES(2) - IY *
-* XYZ(3,*) - coordinates of nodes *
-* NP - number of nodes *
-* IFACE(NP) - face *
-* TT(NP) - additional function defined on this face *
-* (not used in this routine) *
-* *
-************************************************************************
-#include "higz/hcscrn.inc"
-#include "higz/hcline.inc"
- REAL XYZ(3,*),P1(3),P2(3),P3(3,12),TT(*),X(2),Y(2)
- INTEGER ICODES(*),IFACE(*)
-*-
-** C O P Y P O I N T S T O A R R A Y
-*
- DO 100 I=1,NP
- K = IFACE(I)
- P3(1,I) = XYZ(1,K)
- P3(2,I) = XYZ(2,K)
- P3(3,I) = XYZ(3,K)
- 100 CONTINUE
-*
-** F I N D L E V E L L I N E S
-*
- CALL IHWLIN(NP,P3,TT)
-*
-** D R A W L E V E L L I N E S
-*
- CALL ISLN(3)
- DO 220 IL=1,NLINES
- CALL IHSDRL(PLINES(1,1,IL),PLINES(1,2,IL))
- CALL IHWTON(PLINES(1,1,IL),P1)
- CALL IHWTON(PLINES(1,2,IL),P2)
- XDEL = P2(1) - P1(1)
- YDEL = P2(2) - P1(2)
- DO 210 IT=1,NT
- X(1) = P1(1) + XDEL*T(1,IT)
- Y(1) = P1(2) + YDEL*T(1,IT)
- X(2) = P1(1) + XDEL*T(2,IT)
- Y(2) = P1(2) + YDEL*T(2,IT)
- CALL IPL(2,X,Y)
- 210 CONTINUE
- 220 CONTINUE
-*
-** D R A W F A C E
-*
- CALL ISLN(1)
- DO 320 I=1,NP
- I1 = I
- I2 = I + 1
- IF (I .EQ. NP) I2 = 1
- CALL IHSDRL(P3(1,I1),P3(1,I2))
- CALL IHWTON(P3(1,I1),P1)
- CALL IHWTON(P3(1,I2),P2)
- XDEL = P2(1) - P1(1)
- YDEL = P2(2) - P1(2)
- DO 310 IT=1,NT
- X(1) = P1(1) + XDEL*T(1,IT)
- Y(1) = P1(2) + YDEL*T(1,IT)
- X(2) = P1(1) + XDEL*T(2,IT)
- Y(2) = P1(2) + YDEL*T(2,IT)
- CALL IPL(2,X,Y)
- 310 CONTINUE
- 320 CONTINUE
-*
-** M O D I F Y S C R E E N
-*
- DO 400 I=1,NP
- I1 = I
- I2 = I + 1
- IF (I .EQ. NP) I2 = 1
- CALL IHSMDF(P3(1,I1),P3(1,I2))
- 400 CONTINUE
-*
- END
diff --git a/src/graflib/higz/ih/ihdfl2.F b/src/graflib/higz/ih/ihdfl2.F
deleted file mode 100644
index 29ad330..0000000
--- a/src/graflib/higz/ih/ihdfl2.F
+++ /dev/null
@@ -1,83 +0,0 @@
-*
-* $Id: ihdfl2.F,v 1.1.1.1 1996/02/14 13:10:49 mclareni Exp $
-*
-* $Log: ihdfl2.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:49 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.18/02 25/05/93 09.31.37 by O.Couet
-*-- Author :
- SUBROUTINE IHDFL2(ICODES,XYZ,NP,IFACE,TT)
-************************************************************************
-* *
-* IHDFL2 Date: 12.01.92 *
-* Author: E. Chernyaev (IHEP/Protvino) Revised: *
-* *
-* Function: Draw face - 2nd variant for "MOVING SCREEN" algorithm *
-* (draw face for stacked lego plot) *
-* *
-* References: IHWLIN, IHWTON, IHSDRL, IHSMDF *
-* *
-* Input: ICODES(*) - set of codes for the line (not used) *
-* ICODES(1) - IX *
-* ICODES(2) - IY *
-* ICODES(3) - line code (N of lego) *
-* XYZ(3,*) - coordinates of nodes *
-* NP - number of nodes *
-* IFACE(NP) - face *
-* TT(NP) - additional function defined on this face *
-* (not used in this routine) *
-* *
-************************************************************************
-#include "higz/hcscrn.inc"
-#include "higz/hihid.inc"
- REAL XYZ(3,*),P1(3),P2(3),P3(3,12),TT(*),X(2),Y(2)
- INTEGER ICODES(*),IFACE(*)
-*-
-** C O P Y P O I N T S T O A R R A Y
-*
- DO 100 I=1,NP
- K = IFACE(I)
- P3(1,I) = XYZ(1,K)
- P3(2,I) = XYZ(2,K)
- P3(3,I) = XYZ(3,K)
- 100 CONTINUE
-*
-** D R A W F A C E
-*
- ICOL = ICODES(3)
- IF(ICOL.NE.0)THEN
- CALL ISPLCI(ISTCOL(ICOL))
- ELSE
- CALL ISPLCI(1)
- ENDIF
- DO 320 I=1,NP
- I1 = I
- I2 = I + 1
- IF (I .EQ. NP) I2 = 1
- CALL IHSDRL(P3(1,I1),P3(1,I2))
- CALL IHWTON(P3(1,I1),P1)
- CALL IHWTON(P3(1,I2),P2)
- XDEL = P2(1) - P1(1)
- YDEL = P2(2) - P1(2)
- DO 310 IT=1,NT
- X(1) = P1(1) + XDEL*T(1,IT)
- Y(1) = P1(2) + YDEL*T(1,IT)
- X(2) = P1(1) + XDEL*T(2,IT)
- Y(2) = P1(2) + YDEL*T(2,IT)
- CALL IPL(2,X,Y)
- 310 CONTINUE
- 320 CONTINUE
-*
-** M O D I F Y S C R E E N
-*
- DO 400 I=1,NP
- I1 = I
- I2 = I + 1
- IF (I .EQ. NP) I2 = 1
- CALL IHSMDF(P3(1,I1),P3(1,I2))
- 400 CONTINUE
-*
- END
diff --git a/src/graflib/higz/ih/ihdfr1.F b/src/graflib/higz/ih/ihdfr1.F
deleted file mode 100644
index 0f3e5c1..0000000
--- a/src/graflib/higz/ih/ihdfr1.F
+++ /dev/null
@@ -1,96 +0,0 @@
-*
-* $Id: ihdfr1.F,v 1.1.1.1 1996/02/14 13:10:49 mclareni Exp $
-*
-* $Log: ihdfr1.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:49 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.19/05 26/08/93 09.34.08 by O.Couet
-*-- Author :
- SUBROUTINE IHDFR1(ICODES,XYZ,NP,IFACE,TT)
-************************************************************************
-* *
-* IHDFR1 Date: 19.05.93 *
-* Author: E. Chernyaev (IHEP/Protvino) Revised: *
-* *
-* Function: Draw face - 1st variant for "RASTER SCREEN" algorithm *
-* (draw face with level lines) *
-* *
-* References: IHWLIN, IHWTON, IHRLIN, IHRFIL *
-* *
-* Input: ICODES(*) - set of codes for the line (not used) *
-* ICODES(1) - IX *
-* ICODES(2) - IY *
-* XYZ(3,*) - coordinates of nodes *
-* NP - number of nodes *
-* IFACE(NP) - face *
-* TT(NP) - additional function defined on this face *
-* (not used in this routine) *
-* *
-************************************************************************
-#include "higz/hcscrn.inc"
-#include "higz/hcline.inc"
- REAL XYZ(3,*),P1(3),P2(3),P3(3,12),TT(*),X(2),Y(2)
- REAL PP(2,12)
- INTEGER ICODES(*),IFACE(*)
-*-
-** C O P Y P O I N T S T O A R R A Y
-*
- DO 100 I=1,NP
- K = IFACE(I)
- IF(K.LT.0)K = -K
- P3(1,I) = XYZ(1,K)
- P3(2,I) = XYZ(2,K)
- P3(3,I) = XYZ(3,K)
- CALL IHWTON(P3(1,I),PP(1,I))
- 100 CONTINUE
-*
-** F I N D L E V E L L I N E S
-*
- CALL IHWLIN(NP,P3,TT)
-*
-** D R A W L E V E L L I N E S
-*
- CALL ISLN(3)
- DO 220 IL=1,NLINES
- CALL IHWTON(PLINES(1,1,IL),P1)
- CALL IHWTON(PLINES(1,2,IL),P2)
- CALL IHRLIN(P1,P2,NTMAX,NT,T)
- XDEL = P2(1) - P1(1)
- YDEL = P2(2) - P1(2)
- DO 210 IT=1,NT
- X(1) = P1(1) + XDEL*T(1,IT)
- Y(1) = P1(2) + YDEL*T(1,IT)
- X(2) = P1(1) + XDEL*T(2,IT)
- Y(2) = P1(2) + YDEL*T(2,IT)
- CALL IPL(2,X,Y)
- 210 CONTINUE
- 220 CONTINUE
-*
-** D R A W F A C E
-*
- CALL ISLN(1)
- DO 320 I=1,NP
- IF(IFACE(I).LT.0)GOTO 320
- I1 = I
- I2 = I + 1
- IF (I .EQ. NP) I2 = 1
- CALL IHRLIN(PP(1,I1),PP(1,I2),NTMAX,NT,T)
- XDEL = PP(1,I2) - PP(1,I1)
- YDEL = PP(2,I2) - PP(2,I1)
- DO 310 IT=1,NT
- X(1) = PP(1,I1) + XDEL*T(1,IT)
- Y(1) = PP(2,I1) + YDEL*T(1,IT)
- X(2) = PP(1,I1) + XDEL*T(2,IT)
- Y(2) = PP(2,I1) + YDEL*T(2,IT)
- CALL IPL(2,X,Y)
- 310 CONTINUE
- 320 CONTINUE
-*
-** M O D I F Y S C R E E N
-*
- CALL IHRFIL(NP,PP)
-*
- END
diff --git a/src/graflib/higz/ih/ihdfr2.F b/src/graflib/higz/ih/ihdfr2.F
deleted file mode 100644
index 91e14ea..0000000
--- a/src/graflib/higz/ih/ihdfr2.F
+++ /dev/null
@@ -1,78 +0,0 @@
-*
-* $Id: ihdfr2.F,v 1.1.1.1 1996/02/14 13:10:49 mclareni Exp $
-*
-* $Log: ihdfr2.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:49 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.19/05 26/08/93 09.34.08 by O.Couet
-*-- Author :
- SUBROUTINE IHDFR2(ICODES,XYZ,NP,IFACE,TT)
-************************************************************************
-* *
-* IHDFR2 Date: 19.05.93 *
-* Author: E. Chernyaev (IHEP/Protvino) Revised: *
-* *
-* Function: Draw face - 2nd variant for "RASTER SCREEN" algorithm *
-* (draw face for stacked lego plot) *
-* *
-* References: IHWTON, IHRLIN, IHRFIL *
-* *
-* Input: ICODES(*) - set of codes for the line (not used) *
-* ICODES(1) - IX *
-* ICODES(2) - IY *
-* ICODES(3) - line code (N of lego) *
-* XYZ(3,*) - coordinates of nodes *
-* NP - number of nodes *
-* IFACE(NP) - face *
-* TT(NP) - additional function defined on this face *
-* (not used in this routine) *
-* *
-************************************************************************
-#include "higz/hcscrn.inc"
-#include "higz/hihid.inc"
- REAL XYZ(3,*),P(3),PP(2,12),TT(*),X(2),Y(2)
- INTEGER ICODES(*),IFACE(*)
-*-
-** C O P Y P O I N T S T O A R R A Y
-*
- DO 100 I=1,NP
- K = IFACE(I)
- IF(K.LT.0)K = -K
- CALL IHWTON(XYZ(1,K),P)
- PP(1,I) = P(1)
- PP(2,I) = P(2)
- 100 CONTINUE
-*
-** D R A W F A C E
-*
- ICOL = ICODES(3)
- IF(ICOL.NE.0)THEN
- CALL ISPLCI(ISTCOL(ICOL))
- ELSE
- CALL ISPLCI(1)
- ENDIF
- DO 320 I=1,NP
- IF(IFACE(I).LT.0)GOTO 320
- I1 = I
- I2 = I + 1
- IF (I .EQ. NP) I2 = 1
- CALL IHRLIN(PP(1,I1),PP(1,I2),NTMAX,NT,T)
- XDEL = PP(1,I2) - PP(1,I1)
- YDEL = PP(2,I2) - PP(2,I1)
- DO 310 IT=1,NT
- X(1) = PP(1,I1) + XDEL*T(1,IT)
- Y(1) = PP(2,I1) + YDEL*T(1,IT)
- X(2) = PP(1,I1) + XDEL*T(2,IT)
- Y(2) = PP(2,I1) + YDEL*T(2,IT)
- CALL IPL(2,X,Y)
- 310 CONTINUE
- 320 CONTINUE
-*
-** M O D I F Y R A S T E R S C R E E N
-*
- CALL IHRFIL(NP,PP)
-*
- END
diff --git a/src/graflib/higz/ih/iheran.F b/src/graflib/higz/ih/iheran.F
deleted file mode 100644
index 1cd2adb..0000000
--- a/src/graflib/higz/ih/iheran.F
+++ /dev/null
@@ -1,143 +0,0 @@
-*
-* $Id: iheran.F,v 1.1.1.1 1996/02/14 13:10:49 mclareni Exp $
-*
-* $Log: iheran.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:49 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.13/09 14/01/92 14.01.24 by O.Couet
-*-- Author :
- SUBROUTINE IHERAN(P1,P2,F1,F2,FMIN,FMAX,KPP,PP)
-************************************************************************
-* *
-* IHERAN Date: 20.03.90 *
-* Author: E. Chernyaev (IHEP) Revised: 13.09.90 *
-* *
-* Function: Find part of edge where function defined on this edge *
-* has value from FMIN to FMAX *
-* *
-* Input: P1(3) - 1st point *
-* P2(3) - 2nd point *
-* F1 - function value at 1st point *
-* F2 - function value at 2nd point *
-* FMIN - min value of layer *
-* FMAX - max value of layer *
-* *
-* Output: KPP - current number of point *
-* PP(3,*) - coordinates of new face *
-* *
-************************************************************************
- REAL P1(3),P2(3),PP(3,*)
-*-
- K1 = 0
- IF (F1 .LT. FMIN) K1 =-2
- IF (F1 .EQ. FMIN) K1 =-1
- IF (F1 .EQ. FMAX) K1 =+1
- IF (F1 .GT. FMAX) K1 =+2
- K2 = 0
- IF (F2 .LT. FMIN) K2 =-2
- IF (F2 .EQ. FMIN) K2 =-1
- IF (F2 .EQ. FMAX) K2 =+1
- IF (F2 .GT. FMAX) K2 =+2
- KK = (K1+2)*5 + (K2+2) + 1
-*
-** K2: -2 -1 0 +1 +2
-* K1: -2 -1 0 +1 +2
- GOTO (999,999,200,200,600,
- + 100,100,100,100,500,
- + 400,100,100,100,500,
- + 400,100,100,100,100,
- + 700,300,300,999,999), KK
-*
-** 1 - S T P O I N T
-*
- 100 KPP = KPP + 1
- PP(1,KPP) = P1(1)
- PP(2,KPP) = P1(2)
- PP(3,KPP) = P1(3)
- GOTO 999
-*
-** I N T E R S E C T I O N W I T H Fmin
-*
- 200 KPP = KPP + 1
- D1 = (FMIN - F1) / (F1 - F2)
- D2 = (FMIN - F2) / (F1 - F2)
- PP(1,KPP) = D2*P1(1) - D1*P2(1)
- PP(2,KPP) = D2*P1(2) - D1*P2(2)
- PP(3,KPP) = D2*P1(3) - D1*P2(3)
- GOTO 999
-*
-** I N T E R S E C T I O N W I T H Fmax
-*
- 300 KPP = KPP + 1
- D1 = (FMAX - F1) / (F1 - F2)
- D2 = (FMAX - F2) / (F1 - F2)
- PP(1,KPP) = D2*P1(1) - D1*P2(1)
- PP(2,KPP) = D2*P1(2) - D1*P2(2)
- PP(3,KPP) = D2*P1(3) - D1*P2(3)
- GOTO 999
-*
-** 1 - S T P O I N T, I N T E R S E C T I O N WITH Fmin
-*
- 400 KPP = KPP + 1
- PP(1,KPP) = P1(1)
- PP(2,KPP) = P1(2)
- PP(3,KPP) = P1(3)
- KPP = KPP + 1
- D1 = (FMIN - F1) / (F1 - F2)
- D2 = (FMIN - F2) / (F1 - F2)
- PP(1,KPP) = D2*P1(1) - D1*P2(1)
- PP(2,KPP) = D2*P1(2) - D1*P2(2)
- PP(3,KPP) = D2*P1(3) - D1*P2(3)
- GOTO 999
-*
-** 1 - S T P O I N T, I N T E R S E C T I O N WITH Fmax
-*
- 500 KPP = KPP + 1
- PP(1,KPP) = P1(1)
- PP(2,KPP) = P1(2)
- PP(3,KPP) = P1(3)
- KPP = KPP + 1
- D1 = (FMAX - F1) / (F1 - F2)
- D2 = (FMAX - F2) / (F1 - F2)
- PP(1,KPP) = D2*P1(1) - D1*P2(1)
- PP(2,KPP) = D2*P1(2) - D1*P2(2)
- PP(3,KPP) = D2*P1(3) - D1*P2(3)
- GOTO 999
-*
-** I N T E R S E C T I O N W I T H Fmin, Fmax
-*
- 600 KPP = KPP + 1
- D1 = (FMIN - F1) / (F1 - F2)
- D2 = (FMIN - F2) / (F1 - F2)
- PP(1,KPP) = D2*P1(1) - D1*P2(1)
- PP(2,KPP) = D2*P1(2) - D1*P2(2)
- PP(3,KPP) = D2*P1(3) - D1*P2(3)
- KPP = KPP + 1
- D1 = (FMAX - F1) / (F1 - F2)
- D2 = (FMAX - F2) / (F1 - F2)
- PP(1,KPP) = D2*P1(1) - D1*P2(1)
- PP(2,KPP) = D2*P1(2) - D1*P2(2)
- PP(3,KPP) = D2*P1(3) - D1*P2(3)
- GOTO 999
-*
-** I N T E R S E C T I O N W I T H Fmax, Fmin
-*
- 700 KPP = KPP + 1
- D1 = (FMAX - F1) / (F1 - F2)
- D2 = (FMAX - F2) / (F1 - F2)
- PP(1,KPP) = D2*P1(1) - D1*P2(1)
- PP(2,KPP) = D2*P1(2) - D1*P2(2)
- PP(3,KPP) = D2*P1(3) - D1*P2(3)
- KPP = KPP + 1
- D1 = (FMIN - F1) / (F1 - F2)
- D2 = (FMIN - F2) / (F1 - F2)
- PP(1,KPP) = D2*P1(1) - D1*P2(1)
- PP(2,KPP) = D2*P1(2) - D1*P2(2)
- PP(3,KPP) = D2*P1(3) - D1*P2(3)
- GOTO 999
-*
- 999 RETURN
- END
diff --git a/src/graflib/higz/ih/ihfbox.F b/src/graflib/higz/ih/ihfbox.F
deleted file mode 100644
index 256915e..0000000
--- a/src/graflib/higz/ih/ihfbox.F
+++ /dev/null
@@ -1,57 +0,0 @@
-*
-* $Id: ihfbox.F,v 1.1.1.1 1996/02/14 13:10:49 mclareni Exp $
-*
-* $Log: ihfbox.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:49 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.15/02 17/07/92 13.45.04 by O.Couet
-*-- Author :
- SUBROUTINE IHFBOX(RMIN,RMAX,ANG,DRFACE)
-************************************************************************
-* *
-* IHFBOX Date: 12.01.92 *
-* Author: E. Chernyaev (IHEP/Protvino) Revised: *
-* *
-* Function: Draw forward faces of surrounding box & axes *
-* *
-* References: IHAXIV, IGAXIS *
-* *
-* Input: RMIN(3) - MIN - *
-* RMAX(3) - MAX scope *
-* ANG - angle between X and Y axis *
-* *
-* DRFACE(ICODES,XYZ,NP,IFACE,T) - routine for face drawing *
-* ICODES(*) - set of codes for this face *
-* NP - number of nodes in face *
-* IFACE(NP) - face *
-* T(NP) - additional function *
-* *
-************************************************************************
- REAL RMIN(3),RMAX(3),AV(3,8),R(3,8),FDUMMY(1)
- DOUBLE PRECISION RAD,COSA,SINA
- INTEGER ICODES(3),IFACE1(4),IFACE2(4)
- EXTERNAL DRFACE
- DATA IFACE1/1,2,6,5/,IFACE2/2,3,7,6/
-*-
- RAD = ATAN(1.D0)*4./180.
- COSA = COS(RAD*ANG)
- SINA = SIN(RAD*ANG)
- CALL IHAXIV(RMIN,RMAX,ANG,AV,IX1,IX2,IY1,IY2,IZ1,IZ2)
- DO 10 I=1,8
- R(1,I) = AV(1,I) + AV(2,I)*COSA
- R(2,I) = AV(2,I)*SINA
- R(3,I) = AV(3,I)
- 10 CONTINUE
-*
-** D R A W F O R W A R D F A C E S
-*
- ICODES(1) = 0
- ICODES(2) = 0
- ICODES(3) = 0
- CALL DRFACE(ICODES,R,4,IFACE1,FDUMMY)
- CALL DRFACE(ICODES,R,4,IFACE2,FDUMMY)
-*
- END
diff --git a/src/graflib/higz/ih/ihimpf.F b/src/graflib/higz/ih/ihimpf.F
deleted file mode 100644
index 2b1c43c..0000000
--- a/src/graflib/higz/ih/ihimpf.F
+++ /dev/null
@@ -1,267 +0,0 @@
-*
-* $Id: ihimpf.F,v 1.2 2002/04/05 13:20:05 couet Exp $
-*
-* $Log: ihimpf.F,v $
-* Revision 1.2 2002/04/05 13:20:05 couet
-* - The variable KSURF was initialized but never used
-*
-* Revision 1.1.1.1 1996/02/14 13:10:49 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.19/06 27/08/93 14.06.00 by O.Couet
-*-- Author :
- SUBROUTINE IHIMPF(FUN,RMIN,RMAX,NX,NY,NZ,DRFACE,CHOPT)
-************************************************************************
-* *
-* IHIMPF Date: 22.08.90 *
-* Author: E. Chernyaev (IHEP/Protvino) Revised: 12.01.92 *
-* 11.09.92 *
-* 25.08.93 *
-* Function: Draw implicit function FUN(X,Y,Z) = 0 in cartesian *
-* coordinates using hidden surface removal algorithm *
-* "Painter". *
-* *
-* Input: FUN - external routine FUN(X,Y,Z) *
-* RMIN(3) - min scope coordinates *
-* RMAX(3) - max scope coordinates *
-* NX - number of steps along X *
-* NY - number of steps along Y *
-* NZ - number of steps along Z *
-* *
-* DRFACE(ICODES,XYZ,NP,IFACE,T) - routine for face drawing *
-* ICODES(*) - set of codes for this face *
-* ICODES(1) - 1 *
-* ICODES(2) - 1 *
-* ICODES(3) - 1 *
-* NP - number of nodes in face *
-* IFACE(NP) - face *
-* T(NP) - additional function (lightness) *
-* *
-* CHOPT - options: 'BF' - from BACK to FRONT *
-* 'FB' - from FRONT to BACK *
-* *
-************************************************************************
-#include "higz/hcmctr.inc"
-#include "higz/hctnor.inc"
- PARAMETER (FDEL = 0.)
- REAL RMIN(3),RMAX(3)
- REAL P(3,8),PF(8),PN(3,8),T(3)
- INTEGER ICODES(3)
- CHARACTER*(*) CHOPT
- EXTERNAL FUN,DRFACE
-*-
-** D E F I N E O R D E R O F D R A W I N G
-*
- IF (CHOPT(1:1).EQ.'B' .OR. CHOPT(1:1).EQ.'b') THEN
- INCRX =+1
- INCRY =+1
- INCRZ =+1
- ELSE
- INCRX =-1
- INCRY =-1
- INCRZ =-1
- END IF
- IF (TNORM(1,3) .LT. 0.) INCRX =-INCRX
- IF (TNORM(2,3) .LT. 0.) INCRY =-INCRY
- IF (TNORM(3,3) .LT. 0.) INCRZ =-INCRZ
- IX1 = 1
- IY1 = 1
- IZ1 = 1
- IF (INCRX .EQ. -1) IX1 = NX
- IF (INCRY .EQ. -1) IY1 = NY
- IF (INCRZ .EQ. -1) IZ1 = NZ
- IX2 = NX - IX1 + 1
- IY2 = NY - IY1 + 1
- IZ2 = NZ - IZ1 + 1
- DX = (RMAX(1)-RMIN(1)) / NX
- DY = (RMAX(2)-RMIN(2)) / NY
- DZ = (RMAX(3)-RMIN(3)) / NZ
-*
-** D R A W F U N C T I O N
-*
- DO 530 IZ=IZ1,IZ2,INCRZ
- Z1 = (IZ-1)*DZ + RMIN(3)
- Z2 = Z1 + DZ
- P(3,1) = Z1
- P(3,2) = Z1
- P(3,3) = Z1
- P(3,4) = Z1
- P(3,5) = Z2
- P(3,6) = Z2
- P(3,7) = Z2
- P(3,8) = Z2
- DO 520 IY=IY1,IY2,INCRY
- Y1 = (IY-1)*DY + RMIN(2)
- Y2 = Y1 + DY
- P(2,1) = Y1
- P(2,2) = Y1
- P(2,3) = Y2
- P(2,4) = Y2
- P(2,5) = Y1
- P(2,6) = Y1
- P(2,7) = Y2
- P(2,8) = Y2
- IF (INCRX .EQ.+1) THEN
- X2 = RMIN(1)
- PF(2) = FUN(X2,Y1,Z1)
- PF(3) = FUN(X2,Y2,Z1)
- PF(6) = FUN(X2,Y1,Z2)
- PF(7) = FUN(X2,Y2,Z2)
- ELSE
- X1 = RMAX(1)
- PF(1) = FUN(X1,Y1,Z1)
- PF(4) = FUN(X1,Y2,Z1)
- PF(5) = FUN(X1,Y1,Z2)
- PF(8) = FUN(X1,Y2,Z2)
- END IF
- DO 510 IX=IX1,IX2,INCRX
- ICODES(1) = IX
- ICODES(2) = IY
- ICODES(3) = IZ
- IF (INCRX .EQ.+1) THEN
- X1 = X2
- X2 = X2 + DX
- PF(1) = PF(2)
- PF(4) = PF(3)
- PF(5) = PF(6)
- PF(8) = PF(7)
- PF(2) = FUN(X2,Y1,Z1)
- PF(3) = FUN(X2,Y2,Z1)
- PF(6) = FUN(X2,Y1,Z2)
- PF(7) = FUN(X2,Y2,Z2)
- ELSE
- X2 = X1
- X1 = X1 - DX
- PF(2) = PF(1)
- PF(3) = PF(4)
- PF(6) = PF(5)
- PF(7) = PF(8)
- PF(1) = FUN(X1,Y1,Z1)
- PF(4) = FUN(X1,Y2,Z1)
- PF(5) = FUN(X1,Y1,Z2)
- PF(8) = FUN(X1,Y2,Z2)
- END IF
- IF (PF(1) .GE. -FDEL) GOTO 110
- IF (PF(2) .GE. -FDEL) GOTO 120
- IF (PF(3) .GE. -FDEL) GOTO 120
- IF (PF(4) .GE. -FDEL) GOTO 120
- IF (PF(5) .GE. -FDEL) GOTO 120
- IF (PF(6) .GE. -FDEL) GOTO 120
- IF (PF(7) .GE. -FDEL) GOTO 120
- IF (PF(8) .GE. -FDEL) GOTO 120
- GOTO 510
- 110 IF (PF(2) .LT. -FDEL) GOTO 120
- IF (PF(3) .LT. -FDEL) GOTO 120
- IF (PF(4) .LT. -FDEL) GOTO 120
- IF (PF(5) .LT. -FDEL) GOTO 120
- IF (PF(6) .LT. -FDEL) GOTO 120
- IF (PF(7) .LT. -FDEL) GOTO 120
- IF (PF(8) .LT. -FDEL) GOTO 120
- GOTO 510
- 120 P(1,1) = X1
- P(1,2) = X2
- P(1,3) = X2
- P(1,4) = X1
- P(1,5) = X1
- P(1,6) = X2
- P(1,7) = X2
- P(1,8) = X1
-*
-** F I N D G R A D I E N T S
-*
- IF (IX .EQ. 1) THEN
- PN(1,1) = (PF(2) - PF(1)) / DX
- PN(1,4) = (PF(3) - PF(4)) / DX
- PN(1,5) = (PF(6) - PF(5)) / DX
- PN(1,8) = (PF(7) - PF(8)) / DX
- ELSE
- PN(1,1) = (PF(2) - FUN(X1-DX,Y1,Z1)) / (DX + DX)
- PN(1,4) = (PF(3) - FUN(X1-DX,Y2,Z1)) / (DX + DX)
- PN(1,5) = (PF(6) - FUN(X1-DX,Y1,Z2)) / (DX + DX)
- PN(1,8) = (PF(7) - FUN(X1-DX,Y2,Z2)) / (DX + DX)
- END IF
- IF (IX .EQ. NX) THEN
- PN(1,2) = (PF(2) - PF(1)) / DX
- PN(1,3) = (PF(3) - PF(4)) / DX
- PN(1,6) = (PF(6) - PF(5)) / DX
- PN(1,7) = (PF(7) - PF(8)) / DX
- ELSE
- PN(1,2) = (FUN(X2+DX,Y1,Z1) - PF(1)) / (DX + DX)
- PN(1,3) = (FUN(X2+DX,Y2,Z1) - PF(4)) / (DX + DX)
- PN(1,6) = (FUN(X2+DX,Y1,Z2) - PF(5)) / (DX + DX)
- PN(1,7) = (FUN(X2+DX,Y2,Z2) - PF(8)) / (DX + DX)
- END IF
-* F I N D Y - G R A D I E N T
- IF (IY .EQ. 1) THEN
- PN(2,1) = (PF(4) - PF(1)) / DY
- PN(2,2) = (PF(3) - PF(2)) / DY
- PN(2,5) = (PF(8) - PF(5)) / DY
- PN(2,6) = (PF(7) - PF(6)) / DY
- ELSE
- PN(2,1) = (PF(4) - FUN(X1,Y1-DY,Z1)) / (DY + DY)
- PN(2,2) = (PF(3) - FUN(X2,Y1-DY,Z1)) / (DY + DY)
- PN(2,5) = (PF(8) - FUN(X1,Y1-DY,Z2)) / (DY + DY)
- PN(2,6) = (PF(7) - FUN(X2,Y1-DY,Z2)) / (DY + DY)
- END IF
- IF (IY .EQ. NY) THEN
- PN(2,3) = (PF(3) - PF(2)) / DY
- PN(2,4) = (PF(4) - PF(1)) / DY
- PN(2,7) = (PF(7) - PF(6)) / DY
- PN(2,8) = (PF(8) - PF(5)) / DY
- ELSE
- PN(2,3) = (FUN(X2,Y2+DY,Z1) - PF(2)) / (DY + DY)
- PN(2,4) = (FUN(X1,Y2+DY,Z1) - PF(1)) / (DY + DY)
- PN(2,7) = (FUN(X2,Y2+DY,Z2) - PF(6)) / (DY + DY)
- PN(2,8) = (FUN(X1,Y2+DY,Z2) - PF(5)) / (DY + DY)
- END IF
-* F I N D Z - G R A D I E N T
- IF (IZ .EQ. 1) THEN
- PN(3,1) = (PF(5) - PF(1)) / DZ
- PN(3,2) = (PF(6) - PF(2)) / DZ
- PN(3,3) = (PF(7) - PF(3)) / DZ
- PN(3,4) = (PF(8) - PF(4)) / DZ
- ELSE
- PN(3,1) = (PF(5) - FUN(X1,Y1,Z1-DZ)) / (DZ + DZ)
- PN(3,2) = (PF(6) - FUN(X2,Y1,Z1-DZ)) / (DZ + DZ)
- PN(3,3) = (PF(7) - FUN(X2,Y2,Z1-DZ)) / (DZ + DZ)
- PN(3,4) = (PF(8) - FUN(X1,Y2,Z1-DZ)) / (DZ + DZ)
- END IF
- IF (IZ .EQ. NZ) THEN
- PN(3,5) = (PF(5) - PF(1)) / DZ
- PN(3,6) = (PF(6) - PF(2)) / DZ
- PN(3,7) = (PF(7) - PF(3)) / DZ
- PN(3,8) = (PF(8) - PF(4)) / DZ
- ELSE
- PN(3,5) = (FUN(X1,Y1,Z2+DZ) - PF(1)) / (DZ + DZ)
- PN(3,6) = (FUN(X2,Y1,Z2+DZ) - PF(2)) / (DZ + DZ)
- PN(3,7) = (FUN(X2,Y2,Z2+DZ) - PF(3)) / (DZ + DZ)
- PN(3,8) = (FUN(X1,Y2,Z2+DZ) - PF(4)) / (DZ + DZ)
- END IF
- FSURF = 0.
- CALL IHMCUB(FSURF,P,PF,PN,NNOD,NTRIA,XYZ,GRAD,ITRIA)
- IF (NTRIA .EQ. 0) GOTO 510
- DO 410 I=1,NNOD
- CALL IHWTON(XYZ(1,I),XYZN(1,I))
- CALL IHLUMI(GRAD(1,I),W)
- GRAD(1,I) = W
- 410 CONTINUE
- CALL IHZDEP(XYZN,NTRIA,ITRIA,DTRIA,ABCD,IORDER)
- IF (NTRIA .EQ. 0) GOTO 510
- INCR = 1
- IF (CHOPT(1:1).EQ.'B' .OR. CHOPT(1:1).EQ.'b') INCR =-1
- I1 = 1
- IF (INCR .EQ. -1) I1 = NTRIA
- I2 = NTRIA - I1 + 1
- DO 420 I=I1,I2,INCR
- K = IORDER(I)
- T(1) = GRAD(1,IABS(ITRIA(1,K)))
- T(2) = GRAD(1,IABS(ITRIA(2,K)))
- T(3) = GRAD(1,IABS(ITRIA(3,K)))
- CALL DRFACE(ICODES,XYZ,3,ITRIA(1,K),T)
- 420 CONTINUE
- 510 CONTINUE
- 520 CONTINUE
- 530 CONTINUE
- END
diff --git a/src/graflib/higz/ih/ihiso.F b/src/graflib/higz/ih/ihiso.F
deleted file mode 100644
index 711342e..0000000
--- a/src/graflib/higz/ih/ihiso.F
+++ /dev/null
@@ -1,265 +0,0 @@
-*
-* $Id: ihiso.F,v 1.1.1.1 1996/02/14 13:10:49 mclareni Exp $
-*
-* $Log: ihiso.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:49 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.19/06 27/08/93 13.53.33 by O.Couet
-*-- Author :
- SUBROUTINE IHISO(NS,S,NX,NY,NZ,X,Y,Z,F,DRFACE,CHOPT)
-************************************************************************
-* *
-* IHISO Date: 21.07.92 *
-* Author: E. Chernyaev (IHEP/Protvino) Revised: 22.08.93 *
-* *
-* Function: Draw set of isosurfaces for a scalar function *
-* defined on a grid. *
-* *
-* Input: NS - number of isosurfaces *
-* S(*) - isosurface values *
-* NX - number of slices along X *
-* NY - number of slices along Y *
-* NZ - number of slices along Z *
-* X(*) - slices along X *
-* Y(*) - slices along Y *
-* Z(*) - slices along Z *
-* F(NX,NY,NZ) - function values *
-* *
-* DRFACE(ICODES,XYZ,NP,IFACE,T) - routine for face drawing *
-* ICODES(1) - isosurface number *
-* ICODES(2) - isosurface number *
-* ICODES(3) - isosurface number *
-* NP - number of nodes in face *
-* IFACE(NP) - face *
-* T(NP) - additional function (lightness) *
-* *
-* CHOPT - options: 'BF' - from BACK to FRONT *
-* 'FB' - from FRONT to BACK *
-* *
-************************************************************************
-#include "higz/hcmctr.inc"
- CHARACTER*(*) CHOPT
- EXTERNAL DRFACE
- REAL S(*),X(*),Y(*),Z(*)
- REAL P0(3),P1(3),P2(3),P3(3),F(NX,NY,NZ),T(3)
- REAL P(3,8),PF(8),PN(3,8)
- INTEGER IND(3,8),ICODES(3)
- DATA IND/0,0,0, 1,0,0, 1,0,1, 0,0,1,
- & 0,1,0, 1,1,0, 1,1,1, 0,1,1/
-*-
- NSURF = NS
- IF (NSURF .GT. NISO) THEN
- WRITE(*,*) 'IHISO: Warning: No. of isosurfaces great then',NISO
- WRITE(*,*) 'IHISO: Increase parameter NISO in COMMON /HCMCTR/'
- END IF
- IOPT = 2
- IF (CHOPT(1:1).EQ.'B' .OR. CHOPT(1:1).EQ.'b') IOPT = 1
-*
-** F I N D X - , Y - , Z - C R I T I C A L
-** This logic works for parallel projection only.
-** For central projection another logic should be implemented.
-*
- P0(1) = X(1)
- P0(2) = Y(1)
- P0(3) = Z(1)
- CALL IHWTON(P0,P0)
- P1(1) = X(NX)
- P1(2) = Y(1)
- P1(3) = Z(1)
- CALL IHWTON(P1,P1)
- P2(1) = X(1)
- P2(2) = Y(NY)
- P2(3) = Z(1)
- CALL IHWTON(P2,P2)
- P3(1) = X(1)
- P3(2) = Y(1)
- P3(3) = Z(NZ)
- CALL IHWTON(P3,P3)
- IXCRIT = NX
- IYCRIT = NY
- IZCRIT = NZ
- IF (P1(3) .LT. P0(3)) IXCRIT = 1
- IF (P2(3) .LT. P0(3)) IYCRIT = 1
- IF (P3(3) .LT. P0(3)) IZCRIT = 1
-*
-** L O O P A L O N G G R I D
-** This logic works for both (parallel & central) projections.
-*
- INCRX = 1
- INCRY = 1
- INCRZ = 1
- 110 IF (INCRZ .GE. 0) THEN
- IF (IOPT .EQ. 1) IZ1 = 1
- IF (IOPT .EQ. 1) IZ2 = IZCRIT-1
- IF (IOPT .EQ. 2) IZ1 = IZCRIT
- IF (IOPT .EQ. 2) IZ2 = NZ - 1
- ELSE
- IF (IOPT .EQ. 1) IZ1 = NZ - 1
- IF (IOPT .EQ. 1) IZ2 = IZCRIT
- IF (IOPT .EQ. 2) IZ1 = IZCRIT-1
- IF (IOPT .EQ. 2) IZ2 = 1
- END IF
- DO 530 IZ=IZ1,IZ2,INCRZ
- 120 IF (INCRY .GE. 0) THEN
- IF (IOPT .EQ. 1) IY1 = 1
- IF (IOPT .EQ. 1) IY2 = IYCRIT-1
- IF (IOPT .EQ. 2) IY1 = IYCRIT
- IF (IOPT .EQ. 2) IY2 = NY - 1
- ELSE
- IF (IOPT .EQ. 1) IY1 = NY - 1
- IF (IOPT .EQ. 1) IY2 = IYCRIT
- IF (IOPT .EQ. 2) IY1 = IYCRIT-1
- IF (IOPT .EQ. 2) IY2 = 1
- END IF
- DO 520 IY=IY1,IY2,INCRY
- 130 IF (INCRX .GE. 0) THEN
- IF (IOPT .EQ. 1) IX1 = 1
- IF (IOPT .EQ. 1) IX2 = IXCRIT-1
- IF (IOPT .EQ. 2) IX1 = IXCRIT
- IF (IOPT .EQ. 2) IX2 = NX - 1
- ELSE
- IF (IOPT .EQ. 1) IX1 = NX - 1
- IF (IOPT .EQ. 1) IX2 = IXCRIT
- IF (IOPT .EQ. 2) IX1 = IXCRIT-1
- IF (IOPT .EQ. 2) IX2 = 1
- END IF
- DO 510 IX=IX1,IX2,INCRX
- NNOD = 0
- NTRIA = 0
- IREADY = 0
- DO 400 ISURF=1,NSURF
- FSURF = S(ISURF)
- IF (F(IX, IY, IZ) .GE. FSURF) GOTO 210
- IF (F(IX+1,IY, IZ) .GE. FSURF) GOTO 220
- IF (F(IX, IY+1,IZ) .GE. FSURF) GOTO 220
- IF (F(IX+1,IY+1,IZ) .GE. FSURF) GOTO 220
- IF (F(IX, IY, IZ+1) .GE. FSURF) GOTO 220
- IF (F(IX+1,IY, IZ+1) .GE. FSURF) GOTO 220
- IF (F(IX, IY+1,IZ+1) .GE. FSURF) GOTO 220
- IF (F(IX+1,IY+1,IZ+1) .GE. FSURF) GOTO 220
- GOTO 400
- 210 IF (F(IX+1,IY, IZ) .LT. FSURF) GOTO 220
- IF (F(IX, IY+1,IZ) .LT. FSURF) GOTO 220
- IF (F(IX+1,IY+1,IZ) .LT. FSURF) GOTO 220
- IF (F(IX, IY, IZ+1) .LT. FSURF) GOTO 220
- IF (F(IX+1,IY, IZ+1) .LT. FSURF) GOTO 220
- IF (F(IX, IY+1,IZ+1) .LT. FSURF) GOTO 220
- IF (F(IX+1,IY+1,IZ+1) .LT. FSURF) GOTO 220
- GOTO 400
-*
-** P R E P A R E C U B E ( P A R A L L E P I P E D )
-*
- 220 IF (IREADY .NE.0) GOTO 310
- IREADY = 1
- DO 300 I=1,8
- KX = IX + IND(1,I)
- KY = IY + IND(2,I)
- KZ = IZ + IND(3,I)
- P(1,I) = X(KX)
- P(2,I) = Y(KY)
- P(3,I) = Z(KZ)
- PF(I) = F(KX,KY,KZ)
-* F I N D X - G R A D I E N T
- IF (KX .EQ. 1) THEN
- PN(1,I) = (F(2,KY,KZ)-F(1,KY,KZ))/(X(2)-X(1))
- ELSE IF (KX .EQ. NX) THEN
- PN(1,I) = (F(KX,KY,KZ)-F(KX-1,KY,KZ))/(X(KX)-X(KX-1))
- ELSE
- D1 = X(KX) - X(KX-1)
- D2 = X(KX+1) - X(KX)
- IF (D1 .EQ. D2) THEN
- PN(1,I) = (F(KX+1,KY,KZ)-F(KX-1,KY,KZ))/(D1+D1)
- ELSE
- DF1 = F(KX,KY,KZ) - F(KX-1,KY,KZ)
- DF2 = F(KX+1,KY,KZ) - F(KX,KY,KZ)
- PN(1,I) = (DF1*D2*D2+DF2*D1*D1)/(D1*D2*D2+D2*D1*D1)
- END IF
- END IF
-* F I N D Y - G R A D I E N T
- IF (KY .EQ. 1) THEN
- PN(2,I) = (F(KX,2,KZ)-F(KX,1,KZ))/(Y(2)-Y(1))
- ELSE IF (KY .EQ. NY) THEN
- PN(2,I) = (F(KX,KY,KZ)-F(KX,KY-1,KZ))/(Y(KY)-Y(KY-1))
- ELSE
- D1 = Y(KY) - Y(KY-1)
- D2 = Y(KY+1) - Y(KY)
- IF (D1 .EQ. D2) THEN
- PN(2,I) = (F(KX,KY+1,KZ)-F(KX,KY-1,KZ))/(D1+D1)
- ELSE
- DF1 = F(KX,KY,KZ) - F(KX,KY-1,KZ)
- DF2 = F(KX,KY+1,KZ) - F(KX,KY,KZ)
- PN(2,I) = (DF1*D2*D2+DF2*D1*D1)/(D1*D2*D2+D2*D1*D1)
- END IF
- END IF
-* F I N D Z - G R A D I E N T
- IF (KZ .EQ. 1) THEN
- PN(3,I) = (F(KX,KY,2)-F(KX,KY,1))/(Z(2)-Z(1))
- ELSE IF (KZ .EQ. NZ) THEN
- PN(3,I) = (F(KX,KY,KZ)-F(KX,KY,KZ-1))/(Z(KZ)-Z(KZ-1))
- ELSE
- D1 = Z(KZ) - Z(KZ-1)
- D2 = Z(KZ+1) - Z(KZ)
- IF (D1 .EQ. D2) THEN
- PN(3,I) = (F(KX,KY,KZ+1)-F(KX,KY,KZ-1))/(D1+D1)
- ELSE
- DF1 = F(KX,KY,KZ) - F(KX,KY,KZ-1)
- DF2 = F(KX,KY,KZ+1) - F(KX,KY,KZ)
- PN(3,I) = (DF1*D2*D2+DF2*D1*D1)/(D1*D2*D2+D2*D1*D1)
- END IF
- END IF
- 300 CONTINUE
-*
-** F I N D S E T O F T R I A N G L E S
-*
- 310 CALL IHMCUB(S(ISURF),P,PF,PN,KNOD,KTRIA,
- & XYZ(1,NNOD+1),GRAD(1,NNOD+1),ITRIA(1,NTRIA+1))
- DO 330 I=NTRIA+1,NTRIA+KTRIA
- DO 320 J=1,3
- IBASE = NNOD
- IF (ITRIA(J,I) .LT. 0) IBASE =-NNOD
- ITRIA(J,I) = ITRIA(J,I) + IBASE
- 320 CONTINUE
- IATTR(I) = ISURF
- 330 CONTINUE
- NNOD = NNOD + KNOD
- NTRIA = NTRIA + KTRIA
- 400 CONTINUE
-*
-** D E P T H S O R T, D R A W I N G
-*
- IF (NTRIA .EQ. 0) GOTO 510
- DO 410 I=1,NNOD
- CALL IHWTON(XYZ(1,I),XYZN(1,I))
- CALL IHLUMI(GRAD(1,I),W)
- GRAD(1,I) = W
- 410 CONTINUE
- CALL IHZDEP(XYZN,NTRIA,ITRIA,DTRIA,ABCD,IORDER)
- IF (NTRIA .EQ. 0) GOTO 510
- INCR = 1
- IF (IOPT .EQ. 1) INCR =-1
- I1 = 1
- IF (INCR .EQ. -1) I1 = NTRIA
- I2 = NTRIA - I1 + 1
- DO 420 I=I1,I2,INCR
- K = IORDER(I)
- T(1) = GRAD(1,IABS(ITRIA(1,K)))
- T(2) = GRAD(1,IABS(ITRIA(2,K)))
- T(3) = GRAD(1,IABS(ITRIA(3,K)))
- ICODES(1) = IATTR(K)
- ICODES(2) = IATTR(K)
- ICODES(3) = IATTR(K)
- CALL DRFACE(ICODES,XYZ,3,ITRIA(1,K),T)
- 420 CONTINUE
- 510 CONTINUE
- INCRX =-INCRX
- IF (INCRX .LT. 0) GOTO 130
- 520 CONTINUE
- INCRY =-INCRY
- IF (INCRY .LT. 0) GOTO 120
- 530 CONTINUE
- INCRZ =-INCRZ
- IF (INCRZ .LT. 0) GOTO 110
- END
diff --git a/src/graflib/higz/ih/ihlegc.F b/src/graflib/higz/ih/ihlegc.F
deleted file mode 100644
index 77dfcc6..0000000
--- a/src/graflib/higz/ih/ihlegc.F
+++ /dev/null
@@ -1,162 +0,0 @@
-*
-* $Id: ihlegc.F,v 1.1.1.1 1996/02/14 13:10:50 mclareni Exp $
-*
-* $Log: ihlegc.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:50 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.18/00 20/04/93 14.20.33 by O.Couet
-*-- Author :
- SUBROUTINE IHLEGC(ANG,NX,NY,FUN,DRFACE,CHOPT)
-************************************************************************
-* *
-* IHLEGC Date: 17.09.90 *
-* Author: E. Chernyaev (IHEP/Protvino) Revised: 15.04.93 *
-* *
-* Function: Draw stack of lego-plots in cartesian coordinates *
-* *
-* References: IHWZN *
-* *
-* Input: ANG - angle between X ang Y *
-* NX - number of cells along X *
-* NY - number of cells along Y *
-* *
-* FUN(IX,IY,NV,XY,V,T) - external routine *
-* IX - X number of the cell *
-* IY - Y number of the cell *
-* NV - number of values for given cell *
-* XY(2,4)- coordinates of the cell corners *
-* V(NV) - cell values *
-* T(4,NV)- additional function (for example: temperature) *
-* *
-* DRFACE(ICODES,XYZ,NP,IFACE,T) - routine for face drawing *
-* ICODES(*) - set of codes for this line *
-* ICODES(1) - IX *
-* ICODES(2) - IY *
-* ICODES(3) - IV *
-* ICODES(4) - side: 1-face,2-right,3-back,4-left, *
-* 5-bottom, 6-top *
-* XYZ(3,*) - coordinates of nodes *
-* NP - number of nodes *
-* IFACE(NP) - face *
-* T(4) - additional function (here Z-coordinate) *
-* *
-* CHOPT - options: 'BF' - from BACK to FRONT *
-* 'FB' - from FRONT to BACK *
-* *
-************************************************************************
-#include "higz/hcscrn.inc"
-#include "higz/pnvmax.inc"
- REAL XY(2,4),XYZ(3,8),V(NVMAX),TT(4,NVMAX),TFACE(4)
- INTEGER ICODES(4),IFACE(4),IVIS(4)
- CHARACTER*(*) CHOPT
- EXTERNAL FUN,DRFACE
-*-
- RAD = ATAN(1.)*4./180.
- SINA = SIN(ANG*RAD)
- COSA = COS(ANG*RAD)
-*
-** F I N D T H E M O S T L E F T P O I N T
-*
- I1 = 1
- IF (TN(1,1) .LT. 0.) I1 = 2
- IF (TN(1,1)*COSA+TN(2,1)*SINA .LT. 0.) I1 = 5 - I1
-*
-** D E F I N E O R D E R O F D R A W I N G
-*
- IF (CHOPT(1:1).EQ.'B' .OR. CHOPT(1:1).EQ.'b') THEN
- INCRX =-1
- INCRY =-1
- ELSE
- INCRX =+1
- INCRY =+1
- END IF
- IF (I1.EQ.1 .OR. I1.EQ.2) INCRX =-INCRX
- IF (I1.EQ.2 .OR. I1.EQ.3) INCRY =-INCRY
- IX1 = 1
- IY1 = 1
- IF (INCRX .LT. 0) IX1 = NX
- IF (INCRY .LT. 0) IY1 = NY
- IX2 = NX - IX1 + 1
- IY2 = NY - IY1 + 1
-*
-** F I N D V I S I B I L I T Y O F S I D E S
-*
- IVIS(1) = 0
- IVIS(2) = 0
- IVIS(3) = 0
- IVIS(4) = 0
- CALL IHWZN(0.,1.,0.,ZN)
- IF (ZN .LT. 0.) IVIS(1) = 1
- IF (ZN .GT. 0.) IVIS(3) = 1
- CALL IHWZN(SINA,COSA,0.,ZN)
- IF (ZN .GT. 0.) IVIS(2) = 1
- IF (ZN .LT. 0.) IVIS(4) = 1
-*
-** D R A W S T A C K O F L E G O - P L O T S
-*
- DO 320 IY=IY1,IY2,INCRY
- DO 310 IX=IX1,IX2,INCRX
- CALL FUN(IX,IY,NV,XY,V,TT)
- IF (NV.LT.2 .OR. NV.GT.NVMAX) GOTO 310
- ICODES(1) = IX
- ICODES(2) = IY
- DO 110 I=1,4
- XYZ(1,I) = XY(1,I) + XY(2,I)*COSA
- XYZ(2,I) = XY(2,I)*SINA
- XYZ(1,I+4) = XYZ(1,I)
- XYZ(2,I+4) = XYZ(2,I)
- 110 CONTINUE
-* D R A W S T A C K
- DO 140 IV=1,NV-1
- DO 120 I=1,4
- XYZ(3,I) = V(IV)
- XYZ(3,I+4) = V(IV+1)
- 120 CONTINUE
- IF (V(IV) .EQ. V(IV+1)) GOTO 140
- ICODES(3) = IV
- DO 130 I=1,4
- IF (IVIS(I) .EQ. 0) GOTO 130
- K1 = I
- K2 = I + 1
- IF (I .EQ. 4) K2 = 1
- ICODES(4) = K1
- IFACE(1) = K1
- IFACE(2) = K2
- IFACE(3) = K2 + 4
- IFACE(4) = K1 + 4
- TFACE(1) = TT(K1,IV)
- TFACE(2) = TT(K2,IV)
- TFACE(3) = TT(K2,IV+1)
- TFACE(4) = TT(K1,IV+1)
- CALL DRFACE(ICODES,XYZ,4,IFACE,TFACE)
- 130 CONTINUE
- 140 CONTINUE
-* D R A W B O T T O M F A C E
- CALL IHWZN(0.,0.,1.,ZN)
- IF (ZN .LT. 0.) THEN
- ICODES(3) = 1
- ICODES(4) = 5
- DO 210 I=1,4
- XYZ(3,I) = V(1)
- IFACE(I) = 5 - I
- TFACE(I) = TT(5-I,1)
- 210 CONTINUE
- CALL DRFACE(ICODES,XYZ,4,IFACE,TFACE)
- END IF
-* D R A W T O P F A C E
- IF (ZN .GT. 0.) THEN
- ICODES(3) = NV - 1
- ICODES(4) = 6
- DO 220 I=1,4
- IFACE(I) = I + 4
- TFACE(I) = TT(I,NV)
- 220 CONTINUE
- CALL DRFACE(ICODES,XYZ,4,IFACE,TFACE)
- END IF
- 310 CONTINUE
- 320 CONTINUE
- RETURN
- END
diff --git a/src/graflib/higz/ih/ihlegp.F b/src/graflib/higz/ih/ihlegp.F
deleted file mode 100644
index f38e909..0000000
--- a/src/graflib/higz/ih/ihlegp.F
+++ /dev/null
@@ -1,195 +0,0 @@
-*
-* $Id: ihlegp.F,v 1.1.1.1 1996/02/14 13:10:50 mclareni Exp $
-*
-* $Log: ihlegp.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:50 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.18/01 04/05/93 14.11.01 by O.Couet
-*-- Author :
- SUBROUTINE IHLEGP(IORDR,NA,NB,FUN,DRFACE,CHOPT)
-************************************************************************
-* *
-* IHLEGP Date: 04.11.90 *
-* Author: E. Chernyaev (IHEP/Protvino) Revised: 03.03.93 *
-* *
-* Function: Draw stack of lego-plots in polar coordinates *
-* *
-* References: IHWPHI, IHWVR1, IHWVR2, IHWZN *
-* *
-* Input: IORDR - order of variables (0 - R,PHI; 1 - PHI,R) *
-* NA - number of steps along 1st variable *
-* NB - number of steps along 2nd variable *
-* *
-* FUN(IA,IB,NV,AB,V,TT) - external routine *
-* IA - cell number for 1st variable *
-* IB - cell number for 2nd variable *
-* NV - number of values for given cell *
-* AB(2,4) - coordinates of the cell corners *
-* V(NV) - cell values *
-* TT(4,*) - additional function *
-* *
-* DRFACE(ICODES,XYZ,NP,IFACE,T) - routine for face drawing *
-* ICODES(*) - set of codes for this face *
-* ICODES(1) - IA *
-* ICODES(2) - IB *
-* ICODES(3) - IV *
-* ICODES(4) - side: 1-internal,2-right,3-external,4-left*
-* 5-bottom, 6-top *
-* XYZ(3,*) - coordinates of nodes *
-* NP - number of nodes in face *
-* IFACE(NP) - face *
-* T(NP) - additional function *
-* *
-* CHOPT - options: 'BF' - from BACK to FRONT *
-* 'FB' - from FRONT to BACK *
-* *
-************************************************************************
-#include "higz/hcphi.inc"
-#include "higz/pnvmax.inc"
- REAL AB(2,4),XYZ(3,8),V(NVMAX),TT(4,NVMAX),TFACE(4)
- INTEGER ICODES(4),IFACE(4),IVIS(6)
- CHARACTER*(*) CHOPT
- EXTERNAL FUN,DRFACE
-*-
- IF (IORDR .EQ. 0) THEN
- JR = 1
- JPHI = 2
- NR = NA
- NPHI = NB
- ELSE
- JR = 2
- JPHI = 1
- NR = NB
- NPHI = NA
- END IF
- IF (NPHI .GT. NPMAX) GOTO 998
- RAD = ATAN(1.)*4./180.
- IOPT = 2
- IF (CHOPT(1:1).EQ.'B' .OR. CHOPT(1:1).EQ.'b') IOPT = 1
-*
-** P R E P A R E P H I A R R A Y
-** F I N D C R I T I C A L S E C T O R S
-*
- KPHI = NPHI
- IF (IORDR .EQ. 0) IA = NR
- IF (IORDR .NE. 0) IB = NR
- DO 10 I=1,NPHI
- IF (IORDR .EQ. 0) IB = I
- IF (IORDR .NE. 0) IA = I
- CALL FUN(IA,IB,NV,AB,V,TT)
- IF (I .EQ. 1) APHI(1) = AB(JPHI,1)
- APHI(I) = (APHI(I) + AB(JPHI,1))/2.
- APHI(I+1) = AB(JPHI,3)
- 10 CONTINUE
- CALL IHWPHI(IOPT,KPHI,APHI,IPHI1,IPHI2)
-*
-** E N C O D E V I S I B I L I T Y O F S I D E S
-** A N D O R D E R A L O N G R
-*
- DO 20 I=1,NPHI
- IF (IORDR .EQ. 0) IB = I
- IF (IORDR .NE. 0) IA = I
- CALL FUN(IA,IB,NV,AB,V,TT)
- CALL IHWVR1(IOPT,AB(JPHI,1)*RAD,AB(JPHI,3)*RAD,APHI(I))
- 20 CONTINUE
-*
-** D R A W S T A C K O F L E G O - P L O T S
-*
- INCR = 1
- IPHI = IPHI1
- 100 IF (IPHI .GT. NPHI) GOTO 300
-* D E C O D E V I S I B I L I T Y O F S I D E S
- CALL IHWVR2(APHI(IPHI),
- & IVIS(1),IVIS(2),IVIS(3),IVIS(4),IVIS(5),IVIS(6),INCRR)
- IR1 = 1
- IF (INCRR .LT. 0) IR1 = NR
- IR2 = NR - IR1 + 1
-* D R A W L E G O S F O R S E C T O R
- DO 290 IR=IR1,IR2,INCRR
- IF (IORDR .EQ. 0) THEN
- IA = IR
- IB = IPHI
- ELSE
- IA = IPHI
- IB = IR
- END IF
- CALL FUN(IA,IB,NV,AB,V,TT)
- IF (NV.LT.2 .OR. NV.GT.NVMAX) GOTO 290
- ICODES(1) = IA
- ICODES(2) = IB
- DO 210 I=1,4
- J = I
- IF (IORDR.NE.0 .AND. I.EQ.2) J = 4
- IF (IORDR.NE.0 .AND. I.EQ.4) J = 2
- XYZ(1,J) = AB(JR,I)*COS(AB(JPHI,I)*RAD)
- XYZ(2,J) = AB(JR,I)*SIN(AB(JPHI,I)*RAD)
- XYZ(1,J+4) = XYZ(1,J)
- XYZ(2,J+4) = XYZ(2,J)
- 210 CONTINUE
-* D R A W S T A C K
- DO 240 IV=1,NV-1
- DO 220 I=1,4
- XYZ(3,I) = V(IV)
- XYZ(3,I+4) = V(IV+1)
- 220 CONTINUE
- IF (V(IV) .GE. V(IV+1)) GOTO 240
- ICODES(3) = IV
- DO 230 I=1,4
- IF (IVIS(I) .EQ. 0) GOTO 230
- K1 = I-1
- IF (I .EQ. 1) K1 = 4
- K2 = I
- IF (XYZ(1,K1).EQ.XYZ(1,K2) .AND.
- & XYZ(2,K1).EQ.XYZ(2,K2)) GOTO 230
- IFACE(1) = K1
- IFACE(2) = K2
- IFACE(3) = K2 + 4
- IFACE(4) = K1 + 4
- TFACE(1) = TT(K1,IV)
- TFACE(2) = TT(K2,IV)
- TFACE(3) = TT(K2,IV+1)
- TFACE(4) = TT(K1,IV+1)
- ICODES(4)= I
- CALL DRFACE(ICODES,XYZ,4,IFACE,TFACE)
- 230 CONTINUE
- 240 CONTINUE
-* D R A W B O T T O M F A C E
- IF (IVIS(5) .NE. 0) THEN
- ICODES(3) = 1
- ICODES(4) = 5
- DO 250 I=1,4
- XYZ(3,I) = V(1)
- IFACE(I) = 5 - I
- TFACE(I) = TT(5-I,1)
- 250 CONTINUE
- CALL DRFACE(ICODES,XYZ,4,IFACE,TFACE)
- END IF
-* D R A W T O P F A C E
- IF (IVIS(6) .NE. 0) THEN
- ICODES(3) = NV - 1
- ICODES(4) = 6
- DO 260 I=1,4
- IFACE(I) = I + 4
- TFACE(I) = TT(I,NV)
- 260 CONTINUE
- CALL DRFACE(ICODES,XYZ,4,IFACE,TFACE)
- END IF
- 290 CONTINUE
-* N E X T P H I
- 300 IPHI = IPHI + INCR
- IF (IPHI .EQ. 0) IPHI = KPHI
- IF (IPHI .GT. KPHI) IPHI = 1
- IF (IPHI .NE. IPHI2) GOTO 100
- IF (INCR) 310,999,320
- 310 INCR = 0
- GOTO 100
- 320 INCR =-1
- IPHI = IPHI1
- GOTO 300
-*
- 998 WRITE(*,*) 'IHLEGP: too many PHI sectors'
- 999 RETURN
- END
diff --git a/src/graflib/higz/ih/ihlegr.F b/src/graflib/higz/ih/ihlegr.F
deleted file mode 100644
index d6a29a3..0000000
--- a/src/graflib/higz/ih/ihlegr.F
+++ /dev/null
@@ -1,204 +0,0 @@
-*
-* $Id: ihlegr.F,v 1.1.1.1 1996/02/14 13:10:50 mclareni Exp $
-*
-* $Log: ihlegr.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:50 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.18/05 27/05/93 09.28.13 by O.Couet
-*-- Author :
- SUBROUTINE IHLEGR(IORDR,NA,NB,FUN,DRFACE,CHOPT)
-************************************************************************
-* *
-* IHLEGR Date: 04.11.90 *
-* Author: E. Chernyaev (IHEP/Protvino) Revised: 31.03.93 *
-* *
-* Function: Draw stack of lego-plots in cylindrical coordinates *
-* *
-* References: IHWPHI, IHWVR1, IHWVR2, IHWZN *
-* *
-* Input: IORDR - order of variables (0 - Z,PHI; 1 - PHI,Z) *
-* NA - number of steps along 1st variable *
-* NPHI - number of steps along 2nd variable *
-* *
-* FUN(IA,IB,NV,AB,V,TT) - external routine *
-* IA - cell number for 1st variable *
-* IB - cell number for 2nd variable *
-* NV - number of values for given cell *
-* AB(2,4) - coordinates of the cell corners *
-* V(NV) - cell values *
-* TT(4,*) - additional function *
-* *
-* DRFACE(ICODES,XYZ,NP,IFACE,T) - routine for face drawing *
-* ICODES(*) - set of codes for this face *
-* ICODES(1) - IA *
-* ICODES(2) - IB *
-* ICODES(3) - IV *
-* ICODES(4) - side: 1,2,3,4 - ordinary sides *
-* 5-bottom,6-top *
-* XYZ(3,*) - coordinates of nodes *
-* NP - number of nodes in face *
-* IFACE(NP) - face *
-* T(NP) - additional function *
-* *
-* CHOPT - options: 'BF' - from BACK to FRONT *
-* 'FB' - from FRONT to BACK *
-* *
-************************************************************************
-#include "higz/hcphi.inc"
-#include "higz/pnvmax.inc"
- REAL AB(2,4),XYZ(3,8),V(NVMAX),TT(4,NVMAX),TFACE(4)
- REAL COSPHI(4),SINPHI(4)
- INTEGER ICODES(4),IFACE(4),IVIS(6)
- CHARACTER*(*) CHOPT
- EXTERNAL FUN,DRFACE
-*-
- IF (IORDR .EQ. 0) THEN
- JZ = 1
- JPHI = 2
- NZ = NA
- NPHI = NB
- ELSE
- JZ = 2
- JPHI = 1
- NZ = NB
- NPHI = NA
- END IF
- IF (NPHI .GT. NPMAX) GOTO 998
- RAD = ATAN(1.)*4./180.
- IOPT = 2
- IF (CHOPT(1:1).EQ.'B' .OR. CHOPT(1:1).EQ.'b') IOPT = 1
-*
-** P R E P A R E P H I A R R A Y
-** F I N D C R I T I C A L S E C T O R S
-*
- KPHI = NPHI
- IF (IORDR .EQ. 0) IA = NZ
- IF (IORDR .NE. 0) IB = NZ
- DO 10 I=1,NPHI
- IF (IORDR .EQ. 0) IB = I
- IF (IORDR .NE. 0) IA = I
- CALL FUN(IA,IB,NV,AB,V,TT)
- IF (I .EQ. 1) APHI(1) = AB(JPHI,1)
- APHI(I) = (APHI(I) + AB(JPHI,1))/2.
- APHI(I+1) = AB(JPHI,3)
- 10 CONTINUE
- CALL IHWPHI(IOPT,KPHI,APHI,IPHI1,IPHI2)
-*
-** E N C O D E V I S I B I L I T Y O F S I D E S
-** A N D O R D E R A L O N G R
-*
- DO 20 I=1,NPHI
- IF (IORDR .EQ. 0) IB = I
- IF (IORDR .NE. 0) IA = I
- CALL FUN(IA,IB,NV,AB,V,TT)
- CALL IHWVR1(IOPT,AB(JPHI,1)*RAD,AB(JPHI,3)*RAD,APHI(I))
- 20 CONTINUE
-*
-** F I N D O R D E R A L O N G Z
-*
- INCRZ = 1
- IZ1 = 1
- CALL IHWZN(0.,0.,1.,Z)
- IF ((Z.LE.0. .AND. IOPT.EQ.1) .OR. (Z.GT.0. .AND. IOPT.EQ.2)) THEN
- INCRZ =-1
- IZ1 = NZ
- END IF
- IZ2 = NZ - IZ1 + 1
-*
-** D R A W S T A C K O F L E G O - P L O T S
-*
- INCR = 1
- IPHI = IPHI1
- 100 IF (IPHI .GT. NPHI) GOTO 400
-* D E C O D E V I S I B I L I T Y O F S I D E S
- CALL IHWVR2(APHI(IPHI),
- & IVIS(5),IVIS(2),IVIS(6),IVIS(4),IVIS(1),IVIS(3),IDUMMY)
- DO 300 IZ=IZ1,IZ2,INCRZ
- IF (IORDR .EQ. 0) THEN
- IA = IZ
- IB = IPHI
- ELSE
- IA = IPHI
- IB = IZ
- END IF
- CALL FUN(IA,IB,NV,AB,V,TT)
- IF (NV.LT.2 .OR. NV.GT.NVMAX) GOTO 300
- ICODES(1) = IA
- ICODES(2) = IB
- DO 210 I=1,4
- J = I
- IF (IORDR.NE.0 .AND. I.EQ.2) J = 4
- IF (IORDR.NE.0 .AND. I.EQ.4) J = 2
- COSPHI(J) = COS(AB(JPHI,I)*RAD)
- SINPHI(J) = SIN(AB(JPHI,I)*RAD)
- XYZ(3,J) = AB(JZ,I)
- XYZ(3,J+4) = AB(JZ,I)
- 210 CONTINUE
-* D R A W S T A C K
- DO 240 IV=1,NV-1
- DO 220 I=1,4
- XYZ(1,I) = V(IV)*COSPHI(I)
- XYZ(2,I) = V(IV)*SINPHI(I)
- XYZ(1,I+4) = V(IV+1)*COSPHI(I)
- XYZ(2,I+4) = V(IV+1)*SINPHI(I)
- 220 CONTINUE
- IF (V(IV) .GE. V(IV+1)) GOTO 240
- ICODES(3) = IV
- DO 230 I=1,4
- IF (IVIS(I) .EQ. 0) GOTO 230
- K1 = I
- K2 = I - 1
- IF (I .EQ. 1) K2 = 4
- IFACE(1) = K1
- IFACE(2) = K2
- IFACE(3) = K2 + 4
- IFACE(4) = K1 + 4
- TFACE(1) = TT(K1,IV)
- TFACE(2) = TT(K2,IV)
- TFACE(3) = TT(K2,IV+1)
- TFACE(4) = TT(K1,IV+1)
- ICODES(4) = I
- CALL DRFACE(ICODES,XYZ,4,IFACE,TFACE)
- 230 CONTINUE
- 240 CONTINUE
-* D R A W B O T T O M F A C E
- IF (IVIS(5).NE.0 .AND. V(1).GT.0.) THEN
- ICODES(3) = 1
- ICODES(4) = 5
- DO 250 I=1,4
- XYZ(1,I) = V(1)*COSPHI(I)
- XYZ(2,I) = V(1)*SINPHI(I)
- IFACE(I) = I
- TFACE(I) = TT(I,1)
- 250 CONTINUE
- CALL DRFACE(ICODES,XYZ,4,IFACE,TFACE)
- END IF
-* D R A W T O P F A C E
- IF (IVIS(6).NE.0 .AND. V(NV).GT.0.) THEN
- ICODES(3) = NV - 1
- ICODES(4) = 6
- DO 260 I=1,4
- IFACE(I) = 5 - I + 4
- TFACE(I) = TT(5-I,NV)
- 260 CONTINUE
- CALL DRFACE(ICODES,XYZ,4,IFACE,TFACE)
- END IF
- 300 CONTINUE
-* N E X T P H I
- 400 IPHI = IPHI + INCR
- IF (IPHI .EQ. 0) IPHI = KPHI
- IF (IPHI .GT. KPHI) IPHI = 1
- IF (IPHI .NE. IPHI2) GOTO 100
- IF (INCR) 410,999,420
- 410 INCR = 0
- GOTO 100
- 420 INCR =-1
- IPHI = IPHI1
- GOTO 400
-*
- 998 WRITE(*,*) 'IHLEGR: too many PHI sectors'
- 999 RETURN
- END
diff --git a/src/graflib/higz/ih/ihlegs.F b/src/graflib/higz/ih/ihlegs.F
deleted file mode 100644
index f1628ac..0000000
--- a/src/graflib/higz/ih/ihlegs.F
+++ /dev/null
@@ -1,262 +0,0 @@
-*
-* $Id: ihlegs.F,v 1.1.1.1 1996/02/14 13:10:50 mclareni Exp $
-*
-* $Log: ihlegs.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:50 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.18/01 04/05/93 14.11.01 by O.Couet
-*-- Author :
- SUBROUTINE IHLEGS(IPSDR,IORDR,NA,NB,FUN,DRFACE,CHOPT)
-************************************************************************
-* *
-* IHLEGS Date: 11.11.90 *
-* Author: E. Chernyaev (IHEP/Protvino) Revised: 13.04.93 *
-* *
-* Function: Draw stack of lego-plots spheric coordinates *
-* *
-* References: IHWPHI, IHWTH, IHWZN *
-* *
-* Input: IPSDR - pseudo-rapidity flag *
-* IORDR - order of variables (0 - THETA,PHI; 1 - PHI,THETA) *
-* NA - number of steps along 1st variable *
-* NB - number of steps along 2nd variable *
-* *
-* FUN(IA,IB,NV,AB,V,TT) - external routine *
-* IA - cell number for 1st variable *
-* IB - cell number for 2nd variable *
-* NV - number of values for given cell *
-* AB(2,4) - coordinates of the cell corners *
-* V(NV) - cell values *
-* TT(4,*) - additional function *
-* *
-* DRFACE(ICODES,XYZ,NP,IFACE,T) - routine for face drawing *
-* ICODES(*) - set of codes for this face *
-* ICODES(1) - IA *
-* ICODES(2) - IB *
-* ICODES(3) - IV *
-* ICODES(4) - side: 1,2,3,4 - ordinary sides *
-* 5-bottom,6-top *
-* XYZ(3,*) - coordinates of nodes *
-* NP - number of nodes in face *
-* IFACE(NP) - face *
-* T(NP) - additional function *
-* *
-* CHOPT - options: 'BF' - from BACK to FRONT *
-* 'FB' - from FRONT to BACK *
-* *
-************************************************************************
-#include "higz/hcphi.inc"
-#include "higz/pnvmax.inc"
- REAL AB(2,4),XYZ(3,8),V(NVMAX)
- REAL TT(4,NVMAX),TFACE(4)
- REAL COSTH(4),SINTH(4),COSPHI(4),SINPHI(4)
- INTEGER ICODES(4),IFACE(4),IVIS(6)
- CHARACTER*(*) CHOPT
- EXTERNAL FUN,DRFACE
-*-
- IF (IORDR .EQ. 0) THEN
- JTH = 1
- JPHI = 2
- NTH = NA
- NPHI = NB
- ELSE
- JTH = 2
- JPHI = 1
- NTH = NB
- NPHI = NA
- END IF
- IF (NTH .GT. NPMAX) GOTO 997
- IF (NPHI .GT. NPMAX) GOTO 998
- RAD = ATAN(1.)*4./180.
- IOPT = 2
- IF (CHOPT(1:1).EQ.'B' .OR. CHOPT(1:1).EQ.'b') IOPT = 1
-*
-** P R E P A R E P H I A R R A Y
-** F I N D C R I T I C A L P H I S E C T O R S
-*
- KPHI = NPHI
- MTH = NTH/2
- IF (MTH .EQ. 0) MTH = 1
- IF (IORDR .EQ. 0) IA = MTH
- IF (IORDR .NE. 0) IB = MTH
- DO 10 I=1,NPHI
- IF (IORDR .EQ. 0) IB = I
- IF (IORDR .NE. 0) IA = I
- CALL FUN(IA,IB,NV,AB,V,TT)
- IF (I .EQ. 1) APHI(1) = AB(JPHI,1)
- APHI(I) = (APHI(I) + AB(JPHI,1))/2.
- APHI(I+1) = AB(JPHI,3)
- 10 CONTINUE
- CALL IHWPHI(IOPT,KPHI,APHI,IPHI1,IPHI2)
-*
-** P R E P A R E T H E T A A R R A Y
-*
- IF (IORDR .EQ. 0) IB = 1
- IF (IORDR .NE. 0) IA = 1
- DO 20 I=1,NTH
- IF (IORDR .EQ. 0) IA = I
- IF (IORDR .NE. 0) IB = I
- CALL FUN(IA,IB,NV,AB,V,TT)
- IF (I .EQ. 1) APHI(1) = AB(JTH,1)
- APHI(I) = (APHI(I) + AB(JTH,1))/2.
- APHI(I+1) = AB(JTH,3)
- 20 CONTINUE
-*
-** D R A W S T A C K O F L E G O - P L O T S
-*
- KTH = NTH
- INCR = 1
- IPHI = IPHI1
- 100 IF (IPHI .GT. NPHI) GOTO 500
-* F I N D C R I T I C A L T H E T A S E C T O R S
- IF (IORDR .EQ. 0) THEN
- IA = MTH
- IB = IPHI
- ELSE
- IA = IPHI
- IB = MTH
- END IF
- CALL FUN(IA,IB,NV,AB,V,TT)
- PHI = (AB(JPHI,1) + AB(JPHI,3)) / 2.
- CALL IHWTH(IOPT,PHI,KTH,APHI,ITH1,ITH2)
- INCRTH = 1
- ITH = ITH1
- 200 IF (ITH .GT. NTH) GOTO 400
- IF (IORDR .EQ. 0) IA = ITH
- IF (IORDR .NE. 0) IB = ITH
- CALL FUN(IA,IB,NV,AB,V,TT)
- IF (NV.LT.2 .OR. NV.GT.NVMAX) GOTO 400
-* D E F I N E V I S I B I L I T Y O F S I D E S
- DO 300 I=1,6
- IVIS(I) = 0
- 300 CONTINUE
- PHI1 = RAD * AB(JPHI,1)
- PHI2 = RAD * AB(JPHI,3)
- TH1 = RAD * AB(JTH,1)
- TH2 = RAD * AB(JTH,3)
- CALL IHWZN(SIN(PHI1),-COS(PHI1),0.,ZN)
- IF (ZN .GT. 0.) IVIS(2) = 1
- CALL IHWZN(-SIN(PHI2),COS(PHI2),0.,ZN)
- IF (ZN .GT. 0.) IVIS(4) = 1
- PHI = (PHI1 + PHI2) / 2.
- CALL IHWZN(-COS(PHI)*COS(TH1),-SIN(PHI)*COS(TH1),SIN(TH1),ZN)
- IF (ZN .GT. 0.) IVIS(1) = 1
- CALL IHWZN(COS(PHI)*COS(TH2),SIN(PHI)*COS(TH2),-SIN(TH2),ZN)
- IF (ZN .GT. 0.) IVIS(3) = 1
- TH = (TH1 + TH2) / 2.
- IF (IPSDR .EQ. 1) TH = RAD * 90.
- CALL IHWZN(COS(PHI)*SIN(TH),SIN(PHI)*SIN(TH),COS(TH),ZN)
- IF (ZN .LT. 0.) IVIS(5) = 1
- IF (ZN .GT. 0.) IVIS(6) = 1
-* D R A W S T A C K
- ICODES(1) = IA
- ICODES(2) = IB
- DO 310 I=1,4
- J = I
- IF (IORDR.NE.0 .AND. I.EQ.2) J = 4
- IF (IORDR.NE.0 .AND. I.EQ.4) J = 2
- COSTH(J) = COS(RAD*AB(JTH,I))
- SINTH(J) = SIN(RAD*AB(JTH,I))
- COSPHI(J) = COS(RAD*AB(JPHI,I))
- SINPHI(J) = SIN(RAD*AB(JPHI,I))
- 310 CONTINUE
- DO 350 IV=1,NV-1
- IF (IPSDR .EQ. 1) THEN
- DO 320 I=1,4
- XYZ(1,I) = V(IV) * COSPHI(I)
- XYZ(2,I) = V(IV) * SINPHI(I)
- XYZ(3,I) = V(IV) * COSTH(I) / SINTH(I)
- XYZ(1,I+4) = V(IV+1) * COSPHI(I)
- XYZ(2,I+4) = V(IV+1) * SINPHI(I)
- XYZ(3,I+4) = V(IV+1) * COSTH(I) / SINTH(I)
- 320 CONTINUE
- ELSE
- DO 330 I=1,4
- XYZ(1,I) = V(IV) * SINTH(I) * COSPHI(I)
- XYZ(2,I) = V(IV) * SINTH(I) * SINPHI(I)
- XYZ(3,I) = V(IV) * COSTH(I)
- XYZ(1,I+4) = V(IV+1) * SINTH(I) * COSPHI(I)
- XYZ(2,I+4) = V(IV+1) * SINTH(I) * SINPHI(I)
- XYZ(3,I+4) = V(IV+1) * COSTH(I)
- 330 CONTINUE
- END IF
- IF (V(IV) .GE. V(IV+1)) GOTO 350
- ICODES(3) = IV
- DO 340 I=1,4
- IF (IVIS(I) .EQ. 0) GOTO 340
- K1 = I - 1
- IF (I .EQ. 1) K1 = 4
- K2 = I
- IFACE(1) = K1
- IFACE(2) = K2
- IFACE(3) = K2 + 4
- IFACE(4) = K1 + 4
- TFACE(1) = TT(K1,IV)
- TFACE(2) = TT(K2,IV)
- TFACE(3) = TT(K2,IV+1)
- TFACE(4) = TT(K1,IV+1)
- ICODES(4) = I
- CALL DRFACE(ICODES,XYZ,4,IFACE,TFACE)
- 340 CONTINUE
- 350 CONTINUE
-* D R A W B O T T O M F A C E
- IF (IVIS(5).NE.0 .AND. V(1).GT.0.) THEN
- ICODES(3) = 1
- ICODES(4) = 5
- DO 360 I=1,4
- IF (IPSDR .EQ. 1) THEN
- XYZ(1,I) = V(1) * COSPHI(I)
- XYZ(2,I) = V(1) * SINPHI(I)
- XYZ(3,I) = V(1) * COSTH(I) / SINTH(I)
- ELSE
- XYZ(1,I) = V(1) * SINTH(I) * COSPHI(I)
- XYZ(2,I) = V(1) * SINTH(I) * SINPHI(I)
- XYZ(3,I) = V(1) * COSTH(I)
- ENDIF
- IFACE(I) = 5 - I
- TFACE(I) = TT(5-I,1)
- 360 CONTINUE
- CALL DRFACE(ICODES,XYZ,4,IFACE,TFACE)
- END IF
-* D R A W T O P F A C E
- IF (IVIS(6).NE.0 .AND. V(NV).GT.0.) THEN
- ICODES(3) = NV - 1
- ICODES(4) = 6
- DO 370 I=1,4
- IFACE(I) = I+4
- TFACE(I) = TT(I+4,NV)
- 370 CONTINUE
- CALL DRFACE(ICODES,XYZ,4,IFACE,TFACE)
- END IF
-* N E X T T H E T A
- 400 ITH = ITH + INCRTH
- IF (ITH .EQ. 0) ITH = KTH
- IF (ITH .GT. KTH) ITH = 1
- IF (ITH .NE. ITH2) GOTO 200
- IF (INCRTH) 410,500,420
- 410 INCRTH = 0
- GOTO 200
- 420 INCRTH =-1
- ITH = ITH1
- GOTO 400
-* N E X T P H I
- 500 IPHI = IPHI + INCR
- IF (IPHI .EQ. 0) IPHI = KPHI
- IF (IPHI .GT. KPHI) IPHI = 1
- IF (IPHI .NE. IPHI2) GOTO 100
- IF (INCR) 510,999,520
- 510 INCR = 0
- GOTO 100
- 520 INCR =-1
- IPHI = IPHI1
- GOTO 500
-*
- 997 WRITE(*,*) 'IHLEGS: too many THETA sectors'
- GOTO 999
- 998 WRITE(*,*) 'IHLEGS: too many PHI sectors'
- GOTO 999
- 999 RETURN
- END
diff --git a/src/graflib/higz/ih/ihligh.F b/src/graflib/higz/ih/ihligh.F
deleted file mode 100644
index b2d7236..0000000
--- a/src/graflib/higz/ih/ihligh.F
+++ /dev/null
@@ -1,77 +0,0 @@
-*
-* $Id: ihligh.F,v 1.1.1.1 1996/02/14 13:10:50 mclareni Exp $
-*
-* $Log: ihligh.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:50 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.13/09 14/01/92 14.01.24 by O.Couet
-*-- Author :
- SUBROUTINE IHLIGH(NL,YL,XSCR,YSCR,ZSCR,IREP)
-************************************************************************
-* *
-* IHLIGH Date: 11.10.91 *
-* Author: E. Chernyaev (IHEP/Protvino) Revised: *
-* *
-* Function: Set light source *
-* *
-* Input: NL - source number: -1 off all light sources *
-* 0 set diffused light *
-* YL - intensity of the light source *
-* XSCR \ *
-* YSCR - direction of the light (in respect of the screen) *
-* ZSCR / *
-* *
-* Output: IREP - reply : 0 - O.K. *
-* -1 - error in light sources definition: *
-* negative intensity *
-* source number greater than max *
-* light source is placed at origin *
-* *
-************************************************************************
-#include "higz/hcligh.inc"
-*-
- IREP = 0
- IF (NL) 100,200,300
-** S W I T C H O F F L I G H T S
- 100 LOFF = 1
- YDL = 0.
- DO 110 I=1,LLIGHT
- YLS(I) = 0.
- 110 CONTINUE
- GOTO 999
-** S E T D I F F U S E D L I G H T
- 200 IF (YL .LT. 0.) GOTO 996
- YDL = YL
- GOTO 400
-** S E T L I G H T S O U R C E
- 300 IF (NL .GT. LLIGHT) GOTO 997
- IF (YL .LT. 0.) GOTO 997
- S = SQRT(XSCR*XSCR+YSCR*YSCR+ZSCR*ZSCR)
- IF (S .EQ. 0.) GOTO 998
- YLS(NL) = YL
- VLS(1,NL) = XSCR/S
- VLS(2,NL) = YSCR/S
- VLS(3,NL) = ZSCR/S
-* C H E C K L I G H T S
- 400 LOFF = 0
- IF (YDL .NE. 0) GOTO 999
- DO 410 I=1,LLIGHT
- IF (YLS(I) .NE. 0.) GOTO 999
- 410 CONTINUE
- LOFF = 1
- GOTO 999
-*
- 996 WRITE(*,*) 'IHLIGH: negative light intensity'
- IREP =-1
- GOTO 999
- 997 WRITE(*,*) 'IHLIGH: illegal light source number'
- IREP =-1
- GOTO 999
- 998 WRITE(*,*) 'IHLIGH: light source is placed at origin'
- IREP =-1
- GOTO 999
- 999 RETURN
- END
diff --git a/src/graflib/higz/ih/ihlumi.F b/src/graflib/higz/ih/ihlumi.F
deleted file mode 100644
index 6e7c1ac..0000000
--- a/src/graflib/higz/ih/ihlumi.F
+++ /dev/null
@@ -1,85 +0,0 @@
-*
-* $Id: ihlumi.F,v 1.3 1996/09/25 15:02:14 couet Exp $
-*
-* $Log: ihlumi.F,v $
-* Revision 1.3 1996/09/25 15:02:14 couet
-* *** empty log message ***
-*
-* Revision 1.2 1996/09/25 14:58:22 couet
-* - Protection added to prevent division by 0
-*
-* Revision 1.1.1.1 1996/02/14 13:10:50 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.13/09 17/01/92 11.37.23 by O.Couet
-*-- Author :
- SUBROUTINE IHLUMI(ANORM,FLUM)
-************************************************************************
-* *
-* IHLUMI Date: 11.10.91 *
-* Author: E. Chernyaev (IHEP/Protvino) Revised: *
-* *
-* Function: Find surface luminosity at given point *
-* *
-* -- *
-* Lightness model formula: Y = YD*QA + > YLi*(QD*cosNi+QS*cosRi) *
-* -- *
-* *
-* B1 = VN(3)*VL(2) - VN(2)*VL(3) *
-* B2 = VN(1)*VL(3) - VN(3)*VL(1) *
-* B3 = VN(2)*VL(1) - VN(1)*VL(2) *
-* B4 = VN(1)*VL(1) + VN(2)*VL(2) + VN(3)*VL(3) *
-* VR(1) = VN(3)*B2 - VN(2)*B3 + VN(1)*B4 *
-* VR(2) =-VN(3)*B1 + VN(1)*B3 + VN(2)*B4 *
-* VR(3) = VN(2)*B1 - VN(1)*B2 + VN(3)*B4 *
-* S = SQRT(VR(1)*VR(1)+VR(2)*VR(2)+VR(3)*VR(3)) *
-* VR(1) = VR(1)/S *
-* VR(2) = VR(2)/S *
-* VR(3) = VR(3)/S *
-* COSR = VR(1)*0. + VR(2)*0. + VR(3)*1. *
-* *
-* References: IHWTON *
-* *
-* Input: ANORM(3) - surface normal at given point *
-* *
-* Output: FLUM - luminosity *
-* *
-************************************************************************
-#include "higz/hcligh.inc"
- REAL ANORM(3),VN(3),VL(3)
-*-
- FLUM = 0.
- IF (LOFF .NE. 0) RETURN
-*
-** T R A N S F E R N O R M A L T O SCREEN COORDINATES
-*
- CALL IHWWNN(ANORM,VN)
- S = SQRT(VN(1)*VN(1)+VN(2)*VN(2)+VN(3)*VN(3))
- IF (VN(3) .LT. 0.) S =-S
- IF (S.NE.0.) THEN
- VN(1) = VN(1)/S
- VN(2) = VN(2)/S
- VN(3) = VN(3)/S
- ELSE
- RETURN
- ENDIF
-*
-** F I N D L U M I N O S I T Y
-*
- FLUM = YDL*QA
- DO 100 I=1,LLIGHT
- IF (YLS(I) .LE. 0.) GOTO 100
- VL(1) = VLS(1,I)
- VL(2) = VLS(2,I)
- VL(3) = VLS(3,I)
- COSN = VL(1)*VN(1) + VL(2)*VN(2) + VL(3)*VN(3)
- IF (COSN .LT. 0.) GOTO 100
- COSR = VN(2)*(VN(3)*VL(2)-VN(2)*VL(3))
- & -VN(1)*(VN(1)*VL(3)-VN(3)*VL(1)) + VN(3)*COSN
- IF (COSR .LE. 0.) COSR = 0.
- FLUM = FLUM + YLS(I)*(QD*COSN + QS*COSR**NQS)
- 100 CONTINUE
-*
- END
diff --git a/src/graflib/higz/ih/ihmc00.F b/src/graflib/higz/ih/ihmc00.F
deleted file mode 100644
index a3dbdc0..0000000
--- a/src/graflib/higz/ih/ihmc00.F
+++ /dev/null
@@ -1,51 +0,0 @@
-*
-* $Id: ihmc00.F,v 1.1.1.1 1996/02/14 13:10:50 mclareni Exp $
-*
-* $Log: ihmc00.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:50 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.19/06 27/08/93 13.53.33 by O.Couet
-*-- Author :
- SUBROUTINE IHMC00(K1,K2,K3,K4,K5,K6,NNOD,NTRIA,XYZ,GRAD,ITRIA)
-************************************************************************
-* *
-* IHMC00 Date: 20.07.93 *
-* Author: E. Chernyaev (IHEP/Protvino) Revised: *
-* *
-* Function: Consideration of trivial cases: 1,2,5,8,9,11,14 *
-* *
-* Input: K1,...,K6 - edges intersected with isosurface *
-* *
-* Output: the same as for IHMCUB *
-* *
-************************************************************************
- REAL XYZ(3,*),GRAD(3,*)
- INTEGER ITRIA(3,*),IE(6),IT(3,4,4)
- DATA IT/1,2,3, 0,0,0, 0,0,0, 0,0,0,
- & 1,2,-3, -1,3,4, 0,0,0, 0,0,0,
- & 1,2,-3, -1,3,-4, -1,4,5, 0,0,0,
- & 1,2,-3, -1,3,-4, -4,6,-1, 4,5,-6/
-*-
-** S E T N O D E S & N O R M A L E S
-*
- IE(1) = K1
- IE(2) = K2
- IE(3) = K3
- IE(4) = K4
- IE(5) = K5
- IE(6) = K6
- NNOD = 6
- IF (IE(6) .EQ. 0) NNOD = 5
- IF (IE(5) .EQ. 0) NNOD = 4
- IF (IE(4) .EQ. 0) NNOD = 3
- CALL IHMCPP(NNOD,IE,XYZ,GRAD)
-*
-** S E T T R I A N G L E S
-*
- NTRIA = NNOD - 2
- CALL IHMCTT(NTRIA,IT(1,1,NTRIA),ITRIA)
- RETURN
- END
diff --git a/src/graflib/higz/ih/ihmc03.F b/src/graflib/higz/ih/ihmc03.F
deleted file mode 100644
index a1055e2..0000000
--- a/src/graflib/higz/ih/ihmc03.F
+++ /dev/null
@@ -1,53 +0,0 @@
-*
-* $Id: ihmc03.F,v 1.1.1.1 1996/02/14 13:10:50 mclareni Exp $
-*
-* $Log: ihmc03.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:50 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.19/05 26/08/93 09.50.26 by O.Couet
-*-- Author :
- SUBROUTINE IHMC03(NNOD,NTRIA,XYZ,GRAD,ITRIA)
-************************************************************************
-* *
-* IHMC03 Date: 10.08.93 *
-* Author: E. Chernyaev (IHEP/Protvino) Revised: *
-* *
-* Function: Consider case No 3 *
-* *
-* Input: see common HCMCUB *
-* *
-* Output: the same as for IHMCUB *
-* *
-************************************************************************
-#include "higz/hcmcub.inc"
- REAL XYZ(3,*),GRAD(3,*)
- INTEGER ITRIA(3,*),IE(6),IT1(3,2),IT2(3,4)
- DATA IE/4,9,1, 2,11,3/
- DATA IT1/1,2,3, 4,5,6/
- DATA IT2/1,2,-5, -1,5,6, 5,-2,4, -4,2,3/
-*-
-** S E T N O D E S & N O R M A L E S
-*
- NNOD = 6
- CALL IHMCPP(NNOD,IE,XYZ,GRAD)
-*
-** F I N D C O N F I G U R A T I O N
-*
- F0 = (F8(1)*F8(3)-F8(2)*F8(4)) / (F8(1)+F8(3)-F8(2)-F8(4))
- IF (F0.GE.0. .AND. F8(1).GE.0.) GOTO 100
- IF (F0.LT.0. .AND. F8(1).LT.0.) GOTO 100
- NTRIA = 2
- CALL IHMCTT(NTRIA,IT1,ITRIA)
- GOTO 999
-*
-** N O T S E P A R A T E D F R O N T F A C E
-*
- 100 NTRIA = 4
- CALL IHMCTT(NTRIA,IT2,ITRIA)
- GOTO 999
-*
- 999 RETURN
- END
diff --git a/src/graflib/higz/ih/ihmc04.F b/src/graflib/higz/ih/ihmc04.F
deleted file mode 100644
index 74d4ec5..0000000
--- a/src/graflib/higz/ih/ihmc04.F
+++ /dev/null
@@ -1,48 +0,0 @@
-*
-* $Id: ihmc04.F,v 1.1.1.1 1996/02/14 13:10:52 mclareni Exp $
-*
-* $Log: ihmc04.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:52 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.19/05 26/08/93 09.50.26 by O.Couet
-*-- Author :
- SUBROUTINE IHMC04(NNOD,NTRIA,XYZ,GRAD,ITRIA)
-************************************************************************
-* *
-* IHMC04 Date: 10.08.93 *
-* Author: E. Chernyaev (IHEP/Protvino) Revised: *
-* *
-* Function: Consider case No 4 *
-* *
-* Input: see common HCMCUB *
-* *
-* Output: the same as for IHMCUB *
-* *
-************************************************************************
-#include "higz/hcmcub.inc"
- REAL XYZ(3,*),GRAD(3,*)
- INTEGER ITRIA(3,*),IE(6),IT1(3,2),IT2(3,6)
- DATA IE/4,9,1, 7,11,6/
- DATA IT1/1,2,3, 4,5,6/
- DATA IT2/1,2,4, 2,3,6, 3,1,5, 4,5,1, 5,6,3, 6,4,2/
-*-
-** S E T N O D E S & N O R M A L E S
-*
- NNOD = 6
- CALL IHMCPP(NNOD,IE,XYZ,GRAD)
-*
-** I S T H E R E S U R F A C E P E N E T R A T I O N ?
-*
- CALL IHMCX(F8(1),F8(2),F8(3),F8(4),F8(5),F8(6),F8(7),F8(8),IREP)
- IF (IREP .EQ. 0) THEN
- NTRIA = 2
- CALL IHMCTT(NTRIA,IT1,ITRIA)
- ELSE
- NTRIA = 6
- CALL IHMCTT(NTRIA,IT2,ITRIA)
- END IF
- RETURN
- END
diff --git a/src/graflib/higz/ih/ihmc06.F b/src/graflib/higz/ih/ihmc06.F
deleted file mode 100644
index b11179c..0000000
--- a/src/graflib/higz/ih/ihmc06.F
+++ /dev/null
@@ -1,64 +0,0 @@
-*
-* $Id: ihmc06.F,v 1.1.1.1 1996/02/14 13:10:52 mclareni Exp $
-*
-* $Log: ihmc06.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:52 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.19/05 26/08/93 09.50.26 by O.Couet
-*-- Author :
- SUBROUTINE IHMC06(NNOD,NTRIA,XYZ,GRAD,ITRIA)
-************************************************************************
-* *
-* IHMC06 Date: 10.08.93 *
-* Author: E. Chernyaev (IHEP/Protvino) Revised: *
-* *
-* Function: Consider case No 6 *
-* *
-* Input: see common HCMCUB *
-* *
-* Output: the same as for IHMCUB *
-* *
-************************************************************************
-#include "higz/hcmcub.inc"
- REAL XYZ(3,*),GRAD(3,*)
- INTEGER ITRIA(3,*),IE(7),IT1(3,5),IT2(3,3),IT3(3,7)
- DATA IE/2,4,9,10, 6,7,11/
- DATA IT1/6,7,-1, -6,1,2, 6,2,3, 6,3,-4, -6,4,5/
- DATA IT2/1,2,-3, -1,3,4, 5,6,7/
- DATA IT3/6,7,-1, -6,1,2, 6,2,3, 6,3,-4, -6,4,5,
- & 1,7,-5, -1,5,4/
-*-
-** S E T N O D E S & N O R M A L E S
-*
- NNOD = 7
- CALL IHMCPP(NNOD,IE,XYZ,GRAD)
-*
-** F I N D C O N F I G U R A T I O N
-*
- F0 = (F8(2)*F8(7)-F8(6)*F8(3)) / (F8(2)+F8(7)-F8(6)-F8(3))
- IF (F0.GE.0. .AND. F8(2).GE.0.) GOTO 100
- IF (F0.LT.0. .AND. F8(2).LT.0.) GOTO 100
-*
-** I S T H E R E S U R F A C E P E N E T R A T I O N ?
-*
- CALL IHMCX(F8(3),F8(2),F8(6),F8(7),F8(4),F8(1),F8(5),F8(8),IREP)
- IF (IREP .EQ. 1) THEN
- NTRIA = 7
- CALL IHMCTT(NTRIA,IT3,ITRIA)
- ELSE
- NTRIA = 3
- CALL IHMCTT(NTRIA,IT2,ITRIA)
- END IF
- GOTO 999
-*
-** N O T S E P A R A T E D R I G T H F A C E
-*
- 100 NTRIA = 5
- CALL IHMCTT(NTRIA,IT1,ITRIA)
- GOTO 999
-*
- 999 RETURN
- END
diff --git a/src/graflib/higz/ih/ihmc07.F b/src/graflib/higz/ih/ihmc07.F
deleted file mode 100644
index a78b138..0000000
--- a/src/graflib/higz/ih/ihmc07.F
+++ /dev/null
@@ -1,89 +0,0 @@
-*
-* $Id: ihmc07.F,v 1.2 2002/05/16 15:29:27 couet Exp $
-*
-* $Log: ihmc07.F,v $
-* Revision 1.2 2002/05/16 15:29:27 couet
-* - During the conversion to C++ (for ROOT), two bugs have been found
-* (and fixed) in the fortran code.
-*
-* Revision 1.1.1.1 1996/02/14 13:10:52 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.19/05 26/08/93 09.50.26 by O.Couet
-*-- Author :
- SUBROUTINE IHMC07(NNOD,NTRIA,XYZ,GRAD,ITRIA)
-************************************************************************
-* *
-* IHMC07 Date: 13.08.93 *
-* Author: E. Chernyaev (IHEP/Protvino) Revised: *
-* *
-* Function: Consider case No 7 *
-* *
-* Input: see common HCMCUB *
-* *
-* Output: the same as for IHMCUB *
-* *
-************************************************************************
-#include "higz/hcmcub.inc"
- REAL XYZ(3,*),GRAD(3,*)
- INTEGER ITRIA(3,*),IE(9),IT(3,9,9)
- DATA IE/3,12,4, 1,10,2, 11,6,7/
- DATA IT/
- & 1,2,3, 4,5,6, 7,8,9, 0,0,0, 0,0,0, 0,0,0, 0,0,0, 0,0,0, 0,0,0,
- & 1,2,3, 4,9,-7, -4,7,6, 9,4,-5, -9,5,8, 0,0,0,0,0,0,0,0,0,0,0,0,
- & 4,5,6, 8,3,-1, -8,1,7, 3,8,-9, -3,9,2, 0,0,0,0,0,0,0,0,0,0,0,0,
- &-10,2,3, 10,3,-1, -10,1,7, 10,7,-6, -10,6,4,
- & 10,4,-5, -10,5,8, 10,8,9, 10,9,-2,
- & 7,8,9, 2,5,-6, -2,6,1, 5,2,-3, -5,3,4, 0,0,0,0,0,0,0,0,0,0,0,0,
- &-10,1,2, 10,2,-3, -10,3,4, 10,4,5, 10,5,-8,
- & -10,8,9, 10,9,-7, -10,7,6, 10,6,-1,
- & 10,2,3, 10,3,-4, -10,4,5, 10,5,-6, -10,6,1,
- & 10,1,-7, -10,7,8, 10,8,-9, -10,9,2,
- & 1,7,6, -4,2,3, -4,9,-2, -9,4,-5, -9,5,8, 0,0,0,0,0,0,0,0,0,0,0,0,
- &-1,9,2, 1,2,3, 1,3,-4, 6,-1,4, 6,4,5,
- & 6,-5,7, -7,5,8, 7,8,9, 7,-9,1/
-*-
-** S E T N O D E S & N O R M A L E S
-*
- NNOD = 9
- CALL IHMCPP(NNOD,IE,XYZ,GRAD)
-*
-** F I N D C O N F I G U R A T I O N
-*
- F1 = (F8(3)*F8(6)-F8(2)*F8(7)) / (F8(3)+F8(6)-F8(2)-F8(7))
- F2 = (F8(3)*F8(8)-F8(4)*F8(7)) / (F8(3)+F8(8)-F8(4)-F8(7))
- F3 = (F8(3)*F8(1)-F8(2)*F8(4)) / (F8(3)+F8(1)-F8(2)-F8(4))
- ICASE = 1
- IF (F1.GE.0. .AND. F8(3).LT.0.) ICASE = ICASE + 1
- IF (F1.LT.0. .AND. F8(3).GE.0.) ICASE = ICASE + 1
- IF (F2.GE.0. .AND. F8(3).LT.0.) ICASE = ICASE + 2
- IF (F2.LT.0. .AND. F8(3).GE.0.) ICASE = ICASE + 2
- IF (F3.GE.0. .AND. F8(3).LT.0.) ICASE = ICASE + 4
- IF (F3.LT.0. .AND. F8(3).GE.0.) ICASE = ICASE + 4
- NTRIA = 5
- GOTO (100,400,400,200,400,200,200,300),ICASE
- 100 NTRIA = 3
- GOTO 400
-*
-** F I N D A D D I T I O N A L P O I N T
-*
- 200 NNOD = 10
- NTRIA = 9
- CALL IHMCMP(9,XYZ,GRAD,IT(1,1,ICASE),XYZ(1,NNOD),GRAD(1,NNOD))
- GOTO 400
-*
-** I S T H E R E S U R F A C E P E N E T R A T I O N ?
-*
- 300 CALL IHMCX(F8(4),F8(3),F8(7),F8(8),F8(1),F8(2),F8(6),F8(5),IREP)
- IF (IREP .NE. 2) GOTO 400
-CCC CALL IHMCTT(NTRIA,IT8,ITRIA)
- NTRIA = 9
- ICASE = 9
-*
-** S E T T R I A N G L E S
-*
- 400 CALL IHMCTT(NTRIA,IT(1,1,ICASE),ITRIA)
- RETURN
- END
diff --git a/src/graflib/higz/ih/ihmc10.F b/src/graflib/higz/ih/ihmc10.F
deleted file mode 100644
index 1a2d4e3..0000000
--- a/src/graflib/higz/ih/ihmc10.F
+++ /dev/null
@@ -1,72 +0,0 @@
-*
-* $Id: ihmc10.F,v 1.1.1.1 1996/02/14 13:10:52 mclareni Exp $
-*
-* $Log: ihmc10.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:52 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.19/05 26/08/93 09.50.26 by O.Couet
-*-- Author :
- SUBROUTINE IHMC10(NNOD,NTRIA,XYZ,GRAD,ITRIA)
-************************************************************************
-* *
-* IHMC10 Date: 10.08.93 *
-* Author: E. Chernyaev (IHEP/Protvino) Revised: *
-* *
-* Function: Consider case No 10 *
-* *
-* Input: see common HCMCUB *
-* *
-* Output: the same as for IHMCUB *
-* *
-************************************************************************
-#include "higz/hcmcub.inc"
- REAL XYZ(3,*),GRAD(3,*)
- INTEGER ITRIA(3,*),IE(8),IT(3,8,6)
- DATA IE/1,3,12,9, 5,7,11,10/
- DATA IT/
- & 1,2,-3, -1,3,4, 5,6,-7, -5,7,8, 0,0,0, 0,0,0, 0,0,0, 0,0,0,
- & 9,1,2, 9,2,3, 9,3,4, 9,4,5, 9,5,6, 9,6,7, 9,7,8, 9,8,1,
- & 9,1,2, 9,4,1, 9,3,4, 9,6,3, 9,5,6, 9,8,5, 9,7,8, 9,2,7,
- & 1,2,-7, -1,7,8, 5,6,-3, -5,3,4, 0,0,0, 0,0,0, 0,0,0, 0,0,0,
- & 1,2,-7, -1,7,8, 2,3,-6, -2,6,7, 3,4,-5, -3,5,6, 4,1,-8, -4,8,5,
- & 1,2,-3, -1,3,4, 2,7,-6, -2,6,3, 7,8,-5, -7,5,6, 8,1,-4, -8,4,5/
-*-
-** S E T N O D E S & N O R M A L E S
-*
- NNOD = 8
- CALL IHMCPP(NNOD,IE,XYZ,GRAD)
-*
-** F I N D C O N F I G U R A T I O N
-*
- F1 = (F8(1)*F8(6)-F8(2)*F8(5)) / (F8(1)+F8(6)-F8(2)-F8(5))
- F2 = (F8(4)*F8(7)-F8(3)*F8(8)) / (F8(4)+F8(7)-F8(3)-F8(8))
- ICASE = 1
- IF (F1 .GE. 0.) ICASE = ICASE + 1
- IF (F2 .GE. 0.) ICASE = ICASE + 2
- IF (ICASE.EQ.1 .OR. ICASE.EQ.4) GOTO 100
-*
-** D I F F E R E N T T O P A N D B O T T O M
-*
- NNOD = 9
- NTRIA = 8
- CALL IHMCMP(8,XYZ,GRAD,IT(1,1,ICASE),XYZ(1,NNOD),GRAD(1,NNOD))
- GOTO 200
-*
-** I S T H E R E S U R F A C E P E N E T R A T I O N ?
-*
- 100 CALL IHMCX(F8(1),F8(2),F8(6),F8(5),F8(4),F8(3),F8(7),F8(8),IREP)
- NTRIA = 4
- IF (IREP .EQ. 0) GOTO 200
-** "B O T T L E N E C K"
- NTRIA = 8
- IF (ICASE .EQ. 1) ICASE = 5
- IF (ICASE .EQ. 4) ICASE = 6
-*
-** S E T T R I A N G L E S
-*
- 200 CALL IHMCTT(NTRIA,IT(1,1,ICASE),ITRIA)
- RETURN
- END
diff --git a/src/graflib/higz/ih/ihmc12.F b/src/graflib/higz/ih/ihmc12.F
deleted file mode 100644
index 75dee7d..0000000
--- a/src/graflib/higz/ih/ihmc12.F
+++ /dev/null
@@ -1,76 +0,0 @@
-*
-* $Id: ihmc12.F,v 1.2 2002/05/16 15:29:28 couet Exp $
-*
-* $Log: ihmc12.F,v $
-* Revision 1.2 2002/05/16 15:29:28 couet
-* - During the conversion to C++ (for ROOT), two bugs have been found
-* (and fixed) in the fortran code.
-*
-* Revision 1.1.1.1 1996/02/14 13:10:52 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.19/05 26/08/93 09.50.26 by O.Couet
-*-- Author :
- SUBROUTINE IHMC12(NNOD,NTRIA,XYZ,GRAD,ITRIA)
-************************************************************************
-* *
-* IHMC12 Date: 10.08.93 *
-* Author: E. Chernyaev (IHEP/Protvino) Revised: *
-* *
-* Function: Consider case No 12 *
-* *
-* Input: see common HCMCUB *
-* *
-* Output: the same as for IHMCUB *
-* *
-************************************************************************
-#include "higz/hcmcub.inc"
- REAL XYZ(3,*),GRAD(3,*)
- INTEGER ITRIA(3,*),IE(8),IT(3,8,6)
- DATA IE/3,12,4, 1,9,8,6,2/
- DATA IT/
- & 1,2,3, 4,5,-6, -4,6,8, 6,7,8, 0,0,0, 0,0,0, 0,0,0, 0,0,0,
- &-9,1,2, 9,2,-3, -9,3,4, 9,4,-5, -9,5,6, 9,6,-7, -9,7,8, 9,8,-1,
- &9,1,-2, -9,2,6, 9,6,-7, -9,7,8, 9,8,-4, -9,4,5, 9,5,-3, -9,3,1,
- & 3,4,5, 1,2,-6, -1,6,8, 6,7,8, 0,0,0, 0,0,0, 0,0,0, 0,0,0,
- & 7,8,6, 6,8,-1, -6,1,2, 3,1,-8, -3,8,4, 3,4,5, 3,5,-6, -3,6,2,
- & 7,8,6, 6,8,-4, -6,4,5, 3,4,-8, -3,8,1, 3,1,2, 3,2,-6, -3,6,5/
-*-
-** S E T N O D E S & N O R M A L E S
-*
- NNOD = 8
- CALL IHMCPP(NNOD,IE,XYZ,GRAD)
-*
-** F I N D C O N F I G U R A T I O N
-*
- F1 = (F8(1)*F8(3)-F8(2)*F8(4)) / (F8(1)+F8(3)-F8(2)-F8(4))
- F2 = (F8(1)*F8(8)-F8(4)*F8(5)) / (F8(1)+F8(8)-F8(4)-F8(5))
- ICASE = 1
- IF (F1 .GE. 0.) ICASE = ICASE + 1
- IF (F2 .GE. 0.) ICASE = ICASE + 2
- IF (ICASE.EQ.1 .OR. ICASE.EQ.4) GOTO 100
-*
-** F I N D A D D I T I O N A L P O I N T
-*
- NNOD = 9
- NTRIA = 8
- CALL IHMCMP(8,XYZ,GRAD,IT(1,1,ICASE),XYZ(1,NNOD),GRAD(1,NNOD))
- GOTO 200
-*
-** I S T H E R E S U R F A C E P E N E T R A T I O N ?
-*
- 100 CALL IHMCX(F8(1),F8(2),F8(3),F8(4),F8(5),F8(6),F8(7),F8(8),IREP)
- NTRIA = 4
- IF (IREP .NE. 1) GOTO 200
-** "B O T T L E N E C K"
- NTRIA = 8
- IF (ICASE .EQ. 1) ICASE = 5
- IF (ICASE .EQ. 4) ICASE = 6
-*
-** S E T T R I A N G L E S
-*
- 200 CALL IHMCTT(NTRIA,IT(1,1,ICASE),ITRIA)
- RETURN
- END
diff --git a/src/graflib/higz/ih/ihmc13.F b/src/graflib/higz/ih/ihmc13.F
deleted file mode 100644
index 3a09cbf..0000000
--- a/src/graflib/higz/ih/ihmc13.F
+++ /dev/null
@@ -1,155 +0,0 @@
-*
-* $Id: ihmc13.F,v 1.1.1.1 1996/02/14 13:10:52 mclareni Exp $
-*
-* $Log: ihmc13.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:52 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.19/05 26/08/93 09.50.26 by O.Couet
-*-- Author :
- SUBROUTINE IHMC13(NNOD,NTRIA,XYZ,GRAD,ITRIA)
-************************************************************************
-* *
-* IHMC13 Date: 13.08.93 *
-* Author: E. Chernyaev (IHEP/Protvino) Revised: *
-* *
-* Function: Consider case No 13 *
-* *
-* Input: see common HCMCUB *
-* *
-* Output: the same as for IHMCUB *
-* *
-************************************************************************
-#include "higz/hcmcub.inc"
- REAL XYZ(3,*),GRAD(3,*),FF(8)
- INTEGER ITRIA(3,*)
- INTEGER IE(12),IFACE(4,6),IROTA(8,12),IWHAT(8)
- INTEGER IT1(3,4), IT2(3,4), IT3(3,6), IT4(3,6)
- INTEGER IT5(3,10),IT6(3,10),IT7(3,12)
- INTEGER IT8(3,6), IT9(3,10),IT10(3,10)
- DATA IROTA/
- & 1,2,3,4,5,6,7,8, 1,5,6,2,4,8,7,3, 1,4,8,5,2,3,7,6,
- & 3,7,8,4,2,6,5,1, 3,2,6,7,4,1,5,8, 3,4,1,2,7,8,5,6,
- & 6,7,3,2,5,8,4,1, 6,5,8,7,2,1,4,3, 6,2,1,5,7,3,4,8,
- & 8,4,3,7,5,1,2,6, 8,5,1,4,7,6,2,3, 8,7,6,5,4,3,2,1/
- DATA IWHAT/63,62,54,26,50,9,1,0/
- DATA IE/1,2,3,4,5,6,7,8,9,10,11,12/
- DATA IFACE/
- & 1,2,3,4, 5,6,7,8, 1,2,6,5, 2,6,7,3, 4,3,7,8, 1,5,8,4/
- DATA IT1/1,2,10, 9,5,8, 6,11,7, 3,4,12/
- DATA IT2/5,6,10, 1,4,9, 2,11,3, 7,8,12/
- DATA IT3/10,12,-3, -10,3,2, 12,10,-1, -12,1,4,
- & 9,5,8, 6,11,7/
- DATA IT4/11,9,-1, -11,1,2, 9,11,-3, -9,3,4,
- & 5,6,10, 7,8,12/
- DATA IT5/13,2,-11, -13,11,7, 13,7,-6, -13,6,10,
- & 13,10,1, 13,1,-4, -13,4,12, 13,12,-3, -13,3,2, 5,8,9/
- DATA IT6/13,2,-10, -13,10,5, 13,5,-6, -13,6,11,
- & 13,11,3, 13,3,-4, -13,4,9, 13,9,-1, -13,1,2, 12,7,8/
- DATA IT7/13,2,-11, -13,11,7, 13,7,-6, -13,6,10,
- & 13,10,-5, -13,5,8, 13,8,-9, -13,9,1,
- & 13,1,-4, -13,4,12, 13,12,-3, -13,3,2/
- DATA IT8/-3,8,12, 3,-2,-8, -2,5,-8, 2,10,-5,
- & 7,6,11, 1,4,9/
- DATA IT9/7,12,-3, -7,3,11, 11,3,2, 6,11,-2, -6,2,10,
- & 6,10,5, 7,6,-5, -7,5,8, 7,8,12, 1,4,9/
- DATA IT10/9,1,-10, -9,10,5, 9,5,8, 4,9,-8, -4,8,12,
- & 4,12,3, 1,4,-3, -1,3,2, 1,2,10, 7,6,11/
-*-
- NNOD = 0
- NTRIA = 0
-*
-** F I N D C O N F I G U R A T I O N T Y P E
-*
- DO 130 NR=1,12
- K = 0
- INCR = 1
- DO 110 NF=1,6
- F1 = F8(IROTA(IFACE(1,NF),NR))
- F2 = F8(IROTA(IFACE(2,NF),NR))
- F3 = F8(IROTA(IFACE(3,NF),NR))
- F4 = F8(IROTA(IFACE(4,NF),NR))
- IF ((F1*F3-F2*F4)/(F1+F3-F2-F4) .GE. 0.) K = K + INCR
- INCR = INCR + INCR
- 110 CONTINUE
- DO 120 I=1,8
- IF (K .NE. IWHAT(I)) GOTO 120
- ICASE = I
- KR = NR
- GOTO 200
- 120 CONTINUE
- 130 CONTINUE
- WRITE(*,*) 'IHMC13: configuration is not found'
- GOTO 999
-*
-** R O T A T E C U B E
-*
- 200 IF (ICASE.EQ.1 .OR. ICASE.EQ.8) GOTO 300
- DO 220 N=1,8
- K = IROTA(N,KR)
- FF(N) = F8(K)
- DO 210 I=1,3
- XYZ(I,N) = P8(I,K)
- GRAD(I,N) = G8(I,K)
- 210 CONTINUE
- 220 CONTINUE
- DO 240 N=1,8
- F8(N) = FF(N)
- DO 230 I=1,3
- P8(I,N) = XYZ(I,N)
- G8(I,N) = GRAD(I,N)
- 230 CONTINUE
- 240 CONTINUE
-*
-** S E T N O D E S & N O R M A L E S
-*
- 300 NNOD = 12
- CALL IHMCPP(NNOD,IE,XYZ,GRAD)
-*
-** V A R I O U S C O N F I G U R A T I O N S
-*
- GOTO (410,430,450,480,470,460,440,420), ICASE
- 410 NTRIA = 4
- CALL IHMCTT(NTRIA,IT1,ITRIA)
- GOTO 999
- 420 NTRIA = 4
- CALL IHMCTT(NTRIA,IT2,ITRIA)
- GOTO 999
- 430 NTRIA = 6
- CALL IHMCTT(NTRIA,IT3,ITRIA)
- GOTO 999
- 440 NTRIA = 6
- CALL IHMCTT(NTRIA,IT4,ITRIA)
- GOTO 999
- 450 NNOD = 13
- NTRIA = 10
- CALL IHMCMP(9,XYZ,GRAD,IT5,XYZ(1,NNOD),GRAD(1,NNOD))
- CALL IHMCTT(NTRIA,IT5,ITRIA)
- GOTO 999
- 460 NNOD = 13
- NTRIA = 10
- CALL IHMCMP(9,XYZ,GRAD,IT6,XYZ(1,NNOD),GRAD(1,NNOD))
- CALL IHMCTT(NTRIA,IT6,ITRIA)
- GOTO 999
- 470 NNOD = 13
- NTRIA = 12
- CALL IHMCMP(12,XYZ,GRAD,IT7,XYZ(1,NNOD),GRAD(1,NNOD))
- CALL IHMCTT(NTRIA,IT7,ITRIA)
- GOTO 999
-** I S T H E R E S U R F A C E P E N E T R A T I O N ?
- 480 CALL IHMCX(F8(3),F8(4),F8(1),F8(2),F8(7),F8(8),F8(5),F8(6),IREP)
- GOTO (481,482,483), IREP+1
- 481 NTRIA = 6
- CALL IHMCTT(NTRIA,IT8,ITRIA)
- GOTO 999
- 482 NTRIA = 10
- CALL IHMCTT(NTRIA,IT9,ITRIA)
- GOTO 999
- 483 NTRIA = 10
- CALL IHMCTT(NTRIA,IT10,ITRIA)
- GOTO 999
-*
- 999 RETURN
- END
diff --git a/src/graflib/higz/ih/ihmcmp.F b/src/graflib/higz/ih/ihmcmp.F
deleted file mode 100644
index f6571c4..0000000
--- a/src/graflib/higz/ih/ihmcmp.F
+++ /dev/null
@@ -1,49 +0,0 @@
-*
-* $Id: ihmcmp.F,v 1.1.1.1 1996/02/14 13:10:52 mclareni Exp $
-*
-* $Log: ihmcmp.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:52 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.19/05 26/08/93 09.50.26 by O.Couet
-*-- Author :
- SUBROUTINE IHMCMP(NNOD,XYZ,GRAD,IT,PXYZ,PGRAD)
-************************************************************************
-* *
-* IHMCMP Date: 15.08.93 *
-* Author: E. Chernyaev (IHEP/Protvino) Revised: *
-* *
-* Function: Find meadle point of a polygon *
-* *
-* Input: NNOD - number of nodes in the polygon *
-* XYZ(3,*) - node coordinates *
-* GRAD(3,*) - node normalies *
-* IT(3,*) - division of the polygons into triangles *
-* *
-* Output: PXYZ(3) - meadle point coordinates *
-* PGRAD(3) - meadle point normale *
-* *
-************************************************************************
- REAL XYZ(3,*),GRAD(3,*),PXYZ(3),PGRAD(3),P(3),G(3)
- INTEGER IT(3,*)
-*-
- DO 100 I=1,3
- P(I) = 0.
- G(I) = 0.
- 100 CONTINUE
- DO 220 N=1,NNOD
- K = IT(3,N)
- IF (K .LT. 0) K =-K
- DO 210 I=1,3
- P(I) = P(I) + XYZ(I,K)
- G(I) = G(I) + GRAD(I,K)
- 210 CONTINUE
- 220 CONTINUE
- DO 300 I=1,3
- PXYZ(I) = P(I) / NNOD
- PGRAD(I) = G(I) / NNOD
- 300 CONTINUE
- RETURN
- END
diff --git a/src/graflib/higz/ih/ihmcpp.F b/src/graflib/higz/ih/ihmcpp.F
deleted file mode 100644
index 653f28a..0000000
--- a/src/graflib/higz/ih/ihmcpp.F
+++ /dev/null
@@ -1,45 +0,0 @@
-*
-* $Id: ihmcpp.F,v 1.1.1.1 1996/02/14 13:10:53 mclareni Exp $
-*
-* $Log: ihmcpp.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:53 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.19/05 26/08/93 09.50.26 by O.Couet
-*-- Author :
- SUBROUTINE IHMCPP(NNOD,IE,XYZ,GRAD)
-************************************************************************
-* *
-* IHMCPP Date: 15.08.93 *
-* Author: E. Chernyaev (IHEP/Protvino) Revised: *
-* *
-* Function: Find nodes and normales *
-* *
-* Input: NNOD - number of nodes *
-* IE(*) - edges which have section node *
-* *
-* Output: XYZ(3,*) - nodes *
-* GRAD(3,*) - node normales (not normalized) *
-* *
-************************************************************************
-#include "higz/hcmcub.inc"
- REAL XYZ(3,*),GRAD(3,*)
- INTEGER IE(*),IEDGE(2,12)
- DATA IEDGE/
- & 1,2, 2,3, 3,4, 4,1, 5,6, 6,7, 7,8, 8,5, 1,5, 2,6, 3,7, 4,8/
-*-
- DO 200 N=1,NNOD
- K = IE(N)
- IF (K .LT. 0) K =-K
- N1 = IEDGE(1,K)
- N2 = IEDGE(2,K)
- T = F8(N1) / (F8(N1)-F8(N2))
- DO 100 I=1,3
- XYZ(I,N) = (P8(I,N2)-P8(I,N1))*T + P8(I,N1)
- GRAD(I,N) = (G8(I,N2)-G8(I,N1))*T + G8(I,N1)
- 100 CONTINUE
- 200 CONTINUE
- RETURN
- END
diff --git a/src/graflib/higz/ih/ihmctt.F b/src/graflib/higz/ih/ihmctt.F
deleted file mode 100644
index 320c958..0000000
--- a/src/graflib/higz/ih/ihmctt.F
+++ /dev/null
@@ -1,37 +0,0 @@
-*
-* $Id: ihmctt.F,v 1.1.1.1 1996/02/14 13:10:53 mclareni Exp $
-*
-* $Log: ihmctt.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:53 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.19/06 27/08/93 13.53.33 by O.Couet
-*-- Author :
- SUBROUTINE IHMCTT(NTRIA,IT,ITRIA)
-************************************************************************
-* *
-* IHMCTT Date: 15.08.93 *
-* Author: E. Chernyaev (IHEP/Protvino) Revised: *
-* *
-* Function: Set triangles *
-* (if parameter IALL=1, all edges will be visible) *
-* *
-* Input: NTRIA - number of triagles *
-* IT(3,*) - triangles *
-* *
-* Output: ITRIA(3,*) - triangles *
-* *
-************************************************************************
- INTEGER IT(3,*),ITRIA(3,*)
-*-
- DO 200 N=1,NTRIA
- DO 100 I=1,3
- K = IT(I,N)
-* IF (K .LT. 0) K =-K
- ITRIA(I,N) = K
- 100 CONTINUE
- 200 CONTINUE
- RETURN
- END
diff --git a/src/graflib/higz/ih/ihmcub.F b/src/graflib/higz/ih/ihmcub.F
deleted file mode 100644
index a99ad86..0000000
--- a/src/graflib/higz/ih/ihmcub.F
+++ /dev/null
@@ -1,190 +0,0 @@
-*
-* $Id: ihmcub.F,v 1.1.1.1 1996/02/14 13:10:53 mclareni Exp $
-*
-* $Log: ihmcub.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:53 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.19/06 27/08/93 13.59.54 by O.Couet
-*-- Author :
- SUBROUTINE IHMCUB(FISO,P,F,G,NNOD,NTRIA,XYZ,GRAD,ITRIA)
-************************************************************************
-* *
-* IHMCUB Date: 09.07.93 *
-* Author: E. Chernyaev (IHEP/Protvino) Revised: *
-* *
-* Function: Topological decider for "Matching Cubes" algorithm *
-* Find set of triangles aproximating the isosurface *
-* F(x,y,z)=Fiso inside the cube (improved version) *
-* *
-* Input: FISO - function value for isosurface *
-* P(3,8) - cube vertexes *
-* F(8) - function values at the vertexes *
-* G(3,8) - function gradients at the vertexes *
-* *
-* Output: NNOD - number of nodes (maximum 13) *
-* NTRIA - number of triangles (maximum 12) *
-* XYZ(3,*) - nodes *
-* GRAD(3,*) - node normales (not normalized) *
-* ITRIA(3,*) - triangles *
-* *
-************************************************************************
-#include "higz/hcmcub.inc"
- PARAMETER (DEL = 0.0001)
- REAL P(3,*),F(*),G(3,*),XYZ(3,*),GRAD(3,*)
- INTEGER ITRIA(3,*),IROTA(8,24),IWHAT(21),ITR(3)
- DATA IROTA/
- & 1,2,3,4,5,6,7,8, 2,3,4,1,6,7,8,5,
- & 3,4,1,2,7,8,5,6, 4,1,2,3,8,5,6,7,
- & 6,5,8,7,2,1,4,3, 5,8,7,6,1,4,3,2,
- & 8,7,6,5,4,3,2,1, 7,6,5,8,3,2,1,4,
- & 2,6,7,3,1,5,8,4, 6,7,3,2,5,8,4,1,
- & 7,3,2,6,8,4,1,5, 3,2,6,7,4,1,5,8,
- & 5,1,4,8,6,2,3,7, 1,4,8,5,2,3,7,6,
- & 4,8,5,1,3,7,6,2, 8,5,1,4,7,6,2,3,
- & 5,6,2,1,8,7,3,4, 6,2,1,5,7,3,4,8,
- & 2,1,5,6,3,4,8,7, 1,5,6,2,4,8,7,3,
- & 4,3,7,8,1,2,6,5, 3,7,8,4,2,6,5,1,
- & 7,8,4,3,6,5,1,2, 8,4,3,7,5,1,2,6/
- DATA IWHAT/
- & 1,3,5,65,50,67,74,51,177,105,113,58,165,178,
- & 254,252,250,190,205,188,181/
-*-
- NNOD = 0
- NTRIA = 0
-*
-** F I N D C O N F I G U R A T I O N T Y P E
-*
- DO 100 I=1,8
- F8(I) = F(I) - FISO
- 100 CONTINUE
- DO 130 IR=1,24
- K = 0
- INCR = 1
- DO 110 I=1,8
- IF (F8(IROTA(I,IR)) .GE. 0.) K = K + INCR
- INCR = INCR + INCR
- 110 CONTINUE
- IF (K.EQ.0 .OR. K.EQ.255) GOTO 999
- DO 120 I=1,21
- IF (K .NE. IWHAT(I)) GOTO 120
- ICASE = I
- IRT = IR
- GOTO 200
- 120 CONTINUE
- 130 CONTINUE
-*
-** R O T A T E C U B E
-*
- 200 DO 210 I=1,8
- K = IROTA(I,IRT)
- F8(I) = F(K) - FISO
- P8(1,I)= P(1,K)
- P8(2,I)= P(2,K)
- P8(3,I)= P(3,K)
- G8(1,I)= G(1,K)
- G8(2,I)= G(2,K)
- G8(3,I)= G(3,K)
- 210 CONTINUE
-*
-** V A R I O U S C O N F I G U R A T I O N S
-*
- N = 0
- GOTO (301,302,303,304,305,306,307,308,309,310,311,312,313,314,
- & 301,302,303,304,305,306,307),ICASE
-*
- 301 CALL IHMC00(1, 4, 9, 0, 0, 0, NNOD,NTRIA,XYZ,GRAD,ITRIA)
- GOTO 400
- 302 CALL IHMC00(2, 4, 9,10, 0, 0, NNOD,NTRIA,XYZ,GRAD,ITRIA)
- GOTO 400
- 303 CALL IHMC03(NNOD,NTRIA,XYZ,GRAD,ITRIA)
- GOTO 400
- 304 CALL IHMC04(NNOD,NTRIA,XYZ,GRAD,ITRIA)
- GOTO 400
- 305 CALL IHMC00(6, 2, 1, 9, 8, 0, NNOD,NTRIA,XYZ,GRAD,ITRIA)
- GOTO 400
- 306 CALL IHMC06(NNOD,NTRIA,XYZ,GRAD,ITRIA)
- GOTO 400
- 307 CALL IHMC07(NNOD,NTRIA,XYZ,GRAD,ITRIA)
- GOTO 400
- 308 CALL IHMC00(2, 4, 8, 6, 0, 0, NNOD,NTRIA,XYZ,GRAD,ITRIA)
- GOTO 500
- 309 CALL IHMC00(1, 4,12, 7, 6,10, NNOD,NTRIA,XYZ,GRAD,ITRIA)
- GOTO 500
- 310 CALL IHMC10(NNOD,NTRIA,XYZ,GRAD,ITRIA)
- GOTO 500
- 311 CALL IHMC00(1, 4, 8, 7,11,10, NNOD,NTRIA,XYZ,GRAD,ITRIA)
- GOTO 500
- 312 CALL IHMC12(NNOD,NTRIA,XYZ,GRAD,ITRIA)
- GOTO 500
- 313 CALL IHMC13(NNOD,NTRIA,XYZ,GRAD,ITRIA)
- GOTO 500
- 314 CALL IHMC00(1, 9,12, 7, 6, 2, NNOD,NTRIA,XYZ,GRAD,ITRIA)
- GOTO 500
-*
-** I F N E E D E D , I N V E R T T R I A N G L E S
-*
- 400 IF (NTRIA .EQ. 0) GOTO 999
- IF (ICASE .LE. 14) GOTO 500
- DO 410 I=1,NTRIA
- I1 = IABS(ITRIA(1,I))
- I2 = IABS(ITRIA(2,I))
- I3 = IABS(ITRIA(3,I))
- IF (ITRIA(3,I) .LT. 0) I1 =-I1
- IF (ITRIA(2,I) .LT. 0) I3 =-I3
- IF (ITRIA(1,I) .LT. 0) I2 =-I2
- ITRIA(1,I) = I1
- ITRIA(2,I) = I3
- ITRIA(3,I) = I2
- 410 CONTINUE
-*
-** R E M O V E V E R Y S M A L L T R I A N G L E S
-*
- 500 N = N + 1
- 510 IF (N .GT. NTRIA) GOTO 999
- DO 520 I=1,3
- I1 = I
- I2 = I + 1
- IF (I .EQ. 3) I2 = 1
- K1 = IABS(ITRIA(I1,N))
- K2 = IABS(ITRIA(I2,N))
- IF (ABS(XYZ(1,K1)-XYZ(1,K2)) .GT. DEL) GOTO 520
- IF (ABS(XYZ(2,K1)-XYZ(2,K2)) .GT. DEL) GOTO 520
- IF (ABS(XYZ(3,K1)-XYZ(3,K2)) .GT. DEL) GOTO 520
- I3 = I - 1
- IF (I .EQ. 1) I3 = 3
- GOTO 530
- 520 CONTINUE
- GOTO 500
-* R E M O V E T R I A N G L E
- 530 DO 540 I=1,3
- ITR(I) = ITRIA(I,N)
- ITRIA(I,N) = ITRIA(I,NTRIA)
- 540 CONTINUE
- NTRIA = NTRIA - 1
- IF (NTRIA .EQ. 0) GOTO 999
- IF (ITR(I2)*ITR(I3) .GT. 0) GOTO 510
-* C O R R E C T O T H E R T R I A N G L E S
- IF (ITR(I2) .LT. 0) THEN
- K1 =-ITR(I2)
- K2 =-IABS(ITR(I3))
- END IF
- IF (ITR(I3) .LT. 0) THEN
- K1 =-ITR(I3)
- K2 =-IABS(ITR(I1))
- END IF
- DO 560 J=1,NTRIA
- DO 550 I=1,3
- IF (ITRIA(I,J) .NE. K2) GOTO 550
- I2 = IABS(ITRIA(1,J))
- IF (I .NE. 3) I2 = IABS(ITRIA(I+1,J))
- IF (I2 .EQ. K1) ITRIA(I,J) =-ITRIA(I,J)
- GOTO 560
- 550 CONTINUE
- 560 CONTINUE
- GOTO 510
-*
- 999 RETURN
- END
diff --git a/src/graflib/higz/ih/ihmcx.F b/src/graflib/higz/ih/ihmcx.F
deleted file mode 100644
index c7271e3..0000000
--- a/src/graflib/higz/ih/ihmcx.F
+++ /dev/null
@@ -1,83 +0,0 @@
-*
-* $Id: ihmcx.F,v 1.1.1.1 1996/02/14 13:10:52 mclareni Exp $
-*
-* $Log: ihmcx.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:52 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.19/06 27/08/93 13.53.33 by O.Couet
-*-- Author :
- SUBROUTINE IHMCX(A00,A10,A11,A01,B00,B10,B11,B01,IREP)
-************************************************************************
-* *
-* IHMCX Date: 11.08.93 *
-* Author: E. Chernyaev (IHEP/Protvino) Revised: *
-* *
-* Function: Check for sursafe penetration ("bottle neck") *
-* *
-* Input: A00,A10,A11,A01 - vertex values for 1st face *
-* B00,B10,B11,B01 - vertex values for opposite face *
-* *
-* Output: IREP - 1,2 - there is surface penetration *
-* 0 - there is not surface penetration *
-* *
-************************************************************************
- IREP = 0
- A = (A11-A01)*(B00-B10) - (A00-A10)*(B11-B01)
- IF (A .EQ. 0.) GOTO 999
- B = A01*(B00-B10)-(A11-A01)*B00-(A00-A10)*B01+A00*(B11-B01)
- C = A00*B01 - A01*B00
- D = B*B-4*A*C
- IF (D .LE. 0.) GOTO 999
- D = SQRT(D)
- IF (ABS(-B+D) .GT. ABS(2*A)) GOTO 999
- S1 = (-B+D) / (2*A)
- IF (S1.LT.0. .OR. S1.GT.1.) GOTO 999
- IF (ABS(-B-D) .GT. ABS(2*A)) GOTO 999
- S2 = (-B-D) / (2*A)
- IF (S2.LT.0. .OR. S2.GT.1.) GOTO 999
-*
-** C A S E N O 4 ?
-*
- IPOSA = 0
- IF (A00 .GE. 0) IPOSA = IPOSA + 1
- IF (A01 .GE. 0) IPOSA = IPOSA + 2
- IF (A10 .GE. 0) IPOSA = IPOSA + 4
- IF (A11 .GE. 0) IPOSA = IPOSA + 8
- IF (IPOSA.EQ.6 .OR. IPOSA.EQ.9) GOTO 100
- IREP = 1
- GOTO 999
-*
-** N O T C A S E N O 4
-*
- 100 S0 = (A00-A01) / (A00+A11-A10-A01)
- IF (S1.GE.S0 .AND. S2.LT.S0) GOTO 999
- IF (S1.LT.S0 .AND. S2.GE.S0) GOTO 999
- IREP = 1
- IF (S1 .GE. S0) IREP = 2
-*
-** C A S E S N O 10, 13 ?
-*
- IPOSB = 0
- IF (B00 .GE. 0) IPOSB = IPOSB + 1
- IF (B01 .GE. 0) IPOSB = IPOSB + 2
- IF (B10 .GE. 0) IPOSB = IPOSB + 4
- IF (B11 .GE. 0) IPOSB = IPOSB + 8
- IF (IPOSB.NE.6 .AND. IPOSB.NE.9) GOTO 999
- S0 = (B00-B01) / (B00+B11-B10-B01)
- IF (IPOSA .NE. IPOSB) GOTO 200
-** C A S E N O 10
- IF (IREP.EQ.1 .AND. S1.GT.S0) GOTO 999
- IF (IREP.EQ.2 .AND. S1.LT.S0) GOTO 999
- IREP = 0
- GOTO 999
-** C A S E N O 13
- 200 IF (IREP.EQ.1 .AND. S1.LT.S0) GOTO 999
- IF (IREP.EQ.2 .AND. S1.GT.S0) GOTO 999
- IREP = 0
- GOTO 999
-*
- 999 RETURN
- END
diff --git a/src/graflib/higz/ih/ihpff.F b/src/graflib/higz/ih/ihpff.F
deleted file mode 100644
index 5062e38..0000000
--- a/src/graflib/higz/ih/ihpff.F
+++ /dev/null
@@ -1,88 +0,0 @@
-*
-* $Id: ihpff.F,v 1.1.1.1 1996/02/14 13:10:53 mclareni Exp $
-*
-* $Log: ihpff.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:53 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.13/09 14/01/92 14.01.24 by O.Couet
-*-- Author :
- SUBROUTINE IHPFF(N,P,F)
-************************************************************************
-* *
-* IHPFF Date: 09.01.92 *
-* Author: E. Chernyaev (IHEP/Protvino) Revised: *
-* *
-* Function: Fill polygon with fuction values at vertexes *
-* *
-* References: IHERAN *
-* *
-* Input: N - number of vertexes *
-* P(3,*) - polygon *
-* F(*) - function values at nodes *
-* *
-* Errors: - illegal number of vertexes in polygon *
-* - illegal call of IHPFF: no levels *
-* *
-************************************************************************
-#include "higz/hclevl.inc"
- REAL P(3,*),F(*),X(12),Y(12),P3(3,12)
-*-
- IF (N .LT. 3) GOTO 997
- IF (NLEV .EQ. 0) GOTO 998
- NP = N
- NL = NLEV
- IF (NL .LT. 0) NL =-NL
- FMIN = F(1)
- FMAX = F(1)
- DO 100 I=2,NP
- IF (FMIN .GT. F(I)) FMIN = F(I)
- IF (FMAX .LT. F(I)) FMAX = F(I)
- 100 CONTINUE
- FUNMIN = FUNLEV(1) - 1.
- IF (FMIN .LT. FUNMIN) FUNMIN = FMIN - 1.
- FUNMAX = FUNLEV(NL) + 1.
- IF (FMAX .GT. FUNMAX) FUNMAX = FMAX + 1.
-*
-** F I N D A N D D R A W S U B P O L Y G O N S
-*
- F2 = FUNMIN
- DO 300 ILEV=1,NL+1
-* S E T L E V E L L I M I T S
- F1 = F2
- IF (ILEV .EQ. NL+1) THEN
- F2 = FUNMAX
- ELSE
- F2 = FUNLEV(ILEV)
- END IF
- IF (FMAX .LT. F1) GOTO 999
- IF (FMIN .GT. F2) GOTO 300
-* F I N D S U B P O L Y G O N
- K = 0
- DO 210 I=1,NP
- I1 = I
- I2 = I + 1
- IF (I .EQ. NP) I2 = 1
- CALL IHERAN(P(1,I1),P(1,I2),F(I1),F(I2),F1,F2,K,P3)
- 210 CONTINUE
-* D R A W S U B P O L Y G O N
- IF (K .LT. 3) GOTO 300
- DO 220 I=1,K
- X(I) = P3(1,I)
- Y(I) = P3(2,I)
- 220 CONTINUE
- ICOL = ICLEV(ILEV)
- CALL ISFACI(ICOL)
- CALL ISFAIS(1)
- CALL IFA(K,X,Y)
- 300 CONTINUE
- GOTO 999
-*
- 997 WRITE (*,*) 'IHPFF: illegal number of vertexes in polygon'
- GOTO 999
- 998 WRITE (*,*) 'IHPFF: illegal call of IHPFF: no levels'
- GOTO 999
- 999 RETURN
- END
diff --git a/src/graflib/higz/ih/ihprop.F b/src/graflib/higz/ih/ihprop.F
deleted file mode 100644
index 2dec047..0000000
--- a/src/graflib/higz/ih/ihprop.F
+++ /dev/null
@@ -1,49 +0,0 @@
-*
-* $Id: ihprop.F,v 1.1.1.1 1996/02/14 13:10:53 mclareni Exp $
-*
-* $Log: ihprop.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:53 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.13/09 14/01/92 14.01.24 by O.Couet
-*-- Author :
- SUBROUTINE IHPROP(QQA,QQD,QQS,NNQS,IREP)
-************************************************************************
-* *
-* IHPROP Date: 11.10.91 *
-* Author: E. Chernyaev (IHEP/Protvino) Revised: *
-* *
-* Function: Set surface property coefficients *
-* *
-* Input: QQA - diffusion coefficient for diffused light [0.,1.] *
-* QQD - diffusion coefficient for direct light [0.,1.] *
-* QQS - diffusion coefficient for reflected light [0.,1.] *
-* NNCS - power coefficient for reflected light (.GE.1) *
-* *
-* -- *
-* Lightness model formula: Y = YD*QA + > YLi*(QD*cosNi+QS*cosRi) *
-* -- *
-* *
-* Output: IREP - reply : 0 - O.K. *
-* -1 - error in cooefficients *
-* *
-************************************************************************
-#include "higz/hcligh.inc"
-*-
- IREP = 0
- IF (QQA.LT.0. .OR. QQA.GT.1.) GOTO 998
- IF (QQA.LT.0. .OR. QQA.GT.1.) GOTO 998
- IF (QQA.LT.0. .OR. QQA.GT.1.) GOTO 998
- IF (NNQS .LT. 1) GOTO 998
- QA = QQA
- QD = QQD
- QS = QQS
- NQS = NNQS
- GOTO 999
-*
- 998 WRITE(*,*) 'IHPROP: error in coefficients'
- IREP =-1
- 999 RETURN
- END
diff --git a/src/graflib/higz/ih/ihpvie.F b/src/graflib/higz/ih/ihpvie.F
deleted file mode 100644
index c93a04a..0000000
--- a/src/graflib/higz/ih/ihpvie.F
+++ /dev/null
@@ -1,78 +0,0 @@
-*
-* $Id: ihpvie.F,v 1.1.1.1 1996/02/14 13:10:53 mclareni Exp $
-*
-* $Log: ihpvie.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:53 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.20/07 13/01/94 14.40.02 by O.Couet
-*-- Author :
- SUBROUTINE IHPVIE(RMIN,RMAX,P,PSI,IREP)
-************************************************************************
-* *
-* IHPVIE Date: 13.08.90 *
-* Author: E. Chernyaev (IHEP/Protvino) Revised: *
-* *
-* Function: Set view direction using eye point *
-* *
-* References: IHWV01, IHWV02 *
-* *
-* Input: RMIN(3) - MIN - *
-* RMAX(3) - MAX scope *
-* *
-* P(3) - eye point *
-* PSI - rotation in screen plane *
-* *
-* Output: IREP - reply :-1 - error in min-max *
-* -2 - error in eye point *
-* *
-* Errors: error in min-max scope *
-* *
-************************************************************************
-#include "higz/hctnor.inc"
-#include "higz/hcscrn.inc"
- REAL RMIN(3),RMAX(3),P(3),CENTRE(3),SCALE(3)
- DOUBLE PRECISION DRAD,C1,S1,C2,S2,C3,S3
- DOUBLE PRECISION DDXX,DDYY,DDZZ,S,SS
-*-
- DRAD = DATAN(1.D0)*4./180.
-*
-** F I N D C E N T E R O F S C O P E A N D
-** S C A L E F A C T O R S
-*
- CALL IHWV01(RMIN,RMAX,SCALE,CENTRE,IREP)
- IF (IREP .LT. 0) GOTO 997
-*
-** S E T T R A N S F O R M A T I O N M A T R I X E S
-*
- DDXX = P(1) - CENTRE(1)
- DDYY = P(2) - CENTRE(2)
- DDZZ = P(3) - CENTRE(3)
- S = DSQRT(DDXX*DDXX + DDYY*DDYY)
- SS = DSQRT(DDXX*DDXX + DDYY*DDYY+ DDZZ*DDZZ)
- IF (SS .EQ. 0.) GOTO 998
- C1 = 1.
- S1 = 0.
- C2 = 1.
- S2 = 0.
- IF (S .EQ. 0.) GOTO 200
- C1 = DDXX / S
- S1 = DDYY / S
- C2 = DDZZ / SS
- S2 = S / SS
- 200 C3 = DCOS(PSI*DRAD)
- S3 = DSIN(PSI*DRAD)
- CALL IHWV02(SCALE,CENTRE,C1,S1,C2,S2,C3,S3,TNORM,TBACK)
- C3 = 1.
- S3 = 0.
- CALL IHWV02(SCALE,CENTRE,C1,S1,C2,S2,C3,S3,TN,TB)
- RETURN
-*
- 997 WRITE(*,*) 'IHPVIE: error in min-max scope'
- IREP =-1
- RETURN
- 998 WRITE(*,*) 'IHPVIE: error in eye point'
- IREP =-2
- END
diff --git a/src/graflib/higz/ih/ihrcle.F b/src/graflib/higz/ih/ihrcle.F
deleted file mode 100644
index 3f32df0..0000000
--- a/src/graflib/higz/ih/ihrcle.F
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: ihrcle.F,v 1.1.1.1 1996/02/14 13:10:53 mclareni Exp $
-*
-* $Log: ihrcle.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:53 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.18/05 26/05/93 17.59.17 by O.Couet
-*-- Author :
- SUBROUTINE IHRCLE()
-************************************************************************
-* *
-* IHRCLE Date: 16.05.93 *
-* Author: E. Chernyaev (IHEP/Protvino) Revised: *
-* *
-* Function: Clear screen ("RASTER SCREEN") *
-* *
-************************************************************************
-#include "higz/hcrast.inc"
-*-
- NW = (NXRAST*NYRAST + NBW - 1) / NBW
- DO 200 I=1,NW
- IRAST(JRAST+I) = 0
- 200 CONTINUE
- IFRAST = 1
- RETURN
- END
diff --git a/src/graflib/higz/ih/ihrfil.F b/src/graflib/higz/ih/ihrfil.F
deleted file mode 100644
index 8211b6d..0000000
--- a/src/graflib/higz/ih/ihrfil.F
+++ /dev/null
@@ -1,246 +0,0 @@
-*
-* $Id: ihrfil.F,v 1.1.1.1 1996/02/14 13:10:53 mclareni Exp $
-*
-* $Log: ihrfil.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:53 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.18/05 26/05/93 17.59.17 by O.Couet
-*-- Author :
- SUBROUTINE IHRFIL(NN,XY)
-************************************************************************
-* *
-* IHRFIL Date: 14.05.93 *
-* Author: E. Chernyaev (IHEP/Protvino) Revised: *
-* *
-* Function: Fill a polygon including border ("RASTER SCREEN") *
-* *
-* Input: NN - number of polygon nodes *
-* XY(2,*) - polygon nodes *
-* *
-************************************************************************
-#include "higz/hcrast.inc"
- PARAMETER (LMAX=12)
- REAL XY(2,*)
- INTEGER YMIN,YMAX,X,Y,XX,YY,DX,DY,SIGNDX,T,STEP,YSCAN
- INTEGER XX1,XX2
- INTEGER X1(LMAX+2),Y1(LMAX+2),X2(LMAX),Y2(LMAX)
- INTEGER XCUR(LMAX),XNEX(LMAX),TEST(LMAX),XSCAN(2,LMAX)
-*-
-** T R A N S F E R T O S C R E E N C O O R D I N A T E S
-*
- IF (IFRAST .NE. 1) GOTO 999
- N = NN
- DO 100 I=1,N
- X1(I) = NXRAST * ((XY(1,I)-XRAST)/DXRAST) - 0.01
- Y1(I) = NYRAST * ((XY(2,I)-YRAST)/DYRAST) - 0.01
- 100 CONTINUE
- X1(N+1) = X1(1)
- Y1(N+1) = Y1(1)
-*
-** F I N D Y - M I N A N D Y - M A X
-** S E T R I G H T E D G E O R I E N T A T I O N
-*
- YMIN = Y1(1)
- YMAX = Y1(1)
- DO 200 I=1,N
- IF (YMIN .GT. Y1(I)) YMIN = Y1(I)
- IF (YMAX .LT. Y1(I)) YMAX = Y1(I)
- IF (Y1(I) .LE. Y1(I+1)) THEN
- X2(I) = X1(I+1)
- Y2(I) = Y1(I+1)
- ELSE
- X2(I) = X1(I)
- Y2(I) = Y1(I)
- X1(I) = X1(I+1)
- Y1(I) = Y1(I+1)
- END IF
- 200 CONTINUE
- IF (YMIN .GE. NYRAST) GOTO 999
- IF (YMAX .LT. 0) GOTO 999
- IF (YMAX .GE. NYRAST) YMAX = NYRAST - 1
-*
-** S O R T L I N E S
-*
- DO 250 I=1,N-1
- IF (Y1(I+1) .GE. Y1(I)) GOTO 250
- Y = Y1(I+1)
- K = 1
- DO 210 J=I-1,1,-1
- IF (Y .LT. Y1(J)) GOTO 210
- K = J + 1
- GOTO 220
- 210 CONTINUE
- 220 X = X1(I+1)
- XX = X2(I+1)
- YY = Y2(I+1)
- DO 230 J=I,K,-1
- X1(J+1) = X1(J)
- Y1(J+1) = Y1(J)
- X2(J+1) = X2(J)
- Y2(J+1) = Y2(J)
- 230 CONTINUE
- X1(K) = X
- Y1(K) = Y
- X2(K) = XX
- Y2(K) = YY
- 250 CONTINUE
-*
-** S E T I N I T I A L V A L U E S
-*
- DO 300 I=1,N
- XCUR(I) = X1(I)
- DY = Y2(I) - Y1(I)
- DX = X2(I) - X1(I)
- SIGNDX = 1
- IF (DX .LT. 0) SIGNDX =-1
- IF (DX .LT. 0) DX =-DX
- IF (DX .LE. DY) THEN
- T =-(DY+1)/2 + DX
- IF (T .LT. 0) THEN
- TEST(I) = T
- XNEX(I) = XCUR(I)
- ELSE
- TEST(I) = T - DY
- XNEX(I) = XCUR(I) + SIGNDX
- END IF
- ELSE IF (DY .NE. 0) THEN
- STEP = (DX-1)/(DY+DY) + 1
- TEST(I) = STEP*DY - (DX+1)/2 - DX
- XNEX(I) = XCUR(I) + SIGNDX*STEP
- END IF
- 300 CONTINUE
-*
-** L O O P O N S C A N L I N E S
-*
- NSTART = 1
- DO 700 YSCAN=YMIN,YMAX
- NX = 0
- NXA = 0
- NXB = LMAX + 1
- DO 440 I=NSTART,N
- IF (Y1(I) .GT. YSCAN) GOTO 500
- IF (Y2(I) .GT. YSCAN) GOTO 410
- IF (I .EQ. NSTART) NSTART = NSTART + 1
- IF (Y2(I) .NE. YSCAN) GOTO 440
- NXB = NXB - 1
- IF (X2(I) .GE. XCUR(I)) THEN
- XSCAN(1,NXB) = XCUR(I)
- XSCAN(2,NXB) = X2(I)
- ELSE
- XSCAN(1,NXB) = X2(I)
- XSCAN(2,NXB) = XCUR(I)
- END IF
- GOTO 440
-*
-** S T O R E C U R R E N T X
-** P R E P A R E X F O R N E X T S C A N - L I N E
-*
- 410 NXA = NXA + 1
- DY = Y2(I) - Y1(I)
- DX = X2(I) - X1(I)
- IF (DX .GE. 0) THEN
- SIGNDX = 1
- XSCAN(1,NXA) = XCUR(I)
- XSCAN(2,NXA) = XNEX(I)
- IF(XSCAN(1,NXA).NE.XSCAN(2,NXA)) XSCAN(2,NXA)=XSCAN(2,NXA)-1
- ELSE
- DX =-DX
- SIGNDX =-1
- XSCAN(1,NXA) = XNEX(I)
- XSCAN(2,NXA) = XCUR(I)
- IF(XSCAN(1,NXA).NE.XSCAN(2,NXA)) XSCAN(1,NXA)=XSCAN(1,NXA)+1
- END IF
- XCUR(I) = XNEX(I)
- IF (DX .GT. DY) GOTO 430
- TEST(I) = TEST(I) + DX
- IF (TEST(I) .LT. 0) GOTO 440
- TEST(I) = TEST(I) - DY
- XNEX(I) = XNEX(I) + SIGNDX
- GOTO 440
- 430 STEP = DX/DY
- T = TEST(I) + STEP*DY
- IF (T .GE. 0) THEN
- TEST(I) = T - DX
- XNEX(I) = XNEX(I) + SIGNDX*STEP
- ELSE
- TEST(I) = T + DY - DX
- XNEX(I) = XNEX(I) + SIGNDX*(STEP+1)
- END IF
- 440 CONTINUE
-*
-** S O R T P O I N T S A L O N G X
-*
- 500 IF (YSCAN .LT. 0) GOTO 700
- IBASE = YSCAN*NXRAST
- IF (NXA .LT. 2) GOTO 540
- DO 520 I=1,NXA-1
- DO 510 J=I,1,-1
- IF (XSCAN(1,J+1) .GE. XSCAN(1,J)) GOTO 520
- X = XSCAN(1,J+1)
- XSCAN(1,J+1) = XSCAN(1,J)
- XSCAN(1,J) = X
- X = XSCAN(2,J+1)
- XSCAN(2,J+1) = XSCAN(2,J)
- XSCAN(2,J) = X
- 510 CONTINUE
- 520 CONTINUE
- DO 530 I=1,NXA,2
- NX = NX + 1
- XSCAN(1,NX) = XSCAN(1,I)
- X = XSCAN(2,I+1)
- IF (XSCAN(2,I) .GT. X) X = XSCAN(2,I)
- XSCAN(2,NX) = X
- 530 CONTINUE
-*
- 540 IF (NXB .GT. LMAX) GOTO 600
- DO 550 I=NXB,LMAX,1
- NX = NX + 1
- XSCAN(1,NX) = XSCAN(1,I)
- XSCAN(2,NX) = XSCAN(2,I)
- 550 CONTINUE
-*
-** C O N C A N T I N A T E A N D F I L L
-*
- 600 IF (NX .EQ. 0) GOTO 700
- XX1 = XSCAN(1,NX)
- XX2 = XSCAN(2,NX)
- NX = NX - 1
- K = 1
- 610 IF (K .GT. NX) GOTO 630
- IF (XSCAN(1,K) .GT. XX2+1) GOTO 620
- IF (XSCAN(2,K) .LT. XX1-1) GOTO 620
- IF (XSCAN(1,K) .LT. XX1) XX1 = XSCAN(1,K)
- IF (XSCAN(2,K) .GT. XX2) XX2 = XSCAN(2,K)
- XSCAN(1,K) = XSCAN(1,NX)
- XSCAN(2,K) = XSCAN(2,NX)
- NX = NX - 1
- GOTO 610
- 620 K = K + 1
- GOTO 610
- 630 IF (XX1 .LT. 0) XX1 = 0
- IF (XX2 .GE. NXRAST) XX2 = NXRAST - 1
- NBIT = XX2 - XX1 + 1
- KBIT = IBASE + XX1
- IW = KBIT / NBW
- IB = KBIT - IW*NBW + 1
- IW = IW + JRAST + 1
- NB = NBW - IB + 1
- IF (NB .GT. NBIT) NB = NBIT
- IRAST(IW) = IOR(IRAST(IW),MASK(JMASK(NB)+IB))
- NBIT = NBIT - NB
- IF (NBIT .EQ. 0) GOTO 600
- DO 640 WHILE (NBIT .GT. NBW)
- IW = IW + 1
- IRAST(IW) = MASK(LMASK)
- NBIT = NBIT - NBW
- 640 CONTINUE
- IW = IW + 1
- IRAST(IW) = IOR(IRAST(IW),MASK(JMASK(NBIT)+1))
- GOTO 600
- 700 CONTINUE
-*
- 999 RETURN
- END
diff --git a/src/graflib/higz/ih/ihrini.F b/src/graflib/higz/ih/ihrini.F
deleted file mode 100644
index 2d6c6a0..0000000
--- a/src/graflib/higz/ih/ihrini.F
+++ /dev/null
@@ -1,67 +0,0 @@
-*
-* $Id: ihrini.F,v 1.1.1.1 1996/02/14 13:10:53 mclareni Exp $
-*
-* $Log: ihrini.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:53 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.18/06 27/05/93 15.47.54 by O.Couet
-*-- Author :
- SUBROUTINE IHRINI(XMIN,YMIN,XMAX,YMAX,NX,NY,IBUF)
-************************************************************************
-* *
-* IHRINI Date: 14.05.93 *
-* Author: E. Chernyaev (IHEP/Protvino) Revised: *
-* *
-* Function: Initialise hidden lines removal algorithm *
-* "RASTER SCREEN" *
-* *
-* References: IHRCLE *
-* *
-* Input: XMIN - Xmin in the normalized coordinate system *
-* YMIN - Ymin in the normalized coordinate system *
-* XMAX - Xmax in the normalized coordinate system *
-* YMAX - Ymax in the normalized coordinate system *
-* NX - number of pixels along X *
-* NY - number of pixels along Y *
-* IBUF(NX*NY/4) - buffer for raster *
-* *
-************************************************************************
-#include "higz/hcrast.inc"
- INTEGER IBUF(*)
-*-
- NXRAST = NX
- NYRAST = NY
- XRAST = XMIN
- DXRAST = XMAX - XMIN
- YRAST = YMIN
- DYRAST = YMAX - YMIN
- JRAST = LOCF(IBUF(1)) - LOCF(IRAST(1))
-*
-** S E T M A S K S
-*
- K = 0
- DO 100 I=1,NBW
- JMASK(I) = K
- K = K + NBW - I + 1
- MASK(I) = 2**(I-1)
- 100 CONTINUE
- J = NBW
- DO 130 NB=2,NBW
- DO 120 IB=1,NBW-NB+1
- K = 0
- DO 110 I=IB,IB+NB-1
- K = IOR(K,MASK(I))
- 110 CONTINUE
- J = J + 1
- MASK(J) = K
- 120 CONTINUE
- 130 CONTINUE
-*
-** C L E A R R A S T E R S C R E E N
-*
- CALL IHRCLE()
- RETURN
- END
diff --git a/src/graflib/higz/ih/ihrlin.F b/src/graflib/higz/ih/ihrlin.F
deleted file mode 100644
index b1e8ebc..0000000
--- a/src/graflib/higz/ih/ihrlin.F
+++ /dev/null
@@ -1,166 +0,0 @@
-*
-* $Id: ihrlin.F,v 1.1.1.1 1996/02/14 13:10:53 mclareni Exp $
-*
-* $Log: ihrlin.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:53 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.18/05 26/05/93 17.59.17 by O.Couet
-*-- Author :
- SUBROUTINE IHRLIN(P1,P2,NTMAX,NT,T)
-************************************************************************
-* *
-* IHRLIN Date: 14.05.93 *
-* Author: E. Chernyaev (IHEP/Protvino) Revised: *
-* *
-* Function: Find visible part of a line ("RASTER SCREEN") *
-* *
-* Input: P1(2) - 1st point of the line *
-* P2(2) - 2nd point of the line *
-* NTMAX - max allowed number of visible segments *
-* *
-* Output: NT - number of visible segments of the line *
-* T(2,*) - visible segments *
-* *
-************************************************************************
-#include "higz/hcrast.inc"
- REAL P1(2),P2(2),T(2,*)
- INTEGER X1,Y1,X2,Y2,DX,DY,DX2,DY2
-*-
- IF (IFRAST .NE. 1) THEN
- NT = 1
- T(1,1) = 0.
- T(2,1) = 1.
- GOTO 999
- END IF
- X1 = NXRAST * ((P1(1)-XRAST)/DXRAST) - 0.01
- Y1 = NYRAST * ((P1(2)-YRAST)/DYRAST) - 0.01
- X2 = NXRAST * ((P2(1)-XRAST)/DXRAST) - 0.01
- Y2 = NYRAST * ((P2(2)-YRAST)/DYRAST) - 0.01
- IFINVE = 0
- IF (Y1 .GT. Y2) THEN
- IFINVE = 1
- IW = X1
- X1 = X2
- X2 = IW
- IW = Y1
- Y1 = Y2
- Y2 = IW
- END IF
- NT = 0
- IVIS = 0
- IF (Y1 .GE. NYRAST) GOTO 999
- IF (Y2 .LT. 0) GOTO 999
- IF (X1.GE.NXRAST .AND. X2.GE.NXRAST) GOTO 999
- IF (X1.LT.0 .AND. X2.LT.0) GOTO 999
-*
-** S E T I N I T I A L V A L U E S
-*
- INCRX =+1
- DX = X2 - X1
- IF (DX .LT. 0) THEN
- DX =-DX
- INCRX =-1
- END IF
- DY = Y2 - Y1
- DX2 = DX + DX
- DY2 = DY + DY
- IF (DY .GT. DX) GOTO 200
-*
-** D X . G T . D Y
-*
- DT = 1. / (DX+1)
- DDTT = 0.5*DT
- TCUR =-DT
- TT =-(DX + DY2)
- IY = Y1
- KB = IY*NXRAST + X1 - INCRX
- DO 120 IX=X1,X2,INCRX
- KB = KB + INCRX
- TCUR = TCUR + DT
- TT = TT + DY2
- IF (TT .GE. 0) THEN
- IY = IY + 1
- TT = TT - DX2
- KB = KB + NXRAST
- END IF
- IF (IY .LT. 0) GOTO 110
- IF (IY .GE. NYRAST) GOTO 110
- IF (IX .LT. 0) GOTO 110
- IF (IX .GE. NXRAST) GOTO 110
- IW = KB / NBW
- IB = KB - IW*NBW + 1
- IF(IAND(IRAST(JRAST+IW+1),MASK(IB)) .NE. 0) GOTO 110
- IF (IVIS .GT. 0) GOTO 120
- IVIS = 1
- NT = NT + 1
-* T(1,NT)= TCUR - DDTT
- T(1,NT)= TCUR
- GOTO 120
- 110 IF (IVIS .EQ. 0) GOTO 120
- IVIS = 0
-* T(2,NT)= TCUR + DDTT
- T(2,NT)= TCUR
- IF (NT .EQ. NTMAX) GOTO 300
- 120 CONTINUE
- IF (IVIS .GT. 0) T(2,NT)= TCUR + DT + DDTT
- GOTO 300
-*
-** D Y . G T . D X
-*
- 200 DT = 1. / (DY+1)
- DDTT = 0.5*DT
- TCUR =-DT
- TT =-(DY + DX2)
- IX = X1
- IF (Y2 .GE. NYRAST) Y2 = NYRAST - 1
- KB = (Y1-1)*NXRAST + IX
- DO 220 IY=Y1,Y2
- KB = KB + NXRAST
- TCUR = TCUR + DT
- TT = TT + DX2
- IF (TT .GE. 0) THEN
- IX = IX + INCRX
- TT = TT - DY2
- KB = KB + INCRX
- END IF
- IF (IY .LT. 0) GOTO 210
- IF (IX .LT. 0) GOTO 210
- IF (IX .GE. NXRAST) GOTO 210
- IW = KB / NBW
- IB = KB - IW*NBW + 1
- IF (IAND(IRAST(JRAST+IW+1),MASK(IB)) .NE. 0) GOTO 210
- IF (IVIS .GT. 0) GOTO 220
- IVIS = 1
- NT = NT + 1
-* T(1,NT)= TCUR - DDTT
- T(1,NT)= TCUR
- GOTO 220
- 210 IF (IVIS .EQ. 0) GOTO 220
- IVIS = 0
-* T(2,NT)= TCUR + DDTT
- T(2,NT)= TCUR
- IF (NT .EQ. NTMAX) GOTO 300
- 220 CONTINUE
- IF (IVIS .GT. 0) T(2,NT)= TCUR + DT
- GOTO 300
-*
-** C H E C K D I R E C T I O N O F P A R A M E T E R
-*
- 300 IF (NT .EQ. 0) GOTO 999
- DT = DT*1.1
- IF (T(1,1) .LE. DT) T(1,1) = 0.
- IF (T(2,NT) .GE. 1.-DT) T(2,NT) = 1.
- IF (IFINVE .EQ. 0) GOTO 999
- DO 310 I=1,NT
- T1 = T(1,I)
- T2 = T(2,I)
- T(1,I) = 1. - T2
- T(2,I) = 1. - T1
- 310 CONTINUE
- GOTO 999
-*
- 999 RETURN
- END
diff --git a/src/graflib/higz/ih/ihroff.F b/src/graflib/higz/ih/ihroff.F
deleted file mode 100644
index 63b1f60..0000000
--- a/src/graflib/higz/ih/ihroff.F
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: ihroff.F,v 1.1.1.1 1996/02/14 13:10:53 mclareni Exp $
-*
-* $Log: ihroff.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:53 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.19/05 26/08/93 09.53.55 by O.Couet
-*-- Author :
- SUBROUTINE IHROFF()
-************************************************************************
-* *
-* IHROFF Date: 16.05.93 *
-* Author: E. Chernyaev (IHEP/Protvino) Revised: *
-* *
-* Function: Switch OFF "RASTER SCREEN" algorithm *
-* *
-************************************************************************
-#include "higz/hcrast.inc"
-*-
- IFRAST = 0
- END
diff --git a/src/graflib/higz/ih/ihsdrl.F b/src/graflib/higz/ih/ihsdrl.F
deleted file mode 100644
index 0b24740..0000000
--- a/src/graflib/higz/ih/ihsdrl.F
+++ /dev/null
@@ -1,152 +0,0 @@
-*
-* $Id: ihsdrl.F,v 1.1.1.1 1996/02/14 13:10:53 mclareni Exp $
-*
-* $Log: ihsdrl.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:53 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.20/06 05/01/94 17.53.24 by O.Couet
-*-- Author :
- SUBROUTINE IHSDRL(R1,R2)
-************************************************************************
-* *
-* IHSDRL Date: 06.08.90 *
-* Author: E. Chernyaev (IHEP/Protvino) Revised: 13.09.90 *
-* 10.01.92 *
-* 06.11.92 *
-* Function: Find visible parts of line (draw line) *
-* *
-* Input: R1(3) - 1-st point of the line *
-* R2(3) - 2-nd point of the line *
-* *
-************************************************************************
-#include "higz/hcscrn.inc"
- REAL R1(3),R2(3)
-*-
- X1 = TN(1,1)*R1(1)+TN(2,1)*R1(2)+TN(3,1)*R1(3)+TN(4,1)
- X2 = TN(1,1)*R2(1)+TN(2,1)*R2(2)+TN(3,1)*R2(3)+TN(4,1)
- Y1 = TN(1,2)*R1(1)+TN(2,2)*R1(2)+TN(3,2)*R1(3)+TN(4,2)
- Y2 = TN(1,2)*R2(1)+TN(2,2)*R2(2)+TN(3,2)*R2(3)+TN(4,2)
- Z1 = TN(1,3)*R1(1)+TN(2,3)*R1(2)+TN(3,3)*R1(3)+TN(4,3)
- Z2 = TN(1,3)*R2(1)+TN(2,3)*R2(2)+TN(3,3)*R2(3)+TN(4,3)
- IFBACK = 0
- IF (X1 .LT. X2) GOTO 10
- IFBACK = 1
- WW = X1
- X1 = X2
- X2 = WW
- WW = Y1
- Y1 = Y2
- Y2 = WW
- WW = Z1
- Z1 = Z2
- Z2 = WW
- 10 NT = 0
- I1 = (X1-X0)/DX + 1.5
- I2 = (X2-X0)/DX + 1.5
- X1 = X0 + (I1-1)*DX
- X2 = X0 + (I2-1)*DX
- IF (I1 .EQ. I2) GOTO 140
-*
-** F I N D V I S I B L E P A R T S O F T H E L I N E
-*
- DI = I2 - I1
- DY = (Y2-Y1) / DI
- DT = 1. / DI
- IV =-1
- DO 120 I=I1,I2-1
- YY1 = Y1 + DY*(I-I1)
- YY2 = YY1 + DY
- YY1U = YY1 - U(1,I)
- YY1D = YY1 - D(1,I)
- YY2U = YY2 - U(2,I)
- YY2D = YY2 - D(2,I)
- TT = DT*(I-I1)
-* A N A L I S E L E F T S I D E
- ICASE1 = 1
- IF (YY1U .GT. 0.) ICASE1 = 0
- IF (YY1D .LT. 0.) ICASE1 = 2
- GOTO (20 ,30 ,20 ), ICASE1+1
- 20 IF (IV .GT. 0) GOTO 40
- IV = +1
- NT = NT + 1
- T(1,NT) = TT
- GOTO 40
- 30 IF (IV .LT. 0) GOTO 40
- IV = -1
- T(2,NT) = TT
- GOTO 40
-* A N A L I S E R I G H T S I D E
- 40 ICASE2 = 1
- IF (YY2U .GT. 0.) ICASE2 = 0
- IF (YY2D .LT. 0.) ICASE2 = 2
- ICASE = ICASE1*3 + ICASE2
- GOTO (110,50 ,60 , 70 ,110,80 , 90 ,100,110), ICASE+1
- 50 IV = -1
- T(2,NT) = TT + DT*(YY1U/(YY1U-YY2U))
- GOTO 110
- 60 T(2,NT) = TT + DT*(YY1U/(YY1U-YY2U))
- NT = NT + 1
- T(1,NT) = TT + DT*(YY1D/(YY1D-YY2D))
- GOTO 110
- 70 IV = +1
- NT = NT + 1
- T(1,NT) = TT + DT*(YY1U/(YY1U-YY2U))
- GOTO 110
- 80 IV = +1
- NT = NT + 1
- T(1,NT) = TT + DT*(YY1D/(YY1D-YY2D))
- GOTO 110
- 90 T(2,NT) = TT + DT*(YY1D/(YY1D-YY2D))
- NT = NT + 1
- T(1,NT) = TT + DT*(YY1U/(YY1U-YY2U))
- GOTO 110
- 100 IV = -1
- T(2,NT) = TT + DT*(YY1D/(YY1D-YY2D))
- GOTO 110
- 110 IF (NT+1 .GE. NTMAX) GOTO 130
- 120 CONTINUE
- 130 IF (IV .GT. 0) T(2,NT) = 1.
- GOTO 180
-*
-** V E R T I C A L L I N E
-*
- 140 NT = 1
- T(1,1) = 0.
- T(2,1) = 1.
- IF (Y2 .GT. Y1) GOTO 150
- IF (Y2 .EQ. Y1) GOTO 200
- IFBACK = 1 - IFBACK
- YY = Y1
- Y1 = Y2
- Y2 = YY
- 150 UU = U(1,I1)
- DD = D(1,I1)
- IF (I1 .EQ. 1) GOTO 160
- IF (UU .LT. U(2,I1-1)) UU = U(2,I1-1)
- IF (DD .GT. D(2,I1-1)) DD = D(2,I1-1)
-* F I N D V I S I B L E P A R T O F L I N E
- 160 IF (Y1.GE.UU .OR. Y2.LE.DD) GOTO 180
- IF (Y1.GE.DD .AND. Y2.LE.UU) GOTO 200
- NT = 0
- IF (DD .LE. Y1) GOTO 170
- NT = NT + 1
- T(1,NT)= 0.
- T(2,NT)= (DD-Y1) / (Y2-Y1)
- 170 IF (UU .GE. Y2) GOTO 180
- NT = NT + 1
- T(1,NT)= (UU-Y1) / (Y2-Y1)
- T(2,NT)= 1.
-*
- 180 IF (IFBACK .EQ. 0) RETURN
- IF (NT .EQ. 0) RETURN
- DO 190 I=1,NT
- T(1,I) = 1. - T(1,I)
- T(2,I) = 1. - T(2,I)
- 190 CONTINUE
- RETURN
-*
- 200 NT = 0
- END
diff --git a/src/graflib/higz/ih/ihsini.F b/src/graflib/higz/ih/ihsini.F
deleted file mode 100644
index c3f9b2b..0000000
--- a/src/graflib/higz/ih/ihsini.F
+++ /dev/null
@@ -1,35 +0,0 @@
-*
-* $Id: ihsini.F,v 1.1.1.1 1996/02/14 13:10:53 mclareni Exp $
-*
-* $Log: ihsini.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:53 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.14/00 19/02/92 10.16.08 by O.Couet
-*-- Author :
- SUBROUTINE IHSINI(XMIN,XMAX)
-************************************************************************
-* *
-* IHSINI Date: 07.08.90 *
-* Author: E. Chernyaev (IHEP/Protvino) Revised: *
-* *
-* Function: Initialise "MOVING SCREEN" method *
-* *
-* Input: XMIN - left boundary *
-* XMAX - right boundary *
-* *
-************************************************************************
-#include "higz/hcscrn.inc"
-*-
- X0 = XMIN
- DX = (XMAX-XMIN) / NSLIC
- DO 100 I=1,NSLIC
- U(1,I) =-999.
- U(2,I) =-999.
- D(1,I) =+999.
- D(2,I) =+999.
- 100 CONTINUE
- RETURN
- END
diff --git a/src/graflib/higz/ih/ihsmdf.F b/src/graflib/higz/ih/ihsmdf.F
deleted file mode 100644
index 8f45fd1..0000000
--- a/src/graflib/higz/ih/ihsmdf.F
+++ /dev/null
@@ -1,55 +0,0 @@
-*
-* $Id: ihsmdf.F,v 1.1.1.1 1996/02/14 13:10:53 mclareni Exp $
-*
-* $Log: ihsmdf.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:53 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.14/00 19/02/92 10.16.08 by O.Couet
-*-- Author :
- SUBROUTINE IHSMDF(R1,R2)
-************************************************************************
-* *
-* IHSMDF Date: 07.08.90 *
-* Author: E. Chernyaev (IHEP/Protvino) Revised: *
-* *
-* Function: Modify SCREEN *
-* *
-* Input: R1(3) - 1-st point of the line *
-* R2(3) - 2-nd point of the line *
-* *
-************************************************************************
-#include "higz/hcscrn.inc"
- REAL R1(3),R2(3)
-*-
- X1 = TN(1,1)*R1(1)+TN(2,1)*R1(2)+TN(3,1)*R1(3)+TN(4,1)
- X2 = TN(1,1)*R2(1)+TN(2,1)*R2(2)+TN(3,1)*R2(3)+TN(4,1)
- Y1 = TN(1,2)*R1(1)+TN(2,2)*R1(2)+TN(3,2)*R1(3)+TN(4,2)
- Y2 = TN(1,2)*R2(1)+TN(2,2)*R2(2)+TN(3,2)*R2(3)+TN(4,2)
- IF (X1 .LT. X2) GOTO 100
- WW = X1
- X1 = X2
- X2 = WW
- WW = Y1
- Y1 = Y2
- Y2 = WW
- 100 I1 = (X1-X0)/DX + 1.5
- I2 = (X2-X0)/DX + 1.5
- IF (I1 .EQ. I2) GOTO 999
-*
-** M O D I F Y B O U N D A R I E S OF THE SCREEN
-*
- DY = (Y2-Y1) / (I2-I1)
- DO 200 I=I1,I2-1
- YY1 = Y1 + DY*(I-I1)
- YY2 = YY1 + DY
- IF (D(1,I) .GT. YY1) D(1,I) = YY1
- IF (D(2,I) .GT. YY2) D(2,I) = YY2
- IF (U(1,I) .LT. YY1) U(1,I) = YY1
- IF (U(2,I) .LT. YY2) U(2,I) = YY2
- 200 CONTINUE
-*
- 999 RETURN
- END
diff --git a/src/graflib/higz/ih/ihsurc.F b/src/graflib/higz/ih/ihsurc.F
deleted file mode 100644
index 08492a6..0000000
--- a/src/graflib/higz/ih/ihsurc.F
+++ /dev/null
@@ -1,93 +0,0 @@
-*
-* $Id: ihsurc.F,v 1.1.1.1 1996/02/14 13:10:54 mclareni Exp $
-*
-* $Log: ihsurc.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:54 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.18/00 20/04/93 14.20.34 by O.Couet
-*-- Author :
- SUBROUTINE IHSURC(ANG,NX,NY,FUN,DRFACE,CHOPT)
-************************************************************************
-* *
-* IHSURC Date: 10.01.92 *
-* Author: E. Chernyaev (IHEP/Protvino) Revised: *
-* *
-* Function: Draw surface in cartesian coordinate system *
-* *
-* Input: ANG - angle between X ang Y *
-* NX - number of steps along X *
-* NY - number of steps along Y *
-* *
-* FUN(IX,IY,F,T) - external routine *
-* IX - X number of the cell *
-* IY - Y number of the cell *
-* F(3,4) - face which corresponds to the cell *
-* T(4) - additional function (for example: temperature) *
-* *
-* DRFACE(ICODES,XYZ,NP,IFACE,T) - routine for face drawing *
-* ICODES(*) - set of codes for this face *
-* ICODES(1) - IX *
-* ICODES(2) - IY *
-* NP - number of nodes in face *
-* IFACE(NP) - face *
-* T(NP) - additional function *
-* *
-* CHOPT - options: 'BF' - from BACK to FRONT *
-* 'FB' - from FRONT to BACK *
-* *
-************************************************************************
-#include "higz/hcscrn.inc"
- REAL F(3,4),XYZ(3,4),TT(4)
- INTEGER IFACE(4),ICODES(2)
- CHARACTER*(*) CHOPT
- EXTERNAL FUN,DRFACE
- DATA IFACE/1,2,3,4/
-*-
- RAD = ATAN(1.)*4./180.
- SINA = SIN(ANG*RAD)
- COSA = COS(ANG*RAD)
-*
-** F I N D T H E M O S T L E F T P O I N T
-*
- I1 = 1
- IF (TN(1,1) .LT. 0.) I1 = 2
- IF (TN(1,1)*COSA+TN(2,1)*SINA .LT. 0.) I1 = 5 - I1
-*
-** D E F I N E O R D E R O F D R A W I N G
-*
- IF (CHOPT(1:1).EQ.'B' .OR. CHOPT(1:1).EQ.'b') THEN
- INCRX =-1
- INCRY =-1
- ELSE
- INCRX =+1
- INCRY =+1
- END IF
- IF (I1.EQ.1 .OR. I1.EQ.2) INCRX =-INCRX
- IF (I1.EQ.2 .OR. I1.EQ.3) INCRY =-INCRY
- IX1 = 1
- IY1 = 1
- IF (INCRX .LT. 0) IX1 = NX
- IF (INCRY .LT. 0) IY1 = NY
- IX2 = NX - IX1 + 1
- IY2 = NY - IY1 + 1
-*
-** D R A W S U R F A C E
-*
- DO 120 IY=IY1,IY2,INCRY
- DO 110 IX=IX1,IX2,INCRX
- CALL FUN(IX,IY,F,TT)
- DO 100 I=1,4
- XYZ(1,I) = F(1,I) + F(2,I)*COSA
- XYZ(2,I) = F(2,I)*SINA
- XYZ(3,I) = F(3,I)
- 100 CONTINUE
- ICODES(1)= IX
- ICODES(2)= IY
- CALL DRFACE(ICODES,XYZ,4,IFACE,TT)
- 110 CONTINUE
- 120 CONTINUE
- RETURN
- END
diff --git a/src/graflib/higz/ih/ihsurp.F b/src/graflib/higz/ih/ihsurp.F
deleted file mode 100644
index 905ac25..0000000
--- a/src/graflib/higz/ih/ihsurp.F
+++ /dev/null
@@ -1,142 +0,0 @@
-*
-* $Id: ihsurp.F,v 1.1.1.1 1996/02/14 13:10:54 mclareni Exp $
-*
-* $Log: ihsurp.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:54 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.18/01 04/05/93 14.37.57 by O.Couet
-*-- Author :
- SUBROUTINE IHSURP(IORDR,NA,NB,FUN,DRFACE,CHOPT)
-************************************************************************
-* *
-* IHSURP Date: 06.10.90 *
-* Author: E. Chernyaev (IHEP/Protvino) Revised: 26.03.93 *
-* *
-* Function: Draw surface in polar coordinates *
-* *
-* References: IHWPHI, IHWZN *
-* *
-* Input: IORDR - order of variables (0 - R,PHI, 1 - PHI,R) *
-* NA - number of steps along 1st variable *
-* NB - number of steps along 2nd variable *
-* *
-* FUN(IA,IB,F,T) - external routine *
-* IA - cell number for 1st variable *
-* IB - cell number for 2nd variable *
-* F(3,4) - face which corresponds to the cell *
-* F(1,*) - A *
-* F(2,*) - B *
-* F(3,*) - Z *
-* T(4) - additional function (for example: temperature) *
-* *
-* DRFACE(ICODES,XYZ,NP,IFACE,T) - routine for face drawing *
-* ICODES(*) - set of codes for this face *
-* ICODES(1) - IA *
-* ICODES(2) - IB *
-* XYZ(3,*) - coordinates of nodes *
-* NP - number of nodes in face *
-* IFACE(NP) - face *
-* T(NP) - additional function *
-* *
-* CHOPT - options: 'BF' - from BACK to FRONT *
-* 'FB' - from FRONT to BACK *
-* *
-************************************************************************
-#include "higz/hcphi.inc"
- REAL F(3,4),XYZ(3,4),TT(4),TTT(4)
- INTEGER IFACE(4),ICODES(2)
- CHARACTER*(*) CHOPT
- EXTERNAL FUN,DRFACE
- DATA IFACE/1,2,3,4/
-*-
- IF (IORDR .EQ. 0) THEN
- JR = 1
- JPHI = 2
- NR = NA
- NPHI = NB
- ELSE
- JR = 2
- JPHI = 1
- NR = NB
- NPHI = NA
- END IF
- IF (NPHI .GT. NPMAX) GOTO 998
- RAD = ATAN(1.)*4./180.
- IOPT = 2
- IF (CHOPT(1:1).EQ.'B' .OR. CHOPT(1:1).EQ.'b') IOPT = 1
-*
-** P R E P A R E P H I A R R A Y
-** F I N D C R I T I C A L S E C T O R S
-*
- KPHI = NPHI
- IF (IORDR .EQ. 0) IA = NR
- IF (IORDR .NE. 0) IB = NR
- DO 10 I=1,NPHI
- IF (IORDR .EQ. 0) IB = I
- IF (IORDR .NE. 0) IA = I
- CALL FUN(IA,IB,F,TT)
- IF (I .EQ. 1) APHI(1) = F(JPHI,1)
- APHI(I) = (APHI(I) + F(JPHI,1))/2.
- APHI(I+1) = F(JPHI,3)
- 10 CONTINUE
- CALL IHWPHI(IOPT,KPHI,APHI,IPHI1,IPHI2)
-*
-** D R A W S U R F A C E
-*
- INCR = 1
- IPHI = IPHI1
- 100 IF (IPHI .GT. NPHI) GOTO 300
-* F I N D O R D E R A L O N G R
- IF (IORDR .EQ. 0) THEN
- IA = NR
- IB = IPHI
- ELSE
- IA = IPHI
- IB = NR
- END IF
- CALL FUN(IA,IB,F,TT)
- PHI = RAD * ((F(JPHI,1) + F(JPHI,3))/2.)
- CALL IHWZN(COS(PHI),SIN(PHI),0.,Z)
- INCRR = 1
- IR1 = 1
- IF ((Z.LE.0. .AND. IOPT.EQ.1) .OR. (Z.GT.0. .AND. IOPT.EQ.2)) THEN
- INCRR =-1
- IR1 = NR
- END IF
- IR2 = NR - IR1 + 1
-* D R A W S U R F A C E F O R S E C T O R
- DO 200 IR=IR1,IR2,INCRR
- IF (IORDR .EQ. 0) IA = IR
- IF (IORDR .NE. 0) IB = IR
- CALL FUN(IA,IB,F,TT)
- DO 210 I=1,4
- J = I
- IF (IORDR.NE.0 .AND. I.EQ.2) J = 4
- IF (IORDR.NE.0 .AND. I.EQ.4) J = 2
- XYZ(1,J) = F(JR,I)*COS(F(JPHI,I)*RAD)
- XYZ(2,J) = F(JR,I)*SIN(F(JPHI,I)*RAD)
- XYZ(3,J) = F(3,I)
- TTT(J) = TT(I)
- 210 CONTINUE
- ICODES(1) = IA
- ICODES(2) = IB
- CALL DRFACE(ICODES,XYZ,4,IFACE,TTT)
- 200 CONTINUE
-* N E X T P H I
- 300 IPHI = IPHI + INCR
- IF (IPHI .EQ. 0) IPHI = KPHI
- IF (IPHI .GT. KPHI) IPHI = 1
- IF (IPHI .NE. IPHI2) GOTO 100
- IF (INCR) 310,999,320
- 310 INCR = 0
- GOTO 100
- 320 INCR =-1
- IPHI = IPHI1
- GOTO 300
-*
- 998 WRITE(*,*) 'IHSURP: too many PHI sectors'
- 999 RETURN
- END
diff --git a/src/graflib/higz/ih/ihsurr.F b/src/graflib/higz/ih/ihsurr.F
deleted file mode 100644
index 102f8e7..0000000
--- a/src/graflib/higz/ih/ihsurr.F
+++ /dev/null
@@ -1,139 +0,0 @@
-*
-* $Id: ihsurr.F,v 1.1.1.1 1996/02/14 13:10:54 mclareni Exp $
-*
-* $Log: ihsurr.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:54 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.18/05 27/05/93 09.28.13 by O.Couet
-*-- Author :
- SUBROUTINE IHSURR(IORDR,NA,NB,FUN,DRFACE,CHOPT)
-************************************************************************
-* *
-* IHSURR Date: 04.11.90 *
-* Author: E. Chernyaev (IHEP/Protvino) Revised: 31.03.93 *
-* *
-* Function: Draw surface in cylindrical coordinates *
-* *
-* References: IHWPHI, IHWZN *
-* *
-* Input: IORDR - order of variables (0 - Z,PHI, 1 - PHI,Z) *
-* NA - number of steps along 1st variable *
-* NB - number of steps along 2nd variable *
-* *
-* FUN(IA,IB,F,T) - external routine *
-* IA - cell number for 1st variable *
-* IB - cell number for 2nd variable *
-* F(3,4) - face which corresponds to the cell *
-* F(1,*) - A *
-* F(2,*) - B *
-* F(3,*) - R *
-* T(4) - additional function (for example: temperature) *
-* *
-* DRFACE(ICODES,XYZ,NP,IFACE,T) - routine for face drawing *
-* ICODES(*) - set of codes for this face *
-* ICODES(1) - IA *
-* ICODES(2) - IB *
-* XYZ(3,*) - coordinates of nodes *
-* NP - number of nodes in face *
-* IFACE(NP) - face *
-* T(NP) - additional function *
-* *
-* CHOPT - options: 'BF' - from BACK to FRONT *
-* 'FB' - from FRONT to BACK *
-* *
-************************************************************************
-#include "higz/hcphi.inc"
- REAL F(3,4),XYZ(3,4),TT(4),TTT(4)
- INTEGER IFACE(4),ICODES(2)
- CHARACTER*(*) CHOPT
- EXTERNAL FUN,DRFACE
- DATA IFACE/1,2,3,4/
-*-
- IF (IORDR .EQ. 0) THEN
- JZ = 1
- JPHI = 2
- NZ = NA
- NPHI = NB
- ELSE
- JZ = 2
- JPHI = 1
- NZ = NB
- NPHI = NA
- END IF
- IF (NPHI .GT. NPMAX) GOTO 998
- RAD = ATAN(1.)*4./180.
- IOPT = 2
- IF (CHOPT(1:1).EQ.'B' .OR. CHOPT(1:1).EQ.'b') IOPT = 1
-*
-** P R E P A R E P H I A R R A Y
-** F I N D C R I T I C A L S E C T O R S
-*
- KPHI = NPHI
- IF (IORDR .EQ. 0) IA = NZ
- IF (IORDR .NE. 0) IB = NZ
- DO 10 I=1,NPHI
- IF (IORDR .EQ. 0) IB = I
- IF (IORDR .NE. 0) IA = I
- CALL FUN(IA,IB,F,TT)
- IF (I .EQ. 1) APHI(1) = F(JPHI,1)
- APHI(I) = (APHI(I) + F(JPHI,1))/2.
- APHI(I+1) = F(JPHI,3)
- 10 CONTINUE
- CALL IHWPHI(IOPT,KPHI,APHI,IPHI1,IPHI2)
-*
-** F I N D O R D E R A L O N G Z
-*
- INCRZ = 1
- IZ1 = 1
- CALL IHWZN(0.,0.,1.,Z)
- IF ((Z.LE.0. .AND. IOPT.EQ.1) .OR. (Z.GT.0. .AND. IOPT.EQ.2)) THEN
- INCRZ =-1
- IZ1 = NZ
- END IF
- IZ2 = NZ - IZ1 + 1
-*
-** D R A W S U R F A C E
-*
- INCR = 1
- IPHI = IPHI1
- 100 IF (IPHI .GT. NPHI) GOTO 400
- DO 300 IZ=IZ1,IZ2,INCRZ
- IF (IORDR .EQ. 0) THEN
- IA = IZ
- IB = IPHI
- ELSE
- IA = IPHI
- IB = IZ
- END IF
- CALL FUN(IA,IB,F,TT)
- DO 200 I=1,4
- J = I
- IF (IORDR.EQ.0 .AND. I.EQ.2) J = 4
- IF (IORDR.EQ.0 .AND. I.EQ.4) J = 2
- XYZ(1,J) = F(3,I)*COS(F(JPHI,I)*RAD)
- XYZ(2,J) = F(3,I)*SIN(F(JPHI,I)*RAD)
- XYZ(3,J) = F(JZ,I)
- TTT(J) = TT(I)
- 200 CONTINUE
- ICODES(1) = IA
- ICODES(2) = IB
- CALL DRFACE(ICODES,XYZ,4,IFACE,TTT)
- 300 CONTINUE
-* N E X T P H I
- 400 IPHI = IPHI + INCR
- IF (IPHI .EQ. 0) IPHI = KPHI
- IF (IPHI .GT. KPHI) IPHI = 1
- IF (IPHI .NE. IPHI2) GOTO 100
- IF (INCR) 410,999,420
- 410 INCR = 0
- GOTO 100
- 420 INCR =-1
- IPHI = IPHI1
- GOTO 400
-*
- 998 WRITE(*,*) 'IHSURR: too many PHI sectors'
- 999 RETURN
- END
diff --git a/src/graflib/higz/ih/ihsurs.F b/src/graflib/higz/ih/ihsurs.F
deleted file mode 100644
index 68256ee..0000000
--- a/src/graflib/higz/ih/ihsurs.F
+++ /dev/null
@@ -1,179 +0,0 @@
-*
-* $Id: ihsurs.F,v 1.1.1.1 1996/02/14 13:10:54 mclareni Exp $
-*
-* $Log: ihsurs.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:54 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.18/01 04/05/93 15.28.34 by O.Couet
-*-- Author :
- SUBROUTINE IHSURS(IPSDR,IORDR,NA,NB,FUN,DRFACE,CHOPT)
-************************************************************************
-* *
-* IHSURS Date: 07.11.90 *
-* Author: E. Chernyaev (IHEP/Protvino) Revised: 12.04.93 *
-* *
-* Function: Draw surface in spheric coordinates *
-* *
-* References: IHWPHI, IHWTH *
-* *
-* Input: IPSDR - pseudo-rapidity flag *
-* IORDR - order of variables (0 - THETA,PHI; 1 - PHI,THETA) *
-* NA - number of steps along 1st variable *
-* NB - number of steps along 2nd variable *
-* *
-* FUN(IA,IB,F,T) - external routine *
-* IA - cell number for 1st variable *
-* IB - cell number for 2nd variable *
-* F(3,4) - face which corresponds to the cell *
-* F(1,*) - A *
-* F(2,*) - B *
-* F(3,*) - R *
-* T(4) - additional function (for example: temperature) *
-* *
-* DRFACE(ICODES,XYZ,NP,IFACE,T) - routine for face drawing *
-* ICODES(*) - set of codes for this face *
-* ICODES(1) - IA *
-* ICODES(2) - IB *
-* XYZ(3,*) - coordinates of nodes *
-* NP - number of nodes in face *
-* IFACE(NP) - face *
-* T(NP) - additional function *
-* *
-* CHOPT - options: 'BF' - from BACK to FRONT *
-* 'FB' - from FRONT to BACK *
-* *
-************************************************************************
-#include "higz/hcphi.inc"
- REAL F(3,4),XYZ(3,4),TT(4),TTT(4)
- INTEGER IFACE(4),ICODES(2)
- CHARACTER*(*) CHOPT
- EXTERNAL FUN,DRFACE
- DATA IFACE/1,2,3,4/
-*-
- IF (IORDR .EQ. 0) THEN
- JTH = 1
- JPHI = 2
- NTH = NA
- NPHI = NB
- ELSE
- JTH = 2
- JPHI = 1
- NTH = NB
- NPHI = NA
- END IF
- IF (NTH .GT. NPMAX) GOTO 997
- IF (NPHI .GT. NPMAX) GOTO 998
- RAD = ATAN(1.)*4./180.
- IOPT = 2
- IF (CHOPT(1:1).EQ.'B' .OR. CHOPT(1:1).EQ.'b') IOPT = 1
-*
-** P R E P A R E P H I A R R A Y
-** F I N D C R I T I C A L P H I S E C T O R S
-*
- KPHI = NPHI
- MTH = NTH/2
- IF (MTH .EQ. 0) MTH = 1
- IF (IORDR .EQ. 0) IA = MTH
- IF (IORDR .NE. 0) IB = MTH
- DO 10 I=1,NPHI
- IF (IORDR .EQ. 0) IB = I
- IF (IORDR .NE. 0) IA = I
- CALL FUN(IA,IB,F,TT)
- IF (I .EQ. 1) APHI(1) = F(JPHI,1)
- APHI(I) = (APHI(I) + F(JPHI,1))/2.
- APHI(I+1) = F(JPHI,3)
- 10 CONTINUE
- CALL IHWPHI(IOPT,KPHI,APHI,IPHI1,IPHI2)
-*
-** P R E P A R E T H E T A A R R A Y
-*
- IF (IORDR .EQ. 0) IB = 1
- IF (IORDR .NE. 0) IA = 1
- DO 20 I=1,NTH
- IF (IORDR .EQ. 0) IA = I
- IF (IORDR .NE. 0) IB = I
- CALL FUN(IA,IB,F,TT)
- IF (I .EQ. 1) APHI(1) = F(JTH,1)
- APHI(I) = (APHI(I) + F(JTH,1))/2.
- APHI(I+1) = F(JTH,3)
- 20 CONTINUE
-*
-** D R A W S U R F A C E
-*
- KTH = NTH
- INCR = 1
- IPHI = IPHI1
- 100 IF (IPHI .GT. NPHI) GOTO 500
-* F I N D C R I T I C A L T H E T A S E C T O R S
- IF (IORDR .EQ. 0) THEN
- IA = MTH
- IB = IPHI
- ELSE
- IA = IPHI
- IB = MTH
- END IF
- CALL FUN(IA,IB,F,TT)
- PHI = (F(JPHI,1) + F(JPHI,3)) / 2.
- CALL IHWTH(IOPT,PHI,KTH,APHI,ITH1,ITH2)
- INCRTH = 1
- ITH = ITH1
- 200 IF (ITH .GT. NTH) GOTO 400
- IF (IORDR .EQ. 0) IA = ITH
- IF (IORDR .NE. 0) IB = ITH
- CALL FUN(IA,IB,F,TT)
- IF (IPSDR .EQ. 1) THEN
- DO 310 I=1,4
- J = I
- IF (IORDR.NE.0 .AND. I.EQ.2) J = 4
- IF (IORDR.NE.0 .AND. I.EQ.4) J = 2
- XYZ(1,J) = F(3,I) * COS(F(JPHI,I)*RAD)
- XYZ(2,J) = F(3,I) * SIN(F(JPHI,I)*RAD)
- XYZ(3,J) = F(3,I) * COS(F(JTH,I)*RAD) / SIN(F(JTH,I)*RAD)
- TTT(J) = TT(I)
- 310 CONTINUE
- ELSE
- DO 320 I=1,4
- J = I
- IF (IORDR.NE.0 .AND. I.EQ.2) J = 4
- IF (IORDR.NE.0 .AND. I.EQ.4) J = 2
- XYZ(1,J) = F(3,I) * SIN(F(JTH,I)*RAD) * COS(F(JPHI,I)*RAD)
- XYZ(2,J) = F(3,I) * SIN(F(JTH,I)*RAD) * SIN(F(JPHI,I)*RAD)
- XYZ(3,J) = F(3,I) * COS(F(JTH,I)*RAD)
- TTT(J) = TT(I)
- 320 CONTINUE
- END IF
- ICODES(1) = IA
- ICODES(2) = IB
- CALL DRFACE(ICODES,XYZ,4,IFACE,TTT)
-* N E X T T H E T A
- 400 ITH = ITH + INCRTH
- IF (ITH .EQ. 0) ITH = KTH
- IF (ITH .GT. KTH) ITH = 1
- IF (ITH .NE. ITH2) GOTO 200
- IF (INCRTH) 410,500,420
- 410 INCRTH = 0
- GOTO 200
- 420 INCRTH =-1
- ITH = ITH1
- GOTO 400
-* N E X T P H I
- 500 IPHI = IPHI + INCR
- IF (IPHI .EQ. 0) IPHI = KPHI
- IF (IPHI .GT. KPHI) IPHI = 1
- IF (IPHI .NE. IPHI2) GOTO 100
- IF (INCR) 510,999,520
- 510 INCR = 0
- GOTO 100
- 520 INCR =-1
- IPHI = IPHI1
- GOTO 500
-*
- 997 WRITE(*,*) 'IHSURS: too many THETA sectors'
- GOTO 999
- 998 WRITE(*,*) 'IHSURS: too many PHI sectors'
- GOTO 999
- 999 RETURN
- END
diff --git a/src/graflib/higz/ih/ihsvie.F b/src/graflib/higz/ih/ihsvie.F
deleted file mode 100644
index 52ffd90..0000000
--- a/src/graflib/higz/ih/ihsvie.F
+++ /dev/null
@@ -1,62 +0,0 @@
-*
-* $Id: ihsvie.F,v 1.1.1.1 1996/02/14 13:10:54 mclareni Exp $
-*
-* $Log: ihsvie.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:54 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.20/07 13/01/94 14.39.17 by O.Couet
-*-- Author :
- SUBROUTINE IHSVIE(RMIN,RMAX,PHI,THETA,PSI,IREP)
-************************************************************************
-* *
-* IHSVIE Date: 13.08.90 *
-* Author: E. Chernyaev (IHEP/Protvino) Revised: *
-* *
-* Function: Set view direction (in spherical coordinates) *
-* *
-* References: IHWV01, IHWV02 *
-* *
-* Input: RMIN(3) - MIN - *
-* RMAX(3) - MAX scope *
-* *
-* PHI - longitude *
-* THETA - latitude (angle between +Z and view direction) *
-* PSI - rotation in screen plane *
-* *
-* Output: IREP - reply (-1 if error in min-max) *
-* *
-* Errors: error in min-max scope *
-* *
-************************************************************************
-#include "higz/hctnor.inc"
-#include "higz/hcscrn.inc"
- REAL RMIN(3),RMAX(3),CENTRE(3),SCALE(3)
- DOUBLE PRECISION DRAD,C1,S1,C2,S2,C3,S3
-*-
- DRAD = DATAN(1.D0)*4./180.
-*
-** F I N D C E N T E R O F S C O P E A N D
-** S C A L E F A C T O R S
-*
- CALL IHWV01(RMIN,RMAX,SCALE,CENTRE,IREP)
- IF (IREP .LT. 0) GOTO 998
-*
-** S E T T R A N S F O R M A T I O N M A T R I X E S
-*
- C1 = DCOS(PHI*DRAD)
- S1 = DSIN(PHI*DRAD)
- C2 = DCOS(THETA*DRAD)
- S2 = DSIN(THETA*DRAD)
- C3 = DCOS(PSI*DRAD)
- S3 = DSIN(PSI*DRAD)
- CALL IHWV02(SCALE,CENTRE,C1,S1,C2,S2,C3,S3,TNORM,TBACK)
- C3 = 1.
- S3 = 0.
- CALL IHWV02(SCALE,CENTRE,C1,S1,C2,S2,C3,S3,TN,TB)
- RETURN
-*
- 998 WRITE(*,*) 'IHSVIE: error in min-max scope'
- END
diff --git a/src/graflib/higz/ih/ihwlin.F b/src/graflib/higz/ih/ihwlin.F
deleted file mode 100644
index f3cd3f4..0000000
--- a/src/graflib/higz/ih/ihwlin.F
+++ /dev/null
@@ -1,85 +0,0 @@
-*
-* $Id: ihwlin.F,v 1.1.1.1 1996/02/14 13:10:54 mclareni Exp $
-*
-* $Log: ihwlin.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:54 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.14/00 19/02/92 10.16.08 by O.Couet
-*-- Author :
- SUBROUTINE IHWLIN(NP,F,T)
-************************************************************************
-* *
-* IHWLIN Date: 10.01.92 *
-* Author: E. Chernyaev (IHEP/Protvino) Revised: *
-* *
-* Function: Find level lines for face *
-* *
-* Input: NP - number of nodes *
-* F(3,NP) - face *
-* T(NP) - additional function *
-* *
-* Error: number of points for line .NE. 2 *
-* *
-************************************************************************
-#include "higz/hclevl.inc"
-#include "higz/hcline.inc"
- REAL F(3,*),T(*)
-*-
- NLINES = 0
- IF (NLEV .EQ. 0) GOTO 999
- NL = NLEV
- IF (NL .LT. 0) NL =-NL
-* F I N D Tmin A N D Tmax
- TMIN = T(1)
- TMAX = T(1)
- DO 100 I=2,NP
- IF (T(I) .LT. TMIN) TMIN = T(I)
- IF (T(I) .GT. TMAX) TMAX = T(I)
- 100 CONTINUE
- IF (TMIN .GE. FUNLEV(NL)) GOTO 999
- IF (TMAX .LE. FUNLEV(1)) GOTO 999
-*
-** F I N D L E V E L S L I N E S
-*
- DO 340 IL=1,NL
- IF (TMIN .GE. FUNLEV(IL)) GOTO 340
- IF (TMAX .LE. FUNLEV(IL)) GOTO 999
- IF (NLINES .GE. LLINES) GOTO 999
- NLINES = NLINES + 1
- ILLEVL(NLINES) = IL
- K = 0
- DO 330 I=1,NP
- I1 = I
- I2 = I + 1
- IF (I .EQ. NP) I2 = 1
- D1 = T(I1) - FUNLEV(IL)
- D2 = T(I2) - FUNLEV(IL)
- IF (D1 .EQ. 0.) GOTO 310
- IF (D1*D2 .LT. 0.) GOTO 320
- GOTO 330
- 310 K = K + 1
- PLINES(1,K,NLINES) = F(1,I1)
- PLINES(2,K,NLINES) = F(2,I1)
- PLINES(3,K,NLINES) = F(3,I1)
- IF (K .EQ. 1) GOTO 330
- GOTO 340
- 320 K = K + 1
- D1 = D1 / (T(I2)-T(I1))
- D2 = D2 / (T(I2)-T(I1))
- PLINES(1,K,NLINES) = D2*F(1,I1) - D1*F(1,I2)
- PLINES(2,K,NLINES) = D2*F(2,I1) - D1*F(2,I2)
- PLINES(3,K,NLINES) = D2*F(3,I1) - D1*F(3,I2)
- IF (K .EQ. 1) GOTO 330
- GOTO 340
- 330 CONTINUE
- IF (K .NE. 2) THEN
- WRITE(*,*) 'IHWLIN: number of points for line .NE. 2'
- NLINES = NLINES - 1
- END IF
- 340 CONTINUE
-*
- 999 RETURN
- END
diff --git a/src/graflib/higz/ih/ihwphi.F b/src/graflib/higz/ih/ihwphi.F
deleted file mode 100644
index b4494bb..0000000
--- a/src/graflib/higz/ih/ihwphi.F
+++ /dev/null
@@ -1,78 +0,0 @@
-*
-* $Id: ihwphi.F,v 1.1.1.1 1996/02/14 13:10:54 mclareni Exp $
-*
-* $Log: ihwphi.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:54 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.18/00 13/04/93 17.53.44 by O.Couet
-*-- Author :
- SUBROUTINE IHWPHI(IOPT,KPHI,APHI,IPHI1,IPHI2)
-************************************************************************
-* *
-* IHWPHI Date: 29.03.93 *
-* Author: E. Chernyaev (IHEP/Protvino) Revised: *
-* *
-* Function: Find critical PHI sectors *
-* *
-* Input: IOPT - options: 1 - from BACK to FRONT 'BF' *
-* 2 - from FRONT to BACK 'FB' *
-* KPHI - number of phi sectors *
-* APHI(*) - PHI separatrices *
-* *
-* Output: IPHI1 - initial sector *
-* IPHI2 - final sector *
-* *
-************************************************************************
-#include "higz/hcscrn.inc"
- REAL APHI(*)
- INTEGER IPHI(2)
-*-
- RAD = ATAN(1.)*4./180.
- IF (APHI(KPHI+1) .EQ. APHI(1)) APHI(KPHI+1) = APHI(KPHI+1) + 360.
- DPHI = ABS(APHI(KPHI+1) - APHI(1))
- IF (DPHI .NE. 360.) THEN
- APHI(KPHI+2) = (APHI(1) + APHI(KPHI+1))/2. + 180.
- APHI(KPHI+3) = APHI(1) + 360.
- KPHI = KPHI + 2
- END IF
-*
-** F I N D C R I T I C A L S E C T O R S
-*
- K = 0
- DO 100 I=1,KPHI
- PHI1 = RAD*APHI(I)
- PHI2 = RAD*APHI(I+1)
- X1 = TN(1,1)*COS(PHI1) + TN(2,1)*SIN(PHI1)
- X2 = TN(1,1)*COS(PHI2) + TN(2,1)*SIN(PHI2)
- IF (X1.GE.0. .AND. X2.GT.0.) GOTO 100
- IF (X1.LE.0. .AND. X2.LT.0.) GOTO 100
- K = K + 1
- IF (K .EQ. 3) GOTO 998
- IPHI(K)= I
- 100 CONTINUE
- IF (K .NE. 2) GOTO 998
-*
-** F I N D O R D E R O F C R I T I C A L S E C T O R S
-*
- PHI1 = RAD * (APHI(IPHI(1)) + APHI(IPHI(1)+1)) / 2.
- PHI2 = RAD * (APHI(IPHI(2)) + APHI(IPHI(2)+1)) / 2.
- Z1 = TN(1,3)*COS(PHI1) + TN(2,3)*SIN(PHI1)
- Z2 = TN(1,3)*COS(PHI2) + TN(2,3)*SIN(PHI2)
- IF ((Z1.LE.Z2 .AND. IOPT.EQ.1).OR.(Z1.GT.Z2 .AND. IOPT.EQ.2)) THEN
- IPHI1 = IPHI(1)
- IPHI2 = IPHI(2)
- ELSE
- IPHI1 = IPHI(2)
- IPHI2 = IPHI(1)
- END IF
- GOTO 999
-*
- 998 WRITE(*,*)
- & 'IHWPHI: Something strange: num. of critical sectors .NE. 2'
- IPHI1 = 1
- IPHI2 = 2
- 999 RETURN
- END
diff --git a/src/graflib/higz/ih/ihwth.F b/src/graflib/higz/ih/ihwth.F
deleted file mode 100644
index 624403b..0000000
--- a/src/graflib/higz/ih/ihwth.F
+++ /dev/null
@@ -1,81 +0,0 @@
-*
-* $Id: ihwth.F,v 1.1.1.1 1996/02/14 13:10:54 mclareni Exp $
-*
-* $Log: ihwth.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:54 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.18/00 20/04/93 14.20.34 by O.Couet
-*-- Author :
- SUBROUTINE IHWTH(IOPT,PHI,KTH,ATH,ITH1,ITH2)
-************************************************************************
-* *
-* IHWTH Date: 07.04.93 *
-* Author: E. Chernyaev (IHEP/Protvino) Revised: *
-* *
-* Function: Find critical THETA sectors for given PHI sector *
-* *
-* Input: IOPT - options: 1 - from BACK to FRONT 'BF' *
-* 2 - from FRONT to BACK 'FB' *
-* PHI - PHI sector *
-* KTH - number of THETA sectors *
-* ATH(*) - THETA separatrices *
-* *
-* Output: ITH1 - initial sector *
-* ITH2 - final sector *
-* *
-************************************************************************
-#include "higz/hcscrn.inc"
- REAL ATH(*)
- INTEGER ITH(2)
-*-
- RAD = ATAN(1.)*4./180.
- DTH = ABS(ATH(KTH+1) - ATH(1))
- IF (DTH .NE. 360.) THEN
- ATH(KTH+2) = (ATH(1) + ATH(KTH+1))/2. + 180.
- ATH(KTH+3) = ATH(1) + 360.
- KTH = KTH + 2
- END IF
-*
-** F I N D C R I T I C A L S E C T O R S
-*
- COSPHI = COS(PHI*RAD)
- SINPHI = SIN(PHI*RAD)
- K = 0
- DO 100 I=1,KTH
- TH1 = RAD*ATH(I)
- TH2 = RAD*ATH(I+1)
- CALL IHWZN(COS(TH1)*COSPHI,COS(TH1)*SINPHI,-SIN(TH1),Z1)
- CALL IHWZN(COS(TH2)*COSPHI,COS(TH2)*SINPHI,-SIN(TH2),Z2)
- IF (Z1.GE.0. .AND. Z2.GT.0.) GOTO 100
- IF (Z1.LE.0. .AND. Z2.LT.0.) GOTO 100
- K = K + 1
- IF (K .EQ. 3) GOTO 998
- ITH(K)= I
- 100 CONTINUE
- IF (K .NE. 2) GOTO 998
-*
-** F I N D O R D E R O F C R I T I C A L S E C T O R S
-*
- TNCONS = TN(1,3)*COS(PHI*RAD) + TN(2,3)*SIN(PHI*RAD)
- TH1 = RAD * (ATH(ITH(1)) + ATH(ITH(1)+1)) / 2.
- TH2 = RAD * (ATH(ITH(2)) + ATH(ITH(2)+1)) / 2.
- Z1 = TNCONS*SIN(TH1) + TN(3,3)*COS(TH1)
- Z2 = TNCONS*SIN(TH2) + TN(3,3)*COS(TH2)
- IF ((Z1.LE.Z2 .AND. IOPT.EQ.1).OR.(Z1.GT.Z2 .AND. IOPT.EQ.2)) THEN
- ITH1 = ITH(1)
- ITH2 = ITH(2)
- ELSE
- ITH1 = ITH(2)
- ITH2 = ITH(1)
- END IF
- GOTO 999
-*
- 998 WRITE(*,*)
- & 'IHWTH: Something strange: num. of critical sectors .NE. 2'
- ITH1 = 1
- ITH2 = 2
- 999 RETURN
- END
diff --git a/src/graflib/higz/ih/ihwton.F b/src/graflib/higz/ih/ihwton.F
deleted file mode 100644
index 6328857..0000000
--- a/src/graflib/higz/ih/ihwton.F
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: ihwton.F,v 1.1.1.1 1996/02/14 13:10:54 mclareni Exp $
-*
-* $Log: ihwton.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:54 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.21/07 28/06/94 13.57.20 by O.Couet
-*-- Author :
- SUBROUTINE IHWTON(PW,PN)
-************************************************************************
-* *
-* IHWTON Date: 14.10.91 *
-* Author: E. Chernyaev (IHEP/Protvino) Revised: *
-* *
-* Function: Transfer point from world to normalized coordinates *
-* *
-* Input: PW(3) - point in world coordinate system *
-* PN(3) - point in normalized coordinate system *
-* *
-************************************************************************
-#include "higz/hctnor.inc"
- REAL PW(3),PN(3)
-*-
- X = PW(1)
- Y = PW(2)
- Z = PW(3)
- PN(1) = TNORM(1,1)*X + TNORM(2,1)*Y + TNORM(3,1)*Z + TNORM(4,1)
- PN(2) = TNORM(1,2)*X + TNORM(2,2)*Y + TNORM(3,2)*Z + TNORM(4,2)
- PN(3) = TNORM(1,3)*X + TNORM(2,3)*Y + TNORM(3,3)*Z + TNORM(4,3)
- END
diff --git a/src/graflib/higz/ih/ihwv01.F b/src/graflib/higz/ih/ihwv01.F
deleted file mode 100644
index 5480ffa..0000000
--- a/src/graflib/higz/ih/ihwv01.F
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: ihwv01.F,v 1.1.1.1 1996/02/14 13:10:54 mclareni Exp $
-*
-* $Log: ihwv01.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:54 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.13/09 14/01/92 14.01.24 by O.Couet
-*-- Author :
- SUBROUTINE IHWV01(RMIN,RMAX,SCALE,CENTER,IREP)
-************************************************************************
-* *
-* IHWV01 Date: 13.08.90 *
-* Author: E. Chernyaev (IHEP/Protvino) Revised: 08.01.92 *
-* *
-* Function: Find centre of a MIN-MAX scope and scale factors *
-* *
-* Input: RMIN(3) - MIN - *
-* RMAX(3) - MAX scope *
-* *
-* Output: SCALE(3) - scale factors *
-* CENTER(3) - centre *
-* IREP - reply (-1 if error in min-max) *
-* *
-************************************************************************
- REAL RMIN(3),RMAX(3),SCALE(3),CENTER(3)
-*-
- IREP = 0
- SQRT3 = SQRT(3.)/2.
- DO 100 I=1,3
- IF (RMIN(I) .GE. RMAX(I)) GOTO 998
- SCALE(I) = (RMAX(I)-RMIN(I)) * SQRT3
- CENTER(I) = (RMAX(I)+RMIN(I)) / 2.
- 100 CONTINUE
- GOTO 999
-*
- 998 IREP =-1
- 999 RETURN
- END
diff --git a/src/graflib/higz/ih/ihwv02.F b/src/graflib/higz/ih/ihwv02.F
deleted file mode 100644
index 425d17a..0000000
--- a/src/graflib/higz/ih/ihwv02.F
+++ /dev/null
@@ -1,130 +0,0 @@
-*
-* $Id: ihwv02.F,v 1.1.1.1 1996/02/14 13:10:54 mclareni Exp $
-*
-* $Log: ihwv02.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:54 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.13/09 14/01/92 14.01.24 by O.Couet
-*-- Author :
- SUBROUTINE IHWV02(S,C,COSPHI,SINPHI,COSTHE,SINTHE,COSPSI,SINPSI,
- & TNORM,TBACK)
-************************************************************************
-* *
-* IHWV02 Date: 13.08.90 *
-* Author: E. Chernyaev (IHEP/Protvino) Revised: 07.01.92 *
-* *
-* Function: Define view direction (in spherical coordinates) *
-* Compute transformation matrix from world coordinates *
-* to normalised coordinates (-1 to +1) *
-* *
-* Input: S(3) - scale factors *
-* C(3) - centre of scope *
-* COSPHI - longitude COS *
-* SINPHI - longitude SIN *
-* COSTHE - latitude COS (angle between +Z and view direc.) *
-* SINTHE - latitude SIN *
-* COSPSI - screen plane rotation angle COS *
-* SINPSI - screen plane rotation angle SIN *
-* *
-************************************************************************
- REAL S(3),C(3),TNORM(4,3),TBACK(4,3)
- DOUBLE PRECISION SCALEX,SCALEY,SCALEZ,ROTA(4,4),TRAN(4,4)
- DOUBLE PRECISION COSPHI,SINPHI,COSTHE,SINTHE,COSPSI,SINPSI
- DOUBLE PRECISION C1,S1,C2,S2,C3,S3
-*-
- SCALEX = S(1)
- SCALEY = S(2)
- SCALEZ = S(3)
-*
-** S E T T R A N S L A T I O N M A T R I X
-*
- TRAN(1,1) = 1./SCALEX
- TRAN(2,1) = 0.
- TRAN(3,1) = 0.
- TRAN(4,1) =-C(1)/SCALEX
-*
- TRAN(1,2) = 0.
- TRAN(2,2) = 1./SCALEY
- TRAN(3,2) = 0.
- TRAN(4,2) =-C(2)/SCALEY
-*
- TRAN(1,3) = 0.
- TRAN(2,3) = 0.
- TRAN(3,3) = 1./SCALEZ
- TRAN(4,3) =-C(3)/SCALEZ
-*
- TRAN(1,4) = 0.
- TRAN(2,4) = 0.
- TRAN(3,4) = 0.
- TRAN(4,4) = 1.
-*
-** S E T R O T A T I O N M A T R I X
-*
-* ( C(PSI) S(PSI) 0) (1 0 0 ) ( C(90+PHI) S(90+PHI) 0)
-* (-S(PSI) C(PSI) 0) * (0 C(THETA) S(THETA)) * (-S(90+PHI) C(90+PHI) 0)
-* ( 0 0 1) (0 -S(THETA) C(THETA)) ( 0 0 1)
-*
- C1 = COSPSI
- S1 = SINPSI
- C2 = COSTHE
- S2 = SINTHE
- C3 =-SINPHI
- S3 = COSPHI
-*
- ROTA(1,1) = C1*C3 - S1*C2*S3
- ROTA(2,1) = C1*S3 + S1*C2*C3
- ROTA(3,1) = S1*S2
- ROTA(4,1) = 0.
-*
- ROTA(1,2) =-S1*C3 - C1*C2*S3
- ROTA(2,2) =-S1*S3 + C1*C2*C3
- ROTA(3,2) = C1*S2
- ROTA(4,2) = 0.
-*
- ROTA(1,3) = S2*S3
- ROTA(2,3) =-S2*C3
- ROTA(3,3) = C2
- ROTA(4,3) = 0.
-*
- ROTA(1,4) = 0.
- ROTA(2,4) = 0.
- ROTA(3,4) = 0.
- ROTA(4,4) = 1.
-*
-** F I N D T R A N S F O R M A T I O N M A T R I X
-*
- DO 220 I=1,3
- DO 210 K=1,4
- TNORM(K,I) = ROTA(1,I)*TRAN(K,1) +
- + ROTA(2,I)*TRAN(K,2) +
- + ROTA(3,I)*TRAN(K,3) +
- + ROTA(4,I)*TRAN(K,4)
- 210 CONTINUE
- 220 CONTINUE
-*
-** S E T B A C K T R A N S L A T I O N M A T R I X
-*
- TRAN(1,1) = SCALEX
- TRAN(4,1) = C(1)
-*
- TRAN(2,2) = SCALEY
- TRAN(4,2) = C(2)
-*
- TRAN(3,3) = SCALEZ
- TRAN(4,3) = C(3)
-*
-** F I N D B A C K T R A N S F O R M A T I O N
-*
- DO 320 I=1,3
- DO 310 K=1,4
- TBACK(K,I) = TRAN(1,I)*ROTA(1,K) +
- + TRAN(2,I)*ROTA(2,K) +
- + TRAN(3,I)*ROTA(3,K) +
- + TRAN(4,I)*ROTA(4,K)
- 310 CONTINUE
- 320 CONTINUE
- RETURN
- END
diff --git a/src/graflib/higz/ih/ihwvr1.F b/src/graflib/higz/ih/ihwvr1.F
deleted file mode 100644
index 07487e1..0000000
--- a/src/graflib/higz/ih/ihwvr1.F
+++ /dev/null
@@ -1,47 +0,0 @@
-*
-* $Id: ihwvr1.F,v 1.1.1.1 1996/02/14 13:10:54 mclareni Exp $
-*
-* $Log: ihwvr1.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:54 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.18/00 20/04/93 14.20.34 by O.Couet
-*-- Author :
- SUBROUTINE IHWVR1(IOPT,PHI1,PHI2,VAL)
-************************************************************************
-* *
-* IHWVR1 Date: 20.04.93 *
-* Author: E. Chernyaev (IHEP/Protvino) Revised: *
-* *
-* Function: Encode side visibilities and order along R for sector *
-* *
-* References: IHWZN *
-* *
-* Input: IOPT - options: 1 - from BACK to FRONT 'BF' *
-* 2 - from FRONT to BACK 'FB' *
-* PHI1 - 1st phi of sector *
-* PHI2 - 2nd phi of sector *
-* *
-* Output: VAL - encoded value *
-* *
-************************************************************************
- EQUIVALENCE (Q,K)
-*-
- K = 0
- CALL IHWZN(0.,0.,1.,ZN)
- IF (ZN .GT. 0.) K = K + 64
- IF (ZN .LT. 0.) K = K + 32
- CALL IHWZN(-SIN(PHI2),COS(PHI2),0.,ZN)
- IF (ZN .GT. 0.) K = K + 16
- CALL IHWZN(SIN(PHI1),-COS(PHI1),0.,ZN)
- IF (ZN .GT. 0.) K = K + 4
- PHI = (PHI1 + PHI2) / 2.
- CALL IHWZN(COS(PHI),SIN(PHI),0.,ZN)
- IF (ZN .GT. 0.) K = K + 8
- IF (ZN .LT. 0.) K = K + 2
- IF ((ZN.LE.0. .AND. IOPT.EQ.1) .OR.
- & (ZN.GT.0. .AND. IOPT.EQ.2)) K = K + 1
- VAL = Q
- END
diff --git a/src/graflib/higz/ih/ihwvr2.F b/src/graflib/higz/ih/ihwvr2.F
deleted file mode 100644
index 92d484b..0000000
--- a/src/graflib/higz/ih/ihwvr2.F
+++ /dev/null
@@ -1,46 +0,0 @@
-*
-* $Id: ihwvr2.F,v 1.1.1.1 1996/02/14 13:10:54 mclareni Exp $
-*
-* $Log: ihwvr2.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:54 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.18/00 02/04/93 11.28.07 by O.Couet
-*-- Author :
- SUBROUTINE IHWVR2(VAL,IV1,IV2,IV3,IV4,IV5,IV6,IR)
-************************************************************************
-* *
-* IHWVR2 Date: 31.03.93 *
-* Author: E. Chernyaev (IHEP/Protvino) Revised: *
-* *
-* Function: Decode side visibilities and order along R for sector *
-* *
-* Input: VAL - encoded value *
-* *
-* Output: IV1 ... IV6 - visibility of the sides *
-* IR - increment along R *
-* *
-************************************************************************
- EQUIVALENCE (Q,K)
- INTEGER IVIS(6)
-*-
- Q = VAL
- NUM = 128
- DO 100 I=1,6
- IVIS(I) = 0
- NUM = NUM / 2
- IF (K .LT. NUM) GOTO 100
- K = K - NUM
- IVIS(I) = 1
- 100 CONTINUE
- IR = 1
- IF (K .EQ. 1) IR = -1
- IV1 = IVIS(6)
- IV2 = IVIS(5)
- IV3 = IVIS(4)
- IV4 = IVIS(3)
- IV5 = IVIS(2)
- IV6 = IVIS(1)
- END
diff --git a/src/graflib/higz/ih/ihwwnn.F b/src/graflib/higz/ih/ihwwnn.F
deleted file mode 100644
index db16c42..0000000
--- a/src/graflib/higz/ih/ihwwnn.F
+++ /dev/null
@@ -1,45 +0,0 @@
-*
-* $Id: ihwwnn.F,v 1.1.1.1 1996/02/14 13:10:54 mclareni Exp $
-*
-* $Log: ihwwnn.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:54 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.13/09 17/01/92 17.09.53 by O.Couet
-*-- Author :
- SUBROUTINE IHWWNN(PW,PN)
-************************************************************************
-* *
-* IHWWNN Date: 17.01.92 *
-* Author: E. Chernyaev (IHEP/Protvino) Revised: *
-* *
-* Function: Transfer vector of NORMAL from word to normalized *
-* coodinates *
-* *
-* Input: PW(3) - vector of NORMAL in word coordinate system *
-* PN(3) - vector of NORMAL in normalized coordinate system *
-* *
-************************************************************************
-#include "higz/hctnor.inc"
- REAL PW(3),PN(3)
-*-
- X = PW(1)
- Y = PW(2)
- Z = PW(3)
- A1 = TNORM(1,1)
- A2 = TNORM(2,1)
- A3 = TNORM(3,1)
- B1 = TNORM(1,2)
- B2 = TNORM(2,2)
- B3 = TNORM(3,2)
- C1 = TNORM(1,3)
- C2 = TNORM(2,3)
- C3 = TNORM(3,3)
- PN(1) = X*(B2*C3-B3*C2) + Y*(B3*C1-B1*C3) + Z*(B1*C2-B2*C1)
- PN(2) = X*(C2*A3-C3*A2) + Y*(C3*A1-C1*A3) + Z*(C1*A2-C2*A1)
- PN(3) = X*(A2*B3-A3*B2) + Y*(A3*B1-A1*B3) + Z*(A1*B2-A2*B1)
- RETURN
- END
-
diff --git a/src/graflib/higz/ih/ihwzn.F b/src/graflib/higz/ih/ihwzn.F
deleted file mode 100644
index 715d93f..0000000
--- a/src/graflib/higz/ih/ihwzn.F
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: ihwzn.F,v 1.1.1.1 1996/02/14 13:10:54 mclareni Exp $
-*
-* $Log: ihwzn.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:54 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.18/00 20/04/93 14.20.34 by O.Couet
-*-- Author :
- SUBROUTINE IHWZN(X,Y,Z,ZN)
-************************************************************************
-* *
-* IHWZN Date: 20.04.93 *
-* Author: E. Chernyaev (IHEP/Protvino) Revised: *
-* *
-* Function: Find Z component of NORMAL in normalized coordinates *
-* *
-* Input: X - X-component of NORMAL *
-* Y - Y-component of NORMAL *
-* Z - Z-component of NORMAL *
-* *
-* Output: ZN - Z-component of NORMAL in normalized coordinates *
-* *
-************************************************************************
-#include "higz/hcscrn.inc"
-*-
- ZN = X*(TN(2,1)*TN(3,2)-TN(3,1)*TN(2,2)) +
- & Y*(TN(3,1)*TN(1,2)-TN(1,1)*TN(3,2)) +
- & Z*(TN(1,1)*TN(2,2)-TN(2,1)*TN(1,2))
- RETURN
- END
diff --git a/src/graflib/higz/ih/ihzdep.F b/src/graflib/higz/ih/ihzdep.F
deleted file mode 100644
index 1c2428e..0000000
--- a/src/graflib/higz/ih/ihzdep.F
+++ /dev/null
@@ -1,208 +0,0 @@
-*
-* $Id: ihzdep.F,v 1.1.1.1 1996/02/14 13:10:54 mclareni Exp $
-*
-* $Log: ihzdep.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:54 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.19/06 27/08/93 14.16.47 by O.Couet
-*-- Author :
- SUBROUTINE IHZDEP(XYZ,NFACE,IFACE,DFACE,ABCD,IORDER)
-************************************************************************
-* *
-* IHZDEP Date: 26.07.93 *
-* Author: E. Chernyaev (IHEP/Protvino) Revised: *
-* *
-* Function: Z-depth algorithm for set of triangles *
-* *
-* Input: XYZ(3,*) - nodes *
-* NFACE - number of triangular faces *
-* IFACE(3,*) - faces (triangles) *
-* *
-* Arrays: DFACE(6,*) - array for min-max scopes *
-* ABCD(4,*) - array for face plane equations *
-* *
-* Output: IORDER(*) - face order *
-* *
-************************************************************************
- PARAMETER (DEL = 0.0001)
- INTEGER IFACE(3,*),IORDER(*),NN(3),KK(3)
- REAL XYZ(3,*),DFACE(6,*),ABCD(4,*)
- REAL V(3,2),ABCDN(4),ABCDK(4)
- EQUIVALENCE (N1,NN(1)),(N2,NN(2)),(N3,NN(3))
- EQUIVALENCE (K1,KK(1)),(K2,KK(2)),(K3,KK(3))
-*-
-** S E T I N I T I A L O R D E R
-** I G N O R E V E R Y S M A L L F A C E S
-** S E T M I N - M A X S C O P E S
-** S E T F A C E P L A N E E Q U A T I O N S
-*
- NF = 0
- DO 130 N=1,NFACE
- I1 = IABS(IFACE(1,N))
- I2 = IABS(IFACE(2,N))
- I3 = IABS(IFACE(3,N))
-* A R E A T E S T
- IF (ABS(XYZ(1,I2)-XYZ(1,I1)).LE.DEL .AND.
- & ABS(XYZ(2,I2)-XYZ(2,I1)).LE.DEL .AND.
- & ABS(XYZ(3,I2)-XYZ(3,I1)).LE.DEL) GOTO 130
- IF (ABS(XYZ(1,I3)-XYZ(1,I2)).LE.DEL .AND.
- & ABS(XYZ(2,I3)-XYZ(2,I2)).LE.DEL .AND.
- & ABS(XYZ(3,I3)-XYZ(3,I2)).LE.DEL) GOTO 130
- IF (ABS(XYZ(1,I1)-XYZ(1,I3)).LE.DEL .AND.
- & ABS(XYZ(2,I1)-XYZ(2,I3)).LE.DEL .AND.
- & ABS(XYZ(3,I1)-XYZ(3,I3)).LE.DEL) GOTO 130
-* P R O J E C T I O N T E S T
- IF (ABS(XYZ(1,I2)-XYZ(1,I1)).LE.DEL .AND.
- & ABS(XYZ(2,I2)-XYZ(2,I1)).LE.DEL .AND.
- & ABS(XYZ(1,I3)-XYZ(1,I2)).LE.DEL .AND.
- & ABS(XYZ(2,I3)-XYZ(2,I2)).LE.DEL .AND.
- & ABS(XYZ(1,I1)-XYZ(1,I3)).LE.DEL .AND.
- & ABS(XYZ(2,I1)-XYZ(2,I3)).LE.DEL) GOTO 130
- NF = NF + 1
- IORDER(NF) = N
-* F I N D M I N - M A X
- DO 110 I=1,3
- WMIN = XYZ(I,I1)
- WMAX = XYZ(I,I1)
- IF (WMIN .GT. XYZ(I,I2)) WMIN = XYZ(I,I2)
- IF (WMAX .LT. XYZ(I,I2)) WMAX = XYZ(I,I2)
- IF (WMIN .GT. XYZ(I,I3)) WMIN = XYZ(I,I3)
- IF (WMAX .LT. XYZ(I,I3)) WMAX = XYZ(I,I3)
- DFACE(I,N) = WMIN
- DFACE(I+3,N) = WMAX
- 110 CONTINUE
-* F I N D F A C E E Q U A T I O N
- DO 120 I=1,3
- V(I,1) = XYZ(I,I2) - XYZ(I,I1)
- V(I,2) = XYZ(I,I3) - XYZ(I,I2)
- 120 CONTINUE
- A = (V(2,1)*V(3,2) - V(3,1)*V(2,2))
- B = (V(3,1)*V(1,2) - V(1,1)*V(3,2))
- C = (V(1,1)*V(2,2) - V(2,1)*V(1,2))
- Q = SQRT(A*A+B*B+C*C)
- IF (C .LT. 0.) Q =-Q
- A = A / Q
- B = B / Q
- C = C / Q
- ABCD(1,N) = A
- ABCD(2,N) = B
- ABCD(3,N) = C
- ABCD(4,N) =-(A*XYZ(1,I1) + B*XYZ(2,I1) + C*XYZ(3,I1))
- 130 CONTINUE
- NFACE = NF
- IF (NF .LE. 1) GOTO 999
-*
-** S O R T T R I A N G L E S A L O N G Z - M I N
-*
- DO 220 ICUR=2,NFACE
- K = IORDER(ICUR)
- ZCUR = DFACE(3,K)
- DO 210 ITST=ICUR-1,1,-1
- K = IORDER(ITST)
- IF (ZCUR .LT. DFACE(3,K)) GOTO 220
- K = IORDER(ITST)
- IORDER(ITST) = IORDER(ITST+1)
- IORDER(ITST+1) = K
- 210 CONTINUE
- 220 CONTINUE
-*
-** Z - D E P T H A L G O R I T H M
-*
- KFACE = NFACE
- 300 IF (KFACE .EQ. 1) GOTO 900
- NF = IORDER(KFACE)
- IF (NF .LT. 0) NF =-NF
- ABCDN(1) = ABCD(1,NF)
- ABCDN(2) = ABCD(2,NF)
- ABCDN(3) = ABCD(3,NF)
- ABCDN(4) = ABCD(4,NF)
- N1 = IABS(IFACE(1,NF))
- N2 = IABS(IFACE(2,NF))
- N3 = IABS(IFACE(3,NF))
-*
-** I N T E R N A L L O O P
-*
- DO 800 K=KFACE-1,1,-1
- KF = IORDER(K)
- IF (KF .LT. 0) KF =-KF
- IF (DFACE(6,NF) .GT. DFACE(3,KF)+DEL) GOTO 400
- IF (IORDER(K) .GT. 0) GOTO 900
- GOTO 800
-*
-** M I N - M A X T E S T
-*
- 400 IF (DFACE(1,KF) .GE. DFACE(4,NF)-DEL) GOTO 800
- IF (DFACE(4,KF) .LE. DFACE(1,NF)+DEL) GOTO 800
- IF (DFACE(2,KF) .GE. DFACE(5,NF)-DEL) GOTO 800
- IF (DFACE(5,KF) .LE. DFACE(2,NF)+DEL) GOTO 800
-*
-** K F B E F O R E N F ?
-*
- K1 = IABS(IFACE(1,KF))
- K2 = IABS(IFACE(2,KF))
- K3 = IABS(IFACE(3,KF))
- IF (ABCDN(1)*XYZ(1,K1)+ABCDN(2)*XYZ(2,K1)+
- & ABCDN(3)*XYZ(3,K1)+ABCDN(4) .LT. -DEL) GOTO 500
- IF (ABCDN(1)*XYZ(1,K2)+ABCDN(2)*XYZ(2,K2)+
- & ABCDN(3)*XYZ(3,K2)+ABCDN(4) .LT. -DEL) GOTO 500
- IF (ABCDN(1)*XYZ(1,K3)+ABCDN(2)*XYZ(2,K3)+
- & ABCDN(3)*XYZ(3,K3)+ABCDN(4) .LT. -DEL) GOTO 500
- GOTO 800
-*
-** N F A F T E R K F ?
-*
- 500 ABCDK(1) = ABCD(1,KF)
- ABCDK(2) = ABCD(2,KF)
- ABCDK(3) = ABCD(3,KF)
- ABCDK(4) = ABCD(4,KF)
- IF (ABCDK(1)*XYZ(1,N1)+ABCDK(2)*XYZ(2,N1)+
- & ABCDK(3)*XYZ(3,N1)+ABCDK(4) .GT. DEL) GOTO 600
- IF (ABCDK(1)*XYZ(1,N2)+ABCDK(2)*XYZ(2,N2)+
- & ABCDK(3)*XYZ(3,N2)+ABCDK(4) .GT. DEL) GOTO 600
- IF (ABCDK(1)*XYZ(1,N3)+ABCDK(2)*XYZ(2,N3)+
- & ABCDK(3)*XYZ(3,N3)+ABCDK(4) .GT. DEL) GOTO 600
- GOTO 800
-*
-** E D G E B Y E D G E T E S T
-** K F - E D G E S A G A I N S T N F
-*
- 600 DO 610 I=1,3
- I1 = KK(I)
- I2 = KK(1)
- IF (I .NE. 3) I2 = KK(I+1)
- CALL IHZTST(DEL,XYZ,I1,I2,NN,ABCDN,IREP)
- IF (IREP) 700,610,800
- 610 CONTINUE
-** N F - E D G E S A G A I N S T K F
- DO 620 I=1,3
- I1 = NN(I)
- I2 = NN(1)
- IF (I .NE. 3) I2 = NN(I+1)
- CALL IHZTST(DEL,XYZ,I1,I2,KK,ABCDK,IREP)
- IF (IREP) 800,620,700
- 620 CONTINUE
- GOTO 800
-*
-** C H A N G E F A C E O R D E R
-*
- 700 KF = IORDER(K)
- DO 710 I=K+1,KFACE
- IORDER(I-1) = IORDER(I)
- 710 CONTINUE
- IORDER(KFACE) =-KF
- IF (KF .GT. 0) GOTO 300
-* WRITE(*,*) 'IHZDEP: loop'
- GOTO 900
- 800 CONTINUE
-*
-** N E X T F A C E
-*
- 900 IF (IORDER(KFACE) .LT. 0) IORDER(KFACE) =-IORDER(KFACE)
- KFACE = KFACE - 1
- IF (KFACE .GT. 0) GOTO 300
-*
- 999 RETURN
- END
diff --git a/src/graflib/higz/ih/ihztst.F b/src/graflib/higz/ih/ihztst.F
deleted file mode 100644
index 0d8268b..0000000
--- a/src/graflib/higz/ih/ihztst.F
+++ /dev/null
@@ -1,89 +0,0 @@
-*
-* $Id: ihztst.F,v 1.1.1.1 1996/02/14 13:10:55 mclareni Exp $
-*
-* $Log: ihztst.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:55 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.19/05 26/08/93 09.53.55 by O.Couet
-*-- Author :
- SUBROUTINE IHZTST(DEL,XYZ,I1,I2,IFACE,ABCD,IREP)
-************************************************************************
-* *
-* IHZTST Date: 18.03.90 *
-* Author: E. Chernyaev (IHEP) Revised: 30.07.93 *
-* *
-* Function: Test edge against face (triangle) *
-* *
-* Input: DEL - precision *
-* XYZ(3,*) - nodes *
-* I1 - 1-st node of edge *
-* I2 - 2-nd node of edge *
-* IFACE(3) - triangular face *
-* ABCD(4) - face plane *
-* *
-* Output: IREP:-1 - edge under face *
-* 0 - no decision *
-* +1 - edge before face *
-* *
-************************************************************************
- REAL XYZ(3,*),ABCD(4),D(3),DELTA(3),T(2)
- INTEGER IFACE(3)
- EQUIVALENCE (DX,DELTA(1)),(DY,DELTA(2)),(DZ,DELTA(3))
-*-
- IREP = 0
-*
-** F I N D I N T E R S E C T I O N P O I N T S
-*
- DX = XYZ(1,I2) - XYZ(1,I1)
- DY = XYZ(2,I2) - XYZ(2,I1)
- DZ = XYZ(3,I2) - XYZ(3,I1)
- IF (ABS(DX).LE.DEL .AND. ABS(DY).LE.DEL) GOTO 999
- IXY = 1
- IF (ABS(DY) .GT. ABS(DX)) IXY = 2
- A = DY
- B =-DX
- C =-(A*XYZ(1,I1) + B*XYZ(2,I1))
- D(1) = A*XYZ(1,IFACE(1)) + B*XYZ(2,IFACE(1)) + C
- D(2) = A*XYZ(1,IFACE(2)) + B*XYZ(2,IFACE(2)) + C
- D(3) = A*XYZ(1,IFACE(3)) + B*XYZ(2,IFACE(3)) + C
- K = 0
- DO 100 I=1,3
- K1 = I
- K2 = I + 1
- IF (I .EQ. 3) K2 = 1
- IF (D(K1).GE.0. .AND. D(K2).GE.0.) GOTO 100
- IF (D(K1).LT.0. .AND. D(K2).LT.0.) GOTO 100
- D1 = D(K1) / (D(K1) - D(K2))
- D2 = D(K2) / (D(K1) - D(K2))
- XY = D1*XYZ(IXY,IFACE(K2)) - D2*XYZ(IXY,IFACE(K1))
- K = K + 1
- T(K) = (XY-XYZ(IXY,I1)) / DELTA(IXY)
- IF (K .EQ. 2) GOTO 200
- 100 CONTINUE
- GOTO 999
-*
-** C O M P A R E Z - D E P T H
-*
- 200 TMIN = AMIN1(T(1),T(2))
- TMAX = AMAX1(T(1),T(2))
- IF (TMIN.GT.1. .OR. TMAX.LT.0) GOTO 999
- IF (TMIN .LT. 0.) TMIN = 0.
- IF (TMAX .GT. 1.) TMAX = 1.
- TMID = (TMIN + TMAX) / 2.
- X = DX*TMID + XYZ(1,I1)
- Y = DY*TMID + XYZ(2,I1)
- Z = DZ*TMID + XYZ(3,I1)
- DD = ABCD(1)*X + ABCD(2)*Y + ABCD(3)*Z + ABCD(4)
- IF (DD .GT. DEL) GOTO 997
- IF (DD .LT.-DEL) GOTO 998
- GOTO 999
-*
- 997 IREP =+1
- GOTO 999
- 998 IREP =-1
- GOTO 999
- 999 RETURN
- END
diff --git a/src/graflib/higz/ikernel/Imakefile b/src/graflib/higz/ikernel/Imakefile
deleted file mode 100644
index a4b0372..0000000
--- a/src/graflib/higz/ikernel/Imakefile
+++ /dev/null
@@ -1,37 +0,0 @@
-DoIncludePackage(higz)
-#include "pilot.h"
-
-SRCS_F= iacwk.F iclks.F iclwk.F idawk.F ifa.F igsa.F \ @@\
- igsg.F iopks.F \ @@\
- iopwk.F ipl.F ipm.F irqlc.F irqst.F ischh.F ischup.F isclip.F \ @@\
- iscr.F iselnt.F isfaci.F isfais.F isfasi.F isln.F islwsc.F \ @@\
- ismk.F ismksc.F isplci.F ispmci.F istxal.F istxci.F istxfp.F \ @@\
- isvp.F iswkvp.F iswkwn.F iswn.F itx.F iuwk.F
-
-#if !defined(CERNLIB_MSDOS)
-SRCS_F := $(SRCS_F) iclrwk.F
-#endif
-
-#if defined(CERNLIB_X11)
-SRCS_F := $(SRCS_F) ikfntx.F ikuwk.F
-#endif
-
-#if !defined(CERNLIB_BATCH)
-SRCS_F := $(SRCS_F) ikpl.F
-#endif
-
-#if defined(CERNLIB_GL) || defined(CERNLIB_X11) || \
- defined(CERNLIB_FALCO) || defined(CERNLIB_MACMPW)
-SRCS_F := $(SRCS_F) ikbox.F
-#endif
-
-#if defined(CERNLIB_KERNEL) && \
- !defined(CERNLIB_PHIGS) && !defined(CERNLIB_MSDOS)
-SRCS_F := $(SRCS_F) ikfile.F
-#endif
-
-#ifdef CERNLIB_DECS
-SpecialFortranLibObjectRule(ikpl,ikpl,-O1,NullParameter)
-#endif
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/graflib/higz/ikernel/iacwk.F b/src/graflib/higz/ikernel/iacwk.F
deleted file mode 100644
index 95da34a..0000000
--- a/src/graflib/higz/ikernel/iacwk.F
+++ /dev/null
@@ -1,135 +0,0 @@
-*
-* $Id: iacwk.F,v 1.2 1996/09/25 14:58:40 couet Exp $
-*
-* $Log: iacwk.F,v $
-* Revision 1.2 1996/09/25 14:58:40 couet
-* - GPR driver removed
-*
-* Revision 1.1.1.1 1996/02/14 13:10:55 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.21/09 22/08/94 18.27.58 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE IACWK(IWKID)
- ENTRY GACWK(IWKID)
-#include "higz/hiflag.inc"
-#if defined(CERNLIB_KERNEL)
-#include "higz/hikern.inc"
-#endif
-#include "higz/hiatt.inc"
-#if defined(CERNLIB_MSDOS)
-#include "higz/himeta.inc"
-#endif
-#if defined(CERNLIB_X11)
- INTEGER DASHED(2),DOTTED(2),DSHDOT(4)
- DATA DASHED/5,5/
- DATA DOTTED/1,3/
- DATA DSHDOT/5,3,1,3/
-#endif
-#if !defined(CERNLIB_BATCH)
- IF(IWKID.EQ.0)THEN
- CALL IGERR('Workstation identifier equal 0','IACWK')
- RETURN
- ENDIF
- DO 10 I=1,INOPWK
- IF(ILOPWK(I).EQ.IWKID)THEN
- ACWKFL(I)=.TRUE.
- IF(IWTYL(I).LE.0)THEN
- NODRFL(I)=.TRUE.
- ELSE
- NODRFL(I)=.FALSE.
- ENDIF
- IWKIND=I
- GOTO 20
- ENDIF
- 10 CONTINUE
- CALL IGERR('Workstation is not open','IACWK')
- RETURN
- 20 CONTINUE
-#endif
-#if defined(CERNLIB_MSDOS)
- ISAVE = IWKNB
- IWKNB = IWKIND
-#endif
-#if defined(CERNLIB_PSCRIPT)
-*
-* Active the PostScript metafile
-*
- IF(IGIWTY(IWKID).LT.0)THEN
- PFLAG=.TRUE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- RETURN
- ENDIF
-#endif
-#if defined(CERNLIB_KERNEL)
-*
-* Initialise the default attributes for the screen
-*
- CALL IGSG(IWKIND)
-#endif
-#if (defined(CERNLIB_GL))&&(!defined(CERNLIB_MSDOS))
- CALL COLOR(IPLCI+IOFCOL)
- ICURCI(IWKIND)=IPLCI
- IF(IFAIS.LE.1)THEN
- CALL SETPAT(0)
- ELSE
- CALL SETPAT(IFASI)
- ENDIF
- CALL SETLIN(ILN-1)
- CALL LINEWI(INT(RLWSC))
-*
-#endif
-#if defined(CERNLIB_MSDOS)
- CALL COLOR(IPLCI+IOFCOL)
- ICURCI(IWKIND)=IPLCI
- IF(IFAIS.LE.1)THEN
- CALL SETPAT(0)
- ELSE
- CALL SETPAT(IFASI)
- ENDIF
- CALL SETLIN(ILN)
- CALL LINEWI(INT(RLWSC))
- IF(IWKID.EQ.IDMETA)THEN
- IF(IWTYL(IWKNB).EQ.ISURF)THEN
- XMFACT = 1.0
- YMFACT = 1.0
- ENDIF
- ENDIF
- IWKNB = ISAVE
-*
-#endif
-#if defined(CERNLIB_FALCO)
- IF(IGIWTY(IWKID).EQ.7878)RETURN
- IF(IGIWTY(IWKID).EQ.7879)THEN
- CALL IGSA(0)
- RETURN
- ENDIF
-#endif
-#if defined(CERNLIB_X11)
- CALL IXSELWI(IWINID(IWKIND))
- CALL IXSETFC(IFACI)
- CALL IXSETLC(IPLCI)
- CALL IXSETMC(IPMCI)
- CALL IXSETTC(ITXCI)
- CALL IXSETFS(MIN(1,IFAIS),0)
-#endif
-#if (defined(CERNLIB_X11))&&(!defined(CERNLIB_WINNT))
- IF(ILN.EQ.1)CALL IXSETLS(0,0)
- IF(ILN.EQ.2)CALL IXSETLS(2,DASHED)
- IF(ILN.EQ.3)CALL IXSETLS(2,DOTTED)
- IF(ILN.EQ.4)CALL IXSETLS(4,DSHDOT)
-#endif
-#if (defined(CERNLIB_X11))&&(defined(CERNLIB_WINNT))
- CALL IXSETLS(-ILN, 0)
-#endif
-#if defined(CERNLIB_X11)
- CALL IXSETLN(MAX(INT(RLWSC/2.2),1))
- CALL IXSETTA(ITXALH,ITXALV)
-*
-#endif
-#if defined(CERNLIB_KERNEL)
- CALL IGSA(0)
-#endif
- END
diff --git a/src/graflib/higz/ikernel/iclks.F b/src/graflib/higz/ikernel/iclks.F
deleted file mode 100644
index 3559a73..0000000
--- a/src/graflib/higz/ikernel/iclks.F
+++ /dev/null
@@ -1,35 +0,0 @@
-*
-* $Id: iclks.F,v 1.2 1996/09/25 14:58:40 couet Exp $
-*
-* $Log: iclks.F,v $
-* Revision 1.2 1996/09/25 14:58:40 couet
-* - GPR driver removed
-*
-* Revision 1.1.1.1 1996/02/14 13:10:55 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.21/09 23/08/94 09.34.58 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE ICLKS
- ENTRY GCLKS
-#include "higz/hiatt.inc"
- DIMENSION ICLSWK(10)
- IEND = INOPWK
- DO 10 I=1,IEND
- ICLSWK(I) = ILOPWK(I)
- 10 CONTINUE
- DO 20 I=1,IEND
- CALL ICLWK(ICLSWK(I))
- 20 CONTINUE
-#if defined(CERNLIB_X11)
- CALL IXCLSDS
-#endif
-#if defined(CERNLIB_MACMPW)
- CALL IMCLSDS
-#endif
-#if defined(CERNLIB_PHIGS)
- CALL PCLPH
-#endif
- END
diff --git a/src/graflib/higz/ikernel/iclrwk.F b/src/graflib/higz/ikernel/iclrwk.F
deleted file mode 100644
index e4a0e18..0000000
--- a/src/graflib/higz/ikernel/iclrwk.F
+++ /dev/null
@@ -1,114 +0,0 @@
-*
-* $Id: iclrwk.F,v 1.3 1998/01/28 14:34:40 couet Exp $
-*
-* $Log: iclrwk.F,v $
-* Revision 1.3 1998/01/28 14:34:40 couet
-* - GGDM driver removed
-*
-* Revision 1.2 1996/09/25 14:58:41 couet
-* - GPR driver removed
-*
-* Revision 1.1.1.1 1996/02/14 13:10:55 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-#if !defined(CERNLIB_MSDOS)
-*CMZ : 1.23/06 20/11/95 17.15.55 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE ICLRWK(IWKID,ICOFL)
- ENTRY GCLRWK(IWKID,ICOFL)
-#if defined(CERNLIB_KERNEL)
-#include "higz/hikern.inc"
-#endif
-#include "higz/hiatt.inc"
-#include "higz/hiflag.inc"
- DIMENSION RVAL(2)
-*
- IF(GFLAG)THEN
-#if defined(CERNLIB_KERNEL)||defined(CERNLIB_FALCO)||defined(CERNLIB_PHIGS)
- IF(IWKID.EQ.0)THEN
- DO 10 I=1,INOPWK
- IF(NODRFL(I))GOTO 10
- CALL IGQWK(ILOPWK(I),'MXDS',RVAL)
- IF((REDIT.NE.0).AND.(REDIT.NE.1.))THEN
- CALL IGCLES
- ELSE
- CALL IGSG(I)
-#endif
-#if defined(CERNLIB_FALCO)
- IF(IWTYL(I).EQ.7878.OR.IWTYL(I).EQ.7879)THEN
- CALL IFCLR(IWTYL(I))
- GOTO 10
- ENDIF
-#endif
-#if defined(CERNLIB_GL)
- CALL WINPOP
- CALL SETPAT(0)
- CALL COLOR(IOFCOL)
- ICURCI(I)=0
- CALL CLEAR
- IF(IFAIS.GT.1)CALL SETPAT(IFASI)
-#endif
-#if defined(CERNLIB_X11)
- CALL IXCLRWI
-#endif
-#if defined(CERNLIB_ZBUF)
- IF (IZBUF.NE.0) CALL IHZCLE(0)
-#endif
-#if defined(CERNLIB_MACMPW)
- CALL IMCLRWI
-#endif
-#if defined(CERNLIB_PHIGS)
- CALL PXCLEAR_WS(ILOPWK(I))
-#endif
-#if defined(CERNLIB_KERNEL)||defined(CERNLIB_FALCO)||defined(CERNLIB_PHIGS)
- ENDIF
- 10 CONTINUE
- ELSE
- IWT=IGIWTY(IWKID)
- IF(IWT.LE.0)GOTO 999
- CALL IGQWK(IWKID,'MXDS',RVAL)
- IF((REDIT.NE.0).AND.(REDIT.NE.1.))THEN
- CALL IGCLES
- ELSE
- I=IGIWIN(IWKID)
- CALL IGSG(I)
-#endif
-#if defined(CERNLIB_FALCO)
- IF(IWT.EQ.7878.OR.IWT.EQ.7879)THEN
- CALL IFCLR(IWT)
- GOTO 999
- ENDIF
-#endif
-#if defined(CERNLIB_GL)
- CALL WINPOP
- CALL SETPAT(0)
- CALL COLOR(IOFCOL)
- ICURCI(I)=0
- CALL CLEAR
- IF(IFAIS.GT.1)CALL SETPAT(IFASI)
-#endif
-#if defined(CERNLIB_X11)
- CALL IXCLRWI
-#endif
-#if defined(CERNLIB_ZBUF)
- IF (IZBUF.NE.0) CALL IHZCLE(0)
-#endif
-#if defined(CERNLIB_MACMPW)
- CALL IMCLRWI
-#endif
-#if defined(CERNLIB_PHIGS)
- CALL PXCLEAR_WS(IWKID)
-#endif
-#if defined(CERNLIB_KERNEL)||defined(CERNLIB_FALCO)||defined(CERNLIB_PHIGS)
- ENDIF
- ENDIF
-#endif
- ENDIF
- 999 CONTINUE
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_PSCRIPT)||defined(CERNLIB_MAIL)
- IF(GLFLAG)CALL IZCLRD
-#endif
- END
-#endif
diff --git a/src/graflib/higz/ikernel/iclwk.F b/src/graflib/higz/ikernel/iclwk.F
deleted file mode 100644
index ceb2c2a..0000000
--- a/src/graflib/higz/ikernel/iclwk.F
+++ /dev/null
@@ -1,105 +0,0 @@
-*
-* $Id: iclwk.F,v 1.2 1996/09/25 14:58:42 couet Exp $
-*
-* $Log: iclwk.F,v $
-* Revision 1.2 1996/09/25 14:58:42 couet
-* - GPR driver removed
-*
-* Revision 1.1.1.1 1996/02/14 13:10:55 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.23/01 08/05/95 11.41.29 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE ICLWK(IWKID)
- ENTRY GCLWK(IWKID)
-#if defined(CERNLIB_KERNEL)
-#include "higz/hikern.inc"
-#endif
-#if defined(CERNLIB_PSCRIPT)
-#include "higz/hipost.inc"
-#endif
-#include "higz/hiatt.inc"
-#include "higz/hiflag.inc"
-#include "higz/himeta.inc"
-*
- IF(IGIWIN(IWKID).EQ.0)THEN
- CALL IGERR('This workstation is not open','ICLWK')
- RETURN
- ENDIF
-#if !defined(CERNLIB_BATCH)
- IF(IGIWTY(IWKID).GT.0.AND.GFLAG)THEN
-#endif
-#if (defined(CERNLIB_GL))&&(!defined(CERNLIB_MSDOS))
- CALL WINCLO(IWINID(IGIWIN(IWKID)))
-#endif
-#if defined(CERNLIB_MSDOS)
- IF(IGIWTY(IWKID).EQ.ISURF.AND.IWKID.EQ.IDMETA) THEN
- CALL GOLCLO
- ELSE
- CALL TEXT_MODE
- ENDIF
-#endif
-#if defined(CERNLIB_FALCO)
- ITY = IGIWTY(IWKID)
- IF(ITY.EQ.7878.OR.ITY.EQ.7879)THEN
- IWTYPE = 0
- GOTO 10
- ENDIF
-#endif
-#if defined(CERNLIB_X11)
- CALL IXSELWI(IWINID(IGIWIN(IWKID)))
- CALL IXCLSWI
-#endif
-#if defined(CERNLIB_MACMPW)
- CALL IMCLSWI
-#endif
-#if defined(CERNLIB_PHIGS)
- CALL PCLWK(IWKID)
-#endif
-#if !defined(CERNLIB_BATCH)
- GOTO 10
- ENDIF
-#endif
-#if defined(CERNLIB_PSCRIPT)
- IF(IGIWTY(IWKID).LT.0)THEN
- CALL IPEND
- IF(IWKID.EQ.IDMETA.AND.FILOPN)FILOPN=.FALSE.
- GOTO 10
- ENDIF
-#endif
- 10 CONTINUE
- DO 30 I=1,INOPWK
- IF(ILOPWK(I).EQ.IWKID)THEN
- INOPWK=INOPWK-1
- DO 20 J=I,INOPWK
- ILOPWK(J) = ILOPWK(J+1)
- IWTYL(J) = IWTYL(J+1)
-#if defined(CERNLIB_PSCRIPT)
- IF (IWTYL(J).LT.0) IPSI = J
-#endif
- ACWKFL(J) = ACWKFL(J+1)
- XWKSIZ(J) = XWKSIZ(J+1)
- YWKSIZ(J) = YWKSIZ(J+1)
- WKMAX(J) = WKMAX(J+1)
- IWINID(J) = IWINID(J+1)
- NODRFL(J) = NODRFL(J+1)
-#if defined(CERNLIB_KERNEL)
- WKSC(J) = WKSC(J+1)
- XWKR(J) = XWKR(J+1)
- YWKR(J) = YWKR(J+1)
- XWKW1(J) = XWKW1(J+1)
- YWKW1(J) = YWKW1(J+1)
- XWKV1(J) = XWKV1(J+1)
- YWKV1(J) = YWKV1(J+1)
- XWKW2(J) = XWKW2(J+1)
- YWKW2(J) = YWKW2(J+1)
- XWKV2(J) = XWKV2(J+1)
- YWKV2(J) = YWKV2(J+1)
-#endif
- 20 CONTINUE
- RETURN
- ENDIF
- 30 CONTINUE
- END
diff --git a/src/graflib/higz/ikernel/idawk.F b/src/graflib/higz/ikernel/idawk.F
deleted file mode 100644
index 25ebbc8..0000000
--- a/src/graflib/higz/ikernel/idawk.F
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: idawk.F,v 1.1.1.1 1996/02/14 13:10:55 mclareni Exp $
-*
-* $Log: idawk.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:55 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.13/09 11/12/91 17.59.57 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE IDAWK(IWKID)
- ENTRY GDAWK(IWKID)
-#include "higz/hiflag.inc"
-#include "higz/hiatt.inc"
- DO 10 I=1,INOPWK
- IF(ILOPWK(I).EQ.IWKID)THEN
- ACWKFL(I)=.FALSE.
- NODRFL(I)=.TRUE.
- GOTO 20
- ENDIF
- 10 CONTINUE
- CALL IGERR('Workstation is not active','IDAWK')
- RETURN
- 20 CONTINUE
-#if defined(CERNLIB_PSCRIPT)
- IF(IGIWTY(IWKID).LT.0)THEN
- PFLAG=.FALSE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- RETURN
- ENDIF
-#endif
- END
diff --git a/src/graflib/higz/ikernel/ifa.F b/src/graflib/higz/ikernel/ifa.F
deleted file mode 100644
index 8f50d71..0000000
--- a/src/graflib/higz/ikernel/ifa.F
+++ /dev/null
@@ -1,147 +0,0 @@
-*
-* $Id: ifa.F,v 1.3 1998/01/28 14:34:41 couet Exp $
-*
-* $Log: ifa.F,v $
-* Revision 1.3 1998/01/28 14:34:41 couet
-* - GGDM driver removed
-*
-* Revision 1.2 1996/09/25 14:58:43 couet
-* - GPR driver removed
-*
-* Revision 1.1.1.1 1996/02/14 13:10:55 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.23/01 08/05/95 11.43.59 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE IFA(N,X,Y)
- ENTRY GFA(N,X,Y)
-#if defined(CERNLIB_KERNEL)
-#include "higz/hikern.inc"
-#endif
-#include "higz/hiatt.inc"
-#include "higz/hiflag.inc"
-#if defined(CERNLIB_FALCO)||defined(CERNLIB_MACMPW)
- DIMENSION XCLOSE(2),YCLOSE(2)
-#endif
- DIMENSION X(*),Y(*)
-*
-#if defined(CERNLIB_KERNEL)
-#include "higz/hiwcdc.inc"
-#endif
-#if defined(CERNLIB_KERNEL)
- IF(N.LT.3.OR.N.GT.IBUFSI-1)THEN
- CALL IGERR('Invalid number of points','IFA')
- RETURN
- ENDIF
-#endif
- IF(IFAIS.EQ.3.AND.IFASI.GE.100)THEN
- CALL IGFA(N,X,Y)
- ELSE
- IF(GFLAG)THEN
-#if defined(CERNLIB_PHIGS)
- CALL PFA(N,X,Y)
-#endif
-#if defined(CERNLIB_KERNEL)||defined(CERNLIB_FALCO)
- DO 70 IWKNB=1,INOPWK
- IF(NODRFL(IWKNB))GOTO 70
- CALL IGSG(IWKNB)
-#endif
-#if defined(CERNLIB_FALCO)
- IF(IWTYL(IWKNB).EQ.7878.OR.IWTYL(IWKNB).EQ.7879)THEN
- IF(IFAIS.EQ.1)THEN
- CALL IGHATC(0.001,0.,N,X,Y)
- ELSE
- CALL IFPL(N,X,Y)
- XCLOSE(1)=X(1)
- YCLOSE(1)=Y(1)
- XCLOSE(2)=X(N)
- YCLOSE(2)=Y(N)
- CALL IFPL(2,XCLOSE,YCLOSE)
- ENDIF
- GOTO 70
- ENDIF
-#endif
-#if (defined(CERNLIB_GL))&&(!defined(CERNLIB_MSDOS))
- DO 20 I=1,N
- IPOS(1,I)=IXWCDC(X(I))
- IPOS(2,I)=IYWCDC(Y(I))
- 20 CONTINUE
- IF(ICURCI(IWKNB).NE.IFACI)THEN
- CALL COLOR(IFACI+IOFCOL)
- ICURCI(IWKNB)=IFACI
- ENDIF
- IF(IFAIS.NE.0)THEN
- CALL POLF2I(N,IPOS)
- ELSE
- CALL POLY2I(N,IPOS)
- ENDIF
-#endif
-#if defined(CERNLIB_MSDOS)
- IF(IFAIS.EQ.1.AND.ILOPWK(IWKNB).EQ.IDMETA)THEN
- CALL IGHATC(0.001,0.0,N,X,Y)
- ELSE
- DO 30 I=1,N
-#endif
-#if (defined(CERNLIB_MSDOS))&&(defined(CERNLIB_NDP))
- IPOS(I,1)=IXWCDC(X(I))
- IPOS(I,2)=IYWCDC(Y(I))
-#endif
-#if (defined(CERNLIB_MSDOS))&&(!defined(CERNLIB_NDP))
- IPOS(1,I)=IXWCDC(X(I))
- IPOS(2,I)=IYWCDC(Y(I))
-#endif
-#if defined(CERNLIB_MSDOS)
- 30 CONTINUE
- IF(ICURCI(IWKNB).NE.IFACI)THEN
- CALL COLOR(IFACI+IOFCOL)
- ICURCI(IWKNB)=IFACI
- ENDIF
- IF(IFAIS.NE.0)THEN
- CALL POLF2I(N,IPOS)
- ELSE
- CALL POLY2I(N,IPOS)
- ENDIF
- ENDIF
-#endif
-#if defined(CERNLIB_X11)
- NP=N
- DO 40 I=1,NP
- IPOS(1,I)=IXWCDC(X(I))
- IPOS(2,I)=IYWCDC(Y(I))
- 40 CONTINUE
-#endif
-#if (defined(CERNLIB_X11))&&(!defined(CERNLIB_WINNT))
- IF(IFAIS.EQ.0)THEN
- IPOS(1,NP+1)=IPOS(1,1)
- IPOS(2,NP+1)=IPOS(2,1)
- NP=NP+1
- ENDIF
-#endif
-#if defined(CERNLIB_X11)
- CALL IXFLARE(NP,IPOS)
-#endif
-#if defined(CERNLIB_MACMPW)
- NP=N
- DO 60 I=1,NP
- IPOS(1,I)=IXWCDC(X(I))
- IPOS(2,I)=IYWCDC(Y(I))
- 60 CONTINUE
- IF(IFAIS.EQ.0)THEN
- IPOS(1,NP+1)=IPOS(1,1)
- IPOS(2,NP+1)=IPOS(2,1)
- NP=NP+1
- ENDIF
- CALL IMFLARE(NP,IPOS)
-#endif
-#if defined(CERNLIB_KERNEL)||defined(CERNLIB_FALCO)
- 70 CONTINUE
-#endif
- ENDIF
- ENDIF
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_PSCRIPT)||defined(CERNLIB_MAIL)
- IF(GLFLAG)CALL IZFA(N,X,Y)
-#endif
-*
- END
diff --git a/src/graflib/higz/ikernel/igsa.F b/src/graflib/higz/ikernel/igsa.F
deleted file mode 100644
index 96c34c2..0000000
--- a/src/graflib/higz/ikernel/igsa.F
+++ /dev/null
@@ -1,73 +0,0 @@
-*
-* $Id: igsa.F,v 1.3 1998/01/28 14:34:41 couet Exp $
-*
-* $Log: igsa.F,v $
-* Revision 1.3 1998/01/28 14:34:41 couet
-* - GGDM driver removed
-*
-* Revision 1.2 1996/09/25 14:58:44 couet
-* - GPR driver removed
-*
-* Revision 1.1.1.1 1996/02/14 13:10:55 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.21/03 06/06/94 11.51.09 by O.Couet
-*-- Author : O.Couet 06/02/90
- SUBROUTINE IGSA(IWK)
-#if defined(CERNLIB_FALCO)
-#include "higz/hiatt.inc"
-#endif
-#include "higz/hiflag.inc"
-#if defined(CERNLIB_FALCO)
- CHARACTER*4 CHREP
-#endif
- IF(GRFLAG)THEN
- GRFLAG=.FALSE.
-#if defined(CERNLIB_FALCO)
- IF(IWK.EQ.0)THEN
- DO 10 I=1,INOPWK
- IF(IWTYL(I).EQ.7878)THEN
- CALL IFMOVE(0.,0.)
- CALL IFPUT(0)
- READ (*,'(A)') CHREP
- CALL IFPUT(31)
- CALL IFPUT(24)
- CALL IFPUT(0)
- GOTO 10
- ENDIF
- IF(IWTYL(I).EQ.7879)THEN
- CALL IFPUT(27)
- CALL IFPUT(3)
- CALL IFPUT(0)
- GOTO 10
- ENDIF
- 10 CONTINUE
- ELSE
- IWT = IGIWTY(IWK)
- IF(IWT.EQ.7878)THEN
- CALL IFMOVE(0.,0.)
- CALL IFPUT(0)
- READ (*,'(A)') CHREP
- CALL IFPUT(31)
- CALL IFPUT(24)
- CALL IFPUT(0)
- RETURN
- ENDIF
- IF(IWT.EQ.7879)THEN
- CALL IFPUT(27)
- CALL IFPUT(3)
- CALL IFPUT(0)
- RETURN
- ENDIF
- ENDIF
-#endif
-#if defined(CERNLIB_MSDOS)
- CALL LOCATE(0,0)
-#endif
-#if defined(CERNLIB_MACMPW)
- CALL IMACPLO(0,0,-999)
-#endif
- ENDIF
- END
diff --git a/src/graflib/higz/ikernel/igsg.F b/src/graflib/higz/ikernel/igsg.F
deleted file mode 100644
index 7f8b7fc..0000000
--- a/src/graflib/higz/ikernel/igsg.F
+++ /dev/null
@@ -1,77 +0,0 @@
-*
-* $Id: igsg.F,v 1.2 1996/09/25 14:58:45 couet Exp $
-*
-* $Log: igsg.F,v $
-* Revision 1.2 1996/09/25 14:58:45 couet
-* - GPR driver removed
-*
-* Revision 1.1.1.1 1996/02/14 13:10:55 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.20/06 07/01/94 15.19.30 by O.Couet
-*-- Author : O.Couet 06/02/90
- SUBROUTINE IGSG(IWK)
-#if defined(CERNLIB_KERNEL)
-#include "higz/hikern.inc"
-#endif
-#if defined(CERNLIB_MSDOS)
-#include "higz/himeta.inc"
-#endif
-#include "higz/hiatt.inc"
-#include "higz/hiflag.inc"
-#if defined(CERNLIB_MSDOS)
- PARAMETER (IVGA=18)
-#endif
- IF(ICURWK.NE.IWK)THEN
-#if defined(CERNLIB_FALCO)
- IF(IGIWTY(IWK).EQ.7878.OR.IGIWTY(IWK).EQ.7879)GOTO 10
-#endif
-#if defined(CERNLIB_GL)
- CALL WINSET(IWINID(IWK))
-#endif
-#if defined(CERNLIB_X11)
- CALL IXSELWI(IWINID(IWK))
-#endif
- ICURWK=IWK
- ENDIF
- 10 IF(.NOT.GRFLAG)THEN
-#if defined(CERNLIB_MSDOS)
- IF(ILOPWK(IWK).NE.IDMETA)THEN
- I = GET_VIDEO_MODE(LRX,LCY)
- IF (I .GT. 0 .and. I .le. 7) THEN
- IF (IWTYL(IWK) .LE. IVGA+1) THEN
- IER = GRAPHICS_MODE(IWTYL(IWK))
- ELSE
- IER = SUPER_VGA(IWTYL(IWK), 800, 600)
- END IF
- END IF
- IF (IWTYL(IWK) .LT. IVGA) THEN
- IER = SET_PALETTE(PAL)
- ELSE
- CALL MAPCOL(0,1.,1.,1.)
- CALL MAPCOL(1,0.,0.,0.)
- CALL MAPCOL(2,1.,0.,0.)
- CALL MAPCOL(3,0.,1.,0.)
- CALL MAPCOL(4,0.,0.,1.)
- CALL MAPCOL(5,1.,1.,0.)
- CALL MAPCOL(6,1.,0.,1.)
- CALL MAPCOL(7,0.,0.,0.)
- END IF
- ENDIF
-#endif
- GRFLAG=.TRUE.
-#if defined(CERNLIB_FALCO)
- IF(IGIWTY(IWK).EQ.7879)THEN
- CALL IFPUT(27)
- CALL IFPUT(IGASCI('['))
- CALL IFPUT(IGASCI('?'))
- CALL IFPUT(IGASCI('3'))
- CALL IFPUT(IGASCI('8'))
- CALL IFPUT(IGASCI('h'))
- CALL IFPUT(0)
- ENDIF
-#endif
- ENDIF
- END
diff --git a/src/graflib/higz/ikernel/ikbox.F b/src/graflib/higz/ikernel/ikbox.F
deleted file mode 100644
index e7eb139..0000000
--- a/src/graflib/higz/ikernel/ikbox.F
+++ /dev/null
@@ -1,173 +0,0 @@
-*
-* $Id: ikbox.F,v 1.2 1996/09/25 14:58:46 couet Exp $
-*
-* $Log: ikbox.F,v $
-* Revision 1.2 1996/09/25 14:58:46 couet
-* - GPR driver removed
-*
-* Revision 1.1.1.1 1996/02/14 13:10:55 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-#if defined(CERNLIB_GL)||defined(CERNLIB_X11)||defined(CERNLIB_FALCO)||defined(CERNLIB_MACMPW)
-*CMZ : 1.22/08 14/02/95 09.29.55 by O.Couet
-*-- Author : O.Couet 17/05/90
- SUBROUTINE IKBOX(X1,X2,Y1,Y2)
-*.===========>
-*.
-*. This routine draws a boxe. The boxe is drawn according to the
-*. current fill area attributes. Most of the time the basic graphics
-*. packages are able to draw boxes in a very fast way. This routines
-*. access this type of facilities.
-*.
-*. _Input parameters:
-*.
-*. REAL X1,Y1 : Left down corner (in WC).
-*. REAL X2,Y2 : Right up corner (in WC).
-*.
-*..==========> (O.Couet)
-#if defined(CERNLIB_KERNEL)
-#include "higz/hikern.inc"
-#endif
-#include "higz/hiflag.inc"
-#include "higz/hiatt.inc"
- DIMENSION X(4),Y(4)
-*.______________________________________
-*
-#if defined(CERNLIB_KERNEL)
-#include "higz/hiwcdc.inc"
-#endif
-*
-* Draw the inside of the box with the portable
-* HIGZ hatches.
-*
- IF(IFAIS.EQ.3.AND.IFASI.GE.100)THEN
- X(1)=X1
- X(2)=X2
- X(3)=X2
- X(4)=X1
- Y(1)=Y1
- Y(2)=Y1
- Y(3)=Y2
- Y(4)=Y2
- CALL IGFA(4,X,Y)
- GOTO 20
- ENDIF
-#if defined(CERNLIB_FALCO)
- IF(IWTYPE.EQ.7878.OR.IWTYPE.EQ.7879)GOTO 20
-#endif
-#if defined(CERNLIB_KERNEL)
-*
-* Draw the inside of the box with color or
-* device dependant pattern.
-*
- IF(IFAIS.NE.0)THEN
- IF(GFLAG)THEN
- DO 10 IWKNB=1,INOPWK
- IF(NODRFL(IWKNB))GOTO 10
- CALL IGSG(IWKNB)
-#endif
-#if defined(CERNLIB_GL)
- IX1=IXWCDC(X1)
- IX2=IXWCDC(X2)
- IY1=IYWCDC(Y1)
- IY2=IYWCDC(Y2)
- IF(IFAIS.NE.0)THEN
- IF(ICURCI(IWKNB).NE.IFACI)THEN
- CALL COLOR(IFACI+IOFCOL)
- ICURCI(IWKNB)=IFACI
- ENDIF
- CALL SBOXFI(IX1,IY1,IX2,IY2)
- ENDIF
-#endif
-#if defined(CERNLIB_X11)
- IX1=IXWCDC(X1)
- IX2=IXWCDC(X2)
- IY1=IYWCDC(Y1)
- IY2=IYWCDC(Y2)
- MODE=1
- CALL IXBOX(IX1,IX2,IY1,IY2,MODE)
-#endif
-#if defined(CERNLIB_MACMPW)
- IX1=IXWCDC(X1)
- IX2=IXWCDC(X2)
- IY1=IYWCDC(Y1)
- IY2=IYWCDC(Y2)
- MODE=1
- CALL IMBOX(IX1,IX2,IY1,IY2,MODE)
-#endif
-#if defined(CERNLIB_KERNEL)
- 10 CONTINUE
- ENDIF
- ENDIF
-#endif
- 20 CONTINUE
-#if defined(CERNLIB_FALCO)
- IF(IWTYPE.EQ.7878.OR.IWTYPE.EQ.7879)THEN
- CALL IGSG(1)
- IF(GFLAG)THEN
- X(1)=X1
- X(2)=X2
- X(3)=X2
- X(4)=X1
- Y(1)=Y1
- Y(2)=Y1
- Y(3)=Y2
- Y(4)=Y2
- IF(IFAIS.EQ.1)CALL IGHATC(0.001,0.,4,X,Y)
- IF(IFAIS.EQ.0.OR.IBORD.EQ.1)THEN
- CALL IFPL(4,X,Y)
- X(2)=X(4)
- Y(2)=Y(4)
- CALL IFPL(2,X,Y)
- ENDIF
- ENDIF
- RETURN
- ENDIF
-#endif
-#if defined(CERNLIB_KERNEL)
-*
-* Draw the border of the box
-*
- IF(IFAIS.EQ.0.OR.IBORD.NE.0)THEN
- IF(GFLAG)THEN
- DO 30 IWKNB=1,INOPWK
- IF(NODRFL(IWKNB))GOTO 30
- CALL IGSG(IWKNB)
-#endif
-#if defined(CERNLIB_GL)
- IX1=IXWCDC(X1)
- IX2=IXWCDC(X2)
- IY1=IYWCDC(Y1)
- IY2=IYWCDC(Y2)
- IF(ICURCI(IWKNB).NE.IPLCI)THEN
- CALL COLOR(IPLCI+IOFCOL)
- ICURCI(IWKNB)=IPLCI
- ENDIF
- CALL SBOXI(IX1,IY1,IX2,IY2)
-#endif
-#if defined(CERNLIB_X11)
- IX1=IXWCDC(X1)
- IX2=IXWCDC(X2)
- IY1=IYWCDC(Y1)
- IY2=IYWCDC(Y2)
- MODE=0
- CALL IXBOX(IX1,IX2,IY1,IY2,MODE)
-#endif
-#if defined(CERNLIB_MACMPW)
- IX1=IXWCDC(X1)
- IX2=IXWCDC(X2)
- IY1=IYWCDC(Y1)
- IY2=IYWCDC(Y2)
- MODE=0
- CALL IMBOX(IX1,IX2,IY1,IY2,MODE)
-#endif
-#if defined(CERNLIB_KERNEL)
- 30 CONTINUE
- ENDIF
- ENDIF
-#endif
-*
- END
-#endif
diff --git a/src/graflib/higz/ikernel/ikfile.F b/src/graflib/higz/ikernel/ikfile.F
deleted file mode 100644
index c6b1266..0000000
--- a/src/graflib/higz/ikernel/ikfile.F
+++ /dev/null
@@ -1,172 +0,0 @@
-*
-* $Id: ikfile.F,v 1.4 1998/01/30 15:22:36 couet Exp $
-*
-* $Log: ikfile.F,v $
-* Revision 1.4 1998/01/30 15:22:36 couet
-* - APOLLO version removed
-*
-* Revision 1.3 1998/01/28 14:34:42 couet
-* - GGDM driver removed
-*
-* Revision 1.2 1997/10/23 12:29:55 mclareni
-* NT mods
-*
-* Revision 1.1.1.1 1996/02/14 13:10:55 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-#if (defined(CERNLIB_KERNEL))&&(!defined(CERNLIB_PHIGS))&&(!defined(CERNLIB_MSDOS))
-*CMZ : 1.23/03 01/09/95 12.03.27 by O.Couet
-*-- Author : O.Couet 08/02/91
- SUBROUTINE IKFILE(IWTYP)
-*.===========>
-*.
-*. Open the file higz_windows.dat :
-*.
-*. 1) in the current working directory
-*. 2) in the HOME directory
-*. 3) create this file in the home directory
-*. if it doesn't exits.
-*.
-*. and read in this file the informations concerning
-*. the workstation type IWTYP
-*.
-*..==========>
-#include "higz/hikern.inc"
- CHARACTER*64 UHOME
- CHARACTER*128 TNAME
- LOGICAL INIT,OPND,EXIST1
- SAVE INIT,LUHOME,UHOME
-#if defined(CERNLIB_IBM)
- CHARACTER*24 CHREAD
-#endif
-#if defined(CERNLIB_CRAY)
- INTEGER GETENV
-#endif
-#if (defined(CERNLIB_X11))&&(defined(CERNLIB_IBM))&&(!defined(CERNLIB_IBMMVS))
- CHARACTER*3 CHLUN
-#endif
- DATA INIT /.FALSE./
- DATA LUHOME /0/
- DATA UHOME /' '/
-*.______________________________________
-*
- LUNWIN=20
- DO 10 I=20,99
- INQUIRE(UNIT=I,OPENED=OPND)
- IF(.NOT.OPND)THEN
- LUNWIN=I
- OPND=.TRUE.
- GOTO 20
- ENDIF
- 10 CONTINUE
-*
-#if defined(CERNLIB_IBM)
- 20 FILEN='/HIGZWIN DATA A'
-#endif
-#if (!defined(CERNLIB_IBM))&&(!defined(CERNLIB_IPSC))
- 20 FILEN='higz_windows.dat'
-#endif
-#if defined(CERNLIB_IPSC)
- 20 FILEN='higz_windows'
-#endif
-#if !defined(CERNLIB_IBM)
-*
- WINSIZ(1)=0
- WINSIZ(2)=0
- WINSIZ(3)=600
- WINSIZ(4)=600
- IF(.NOT.OPND)RETURN
-*
- INQUIRE(FILE=FILEN,EXIST=EXIST1)
- IF(EXIST1)THEN
- OPEN(UNIT=LUNWIN,FILE=FILEN,FORM='FORMATTED',STATUS='OLD'
- +, IOSTAT=ISTA)
- IF (ISTA.NE.0) THEN
- CALL IGERR('Cannot open higz_windows.dat','IKFILE')
- GOTO 999
- ELSE
- GOTO 50
- ENDIF
- ENDIF
-*
- IF (.NOT.INIT) THEN
-#endif
-#if defined(CERNLIB_UNIX)||defined(CERNLIB_CRAY)
- UHOME=' '
- CALL GETENVF('HOME',UHOME)
-#endif
-#if defined(CERNLIB_VAX)
- UHOME='SYS$LOGIN:'
-#endif
-#if !defined(CERNLIB_IBM)
- LUHOME=LENOCC(UHOME)
-#endif
-#if (!defined(CERNLIB_VAX))&&(!defined(CERNLIB_IBM))
- IF (UHOME(LUHOME:LUHOME) .NE. '/'
-#ifdef CERNLIB_WINNT
- * .OR. UHOME(LUHOME:LUHOME) .NE. '\'
-#endif
- * ) THEN
- LUHOME=LUHOME+1
- UHOME(LUHOME:LUHOME)='/'
- ENDIF
-#endif
-#if !defined(CERNLIB_IBM)
- INIT=.TRUE.
- ENDIF
-*
- TNAME = FILEN
- FILEN = UHOME(1:LUHOME)//TNAME
-#endif
-*
- 30 INQUIRE(FILE=FILEN,EXIST=EXIST1)
- IF(EXIST1)THEN
- OPEN(UNIT=LUNWIN,FILE=FILEN,FORM='FORMATTED',STATUS='OLD'
- +, IOSTAT=ISTA)
- IF (ISTA.NE.0) THEN
- CALL IGERR('Cannot open higz_windows.dat','IKFILE')
- GOTO 999
- ENDIF
- ELSE
- OPEN(UNIT=LUNWIN,FILE=FILEN,FORM='FORMATTED',STATUS='NEW'
- +, IOSTAT=ISTA)
- IF(ISTA.EQ.0)THEN
- DO 40 I=1,10
- WRITE(LUNWIN,'('' 0000 0000 0600 0600'')',ERR=999)
- 40 CONTINUE
- CLOSE(LUNWIN)
- GOTO 30
- ELSE
- OPND=.FALSE.
- ENDIF
- ENDIF
-*
- 50 IF(OPND)THEN
- DO 60 I=1,IWTYP
-#if (defined(CERNLIB_X11))&&(!defined(CERNLIB_IBM))
- READ(LUNWIN,'(4(1X,I4),1X,A)',ERR=999,END=999)
- + (WINSIZ(J),J=1,4),CHHOST
-#endif
-#if (defined(CERNLIB_X11))&&(defined(CERNLIB_IBM))
- READ(LUNWIN,'(4(1X,I4),1X,A)',ERR=999,END=999)
- + (WINSIZ(J),J=1,4),CHREAD
- CHHOST=CHREAD
-#endif
-#if !defined(CERNLIB_X11)
- READ(LUNWIN,'(4(1X,I4))',ERR=999,END=999)
- + (WINSIZ(J),J=1,4)
-#endif
- 60 CONTINUE
- CLOSE(LUNWIN)
-#if (defined(CERNLIB_X11))&&(defined(CERNLIB_IBM))&&(!defined(CERNLIB_IBMMVS))
- WRITE(CHLUN,'(I3)')LUNWIN
- FILEN='FILEDEF '//CHLUN//' CLEAR'
- CALL VMCMS(FILEN,ISTAT)
- FILEN='/HIGZWIN DATA A'
-#endif
- ENDIF
-*
- 999 END
-#endif
diff --git a/src/graflib/higz/ikernel/ikfntx.F b/src/graflib/higz/ikernel/ikfntx.F
deleted file mode 100644
index 560f1c9..0000000
--- a/src/graflib/higz/ikernel/ikfntx.F
+++ /dev/null
@@ -1,191 +0,0 @@
-*
-* $Id: ikfntx.F,v 1.1.1.1 1996/02/14 13:10:55 mclareni Exp $
-*
-* $Log: ikfntx.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:55 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-#if defined(CERNLIB_X11)
-*CMZ : 1.23/02 15/08/95 17.39.13 by O.Couet
-*-- Author : O.Couet 15/03/91
- INTEGER FUNCTION IKFNTX(IWKNB)
-*.===========>
-*.
-*. This routine manages the X11 hardware text fonts.
-*.
-*..==========> (O.Couet)
-#include "higz/hiatt.inc"
-#include "higz/hikern.inc"
-#if !defined(CERNLIB_WINNT)
- PARAMETER (IFSIZE=7,IBIG=16)
- DIMENSION X11RAP(13)
- DATA X11RAP /1.000,1.000,1.010,0.910,0.920,0.920,0.925,1.204,
- + 1.204,1.168,1.166,1.007,1.026/
-#endif
-#if defined(CERNLIB_WINNT)
- DIMENSION IMSG(5)
- EQUIVALENCE (IMSG(1), Italic), (IMSG(2), IBOLD),
- + (IMSG(3), IH)
-#endif
-*.______________________________________
-*
- IKFNTX=0
- IF(RCHH.EQ.THX11.AND.IFPX11.EQ.ABS(IFONT))RETURN
-*
- THX11 = RCHH
- IFPX11 = ABS(IFONT)
- FX11 = ' '
- IH = INT(WKSC(IWKNB)*YRATIO*RCHH*1.5)
-#if !defined(CERNLIB_WINNT)
- RSIZE = FLOAT(IH)
- IF(IH.GT.40)IH=40
-*
-* Set the X11 font name
-*
-#endif
-#if (!defined(CERNLIB_IBM))&&(!defined(CERNLIB_WINNT))
- IF (IFPX11.EQ. 1) FX11='-*-times-medium-i-normal--'
- IF (IFPX11.EQ. 2) FX11='-*-times-bold-r-normal--'
- IF (IFPX11.EQ. 3) FX11='-*-times-bold-i-normal--'
- IF (IFPX11.EQ. 4) FX11='-*-helvetica-medium-r-normal--'
- IF (IFPX11.EQ. 5) FX11='-*-helvetica-medium-o-normal--'
- IF (IFPX11.EQ. 6) FX11='-*-helvetica-bold-r-normal--'
- IF (IFPX11.EQ. 7) FX11='-*-helvetica-bold-o-normal--'
- IF (IFPX11.EQ. 8) FX11='-*-courier-medium-r-normal--'
- IF (IFPX11.EQ. 9) FX11='-*-courier-medium-o-normal--'
- IF (IFPX11.EQ.10) FX11='-*-courier-bold-r-normal--'
- IF (IFPX11.EQ.11) FX11='-*-courier-bold-o-normal--'
- IF (IFPX11.EQ.12) FX11='-*-symbol-medium-r-normal--'
- IF (IFPX11.EQ.13) FX11='-*-times-medium-r-normal--'
-#endif
-#if (defined(CERNLIB_IBM))&&(!defined(CERNLIB_WINNT))
- IF (IFPX11.EQ. 1) FX11='-*-courier-medium-o-normal--'
- IF (IFPX11.EQ. 2) FX11='-*-courier-bold-r-normal--'
- IF (IFPX11.EQ. 3) FX11='-*-courier-bold-o-normal--'
- IF (IFPX11.EQ. 4) FX11='-*-courier-medium-r-normal--'
- IF (IFPX11.EQ. 5) FX11='-*-courier-medium-o-normal--'
- IF (IFPX11.EQ. 6) FX11='-*-courier-bold-r-normal--'
- IF (IFPX11.EQ. 7) FX11='-*-courier-bold-o-normal--'
- IF (IFPX11.EQ. 8) FX11='-*-courier-medium-r-normal--'
- IF (IFPX11.EQ. 9) FX11='-*-courier-medium-o-normal--'
- IF (IFPX11.EQ.10) FX11='-*-courier-bold-r-normal--'
- IF (IFPX11.EQ.11) FX11='-*-courier-bold-o-normal--'
- IF (IFPX11.EQ.12) FX11='-*-symbol-medium-r-normal--'
- IF (IFPX11.EQ.13) FX11='-*-courier-medium-r-normal--'
-#endif
-#if !defined(CERNLIB_WINNT)
- IF(FX11.EQ.' ') RETURN
- IL=LENOCC(FX11)
-*
-* Find the smallest size available.
-*
- ISXFNT=IFSIZE
- 10 CALL IZITOC(ISXFNT,FX11(IL+1:))
- IL2=LENOCC(FX11)+1
- FX11(IL2:IL2+1)='-*'
- IF(IXSETTF(0,IL2+1,FX11).NE.0)THEN
- IF(ISXFNT.EQ.IBIG)THEN
- CALL IGERR('X11 fonts not available','IKFNTX')
- RETURN
- ENDIF
- ISXFNT=ISXFNT+1
- GOTO 10
- ENDIF
-*
-* Find the closest size available
-*
- 20 IF(IH.LT.ISXFNT)IH=ISXFNT
- CALL IZITOC(IH,FX11(IL+1:))
- IL2=LENOCC(FX11)+1
- FX11(IL2:IL2+1)='-*'
- ILL=IL2+1
- IF(IXSETTF(1,ILL,FX11).NE.0)THEN
- IF(IH.EQ.ISXFNT)THEN
- CALL IGERR('X11 fonts not available','IKFNTX')
- IKFNTX=1
- RETURN
- ENDIF
- IH=IH-1
- GOTO 20
- ENDIF
- IF(IPREC.EQ.2)THEN
- RMAGN = X11RAP(IFPX11)*RSIZE/FLOAT(IH)
- ELSE
- RMAGN = 1.
- ENDIF
-*
-#endif
-#if defined(CERNLIB_WINNT)
-*
-* Set the Windows/NT True Type text font.
-*
- IF (IFPX11 .LE. 14) THEN
- GO TO (30 ,40 ,50 ,60 ,70 ,80 ,90 ,100,110,120 ,130 ,140 ,
- + 150, 160 ) IFPX11
- GO TO 100
- 30 FX11 = 'Times New Roman'
- Italic = 1
- IBOLD = 4
- GO TO 170
- 40 FX11 = 'Times New Roman'
- Italic = 0
- IBOLD = 8
- GO TO 170
- 50 FX11 = 'Times New Roman'
- Italic = 1
- IBOLD = 8
- GO TO 170
- 60 FX11 = 'Arial'
- Italic = 0
- IBOLD = 4
- GO TO 170
- 70 FX11 = 'Arial'
- Italic = 1
- IBOLD = 4
- GO TO 170
- 80 FX11 = 'Arial'
- Italic = 0
- IBOLD = 8
- GO TO 170
- 90 FX11 = 'Arial'
- Italic = 1
- IBOLD = 8
- GO TO 170
- 100 FX11 = 'Courier New'
- Italic = 0
- IBOLD = 4
- GO TO 170
- 110 FX11 = 'Courier New'
- Italic = 1
- IBOLD = 4
- GO TO 170
- 120 FX11 = 'Courier New'
- Italic = 0
- IBOLD = 8
- GO TO 170
- 130 FX11 = 'Courier New'
- Italic = 1
- IBOLD = 8
- GO TO 170
- 140 FX11 = 'Symbol'
- Italic = 0
- IBOLD = 6
- GO TO 170
- 150 FX11 = 'Times New Roman'
- Italic = 0
- IBOLD = 4
- GO TO 170
- 160 FX11 = 'Wingdings'
- Italic = 0
- IBOLD = 4
- GO TO 170
- ENDIF
- 170 IMSG(4) = 10*RANGLE
- IMSG(5) = IPREC
- L = LENOCC(FX11)
- IRET = IXSETTF(IMSG,L,FX11(:L)//CHAR(0))
-#endif
- END
-#endif
diff --git a/src/graflib/higz/ikernel/ikpl.F b/src/graflib/higz/ikernel/ikpl.F
deleted file mode 100644
index 5dc644d..0000000
--- a/src/graflib/higz/ikernel/ikpl.F
+++ /dev/null
@@ -1,103 +0,0 @@
-*
-* $Id: ikpl.F,v 1.3 1998/01/28 14:34:43 couet Exp $
-*
-* $Log: ikpl.F,v $
-* Revision 1.3 1998/01/28 14:34:43 couet
-* - GGDM driver removed
-*
-* Revision 1.2 1996/09/25 14:58:46 couet
-* - GPR driver removed
-*
-* Revision 1.1.1.1 1996/02/14 13:10:55 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-#if !defined(CERNLIB_BATCH)
-*CMZ : 1.19/17 22/10/93 16.54.23 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE IKPL(N,X,Y)
-#if defined(CERNLIB_KERNEL)
-#include "higz/hikern.inc"
-#endif
-#include "higz/hiatt.inc"
- DIMENSION X(*),Y(*)
-*
-#if defined(CERNLIB_KERNEL)
-#include "higz/hiwcdc.inc"
-#endif
-#if (defined(CERNLIB_KERNEL))&&(!defined(CERNLIB_X11))
- IF(N.GT.IBUFSI)THEN
- CALL IGERR('Invalid number of points','IPL')
- RETURN
- ENDIF
-#endif
-#if defined(CERNLIB_PHIGS)
- CALL PPL(N,X,Y)
-#endif
-#if defined(CERNLIB_KERNEL)||defined(CERNLIB_FALCO)
- DO 60 IWKNB=1,INOPWK
- IF(NODRFL(IWKNB))GOTO 60
- CALL IGSG(IWKNB)
-#endif
-#if defined(CERNLIB_FALCO)
- IF(IWTYL(IWKNB).EQ.7878.OR.IWTYL(IWKNB).EQ.7879)THEN
- CALL IFPL(N,X,Y)
- GOTO 60
- ENDIF
-#endif
-#if defined(CERNLIB_GL)
- IF(ICURCI(IWKNB).NE.IPLCI)THEN
- CALL COLOR(IPLCI+IOFCOL)
- ICURCI(IWKNB)=IPLCI
- ENDIF
- IXX=IXWCDC(X(1))
- IYY=IYWCDC(Y(1))
- CALL MOVE2I(IXX,IYY)
- DO 20 I=2,N
- IXX=IXWCDC(X(I))
- IYY=IYWCDC(Y(I))
- CALL DRAW2I(IXX,IYY)
- 20 CONTINUE
-#endif
-#if defined(CERNLIB_X11)
- IPOS(1,1) = IXWCDC(X(1))
- IPOS(2,1) = IYWCDC(Y(1))
- NP = 1
- DO 30 I=2,N
- IXX = IXWCDC(X(I))
- IYY = IYWCDC(Y(I))
- IF(IXX.NE.IPOS(1,NP).OR.IYY.NE.IPOS(2,NP))THEN
- NP = NP+1
- IPOS(1,NP) = IXX
- IPOS(2,NP) = IYY
- IF(NP.EQ.IBUFSI)THEN
- CALL IXLINE(NP,IPOS)
- NP = 1
- IPOS(1,1) = IXX
- IPOS(2,1) = IYY
- ENDIF
- ENDIF
- 30 CONTINUE
- IF(NP.GT.1)CALL IXLINE(NP,IPOS)
-#endif
-#if defined(CERNLIB_MACMPW)
- IPOS(1,1)=IXWCDC(X(1))
- IPOS(2,1)=IYWCDC(Y(1))
- NP=1
- DO 40 I=2,N
- IXX=IXWCDC(X(I))
- IYY=IYWCDC(Y(I))
- IF(IXX.NE.IPOS(1,NP).OR.IYY.NE.IPOS(2,NP))THEN
- NP=NP+1
- IPOS(1,NP)=IXX
- IPOS(2,NP)=IYY
- ENDIF
- 40 CONTINUE
- CALL IMLINE(NP,IPOS)
-#endif
-#if defined(CERNLIB_KERNEL)||defined(CERNLIB_FALCO)
- 60 CONTINUE
-#endif
- END
-#endif
diff --git a/src/graflib/higz/ikernel/ikuwk.F b/src/graflib/higz/ikernel/ikuwk.F
deleted file mode 100644
index 637e411..0000000
--- a/src/graflib/higz/ikernel/ikuwk.F
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: ikuwk.F,v 1.1.1.1 1996/02/14 13:10:56 mclareni Exp $
-*
-* $Log: ikuwk.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:56 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-#if defined(CERNLIB_X11)
-*CMZ : 1.14/11 26/06/92 14.55.46 by O.Couet
-*-- Author : O.Couet 24/06/92
- SUBROUTINE IKUWK(IWKID)
-#include "higz/hiatt.inc"
- I = IGIWIN(IWKID)
- RW = (XWKW2(I)-XWKW1(I)) / (YWKW2(I)-YWKW1(I))
- XWKV2N = RW*(YWKV2(I)-YWKV1(I)) + XWKV1(I)
- YWKV2N = (1./RW)*(XWKV2(I)-XWKV1(I)) + YWKV1(I)
- IF(XWKV2N.GT.XWKV2(I))THEN
- YWKV2(I) = YWKV2N
- GOTO 10
- ENDIF
- IF(YWKV2N.GT.YWKV2(I))THEN
- XWKV2(I) = XWKV2N
- GOTO 10
- ENDIF
- 10 R = REDIT
- IF(R.LE.0)R=1
- XWKR(I) = R*(XWKV2(I)-XWKV1(I)) / (XWKW2(I)-XWKW1(I))
- YWKR(I) = R*(YWKV2(I)-YWKV1(I)) / (YWKW2(I)-YWKW1(I))
- END
-#endif
diff --git a/src/graflib/higz/ikernel/iopks.F b/src/graflib/higz/ikernel/iopks.F
deleted file mode 100644
index 8b95d11..0000000
--- a/src/graflib/higz/ikernel/iopks.F
+++ /dev/null
@@ -1,173 +0,0 @@
-*
-* $Id: iopks.F,v 1.34 2004/06/10 07:54:21 couet Exp $
-*
-* $Log: iopks.F,v $
-* Revision 1.34 2004/06/10 07:54:21 couet
-* - 1.29/04
-*
-* Revision 1.33 2003/07/23 09:48:23 couet
-* - 1.29/03
-*
-* Revision 1.32 2003/03/18 13:39:39 couet
-* *** empty log message ***
-*
-* Revision 1.31 2003/02/17 10:04:58 couet
-* - 1.29/01
-*
-* Revision 1.30 2002/12/04 11:01:13 couet
-* - 1.29/00
-*
-* Revision 1.29 2002/05/22 09:18:45 couet
-* - 1.28/07
-*
-* Revision 1.28 2002/05/16 15:32:16 couet
-* - 1.28/06
-*
-* Revision 1.27 2002/04/04 10:23:23 couet
-* - 1.28/05
-*
-* Revision 1.26 2002/03/18 16:25:53 couet
-* - 1.28/04
-*
-* Revision 1.25 2001/12/07 15:52:32 couet
-* - 1.28/03
-*
-* Revision 1.24 2001/11/23 16:09:39 couet
-* - 1.28/02
-*
-* Revision 1.23 2001/10/17 14:42:58 couet
-* - 1.28/01
-*
-* Revision 1.22 2001/10/08 16:18:10 couet
-* - 1.28/00
-*
-* Revision 1.21 2001/05/31 08:08:43 couet
-* - 1.27/03
-*
-* Revision 1.20 2000/08/29 14:04:11 couet
-* - 1.27/02
-*
-* Revision 1.19 2000/07/14 15:19:10 couet
-* - 1.27/01
-*
-* Revision 1.18 2000/04/03 15:41:44 couet
-* - 1.27/00
-*
-* Revision 1.17 1999/10/20 14:17:03 couet
-* - 1.26/04
-*
-* Revision 1.16 1999/10/13 12:35:50 couet
-* - 1.26/03
-*
-* Revision 1.15 1999/10/06 14:05:35 couet
-* - 1.26/02
-*
-* Revision 1.14 1999/06/21 16:48:43 couet
-* - 1.26/01
-*
-* Revision 1.13 1999/05/06 06:59:38 couet
-* - version 1.26/00 to tag the following bug fixe in x11int.c:
-* "MapNotify is not supported by all the X11 emulators (problem on Mac !!!)"
-*
-* Revision 1.12 1999/01/07 15:31:33 couet
-* - 1.25/05
-*
-* Revision 1.11 1998/12/07 13:45:29 couet
-* - 1.25/04
-*
-* Revision 1.10 1998/11/16 11:14:10 couet
-* - 1.25/03
-*
-* Revision 1.9 1998/11/13 10:52:37 couet
-* - 1.25/02
-*
-* Revision 1.8 1998/05/26 09:23:04 couet
-* - 1.25/01
-*
-* Revision 1.7 1998/04/09 13:08:23 couet
-* - new version
-*
-* Revision 1.6 1998/01/28 14:34:44 couet
-* - GGDM driver removed
-*
-* Revision 1.5 1997/01/30 10:55:24 couet
-* - version 1.23/09
-*
-* Revision 1.4 1996/09/25 14:58:47 couet
-* - GPR driver removed
-*
-* Revision 1.3 1996/04/23 08:37:23 couet
-* - version number incremented.
-*
-* Revision 1.2 1996/03/08 17:08:03 couet
-* The initialization of the Version string was wrong.
-*
-* Revision 1.1.1.1 1996/02/14 13:10:56 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-
-*-- Author : O.Couet
- SUBROUTINE IOPKS(IERFIL)
- ENTRY GOPKS(IERFIL)
-#include "higz/hilun.inc"
-#if defined(CERNLIB_KERNEL)
-#include "higz/hikern.inc"
-#endif
-#include "higz/hiatt.inc"
-#include "higz/hivers.inc"
- CHARACTER*16 TCARD
-*
- CALL UHTOC(
- + 40HVERSION 1.29/04 10/06/04
-#if !defined(CERNLIB_CRAY)
- +,4,TCARD,16)
-#endif
-#if defined(CERNLIB_CRAY)
- +,8,TCARD,16)
-#endif
- CHVERS = TCARD(9:16)
-#if !defined(CERNLIB_NOVERS)
- PRINT*,'Version'//CHVERS//' of HIGZ started'
-#endif
-*
-* ICURWK = Index of the current active workstation
-* NODRFL = If .TRUE. the basic graphics package is not called
-* in each primitives of IKERNEL
-* ICURCI = Current color
-* IOFCOL = Offset in the color table
-*
- ICURWK=0
- DO 10 I=1,10
- NODRFL(I)=.TRUE.
-#if (defined(CERNLIB_GL))&&(!defined(CERNLIB_MSDOS))
- ICURCI(I)=-1
-#endif
-#if defined(CERNLIB_MSDOS)
- ICURCI(I)=0
-#endif
- 10 CONTINUE
-#if (defined(CERNLIB_GL))&&(!defined(CERNLIB_MSDOS))
- IXLOCO=0
- IYLOCO=0
- IOFCOL=64
- LOINS=.FALSE.
-#endif
-#if defined(CERNLIB_MSDOS)
- IXLOCO=0
- IYLOCO=0
- IWKNB=0
- IOFCOL=0
- LOINS=.FALSE.
-#endif
-#if defined(CERNLIB_X11)
- THX11=0.
- IFPX11=0.
-#endif
-#if defined(CERNLIB_PHIGS)
- CALL POPPH(IERFIL,-1)
- IDIM=3
-#endif
- IF(IERFIL.GT.0)LUNERR=IERFIL
- END
diff --git a/src/graflib/higz/ikernel/iopwk.F b/src/graflib/higz/ikernel/iopwk.F
deleted file mode 100644
index c7eefcc..0000000
--- a/src/graflib/higz/ikernel/iopwk.F
+++ /dev/null
@@ -1,304 +0,0 @@
-*
-* $Id: iopwk.F,v 1.4 1998/12/01 15:48:36 couet Exp $
-*
-* $Log: iopwk.F,v $
-* Revision 1.4 1998/12/01 15:48:36 couet
-* - Clean up: commented lines of code removed
-*
-* Revision 1.3 1998/01/28 14:34:45 couet
-* - GGDM driver removed
-*
-* Revision 1.2 1996/09/25 14:58:48 couet
-* - GPR driver removed
-*
-* Revision 1.1.1.1 1996/02/14 13:10:56 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.21/00 10/03/94 17.48.13 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE IOPWK(IWKID,ICONID,IWTYPI)
- ENTRY GOPWK(IWKID,ICONID,IWTYPI)
-#if defined(CERNLIB_KERNEL)
-#include "higz/hikern.inc"
-#endif
-#if defined(CERNLIB_MSDOS)
-#include "higz/himeta.inc"
-#endif
-#include "higz/hiatt.inc"
-#include "higz/hiflag.inc"
-#if defined(CERNLIB_KERNEL)
- CHARACTER*32 CHWIN
-#endif
- DIMENSION RVAL(2)
-#if !defined(CERNLIB_X11)
- SAVE IFIRST
-#endif
-#if defined(CERNLIB_X11)
- INTEGER WINID
-#endif
-#if (defined(CERNLIB_X11))&&(defined(CERNLIB_IBM))&&(!defined(CERNLIB_IBMMVS))
- CHARACTER*3 CHLUN
-#endif
-#if (defined(CERNLIB_GL))&&(!defined(CERNLIB_MSDOS))
- INTEGER*2 IHATCH(16,8)
- DATA (IHATCH(I,1),I=1,16)
- + / X'8888' , X'2222' , X'8888' , X'2222'
- + , X'8888' , X'2222' , X'8888' , X'2222'
- + , X'8888' , X'2222' , X'8888' , X'2222'
- + , X'8888' , X'2222' , X'8888' , X'2222' /
- DATA (IHATCH(I,2),I=1,16)
- + / X'9999' , X'0000' , X'6666' , X'0000'
- + , X'9999' , X'0000' , X'6666' , X'0000'
- + , X'9999' , X'0000' , X'6666' , X'0000'
- + , X'9999' , X'0000' , X'6666' , X'0000' /
- DATA (IHATCH(I,3),I=1,16)
- + / X'8181' , X'0000' , X'0000' , X'0000'
- + , X'1818' , X'0000' , X'0000' , X'0000'
- + , X'8181' , X'0000' , X'0000' , X'0000'
- + , X'1818' , X'0000' , X'0000' , X'0000' /
- DATA (IHATCH(I,4),I=1,16)
- + / X'8001' , X'0000' , X'0000' , X'0000'
- + , X'0000' , X'0000' , X'0000' , X'0000'
- + , X'0180' , X'0000' , X'0000' , X'0000'
- + , X'0000' , X'0000' , X'0000' , X'0000' /
- DATA (IHATCH(I,5),I=1,16)
- + / X'FFFF' , X'8181' , X'8181' , X'8181'
- + , X'FFFF' , X'FFFF' , X'1818' , X'1818'
- + , X'1818' , X'1818' , X'FFFF' , X'FFFF'
- + , X'8181' , X'8181' , X'8181' , X'FFFF' /
- DATA (IHATCH(I,6),I=1,16)
- + / X'CCCC' , X'CCCC' , X'3333' , X'3333'
- + , X'CCCC' , X'CCCC' , X'3333' , X'3333'
- + , X'CCCC' , X'CCCC' , X'3333' , X'3333'
- + , X'CCCC' , X'CCCC' , X'3333' , X'3333' /
- DATA (IHATCH(I,7),I=1,16)
- + / X'F0F0' , X'F0F0' , X'F0F0' , X'F0F0'
- + , X'0F0F' , X'0F0F' , X'0F0F' , X'0F0F'
- + , X'F0F0' , X'F0F0' , X'F0F0' , X'F0F0'
- + , X'0F0F' , X'0F0F' , X'0F0F' , X'0F0F' /
- DATA (IHATCH(I,8),I=1,16)
- + / X'FF00' , X'FF00' , X'FF00' , X'FF00'
- + , X'FF00' , X'FF00' , X'FF00' , X'FF00'
- + , X'00FF' , X'00FF' , X'00FF' , X'00FF'
- + , X'00FF' , X'00FF' , X'00FF' , X'00FF' /
-#endif
-#if !defined(CERNLIB_X11)
- DATA IFIRST/1/
-#endif
-*
- IF(IWKID.EQ.0)THEN
- CALL IGERR('Workstation identifier equal 0','IOPWK')
- RETURN
- ENDIF
- IF(INOPWK.EQ.10)THEN
- CALL IGERR('Maximal number of open workstation is 10','IOPWK')
- RETURN
- ENDIF
- IF(IGIWIN(IWKID).NE.0)THEN
- CALL IGERR('Workstation already open','IOPWK')
- RETURN
- ENDIF
-*
- IWTYP=IWTYPI
-#if defined(CERNLIB_X11)
- IF(IWTYP.EQ.999)IWTYP=1
-#endif
- INOPWK=INOPWK+1
- ILOPWK(INOPWK)=IWKID
- IWTYL(INOPWK)=IWTYP
- ACWKFL(INOPWK)=.FALSE.
- NODRFL(INOPWK)=.TRUE.
-#if defined(CERNLIB_MSDOS)
- ISAVE = IWKNB
- IWKNB = INOPWK
-#endif
-#if defined(CERNLIB_PSCRIPT)
-*
- IF(IWTYP.LT.0)THEN
- CALL IPINIT(IWKID,ABS(ICONID),IWTYP)
- RETURN
- ENDIF
-#endif
-#if !defined(CERNLIB_BATCH)
-*
- IF(GFLAG)THEN
-#endif
-#if defined(CERNLIB_FALCO)
- IF(IWTYP.EQ.7878.OR.IWTYP.EQ.7879)THEN
- IWTYPE = IWTYP
- IFONT = 0
- IPREC = 2
- IFTPR = 20
- CALL IFINIT
- CALL IFVWIN(0.,1.,0.,.8)
- IF(IWTYP.EQ.7878)THEN
- CALL IFSWIN(0,128000,0,100000)
- ELSE
- CALL IFSWIN(0,128000,0,101120)
- ENDIF
- RETURN
- ENDIF
-#endif
-#if (defined(CERNLIB_KERNEL))&&(!defined(CERNLIB_PHIGS))&&(!defined(CERNLIB_MSDOS))
- IF(IWTYP.LE.0.OR.IWTYP.GT.20)THEN
- CALL IGERR('Invalid workstation type','IOPWK')
- INOPWK=INOPWK-1
- RETURN
- ENDIF
-#endif
-#if defined(CERNLIB_MSDOS)
- IF(IWTYP.LE.0.)THEN
- CALL IGERR('Invalid workstation type','IOPWK')
- INOPWK=INOPWK-1
- RETURN
- ENDIF
- IF(IWTYP.GT.10)IWTYP=IWTYP-10
-*
-#endif
-#if (defined(CERNLIB_KERNEL))&&(!defined(CERNLIB_PHIGS))&&(!defined(CERNLIB_MSDOS))
- CALL IKFILE(IWTYP)
-#endif
-#if (defined(CERNLIB_KERNEL))&&(!defined(CERNLIB_PHIGS))
-*
- WRITE(CHWIN,'(''HIGZ_'',I2.2)') IWKID
-#endif
-#if (defined(CERNLIB_GL))&&(defined(CERNLIB_SGI))&&(!defined(CERNLIB_MSDOS))
- CALL FOREGR
-#endif
-#if (defined(CERNLIB_GL))&&(!defined(CERNLIB_MSDOS))
- CALL PREFPO(WINSIZ(1),WINSIZ(1)+WINSIZ(3)-1
- +, WINSIZ(2),WINSIZ(2)+WINSIZ(4)-1)
- WINID=WINOPE(CHWIN,11)
- IWINID(INOPWK)=WINID
- CALL ICLRWK(IWKID,0)
- CALL WINCON
- CALL CONCAV(.TRUE.)
- IF(IFIRST.NE.0)THEN
- IFIRST=0
- CALL DEFLIN(1,X'F0F0')
- CALL DEFLIN(2,X'8888')
- CALL DEFLIN(3,X'E4E4')
- CALL DEFLIN(4,X'FAFA')
- DO 20 I=1,8
- CALL DEFPAT(I,16,IHATCH(1,I))
- 20 CONTINUE
- CALL SETPAT(0)
- ENDIF
-#endif
-#if defined(CERNLIB_MSDOS)
- CALL IGSG(INOPWK)
- IER = GET_DEVICE_LIMITS(IXX
- +, IYY
- +, MAX_COLOR(INOPWK))
- XWKSIZ(INOPWK) = IXX
- YWKSIZ(INOPWK) = IYY
- CALL ICLRWK(IWKID,0)
- IF (IFIRST .NE. 0) THEN
- IFIRST = 0
- DASH_PATTERN( 1) =
- + CHAR(Z'FF')//CHAR(Z'FF')//CHAR(Z'FF')//CHAR(Z'FF')
- DASH_PATTERN( 2) =
- + CHAR(Z'0F')//CHAR(Z'0F')//CHAR(Z'0F')//CHAR(Z'0F')
- DASH_PATTERN(3) =
- + CHAR(Z'11')//CHAR(Z'11')//CHAR(Z'11')//CHAR(Z'11')
- DASH_PATTERN(4) =
- + CHAR(Z'F6')//CHAR(Z'F6')//CHAR(Z'F6')//CHAR(Z'F6')
- DASH_PATTERN( 5) =
- + CHAR(Z'F0')//CHAR(Z'F0')//CHAR(Z'F0')//CHAR(Z'F0')
- DASH_PATTERN( 6) =
- + CHAR(Z'00')//CHAR(Z'FF')//CHAR(Z'FF')//CHAR(Z'FF')
- DASH_PATTERN( 7) =
- + CHAR(Z'FF')//CHAR(Z'00')//CHAR(Z'FF')//CHAR(Z'00')
- DASH_PATTERN( 8) =
- + CHAR(Z'00')//CHAR(Z'FF')//CHAR(Z'00')//CHAR(Z'FF')
- DASH_PATTERN( 9) =
- + CHAR(Z'F0')//CHAR(Z'0F')//CHAR(Z'F0')//CHAR(Z'0F')
- DASH_PATTERN(10) =
- + CHAR(Z'00')//CHAR(Z'00')//CHAR(Z'00')//CHAR(Z'FF')
- DASH_PATTERN(11) =
- + CHAR(Z'00')//CHAR(Z'00')//CHAR(Z'FF')//CHAR(Z'FF')
- DASH_PATTERN(12) = DASH_PATTERN(2)
- DASH_PATTERN(13) = DASH_PATTERN(4)
- DASH_PATTERN(14) = DASH_PATTERN(3)
- DASH_PATTERN(15) =
- + CHAR(Z'55')//CHAR(Z'55')//CHAR(Z'55')//CHAR(Z'55')
- DASH_PATTERN(16) =
- + CHAR(Z'AA')//CHAR(Z'AA')//CHAR(Z'AA')//CHAR(Z'AA')
- MAG_X = 1
- MAG_Y = 1
- ENDIF
- IF(IWKID.EQ.IDMETA)THEN
- LUNMET(INOPWK) = ABS(ICONID)
- ENDIF
- IWKNB = ISAVE
-#endif
-#if defined(CERNLIB_X11)
- IWINN=INDEX(CHHOST,' ')
- I=IWINN-1
- IF(I.LE.0)I=LENOCC(CHHOST)
- IF(I.NE.0)THEN
-#endif
-#if (defined(CERNLIB_X11))&&(defined(CERNLIB_IBM))&&(!defined(CERNLIB_IBMMVS))
- CALL VMCMS('GLOBALV SELECT CENV SETL DISPLAY '
- + //CHHOST(1:I)//':0',IRET)
-#endif
-#if defined(CERNLIB_X11)
- FX11 = CHHOST
- IF(INDEX(CHHOST,':').EQ.0)THEN
- FX11(I+1:) = ':0.0'
- I = I+4
- ENDIF
- ELSE
- FX11 = ' '
- ENDIF
- IF(IXOPNDS(I,FX11).LT.0)THEN
- CALL IGERR('Can''t open DISPLAY','IOPWK')
- INOPWK=INOPWK-1
- IWTYPE=0
- RETURN
- ENDIF
- IF(LENOCC(CHHOST).GT.I)THEN
- CHWIN(1:1)='-'
- CHWIN(2:)=CHHOST(IWINN:)
- ENDIF
- IFLAG=0
- WINID=IXOPNWI(WINSIZ(1),WINSIZ(2),WINSIZ(3),WINSIZ(4)
- +, LENOCC(CHWIN),CHWIN,IFLAG)
- IF(WINID.LT.0)THEN
- CALL IGERR('Can''t open WINDOW','IOPWK')
- INOPWK=INOPWK-1
- IWTYPE=0
- RETURN
- ENDIF
- CALL IXMINIT(WINID)
- IWINID(INOPWK)=WINID
- CALL IXSETCO(1,0.,0.,0.)
- CALL IXSETFC(1)
- CALL IXSETLC(1)
- CALL IXSETMC(1)
- CALL IXSETTC(1)
- CALL ICLRWK(IWKID,0)
-*
- CALL IGQWK(IWKID,'MXDS',RVAL)
- XWKWN=MIN(1.,RVAL(1)/RVAL(2))
- YWKWN=MIN(1.,RVAL(2)/RVAL(1))
- CALL ISWKWN(IWKID,0.,XWKWN,0.,YWKWN)
- CALL ISWKVP(IWKID,0.,RVAL(1),0.,RVAL(2))
- CALL IKUWK(IWKID)
-*
-#endif
-#if defined(CERNLIB_PHIGS)
- CALL POPWK(IWKID,1,IWTYP)
- CALL PXOPEN_PIPE(IWKID)
-#endif
-#if defined(CERNLIB_MACMPW)
- WINID=IMOPNWI(WINSIZ(1),WINSIZ(2),WINSIZ(3),WINSIZ(4)
- +, 20,'HIGZ Graphics Window')
-#endif
-#if !defined(CERNLIB_BATCH)
- ENDIF
-#endif
-*
- END
diff --git a/src/graflib/higz/ikernel/ipl.F b/src/graflib/higz/ikernel/ipl.F
deleted file mode 100644
index 6aa2255..0000000
--- a/src/graflib/higz/ikernel/ipl.F
+++ /dev/null
@@ -1,178 +0,0 @@
-*
-* $Id: ipl.F,v 1.1.1.1 1996/02/14 13:10:56 mclareni Exp $
-*
-* $Log: ipl.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:56 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.22/09 23/03/95 15.20.01 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE IPL(N,X,Y)
- ENTRY GPL(N,X,Y)
-*.===========>
-*.
-*. This routine draws a polyline . The line type from 12 to 15 are independent
-*. from the underlaying basic graphics package .
-*.
-*. _Input parameters:
-*.
-*. INTEGER N : Number of points in the polyline .
-*. REAL X(N) : X coordinates .
-*. REAL Y(N) : Y coordinates .
-*.
-*..==========> (O.Couet)
-#include "higz/hiatt.inc"
-#include "higz/hiflag.inc"
- DIMENSION X(*),Y(*),XX(2),YY(2)
- DIMENSION XDOT(2),YDOT(2)
- LOGICAL ZSAV
- EQUIVALENCE (XOLD,XX(1)),(XNEW,XX(2))
- EQUIVALENCE (YOLD,YY(1)),(YNEW,YY(2))
- DATA XLSTEP,SMIN/0.2,0.0002/
-*.______________________________________
-*
- IF(N.LT.2)THEN
- CALL IGERR('Invalid number of points','IPL')
- RETURN
- ENDIF
-*
- IF((ILN.GE.12).AND.(GFLAG.OR.PFLAG))THEN
- ZSAV=ZFLAG
- ZFLAG=.FALSE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- NTSAV=INTR
- RATIO1=(RVXMAX-RVXMIN)/(RWXMAX-RWXMIN)
- RATIO2=(RVYMAX-RVYMIN)/(RWYMAX-RWYMIN)
- RWX1=RWXMIN
- RWY1=RWYMIN
- RVX1=RVXMIN
- RVY1=RVYMIN
- RVX2=RVXMAX
- RVY2=RVYMAX
- XLSTEP=RBSL
- SMIN=0.001*XLSTEP
- CALL ISELNT(0)
- ILNS=ILN
- CALL ISLN(1)
- IF((XLSTEP.LE.0.).OR.(XLSTEP.GT.1))XLSTEP=0.01
-*
-* Possibly dashed lines drawn
-*
- 10 MODE=1
- IDOT=0
- SRES=XLSTEP
-*
- DO 90 I=2,N
- XOLD=RATIO1*(X(I-1)-RWX1)+RVX1
- YOLD=RATIO2*(Y(I-1)-RWY1)+RVY1
-*
- DXSTEP=RATIO1*(X(I)-RWX1)+RVX1-XOLD
- DYSTEP=RATIO2*(Y(I)-RWY1)+RVY1-YOLD
- ADX=ABS(DXSTEP)
- ADY=ABS(DYSTEP)
- IF(ADX.LE.SMIN)THEN
- STEP=ADY
- DSX=0.
- DSY=SIGN(1.,DYSTEP)
- GOTO 20
- ENDIF
- IF(ADY.LE.SMIN)THEN
- STEP=ADX
- DSX=SIGN(1.,DXSTEP)
- DSY=0.
- GOTO 20
- ENDIF
- STEP=SQRT(DXSTEP*DXSTEP+DYSTEP*DYSTEP)
- DSX=DXSTEP/STEP
- DSY=DYSTEP/STEP
- 20 IF(STEP.LE.0.)GO TO 90
- DRES=STEP
-*
- 30 ST=SRES
- IF(ST.GT.DRES)ST=DRES
- SRES=SRES-ST
- DRES=DRES-ST
- XNEW=XOLD+ST*DSX
- YNEW=YOLD+ST*DSY
-*
- IF(ICLIP.EQ.1)THEN
- ICL=IGCLIP(XX,YY,RVX1,RVX2,RVY1,RVY2)
- IF(ICL.EQ.0)GOTO 80
- ENDIF
-*
- GO TO (40 ,40 ,50 ,60 ,70 ),ILNS-10
-*
-* Dashed line _ _ _ _ _ _ _
-*
- 40 CONTINUE
- IF(MODE.NE.0)THEN
-#if defined(CERNLIB_PSCRIPT)
- IF(PFLAG)CALL IZPL(2,XX,YY)
-#endif
-#if !defined(CERNLIB_BATCH)
- IF(GFLAG)CALL IKPL(2,XX,YY)
-#endif
- ENDIF
- GO TO 80
-*
-* Dash-dot line _._._._._.
-*
- 50 IF(MODE.EQ.0)GO TO 70
-#if defined(CERNLIB_PSCRIPT)
- IF(PFLAG)CALL IZPL(2,XX,YY)
-#endif
-#if !defined(CERNLIB_BATCH)
- IF(GFLAG)CALL IKPL(2,XX,YY)
-#endif
- GO TO 80
-*
-* Dot-blank . . . . . . .
-*
- 60 IF(MODE.EQ.0)GO TO 80
-*
-* Dotted line ............
-*
- 70 IF (SRES.LT.0.5*XLSTEP) IDOT=IDOT+1
- IF (IDOT.NE.1) GOTO 80
- XDOT(1)=XNEW-(0.5*XLSTEP-SRES)*DSX
- YDOT(1)=YNEW-(0.5*XLSTEP-SRES)*DSY
- MTS=IMK
- MCOL=IPMCI
- RMSC=RMKSC
- CALL ISMKSC(RLWSC)
- CALL ISMK(1)
- CALL ISPMCI(IPLCI)
- IF(GFLAG)CALL IPM(1,XDOT,YDOT)
-#if defined(CERNLIB_PSCRIPT)
- IF(PFLAG)CALL IZPM(1,XDOT,YDOT)
-#endif
- CALL ISMKSC(RMSC)
- CALL ISMK(MTS)
- CALL ISPMCI(MCOL)
-*
- 80 XOLD=XNEW
- YOLD=YNEW
- IF(SRES.LE.SMIN)THEN
- IDOT=0
- SRES=XLSTEP
- MODE=MODE+1
- IF(MODE.EQ.2)MODE=0
- ENDIF
- IF(DRES.GT.SMIN)GO TO 30
- 90 CONTINUE
- CALL ISELNT(NTSAV)
- CALL ISLN(ILNS)
- ZFLAG=ZSAV
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- ELSE
-#if !defined(CERNLIB_BATCH)
- IF(GFLAG)CALL IKPL(N,X,Y)
-#endif
- ENDIF
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_PSCRIPT)||defined(CERNLIB_MAIL)
- IF(GLFLAG)CALL IZPL(N,X,Y)
-#endif
-*
- END
diff --git a/src/graflib/higz/ikernel/ipm.F b/src/graflib/higz/ikernel/ipm.F
deleted file mode 100644
index 9871f0e..0000000
--- a/src/graflib/higz/ikernel/ipm.F
+++ /dev/null
@@ -1,194 +0,0 @@
-*
-* $Id: ipm.F,v 1.3 1998/01/28 14:34:46 couet Exp $
-*
-* $Log: ipm.F,v $
-* Revision 1.3 1998/01/28 14:34:46 couet
-* - GGDM driver removed
-*
-* Revision 1.2 1996/09/25 14:58:49 couet
-* - GPR driver removed
-*
-* Revision 1.1.1.1 1996/02/14 13:10:56 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.20/10 26/01/94 12.06.22 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE IPM(N,X,Y)
- ENTRY GPM(N,X,Y)
-#if defined(CERNLIB_KERNEL)
-#include "higz/hikern.inc"
-#endif
-#if defined(CERNLIB_MSDOS)
-#include "higz/himeta.inc"
-#endif
-#include "higz/hiatt.inc"
-#include "higz/hiflag.inc"
- DIMENSION X(*),Y(*)
-*
-#if defined(CERNLIB_KERNEL)
-#include "higz/hiwcdc.inc"
-#endif
-#if (defined(CERNLIB_KERNEL))&&(!defined(CERNLIB_X11))
- IF(N.LT.1.OR.N.GT.IBUFSI)THEN
- CALL IGERR('Invalid number of points','IPM')
- RETURN
- ENDIF
-#endif
- IF(IMK.GE.20)THEN
- CALL IGPM(N,X,Y,IMK)
- ELSE
- IF(GFLAG)THEN
-#if defined(CERNLIB_PHIGS)
- CALL PPM(N,X,Y)
-#endif
-#if defined(CERNLIB_KERNEL)||defined(CERNLIB_FALCO)
- DO 70 IWKNB=1,INOPWK
- IF(NODRFL(IWKNB))GOTO 70
- CALL IGSG(IWKNB)
-#endif
-#if defined(CERNLIB_FALCO)
- IF(IWTYL(IWKNB).EQ.7878.OR.IWTYL(IWKNB).EQ.7879)THEN
- IF(IMK.EQ.3)THEN
- CALL IGPM(N,X,Y,31)
- ELSEIF(IMK.EQ.4)THEN
- CALL IGPM(N,X,Y,24)
- ELSE
- DO 10 I=1,N
- XFALCO=(RVXMIN+XRATIO*(X(I)-RWXMIN))
- YFALCO=(RVYMIN+YRATIO*(Y(I)-RWYMIN))
- CALL IFMOVE(XFALCO,YFALCO)
- CALL IFDRAW(XFALCO,YFALCO)
- 10 CONTINUE
- CALL IFPUT(0)
- ENDIF
- GOTO 70
- ENDIF
-#endif
-#if (defined(CERNLIB_GL))&&(!defined(CERNLIB_MSDOS))
- IF(ICURCI(IWKNB).NE.IPMCI)THEN
- CALL COLOR(IPMCI+IOFCOL)
- ICURCI(IWKNB)=IPMCI
- ENDIF
- DO 30 I=1,N
- IXX=IXWCDC(X(I))
- IYY=IYWCDC(Y(I))
- CALL MOVE2I(IXX,IYY)
- CALL DRAW2I(IXX,IYY)
- 30 CONTINUE
-#endif
-#if defined(CERNLIB_MSDOS)
- CALL MARKER(N,X,Y)
-#endif
-#if defined(CERNLIB_X11)
- LM=ABS(IMK)
- IM=NINT(RMKSC*4)
- IF(IM.LE.0) LM=1
- IF(LM.EQ.2) THEN
-*--- + shaped marker
- IPOS(1,1)=-IM
- IPOS(2,1)=0
- IPOS(1,2)=IM
- IPOS(2,2)=0
- IPOS(1,3)=0
- IPOS(2,3)=-IM
- IPOS(1,4)=0
- IPOS(2,4)=IM
- CALL IXSETMS(4,4,IPOS)
- ELSEIF(LM.EQ.3) THEN
-*--- * shaped marker
- IPOS(1,1)=-IM
- IPOS(2,1)=0
- IPOS(1,2)=IM
- IPOS(2,2)=0
- IPOS(1,3)=0
- IPOS(2,3)=-IM
- IPOS(1,4)=0
- IPOS(2,4)=IM
- IM=NINT(IM*0.707)
- IPOS(1,5)=-IM
- IPOS(2,5)=-IM
- IPOS(1,6)=IM
- IPOS(2,6)=IM
- IPOS(1,7)=-IM
- IPOS(2,7)=IM
- IPOS(1,8)=IM
- IPOS(2,8)=-IM
- CALL IXSETMS(4,8,IPOS)
- ELSEIF(LM.EQ.4) THEN
-*--- O shaped marker
- CALL IXSETMS(0,IM*2,IPOS)
- ELSEIF(LM.EQ.5) THEN
-*--- X shaped marker
- IM=NINT(IM*0.707)
- IPOS(1,1)=-IM
- IPOS(2,1)=-IM
- IPOS(1,2)=IM
- IPOS(2,2)=IM
- IPOS(1,3)=-IM
- IPOS(2,3)=IM
- IPOS(1,4)=IM
- IPOS(2,4)=-IM
- CALL IXSETMS(4,4,IPOS)
- ELSEIF(LM.EQ.6) THEN
-*--- + shaped marker (with 1 pixel)
- IPOS(1,1)=-1
- IPOS(2,1)=0
- IPOS(1,2)=1
- IPOS(2,2)=0
- IPOS(1,3)=0
- IPOS(2,3)=-1
- IPOS(1,4)=0
- IPOS(2,4)=1
- CALL IXSETMS(4,4,IPOS)
- ELSEIF(LM.EQ.7) THEN
-*--- . shaped marker (with 9 pixel)
- IPOS(1,1)=-1
- IPOS(2,1)=1
- IPOS(1,2)=1
- IPOS(2,2)=1
- IPOS(1,3)=-1
- IPOS(2,3)=0
- IPOS(1,4)=1
- IPOS(2,4)=0
- IPOS(1,5)=-1
- IPOS(2,5)=-1
- IPOS(1,6)=1
- IPOS(2,6)=-1
- CALL IXSETMS(4,6,IPOS)
- ELSEIF(LM.EQ.8) THEN
-*--- O shaped marker (filled)
- CALL IXSETMS(1,IM*2,IPOS)
- ELSE
-*--- single dot
- CALL IXSETMS(0,0,IPOS)
- ENDIF
- NPT = 0
- DO 40 I=1,N
- NPT = NPT+1
- IPOS(1,NPT) = IXWCDC(X(I))
- IPOS(2,NPT) = IYWCDC(Y(I))
- IF(NPT.EQ.IBUFSI.OR.I.EQ.N)THEN
- CALL IXMARKE(NPT,IPOS)
- NPT = 0
- ENDIF
- 40 CONTINUE
-#endif
-#if defined(CERNLIB_MACMPW)
- DO 50 I=1,N
- IPOS(1,I)=IXWCDC(X(I))
- IPOS(2,I)=IYWCDC(Y(I))
- 50 CONTINUE
- CALL IMMARKE(N,IPOS)
-#endif
-#if defined(CERNLIB_KERNEL)||defined(CERNLIB_FALCO)
- 70 CONTINUE
-#endif
- ENDIF
- ENDIF
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_PSCRIPT)||defined(CERNLIB_MAIL)
- IF(GLFLAG)CALL IZPM(N,X,Y)
-#endif
-*
- END
diff --git a/src/graflib/higz/ikernel/irqlc.F b/src/graflib/higz/ikernel/irqlc.F
deleted file mode 100644
index b14dad2..0000000
--- a/src/graflib/higz/ikernel/irqlc.F
+++ /dev/null
@@ -1,524 +0,0 @@
-*
-* $Id: irqlc.F,v 1.4 1998/12/01 15:48:36 couet Exp $
-*
-* $Log: irqlc.F,v $
-* Revision 1.4 1998/12/01 15:48:36 couet
-* - Clean up: commented lines of code removed
-*
-* Revision 1.3 1998/01/28 14:34:47 couet
-* - GGDM driver removed
-*
-* Revision 1.2 1996/09/25 14:58:50 couet
-* - GPR driver removed
-*
-* Revision 1.1.1.1 1996/02/14 13:10:56 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.23/01 08/05/95 11.47.40 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE IRQLC(IWKIDI,LCN,ISTATI,ITNRI,XLOC,YLOC)
- ENTRY GRQLC(IWKIDI,LCN,ISTATI,ITNRI,XLOC,YLOC)
-*.===========>
-*.
-*. This routine returns the graphic cursor position in WC space in
-*. XLOC and YLOC. The same position in the NDC space is available in
-*. RQUEST(11) and RQUEST(12). The normalization tranformation number
-*. is returned in TNR. After a call to IRQLC the window coordinates
-*. are available in RQUEST(20), RQUEST(21), RQUEST(22), and RQUEST(23).
-*. The viewport coordinates are available in RQUEST(30), RQUEST(31),
-*. RQUEST(32), and RQUEST(33). This routine computed the XLOC and YLOC
-*. value according to value of the REDIT factor, but the value of
-*. RQUEST(11) and RQUEST(12) do not care about the value of REDIT. The
-*. REDIT factor is usefull for the graphics editor and the menu mode of
-*. KUIP.
-*. The values of XLOC and YLOC are computed with the parameters stored
-*. in the NT storage (HINT) if ZEBRA is not used, or if there no
-*. displayed picture. If an HIGZ picture is displayed, only the NT
-*. existing in this picture are used to compute the values of XLOC and
-*. YLOC.
-*. This routine can work in two modes :
-*. - The REQUEST mode where a "Button_Press" event is necesary to get
-*. the cursor position.
-*. - The SAMPLE mode where only a move of the mouse is enough to get
-*. the cursor position.
-*.
-*. _Input parameters:
-*.
-*. INTEGER IWKIDI : Workstation identifier .
-*. INTEGER LCN : Input device number .
-*. If LCN>10 then LCN=10*IPET+LNDNR
-*.
-*. LCN=10 tracking cross
-*. LCN=20 cross-hair
-*. LCN=30 rubber circle
-*. LCN=40 rubber band
-*. LCN=50 rubber rectangle
-*. LCN=99 the screen coordinates are taken
-*. in XLOC and YLOC (X11 only).
-*.
-*. LCN>0 request mode
-*. LCN<0 sample mode
-*.
-*. _Output parameters:
-*.
-*. INTEGER ISTATI : Return status: 0=BREAK, 1=OK .
-*. INTEGER ITNRI : Normalization transformation number .
-*. REAL XLOC YLOC : Cursor position in WC space .
-*.
-*..==========> (O.Couet)
-#if defined(CERNLIB_KERNEL)
-#include "higz/hikern.inc"
-#endif
-#if defined(CERNLIB_ZEBRA)
-#include "higz/hipaw.inc"
-#endif
-#if !defined(CERNLIB_ZEBRA)
-#include "higz/hiques.inc"
-#endif
-#if (!defined(CERNLIB_NTC))&&(!defined(CERNLIB_X11))
-#include "higz/hint.inc"
-#endif
-#include "higz/hiloc.inc"
-#include "higz/hiatt.inc"
-#if defined(CERNLIB_MAIL)
-#include "higz/himail.inc"
-#endif
-#if defined(CERNLIB_MAIL)
-#include "higz/hiflag.inc"
-#endif
- LOGICAL SAMPLE
-#if defined(CERNLIB_GL)
- SAVE IXLOCP,IYLOCP
-#endif
-*.______________________________________
-*
- IWKIND = IGIWIN(IWKIDI)
- IQUEST(1) = 0
- IF(IWKIND.EQ.0)THEN
- CALL IGERR('Workstation is not open','IRQLC')
- RETURN
- ENDIF
- IF(IWTYL(IWKIND).LE.0)THEN
-* No locator for Metafile.
- CALL IGERR('No request locator on metafile','IRQLC')
- RETURN
- ENDIF
-#if defined(CERNLIB_MAIL)
-*
- IF(MFLAG)THEN
- WRITE (CHMAIL,'(3I3)') 555,IWKIDI,LCN
- CALL IMWRIT(1)
- READ (5,'(2I5,2E16.7)') ISTATI,ITNRI,XLOC,YLOC
- CALL IMWRIT(5)
- RETURN
- ENDIF
-#endif
-*
- IF (LCN.GE.0) THEN
- SAMPLE = .FALSE.
- ELSE
- SAMPLE = .TRUE.
- ENDIF
- IPET = 1
- IF(ABS(LCN).GE.10)THEN
- IPET = ABS(LCN)/10
- ENDIF
-#if defined(CERNLIB_MSDOS)
- ISAVE = IWKNB
- IWKNB = IWKIND
-#endif
-#if defined(CERNLIB_FALCO)
-*
- IF(IWTYL(IWKIND).EQ.7878.OR.IWTYL(IWKIND).EQ.7879)THEN
-* Here we use space as affirmative reply and any other char as NO
- IF (ISTATI.EQ.ICHAR(' ')) THEN
- ISTATI=1
- ELSE
- ISTATI=0
- ENDIF
- GOTO 90
- ENDIF
-#endif
-#if (defined(CERNLIB_GL))&&(!defined(CERNLIB_MSDOS))
-*
- CALL ISCLIP(0)
- CALL QDEVIC(LEFTMO)
- CALL QDEVIC(RIGHTM)
- CALL QDEVIC(MOUSEX)
- CALL QDEVIC(MOUSEY)
- CALL LOGICO(LOXOR)
- CALL GETORI(IXORI,IYORI)
- CALL COLOR(1)
- CALL QRESET
- IXLOCP=IXLOCO
- IYLOCP=IYLOCO
- 40 CONTINUE
- CALL WINSET(IWINID(IWKIND))
- CALL CURSOF
- IF(LOINS)THEN
- IF(IPET.EQ.1)THEN
- CALL MOVE2I(IXLOC,IYLOC-10)
- CALL DRAW2I(IXLOC,IYLOC+10)
- CALL MOVE2I(IXLOC-10,IYLOC)
- CALL DRAW2I(IXLOC+10,IYLOC)
- ENDIF
- IF(IPET.EQ.2)THEN
- CALL MOVE2I(IXLOC,0)
- CALL DRAW2I(IXLOC,INT(YWKSIZ(IWKIND)))
- CALL MOVE2I(0,IYLOC)
- CALL DRAW2I(INT(XWKSIZ(IWKIND)),IYLOC)
- ENDIF
- IF(IPET.EQ.3)THEN
- RX=FLOAT(IXLOC-IXLOCP)
- RY=FLOAT(IYLOC-IYLOCP)
- IRAD=INT(SQRT(RX*RX+RY*RY))
- CALL CIRCI(IXLOCP,IYLOCP,IRAD)
- ENDIF
- IF(IPET.EQ.4.OR.IPET.EQ.3)THEN
- CALL MOVE2I(IXLOCP,IYLOCP)
- CALL DRAW2I(IXLOC,IYLOC)
- ENDIF
- IF(IPET.EQ.5)THEN
- CALL SBOXI(IXLOCP,IYLOCP,IXLOC,IYLOC)
- ENDIF
- ENDIF
- IXLOCO=IXLOC
- IYLOCO=IYLOC
- IDEV=QREAD(IVAL)
- IF(IDEV.EQ.MOUSEX.OR.IDEV.EQ.MOUSEY.OR.LOINS)THEN
- IF(IDEV.EQ.MOUSEX)THEN
- IXLOC=IVAL-IXORI
- RQUEST(11)=FLOAT(IXLOC)/WKMAX(IWKIND)
- GOTO 50
- ENDIF
- IF(IDEV.EQ.MOUSEY)THEN
- IYLOC=IVAL-IYORI
- RQUEST(12)=FLOAT(IYLOC)/WKMAX(IWKIND)
- GOTO 50
- ENDIF
- 50 IF(LOINS)THEN
- IF(IPET.EQ.1)THEN
- CALL MOVE2I(IXLOCO,IYLOCO-10)
- CALL DRAW2I(IXLOCO,IYLOCO+10)
- CALL MOVE2I(IXLOCO-10,IYLOCO)
- CALL DRAW2I(IXLOCO+10,IYLOCO)
- ENDIF
- IF(IPET.EQ.2)THEN
- CALL MOVE2I(IXLOCO,0)
- CALL DRAW2I(IXLOCO,INT(YWKSIZ(IWKIND)))
- CALL MOVE2I(0,IYLOCO)
- CALL DRAW2I(INT(XWKSIZ(IWKIND)),IYLOCO)
- ENDIF
- IF(IPET.EQ.3)THEN
- RX=FLOAT(IXLOCO-IXLOCP)
- RY=FLOAT(IYLOCO-IYLOCP)
- IRAD=INT(SQRT(RX*RX+RY*RY))
- CALL CIRCI(IXLOCP,IYLOCP,IRAD)
- ENDIF
- IF(IPET.EQ.4.OR.IPET.EQ.3)THEN
- CALL MOVE2I(IXLOCP,IYLOCP)
- CALL DRAW2I(IXLOCO,IYLOCO)
- ENDIF
- IF(IPET.EQ.5)THEN
- CALL SBOXI(IXLOCP,IYLOCP,IXLOCO,IYLOCO)
- ENDIF
- ENDIF
- LOINS=.TRUE.
- GOTO 60
- ENDIF
- 60 IF(IDEV.EQ.LEFTMO)THEN
- IDEV=QREAD(IVAL)
- ISTATI=1
- GOTO 70
- ENDIF
- IF(IDEV.EQ.RIGHTM)THEN
- IDEV=QREAD(IVAL)
- ISTATI=0
- GOTO 70
- ENDIF
- IF(IDEV.EQ.INPTCH)THEN
- LOINS=.NOT.LOINS
- GOTO 40
- ENDIF
- GOTO 40
- 70 CALL UNQDEV(LEFTMO)
- CALL UNQDEV(RIGHTM)
- CALL UNQDEV(MOUSEX)
- CALL UNQDEV(MOUSEY)
- CALL LOGICO(LOSRC)
- CALL COLOR(IPLCI+IOFCOL)
- CALL CURSON
- LOINS=.FALSE.
-#endif
-#if defined(CERNLIB_MSDOS)
- RQUEST(11)=OLDXP
- RQUEST(12)=OLDYP
-*
- IXLOCO = NINT(RQUEST(11)*WKMAX(IWKIND))
- IYLOCO = NINT(YWKSIZ(IWKIND)-RQUEST(12)*WKMAX(IWKIND))
-#endif
-#if (defined(CERNLIB_MSDOS))&&(defined(CERNLIB_NDP))
-*
- CALL ISCLIP(0)
- IER = SET_XOR(1)
- CALL COLOR(6)
- IF (MOUSE) CALL SET_MOUSE(IXLOCO,IYLOCO)
- IXLOCP=IXLOCO
- IYLOCP=IYLOCO
- 40 CONTINUE
- CALL WINSET(IWINID(IWKIND))
- CALL CURSOF
- IF(LOINS)THEN
- IF(IPET.EQ.1)THEN
- CALL MOVE2I(IXLOC,IYLOC-10)
- CALL DRAW2I(IXLOC,IYLOC+10)
- CALL MOVE2I(IXLOC-10,IYLOC)
- CALL DRAW2I(IXLOC+10,IYLOC)
- ENDIF
- IF(IPET.EQ.2)THEN
- CALL MOVE2I(IXLOC,0)
- CALL DRAW2I(IXLOC,INT(YWKSIZ(IWKIND)))
- CALL MOVE2I(0,IYLOC)
- CALL DRAW2I(INT(XWKSIZ(IWKIND)),IYLOC)
- ENDIF
- IF(IPET.EQ.3)THEN
- RX=FLOAT(IXLOC-IXLOCP)
- RY=FLOAT(IYLOC-IYLOCP)
- IRAD=NINT(SQRT(RX*RX+RY*RY))
- CALL CIRCI(IXLOCP,IYLOCP,IRAD)
- ENDIF
- IF(IPET.EQ.4.OR.IPET.EQ.3)THEN
- CALL MOVE2I(IXLOCP,IYLOCP)
- CALL DRAW2I(IXLOC,IYLOC)
- ENDIF
- IF(IPET.EQ.5)THEN
- CALL SBOXI(IXLOCP,IYLOCP,IXLOC,IYLOC)
- ENDIF
- ENDIF
- IXLOCO=IXLOC
- IYLOCO=IYLOC
- ISTATI=ICRAWL(IXLOC,IYLOC)
- IF(ISTATI.GT. 0 .OR. LOINS)THEN
- IF(ISTATI .EQ. 10 .or. ISTATI .EQ. 11)THEN
- RQUEST(11)=FLOAT(IXLOC)/WKMAX(IWKIND)
- ENDIF
- IF(ISTATI .EQ. 1 .or. ISTATI .EQ. 11)THEN
- RQUEST(12)=(YWKSIZ(IWKIND)-FLOAT(IYLOC))/WKMAX(IWKIND)
- ENDIF
- 50 IF(LOINS)THEN
- IF(IPET.EQ.1)THEN
- CALL MOVE2I(IXLOCO,IYLOCO-10)
- CALL DRAW2I(IXLOCO,IYLOCO+10)
- CALL MOVE2I(IXLOCO-10,IYLOCO)
- CALL DRAW2I(IXLOCO+10,IYLOCO)
- ENDIF
- IF(IPET.EQ.2)THEN
- CALL MOVE2I(IXLOCO,0)
- CALL DRAW2I(IXLOCO,INT(YWKSIZ(IWKIND)))
- CALL MOVE2I(0,IYLOCO)
- CALL DRAW2I(INT(XWKSIZ(IWKIND)),IYLOCO)
- ENDIF
- IF(IPET.EQ.3)THEN
- RX=FLOAT(IXLOCO-IXLOCP)
- RY=FLOAT(IYLOCO-IYLOCP)
- IRAD=NINT(SQRT(RX*RX+RY*RY))
- CALL CIRCI(IXLOCP,IYLOCP,IRAD)
- ENDIF
- IF(IPET.EQ.4.OR.IPET.EQ.3)THEN
- CALL MOVE2I(IXLOCP,IYLOCP)
- CALL DRAW2I(IXLOCO,IYLOCO)
- ENDIF
- IF(IPET.EQ.5)THEN
- CALL SBOXI(IXLOCP,IYLOCP,IXLOCO,IYLOCO)
- ENDIF
- ENDIF
- LOINS=.TRUE.
- GOTO 60
- ENDIF
- 60 IF(ISTATI .EQ. 0)THEN
- ISTATI=1
- GOTO 70
- ENDIF
- IF(ISTATI .EQ. -1)THEN
- ISTATI=0
- GOTO 70
- ENDIF
- IF (.NOT. SAMPLE) GOTO 40
- ISTATI = 1
- 70 CONTINUE
- IER = SET_XOR(0)
- CALL COLOR(IPLCI+IOFCOL)
- LOINS=.FALSE.
- IWKNB = ISAVE
-#endif
-#if (defined(CERNLIB_MSDOS))&&(!defined(CERNLIB_NDP))
- IIX= IXLOCO
- IIY= IYLOCO
-#endif
-#if (defined(CERNLIB_X11)||defined(CERNLIB_MSDOS))&&(!defined(CERNLIB_NDP))
-*
- IF(LCN.EQ.99)THEN
- IIX=INT(XLOC)
- IIY=INT(YLOC)
- ISTATI=99
- GOTO 80
- ENDIF
- CALL IXSELWI(IWINID(IWKIND))
- IF(SAMPLE)THEN
- ISTATI=IXREQLO(1,IPET,IIX,IIY)
- ELSE
- ISTATI=IXREQLO(0,IPET,IIX,IIY)
- ENDIF
- IF(ISTATI.EQ.3)ISTATI=0
- 80 RQUEST(11)=FLOAT(IIX)/WKMAX(IWKIND)
- RQUEST(12)=(YWKSIZ(IWKIND)-FLOAT(IIY))/WKMAX(IWKIND)
-#endif
-#if defined(CERNLIB_MACMPW)
-*
- IF(SAMPLE)THEN
- ISTATI=IMREQLO(1,IPET,IIX,IIY)
- ELSE
- ISTATI=IMREQLO(0,IPET,IIX,IIY)
- ENDIF
- IF(ISTATI.EQ.3)ISTATI=0
- RQUEST(11)=FLOAT(IIX)/WKMAX(IWKIND)
- RQUEST(12)=(YWKSIZ(IWKIND)-FLOAT(IIY))/WKMAX(IWKIND)
-#endif
-*
- 90 IF(ISTATI.EQ.0.AND..NOT.SAMPLE)THEN
- RQUEST(11)=OLDXP
- RQUEST(12)=OLDYP
- RETURN
- ENDIF
- OLDXP=RQUEST(11)
- OLDYP=RQUEST(12)
- SCALE=1.
- IF(REDIT.NE.0.)SCALE=REDIT
- RQUEST(20)=0.
- RQUEST(21)=1.
- RQUEST(22)=0.
- RQUEST(23)=1.
- RQUEST(30)=0.
- RQUEST(31)=1.
- RQUEST(32)=0.
- RQUEST(33)=1.
- ITNRI=0
- XLOC=(RQUEST(11)+RDWXMI*REDIT)/SCALE
- YLOC=(RQUEST(12)+RDWYMI*REDIT)/SCALE
-#if defined(CERNLIB_ZEBRA)
-*
-* There is displayed picture
-*
- IF(LPICD.GT.0)THEN
- IPRIOO=IQ(LDNT0+3)
- NBNT=IQ(LPICD+8)-1
- LN=LQ(LDNT0)
- DO 100 I=1,NBNT
- IAWV=LDF+IQ(LN+2)
- IPRION=IQ(LN+3)
- RQUEST(20)=Q(IAWV)
- RQUEST(21)=Q(IAWV+1)
- RQUEST(22)=Q(IAWV+2)
- RQUEST(23)=Q(IAWV+3)
- RQUEST(30)=Q(IAWV+4)
- RQUEST(31)=Q(IAWV+5)
- RQUEST(32)=Q(IAWV+6)
- RQUEST(33)=Q(IAWV+7)
- IF((RQUEST(30)*SCALE-(RDWXMI*REDIT).LE.RQUEST(11)).AND.
- + (RQUEST(11).LE.RQUEST(31)*SCALE-(RDWXMI*REDIT)).AND.
- + (RQUEST(32)*SCALE-(RDWYMI*REDIT).LE.RQUEST(12)).AND.
- + (RQUEST(12).LE.RQUEST(33)*SCALE-(RDWYMI*REDIT)))THEN
- IF(IPRION.GT.IPRIOO)THEN
- XLOC=((((RQUEST(11)+(RDWXMI*REDIT))/SCALE)
- + -RQUEST(30))
- + /(RQUEST(31)-RQUEST(30)))
- + *(RQUEST(21)-RQUEST(20))
- + +RQUEST(20)
- YLOC=((((RQUEST(12)+(RDWYMI*REDIT))/SCALE)
- + -RQUEST(32))
- + /(RQUEST(33)-RQUEST(32)))
- + *(RQUEST(23)-RQUEST(22))
- + +RQUEST(22)
- ITNRI=IQ(LN+1)
- IPRIOO=IPRION
- ENDIF
- ENDIF
- LN=LQ(LN)
- IF(LN.EQ.0)RETURN
- 100 CONTINUE
- RETURN
- ENDIF
-#endif
-#if (!defined(CERNLIB_NTC))&&(!defined(CERNLIB_X11))
-*
-* The computing of XLOC and YLOC in done with the parameters
-* stored in HINT.
-*
- NBNT=NTSTOR(1)
- IPRIOO=NT0PRI
- DO 110 I=1,NBNT
- NNT=NTSTOR(2*I)
- CALL IZGNT(NNT,IFIND,IAWV,IPRION,IHPRIO)
- RQUEST(20)=WNVPST(IAWV)
- RQUEST(21)=WNVPST(IAWV+1)
- RQUEST(22)=WNVPST(IAWV+2)
- RQUEST(23)=WNVPST(IAWV+3)
- RQUEST(30)=WNVPST(IAWV+4)
- RQUEST(31)=WNVPST(IAWV+5)
- RQUEST(32)=WNVPST(IAWV+6)
- RQUEST(33)=WNVPST(IAWV+7)
- IF((RQUEST(30)*SCALE-(RDWXMI*REDIT).LE.RQUEST(11)).AND.
- + (RQUEST(11).LE.RQUEST(31)*SCALE-(RDWXMI*REDIT)).AND.
- + (RQUEST(32)*SCALE-(RDWYMI*REDIT).LE.RQUEST(12)).AND.
- + (RQUEST(12).LE.RQUEST(33)*SCALE-(RDWYMI*REDIT)))THEN
- IF(IPRION.GT.IPRIOO)THEN
- XLOC=((((RQUEST(11)+(RDWXMI*REDIT))/SCALE)
- + -RQUEST(30))
- + /(RQUEST(31)-RQUEST(30)))
- + *(RQUEST(21)-RQUEST(20))
- + +RQUEST(20)
- YLOC=((((RQUEST(12)+(RDWYMI*REDIT))/SCALE)
- + -RQUEST(32))
- + /(RQUEST(33)-RQUEST(32)))
- + *(RQUEST(23)-RQUEST(22))
- + +RQUEST(22)
- ITNRI=NNT
- IPRIOO=IPRION
- ENDIF
- ENDIF
- 110 CONTINUE
-#endif
-#if defined(CERNLIB_NTC)||defined(CERNLIB_X11)
- IPRIOO = NT0PRI
- IEND = IGNNXT(1)
- 120 IF(IEND.EQ.0)THEN
- CALL IGNGET(NNT,IPRION,IHPRIO
- +, RQUEST(20),RQUEST(21),RQUEST(22),RQUEST(23)
- +, RQUEST(30),RQUEST(31),RQUEST(32),RQUEST(33),I3D)
- IF((RQUEST(30)*SCALE-(RDWXMI*REDIT).LE.RQUEST(11)).AND.
- + (RQUEST(11).LE.RQUEST(31)*SCALE-(RDWXMI*REDIT)).AND.
- + (RQUEST(32)*SCALE-(RDWYMI*REDIT).LE.RQUEST(12)).AND.
- + (RQUEST(12).LE.RQUEST(33)*SCALE-(RDWYMI*REDIT)))THEN
- IF(IPRION.GT.IPRIOO)THEN
- XLOC=((((RQUEST(11)+(RDWXMI*REDIT))/SCALE)
- + -RQUEST(30))
- + /(RQUEST(31)-RQUEST(30)))
- + *(RQUEST(21)-RQUEST(20))
- + +RQUEST(20)
- YLOC=((((RQUEST(12)+(RDWYMI*REDIT))/SCALE)
- + -RQUEST(32))
- + /(RQUEST(33)-RQUEST(32)))
- + *(RQUEST(23)-RQUEST(22))
- + +RQUEST(22)
- ITNRI=NNT
- IPRIOO=IPRION
- ENDIF
- ENDIF
- IEND = IGNNXT(0)
- GOTO 120
- ENDIF
-#endif
-*
- END
diff --git a/src/graflib/higz/ikernel/irqst.F b/src/graflib/higz/ikernel/irqst.F
deleted file mode 100644
index cb17ac2..0000000
--- a/src/graflib/higz/ikernel/irqst.F
+++ /dev/null
@@ -1,210 +0,0 @@
-*
-* $Id: irqst.F,v 1.2 1996/09/25 14:58:51 couet Exp $
-*
-* $Log: irqst.F,v $
-* Revision 1.2 1996/09/25 14:58:51 couet
-* - GPR driver removed
-*
-* Revision 1.1.1.1 1996/02/14 13:10:56 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.21/09 29/08/94 09.14.25 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE IRQST(IWKID,ISTD,IISTAT,L,STR)
- ENTRY GRQST(IWKID,ISTD,IISTAT,L,STR)
-#if defined(CERNLIB_KERNEL)
-#include "higz/hikern.inc"
-#endif
-#include "higz/hiatt.inc"
-#include "higz/hiques.inc"
-#if defined(CERNLIB_MAIL)
-#include "higz/himail.inc"
-#endif
-#if defined(CERNLIB_MAIL)
-#include "higz/hiflag.inc"
-#endif
- CHARACTER*(*) STR
-*
-#if defined(CERNLIB_MSDOS)
- INTEGER BACKSP, RETKEY, LARROW, DELCHR, CTRL_C, ESC
- DATA BACKSP, RETKEY, LARROW, DELCHR, ESC /8, 13, -75, -83, 27/
- DATA CTRL_C /3/
-#endif
- IF(IWKID.LT.0)THEN
- IIWKID = ABS(IWKID)
- RXPOS = RQUEST(81)
- RYPOS = RQUEST(91)
- ELSE
- IIWKID = IWKID
- RXPOS = 0.
- RYPOS = 0.
- ENDIF
-*
- IWKIND = IGIWIN(IIWKID)
- IQUEST(1) = 0
- IF(IWKIND.EQ.0)THEN
- CALL IGERR('Workstation is not open','IRQST')
- RETURN
- ENDIF
- IF(IWTYL(IWKIND).LE.0)THEN
-* No locator for Metafile.
- CALL IGERR('Request string is not available','IRQST')
- RETURN
- ENDIF
-*
- IISTAT=0
-#if defined(CERNLIB_MSDOS)
- ISAVE = IWKNB
- IWKNB = IWKIND
-#endif
-*
-#if defined(CERNLIB_MAIL)
- IF(MFLAG)THEN
- WRITE (CHMAIL,'(3I3)') 556,IIWKID,ISTD
- CALL IMWRIT(1)
- READ (5,'(2I5,A)') IISTAT,L,STR
- CALL IMWRIT(5)
- RETURN
- ENDIF
-*
-#endif
-#if defined(CERNLIB_MACMPW)
- CALL IMACPLO(0,0,-999)
- WRITE (6,'(X,A,$)',ERR=100,END=100) '>'
- READ (5,'(A)',ERR=100,END=100) STR
- L=LENOCC(STR)
- IISTAT=1
-100 RETURN
-#endif
-#if defined(CERNLIB_FALCO)
- IF(IWTYL(IWKIND).EQ.7878.OR.IWTYL(IWKIND).EQ.7879)THEN
- CALL IFMOVE(0.,0.)
- CALL IFPUT(0)
- READ (*,'(A)') STR
- CALL IFPUT(31)
- CALL IFPUT(24)
- CALL IFPUT(0)
- L = LENOCC(STR)
- RETURN
- ENDIF
-*
-#endif
-#if (defined(CERNLIB_GL))&&(!defined(CERNLIB_MSDOS))
- CALL WINSET(IWINID(IWKIND))
- CALL QRESET
- CALL QDEVIC(KEYBD)
- CALL QDEVIC(RETKEY)
- CALL QDEVIC(BACKSP)
- CALL CLKON
- IXPOS=INT(RXPOS)
- L=1
- STR=' '
- 20 CALL COLOR(IOFCOL+1)
- ICURCI(IWKIND)=1
- CALL CMOV2I(IXPOS,INT(RYPOS))
- CALL CHARST('_',1)
- IDEV=QREAD(IVAL)
- CALL COLOR(IOFCOL)
- ICURCI(IWKIND)=0
- CALL CMOV2I(IXPOS,INT(RYPOS))
- CALL CHARST('_',1)
- IF(IDEV.EQ.RETKEY)THEN
- CALL UNQDEV(KEYBD)
- CALL UNQDEV(RETKEY)
- CALL UNQDEV(BACKSP)
- CALL CLKOFF
- IISTAT=1
- RETURN
- ENDIF
- IF(IDEV.EQ.BACKSP)THEN
- IF(L.EQ.1)THEN
- CALL RINGBE
- GOTO 20
- ENDIF
- L=L-1
- IXPOS=IXPOS-STRWID(STR(L:L),1)
- CALL CMOV2I(IXPOS,INT(RYPOS))
- CALL CHARST(STR(L:L),1)
- STR(L:L)=' '
- GOTO 20
- ENDIF
- IF(IVAL.LT.32)GOTO 20
- IF(L.GT.LEN(STR))THEN
- CALL RINGBE
- GOTO 20
- ENDIF
- CALL COLOR(IOFCOL+1)
- ICURCI(IWKIND)=1
- CALL CMOV2I(IXPOS,INT(RYPOS))
- CALL CHARST(CHAR(IVAL),1)
- STR(L:L)=CHAR(IVAL)
- IXPOS=IXPOS+STRWID(CHAR(IVAL),1)
- L=L+1
- GOTO 20
-*
-#endif
-#if defined(CERNLIB_MSDOS)
- CALL WINSET(IWINID(IWKIND))
- IHHH = STRWID('_',1)
- RYPOS = YWKSIZ(IWKIND)-RYPOS
- IXPOS = NINT(RXPOS)
- IYPOS = NINT(RYPOS) - IHHH + 1
- L = 1
- STR = ' '
- 30 CALL COLOR(IOFCOL+1)
- ICURCI(IWKIND)=1
- IER = GRAPHIC_TEXT('_',IXPOS,IYPOS,IOFCOL+1)
- IDEV = PAUSE()
- IF (IDEV .EQ. CTRL_C) THEN
- CALL IGEND
- CALL ABEND
- END IF
- IF (IDEV .EQ. LARROW .OR. IDEV .EQ. DELCHR) IDEV = BACKSP
- IF (IDEV .LE. 0)GOTO 30
- CALL COLOR(IOFCOL)
- ICURCI(IWKIND)=0
- IER = GRAPHIC_TEXT('_',IXPOS,IYPOS,IOFCOL)
- IF(IDEV.EQ.RETKEY .OR. IDEV .EQ. ESC)THEN
- IISTAT=1
- IWKNB = ISAVE
- RETURN
- ENDIF
- IF(IDEV.EQ.BACKSP)THEN
- IF(L.EQ.1)THEN
- IER = BEEP()
- IER = BEEP()
- GOTO 30
- ENDIF
- L=L-1
- IXPOS=IXPOS-STRWID(STR(L:L),1)
- IER = GRAPHIC_TEXT(STR(L:L),IXPOS,IYPOS,IOFCOL)
- STR(L:L)=' '
- GOTO 30
- ENDIF
- IF(IDEV.LT.32)GOTO 30
- IF(L.GT.LEN(STR))THEN
- IER = BEEP()
- IER = BEEP()
- GOTO 30
- ENDIF
- CALL COLOR(IOFCOL+1)
- ICURCI(IWKIND)=1
- IER = GRAPHIC_TEXT(CHAR(IDEV),IXPOS,IYPOS,IOFCOL+1)
- STR(L:L)=CHAR(IDEV)
- IXPOS=IXPOS+STRWID(CHAR(IDEV),1)
- L=L+1
- GOTO 30
-*
-#endif
-#if defined(CERNLIB_X11)
- RYPOS = YWKSIZ(IWKIND)-RYPOS
- IXPOS = NINT(RXPOS)
- IYPOS = NINT(RYPOS)
- L = LEN(STR)
- IISTAT = IXREQST(IXPOS,IYPOS,L,STR)
- L = LENOCC(STR)
-*
-#endif
- END
diff --git a/src/graflib/higz/ikernel/ischh.F b/src/graflib/higz/ikernel/ischh.F
deleted file mode 100644
index 718c21c..0000000
--- a/src/graflib/higz/ikernel/ischh.F
+++ /dev/null
@@ -1,52 +0,0 @@
-*
-* $Id: ischh.F,v 1.2 1998/01/28 14:34:48 couet Exp $
-*
-* $Log: ischh.F,v $
-* Revision 1.2 1998/01/28 14:34:48 couet
-* - GGDM driver removed
-*
-* Revision 1.1.1.1 1996/02/14 13:10:56 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.18/10 22/06/93 17.23.31 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE ISCHH(CHH)
- ENTRY GSCHH(CHH)
-#include "higz/hiatt.inc"
-#if defined(CERNLIB_ZEBRA)
-#include "higz/hicode.inc"
-#endif
-#include "higz/hiflag.inc"
-#if defined(CERNLIB_MSDOS)
-#include "higz/hikern.inc"
-#endif
-#if defined(CERNLIB_MSDOS)
-#include "higz/hiwcdc.inc"
-#endif
- IF(CHH.EQ.RCHH)RETURN
- RCHH=CHH
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_MAIL)
- IF(GLFLAG)CALL IZATT(ICHHCO)
-#endif
- IF(GFLAG)THEN
-#if defined(CERNLIB_FALCO)
- IF(IWTYPE.EQ.7878.OR.IWTYPE.EQ.7879)RETURN
-#endif
-#if defined(CERNLIB_PHIGS)
- CALL PSCHH(CHH)
-#endif
-#if defined(CERNLIB_MSDOS)
- ISAVE=IWKNB
- IWKNB=IGIWIN(1)
- IF(IWKNB.NE.0)THEN
- MAG_Y=IABS(IYWCDC(RCHH)-IYWCDC(0.0))/8
- IF(MAG_Y.EQ.0)MAG_Y=1
- MAG_X=MAG_Y
- IER=MAGNIFY_TEXT(MAG_X,MAG_Y)
- ENDIF
- IWKNB = ISAVE
-#endif
- ENDIF
- END
diff --git a/src/graflib/higz/ikernel/ischup.F b/src/graflib/higz/ikernel/ischup.F
deleted file mode 100644
index 7caf5fd..0000000
--- a/src/graflib/higz/ikernel/ischup.F
+++ /dev/null
@@ -1,42 +0,0 @@
-*
-* $Id: ischup.F,v 1.2 1998/01/28 14:34:49 couet Exp $
-*
-* $Log: ischup.F,v $
-* Revision 1.2 1998/01/28 14:34:49 couet
-* - GGDM driver removed
-*
-* Revision 1.1.1.1 1996/02/14 13:10:56 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.12/05 05/03/91 12.06.07 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE ISCHUP(CHUX,CHUY)
- ENTRY GSCHUP(CHUX,CHUY)
-#include "higz/hiatt.inc"
-#if defined(CERNLIB_ZEBRA)
-#include "higz/hicode.inc"
-#endif
-#include "higz/hiflag.inc"
- IF((CHUX.EQ.RCHUX).AND.(CHUY.EQ.RCHUY))RETURN
- RCHUX=CHUX
- RCHUY=CHUY
- IF((RCHUX.EQ.0.).AND.(RCHUY.EQ.1.))THEN
- RANGLE=0.
- ELSEIF((RCHUX.EQ.-1.).AND.(RCHUY.EQ.0.))THEN
- RANGLE=90.
- ELSEIF((RCHUX.EQ.0.).AND.(RCHUY.EQ.-1.))THEN
- RANGLE=180.
- ELSEIF((RCHUX.EQ.1.).AND.(RCHUY.EQ.0.))THEN
- RANGLE=270.
- ELSE
- RANGLE=((ACOS(RCHUX/SQRT(RCHUX**2+RCHUY**2))*180.)
- + /3.14159)-90.
- IF(RCHUY.LT.0.)RANGLE=180.-RANGLE
- IF(ABS(RANGLE).LE.0.01)RANGLE=0.
- ENDIF
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_MAIL)
- IF(GLFLAG)CALL IZATT(IANGCO)
-#endif
- END
diff --git a/src/graflib/higz/ikernel/isclip.F b/src/graflib/higz/ikernel/isclip.F
deleted file mode 100644
index ef3b410..0000000
--- a/src/graflib/higz/ikernel/isclip.F
+++ /dev/null
@@ -1,81 +0,0 @@
-*
-* $Id: isclip.F,v 1.3 1998/01/28 14:34:50 couet Exp $
-*
-* $Log: isclip.F,v $
-* Revision 1.3 1998/01/28 14:34:50 couet
-* - GGDM driver removed
-*
-* Revision 1.2 1996/09/25 14:58:52 couet
-* - GPR driver removed
-*
-* Revision 1.1.1.1 1996/02/14 13:10:56 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.21/01 10/05/94 10.52.06 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE ISCLIP(ICLSW)
- ENTRY GSCLIP(ICLSW)
-#if defined(CERNLIB_KERNEL)
-#include "higz/hikern.inc"
-#endif
-#include "higz/hiatt.inc"
-#include "higz/hiflag.inc"
-#if defined(CERNLIB_KERNEL)
-#include "higz/hiwcdc.inc"
-#endif
- ICLIP=ICLSW
- IF(GFLAG)THEN
-#if defined(CERNLIB_KERNEL)||defined(CERNLIB_FALCO)
- DO 10 IWKNB=1,INOPWK
- IF(NODRFL(IWKNB))GOTO 10
- CALL IGSG(IWKNB)
-#endif
-#if defined(CERNLIB_FALCO)
- IF(IWTYL(IWKNB).EQ.7878.OR.IWTYL(IWKNB).EQ.7879)GOTO 10
-#endif
-#if defined(CERNLIB_GL)
- IF(ICLIP.NE.0)THEN
- WINSIZ(1)=IXWCDC(RWXMIN)
- WINSIZ(2)=IXWCDC(RWXMAX)
- WINSIZ(3)=IYWCDC(RWYMIN)
- WINSIZ(4)=IYWCDC(RWYMAX)
- ELSE
- WINSIZ(1)=0
- WINSIZ(2)=INT(XWKSIZ(IWKNB))
- WINSIZ(3)=0
- WINSIZ(4)=INT(YWKSIZ(IWKNB))
- ENDIF
- CALL SCRMAS(WINSIZ(1),WINSIZ(2),WINSIZ(3),WINSIZ(4))
-#endif
-#if defined(CERNLIB_X11)
- IF(ICLIP.NE.0)THEN
- IX=IXWCDC(RWXMIN)
- IY=IYWCDC(RWYMAX)
- IW=IXWCDC(RWXMAX)-IXWCDC(RWXMIN)
- IH=IYWCDC(RWYMIN)-IYWCDC(RWYMAX)
- CALL IXCLIP(IWINID(IWKNB),IX,IY,IW,IH)
- ELSE
- CALL IXNOCLI(IWINID(IWKNB))
- ENDIF
-#endif
-#if defined(CERNLIB_MACMPW)
- IF(ICLIP.NE.0)THEN
- IX=IXWCDC(RWXMIN)
- IY=IYWCDC(RWYMAX)
- IW=IXWCDC(RWXMAX)-IXWCDC(RWXMIN)
- IH=IYWCDC(RWYMIN)-IYWCDC(RWYMAX)
- CALL IMCLIP(IX,IY,IW,IH)
- ELSE
- CALL IMNOCLI
- ENDIF
-#endif
-#if defined(CERNLIB_KERNEL)||defined(CERNLIB_FALCO)
- 10 CONTINUE
-#endif
- ENDIF
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_PSCRIPT)||defined(CERNLIB_MAIL)
- IF(GLFLAG)CALL IZSCLI(ICLSW)
-#endif
- END
diff --git a/src/graflib/higz/ikernel/iscr.F b/src/graflib/higz/ikernel/iscr.F
deleted file mode 100644
index 8e50a82..0000000
--- a/src/graflib/higz/ikernel/iscr.F
+++ /dev/null
@@ -1,60 +0,0 @@
-*
-* $Id: iscr.F,v 1.2 1996/09/25 14:58:53 couet Exp $
-*
-* $Log: iscr.F,v $
-* Revision 1.2 1996/09/25 14:58:53 couet
-* - GPR driver removed
-*
-* Revision 1.1.1.1 1996/02/14 13:10:56 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.20/07 12/01/94 09.48.29 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE ISCR(IWKID,ICI,CR,CG,CB)
- ENTRY GSCR(IWKID,ICI,CR,CG,CB)
-#if defined(CERNLIB_KERNEL)
-#include "higz/hikern.inc"
-#endif
-#include "higz/hiflag.inc"
-#include "higz/hilut.inc"
-#if defined(CERNLIB_X11)||defined(CERNLIB_FALCO)
-#include "higz/hiatt.inc"
-#endif
-*
- I=MIN(NBCLUT-1,ABS(ICI))+1
- REDLUT(I)=CR
- GRNLUT(I)=CG
- BLULUT(I)=CB
-*
- IF(GFLAG)THEN
- J=IGIWTY(IWKID)
- IF(J.LE.0)RETURN
-#if defined(CERNLIB_FALCO)
- IF(J.EQ.7878.OR.J.EQ.7879)RETURN
-#endif
-#if (defined(CERNLIB_GL))&&(!defined(CERNLIB_MSDOS))
- CALL MAPCOL(ICI+IOFCOL,INT(255.*CR),INT(255.*CG),INT(255.*CB))
-#endif
-#if defined(CERNLIB_MSDOS)
- CALL MAPCOL(ICI+IOFCOL,CR,CG,CB)
-#endif
-#if defined(CERNLIB_X11)
- CALL IXSETCO(ICI,CR,CG,CB)
- IF(IPLCI.EQ.ICI)CALL IXSETLC(ICI)
- IF(IFACI.EQ.ICI)CALL IXSETFC(ICI)
- IF(IPMCI.EQ.ICI)CALL IXSETMC(ICI)
- IF(ITXCI.EQ.ICI)CALL IXSETTC(ICI)
-#endif
-#if defined(CERNLIB_MACMPW)
- CALL IMSETCO(ICI,CR,CG,CB)
-#endif
-#if defined(CERNLIB_PHIGS)
- CALL PSCR(IWKID,ICI,CR,CG,CB)
-#endif
- ENDIF
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_MAIL)
- IF(GLFLAG)CALL IZSCOR(IWKID,ICI,CR,CG,CB)
-#endif
- END
diff --git a/src/graflib/higz/ikernel/iselnt.F b/src/graflib/higz/ikernel/iselnt.F
deleted file mode 100644
index 527e2ae..0000000
--- a/src/graflib/higz/ikernel/iselnt.F
+++ /dev/null
@@ -1,115 +0,0 @@
-*
-* $Id: iselnt.F,v 1.1.1.1 1996/02/14 13:10:57 mclareni Exp $
-*
-* $Log: iselnt.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:57 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.21/03 31/05/94 11.24.05 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE ISELNT(NT)
- ENTRY GSELNT(NT)
-#if (!defined(CERNLIB_NTC))&&(!defined(CERNLIB_X11))
-#include "higz/hint.inc"
-#endif
-#include "higz/hiflag.inc"
-#include "higz/hiatt.inc"
-#if defined(CERNLIB_PHIGS)
- DIMENSION RMOR(3,3),RMAP(3,3),VWWNLM(4),PJVPLM(4)
-*
-#endif
-#if (!defined(CERNLIB_NTC))&&(!defined(CERNLIB_X11))
- CALL IZGNT(NT,IFIND,IAWV,IPRIO,IHPRIO)
-*
- IF(NT.EQ.0)THEN
- NT0PRI=IHPRIO+1
- RWXMIN=0.
- RWYMIN=0.
- RWXMAX=1.
- RWYMAX=1.
- RVXMIN=0.
- RVYMIN=0.
- RVXMAX=1.
- RVYMAX=1.
- GOTO 10
- ENDIF
-*
- IF(IFIND.NE.0)THEN
- RWXMIN=WNVPST(IAWV)
- RWYMIN=WNVPST(IAWV+2)
- RWXMAX=WNVPST(IAWV+1)
- RWYMAX=WNVPST(IAWV+3)
- RVXMIN=WNVPST(IAWV+4)
- RVYMIN=WNVPST(IAWV+6)
- RVXMAX=WNVPST(IAWV+5)
- RVYMAX=WNVPST(IAWV+7)
- NTSTOR(IFIND)=IHPRIO+1
- ELSE
- RWXMIN=0.
- RWYMIN=0.
- RWXMAX=1.
- RWYMAX=1.
- RVXMIN=0.
- RVYMIN=0.
- RVXMAX=1.
- RVYMAX=1.
- NBNT=NTSTOR(1)
- IF(NBNT+1.GT.NBNTMX)THEN
- CALL IGERR('Too many normalisation transformation','ISELNT')
- RETURN
- ENDIF
- NTSTOR(2*NBNT+2)=NT
- NTSTOR(2*NBNT+3)=IHPRIO+1
- WNVPST(8*NBNT+1)=0.
- WNVPST(8*NBNT+2)=1.
- WNVPST(8*NBNT+3)=0.
- WNVPST(8*NBNT+4)=1.
- WNVPST(8*NBNT+5)=0.
- WNVPST(8*NBNT+6)=1.
- WNVPST(8*NBNT+7)=0.
- WNVPST(8*NBNT+8)=1.
- NTSTOR(1)=NTSTOR(1)+1
- ENDIF
- 10 CONTINUE
-*
-#endif
-#if defined(CERNLIB_NTC)||defined(CERNLIB_X11)
- IF(IGNSCU(NT).EQ.0)CALL IGNCRE(NT)
- CALL IGNGET(I0,I1,IHPRIO
- +, RWXMIN,RWXMAX,RWYMIN,RWYMAX
- +, RVXMIN,RVXMAX,RVYMIN,RVYMAX,I3D)
- CALL IGNSPR(IHPRIO+1)
- IF(I3D.NE.0)CALL IGSVIE
-*
-#endif
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_PSCRIPT)||defined(CERNLIB_MAIL)
- IF(GLFLAG)CALL IZSELN(NT)
-#endif
-#if !defined(CERNLIB_PHIGS)
- XRATIO=(RVXMAX-RVXMIN)/(RWXMAX-RWXMIN)
- YRATIO=(RVYMAX-RVYMIN)/(RWYMAX-RWYMIN)
-#endif
-#if defined(CERNLIB_PHIGS)
- VWWNLM(1)=RWXMIN
- VWWNLM(2)=RWXMAX
- VWWNLM(3)=RWYMIN
- VWWNLM(4)=RWYMAX
- PJVPLM(1)=RVXMIN
- PJVPLM(2)=RVXMAX
- PJVPLM(3)=RVYMIN
- PJVPLM(4)=RVYMAX
- CALL PEVOM(0.,0.,0.,1.,IERR,RMOR)
- CALL PEVMM(VWWNLM,PJVPLM,IERR,RMAP)
- IF(NT.NE.0)THEN
- DO 20 I=1,INOPWK
- CALL PSVWR(ILOPWK(I),NT,RMOR,RMAP,PJVPLM,1)
- CALL PUWK(ILOPWK(I),1)
- 20 CONTINUE
- ENDIF
- CALL PSVWI(NT)
-#endif
- INTR=NT
- CALL ISCLIP(ICLIP)
- END
diff --git a/src/graflib/higz/ikernel/isfaci.F b/src/graflib/higz/ikernel/isfaci.F
deleted file mode 100644
index 01054be..0000000
--- a/src/graflib/higz/ikernel/isfaci.F
+++ /dev/null
@@ -1,59 +0,0 @@
-*
-* $Id: isfaci.F,v 1.3 1998/01/28 14:34:51 couet Exp $
-*
-* $Log: isfaci.F,v $
-* Revision 1.3 1998/01/28 14:34:51 couet
-* - GGDM driver removed
-*
-* Revision 1.2 1996/09/25 14:58:56 couet
-* - GPR driver removed
-*
-* Revision 1.1.1.1 1996/02/14 13:10:57 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.20/07 12/01/94 09.58.02 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE ISFACI(ICOLI)
- ENTRY GSFACI(ICOLI)
-#if defined(CERNLIB_KERNEL)
-#include "higz/hikern.inc"
-#endif
-#include "higz/hiatt.inc"
-#if defined(CERNLIB_ZEBRA)
-#include "higz/hicode.inc"
-#endif
-#include "higz/hiflag.inc"
- IF(ICOLI.EQ.IFACI)RETURN
- IFACI=ICOLI
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_MAIL)
- IF(GLFLAG)CALL IZATT(IFACCO)
-#endif
- IF(GFLAG)THEN
-#if defined(CERNLIB_PHIGS)
- CALL PSICI(IFACI)
-#endif
-#if defined(CERNLIB_KERNEL)||defined(CERNLIB_FALCO)
- DO 10 IWKNB=1,INOPWK
- IF(NODRFL(IWKNB))GOTO 10
- CALL IGSG(IWKNB)
-#endif
-#if defined(CERNLIB_FALCO)
- IF(IWTYL(IWKNB).EQ.7878.OR.IWTYL(IWKNB).EQ.7879)GOTO 10
-#endif
-#if defined(CERNLIB_GL)
- CALL COLOR(IFACI+IOFCOL)
- ICURCI(IWKNB)=IFACI
-#endif
-#if defined(CERNLIB_X11)
- CALL IXSETFC(IFACI)
-#endif
-#if defined(CERNLIB_MACMPW)
- CALL IMSETFC(IFACI)
-#endif
-#if defined(CERNLIB_KERNEL)||defined(CERNLIB_FALCO)
- 10 CONTINUE
-#endif
- ENDIF
- END
diff --git a/src/graflib/higz/ikernel/isfais.F b/src/graflib/higz/ikernel/isfais.F
deleted file mode 100644
index c78210d..0000000
--- a/src/graflib/higz/ikernel/isfais.F
+++ /dev/null
@@ -1,55 +0,0 @@
-*
-* $Id: isfais.F,v 1.3 1996/12/09 13:47:28 couet Exp $
-*
-* $Log: isfais.F,v $
-* Revision 1.3 1996/12/09 13:47:28 couet
-* - protection added against IWTYP=0
-*
-* Revision 1.2 1996/09/25 14:58:56 couet
-* - GPR driver removed
-*
-* Revision 1.1.1.1 1996/02/14 13:10:57 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.23/01 08/05/95 11.49.38 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE ISFAIS(INTS)
- ENTRY GSFAIS(INTS)
-#include "higz/hiatt.inc"
-#if defined(CERNLIB_ZEBRA)
-#include "higz/hicode.inc"
-#endif
-#include "higz/hiflag.inc"
- IF(INTS.EQ.IFAIS)RETURN
- IF((INTS.LT.0).OR.(INTS.GT.3))THEN
- CALL IGERR('Fill area interior style must be > -1 and < 4'
- +, 'ISFAIS')
- RETURN
- ENDIF
- IFAIS=INTS
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_MAIL)
- IF(GLFLAG)CALL IZATT(IFAICO)
-#endif
- IF(GFLAG)THEN
-#if defined(CERNLIB_FALCO)
- IF(IWTYPE.EQ.7878.OR.IWTYPE.EQ.7879)RETURN
-#endif
-#if (defined(CERNLIB_GL))&&(!defined(CERNLIB_MSDOS))
- IF(IFAIS.EQ.1)CALL SETPAT(0)
-#endif
-#if (defined(CERNLIB_X11)||defined(CERNLIB_MSDOS))&&(!defined(CERNLIB_NDP))
- DO 10 IWKNB=1,INOPWK
- IF(NODRFL(IWKNB))GOTO 10
- CALL IXSETFS(IFAIS,ABS(IFASI))
- 10 CONTINUE
-#endif
-#if defined(CERNLIB_MACMPW)
- CALL IMSETFS(IFAIS,ABS(IFASI))
-#endif
-#if defined(CERNLIB_PHIGS)
- CALL PSIS(IFAIS)
-#endif
- ENDIF
- END
diff --git a/src/graflib/higz/ikernel/isfasi.F b/src/graflib/higz/ikernel/isfasi.F
deleted file mode 100644
index 4924ec7..0000000
--- a/src/graflib/higz/ikernel/isfasi.F
+++ /dev/null
@@ -1,55 +0,0 @@
-*
-* $Id: isfasi.F,v 1.2 1998/01/28 14:34:52 couet Exp $
-*
-* $Log: isfasi.F,v $
-* Revision 1.2 1998/01/28 14:34:52 couet
-* - GGDM driver removed
-*
-* Revision 1.1.1.1 1996/02/14 13:10:57 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.18/01 05/05/93 14.09.03 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE ISFASI(ISTYL)
- ENTRY GSFASI(ISTYL)
-#if defined(CERNLIB_KERNEL)
-#include "higz/hikern.inc"
-#endif
-#include "higz/hiatt.inc"
-#if defined(CERNLIB_ZEBRA)
-#include "higz/hicode.inc"
-#endif
-#include "higz/hiflag.inc"
- IF(ISTYL.EQ.IFASI)RETURN
- IFASI=ISTYL
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_MAIL)
- IF(GLFLAG)CALL IZATT(IFASCO)
-#endif
- IF(GFLAG)THEN
-#if defined(CERNLIB_FALCO)
- IF(IWTYPE.EQ.7878.OR.IWTYPE.EQ.7879)RETURN
-#endif
-#if defined(CERNLIB_GL)
- DO 10 IWKNB=1,INOPWK
- IF(NODRFL(IWKNB))GOTO 10
- CALL IGSG(IWKNB)
- IF(IFAIS.LE.1)THEN
- CALL SETPAT(0)
- ELSE
- CALL SETPAT(IFASI)
- ENDIF
- 10 CONTINUE
-#endif
-#if defined(CERNLIB_X11)
- CALL IXSETFS(IFAIS,ABS(IFASI))
-#endif
-#if defined(CERNLIB_MACMPW)
- CALL IMSETFS(IFAIS,ABS(IFASI))
-#endif
-#if defined(CERNLIB_PHIGS)
- CALL PSISI(IFASI)
-#endif
- ENDIF
- END
diff --git a/src/graflib/higz/ikernel/isln.F b/src/graflib/higz/ikernel/isln.F
deleted file mode 100644
index 0b52753..0000000
--- a/src/graflib/higz/ikernel/isln.F
+++ /dev/null
@@ -1,77 +0,0 @@
-*
-* $Id: isln.F,v 1.3 1998/01/28 14:34:53 couet Exp $
-*
-* $Log: isln.F,v $
-* Revision 1.3 1998/01/28 14:34:53 couet
-* - GGDM driver removed
-*
-* Revision 1.2 1996/09/25 14:58:57 couet
-* - GPR driver removed
-*
-* Revision 1.1.1.1 1996/02/14 13:10:57 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.20/07 12/01/94 10.01.55 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE ISLN(LTYPE)
- ENTRY GSLN(LTYPE)
-#if defined(CERNLIB_KERNEL)
-#include "higz/hikern.inc"
-#endif
-#if defined(CERNLIB_ZEBRA)
-#include "higz/hicode.inc"
-#endif
-#include "higz/hiatt.inc"
-#include "higz/hiflag.inc"
-#if defined(CERNLIB_X11)
- INTEGER DASHED(2),DOTTED(2),DSHDOT(4)
- DATA DASHED/5,5/
- DATA DOTTED/1,3/
- DATA DSHDOT/5,3,1,3/
-#endif
- IF(LTYPE.EQ.ILN)RETURN
- ILN=LTYPE
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_MAIL)
- IF(GLFLAG)CALL IZATT(ILNCO)
-#endif
- IF(GFLAG)THEN
-#if defined(CERNLIB_PHIGS)
- CALL PSLN(ILN)
-#endif
-#if !defined(CERNLIB_BATCH)
- DO 10 IWKNB=1,INOPWK
- IF(NODRFL(IWKNB))GOTO 10
- CALL IGSG(IWKNB)
-#endif
-#if defined(CERNLIB_FALCO)
- IF(IWTYL(IWKNB).EQ.7878.OR.IWTYL(IWKNB).EQ.7879)THEN
- CALL IGSG(1)
- CALL IFPUT(27)
- IF(ILN.EQ.1)CALL IFPUT(IGASCI('`'))
- IF(ILN.EQ.2)CALL IFPUT(IGASCI('a'))
- IF(ILN.EQ.3)CALL IFPUT(IGASCI('c'))
- IF(ILN.EQ.4)CALL IFPUT(IGASCI('b'))
- IF(ILN.EQ.5)CALL IFPUT(IGASCI('d'))
- CALL IFPUT(0)
- GOTO 10
- ENDIF
-#endif
-#if defined(CERNLIB_GL)
- CALL SETLIN(ILN-1)
-#endif
-#if (defined(CERNLIB_X11))&&(!defined(CERNLIB_WINNT))
- IF(ILN.EQ.1)CALL IXSETLS(0,0)
- IF(ILN.EQ.2)CALL IXSETLS(2,DASHED)
- IF(ILN.EQ.3)CALL IXSETLS(2,DOTTED)
- IF(ILN.EQ.4)CALL IXSETLS(4,DSHDOT)
-#endif
-#if defined(CERNLIB_WINNT)
- CALL IXSETLS(-ILN,0)
-#endif
-#if !defined(CERNLIB_BATCH)
- 10 CONTINUE
-#endif
- ENDIF
- END
diff --git a/src/graflib/higz/ikernel/islwsc.F b/src/graflib/higz/ikernel/islwsc.F
deleted file mode 100644
index 1f0264e..0000000
--- a/src/graflib/higz/ikernel/islwsc.F
+++ /dev/null
@@ -1,58 +0,0 @@
-*
-* $Id: islwsc.F,v 1.3 1998/01/28 14:34:54 couet Exp $
-*
-* $Log: islwsc.F,v $
-* Revision 1.3 1998/01/28 14:34:54 couet
-* - GGDM driver removed
-*
-* Revision 1.2 1996/09/25 14:58:58 couet
-* - GPR driver removed
-*
-* Revision 1.1.1.1 1996/02/14 13:10:57 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.20/07 12/01/94 10.04.13 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE ISLWSC(WIDTH)
- ENTRY GSLWSC(WIDTH)
-#if defined(CERNLIB_KERNEL)
-#include "higz/hikern.inc"
-#endif
-#include "higz/hiatt.inc"
-#if defined(CERNLIB_ZEBRA)
-#include "higz/hicode.inc"
-#endif
-#include "higz/hiflag.inc"
- IF(WIDTH.EQ.RLWSC)RETURN
- RLWSC=WIDTH
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_MAIL)
- IF(GLFLAG)CALL IZATT(ILWSCO)
-#endif
- IF(GFLAG)THEN
-#if defined(CERNLIB_PHIGS)
- CALL PSLWSC(RLWSC)
-#endif
-#if !defined(CERNLIB_BATCH)
- DO 10 IWKNB=1,INOPWK
- IF(NODRFL(IWKNB))GOTO 10
- CALL IGSG(IWKNB)
-#endif
-#if defined(CERNLIB_FALCO)
- IF(IWTYL(IWKNB).EQ.7878.OR.IWTYL(IWKNB).EQ.7879)GOTO 10
-#endif
-#if defined(CERNLIB_GL)
- CALL LINEWI(INT(RLWSC))
-#endif
-#if defined(CERNLIB_X11)
- CALL IXSETLN(MAX(INT(RLWSC/2.2),1))
-#endif
-#if defined(CERNLIB_MACMPW)
- CALL IMSETLN(INT(RLWSC))
-#endif
-#if !defined(CERNLIB_BATCH)
- 10 CONTINUE
-#endif
- ENDIF
- END
diff --git a/src/graflib/higz/ikernel/ismk.F b/src/graflib/higz/ikernel/ismk.F
deleted file mode 100644
index 906e8d5..0000000
--- a/src/graflib/higz/ikernel/ismk.F
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: ismk.F,v 1.2 1998/01/28 14:34:55 couet Exp $
-*
-* $Log: ismk.F,v $
-* Revision 1.2 1998/01/28 14:34:55 couet
-* - GGDM driver removed
-*
-* Revision 1.1.1.1 1996/02/14 13:10:57 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.18/01 05/05/93 14.09.03 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE ISMK(MTYPE)
- ENTRY GSMK(MTYPE)
-#include "higz/hiatt.inc"
-#if defined(CERNLIB_ZEBRA)
-#include "higz/hicode.inc"
-#endif
-#include "higz/hiflag.inc"
- IF(MTYPE.EQ.IMK)RETURN
- IMK=MTYPE
-#if !defined(CERNLIB_X11)
- IF(IMK.EQ.3)IMK=31
-#endif
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_MAIL)
- IF(GLFLAG)CALL IZATT(IMKCO)
-#endif
-#if defined(CERNLIB_PHIGS)
- CALL PSMK(MTYPE)
-#endif
- END
diff --git a/src/graflib/higz/ikernel/ismksc.F b/src/graflib/higz/ikernel/ismksc.F
deleted file mode 100644
index 0ec5412..0000000
--- a/src/graflib/higz/ikernel/ismksc.F
+++ /dev/null
@@ -1,30 +0,0 @@
-*
-* $Id: ismksc.F,v 1.2 1998/01/28 14:34:56 couet Exp $
-*
-* $Log: ismksc.F,v $
-* Revision 1.2 1998/01/28 14:34:56 couet
-* - GGDM driver removed
-*
-* Revision 1.1.1.1 1996/02/14 13:10:57 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.18/01 05/05/93 14.09.03 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE ISMKSC(RMSCF)
- ENTRY GSMKSC(RMSCF)
-#include "higz/hiatt.inc"
-#if defined(CERNLIB_ZEBRA)
-#include "higz/hicode.inc"
-#endif
-#include "higz/hiflag.inc"
- IF(RMSCF.EQ.RMKSC)RETURN
- RMKSC=RMSCF
-#if defined(CERNLIB_PHIGS)
- CALL PSMKSC(RMKSC)
-#endif
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_MAIL)
- IF(GLFLAG)CALL IZATT(IMKSCO)
-#endif
- END
diff --git a/src/graflib/higz/ikernel/isplci.F b/src/graflib/higz/ikernel/isplci.F
deleted file mode 100644
index 928b41f..0000000
--- a/src/graflib/higz/ikernel/isplci.F
+++ /dev/null
@@ -1,59 +0,0 @@
-*
-* $Id: isplci.F,v 1.3 1998/01/28 14:34:57 couet Exp $
-*
-* $Log: isplci.F,v $
-* Revision 1.3 1998/01/28 14:34:57 couet
-* - GGDM driver removed
-*
-* Revision 1.2 1996/09/25 14:58:59 couet
-* - GPR driver removed
-*
-* Revision 1.1.1.1 1996/02/14 13:10:57 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.20/07 12/01/94 10.05.05 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE ISPLCI(ICOLI)
- ENTRY GSPLCI(ICOLI)
-#if defined(CERNLIB_KERNEL)
-#include "higz/hikern.inc"
-#endif
-#include "higz/hiatt.inc"
-#if defined(CERNLIB_ZEBRA)
-#include "higz/hicode.inc"
-#endif
-#include "higz/hiflag.inc"
- IF(ICOLI.EQ.IPLCI)RETURN
- IPLCI=ICOLI
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_MAIL)
- IF(GLFLAG)CALL IZATT(IPLCCO)
-#endif
- IF(GFLAG)THEN
-#if defined(CERNLIB_PHIGS)
- CALL PSPLCI(IPLCI)
-#endif
-#if defined(CERNLIB_KERNEL)||defined(CERNLIB_FALCO)
- DO 10 IWKNB=1,INOPWK
- IF(NODRFL(IWKNB))GOTO 10
- CALL IGSG(IWKNB)
-#endif
-#if defined(CERNLIB_FALCO)
- IF(IWTYL(IWKNB).EQ.7878.OR.IWTYL(IWKNB).EQ.7879)GOTO 10
-#endif
-#if defined(CERNLIB_GL)
- CALL COLOR(IPLCI+IOFCOL)
- ICURCI(IWKNB)=IPLCI
-#endif
-#if defined(CERNLIB_X11)
- CALL IXSETLC(IPLCI)
-#endif
-#if defined(CERNLIB_MACMPW)
- CALL IMSETLC(IPLCI)
-#endif
-#if defined(CERNLIB_KERNEL)||defined(CERNLIB_FALCO)
- 10 CONTINUE
-#endif
- ENDIF
- END
diff --git a/src/graflib/higz/ikernel/ispmci.F b/src/graflib/higz/ikernel/ispmci.F
deleted file mode 100644
index ec375b9..0000000
--- a/src/graflib/higz/ikernel/ispmci.F
+++ /dev/null
@@ -1,59 +0,0 @@
-*
-* $Id: ispmci.F,v 1.3 1998/01/28 14:34:57 couet Exp $
-*
-* $Log: ispmci.F,v $
-* Revision 1.3 1998/01/28 14:34:57 couet
-* - GGDM driver removed
-*
-* Revision 1.2 1996/09/25 14:59:00 couet
-* - GPR driver removed
-*
-* Revision 1.1.1.1 1996/02/14 13:10:58 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.20/07 12/01/94 10.05.45 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE ISPMCI(ICOLI)
- ENTRY GSPMCI(ICOLI)
-#if defined(CERNLIB_KERNEL)
-#include "higz/hikern.inc"
-#endif
-#include "higz/hiatt.inc"
-#if defined(CERNLIB_ZEBRA)
-#include "higz/hicode.inc"
-#endif
-#include "higz/hiflag.inc"
- IF(ICOLI.EQ.IPMCI)RETURN
- IPMCI=ICOLI
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_MAIL)
- IF(GLFLAG)CALL IZATT(IPMCCO)
-#endif
- IF(GFLAG)THEN
-#if defined(CERNLIB_PHIGS)
- CALL PSPMCI(IPMCI)
-#endif
-#if defined(CERNLIB_KERNEL)||defined(CERNLIB_FALCO)
- DO 10 IWKNB=1,INOPWK
- IF(NODRFL(IWKNB))GOTO 10
- CALL IGSG(IWKNB)
-#endif
-#if defined(CERNLIB_FALCO)
- IF(IWTYL(IWKNB).EQ.7878.OR.IWTYL(IWKNB).EQ.7879)GOTO 10
-#endif
-#if defined(CERNLIB_GL)
- CALL COLOR(IPMCI+IOFCOL)
- ICURCI(IWKNB)=IPMCI
-#endif
-#if defined(CERNLIB_X11)
- CALL IXSETMC(IPMCI)
-#endif
-#if defined(CERNLIB_MACMPW)
- CALL IMSETMC(IPMCI)
-#endif
-#if defined(CERNLIB_KERNEL)||defined(CERNLIB_FALCO)
- 10 CONTINUE
-#endif
- ENDIF
- END
diff --git a/src/graflib/higz/ikernel/istxal.F b/src/graflib/higz/ikernel/istxal.F
deleted file mode 100644
index 4771a56..0000000
--- a/src/graflib/higz/ikernel/istxal.F
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: istxal.F,v 1.1.1.1 1996/02/14 13:10:58 mclareni Exp $
-*
-* $Log: istxal.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:58 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.23/03 05/09/95 15.03.12 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE ISTXAL(JTXALH,JTXALV)
- ENTRY GSTXAL(JTXALH,JTXALV)
-#include "higz/hiatt.inc"
-#if defined(CERNLIB_ZEBRA)
-#include "higz/hicode.inc"
-#endif
-#include "higz/hiflag.inc"
- IF((JTXALH.EQ.ITXALH).AND.(JTXALV.EQ.ITXALV))RETURN
- ITXALH=JTXALH
- ITXALV=JTXALV
- ITXALG=10*JTXALH+JTXALV
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_MAIL)
- IF(GLFLAG)CALL IZATT(ITXACO)
-#endif
- IF(GFLAG)THEN
-#if defined(CERNLIB_FALCO)
- IF(IWTYPE.EQ.7878.OR.IWTYPE.EQ.7879)RETURN
-#endif
-#if defined(CERNLIB_X11)
- CALL IXSETTA(ITXALH,ITXALV)
-#endif
- ENDIF
- END
diff --git a/src/graflib/higz/ikernel/istxci.F b/src/graflib/higz/ikernel/istxci.F
deleted file mode 100644
index 93ebca3..0000000
--- a/src/graflib/higz/ikernel/istxci.F
+++ /dev/null
@@ -1,56 +0,0 @@
-*
-* $Id: istxci.F,v 1.3 1998/01/28 14:34:58 couet Exp $
-*
-* $Log: istxci.F,v $
-* Revision 1.3 1998/01/28 14:34:58 couet
-* - GGDM driver removed
-*
-* Revision 1.2 1996/09/25 14:59:01 couet
-* - GPR driver removed
-*
-* Revision 1.1.1.1 1996/02/14 13:10:58 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.20/07 12/01/94 10.06.24 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE ISTXCI(ICOLI)
- ENTRY GSTXCI(ICOLI)
-#if defined(CERNLIB_KERNEL)
-#include "higz/hikern.inc"
-#endif
-#include "higz/hiatt.inc"
-#if defined(CERNLIB_ZEBRA)
-#include "higz/hicode.inc"
-#endif
-#include "higz/hiflag.inc"
- IF(ICOLI.EQ.ITXCI)RETURN
- ITXCI=ICOLI
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_MAIL)
- IF(GLFLAG)CALL IZATT(ITXCCO)
-#endif
- IF(GFLAG)THEN
-#if defined(CERNLIB_PHIGS)
- CALL PSTXCI(ITXCI)
-#endif
-#if defined(CERNLIB_KERNEL)||defined(CERNLIB_FALCO)
- DO 10 IWKNB=1,INOPWK
- IF(NODRFL(IWKNB))GOTO 10
- CALL IGSG(IWKNB)
-#endif
-#if defined(CERNLIB_FALCO)
- IF(IWTYL(IWKNB).EQ.7878.OR.IWTYL(IWKNB).EQ.7879)GOTO 10
-#endif
-#if defined(CERNLIB_GL)
- CALL COLOR(ITXCI+IOFCOL)
- ICURCI(IWKNB)=ITXCI
-#endif
-#if defined(CERNLIB_X11)
- CALL IXSETTC(ITXCI)
-#endif
-#if defined(CERNLIB_KERNEL)||defined(CERNLIB_FALCO)
- 10 CONTINUE
-#endif
- ENDIF
- END
diff --git a/src/graflib/higz/ikernel/istxfp.F b/src/graflib/higz/ikernel/istxfp.F
deleted file mode 100644
index 7e7021f..0000000
--- a/src/graflib/higz/ikernel/istxfp.F
+++ /dev/null
@@ -1,63 +0,0 @@
-*
-* $Id: istxfp.F,v 1.2 1996/09/25 14:59:02 couet Exp $
-*
-* $Log: istxfp.F,v $
-* Revision 1.2 1996/09/25 14:59:02 couet
-* - GPR driver removed
-*
-* Revision 1.1.1.1 1996/02/14 13:10:58 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.20/09 26/01/94 09.10.03 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE ISTXFP(JFONT,JPREC)
- ENTRY GSTXFP(JFONT,JPREC)
-#if defined(CERNLIB_KERNEL)
-#include "higz/hikern.inc"
-#endif
-#include "higz/hiatt.inc"
-#if defined(CERNLIB_ZEBRA)
-#include "higz/hicode.inc"
-#endif
-#include "higz/hiflag.inc"
-*
- IF((JFONT.EQ.IFONT).AND.(JPREC.EQ.IPREC))RETURN
- IFONT=JFONT
- IPREC=JPREC
-#if defined(CERNLIB_MACMPW)
- IF(.NOT.((IFONT.EQ.0.AND.IPREC.EQ.2).OR.
- + (IFONT.LT.0.AND.IFONT.GT.-25.AND.IPREC.EQ.1)))THEN
- IFONT=0
- IPREC=2
- ENDIF
-#endif
- IFTPR=10*JFONT+ISIGN(1,JFONT)*JPREC
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_MAIL)
- IF(GLFLAG)CALL IZATT(ITXFCO)
-#endif
- IF(IPREC.EQ.2)RETURN
- IF(GFLAG)THEN
-#if defined(CERNLIB_FALCO)
- IF(IWTYPE.EQ.7878.OR.IWTYPE.EQ.7879)THEN
- IF(IFONT.LT.0.AND.IFONT.GT.-25.AND.IPREC.EQ.1)RETURN
- IFONT=0
- IPREC=2
- RETURN
- ENDIF
-#endif
-#if defined(CERNLIB_PHIGS)
- CALL PSTXPR(JPREC)
- CALL PSTXFN(JFONT)
-#endif
-#if !defined(CERNLIB_BATCH)
- DO 10 IWKNB=1,INOPWK
- IF(NODRFL(IWKNB))GOTO 10
- CALL IGSG(IWKNB)
-#endif
-#if !defined(CERNLIB_BATCH)
- 10 CONTINUE
-#endif
- ENDIF
- END
diff --git a/src/graflib/higz/ikernel/isvp.F b/src/graflib/higz/ikernel/isvp.F
deleted file mode 100644
index eca4cbe..0000000
--- a/src/graflib/higz/ikernel/isvp.F
+++ /dev/null
@@ -1,78 +0,0 @@
-*
-* $Id: isvp.F,v 1.1.1.1 1996/02/14 13:10:58 mclareni Exp $
-*
-* $Log: isvp.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:58 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.22/03 06/01/95 11.27.19 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE ISVP(NT,X1,X2,Y1,Y2)
- ENTRY GSVP(NT,X1,X2,Y1,Y2)
-#if (!defined(CERNLIB_NTC))&&(!defined(CERNLIB_X11))
-#include "higz/hint.inc"
-#endif
-#include "higz/hiflag.inc"
-#include "higz/hiatt.inc"
- IF((X1.LT.0).OR.(X1.GT.1)
- + .OR.
- + (X2.LT.0).OR.(X2.GT.1)
- + .OR.
- + (Y1.LT.0).OR.(Y1.GT.1)
- + .OR.
- + (Y2.LT.0).OR.(Y2.GT.1)
- + .OR.
- + (Y1.GE.Y2).OR.(X1.GE.X2))THEN
- CALL IGERR('Invalid viewport definition','ISVP')
- RETURN
- ENDIF
- IF(NT.EQ.0)RETURN
-#if (!defined(CERNLIB_NTC))&&(!defined(CERNLIB_X11))
- CALL IZGNT(NT,IFIND,IAWV,IPRIO,IHPRIO)
-*
- IF(IFIND.NE.0)THEN
- IF((INTR.EQ.NT).AND.GFLAG)THEN
- RVXMIN=X1
- RVYMIN=Y1
- RVXMAX=X2
- RVYMAX=Y2
- ENDIF
- WNVPST(IAWV+4)=X1
- WNVPST(IAWV+5)=X2
- WNVPST(IAWV+6)=Y1
- WNVPST(IAWV+7)=Y2
-*
- ELSE
- NBNT=NTSTOR(1)
- IF(NBNT+1.GT.NBNTMX)THEN
- CALL IGERR('Too many normalisation transformation','ISVP')
- RETURN
- ENDIF
- NTSTOR(2*NBNT+2)=NT
- WNVPST(8*NBNT+1)=0.
- WNVPST(8*NBNT+2)=1.
- WNVPST(8*NBNT+3)=0.
- WNVPST(8*NBNT+4)=1.
- WNVPST(8*NBNT+5)=X1
- WNVPST(8*NBNT+6)=X2
- WNVPST(8*NBNT+7)=Y1
- WNVPST(8*NBNT+8)=Y2
- NTSTOR(1)=NTSTOR(1)+1
- ENDIF
-#endif
-#if defined(CERNLIB_NTC)||defined(CERNLIB_X11)
- IF(IGNSCU(NT).NE.0)THEN
- IF((INTR.EQ.NT).AND.GFLAG)THEN
- RVXMIN=X1
- RVYMIN=Y1
- RVXMAX=X2
- RVYMAX=Y2
- ENDIF
- ELSE
- CALL IGNCRE(NT)
- ENDIF
- CALL IGNSVP(X1,X2,Y1,Y2)
-#endif
- END
diff --git a/src/graflib/higz/ikernel/iswkvp.F b/src/graflib/higz/ikernel/iswkvp.F
deleted file mode 100644
index c2c4025..0000000
--- a/src/graflib/higz/ikernel/iswkvp.F
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: iswkvp.F,v 1.1.1.1 1996/02/14 13:10:58 mclareni Exp $
-*
-* $Log: iswkvp.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:58 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.23/02 29/08/95 14.29.43 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE ISWKVP(IWKID,X1,X2,Y1,Y2)
- ENTRY GSWKVP(IWKID,X1,X2,Y1,Y2)
-#include "higz/hiatt.inc"
- I=IGIWIN(IWKID)
- IF(I.LE.0)THEN
- CALL IGERR('Invalid workstation window parameters','ISWKVP')
- RETURN
- ENDIF
- RDVXMI = X1
- RDVXMA = X2
- RDVYMI = Y1
- RDVYMA = Y2
- XWKV1(I) = X1
- XWKV2(I) = X2
- YWKV1(I) = Y1
- YWKV2(I) = Y2
-#if defined(CERNLIB_PHIGS)
- CALL PSWKV(IWKID,X1,X2,Y1,Y2)
-#endif
- END
diff --git a/src/graflib/higz/ikernel/iswkwn.F b/src/graflib/higz/ikernel/iswkwn.F
deleted file mode 100644
index 92473cb..0000000
--- a/src/graflib/higz/ikernel/iswkwn.F
+++ /dev/null
@@ -1,37 +0,0 @@
-*
-* $Id: iswkwn.F,v 1.1.1.1 1996/02/14 13:10:58 mclareni Exp $
-*
-* $Log: iswkwn.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:58 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.14/11 24/06/92 12.46.29 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE ISWKWN(IWKID,X1,X2,Y1,Y2)
- ENTRY GSWKWN(IWKID,X1,X2,Y1,Y2)
-#include "higz/hiatt.inc"
- I=IGIWIN(IWKID)
- IF((X1.LT.0).OR.(X1.GT.1)
- + .OR.
- + (X2.LT.0).OR.(X2.GT.1)
- + .OR.
- + (Y1.LT.0).OR.(Y1.GT.1)
- + .OR.
- + (Y2.LT.0).OR.(Y2.GT.1).OR.(I.LE.0))THEN
- CALL IGERR('Invalid workstation window parameters','ISWKWN')
- RETURN
- ENDIF
- RDWXMI = X1
- RDWXMA = X2
- RDWYMI = Y1
- RDWYMA = Y2
- XWKW1(I) = X1
- XWKW2(I) = X2
- YWKW1(I) = Y1
- YWKW2(I) = Y2
-#if defined(CERNLIB_PHIGS)
- CALL PSWKW(IWKID,X1,X2,Y1,Y2)
-#endif
- END
diff --git a/src/graflib/higz/ikernel/iswn.F b/src/graflib/higz/ikernel/iswn.F
deleted file mode 100644
index 5432978..0000000
--- a/src/graflib/higz/ikernel/iswn.F
+++ /dev/null
@@ -1,72 +0,0 @@
-*
-* $Id: iswn.F,v 1.1.1.1 1996/02/14 13:10:59 mclareni Exp $
-*
-* $Log: iswn.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:59 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.18/00 28/04/93 10.53.48 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE ISWN(NT,X1,X2,Y1,Y2)
- ENTRY GSWN(NT,X1,X2,Y1,Y2)
-#if (!defined(CERNLIB_NTC))&&(!defined(CERNLIB_X11))
-#include "higz/hint.inc"
-#endif
-#include "higz/hiflag.inc"
-#include "higz/hiatt.inc"
- IF(NT.EQ.0)RETURN
-*
- IF(X1.GE.X2.OR.Y1.GE.Y2)THEN
- CALL IGERR('Bad window range','ISWN')
- RETURN
- ENDIF
-*
-#if (!defined(CERNLIB_NTC))&&(!defined(CERNLIB_X11))
- CALL IZGNT(NT,IFIND,IAWV,IPRIO,IHPRIO)
-*
- IF(IFIND.NE.0)THEN
- IF((INTR.EQ.NT).AND.GFLAG)THEN
- RWXMIN=X1
- RWYMIN=Y1
- RWXMAX=X2
- RWYMAX=Y2
- ENDIF
- WNVPST(IAWV) =X1
- WNVPST(IAWV+1)=X2
- WNVPST(IAWV+2)=Y1
- WNVPST(IAWV+3)=Y2
-*
- ELSE
- NBNT=NTSTOR(1)
- IF(NBNT+1.GT.NBNTMX)THEN
- CALL IGERR('Too many normalisation transformation','ISWN')
- RETURN
- ENDIF
- NTSTOR(2*NBNT+2)=NT
- WNVPST(8*NBNT+1)=X1
- WNVPST(8*NBNT+2)=X2
- WNVPST(8*NBNT+3)=Y1
- WNVPST(8*NBNT+4)=Y2
- WNVPST(8*NBNT+5)=0.
- WNVPST(8*NBNT+6)=1.
- WNVPST(8*NBNT+7)=0.
- WNVPST(8*NBNT+8)=1.
- NTSTOR(1)=NTSTOR(1)+1
- ENDIF
-#endif
-#if defined(CERNLIB_NTC)||defined(CERNLIB_X11)
- IF(IGNSCU(NT).NE.0)THEN
- IF((INTR.EQ.NT).AND.GFLAG)THEN
- RWXMIN=X1
- RWYMIN=Y1
- RWXMAX=X2
- RWYMAX=Y2
- ENDIF
- ELSE
- CALL IGNCRE(NT)
- ENDIF
- CALL IGNSWN(X1,X2,Y1,Y2)
-#endif
- END
diff --git a/src/graflib/higz/ikernel/itx.F b/src/graflib/higz/ikernel/itx.F
deleted file mode 100644
index f61df45..0000000
--- a/src/graflib/higz/ikernel/itx.F
+++ /dev/null
@@ -1,107 +0,0 @@
-*
-* $Id: itx.F,v 1.3 1998/01/28 14:34:59 couet Exp $
-*
-* $Log: itx.F,v $
-* Revision 1.3 1998/01/28 14:34:59 couet
-* - GGDM driver removed
-*
-* Revision 1.2 1996/09/25 14:59:03 couet
-* - GPR driver removed
-*
-* Revision 1.1.1.1 1996/02/14 13:10:59 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.20/03 19/11/93 13.52.59 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE ITX(X,Y,CHARS)
- ENTRY GTX(X,Y,CHARS)
-#if defined(CERNLIB_KERNEL)
-#include "higz/hikern.inc"
-#endif
-#include "higz/hiflag.inc"
-#include "higz/hiatt.inc"
- CHARACTER*(*) CHARS
- CHARACTER*1 CHOPT
- LOGICAL ZFSAV,PFSAV
-*
-#if defined(CERNLIB_KERNEL)
-#include "higz/hiwcdc.inc"
-#endif
- ILEN = LENOCC(CHARS)
- IF(ILEN.EQ.0)RETURN
- IF((IFONT.EQ.0.AND.IPREC.EQ.2).OR.
- + (IFONT.LT.0.AND.IFONT.GT.-25.AND.IPREC.EQ.1))THEN
- IF((ITXALH.EQ.0).OR.(ITXALH.EQ.1))CHOPT='L'
- IF(ITXALH.EQ.2)THEN
- CHOPT = 'C'
- ELSEIF(ITXALH.EQ.3)THEN
- CHOPT = 'R'
- ELSE
- CHOPT = 'L'
- ENDIF
- IF((ITXALV.EQ.2).OR.(ITXALV.EQ.1))THEN
- YY = Y-RCHH*COS((3.14159/180.)*RANGLE)
- XX = X+RCHH*SIN((3.14159/180.)*RANGLE)
- ELSEIF(ITXALV.EQ.3)THEN
- YY = Y-(RCHH/2.)*COS((3.14159/180.)*RANGLE)
- XX = X+(RCHH/2.)*SIN((3.14159/180.)*RANGLE)
- ELSE
- YY = Y
- XX = X
- ENDIF
- ZFSAV = ZFLAG
- ZFLAG = .FALSE.
- PFSAV = PFLAG
- PFLAG = .FALSE.
- GLFLAG = (ZFLAG.OR.PFLAG.OR.MFLAG)
- CALL IGTEXT(XX,YY,CHARS,RCHH,RANGLE,CHOPT)
- ZFLAG = ZFSAV
- PFLAG = PFSAV
- GLFLAG = (ZFLAG.OR.PFLAG.OR.MFLAG)
- ELSE
- IF(GFLAG)THEN
-#if defined(CERNLIB_PHIGS)
- CALL PTX(X,Y,CHARS)
-#endif
-#if defined(CERNLIB_KERNEL)||defined(CERNLIB_FALCO)
- IF(ITXALH.EQ.0)ITXALH=1
- DO 10 IWKNB=1,INOPWK
- IF(NODRFL(IWKNB))GOTO 10
- CALL IGSG(IWKNB)
-#endif
-#if defined(CERNLIB_FALCO)
- IF(IWTYL(IWKNB).EQ.7878.OR.IWTYL(IWKNB).EQ.7879)GOTO 10
-#endif
-#if defined(CERNLIB_GL)||defined(CERNLIB_MSDOS)
- CALL COLOR(ITXCI+IOFCOL)
- ICURCI(IWKNB)=ITXCI
- ITXW2=STRWID(CHARS,ILEN)/2
- IXX=IXWCDC(X)-(ITXALH-1)*ITXW2
- IYY=IYWCDC(Y)
-#endif
-#if (defined(CERNLIB_GL))&&(!defined(CERNLIB_MSDOS))
- CALL CMOV2I(IXX,IYY)
- CALL CHARST(CHARS,ILEN)
-#endif
-#if defined(CERNLIB_MSDOS)
- CALL OUT_TEXT(CHARS(1:ILEN),IXX,IYY,ITXCI+IOFCOL)
-#endif
-#if defined(CERNLIB_X11)
- CALL IXSETTA(ITXALH,ITXALV)
- IXX=IXWCDC(X)
- IYY=IYWCDC(Y)
- IF(IKFNTX(IWKNB).EQ.0)THEN
- CALL IXTEXT(0,IXX,IYY,RANGLE,RMAGN,ILEN,CHARS(1:ILEN))
- ENDIF
-#endif
-#if defined(CERNLIB_KERNEL)||defined(CERNLIB_FALCO)
- 10 CONTINUE
-#endif
- ENDIF
- ENDIF
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_PSCRIPT)||defined(CERNLIB_MAIL)
- IF(GLFLAG)CALL IZTX(X,Y,CHARS(1:ILEN))
-#endif
- END
diff --git a/src/graflib/higz/ikernel/iuwk.F b/src/graflib/higz/ikernel/iuwk.F
deleted file mode 100644
index 5fdcd4f..0000000
--- a/src/graflib/higz/ikernel/iuwk.F
+++ /dev/null
@@ -1,94 +0,0 @@
-*
-* $Id: iuwk.F,v 1.1.1.1 1996/02/14 13:10:59 mclareni Exp $
-*
-* $Log: iuwk.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:59 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.23/06 04/12/95 15.28.25 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE IUWK(IWKID,IRFLG)
- ENTRY GUWK(IWKID,IRFLG)
-#include "higz/hiatt.inc"
-#include "higz/hiflag.inc"
-#if defined(CERNLIB_ZBUF)
-#include "higz/hiwcdc.inc"
-#endif
-#if defined(CERNLIB_PHIGS)
- CALL PXCLOSE_PIPE
-#endif
-#if (defined(CERNLIB_X11))&&(defined(CERNLIB_ZBUF))
- CALL IGNG3D(W3X1,W3X2,W3Y1,W3Y2,W3Z1,W3Z2
- +, PHI,THETA,PSI
- +, V3X1,V3X2,V3Y1,V3Y2)
-#endif
- IF(IWKID.NE.0)THEN
- ITY=IGIWTY(IWKID)
- IF(ITY.GT.0.AND.GRFLAG)THEN
-#if defined(CERNLIB_FALCO)
- IF(ITY.EQ.7878.OR.ITY.EQ.7879)RETURN
-#endif
-#if (defined(CERNLIB_GL))&&(defined(CERNLIB_SGI))
- CALL GFLUSH
-#endif
-#if (defined(CERNLIB_X11))&&(defined(CERNLIB_ZBUF))
- IF (IZBUF.NE.0) THEN
- IWKNB=1
- IZX = IXWCDC(V3X1)
- IZY = IYWCDC(V3Y2)
- CALL IHZTOX(0,IZX,IZY)
- ENDIF
-#endif
-#if defined(CERNLIB_X11)
- CALL IXSELWI(IWINID(IGIWIN(IWKID)))
- CALL IXUPDWI(1)
- CALL IKUWK(IWKID)
-#endif
-#if defined(CERNLIB_MACMPW)
- CALL IMUPDWI
-#endif
-#if defined(CERNLIB_PHIGS)
- CALL PXOPEN_PIPE(IWKID)
-#endif
-#if defined(CERNLIB_MSDOS)
- CALL IMFUWK(ITY)
-#endif
- ENDIF
- ELSE
- DO 10 I=1,INOPWK
- ITY=IGIWTY(ILOPWK(I))
- IF(ITY.GT.0.AND.ACWKFL(I))THEN
-#if defined(CERNLIB_FALCO)
- IF(ITY.EQ.7878.OR.ITY.EQ.7879)GOTO 10
-#endif
-#if (defined(CERNLIB_GL))&&(defined(CERNLIB_SGI))
- CALL GFLUSH
-#endif
-#if (defined(CERNLIB_X11))&&(defined(CERNLIB_ZBUF))
- IF (IZBUF.NE.0) THEN
- IWKNB=I
- IZX = IXWCDC(V3X1)
- IZY = IYWCDC(V3Y2)
- CALL IHZTOX(0,IZX,IZY)
- ENDIF
-#endif
-#if defined(CERNLIB_X11)
- CALL IXSELWI(IWINID(I))
- CALL IXUPDWI(1)
- CALL IKUWK(ILOPWK(I))
-#endif
-#if defined(CERNLIB_MACMPW)
- CALL IMUPDWI
-#endif
-#if defined(CERNLIB_PHIGS)
- CALL PXOPEN_PIPE(ILOPWK(I))
-#endif
-#if defined(CERNLIB_MSDOS)
- CALL IMFUWK(ITY)
-#endif
- ENDIF
- 10 CONTINUE
- ENDIF
- END
diff --git a/src/graflib/higz/imac/Imakefile b/src/graflib/higz/imac/Imakefile
deleted file mode 100644
index d201ae3..0000000
--- a/src/graflib/higz/imac/Imakefile
+++ /dev/null
@@ -1,6 +0,0 @@
-SRCS_F= f_doback.F f_readwi.F imacplo.F imclip.F imclrwi.F \ @@\
- imclsds.F imclswi.F imdrmde.F imflare.F imgetge.F imline.F \ @@\
- imnocli.F imopnwi.F imreqlo.F imsetco.F imsetln.F imsetms.F \ @@\
- imupdwi.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/graflib/higz/imac/f_doback.F b/src/graflib/higz/imac/f_doback.F
deleted file mode 100644
index f0a2229..0000000
--- a/src/graflib/higz/imac/f_doback.F
+++ /dev/null
@@ -1,39 +0,0 @@
-*
-* $Id: f_doback.F,v 1.1.1.1 1996/02/14 13:10:59 mclareni Exp $
-*
-* $Log: f_doback.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:59 mclareni
-* Higz
-*
-*
-#if defined(CERNLIB_MACMPW)
-#include "higz/pilot.h"
-*CMZ : 1.23/06 01/11/95 14.04.54 by O.Couet
-*-- Author : Cees de Laat
-!!IFC NOT LSPOWERF
-!!mp 68kinlines
-!!ELSEC
-!!mp PPCinlines
-!!ENDC
- subroutine F_DoBackground
-!!SETC USINGINCLUDES = .FALSE.
-!!T72-
- include 'Events.f'
- record /EventRecord/TheEvent
- logical*4 F_BACKEVENT
- external F_BACKEVENT
- logical jev
- integer*2 mask
- integer*4 mySleep
-c
- mask=everyEvent-keyDownMask
- mySleep=0
-100 if(WaitNextEvent(mask,%ref(TheEvent),mySleep,nil))then
- call F_ReadWindowEvent(TheEvent)
- if(TheEvent.what.ne.0)jev=F_BACKEVENT(%ref(TheEvent))
- goto 100
- endif
-c
- return
- end
-#endif
diff --git a/src/graflib/higz/imac/f_readwi.F b/src/graflib/higz/imac/f_readwi.F
deleted file mode 100644
index 6b4f89f..0000000
--- a/src/graflib/higz/imac/f_readwi.F
+++ /dev/null
@@ -1,173 +0,0 @@
-*
-* $Id: f_readwi.F,v 1.1.1.1 1996/02/14 13:10:59 mclareni Exp $
-*
-* $Log: f_readwi.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:59 mclareni
-* Higz
-*
-*
-#if defined(CERNLIB_MACMPW)
-#include "higz/pilot.h"
-*CMZ : 1.23/06 01/11/95 14.04.54 by O.Couet
-*-- Author : Cees de Laat
-!!IFC NOT LSPOWERF
-!!mp 68kinlines
-!!ELSEC
-!!mp PPCinlines
-!!ENDC
- SUBROUTINE F_ReadWindowEvent(TheEvent)
-c+
-c SUBROUTINE F_ReadWindowEvent(TheEvent)
-c
-c Someone else requested something similar to your event handling and we have
-c an undocumented call that is described below. Although I will put your entire
-c commentary on events into the suggestions list so that the programmers can
-c ponder your ideas.
-c If you write a subroutine:
-c SUBROUTINE F_ReadWindowEvent(TheEvent)
-c
-c and put it in your link ahead of FORTRANlib, you will get a chance to see and
-c steal every event that comes through during a READ from the output window. If
-c you handle the event you should set the .what field to 0 so the FORTRAN
-c runtime code won't try to handle the event again.
-c-
-!!SETC USINGINCLUDES = .FALSE.
-!!T72-
- include 'types.f'
- include 'Windows.f'
- include 'Events.f'
- include 'QDOffscreen.f'
- include 'Quickdraw.f'
- include 'globals.f'
-c
- integer OutputWindow
- external OutputWindow
-c
- record /EventRecord/ TheEvent
- record /WindowPtr/ wptr
- record /GWorldptr/ oldGWorld
- record /GDHandle/ oldGDHandle
- record /CWindowPtr/ myCWindow
- record /GWorldptr/ myGWorld
- record /GDHandle/ mywGDHandle,mygGDHandle
- record /RGBcolor/ colorblack,colorwhite
- record /PixMapHandle/ myPixMapHandle
- record /grafport/ myGport
-c record /TEHandle/ myTEHandle
- logical jclgra,jfrmst,jmouse
- common /mpwevt/jclgra,jfrmst,jmouse,ixcur,iycur,
- # myCWindow,myGWorld,mywGDHandle,mygGDHandle,colorblack,
- # colorwhite,myGport
- integer*2 WindowPart
- logical jdone,jevdon,jlocal
- save
- data jdone/.false./
-c
- if(.not.jdone)then
- call F_AboutString(
- # ' Program and libraries',
- # ' written by',
- # ' C.Th. de Laat',
- # 'Physics department, Utrecht University',
- # ' (all rights reserved 1988 - 1995)')
- call F_GetOutWindowSize(il,it,ir,ib)
- call MoveOutWindow(10,it,542,ib)
- call OutWindowScroll(9999)
- jdone=.true.
- jfrmst=.true.
- endif
- jevdon=.false.
-c
- if(TheEvent.what.eq.nullEvent)then
- elseif(TheEvent.what.eq.mouseDown)then
- WindowPart = FINDWindow(TheEvent.Where,%ref(wptr))
- if(WindowPart.eq.inDesk)then
- elseif(WindowPart.eq.inMenuBar)then
-cccc if(myCWindow.P.eq.FrontWindow())jevdon=.true.
- elseif(WindowPart.eq.inSysWindow)then
- call SystemClick(theEvent,wptr)
- jevdon=.true.
- elseif(WindowPart.eq.inContent)then
- if(wptr.P .eq. myCWindow.P)then
- if(wptr.P.eq.FrontWindow())jmouse=.true.
- jevdon=.true.
- endif
- if(wptr.P.ne.FrontWindow())call SelectWindow(wptr.P)
- elseif(WindowPart.eq.inDrag)then
- if(wptr.P.ne.FrontWindow())call SelectWindow(wptr.P)
- if(wptr.P.eq.myCWindow.P)then
-!!IFC NOT LSPOWERF
- QDG = JQDGLOBALS()
-!!ELSEC
- QDG = %loc(qd)
-!!ENDC
- call DragWindow(wptr,TheEvent.where,QDG^.screenbits.bounds)
- ier=UpdateGWorld(%ref(myGWorld.P),int2(0),
- # myCWindow.P^.portrect,nil,nil,clipPix)
- jevdon=.true.
- endif
- elseif(WindowPart.eq.inGrow)then
- elseif(WindowPart.eq.inGoAway)then
- if(wptr.P .eq. OutputWindow() )then
- jlocal = TrackGoaway(wptr,TheEvent.where)
- if(jlocal.and.myCWindow.P.ne.nil)then
- call SelectWindow(myCWindow.P)
- endif
- jevdon=.true.
- elseif(wptr.P .eq. myCWindow.P)then
- jlocal = TrackGoaway(wptr,TheEvent.where)
- jclgra = jclgra.or.jlocal
- if(jlocal.and.OutputWindow().ne.nil)then
- call SelectWindow( %val(OutputWindow()) )
- endif
- jevdon=.true.
- endif
- endif
- elseif(TheEvent.what.eq.mouseUp)then
- elseif(TheEvent.what.eq.keyDown)then
- elseif(TheEvent.what.eq.keyUp)then
- elseif(TheEvent.what.eq.autoKey)then
- elseif(TheEvent.what.eq.updateEvt)then
- if(TheEvent.message.eq.myCWindow.P)then
- call BeginUpdate(TheEvent.message)
- call GetGWorld(%ref(oldGWorld),%ref(oldGDHandle))
- call SetGWorld(myCWindow,mywGDHandle)
- call RGBForeColor(colorblack)
- call RGBBackColor(colorwhite)
- ier=LockPixels(myGWorld.P^.portPixMap)
- myPixMapHandle.H=GetGWorldPixMap(myGWorld)
- call copybits(
- # myPixMapHandle.H^.P^,myCWindow.P^.portPixMap.H^.P^,
- # myGWorld.P^.portrect,myCWindow.P^.portrect,
- # srccopy ,myCWindow.P^.visrgn)
- call UnlockPixels(myGWorld.P^.portPixMap)
- ixcur=-11111
- iycur=-11111
- call SetGWorld(oldGWorld,oldGDHandle)
- call EndUpdate(TheEvent.message)
- jevdon=.true.
-ccccc
-c elseif(TheEvent.message.eq.OutputWindow())then
-c call BeginUpdate(TheEvent.message)
-c call F_DRAWOUTPWINDOW
-c call DrawControls(TheEvent.message)
-c call DrawGrowIcon(TheEvent.message)
-c call EndUpdate(TheEvent.message)
-c jevdon=.true.
-ccccc
- endif
- elseif(TheEvent.what.eq.diskEvt)then
- elseif(TheEvent.what.eq.activateEvt)then
- elseif(TheEvent.what.eq.networkEvt)then
- elseif(TheEvent.what.eq.driverEvt)then
- elseif(TheEvent.what.eq.app1Evt)then
- elseif(TheEvent.what.eq.app2Evt)then
- elseif(TheEvent.what.eq.app3Evt)then
- elseif(TheEvent.what.eq.osEvt)then
- if(iand(ishft(theEvent.message,-24),suspendResumeMessage).ne.0)
- # jfrmst=iand(theEvent.message,resumeFlag).ne.0
- endif
- if(jevdon)TheEvent.what=0
- return
- end
-#endif
diff --git a/src/graflib/higz/imac/imacplo.F b/src/graflib/higz/imac/imacplo.F
deleted file mode 100644
index 979607f..0000000
--- a/src/graflib/higz/imac/imacplo.F
+++ /dev/null
@@ -1,583 +0,0 @@
-*
-* $Id: imacplo.F,v 1.1.1.1 1996/02/14 13:10:59 mclareni Exp $
-*
-* $Log: imacplo.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:59 mclareni
-* Higz
-*
-*
-#if defined(CERNLIB_MACMPW)
-#include "higz/pilot.h"
-*CMZ : 1.23/06 01/11/95 14.04.53 by O.Couet
-*-- Author : Cees de Laat
-!!IFC NOT LSPOWERF
-!!mp 68kinlines
-!!ELSEC
-!!mp PPCinlines
-!!ENDC
- subroutine macplo(ix,iy,ip)
- entry imacplo(ix,iy,ip)
-c+
-c subroutine macplo(ix,iy,ip)
-c entry imacplo(ix,iy,ip)
-c
-c device plot routine for Macintosh screen in MPW-LS-fortran window.
-c This routine is also usable as interface under the CERN-higz package.
-c
-c Normally ix and iy are integer plot coordinates, they should range
-c from 0 inclusive to some upper bound in both directions.
-c The point (0,0) should be at the left bottom corner, the positive
-c x axis to the right and the positive y axis is upwards.
-c
-c ip is the function code (those preceded by * are supported):
-c*ip = 999 close plot, it is ready
-c*ip = 31 give back type of device
-c ix is device, iy = 1 = screen with cursor readout,
-c iy = 2 = screen without cursor readout,
-c iy = 3 = plotter
-c iy = 4 = file.
-c*ip = 11 - 30 give back characters of names of devices
-c ix is device, iy contains character ip-10
-c*ip = 10 give back number of defined devices in ix
-c give back capabillities in iy:
-c iy= 1 = can do clipping
-c +2 = can do polyfill
-c +4 = can do block fill
-c +8 = can do pen clear
-c +16 = can do pen invert
-c*ip = 9 set pen width (ix) and height (iy)
-c*ip = -8 unset clipping rectangle
-c*ip = 8 set clipping rectangle from old position to ix,iy
-c*ip = 7 end defining and draw filled polygon with color
-c ix=style, iy=pattern number
-c ix=0=hollow
-c ix=1=solid
-c ix=2=pattern
-c ix=3=pattern
-c*ip = 6 start defining polygon, ix,iy is starting point
-c*ip = 5 fill rectangle from old position to ix,iy with color
-c*ip = 4 set pen to color ix (mod iy)
-c coding of color in big color pallette
-c ix = ired + iy*igreen + iy**2 * iblue
-c*ip = 3 set pen to clear mode
-c*ip = 2 set pen to invert mode
-c*ip = 1 set pen to set mode
-c*ip = 0 move pen to new coordinates (ix,iy)
-c*ip = -1 draw line to new coordinates (ix,iy)
-c*ip = -2 initialize for new plot (clear screen, new paper)
-c ix = 1 tektronics shape (1024*780)
-c ix = 2 three quarter size tektronics shape (768*585)
-c ix = 3 half size tektronics shape (512*390)
-c ix = 4 quarter size tektronics shape (256*195)
-c ix = 5 full screen
-c ix = 6 higz_cern
-c*ip = -3 activates cursor and performes readout (request mode)
-c*ip = -13 activates cursor and performes readout (sample mode)
-c*ip = -4 give back maximum possible ix and iy coordinates
-c*ip = -14 give back position of window on display in ix and iy
-c*ip = -5 give back number of pixels (steps) per unit of length
-c*ip = -6 give back supported number of colors (2-16777216) (8)
-c*ip = -999 stop plotting for the moment, it will continue later,
-c in the mean time terminal i/o might be undertaken.
-c*ip = -9999 bring graphics window to the front
-c
-c Function codes 10-31 are special and used to inform the software layer
-c above about available devices. These calls (10-31) are also passed to the
-c underlying layer but can be done also if there is no device open.
-c-
-!!SETC USINGINCLUDES = .FALSE.
-!!T72-
- include 'types.f'
- include 'OSUtils.f'
- include 'Windows.f'
- include 'QDOffscreen.f'
- include 'Quickdraw.f'
- include 'globals.f'
-c
- integer minus1
- parameter (minus1 = -1)
- record /Cursor/ mycursor
- record /rect/ bounds,localrect,myportrect,updaterect
- record /WindowPeek/ front
- record /SysEnvRec/ myenv
- record /PolyHandle/ mypoly
- record /Point/ pnLoc,pnt1,pnt2
- record /CWindowPtr/ myCWindow
- record /GWorldptr/ myGWorld,tmpGWorld
- record /RGBcolor/ currcolor,colorblack,colorwhite
- record /GDHandle/ mywGDHandle,mygGDHandle,tmpGDHandle
- record /grafport/ myGport
- record /Pattern/ mypattern
- parameter (mxbf=500)
- logical jcdraw,jpoly
- logical jclgra,jfrmst,jmouse
- common /mpwevt/jclgra,jfrmst,jmouse,ixcur,iycur,
- # myCWindow,myGWorld,
- # mywGDHandle,mygGDHandle,colorblack,colorwhite,myGport,
- # ixl(mxbf),iyl(mxbf),ipl(mxbf),updsec,mycursor,bounds,
- # localrect,myportrect,updaterect,front,myenv,mypoly,pnLoc,
- # currcolor,tmpGWorld,tmpGDHandle,jpoly,pnt1,pnt2
-c
- logical jopn,jact,jfrm,jprev
- logical jtitle
- character chtit*(*)
- parameter (mxdv=8,mxnd=mxdv-1)
- character txt*80,cdev(mxdv)*20
- integer itdv(mxdv)
- integer ixpos(mxdv),iypos(mxdv),ixwid(mxdv),iywid(mxdv)
- string*255 title
- logical*1 visible,goAway
- integer*1 ipatt(8,9)
- save
- data ipatt/
- # Z'aa',Z'55',Z'aa',Z'55',Z'aa',Z'55',Z'aa',Z'55',
- # Z'44',Z'11',Z'44',Z'11',Z'44',Z'11',Z'44',Z'11',
- # Z'00',Z'44',Z'00',Z'11',Z'00',Z'44',Z'00',Z'11',
- # Z'80',Z'40',Z'20',Z'10',Z'08',Z'04',Z'02',Z'01',
- # Z'20',Z'40',Z'80',Z'01',Z'02',Z'04',Z'08',Z'10',
- # Z'44',Z'44',Z'44',Z'44',Z'44',Z'44',Z'44',Z'44',
- # Z'00',Z'00',Z'00',Z'ff',Z'00',Z'00',Z'00',Z'ff',
- # Z'11',Z'b8',Z'7c',Z'3a',Z'11',Z'a3',Z'c7',Z'8b',
- # Z'10',Z'10',Z'28',Z'c7',Z'01',Z'01',Z'82',Z'7c'/
- data cdev/'s4_tek_screen','s3_tek_screen','s2_tek_screen',
- # 's1_tek_screen','mac_screen','macflat','machigh','higz_cern'/
- data ixpos/4,4,4,4,4,4,4,4/
- data iypos/40,40,40,40,40,40,40,40/
- data ixwid/1024,768,512,256,10000,580,290,620/
- data iywid/ 780,585,390,195,10000,290,580,436/
- data itdv/1,1,1,1,1,1,1,1/
- data jact/.false./,jopn/.false./,jtitle/.false./
- data nbfl/0/,ipenw/1/,ipenh/1/
-c-----------------------------------------------------------------------
-c first, check for the information function calls
-c
- if(ip.ge.10.and.ip.le.31)then
- if(ip.eq.10)then
- ix=mxdv
- iy=1+2+4+8+16
- elseif(ip.eq.31)then
- iy=itdv(max(1,min(mxdv,ix)))
- else
- iy=ichar(cdev(max(1,min(mxdv,ix)))(ip-10:ip-10))
- endif
- return
- endif
-c-----------------------------------------------------------------------
-c in all cases except initialisation the workstation must be activated.
-c
- if(.not.jopn.and.ip.ne.-2)return
- if(jopn.and..not.jact)then
- jact=.true.
- updsec=secnds(0.0)
- endif
-c-----------------------------------------------------------------------
- if(ip.ge.-1.and.ip.le.9.or.ip.eq.-8)then
- nbfl=nbfl+1
- ixl(nbfl)=ix
- iyl(nbfl)=iy
- ipl(nbfl)=ip
- if(ip.eq.-1.or.ip.eq.0.or.ip.eq.5.or.ip.eq.8)then
- if(idev.le.mxnd)iyl(nbfl)=iyen-iyl(nbfl)
- ixl(nbfl)=ixl(nbfl)-ipenw/2
- iyl(nbfl)=iyl(nbfl)-ipenh/2
- elseif(ip.eq.9)then
- ipenw=max(ix,1)
- ipenh=max(iy,1)
- endif
- if(nbfl.lt.mxbf.and.abs(secnds(updsec)).le.1.0)return
- elseif(ip.eq.-4)then
- ix=ixen
- iy=iyen
- return
- elseif(ip.eq.-14)then
- ix=bounds.left
- iy=bounds.top
- return
- elseif(ip.eq.-5)then
- ix=min((ixen-ixbg+1)/10.24,(iyen-iybg+1)/7.80) + .001
- iy=ix
- return
- elseif(ip.eq.-6)then
- ix=mxcl
- iy=mxgr
- return
- endif
-c-----------------------------------------------------------------------
-c in all cases except draw (modes) the buffer must be flushed
-c
- if(jopn.and.nbfl.gt.0)then
- call GetGWorld(%ref(tmpGWorld.P),%ref(tmpGDHandle.H))
- call SetGWorld(myGWorld,mygGDHandle)
- ier=LockPixels(myGWorld.P^.portPixMap)
- do 10 i=1,nbfl
- if(ipl(i).eq.0)then
- call MoveTo(int2(ixl(i)),int2(iyl(i)))
- ixold=ixl(i)
- iyold=iyl(i)
- pnt2.h=ixl(i)
- pnt2.v=iyl(i)
- elseif(ipl(i).eq.-1)then
- call LineTo(int2(ixl(i)),int2(iyl(i)))
- ixold=ixl(i)
- iyold=iyl(i)
- pnt1=pnt2
- pnt2.h=ixl(i)
- pnt2.v=iyl(i)
- if(.not.jpoly)then
- call Pt2Rect(pnt1,pnt2,localrect)
- call unionrect(localrect,updaterect,updaterect)
- endif
- elseif(ipl(i).eq.9)then
- call PenSize(int2(ixl(i)),int2(iyl(i)))
- elseif(ipl(i).eq.-8)then
- call ClipRect(myGWorld.P^.portRect)
- elseif(ipl(i).eq.8)then
- if(idev.le.mxnd)then
- call setrect(localrect,int2(ixold),int2(iyl(i)),
- # int2(ixl(i)+1),int2(iyold+1))
- else
- call setrect(localrect,int2(ixold),int2(iyold),
- # int2(ixl(i)+1),int2(iyl(i)+1))
- endif
- call ClipRect(localrect)
- elseif(ipl(i).eq.7)then
- call ClosePoly
- if(ixl(i).eq.1)then
- call PaintPoly(mypoly)
- elseif(ixl(i).eq.2.or.ixl(i).eq.3)then
- np=max(1,min(9,iyl(i)))
- mypattern.pat(0)=ipatt(1,np)
- mypattern.pat(1)=ipatt(2,np)
- mypattern.pat(2)=ipatt(3,np)
- mypattern.pat(3)=ipatt(4,np)
- mypattern.pat(4)=ipatt(5,np)
- mypattern.pat(5)=ipatt(6,np)
- mypattern.pat(6)=ipatt(7,np)
- mypattern.pat(7)=ipatt(8,np)
- call FillPoly(mypoly,mypattern)
- else
- call FramePoly(mypoly)
- endif
- call unionrect(mypoly.H^.P^.polyBBox,updaterect,updaterect)
- call KillPoly(mypoly)
- jpoly=.false.
- elseif(ipl(i).eq.6)then
- mypoly.H=OpenPoly
- jpoly=.true.
- elseif(ipl(i).eq.5)then
- if(idev.le.mxnd)then
- call setrect(localrect,int2(ixold),int2(iyl(i)),
- # int2(ixl(i)+1),int2(iyold+1))
- else
- call setrect(localrect,int2(ixold),int2(iyold),
- # int2(ixl(i)+1),int2(iyl(i)+1))
- endif
- call paintrect(localrect)
- call unionrect(localrect,updaterect,updaterect)
- elseif(ipl(i).eq.4)then
- if(mxcl.gt.2.or.mxgr.gt.2)then
- ncl=max(2,iyl(i))
- fc=65535./float(ncl-1)
- ic=abs(ixl(i))
- currcolor.red = nint(fc*mod(ic,ncl))
- ic=ic/ncl
- currcolor.green= nint(fc*mod(ic,ncl))
- ic=ic/ncl
- currcolor.blue = nint(fc*mod(ic,ncl))
- call RGBForeColor(currcolor)
- else
- if(ixl(i).eq.iyl(i)*iyl(i)*iyl(i)-1)then
- call RGBForeColor(colorwhite)
- else
- call RGBForeColor(colorblack)
- endif
- endif
- elseif(ipl(i).eq.3)then
- call PenMode(patBic)
- elseif(ipl(i).eq.2)then
- call PenMode(patXor)
- elseif(ipl(i).eq.1)then
- call PenMode(patCopy)
- endif
-10 continue
- call UnlockPixels(myGWorld.P^.portPixMap)
- call SetGWorld(tmpGWorld,tmpGDHandle)
- nbfl=0
- if((ip.ge.-1.and.ip.le.9.or.ip.eq.-8).and.
- # abs(secnds(updsec)).le.1.0)return
- endif
-c-----------------------------------------------------------------------
- if(ip.eq.999)then
- call DisposeGWorld(myGWorld)
- myGWorld.P=nil
- call DisposeWindow(myCWindow.P)
- myCWindow.P=nil
- jopn=.false.
- jact=.false.
-c-----------------------------------------------------------------------
- elseif(ip.eq.-2)then
- if(.not.jopn)then
- front.P=FrontWindow()
- if(front.P.eq.nil)write(6,*)' '
-!!IFC NOT LSPOWERF
- ierror = SysEnvirons(curSysEnvVers,myenv)
- jcdraw = myenv.hasColorQD
- if(.not.jcdraw)then
- write(6,*)'macplo: Color Quickdraw is not installed!'
- write(6,*)'macplo: update your system.'
- return
- endif
- QDG = JQDGLOBALS()
-!!ELSEC
- QDG = %loc(qd)
-!!ENDC
- idev=max(1,min(mxdv,ix))
- isl=QDG^.screenbits.bounds.left + 4
- isr=QDG^.screenbits.bounds.right - 4
- ist=QDG^.screenbits.bounds.top + 40
- isb=QDG^.screenbits.bounds.bottom - 4
-c
- if(idev.ge.1.and.idev.le.mxnd)then
- call fclenv('plot_windowposition',txt)
- call plcwps(isl,isr,ist,isb,ixwid(idev),iywid(idev),
- # txt,iwl,iwr,iwt,iwb)
- if(idev.le.4)then
- f=min(float(iwb - iwt + 1)/780.,float(iwr - iwl + 1)/1024.)
- iwb = iwt + nint(f * 780.) - 1
- iwr = iwl + nint(f * 1024.) - 1
- endif
- else
- iwr = min(isr,max(isl,ixpos(idev))+ixwid(idev))
- iwl = max(isl,iwr-ixwid(idev))
- iwb = min(isb,max(ist,iypos(idev))+iywid(idev))
- iwt = max(ist,iwb-iywid(idev))
- endif
-c
- if(mod(iwr-iwl+1,2).eq.1)iwr=iwr+1
- if(mod(iwb-iwt+1,2).eq.1)iwb=iwb+1
- ixbg=0
- iybg=0
- ixen=iwr-iwl
- iyen=iwb-iwt
- bounds.right = iwr
- bounds.left = iwl
- bounds.bottom = iwb
- bounds.top = iwt
-c
- if(.not.jtitle)then
- write(txt,'(a,i5,a,i5,a)')
- # 'MacPlo =>',ixen+1,'*',iyen+1,' pixels'
- title = txt(1:27)
- endif
- visible = .true.
- goAway = .true.
- myCwindow.P=nil
- mywGDHandle.H=nil
- myGWorld.P=nil
- myCWindow.P = NewCWindow(nil,bounds,title,visible,
- # int2(noGrowDocProc),minus1,goAway,nil)
- call SetPort(myCWindow.P)
- myportrect=myCWindow.P^.portRect
- call ClipRect(myCWindow.P^.portRect)
- call PenMode(patCopy)
- colorblack.red = 0
- colorblack.green = 0
- colorblack.blue = 0
- colorwhite.red = -1
- colorwhite.green = -1
- colorwhite.blue = -1
- call RGBForeColor(colorblack)
- call RGBBackColor(colorwhite)
- call GetGWorld(%ref(myCWindow.P),%ref(mywGDHandle.H))
- mxcl=myCWindow.P^.portpixmap.H^.P^.pixelsize
- if(mxcl.eq.16)mxcl=15
- mxcl=2**max(1,min(24,mxcl))
- mxgr=min(256,mxcl)
- ier=NewGWorld(%ref(myGWorld.P),int2(0),bounds,nil,nil,nil)
- if(ier.ne.0)then
- call DisposeWindow(myCWindow.P)
- myCWindow.P=nil
- write(6,*)'macplo: GWorld creation failed, error:',ier
- write(6,*)'macplo: allocate more memory to this application'
- write(6,*)'bounds.right,bounds.left,bounds.bottom,bounds.top'
- write(6,*)bounds.right,bounds.left,bounds.bottom,bounds.top
- return
- endif
- mygGDHandle.H=nil
- jopn=.true.
- jact=.true.
- elseif(jtitle)then
- call SetWTitle(myCWindow.P,title)
- endif
-c
- call SetGWorld(myGWorld,mygGDHandle)
- ier=LockPixels(myGWorld.P^.portPixMap)
- call RGBForeColor(colorblack)
- call RGBBackColor(colorwhite)
- call ClipRect(myGWorld.P^.portRect)
- call EraseRect(myGWorld.P^.portRect)
- call UnlockPixels(myGWorld.P^.portPixMap)
- nbfl=0
- jpoly=.false.
- updaterect=myportrect
-c-----------------------------------------------------------------------
- elseif(ip.eq.-3.or.ip.eq.-13)then
-c
- call SetGWorld(myCWindow,mywGDHandle)
- do 90 i=0,15
- mycursor.mask.bits(i)=$0000
-90 continue
- mycursor.data=mycursor.mask
- mycursor.hotSpot.h=8
- mycursor.hotSpot.v=8
- ixcur=-11111
- iycur=-11111
- jfrm=.true.
-c
-100 jprev=jfrm
- jclgra=.false.
- jmouse=.false.
- call F_DoBackground
- jfrm=jfrmst
- if(.not.jprev.and.jfrm)then
-110 if(button)goto 110
- goto 100
- endif
-c
- if(jclgra)then
- ixx=0
- iyy=iyen
- goto 190
- endif
-c
- if(myCWindow.P.ne.FrontWindow())goto 100
-c
-c draw (parts of) new cursor and erase (parts of) old cursor
-c
- call SetGWorld(myCWindow,mywGDHandle)
- if(.not.jfrm)then
- ixx=-11111
- iyy=-11111
- else
- call GetMouse(%ref(pnLoc))
- ixx=pnLoc.h
- iyy=pnLoc.v
- endif
- if(ixx.lt.0.or.ixx.gt.ixen.or.iyy.lt.0.or.iyy.gt.iyen)then
- ixx=-11111
- iyy=-11111
- endif
- if(ixx.ne.ixcur.or.iyy.ne.iycur)then
- call SetCursor(mycursor)
- if(ip.eq.-3)then
- call PenMode(patXor)
- if(ixx.ne.ixcur)then
- call MoveTo(int2(ixx),int2(iybg))
- call LineTo(int2(ixx),int2(iyen))
- call MoveTo(int2(ixcur),int2(iybg))
- call LineTo(int2(ixcur),int2(iyen))
- ixcur=ixx
- endif
- if(iyy.ne.iycur)then
- call MoveTo(int2(ixbg),int2(iyy))
- call LineTo(int2(ixen),int2(iyy))
- call MoveTo(int2(ixbg),int2(iycur))
- call LineTo(int2(ixen),int2(iycur))
- iycur=iyy
- endif
- call PenMode(patCopy)
- endif
- endif
-c
- if(ixx.ge.0.and.ixx.le.ixen.and.iyy.ge.0.and.iyy.le.iyen)then
- if(jmouse.or.ip.eq.-13)then
-130 if(button)goto 130
- goto 190
- endif
- else
- call InitCursor
- endif
- goto 100
-c
-190 call PenMode(patXor)
- call MoveTo(int2(ixcur),int2(iybg))
- call LineTo(int2(ixcur),int2(iyen))
- call MoveTo(int2(ixbg),int2(iycur))
- call LineTo(int2(ixen),int2(iycur))
- call PenMode(patCopy)
- call InitCursor
- ix=max(0,min(ixen,ixx))
- iy=max(0,min(iyen,iyy))
- if(idev.le.mxnd)iy=iyen-iy
-c-----------------------------------------------------------------------
- elseif(ip.eq.-999)then
- jact=.false.
-c-----------------------------------------------------------------------
- elseif(ip.eq.-9999)then
- front.P=FrontWindow()
- if(front.P^.windowKind.ne.dBoxProc)then
-ccc call GetGWorld(%ref(tmpGWorld.P),%ref(tmpGDHandle.H))
- call SetGWorld(myCWindow,mywGDHandle)
- call SelectWindow(myCWindow)
-ccc call SetGWorld(tmpGWorld,tmpGDHandle)
- endif
- endif
-c-----------------------------------------------------------------------
- if(jopn)then
- if(.not.EmptyRect(updaterect))then
-ccc call GetGWorld(%ref(tmpGWorld.P),%ref(tmpGDHandle.H))
- call SetGWorld(myCWindow,mywGDHandle)
- updaterect.left =updaterect.left -ipenw/2
- updaterect.top =updaterect.top -ipenh/2
- updaterect.right =updaterect.right +ipenw
- updaterect.bottom=updaterect.bottom+ipenh
- call InvalRect(updaterect)
- call SetRect(updaterect,int2( 10000),int2( 10000),
- # int2(-10000),int2(-10000))
-ccc call SetGWorld(tmpGWorld,tmpGDHandle)
- endif
- call F_DoBackground
- updsec=secnds(0.0)
- endif
- return
-c-----------------------------------------------------------------------
- entry imsettit(lentit,chtit)
- if(lentit.gt.0.and.lentit.le.255)then
- title=chtit(1:lentit)
- jtitle=.true.
- else
- jtitle=.false.
- endif
- return
-c-----------------------------------------------------------------------
- entry imsetwsz(ixp,iyp,ixw,iyh)
- ixpos(5)=ixp
- iypos(5)=iyp
- ixwid(5)=ixw
- iywid(5)=iyh
- ixpos(6)=ixp
- iypos(6)=iyp
- ixwid(6)=ixw
- iywid(6)=iyh
- return
-c-----------------------------------------------------------------------
- entry imgetds(idxp,idyp,idxw,idyh)
-!!IFC NOT LSPOWERF
- QDG = JQDGLOBALS()
-!!ELSEC
- QDG = %loc(qd)
-!!ENDC
- idxp=QDG^.screenbits.bounds.left
- idyp=QDG^.screenbits.bounds.top
- idxw=QDG^.screenbits.bounds.right - QDG^.screenbits.bounds.left
- idyw=QDG^.screenbits.bounds.bottom - QDG^.screenbits.bounds.top
- return
-c-----------------------------------------------------------------------
- entry imgetms(im)
- if(jmouse)then
- im=2
- else
- im=0
- endif
- end
-#endif
diff --git a/src/graflib/higz/imac/imclip.F b/src/graflib/higz/imac/imclip.F
deleted file mode 100644
index 9e592de..0000000
--- a/src/graflib/higz/imac/imclip.F
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: imclip.F,v 1.1.1.1 1996/02/14 13:10:59 mclareni Exp $
-*
-* $Log: imclip.F,v $
-* Revision 1.1.1.1 1996/02/14 13:10:59 mclareni
-* Higz
-*
-*
-#if defined(CERNLIB_MACMPW)
-#include "higz/pilot.h"
-*CMZ : 1.16/04 02/10/92 13.34.54 by O.Couet
-*-- Author : Cees de Laat
- subroutine imclip(ix,iy,iw,ih)
-c+
-c subroutine imclip(ix,iy,iw,ih)
-c
-c Set clipping to the rectangle ix,iy,iw,ih
-c-
- call imacplo(ix,iy,0)
- call imacplo(ix+iw,iy+ih,8)
- end
-#endif
diff --git a/src/graflib/higz/imac/imclrwi.F b/src/graflib/higz/imac/imclrwi.F
deleted file mode 100644
index c46ea22..0000000
--- a/src/graflib/higz/imac/imclrwi.F
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: imclrwi.F,v 1.1.1.1 1996/02/14 13:11:00 mclareni Exp $
-*
-* $Log: imclrwi.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:00 mclareni
-* Higz
-*
-*
-#if defined(CERNLIB_MACMPW)
-#include "higz/pilot.h"
-*CMZ : 1.23/06 01/11/95 14.04.54 by O.Couet
-*-- Author : Cees de Laat
- subroutine imclrwi
-c+
-c subroutine imclrwi
-c
-c Clears the window. If the window is not open, it will be opened.
-c-
- call imacplo(ima,idm,10)
- call imacplo(ima,0,-2)
- end
-#endif
diff --git a/src/graflib/higz/imac/imclsds.F b/src/graflib/higz/imac/imclsds.F
deleted file mode 100644
index f3bbf40..0000000
--- a/src/graflib/higz/imac/imclsds.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: imclsds.F,v 1.1.1.1 1996/02/14 13:11:00 mclareni Exp $
-*
-* $Log: imclsds.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:00 mclareni
-* Higz
-*
-*
-#if defined(CERNLIB_MACMPW)
-#include "higz/pilot.h"
-*CMZ : 1.14/09 05/06/92 09.51.11 by O.Couet
-*-- Author : Cees de Laat
- subroutine imclsds
-c+
-c subroutine imclsds
-c
-c Closes window.
-c-
- call imacplo(0,0,999)
- end
-#endif
diff --git a/src/graflib/higz/imac/imclswi.F b/src/graflib/higz/imac/imclswi.F
deleted file mode 100644
index 14747bf..0000000
--- a/src/graflib/higz/imac/imclswi.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: imclswi.F,v 1.1.1.1 1996/02/14 13:11:00 mclareni Exp $
-*
-* $Log: imclswi.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:00 mclareni
-* Higz
-*
-*
-#if defined(CERNLIB_MACMPW)
-#include "higz/pilot.h"
-*CMZ : 1.14/09 05/06/92 09.51.11 by O.Couet
-*-- Author : Cees de Laat
- subroutine imclswi
-c+
-c subroutine imclswi
-c
-c Closes window.
-c-
- call imacplo(0,0,999)
- end
-#endif
diff --git a/src/graflib/higz/imac/imdrmde.F b/src/graflib/higz/imac/imdrmde.F
deleted file mode 100644
index 84762a5..0000000
--- a/src/graflib/higz/imac/imdrmde.F
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: imdrmde.F,v 1.1.1.1 1996/02/14 13:11:00 mclareni Exp $
-*
-* $Log: imdrmde.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:00 mclareni
-* Higz
-*
-*
-#if defined(CERNLIB_MACMPW)
-#include "higz/pilot.h"
-*CMZ : 1.14/09 05/06/92 09.51.11 by O.Couet
-*-- Author : Cees de Laat
- subroutine imdrmde(mode)
-c+
-c subroutine imdrmde(mode)
-c
-c Set drawing mode
-c mode = 1 = pixels are set
-c mode = 2 = xor mode
-c-
- if(mode.eq.1)then
- call imacplo(0,0,1)
- elseif(mode.eq.2)then
- call imacplo(0,0,2)
- endif
- end
-#endif
diff --git a/src/graflib/higz/imac/imflare.F b/src/graflib/higz/imac/imflare.F
deleted file mode 100644
index 47bf062..0000000
--- a/src/graflib/higz/imac/imflare.F
+++ /dev/null
@@ -1,74 +0,0 @@
-*
-* $Id: imflare.F,v 1.1.1.1 1996/02/14 13:11:01 mclareni Exp $
-*
-* $Log: imflare.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:01 mclareni
-* Higz
-*
-*
-#if defined(CERNLIB_MACMPW)
-#include "higz/pilot.h"
-*CMZ : 1.19/03 24/08/93 11.37.18 by O.Couet
-*-- Author : Cees de Laat
- subroutine imflare(n,ixy)
-c+
-c subroutine imflare(n,ixy)
-c
-c Draw a line trough the points given in ixy(2,n)
-c n <= integer, number of points
-c ixy <= integer array, set of points to draw the line through.
-c
-c style = 0 = hollow
-c 1 = solid
-c 2 = pattern
-c 3 = hatch
-c-
- integer ixy(2,*),ixyloc(2,5)
- data indxf/1/,istyl/0/,ifasi/2/
- save indxf,istyl,ifasi
-c
- call imsetcc(indxf)
- call imacplo(0,0,6)
- ip=0
- do 10 i=1,n
- call imacplo(ixy(1,i),ixy(2,i),ip)
- ip=-1
- 10 continue
- call imacplo(istyl,ifasi,7)
- return
-c-----------------------------------------------------------------------
- entry imsetfc(index)
- indxf=index
- return
-c-----------------------------------------------------------------------
- entry imsetfs(istyle,ifasii)
- istyl=max(0,min(3,istyle))
- ifasi=ifasii
- if(ifasi.le.0.or.ifasi.gt.9)ifasi=2
- return
-c-----------------------------------------------------------------------
- entry imbox(ix1,ix2,iy1,iy2,mode)
-c+
-c subroutine imbox(ix1,ix2,iy1,iy2,mode)
-c Draws a rectangle
-c mode not equals 0 rect = filled with current color.
-c-
- if(mode.eq.0)then
- ixyloc(1,1)=ix1
- ixyloc(2,1)=iy1
- ixyloc(1,2)=ix2
- ixyloc(2,2)=iy1
- ixyloc(1,3)=ix2
- ixyloc(2,3)=iy2
- ixyloc(1,4)=ix1
- ixyloc(2,4)=iy2
- ixyloc(1,5)=ix1
- ixyloc(2,5)=iy1
- call imline(5,ixyloc)
- else
- call imsetcc(indxf)
- call imacplo(min(ix1,ix2),min(iy1,iy2),0)
- call imacplo(max(ix1,ix2),max(iy1,iy2),5)
- endif
- end
-#endif
diff --git a/src/graflib/higz/imac/imgetge.F b/src/graflib/higz/imac/imgetge.F
deleted file mode 100644
index 3ba0039..0000000
--- a/src/graflib/higz/imac/imgetge.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: imgetge.F,v 1.1.1.1 1996/02/14 13:11:00 mclareni Exp $
-*
-* $Log: imgetge.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:00 mclareni
-* Higz
-*
-*
-#if defined(CERNLIB_MACMPW)
-#include "higz/pilot.h"
-*CMZ : 1.14/09 05/06/92 09.51.11 by O.Couet
-*-- Author : Cees de Laat
- subroutine imgetge(iwid,ix,iy,iw,ih)
-c+
-c subroutine imgetge(iwid,ix,iy,iw,ih)
-c
-c iwid smaller than zero, returns display size, otherwise open window size.
-c-
- if(iwid.lt.0)then
- call imgetds(ix,iy,iw,ih)
- else
- call imacplo(ix,iy,-14)
- call imacplo(iw,ih,-4)
- endif
- end
-#endif
diff --git a/src/graflib/higz/imac/imline.F b/src/graflib/higz/imac/imline.F
deleted file mode 100644
index 333f6aa..0000000
--- a/src/graflib/higz/imac/imline.F
+++ /dev/null
@@ -1,38 +0,0 @@
-*
-* $Id: imline.F,v 1.1.1.1 1996/02/14 13:11:00 mclareni Exp $
-*
-* $Log: imline.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:00 mclareni
-* Higz
-*
-*
-#if defined(CERNLIB_MACMPW)
-#include "higz/pilot.h"
-*CMZ : 1.16/04 02/10/92 13.37.17 by O.Couet
-*-- Author : Cees de Laat
- subroutine imline(n,ixy)
-c+
-c subroutine imline(n,ixy)
-c
-c Draw a line trough the points given in ixy(2,n)
-c n <= integer, number of points
-c ixy <= integer array, set of points to draw the line through.
-c-
- integer ixy(2,*)
- data indxl/1/
- save
-c
- call imsetcc(indxl)
- ip=0
- do 10 i=1,n
- call imacplo(ixy(1,i),ixy(2,i),ip)
- ip=-1
- 10 continue
- return
-c-----------------------------------------------------------------------
- entry imsetlc(index)
- indxl=index
- return
-c-----------------------------------------------------------------------
- end
-#endif
diff --git a/src/graflib/higz/imac/imnocli.F b/src/graflib/higz/imac/imnocli.F
deleted file mode 100644
index 453a9d6..0000000
--- a/src/graflib/higz/imac/imnocli.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: imnocli.F,v 1.1.1.1 1996/02/14 13:11:00 mclareni Exp $
-*
-* $Log: imnocli.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:00 mclareni
-* Higz
-*
-*
-#if defined(CERNLIB_MACMPW)
-#include "higz/pilot.h"
-*CMZ : 1.16/04 02/10/92 13.35.41 by O.Couet
-*-- Author : Cees de Laat
- subroutine imnocli
-c+
-c subroutine imnocli
-c
-c Remove clipping.
-c-
- call imacplo(0,0,-8)
- end
-#endif
diff --git a/src/graflib/higz/imac/imopnwi.F b/src/graflib/higz/imac/imopnwi.F
deleted file mode 100644
index 9e9bd35..0000000
--- a/src/graflib/higz/imac/imopnwi.F
+++ /dev/null
@@ -1,44 +0,0 @@
-*
-* $Id: imopnwi.F,v 1.1.1.1 1996/02/14 13:11:00 mclareni Exp $
-*
-* $Log: imopnwi.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:00 mclareni
-* Higz
-*
-*
-#if defined(CERNLIB_MACMPW)
-#include "higz/pilot.h"
-*CMZ : 1.23/06 01/11/95 14.04.54 by O.Couet
-*-- Author : Cees de Laat
- integer function imopnwi(ix,iy,iw,ih,lentit,chtit)
-c+
-c integer function imopnwi(ix,iy,iw,ih,lentit,chtit)
-c
-c Opens a window on the screen at position ix,iy. Size of the window
-c will be iw * ih pixels. Coordinates on display and in the window are
-c increasing from top to down and from left to right.
-c
-c ix,iy,iw,iy <= integer, position and size of window
-c lentit <= integer, length of the window title. If a zero or negative
-c number is supplied, a default title will be generated.
-c chtit <= character string, title for the window.
-c imopnwi => integer, return status, -1 is failure.
-c It is possible to open only one grapics window.
-c-
- character chtit*(*)
- call imsettit(lentit,chtit)
- call imsetwsz(ix,iy,iw,ih)
- call imacplo(ima,idm,10)
- call imacplo(ima,0,-2)
- i=0
- j=0
- call imacplo(i,j,-4)
- if(i.eq.0.or.j.eq.0)then
- imopnwi=-1
- else
- imopnwi=0
- call imsetco(0,1.,1.,1.)
- call imsetco(1,0.,0.,0.)
- endif
- end
-#endif
diff --git a/src/graflib/higz/imac/imreqlo.F b/src/graflib/higz/imac/imreqlo.F
deleted file mode 100644
index 306842c..0000000
--- a/src/graflib/higz/imac/imreqlo.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: imreqlo.F,v 1.1.1.1 1996/02/14 13:11:00 mclareni Exp $
-*
-* $Log: imreqlo.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:00 mclareni
-* Higz
-*
-*
-#if defined(CERNLIB_MACMPW)
-#include "higz/pilot.h"
-*CMZ : 1.16/01 18/08/92 10.44.19 by O.Couet
-*-- Author : Cees de Laat
- integer function imreqlo(mode,ityp,ix,iy)
-c+
-c integer function imreqlo(mode,ityp,ix,iy)
-c locator request, always crosshair,
-c mode = 0 normal mode
-c mode = 1 sampling mode
-c-
- if(mode.eq.0)then
- call imacplo(ix,iy,-3)
- imreqlo=2
- elseif(mode.eq.1)then
- call imacplo(ix,iy,-13)
- call imgetms(imreqlo)
- endif
- end
-#endif
diff --git a/src/graflib/higz/imac/imsetco.F b/src/graflib/higz/imac/imsetco.F
deleted file mode 100644
index 2e980ec..0000000
--- a/src/graflib/higz/imac/imsetco.F
+++ /dev/null
@@ -1,65 +0,0 @@
-*
-* $Id: imsetco.F,v 1.1.1.1 1996/02/14 13:11:00 mclareni Exp $
-*
-* $Log: imsetco.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:00 mclareni
-* Higz
-*
-*
-#if defined(CERNLIB_MACMPW)
-#include "higz/pilot.h"
-*CMZ : 1.16/05 12/10/92 14.06.41 by O.Couet
-*-- Author : Cees de Laat
- subroutine imsetco(index,r,g,b)
-c+
-c subroutine imsetco(index,r,g,b)
-c Set color r,g,b for index. The requested color will be mapped to the
-c closest available color in the map of the screen.
-c
-c Color index management, index between 0 and 255 inclusive.
-c-
- parameter (mxcl=1000)
- integer irgb(0:255),indold
- save
- data irgb/256*0/,indold/-1/
-c
- indold=-1
- if(index.ge.0.and.index.le.255)then
- if(r.ge.0..and.r.le.1..and.
- + g.ge.0..and.g.le.1..and.
- + b.ge.0..and.b.le.1.)then
- ir=nint(r*(mxcl-1))
- ig=nint(g*(mxcl-1))
- ib=nint(b*(mxcl-1))
- irgb(index)=ir+(ig+ib*mxcl)*mxcl
- endif
- endif
- return
-c-----------------------------------------------------------------------
- entry imgetcol(index,r,g,b)
-c+
-c returns the requested color mapping of the index, not the on screen
-c actual!!!
-c+
- if(index.ge.0.and.index.le.255)then
- fc=1./float(mxcl-1)
- ic=irgb(index)
- r=nint(fc*mod(ic,mxcl))
- ic=ic/mxcl
- g=nint(fc*mod(ic,mxcl))
- ic=ic/mxcl
- b=nint(fc*mod(ic,mxcl))
- endif
- return
-c-----------------------------------------------------------------------
- entry imsetcc(index)
-c+
-c entry imsetcc(index)
-c sets the color for all following drawing operations.
-c=
- if(index.ge.0.and.index.le.255.and.index.ne.indold)then
- indold=index
- call imacplo(irgb(indold),mxcl,4)
- endif
- end
-#endif
diff --git a/src/graflib/higz/imac/imsetln.F b/src/graflib/higz/imac/imsetln.F
deleted file mode 100644
index cf3807e..0000000
--- a/src/graflib/higz/imac/imsetln.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: imsetln.F,v 1.1.1.1 1996/02/14 13:11:01 mclareni Exp $
-*
-* $Log: imsetln.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:01 mclareni
-* Higz
-*
-*
-#if defined(CERNLIB_MACMPW)
-#include "higz/pilot.h"
-*CMZ : 1.16/04 02/10/92 13.36.10 by O.Couet
-*-- Author : Cees de Laat
- subroutine imsetln(iwidth)
-c+
-c subroutine imsetln(iwidth)
-c
-c Set line width in pixels.
-c-
- call imacplo(iwidth,iwidth,9)
- end
-#endif
diff --git a/src/graflib/higz/imac/imsetms.F b/src/graflib/higz/imac/imsetms.F
deleted file mode 100644
index b723562..0000000
--- a/src/graflib/higz/imac/imsetms.F
+++ /dev/null
@@ -1,101 +0,0 @@
-*
-* $Id: imsetms.F,v 1.1.1.1 1996/02/14 13:11:01 mclareni Exp $
-*
-* $Log: imsetms.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:01 mclareni
-* Higz
-*
-*
-#if defined(CERNLIB_MACMPW)
-#include "higz/pilot.h"
-*CMZ : 1.16/01 18/08/92 10.10.58 by O.Couet
-*-- Author : Cees de Laat
- subroutine imsetms(itype,n,ixy)
-c+
-c subroutine imsetms(itype,n,ixy)
-c
-c Set marker type. The definition is the same as for the corresponding
-c ixsetms routine, but the filled polygon routines are not implemented and
-c will only produce the hollow shapes.
-c
-c itype <= integer, marker type
-c n <= integer, number of points in ixy
-c ixy(2,n) <= integer, array of x,y points in ixy(2,n)
-c n.eq.0 Marker is a single point
-c itype = 0 or 1, Marker is hollow circle of diameter N
-c itype = 2 or 3, Marker is hollow polygon described by ixy
-c itype = 4, Marker is described by segmented line ixy
-c-
- integer ixy(2,*),mkxy(2,40)
- save
- data mktp/-1/,mknn/0/,nmkc/1/
-c
- if(n.le.0.or.itype.lt.0.or.itype.gt.4)then
- mktp=-1
- mknn=0
- elseif(itype.eq.0.or.itype.eq.1)then
- mktp=itype
- fac=2.*3.14159264358/32.
- nr=max(1,n/2)
- mkxy(1,1)=nr
- mkxy(2,1)=0
- mknn=2
- do 10 i=2,32
- phi=float(i-1)*fac
- mkxy(1,mknn)=nint(nr*cos(phi))
- mkxy(2,mknn)=nint(nr*sin(phi))
- if(mkxy(1,mknn-1).ne.mkxy(1,mknn).or. mkxy(1,mknn-1)
- + .ne.mkxy(1,mknn))mknn=mknn+1
- 10 continue
- mkxy(1,mknn)=mkxy(1,1)
- mkxy(2,mknn)=mkxy(2,1)
- elseif(itype.eq.2.or.itype.eq.3.or.itype.eq.4)then
- mktp=itype
- mknn=min(n,40)
- do 20 i=1,mknn
- mkxy(1,i)=ixy(1,i)
- mkxy(2,i)=ixy(2,i)
- 20 continue
- endif
- return
-c-----------------------------------------------------------------------
- entry imsetmc(index)
-c+
-c entry imsetmc(index)
-c
-c Set color index for markers
-c index <= integer, index of color defined previously by imsetco
-c-
- nmkc=index
- return
-c-----------------------------------------------------------------------
- entry immarke(n,ixy)
-c+
-c entry immarke(n,ixy)
-c Sets a marker at each of the points in ixy
-c
-c ixy <= integer, array of points where marker will be drawn.
-c-
- call imsetcc(nmkc)
- do 40 i=1,n
- ixo=ixy(1,i)
- iyo=ixy(2,i)
- if(mktp.eq.-1)then
- call imacplo(ixo,iyo,0)
- call imacplo(ixo,iyo,-1)
- elseif(mktp.ge.0.and.mktp.le.4)then
- ip=0
- do 30 j=1,mknn
- ix=ixy(1,i)+mkxy(1,j)
- iy=ixy(2,i)+mkxy(2,j)
- call imacplo(ix,iy,ip)
- if(mktp.eq.4)then
- ip=-1-ip
- else
- ip=-1
- endif
- 30 continue
- endif
- 40 continue
- end
-#endif
diff --git a/src/graflib/higz/imac/imupdwi.F b/src/graflib/higz/imac/imupdwi.F
deleted file mode 100644
index 14ea941..0000000
--- a/src/graflib/higz/imac/imupdwi.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: imupdwi.F,v 1.1.1.1 1996/02/14 13:11:01 mclareni Exp $
-*
-* $Log: imupdwi.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:01 mclareni
-* Higz
-*
-*
-#if defined(CERNLIB_MACMPW)
-#include "higz/pilot.h"
-*CMZ : 1.16/01 18/08/92 11.02.33 by O.Couet
-*-- Author : Cees de Laat
- subroutine imupdwi
-c+
-c subroutine imupdwi
-c
-c the window is updated and moved to the top of the stack.
-c-
- call imacplo(0,0,-999)
- end
-#endif
diff --git a/src/graflib/higz/imail/Imakefile b/src/graflib/higz/imail/Imakefile
deleted file mode 100644
index da4735c..0000000
--- a/src/graflib/higz/imail/Imakefile
+++ /dev/null
@@ -1,3 +0,0 @@
-SRCS_F= imfin.F imfout.F imint.F imtek.F imwrit.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/graflib/higz/imail/imfin.F b/src/graflib/higz/imail/imfin.F
deleted file mode 100644
index 2966e8b..0000000
--- a/src/graflib/higz/imail/imfin.F
+++ /dev/null
@@ -1,83 +0,0 @@
-*
-* $Id: imfin.F,v 1.1.1.1 1996/02/14 13:11:02 mclareni Exp $
-*
-* $Log: imfin.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:02 mclareni
-* Higz
-*
-*
-#if defined(CERNLIB_MAIL)
-#include "higz/pilot.h"
-*CMZ : 1.09/00 05/12/89 11.55.58 by O.Couet
-*-- Author : O.Couet 30/01/89
- INTEGER FUNCTION IMFIN(CHBUF,NBREAD,X)
-*.===========>
-*.
-*. This routine write input CHBUF in X. If IMFIN=0,
-*. the array X is not fill with NBREAD value, if IMFIN
-*. =1 the array is filled with NBREAD value, if IMFIN
-*. =-1, an errors has occured.
-*.
-*. _Input parameters:
-*.
-*. CHARACTER CHBUF : Character buffer
-*. INTEGER NBREAD : Number of reals to be read
-*. REAL X(N) : Array.
-*.
-*..==========> (O.Couet)
- DIMENSION X(*),IX(16)
- CHARACTER*(*) CHBUF
- SAVE FACT,XMIN
- SAVE IPTR,IX
- DATA IPTR /0/
-*.______________________________________
-*
- IMFIN=0
-*
- IF(NBREAD.EQ.2)THEN
- READ (CHBUF,'(2E16.7)') X(1),X(2)
- IPTR=0
- IMFIN=1
- RETURN
- ENDIF
-*
- IF(IPTR.EQ.0)THEN
- READ (CHBUF,'(2E16.7)',ERR=40) FACT,XMIN
- IF(FACT.LE.0.)THEN
- DO 10 K=1,NBREAD
- X(K)=XMIN
- 10 CONTINUE
- IPTR=0
- IMFIN=1
- ELSE
- IPTR=1
- ENDIF
- RETURN
- ENDIF
- IF(IPTR+15.LE.NBREAD)THEN
- READ (CHBUF,'(16I5)',ERR=40) (IX(I),I=1,16)
- DO 20 I=IPTR,IPTR+15
- X(I)=FACT*IX(I-IPTR+1)+XMIN
- 20 CONTINUE
- IF(IPTR+15.EQ.NBREAD)THEN
- IPTR=0
- IMFIN=1
- RETURN
- ELSE
- IPTR=IPTR+16
- RETURN
- ENDIF
- ELSE
- J=NBREAD-IPTR
- READ (CHBUF,'(16I5)',ERR=40) (IX(I),I=1,J+1)
- DO 30 I=IPTR,IPTR+J
- X(I)=FACT*IX(I-IPTR+1)+XMIN
- 30 CONTINUE
- IPTR=0
- IMFIN=1
- RETURN
- ENDIF
- 40 IMFIN=-1
-*
- END
-#endif
diff --git a/src/graflib/higz/imail/imfout.F b/src/graflib/higz/imail/imfout.F
deleted file mode 100644
index db99816..0000000
--- a/src/graflib/higz/imail/imfout.F
+++ /dev/null
@@ -1,61 +0,0 @@
-*
-* $Id: imfout.F,v 1.1.1.1 1996/02/14 13:11:02 mclareni Exp $
-*
-* $Log: imfout.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:02 mclareni
-* Higz
-*
-*
-#if defined(CERNLIB_MAIL)
-#include "higz/pilot.h"
-*CMZ : 1.09/00 05/12/89 11.55.12 by O.Couet
-*-- Author : O.Couet 30/01/89
- SUBROUTINE IMFOUT(N,X)
-*.===========>
-*.
-*. This routine write a buffer of N floating points
-*. on the std output.
-*.
-*. _Input parameters:
-*.
-*. INTEGER N : Number of floating points.
-*. REAL X(N) : Array.
-*.
-*..==========> (O.Couet)
-#include "higz/himail.inc"
- DIMENSION X(*)
- CHARACTER*8 CHTEMP
-*.______________________________________
-*
- IF(N.EQ.2)THEN
- WRITE (CHMAIL,'(2E16.7)') X(1),X(2)
- CALL IMWRIT(2)
- RETURN
- ENDIF
-*
- XMIN=VMIN(X,N)
- XMAX=VMAX(X,N)
- IF(XMIN.EQ.XMAX)THEN
- FACT=-1.
- ELSE
- FACT=(XMAX-XMIN)/99999.
- ENDIF
- WRITE (CHMAIL,'(2E16.7)') FACT,XMIN
- CALL IMWRIT(2)
- IF(FACT.LE.0.)RETURN
- J=0
- DO 10 I=1,N
- IX=(X(I)-XMIN)/FACT
- WRITE (CHTEMP,'(I5)') IX
- K=(5*J)+1
- CHMAIL(K:K+4)=CHTEMP(1:5)
- J=J+1
- IF(J.EQ.16)THEN
- J=0
- CALL IMWRIT(2)
- ENDIF
- 10 CONTINUE
- IF(J.NE.0)CALL IMWRIT(2)
-*
- END
-#endif
diff --git a/src/graflib/higz/imail/imint.F b/src/graflib/higz/imail/imint.F
deleted file mode 100644
index c513935..0000000
--- a/src/graflib/higz/imail/imint.F
+++ /dev/null
@@ -1,638 +0,0 @@
-*
-* $Id: imint.F,v 1.1.1.1 1996/02/14 13:11:02 mclareni Exp $
-*
-* $Log: imint.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:02 mclareni
-* Higz
-*
-*
-#if defined(CERNLIB_MAIL)
-#include "higz/pilot.h"
-*CMZ : 1.17/00 16/02/93 11.58.28 by O.Couet
-*-- Author : O.Couet 30/01/89
- SUBROUTINE IMINT(CHBUFI,IO)
-*.===========>
-*.
-*. Interface between: TELNET "G" and HIGZ
-*. 3270 "G" and HIGZ
-*.
-*. _Input parameters:
-*.
-*. CHARACTER CHBUFI : Buffer to be interpreted
-*. INTEGER IO : Lenght of the significant characters
-*. in CHBUFI.
-*.
-*. _Output parameters:
-*.
-*. INTEGER IO : =0 Ouput
-*. =1 Input
-*.
-*..==========> (O.Couet)
- PARAMETER (IMEN=50)
- PARAMETER (NWORDS=20000)
- COMMON /PAWC/ H(NWORDS)
-#include "higz/hiques.inc"
-#include "higz/hiatnb.inc"
-#include "higz/hilabs.inc"
-#include "higz/hiflag.inc"
- CHARACTER*80 CHBUFI,CHBUF
- CHARACTER*80 CHARS
- CHARACTER*32 CHOPT
- CHARACTER*32 CHITEM(IMEN),TITLE,CHDEF(IMEN)
- CHARACTER*32 CHVAL(IMEN),CHUSER(IMEN)
- PARAMETER (IBUFSI=10000)
- DIMENSION X(IBUFSI),Y(IBUFSI)
- SAVE CHOPT,CHITEM,TITLE,CHDEF,CHVAL,CHUSER,CHARS
- SAVE X,Y
- SAVE NEWCOD,NT,N,NN,IXREAD,IERR,NX,NY,NYY,NPAR
- SAVE MN,NBU,ICHOIC,IPTR,ICODE,IO2
-#include "higz/hiatnm.inc"
- DATA NEWCOD /1/
- DATA IXREAD /1/
- DATA IERR /0/
- DATA IO2 /0/
-*.______________________________________
-*
- CHBUF=' '
- CHBUF=CHBUFI(1:IO)
-*
-* Errors management
-*
- IF(IERR.EQ.-1)THEN
- IF(CHBUF(1:1).EQ.'%')THEN
- IERR=0
- NEWCOD=1
- ELSE
- GOTO 999
- ENDIF
- ENDIF
-*
-* Read the code of the HIGZ function to be performed
-*
- IO=0
- IF(NEWCOD.NE.0)THEN
- IF(CHBUF(1:1).EQ.'%')THEN
- READ (CHBUF,'(1X,I3)',ERR=2) ICODE
- ELSE
- GOTO 999
- ENDIF
- ENDIF
-*
-* Start with HIGZ
-*
- IF(ICODE.EQ.100)THEN
- READ (CHBUF,'(4X,I5,I10)',ERR=99)IFIL,IWT
- CALL MZEBRA(-3)
- CALL MZPAW(NWORDS,' ')
- CALL IGINIT(100)
- CALL IGSSE(IFIL,IWT)
- CALL IGZSET('G')
- WRITE (CHBUFI,'(2E16.7)') RQUEST(11),RQUEST(12)
- CHBUFI(79:79)=CHAR(13)
- CHBUFI(80:80)=CHAR(10)
- IO=1
- GOTO 999
- ENDIF
-*
-* Clear workstation
-*
- IF(ICODE.EQ.101)THEN
- IF(ZFLAG)THEN
- CALL IZPICT(' ','S')
- CALL IZPICT(' ','M')
- ENDIF
- CALL ICLRWK(0,0)
- GOTO 999
- ENDIF
-*
-* Normalization transformations
-*
- IF(ICODE.EQ.200)THEN
- IF(NEWCOD.NE.0)THEN
- READ (CHBUF,'(4X,I5)',ERR=99) NT
- NEWCOD=0
- IXREAD=1
- ELSE
- IF(IXREAD.EQ.1)THEN
- READ (CHBUF,'(4E16.7)') X(1),X(2),X(3),X(4)
- IXREAD=0
- ELSE
- READ (CHBUF,'(4E16.7)') X(5),X(6),X(7),X(8)
- CALL ISWN(NT,X(1),X(2),X(3),X(4))
- CALL ISVP(NT,X(5),X(6),X(7),X(8))
- CALL ISELNT(NT)
- NEWCOD=1
- ENDIF
- ENDIF
- GOTO 999
- ENDIF
-*
-* IGRNG
-*
- IF(ICODE.EQ.201)THEN
- READ (CHBUF,'(4X,2E16.7)',ERR=99) X(1),Y(1)
- CALL IGRNG(X(1),Y(1))
- WRITE (CHBUFI,'(5E15.6)') RQUEST(11),RQUEST(12),RQUEST(13)
- +, RQUEST(14),RQUEST(15)
- CHBUFI(79:79)=CHAR(13)
- CHBUFI(80:80)=CHAR(10)
- IO=1
- GOTO 999
- ENDIF
-*
-* Request locator
-*
- IF(ICODE.EQ.555)THEN
- READ (CHBUF,'(4X,2I3)',ERR=99) N,NN
- CALL IRQLC(N,NN,ISTAT,NT,XLOC,YLOC)
- WRITE (CHBUFI,'(2I5,2E16.7)') ISTAT,NT,XLOC,YLOC
- CHBUFI(79:79)=CHAR(13)
- CHBUFI(80:80)=CHAR(10)
- IO=1
- GOTO 999
- ENDIF
-*
-* Request string
-*
- IF(ICODE.EQ.556)THEN
- READ (CHBUF,'(4X,2I3)',ERR=99) N,NN
- CALL IRQST(N,NN,ISTAT,L,CHOPT)
- IF(L.GT.78)L=32
- WRITE (CHBUFI,'(2I5,A)') ISTAT,L,CHOPT
- CHBUFI(79:79)=CHAR(13)
- CHBUFI(80:80)=CHAR(10)
- IO=1
- GOTO 999
- ENDIF
-*
-* IGMENU
-*
- IF(ICODE.EQ.557)THEN
- IF(IO2.NE.0)GOTO 5571
- IF(NEWCOD.NE.0)THEN
- READ (CHBUF,'(4X,3I3,I10)',ERR=99) MN,NBU,N,ICHOIC
- NEWCOD=0
- IXREAD=1
- GOTO 999
- ENDIF
- IF(IXREAD.NE.0)THEN
- READ (CHBUF,'(4E16.7,A16)',ERR=99) X(1),X(2)
- +, Y(1),Y(2),CHOPT
- IXREAD=0
- IF(INDEX(CHOPT,'T').EQ.0)THEN
- IPTR=0
- ELSE
- IPTR=1
- TITLE=' '
- ENDIF
- IF(NBU.EQ.0.AND.N.EQ.0)THEN
- IPTR=0
- GOTO 5570
- ENDIF
- GOTO 999
- ENDIF
- IF(IPTR.EQ.0)THEN
- READ (CHBUF,'(A)') TITLE
- IPTR=1
- GOTO 999
- ENDIF
- IF(IPTR.NE.0)THEN
- IF(IPTR.LE.N)THEN
- READ (CHBUF,'(2A32)',ERR=99) CHITEM(IPTR),CHDEF(IPTR)
- IPTR=IPTR+1
- IF(NBU.EQ.0.AND.IPTR.EQ.N+1)THEN
- IPTR=0
- GOTO 5570
- ENDIF
- GOTO 999
- ENDIF
- IF(IPTR.LE.N+NBU)THEN
- READ (CHBUF,'(A)') CHUSER(IPTR-N)
- IPTR=IPTR+1
- IF(IPTR.EQ.N+NBU+1)THEN
- IPTR=0
- GOTO 5570
- ENDIF
- GOTO 999
- ENDIF
- ENDIF
-*
- 5570 CALL IGMENU(MN,TITLE,X(1),X(2),Y(1),Y(2),NBU,CHUSER
- +, N,CHITEM,CHDEF,CHVAL,ICHOIC,CHOPT)
-*
- 5571 IF(INDEX(CHOPT,'C').NE.0)THEN
- IF(IPTR.EQ.0)THEN
- WRITE (CHBUFI,'(I5)') ICHOIC
- CHBUFI(79:79)=CHAR(13)
- CHBUFI(80:80)=CHAR(10)
- IO=1
- IPTR=1
- IF(INDEX(CHOPT,'P').NE.0.AND.N.GT.0)THEN
- IO2=1
- NEWCOD=0
- ELSE
- NEWCOD=1
- ENDIF
- GOTO 999
- ENDIF
- IF(INDEX(CHOPT,'P').NE.0)THEN
- IF(IPTR.NE.0)THEN
- CHBUFI=CHVAL(IPTR)
- CHBUFI(79:79)=CHAR(13)
- CHBUFI(80:80)=CHAR(10)
- IO=1
- IPTR=IPTR+1
- IF(IPTR.GT.N)THEN
- NEWCOD=1
- IO2=0
- ENDIF
- GOTO 999
- ENDIF
- ENDIF
- ENDIF
- IF(INDEX(CHOPT,'I').NE.0)THEN
- CHBUFI=CHVAL(1)
- CHBUFI(79:79)=CHAR(13)
- CHBUFI(80:80)=CHAR(10)
- IO=1
- ENDIF
- NEWCOD=1
- GOTO 999
- ENDIF
-*
-* Set the REDIT factor
-*
- IF(ICODE.EQ.558)THEN
- READ (CHBUF,'(4X,E16.7)',ERR=99) R1
- R2=R1
- CALL IGSRAP(R1)
- IF(R2.LT.0)THEN
- WRITE (CHBUFI,'(E16.7)') R1
- CHBUFI(79:79)=CHAR(13)
- CHBUFI(80:80)=CHAR(10)
- IO=1
- ENDIF
- GOTO 999
- ENDIF
-*
-* IGTERM
-*
- IF(ICODE.EQ.559)THEN
- CALL IGTERM
- GOTO 999
- ENDIF
-*
-* END with HIGZ
-*
- IF(ICODE.EQ.999)THEN
- CALL IGEND
- RETURN
- ENDIF
-*
- GOTO (2,2,2,2,2
- +, 60,70,80,90,100,110,120,130,140,150,160,170,180,190
- +, 200,210,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2
- +, 480,490
- +, 5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5
- +, 8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8
- + ),ICODE
-*
- 2 CONTINUE
- GOTO 999
-*
-* Histograms
-*
- 60 IF(NEWCOD.NE.0)THEN
- READ (CHBUF,'(4X,A10,I5)',ERR=99) CHOPT,N
- NEWCOD=0
- IXREAD=1
- NN=2
- IF(INDEX(CHOPT,'N').NE.0)NN=N+1
- GOTO 999
- ENDIF
- IF(IXREAD.NE.0)THEN
- IERR=IMFIN(CHBUF,NN,X)
- IF(IERR.EQ.-1)GOTO 999
- IF(IERR.EQ.1)THEN
- IXREAD=0
- ENDIF
- GOTO 999
- ELSE
- IERR=IMFIN(CHBUF,N,Y)
- IF(IERR.EQ.-1)GOTO 999
- IF(IERR.EQ.1)THEN
- IXREAD=1
- GOTO 61
- ENDIF
- GOTO 999
- ENDIF
- 61 IF(INDEX(CHOPT,'R').NE.0)THEN
- CALL IGHIST(N,Y,X,CHOPT)
- ELSE
- CALL IGHIST(N,X,Y,CHOPT)
- ENDIF
- NEWCOD=1
- GOTO 999
-*
-* Polymarker with one point
-*
- 70 READ (CHBUF,'(4X,2E16.7)',ERR=99) X(1),Y(1)
- CALL IPM(1,X,Y)
- GOTO 999
-*
-* Polyline with two points
-*
- 80 READ (CHBUF,'(4X,4E16.7)',ERR=99) X(1),X(2),Y(1),Y(2)
- CALL IPL(2,X,Y)
- GOTO 999
-*
-* Polyline
-*
- 90 IF(NEWCOD.NE.0)THEN
- READ (CHBUF,'(4X,I5)',ERR=99) N
- NEWCOD=0
- IXREAD=1
- GOTO 999
- ENDIF
- IF(IXREAD.NE.0)THEN
- IERR=IMFIN(CHBUF,N,X)
- IF(IERR.EQ.-1)GOTO 999
- IF(IERR.EQ.1)THEN
- IXREAD=0
- ENDIF
- GOTO 999
- ELSE
- IERR=IMFIN(CHBUF,N,Y)
- IF(IERR.EQ.-1)GOTO 999
- IF(IERR.EQ.1)THEN
- IXREAD=1
- GOTO 91
- ENDIF
- GOTO 999
- ENDIF
- 91 CALL IPL(N,X,Y)
- NEWCOD=1
- GOTO 999
-*
-* Polymarker
-*
- 100 IF(NEWCOD.NE.0)THEN
- READ (CHBUF,'(4X,I5)',ERR=99) N
- NEWCOD=0
- IXREAD=1
- GOTO 999
- ENDIF
- IF(IXREAD.NE.0)THEN
- IERR=IMFIN(CHBUF,N,X)
- IF(IERR.EQ.-1)GOTO 999
- IF(IERR.EQ.1)THEN
- IXREAD=0
- ENDIF
- GOTO 999
- ELSE
- IERR=IMFIN(CHBUF,N,Y)
- IF(IERR.EQ.-1)GOTO 999
- IF(IERR.EQ.1)THEN
- IXREAD=1
- GOTO 101
- ENDIF
- GOTO 999
- ENDIF
- 101 CALL IPM(N,X,Y)
- NEWCOD=1
- GOTO 999
-*
-* Fill area
-*
- 110 IF(NEWCOD.NE.0)THEN
- READ (CHBUF,'(4X,I5)',ERR=99) N
- NEWCOD=0
- IXREAD=1
- GOTO 999
- ENDIF
- IF(IXREAD.NE.0)THEN
- IERR=IMFIN(CHBUF,N,X)
- IF(IERR.EQ.-1)GOTO 999
- IF(IERR.EQ.1)THEN
- IXREAD=0
- ENDIF
- GOTO 999
- ELSE
- IERR=IMFIN(CHBUF,N,Y)
- IF(IERR.EQ.-1)GOTO 999
- IF(IERR.EQ.1)THEN
- IXREAD=1
- GOTO 111
- ENDIF
- GOTO 999
- ENDIF
- 111 CALL IFA(N,X,Y)
- NEWCOD=1
- GOTO 999
-*
-* Text
-*
- 120 IF(NEWCOD.NE.0)THEN
- READ (CHBUF,'(4X,2E16.7)',ERR=99) X(1),Y(1)
- NEWCOD=0
- GOTO 999
- ELSE
- READ (CHBUF,'(A)',ERR=99) CHARS
- NEWCOD=1
- ENDIF
- CALL ITX(X(1),Y(1),CHARS)
- GOTO 999
-*
-* Box
-*
- 130 READ (CHBUF,'(4X,4E16.7)',ERR=99) X(1),X(2),X(3),X(4)
- CALL IGBOX(X(1),X(2),X(3),X(4))
- GOTO 999
-*
-* Frame box
-*
- 140 IF(NEWCOD.NE.0)THEN
- READ (CHBUF,'(4X,4E16.7)',ERR=99) X(1),X(2),X(3),X(4)
- NEWCOD=0
- GOTO 999
- ELSE
- READ (CHBUF,'(4E16.7)',ERR=99) X(5),X(6),X(7),X(8)
- NEWCOD=1
- ENDIF
- CALL IGFBOX(X(1),X(2),X(3),X(4),X(5),X(6),X(7),X(8))
- GOTO 999
-*
-* Arc
-*
- 150 IF(NEWCOD.NE.0)THEN
- READ (CHBUF,'(4X,4E16.7)',ERR=99) X(1),X(2),X(3),X(4)
- NEWCOD=0
- GOTO 999
- ELSE
- READ (CHBUF,'(2E16.7)',ERR=99) X(5),X(6)
- NEWCOD=1
- ENDIF
- CALL IGARC(X(1),X(2),X(3),X(4),X(5),X(6))
- GOTO 999
-*
-* Axis
-*
- 160 IF(NEWCOD.NE.0)THEN
- READ (CHBUF,'(4X,4E16.7)',ERR=99) X(1),X(2),X(3),X(4)
- NEWCOD=0
- GOTO 999
- ELSE
- READ (CHBUF,'(2E16.7,I10,A10)',ERR=99) X(5),X(6),NDIV,CHOPT
- NEWCOD=1
- ENDIF
- CALL IGAXIS(X(1),X(2),X(3),X(4),X(5),X(6),NDIV,CHOPT)
- GOTO 999
-*
-* Software characters
-*
- 170 IF(NEWCOD.NE.0)THEN
- READ (CHBUF,'(4X,4E16.7,A4)',ERR=99) X(1),X(2),X(3),X(4),CHOPT
- NEWCOD=0
- GOTO 999
- ELSE
- READ (CHBUF,'(A)',ERR=99) CHARS
- NEWCOD=1
- ENDIF
- CALL IGTEXT(X(1),X(2),CHARS,X(3),X(4),CHOPT)
- GOTO 999
-*
-* Multiline
-*
- 180 IF(NEWCOD.NE.0)THEN
- READ (CHBUF,'(4X,I5)',ERR=99) N
- NEWCOD=0
- IXREAD=1
- GOTO 999
- ENDIF
- IF(IXREAD.NE.0)THEN
- IERR=IMFIN(CHBUF,N,X)
- IF(IERR.EQ.-1)GOTO 999
- IF(IERR.EQ.1)THEN
- IXREAD=0
- ENDIF
- GOTO 999
- ELSE
- IERR=IMFIN(CHBUF,N,Y)
- IF(IERR.EQ.-1)GOTO 999
- IF(IERR.EQ.1)THEN
- IXREAD=1
- GOTO 181
- ENDIF
- GOTO 999
- ENDIF
- 181 CALL IML(N,X,Y)
- NEWCOD=1
- GOTO 999
-*
-* Alpha numerique axis labels
-*
- 190 IF(NEWCOD.NE.0)THEN
- READ (CHBUF,'(4X,I5)',ERR=99) NHILAB
- NEWCOD=0
- N=1
- GOTO 999
- ELSE
- READ (CHBUF,'(A)',ERR=99) HILABS(N)
- N=N+1
- IF(N.GT.NHILAB)GOTO 999
- ENDIF
- NEWCOD=1
- GOTO 999
-*
-* Tables
-*
- 200 IF(NEWCOD.NE.0)THEN
- READ (CHBUF,'(4X,A20,3I5)',ERR=99) CHOPT,NX,NY,NPAR
- NYY=MAX(NY,1)
- IF(NX*NY.GT.IBUFSI)THEN
- CALL IGERR('To many data','TELNETG')
- GOTO 99
- ENDIF
- NEWCOD=0
- IXREAD=0
- GOTO 999
- ENDIF
- IF(IXREAD.EQ.0)THEN
- IERR=IMFIN(CHBUF,NPAR,X)
- IF(IERR.EQ.-1)GOTO 999
- IF(IERR.EQ.1)THEN
- IXREAD=1
- ENDIF
- GOTO 999
- ELSE
- READ (CHBUF,'(6G13.7)',ERR=99) (Y((IXREAD-1)*6+I),I=1,6)
- IXREAD=IXREAD+1
- IF(IXREAD*6.GT.NX*NYY)GOTO 201
- GOTO 999
- ENDIF
- 201 CALL IGTABL(NX,NY,Y,NPAR,X,CHOPT)
- NEWCOD=1
- GOTO 999
-*
-* Graphs
-*
- 210 IF(NEWCOD.NE.0)THEN
- READ (CHBUF,'(4X,A10,I5)',ERR=99) CHOPT,N
- NEWCOD=0
- IXREAD=1
- GOTO 999
- ENDIF
- IF(IXREAD.NE.0)THEN
- IERR=IMFIN(CHBUF,NN,X)
- IF(IERR.EQ.-1)GOTO 999
- IF(IERR.EQ.1)THEN
- IXREAD=0
- ENDIF
- GOTO 999
- ELSE
- IERR=IMFIN(CHBUF,N,Y)
- IF(IERR.EQ.-1)GOTO 999
- IF(IERR.EQ.1)THEN
- IXREAD=1
- GOTO 211
- ENDIF
- GOTO 999
- ENDIF
- 211 CALL IGRAPH(N,X,Y,CHOPT)
- NEWCOD=1
- GOTO 999
-*
-*
-* Set color representation
-*
- 480 READ (CHBUF,'(4X,I3,I5,3E16.7)',ERR=99)IWKID,IC,X(1),X(2),X(3)
- CALL ISCR(IDID,IC,X(1),X(2),X(3))
- GOTO 999
-*
-* Set clipping indicator
-*
- 490 READ (CHBUF,'(4X,I2)',ERR=99)ICLSW
- CALL ISCLIP(ICLSW)
- GOTO 999
-*
-* Real attributes
-*
- 5 READ (CHBUF,'(4X,E16.7)',ERR=99) X(1)
- CALL IGSET(CHRATT(ICODE-49),X(1))
- GOTO 999
-*
-* Integer attributes
-*
- 8 READ (CHBUF,'(4X,E16.7)',ERR=99) X(1)
- CALL IGSET(CHIATT(ICODE-79),X(1))
- GOTO 999
-*
-* Read Errors
-*
- 99 CONTINUE
- IERR=-1
- 999 CONTINUE
- CALL IGSA(0)
-*
- END
-#endif
diff --git a/src/graflib/higz/imail/imtek.F b/src/graflib/higz/imail/imtek.F
deleted file mode 100644
index 3b05ae3..0000000
--- a/src/graflib/higz/imail/imtek.F
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: imtek.F,v 1.1.1.1 1996/02/14 13:11:02 mclareni Exp $
-*
-* $Log: imtek.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:02 mclareni
-* Higz
-*
-*
-#if defined(CERNLIB_MAIL)
-#include "higz/pilot.h"
-*CMZ : 1.11/00 07/11/90 11.03.43 by O.Couet
-*-- Author : O.Couet 07/11/90
- SUBROUTINE IMTEK(KCHAR)
- INTEGER*4 KCHAR
- END
-#endif
diff --git a/src/graflib/higz/imail/imwrit.F b/src/graflib/higz/imail/imwrit.F
deleted file mode 100644
index 763bdd4..0000000
--- a/src/graflib/higz/imail/imwrit.F
+++ /dev/null
@@ -1,76 +0,0 @@
-*
-* $Id: imwrit.F,v 1.2 1998/01/30 15:22:42 couet Exp $
-*
-* $Log: imwrit.F,v $
-* Revision 1.2 1998/01/30 15:22:42 couet
-* - APOLLO version removed
-*
-* Revision 1.1.1.1 1996/02/14 13:11:02 mclareni
-* Higz
-*
-*
-#if defined(CERNLIB_MAIL)
-#include "higz/pilot.h"
-*CMZ : 1.14/00 20/02/92 13.58.53 by O.Couet
-*-- Author : O.Couet 13/02/89
- SUBROUTINE IMWRIT(IMC)
-*.===========>
-*.
-*. This routine write CHMAIL on the std output.
-*.
-*. _Input parameters:
-*.
-*. INTEGER IMC : Control, IMC=1 <==> First record
-*. IMC=2 <==> Middle record
-*. IMC=3 <==> Last record
-*. IMC=4 <==> 1+2+3
-*. IMC=5 <==> Only CHCTRL
-*.
-*..==========> (O.Couet)
-#include "higz/himail.inc"
-*.______________________________________
-*
- IF(IMC.EQ.5)THEN
- WRITE (6,10400) CHCTRL
- RETURN
- ENDIF
-*
- IF(IGASCI(CHMAIL(1:1)).LT.32)CHMAIL=' '
- ILEN=LENOCC(CHMAIL)
- IF(ILEN.EQ.0)ILEN=2
-#if (defined(CERNLIB_IBM))&&(!defined(CERNLIB_NEWLIB))
- ICR=IOSCLR()
-#endif
-*
- GOTO(10,20,30,40)IMC
-*
- 10 WRITE (6,10000) CHCTRL,CHEOR,CHMAIL(1:ILEN),CHEOR
- GOTO 50
-*
- 20 WRITE (6,10100) CHEOR,CHMAIL(1:ILEN),CHEOR
- GOTO 50
-*
- 30 WRITE (6,10200) CHEOR,CHMAIL(1:ILEN),CHEOR,CHCTRL
- GOTO 50
-*
- 40 WRITE (6,10300) CHCTRL,CHEOR,CHMAIL(1:ILEN),CHEOR,CHCTRL
-*
- 50 CHMAIL=' '
- RETURN
-*
-#if defined(CERNLIB_UNIX)
-10000 FORMAT(A2,A1,'%',A,A1)
-10100 FORMAT(A1,A,A1)
-10200 FORMAT(A1,A,A1,A2)
-10300 FORMAT(A2,A1,'%',A,A1,A2)
-10400 FORMAT(A2)
-#endif
-#if (!defined(CERNLIB_UNIX))
-10000 FORMAT(1X,A2,A1,'%',A,A1)
-10100 FORMAT(1X,A1,A,A1)
-10200 FORMAT(1X,A1,A,A1,A2)
-10300 FORMAT(1X,A2,A1,'%',A,A1,A2)
-10400 FORMAT(1X,A2)
-#endif
- END
-#endif
diff --git a/src/graflib/higz/imsdos/Imakefile b/src/graflib/higz/imsdos/Imakefile
deleted file mode 100644
index cf774cd..0000000
--- a/src/graflib/higz/imsdos/Imakefile
+++ /dev/null
@@ -1,6 +0,0 @@
-SRCS_F= circf.F circi.F color.F cursof.F draw2i.F icrawl.F \ @@\
- linewi.F mapcol.F marker.F move2i.F outtext.F polf2i.F \ @@\
- poly2i.F sboxfi.F sboxi.F scrmas.F setlin.F setpat.F setpix.F \ @@\
- strwid.F winclo.F winope.F winpop.F winset.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/graflib/higz/imsdos/circf.F b/src/graflib/higz/imsdos/circf.F
deleted file mode 100644
index 6e5231b..0000000
--- a/src/graflib/higz/imsdos/circf.F
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: circf.F,v 1.1.1.1 1996/02/14 13:11:03 mclareni Exp $
-*
-* $Log: circf.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:03 mclareni
-* Higz
-*
-*
-#if defined(CERNLIB_MSDOS)
-#include "higz/pilot.h"
-*CMZ : 1.14/11 29/06/92 13.49.21 by Unknown
-*-- Author : V.Fine
- SUBROUTINE CIRCF(IX,IY,IRAD)
-#include "higz/grex.inc"
- IER = FILLED_ELLIPSE(IX,IY,IRAD,IRAD)
- END
-#endif
diff --git a/src/graflib/higz/imsdos/circi.F b/src/graflib/higz/imsdos/circi.F
deleted file mode 100644
index adb228e..0000000
--- a/src/graflib/higz/imsdos/circi.F
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: circi.F,v 1.1.1.1 1996/02/14 13:11:03 mclareni Exp $
-*
-* $Log: circi.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:03 mclareni
-* Higz
-*
-*
-#if defined(CERNLIB_MSDOS)
-#include "higz/pilot.h"
-*CMZ : 1.14/11 29/06/92 13.49.21 by Unknown
-*-- Author : V.Fine
- SUBROUTINE CIRCI(IX,IY,IRAD)
-#include "higz/grex.inc"
- IER = OPEN_ELLIPSE(IX,IY,IRAD,IRAD)
- END
-#endif
diff --git a/src/graflib/higz/imsdos/color.F b/src/graflib/higz/imsdos/color.F
deleted file mode 100644
index 45ce2c0..0000000
--- a/src/graflib/higz/imsdos/color.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: color.F,v 1.1.1.1 1996/02/14 13:11:03 mclareni Exp $
-*
-* $Log: color.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:03 mclareni
-* Higz
-*
-*
-#if defined(CERNLIB_MSDOS)
-#include "higz/pilot.h"
-*CMZ : 1.14/11 29/06/92 13.49.21 by Unknown
-*-- Author : V.Fine
- SUBROUTINE COLOR(INDEX)
-#include "higz/hikern.inc"
-#include "higz/hiatt.inc"
-#include "higz/himeta.inc"
- I = INDEX
- IF (ILOPWK(IWKNB) .EQ. IDMETA) THEN
- IF (IWTYL(IWKNB) .EQ. ISURF) THEN
- CALL GOLWRI(SP,I,' ')
- END IF
- ELSE
- IER = SET_COLOR(I)
- END IF
- END
-#endif
diff --git a/src/graflib/higz/imsdos/cursof.F b/src/graflib/higz/imsdos/cursof.F
deleted file mode 100644
index c3c31bb..0000000
--- a/src/graflib/higz/imsdos/cursof.F
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: cursof.F,v 1.1.1.1 1996/02/14 13:11:03 mclareni Exp $
-*
-* $Log: cursof.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:03 mclareni
-* Higz
-*
-*
-#if defined(CERNLIB_MSDOS)
-#include "higz/pilot.h"
-*CMZ : 1.14/11 29/06/92 13.49.21 by Unknown
-*-- Author : V.Fine
- SUBROUTINE CURSOF
-#include "higz/grex.inc"
- IER = MOVE_CURSOR(-1,-1)
- END
-#endif
diff --git a/src/graflib/higz/imsdos/draw2i.F b/src/graflib/higz/imsdos/draw2i.F
deleted file mode 100644
index 2032ffa..0000000
--- a/src/graflib/higz/imsdos/draw2i.F
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: draw2i.F,v 1.1.1.1 1996/02/14 13:11:03 mclareni Exp $
-*
-* $Log: draw2i.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:03 mclareni
-* Higz
-*
-*
-#if defined(CERNLIB_MSDOS)
-#include "higz/pilot.h"
-*CMZ : 1.14/11 29/06/92 13.49.21 by Unknown
-*-- Author : V.Fine
- SUBROUTINE DRAW2I(IX,IY)
-#include "higz/hikern.inc"
-#include "higz/hiatt.inc"
-#include "higz/himeta.inc"
- IF (ILOPWK(IWKNB) .EQ. IDMETA) THEN
- IXSAVE(IWKNB) = IX
- IYSAVE(IWKNB) = IY
- IF (IWTYL(IWKNB) .EQ. ISURF) THEN
- COOR(1) = IX
- COOR(2) = YWKSIZ(IWKNB)-IY
- CALL GOLWRI(PA,COOR,' ')
- END IF
- ELSE
- IER = DRAW(IX,IY)
- END IF
- END
-#endif
diff --git a/src/graflib/higz/imsdos/icrawl.F b/src/graflib/higz/imsdos/icrawl.F
deleted file mode 100644
index 21085cf..0000000
--- a/src/graflib/higz/imsdos/icrawl.F
+++ /dev/null
@@ -1,183 +0,0 @@
-*
-* $Id: icrawl.F,v 1.1.1.1 1996/02/14 13:11:03 mclareni Exp $
-*
-* $Log: icrawl.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:03 mclareni
-* Higz
-*
-*
-#if defined(CERNLIB_MSDOS)
-#include "higz/pilot.h"
-#if defined(CERNLIB_NDP)
-*CMZ : 1.14/11 29/06/92 13.51.08 by Unknown
-*-- Author : V.Fine
- FUNCTION ICRAWL(X,Y)
-*.
-*... CHANGE POSITION OF THE CURSOR
-*.
-*.. INPUT:
-*. -----
-*. X, Y - INITIAL POSITION
-*.
-*.. OUTPUT:
-*. ------
-*. X, Y - NEW POSITION
-*. ICRAWL = 10*XFLAG + YFLAG
-*. XFLAG = 1 - X POSITION HAVE BEEN CHANGED
-*. YFLAG = 1 - Y POSITION HAVE BEEN CHANGED
-*. = -1 KEY "ESC" HAVE BEEN PRESSED OR LEFT BUTTON
-*. = 0 KEY "ENTER" HAVE BEEN PRESSED OR RIGHT BUTTON
-#include "higz/hikern.inc"
- INTEGER XMIN,YMIN,XMAX,YMAX,X,Y, CTRL_C, ESC, ENTER
- PARAMETER (CTRL_C=3, ESC=27, RETKEY=13)
- INTEGER K
-*
- LOGICAL SAMPLE
- LOGICAL MIDPR,LEFTPR,RIGHTPR
- SAVE MIDPR,LEFTPR,RIGHTPR
- DATA MIDPR,LEFTPR,RIGHTPR /3*.true./
-*
- IER = GET_CLIP_LIMITS(XMIN,YMIN,XMAX,YMAX)
-
- ICRAWL = 0
- 10 IF (MOUSE) THEN
- IBUT = 0
- CALL GET_MOUSE(IBUT,IX,IY)
- IF (IX .NE. X) THEN
- IF(IX.GT.XMAX) IX = XMIN
- if(IX.lt.xmin) IX = xmax
- icrawl = icrawl + 10
- END IF
-
- IF (IY .NE. Y) THEN
- IF(IY.GT.YMAX) IY = YMIN
- IF(IY.LT.YMIN) IY = YMAX
- icrawl = icrawl + 1
- END IF
-
- IF (ICRAWL .EQ. 0 .AND. IBUT .EQ. 0) then
- MIDPR = .TRUE.
- LEFTPR = .TRUE.
- RIGHTPR = .TRUE.
- GO TO 70
- END IF
- IF (IBUT .GT. 0) THEN
- GO TO (30,20,40,50),IBUT
- 20 CONTINUE
-*--
-*-- LEFT BUTTON ARE PRESSING
-*
- IF (.NOT.LEFTPR) GO TO 70
- MIDPR = .TRUE.
- RIGHTPR = .TRUE.
- LEFTPR = .NOT. LEFTPR
- ICRAWL = IBUT - 2
- GO TO 60
- 30 CONTINUE
-*--
-*-- RIGHT BUTTON ARE PRESSING
-*
- IF (.NOT.RIGHTPR) GO TO 70
- MIDPR = .TRUE.
- LEFTPR = .TRUE.
- RIGHTPR = .NOT. RIGHTPR
- ICRAWL = IBUT - 2
- GO TO 60
- 40 CONTINUE
-*--
-*-- MIDDLE BUTTON ARE PRESSING
-*
- 50 CONTINUE
- IF (.NOT.MIDPR) GO TO 70
- RIGHTPR = .TRUE.
- LEFTPR = .TRUE.
- MIDPR = .NOT. MIDPR
- ICRAWL = IBUT - 2
- ELSE
- MIDPR = .TRUE.
- LEFTPR = .TRUE.
- RIGHTPR = .TRUE.
- Y = IY
- X = IX
- CALL SET_MOUSE(X,Y)
- END IF
- 60 CONTINUE
- GO TO 80
- END IF
- 70 CONTINUE
- K = INKEY$()
- IF (K .EQ. 0) GO TO 10
- IF (K .EQ. CTRL_C) THEN
- CALL IGEND
- CALL ABEND
- END IF
- IF(K.LT.0) THEN
- K = -K
- IF(K.EQ.83) THEN
-*--
-*-- [DEL] KEY have been pressed
-*-- to decrease the speed of cursor
-*
- ISTEP = ISTEP-1
- ISTEP = MAX0(ISTEP,1)
- IF (MOUSE) THEN
- IRAT = 64/ISTEP + 1
- CALL SET_MP_RATIO(IRAT,IRAT)
- END IF
- GO TO 10
- END IF
-*
- IF(K.EQ.82) THEN
-*--
-*-- [INS] KEY have been pressed
-*-- to increase the speed of cursor
-*
- ISTEP = ISTEP+1
- ISTEP = MIN0(ISTEP,100)
- IF (MOUSE) THEN
- IRAT = 64/ISTEP + 1
- CALL SET_MP_RATIO(IRAT,IRAT)
- END IF
- GO TO 10
- END IF
-*
- IF(K.LT.71.OR.K.GT.81) GO TO 10
-*--
-*-- Arrow keys have been pressed
-*
-*
-* Y MOTION
-*
- IF(K.EQ.71.OR.K.EQ.72.OR.K.EQ.73) THEN
- Y = Y - ISTEP
- ICRAWL = ICRAWL + 1
- ELSE IF(K.EQ.79.OR.K.EQ.80.OR.K.EQ.81) THEN
- Y = Y + ISTEP
- ICRAWL = ICRAWL + 1
- END IF
-*
-* X MOTION
-*
- IF(K.EQ.71.OR.K.EQ.75.OR.K.EQ.79) THEN
- X = X - ISTEP
- ICRAWL = ICRAWL + 10
- ELSE IF(K.EQ.73.OR.K.EQ.77.OR.K.EQ.81) THEN
- X = X + ISTEP
- ICRAWL = ICRAWL + 10
- END IF
- IF(X.LT.XMIN) X = XMAX
- IF(Y.LT.YMIN) Y = YMAX
- IF(X.GT.XMAX) X = XMIN
- IF(Y.GT.YMAX) Y = YMIN
- IF (MOUSE) CALL SET_MOUSE(X,Y)
- ELSE IF (K .EQ. ESC) THEN
- ICRAWL = -1
- ELSE IF (K .EQ. RETKEY) THEN
- ICRAWL = 0
- ELSE
- GO TO 10
- END IF
- 80 RETURN
- END
-#endif
-#endif
diff --git a/src/graflib/higz/imsdos/linewi.F b/src/graflib/higz/imsdos/linewi.F
deleted file mode 100644
index cba1ea0..0000000
--- a/src/graflib/higz/imsdos/linewi.F
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: linewi.F,v 1.1.1.1 1996/02/14 13:11:03 mclareni Exp $
-*
-* $Log: linewi.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:03 mclareni
-* Higz
-*
-*
-#if defined(CERNLIB_MSDOS)
-#include "higz/pilot.h"
-#if defined(CERNLIB_NDP)
-*CMZ : 1.14/11 29/06/92 13.49.21 by Unknown
-*-- Author : V.Fine
- SUBROUTINE LINEWI(LWSC)
- END
-#endif
-#endif
diff --git a/src/graflib/higz/imsdos/mapcol.F b/src/graflib/higz/imsdos/mapcol.F
deleted file mode 100644
index 0166329..0000000
--- a/src/graflib/higz/imsdos/mapcol.F
+++ /dev/null
@@ -1,40 +0,0 @@
-*
-* $Id: mapcol.F,v 1.1.1.1 1996/02/14 13:11:03 mclareni Exp $
-*
-* $Log: mapcol.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:03 mclareni
-* Higz
-*
-*
-#if defined(CERNLIB_MSDOS)
-#include "higz/pilot.h"
-*CMZ : 1.16/07 26/11/92 11.37.03 by O.Couet
-*-- Author : V.Fine
- SUBROUTINE MAPCOL(ICI,RED,GREEN,BLUE)
-#include "higz/hikern.inc"
-#include "higz/hiatt.inc"
- PARAMETER (IVGA = 18)
-
- if (ICI .gt. INBCOL) return
- IRED = MIN(NINT(RED*3),3)
- IGREEN= MIN(NINT(GREEN*3),3)
- IBLUE = MIN(NINT(BLUE*3),3)
- IIIC = ISHFT(IAND(IRED,2),4)+ISHFT(IAND(IRED,1),2)
- IIIC2= ISHFT(IAND(IGREEN,2),3)+ISHFT(IAND(IGREEN,1),1)
- IIIC = IOR(IIIC,IIIC2)
- IIIC2= ISHFT(IAND(IBLUE,2),2)+JBIT(IBLUE,1)
- IIIC = IOR(IIIC,IIIC2)
- IF (IWTYL(Icurwk) .LT. IVGA) THEN
- CALL DEFINE_COLOR(ICI,IIIC)
- PAL(ICI+1) = CHAR(IIIC)
- ELSE
-** IER = SET_PALETTE(PAL)
- IRED = NINT(RED*63)
- IGREEN = NINT(GREEN*63)
- IBLUE = NINT(BLUE*63)
- CALL DEFINE_COLOR(ICI,ICI+IOFCOL)
- PAL(ICI+1) = CHAR(ICI+IOFCOL)
- CALL VGA_PALETTE(ICI+IOFCOL,IRED,IGREEN,IBLUE)
- END IF
- END
-#endif
diff --git a/src/graflib/higz/imsdos/marker.F b/src/graflib/higz/imsdos/marker.F
deleted file mode 100644
index 74b648b..0000000
--- a/src/graflib/higz/imsdos/marker.F
+++ /dev/null
@@ -1,77 +0,0 @@
-*
-* $Id: marker.F,v 1.1.1.1 1996/02/14 13:11:03 mclareni Exp $
-*
-* $Log: marker.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:03 mclareni
-* Higz
-*
-*
-#if defined(CERNLIB_MSDOS)
-#include "higz/pilot.h"
-*CMZ : 1.14/11 29/06/92 13.49.21 by Unknown
-*-- Author : V.Fine
- SUBROUTINE MARKER(N,X,Y)
-#include "higz/hiatt.inc"
-#include "higz/hikern.inc"
-#include "higz/himeta.inc"
- DIMENSION X(N),Y(N)
-C--
-C-- Corresponing between marker type and it code into centered.sym
-C
- DIMENSION IPLMTP(5)
- DATA IPLMTP / 59, 39, 41, 33, 40/
-*
-#include "higz/hiwcdc.inc"
-C
- IF (IMK .EQ. 1) THEN
- DO 10 I=1,N
- IXX = IXWCDC(X(I))
- IYY = IYWCDC(Y(I))
- CALL SETPIX(IXX,IYY)
- 10 CONTINUE
- ELSE
- IS = IWKNB
- NTSAV = INTR
- CALL ISELNT(0)
- IWKNB = IS
- ISF = IXWCDC(RMKSC*0.009)
- CALL ISELNT(NTSAV)
- IWKNB = IS
- IF (ILOPWK(IWKNB) .EQ. IDMETA) THEN
- IF (IWTYL(IWKNB) .EQ. ISURF) THEN
- CALL GOLWRI(SS,0,'CENTERED.SYM')
- DO 20 I=1,N
- COOR(1) = FLOAT(IXWCDC(X(I)))
- COOR(2) = YWKSIZ(IWKNB)-IYWCDC(Y(I))
- COOR(3) = FLOAT(ISF)
- COOR(4) = 0.0
- IF (IMK .LE. 5) THEN
- CALL GOLWRI(PS,COOR,CHAR(IPLMTP(IMK)))
- ELSE
- CALL GOLWRI(PS,COOR,CHAR(IMK+31))
- END IF
- 20 CONTINUE
- CALL GOLWRI(SS,0,SYMFIL)
- END IF
- ELSE
- ISF = ISF/2
- DO 80 I=1,N
- IXX = IXWCDC(X(I))
- IYY = IYWCDC(Y(I))
- GO TO (30,40,50,60),MOD(IMK-1,4)+1
- 30 CALL SBOXI(IXX-ISF,IYY-ISF,IXX+ISF,IYY+ISF)
- GOTO 70
- 40 CALL SBOXFI(IXX-ISF,IYY-ISF,IXX+ISF,IYY+ISF)
- GOTO 70
- 50 CALL CIRCI(IXX,IYY,ISF)
- GOTO 70
- 60 CALL CIRCF(IXX,IYY,ISF)
- 70 CONTINUE
- 80 CONTINUE
- IXSAVE(IWKNB) = IXX
- IYSAVE(IWKNB) = IYY
- END IF
- IWKNB = IS
- END IF
- END
-#endif
diff --git a/src/graflib/higz/imsdos/move2i.F b/src/graflib/higz/imsdos/move2i.F
deleted file mode 100644
index 2657ba8..0000000
--- a/src/graflib/higz/imsdos/move2i.F
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: move2i.F,v 1.1.1.1 1996/02/14 13:11:03 mclareni Exp $
-*
-* $Log: move2i.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:03 mclareni
-* Higz
-*
-*
-#if defined(CERNLIB_MSDOS)
-#include "higz/pilot.h"
-*CMZ : 1.14/11 29/06/92 13.49.21 by Unknown
-*-- Author : V.Fine
- SUBROUTINE MOVE2I(IX,IY)
-#include "higz/hikern.inc"
-#include "higz/hiatt.inc"
-#include "higz/himeta.inc"
-*
- IF (ILOPWK(IWKNB) .EQ. IDMETA) THEN
- IF (IX .NE. IXSAVE(IWKNB) .OR. IY .NE. IYSAVE(IWKNB)) THEN
- IXSAVE(IWKNB) = IX
- IYSAVE(IWKNB) = IY
- IF (IWTYL(IWKNB).EQ. ISURF) THEN
- COOR(1) = IX
- COOR(2) = (YWKSIZ(IWKNB)-IY)
- CALL GOLWRI(MA,COOR,' ')
- END IF
- END IF
- ELSE
- IER = MOVE(IX,IY)
- END IF
- END
-#endif
diff --git a/src/graflib/higz/imsdos/outtext.F b/src/graflib/higz/imsdos/outtext.F
deleted file mode 100644
index f690cdf..0000000
--- a/src/graflib/higz/imsdos/outtext.F
+++ /dev/null
@@ -1,35 +0,0 @@
-*
-* $Id: outtext.F,v 1.1.1.1 1996/02/14 13:11:04 mclareni Exp $
-*
-* $Log: outtext.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:04 mclareni
-* Higz
-*
-*
-#if defined(CERNLIB_MSDOS)
-#include "higz/pilot.h"
-*CMZ : 1.14/11 29/06/92 13.49.21 by Unknown
-*-- Author : V.Fine
- SUBROUTINE OUT_TEXT(CHARS,IX,IY,ICOLOR)
-#include "higz/hiatt.inc"
-#include "higz/hikern.inc"
-#include "higz/himeta.inc"
- CHARACTER CHARS*(*)
-*
-#include "higz/hiwcdc.inc"
- IF (ILOPWK(IWKNB) .EQ. IDMETA) THEN
- IF (IWTYL(IWKNB) .EQ. ISURF) THEN
- COOR(1) = IX
- COOR(2) = YWKSIZ(IWKNB)-IY
- COOR(3) = YWKSIZ(IWKNB) - IYWCDC(RCHH)
- COOR(4) = RANGLE
- CALL GOLWRI(PS,COOR,CHARS)
- END IF
- ELSE
- IHHH = STRWID(CHARS,1)
- IER = GRAPHIC_TEXT(CHARS,IX,IY -IHHH+1,ICOLOR)
- END IF
- IXSAVE(IWKNB) = -1
- IYSAVE(IWKNB) = -1
- END
-#endif
diff --git a/src/graflib/higz/imsdos/polf2i.F b/src/graflib/higz/imsdos/polf2i.F
deleted file mode 100644
index 37d5154..0000000
--- a/src/graflib/higz/imsdos/polf2i.F
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: polf2i.F,v 1.1.1.1 1996/02/14 13:11:04 mclareni Exp $
-*
-* $Log: polf2i.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:04 mclareni
-* Higz
-*
-*
-#if defined(CERNLIB_MSDOS)
-#include "higz/pilot.h"
-*CMZ : 1.14/11 29/06/92 13.49.21 by Unknown
-*-- Author : V.Fine
- SUBROUTINE POLF2I(N,IXY)
-*.
-*. by Fine V. from LCTA JINR (fine at main2.jinr.dubna.su)
-*. (based on IGHATC)
-*.
- INTEGER IXY(N,2)
-*.___________________________________________
-*
-#include "higz/hikern.inc"
-#include "higz/hiatt.inc"
- INTEGER IXY(IBUFSI,2)
- III =IFACI+IOFCOL
-#if defined(CERNLIB_NDP)
- IER = POLYFILL (IXY(1,1),IXY(1,2),N,III, III)
-#endif
-#if !defined(CERNLIB_NDP)
- IER = POLFIL (IXY,N,III, III)
-#endif
- END
-#endif
diff --git a/src/graflib/higz/imsdos/poly2i.F b/src/graflib/higz/imsdos/poly2i.F
deleted file mode 100644
index 8d514b8..0000000
--- a/src/graflib/higz/imsdos/poly2i.F
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: poly2i.F,v 1.1.1.1 1996/02/14 13:11:04 mclareni Exp $
-*
-* $Log: poly2i.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:04 mclareni
-* Higz
-*
-*
-#if defined(CERNLIB_MSDOS)
-#include "higz/pilot.h"
-*CMZ : 1.14/11 29/06/92 13.49.21 by Unknown
-*-- Author : V.Fine
- SUBROUTINE POLY2I(N,IPOS)
-#if defined(CERNLIB_NDP)
- DIMENSION IPOS(1000,2)
- IF (N .GT. 0) THEN
- IF (N .EQ. 1) THEN
- CALL SETPIX(IPOS(1,1),IPOS(1,2))
- ELSE
- CALL MOVE2I(IPOS(1,1),IPOS(1,2))
- DO 10 I=2,N
- CALL DRAW2I(IPOS(I,1),IPOS(I,2))
- 10 CONTINUE
- IF (N .GT. 2) CALL DRAW2I(IPOS(1,1),IPOS(1,2))
-#endif
-#if !defined(CERNLIB_NDP)
- DIMENSION IPOS(2,1000)
- IF (N .GT. 0) THEN
- IF (N .EQ. 1) THEN
- CALL SETPIX(IPOS(1,1),IPOS(2,1))
- ELSE
- CALL MOVE2I(IPOS(1,1),IPOS(2,1))
- DO 10 I=2,N
- CALL DRAW2I(IPOS(1,I),IPOS(2,I))
- 10 CONTINUE
- IF (N .GT. 2) CALL DRAW2I(IPOS(1,1),IPOS(2,1))
-#endif
- END IF
- END IF
- END
-#endif
diff --git a/src/graflib/higz/imsdos/sboxfi.F b/src/graflib/higz/imsdos/sboxfi.F
deleted file mode 100644
index 5648227..0000000
--- a/src/graflib/higz/imsdos/sboxfi.F
+++ /dev/null
@@ -1,48 +0,0 @@
-*
-* $Id: sboxfi.F,v 1.1.1.1 1996/02/14 13:11:04 mclareni Exp $
-*
-* $Log: sboxfi.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:04 mclareni
-* Higz
-*
-*
-#if defined(CERNLIB_MSDOS)
-#include "higz/pilot.h"
-*CMZ : 1.14/11 29/06/92 13.49.21 by Unknown
-*-- Author : V.Fine
- SUBROUTINE SBOXFI(IX1,IY1,IX2,IY2)
-#include "higz/hikern.inc"
-#include "higz/hiatt.inc"
-#include "higz/himeta.inc"
- DIMENSION IBX(2,4)
- IF (ILOPWK(IWKNB) .EQ. IDMETA) THEN
- IF (IWTYL(IWKNB).EQ. ISURF) THEN
- IBX(2,1) = IX1
- IBX(2,1) = IX2
- IBX(3,1) = IX2
- IBX(4,1) = IX1
- IBX(1,2) = IY1
- IBX(2,2) = IY1
- IBX(3,2) = IY2
- IBX(4,2) = IY2
- IDX = IABS(IX2-IX1)
- IDY = IABS(IY2-IY1)
- IF (IDX .GT. IDY) THEN
- IFY = MIN(IY1,IY2)-1
- DO 10 I=1,IDY
- CALL MOVE2I(IX1,IFY+I)
- CALL DRAW2I(IX2,IFY+I)
- 10 CONTINUE
- ELSE
- IFX = MIN(IX1,IX2)-1
- DO 20 I=1,IDX
- CALL MOVE2I(IFX+I,IY1)
- CALL DRAW2I(IFX+1,IY2)
- 20 CONTINUE
- END IF
- END IF
- ELSE
- IER = FILLED_RECTANGLE(IX1,IY2,IX2,IY1)
- END IF
- END
-#endif
diff --git a/src/graflib/higz/imsdos/sboxi.F b/src/graflib/higz/imsdos/sboxi.F
deleted file mode 100644
index cb908ca..0000000
--- a/src/graflib/higz/imsdos/sboxi.F
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: sboxi.F,v 1.1.1.1 1996/02/14 13:11:04 mclareni Exp $
-*
-* $Log: sboxi.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:04 mclareni
-* Higz
-*
-*
-#if defined(CERNLIB_MSDOS)
-#include "higz/pilot.h"
-*CMZ : 1.14/11 29/06/92 13.49.21 by Unknown
-*-- Author : V.Fine
- SUBROUTINE SBOXI(IX1,IY1,IX2,IY2)
-#include "higz/hiatt.inc"
- CALL SETLIN(1)
- CALL MOVE2I(IX1,IY1)
- CALL DRAW2I(IX2,IY1)
- CALL DRAW2I(IX2,IY2)
- CALL DRAW2I(IX1,IY2)
- CALL DRAW2I(IX1,IY1)
- CALL SETLIN(ILN)
- END
-#endif
diff --git a/src/graflib/higz/imsdos/scrmas.F b/src/graflib/higz/imsdos/scrmas.F
deleted file mode 100644
index 4f9c4a8..0000000
--- a/src/graflib/higz/imsdos/scrmas.F
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: scrmas.F,v 1.1.1.1 1996/02/14 13:11:04 mclareni Exp $
-*
-* $Log: scrmas.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:04 mclareni
-* Higz
-*
-*
-#if defined(CERNLIB_MSDOS)
-#include "higz/pilot.h"
-*CMZ : 1.14/11 29/06/92 13.49.21 by Unknown
-*-- Author : V.Fine
- SUBROUTINE SCRMAS(IX1,IX2,IY2,IY1)
-#include "higz/hikern.inc"
-#include "higz/hiatt.inc"
-#include "higz/grex.inc"
- IYMIN = IY1 - 1
- IYMAX = IY2 + 1
- IXMIN = IX1 - 1
- IXMAX = IX2 + 1
- IYMIN = MAX(0,IYMIN)
- IXMIN = MAX(0,IXMIN)
- IYMAX = MIN(INT(YWKSIZ(IWKNB))-1,IYMAX)
- IXMAX = MIN(INT(XWKSIZ(IWKNB))-1,IXMAX)
- IER = SET_CLIP_LIMITS(IXMIN,IYMIN,IXMAX,IYMAX)
- END
-#endif
diff --git a/src/graflib/higz/imsdos/setlin.F b/src/graflib/higz/imsdos/setlin.F
deleted file mode 100644
index aadb1cc..0000000
--- a/src/graflib/higz/imsdos/setlin.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: setlin.F,v 1.1.1.1 1996/02/14 13:11:04 mclareni Exp $
-*
-* $Log: setlin.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:04 mclareni
-* Higz
-*
-*
-#if defined(CERNLIB_MSDOS)
-#include "higz/pilot.h"
-*CMZ : 1.14/11 29/06/92 13.49.21 by Unknown
-*-- Author : V.Fine
- SUBROUTINE SETLIN(ILIN)
-#include "higz/hikern.inc"
-#include "higz/hiatt.inc"
-#include "higz/himeta.inc"
- I = ILIN
- IF (I .LE. 0) I = 1
- IF (ILOPWK(IWKNB) .EQ. IDMETA) THEN
- IF (IWTYL(IWKNB) .EQ. ISURF) THEN
- END IF
- ELSE
- IER = SET_DASH(DASH_PATTERN(ILN))
- END IF
- END
-#endif
diff --git a/src/graflib/higz/imsdos/setpat.F b/src/graflib/higz/imsdos/setpat.F
deleted file mode 100644
index f6158e2..0000000
--- a/src/graflib/higz/imsdos/setpat.F
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: setpat.F,v 1.1.1.1 1996/02/14 13:11:05 mclareni Exp $
-*
-* $Log: setpat.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:05 mclareni
-* Higz
-*
-*
-#if defined(CERNLIB_MSDOS)
-#include "higz/pilot.h"
-#if defined(CERNLIB_NDP)
-*CMZ : 1.14/11 29/06/92 13.49.21 by Unknown
-*-- Author : V.Fine
- SUBROUTINE SETPAT(IFASI)
- END
-#endif
-#endif
diff --git a/src/graflib/higz/imsdos/setpix.F b/src/graflib/higz/imsdos/setpix.F
deleted file mode 100644
index 3968f0f..0000000
--- a/src/graflib/higz/imsdos/setpix.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: setpix.F,v 1.1.1.1 1996/02/14 13:11:05 mclareni Exp $
-*
-* $Log: setpix.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:05 mclareni
-* Higz
-*
-*
-#if defined(CERNLIB_MSDOS)
-#include "higz/pilot.h"
-*CMZ : 1.14/11 29/06/92 13.49.21 by Unknown
-*-- Author : V.Fine
- SUBROUTINE SETPIX(IX,IY)
-#include "higz/hikern.inc"
-#include "higz/hiatt.inc"
-#include "higz/himeta.inc"
- IF (ILOPWK(IWKNB) .EQ. IDMETA) THEN
- IF (IWTYL(IWKNB) .EQ. ISURF) THEN
- CALL MOVE2I(IX,IY)
- CALL DRAW2I(IX,IY)
- END IF
- ELSE
- IER = SET_PIXEL(IX,IY)
- IXSAVE(IWKNB) = IX
- IYSAVE(IWKNB) = IY
- END IF
- END
-#endif
diff --git a/src/graflib/higz/imsdos/strwid.F b/src/graflib/higz/imsdos/strwid.F
deleted file mode 100644
index b0ddfdb..0000000
--- a/src/graflib/higz/imsdos/strwid.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: strwid.F,v 1.1.1.1 1996/02/14 13:11:05 mclareni Exp $
-*
-* $Log: strwid.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:05 mclareni
-* Higz
-*
-*
-#if defined(CERNLIB_MSDOS)
-#include "higz/pilot.h"
-*CMZ : 1.14/11 29/06/92 13.49.21 by Unknown
-*-- Author : V.Fine
- FUNCTION STRWID(CH,LCH)
-#include "higz/hiatt.inc"
-#include "higz/hikern.inc"
-#include "higz/himeta.inc"
- CHARACTER*(*) CH
-#include "higz/hiwcdc.inc"
- IF (ILOPWK(IWKNB) .EQ. IDMETA) THEN
- IF (IWTYL(IWKNB) .EQ. ISURF) THEN
- CALL IGTEXT(0.0,0.0,CH(:LCH),RCHH,A,'S')
- STRWID = IXWCDC(A)
- END IF
- ELSE
- STRWID = 8*MAG_X*lch-1
- END IF
- END
-#endif
diff --git a/src/graflib/higz/imsdos/winclo.F b/src/graflib/higz/imsdos/winclo.F
deleted file mode 100644
index 731a18c..0000000
--- a/src/graflib/higz/imsdos/winclo.F
+++ /dev/null
@@ -1,15 +0,0 @@
-*
-* $Id: winclo.F,v 1.1.1.1 1996/02/14 13:11:05 mclareni Exp $
-*
-* $Log: winclo.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:05 mclareni
-* Higz
-*
-*
-#if defined(CERNLIB_MSDOS)
-#include "higz/pilot.h"
-*CMZ : 1.14/11 29/06/92 13.49.21 by Unknown
-*-- Author : V.Fine
- SUBROUTINE WINCLO(IDUMMY)
- END
-#endif
diff --git a/src/graflib/higz/imsdos/winope.F b/src/graflib/higz/imsdos/winope.F
deleted file mode 100644
index cb55c74..0000000
--- a/src/graflib/higz/imsdos/winope.F
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: winope.F,v 1.1.1.1 1996/02/14 13:11:05 mclareni Exp $
-*
-* $Log: winope.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:05 mclareni
-* Higz
-*
-*
-#if defined(CERNLIB_MSDOS)
-#include "higz/pilot.h"
-*CMZ : 1.14/11 29/06/92 13.49.21 by Unknown
-*-- Author : V.Fine
- SUBROUTINE WINOPE(I,J)
- CHARACTER I
- END
-#endif
diff --git a/src/graflib/higz/imsdos/winpop.F b/src/graflib/higz/imsdos/winpop.F
deleted file mode 100644
index 8f473d5..0000000
--- a/src/graflib/higz/imsdos/winpop.F
+++ /dev/null
@@ -1,15 +0,0 @@
-*
-* $Id: winpop.F,v 1.1.1.1 1996/02/14 13:11:05 mclareni Exp $
-*
-* $Log: winpop.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:05 mclareni
-* Higz
-*
-*
-#if defined(CERNLIB_MSDOS)
-#include "higz/pilot.h"
-*CMZ : 1.14/11 29/06/92 13.49.21 by Unknown
-*-- Author : V.Fine
- SUBROUTINE WINPOP
- END
-#endif
diff --git a/src/graflib/higz/imsdos/winset.F b/src/graflib/higz/imsdos/winset.F
deleted file mode 100644
index ab9e5ea..0000000
--- a/src/graflib/higz/imsdos/winset.F
+++ /dev/null
@@ -1,15 +0,0 @@
-*
-* $Id: winset.F,v 1.1.1.1 1996/02/14 13:11:06 mclareni Exp $
-*
-* $Log: winset.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:06 mclareni
-* Higz
-*
-*
-#if defined(CERNLIB_MSDOS)
-#include "higz/pilot.h"
-*CMZ : 1.14/11 29/06/92 13.49.21 by Unknown
-*-- Author : V.Fine
- SUBROUTINE WINSET(IWINID)
- END
-#endif
diff --git a/src/graflib/higz/ipost/Imakefile b/src/graflib/higz/ipost/Imakefile
deleted file mode 100644
index b66845d..0000000
--- a/src/graflib/higz/ipost/Imakefile
+++ /dev/null
@@ -1,10 +0,0 @@
-SRCS_F= ipdef.F ipdlin.F ipdraw.F ipend.F ipfon.F ipfout.F \ @@\
- ipinit.F ipiout.F ipjout.F ipltyp.F iplwid.F ipmark.F ipmove.F \ @@\
- ipdpat.F ippstr.F iprng.F ipscol.F ipspec.F ipsvrt.F iptext.F \ @@\
- iptlin.F iptmac.F ipttex.F ipzone.F ipkout.F
-
-#ifdef CERNLIB_QMVAOS
-SpecialFortranLibObjectRule(iptext,iptext,FortranNoSaveFlags,NullParameter)
-#endif
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/graflib/higz/ipost/Imakefile.dgks b/src/graflib/higz/ipost/Imakefile.dgks
deleted file mode 100644
index ffadad3..0000000
--- a/src/graflib/higz/ipost/Imakefile.dgks
+++ /dev/null
@@ -1,14 +0,0 @@
-SRCS_F= ipdef.F ipdlin.F ipdraw.F ipend.F ipfon.F ipfout.F \ @@\
- ipinit.F ipiout.F ipjout.F ipltyp.F iplwid.F ipmark.F ipmove.F \ @@\
- ippatt.F ippstr.F iprng.F ipscol.F ipspec.F ipsvrt.F iptext.F \ @@\
- iptlin.F iptmac.F ipttex.F ipzone.F
-
-#ifdef CERNLIB_QMVAOS
-SpecialFortranLibObjectRule(iptext,iptext,FortranNoSaveFlags,NullParameter)
-#endif
-
-SubdirExtraLibraryTarget(NullParameter,NullParameter,NullParameter,dgks)
-
-VersionFortranObjectRule(dgks,NullParameter,-DCERNLIB_DECGKS)
-
-BuildNamedMakefileTarget(Makefile.dgks,Imakefile.dgks,-DCERNLIB_DECGKS)
diff --git a/src/graflib/higz/ipost/ipdef.F b/src/graflib/higz/ipost/ipdef.F
deleted file mode 100644
index 5c19aa2..0000000
--- a/src/graflib/higz/ipost/ipdef.F
+++ /dev/null
@@ -1,377 +0,0 @@
-*
-* $Id: ipdef.F,v 1.7 2005/10/28 12:45:45 couet Exp $
-*
-* $Log: ipdef.F,v $
-* Revision 1.7 2005/10/28 12:45:45 couet
-* - Mods to make CUPS version 1.1.22 happy
-*
-* Revision 1.6 2005/10/28 12:38:13 couet
-* - SVG driver, workstation type -779
-*
-* Revision 1.5 2003/03/20 09:14:10 couet
-* - Enclose the PS code between %%EndProlog and the fist %%Page in %%BeginSetup
-* and %EndSetup. That way the CUPS printing package is happy !
-*
-* Revision 1.4 2003/03/18 13:37:01 couet
-* - %%Page 1 moved just after %%EndProlog to be compliant with CUPS
-* printing software which seems to become the standard on Linux.
-*
-* Revision 1.3 2000/04/03 14:53:14 couet
-* - "newpath" has been added at the beginning of the PS and EPS file to close
-* some graphics path which may have been left opened by the application in
-* which the HIGZ PS or EPS file is included.
-*
-* Revision 1.2 1999/07/20 14:09:03 couet
-* - New version of the pattern polygon filling. It now uses the Pattern
-* functionality provided by PostScript level 2. This allows to have
-* colored pattern and a better drawing of the pattern.
-*
-* Revision 1.1.1.1 1996/02/14 13:11:06 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.23/02 07/06/95 17.36.12 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE IPDEF
-*.===========>
-*.
-*. This routine initialise the following PostScript procedures:
-*.
-*. +------------+------------------+-----------------------------------+
-*. | Macro Name | Input parameters | Explanation |
-*. +------------+------------------+-----------------------------------+
-*. | l | x y | Draw a line to the x y position |
-*. +------------+------------------+-----------------------------------+
-*. | m | x y | Move to the position x y |
-*. +------------+------------------+-----------------------------------+
-*. | box | dx dy x y | Define a box |
-*. +------------+------------------+-----------------------------------+
-*. | bl | dx dy x y | Draw a line box |
-*. +------------+------------------+-----------------------------------+
-*. | bf | dx dy x y | Draw a filled box |
-*. +------------+------------------+-----------------------------------+
-*. | sw | text | Return string width of text |
-*. +------------+------------------+-----------------------------------+
-*. | t | x y | Translate |
-*. +------------+------------------+-----------------------------------+
-*. | r | angle | Rotate |
-*. +------------+------------------+-----------------------------------+
-*. | rl | i j | Roll the stack |
-*. +------------+------------------+-----------------------------------+
-*. | d | x y | Draw a relative line to x y |
-*. +------------+------------------+-----------------------------------+
-*. | X | x | Draw a relative line to x (y=0) |
-*. +------------+------------------+-----------------------------------+
-*. | Y | y | Draw a relative line to y (x=0) |
-*. +------------+------------------+-----------------------------------+
-*. | rm | x y | Move relatively to x y |
-*. +------------+------------------+-----------------------------------+
-*. | gr | | Restore the graphic context |
-*. +------------+------------------+-----------------------------------+
-*. | lw | lwidth | Set line width to lwidth |
-*. +------------+------------------+-----------------------------------+
-*. | sd | [] 0 | Set dash line define by [] |
-*. +------------+------------------+-----------------------------------+
-*. | s | | Stroke mode |
-*. +------------+------------------+-----------------------------------+
-*. | c | r g b | Set rgb color to r g b |
-*. +------------+------------------+-----------------------------------+
-*. | cl | | Close path |
-*. +------------+------------------+-----------------------------------+
-*. | f | | Fill the last describe path |
-*. +------------+------------------+-----------------------------------+
-*. | mXX | x y | Draw the marker type XX at (x,y) |
-*. +------------+------------------+-----------------------------------+
-*. | Zone | ix iy | Define the current zone |
-*. +------------+------------------+-----------------------------------+
-*. | black | | The color is black |
-*. +------------+------------------+-----------------------------------+
-*. | C | dx dy x y | Clipping on |
-*. +------------+------------------+-----------------------------------+
-*. | NC | | Clipping off |
-*. +------------+------------------+-----------------------------------+
-*. | R | | repeat |
-*. +------------+------------------+-----------------------------------+
-*.
-*..==========> (O.Couet)
-#include "higz/hiatt.inc"
-#include "higz/hipost.inc"
-#include "higz/hiflag.inc"
- CHARACTER*80 CHPS1,CHPS2
-#include "higz/hivers.inc"
-*.______________________________________
-*
-#include "higz/icmtop.inc"
- NPAGES=1
-*
-* Mode is last digit of Postscript Workstation type
-* mode=1,2 for portrait/landscape black and white
-* mode=3 for Encapsulated PostScript File
-* mode=4 for portrait colour
-* mode=5 for lanscape colour
-*
- MODE=MOD(ABS(IPSWTY),10)
- IF(MODE.LE.0.OR.MODE.GT.5)GOTO 20
-*
-* NX (NY) is the total number of windows in x (y)
-*
- NX=MOD(ABS(IPSWTY),1000)/100
- NY=MOD(ABS(IPSWTY),100)/10
- IF(NX.LE.0.OR.NY.LE.0)GOTO 20
- IXZ=1
- IYZ=1
-*
-* IFMT = 0-99 is the European page format (A4,A3 ...)
-* IFMT = 100 is the US format 8.5x11.0 inch
-* IFMT = 200 is the US format 8.5x14.0 inch
-* IFMT = 300 is the US format 11.0x17.0 inch
-*
- IFMT=ABS(IPSWTY/1000)
- IF(IFMT.EQ.0)IFMT=4
- IF(IFMT.EQ.99)IFMT=0
-*
- IF(TFLAG)GOTO 10
-*
- IF(VFLAG)THEN
- INQUIRE(UNIT=LUNPS,NAME=CHPS2)
- ILEN=MIN(LENOCC(CHPS2),60)
- CALL IPPSTR('<title>@')
- CALL IPPSTR(CHPS2(1:ILEN))
- CALL IPPSTR('</title>@')
- CALL IPPSTR('<desc>@')
- CALL IPPSTF(21,'Creator: HIGZ Version')
- CALL IPPSTR(CHVERS)
- CALL IPPSTR('@')
- CALL IPPSTF(14,'Creation date:')
- CALL IGDATE(CHPS1)
- CHPS2=' '
- CHPS2(2:)=CHPS1(1:LENOCC(CHPS1))
- CALL IPPSTR(CHPS2)
- CALL IPPSTR('@')
- CALL IPPSTR('</desc>@')
- CALL IPMARK
- CALL IPPSTR('<defs>@')
- CALL IPPSTR('</defs>@')
- GOTO 10
- ENDIF
-*
- CHPS1='%%Title: '
- INQUIRE(UNIT=LUNPS,NAME=CHPS2)
- CHPS1(10:)=CHPS2(1:LENOCC(CHPS2))
- ILEN=MIN(LENOCC(CHPS1),60)
- CALL IPPSTR(CHPS1(1:ILEN))
- IF(MODE.NE.3)THEN
- IF(MODE.EQ.1.OR.MODE.EQ.4)CALL IPPSTF(10,' (Portrait')
- IF(MODE.EQ.2.OR.MODE.EQ.5)CALL IPPSTF(11,' (Landscape')
- IF(IFMT.LE.99)THEN
- CALL IPPSTF(2,' A')
- CALL IPIOUT(IFMT)
- CALL IPPSTF(1,')')
- ELSE
- IF(IFMT.EQ.100)CALL IPPSTF(8,' Letter)')
- IF(IFMT.EQ.200)CALL IPPSTF(7,' Legal)')
- IF(IFMT.EQ.300)CALL IPPSTF(8,' Ledger)')
- ENDIF
- CALL IPPSTR('@')
- CALL IPPSTR('%%Pages: (atend)@')
- ELSE
- CALL IPPSTR('@')
- ENDIF
-*
- CALL IPPSTF(23,'%%Creator: HIGZ Version')
- CALL IPPSTR(CHVERS)
- CALL IPPSTR('@')
-*
- CALL IPPSTF(15,'%%CreationDate:')
- CALL IGDATE(CHPS1)
- CHPS2=' '
- CHPS2(2:)=CHPS1(1:LENOCC(CHPS1))
- CALL IPPSTR(CHPS2)
- CALL IPPSTR('@')
- CALL IPPSTR('%%EndComments@')
- CALL IPPSTR('%%BeginProlog@')
-*
- IF(MODE.EQ.3)CALL IPPSTR('80 dict begin@')
-*
-* Initialization of PostScript procedures
-*
- CALL IPPSTR('/s {stroke} def /l {lineto} def /m {moveto} def /t {t
- +ranslate} def@')
- CALL IPPSTR('/sw {stringwidth} def /r {rotate} def /rl {roll} def
- + /R {repeat} def@')
- CALL IPPSTR('/d {rlineto} def /rm {rmoveto} def /gr {grestore} def
- + /f {eofill} def@')
- CALL IPPSTR('/c {setrgbcolor} def /lw {setlinewidth} def /sd {setd
- +ash} def@')
- CALL IPPSTR('/cl {closepath} def /sf {scalefont setfont} def /blac
- +k {0 setgray} def@')
- CALL IPPSTR('/box {m dup 0 exch d exch 0 d 0 exch neg d cl} def@')
- CALL IPPSTR('/NC{systemdict begin initclip end}def/C{NC box clip n
- +ewpath}def@')
- CALL IPPSTR('/bl {box s} def /bf {box f} def /Y { 0 exch d} def /X
- + { 0 d} def @')
-*
- CALL IPMARK
- CALL IPFON
- CALL IPSPEC
-*
-* mode=1 for portrait black/white
-*
- IF (MODE.EQ.1) THEN
- RPXMIN = 0.7
- RPYMIN = SQRT(2.)*RPXMIN
- IF (IFMT.EQ.100) THEN
- WIDTH = (8.5*2.54)-2.*RPXMIN
- HEIGTH = (11.*2.54)-2.*RPYMIN
- ELSEIF (IFMT.EQ.200) THEN
- WIDTH = (8.5*2.54)-2.*RPXMIN
- HEIGTH = (14.*2.54)-2.*RPYMIN
- ELSEIF (IFMT.EQ.300) THEN
- WIDTH = (11.*2.54)-2.*RPXMIN
- HEIGTH = (17.*2.54)-2.*RPYMIN
- ELSE
- WIDTH = 21.0-2.*RPXMIN
- HEIGTH = 29.7-2.*RPYMIN
- ENDIF
- ENDIF
-*
-* mode=2 for landscape black/white
-*
- IF (MODE.EQ.2) THEN
- RPYMIN = 0.7
- RPXMIN = SQRT(2.)*RPYMIN
- IF (IFMT.EQ.100) THEN
- WIDTH = (11.*2.54)-2.*RPXMIN
- HEIGTH = (8.5*2.54)-2.*RPYMIN
- ELSEIF (IFMT.EQ.200) THEN
- WIDTH = (14.*2.54)-2.*RPXMIN
- HEIGTH = (8.5*2.54)-2.*RPYMIN
- ELSEIF (IFMT.EQ.300) THEN
- WIDTH = (17.*2.54)-2.*RPXMIN
- HEIGTH = (11.*2.54)-2.*RPYMIN
- ELSE
- WIDTH = 29.7-2.*RPXMIN
- HEIGTH = 21-2.*RPYMIN
- ENDIF
- ENDIF
-*
-* mode=3 encapsulated PostScript
-*
- 10 IF (MODE.EQ.3) THEN
- WIDTH = X2W
- HEIGTH = Y2W
- IFMT = 4
- NX = 1
- NY = 1
- ENDIF
-*
-* mode=4 for portrait colour
-*
- IF (MODE.EQ.4) THEN
- RPXMIN = 0.7
- RPYMIN = 3.4
- IF (IFMT.EQ.100) THEN
- WIDTH = (8.5*2.54)-2.*RPXMIN
- HEIGTH = (11.*2.54)-2.*RPYMIN
- ELSEIF (IFMT.EQ.200) THEN
- WIDTH = (8.5*2.54)-2.*RPXMIN
- HEIGTH = (14.*2.54)-2.*RPYMIN
- ELSEIF (IFMT.EQ.300) THEN
- WIDTH = (11.*2.54)-2.*RPXMIN
- HEIGTH = (17.*2.54)-2.*RPYMIN
- ELSE
- WIDTH = (21.0-2*RPXMIN)
- HEIGTH = (29.7-2.*RPYMIN)
- ENDIF
- ENDIF
-*
-* mode=5 for lanscape colour
-*
- IF (MODE.EQ.5) THEN
- RPXMIN = 3.4
- RPYMIN = 0.7
- IF (IFMT.EQ.100) THEN
- WIDTH = (11.*2.54)-2.*RPXMIN
- HEIGTH = (8.5*2.54)-2.*RPYMIN
- ELSEIF (IFMT.EQ.200) THEN
- WIDTH = (14.*2.54)-2.*RPXMIN
- HEIGTH = (8.5*2.54)-2.*RPYMIN
- ELSEIF (IFMT.EQ.300) THEN
- WIDTH = (17.*2.54)-2.*RPXMIN
- HEIGTH = (11.*2.54)-2.*RPYMIN
- ELSE
- WIDTH = (29.7-2*RPXMIN)
- HEIGTH = (21-2.*RPYMIN)
- ENDIF
- ENDIF
-*
- IF (IFMT.LT.100) THEN
- VALUE = 21.*SQRT(2.)**(4-IFMT)
- ELSEIF (IFMT.EQ.100) THEN
- VALUE = 8.5*2.54
- ELSEIF (IFMT.EQ.200) THEN
- VALUE=8.5*2.54
- ELSEIF (IFMT.EQ.300) THEN
- VALUE = 11.*2.54
- ENDIF
-*
- IF (IFMT.GE.100) IFMT = 4
-*
-* Compute size (in points) of the window for each picture = f(NX,NY)
-*
- IPSI = IGIWIN(IPSWID)
- XWKSIZ(IPSI) = WIDTH/FLOAT(NX)*SQRT(2.)**(4-IFMT)
- YWKSIZ(IPSI) = HEIGTH/FLOAT(NY)*SQRT(2.)**(4-IFMT)
- WKMAX(IPSI) = FLOAT(MAX(ICMTOP(XWKSIZ(IPSI))
- +, ICMTOP(YWKSIZ(IPSI))))
- NPX = 4*ICMTOP(XWKSIZ(IPSI))
- NPY = 4*ICMTOP(YWKSIZ(IPSI))
-*
- IF (TFLAG.OR.VFLAG) RETURN
-*
-* Procedure Zone
-*
- IF (MODE.NE.3) THEN
- CALL IPPSTF(33,'/Zone {/iy exch def /ix exch def ')
- CALL IPPSTF(10,' ix 1 sub ')
- CALL IPIOUT(NPX)
- CALL IPPSTF(5,' mul ')
- CALL IPFOUT(FLOAT(NY))
- CALL IPPSTF(8,' iy sub ')
- CALL IPIOUT(NPY)
- CALL IPPSTR(' mul t} def@')
- ENDIF
-*
- CALL IPPSTR('%%EndProlog@')
- IF (MODE.NE.3) CALL IPPSTR('%%Page: number 1@')
-*
- CALL IPPSTR('%%BeginSetup@')
- CALL IPPSTR('%%EndSetup@')
- CALL IPPSTF(8,'newpath ')
- CALL IPSVRT(1)
- IF (MODE.EQ.1.OR.MODE.EQ.4) THEN
- CALL IPIOUT(ICMTOP(RPXMIN))
- CALL IPIOUT(ICMTOP(RPYMIN))
- CALL IPPSTF(2,' t')
- ENDIF
- IF (MODE.EQ.2.OR.MODE.EQ.5) THEN
- CALL IPPSTF(7,' 90 r 0')
- CALL IPIOUT(ICMTOP(-VALUE))
- CALL IPPSTF(3,' t ')
- CALL IPIOUT(ICMTOP(RPXMIN))
- CALL IPIOUT(ICMTOP(RPYMIN))
- CALL IPPSTF(2,' t')
- ENDIF
- CALL IPPSTF(15,' .25 .25 scale ')
- IF (MODE.NE.3) CALL IPSVRT(1)
-*
- NBSAV0 = NBSAVE
-*
- RETURN
-*
- 20 CALL IGERR('Invalid PostScript file type','IPDEF')
- PFLAG=.FALSE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
-*
- END
diff --git a/src/graflib/higz/ipost/ipdlin.F b/src/graflib/higz/ipost/ipdlin.F
deleted file mode 100644
index 8ad207c..0000000
--- a/src/graflib/higz/ipost/ipdlin.F
+++ /dev/null
@@ -1,60 +0,0 @@
-*
-* $Id: ipdlin.F,v 1.1.1.1 1996/02/14 13:11:06 mclareni Exp $
-*
-* $Log: ipdlin.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:06 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.21/01 10/05/94 17.42.25 by O.Couet
-*-- Author :
- SUBROUTINE IPDLIN(NN,IX,IY)
- DIMENSION IX(*),IY(*)
-*.===========>
-*.
-*. Write the drawing command to the LaTeX metafile
-*. after removing intermediate points lying on a straight line.
-*.
-*..==========> (A.Nathaniel)
-#include "higz/hiflag.inc"
-
- IF(NN.EQ.0) RETURN
-
- 10 CONTINUE
- DO 30 I=2,NN
- IDX1=IX(I-1)
- IDY1=IY(I-1)
- IDX2=IX(I)
- IDY2=IY(I)
- IF(SIGN(1,IDX1).EQ.SIGN(1,IDX2).AND.SIGN(1,IDY1).EQ.
- + SIGN(1,IDY2).AND.IDX1*IDY2.EQ.IDX2*IDY1)THEN
- IX(I-1)=IDX1+IDX2
- IY(I-1)=IDY1+IDY2
- NN=NN-1
- DO 20 J=I,NN
- IX(J)=IX(J+1)
- IY(J)=IY(J+1)
- 20 CONTINUE
- GOTO 10
- ENDIF
- 30 CONTINUE
- DO 40 I=1,NN
- IF(IX(I).EQ.0) THEN
- IF(IY(I).GT.0) THEN
- CALL IPTLIN('U',IY(I),0)
- ELSE
- CALL IPTLIN('D',-IY(I),0)
- ENDIF
- ELSEIF(IY(I).EQ.0) THEN
- IF(IX(I).GT.0) THEN
- CALL IPTLIN('h',IX(I),0)
- ELSE
- CALL IPTLIN('r',-IX(I),0)
- ENDIF
- ELSE
- CALL IPTLIN('s',IX(I),IY(I))
- ENDIF
- 40 CONTINUE
- NN=0
- END
diff --git a/src/graflib/higz/ipost/ipdpat.F b/src/graflib/higz/ipost/ipdpat.F
deleted file mode 100644
index 767812c..0000000
--- a/src/graflib/higz/ipost/ipdpat.F
+++ /dev/null
@@ -1,320 +0,0 @@
-*
-* $Id: ipdpat.F,v 1.3 2002/12/04 10:55:03 couet Exp $
-*
-* $Log: ipdpat.F,v $
-* Revision 1.3 2002/12/04 10:55:03 couet
-* - Line width must be 1 to draw PS patterns
-*
-* Revision 1.2 1999/07/21 15:48:24 couet
-* - Improvements in PS Patterns drawing
-*
-* Revision 1.1 1999/07/20 14:09:04 couet
-* - New version of the pattern polygon filling. It now uses the Pattern
-* functionality provided by PostScript level 2. This allows to have
-* colored pattern and a better drawing of the pattern.
-*
-*
-#include "higz/pilot.h"
-*-- Author : O.Couet 16/07/99
- SUBROUTINE IPDPAT(IPAT,ICOL)
-*.===========>
-*.
-*. Define the pattern IPAT in the current PS file. IPAT can varies from 1 to 25.
-*. Together with the pattern, the color (ICOL) in which the pattern has to be
-*. drawn is also required.
-*. A pattern is defined in the current PS file only the first time it is used.
-*. Some level 2 Postscript functions are used, so on level 1 printers, patterns
-*. will not work. This is not a big problem because, as we said, patterns are
-*. define only if they are used, so if they are not used a PS level 1 file will
-*. not be poluted by level 2 features, and in any case the old patterns (defined
-*. by the routine IPPATT) used a lot of memory which made them almost unusable
-*. on old level 1 printers. Finally we should say that level 1 devices are
-*. becoming very rare. The official PostScript is now level 3 !
-*.
-*..==========> (O.Couet)
-#include "higz/hilut.inc"
-#include "higz/hipost.inc"
- CHARACTER*28, CDEF
- CHARACTER*4, CPAT
-*.______________________________________
-*
- CPAT = ' P '
- WRITE (CPAT(3:4),'(I2.2)') IPAT
-*
-* IPATD is used as a set of bits. If JBIT(IPATD,IPAT).NE.0 the
-* pattern number IPAT as already be defined is this file and it
-* is not necessary to redefine it. IPATD is set to zero in IPINIT.
-* The bit number 26 allows to know if the macro "cs" has already
-* been defined in the current file (see label 200).
-*
- IF (JBIT(IPATD,IPAT).NE.0) GOTO 200
-*
-* Define the Patterns. Line width must be 1
-*
- CALL IPLWID(1)
- CALL IPPSTR(' << /PatternType 1 /PaintType 2 /TilingType 1')
-*
- GOTO ( 1, 2, 3, 4, 5, 6, 7, 8, 9, 10
- +, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20
- +, 21, 22, 23, 24, 25), IPAT
-*
- 1 CALL IPPSTR(' /BBox [ 0 0 100 100 ]')
- CALL IPPSTR(' /XStep 98 /YStep 4')
- CALL IPPSTR(' /PaintProc { begin gsave')
- CALL IPPSTR(' [1] 0 sd 2 4 m 99 4 l s 1 3 m 98 3 l s')
- CALL IPPSTR(' 2 2 m 99 2 l s 1 1 m 98 1 l s')
- CALL IPPSTR(' gr end } >> [ 4.0 0 0 4.0 0 0 ]')
- GOTO 100
-*
- 2 CALL IPPSTR(' /BBox [ 0 0 100 100 ]')
- CALL IPPSTR(' /XStep 96 /YStep 4')
- CALL IPPSTR(' /PaintProc { begin gsave')
- CALL IPPSTR(' [1 3] 0 sd 2 4 m 98 4 l s 0 3 m 96 3 l s')
- CALL IPPSTR(' 2 2 m 98 2 l s 0 1 m 96 1 l s')
- CALL IPPSTR(' gr end } >> [ 3.0 0 0 3.0 0 0 ]')
- GOTO 100
-*
- 3 CALL IPPSTR(' /BBox [ 0 0 100 100 ]')
- CALL IPPSTR(' /XStep 96 /YStep 16')
- CALL IPPSTR(' /PaintProc { begin gsave')
- CALL IPPSTR(' [1 3] 0 sd 2 13 m 98 13 l s 0 9 m 96 9 l s')
- CALL IPPSTR(' 2 5 m 98 5 l s 0 1 m 96 1 l s')
- CALL IPPSTR(' gr end } >> [ 2.0 0 0 2.0 0 0 ]')
- GOTO 100
-*
- 4 CALL IPPSTR(' /BBox [ 0 0 100 100 ]')
- CALL IPPSTR(' /XStep 100 /YStep 100')
- CALL IPPSTR(' /PaintProc { begin gsave')
- CALL IPPSTR(' 0 0 m 100 100 l s')
- CALL IPPSTR(' gr end } >> [ 0.24 0 0 0.24 0 0 ]')
- GOTO 100
-*
- 5 CALL IPPSTR(' /BBox [ 0 0 100 100 ]')
- CALL IPPSTR(' /XStep 100 /YStep 100')
- CALL IPPSTR(' /PaintProc { begin gsave')
- CALL IPPSTR(' 0 100 m 100 0 l s')
- CALL IPPSTR(' gr end } >> [ 0.24 0 0 0.24 0 0 ]')
- GOTO 100
-*
- 6 CALL IPPSTR(' /BBox [ 0 0 100 100 ]')
- CALL IPPSTR(' /XStep 100 /YStep 100')
- CALL IPPSTR(' /PaintProc { begin gsave')
- CALL IPPSTR(' 50 0 m 50 100 l s')
- CALL IPPSTR(' gr end } >> [ 0.12 0 0 0.12 0 0 ]')
- GOTO 100
-*
- 7 CALL IPPSTR(' /BBox [ 0 0 100 100 ]')
- CALL IPPSTR(' /XStep 100 /YStep 100')
- CALL IPPSTR(' /PaintProc { begin gsave')
- CALL IPPSTR(' 0 50 m 100 50 l s')
- CALL IPPSTR(' gr end } >> [ 0.12 0 0 0.12 0 0 ]')
- GOTO 100
-*
- 8 CALL IPPSTR(' /BBox [ 0 0 101 101 ]')
- CALL IPPSTR(' /XStep 100 /YStep 100')
- CALL IPPSTR(' /PaintProc { begin gsave')
- CALL IPPSTR(' 0 0 m 0 30 l 30 0 l f 0 70 m 0 100 l 30 100 l f')
- CALL IPPSTR(' 70 100 m 100 100 l 100 70 l f 70 0 m 100 0 l')
- CALL IPPSTR(' 100 30 l f 50 20 m 20 50 l 50 80 l 80 50 l f')
- CALL IPPSTR(' 50 80 m 30 100 l s 20 50 m 0 30 l s 50 20 m')
- CALL IPPSTR(' 70 0 l s 80 50 m 100 70 l s')
- CALL IPPSTR(' gr end } >> [ 0.24 0 0 0.24 0 0 ]')
- GOTO 100
-*
- 9 CALL IPPSTR(' /BBox [ 0 0 100 100 ]')
- CALL IPPSTR(' /XStep 100 /YStep 100')
- CALL IPPSTR(' /PaintProc { begin gsave')
- CALL IPPSTR(' 0 50 m 50 50 50 180 360 arc')
- CALL IPPSTR(' 0 50 m 0 100 50 270 360 arc')
- CALL IPPSTR(' 50 100 m 100 100 50 180 270 arc s')
- CALL IPPSTR(' gr end } >> [ 0.24 0 0 0.24 0 0 ]')
- GOTO 100
-*
- 10 CALL IPPSTR(' /BBox [ 0 0 100 100 ]')
- CALL IPPSTR(' /XStep 100 /YStep 100')
- CALL IPPSTR(' /PaintProc { begin gsave')
- CALL IPPSTR(' 0 50 m 100 50 l 1 1 m 100 1 l')
- CALL IPPSTR(' 0 0 m 0 50 l 100 0 m 100 50 l')
- CALL IPPSTR(' 50 50 m 50 100 l s')
- CALL IPPSTR(' gr end } >> [ 0.24 0 0 0.24 0 0 ]')
- GOTO 100
-*
- 11 CALL IPPSTR(' /BBox [ 0 0 100 100 ]')
- CALL IPPSTR(' /XStep 100 /YStep 100')
- CALL IPPSTR(' /PaintProc { begin gsave')
- CALL IPPSTR(' 0 0 m 0 20 l 50 0 m 50 20 l')
- CALL IPPSTR(' 100 0 m 100 20 l 0 80 m 0 100 l')
- CALL IPPSTR(' 50 80 m 50 100 l 100 80 m 100 100 l')
- CALL IPPSTR(' 25 30 m 25 70 l 75 30 m 75 70 l')
- CALL IPPSTR(' 0 100 m 20 85 l 50 100 m 30 85 l')
- CALL IPPSTR(' 50 100 m 70 85 l 100 100 m 80 85 l')
- CALL IPPSTR(' 0 0 m 20 15 l 50 0 m 30 15 l')
- CALL IPPSTR(' 50 0 m 70 15 l 100 0 m 80 15 l')
- CALL IPPSTR(' 5 35 m 45 65 l 5 65 m 45 35 l')
- CALL IPPSTR(' 55 35 m 95 65 l 55 65 m 95 35 l s')
- CALL IPPSTR(' gr end } >> [ 0.5 0 0 0.5 0 0 ]')
- GOTO 100
-*
- 12 CALL IPPSTR(' /BBox [ 0 0 100 100 ]')
- CALL IPPSTR(' /XStep 100 /YStep 100')
- CALL IPPSTR(' /PaintProc { begin gsave')
- CALL IPPSTR(' 0 80 m 0 100 20 270 360 arc')
- CALL IPPSTR(' 30 100 m 50 100 20 180 360 arc')
- CALL IPPSTR(' 80 100 m 100 100 20 180 270 arc')
- CALL IPPSTR(' 20 0 m 0 0 20 0 90 arc')
- CALL IPPSTR(' 70 0 m 50 0 20 0 180 arc')
- CALL IPPSTR(' 100 20 m 100 0 20 90 180 arc')
- CALL IPPSTR(' 45 50 m 25 50 20 0 360 arc')
- CALL IPPSTR(' 95 50 m 75 50 20 0 360 arc s')
- CALL IPPSTR(' gr end } >> [ 0.5 0 0 0.5 0 0 ]')
- GOTO 100
-*
- 13 CALL IPPSTR(' /BBox [ 0 0 100 100 ]')
- CALL IPPSTR(' /XStep 100 /YStep 100')
- CALL IPPSTR(' /PaintProc { begin gsave')
- CALL IPPSTR(' 0 0 m 100 100 l 0 100 m 100 0 l s')
- CALL IPPSTR(' gr end } >> [ 0.24 0 0 0.24 0 0 ]')
- GOTO 100
-*
- 14 CALL IPPSTR(' /BBox [ 0 0 100 100 ]')
- CALL IPPSTR(' /XStep 80 /YStep 80')
- CALL IPPSTR(' /PaintProc { begin gsave')
- CALL IPPSTR(' 0 20 m 100 20 l 20 0 m 20 100 l')
- CALL IPPSTR(' 0 80 m 100 80 l 80 0 m 80 100 l')
- CALL IPPSTR(' 20 40 m 60 40 l 60 20 m 60 60 l')
- CALL IPPSTR(' 40 40 m 40 80 l 40 60 m 80 60 l s')
- CALL IPPSTR(' gr end } >> [ 0.60 0 0 0.60 0 0 ]')
- GOTO 100
-*
- 15 CALL IPPSTR(' /BBox [ 0 0 60 60 ]')
- CALL IPPSTR(' /XStep 60 /YStep 60')
- CALL IPPSTR(' /PaintProc { begin gsave')
- CALL IPPSTR(' 0 55 m 0 60 5 270 360 arc')
- CALL IPPSTR(' 25 60 m 30 60 5 180 360 arc')
- CALL IPPSTR(' 55 60 m 60 60 5 180 270 arc')
- CALL IPPSTR(' 20 30 m 15 30 5 0 360 arc')
- CALL IPPSTR(' 50 30 m 45 30 5 0 360')
- CALL IPPSTR(' arc 5 0 m 0 0 5 0 90 arc')
- CALL IPPSTR(' 35 0 m 30 0 5 0 180 arc')
- CALL IPPSTR(' 60 5 m 60 0 5 90 180 arc s')
- CALL IPPSTR(' gr end } >> [ 0.41 0 0 0.41 0 0 ]')
- GOTO 100
-*
- 16 CALL IPPSTR(' /BBox [ 0 0 100 100 ]')
- CALL IPPSTR(' /XStep 100 /YStep 100')
- CALL IPPSTR(' /PaintProc { begin gsave')
- CALL IPPSTR(' 50 50 m 25 50 25 0 180 arc s')
- CALL IPPSTR(' 50 50 m 75 50 25 180 360 arc s')
- CALL IPPSTR(' gr end } >> [ 0.4 0 0 0.2 0 0 ]')
- GOTO 100
-*
- 17 CALL IPPSTR(' /BBox [ 0 0 100 100 ]')
- CALL IPPSTR(' /XStep 100 /YStep 100')
- CALL IPPSTR(' /PaintProc { begin gsave')
- CALL IPPSTR(' [24] 0 setdash 0 0 m 100 100 l s')
- CALL IPPSTR(' gr end } >> [ 0.24 0 0 0.24 0 0 ]')
- GOTO 100
-*
- 18 CALL IPPSTR(' /BBox [ 0 0 100 100 ]')
- CALL IPPSTR(' /XStep 100 /YStep 100')
- CALL IPPSTR(' /PaintProc { begin gsave')
- CALL IPPSTR(' [24] 0 setdash 0 100 m 100 0 l s')
- CALL IPPSTR(' gr end } >> [ 0.24 0 0 0.24 0 0 ]')
- GOTO 100
-*
- 19 CALL IPPSTR(' /BBox [ 0 0 100 100 ]')
- CALL IPPSTR(' /XStep 100 /YStep 100')
- CALL IPPSTR(' /PaintProc { begin gsave')
- CALL IPPSTR(' 90 50 m 50 50 40 0 360 arc')
- CALL IPPSTR(' 0 50 m 0 100 50 270 360 arc')
- CALL IPPSTR(' 50 0 m 0 0 50 0 90 arc')
- CALL IPPSTR(' 100 50 m 100 0 50 90 180 arc')
- CALL IPPSTR(' 50 100 m 100 100 50 180 270 arc s')
- CALL IPPSTR(' gr end } >> [ 0.47 0 0 0.47 0 0 ]')
- GOTO 100
-*
- 20 CALL IPPSTR(' /BBox [ 0 0 100 100 ]')
- CALL IPPSTR(' /XStep 100 /YStep 100')
- CALL IPPSTR(' /PaintProc { begin gsave')
- CALL IPPSTR(' 50 50 m 50 75 25 270 450 arc s')
- CALL IPPSTR(' 50 50 m 50 25 25 90 270 arc s')
- CALL IPPSTR(' gr end } >> [ 0.2 0 0 0.4 0 0 ]')
- GOTO 100
-*
- 21 CALL IPPSTR(' /BBox [ 0 0 101 101 ]')
- CALL IPPSTR(' /XStep 100 /YStep 100')
- CALL IPPSTR(' /PaintProc { begin gsave')
- CALL IPPSTR(' 1 1 m 25 1 l 25 25 l 50 25 l 50 50 l')
- CALL IPPSTR(' 75 50 l 75 75 l 100 75 l 100 100 l')
- CALL IPPSTR(' 50 1 m 75 1 l 75 25 l 100 25 l 100 50 l')
- CALL IPPSTR(' 0 50 m 25 50 l 25 75 l 50 75 l 50 100 l s')
- CALL IPPSTR(' gr end } >> [ 0.5 0 0 0.5 0 0 ]')
- GOTO 100
-*
- 22 CALL IPPSTR(' /BBox [ 0 0 101 101 ]')
- CALL IPPSTR(' /XStep 100 /YStep 100')
- CALL IPPSTR(' /PaintProc { begin gsave')
- CALL IPPSTR(' 1 100 m 25 100 l 25 75 l 50 75 l 50 50 l')
- CALL IPPSTR(' 75 50 l 75 25 l 100 25 l 100 1 l')
- CALL IPPSTR(' 50 100 m 75 100 l 75 75 l 100 75 l 100 50 l')
- CALL IPPSTR(' 0 50 m 25 50 l 25 25 l 50 25 l 50 1 l s')
- CALL IPPSTR(' gr end } >> [ 0.5 0 0 0.5 0 0 ]')
- GOTO 100
-*
- 23 CALL IPPSTR(' /BBox [ 0 0 100 100 ]')
- CALL IPPSTR(' /XStep 100 /YStep 100')
- CALL IPPSTR(' /PaintProc { begin gsave')
- CALL IPPSTR(' [1 7] 0 sd 0 8 50 { dup dup m 2 mul 0 l s } for')
- CALL IPPSTR(' 0 8 50 { dup dup 2 mul 100 m 50 add exch 50')
- CALL IPPSTR(' add l s } for 100 0 m 100 100 l 50 50 l f')
- CALL IPPSTR(' gr end } >> [ 0.24 0 0 0.24 0 0 ]')
- GOTO 100
-*
- 24 CALL IPPSTR(' /BBox [ 0 0 100 100 ]')
- CALL IPPSTR(' /XStep 100 /YStep 100')
- CALL IPPSTR(' /PaintProc { begin gsave')
- CALL IPPSTR(' 100 100 m 100 36 l 88 36 l 88 88 l f')
- CALL IPPSTR(' 100 0 m 100 12 l 56 12 l 50 0 l f')
- CALL IPPSTR(' 0 0 m 48 0 l 48 48 l 50 48 l 56 60 l')
- CALL IPPSTR(' 36 60 l 36 12 l 0 12 l f [1 7] 0 sd')
- CALL IPPSTR(' 61 8 87 { dup dup dup 12 exch m 88 exch l s')
- CALL IPPSTR(' 16 exch 4 sub m 88 exch 4 sub l s } for')
- CALL IPPSTR(' 13 8 35 { dup dup dup 0 exch m 36 exch l s')
- CALL IPPSTR(' 4 exch 4 sub m 36 exch 4 sub l s } for')
- CALL IPPSTR(' 37 8 59 { dup dup dup 12 exch m 36 exch l s')
- CALL IPPSTR(' 16 exch 4 sub m 36 exch 4 sub l s } for')
- CALL IPPSTR(' 13 8 60 { dup dup dup 56 exch m 100 exch l s')
- CALL IPPSTR(' 60 exch 4 sub m 100 exch 4 sub l s } for')
- CALL IPPSTR(' gr end } >> [ 0.5 0 0 0.5 0 0 ]')
- GOTO 100
-*
- 25 CALL IPPSTR(' /BBox [ 0 0 101 101 ]')
- CALL IPPSTR(' /XStep 100 /YStep 100')
- CALL IPPSTR(' /PaintProc { begin gsave')
- CALL IPPSTR(' 0 0 m 30 30 l 70 30 l 70 70 l 100 100 l 100 0 l')
- CALL IPPSTR(' f 30 30 m 30 70 l 70 70 l f')
- CALL IPPSTR(' gr end } >> [ 0.5 0 0 0.5 0 0 ]')
-*
- 100 CDEF = ' makepattern / exch def'
- CDEF(15:17) = CPAT(2:4)
- CALL IPPSTF(26,CDEF(1:26))
- CALL SBIT1(IPATD,IPAT)
-*
-* Activate the pattern.
-*
- 200 IF (JBIT(IPATD,26).EQ.0) THEN
- CALL IPPSTR(' /cs {[/Pattern /DeviceRGB] setcolorspace} def')
- CALL IPPSTR(' /FA {f [/DeviceRGB] setcolorspace} def')
- CALL SBIT1(IPATD,26)
- ENDIF
- CALL IPPSTF(3,' cs')
- I = ICOL+1
- IF (I.LT.1) I=1
- IF (I.GT.NBCLUT) I=NBCLUT
- CALL IPFOUT(REDLUT(I))
- CALL IPFOUT(GRNLUT(I))
- CALL IPFOUT(BLULUT(I))
- CALL IPPSTF(4,CPAT)
- CALL IPPSTF(9,' setcolor')
-*
- END
diff --git a/src/graflib/higz/ipost/ipdraw.F b/src/graflib/higz/ipost/ipdraw.F
deleted file mode 100644
index cbc3605..0000000
--- a/src/graflib/higz/ipost/ipdraw.F
+++ /dev/null
@@ -1,166 +0,0 @@
-*
-* $Id: ipdraw.F,v 1.2 2005/10/28 12:38:13 couet Exp $
-*
-* $Log: ipdraw.F,v $
-* Revision 1.2 2005/10/28 12:38:13 couet
-* - SVG driver, workstation type -779
-*
-* Revision 1.1.1.1 1996/02/14 13:11:06 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.21/09 26/09/94 15.22.25 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE IPDRAW(NN,XW,YW)
-*.===========>
-*.
-*. Draw a line with the points XW,YW. If NN=1
-*. this routine do a move only. If NN=0 the XW(1)
-*. and YW(1) are written in the PostScript file
-*. according to the current NT. If NN>0 the line
-*. is clipped as a line, if NN<0 the line is clip-
-*. -ped as a fill area.
-*.
-*..==========> (O.Couet)
-#include "higz/hiatt.inc"
-#include "higz/hiflag.inc"
-#include "higz/hipost.inc"
-#include "higz/hiques.inc"
- DIMENSION XW(*),YW(*)
- DIMENSION XC(2),YC(2)
- PARAMETER(MWORK=50)
- DIMENSION IXWORK(MWORK),IYWORK(MWORK)
- LOGICAL LOMOVE,LOLINE,LOCLIP
-*.______________________________________
-*
-#include "higz/hiwcps.inc"
-#include "higz/hiwcsv.inc"
- IF(NN.LT.0)THEN
- N = ABS(NN)
- LOLINE = .FALSE.
- ELSE
- N = NN
- LOLINE = .TRUE.
- ENDIF
-*
- IF(N.LE.1)THEN
- IXD=IXWCPS(XW(1))
- IYD=IYWCPS(YW(1))
- IF(TFLAG) THEN
- CALL IPTLIN('m',IXD,IYD)
- ELSE
- CALL IPIOUT(IXD)
- CALL IPIOUT(IYD)
- IF(N.EQ.0)RETURN
- CALL IPPSTF(2,' m')
- ENDIF
- RETURN
- ENDIF
-*
- IF (TFLAG) THEN
- NWORK = 0
- LOCLIP = .FALSE.
- LOMOVE = .TRUE.
- DO 10 I=2,N
- XC(1) = XW(I-1)
- XC(2) = XW(I)
- YC(1) = YW(I-1)
- YC(2) = YW(I)
- IF(IGCLIP(XC,YC,X1W,X2W,Y1W,Y2W).NE.0)THEN
- IF(LOMOVE)THEN
- IF(NN.GT.0)CALL IPDLIN(NWORK,IXWORK,IYWORK)
- IXD0 = IXWCPS(XC(1))
- IYD0 = IYWCPS(YC(1))
- CALL IPTLIN('m',IXD0,IYD0)
- LOMOVE = .FALSE.
- ENDIF
- IXD = IXWCPS(XC(2))
- IYD = IYWCPS(YC(2))
- NWORK = NWORK+1
- IXWORK(NWORK) = IXD-IXD0
- IYWORK(NWORK) = IYD-IYD0
- IXD0 = IXD
- IYD0 = IYD
- IF(NWORK.EQ.MWORK)CALL IPDLIN(NWORK,IXWORK,IYWORK)
- IF(IQUEST(50).NE.0)THEN
- IF(LOLINE)LOMOVE = .TRUE.
- LOCLIP = .TRUE.
- ENDIF
- ELSE
- IF(LOLINE)LOMOVE = .TRUE.
- LOCLIP = .TRUE.
- ENDIF
- 10 CONTINUE
- CALL IPDLIN(NWORK,IXWORK,IYWORK)
- ELSEIF(VFLAG)THEN
- IXDI = IXWCSV(XW(1))
- IYDI = IYWCSV(YW(1))
- CALL IPKOUT(IXDI)
- CALL IPPSTF(1,',')
- CALL IPKOUT(IYDI)
- DO 22 I=2,N
- IXDI = IXWCSV(XW(I))
- IYDI = IYWCSV(YW(I))
- CALL IPIOUT(IXDI)
- CALL IPPSTF(1,',')
- CALL IPKOUT(IYDI)
- 22 CONTINUE
- ELSE
- IXD0 = IXWCPS(XW(1))
- IYD0 = IYWCPS(YW(1))
- CALL IPIOUT(IXD0)
- CALL IPIOUT(IYD0)
- CALL IPPSTF(2,' m')
- IDX = 0
- IDY = 0
- DO 20 I=2,N
- IXDI = IXWCPS(XW(I))
- IYDI = IYWCPS(YW(I))
- IX = IXDI-IXD0
- IY = IYDI-IYD0
- IXD0 = IXDI
- IYD0 = IYDI
- IF(IX.NE.0.AND.IY.NE.0)THEN
- IF(IDX.NE.0)THEN
- CALL IPMOVE(IDX,0)
- IDX = 0
- ENDIF
- IF(IDY.NE.0)THEN
- CALL IPMOVE(0,IDY)
- IDY = 0
- ENDIF
- CALL IPMOVE(IX,IY)
- ELSEIF(IX.NE.0)THEN
- IF(IDY.NE.0)THEN
- CALL IPMOVE(0,IDY)
- IDY = 0
- ENDIF
- IF(IDX.EQ.0)THEN
- IDX = IX
- ELSEIF(ISIGN(IX,IDX).EQ.IX)THEN
- IDX = IDX+IX
- ELSE
- CALL IPMOVE(IDX,0)
- IDX = IX
- ENDIF
- ELSEIF(IY.NE.0)THEN
- IF(IDX.NE.0)THEN
- CALL IPMOVE(IDX,0)
- IDX = 0
- ENDIF
- IF(IDY.EQ.0)THEN
- IDY = IY
- ELSEIF(ISIGN(IY,IDY).EQ.IY)THEN
- IDY = IDY+IY
- ELSE
- CALL IPMOVE(0,IDY)
- IDY = IY
- ENDIF
- ENDIF
- 20 CONTINUE
- IF(IDX.NE.0)CALL IPMOVE(IDX,0)
- IF(IDY.NE.0)CALL IPMOVE(0,IDY)
- ENDIF
-*
- END
diff --git a/src/graflib/higz/ipost/ipend.F b/src/graflib/higz/ipost/ipend.F
deleted file mode 100644
index 987f138..0000000
--- a/src/graflib/higz/ipost/ipend.F
+++ /dev/null
@@ -1,58 +0,0 @@
-*
-* $Id: ipend.F,v 1.3 2005/10/28 12:38:13 couet Exp $
-*
-* $Log: ipend.F,v $
-* Revision 1.3 2005/10/28 12:38:13 couet
-* - SVG driver, workstation type -779
-*
-* Revision 1.1.1.1 1996/02/14 13:11:06 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.23/01 24/05/95 10.39.02 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE IPEND
-#include "higz/hiflag.inc"
-#include "higz/hipost.inc"
-*
- IF(TFLAG) THEN
- CALL IPPSTR(BSLASH//'fi'//BSLASH//'end{picture}@')
- IF(IPTWTY.EQ.-778)CALL IPPSTR(BSLASH//'end{document}@')
- ELSEIF(VFLAG) THEN
- CALL IPPSTR('</svg>@')
- VFLAG=.FALSE.
- RETURN
- ELSE
- IF(MODE.NE.3)THEN
- CALL IPSVRT(-1)
- IF (LOPRT) THEN
- CALL IPPSTR('showpage@')
- CALL IPSVRT(-1)
- ENDIF
- CALL IPPSTR('%%Trailer@')
- CALL IPPSTR('%%Pages: ')
- CALL IPIOUT(NPAGES)
- CALL IPPSTR('@')
- 10 IF (NBSAVE.GT.0) THEN
- CALL IPSVRT(-1)
- GOTO 10
- ENDIF
- ELSE
- CALL IPPSTR('@')
- 20 IF (NBSAVE.GT.0) THEN
- CALL IPSVRT(-1)
- GOTO 20
- ENDIF
- CALL IPPSTR('showpage@')
- CALL IPPSTR('end@')
- ENDIF
- CALL IPPSTR('%%EOF@')
- ENDIF
- IF (NBSAVE.NE.0)
- + CALL IGERR(
- + 'Invalid number of ''grestore'' in PostScript file',
- + 'IPEND')
- PFLAG=.FALSE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- END
diff --git a/src/graflib/higz/ipost/ipfon.F b/src/graflib/higz/ipost/ipfon.F
deleted file mode 100644
index 9fe0b87..0000000
--- a/src/graflib/higz/ipost/ipfon.F
+++ /dev/null
@@ -1,118 +0,0 @@
-*
-* $Id: ipfon.F,v 1.3 2005/10/28 12:38:14 couet Exp $
-*
-* $Log: ipfon.F,v $
-* Revision 1.3 2005/10/28 12:38:14 couet
-* - SVG driver, workstation type -779
-*
-* Revision 1.1.1.1 1996/02/14 13:11:06 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.16/01 13/08/92 18.40.25 by O.Couet
-*-- Author : P.Juillot 13/08/92
- SUBROUTINE IPFON
-*.===========>
-*.
-*. Font reencoding
-*.
-*..==========> (O.Couet)
- CALL IPPSTR('@/reencdict 24 dict def')
- CALL IPPSTR(' /ReEncode')
- CALL IPPSTR(' {reencdict begin')
- CALL IPPSTR(' /nco&na exch def')
- CALL IPPSTR('@/nfnam exch def /basefontname exch')
- CALL IPPSTR(' def /basefontdict basefontname')
- CALL IPPSTR(' findfont def')
- CALL IPPSTR('@/newfont basefontdict maxlength dict def')
- CALL IPPSTR(' basefontdict')
- CALL IPPSTR(' {exch dup /FID ne')
- CALL IPPSTR('@{dup /Encoding eq')
- CALL IPPSTR(' {exch dup length array copy')
- CALL IPPSTR(' newfont 3 1 roll put} {exch ')
- CALL IPPSTR('@newfont 3 1 roll put}')
- CALL IPPSTR(' ifelse}')
- CALL IPPSTR(' {pop pop}')
- CALL IPPSTR(' ifelse')
- CALL IPPSTR(' } forall newfont')
- CALL IPPSTR('@/FontName nfnam put')
- CALL IPPSTR(' nco&na aload pop')
- CALL IPPSTR(' nco&na length 2 idiv {newfont')
- CALL IPPSTR('@/Encoding get 3 1 roll put}')
- CALL IPPSTR(' repeat')
- CALL IPPSTR(' nfnam newfont definefont pop')
- CALL IPPSTR(' end } def')
- CALL IPPSTR('@/accvec [')
- CALL IPPSTR(' 176 /agrave ')
- CALL IPPSTR(' 181 /Agrave ')
- CALL IPPSTR(' 190 /acircumflex')
- CALL IPPSTR(' 192 /Acircumflex')
- CALL IPPSTR('@201 /adieresis ')
- CALL IPPSTR(' 204 /Adieresis ')
- CALL IPPSTR(' 209 /ccedilla ')
- CALL IPPSTR(' 210 /Ccedilla ')
- CALL IPPSTR(' 211 /eacute ')
- CALL IPPSTR('@212 /Eacute ')
- CALL IPPSTR(' 213 /egrave ')
- CALL IPPSTR(' 214 /Egrave ')
- CALL IPPSTR(' 215 /ecircumflex')
- CALL IPPSTR(' 216 /Ecircumflex')
- CALL IPPSTR('@217 /edieresis ')
- CALL IPPSTR(' 218 /Edieresis ')
- CALL IPPSTR(' 219 /icircumflex')
- CALL IPPSTR(' 220 /Icircumflex')
- CALL IPPSTR('@221 /idieresis ')
- CALL IPPSTR(' 222 /Idieresis ')
- CALL IPPSTR(' 223 /ntilde ')
- CALL IPPSTR(' 224 /Ntilde ')
- CALL IPPSTR(' 226 /ocircumflex')
- CALL IPPSTR('@228 /Ocircumflex')
- CALL IPPSTR(' 229 /odieresis ')
- CALL IPPSTR(' 230 /Odieresis ')
- CALL IPPSTR(' 231 /ucircumflex')
- CALL IPPSTR(' 236 /Ucircumflex')
- CALL IPPSTR('@237 /udieresis ')
- CALL IPPSTR(' 238 /Udieresis ')
- CALL IPPSTR(' 239 /aring ')
- CALL IPPSTR(' 242 /Aring ')
- CALL IPPSTR(' 243 /ydieresis ')
- CALL IPPSTR('@244 /Ydieresis ')
- CALL IPPSTR(' 246 /aacute ')
- CALL IPPSTR(' 247 /Aacute ')
- CALL IPPSTR(' 252 /ugrave ')
- CALL IPPSTR(' 253 /Ugrave ')
- CALL IPPSTR('] def')
- CALL IPPSTR('/Times-Roman /Times-Roman accvec ReEncode@')
- CALL IPPSTR('/Times-Italic /Times-Italic accvec ReEncode@')
- CALL IPPSTR('/Times-Bold /Times-Bold accvec ReEncode@')
- CALL IPPSTR('/Times-BoldItalic /Times-BoldItalic accvec ReEncode@'
- +)
- CALL IPPSTR('/Helvetica /Helvetica accvec ReEncode@')
- CALL IPPSTR('/Helvetica-Oblique /Helvetica-Oblique accvec ReEncode
- +@')
- CALL IPPSTR('/Helvetica-Bold /Helvetica-Bold accvec ReEncode@
- +')
- CALL IPPSTR('/Helvetica-BoldOblique /Helvetica-BoldOblique accvec
- + ReEncode@')
- CALL IPPSTR('/Courier /Courier accvec ReEncode@')
- CALL IPPSTR('/Courier-Oblique /Courier-Oblique accvec ReEncode')
- CALL IPPSTR('/Courier-Bold /Courier-Bold accvec ReEncode@')
- CALL IPPSTR('/Courier-BoldOblique /Courier-BoldOblique accvec ReEn
- +code@')
-*
-* Initialization of text PostScript procedures
-*
- CALL IPPSTR('/oshow {gsave [] 0 sd true charpath stroke gr} def@')
- CALL IPPSTR('/stwn { /fs exch def /fn exch def /text exch def fn f
- +indfont fs sf')
- CALL IPPSTR(' text sw pop xs add /xs exch def} def@')
- CALL IPPSTR('/stwb { /fs exch def /fn exch def /nbas exch def /tex
- +tf exch def')
- CALL IPPSTR('textf length /tlen exch def nbas tlen gt {/nbas tlen
- +def} if')
- CALL IPPSTR('fn findfont fs sf textf dup length nbas sub nbas geti
- +nterval sw')
- CALL IPPSTR('pop neg xs add /xs exch def} def@')
-*
- END
diff --git a/src/graflib/higz/ipost/ipfout.F b/src/graflib/higz/ipost/ipfout.F
deleted file mode 100644
index 5cb10be..0000000
--- a/src/graflib/higz/ipost/ipfout.F
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: ipfout.F,v 1.1.1.1 1996/02/14 13:11:06 mclareni Exp $
-*
-* $Log: ipfout.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:06 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.16/06 26/10/92 16.35.13 by O.Couet
-*-- Author :
- SUBROUTINE IPFOUT(Z)
-*.===========>
-*.
-*. Write the real Z in the PostScript file.
-*.
-*..==========> (O.Couet)
- CHARACTER*20 STR
-*.______________________________________
-*
- CALL IZRTOC(Z,STR)
- ILEN=LENOCC(STR)
- IF(STR(ILEN:ILEN).EQ.'.')THEN
- IF(ILEN.GT.1)THEN
- ILEN=ILEN-1
- ELSE
- STR='0'
- ILEN=1
- ENDIF
- ENDIF
- CALL IPPSTR(' '//STR(1:ILEN))
-*
- END
diff --git a/src/graflib/higz/ipost/ipinit.F b/src/graflib/higz/ipost/ipinit.F
deleted file mode 100644
index 78784c0..0000000
--- a/src/graflib/higz/ipost/ipinit.F
+++ /dev/null
@@ -1,112 +0,0 @@
-*
-* $Id: ipinit.F,v 1.3 2005/10/28 12:38:14 couet Exp $
-*
-* $Log: ipinit.F,v $
-* Revision 1.3 2005/10/28 12:38:14 couet
-* - SVG driver, workstation type -779
-*
-* Revision 1.2 1999/07/20 14:09:06 couet
-* - New version of the pattern polygon filling. It now uses the Pattern
-* functionality provided by PostScript level 2. This allows to have
-* colored pattern and a better drawing of the pattern.
-*
-* Revision 1.1.1.1 1996/02/14 13:11:06 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.23/01 23/05/95 15.56.21 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE IPINIT(IWID,LUN,IPSWK)
-*.===========>
-*.
-*. Initialise the PostScript interface
-*.
-*. _Input parameters:
-*.
-*. INTEGER IWID : Workstation identifier.
-*. INTEGER LUN : Logical Unit Number for the PostScript file.
-*. INTEGER IPSWK : Workstation type.
-*.
-*..==========> (O.Couet)
-#include "higz/hipost.inc"
-#include "higz/hiflag.inc"
-*.______________________________________
-*
- IPSLT = 0
- IPSLW = 0
- IPSCI = 0
- IPSMSC = -1
- PSRED = -1.
- PSGRN = -1.
- PSBLU = -1.
- LUNPS = LUN
- IPSWID = IWID
- STRBUF = ' '
- LENBUF = 0
- LENBMX = 80
- IPCLIP = 0
- IPDXC = 0
- IPDYC = 0
- IPXC = 0
- IPYC = 0
- NBSAVE = 0
- IPATD = 0
-#if !defined(CERNLIB_BSLASH)
- BSLASH = '\'
-#endif
-#if defined(CERNLIB_BSLASH)
- BSLASH = '\\'
-#endif
- TFLAG = .FALSE.
- IF(IPSWK.EQ.-777.OR.IPSWK.EQ.-778)TFLAG = .TRUE.
- VFLAG = .FALSE.
- IF(IPSWK.EQ.-779)VFLAG = .TRUE.
- IF(TFLAG) THEN
- IPSWTY = -113
- IPTWTY = IPSWK
- LOBB = .FALSE.
- LOCLR = .FALSE.
- LOZONE = .TRUE.
-#if defined(CERNLIB_IBM)
- LENBMX = 80
-#endif
-#if !defined(CERNLIB_IBM)
- LENBMX = 132
-#endif
- IF(IPTWTY.EQ.-778)THEN
- CALL IPPSTR(BSLASH//'documentstyle{article}')
- CALL IPPSTR(BSLASH//'pagestyle{empty}')
- CALL IPPSTR(BSLASH//'evensidemargin-.5in')
- CALL IPPSTR(BSLASH//'oddsidemargin-.5in')
- CALL IPPSTR(BSLASH//'topmargin-.5in')
- CALL IPPSTR(BSLASH//'multiply'//BSLASH//'textheight14')
- CALL IPPSTR(BSLASH//'divide'//BSLASH//'textheight10')
- CALL IPPSTR(BSLASH//'multiply'//BSLASH//'textwidth14')
- CALL IPPSTR(BSLASH//'divide'//BSLASH//'textwidth10')
- CALL IPPSTR(BSLASH//'begin{document}@')
- ENDIF
- ELSEIF (VFLAG) THEN
- IPSWTY = -113
- IPTWTY = IPSWK
- LOBB = .FALSE.
- LOCLR = .FALSE.
- LOZONE = .TRUE.
- ELSE
- IPSWTY = IPSWK
- LOCLR = .TRUE.
- LOZONE = .FALSE.
- IF(IPSWK.EQ.-113)THEN
- LOBB = .FALSE.
- CALL IPPSTR('%!PS-Adobe-2.0 EPSF-2.0@')
- ELSE
- LOBB = .TRUE.
- CALL IPPSTR('%!PS-Adobe-2.0@')
- CALL IPDEF
- ENDIF
- ENDIF
- LOPRT = .FALSE.
- LOPRNG = .FALSE.
- LOSCLI = .FALSE.
-*
- END
diff --git a/src/graflib/higz/ipost/ipiout.F b/src/graflib/higz/ipost/ipiout.F
deleted file mode 100644
index 78820a8..0000000
--- a/src/graflib/higz/ipost/ipiout.F
+++ /dev/null
@@ -1,40 +0,0 @@
-*
-* $Id: ipiout.F,v 1.1.1.1 1996/02/14 13:11:06 mclareni Exp $
-*
-* $Log: ipiout.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:06 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.21/12 25/10/94 13.21.32 by O.Couet
-*-- Author :
- SUBROUTINE IPIOUT(N)
-*.===========>
-*.
-*. Write the integer N in the PostScript file.
-*.
-*..==========> (O.Couet)
-#include "higz/hipost.inc"
- PARAMETER (LENSTR=16)
- CHARACTER*(LENSTR) STR
-*.______________________________________
-*
- STR = ' '
- WRITE (STR(2:),'(I15)') N
- I = 2
- 10 IF (STR(I:I).EQ.' ') THEN
- I = I+1
- GOTO 10
- ENDIF
- ILEN = LENSTR+2-I
- IF ((ILEN+LENBUF).GT.LENBMX) THEN
- WRITE (LUNPS,'(A)',ERR=999) STRBUF(1:LENBUF)
- STRBUF = STR(I-1:)
- LENBUF = ILEN
- ELSE
- STRBUF(LENBUF+1:) = STR(I-1:)
- LENBUF = LENBUF+ILEN
- ENDIF
-*
- 999 END
diff --git a/src/graflib/higz/ipost/ipjout.F b/src/graflib/higz/ipost/ipjout.F
deleted file mode 100644
index e814cbe..0000000
--- a/src/graflib/higz/ipost/ipjout.F
+++ /dev/null
@@ -1,30 +0,0 @@
-*
-* $Id: ipjout.F,v 1.1.1.1 1996/02/14 13:11:06 mclareni Exp $
-*
-* $Log: ipjout.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:06 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.12/00 08/02/91 16.41.22 by Unknown
-*-- Author :
- SUBROUTINE IPJOUT(NX,NY)
-*.===========>
-*.
-*. Write coordinate pair (nx,ny) in LaTeX file.
-*.
-*..==========> (A.Nathaniel)
- CHARACTER*20 STR
-*.______________________________________
-*
- STR='('
- CALL IZITOC(NX,STR(2:))
- L=LENOCC(STR)
- STR(L+1:)=','
- CALL IZITOC(NY,STR(L+2:))
- L=LENOCC(STR)
- STR(L+1:)=')'
- CALL IPPSTR(STR)
-*
- END
diff --git a/src/graflib/higz/ipost/ipkout.F b/src/graflib/higz/ipost/ipkout.F
deleted file mode 100644
index a064445..0000000
--- a/src/graflib/higz/ipost/ipkout.F
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: ipkout.F,v 1.1 2006/08/31 14:15:04 couet Exp $
-*
-* $Log: ipkout.F,v $
-* Revision 1.1 2006/08/31 14:15:04 couet
-* - needed for SVG
-*
-*
-#include "higz/pilot.h"
- SUBROUTINE IPKOUT(N)
-*.===========>
-*.
-*. Write integer in the SVG file with no space in front (unlike IPIOUT).
-*.
-*..==========> (O.Couet)
- CHARACTER*20 STR
-*.______________________________________
-*
- STR=' '
- CALL IZITOC(N,STR(1:))
- L=LENOCC(STR)
- CALL IPPSTR(STR(1:L))
-*
- END
diff --git a/src/graflib/higz/ipost/ipltyp.F b/src/graflib/higz/ipost/ipltyp.F
deleted file mode 100644
index 98aec04..0000000
--- a/src/graflib/higz/ipost/ipltyp.F
+++ /dev/null
@@ -1,79 +0,0 @@
-*
-* $Id: ipltyp.F,v 1.2 2005/10/28 12:38:14 couet Exp $
-*
-* $Log: ipltyp.F,v $
-* Revision 1.2 2005/10/28 12:38:14 couet
-* - SVG driver, workstation type -779
-*
-* Revision 1.1.1.1 1996/02/14 13:11:06 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.21/09 27/09/94 17.04.43 by O.Couet
-*-- Author :
- SUBROUTINE IPLTYP(LTYPE)
-*.===========>
-*.
-*. This routine writes the commands for changing the line style
-*. to the Postscript/LaTeX metafile.
-*.
-*. _Input parameters:
-*.
-*. INTEGER LTYPE : line type
-*. 2 = dashed
-*. 3 = dotted
-*. 4 = dash-dotted
-* else = solid
-*.
-*..==========> (A.Nathaniel)
-#include "higz/hiflag.inc"
-#include "higz/hipost.inc"
- IF(TFLAG) THEN
- IF(LTYPE.EQ.IPSLT)RETURN
- IPSLT=LTYPE
- IF(LTYPE.EQ.2) THEN
-*--- dashed line
- CALL IPPSTR(BSLASH//'let'//BSLASH//'higzline='//
- + BSLASH//'higzdashed'//BSLASH//'higzoffs=0'//
- + BSLASH//'higzadash=12'//BSLASH//'higzbdash=24'//
- + BSLASH//'higzcdash=36'//BSLASH//'higzddash=48')
- ELSEIF(LTYPE.EQ.3) THEN
-*--- dotted line
- CALL IPPSTR(BSLASH//'let'//BSLASH//'higzline='//
- + BSLASH//'higzdashed'//BSLASH//'higzoffs=0'//
- + BSLASH//'higzadash=1'//BSLASH//'higzbdash=12'//
- + BSLASH//'higzcdash=13'//BSLASH//'higzddash=24')
- ELSEIF(LTYPE.EQ.4) THEN
-*--- dash-dotted line
- CALL IPPSTR(BSLASH//'let'//BSLASH//'higzline='//
- + BSLASH//'higzdashed'//BSLASH//'higzoffs=0'//
- + BSLASH//'higzadash=12'//BSLASH//'higzbdash=24'//
- + BSLASH//'higzcdash=25'//BSLASH//'higzddash=36')
- ELSEIF(LTYPE.NE.0) THEN
-*--- solid line
- CALL IPPSTR(BSLASH//'let'//BSLASH//'higzline='//
- + BSLASH//'higzsolid')
- ENDIF
- ELSEIF(VFLAG) THEN
- IF(LTYPE.EQ.2) THEN
- CALL IPPSTF(23,' stroke-dasharray="3,3"')
- ELSEIF(LTYPE.EQ.3) THEN
- CALL IPPSTF(23,' stroke-dasharray="1,4"')
- ELSEIF(LTYPE.EQ.4) THEN
- CALL IPPSTF(27,' stroke-dasharray="3,4,1,4"')
- ENDIF
- ELSE
- IF(LTYPE.EQ.IPSLT)RETURN
- IPSLT=LTYPE
- IF(LTYPE.EQ.2) THEN
- CALL IPPSTF(13,' [12 12] 0 sd')
- ELSEIF(LTYPE.EQ.3) THEN
- CALL IPPSTF(11,' [4 8] 0 sd')
- ELSEIF(LTYPE.EQ.4) THEN
- CALL IPPSTF(18,' [12 15 4 15] 0 sd')
- ELSE
- CALL IPPSTF(8,' [] 0 sd')
- ENDIF
- ENDIF
- END
diff --git a/src/graflib/higz/ipost/iplwid.F b/src/graflib/higz/ipost/iplwid.F
deleted file mode 100644
index 747258c..0000000
--- a/src/graflib/higz/ipost/iplwid.F
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: iplwid.F,v 1.2 2005/10/28 12:38:14 couet Exp $
-*
-* $Log: iplwid.F,v $
-* Revision 1.2 2005/10/28 12:38:14 couet
-* - SVG driver, workstation type -779
-*
-* Revision 1.1.1.1 1996/02/14 13:11:07 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.21/09 27/09/94 17.04.43 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE IPLWID(IWID)
-*.===========>
-*.
-*. Set the line width
-*.
-*. _Input parameters:
-*.
-*. INTEGER IWID : Line width.
-*.
-*..==========> (O.Couet)
-#include "higz/hipost.inc"
-#include "higz/hiflag.inc"
-*.______________________________________
-*
- IF(VFLAG)THEN
- IF(IWID.LE.1)RETURN
- CALL IPPSTF(15,' stroke-width="')
- CALL IPKOUT(IWID/2)
- CALL IPPSTF(1,'"')
- ELSE
- IF(IWID.EQ.IPSLW)RETURN
- IPSLW=IWID
- CALL IPIOUT(IPSLW)
- CALL IPPSTF(3,' lw')
- ENDIF
-*
- END
diff --git a/src/graflib/higz/ipost/ipmark.F b/src/graflib/higz/ipost/ipmark.F
deleted file mode 100644
index 3c53c29..0000000
--- a/src/graflib/higz/ipost/ipmark.F
+++ /dev/null
@@ -1,63 +0,0 @@
-*
-* $Id: ipmark.F,v 1.3 2005/10/28 12:38:14 couet Exp $
-*
-* $Log: ipmark.F,v $
-* Revision 1.3 2005/10/28 12:38:14 couet
-* - SVG driver, workstation type -779
-*
-* Revision 1.1.1.1 1996/02/14 13:11:07 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.21/03 19/05/94 14.20.47 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE IPMARK
-*.===========>
-*.
-*. This routine define the markers
-*.
-*.==========> (O.Couet)
-#include "higz/hiflag.inc"
- IF (VFLAG) THEN
- CALL IPPSTR(' <marker id="M01"')
- CALL IPPSTR(' viewBox="0 0 10 10" refX="5" refY="5"')
- CALL IPPSTR(' markerUnits="strokeWidth"')
- CALL IPPSTR(' markerWidth="1" markerHeight="10"')
- CALL IPPSTR(' orient="auto">')
- CALL IPPSTR(' <circle cx="5" cy="5" r="5"/>')
- CALL IPPSTR(' </marker>')
- ELSE
- CALL IPPSTR('/mp {newpath /y exch def /x exch def} def@')
- CALL IPPSTR('/side {[w .77 mul w .23 mul] .385 w mul sd w 0 l curr
- +entpoint t -144 r} def@')
- CALL IPPSTR('/mr {mp x y w2 0 360 arc} def /m24 {mr s} def /m20 {m
- +r f} def@')
- CALL IPPSTR('/mb {mp x y w2 add m w2 neg 0 d 0 w neg d w 0 d 0 w d
- + cl} def@')
- CALL IPPSTR('/mt {mp x y w2 add m w2 neg w neg d w 0 d cl} def@')
- CALL IPPSTR('/m21 {mb f} def /m25 {mb s} def /m22 {mt f} def /m26
- +{mt s} def@')
- CALL IPPSTR('/m23 {mp x y w2 sub m w2 w d w neg 0 d cl f} def@')
- CALL IPPSTR('/m27 {mp x y w2 add m w3 neg w2 neg d w3 w2 neg d w3
- + w2 d cl s} def@')
- CALL IPPSTR('/m28 {mp x w2 sub y w2 sub w3 add m w3 0 d ')
- CALL IPPSTR(' 0 w3 neg d w3 0 d 0 w3 d w3 0 d ')
- CALL IPPSTR(' 0 w3 d w3 neg 0 d 0 w3 d w3 neg 0 d')
- CALL IPPSTR(' 0 w3 neg d w3 neg 0 d cl s } def@')
- CALL IPPSTR('/m29 {mp gsave x w2 sub y w2 add w3 sub m currentpoin
- +t t')
- CALL IPPSTR(' 4 {side} repeat cl fill gr} def@')
- CALL IPPSTR('/m30 {mp gsave x w2 sub y w2 add w3 sub m currentpoin
- +t t')
- CALL IPPSTR(' 5 {side} repeat s gr} def@')
- CALL IPPSTR('/m31 {mp x y w2 sub m 0 w d x w2 sub y m w 0 d')
- CALL IPPSTR(' x w2 sub y w2 add m w w neg d x w2 sub y w2')
- CALL IPPSTR(' sub m w w d s} def@')
- CALL IPPSTR('/m2 {mp x y w2 sub m 0 w d x w2 sub y m w 0 d s} def@
- +')
- CALL IPPSTR('/m5 {mp x w2 sub y w2 sub m w w d x w2 sub y w2 add m
- + w w neg d s} def@')
- ENDIF
-*
- END
diff --git a/src/graflib/higz/ipost/ipmove.F b/src/graflib/higz/ipost/ipmove.F
deleted file mode 100644
index 380ad2d..0000000
--- a/src/graflib/higz/ipost/ipmove.F
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: ipmove.F,v 1.1.1.1 1996/02/14 13:11:07 mclareni Exp $
-*
-* $Log: ipmove.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:07 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.21/09 26/09/94 15.23.41 by O.Couet
-*-- Author : O.Couet 05/04/94
- SUBROUTINE IPMOVE(IX,IY)
- IF (IX.NE.0.AND.IY.NE.0) THEN
- CALL IPIOUT(IX)
- CALL IPIOUT(IY)
- CALL IPPSTF(2,' d')
- ELSEIF (IX.NE.0) THEN
- CALL IPIOUT(IX)
- CALL IPPSTF(2,' X')
- ELSEIF (IY.NE.0) THEN
- CALL IPIOUT(IY)
- CALL IPPSTF(2,' Y')
- ENDIF
- END
diff --git a/src/graflib/higz/ipost/ippstr.F b/src/graflib/higz/ipost/ippstr.F
deleted file mode 100644
index e0e372e..0000000
--- a/src/graflib/higz/ipost/ippstr.F
+++ /dev/null
@@ -1,82 +0,0 @@
-*
-* $Id: ippstr.F,v 1.1.1.1 1996/02/14 13:11:07 mclareni Exp $
-*
-* $Log: ippstr.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:07 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.23/06 30/11/95 10.06.40 by O.Couet
-*-- Author :
- SUBROUTINE IPPSTR(STR)
-*.===========>
-*.
-*. Output the string STR in the buffer STRBUF
-*.
-*. _Input parameters:
-*.
-*. CHARACTER STR : String to be buffered.
-*.
-*..==========> (O.Couet)
-#include "higz/hipost.inc"
- CHARACTER*(*) STR
-*.______________________________________
-*
- LEN=LENOCC(STR)
- IF(STR(1:1).EQ.'@')THEN
- IF(LENBUF.NE.0)THEN
- WRITE(LUNPS,10000,ERR=999) STRBUF(1:LENBUF)
- ENDIF
- IF(LEN.LT.2)THEN
- STRBUF=' '
- ELSE
- STRBUF=STR(2:LEN)
- ENDIF
- LENBUF=LEN-1
- GOTO 999
- ENDIF
-*
- IF(STR(LEN:LEN).EQ.'@')THEN
- IF(LENBUF.NE.0)THEN
- WRITE(LUNPS,10000,ERR=999) STRBUF(1:LENBUF)
- ENDIF
- WRITE(LUNPS,10000,ERR=999) STR(1:LEN-1)
- LENBUF=0
- GOTO 999
- ENDIF
-*
- IF((LEN+LENBUF).GT.LENBMX)THEN
- WRITE(LUNPS,10000,ERR=999) STRBUF(1:LENBUF)
- STRBUF=STR(1:LEN)
- LENBUF=LEN
- ELSE
- STRBUF(LENBUF+1:) = STR(1:LEN)
- LENBUF = LENBUF+LEN
- ENDIF
- GOTO 999
-*
-*====> Fast write in the PS file
-*
- ENTRY IPPSTF(ILEN,STR)
-*
- IF((ILEN+LENBUF).GT.LENBMX)THEN
- WRITE (LUNPS,10000,ERR=999) STRBUF(1:LENBUF)
- STRBUF = STR(1:ILEN)
- LENBUF = ILEN
- ELSE
- STRBUF(LENBUF+1:) = STR(1:ILEN)
- LENBUF = LENBUF+ILEN
- ENDIF
- GOTO 999
-*
-*====> Fast write in the PS file without buffering
-* (Print Full STring)
-*
- ENTRY IPPFST(STR)
- LEN=LENOCC(STR)
- WRITE (LUNPS,10000,ERR=999) STR(1:LEN)
-*
-10000 FORMAT (A)
- 999 LOPRT = .TRUE.
- END
diff --git a/src/graflib/higz/ipost/iprng.F b/src/graflib/higz/ipost/iprng.F
deleted file mode 100644
index 5157d09..0000000
--- a/src/graflib/higz/ipost/iprng.F
+++ /dev/null
@@ -1,79 +0,0 @@
-*
-* $Id: iprng.F,v 1.1.1.1 1996/02/14 13:11:07 mclareni Exp $
-*
-* $Log: iprng.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:07 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.20/00 01/11/93 10.47.48 by O.Couet
-*-- Author : O.Couet 13/08/91
- SUBROUTINE IPRNG(XSIZI,YSIZI)
-*.==========>
-*.
-*. This routine sets the range for the paper in cm.
-*.
-*. _Input parameters:
-*.
-*. REAL XSIZ YSIZ : Paper range.
-*.
-*..=========>
-#include "higz/hiatt.inc"
-#include "higz/hipost.inc"
-*.______________________________________
-*
- XSIZ=XSIZI
- YSIZ=YSIZI
-*
- IF(IPSWTY.NE.-113)THEN
- XPS=XWKSIZ(IPSI)
- YPS=YWKSIZ(IPSI)
- ELSE
- XPS=XSIZ
- YPS=YSIZ
- ENDIF
- XPSR=XSIZ
- YPSR=YSIZ
-*
- IF(XSIZ.LE.XPS.AND.YSIZ.LT.YPS)THEN
- XYMAX=MAX(XPS,YPS)
- XNCM=XSIZ/XYMAX
- YNCM=YSIZ/XYMAX
- DXWN=((XPS/XYMAX)-XNCM)/2.
- DYWN=((YPS/XYMAX)-YNCM)/2.
- ELSE
- XWKWN=MIN(1.,XPS/YPS)
- YWKWN=MIN(1.,YPS/XPS)
-*
- IF (XSIZ.LT.YSIZ) THEN
- XNCM=YWKWN*XSIZ/YSIZ
- YNCM=YWKWN
- DXWN=(XWKWN-XNCM)/2.
- DYWN=0.
- IF(DXWN.LT.0.)THEN
- XNCM=XWKWN
- DXWN=0.
- YNCM=XWKWN*YSIZ/XSIZ
- DYWN=(YWKWN-YNCM)/2.
- ENDIF
- ELSE
- XNCM=XWKWN
- YNCM=XWKWN*YSIZ/XSIZ
- DXWN=0.
- DYWN=(YWKWN-YNCM)/2.
- IF(DYWN.LT.0.)THEN
- YNCM=YWKWN
- DYWN=0.
- XNCM=YWKWN*XSIZ/YSIZ
- DXWN=(XWKWN-XNCM)/2.
- ENDIF
- ENDIF
- ENDIF
- XVP1=DXWN
- XVP2=XNCM+DXWN
- YVP1=DYWN
- YVP2=YNCM+DYWN
- LOPRNG=.TRUE.
-*
- END
diff --git a/src/graflib/higz/ipost/ipscol.F b/src/graflib/higz/ipost/ipscol.F
deleted file mode 100644
index a416ba5..0000000
--- a/src/graflib/higz/ipost/ipscol.F
+++ /dev/null
@@ -1,63 +0,0 @@
-*
-* $Id: ipscol.F,v 1.2 2005/10/28 12:38:14 couet Exp $
-*
-* $Log: ipscol.F,v $
-* Revision 1.2 2005/10/28 12:38:14 couet
-* - SVG driver, workstation type -779
-*
-* Revision 1.1.1.1 1996/02/14 13:11:07 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.21/09 27/09/94 17.04.43 by O.Couet
-*-- Author :
- SUBROUTINE IPSCOL(ICOL)
-*.===========>
-*.
-*. Set the current color
-*.
-*. _Input parameters:
-*.
-*. INTEGER ICOL : Color Index.
-*.
-*..==========> (O.Couet)
-#include "higz/hiflag.inc"
-#include "higz/hipost.inc"
-#include "higz/hilut.inc"
-*.______________________________________
-*
- IPSCI=ICOL
- IF(IPSCI.LT.0)IPSCI=0
- IF(IPSCI.GT.NBCLUT-1)IPSCI=NBCLUT-1
- I=IPSCI+1
- IF(VFLAG)THEN
- CALL IPPSTF(5,'"rgb(')
- CALL IPKOUT(INT(REDLUT(I)*255.))
- CALL IPPSTF(1,',')
- CALL IPKOUT(INT(GRNLUT(I)*255.))
- CALL IPPSTF(1,',')
- CALL IPKOUT(INT(BLULUT(I)*255.))
- CALL IPPSTF(2,')"')
- ELSE
- IF(REDLUT(I).EQ.PSRED.AND.
- + GRNLUT(I).EQ.PSGRN.AND.
- + BLULUT(I).EQ.PSBLU)RETURN
- PSRED=REDLUT(I)
- PSGRN=GRNLUT(I)
- PSBLU=BLULUT(I)
- IF(.NOT.TFLAG) THEN
- IF(REDLUT(I).LE.0..AND.
- + GRNLUT(I).LE.0..AND.
- + BLULUT(I).LE.0.)THEN
- CALL IPPSTF(6,' black')
- ELSE
- CALL IPFOUT(REDLUT(I))
- CALL IPFOUT(GRNLUT(I))
- CALL IPFOUT(BLULUT(I))
- CALL IPPSTF(2,' c')
- ENDIF
- ENDIF
- ENDIF
-*
- END
diff --git a/src/graflib/higz/ipost/ipspec.F b/src/graflib/higz/ipost/ipspec.F
deleted file mode 100644
index 2540b8c..0000000
--- a/src/graflib/higz/ipost/ipspec.F
+++ /dev/null
@@ -1,94 +0,0 @@
-*
-* $Id: ipspec.F,v 1.1.1.1 1996/02/14 13:11:07 mclareni Exp $
-*
-* $Log: ipspec.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:07 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.16/01 13/08/92 18.40.25 by O.Couet
-*-- Author : P.Juillot 13/08/92
- SUBROUTINE IPSPEC
-*.===========>
-*.
-*. Reencode the Greek (/Symbol) font into the special font (/Special).
-*.
-*..==========> (O.Couet)
- CALL IPPSTR('@/accspe [')
- CALL IPPSTR(' 65 /plusminus ')
- CALL IPPSTR(' 66 /bar ')
- CALL IPPSTR(' 67 /existential ')
- CALL IPPSTR(' 68 /universal ')
- CALL IPPSTR('@69 /exclam ')
- CALL IPPSTR(' 70 /numbersign')
- CALL IPPSTR(' 71 /greater ')
- CALL IPPSTR(' 72 /question ')
- CALL IPPSTR(' 73 /integral ')
- CALL IPPSTR('@74 /colon ')
- CALL IPPSTR(' 75 /semicolon ')
- CALL IPPSTR(' 76 /less ')
- CALL IPPSTR(' 77 /bracketleft ')
- CALL IPPSTR(' 78 /bracketright')
- CALL IPPSTR('@79 /greaterequal')
- CALL IPPSTR(' 80 /braceleft')
- CALL IPPSTR(' 81 /braceright')
- CALL IPPSTR(' 82 /radical')
- CALL IPPSTR('@83 /spade')
- CALL IPPSTR(' 84 /heart')
- CALL IPPSTR(' 85 /diamond')
- CALL IPPSTR(' 86 /club')
- CALL IPPSTR(' 87 /lessequal')
- CALL IPPSTR('@88 /multiply')
- CALL IPPSTR(' 89 /percent')
- CALL IPPSTR(' 90 /infinity')
- CALL IPPSTR(' 48 /circlemultiply')
- CALL IPPSTR(' 49 /circleplus')
- CALL IPPSTR('@50 /emptyset ')
- CALL IPPSTR(' 51 /lozenge')
- CALL IPPSTR(' 52 /bullet')
- CALL IPPSTR(' 53 /arrowright')
- CALL IPPSTR(' 54 /arrowup')
- CALL IPPSTR('@55 /arrowleft')
- CALL IPPSTR(' 56 /arrowdown')
- CALL IPPSTR(' 57 /arrowboth')
- CALL IPPSTR(' 48 /degree')
- CALL IPPSTR(' 44 /comma')
- CALL IPPSTR(' 43 /plus')
- CALL IPPSTR(' 45 /angle')
- CALL IPPSTR(' 42 /angleleft')
- CALL IPPSTR(' 47 /divide')
- CALL IPPSTR(' 61 /notequal')
- CALL IPPSTR(' 40 /equivalence')
- CALL IPPSTR(' 41 /second')
-*
- CALL IPPSTR(' 97 /approxequal')
- CALL IPPSTR(' 98 /congruent')
- CALL IPPSTR(' 99 /perpendicular')
- CALL IPPSTR(' 100 /partialdiff')
- CALL IPPSTR(' 101 /florin')
- CALL IPPSTR(' 102 /intersection')
- CALL IPPSTR(' 103 /union')
- CALL IPPSTR(' 104 /propersuperset')
- CALL IPPSTR(' 105 /reflexsuperset')
- CALL IPPSTR(' 106 /notsubset')
- CALL IPPSTR(' 107 /propersubset')
- CALL IPPSTR(' 108 /reflexsubset')
- CALL IPPSTR(' 109 /element')
- CALL IPPSTR(' 110 /notelement')
- CALL IPPSTR(' 111 /gradient')
- CALL IPPSTR(' 112 /logicaland')
- CALL IPPSTR(' 113 /logicalor')
- CALL IPPSTR(' 114 /arrowdblboth')
- CALL IPPSTR(' 115 /arrowdblleft')
- CALL IPPSTR(' 116 /arrowdblup')
- CALL IPPSTR(' 117 /arrowdblright')
- CALL IPPSTR(' 118 /arrowdbldown')
- CALL IPPSTR(' 119 /ampersand')
- CALL IPPSTR(' 120 /omega1')
- CALL IPPSTR(' 121 /similar')
- CALL IPPSTR(' 122 /aleph')
- CALL IPPSTR(' ] def')
- CALL IPPSTR('/Symbol /Special accspe ReEncode@')
-*
- END
diff --git a/src/graflib/higz/ipost/ipsvrt.F b/src/graflib/higz/ipost/ipsvrt.F
deleted file mode 100644
index 8aaabb0..0000000
--- a/src/graflib/higz/ipost/ipsvrt.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: ipsvrt.F,v 1.1.1.1 1996/02/14 13:11:07 mclareni Exp $
-*
-* $Log: ipsvrt.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:07 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.23/01 24/05/95 10.21.27 by O.Couet
-*-- Author : O.Couet 24/05/95
- SUBROUTINE IPSVRT(IFLAG)
-#include "higz/hipost.inc"
- IF (IFLAG.EQ.1) THEN
- CALL IPPSTF(7,' gsave ')
- NBSAVE = NBSAVE+1
- ELSE
- CALL IPPSTF(4,' gr ')
- NBSAVE = NBSAVE-1
- ENDIF
- END
diff --git a/src/graflib/higz/ipost/iptext.F b/src/graflib/higz/ipost/iptext.F
deleted file mode 100644
index 99adb50..0000000
--- a/src/graflib/higz/ipost/iptext.F
+++ /dev/null
@@ -1,919 +0,0 @@
-*
-* $Id: iptext.F,v 1.5 2005/10/28 12:38:14 couet Exp $
-*
-* $Log: iptext.F,v $
-* Revision 1.5 2005/10/28 12:38:14 couet
-* - SVG driver, workstation type -779
-*
-* Revision 1.3 1996/03/08 16:53:41 couet
-* Comment line added after \ at the end of the line
-*
-* Revision 1.2 1996/02/29 16:30:41 cernlib
-* This had \\ at the end of some comments, which on osf disturbed the
-* following line-- was indented by a few blanks -- and the label ended
-* up beyond col. 6
-*
-* Revision 1.1.1.1 1996/02/14 13:11:07 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.23/02 28/08/95 14.31.19 by O.Couet
-*-- Author : P.Juillot 13/08/92
- SUBROUTINE IPTEXT(XX,YY,CHARS)
-*.===========>
-*.
-*. This routine writes the a into a PostScript file
-*. according to the IGTEXT control characters.
-*.
-*. _Input parameters:
-*.
-*. REAL XX,YY : Text position in world coordinates .
-*. CHARACTER CHARS : Text string .
-*.
-*..==========> (P.Juillot)
-#include "higz/hiatt.inc"
-#include "higz/hipost.inc"
-*
-* npiece= max number of pieces of text ( separated by escape characters)
- PARAMETER (NPIECE=50)
- DIMENSION IFNB(NPIECE),IFNS(NPIECE),LEVEL(NPIECE),LBACK(NPIECE)
-
-* maximum length of a (PostScript) string
-
- CHARACTER*(*) CHARS
- CHARACTER*512 NEWTXT
- CHARACTER*512 CHAR2
- CHARACTER*80 PIECE(NPIECE)
-
-* this common is needed for some routines in CHPACK (KERNLIB M432)
- COMMON /SLATE/ND,NE,NF,NG,DUMMY(36)
-
- CHARACTER*30 PSFONT(42)
- DIMENSION PSRAP(30)
- CHARACTER*3 PSTMP
- CHARACTER*13 CFLIP
- CHARACTER*3 CFLIPC(13)
-
- LOGICAL UPPER,LOWER,ESCAPE
- LOGICAL ROMAN,GREEK,SPECIA,ZAPF,NORMAL,SUB,SUPER
- LOGICAL OSHOW
-
- DATA CFLIP /'["?^]#!~&$<>@'/
- DATA CFLIPC /'133','42','77','136','135','43','41',
- + '176','46','44','74','76','100'/
- DATA PSRAP /1.031,1.000,1.026,0.932,0.931,0.931,0.930,1.204,1.204,
- + 1.168,1.166,1.007,1.026,0.964,
- + 16*1.0/
-
- DATA PSFONT /'/Times-Italic','/Times-Bold','/Times-BoldItalic'
- +,'/Helvetica','/Helvetica-Oblique','/Helvetica-Bold'
- +,'/Helvetica-BoldOblique','/Courier','/Courier-Oblique'
- +,'/Courier-Bold','/Courier-BoldOblique','/Symbol','/Times-Roman'
- +,'/ZapfDingbats','/Times-Italic','/Times-Bold','/Times-BoldItalic'
- +,'/Helvetica','/Helvetica-Oblique','/Helvetica-Bold'
- +,'/Helvetica-BoldOblique','/Symbol','/Times-Roman','/ZapfDingbats'
- +,'/Special','/ZapfChancery-MediumItalic','/AvantGarde-Book'
- +,'/AvantGarde-BookOblique','/AvantGarde-Demi'
- +,'/AvantGarde-DemiOblique','/Bookman-Demi','/Bookman-DemiItalic'
- +,'/Bookman-Light','/Bookman-LightItalic','/Palatino-Roman'
- +,'/Palatino-Italic','/Palatino-Bold','/Palatino-BoldItalic'
- +,'/NewCenturySchlbk-Roman','/NewCenturySchlbk-Italic'
- +,'/NewCenturySchlbk-Bold','/NewCenturySchlbk-BoldItalic'/
-*.______________________________________
-*
-#include "higz/hiwcps.inc"
-*
- X = XX
- Y = YY
- NOLD = MIN(LENOCC(CHARS),512)
-*
-* Text colour and vertical alignment
-*
- CALL IPSCOL(ITXCI)
- IF((ITXALV.EQ.2).OR.(ITXALV.EQ.1))THEN
- Y = Y-RCHH*COS((3.14159/180.)*RANGLE)
- X = X+RCHH*SIN((3.14159/180.)*RANGLE)
- ELSEIF(ITXALV.EQ.3)THEN
- Y = Y-(RCHH/2.)*COS((3.14159/180.)*RANGLE)
- X = X+(RCHH/2.)*SIN((3.14159/180.)*RANGLE)
- ENDIF
-*
-* Compute the fonts size. Exit if it is 0
-*
- NFON = ABS(IFONT)
- IF(NFON.GT.42.OR.NFON.LT.1)NFON = 1
- FONRAP = 75./51.
- IF(NFON.LE.14.AND.NFON.GE.1)FONRAP = FONRAP*PSRAP(NFON)
- IS = IYWCPS(RCHH*FONRAP)-IYWCPS(0.)
- IF(IS.LE.0)GOTO 999
- NP = IPREC
-*
-* The hollow fonts are set on by the roman font number
-* The number of passes define the width of the hollow text
-*
- OSHOW = .FALSE.
- IF (NFON.GT.14.AND.NFON.LT.25) THEN
- OSHOW = .TRUE.
- CALL IPIOUT(INPASS)
- CALL IPPSTR(' lw')
- ENDIF
-*
-* Start a first parsing:
-* - looking for the < and > escape characters,
-* - remove them and build a new string changing
-* upper <=> lower characters
-* - manage the '@' escape character
-* - check if the input string is not too long (J<=505)
-*
- ESCAPE = .FALSE.
- UPPER = .FALSE.
- LOWER = .FALSE.
- NEWTXT = ' '
- PSTMP = ' '
- J = 0
- DO 10 I=1,NOLD
- IF(J.GE.505)GOTO 360
- IF(ESCAPE)THEN
- ESCAPE = .FALSE.
- GOTO 10
- ENDIF
- IF(CHARS(I:I).EQ.'@')THEN
- IFLIP=INDEX(CFLIP,CHARS(I+1:I+1))
- IF(IFLIP.NE.0)THEN
- J = J+1
- NEWTXT(J:J) = BSLASH
- J = J+1
- NEWTXT(J:) = CFLIPC(IFLIP)
- J = LENOCC(NEWTXT)
- ESCAPE = .TRUE.
- GOTO 10
- ENDIF
- ENDIF
- IF (CHARS(I:I).EQ.'<') THEN
- LOWER = .TRUE.
- UPPER = .FALSE.
- ELSEIF(CHARS(I:I).EQ.'>') THEN
- LOWER = .FALSE.
- UPPER = .TRUE.
- ELSE
- PSTMP(1:1)=CHARS(I:I)
- IF(LOWER)CALL CUTOL(PSTMP(1:1))
- IF(UPPER)CALL CLTOU(PSTMP(1:1))
- J = J+1
- NEWTXT(J:J) = PSTMP(1:1)
- ENDIF
- 10 CONTINUE
- NCHP = LENOCC(NEWTXT)
-*
-* Now a second parsing to search for the PostScript
-* characters (following a \) and ( , ), \
-*
- CHAR2 = ' '
-* loop on NCHP old characters and look for \
-*
- IOLD=0
- INEW=0
- 20 IOLD=IOLD+1
- IF(IOLD.EQ.NCHP+1) GO TO 70
-*
-* 1. find an antislash
-*
- IF (NEWTXT(IOLD:IOLD).EQ.BSLASH) THEN
-* if this \ is not the last character of the string, then
-* study the character following this \
-*
- IF(IOLD.EQ.NCHP) GO TO 60
-*
-* 1.1 the character following this \ is also an \
-*
- IF (NEWTXT(IOLD+1:IOLD+1).EQ.BSLASH) THEN
-* copy both \\,
- INEW=INEW+1
- CHAR2(INEW:INEW)=BSLASH
- INEW=INEW+1
- CHAR2(INEW:INEW)=BSLASH
-* and go to the next character
- IOLD=IOLD+1
- GO TO 20
- ENDIF
-*
-* 1.2 the character following this \ is a parenthesis: ( or )
-*
- IF(NEWTXT(IOLD+1:IOLD+1).EQ.'(' .OR.
- + NEWTXT(IOLD+1:IOLD+1).EQ.')') THEN
-* copy the \ and the parenthesis,
- INEW=INEW+1
- CHAR2(INEW:INEW)=BSLASH
- INEW=INEW+1
- CHAR2(INEW:INEW)=NEWTXT(IOLD+1:IOLD+1)
-* and go to the following character
- IOLD=IOLD+1
- GO TO 20
- ENDIF
-*
-* 1.3 the character following this \ is also a special
-* PostScript character:
-* \n linefeed (newline)
-* \r carriage return
-* \t horizontal tab
-* \f form feed
-*
- IF(NEWTXT(IOLD+1:IOLD+1).EQ.'n' .OR.
- + NEWTXT(IOLD+1:IOLD+1).EQ.'r' .OR.
- + NEWTXT(IOLD+1:IOLD+1).EQ.'t' .OR.
- + NEWTXT(IOLD+1:IOLD+1).EQ.'f') THEN
-* copy nothing and go to the following character
- IOLD=IOLD+1
- GO TO 20
- ENDIF
-*
-* 1.4 the character following this \ is the special
-* PostScript character:
-* \b back space
-*
- IF(NEWTXT(IOLD+1:IOLD+1).EQ.'b') THEN
-* replace the sequence \b by the & escape character
- INEW=INEW+1
- CHAR2(INEW:INEW)='&'
-* and forget the b
- IOLD=IOLD+1
- GO TO 20
- ENDIF
-*
-* 1.5 the character following this \ is a digit between 0 and 7,
-* which means that the input text contains a string like \123 where
-* 123 is an octal number the accepted ranges are 40-176 and 241-376
-* ( all others are ASCII control characters )
-*
-* => first, study the range 40-77 (case of 2 digits after the \)
-*
- PSTMP=' '
- DO 40 K=40,77
- WRITE(PSTMP(1:2),'(I2.2)') K
- IADD = 0
- IF(PSTMP(1:2).EQ.NEWTXT(IOLD+1:IOLD+2))GOTO 30
- IF(NEWTXT(IOLD+1:IOLD+1).EQ.'0'.AND.
- + PSTMP(1:2).EQ.NEWTXT(IOLD+2:IOLD+3))THEN
- IADD = 1
- GOTO 30
- ENDIF
- GOTO 40
-* OK: copy the \ and the 2 following digits and add a 0
- 30 CHAR2(INEW+1:INEW+1) = BSLASH
- CHAR2(INEW+2:INEW+2) = '0'
- CHAR2(INEW+3:INEW+4) = NEWTXT(IOLD+1+IADD:IOLD+2+IADD)
- INEW = INEW+4
-* and go parsing the next following old character
- IOLD=IOLD+2+IADD
- GO TO 20
- 40 CONTINUE
-*
-* => then, study the ranges 100-177 and 241-377
-* (case of 3 digits after the \)
- PSTMP=' '
- DO 50 K=100,377
- IF(K.GE.178 .AND. K.LE.240) GO TO 50
- WRITE(PSTMP(1:3),'(I3.3)') K
- IF(PSTMP(1:3).EQ.NEWTXT(IOLD+1:IOLD+3))THEN
-* OK: copy the \ and the 3 following digits
- CHAR2(INEW+1:) = NEWTXT(IOLD:IOLD+3)
- INEW = INEW+4
-* and go parsing the next following old character
- IOLD = IOLD+3
- GO TO 20
- ENDIF
- 50 CONTINUE
-*
-* 1.6 this \ is followed by nothing understandable in PostScript,
-* it is an "isolated \" which will appear as \\ (leave one space for cpp)
-* copy two \\ (leave one space for cpp)
-*
- 60 INEW=INEW+1
- CHAR2(INEW:INEW)=BSLASH
- INEW=INEW+1
- CHAR2(INEW:INEW)=BSLASH
- GO TO 20
-*
-* 2. find ( or ) not preceeded by an \ : include one \
-*
- ELSEIF(NEWTXT(IOLD:IOLD).EQ.'('
- + .OR. NEWTXT(IOLD:IOLD).EQ.')') THEN
-* 2.1 if this (,) is not preceeded by a \, include one \
-*
- IF(I.EQ.1 .OR. NEWTXT(IOLD-1:IOLD-1).NE.BSLASH) THEN
- INEW=INEW+1
- CHAR2(INEW:INEW)=BSLASH
- INEW=INEW+1
- CHAR2(INEW:INEW)=NEWTXT(IOLD:IOLD)
- GO TO 20
- ENDIF
- GO TO 20
-* 3. treat normal text
- ELSE
- INEW=INEW+1
- CHAR2(INEW:INEW)=NEWTXT(IOLD:IOLD)
- ENDIF
- GO TO 20
- 70 CONTINUE
-
- NCHP=LENOCC(CHAR2)
-
-** now a third parsing to cut the text into pieces
-*** for each piece of text, I define
-* a. the string content = PIECE(I)
-* b. the font # = IFNB(I)= NFON: roman, 12: greek ,
-* 14: ZapfdingBats
-* c. the font size = IFNS(I)
-* d. a level flag = LEVEL(I) = 1: normal
-* 2: superscript
-* 3: subscript
-* e. a "backward" flag = LBACK(I) = 0: normal text ,
-* = 1: superscript and
-* subscript start at
-* the same x
-* = -n: for n backspaces
-*
- DO 80 I=1,50
- PIECE(I)=' '
- IFNS(I)=0
- IFNB(I)=0
- LEVEL(I)=0
- LBACK(I)=0
- 80 CONTINUE
-
- ROMAN=.TRUE.
- GREEK=.FALSE.
- SPECIA=.FALSE.
- ZAPF=.FALSE.
- NORMAL=.TRUE.
- SUPER=.FALSE.
- SUB=.FALSE.
-
-*NT=number for pieces of text
- NT=0
- I=0
- 90 I=I+1
- IF(I.GT.NCHP) GO TO 140
- NBAS=0
-*
-* read character number I and check if it is an escape character
-* using KERNLIB M432 with NG in /SLATE/ as return code
-*
- JX=ICFMUL(CFLIP,CHAR2,I,I)
- IF(NG.GT.0) THEN
-*
-* find [ : go to greek
-*
- IF(CHAR2(I:I).EQ.CFLIP(1:1)) THEN
- GREEK=.TRUE.
-*
-* find " : go to special
-*
- ELSE IF(CHAR2(I:I).EQ.CFLIP(2:2)) THEN
- SPECIA=.TRUE.
-* find ? : go to subscript
- ELSE IF(CHAR2(I:I).EQ.CFLIP(3:3)) THEN
- SUB=.TRUE.
- SUPER=.FALSE.
-* find ^ : go to superscript
- ELSE IF(CHAR2(I:I).EQ.CFLIP(4:4)) THEN
- SUPER=.TRUE.
- SUB=.FALSE.
-* find ] : end of greek or of Zapf=> go to roman
- ELSE IF(CHAR2(I:I).EQ.CFLIP(5:5)) THEN
- GREEK=.FALSE.
- ZAPF=.FALSE.
- ROMAN=.TRUE.
-* find # : end of special or of Zapf => go to roman
- ELSE IF(CHAR2(I:I).EQ.CFLIP(6:6)) THEN
- ROMAN=.TRUE.
- ZAPF=.FALSE.
- SPECIA=.FALSE.
-* find ! : go to normal level of script
- ELSE IF(CHAR2(I:I).EQ.CFLIP(7:7)) THEN
- NORMAL=.TRUE.
- SUPER=.FALSE.
- SUB=.FALSE.
-* find ~ : go to ZapfDingbats
- ELSE IF(CHAR2(I:I).EQ.CFLIP(8:8)) THEN
- ZAPF=.TRUE.
-* find & : backspace is required
- ELSE IF(CHAR2(I:I).EQ.CFLIP(9:9)) THEN
- NBAS=1
-* check if many backspaces are required:
-* compute how many consecutive backspaces
-* in the NCHP-I remaining characters
- DO 100 J=I+1,NCHP
- IF(CHAR2(J:J).EQ.CFLIP(9:9)) THEN
- NBAS=NBAS+1
- ELSE
- GO TO 110
- ENDIF
- 100 CONTINUE
- 110 CONTINUE
-*
-* Since I have to backspace some text, (part of the preceeding piece),
-* I define two pieces:
-*
-* a. the string which follows normally the & ( i.e. up to the next
-* escape character)
-*
-* b. the string to be backspaced, i.e. a part of the preceeding piece so
-* I create a new piece which is a copy the preceeding with LBACK<0
-*
- NT=NT+1
- LBACK(NT)=-NBAS
-* and the other parameters identical
- PIECE(NT)=PIECE(NT-1)
- IFNB(NT)=IFNB(NT-1)
- IFNS(NT)=IFNS(NT-1)
-* except the level, since the backspaced piece is not printed
- LEVEL(NT)=0
-* however, in case of multiple backspaces, take the &&&...&&& as a
-* whole
- IF(NBAS.GT.1) THEN
- I=I+NBAS-1
- GO TO 90
- ENDIF
-* find $ : optional terminaison character
- ELSE IF(CHAR2(I:I).EQ.CFLIP(10:10)) THEN
- IF(I.EQ.NCHP) GO TO 140
- ENDIF
-* the character is not a control character
- ELSE
-*
-* START of a new text: on the first character, or on the
-* first non escape char. which follows an escape char.
- IF(I.NE.1)JX=ICFMUL(CFLIP,CHAR2,I-1,I-1)
- IF(NG.NE.0.OR.I.EQ.1) THEN
- IDEB=I
- NT=NT+1
-* set font # (IFNB)
- IF(ROMAN) IFNB(NT)=NFON
- IF(GREEK) IFNB(NT)=12
- IF(ZAPF) IFNB(NT)=14
- IF(SPECIA) IFNB(NT)=25
-* set font size (IFNS)
- JSIZP=NINT(0.7*IS)
- JSIZB=NINT(0.7*IS)
- IFNS(NT)=IS
- IF(SUPER) IFNS(NT)=JSIZP
- IF(SUB) IFNS(NT)=JSIZB
-* set level flag (LEVEL)
- NYPOS=0
- NYSUP=NINT(IS/2.)
- NYSUB=NINT(-IS/3.)
- LEVEL(NT)=NYPOS
- IF(SUPER) LEVEL(NT)=NYSUP
- IF(SUB) LEVEL(NT)=NYSUB
- ENDIF
-*set LBACK flag (1 for sub/uperscript)
- IF(SUPER.OR.SUB) LBACK(NT)=1
-
-* END of a this text: on the last character or on
-* the last non escape which preceeds an escape (but
-* the terminating escape character itself is not known)
- IF(I.NE.NCHP)JX=ICFMUL(CFLIP,CHAR2,I+1,I+1)
- IF(NG.NE.0.OR.I.EQ.NCHP) THEN
- IFIN = I
-* compute text length and make one piece if length <74
-* and not 80, because of the () and \040 on the PostScript file
- ILEN = IFIN-IDEB+1
- IF(ILEN.LT.74) THEN
- PIECE(NT) = CHAR2(IDEB:IFIN)
-* if the last character is ' ' it is replaced with \040
- IF(CHAR2(IFIN:IFIN).EQ.' ')THEN
- PIECE(NT)(ILEN:ILEN) = BSLASH
- PIECE(NT)(ILEN+1:) = '040'
- ENDIF
-* make several pieces if length > 74
- ELSE
- I1 = IDEB
- I2 = I1+73
- NTS = NT
-* check if CHAR2 will not be cut in the middle of an octal code
- 120 IB = INDEX(CHAR2(I2-2:I2),BSLASH)
- IF (IB.NE.0.AND.I2-I1.EQ.73.AND.I2.NE.NCHP) I2 = I2-4+IB
-* copy CHAR2 in the piece number NT with I2 readjusted
- PIECE(NT) = CHAR2(I1:I2)
-* if the last character is ' ' it is replaced with \040
- IF(CHAR2(I2:I2).EQ.' ')THEN
- ILP = LENOCC(PIECE(NT))+1
- PIECE(NT)(ILP:ILP) = BSLASH
- PIECE(NT)(ILP+1:) = '040'
- ENDIF
- IF (I2.EQ.ILEN) GOTO 130
- I1 = I2+1
- I2 = MIN(ILEN,I1+73)
- NT = NT+1
- IFNB(NT) = IFNB(NTS)
- IFNS(NT) = IFNS(NTS)
- LEVEL(NT) = LEVEL(NTS)
- LBACK(NT) = LBACK(NTS)
- GOTO 120
- ENDIF
- 130 CONTINUE
- ENDIF
- ENDIF
- GO TO 90
- 140 CONTINUE
-*
-* Finally, a fourth parsing for 3 reasons:
-*
- DO 160 I=1,NT
-*** 1. LEVEL of sub/superscript after a multiple backsp. text:
-* one has:
-* i-2: text normally output lback=0
-* i-1 : text following in superscript mode
-* i : part of the preceeding (not printed) in which one
-* computes the backspace
-* i+1: text following the backspace
-* => since PIECE(i-1) and PIECE(I+1) are superposed;
-* I increase the level such that LEVEL(I-1)=IFNS(I-1)
-
- IF(LBACK(I).LT.-1) THEN
- IF (I.GT.1) THEN
-* superscript
- IF(LEVEL(I-1).GT.0) LEVEL(I-1)=IFNS(I-1)
-* subscript
- IF(LEVEL(I-1).LT.0) LEVEL(I-1)=-IFNS(I-1)
- ENDIF
- ENDIF
-
-*** 2. LEVEL of sub/ superscript after ONE backspaced text:
-* put the LEVEL to +(actual font size) for superscript
-* and to - (actuel font size) for subscript
- IF (I.GT.1) THEN
- IF(LBACK(I-1).EQ.-1) THEN
-* superscript
- IF(LEVEL(I).GT.0) LEVEL(I)=IFNS(I)
-* subscript
- IF(LEVEL(I).LT.0) LEVEL(I)=-IFNS(I)
- ENDIF
- ENDIF
-
-*** 3. correct in the greek text the 4 characters in the /Symbol font
-* which are not " at their correct place" w.r.t. the HIGZ official table
- IF(IFNB(I).EQ.12) THEN
- DO 150 J=1,LENOCC(PIECE(I))
- IF(PIECE(I)(J:J).EQ.'J') THEN
- PIECE(I)(J:J)='I'
- ELSEIF(PIECE(I)(J:J).EQ.'V') THEN
- PIECE(I)(J:J)='C'
- ELSEIF(PIECE(I)(J:J).EQ.'C') THEN
- PIECE(I)(J:J)='H'
- ELSEIF(PIECE(I)(J:J).EQ.'H') THEN
- PIECE(I)(J:J)='C'
-*
- ELSEIF(PIECE(I)(J:J).EQ.'j') THEN
- PIECE(I)(J:J)='i'
- ELSEIF(PIECE(I)(J:J).EQ.'v') THEN
- PIECE(I)(J:J)='c'
- ELSEIF(PIECE(I)(J:J).EQ.'c') THEN
- PIECE(I)(J:J)='h'
- ELSEIF(PIECE(I)(J:J).EQ.'h') THEN
- PIECE(I)(J:J)='c'
- ENDIF
- 150 CONTINUE
- ENDIF
- 160 CONTINUE
-*
-* write PS
-* position of text from arguments
-*
- PSANGL=RANGLE
-*
- CALL IPPSTR('@')
-
-* 1. text is left aligned
- IF(ITXALH.LE.1) THEN
- CALL IPSVRT(1)
- CALL IPDRAW(0,X,Y)
- CALL IPPSTR('@')
- WRITE (LUNPS,10000,ERR=350) NINT(PSANGL)
-10000 FORMAT(' t ',I3,' r 0 0 m')
-*
-* 2. the text is centered or right-adjusted => compute
-* the whole length
-*
- ELSEIF(ITXALH.EQ.2.OR.ITXALH.EQ.3) THEN
-
-* initialize the variable containing the string length
- WRITE(LUNPS,10100,ERR=350)
-10100 FORMAT(' /xs 0 def ')
-
-* loop on all pieces and add the length of each piece
- IPIECE=0
- 170 IPIECE=IPIECE+1
- IF(IPIECE.GT.NT) GO TO 250
-*
-* 2.1. ONE bakspaced text: forget the piece to be backspaced
-* and the piece which follows
-*
- IF(LBACK(IPIECE).EQ.-1) THEN
- IPIECE=IPIECE+1
- GO TO 170
- ENDIF
-*
-* 2.2 backspaced text by more than one backspace
-*
- IF(LBACK(IPIECE).LT.-1) THEN
- ILEN=LENOCC(PIECE(IPIECE))
- WRITE(LUNPS,13100,ERR=999) PIECE(IPIECE)(1:ILEN)
- WRITE(LUNPS,13400,ERR=350) ABS(LBACK(IPIECE))
- +, PSFONT(IFNB(IPIECE))(1:LENOCC(PSFONT(IFNB(IPIECE))))
- +, IFNS(IPIECE)
- GO TO 170
- ENDIF
-*
-* 2.3 many superscript and many subscript at the same x
-*
- IF(LBACK(IPIECE).EQ.1.AND.LBACK(IPIECE+1).EQ.1) THEN
-*
-* loop on pieces, computes how many pieces withe LBACK=1
-* and check if they are all at the same level;
-* if yes, this is "standart" text
- N1=0
- N2=0
- DO 180 J=IPIECE,NT
- IF(LBACK(J).NE.1) GO TO 190
- IF(LEVEL(J).EQ.LEVEL(IPIECE)) THEN
- N1=N1+1
- ELSE
- N2=N2+1
- ENDIF
- 180 CONTINUE
- 190 CONTINUE
- IF(N1.EQ.0.OR.N2.EQ.0) GO TO 240
-*
-* since many fonts are possible in sub/superscript, we output all
-* the pieces in super/subscript then thoses in sub/superscript
-*
-* a) first pieces subscript or superscript
- WRITE(LUNPS,10200)
-10200 FORMAT(' /s1 0 def ')
- DO 200 J=IPIECE,NT
- IF(LEVEL(J).NE.LEVEL(IPIECE)) GO TO 210
- WRITE(LUNPS,13200,ERR=350)
- + PSFONT(IFNB(J))(1:LENOCC(PSFONT(IFNB(J)))),IFNS(IPIECE)
- ILEN=LENOCC(PIECE(J))
- WRITE(LUNPS,10300,ERR=999) PIECE(J)(1:ILEN)
-10300 FORMAT(' (',A,') sw pop s1 add /s1 exch def')
-*
- NEW=J
- 200 CONTINUE
- 210 CONTINUE
-
-* b) then superscript or subscript
- WRITE(LUNPS,10400)
-10400 FORMAT(' /s2 0 def ')
- NEW=NEW+1
- DO 220 J=NEW,NT
- IF(LEVEL(J).NE.LEVEL(NEW)) GO TO 230
- WRITE(LUNPS,13200,ERR=350)
- + PSFONT(IFNB(J))(1:LENOCC(PSFONT(IFNB(J)))),IFNS(IPIECE)
- ILEN=LENOCC(PIECE(J))
- WRITE(LUNPS,10500,ERR=999) PIECE(J)(1:ILEN)
-10500 FORMAT(' (',A,') sw pop s2 add /s2 exch def')
- NNEW=J
- 220 CONTINUE
- 230 CONTINUE
-*
-* between subscript and superscript, which one is the longest?
- WRITE(LUNPS,10600,ERR=350)
-10600 FORMAT(' s1 s2 ge { xs s1 add /xs exch def}'
- + ,' { xs s2 add /xs exch def} ifelse ')
-*
-* since many pieces are treated :increase piece counter accordingly
- IPIECE=NNEW
- GO TO 170
- ENDIF
-*
-* 2.4. "standart" text:
-*
- 240 CONTINUE
- IF(LBACK(IPIECE).EQ.0.OR.LBACK(IPIECE).EQ.1) THEN
- ILEN=LENOCC(PIECE(IPIECE))
- WRITE(LUNPS,13100,ERR=999) PIECE(IPIECE)(1:ILEN)
- WRITE(LUNPS,10700,ERR=350)
- + PSFONT(IFNB(IPIECE))(1:LENOCC(PSFONT(IFNB(IPIECE))))
- +, IFNS(IPIECE)
-10700 FORMAT(1X,A,1X,I6,' stwn ')
- ENDIF
- GO TO 170
- 250 CONTINUE
-*
-* Centered text
-*
- IF(ITXALH.EQ.2) THEN
- CALL IPSVRT(1)
- CALL IPDRAW(0,X,Y)
- CALL IPPSTR('@')
- WRITE(LUNPS,10800,ERR=350) NINT(PSANGL)
-10800 FORMAT(' t ',I3,' r ',' xs 2 div neg 0 t 0 0 m')
-*
-* Right adjusted text
-*
- ELSEIF(ITXALH.EQ.3) THEN
- CALL IPSVRT(1)
- CALL IPDRAW(0,X,Y)
- CALL IPPSTR('@')
- WRITE(LUNPS,10900,ERR=350) NINT(PSANGL)
-10900 FORMAT(' t ',I3,' r ',' xs neg 0 t 0 0 m')
- ENDIF
- ENDIF
-
-* now output the pieces
- IPIECE=0
- 260 IPIECE=IPIECE+1
- IF(IPIECE.GT.NT) GO TO 340
-*
-* make the PostScript file:
-*
-* 1. ONE bakspace: output "piece" to be backspaced AND following piece
-* first save current graphic state, compute backward distance,
-* and move to that point
-*
- IF(LBACK(IPIECE).EQ.-1) THEN
- CALL IPSVRT(1)
- WRITE(LUNPS,11000,ERR=350)
- + PSFONT(IFNB(IPIECE))(1:LENOCC(PSFONT(IFNB(IPIECE))))
- +, IFNS(IPIECE)
-11000 FORMAT(A,' findfont ',I4,' sf ')
- ILEN=LENOCC(PIECE(IPIECE))
- WRITE(LUNPS,13100,ERR=999) PIECE(IPIECE)(1:ILEN)
- WRITE(LUNPS,11100,ERR=350)
-11100 FORMAT( ' dup length 1 sub 1 getinterval ')
- WRITE(LUNPS,11200,ERR=350) LEVEL(IPIECE)
-11200 FORMAT( ' stringwidth pop 2 div neg ',I4,' rm ')
-
-* then, text following one backspace: backspace also 1/2 of text
-* ( normally one character) print and restore preceeding graphic state
- WRITE(LUNPS,11300,ERR=350)
- + PSFONT(IFNB(IPIECE+1))(1:LENOCC(PSFONT(IFNB(IPIECE+1))))
- +, IFNS(IPIECE+1),LEVEL(IPIECE+1)
-11300 FORMAT(1X,A,' findfont ',I4,' sf 0 ',I4,' rm ')
- ILEN=LENOCC(PIECE(IPIECE+1))
- WRITE(LUNPS,13100,ERR=999) PIECE(IPIECE+1)(1:ILEN)
- WRITE(LUNPS,11400,ERR=350)
-11400 FORMAT(' stringwidth pop 2 div neg 0 rm ')
- ILEN=LENOCC(PIECE(IPIECE+1))
- WRITE(LUNPS,13100,ERR=999) PIECE(IPIECE+1)(1:ILEN)
- IF(OSHOW) THEN
- WRITE(LUNPS,'('' oshow'')',ERR=350)
- CALL IPSVRT(-1)
- ELSE
- WRITE(LUNPS,'('' show'')',ERR=350)
- CALL IPSVRT(-1)
- ENDIF
-* since two pieces are treated increase piece counter
- IPIECE=IPIECE+1
- GO TO 260
- ENDIF
-*
-* 2. Many Backspaces
-*
- IF(LBACK(IPIECE).LT.-1) THEN
-* first, protect against a number of bakspaces larger than
-* the total number of characters in the string to be
-* backspaced
- ILEN=LENOCC(PIECE(IPIECE))
- WRITE(LUNPS,13300,ERR=350) ABS(LBACK(IPIECE))
- +, PIECE(IPIECE)(1:ILEN)
-* then output
- WRITE(LUNPS,13200,ERR=350)
- + PSFONT(IFNB(IPIECE))(1:LENOCC(PSFONT(IFNB(IPIECE))))
- +, IFNS(IPIECE)
- WRITE(LUNPS,13100,ERR=999) PIECE(IPIECE)(1:ILEN)
- WRITE(LUNPS,11700,ERR=350)
-11700 FORMAT(' dup length nbas sub nbas getinterval stringwidth '
- + ,'pop neg 0 t ')
- GO TO 260
- ENDIF
-*
-* 3. superscript and subscript at the same x
- IF(LBACK(IPIECE).EQ.1.AND.LBACK(IPIECE+1).EQ.1) THEN
-*
-* loop on pieces, computes how many pieces withe LBACK=1
-* and check if they are all at the same level;
-* if yes, this is "standart" text
- N1=0
- N2=0
- DO 270 J=IPIECE,NT
- IF(LBACK(J).NE.1) GO TO 280
- IF(LEVEL(J).EQ.LEVEL(IPIECE)) THEN
- N1=N1+1
- ELSE
- N2=N2+1
- ENDIF
- 270 CONTINUE
- 280 CONTINUE
- IF(N1.EQ.0.OR.N2.EQ.0) GO TO 330
-*
-* since many fonts are possible in sub/superscript, we output all
-* the pieces in super/subscript then thoses in sub/superscript
-*
-* a) first pieces subscript or superscript
- CALL IPSVRT(1)
- CALL IPSVRT(1)
- WRITE(LUNPS,11900,ERR=350) LEVEL(IPIECE)
-11900 FORMAT(' 0 ',I4,' rm ')
-*
- DO 290 J=IPIECE,NT
- IF(LEVEL(J).NE.LEVEL(IPIECE)) GO TO 300
- WRITE(LUNPS,13200,ERR=350)
- + PSFONT(IFNB(J))(1:LENOCC(PSFONT(IFNB(J)))),IFNS(IPIECE)
- ILEN=LENOCC(PIECE(J))
- WRITE(LUNPS,13100,ERR=999) PIECE(J)(1:ILEN)
- IF(OSHOW) THEN
- WRITE(LUNPS,12000,ERR=350)
-12000 FORMAT(' dup oshow true charpath currentpoint pop'
- + ,' /s1 exch def')
- ELSE
- WRITE(LUNPS,12100,ERR=350)
-12100 FORMAT(' show currentpoint pop /s1 exch def')
- ENDIF
-*
- NEW=J
- 290 CONTINUE
- 300 CONTINUE
- CALL IPSVRT(-1)
-*
-* b) then superscript or subscript
- NEW=NEW+1
-*
- WRITE(LUNPS,11900,ERR=350) LEVEL(NEW)
- DO 310 J=NEW,NT
- IF(LEVEL(J).NE.LEVEL(NEW)) GO TO 320
- WRITE(LUNPS,13200,ERR=350)
- + PSFONT(IFNB(J))(1:LENOCC(PSFONT(IFNB(J)))),IFNS(IPIECE)
- ILEN=LENOCC(PIECE(J))
- WRITE(LUNPS,13100,ERR=999) PIECE(J)(1:ILEN)
- IF(OSHOW) THEN
- WRITE(LUNPS,12300,ERR=350)
-12300 FORMAT(' dup oshow true charpath currentpoint pop '
- + , ' /s2 exch def')
- ELSE
- WRITE(LUNPS,12400,ERR=350)
-12400 FORMAT(' show currentpoint pop /s2 exch def')
- ENDIF
- NNEW=J
- 310 CONTINUE
-
- 320 CONTINUE
- CALL IPSVRT(-1)
-*
-* at which x- value, should one translate the current state?
- WRITE(LUNPS,12500,ERR=350)
-12500 FORMAT(' s1 s2 ge {s1 0 t} {s2 0 t} ifelse ')
-*
-* since many pieces are treated :increase piece counter accordingly
- IPIECE=NNEW
- GO TO 260
- ENDIF
-*
-* 4. "standart" text: output current "piece" of text
-*
- 330 CONTINUE
- IF(LBACK(IPIECE).EQ.0.OR.LBACK(IPIECE).EQ.1) THEN
- WRITE(LUNPS,12600,ERR=350)
- + PSFONT(IFNB(IPIECE))(1:LENOCC(PSFONT(IFNB(IPIECE))))
- +, IFNS(IPIECE),LEVEL(IPIECE)
-12600 FORMAT(1X,A,' findfont ',I4,' sf 0 ',I4,' m ')
- ILEN=LENOCC(PIECE(IPIECE))
- WRITE(LUNPS,13100,ERR=999) PIECE(IPIECE)(1:ILEN)
- IF(OSHOW) THEN
- WRITE(LUNPS,12700,ERR=350)
-12700 FORMAT(' dup oshow')
-* move currentpoint ( if not last piece of text)
- IF(IPIECE.NE.NT) WRITE(LUNPS,12800,ERR=350)
-12800 FORMAT(' true charpath currentpoint pop 0 t ')
- ELSE
- WRITE(LUNPS,12900,ERR=350)
-12900 FORMAT(' show ')
-* move currentpoint ( if not last piece of text)
- IF(IPIECE.NE.NT) WRITE(LUNPS,13000,ERR=350)
-13000 FORMAT(' currentpoint pop 0 t ')
- ENDIF
- GO TO 260
- ENDIF
-
-* end of loop on pieces
- 340 CONTINUE
-
-* restore graphic state after the last piece of text
- CALL IPSVRT(-1)
- GOTO 999
-*
- 350 CALL IGERR('Cannot write in the PostScript file','IPTEXT')
- GOTO 999
-*
- 360 CALL IGERR('Too many characters in input string','IPTEXT')
-13100 FORMAT('(',A,')')
-13200 FORMAT(1X,A,' findfont ',I4,' sf')
-13300 FORMAT(1X,I4,' /nbas exch def ',/,1X,'(',A,')',/,
- +' length /tlen exch def nbas tlen gt { /nbas tlen def } if ')
-13400 FORMAT(' ',I2,' ',A,I4,' stwb ')
-*
- 999 END
diff --git a/src/graflib/higz/ipost/iptlin.F b/src/graflib/higz/ipost/iptlin.F
deleted file mode 100644
index 9e6932b..0000000
--- a/src/graflib/higz/ipost/iptlin.F
+++ /dev/null
@@ -1,39 +0,0 @@
-*
-* $Id: iptlin.F,v 1.1.1.1 1996/02/14 13:11:07 mclareni Exp $
-*
-* $Log: iptlin.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:07 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.12/16 14/08/91 09.49.15 by O.Couet
-*-- Author :
- SUBROUTINE IPTLIN(CMD,IX,IY)
- CHARACTER CMD*(*)
-*.===========>
-*.
-*. This routine writes a drawing command to the LaTeX metafile
-*.
-*. _Input parameters:
-*.
-*. CHARACTER CMD : name of drawing macro
-*. INTEGER IX,IY : coordinates
-*.
-*..==========> (A.Nathaniel)
-#include "higz/hipost.inc"
- CHARACTER*30 STR
-*.______________________________________
-*
- STR=BSLASH//CMD
- L=INDEX(STR,' ')
- CALL IZITOC(IX,STR(L:))
- IF(INDEX('hrUD',CMD).EQ.0) THEN
- L=INDEX(STR,' ')
- STR(L:)=','
- CALL IZITOC(IY,STR(L+1:))
- ENDIF
- L=INDEX(STR,' ')
- STR(L:)=';'
- CALL IPPSTR(STR)
- END
diff --git a/src/graflib/higz/ipost/iptmac.F b/src/graflib/higz/ipost/iptmac.F
deleted file mode 100644
index 3a77fe1..0000000
--- a/src/graflib/higz/ipost/iptmac.F
+++ /dev/null
@@ -1,293 +0,0 @@
-*
-* $Id: iptmac.F,v 1.1.1.1 1996/02/14 13:11:07 mclareni Exp $
-*
-* $Log: iptmac.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:07 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.13/02 23/09/91 14.04.17 by O.Couet
-*-- Author :
- SUBROUTINE IPTMAC
-*.===========>
-*.
-*. Write the LaTeX macro definitions to the metafile:
-*. \h<n>; horizontal line left
-*. \r<n>; horizontal line right
-*. \U<n>; vertical line up
-*. \D<n>; vertical line down
-*. \s<m>,<n>; slanted line
-*. \m<m>,<n>; move
-*. \p<m>,<n>; plot
-*. \f<m>,<n>; filled box
-*.
-*..==========> (A.Nathaniel)
-*.______________________________________
-*
-#include "higz/hiatt.inc"
-#include "higz/hipost.inc"
- CHARACTER CHDATE*20
-#include "higz/hivers.inc"
-
-* convert centimeter to minimal resolution 0.1mm
- IPTCM(CM)=INT(CM*100)
- CALL IGDATE(CHDATE)
- CALL IPPSTR('% HIGZ version'//CHVERS//
- + ' LaTeX metafile created '//CHDATE(:LENOCC(CHDATE))//'@')
-*------------------------------------------------------------------*
-* Don't change the following compressed macro definitions by hand. *
-* Instead change the expanded form in deck MACROTEX and insert the *
-* Fortran code generated by the awk script in deck MACROAWK: *
-* awk -f macro.awk macro.tex *
-*------------------------------------------------------------------*
- CALL IPPSTR(BSLASH//'ifx'//BSLASH//'higzunit')
- CALL IPPSTR(BSLASH//'undefined'//BSLASH//'unitlength=0pt{}')
- CALL IPPSTR(BSLASH//'else'//BSLASH//'unitlength=')
- CALL IPPSTR(BSLASH//'higzunit'//BSLASH//'fi')
- CALL IPPSTR(BSLASH//'ifdim'//BSLASH//'unitlength=0pt')
- CALL IPPSTR(BSLASH//'unitlength='//BSLASH//'textwidth')
- CALL IPPSTR(BSLASH//'divide'//BSLASH//'unitlength')
- CALL IPIOUT(IPTCM(X2W-X1W))
- CALL IPPSTR(BSLASH//'fi'//BSLASH//'par'//BSLASH//'noindent')
- CALL IPPSTR(BSLASH//'begin{picture}')
- CALL IPJOUT(IPTCM(X2W-X1W),IPTCM(Y2W-Y1W))
- CALL IPJOUT(IPTCM(X1W),IPTCM(Y1W))
- CALL IPPSTR(BSLASH//'ifx'//BSLASH//'higzdraft')
- CALL IPPSTR(BSLASH//'undefined'//BSLASH//'newcount')
- CALL IPPSTR(BSLASH//'higzdraft'//BSLASH//'higzdraft=0{}')
- CALL IPPSTR(BSLASH//'fi'//BSLASH//'ifnum'//BSLASH//'higzdraft>0')
- CALL IPPSTR(BSLASH//'put(0,0){'//BSLASH//'framebox')
- CALL IPJOUT(IPTCM(X2W-X1W),IPTCM(Y2W-Y1W))
- CALL IPPSTR('{}}'//BSLASH//'else'//BSLASH//'ifx')
- CALL IPPSTR(BSLASH//'higzstep'//BSLASH//'undefined')
- CALL IPPSTR(BSLASH//'newcount'//BSLASH//'higzstep')
- CALL IPPSTR(BSLASH//'higzstep=0{}'//BSLASH//'fi'//BSLASH//'ifnum')
- CALL IPPSTR(BSLASH//'higzstep<1'//BSLASH//'higzstep=2')
- CALL IPPSTR(BSLASH//'fi'//BSLASH//'ifx'//BSLASH//'higzxx')
- CALL IPPSTR(BSLASH//'undefined'//BSLASH//'newcount')
- CALL IPPSTR(BSLASH//'higzxx'//BSLASH//'newcount')
- CALL IPPSTR(BSLASH//'higzyy'//BSLASH//'newcount'//BSLASH//'higzx')
- CALL IPPSTR(BSLASH//'newcount'//BSLASH//'higzy')
- CALL IPPSTR(BSLASH//'newcount'//BSLASH//'higzdx')
- CALL IPPSTR(BSLASH//'newcount'//BSLASH//'higzdy')
- CALL IPPSTR(BSLASH//'newcount'//BSLASH//'higzlx')
- CALL IPPSTR(BSLASH//'newcount'//BSLASH//'higzly')
- CALL IPPSTR(BSLASH//'newcount'//BSLASH//'higzslope')
- CALL IPPSTR(BSLASH//'newcount'//BSLASH//'higzlen')
- CALL IPPSTR(BSLASH//'newcount'//BSLASH//'higzllen')
- CALL IPPSTR(BSLASH//'newcount'//BSLASH//'higzoffs')
- CALL IPPSTR(BSLASH//'newcount'//BSLASH//'higzloffs')
- CALL IPPSTR(BSLASH//'newcount'//BSLASH//'higzadash')
- CALL IPPSTR(BSLASH//'newcount'//BSLASH//'higzbdash')
- CALL IPPSTR(BSLASH//'newcount'//BSLASH//'higzcdash')
- CALL IPPSTR(BSLASH//'newcount'//BSLASH//'higzddash')
- CALL IPPSTR(BSLASH//'newcount'//BSLASH//'higzmsize')
- CALL IPPSTR(BSLASH//'newcount'//BSLASH//'higztemp'//BSLASH//'fi')
- CALL IPPSTR(BSLASH//'def'//BSLASH//'higzstroke#1,#2,#3,#4;{')
- CALL IPPSTR(BSLASH//'advance'//BSLASH//'higzloffs')
- CALL IPPSTR(BSLASH//'higzllen'//BSLASH//'ifnum')
- CALL IPPSTR(BSLASH//'higzloffs>#1'//BSLASH//'advance')
- CALL IPPSTR(BSLASH//'higzloffs-'//BSLASH//'higzllen')
- CALL IPPSTR(BSLASH//'advance'//BSLASH//'higzloffs-#1')
- CALL IPPSTR(BSLASH//'higzloffs=-'//BSLASH//'higzloffs')
- CALL IPPSTR(BSLASH//'ifnum#2>0'//BSLASH//'put(')
- CALL IPPSTR(BSLASH//'higzlx,'//BSLASH//'higzly){')
- CALL IPPSTR(BSLASH//'line(#3,#4){'//BSLASH//'higzloffs}}')
- CALL IPPSTR(BSLASH//'fi'//BSLASH//'ifnum#2<0'//BSLASH//'put(')
- CALL IPPSTR(BSLASH//'higzlx,'//BSLASH//'higzly){')
- CALL IPPSTR(BSLASH//'circle*{0}}'//BSLASH//'fi')
- CALL IPPSTR(BSLASH//'higztemp='//BSLASH//'higzloffs')
- CALL IPPSTR(BSLASH//'multiply'//BSLASH//'higztemp#3')
- CALL IPPSTR(BSLASH//'advance'//BSLASH//'higzlx')
- CALL IPPSTR(BSLASH//'higztemp'//BSLASH//'higztemp=')
- CALL IPPSTR(BSLASH//'higzloffs'//BSLASH//'multiply')
- CALL IPPSTR(BSLASH//'higztemp#4'//BSLASH//'advance')
- CALL IPPSTR(BSLASH//'higzly'//BSLASH//'higztemp')
- CALL IPPSTR(BSLASH//'advance'//BSLASH//'higzllen-')
- CALL IPPSTR(BSLASH//'higzloffs'//BSLASH//'higzloffs=#1')
- CALL IPPSTR(BSLASH//'else'//BSLASH//'ifnum#2>0'//BSLASH//'put(')
- CALL IPPSTR(BSLASH//'higzlx,'//BSLASH//'higzly){')
- CALL IPPSTR(BSLASH//'line(#3,#4){'//BSLASH//'higzllen}}')
- CALL IPPSTR(BSLASH//'fi'//BSLASH//'ifnum#2<0'//BSLASH//'put(')
- CALL IPPSTR(BSLASH//'higzlx,'//BSLASH//'higzly){')
- CALL IPPSTR(BSLASH//'circle*{0}}'//BSLASH//'fi')
- CALL IPPSTR(BSLASH//'higzllen=0'//BSLASH//'fi}'//BSLASH//'def')
- CALL IPPSTR(BSLASH//'higzdashed#1,#2,#3,#4,#5;{{')
- CALL IPPSTR(BSLASH//'higzlx=#1'//BSLASH//'higzly=#2')
- CALL IPPSTR(BSLASH//'higzllen=#5'//BSLASH//'higzloffs=')
- CALL IPPSTR(BSLASH//'higzoffs'//BSLASH//'loop'//BSLASH//'ifnum')
- CALL IPPSTR(BSLASH//'higzloffs<'//BSLASH//'higzadash')
- CALL IPPSTR(BSLASH//'ifnum'//BSLASH//'higzadash>1')
- CALL IPPSTR(BSLASH//'higzstroke'//BSLASH//'higzadash,1,#3,#4;')
- CALL IPPSTR(BSLASH//'else'//BSLASH//'higzstroke')
- CALL IPPSTR(BSLASH//'higzadash,-1,#3,#4;'//BSLASH//'fi')
- CALL IPPSTR(BSLASH//'else'//BSLASH//'ifnum'//BSLASH//'higzloffs<')
- CALL IPPSTR(BSLASH//'higzbdash'//BSLASH//'higzstroke')
- CALL IPPSTR(BSLASH//'higzbdash,0,#3,#4;'//BSLASH//'else')
- CALL IPPSTR(BSLASH//'ifnum'//BSLASH//'higzloffs<')
- CALL IPPSTR(BSLASH//'higzcdash'//BSLASH//'higztemp=')
- CALL IPPSTR(BSLASH//'higzcdash'//BSLASH//'advance')
- CALL IPPSTR(BSLASH//'higztemp-'//BSLASH//'higzbdash')
- CALL IPPSTR(BSLASH//'ifnum'//BSLASH//'higztemp>1')
- CALL IPPSTR(BSLASH//'higzstroke'//BSLASH//'higzcdash,1,#3,#4;')
- CALL IPPSTR(BSLASH//'else'//BSLASH//'higzstroke')
- CALL IPPSTR(BSLASH//'higzcdash,-1,#3,#4;'//BSLASH//'fi')
- CALL IPPSTR(BSLASH//'else'//BSLASH//'ifnum'//BSLASH//'higzloffs<')
- CALL IPPSTR(BSLASH//'higzddash'//BSLASH//'higzstroke')
- CALL IPPSTR(BSLASH//'higzddash,0,#3,#4;'//BSLASH//'else')
- CALL IPPSTR(BSLASH//'higzloffs=0'//BSLASH//'fi'//BSLASH//'fi')
- CALL IPPSTR(BSLASH//'fi'//BSLASH//'fi'//BSLASH//'ifnum')
- CALL IPPSTR(BSLASH//'higzllen>0'//BSLASH//'repeat')
- CALL IPPSTR(BSLASH//'global'//BSLASH//'higzoffs=')
- CALL IPPSTR(BSLASH//'higzloffs}}'//BSLASH//'def')
- CALL IPPSTR(BSLASH//'higzsolid#1,#2,#3,#4,#5;{')
- CALL IPPSTR(BSLASH//'put(#1,#2){'//BSLASH//'line(#3,#4){#5}}}')
- CALL IPPSTR(BSLASH//'def'//BSLASH//'higzhslant#1,#2,#3;{')
- CALL IPPSTR(BSLASH//'higzslope=#1'//BSLASH//'multiply')
- CALL IPPSTR(BSLASH//'higzslope1000'//BSLASH//'advance')
- CALL IPPSTR(BSLASH//'higzslope500'//BSLASH//'divide')
- CALL IPPSTR(BSLASH//'higzslope#2'//BSLASH//'higzlen=')
- CALL IPPSTR(BSLASH//'higzslope'//BSLASH//'multiply')
- CALL IPPSTR(BSLASH//'higzlen'//BSLASH//'higzstep')
- CALL IPPSTR(BSLASH//'divide'//BSLASH//'higzlen1000')
- CALL IPPSTR(BSLASH//'higzdy=0'//BSLASH//'loop'//BSLASH//'ifnum')
- CALL IPPSTR(BSLASH//'higzdy<#2'//BSLASH//'higzx=')
- CALL IPPSTR(BSLASH//'higzxx'//BSLASH//'higzy='//BSLASH//'higzyy')
- CALL IPPSTR(BSLASH//'higzdx='//BSLASH//'higzslope')
- CALL IPPSTR(BSLASH//'multiply'//BSLASH//'higzdx')
- CALL IPPSTR(BSLASH//'higzdy'//BSLASH//'advance')
- CALL IPPSTR(BSLASH//'higzdx500'//BSLASH//'divide')
- CALL IPPSTR(BSLASH//'higzdx1000'//BSLASH//'advance')
- CALL IPPSTR(BSLASH//'higzy'//BSLASH//'higzdy'//BSLASH//'multiply')
- CALL IPPSTR(BSLASH//'higzdx#3'//BSLASH//'advance')
- CALL IPPSTR(BSLASH//'higzx'//BSLASH//'higzdx'//BSLASH//'multiply')
- CALL IPPSTR(BSLASH//'higzdx#3'//BSLASH//'advance')
- CALL IPPSTR(BSLASH//'higzdx'//BSLASH//'higzlen'//BSLASH//'ifnum')
- CALL IPPSTR(BSLASH//'higzdx>#1'//BSLASH//'advance')
- CALL IPPSTR(BSLASH//'higzlen#1'//BSLASH//'advance')
- CALL IPPSTR(BSLASH//'higzlen-'//BSLASH//'higzdx'//BSLASH//'fi')
- CALL IPPSTR(BSLASH//'higzline'//BSLASH//'higzx,')
- CALL IPPSTR(BSLASH//'higzy,#3,0,'//BSLASH//'higzlen;')
- CALL IPPSTR(BSLASH//'advance'//BSLASH//'higzdy')
- CALL IPPSTR(BSLASH//'higzstep'//BSLASH//'repeat}'//BSLASH//'def')
- CALL IPPSTR(BSLASH//'higzvslant#1,#2,#3;{')
- CALL IPPSTR(BSLASH//'higzslope=#2'//BSLASH//'multiply')
- CALL IPPSTR(BSLASH//'higzslope1000'//BSLASH//'advance')
- CALL IPPSTR(BSLASH//'higzslope500'//BSLASH//'divide')
- CALL IPPSTR(BSLASH//'higzslope#1'//BSLASH//'higzlen=')
- CALL IPPSTR(BSLASH//'higzslope'//BSLASH//'multiply')
- CALL IPPSTR(BSLASH//'higzlen'//BSLASH//'higzstep')
- CALL IPPSTR(BSLASH//'divide'//BSLASH//'higzlen1000')
- CALL IPPSTR(BSLASH//'higzdx=0'//BSLASH//'loop'//BSLASH//'ifnum')
- CALL IPPSTR(BSLASH//'higzdx<#1'//BSLASH//'higzx=')
- CALL IPPSTR(BSLASH//'higzxx'//BSLASH//'higzy='//BSLASH//'higzyy')
- CALL IPPSTR(BSLASH//'higzdy='//BSLASH//'higzslope')
- CALL IPPSTR(BSLASH//'multiply'//BSLASH//'higzdy')
- CALL IPPSTR(BSLASH//'higzdx'//BSLASH//'advance')
- CALL IPPSTR(BSLASH//'higzdy500'//BSLASH//'divide')
- CALL IPPSTR(BSLASH//'higzdy1000'//BSLASH//'advance')
- CALL IPPSTR(BSLASH//'higzx'//BSLASH//'higzdx'//BSLASH//'multiply')
- CALL IPPSTR(BSLASH//'higzdy#3'//BSLASH//'advance')
- CALL IPPSTR(BSLASH//'higzy'//BSLASH//'higzdy'//BSLASH//'multiply')
- CALL IPPSTR(BSLASH//'higzdy#3'//BSLASH//'advance')
- CALL IPPSTR(BSLASH//'higzdy'//BSLASH//'higzlen'//BSLASH//'ifnum')
- CALL IPPSTR(BSLASH//'higzdy>#2'//BSLASH//'advance')
- CALL IPPSTR(BSLASH//'higzlen#2'//BSLASH//'advance')
- CALL IPPSTR(BSLASH//'higzlen-'//BSLASH//'higzdy'//BSLASH//'fi')
- CALL IPPSTR(BSLASH//'higzline'//BSLASH//'higzx,')
- CALL IPPSTR(BSLASH//'higzy,0,#3,'//BSLASH//'higzlen;')
- CALL IPPSTR(BSLASH//'advance'//BSLASH//'higzdx')
- CALL IPPSTR(BSLASH//'higzstep'//BSLASH//'repeat}'//BSLASH//'def')
- CALL IPPSTR(BSLASH//'s#1,#2;{'//BSLASH//'higzdx=#1{}')
- CALL IPPSTR(BSLASH//'ifnum'//BSLASH//'higzdx<0')
- CALL IPPSTR(BSLASH//'higzdx=-'//BSLASH//'higzdx'//BSLASH//'fi')
- CALL IPPSTR(BSLASH//'higzdy=#2{}'//BSLASH//'ifnum')
- CALL IPPSTR(BSLASH//'higzdy<0'//BSLASH//'higzdy=-')
- CALL IPPSTR(BSLASH//'higzdy'//BSLASH//'fi'//BSLASH//'ifnum')
- CALL IPPSTR(BSLASH//'higzdx<'//BSLASH//'higzdy'//BSLASH//'ifnum')
- CALL IPPSTR('#1<0'//BSLASH//'advance'//BSLASH//'higzxx#1')
- CALL IPPSTR(BSLASH//'advance'//BSLASH//'higzyy#2')
- CALL IPPSTR(BSLASH//'ifnum#2<0'//BSLASH//'higzvslant-#1,-#2,1;')
- CALL IPPSTR(BSLASH//'else'//BSLASH//'higzvslant-#1,#2,-1;')
- CALL IPPSTR(BSLASH//'fi'//BSLASH//'else'//BSLASH//'ifnum#2<0')
- CALL IPPSTR(BSLASH//'higzvslant#1,-#2,-1;'//BSLASH//'else')
- CALL IPPSTR(BSLASH//'higzvslant#1,#2,1;'//BSLASH//'fi')
- CALL IPPSTR(BSLASH//'advance'//BSLASH//'higzxx#1')
- CALL IPPSTR(BSLASH//'advance'//BSLASH//'higzyy#2'//BSLASH//'fi')
- CALL IPPSTR(BSLASH//'else'//BSLASH//'ifnum#2<0')
- CALL IPPSTR(BSLASH//'advance'//BSLASH//'higzxx#1')
- CALL IPPSTR(BSLASH//'advance'//BSLASH//'higzyy#2')
- CALL IPPSTR(BSLASH//'ifnum#1<0'//BSLASH//'higzhslant-#1,-#2,1;')
- CALL IPPSTR(BSLASH//'else'//BSLASH//'higzhslant#1,-#2,-1;')
- CALL IPPSTR(BSLASH//'fi'//BSLASH//'else'//BSLASH//'ifnum#1<0')
- CALL IPPSTR(BSLASH//'higzhslant-#1,#2,-1;'//BSLASH//'else')
- CALL IPPSTR(BSLASH//'higzhslant#1,#2,1;'//BSLASH//'fi')
- CALL IPPSTR(BSLASH//'advance'//BSLASH//'higzxx#1')
- CALL IPPSTR(BSLASH//'advance'//BSLASH//'higzyy#2'//BSLASH//'fi')
- CALL IPPSTR(BSLASH//'fi}'//BSLASH//'def'//BSLASH//'h#1;{')
- CALL IPPSTR(BSLASH//'higzline'//BSLASH//'higzxx,')
- CALL IPPSTR(BSLASH//'higzyy,1,0,#1;'//BSLASH//'advance')
- CALL IPPSTR(BSLASH//'higzxx#1}'//BSLASH//'def'//BSLASH//'r#1;{')
- CALL IPPSTR(BSLASH//'higzline'//BSLASH//'higzxx,')
- CALL IPPSTR(BSLASH//'higzyy,-1,0,#1;'//BSLASH//'advance')
- CALL IPPSTR(BSLASH//'higzxx-#1}'//BSLASH//'def'//BSLASH//'U#1;{')
- CALL IPPSTR(BSLASH//'higzline'//BSLASH//'higzxx,')
- CALL IPPSTR(BSLASH//'higzyy,0,1,#1;'//BSLASH//'advance')
- CALL IPPSTR(BSLASH//'higzyy#1}'//BSLASH//'def'//BSLASH//'D#1;{')
- CALL IPPSTR(BSLASH//'higzline'//BSLASH//'higzxx,')
- CALL IPPSTR(BSLASH//'higzyy,0,-1,#1;'//BSLASH//'advance')
- CALL IPPSTR(BSLASH//'higzyy-#1}'//BSLASH//'def')
- CALL IPPSTR(BSLASH//'m#1,#2;{'//BSLASH//'higzxx=#1')
- CALL IPPSTR(BSLASH//'higzyy=#2}'//BSLASH//'def')
- CALL IPPSTR(BSLASH//'higzdot#1,#2;{'//BSLASH//'put(#1,#2){')
- CALL IPPSTR(BSLASH//'circle*{'//BSLASH//'higzmsize}}}')
- CALL IPPSTR(BSLASH//'def'//BSLASH//'higzplus#1,#2;{')
- CALL IPPSTR(BSLASH//'higzx=#1'//BSLASH//'multiply')
- CALL IPPSTR(BSLASH//'higzx2'//BSLASH//'advance'//BSLASH//'higzx-')
- CALL IPPSTR(BSLASH//'higzmsize'//BSLASH//'divide')
- CALL IPPSTR(BSLASH//'higzx2'//BSLASH//'put(')
- CALL IPPSTR(BSLASH//'higzx,#2){'//BSLASH//'line(1,0){')
- CALL IPPSTR(BSLASH//'higzmsize}}'//BSLASH//'higzy=#2')
- CALL IPPSTR(BSLASH//'multiply'//BSLASH//'higzy2')
- CALL IPPSTR(BSLASH//'advance'//BSLASH//'higzy-')
- CALL IPPSTR(BSLASH//'higzmsize'//BSLASH//'divide')
- CALL IPPSTR(BSLASH//'higzy2'//BSLASH//'put(#1,')
- CALL IPPSTR(BSLASH//'higzy){'//BSLASH//'line(0,1){')
- CALL IPPSTR(BSLASH//'higzmsize}}}'//BSLASH//'def')
- CALL IPPSTR(BSLASH//'higzstar#1,#2;{'//BSLASH//'higzplus#1,#2;')
- CALL IPPSTR(BSLASH//'higzcross#1,#2;}'//BSLASH//'def')
- CALL IPPSTR(BSLASH//'higzcircle#1,#2;{'//BSLASH//'put(#1,#2){')
- CALL IPPSTR(BSLASH//'circle{'//BSLASH//'higzmsize}}}')
- CALL IPPSTR(BSLASH//'def'//BSLASH//'higzcross#1,#2;{')
- CALL IPPSTR(BSLASH//'let'//BSLASH//'higzsave'//BSLASH//'higzline')
- CALL IPPSTR(BSLASH//'let'//BSLASH//'higzline')
- CALL IPPSTR(BSLASH//'higzsolid'//BSLASH//'higzlx=#1')
- CALL IPPSTR(BSLASH//'multiply'//BSLASH//'higzlx2')
- CALL IPPSTR(BSLASH//'advance'//BSLASH//'higzlx-')
- CALL IPPSTR(BSLASH//'higzmsize'//BSLASH//'divide')
- CALL IPPSTR(BSLASH//'higzlx2'//BSLASH//'higzly=#2')
- CALL IPPSTR(BSLASH//'multiply'//BSLASH//'higzly2')
- CALL IPPSTR(BSLASH//'advance'//BSLASH//'higzly-')
- CALL IPPSTR(BSLASH//'higzmsize'//BSLASH//'divide')
- CALL IPPSTR(BSLASH//'higzly2'//BSLASH//'m'//BSLASH//'higzlx,')
- CALL IPPSTR(BSLASH//'higzly;'//BSLASH//'s'//BSLASH//'higzmsize,')
- CALL IPPSTR(BSLASH//'higzmsize;'//BSLASH//'higzly=#2')
- CALL IPPSTR(BSLASH//'multiply'//BSLASH//'higzly2')
- CALL IPPSTR(BSLASH//'advance'//BSLASH//'higzly')
- CALL IPPSTR(BSLASH//'higzmsize'//BSLASH//'divide')
- CALL IPPSTR(BSLASH//'higzly2'//BSLASH//'m'//BSLASH//'higzlx,')
- CALL IPPSTR(BSLASH//'higzly;'//BSLASH//'s'//BSLASH//'higzmsize,-')
- CALL IPPSTR(BSLASH//'higzmsize;'//BSLASH//'let')
- CALL IPPSTR(BSLASH//'higzline'//BSLASH//'higzsave}')
- CALL IPPSTR(BSLASH//'def'//BSLASH//'p#1,#2;{')
- CALL IPPSTR(BSLASH//'higzmarker#1,#2;}'//BSLASH//'def')
- CALL IPPSTR(BSLASH//'f#1,#2;{'//BSLASH//'put('//BSLASH//'higzxx,')
- CALL IPPSTR(BSLASH//'higzyy){'//BSLASH//'makebox(#1,#2)[lb]{')
- CALL IPPSTR(BSLASH//'rule{#1'//BSLASH//'unitlength')
- CALL IPPSTR('}{#2'//BSLASH//'unitlength}}}}')
-*------------------------------------------------------------------*
- CALL IPPSTR('% End of Initialisation@')
- CALL IPLTYP(0)
- CALL IPLTYP(ILN)
- END
diff --git a/src/graflib/higz/ipost/ipttex.F b/src/graflib/higz/ipost/ipttex.F
deleted file mode 100644
index 5aebd94..0000000
--- a/src/graflib/higz/ipost/ipttex.F
+++ /dev/null
@@ -1,187 +0,0 @@
-*
-* $Id: ipttex.F,v 1.1.1.1 1996/02/14 13:11:08 mclareni Exp $
-*
-* $Log: ipttex.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:08 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.12/16 14/08/91 16.21.01 by O.Couet
-*-- Author :
- SUBROUTINE IPTTEX(X,Y,CHARS)
- CHARACTER*(*) CHARS
-*.===========>
-*.
-*. This routine translates text to TeX format
-*. according to the IGTEXT control characters.
-*.
-*. _Input parameters:
-*.
-*. CHARACTER CHARS : Text string .
-*.
-*..==========> (A.Nathaniel)
-#include "higz/hiatt.inc"
-#include "higz/hipost.inc"
- PARAMETER(MFONTS=8)
- CHARACTER CH*1,FONTS(MFONTS)*2
- LOGICAL LOWER,LGREEK,LSPEC,LSUPER
- CHARACTER LETTER(26,4)*12
-*--- LaTeX names for greek letters and special symbols
-* '123456789012','123456789012','123456789012','123456789012'
- DATA (LETTER(I,1),I=1,26)/
- + '|alpha ','|beta ','|eta ','|delta ',
- + '|epsilon ','|phi ','|gamma ','|chi ',
- + '|iota ','|iota ','|kappa ','|lambda ',
- + '|mu ','|nu ','o ','|pi ',
- + '|theta ','|rho ','|sigma ','|tau ',
- + '|upsilon ','|chi ','|omega ','|xi ',
- + '|psi ','|zeta '/
- DATA (LETTER(I,2),I=1,26)/
- + 'A ','B ','H ','|Delta ',
- + 'E ','|Phi ','|Gamma ','X ',
- + 'I ','I ','K ','|Lambda ',
- + 'M ','N ','O ','|Pi ',
- + '|Theta ','R ','|Sigma ','T ',
- + '|Upsilon ','X ','|Omega ','|Xi ',
- + '|Psi ','Z '/
- DATA (LETTER(I,3),I=1,26)/
- + '|pm ','|mid ','|ast ','|$ ',
- + '! ','|# ','> ','? ',
- + '|int ',': ','; ','< ',
- + '[ ','] ','|leq ','|{ ',
- + '|} ','|surd ','|cap ','|dagger ',
- + '|ddagger ','|cup ','|& ','|times ',
- + '|partial ','|infty '/
- DATA (LETTER(I,4),I=1,26)/
- + '|pm ','|mid ','|div ','|$ ',
- + '! ','|# ','> ','? ',
- + '|int ',': ','; ','< ',
- + '[ ','] ','|geq ','|{ ',
- + '|} ','|surd ','|spadesuit ','|heartsuit ',
- + '|diamondsuit','|clubsuit ','|& ','|times ',
- + '|% ','|infty '/
-
- DATA FONTS/'rm','em','bf','it','sl','sf','sc','tt'/
-*.______________________________________
-*
-#include "higz/hiwcps.inc"
- IF(X.LT.X1W .OR. X.GT.X2W .OR. Y.LT.Y1W .OR. Y.GT.Y2W) RETURN
- CALL IPPSTR(BSLASH//'put')
- IXD=IXWCPS(X)
- IYD=IYWCPS(Y)
- CALL IPJOUT(IXD,IYD)
- CALL IPPSTR('{'//BSLASH//'makebox(0,0)')
- IF(ITXALH.NE.2 .OR. ITXALV.NE.3) THEN
- CALL IPPSTR('[')
- IF(ITXALV.EQ.1 .OR. ITXALV.EQ.2) THEN
- CALL IPPSTR('t')
- ELSEIF(ITXALV.NE.3) THEN
- CALL IPPSTR('b')
- ENDIF
- IF(ITXALH.EQ.3) THEN
- CALL IPPSTR('r')
- ELSEIF(ITXALH.NE.2) THEN
- CALL IPPSTR('l')
- ENDIF
- CALL IPPSTR(']')
- ENDIF
- IFNT=ABS(IFONT)
- IF(IFNT.LT.1 .OR. IFNT.GT.MFONTS) IFNT=1
- CALL IPPSTR('{$'//BSLASH//FONTS(IFNT)//'{}')
-
- LOWER=.FALSE.
- LGREEK=.FALSE.
- LSPEC=.FALSE.
- LSUPER=.FALSE.
-
- DO 10 I=1,LENOCC(CHARS)
- CH=CHARS(I:I)
- LLOW=ICHAR(CH)-ICHAR('a')+1
- LCAP=ICHAR(CH)-ICHAR('A')+1
- IF(LOWER .AND. LCAP.GE.1 .AND. LCAP.LE.26) THEN
- LLOW=LCAP
- LCAP=0
- CH=CHAR(LLOW+ICHAR('a')-1)
- ENDIF
- IF(LLOW.GE.1 .AND. LLOW.LE.26 .OR.
- + LCAP.GE.1 .AND. LCAP.LE.26) THEN
- IF(LLOW.GE.1 .AND. LLOW.LE.26) THEN
- IF(LGREEK) THEN
- ICASE=1
- ELSEIF(LSPEC) THEN
- ICASE=3
- ELSE
- ICASE=0
- ENDIF
- ELSE
- LLOW=LCAP
- IF(LGREEK) THEN
- ICASE=2
- ELSEIF(LSPEC) THEN
- ICASE=4
- ELSE
- ICASE=0
- ENDIF
- ENDIF
- IF(ICASE.EQ.0) THEN
- CALL IPPSTR(CH)
- ELSE
- L=INDEX(LETTER(LLOW,ICASE),' ')
- IF(L.EQ.0) L=LEN(LETTER(LLOW,ICASE))+1
- IF(LETTER(LLOW,ICASE)(1:1).EQ.'|') THEN
- CALL IPPSTR(BSLASH//LETTER(LLOW,ICASE)(2:L-1)//'{}')
- ELSE
- CALL IPPSTR(LETTER(LLOW,ICASE)(:L-1))
- ENDIF
- ENDIF
- ELSEIF(CH.EQ.' ') THEN
- CALL IPPSTR(BSLASH//' {}')
- ELSEIF(CH.EQ.'<') THEN
- LOWER=.TRUE.
- ELSEIF(CH.EQ.'>') THEN
- LOWER=.FALSE.
- ELSEIF(CH.EQ.'[') THEN
- LGREEK=.TRUE.
- LSPEC=.FALSE.
- ELSEIF(CH.EQ.']') THEN
- LGREEK=.FALSE.
- ELSEIF(CH.EQ.'"') THEN
- LSPEC=.TRUE.
- LGREEK=.FALSE.
- ELSEIF(CH.EQ.'#') THEN
- LSPEC=.FALSE.
- ELSEIF(CH.EQ.'^') THEN
- IF(LSUPER) CALL IPPSTR('}')
- CALL IPPSTR('^{')
- LSUPER=.TRUE.
- ELSEIF(CH.EQ.'?') THEN
- IF(LSUPER) CALL IPPSTR('}')
- CALL IPPSTR('_{')
- LSUPER=.TRUE.
- ELSEIF(CH.EQ.'!') THEN
- IF(LSUPER) CALL IPPSTR('}')
- LSUPER=.FALSE.
- ELSEIF(CH.EQ.'$') THEN
- IF(LSUPER) CALL IPPSTR('}')
- LSUPER=.FALSE.
- GOTO 20
- ELSEIF(CH.EQ.'*') THEN
- CALL IPPSTR(BSLASH//'ast{}')
- ELSEIF(INDEX('%}_',CH).GT.0) THEN
-*--- TeX special characters which need to be escaped
- CALL IPPSTR(BSLASH//CH)
- ELSEIF(CH.EQ.'{' .OR. CH.EQ.BSLASH) THEN
-*--- enter TeX mode
- IF(LSUPER) CALL IPPSTR('}')
- LSUPER=.FALSE.
- CALL IPPSTR(CHARS(I:))
- GOTO 20
- ELSE
- CALL IPPSTR(CH)
- ENDIF
- 10 CONTINUE
- 20 CONTINUE
- IF(LSUPER) CALL IPPSTR('}')
- CALL IPPSTR('$}}')
- END
diff --git a/src/graflib/higz/ipost/ipzone.F b/src/graflib/higz/ipost/ipzone.F
deleted file mode 100644
index 7e29d4c..0000000
--- a/src/graflib/higz/ipost/ipzone.F
+++ /dev/null
@@ -1,81 +0,0 @@
-*
-* $Id: ipzone.F,v 1.2 2005/10/28 12:38:14 couet Exp $
-*
-* $Log: ipzone.F,v $
-* Revision 1.2 2005/10/28 12:38:14 couet
-* - SVG driver, workstation type -779
-*
-* Revision 1.1.1.1 1996/02/14 13:11:08 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.23/02 30/05/95 14.43.59 by O.Couet
-*-- Author : O.Couet 13/08/91
- SUBROUTINE IPZONE
-#include "higz/hiatt.inc"
-#include "higz/hipost.inc"
-#include "higz/hiflag.inc"
-*.______________________________________
-*
- IF(.NOT.LOCLR.OR.TFLAG.OR.VFLAG)RETURN
- LOCLR=.FALSE.
-* When IPZONE has been called, LOZONE is TRUE
- LOZONE=.TRUE.
-*
- IF(IYZ.GT.NY)THEN
- IYZ=1
- IF(MODE.NE.3)THEN
- CALL IPPSTR('@showpage')
- CALL IPSVRT(-1)
- NPAGES = NPAGES+1
- CALL IPPSTR('@%%Page: number ')
- CALL IPIOUT(NPAGES)
- CALL IPPSTR('@')
- ELSE
- CALL IPPSTF(9,' showpage')
- CALL IPSVRT(-1)
- ENDIF
- ENDIF
-*
-* No grestore the first time
-*
- IF(MODE.NE.3)THEN
- IF (IXZ.NE.1.OR.IYZ.NE.1) CALL IPSVRT(-1)
- CALL IPSVRT(1)
- CALL IPPSTR('@')
- CALL IPIOUT(IXZ)
- CALL IPIOUT(IYZ)
- CALL IPPSTF(5,' Zone')
- CALL IPPSTR('@')
- IXZ=IXZ+1
- IF(IXZ.GT.NX)THEN
- IXZ=1
- IYZ=IYZ+1
- ENDIF
- ENDIF
-*
-* Picture Initialisation
-*
- CALL IPSVRT(1)
- CALL IPPSTF(5,'0 0 t')
- IPSLT = 0
- IPSLW = 0
- IPSCI = 0
- IPSMSC = -1
- PSRED = -1.
- PSGRN = -1.
- PSBLU = -1.
- CALL IPSCOL(1)
- CALL IPLTYP(1)
- CALL IPLWID(1)
- LOPRT=.FALSE.
-*
-* Force the clipping definition if required.
-*
- IF (ICLIP.NE.0) THEN
- IPDXC = -IPDXC
- CALL ISCLIP(ICLIP)
- ENDIF
-*
- END
diff --git a/src/graflib/higz/iwin32/iw_text.c b/src/graflib/higz/iwin32/iw_text.c
deleted file mode 100644
index 2b9f2d0..0000000
--- a/src/graflib/higz/iwin32/iw_text.c
+++ /dev/null
@@ -1,254 +0,0 @@
-#define CERNLIB_QFMSOFT
-#define CERNLIB_QXCAPT
-#define type_of_call _stdcall
-
-#include <windows.h>
-
-#include <stdio.h>
-#include <string.h>
-#include <stdlib.h>
-#include <ctype.h>
-#include <math.h>
-
-#include "ix_win32.h"
-#include "iw_text.h"
-
-#ifdef CERNLIB_QX_NC
-#define igxmes igxmes_
-#define ixopnwi ixopnwi_
-#endif
-
-#ifdef CERNLIB_QXCAPT
-#define igxmes type_of_call IGXMES
-#define ixopnwi type_of_call IXOPNWI
-#endif
-
-static BOOL open = {FALSE};
-
-int lenocc(char *c,int l)
- {
- int i;
- for (i=l-1;i>=0 && c[i] == " ";i--);
- return i+1;
- }
-
-
-/*_______________________________________________________________*/
-/* This is a pool of routines to present text in Windows/NT */
-
-#ifndef CERNLIB_QFMSOFT
-void igxmes(ix, iy, nc, n, chmess, chtit, chopt, chmess_len,
- chtit_len, chopt_len)
-#else
-void igxmes(ix, iy, nc, n, chmess, chmess_len,
- chtit, chtit_len,
- chopt, chopt_len)
-#endif
-
-int *ix, *iy, *nc, *n;
-char *chmess, *chtit, *chopt;
-int chmess_len;
-int chtit_len;
-int chopt_len;
-{
- char *title;
- static HWND hwnd, hwndEdit;
- struct CREATEHIGZWINDOW WinThr;
- static RECT FmtRect;
- char *temp;
- int i,j,k, sw;
-
- sw=0; for(i=0;i<chopt_len;i++) if (*(chopt+i) == 'P') sw = i+1;
-
- if (sw) {
- if (!open) {
-
- WinThr.x = *ix;
- WinThr.y = *iy;
- WinThr.w = 180;
-
- WinThr.h = 160;
-
- FmtRect.left = 10;
- FmtRect.right = WinThr.w - FmtRect.left - 10;
- FmtRect.top = 0;
- FmtRect.bottom = WinThr.h;
-
- WinThr.lentit = lenocc(chtit,chtit_len)+1;
- title = malloc( WinThr.lentit );
- memcpy(title,chtit,WinThr.lentit-1);
- title[WinThr.lentit-1] = (char)NULL;
- WinThr.title = title;
- WinThr.flag = 2;
-
-
- /* Create HIGZ message window */
-
- WinThr.semaphore = CreateSemaphore(NULL, 0, 1, NULL);
-
- while(!PostThreadMessage(IDThread,
- IX11_HIGZ_MSG,MAKEWPARAM(IX_OPNWI,HIGZ_Control), &WinThr));
-
- WaitForSingleObject(WinThr.semaphore, INFINITE);
- CloseHandle(WinThr.semaphore);
- free(title);
-
- hwnd = WinThr.hwnd;
- hwndEdit = (HWND)GetWindowLong(hwnd,0);
-
- ShowWindow(WinThr.hwnd,SW_SHOWDEFAULT);
- UpdateWindow(WinThr.hwnd);
- }
-/* Allocate intermediate buffer for whole page */
- j = (chmess_len+2)*(*n); /* Two bytes should be reserved to intend "hard end of line" */
- title = malloc(j+1);
-/* Copy a user message to itermediate buffer */
- j = 0; k=0;
- for (i=0;i<*n;i++) {
- memcpy(&title[j],&chmess[k],chmess_len); /* Copy one string */
- j += lenocc(&chmess[k],chmess_len); /* Truncate it */
- title[j] = (char)13; /* insert "hard end-of-line" */
- j++;
- title[j] = (char)10;
- j++;
- title[j] = (char)0;
- k += chmess_len;
- }
-
-
- if (!open) {
- SendMessage(hwndEdit, EM_SETRECT, 0, &FmtRect);
- open = TRUE;
- }
- i = SendMessage(hwndEdit, EM_GETFIRSTVISIBLELINE, 0, 0);
- SendMessage(hwndEdit,WM_SETTEXT,0,(LPARAM) title);
- if (i) SendMessage(hwndEdit,EM_LINESCROLL,0, (LPARAM) i);
- free(title);
- }
- sw=0; for(i=0;i<chopt_len;i++) if (chopt[i] == 'C') sw = 1;
- if (sw) {
- if (open) {
- SendMessage(hwnd,WM_CLOSE, 0, 0);
- open = FALSE;
- }
- }
- sw=0; for(i=0;i<chopt_len;i++) if (chopt[i] == 'D') sw = 1;
- if (sw) SendMessage(hwndEdit,WM_SETTEXT,0, 0);
- }
-
-/*_______________________________________________________________*/
-HWND CreateTextClass(WinThr)
- struct CREATEHIGZWINDOW *WinThr;
- {
- HWND hwndHIGZ;
- HMENU hmenu;
- WNDCLASS text_display;
-
-/* Make sure that this window hasn't been registered yet */
-
- if (!GetClassInfo(GetModuleHandle(NULL),TEXTCLASS,&text_display)) {
-
- /* Set the common wndClass information. This is common for all windows
- ** of this application.
- */
-
- text_display.style = CS_HREDRAW | CS_VREDRAW;
- text_display.cbClsExtra = 0;
-
- text_display.cbWndExtra = 4;
-
- text_display.hCursor = LoadCursor(NULL, IDC_IBEAM);
- text_display.hInstance = GetModuleHandle (NULL);
-
- /*
- ** Reister the main top-level window
- */
-
- text_display.lpfnWndProc = (WNDPROC) WndText;
- text_display.hIcon = LoadIcon(NULL, IDI_APPLICATION);
- text_display.hbrBackground = GetStockObject(WHITE_BRUSH);
- text_display.lpszMenuName = NULL;
- text_display.lpszClassName = TEXTCLASS;
-
- if (!RegisterClass(&text_display)) return -1;
- }
-/* Create "frame" window */
- hmenu = CreateMenu();
- AppendMenu(hmenu,MF_STRING,IDM_EDCOPY,"&Copy");
- hwndHIGZ = CreateWindowEx(
- WS_EX_TOPMOST,
- TEXTCLASS, /*extended window style */
- string(WinThr->title,WinThr->lentit), /*address of window name */
-//= WS_OVERLAPPED | WS_VISIBLE |
-//= WS_THICKFRAME,
- WS_OVERLAPPEDWINDOW,
- // | WS_VSCROLL | WS_HSCROLL, /* Window style */
- WinThr->x, WinThr->y, // *x, *y,
- WinThr->w, WinThr->h, // *w, *h,
- NULL, /*handle of parent of owner window */
- hmenu, /*handle of menu, or child-window identifier */
- text_display.hInstance, /*handle of application instance */
- NULL); /*address of window-creation data */
- return hwndHIGZ;
-}
-
-/*_______________________________________________________________*/
-LRESULT APIENTRY WndText(hwnd, uMsg, wParam, lParam)
-HWND hwnd;
-UINT uMsg;
-WPARAM wParam;
-LPARAM lParam;
-{
- static HWND hwndEdit;
-
- switch (uMsg) {
- case WM_CREATE:
- hwndEdit = CreateWindow(
- "EDIT", /* Predefined class */
- NULL, /* no window title */
- WS_CHILD | WS_VISIBLE | WS_VSCROLL |
- ES_LEFT | ES_MULTILINE | ES_AUTOVSCROLL,
- 0,0,0,0, /* set size in WM_SIZE message */
- hwnd, /* parent window */
- (HMENU) ID_EDITCHILD , /* edit control ID */
- (HINSTANCE) GetWindowLong(hwnd, GWL_HINSTANCE),
- NULL); /* pointer not need */
- SetWindowLong(hwnd,0, hwndEdit);
- break;
- case WM_COMMAND:
- switch (wParam) {
- case IDM_EDCOPY:
- SendMessage(hwndEdit, WM_COPY, 0, 0);
- break;
- default:
- return DefWindowProc(hwnd,uMsg,wParam,lParam);
- }
- break;
-
- case WM_SETFOCUS:
- SetFocus(hwndEdit);
- break;
-
- case WM_SIZE:
-
- /*
- * Make the edit control the size of the window's
- * client area
- */
-
- MoveWindow(hwndEdit,
- 0,0, /* Starting x- and y-coordinates */
- LOWORD(lParam), /* width of client area */
- HIWORD(lParam), /* height of client area */
- TRUE); /* repaint window */
- break;
-
- case WM_DESTROY:
- open = FALSE;
- break;
- default: break;
-
- }
- return DefWindowProc(hwnd,uMsg,wParam,lParam);
- }
-
diff --git a/src/graflib/higz/iwin32/iw_text.h b/src/graflib/higz/iwin32/iw_text.h
deleted file mode 100644
index 8cff15d..0000000
--- a/src/graflib/higz/iwin32/iw_text.h
+++ /dev/null
@@ -1,19 +0,0 @@
-#define TEXTCLASS "HIGZTEXT"
-
-#define IDM_EDCOPY 1
-#define ID_EDITCHILD 1
-#define TEXT_BUFFER 2048
-
-LRESULT APIENTRY WndText(HWND, UINT, WPARAM, LPARAM);
-
-typedef struct tagTextWindow {
- struct TextWindow *ptbw; // Previous Winodws in this list
- struct TextWindow *ptfw; // Next Windows in this list
- HWND hwnd; // Handle of this Windows
- HDC hdcWindow; // Device context of display
- RECT HIGZWindowSize; // size of the client area of the
- // window in logical untis
- int WinType; // Type of HIGZ window
- // window variables for HIGZ text input facility
- DWORD dwCharX, dwCharY, dwAscent;
- } TextWindow;
diff --git a/src/graflib/higz/iwin32/ix_higz.c b/src/graflib/higz/iwin32/ix_higz.c
deleted file mode 100755
index d0d4db1..0000000
--- a/src/graflib/higz/iwin32/ix_higz.c
+++ /dev/null
@@ -1,3956 +0,0 @@
-#define CERNLIB_QXCAPT
-#define CERNLIB_QFMSOFT
-#define type_of_call _stdcall
-#include <windows.h>
-#include <math.h>
-#include "ix_win32.h"
-
-#define ColorOffset 20
-#define HIGZColorIndex(ic) ColorIndex(ic)
-
-/* #include <f2c.h> */ // +SEQ, F2C.
-#define IX11_HIGZ_Input IX11_HIGZ_MSG+1
- enum ListDC {
-/*
- * Windows 95 checks to see if cbWndExtra or cbClsExtra is greater than 40. If
- */
- LastExtraMember};
-
- static struct HIGZWindow *cHw = NULL, // Current HIGZ Window
- *fHw = NULL, // First HIGZ Window
- *lHw = NULL, // Last HIGZ Window
- *lpHpixmap = NULL; // Current pixmap
- static int Number_of_HIGZ_Windows = 0; // Total numaber of the HIGZ
- // Windows
-
-
-/*___________________________________________________________________*/
-/* X11 output primitives
-**
-** HIGZ_Primitive
-*/
-
-enum L_HIGZ_Primitive
- {
- IX_LINE , // Draw a line through all points
- IX_MARKE, // Draw a marker ar each point
- IX_FLARE, // Fill area described by polygon
- IX_BOX , // Draw a box
- IX_CA // Draw a cell array
- };
-
-/* X11 text
-**
-** HIGZ_Text
-*/
-
-enum L_HIGZ_Text
- {
- IX_TEXT, // Draw a text string using the current font
- IX_TXTL, // Return the width and height of character string in the current font
- IW_SETCH // Set a height for the charatcter
- };
-
-
-/* X11 output attributes
-**
-** HIGZ_Attribute
-*/
-
-enum L_HIGZ_Attribute
- {
- IX_SETCO, // Set color intensities for given colour index
- IX_SETLN, // Set line width
- IX_SETLS, // Set line style
- IX_SETLC, // Set colour index for lines
- IX_DRMDE // Set drawing mode
- };
-
-/* X11 marker style
-**
-** HIGZ_Marker
-*/
-
-enum L_HIGZ_Marker
- {
- IX_SETMS, // Set market style
- IX_SETMC, // Set colour indx for markers
- IX_SETFS, // Set fill area style
- IX_SETFC, // Set colour index for fill area
-
- IX_SETTA, // Set text alignment
- IX_SETTF, // Set text font to specified name
- IX_SETTC, // Set colour index for text
- IX_SYNC , // X11 synchronization
- };
-
-
-/* X11 input functions
-**
-** HIGZ_Input
- */
-
-enum L_HIGZ_Input
- {
- IX_REQLO, // Request locator input.
- IX_REQST // Request a string input
- };
-
-
-/* X11 inquiry routines
-**
-** HIGZ_Inquiry
- */
-
-enum L_HIGZ_Inquiry
- {
- IX_GETGE, // Returns position and size of Window
- IX_GETWI, // Returns the X11 window identifier
- IX_GETPL, // Returns the maximal number of planes of the display
- IX_GETCOL // Returns the X11 colour representation
- };
-
-
-/* Pixmap manipulation
-**
-** HIGZ_Pixmap
- */
-
-enum L_HIGZ_Pixmap
- {
- IX_OPNPX, // Open a new pixmap
- IX_CLPX , // Close the current opened pixmap
- IX_CPPX , // Copy the pixmap
- IX_CLRPX, // Clear the pixmap
- IX_RMPX , // Remove the pixmap
- IX_WRPX , // Write the pixmap
- IX_WIPX // Copy the area in the current window
- };
-
-
-/* Dummies
-**
-** HIGZ_Dummies
- */
-
-enum L_HIGZ_Dummies
- {
- IX_S2BUF,
- IX_SDSWI
- };
-
-#define WndActHeader( arg ) LRESULT APIENTRY \
- Wnd_(arg) (hwnd, uMsg, wParam, lParam) \
- HWND hwnd; UINT uMsg; WPARAM wParam; LPARAM lParam;
-
-/*-- Author : V.Fine */
-/*
- * Fortran interface to Window/NT SDK routines for HIGZ
- */
-#include <stdio.h>
-#include <string.h>
-#include <stdlib.h>
-#include <ctype.h>
-#include <math.h>
-
-
-
-#ifdef CERNLIB_QX_SC
-#define igerr igerr_
-#define wrtlst wrtlst_
-#define clrlst clrlst_
-#define ixbord ixbord_
-
-
-
-#define ixclip ixclip_
-#define ixclrwi ixclrwi_
-#define ixclsds ixclsds_
-#define ixclswi ixclswi_
-#define ixflare ixflare_
-#define ixgetge ixgetge_
-#define ixgetpl ixgetpl_
-#define ixgetht ixgetht_
-#define ixline ixline_
-#define ixmarke ixmarke_
-#define ixnocli ixnocli_
-#define ixopnds ixopnds_
-#define ixopnwi ixopnwi_
-#define ixreqlo ixreqlo_
-#define ixreqst ixreqst_
-#define ixselwi ixselwi_
-#define ixsetco ixsetco_
-#define ixsetfc ixsetfc_
-#define ixsetfs ixsetfs_
-#define ixsetlc ixsetlc_
-#define ixsetln ixsetln_
-#define ixsetls ixsetls_
-#define ixsetmc ixsetmc_
-#define ixsetms ixsetms_
-#define ixsetta ixsetta_
-#define ixsettc ixsettc_
-#define ixsettf ixsettf_
-#define ixtext ixtext_
-#define ixupdwi ixupdwi_
-#define ixbox ixbox_
-#define ixtxtl ixtxtl_
-#define ixdrmde ixdrmde_
-#define ixsync ixsync_
-#define ixsethn ixsethn_
-#define ixopnpx ixopnpx_
-#define ixclpx ixclpx_
-#define ixcppx ixcppx_
-#define ixrmpx ixrmpx_
-#define ixwipx ixwipx_
-#define ixclrpx ixclrpx_
-#define ixs2buf ixs2buf_
-#define ixq2buf ixq2buf_
-#define ixwrpx ixwrpx_
-#define ixrsiz ixrsiz_
-#define ixsavwi ixsavwi_
-#define ixsetwi ixsetwi_
-#define ixrscwi ixrscwi_
-#define ixminit ixminit_
-#define ixca ixca_
-#define ixldgif ixldgif_
-#define ixdogif ifdogif_
-#endif
-
-#ifdef CERNLIB_QXCAPT
-#define igerr IGERR
-#define wrtlst WRLST
-#define clrlst CLRLST
-#define ixbord IXBORD
-
-
-
-#define ixclip type_of_call IXCLIP
-#define ixclrwi type_of_call IXCLRWI
-#define ixclsds type_of_call IXCLSDS
-#define ixclswi type_of_call IXCLSWI
-#define ixflare type_of_call IXFLARE
-#define ixgetge type_of_call IXGETGE
-#define ixgetpl type_of_call IXGETPL
-#define ixgetht type_of_call IXGETHT
-#define ixline type_of_call IXLINE
-#define ixmarke type_of_call IXMARKE
-#define ixnocli type_of_call IXNOCLI
-#define ixopnds type_of_call IXOPNDS
-#define ixopnwi type_of_call IXOPNWI
-#define ixreqlo type_of_call IXREQLO
-#define ixreqst type_of_call IXREQST
-#define ixselwi type_of_call IXSELWI
-#define ixsetco type_of_call IXSETCO
-#define ixsetfc type_of_call IXSETFC
-#define ixsetfs type_of_call IXSETFS
-#define ixsetlc type_of_call IXSETLC
-#define ixsetln type_of_call IXSETLN
-#define ixsetls type_of_call IXSETLS
-#define ixsetmc type_of_call IXSETMC
-#define ixsetms type_of_call IXSETMS
-#define ixsetta type_of_call IXSETTA
-#define ixsettc type_of_call IXSETTC
-#define ixsettf type_of_call IXSETTF
-#define ixtext type_of_call IXTEXT
-#define ixupdwi type_of_call IXUPDWI
-#define ixbox type_of_call IXBOX
-#define ixtxtl type_of_call IXTXTL
-#define ixdrmde type_of_call IXDRMDE
-#define ixsync type_of_call IXSYNC
-#define ixsethn type_of_call IXSETHN
-#define ixopnpx type_of_call IXOPNPX
-#define ixclpx type_of_call IXCLPX
-#define ixcppx type_of_call IXCPPX
-#define ixrmpx type_of_call IXRMPX
-#define ixwipx type_of_call IXWIPX
-#define ixclrpx type_of_call IXCLRPX
-#define ixs2buf type_of_call IXS2BUF
-#define ixq2buf type_of_call IXQ2BUF
-#define ixwrpx type_of_call IXWRPX
-#define ixrsiz type_of_call IXRSIZ
-#define ixsavwi type_of_call IXSAVWI
-#define ixsetwi type_of_call IXSETWI
-#define ixrscwi type_of_call IXRSCWI
-#define ixminit type_of_call IXMINIT
-#define ixca type_of_call IXCA
-#define ixldgif type_of_call IXLDGIF
-#define ixdogif type_of_call IXDOGIF
-#endif
-
-/* #define ixmotif ixmotif_ */
-/* +SELF. */
-
-#define forever while(1)
-#define LNULL 0L
-
-#define XPoint POINT /* Change Xpoint by X11 to POINT by Windows/NT */
-
-#define MAXWN 20 /* maximum number of windows */
-static struct {
- int open; /* 1 if the window is open, 0 if not */
- int motif; /* 1 if the window is a motif window */
- int double_buffer; /* 1 if the double buffer is on, 0 if not */
- int width; /* width of the window */
- int height; /* height of the window */
- int clip; /* 1 if the clipping is on */
- int xclip; /* x coordinate of the clipping rectangle */
- int yclip; /* y coordinate of the clipping rectangle */
- int wclip; /* width of the clipping rectangle */
- int hclip; /* height of the clipping rectangle */
-
- LOGPEN pen; /********* */
- LOGBRUSH gcfill;
- LOGFONT font;
- LOGPALETTE palette;
- BITMAP pixmap;
-
-} windows[MAXWN], /* windows : list of the opened windows */
- *cws, *tws, *sws; /* cws : pointer to the current window */
-
-#define MAXCOL 256
- static int maxcol;
-
- struct HIGZPEN {
- LOGPEN pen;
- LOGBRUSH brush;
- int lUserDash;
- int *UserDash;
- } pen = { BS_SOLID,0, 0, 1, // lopnStyle, lopnWidth, lopnColor
- BS_SOLID, 0, 0, // lbStyle, lbColor, lbHatch
- 0, NULL}; // n dashes, pointer to an array of dashes
- LOGBRUSH gcfill;
-
- LOGFONT HIGZFont = { 0, // lfHeight
- 0, // lfWidth
- 0, // lfEscapement
- 0, // lfOrientation (doesn't used by HIGZ)
- 400, // lfWeigh (Normal = 400, BOLD =800)
- FALSE, // lfItalic
- FALSE, // lfUnderline
- FALSE, // lfStrikeOut
- ANSI_CHARSET, // lfCharSet
- OUT_DEFAULT_PRECIS, // lfOutPrecision
- CLIP_DEFAULT_PRECIS,
- DEFAULT_QUALITY,
- FF_DONTCARE, // lfPitchAndFamily;
- };
- PALETTEENTRY HIGZcolors[MAXCOL];
- NPLOGPALETTE lpPalette; // = {0x300, MAXCOL, HIGZcolors};
- BOOLEAN bord = {FALSE};
-
-
-/* Global variable to plot HIGZ graphics cursor */
- static RECT rect;
- static HPEN CurPen;
- static HBRUSH CurBrush;
- static HRGN CurClipRgn;
-/* ==================================================== */
-
-/* Common HANDLES of the graphics attributes for all HIGZ windows */
-
-static HPALETTE hdCommonPalette = NULL;
-static HBRUSH hdCommonBrush = NULL;
-static HPEN hdCommonPen = NULL;
-static HFONT hdCommonFont = NULL;
-static HPEN hdCursorPen; // Pen to draw HIGZ locator
-static HBRUSH hdCursorBrush; // Brush to draw HIGZ locator 3 or 5
-static RECT CommonClipRectangle;
-static int dwCommonTextAlign = TA_LEFT | TA_BASELINE;
-static COLORREF dwCommonTextColor;
-static BOOL PixMapON = {FALSE};
-
- int ixText,iyText;
- static HWND ConWindow; // Handler of console window
-
-/* ==================================================== */
-
-
-/* =================== */
-static int ispix = 0; /* if ispix=1 a pixmap has been opened */
-
-static char hname[132]; /* host name */
-
-static int external_int = 0;
-
-static int do_raise = 0; /* if do_raise =1 cws is raised in ixupdwi */
-
-
-/* External variables for Windows/NT */ // V.E. Fine 21.07.93
-
-#ifdef WINEX
- WNDCLASSEX *p_higz_display, higz_display;
-#else
- WNDCLASS *p_higz_display, higz_display;
-#endif
-
-HWND CurrentHIGZWindow;
-HDC CurrentDC, MetaFileDC, HistoryDC;
-
-/* LOGPALLETE HIGZ_palette[MAXCOL];
- HPALETTE WindowPalette;
- */
-
-
-/*
- * colors[1] : foreground also used for b/w screen
- * colors[0] : background also used for b/w screen
- * colors[2..MAXCOL-1] : colors which can be set by IXSETCO
- */
-static int colored; /* Flag if color screen */
-
-static struct {
- int defined;
- unsigned long pixel;
- float red;
- float green;
- float blue;
-} colors[MAXCOL] = {0, 0, 1., 1., 1.};
-
-/*
- * Primitives Graphic Contexts global for all windows
- */
-
-/*
- * Input echo Graphic Context global for all windows
- */
-
-static int fill_hollow; /* Flag if fill style is hollow */
-static int current_fasi = 0; /* Current fill area style index */
-static int align_hori = -1; /* Align text left, center, right */
-static int align_vert = -1; /* Align text bottom, middle, top */
-
-
-static int current_font_number = 0; /* current font number in font[] */
-
-
-/*
- * data to create fill area interior style
- */
-static char p1_bits[] = {
- ~(0xaa), ~(0xaa), ~(0x55), ~(0x55), ~(0xaa), ~(0xaa), ~(0x55), ~(0x55), ~(0xaa), ~(0xaa), ~(0x55), ~(0x55),
- ~(0xaa), ~(0xaa), ~(0x55), ~(0x55), ~(0xaa), ~(0xaa), ~(0x55), ~(0x55), ~(0xaa), ~(0xaa), ~(0x55), ~(0x55),
- ~(0xaa), ~(0xaa), ~(0x55), ~(0x55), ~(0xaa), ~(0xaa), ~(0x55), ~(0x55)};
-static char p2_bits[] = {
- ~(0x44), ~(0x44), ~(0x11), ~(0x11), ~(0x44), ~(0x44), ~(0x11), ~(0x11), ~(0x44), ~(0x44), ~(0x11), ~(0x11),
- ~(0x44), ~(0x44), ~(0x11), ~(0x11), ~(0x44), ~(0x44), ~(0x11), ~(0x11), ~(0x44), ~(0x44), ~(0x11), ~(0x11),
- ~(0x44), ~(0x44), ~(0x11), ~(0x11), ~(0x44), ~(0x44), ~(0x11), ~(0x11)};
-static char p3_bits[] = {
- ~(0x00), ~(0x00), ~(0x44), ~(0x44), ~(0x00), ~(0x00), ~(0x11), ~(0x11), ~(0x00), ~(0x00), ~(0x44), ~(0x44),
- ~(0x00), ~(0x00), ~(0x11), ~(0x11), ~(0x00), ~(0x00), ~(0x44), ~(0x44), ~(0x00), ~(0x00), ~(0x11), ~(0x11),
- ~(0x00), ~(0x00), ~(0x44), ~(0x44), ~(0x00), ~(0x00), ~(0x11), ~(0x11)};
-static char p4_bits[] = {
- ~(0x80), ~(0x80), ~(0x40), ~(0x40), ~(0x20), ~(0x20), ~(0x10), ~(0x10), ~(0x08), ~(0x08), ~(0x04), ~(0x04),
- ~(0x02), ~(0x02), ~(0x01), ~(0x01), ~(0x80), ~(0x80), ~(0x40), ~(0x40), ~(0x20), ~(0x20), ~(0x10), ~(0x10),
- ~(0x08), ~(0x08), ~(0x04), ~(0x04), ~(0x02), ~(0x02), ~(0x01), ~(0x01)};
-static char p5_bits[] = {
- ~(0x20), ~(0x20), ~(0x40), ~(0x40), ~(0x80), ~(0x80), ~(0x01), ~(0x01), ~(0x02), ~(0x02), ~(0x04), ~(0x04),
- ~(0x08), ~(0x08), ~(0x10), ~(0x10), ~(0x20), ~(0x20), ~(0x40), ~(0x40), ~(0x80), ~(0x80), ~(0x01), ~(0x01),
- ~(0x02), ~(0x02), ~(0x04), ~(0x04), ~(0x08), ~(0x08), ~(0x10), ~(0x10)};
-static char p6_bits[] = {
- ~(0x44), ~(0x44), ~(0x44), ~(0x44), ~(0x44), ~(0x44), ~(0x44), ~(0x44), ~(0x44), ~(0x44), ~(0x44), ~(0x44),
- ~(0x44), ~(0x44), ~(0x44), ~(0x44), ~(0x44), ~(0x44), ~(0x44), ~(0x44), ~(0x44), ~(0x44), ~(0x44), ~(0x44),
- ~(0x44), ~(0x44), ~(0x44), ~(0x44), ~(0x44), ~(0x44), ~(0x44), ~(0x44)};
-static char p7_bits[] = {
- ~(0x00), ~(0x00), ~(0x00), ~(0x00), ~(0x00), ~(0x00), ~(0xff), ~(0xff), ~(0x00), ~(0x00), ~(0x00), ~(0x00),
- ~(0x00), ~(0x00), ~(0xff), ~(0xff), ~(0x00), ~(0x00), ~(0x00), ~(0x00), ~(0x00), ~(0x00), ~(0xff), ~(0xff),
- ~(0x00), ~(0x00), ~(0x00), ~(0x00), ~(0x00), ~(0x00), ~(0xff), ~(0xff)};
-static char p8_bits[] = {
- ~(0x11), ~(0x11), ~(0xb8), ~(0xb8), ~(0x7c), ~(0x7c), ~(0x3a), ~(0x3a), ~(0x11), ~(0x11), ~(0xa3), ~(0xa3),
- ~(0xc7), ~(0xc7), ~(0x8b), ~(0x8b), ~(0x11), ~(0x11), ~(0xb8), ~(0xb8), ~(0x7c), ~(0x7c), ~(0x3a), ~(0x3a),
- ~(0x11), ~(0x11), ~(0xa3), ~(0xa3), ~(0xc7), ~(0xc7), ~(0x8b), ~(0x8b)};
-static char p9_bits[] = {
- ~(0x10), ~(0x10), ~(0x10), ~(0x10), ~(0x28), ~(0x28), ~(0xc7), ~(0xc7), ~(0x01), ~(0x01), ~(0x01), ~(0x01),
- ~(0x82), ~(0x82), ~(0x7c), ~(0x7c), ~(0x10), ~(0x10), ~(0x10), ~(0x10), ~(0x28), ~(0x28), ~(0xc7), ~(0xc7),
- ~(0x01), ~(0x01), ~(0x01), ~(0x01), ~(0x82), ~(0x82), ~(0x7c), ~(0x7c)};
-
-BITMAP FillBitMap = { 0, // Specifies the bitmap type. This member must be zero
- 16, // Specifies the width, in pixel, of the bitmap
- 16, // Specifies the height, in pixel, of the bitmap
- 2, // Specifies the number of bytes in each scan line.
- 1, // Specifies the count of color planes.
- 1, // Specifies the number of bits required to ind. th color
- &p2_bits // points to the location of the bit values for the bitmap
- };
-
-#define MAXMK 100
-static struct MARKER {
- int cindex;
- int type;
- int n;
- XPoint xy[MAXMK];
-} marker; /* point list to draw marker */
-
-
-/*___________________________________________________________________*/
-/*
- * Set input on or off
- */
-void
- setinput(inp)
-int inp;
-{
-
-}
-
-//______________________________________________________________________________
-COLORREF ColorIndex(int ic) {
- COLORREF c;
- if (hdCommonPalette)
- c = PALETTEINDEX(ic+ColorOffset);
- else {
- PALETTEENTRY palentr = lpPalette->palPalEntry[ic];
- c = *(DWORD *)(&palentr) & 0x00FFFFFF;
- }
- return c;
-}
-
-/*___________________________________________________________________*/
-/*
- * set the foreground color in GC
- */
-void
- setcolor( gc, ci )
-int gc;
-int ci;
-{
- if( colored && ( ci < 0 || ci >= MAXCOL || !colors[ci].defined ) )
- {
- ci = 0;
- }
- else if (!colored && ci < 0 )
- {
- ci = 0;
- }
- else if (!colored && ci > 0 )
- {
- ci = 1;
- }
-
-
- /* make sure that foreground and background are different */
-}
-
-
-/*___________________________________________________________________*/
-/*
- * return null terminated and blank trimmed string
- */
-char*
- string( s, l )
-char *s;
-int l;
-{
- static char str[256];
- int i;
-
- if( l >= sizeof( str ) )
- l = sizeof( str ) - 1;
-
- for( i = 0; i < l; i++ )
- str[i] = s[i];
- while( l > 0 && str[l-1] == ' ' )
- l--;
-
- str[l] = '\0';
- return( str );
-}
-
-
-
-
-/*___________________________________________________________________*/
-/*
- * Allows to set the DISPLAY and the WINDOW address
- * from outside HIGZ (ie a MOTIF program).
- */
-void
- ixsdswi( dsp , win )
- int *dsp;
- int win;
-{
-
-}
-
-/*___________________________________________________________________*/
-/*
- * Allows KUIP to give to HIGZ the adress of three routines:
- * 1) motif_open : to open a KUIP motif window
- * 2) motif_init : to initalize a KUIP motif window (add the callbacks)
- * 3) motif_close : to close a KUIP motif window
- */
-void
- ixmotif( dsp , open, init, close)
- int *dsp;
- int (*open)();
- void (*init)();
- void (*close)();
-{
-}
-
-
-/*___________________________________________________________________*/
-/*
- * SUBROUTINE IXMINIT(WID)
- * INTEGER WID : Window ID
- *
- * Initialize the Motif windows (add the callbacks)
- */
-void
- ixminit(wid)
- int *wid;
-{
-}
-
-/*___________________________________________________________________*/
- LRESULT APIENTRY
- HIGZDrawing(wParam,lParam)
-/* Dispatch a drawing operation either to real window or to pixmap */
-WPARAM wParam;
-LPARAM lParam;
- {
- if (PixMapON){
- DWORD rvalue;
- HGDIOBJ hbr,hpn;
-
- cHw = lpHpixmap;
- CurrentDC = lpHpixmap->hdcWindow;
- hbr = SelectObject(CurrentDC,hdCommonBrush);
- hpn = SelectObject(CurrentDC,hdCommonPen);
-
- rvalue = (int) HIGZ_Act(NULL,IX11_HIGZ_MSG,wParam, lParam);
-/* Restore all attributes */
- SelectObject(CurrentDC,hpn);
- SelectObject(CurrentDC,hbr);
- return rvalue;
- }
- else return SendMessage(CurrentHIGZWindow,
- IX11_HIGZ_MSG,wParam,lParam);
-}
-
-/*___________________________________________________________________*/
-/*
- * SUBROUTINE IXSETHN(LENHST,HOST)
- * INTEGER LENHST : host name length
- * CHARACTER*(*) HOST : host name
- *
- * Set host name (fill global variable hname)
- */
-void
- ixsethn( lenhst, host, len_host )
-char *host;
-int *lenhst;
-int len_host;
-{
- strcpy (hname,string( host, *lenhst ));
-}
-
-
-/*___________________________________________________________________*/
- HBITMAP CreateHIGZBuffer(hwnd)
- HWND hwnd;
- {
- HBITMAP hdBuffer,oldbit,hdNewBuffer;
- HDC hdPixmapDC,hdWindowDC,oldbitDC,hdNewDC;
- SIZE WindowSize,BufferSize;
-
- hdPixmapDC = cHw->hdcPixBuffer;
- hdWindowDC = cHw->hdcWindow;
- hdBuffer = cHw->hbBuffer;
-
-/* Create New Memory Device context */
- hdNewDC = CreateCompatibleDC(NULL);
- SetMapMode (hdNewDC,MM_ISOTROPIC);
- SetBkMode (hdNewDC,TRANSPARENT);
-/* Set HIGZ pallete */
- if (hdCommonPalette != NULL)
- DeleteObject(SelectPalette(hdNewDC,hdCommonPalette,TRUE));
-/* Create a new BITMAP for double buffering and coordinate transformation */
- GetWindowExtEx(hdWindowDC,&WindowSize);
- GetViewportExtEx(hdWindowDC,&BufferSize);
- hdNewBuffer = CreateCompatibleBitmap(hdWindowDC,BufferSize.cx,
- BufferSize.cy);
- SetWindowExtEx(hdNewDC,WindowSize.cx,WindowSize.cy,NULL);
- SetViewportExtEx(hdNewDC,BufferSize.cx,BufferSize.cy,NULL);
-/* Set new bitmap */
- DeleteObject(SelectObject(hdNewDC,hdNewBuffer));
-
- if (hdPixmapDC) { /* Copy old bitmap to new one */
- BitBlt(hdNewDC,0,0,WindowSize.cx,WindowSize.cy,
- hdPixmapDC, 0,0,SRCCOPY);
-/* Delete previous buffer */
- DeleteObject(SelectObject(hdPixmapDC,hdNewBuffer));
- DeleteDC(hdPixmapDC);
- }
- else { /* Clear new bitmap */
- rect.left = 0;
- rect.right = WindowSize.cx;
- rect.top = 0;
- rect.bottom = WindowSize.cy;
- FillRect(hdNewDC,&rect, CurBrush = CreateSolidBrush(WHITE_HIGZ_COLOR));
- DeleteObject(CurBrush);
- }
-
-
-/* Set window variable */
-
- cHw->hdcPixBuffer=hdNewDC;
- cHw->hbBuffer =hdNewBuffer;
- return cHw->hbBuffer;
- }
-
-
-/*___________________________________________________________________*/
- HBITMAP FlushHIGZBuffer(hwnd)
- HWND hwnd;
- {
- HBITMAP hdBuffer;
- HDC hdPixmapDC,hdWindowDC;
- SIZE WindowSize,BufferSize;
- HRGN TempClip;
-
- hdPixmapDC = cHw->hdcPixBuffer;
- hdWindowDC = cHw->hdcWindow;
- hdBuffer = cHw->hbBuffer;
-
- if (hdPixmapDC) {
- if (hdBuffer) {
- GetWindowExtEx(hdWindowDC,&WindowSize);
-
-/* Set an application palette */
- if (hdCommonPalette) {
- SetSystemPaletteUse(hdWindowDC,SYSPAL_NOSTATIC);
- RealizePalette(hdWindowDC);
- }
-/* Cancel clipping temporary */
- if (cHw->HIGZClipRegion)
- TempClip = SelectClipRgn(hdWindowDC,NULL);
-
-/* Hide HIGZCursor */
- BitBlt(hdWindowDC,0L,0L,WindowSize.cx,WindowSize.cy,
- hdPixmapDC,0L,0L,SRCCOPY);
-/* Restore HIGZCursor */
-/* Compare size of Window and its Buffer */
- if (WindowSize.cx != BufferSize.cx)
-/* One needs change a scale */
- hdBuffer = CreateHIGZBuffer(hwnd);
-/* Restore the current clipboard */
- if (cHw->HIGZClipRegion)
- TempClip = SelectClipRgn(hdWindowDC,TempClip);
-
-
- }
- }
- return hdBuffer;
- }
-
-/*___________________________________________________________________*/
-LRESULT APIENTRY WndHIGZ(hwnd, uMsg, wParam, lParam)
-HWND hwnd;
-UINT uMsg;
-WPARAM wParam;
-LPARAM lParam;
-{
- PAINTSTRUCT ps;
-
- cHw = (struct HIGZWindow *)GetWindowLong(hwnd,ExtHIGZWindow);
- if (cHw) CurrentDC = cHw->hdcWindow;
-
- // HistoryDC = (HDC) GetWindowLong(hwnd,4*offHistoryDC);
- switch (uMsg) {
- case WM_LBUTTONDOWN:
- case WM_MBUTTONDOWN:
- case WM_RBUTTONDOWN:
- if (!cHw->MouseInit) break;
- cHw->MouseInit = 0;
- Wnd_REQLO(hwnd,uMsg,wParam,lParam);
- return 0;
- case WM_MOUSEMOVE:
- SetCursor(cHw->hHIGZCursor);
- case WM_RBUTTONUP:
- case WM_MBUTTONUP:
- case WM_LBUTTONUP:
- if (!cHw->MouseInit) break;
- Wnd_REQLO(hwnd,uMsg,wParam,lParam);
- return 0;
-//_______________________________________________________________
- // The WM_QUERYNEWPALETTE message informs a window that it is about to
- // receive input focus. In response, the window receiving focus should
- // realize its palette as a foreground palette and update its client
- // area. If the window realizes its palette, it should return TRUE;
- // otherwise, it should return FALSE.
-
- case WM_QUERYNEWPALETTE:
- {
- HDC hDC;
- HPALETTE hpalOld = NULL;
-
- if(hdCommonPalette)
- {
- hDC = GetDC(hwnd);
-
- // Select and realize the palette
-
- hpalOld = SelectPalette(hDC, hdCommonPalette, FALSE);
- RealizePalette(hDC);
-
- // Redraw the client area
-
- InvalidateRect(hwnd, NULL, TRUE);
- UpdateWindow(hwnd);
-
- if(hpalOld)
- SelectPalette(hDC, hpalOld, FALSE);
-
- ReleaseDC(hwnd, hDC);
-
- return TRUE;
- }
-
- return FALSE;
- }
-
-//_______________________________________________________________
- // The WM_PALETTECHANGED message informs all windows that the window
- // with input focus has realized its logical palette, thereby changing
- // the system palette. This message allows a window without input focus
- // that uses a color palette to realize its logical palettes and update
- // its client area.
- //
- // This message is sent to all windows, including the one that changed
- // the system palette and caused this message to be sent. The wParam of
- // this message contains the handle of the window that caused the system
- // palette to change. To avoid an infinite loop, care must be taken to
- // check that the wParam of this message does not match the window's
- // handle.
-
- case WM_PALETTECHANGED:
- {
- HDC hDC;
- HPALETTE hpalOld = NULL;
-
- // Before processing this message, make sure we
- // are indeed using a palette
-
- if (hdCommonPalette)
- {
- // If this application did not change the palette, select
- // and realize this application's palette
-
- if (wParam != (WPARAM)hwnd)
- {
- // Need the window's DC for SelectPalette/RealizePalette
-
- hDC = GetDC(hwnd);
-
- // Select and realize our palette
-
- hpalOld = SelectPalette(hDC, hdCommonPalette, FALSE);
- RealizePalette(hDC);
-
- // When updating the colors for an inactive window,
- // UpdateColors can be called because it is faster than
- // redrawing the client area (even though the results are
- // not as good)
-
- UpdateColors(hDC);
-
- // Clean up
-
- if (hpalOld)
- SelectPalette(hDC, hpalOld, FALSE);
-
- ReleaseDC(hwnd, hDC);
- }
- }
- break;
- }
-
-
-//______________________ WM_CREATE ______________________
- case WM_CREATE:
- { int iLoop;
- TEXTMETRIC *tm;
- RECT RectClient;
- HPALETTE hpallete;
- SIZE WindowSize;
- HMENU hmenu;
-
-/* Yin cursor AND bitmask */
-
-BYTE ANDmaskCursor[] =
- {0xff, 0xfc, 0x7f, 0xff, /* line 1 */
- 0xff, 0xfc, 0x7f, 0xff, /* line 2 */
- 0xff, 0xfc, 0x7f, 0xff, /* line 3 */
- 0xff, 0xfc, 0x7f, 0xff, /* line 4 */
-
- 0xff, 0xfc, 0x7f, 0xff, /* line 5 */
-
- 0xff, 0xfc, 0x7f, 0xff, /* line 6 */
- 0xff, 0xfc, 0x7f, 0xff, /* line 7 */
- 0xff, 0xfc, 0x7f, 0xff, /* line 8 */
-
- 0xff, 0xfc, 0x7f, 0xff, /* line 9 */
- 0xff, 0xfc, 0x7f, 0xff, /* line 10 */
- 0xff, 0xfc, 0x7f, 0xff, /* line 11 */
- 0xff, 0xfc, 0x7f, 0xff, /* line 12 */
-
- 0xff, 0xfc, 0x7f, 0xff, /* line 13 */
- 0xff, 0xfc, 0x7f, 0xff, /* line 14 */
-
- 0x00, 0x02, 0x80, 0x01, /* line 15 */
- 0x00, 0x01, 0x00, 0x01, /* line 16 */
- 0x00, 0x02, 0x80, 0x01, /* line 17 */
-
- 0xff, 0xfc, 0x7f, 0xff, /* line 18 */
- 0xff, 0xfc, 0x7f, 0xff, /* line 19 */
- 0xff, 0xfc, 0x7f, 0xff, /* line 20 */
-
- 0xff, 0xfc, 0x7f, 0xff, /* line 21 */
- 0xff, 0xfc, 0x7f, 0xff, /* line 22 */
-
- 0xff, 0xfc, 0x7f, 0xff, /* line 23 */
- 0xff, 0xfc, 0x7f, 0xff, /* line 24 */
-
- 0xff, 0xfc, 0x7f, 0xff, /* line 25 */
- 0xff, 0xfc, 0x7f, 0xff, /* line 26 */
- 0xff, 0xfc, 0x7f, 0xff, /* line 27 */
- 0xff, 0xfc, 0x7f, 0xff, /* line 28 */
-
- 0xff, 0xfc, 0x7f, 0xff, /* line 29 */
- 0xff, 0xfc, 0x7f, 0xff, /* line 30 */
- 0xff, 0xfc, 0x7f, 0xff, /* line 31 */
-
- 0xff, 0xff, 0xff, 0xff}; /* line 32 */
-
-/* Yin cursor XOR bitmask */
-
-BYTE XORmaskCursor[] =
- {0x00, 0x02, 0x80, 0x00, /* line 1 */
- 0x00, 0x02, 0x80, 0x00, /* line 2 */
- 0x00, 0x02, 0x80, 0x00, /* line 3 */
- 0x00, 0x02, 0x80, 0x00, /* line 4 */
-
- 0x00, 0x02, 0x80, 0x00, /* line 5 */
-
- 0x00, 0x02, 0x80, 0x00, /* line 6 */
- 0x00, 0x02, 0x80, 0x00, /* line 7 */
- 0x00, 0x02, 0x80, 0x00, /* line 8 */
-
- 0x00, 0x02, 0x80, 0x00, /* line 9 */
- 0x00, 0x02, 0x80, 0x00, /* line 10 */
- 0x00, 0x02, 0x80, 0x00, /* line 11 */
- 0x00, 0x02, 0x80, 0x00, /* line 12 */
-
- 0x00, 0x02, 0x80, 0x00, /* line 13 */
- 0x00, 0x02, 0x80, 0x00, /* line 14 */
-
- 0xFF, 0xFC, 0x7F, 0xFE, /* line 15 white border */
- 0x00, 0x00, 0x00, 0x00, /* line 16 black cross */
- 0xFF, 0xFC, 0x7F, 0xFE, /* line 17 white border */
-
- 0x00, 0x02, 0x80, 0x00, /* line 18 */
- 0x00, 0x02, 0x80, 0x00, /* line 19 */
- 0x00, 0x02, 0x80, 0x00, /* line 20 */
-
- 0x00, 0x02, 0x80, 0x00, /* line 21 */
- 0x00, 0x02, 0x80, 0x00, /* line 22 */
-
- 0x00, 0x02, 0x80, 0x00, /* line 23 */
- 0x00, 0x02, 0x80, 0x00, /* line 24 */
-
- 0x00, 0x02, 0x80, 0x00, /* line 25 */
- 0x00, 0x02, 0x80, 0x00, /* line 26 */
- 0x00, 0x02, 0x80, 0x00, /* line 27 */
- 0x00, 0x02, 0x80, 0x00, /* line 28 */
-
- 0x00, 0x02, 0x80, 0x00, /* line 29 */
- 0x00, 0x02, 0x80, 0x00, /* line 30 */
- 0x00, 0x02, 0x80, 0x00, /* line 31 */
-
- 0x00, 0x00, 0x00, 0x00}; /* line 32 */
-
-/* Create a custom cursor at run time. */
-
-HCURSOR hCursor = CreateCursor(
- (HINSTANCE)GetWindowLong(hwnd,GWL_HINSTANCE), /* app instance */
- 15, /* horiz pos of hot spot */
- 15, /* vert pos of hot spot */
-
- 32, /* cursor width */
- 32, /* cursor height */
- ANDmaskCursor, /* AND bitmask */
- XORmaskCursor); /* XOR bitmask */
-
-/*
- *
- * AND XOR Display
- *
- * 0 0 Black
- * 0 1 White
- * 1 0 Screen
- * 1 1 Reverse screen
- *
- */
-
-/* To define whether our graphics device has a pallette */
-
- int iPalExist;
-
-/* Disable the Close postion in the System Menu */
- hmenu = GetSystemMenu(hwnd,FALSE);
- EnableMenuItem(hmenu,6 , MF_GRAYED | MF_BYPOSITION);
-
-/* Create Extended data block */
- cHw = malloc(sizeof(HIGZWindow));
- /* Insert in dadata chain */
- if (fHw == NULL) {
- fHw = cHw;
- cHw->ptbw = NULL;
- }
- else {
- lHw->ptfw = cHw;
- cHw->ptbw = lHw;
- }
-
-/* Initial fill the data structure in */
- cHw->WinType = 0;
- cHw->ptfw = NULL;
- cHw->hwnd = hwnd;
- cHw->hdcWindow = GetDC(hwnd);
- cHw->hdcPixBuffer = (HDC) NULL;
- cHw->HIGZClipRegion = (HRGN)NULL;
- cHw->HIGZCursor = FALSE;
- cHw->SystemCursorVisible = TRUE;
- cHw->MouseInit = 0;
- cHw->SetTextInput = FALSE;
- cHw->loc.x = 0; cHw->loc.y=0; cHw->locp.x=0; cHw->locp.y=0;
- cHw->isopening = FALSE;
- cHw->hHIGZCursor = hCursor;
-
- SetWindowLong(hwnd,ExtHIGZWindow,(LONG)cHw);
-
- lHw = cHw;
- Number_of_HIGZ_Windows++;
-
- CurrentDC = cHw->hdcWindow;
-
- /* Create caret to character input */
-
- tm = malloc(sizeof(TEXTMETRIC));
- GetTextMetrics(CurrentDC,tm);
- cHw->dwCharX = tm->tmAveCharWidth;
- cHw->dwCharY = tm->tmHeight;
- cHw->dwAscent= tm->tmAscent;
- free(tm);
-
- SetMapMode (CurrentDC,MM_ISOTROPIC);
- RectClient.left = 0;
- RectClient.top = 0;
- RectClient.right = 1023;
- RectClient.bottom = 1023;
-
- /* Create HistoryDC (memory MetaFile) DC to perform PAINT operation */
-
-// HistoryDC = CreateEnhMetaFile(CurrentDC,"META.emf",&RectClient,NULL);
- HistoryDC = 0;
- if (HistoryDC) cHw->hdcHistory =HistoryDC;
-
- SetWindowExtEx(CurrentDC,
- RectClient.right+1,
- RectClient.bottom+1,
- NULL);
- SetBkMode(CurrentDC,TRANSPARENT);
- SetTextAlign(CurrentDC,
- TA_BASELINE | TA_LEFT | TA_NOUPDATECP);
- if (HistoryDC)
- {
- SetMapMode (HistoryDC,MM_ISOTROPIC);
- /* SetWindowExtEx(HistoryDC,
- RectClient.right+1,
- RectClient.bottom+1,
- NULL);
- */ SetBkMode(HistoryDC,TRANSPARENT);
- SetTextAlign(CurrentDC,
- TA_BASELINE | TA_LEFT | TA_NOUPDATECP);
- }
- GetClientRect(hwnd,&RectClient);
- SetViewportExtEx (CurrentDC,
- RectClient.right,
- RectClient.bottom,
- NULL);
- GetClientRect(hwnd,&(cHw->HIGZWindowSize));
- DPtoLP(CurrentDC,(POINT*) (&(cHw->HIGZWindowSize)),2);
-
-// if (hdCommonPalette == NULL) {
-
-/*
- * Let's define whether we have a palette or any true color facilities
- */
- iPalExist = GetDeviceCaps(CurrentDC,RASTERCAPS) & RC_PALETTE ;
-
- if (iPalExist)
- maxcol = GetDeviceCaps(CurrentDC,SIZEPALETTE);
- else {
- maxcol = GetDeviceCaps(CurrentDC,NUMCOLORS);
- if (maxcol == -1)
- maxcol = 256;
- hdCommonPalette = NULL;
- }
-
- maxcol = min(256,maxcol);
- /* Allocate enough memory for a logical palette with
- * PALETTESIZE entries and set the size and version fields
- * of the logical palette structure.
- */
- lpPalette = (NPLOGPALETTE) malloc((sizeof (LOGPALETTE) +
- (sizeof (PALETTEENTRY) * (maxcol))));
-
- if(!lpPalette){
- MessageBox(hwnd, "<WM_CREATE> Not enough memory for palette.", NULL, MB_OK | MB_ICONHAND);
- PostQuitMessage (0) ;
- break;
- }
-
- lpPalette->palVersion = 0x300;
- lpPalette->palNumEntries = maxcol;
-
- /* fill in intensities for all palette entry colors */
- if (iPalExist) {
- GetSystemPaletteEntries(CurrentDC,0,20, lpPalette->palPalEntry);
-
- /* create a logical color palette according the information
- * in the LOGPALETTE structure.
- */
- hdCommonPalette = CreatePalette ((LPLOGPALETTE) lpPalette);
- }
-
- if(hdCommonPalette != NULL)
- DeleteObject(SelectPalette(CurrentDC,hdCommonPalette,TRUE));
- // if (HistoryDC) DeleteObject(SelectPalette(HistoryDC,hpallete,TRUE));
- return 0;
-
- }
- case WM_PAINT:
- if (BeginPaint(hwnd,&ps)) {
- HDC hdc;
- ENHMETAHEADER mfHeader;
- HENHMETAFILE hmf,hmfOld;
- HRGN TempClip;
- RECT rect;
-
-/* Close History Metafile and create a new one and play old */
-// hdc=(HDC)GetWindowLong(hwnd,4*offHistoryDC);
-
- if (hdCommonPalette) {
- SetSystemPaletteUse(CurrentDC,SYSPAL_NOSTATIC);
- RealizePalette(CurrentDC);
- }
-/* Hide HIGZ mouse locator and text caret */
- if (!cHw->isopening)
- if (cHw->MouseInit) DrawHIGZCursor(cHw->MouseInit);
- else cHw->isopening = FALSE;
- if (cHw->SetTextInput) HideCaret(hwnd);
- FlushHIGZBuffer(hwnd);
-/* Restore HIGZ mouse locator and text caret */
- if (cHw->SetTextInput) ShowCaret(hwnd);
- if (cHw->MouseInit) DrawHIGZCursor(cHw->MouseInit);
-
- hdc = HistoryDC;
- if (hdc) {
-/* Get Old metafile */
- hmf = CloseEnhMetaFile(hdc);
-//==> printf("PAINT ==> hmf is %x with error code %d \n", hmf, GetLastError());
-
-/* Create new metafile */
- GetEnhMetaFileHeader(hmf,sizeof(ENHMETAHEADER),&mfHeader);
-//==> printf("==> PAINT: Rectangle retrivied by GetEnh %d %d %d %d Error code is %d \n",
-// mfHeader.rclFrame.top,mfHeader.rclFrame.right,
-// mfHeader.rclFrame.left,mfHeader.rclFrame.bottom, GetLastError());
-
- HistoryDC = CreateEnhMetaFile(ps.hdc,NULL,&(mfHeader.rclFrame),NULL);
-//==> printf(" PAINT, CreateEnh HistoryDC = %x \n", HistoryDC);
-
- cHw->hdcHistory = HistoryDC;
-/* Play Old metafile in new one and ti window */
- GetClientRect(hwnd,&rect);
- DPtoLP(ps.hdc,&rect,2);
-//==> printf("New rectangle will be %d %d %d %d \n",rect.top, rect.left,rect.bottom,rect.right);
-
-// PlayEnhMetaFile(HistoryDC,hmf,&rect);
-
-/* Set clipping temporary for PAINT arear */
- // TempClip = SelectClipRgn(ps.hdc,
-// CreateRectRgnIndirect(&ps.rcPaint));
-
- if (hdCommonPalette) {
- SetSystemPaletteUse(CurrentDC,SYSPAL_NOSTATIC);
- RealizePalette(CurrentDC);
- }
- PlayEnhMetaFile(ps.hdc,hmf,&rect);
-
-/* Restore clip region */
-// SelectClipRgn(ps.hdc,TempClip);
-
-/* Delete Old metafile */
- DeleteEnhMetaFile(hmf);
- }
-
- EndPaint(hwnd, &ps);
- }
-
- return DefWindowProc(hwnd,uMsg, wParam, lParam);
- case WM_ERASEBKGND:
- {
- HRGN TempClip;
-/* Cancel clipping temporary */
- if (cHw->HIGZClipRegion)
- TempClip = SelectClipRgn((HDC)wParam,NULL);
-/* Hide HIGZ mouse locator */
- if (!cHw->isopening)
- if (cHw->MouseInit) DrawHIGZCursor(cHw->MouseInit);
- else cHw->isopening = FALSE;
- GetClientRect(hwnd,&rect);
- DPtoLP(CurrentDC,&rect,2);
- FillRect(CurrentDC,&rect, CurBrush = CreateSolidBrush(WHITE_HIGZ_COLOR));
- DeleteObject(CurBrush);
-// DefWindowProc(hwnd,uMsg, wParam, lParam);
-/* Restore HIGZ mouse locator */
- if (cHw->MouseInit) DrawHIGZCursor(cHw->MouseInit);
- if (cHw->HIGZClipRegion)
- TempClip = SelectClipRgn((HDC)wParam,TempClip);
- return TRUE;
-// return FALSE // Window will remain marked for erasing
- }
- case WM_SIZE:
-
-/* WM_SIZE
- * fwSizeType = wParam; - resizing flag
- * nWidth = LOWORD(lParam); - width of client area
- *nHeight = HIWORD(lParam); - height of client area
- */
- SetViewportExtEx(CurrentDC, LOWORD(lParam), HIWORD(lParam), NULL);
- cHw->HIGZWindowSize.right = LOWORD(lParam);
- cHw->HIGZWindowSize.bottom = HIWORD(lParam);
- DPtoLP(CurrentDC,(POINT*) (&(cHw->HIGZWindowSize)),2);
- return 0;
- /* return DefWindowProc(hwnd,uMsg, wParam, lParam); */
- case WM_SETFOCUS:
- if (!cHw->SetTextInput) break;
- CreateCaret(hwnd, (HBITMAP) 1, cHw->dwCharX, cHw->dwAscent);
- SetCaretPos(ixText, iyText);
- ShowCaret(hwnd);
- return 0;
- case WM_KILLFOCUS:
-
- /*
- * Hide and destroy the caret when the window loses
- * keyboard focus
- */
-
- if (!cHw->SetTextInput) break;
- HideCaret(hwnd);
- DestroyCaret();
- return 0;
- case WM_CHAR:
- if (cHw->SetTextInput) return Wnd_REQST(hwnd, uMsg, wParam, lParam);
- break;
- case WM_KEYDOWN:
- if (cHw->MouseInit) Wnd_REQLO(hwnd, uMsg, wParam, lParam);
- else if (cHw->SetTextInput) Wnd_REQST(hwnd, uMsg, wParam, lParam);
- break;
- case WM_QUERYOPEN:
- cHw->isopening = TRUE;
- break;
- case WM_DESTROY:
- DeleteDC(CurrentDC);
- DestroyCursor(cHw->hHIGZCursor); /* 3.06.94 */
- if (HistoryDC) CloseEnhMetaFile(HistoryDC);
- break;
-// return 0;
-
- case IX11_HIGZ_MSG:
- {
- DWORD rvalue;
- HGDIOBJ hbr,hpn;
- HDC hdc;
-/* Set double buffering DC */
- if (cHw->hdcPixBuffer)
- CurrentDC = cHw->hdcPixBuffer;
- if (hdCommonPalette) {
- SetSystemPaletteUse(CurrentDC,SYSPAL_NOSTATIC);
- RealizePalette(CurrentDC);
- }
- hbr = SelectObject(CurrentDC,hdCommonBrush);
- hpn = SelectObject(CurrentDC,hdCommonPen);
-
- rvalue = (DWORD)HIGZ_Act(hwnd,uMsg, wParam, lParam);
-/* Restore all attributes */
- SelectObject(CurrentDC,hpn);
- SelectObject(CurrentDC,hbr);
- return rvalue;
- }
- case IX11_HIGZ_Input:
- {
- switch (LOWORD(wParam)) {
- case IX_REQLO:
- Wnd_REQLO(hwnd,uMsg, wParam, lParam);
- break;
- case IX_REQST: // Request a string input
- Wnd_REQST(hwnd, uMsg, wParam, lParam);
- break;
- default:
- break;
- }
- }
- default:
- break;
- }
- return DefWindowProc(hwnd,uMsg, wParam, lParam);
-}
-
-/*___________________________________________________________________*/
-LPTHREAD_START_ROUTINE HIGZ_MsgLoop(ThrSem)
- HANDLE ThrSem;
- {
- MSG msg;
- HWND hwndHIGZ;
- int value;
- struct CREATEHIGZWINDOW *WinThr;
-
- ReleaseSemaphore(ThrSem, 1, NULL);
- while(GetMessage(&msg,NULL,0,0))
- {
- if (msg.hwnd == NULL & msg.message == IX11_HIGZ_MSG) {
-
- switch(HIWORD(msg.wParam)) {
- case HIGZ_Control:
- switch (LOWORD(msg.wParam)) {
- case IX_OPNWI:
-/* Create new window */
- WinThr = msg.lParam;
- if ( WinThr->flag != 2)
- hwndHIGZ = CreateWindow(
- HIGZCLASS, /*extended window style */
- string(WinThr->title,WinThr->lentit), /*address of window name */
- WS_OVERLAPPEDWINDOW | WS_VISIBLE, /*window style */
- CW_USEDEFAULT, CW_USEDEFAULT, // *x, *y,
- WinThr->w, WinThr->h, // *w, *h,
- NULL, /*handle of parent of owner window */
- NULL, /*handle of menu, or child-window identifier */
- higz_display.hInstance, /*handle of application instance */
- NULL); /*address of window-creation data */
- else {
- hwndHIGZ = CreateTextClass(WinThr);
- }
-
- WinThr->hwnd = hwndHIGZ;
-
- ReleaseSemaphore(WinThr->semaphore, 1, NULL);
- break; /* IX_OPNWI */
- default:
- break;
- } /* End of HIGZ_Control */
- case HIGZ_Attribute:
- switch (LOWORD(msg.wParam))
- {
- default:
- break;
- }
- default:
- break;
- }
- }
- else {
- if (msg.message != IX11_HIGZ_MSG)
- TranslateMessage(&msg);
- DispatchMessage(&msg);
- }
- }
- ExitThread(0);
- return 0;
- } /* HIGZ_MsgLoop */
-
-
-/*___________________________________________________________________*/
-/*
- * INTEGER FUNCTION IXOPNDS(LENHST,HOST)
- * INTEGER LENHST : host name length
- * CHARACTER*(*) HOST : host name
- *
- * Open the display. Return -1 if the opening fails
- */
-int
- ixopnds( lenhst, host
-#ifdef CERNLIB_QFMSOFT
- , len_host
-#endif
-)
-#ifdef CERNLIB_QFMSOFT
- int len_host;
-#endif
-char *host;
-int *lenhst;
-{
- HINSTANCE hinst = GetModuleHandle(NULL); /* handle of current instance */
- ATOM iregcode;
-
-// HINSTANCE hinst = NULL; /* handle of current instance */
-
-
- /* Make sure that this window hasn't been registered yet */
-
-#ifdef WINEX
- higz_display.cbSize = sizeof(WNDCLASSEX);
-#endif
-
-#ifdef WINEX
- if (GetClassInfoEx(hinst,HIGZCLASS,&higz_display))
-#else
- if (GetClassInfo(hinst,HIGZCLASS,&higz_display))
-#endif
- return 0;
-
- /* Set the common wndClass information. This is common for all windows
- ** of this application.
- */
-
- higz_display.style = CS_OWNDC | CS_HREDRAW | CS_VREDRAW;
- higz_display.cbClsExtra = 0;
-
- higz_display.cbWndExtra = sizeof(LONG)+LastExtraMember*sizeof(HANDLE);
-
- higz_display.hCursor = NULL;
-// higz_display.hCursor = LoadCursor(NULL, IDC_CROSS);
-// higz_display.hCursor = LoadCursor(hinst, hCursor);
- higz_display.hInstance = hinst;
-#ifdef WINEX
- higz_display.hIconSm = NULL; /* For Windows NT it must be NULL */
-#endif
-
- /*
- ** Register the main top-level window
- */
-
- higz_display.lpfnWndProc = (WNDPROC) WndHIGZ;
- higz_display.hIcon = LoadIcon(NULL, IDI_APPLICATION);
- higz_display.hbrBackground = GetStockObject(WHITE_BRUSH);
- higz_display.lpszMenuName = NULL;
- higz_display.lpszClassName = HIGZCLASS;
-
-#ifdef WINEX
- if (!RegisterClassEx(&higz_display)) {
-#else
- if (!RegisterClass(&higz_display)) {
-#endif
- int ierrcode;
- ierrcode = GetLastError();
- printf(" Open Display error %d RegCode= %i \n", ierrcode, iregcode);
- return -1;
- }
- else
- {
- HANDLE ThrSem;
-/*
- * Retrieve the applicaiton instance
- */
-
- /* Create thread to do loop msg */
-
- ThrSem = CreateSemaphore(NULL, 0, 1, NULL);
-
- CreateThread(NULL,0, (LPTHREAD_START_ROUTINE) HIGZ_MsgLoop,
- (LPVOID) ThrSem, 0, &IDThread);
-
- WaitForSingleObject(ThrSem, INFINITE);
- CloseHandle(ThrSem);
-/* Create common object */
- hdCursorPen = GetStockObject(BLACK_PEN);
-// CreatePen(PS_SOLID,0,RGB(64,64,64));// Pen to draw HIGZ locator
- hdCursorBrush =
- GetStockObject(HOLLOW_BRUSH); // Brush to draw HIGZ locator 3 or 5
- return 0;}
-}
-
-
-/*___________________________________________________________________*/
-LRESULT APIENTRY
- HIGZ_Act(hwnd, uMsg, wParam, lParam)
-HWND hwnd;
-UINT uMsg;
-WPARAM wParam;
-LPARAM lParam;
- {
- switch (HIWORD(wParam)) {
-
- case HIGZ_Control:
- switch (LOWORD(wParam))
- {
- case IX_OPNDS: // Open X11 display
- break;
- case IX_OPNWI: // Open X11 window
- break;
- case IX_SELWI: // Select the current X11 window
- break;
- case IX_CLSWI: // Close an X11 window
- if (hdCommonPalette) {
- SetSystemPaletteUse(CurrentDC,SYSPAL_STATIC);
- RealizePalette(CurrentDC);
- }
- while(!PostMessage(HWND_BROADCAST,WM_SYSCOLORCHANGE, 0, 0));
-
- if (HistoryDC) DeleteEnhMetaFile(CloseEnhMetaFile(HistoryDC));
- /* Delete data structure */
- /* Link previous and next structure */
- if (cHw->ptbw == NULL) fHw = cHw->ptfw; /* This is the first structure in the list */
- else cHw->ptbw->ptfw = cHw->ptfw;
-
- if (cHw->ptfw == NULL) lHw = cHw->ptbw; /* This is the last structure in the list */
- else cHw->ptfw->ptbw = cHw->ptbw;
- /* Now the current structure is free and we may delete it */
- free(cHw);
- Number_of_HIGZ_Windows--;
- DestroyWindow( hwnd );
- return 0;
- case IX_CLSDS: // Close an X11 session
- PostQuitMessage(0);
- break;
-
- case IX_SETHN: // Set X11 host name
- return TRUE;
- case IX_CLRWI: // Clear an X11 window
- {
- /* HBRUSH CurBrush; */
- /* RECT rect; */
- HRGN TempClip, clip;
- char buftext[20]= {"HI\0PAW\0\0" };
-
-/* Cancel clipping temporary */
-
- clip = cHw->HIGZClipRegion;
- if (clip != NULL) TempClip = SelectClipRgn(CurrentDC,NULL);
- GetClientRect(hwnd,&rect);
- DPtoLP(CurrentDC,&rect,2);
- FillRect(CurrentDC,&rect, CurBrush = CreateSolidBrush(WHITE_HIGZ_COLOR));
- DeleteObject(CurBrush);
- if (clip != NULL) TempClip = SelectClipRgn(CurrentDC,TempClip);
-
-/* Close History Metafile and create a new one */
-
-// if (HistoryDC) {
- if(FALSE) {
- ENHMETAHEADER mfHeader;
- HENHMETAFILE hmf;
- hmf = CloseEnhMetaFile(HistoryDC);
-//==> printf(" Metafile ID %x with error %d for %x Histiry DC \n", hmf,GetLastError(),HistoryDC);
- GetEnhMetaFileHeader(hmf,sizeof(ENHMETAHEADER),&mfHeader);
- DeleteEnhMetaFile(hmf);
- HistoryDC = CreateEnhMetaFile(CurrentDC ,NULL,&(mfHeader.rclFrame),
- NULL);
-//==> printf(" HistoryDC inside od CLRWI %x with Error %d \n", HistoryDC,
-// GetLastError());
- cHw->hdcHistory = HistoryDC;
- }
- return TRUE;
- }
-
- case IX_UPDWI: // Update an X11 window
- FlushHIGZBuffer(hwnd);
-//----> 1.08.96 It caused strange behav under Win 95 --> BringWindowToTop(hwnd);
- break;
- case IX_RSCWI: // Resize an X11 window
- return TRUE;
- case IX_CLIP : // Define the X11 clipping rectangle
- {
- LPPOINT ClipRectPoint;
- LPRECT ClipRectFromPoint;
- HDC hdc;
- HRGN clip;
-
- hdc = CurrentDC;
- ClipRectPoint = (LPPOINT) lParam;
- ClipRectFromPoint = (LPPOINT) lParam;
- LPtoDP(hdc,ClipRectPoint, 2);
-
- if (clip = cHw->HIGZClipRegion)
- DeleteObject(clip);
-/* Select clippping for Display */
- hdc = cHw->hdcWindow;
- SelectClipRgn(hdc,
- clip = CreateRectRgnIndirect( ClipRectFromPoint));
-
-/* Select clippping for bitmap buffer */
- hdc = cHw->hdcPixBuffer;
- if (hdc)
- SelectClipRgn(hdc,
- clip = CreateRectRgnIndirect( ClipRectFromPoint));
- cHw->HIGZClipRegion = clip;
- return (LRESULT) TRUE;
- }
- case IX_NOCLI: // Deactivate the X11 clipping rectangle
- {
- HDC hdc;
- HRGN clip;
-
- clip = cHw->HIGZClipRegion;
- if (clip != NULL) {
- DeleteObject(clip);
- hdc = cHw->hdcWindow;
- SelectClipRgn(hdc,NULL);
- /* Cancel cliiping for bitmap buffer */
- hdc = cHw->hdcPixBuffer;
- if (hdc) SelectClipRgn(hdc,NULL);
- cHw->HIGZClipRegion = (HRGN) NULL;;
- }
- return (LRESULT) TRUE;
- }
- default:
- return TRUE;
- }
- break;
-
-
- /* X11 output primitives */
- case HIGZ_Primitive:
- switch (LOWORD(wParam))
- {
- case IX_LINE : // Draw a line through all points
- {
- struct { int n; XPoint *xy;} *line;
- HDC hdc;
- int i;
-
- line = lParam;
- hdc = CurrentDC;
- if ( line->n > 1 )
- return Polyline(hdc,line->xy,line->n);
- else
- return SetPixel(hdc, line->xy[0].x,line->xy[0].y, RGB(0,0,0));
- }
- case IX_MARKE: // Draw a marker ar each point
- return Wnd_MARKE(hwnd, uMsg, wParam, lParam);
-
- case IX_FLARE: // Fill area described by polygon
- return Wnd_FLARE(hwnd, uMsg, wParam, lParam);
- case IX_BOX : // Draw a box
- return Wnd_BOX(hwnd, uMsg, wParam, lParam);
- case IX_CA : // Draw a cell array
- return Wnd_CA(hwnd, uMsg, wParam, lParam);
- default:
- return TRUE;
- }
- break;
- /* X11 text */
- case HIGZ_Text:
- {
- TEXTMETRIC *tm;
- HGDIOBJ hdf;
-/* Save default values and set cthe current one */
- hdf = SelectObject(CurrentDC,hdCommonFont);
-
- /* Update text metric's */
-
- tm = malloc(sizeof(TEXTMETRIC));
- GetTextMetrics(CurrentDC,tm);
- cHw->dwCharX = tm->tmAveCharWidth;
- cHw->dwCharY = tm->tmHeight;
- cHw->dwAscent= tm->tmAscent;
- free(tm);
-
- switch (LOWORD(wParam))
- {
- case IX_TEXT : // Draw a text string using the current font
- {
- struct {int mode,x,y,lentxt; float angle, mgn; char *text;} *text_msg;
- COLORREF clrref;
- int y_shift = 0,
- x_shift = 0;
- int txtA;
- double t_rotate;
-
-/* Save default values and set current one */
- clrref = SetTextColor(CurrentDC,dwCommonTextColor);
- txtA = SetTextAlign(CurrentDC,dwCommonTextAlign);
-
- text_msg = lParam;
- /* therefore Windows font hasn'ta "vertical cernter attribute"
- one should emulate it by hand
- */
- if (align_vert == 0) {
- t_rotate = cos(0.1*HIGZFont.lfEscapement);
- y_shift = (cHw->dwAscent/2)*t_rotate;
- x_shift = (cHw->dwAscent/2)*sqrt(1.0-t_rotate*t_rotate);
- }
- ExtTextOut(CurrentDC,
- text_msg->x+x_shift, text_msg->y+y_shift,
- 0, NULL,
- text_msg->text, text_msg->lentxt,
- NULL);
-/* Restore default values */
- SetTextColor(CurrentDC,clrref);
- SetTextAlign(CurrentDC,txtA );
- break;
- }
- case IX_TXTL : // Return the width and height of character string in the current font
- {
- SIZE text_size;
- struct { int w,h, lmess; char *mess;} *sText;
- sText = lParam;
- GetTextExtentPoint(CurrentDC,
- sText->mess,sText->lmess, &text_size);
- sText->w = text_size.cx;
- sText->h = text_size.cy;
- break;
- }
- default:
- break;
- }
-/* Restore Default font */
-
- SelectObject(CurrentDC,hdf);
-
- tm = malloc(sizeof(TEXTMETRIC));
- GetTextMetrics(CurrentDC,tm);
- cHw->dwCharX = tm->tmAveCharWidth;
- cHw->dwCharY = tm->tmHeight;
- cHw->dwAscent= tm->tmAscent;
- free(tm);
-
- break;
- }
-/* X11 output attributes */
- case HIGZ_Attribute:
- switch (LOWORD(wParam))
- {
- case IX_DRMDE: // Set drawing mode
- SetROP2(CurrentDC,lParam);
- return TRUE;
- }
- break;
- /* X11 marker style */
-
- case HIGZ_Marker:
- switch (LOWORD(wParam))
- {
- case IX_SETTA: // Set text alignment
- SetTextAlign(CurrentDC,lParam);
- break;
- case IX_SETTF: // Set text font to specified name
- {
- TEXTMETRIC *tm;
- DeleteObject(SelectObject(CurrentDC,
- CreateFontIndirect((LOGFONT*) lParam))
- );
- /* Update text metric's */
-
- tm = malloc(sizeof(TEXTMETRIC));
- GetTextMetrics(CurrentDC,tm);
- cHw->dwCharX = tm->tmAveCharWidth;
- cHw->dwCharY = tm->tmHeight;
- cHw->dwAscent= tm->tmAscent;
- free(tm);
-
- break;
- }
-
- case IX_SYNC : // X11 synchronization
-
- default:
- return TRUE;
- }
- break;
- /* X11 inquiry routines */
- case HIGZ_Inquiry:
- switch (LOWORD(wParam))
- {
- case IX_GETGE: // Returns position and size of Window
- GetWindowExtEx(CurrentDC,(LPSIZE)lParam);
- return TRUE;
- case IX_GETWI: // Returns the X11 window identifier
- case IX_GETPL: // Returns the maximal number of planes of the display
- case IX_GETCOL: // Returns the X11 colour representation
- {
- struct {int index; struct tagPALETTEENTRY rgb;} *lpHIGZ_rgb;
- HGDIOBJ hpl;
-
- lpHIGZ_rgb = lParam;
- hpl = GetCurrentObject(CurrentDC,OBJ_PAL);
- GetPaletteEntries(hpl,lpHIGZ_rgb->index,1,&(lpHIGZ_rgb->rgb));
- break;
- }
- default:
- return TRUE;
- }
- break;
-
- /* Pixmap manipulation */
-
- case HIGZ_Pixmap:
- switch (LOWORD(wParam))
- {
- case IX_CPPX : // Copy the pixmap
- Wnd_CPPX(hwnd, uMsg, wParam, lParam);
- break;
- case IX_WRPX : // Write the pixmap
-// Wnd_WRPX(hwnd, uMsg, wParam, lParam);
- break;
- case IX_WIPX : // Copy the area in the current window
- Wnd_WIPX(hwnd, uMsg, wParam, lParam);
- break;
- default:
- return TRUE;
- }
- return TRUE;
- /* Dummies */
-
- case HIGZ_Dummies:
- switch (LOWORD(wParam))
- {
- case IX_S2BUF:
- Wnd_S2BUF(hwnd, uMsg, wParam, lParam);
- break;
- case IX_SDSWI:
- default:
- return TRUE;
- }
- default:
- return TRUE;
- }
- return TRUE;
- } /* HIGZ_Act */
-
-/*___________________________________________________________________*/
-/*
- * INTEGER FUNCTION IXOPNWI(X,Y,W,H,LENTIT,TITLE,FLAG)
- * INTEGER X,Y : initial window position
- * INTEGER W,H : initial window width and height
- * INTEGER LENTIT : title length
- * CHARACTER*(*) TITLE : window title
- * INTEGER FLAG : FLAG<>1 allows to open a non MOTIF window
- * even if ixmotif has been called.
- *
- * Open window and returns window number which can be used with IXSELWIN
- * return -1 if window creation fails
- */
-int
- ixopnwi( x, y, w, h, lentit,title,
-#ifdef CERNLIB_QFMSOFT
- len_title,
-#endif
- flag )
-char *title;
-#ifdef CERNLIB_QFMSOFT
- int len_title;
-#endif
-int *x, *y;
-int *w, *h;
-int *lentit;
-int *flag;
-{
- HWND hwndHIGZ;
- int value;
- static struct CREATEHIGZWINDOW WinThr;
-
- WinThr.x = *x;
- WinThr.y = *y;
- WinThr.w = *w+2*GetSystemMetrics(SM_CXFRAME);
-
- WinThr.h = *h+ GetSystemMetrics(SM_CYCAPTION)
- +2*GetSystemMetrics(SM_CYFRAME)
- - GetSystemMetrics(SM_CYBORDER);
- WinThr.lentit = *lentit;
- WinThr.title = title;
-
-
- /* Create HIGZ window */
-
- WinThr.semaphore = CreateSemaphore(NULL, 0, 1, NULL);
-
- while(!PostThreadMessage(IDThread,
- IX11_HIGZ_MSG,MAKEWPARAM(IX_OPNWI,HIGZ_Control), &WinThr));
-
- WaitForSingleObject(WinThr.semaphore, INFINITE);
- CloseHandle(WinThr.semaphore);
-
- ShowWindow(WinThr.hwnd,SW_SHOWDEFAULT);
- UpdateWindow(WinThr.hwnd);
-
- return (int)WinThr.hwnd;
-
- }
-
-
-/*___________________________________________________________________*/
-/*
- * SUBROUTINE IXRSCWI(WID, W, H)
- * INTEGER WID : Window identifier.
- * INTEGER W : Width
- * INTEGER H : Heigth
- *
- * Rescale the window WID
- */
-void
- ixrscwi(wid, w, h)
- HWND *wid;
- int *w;
- int *h;
-{
- int new_w,new_h;
-
- new_w = *w+2*GetSystemMetrics(SM_CXFRAME);
-
- new_h = *h+ GetSystemMetrics(SM_CYCAPTION)
- +2*GetSystemMetrics(SM_CYFRAME)
- - GetSystemMetrics(SM_CYBORDER);
-
- SetWindowPos(*wid,HWND_TOP,0,0,new_w,new_h,
- SWP_DRAWFRAME|SWP_NOMOVE |SWP_NOZORDER );
-}
-
-/*___________________________________________________________________*/
-/*
- * SUBROUTINE IXS2BUF(WID,MODE)
- * INTEGER WID : Window identifier.
- * 999 means all the opened windows.
- * INTEGER MODE : 1 double buffer is on
- * 0 double buffer is off
- *
- * Set the double buffer on/off on window WID.
- */
-void
- ixs2buf( wid, mode )
- int *wid;
- int *mode;
-{
- SendMessage(*wid,
- IX11_HIGZ_MSG,MAKEWPARAM(IX_S2BUF,HIGZ_Dummies),*mode);
-}
-
-/*___________________________________________________________________*/
-LRESULT APIENTRY
- Wnd_S2BUF (hwnd, uMsg, wParam, lParam)
-HWND hwnd;
-UINT uMsg;
-WPARAM wParam;
-LPARAM lParam;
-/* Global variable used:
- *
- * offPixmapDC - handle of the memory device context
- * offPixBuffer - handle of the bitmap in memory DC
- * = NULL - means there os no double buffering
- * for the current window.
- */
- {
- HBITMAP hdBuffer;
- HDC hdPixmapDC;
-
- hdPixmapDC = cHw->hdcPixBuffer;
- hdBuffer = cHw->hbBuffer;
-
- if (lParam) {
-/* Turn double bufferring ON */
- if (hdPixmapDC) FlushHIGZBuffer(hwnd);
- else CreateHIGZBuffer(hwnd);
- }
- else
-/* Turn double bufferring OFF */
- if (hdPixmapDC){
- hdBuffer = FlushHIGZBuffer(hwnd);
- DeleteDC(hdPixmapDC);
- DeleteObject(hdBuffer);
-
- cHw->hdcPixBuffer = NULL;
- cHw->hbBuffer = NULL;
- }
- }
-
-/*___________________________________________________________________*/
-/*
- * SUBROUTINE IXQ2BUF(WID)
- * INTEGER WID : Window identifier.
- *
- * Query the double buffer value for the window WID.
- */
-int
- ixq2buf( wid )
- int *wid;
-{
- int rval;
- struct HIGZWindow *Hw;
- Hw = (struct HIGZWindow *)GetWindowLong(*wid,ExtHIGZWindow);
- rval = (int) (Hw->hbBuffer);
- if (rval) return rval;
- else return -1;
-}
-
-
-
-/*___________________________________________________________________*/
-/*
- * INTEGER FUNCTION IXOPNPX(W, H)
- * INTEGER W,H : Width and height of the pixmap.
- *
- * Open a new pixmap.
- */
-int
- ixopnpx(w, h)
-int *w, *h;
-{
- static struct {SIZE PixMap;HANDLE semaphore;HBITMAP ipix;} HIGZPixmap;
-
- HIGZPixmap.PixMap.cx = *w;
- HIGZPixmap.PixMap.cy = *h;
-
- lpHpixmap = malloc(sizeof(HIGZWindow));
- if (lpHpixmap) {
- lpHpixmap->hdcWindow = CreateCompatibleDC(NULL);
- SetMapMode (lpHpixmap->hdcWindow,MM_ISOTROPIC);
- SetBkMode (lpHpixmap->hdcWindow,TRANSPARENT);
- if (hdCommonPalette!= NULL)
- DeleteObject(SelectPalette(lpHpixmap->hdcWindow,hdCommonPalette,TRUE));
-
- lpHpixmap->HIGZWindowSize.right = *w;
- lpHpixmap->HIGZWindowSize.bottom = *h;
- cHw = (struct HIGZWindow *)GetWindowLong(CurrentHIGZWindow,ExtHIGZWindow);
- lpHpixmap->hbBuffer = CreateCompatibleBitmap(cHw->hdcWindow,
- lpHpixmap->HIGZWindowSize.right,
- lpHpixmap->HIGZWindowSize.bottom);
- SelectObject(lpHpixmap->hdcWindow,lpHpixmap->hbBuffer);
- PixMapON = TRUE;
- }
- return (int) lpHpixmap->hbBuffer;
-}
-
-
-/*___________________________________________________________________*/
-/*
- * SUBROUTINE IXCLRPX(PIX)
- * INTEGER PIX : Pixmap address
- *
- * Clear the pixmap PIX.
- */
-void
- ixclrpx(pix )
-HGDIOBJ *pix;
-{
- RECT rect;
- BITMAP Bitmap_buffer;
-
- if (lpHpixmap) {
- if (lpHpixmap->hbBuffer == *pix) {
- GetObject(*pix, sizeof(BITMAP),&Bitmap_buffer);
- rect.left = 0;
- rect.top = 0;
- rect.right = Bitmap_buffer.bmWidth;
- rect.bottom = Bitmap_buffer.bmHeight;
- FillRect(lpHpixmap->hdcWindow,
- &rect, CurBrush = CreateSolidBrush(WHITE_HIGZ_COLOR));
- DeleteObject(CurBrush);
- }
- }
-}
-
-/*___________________________________________________________________*/
-/*
- * SUBROUTINE IXCLPX
- *
- * Close the current opened pixmap.
- */
-void
- ixclpx()
-{
- PixMapON = FALSE;
-}
-
-
-/*___________________________________________________________________*/
-/*
- * SUBROUTINE IXCPPX(PIX, XPOS, YPOS)
- * INTEGER PIX : Pixmap address
- * INTEGER XPOS, YPOS : Pixmap Position
- *
- * Copy the pixmap PIX at the position XPOS YPOS.
- */
-void
- ixcppx(pix, xpos, ypos)
-int *pix;
-int *xpos, *ypos;
-{
- POINT point;
- point.x = *xpos;
- point.y = *ypos;
- if (lpHpixmap->hbBuffer == *pix)
- SendMessage(CurrentHIGZWindow,
- IX11_HIGZ_MSG,MAKEWPARAM(IX_CPPX,HIGZ_Pixmap),&point);
-}
-
-/*___________________________________________________________________*/
-LRESULT APIENTRY
- Wnd_CPPX (hwnd, uMsg, wParam, lParam)
- HWND hwnd; UINT uMsg; WPARAM wParam; LPARAM lParam;
-{
- BITMAP Bitmap_buffer;
- int w,h;
- GetObject(lpHpixmap->hbBuffer, sizeof(BITMAP),&Bitmap_buffer);
- w = Bitmap_buffer.bmWidth;
- h = Bitmap_buffer.bmHeight;
- BitBlt(CurrentDC,((POINT*)lParam)->x,((POINT*)lParam)->y,w,h,
- lpHpixmap->hdcWindow,0,0,SRCCOPY);
-
-}
-
-
-
-/*___________________________________________________________________*/
-/*
- * SUBROUTINE IXWRPX(PIX,W,H,LENNAME,PXNAME)
- * INTEGER PIX : Pixmap address
- * INTEGER W,H : Width and height of the pixmap.
- * INTEGER LENNAME : pixmap name length
- * CHARACTER*(*) PXNAME: pixmap name
- *
- * Write the pixmap IPX in the bitmap file PXNAME.
- */
-void
- ixwrpx(pix, w, h, lenname, pxname,lpxname )
-char *pxname;
-int *pix;
-int *w, *h;
-int *lenname;
-int lpxname;
-{
- unsigned int wval, hval;
- wval = *w;
- hval = *h;
-/* XWriteBitmapFile(display,string(pxname,*lenname),*pix,wval,hval,-1,-1);
-*/
-}
-
-
-/*___________________________________________________________________*/
-/*
- * SUBROUTINE IXWIPX(PIX, XPOS, YPOS)
- * INTEGER PIX : Pixmap address
- * INTEGER XPOS, YPOS : Position in the current window
- *
- * Copy the area at the position XPOS YPOS in the current
- * window in the pixmap PIX. The area copied has the size
- * of the pixmap PIX.
- */
-void
- ixwipx(pix, xpos, ypos )
-int *pix;
-int *xpos, *ypos;
-{
- POINT point;
- point.x = *xpos;
- point.y = *ypos;
- SendMessage(CurrentHIGZWindow,
- IX11_HIGZ_MSG,MAKEWPARAM(IX_WIPX,HIGZ_Pixmap),&point);
-}
-
-/*___________________________________________________________________*/
-LRESULT APIENTRY
- Wnd_WIPX (hwnd, uMsg, wParam, lParam)
- HWND hwnd; UINT uMsg; WPARAM wParam; LPARAM lParam;
-{
- int w,h;
- BITMAP Bitmap_buffer;
-
- GetObject(lpHpixmap->hbBuffer, sizeof(BITMAP),&Bitmap_buffer);
- w = Bitmap_buffer.bmWidth;
- h = Bitmap_buffer.bmHeight;
- BitBlt(lpHpixmap->hdcWindow,0,0,w,h,
- CurrentDC,((POINT*)lParam)->x,((POINT*)lParam)->y,SRCCOPY);
-
-}
-
-
-
-/*___________________________________________________________________*/
-/*
- * SUBROUTINE IXRMPX(PIX)
- * INTEGER PIX : Pixmap adress
- *
- * Remove the pixmap PIX.
- */
-void
- ixrmpx(pix)
-int *pix;
-{
- PixMapON = FALSE;
- DeleteDC(lpHpixmap->hdcWindow);
- DeleteObject(lpHpixmap->hbBuffer);
- free(lpHpixmap);
- lpHpixmap = NULL;
-}
-
-
-/*___________________________________________________________________*/
-/*
- * SUBROUTINE IXCLSDS
- *
- * Delete all windows and close connection
- */
-void
- ixclsds()
-{
-/* Delete common objects */
- DeleteObject(hdCursorPen);
- DeleteObject(hdCursorBrush);
- PostMessage(CurrentHIGZWindow,
- IX11_HIGZ_MSG,MAKEWPARAM(IX_CLSDS,HIGZ_Control), 0);
-}
-
-
-/*___________________________________________________________________*/
-/*
- * SUBROUTINE IXCLSWI
- *
- * Delete current window
- */
-void
- ixclswi()
-{
- int wid;
-
- SendMessage(CurrentHIGZWindow,
- IX11_HIGZ_MSG,MAKEWPARAM(IX_CLSWI,HIGZ_Control), 0);
-
-// ixclsds(); /* no open window left */
-}
-
-
-/*___________________________________________________________________*/
-/*
- * SUBROUTINE IXSELWI(WID)
- * INTEGER WID : window number returned by IXOPNWIN
- *
- * Select window to which subsequent output is directed
- */
-void
- ixselwi( wid )
-HWND *wid;
-{
- CurrentHIGZWindow = *wid;
-}
-
-
-/*___________________________________________________________________*/
-/*
- * SUBROUTINE IXSAVWI
- *
- * Save the adress of the current active window
- */
-void
- ixsavwi()
-{
- sws = cws;
-}
-
-
-/*___________________________________________________________________*/
-/*
- * SUBROUTINE IXSETWI
- *
- * Restore the adress of the saved window
- */
-void
- ixsetwi()
-{
- cws = sws;
-}
-
-
-/*___________________________________________________________________*/
-/*
- * SUBROUTINE IXGETGE(WID,X,Y,W,H)
- * INTEGER WID : window identifier
- * INTEGER X,Y : window position (output)
- * INTEGER W,H : window size (output) (in Windowa/NT logical coordinat)
- *
- * Return position and size of window wid
- * if wid < 0 the size of the display is returned
- */
-void
- ixgetge( wid, x, y, w, h )
-HWND *wid;
-int *x, *y;
-unsigned int *w, *h;
-{
- HDC junkwin;
- static SIZE win_pos;
- if( *wid < 0 ) {
- /* Retrive size of full screen in the device unit */
- junkwin = GetDC(NULL);
- *x = 0;
- *y = 0;
- *w = GetDeviceCaps(junkwin,HORZRES);
- *h = GetDeviceCaps(junkwin,VERTRES);
- ReleaseDC(NULL,junkwin);
- } else {
- junkwin = SendMessage(*wid,IX11_HIGZ_MSG,MAKEWPARAM(IX_GETGE,HIGZ_Inquiry), &win_pos);
- /* Retrive size of DISPLAY in the logical unit */
- *x = 0;
- *y = 0;
- *w = win_pos.cx;
- *h = win_pos.cy;
- }
-}
-
-
-/*___________________________________________________________________*/
-/*
- * SUBROUTINE IXGETPL(NPLANES)
- * INTEGER NPLANES : number of bit planes
- *
- * Get maximum number of planes
- */
-void
- ixgetpl(nplanes)
-int *nplanes;
-{
- HDC hDCGlobal;
- hDCGlobal = GetDC(NULL);
- *nplanes = GetDeviceCaps(hDCGlobal,PLANES);
- ReleaseDC(NULL,hDCGlobal);
-}
-
-
-/*___________________________________________________________________*/
-/*
- * SUBROUTINE IXRSIZ(WID)
- * INTEGER WID : window to be resized
- *
- * Resize the current window if necessary
- */
-void
- ixrsiz(wid)
-int *wid;
-{
-
-}
-
-
-/*___________________________________________________________________*/
-/*
- * SUBROUTINE IXGETHT(IL,CHHOST)
- * INTEGER IL : host name length (output)
- * CHARACTER*(*) CHHOST : host name (output)
- *
- * Return the host name given with IGWKTY.
- */
-void
- ixgetht (il, chhost)
- int *il;
- char *chhost; /* host name */
-{
- GetComputerName(chhost,il);
-}
-
-
-/*___________________________________________________________________*/
-void
- ixgetwi (wkid, idg)
- int wkid; /* workstation identifier (input) */
- int *idg; /* window identifier (output) */
-{
- *idg = 1;
-}
-
-
-/*___________________________________________________________________*/
-/*
- * SUBROUTINE IXCLRWI
- *
- * Clear current window
- */
-void
- ixclrwi()
-{
- HIGZDrawing(MAKEWPARAM(IX_CLRWI,HIGZ_Control), 0);
-}
-
-
-/*___________________________________________________________________*/
-/*
- * SUBROUTINE IXUPDWI(MODE)
- * INTEGER MODE : (1) or (11) The window is raised
- * (0) or (10) The window is not raised
- * (0) or (1) no synchonisation between client and server
- * (10) or (11) synchonisation between client and server
- *
- * Update display and raise current window to top of stack.
- * Synchronise client and server once (not permanent).
- * Copy the pixmap cws->buffer on the window cws-> window
- * if the double buffer is on.
- */
-void
- ixupdwi(mode)
- int *mode;
-{
- SendMessage(CurrentHIGZWindow,IX11_HIGZ_MSG,
- MAKEWPARAM(IX_UPDWI,HIGZ_Control), *mode);
-}
-
-
-/*___________________________________________________________________*/
-/*
- * SUBROUTINE IXCLIP(WID,X,Y,W,H)
- * INTEGER WID : Window indentifier
- * INTEGER X,Y : origin of clipping rectangle
- * INTEGER W,H : size of clipping rectangle;
- *
- * Set clipping region for the window wid
- */
-void
- ixclip( wid, x, y, w, h )
-HWND *wid;
-int *x, *y;
-int *w, *h;
-{
- static RECT region;
-
- region.left = *x;
- region.top = *y;
- region.right = *x+*w;
- region.bottom = *y+*h;
-
- SendMessage(*wid,IX11_HIGZ_MSG,MAKEWPARAM(IX_CLIP,HIGZ_Control), ®ion);
-
-}
-
-/*___________________________________________________________________*/
-/*
- * SUBROUTINE IWCLIP(WID,XMIN,YMIN,XMAX,YMAX)
- * INTEGER WID : Window indentifier
- * INTEGER XMIN,YMIN, XMAX, YMAX : clipping rectangle
- *
- * Set clipping region for the window wid
- */
-void
- iwclip( wid, xmin, ymin, xmax, ymax )
-HWND *wid;
-int *xmin, *ymin, *xmax, *ymax;
-{
- static RECT region;
-
- region.left = *xmin;
- region.top = *ymin;
- region.right = *xmax;
- region.bottom = *ymax;
-
- SendMessage(*wid,IX11_HIGZ_MSG,MAKEWPARAM(IX_CLIP,HIGZ_Control), ®ion);
-
-}
-
-/*___________________________________________________________________*/
-/*
- * SUBROUTINE IXNOCLI(WID)
- * INTEGER WID : Window indentifier
- *
- * Switch off the clipping for the window wid
- */
-void
- ixnocli(wid)
-HWND *wid;
-{
-
- SendMessage(*wid,IX11_HIGZ_MSG,MAKEWPARAM(IX_NOCLI,HIGZ_Control), 0 );
-
-}
-
-
-/*___________________________________________________________________*/
-/*
- * SUBROUTINE IXSETCO(CINDEX,R,G,B)
- * INTEGER CINDEX : color index
- * REAL R,G,B : red, green, blue intensities between 0.0 and 1.0
- *
- * Set color intensities for given color index
- */
-#define BIGGEST_RGB_VALUE 255 // 65535
-
-void
- ixsetco( cindex, r, g, b )
-int *cindex;
-float *r, *g, *b;
-{
- static PALETTEENTRY ChColor;
- static struct {UINT ci; struct PALETTEENTRY *lpChColor;} NewColor;
- int i;
-
- if (*cindex >= MAXCOL-1) return;
- if (hdCommonPalette != NULL) {
- NewColor.ci = *cindex;
- NewColor.lpChColor = &ChColor;
-
- ChColor.peRed = (BYTE) (*r*BIGGEST_RGB_VALUE);
- ChColor.peGreen = (BYTE) (*g*BIGGEST_RGB_VALUE);
- ChColor.peBlue = (BYTE) (*b*BIGGEST_RGB_VALUE);
-
- ChColor.peFlags = PC_NOCOLLAPSE;
-
- i = NewColor.ci+ColorOffset;
- SetPaletteEntries(hdCommonPalette,i,1,&ChColor);
- }
- else if (lpPalette){
- lpPalette->palPalEntry[*cindex].peRed = (BYTE) (*r*BIGGEST_RGB_VALUE);
- lpPalette->palPalEntry[*cindex].peGreen = (BYTE) (*g*BIGGEST_RGB_VALUE);
- lpPalette->palPalEntry[*cindex].peBlue = (BYTE) (*b*BIGGEST_RGB_VALUE);
- }
-}
-
-
-/*___________________________________________________________________*/
-void
- ixgetcol( index, r, g, b )
-int index; /* input */
-float *r, *g, *b; /* output */
-{
- static struct {int index; PALETTEENTRY rgb;} HIGZ_rgb;
- if (hdCommonPalette) {
- HIGZ_rgb.index = index;
- SendMessage(CurrentHIGZWindow,
- IX11_HIGZ_MSG,MAKEWPARAM(IX_GETCOL,HIGZ_Inquiry),&HIGZ_rgb);
- *r = (float)HIGZ_rgb.rgb.peRed /BIGGEST_RGB_VALUE;
- *g = (float)HIGZ_rgb.rgb.peGreen/BIGGEST_RGB_VALUE;
- *b = (float)HIGZ_rgb.rgb.peBlue /BIGGEST_RGB_VALUE;
- }
- else if (lpPalette) {
- *r = lpPalette->palPalEntry[index].peRed/BIGGEST_RGB_VALUE;
- *g = lpPalette->palPalEntry[index].peGreen/BIGGEST_RGB_VALUE;
- *b = lpPalette->palPalEntry[index].peBlue/BIGGEST_RGB_VALUE;
- }
- else {
- *r = *g = *b = 0;
- }
- return ;
-}
-
-/*___________________________________________________________________*/
-HPEN CreateHIGZPen(lpPen)
-struct HIGZPEN *lpPen;
- {
- static int dwWidth, dwStyle;
-
- dwWidth = lpPen->pen.lopnWidth.x;
- if (dwWidth <= 1) dwWidth=1;
-
- dwStyle = lpPen->pen.lopnStyle |
- ((dwWidth == 1)? PS_COSMETIC:
- PS_GEOMETRIC | PS_INSIDEFRAME);
-
- if (hdCommonPen) DeleteObject(hdCommonPen);
- return ExtCreatePen( dwStyle,
- dwWidth,
- &(lpPen->brush),
- lpPen->lUserDash,
- lpPen->UserDash);
- }
-
-
-/*___________________________________________________________________*/
-/*
- * SUBROUTINE IXSETLN(WIDTH)
- * INTEGER WIDTH : line width in pixels
- *
- * Set line width
- */
-void
- ixsetln( width )
-int *width;
-{
- if (pen.pen.lopnWidth.x != *width)
- {
- pen.pen.lopnWidth.x = *width;
- hdCommonPen = CreateHIGZPen(&pen);
- }
-}
-
-
-/*___________________________________________________________________*/
-/*
- * SUBROUTINE IXSETLS(N,DASH)
- * INTEGER N : length of dash list
- * INTEGER DASH(N) : dash segment lengths
- *
- * Set line style:
- * if N.LE.0 use pre-defined Windows style:
- * 0 - solid lines
- * -1 - solid lines
- * -2 - dash line
- * -3 - dot line
- * -4 - dash-dot line
- * -5 - dash-dot-dot line
- * .LE.-6 - solid line
- *
- * if N.GT.0 use dashed lines described by DASH(N)
- * e.g. N=4,DASH=(6,3,1,3) gives a dashed-dotted line with dash length 6
- * and a gap of 7 between dashes
- */
-void
- ixsetls( n, dash )
-int *n;
-int *dash;
-{
- UINT style;
- if( *n <= 0 ) {
- pen.lUserDash = 0;
- pen.UserDash = NULL;
- switch (*n)
- {
- case 0: style = PS_SOLID;
- break;
- case -1: style = PS_SOLID;
- break;
- case -2: style = PS_DASH;
- break;
- case -3: style = PS_DOT;
- break;
- case -4: style = PS_DASHDOT;
- break;
- case -5: style = PS_DASHDOTDOT;
- break;
- default: style = PS_SOLID;
- break;
- }
- if (pen.pen.lopnStyle == style ) return;
- pen.pen.lopnStyle = style;
- }
- else
- {
- pen.pen.lopnStyle = PS_USERSTYLE;
- pen.lUserDash = *n;
- pen.UserDash = dash;
- }
- hdCommonPen = CreateHIGZPen(&pen);
-}
-
-
-/*___________________________________________________________________*/
-/*
- * SUBROUTINE IXSETLC(CINDEX)
- * INTEGER CINDEX : color index defined my IXSETCOL
- *
- * Set color index for lines
- */
-void
- ixsetlc( cindex )
-int *cindex;
-{
- if (pen.pen.lopnColor != *cindex)
- {
- pen.pen.lopnColor = *cindex;
- pen.brush.lbColor = HIGZColorIndex(pen.pen.lopnColor);
-
- hdCommonPen = CreateHIGZPen(&pen);
- }
-}
-
-
-/*___________________________________________________________________*/
-/*
- * SUBROUTINE IXLINE(N,XY)
- * INTEGER N : number of points
- * INTEGER*2 XY(2,N) : list of points
- *
- * Draw a line through all points
- */
-void
- ixline( n, xy )
-int *n;
-XPoint *xy;
-{
- static struct { int n; XPoint *xy;} line;
- line.n = *n;
- line.xy = xy;
- HIGZDrawing(MAKEWPARAM(IX_LINE,HIGZ_Primitive),&line);
-}
-
-
-/*___________________________________________________________________*/
-/*
- * SUBROUTINE IXSETMS(TYPE,N,XY)
- * INTEGER TYPE : marker type
- * INTEGER N : length of marker description
- * INTEGER*2 XY(2,N) : list of points describing marker shape
- *
- * Set marker style:
- * if N.EQ.0 marker is a single point
- * if TYPE.EQ.0 marker is hollow circle of diameter N
- * if TYPE.EQ.1 marker is filled circle of diameter N
- * if TYPE.EQ.2 marker is a hollow polygon describe by line XY
- * if TYPE.EQ.3 marker is a filled polygon describe by line XY
- * if TYPE.EQ.4 marker is described by segmented line XY
- * e.g. TYPE=4,N=4,XY=(-3,0,3,0,0,-3,0,3) sets a plus shape of 7x7 pixels
- */
-void
- ixsetms( type, n, xy )
-int *type;
-int *n;
-XPoint *xy;
-{
- int i;
-
- marker.type = *type;
- marker.n = *n < MAXMK ? *n : MAXMK;
- if( marker.type >= 2 )
- for( i = 0; i < marker.n; i++ )
- marker.xy[i] = xy[i];
-}
-
-
-/*___________________________________________________________________*/
-/*
- * SUBROUTINE IXSETMC(CINDEX)
- * INTEGER CINDEX : color index defined my IXSETCOL
- *
- * Set color index for markers
- */
-void
- ixsetmc( cindex )
-int *cindex;
-{
- marker.cindex = *cindex;
-}
-
-
-/*___________________________________________________________________*/
-/*
- * SUBROUTINE IXMARKE(N,XY)
- * INTEGER N : number of points
- * INTEGER*2 XY(2,N) : list of points
- *
- * Draw a marker at each point
- */
-void
- ixmarke( n, xy )
-int *n;
-XPoint *xy;
-{
- static struct { int n; XPoint *xy; struct MARKER *marker;} markers;
-
- markers.n = *n;
- markers.xy = xy;
- markers.marker = ▮
-
- HIGZDrawing(MAKEWPARAM(IX_MARKE,HIGZ_Primitive),&markers);
-
-}
-
-/*___________________________________________________________________*/
- LRESULT APIENTRY
- Wnd_MARKE(hwnd, uMsg, wParam, lParam)
- HWND hwnd;
- UINT uMsg;
- WPARAM wParam;
- LPARAM lParam;
- {
- struct { int n; XPoint *xy; struct MARKER *marker;} *markers;
- int m,n;
- XPoint *xy;
- COLORREF mColor;
- struct MARKER *CurMarker;
- int ownBrush;
-
- markers = lParam;
- n = markers->n;
- xy = markers->xy;
- CurMarker = markers->marker;
-
- /* Set marker Color */
- mColor = HIGZColorIndex(CurMarker->cindex);
-
- if( CurMarker->n <= 0 )
- for (m=0; m < n; m++) SetPixel(CurrentDC, xy[m].x,xy[m].y, mColor);
-
- else {
- int r = CurMarker->n / 2;
- HGDIOBJ CurBrush, CurPen;
-
- CurPen = SelectObject(CurrentDC, CreatePen(PS_SOLID,0,mColor));
-
- switch (CurMarker -> type) {
- case 0:
- case 3:
- default:
- ownBrush = TRUE;
- CurBrush = SelectObject(CurrentDC, CreateSolidBrush(mColor));
- break;
- case 1:
- case 2:
- ownBrush = TRUE;
- CurBrush = SelectObject(CurrentDC, GetStockObject(HOLLOW_BRUSH));
- break;
- case 4:
- ownBrush = FALSE;
- break;
- }
-
- for( m = 0; m < n; m++ ) {
- int i;
-
- switch( CurMarker->type ) {
-
- case 0: /* hollow circle */
- case 1: /* filled circle */
-
-
- Ellipse( CurrentDC,
- xy[m].x - r, xy[m].y - r,
- xy[m].x + r, xy[m].y + r);
- break;
-
- case 2: /* hollow polygon */
- case 3: /* filled polygon */
- for( i = 0; i < CurMarker->n; i++ ) {
- CurMarker->xy[i].x += xy[m].x;
- CurMarker->xy[i].y += xy[m].y;
- }
- Polygon(CurrentDC,CurMarker->xy,CurMarker->n);
- for( i = 0; i < CurMarker->n; i++ ) {
- CurMarker->xy[i].x -= xy[m].x;
- CurMarker->xy[i].y -= xy[m].y;
- }
- break;
-
- case 4: /* segmented line */
- for( i = 0; i < CurMarker->n; i += 2 )
- {
- MoveToEx(CurrentDC,xy[m].x + CurMarker->xy[i].x, xy[m].y + CurMarker->xy[i].y,NULL);
- LineTo(CurrentDC,xy[m].x + CurMarker->xy[i+1].x, xy[m].y + CurMarker->xy[i+1].y);
- }
- break;
- }
- }
-
-
- if (ownBrush) DeleteObject(SelectObject(CurrentDC, CurBrush));
- DeleteObject( SelectObject(CurrentDC, CurPen ));
- }
- return (LRESULT)TRUE;
- }
-
-
-
-/*___________________________________________________________________*/
-/*
- * SUBROUTINE IXSETFS(STYLE,FASI)
- * INTEGER STYLE : fill area interior style hollow or solid
- *
- * Set fill area style
- */
-void
- ixsetfs( style, fasi )
-int *style;
-int *fasi;
-{
- if (hdCommonBrush != NULL) DeleteObject(hdCommonBrush);
- switch( *style ) {
-
- case 0: /* solid */
- gcfill.lbStyle = BS_HOLLOW;
- hdCommonBrush = GetStockObject(HOLLOW_BRUSH);
- break;
- case 1: /* solid */
- gcfill.lbStyle = BS_SOLID;
-// if (gcfill.lbColor)
- hdCommonBrush = CreateSolidBrush(HIGZColorIndex(gcfill.lbColor));
-// else
-// hdCommonBrush = GetStockObject(WHITE_BRUSH);
- break;
-
- case 2: /* pattern */
- gcfill.lbStyle = BS_PATTERN;
- gcfill.lbHatch = &FillBitMap;
- switch( *fasi ) {
- case 1: FillBitMap.bmBits = &p1_bits;
- break;
- case 2: FillBitMap.bmBits = &p2_bits;
- break;
- case 3: FillBitMap.bmBits = &p3_bits;
- break;
- case 4: FillBitMap.bmBits = &p4_bits;
- break;
- case 5: FillBitMap.bmBits = &p5_bits;
- break;
- case 6: FillBitMap.bmBits = &p6_bits;
- break;
- case 7: FillBitMap.bmBits = &p7_bits;
- break;
- case 8: FillBitMap.bmBits = &p8_bits;
- break;
- case 9: FillBitMap.bmBits = &p9_bits;
- break;
- default: FillBitMap.bmBits = &p2_bits;
- break;
- }
- hdCommonBrush =
- CreatePatternBrush(CreateBitmapIndirect((LPBITMAP)gcfill.lbHatch));
- break;
-
- case 3: /* hatch */
- gcfill.lbStyle = BS_HATCHED;
- switch (*fasi)
- {
- case 1: gcfill.lbHatch = HS_BDIAGONAL;
- break;
- case 2: gcfill.lbHatch = HS_CROSS;
- break;
- case 3: gcfill.lbHatch = HS_DIAGCROSS;
- break;
- case 4: gcfill.lbHatch = HS_FDIAGONAL;
- break;
- case 5: gcfill.lbHatch = HS_HORIZONTAL;
- break;
- case 6: gcfill.lbHatch = HS_VERTICAL;
- break;
- default: gcfill.lbHatch = HS_FDIAGONAL;
- break;
- }
- hdCommonBrush =
- CreateHatchBrush(gcfill.lbHatch,HIGZColorIndex(gcfill.lbColor));
- break;
- default: /* solid */
- gcfill.lbStyle = BS_NULL;
-// if (gcfill.lbColor)
- hdCommonBrush = CreateSolidBrush(HIGZColorIndex(gcfill.lbColor));
-// else
-// hdCommonBrush = GetStockObject(WHITE_BRUSH);
- break;
-
- }
-}
-
-
-/*___________________________________________________________________*/
-/*
- * SUBROUTINE IXSETFC(CINDEX)
- * INTEGER CINDEX : color index defined my IXSETCOL
- *
- * Set color index for fill areas
- */
-void
- ixsetfc( cindex )
-int *cindex;
-{
- if (gcfill.lbColor != *cindex) {
- gcfill.lbColor = *cindex;
-
- switch (gcfill.lbStyle)
- {
- case BS_HOLLOW :
- case BS_PATTERN :
-/* Hollow and Patten styles needn't a change of brush */
- break;
- case BS_HATCHED :
- if (hdCommonBrush) DeleteObject(hdCommonBrush);
- hdCommonBrush =
- CreateHatchBrush(gcfill.lbHatch,HIGZColorIndex(gcfill.lbColor));
- break;
- case BS_SOLID :
- default :
- if (hdCommonBrush) DeleteObject(hdCommonBrush);
-// if (gcfill.lbColor)
- hdCommonBrush = CreateSolidBrush(HIGZColorIndex(gcfill.lbColor));
-// else
-// hdCommonBrush = GetStockObject(WHITE_BRUSH);
- break;
- }
- }
-}
-
-
-/*___________________________________________________________________*/
-/*
- * SUBROUTINE IXFLARE(N,XY)
- * INTEGER N : number of points
- * INTEGER*2 XY(2,N) : list of points
- *
- * Fill area described by polygon
- */
-void
- ixflare( n, xy )
-int *n;
-XPoint *xy;
-{
- static struct {int n; XPoint *xy;} polygon;
-
- polygon.n = *n;
- polygon.xy = xy;
- HIGZDrawing(MAKEWPARAM(IX_FLARE,HIGZ_Primitive),&polygon);
-}
-
-/*___________________________________________________________________*/
- LRESULT APIENTRY
- Wnd_FLARE(hwnd, uMsg, wParam, lParam)
- HWND hwnd;
- UINT uMsg;
- WPARAM wParam;
- LPARAM lParam;
- {
- static struct {int n; XPoint *xy;} *polygon;
- static COLORREF CurTextColor;
- static HGDIOBJ lpCurPen;
-
- polygon = lParam;
-
- if (!bord & gcfill.lbStyle != BS_HOLLOW)
- lpCurPen = SelectObject(CurrentDC, GetStockObject(NULL_PEN));
-
-
- if (gcfill.lbStyle == BS_PATTERN) {
- CurTextColor = SetTextColor(CurrentDC,HIGZColorIndex(gcfill.lbColor));
- Polygon(CurrentDC,polygon->xy,polygon->n);
- SetTextColor(CurrentDC,CurTextColor);
- }
- else {
- Polygon(CurrentDC,polygon->xy,polygon->n);
- }
- if (!bord & gcfill.lbStyle != BS_HOLLOW)
- DeleteObject(SelectObject(CurrentDC,lpCurPen));
-
- return TRUE;
-}
-
-/*___________________________________________________________________*/
-/*
- * SUBROUTINE IXSETTA(ALIGNH,ALIGNV)
- * INTEGER ALIGNH : horizontal text alignment
- * INTEGER ALIGNV : vertical text alignment
- *
- * Set text alignment:
- * if ALIGNH.EQ.2 align center
- * if ALIGHH.EQ.3 align right
- * else align left
- *
- * if ALIGNV.EQ.1 align top
- * if ALIGNV.EQ.2 align top
- * if ALIGNV.EQ.3 align middle
- * else align base
- */
-void
- ixsetta( align_h, align_v )
-int *align_h;
-int *align_v;
-{
- dwCommonTextAlign = 0;
- switch( *align_h ) {
-
- case 2:
- dwCommonTextAlign |= TA_CENTER;
- break;
-
- case 3:
- dwCommonTextAlign |= TA_RIGHT;
- break;
-
- default:
- dwCommonTextAlign |= TA_LEFT;
- }
-
-
- switch( *align_v ) {
-
- case 1:
- case 2:
- dwCommonTextAlign |= TA_TOP;
- align_vert = 1;
- break;
-
- case 3:
- dwCommonTextAlign |= TA_BASELINE;
- align_vert = 0;
- break;
-
- default:
- dwCommonTextAlign |= TA_BASELINE;
- align_vert = -1;
- }
-}
-
-/*___________________________________________________________________*/
-/*
- * FUNCTION IXSETTF(MODE,LENFNT,FONTNAME)
- * INTEGER *MODE : Option message
- * [0] : = 1 - Italic
- * [1] : = BOLD
- * [2] : = Height of the character
- * [3] : = Angle
- * [4] : = Precision
- * INTEGER LENFNT : font name length
- * CHARACTER*(*) FONT : font name
- *
- * Set text font to specified name. This function returns 0 if
- * the specified font is found, 1 if not.
- */
-int
- ixsettf( mode, lenfnt, fontname
-#ifdef CERNLIB_QFMSOFT
- , len_fontname
-#endif
- )
-char *fontname;
-#ifdef CERNLIB_QFMSOFT
- int len_fontname;
-#endif
-
-int *mode;
-int *lenfnt;
-{
- HIGZFont.lfItalic = (BYTE) mode[0];
- HIGZFont.lfWeight = (LONG) mode[1]*100;
- HIGZFont.lfHeight = (LONG) mode[2]*1.1; // To account "tail"
- // HIGZFont.lfWidth = (LONG) mode[2]*1.2
- HIGZFont.lfEscapement = (LONG)mode[3];
- HIGZFont.lfOutPrecision = 0; // (LONG)mode[4];
- strcpy(HIGZFont.lfFaceName,fontname);
-
- if (hdCommonFont != NULL) DeleteObject(hdCommonFont);
- hdCommonFont = CreateFontIndirect(&HIGZFont);
-
- return 0;
- }
-
-
-/*___________________________________________________________________*/
-/*
- * SUBROUTINE IXSETTC(CINDEX)
- * INTEGER CINDEX : color index defined my IXSETCOL
- *
- * Set color index for text
- */
-void
- ixsettc( cindex )
-int *cindex;
-{
- dwCommonTextColor = HIGZColorIndex((COLORREF)(*cindex));
-}
-
-
-/*___________________________________________________________________*/
-/*
- * SUBROUTINE IXTEXT(MODE,X,Y,ANGLE,MGN,LENTXT,TEXT)
- * INTEGER MODE : drawing mode
- * MODE=0 : the background is not drawn
- * MODE=1 : the background is drawn
- * INTEGER X,Y : text position
- * REAL ANGLE : text angle
- * REAL MGN : magnification factor
- * INTEGER LENTXT : text length
- * CHARACTER*(*) TEXT : text string
- *
- * Draw a text string using current font
- */
-void
- ixtext( mode, x, y, angle, mgn, lentxt, text, len_text )
-char *text;
-int len_text;
-int *mode;
-int *x, *y;
-float *angle;
-float *mgn;
-int *lentxt;
-{
- int dx = 0;
- int dy = 0;
- static struct {int mode,x,y,lentxt; float angle, mgn; char *text;} text_msg;
-
- text_msg.mode = *mode;
- text_msg.x = *x;
- text_msg.y = *y;
- text_msg.angle = *angle;
- text_msg.mgn = *mgn;
- text_msg.text = text;
- text_msg.lentxt=*lentxt;
-
- HIGZDrawing(MAKEWPARAM(IX_TEXT,HIGZ_Text), &text_msg);
-
-// do_raise = 1;
-}
-
-
-/*___________________________________________________________________*/
-/*
- * SUBROUTINE IXTXTL(IW,IH,LMESS,MESS)
- * INTEGER IW : text width
- * INTEGER IH : text height
- * INTEGER LMES : message length
- * CHARACTER*(*) MESS : message
- *
- * Return the size of a character string
- */
-void
- ixtxtl( w, h, lmess, mess
-#ifdef CERNLIB_QFMSOFT
- , len_mess
-#endif
- )
-char *mess;
-#ifdef CERNLIB_QFMSOFT
- int len_mess;
-#endif
-
-int *lmess;
-int *w;
-int *h;
-{
- static struct { int w,h, lmess; char *mess;} sText;
- HIGZDrawing(MAKEWPARAM(IX_TXTL,HIGZ_Text), &sText);
- *w = sText.w;
- *h = sText.h;
-}
-
-
-/*___________________________________________________________________*/
-/*
- * SUBROUTINE IXBOX(X1,X2,Y1,Y2,MODE)
- * INTEGER X1,Y1 : left down corner
- * INTEGER X2,Y2 : right up corner
- * INTEGER MODE : drawing mode
- *
- * MODE=0 hollow
- * MODE=1 solid
- *
- * Draw a box
- */
-void
- ixbox( x1, x2, y1, y2, mode)
-int *x1, *x2, *y1, *y2;
-int *mode;
-{
- static struct { int x1, y1, x2, y2, mode;} box;
-
- box.mode = *mode;
- box.x1 = min(*x1,*x2);
- box.x2 = max(*x1,*x2);
- box.y1 = min(*y1,*y2);
- box.y2 = max(*y1,*y2);
-
- HIGZDrawing(MAKEWPARAM(IX_BOX,HIGZ_Primitive), &box);
-
-}
-
-/*___________________________________________________________________*/
- LRESULT APIENTRY
- Wnd_BOX(hwnd, uMsg, wParam, lParam)
- HWND hwnd;
- UINT uMsg;
- WPARAM wParam;
- LPARAM lParam;
- {
- struct { int x1, y1, x2, y2, mode;} *box;
- HGDIOBJ NewBrush, lpCurPen;
- static COLORREF CurTextColor;
-
- box = lParam;
- if (box->mode == 0) {
- if (box->x1 == box->x2 | box->y1 == box->y2) {
-/* Draw a line instead the rectangle */
- MoveToEx(CurrentDC,box->x1,box->y1,NULL);
- LineTo (CurrentDC,box->x2,box->y2);
- }
- else {
- CurBrush = SelectObject(CurrentDC, GetStockObject(HOLLOW_BRUSH));
- Rectangle(CurrentDC,box->x1, box->y1, box->x2, box->y2);
- DeleteObject(SelectObject(CurrentDC,CurBrush));
- }
- }
- else {
-// CurBrush = GetCurrentObject(CurrentDC,OBJ_BRUSH);
- if (gcfill.lbStyle == BS_PATTERN) {
- CurTextColor = SetTextColor(CurrentDC,HIGZColorIndex(gcfill.lbColor));
- FillRect(CurrentDC, (RECT*)box, hdCommonBrush);
- SetTextColor(CurrentDC,CurTextColor);
- }
- else
- FillRect(CurrentDC, (RECT*)box, hdCommonBrush);
- }
- return TRUE;
- }
-
-/*___________________________________________________________________*/
-/*
- * SUBROUTINE IXCA(X1,X2,Y1,Y2,NX,NY,IC)
- * INTEGER X1,Y1 : left down corner
- * INTEGER X2,Y2 : right up corner
- * INTEGER NX,NY : array size
- * INTEGER IC : array
- *
- * Draw a cell array. The drawing is done with the pixel presicion
- * if (X2-X1)/NX (or Y) is not a exact pixel number the position of
- * the top rigth corner may be wrong.
- */
-void
- ixca(x1, x2, y1, y2, nx, ny, ic)
-int *x1, *x2, *y1, *y2, *nx, *ny;
-int ic[];
-{
-
- static struct { int x1, x2, y1, y2, nx, ny; int *ic;} cell;
-
- cell.x1 = *x1;
- cell.x2 = *x2;
- cell.y1 = *y1;
- cell.y2 = *y2;
-
- cell.nx = *nx;
- cell.ny = *ny;
- cell.ic = ic;
-
- cell.x1 = *x1;
- HIGZDrawing(MAKEWPARAM(IX_CA,HIGZ_Primitive), &cell);
-}
-
-/*___________________________________________________________________*/
- LRESULT APIENTRY
- Wnd_CA(hwnd, uMsg, wParam, lParam)
- HWND hwnd;
- UINT uMsg;
- WPARAM wParam;
- LPARAM lParam;
- {
- int i,j,icol,ix,iy,w,h,hh,current_icol;
- struct { int x1, x2, y1, y2, nx, ny; int *ic;} *cell;
- HBRUSH CurCABrush = NULL;
- RECT box;
- cell = lParam;
-
- current_icol = -1;
- w = max((cell->x2-cell->x1)/(cell->nx),1);
- h = max((cell->y1-cell->y2)/(cell->ny),1);
- ix = cell->x1;
-
- box.bottom = cell->y1;
- box.top = cell->y1;
- box.left = cell->x1;
- box.right = box.left+h;
- for ( i=0; i<cell->nx; i++ ) {
- box.top -= h;
- for ( j=0; j<cell->ny; j++ ) {
- icol = cell->ic[i+(cell->nx*j)];
- if(icol != current_icol){
- if (CurCABrush != NULL) DeleteObject(CurCABrush);
- CurCABrush = CreateSolidBrush(HIGZColorIndex(icol));
- current_icol = icol;
- }
- FillRect(CurrentDC, &box, CurCABrush);
- box.bottom = box.top;
- box.top -= h;
- }
- box.left = box.right;
- box.right += w;
- }
-
- DeleteObject(CurCABrush);
- return TRUE;
- }
-
-
-/*___________________________________________________________________*/
-/*
- * SUBROUTINE IXDRMDE(MODE)
- * INTEGER MODE : drawing mode
- *
- * MODE=1 copy R2_COPYPEN
- * MODE=2 xor - R2_XORPEN
- * MODE=3 invert - R2_NOT
- *
- * Set the drawing mode
- */
-void
- ixdrmde( mode )
- int *mode;
-{
- static int OP[3] = {R2_COPYPEN, R2_XORPEN, R2_NOT};
- HIGZDrawing(MAKEWPARAM(IX_DRMDE,HIGZ_Attribute), OP[*mode-1]);
-}
-
-
-/*___________________________________________________________________*/
-/*
- * SUBROUTINE IXSYNC(MODE)
- * INTEGER MODE : synchronisation on/off
- *
- * MODE=1 on
- * MODE<>0 off
- *
- * Set synchronisation on or off
- */
-void
- ixsync( mode )
- int *mode;
-{
- int i;
-}
-
-
-/*___________________________________________________________________*/
-/*
- * INTEGER FUNCTION IXREQLO(MODE,CTYP,X,Y)
- * INTEGER X,Y : cursor position out moment of button press (output)
- * INTEGER CTYP : cursor type (input)
- *
- * CTYP=1 tracking cross
- * CTYP=2 cross-hair
- * CTYP=3 rubber circle
- * CTYP=4 rubber band
- * CTYP=5 rubber rectangle
- *
- * INTEGER MODE : input mode
- *
- * MODE=0 request
- * MODE=1 sample
- *
- * Request locator:
- * return button number 1 = left is pressed
- * 2 = middle is pressed
- * 3 = right is pressed
- * in sample mode:
- * 11 = left is released
- * 12 = middle is released
- * 13 = right is released
- * -1 = nothing is pressed or released
- * -2 = leave the window
- */
-int
- ixreqlo( mode, ctyp, x, y )
-int *mode, *ctyp, *x, *y;
-{
- static struct {int mode, ctyp, x, y, button; HANDLE semaphore;} HIGZmouse;
-
- HIGZmouse.x = *x;
- HIGZmouse.y = *y;
- HIGZmouse.ctyp = *ctyp;
- HIGZmouse.mode = *mode;
- HIGZmouse.semaphore = CreateSemaphore(NULL, 0, 1, NULL);
-
- SendMessage(CurrentHIGZWindow,
- IX11_HIGZ_Input,MAKEWPARAM(IX_REQLO,HIGZ_Input),&HIGZmouse);
-
- WaitForSingleObject(HIGZmouse.semaphore, INFINITE);
- CloseHandle(HIGZmouse.semaphore);
-
- *x = HIGZmouse.x;
- *y = HIGZmouse.y;
- return HIGZmouse.button;
-
-}
-
-/*___________________________________________________________________*/
- LRESULT APIENTRY
- Wnd_REQLO(hwnd, uMsg, wParam, lParam)
- HWND hwnd;
- UINT uMsg;
- WPARAM wParam;
- LPARAM lParam;
- {
- /* Global for draw cursor utilities variables */
- static struct {int mode, ctyp, x, y, button; HANDLE semaphore;} *lpHIGZmouse;
-
-
- if (hdCommonPalette) {
- SetSystemPaletteUse(cHw->hdcWindow,SYSPAL_NOSTATIC);
- RealizePalette(cHw->hdcWindow);
- }
-
- cHw->button_press = 0;
- cHw->button_up = 0;
- switch (uMsg) {
- case WM_RBUTTONUP:
- cHw->button_up++;
- case WM_MBUTTONUP:
- cHw->button_up++;
- case WM_LBUTTONUP:
- cHw->button_up++;
- cHw->button_press++;
- case WM_RBUTTONDOWN:
- cHw->button_press++;
- case WM_MBUTTONDOWN:
- cHw->button_press++;
- case WM_LBUTTONDOWN:
- cHw->button_press++;
- case WM_MOUSEMOVE:
-
- /* Clean an old position */
-
- DrawHIGZCursor(lpHIGZmouse->ctyp);
-
- /* Plot new cursor position */
-
- cHw->loc.x = (LONG) (MAKEPOINTS(lParam).x);
- cHw->loc.y = (LONG) (MAKEPOINTS(lParam).y);
- DPtoLP(CurrentDC,&(cHw->loc),1);
- DrawHIGZCursor(lpHIGZmouse->ctyp);
-
- /* Reset system cursor near the bord id frame */
-
- if (lpHIGZmouse->mode) {
- if (cHw->button_press == 0)
- cHw->button_press = -1;
- else if (cHw->button_press == 4)
- cHw->button_press = cHw->button_up+10;
- RestoreHIGZ(lpHIGZmouse->ctyp);
- lpHIGZmouse->x = cHw->loc.x ; lpHIGZmouse->y = cHw->loc.y ;
- lpHIGZmouse->button = cHw->button_press;
-
-// RestoreDC(CurrentDC,-1);
- ReleaseSemaphore(lpHIGZmouse->semaphore,1L,NULL);
-
- }
- else if (cHw->button_press > 0 & cHw->button_up ==0) {
- RestoreHIGZ(lpHIGZmouse->ctyp);
- lpHIGZmouse->x = cHw->loc.x ; lpHIGZmouse->y = cHw->loc.y;
- lpHIGZmouse->button = cHw->button_press;
-
- ReleaseSemaphore(lpHIGZmouse->semaphore,1L,NULL);
- }
-
- break;
- case IX11_HIGZ_Input:
- lpHIGZmouse = lParam;
- cHw->loc.x = lpHIGZmouse->x; cHw->loc.y = lpHIGZmouse->y;
- cHw->locp.x = lpHIGZmouse->x; cHw->locp.y = lpHIGZmouse->y;
-
- HIGZCursorInit(hwnd,lpHIGZmouse->ctyp);
- break;
- default:
- break;
- }
-}
-
- DrawHIGZCursor( ctyp)
- int ctyp;
- {
- int radius, CurMxX, CurMxY;
- POINT loc,locp;
- loc.x = cHw->loc.x;
- loc.y = cHw->loc.y;
-
- locp.x = cHw->locp.x;
- locp.y = cHw->locp.y;
-
- CurMxX = cHw->HIGZWindowSize.right;
- CurMxY = cHw->HIGZWindowSize.bottom;
-
- switch ( ctyp ) {
-
- case 1 : /* Default HIGZ window cursor is CROSS -> do nothing here */
- /*
- * MoveToEx(CurrentDC,max(0,loc.x-10), loc.y,NULL);
- * LineTo (CurrentDC,min(CurMxX,loc.x+10),loc.y);
-
- * MoveToEx(CurrentDC,loc.x,max(0,loc.y-10) ,NULL);
- * LineTo (CurrentDC,loc.x,min(CurMxY,loc.y+10));
- */
- break;
-
- case 2 : MoveToEx(CurrentDC,0, loc.y,NULL);
- LineTo (CurrentDC,CurMxX,loc.y);
-
- MoveToEx(CurrentDC,loc.x,0, NULL);
- LineTo (CurrentDC,loc.x,CurMxY);
-
- break;
-
- case 3 : radius = (int) sqrt((double)((loc.x-locp.x)*(loc.x-locp.x)+
- (loc.y-locp.y)*(loc.y-locp.y)));
- Pie(CurrentDC,locp.x-radius,locp.y-radius,
- locp.x+radius,locp.y+radius,
- locp.x-radius,locp.y-radius,
- locp.x-radius,locp.y-radius);
- break;
-
- case 4 : MoveToEx(CurrentDC,loc.x, loc.y, NULL);
- LineTo (CurrentDC,locp.x,locp.y);
- break;
-
- case 5 : Rectangle(CurrentDC,locp.x, locp.y, loc.x, loc.y);
- break;
- default:
- break;
- }
- }
-
-/*___________________________________________________________________*/
- HIGZCursorInit(hwnd,ctyp)
- HWND hwnd;
- int ctyp;
- {
- SaveDC(CurrentDC);
- /* Create Brush or Pen to draw HIGZ graphics cursor */
-
- SelectObject(CurrentDC,hdCursorPen);
- if (ctyp == 3 | ctyp == 5)
- SelectObject(CurrentDC, hdCursorBrush);
-
- /* Suspend current clipping */
-
- SelectClipRgn(CurrentDC, NULL);
-
-
- /* Set a new mix mode to XOR */
-
- SetROP2(CurrentDC,R2_NOT);
-
- /* Set Cursor on the screen */
- DrawHIGZCursor(ctyp);
- cHw->MouseInit = ctyp;
- }
-
-/*___________________________________________________________________*/
-RestoreHIGZ(int ctyp)
- {
- cHw->MouseInit = 0;
-/* Clean cursor off the screen */
- DrawHIGZCursor(ctyp);
- RestoreDC(CurrentDC,-1);
- }
-
-
-/*___________________________________________________________________*/
-/*
- * INTEGER FUNCTION IXREQST(X,Y,TEXT)
- * INTEGER X,Y : position where text is displayed
- * CHARACTER*(*) TEXT : text displayed (input), edited text (output)
- *
- * Request string:
- * text is displayed and can be edited with Emacs-like keybinding
- * return termination code (0 for ESC, 1 for RETURN)
- */
-int
- ixreqst( x, y, len_text, text
-#ifdef CERNLIB_QFMSOFT
- , lenn_text
-#endif
-)
-char *text;
-
-#ifdef CERNLIB_QFMSOFT
-int lenn_text;
-#endif
-
-int *len_text;
-int *x, *y;
-{
- static struct {int x, y, len_tex; char *text;
- int BreakKey; HANDLE semaphore;}
- HIGZText;
- HIGZText.x = *x;
- HIGZText.y = *y;
- HIGZText.len_tex = *len_text;
- HIGZText.text = text;
- HIGZText.BreakKey = -1;
- HIGZText.semaphore = CreateSemaphore(NULL, 0, 1, NULL);
-
- SendMessage(CurrentHIGZWindow,
- IX11_HIGZ_Input,MAKEWPARAM(IX_REQST,HIGZ_Input),&HIGZText);
-
- WaitForSingleObject(HIGZText.semaphore, INFINITE);
- CloseHandle(HIGZText.semaphore);
-
- return HIGZText.BreakKey;
-
-}
-
-/*___________________________________________________________________*/
- int CharWidth(ch)
- char ch;
- {int LenOfChar;
- GetCharWidth(CurrentDC, (UINT) ch, (UINT) ch, &LenOfChar);
- return LenOfChar;}
-
-/*___________________________________________________________________*/
- LRESULT APIENTRY
- Wnd_REQST(hwnd, uMsg, wParam, lParam)
- HWND hwnd;
- UINT uMsg;
- WPARAM wParam;
- LPARAM lParam;
- {
-#define ixg(x) (ix0+x)
-#define iyg(y) (iy0+y)
- /* Application message */
- static struct {int x, y, len_tex; char *text;
- int BreakKey; HANDLE semaphore;}
- *lpHIGZText;
-
- static char ch; // entered symbol
- static char *lpInstr; // Input line buffer
- static int nCur, // Current text cursor postion
- lStr, // Current length of the entered string
- pt, // Current symbol position
- BreakKey, // Code of the entered "End of Line" terminator
- nCharWidth, // Width of the current symbol
- LenLine, // Pixel length of the entered string
- ix0,iy0;
- static char *Instr; // temporary buffer
-
-
- static int insert;
- int i;
-
- switch (uMsg) {
- case WM_CHAR:
- switch(wParam) {
-
- case 0x0A: /* line feed */
- case 0x0D: /* carriage return */
- (lpHIGZText->BreakKey)++;
- case 0x1B: /* escape */
- (lpHIGZText->BreakKey)++;
-
- cHw->SetTextInput = FALSE;
- HideCaret(hwnd);
- DestroyCaret();
- if (lpHIGZText->len_tex > 0) {
- for (i=0;i<lStr;i++) lpInstr[i] = Instr[i];
- for (i=lStr; i<lpHIGZText->len_tex; i++) lpInstr[i]=' ';
- free(Instr);
- }
-
-
-/* End of text input from keyboard
- * and restore previous active window
- */
- SetActiveWindow(ConWindow);
- SetFocus(ConWindow);
-
- ReleaseSemaphore(lpHIGZText->semaphore,1L,NULL);
- break;
-
- case 0x09: /* Tab */
- case 0x08: /* backspace */
- break;
- default: /* all other letters */
- ch = (TCHAR) wParam;
- HideCaret(hwnd);
-
- if (nCur != lStr){/* Clear the old tail of the string */
- COLORREF CurTextCol;
- CurTextCol = SetTextColor(CurrentDC,GetBkColor(CurrentDC));
- TextOut(CurrentDC,ixg(ixText),iyg(iyText),
- &Instr[nCur],lStr-nCur);
- SetTextColor(CurrentDC,CurTextCol);
- }
- if (insert==1) {/* Shift string */
- for (i=lStr; i>nCur; i--) Instr[i] = Instr[i-1];
- /* Increasing of the acctual length */
- lStr++;
- Instr[lStr] = 0x0;
- }
- else if (nCur == lStr) lStr++;
- else // reduce length of string
- LenLine -= CharWidth(Instr[nCur]);
-
-/* Put enreted symbol in place */
- Instr[nCur] = ch;
-/* Out the new tail of the text */
- TextOut(CurrentDC,ixg(ixText),iyg(iyText),
- &Instr[nCur],lStr-nCur);
-
- LenLine += CharWidth(ch); // pixel length of entered string
- ixText += CharWidth(ch); // Reset Graphics position for next input
- nCur++;
- break;
- }
- SetCaretPos(ixg(ixText),iyg(iyText-(cHw->dwAscent) ));
- ShowCaret(hwnd);
- return 0;
- case WM_KEYDOWN:
- HideCaret(hwnd);
- switch(wParam) {
- case VK_LEFT:
- nCur--;
- ixText -= CharWidth(Instr[nCur]);
- break;
- case VK_RIGHT:
- ixText += CharWidth(Instr[nCur]);
- nCur++;
- break;
- case VK_HOME:
- ixText = 0;
- nCur = 0;
- break;
- case VK_END:
- ixText = LenLine;
- nCur = lStr;
- break;
- case VK_INSERT:
- insert = -insert;
- break;
- case VK_DELETE:
-/* Clear the old tail of the string */
- { COLORREF CurTextCol;
- CurTextCol = SetTextColor(CurrentDC,GetBkColor(CurrentDC));
- TextOut(CurrentDC,ixg(ixText),iyg(iyText), &Instr[nCur],lStr-nCur);
- SetTextColor(CurrentDC,CurTextCol);
- }
-/* Reduce current lenght of string */
- LenLine -= CharWidth(Instr[nCur]);
-
- for (i=nCur; i<lStr;i++)
- Instr[i] = Instr[i+1];
- lStr = max(lStr-1, nCur);
- if (lStr != nCur)
- TextOut(CurrentDC,ixg(ixText),iyg(iyText), &Instr[nCur],lStr-nCur);
- else
- Beep(1000L,100L);
- break;
-
- case VK_BACK:
- nCur--;
- if (nCur >= 0) {
-/* Clear the old tail of the string */
- ixText -= CharWidth(Instr[nCur]);
- { COLORREF CurTextCol;
- CurTextCol = SetTextColor(CurrentDC,GetBkColor(CurrentDC));
- TextOut(CurrentDC,ixg(ixText),iyg(iyText), &Instr[nCur],lStr-nCur);
- SetTextColor(CurrentDC,CurTextCol);
- }
-/* Reduce current lenght of string */
- LenLine -= CharWidth(Instr[nCur]);
-
- for (i=nCur; i<lStr;i++)
- Instr[i] = Instr[i+1];
- lStr = max(lStr-1, nCur);
- if (lStr != nCur)
- TextOut(CurrentDC,ixg(ixText),iyg(iyText), &Instr[nCur],lStr-nCur);
- } else {
- Beep(1000L,100L);
- nCur = 0;
- }
- break;
- default:
- return DefWindowProc(hwnd,uMsg, wParam, lParam);
- }
- SetCaretPos(ixg(ixText),iyg(iyText-(cHw->dwAscent)));
- ShowCaret(hwnd);
- return 0; // User procedure SHOULD return ZERO if it is process
- case IX11_HIGZ_Input:
- lpHIGZText = lParam;
- /* Write TEXT to the pointed position on the screen */
- ix0 = lpHIGZText->x;
- iy0 = lpHIGZText->y;
- ixText = 0;
- iyText = 0;
-/* Init of string input */
- lpInstr = lpHIGZText->text;
- nCur = 0;
- lStr = 0;
- insert = 1;
-
- if (lpHIGZText->len_tex >0 ) {
- Instr = malloc(lpHIGZText->len_tex);
- Instr[0] = 0x0;
- }
- LenLine = 0;
-
-
-/* Create and set Caret */
-
- CreateCaret(hwnd, (HBITMAP) 1, cHw->dwCharX, cHw->dwAscent);
- SetCaretPos(ixg(ixText),iyg(iyText-(cHw->dwAscent)));
- ShowCaret(hwnd);
-
- SetFocus(hwnd);
- ConWindow = SetActiveWindow(hwnd);
-
- cHw->SetTextInput = TRUE;
-
- break;
- default: break;
- }
- }
-
-
-/*___________________________________________________________________*/
-/* SUBROUTINE IGERR(ERRTEX,RNAME)
-*.===========>
-*.
-*. This prints on the screen the error message (ERRTEX) and
-*. the routine name (RNAME). This routine sets also IQUEST(1)
-*. to 1. If RNAME equal ' ' only a warning is printed and
-*. IQUEST(1) is sets to 0.
-*.
-*. _Input parameters:
-*.
-*. INTEGER ERRTEX : Error text .
-*. CHARACTER RNAME : Routine name .
-*.
-*.
-*/
-
- void _stdcall igerr(errtex,rname,lerr,lname)
- char *errtex, *rname;
- int lerr, lname;
- {
- struct {
- int iquest[100];
- } quest_;
-
-#define quest_1 quest_
-
- LPCTSTR lpszText; /* address of text in message box */
- LPCTSTR lpszTitle; /* address of title of message box */
- lpszText = malloc(lerr);
- strcpy(lpszText,string(errtex,lerr));
- if (lname <= 1 & rname[0] == ' ') {
- /* This is a warning message */
- lpszTitle = malloc(15);
- strcpy(lpszTitle,"*** Warning ***");
- MessageBox(NULL, lpszText, lpszTitle,
- MB_OK | MB_SETFOREGROUND | MB_ICONEXCLAMATION);
- quest_1.iquest[0] = 0;
- }
- else {
- /* This is an error message */
- lpszTitle = malloc(lname+18);
- strcpy(lpszTitle,"*** ERROR in ");
- strcat(lpszTitle,string(rname,lname));
- strcat(lpszTitle," ***");
- MessageBox(NULL, lpszText, lpszTitle,
- MB_OK | MB_SETFOREGROUND | MB_ICONHAND);
- quest_1.iquest[0] = 1;
- }
- free(lpszTitle);
- free(lpszText);
- }
-
-/*___________________________________________________________________*/
- wrtlst(wid, mess, lmess)
- HWND *wid;
- char *mess;
- int *lmess;
- {
- SendMessage(*wid,LB_ADDSTRING,0, (LPARAM) string(mess,*lmess));
- }
-
-/*___________________________________________________________________*/
- clrlst(wid)
- HWND *wid;
- {
- int n;
- if (n = SendMessage(*wid,LB_GETCOUNT,0,0) != LB_ERR)
- SendMessage(*wid,LB_DELETESTRING,(WPARAM) n, 0);
- }
-
- ixbord()
- {bord = ~bord;}
-
-/*__________________________________________________________________*/
- void ixldgif (x0, y0, len, file, lenfile )
- char *file;
- int lenfile;
- int *len;
- int *x0,*y0;
- { }
-
-/*__________________________________________________________________*/
- void ixdogif( len,
- file, lenfile )
- char *file;
- int lenfile;
- int *len;
- { }
-
diff --git a/src/graflib/higz/iwin32/ix_higz.def b/src/graflib/higz/iwin32/ix_higz.def
deleted file mode 100644
index da46e69..0000000
--- a/src/graflib/higz/iwin32/ix_higz.def
+++ /dev/null
@@ -1,61 +0,0 @@
-LIBRARY IX_HIGZ
-
-EXPORTS
-
- IGERR
- WRLST
- CLRLST
- IXBORD
- IXCLIP
- IXCLRWI
- IXCLSDS
- IXCLSWI
- IXFLARE
- IXGETGE
- IXGETPL
- IXGETHT
- IXLINE
- IXMARKE
- IXNOCLI
- IXOPNDS
- IXOPNWI
- IXREQLO
- IXREQST
- IXSELWI
- IXSETCO
- IXSETFC
- IXSETFS
- IXSETLC
- IXSETLN
- IXSETLS
- IXSETMC
- IXSETMS
- IXSETTA
- IXSETTC
- IXSETTF
- IXTEXT
- IXUPDWI
- IXBOX
- IXTXTL
- IXDRMDE
- IXSYNC
- IXSETHN
- IXOPNPX
- IXCLPX
- IXCPPX
- IXRMPX
- IXWIPX
- IXCLRPX
- IXS2BUF
- IXQ2BUF
- IXWRPX
- IXRSIZ
- IXSAVWI
- IXSETWI
- IXRSCWI
- IXMINIT
- IXCA
- IXLDGIF
- IXDOGIF
- IGXMES
- ixmotif
diff --git a/src/graflib/higz/iwin32/ix_higz.h b/src/graflib/higz/iwin32/ix_higz.h
deleted file mode 100755
index 9f8c29c..0000000
--- a/src/graflib/higz/iwin32/ix_higz.h
+++ /dev/null
@@ -1,78 +0,0 @@
-#define IX11_HIGZ_MSG WM_USER+10 /* ID of HIGZ messages */
- /* +10 because WM_USER is used */
- /* by WIN32 itself ! ! ! */
- enum HIGZ_Graphics_Msg {
- HIGZ_Control, HIGZ_Primitive, HIGZ_Text , HIGZ_Attribute,
- HIGZ_Marker , HIGZ_Input , HIGZ_Inquiry, HIGZ_Pixmap,
- HIGZ_Dummies
- };
-/* Emulation of X11 control HIGZ routines
-**
-** HIGZ_Control set
-*/
-
-enum L_HIGZ_Control
- {
- IX_OPNDS, // Open X11 display
- IX_OPNWI, // Open X11 window
- IX_SELWI, // Select the current X11 window
- IX_CLSWI, // Close an X11 window
- IX_CLSDS, // Close an X11 session
- IX_SETHN, // Set X11 host name
- IX_CLRWI, // Clear an X11 window
- IX_UPDWI, // Update an X11 window
- IX_RSCWI, // Resize an X11 window
- IX_CLIP , // Define the X11 clipping rectangle
- IX_NOCLI // Deactivate the X11 clipping rectangle
- };
-#define ExtHIGZWindow 0
-struct HIGZWindow {
- struct HIGZWindow *ptbw; // Previous Winodws in this list
- struct HIGZWindow *ptfw; // Next Windows in this list
- HWND hwnd; // Handle of this Windows
- HDC hdcWindow; // Device context of display
- RECT HIGZWindowSize; /* size of the client area of the */
- /* window in logical untis */
- int WinType; // Type of HIGZ window
- /* window variables for HIGZ text input fasility*/
- DWORD dwCharX, dwCharY, dwAscent;
-
- HDC hdcPixBuffer; // Device context of the bitmap buffer
- HBITMAP hbBuffer; // Bitmap handle for double buffering
- HDC hdcHistory; // History metafile DC
- HRGN HIGZClipRegion; /* != NULL clip is ON and */
- /* clip = (handle) RECT of the clip region */
- BOOL HIGZCursor,
- SystemCursorVisible,
- SetTextInput;
- int MouseInit; // Type of HIGZ mouse cursor or 0
- POINT loc, locp; // Positions of HIGZ graphics locator
- int button_press, button_up;
- BOOL isopening; /* HIGZ window is restoring its own position
- * from icon state
- */
- HCURSOR hHIGZCursor;
- } HIGZWindow;
-
-
-HWND CreateTextClass(struct CREATEHIGZWINDOW *);
-struct CREATEHIGZWINDOW { int x,y,w,h,lentit,flag; char *title;HANDLE semaphore;
- HWND hwnd;};
-#define HIGZCLASS "HIGZ"
-#define WHITE_HIGZ_COLOR HIGZColorIndex(0)
-
-/* ID of the current thread manageing main windows loop. */
-struct {DWORD ID_Thread;} IDStruct_;
-#define IDThread (IDStruct_.ID_Thread)
-char* string(char *, int);
-LRESULT APIENTRY HIGZ_Act(HWND, UINT, WPARAM, LPARAM);
-LRESULT APIENTRY Wnd_S2BUF(HWND, UINT, WPARAM, LPARAM);
-LRESULT APIENTRY Wnd_CPPX(HWND, UINT, WPARAM, LPARAM);
-LRESULT APIENTRY Wnd_WIPX(HWND, UINT, WPARAM, LPARAM);
-LRESULT APIENTRY Wnd_MARKE(HWND, UINT, WPARAM, LPARAM);
-LRESULT APIENTRY Wnd_FLARE(HWND, UINT, WPARAM, LPARAM);
-LRESULT APIENTRY Wnd_BOX (HWND, UINT, WPARAM, LPARAM);
-LRESULT APIENTRY Wnd_CA (HWND, UINT, WPARAM, LPARAM);
-LRESULT APIENTRY Wnd_REQLO(HWND, UINT, WPARAM, LPARAM);
-LRESULT APIENTRY Wnd_REQST(HWND, UINT, WPARAM, LPARAM);
-LPTHREAD_START_ROUTINE HIGZ_MsgLoop(HANDLE);
diff --git a/src/graflib/higz/iwin32/ix_win32.c b/src/graflib/higz/iwin32/ix_win32.c
deleted file mode 100644
index 3278c20..0000000
--- a/src/graflib/higz/iwin32/ix_win32.c
+++ /dev/null
@@ -1,3706 +0,0 @@
-#include <windows.h>
-#include <math.h>
-#include "ix_win32.h"
-
-#define ColorOffset 20
-#define HIGZColorIndex(ic) PALETTEINDEX(ic+ColorOffset)
-
-/* #include <f2c.h> */ // +SEQ, F2C.
-#define IX11_HIGZ_Input IX11_HIGZ_MSG+1
-enum ListDC { offWindowDC, offHistoryDC, offPixmapDC, offMetafileDC, offPixBuffer,
- Number_of_DC_Handle,
- offClipWindowDC,offClipHistoryDC,offClipPixmapDC,
- offClipMetafileDC,
- LastExtraMember};
-
- static struct HIGZWindow *cHw = NULL, // Current HIGZ Window
- *fHw = NULL, // First HIGZ Window
- *lHw = NULL, // Last HIGZ Window
- *lpHpixmap = NULL; // Current pixmap
- static int Number_of_HIGZ_Windows = 0; // Total numaber of the HIGZ
- // Windows
-
-
-/*___________________________________________________________________*/
-/* X11 output primitives
-**
-** HIGZ_Primitive
-*/
-
-enum L_HIGZ_Primitive
- {
- IX_LINE , // Draw a line through all points
- IX_MARKE, // Draw a marker ar each point
- IX_FLARE, // Fill area described by polygon
- IX_BOX , // Draw a box
- IX_CA // Draw a cell array
- };
-
-/* X11 text
-**
-** HIGZ_Text
-*/
-
-enum L_HIGZ_Text
- {
- IX_TEXT, // Draw a text string using the current font
- IX_TXTL, // Return the width and height of character string in the current font
- IW_SETCH // Set a height for the charatcter
- };
-
-
-/* X11 output attributes
-**
-** HIGZ_Attribute
-*/
-
-enum L_HIGZ_Attribute
- {
- IX_SETCO, // Set color intensities for given colour index
- IX_SETLN, // Set line width
- IX_SETLS, // Set line style
- IX_SETLC, // Set colour index for lines
- IX_DRMDE // Set drawing mode
- };
-
-/* X11 marker style
-**
-** HIGZ_Marker
-*/
-
-enum L_HIGZ_Marker
- {
- IX_SETMS, // Set market style
- IX_SETMC, // Set colour indx for markers
- IX_SETFS, // Set fill area style
- IX_SETFC, // Set colour index for fill area
-
- IX_SETTA, // Set text alignment
- IX_SETTF, // Set text font to specified name
- IX_SETTC, // Set colour index for text
- IX_SYNC , // X11 synchronization
- };
-
-
-/* X11 input functions
-**
-** HIGZ_Input
- */
-
-enum L_HIGZ_Input
- {
- IX_REQLO, // Request locator input.
- IX_REQST // Request a string input
- };
-
-
-/* X11 inquiry routines
-**
-** HIGZ_Inquiry
- */
-
-enum L_HIGZ_Inquiry
- {
- IX_GETGE, // Returns position and size of Window
- IX_GETWI, // Returns the X11 window identifier
- IX_GETPL, // Returns the maximal number of planes of the display
- IX_GETCOL // Returns the X11 colour representation
- };
-
-
-/* Pixmap manipulation
-**
-** HIGZ_Pixmap
- */
-
-enum L_HIGZ_Pixmap
- {
- IX_OPNPX, // Open a new pixmap
- IX_CLPX , // Close the current opened pixmap
- IX_CPPX , // Copy the pixmap
- IX_CLRPX, // Clear the pixmap
- IX_RMPX , // Remove the pixmap
- IX_WRPX , // Write the pixmap
- IX_WIPX // Copy the area in the current window
- };
-
-
-/* Dummies
-**
-** HIGZ_Dummies
- */
-
-enum L_HIGZ_Dummies
- {
- IX_S2BUF,
- IX_SDSWI
- };
-
-#define WndActHeader( arg ) LRESULT APIENTRY \
- Wnd_(arg) (hwnd, uMsg, wParam, lParam) \
- HWND hwnd; UINT uMsg; WPARAM wParam; LPARAM lParam;
-
-/*-- Author : V.Fine */
-/*
- * Fortran interface to Window/NT SDK routines for HIGZ
- */
-#include <stdio.h>
-#include <string.h>
-#include <stdlib.h>
-#include <ctype.h>
-#include <math.h>
-
-
-
-#ifdef CERNLIB_QX_SC.
-#define igerr igerr_
-#define wrtlst wrtlst_
-#define clrlst clrlst_
-#define ixbord ixbord_
-
-
-
-#define ixclip ixclip_
-#define ixclrwi ixclrwi_
-#define ixclsds ixclsds_
-#define ixclswi ixclswi_
-#define ixflare ixflare_
-#define ixgetge ixgetge_
-#define ixgetpl ixgetpl_
-#define ixgetht ixgetht_
-#define ixline ixline_
-#define ixmarke ixmarke_
-#define ixnocli ixnocli_
-#define ixopnds ixopnds_
-#define ixopnwi ixopnwi_
-#define ixreqlo ixreqlo_
-#define ixreqst ixreqst_
-#define ixselwi ixselwi_
-#define ixsetco ixsetco_
-#define ixsetfc ixsetfc_
-#define ixsetfs ixsetfs_
-#define ixsetlc ixsetlc_
-#define ixsetln ixsetln_
-#define ixsetls ixsetls_
-#define ixsetmc ixsetmc_
-#define ixsetms ixsetms_
-#define ixsetta ixsetta_
-#define ixsettc ixsettc_
-#define ixsettf ixsettf_
-#define ixtext ixtext_
-#define ixupdwi ixupdwi_
-#define ixbox ixbox_
-#define ixtxtl ixtxtl_
-#define ixdrmde ixdrmde_
-#define ixsync ixsync_
-#define ixsethn ixsethn_
-#define ixopnpx ixopnpx_
-#define ixclpx ixclpx_
-#define ixcppx ixcppx_
-#define ixrmpx ixrmpx_
-#define ixwipx ixwipx_
-#define ixclrpx ixclrpx_
-#define ixs2buf ixs2buf_
-#define ixq2buf ixq2buf_
-#define ixwrpx ixwrpx_
-#define ixrsiz ixrsiz_
-#define ixsavwi ixsavwi_
-#define ixsetwi ixsetwi_
-#define ixrscwi ixrscwi_
-#define ixminit ixminit_
-#define ixca ixca_
-#endif
-
-#ifdef CERNLIB_QXCAPT.
-#define igerr IGERR
-#define wrtlst WRLST
-#define clrlst CLRLST
-#define ixbord IXBORD
-
-
-
-#define ixclip type_of_call IXCLIP
-#define ixclrwi type_of_call IXCLRWI
-#define ixclsds type_of_call IXCLSDS
-#define ixclswi type_of_call IXCLSWI
-#define ixflare type_of_call IXFLARE
-#define ixgetge type_of_call IXGETGE
-#define ixgetpl type_of_call IXGETPL
-#define ixgetht type_of_call IXGETHT
-#define ixline type_of_call IXLINE
-#define ixmarke type_of_call IXMARKE
-#define ixnocli type_of_call IXNOCLI
-#define ixopnds type_of_call IXOPNDS
-#define ixopnwi type_of_call IXOPNWI
-#define ixreqlo type_of_call iXREQLO
-#define ixreqst type_of_call IXREQST
-#define ixselwi type_of_call IXSELWI
-#define ixsetco type_of_call IXSETCO
-#define ixsetfc type_of_call IXSETFC
-#define ixsetfs type_of_call IXSETFS
-#define ixsetlc type_of_call IXSETLC
-#define ixsetln type_of_call IXSETLN
-#define ixsetls type_of_call IXSETLS
-#define ixsetmc type_of_call IXSETMC
-#define ixsetms type_of_call IXSETMS
-#define ixsetta type_of_call IXSETTA
-#define ixsettc type_of_call IXSETTC
-#define ixsettf type_of_call IXSETTF
-#define ixtext type_of_call IXTEXT
-#define ixupdwi type_of_call IXUPDWI
-#define ixbox type_of_call IXBOX
-#define ixtxtl type_of_call IXTXTL
-#define ixdrmde type_of_call IXDRMDE
-#define ixsync type_of_call IXSYNC
-#define ixsethn type_of_call IXSETHN
-#define ixopnpx type_of_call IXOPNPX
-#define ixclpx type_of_call IXCLPX
-#define ixcppx type_of_call IXCPPX
-#define ixrmpx type_of_call IXRMPX
-#define ixwipx type_of_call IXWIPX
-#define ixclrpx type_of_call IXCLRPX
-#define ixs2buf type_of_call IXS2BUF
-#define ixq2buf type_of_call IXQ2BUF
-#define ixwrpx type_of_call IXWRPX
-#define ixrsiz type_of_call IXRSIZ
-#define ixsavwi type_of_call IXSAVWI
-#define ixsetwi type_of_call IXSETWI
-#define ixrscwi type_of_call IXRSCWI
-#define ixminit type_of_call IXMINIT
-#define ixca type_of_call IXCA
-#endif
-
-/* #define ixmotif ixmotif_ */
-/* +SELF. */
-
-#define forever while(1)
-#define LNULL 0L
-
-#define XPoint POINT /* Change Xpoint by X11 to POINT by Windows/NT */
-
-#define MAXWN 20 /* maximum number of windows */
-static struct {
- int open; /* 1 if the window is open, 0 if not */
- int motif; /* 1 if the window is a motif window */
- int double_buffer; /* 1 if the double buffer is on, 0 if not */
- int width; /* width of the window */
- int height; /* height of the window */
- int clip; /* 1 if the clipping is on */
- int xclip; /* x coordinate of the clipping rectangle */
- int yclip; /* y coordinate of the clipping rectangle */
- int wclip; /* width of the clipping rectangle */
- int hclip; /* height of the clipping rectangle */
-
- LOGPEN pen; /********* */
- LOGBRUSH gcfill;
- LOGFONT font;
- LOGPALETTE palette;
- BITMAP pixmap;
-
-} windows[MAXWN], /* windows : list of the opened windows */
- *cws, *tws, *sws; /* cws : pointer to the current window */
-
-#define MAXCOL 256
- static int maxcol;
-
- struct HIGZPEN {
- LOGPEN pen;
- LOGBRUSH brush;
- int lUserDash;
- int *UserDash;
- } pen = { BS_SOLID,0, 0, 1, // lopnStyle, lopnWidth, lopnColor
- BS_SOLID, 0, 0, // lbStyle, lbColor, lbHatch
- 0, NULL}; // n dashes, pointer to an array of dashes
- LOGBRUSH gcfill;
-
- LOGFONT HIGZFont = { 0, // lfHeight
- 0, // lfWidth
- 0, // lfEscapement
- 0, // lfOrientation (doesn't used by HIGZ)
- 400, // lfWeigh (Normal = 400, BOLD =800)
- FALSE, // lfItalic
- FALSE, // lfUnderline
- FALSE, // lfStrikeOut
- ANSI_CHARSET, // lfCharSet
- OUT_DEFAULT_PRECIS, // lfOutPrecision
- CLIP_DEFAULT_PRECIS,
- DEFAULT_QUALITY,
- FF_DONTCARE, // lfPitchAndFamily;
- };
- PALETTEENTRY HIGZcolors[MAXCOL];
- NPLOGPALETTE lpPalette; // = {0x300, MAXCOL, HIGZcolors};
- BOOLEAN bord = {FALSE};
-
-
-/* Global variable to plot HIGZ graphics cursor */
- static RECT rect;
- static HPEN CurPen;
- static HBRUSH CurBrush;
- static HRGN CurClipRgn;
-/* ==================================================== */
-
-/* Common HANDLES of the graphics attributes for all HIGZ windows */
-
-static HPALETTE hdCommonPalette = NULL;
-static HBRUSH hdCommonBrush = NULL;
-static HPEN hdCommonPen = NULL;
-static HFONT hdCommonFont = NULL;
-static HPEN hdCursorPen; // Pen to draw HIGZ locator
-static HBRUSH hdCursorBrush; // Brush to draw HIGZ locator 3 or 5
-static RECT CommonClipRectangle;
-static int dwCommonTextAlign = TA_LEFT | TA_BASELINE;
-static COLORREF dwCommonTextColor;
-static BOOL PixMapON = {FALSE};
-
- int ixText,iyText;
- static HWND ConWindow; // Handler of console window
-
-/* ==================================================== */
-
-
-/* =================== */
-static int ispix = 0; /* if ispix=1 a pixmap has been opened */
-
-static char hname[132]; /* host name */
-
-static int external_int = 0;
-
-static int do_raise = 0; /* if do_raise =1 cws is raised in ixupdwi */
-
-
-/* External variables for Windows/NT */ // V.E. Fine 21.07.93
-
-WNDCLASS *p_higz_display, higz_display;
-
-HWND CurrentHIGZWindow;
-HDC CurrentDC, MetaFileDC, HistoryDC;
-
-/* LOGPALLETE HIGZ_palette[MAXCOL];
- HPALETTE WindowPalette;
- */
-
-
-/*
- * colors[1] : foreground also used for b/w screen
- * colors[0] : background also used for b/w screen
- * colors[2..MAXCOL-1] : colors which can be set by IXSETCO
- */
-static int colored; /* Flag if color screen */
-
-static struct {
- int defined;
- unsigned long pixel;
- float red;
- float green;
- float blue;
-} colors[MAXCOL] = {0, 0, 1., 1., 1.};
-
-/*
- * Primitives Graphic Contexts global for all windows
- */
-
-/*
- * Input echo Graphic Context global for all windows
- */
-
-static int fill_hollow; /* Flag if fill style is hollow */
-static int current_fasi = 0; /* Current fill area style index */
-static int align_hori = -1; /* Align text left, center, right */
-static int align_vert = -1; /* Align text bottom, middle, top */
-
-
-static int current_font_number = 0; /* current font number in font[] */
-
-
-/*
- * data to create fill area interior style
- */
-static char p1_bits[] = {
- ~(0xaa), ~(0xaa), ~(0x55), ~(0x55), ~(0xaa), ~(0xaa), ~(0x55), ~(0x55), ~(0xaa), ~(0xaa), ~(0x55), ~(0x55),
- ~(0xaa), ~(0xaa), ~(0x55), ~(0x55), ~(0xaa), ~(0xaa), ~(0x55), ~(0x55), ~(0xaa), ~(0xaa), ~(0x55), ~(0x55),
- ~(0xaa), ~(0xaa), ~(0x55), ~(0x55), ~(0xaa), ~(0xaa), ~(0x55), ~(0x55)};
-static char p2_bits[] = {
- ~(0x44), ~(0x44), ~(0x11), ~(0x11), ~(0x44), ~(0x44), ~(0x11), ~(0x11), ~(0x44), ~(0x44), ~(0x11), ~(0x11),
- ~(0x44), ~(0x44), ~(0x11), ~(0x11), ~(0x44), ~(0x44), ~(0x11), ~(0x11), ~(0x44), ~(0x44), ~(0x11), ~(0x11),
- ~(0x44), ~(0x44), ~(0x11), ~(0x11), ~(0x44), ~(0x44), ~(0x11), ~(0x11)};
-static char p3_bits[] = {
- ~(0x00), ~(0x00), ~(0x44), ~(0x44), ~(0x00), ~(0x00), ~(0x11), ~(0x11), ~(0x00), ~(0x00), ~(0x44), ~(0x44),
- ~(0x00), ~(0x00), ~(0x11), ~(0x11), ~(0x00), ~(0x00), ~(0x44), ~(0x44), ~(0x00), ~(0x00), ~(0x11), ~(0x11),
- ~(0x00), ~(0x00), ~(0x44), ~(0x44), ~(0x00), ~(0x00), ~(0x11), ~(0x11)};
-static char p4_bits[] = {
- ~(0x80), ~(0x80), ~(0x40), ~(0x40), ~(0x20), ~(0x20), ~(0x10), ~(0x10), ~(0x08), ~(0x08), ~(0x04), ~(0x04),
- ~(0x02), ~(0x02), ~(0x01), ~(0x01), ~(0x80), ~(0x80), ~(0x40), ~(0x40), ~(0x20), ~(0x20), ~(0x10), ~(0x10),
- ~(0x08), ~(0x08), ~(0x04), ~(0x04), ~(0x02), ~(0x02), ~(0x01), ~(0x01)};
-static char p5_bits[] = {
- ~(0x20), ~(0x20), ~(0x40), ~(0x40), ~(0x80), ~(0x80), ~(0x01), ~(0x01), ~(0x02), ~(0x02), ~(0x04), ~(0x04),
- ~(0x08), ~(0x08), ~(0x10), ~(0x10), ~(0x20), ~(0x20), ~(0x40), ~(0x40), ~(0x80), ~(0x80), ~(0x01), ~(0x01),
- ~(0x02), ~(0x02), ~(0x04), ~(0x04), ~(0x08), ~(0x08), ~(0x10), ~(0x10)};
-static char p6_bits[] = {
- ~(0x44), ~(0x44), ~(0x44), ~(0x44), ~(0x44), ~(0x44), ~(0x44), ~(0x44), ~(0x44), ~(0x44), ~(0x44), ~(0x44),
- ~(0x44), ~(0x44), ~(0x44), ~(0x44), ~(0x44), ~(0x44), ~(0x44), ~(0x44), ~(0x44), ~(0x44), ~(0x44), ~(0x44),
- ~(0x44), ~(0x44), ~(0x44), ~(0x44), ~(0x44), ~(0x44), ~(0x44), ~(0x44)};
-static char p7_bits[] = {
- ~(0x00), ~(0x00), ~(0x00), ~(0x00), ~(0x00), ~(0x00), ~(0xff), ~(0xff), ~(0x00), ~(0x00), ~(0x00), ~(0x00),
- ~(0x00), ~(0x00), ~(0xff), ~(0xff), ~(0x00), ~(0x00), ~(0x00), ~(0x00), ~(0x00), ~(0x00), ~(0xff), ~(0xff),
- ~(0x00), ~(0x00), ~(0x00), ~(0x00), ~(0x00), ~(0x00), ~(0xff), ~(0xff)};
-static char p8_bits[] = {
- ~(0x11), ~(0x11), ~(0xb8), ~(0xb8), ~(0x7c), ~(0x7c), ~(0x3a), ~(0x3a), ~(0x11), ~(0x11), ~(0xa3), ~(0xa3),
- ~(0xc7), ~(0xc7), ~(0x8b), ~(0x8b), ~(0x11), ~(0x11), ~(0xb8), ~(0xb8), ~(0x7c), ~(0x7c), ~(0x3a), ~(0x3a),
- ~(0x11), ~(0x11), ~(0xa3), ~(0xa3), ~(0xc7), ~(0xc7), ~(0x8b), ~(0x8b)};
-static char p9_bits[] = {
- ~(0x10), ~(0x10), ~(0x10), ~(0x10), ~(0x28), ~(0x28), ~(0xc7), ~(0xc7), ~(0x01), ~(0x01), ~(0x01), ~(0x01),
- ~(0x82), ~(0x82), ~(0x7c), ~(0x7c), ~(0x10), ~(0x10), ~(0x10), ~(0x10), ~(0x28), ~(0x28), ~(0xc7), ~(0xc7),
- ~(0x01), ~(0x01), ~(0x01), ~(0x01), ~(0x82), ~(0x82), ~(0x7c), ~(0x7c)};
-
-BITMAP FillBitMap = { 0, // Specifies the bitmap type. This member must be zero
- 16, // Specifies the width, in pixel, of the bitmap
- 16, // Specifies the height, in pixel, of the bitmap
- 2, // Specifies the number of bytes in each scan line.
- 1, // Specifies the count of color planes.
- 1, // Specifies the number of bits required to ind. th color
- &p2_bits // points to the location of the bit values for the bitmap
- };
-
-#define MAXMK 100
-static struct MARKER {
- int cindex;
- int type;
- int n;
- XPoint xy[MAXMK];
-} marker; /* point list to draw marker */
-
-
-/*___________________________________________________________________*/
-/*
- * Set input on or off
- */
-void
- setinput(inp)
-int inp;
-{
-
-}
-
-
-/*___________________________________________________________________*/
-/*
- * set the foreground color in GC
- */
-void
- setcolor( gc, ci )
-int gc;
-int ci;
-{
- if( colored && ( ci < 0 || ci >= MAXCOL || !colors[ci].defined ) )
- {
- ci = 0;
- }
- else if (!colored && ci < 0 )
- {
- ci = 0;
- }
- else if (!colored && ci > 0 )
- {
- ci = 1;
- }
-
-
- /* make sure that foreground and background are different */
-}
-
-
-/*___________________________________________________________________*/
-/*
- * return null terminated and blank trimmed string
- */
-char*
- string( s, l )
-char *s;
-int l;
-{
- static char str[256];
- int i;
-
- if( l >= sizeof( str ) )
- l = sizeof( str ) - 1;
-
- for( i = 0; i < l; i++ )
- str[i] = s[i];
- while( l > 0 && str[l-1] == ' ' )
- l--;
-
- str[l] = '\0';
- return( str );
-}
-
-
-
-
-/*___________________________________________________________________*/
-/*
- * Allows to set the DISPLAY and the WINDOW address
- * from outside HIGZ (ie a MOTIF program).
- */
-void
- ixsdswi( dsp , win )
- int *dsp;
- int win;
-{
-
-}
-
-/*___________________________________________________________________*/
-/*
- * Allows KUIP to give to HIGZ the adress of three routines:
- * 1) motif_open : to open a KUIP motif window
- * 2) motif_init : to initalize a KUIP motif window (add the callbacks)
- * 3) motif_close : to close a KUIP motif window
- */
-void
- ixmotif( dsp , open, init, close)
- int *dsp;
- int (*open)();
- void (*init)();
- void (*close)();
-{
-}
-
-
-/*___________________________________________________________________*/
-/*
- * SUBROUTINE IXMINIT(WID)
- * INTEGER WID : Window ID
- *
- * Initialize the Motif windows (add the callbacks)
- */
-void
- ixminit(wid)
- int *wid;
-{
-}
-
-/*___________________________________________________________________*/
- LRESULT APIENTRY
- HIGZDrawing(wParam,lParam)
-/* Dispatch a drawing operation either to real window or to pixmap */
-WPARAM wParam;
-LPARAM lParam;
- {
- if (PixMapON){
- DWORD rvalue;
- HGDIOBJ hbr,hpn;
-
- cHw = lpHpixmap;
- CurrentDC = lpHpixmap->hdcWindow;
- hbr = SelectObject(CurrentDC,hdCommonBrush);
- hpn = SelectObject(CurrentDC,hdCommonPen);
-
- rvalue = (int) HIGZ_Act(NULL,IX11_HIGZ_MSG,wParam, lParam);
-/* Restore all attributes */
- SelectObject(CurrentDC,hpn);
- SelectObject(CurrentDC,hbr);
- return rvalue;
- }
- else return SendMessage(CurrentHIGZWindow,
- IX11_HIGZ_MSG,wParam,lParam);
-}
-
-/*___________________________________________________________________*/
-/*
- * SUBROUTINE IXSETHN(LENHST,HOST)
- * INTEGER LENHST : host name length
- * CHARACTER*(*) HOST : host name
- *
- * Set host name (fill global variable hname)
- */
-void
- ixsethn( lenhst, host )
-char *host;
-int *lenhst;
-{
- strcpy (hname,string( host, *lenhst ));
-}
-
-
-/*___________________________________________________________________*/
- HBITMAP CreateHIGZBuffer(hwnd)
- HWND hwnd;
- {
- HBITMAP hdBuffer,oldbit,hdNewBuffer;
- HDC hdPixmapDC,hdWindowDC,oldbitDC,hdNewDC;
- SIZE WindowSize,BufferSize;
-
- hdPixmapDC = cHw->hdcPixBuffer;
- hdWindowDC = cHw->hdcWindow;
- hdBuffer = cHw->hbBuffer;
-
-/* Create New Memory Device context */
- hdNewDC = CreateCompatibleDC(NULL);
- SetMapMode (hdNewDC,MM_ISOTROPIC);
- SetBkMode (hdNewDC,TRANSPARENT);
-/* Set HIGZ pallete */
- DeleteObject(SelectPalette(hdNewDC,hdCommonPalette,TRUE));
-/* Create a new BITMAP for double buffering and coordinate transformation */
- GetWindowExtEx(hdWindowDC,&WindowSize);
- GetViewportExtEx(hdWindowDC,&BufferSize);
- hdNewBuffer = CreateCompatibleBitmap(hdWindowDC,BufferSize.cx,
- BufferSize.cy);
- SetWindowExtEx(hdNewDC,WindowSize.cx,WindowSize.cy,NULL);
- SetViewportExtEx(hdNewDC,BufferSize.cx,BufferSize.cy,NULL);
-/* Set new bitmap */
- DeleteObject(SelectObject(hdNewDC,hdNewBuffer));
-
- if (hdPixmapDC) { /* Copy old bitmap to new one */
- BitBlt(hdNewDC,0,0,WindowSize.cx,WindowSize.cy,
- hdPixmapDC, 0,0,SRCCOPY);
-/* Delete previous buffer */
- DeleteObject(SelectObject(hdPixmapDC,hdNewBuffer));
- DeleteDC(hdPixmapDC);
- }
- else { /* Clear new bitmap */
- rect.left = 0;
- rect.right = WindowSize.cx;
- rect.top = 0;
- rect.bottom = WindowSize.cy;
- FillRect(hdNewDC,&rect, CurBrush = CreateSolidBrush(WHITE_HIGZ_COLOR));
- DeleteObject(CurBrush);
- }
-
-
-/* Set window variable */
-
- cHw->hdcPixBuffer=hdNewDC;
- cHw->hbBuffer =hdNewBuffer;
- return cHw->hbBuffer;
- }
-
-
-/*___________________________________________________________________*/
- HBITMAP FlushHIGZBuffer(hwnd)
- HWND hwnd;
- {
- HBITMAP hdBuffer;
- HDC hdPixmapDC,hdWindowDC;
- SIZE WindowSize,BufferSize;
-
- hdPixmapDC = cHw->hdcPixBuffer;
- hdWindowDC = cHw->hdcWindow;
- hdBuffer = cHw->hbBuffer;
-
- if (hdPixmapDC) {
- if (hdBuffer) {
- GetWindowExtEx(hdWindowDC,&WindowSize);
-
-/* Set an application palette */
- SetSystemPaletteUse(hdWindowDC,SYSPAL_NOSTATIC);
- RealizePalette(hdWindowDC);
-
-/* Hide HIGZCursor */
- BitBlt(hdWindowDC,0L,0L,WindowSize.cx,WindowSize.cy,
- hdPixmapDC,0L,0L,SRCCOPY);
-/* Restore HIGZCursor */
-/* Compare size of Window and its Buffer */
- if (WindowSize.cx != BufferSize.cx)
-/* One needs change a scale */
- hdBuffer = CreateHIGZBuffer(hwnd);
- }
- }
- return hdBuffer;
- }
-
-/*___________________________________________________________________*/
-LRESULT APIENTRY WndHIGZ(hwnd, uMsg, wParam, lParam)
-HWND hwnd;
-UINT uMsg;
-WPARAM wParam;
-LPARAM lParam;
-{
- PAINTSTRUCT ps;
-
- cHw = (struct HIGZWindow *)GetWindowLong(hwnd,ExtHIGZWindow);
- if (cHw) CurrentDC = cHw->hdcWindow;
-
- // HistoryDC = (HDC) GetWindowLong(hwnd,4*offHistoryDC);
- switch (uMsg) {
- case WM_LBUTTONDOWN:
- case WM_MBUTTONDOWN:
- case WM_RBUTTONDOWN:
- if (!cHw->MouseInit) break;
- cHw->MouseInit = 0;
- Wnd_REQLO(hwnd,uMsg,wParam,lParam);
- return 0;
- case WM_MOUSEMOVE:
- SetCursor(cHw->hHIGZCursor);
- case WM_RBUTTONUP:
- case WM_MBUTTONUP:
- case WM_LBUTTONUP:
- if (!cHw->MouseInit) break;
- Wnd_REQLO(hwnd,uMsg,wParam,lParam);
- return 0;
- case WM_CREATE:
- { int iLoop;
- TEXTMETRIC *tm;
- RECT RectClient;
- HPALETTE hpallete;
- SIZE WindowSize;
- HMENU hmenu;
-
-/* Yin cursor AND bitmask */
-
-BYTE ANDmaskCursor[] =
- {0xff, 0xfc, 0x7f, 0xff, /* line 1 */
- 0xff, 0xfc, 0x7f, 0xff, /* line 2 */
- 0xff, 0xfc, 0x7f, 0xff, /* line 3 */
- 0xff, 0xfc, 0x7f, 0xff, /* line 4 */
-
- 0xff, 0xfc, 0x7f, 0xff, /* line 5 */
-
- 0xff, 0xfc, 0x7f, 0xff, /* line 6 */
- 0xff, 0xfc, 0x7f, 0xff, /* line 7 */
- 0xff, 0xfc, 0x7f, 0xff, /* line 8 */
-
- 0xff, 0xfc, 0x7f, 0xff, /* line 9 */
- 0xff, 0xfc, 0x7f, 0xff, /* line 10 */
- 0xff, 0xfc, 0x7f, 0xff, /* line 11 */
- 0xff, 0xfc, 0x7f, 0xff, /* line 12 */
-
- 0xff, 0xfc, 0x7f, 0xff, /* line 13 */
- 0xff, 0xfc, 0x7f, 0xff, /* line 14 */
-
- 0x00, 0x00, 0x00, 0x01, /* line 15 */
- 0x00, 0x00, 0x00, 0x01, /* line 16 */
- 0x00, 0x00, 0x00, 0x01, /* line 17 */
-
- 0xff, 0xfc, 0x7f, 0xff, /* line 18 */
- 0xff, 0xfc, 0x7f, 0xff, /* line 19 */
- 0xff, 0xfc, 0x7f, 0xff, /* line 20 */
-
- 0xff, 0xfc, 0x7f, 0xff, /* line 21 */
- 0xff, 0xfc, 0x7f, 0xff, /* line 22 */
-
- 0xff, 0xfc, 0x7f, 0xff, /* line 23 */
- 0xff, 0xfc, 0x7f, 0xff, /* line 24 */
-
- 0xff, 0xfc, 0x7f, 0xff, /* line 25 */
- 0xff, 0xfc, 0x7f, 0xff, /* line 26 */
- 0xff, 0xfc, 0x7f, 0xff, /* line 27 */
- 0xff, 0xfc, 0x7f, 0xff, /* line 28 */
-
- 0xff, 0xfc, 0x7f, 0xff, /* line 29 */
- 0xff, 0xfc, 0x7f, 0xff, /* line 30 */
- 0xff, 0xfc, 0x7f, 0xff, /* line 31 */
-
- 0xff, 0xff, 0xff, 0xff}; /* line 32 */
-
-/* Yin cursor XOR bitmask */
-
-BYTE XORmaskCursor[] =
- {0x00, 0x02, 0x80, 0x00, /* line 1 */
- 0x00, 0x02, 0x80, 0x00, /* line 2 */
- 0x00, 0x02, 0x80, 0x00, /* line 3 */
- 0x00, 0x02, 0x80, 0x00, /* line 4 */
-
- 0x00, 0x02, 0x80, 0x00, /* line 5 */
-
- 0x00, 0x02, 0x80, 0x00, /* line 6 */
- 0x00, 0x02, 0x80, 0x00, /* line 7 */
- 0x00, 0x02, 0x80, 0x00, /* line 8 */
-
- 0x00, 0x02, 0x80, 0x00, /* line 9 */
- 0x00, 0x02, 0x80, 0x00, /* line 10 */
- 0x00, 0x02, 0x80, 0x00, /* line 11 */
- 0x00, 0x02, 0x80, 0x00, /* line 12 */
-
- 0x00, 0x02, 0x80, 0x00, /* line 13 */
- 0x00, 0x02, 0x80, 0x00, /* line 14 */
-
- 0xFF, 0xFE, 0xFF, 0xFE, /* line 15 white border */
- 0x00, 0x00, 0x00, 0x00, /* line 16 black cross */
- 0xFF, 0xFE, 0xFF, 0xFE, /* line 17 white border */
-
- 0x00, 0x02, 0x80, 0x00, /* line 18 */
- 0x00, 0x02, 0x80, 0x00, /* line 19 */
- 0x00, 0x02, 0x80, 0x00, /* line 20 */
-
- 0x00, 0x02, 0x80, 0x00, /* line 21 */
- 0x00, 0x02, 0x80, 0x00, /* line 22 */
-
- 0x00, 0x02, 0x80, 0x00, /* line 23 */
- 0x00, 0x02, 0x80, 0x00, /* line 24 */
-
- 0x00, 0x02, 0x80, 0x00, /* line 25 */
- 0x00, 0x02, 0x80, 0x00, /* line 26 */
- 0x00, 0x02, 0x80, 0x00, /* line 27 */
- 0x00, 0x02, 0x80, 0x00, /* line 28 */
-
- 0x00, 0x02, 0x80, 0x00, /* line 29 */
- 0x00, 0x02, 0x80, 0x00, /* line 30 */
- 0x00, 0x02, 0x80, 0x00, /* line 31 */
-
- 0x00, 0x00, 0x00, 0x00}; /* line 32 */
-
-/* Create a custom cursor at run time. */
-
-HCURSOR hCursor = CreateCursor(
- (HINSTANCE)GetWindowLong(hwnd,GWL_HINSTANCE), /* app instance */
- 15, /* horiz pos of hot spot */
- 15, /* vert pos of hot spot */
-
- 32, /* cursor width */
- 32, /* cursor height */
- ANDmaskCursor, /* AND bitmask */
- XORmaskCursor); /* XOR bitmask */
-
-/*
- *
- * AND XOR Display
- *
- * 0 0 Black
- * 0 1 White
- * 1 0 Screen
- * 1 1 Reverse screen
- *
- */
-
-
-/* Disable the Close postion in the System Menu */
- hmenu = GetSystemMenu(hwnd,FALSE);
- EnableMenuItem(hmenu,6 , MF_GRAYED | MF_BYPOSITION);
-
-/* Create Extended data block */
- cHw = malloc(sizeof(HIGZWindow));
- /* Insert in dadata chain */
- if (fHw == NULL) {
- fHw = cHw;
- cHw->ptbw = NULL;
- }
- else {
- lHw->ptfw = cHw;
- cHw->ptbw = lHw;
- }
-
-/* Initial fill the data structure in */
- cHw->WinType = 0;
- cHw->ptfw = NULL;
- cHw->hwnd = hwnd;
- cHw->hdcWindow = GetDC(hwnd);
- cHw->hdcPixBuffer = (HDC) NULL;
- cHw->HIGZClipRegion = (HRGN)NULL;
- cHw->HIGZCursor = FALSE;
- cHw->SystemCursorVisible = TRUE;
- cHw->MouseInit = 0;
- cHw->SetTextInput = FALSE;
- cHw->loc.x = 0; cHw->loc.y=0; cHw->locp.x=0; cHw->locp.y=0;
- cHw->isopening = FALSE;
- cHw->hHIGZCursor = hCursor;
-
- SetWindowLong(hwnd,ExtHIGZWindow,(LONG)cHw);
-
- lHw = cHw;
- Number_of_HIGZ_Windows++;
-
- CurrentDC = cHw->hdcWindow;
-
- /* Create caret to character input */
-
- tm = malloc(sizeof(TEXTMETRIC));
- GetTextMetrics(CurrentDC,tm);
- cHw->dwCharX = tm->tmAveCharWidth;
- cHw->dwCharY = tm->tmHeight;
- cHw->dwAscent= tm->tmAscent;
- free(tm);
-
- SetMapMode (CurrentDC,MM_ISOTROPIC);
- RectClient.left = 0;
- RectClient.top = 0;
- RectClient.right = 1023;
- RectClient.bottom = 1023;
-
- /* Create HistoryDC (memory MetaFile) DC to perform PAINT operation */
-
-// HistoryDC = CreateEnhMetaFile(CurrentDC,"META.emf",&RectClient,NULL);
- HistoryDC = 0;
- if (HistoryDC) cHw->hdcHistory =HistoryDC;
-
- SetWindowExtEx(CurrentDC,
- RectClient.right+1,
- RectClient.bottom+1,
- NULL);
- SetBkMode(CurrentDC,TRANSPARENT);
- SetTextAlign(CurrentDC,
- TA_BASELINE | TA_LEFT | TA_NOUPDATECP);
- if (HistoryDC)
- {
- SetMapMode (HistoryDC,MM_ISOTROPIC);
- /* SetWindowExtEx(HistoryDC,
- RectClient.right+1,
- RectClient.bottom+1,
- NULL);
- */ SetBkMode(HistoryDC,TRANSPARENT);
- SetTextAlign(CurrentDC,
- TA_BASELINE | TA_LEFT | TA_NOUPDATECP);
- }
- GetClientRect(hwnd,&RectClient);
- SetViewportExtEx (CurrentDC,
- RectClient.right,
- RectClient.bottom,
- NULL);
- GetClientRect(hwnd,&(cHw->HIGZWindowSize));
- DPtoLP(CurrentDC,(POINT*) (&(cHw->HIGZWindowSize)),2);
-
- if (hdCommonPalette == NULL) {
- /* Allocate enough memory for a logical palette with
- * PALETTESIZE entries and set the size and version fields
- * of the logical palette structure.
- */
- maxcol = GetDeviceCaps(CurrentDC,SIZEPALETTE);
- lpPalette = (NPLOGPALETTE) malloc((sizeof (LOGPALETTE) +
- (sizeof (PALETTEENTRY) * (maxcol))));
-
- if(!lpPalette){
- MessageBox(hwnd, "<WM_CREATE> Not enough memory for palette.", NULL, MB_OK | MB_ICONHAND);
- PostQuitMessage (0) ;
- break;
- }
-
- lpPalette->palVersion = 0x300;
- lpPalette->palNumEntries = maxcol;
-
- /* fill in intensities for all palette entry colors */
- GetSystemPaletteEntries(CurrentDC,0,20, lpPalette->palPalEntry);
-
- /* create a logical color palette according the information
- * in the LOGPALETTE structure.
- */
- hdCommonPalette = CreatePalette ((LPLOGPALETTE) lpPalette);
- }
-
- DeleteObject(SelectPalette(CurrentDC,hdCommonPalette,TRUE));
- if (HistoryDC) DeleteObject(SelectPalette(HistoryDC,hpallete,TRUE));
-
-
- return 0;
-
- }
- case WM_PAINT:
- if (BeginPaint(hwnd,&ps)) {
- HDC hdc;
- ENHMETAHEADER mfHeader;
- HENHMETAFILE hmf,hmfOld;
- HRGN TempClip;
- RECT rect;
-
-/* Close History Metafile and create a new one and play old */
-// hdc=(HDC)GetWindowLong(hwnd,4*offHistoryDC);
-
- SetSystemPaletteUse(CurrentDC,SYSPAL_NOSTATIC);
- RealizePalette(CurrentDC);
-/* Hide HIGZ mouse locator and text caret */
- if (!cHw->isopening)
- if (cHw->MouseInit) DrawHIGZCursor(cHw->MouseInit);
- else cHw->isopening = FALSE;
- if (cHw->SetTextInput) HideCaret(hwnd);
- FlushHIGZBuffer(hwnd);
-/* Restore HIGZ mouse locator and text caret */
- if (cHw->SetTextInput) ShowCaret(hwnd);
- if (cHw->MouseInit) DrawHIGZCursor(cHw->MouseInit);
-
- hdc = HistoryDC;
- if (hdc) {
-/* Get Old metafile */
- hmf = CloseEnhMetaFile(hdc);
- printf("PAINT ==> hmf is %x with error code %d \n", hmf, GetLastError());
-
-/* Create new metafile */
- GetEnhMetaFileHeader(hmf,sizeof(ENHMETAHEADER),&mfHeader);
- printf("==> PAINT: Rectangle retrivied by GetEnh %d %d %d %d Error code is %d \n",
- mfHeader.rclFrame.top,mfHeader.rclFrame.right,
- mfHeader.rclFrame.left,mfHeader.rclFrame.bottom, GetLastError());
-
- HistoryDC = CreateEnhMetaFile(ps.hdc,NULL,&(mfHeader.rclFrame),NULL);
- printf(" PAINT, CreateEnh HistoryDC = %x \n", HistoryDC);
-
- cHw->hdcHistory = HistoryDC;
-/* Play Old metafile in new one and ti window */
- GetClientRect(hwnd,&rect);
- DPtoLP(ps.hdc,&rect,2);
- printf("New rectangle will be %d %d %d %d \n",rect.top, rect.left,rect.bottom,rect.right);
-
-// PlayEnhMetaFile(HistoryDC,hmf,&rect);
-
-/* Set clipping temporary for PAINT arear */
- // TempClip = SelectClipRgn(ps.hdc,
-// CreateRectRgnIndirect(&ps.rcPaint));
-
- SetSystemPaletteUse(CurrentDC,SYSPAL_NOSTATIC);
- RealizePalette(CurrentDC);
- PlayEnhMetaFile(ps.hdc,hmf,&rect);
-
-/* Restore clip region */
-// SelectClipRgn(ps.hdc,TempClip);
-
-/* Delete Old metafile */
- DeleteEnhMetaFile(hmf);
- }
-
- EndPaint(hwnd, &ps);
- }
-
- return DefWindowProc(hwnd,uMsg, wParam, lParam);
- case WM_ERASEBKGND:
- {
- HRGN TempClip;
-/* Cancel clipping temporary */
- if (cHw->HIGZClipRegion)
- TempClip = SelectClipRgn((HDC)wParam,NULL);
-/* Hide HIGZ mouse locator */
- if (!cHw->isopening)
- if (cHw->MouseInit) DrawHIGZCursor(cHw->MouseInit);
- else cHw->isopening = FALSE;
- GetClientRect(hwnd,&rect);
- DPtoLP(CurrentDC,&rect,2);
- FillRect(CurrentDC,&rect, CurBrush = CreateSolidBrush(WHITE_HIGZ_COLOR));
- DeleteObject(CurBrush);
-// DefWindowProc(hwnd,uMsg, wParam, lParam);
-/* Restore HIGZ mouse locator */
- if (cHw->MouseInit) DrawHIGZCursor(cHw->MouseInit);
- if (cHw->HIGZClipRegion)
- TempClip = SelectClipRgn((HDC)wParam,TempClip);
- return TRUE;
-// return FALSE // Window will remain marked for erasing
- }
- case WM_SIZE:
-
-/* WM_SIZE
- * fwSizeType = wParam; - resizing flag
- * nWidth = LOWORD(lParam); - width of client area
- *nHeight = HIWORD(lParam); - height of client area
- */
- SetViewportExtEx(CurrentDC, LOWORD(lParam), HIWORD(lParam), NULL);
- cHw->HIGZWindowSize.right = LOWORD(lParam);
- cHw->HIGZWindowSize.bottom = HIWORD(lParam);
- DPtoLP(CurrentDC,(POINT*) (&(cHw->HIGZWindowSize)),2);
- return 0;
- /* return DefWindowProc(hwnd,uMsg, wParam, lParam); */
- case WM_SETFOCUS:
- if (!cHw->SetTextInput) break;
- CreateCaret(hwnd, (HBITMAP) 1, cHw->dwCharX, cHw->dwAscent);
- SetCaretPos(ixText, iyText);
- ShowCaret(hwnd);
- return 0;
- case WM_KILLFOCUS:
-
- /*
- * Hide and destroy the caret when the window loses
- * keyboard focus
- */
-
- if (!cHw->SetTextInput) break;
- HideCaret(hwnd);
- DestroyCaret();
- return 0;
- case WM_CHAR:
- if (cHw->SetTextInput) return Wnd_REQST(hwnd, uMsg, wParam, lParam);
- break;
- case WM_KEYDOWN:
- if (cHw->MouseInit) Wnd_REQLO(hwnd, uMsg, wParam, lParam);
- else if (cHw->SetTextInput) Wnd_REQST(hwnd, uMsg, wParam, lParam);
- break;
- case WM_QUERYOPEN:
- cHw->isopening = TRUE;
- break;
- case WM_DESTROY:
- DeleteDC(CurrentDC);
- DestroyCursor(cHw->hHIGZCursor); /* 3.06.94 */
- if (HistoryDC) CloseEnhMetaFile(HistoryDC);
- break;
-// return 0;
-
- case IX11_HIGZ_MSG:
- {
- DWORD rvalue;
- HGDIOBJ hbr,hpn;
- HDC hdc;
-/* Set double buffering DC */
- if (cHw->hdcPixBuffer)
- CurrentDC = cHw->hdcPixBuffer;
- SetSystemPaletteUse(CurrentDC,SYSPAL_NOSTATIC);
- RealizePalette(CurrentDC);
- hbr = SelectObject(CurrentDC,hdCommonBrush);
- hpn = SelectObject(CurrentDC,hdCommonPen);
-
- rvalue = (DWORD)HIGZ_Act(hwnd,uMsg, wParam, lParam);
-/* Restore all attributes */
- SelectObject(CurrentDC,hpn);
- SelectObject(CurrentDC,hbr);
- return rvalue;
- }
- case IX11_HIGZ_Input:
- {
- switch (LOWORD(wParam)) {
- case IX_REQLO:
- Wnd_REQLO(hwnd,uMsg, wParam, lParam);
- break;
- case IX_REQST: // Request a string input
- Wnd_REQST(hwnd, uMsg, wParam, lParam);
- break;
- default:
- break;
- }
- }
- default:
- break;
- }
- return DefWindowProc(hwnd,uMsg, wParam, lParam);
-}
-
-/*___________________________________________________________________*/
-LPTHREAD_START_ROUTINE HIGZ_MsgLoop(ThrSem)
- HANDLE ThrSem;
- {
- MSG msg;
- HWND hwndHIGZ;
- int value;
- struct CREATEHIGZWINDOW *WinThr;
-
- ReleaseSemaphore(ThrSem, 1, NULL);
- while(GetMessage(&msg,NULL,0,0))
- {
- if (msg.hwnd == NULL & msg.message == IX11_HIGZ_MSG) {
-
- switch(HIWORD(msg.wParam)) {
- case HIGZ_Control:
- switch (LOWORD(msg.wParam)) {
- case IX_OPNWI:
-/* Create new window */
- WinThr = msg.lParam;
- if ( WinThr->flag != 2)
- hwndHIGZ = CreateWindow(
- HIGZCLASS, /*extended window style */
- string(WinThr->title,WinThr->lentit), /*address of window name */
- WS_OVERLAPPEDWINDOW | WS_VISIBLE, /*window style */
- CW_USEDEFAULT, CW_USEDEFAULT, // *x, *y,
- WinThr->w, WinThr->h, // *w, *h,
- NULL, /*handle of parent of owner window */
- NULL, /*handle of menu, or child-window identifier */
- higz_display.hInstance, /*handle of application instance */
- NULL); /*address of window-creation data */
- else {
- hwndHIGZ = CreateTextClass(WinThr);
- }
-
- WinThr->hwnd = hwndHIGZ;
-
- ReleaseSemaphore(WinThr->semaphore, 1, NULL);
- break; /* IX_OPNWI */
- default:
- break;
- } /* End of HIGZ_Control */
- case HIGZ_Attribute:
- switch (LOWORD(msg.wParam))
- {
- default:
- break;
- }
- default:
- break;
- }
- }
- else {
- if (msg.message != IX11_HIGZ_MSG)
- TranslateMessage(&msg);
- DispatchMessage(&msg);
- }
- }
- ExitThread(0);
- return 0;
- } /* HIGZ_MsgLoop */
-
-
-/*___________________________________________________________________*/
-/*
- * INTEGER FUNCTION IXOPNDS(LENHST,HOST)
- * INTEGER LENHST : host name length
- * CHARACTER*(*) HOST : host name
- *
- * Open the display. Return -1 if the opening fails
- */
-int
- ixopnds( lenhst, host )
-char *host;
-int *lenhst;
-{
- HINSTANCE hinst = GetModuleHandle(NULL); /* handle of current instance */
-// HINSTANCE hinst = NULL; /* handle of current instance */
-
-
- /* Make sure that this window hasn't been registered yet */
-
- if (GetClassInfo(hinst,HIGZCLASS,&higz_display))
- return 0;
-
- /* Set the common wndClass information. This is common for all windows
- ** of this application.
- */
-
- higz_display.style = CS_OWNDC | CS_HREDRAW | CS_VREDRAW;
- higz_display.cbClsExtra = 0;
-
- higz_display.cbWndExtra = sizeof(LONG)+LastExtraMember*sizeof(HANDLE);
-
- higz_display.hCursor = NULL;
-// higz_display.hCursor = LoadCursor(NULL, IDC_CROSS);
-// higz_display.hCursor = LoadCursor(hinst, hCursor);
- higz_display.hInstance = hinst;
-
- /*
- ** Register the main top-level window
- */
-
- higz_display.lpfnWndProc = (WNDPROC) WndHIGZ;
- higz_display.hIcon = LoadIcon(NULL, IDI_APPLICATION);
- higz_display.hbrBackground = GetStockObject(WHITE_BRUSH);
- higz_display.lpszMenuName = NULL;
- higz_display.lpszClassName = HIGZCLASS;
-
- if (!RegisterClass(&higz_display)) {
- return -1;
- }
- else {
- HANDLE ThrSem;
-/*
- * Retrieve the applicaiton instance
- */
-
- /* Create thread to do loop msg */
-
- ThrSem = CreateSemaphore(NULL, 0, 1, NULL);
-
- CreateThread(NULL,0, (LPTHREAD_START_ROUTINE) HIGZ_MsgLoop,
- (LPVOID) ThrSem, 0, &IDThread);
-
- WaitForSingleObject(ThrSem, INFINITE);
- CloseHandle(ThrSem);
-/* Create common object */
- hdCursorPen = GetStockObject(BLACK_PEN);
-// CreatePen(PS_SOLID,0,RGB(64,64,64));// Pen to draw HIGZ locator
- hdCursorBrush =
- GetStockObject(HOLLOW_BRUSH); // Brush to draw HIGZ locator 3 or 5
- return 0;}
-}
-
-
-/*___________________________________________________________________*/
-LRESULT APIENTRY
- HIGZ_Act(hwnd, uMsg, wParam, lParam)
-HWND hwnd;
-UINT uMsg;
-WPARAM wParam;
-LPARAM lParam;
- {
- switch (HIWORD(wParam)) {
-
- case HIGZ_Control:
- switch (LOWORD(wParam))
- {
- case IX_OPNDS: // Open X11 display
- break;
- case IX_OPNWI: // Open X11 window
- break;
- case IX_SELWI: // Select the current X11 window
- break;
- case IX_CLSWI: // Close an X11 window
- SetSystemPaletteUse(CurrentDC,SYSPAL_STATIC);
- RealizePalette(CurrentDC);
- while(!PostMessage(HWND_BROADCAST,WM_SYSCOLORCHANGE, 0, 0));
-
- if (HistoryDC) DeleteEnhMetaFile(CloseEnhMetaFile(HistoryDC));
- /* Delete data structure */
- /* Link previous and next structure */
- if (cHw->ptbw == NULL) fHw = cHw->ptfw; /* This is the first structure in the list */
- else cHw->ptbw->ptfw = cHw->ptfw;
-
- if (cHw->ptfw == NULL) lHw = cHw->ptbw; /* This is the last structure in the list */
- else cHw->ptfw->ptbw = cHw->ptbw;
- /* Now the current structure is free and we may delete it */
- free(cHw);
- Number_of_HIGZ_Windows--;
- DestroyWindow( hwnd );
- return 0;
- case IX_CLSDS: // Close an X11 session
- PostQuitMessage(0);
- break;
-
- case IX_SETHN: // Set X11 host name
- return TRUE;
- case IX_CLRWI: // Clear an X11 window
- {
- /* HBRUSH CurBrush; */
- /* RECT rect; */
- HRGN TempClip, clip;
- char buftext[20]= {"HI\0PAW\0\0" };
-
-/* Cancel clipping temporary */
-
- clip = cHw->HIGZClipRegion;
- if (clip != NULL) TempClip = SelectClipRgn(CurrentDC,NULL);
- GetClientRect(hwnd,&rect);
- DPtoLP(CurrentDC,&rect,2);
- FillRect(CurrentDC,&rect, CurBrush = CreateSolidBrush(WHITE_HIGZ_COLOR));
- DeleteObject(CurBrush);
- if (clip != NULL) TempClip = SelectClipRgn(CurrentDC,TempClip);
-
-/* Close History Metafile and create a new one */
-
-// if (HistoryDC) {
- if(FALSE) {
- ENHMETAHEADER mfHeader;
- HENHMETAFILE hmf;
- hmf = CloseEnhMetaFile(HistoryDC);
- printf(" Metafile ID %x with error %d for %x Histiry DC \n", hmf,GetLastError(),HistoryDC);
- GetEnhMetaFileHeader(hmf,sizeof(ENHMETAHEADER),&mfHeader);
- DeleteEnhMetaFile(hmf);
- HistoryDC = CreateEnhMetaFile(CurrentDC ,NULL,&(mfHeader.rclFrame),
- NULL);
- printf(" HistoryDC inside od CLRWI %x with Error %d \n", HistoryDC,
- GetLastError());
- cHw->hdcHistory = HistoryDC;
- }
- return TRUE;
- }
-
- case IX_UPDWI: // Update an X11 window
- FlushHIGZBuffer(hwnd);
- break;
- case IX_RSCWI: // Resize an X11 window
- return TRUE;
- case IX_CLIP : // Define the X11 clipping rectangle
- {
- LPPOINT ClipRectPoint;
- LPRECT ClipRectFromPoint;
- HDC hdc;
- HRGN clip;
-
- hdc = CurrentDC;
- ClipRectPoint = (LPPOINT) lParam;
- ClipRectFromPoint = (LPPOINT) lParam;
- LPtoDP(hdc,ClipRectPoint, 2);
-
- if (clip = cHw->HIGZClipRegion)
- DeleteObject(clip);
-/* Select clippping for Display */
- hdc = cHw->hdcWindow;
- SelectClipRgn(hdc,
- clip = CreateRectRgnIndirect( ClipRectFromPoint));
-
-/* Select clippping for bitmap buffer */
- hdc = cHw->hdcPixBuffer;
- if (hdc)
- SelectClipRgn(hdc,
- clip = CreateRectRgnIndirect( ClipRectFromPoint));
- cHw->HIGZClipRegion = clip;
- return (LRESULT) TRUE;
- }
- case IX_NOCLI: // Deactivate the X11 clipping rectangle
- {
- HDC hdc;
- HRGN clip;
-
- clip = cHw->HIGZClipRegion;
- if (clip != NULL) {
- DeleteObject(clip);
- hdc = cHw->hdcWindow;
- SelectClipRgn(hdc,NULL);
- /* Cancel cliiping for bitmap buffer */
- hdc = cHw->hdcPixBuffer;
- if (hdc) SelectClipRgn(hdc,NULL);
- cHw->HIGZClipRegion = (HRGN) NULL;;
- }
- return (LRESULT) TRUE;
- }
- default:
- return TRUE;
- }
- break;
-
-
- /* X11 output primitives */
- case HIGZ_Primitive:
- switch (LOWORD(wParam))
- {
- case IX_LINE : // Draw a line through all points
- {
- struct { int n; XPoint *xy;} *line;
- HDC hdc;
- int i;
-
- line = lParam;
- hdc = CurrentDC;
- if ( line->n > 1 )
- return Polyline(hdc,line->xy,line->n);
- else
- return SetPixel(hdc, line->xy[0].x,line->xy[0].y, RGB(0,0,0));
- }
- case IX_MARKE: // Draw a marker ar each point
- return Wnd_MARKE(hwnd, uMsg, wParam, lParam);
-
- case IX_FLARE: // Fill area described by polygon
- return Wnd_FLARE(hwnd, uMsg, wParam, lParam);
- case IX_BOX : // Draw a box
- return Wnd_BOX(hwnd, uMsg, wParam, lParam);
- case IX_CA : // Draw a cell array
- return Wnd_CA(hwnd, uMsg, wParam, lParam);
- default:
- return TRUE;
- }
- break;
- /* X11 text */
- case HIGZ_Text:
- {
- TEXTMETRIC *tm;
- HGDIOBJ hdf;
-/* Save default values and set cthe current one */
- hdf = SelectObject(CurrentDC,hdCommonFont);
-
- /* Update text metric's */
-
- tm = malloc(sizeof(TEXTMETRIC));
- GetTextMetrics(CurrentDC,tm);
- cHw->dwCharX = tm->tmAveCharWidth;
- cHw->dwCharY = tm->tmHeight;
- cHw->dwAscent= tm->tmAscent;
- free(tm);
-
- switch (LOWORD(wParam))
- {
- case IX_TEXT : // Draw a text string using the current font
- {
- struct {int mode,x,y,lentxt; float angle, mgn; char *text;} *text_msg;
- COLORREF clrref;
- int y_shift = 0,
- x_shift = 0;
- int txtA;
- double t_rotate;
-
-/* Save default values and set current one */
- clrref = SetTextColor(CurrentDC,dwCommonTextColor);
- txtA = SetTextAlign(CurrentDC,dwCommonTextAlign);
-
- text_msg = lParam;
- /* therefore Windows font hasn'ta "vertical cernter attribute"
- one should emulate it by hand
- */
- if (align_vert == 0) {
- t_rotate = cos(0.1*HIGZFont.lfEscapement);
- y_shift = (cHw->dwAscent/2)*t_rotate;
- x_shift = (cHw->dwAscent/2)*sqrt(1.0-t_rotate*t_rotate);
- }
- ExtTextOut(CurrentDC,
- text_msg->x+x_shift, text_msg->y+y_shift,
- 0, NULL,
- text_msg->text, text_msg->lentxt,
- NULL);
-/* Restore default values */
- SetTextColor(CurrentDC,clrref);
- SetTextAlign(CurrentDC,txtA );
- break;
- }
- case IX_TXTL : // Return the width and height of character string in the current font
- {
- SIZE text_size;
- struct { int w,h, lmess; char *mess;} *sText;
- sText = lParam;
- GetTextExtentPoint(CurrentDC,
- sText->mess,sText->lmess, &text_size);
- sText->w = text_size.cx;
- sText->h = text_size.cy;
- break;
- }
- default:
- break;
- }
-/* Restore Default font */
-
- SelectObject(CurrentDC,hdf);
-
- tm = malloc(sizeof(TEXTMETRIC));
- GetTextMetrics(CurrentDC,tm);
- cHw->dwCharX = tm->tmAveCharWidth;
- cHw->dwCharY = tm->tmHeight;
- cHw->dwAscent= tm->tmAscent;
- free(tm);
-
- break;
- }
-/* X11 output attributes */
- case HIGZ_Attribute:
- switch (LOWORD(wParam))
- {
- case IX_DRMDE: // Set drawing mode
- SetROP2(CurrentDC,lParam);
- return TRUE;
- }
- break;
- /* X11 marker style */
-
- case HIGZ_Marker:
- switch (LOWORD(wParam))
- {
- case IX_SETTA: // Set text alignment
- SetTextAlign(CurrentDC,lParam);
- break;
- case IX_SETTF: // Set text font to specified name
- {
- TEXTMETRIC *tm;
- DeleteObject(SelectObject(CurrentDC,
- CreateFontIndirect((LOGFONT*) lParam))
- );
- /* Update text metric's */
-
- tm = malloc(sizeof(TEXTMETRIC));
- GetTextMetrics(CurrentDC,tm);
- cHw->dwCharX = tm->tmAveCharWidth;
- cHw->dwCharY = tm->tmHeight;
- cHw->dwAscent= tm->tmAscent;
- free(tm);
-
- break;
- }
-
- case IX_SYNC : // X11 synchronization
-
- default:
- return TRUE;
- }
- break;
- /* X11 inquiry routines */
- case HIGZ_Inquiry:
- switch (LOWORD(wParam))
- {
- case IX_GETGE: // Returns position and size of Window
- GetWindowExtEx(CurrentDC,(LPSIZE)lParam);
- return TRUE;
- case IX_GETWI: // Returns the X11 window identifier
- case IX_GETPL: // Returns the maximal number of planes of the display
- case IX_GETCOL: // Returns the X11 colour representation
- {
- struct {int index; struct tagPALETTEENTRY rgb;} *lpHIGZ_rgb;
- HGDIOBJ hpl;
-
- lpHIGZ_rgb = lParam;
- hpl = GetCurrentObject(CurrentDC,OBJ_PAL);
- GetPaletteEntries(hpl,lpHIGZ_rgb->index,1,&(lpHIGZ_rgb->rgb));
- break;
- }
- default:
- return TRUE;
- }
- break;
-
- /* Pixmap manipulation */
-
- case HIGZ_Pixmap:
- switch (LOWORD(wParam))
- {
- case IX_CPPX : // Copy the pixmap
- Wnd_CPPX(hwnd, uMsg, wParam, lParam);
- break;
- case IX_WRPX : // Write the pixmap
-// Wnd_WRPX(hwnd, uMsg, wParam, lParam);
- break;
- case IX_WIPX : // Copy the area in the current window
- Wnd_WIPX(hwnd, uMsg, wParam, lParam);
- break;
- default:
- return TRUE;
- }
- return TRUE;
- /* Dummies */
-
- case HIGZ_Dummies:
- switch (LOWORD(wParam))
- {
- case IX_S2BUF:
- Wnd_S2BUF(hwnd, uMsg, wParam, lParam);
- break;
- case IX_SDSWI:
- default:
- return TRUE;
- }
- default:
- return TRUE;
- }
- return TRUE;
- } /* HIGZ_Act */
-
-/*___________________________________________________________________*/
-/*
- * INTEGER FUNCTION IXOPNWI(X,Y,W,H,LENTIT,TITLE,FLAG)
- * INTEGER X,Y : initial window position
- * INTEGER W,H : initial window width and height
- * INTEGER LENTIT : title length
- * CHARACTER*(*) TITLE : window title
- * INTEGER FLAG : FLAG<>1 allows to open a non MOTIF window
- * even if ixmotif has been called.
- *
- * Open window and returns window number which can be used with IXSELWIN
- * return -1 if window creation fails
- */
-int
- ixopnwi( x, y, w, h, lentit,title, flag )
-char *title;
-
-int *x, *y;
-int *w, *h;
-int *lentit;
-int *flag;
-{
- HWND hwndHIGZ;
- int value;
- static struct CREATEHIGZWINDOW WinThr;
-
- WinThr.x = *x;
- WinThr.y = *y;
- WinThr.w = *w+2*GetSystemMetrics(SM_CXFRAME);
-
- WinThr.h = *h+ GetSystemMetrics(SM_CYCAPTION)
- +2*GetSystemMetrics(SM_CYFRAME)
- - GetSystemMetrics(SM_CYBORDER);
- WinThr.lentit = *lentit;
- WinThr.title = title;
-
-
- /* Create HIGZ window */
-
- WinThr.semaphore = CreateSemaphore(NULL, 0, 1, NULL);
-
- while(!PostThreadMessage(IDThread,
- IX11_HIGZ_MSG,MAKEWPARAM(IX_OPNWI,HIGZ_Control), &WinThr));
-
- WaitForSingleObject(WinThr.semaphore, INFINITE);
- CloseHandle(WinThr.semaphore);
-
- ShowWindow(WinThr.hwnd,SW_SHOWDEFAULT);
- UpdateWindow(WinThr.hwnd);
-
- return (int)WinThr.hwnd;
-
- }
-
-
-/*___________________________________________________________________*/
-/*
- * SUBROUTINE IXRSCWI(WID, W, H)
- * INTEGER WID : Window identifier.
- * INTEGER W : Width
- * INTEGER H : Heigth
- *
- * Rescale the window WID
- */
-void
- ixrscwi(wid, w, h)
- HWND *wid;
- int *w;
- int *h;
-{
- int new_w,new_h;
-
- new_w = *w+2*GetSystemMetrics(SM_CXFRAME);
-
- new_h = *h+ GetSystemMetrics(SM_CYCAPTION)
- +2*GetSystemMetrics(SM_CYFRAME)
- - GetSystemMetrics(SM_CYBORDER);
-
- SetWindowPos(*wid,HWND_TOP,0,0,new_w,new_h,
- SWP_DRAWFRAME|SWP_NOMOVE |SWP_NOZORDER );
-}
-
-/*___________________________________________________________________*/
-/*
- * SUBROUTINE IXS2BUF(WID,MODE)
- * INTEGER WID : Window identifier.
- * 999 means all the opened windows.
- * INTEGER MODE : 1 double buffer is on
- * 0 double buffer is off
- *
- * Set the double buffer on/off on window WID.
- */
-void
- ixs2buf( wid, mode )
- int *wid;
- int *mode;
-{
- SendMessage(*wid,
- IX11_HIGZ_MSG,MAKEWPARAM(IX_S2BUF,HIGZ_Dummies),*mode);
-}
-
-/*___________________________________________________________________*/
-LRESULT APIENTRY
- Wnd_S2BUF (hwnd, uMsg, wParam, lParam)
-HWND hwnd;
-UINT uMsg;
-WPARAM wParam;
-LPARAM lParam;
-/* Global variable used:
- *
- * offPixmapDC - handle of the memory device context
- * offPixBuffer - handle of the bitmap in memory DC
- * = NULL - means there os no double buffering
- * for the current window.
- */
- {
- HBITMAP hdBuffer;
- HDC hdPixmapDC;
-
- hdPixmapDC = cHw->hdcPixBuffer;
- hdBuffer = cHw->hbBuffer;
-
- if (lParam) {
-/* Turn double bufferring ON */
- if (hdPixmapDC) FlushHIGZBuffer(hwnd);
- else CreateHIGZBuffer(hwnd);
- }
- else
-/* Turn double bufferring OFF */
- if (hdPixmapDC){
- hdBuffer = FlushHIGZBuffer(hwnd);
- DeleteDC(hdPixmapDC);
- DeleteObject(hdBuffer);
-
- cHw->hdcPixBuffer = NULL;
- cHw->hbBuffer = NULL;
- }
- }
-
-/*___________________________________________________________________*/
-/*
- * SUBROUTINE IXQ2BUF(WID)
- * INTEGER WID : Window identifier.
- *
- * Query the double buffer value for the window WID.
- */
-int
- ixq2buf( wid )
- int *wid;
-{
- int rval;
- struct HIGZWindow *Hw;
- Hw = (struct HIGZWindow *)GetWindowLong(*wid,ExtHIGZWindow);
- rval = (int) (Hw->hbBuffer);
- if (rval) return rval;
- else return -1;
-}
-
-
-
-/*___________________________________________________________________*/
-/*
- * INTEGER FUNCTION IXOPNPX(W, H)
- * INTEGER W,H : Width and height of the pixmap.
- *
- * Open a new pixmap.
- */
-int
- ixopnpx(w, h)
-int *w, *h;
-{
- static struct {SIZE PixMap;HANDLE semaphore;HBITMAP ipix;} HIGZPixmap;
-
- HIGZPixmap.PixMap.cx = *w;
- HIGZPixmap.PixMap.cy = *h;
-
- lpHpixmap = malloc(sizeof(HIGZWindow));
- if (lpHpixmap) {
- lpHpixmap->hdcWindow = CreateCompatibleDC(NULL);
- SetMapMode (lpHpixmap->hdcWindow,MM_ISOTROPIC);
- SetBkMode (lpHpixmap->hdcWindow,TRANSPARENT);
- DeleteObject(SelectPalette(lpHpixmap->hdcWindow,hdCommonPalette,TRUE));
-
- lpHpixmap->HIGZWindowSize.right = *w;
- lpHpixmap->HIGZWindowSize.bottom = *h;
- cHw = (struct HIGZWindow *)GetWindowLong(CurrentHIGZWindow,ExtHIGZWindow);
- lpHpixmap->hbBuffer = CreateCompatibleBitmap(cHw->hdcWindow,
- lpHpixmap->HIGZWindowSize.right,
- lpHpixmap->HIGZWindowSize.bottom);
- SelectObject(lpHpixmap->hdcWindow,lpHpixmap->hbBuffer);
- PixMapON = TRUE;
- }
- return (int) lpHpixmap->hbBuffer;
-}
-
-
-/*___________________________________________________________________*/
-/*
- * SUBROUTINE IXCLRPX(PIX)
- * INTEGER PIX : Pixmap address
- *
- * Clear the pixmap PIX.
- */
-void
- ixclrpx(pix )
-HGDIOBJ *pix;
-{
- RECT rect;
- BITMAP Bitmap_buffer;
-
- if (lpHpixmap) {
- if (lpHpixmap->hbBuffer == *pix) {
- GetObject(*pix, sizeof(BITMAP),&Bitmap_buffer);
- rect.left = 0;
- rect.top = 0;
- rect.right = Bitmap_buffer.bmWidth;
- rect.bottom = Bitmap_buffer.bmHeight;
- FillRect(lpHpixmap->hdcWindow,
- &rect, CurBrush = CreateSolidBrush(WHITE_HIGZ_COLOR));
- DeleteObject(CurBrush);
- }
- }
-}
-
-/*___________________________________________________________________*/
-/*
- * SUBROUTINE IXCLPX
- *
- * Close the current opened pixmap.
- */
-void
- ixclpx()
-{
- PixMapON = FALSE;
-}
-
-
-/*___________________________________________________________________*/
-/*
- * SUBROUTINE IXCPPX(PIX, XPOS, YPOS)
- * INTEGER PIX : Pixmap address
- * INTEGER XPOS, YPOS : Pixmap Position
- *
- * Copy the pixmap PIX at the position XPOS YPOS.
- */
-void
- ixcppx(pix, xpos, ypos)
-int *pix;
-int *xpos, *ypos;
-{
- POINT point;
- point.x = *xpos;
- point.y = *ypos;
- if (lpHpixmap->hbBuffer == *pix)
- SendMessage(CurrentHIGZWindow,
- IX11_HIGZ_MSG,MAKEWPARAM(IX_CPPX,HIGZ_Pixmap),&point);
-}
-
-/*___________________________________________________________________*/
-LRESULT APIENTRY
- Wnd_CPPX (hwnd, uMsg, wParam, lParam)
- HWND hwnd; UINT uMsg; WPARAM wParam; LPARAM lParam;
-{
- BITMAP Bitmap_buffer;
- int w,h;
- GetObject(lpHpixmap->hbBuffer, sizeof(BITMAP),&Bitmap_buffer);
- w = Bitmap_buffer.bmWidth;
- h = Bitmap_buffer.bmHeight;
- BitBlt(CurrentDC,((POINT*)lParam)->x,((POINT*)lParam)->y,w,h,
- lpHpixmap->hdcWindow,0,0,SRCCOPY);
-
-}
-
-
-
-/*___________________________________________________________________*/
-/*
- * SUBROUTINE IXWRPX(PIX,W,H,LENNAME,PXNAME)
- * INTEGER PIX : Pixmap address
- * INTEGER W,H : Width and height of the pixmap.
- * INTEGER LENNAME : pixmap name length
- * CHARACTER*(*) PXNAME: pixmap name
- *
- * Write the pixmap IPX in the bitmap file PXNAME.
- */
-void
- ixwrpx(pix, w, h, lenname, pxname, lpxname )
-char *pxname;
-int *pix;
-int *w, *h;
-int *lenname;
-int lpxname;
-{
- unsigned int wval, hval;
- wval = *w;
- hval = *h;
-/* XWriteBitmapFile(display,string(pxname,*lenname),*pix,wval,hval,-1,-1);
-*/
-}
-
-
-/*___________________________________________________________________*/
-/*
- * SUBROUTINE IXWIPX(PIX, XPOS, YPOS)
- * INTEGER PIX : Pixmap address
- * INTEGER XPOS, YPOS : Position in the current window
- *
- * Copy the area at the position XPOS YPOS in the current
- * window in the pixmap PIX. The area copied has the size
- * of the pixmap PIX.
- */
-void
- ixwipx(pix, xpos, ypos )
-int *pix;
-int *xpos, *ypos;
-{
- POINT point;
- point.x = *xpos;
- point.y = *ypos;
- SendMessage(CurrentHIGZWindow,
- IX11_HIGZ_MSG,MAKEWPARAM(IX_WIPX,HIGZ_Pixmap),&point);
-}
-
-/*___________________________________________________________________*/
-LRESULT APIENTRY
- Wnd_WIPX (hwnd, uMsg, wParam, lParam)
- HWND hwnd; UINT uMsg; WPARAM wParam; LPARAM lParam;
-{
- int w,h;
- BITMAP Bitmap_buffer;
-
- GetObject(lpHpixmap->hbBuffer, sizeof(BITMAP),&Bitmap_buffer);
- w = Bitmap_buffer.bmWidth;
- h = Bitmap_buffer.bmHeight;
- BitBlt(lpHpixmap->hdcWindow,0,0,w,h,
- CurrentDC,((POINT*)lParam)->x,((POINT*)lParam)->y,SRCCOPY);
-
-}
-
-
-
-/*___________________________________________________________________*/
-/*
- * SUBROUTINE IXRMPX(PIX)
- * INTEGER PIX : Pixmap adress
- *
- * Remove the pixmap PIX.
- */
-void
- ixrmpx(pix)
-int *pix;
-{
- PixMapON = FALSE;
- DeleteDC(lpHpixmap->hdcWindow);
- DeleteObject(lpHpixmap->hbBuffer);
- free(lpHpixmap);
- lpHpixmap = NULL;
-}
-
-
-/*___________________________________________________________________*/
-/*
- * SUBROUTINE IXCLSDS
- *
- * Delete all windows and close connection
- */
-void
- ixclsds()
-{
-/* Delete common objects */
- DeleteObject(hdCursorPen);
- DeleteObject(hdCursorBrush);
- PostMessage(CurrentHIGZWindow,
- IX11_HIGZ_MSG,MAKEWPARAM(IX_CLSDS,HIGZ_Control), 0);
-}
-
-
-/*___________________________________________________________________*/
-/*
- * SUBROUTINE IXCLSWI
- *
- * Delete current window
- */
-void
- ixclswi()
-{
- int wid;
-
- SendMessage(CurrentHIGZWindow,
- IX11_HIGZ_MSG,MAKEWPARAM(IX_CLSWI,HIGZ_Control), 0);
-
-// ixclsds(); /* no open window left */
-}
-
-
-/*___________________________________________________________________*/
-/*
- * SUBROUTINE IXSELWI(WID)
- * INTEGER WID : window number returned by IXOPNWIN
- *
- * Select window to which subsequent output is directed
- */
-void
- ixselwi( wid )
-HWND *wid;
-{
- CurrentHIGZWindow = *wid;
-}
-
-
-/*___________________________________________________________________*/
-/*
- * SUBROUTINE IXSAVWI
- *
- * Save the adress of the current active window
- */
-void
- ixsavwi()
-{
- sws = cws;
-}
-
-
-/*___________________________________________________________________*/
-/*
- * SUBROUTINE IXSETWI
- *
- * Restore the adress of the saved window
- */
-void
- ixsetwi()
-{
- cws = sws;
-}
-
-
-/*___________________________________________________________________*/
-/*
- * SUBROUTINE IXGETGE(WID,X,Y,W,H)
- * INTEGER WID : window identifier
- * INTEGER X,Y : window position (output)
- * INTEGER W,H : window size (output) (in Windowa/NT logical coordinat)
- *
- * Return position and size of window wid
- * if wid < 0 the size of the display is returned
- */
-void
- ixgetge( wid, x, y, w, h )
-HWND *wid;
-int *x, *y;
-unsigned int *w, *h;
-{
- HDC junkwin;
- static SIZE win_pos;
- if( *wid < 0 ) {
- /* Retrive size of full screen in the device unit */
- junkwin = GetDC(NULL);
- *x = 0;
- *y = 0;
- *w = GetDeviceCaps(junkwin,HORZRES);
- *h = GetDeviceCaps(junkwin,VERTRES);
- ReleaseDC(NULL,junkwin);
- } else {
- junkwin = SendMessage(*wid,IX11_HIGZ_MSG,MAKEWPARAM(IX_GETGE,HIGZ_Inquiry), &win_pos);
- /* Retrive size of DISPLAY in the logical unit */
- *x = 0;
- *y = 0;
- *w = win_pos.cx;
- *h = win_pos.cy;
- }
-}
-
-
-/*___________________________________________________________________*/
-/*
- * SUBROUTINE IXGETPL(NPLANES)
- * INTEGER NPLANES : number of bit planes
- *
- * Get maximum number of planes
- */
-void
- ixgetpl(nplanes)
-int *nplanes;
-{
- HDC hDCGlobal;
- hDCGlobal = GetDC(NULL);
- *nplanes = GetDeviceCaps(hDCGlobal,PLANES);
- ReleaseDC(NULL,hDCGlobal);
-}
-
-
-/*___________________________________________________________________*/
-/*
- * SUBROUTINE IXRSIZ(WID)
- * INTEGER WID : window to be resized
- *
- * Resize the current window if necessary
- */
-void
- ixrsiz(wid)
-int *wid;
-{
-
-}
-
-
-/*___________________________________________________________________*/
-/*
- * SUBROUTINE IXGETHT(IL,CHHOST)
- * INTEGER IL : host name length (output)
- * CHARACTER*(*) CHHOST : host name (output)
- *
- * Return the host name given with IGWKTY.
- */
-void
- ixgetht (il, chhost)
- int *il;
- char *chhost; /* host name */
-{
- GetComputerName(chhost,il);
-}
-
-
-/*___________________________________________________________________*/
-void
- ixgetwi (wkid, idg)
- int wkid; /* workstation identifier (input) */
- int *idg; /* window identifier (output) */
-{
- *idg = 1;
-}
-
-
-/*___________________________________________________________________*/
-/*
- * SUBROUTINE IXCLRWI
- *
- * Clear current window
- */
-void
- ixclrwi()
-{
- HIGZDrawing(MAKEWPARAM(IX_CLRWI,HIGZ_Control), 0);
-}
-
-
-/*___________________________________________________________________*/
-/*
- * SUBROUTINE IXUPDWI(MODE)
- * INTEGER MODE : (1) or (11) The window is raised
- * (0) or (10) The window is not raised
- * (0) or (1) no synchonisation between client and server
- * (10) or (11) synchonisation between client and server
- *
- * Update display and raise current window to top of stack.
- * Synchronise client and server once (not permanent).
- * Copy the pixmap cws->buffer on the window cws-> window
- * if the double buffer is on.
- */
-void
- ixupdwi(mode)
- int *mode;
-{
- SendMessage(CurrentHIGZWindow,IX11_HIGZ_MSG,
- MAKEWPARAM(IX_UPDWI,HIGZ_Control), *mode);
-}
-
-
-/*___________________________________________________________________*/
-/*
- * SUBROUTINE IXCLIP(WID,X,Y,W,H)
- * INTEGER WID : Window indentifier
- * INTEGER X,Y : origin of clipping rectangle
- * INTEGER W,H : size of clipping rectangle;
- *
- * Set clipping region for the window wid
- */
-void
- ixclip( wid, x, y, w, h )
-HWND *wid;
-int *x, *y;
-int *w, *h;
-{
- static RECT region;
-
- region.left = *x;
- region.top = *y;
- region.right = *x+*w;
- region.bottom = *y+*h;
-
- SendMessage(*wid,IX11_HIGZ_MSG,MAKEWPARAM(IX_CLIP,HIGZ_Control), ®ion);
-
-}
-
-/*___________________________________________________________________*/
-/*
- * SUBROUTINE IWCLIP(WID,XMIN,YMIN,XMAX,YMAX)
- * INTEGER WID : Window indentifier
- * INTEGER XMIN,YMIN, XMAX, YMAX : clipping rectangle
- *
- * Set clipping region for the window wid
- */
-void
- iwclip( wid, xmin, ymin, xmax, ymax )
-HWND *wid;
-int *xmin, *ymin, *xmax, *ymax;
-{
- static RECT region;
-
- region.left = *xmin;
- region.top = *ymin;
- region.right = *xmax;
- region.bottom = *ymax;
-
- SendMessage(*wid,IX11_HIGZ_MSG,MAKEWPARAM(IX_CLIP,HIGZ_Control), ®ion);
-
-}
-
-/*___________________________________________________________________*/
-/*
- * SUBROUTINE IXNOCLI(WID)
- * INTEGER WID : Window indentifier
- *
- * Switch off the clipping for the window wid
- */
-void
- ixnocli(wid)
-HWND *wid;
-{
-
- SendMessage(*wid,IX11_HIGZ_MSG,MAKEWPARAM(IX_NOCLI,HIGZ_Control), 0 );
-
-}
-
-
-/*___________________________________________________________________*/
-/*
- * SUBROUTINE IXSETCO(CINDEX,R,G,B)
- * INTEGER CINDEX : color index
- * REAL R,G,B : red, green, blue intensities between 0.0 and 1.0
- *
- * Set color intensities for given color index
- */
-#define BIGGEST_RGB_VALUE 255 // 65535
-
-void
- ixsetco( cindex, r, g, b )
-int *cindex;
-float *r, *g, *b;
-{
- static PALETTEENTRY ChColor;
- static struct {UINT ci; struct PALETTEENTRY *lpChColor;} NewColor;
- int i;
-
- if (*cindex < MAXCOL-1) {
- NewColor.ci = *cindex;
- NewColor.lpChColor = &ChColor;
-
- ChColor.peRed = (BYTE) (*r*BIGGEST_RGB_VALUE);
- ChColor.peGreen = (BYTE) (*g*BIGGEST_RGB_VALUE);
- ChColor.peBlue = (BYTE) (*b*BIGGEST_RGB_VALUE);
-
- ChColor.peFlags = PC_NOCOLLAPSE;
-
- i = NewColor.ci+ColorOffset;
- SetPaletteEntries(hdCommonPalette,i,1,&ChColor);
- }
-}
-
-
-/*___________________________________________________________________*/
-void
- ixgetcol( index, r, g, b )
-int index; /* input */
-float *r, *g, *b; /* output */
-{
- static struct {int index; PALETTEENTRY rgb;} HIGZ_rgb;
- HIGZ_rgb.index = index;
- SendMessage(CurrentHIGZWindow,
- IX11_HIGZ_MSG,MAKEWPARAM(IX_GETCOL,HIGZ_Inquiry),&HIGZ_rgb);
- *r = (float)HIGZ_rgb.rgb.peRed /BIGGEST_RGB_VALUE;
- *g = (float)HIGZ_rgb.rgb.peGreen/BIGGEST_RGB_VALUE;
- *b = (float)HIGZ_rgb.rgb.peBlue /BIGGEST_RGB_VALUE;
- return ;
-}
-
-/*___________________________________________________________________*/
-HPEN CreateHIGZPen(lpPen)
-struct HIGZPEN *lpPen;
- {
- static int dwWidth, dwStyle;
-
- dwWidth = lpPen->pen.lopnWidth.x;
- if (dwWidth <= 1) dwWidth=1;
-
- dwStyle = lpPen->pen.lopnStyle |
- ((dwWidth == 1)? PS_COSMETIC:
- PS_GEOMETRIC | PS_INSIDEFRAME);
-
- if (hdCommonPen) DeleteObject(hdCommonPen);
- return ExtCreatePen( dwStyle,
- dwWidth,
- &(lpPen->brush),
- lpPen->lUserDash,
- lpPen->UserDash);
- }
-
-
-/*___________________________________________________________________*/
-/*
- * SUBROUTINE IXSETLN(WIDTH)
- * INTEGER WIDTH : line width in pixels
- *
- * Set line width
- */
-void
- ixsetln( width )
-int *width;
-{
- if (pen.pen.lopnWidth.x != *width)
- {
- pen.pen.lopnWidth.x = *width;
- hdCommonPen = CreateHIGZPen(&pen);
- }
-}
-
-
-/*___________________________________________________________________*/
-/*
- * SUBROUTINE IXSETLS(N,DASH)
- * INTEGER N : length of dash list
- * INTEGER DASH(N) : dash segment lengths
- *
- * Set line style:
- * if N.LE.0 use pre-defined Windows style:
- * 0 - solid lines
- * -1 - solid lines
- * -2 - dash line
- * -3 - dot line
- * -4 - dash-dot line
- * -5 - dash-dot-dot line
- * .LE.-6 - solid line
- *
- * if N.GT.0 use dashed lines described by DASH(N)
- * e.g. N=4,DASH=(6,3,1,3) gives a dashed-dotted line with dash length 6
- * and a gap of 7 between dashes
- */
-void
- ixsetls( n, dash )
-int *n;
-int *dash;
-{
- UINT style;
- if( *n <= 0 ) {
- pen.lUserDash = 0;
- pen.UserDash = NULL;
- switch (*n)
- {
- case 0: style = PS_SOLID;
- break;
- case -1: style = PS_SOLID;
- break;
- case -2: style = PS_DASH;
- break;
- case -3: style = PS_DOT;
- break;
- case -4: style = PS_DASHDOT;
- break;
- case -5: style = PS_DASHDOTDOT;
- break;
- default: style = PS_SOLID;
- break;
- }
- if (pen.pen.lopnStyle == style ) return;
- pen.pen.lopnStyle = style;
- }
- else
- {
- pen.pen.lopnStyle = PS_USERSTYLE;
- pen.lUserDash = *n;
- pen.UserDash = dash;
- }
- hdCommonPen = CreateHIGZPen(&pen);
-}
-
-
-/*___________________________________________________________________*/
-/*
- * SUBROUTINE IXSETLC(CINDEX)
- * INTEGER CINDEX : color index defined my IXSETCOL
- *
- * Set color index for lines
- */
-void
- ixsetlc( cindex )
-int *cindex;
-{
- if (pen.pen.lopnColor != *cindex)
- {
- pen.pen.lopnColor = *cindex;
- pen.brush.lbColor = HIGZColorIndex(pen.pen.lopnColor);
-
- hdCommonPen = CreateHIGZPen(&pen);
- }
-}
-
-
-/*___________________________________________________________________*/
-/*
- * SUBROUTINE IXLINE(N,XY)
- * INTEGER N : number of points
- * INTEGER*2 XY(2,N) : list of points
- *
- * Draw a line through all points
- */
-void
- ixline( n, xy )
-int *n;
-XPoint *xy;
-{
- static struct { int n; XPoint *xy;} line;
- line.n = *n;
- line.xy = xy;
- HIGZDrawing(MAKEWPARAM(IX_LINE,HIGZ_Primitive),&line);
-}
-
-
-/*___________________________________________________________________*/
-/*
- * SUBROUTINE IXSETMS(TYPE,N,XY)
- * INTEGER TYPE : marker type
- * INTEGER N : length of marker description
- * INTEGER*2 XY(2,N) : list of points describing marker shape
- *
- * Set marker style:
- * if N.EQ.0 marker is a single point
- * if TYPE.EQ.0 marker is hollow circle of diameter N
- * if TYPE.EQ.1 marker is filled circle of diameter N
- * if TYPE.EQ.2 marker is a hollow polygon describe by line XY
- * if TYPE.EQ.3 marker is a filled polygon describe by line XY
- * if TYPE.EQ.4 marker is described by segmented line XY
- * e.g. TYPE=4,N=4,XY=(-3,0,3,0,0,-3,0,3) sets a plus shape of 7x7 pixels
- */
-void
- ixsetms( type, n, xy )
-int *type;
-int *n;
-XPoint *xy;
-{
- int i;
-
- marker.type = *type;
- marker.n = *n < MAXMK ? *n : MAXMK;
- if( marker.type >= 2 )
- for( i = 0; i < marker.n; i++ )
- marker.xy[i] = xy[i];
-}
-
-
-/*___________________________________________________________________*/
-/*
- * SUBROUTINE IXSETMC(CINDEX)
- * INTEGER CINDEX : color index defined my IXSETCOL
- *
- * Set color index for markers
- */
-void
- ixsetmc( cindex )
-int *cindex;
-{
- marker.cindex = *cindex;
-}
-
-
-/*___________________________________________________________________*/
-/*
- * SUBROUTINE IXMARKE(N,XY)
- * INTEGER N : number of points
- * INTEGER*2 XY(2,N) : list of points
- *
- * Draw a marker at each point
- */
-void
- ixmarke( n, xy )
-int *n;
-XPoint *xy;
-{
- static struct { int n; XPoint *xy; struct MARKER *marker;} markers;
-
- markers.n = *n;
- markers.xy = xy;
- markers.marker = ▮
-
- HIGZDrawing(MAKEWPARAM(IX_MARKE,HIGZ_Primitive),&markers);
-
-}
-
-/*___________________________________________________________________*/
- LRESULT APIENTRY
- Wnd_MARKE(hwnd, uMsg, wParam, lParam)
- HWND hwnd;
- UINT uMsg;
- WPARAM wParam;
- LPARAM lParam;
- {
- struct { int n; XPoint *xy; struct MARKER *marker;} *markers;
- int m,n;
- XPoint *xy;
- COLORREF mColor;
- struct MARKER *CurMarker;
- int ownBrush;
-
- markers = lParam;
- n = markers->n;
- xy = markers->xy;
- CurMarker = markers->marker;
-
- /* Set marker Color */
- mColor = HIGZColorIndex(CurMarker->cindex);
-
- if( CurMarker->n <= 0 )
- for (m=0; m < n; m++) SetPixel(CurrentDC, xy[m].x,xy[m].y, mColor);
-
- else {
- int r = CurMarker->n / 2;
- HGDIOBJ CurBrush, CurPen;
-
- CurPen = SelectObject(CurrentDC, CreatePen(PS_SOLID,0,mColor));
-
- switch (CurMarker -> type) {
- case 0:
- case 3:
- default:
- ownBrush = TRUE;
- CurBrush = SelectObject(CurrentDC, CreateSolidBrush(mColor));
- break;
- case 1:
- case 2:
- ownBrush = TRUE;
- CurBrush = SelectObject(CurrentDC, GetStockObject(HOLLOW_BRUSH));
- break;
- case 4:
- ownBrush = FALSE;
- break;
- }
-
- for( m = 0; m < n; m++ ) {
- int i;
-
- switch( CurMarker->type ) {
-
- case 0: /* hollow circle */
- case 1: /* filled circle */
-
-
- Pie( CurrentDC,
- xy[m].x - r, xy[m].y - r,
- xy[m].x + r, xy[m].y + r,
- xy[m].x - r, xy[m].y - r,
- xy[m].x - r, xy[m].y - r);
- break;
-
- case 2: /* hollow polygon */
- case 3: /* filled polygon */
- for( i = 0; i < CurMarker->n; i++ ) {
- CurMarker->xy[i].x += xy[m].x;
- CurMarker->xy[i].y += xy[m].y;
- }
- Polygon(CurrentDC,CurMarker->xy,CurMarker->n);
- for( i = 0; i < CurMarker->n; i++ ) {
- CurMarker->xy[i].x -= xy[m].x;
- CurMarker->xy[i].y -= xy[m].y;
- }
- break;
-
- case 4: /* segmented line */
- for( i = 0; i < CurMarker->n; i += 2 )
- {
- MoveToEx(CurrentDC,xy[m].x + CurMarker->xy[i].x, xy[m].y + CurMarker->xy[i].y,NULL);
- LineTo(CurrentDC,xy[m].x + CurMarker->xy[i+1].x, xy[m].y + CurMarker->xy[i+1].y);
- }
- break;
- }
- }
-
-
- if (ownBrush) DeleteObject(SelectObject(CurrentDC, CurBrush));
- DeleteObject( SelectObject(CurrentDC, CurPen ));
- }
- return (LRESULT)TRUE;
- }
-
-
-
-/*___________________________________________________________________*/
-/*
- * SUBROUTINE IXSETFS(STYLE,FASI)
- * INTEGER STYLE : fill area interior style hollow or solid
- *
- * Set fill area style
- */
-void
- ixsetfs( style, fasi )
-int *style;
-int *fasi;
-{
- if (hdCommonBrush != NULL) DeleteObject(hdCommonBrush);
- switch( *style ) {
-
- case 0: /* solid */
- gcfill.lbStyle = BS_HOLLOW;
- hdCommonBrush = GetStockObject(HOLLOW_BRUSH);
- break;
- case 1: /* solid */
- gcfill.lbStyle = BS_SOLID;
-// if (gcfill.lbColor)
- hdCommonBrush = CreateSolidBrush(HIGZColorIndex(gcfill.lbColor));
-// else
-// hdCommonBrush = GetStockObject(WHITE_BRUSH);
- break;
-
- case 2: /* pattern */
- gcfill.lbStyle = BS_PATTERN;
- gcfill.lbHatch = &FillBitMap;
- switch( *fasi ) {
- case 1: FillBitMap.bmBits = &p1_bits;
- break;
- case 2: FillBitMap.bmBits = &p2_bits;
- break;
- case 3: FillBitMap.bmBits = &p3_bits;
- break;
- case 4: FillBitMap.bmBits = &p4_bits;
- break;
- case 5: FillBitMap.bmBits = &p5_bits;
- break;
- case 6: FillBitMap.bmBits = &p6_bits;
- break;
- case 7: FillBitMap.bmBits = &p7_bits;
- break;
- case 8: FillBitMap.bmBits = &p8_bits;
- break;
- case 9: FillBitMap.bmBits = &p9_bits;
- break;
- default: FillBitMap.bmBits = &p2_bits;
- break;
- }
- hdCommonBrush =
- CreatePatternBrush(CreateBitmapIndirect((LPBITMAP)gcfill.lbHatch));
- break;
-
- case 3: /* hatch */
- gcfill.lbStyle = BS_HATCHED;
- switch (*fasi)
- {
- case 1: gcfill.lbHatch = HS_BDIAGONAL;
- break;
- case 2: gcfill.lbHatch = HS_CROSS;
- break;
- case 3: gcfill.lbHatch = HS_DIAGCROSS;
- break;
- case 4: gcfill.lbHatch = HS_FDIAGONAL;
- break;
- case 5: gcfill.lbHatch = HS_HORIZONTAL;
- break;
- case 6: gcfill.lbHatch = HS_VERTICAL;
- break;
- default: gcfill.lbHatch = HS_FDIAGONAL;
- break;
- }
- hdCommonBrush =
- CreateHatchBrush(gcfill.lbHatch,HIGZColorIndex(gcfill.lbColor));
- break;
- default: /* solid */
- gcfill.lbStyle = BS_NULL;
-// if (gcfill.lbColor)
- hdCommonBrush = CreateSolidBrush(HIGZColorIndex(gcfill.lbColor));
-// else
-// hdCommonBrush = GetStockObject(WHITE_BRUSH);
- break;
-
- }
-}
-
-
-/*___________________________________________________________________*/
-/*
- * SUBROUTINE IXSETFC(CINDEX)
- * INTEGER CINDEX : color index defined my IXSETCOL
- *
- * Set color index for fill areas
- */
-void
- ixsetfc( cindex )
-int *cindex;
-{
- if (gcfill.lbColor != *cindex) {
- gcfill.lbColor = *cindex;
-
- switch (gcfill.lbStyle)
- {
- case BS_HOLLOW :
- case BS_PATTERN :
-/* Hollow and Patten styles needn't a change of brush */
- break;
- case BS_HATCHED :
- if (hdCommonBrush) DeleteObject(hdCommonBrush);
- hdCommonBrush =
- CreateHatchBrush(gcfill.lbHatch,HIGZColorIndex(gcfill.lbColor));
- break;
- case BS_SOLID :
- default :
- if (hdCommonBrush) DeleteObject(hdCommonBrush);
-// if (gcfill.lbColor)
- hdCommonBrush = CreateSolidBrush(HIGZColorIndex(gcfill.lbColor));
-// else
-// hdCommonBrush = GetStockObject(WHITE_BRUSH);
- break;
- }
- }
-}
-
-
-/*___________________________________________________________________*/
-/*
- * SUBROUTINE IXFLARE(N,XY)
- * INTEGER N : number of points
- * INTEGER*2 XY(2,N) : list of points
- *
- * Fill area described by polygon
- */
-void
- ixflare( n, xy )
-int *n;
-XPoint *xy;
-{
- static struct {int n; XPoint *xy;} polygon;
-
- polygon.n = *n;
- polygon.xy = xy;
- HIGZDrawing(MAKEWPARAM(IX_FLARE,HIGZ_Primitive),&polygon);
-}
-
-/*___________________________________________________________________*/
- LRESULT APIENTRY
- Wnd_FLARE(hwnd, uMsg, wParam, lParam)
- HWND hwnd;
- UINT uMsg;
- WPARAM wParam;
- LPARAM lParam;
- {
- static struct {int n; XPoint *xy;} *polygon;
- static COLORREF CurTextColor;
- static HGDIOBJ lpCurPen;
-
- polygon = lParam;
-
- if (!bord & gcfill.lbStyle != BS_HOLLOW)
- lpCurPen = SelectObject(CurrentDC, GetStockObject(NULL_PEN));
-
-
- if (gcfill.lbStyle == BS_PATTERN) {
- CurTextColor = SetTextColor(CurrentDC,HIGZColorIndex(gcfill.lbColor));
- Polygon(CurrentDC,polygon->xy,polygon->n);
- SetTextColor(CurrentDC,CurTextColor);
- }
- else {
- Polygon(CurrentDC,polygon->xy,polygon->n);
- }
- if (!bord & gcfill.lbStyle != BS_HOLLOW)
- DeleteObject(SelectObject(CurrentDC,lpCurPen));
-
- return TRUE;
-}
-
-/*___________________________________________________________________*/
-/*
- * SUBROUTINE IXSETTA(ALIGNH,ALIGNV)
- * INTEGER ALIGNH : horizontal text alignment
- * INTEGER ALIGNV : vertical text alignment
- *
- * Set text alignment:
- * if ALIGNH.EQ.2 align center
- * if ALIGHH.EQ.3 align right
- * else align left
- *
- * if ALIGNV.EQ.1 align top
- * if ALIGNV.EQ.2 align top
- * if ALIGNV.EQ.3 align middle
- * else align base
- */
-void
- ixsetta( align_h, align_v )
-int *align_h;
-int *align_v;
-{
- dwCommonTextAlign = 0;
- switch( *align_h ) {
-
- case 2:
- dwCommonTextAlign |= TA_CENTER;
- break;
-
- case 3:
- dwCommonTextAlign |= TA_RIGHT;
- break;
-
- default:
- dwCommonTextAlign |= TA_LEFT;
- }
-
-
- switch( *align_v ) {
-
- case 1:
- case 2:
- dwCommonTextAlign |= TA_TOP;
- align_vert = 1;
- break;
-
- case 3:
- dwCommonTextAlign |= TA_BASELINE;
- align_vert = 0;
- break;
-
- default:
- dwCommonTextAlign |= TA_BASELINE;
- align_vert = -1;
- }
-}
-
-/*___________________________________________________________________*/
-/*
- * FUNCTION IXSETTF(MODE,LENFNT,FONTNAME)
- * INTEGER *MODE : Option message
- * [0] : = 1 - Italic
- * [1] : = BOLD
- * [2] : = Height of the character
- * [3] : = Angle
- * [4] : = Precision
- * INTEGER LENFNT : font name length
- * CHARACTER*(*) FONT : font name
- *
- * Set text font to specified name. This function returns 0 if
- * the specified font is found, 1 if not.
- */
-int
- ixsettf( mode, lenfnt, fontname )
-char *fontname;
-int *mode;
-int *lenfnt;
-{
- HIGZFont.lfItalic = (BYTE) mode[0];
- HIGZFont.lfWeight = (LONG) mode[1]*100;
- HIGZFont.lfHeight = (LONG) mode[2]*1.1; // To account "tail"
- // HIGZFont.lfWidth = (LONG) mode[2]*1.2
- HIGZFont.lfEscapement = (LONG)mode[3];
- HIGZFont.lfOutPrecision = 0; // (LONG)mode[4];
- strcpy(HIGZFont.lfFaceName,fontname);
-
- if (hdCommonFont != NULL) DeleteObject(hdCommonFont);
- hdCommonFont = CreateFontIndirect(&HIGZFont);
-
- return 0;
- }
-
-
-/*___________________________________________________________________*/
-/*
- * SUBROUTINE IXSETTC(CINDEX)
- * INTEGER CINDEX : color index defined my IXSETCOL
- *
- * Set color index for text
- */
-void
- ixsettc( cindex )
-int *cindex;
-{
- dwCommonTextColor = HIGZColorIndex((COLORREF)(*cindex));
-}
-
-
-/*___________________________________________________________________*/
-/*
- * SUBROUTINE IXTEXT(MODE,X,Y,ANGLE,MGN,LENTXT,TEXT)
- * INTEGER MODE : drawing mode
- * MODE=0 : the background is not drawn
- * MODE=1 : the background is drawn
- * INTEGER X,Y : text position
- * REAL ANGLE : text angle
- * REAL MGN : magnification factor
- * INTEGER LENTXT : text length
- * CHARACTER*(*) TEXT : text string
- *
- * Draw a text string using current font
- */
-void
- ixtext( mode, x, y, angle, mgn, lentxt, text )
-char *text;
-int *mode;
-int *x, *y;
-float *angle;
-float *mgn;
-int *lentxt;
-{
- int dx = 0;
- int dy = 0;
- static struct {int mode,x,y,lentxt; float angle, mgn; char *text;} text_msg;
-
- text_msg.mode = *mode;
- text_msg.x = *x;
- text_msg.y = *y;
- text_msg.angle = *angle;
- text_msg.mgn = *mgn;
- text_msg.text = text;
- text_msg.lentxt=*lentxt;
-
- HIGZDrawing(MAKEWPARAM(IX_TEXT,HIGZ_Text), &text_msg);
-
-// do_raise = 1;
-}
-
-
-/*___________________________________________________________________*/
-/*
- * SUBROUTINE IXTXTL(IW,IH,LMESS,MESS)
- * INTEGER IW : text width
- * INTEGER IH : text height
- * INTEGER LMES : message length
- * CHARACTER*(*) MESS : message
- *
- * Return the size of a character string
- */
-void
- ixtxtl( w, h, lmess, mess )
-char *mess;
-int *lmess;
-int *w;
-int *h;
-{
- static struct { int w,h, lmess; char *mess;} sText;
- HIGZDrawing(MAKEWPARAM(IX_TXTL,HIGZ_Text), &sText);
- *w = sText.w;
- *h = sText.h;
-}
-
-
-/*___________________________________________________________________*/
-/*
- * SUBROUTINE IXBOX(X1,X2,Y1,Y2,MODE)
- * INTEGER X1,Y1 : left down corner
- * INTEGER X2,Y2 : right up corner
- * INTEGER MODE : drawing mode
- *
- * MODE=0 hollow
- * MODE=1 solid
- *
- * Draw a box
- */
-void
- ixbox( x1, x2, y1, y2, mode)
-int *x1, *x2, *y1, *y2;
-int *mode;
-{
- static struct { int x1, y1, x2, y2, mode;} box;
-
- box.mode = *mode;
- box.x1 = min(*x1,*x2);
- box.x2 = max(*x1,*x2);
- box.y1 = min(*y1,*y2);
- box.y2 = max(*y1,*y2);
-
- HIGZDrawing(MAKEWPARAM(IX_BOX,HIGZ_Primitive), &box);
-
-}
-
-/*___________________________________________________________________*/
- LRESULT APIENTRY
- Wnd_BOX(hwnd, uMsg, wParam, lParam)
- HWND hwnd;
- UINT uMsg;
- WPARAM wParam;
- LPARAM lParam;
- {
- struct { int x1, y1, x2, y2, mode;} *box;
- HGDIOBJ NewBrush, lpCurPen;
- static COLORREF CurTextColor;
-
- box = lParam;
- if (box->mode == 0) {
- if (box->x1 == box->x2 | box->y1 == box->y2) {
-/* Draw a line instead the rectangle */
- MoveToEx(CurrentDC,box->x1,box->y1,NULL);
- LineTo (CurrentDC,box->x2,box->y2);
- }
- else {
- CurBrush = SelectObject(CurrentDC, GetStockObject(HOLLOW_BRUSH));
- Rectangle(CurrentDC,box->x1, box->y1, box->x2, box->y2);
- DeleteObject(SelectObject(CurrentDC,CurBrush));
- }
- }
- else {
-// CurBrush = GetCurrentObject(CurrentDC,OBJ_BRUSH);
- if (gcfill.lbStyle == BS_PATTERN) {
- CurTextColor = SetTextColor(CurrentDC,HIGZColorIndex(gcfill.lbColor));
- FillRect(CurrentDC, (RECT*)box, hdCommonBrush);
- SetTextColor(CurrentDC,CurTextColor);
- }
- else
- FillRect(CurrentDC, (RECT*)box, hdCommonBrush);
- }
- return TRUE;
- }
-
-/*___________________________________________________________________*/
-/*
- * SUBROUTINE IXCA(X1,X2,Y1,Y2,NX,NY,IC)
- * INTEGER X1,Y1 : left down corner
- * INTEGER X2,Y2 : right up corner
- * INTEGER NX,NY : array size
- * INTEGER IC : array
- *
- * Draw a cell array. The drawing is done with the pixel presicion
- * if (X2-X1)/NX (or Y) is not a exact pixel number the position of
- * the top rigth corner may be wrong.
- */
-void
- ixca(x1, x2, y1, y2, nx, ny, ic)
-int *x1, *x2, *y1, *y2, *nx, *ny;
-int ic[];
-{
-
- static struct { int x1, x2, y1, y2, nx, ny; int *ic;} cell;
-
- cell.x1 = *x1;
- cell.x2 = *x2;
- cell.y1 = *y1;
- cell.y2 = *y2;
-
- cell.nx = *nx;
- cell.ny = *ny;
- cell.ic = ic;
-
- cell.x1 = *x1;
- HIGZDrawing(MAKEWPARAM(IX_CA,HIGZ_Primitive), &cell);
-}
-
-/*___________________________________________________________________*/
- LRESULT APIENTRY
- Wnd_CA(hwnd, uMsg, wParam, lParam)
- HWND hwnd;
- UINT uMsg;
- WPARAM wParam;
- LPARAM lParam;
- {
- int i,j,icol,ix,iy,w,h,hh,current_icol;
- struct { int x1, x2, y1, y2, nx, ny; int *ic;} *cell;
- HBRUSH CurCABrush = NULL;
- RECT box;
- cell = lParam;
-
- current_icol = -1;
- w = max((cell->x2-cell->x1)/(cell->nx),1);
- h = max((cell->y1-cell->y2)/(cell->ny),1);
- ix = cell->x1;
-
- box.bottom = cell->y1;
- box.top = cell->y1;
- box.left = cell->x1;
- box.right = box.left+h;
- for ( i=0; i<cell->nx; i++ ) {
- box.top -= h;
- for ( j=0; j<cell->ny; j++ ) {
- icol = cell->ic[i+(cell->nx*j)];
- if(icol != current_icol){
- if (CurCABrush != NULL) DeleteObject(CurCABrush);
- CurCABrush = CreateSolidBrush(HIGZColorIndex(icol));
- current_icol = icol;
- }
- FillRect(CurrentDC, &box, CurCABrush);
- box.bottom = box.top;
- box.top -= h;
- }
- box.left = box.right;
- box.right += w;
- }
-
- DeleteObject(CurCABrush);
- return TRUE;
- }
-
-
-/*___________________________________________________________________*/
-/*
- * SUBROUTINE IXDRMDE(MODE)
- * INTEGER MODE : drawing mode
- *
- * MODE=1 copy R2_COPYPEN
- * MODE=2 xor - R2_XORPEN
- * MODE=3 invert - R2_NOT
- *
- * Set the drawing mode
- */
-void
- ixdrmde( mode )
- int *mode;
-{
- static int OP[3] = {R2_COPYPEN, R2_XORPEN, R2_NOT};
- HIGZDrawing(MAKEWPARAM(IX_DRMDE,HIGZ_Attribute), OP[*mode]);
-}
-
-
-/*___________________________________________________________________*/
-/*
- * SUBROUTINE IXSYNC(MODE)
- * INTEGER MODE : synchronisation on/off
- *
- * MODE=1 on
- * MODE<>0 off
- *
- * Set synchronisation on or off
- */
-void
- ixsync( mode )
- int *mode;
-{
- int i;
-}
-
-
-/*___________________________________________________________________*/
-/*
- * INTEGER FUNCTION IXREQLO(MODE,CTYP,X,Y)
- * INTEGER X,Y : cursor position out moment of button press (output)
- * INTEGER CTYP : cursor type (input)
- *
- * CTYP=1 tracking cross
- * CTYP=2 cross-hair
- * CTYP=3 rubber circle
- * CTYP=4 rubber band
- * CTYP=5 rubber rectangle
- *
- * INTEGER MODE : input mode
- *
- * MODE=0 request
- * MODE=1 sample
- *
- * Request locator:
- * return button number 1 = left is pressed
- * 2 = middle is pressed
- * 3 = right is pressed
- * in sample mode:
- * 11 = left is released
- * 12 = middle is released
- * 13 = right is released
- * -1 = nothing is pressed or released
- * -2 = leave the window
- */
-int
- ixreqlo( mode, ctyp, x, y )
-int *mode, *ctyp, *x, *y;
-{
- static struct {int mode, ctyp, x, y, button; HANDLE semaphore;} HIGZmouse;
-
- HIGZmouse.x = *x;
- HIGZmouse.y = *y;
- HIGZmouse.ctyp = *ctyp;
- HIGZmouse.mode = *mode;
- HIGZmouse.semaphore = CreateSemaphore(NULL, 0, 1, NULL);
-
- SendMessage(CurrentHIGZWindow,
- IX11_HIGZ_Input,MAKEWPARAM(IX_REQLO,HIGZ_Input),&HIGZmouse);
-
- WaitForSingleObject(HIGZmouse.semaphore, INFINITE);
- CloseHandle(HIGZmouse.semaphore);
-
- *x = HIGZmouse.x;
- *y = HIGZmouse.y;
- return HIGZmouse.button;
-
-}
-
-/*___________________________________________________________________*/
- LRESULT APIENTRY
- Wnd_REQLO(hwnd, uMsg, wParam, lParam)
- HWND hwnd;
- UINT uMsg;
- WPARAM wParam;
- LPARAM lParam;
- {
- /* Global for draw cursor utilities variables */
- static struct {int mode, ctyp, x, y, button; HANDLE semaphore;} *lpHIGZmouse;
-
-
- SetSystemPaletteUse(cHw->hdcWindow,SYSPAL_NOSTATIC);
- RealizePalette(cHw->hdcWindow);
-
- cHw->button_press = 0;
- cHw->button_up = 0;
- switch (uMsg) {
- case WM_RBUTTONUP:
- cHw->button_up++;
- case WM_MBUTTONUP:
- cHw->button_up++;
- case WM_LBUTTONUP:
- cHw->button_up++;
- cHw->button_press++;
- case WM_RBUTTONDOWN:
- cHw->button_press++;
- case WM_MBUTTONDOWN:
- cHw->button_press++;
- case WM_LBUTTONDOWN:
- cHw->button_press++;
- case WM_MOUSEMOVE:
-
- /* Clean an old position */
-
- DrawHIGZCursor(lpHIGZmouse->ctyp);
-
- /* Plot new cursor position */
-
- cHw->loc.x = (LONG) (MAKEPOINTS(lParam).x);
- cHw->loc.y = (LONG) (MAKEPOINTS(lParam).y);
- DPtoLP(CurrentDC,&(cHw->loc),1);
- DrawHIGZCursor(lpHIGZmouse->ctyp);
-
- /* Reset system cursor near the bord id frame */
-
- if (lpHIGZmouse->mode) {
- if (cHw->button_press == 0)
- cHw->button_press = -1;
- else if (cHw->button_press == 4)
- cHw->button_press = cHw->button_up+10;
- RestoreHIGZ(lpHIGZmouse->ctyp);
- lpHIGZmouse->x = cHw->loc.x ; lpHIGZmouse->y = cHw->loc.y ;
- lpHIGZmouse->button = cHw->button_press;
-
-// RestoreDC(CurrentDC,-1);
- ReleaseSemaphore(lpHIGZmouse->semaphore,1L,NULL);
-
- }
- else if (cHw->button_press > 0 & cHw->button_up ==0) {
- RestoreHIGZ(lpHIGZmouse->ctyp);
- lpHIGZmouse->x = cHw->loc.x ; lpHIGZmouse->y = cHw->loc.y;
- lpHIGZmouse->button = cHw->button_press;
-
- ReleaseSemaphore(lpHIGZmouse->semaphore,1L,NULL);
- }
-
- break;
- case IX11_HIGZ_Input:
- lpHIGZmouse = lParam;
- cHw->loc.x = lpHIGZmouse->x; cHw->loc.y = lpHIGZmouse->y;
- cHw->locp.x = lpHIGZmouse->x; cHw->locp.y = lpHIGZmouse->y;
-
- HIGZCursorInit(hwnd,lpHIGZmouse->ctyp);
- break;
- default:
- break;
- }
-}
-
- DrawHIGZCursor( ctyp)
- int ctyp;
- {
- int radius, CurMxX, CurMxY;
- POINT loc,locp;
- loc.x = cHw->loc.x;
- loc.y = cHw->loc.y;
-
- locp.x = cHw->locp.x;
- locp.y = cHw->locp.y;
-
- CurMxX = cHw->HIGZWindowSize.right;
- CurMxY = cHw->HIGZWindowSize.bottom;
-
- switch ( ctyp ) {
-
- case 1 : /* Default HIGZ window cursor is CROSS -> do nothing here */
- /*
- * MoveToEx(CurrentDC,max(0,loc.x-10), loc.y,NULL);
- * LineTo (CurrentDC,min(CurMxX,loc.x+10),loc.y);
-
- * MoveToEx(CurrentDC,loc.x,max(0,loc.y-10) ,NULL);
- * LineTo (CurrentDC,loc.x,min(CurMxY,loc.y+10));
- */
- break;
-
- case 2 : MoveToEx(CurrentDC,0, loc.y,NULL);
- LineTo (CurrentDC,CurMxX,loc.y);
-
- MoveToEx(CurrentDC,loc.x,0, NULL);
- LineTo (CurrentDC,loc.x,CurMxY);
-
- break;
-
- case 3 : radius = (int) sqrt((double)((loc.x-locp.x)*(loc.x-locp.x)+
- (loc.y-locp.y)*(loc.y-locp.y)));
- Pie(CurrentDC,locp.x-radius,locp.y-radius,
- locp.x+radius,locp.y+radius,
- locp.x-radius,locp.y-radius,
- locp.x-radius,locp.y-radius);
- break;
-
- case 4 : MoveToEx(CurrentDC,loc.x, loc.y, NULL);
- LineTo (CurrentDC,locp.x,locp.y);
- break;
-
- case 5 : Rectangle(CurrentDC,locp.x, locp.y, loc.x, loc.y);
- break;
- default:
- break;
- }
- }
-
-/*___________________________________________________________________*/
- HIGZCursorInit(hwnd,ctyp)
- HWND hwnd;
- int ctyp;
- {
- SaveDC(CurrentDC);
- /* Create Brush or Pen to draw HIGZ graphics cursor */
-
- SelectObject(CurrentDC,hdCursorPen);
- if (ctyp == 3 | ctyp == 5)
- SelectObject(CurrentDC, hdCursorBrush);
-
- /* Suspend current clipping */
-
- SelectClipRgn(CurrentDC, NULL);
-
-
- /* Set a new mix mode to XOR */
-
- SetROP2(CurrentDC,R2_NOT);
-
- /* Set Cursor on the screen */
- DrawHIGZCursor(ctyp);
- cHw->MouseInit = ctyp;
- }
-
-/*___________________________________________________________________*/
-RestoreHIGZ(int ctyp)
- {
- cHw->MouseInit = 0;
-/* Clean cursor off the screen */
- DrawHIGZCursor(ctyp);
- RestoreDC(CurrentDC,-1);
- }
-
-
-/*___________________________________________________________________*/
-/*
- * INTEGER FUNCTION IXREQST(X,Y,TEXT)
- * INTEGER X,Y : position where text is displayed
- * CHARACTER*(*) TEXT : text displayed (input), edited text (output)
- *
- * Request string:
- * text is displayed and can be edited with Emacs-like keybinding
- * return termination code (0 for ESC, 1 for RETURN)
- */
-int
- ixreqst( x, y, len_text, text )
-char *text;
-int *len_text;
-int *x, *y;
-{
- static struct {int x, y, len_tex; char *text;
- int BreakKey; HANDLE semaphore;}
- HIGZText;
- HIGZText.x = *x;
- HIGZText.y = *y;
- HIGZText.len_tex = *len_text;
- HIGZText.text = text;
- HIGZText.BreakKey = -1;
- HIGZText.semaphore = CreateSemaphore(NULL, 0, 1, NULL);
-
- SendMessage(CurrentHIGZWindow,
- IX11_HIGZ_Input,MAKEWPARAM(IX_REQST,HIGZ_Input),&HIGZText);
-
- WaitForSingleObject(HIGZText.semaphore, INFINITE);
- CloseHandle(HIGZText.semaphore);
-
- return HIGZText.BreakKey;
-
-}
-
-/*___________________________________________________________________*/
- int CharWidth(ch)
- char ch;
- {int LenOfChar;
- GetCharWidth(CurrentDC, (UINT) ch, (UINT) ch, &LenOfChar);
- return LenOfChar;}
-
-/*___________________________________________________________________*/
- LRESULT APIENTRY
- Wnd_REQST(hwnd, uMsg, wParam, lParam)
- HWND hwnd;
- UINT uMsg;
- WPARAM wParam;
- LPARAM lParam;
- {
-#define ixg(x) (ix0+x)
-#define iyg(y) (iy0+y)
- /* Application message */
- static struct {int x, y, len_tex; char *text;
- int BreakKey; HANDLE semaphore;}
- *lpHIGZText;
-
- static char ch; // entered symbol
- static char *lpInstr; // Input line buffer
- static int nCur, // Current text cursor postion
- lStr, // Current length of the entered string
- pt, // Current symbol position
- BreakKey, // Code of the entered "End of Line" terminator
- nCharWidth, // Width of the current symbol
- LenLine, // Pixel length of the entered string
- ix0,iy0;
- static char *Instr; // temporary buffer
-
-
- static int insert;
- int i;
-
- switch (uMsg) {
- case WM_CHAR:
- switch(wParam) {
-
- case 0x0A: /* line feed */
- case 0x0D: /* carriage return */
- (lpHIGZText->BreakKey)++;
- case 0x1B: /* escape */
- (lpHIGZText->BreakKey)++;
-
- cHw->SetTextInput = FALSE;
- HideCaret(hwnd);
- DestroyCaret();
- if (lpHIGZText->len_tex > 0) {
- for (i=0;i<lStr;i++) lpInstr[i] = Instr[i];
- for (i=lStr; i<lpHIGZText->len_tex; i++) lpInstr[i]=' ';
- free(Instr);
- }
-
-
-/* End of text input from keyboard
- * and restore previous active window
- */
- SetActiveWindow(ConWindow);
- SetFocus(ConWindow);
-
- ReleaseSemaphore(lpHIGZText->semaphore,1L,NULL);
- break;
-
- case 0x09: /* Tab */
- case 0x08: /* backspace */
- break;
- default: /* all other letters */
- ch = (TCHAR) wParam;
- HideCaret(hwnd);
-
- if (nCur != lStr){/* Clear the old tail of the string */
- COLORREF CurTextCol;
- CurTextCol = SetTextColor(CurrentDC,GetBkColor(CurrentDC));
- TextOut(CurrentDC,ixg(ixText),iyg(iyText),
- &Instr[nCur],lStr-nCur);
- SetTextColor(CurrentDC,CurTextCol);
- }
- if (insert==1) {/* Shift string */
- for (i=lStr; i>nCur; i--) Instr[i] = Instr[i-1];
- /* Increasing of the acctual length */
- lStr++;
- Instr[lStr] = 0x0;
- }
- else if (nCur == lStr) lStr++;
- else // reduce length of string
- LenLine -= CharWidth(Instr[nCur]);
-
-/* Put enreted symbol in place */
- Instr[nCur] = ch;
-/* Out the new tail of the text */
- TextOut(CurrentDC,ixg(ixText),iyg(iyText),
- &Instr[nCur],lStr-nCur);
-
- LenLine += CharWidth(ch); // pixel length of entered string
- ixText += CharWidth(ch); // Reset Graphics position for next input
- nCur++;
- break;
- }
- SetCaretPos(ixg(ixText),iyg(iyText-(cHw->dwAscent) ));
- ShowCaret(hwnd);
- return 0;
- case WM_KEYDOWN:
- HideCaret(hwnd);
- switch(wParam) {
- case VK_LEFT:
- nCur--;
- ixText -= CharWidth(Instr[nCur]);
- break;
- case VK_RIGHT:
- ixText += CharWidth(Instr[nCur]);
- nCur++;
- break;
- case VK_HOME:
- ixText = 0;
- nCur = 0;
- break;
- case VK_END:
- ixText = LenLine;
- nCur = lStr;
- break;
- case VK_INSERT:
- insert = -insert;
- break;
- case VK_DELETE:
-/* Clear the old tail of the string */
- { COLORREF CurTextCol;
- CurTextCol = SetTextColor(CurrentDC,GetBkColor(CurrentDC));
- TextOut(CurrentDC,ixg(ixText),iyg(iyText), &Instr[nCur],lStr-nCur);
- SetTextColor(CurrentDC,CurTextCol);
- }
-/* Reduce current lenght of string */
- LenLine -= CharWidth(Instr[nCur]);
-
- for (i=nCur; i<lStr;i++)
- Instr[i] = Instr[i+1];
- lStr = max(lStr-1, nCur);
- if (lStr != nCur)
- TextOut(CurrentDC,ixg(ixText),iyg(iyText), &Instr[nCur],lStr-nCur);
- else
- Beep(1000L,100L);
- break;
-
- case VK_BACK:
- nCur--;
- if (nCur >= 0) {
-/* Clear the old tail of the string */
- ixText -= CharWidth(Instr[nCur]);
- { COLORREF CurTextCol;
- CurTextCol = SetTextColor(CurrentDC,GetBkColor(CurrentDC));
- TextOut(CurrentDC,ixg(ixText),iyg(iyText), &Instr[nCur],lStr-nCur);
- SetTextColor(CurrentDC,CurTextCol);
- }
-/* Reduce current lenght of string */
- LenLine -= CharWidth(Instr[nCur]);
-
- for (i=nCur; i<lStr;i++)
- Instr[i] = Instr[i+1];
- lStr = max(lStr-1, nCur);
- if (lStr != nCur)
- TextOut(CurrentDC,ixg(ixText),iyg(iyText), &Instr[nCur],lStr-nCur);
- } else {
- Beep(1000L,100L);
- nCur = 0;
- }
- break;
- default:
- return DefWindowProc(hwnd,uMsg, wParam, lParam);
- }
- SetCaretPos(ixg(ixText),iyg(iyText-(cHw->dwAscent)));
- ShowCaret(hwnd);
- return 0; // User procedure SHOULD return ZERO if it is process
- case IX11_HIGZ_Input:
- lpHIGZText = lParam;
- /* Write TEXT to the pointed position on the screen */
- ix0 = lpHIGZText->x;
- iy0 = lpHIGZText->y;
- ixText = 0;
- iyText = 0;
-/* Init of string input */
- lpInstr = lpHIGZText->text;
- nCur = 0;
- lStr = 0;
- insert = 1;
-
- if (lpHIGZText->len_tex >0 ) {
- Instr = malloc(lpHIGZText->len_tex);
- Instr[0] = 0x0;
- }
- LenLine = 0;
-
-
-/* Create and set Caret */
-
- CreateCaret(hwnd, (HBITMAP) 1, cHw->dwCharX, cHw->dwAscent);
- SetCaretPos(ixg(ixText),iyg(iyText-(cHw->dwAscent)));
- ShowCaret(hwnd);
-
- SetFocus(hwnd);
- ConWindow = SetActiveWindow(hwnd);
-
- cHw->SetTextInput = TRUE;
-
- break;
- default: break;
- }
- }
-
-
-/*___________________________________________________________________*/
-/* SUBROUTINE IGERR(ERRTEX,RNAME)
-*.===========>
-*.
-*. This prints on the screen the error message (ERRTEX) and
-*. the routine name (RNAME). This routine sets also IQUEST(1)
-*. to 1. If RNAME equal ' ' only a warning is printed and
-*. IQUEST(1) is sets to 0.
-*.
-*. _Input parameters:
-*.
-*. INTEGER ERRTEX : Error text .
-*. CHARACTER RNAME : Routine name .
-*.
-*.
-*/
-
- void igerr(errtex,rname,lerr,lname)
- char *errtex, *rname;
- int lerr, lname;
- {
- struct {
- int iquest[100];
- } quest_;
-
-#define quest_1 quest_
-
- LPCTSTR lpszText; /* address of text in message box */
- LPCTSTR lpszTitle; /* address of title of message box */
- lpszText = malloc(lerr);
- strcpy(lpszText,string(errtex,lerr));
- if (lname <= 1 & rname[0] == ' ') {
- /* This is a warning message */
- lpszTitle = malloc(15);
- strcpy(lpszTitle,"*** Warning ***");
- MessageBox(NULL, lpszText, lpszTitle,
- MB_OK | MB_SETFOREGROUND | MB_ICONEXCLAMATION);
- quest_1.iquest[0] = 0;
- }
- else {
- /* This is an error message */
- lpszTitle = malloc(lname+18);
- strcpy(lpszTitle,"*** ERROR in ");
- strcat(lpszTitle,string(rname,lname));
- strcat(lpszTitle," ***");
- MessageBox(NULL, lpszText, lpszTitle,
- MB_OK | MB_SETFOREGROUND | MB_ICONHAND);
- quest_1.iquest[0] = 1;
- }
- free(lpszTitle);
- free(lpszText);
- }
-
-/*___________________________________________________________________*/
- wrtlst(wid, mess, lmess)
- HWND *wid;
- char *mess;
- int *lmess;
- {
- SendMessage(*wid,LB_ADDSTRING,0, (LPARAM) string(mess,*lmess));
- }
-
-/*___________________________________________________________________*/
- clrlst(wid)
- HWND *wid;
- {
- int n;
- if (n = SendMessage(*wid,LB_GETCOUNT,0,0) != LB_ERR)
- SendMessage(*wid,LB_DELETESTRING,(WPARAM) n, 0);
- }
-
- ixbord()
- {bord = ~bord;}
-
diff --git a/src/graflib/higz/iwin32/ix_win32.h b/src/graflib/higz/iwin32/ix_win32.h
deleted file mode 100644
index 91f7b8e..0000000
--- a/src/graflib/higz/iwin32/ix_win32.h
+++ /dev/null
@@ -1,2 +0,0 @@
-#include "ix_higz.h"
-
diff --git a/src/graflib/higz/iwin32/makefile b/src/graflib/higz/iwin32/makefile
deleted file mode 100644
index b849ad9..0000000
--- a/src/graflib/higz/iwin32/makefile
+++ /dev/null
@@ -1,68 +0,0 @@
-# Some nmake macros for Win32 apps development
-
-!include <f77.mak>
-!include <ntwin32.mak>
-
-PROJ = hplexam
-
-# application specific C defines
-
-# Fortram compilers specifics:
-
-.SUFFIXES: .f
-
-#for = f2c
-
-!IF "$(FOR)" != "f77"
-for = f2c
-FFLAGS = -w -Nn802 -Nx802 -NL802
-flib = f2c.lib
-!ELSE
-for = $(f77)
-FFLAGS = $(fflags) -align:dcommon -align:records -debug:full
-flib = $(f77libs)
-!ENDIF
-
-# Rules to constract obj either under f2c or under "native" FORTRAN
-
-.f.obj:
-!IF "$(for)" == "f2c"
- $(for) $(fflags) $*.f
- $(cc) $(cflags) $(cvars) $(cdebug) $(cf) /Op /Yd /Zi $*.c >> $*_c.log
-!ELSE
- $(for) $(FFLAGS) $*.f /nolink /object:$@ >>$*_f.log
-!ENDIF
-
-.c.obj:
- $(cc) /Op /Yd /Zi $(cflags) $(cvars) $(cdebug) $(cf) $*.c >$*.log
-
-
-
-cf = -DNT -DWIN -DNOT_IMPLEMENTED -D_MT -D_PORTABLE_32BIT_CONTEXT
-
-# This line allows NMAKE to work as well
-
-all: $(PROJ).exe
-
-IX_HIGZ.obj: IX_HIGZ.c IX_HIGZ.h
-
-IW_TEXT.obj: IW_TEXT.c IX_HIGZ.h IW_TEXT.H
-
-# Update the executable file if necessary, and if so, add the resource back in.
-IX_HIGZ.exp: IX_HIGZ.def IX_HIGZ.obj IW_TEXT.obj
- $(implib) /out:$*.lib $*.obj IW_TEXT.obj /def:$*.def
-
-IX_HIGZ.dll: IX_HIGZ.obj IW_TEXT.obj IX_HIGZ.exp
- $(link) /out:$*.dll /dll /entry:_CRT_INIT$(DLLENTRY) $(linkdebug) \
- $*.obj IW_TEXT.obj $*.exp \
- $(guilibs)
-
-$(PROJ).exe: $(PROJ).obj
- $(link) $(linkdebug) $(conflags) -out:$(PROJ).exe \
- $(PROJ).obj \
- ix_higz.lib \
- d:\cern\lib\94a\hplot.lib d:\cern\lib\94a\higz.lib \
- d:\cern\lib\94a\hbook.lib \
- d:\cern\lib\94a\zebra.lib d:\cern\lib\94a\math.lib \
- d:\cern\lib\94a\kern.lib \
- $(flib) $(guilibs)
diff --git a/src/graflib/higz/iwin32/makefile.mak b/src/graflib/higz/iwin32/makefile.mak
deleted file mode 100644
index ac02749..0000000
--- a/src/graflib/higz/iwin32/makefile.mak
+++ /dev/null
@@ -1,68 +0,0 @@
-# Some nmake macros for Win32 apps development
-
-# !include <f77.mak>
-!include <ntwin32.mak>
-
-PROJ = hplexam
-
-# application specific C defines
-
-# Fortran compilers specifics:
-
-.SUFFIXES: .f
-
-#for = f2c
-
-!IF "$(FOR)" != "f77"
-for = f2c
-FFLAGS = -w -Nn802 -Nx802 -NL802
-flib = f2c.lib
-!ELSE
-for = $(f77)
-FFLAGS = $(fflags) -align:dcommon -align:records -debug:full
-flib = $(f77libs)
-!ENDIF
-
-# Rules to constract obj either under f2c or under "native" FORTRAN
-
-.f.obj:
-!IF "$(for)" == "f2c"
- $(for) $(fflags) $*.f
- $(cc) $(cflags) $(cvarsdll) -O2 $*.c >> $*_c.log
-!ELSE
- $(for) $(FFLAGS) $*.f /nolink /object:$@ >>$*_f.log
-!ENDIF
-
-.c.obj:
- $(cc) -c -O2 $(cflags) $(cvarsdll) /G5 $*.c >$*.log
-
-
-
-cf = -DNT -DWIN -DNOT_IMPLEMENTED -D_MT -D_PORTABLE_32BIT_CONTEXT
-
-# This line allows NMAKE to work as well
-
-all: $(PROJ).exe
-
-IX_HIGZ.obj: IX_HIGZ.c IX_HIGZ.h
-
-IW_TEXT.obj: IW_TEXT.c IX_HIGZ.h IW_TEXT.H
-
-# Update the executable file if necessary, and if so, add the resource back in.
-IX_HIGZ.exp: IX_HIGZ.def IX_HIGZ.obj IW_TEXT.obj
- $(implib) /out:$*.lib $*.obj IW_TEXT.obj /def:$*.def
-
-IX_HIGZ.dll: IX_HIGZ.obj IW_TEXT.obj IX_HIGZ.exp
- $(link) /out:$*.dll $(dlllflags) \
- $*.obj IW_TEXT.obj $*.exp \
- $(guilibsdll)
-
-$(PROJ).exe: $(PROJ).obj
- $(link) $(linkdebug) $(conflags) -out:$(PROJ).exe \
- $(PROJ).obj \
- ix_higz.lib \
- \misf58\cern\lib\hplot.lib \misf58\cern\lib\higz.lib \
- \misf58\cern\lib\94a\hbook.lib \
- \misf58\cern\lib\zebra.lib \misf58\cern\lib\mathlib.lib \
- \misf58\cern\lib\kernlib.lib \
- $(flib) $(guilibs)
diff --git a/src/graflib/higz/iz/Imakefile b/src/graflib/higz/iz/Imakefile
deleted file mode 100644
index 7d69bc2..0000000
--- a/src/graflib/higz/iz/Imakefile
+++ /dev/null
@@ -1,30 +0,0 @@
-DoIncludePackage(higz)
-#include "pilot.h"
-
-SRCS_F= izctoi.F izctor.F izitoc.F izpave.F izrtoc.F izsav.F izsava.F \ @@\
- izset.F izseta.F
-
-#if defined(CERNLIB_ZEBRA)
-SRCS_F := $(SRCS_F) izcda.F izcfa.F izcopy.F izdatt.F izdipi.F izdnb.F \ @@\
- izfa3.F izfile.F izgadr.F izgcod.F izghnp.F izgngt.F izgnnt.F \ @@\
- izgntp.F izin.F izincf.F izinci.F izincs.F izinit.F izmerg.F \ @@\
- izml3.F izopen.F izout.F izpict.F izpl3.F izpm3.F izpush.F \ @@\
- izrpip.F izscan.F izscpi.F izscr.F izsenv.F izstcc.F iztx3.F \ @@\
- izwip.F
-#endif
-
-#if defined(CERNLIB_ZEBRA) || defined(CERNLIB_MAIL)
-SRCS_F := $(SRCS_F) izarc.F izatt.F izaxis.F izend.F izfbox.F izgrap.F \ @@\
- izhist.F izlbl.F izml.F izscor.F iztabl.F iztext.F
-#endif
-
-#if defined(CERNLIB_ZEBRA) || defined(CERNLIB_MAIL) || defined(CERNLIB_PSCRIPT)
-SRCS_F := $(SRCS_F) izbox.F izclrd.F izfa.F izpl.F izpm.F izscli.F \ @@\
- izseln.F iztx.F
-#endif
-
-#if !defined(CERNLIB_NTC) && !defined(CERNLIB_X11)
-SRCS_F := $(SRCS_F) izgnt.F
-#endif
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/graflib/higz/iz/Imakefile.dgks b/src/graflib/higz/iz/Imakefile.dgks
deleted file mode 100644
index b90c654..0000000
--- a/src/graflib/higz/iz/Imakefile.dgks
+++ /dev/null
@@ -1,34 +0,0 @@
-DoIncludePackage(higz)
-#include "pilot.h"
-
-SRCS_F= izctoi.F izctor.F izitoc.F izpave.F izrtoc.F izsav.F izsava.F \ @@\
- izset.F izseta.F
-
-#if defined(CERNLIB_ZEBRA)
-SRCS_F := $(SRCS_F) izcda.F izcfa.F izcopy.F izdatt.F izdipi.F izdnb.F \ @@\
- izfa3.F izfile.F izgadr.F izgcod.F izghnp.F izgngt.F izgnnt.F \ @@\
- izgntp.F izin.F izincf.F izinci.F izincs.F izinit.F izmerg.F \ @@\
- izml3.F izopen.F izout.F izpict.F izpl3.F izpm3.F izpush.F \ @@\
- izrpip.F izscan.F izscpi.F izscr.F izsenv.F izstcc.F iztx3.F \ @@\
- izwip.F
-#endif
-
-#if defined(CERNLIB_ZEBRA) || defined(CERNLIB_MAIL)
-SRCS_F := $(SRCS_F) izarc.F izatt.F izaxis.F izend.F izfbox.F izgrap.F \ @@\
- izhist.F izlbl.F izml.F izscor.F iztabl.F iztext.F
-#endif
-
-#if defined(CERNLIB_ZEBRA) || defined(CERNLIB_MAIL) || defined(CERNLIB_PSCRIPT)
-SRCS_F := $(SRCS_F) izbox.F izclrd.F izfa.F izpl.F izpm.F izscli.F \ @@\
- izseln.F iztx.F
-#endif
-
-#if !defined(CERNLIB_NTC) && !defined(CERNLIB_X11)
-SRCS_F := $(SRCS_F) izgnt.F
-#endif
-
-SubdirExtraLibraryTarget(NullParameter,NullParameter,NullParameter,dgks)
-
-VersionFortranObjectRule(dgks,NullParameter,-DCERNLIB_DECGKS)
-
-BuildNamedMakefileTarget(Makefile.dgks,Imakefile.dgks,-DCERNLIB_DECGKS)
diff --git a/src/graflib/higz/iz/izarc.F b/src/graflib/higz/iz/izarc.F
deleted file mode 100644
index fffd280..0000000
--- a/src/graflib/higz/iz/izarc.F
+++ /dev/null
@@ -1,72 +0,0 @@
-*
-* $Id: izarc.F,v 1.2 1996/11/20 15:21:44 couet Exp $
-*
-* $Log: izarc.F,v $
-* Revision 1.2 1996/11/20 15:21:44 couet
-* *** empty log message ***
-*
-* Revision 1.1.1.1 1996/02/14 13:11:08 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_MAIL)
- SUBROUTINE IZARC(X,Y,R1,R2,PHI1,PHI2)
-*.===========>
-*.
-*. This routine stores in the current picture the necessary data to
-*. draw an arc of circle .
-*.
-*. _Input parameters:
-*.
-*. REAL X,Y : Center of the arc .
-*. REAL R1 : First radius .
-*. REAL R2 : Second radius .
-*. REAL PHI1 : First angle .
-*. REAL PHI2 : Second angle .
-*.
-*..==========> (O.Couet)
-#include "higz/hicode.inc"
-#include "higz/hiflag.inc"
-#if defined(CERNLIB_ZEBRA)
-#include "higz/hipaw.inc"
-#endif
-#if defined(CERNLIB_MAIL)
-#include "higz/himail.inc"
-#endif
-*.______________________________________
-*
-#if defined(CERNLIB_ZEBRA)
- IF(ZFLAG)THEN
- IF(LPICT.LT.0)RETURN
- IF(IZPUSH(0,6,0,'IGARC').NE.0)RETURN
- CALL IZCFA(IFAICO,1)
- CALL IZCFA(IFASCO,1)
- CALL IZCFA(ILNCO,1)
- CALL IZCFA(ILWSCO,1)
- CALL IZCFA(IPLCCO,1)
- CALL IZCFA(IFACCO,1)
- CALL IZCFA(IBORCO,1)
-*
- CALL IZSTCC(IARCCO,IFLPTR)
- Q(LHF+IFLPTR)=X
- Q(LHF+IFLPTR+1)=Y
- Q(LHF+IFLPTR+2)=R1
- Q(LHF+IFLPTR+3)=R2
- Q(LHF+IFLPTR+4)=PHI1
- Q(LHF+IFLPTR+5)=PHI2
- CALL IZINCF(6)
- ENDIF
-#endif
-#if defined(CERNLIB_MAIL)
-*
- IF(MFLAG)THEN
- WRITE (CHMAIL,'(I3,4E16.7)') IARCCO,X,Y,R1,R2
- CALL IMWRIT(1)
- WRITE (CHMAIL,'(2E16.7)') PHI1,PHI2
- CALL IMWRIT(3)
- ENDIF
-#endif
-*
- END
-#endif
diff --git a/src/graflib/higz/iz/izatt.F b/src/graflib/higz/iz/izatt.F
deleted file mode 100644
index b5f5f8e..0000000
--- a/src/graflib/higz/iz/izatt.F
+++ /dev/null
@@ -1,123 +0,0 @@
-*
-* $Id: izatt.F,v 1.1.1.1 1996/02/14 13:11:08 mclareni Exp $
-*
-* $Log: izatt.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:08 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_MAIL)
-*CMZ : 1.21/05 16/06/94 14.50.16 by O.Couet
-*-- Author :
- SUBROUTINE IZATT(IATTCO)
-*.===========>
-*.
-*. This routine stores in the current picture the REAL and INTEGER
-*. HIGZ attributes. When an INTEGER attribute is stored in the data
-*. structure, 100000 is added to the value of this attribute to
-*. prevent the negatives values of some INTEGER attributes. In this
-*. routine the case of the option MAIL is also managed.
-*. If CFLAG is true (default), attributes are stored only if they are
-*. different from the current value in the bank. If CFLAG is false, they
-*. are always stored. The value of CFLAG can be cahnged via a call to
-*. IGZSET ('E' ==> false, 'C' ==> true).
-*.
-*. _Input parameters:
-*.
-*. INTEGER IATTCO : Attribute code
-*.
-*..==========> (O.Couet)
-#if defined(CERNLIB_ZEBRA)
-#include "higz/hipaw.inc"
-#endif
-#if defined(CERNLIB_MAIL)
-#include "higz/himail.inc"
-#endif
-#include "higz/hiatnb.inc"
-#include "higz/hiatt.inc"
-#include "higz/hiflat.inc"
-#include "higz/hiflag.inc"
-#include "higz/hiaadr.inc"
- DIMENSION RATVAL(NBRATT)
- EQUIVALENCE (RATVAL(1),RMKSC)
- DIMENSION IATVAL(NBIATT)
- EQUIVALENCE (IATVAL(1),IPLCI)
- DIMENSION IRFLAT(NBRATT),IIFLAT(NBIATT)
- EQUIVALENCE (IRFLAT(1),KMKSC),(IIFLAT(1),KPLCI)
-*.______________________________________
-*
-#if defined(CERNLIB_ZEBRA)
- IF(ZFLAG)THEN
- IF(LPICT.LT.0)RETURN
- IPOS=IATADR(IATTCO-49)
- IF(IPOS.LT.0)CALL IZSCAN(LHNT,IATTCO,ITBPTR-1,-1,IPOS)
- IATADR(IATTCO-49)=IPOS
-*
- IF(IATTCO.LT.80)THEN
- INDEX=IATTCO-49
- IF(IRFLAT(INDEX).NE.0)THEN
- IF(IPOS.EQ.0)THEN
- IF((Q(LHF+IRAPTR+INDEX-1).EQ.RATVAL(INDEX))
- + .AND.CFLAG)RETURN
- GOTO 10
- ELSE
- IF((Q(LHF+IZGADR(LHNT,IPOS)).EQ.RATVAL(INDEX))
- + .AND.CFLAG)RETURN
- GOTO 10
- ENDIF
- 10 IF(IZPUSH(0,1,0,'IZATT').NE.0)RETURN
- IATADR(IATTCO-49)=ITBPTR
- CALL IZSTCC(IATTCO,IFLPTR)
- Q(LHF+IFLPTR)=RATVAL(INDEX)
- CALL IZCFA(IATTCO,0)
- CALL IZINCF(1)
- ELSE
- IF(IPOS.EQ.0)THEN
- CALL IZCDA(IATTCO)
- ELSE
- Q(LHF+IZGADR(LHNT,IPOS))=RATVAL(INDEX)
- ENDIF
- ENDIF
- ELSE
- INDEX=IATTCO-79
- IF(IIFLAT(INDEX).NE.0)THEN
- IF(IPOS.EQ.0)THEN
- IF((IQ(LHI+IIAPTR+INDEX-1).EQ.IATVAL(INDEX))
- + .AND.CFLAG)RETURN
- GOTO 20
- ELSE
- IF((IZGADR(LHNT,IPOS).EQ.(IATVAL(INDEX)+100000))
- + .AND.CFLAG)RETURN
- GOTO 20
- ENDIF
- 20 IF(IZPUSH(0,0,0,'IZATT').NE.0)RETURN
- IATADR(IATTCO-49)=ITBPTR
- CALL IZSTCC(IATTCO,IATVAL(INDEX)+100000)
- CALL IZCFA(IATTCO,0)
- ELSE
- IF(IPOS.EQ.0)THEN
- CALL IZCDA(IATTCO)
- ELSE
- IQ(LHNT+IPOS)=1000000*IATTCO+(IATVAL(INDEX)+100000)
- ENDIF
- ENDIF
- ENDIF
- ENDIF
-#endif
-#if defined(CERNLIB_MAIL)
-*
- IF(MFLAG)THEN
- IF(IATTCO.LT.80)THEN
- IND=IATTCO-49
- WRITE (CHMAIL,'(I3,E16.7)') IATTCO,RATVAL(IND)
- ELSE
- IND=IATTCO-79
- WRITE (CHMAIL,'(I3,E16.7)') IATTCO,FLOAT(IATVAL(IND))
- ENDIF
- CALL IMWRIT(4)
- ENDIF
-#endif
-*
- END
-#endif
diff --git a/src/graflib/higz/iz/izaxis.F b/src/graflib/higz/iz/izaxis.F
deleted file mode 100644
index c66875c..0000000
--- a/src/graflib/higz/iz/izaxis.F
+++ /dev/null
@@ -1,84 +0,0 @@
-*
-* $Id: izaxis.F,v 1.1.1.1 1996/02/14 13:11:08 mclareni Exp $
-*
-* $Log: izaxis.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:08 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_MAIL)
-*CMZ : 1.11/00 03/10/90 11.54.57 by O.Couet
-*-- Author :
- SUBROUTINE IZAXIS(X0,X1,Y0,Y1,WMIN,WMAX,NDIV,IOPT)
-*.===========>
-*.
-*. This routine store in the current picture the necessary data to
-*. draw an axis .
-*.
-*. _Input parameters:
-*.
-*. REAL X0 : X origin axis coordinate in WC space .
-*. REAL X1 : X end axis coordinate in WC space .
-*. REAL Y0 : Y origin axis coordinate in WC space .
-*. REAL Y1 : Y end axis coordinate in WC space .
-*. REAL WMIN : Lowest value for the tick marks labels written on axis .
-*. REAL WMAX : Highest value for the tick marks labels written on axis .
-*. INTEGER NDIV : Number of division .
-*. INTEGER IOPT : Option . (See IGAXIS comments)
-*.
-*..==========> (O.Couet)
-#include "higz/hicode.inc"
-#include "higz/hiflag.inc"
-#if defined(CERNLIB_ZEBRA)
-#include "higz/hipaw.inc"
-#endif
-#if defined(CERNLIB_MAIL)
-#include "higz/himail.inc"
-#endif
- DIMENSION IOPT(*)
-*.______________________________________
-*
-#if defined(CERNLIB_ZEBRA)
- IF(ZFLAG)THEN
- IF(LPICT.LT.0)RETURN
- IF(IZPUSH(3,6,0,'IGAXIS').NE.0)RETURN
- CALL IZCFA(IPLCCO,1)
- CALL IZCFA(ILNCO,1)
- CALL IZCFA(ILWSCO,1)
- CALL IZCFA(ITMSCO,1)
- CALL IZCFA(IALHCO,1)
- CALL IZCFA(IALDCO,1)
- CALL IZCFA(ITXCCO,1)
- CALL IZCFA(ITXFCO,1)
- CALL IZCFA(IGTSCO,1)
- CALL IZCFA(IGTWCO,1)
- CALL IZCFA(IAWLCO,1)
-*
- CALL IZSTCC(IAXICO,INTPTR)
- IQ(LHI+INTPTR)=IFLPTR
- IQ(LHI+INTPTR+1)=NDIV
- DO 10 I=1,25
- IF(IOPT(I).NE.0)CALL SBIT1(IQ(LHI+INTPTR+2),I)
- 10 CONTINUE
- CALL IZINCI(3)
- Q(LHF+IFLPTR)=X0
- Q(LHF+IFLPTR+1)=X1
- Q(LHF+IFLPTR+2)=Y0
- Q(LHF+IFLPTR+3)=Y1
- Q(LHF+IFLPTR+4)=WMIN
- Q(LHF+IFLPTR+5)=WMAX
- CALL IZINCF(6)
- ENDIF
-#endif
-#if defined(CERNLIB_MAIL)
- IF(MFLAG)THEN
- WRITE (CHMAIL,'(I3,4E16.7)') IAXICO,X0,X1,Y0,Y1
- CALL IMWRIT(1)
- WRITE (CHMAIL,'(2E16.7,I10,A10)') WMIN,WMAX,NDIV,CHOPTM
- CALL IMWRIT(3)
- ENDIF
-#endif
-*
- END
-#endif
diff --git a/src/graflib/higz/iz/izbox.F b/src/graflib/higz/iz/izbox.F
deleted file mode 100644
index a9c37b3..0000000
--- a/src/graflib/higz/iz/izbox.F
+++ /dev/null
@@ -1,217 +0,0 @@
-*
-* $Id: izbox.F,v 1.3 2005/10/28 12:38:18 couet Exp $
-*
-* $Log: izbox.F,v $
-* Revision 1.3 2005/10/28 12:38:18 couet
-* - SVG driver, workstation type -779
-*
-* Revision 1.2 1999/07/21 15:48:28 couet
-* - Improvements in PS Patterns drawing
-*
-* Revision 1.1.1.1 1996/02/14 13:11:08 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_PSCRIPT)||defined(CERNLIB_MAIL)
-*CMZ : 1.21/09 26/09/94 16.21.39 by O.Couet
-*-- Author :
- SUBROUTINE IZBOX(X1,X2,Y1,Y2)
-*.===========>
-*.
-*. This routine store in the current picture the necessary data to
-*. draw a line box .
-*.
-*. _Input parameters:
-*.
-*. REAL X1,Y1 : Left down corner .
-*. REAL X2,Y2 : Right up corner .
-*.
-*..==========> (O.Couet)
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_MAIL)
-#include "higz/hicode.inc"
-#endif
-#include "higz/hiflag.inc"
-#if defined(CERNLIB_ZEBRA)
-#include "higz/hipaw.inc"
-#endif
-#if defined(CERNLIB_PSCRIPT)
-#include "higz/hiatt.inc"
-#include "higz/hipost.inc"
-#endif
-#if defined(CERNLIB_MAIL)
-#include "higz/himail.inc"
-#endif
-#if defined(CERNLIB_PSCRIPT)
- LOGICAL GSAV
- DIMENSION X(4),Y(4)
-#endif
-*.______________________________________
-*
-#if defined(CERNLIB_PSCRIPT)
-#include "higz/hiwcps.inc"
-#include "higz/hiwcsv.inc"
-#endif
-#if defined(CERNLIB_PSCRIPT)
- IF(PFLAG)THEN
- CALL IPZONE
- IF(ICLIP.NE.0)THEN
- IF(VFLAG)THEN
- IX1=IXWCSV(MIN(MAX(X1,X1W),X2W))
- IX2=IXWCSV(MIN(MAX(X2,X1W),X2W))
- IY1=IYWCSV(MIN(MAX(Y1,Y1W),Y2W))
- IY2=IYWCSV(MIN(MAX(Y2,Y1W),Y2W))
- ELSE
- IX1=IXWCPS(MIN(MAX(X1,X1W),X2W))
- IX2=IXWCPS(MIN(MAX(X2,X1W),X2W))
- IY1=IYWCPS(MIN(MAX(Y1,Y1W),Y2W))
- IY2=IYWCPS(MIN(MAX(Y2,Y1W),Y2W))
- ENDIF
- ELSE
- IF(VFLAG)THEN
- IX1=IXWCSV(X1)
- IX2=IXWCSV(X2)
- IY1=IYWCSV(Y1)
- IY2=IYWCSV(Y2)
- ELSE
- IX1=IXWCPS(X1)
- IX2=IXWCPS(X2)
- IY1=IYWCPS(Y1)
- IY2=IYWCPS(Y2)
- ENDIF
- ENDIF
-*
- IF(IFAIS.EQ.3.OR.IFAIS.EQ.2)THEN
- IF(IFASI.GE.100)THEN
- GSAV=GFLAG
- GFLAG=.FALSE.
- X(1)=X1
- X(2)=X2
- X(3)=X2
- X(4)=X1
- Y(1)=Y1
- Y(2)=Y1
- Y(3)=Y2
- Y(4)=Y2
- CALL IGFA(4,X,Y)
- GFLAG=GSAV
- ENDIF
- IF(IFASI.GE.1.AND.IFASI.LE.25..AND..NOT.TFLAG)THEN
- CALL IPDPAT(IFASI,IFACI)
- X(1)=X1
- X(2)=X2
- X(3)=X2
- X(4)=X1
- Y(1)=Y1
- Y(2)=Y1
- Y(3)=Y2
- Y(4)=Y2
- CALL IPDRAW(-4,X,Y)
- CALL IPPSTF(3,' FA')
- PSRED = -1.
- PSGRN = -1.
- PSBLU = -1.
- ENDIF
- IF(IFASI.EQ.-3.AND..NOT.TFLAG.AND..NOT.VFLAG)THEN
- CALL IPSCOL(5)
- CALL IPIOUT(IX2-IX1)
- CALL IPIOUT(IY2-IY1)
- CALL IPIOUT(IX1)
- CALL IPIOUT(IY1)
- CALL IPPSTF(3,' bf')
- ENDIF
- ENDIF
-*
- IF(IFAIS.EQ.1)THEN
- IF(TFLAG)THEN
- ELSEIF(VFLAG) THEN
- CALL IPPSTF(9,'<rect x="')
- CALL IPKOUT(IX1)
- CALL IPPSTF(5,'" y="')
- CALL IPKOUT(IY2)
- CALL IPPSTF(9,'" width="')
- CALL IPKOUT(IX2-IX1)
- CALL IPPSTF(10,'" height="')
- CALL IPKOUT(IY1-IY2)
- CALL IPPSTF(7,'" fill=')
- CALL IPSCOL(IFACI)
- CALL IPPSTF(2,'/>')
- ELSE
- CALL IPLWID(1)
- CALL IPLTYP(1)
- CALL IPSCOL(IFACI)
- CALL IPIOUT(IX2-IX1)
- CALL IPIOUT(IY2-IY1)
- CALL IPIOUT(IX1)
- CALL IPIOUT(IY1)
- CALL IPPSTF(3,' bf')
- ENDIF
- ENDIF
-*
- IF(TFLAG.AND.IFAIS.EQ.1)THEN
- CALL IPTLIN('m',IX1,IY1)
- CALL IPTLIN('f',IX2-IX1,IY2-IY1)
- ENDIF
-*
- IF(IFAIS.EQ.0.OR.IBORD.NE.0)THEN
- IF(TFLAG) THEN
- CALL IPPSTR(BSLASH//'put')
- CALL IPJOUT(IX1,IY1)
- CALL IPPSTR('{'//BSLASH//'framebox')
- CALL IPJOUT(IX2-IX1,IY2-IY1)
- CALL IPPSTR('{}}')
- ELSEIF(VFLAG) THEN
- CALL IPPSTF(9,'<rect x="')
- CALL IPKOUT(IX1)
- CALL IPPSTF(5,'" y="')
- CALL IPKOUT(IY2)
- CALL IPPSTF(9,'" width="')
- CALL IPKOUT(IX2-IX1)
- CALL IPPSTF(10,'" height="')
- CALL IPKOUT(IY1-IY2)
- CALL IPPSTF(21,'" fill="none" stroke=')
- CALL IPSCOL(IPLCI)
- CALL IPLWID(INT(RLWSC))
- CALL IPPSTF(2,'/>')
- ELSE
- CALL IPLWID(INT(RLWSC))
- CALL IPLTYP(1)
- CALL IPSCOL(IPLCI)
- CALL IPIOUT(IX2-IX1)
- CALL IPIOUT(IY2-IY1)
- CALL IPIOUT(IX1)
- CALL IPIOUT(IY1)
- CALL IPPSTF(3,' bl')
- ENDIF
- ENDIF
- ENDIF
-#endif
-#if defined(CERNLIB_MAIL)
-*
- IF(MFLAG)THEN
- WRITE (CHMAIL,'(I3,4E16.7)') IBXCO,X1,X2,Y1,Y2
- CALL IMWRIT(4)
- ENDIF
-#endif
-#if defined(CERNLIB_ZEBRA)
-*
- IF(ZFLAG)THEN
- IF(LPICT.LT.0)RETURN
- IF(IZPUSH(0,4,0,'IGBOX').NE.0)RETURN
- CALL IZCFA(IFAICO,1)
- CALL IZCFA(IFASCO,1)
- CALL IZCFA(IFACCO,1)
- CALL IZCFA(IBORCO,1)
- CALL IZCFA(ILWSCO,1)
- CALL IZCFA(IPLCCO,1)
- CALL IZSTCC(IBXCO,IFLPTR)
- Q(LHF+IFLPTR)=X1
- Q(LHF+IFLPTR+1)=X2
- Q(LHF+IFLPTR+2)=Y1
- Q(LHF+IFLPTR+3)=Y2
- CALL IZINCF(4)
- ENDIF
-#endif
-*
- END
-#endif
diff --git a/src/graflib/higz/iz/izcda.F b/src/graflib/higz/iz/izcda.F
deleted file mode 100644
index 9320aef..0000000
--- a/src/graflib/higz/iz/izcda.F
+++ /dev/null
@@ -1,58 +0,0 @@
-*
-* $Id: izcda.F,v 1.2 1996/11/20 15:21:45 couet Exp $
-*
-* $Log: izcda.F,v $
-* Revision 1.2 1996/11/20 15:21:45 couet
-* *** empty log message ***
-*
-* Revision 1.1.1.1 1996/02/14 13:11:08 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-#if defined(CERNLIB_ZEBRA)
- SUBROUTINE IZCDA(IATTCO)
-*.===========>
-*.
-*. This routine Changes the current normalisation transformation
-*. Default Attributes .
-*.
-*. _Input parameters:
-*.
-*. INTEGER IATTCO : Code of the attribute function .
-*.
-*..==========> (O.Couet)
-#include "higz/hipaw.inc"
-#include "higz/hiatnb.inc"
-#include "higz/hiatt.inc"
- DIMENSION RATVAL(NBRATT)
- EQUIVALENCE (RATVAL(1),RMKSC)
- DIMENSION IATVAL(NBIATT)
- EQUIVALENCE (IATVAL(1),IPLCI)
-*.______________________________________
-*
- IF(LPICT.LE.0)RETURN
- INBIAT=IZGCOD(LHNT,8)
- INBRAT=IZGCOD(LHNT,9)
-*
- IF(IATTCO.EQ.0)THEN
- DO 10 I=1,INBRAT
- Q(LHF+IRAPTR+I-1)=RATVAL(I)
- 10 CONTINUE
- DO 20 I=1,INBIAT
- IQ(LHI+IIAPTR+I-1)=IATVAL(I)
- 20 CONTINUE
- ELSE
- IF(IATTCO.LT.80)THEN
- INDEX=IATTCO-49
- IF(INDEX.GT.INBRAT)RETURN
- Q(LHF+IRAPTR+INDEX-1)=RATVAL(INDEX)
- ELSE
- INDEX=IATTCO-79
- IF(INDEX.GT.INBIAT)RETURN
- IQ(LHI+IIAPTR+INDEX-1)=IATVAL(INDEX)
- ENDIF
- ENDIF
-*
- END
-#endif
diff --git a/src/graflib/higz/iz/izcfa.F b/src/graflib/higz/iz/izcfa.F
deleted file mode 100644
index 5348eb4..0000000
--- a/src/graflib/higz/iz/izcfa.F
+++ /dev/null
@@ -1,42 +0,0 @@
-*
-* $Id: izcfa.F,v 1.1.1.1 1996/02/14 13:11:08 mclareni Exp $
-*
-* $Log: izcfa.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:08 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-#if defined(CERNLIB_ZEBRA)
-*CMZ : 1.06/03 12/12/88 13.58.49 by O.Couet
-*-- Author :
- SUBROUTINE IZCFA(IATTCO,IUD)
-*.===========>
-*.
-*. Change the Flag Attribute (of the current NT) IATTCO to the value IUD .
-*.
-*. _Input parameters:
-*.
-*. INTEGER IATTCO : Code of the attribute function .
-*. INTEGER IUD : New flag state Up/Down (0/1) .
-*.
-*..==========> (O.Couet)
-#include "higz/hipaw.inc"
-#include "higz/hiatnb.inc"
-#include "higz/hiflat.inc"
- DIMENSION IRFLAT(NBRATT),IIFLAT(NBIATT)
- EQUIVALENCE (IRFLAT(1),KMKSC),(IIFLAT(1),KPLCI)
-*.______________________________________
-*
- IF(IATTCO.LT.80)THEN
- INDEX=IATTCO-49
- CALL SBIT(IUD,IQ(LHNT+7),INDEX)
- IRFLAT(INDEX)=IUD
- ELSE
- INDEX=IATTCO-79
- CALL SBIT(IUD,IQ(LHNT+6),INDEX)
- IIFLAT(INDEX)=IUD
- ENDIF
-*
- END
-#endif
diff --git a/src/graflib/higz/iz/izclrd.F b/src/graflib/higz/iz/izclrd.F
deleted file mode 100644
index a64c828..0000000
--- a/src/graflib/higz/iz/izclrd.F
+++ /dev/null
@@ -1,65 +0,0 @@
-*
-* $Id: izclrd.F,v 1.1.1.1 1996/02/14 13:11:08 mclareni Exp $
-*
-* $Log: izclrd.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:08 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_PSCRIPT)||defined(CERNLIB_MAIL)
-*CMZ : 1.23/01 24/05/95 10.42.01 by O.Couet
-*-- Author :
- SUBROUTINE IZCLRD
-*.===========>
-*.
-*. This routine stores in the current picture the necessary data to
-*. clear a workstation .
-*.
-*..==========> (O.Couet)
-#include "higz/hiflag.inc"
-#if defined(CERNLIB_ZEBRA)
-#include "higz/hipaw.inc"
-#endif
-#if defined(CERNLIB_PSCRIPT)
-#include "higz/hipost.inc"
-#endif
-#if defined(CERNLIB_MAIL)
-#include "higz/himail.inc"
-#endif
-*.______________________________________
-*
-#if defined(CERNLIB_PSCRIPT)
- IF(PFLAG)THEN
- IF(LOPRT)THEN
- IF(TFLAG)THEN
- CALL IPPSTR(BSLASH//'fi'//BSLASH//'end{picture}@')
- IF(IPTWTY.EQ.-778)THEN
- CALL IPPSTR(BSLASH//'vfill'//BSLASH//'eject@')
- LOBB=.FALSE.
- ENDIF
- ELSE
- IF (NBSAVE.GT.NBSAV0) CALL IPSVRT(-1)
- ENDIF
- LOPRT=.FALSE.
- LOCLR=.TRUE.
- ENDIF
- ENDIF
-#endif
-#if defined(CERNLIB_ZEBRA)
-*
- IF(ZFLAG)THEN
- IF(LPICT.LT.0)RETURN
- CALL SBIT1(IQ(LPICT),1)
- ENDIF
-#endif
-#if defined(CERNLIB_MAIL)
-*
- IF(MFLAG)THEN
- WRITE (CHMAIL,'(I3)') 101
- CALL IMWRIT(4)
- ENDIF
-#endif
-*
- END
-#endif
diff --git a/src/graflib/higz/iz/izcopy.F b/src/graflib/higz/iz/izcopy.F
deleted file mode 100644
index 9c8d234..0000000
--- a/src/graflib/higz/iz/izcopy.F
+++ /dev/null
@@ -1,131 +0,0 @@
-*
-* $Id: izcopy.F,v 1.1.1.1 1996/02/14 13:11:08 mclareni Exp $
-*
-* $Log: izcopy.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:08 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-#if defined(CERNLIB_ZEBRA)
-*CMZ : 1.12/08 28/03/91 12.13.39 by O.Couet
-*-- Author :
- SUBROUTINE IZCOPY(PNME1,PNME2,CHOPT)
-*.===========>
-*.
-*. This routine copy or rename the picture PNAME1 to the picture PNAME2
-*. according to the parameter CHOPT .
-*.
-*. _Input parameters:
-*.
-*. CHARACTER PNME1 : Picture name 1 .
-*. CHARACTER PNME2 : Picture name 2 .
-*. CHARACTER CHOPT : Option .
-*.
-*. CHOPT='C'opy .
-*. CHOPT='R'ename .
-*.
-*..==========> (O.Couet)
-#include "higz/hipaw.inc"
-#include "higz/hiflag.inc"
- CHARACTER*(*) CHOPT,PNME1,PNME2
- CHARACTER*20 PNAME1,PNAME2
- DIMENSION IOPT(2)
- LOGICAL GFSAV,ZFSAV
- EQUIVALENCE (IOPT(1),IOPTC),(IOPT(2),IOPTR)
-*.______________________________________
-*
- CALL UOPTC (CHOPT,'CR',IOPT)
- IF(CHOPT.EQ.' ')IOPTC=1
- PNAME1=PNME1
- PNAME2=PNME2
- NCHP2=LENOCC(PNME2)
- IF(NCHP2.GT.20)NCHP2=20
- IQUEST(1)=0
-*
-* Adressing pictures by number
-*
- INUM=IGASCI(PNAME2(1:1))
- IF(49.LE.INUM.AND.INUM.LE.57)GOTO 20
- INUM=IGASCI(PNAME1(1:1))
- IF(49.LE.INUM.AND.INUM.LE.57)THEN
- READ (PNAME1,'(I15)',ERR=20 ) INUM
- IF(INUM.GT.NBPICT)THEN
- CALL IGERR('Picture not in memory','IZCOPY')
- RETURN
- ENDIF
- LP=LQ(LHIGZ)
- DO 10 I=1,INUM-1
- LP=LQ(LP)
- 10 CONTINUE
- LCH=LQ(LP-4)
- CALL UHTOC(IQ(LCH+1),4,PNAME1,IQ(LP+1))
- ENDIF
- GOTO 30
- 20 CALL IGERR('PNAME must begin with a letter','IZCOPY')
- RETURN
- 30 CONTINUE
-*
-* Check the validity of PNAME1 and PNAME2
-*
- LP1=IZRPIP(PNAME1)
- LP2=IZRPIP(PNAME2)
- IF(PNAME1.EQ.' ')LP1=LPICT
- IF(LP2.NE.0)THEN
- CALL IGERR('Picture already exist','IZCOPY')
- RETURN
- ENDIF
- IF(LP1.EQ.0)THEN
- CALL IGERR('Picture not in memory','IZCOPY')
- RETURN
- ENDIF
-*
-* Copy
-*
- IF(IOPTC.NE.0)THEN
- LPIC2=LP1
- L2NT0=LQ(LPIC2-1)
- L2I=LQ(LPIC2-2)
- L2F=LQ(LPIC2-3)
- L2C=LQ(LPIC2-4)
- CALL IZPICT(PNAME2,'M')
- GFSAV=GFLAG
- ZFSAV=ZFLAG
- GFLAG=.FALSE.
- ZFLAG=.TRUE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- L2NT=L2NT0
- N=IQ(LPIC2+8)
- DO 50 I=1,N
- NT=IQ(L2NT+1)
- IF(NT.EQ.0)GOTO 40
- J=IQ(L2NT+2)
- CALL ISWN(NT,Q(L2F+J),Q(L2F+J+1),Q(L2F+J+2),Q(L2F+J+3))
- CALL ISVP(NT,Q(L2F+J+4),Q(L2F+J+5),Q(L2F+J+6),Q(L2F+J+7))
- 40 CALL ISELNT(NT)
- CALL IZDNB(L2NT,L2I,L2F,L2C,0,0)
- L2NT=LQ(L2NT)
- IF(L2NT.EQ.0)GOTO 60
- 50 CONTINUE
- IF(JBIT(IQ(LP1),1).NE.0)CALL SBIT1(IQ(LP2),1)
- 60 GFLAG=GFSAV
- ZFLAG=ZFSAV
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- CALL IZPICT(PNAME1,'C')
- RETURN
- ENDIF
-*
-* Rename
-*
- IF(IOPTR.NE.0)THEN
- LPSAV=LPICT
- CALL IZSCPI(LP1)
- CALL UCTOH(PNAME2,IQ(LHC+1),4,20)
- IQ(LPICT+1)=NCHP2
- LPICT=LPSAV
- IF(LPSAV.GT.0)CALL IZSCPI(LPSAV)
- RETURN
- ENDIF
-*
- END
-#endif
diff --git a/src/graflib/higz/iz/izctoi.F b/src/graflib/higz/iz/izctoi.F
deleted file mode 100644
index 9f561c7..0000000
--- a/src/graflib/higz/iz/izctoi.F
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: izctoi.F,v 1.1.1.1 1996/02/14 13:11:09 mclareni Exp $
-*
-* $Log: izctoi.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:09 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.06/07 05/04/89 10.01.28 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE IZCTOI(CVAL,IVAL)
-*.===========>
-*.
-*. Convert character string CVAL into integer value IVAL
-*.
-*..==========>
-#include "higz/hiques.inc"
- CHARACTER*(*) CVAL
- PARAMETER (MAXDIG=15)
- CHARACTER*(MAXDIG) CHTEMP,BLANK
-*.______________________________________
-*
- IQUEST(1)=0
- L=LENOCC(CVAL)
- IF (L.EQ.0)RETURN
- IF (L.GT.MAXDIG) THEN
- IQUEST(1)=1
- RETURN
- ENDIF
- BLANK=' '
- IF (L.EQ.MAXDIG) THEN
- CHTEMP=CVAL
- ELSE
- CHTEMP=BLANK(:MAXDIG-L)//CVAL
- ENDIF
- READ (CHTEMP,'(I15)',ERR=10 ) IVAL
- RETURN
- 10 IQUEST(1)=1
-*
- END
diff --git a/src/graflib/higz/iz/izctor.F b/src/graflib/higz/iz/izctor.F
deleted file mode 100644
index 142361c..0000000
--- a/src/graflib/higz/iz/izctor.F
+++ /dev/null
@@ -1,55 +0,0 @@
-*
-* $Id: izctor.F,v 1.1.1.1 1996/02/14 13:11:09 mclareni Exp $
-*
-* $Log: izctor.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:09 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.06/05 28/02/89 18.04.24 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE IZCTOR(CVAL,RVAL)
-*.===========>
-*.
-*. Convert character string CVAL into real value RVAL
-*.
-*..==========>
- CHARACTER*(*) CVAL
- PARAMETER (MAXDIG=16)
- CHARACTER*(MAXDIG) CHTEMP,BLANK
-*.______________________________________
-*
- L=LENOCC(CVAL)
- IF (L.EQ.0)RETURN
- IF (L.GT.MAXDIG)RETURN
- BLANK=' '
- IF (L.EQ.MAXDIG) THEN
- CHTEMP=CVAL
- ELSE
- CHTEMP=BLANK(:MAXDIG-L)//CVAL
- ENDIF
- CALL CLTOU(CHTEMP)
- I1 =INDEX(CHTEMP,'.')
- II1=0
- IF (I1.LT.L) II1=INDEX(CHTEMP(I1+1:),'.')
- I2=INDEX(CHTEMP,'E')
- II2=0
- IF (I2.LT.L) II2=INDEX(CHTEMP(I2+1:),'E')
- IF (II1+II2.NE.0)RETURN
- IF (I1+I2.EQ.0) THEN
- CALL IZCTOI(CHTEMP,IVAL)
- RVAL=IVAL
- RETURN
- ENDIF
- IF (I1.EQ.L.AND.I2.EQ.0) THEN
- CALL IZCTOI(CHTEMP(:I1-1),IVAL)
- RVAL=IVAL
- RETURN
- ENDIF
- BLANK(1:15)=CHTEMP(2:16)
- CHTEMP=BLANK(1:15)//'0'
- READ (CHTEMP,'(G15.9)',END=999,ERR=999) RVAL
-*
- 999 END
-
diff --git a/src/graflib/higz/iz/izdatt.F b/src/graflib/higz/iz/izdatt.F
deleted file mode 100644
index 4207613..0000000
--- a/src/graflib/higz/iz/izdatt.F
+++ /dev/null
@@ -1,95 +0,0 @@
-*
-* $Id: izdatt.F,v 1.1.1.1 1996/02/14 13:11:09 mclareni Exp $
-*
-* $Log: izdatt.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:09 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-#if defined(CERNLIB_ZEBRA)
-*CMZ : 1.06/05 17/02/89 16.44.54 by O.Couet
-*-- Author :
- SUBROUTINE IZDATT(IADR1,IADR2)
-*.===========>
-*.
-*. This routine Decodes the attributes in the from the adress IADR1
-*. to the adress IADR2 in the bank LNDECO.
-*.
-*. _Input parameters:
-*.
-*. INTEGER IADR1 : Starting adress.
-*. INTEGER IADR2 : End adress.
-*.
-*..==========> (O.Couet)
-#include "higz/hipaw.inc"
-#include "higz/hiatnb.inc"
-#include "higz/hiatt.inc"
-#include "higz/hiatnm.inc"
-*.______________________________________
-*
- IF(IADR1.LE.9)THEN
- IREPTR=9
- ELSE
- IREPTR=IADR1-1
- ENDIF
- IDIAA=IZGADR(LNDECO,8)
- IDRAA=IZGADR(LNDECO,9)
- INBIAT=IZGCOD(LNDECO,8)
- INBRAT=IZGCOD(LNDECO,9)
- IF(IADR1.GT.10)GOTO 1
-*
-* Set the default attributes
-*
- DO 3 I=1,INBIAT
- CALL IGSET(CHIATT(I),FLOAT(IQ(LIDECO+IDIAA+I-1)))
- 3 CONTINUE
- DO 4 I=1,INBRAT
- CALL IGSET(CHRATT(I),Q(LFDECO+IDRAA+I-1))
- 4 CONTINUE
-*
-* Decode the LN bank
-*
- 1 IREPTR=IREPTR+1
- IF(IREPTR.EQ.IQ(LNDECO+4))RETURN
- IF(IREPTR.EQ.IADR2+1)RETURN
- IADRI=ABS(IZGADR(LNDECO,IREPTR))
- ICODE=IZGCOD(LNDECO,IREPTR)
-*
- GOTO (2,2,2,2,2
- +, 2,2,2,2,2,2,2,2,2,2,2,2,2,2,480,490
- +, 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2
- +, 5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5
- +, 8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8
- + ),ABS(ICODE)
-*
- 2 CONTINUE
- GOTO 1
-*
-* Set color representation
-*
- 480 IADRF=IQ(LIDECO+IADRI)
- CALL ISCR(IDID
- +, IQ(LIDECO+IADRI+1)
- +, Q(LFDECO+IADRF)
- +, Q(LFDECO+IADRF+1)
- +, Q(LFDECO+IADRF+2))
- GOTO 1
-*
-* Set clipping indicator
-*
- 490 CALL ISCLIP(IADRI)
- GOTO 1
-*
-* Real attributes
-*
- 5 CALL IGSET(CHRATT(ICODE-49),Q(LFDECO+IADRI))
- GOTO 1
-*
-* Integer attributes
-*
- 8 CALL IGSET(CHIATT(ICODE-79),FLOAT(IADRI-100000))
- GOTO 1
-*
- END
-#endif
diff --git a/src/graflib/higz/iz/izdipi.F b/src/graflib/higz/iz/izdipi.F
deleted file mode 100644
index 31c6231..0000000
--- a/src/graflib/higz/iz/izdipi.F
+++ /dev/null
@@ -1,128 +0,0 @@
-*
-* $Id: izdipi.F,v 1.2 1998/12/01 15:48:40 couet Exp $
-*
-* $Log: izdipi.F,v $
-* Revision 1.2 1998/12/01 15:48:40 couet
-* - Clean up: commented lines of code removed
-*
-* Revision 1.1.1.1 1996/02/14 13:11:09 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-#if defined(CERNLIB_ZEBRA)
-*CMZ : 1.20/07 12/01/94 14.04.38 by O.Couet
-*-- Author :
- SUBROUTINE IZDIPI(LP)
-*.===========>
-*.
-*. This routine displays the picture which is at the adress LP in the
-*. ZEBRA data structure. For more details about the structure of the
-*. HIGZ pictures see the comments in the routine IZPICT .
-*.
-*. _Input parameters:
-*.
-*. INTEGER LP : Picture adress in the ZEBRA data structure .
-*.
-*..==========> (O.Couet)
-#include "higz/hipaw.inc"
-#include "higz/hiflag.inc"
-#include "higz/himeta.inc"
-#include "higz/hiconv.inc"
- EQUIVALENCE (LPCOP,LN)
- LOGICAL GFSAV,ZFSAV,LOSIZE
-*.______________________________________
-*
- IF(LP.LT.0)RETURN
-*
- LPICD=LP
- LDNT0=LQ(LPICD-1)
- IHP=IZGHNP(LPICD)-1
- LDNT=IZGNGT(LPICD,IHP)
- LDI=LQ(LPICD-2)
- LDF=LQ(LPICD-3)
- LDC=LQ(LPICD-4)
-*
- GFSAV=GFLAG
- ZFSAV=ZFLAG
- ZFLAG=.FALSE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- IF((.NOT.TEKACT).AND.(METACT).AND.(PFLAG).OR.MFLAG)THEN
- GFLAG=.FALSE.
- ELSE
- GFLAG=.TRUE.
- ENDIF
-*
-* Compute in LN1 the bank adress of the NT 1
-*
- LN=LDNT0
- LN1=0
- DO 10 I=1,IQ(LPICD+8)
- IF(LN.EQ.0)GOTO 20
- IF(IQ(LN+1).EQ.1)THEN
- LN1=LN
- GOTO 20
- ENDIF
- LN=LQ(LN)
- 10 CONTINUE
-*
- 20 IF(JBIT(IQ(LPICD),1).NE.0)CALL ICLRWK(0,0)
-*
- IF(LN1.NE.0)THEN
- CALL IGRNG(Q(LDF+IQ(LN1+2)+1)
- +, Q(LDF+IQ(LN1+2)+3))
- IWVA=IQ(LN1+2)
- X1MIN=Q(LDF+IWVA+4)
- X1MAX=Q(LDF+IWVA+5)
- Y1MIN=Q(LDF+IWVA+6)
- Y1MAX=Q(LDF+IWVA+7)
- X2MIN=RQUEST(12)
- X2MAX=RQUEST(14)+RQUEST(12)
- Y2MIN=RQUEST(13)
- Y2MAX=RQUEST(15)+RQUEST(13)
- LOSIZE=.TRUE.
- ELSE
- LOSIZE=.FALSE.
- ENDIF
-*
-* Display the NT banks according to there priorities
-*
- NGT=0
- LN=IZGNGT(LPICD,NGT)
- DO 40 I=1,IQ(LPICD+8)
- IF(LN.EQ.0)GOTO 50
-*
-* Set the normalisation transformation
-*
- IWVA=IQ(LN+2)
- INTN=IQ(LN+1)
-*
- IF(INTN.EQ.0)GOTO 30
- CALL ISWN(INTN
- +, Q(LDF+IWVA)
- +, Q(LDF+IWVA+1)
- +, Q(LDF+IWVA+2)
- +, Q(LDF+IWVA+3))
- IF(LOSIZE)CALL IGCONV(2,Q(LDF+IWVA+4),Q(LDF+IWVA+6))
- CALL ISVP(INTN
- +, Q(LDF+IWVA+4)
- +, Q(LDF+IWVA+5)
- +, Q(LDF+IWVA+6)
- +, Q(LDF+IWVA+7))
- 30 CALL ISELNT(INTN)
-*
-* Decode the NT bank linked to LN
-*
- CALL IZDNB(LN,LDI,LDF,LDC,0,0)
-*
-* Give the link of the next highest priority NT bank
-*
- NGT=IQ(LN+3)
- LN=IZGNGT(LPICD,NGT)
- 40 CONTINUE
-*
- 50 ZFLAG=ZFSAV
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- GFLAG=GFSAV
- END
-#endif
diff --git a/src/graflib/higz/iz/izdnb.F b/src/graflib/higz/iz/izdnb.F
deleted file mode 100644
index 44909b8..0000000
--- a/src/graflib/higz/iz/izdnb.F
+++ /dev/null
@@ -1,918 +0,0 @@
-*
-* $Id: izdnb.F,v 1.1.1.1 1996/02/14 13:11:09 mclareni Exp $
-*
-* $Log: izdnb.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:09 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-#if defined(CERNLIB_ZEBRA)
-*CMZ : 1.23/02 30/08/95 18.19.28 by O.Couet
-*-- Author :
- SUBROUTINE IZDNB(LN,LI,LF,LC,IADRES,IALON)
-*.===========>
-*.
-*. This routine Decode the NT Bank referenced by LN.
-*.
-*. _Input parameters:
-*.
-*. INTEGER LN : NT bank link in the ZEBRA data structure .
-*. INTEGER LI : LHI bank link in the ZEBRA data structure .
-*. INTEGER LF : LHF bank link in the ZEBRA data structure .
-*. INTEGER LC : LHC bank link in the ZEBRA data structure .
-*. INTEGER IADRES : Adress to be decode if IALON=1.
-*. INTEGER IALON : =0 the whole bank is decoded ;
-*. =1 only the code at the adress IADRES is decoded
-*.
-*..==========> (O.Couet)
-#include "higz/hipaw.inc"
-#include "higz/hiatnb.inc"
-#include "higz/hiatt.inc"
-#include "higz/hilabs.inc"
- CHARACTER*256 CHARS,STR
- CHARACTER*80 CHOPT
- CHARACTER*1 CHAXIS(25),CHHIST(14),CHTEXT(3),CHTABL(11),CHGRAP(12)
- +, CHPAVE(9)
- DIMENSION X(2),Y(2)
-#include "higz/hiatnm.inc"
- DATA CHAXIS /'G','B','A','V','+','-','U','P','O'
- +, 'R','L','C','=','.','H','D','Y','T'
- +, 'W','S','N','I','M','0','X'/
- DATA CHHIST /'H','F','C','*','R','1','B','N','L'
- +, 'P','A','G','X','Y'/
- DATA CHTEXT /'L','C','R'/
- DATA CHTABL /'P','B','C','T','K','L','S',' ','A','+','R'/
- DATA CHGRAP /'L','A','C','*','P','B','R','1','G','X','Y','F'/
- DATA CHPAVE /'T','B','L','R','-','S','P','K','D'/
-*.______________________________________
-*
- LNDECO=LN
- LIDECO=LI
- LFDECO=LF
- LCDECO=LC
-*
- IF(IALON.NE.0)THEN
- IREPTR=IADRES
- IREPTR=IREPTR-1
- GOTO 1
- ENDIF
-*
- IREPTR=9
- IDIAA=IZGADR(LNDECO,8)
- IDRAA=IZGADR(LNDECO,9)
- INBIAT=IZGCOD(LNDECO,8)
- INBRAT=IZGCOD(LNDECO,9)
-*
-* Set the default attributes
-*
- DO 3 I=1,INBIAT
- CALL IGSET(CHIATT(I),FLOAT(IQ(LIDECO+IDIAA+I-1)))
- 3 CONTINUE
- DO 4 I=1,INBRAT
- CALL IGSET(CHRATT(I),Q(LFDECO+IDRAA+I-1))
- 4 CONTINUE
-*
-* Decode the LN bank
-*
- 1 IREPTR=IREPTR+1
- IF(IREPTR.EQ.IQ(LNDECO+4))RETURN
- IADRI=ABS(IZGADR(LNDECO,IREPTR))
- ICODE=IZGCOD(LNDECO,IREPTR)
-*
- GOTO (2,2,2,2,2
- +, 60,70,80,90,100,110,120,130,140,150,160,170,180,190
- +, 200,210,220,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2
- +, 2,480,490
- +, 5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5
- +, 8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8
- + ),ABS(ICODE)
-*
- 2 CONTINUE
- IF(IALON.NE.0)RETURN
- GOTO 1
-*
-* Histograms
-*
- 60 IADRI2=IADRI
- IF(ICODE.GT.0)THEN
- ICHOPT=IQ(LIDECO+IADRI+2)
- ELSE
- ICHOPT=-1
- ENDIF
-*
- IF(ICODE.LT.0)THEN
- CALL IZSAVA
- NBNOP=1
- KATT=0
- 61 IF(IQ(LNDECO+IADRI2).LT.0)THEN
- NBNOP=NBNOP+1
- IADRI2=ABS(IZGADR(LNDECO,IADRI2))
- GOTO 61
- ENDIF
- IADRI2=IZGADR(LNDECO,IADRI2)
- DO 62 I=1,NBNOP
- IF(IQ(LIDECO+IADRI2).EQ.0)THEN
- GOTO 63
- ENDIF
- IF((IQ(LIDECO+IADRI2).EQ.2).AND.(KATT.EQ.0))THEN
- IF(IALON.NE.-1)THEN
- IADRI3=ABS(IZGADR(LNDECO,IQ(LIDECO+IADRI2+2)))-1
- CALL IZDATT(IREPTR+1,IADRI3)
- ICHOPT=IQ(LIDECO+IADRI2+3)
- ENDIF
- KATT=1
- ENDIF
- IADRI2=IQ(LIDECO+IADRI2+1)
- 62 CONTINUE
- ENDIF
-*
- IADRF=IQ(LIDECO+IADRI2)
- IF(ICHOPT.LT.0)THEN
- ICHOPT=IQ(LIDECO+IADRI2+2)
- ENDIF
- CHOPT=' '
- DO 64 I=1,14
- IF(JBIT(ICHOPT,I).NE.0)CHOPT(I:I)=CHHIST(I)
- 64 CONTINUE
- NN=2
- IF(JBIT(ICHOPT,8).NE.0)THEN
- NN=IQ(LIDECO+IADRI2+1)+1
- ENDIF
- IF(JBIT(ICHOPT,5).NE.0)THEN
- IQUEST(81) = LFDECO+IADRF+NN
- IQUEST(82) = LFDECO+IADRF
- CHOPT(20:20) = 'Z'
- CALL IGHIST(IQ(LIDECO+IADRI2+1)
- +, Q(LFDECO+IADRF+NN)
- +, Q(LFDECO+IADRF)
- +, CHOPT)
- GOTO 1
- ENDIF
- NBIN=IQ(LIDECO+IADRI2+1)
- IF(IZPUSH(3,NBIN+2,0,'IZDNB').NE.0)RETURN
- IQUEST(81) = LFDECO+IADRF
- IQUEST(82) = LFDECO+IADRF+NN
- CHOPT(20:20) = 'Z'
- CALL IGHIST(NBIN
- +, Q(LFDECO+IADRF)
- +, Q(LFDECO+IADRF+NN)
- +, CHOPT)
- IF(ICODE.LT.0)CALL IZSETA
-*
- 63 IF(IALON.NE.0)RETURN
- GOTO 1
-*
-* Polymarker with one point
-*
- 70 IADRI2=IADRI
-*
- IF(ICODE.LT.0)THEN
- CALL IZSAVA
- NBNOP=1
- KATT=0
- 71 IF(IQ(LNDECO+IADRI2).LT.0)THEN
- NBNOP=NBNOP+1
- IADRI2=ABS(IZGADR(LNDECO,IADRI2))
- GOTO 71
- ENDIF
- IADRI2=IZGADR(LNDECO,IADRI2)
- DO 72 I=1,NBNOP
- IF(IQ(LIDECO+IADRI2).EQ.0)THEN
- GOTO 73
- ENDIF
- IF((IQ(LIDECO+IADRI2).EQ.1).AND.(KATT.EQ.0))THEN
- IF(IALON.NE.-1)THEN
- IADRI3=ABS(IZGADR(LNDECO,IQ(LIDECO+IADRI2+2)))-1
- CALL IZDATT(IREPTR+1,IADRI3)
- ENDIF
- KATT=1
- ENDIF
- IADRI2=IQ(LIDECO+IADRI2+1)
- 72 CONTINUE
- ENDIF
-*
- IF(IZPUSH(2,2,0,'IZDNB').NE.0)RETURN
- CALL IPM(1,Q(LFDECO+IADRI2),Q(LFDECO+IADRI2+1))
- IF(ICODE.LT.0)CALL IZSETA
-*
- 73 IF(IALON.NE.0)RETURN
- GOTO 1
-*
-* Polyline with two points
-*
- 80 DX=0.
- DY=0.
- IADRI2=IADRI
-*
- IF(ICODE.LT.0)THEN
- CALL IZSAVA
- NBNOP=1
- KATT=0
- 81 IF(IQ(LNDECO+IADRI2).LT.0)THEN
- NBNOP=NBNOP+1
- IADRI2=ABS(IZGADR(LNDECO,IADRI2))
- GOTO 81
- ENDIF
- IADRI2=IZGADR(LNDECO,IADRI2)
- DO 82 I=1,NBNOP
- IF(IQ(LIDECO+IADRI2).EQ.0)THEN
- GOTO 83
- ENDIF
- IF((IQ(LIDECO+IADRI2).EQ.1).AND.(KATT.EQ.0))THEN
- IF(IALON.NE.-1)THEN
- IADRI3=ABS(IZGADR(LNDECO,IQ(LIDECO+IADRI2+2)))-1
- CALL IZDATT(IREPTR+1,IADRI3)
- ENDIF
- KATT=1
- ENDIF
- IF(IZGCOD(LIDECO,IADRI2).EQ.3)THEN
- IADRI4=IZGADR(LIDECO,IADRI2)
- DX=DX+Q(LFDECO+IADRI4)
- DY=DY+Q(LFDECO+IADRI4+1)
- ENDIF
- IADRI2=IQ(LIDECO+IADRI2+1)
- 82 CONTINUE
- ENDIF
-*
- X(1)=Q(LFDECO+IADRI2)+DX
- X(2)=Q(LFDECO+IADRI2+1)+DX
- Y(1)=Q(LFDECO+IADRI2+2)+DY
- Y(2)=Q(LFDECO+IADRI2+3)+DY
- CALL IPL(2,X,Y)
- IF(ICODE.LT.0)CALL IZSETA
-*
- 83 IF(IALON.NE.0)RETURN
- GOTO 1
-*
-* Polyline
-*
- 90 DX=0.
- DY=0.
- IADRI2=IADRI
-*
- IF(ICODE.LT.0)THEN
- CALL IZSAVA
- NBNOP=1
- KATT=0
- 91 IF(IQ(LNDECO+IADRI2).LT.0)THEN
- NBNOP=NBNOP+1
- IADRI2=ABS(IZGADR(LNDECO,IADRI2))
- GOTO 91
- ENDIF
- IADRI2=IZGADR(LNDECO,IADRI2)
- DO 92 I=1,NBNOP
- IF(IQ(LIDECO+IADRI2).EQ.0)THEN
- GOTO 93
- ENDIF
- IF((IQ(LIDECO+IADRI2).EQ.1).AND.(KATT.EQ.0))THEN
- IF(IALON.NE.-1)THEN
- IADRI3=ABS(IZGADR(LNDECO,IQ(LIDECO+IADRI2+2)))-1
- CALL IZDATT(IREPTR+1,IADRI3)
- ENDIF
- KATT=1
- ENDIF
- IF(IZGCOD(LIDECO,IADRI2).EQ.3)THEN
- IADRI4=IZGADR(LIDECO,IADRI2)
- DX=DX+Q(LFDECO+IADRI4)
- DY=DY+Q(LFDECO+IADRI4+1)
- ENDIF
- IADRI2=IQ(LIDECO+IADRI2+1)
- 92 CONTINUE
- ENDIF
-*
- IADRF=IQ(LIDECO+IADRI2)
- N=IQ(LIDECO+IADRI2+1)
- IF(DX.NE.0..OR.DY.NE.0.)THEN
- DO 94 I=0,N-1
- Q(LFDECO+IADRF+I)=Q(LFDECO+IADRF+I)+DX
- Q(LFDECO+IADRF+I+N)=Q(LFDECO+IADRF+I+N)+DY
- 94 CONTINUE
- ENDIF
- IF(IZPUSH(2,2*N,0,'IZDNB').NE.0)RETURN
- CALL IPL(N
- +, Q(LFDECO+IADRF)
- +, Q(LFDECO+IADRF+N))
- IF(DX.NE.0..OR.DY.NE.0.)THEN
- DO 95 I=0,N-1
- Q(LFDECO+IADRF+I)=Q(LFDECO+IADRF+I)-DX
- Q(LFDECO+IADRF+I+N)=Q(LFDECO+IADRF+I+N)-DY
- 95 CONTINUE
- ENDIF
- IF(ICODE.LT.0)CALL IZSETA
-*
- 93 IF(IALON.NE.0)RETURN
- GOTO 1
-*
-* Polymarker
-*
- 100 IADRI2=IADRI
-*
- IF(ICODE.LT.0)THEN
- CALL IZSAVA
- NBNOP=1
- KATT=0
- 101 IF(IQ(LNDECO+IADRI2).LT.0)THEN
- NBNOP=NBNOP+1
- IADRI2=ABS(IZGADR(LNDECO,IADRI2))
- GOTO 101
- ENDIF
- IADRI2=IZGADR(LNDECO,IADRI2)
- DO 102 I=1,NBNOP
- IF(IQ(LIDECO+IADRI2).EQ.0)THEN
- GOTO 103
- ENDIF
- IF((IQ(LIDECO+IADRI2).EQ.1).AND.(KATT.EQ.0))THEN
- IF(IALON.NE.-1)THEN
- IADRI3=ABS(IZGADR(LNDECO,IQ(LIDECO+IADRI2+2)))-1
- CALL IZDATT(IREPTR+1,IADRI3)
- ENDIF
- KATT=1
- ENDIF
- IADRI2=IQ(LIDECO+IADRI2+1)
- 102 CONTINUE
- ENDIF
-*
- IADRF=IQ(LIDECO+IADRI2)
- N=IQ(LIDECO+IADRI2+1)
- IF(IZPUSH(2,2*N,0,'IZDNB').NE.0)RETURN
- CALL IPM(N
- +, Q(LFDECO+IADRF)
- +, Q(LFDECO+IADRF+N))
- IF(ICODE.LT.0)CALL IZSETA
-*
- 103 IF(IALON.NE.0)RETURN
- GOTO 1
-*
-* Fill area
-*
- 110 DX=0.
- DY=0.
- IADRI2=IADRI
-*
- IF(ICODE.LT.0)THEN
- CALL IZSAVA
- NBNOP=1
- KATT=0
- 111 IF(IQ(LNDECO+IADRI2).LT.0)THEN
- NBNOP=NBNOP+1
- IADRI2=ABS(IZGADR(LNDECO,IADRI2))
- GOTO 111
- ENDIF
- IADRI2=IZGADR(LNDECO,IADRI2)
- DO 112 I=1,NBNOP
- IF(IQ(LIDECO+IADRI2).EQ.0)THEN
- GOTO 113
- ENDIF
- IF((IQ(LIDECO+IADRI2).EQ.1).AND.(KATT.EQ.0))THEN
- IF(IALON.NE.-1)THEN
- IADRI3=ABS(IZGADR(LNDECO,IQ(LIDECO+IADRI2+2)))-1
- CALL IZDATT(IREPTR+1,IADRI3)
- ENDIF
- KATT=1
- ENDIF
- IF(IZGCOD(LIDECO,IADRI2).EQ.3)THEN
- IADRI4=IZGADR(LIDECO,IADRI2)
- DX=DX+Q(LFDECO+IADRI4)
- DY=DY+Q(LFDECO+IADRI4+1)
- ENDIF
- IADRI2=IQ(LIDECO+IADRI2+1)
- 112 CONTINUE
- ENDIF
-*
- IADRF=IQ(LIDECO+IADRI2)
- N=IQ(LIDECO+IADRI2+1)
- IF(DX.NE.0..OR.DY.NE.0.)THEN
- DO 114 I=0,N-1
- Q(LFDECO+IADRF+I)=Q(LFDECO+IADRF+I)+DX
- Q(LFDECO+IADRF+I+N)=Q(LFDECO+IADRF+I+N)+DY
- 114 CONTINUE
- ENDIF
- IF(IZPUSH(2,2*N,0,'IZDNB').NE.0)RETURN
- CALL IFA(N
- +, Q(LFDECO+IADRF)
- +, Q(LFDECO+IADRF+N))
- IF(DX.NE.0..OR.DY.NE.0.)THEN
- DO 115 I=0,N-1
- Q(LFDECO+IADRF+I)=Q(LFDECO+IADRF+I)-DX
- Q(LFDECO+IADRF+I+N)=Q(LFDECO+IADRF+I+N)-DY
- 115 CONTINUE
- ENDIF
- IF(ICODE.LT.0)CALL IZSETA
-*
- 113 IF(IALON.NE.0)RETURN
- GOTO 1
-*
-* Text
-*
- 120 DX=0.
- DY=0.
- IADRI2=IADRI
-*
- IF(ICODE.LT.0)THEN
- CALL IZSAVA
- NBNOP=1
- KATT=0
- 121 IF(IQ(LNDECO+IADRI2).LT.0)THEN
- NBNOP=NBNOP+1
- IADRI2=ABS(IZGADR(LNDECO,IADRI2))
- GOTO 121
- ENDIF
- IADRI2=IZGADR(LNDECO,IADRI2)
- DO 122 I=1,NBNOP
- IF(IQ(LIDECO+IADRI2).EQ.0)THEN
- GOTO 123
- ENDIF
- IF((IQ(LIDECO+IADRI2).EQ.1).AND.(KATT.EQ.0))THEN
- IF(IALON.NE.-1)THEN
- IADRI3=ABS(IZGADR(LNDECO,IQ(LIDECO+IADRI2+2)))-1
- CALL IZDATT(IREPTR+1,IADRI3)
- ENDIF
- KATT=1
- ENDIF
- IF(IZGCOD(LIDECO,IADRI2).EQ.3)THEN
- IADRI4=IZGADR(LIDECO,IADRI2)
- DX=DX+Q(LFDECO+IADRI4)
- DY=DY+Q(LFDECO+IADRI4+1)
- ENDIF
- IADRI2=IQ(LIDECO+IADRI2+1)
- 122 CONTINUE
- ENDIF
-*
- IADRF=IQ(LIDECO+IADRI2)
- IADRC=IQ(LIDECO+IADRI2+1)
- NCHP=IQ(LIDECO+IADRI2+2)
- CALL UHTOC(IQ(LCDECO+IADRC),4,STR,NCHP)
- CHARS=STR(1:NCHP)
- IF(IZPUSH(3,2,(NCHP+3)/4,'IZDNB').NE.0)RETURN
- CALL ITX(Q(LFDECO+IADRF)+DX
- +, Q(LFDECO+IADRF+1)+DY
- +, CHARS)
- IF(ICODE.LT.0)CALL IZSETA
-*
- 123 IF(IALON.NE.0)RETURN
- GOTO 1
-*
-* Boxe
-*
- 130 DX=0.
- DY=0.
- IADRI2=IADRI
-*
- IF(ICODE.LT.0)THEN
- CALL IZSAVA
- NBNOP=1
- KATT=0
- 131 IF(IQ(LNDECO+IADRI2).LT.0)THEN
- NBNOP=NBNOP+1
- IADRI2=ABS(IZGADR(LNDECO,IADRI2))
- GOTO 131
- ENDIF
- IADRI2=IZGADR(LNDECO,IADRI2)
- DO 132 I=1,NBNOP
- IF(IQ(LIDECO+IADRI2).EQ.0)THEN
- GOTO 133
- ENDIF
- IF((IQ(LIDECO+IADRI2).EQ.1).AND.(KATT.EQ.0))THEN
- IF(IALON.NE.-1)THEN
- IADRI3=ABS(IZGADR(LNDECO,IQ(LIDECO+IADRI2+2)))-1
- CALL IZDATT(IREPTR+1,IADRI3)
- ENDIF
- KATT=1
- ENDIF
- IF(IZGCOD(LIDECO,IADRI2).EQ.3)THEN
- IADRI4=IZGADR(LIDECO,IADRI2)
- DX=DX+Q(LFDECO+IADRI4)
- DY=DY+Q(LFDECO+IADRI4+1)
- ENDIF
- IADRI2=IQ(LIDECO+IADRI2+1)
- 132 CONTINUE
- ENDIF
-*
- IF(IZPUSH(0,4,0,'IZDNB').NE.0)RETURN
- CALL IGBOX(Q(LFDECO+IADRI2)+DX
- +, Q(LFDECO+IADRI2+1)+DX
- +, Q(LFDECO+IADRI2+2)+DY
- +, Q(LFDECO+IADRI2+3)+DY)
- IF(ICODE.LT.0)CALL IZSETA
-*
- 133 IF(IALON.NE.0)RETURN
- GOTO 1
-*
-* Frame box
-*
- 140 DX=0.
- DY=0.
- IADRI2=IADRI
-*
- IF(ICODE.LT.0)THEN
- CALL IZSAVA
- NBNOP=1
- KATT=0
- 141 IF(IQ(LNDECO+IADRI2).LT.0)THEN
- NBNOP=NBNOP+1
- IADRI2=ABS(IZGADR(LNDECO,IADRI2))
- GOTO 141
- ENDIF
- IADRI2=IZGADR(LNDECO,IADRI2)
- DO 142 I=1,NBNOP
- IF(IQ(LIDECO+IADRI2).EQ.0)THEN
- GOTO 143
- ENDIF
- IF((IQ(LIDECO+IADRI2).EQ.1).AND.(KATT.EQ.0))THEN
- IF(IALON.NE.-1)THEN
- IADRI3=ABS(IZGADR(LNDECO,IQ(LIDECO+IADRI2+2)))-1
- CALL IZDATT(IREPTR+1,IADRI3)
- ENDIF
- KATT=1
- ENDIF
- IF(IZGCOD(LIDECO,IADRI2).EQ.3)THEN
- IADRI4=IZGADR(LIDECO,IADRI2)
- DX=DX+Q(LFDECO+IADRI4)
- DY=DY+Q(LFDECO+IADRI4+1)
- ENDIF
- IADRI2=IQ(LIDECO+IADRI2+1)
- 142 CONTINUE
- ENDIF
-*
- IF(IZPUSH(0,8,0,'IZDNB').NE.0)RETURN
- CALL IGFBOX(Q(LFDECO+IADRI2)+DX
- +, Q(LFDECO+IADRI2+1)+DX
- +, Q(LFDECO+IADRI2+2)+DY
- +, Q(LFDECO+IADRI2+3)+DY
- +, Q(LFDECO+IADRI2+4)+DX
- +, Q(LFDECO+IADRI2+5)+DX
- +, Q(LFDECO+IADRI2+6)+DY
- +, Q(LFDECO+IADRI2+7)+DY)
- IF(ICODE.LT.0)CALL IZSETA
-*
- 143 IF(IALON.NE.0)RETURN
- GOTO 1
-*
-* Arc
-*
- 150 DX=0.
- DY=0.
- IADRI2=IADRI
-*
- IF(ICODE.LT.0)THEN
- CALL IZSAVA
- NBNOP=1
- KATT=0
- 151 IF(IQ(LNDECO+IADRI2).LT.0)THEN
- NBNOP=NBNOP+1
- IADRI2=ABS(IZGADR(LNDECO,IADRI2))
- GOTO 151
- ENDIF
- IADRI2=IZGADR(LNDECO,IADRI2)
- DO 152 I=1,NBNOP
- IF(IQ(LIDECO+IADRI2).EQ.0)THEN
- GOTO 153
- ENDIF
- IF((IQ(LIDECO+IADRI2).EQ.1).AND.(KATT.EQ.0))THEN
- IF(IALON.NE.-1)THEN
- IADRI3=ABS(IZGADR(LNDECO,IQ(LIDECO+IADRI2+2)))-1
- CALL IZDATT(IREPTR+1,IADRI3)
- ENDIF
- KATT=1
- ENDIF
- IF(IZGCOD(LIDECO,IADRI2).EQ.3)THEN
- IADRI4=IZGADR(LIDECO,IADRI2)
- DX=DX+Q(LFDECO+IADRI4)
- DY=DY+Q(LFDECO+IADRI4+1)
- ENDIF
- IADRI2=IQ(LIDECO+IADRI2+1)
- 152 CONTINUE
- ENDIF
-*
- IF(IZPUSH(0,6,0,'IZDNB').NE.0)RETURN
- CALL IGARC(Q(LFDECO+IADRI2)+DX
- +, Q(LFDECO+IADRI2+1)+DY
- +, Q(LFDECO+IADRI2+2)
- +, Q(LFDECO+IADRI2+3)
- +, Q(LFDECO+IADRI2+4)
- +, Q(LFDECO+IADRI2+5))
- IF(ICODE.LT.0)CALL IZSETA
-*
- 153 IF(IALON.NE.0)RETURN
- GOTO 1
-*
-* Axis
-*
- 160 DX=0.
- DY=0.
- IADRI2=IADRI
- IF(ICODE.GT.0)THEN
- ICHOPT=IQ(LIDECO+IADRI+2)
- ELSE
- ICHOPT=-1
- ENDIF
-*
- IF(ICODE.LT.0)THEN
- CALL IZSAVA
- NBNOP=1
- KATT=0
- 161 IF(IQ(LNDECO+IADRI2).LT.0)THEN
- NBNOP=NBNOP+1
- IADRI2=ABS(IZGADR(LNDECO,IADRI2))
- GOTO 161
- ENDIF
- IADRI2=IZGADR(LNDECO,IADRI2)
- DO 162 I=1,NBNOP
- IF(IQ(LIDECO+IADRI2).EQ.0)THEN
- GOTO 163
- ENDIF
- IF((IQ(LIDECO+IADRI2).EQ.2).AND.(KATT.EQ.0))THEN
- IF(IALON.NE.-1)THEN
- IADRI3=ABS(IZGADR(LNDECO,IQ(LIDECO+IADRI2+2)))-1
- CALL IZDATT(IREPTR+1,IADRI3)
- ICHOPT=IQ(LIDECO+IADRI2+3)
- ENDIF
- KATT=1
- ENDIF
- IF(IZGCOD(LIDECO,IADRI2).EQ.3)THEN
- IADRI4=IZGADR(LIDECO,IADRI2)
- DX=DX+Q(LFDECO+IADRI4)
- DY=DY+Q(LFDECO+IADRI4+1)
- ENDIF
- IADRI2=IQ(LIDECO+IADRI2+1)
- 162 CONTINUE
- ENDIF
-*
- IADRF=IQ(LIDECO+IADRI2)
- IF(ICHOPT.LT.0)THEN
- ICHOPT=IQ(LIDECO+IADRI2+2)
- ENDIF
- CHOPT=' '
- DO 164 I=1,25
- IF(JBIT(ICHOPT,I).NE.0)CHOPT(I:I)=CHAXIS(I)
- 164 CONTINUE
- IF(IZPUSH(3,6,0,'IZDNB').NE.0)RETURN
- CALL IGAXIS(Q(LFDECO+IADRF)+DX
- +, Q(LFDECO+IADRF+1)+DX
- +, Q(LFDECO+IADRF+2)+DY
- +, Q(LFDECO+IADRF+3)+DY
- +, Q(LFDECO+IADRF+4)
- +, Q(LFDECO+IADRF+5)
- +, IQ(LIDECO+IADRI2+1)
- +, CHOPT)
- IF(ICODE.LT.0)CALL IZSETA
-*
- 163 IF(IALON.NE.0)RETURN
- GOTO 1
-*
-* Software characters
-*
- 170 DX=0.
- DY=0.
- IADRI2=IADRI
- IF(ICODE.GT.0)THEN
- ICHOPT=IQ(LIDECO+IADRI+3)
- ELSE
- ICHOPT=-1
- ENDIF
-*
- IF(ICODE.LT.0)THEN
- CALL IZSAVA
- NBNOP=1
- KATT=0
- 171 IF(IQ(LNDECO+IADRI2).LT.0)THEN
- NBNOP=NBNOP+1
- IADRI2=ABS(IZGADR(LNDECO,IADRI2))
- GOTO 171
- ENDIF
- IADRI2=IZGADR(LNDECO,IADRI2)
- DO 172 I=1,NBNOP
- IF(IQ(LIDECO+IADRI2).EQ.0)THEN
- GOTO 173
- ENDIF
- IF((IQ(LIDECO+IADRI2).EQ.2).AND.(KATT.EQ.0))THEN
- IF(IALON.NE.-1)THEN
- IADRI3=ABS(IZGADR(LNDECO,IQ(LIDECO+IADRI2+2)))-1
- CALL IZDATT(IREPTR+1,IADRI3)
- ICHOPT=IQ(LIDECO+IADRI2+3)
- ENDIF
- KATT=1
- ENDIF
- IF(IZGCOD(LIDECO,IADRI2).EQ.3)THEN
- IADRI4=IZGADR(LIDECO,IADRI2)
- DX=DX+Q(LFDECO+IADRI4)
- DY=DY+Q(LFDECO+IADRI4+1)
- ENDIF
- IADRI2=IQ(LIDECO+IADRI2+1)
- 172 CONTINUE
- ENDIF
-*
- IADRF=IQ(LIDECO+IADRI2)
- IADRC=IQ(LIDECO+IADRI2+1)
- NCHP=IQ(LIDECO+IADRI2+2)
- IF(ICHOPT.LT.0)THEN
- ICHOPT=IQ(LIDECO+IADRI2+3)
- ENDIF
- CHOPT=' '
- DO 174 I=1,3
- IF(JBIT(ICHOPT,I).NE.0)CHOPT(I:I)=CHTEXT(I)
- 174 CONTINUE
- CALL UHTOC(IQ(LCDECO+IADRC),4,STR,NCHP)
- CHARS=STR(1:NCHP)
- IF(IZPUSH(4,4,(NCHP+3)/4,'IZDNB').NE.0)RETURN
- CALL IGTEXT(Q(LFDECO+IADRF)+DX
- +, Q(LFDECO+IADRF+1)+DY
- +, CHARS
- +, Q(LFDECO+IADRF+2)
- +, Q(LFDECO+IADRF+3)
- +, CHOPT)
- IF(ICODE.LT.0)CALL IZSETA
-*
- 173 IF(IALON.NE.0)RETURN
- GOTO 1
-*
-* Multiline
-*
- 180 IADRI2=IADRI
-*
- IF(ICODE.LT.0)THEN
- CALL IZSAVA
- NBNOP=1
- KATT=0
- 181 IF(IQ(LNDECO+IADRI2).LT.0)THEN
- NBNOP=NBNOP+1
- IADRI2=ABS(IZGADR(LNDECO,IADRI2))
- GOTO 181
- ENDIF
- IADRI2=IZGADR(LNDECO,IADRI2)
- DO 182 I=1,NBNOP
- IF(IQ(LIDECO+IADRI2).EQ.0)THEN
- GOTO 183
- ENDIF
- IF((IQ(LIDECO+IADRI2).EQ.1).AND.(KATT.EQ.0))THEN
- IF(IALON.NE.-1)THEN
- IADRI3=ABS(IZGADR(LNDECO,IQ(LIDECO+IADRI2+2)))-1
- CALL IZDATT(IREPTR+1,IADRI3)
- ENDIF
- KATT=1
- ENDIF
- IADRI2=IQ(LIDECO+IADRI2+1)
- 182 CONTINUE
- ENDIF
-*
- IADRF=IQ(LIDECO+IADRI2)
- N=IQ(LIDECO+IADRI2+1)
- IF(IZPUSH(2,2*N,0,'IZDNB').NE.0)RETURN
- CALL IML(N
- +, Q(LFDECO+IADRF)
- +, Q(LFDECO+IADRF+N))
- IF(ICODE.LT.0)CALL IZSETA
-*
- 183 IF(IALON.NE.0)RETURN
- GOTO 1
-*
-* Table
-*
- 200 NX=IQ(LIDECO+IADRI)
- NY=IQ(LIDECO+IADRI+1)
- NYY=MAX(NY,1)
- IADRF=IQ(LIDECO+IADRI+2)
- NPAR=IQ(LIDECO+IADRI+3)
- ICHOPT=IQ(LIDECO+IADRI+4)
- CHOPT=' '
- IF(JBIT(ICHOPT, 1).NE.0)CHOPT( 1: 3)='COL'
- IF(JBIT(ICHOPT,13).NE.0)CHOPT(16:17)='S1'
- IF(JBIT(ICHOPT,14).NE.0)CHOPT(16:17)='S2'
- IF(JBIT(ICHOPT,15).NE.0)CHOPT(16:17)='L1'
- IF(JBIT(ICHOPT,16).NE.0)CHOPT(16:17)='L2'
- IF(JBIT(ICHOPT,17).NE.0)CHOPT(18:19)='GZ'
- IF(JBIT(ICHOPT,18).NE.0)CHOPT(20:21)='GX'
- IF(JBIT(ICHOPT,19).NE.0)CHOPT(22:23)='GY'
- IF(JBIT(ICHOPT,20).NE.0)CHOPT(15:16)='LB'
- IF(JBIT(ICHOPT,21).NE.0)CHOPT( 4: 4)='Z'
- IF(JBIT(ICHOPT,22).NE.0)CHOPT(16:17)='S3'
- IF(JBIT(ICHOPT,23).NE.0)CHOPT(16:17)='S4'
- IF(JBIT(ICHOPT,24).NE.0)CHOPT( 1: 3)='POL'
- IF(JBIT(ICHOPT,25).NE.0)CHOPT( 1: 3)='CYL'
- IF(JBIT(ICHOPT,26).NE.0)CHOPT( 1: 3)='SPH'
- IF(JBIT(ICHOPT,27).NE.0)CHOPT( 1: 3)='PSD'
- IF(JBIT(ICHOPT,28).NE.0)CHOPT(38:39)='BB'
- IF(JBIT(ICHOPT,29).NE.0)CHOPT(36:37)='FB'
- IF(JBIT(ICHOPT,30).NE.0)CHOPT(41:41)='E'
- DO 201 I=2,12
- IF(JBIT(ICHOPT,I).NE.0)CHOPT(I+2:I+2)=CHTABL(I-1)
- 201 CONTINUE
- CHOPT(40:40) = 'I'
-*
- NPAR2=NPAR
- IF(NPAR.GE.9)THEN
- IF(Q(LFDECO+IADRF+8).LT.0.)THEN
- IQUEST(60)=Q(LFDECO+IADRF+NPAR)
- NPAR2=NPAR+2
- ENDIF
- IF(Q(LFDECO+IADRF+9).LT.0.)THEN
- IQUEST(61)=Q(LFDECO+IADRF+NPAR+1)
- NPAR2=NPAR+2
- ENDIF
- ENDIF
-*
- IF(IZPUSH(5,NX*NYY+NPAR,0,'IZDNB').NE.0)RETURN
- CALL IGTABL(NX
- +, NY
- +, FLOAT(LFDECO+IADRF+NPAR2-1)
- +, NPAR
- +, Q(LFDECO+IADRF)
- +, CHOPT)
-*
- IF(IALON.NE.0)RETURN
- GOTO 1
-*
-* Graph
-*
- 210 IADRF = IQ(LIDECO+IADRI)
- N = IQ(LIDECO+IADRI+1)
- ICHOPT = IQ(LIDECO+IADRI+2)
- CHOPT = ' '
- DO 211 I=1,12
- IF(JBIT(ICHOPT,I).NE.0)CHOPT(I:I)=CHGRAP(I)
- 211 CONTINUE
-*
- IF(IZPUSH(3,2*N,0,'IZDNB').NE.0)RETURN
- IQUEST(81) = LFDECO+IADRF
- IQUEST(82) = LFDECO+IADRF+N
- CHOPT(20:20) = 'Z'
- CALL IGRAPH(N
- +, Q(LFDECO+IADRF)
- +, Q(LFDECO+IADRF+N)
- +, CHOPT)
-*
- IF(IALON.NE.0)RETURN
- GOTO 1
-*
-* Pave
-*
- 220 IADRF = IQ(LIDECO+IADRI)
- ICHOPT = IQ(LIDECO+IADRI+3)
- CHOPT = ' '
- DO 221 I=1,9
- IF(JBIT(ICHOPT,I).NE.0)CHOPT(I:I)=CHPAVE(I)
- 221 CONTINUE
-*
- IF(IZPUSH(4,5,0,'IZDNB').NE.0)RETURN
- CALL IGPAVE(Q(LFDECO+IADRF)
- +, Q(LFDECO+IADRF+1)
- +, Q(LFDECO+IADRF+2)
- +, Q(LFDECO+IADRF+3)
- +, Q(LFDECO+IADRF+4)
- +, IQ(LIDECO+IADRI+1)
- +, IQ(LIDECO+IADRI+2)
- +, CHOPT)
-*
- IF(IALON.NE.0)RETURN
- GOTO 1
-*
-* Alpha numerique axis labels
-*
- 190 NHILAB=IQ(LIDECO+IADRI)
- IADRC=IQ(LIDECO+IADRI+1)
- LBLLEN=0
- DO 191 I=1,NHILAB
- NCHP=IQ(IADRI+LIDECO+I+1)
- HILABS(I)=' '
- CALL UHTOC(IQ(LCDECO+IADRC+LBLLEN),4,HILABS(I),NCHP)
- LBLLEN=LBLLEN+((NCHP+3)/4)
- 191 CONTINUE
- CALL IZLBL
- IF(IALON.NE.0)RETURN
- GOTO 1
-*
-* Set color representation
-*
- 480 IADRF=IQ(LIDECO+IADRI)
- IF(IZPUSH(2,3,0,'IZDNB').NE.0)RETURN
- CALL ISCR(IDID
- +, IQ(LIDECO+IADRI+1)
- +, Q(LFDECO+IADRF)
- +, Q(LFDECO+IADRF+1)
- +, Q(LFDECO+IADRF+2))
- IF(IALON.NE.0)RETURN
- GOTO 1
-*
-* Set clipping indicator
-*
- 490 CALL ISCLIP(IADRI)
- IF(IALON.NE.0)RETURN
- GOTO 1
-*
-* Real attributes
-*
- 5 IF(IZPUSH(0,1,0,'IZDNB').NE.0)RETURN
- CALL IGSET(CHRATT(ICODE-49),Q(LFDECO+IADRI))
- IF(IALON.NE.0)RETURN
- GOTO 1
-*
-* Integer attributes
-*
- 8 IF(IZPUSH(0,0,0,'IZDNB').NE.0)RETURN
- CALL IGSET(CHIATT(ICODE-79),FLOAT(IADRI-100000))
- IF(IALON.NE.0)RETURN
- GOTO 1
-*
- END
-#endif
diff --git a/src/graflib/higz/iz/izend.F b/src/graflib/higz/iz/izend.F
deleted file mode 100644
index ad59b32..0000000
--- a/src/graflib/higz/iz/izend.F
+++ /dev/null
@@ -1,64 +0,0 @@
-*
-* $Id: izend.F,v 1.1.1.1 1996/02/14 13:11:09 mclareni Exp $
-*
-* $Log: izend.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:09 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_MAIL)
-*CMZ : 1.07/00 23/05/89 15.36.30 by O.Couet
-*-- Author :
- SUBROUTINE IZEND
-*.===========>
-*.
-*. End with HIGZ . If the automatic saving is on the whole
-*. pictures always in memory are saved in the current open
-*. HIGZ file.
-*.
-*..==========> (O.Couet)
-#if defined(CERNLIB_ZEBRA)
-#include "higz/hipaw.inc"
-#endif
-#include "higz/hiflag.inc"
-#if defined(CERNLIB_ZEBRA)
-#include "higz/hicur.inc"
-#endif
-#if defined(CERNLIB_MAIL)
-#include "higz/himail.inc"
-#endif
- DIMENSION INAME(5)
- CHARACTER*32 OLDDIR
-*.______________________________________
-*
-#if defined(CERNLIB_ZEBRA)
- IF((NBPICT.NE.0).AND.ASFLAG)THEN
- LP=LQ(LHIGZ)
- CALL RZCDIR(OLDDIR,'R')
- CALL RZCDIR(HICDIR,' ')
- DO 10 I=1,NBPICT
- CALL IZSCPI(LP)
- CALL VBLANK(INAME,5)
- LOOP=(IQ(LPICT+1)+3)/4
- DO 20 II=1,LOOP
- INAME(II)=IQ(LQ(LPICT-4)+II)
- 20 CONTINUE
- CALL IZWIP(LPICT)
- CALL RZOUT(IXHIGZ,LPICT,INAME,ICYCLE,' ')
- CALL RZSAVE
- LP=LQ(LPICT)
- 10 CONTINUE
- CALL RZCDIR(OLDDIR,' ')
- ENDIF
-#endif
-#if defined(CERNLIB_MAIL)
-*
- IF(MFLAG)THEN
- WRITE (CHMAIL,'(I3)') 999
- CALL IMWRIT(4)
- ENDIF
-#endif
-*
- END
-#endif
diff --git a/src/graflib/higz/iz/izfa.F b/src/graflib/higz/iz/izfa.F
deleted file mode 100644
index 7e142cf..0000000
--- a/src/graflib/higz/iz/izfa.F
+++ /dev/null
@@ -1,165 +0,0 @@
-*
-* $Id: izfa.F,v 1.4 2005/10/28 12:38:18 couet Exp $
-*
-* $Log: izfa.F,v $
-* Revision 1.4 2005/10/28 12:38:18 couet
-* - SVG driver, workstation type -779
-*
-* Revision 1.3 1999/07/21 15:48:29 couet
-* - Improvements in PS Patterns drawing
-*
-* Revision 1.2 1998/05/26 09:19:28 couet
-* - For filling patterns 1 to 25 the PS ouput was wrong in some cases. For those
-* the pattern we now close the polygon (move to X1 Y1).
-*
-* Revision 1.1.1.1 1996/02/14 13:11:09 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_PSCRIPT)||defined(CERNLIB_MAIL)
-*CMZ : 1.21/09 26/09/94 16.21.39 by O.Couet
-*-- Author :
- SUBROUTINE IZFA(N,X,Y)
-*.===========>
-*.
-*. This routine stores in the current picture the necessary data to
-*. draw a fill area .
-*.
-*. _Input parameters:
-*.
-*. INTEGER N : Number of points .
-*. REAL X(N) : X coordinates .
-*. REAL Y(N) : Y coordinates .
-*.
-*..==========> (O.Couet)
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_MAIL)
-#include "higz/hicode.inc"
-#endif
-#include "higz/hiflag.inc"
-#if defined(CERNLIB_ZEBRA)
-#include "higz/hipaw.inc"
-#endif
-#if defined(CERNLIB_PSCRIPT)
-#include "higz/hiatt.inc"
-#include "higz/hipost.inc"
-#endif
-#if defined(CERNLIB_MAIL)
-#include "higz/himail.inc"
-#endif
- DIMENSION X(*),Y(*)
-#if defined(CERNLIB_PSCRIPT)
- LOGICAL GSAV
-#endif
-*.______________________________________
-*
-#if defined(CERNLIB_PSCRIPT)
-#include "higz/hiwcps.inc"
- IF(PFLAG)THEN
- IF(IFAIS.EQ.3.AND.IFASI.GE.100)GOTO 10
- CALL IPZONE
- GSAV=GFLAG
- GFLAG=.FALSE.
- IF(.NOT.TFLAG.AND..NOT.VFLAG) THEN
- CALL IPSCOL(IFACI)
- CALL IPLWID(1)
- ENDIF
- CALL IPLTYP(1)
- IF(IFAIS.EQ.0.AND..NOT.TFLAG.AND..NOT.VFLAG)THEN
- CALL IPDRAW(-N,X,Y)
- CALL IPPSTF(5,' cl s')
- ELSEIF(IFAIS.EQ.3.OR.IFAIS.EQ.2)THEN
- IF(IFASI.EQ.-101)CALL IGHATC(0.0075,180.,N,X,Y)
- IF(IFASI.EQ.-102)CALL IGHATC(0.0075,90.,N,X,Y)
- IF(IFASI.EQ.-103)CALL IGHATC(0.0075,135.,N,X,Y)
- IF(IFASI.EQ.-104)CALL IGHATC(0.0075,45.,N,X,Y)
- IF(IFASI.EQ.-105)CALL IGHATC(0.0075,150.,N,X,Y)
- IF(IFASI.EQ.-106)CALL IGHATC(0.0075,30.,N,X,Y)
- IF(IFASI.EQ.-107)CALL IGHATC(0.0075,120.,N,X,Y)
- IF(IFASI.EQ.-108)CALL IGHATC(0.0075,60.,N,X,Y)
- IF(IFASI.EQ.-109)CALL IGHATC(0.01,180.,N,X,Y)
- IF(IFASI.EQ.-110)CALL IGHATC(0.01,90.,N,X,Y)
- IF(IFASI.EQ.-111)CALL IGHATC(0.01,135.,N,X,Y)
- IF(IFASI.EQ.-112)CALL IGHATC(0.01,45.,N,X,Y)
- IF(IFASI.EQ.-113)CALL IGHATC(0.01,150.,N,X,Y)
- IF(IFASI.EQ.-114)CALL IGHATC(0.01,30.,N,X,Y)
- IF(IFASI.EQ.-115)CALL IGHATC(0.01,120.,N,X,Y)
- IF(IFASI.EQ.-116)CALL IGHATC(0.01,60.,N,X,Y)
- IF(IFASI.EQ.-117)CALL IGHATC(0.015,180.,N,X,Y)
- IF(IFASI.EQ.-118)CALL IGHATC(0.015,90.,N,X,Y)
- IF(IFASI.EQ.-119)CALL IGHATC(0.015,135.,N,X,Y)
- IF(IFASI.EQ.-120)CALL IGHATC(0.015,45.,N,X,Y)
- IF(IFASI.EQ.-121)CALL IGHATC(0.015,150.,N,X,Y)
- IF(IFASI.EQ.-122)CALL IGHATC(0.015,30.,N,X,Y)
- IF(IFASI.EQ.-123)CALL IGHATC(0.015,120.,N,X,Y)
- IF(IFASI.EQ.-124)CALL IGHATC(0.015,60.,N,X,Y)
- IF(IFASI.GE.1.AND.IFASI.LE.25..AND.
- + .NOT.TFLAG.AND..NOT.VFLAG)THEN
- CALL IPDPAT(IFASI,IFACI)
- CALL IPDRAW(-N,X,Y)
- CALL IPPSTF(3,' FA')
- PSRED = -1.
- PSGRN = -1.
- PSBLU = -1.
- ENDIF
- IF(IFASI.EQ.-3.AND..NOT.TFLAG.AND..NOT.VFLAG)THEN
- CALL IPSCOL(5)
- CALL IPDRAW(-N,X,Y)
- CALL IPPSTF(2,' f')
- ENDIF
- ELSEIF(VFLAG) THEN
- IF(IFAIS.EQ.0)THEN
- CALL IPPSTF(28,'<polygon fill="none" stroke=')
- CALL IPSCOL(IFACI)
- CALL IPPSTF(9,' points="')
- CALL IPDRAW(N,X,Y)
- CALL IPPSTF(3,'"/>')
- ELSE
- CALL IPPSTF(14,'<polygon fill=')
- CALL IPSCOL(IFACI)
- CALL IPPSTF(9,' points="')
- CALL IPDRAW(N,X,Y)
- CALL IPPSTF(3,'"/>')
- ENDIF
- ELSEIF(.NOT.TFLAG.AND..NOT.VFLAG) THEN
- CALL IPDRAW(-N,X,Y)
- CALL IPPSTF(2,' f')
- ENDIF
- GFLAG=GSAV
- ENDIF
- 10 CONTINUE
-#endif
-#if defined(CERNLIB_MAIL)
-*
- IF(MFLAG)THEN
- WRITE (CHMAIL,'(I3,I5)') IFACO,N
- CALL IMWRIT(1)
- CALL IMFOUT(N,X)
- CALL IMFOUT(N,Y)
- CALL IMWRIT(5)
- ENDIF
-#endif
-#if defined(CERNLIB_ZEBRA)
-*
- IF(ZFLAG)THEN
- IF(LPICT.LT.0)RETURN
- IF(IZPUSH(2,2*N,0,'IFA').NE.0)RETURN
- CALL IZCFA(IFAICO,1)
- CALL IZCFA(IFASCO,1)
- CALL IZCFA(IFACCO,1)
- CALL IZSTCC(IFACO,INTPTR)
- IQ(LHI+INTPTR) = IFLPTR
- IQ(LHI+INTPTR+1) = N
- CALL IZINCI(2)
- IADR = LHF+IFLPTR-1
- IADRN = IADR+N
- DO 20 I=1,N
- Q(IADR+I) = X(I)
- Q(IADRN+I) = Y(I)
- 20 CONTINUE
- CALL IZINCF(2*N)
- ENDIF
-#endif
-*
- END
-#endif
diff --git a/src/graflib/higz/iz/izfa3.F b/src/graflib/higz/iz/izfa3.F
deleted file mode 100644
index 602d78d..0000000
--- a/src/graflib/higz/iz/izfa3.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: izfa3.F,v 1.1.1.1 1996/02/14 13:11:10 mclareni Exp $
-*
-* $Log: izfa3.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:10 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-#if defined(CERNLIB_ZEBRA)
-*CMZ : 1.11/00 27/09/90 15.56.01 by O.Couet
-*-- Author :
- SUBROUTINE IZFA3(N,X,Y,Z)
-*.===========>
-*.
-*..==========> (O.Couet)
- DIMENSION X(*),Y(*),Z(*)
-*.______________________________________
-*
- END
-#endif
diff --git a/src/graflib/higz/iz/izfbox.F b/src/graflib/higz/iz/izfbox.F
deleted file mode 100644
index 26e4106..0000000
--- a/src/graflib/higz/iz/izfbox.F
+++ /dev/null
@@ -1,69 +0,0 @@
-*
-* $Id: izfbox.F,v 1.1.1.1 1996/02/14 13:11:10 mclareni Exp $
-*
-* $Log: izfbox.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:10 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_MAIL)
-*CMZ : 1.07/00 23/05/89 15.36.30 by O.Couet
-*-- Author :
- SUBROUTINE IZFBOX(X1,X2,Y1,Y2,X3,X4,Y3,Y4)
-*.===========>
-*.
-*. This routine stores in the current picture the necessary data to
-*. draw a frame boxe .
-*.
-*. _Input parameters:
-*.
-*. INTEGER X1,Y1 : Left down corner of the inside boxe .
-*. INTEGER X2,Y2 : Right up corner of the inside boxe .
-*. INTEGER X3,Y3 : Left down corner of the outside boxe .
-*. INTEGER X4,Y4 : Right up corner of the outside boxe .
-*.
-*..==========> (O.Couet)
-#include "higz/hicode.inc"
-#include "higz/hiflag.inc"
-#if defined(CERNLIB_ZEBRA)
-#include "higz/hipaw.inc"
-#endif
-#if defined(CERNLIB_MAIL)
-#include "higz/himail.inc"
-#endif
-*.______________________________________
-*
-#if defined(CERNLIB_ZEBRA)
- IF(ZFLAG)THEN
- IF(LPICT.LT.0)RETURN
- IF(IZPUSH(0,8,0,'IGFBOX').NE.0)RETURN
- CALL IZCFA(IFAICO,1)
- CALL IZCFA(IFASCO,1)
- CALL IZCFA(IFACCO,1)
- CALL IZCFA(IBORCO,1)
-*
- CALL IZSTCC(IFBXCO,IFLPTR)
- Q(LHF+IFLPTR)=X1
- Q(LHF+IFLPTR+1)=X2
- Q(LHF+IFLPTR+2)=Y1
- Q(LHF+IFLPTR+3)=Y2
- Q(LHF+IFLPTR+4)=X3
- Q(LHF+IFLPTR+5)=X4
- Q(LHF+IFLPTR+6)=Y3
- Q(LHF+IFLPTR+7)=Y4
- CALL IZINCF(8)
- ENDIF
-#endif
-#if defined(CERNLIB_MAIL)
-*
- IF(MFLAG)THEN
- WRITE (CHMAIL,'(I3,4E16.7)') IFBXCO,X1,X2,Y1,Y2
- CALL IMWRIT(1)
- WRITE (CHMAIL,'(4E16.7)') X3,X4,Y3,Y4
- CALL IMWRIT(3)
- ENDIF
-#endif
-*
- END
-#endif
diff --git a/src/graflib/higz/iz/izfile.F b/src/graflib/higz/iz/izfile.F
deleted file mode 100644
index 80c4279..0000000
--- a/src/graflib/higz/iz/izfile.F
+++ /dev/null
@@ -1,66 +0,0 @@
-*
-* $Id: izfile.F,v 1.2 1999/10/13 12:32:22 couet Exp $
-*
-* $Log: izfile.F,v $
-* Revision 1.2 1999/10/13 12:32:22 couet
-* - rzmake is now called with 32000
-*
-* Revision 1.1.1.1 1996/02/14 13:11:10 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-#if defined(CERNLIB_ZEBRA)
-*CMZ : 1.21/06 27/06/94 17.36.26 by Rene Brun
-*-- Author :
- SUBROUTINE IZFILE(LUN,CHDIR,CHOPT)
-*.===========>
-*.
-*. This routine create a RZ file .
-*.
-*. _Input parameters:
-*.
-*. INTEGER LUN : Logical unit number .
-*. CHARACTER CHDIR : Top directoy .
-*. CHARACTER CHOPT : Option .
-*.
-*. CHOPT='N' : New RZ file .
-*. CHOPT='X' : EXchange mode .
-*. CHOPT=' ' : Open an existing file .
-*. CHOPT='A' : Pictures are Automatically saved in RZ file .
-*.
-*..==========> (O.Couet)
-#include "higz/hipaw.inc"
-#include "higz/hiflag.inc"
-#include "higz/hicur.inc"
- CHARACTER*(*) CHDIR,CHOPT
- CHARACTER*8 CHTAG(5),CHOPTT
- DIMENSION IOPT(9)
- EQUIVALENCE (IOPT(1),IOPTN),(IOPT(2),IOPTX),(IOPT(3),IOPTA)
-*.______________________________________
-*
- CHOPTT=CHOPT
- CALL CLTOU(CHOPTT)
- CALL UOPTC (CHOPTT,'NXA',IOPT)
-*
- IF(IOPTN.NE.0)THEN
- CHTAG(1)=' '
- CHTAG(2)='PICTURE'
- CHTAG(3)='NAME'
- CHTAG(4)=' '
- CHTAG(5)=' '
- I=INDEX(CHOPTT,'N')
- CHOPTT(I:I)='?'
- CALL RZMAKE(LUN,CHDIR,5,'AAAAA',CHTAG,32000,CHOPTT)
- ELSE
- CALL RZFILE(LUN,CHDIR,CHOPTT)
- ENDIF
- CALL RZCDIR(HICDIR,'R')
-*
- IF(IOPTA.NE.0)THEN
- ASFLAG=.TRUE.
- ENDIF
-*
- END
-
-#endif
diff --git a/src/graflib/higz/iz/izgadr.F b/src/graflib/higz/iz/izgadr.F
deleted file mode 100644
index 44e597d..0000000
--- a/src/graflib/higz/iz/izgadr.F
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: izgadr.F,v 1.1.1.1 1996/02/14 13:11:10 mclareni Exp $
-*
-* $Log: izgadr.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:10 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-#if defined(CERNLIB_ZEBRA)
-*CMZ : 1.11/00 27/09/90 15.56.02 by O.Couet
-*-- Author :
- FUNCTION IZGADR(LN,IPOS)
-*.===========>
-*.
-*. This function Gives the ADRess in the word number IPOS in the bank LN .
-*.
-*. _Input parameters:
-*.
-*. INTEGER LN : NT link .
-*. INTEGER IPOS : Word position .
-*.
-*..==========> (O.Couet)
-#include "higz/hipaw.inc"
-*.______________________________________
-*
- IF(LN.GT.0)THEN
- IZGADR=MOD(IQ(LN+IPOS),1000000)
- ELSE
- IZGADR=0
- ENDIF
-*
- END
-#endif
diff --git a/src/graflib/higz/iz/izgcod.F b/src/graflib/higz/iz/izgcod.F
deleted file mode 100644
index 2b597a9..0000000
--- a/src/graflib/higz/iz/izgcod.F
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: izgcod.F,v 1.1.1.1 1996/02/14 13:11:10 mclareni Exp $
-*
-* $Log: izgcod.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:10 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-#if defined(CERNLIB_ZEBRA)
-*CMZ : 1.11/00 27/09/90 15.56.02 by O.Couet
-*-- Author :
- FUNCTION IZGCOD(LN,IPOS)
-*.===========>
-*.
-*. This function Gives the CODe in the word number IPOS in the bank LN .
-*.
-*. _Input parameters:
-*.
-*. INTEGER LN : NT link .
-*. INTEGER IPOS : Word position .
-*.
-*..==========> (O.Couet)
-#include "higz/hipaw.inc"
-*.______________________________________
-*
- IF(LN.GT.0)THEN
- IZGCOD=INT(IQ(LN+IPOS)/1000000)
- ELSE
- IZGCOD=0
- ENDIF
-*
- END
-#endif
diff --git a/src/graflib/higz/iz/izghnp.F b/src/graflib/higz/iz/izghnp.F
deleted file mode 100644
index 9660759..0000000
--- a/src/graflib/higz/iz/izghnp.F
+++ /dev/null
@@ -1,37 +0,0 @@
-*
-* $Id: izghnp.F,v 1.1.1.1 1996/02/14 13:11:10 mclareni Exp $
-*
-* $Log: izghnp.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:10 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-#if defined(CERNLIB_ZEBRA)
-*CMZ : 1.17/00 05/02/93 11.31.22 by O.Couet
-*-- Author :
- INTEGER FUNCTION IZGHNP(LP)
-*.===========>
-*.
-*. This function Gives the Higher Normalisation
-*. transformation Priority in the picture LP .
-*.
-*. _Input parameters:
-*.
-*. INTEGER LP : Picture link .
-*.
-*..==========> (O.Couet)
-#include "higz/hipaw.inc"
-*.______________________________________
-*
- IZGHNP=1
- IF(LP.LE.0)RETURN
- LN=LQ(LP-1)
- DO 10 I=1,IQ(LP+8)
- IF(LN.EQ.0)RETURN
- IF(IQ(LN+3).GT.IZGHNP)IZGHNP=IQ(LN+3)
- LN=LQ(LN)
- 10 CONTINUE
-*
- END
-#endif
diff --git a/src/graflib/higz/iz/izgngt.F b/src/graflib/higz/iz/izgngt.F
deleted file mode 100644
index 0dcdcaf..0000000
--- a/src/graflib/higz/iz/izgngt.F
+++ /dev/null
@@ -1,44 +0,0 @@
-*
-* $Id: izgngt.F,v 1.1.1.1 1996/02/14 13:11:10 mclareni Exp $
-*
-* $Log: izgngt.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:10 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-#if defined(CERNLIB_ZEBRA)
-*CMZ : 1.11/00 27/09/90 15.56.02 by O.Couet
-*-- Author :
- INTEGER FUNCTION IZGNGT(LP,NGT)
-*.===========>
-*.
-*. This function Gives the link to the first normalisation transformation
-*. which priority is Greater Than NGT in the picture LP .
-*.
-*. _Input parameters:
-*.
-*. INTEGER LP : Picture link .
-*. INTEGER NGT : Lower value of priority .
-*.
-*..==========> (O.Couet)
-#include "higz/hipaw.inc"
-*.______________________________________
-*
- IZGNGT=0
- LN=LQ(LP-1)
- IGP=IZGHNP(LP)
- DO 10 I=1,IQ(LP+8)
- IF(LN.EQ.0)GOTO 99
- IP=IQ(LN+3)
- IF(IP.GT.NGT)THEN
- IF(IP.LE.IGP)THEN
- IGP=IP
- IZGNGT=LN
- ENDIF
- ENDIF
- LN=LQ(LN)
- 10 CONTINUE
-*
- 99 END
-#endif
diff --git a/src/graflib/higz/iz/izgnnt.F b/src/graflib/higz/iz/izgnnt.F
deleted file mode 100644
index 463085f..0000000
--- a/src/graflib/higz/iz/izgnnt.F
+++ /dev/null
@@ -1,50 +0,0 @@
-*
-* $Id: izgnnt.F,v 1.1.1.1 1996/02/14 13:11:10 mclareni Exp $
-*
-* $Log: izgnnt.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:10 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-#if defined(CERNLIB_ZEBRA)
-*CMZ : 1.23/00 10/04/95 10.38.45 by O.Couet
-*-- Author : O.Couet
- FUNCTION IZGNNT(NT)
-*.===========>
-*.
-*. This function returns in the current picture the Normalisation
-*. Transformation stored after NT. This is useful to loop over all
-*. the transformations in a picture. If -1 is return the transformation
-*. NT has not be found, or the last NT has been found.
-*.
-*. _Input parameters:
-*.
-*. INTEGER NT : Normalisation transformation number .
-*.
-*..==========> (O.Couet)
-#include "higz/hipaw.inc"
-*.______________________________________
-*
- IZGNNT = -1
- IF (LPICT.LE.0) GOTO 999
- LN = LHNT0
- DO 10 I=1,INBNT
- IF (LN.EQ.0) THEN
- GOTO 999
- ELSE
- IF (IQ(LN+1).EQ.NT) THEN
- LN = LQ(LN)
- IF (LN.EQ.0) THEN
- GOTO 999
- ELSE
- IZGNNT = IQ(LN+1)
- GOTO 999
- ENDIF
- ENDIF
- LN = LQ(LN)
- ENDIF
- 10 CONTINUE
-*
- 999 END
-#endif
diff --git a/src/graflib/higz/iz/izgnt.F b/src/graflib/higz/iz/izgnt.F
deleted file mode 100644
index 440fd5c..0000000
--- a/src/graflib/higz/iz/izgnt.F
+++ /dev/null
@@ -1,53 +0,0 @@
-*
-* $Id: izgnt.F,v 1.1.1.1 1996/02/14 13:11:10 mclareni Exp $
-*
-* $Log: izgnt.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:10 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-#if (!defined(CERNLIB_NTC))&&(!defined(CERNLIB_X11))
-*CMZ : 1.19/10 15/09/93 09.46.39 by O.Couet
-*-- Author :
- SUBROUTINE IZGNT(NT,IFIND,IAWV,IPRIO,IHPRIO)
-*.===========>
-*.
-*. This routine searchs in the NT storage if the transformation NT
-*. exits. And returns the adress and the priority of the transformation
-*. NT if IFIND.NE.0 .
-*.
-*. _Input parameters:
-*.
-*. INTEGER NT : Normalisation transformation number .
-*.
-*. _Output parameters:
-*.
-*. INTEGER IFIND : IFIND.NE.0 if NT already exist (IFIND = Adress of the
-*. priority word).
-*. INTEGER IAWV : Transformation parameters adress .
-*. INTEGER IPRIO : NT priority .
-*. INTEGER IHPRIO : Highest NT priority .
-*.
-*..==========> (O.Couet, R.Wilhelm)
-#include "higz/hint.inc"
-#include "higz/hiatt.inc"
-*.______________________________________
-*
- IFIND=0
- IHPRIO=NT0PRI
- IF(NTSTOR(1).EQ.0)RETURN
-*
- DO 10 I=0,NTSTOR(1)-1
- IOFF=INWDNT*I
- IOF3=IOFF+3
- IF(NTSTOR(2+IOFF).EQ.NT)THEN
- IFIND=IOF3
- IPRIO=NTSTOR(IFIND)
- IAWV=I*8+1
- ENDIF
- IF(NTSTOR(IOF3).GT.IHPRIO)IHPRIO=NTSTOR(IOF3)
- 10 CONTINUE
-*
- END
-#endif
diff --git a/src/graflib/higz/iz/izgntp.F b/src/graflib/higz/iz/izgntp.F
deleted file mode 100644
index ffd47c9..0000000
--- a/src/graflib/higz/iz/izgntp.F
+++ /dev/null
@@ -1,44 +0,0 @@
-*
-* $Id: izgntp.F,v 1.1.1.1 1996/02/14 13:11:10 mclareni Exp $
-*
-* $Log: izgntp.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:10 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-#if defined(CERNLIB_ZEBRA)
-*CMZ : 1.11/00 27/09/90 15.56.02 by O.Couet
-*-- Author :
- FUNCTION IZGNTP(NT)
-*.===========>
-*.
-*. This routine searchs in the current picture if the Normalisation
-*. Transformation bank NT exits .
-*.
-*. If IZGNTP=0 : There is no transformation bank NT in the current picture .
-*. If IZGNTP>0 : The transformation bank NT exists in the current picture
-*. and IZGNTP gives the link NT bank value .
-*.
-*. _Input parameters:
-*.
-*. INTEGER NT : Normalisation transformation number .
-*.
-*..==========> (O.Couet)
-#include "higz/hipaw.inc"
-*.______________________________________
-*
- IZGNTP=0
- IF(LPICT.LE.0)GOTO 99
- LN=LHNT0
- DO 10 I=1,INBNT
- IF(LN.EQ.0)GOTO 99
- IF(IQ(LN+1).EQ.NT)THEN
- IZGNTP=LN
- GOTO 99
- ENDIF
- LN=LQ(LN)
- 10 CONTINUE
-*
- 99 END
-#endif
diff --git a/src/graflib/higz/iz/izgrap.F b/src/graflib/higz/iz/izgrap.F
deleted file mode 100644
index 9fe7f09..0000000
--- a/src/graflib/higz/iz/izgrap.F
+++ /dev/null
@@ -1,111 +0,0 @@
-*
-* $Id: izgrap.F,v 1.1.1.1 1996/02/14 13:11:10 mclareni Exp $
-*
-* $Log: izgrap.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:10 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_MAIL)
-*CMZ : 1.23/00 25/04/95 11.19.19 by O.Couet
-*-- Author :
- SUBROUTINE IZGRAP(N,X,Y,IOPT,IOPTZ)
-*.===========>
-*.
-*. This routine stores in the current picture the necessary data to
-*. to draw a graphic .
-*.
-*. _Input parameters:
-*.
-*. INTEGER N : Number of points .
-*. REAL X(N or 2 or N+1) : X coordinates .
-*. REAL Y(N or 2 or N+1) : Y coordinates .
-*. INTEGER IOPT : Option .
-*.
-*..==========> (O.Couet)
-#include "higz/hicode.inc"
-#include "higz/hiflag.inc"
-#if defined(CERNLIB_ZEBRA)
-#include "higz/hipaw.inc"
-#endif
-#if defined(CERNLIB_MAIL)
-#include "higz/himail.inc"
-#endif
- EQUIVALENCE (LXADR,L2NTLA),(LYADR,LDNTLA)
- DIMENSION IOPT(*)
- DIMENSION X(2),Y(2)
-*.______________________________________
-*
-#include "higz/hibit.inc"
-#if defined(CERNLIB_ZEBRA)
-*
- IF(ZFLAG)THEN
- IF(LPICT.LT.0)RETURN
- IF(IZPUSH(3,2*N,0,'IGRAPH').NE.0)RETURN
- CALL IZCFA(IBOFCO,1)
- CALL IZCFA(IBWDCO,1)
- CALL IZCFA(ILNCO,1)
- CALL IZCFA(ILWSCO,1)
- CALL IZCFA(IPLCCO,1)
- CALL IZCFA(IBSLCO,1)
- CALL IZCFA(IFAICO,1)
- CALL IZCFA(IFASCO,1)
- CALL IZCFA(IFACCO,1)
- CALL IZCFA(ITMSCO,1)
- CALL IZCFA(IALHCO,1)
- CALL IZCFA(IALDCO,1)
- CALL IZCFA(ITXCCO,1)
- CALL IZCFA(ITXFCO,1)
- CALL IZCFA(IGTSCO,1)
- CALL IZCFA(IGTWCO,1)
- CALL IZCFA(IAWLCO,1)
- CALL IZCFA(IMKCO,1)
- CALL IZCFA(IMKSCO,1)
- CALL IZCFA(IPMCCO,1)
- CALL IZCFA(IBORCO,1)
-*
- CALL IZSTCC(IGRACO,INTPTR)
- IQ(LHI+INTPTR) = IFLPTR
- IQ(LHI+INTPTR+1) = N
- DO 10 I=1,12
- IF(IOPT(I).NE.0)CALL SBIT1(IQ(LHI+INTPTR+2),I)
- 10 CONTINUE
- CALL IZINCI(3)
- IF(IOPT(7).NE.0)THEN
- DO 20 I=1,N
- IF(IOPTZ.NE.0)THEN
- Q(LHF+IFLPTR+I-1) = Q(LYADR+I-1)
- Q(LHF+IFLPTR+I+N-1) = Q(LXADR+I-1)
- ELSE
- Q(LHF+IFLPTR+I-1) = Y(I)
- Q(LHF+IFLPTR+I+N-1) = X(I)
- ENDIF
- 20 CONTINUE
- ELSE
- DO 30 I=1,N
- IF(IOPTZ.NE.0)THEN
- Q(LHF+IFLPTR+I-1) = Q(LXADR+I-1)
- Q(LHF+IFLPTR+I+N-1) = Q(LYADR+I-1)
- ELSE
- Q(LHF+IFLPTR+I-1) = X(I)
- Q(LHF+IFLPTR+I+N-1) = Y(I)
- ENDIF
- 30 CONTINUE
- ENDIF
- CALL IZINCF(2*N)
- ENDIF
-#endif
-#if defined(CERNLIB_MAIL)
-*
- IF(MFLAG)THEN
- WRITE (CHMAIL,'(I3,A10,I5)') IGRACO,CHOPTM,N
- CALL IMWRIT(1)
- CALL IMFOUT(N,X)
- CALL IMFOUT(N,Y)
- CALL IMWRIT(5)
- ENDIF
-#endif
-*
- END
-#endif
diff --git a/src/graflib/higz/iz/izhist.F b/src/graflib/higz/iz/izhist.F
deleted file mode 100644
index 8786c66..0000000
--- a/src/graflib/higz/iz/izhist.F
+++ /dev/null
@@ -1,160 +0,0 @@
-*
-* $Id: izhist.F,v 1.1.1.1 1996/02/14 13:11:10 mclareni Exp $
-*
-* $Log: izhist.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:10 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_MAIL)
-*CMZ : 1.23/00 25/04/95 11.18.53 by O.Couet
-*-- Author :
- SUBROUTINE IZHIST(N,X,Y,IOPT,IOPTZ)
-*.===========>
-*.
-*. This routine stores in the current picture the necessary data to
-*. to draw a graphic .
-*.
-*. _Input parameters:
-*.
-*. INTEGER N : Number of points .
-*. REAL X(N or 2 or N+1) : X coordinates .
-*. REAL Y(N or 2 or N+1) : Y coordinates .
-*. INTEGER IOPT : Option .
-*.
-*..==========> (O.Couet)
-#include "higz/hicode.inc"
-#include "higz/hiflag.inc"
-#if defined(CERNLIB_ZEBRA)
-#include "higz/hipaw.inc"
-#endif
-#if defined(CERNLIB_MAIL)
-#include "higz/himail.inc"
-#endif
- EQUIVALENCE (LXADR,L2NTLA),(LYADR,LDNTLA)
- DIMENSION IOPT(*)
- DIMENSION X(2),Y(2)
-*.______________________________________
-*
-#include "higz/hibit.inc"
-#if defined(CERNLIB_ZEBRA)
-*
- IF(ZFLAG)THEN
- IF(LPICT.LT.0)RETURN
- IF(IOPT(8).NE.0)THEN
- IF(IZPUSH(3,2*N+2,0,'IGHIST').NE.0)RETURN
- ELSE
- IF(IZPUSH(3,N+2,0,'IGHIST').NE.0)RETURN
- ENDIF
- CALL IZCFA(IBOFCO,1)
- CALL IZCFA(IBWDCO,1)
- CALL IZCFA(ILNCO,1)
- CALL IZCFA(ILWSCO,1)
- CALL IZCFA(IPLCCO,1)
- CALL IZCFA(IFAICO,1)
- CALL IZCFA(IFASCO,1)
- CALL IZCFA(IFACCO,1)
- CALL IZCFA(ITMSCO,1)
- CALL IZCFA(IALHCO,1)
- CALL IZCFA(IALDCO,1)
- CALL IZCFA(ITXCCO,1)
- CALL IZCFA(ITXFCO,1)
- CALL IZCFA(IGTSCO,1)
- CALL IZCFA(IGTWCO,1)
- CALL IZCFA(IAWLCO,1)
- CALL IZCFA(IMKCO,1)
- CALL IZCFA(IMKSCO,1)
- CALL IZCFA(IPMCCO,1)
- CALL IZCFA(IBORCO,1)
-*
- CALL IZSTCC(IHISCO,INTPTR)
- IQ(LHI+INTPTR)=IFLPTR
- IQ(LHI+INTPTR+1)=N
- DO 10 I=1,14
- IF(IOPT(I).NE.0)CALL SBIT1(IQ(LHI+INTPTR+2),I)
- 10 CONTINUE
- CALL IZINCI(3)
- NN=2
- IF(IOPT(5).NE.0)THEN
- IF(IOPTZ.NE.0)THEN
- Q(LHF+IFLPTR)=Q(LYADR)
- Q(LHF+IFLPTR+1)=Q(LYADR+1)
- ELSE
- Q(LHF+IFLPTR)=Y(1)
- Q(LHF+IFLPTR+1)=Y(2)
- ENDIF
- IF(IOPT(8).NE.0)THEN
- NN=N+1
- DO 20 I=3,NN
- IF(IOPTZ.NE.0)THEN
- Q(LHF+IFLPTR+I-1)=Q(LYADR+I-1)
- ELSE
- Q(LHF+IFLPTR+I-1)=Y(I)
- ENDIF
- 20 CONTINUE
- ENDIF
- CALL IZINCF(NN)
- DO 30 I=1,N
- IF(IOPTZ.NE.0)THEN
- Q(LHF+IFLPTR+I-1)=Q(LXADR+I-1)
- ELSE
- Q(LHF+IFLPTR+I-1)=X(I)
- ENDIF
- 30 CONTINUE
- ELSE
- IF(IOPTZ.NE.0)THEN
- Q(LHF+IFLPTR)=Q(LXADR)
- Q(LHF+IFLPTR+1)=Q(LXADR+1)
- ELSE
- Q(LHF+IFLPTR)=X(1)
- Q(LHF+IFLPTR+1)=X(2)
- ENDIF
- IF(IOPT(8).NE.0)THEN
- NN=N+1
- DO 40 I=3,NN
- IF(IOPTZ.NE.0)THEN
- Q(LHF+IFLPTR+I-1)=Q(LXADR+I-1)
- ELSE
- Q(LHF+IFLPTR+I-1)=X(I)
- ENDIF
- 40 CONTINUE
- ENDIF
- CALL IZINCF(NN)
- DO 50 I=1,N
- IF(IOPTZ.NE.0)THEN
- Q(LHF+IFLPTR+I-1)=Q(LYADR+I-1)
- ELSE
- Q(LHF+IFLPTR+I-1)=Y(I)
- ENDIF
- 50 CONTINUE
- ENDIF
- CALL IZINCF(N)
- ENDIF
-#endif
-#if defined(CERNLIB_MAIL)
-*
- IF(MFLAG)THEN
- WRITE (CHMAIL,'(I3,A10,I5)') IHISCO,CHOPTM,N
- CALL IMWRIT(1)
- IF(IOPT(5).NE.0)THEN
- IF(IOPT(8).NE.0)THEN
- CALL IMFOUT(N+1,Y)
- ELSE
- CALL IMFOUT(2,Y)
- ENDIF
- CALL IMFOUT(N,X)
- ELSE
- IF(IOPT(8).NE.0)THEN
- CALL IMFOUT(N+1,X)
- ELSE
- CALL IMFOUT(2,X)
- ENDIF
- CALL IMFOUT(N,Y)
- ENDIF
- CALL IMWRIT(5)
- ENDIF
-#endif
-*
- END
-#endif
diff --git a/src/graflib/higz/iz/izin.F b/src/graflib/higz/iz/izin.F
deleted file mode 100644
index 9366615..0000000
--- a/src/graflib/higz/iz/izin.F
+++ /dev/null
@@ -1,141 +0,0 @@
-*
-* $Id: izin.F,v 1.1.1.1 1996/02/14 13:11:10 mclareni Exp $
-*
-* $Log: izin.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:10 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-#if defined(CERNLIB_ZEBRA)
-*CMZ : 1.07/00 24/05/89 16.36.33 by O.Couet
-* Control if the current directory is a picture data base.
-*-- Author :
- SUBROUTINE IZIN(PNAME,ICYCLE)
-*.===========>
-*.
-*. This routine manages the INput of the pictures on RZ files .
-*.
-*. _Input parameters:
-*.
-*. CHARACTER PNAME : Picture name .
-*. INTEGER ICYCLE : Cycle number of the picture on the RZ file .
-*.
-*. Special cases:
-*.
-*. If ICYCLE<0 then IABS(ICYCLE) is assumed to be the
-*. picture serial number in the RZ file.
-*. In this case PNAME is an output parameter containing
-*. the name of the picture.
-*. If this serial number does not exist, then PNAME is set to ' '
-*. and IQUEST(1)=1
-*.
-*. If PNAME='*' all pictures on disk are put in memory
-*.
-*..==========> (O.Couet)
-#include "higz/hipaw.inc"
- CHARACTER*(*) PNAME
- CHARACTER*20 PNAMEI
- CHARACTER*32 CHPATH
- DIMENSION NAME(5)
- CHARACTER*1 CHOPT
- CHARACTER*8 CHTAG(5),CHFORM
-*.______________________________________
-*
-* Verify if the picture PNAME is in memory
-*
- IF(IZRPIP(PNAME).NE.0)THEN
- CALL IGERR('Picture already in memory','IZIN')
- RETURN
- ENDIF
-*
-* Verify if the current working directrory
-* is a pictures data base
-*
- CALL RZKEYD(NWKEY,CHFORM,CHTAG)
- IF(CHTAG(2).NE.'PICTURE')RETURN
-*
-* Create the bank LHIGZ if it does'nt exist
-*
- LPSAV=LPICT
- IF(LHIGZ.EQ.0)THEN
- CALL MZBOOK(IXHIGZ,LPICT,LHIGZ,1,'PICT',1,1,5,2,0)
- ENDIF
-*
-* Compute the link of the last picture in memory
-*
- LP=LHIGZ
- 10 IF(LP.NE.0)THEN
- LAST=LP
- LP=LQ(LP)
- GOTO 10
- ENDIF
-*
-* Get the number of pictures on disk
-*
- CALL RZCDIR(CHPATH,'RP')
- NKEYS=IQUEST(7)
-*
-* Put all pictures on disk in memory
-*
- IF(PNAME.EQ.'*')THEN
- DO 40 I=1,NKEYS
- CALL RZIN(IXHIGZ,LAST,0,I,9999,'S')
- LP=LHIGZ
- 20 IF(LP.NE.0)THEN
- LAST=LP
- LP=LQ(LP)
- GOTO 20
- ENDIF
- CALL IZSCPI(LAST)
- IF(IQUEST(1).EQ.0)NBPICT=NBPICT+1
- CALL IZPICT(PNAMEI,'R')
- LP=IZRPIP(PNAMEI)
- IF((LP.GT.0).AND.(LP.NE.LPICT))CALL IZPICT(' ','S')
- LP=LHIGZ
- 30 IF(LP.NE.0)THEN
- LAST=LP
- LP=LQ(LP)
- GOTO 30
- ENDIF
- 40 CONTINUE
- CALL IZSCPI(LPSAV)
- RETURN
- ENDIF
-*
-* Put one picture on disk in memory (by name or by number)
-*
- IF(ICYCLE.GE.0)THEN
- CHOPT=' '
- LP=IZRPIP(PNAME)
- NCH=LENOCC(PNAME)
- CALL VBLANK(NAME,5)
- CALL UCTOH(PNAME,NAME,4,NCH)
- ICY=ICYCLE
- ELSE
- NAME(1)=-ICYCLE
- PNAME=' '
- IF(NAME(1).GT.NKEYS)THEN
- IQUEST(1)=1
- RETURN
- ENDIF
- NCH=LEN(PNAME)
- NCH=MIN(NCH,20)
- CHOPT='S'
- LP=0
- ICY=9999
- ENDIF
- IF(LP.GT.0) CALL MZDROP(IXHIGZ,LP,' ')
- IF(LAST.EQ.0)THEN
- CALL RZIN(IXHIGZ,LHIGZ,1,NAME,ICY,CHOPT)
- ELSE
- CALL RZIN(IXHIGZ,LAST,0,NAME,ICY,CHOPT)
- ENDIF
- IF(IQUEST(1).EQ.0)THEN
- NBPICT=NBPICT+1
- IF(ICYCLE.LT.0) CALL UHTOC(IQUEST(21),4,PNAME,NCH)
- ENDIF
- CALL IZSCPI(LPSAV)
-*
- END
-#endif
diff --git a/src/graflib/higz/iz/izincf.F b/src/graflib/higz/iz/izincf.F
deleted file mode 100644
index 30a2b12..0000000
--- a/src/graflib/higz/iz/izincf.F
+++ /dev/null
@@ -1,30 +0,0 @@
-*
-* $Id: izincf.F,v 1.1.1.1 1996/02/14 13:11:10 mclareni Exp $
-*
-* $Log: izincf.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:10 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-#if defined(CERNLIB_ZEBRA)
-*CMZ : 1.11/00 27/09/90 15.56.02 by O.Couet
-*-- Author :
- SUBROUTINE IZINCF(INC)
-*.===========>
-*.
-*. Increments the (F) bank pointer .
-*.
-*. _Input parameters:
-*.
-*. INTEGER INC : Increment .
-*.
-*..==========> (O.Couet)
-#include "higz/hipaw.inc"
-*.______________________________________
-*
- IFLPTR=IFLPTR+INC
- IQ(LPICT+3)=IFLPTR
-*
- END
-#endif
diff --git a/src/graflib/higz/iz/izinci.F b/src/graflib/higz/iz/izinci.F
deleted file mode 100644
index 494f689..0000000
--- a/src/graflib/higz/iz/izinci.F
+++ /dev/null
@@ -1,30 +0,0 @@
-*
-* $Id: izinci.F,v 1.1.1.1 1996/02/14 13:11:10 mclareni Exp $
-*
-* $Log: izinci.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:10 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-#if defined(CERNLIB_ZEBRA)
-*CMZ : 1.11/00 27/09/90 15.56.02 by O.Couet
-*-- Author :
- SUBROUTINE IZINCI(INC)
-*.===========>
-*.
-*. Increments the (I) bank pointer .
-*.
-*. _Input parameters:
-*.
-*. INTEGER INC : Increment .
-*.
-*..==========> (O.Couet)
-#include "higz/hipaw.inc"
-*.______________________________________
-*
- INTPTR=INTPTR+INC
- IQ(LPICT+2)=INTPTR
-*
- END
-#endif
diff --git a/src/graflib/higz/iz/izincs.F b/src/graflib/higz/iz/izincs.F
deleted file mode 100644
index 9fb3c2e..0000000
--- a/src/graflib/higz/iz/izincs.F
+++ /dev/null
@@ -1,30 +0,0 @@
-*
-* $Id: izincs.F,v 1.1.1.1 1996/02/14 13:11:10 mclareni Exp $
-*
-* $Log: izincs.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:10 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-#if defined(CERNLIB_ZEBRA)
-*CMZ : 1.11/00 27/09/90 15.56.02 by O.Couet
-*-- Author :
- SUBROUTINE IZINCS(INC)
-*.===========>
-*.
-*. Increments the (C) bank pointer .
-*.
-*. _Input parameters:
-*.
-*. INTEGER INC : Increment .
-*.
-*..==========> (O.Couet)
-#include "higz/hipaw.inc"
-*.______________________________________
-*
- ISTPTR=ISTPTR+INC
- IQ(LPICT+4)=ISTPTR
-*
- END
-#endif
diff --git a/src/graflib/higz/iz/izinit.F b/src/graflib/higz/iz/izinit.F
deleted file mode 100644
index e99bc28..0000000
--- a/src/graflib/higz/iz/izinit.F
+++ /dev/null
@@ -1,83 +0,0 @@
-*
-* $Id: izinit.F,v 1.1.1.1 1996/02/14 13:11:10 mclareni Exp $
-*
-* $Log: izinit.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:10 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-#if defined(CERNLIB_ZEBRA)
-*CMZ : 1.06/06 08/03/89 15.00.12 by O.Couet
-*-- Author :
- SUBROUTINE IZINIT(NWORDS)
-*.===========>
-*.
-*. This routine initialize the IZ package :
-*.
-*. -Creates an HIGZ division .
-*. -Initialise the links .
-*. -Initialize the following parameters :
-*.
-*. INSIZ : Default (NT) bank size .
-*. IISIZ : Default (I) bank size .
-*. IFSIZ : Default (F) bank size .
-*. ISSIZ : Default (C) bank size .
-*. NBPICT : Number of pictures in memory .
-*. LPICT : Current picture link . If < 0 , there is no current picture .
-*. LPICD : Displayed picture link . If < 0 , there is no displayed picture .
-*. KXXX : Flag for XXX attributes . Indicate if a primitive with XXX
-*. attributes has been called since the last call to the
-*. XXX attribute .
-*.
-*. _Input parameters:
-*.
-*. INTEGER NWORDS : Minimal ZEBRA space in memory
-*. (if=0 , standart memory allocation)
-*.
-*..==========> (O.Couet)
-#include "higz/hiatnb.inc"
-#include "higz/hipaw.inc"
-#include "higz/hiflat.inc"
- DIMENSION IRFLAT(NBRATT),IIFLAT(NBIATT)
- EQUIVALENCE (IRFLAT(1),KMKSC),(IIFLAT(1),KPLCI)
-*.______________________________________
-*
-* Default bank sizes initialisation
-*
- INSIZ=100
- IISIZ=500
- IFSIZ=1000
- ISSIZ=100
-*
-* ZEBRA space initialisation
-*
- NW=NWORDS
- IF(NW.LT.500)NW=500
- IF(NW.GT.NWPAW-1000)NW=NWPAW-1000
-*
-* HIGZ division initialisation
-* Links initialisation
-*
- CALL MZDIV(IXPAWC,IXHIGZ,'HIGZ',NW,NWPAW,'P')
- CALL MZLINK(IXPAWC,'/HILINK/',LHIGZ,LWV,LAST)
-*
-* Number of pictures=0
-* No current IZ picture
-* Display picture=current IZ picture
-*
- NBPICT=0
- LPICT=-1
- LPICD=LPICT
-*
-* Attributes flags initialisation
-*
- DO 10 I=1,NBRATT
- IRFLAT(I)=0
- 10 CONTINUE
- DO 20 I=1,NBIATT
- IIFLAT(I)=0
- 20 CONTINUE
-*
- END
-#endif
diff --git a/src/graflib/higz/iz/izitoc.F b/src/graflib/higz/iz/izitoc.F
deleted file mode 100644
index 6cb773e..0000000
--- a/src/graflib/higz/iz/izitoc.F
+++ /dev/null
@@ -1,36 +0,0 @@
-*
-* $Id: izitoc.F,v 1.1.1.1 1996/02/14 13:11:10 mclareni Exp $
-*
-* $Log: izitoc.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:10 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.11/00 27/09/90 15.56.02 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE IZITOC(IVAL,CVAL)
-*.===========>
-*.
-*. Convert integer value IVAL into character string CVAL
-*.
-*..==========>
- CHARACTER*(*) CVAL
- CHARACTER*12 CODED
-*.______________________________________
-*
- IF1=1
- IIVAL=IVAL
- 10 IIVAL=IIVAL/10
- IF(IIVAL.NE.0)THEN
- IF1=IF1+1
- GOTO 10
- ENDIF
- IF(IVAL.LT.0)THEN
- IF1=IF1+1
- ENDIF
- WRITE(CODED,1000)IF1
- WRITE(CVAL,CODED)IVAL
-*
- 1000 FORMAT(2H(I,I2,1H))
- END
diff --git a/src/graflib/higz/iz/izlbl.F b/src/graflib/higz/iz/izlbl.F
deleted file mode 100644
index 50e4339..0000000
--- a/src/graflib/higz/iz/izlbl.F
+++ /dev/null
@@ -1,67 +0,0 @@
-*
-* $Id: izlbl.F,v 1.1.1.1 1996/02/14 13:11:11 mclareni Exp $
-*
-* $Log: izlbl.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:11 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_MAIL)
-*CMZ : 1.16/09 07/01/93 15.34.11 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE IZLBL
-*.===========>
-*.
-*. This routine stores the IGLBL data in the current picture .
-*.
-*..==========> (O.Couet)
-#include "higz/hicode.inc"
-#include "higz/hiflag.inc"
-#if defined(CERNLIB_ZEBRA)
-#include "higz/hipaw.inc"
-#endif
-#if defined(CERNLIB_MAIL)
-#include "higz/himail.inc"
-#endif
-#include "higz/hilabs.inc"
-*.______________________________________
-*
-#if defined(CERNLIB_ZEBRA)
- IF(ZFLAG)THEN
- IF(LPICT.LE.0)RETURN
- IF(IZPUSH(NHILAB+2,0,0,'IGLBL').NE.0)RETURN
- IPUSH=0
- DO 10 I=1,NHILAB
- ILEN = LENOCC(HILABS(I))
- IPUSH = IPUSH+((ILEN+3)/4)
- 10 CONTINUE
- IF(IZPUSH(0,0,IPUSH,'IGLBL').NE.0)RETURN
-*
- CALL IZSTCC(ILBLCO,INTPTR)
- IQ(LHI+INTPTR) = NHILAB
- IQ(LHI+INTPTR+1) = ISTPTR
- DO 20 I=1,NHILAB
- ILEN = LENOCC(HILABS(I))
- IQ(LHI+INTPTR+I+1) = ILEN
- CALL UCTOH(HILABS(I),IQ(LHC+ISTPTR),4,ILEN)
- CALL IZINCS((ILEN+3)/4)
- 20 CONTINUE
- CALL IZINCI(NHILAB+2)
- ENDIF
-#endif
-#if defined(CERNLIB_MAIL)
-*
- IF(MFLAG)THEN
- WRITE (CHMAIL,'(I3,I5)') ILBLCO,NHILAB
- CALL IMWRIT(1)
- DO 30 I=1,NHILAB
- CHMAIL=HILABS(I)
- CALL IMWRIT(2)
- 30 CONTINUE
- CALL IMWRIT(5)
- ENDIF
-#endif
-*
- END
-#endif
diff --git a/src/graflib/higz/iz/izmerg.F b/src/graflib/higz/iz/izmerg.F
deleted file mode 100644
index 0ad7957..0000000
--- a/src/graflib/higz/iz/izmerg.F
+++ /dev/null
@@ -1,170 +0,0 @@
-*
-* $Id: izmerg.F,v 1.1.1.1 1996/02/14 13:11:11 mclareni Exp $
-*
-* $Log: izmerg.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:11 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-#if defined(CERNLIB_ZEBRA)
-*CMZ : 1.19/10 15/09/93 10.06.31 by O.Couet
-*-- Author :
- SUBROUTINE IZMERG(PNAMEI,X0I,Y0I,RI,CHOPT)
-*.===========>
-*.
-*. This routine merges the picture PNAME in the current picture .
-*. the viewport defined in PNAME are transformed according to the
-*. parameters X0,Y0,R . These parameters are defined in the NDC space .
-*.
-*. _Input parameters:
-*.
-*. REAL X0,Y0 : Down left corner (in NDC space) of the PNAME picture in
-*. the current picture .
-*. REAL R : Lenght in NDC of the square onto is mapped the transformation 0 .
-*. CHARACTER PNAME : Picture name .
-*. CHARACTER CHOPT : Option .
-*.
-*. CHOPT='D' : If the displayed picture is not the current
-*. picture the displayed picture is cleared and
-*. the current picture is displayed .
-*.
-*..==========> (O.Couet)
-#include "higz/hipaw.inc"
-#include "higz/hiflag.inc"
- CHARACTER*(*) PNAMEI,CHOPT
- CHARACTER*20 PNAME
- LOGICAL GFSAV,ZFSAV
- DIMENSION IOPT(1)
- EQUIVALENCE (IOPT(1),IOPTD)
-*.______________________________________
-*
- CALL UOPTC (CHOPT,'D',IOPT)
- PNAME=PNAMEI
-*
-* Adressing pictures by number
-*
- INUM=IGASCI(PNAME(1:1))
- IF(49.LE.INUM.AND.INUM.LE.57)THEN
- READ (PNAME,'(I15)',ERR=20 ) INUM
- IF(INUM.GT.NBPICT)THEN
- CALL IGERR('Picture not in memory','IZMERG')
- RETURN
- ENDIF
- LP=LQ(LHIGZ)
- DO 10 I=1,INUM-1
- LP=LQ(LP)
- 10 CONTINUE
- LCH=LQ(LP-4)
- CALL UHTOC(IQ(LCH+1),4,PNAME,IQ(LP+1))
- GOTO 30
- 20 CALL IGERR('PNAME must begin with a letter','IZMERG')
- RETURN
- ENDIF
- 30 CONTINUE
-*
- X0=X0I
- Y0=Y0I
- R=RI
- LPIC2=IZRPIP(PNAME)
- IF(LPIC2.LE.0)RETURN
- IF(LPICT.LE.0)THEN
- CALL IGERR('No current picture','IZMERG')
- RETURN
- ENDIF
-*
- IF((X0.LT.0.).OR.(X0.GT.1.))RETURN
- IF((Y0.LT.0.).OR.(Y0.GT.1.))RETURN
- IF((R.LT.0.).OR.(R.GT.1.))RETURN
- RX=-1.
- RY=-1.
- IF(X0+R.GT.1.)RX=1.-X0
- IF(Y0+R.GT.1.)RY=1.-Y0
- IF((RX.GE.0).OR.(RY.GE.0.))R=MAX(RX,RY)
- IF((RX.GE.0).AND.(RY.GE.0.))R=MIN(RX,RY)
-*
- L2NT0=LQ(LPIC2-1)
- L2I=LQ(LPIC2-2)
- L2F=LQ(LPIC2-3)
- L2C=LQ(LPIC2-4)
-*
- GFSAV=GFLAG
- ZFSAV=ZFLAG
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
-*
- IF((IOPTD.NE.0).AND.(.NOT.MFLAG))THEN
- GFLAG=.TRUE.
- IF(LPICD.NE.LPICT)THEN
- ZFLAG=.FALSE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- CALL ICLRWK(0,0)
- CALL IZDIPI(LPICT)
- ENDIF
- ENDIF
- ZFLAG=.TRUE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
-*
- NTNEW=99
- 40 NTNEW=NTNEW+1
-#if (!defined(CERNLIB_NTC))&&(!defined(CERNLIB_X11))
- CALL IZGNT(NTNEW,IFIND,IAWV,IPRIO,IHPRIO)
- IF(IFIND.NE.0)GOTO 40
-#endif
-#if defined(CERNLIB_NTC)||defined(CERNLIB_X11)
- IF(IGNSCU(NTNEW).NE.0)GOTO 40
-#endif
- CALL ISVP(NTNEW,X0,X0+R,Y0,Y0+R)
- CALL ISELNT(NTNEW)
- CALL IZDNB(L2NT0,L2I,L2F,L2C,0,0)
- IF(IQ(LPIC2+8).EQ.1)GOTO 90
-*
-* Merge the NT banks
-*
- NGT=0
- 50 L2NT=IZGNGT(LPIC2,NGT)
- NGT=IQ(L2NT+3)
- IF(IQ(L2NT+1).EQ.0)GOTO 50
- N=IQ(LPIC2+8)-1
- DO 80 I=1,N
-*
-* Set the normalisation transformation
-*
- 60 NTNEW=NTNEW+1
-#if (!defined(CERNLIB_NTC))&&(!defined(CERNLIB_X11))
- CALL IZGNT(NTNEW,IFIND,IAWV,IPRIO,IHPRIO)
- IF(IFIND.NE.0)GOTO 60
-#endif
-#if defined(CERNLIB_NTC)||defined(CERNLIB_X11)
- IF(IGNSCU(NTNEW).NE.0)GOTO 60
-#endif
- IWVA=IQ(L2NT+2)
- CALL ISWN(NTNEW
- +, Q(L2F+IWVA)
- +, Q(L2F+IWVA+1)
- +, Q(L2F+IWVA+2)
- +, Q(L2F+IWVA+3))
- CALL ISVP(NTNEW
- +, (Q(L2F+IWVA+4)*R+X0)
- +, (Q(L2F+IWVA+5)*R+X0)
- +, (Q(L2F+IWVA+6)*R+Y0)
- +, (Q(L2F+IWVA+7)*R+Y0))
- CALL ISELNT(NTNEW)
-*
-* Decode the NT bank linked to LN
-*
- CALL IZDNB(L2NT,L2I,L2F,L2C,0,0)
-*
-* Give the link of the next highest priority NT bank
-*
- 70 LN=IZGNGT(LPIC2,NGT)
- IF(LN.EQ.0)RETURN
- L2NT=LN
- NGT=IQ(L2NT+3)
- IF(IQ(L2NT+1).EQ.0)GOTO 70
- 80 CONTINUE
-*
- 90 GFLAG=GFSAV
- ZFLAG=ZFSAV
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- END
-#endif
diff --git a/src/graflib/higz/iz/izml.F b/src/graflib/higz/iz/izml.F
deleted file mode 100644
index b614162..0000000
--- a/src/graflib/higz/iz/izml.F
+++ /dev/null
@@ -1,71 +0,0 @@
-*
-* $Id: izml.F,v 1.1.1.1 1996/02/14 13:11:11 mclareni Exp $
-*
-* $Log: izml.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:11 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_MAIL)
-*CMZ : 1.10/02 14/05/90 17.31.11 by O.Couet
-*-- Author :
- SUBROUTINE IZML(N,X,Y)
-*.===========>
-*.
-*. This routine stores in the current picture the necessary data to
-*. to draw a multiline .
-*.
-*. _Input parameters:
-*.
-*. INTEGER N : Number of points .
-*. REAL X(N) : X coordinates .
-*. REAL Y(N) : Y coordinates .
-*.
-*..==========> (O.Couet)
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_MAIL)
-#include "higz/hicode.inc"
-#endif
-#include "higz/hiflag.inc"
-#if defined(CERNLIB_ZEBRA)
-#include "higz/hipaw.inc"
-#endif
-#if defined(CERNLIB_MAIL)
-#include "higz/himail.inc"
-#endif
- DIMENSION X(*),Y(*)
-*.______________________________________
-*
-#if defined(CERNLIB_MAIL)
- IF(MFLAG)THEN
- WRITE (CHMAIL,'(I3,I5)') IMLCO,N
- CALL IMWRIT(1)
- CALL IMFOUT(N,X)
- CALL IMFOUT(N,Y)
- CALL IMWRIT(5)
- ENDIF
-#endif
-#if defined(CERNLIB_ZEBRA)
-*
- IF(ZFLAG)THEN
- IF(LPICT.LT.0)RETURN
- IF(IZPUSH(2,2*N,0,'IML').NE.0)RETURN
- CALL IZCFA(ILNCO,1)
- CALL IZCFA(ILWSCO,1)
- CALL IZCFA(IPLCCO,1)
- CALL IZSTCC(IMLCO,INTPTR)
- IQ(LHI+INTPTR)=IFLPTR
- IQ(LHI+INTPTR+1)=N
- CALL IZINCI(2)
- DO 10 I=1,N
- Q(LHF+IFLPTR+I-1)=X(I)
- 10 CONTINUE
- DO 20 I=1,N
- Q(LHF+IFLPTR+I+N-1)=Y(I)
- 20 CONTINUE
- CALL IZINCF(2*N)
- ENDIF
-#endif
-*
- END
-#endif
diff --git a/src/graflib/higz/iz/izml3.F b/src/graflib/higz/iz/izml3.F
deleted file mode 100644
index 339bc35..0000000
--- a/src/graflib/higz/iz/izml3.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: izml3.F,v 1.1.1.1 1996/02/14 13:11:11 mclareni Exp $
-*
-* $Log: izml3.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:11 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-#if defined(CERNLIB_ZEBRA)
-*CMZ : 1.06/03 09/12/88 10.34.13 by O.Couet
-*-- Author :
- SUBROUTINE IZML3(N,X,Y,Z)
-*.===========>
-*.
-*..==========> (O.Couet)
- DIMENSION X(*),Y(*),Z(*)
-*.______________________________________
-*
- END
-#endif
diff --git a/src/graflib/higz/iz/izopen.F b/src/graflib/higz/iz/izopen.F
deleted file mode 100644
index 9ed9627..0000000
--- a/src/graflib/higz/iz/izopen.F
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: izopen.F,v 1.1.1.1 1996/02/14 13:11:12 mclareni Exp $
-*
-* $Log: izopen.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:12 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-#if defined(CERNLIB_ZEBRA)
-*CMZ : 1.10/03 05/06/90 10.29.03 by O.Couet
-*-- Author :
- SUBROUTINE IZOPEN(LUN,CHDIR,CFNAME,CHOPTT,LRECL,ISTAT)
-*.==========>
-*. Open a HIGZ/RZ picture file
-*..=========> ( R.Brun )
- CHARACTER*(*) CFNAME,CHDIR,CHOPTT
- CHARACTER*8 CHOPT
-*.___________________________________________
-*
- CHOPT=CHOPTT
- CALL CLTOU(CHOPT)
-*
- CALL RZOPEN(LUN,CHDIR,CFNAME,CHOPT,LRECL,ISTAT)
- IF(ISTAT.NE.0)THEN
- CALL IGERR('Cannot open file','IZOPEN')
- RETURN
- ENDIF
-*
- CALL IZFILE(LUN,CHDIR,CHOPT)
-*
- END
-#endif
diff --git a/src/graflib/higz/iz/izout.F b/src/graflib/higz/iz/izout.F
deleted file mode 100644
index 7eefcf8..0000000
--- a/src/graflib/higz/iz/izout.F
+++ /dev/null
@@ -1,113 +0,0 @@
-*
-* $Id: izout.F,v 1.1.1.1 1996/02/14 13:11:12 mclareni Exp $
-*
-* $Log: izout.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:12 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-#if defined(CERNLIB_ZEBRA)
-*CMZ : 1.12/08 28/03/91 12.13.40 by O.Couet
-*-- Author :
- SUBROUTINE IZOUT(PNAME,ICYCLE)
-*.===========>
-*.
-*. This routine manages the OUTput of the pictures on RZ files .
-*.
-*. _Input parameters:
-*.
-*. CHARACTER PNAME : Picture name.
-*. - If PNAME='*' all pictures in memory
-*. are stored on disk
-*. - If PNAME=' ' the current picture in memory
-*. is stored on disk
-*. INTEGER ICYCLE : Number of version of the picture on the RZ file .
-*.
-*..==========> (O.Couet)
-#include "higz/hipaw.inc"
- CHARACTER*(*) PNAME
- CHARACTER*20 PNAMEI
- DIMENSION NAME(5)
-*.______________________________________
-*
- IF(NBPICT.EQ.0)THEN
- CALL IGERR('No picture in memory','IZOUT')
- RETURN
- ENDIF
- PNAMEI=PNAME
-*
-* Adressing pictures by number
-*
- INUM=IGASCI(PNAMEI(1:1))
- IF(49.LE.INUM.AND.INUM.LE.57)THEN
- READ (PNAMEI,'(I15)',ERR=21 ) INUM
- IF(INUM.GT.NBPICT)THEN
- CALL IGERR('Picture not in memory','IZOUT')
- RETURN
- ENDIF
- LP=LQ(LHIGZ)
- DO 11 I=1,INUM-1
- LP=LQ(LP)
- 11 CONTINUE
- LCH=LQ(LP-4)
- CALL UHTOC(IQ(LCH+1),4,PNAMEI,IQ(LP+1))
- GOTO 31
- 21 CALL IGERR('PNAME must begin with a letter','IZOUT')
- RETURN
- ENDIF
- 31 CONTINUE
-*
-* Store all pictures in memory in the current
-* picture data base.
-*
- IF(PNAMEI.EQ.'*')THEN
- LP=LPICT
- IF(LP.GT.0)LPSAV=LPICT
- CALL IZPICT(' ','F')
- DO 10 I=1,NBPICT
- CALL IZPICT(PNAMEI,'R')
- IF(PNAMEI.EQ.' ')GOTO 20
- LAST=IZRPIP(PNAMEI)
- NCH=LENOCC(PNAMEI)
- CALL VBLANK(NAME,5)
- CALL UCTOH(PNAMEI,NAME,4,NCH)
- CALL IZWIP(LAST)
- CALL RZOUT(IXHIGZ,LAST,NAME,ICYCLE,' ')
- CALL RZSAVE
- CALL IZPICT(' ','N')
- 10 CONTINUE
- 20 IF(LP.GT.0)THEN
- CALL IZSCPI(LPSAV)
- ELSE
- LPICT=-1
- ENDIF
- RETURN
- ENDIF
-*
-* Store the picture PNAME (or the current picture if
-* PNAME=' ') in memory in the current picture data base.
-*
- IF(PNAMEI.NE.' ')THEN
- LAST=IZRPIP(PNAMEI)
- IF(LAST.EQ.0)THEN
- CALL IGERR('This picture is not in memory','IZOUT')
- RETURN
- ENDIF
- ELSE
- IF(LPICT.LE.0)THEN
- CALL IGERR('No current picture','IZOUT')
- RETURN
- ENDIF
- LAST=LPICT
- CALL IZPICT(PNAMEI,'R')
- ENDIF
- NCH=LENOCC(PNAMEI)
- CALL VBLANK(NAME,5)
- CALL UCTOH(PNAMEI,NAME,4,NCH)
- CALL IZWIP(LAST)
- CALL RZOUT(IXHIGZ,LAST,NAME,ICYCLE,' ')
- CALL RZSAVE
-*
- END
-#endif
diff --git a/src/graflib/higz/iz/izpave.F b/src/graflib/higz/iz/izpave.F
deleted file mode 100644
index e69ccad..0000000
--- a/src/graflib/higz/iz/izpave.F
+++ /dev/null
@@ -1,51 +0,0 @@
-*
-* $Id: izpave.F,v 1.1.1.1 1996/02/14 13:11:12 mclareni Exp $
-*
-* $Log: izpave.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:12 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.21/08 20/07/94 16.40.03 by O.Couet
-*-- Author : O.Couet 20/07/94
- SUBROUTINE IZPAVE(X1I,X2I,Y1I,Y2I,DZ,ISBOX,ISFRAM,IOPT)
-*.===========>
-*.
-*. This routine store in the current picture the necessary data to
-*. draw a pave.
-*.
-*..==========> (O.Couet)
-#include "higz/hicode.inc"
-#include "higz/hiflag.inc"
-#if defined(CERNLIB_ZEBRA)
-#include "higz/hipaw.inc"
-#endif
- DIMENSION IOPT(*)
-*.______________________________________
-*
-#if defined(CERNLIB_ZEBRA)
- IF(ZFLAG)THEN
- IF(LPICT.LT.0)RETURN
- IF(IZPUSH(4,5,0,'IGPAVE').NE.0)RETURN
- CALL IZCFA(IPLCCO,1)
- CALL IZCFA(ILNCO,1)
-*
- CALL IZSTCC(IPAVCO,INTPTR)
- IQ(LHI+INTPTR) = IFLPTR
- IQ(LHI+INTPTR+1) = ISBOX
- IQ(LHI+INTPTR+2) = ISFRAM
- DO 10 I=1,9
- IF(IOPT(I).NE.0)CALL SBIT1(IQ(LHI+INTPTR+3),I)
- 10 CONTINUE
- CALL IZINCI(4)
- Q(LHF+IFLPTR) = X1I
- Q(LHF+IFLPTR+1) = X2I
- Q(LHF+IFLPTR+2) = Y1I
- Q(LHF+IFLPTR+3) = Y2I
- Q(LHF+IFLPTR+4) = DZ
- CALL IZINCF(5)
- ENDIF
-#endif
-*
- END
diff --git a/src/graflib/higz/iz/izpict.F b/src/graflib/higz/iz/izpict.F
deleted file mode 100644
index 6afd712..0000000
--- a/src/graflib/higz/iz/izpict.F
+++ /dev/null
@@ -1,724 +0,0 @@
-*
-* $Id: izpict.F,v 1.1.1.1 1996/02/14 13:11:12 mclareni Exp $
-*
-* $Log: izpict.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:12 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-#if defined(CERNLIB_ZEBRA)
-*CMZ : 1.19/16 22/10/93 09.33.30 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE IZPICT(PNAMEI,CHOPT)
-*.===========>
-*.
-*. This routine acts on the picture representation in the ZEBRA data
-*. base according to the values of CHOPT. The following diagram shows
-*. the general structure of an HIGZ picture.
-*.
-*.
-*. General structure of an HIGZ picture
-*. ______________________________________
-*.
-*. LPICT
-*. |
-*. |
-*. +----+----+----+----+-V-+----------------------------------\
-*. | -4 | -3 | -2 | -1 | | Top control bank (TCB) >
-*. +--+-+--+-+--+-+--+-+---+----------------------------------/
-*. |LHC |LHF |LHI |LHNT0
-*. | | | | +----------\
-*. | | | +-------->| NT banks >
-*. | | | +----------/
-*. | | | +--------------+
-*. | | +------------->| Integer bank |
-*. | | +--------------+
-*. | | +-----------+
-*. | +------------------>| Real bank |
-*. | +-----------+
-*. | +----------------+
-*. +----------------------->| Character bank |
-*. +----------------+
-*.
-*. Content of the Top Control bank
-*. _________________________________
-*.
-*. 1 2 3 4
-*. +--------------+-----------------+-----------------+----------------+
-*. | PNAME length | Integer bank | Real bank | Character bank |
-*. | in character | pointer: INTPTR | pointer: IFLPTR | pointer: ISTPTR|
-*. +--------------+-----------------+-----------------+----------------+
-*.
-*. 5 6 7 8
-*. +--------+--------+--------+--------+
-*. | IRISIZ | IRFSIZ | IRSSIZ | INBNT |
-*. +--------+--------+--------+--------+
-*.
-*. Content of a NT bank
-*. ______________________
-*.
-*. 1 2 3 4
-*. +-----------+----------------------------+------------------+-------+
-*. | NT Number | Window and Viewport adress | Display Priority | ITBPTR|
-*. +-----------+----------------------------+------------------+-------+
-*.
-*. 5 6 7
-*. +-------+--------------------------+-----------------------+
-*. | Level | Integer Attributes Flags | Real Attributes Flags |
-*. +-------+--------------------------+-----------------------+
-*.
-*. 8
-*. +------------------------------------------+
-*. | Adress of the default Integer attributes |
-*. +------------------------------------------+
-*.
-*. 9
-*. +---------------------------------------+
-*. | Adress of the default real attributes |
-*. +---------------------------------------+
-*.
-*. 10 ...
-*. +---------- - - - - - - - -
-*. | Graphics primitives and attributes
-*. +---------- - - - - - - - -
-*.
-*. Content of the Integer bank
-*. _____________________________
-*.
-*. 1 .... NBIATT
-*. +------------------------------------------+
-*. | Integer attributes word of the NT 0 |
-*. +------------------------------------------+
-*.
-*. NBIATT ...
-*. +----------- - - - - - -
-*. | Graphics Integer data
-*. +----------- - - - - - -
-*.
-*. Content of the Real bank
-*. __________________________
-*.
-*. 1 .... NBRATT
-*. +---------------------------------------+
-*. | Real attributes word of the NT 0 |
-*. +---------------------------------------+
-*.
-*. NBRATT ...
-*. +----------- - - - - - -
-*. | Graphics Real data
-*. +----------- - - - - - -
-*.
-*. Content of the Character bank
-*. _______________________________
-*.
-*. 1 .... 5
-*. +-----------------+
-*. | Picture name |
-*. +-----------------+
-*.
-*. 6 ...
-*. +----------- - - - - - -
-*. | Character data
-*. +----------- - - - - - -
-*.
-*. _Input parameters:
-*.
-*. CHARACTER PNAMEI : Picture name . Input parameter with the options :
-*. M,D,S,P,C,O
-*. CHARACTER CHOPT : Option .
-*.
-*. CHOPT='M'ake a new picture.
-*. CHOPT='D'isplay the picture PNAMEI.
-*. CHOPT='S'cratch picture.
-*. CHOPT='N'ext picture.
-*. CHOPT='L'ist pictures.
-*. CHOPT='AL' Full listing of the pictures.
-*. CHOPT='F'irst picture.
-*. CHOPT='P'rint the contain of a picture.
-*. CHOPT='C'urrent picture.
-*. CHOPT='R'etrieve picture name.
-*. CHOPT='Q'uiet (not error message).
-*. CHOPT='G' retrieve the dispalyed (Graphic) picture name.
-*. CHOPT='O'rder the NT banks in the picture PNAMEI
-*. in the order of creation.
-*.
-*. _Output parameters:
-*.
-*. CHARACTER PNAMEI : Picture name .
-*. Output parameter with the option : R or G
-*.
-*. N.B. PNAMEI is not used if CHOPT='L' or CHOPT='AL'
-*.
-*..==========> (O.Couet)
-#include "higz/hipaw.inc"
-#include "higz/hilun.inc"
-#include "higz/hiflag.inc"
-#include "higz/hiatnb.inc"
-#include "higz/hiatt.inc"
-#include "higz/hiflat.inc"
-#include "higz/hicur.inc"
- DIMENSION IRFLAT(NBRATT),IIFLAT(NBIATT)
- EQUIVALENCE (IRFLAT(1),KMKSC),(IIFLAT(1),KPLCI)
- CHARACTER*(*) CHOPT,PNAMEI
- CHARACTER*80 STR,OLDDIR,PNAME
- CHARACTER*80 CHARS
- CHARACTER*10 CHPTNO
- DIMENSION IOPT(13),INAME(5)
- EQUIVALENCE (IOPT(1) ,IOPTM),(IOPT(2) ,IOPTD),(IOPT(3) ,IOPTS)
- EQUIVALENCE (IOPT(4) ,IOPTN),(IOPT(5) ,IOPTL),(IOPT(6) ,IOPTF)
- EQUIVALENCE (IOPT(7) ,IOPTP),(IOPT(8) ,IOPTC),(IOPT(9) ,IOPTR)
- EQUIVALENCE (IOPT(10),IOPTG),(IOPT(11),IOPTQ),(IOPT(12),IOPTA)
- EQUIVALENCE (IOPT(13),IOPTO)
-*.______________________________________
-*
- CALL UOPTC (CHOPT,'MDSNLFPCRGQAO',IOPT)
- PNAME=PNAMEI
- IQUEST(1)=0
-*
-* Adressing pictures by number
-*
- INUM=IGASCI(PNAME(1:1))
- IF(49.LE.INUM.AND.INUM.LE.57)THEN
- IF(IOPTM.NE.0)GOTO 20
- CALL IZCTOI(PNAME,INUM)
- IF(IQUEST(1).NE.0)GOTO 20
- IF(INUM.GT.NBPICT)THEN
- IF(IOPTQ.EQ.0)CALL IGERR('Picture not in memory',' ')
- RETURN
- ENDIF
- LP=LQ(LHIGZ)
- DO 10 I=1,INUM-1
- LP=LQ(LP)
- 10 CONTINUE
- LCH=LQ(LP-4)
- CALL UHTOC(IQ(LCH+1),4,STR,IQ(LP+1))
- PNAME=STR(1:IQ(LP+1))
- GOTO 30
- 20 IF(IOPTQ.EQ.0)CALL IGERR('PNAME must begin with a letter'
- +, 'IZPICT')
- RETURN
- ENDIF
- 30 CONTINUE
-*.______________________________________
-*
-* First picture
-*
- IF(IOPTF.NE.0)THEN
- IF(NBPICT.NE.0)THEN
- IF(LPICT.GT.0)CALL IZWIP(LPICT)
- CALL IZSCPI(LQ(LHIGZ))
- ZFLAG=.TRUE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- ELSE
- IF(IOPTQ.EQ.0)CALL IGERR('No picture in memory',' ')
- RETURN
- ENDIF
- ENDIF
-*.______________________________________
-*
-* Current picture
-*
-
- IF(IOPTC.NE.0)THEN
- IF(NBPICT.NE.0)THEN
- IF(LPICT.GT.0)CALL IZWIP(LPICT)
- IF(PNAME.EQ.' '.OR.PNAME.EQ.'*')GOTO 40
- LP=IZRPIP(PNAME)
- IF(LP.NE.0)THEN
- CALL IZSCPI(LP)
- ZFLAG=.TRUE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- ELSE
- IF(IOPTQ.EQ.0)CALL IGERR('This picture is not in memory'
- +, ' ')
- RETURN
- ENDIF
- ELSE
- IF(IOPTQ.EQ.0)CALL IGERR('No picture in memory',' ')
- RETURN
- ENDIF
- ENDIF
- 40 CONTINUE
-*.______________________________________
-*
-* Next picture
-*
- IF(IOPTN.NE.0)THEN
- IF(NBPICT.NE.0)THEN
- IF(LPICT.LT.0)THEN
- IF(IOPTQ.EQ.0)CALL IGERR('No current picture',' ')
- RETURN
- ENDIF
- CALL IZWIP(LPICT)
- IF(LQ(LPICT).NE.0)THEN
- CALL IZSCPI(LQ(LPICT))
- ELSE
- CALL IZSCPI(LQ(LHIGZ))
- ENDIF
- ELSE
- IF(IOPTQ.EQ.0)CALL IGERR('No picture in memory',' ')
- RETURN
- ENDIF
- ENDIF
-*.______________________________________
-*
-* Make a new picture in memory with name PNAME
-*
- IF(IOPTM.NE.0)THEN
-*
-* HIGZ is automatically set in the state 'Z' or 'GZ'
-*
- ZFLAG=.TRUE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
-*
-* Automatic naming of the picture if PNAME=' ' or PNAME='*'
-*
- IF((PNAME.EQ.' ').OR.(PNAME.EQ.'*'))THEN
- WRITE (CHPTNO,10100) IPICT
- IPICT=IPICT+1
- NLAST=LENOCC(CHPTNO)
- NFIRST=1
- 50 IF(CHPTNO(NFIRST:NFIRST).EQ.' ')THEN
- NFIRST=NFIRST+1
- GOTO 50
- ENDIF
- PNAME='PICT'//CHPTNO(NFIRST:NLAST)
- ENDIF
-*
-* Automatic saving of the current picture in the RZ data base
-*
- IF(LPICT.GT.0)THEN
- CALL IZWIP(LPICT)
- IF(ASFLAG)THEN
- CALL VBLANK(INAME,5)
- LOOP=(IQ(LPICT+1)+3)/4
- DO 60 I=1,LOOP
- INAME(I)=IQ(LQ(LPICT-4)+I)
- 60 CONTINUE
- LPSAV=LPICT
- CALL RZCDIR(OLDDIR,'R')
- CALL RZCDIR(HICDIR,' ')
- CALL RZOUT(IXHIGZ,LPSAV,INAME,ICYCLE,' ')
- CALL RZSAVE
- CALL RZCDIR(OLDDIR,' ')
- IF(LQ(LPSAV).NE.0)THEN
- CALL IZSCPI(LQ(LPSAV))
- ELSE
- CALL IZSCPI(LQ(LHIGZ))
- ENDIF
- CALL MZDROP(IXHIGZ,LPSAV,' ')
- NBPICT=NBPICT-1
- IF(NBPICT.EQ.0)THEN
- CALL MZDROP(IXHIGZ,LHIGZ,' ')
- LHIGZ=0
- LPICT=-1
- ENDIF
- ENDIF
- ENDIF
-*
-* Create a small bank (LHIGZ) onto the all HIGZ structure is linked
-*
- IF(LHIGZ.EQ.0)THEN
- CALL MZBOOK(IXHIGZ,LPICT,LHIGZ,1,'PICT',1,1,5,2,0)
- ENDIF
-*
-* If PNAME already exist
-*
- IF(IZRPIP(PNAME).NE.0)THEN
- IF(IOPTQ.EQ.0)CALL IGERR('This picture already exist'
- +, 'IZPICT')
- RETURN
- ENDIF
-*
-* Compute the link of the last picture in memory. The new picture
-* is linked to the last picture in memory (LPICT=LAST)
-*
- LP=LHIGZ
- 70 IF(LP.NE.0)THEN
- LAST=LP
- LP=LQ(LP)
- GOTO 70
- ENDIF
- LPICT=LAST
-*
-* Create the Top Control Bank
-*
- CALL MZBOOK(IXHIGZ,LHP,LPICT,0,'PICT',4,4,8,2,0)
- LPICT = LHP
- LAST = LPICT
-*
-* Create the Normalisation Transformation Bank number 0
-*
- CALL MZBOOK(IXHIGZ,LHNT0,LPICT,-1,'HZNT',0,0,INSIZ,2,0)
-*
-* Create the Integer Data Bank
-*
- CALL MZBOOK(IXHIGZ,LHI,LPICT,-2,'PICI',0,0,IISIZ,2,0)
-*
-* Create the Floating Point Data Bank
-*
- CALL MZBOOK(IXHIGZ,LHF,LPICT,-3,'PICF',0,0,IFSIZ,3,0)
-*
-* Create the Character Data Bank
-*
- CALL MZBOOK(IXHIGZ,LHC,LPICT,-4,'PICC',0,0,ISSIZ,5,0)
-*
-* (Number of pictures in memory) = (Number of pictures in menory) + 1
-*
- NBPICT = NBPICT+1
-*
-* Links initialisation
-*
- LHNT = LHNT0
- LHNTLA = LHNT
-*
-* Number of Normalisation Transformation in the current picture
-*
- INBNT = 1
-*
-* The structure level number is 0
-*
- INBLEV = 0
-*
-* Pointers initialisation
-*
-* ITBPTR = Last free adress in the current transformation bank
-* INTPTR = Last free adress in the INTEGER bank data
-* IFLPTR = Last free adress in the REAL bank data
-* ISTPTR = Last free adress in the CHARACTER bank data
-* IIAPTR = Default INTEGER attributes adress
-* IRAPTR = Default REAL attributes adress
-*
- ITBPTR = 10
- INTPTR = NBIATT+1
- IFLPTR = NBRATT+1
- ISTPTR = 1
- IIAPTR = 1
- IRAPTR = 1
-*
-* Initialisation of the real size of the bank
-*
-* IRNSIZ = Real size of the current transformation bank
-* IRISIZ = Real size of the current INTEGER bank
-* IRFSIZ = Real size of the current REAL bank
-* IRSSIZ = Real size of the current CHARACTER bank
-*
- IRNSIZ = INSIZ
- IRISIZ = IISIZ
- IRFSIZ = IFSIZ
- IRSSIZ = ISSIZ
-*
-* Names the picture. The picture name is truncated to 20 characters
-*
- NCHP = LENOCC(PNAME)
- IF(NCHP.GT.20)NCHP=20
- IF(NCHP.NE.0)THEN
- CALL UCTOH(PNAME,IQ(LHC+1),4,NCHP)
- CALL IZINCS(5)
- ENDIF
-*
-* Initialisation of the top control bank
-*
- IQ(LPICT+1) = NCHP
- IQ(LPICT+2) = INTPTR
- IQ(LPICT+3) = IFLPTR
- IQ(LPICT+4) = ISTPTR
- IQ(LPICT+5) = IRISIZ
- IQ(LPICT+6) = IRFSIZ
- IQ(LPICT+7) = IRSSIZ
- IQ(LPICT+8) = INBNT
-*
-* Initialisation of the Normalisation Transformation bank 0
-*
- IQ(LHNT+1) = 0
- CALL SBIT0(IQ(LHNT0+2),1)
- IQ(LHNT+3) = 1
- IQ(LHNT+4) = ITBPTR
- IQ(LHNT+5) = 0
- IQ(LHNT+8) = 1000000*NBIATT+IIAPTR
- IQ(LHNT+9) = 1000000*NBRATT+IRAPTR
- CALL IZCDA(0)
-*
-* Attributes flags initialisation
-*
- DO 80 I=1,NBRATT
- IRFLAT(I) = 0
- 80 CONTINUE
- DO 90 I=1,NBIATT
- IIFLAT(I) = 0
- 90 CONTINUE
-*
-* Sets the current displayed picture pointers
-*
- IF(GFLAG)THEN
- LPICD = LPICT
- LDNT0 = LQ(LPICD-1)
- LDI = LQ(LPICD-2)
- LDF = LQ(LPICD-3)
- LDC = LQ(LPICD-4)
- LDNT = LDNT0
- LDNTLA = LDNT
- ENDIF
- ENDIF
-*.______________________________________
-*
-* Sort NT banks in the picture PNAME
-*
- IF(IOPTO.NE.0)THEN
- IF(NBPICT.NE.0)THEN
-*
-* Order all pictures in memory
-*
- IF(PNAME.EQ.'*')THEN
- LPSAV = LQ(LHIGZ)
- DO 120 I=1,NBPICT
- LN = LQ(LPSAV-1)
- DO 100 J=1,IQ(LPSAV+8)
- IF(LN.EQ.0)GOTO 110
- IQ(LN+3) = J
- LN = LQ(LN)
- 100 CONTINUE
- 110 LPSAV = LQ(LPSAV)
- IF(LPSAV.EQ.0)GOTO 140
- 120 CONTINUE
- ENDIF
-*
-* Order one picture in memory
-*
- IF(PNAME.EQ.' ')THEN
- LP = LPICT
- ELSE
- LP = IZRPIP(PNAME)
- ENDIF
- IF(LP.NE.0)THEN
- LN = LQ(LP-1)
- DO 130 I=1,IQ(LP+8)
- IF(LN.EQ.0)GOTO 140
- IQ(LN+3) = I
- LN = LQ(LN)
- 130 CONTINUE
- ELSE
- IF(IOPTQ.EQ.0)CALL IGERR('This picture is not in memory'
- +, ' ')
- RETURN
- ENDIF
- ELSE
- IF(IOPTQ.EQ.0)CALL IGERR('No picture in memory',' ')
- RETURN
- ENDIF
- ENDIF
- 140 CONTINUE
-*.______________________________________
-*
-* Display pictures in memory
-*
- IF(IOPTD.NE.0)THEN
- IF(NBPICT.NE.0)THEN
-*
-* Display all pictures in memory
-*
- IF(PNAME.EQ.'*')THEN
- LPSAV=LQ(LHIGZ)
- DO 150 I=1,NBPICT
- CALL IZDIPI(LPSAV)
- LPSAV=LQ(LPSAV)
- IF(LPSAV.EQ.0)RETURN
- 150 CONTINUE
- RETURN
- ENDIF
-*
-* Display the current picture in memory
-*
- IF(PNAME.EQ.' ')THEN
- IF(LPICT.LT.0)THEN
- IF(IOPTQ.EQ.0)CALL IGERR('No current picture',' ')
- RETURN
- ENDIF
- CALL IZDIPI(LPICT)
- RETURN
- ENDIF
-*
-* Display the picture PNAME in memory
-*
- LP=IZRPIP(PNAME)
- IF(LP.NE.0)THEN
- CALL IZDIPI(LP)
- ELSE
- IF(IOPTQ.EQ.0)CALL IGERR('This picture is not in memory'
- +, 'IZPICT')
- RETURN
- ENDIF
- ELSE
- IF(IOPTQ.EQ.0)CALL IGERR('No picture in memory',' ')
- RETURN
- ENDIF
- ENDIF
-*.______________________________________
-*
-* Scratch the picture PNAME from memory
-*
- IF(IOPTS.NE.0)THEN
- IF(NBPICT.NE.0)THEN
-*
-* Delete all pictures in memory
-*
- IF(PNAME.EQ.'*')THEN
- LPSAV=LQ(LHIGZ)
- DO 160 I=1,NBPICT
- CALL MZDROP(IXHIGZ,LPSAV,' ')
- LPSAV=LQ(LPSAV)
- IF(LPSAV.EQ.0)GOTO 170
- 160 CONTINUE
- 170 NBPICT=0
- LPICT=-1
- LPICD=-1
- CALL MZDROP(IXHIGZ,LHIGZ,' ')
- LHIGZ=0
- RETURN
- ENDIF
-*
-* Delete one picture in memory
-*
- IF(PNAME.EQ.' ')THEN
- LP=LPICT
- ELSE
- LP=IZRPIP(PNAME)
- ENDIF
- IF(LP.NE.0)THEN
- IF(LP.EQ.LPICD)LPICD=-1
- IF(LP.EQ.LPICT)THEN
- IF(LQ(LPICT).NE.0)THEN
- CALL IZSCPI(LQ(LPICT))
- ELSE
- CALL IZSCPI(LQ(LHIGZ))
- ENDIF
- ENDIF
- CALL MZDROP(IXHIGZ,LP,' ')
- NBPICT=NBPICT-1
- IF(NBPICT.EQ.0)THEN
- CALL MZDROP(IXHIGZ,LHIGZ,' ')
- LHIGZ=0
- LPICT=-1
- ENDIF
- ELSE
- IF(IOPTQ.EQ.0)CALL IGERR('This picture is not in memory'
- +, ' ')
- RETURN
- ENDIF
- ELSE
- IF(IOPTQ.EQ.0)CALL IGERR('No picture in memory',' ')
- RETURN
- ENDIF
- ENDIF
-*.______________________________________
-*
-* List the pictures in memory
-*
-
- IF(IOPTL.NE.0)THEN
- IF(NBPICT.NE.0)THEN
- CALL IGSA(0)
- LP=LQ(LHIGZ)
- IF(IOPTA.NE.0)WRITE(LUNOUT,10400)
- DO 190 I=1,NBPICT
- LCH=LQ(LP-4)
- CALL UHTOC(IQ(LCH+1),4,STR,IQ(LP+1))
- CHARS=STR(1:IQ(LP+1))
-*
-* Full listing
-*
- IF(IOPTA.NE.0)THEN
- LN=LQ(LP-1)
- IP=IQ(LN+3)
- NT=IQ(LN+1)
- IS=IQ(LP+2)+IQ(LP+3)+IQ(LP+4)
- DO 180 J=1,IQ(LP+8)
- IS=IS+IQ(LN+4)
- IF(IQ(LN+3).GT.IP)THEN
- IP=IQ(LN+3)
- NT=IQ(LN+1)
- ENDIF
- LN=LQ(LN)
- 180 CONTINUE
- IF(LP.EQ.LPICT)THEN
- WRITE(LUNOUT,10300) I,CHARS(1:20),IS,IQ(LP+8),NT
- ELSE
- WRITE(LUNOUT,10200) I,CHARS(1:20),IS,IQ(LP+8),NT
- ENDIF
- ELSE
-*
-* Simple listing
-*
- IF(LP.EQ.LPICT)THEN
- CHARS=CHARS(1:LENOCC(CHARS))//' <-- Current '
- + //'Picture'
- IF(ZFLAG)THEN
- CHARS=CHARS(1:LENOCC(CHARS))//' (Active)'
- ENDIF
- ENDIF
- WRITE(LUNOUT,10000) I,CHARS(1:LENOCC(CHARS))
- ENDIF
- LP=LQ(LP)
- 190 CONTINUE
- ELSE
- IF(IOPTQ.EQ.0)CALL IGERR('No picture in memory',' ')
- RETURN
- ENDIF
- ENDIF
-*.______________________________________
-*
-* Print the picture data structure
-*
- IF(IOPTP.NE.0)THEN
- CALL IGSA(0)
- IF(PNAME.NE.' ')THEN
- LP=IZRPIP(PNAME)
- IF(LP.NE.0)THEN
- CALL IZWIP(LP)
- CALL DZSHOW(PNAME,IXHIGZ,LP,'BV',0,0,0,0)
- ELSE
- IF(IOPTQ.EQ.0)CALL IGERR('This picture is not in memory'
- +, ' ')
- RETURN
- ENDIF
- ELSE
- IF(LPICT.GT.0)THEN
- CALL IZWIP(LPICT)
- CALL DZSHOW(PNAME,IXHIGZ,LPICT,'BV',0,0,0,0)
- ELSE
- IF(IOPTQ.EQ.0)CALL IGERR('No current picture',' ')
- RETURN
- ENDIF
- ENDIF
- ENDIF
-*.______________________________________
-*
-* Retrieve current picture name
-*
-
- IF(IOPTR.NE.0)THEN
- PNAMEI=' '
- IF(LPICT.LT.0)RETURN
- CALL UHTOC(IQ(LHC+1),4,STR,IQ(LPICT+1))
- PNAMEI=STR(1:IQ(LPICT+1))
- ENDIF
-*.______________________________________
-*
-* Retrieve displayed picture name
-*
- IF(IOPTG.NE.0)THEN
- PNAMEI=' '
- IF(LPICD.LT.0)RETURN
- CALL UHTOC(IQ(LDC+1),4,STR,IQ(LPICD+1))
- PNAMEI=STR(1:IQ(LPICD+1))
- ENDIF
-*
-10000 FORMAT(1X,I5,': ',A)
-10100 FORMAT(I10)
-10200 FORMAT(1X,I5,': ',A,3X,I6,10X,I5,10X,I6)
-10300 FORMAT(1X,I5,': ',A,'*',2X,I6,10X,I5,10X,I6)
-10400 FORMAT(1X,/,' PICTURE NAME '
- +,'SIZE IN WORDS ','NUMBER OF NT ','CURRENT NT'/)
- END
-#endif
diff --git a/src/graflib/higz/iz/izpl.F b/src/graflib/higz/iz/izpl.F
deleted file mode 100644
index 0dfdd95..0000000
--- a/src/graflib/higz/iz/izpl.F
+++ /dev/null
@@ -1,121 +0,0 @@
-*
-* $Id: izpl.F,v 1.2 2005/10/28 12:38:18 couet Exp $
-*
-* $Log: izpl.F,v $
-* Revision 1.2 2005/10/28 12:38:18 couet
-* - SVG driver, workstation type -779
-*
-* Revision 1.1.1.1 1996/02/14 13:11:12 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_PSCRIPT)||defined(CERNLIB_MAIL)
-*CMZ : 1.21/09 26/09/94 16.21.39 by O.Couet
-*-- Author :
- SUBROUTINE IZPL(N,X,Y)
-*.===========>
-*.
-*. This routine stores in the current picture the necessary data to
-*. to draw a polyline .
-*.
-*. _Input parameters:
-*.
-*. INTEGER N : Number of points .
-*. REAL X(N) : X coordinates .
-*. REAL Y(N) : Y coordinates .
-*.
-*..==========> (O.Couet)
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_MAIL)
-#include "higz/hicode.inc"
-#endif
-#include "higz/hiflag.inc"
-#if defined(CERNLIB_ZEBRA)
-#include "higz/hipaw.inc"
-#endif
-#if defined(CERNLIB_PSCRIPT)
-#include "higz/hiatt.inc"
-#endif
-#if defined(CERNLIB_MAIL)
-#include "higz/himail.inc"
-#endif
- DIMENSION X(*),Y(*)
-*.______________________________________
-*
-#if defined(CERNLIB_PSCRIPT)
- IF(PFLAG)THEN
- IF(ILN.GE.12.AND.ILN.LE.15)GOTO 10
- CALL IPZONE
- IF(TFLAG)THEN
- CALL IPLTYP(ILN)
- CALL IPDRAW(N,X,Y)
- ELSEIF(VFLAG)THEN
- CALL IPPSTF(29,'<polyline fill="none" stroke=')
- CALL IPSCOL(IPLCI)
- CALL IPLWID(INT(RLWSC))
- CALL IPLTYP(ILN)
- CALL IPPSTF(9,' points="')
- CALL IPDRAW(N,X,Y)
- CALL IPPSTF(3,'"/>')
- ELSE
- CALL IPLTYP(ILN)
- CALL IPLWID(INT(RLWSC))
- CALL IPSCOL(IPLCI)
- CALL IPDRAW(N,X,Y)
- IF(X(1).EQ.X(N).AND.Y(1).EQ.Y(N))THEN
- CALL IPPSTF(3,' cl')
- ENDIF
- CALL IPPSTF(2,' s')
- ENDIF
- ENDIF
- 10 CONTINUE
-#endif
-#if defined(CERNLIB_MAIL)
-*
- IF(MFLAG)THEN
- IF(N.EQ.2)THEN
- WRITE (CHMAIL,'(I3,4E16.7)') IPL2CO,X(1),X(2),Y(1),Y(2)
- CALL IMWRIT(4)
- ELSE
- WRITE (CHMAIL,'(I3,I5)') IPLCO,N
- CALL IMWRIT(1)
- CALL IMFOUT(N,X)
- CALL IMFOUT(N,Y)
- CALL IMWRIT(5)
- ENDIF
- ENDIF
-#endif
-#if defined(CERNLIB_ZEBRA)
-*
- IF(ZFLAG)THEN
- IF(LPICT.LT.0)RETURN
- IF(IZPUSH(2,2*N,0,'IPL').NE.0)RETURN
- CALL IZCFA(ILNCO,1)
- CALL IZCFA(ILWSCO,1)
- CALL IZCFA(IPLCCO,1)
- CALL IZCFA(IBSLCO,1)
- IF(N.NE.2)THEN
- CALL IZSTCC(IPLCO,INTPTR)
- IQ(LHI+INTPTR) = IFLPTR
- IQ(LHI+INTPTR+1) = N
- CALL IZINCI(2)
- IADR = LHF+IFLPTR-1
- IADRN = IADR+N
- DO 20 I=1,N
- Q(IADR+I) = X(I)
- Q(IADRN+I) = Y(I)
- 20 CONTINUE
- CALL IZINCF(2*N)
- ELSE
- CALL IZSTCC(IPL2CO,IFLPTR)
- Q(LHF+IFLPTR) = X(1)
- Q(LHF+IFLPTR+1) = X(2)
- Q(LHF+IFLPTR+2) = Y(1)
- Q(LHF+IFLPTR+3) = Y(2)
- CALL IZINCF(4)
- ENDIF
- ENDIF
-#endif
-*
- END
-#endif
diff --git a/src/graflib/higz/iz/izpl3.F b/src/graflib/higz/iz/izpl3.F
deleted file mode 100644
index 5fb5643..0000000
--- a/src/graflib/higz/iz/izpl3.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: izpl3.F,v 1.1.1.1 1996/02/14 13:11:13 mclareni Exp $
-*
-* $Log: izpl3.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:13 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-#if defined(CERNLIB_ZEBRA)
-*CMZ : 1.11/00 27/09/90 15.56.03 by O.Couet
-*-- Author :
- SUBROUTINE IZPL3(N,X,Y,Z)
-*.===========>
-*.
-*..==========> (O.Couet)
- DIMENSION X(*),Y(*),Z(*)
-*.______________________________________
-*
- END
-#endif
diff --git a/src/graflib/higz/iz/izpm.F b/src/graflib/higz/iz/izpm.F
deleted file mode 100644
index 5c73af7..0000000
--- a/src/graflib/higz/iz/izpm.F
+++ /dev/null
@@ -1,242 +0,0 @@
-*
-* $Id: izpm.F,v 1.5 2005/10/28 12:38:18 couet Exp $
-*
-* $Log: izpm.F,v $
-* Revision 1.5 2005/10/28 12:38:18 couet
-* - SVG driver, workstation type -779
-*
-* Revision 1.4 1998/05/26 09:19:30 couet
-* - For filling patterns 1 to 25 the PS ouput was wrong in some cases. For those
-* the pattern we now close the polygon (move to X1 Y1).
-*
-* Revision 1.3 1997/01/30 10:49:15 couet
-* - Initialisation of NP was missing (in case all the points are outside the
-* world coordinates).
-*
-* Revision 1.2 1997/01/30 10:04:18 couet
-* - Bug fixed in the marker PS drawing: when the markers drawn were too for from
-* the world coordinates, unvalid PS coordinates were generated.
-*
-* Revision 1.1.1.1 1996/02/14 13:11:13 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_PSCRIPT)||defined(CERNLIB_MAIL)
-*CMZ : 1.23/03 20/09/95 13.58.45 by O.Couet
-*-- Author :
- SUBROUTINE IZPM(N,X,Y)
-*.===========>
-*.
-*. This routine stores in the current picture the necessary data to
-*. to draw polymarkers .
-*.
-*. _Input parameters:
-*.
-*. INTEGER N : Number of points .
-*. REAL X(N) : X coordinates .
-*. REAL Y(N) : Y coordinates .
-*.
-*..==========> (O.Couet)
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_MAIL)
-#include "higz/hicode.inc"
-#endif
-#include "higz/hiflag.inc"
-#if defined(CERNLIB_ZEBRA)
-#include "higz/hipaw.inc"
-#endif
-#if defined(CERNLIB_PSCRIPT)
-#include "higz/hiatt.inc"
-#include "higz/hipost.inc"
-#endif
-#if defined(CERNLIB_MAIL)
-#include "higz/himail.inc"
-#endif
- DIMENSION X(*),Y(*)
-#if defined(CERNLIB_PSCRIPT)
- CHARACTER*4 CHTEMP
- CHARACTER TEXMRK(5)*7
- LOGICAL ZFSAV
- PARAMETER (ISTS = 100)
- DATA TEXMRK/'dot','plus','star','circle','cross'/
-#endif
-*.______________________________________
-*
-#if defined(CERNLIB_PSCRIPT)
-#include "higz/hiwcps.inc"
-#include "higz/hiwcsv.inc"
- IF(PFLAG)THEN
- CALL IPZONE
- IF(TFLAG)THEN
- LM=ABS(IMK)
- IF(LM.GE.2 .AND. LM.LE.5) THEN
- IM=NINT(RMKSC*16)
- ELSE
- LM=1
- IM=NINT(RMKSC)
- ENDIF
- CALL IPPSTR(BSLASH//'let'//BSLASH//'higzmarker='//
- + BSLASH//'higz'//TEXMRK(LM)(:INDEX(TEXMRK(LM),' ')-1)//
- + BSLASH//'higzmsize=')
- CALL IPIOUT(IM)
- DO 10 I=1,N
- IF(X(I).GE.X1W .AND. X(I).LE.X2W .AND.
- + Y(I).GE.Y1W .AND. Y(I).LE.Y2W) THEN
- IXD=IXWCPS(X(I))
- IYD=IYWCPS(Y(I))
- CALL IPTLIN('p',IXD,IYD)
- ENDIF
- 10 CONTINUE
- ELSEIF(VFLAG)THEN
- CALL IPPSTF(10,' <path d="')
- DO 11 I=1,N
- CALL IPPSTF(1,'M')
- IXDI = IXWCSV(X(I))
- IYDI = IYWCSV(Y(I))
- CALL IPKOUT(IXDI)
- CALL IPIOUT(IYDI)
- 11 CONTINUE
- CALL IPPSTR('" fill="none" stroke-width="1"')
- CALL IPPSTR(' stroke="black" marker-end="url(#M01)"')
- CALL IPPSTR(' marker-mid="url(#M01)"')
- CALL IPPSTR(' marker-start="url(#M01)"/>')
- ELSE
- CALL IPLWID(INT(RLWSC))
- CALL IPLTYP(1)
- CALL IPSCOL(IPMCI)
- LM = ABS(IMK)
- IF(LM.LE.0) CHTEMP =' m20'
- IF(LM.EQ.1) CHTEMP =' m20'
- IF(LM.EQ.2) CHTEMP =' m2'
- IF(LM.EQ.3) CHTEMP =' m31'
- IF(LM.EQ.4) CHTEMP =' m24'
- IF(LM.EQ.5) CHTEMP =' m5'
- IF(LM.GE.6.AND.LM.LE.19) CHTEMP = ' m20'
- IF(LM.GE.20.AND.LM.LE.31)THEN
- CHTEMP=' m '
- WRITE (CHTEMP(3:4),'(I2)') LM
- ENDIF
- IF(LM.GE.32) CHTEMP = ' m20'
-*
-* Normalized space
-*
- ZFSAV = ZFLAG
- ZFLAG = .FALSE.
- GLFLAG = (ZFLAG.OR.PFLAG.OR.MFLAG.OR.VFLAG)
- INTSAV = INTR
- SVXMAX = RVXMAX
- SVXMIN = RVXMIN
- SWXMAX = RWXMAX
- SWXMIN = RWXMIN
- SVYMAX = RVYMAX
- SVYMIN = RVYMIN
- SWYMAX = RWYMAX
- SWYMIN = RWYMIN
- LOSCLI = .TRUE.
- CALL ISELNT(0)
-*
-* Set the PostScript marker size
-*
- RMKSIZ = 0.009*RMKSC
- RNSIZ = 0.
- CALL IGTEXT(0.,0.,'"0 ',RMKSIZ,RNSIZ,'S')
- IMSIZ = IYWCPS(RNSIZ)-IYWCPS(0.)
- IF(LM.EQ.1)IMSIZ=INT(2.*RMKSC)
- IF(LM.EQ.6.OR.LM.EQ.7)IMSIZ=INT(4.*RMKSC)
- IF(IPSMSC.NE.IMSIZ)THEN
- IPSMSC = IMSIZ
- CALL IPPSTF(3,' /w')
- CALL IPIOUT(IMSIZ)
- CALL IPPSTF(40,
- + ' def /w2 {w 2 div} def /w3 {w 3 div} def')
- ENDIF
-*
- XV=(((SVXMAX-SVXMIN)*(X(1)-SWXMIN))/(SWXMAX-SWXMIN))+SVXMIN
- YV=(((SVYMAX-SVYMIN)*(Y(1)-SWYMIN))/(SWYMAX-SWYMIN))+SVYMIN
- IXPS = IXWCPS(XV)
- IYPS = IYWCPS(YV)
- NP = 0
- IF (IXPS.GE.0.AND.IYPS.GE.0) THEN
- CALL IPIOUT(IXPS)
- CALL IPIOUT(IYPS)
- IF(N.EQ.1)THEN
- CALL IPPSTR(CHTEMP)
- GOTO 40
- ENDIF
- NP = 1
- ENDIF
- DO 20 I=2,N
- XV = (((SVXMAX-SVXMIN)*(X(I)-SWXMIN))/
- + (SWXMAX-SWXMIN))+SVXMIN
- YV = (((SVYMAX-SVYMIN)*(Y(I)-SWYMIN))/
- + (SWYMAX-SWYMIN))+SVYMIN
- IXPS = IXWCPS(XV)
- IYPS = IYWCPS(YV)
- IF (IXPS.GE.0.AND.IYPS.GE.0) THEN
- CALL IPIOUT(IXWCPS(XV))
- CALL IPIOUT(IYWCPS(YV))
- NP = NP+1
- ENDIF
- IF(NP.EQ.ISTS.OR.I.EQ.N)THEN
- IF (NP.GT.0) THEN
- CALL IPIOUT(NP)
- CALL IPPSTF(2,' {')
- CALL IPPSTR(CHTEMP)
- CALL IPPSTF(3,'} R')
- NP = 0
- ENDIF
- ENDIF
- 20 CONTINUE
- 40 CALL ISELNT(INTSAV)
- LOSCLI = .FALSE.
- ZFLAG = ZFSAV
- GLFLAG = (ZFLAG.OR.PFLAG.OR.MFLAG)
- ENDIF
- ENDIF
-#endif
-#if defined(CERNLIB_MAIL)
-*
- IF(MFLAG)THEN
- IF(N.EQ.1)THEN
- WRITE (CHMAIL,'(I3,4E16.7)') IPM1CO,X(1),Y(1)
- CALL IMWRIT(4)
- ELSE
- WRITE (CHMAIL,'(I3,I5)') IPMCO,N
- CALL IMWRIT(1)
- CALL IMFOUT(N,X)
- CALL IMFOUT(N,Y)
- CALL IMWRIT(5)
- ENDIF
- ENDIF
-#endif
-#if defined(CERNLIB_ZEBRA)
-*
- IF(ZFLAG)THEN
- IF(LPICT.LT.0)RETURN
- IF(IZPUSH(2,2*N,0,'IPM').NE.0)RETURN
- CALL IZCFA(IMKCO,1)
- CALL IZCFA(IMKSCO,1)
- CALL IZCFA(IPMCCO,1)
- IF(N.NE.1)THEN
- CALL IZSTCC(IPMCO,INTPTR)
- IQ(LHI+INTPTR) = IFLPTR
- IQ(LHI+INTPTR+1) = N
- CALL IZINCI(2)
- IADR = LHF+IFLPTR-1
- IADRN = IADR+N
- DO 50 I=1,N
- Q(IADR+I) = X(I)
- Q(IADRN+I) = Y(I)
- 50 CONTINUE
- CALL IZINCF(2*N)
- ELSE
- CALL IZSTCC(IPM1CO,IFLPTR)
- Q(LHF+IFLPTR) = X(1)
- Q(LHF+IFLPTR+1) = Y(1)
- CALL IZINCF(2)
- ENDIF
- ENDIF
-#endif
-*
- END
-#endif
diff --git a/src/graflib/higz/iz/izpm3.F b/src/graflib/higz/iz/izpm3.F
deleted file mode 100644
index 96f0c24..0000000
--- a/src/graflib/higz/iz/izpm3.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: izpm3.F,v 1.1.1.1 1996/02/14 13:11:13 mclareni Exp $
-*
-* $Log: izpm3.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:13 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-#if defined(CERNLIB_ZEBRA)
-*CMZ : 1.06/03 09/12/88 10.34.15 by O.Couet
-*-- Author :
- SUBROUTINE IZPM3(N,X,Y,Z)
-*.===========>
-*.
-*..==========> (O.Couet)
- DIMENSION X(*),Y(*),Z(*)
-*.______________________________________
-*
- END
-#endif
diff --git a/src/graflib/higz/iz/izpush.F b/src/graflib/higz/iz/izpush.F
deleted file mode 100644
index 2a473f7..0000000
--- a/src/graflib/higz/iz/izpush.F
+++ /dev/null
@@ -1,106 +0,0 @@
-*
-* $Id: izpush.F,v 1.2 1998/12/01 15:48:41 couet Exp $
-*
-* $Log: izpush.F,v $
-* Revision 1.2 1998/12/01 15:48:41 couet
-* - Clean up: commented lines of code removed
-*
-* Revision 1.1.1.1 1996/02/14 13:11:13 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-#if defined(CERNLIB_ZEBRA)
-*CMZ : 1.14/09 01/06/92 16.36.30 by O.Couet
-*-- Author :
- FUNCTION IZPUSH(IIDS,IFDS,ISDS,CHROUT)
-*.===========>
-*.
-*. This function enlarge the (NT),(I),(F) and (C) bank when there is
-*. not enough place to put data into one of this bank .
-*. If IZPUSH .EQ. 0 the pushing is OK if not , there is not enough
-*. space in memory .
-*.
-*. _Input parameters:
-*.
-*. INTEGER IIDS : Integer Data Size to put into (I) .
-*. INTEGER IFDS : Floating point Data Size to put into (F) .
-*. INTEGER ISDS : Character Data Size to put into (C) .
-*. CHARACTER CHROUT : Calling routine name (in case of error) .
-*.
-*. N.B. For the current NT bank the number of new data is always 1.
-*.
-*..==========> (O.Couet)
-#include "higz/hipaw.inc"
-#include "higz/hiflag.inc"
- CHARACTER*(*) CHROUT
-*.______________________________________
-*
- IZPUSH=0
- IF(.NOT.ZFLAG)RETURN
- IF(LPICT.LE.0)THEN
- CALL IGERR('No current picture',CHROUT)
- RETURN
- ENDIF
-*
-* Enlarge the current NT bank
-*
- IF(ITBPTR+1.GT.IRNSIZ)THEN
- INPUSH=2+INSIZ-IRNSIZ+ITBPTR-1
- INPUSH=MAX(INPUSH,IQ(LHNT-1)/4)
- NWNEED=IQ(LHNT-1)+IQ(LHNT-2)+INPUSH+25
- CALL MZNEED(IXHIGZ,NWNEED,'G')
- IF(IQUEST(11).LT.0)GOTO 10
- CALL MZPUSH(IXHIGZ,LHNT,0,INPUSH,' ')
- IRNSIZ=IRNSIZ+INPUSH
- ENDIF
-*
-* Enlarge the INTEGER bank
-*
- IF(INTPTR+IIDS.GT.IRISIZ+1)THEN
- IIPUSH=IIDS+IISIZ-IRISIZ+INTPTR-1
- IIPUSH=MAX(IIPUSH,IQ(LHI-1)/4)
- NWNEED=IQ(LHI-1)+IQ(LHI-2)+IIPUSH+25
- CALL MZNEED(IXHIGZ,NWNEED,'G')
- IF(IQUEST(11).LT.0)GOTO 10
- CALL MZPUSH(IXHIGZ,LHI,0,IIPUSH,' ')
- IRISIZ=IRISIZ+IIPUSH
- IQ(LPICT+5)=IRISIZ
- ENDIF
-*
-* Enlarge the REAL bank
-*
- IF(IFLPTR+IFDS.GT.IRFSIZ+1)THEN
- IFPUSH=IFDS+IFSIZ-IRFSIZ+IFLPTR-1
- IFPUSH=MAX(IFPUSH,IQ(LHF-1)/4)
- NWNEED=IQ(LHF-1)+IQ(LHF-2)+IFPUSH+25
- CALL MZNEED(IXHIGZ,NWNEED,'G')
- IF(IQUEST(11).LT.0)GOTO 10
- CALL MZPUSH(IXHIGZ,LHF,0,IFPUSH,' ')
- IRFSIZ=IRFSIZ+IFPUSH
- IQ(LPICT+6)=IRFSIZ
- ENDIF
-*
-* Enlarge the CHARACTER bank
-*
- IF(ISTPTR+ISDS.GT.IRSSIZ+1)THEN
- ISPUSH=ISDS+ISSIZ-IRSSIZ+ISTPTR-1
- ISPUSH=MAX(ISPUSH,IQ(LHC-1)/4)
- NWNEED=IQ(LHC-1)+IQ(LHC-2)+ISPUSH+25
- CALL MZNEED(IXHIGZ,NWNEED,'G')
- IF(IQUEST(11).LT.0)GOTO 10
- CALL MZPUSH(IXHIGZ,LHC,0,ISPUSH,' ')
- IRSSIZ=IRSSIZ+ISPUSH
- IQ(LPICT+7)=IRSSIZ
- ENDIF
- RETURN
-*
-* Error. Not enough space left
-*
- 10 IZPUSH=1
- CALL IGERR('Not enough space in memory',CHROUT)
- ZFLAG=.FALSE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
-*
- END
-#endif
diff --git a/src/graflib/higz/iz/izrpip.F b/src/graflib/higz/iz/izrpip.F
deleted file mode 100644
index d37f7a3..0000000
--- a/src/graflib/higz/iz/izrpip.F
+++ /dev/null
@@ -1,61 +0,0 @@
-*
-* $Id: izrpip.F,v 1.1.1.1 1996/02/14 13:11:13 mclareni Exp $
-*
-* $Log: izrpip.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:13 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-#if defined(CERNLIB_ZEBRA)
-*CMZ : 1.06/07 04/04/89 09.34.00 by O.Couet
-* Bugs corrected IZRPIP=LP only if NCHP=IQ(LPICT+1)
-*-- Author :
- INTEGER FUNCTION IZRPIP(PNAME)
-*.===========>
-*.
-*. This routine Retrieves the PIcture Pointer of the picture PNAME .
-*.
-*. _Input parameters:
-*.
-*. CHARACTER PNAME : Picture name .
-*.
-*..==========> (O.Couet)
-#include "higz/hipaw.inc"
- CHARACTER*(*) PNAME
- DIMENSION INAME(5)
-*.______________________________________
-*
- IZRPIP=0
- IF(LHIGZ.EQ.0)RETURN
- NCHP=LENOCC(PNAME)
- IF(NCHP.GT.20)NCHP=20
- IF(NCHP.LT.1)RETURN
- CALL UCTOH(PNAME,INAME(1),4,NCHP)
- LP=LQ(LHIGZ)
- IF(LP.EQ.0)RETURN
- LCH=LQ(LP-4)
- I=0
-*
- 10 I=I+1
- IF(I.GT.NBPICT)RETURN
- DO 20 J=1,(NCHP+3)/4
- IF(INAME(J).NE.IQ(LCH+J))THEN
- LP=LQ(LP)
- IF(LP.EQ.0)RETURN
- LCH=LQ(LP-4)
- GOTO 10
- ENDIF
- 20 CONTINUE
- IF(NCHP.EQ.IQ(LP+1))THEN
- IZRPIP=LP
- RETURN
- ELSE
- LP=LQ(LP)
- IF(LP.EQ.0)RETURN
- LCH=LQ(LP-4)
- GOTO 10
- ENDIF
-*
- END
-#endif
diff --git a/src/graflib/higz/iz/izrtoc.F b/src/graflib/higz/iz/izrtoc.F
deleted file mode 100644
index 1fa0d13..0000000
--- a/src/graflib/higz/iz/izrtoc.F
+++ /dev/null
@@ -1,76 +0,0 @@
-*
-* $Id: izrtoc.F,v 1.1.1.1 1996/02/14 13:11:13 mclareni Exp $
-*
-* $Log: izrtoc.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:13 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.16/10 18/01/93 13.59.56 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE IZRTOC(RVAL,CVAL)
-*.===========>
-*.
-*. Convert character string CVAL into real value RVAL
-*.
-*..==========>
- PARAMETER (MAXDIG=16)
- CHARACTER*(MAXDIG) CHTMP1,CHTMP2
- CHARACTER*(*) CVAL
-*.______________________________________
-*
- IF(RVAL.EQ.0)THEN
- CVAL='0.'
- RETURN
- ENDIF
-*
- IF(RVAL.GE.0.001.AND.RVAL.LE.10.)THEN
- WRITE (CHTMP1,'(F10.5)') RVAL
- ELSE
- WRITE (CHTMP1,'(G15.5)') RVAL
- ENDIF
-*
-* Remove the leading blanks
-*
- I1=LENOCC(CHTMP1)
- 10 IF(CHTMP1(1:1).EQ.' ')THEN
- CHTMP2=CHTMP1(2:I1)
- CHTMP1=CHTMP2
- I1=I1-1
- GOTO 10
- ENDIF
-*
-* Remove the trailing 0
-*
- I2=INDEX(CHTMP1,'E')
- IF(I2.NE.0)THEN
- 20 IF(CHTMP1(I2-1:I2-1).EQ.'0')THEN
- CHTMP2=CHTMP1(1:I2-2)//CHTMP1(I2:)
- CHTMP1=CHTMP2
- I1=I1-1
- ELSE
- GOTO 40
- ENDIF
- I2=INDEX(CHTMP1,'E')
- GOTO 20
- ELSE
- 30 IF(CHTMP1(I1:I1).EQ.'0')THEN
- CHTMP2=CHTMP1(1:I1-1)
- CHTMP1=CHTMP2
- I1=I1-1
- GOTO 30
- ENDIF
- ENDIF
-*
-* Add a 0 in front of the '.'
-*
- 40 IF(CHTMP1(1:1).EQ.'.')THEN
- CHTMP2='0'//CHTMP1
- CHTMP1=CHTMP2
- I1=I1+1
- ENDIF
-*
- CVAL=CHTMP1(1:I1)
-*
- END
diff --git a/src/graflib/higz/iz/izsav.F b/src/graflib/higz/iz/izsav.F
deleted file mode 100644
index 8bdab47..0000000
--- a/src/graflib/higz/iz/izsav.F
+++ /dev/null
@@ -1,43 +0,0 @@
-*
-* $Id: izsav.F,v 1.1.1.1 1996/02/14 13:11:13 mclareni Exp $
-*
-* $Log: izsav.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:13 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.06/03 12/12/88 17.12.44 by O.Couet
-*-- Author :
- SUBROUTINE IZSAV
-*.===========>
-*.
-*. This saves the attributes environment.
-*.
-*..==========> (O.Couet)
-#include "higz/hiatnb.inc"
-#include "higz/hiatt.inc"
-#include "higz/hisave.inc"
- DIMENSION RATVAL(NBRATT)
- EQUIVALENCE (RATVAL(1),RMKSC)
- DIMENSION IATVAL(NBIATT)
- EQUIVALENCE (IATVAL(1),IPLCI)
-*.______________________________________
-*
- DO 10 I=1,NBIATT
- ISAVE(I)=IATVAL(I)
- 10 CONTINUE
- DO 20 I=1,NBRATT
- RSAVE(I)=RATVAL(I)
- 20 CONTINUE
- WNVPSV(1)=RWXMIN
- WNVPSV(2)=RWXMAX
- WNVPSV(3)=RWYMIN
- WNVPSV(4)=RWYMAX
- WNVPSV(5)=RVXMIN
- WNVPSV(6)=RVXMAX
- WNVPSV(7)=RVYMIN
- WNVPSV(8)=RVYMAX
- ISVNT=INTR
-*
- END
diff --git a/src/graflib/higz/iz/izsava.F b/src/graflib/higz/iz/izsava.F
deleted file mode 100644
index f42add3..0000000
--- a/src/graflib/higz/iz/izsava.F
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: izsava.F,v 1.1.1.1 1996/02/14 13:11:13 mclareni Exp $
-*
-* $Log: izsava.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:13 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.06/03 12/12/88 17.12.44 by O.Couet
-*-- Author :
- SUBROUTINE IZSAVA
-*.===========>
-*.
-*. This saves the attributes environment.
-*.
-*..==========> (O.Couet)
-#include "higz/hiatnb.inc"
-#include "higz/hiatt.inc"
-#include "higz/hisava.inc"
- DIMENSION RATVAL(NBRATT)
- EQUIVALENCE (RATVAL(1),RMKSC)
- DIMENSION IATVAL(NBIATT)
- EQUIVALENCE (IATVAL(1),IPLCI)
-*.______________________________________
-*
- DO 10 I=1,NBIATT
- ISAVA(I)=IATVAL(I)
- 10 CONTINUE
- DO 20 I=1,NBRATT
- RSAVA(I)=RATVAL(I)
- 20 CONTINUE
-*
- END
diff --git a/src/graflib/higz/iz/izscan.F b/src/graflib/higz/iz/izscan.F
deleted file mode 100644
index 64ab390..0000000
--- a/src/graflib/higz/iz/izscan.F
+++ /dev/null
@@ -1,69 +0,0 @@
-*
-* $Id: izscan.F,v 1.1.1.1 1996/02/14 13:11:13 mclareni Exp $
-*
-* $Log: izscan.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:13 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-#if defined(CERNLIB_ZEBRA)
-*CMZ : 1.11/00 01/10/90 12.08.29 by O.Couet
-*-- Author :
- SUBROUTINE IZSCAN(LN,IFCODE,IADRS,ISEN,IPOS)
-*.===========>
-*.
-*. This routine scans the NT bank at the adress LN and returns the
-*. position of the graphic function number IFCODE in this bank .
-*.
-*. _Input parameters:
-*.
-*. INTEGER LN : Link of th NT bank to be scanned .
-*. INTEGER IFCODE : Graphic function code .
-*. INTEGER IADRS : Starting adress . if IADRS < 0 IFCODE is not a function code
-*. but an integer word .
-*. INTEGER ISEN : Sense of scanning . If ISEN < 0 the scanning is reverve .
-*.
-*. _Output parameters:
-*.
-*. INTEGER IPOS : Position, in the NT bank, of the function IFCODE .
-*. If IPOS equal 0: The function has not be found .
-*.
-*..==========> (O.Couet)
-#include "higz/hipaw.inc"
-*.______________________________________
-*
- IPOS=0
- IF(IADRS.LT.0)GOTO 30
-*
- IF(ISEN.GE.0)THEN
- DO 10 I=IADRS,IQ(LN+4)-1
- IF(IZGCOD(LN,I).NE.IFCODE)GOTO 10
- IPOS=I
- RETURN
- 10 CONTINUE
- ELSE
- DO 20 I=IADRS,10,-1
- IF(IZGCOD(LN,I).NE.IFCODE)GOTO 20
- IPOS=I
- RETURN
- 20 CONTINUE
- ENDIF
- RETURN
-*
- 30 IF(ISEN.GE.0)THEN
- DO 40 I=ABS(IADRS),IQ(LN+4)-1
- IF(IQ(LN+I).NE.IFCODE)GOTO 40
- IPOS=I
- RETURN
- 40 CONTINUE
- ELSE
- DO 50 I=ABS(IADRS),10,-1
- IF(IQ(LN+I).NE.IFCODE)GOTO 50
- IPOS=I
- RETURN
- 50 CONTINUE
- ENDIF
-*
- END
-#endif
diff --git a/src/graflib/higz/iz/izscli.F b/src/graflib/higz/iz/izscli.F
deleted file mode 100644
index 9e76b00..0000000
--- a/src/graflib/higz/iz/izscli.F
+++ /dev/null
@@ -1,101 +0,0 @@
-*
-* $Id: izscli.F,v 1.2 2005/10/28 12:38:18 couet Exp $
-*
-* $Log: izscli.F,v $
-* Revision 1.2 2005/10/28 12:38:18 couet
-* - SVG driver, workstation type -779
-*
-* Revision 1.1.1.1 1996/02/14 13:11:13 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_PSCRIPT)||defined(CERNLIB_MAIL)
-*CMZ : 1.22/05 30/01/95 10.57.22 by O.Couet
-*-- Author :
- SUBROUTINE IZSCLI(ICLSW)
-*.===========>
-*.
-*. This routine stores in the current NT bank the state of the clipping
-*. indicator .
-*.
-*. _Input parameters:
-*.
-*. INTEGER ICLSW : Clipping indicator .
-*.
-*..==========> (O.Couet)
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_MAIL)
-#include "higz/hicode.inc"
-#endif
-#include "higz/hiflag.inc"
-#if defined(CERNLIB_PSCRIPT)
-#include "higz/hipost.inc"
-#endif
-#if defined(CERNLIB_PSCRIPT)
-#include "higz/hiatt.inc"
-#endif
-#if defined(CERNLIB_ZEBRA)
-#include "higz/hipaw.inc"
-#endif
-#if defined(CERNLIB_MAIL)
-#include "higz/himail.inc"
-#endif
-*.______________________________________
-*
-#if defined(CERNLIB_PSCRIPT)
-#include "higz/hiwcps.inc"
-#endif
-#if defined(CERNLIB_PSCRIPT)
- IF(LOSCLI.OR..NOT.LOZONE)GOTO 20
- IF(PFLAG.AND..NOT.TFLAG.AND..NOT.VFLAG)THEN
- IF(IPSWTY.EQ.-113.AND..NOT.LOBB)GOTO 20
- IF(ICLSW.NE.0)THEN
- IDXNC = IXWCPS(X2W)-IXWCPS(X1W)
- IDYNC = IYWCPS(Y2W)-IYWCPS(Y1W)
- IXNC = IXWCPS(X1W)
- IYNC = IYWCPS(Y1W)
- IF(IDXNC .EQ.IPDXC.AND.IDYNC.EQ.IPDYC.AND.
- + IXNC .EQ.IPXC .AND.IYNC .EQ.IPYC .AND.
- + IPCLIP.EQ.ICLSW)GOTO 10
- CALL IPIOUT(IDXNC)
- CALL IPIOUT(IDYNC)
- CALL IPIOUT(IXNC)
- CALL IPIOUT(IYNC)
- CALL IPPSTF(2,' C')
- IPDXC = IDXNC
- IPDYC = IDYNC
- IPXC = IXNC
- IPYC = IYNC
- ELSE
- IF(IPCLIP.NE.ICLSW)CALL IPPSTF(3,' NC')
- ENDIF
- 10 IPCLIP = ICLSW
- ENDIF
- 20 CONTINUE
-#endif
-#if defined(CERNLIB_MAIL)
-*
- IF(MFLAG)THEN
- WRITE (CHMAIL,'(I3,I2)') ICLICO,ICLSW
- CALL IMWRIT(4)
- ENDIF
-#endif
-#if defined(CERNLIB_ZEBRA)
-*
- IF(ZFLAG)THEN
- IF(LPICT.LT.0)RETURN
- CALL IZSCAN(LHNT,ICLICO,ITBPTR-1,-1,IPOS)
- IF(IPOS.NE.0)THEN
- IF(IZGADR(LHNT,IPOS).EQ.ICLSW)RETURN
- IF(IPOS.EQ.ITBPTR-1)THEN
- IQ(LHNT+IPOS)=1000000*ICLICO+ICLSW
- RETURN
- ENDIF
- ENDIF
- IF(IZPUSH(0,0,0,'IZSCLI').NE.0)RETURN
- CALL IZSTCC(ICLICO,ICLSW)
- ENDIF
-#endif
-*
- END
-#endif
diff --git a/src/graflib/higz/iz/izscor.F b/src/graflib/higz/iz/izscor.F
deleted file mode 100644
index 55a8fe1..0000000
--- a/src/graflib/higz/iz/izscor.F
+++ /dev/null
@@ -1,63 +0,0 @@
-*
-* $Id: izscor.F,v 1.1.1.1 1996/02/14 13:11:13 mclareni Exp $
-*
-* $Log: izscor.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:13 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_MAIL)
-*CMZ : 1.10/02 14/05/90 17.31.11 by O.Couet
-*-- Author :
- SUBROUTINE IZSCOR(IWKID,IC,CR,CG,CB)
-*.===========>
-*.
-*. This routine stores the color representation in the current picture.
-*.
-*. _Input parameters:
-*.
-*. INTEGER WKID : Workstation identifier .
-*. INTEGER CI : Color index .
-*. REAL CR : Red .
-*. REAL CG : Green .
-*. REAL CB : Blue .
-*.
-*..==========> (O.Couet)
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_MAIL)
-#include "higz/hicode.inc"
-#endif
-#include "higz/hiflag.inc"
-#if defined(CERNLIB_ZEBRA)
-#include "higz/hipaw.inc"
-#endif
-#if defined(CERNLIB_MAIL)
-#include "higz/himail.inc"
-#endif
-*.______________________________________
-*
-#if defined(CERNLIB_MAIL)
-*
- IF(MFLAG)THEN
- WRITE (CHMAIL,'(2I3,I5,3E16.7)')ICRCO,IWKID,IC,CR,CG,CB
- CALL IMWRIT(4)
- ENDIF
-#endif
-#if defined(CERNLIB_ZEBRA)
-*
- IF(ZFLAG)THEN
- IF(LPICT.LT.0)RETURN
- IF(IZPUSH(2,3,0,'ISCR').NE.0)RETURN
- CALL IZSTCC(ICRCO,INTPTR)
- IQ(LHI+INTPTR)=IFLPTR
- IQ(LHI+INTPTR+1)=IC
- CALL IZINCI(2)
- Q(LHF+IFLPTR)=CR
- Q(LHF+IFLPTR+1)=CG
- Q(LHF+IFLPTR+2)=CB
- CALL IZINCF(3)
- ENDIF
-#endif
-*
- END
-#endif
diff --git a/src/graflib/higz/iz/izscpi.F b/src/graflib/higz/iz/izscpi.F
deleted file mode 100644
index 7024df4..0000000
--- a/src/graflib/higz/iz/izscpi.F
+++ /dev/null
@@ -1,88 +0,0 @@
-*
-* $Id: izscpi.F,v 1.2 1998/12/01 15:48:42 couet Exp $
-*
-* $Log: izscpi.F,v $
-* Revision 1.2 1998/12/01 15:48:42 couet
-* - Clean up: commented lines of code removed
-*
-* Revision 1.1.1.1 1996/02/14 13:11:13 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-#if defined(CERNLIB_ZEBRA)
-*CMZ : 1.14/09 02/06/92 10.08.58 by O.Couet
-*-- Author :
- SUBROUTINE IZSCPI(LP)
-*.===========>
-*.
-*. Sets the picture LP as current picture .
-*.
-*. _Input parameters:
-*.
-*. INTEGER LP : Picture pointer .
-*.
-*..==========> (O.Couet)
-#include "higz/hipaw.inc"
-#include "higz/hiatnb.inc"
-#include "higz/hiflat.inc"
-#include "higz/hiaadr.inc"
- DIMENSION IRFLAT(NBRATT),IIFLAT(NBIATT)
- EQUIVALENCE (IRFLAT(1),KMKSC),(IIFLAT(1),KPLCI)
-*.______________________________________
-*
- LPICT=LP
- IF(LPICT.LE.0)RETURN
-*
- INBNT=IQ(LPICT+8)
- LHNT0=LQ(LPICT-1)
- LHI=LQ(LPICT-2)
- LHF=LQ(LPICT-3)
- LHC=LQ(LPICT-4)
- LN=LHNT0
- LHNT=LHNT0
- LHNTLA=LHNT0
-*
-* Sets the normalisation transformation with
-* the highest priority as the current transformation.
-*
- DO 10 I=1,INBNT
- LN=LQ(LN)
- IF(LN.EQ.0)GOTO 20
- LHNTLA=LN
- IF(IQ(LN+3).GT.IQ(LHNT+3))LHNT=LN
- 10 CONTINUE
-*
- 20 CONTINUE
- ITBPTR=IQ(LHNT+4)
- INBLEV=IQ(LHNT+5)
- IRNSIZ=IQ(LHNT-1)
-*
-* Set the Flags Attributes
-* Initialise the attributes adresses
-*
- DO 30 I=1,NBIATT
- IIFLAT(I)=JBIT(IQ(LHNT+6),I)
- IATADR(30+I)=-1
- 30 CONTINUE
- DO 40 I=1,NBRATT
- IRFLAT(I)=JBIT(IQ(LHNT+7),I)
- IATADR(I)=-1
- 40 CONTINUE
-*
-* Set the adress of the default attributes
-*
- IIAPTR=IZGADR(LHNT,8)
- IRAPTR=IZGADR(LHNT,9)
-*
-* Set pointers and bank size
-*
- INTPTR=IQ(LPICT+2)
- IFLPTR=IQ(LPICT+3)
- ISTPTR=IQ(LPICT+4)
- IRISIZ=IQ(LPICT+5)
- IRFSIZ=IQ(LPICT+6)
- IRSSIZ=IQ(LPICT+7)
-*
- END
-#endif
diff --git a/src/graflib/higz/iz/izscr.F b/src/graflib/higz/iz/izscr.F
deleted file mode 100644
index 8d53d35..0000000
--- a/src/graflib/higz/iz/izscr.F
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: izscr.F,v 1.1.1.1 1996/02/14 13:11:14 mclareni Exp $
-*
-* $Log: izscr.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:14 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-#if defined(CERNLIB_ZEBRA)
-*CMZ : 1.11/00 27/09/90 15.56.04 by O.Couet
-*-- Author :
- SUBROUTINE IZSCR(PNAME,ICYCLE)
-*.===========>
-*.
-*. This routine manages the SCRatch of the pictures on RZ files .
-*.
-*. _Input parameters:
-*.
-*. CHARACTER PNAME : Picture name .
-*. INTEGER ICYCLE : Number of version of the picture on the RZ file .
-*.
-*..==========> (O.Couet)
-#include "higz/hipaw.inc"
- CHARACTER*(*) PNAME
- DIMENSION NAME(5)
-*.______________________________________
-*
- LPSAV=LPICT
- IF(LHIGZ.EQ.0)THEN
- CALL MZBOOK(IXHIGZ,LPICT,LHIGZ,1,'PICT',1,1,5,2,0)
- ENDIF
- NCH=LENOCC(PNAME)
- CALL VBLANK(NAME,5)
- CALL UCTOH(PNAME,NAME,4,NCH)
-*
- CALL RZDELK(NAME,ICYCLE,' ')
- CALL RZSAVE
-*
- END
-#endif
diff --git a/src/graflib/higz/iz/izseln.F b/src/graflib/higz/iz/izseln.F
deleted file mode 100644
index 9918936..0000000
--- a/src/graflib/higz/iz/izseln.F
+++ /dev/null
@@ -1,251 +0,0 @@
-*
-* $Id: izseln.F,v 1.3 2005/10/28 12:38:18 couet Exp $
-*
-* $Log: izseln.F,v $
-* Revision 1.3 2005/10/28 12:38:18 couet
-* - SVG driver, workstation type -779
-*
-* Revision 1.2 1998/12/01 15:48:42 couet
-* - Clean up: commented lines of code removed
-*
-* Revision 1.1.1.1 1996/02/14 13:11:14 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_PSCRIPT)||defined(CERNLIB_MAIL)
-*CMZ : 1.18/00 02/04/93 10.57.30 by O.Couet
-*-- Author :
- SUBROUTINE IZSELN(NT)
-*.===========>
-*.
-*. This routine create in the current picture a bank for the
-*. normalisation transformation .
-*.
-*. _Input parameters:
-*.
-*. INTEGER NT : Normalization transformation number.
-*.
-*..==========> (O.Couet)
-#if defined(CERNLIB_ZEBRA)
-#include "higz/hiatnb.inc"
-#endif
-#include "higz/hiatt.inc"
-#include "higz/hiflag.inc"
-#if defined(CERNLIB_PSCRIPT)
-#include "higz/hipost.inc"
-#endif
-#if defined(CERNLIB_ZEBRA)
-#include "higz/hipaw.inc"
-#endif
-#if defined(CERNLIB_ZEBRA)
-#include "higz/hiflat.inc"
-#endif
-#if defined(CERNLIB_ZEBRA)
-#include "higz/hiaadr.inc"
-#endif
-#if defined(CERNLIB_MAIL)
-#include "higz/himail.inc"
-#endif
-#if defined(CERNLIB_ZEBRA)
- DIMENSION IRFLAT(NBRATT),IIFLAT(NBIATT)
- EQUIVALENCE (IRFLAT(1),KMKSC),(IIFLAT(1),KPLCI)
- LOGICAL LOPSAV
-*.______________________________________
-*
-#if defined(CERNLIB_PSCRIPT)
-#include "higz/icmtop.inc"
-#endif
-#endif
-#if defined(CERNLIB_PSCRIPT)
- IF(PFLAG)THEN
- X1W=RWXMIN
- X2W=RWXMAX
- Y1W=RWYMIN
- Y2W=RWYMAX
- IF(LOPRNG)THEN
- X1V=((XVP2-XVP1)/(XVS2-XVS1))*(RVXMIN-XVS1)+XVP1
- X2V=((XVP2-XVP1)/(XVS2-XVS1))*(RVXMAX-XVS1)+XVP1
- Y1V=((YVP2-YVP1)/(YVS2-YVS1))*(RVYMIN-YVS1)+YVP1
- Y2V=((YVP2-YVP1)/(YVS2-YVS1))*(RVYMAX-YVS1)+YVP1
- ELSE
- X1V=RVXMIN
- X2V=RVXMAX
- Y1V=RVYMIN
- Y2V=RVYMAX
- ENDIF
- FX=(X2V-X1V)/(X2W-X1W)
- FY=(Y2V-Y1V)/(Y2W-Y1W)
- IF(IPSWTY.EQ.-113.AND.NT.EQ.1.AND..NOT.LOBB)THEN
- LOPSAV=LOPRT
- IF(TFLAG) THEN
- CALL IPTMAC
- ELSEIF(VFLAG) THEN
- CALL IPPSTF(14,'<svg viewBox="')
- CALL IPKOUT(ICMTOP(X1W))
- CALL IPIOUT(ICMTOP(Y1W))
- CALL IPIOUT(ICMTOP(X2W))
- IYSVG = ICMTOP(Y2W)
- CALL IPIOUT(IYSVG)
- CALL IPPSTF(1,'"')
- CALL IPPSTR(' xmlns="http://www.w3.org/2000/svg">')
- CALL IPPSTR('@')
- ELSE
- CALL IPPSTR('@%%BoundingBox: ')
- CALL IPIOUT(ICMTOP(X1W))
- CALL IPIOUT(ICMTOP(Y1W))
- CALL IPIOUT(ICMTOP(X2W))
- CALL IPIOUT(ICMTOP(Y2W))
- CALL IPPSTR('@')
- ENDIF
- CALL IPDEF
- LOBB=.TRUE.
- LOPRT=LOPSAV
- ENDIF
- ENDIF
-#endif
-#if defined(CERNLIB_MAIL)
-*
- IF(MFLAG)THEN
- WRITE (CHMAIL,'(I3,I5)') 200,NT
- CALL IMWRIT(1)
- WRITE (CHMAIL,'(4E16.7)') RWXMIN,RWXMAX,RWYMIN,RWYMAX
- CALL IMWRIT(2)
- WRITE (CHMAIL,'(4E16.7)') RVXMIN,RVXMAX,RVYMIN,RVYMAX
- CALL IMWRIT(3)
- ENDIF
-#endif
-#if defined(CERNLIB_ZEBRA)
-*
- IF(ZFLAG)THEN
- IF(LPICT.LT.0)RETURN
- DO 10 I=1,NBIATT
- IATADR(30+I)=-1
- 10 CONTINUE
- DO 20 I=1,NBRATT
- IATADR(I)=-1
- 20 CONTINUE
-*
-* The normalization transformation is the transformation 0
-*
- IF(NT.EQ.0)THEN
- LHNT=LHNT0
- IQ(LHNT+3)=IZGHNP(LPICT)+1
- ITBPTR=IQ(LHNT+4)
- INBLEV=IQ(LHNT+5)
- IRNSIZ=IQ(LHNT-1)
- IIAPTR=IZGADR(LHNT,8)
- IRAPTR=IZGADR(LHNT,9)
- IF(NT.NE.INTR)THEN
- DO 30 I=1,NBIATT
- IIFLAT(I)=JBIT(IQ(LHNT+6),I)
- 30 CONTINUE
- DO 40 I=1,NBRATT
- IRFLAT(I)=JBIT(IQ(LHNT+7),I)
- 40 CONTINUE
- CALL IZSENV
- ENDIF
- RETURN
- ENDIF
-*
- LN=IZGNTP(NT)
-*
-* The normalization transformation NT is not yet in
-* the current IZ picture
-*
- IF(LN.EQ.0)THEN
-*
-* Create the Normalisation Tranformation Bank number NT
-*
- CALL MZBOOK(IXHIGZ,LHNTP,LHNTLA,0,'HZNT',0,0,INSIZ,2,0)
- LHNT=LHNTP
- LHNTLA=LHNT
-*
-* Initialisation of the Normalisation Transformation bank NT
-*
- IQ(LHNT+1)=NT
- ITBPTR=10
- IQ(LHNT+3)=IZGHNP(LPICT)+1
- IQ(LHNT+4)=ITBPTR
- IRNSIZ=INSIZ
- IQ(LHNT+5)=0
- INBLEV=IQ(LHNT+5)
- IIAPTR=INTPTR
- IRAPTR=IFLPTR
- IQ(LHNT+8)=1000000*NBIATT+IIAPTR
- IQ(LHNT+9)=1000000*NBRATT+IRAPTR
-*
-* Store the default attributes in the new NT bank
-*
- IF(IZPUSH(NBIATT,NBRATT,0,'ISELNT').NE.0)RETURN
- CALL IZCDA(0)
- CALL IZINCI(NBIATT)
- CALL IZINCF(NBRATT)
-*
-* Attributes flags initialization
-*
- DO 50 I=1,NBRATT
- IRFLAT(I)=0
- 50 CONTINUE
- DO 60 I=1,NBIATT
- IIFLAT(I)=0
- 60 CONTINUE
-*
-* Increment the NT bank counter
-*
- INBNT=INBNT+1
- IQ(LPICT+8)=INBNT
-*
-* Store the window and viewport parameters in the REAL bank
-*
- IQ(LHNT+2)=IFLPTR
- IF(IZPUSH(0,8,0,'ISELNT').NE.0)RETURN
- Q(LHF+IFLPTR)=RWXMIN
- Q(LHF+IFLPTR+1)=RWXMAX
- Q(LHF+IFLPTR+2)=RWYMIN
- Q(LHF+IFLPTR+3)=RWYMAX
- Q(LHF+IFLPTR+4)=RVXMIN
- Q(LHF+IFLPTR+5)=RVXMAX
- Q(LHF+IFLPTR+6)=RVYMIN
- Q(LHF+IFLPTR+7)=RVYMAX
- CALL IZINCF(8)
- RETURN
- ELSE
-*
-* The normalisation transformation bank NT exits in the
-* current picture . The transformation NT becomes the
-* current transformation .
-*
- LHNT=LN
- Q(LHF+IQ(LHNT+2))=RWXMIN
- Q(LHF+IQ(LHNT+2)+1)=RWXMAX
- Q(LHF+IQ(LHNT+2)+2)=RWYMIN
- Q(LHF+IQ(LHNT+2)+3)=RWYMAX
- Q(LHF+IQ(LHNT+2)+4)=RVXMIN
- Q(LHF+IQ(LHNT+2)+5)=RVXMAX
- Q(LHF+IQ(LHNT+2)+6)=RVYMIN
- Q(LHF+IQ(LHNT+2)+7)=RVYMAX
- IQ(LHNT+3)=IZGHNP(LPICT)+1
- ITBPTR=IQ(LHNT+4)
- IRNSIZ=IQ(LHNT-1)
- INBLEV=IQ(LHNT+5)
- IIAPTR=IZGADR(LHNT,8)
- IRAPTR=IZGADR(LHNT,9)
- IF(NT.NE.INTR)THEN
-*
-* Set the Flags Attributes .
-*
- DO 70 I=1,NBIATT
- IIFLAT(I)=JBIT(IQ(LHNT+6),I)
- 70 CONTINUE
- DO 80 I=1,NBRATT
- IRFLAT(I)=JBIT(IQ(LHNT+7),I)
- 80 CONTINUE
- CALL IZSENV
- ENDIF
- ENDIF
- ENDIF
-#endif
-*
- END
-#endif
diff --git a/src/graflib/higz/iz/izsenv.F b/src/graflib/higz/iz/izsenv.F
deleted file mode 100644
index e25c146..0000000
--- a/src/graflib/higz/iz/izsenv.F
+++ /dev/null
@@ -1,35 +0,0 @@
-*
-* $Id: izsenv.F,v 1.1.1.1 1996/02/14 13:11:14 mclareni Exp $
-*
-* $Log: izsenv.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:14 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-#if defined(CERNLIB_ZEBRA)
-*CMZ : 1.06/03 19/01/89 10.58.13 by O.Couet
-*-- Author :
- SUBROUTINE IZSENV
-*.===========>
-*.
-*. This routine copies the graphic environnement in the current picture .
-*.
-*..==========> (O.Couet)
-#include "higz/hiatnb.inc"
-*.______________________________________
-*
-* Real attributes .
-*
- DO 10 I=50,50+NBRATT-1
- CALL IZATT(I)
- 10 CONTINUE
-*
-* Integer attributes .
-*
- DO 20 I=80,80+NBIATT-1
- CALL IZATT(I)
- 20 CONTINUE
-*
- END
-#endif
diff --git a/src/graflib/higz/iz/izset.F b/src/graflib/higz/iz/izset.F
deleted file mode 100644
index 76d8037..0000000
--- a/src/graflib/higz/iz/izset.F
+++ /dev/null
@@ -1,36 +0,0 @@
-*
-* $Id: izset.F,v 1.1.1.1 1996/02/14 13:11:14 mclareni Exp $
-*
-* $Log: izset.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:14 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.06/06 10/03/89 08.46.53 by O.Couet
-* Test if ISVNT=0
-*-- Author :
- SUBROUTINE IZSET
-*.===========>
-*.
-*. This restores the attributes environment.
-*.
-*..==========> (O.Couet)
-#include "higz/hiatnb.inc"
-#include "higz/hisave.inc"
-#include "higz/hiatnm.inc"
-*.______________________________________
-*
- DO 10 I=1,NBIATT
- CALL IGSET(CHIATT(I),FLOAT(ISAVE(I)))
- 10 CONTINUE
- DO 20 I=1,NBRATT
- CALL IGSET(CHRATT(I),RSAVE(I))
- 20 CONTINUE
- IF(ISVNT.NE.0)THEN
- CALL ISWN(ISVNT,WNVPSV(1),WNVPSV(2),WNVPSV(3),WNVPSV(4))
- CALL ISVP(ISVNT,WNVPSV(5),WNVPSV(6),WNVPSV(7),WNVPSV(8))
- ENDIF
- CALL ISELNT(ISVNT)
-*
- END
diff --git a/src/graflib/higz/iz/izseta.F b/src/graflib/higz/iz/izseta.F
deleted file mode 100644
index 634887f..0000000
--- a/src/graflib/higz/iz/izseta.F
+++ /dev/null
@@ -1,30 +0,0 @@
-*
-* $Id: izseta.F,v 1.1.1.1 1996/02/14 13:11:14 mclareni Exp $
-*
-* $Log: izseta.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:14 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.06/03 13/12/88 09.53.36 by O.Couet
-*-- Author :
- SUBROUTINE IZSETA
-*.===========>
-*.
-*. This restores the attributes environment.
-*.
-*..==========> (O.Couet)
-#include "higz/hiatnb.inc"
-#include "higz/hisava.inc"
-#include "higz/hiatnm.inc"
-*.______________________________________
-*
- DO 10 I=1,NBIATT
- CALL IGSET(CHIATT(I),FLOAT(ISAVA(I)))
- 10 CONTINUE
- DO 20 I=1,NBRATT
- CALL IGSET(CHRATT(I),RSAVA(I))
- 20 CONTINUE
-*
- END
diff --git a/src/graflib/higz/iz/izstcc.F b/src/graflib/higz/iz/izstcc.F
deleted file mode 100644
index fe63255..0000000
--- a/src/graflib/higz/iz/izstcc.F
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: izstcc.F,v 1.1.1.1 1996/02/14 13:11:14 mclareni Exp $
-*
-* $Log: izstcc.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:14 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-#if defined(CERNLIB_ZEBRA)
-*CMZ : 1.11/00 27/09/90 15.56.04 by O.Couet
-*-- Author :
- SUBROUTINE IZSTCC(ICODE,IADR)
-*.===========>
-*.
-*. This routine STores the Control Code ICODE and the adress IADR in the
-*. current normalisation transformation bank .
-*.
-*. _Input parameters:
-*.
-*. INTEGER ICODE : Control code .
-*. INTEGER IADR : Adress .
-*.
-*..==========> (O.Couet)
-#include "higz/hipaw.inc"
-*.______________________________________
-*
- IQ(LHNT+ITBPTR)=1000000*ICODE+IADR
- ITBPTR=ITBPTR+1
- IQ(LHNT+4)=ITBPTR
-*
- END
-#endif
diff --git a/src/graflib/higz/iz/iztabl.F b/src/graflib/higz/iz/iztabl.F
deleted file mode 100644
index 63dc70c..0000000
--- a/src/graflib/higz/iz/iztabl.F
+++ /dev/null
@@ -1,137 +0,0 @@
-*
-* $Id: iztabl.F,v 1.1.1.1 1996/02/14 13:11:14 mclareni Exp $
-*
-* $Log: iztabl.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:14 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_MAIL)
-*CMZ : 1.22/08 27/02/95 17.41.08 by O.Couet
-*-- Author : O.Couet 18/09/89
- SUBROUTINE IZTABL(NX,NY,V,NPARI,PAR,IOPT)
-*.===========>
-*.
-*. This routine stores in the current picture the necessary data to
-*. to draw a table .
-*.
-*. _Input parameters:
-*.
-*. INTEGER NX x NY : Number of points .
-*. REAL V(NX,NY) : Table contain .
-*. INTEGER NPAR : Number of additional parameters .
-*. REAL PAR(NPAR) : additional parameters .
-*. INTEGER IOPT : Option .
-*.
-*..==========> (O.Couet)
-#include "higz/hicode.inc"
-#include "higz/hiflag.inc"
-#if defined(CERNLIB_ZEBRA)
-#include "higz/hipaw.inc"
-#endif
-#if defined(CERNLIB_ZEBRA)
-#include "higz/hipack.inc"
-#endif
-#if defined(CERNLIB_MAIL)
-#include "higz/himail.inc"
-#endif
- DIMENSION IOPT(*)
- DIMENSION PAR(*),V(NX,1)
-#if defined(CERNLIB_MAIL)
- CHARACTER*16 CHTEMP
-#endif
- REAL IGCELL
-*.______________________________________
-*
-#include "higz/hibit.inc"
-*
- NYY = MAX(NY,1)
- NPAR = NPARI
-#if defined(CERNLIB_ZEBRA)
- IF(ZFLAG)THEN
- IF(LPICT.LT.0)RETURN
- IF(PAR(9).LT.0..OR.PAR(10).LT.0.)NPAR=NPAR+2
- IF(IPACK.NE.0)LWV=INT(V(1,1))
- IF(IZPUSH(5,NX*NYY+NPAR,0,'IGTABL').NE.0)RETURN
- IF(IPACK.NE.0)V(1,1)=FLOAT(LWV)
- CALL IZCFA(IBOFCO,1)
- CALL IZCFA(IBWDCO,1)
- CALL IZCFA(ILNCO,1)
- CALL IZCFA(ILWSCO,1)
- CALL IZCFA(IPLCCO,1)
- CALL IZCFA(IFAICO,1)
- CALL IZCFA(IFASCO,1)
- CALL IZCFA(IFACCO,1)
- CALL IZCFA(ITMSCO,1)
- CALL IZCFA(IALHCO,1)
- CALL IZCFA(IALDCO,1)
- CALL IZCFA(ITXCCO,1)
- CALL IZCFA(ITXFCO,1)
- CALL IZCFA(ICHHCO,1)
- CALL IZCFA(IGTSCO,1)
- CALL IZCFA(IGTWCO,1)
- CALL IZCFA(IAWLCO,1)
- CALL IZCFA(IMKCO,1)
- CALL IZCFA(IMKSCO,1)
- CALL IZCFA(IPMCCO,1)
-*
- CALL IZSTCC(ITABCO,INTPTR)
- IQ(LHI+INTPTR) =NX
- IQ(LHI+INTPTR+1)=NY
- IQ(LHI+INTPTR+2)=IFLPTR
- IQ(LHI+INTPTR+3)=NPARI
- DO 10 I=1,30
- IF(IOPT(I).NE.0)CALL SBIT1(IQ(LHI+INTPTR+4),I)
- 10 CONTINUE
- CALL IZINCI(5)
- DO 20 I=1,NPARI
- Q(LHF+IFLPTR+I-1)=PAR(I)
- 20 CONTINUE
- IF(PAR(9).LT.0.) Q(LHF+IFLPTR+NPARI)=IQUEST(60)
- IF(PAR(10).LT.0.)Q(LHF+IFLPTR+NPARI+1)=IQUEST(61)
- CALL IZINCF(NPAR)
- DO 40 J=1,NYY
- DO 30 I=1,NX
- Q(LHF+IFLPTR+I-1+(J-1)*NX)=IGCELL(NX,NY,V,I,J,1)
- 30 CONTINUE
- 40 CONTINUE
- CALL IZINCF(NX*NYY)
- ENDIF
-#endif
-#if defined(CERNLIB_MAIL)
-*
- IF(MFLAG)THEN
- IF(IOPT(11).NE.0)THEN
- CALL IGERR('Stacked LEGO not implemented with telnetg'
- +, 'IGTABL')
- RETURN
- ENDIF
- IOP=INDEX(CHOPTM,'H')
- IF(IOP.GT.0)CHOPTM(IOP:IOP)=' '
- IF(PAR(9).LT.0.) PAR(9) =1000.*ABS(PAR(9))+IQUEST(60)
- IF(PAR(10).LT.0.)PAR(10)=1000.*ABS(PAR(10))+IQUEST(61)
- WRITE (CHMAIL,'(I3,A20,3I5)') ITABCO,CHOPTM,NX,NY,NPARI
- CALL IMWRIT(1)
- CALL IMFOUT(NPARI,PAR)
- JJ=0
- CHMAIL=' '
- DO 70 J=1,NYY
- DO 60 I=1,NX
- WRITE (CHTEMP,'(G13.7)')IGCELL(NX,NY,V,I,J,1)
- K=(13*JJ)+1
- CHMAIL(K:K+12)=CHTEMP(1:13)
- JJ=JJ+1
- IF(JJ.EQ.6)THEN
- JJ=0
- CALL IMWRIT(2)
- ENDIF
- 60 CONTINUE
- 70 CONTINUE
- IF(JJ.NE.0)CALL IMWRIT(2)
- CALL IMWRIT(5)
- ENDIF
-#endif
-*
- END
-#endif
diff --git a/src/graflib/higz/iz/iztext.F b/src/graflib/higz/iz/iztext.F
deleted file mode 100644
index 803a030..0000000
--- a/src/graflib/higz/iz/iztext.F
+++ /dev/null
@@ -1,77 +0,0 @@
-*
-* $Id: iztext.F,v 1.1.1.1 1996/02/14 13:11:14 mclareni Exp $
-*
-* $Log: iztext.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:14 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_MAIL)
-*CMZ : 1.11/00 24/08/90 16.34.17 by O.Couet
-*-- Author :
- SUBROUTINE IZTEXT(X,Y,KTEXT,SSIZE,ANGLE,IOPT)
-*.===========>
-*.
-*. This routine stores the IGTEXT data in the current picture .
-*.
-*. _Input parameters:
-*.
-*. REAL X,Y : Coordinates for beginning of text .
-*. CHARACTER KTEXT : Text .
-*. INTEGER SSIZE : Text size .
-*. REAL ANGLE : The rotation angle in degrees .
-*. INTEGER IOPT : Option .
-*.
-*..==========> (O.Couet)
-#include "higz/hicode.inc"
-#include "higz/hiflag.inc"
-#if defined(CERNLIB_ZEBRA)
-#include "higz/hipaw.inc"
-#endif
-#if defined(CERNLIB_MAIL)
-#include "higz/himail.inc"
-#endif
- CHARACTER*(*) KTEXT
- DIMENSION IOPT(*)
-*.______________________________________
-*
- NCHP=LENOCC(KTEXT)
- IF(NCHP.LE.0)RETURN
-#if defined(CERNLIB_ZEBRA)
- IF(ZFLAG)THEN
- IF(LPICT.LT.0)RETURN
- IF(IZPUSH(4,4,(NCHP+3)/4,'IGTEXT').NE.0)RETURN
- CALL IZCFA(ITXCCO,1)
- CALL IZCFA(IGTSCO,1)
- CALL IZCFA(IGTWCO,1)
-*
- CALL IZSTCC(IGTXCO,INTPTR)
- IQ(LHI+INTPTR)=IFLPTR
- IQ(LHI+INTPTR+1)=ISTPTR
- IQ(LHI+INTPTR+2)=NCHP
- DO 10 I=1,3
- IF(IOPT(I).NE.0)CALL SBIT1(IQ(LHI+INTPTR+3),I)
- 10 CONTINUE
- CALL IZINCI(4)
- Q(LHF+IFLPTR)=X
- Q(LHF+IFLPTR+1)=Y
- Q(LHF+IFLPTR+2)=SSIZE
- Q(LHF+IFLPTR+3)=ANGLE
- CALL IZINCF(4)
- CALL UCTOH(KTEXT,IQ(LHC+ISTPTR),4,NCHP)
- CALL IZINCS((NCHP+3)/4)
- ENDIF
-#endif
-#if defined(CERNLIB_MAIL)
- IF(MFLAG)THEN
- WRITE (CHMAIL,'(I3,4E16.7,A4)') IGTXCO,X,Y,SSIZE,ANGLE,CHOPTM
- CALL IMWRIT(1)
- CHMAIL=' '
- CHMAIL=KTEXT
- CALL IMWRIT(3)
- ENDIF
-#endif
-*
- END
-#endif
diff --git a/src/graflib/higz/iz/iztx.F b/src/graflib/higz/iz/iztx.F
deleted file mode 100644
index 904eeb9..0000000
--- a/src/graflib/higz/iz/iztx.F
+++ /dev/null
@@ -1,125 +0,0 @@
-*
-* $Id: iztx.F,v 1.2 2004/06/10 07:49:03 couet Exp $
-*
-* $Log: iztx.F,v $
-* Revision 1.2 2004/06/10 07:49:03 couet
-* - The text vertical alignment (in PS files) was not correct for rotated
-* text in case of software font.
-*
-* Revision 1.1.1.1 1996/02/14 13:11:14 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_PSCRIPT)||defined(CERNLIB_MAIL)
-*CMZ : 1.22/10 05/04/95 15.39.08 by O.Couet
-*-- Author :
- SUBROUTINE IZTX(XX,YY,CHARS)
-*.===========>
-*.
-*. This routine stores the text data in the current picture .
-*.
-*. _Input parameters:
-*.
-*. REAL XX,YY : Text position in world coordinates .
-*. CHARACTER CHARS : Text string .
-*.
-*..==========> (O.Couet)
-#if defined(CERNLIB_ZEBRA)||defined(CERNLIB_MAIL)
-#include "higz/hicode.inc"
-#endif
-#if defined(CERNLIB_PSCRIPT)
-#include "higz/hiatt.inc"
-#endif
-#include "higz/hiflag.inc"
-#if defined(CERNLIB_ZEBRA)
-#include "higz/hipaw.inc"
-#endif
-#if defined(CERNLIB_MAIL)
-#include "higz/himail.inc"
-#endif
- CHARACTER*(*) CHARS
-#if defined(CERNLIB_PSCRIPT)
- LOGICAL ZSAV,GSAV
- CHARACTER*1 CHOPT
-#endif
-*.______________________________________
-*
- X=XX
- Y=YY
- NCHP=LENOCC(CHARS)
- IF(NCHP.LE.0)RETURN
-*
-#if defined(CERNLIB_PSCRIPT)
- IF(PFLAG)THEN
- GSAV = GFLAG
- GFLAG = .FALSE.
- ZSAV = ZFLAG
- ZFLAG = .FALSE.
- GLFLAG = (ZFLAG.OR.PFLAG.OR.MFLAG)
- CALL IPZONE
- CALL IPSCOL(ITXCI)
- IF((IFONT.EQ.0).AND.(IPREC.EQ.2))THEN
- IF(ITXALH.EQ.2)THEN
- CHOPT='C'
- ELSEIF(ITXALH.EQ.3)THEN
- CHOPT='R'
- ELSE
- CHOPT='L'
- ENDIF
- IF((ITXALV.EQ.2).OR.(ITXALV.EQ.1))THEN
- Y = Y-RCHH*COS((3.14159/180.)*RANGLE)
- X = X+RCHH*SIN((3.14159/180.)*RANGLE)
- ELSEIF(ITXALV.EQ.3)THEN
- Y = Y-(RCHH/2.)*COS((3.14159/180.)*RANGLE)
- X = X+(RCHH/2.)*SIN((3.14159/180.)*RANGLE)
- ENDIF
- CALL IGTEXT(X,Y,CHARS,RCHH,RANGLE,CHOPT)
- ELSEIF(TFLAG) THEN
- CALL IPTTEX(XX,YY,CHARS)
- ELSE
- CALL IPTEXT(XX,YY,CHARS)
- ENDIF
- GFLAG = GSAV
- ZFLAG = ZSAV
- GLFLAG = (ZFLAG.OR.PFLAG.OR.MFLAG)
- ENDIF
-#endif
-#if defined(CERNLIB_ZEBRA)
-*
- IF(ZFLAG)THEN
- IF(LPICT.LT.0)RETURN
- IF(IZPUSH(3,2,(NCHP+3)/4,'ITX').NE.0)RETURN
- CALL IZCFA(ITXCCO,1)
- CALL IZCFA(ITXACO,1)
- CALL IZCFA(ICHHCO,1)
- CALL IZCFA(IANGCO,1)
- CALL IZCFA(ITXFCO,1)
- CALL IZCFA(IGTSCO,1)
- CALL IZCFA(IGTWCO,1)
-*
- CALL IZSTCC(ITXCO,INTPTR)
- IQ(LHI+INTPTR)=IFLPTR
- IQ(LHI+INTPTR+1)=ISTPTR
- IQ(LHI+INTPTR+2)=NCHP
- CALL IZINCI(3)
- Q(LHF+IFLPTR)=X
- Q(LHF+IFLPTR+1)=Y
- CALL IZINCF(2)
- CALL UCTOH(CHARS,IQ(LHC+ISTPTR),4,NCHP)
- CALL IZINCS((NCHP+3)/4)
- ENDIF
-#endif
-#if defined(CERNLIB_MAIL)
-*
- IF(MFLAG)THEN
- WRITE (CHMAIL,'(I3,2E16.7)') ITXCO,X,Y
- CALL IMWRIT(1)
- CHMAIL=' '
- CHMAIL=CHARS
- CALL IMWRIT(3)
- ENDIF
-#endif
-*
- END
-#endif
diff --git a/src/graflib/higz/iz/iztx3.F b/src/graflib/higz/iz/iztx3.F
deleted file mode 100644
index 9ed098a..0000000
--- a/src/graflib/higz/iz/iztx3.F
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: iztx3.F,v 1.1.1.1 1996/02/14 13:11:14 mclareni Exp $
-*
-* $Log: iztx3.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:14 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-#if defined(CERNLIB_ZEBRA)
-*CMZ : 1.06/03 09/12/88 10.34.18 by O.Couet
-*-- Author :
- SUBROUTINE IZTX3(X,Y,Z,VX,VY,VZ,TEXT)
-*.===========>
-*.
-*..==========> (O.Couet)
- DIMENSION VX(2),VY(2),VZ(2)
- CHARACTER*(*) TEXT
-*.______________________________________
-*
- END
-#endif
diff --git a/src/graflib/higz/iz/izwip.F b/src/graflib/higz/iz/izwip.F
deleted file mode 100644
index 4bf750d..0000000
--- a/src/graflib/higz/iz/izwip.F
+++ /dev/null
@@ -1,80 +0,0 @@
-*
-* $Id: izwip.F,v 1.2 1998/12/01 15:48:42 couet Exp $
-*
-* $Log: izwip.F,v $
-* Revision 1.2 1998/12/01 15:48:42 couet
-* - Clean up: commented lines of code removed
-*
-* Revision 1.1.1.1 1996/02/14 13:11:14 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-#if defined(CERNLIB_ZEBRA)
-*CMZ : 1.14/09 01/06/92 16.36.30 by O.Couet
-*-- Author :
- SUBROUTINE IZWIP(LP)
-*.===========>
-*.
-*. This routine supress the empty words of the picture LP .
-*.
-*. _Input parameters:
-*.
-*. INTEGER LP : Picture link .
-*.
-*..==========> (O.Couet)
-#include "higz/hipaw.inc"
-*.______________________________________
-*
- IF(LP.LE.0)RETURN
- LPSAV=LPICT
- CALL IZSCPI(LP)
-*
-* Cleaning of the NT banks
-*
- LN=LHNT0
- DO 10 I=1,INBNT
- IF(LN.EQ.0)GOTO 30
- INPUSH=IQ(LN+4)-IQ(LN-1)
- IF(INPUSH.EQ.0)GOTO 20
- CALL MZPUSH(IXHIGZ,LN,0,INPUSH,' ')
- IF(LN.EQ.LHNT)IRNSIZ=IQ(LN-1)
- 20 LN=LQ(LN)
- 10 CONTINUE
- 30 CONTINUE
-*
-* Cleaning of the INTEGER bank
-*
- IIPUSH=INTPTR-IRISIZ
- IF(IIPUSH.NE.0)THEN
- CALL MZPUSH(IXHIGZ,LHI,0,IIPUSH,' ')
- IRISIZ=IRISIZ+IIPUSH
- IQ(LPICT+5)=IRISIZ
- ENDIF
-*
-* Cleaning of the REAL bank
-*
- IFPUSH=IFLPTR-IRFSIZ
- IF(IFPUSH.NE.0)THEN
- CALL MZPUSH(IXHIGZ,LHF,0,IFPUSH,' ')
- IRFSIZ=IRFSIZ+IFPUSH
- IQ(LPICT+6)=IRFSIZ
- ENDIF
-*
-* Cleaning of the CHARACTER bank
-*
- ISPUSH=ISTPTR-IRSSIZ
- IF(ISPUSH.NE.0)THEN
- CALL MZPUSH(IXHIGZ,LHC,0,ISPUSH,' ')
- IRSSIZ=IRSSIZ+ISPUSH
- IQ(LPICT+7)=IRSSIZ
- ENDIF
-*
- IF(LPSAV.GT.0)THEN
- CALL IZSCPI(LPSAV)
- ELSE
- LPICT=LPSAV
- ENDIF
-*
- END
-#endif
diff --git a/src/graflib/higz/menu/Imakefile b/src/graflib/higz/menu/Imakefile
deleted file mode 100644
index a6ff139..0000000
--- a/src/graflib/higz/menu/Imakefile
+++ /dev/null
@@ -1,4 +0,0 @@
-SRCS_F= igcmp.F igdelm.F igdime.F iggch.F iggdef.F ighigh.F \ @@\
- igmenu.F igsmp.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/graflib/higz/menu/Imakefile.dgks b/src/graflib/higz/menu/Imakefile.dgks
deleted file mode 100644
index ce2e085..0000000
--- a/src/graflib/higz/menu/Imakefile.dgks
+++ /dev/null
@@ -1,8 +0,0 @@
-SRCS_F= igcmp.F igdelm.F igdime.F iggch.F iggdef.F ighigh.F \ @@\
- igmenu.F igsmp.F
-
-SubdirExtraLibraryTarget(NullParameter,NullParameter,NullParameter,dgks)
-
-VersionFortranObjectRule(dgks,NullParameter,-DCERNLIB_DECGKS)
-
-BuildNamedMakefileTarget(Makefile.dgks,Imakefile.dgks,-DCERNLIB_DECGKS)
diff --git a/src/graflib/higz/menu/igcmp.F b/src/graflib/higz/menu/igcmp.F
deleted file mode 100644
index dc76cb5..0000000
--- a/src/graflib/higz/menu/igcmp.F
+++ /dev/null
@@ -1,93 +0,0 @@
-*
-* $Id: igcmp.F,v 1.1.1.1 1996/02/14 13:11:14 mclareni Exp $
-*
-* $Log: igcmp.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:14 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.20/00 01/11/93 10.49.48 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE IGCMP(TITLE,CHUSER,CHITEM,CHDEF,CHVAL,IOPT,IR)
-*.===========>
-*.
-*. This routine change the place of the current displayed menu.
-*.
-*..==========> (O.Couet)
-#include "higz/himenu.inc"
-#include "higz/hiloc.inc"
-#if defined(CERNLIB_GKS)||defined(CERNLIB_DI3000)
-#include "higz/hiatt.inc"
-#endif
-#if defined(CERNLIB_GKS)||defined(CERNLIB_DI3000)
-#include "higz/hiflag.inc"
-#endif
- DIMENSION IOPT(*)
- CHARACTER*(*) CHITEM(*),TITLE,CHDEF(*),CHVAL
- CHARACTER*(*) CHUSER(*)
-*.______________________________________
-*
- CALL IGDELM(IOPT)
-#if (defined(CERNLIB_GKS))&&(!defined(CERNLIB_MGKS))
- IF(GFLAG)THEN
- IF(MENNUM.NE.0)THEN
- IF(ISEGM(MENNUM).NE.0)THEN
- CALL GDSGWK(IDID,MENNUM)
- ISEGM(MENNUM)=0
- RETURN
- ENDIF
- ENDIF
- ENDIF
-#endif
-#if defined(CERNLIB_DI3000)
- IF(MENNUM.NE.0)THEN
- IF(ISEGM(MENNUM).NE.0)THEN
- CALL JPURGE(MENNUM)
- ISEGM(MENNUM)=0
- RETURN
- ENDIF
- ENDIF
-#endif
-*
- IF(IR.NE.0)THEN
- 10 CALL IGLOC(1,NT,IBN,X1,Y1,XWC,YWC)
- IF(IBN.EQ.0)GOTO 10
- XPOS(1)=X1-(XPOS(2)-XPOS(1))
- YPOS(1)=Y1-(YPOS(2)-YPOS(1))
- XPOS(2)=X1
- YPOS(2)=Y1
- GOTO 30
- ELSE
- 20 CALL IGLOC(1,NT,IBN,X1,Y1,XWC,YWC)
- IF(IBN.EQ.0)GOTO 20
- CALL IGLOC(51,NT,IBN,X2,Y2,XWC,YWC)
- IF(IBN.EQ.0)GOTO 20
- IF((ABS(X1-X2).LT.0.01).OR.
- + (ABS(Y1-Y2).LT.0.01))GOTO 30
- XPOS(1)=X1
- XPOS(2)=X2
- YPOS(1)=Y1
- YPOS(2)=Y2
- IF(XPOS(2).LT.XPOS(1))THEN
- R=XPOS(2)
- XPOS(2)=XPOS(1)
- XPOS(1)=R
- ENDIF
- IF(YPOS(2).LT.YPOS(1))THEN
- R=YPOS(2)
- YPOS(2)=YPOS(1)
- YPOS(1)=R
- ENDIF
- ENDIF
-*
- 30 ICUCHS=ICUCH
- CALL ISTXCI(1)
- CALL IGDIME(TITLE,CHUSER,CHITEM,CHDEF,CHVAL,IOPT)
- IF(IOPT(1).NE.0.AND.IOPT(5).EQ.0)THEN
- CALL IGHIGH(ICUCHS,CHITEM,CHUSER,IOPT)
- ENDIF
- OLDXP=XPOS(1)+(XPOS(2)-XPOS(1))/2
- OLDYP=Y3-YSTEP
-*
- END
diff --git a/src/graflib/higz/menu/igdelm.F b/src/graflib/higz/menu/igdelm.F
deleted file mode 100644
index 0c4a508..0000000
--- a/src/graflib/higz/menu/igdelm.F
+++ /dev/null
@@ -1,57 +0,0 @@
-*
-* $Id: igdelm.F,v 1.1.1.1 1996/02/14 13:11:15 mclareni Exp $
-*
-* $Log: igdelm.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:15 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.20/00 01/11/93 10.50.18 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE IGDELM(IOPT)
-*.===========>
-*.
-*. This routine delete the current displayed menu.
-*.
-*..==========> (O.Couet)
-#include "higz/himenu.inc"
-#if defined(CERNLIB_GKS)||defined(CERNLIB_DI3000)
-#include "higz/hiflag.inc"
-#endif
- CHARACTER*8 CHOPT
- DIMENSION IOPT(*)
-*.______________________________________
-*
-#if (defined(CERNLIB_GKS))&&(!defined(CERNLIB_MGKS))
- IF(GFLAG)THEN
- IF(MENNUM.NE.0)THEN
- IF(ISEGM(MENNUM).NE.0)THEN
- CALL GSVIS(MENNUM,0)
- RETURN
- ENDIF
- ENDIF
- ENDIF
-#endif
-#if defined(CERNLIB_DI3000)
- IF(MENNUM.NE.0)THEN
- IF(ISEGM(MENNUM).NE.0)THEN
- CALL JVISBL(MENNUM,0)
- RETURN
- ENDIF
- ENDIF
-#endif
-*
- CHOPT=' '
- DZ=0.
- IF(IOPT(14).NE.0)CHOPT(1:2)='TR'
- IF(IOPT(15).NE.0)CHOPT(1:2)=' R'
- IF(IOPT(16).NE.0)CHOPT(3:3)='P'
- IF(IOPT(18).NE.0)CHOPT(4:4)='S'
- IF(IOPT(19).NE.0)CHOPT(5:5)='K'
- IF(CHOPT.NE.' ')DZ=5.*DEC
- CHOPT(6:6)='D'
- CALL IGPAVE(XPOS(1),XPOS(2),YPOS(1),YPOS(2)
- +, DZ,0,0,CHOPT)
-*
- END
diff --git a/src/graflib/higz/menu/igdime.F b/src/graflib/higz/menu/igdime.F
deleted file mode 100644
index 2ad4abd..0000000
--- a/src/graflib/higz/menu/igdime.F
+++ /dev/null
@@ -1,267 +0,0 @@
-*
-* $Id: igdime.F,v 1.2 1998/01/30 15:22:46 couet Exp $
-*
-* $Log: igdime.F,v $
-* Revision 1.2 1998/01/30 15:22:46 couet
-* - APOLLO version removed
-*
-* Revision 1.1.1.1 1996/02/14 13:11:15 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.20/00 01/11/93 10.51.24 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE IGDIME(TITLE,CHUSER,CHITEM,CHDEF,CHVAL,IOPT)
-*.===========>
-*.
-*. This routine display the menu.
-*.
-*..==========> (O.Couet)
-#include "higz/himenu.inc"
-#if defined(CERNLIB_GKS)||defined(CERNLIB_DI3000)
-#include "higz/hiflag.inc"
-#endif
- DIMENSION X(6),Y(6)
- DIMENSION IOPT(*)
- CHARACTER*4 CHOPT
- CHARACTER*(*) CHITEM(*),TITLE,CHDEF(*),CHVAL(*)
- CHARACTER*(*) CHUSER(*)
-*.______________________________________
-*
- CALL IGSMP(IOPT)
-*
-#if (defined(CERNLIB_GKS))&&(!defined(CERNLIB_MGKS))
- IF(GFLAG)THEN
- IF(MENNUM.NE.0)THEN
- IF(ISEGM(MENNUM).NE.0)THEN
- CALL GSVIS(MENNUM,1)
- ICUCH=0
- RETURN
- ELSE
- ISEGM(MENNUM)=1
- CALL GCRSG(MENNUM)
- ENDIF
- ENDIF
- ENDIF
-#endif
-#if defined(CERNLIB_DI3000)
- IF(MENNUM.NE.0)THEN
- IF(ISEGM(MENNUM).NE.0)THEN
- CALL JVISBL(MENNUM,1)
- ICUCH=0
- RETURN
- ELSE
- ISEGM(MENNUM)=1
- CALL JROPEN(MENNUM)
- ENDIF
- ENDIF
-#endif
-*
-* Set the correct font and precision
-*
- IF(ISOFT.NE.0)THEN
- CALL ISTXFP(0,2)
- ELSE
-#if defined(CERNLIB_X11)
- CALL ISTXFP(-8,0)
-#endif
-#if !defined(CERNLIB_X11)
- CALL ISTXFP(1,0)
-#endif
- ENDIF
- CALL ISPLCI(1)
- CALL ISLN(1)
- CALL IGSET('BORD',1.)
-*
- CALL ISCLIP(0)
-*
-* Draw the Frame
-*
- IF(IOPT(19).NE.0)GOTO 10
- CHOPT=' '
- DZ=0.
- ISFRAM=0
- IF(IOPT(14).NE.0)CHOPT(1:2)='TR'
- IF(IOPT(15).NE.0)CHOPT(1:2)=' R'
- IF(IOPT(16).NE.0)CHOPT(3:3)='P'
- IF(IOPT(18).NE.0)CHOPT(4:4)='S'
- IF(CHOPT.NE.' ')THEN
- DZ=5.*DEC
- IF(IOPT(18).EQ.0)THEN
-#if (defined(CERNLIB_GL)||defined(CERNLIB_X11))&&(!defined(CERNLIB_MSDOS))
- ISFRAM=2
-#endif
-#if (defined(CERNLIB_GKSGRAL)||defined(CERNLIB_MSDOS))
- ISFRAM=-104
-#endif
-#if (!defined(CERNLIB_GKSGRAL))&&(!defined(CERNLIB_GL))&&(!defined(CERNLIB_X11))
- ISFRAM=1
-#endif
- ELSE
- ISFRAM=1001
- ENDIF
- ENDIF
- CALL IGPAVE(XPOS(1),XPOS(2),YPOS(1),YPOS(2)
- +, DZ,0,ISFRAM,CHOPT)
- IF(NBCHOI.GT.0)THEN
- CALL ISFACI(0)
- CALL IGSET('BORD',1.)
- CALL IGBOX(XPOS(1)+DEC,XPOS(2)-DEC,Y4,Y3)
- ENDIF
- X(1)=XPOS(1)+RINT
- X(2)=X(1)
- Y(1)=Y3
- Y(2)=YPOS(2)
- CALL IPL(2,X,Y)
- X(1)=XPOS(2)-RINT
- X(2)=X(1)
- CALL IPL(2,X,Y)
- Y(1)=Y4
- Y(2)=Y4
- CALL IPL(2,XPOS,Y)
-*
-* Draw the Title bar
-*
- 10 IF(IOPT(13).EQ.0)THEN
- CALL ISCHH(TH)
- CALL IGSET('TANG',0.)
- CALL ISTXAL(2,0)
- CALL ITX(XM,YT,TITLE)
- CALL ISFACI(0)
- X(1)=XPOS(1)+DEC
- X(2)=XPOS(1)+RINT-DEC
- Y(1)=Y3+DEC
- Y(2)=YPOS(2)-DEC
- CALL IGBOX(X(1),X(2),Y(1),Y(2))
- X(1)=XPOS(2)-RINT+DEC
- X(2)=XPOS(2)-DEC
- CALL IGBOX(X(1),X(2),Y(1),Y(2))
- ENDIF
-*
-* Draw the middle bar in case of panel menu type
-*
- IF(IOPT(5).NE.0)THEN
- X(1)=XM
- X(2)=XM
- Y(1)=Y3
- Y(2)=Y4
- CALL IPL(2,X,Y)
- X(1)=XPOS(2)-RINT
- X(2)=X(1)
- CALL IPL(2,X,Y)
- ENDIF
-*
-* Draw the Options
-*
- CALL ISCHH(OTH)
- YOPT=0.
- XOPT=XPOS(1)+RINT
- DO 20 I=1,NBCHOI
- Y(1)=Y3-YSIZ*(I-1)
- Y(2)=Y(1)
- IF(I.NE.1)THEN
- X(1)=XPOS(1)+DEC
- X(2)=XPOS(2)-DEC
- CALL IPL(2,X,Y)
- ELSE
- X(1)=XPOS(1)
- X(2)=XPOS(2)
- CALL IPL(2,X,Y)
- ENDIF
- YOPT=YOPT+YSTEP
- CALL ISTXAL(0,0)
- IF(CHITEM(I)(1:1).EQ.'|')THEN
- CALL ISFAIS(1)
- CALL ISFACI(1)
- CALL IGBOX(XPOS(1),XPOS(1)+DEC,Y(1)-YSIZ,Y(1))
- CALL ITX(XOPT,Y3-YOPT,CHITEM(I)(2:))
- ELSEIF(CHITEM(I)(1:1).EQ.'-')THEN
- CALL ISFAIS(3)
-#if (defined(CERNLIB_GL)||defined(CERNLIB_X11))&&(!defined(CERNLIB_MSDOS))
- CALL ISFASI(2)
-#endif
-#if (defined(CERNLIB_GKSGRAL)||defined(CERNLIB_MSDOS))
- CALL ISFASI(-104)
-#endif
-#if (!defined(CERNLIB_GKSGRAL))&&(!defined(CERNLIB_GL))&&(!defined(CERNLIB_X11))
- CALL ISFASI(1)
-#endif
- CALL ISFACI(1)
- CALL IGBOX(XPOS(1)+DEC,XPOS(2)-DEC,Y(1)-YSIZ,Y(1))
- CALL ITX(XOPT,Y3-YOPT,CHITEM(I)(2:))
- ELSE
- CALL ITX(XOPT,Y3-YOPT,CHITEM(I))
- ENDIF
- CALL ISTXAL(2,0)
- IF(IOPT(5).NE.0)THEN
- CALL ISTXAL(0,0)
- CALL ITX(XM+RINT,Y3-YOPT,CHVAL(I))
- IF(INDEX(CHDEF(I),',').NE.0)THEN
- CALL ISFAIS(1)
- CALL ISFACI(1)
- CALL IGBOX(XPOS(2)-RINT+0.3*DEC,XPOS(2)-1.3*DEC ,
- + Y(1)-YSIZ+0.3*DEC,Y(1)-0.3*DEC)
- ENDIF
- CALL ISTXAL(2,0)
- ENDIF
- YOPT=YOPT+YSIZ-YSTEP
- 20 CONTINUE
-*
-* Draw the user keys
-*
- IF(NBUSER.NE.0)THEN
- CHOPT=' '
- DZ=0.
- ISFRAM=0
- IF(IOPT(19).NE.0)THEN
- DZ=5.*DEC
- CHOPT='TRK'
-#if (defined(CERNLIB_GL)||defined(CERNLIB_X11))&&(!defined(CERNLIB_MSDOS))
- ISFRAM=2
-#endif
-#if (defined(CERNLIB_GKSGRAL)||defined(CERNLIB_MSDOS))
- ISFRAM=-104
-#endif
-#if (!defined(CERNLIB_GKSGRAL))&&(!defined(CERNLIB_GL))&&(!defined(CERNLIB_X11))
- ISFRAM=1
-#endif
- ENDIF
- Y(1)=YPOS(1)
- Y(2)=Y4
- X(1)=XPOS(1)
- X(2)=XPOS(1)+USIZ
- DO 30 I=1,NBUSER
- CALL IGPAVE(X(1),X(2),Y(1),Y(2)
- +, DZ,1000,ISFRAM,CHOPT)
- X(1)=X(1)+USIZ+IOPT(19)*DZ*2
- X(2)=X(1)+USIZ
- 30 CONTINUE
- YU=YPOS(1)+RINT/2.-(UTH/2.)
- XU=XPOS(1)+USIZ/2.
- CALL ISCHH(UTH)
- CALL ISTXAL(2,0)
- DO 40 I=1,NBUSER
- CALL ITX(XU,YU,CHUSER(I))
- XU=XU+USIZ+IOPT(19)*DZ*2
- 40 CONTINUE
- ENDIF
-*
-#if (defined(CERNLIB_GKS))&&(!defined(CERNLIB_MGKS))
- IF(GFLAG)THEN
- IF(MENNUM.NE.0)THEN
- CALL GCLSG
- ENDIF
- ENDIF
-#endif
-#if defined(CERNLIB_DI3000)
- IF (GFLAG) THEN
- IF(MENNUM.NE.0)THEN
- CALL JRCLOS
- ENDIF
- ENDIF
-#endif
-*
- ICUCH=0
-*
- END
diff --git a/src/graflib/higz/menu/iggch.F b/src/graflib/higz/menu/iggch.F
deleted file mode 100644
index 2adf649..0000000
--- a/src/graflib/higz/menu/iggch.F
+++ /dev/null
@@ -1,68 +0,0 @@
-*
-* $Id: iggch.F,v 1.1.1.1 1996/02/14 13:11:15 mclareni Exp $
-*
-* $Log: iggch.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:15 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.07/01 20/07/89 11.49.13 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE IGGCH(XPI,YPI,ICH,IOPT)
-*.===========>
-*.
-*. This routine gets the choice number.
-*.
-*. ICH=0 : out of the menu
-*. ICH=-100 : title bar
-*. ICH=-101 : left square
-*. ICH=-102 : right square
-*. ICH=-1... -NBUSER : user keys
-*. ICH= integer > 0 : option number
-*.
-*..==========> (O.Couet)
-#include "higz/himenu.inc"
- DIMENSION IOPT(*)
-*.______________________________________
-*
- IF((XPI.GT.XPOS(2)).OR.(XPI.LT.XPOS(1))
- + .OR.
- + (YPI.GT.YPOS(2)).OR.(YPI.LT.YPOS(1)))THEN
- ICH=0
- RETURN
- ENDIF
-*
- IF(YPI.GT.Y3)THEN
- IF(XPI.LT.XPOS(1)+RINT)THEN
- ICH=-101
- RETURN
- ENDIF
- IF(XPI.GT.XPOS(2)-RINT)THEN
- ICH=-102
- RETURN
- ENDIF
- ICH=-100
- RETURN
- ENDIF
-*
- IF(YPI.LT.Y4)THEN
- IF(IOPT(19).NE.0)THEN
- TUSIZ=USIZ+10.*DEC
- ITCH=INT((XPI-XPOS(1))/TUSIZ)+1
- ULEN=ITCH*USIZ+(ITCH-1)*10.*DEC
- IF(XPI.GT.ULEN+XPOS(1))THEN
- ICH=0
- ELSE
- ICH=-ITCH
- ENDIF
- ELSE
- ICH=-(INT((XPI-XPOS(1))/USIZ)+1)
- ENDIF
- RETURN
- ENDIF
-*
- ICH=NBCHOI-INT((YPI-Y4)/YSIZ)
-*
- END
-
diff --git a/src/graflib/higz/menu/iggdef.F b/src/graflib/higz/menu/iggdef.F
deleted file mode 100644
index 88c3548..0000000
--- a/src/graflib/higz/menu/iggdef.F
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: iggdef.F,v 1.1.1.1 1996/02/14 13:11:15 mclareni Exp $
-*
-* $Log: iggdef.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:15 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.10/03 03/07/90 11.56.57 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE IGGDEF(CCHIN,NB,CHOUT)
-*.===========>
-*.
-*. This routine returns the option number NB of CHIN in CHOUT.
-*.
-*..==========> (O.Couet)
- CHARACTER*(*) CCHIN,CHOUT
- CHARACTER*255 CHIN
-*.______________________________________
-*
- CHIN=CCHIN
- IF(INDEX(CHIN,',').EQ.0)THEN
- ILEN=LENOCC(CHIN)
- CHOUT=CHIN(1:ILEN)
- ELSE
- ILEN=INDEX(CHIN,',')
- CHOUT=CHIN(1:ILEN-1)
- IF(NB.GT.1)THEN
- DO 10 I=1,NB-1
- ILEN=INDEX(CHIN,',')
- IF(ILEN.EQ.0)RETURN
- CHIN(1:ILEN)=' '
- 10 CONTINUE
- ILAST=LENOCC(CHIN)
- IF(INDEX(CHIN,',').NE.0)ILAST=INDEX(CHIN,',')-1
- CHOUT=CHIN(ILEN+1:ILAST)
- ENDIF
- ENDIF
-*
- END
diff --git a/src/graflib/higz/menu/ighigh.F b/src/graflib/higz/menu/ighigh.F
deleted file mode 100644
index 1be4335..0000000
--- a/src/graflib/higz/menu/ighigh.F
+++ /dev/null
@@ -1,133 +0,0 @@
-*
-* $Id: ighigh.F,v 1.2 1998/01/30 15:22:48 couet Exp $
-*
-* $Log: ighigh.F,v $
-* Revision 1.2 1998/01/30 15:22:48 couet
-* - APOLLO version removed
-*
-* Revision 1.1.1.1 1996/02/14 13:11:15 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.13/06 17/10/91 16.19.14 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE IGHIGH(ICHOIC,CHITEM,CHUSER,IOPT)
-*.===========>
-*.
-*. This routine highlith the choice
-*.
-*..==========> (O.Couet)
-#include "higz/himenu.inc"
-#include "higz/hiflag.inc"
- DIMENSION X(2),Y(2)
- DIMENSION IOPT(*)
- CHARACTER*(*) CHITEM(*)
- CHARACTER*(*) CHUSER(*)
- LOGICAL ZFS,GFS
-*.______________________________________
-*
- ZFS=ZFLAG
- GFS=GFLAG
- ZFLAG=.FALSE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- GFLAG=.TRUE.
-*
- IF(ICHOIC.LE.-100.OR.ICHOIC.GT.NBCHOI)GOTO 10
- CALL ISTXAL(0,0)
- CALL IGSET('TANG',0.)
- IF(ISOFT.NE.0)THEN
- CALL ISTXFP(0,2)
- ELSE
-#if defined(CERNLIB_X11)
- CALL ISTXFP(-8,0)
-#endif
-#if !defined(CERNLIB_X11)
- CALL ISTXFP(1,0)
-#endif
- ENDIF
- CALL ISCHH(OTH)
- XOPT=XPOS(1)+RINT
-*
-* Highlith user key
-*
- IF(ICHOIC.LT.0)THEN
- CALL ISFAIS(1)
- CALL ISFACI(1)
- CALL ISPLCI(1)
- CALL ISTXCI(0)
- Y(1)=YPOS(1)
- Y(2)=Y4
- X(1)=XPOS(1)-(ICHOIC+1)*USIZ-IOPT(19)*(ICHOIC+1)*10.*DEC
- X(2)=X(1)+USIZ
- CALL IGBOX(X(1),X(2),Y(1),Y(2))
- YU=YPOS(1)+RINT/2.-(UTH/2.)
- XU=X(1)+(USIZ/2.)
- CALL ISCHH(UTH)
- CALL ISTXAL(2,0)
- CALL ITX(XU,YU,CHUSER(-ICHOIC))
- GOTO 10
- ENDIF
-*
-* Invert the last highlithed choice ICUCH
-*
- IF(ICUCH.GE.0)THEN
- IF(ICUCH.EQ.0)ICUCH=ICHOIC
- CALL ISFAIS(1)
- CALL ISFACI(0)
- CALL ISPLCI(1)
- CALL ISTXCI(1)
- CALL IGSET('BORD',1.)
- X(1)=XPOS(1)+DEC
- X(2)=XPOS(1)+XSIZ-DEC
- Y(1)=Y3-ICUCH*YSIZ
- Y(2)=Y3-(ICUCH-1)*YSIZ
- CALL IGBOX(X(1),X(2),Y(1),Y(2))
- IF(CHITEM(ICUCH)(1:1).EQ.'-')THEN
- CALL ISFACI(1)
- CALL ISFAIS(3)
-#if defined(CERNLIB_GL)||defined(CERNLIB_X11)
- CALL ISFASI(2)
-#endif
-#if (defined(CERNLIB_GKSGRAL))
- CALL ISFASI(-104)
-#endif
-#if (!defined(CERNLIB_GKSGRAL))&&(!defined(CERNLIB_GL))&&(!defined(CERNLIB_X11))
- CALL ISFASI(1)
-#endif
- CALL IGBOX(X(1),X(2),Y(1),Y(2))
- ENDIF
- IF(CHITEM(ICUCH)(1:1).EQ.'|')THEN
- CALL ITX(XOPT,Y3-YSIZ*(ICUCH-1)-YSTEP,CHITEM(ICUCH)(2:))
- ELSEIF(CHITEM(ICUCH)(1:1).EQ.'-')THEN
- CALL ITX(XOPT,Y3-YSIZ*(ICUCH-1)-YSTEP,CHITEM(ICUCH)(2:))
- ELSE
- CALL ITX(XOPT,Y3-YSIZ*(ICUCH-1)-YSTEP,CHITEM(ICUCH))
- ENDIF
- ENDIF
-*
-* Highlith the choice ICHOIC
-*
- CALL ISFAIS(1)
- CALL ISFACI(1)
- CALL ISPLCI(1)
- CALL ISTXCI(0)
- X(1)=XPOS(1)+DEC
- X(2)=XPOS(1)+XSIZ-DEC
- Y(1)=Y3-ICHOIC*YSIZ
- Y(2)=Y3-(ICHOIC-1)*YSIZ
- CALL IGBOX(X(1),X(2),Y(1),Y(2))
- IF(CHITEM(ICHOIC)(1:1).EQ.'|')THEN
- CALL ITX(XOPT,Y3-YSIZ*(ICHOIC-1)-YSTEP,CHITEM(ICHOIC)(2:))
- ELSEIF(CHITEM(ICHOIC)(1:1).EQ.'-')THEN
- CALL ITX(XOPT,Y3-YSIZ*(ICHOIC-1)-YSTEP,CHITEM(ICHOIC)(2:))
- ELSE
- CALL ITX(XOPT,Y3-YSIZ*(ICHOIC-1)-YSTEP,CHITEM(ICHOIC))
- ENDIF
- ICUCH=ICHOIC
-*
- 10 ZFLAG=ZFS
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- GFLAG=GFS
- END
-
diff --git a/src/graflib/higz/menu/igmenu.F b/src/graflib/higz/menu/igmenu.F
deleted file mode 100644
index 1ef7d7f..0000000
--- a/src/graflib/higz/menu/igmenu.F
+++ /dev/null
@@ -1,516 +0,0 @@
-*
-* $Id: igmenu.F,v 1.1.1.1 1996/02/14 13:11:15 mclareni Exp $
-*
-* $Log: igmenu.F,v $
-* Revision 1.1.1.1 1996/02/14 13:11:15 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.20/02 03/11/93 11.47.50 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE IGMENU(MN,TITLE,X1,X2,Y1,Y2,NBU,CHUSER
- +, N,CHITEM,CHDEF,CHVAL,ICHOIC,CHOPT)
-*.===========>
-*.
-*. This routine displays a menu and returns the users choice in ICHOIC
-*.
-*. _Input parameters:
-*.
-*. INTEGER MN : Menu number. To use bitmap capabilities.
-*. CHARACTER TITLE : Menu title.
-*. REAL X1,Y1 : Down left corner menu coordinates.
-*. REAL X2,Y2 : Up right coner menu coordinates.
-*. INTEGER NBU : User squares number.
-*. CHARACTER CHUSER(NBU) : Text in the users squares.
-*. INTEGER N : Number of items.
-*. CHARACTER CHITEM(N) : Text of the item.
-*. CHARACTER CHDEF(N) : Text of parameters.
-*. INTEGER ICHOIC : Input parameter if CHOPT='U' or CHOPT='H'.
-*. CHARACTER CHOPT : Options.
-*.
-*. CHOPT='H' : The picked choice is Highlighted the last current
-*. choice is given in ICHOIC.
-*. CHOPT='D' : Display the menu.
-*. CHOPT='C' : Permit a choice in the displayed menu.
-*. CHOPT='E' : Erase the menu.
-*. CHOPT='P' : The menu is a menu with parameters.
-*. CHOPT='R' : Return the current position of the menu.
-*. CHOPT='S' : Software character are used.
-*. CHOPT='U' : Update the user text user squares. The user square
-*. number is given in ICHOIC. N.B. that options 'U'
-*. and 'H' are incompatible because they used both
-*. ICHOIC as input parameter.
-*. CHOPT='N' : The last input position is used to compute the value
-*. of ICHOIC.
-*. CHOPT='M' : GKS Metafiles are activated.
-*. CHOPT='Z' : HIGZ metafiles are activated.
-*. CHOPT='B' : A rubberbanding boxe is used for the locator.
-*. CHOPT='T' : The title bar is not drawn, then the menu can not
-*. be moved interactively.
-*. CHOPT='W' : The menu is drawn with Width.
-*. CHOPT='A' : The menu is drawn with shAdow.
-*. CHOPT='V' : Draw only the vertical part of Width.
-*. CHOPT='O' : 'V' Without "Oreilles".
-*. CHOPT='I' : Input menu. A parameter menu is displayed and IGMENU
-*. Enter directly in request string. This is usefull to
-*. do a request string without having a very complicated
-*. initialization part.
-*. CHOPT='K' : Key menu. The user keys are drawn as a keyboard
-*.
-*. _Output parameters:
-*.
-*. CHARACTER CHVAL(N) : Array of parameters choiced.
-*. INTEGER ICHOIC : Choice number.
-*.
-*. _Specials characters in first position of CHITEM(i):
-*.
-*. '|' The left of CHITEM(i) is colored in black
-*. '-' The box of CHITEM(i) is colored in gray
-*.
-*..==========> (O.Couet)
-#include "higz/hiques.inc"
-#include "higz/hiatt.inc"
-#include "higz/hiflag.inc"
-#include "higz/himenu.inc"
-#include "higz/himeta.inc"
-#if defined(CERNLIB_MAIL)
-#include "higz/himail.inc"
-#endif
- DIMENSION IOPT(19),IPLACE(50)
- SAVE IOPT
- DIMENSION X(2),Y(2)
- CHARACTER*(*) CHOPT,CHITEM(*),TITLE,CHDEF(*),CHVAL(*),CHUSER(*)
- CHARACTER*256 CHDEFT
- EQUIVALENCE (IOPT(1),IOPTH) ,(IOPT(2),IOPTD) ,(IOPT(3),IOPTC)
- EQUIVALENCE (IOPT(4),IOPTE) ,(IOPT(5),IOPTP) ,(IOPT(6),IOPTR)
- EQUIVALENCE (IOPT(7),IOPTS) ,(IOPT(8),IOPTU) ,(IOPT(9),IOPTN)
- EQUIVALENCE (IOPT(10),IOPTM),(IOPT(11),IOPTZ),(IOPT(12),IOPTB)
- EQUIVALENCE (IOPT(13),IOPTT),(IOPT(14),IOPTW),(IOPT(15),IOPTV)
- EQUIVALENCE (IOPT(16),IOPTO),(IOPT(17),IOPTI),(IOPT(18),IOPTA)
- EQUIVALENCE (IOPT(19),IOPTK)
- LOGICAL ZFS,GFS,MFS
-*.______________________________________
-*
- CALL UOPTC (CHOPT,'HDCEPRSUNMZBTWVOIAK',IOPT)
-#if defined(CERNLIB_MAIL)
-*
-* MAIL option
-*
- IF(MFLAG)THEN
- WRITE (CHMAIL,'(4I3,I10)') 557,MN,NBU,N,ICHOIC
- CALL IMWRIT(1)
- WRITE (CHMAIL,'(4E16.7,A16)') X1,X2,Y1,Y2,CHOPT
- CALL IMWRIT(2)
- IF(IOPTT.EQ.0)THEN
- CHMAIL=' '
- CHMAIL=TITLE
- CALL IMWRIT(2)
- ENDIF
- DO 10 I=1,N
- CHMAIL=' '
- WRITE (CHMAIL,'(2A32)') CHITEM(I),CHDEF(I)
- CALL IMWRIT(2)
- 10 CONTINUE
- DO 20 I=1,NBU
- CHMAIL=' '
- CHMAIL=CHUSER(I)
- CALL IMWRIT(2)
- 20 CONTINUE
-*
- IF(IOPTC.NE.0)THEN
- READ (5,'(I5)') ICHOIC
- IF(IOPTP.NE.0.AND.N.GT.0)THEN
- CHMAIL='DUMMY'
- DO 30 I=1,N
- CALL IMWRIT(2)
- READ (5,'(A)') CHVAL(I)
- 30 CONTINUE
- ENDIF
- ENDIF
- IF(IOPTI.NE.0)THEN
- READ (5,'(A)') CHVAL(1)
- ENDIF
- CALL IMWRIT(5)
- RETURN
- ENDIF
-#endif
-*
-* Check the valididy of the menu
-*
- IF((NBU+N.EQ.0).AND.(IOPTT.EQ.1))THEN
- ICHOIC=0
- CALL IGERR('Empty menu','IGMENU')
- RETURN
- ENDIF
-*
-* Save the currents attributes and the current NT
-*
- CALL IZSAV
-*
- ZFS=ZFLAG
- GFS=GFLAG
- IF(IOPTZ.NE.0)THEN
- ZFLAG=.TRUE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- ELSE
- ZFLAG=.FALSE.
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- ENDIF
- GFLAG=.TRUE.
-*
- MFS=METACT
- IF(IOPTM.NE.0)THEN
- IF(.NOT.METACT)CALL IACWK(IDMETA)
- METACT=.TRUE.
- ELSE
- IF(METACT)CALL IDAWK(IDMETA)
- METACT=.FALSE.
- ENDIF
-*
- CALL ISTXCI(1)
- CALL ISPLCI(1)
- CALL ISFAIS(1)
- CALL ISLN(1)
- CALL ISLWSC(1.)
- IF(ISOFT.NE.0)THEN
- CALL ISTXFP(0,2)
- ELSE
-#if defined(CERNLIB_X11)
- CALL ISTXFP(-8,0)
-#endif
-#if !defined(CERNLIB_X11)
- CALL ISTXFP(1,0)
-#endif
- ENDIF
- CALL IGSET('TANG',0.)
-*
- REDLOC=REDIT
- CALL IGSRAP(0.)
- CALL ISELNT(0)
-*
-* Set the locator type
-*
- IF(IOPTB.NE.0)THEN
- ICURS=51
- ELSE
- ICURS=1
- ENDIF
-*
-* Initialize the menu position
-*
- MENNUM=MN
- NBCHOI=N
- NBUSER=NBU
- IF((ABS(X1-X2).LT.0.01).OR.(ABS(Y1-Y2).LT.0.01))THEN
- ICHOIC=0
- IF(IOPTC.NE.0)THEN
- REDIT=REDLOC
- CALL IGLOC(ICURS,NT,IBN,XP,YP,XWC,YWC)
- REDIT=0.
- ENDIF
- IF(IBN.EQ.0)ICHOIC=-1000
- RETURN
- ENDIF
- XPOS(1)=X1
- XPOS(2)=X2
- YPOS(1)=Y1
- YPOS(2)=Y2
- RATIO=RMDSY/RMDSX
- IF(RMDSX.GT.RMDSY)THEN
- YPOS(1)=Y1*RATIO
- YPOS(2)=Y2*RATIO
- ELSE
- XPOS(1)=X1/RATIO
- XPOS(2)=X2/RATIO
- ENDIF
- IF(XPOS(2).LT.XPOS(1))THEN
- R=XPOS(2)
- XPOS(2)=XPOS(1)
- XPOS(1)=R
- ENDIF
- IF(YPOS(2).LT.YPOS(1))THEN
- R=YPOS(2)
- YPOS(2)=YPOS(1)
- YPOS(1)=R
- ENDIF
-*
-* Set the menu parameters in case of choice
-*
- IF((IOPTN.NE.0).OR.(IOPTC.NE.0))THEN
- CALL IGSMP(IOPT)
- ENDIF
-*
-* Input menu
-*
- IF(IOPTI.NE.0)THEN
- IOPT(13)=1
- IOPT(5)=1
- IOPT(19)=0
- NBUSER=0
- CHVAL(1)=' '
- CALL IGDIME(TITLE,CHUSER,CHITEM,CHDEF,CHVAL,IOPT)
- CALL ISTXAL(0,0)
- RQUEST(81)=((XM+RINT)*RMDSX)/RDWXMA
- RQUEST(82)=((XPOS(2)-RINT)*RMDSX)/RDWXMA
- RQUEST(91)=((Y3-YSTEP)*RMDSY)/RDWYMA
- RQUEST(92)=((Y3-YSTEP+OTH)*RMDSY)/RDWYMA
- CHDEFT=CHVAL(1)
- IWTMP=-IDID
- CALL IRQST(IWTMP,1,ISTA,ILEN,CHDEFT)
- IF(ISTA.NE.0)THEN
- IILEN=LENOCC(CHDEFT)
- CHVAL(1)=CHDEFT(1:IILEN)
- ENDIF
- ENDIF
-*
-* Update the user keys
-*
- IF((IOPTU.NE.0).AND.(ICHOIC.GT.0))THEN
- CALL IGSMP(IOPT)
- CALL ISFAIS(1)
- CALL ISFACI(0)
- CALL ISPLCI(1)
- CALL ISTXCI(1)
- CALL ISCHH(UTH)
- CALL ISTXAL(2,0)
- CALL IGSET('BORD',1.)
- Y(1)=YPOS(1)
- Y(2)=Y4
- X(1)=XPOS(1)+(ICHOIC-1)*USIZ+IOPT(19)*(ICHOIC-1)*10.*DEC
- X(2)=X(1)+USIZ
- CALL IGBOX(X(1),X(2),Y(1),Y(2))
- YU=YPOS(1)+RINT/2-UTH/2
- XU=X(1)+(USIZ/2.)
- CALL ITX(XU,YU,CHUSER(ICHOIC))
- ENDIF
-*
-* Set the current highlihted choice
-*
- IF(IOPTH.NE.0)THEN
- IF(ICHOIC.LT.0.OR.ICHOIC.GT.N)THEN
- ICUCH=0
- ELSE
- ICUCH=ICHOIC
- ENDIF
- ENDIF
-*
-* Display the menu
-*
- IF(IOPTD.NE.0)THEN
- IF(NBUSER.GE.100)NBUSER=99
- ISOFT=0
- IF(IOPTS.NE.0)ISOFT=1
- IF(IOPTP.NE.0)THEN
- DO 40 I=1,NBCHOI
- ILEN=INDEX(CHDEF(I),',')-1
- IF(ILEN.LT.0)ILEN=LENOCC(CHDEF(I))
- CHVAL(I)=CHDEF(I)(1:ILEN)
- 40 CONTINUE
- ENDIF
- ICUCH=0
- CALL IGDIME(TITLE,CHUSER,CHITEM,CHDEF,CHVAL,IOPT)
- ENDIF
-*
-* Request the choice
-*
- IF(IOPTC.NE.0)THEN
- DO 50 I=1,50
- IPLACE(I)=1
- 50 CONTINUE
- IF(IOPTP.NE.0)THEN
- DO 60 I=1,NBCHOI
- ILEN=INDEX(CHDEF(I),',')-1
- IF(ILEN.LT.0)ILEN=LENOCC(CHDEF(I))
- CHVAL(I)=CHDEF(I)(1:ILEN)
- 60 CONTINUE
- IF(IOPTN.NE.0)GOTO 80
- 70 REDIT=REDLOC
- CALL IGLOC(ICURS,NT,IBN,XP,YP,XWC,YWC)
- REDIT=0.
- IQUEST(10)=NT
- RQUEST(11)=XP
- RQUEST(12)=YP
- RQUEST(13)=XWC
- RQUEST(14)=YWC
- IF(IBN.EQ.0)THEN
- ICHOIC=-1000
- GOTO 120
- ENDIF
- 80 CALL IGGCH(XP,YP,ICHOIC,IOPT)
- IF(ICHOIC.EQ.-101)THEN
- CALL IGCMP(TITLE,CHUSER,CHITEM,CHDEF,CHVAL,IOPT,0)
- GOTO 70
- ELSEIF(ICHOIC.EQ.-102)THEN
- CALL IGCMP(TITLE,CHUSER,CHITEM,CHDEF,CHVAL,IOPT,1)
- GOTO 70
- ELSEIF(ICHOIC.GT.0)THEN
- ICUCH=ICHOIC
- IF(XP.LE.XM)THEN
- CALL IGGDEF(CHDEF(ICUCH),1,CHVAL(ICUCH))
- CALL ISFAIS(1)
- CALL ISFACI(0)
- CALL ISPLCI(1)
- CALL ISTXCI(1)
- CALL ISCHH(OTH)
- CALL IGSET('BORD',1.)
- X(1)=XM
- X(2)=XM+XSIZ-RINT
- Y(1)=Y3-ICUCH*YSIZ
- Y(2)=Y3-(ICUCH-1)*YSIZ
- CALL IGBOX(X(1),X(2),Y(1),Y(2))
- CALL ISTXAL(0,0)
- CALL ITX(XM+RINT,Y3-YSIZ*(ICUCH-1)-YSTEP
- +, CHVAL(ICUCH))
- CALL ISTXAL(2,0)
- LINENO=ICUCH
- IF(LINENO.GT.50)LINENO=50
- IPLACE(LINENO)=1
- GOTO 70
- ELSEIF((XP.GE.(XPOS(2)-RINT)).AND.
- + (INDEX(CHDEF(ICUCH),',').NE.0))THEN
- CHDEFT=CHDEF(ICUCH)
- IMOD=1
- ILEN=LENOCC(CHDEFT)
- IF(CHDEFT(ILEN:ILEN).EQ.',')CHDEFT(ILEN:ILEN)=' '
- 90 ILEN=INDEX(CHDEFT,',')
- IF(ILEN.NE.0)THEN
- CHDEFT=CHDEFT(ILEN+1:LENOCC(CHDEFT))
- IMOD=IMOD+1
- GOTO 90
- ENDIF
- LINENO=ICUCH
- IF(LINENO.GT.50)LINENO=50
- IPLACE(LINENO)=IPLACE(LINENO)+1
- IF(IPLACE(LINENO).GT.IMOD)IPLACE(LINENO)=1
- CALL IGGDEF(CHDEF(ICUCH),IPLACE(LINENO)
- +, CHVAL(ICUCH))
- CALL ISFAIS(1)
- CALL ISFACI(0)
- CALL ISPLCI(1)
- CALL ISTXCI(1)
- CALL ISCHH(OTH)
- CALL IGSET('BORD',1.)
- X(1)=XM
- X(2)=XM+XSIZ-RINT
- Y(1)=Y3-ICUCH*YSIZ
- Y(2)=Y3-(ICUCH-1)*YSIZ
- CALL IGBOX(X(1),X(2),Y(1),Y(2))
- CALL ISTXAL(0,0)
- CALL ITX(XM+RINT,Y3-YSIZ*(ICUCH-1)-YSTEP
- +, CHVAL(ICUCH))
- CALL ISTXAL(2,0)
- GOTO 70
- ELSEIF((XP.GT.XM).AND.(XP.LT.(XPOS(2)-RINT)))THEN
- CALL ISFAIS(1)
- CALL ISFACI(0)
- CALL ISPLCI(1)
- CALL ISTXCI(1)
- CALL IGSET('BORD',1.)
- CALL ISCHH(OTH)
- X(1)=XM
- X(2)=XM+XSIZ-RINT
- Y(1)=Y3-ICUCH*YSIZ
- Y(2)=Y3-(ICUCH-1)*YSIZ
- CALL IGBOX(X(1),X(2),Y(1),Y(2))
- CALL ISTXAL(0,0)
- RQUEST(81)=((XM+RINT)*RMDSX)/RDWXMA
- RQUEST(82)=((XPOS(2)-RINT)*RMDSX)/RDWXMA
- RQUEST(91)=((Y3-YSIZ*(ICUCH-1)-YSTEP)*RMDSY)/RDWYMA
- RQUEST(92)=((Y3-YSIZ*(ICUCH-1)-YSTEP+OTH)*RMDSY)/
- + RDWYMA
- CHDEFT=CHVAL(ICUCH)
- IWTMP=-IDID
- CALL IRQST(IWTMP,1,ISTA,ILEN,CHDEFT)
- IF(ISTA.NE.0)THEN
- CHVAL(ICUCH)=' '
- IILEN=LENOCC(CHDEFT)
- CHVAL(ICUCH)=CHDEFT(1:IILEN)
- ENDIF
- CALL IGBOX(X(1),X(2),Y(1),Y(2))
- CALL ITX(XM+RINT,Y3-YSIZ*(ICUCH-1)-YSTEP
- +, CHVAL(ICUCH))
- CALL ISTXAL(2,0)
- GOTO 70
- ENDIF
- GOTO 70
- ENDIF
- ELSE
- IF(IOPTN.NE.0)GOTO 110
- 100 REDIT=REDLOC
- CALL IGLOC(ICURS,NT,IBN,XP,YP,XWC,YWC)
- REDIT=0.
- IQUEST(10)=NT
- RQUEST(11)=XP
- RQUEST(12)=YP
- RQUEST(13)=XWC
- RQUEST(14)=YWC
- IF(IBN.EQ.0)THEN
- ICHOIC=-1000
- GOTO 120
- ENDIF
- 110 CALL IGGCH(XP,YP,ICHOIC,IOPT)
- IF(ICHOIC.EQ.-101)THEN
- CALL IGCMP(TITLE,CHUSER,CHITEM,CHDEF,CHVAL,IOPT,0)
- GOTO 100
- ELSEIF(ICHOIC.EQ.-102)THEN
- CALL IGCMP(TITLE,CHUSER,CHITEM,CHDEF,CHVAL,IOPT,1)
- GOTO 100
- ELSEIF(ICHOIC.LT.0.AND.ICHOIC.GT.-100)THEN
- IF(IOPTH.NE.0.AND.IOPTP.EQ.0)CALL IGHIGH(ICHOIC,CHITEM
- +, CHUSER,IOPT)
- ELSEIF(ICHOIC.GT.0)THEN
- IF(IOPTH.NE.0.AND.IOPTP.EQ.0)CALL IGHIGH(ICHOIC,CHITEM
- +, CHUSER,IOPT)
- ICUCH=ICHOIC
- ENDIF
- ENDIF
- ENDIF
-*
-* Erase the menu
-*
- IF(IOPTE.NE.0)THEN
- CALL IGDELM(IOPT)
- ENDIF
-*
-* Return the menu position
-*
- 120 IF(IOPTR.NE.0)THEN
- X1=XPOS(1)
- X2=XPOS(2)
- Y1=YPOS(1)
- Y2=YPOS(2)
- IF(RMDSX.GT.RMDSY)THEN
- Y1=Y1/RATIO
- Y2=Y2/RATIO
- ELSE
- X1=X1*RATIO
- X2=X2*RATIO
- ENDIF
- ENDIF
-*
-* Reset the initial environment
-*
- CALL IZSET
-*
- CALL IGTERM
- CALL IGSRAP(REDLOC)
- ZFLAG=ZFS
- GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
- GFLAG=GFS
- IF(MFS)THEN
- IF(METACT)THEN
- RETURN
- ELSE
- CALL IACWK(IDMETA)
- ENDIF
- ELSE
- IF(METACT)THEN
- CALL IDAWK(IDMETA)
- ELSE
- RETURN
- ENDIF
- ENDIF
- METACT=MFS
-*
- END
diff --git a/src/graflib/higz/menu/igsmp.F b/src/graflib/higz/menu/igsmp.F
deleted file mode 100644
index 5bc6df4..0000000
--- a/src/graflib/higz/menu/igsmp.F
+++ /dev/null
@@ -1,68 +0,0 @@
-*
-* $Id: igsmp.F,v 1.2 1998/01/30 15:22:49 couet Exp $
-*
-* $Log: igsmp.F,v $
-* Revision 1.2 1998/01/30 15:22:49 couet
-* - APOLLO version removed
-*
-* Revision 1.1.1.1 1996/02/14 13:11:15 mclareni
-* Higz
-*
-*
-#include "higz/pilot.h"
-*CMZ : 1.07/01 19/07/89 19.00.04 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE IGSMP(IOPT)
-*.===========>
-*.
-*. This routine sets the menu parameters
-*.
-*..==========> (O.Couet)
-#include "higz/himenu.inc"
-#include "higz/hiatt.inc"
- DIMENSION IOPT(*)
-*.______________________________________
-*
- IF(XPOS(1).GT.RDWXMA)XPOS(1)=RDWXMA
- IF(XPOS(2).GT.RDWXMA)XPOS(2)=RDWXMA
- IF(XPOS(1).LT.0)XPOS(1)=0.
- IF(XPOS(2).LT.0)XPOS(2)=0.
- IF(YPOS(1).GT.RDWYMA)YPOS(1)=RDWYMA
- IF(YPOS(2).GT.RDWYMA)YPOS(2)=RDWYMA
- IF(YPOS(1).LT.0)YPOS(1)=0.
- IF(YPOS(2).LT.0)YPOS(2)=0.
-*
- XSIZ=XPOS(2)-XPOS(1)
- NDIV=NBCHOI
- IF(IOPT(13).EQ.0)NDIV=NDIV+1
- IF(NBUSER.NE.0)NDIV=NDIV+1
- RINT=(YPOS(2)-YPOS(1))/FLOAT(NDIV)
- DEC=RINT/6.
-*
- IF(IOPT(13).NE.0)THEN
- Y3=YPOS(2)
- ELSE
- Y3=YPOS(2)-RINT
- ENDIF
-*
- IF(NBUSER.NE.0)THEN
- Y4=YPOS(1)+RINT
- USIZ=(XSIZ-IOPT(19)*(NBUSER-1)*10.*DEC)/NBUSER
- ELSE
- Y4=YPOS(1)
- USIZ=0.
- ENDIF
-*
- YSIZ=RINT
- XM=XPOS(1)+(XSIZ/2.)
- IF(IOPT(5).NE.0)XSIZ=XSIZ/2.
-*
- UTH=0.66*RINT
- TH=UTH
- OTH=UTH
-*
- YT=YPOS(2)-(YSIZ/2.)-(TH/2.)
- YSTEP=(YSIZ/2.)+(OTH/2.)
-*
- END
-
diff --git a/src/graflib/hplot/Imakefile b/src/graflib/hplot/Imakefile
deleted file mode 100644
index e18b1f1..0000000
--- a/src/graflib/hplot/Imakefile
+++ /dev/null
@@ -1,15 +0,0 @@
-
-#define IHaveSubdirs
-#define PassCDebugFlags
-
-
-LIBDIRS= hplotcc hplotf77
-SUBDIRS= $(LIBDIRS) hplot
-
-MakeSubdirs($(SUBDIRS))
-
-TopOfPackage(hplot)
-
-SubdirLibraryTarget(hplot,$(LIBDIRS))
-
-InstallIncludeSubdirs(hplot)
diff --git a/src/graflib/hplot/doc/Versions/v5_04 b/src/graflib/hplot/doc/Versions/v5_04
deleted file mode 100644
index f7c1b0e..0000000
--- a/src/graflib/hplot/doc/Versions/v5_04
+++ /dev/null
@@ -1,337 +0,0 @@
-*
-* $Id: v5_04,v 1.1.1.1 1996/01/19 10:50:14 mclareni Exp $
-*
-* $Log: v5_04,v $
-* Revision 1.1.1.1 1996/01/19 10:50:14 mclareni
-* Hplot
-*
-*
-*CMZ : 27/08/91 18.30.03 by Unknown
-*-- Author :
-*
-*::> VERSION 5.04/14 890510 16.26
-*
-*
-* Minors changes in HPLSYM
-* New HPLCON compatible with option SAME
-* Changes in HPLOPT to inquire the OPT value
-* Options DATE and TIME inplemented in HPLSUR HPLCON and HPLEGO
-* Option FIT and SET FIT introduced (changes in HPLOPT, HPLSET
-* and SEQ HPL1 where 2 variables IFIT and LOFIT have been added)
-* New routine HPLFIT (Now dummy)
-* Minor bug corrected in HPLS (in case of scatter plot)
-* New version of the routine HPLSTA usable in case of histogram
-* udating and zone
-* CFON introduced, implies mods in:
-* HPLSET, HPLOPT, HPLCOM, HPLDAT, HPLFIL, HPLKEY and HPLSTA
-* Bug corrected in the routine HPLOT in case of ID=0 and option STAT
-*
-*::> VERSION 5.04/13 890222 15.48
-*
-*
-* In case of OPT DATE and SAME th date is drawn 1 time only
-* The seconds are not drawn in OPT DATE
-* The STAT box in drawn in Fill area hollow (cf Falco)
-* The Statistics (in case of option U) are erased with IBCOL
-* The Statistics boxes are drawn according with the number of zones
-*
-*::> VERSION 5.04/12 890124 16.06
-*
-* New version of HPLSUR (HPLSU2 is modified)
-* New routine HPLTOC.
-* New option 'A' in HPLOT to suppress axis drawing
-* Bug corrected in HPLEND
-* BWID, FWID, PWID, HWID, FTYP, FCOL and GRID introduced in HPLSET.
-* MZNEED is called in HPLH.
-* Mods in HPLNT
-* The boxes around the histograms are drawn in the histogram coordinates
-* New routine HPLABL
-* New usage of NDVX and NDVY
-* Modifications in HPLS (scatter plots): Polymarkers are now buffered
-* HPLOPT call IGZSET('G') if option='NZFL' or '*'
-* Mod in HPLH (remove test on precision)
-* The new version of the HIGZ COMMON HIATT is now in HPLOT
-* New options: DATE and FILE
-* New setting commands: SET FILE, SET DATE and SET STAT
-* In case of option Update, HPLSTA work in hard text font
-* New options 'BOX' and 'COL' in HPLOT (2d Histograms)
-* Scatter plot, Surface and Lego are drawn with HCOL
-*
-* Version 5.03 (09/09/88)
-*
-* Routine HPLNT: COMMON/PAWIDN/ added
-* Mods in HPLSTA (NTWIN reset)
-* IQUEST(11) returns NTWIN
-* RQUEST(21:24) return XWMINI..YWMAXI
-* HPLNT changed to use HGN
-* PRINT from HPLEND has been removed.
-* HTYP has now priority on HBLACK.
-* HBLACK not recognized anymore
-* HIGZ routine HIATT introduced in HPLCDES
-* CHOPT activated (options * and P) for scatter-plots
-* IN HPLOPT old format (29.7,21.) changed to (20.,20.)
-* Array IFONT changed to IHFONT (clash with HIATT).
-* In routines HPLTIT and HPLAX, NTWIN is reset to its initial value
-* New option ZFL1 to retain only one HIGZ picture in memory.
-* New option 'E' supported by routine HPLOT.
-* New routine HPLER called by HPLONE for option 'E'
-* HPLER draws error bars with the current marker
-* HPLSWN sets NTHIST=NTWIN when LOSAME is true.
-* Option GRID/NGRI introduced in HPLOPT
-*
-* 31/03
-* - HPLCAP,HPLCOL,HPLGIV,HPLINE,HPLKEY,HPLWIR not yet implemented.
-* - New version of HPLSET (SET SHOW)
-* - New version of HPLOPT (OPT SHOW and OPT *)
-*
-* 01/04
-* - New version of HPLSET (SET NDVX et SET NDVY)
-*
-* 02/04
-* - Bug correction : reinitialisation of line type and hach type.
-* - Axis divisions set to 510 by default
-*
-* 03/04
-* - Logarithmic scale in Y implemented.
-* Possibility of makink histogram with logarithmic scale in X
-* not yet implemented.
-*
-* 13/04
-* - LOCATOR with both logarithmic and linear scales is now possible.
-*
-* 14/04
-* - New version of HPLERR and HPLSYM but there is normally no change
-* for the user.
-*
-* 21/04
-* - HPLWIR is now implemented with the new option W (but does not
-* works yet)
-*
-* 27/04
-* - Bug correction of the option "SAME" in HPLOT calling sequence.
-*
-* 28/04
-* - Line type of 12, 13, 14, 15 (equivalent to HPLDRW in HIGZ) are
-* used for histograms.
-*
-* 30/04
-* _ Suppression du facteur FACT et des appels a HFACT.
-* - "SET DMOD 0" ==> incrementation automatique du type de ligne
-* si superposition de plusieurs histo avec l'option "SAME" (si un
-* seul histo : trait plein)
-* - Contour des histo "fill area" inchange si superposition avec
-* l'option "SAME".
-*
-* 04/05
-* - New version of HPLOPT with the option TIC/NTIC to have (or not)
-* automatic cross-wires drawned after each plot.
-* - New version of HPLSET with the option SET BTYP to set the fill
-* area index for boxes (HPLBOX), SET HCOL and SET BCOL to set
-* the color for histograms and boxes.
-*
-* 05/05
-* - New convention for HTYP and BTYP (HPLSET) :
-* HTYP = 100 * FAIS + FASI for histogram
-* BTYP = 100 * FAIS + FASI for boxes
-* (FAIS and FASI are GKS attributes for area)
-* - Errors gestion with messages : a call to HBUG instead of HBUFF
-* is done.
-*
-* 06/05
-* - HPLCAP is now implemented (But there is a problem for WTYP :
-* conflict between screen and metafile).
-*
-* 07/05
-* - New version of HPLOPT with the option STA/NSTA to print statistics
-* information on plots (with the new HPLOT routine HPLSTA).
-* - New version of HPLSET with the options SET PTYP to set the fill
-* area index for the whole picture boxe,and SET PCOL to set the color.
-*
-* 15/05
-* - HPLGIV is now implemented
-* - OPT ACH is no more in use but automatically set when SET HTYP VAL
-* with VAL not equal to 0.
-*
-* 18/05
-* - For histogram 1D axes are drawned at the end (bug with HCOL)
-* - HPLAX is now implemented
-*
-* 19/05
-* - New version of HPLSET with SET GFON, VFON, TFON, LFON with the following
-* convention:
-* XFON = 10 * FONT + PREC (X = G (Global title), V (axis Value),
-* T (Text and Title), L (axis Labels))
-* - HPLARC, HPLKEY are now implemented
-*
-* 20/05
-* - Axis for LEGO plots are available. Now you can SET XTIC and YTIC with
-* negative values to put tick marks on the other side (idem for XLAB and
-* YLAB).
-* - HPLSIZ(XSIZE,YSIZE,CHOPT) is implemented : according the flag CHOPT
-* it sets or returns the picture size in cm.
-*
-* 23/05
-* - Mods in HPLINT (If Workstation is zero RETURN)
-* - New convention for HTYP, BTYP or PTYP (HPLSET) :
-* XTYP = 1000 * (FAIS+1) + FASI (X=H, B or P)
-* FAIS and FASI are GKS attributes for area:
-* if FAIS=0 : empty (XTYP=1000)
-* if FAIS=1 : solid (XTYP=2000)
-* if FAIS=2 : hached (XTYP=3000+FASI)
-* if FAIS=3 : pattern (XTYP=4000+FASI)
-* For GKSGRAL XTYP is negative.
-*
-* 03/06
-* - KICASE must now be type CHARACTER
-* - KICASE may be given as 'C' for 'CM'
-* - Mods in routine HPLOT
-*
-* 15/06
-* - HPLINE and HPLFUN are now implemented
-* - HPLPRO implemented
-*
-* 18/06
-* - New option PTO/NPTO in HPLOPT
-* - New counter for HPLOT pictures
-*
-* 23/06
-* - PATCH,HPLEXAM contains 7 examples
-* - Bug corrected in HPLSYM.
-* - Routine HPLWIN calls new official routine HPLZON.
-*
-* 02/07
-* - Plots for non-equidistant bins are now available.
-*
-* 03/07
-* - HPLOPT(CHOPTN,N) with CHARACTER*(*) CHOPTN(1), instead of
-* HPLOPT(KIOPTN,N).
-* - OPT P (or *P, **P, ***P) is now available
-* - New option in HPLSET: SET FPGN to set the first page number
-*
-* 07/07
-* - New version of HPLNT.
-* - Bugs when drawing scatter-plots with option 'CHA' or tables
-* are corrected.
-* - Axes for contours are available, and for ITYP=2 in HPLCON all
-* lines have the same line type (continuous line).
-*
-* 17/07
-* - Logarithmic scale in Z is available for lego plots and surfaces
-* (by using new option LOGZ/LINZ in HPLOPT, or when a call to HLOGAR
-* in HBOOK)
-*
-* 30/07
-* - New option "SET HMAX" (HMAX is in percent and must be .LE. 1) which
-* allows the user to set the scale beetwen axis graduation and maximum of
-* histogram (default is 0.9). This option is particularly usefull when
-* superposition of several histograms.
-* - New options in HPLOT ("L", "K", "U", "+", etc...) because a Zebra bank
-* has been introduced (only if HPLH called), which memorised the
-* description of the histogram when option "L" ("Live") is selected
-* (usefull for future option "U" ("Update) ).
-*
-* 10/08
-* - new version of HPLC: new scale for histograms and functions with
-* negative value (for instance SINUS which is symetric / Y=0 ).
-*
-* 14/08
-* - new DECKS HPLIVE,HPLRDW,HPLHUP for option "Update".
-*
-* 19/08
-* - options 'U', 'K', 'L', '+' in HPLOT are available (one option at a time).
-*
-* 21/09
-* - New options OPT DVXI (resp. DVXR) and DVYI (resp. DVYR) (DiVisions are
-* Integer (resp. Real) for X or Y axis). If NDVX or NDVY have negative
-* value (in HPLSET) no optimisation is done for axis labelling.
-* - If TSIZ is set to 0 in HPLSET automatic calculation is performed for
-* character size of histogram title in order that it is not truncated.
-* (TSIZ 0 is taken by default).
-* - Correction in HPLEND.
-* - Bug correction in HPLSOF (coordinates in cm).
-* - Optimisation in order to have less CALL to ISELNT
-* (NTWIN=current transformation, NTHIST=histogram transformation
-* and 1=transformation cm).
-*
-* 07/10
-* - Option "L" is no more in use in HPLOT (option "K" replaces it). "K" is
-* necessary only if windowing option is selected.
-*
-* 12/10
-* - New version of HPLF to support new HBOOK functionality
-*
-* 16/10
-* - New PATCH,HPLEXAM
-*
-* 26/10
-* - New options 'L', 'C', 'F', '*', 'M' and 'B' in HPLOT.
-*
-* 30/10
-* - Bug correction about "line type" with option "SAME" (simplifications
-* in the code with ILTYP ).
-* - Bug correction in HPLSET : PASS and CSHI are now correctly reinitialised
-* with SET *.
-* - New option SET BARO and SET BARW (instead of IGSET) in HPLSET.
-*
-* 4/11
-* - New routine HPLZOM(ID,CHOPT,NCMIN,NCMAX)
-*
-* 12/11
-* - XSIZ = 20. and YSIZ = 20. are now the default values in HPLSET.
-*
-* 30/11
-* - New routine HPLCHA
-*
-* 08/12
-* - Bug corrected in HPLPRO
-*
-* 10/12
-* - Changes in HPLZON to reset number of normalisation transformation
-* - Changes for HCOL,PCOL,BCOL
-*
-* 04/01/88
-* - Bug corrected in HPLF when called from HPLZOM
-*
-* 25/01/88
-* - Bug corrected in HPLFUN
-*
-* 03/02/88
-* - Routines HPLEND,HPLPTO,HPLOC and HPLZON modified
-*
-* 04/02/88
-* - Changes in HPLC,HPLONE when YMINI.GE.YMAXI
-*
-* 05/02/88
-* - Changes in HPLEND.
-* Can now give HTYP,PTYP,BTYP like GKS
-* Code cleanup
-*
-* 08/02/88
-* - Changes in HPLS
-*
-* 18/02/88
-* - Bug corrected in HPLNT
-*
-* 01/03/88
-* - Bug corrected in HPLNT
-* - Bug corrected in HPLF
-*
-* 14/03/88
-* - CALL RZIN replaced by CALL HRZIN in HPLNT
-* - Bug corrected in HPLH for option 'P'
-*
-* 15/03/88
-* - Bug corrected in HPLINT
-*
-* 16/04/88
-* - Marker for scatter-plots can be changed if option P given
-*
-* 05/05/88
-* - Routine HPLUSR called with CHARACTER variable instead of Hollerith
-*
-* 10/05/88
-* - Correction in HPLS when plotting tables
-*
-* 17/05/88
-* - Changes for IHCOL,IHTYP in several routines
-*
diff --git a/src/graflib/hplot/doc/Versions/v5_05 b/src/graflib/hplot/doc/Versions/v5_05
deleted file mode 100644
index ab006b1..0000000
--- a/src/graflib/hplot/doc/Versions/v5_05
+++ /dev/null
@@ -1,13 +0,0 @@
-*
-* $Id: v5_05,v 1.1.1.1 1996/01/19 10:50:14 mclareni Exp $
-*
-* $Log: v5_05,v $
-* Revision 1.1.1.1 1996/01/19 10:50:14 mclareni
-* Hplot
-*
-*
-*CMZ : 27/08/91 18.30.03 by Unknown
-*-- Author :
-*
-*::> VERSION 5.05/00 890601 14.02
-*
diff --git a/src/graflib/hplot/doc/Versions/v5_06 b/src/graflib/hplot/doc/Versions/v5_06
deleted file mode 100644
index 322d7c6..0000000
--- a/src/graflib/hplot/doc/Versions/v5_06
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: v5_06,v 1.1.1.1 1996/01/19 10:50:14 mclareni Exp $
-*
-* $Log: v5_06,v $
-* Revision 1.1.1.1 1996/01/19 10:50:14 mclareni
-* Hplot
-*
-*
-*CMZ : 27/08/91 18.30.03 by Unknown
-*-- Author :
-*
-*::> VERSION 5.06/01 890712 11.29
-*
-* HPLINT calls IGINIT(1000) instead of IGINIT(100)
-* Option FILE draws the file for each plot and not only for each page
-* Legos with negative contains are now correct (HPLEG1)
-* Option FIT and SET FIT are now available
-* Now the BCOL has the format C.BS where C is the color of
-* the histo box B the color of the width box and S the
-* color of the shadow for the STAT and FIT boxes.
-* Bug corrected in HPLSTA (CALL HSTATI)
-* Bug corrected in HPLSTA: UDFLW and OVFLW was swaped
-*
-*::> VERSION 5.06/00 890601 14.04
-*
-* Generic functions introduced (LOG10, MAX, MIN etc ..)
-* Bug corrected in HPLF in case of ZOOM
-* Option LOGX introduced (changes in HPLH HPLF and HPLONE)
-*
diff --git a/src/graflib/hplot/doc/Versions/v5_07 b/src/graflib/hplot/doc/Versions/v5_07
deleted file mode 100644
index cc342e3..0000000
--- a/src/graflib/hplot/doc/Versions/v5_07
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: v5_07,v 1.1.1.1 1996/01/19 10:50:14 mclareni Exp $
-*
-* $Log: v5_07,v $
-* Revision 1.1.1.1 1996/01/19 10:50:14 mclareni
-* Hplot
-*
-*
-*CMZ : 27/08/91 18.30.03 by Unknown
-*-- Author :
-*
-*::> VERSION 5.07/00 891011 14.14
-*
-* Mods in HPLNT (COMMON size)
-* Mods in HPLO and HPLONE concerning the LOG scales
-* New routine HPLTAB calling IGTABL. The routines:
-* HPLC2 HPLC3 HPLEG1 HPLHI2 HPLHID HPLO HPLS HPLSU2
-* HPLSU3 HPLSU4 HPLTWO are now obsolete.
-* New option HIST and FUNC in HPLOT to plot separatly
-* the Histogram or the Fit (FUNC) for a give histo ID
-* The option HIST force to plot an histogram with errors
-* bars as a normal histo.
-*
diff --git a/src/graflib/hplot/doc/Versions/v5_08 b/src/graflib/hplot/doc/Versions/v5_08
deleted file mode 100644
index 9107288..0000000
--- a/src/graflib/hplot/doc/Versions/v5_08
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: v5_08,v 1.1.1.1 1996/01/19 10:50:13 mclareni Exp $
-*
-* $Log: v5_08,v $
-* Revision 1.1.1.1 1996/01/19 10:50:13 mclareni
-* Hplot
-*
-*
-*CMZ : 27/08/91 18.30.03 by Unknown
-*-- Author :
-*
-*::> VERSION 5.08/01 900503 14.48
-*
-* Corrections in HPLFRA (bug in case of zone)
-* The COMMON HIATT is now not used in HPLOT
-* New option '-' in HPLOT
-* New option '+-' in HPLOT
-* HPLDAT is called in HPLNUL and HPLFRA
-*
-*::> VERSION 5.08/00 891219 14.42
-*
-* Option LOGX introduced in HPLE
-* New routine HPLFRA to plot a FRAME with axis
-* Text angle set to 0. in HPLFIT and HPLSTA
-*
diff --git a/src/graflib/hplot/doc/Versions/v5_09 b/src/graflib/hplot/doc/Versions/v5_09
deleted file mode 100644
index 84171f5..0000000
--- a/src/graflib/hplot/doc/Versions/v5_09
+++ /dev/null
@@ -1,13 +0,0 @@
-*
-* $Id: v5_09,v 1.1.1.1 1996/01/19 10:50:13 mclareni Exp $
-*
-* $Log: v5_09,v $
-* Revision 1.1.1.1 1996/01/19 10:50:13 mclareni
-* Hplot
-*
-*
-*CMZ : 27/08/91 18.30.03 by Unknown
-*-- Author :
-*
-*::> VERSION 5.09/00 900503 16.23
-*
diff --git a/src/graflib/hplot/doc/Versions/v5_10 b/src/graflib/hplot/doc/Versions/v5_10
deleted file mode 100644
index 9d982b4..0000000
--- a/src/graflib/hplot/doc/Versions/v5_10
+++ /dev/null
@@ -1,89 +0,0 @@
-*
-* $Id: v5_10,v 1.1.1.1 1996/01/19 10:50:13 mclareni Exp $
-*
-* $Log: v5_10,v $
-* Revision 1.1.1.1 1996/01/19 10:50:13 mclareni
-* Hplot
-*
-*
-*CMZ : 27/08/91 18.30.03 by Unknown
-*-- Author :
-*
-*::> VERSION 5.10/13 910614 15.35
-*
-* Mods in HPLF in order to plot the gaussian, exponential and
-* polynomial fits with the parameters of the curves.
-*
-*::> VERSION 5.10/12 910605 11.45
-*
-* Mods in HPLSWN in case of option 'S' in H/PLOT and ZONE.
-* New parameters XWID and YWID in HPLSET in order to change
-* the width of the X and Y axis tick marks.
-*
-*::> VERSION 5.10/11 910503 17.51
-*
-* The marker type is now reset in the example 2 (HPLEX2)
-* HPLCHA fill the COMMON QUEST in order to know if the picked
-* histo is in LOG scale or not.
-*
-*::> VERSION 5.10/10 910321 10.56
-*
-* Bug fixed in HPLAX2. In case of OPTION SOFT the font value
-* was not correct for the LEGO and SURFACE axis.
-*
-*::> VERSION 5.10/09 910215 18.37
-*
-* Changes of Patchy flags STRASB,NEWLIB,IBMMVS.
-*
-*::> VERSION 5.10/08 910118 10.08
-*
-* Bug fixed in HPLC: In case of OPTION LOGY on an histogram
-* with YMINI=YMAXI nothing was drawn.
-*
-*::> VERSION 5.10/07 901220 14.13
-*
-* The value of "all channels" can be printed if option STAT
-* is selected (and also SET STAT 1000000).
-*
-*::> VERSION 5.10/06 901207 11.31
-*
-* Changes in HPLTAB : the color of the contour plots could
-* be changed via SET HCOL.
-*
-*::> VERSION 5.10/05 901206 12.13
-*
-* New option ERRX in HPLSET to define the error on X
-* in % of the bin width. The default is 0.5 . SET ERRX 0
-* set the default value. To delete the error on X one
-* should set ERRX to a small value. This implies mods
-* in HPLSET, HPLE, and HPLER. A new varialble RERRX is
-* in the COMMON HPL1.
-*
-*::> VERSION 5.10/04 901130 11.17
-*
-* It is now possible to give to HPLSET *SIZ, *TYP, *COL, *WID
-* and *FON to define respectivly all the text sizes, the
-* fill area type, the colors, the line width and the text
-* fonts with the same values.
-*
-*::> VERSION 5.10/03 901129 10.59
-*
-* Changes in HPLSET to correct the fact that SET HCOL 0.i
-* set always the list 1 as current list.
-*
-*::> VERSION 5.10/02 901123 10.56
-*
-* Correction in HPLC in case of HMAX and LOGY
-*
-*::> VERSION 5.10/00 901107 14.12
-*
-* Axis are drawn after the 2D plots in HPLTAB
-* The drawing of the errors bars take care with HWID
-* Max for 2D histograms introduced in HPLTAB
-* SET STAT works now 2D histograms
-* New version of HPLTOC
-* New option 'B' in HPLFRA to avoid the Box drawing
-* New algorytms for LEGO and SURFACE
-* A 1 Dim histogram could be plotted as a LEGO
-* OPTION BAR and SET BARO and SET BARW work on LEGOS
-*
diff --git a/src/graflib/hplot/doc/Versions/v5_11 b/src/graflib/hplot/doc/Versions/v5_11
deleted file mode 100644
index d5d80c4..0000000
--- a/src/graflib/hplot/doc/Versions/v5_11
+++ /dev/null
@@ -1,37 +0,0 @@
-*
-* $Id: v5_11,v 1.1.1.1 1996/01/19 10:50:13 mclareni Exp $
-*
-* $Log: v5_11,v $
-* Revision 1.1.1.1 1996/01/19 10:50:13 mclareni
-* Hplot
-*
-*
-*CMZ : 5.11/02 08/10/91 10.20.41 by O.Couet
-*-- Author :
-*
-*::> VERSION 5.11/02 911008 10.20
-*
-* Bug corrected in HPLFIT. The fit box was too large when the
-* OPTION FIT was set to 100.
-* Bug corrected in HPLWIR. The Tick Marks width was not taken
-* into account.
-* The line width for the surface drawing is now controlled with
-* HWID (mods in HPLTAB).
-* First version of the $KUMACS PATCH.
-*
-*::> VERSION 5.11/01 910916 14.21
-*
-* HPLAX doesn't change the text angle to 90 degrees.
-* Bug corrected in HPLF: The fit was partially drawn in case
-* of zoom.
-*
-*::> VERSION 5.11/00 910827 12.19
-*
-* Changes in HPLTOC. Now it works with te current NT parameters.
-* Mods in HPLF to draw only the fitted part of an histogram in
-* a command like HI/FIT 110(50:) G.
-* Bug corrected in HPLFIT. ALLCHAN overwrote the STAT parameters.
-* Bug corrected in HPLER. In case of option SAME the window
-* size used could be wrong. Now IGQWK is called to get the
-* right window size.
-*
diff --git a/src/graflib/hplot/doc/Versions/v5_12 b/src/graflib/hplot/doc/Versions/v5_12
deleted file mode 100644
index 7d8c398..0000000
--- a/src/graflib/hplot/doc/Versions/v5_12
+++ /dev/null
@@ -1,42 +0,0 @@
-*
-* $Id: v5_12,v 1.1.1.1 1996/01/19 10:50:13 mclareni Exp $
-*
-* $Log: v5_12,v $
-* Revision 1.1.1.1 1996/01/19 10:50:13 mclareni
-* Hplot
-*
-*
-*CMZ : 5.12/03 25/06/92 09.29.22 by O.Couet
-*-- Author : O.Couet 03/03/92
-*
-*::> VERSION 5.12/03 920625 9.29
-*
-* Mods in HPLEXAM for the metafiles names (M.Marquina).
-* HPLSYM now restore the marker type and size.
-*
-*::> VERSION 5.12/02 920403 15.06
-*
-* New version of the option '3' in HPLTAB. It take care
-* of the number of contour.
-* Bug corrected in HPLTAB. With the option 'CONT', if more than
-* 15 levels where requested, the level 15 was reset.
-*
-*::> VERSION 5.12/01 920312 17.31
-*
-* Mods in HPLIST in order to define the palette automatically.
-* New option '3' for the contour drawing with HPLTAB. This
-* option allows to draw contours with colored fill area.
-*
-*::> VERSION 5.12/00 920303 13.18
-*
-* Mods in HPLH to allow the option "+" in HPLOT with log
-* scale on Y axis.
-* Mods in HPLTAB: the color of the histogram was not correct in
-* case of the option 'ARR'.
-* Mod in HPLTAB to care of the options "3" and "4" in IGTABL.
-* In HPLTAB take care of VFON for the axes of 3D plots.
-* Some clean up in HPLSYM (HPL9 was not used).
-* Mods in HPLF to draw only the fitted part of an histogram in
-* a command like HI/FIT 110(50:) G and also in command like.
-* H/PLOT 110 if 110 has been previously fitted.
-*
diff --git a/src/graflib/hplot/doc/Versions/v5_13 b/src/graflib/hplot/doc/Versions/v5_13
deleted file mode 100644
index f643939..0000000
--- a/src/graflib/hplot/doc/Versions/v5_13
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: v5_13,v 1.1.1.1 1996/01/19 10:50:13 mclareni Exp $
-*
-* $Log: v5_13,v $
-* Revision 1.1.1.1 1996/01/19 10:50:13 mclareni
-* Hplot
-*
-*
-*CMZ : 5.13/01 22/07/92 17.35.21 by O.Couet
-*-- Author : O.Couet 14/07/92
-*
-*::> VERSION 5.13/01 920722 17.35
-*
-* Mods in HPLF to take care about the new DOUBLE PRECISION version
-* of the HGAUS routine.
-*
-*::> VERSION 5.13/00 920714 16.00
-*
diff --git a/src/graflib/hplot/doc/Versions/v5_14 b/src/graflib/hplot/doc/Versions/v5_14
deleted file mode 100644
index e4dcf0c..0000000
--- a/src/graflib/hplot/doc/Versions/v5_14
+++ /dev/null
@@ -1,90 +0,0 @@
-*
-* $Id: v5_14,v 1.1.1.1 1996/01/19 10:50:13 mclareni Exp $
-*
-* $Log: v5_14,v $
-* Revision 1.1.1.1 1996/01/19 10:50:13 mclareni
-* Hplot
-*
-*
-*CMZ : 5.14/09 22/02/93 13.40.41 by O.Couet
-*-- Author : O.Couet 23/07/92
-*
-*::> VERSION 5.14/09 930222 13.40
-*
-* Bug fixed in HPLWIR: The clipping was not reset.
-* The routine HPLAXI plot now only the axis for 2Dim plots
-* (the parameter ITYP is removed). It is also able
-* to use the alphanumeric labels of an histogram.
-* With OPTION ZFL1, the same picture name ('PICT00') is
-* used for every new picture.
-* It is now possible to specify with one SET command both
-* the border and the inside color for the Histogram, Box
-* Page, and Function (HCOL, BCOL, PCOL, FCOL).
-* Ex:
-* +---- The Histogram is filled
-* |+--- The border color is 2
-* ||++- The inside color is 3
-* ||||
-* VVVV
-* PAW > SET HCOL 1203
-*
-* Protection added in HPLF to prevent undefined value
-* returned by HQF.
-* FLOARG is now not used in HPLBOX.
-* Mods in HPLF. Case of predefine fits the "Too many channels"
-* error doesn't append.
-* Bug fixed in HPLSET: The variables I*BCOL was not initialized
-* correctly.
-* Improvment in HPLC. In case of LOGY with option SAME, the
-* mininum of the previously defined window is used if the
-* content of the histogram is less or equal to 0.
-*
-*::> VERSION 5.14/08 921012 11.58
-*
-* Change link 4 to link 8 of LHBOOK/LCDIR
-*
-* HPLSET is now able to mannage all the IGSET options.
-* Bug fixed in HPLH. In the case of option '+' in HPLOT
-* with a LOGY scale, some contribution was sometimes
-* added even if the bin content was null.
-*
-*::> VERSION 5.14/07 920930 11.00
-*
-* Mods in HPLH, HPLIVE and HPLRDW in order to allow the
-* use of the HPLOT option '+' on subranges of histograms.
-*
-*::> VERSION 5.14/06 920902 10.08
-*
-* Bug fixed in HPLOPT: LINY was not correctly reset with
-* the option '*'.
-*
-*::> VERSION 5.14/05 920826 17.19
-*
-* Changes in HPLTAB, HPLFIT and HPLF to plot the new
-* Multiquadric fits (J.Allison).
-*
-*::> VERSION 5.14/04 920821 16.20
-*
-* Bug fixed in HPLAXI if alphanumeric label are requested
-* and if no alphanumeric have been defined
-*
-*::> VERSION 5.14/03 920819 14.40
-*
-* Changes in *HPLOT and $KUMACS/INSTALL: the flag DOUBLE
-* need to be selected if APOLLO is selected.
-*
-*::> VERSION 5.14/02 920817 15.49
-*
-* Bug fixed in the request mechanism of HPLSET
-*
-*::> VERSION 5.14/01 920812 11.56
-*
-* Fix a problem in routine HPLF (HCFITD introduced)
-* Requires a change in PILOT PATCH and in the INSTALL macro:
-* Add option DOUBLE.
-*
-*::> VERSION 5.14/00 920723 13.52
-*
-* Bug fixed in HPLAXI: in case of alphanumeric labels on both X
-* and Y axis, the Y axis labels overwritten the X labels.
-*
diff --git a/src/graflib/hplot/doc/Versions/v5_15 b/src/graflib/hplot/doc/Versions/v5_15
deleted file mode 100644
index 81152c9..0000000
--- a/src/graflib/hplot/doc/Versions/v5_15
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: v5_15,v 1.1.1.1 1996/01/19 10:50:13 mclareni Exp $
-*
-* $Log: v5_15,v $
-* Revision 1.1.1.1 1996/01/19 10:50:13 mclareni
-* Hplot
-*
-*
-*CMZ : 5.15/00 24/02/93 15.56.27 by O.Couet
-*-- Author : O.Couet 24/02/93
-*
-*::> VERSION 5.15/00 930224 15.56
-*
-* Improvment in HPLC. In case of LOGY with option SAME, the
-* mininum of the previously defined window is used if the
-* content of the histogram is less or equal to 0.
-*
diff --git a/src/graflib/hplot/doc/Versions/v5_16 b/src/graflib/hplot/doc/Versions/v5_16
deleted file mode 100644
index cf32374..0000000
--- a/src/graflib/hplot/doc/Versions/v5_16
+++ /dev/null
@@ -1,37 +0,0 @@
-*
-* $Id: v5_16,v 1.1.1.1 1996/01/19 10:50:13 mclareni Exp $
-*
-* $Log: v5_16,v $
-* Revision 1.1.1.1 1996/01/19 10:50:13 mclareni
-* Hplot
-*
-*
-*CMZ : 5.16/02 27/05/93 08.26.42 by O.Couet
-*-- Author : O.Couet 30/04/93
-*
-*::> VERSION 5.16/02 930527 8.26
-*
-* LINUX version introduce. <balashov at main1.jinr.dubna.su>
-*
-*::> VERSION 5.16/01 930511 17.24
-*
-* Mods in HPLOPT to return the value of the LOG* options.
-* HPLFIL call now IGTCCH to convert IGTEXT control characters.
-*
-*::> VERSION 5.16/00 930430 12.03
-*
-* Bug fixed in HPLTAB. If the number of entries was 0 IGTABL was
-* not called.
-*
-* Changes in routines HPLC,HPLONE and HPLTAB to support MIN/MAX
-* for 2-Dim histograms.
-*
-* HPLAX restore the text alignment.
-* In HPLER, the symbols are drawn only if they are not exactly on
-* the minimum or on the maximum of the current normalisation
-* transformation window.
-* Option POL and CYL in HPLTAB
-* Mods in HPLONE: if IDOPT with option LOGY has been called on a
-* histogram, the way to remove it in PAW in IDOPT id LINY
-* and not OPTION LINY as it was the case in this routine.
-*
diff --git a/src/graflib/hplot/doc/Versions/v5_17 b/src/graflib/hplot/doc/Versions/v5_17
deleted file mode 100644
index b26958f..0000000
--- a/src/graflib/hplot/doc/Versions/v5_17
+++ /dev/null
@@ -1,96 +0,0 @@
-*
-* $Id: v5_17,v 1.1.1.1 1996/01/19 10:50:13 mclareni Exp $
-*
-* $Log: v5_17,v $
-* Revision 1.1.1.1 1996/01/19 10:50:13 mclareni
-* Hplot
-*
-*
-*CMZ : 5.17/12 22/10/93 11.24.18 by O.Couet
-*-- Author : O.Couet 05/07/93
-*
-*::> VERSION 5.17/12 22/10/93 11.24.18
-*
-* Bug fixed in HPLF. The filled area was not good in of
-* histogram subrange drawing.
-*
-*::> VERSION 5.17/11 12/10/93 16.39.20
-*
-* Mods in HPLTAB to manage more than 1000 channels.
-* Improvment in HPLFRA: when the X1=X2 or Y1=Y2 the frame is
-* drawn with X1-1,X2+1,Y1-1,Y2+1.
-*
-*::> VERSION 5.17/10 11/10/93 12.39.47
-*
-* Optimization for alphanuneric labels removed in HPLAXI
-* (now done in IGAXIS).
-* Improvment in HPLCHA: If nothing is picked inside the picture
-* the HPLOT stucture, to retrieve the IDH, is used.
-*
-*::> VERSION 5.17/09 01/10/93 10.53.26
-*
-* Improvments in the error bars with edges marks drawing:
-* 1) If the error bars are smaller than the KSIZ, the edges
-* marks are not drawn.
-* 2) If the edges marks are bigger than the error bars,
-* the mimimum of the two is taken.
-* New options in HPLSET:
-* SMGR: define the Rigth Margin between the STAT/FIT boxes
-* and the histogram box (in % of the histogram box width).
-* SMGU: define the Up Margin between the STAT/FIT boxes and the
-* histogram box (in % of the histogram box heigh).
-* This implies mods in HPLSET, HPLSTA and HPLFIT.
-*
-*::> VERSION 5.17/08 29/09/93 12.15.31
-*
-* Statistics, Fit parameters, Date, File and additional tick
-* marks are now drawn in HPLTAB for 2D histograms. This
-* simplify PAW where duplicated code was added in PAPLOT
-* ans PAHIST and it makes these options working for commands
-* like CONTOUR.
-*
-*::> VERSION 5.17/07 27/09/93 11.54.02
-*
-* Change in HPLAER. The option E1 was not correct if the
-* marker type was "."
-* Two new routines:
-* HPLSEL do a CALL ISELNT and the NTWIN.
-* HPLWN set the window parameters taking care with LOG scale.
-*
-*::> VERSION 5.17/06 15/09/93 12.12.52
-*
-* New routine HPLFR3 (frame 3d).
-*
-*::> VERSION 5.17/05 24/08/93 18.08.07
-*
-* Bug fixed in HPLAER and HPLERR. The input vectors where
-* dimensionned with N, and N can be 0. Now they are dimensioned
-* with 1.
-*
-*::> VERSION 5.17/04 24/08/93 15.45.13
-*
-* The attributes are stored at the begininig of HPLFRA
-* and reset at the end (call to IZSAVA IZSETA).
-*
-*::> VERSION 5.17/03 930722 12.35
-*
-* The HPLAER options are now called 0,1,2,3,4 to avoid
-* ambiguities when it is invoked from HPLOT.
-* New option W in HPLAER.
-* The routines HPLER and HPLE are now obsolete.
-*
-*::> VERSION 5.17/02 930720 11.24
-*
-* New options B,L,R,F and S in HPLAER.
-*
-*::> VERSION 5.17/01 930713 15.48
-*
-* Bug fixed in HPLZON: if IW<=0 it is changed to 1.
-*
-*::> VERSION 5.17/00 930705 12.40
-*
-* Protection added in HPLFRA.
-* Improvments in HPLTAB to allows histograms with more
-* than 1000 bins.
-* New routine HPLAER to draw asymetric error bars.
-*
diff --git a/src/graflib/hplot/doc/Versions/v5_18 b/src/graflib/hplot/doc/Versions/v5_18
deleted file mode 100644
index 5fc98dd..0000000
--- a/src/graflib/hplot/doc/Versions/v5_18
+++ /dev/null
@@ -1,153 +0,0 @@
-*
-* $Id: v5_18,v 1.1.1.1 1996/01/19 10:50:13 mclareni Exp $
-*
-* $Log: v5_18,v $
-* Revision 1.1.1.1 1996/01/19 10:50:13 mclareni
-* Hplot
-*
-*
-*CMZ : 5.18/20 24/10/94 10.49.41 by O.Couet
-*-- Author : O.Couet 02/11/93
-*
-*::> VERSION 5.18/20 24/10/94 10.49.41
-*
-* HPLFUN is now completly dynamic: no limitation on the number
-* of points.
-*
-*::> VERSION 5.18/19 21/10/94 11.05.01
-*
-* Mods in HPLONE to redraw the axis tick marks if they have been
-* erased with an function drawn with option 'S' as a filled area.
-*
-*::> VERSION 5.18/18 11/10/94 17.05.19
-*
-* Bug fixed in HPLFIL: the string send to IGTCCH was too long.
-*
-*::> VERSION 5.18/17 28/09/94 17.57.43
-*
-* Bug fixed in HPLF: In case of LOG scale on Y, the
-* Y bank was filled at the wrong adress.
-* New option 'X' of IGZSET used in HPLOPT.
-* Bug fixed in HPLTAB. The LO3DPL flag is false in case of 1D
-* histos.
-*
-*::> VERSION 5.18/16 26/08/94 17.04.51
-*
-* Redesign of the ZEBRA data structure. All the banks
-* created by are linked on LHPLOT (see comments in HPLINT).
-*
-*::> VERSION 5.18/15 22/07/94 15.26.01
-*
-* Bug fixed in HPLTAB. The decoding of option 'A' was misplaced
-* (conflict with option 'SCAT').
-* Small fix is HPLAER. After the call to HPLATT, the PLCI can
-* be equal to the color of the histogram border. It is now
-* reset to the histogram color (as before).
-* Mods in HPLF. NBINS is used instead of ICMAX to check if
-* the function to draw has too many points. This allows to plot
-* at least subranges.
-*
-*::> VERSION 5.18/14 30/06/94 14.54.54
-*
-* HPLTIT allows titles like:
-* 'histo_title ; X_axis_title ; Y_axis_title ; Z_axis_title'
-* HPLAX allows to draw also the Z_axis_title. If CHYTIT contains
-* a ';' the Z title is drawn
-* The string CHTEMP is now in a sequence in order to save space.
-* Mods in HPLAXI and HPLONE to redraw the axis tick marks if
-* they have been erased with an histogram drawn with option 'S'
-* as a filled area.
-*
-*::> VERSION 5.18/13 17/06/94 17.41.35
-*
-* HPLAXI: IGXY is initialised to 0.
-* New options 'FB' and 'BB' in HPLTAB. The option 'A' to suppress
-* the axis drawing works also on 2D histograms.
-*
-*::> VERSION 5.18/12 10/06/94 11.44.50
-*
-* Fix in HPLNEW: the PTO was not done the first time.
-* New version of HPLH to plot histogram with several millions
-* of bins.
-* New routine HPLATT to set the HIGZ attributes from the HPLOT
-* attributes (histogram and Function). It avoids a lot of
-* duplicated code.
-*
-*::> VERSION 5.18/11 01/03/94 09.10.55
-*
-* In HPLOC, HPLCHA is called only if ISTAT > 0
-*
-*::> VERSION 5.18/10 21/02/94 11.16.33
-*
-* Sometimes LCID was equal to 0 in HPLFIT and the number
-* of lines in the fit drawing was not correct.
-* Mods in HPLH and HPLRDW to use the new option 'Z' of IGHIST.
-*
-*::> VERSION 5.18/09 14/02/94 17.38.52
-*
-* New option 0 in HPLAER to avoid the automatic clipping
-* of markers.
-* In HPLAER the symbol clipping was applied only on histogram
-* drawing. Now it is also applied on vectors drawing.
-*
-*::> VERSION 5.18/08 11/02/94 16.00.43
-*
-* New FLAG WINNT in *HPLOT and *HPLEXAM.
-* Bug fixed in HPLAER: LBINS was not recomputed in
-* case of histograms with a non equidistant bining.
-*
-*::> VERSION 5.18/07 17/01/94 17.59.01
-*
-* Bug fixed in HPLTAB. the scale factor SCMAX should
-* be put in PAR2(5) only for 2-Dim histograms.
-* Bug fixed for the page numbering. In HPL1 the page
-* number variable was IOP which was often a local
-* variable. Now the page number is IOPAGE.
-* HPLPGN has been rewritten in a better way.
-*
-*::> VERSION 5.18/06 07/01/94 18.39.43
-*
-* Mods in HPLFR3 in order to use the new HIGZ 3D routines:
-* ISWN3 and ISVP3.
-*
-*::> VERSION 5.18/05 15/12/93 19.28.57
-*
-* Improvment in HPLTIT: If the histogram title contains a ';'
-* two titles are drawn: one horizontally and one vertically.
-* HPLONE has now a return error code. If it is 0 everything is
-* ok. If NOT, some problem occurs (i.e. log scale on Y=<0).
-* This error code is used in HPLOT.
-*
-*::> VERSION 5.18/04 06/12/93 17.15.26
-*
-* Bug fixed in HPLH. Side effect of: 5.14/07 920930 11.00
-* Fix in HPLH. With option U, the temporary bank HIST was
-* not updated. Side effect of 5.08/01 900503 14.48 (option +-)
-*
-*::> VERSION 5.18/03 01/12/93 17.10.36
-*
-* New option HSTA (HNST) in HPLOPT.
-* If a parameter name given to the HBOOK routine HFINAM begin
-* with a '-', HPLFIT doesn't draw this parameter.
-*
-*::> VERSION 5.18/02 16/11/93 17.40.56
-*
-* Protection added in HPLCHA in case the histo IDH doesn't
-* exist.
-* Improvments in HPLH and HPLHUP: With the options +, -, +-
-* and U of HPLOT, the border is drawn only around the new
-* contribution not around each bin as before.
-*
-*::> VERSION 5.18/01 08/11/93 09.47.24
-*
-* The unsed parameter NCHR in HPLTX1 is suppressed.
-*
-*::> VERSION 5.18/00 02/11/93 17.41.57
-*
-* Unused sequence HPL2 removed in HPLTOC.
-* Bug fixed in HPLWN. An error message was printed even if
-* there was no error.
-* Bug fixed in HPLAER: The definition of the cm coordinates
-* (if requested) was done too late.
-* Bug fixed in HPLSET (SET 2SIZ was not corect).
-*
diff --git a/src/graflib/hplot/doc/Versions/v5_19 b/src/graflib/hplot/doc/Versions/v5_19
deleted file mode 100644
index 7f1b89c..0000000
--- a/src/graflib/hplot/doc/Versions/v5_19
+++ /dev/null
@@ -1,69 +0,0 @@
-*
-* $Id: v5_19,v 1.1.1.1 1996/01/19 10:50:13 mclareni Exp $
-*
-* $Log: v5_19,v $
-* Revision 1.1.1.1 1996/01/19 10:50:13 mclareni
-* Hplot
-*
-*
-*CMZ : 5.19/06 23/03/95 16.20.59 by O.Couet
-*-- Author : O.Couet 08/11/94
-*
-*::> VERSION 5.19/06 23/03/95 16.20.59
-*
-* Mod in HPLAXI. When the axis was redrawn in case of option "S"
-* the body of the axis was not redrawn.
-*
-* 09/03/95 14.38.49
-* Mods in HPLTAB to support the new option E of IGTABL.
-*
-*::> VERSION 5.19/05 02/03/95 16.16.29
-*
-* *HPLOT modified to use HPLOTCC.
-*
-* 01/03/95 14.44.48
-* New PATCH HPLOTCC which contains C code for HPLOT. Now it contains
-* only the HPLVERS routine.
-*
-* 28/02/95 10.23.13
-* The histogram title was drawn in HPLTAB in case of option S.
-*
-*::> VERSION 5.19/04 22/02/95 12.00.20
-*
-* HCXY has a new calling sequence: implies mods in HPLTAB
-*
-* 22/02/95 11.54.25
-* All the material for the ONtuples is moved in the OBSOLETE PATCH.
-*
-* 22/02/95 10.30.31
-* Mods in HPLAER: HCX is now able to return the error even if HBARX
-* has not been called.
-*
-*::> VERSION 5.19/03 08/02/95 12.03.56
-*
-* Bug fixed in HPLFRA: NULL 0 1 0 1 SAB draws tic marks on the
-* right-hand and upper axes if OPT TIC is in force. These mess-up
-* previous tics.
-*
-* Protection added in HPLFR3 (test on IQUEST(1))
-*
-*::> VERSION 5.19/02 06/01/95 11.18.17
-*
-* Protection added in HPLAX2 to avoid a division by 0.
-*
-* Bug fixed in HPLSTA:
-* Opt STAT
-* Set STAT 111110
-* H/pl 2 BOX
-* the two vertical lines in the stat part were drawn to short
-*
-*::> VERSION 5.19/01 15/11/94 16.02.57
-*
-* Modif in HPLWIR: If the labels are on the right, Left and Right
-* text alignments for axis labels are inverted.
-*
-*::> VERSION 5.19/00 08/11/94 11.37.33
-*
-* Explanation of XSIZ and YSIZ changed in HPLSET.
-* Sequence HPL11 removed from HPLFUN.
-*
diff --git a/src/graflib/hplot/doc/Versions/v5_20 b/src/graflib/hplot/doc/Versions/v5_20
deleted file mode 100644
index f891469..0000000
--- a/src/graflib/hplot/doc/Versions/v5_20
+++ /dev/null
@@ -1,110 +0,0 @@
-*
-* $Id: v5_20,v 1.1.1.1 1996/01/19 10:50:13 mclareni Exp $
-*
-* $Log: v5_20,v $
-* Revision 1.1.1.1 1996/01/19 10:50:13 mclareni
-* Hplot
-*
-*
-*CMZ : 10/11/95 10.51.08 by O.Couet
-*-- Author : O.Couet 05/05/95
-*
-* 10/11/95 10.49.26 by O.Couet
-* New HPLSET attributes (mods also in HPLTAB)
-* The size of the axis values can be changed with:
-* SET VSIZ
-* The position of the color map be changed with:
-* SET CMAP
-* The margin between the plot and the color map can be changed with:
-* SET CMMG
-* The width of the color map can be changed with :
-* SET CWID
-* The distance between the axis values and the color map can be
-* changed with:
-* SET CVAL
-*
-*::> VERSION 5.20/06 01/11/95 13.03.00
-*
-* New option 'Z' in HPLAER to access directly the KUIP vectore inside
-* the ZEBRA banks.
-*
-* 31/10/95 11.34.47 by O.Couet
-*
-* New routine HPLQSE to return the value of the HPLSET options (used
-* in the PAW function $GRAFINFO)
-*
-*::> VERSION 5.20/05 27/10/95 11.40.55
-*
-* New routine HPLQOP to return the value of the HPLOPT options (used
-* in the PAW function $OPTION)
-*
-*::> VERSION 5.20/04 16/10/95 16.17.06
-*
-* In hpltab the PMCI was not properly reset
-*
-* 04/10/95 17.30.25 by O.Couet
-* IERROR initialize to 0 in HPLOT
-*
-*::> VERSION 5.20/03 04/09/95 15.15.49
-*
-* Bug fixed in HPLSET. For to big value of the STAT or the FIT attribute
-* there was a crash.
-*
-* 04/09/95 12.12.52
-* In HPLSTA the PID for 2d-histos stat box is not store (anyway
-* not usable).
-*
-* 23/08/95 10.31.36
-* Bug fixed in HPLOPT: for the option HSTA the default value and the
-* alternative was inverted.
-*
-* 12/07/95 15.38.21
-* FORMAT I15 is used to write the entries in HPLSTA.
-*
-*::> VERSION 5.20/02 11/07/95 10.29.15
-*
-* Bug fixed in HPLF. In some cases (ZOOM) in H/PLOT the first chanel
-* was greater than the last one.
-*
-*::> VERSION 5.20/01 27/06/95 09.30.12
-*
-* The option W in HPLAER was not compatible with the LOG scale.
-*
-* 19/05/95 11.10.12
-* New routine HPLNOT to draw annotation with fill area, line and
-* symbol. It is a more complete version of HPLKEY.
-*
-* 05/05/95 16.42.18
-* Mod in HPLAXI: a SAVE statement was after DATA statements.
-*
-*::> VERSION 5.20/00 05/05/95 15.29.14
-*
-* Bug fixed in HPLCHA. When a line was drawn on a histogram, the axis
-* was picked.
-*
-* 25/04/95 16.08.10
-* Mod in HPLAER. Now the option 1 draws always the tick mark at the
-* end of the error bar even if the tick is greater than the error.
-* This was too confuse in the past. The size of the tick is equal to
-* the size of the marker.
-*
-* 19/04/95 14.04.16
-* After a plot with option CONT3, the Atitle was not aligned correctly.
-*
-* 19/04/95 10.52.36
-* First atempt to reset the HIGZ attributes when they are changed in
-* a HPLOT routine
-*
-* 12/04/95 17.39.32
-* HPLWIR use the correct font.
-*
-* 12/04/95 17.39.32
-* New routine HPLLGD to drawn axis in a more flexible way compare
-* to HPLAX. Used in the command Atitle in PAW.
-*
-* 24/03/95 11.02.01
-* In HPLTAB, the scatter plot color and the text color was not HCOL
-*
-* 23/03/95 18.23.20
-* Mods in HPLAER: IOPTE was not initialized.
-*
diff --git a/src/graflib/hplot/examples/Imakefile b/src/graflib/hplot/examples/Imakefile
deleted file mode 100644
index 65e5d9b..0000000
--- a/src/graflib/hplot/examples/Imakefile
+++ /dev/null
@@ -1,5 +0,0 @@
-SRCS_F= \ @@\
- hplex1.F hplex2.F hplex3.F hplex4.F hplex5.F hplex6.F hplex7.F \ @@\
- hplexam.F hplmak.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/graflib/hplot/examples/hplex1.F b/src/graflib/hplot/examples/hplex1.F
deleted file mode 100644
index 62a7cd5..0000000
--- a/src/graflib/hplot/examples/hplex1.F
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: hplex1.F,v 1.1.1.1 1996/01/19 10:50:12 mclareni Exp $
-*
-* $Log: hplex1.F,v $
-* Revision 1.1.1.1 1996/01/19 10:50:12 mclareni
-* Hplot
-*
-*
-#include "hplot/pilot.h"
-*CMZ : 5.13/00 01/07/92 16.13.03 by O.Couet
-*-- Author :
- SUBROUTINE HPLEX1
-*.==========>
-*. Examples of basic HPLOT : 1-DIM histograms
-*..=========>
-*
- CALL HTITLE('EXAMPLE NO = 1')
-*
- CALL HPLSIZ(14.,16.,' ')
- CALL HPLOT(110,' ',' ',0)
- CALL HPLSET('HTYP',333.)
- CALL HPLOT(110,' ',' ',0)
- CALL HPLAX('GeV/C',' ')
- CALL HPLSIZ(14.5,21.4,' ')
- CALL HPLZON(1,2,1,' ')
- CALL HPLOT(110,' ',' ',0)
- CALL HPLSET('HTYP',244.)
- CALL HPLOT(110,' ',' ',0)
- CALL HPLSET('HTYP',0.)
- CALL HPLZON(1,1,1,' ')
-*
- END
diff --git a/src/graflib/hplot/examples/hplex2.F b/src/graflib/hplot/examples/hplex2.F
deleted file mode 100644
index f49bc3c..0000000
--- a/src/graflib/hplot/examples/hplex2.F
+++ /dev/null
@@ -1,36 +0,0 @@
-*
-* $Id: hplex2.F,v 1.1.1.1 1996/01/19 10:50:12 mclareni Exp $
-*
-* $Log: hplex2.F,v $
-* Revision 1.1.1.1 1996/01/19 10:50:12 mclareni
-* Hplot
-*
-*
-#include "hplot/pilot.h"
-*CMZ : 5.13/00 02/07/92 10.01.41 by O.Couet
-*-- Author :
- SUBROUTINE HPLEX2
-*.==========>
-*. Examples of basic HPLOT : 2-DIM histograms
-*..=========>
-*
- CALL HTITLE('EXAMPLE NO = 2')
-*
- CALL HPLSIZ(14.,14.,' ')
- CALL HPLSET('YGTI',0.3)
- CALL HPLSET('XMGL',1.)
- CALL HPLSET('YMGL',1.)
- CALL HPLSET('XMGR',1.)
- CALL HPLSET('YMGU',1.)
- CALL HPLSET('VSIZ',0.2)
- CALL HPLSET('YHTI',0.6)
- CALL IGSET('MTYP',1.)
- CALL HPLOT(200,' ',' ',0)
- CALL HPLCON(200,10,1)
- CALL HPLSET('XMGL',1.5)
- CALL HPLSET('YMGL',2.0)
- CALL HPLSET('YHTI',1.5)
- CALL HPLEGO(200,30.,30.)
- CALL HPLSUR(200,30.,30.,1)
-*
- END
diff --git a/src/graflib/hplot/examples/hplex3.F b/src/graflib/hplot/examples/hplex3.F
deleted file mode 100644
index 19a4f5d..0000000
--- a/src/graflib/hplot/examples/hplex3.F
+++ /dev/null
@@ -1,39 +0,0 @@
-*
-* $Id: hplex3.F,v 1.1.1.1 1996/01/19 10:50:12 mclareni Exp $
-*
-* $Log: hplex3.F,v $
-* Revision 1.1.1.1 1996/01/19 10:50:12 mclareni
-* Hplot
-*
-*
-#include "hplot/pilot.h"
-*CMZ : 5.13/00 02/07/92 10.00.55 by O.Couet
-*-- Author :
- SUBROUTINE HPLEX3
-*.==========>
-*. Examples of HPLOT options
-*..=========>
-*
- CALL HTITLE('EXAMPLE NO = 3')
-*
- CALL HPLSIZ(14.5,20.,' ')
- CALL HPLSET('XMGL',1.0)
- CALL HPLSET('YMGL',1.0)
- CALL HPLSET('XMGR',1.0)
- CALL HPLSET('YMGU',1.0)
- CALL HPLSET('YHTI',0.6)
- CALL HPLSET('GSIZ',0.5)
- CALL HOPERA(110,'+',110,120,0.5,0.)
- CALL HOPERA(120,'+',120,130,0.5,0.)
- CALL HPLSET('PASS',5.)
- CALL HPLSET('CSHI',0.03)
- CALL HPLSET('XVAL',0.15)
- CALL HPLOPT('TIC ',1)
- CALL HPLOT(110,' ',' ',0)
- CALL HPLSET('HTYP',245.)
- CALL HPLOT(120,'S',' ',0)
- CALL HPLSET('HTYP',254.)
- CALL HPLOT(130,'S',' ',0)
- CALL HPLSOF(7.,12.,'LEP4 Very Preliminary',0.5,45.,99.,-1)
-*
- END
diff --git a/src/graflib/hplot/examples/hplex4.F b/src/graflib/hplot/examples/hplex4.F
deleted file mode 100644
index 7d57106..0000000
--- a/src/graflib/hplot/examples/hplex4.F
+++ /dev/null
@@ -1,48 +0,0 @@
-*
-* $Id: hplex4.F,v 1.1.1.1 1996/01/19 10:50:12 mclareni Exp $
-*
-* $Log: hplex4.F,v $
-* Revision 1.1.1.1 1996/01/19 10:50:12 mclareni
-* Hplot
-*
-*
-#include "hplot/pilot.h"
-*CMZ : 5.13/00 01/07/92 16.13.04 by O.Couet
-*-- Author :
- SUBROUTINE HPLEX4
-*.==========>
-*. Examples of HPLOT options
-*..=========>
-*
- DIMENSION X(100),Y(100),EX(100),EY(100)
-*
- CALL HTITLE('EXAMPLE NO = 4')
-*
- CALL HCOPY(110,310,' ')
- CALL HRESET(310,' ')
- CALL HPLSET('XMGL',1.)
- CALL HPLSET('YMGL',1.)
- CALL HPLSET('XMGR',1.)
- CALL HPLSET('YMGU',1.)
- CALL HPLSET('VSIZ',0.2)
- CALL HPLSET('XVAL',0.15)
- CALL HPLSET('YGTI',0.3)
- CALL HPLSET('YHTI',0.6)
- CALL HPLSIZ(14.5,21.,' ')
- CALL HPLZON(1,2,1,' ')
- CALL HMAXIM(310,200.)
- CALL HMINIM(310,-25.)
- CALL HPLOT(310,' ',' ',0)
- CALL HREBIN(110,X,Y,EX,EY,50,1,100)
- CALL HPLERR(X,Y,EX,EY,48,' ',25,0.15)
- CALL HPLKEY(9.,18.,25,'p,K^+!,K^-!,[S,W')
-*
- CALL HPLOT(310,' ',' ',0)
- CALL HREBIN(110,X,Y,EX,EY,20,1,100)
- CALL HPLERR(X,Y,EX,EY,20,' ',22,0.2)
- CALL HPLKEY(9.,8.,22,'[p^+!,p^-!,m^+!,m^-')
- CALL HDELET(120)
- CALL HDELET(130)
- CALL HDELET(310)
-*
- END
diff --git a/src/graflib/hplot/examples/hplex5.F b/src/graflib/hplot/examples/hplex5.F
deleted file mode 100644
index 9ba0388..0000000
--- a/src/graflib/hplot/examples/hplex5.F
+++ /dev/null
@@ -1,46 +0,0 @@
-*
-* $Id: hplex5.F,v 1.1.1.1 1996/01/19 10:50:12 mclareni Exp $
-*
-* $Log: hplex5.F,v $
-* Revision 1.1.1.1 1996/01/19 10:50:12 mclareni
-* Hplot
-*
-*
-#include "hplot/pilot.h"
-*CMZ : 5.13/00 01/07/92 16.13.04 by O.Couet
-*-- Author :
- SUBROUTINE HPLEX5
-*.==========>
-*. Examples of HPLOT options (BARS)
-*..=========>
-*
- DIMENSION XALL(12),XFEM(12)
- DATA XALL/
- +100.,200.,300.,500.,400.,700.,600.,400.,500.,300.,200.,100./
- DATA XFEM/
- + 70.,220.,330.,480.,440.,650.,300.,100.,200.,300.,200.,300./
-*
- CALL HTITLE('EXAMPLE NO = 5')
-*
- CALL HPLSET('YGTI',0.3)
- CALL HPLSIZ(14.5,21.,' ')
- CALL HPLZON(1,2,1,' ')
- CALL HBOOK1(1,'Distribution of grades (males)',12,2.,14.,0.)
- CALL HPAK(1,XALL)
- CALL HPLOPT('BAR ',1)
- CALL HPLSET('HTYP',188.)
- CALL HPLOT(1,' ',' ',0)
- CALL HRESET(1,'(Males and Females)')
- CALL HPAK(1,XALL)
- CALL HPLSET('BARO',0.)
- CALL HPLSET('BARW',0.3)
- CALL HPLOT(1,' ',' ',0)
- CALL HPLSET('HTYP',211.)
- CALL HPLSET('BARO',0.4)
- CALL HPAK(1,XFEM)
- CALL HPLOT(1,'SAME',' ',0)
- CALL HPLOPT('NBAR',1)
- CALL HDELET(1)
- CALL HPLSET('*',0.)
-*
- END
diff --git a/src/graflib/hplot/examples/hplex6.F b/src/graflib/hplot/examples/hplex6.F
deleted file mode 100644
index bf72c5f..0000000
--- a/src/graflib/hplot/examples/hplex6.F
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: hplex6.F,v 1.1.1.1 1996/01/19 10:50:12 mclareni Exp $
-*
-* $Log: hplex6.F,v $
-* Revision 1.1.1.1 1996/01/19 10:50:12 mclareni
-* Hplot
-*
-*
-#include "hplot/pilot.h"
-*CMZ : 5.13/00 01/07/92 16.13.04 by O.Couet
-*-- Author :
- SUBROUTINE HPLEX6
-*.==========>
-*. Examples of HPLOT using GKS metafiles or HIGZ files
-*..=========>
-*
- CALL HPLEX1
- CALL HPLEX2
- CALL HPLEX3
- CALL HPLEX4
- CALL HPLEX5
- CALL HPLNUL
-*
- END
diff --git a/src/graflib/hplot/examples/hplex7.F b/src/graflib/hplot/examples/hplex7.F
deleted file mode 100644
index 6393dab..0000000
--- a/src/graflib/hplot/examples/hplex7.F
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: hplex7.F,v 1.1.1.1 1996/01/19 10:50:12 mclareni Exp $
-*
-* $Log: hplex7.F,v $
-* Revision 1.1.1.1 1996/01/19 10:50:12 mclareni
-* Hplot
-*
-*
-#include "hplot/pilot.h"
-*CMZ : 5.13/00 01/07/92 16.13.04 by O.Couet
-*-- Author :
- SUBROUTINE HPLEX7
-*.==========>
-*. Examples of HPLOT playing back HIGZ files
-*..=========>
- CHARACTER*10 STR
- DATA ICYCLE/999/
-*
- CALL RZLDIR(' ',' ')
- CALL IGSET('AURZ',0.)
- CALL IZIN('PICT1',ICYCLE)
- CALL IZPICT('PICT1','D')
- CALL IRQST(1,1,ISTAT,NCH,STR)
- CALL IZIN('PICT8',ICYCLE)
- CALL IZPICT('PICT8','D')
- CALL IRQST(1,1,ISTAT,NCH,STR)
- CALL IZIN('PICT9',ICYCLE)
- CALL IZPICT('PICT9','D')
- CALL IRQST(1,1,ISTAT,NCH,STR)
-*
- END
diff --git a/src/graflib/hplot/examples/hplexam.F b/src/graflib/hplot/examples/hplexam.F
deleted file mode 100644
index 645de69..0000000
--- a/src/graflib/hplot/examples/hplexam.F
+++ /dev/null
@@ -1,124 +0,0 @@
-*
-* $Id: hplexam.F,v 1.3 1998/01/30 15:24:59 couet Exp $
-*
-* $Log: hplexam.F,v $
-* Revision 1.3 1998/01/30 15:24:59 couet
-* - APOLLO version removed
-*
-* Revision 1.2 1997/03/14 14:24:06 mclareni
-* WNT mods
-*
-* Revision 1.1.1.1.2.1 1997/01/21 11:25:41 mclareni
-* All mods for Winnt 96a on winnt branch
-*
-* Revision 1.1.1.1 1996/01/19 10:50:12 mclareni
-* Hplot
-*
-*
-#include "hplot/pilot.h"
-*CMZ : 5.13/00 01/07/92 16.13.03 by O.Couet
-*-- Author : O.Couet 30/05/91
- PROGRAM HPLEXA
-*.==========>
-*. HPLOT TEST PROGRAM
-*..=========>
- CHARACTER*(*) HZFILE,HPFILE
-#if defined(CERNLIB_IBM)
- PARAMETER (HZFILE='/HPLOT HIGZ')
-#endif
-#if (defined(CERNLIB_IBM))&&(!defined(CERNLIB_PSCRIPT))
- PARAMETER (HPFILE='/HPLOT METAFILE')
-#endif
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB_PSCRIPT))
- PARAMETER (HPFILE='/HPLOT PS')
-#endif
-#if !defined(CERNLIB_IBM)
- PARAMETER (HZFILE='hplot.higz')
-#endif
-#if (!defined(CERNLIB_IBM))&&(!defined(CERNLIB_PSCRIPT))
- PARAMETER (HPFILE='hplot.metafile')
-#endif
-#if (!defined(CERNLIB_IBM))&&(defined(CERNLIB_PSCRIPT))
- PARAMETER (HPFILE='hplot.ps')
-#endif
- COMMON/PAWC/H(100000)
- LOGICAL INTRAC
-*.___________________________________________
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB_X11))
- CALL INITC
-#endif
-#if defined(CERNLIB_UNIX)||defined(CERNLIB_IBM)||defined(CERNLIB_CRAY)
- OPEN(UNIT= 1,FILE=HZFILE,FORM='UNFORMATTED',RECL=4096,
- + ACCESS='DIRECT',STATUS='UNKNOWN')
-#endif
-#if defined(CERNLIB_VAX)
- OPEN(UNIT=1,FILE=HZFILE,FORM='UNFORMATTED',RECL=1024,
- + ACCESS='DIRECT',SHARED,STATUS='UNKNOWN')
-#endif
-#if !defined(CERNLIB_VAX)
- OPEN(UNIT=10,FILE=HPFILE,FORM='FORMATTED',STATUS='UNKNOWN')
-#endif
-#if defined(CERNLIB_VAX)
- OPEN(UNIT=10,FILE=HPFILE,FORM='FORMATTED',SHARED,
- + STATUS='UNKNOWN')
-#endif
- IF(.NOT.INTRAC())THEN
- KWTYPE=0
- ELSE
- CALL IGWKTY(KWTYPE)
- ENDIF
- CALL TIMED(T0)
- CALL HLIMIT(100000)
- CALL HPLINT(KWTYPE)
- CALL HPLMAK
- IF(KWTYPE.NE.0)THEN
- CALL HPLOPT('PTO ',1)
- CALL HPLEX1
- CALL TIMED(T1)
- PRINT *, ' TIME FOR EXAMPLE 1 =',T1,' SECONDS'
- CALL HPLEX2
- CALL TIMED(T2)
- PRINT *, ' TIME FOR EXAMPLE 2 =',T2,' SECONDS'
- CALL HPLEX3
- CALL TIMED(T3)
- PRINT *, ' TIME FOR EXAMPLE 3 =',T3,' SECONDS'
- CALL HPLEX4
- CALL TIMED(T4)
- PRINT *, ' TIME FOR EXAMPLE 4 =',T4,' SECONDS'
- CALL HPLEX5
- CALL TIMED(T5)
- PRINT *, ' TIME FOR EXAMPLE 5 =',T5,' SECONDS'
- ENDIF
- CALL HPLOPT('NPTO',1)
-*
-* Open HIGZ metafile
-* and repeat previous examples
-*
- PRINT *,' WRITING HIGZ PICTURE FILE'
- CALL IGZSET('Z')
- CALL IZFILE(1,'HPLOT','NA')
- CALL HPLOPT('ZFL ',1)
- CALL HPLEX6
- CALL TIMED(T6)
- PRINT *, ' TIME TO WRITE HIGZ PICTURE FILE =',T6,' SECONDS'
-*
-* Open a GKS or PostScript metafile
-* and repeat previous examples
-*
- PRINT *,' WRITING METAFILE (BE PATIENT !)'
- CALL IGZSET('G')
- CALL HPLOPT('NZFL',1)
- CALL HPLCAP(-10)
- CALL HPLEX6
- CALL TIMED(T7)
- PRINT *, ' TIME TO WRITE METAFILE =',T7,' SECONDS'
-*
-* Replay some pictures from the HIGZ picture file
-*
- IF(KWTYPE.NE.0)THEN
- CALL HPLCAP(0)
- CALL HPLEX7
- ENDIF
-*
- CALL HPLEND
- END
diff --git a/src/graflib/hplot/examples/hplmak.F b/src/graflib/hplot/examples/hplmak.F
deleted file mode 100644
index 389dabc..0000000
--- a/src/graflib/hplot/examples/hplmak.F
+++ /dev/null
@@ -1,57 +0,0 @@
-*
-* $Id: hplmak.F,v 1.1.1.1 1996/01/19 10:50:12 mclareni Exp $
-*
-* $Log: hplmak.F,v $
-* Revision 1.1.1.1 1996/01/19 10:50:12 mclareni
-* Hplot
-*
-*
-#include "hplot/pilot.h"
-*CMZ : 5.14/07 22/09/92 17.33.01 by O.Couet
-*-- Author :
- SUBROUTINE HPLMAK
-*.==========>
-*. Creation of some histograms (based on HBOOK examples)
-*..=========>
- COMMON/HEX2/C1,C2,XM1,XM2,XS1,XS2
- EXTERNAL HTFUN1,HTFUN2
-*.___________________________________________
-*
-* BOOKING
-*
- C1=1.
- C2=0.5
- XM1=0.3
- XM2=0.7
- XS1=0.07
- XS2=0.12
-*
- CALL HBFUN1(100,'TEST OF HRNDM1',100,0.,1.,HTFUN1)
-*
- CALL HBOOK1(110,'Test of 1-DIM plots',100,0.,1.,1000.)
-*
- CALL HBFUN2(200,'Test of 2-DIM plots',40,0.,1.,40,0.,1.,HTFUN2)
- CALL HSCALE(200,0.)
-*
-* FILLING
-*
- DO 10 I=1,5000
- X=HRNDM1(100)
- CALL HFILL(110,X,0.,1.)
- 10 CONTINUE
-*
- END
- FUNCTION HTFUN1(X)
- COMMON/HEX2/C1,C2,XM1,XM2,XS1,XS2
-*
- A1=-0.5*((X-XM1)/XS1)**2
- A2=-0.5*((X-XM2)/XS2)**2
- X1=C1
- X2=C2
- IF(ABS(A1).GT.1.E-4)X1=C1*EXP(A1)
- IF(ABS(A2).GT.1.E-4)X2=C2*EXP(A2)
- HTFUN1=X1+X2
- END
- FUNCTION HTFUN2(X,Y)
- HTFUN2=HTFUN1(X)*HTFUN1(Y)
- END
diff --git a/src/graflib/hplot/hplot/Imakefile b/src/graflib/hplot/hplot/Imakefile
deleted file mode 100644
index 172e664..0000000
--- a/src/graflib/hplot/hplot/Imakefile
+++ /dev/null
@@ -1,5 +0,0 @@
-INCLUDES= hpl0.inc hpl1.inc hpl11.inc \ @@\
- hpl12.inc hpl13.inc hpl14.inc hpl2.inc hpl3.inc hpl4.inc \ @@\
- hpl6.inc hpl9.inc hplstr.inc quest.inc pilot.h
-
-InstallIncludes($(INCLUDES),$(CERN_INCLUDEDIR),hplot)
diff --git a/src/graflib/hplot/hplot/hilabs.inc b/src/graflib/hplot/hplot/hilabs.inc
deleted file mode 100644
index 87ecf29..0000000
--- a/src/graflib/hplot/hplot/hilabs.inc
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: hilabs.inc,v 1.1.1.1 1996/01/19 10:50:15 mclareni Exp $
-*
-* $Log: hilabs.inc,v $
-* Revision 1.1.1.1 1996/01/19 10:50:15 mclareni
-* Hplot
-*
-*
-#ifndef CERNLIB_HPLOT_HILABS_INC
-#define CERNLIB_HPLOT_HILABS_INC
-*
-*
-* hilabs.inc
-*
-*CMZ : 09/11/95 17.18.57 by O.Couet
-*-- Author :
- PARAMETER (MAXLAB=100)
- CHARACTER*32 HILABS
- COMMON/HILBL1/NHILAB
- COMMON/HILBL2/HILABS(MAXLAB)
-
-#endif
diff --git a/src/graflib/hplot/hplot/himeta.inc b/src/graflib/hplot/hplot/himeta.inc
deleted file mode 100644
index 52cfc2c..0000000
--- a/src/graflib/hplot/hplot/himeta.inc
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: himeta.inc,v 1.1.1.1 1996/01/19 10:50:15 mclareni Exp $
-*
-* $Log: himeta.inc,v $
-* Revision 1.1.1.1 1996/01/19 10:50:15 mclareni
-* Hplot
-*
-*
-#ifndef CERNLIB_HPLOT_HIMETA_INC
-#define CERNLIB_HPLOT_HIMETA_INC
-*
-*
-* himeta.inc
-*
-*CMZ : 09/11/95 17.18.57 by O.Couet
-*-- Author :
- COMMON /HIMETA/ IDMETA,XMFACT,YMFACT,TEKACT,METACT,FILOPN
- LOGICAL TEKACT,METACT,FILOPN
-
-#endif
diff --git a/src/graflib/hplot/hplot/hpl0.inc b/src/graflib/hplot/hplot/hpl0.inc
deleted file mode 100644
index 8cf0835..0000000
--- a/src/graflib/hplot/hplot/hpl0.inc
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: hpl0.inc,v 1.1.1.1 1996/01/19 10:50:14 mclareni Exp $
-*
-* $Log: hpl0.inc,v $
-* Revision 1.1.1.1 1996/01/19 10:50:14 mclareni
-* Hplot
-*
-*
-#ifndef CERNLIB_HPLOT_HPL0_INC
-#define CERNLIB_HPLOT_HPL0_INC
-*
-*
-* hpl0.inc
-*
-*CMZ : 5.16/00 20/04/93 13.13.43 by O.Couet
-*-- Author :
- COMMON/HPL0/PNAME
- CHARACTER*16 PNAME
- COMMON/PICDES/IPICT
- DIMENSION IPICT(100,3)
-
-#endif
diff --git a/src/graflib/hplot/hplot/hpl1.inc b/src/graflib/hplot/hplot/hpl1.inc
deleted file mode 100644
index 95b6214..0000000
--- a/src/graflib/hplot/hplot/hpl1.inc
+++ /dev/null
@@ -1,39 +0,0 @@
-*
-* $Id: hpl1.inc,v 1.1.1.1 1996/01/19 10:50:14 mclareni Exp $
-*
-* $Log: hpl1.inc,v $
-* Revision 1.1.1.1 1996/01/19 10:50:14 mclareni
-* Hplot
-*
-*
-#ifndef CERNLIB_HPLOT_HPL1_INC
-#define CERNLIB_HPLOT_HPL1_INC
-*
-*
-* hpl1.inc
-*
-*CMZ : 09/11/95 10.56.43 by O.Couet
-*-- Author : O.Couet
- COMMON/HPL1/IPLTNO,IPLNUM,IVSIZE,ICMDUM,IOPAGE,IPGSIZ
- + ,ILTYP ,IGTYP ,ICOLMP,IDATE ,IFILE ,ISTAT ,IFIT
- + ,IHTYP ,IBTYP ,IPTYP ,IFTYP
- + ,RBCOL ,IBCOL ,IBBCOL,ISBCOL,ISSCOL
- + ,RHCOL ,IHCOL ,IHBCOL,IHLIST
- + ,IFCOL ,IFBCOL,IXCOL ,IYCOL
- + ,IPCOL ,IPBCOL
- + ,IHWID ,IBWID ,IPWID ,IFWID ,IXWID ,IYWID ,CWID
- + ,CPASS ,CSHIFT,DLEN ,ROFFS ,RWDTH ,ILTSAM,RERRX
- + ,IDEF1D,IDEF2D
- + ,LOSAME,LOSLIC,LOWIND,LOGXFL,LOGYFL,LOGZFL,LOZERO,LOCM
- + ,LOVERT,LOEAH ,LOCHA ,LOASTK,LOSOFT,LOSQR ,LOUTIT,LOTAB
- + ,LOBOX ,LOTIC ,LOSTAT,LOFIT ,LOZFL ,LOPTO ,LOBAR ,LODVXI
- + ,LODVYI,LOGRID,LODATE,LOFILE,LWSAME,LTYPFL,LOMAX ,LOZOOM
- + ,LOZFL1,LOHBOX,LOGTIT,LO3DPL
- LOGICAL
- + LOSAME,LOSLIC,LOWIND,LOGXFL,LOGYFL,LOGZFL,LOZERO,LOCM
- + ,LOVERT,LOEAH ,LOCHA ,LOASTK,LOSOFT,LOSQR ,LOUTIT,LOTAB
- + ,LOBOX ,LOTIC ,LOSTAT,LOFIT ,LOZFL ,LOPTO ,LOBAR ,LODVXI
- + ,LODVYI,LOGRID,LODATE,LOFILE,LWSAME,LTYPFL,LOMAX ,LOZOOM
- + ,LOZFL1,LOHBOX,LOGTIT,LO3DPL
-
-#endif
diff --git a/src/graflib/hplot/hplot/hpl11.inc b/src/graflib/hplot/hplot/hpl11.inc
deleted file mode 100644
index eb44878..0000000
--- a/src/graflib/hplot/hplot/hpl11.inc
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: hpl11.inc,v 1.1.1.1 1996/01/19 10:50:15 mclareni Exp $
-*
-* $Log: hpl11.inc,v $
-* Revision 1.1.1.1 1996/01/19 10:50:15 mclareni
-* Hplot
-*
-*
-#ifndef CERNLIB_HPLOT_HPL11_INC
-#define CERNLIB_HPLOT_HPL11_INC
-*
-*
-* hpl11.inc
-*
-*CMZ : 09/11/95 17.18.57 by O.Couet
-*-- Author :
- PARAMETER (NMAX=1002)
- COMMON/HPL11/XLINE(NMAX),YLINE(NMAX)
-
-#endif
diff --git a/src/graflib/hplot/hplot/hpl12.inc b/src/graflib/hplot/hplot/hpl12.inc
deleted file mode 100644
index 3679a1b..0000000
--- a/src/graflib/hplot/hplot/hpl12.inc
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: hpl12.inc,v 1.1.1.1 1996/01/19 10:50:15 mclareni Exp $
-*
-* $Log: hpl12.inc,v $
-* Revision 1.1.1.1 1996/01/19 10:50:15 mclareni
-* Hplot
-*
-*
-#ifndef CERNLIB_HPLOT_HPL12_INC
-#define CERNLIB_HPLOT_HPL12_INC
-*
-*
-* hpl12.inc
-*
-*CMZ : 09/11/95 17.18.57 by O.Couet
-*-- Author :
- COMMON/HPL12/XMAX,YMAX,XVP1,XVP2,YVP1,YVP2
-
-#endif
diff --git a/src/graflib/hplot/hplot/hpl13.inc b/src/graflib/hplot/hplot/hpl13.inc
deleted file mode 100644
index 442c84f..0000000
--- a/src/graflib/hplot/hplot/hpl13.inc
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: hpl13.inc,v 1.1.1.1 1996/01/19 10:50:15 mclareni Exp $
-*
-* $Log: hpl13.inc,v $
-* Revision 1.1.1.1 1996/01/19 10:50:15 mclareni
-* Hplot
-*
-*
-#ifndef CERNLIB_HPLOT_HPL13_INC
-#define CERNLIB_HPLOT_HPL13_INC
-*
-*
-* hpl13.inc
-*
-*CMZ : 09/11/95 17.18.57 by O.Couet
-*-- Author :
- PARAMETER (NOPT=6)
- COMMON/HPL13/IOPT(NOPT),IHOPT(6),IDZB,IDZK,LIPTOL,LOSCAL
- +, IOPTF,IOPT0,IOPTH
- LOGICAL LOSCAL
- EQUIVALENCE (IOPTS ,IOPT(1)),(IOPTU ,IOPT(2))
- EQUIVALENCE (IOPTK ,IOPT(3)),(IOPTP ,IOPT(4))
- EQUIVALENCE (IOPTE ,IOPT(5)),(IOPTA ,IOPT(6))
- EQUIVALENCE (IHOPTL ,IHOPT(1)),(IHOPTC ,IHOPT(2))
- EQUIVALENCE (IHOPTT ,IHOPT(3)),(IHOPTP ,IHOPT(4))
- EQUIVALENCE (IHOPTB ,IHOPT(5)),(IHOPTH,IHOPT(6))
-
-#endif
diff --git a/src/graflib/hplot/hplot/hpl14.inc b/src/graflib/hplot/hplot/hpl14.inc
deleted file mode 100644
index 94f1c6b..0000000
--- a/src/graflib/hplot/hplot/hpl14.inc
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: hpl14.inc,v 1.1.1.1 1996/01/19 10:50:15 mclareni Exp $
-*
-* $Log: hpl14.inc,v $
-* Revision 1.1.1.1 1996/01/19 10:50:15 mclareni
-* Hplot
-*
-*
-#ifndef CERNLIB_HPLOT_HPL14_INC
-#define CERNLIB_HPLOT_HPL14_INC
-*
-*
-* hpl14.inc
-*
-*CMZ : 09/11/95 17.18.57 by O.Couet
-*-- Author :
- PARAMETER (MXLIST=50,NBLIST=9)
- COMMON /HPL14/ LSTTYP(NBLIST),NBEL(NBLIST),ILIST(NBLIST,MXLIST)
-
-#endif
diff --git a/src/graflib/hplot/hplot/hpl2.inc b/src/graflib/hplot/hplot/hpl2.inc
deleted file mode 100644
index c23874b..0000000
--- a/src/graflib/hplot/hplot/hpl2.inc
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: hpl2.inc,v 1.1.1.1 1996/01/19 10:50:14 mclareni Exp $
-*
-* $Log: hpl2.inc,v $
-* Revision 1.1.1.1 1996/01/19 10:50:14 mclareni
-* Hplot
-*
-*
-#ifndef CERNLIB_HPLOT_HPL2_INC
-#define CERNLIB_HPLOT_HPL2_INC
-*
-*
-* hpl2.inc
-*
-*CMZ : 09/11/95 17.18.57 by O.Couet
-*-- Author :
- COMMON/HPL2/XLOW ,XHIGH ,YLOW ,YHIGH ,XFRAC ,YFRAC ,YMMAX
- + ,YMMIN ,IOFSET,XWDIST,YWDIST,XWIND ,YWIND ,SCMAX ,IXWIN
- + ,IYWIN ,IWIN ,ISLIC
- + ,NCX
- + ,IWIN0 ,NTWIN ,NTHIST ,NCHIST
-
-#endif
diff --git a/src/graflib/hplot/hplot/hpl3.inc b/src/graflib/hplot/hplot/hpl3.inc
deleted file mode 100644
index 00e7259..0000000
--- a/src/graflib/hplot/hplot/hpl3.inc
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: hpl3.inc,v 1.1.1.1 1996/01/19 10:50:14 mclareni Exp $
-*
-* $Log: hpl3.inc,v $
-* Revision 1.1.1.1 1996/01/19 10:50:14 mclareni
-* Hplot
-*
-*
-#ifndef CERNLIB_HPLOT_HPL3_INC
-#define CERNLIB_HPLOT_HPL3_INC
-*
-*
-* hpl3.inc
-*
-*CMZ : 09/11/95 17.18.57 by O.Couet
-*-- Author :
- COMMON/HPL3/LINX,LINY,LOGX,LOGY,LINZ,LOGZ
-
-#endif
diff --git a/src/graflib/hplot/hplot/hpl4.inc b/src/graflib/hplot/hplot/hpl4.inc
deleted file mode 100644
index c6a8264..0000000
--- a/src/graflib/hplot/hplot/hpl4.inc
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: hpl4.inc,v 1.1.1.1 1996/01/19 10:50:15 mclareni Exp $
-*
-* $Log: hpl4.inc,v $
-* Revision 1.1.1.1 1996/01/19 10:50:15 mclareni
-* Hplot
-*
-*
-#ifndef CERNLIB_HPLOT_HPL4_INC
-#define CERNLIB_HPLOT_HPL4_INC
-*
-*
-* hpl4.inc
-*
-*CMZ : 09/11/95 17.18.14 by O.Couet
-*-- Author :
- COMMON /HPL4/ XSIZ ,YSIZ ,XMLEFT,XMRIT ,XLABEL,XLVAL ,XLTICK,
- + YMGLOW,YMGUP ,YLABEL,YLVAL ,YLTICK,YNPAGE,YGTIT ,
- + YHTIT ,SMRIT ,SMGUP ,CMMG ,CLVAL ,XYTWN ,DXWN ,
- + DYWN
-
-#endif
diff --git a/src/graflib/hplot/hplot/hpl6.inc b/src/graflib/hplot/hplot/hpl6.inc
deleted file mode 100644
index 10a8567..0000000
--- a/src/graflib/hplot/hplot/hpl6.inc
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: hpl6.inc,v 1.1.1.1 1996/01/19 10:50:15 mclareni Exp $
-*
-* $Log: hpl6.inc,v $
-* Revision 1.1.1.1 1996/01/19 10:50:15 mclareni
-* Hplot
-*
-*
-#ifndef CERNLIB_HPLOT_HPL6_INC
-#define CERNLIB_HPLOT_HPL6_INC
-*
-*
-* hpl6.inc
-*
-*CMZ : 09/11/95 17.18.57 by O.Couet
-*-- Author :
- COMMON /HPL6/TVSIZ(9),IHFONT(5)
-
-#endif
diff --git a/src/graflib/hplot/hplot/hpl9.inc b/src/graflib/hplot/hplot/hpl9.inc
deleted file mode 100644
index d6099d1..0000000
--- a/src/graflib/hplot/hplot/hpl9.inc
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: hpl9.inc,v 1.1.1.1 1996/01/19 10:50:15 mclareni Exp $
-*
-* $Log: hpl9.inc,v $
-* Revision 1.1.1.1 1996/01/19 10:50:15 mclareni
-* Hplot
-*
-*
-#ifndef CERNLIB_HPLOT_HPL9_INC
-#define CERNLIB_HPLOT_HPL9_INC
-*
-*
-* hpl9.inc
-*
-*CMZ : 09/11/95 17.18.57 by O.Couet
-*-- Author :
- COMMON/HPL9/FACTOR,XXSIZE,XX0 ,ICMAX ,ICMAY ,NCMIN, NCMAX
- + ,YMINI ,YMAXI ,XMINI ,XMAXI
- + ,YWMINI ,YWMAXI ,XWMINI ,XWMAXI
- + ,RDIVX ,RDIVY ,RDIVZ
- + ,IHSLY1,IHSLY2,IHSLY3,IHSLY4
-
-#endif
diff --git a/src/graflib/hplot/hplot/hplstr.inc b/src/graflib/hplot/hplot/hplstr.inc
deleted file mode 100644
index c93ea5c..0000000
--- a/src/graflib/hplot/hplot/hplstr.inc
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: hplstr.inc,v 1.1.1.1 1996/01/19 10:50:14 mclareni Exp $
-*
-* $Log: hplstr.inc,v $
-* Revision 1.1.1.1 1996/01/19 10:50:14 mclareni
-* Hplot
-*
-*
-#ifndef CERNLIB_HPLOT_HPLSTR_INC
-#define CERNLIB_HPLOT_HPLSTR_INC
-*
-*
-* hplstr.inc
-*
-*CMZ : 5.18/14 30/06/94 12.05.53 by O.Couet
-*-- Author : O.Couet 30/06/94
- PARAMETER (ISTRSZ = 324)
- COMMON /HPLSTR/ CHTEMP
- CHARACTER*(ISTRSZ) CHTEMP
-
-#endif
diff --git a/src/graflib/hplot/hplot/pilot.h b/src/graflib/hplot/hplot/pilot.h
deleted file mode 100644
index df4daba..0000000
--- a/src/graflib/hplot/hplot/pilot.h
+++ /dev/null
@@ -1,5 +0,0 @@
-#if (defined(CERNLIB_UNIX))||(!defined(CERNLIB_SINGLE))
-#ifndef CERNLIB_DOUBLE
-#define CERNLIB_DOUBLE
-#endif
-#endif
diff --git a/src/graflib/hplot/hplot/quest.inc b/src/graflib/hplot/hplot/quest.inc
deleted file mode 100644
index 1e1c65e..0000000
--- a/src/graflib/hplot/hplot/quest.inc
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: quest.inc,v 1.1.1.1 1996/01/19 10:50:14 mclareni Exp $
-*
-* $Log: quest.inc,v $
-* Revision 1.1.1.1 1996/01/19 10:50:14 mclareni
-* Hplot
-*
-*
-#ifndef CERNLIB_HPLOT_QUEST_INC
-#define CERNLIB_HPLOT_QUEST_INC
-*
-*
-* quest.inc
-*
-*CMZ : 5.16/00 20/04/93 13.13.43 by O.Couet
-*-- Author :
- COMMON /QUEST/IQUEST(100)
- DIMENSION RQUEST(100)
- EQUIVALENCE(IQUEST(1),RQUEST(1))
-
-#endif
diff --git a/src/graflib/hplot/hplotcc/Imakefile b/src/graflib/hplot/hplotcc/Imakefile
deleted file mode 100644
index 23f8294..0000000
--- a/src/graflib/hplot/hplotcc/Imakefile
+++ /dev/null
@@ -1,3 +0,0 @@
-SRCS_C= hplvers.c
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/graflib/hplot/hplotcc/hplvers.c b/src/graflib/hplot/hplotcc/hplvers.c
deleted file mode 100644
index 638791f..0000000
--- a/src/graflib/hplot/hplotcc/hplvers.c
+++ /dev/null
@@ -1,75 +0,0 @@
-/*
- * $Id: hplvers.c,v 1.19 2002/11/12 15:34:33 couet Exp $
- *
- * $Log: hplvers.c,v $
- * Revision 1.19 2002/11/12 15:34:33 couet
- * -5.24/02
- *
- * Revision 1.18 2002/05/21 13:00:14 couet
- * - mistake in the date
- *
- * Revision 1.17 2002/04/04 10:25:19 couet
- * - 5.24/01
- *
- * Revision 1.16 2001/12/07 15:49:50 couet
- * - 5.24/00
- *
- * Revision 1.15 2001/03/06 15:11:26 couet
- * - 5.23/04
- *
- * Revision 1.14 2000/09/06 09:46:13 couet
- * - 5.23/03
- *
- * Revision 1.13 2000/06/06 13:46:09 couet
- * - 5.23/02
- *
- * Revision 1.12 2000/04/10 13:54:09 couet
- * - 5.23/01
- *
- * Revision 1.11 2000/03/16 15:37:37 couet
- * - 5.23/00
- *
- * Revision 1.10 1999/05/18 09:00:40 couet
- * - 5.22/00
- *
- * Revision 1.9 1998/12/07 13:47:51 couet
- * - 5.21/04
- *
- * Revision 1.8 1998/12/02 15:08:55 couet
- * *** empty log message ***
- *
- * Revision 1.7 1998/12/02 15:08:14 couet
- * - 5.21/03
- *
- * Revision 1.6 1998/11/10 09:25:46 couet
- * - Y2K
- *
- * Revision 1.5 1998/10/26 16:48:34 couet
- * - 5.21/02
- *
- * Revision 1.4 1998/07/08 13:40:27 couet
- * - 5.21/01
- *
- * Revision 1.3 1998/06/02 09:21:17 couet
- * - vers ++
- *
- * Revision 1.2 1998/04/09 13:05:00 couet
- * - Compilation date removed from the vidqq string: it was meaningless
- *
- * Revision 1.1.1.1 1996/01/19 10:50:15 mclareni
- * Hplot
- *
- *-- Author : O.Couet 01/03/95
- */
-
-static char vidqq[] = "@(#)HPLOT 5.24/02 12/11/2002 16.30.00";
-
-/*
- * Return the static version string for HPLOT
- */
-
-char * hplvers()
-{
- /* skip the 4 char that contain the "what" string */
- return &vidqq[4];
-}
diff --git a/src/graflib/hplot/hplotf77/Imakefile b/src/graflib/hplot/hplotf77/Imakefile
deleted file mode 100644
index 0791516..0000000
--- a/src/graflib/hplot/hplotf77/Imakefile
+++ /dev/null
@@ -1,17 +0,0 @@
-SRCS_F= hplabl.F hplaer.F hplarc.F hplatt.F hplax.F hplax2.F hplaxi.F \ @@\
- hplbox.F hplc.F hplcap.F hplcha.F hplcol.F hplcom.F hplcon.F \ @@\
- hpldat.F hpldes.F hpldo.F hplego.F hplend.F hplerr.F \ @@\
- hplf.F hplfil.F hplfit.F hplfr3.F hplfra.F hplfun.F hplgiv.F \ @@\
- hplglb.F hplgtl.F hplgzo.F hplh.F hplhip.F hplhup.F hpli.F hpline.F \ @@\
- hplint.F hplist.F hplive.F hplj.F hplkey.F hpllgd.F hplnew.F \ @@\
- hplnot.F hplnt.F hplnul.F hplnxt.F hploc.F hplone.F hplopt.F \ @@\
- hplot.F hplpgn.F hplpro.F hplpto.F hplqop.F hplqse.F hplrdw.F \ @@\
- hplscm.F hplsel.F hplset.F hplsiz.F hplsof.F hplsta.F hplsur.F \ @@\
- hplswn.F hplsym.F hpltab.F hpltit.F hpltoc.F hpltx1.F hpltxt.F \ @@\
- hplu.F hplusr.F hplwin.F hplwir.F hplwn.F hplzom.F hplzon.F
-
-#ifdef CERNLIB_SGI
-SpecialFortranLibObjectRule(hplh,hplh,-O1,NullParameter)
-#endif
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/graflib/hplot/hplotf77/hplabl.F b/src/graflib/hplot/hplotf77/hplabl.F
deleted file mode 100644
index cb9224a..0000000
--- a/src/graflib/hplot/hplotf77/hplabl.F
+++ /dev/null
@@ -1,85 +0,0 @@
-*
-* $Id: hplabl.F,v 1.1.1.1 1996/01/19 10:49:57 mclareni Exp $
-*
-* $Log: hplabl.F,v $
-* Revision 1.1.1.1 1996/01/19 10:49:57 mclareni
-* Hplot
-*
-*
-#include "hplot/pilot.h"
-*CMZ : 5.18/16 25/08/94 15.51.16 by O.Couet
-*-- Author :
- SUBROUTINE HPLABL(NUM,NB,CHLAB)
-*.===========>
-*.
-*. This routine stores the label list number NUM. This routine limits
-*. the lenght of the alphanumeric labels at 32 characters.
-*.
-*. _Input parameters:
-*.
-*. INTEGER NUM : List number .
-*. INTEGER NB : Number of labels .
-*. CHARACTER CHLAB(NB) : List contents.
-*.
-*..==========> (O.Couet)
-#include "hbook/hcbook.inc"
-#include "hplot/quest.inc"
-#include "hplot/hplstr.inc"
- PARAMETER (LABLEN=32)
- CHARACTER*(*) CHLAB(*)
-*.______________________________________
-*
- IF (NB.LE.0) RETURN
- IF ((NUM.LT.1).OR.(NUM.GT.9)) THEN
- CALL HBUG('0 < NUM < 10','HPLABL',0)
- RETURN
- ENDIF
-*
- LW = LABLEN/4
- NCHP = LW*(NB+1)
- CHTEMP = ' '
-*
- CALL MZFORM('LABL','2I -H',IXIO)
- IF (LQ(LHPLOT-2).EQ.0)THEN
- CALL MZBOOK(IHDIV,LN,LHPLOT,-2,'LABL',0,0,NCHP,IXIO,0)
- IQ(LN+1) = NUM
- IQ(LN+2) = NB
- DO 10 I=1,NB
- CHTEMP = CHLAB(I)
- CALL UCTOH(CHTEMP,IQ(LN+3+(I-1)*LW),4,LABLEN)
- 10 CONTINUE
- ELSE
- LDROP = LQ(LHPLOT-2)
- 20 IF (IQ(LDROP+1).EQ.NUM) THEN
- CALL MZDROP(IHDIV,LDROP,' ')
- GOTO 30
- ELSE
- LDROP = LQ(LDROP)
- IF (LDROP.EQ.0) THEN
- GOTO 30
- ELSE
- GOTO 20
- ENDIF
- ENDIF
- 30 LEND = LQ(LHPLOT-2)
- IF (LEND.EQ.0) THEN
- CALL MZBOOK(IHDIV,LN,LHPLOT,-2,'LABL',0,0,NCHP,IXIO,0)
- ELSE
- 40 L1 = LQ(LEND)
- IF (L1.NE.0) THEN
- LEND = L1
- GOTO 40
- ELSE
- CALL MZBOOK(IHDIV,LN,LEND,0,'LABL',0,0,NCHP,IXIO,0)
- ENDIF
- ENDIF
- IQ(LN+1) = NUM
- IQ(LN+2) = NB
- DO 50 I=1,NB
- CHTEMP = CHLAB(I)
- CALL UCTOH(CHTEMP,IQ(LN+3+(I-1)*LW),4,LABLEN)
- 50 CONTINUE
- ENDIF
- IQUEST(1) = 0
-*
- END
diff --git a/src/graflib/hplot/hplotf77/hplaer.F b/src/graflib/hplot/hplotf77/hplaer.F
deleted file mode 100644
index 03133a5..0000000
--- a/src/graflib/hplot/hplotf77/hplaer.F
+++ /dev/null
@@ -1,440 +0,0 @@
-*
-* $Id: hplaer.F,v 1.4 2002/11/12 15:00:23 couet Exp $
-*
-* $Log: hplaer.F,v $
-* Revision 1.4 2002/11/12 15:00:23 couet
-* - EQUIVALENCE statement modified again. This version is more logical
-*
-* Revision 1.3 2002/11/12 14:56:52 couet
-* - Mistake in the EQUIVALENCE statement (side effect on the previous mod).
-* The two Y errors vectors were pointing on the same adress.
-*
-* Revision 1.2 2001/12/07 15:19:55 couet
-* - use higz include files from the higz include file directory.
-* option Z is now working in hplaer.F
-* option Z has been implemented in hplsym.F
-*
-* Revision 1.1.1.1 1996/01/19 10:49:57 mclareni
-* Hplot
-*
-*
-#include "hplot/pilot.h"
-*CMZ : 5.20/06 01/11/95 10.05.56 by O.Couet
-*-- Author :
- SUBROUTINE HPLAER(XU,YU,DXU1,DXU2,DYU1,DYU2,N,CHOPT,ISYMB,USIZE)
-*.==========>
-*.
-*. Draws asymetric error bars defined by the user symbol ISYMB is
-*. drawn at the centre of the errors according to CHOPT:
-*.
-*. ' ' Coordinates are expressed in histogram coordinates
-*. (of the last drawn histogram). Error bars are drawn.
-*. 'C' Coordinates are expressed in centimeters.
-*. '1' Small lines are drawn at the end of the error bars.
-*. '2' Error rectangles are drawn.
-*. '3' A filled area is drawn through the end points of the vertical
-*. error bars.
-*. '4' A smoothed filled area is drawn through the end points of the
-*. vertical error bars.
-*. '0' Turn off the symbols clipping.
-*. 'W' The window and the axis are drawn.
-*. 'H' The input data are ignored and the current histogram is used.
-*. 'Z' The vectors XU,YU,DXU1,DXU2,DYU1 and DYU2 are taken into PAWC at the
-*. adresses IQUEST(81) and IQUEST(86)
-*.
-*. If ISYMB = 0 or SSIZE = 0. no symbol is drawn
-*.
-*..=========>
-#include "hplot/hpl1.inc"
-#include "hplot/hpl2.inc"
-#include "hplot/hpl6.inc"
-#include "hplot/hpl9.inc"
-#include "hplot/hpl11.inc"
-#include "hbook/hcbook.inc"
-#include "hplot/quest.inc"
-#include "hbook/hcbits.inc"
-#include "hbook/hcprin.inc"
-#include "higz/hilink.inc"
- EQUIVALENCE (LXU,LSTACK(1)) ,(LYU,LSTACK(2))
- EQUIVALENCE (LDXU1,LSTACK(3)),(LDXU2,LSTACK(4))
- EQUIVALENCE (LDYU1,LSTACK(5)),(LDYU2,LSTACK(6))
- CHARACTER*(*) CHOPT
- DIMENSION IOPT(8)
- EQUIVALENCE (IOPTC,IOPT(1)),(IOPT1,IOPT(2))
- EQUIVALENCE (IOPT2,IOPT(3)),(IOPT0,IOPT(4))
- EQUIVALENCE (IOPT3,IOPT(5)),(IOPT4,IOPT(6))
- EQUIVALENCE (IOPTW,IOPT(7)),(IOPTH,IOPT(8))
- LOGICAL LERR,DRMARK,LOSYMB
- DIMENSION XU(1),YU(1),DXU1(1),DYU1(1),DXU2(1),DYU2(1)
- DIMENSION XI(4),YI(4)
- DIMENSION XXI(4),YYI(4)
- DIMENSION RVAL(4)
-*._____________________________
-*
- CALL UOPTC(CHOPT,'C12034WH',IOPT)
- IF (IOPTH.NE.0) IOPTW = 0
- IF (IOPT4.NE.0) IOPT3 = 1
- IF (IOPT2+IOPT3.EQ.0) THEN
- IOPTE = 1
- ELSE
- IOPTE = 0
- ENDIF
- ISYM = ISYMB
- LERR = .FALSE.
-*----
-* If necessary the adresses of the vectors are saved in
-* a link area.
-*----
- IF(INDEX(CHOPT,'Z').NE.0)THEN
- LXU = IQUEST(81)
- LYU = IQUEST(82)
- LDXU1 = IQUEST(83)
- LDXU2 = IQUEST(84)
- LDYU1 = IQUEST(85)
- LDYU2 = IQUEST(86)
- IOPTZ = 1
- ELSE
- IOPTZ = 0
- ENDIF
-*----
-* draw the frame if requested
-*----
- IF (IOPTW.NE.0) THEN
- IF (IOPTZ.NE.0) THEN
- XMIN = Q(LXU)-Q(LDXU1)
- XMAX = Q(LXU)+Q(LDXU2)
- YMIN = Q(LYU)-Q(LDYU1)
- YMAX = Q(LYU)+Q(LDYU2)
- DO 10 I=1,N-1
- XMIN = MIN(Q(LXU+I)-Q(LDXU1+I),XMIN)
- XMAX = MAX(Q(LXU+I)+Q(LDXU2+I),XMAX)
- YMIN = MIN(Q(LYU+I)-Q(LDYU1+I),YMIN)
- YMAX = MAX(Q(LYU+I)+Q(LDYU2+I),YMAX)
- 10 CONTINUE
- ELSE
- XMIN = XU(1)-DXU1(1)
- XMAX = XU(1)+DXU2(1)
- YMIN = YU(1)-DYU1(1)
- YMAX = YU(1)+DYU2(1)
- DO 20 I=2,N
- XMIN = MIN(XU(I)-DXU1(I),XMIN)
- XMAX = MAX(XU(I)+DXU2(I),XMAX)
- YMIN = MIN(YU(I)-DYU1(I),YMIN)
- YMAX = MAX(YU(I)+DYU2(I),YMAX)
- 20 CONTINUE
- ENDIF
- DY = 0.05*(YMAX-YMIN)
- DX = 0.05*(XMAX-XMIN)
- CALL HPLFRA(XMIN-DX,XMAX+DX,YMIN-DY,YMAX+DY,' ')
- ENDIF
-*----
-* LOCM must be set after the call to HPLFRA (if option W is
-* required) because HPLFRA changes the value of LOCM.
-*----
- LOCM = IOPTC.NE.0
-*----
-* set the graphics attributes
-*----
- CALL IGQ('LWID',RLWID)
- CALL IGQ('FAIS',RFAIS)
- CALL IGQ('FASI',RFASI)
- CALL IGQ('FACI',RFACI)
- CALL IGQ('PLCI',RPLCI)
- CALL IGQ('BORD',RBORD)
- CALL HPLATT(1)
- IF (IOPTE.NE.0) CALL ISPLCI(IHCOL)
-*----
-* initiate the first and last bin
-*----
- IF (IOPTH.NE.0) THEN
- IF (LOZOOM) THEN
- IFIRST = NCMIN
- ILAST = NCMAX
- ELSE
- IFIRST = 1
- ILAST = ICMAX
- ENDIF
- CALL IGQ('MTYP',RMTYP)
- ISYM = INT(RMTYP)
- SYMSIZ = TVSIZ(1)
- BXSIZ = 0.5*SYMSIZ
- IF (ISYM.EQ.1) SYMSIZ = 0.01
- ELSE
- SYMSIZ = MAX(0.,USIZE)
- BXSIZ = 0.5*SYMSIZ
- IFIRST = 1
- ILAST = N
- ENDIF
-*----
-* initiate the filled area drawing
-*----
- IF (IOPT3.NE.0) THEN
- NP = ILAST-IFIRST+1
- IF (2*NP.GT.NMAX) THEN
- CALL HBUG('Too many points','HPLAER',0)
- GOTO 60
- ENDIF
- IF1 = 1
- IF2 = 2*NP
- ENDIF
-*----
-* select the CM normalization transformation if requested
-*----
- IF (LOCM) THEN
- IF (NTWIN.NE.1) CALL ISELNT(1)
- NTWIN = 1
- ELSE
- IF (NTWIN.NE.NTHIST) CALL ISELNT(NTHIST)
- NTWIN = NTHIST
- ENDIF
-*----
-* define the offset of the error bars due to the symbol size
-*----
- BYSIZ = BXSIZ
- S2X = 0.5*SYMSIZ
- S2Y = S2X
- IF (.NOT.LOCM) THEN
- CALL IGQWK(1,'NTWN',RVAL)
- RTX = (RVAL(2)-RVAL(1))/(XHIGH-XLOW)
- S2X = S2X*RTX
- BXSIZ = BXSIZ*RTX
- RTY = (RVAL(4)-RVAL(3))/(YHIGH-YLOW)
- S2Y = S2Y*RTY
- BYSIZ = BYSIZ*RTY
- ENDIF
-*----
-* initiate the first XP in case a histogram is used
-*----
- IF (IOPTH.NE.0) THEN
- IF (I6.EQ.0) THEN
- IF (LOGXFL) THEN
- XP = 10**XMINI+0.5*XXSIZE
- ELSE
- XP = XMINI+0.5*XXSIZE
- ENDIF
- ELSE
- LBINS = LQ(LCID-2)
- DELTA = Q(LBINS+IFIRST+1)-Q(LBINS+IFIRST)
- XP = Q(LBINS+IFIRST)+0.5*DELTA
- ENDIF
- ENDIF
-*----
-* if ISYM = 0 or SYMSIZ = 0. no symbol is drawn
-*----
- LOSYMB = (SYMSIZ.NE.0..AND.ISYM.NE.0)
-*----
-* Loop over the points
-*----
- DO 50 K=IFIRST,ILAST
-*----
-* get the data
-*
-* XP = X position of the current point
-* YP = Y position of the current point
-* ABDX1 = Low X error
-* ABDX2 = Up X error
-* ABDY1 = Low Y error
-* ABDY2 = Up Y error
-* (XI,YI) = Error bars corrdinates
-*
-* If the option 'H' is on, these values are computed from the current
-* histogram (1D or 2D). If the option 'H' is off, the input parameters
-* are used.
-*----
- IF (IOPTH.NE.0) THEN
- YP = HCX(K,1)*FACTOR
- IF (I6.EQ.0) THEN
- ABDX1 = RERRX*XXSIZE
- ELSE
- LBINS = LQ(LCID-2)
- DELTA = Q(LBINS+K+1)-Q(LBINS+K)
- ABDX1 = RERRX*DELTA
- ENDIF
- ABDY1 = HCX(K,2)*FACTOR
- ABDX2 = ABDX1
- ABDY2 = ABDY1
- ELSE
- IF (IOPTZ.NE.0) THEN
- XP = Q(LXU+K-1)
- YP = Q(LYU+K-1)
- ABDX1 = ABS(Q(LDXU1+K-1))
- ABDX2 = ABS(Q(LDXU2+K-1))
- ABDY1 = ABS(Q(LDYU1+K-1))
- ABDY2 = ABS(Q(LDYU2+K-1))
- ELSE
- XP = XU(K)
- YP = YU(K)
- ABDX1 = ABS(DXU1(K))
- ABDX2 = ABS(DXU2(K))
- ABDY1 = ABS(DYU1(K))
- ABDY2 = ABS(DYU2(K))
- ENDIF
- ENDIF
-*
- IF (LOGYFL.AND.YP.LE.0.) THEN
- IF (IOPTH.EQ.0)LERR = .TRUE.
- GOTO 40
- ENDIF
- IF (LOGXFL.AND.XP.LE.0.) THEN
- IF (IOPTH.EQ.0) LERR = .TRUE.
- GOTO 40
- ENDIF
-*
- XI(4) = XP
- XI(3) = XP
- XI(2) = XP+ABDX2
- XI(1) = XP-ABDX1
-*
- YI(1) = YP
- YI(2) = YP
- YI(3) = YP-ABDY1
- YI(4) = YP+ABDY2
-*----
-* take the LOG if necessary
-*----
- IF (.NOT.LOCM) THEN
- DO 30 I=1,4
- IF (IOPTH.NE.0) THEN
- IF (LOGXFL) XI(I) = LOG10(MAX(XI(I),10**XMINI))
- IF (LOGYFL) YI(I) = LOG10(MAX(YI(I),10**YMINI))
- ELSE
- IF (LOGXFL) THEN
- XI(I) = LOG10(MAX(XI(I),10**XWMINI))
- ENDIF
- IF (.NOT.LOGYFL) THEN
- YI(I) = YI(I)*FACTOR
- ELSE
- YI(I) = LOG10(MAX(YI(I),10**YWMINI))
- ENDIF
- ENDIF
- 30 CONTINUE
- ENDIF
-*----
-* test if error bars are not outside the limits
-* otherwise they are truncated
-*----
- IF (LOCM) THEN
- XI(1) = MAX(XI(1),XLOW)
- XI(2) = MIN(XI(2),XHIGH)
- YI(3) = MAX(YI(3),YLOW)
- YI(4) = MIN(YI(4),YHIGH)
- ELSE
- XI(1) = MAX(XI(1),XWMINI)
- XI(2) = MIN(XI(2),XWMAXI)
- YI(3) = MAX(YI(3),YWMINI)
- YI(4) = MIN(YI(4),YWMAXI)
- ENDIF
-*----
-* If the option '0' is selected, test if the marker is on the frame
-* limits. If "Yes", the marker will be not drawn and the error bars
-* will be readjusted.
-*----
- DRMARK = .TRUE.
- IF (IOPT0.EQ.0) THEN
- IF (((YI(1)-S2Y).LT.RVAL(3).AND.(YI(1)+S2Y).GT.RVAL(3))
- + .OR.((YI(1)-S2Y).LT.RVAL(4).AND.(YI(1)+S2Y).GT.RVAL(4))
- + .OR.((XI(3)-S2X).LT.RVAL(1).AND.(XI(3)+S2X).GT.RVAL(1))
- + .OR.((XI(3)-S2X).LT.RVAL(2).AND.(XI(3)+S2X).GT.RVAL(2)))
- + DRMARK = .FALSE.
- ENDIF
- DRMARK = DRMARK.AND.LOSYMB
-*----
-* draw the error rectangles
-*----
- IF (IOPT2.NE.0) THEN
- CALL IGBOX(XI(1),XI(2),YI(3),YI(4))
- ENDIF
-*----
-* keep points for fill area drawing
-*----
- IF (IOPT3.NE.0) THEN
- XLINE(IF1) = XI(3)
- XLINE(IF2) = XI(3)
- YLINE(IF1) = YI(4)
- YLINE(IF2) = YI(3)
- IF1 = IF1+1
- IF2 = IF2-1
- ENDIF
-*----
-* draw the error bars
-*----
- IF (IOPTE.NE.0) THEN
- YYI(3) = YI(3)
- YYI(4) = YI(1)-S2Y
- IF (.NOT.DRMARK) YYI(4) = YI(1)
- IF (YYI(3).LT.YYI(4)) CALL IPL(2,XI(3),YYI(3))
- YYI(3) = YI(1)+S2Y
- IF (.NOT.DRMARK) YYI(3) = YI(1)
- YYI(4) = YI(4)
- IF (YYI(3).LT.YYI(4)) CALL IPL(2,XI(3),YYI(3))
- XXI(1) = XI(1)
- XXI(2) = XI(3)-S2X
- IF (.NOT.DRMARK) XXI(2) = XI(3)
- IF (XXI(1).LT.XXI(2)) CALL IPL(2,XXI,YI)
- XXI(1) = XI(3)+S2X
- IF (.NOT.DRMARK) XXI(1) = XI(3)
- XXI(2) = XI(2)
- IF (XXI(1).LT.XXI(2)) CALL IPL(2,XXI,YI)
- ENDIF
-*----
-* draw line at the end of the error bars
-*----
- IF (IOPT1.NE.0) THEN
- XXI(1) = XI(3)-BXSIZ
- XXI(2) = XI(3)+BXSIZ
- YYI(1) = YI(3)
- YYI(2) = YI(3)
- IF (YI(3).LT.YI(1)-S2Y) CALL IPL(2,XXI,YYI)
- YYI(1) = YI(4)
- YYI(2) = YI(4)
- IF (YI(4).GT.YI(1)+S2Y) CALL IPL(2,XXI,YYI)
- YYI(1) = YI(1)-BYSIZ
- YYI(2) = YI(1)+BYSIZ
- XXI(1) = XI(1)
- XXI(2) = XI(1)
- IF (XI(1).LT.XI(3)-S2X) CALL IPL(2,XXI,YYI)
- XXI(1) = XI(2)
- XXI(2) = XI(2)
- IF (XI(2).GT.XI(3)+S2X) CALL IPL(2,XXI,YYI)
- ENDIF
-*----
-* draw the marker
-*----
- IF (DRMARK) CALL HPLSYM(XP,YP,1,ISYM,SYMSIZ,' ')
-*----
-* increment XP in case of histogram
-*----
- 40 IF (IOPTH.NE.0) THEN
- IF (I6.EQ.0) THEN
- XP = XP+XXSIZE
- ELSE
- IF (K.LT.ILAST) THEN
- LBINS = LQ(LCID-2)
- DELTA = Q(LBINS+K+2)-Q(LBINS+K+1)
- XP = Q(LBINS+K+1)+0.5*DELTA
- ENDIF
- ENDIF
- ENDIF
- 50 CONTINUE
-*----
-* draw the filled area
-*----
- IF (IOPT3.NE.0) THEN
- IF (IOPT4.NE.0) THEN
- CALL IGRAPH(2*NP,XLINE,YLINE,'FC')
- ELSE
- CALL IGRAPH(2*NP,XLINE,YLINE,'F')
- ENDIF
- ENDIF
-*
- IF (LERR) CALL HBUG('Null or negative value with log scale'
- +, 'HPLAER',0)
-*
- 60 CALL IGSET('LWID',RLWID)
- CALL IGSET('FAIS',RFAIS)
- CALL IGSET('FASI',RFASI)
- CALL IGSET('FACI',RFACI)
- CALL IGSET('PLCI',RPLCI)
- CALL IGSET('BORD',RBORD)
-*
- END
diff --git a/src/graflib/hplot/hplotf77/hplarc.F b/src/graflib/hplot/hplotf77/hplarc.F
deleted file mode 100644
index 6f8a302..0000000
--- a/src/graflib/hplot/hplotf77/hplarc.F
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: hplarc.F,v 1.1.1.1 1996/01/19 10:49:57 mclareni Exp $
-*
-* $Log: hplarc.F,v $
-* Revision 1.1.1.1 1996/01/19 10:49:57 mclareni
-* Hplot
-*
-*
-#include "hplot/pilot.h"
-*CMZ : 5.04/12 16/01/89 12.08.11 by O.Couet
-*-- Author :
- SUBROUTINE HPLARC(XC,YC,RAD,APHI1,APHI2)
-*.==========>
-*. Draws arc of circle
-*. (Transformation no 1 (cm) is selected)
-*..=========>
-#include "hplot/hpl2.inc"
-*._____________________________
-*
-*----
-* Transformation no 1 (cm) is selected
-*----
- IF(NTWIN.NE.1)THEN
- CALL ISELNT(1)
- NTWIN=1
- ENDIF
-*
- CALL IGARC(XC,YC,RAD,RAD,APHI1,APHI2)
-*
- END
-
diff --git a/src/graflib/hplot/hplotf77/hplatt.F b/src/graflib/hplot/hplotf77/hplatt.F
deleted file mode 100644
index 83da596..0000000
--- a/src/graflib/hplot/hplotf77/hplatt.F
+++ /dev/null
@@ -1,68 +0,0 @@
-*
-* $Id: hplatt.F,v 1.1.1.1 1996/01/19 10:49:57 mclareni Exp $
-*
-* $Log: hplatt.F,v $
-* Revision 1.1.1.1 1996/01/19 10:49:57 mclareni
-* Hplot
-*
-*
-#include "hplot/pilot.h"
-*CMZ : 5.18/12 09/06/94 15.04.10 by O.Couet
-*-- Author : O.Couet 08/06/94
- SUBROUTINE HPLATT(IOBJ)
-*.==========>
-*.
-*. This routine sets the HIGZ attributes according to
-*. the HPLOT attributes for a given HPLOT object:
-*.
-*. IOBJ is the object identifier:
-*.
-*. 1 = Histograms
-*. 2 = Functions
-*.
-*..=========>
-#include "hplot/hpl1.inc"
-*._____________________________
-*
- GOTO (10,20), IOBJ
-*
- 10 CALL ISLWSC(FLOAT(IHWID))
- IF(IHTYP.NE.0)THEN
- IAHTYP = IABS(IHTYP)
- IHFAIS = IAHTYP/1000 - 1
- IF(IHFAIS.LT.0)IHFAIS = 3
- CALL ISFAIS(IHFAIS)
- IHFASI = MOD(IAHTYP,1000)
- IF(IHTYP.LT.0)IHFASI = -IHFASI
- IF((IHFASI.NE.0).AND.(IHFAIS.GE.2))CALL ISFASI(IHFASI)
- CALL ISFACI(IHCOL)
- CALL ISPLCI(IHCOL)
- ELSE
- CALL ISFAIS(0)
- CALL ISFACI(IHCOL)
- CALL ISPLCI(IHCOL)
- ENDIF
- IF(IHBCOL.NE.0)CALL ISPLCI(IHBCOL)
- CALL IGSET('BORD',1.)
- GOTO 999
-*
- 20 CALL ISLWSC(FLOAT(IFWID))
- IF(.NOT.LOASTK.AND.IFTYP.NE.0)THEN
- IAFTYP = IABS(IFTYP)
- IFFAIS = IAFTYP/1000 - 1
- IF(IFFAIS.LT.0)IFFAIS = 3
- CALL ISFAIS(IFFAIS)
- IFFASI = MOD(IAFTYP,1000)
- IF(IFTYP.LT.0)IFFASI = -IFFASI
- IF((IFFASI.NE.0).AND.(IFFAIS.GE.2))CALL ISFASI(IFFASI)
- CALL ISFACI(IFCOL)
- CALL ISPLCI(IFCOL)
- ENDIF
- IF(IFBCOL.NE.0)THEN
- CALL ISPLCI(IFBCOL)
- CALL IGSET('BORD',1.)
- ELSE
- CALL IGSET('BORD',0.)
- ENDIF
-*
- 999 END
diff --git a/src/graflib/hplot/hplotf77/hplax.F b/src/graflib/hplot/hplotf77/hplax.F
deleted file mode 100644
index 47eca5e..0000000
--- a/src/graflib/hplot/hplotf77/hplax.F
+++ /dev/null
@@ -1,166 +0,0 @@
-*
-* $Id: hplax.F,v 1.2 1998/10/26 16:45:35 couet Exp $
-*
-* $Log: hplax.F,v $
-* Revision 1.2 1998/10/26 16:45:35 couet
-* - TVSIZ(3) was used instead of TVSIZ(4) to place the axis titles
-*
-* Revision 1.1.1.1 1996/01/19 10:49:57 mclareni
-* Hplot
-*
-*
-#include "hplot/pilot.h"
-*CMZ : 5.20/00 19/04/95 10.26.37 by O.Couet
-*-- Author :
- SUBROUTINE HPLAX(CHXTIT,CHYTIT)
-*.==========>
-*. HPLOT routine to label axes with a title
-*..=========>
-#include "hplot/hpl1.inc"
-#include "hplot/hpl2.inc"
-#include "hplot/hpl4.inc"
-#include "hplot/hpl6.inc"
-#include "hplot/quest.inc"
- CHARACTER*(*) CHXTIT,CHYTIT
- DIMENSION RTXFP(2), RTXAL(2)
-*._____________________________
-*
-*----
-* Return immediately if this routine is called before the
-* first HPLOT call
-*----
- IF(IPLNUM.LT.0)THEN
- CALL HBUG('HPLAX must be called after HPLOT','HPLAX ',0)
- RETURN
- ENDIF
-*
- NTWOLD = NTWIN
- IF (LO3DPL) THEN
- NTWIN = NTHIST
- CALL ISELNT(NTHIST)
- CALL HPLTOC(RQUEST(70),RQUEST(72),XKX1,YKX1,NT)
- CALL HPLTOC(RQUEST(71),RQUEST(73),XKX2,YKX2,NT)
- CALL HPLTOC(RQUEST(74),RQUEST(76),XKY1,YKY1,NT)
- CALL HPLTOC(RQUEST(75),RQUEST(77),XKY2,YKY2,NT)
- CALL HPLTOC(RQUEST(78),RQUEST(80),XKZ1,YKZ1,NT)
- CALL HPLTOC(RQUEST(79),RQUEST(81),XKZ2,YKZ2,NT)
- ENDIF
-*----
-* Save the current NT and the current text angle and alignment.
-* Select the centimeters.
-*----
- IF (NTWIN.NE.1) CALL ISELNT(1)
- NTWIN = 1
- CALL IGQ('TANG',RTANG)
- CALL IGQ('TXAL',RTXAL)
- CALL IGQ('TXFP',RTXFP)
- CALL IGQ('CHHE',RCHHE)
-*----
-* Set axis labels font and precision
-*----
- KFONT = IABS(IHFONT(4))
- ILAFON = KFONT/10
- ILAPRE = MOD(KFONT,10)
- IF (IHFONT(4).LT.0) ILAFON = -ILAFON
- CALL ISTXFP(ILAFON,ILAPRE)
- CALL ISCHH(TVSIZ(4))
-*----
-* Check if a Z title is required
-*----
- IZPOS = INDEX(CHYTIT,';')
- IF (IZPOS.NE.0) THEN
- IYPOS = IZPOS-1
- ELSE
- IYPOS = LENOCC(CHYTIT)
- ENDIF
-*----
-* Draw the axis title on a 3D plot
-*----
- IF (LO3DPL) THEN
-* X axis label
- IF (XKX1.EQ.XKZ1) THEN
- XK = XKX1
- YK = YKX1
- CALL ISTXAL(0,0)
- ELSEIF (XKX2.EQ.XKZ1) THEN
- XK = XKX2
- YK = YKX2
- CALL ISTXAL(0,0)
- ELSE
- IF (XKX2.GT.XKX1) THEN
- XK = XKX2
- YK = YKX2
- ELSE
- XK = XKX1
- YK = YKX1
- ENDIF
- CALL ISTXAL(3,0)
- ENDIF
- IF (XKX2-XKX1.NE.0.) THEN
- RANG = (ATAN((YKX2-YKX1)/(XKX2-XKX1)))*(180./3.14159)
- ELSE
- RANG = 0.
- ENDIF
- CALL IGSET('TANG',RANG)
- CALL ITX(XK,YK-1.5*YLABEL-TVSIZ(4),CHXTIT)
-* Y axis label
- IF (XKY1.EQ.XKZ1) THEN
- XK = XKY1
- YK = YKY1
- CALL ISTXAL(0,0)
- ELSEIF (XKY2.EQ.XKZ1) THEN
- XK = XKY2
- YK = YKY2
- CALL ISTXAL(0,0)
- ELSE
- IF (XKY2.GT.XKY1) THEN
- XK = XKY2
- YK = YKY2
- ELSE
- XK = XKY1
- YK = YKY1
- ENDIF
- CALL ISTXAL(3,0)
- ENDIF
- IF (XKY2-XKY1.NE.0.) THEN
- RANG = (ATAN((YKY2-YKY1)/(XKY2-XKY1)))*(180./3.14159)
- ELSE
- RANG = 0.
- ENDIF
- CALL IGSET('TANG',RANG)
- CALL ITX(XK,YK-2.5*YLABEL-TVSIZ(4),CHYTIT(1:IYPOS))
-* Z axis label
- IF(IZPOS.NE.0)THEN
- CALL ISTXAL(3,0)
- CALL IGSET('TANG',90.)
- CALL ITX(XKZ2-XLABEL,YKZ2,CHYTIT(IZPOS+1:))
- ENDIF
-*----
-* Draw the axis title on a 2D plot
-*----
- ELSE
- CALL ISTXAL(3,0)
-* X axis label
- CALL IGSET('TANG',0.)
- XK = XHIGH
- YK = YLOW-YLABEL-TVSIZ(4)
- CALL ITX(XK,YK,CHXTIT)
-* Y axis label
- CALL IGSET('TANG',90.)
- XK = XLOW-XLABEL
- YK = YHIGH
- CALL ITX(XK,YK,CHYTIT(1:IYPOS))
- ENDIF
-*----
-* Restore the NT, the text angle and the text alignment.
-*----
- IF(NTWIN.NE.NTWOLD)THEN
- NTWIN = NTWOLD
- CALL ISELNT(NTWOLD)
- ENDIF
- CALL IGSET('TANG',RTANG)
- CALL ISTXAL(INT(RTXAL(1)),INT(RTXAL(2)))
- CALL ISTXFP(INT(RTXFP(1)),INT(RTXFP(2)))
- CALL IGSET('CHHE',RCHHE)
-*
- END
diff --git a/src/graflib/hplot/hplotf77/hplax2.F b/src/graflib/hplot/hplotf77/hplax2.F
deleted file mode 100644
index 5838f61..0000000
--- a/src/graflib/hplot/hplotf77/hplax2.F
+++ /dev/null
@@ -1,88 +0,0 @@
-*
-* $Id: hplax2.F,v 1.1.1.1 1996/01/19 10:49:57 mclareni Exp $
-*
-* $Log: hplax2.F,v $
-* Revision 1.1.1.1 1996/01/19 10:49:57 mclareni
-* Hplot
-*
-*
-#include "hplot/pilot.h"
-*CMZ : 5.19/03 06/01/95 13.32.07 by O.Couet
-*-- Author : O.Couet 19/10/90
- SUBROUTINE HPLAX2(PAR)
-*.===========>
-*.
-*. Initialize the axis parameter for IGTABL (lego and Surface)
-*. with the values of the HPLOT attributes. This routine is also
-*. called by HPLFR3.
-*.
-*. _Input parameters:
-*.
-*. REAL PAR : Array of attributes
-*.
-*..==========> (O.Couet)
-#include "hplot/hpl1.inc"
-#include "hplot/hpl2.inc"
-#include "hplot/hpl4.inc"
-#include "hplot/hpl6.inc"
-#include "hplot/hpl9.inc"
-#include "hplot/hpl11.inc"
-#include "hplot/hpl13.inc"
- DIMENSION PAR(*)
-*._____________________________
-*
-*
-* Axis division numbers.
-*
- NDIVX = INT(RDIVX)
- NDIVY = INT(RDIVY)
- NDIVZ = INT(RDIVZ)
- IF (IXWIN.GT.1.AND.RDIVX.GT.0) THEN
- N2 = INT(NDIVX/100)
- N1 = MAX(NDIVX-(100*N2),1)
- NDIVX = (100*N2)+(N1/IXWIN)
- ENDIF
- IF (IYWIN.GT.1.AND.RDIVY.GT.0) THEN
- N2 = INT(NDIVY/100)
- N1 = MAX(NDIVY-(100*N2),1)
- NDIVY = (100*N2)+(N1/IYWIN)
- ENDIF
- IF (IYWIN.GT.1.AND.RDIVZ.GT.0) THEN
- N2 = INT(NDIVZ/100)
- N1 = MAX(NDIVZ-(100*N2),1)
- NDIVZ = (100*N2)+(N1/((IYWIN+1)/2))
- ENDIF
- PAR(1) = FLOAT(NDIVX)
- PAR(2) = FLOAT(NDIVY)
- PAR(3) = FLOAT(NDIVZ)
-*
-* Axis color
-*
- PAR(4) = FLOAT(IXCOL)
- PAR(5) = FLOAT(IYCOL)
- IF (RBCOL.GE.1000.) THEN
- PAR(6) = RBCOL
- ELSE
- PAR(6) = FLOAT(IYCOL)
- ENDIF
-*
-* Axis label font
-*
- PAR(11) = FLOAT(IHFONT(3))
-*
-* Axis tick marks size
-*
- IF ((YHIGH-YLOW).NE.0) THEN
- PAR(7) = XLTICK*2./(YHIGH-YLOW)
- PAR(8) = YLTICK*2./(YHIGH-YLOW)
- PAR(9) = YLTICK*2./(XHIGH-XLOW)
-*
- PAR(10) = TVSIZ(7)*2./(YHIGH-YLOW)
- PAR(12) = XLVAL*(2./(YHIGH-YLOW))+1.9*PAR(7)
- PAR(13) = XLVAL*(2./(YHIGH-YLOW))+0.7*PAR(8)
- PAR(14) = YLVAL*(2./(XHIGH-XLOW))+PAR(9)
- ELSE
- CALL IGERR('Invalid world coordinates','HPLAX2')
- ENDIF
-*
- END
diff --git a/src/graflib/hplot/hplotf77/hplaxi.F b/src/graflib/hplot/hplotf77/hplaxi.F
deleted file mode 100644
index 212ce35..0000000
--- a/src/graflib/hplot/hplotf77/hplaxi.F
+++ /dev/null
@@ -1,459 +0,0 @@
-*
-* $Id: hplaxi.F,v 1.2 2001/12/07 15:19:56 couet Exp $
-*
-* $Log: hplaxi.F,v $
-* Revision 1.2 2001/12/07 15:19:56 couet
-* - use higz include files from the higz include file directory.
-* option Z is now working in hplaer.F
-* option Z has been implemented in hplsym.F
-*
-* Revision 1.1.1.1 1996/01/19 10:49:57 mclareni
-* Hplot
-*
-*
-#include "hplot/pilot.h"
-*CMZ : 5.20/01 05/05/95 16.42.14 by O.Couet
-*-- Author :
- SUBROUTINE HPLAXI(XX,YY,IOPT)
-*.==========>
-*.
-*. Draws axis Ox and Oy using histogram coordinates
-*. (including ticks marks and labels) XX(3),YY(3)
-*. extremities of Ox and Oy axis (histogram coordinates)
-*. (Transformation histogram NTHIST must be selected
-*. before calling HPLAXI)
-*.
-*. IOPT = 0 ID is unvalid in this routine
-*. IOPT = 1 ID is valid in this routine
-*. IOPT = 2 Redraw the X-Axis without labels. This is useful
-* when the HCOL is greater tha 1000.
-*.
-*.==========>
-#include "hbook/hcbook.inc"
-#include "hplot/hpl1.inc"
-#include "hplot/hpl2.inc"
-#include "hplot/hpl4.inc"
-#include "hplot/hpl6.inc"
-#include "hplot/hpl9.inc"
-#include "higz/hilabs.inc"
-#include "hbook/hcflag.inc"
- COMMON /HPLYZO/ Y1ZOOM,Y2ZOOM
- LOGICAL HLABEQ
- INTEGER HLABNB
- PARAMETER (LABLEN=32)
- CHARACTER*20 CHAXI
- CHARACTER*16 CHAX0
- DIMENSION XX(3),YY(3)
- DIMENSION RTXFP(2)
- INTEGER CX,CY
- SAVE XTMSIZ,YTMSIZ
- DATA XTMSIZ /0./
- DATA YTMSIZ /0./
-*._____________________________
-*
-* Prepare the NDIV parameters
-*
- NDIVX = INT(RDIVX)
- NDIVY = INT(RDIVY)
- RDIVXA = ABS(RDIVX)
- RDIVYA = ABS(RDIVY)
- IX = 100*(RDIVXA+0.005)
- IY = 100*(RDIVYA+0.005)
- NX = INT(10*RDIVXA-10*IABS(NDIVX))
- NY = INT(10*RDIVYA-10*IABS(NDIVY))
- CX = IX-100*IABS(NDIVX)-10*NX
- CY = IY-100*IABS(NDIVY)-10*NY
- LW = LABLEN/4
- IGXY = 0
-*
-* Optimize the number of divisions as a
-* function of ZONE numbers
-*
- IF(IXWIN.GT.1.AND.RDIVX.GT.0)THEN
- NX2 = INT(NDIVX/100)
- NX1 = MAX(NDIVX-(100*NX2),1)
- NDIVX = (100*NX2)+(NX1/IXWIN)
- ENDIF
- IF(IYWIN.GT.1.AND.RDIVY.GT.0)THEN
- NY2 = INT(NDIVY/100)
- NY1 = MAX(NDIVY-(100*NY2),1)
- NDIVY = (100*NY2)+(NY1/((IYWIN+1)/2))
- ENDIF
-*
-* Transformation rapports between
-* histogram coordinates and cm
-*
- IF(XHIGH.GT.XLOW)THEN
- RTX = (XMAXI-XMINI)/(XHIGH-XLOW)
- ELSE
- RETURN
- ENDIF
- IF(YHIGH.GT.YLOW)THEN
- RTY = (YMAXI-YMINI)/(YHIGH-YLOW)
- ELSE
- RETURN
- ENDIF
-*
- CALL IGQ('TXFP',RTXFP)
- CALL IGQ('TXCI',RTXCI)
- CALL IGQ('PLCI',RPLCI)
- CALL IGQ('LWID',RLWID)
- CALL ISCLIP(0)
- IF(IBBCOL.NE.0)THEN
- CALL ISPLCI(IBBCOL)
- ELSE
- CALL ISPLCI(IBCOL)
- ENDIF
-*
-* Set axis value size
-*
- ALSIZ = TVSIZ(7)*RTY
- CALL IGSET('LASI',ALSIZ)
-*
-* Set axis value font and precision
-*
- KFONT = IABS(IHFONT(3))
- IAXFON = KFONT/10
- IAXPRE = MOD(KFONT,10)
- IF(IHFONT(3).LT.0)IAXFON = -IAXFON
- CALL ISTXFP(IAXFON,IAXPRE)
-*
-* Calculate axis ticks mark
-*
- YTISIZ = YLTICK*RTX
- XTISIZ = XLTICK*RTY
- XYTSIZ = ABS(XTISIZ)*1.5
-*
-* Calculate axis label offset
-*
- YALDIS = ABS(XLVAL)*RTX
- XALDIS = ABS(YLVAL)*RTY
-*.______________________________________
-*
-* Oy axis
-*
- IF(IOPT.NE.0)THEN
- CALL IGPID(1,'y-axis',ID,' ')
- ELSE
- CALL IGPID(1,'y-axis',0,' ')
- ENDIF
- CALL ISTXCI(IYCOL)
- CALL ISLWSC(FLOAT(IYWID))
- IF(.NOT.LOGYFL)THEN
- IF(IOPT.EQ.2)THEN
- BMIN = YWMINI
- BMAX = YWMAXI
- ELSE
- BMIN = YMINI
- BMAX = YMAXI
- ENDIF
- ELSE
- IF(IOPT.EQ.2)THEN
- BMIN = 10**YWMINI
- BMAX = 10**YWMAXI
- ELSE
- BMIN = 10**YMINI
- BMAX = 10**YMAXI
- ENDIF
- ENDIF
-*
- CHAXI='SDH'
- CHAX0=CHAXI
- CALL IGSET('LAOF',YALDIS)
- IF(YTISIZ.LT.0.)THEN
- YTISIZ = -YTISIZ
- IF(XLVAL.GE.0.)THEN
- CHAXI = '+='//CHAX0
- ELSE
- CHAXI = '+'//CHAX0
- ENDIF
- ELSE
- IF(XLVAL.LT.0.)CHAXI='-='//CHAX0
- ENDIF
- IF(IOPT.EQ.2)THEN
- CHAX0=CHAXI
- CHAXI='U'//CHAX0
- CALL IGSET('TMSI',YTMSIZ)
- ELSE
- CALL IGSET('TMSI',YTISIZ)
- YTMSIZ = YTISIZ
- ENDIF
- IF(LOGYFL)THEN
- CHAX0 = CHAXI
- CHAXI = 'G'//CHAX0
- ENDIF
- IF(LODVYI)THEN
- CHAX0 = CHAXI
- CHAXI = 'I'//CHAX0
- ENDIF
- IF(NDIVY.LT.0)THEN
- CHAX0 = CHAXI
- CHAXI = 'N'//CHAX0
- ENDIF
- IF(LOGRID)THEN
- CHAX0 = CHAXI
- IGXY = INT(IGTYP/1000)
- IF(IGXY.NE.2)THEN
- CHAXI = 'W'//CHAX0
- CALL IGSET('AWLN',XX(3))
- ENDIF
- ENDIF
- IF(CY.EQ.1)THEN
- CHAX0 = CHAXI
- CHAXI = 'L'//CHAX0
- ENDIF
- IF(CY.EQ.2)THEN
- CHAX0 = CHAXI
- CHAXI = 'C'//CHAX0
- ENDIF
- IF(CY.EQ.3)THEN
- CHAX0 = CHAXI
- CHAXI = 'R'//CHAX0
- ENDIF
- IF(CY.EQ.4)THEN
- CHAX0 = CHAXI
- CHAXI = 'LM'//CHAX0
- ENDIF
- IF(CY.EQ.5)THEN
- CHAX0 = CHAXI
- CHAXI = 'CM'//CHAX0
- ENDIF
- IF(CY.EQ.6)THEN
- CHAX0 = CHAXI
- CHAXI = 'RM'//CHAX0
- ENDIF
- IF(CY.EQ.0)THEN
- IF(NY.NE.0)THEN
- CHAX0 = CHAXI
- CHAXI = 'RM'//CHAX0
- ELSE
- CHAX0 = CHAXI
- CHAXI = 'R'//CHAX0
- ENDIF
- ENDIF
- IF(NY.NE.0)THEN
- LNY = 0
- LN = LQ(LHPLOT-2)
- IF(LN.EQ.0)GOTO 30
- 10 IF(LN.NE.0)THEN
- IF(IQ(LN+1).EQ.NY)LNY = LN
- LN = LQ(LN)
- GOTO 10
- ENDIF
- NHILAB = MIN(IQ(LNY+2),MAXLAB)
- DO 20 I=1,NHILAB
- HILABS(I) = ' '
- CALL UHTOC(IQ(LNY+3+(I-1)*LW),4,HILABS(I),LABLEN)
- 20 CONTINUE
- CALL IZLBL
- CHAX0 = CHAXI
- CHAXI = 'TN'//CHAX0
- ENDIF
-*
- 30 IAXDIV = IABS(NDIVY)
-*
-* Oy axis is alphanumeric
-*
- IF(IOPT.NE.0)THEN
- IF(HLABEQ(ID,'Y'))THEN
- IF(LOZOOM)THEN
- IAXDIV = Y2ZOOM-Y1ZOOM+1
- ILAB1 = Y1ZOOM
- ILAB2 = Y2ZOOM
- IF(IAXDIV.GT.99)THEN
- IAXDIV = 99
- ILAB2 = ILAB1+MAXLAB-1
- ENDIF
- ELSE
- IAXDIV = MIN(HLABNB(ID,'Y'),99)
- ILAB1 = 1
- ILAB2 = IAXDIV
- ENDIF
- NHILAB = IAXDIV
- DO 40 I=ILAB1,ILAB2
- CALL HLGNXT(ID,I,HILABS(I-ILAB1+1),'Y')
- 40 CONTINUE
- CALL IZLBL
- CHAX0 = CHAXI
- CHAXI = 'TNRM'//CHAX0
- ENDIF
- ENDIF
-*
- NCHX = LENOCC(CHAXI)
- ILT = MAX(IGTYP-1000*IGXY,1)
- CALL ISLN(ILT)
- CALL IGAXIS(XX(1),XX(2),YY(1),YY(2),BMIN,BMAX,IAXDIV,
- + CHAXI(1:NCHX))
-*.______________________________________
-*
-* Ox axis
-*
- IF(IOPT.NE.0)THEN
- CALL IGPID(1,'x-axis',ID,' ')
- ELSE
- CALL IGPID(1,'x-axis',0,' ')
- ENDIF
- CALL ISTXCI(IXCOL)
- CALL ISLWSC(FLOAT(IXWID))
- IF(.NOT.LOGXFL)THEN
- IF(IOPT.EQ.2)THEN
- BMIN=XWMINI
- BMAX=XWMAXI
- ELSE
- BMIN=XMINI
- BMAX=XMAXI
- ENDIF
- ELSE
- IF(IOPT.EQ.2)THEN
- BMIN=10**XWMINI
- BMAX=10**XWMAXI
- ELSE
- BMIN=10**XMINI
- BMAX=10**XMAXI
- ENDIF
- ENDIF
-*
- CHAXI='SDH'
- CHAX0=CHAXI
- CALL IGSET('LAOF',XALDIS)
- IF(XTISIZ.LT.0.)THEN
- XTISIZ=-XTISIZ
- IF(YLVAL.GE.0.)THEN
- CHAXI='-='//CHAX0
- ELSE
- CHAXI='-'//CHAX0
- ENDIF
- ELSE
- IF(YLVAL.LT.0.)CHAXI='+='//CHAX0
- ENDIF
- IF(IOPT.EQ.2)THEN
- CHAX0=CHAXI
- CHAXI='U'//CHAX0
- CALL IGSET('TMSI',XTMSIZ)
- ELSE
- CALL IGSET('TMSI',XTISIZ)
- XTMSIZ = XTISIZ
- ENDIF
- IF(LOGXFL)THEN
- CHAX0=CHAXI
- CHAXI='G'//CHAX0
- ENDIF
- IF(LODVXI)THEN
- CHAX0=CHAXI
- CHAXI='I'//CHAX0
- ENDIF
- IF(NDIVX.LT.0)THEN
- CHAX0=CHAXI
- CHAXI='N'//CHAX0
- ENDIF
- IF(LOGRID)THEN
- CHAX0=CHAXI
- IGXY=INT(IGTYP/1000)
- IF(IGXY.NE.1)THEN
- CHAXI='W'//CHAX0
- CALL IGSET('AWLN',YY(2))
- ENDIF
- ENDIF
- IF(CX.EQ.1)THEN
- CHAX0=CHAXI
- CHAXI='C'//CHAX0
- ENDIF
- IF(CX.EQ.2)THEN
- CHAX0=CHAXI
- CHAXI='YC'//CHAX0
- ENDIF
- IF(CX.EQ.3)THEN
- CHAX0=CHAXI
- CHAXI='LO'//CHAX0
- ENDIF
- IF(CX.EQ.4)THEN
- CHAX0=CHAXI
- CHAXI='R0'//CHAX0
- ENDIF
- IF(CX.EQ.5)THEN
- CHAX0=CHAXI
- CHAXI='MC'//CHAX0
- ENDIF
- IF(CX.EQ.6)THEN
- CHAX0=CHAXI
- CHAXI='MCY'//CHAX0
- ENDIF
- IF(CX.EQ.7)THEN
- CHAX0=CHAXI
- CHAXI='MLO'//CHAX0
- ENDIF
- IF(CX.EQ.8)THEN
- CHAX0=CHAXI
- CHAXI='MR0'//CHAX0
- ENDIF
- IF(CX.EQ.0)THEN
- IF(NX.NE.0)THEN
- CHAX0=CHAXI
- CHAXI='MC'//CHAX0
- ELSE
- CHAX0=CHAXI
- CHAXI='C'//CHAX0
- ENDIF
- ENDIF
- IF(NX.NE.0)THEN
- LNX = 0
- LN = LQ(LHPLOT-2)
- IF(LN.EQ.0)GOTO 90
- 60 IF(LN.NE.0)THEN
- IF(IQ(LN+1).EQ.NX)LNX=LN
- LN=LQ(LN)
- GOTO 60
- ENDIF
- NHILAB = MIN(IQ(LNX+2),MAXLAB)
- DO 70 I=1,NHILAB
- HILABS(I)=' '
- CALL UHTOC(IQ(LNX+3+(I-1)*LW),4,HILABS(I),LABLEN)
- 70 CONTINUE
- CALL IZLBL
- CHAX0=CHAXI
- CHAXI='TN'//CHAX0
- ENDIF
-*
- IAXDIV=IABS(NDIVX)
-*
-* Ox axis is alphanumeric
-*
- IF(IOPT.NE.0)THEN
- IF(HLABEQ(ID,'X'))THEN
- IF(LOZOOM)THEN
- IAXDIV = NCMAX-NCMIN+1
- ILAB1 = NCMIN
- ILAB2 = NCMAX
- IF(IAXDIV.GT.99)THEN
- IAXDIV = 99
- ILAB2 = ILAB1+MAXLAB-1
- ENDIF
- ELSE
- IAXDIV = MIN(HLABNB(ID,'X'),99)
- ILAB1 = 1
- ILAB2 = IAXDIV
- ENDIF
- NHILAB = IAXDIV
- DO 80 I=ILAB1,ILAB2
- CALL HLGNXT(ID,I,HILABS(I-ILAB1+1),'X')
- 80 CONTINUE
- CALL IZLBL
- CHAX0 = CHAXI
- CHAXI = 'TNMC'//CHAX0
- ENDIF
- ENDIF
-*
- 90 NCHX=LENOCC(CHAXI)
- ILT=MAX(IGTYP-1000*IGXY,1)
- CALL ISLN(ILT)
- CALL IGAXIS(XX(1),XX(3),YY(1),YY(3),BMIN,BMAX,IAXDIV,
- + CHAXI(1:NCHX))
-*
- CALL ISCLIP(1)
- CALL ISLN(ILTYP)
- CALL IGSET('TXCI',RTXCI)
- CALL IGSET('PLCI',RPLCI)
- CALL IGSET('LWID',RLWID)
- CALL ISTXFP(INT(RTXFP(1)),INT(RTXFP(2)))
-*
- END
diff --git a/src/graflib/hplot/hplotf77/hplbox.F b/src/graflib/hplot/hplotf77/hplbox.F
deleted file mode 100644
index bda8c82..0000000
--- a/src/graflib/hplot/hplotf77/hplbox.F
+++ /dev/null
@@ -1,147 +0,0 @@
-*
-* $Id: hplbox.F,v 1.1.1.1 1996/01/19 10:49:58 mclareni Exp $
-*
-* $Log: hplbox.F,v $
-* Revision 1.1.1.1 1996/01/19 10:49:58 mclareni
-* Hplot
-*
-*
-#include "hplot/pilot.h"
-*CMZ : 5.20/00 13/04/95 14.14.32 by O.Couet
-*-- Author :
- SUBROUTINE HPLBOX(XSF,YSF,XEF,YEF,KICASE)
-*.==========>
-*. draws a rectangular box on the picture
-*. (Transformation NTHIST or 1 is selected
-*. according to KICASE)
-*..=========>
-#include "hplot/hpl1.inc"
-#include "hplot/hpl2.inc"
-#include "hplot/hpl4.inc"
-#include "hplot/hpl9.inc"
- LOGICAL LERR1
- CHARACTER*(*) KICASE
-*._____________________________
-*
- XS = XSF
- YS = YSF
- XE = XEF
- YE = YEF
-*
- CALL IGQ('FAIS',RFAIS)
- CALL IGQ('FASI',RFASI)
- CALL IGQ('FACI',RFACI)
- CALL IGQ('PLCI',RPLCI)
- CALL IGQ('LWID',RLWID)
- CALL IGQ('BORD',RBORD)
- CALL ISCLIP(0)
-*----
-* Ensure (XS,YS) is lower left hand point
-*----
- IF (XS.GT.XE) THEN
- T = XS
- XS = XE
- XE = T
- ENDIF
- IF (YS.GT.YE) THEN
- T = YS
- YS = YE
- YE = T
- ENDIF
-*----
-* Select the NT according to KICASE
-*----
- LERR1 = .FALSE.
- LOCM = .FALSE.
- IF (KICASE(1:1).EQ.'C') LOCM = .TRUE.
- IF (LOCM) THEN
- IF(NTWIN.NE.1)CALL ISELNT(1)
- NTWIN = 1
- GOTO 10
- ELSE
- IF (NTWIN.NE.NTHIST) CALL ISELNT(NTHIST)
- NTWIN = NTHIST
- ENDIF
-*----
-* Check the validy of the arguments in case of LOG scale
-*----
- IF (LOGXFL) THEN
- IF (XS.LE.0.) GOTO 20
- IF (XE.LE.0.) GOTO 20
- XS = LOG10(XS)
- XE = LOG10(XE)
- ENDIF
- YS = YS*FACTOR
- YE = YE*FACTOR
- IF (LOGYFL) THEN
- IF (YMINI.LE.0.0) GOTO 20
- IF (YS.LE.0.0) GOTO 20
- IF (YE.LE.0.0) GOTO 20
- YS = LOG10(YS)
- YE = LOG10(YE)
- ENDIF
-*----
-* Check if the box is not outside the picture limits
-*----
- 10 IF (LOCM) THEN
- XS = MAX(XS,0.)
- XE = MIN(XE,XSIZ)
- YS = MAX(YS,0.)
- YE = MIN(YE,YSIZ)
- ELSE
- XS = MAX(XS,XMINI)
- XE = MIN(XE,XMAXI)
- YS = MAX(YS,YMINI)
- YE = MIN(YE,YMAXI)
- ENDIF
- IF ((XS.GT.XE).OR.(YS.GT.YE)) LERR1 = .TRUE.
-*----
-* Drawing of the box
-*----
- IF (IBTYP.NE.0) THEN
- IABTYP = IABS(IBTYP)
- IBFAIS = IABTYP/1000-1
- IF (IBFAIS.LT.0) IBFAIS = 3
- CALL ISFAIS(IBFAIS)
- IBFASI = MOD(IABTYP,1000)
- IF(IBTYP.LT.0) IBFASI = -IBFASI
- IF ((IBFASI.NE.0).AND.(IBFAIS.GE.2)) CALL ISFASI(IBFASI)
- IF (IBCOL.NE.0) CALL ISFACI(IBCOL)
- ELSE
- IBFAIS = 0
- CALL ISFAIS(0)
- CALL ISFACI(1)
- ENDIF
- IF (IBBCOL.NE.0) THEN
- CALL ISPLCI(IBBCOL)
- ELSE
- CALL ISPLCI(IBCOL)
- ENDIF
- CALL ISLWSC(FLOAT(IBWID))
- CALL IGSET('BORD',1.)
- IF (KICASE(3:3).EQ.'S'.AND.ISBCOL.NE.0) THEN
- DZ=0.2+(0.1/IXWIN)
- IF(IBFAIS.EQ.0) ISBOX = 0
- IF(IBFAIS.EQ.1) ISBOX = 1000+IBCOL
- IF(IBFAIS.GE.2) ISBOX = IBFASI
- CALL IGPAVE(XS,XE,YS,YE,DZ,ISBOX,1000+ISBCOL,'TR')
- ELSE
- CALL IGBOX(XS,XE,YS,YE)
- ENDIF
-*
- GOTO 30
-*
- 20 CALL HBUG('Routine called with zero or negative argument with log
- +scale','HPLBOX',0)
- 30 IF(LERR1) CALL HBUG('User has called a routine to plot outside the
- + picture limits','HPLBOX',0)
-*
- CALL ISCLIP(1)
- CALL IGSET('FAIS',RFAIS)
- CALL IGSET('FASI',RFASI)
- CALL IGSET('FACI',RFACI)
- CALL IGSET('PLCI',RPLCI)
- CALL IGSET('LWID',RLWID)
- CALL IGSET('BORD',RBORD)
-*
- END
diff --git a/src/graflib/hplot/hplotf77/hplc.F b/src/graflib/hplot/hplotf77/hplc.F
deleted file mode 100644
index 7cbdeff..0000000
--- a/src/graflib/hplot/hplotf77/hplc.F
+++ /dev/null
@@ -1,224 +0,0 @@
-*
-* $Id: hplc.F,v 1.2 1998/07/08 13:18:03 couet Exp $
-*
-* $Log: hplc.F,v $
-* Revision 1.2 1998/07/08 13:18:03 couet
-* - in case of 2D hsitograms (prox, proy etc ..) the minimum and maximum should
-* be takne in KMIN2 and KMAX2 adresses.
-*
-* Revision 1.1.1.1 1996/01/19 10:49:58 mclareni
-* Hplot
-*
-*
-#include "hplot/pilot.h"
-*CMZ : 5.18/05 15/12/93 19.20.55 by O.Couet
-*-- Author :
- SUBROUTINE HPLC(IERROR)
-*.==========>
-*. fills /HPL9/ with HBOOK information
-*. determines YMINI and YMAXI , smallest
-*. and largest ordinates in histogram
-*. coordinates
-*. used for histogram 1D only
-*..=========>
-#include "hbook/hcbits.inc"
-#include "hbook/hcprin.inc"
-#include "hbook/hcbook.inc"
-#include "hbook/hcflag.inc"
-#include "hplot/hpl1.inc"
-#include "hplot/hpl2.inc"
-#include "hplot/hpl9.inc"
-#include "hplot/hpl13.inc"
-*._____________________________
- FACTOR = 1.0
- IERROR = 0
- NOLD = 4
- I34 = NOENT
-*----
-* I11=1 means error bars are to be calculated
-*----
- IF(I11.EQ.1)I34=1
-*----
-* abcissa limits : XMINI,XMAXI
-* XX0, XXSIZE for equidistant bins
-* ICMAX=no. of channels of the whole histogram (no zoom)
-*----
- ICMAX=NCX
- IFIRST=1
- IF(LOZOOM)IFIRST=NCMIN
- ILAST=ICMAX
- IF(LOZOOM)ILAST=NCMAX
- IF(I6.EQ.0)THEN
- XMINI=XX0+(IFIRST-1)*XXSIZE
- XMAXI=XX0+ILAST*XXSIZE
- ELSE
-*----
-* Non_equidistant bins
-*----
- LBINS=LQ(LCID-2)
- XMINI=Q(LBINS+IFIRST)
- XMAXI=Q(LBINS+ILAST+1)
- ENDIF
-*----
-* for log scales, histogram coordinates are :
-* LOG10(XMINI) and LOG10(XMAXI)
-*----
- IF(LOGXFL)THEN
- IF(XMINI.LE.0)GOTO 60
- XMINI=LOG10(XMINI)
- IF(XMAXI.LE.0)GOTO 60
- XMAXI=LOG10(XMAXI)
- ENDIF
-*----
-* ordinates limits : YMINI,YMAXI
-*----
- YMAXI=-BIGP
- YMINI=BIGP
- ALLCHA=0.
- DO 10 I=IFIRST,ILAST
- C1=HCX(I,1)
- YMAXI=MAX(YMAXI,C1)
-*----
-* for log scales, YMINI is the smallest positive value. With
-* option SAME, the previous minimum (YWMINI) is used.
-*----
- IF(LOGYFL)THEN
- IF(C1.GT.0.)THEN
- YMINI=MIN(YMINI,C1)
- ELSE
- IF(LOSAME)YMINI=10**YWMINI
- ENDIF
- ELSE
- YMINI=MIN(YMINI,C1)
- ENDIF
- ALLCHA=ALLCHA+C1
- 10 CONTINUE
-*----
-* take into account HMAXIM,HMINIM,HCOMPA
-*----
- XMIN=YMINI
- IF(I20.EQ.1)THEN
- IF(I1.NE.0)THEN
- YMAXI=Q(LCID+KMAX1)
- ELSE
- YMAXI=Q(LCID+KMAX2)
- ENDIF
- ENDIF
- IF(I21.EQ.1)THEN
- IF(I1.NE.0)THEN
- XMIN =Q(LCID+KMIN1)
- ELSE
- XMIN =Q(LCID+KMIN2)
- ENDIF
- ENDIF
- IF(LOGYFL.AND.XMIN.LE.0.)THEN
- CALL HBUG('Log scale requested with zero or negative argument:'
- + //' HMINIM (HCOMPA) ignored' ,'HPLOT ',ID)
- GOTO 20
- ENDIF
- YMINI=XMIN
- 20 CONTINUE
- IF((YMINI.GE.YMAXI).AND.(IOPTP.EQ.0))THEN
- IF(LOGYFL)THEN
- IF(YMAXI.GT.0.)THEN
- YMINI=0.001*YMAXI
- ELSE
- GOTO 50
- ENDIF
- ELSE
- YMAXI=YMINI+1.
- YMINI=YMINI-1.
- ENDIF
- ENDIF
-*----
-* take into account HNORMA
-* FACTOR=scaling factor for normalisation (HPLOT and HBOOK)
-*----
- FACTOR=ALLCHA
- IF(I18.EQ.1)FACTOR=Q(LCID+KNORM)
- IF(ALLCHA.NE.0.)FACTOR=FACTOR/ALLCHA
- IF(FACTOR.EQ.0.)FACTOR=1.
- YMAXI=YMAXI*FACTOR
- YMINI=YMINI*FACTOR
- C1=YMAXI
- IF(ABS(YMINI).GT.ABS(C1))C1=YMINI
-*
- C2=YMAXI
- IF(I20.EQ.0)THEN
- IF(I12.NE.0)THEN
- C2=HCX(IFIRST,3)
- DO 30 I=IFIRST+1,ILAST
- F1=HCX(I,3)*FACTOR
- C2=MAX(C2,F1)
- 30 CONTINUE
- ENDIF
- IF(I34.NE.0)THEN
- IF(I11.EQ.0)THEN
- DO 40 I=IFIRST,ILAST
- E1=(HCX(I,1) + HCX(I,2))*FACTOR
- YMAXI=MAX(E1,YMAXI)
- 40 CONTINUE
- ELSE
- YMAXI=YMAXI+SQRT(YMAXI)
- ENDIF
- ENDIF
- YMAXI=MAX(C2,YMAXI)
- ENDIF
-*----
-* For log scales, histogram coordinates are LOG10(YMINI) and
-* LOG10(YMAXI). Final adjustment (if not option "Same" or "Update"
-* or "+" for YMAXI) of YMAXI and YMINI for logarithmic scale, if
-* HMAXIM and HMINIM have not been called.
-*----
- IF(LOGYFL)THEN
- IF(YMINI.LE.0)GOTO 60
- YMINI=LOG10(YMINI)
- IF(I21.EQ.0) YMINI=YMINI+LOG10(0.5)
- IF(YMAXI.LE.0)GOTO 60
- YMAXI=LOG10(YMAXI)
- HSCAL=SCMAX
- IF((IOPTK.NE.0).AND.(.NOT.LOMAX))HSCAL=3.*SCMAX
- IF((I20.EQ.0).AND.(IOPTU.EQ.0).AND.(IOPTP.EQ.0)) YMAXI=YMAXI+
- + LOG10(2.*(0.9/HSCAL))
- GOTO 999
- ENDIF
-*----
-* final adjustment of YMAXI for linear scale (if not option "Same"
-* or "Update"):
-* decrease histogram height to MAX% of allowed height if HMAXIM
-* has not been called.
-* MAX% is the value in percent which has been set in HPLSET
-* (default is 90%).
-*----
- IF((I20.EQ.0.).AND.(IOPTU.EQ.0).AND.(IOPTP.EQ.0))THEN
- HSCAL=SCMAX
- IF((IOPTK.NE.0).AND.(.NOT.LOMAX))HSCAL=SCMAX/3.
- IF(YMAXI.GT.0.)THEN
- YMAXI=YMAXI*(1./HSCAL)
- ELSE
- YMAXI=YMAXI*HSCAL
- ENDIF
- ENDIF
-*-----
-* final adjustment of YMINI for linear scale.
-* if HMINIM has not been called set YMINI to zero if >0
-* or to YMINI*SCMAX if <0.
-*-----
- IF(I21.EQ.0.)THEN
- IF(YMINI.GE.0.)THEN
- YMINI=0.
- ELSE
- YMINI=YMINI*(1./SCMAX)
- ENDIF
- ENDIF
- GOTO 999
-*
- 50 CALL HBUG('Log scale is requested but maximum is less or equal 0'
- +,'HPLOT ',ID)
- IERROR = 1
- GOTO 999
-*
- 60 CALL HBUG('Routine called with zero or negative argument with log
- +scale','HPLOT ',ID)
-*
- 999 END
diff --git a/src/graflib/hplot/hplotf77/hplcap.F b/src/graflib/hplot/hplotf77/hplcap.F
deleted file mode 100644
index 4b402cb..0000000
--- a/src/graflib/hplot/hplotf77/hplcap.F
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: hplcap.F,v 1.1.1.1 1996/01/19 10:49:58 mclareni Exp $
-*
-* $Log: hplcap.F,v $
-* Revision 1.1.1.1 1996/01/19 10:49:58 mclareni
-* Hplot
-*
-*
-#include "hplot/pilot.h"
-*CMZ : 5.04/12 16/01/89 12.08.13 by O.Couet
-*-- Author :
- SUBROUTINE HPLCAP (IUNIT)
-*.==========>
-*. To open/activate/deactivate/close metafile or screen
-*..=========>
-*._____________________________
-*
-*----
- CALL IGMETA(IUNIT,0)
-*
- END
-
diff --git a/src/graflib/hplot/hplotf77/hplcha.F b/src/graflib/hplot/hplotf77/hplcha.F
deleted file mode 100644
index 24041d0..0000000
--- a/src/graflib/hplot/hplotf77/hplcha.F
+++ /dev/null
@@ -1,91 +0,0 @@
-*
-* $Id: hplcha.F,v 1.1.1.1 1996/01/19 10:49:58 mclareni Exp $
-*
-* $Log: hplcha.F,v $
-* Revision 1.1.1.1 1996/01/19 10:49:58 mclareni
-* Hplot
-*
-*
-#include "hplot/pilot.h"
-*CMZ : 5.20/00 26/04/95 09.26.27 by O.Couet
-*-- Author :
- SUBROUTINE HPLCHA(NT,XLOC,YLOC,IDH,XLOCH,YLOCH,ICX,ICY)
-*.==========>
-*. To convert a point as returned by the HIGZ routine
-*. IRQLC in histogram coordinates and to return the
-*. value IDH of the latest plotted histogram in selection
-*. transformation NT.
-*..=========>
-#include "hbook/hcbits.inc"
-#include "hplot/hpl0.inc"
-#include "hplot/hpl1.inc"
-#include "hplot/quest.inc"
- CHARACTER*8 CHPID(15)
- DIMENSION IPID(15)
- LOGICAL HEXIST
-*._____________________________
-*
- IDH = 0
- ICX = 0
- ICY = 0
- IQUEST(3) = 0
-*
-* Convert to histogram coordinates if LOG scales
-*
- IW = NT/10
- IF(IW.LE.0.OR.IW.GT.100)RETURN
- IF(IPICT(IW,1).NE.0)THEN
- XLOCH = 10.**XLOC
- ELSE
- XLOCH = XLOC
- ENDIF
- IF(IPICT(IW,2).NE.0)THEN
- YLOCH = 10.**YLOC
- ELSE
- YLOCH = YLOC
- ENDIF
-*
- IF(LOZFL)THEN
- CALL IGPICK(NT,XLOC,YLOC,NBLEV,CHPID,IPID,' ')
- IF(NBLEV.LE.1)GOTO 10
- IDH = IPID(1)
- IF(CHPID(1)(1:2).EQ.'1d')THEN
- IF(HEXIST(IDH))THEN
- CALL HXI(IDH,XLOCH,ICX)
- ELSE
- IDH = 0
- ENDIF
- ELSEIF(CHPID(1)(1:2).EQ.'2d')THEN
- IF(HEXIST(IDH))THEN
- CALL HXYIJ(IDH,XLOC,YLOC,ICX,ICY)
- ELSE
- IDH = 0
- ENDIF
- ELSEIF(CHPID(1)(1:6).EQ.'ntuple')THEN
- IQUEST(3) = 1
- ICX = IPID(2)
- ENDIF
- GOTO 20
- ENDIF
-*
-* Get IDH from NT
-*
- 10 IDH = IPICT(IW,3)
- IF(HEXIST(IDH))THEN
- CALL HFIND(IDH,'HPLCHA')
- CALL HDCOFL
- IF(I1.NE.0)THEN
- CALL HXI(IDH,XLOCH,ICX)
- ELSE
- CALL HXYIJ(IDH,XLOCH,YLOCH,ICX,ICY)
- ENDIF
- ELSE
- IDH=0
- ENDIF
-*
- 20 IQUEST(1) = 0
- IQUEST(2) = 0
- IF(IPICT(IW,1).NE.0)IQUEST(1) = 1
- IF(IPICT(IW,2).NE.0)IQUEST(2) = 1
-*
- END
diff --git a/src/graflib/hplot/hplotf77/hplcol.F b/src/graflib/hplot/hplotf77/hplcol.F
deleted file mode 100644
index 279ddf4..0000000
--- a/src/graflib/hplot/hplotf77/hplcol.F
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: hplcol.F,v 1.1.1.1 1996/01/19 10:49:58 mclareni Exp $
-*
-* $Log: hplcol.F,v $
-* Revision 1.1.1.1 1996/01/19 10:49:58 mclareni
-* Hplot
-*
-*
-#include "hplot/pilot.h"
-*CMZ : 5.04/12 16/01/89 12.08.13 by O.Couet
-*-- Author :
- SUBROUTINE HPLCOL(ICOLOR)
- CALL HBUG('Obsolete routine: see new fonctionnality of HPLSET'
- +,'HPLCOL',0)
- END
-
diff --git a/src/graflib/hplot/hplotf77/hplcom.F b/src/graflib/hplot/hplotf77/hplcom.F
deleted file mode 100644
index 7c87404..0000000
--- a/src/graflib/hplot/hplotf77/hplcom.F
+++ /dev/null
@@ -1,55 +0,0 @@
-*
-* $Id: hplcom.F,v 1.1.1.1 1996/01/19 10:49:58 mclareni Exp $
-*
-* $Log: hplcom.F,v $
-* Revision 1.1.1.1 1996/01/19 10:49:58 mclareni
-* Hplot
-*
-*
-#include "hplot/pilot.h"
-*CMZ : 5.20/00 19/04/95 10.26.37 by O.Couet
-*-- Author :
- SUBROUTINE HPLCOM(XU,YU,CHTITL)
-*.==========>
-*. HPLOT routine to write comments on the picture
-*. (Cm are used for call to HPLTXT)
-*..=========>
-#include "hplot/hpl1.inc"
-#include "hplot/hpl6.inc"
- CHARACTER*(*) CHTITL
- DIMENSION RTXFP(2)
-*._____________________________
-*
-*----
-* Return immediately if this routine is called before
-* the first HPLOT call
-*----
- IF(IPLNUM.LT.0)THEN
- CALL HBUG('HPLCOM must be called after HPLOT','HPLCOM',0)
- RETURN
- ENDIF
-*
- CALL IGQ('TXFP',RTXFP)
-*
- XM = FLOARG(XU)
- YM = FLOARG(YU)
- XK = ABS(XM)
- YK = ABS(YM)
-*
- KORNT = 1
- KFLG = 1
- IF (XM.LT.0.) KFLG = 2
- IF (YM.LT.0.) KFLG = KFLG+1
-*---
-* Set Comment font and precision
-*----
- KFONT = IABS(IHFONT(5))
- ITXFON = KFONT/10
- ITXPRE = MOD(KFONT,10)
- IF (IHFONT(5).LT.0) ITXFON = -ITXFON
- CALL ISTXFP(ITXFON,ITXPRE)
-*
- CALL HPLTXT(XK,YK,CHTITL,5,KORNT,KFLG)
-*
- CALL ISTXFP(INT(RTXFP(1)),INT(RTXFP(2)))
- END
diff --git a/src/graflib/hplot/hplotf77/hplcon.F b/src/graflib/hplot/hplotf77/hplcon.F
deleted file mode 100644
index 78fa734..0000000
--- a/src/graflib/hplot/hplotf77/hplcon.F
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: hplcon.F,v 1.1.1.1 1996/01/19 10:49:58 mclareni Exp $
-*
-* $Log: hplcon.F,v $
-* Revision 1.1.1.1 1996/01/19 10:49:58 mclareni
-* Hplot
-*
-*
-#include "hplot/pilot.h"
-*CMZ : 5.17/08 29/09/93 11.59.27 by O.Couet
-*-- Author :
- SUBROUTINE HPLCON(IDD,ICRES,ITYPE)
-*.==========>
-*. Subroutine to draw a contour plot based on a two dimensional
-*. scatter plot from HBOOK
-*.
-*. IDD - ID of two dimensional histogram
-*. ICRES - resolution of contour plot (number of contour lines)
-*. minimum 2, maximum 50
-*. ITYPE = 0 - use colour to distinguish contours
-*. = 1 - use line style to distinguish contours
-*. = 2 - line style and colour are the same for all contours
-*.
-*..=========>
- DIMENSION PAR(2)
-*._____________________________
-*
- PAR(1)=FLOAT(ICRES)
- PAR(2)=FLOAT(ITYPE)
- CALL HPLTAB(IDD,2,PAR,'CONT')
-*
- END
diff --git a/src/graflib/hplot/hplotf77/hpldat.F b/src/graflib/hplot/hplotf77/hpldat.F
deleted file mode 100644
index 2734ed1..0000000
--- a/src/graflib/hplot/hplotf77/hpldat.F
+++ /dev/null
@@ -1,92 +0,0 @@
-*
-* $Id: hpldat.F,v 1.4 1998/11/09 10:44:47 couet Exp $
-*
-* $Log: hpldat.F,v $
-* Revision 1.4 1998/11/09 10:44:47 couet
-* - Call IGDATE to be Y2K compliant
-*
-* Revision 1.3 1998/01/30 15:25:16 couet
-* - APOLLO version removed
-*
-* Revision 1.2 1997/03/14 14:24:28 mclareni
-* WNT mods
-*
-* Revision 1.1.1.1.2.1 1997/01/21 11:25:44 mclareni
-* All mods for Winnt 96a on winnt branch
-*
-* Revision 1.1.1.1 1996/01/19 10:49:58 mclareni
-* Hplot
-*
-*
-#include "hplot/pilot.h"
-*CMZ : 5.20/00 19/04/95 10.26.37 by O.Couet
-*-- Author : O.Couet 13/01/89
- SUBROUTINE HPLDAT
-*.==========>
-*.
-*. Draw the current DATE and TIME on the current histogram.
-*.
-*..==========> (O.Couet)
-#include "hplot/hpl1.inc"
-#include "hplot/hpl6.inc"
-#include "hplot/hpl2.inc"
-#include "hplot/hpl4.inc"
-#include "hplot/hpl13.inc"
- DIMENSION RTXFP(2)
- CHARACTER*32 CHDT
- SAVE IPRDAT
- DATA IPRDAT /0/
-*._____________________________
-*
- IF((.NOT.LODATE).OR.(IOPTU.NE.0).OR.(LOSAME))RETURN
- IF((IWIN.EQ.IWIN0).AND.(.NOT.LWSAME))IPRDAT=0
- IF(IPRDAT.EQ.1.AND.LOWIND)RETURN
- IPRDAT=1
-*
- CALL IGQ('TXFP',RTXFP)
- TVCOM=TVSIZ(5)
-*
-* Set date font and precision
-*
- NTWOLD=NTWIN
- KFONT=IABS(IHFONT(5))
- ITXFON=KFONT/10
- ITXPRE=MOD(KFONT,10)
- IF(IHFONT(5).LT.0)ITXFON=-ITXFON
- CALL ISTXFP(ITXFON,ITXPRE)
-*
-* Draw the date
-*
- CALL IGDATE(CHDT)
- IF(TVSIZ(5).EQ.0.)TVSIZ(5)=0.28
- IF(IDATE.EQ.1)THEN
- KFLG=1
- XK=0.5
- YK=YSIZ-0.5-TVSIZ(5)
- ELSEIF(IDATE.EQ.2)THEN
- KFLG=3
- XK=XSIZ-0.5
- YK=YSIZ-0.5-TVSIZ(5)
- ELSEIF(IDATE.EQ.3)THEN
- KFLG=1
- XK=0.5
- YK=0.5
- ELSEIF(IDATE.EQ.4)THEN
- KFLG=3
- XK=XSIZ-0.5
- YK=0.5
- ENDIF
- CALL HPLTXT(XK,YK,CHDT,5,1,KFLG)
-*
- TVSIZ(5)=TVCOM
-*
-* Reset NT
-*
- IF(NTWIN.NE.NTWOLD)THEN
- NTWIN=NTWOLD
- CALL ISELNT(NTWOLD)
- ENDIF
- IF(LOZFL)CALL IZPICT(' ','O')
-*
- CALL ISTXFP(INT(RTXFP(1)),INT(RTXFP(2)))
- END
diff --git a/src/graflib/hplot/hplotf77/hpldes.F b/src/graflib/hplot/hplotf77/hpldes.F
deleted file mode 100644
index bfcbb17..0000000
--- a/src/graflib/hplot/hplotf77/hpldes.F
+++ /dev/null
@@ -1,39 +0,0 @@
-*
-* $Id: hpldes.F,v 1.1.1.1 1996/01/19 10:49:58 mclareni Exp $
-*
-* $Log: hpldes.F,v $
-* Revision 1.1.1.1 1996/01/19 10:49:58 mclareni
-* Hplot
-*
-*
-#include "hplot/pilot.h"
-*CMZ : 5.04/12 16/01/89 12.08.14 by O.Couet
-*-- Author :
- SUBROUTINE HPLDES(IDH)
-*.==========>
-*. Fills the common HPL0 which contains a description
-*. of each windows of the picture (number of
-*. transformation NTWIN, flag LOGXFL and LOGYFL, ...)
-*..=========>
-#include "hplot/hpl0.inc"
-#include "hplot/hpl1.inc"
-#include "hplot/hpl2.inc"
-#include "hplot/hpl13.inc"
-*._____________________________
-*
- IF((IOPTS.NE.0).OR.(IOPTU.NE.0).OR.(IOPTP.NE.0))GOTO 999
-*----
-* Fills IPICT according to NTWIN, LOGXFL and LOGYFL for each zone.
-*----
- IW=NTWIN/10
- IF(IW.LE.100)THEN
- IPICT(IW,1)=0
- IPICT(IW,2)=0
- IPICT(IW,3)=IDH
- IF(LOGXFL)IPICT(IW,1)=1
- IF(LOGYFL)IPICT(IW,2)=1
- ENDIF
-*
- 999 RETURN
- END
-
diff --git a/src/graflib/hplot/hplotf77/hpldo.F b/src/graflib/hplot/hplotf77/hpldo.F
deleted file mode 100644
index fc6409c..0000000
--- a/src/graflib/hplot/hplotf77/hpldo.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: hpldo.F,v 1.1.1.1 1996/01/19 10:49:58 mclareni Exp $
-*
-* $Log: hpldo.F,v $
-* Revision 1.1.1.1 1996/01/19 10:49:58 mclareni
-* Hplot
-*
-*
-#include "hplot/pilot.h"
-*CMZ : 5.04/12 16/01/89 12.08.14 by O.Couet
-*-- Author :
- SUBROUTINE HPLDO(IWTYP)
-*.==========>
-*. Single routine to plot everything
-*. - like HISTDO -
-*..=========>
- CALL HPLINT(IWTYP)
- CALL HPLOT(0,' ',' ',0)
-*
-*----
-* Call optional user routine hplnxt before hplend
-*----
- CALL HPLNXT
- CALL HPLEND
- END
-
diff --git a/src/graflib/hplot/hplotf77/hplego.F b/src/graflib/hplot/hplotf77/hplego.F
deleted file mode 100644
index ceecad9..0000000
--- a/src/graflib/hplot/hplotf77/hplego.F
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: hplego.F,v 1.1.1.1 1996/01/19 10:49:58 mclareni Exp $
-*
-* $Log: hplego.F,v $
-* Revision 1.1.1.1 1996/01/19 10:49:58 mclareni
-* Hplot
-*
-*
-#include "hplot/pilot.h"
-*CMZ : 5.17/08 29/09/93 11.59.27 by O.Couet
-*-- Author :
- SUBROUTINE HPLEGO(IDD,THETA,PHI)
-*.==========>
-*. HPLOT 3-D viewing routine
-*. contents of cells are represented as boxes
-*. with automatic hidden lines removal
-*..=========>
- DIMENSION PAR(2)
-*._____________________________
-*
- PAR(1)=THETA
- PAR(2)=PHI
- CALL HPLTAB(IDD,2,PAR,'LEGO')
-*
- END
diff --git a/src/graflib/hplot/hplotf77/hplend.F b/src/graflib/hplot/hplotf77/hplend.F
deleted file mode 100644
index 16361ef..0000000
--- a/src/graflib/hplot/hplotf77/hplend.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: hplend.F,v 1.1.1.1 1996/01/19 10:49:58 mclareni Exp $
-*
-* $Log: hplend.F,v $
-* Revision 1.1.1.1 1996/01/19 10:49:58 mclareni
-* Hplot
-*
-*
-#include "hplot/pilot.h"
-*CMZ : 5.04/12 16/01/89 12.08.15 by O.Couet
-*-- Author :
- SUBROUTINE HPLEND
-*.==========>
-*. terminates the HIGZ file and writes closing messages
-*..=========>
-#include "hplot/hpl1.inc"
- CHARACTER*10 STRING
-*._____________________________
-*
-* Request string (CR) if option PTO selected
-*
- IF(LOPTO)THEN
- CALL HPLPTO(' ',STRING)
- ENDIF
- CALL IGEND
-*
- END
-
diff --git a/src/graflib/hplot/hplotf77/hplerr.F b/src/graflib/hplot/hplotf77/hplerr.F
deleted file mode 100644
index 6a3a08a..0000000
--- a/src/graflib/hplot/hplotf77/hplerr.F
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: hplerr.F,v 1.1.1.1 1996/01/19 10:49:58 mclareni Exp $
-*
-* $Log: hplerr.F,v $
-* Revision 1.1.1.1 1996/01/19 10:49:58 mclareni
-* Hplot
-*
-*
-#include "hplot/pilot.h"
-*CMZ : 5.17/05 24/08/93 18.07.32 by O.Couet
-*-- Author :
- SUBROUTINE HPLERR(XU,YU,DXU,DYU,N,CHOPT,ISYM,USIZE)
-*.==========>
-*. draws error bars defined by the user
-*. symbol ISYM is drawn at the centre of the errors
-*. (Transformation NTHIST or 1 is selected
-*. according to CHOPT)
-*..=========>
- CHARACTER*(*) CHOPT
- DIMENSION XU(1),YU(1),DXU(1),DYU(1)
-*._____________________________
-*
- CALL HPLAER(XU,YU,DXU,DXU,DYU,DYU,N,CHOPT,ISYM,USIZE)
- END
diff --git a/src/graflib/hplot/hplotf77/hplf.F b/src/graflib/hplot/hplotf77/hplf.F
deleted file mode 100644
index 0a2de3a..0000000
--- a/src/graflib/hplot/hplotf77/hplf.F
+++ /dev/null
@@ -1,343 +0,0 @@
-*
-* $Id: hplf.F,v 1.1.1.1 1996/01/19 10:49:58 mclareni Exp $
-*
-* $Log: hplf.F,v $
-* Revision 1.1.1.1 1996/01/19 10:49:58 mclareni
-* Hplot
-*
-*
-#include "hplot/pilot.h"
-*CMZ : 5.20/02 11/07/95 10.21.04 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE HPLF(IFUN)
-*.==========>
-*. draws a function
-*..=========>
-#include "hplot/quest.inc"
-#include "hplot/hpl1.inc"
-#include "hplot/hpl2.inc"
-#include "hplot/hpl4.inc"
-#include "hplot/hpl6.inc"
-#include "hplot/hpl9.inc"
-#include "hplot/hpl11.inc"
-#include "hbook/hcbook.inc"
-#include "hbook/hcbits.inc"
-#include "hbook/hcfits.inc"
-#include "hbook/hcfitd.inc"
- CHARACTER*4 NAME
- CHARACTER*8 CHOPT
-#if defined(CERNLIB_DOUBLE)
- PARAMETER (NWW=2)
- DOUBLE PRECISION SS
-#endif
-#if !defined(CERNLIB_DOUBLE)
- PARAMETER (NWW=1)
- REAL SS
-#endif
-*._____________________________
-*
- CALL IGQ('LWID',RLWID)
- CALL IGQ('FAIS',RFAIS)
- CALL IGQ('FASI',RFASI)
- CALL IGQ('FACI',RFACI)
- CALL IGQ('PLCI',RPLCI)
- CALL IGQ('BORD',RBORD)
- CALL IGQ('MSCF',RMSCF)
-*
- IF (LOASTK) THEN
- IF(YMAXI.EQ.YMINI)GOTO 999
- RTY = (YHIGH-YLOW)/(YMAXI-YMINI)
- SC = RTY*TVSIZ(8)
- SCN = (SC*XYTWN)/0.009
- CALL ISMKSC(SCN)
- ENDIF
-*----
-* Retrieve the first (IFIRST) and last (ILAST)
-* channels, compute the numbers of bins (NBINS),
-* take care of the option ZOOM (HPLZOM) and compute
-* the X value corresponding to IFIRST an ILAST.
-*----
- IF (IFUN.EQ.3) THEN
- LFUNC = LQ(LCONT-1)
- IFIRST = IQ(LFUNC+1)
- ILAST = IQ(LFUNC+2)
- ELSE
- IFIRST = 1
- ILAST = ICMAX
- ENDIF
- IF (LOZOOM) THEN
- IF (IFIRST.GT.NCMAX) GOTO 999
- IF (ILAST .LT.NCMIN) GOTO 999
- IFIRST = MAX(NCMIN,IFIRST)
- ILAST = MIN(NCMAX,ILAST)
- ENDIF
- NBINS = ILAST-IFIRST+1
- XFIRST = XX0+XXSIZE*(IFIRST-1)
- XLAST = XX0+XXSIZE*ILAST
-*----
-* Retrieve the fit parameters
-*----
- IFITTY = 0
- IF (LCID.NE.0) THEN
- LFUNC = LQ(LCONT-1)
- IF (LFUNC.EQ.0) GOTO 90
- IF (IQ(LFUNC-2).EQ.0) GO TO 90
- LHFIT = LQ(LFUNC-1)
- IF (LHFIT.EQ.0) GO TO 90
- IF (JBIT(IQ(LHFIT),5).EQ.0) THEN
-* Old format
- NFPAR = Q(LHFIT+1)
- IF (NFPAR.EQ.0) GO TO 90
- NPFITS = Q(LHFIT+2)
- FITCHI = Q(LHFIT+3)
- DO 10 I=1,NFPAR
- FITPAR(I) = Q(LHFIT+ 4+I)
- FITSIG(I) = Q(LHFIT+24+I)
- CALL UHTOC(Q(LHFIT+43+2*I),4,FITNAM(I),8)
- 10 CONTINUE
- IF (FITNAM(1).EQ.'Constant') IFITTY = NFPAR
- IF (FITNAM(1)(1:2).EQ.'A0') IFITTY = 1
- ELSE
-* New format (29/07/92).
- IFITTY = IQ(LHFIT+1)
- IF (IFITTY.EQ.0) GO TO 90
- NFPAR = IQ(LHFIT+2)
- IF (NFPAR.EQ.0) GO TO 90
- NPFITS = IQ(LHFIT+3)
- NOTHER = IQ(LHFIT+4)
- FITCHI = Q(LHFIT+6)
- IF (IFITTY.EQ.4) THEN
- CALL HQGETF(LHFIT)
- ELSE
- NP = MIN(NFPAR,35)
- II = 11
- DO 20 I=1,NP
- CALL UCOPY(Q(LHFIT+II),SS,NWW)
- FITPAD(I) = SS
- FITPAR(I) = SS
-* Note: FITPAR is only single precision.
- II = II+NWW
- 20 CONTINUE
- NWERR = IQ(LHFIT-1)-NWW*(NFPAR+NOTHER)
- IF (NWERR.GT.0) THEN
- II = IQ(LHFIT-1)-NWERR+11
- DO 30 I=1,NP
- CALL UCOPY(Q(LHFIT+II),SS,NWW)
- FITSIG(I) = SS
-* Note: FITSIG is only single precision.
- II = II+NWW
- 30 CONTINUE
- ELSE
- CALL VZERO(FITSIG,NP)
- ENDIF
-* Get names if available, otherwise generate from IFITTY.
- DO 40 I=1,NP
- FITNAM(I) = ' '
- 40 CONTINUE
- IF (IFITTY.EQ.1) THEN
-* Polynomial.
- N1 = MAX(NP,10)
- DO 50 I=1,N1
- WRITE(FITNAM(I),'(''A'',I1,6X)')I-1
- 50 CONTINUE
- IF (NP.GT.10) THEN
- DO 60 I=11,NP
- WRITE(FITNAM(I),'(''A'',I2,5X)')I-1
- 60 CONTINUE
- END IF
- ELSE IF (IFITTY.EQ.2) THEN
-* Exponential.
- FITNAM(1) = 'Constant'
- FITNAM(2) = 'Slope'
- ELSE IF (IFITTY.EQ.3) THEN
-* Gaussian.
- FITNAM(1) = 'Constant'
- FITNAM(2) = 'Mean'
- FITNAM(3) = 'Sigma'
- ELSE IF (IFITTY.NE.4) THEN
- L = LQ(LHFIT)
- 70 CONTINUE
- IF (L.NE.0) THEN
- CALL UHTOC(IQ(L-4),4,NAME,4)
- IF (NAME.EQ.'HFNA') THEN
- DO 80 I=1,NP
- CALL UHTOC(Q(L+2*I-1),4,FITNAM(I),8)
- 80 CONTINUE
- ELSE
- GO TO 70
- END IF
- END IF
- END IF
- END IF
-* Get covariances if required and when available.
- END IF
- IF (IFITTY.GT.0.AND.IFITTY.LT.100) GOTO 110
- ENDIF
-*
- 90 IF (LQ(LHPLOT-3).NE.0) CALL MZDROP(IHDIV,LQ(LHPLOT-3),' ')
- IF (LQ(LHPLOT-4).NE.0) CALL MZDROP(IHDIV,LQ(LHPLOT-4),' ')
- IF (I6.EQ.0) THEN
-*----
-* Equidistant bins
-*----
- CALL MZNEED(IHDIV,2+(NBINS+1)+50,'G')
- IF (IQUEST(11).LT.0) THEN
- CALL HBUG('Not enough space in memory','HPLOT',IDD)
- GOTO 999
- ENDIF
- CALL MZBOOK(IHDIV,LX,LHPLOT,-3,'TMPX',0,0,2,3,0)
- ELSE
-*----
-* Non_equidistant bins
-*----
- CALL MZNEED(IHDIV,2*(NBINS+1)+50,'G')
- IF (IQUEST(11).LT.0) THEN
- CALL HBUG('Not enough space in memory','HPLOT',IDD)
- GOTO 999
- ENDIF
- CALL MZBOOK(IHDIV,LX,LHPLOT,-3,'TMPX',0,0,NBINS+1,3,0)
- ENDIF
- CALL MZBOOK(IHDIV,LY,LHPLOT,-4,'TMPY',0,0,NBINS+1,3,0)
-*
- IF (I6.EQ.0) THEN
-*----
-* Equidistant bins
-*----
- Q(LX+1) = XFIRST
- Q(LX+2) = XLAST
- ELSE
-*----
-* Non_equidistant bins
-*----
- LBINS = LQ(LCID-2)
- Q(LX+1) = Q(LBINS+IFIRST)
- ENDIF
-*
- DO 100 I=1,NBINS
- IF (I6.NE.0) THEN
- Q(LX+I+1) = Q(LBINS+I+IFIRST)
- ENDIF
- F1 = HCX(I+IFIRST-1,IFUN)
- IF (.NOT.LOGYFL) THEN
- Q(LY+I) = F1
- ELSE
- F1 = AMAX1(F1,10**YMINI)
- Q(LY+I) = ALOG10(F1)
- ENDIF
- 100 CONTINUE
-*----
-* Attributes setting
-*----
- 110 CALL HPLATT(2)
-*----
-* CHOPT encoding
-*----
- CHOPT = ' '
- IF (LOASTK) THEN
- CHOPT(1:1) = '*'
- ELSE
- IF (IFITTY.GT.0.AND.IFITTY.LT.100) THEN
- CHOPT(2:2) = 'L'
- ELSE
- CHOPT(2:2) = 'C'
- ENDIF
- ENDIF
- IF (I6.NE.0)CHOPT(3:3) = 'N'
- IF (IFTYP.NE.1000.AND.IFTYP.NE.0) THEN
- CHOPT(4:4) = 'F'
- IF (LOGYFL) CHOPT(5:5) = '1'
- ENDIF
- IF (LOGXFL) CHOPT(6:7) = 'GX'
-*----
-* Draws the special functions according to IFITTY:
-*
-* IFITTY = 1 --> Polynomial
-* IFITTY = 2 --> Exponential
-* IFITTY = 3 --> Gaussian
-* IFITTY = 4 --> Multiquadric
-*
-*----
- IF (IFITTY.GT.0.AND.IFITTY.LT.100) THEN
- NP = 199
- IF (LOGXFL) THEN
- XSTP = (10**XMAXI-10**XMINI)/FLOAT(NP-1)
- ELSE
- XSTP = (XMAXI-XMINI)/FLOAT(NP-1)
- ENDIF
-*
- IS = 1
- IE = NP
- XDIFF1 = ABS(XLAST-XFIRST)
- XDIFF2 = XDIFF1
-*
- DO 120 I=1,NP
- IF (LOGXFL) THEN
- XLINE(I) = 10**XMINI+(I-1)*XSTP
- ELSE
- XLINE(I) = XMINI+(I-1)*XSTP
- ENDIF
-*
- IF (ABS(XLINE(I)-XFIRST).LT.XDIFF1) THEN
- XDIFF1 = ABS(XLINE(I)-XFIRST)
- IS = I
- ENDIF
- IF (ABS(XLINE(I)-XLAST).LT.XDIFF2) THEN
- XDIFF2 = ABS(XLINE(I)-XLAST)
- IE = I
- ENDIF
-*
- IF (IFITTY.EQ.1) YLINE(I) = HPOLYN(XLINE(I))
- IF (IFITTY.EQ.2) YLINE(I) = HDEXPO(XLINE(I))
- IF (IFITTY.EQ.3) YLINE(I) = HGAUS(XLINE(I))
- IF (IFITTY.EQ.4) YLINE(I) = HQF(XLINE(I))
- IF (LOGYFL) THEN
- YLINE(I) = MIN(10**YMAXI,YLINE(I))
- YLINE(I) = AMAX1(YLINE(I),10**YMINI)
- YLINE(I) = ALOG10(YLINE(I))
- ELSE
- YLINE(I) = MIN(YMAXI,YLINE(I))
- ENDIF
- 120 CONTINUE
-*
- NP = IE-IS+1
-*
- IF (CHOPT(4:4).EQ.'F') THEN
- IF (LOGXFL) THEN
- XLINE(200) = 10**XMAXI
- XLINE(201) = 10**XMINI
- ELSE
- XLINE(200) = XMAXI
- XLINE(201) = XMINI
- ENDIF
- YLINE(200) = YMINI
- YLINE(201) = YMINI
- NP = NP+2
- YLINE(IE+1) = YMINI
- YLINE(IE+2) = YMINI
- XLINE(IE+1) = XLINE(IE)
- XLINE(IE+2) = XLINE(IS)
- ENDIF
- CALL IGRAPH(NP,XLINE(IS),YLINE(IS),CHOPT)
- ELSE
-*----
-* Draws the function
-*----
- IQUEST(81) = LX+1
- IQUEST(82) = LY+1
- CHOPT(8:8) = 'Z'
- CALL IGHIST(NBINS,Q(LX),Q(LY),CHOPT)
- CALL MZDROP(IHDIV,LQ(LHPLOT-3),' ')
- CALL MZDROP(IHDIV,LQ(LHPLOT-4),' ')
- LQ(LHPLOT-3) = 0
- LQ(LHPLOT-4) = 0
- ENDIF
-*
- 999 CALL IGSET('LWID',RLWID)
- CALL IGSET('FAIS',RFAIS)
- CALL IGSET('FASI',RFASI)
- CALL IGSET('FACI',RFACI)
- CALL IGSET('PLCI',RPLCI)
- CALL IGSET('BORD',RBORD)
- CALL IGSET('MSCF',RMSCF)
-*
- END
diff --git a/src/graflib/hplot/hplotf77/hplfil.F b/src/graflib/hplot/hplotf77/hplfil.F
deleted file mode 100644
index 76ed828..0000000
--- a/src/graflib/hplot/hplotf77/hplfil.F
+++ /dev/null
@@ -1,81 +0,0 @@
-*
-* $Id: hplfil.F,v 1.2 1997/05/22 11:00:01 couet Exp $
-*
-* $Log: hplfil.F,v $
-* Revision 1.2 1997/05/22 11:00:01 couet
-* - The file name position was controlled with YLAB.
-*
-* Revision 1.1.1.1 1996/01/19 10:49:58 mclareni
-* Hplot
-*
-*
-#include "hplot/pilot.h"
-*CMZ : 5.20/00 19/04/95 10.26.37 by O.Couet
-*-- Author : O.Couet 13/01/89
- SUBROUTINE HPLFIL
-*.==========>
-*.
-*. Draw the current FILE name on the current histogram.
-*.
-*..==========> (O.Couet)
-#include "hbook/hcdire.inc"
-#include "hplot/hpl1.inc"
-#include "hplot/hpl6.inc"
-#include "hplot/hpl2.inc"
-#include "hplot/hpl4.inc"
-#include "hplot/hpl13.inc"
-#include "hplot/hplstr.inc"
- DIMENSION RTXFP(2)
-*._____________________________
-*
- IF(.NOT.LOFILE.OR.IOPTU.NE.0)RETURN
-*
- CALL IGQ('TXFP',RTXFP)
- TVCOM = TVSIZ(5)
-*
-* Set file name font and precision
-*
- NTWOLD = NTWIN
- KFONT = IABS(IHFONT(5))
- ITXFON = KFONT/10
- ITXPRE = MOD(KFONT,10)
- IF(IHFONT(5).LT.0)ITXFON = -ITXFON
- CALL ISTXFP(ITXFON,ITXPRE)
- CHTEMP = ' '
- CHTEMP = HFNAME(ICDIR)
- IF(ITXFON.EQ.0)CALL IGTCCH(CHTEMP(1:96))
-*
-* Draw the file name
-*
- IF(TVSIZ(5).EQ.0.)TVSIZ(5) = 0.28
- IF(IFILE.EQ.1)THEN
- KFLG = 1
- XK = XLOW
- YK = YHIGH+0.8-XLVAL-TVSIZ(5)
- ELSEIF(IFILE.EQ.2)THEN
- KFLG = 3
- XK = XHIGH
- YK = YHIGH+0.8-XLVAL-TVSIZ(5)
- ELSEIF(IFILE.EQ.3)THEN
- KFLG = 1
- XK = XLOW
- YK = YLOW-0.8
- ELSEIF(IFILE.EQ.4)THEN
- KFLG = 3
- XK = XHIGH
- YK = YLOW-0.8
- ENDIF
- CALL HPLTXT(XK,YK,CHTEMP,5,1,KFLG)
-*
- TVSIZ(5) = TVCOM
-*
-* Reset NT
-*
- IF(NTWIN.NE.NTWOLD)THEN
- NTWIN = NTWOLD
- CALL ISELNT(NTWOLD)
- ENDIF
- IF(LOZFL)CALL IZPICT(' ','O')
-*
- CALL ISTXFP(INT(RTXFP(1)),INT(RTXFP(2)))
- END
diff --git a/src/graflib/hplot/hplotf77/hplfit.F b/src/graflib/hplot/hplotf77/hplfit.F
deleted file mode 100644
index 47c5cca..0000000
--- a/src/graflib/hplot/hplotf77/hplfit.F
+++ /dev/null
@@ -1,307 +0,0 @@
-*
-* $Id: hplfit.F,v 1.1.1.1 1996/01/19 10:49:58 mclareni Exp $
-*
-* $Log: hplfit.F,v $
-* Revision 1.1.1.1 1996/01/19 10:49:58 mclareni
-* Hplot
-*
-*
-#include "hplot/pilot.h"
-*CMZ : 5.20/00 19/04/95 10.26.37 by O.Couet
-*-- Author :
- SUBROUTINE HPLFIT
-*.==========>
-*.
-*. Print fit informations on picture.
-*.
-*..==========> (O.Couet)
-#include "hbook/hcbook.inc"
-#include "hbook/hcbits.inc"
-#include "hbook/hcfits.inc"
-#include "hbook/hcfitd.inc"
-#include "hplot/hpl1.inc"
-#include "hplot/hpl2.inc"
-#include "hplot/hpl4.inc"
-#include "hplot/hpl6.inc"
-#include "hplot/hpl13.inc"
- CHARACTER*4 NAME
- CHARACTER*32 CTEXT
- DIMENSION RTXFP(2), RTXAL(2)
- DIMENSION VPNT(4),VP1(4),IBIT(3)
-#if defined(CERNLIB_DOUBLE)
- PARAMETER (NWW=2)
- DOUBLE PRECISION SS
-#endif
-#if !defined(CERNLIB_DOUBLE)
- PARAMETER (NWW=1)
- REAL SS
-#endif
-*.______________________________________
-*
- IF((IOPTU.NE.0).OR.(.NOT.LOFIT))RETURN
-*
-* Copy Fit parameters from Zebra structure
-*
- IF(LCID.NE.0)THEN
- LFUNC=LQ(LCONT-1)
- IF(LFUNC.EQ.0)RETURN
- IF(IQ(LFUNC-2).EQ.0)RETURN
- LHFIT =LQ(LFUNC-1)
- IF(LHFIT.EQ.0)RETURN
- IF(JBIT(IQ(LHFIT),5).EQ.0)THEN
-* Old format
- NFPAR =Q(LHFIT+1)
- NFLINE=NFPAR
- IF(NFPAR.EQ.0)RETURN
- NPFITS=Q(LHFIT+2)
- FITCHI=Q(LHFIT+3)
- DO 10 I=1,NFPAR
- FITPAR(I)=Q(LHFIT+ 4+I)
- FITSIG(I)=Q(LHFIT+24+I)
- CALL UHTOC(Q(LHFIT+43+2*I),4,FITNAM(I),8)
- 10 CONTINUE
- IF(FITNAM(1).EQ.'Constant')IFITTY=NFPAR
- IF(FITNAM(1)(1:2).EQ.'A0')IFITTY=1
- ELSE
-* New format (29/07/92).
- IFITTY=IQ(LHFIT+1)
- IF(IFITTY.EQ.0)RETURN
- NFPAR=IQ(LHFIT+2)
- NFLINE=NFPAR
- IF(NFPAR.EQ.0)RETURN
- NPFITS=IQ(LHFIT+3)
- NOTHER=IQ(LHFIT+4)
- FITCHI=Q(LHFIT+6)
- IF(IFITTY.EQ.4)THEN
- CALL HQGETF(LHFIT)
- ELSE
- NP=MIN(NFPAR,35)
- II=11
- DO 20 I=1,NP
- CALL UCOPY(Q(LHFIT+II),SS,NWW)
- FITPAD(I)=SS
- FITPAR(I)=SS
-* Note: FITPAR is only single precision.
- II=II+NWW
- 20 CONTINUE
- NWERR=IQ(LHFIT-1)-NWW*(NFPAR+NOTHER)
- IF(NWERR.GT.0)THEN
- II=IQ(LHFIT-1)-NWERR+11
- DO 30 I=1,NP
- CALL UCOPY(Q(LHFIT+II),SS,NWW)
- FITSIG(I)=SS
-* Note: FITSIG is only single precision.
- II=II+NWW
- 30 CONTINUE
- ELSE
- CALL VZERO(FITSIG,NP)
- ENDIF
-* Get names if available, otherwise generate from IFITTY.
- DO 40 I=1,NP
- FITNAM(I)=' '
- 40 CONTINUE
- IF(IFITTY.EQ.1)THEN
-* Polynomial.
- N1=MAX(NP,10)
- DO 50 I=1,N1
- WRITE(FITNAM(I),'(''A'',I1,6X)')I-1
- 50 CONTINUE
- IF(NP.GT.10)THEN
- DO 60 I=11,NP
- WRITE(FITNAM(I),'(''A'',I2,5X)')I-1
- 60 CONTINUE
- END IF
- ELSE IF(IFITTY.EQ.2)THEN
-* Exponential.
- FITNAM(1)='Constant'
- FITNAM(2)='Slope'
- ELSE IF(IFITTY.EQ.3)THEN
-* Gaussian.
- FITNAM(1)='Constant'
- FITNAM(2)='Mean'
- FITNAM(3)='Sigma'
- ELSE IF(IFITTY.NE.4)THEN
- L=LQ(LHFIT)
- 70 CONTINUE
- IF(L.NE.0)THEN
- CALL UHTOC(IQ(L-4),4,NAME,4)
- IF(NAME.EQ.'HFNA')THEN
- NFLINE=0
- DO 80 I=1,NP
- CALL UHTOC(Q(L+2*I-1),4,FITNAM(I),8)
- IF(FITNAM(I)(1:1).NE.'-')NFLINE=NFLINE+1
- 80 CONTINUE
- ELSE
- GO TO 70
- END IF
- END IF
- END IF
- END IF
-* Get covariances if required and when available.
- ENDIF
- ELSE
- NFLINE=NFPAR
- ENDIF
-*
- CALL IGQ('PLCI',RPLCI)
- CALL IGQ('TXCI',RTXCI)
- CALL IGQ('TXFP',RTXFP)
- CALL IGQ('CHHE',RCHHE)
- CALL IGQ('TANG',RTANG)
- CALL IGQ('TXAL',RTXAL)
- CALL IGQ('FACI',RFACI)
- CALL IGQ('FAIS',RFAIS)
- CALL IGQ('BORD',RBORD)
- CALL IGQ('LTYP',RLTYP)
- CALL IGQ('LWID',RLWID)
-*
-* Set transformation no 1 (cm)
-*
- NTWOLD=NTWIN
- CALL ISELNT(NTHIST)
- CALL IGQWK(1,'NTVP',VPNT)
- CALL ISELNT(1)
- CALL IGQWK(1,'NTVP',VP1)
- NTWIN=1
- CALL IGPID(1,'fit-box',1,' ')
-*
-* Decode IFIT
-*
- IFIT2=IFIT
- DO 90 I=3,1,-1
- IBIT(I)=IFIT2/(10**(I-1))
- IFIT2=IFIT2-(IBIT(I)*(10**(I-1)))
- 90 CONTINUE
- IF(IFITTY.EQ.4)IBIT(1)=0
- NLINES=0
- IF(IBIT(1).NE.0)NLINES=NFLINE
- IF(IBIT(3).NE.0)NLINES=NLINES+1
- IF(IBIT(2).NE.0)THEN
- NCHARD=30
- ELSE
- NCHARD=20
- ENDIF
- ISTAT2=ISTAT
-*
-* Compute the offset in case of option STAT
-*
- OFFSET=0.
- IF(LOSTAT)THEN
- ISAT2=ISTAT
- DO 100 I=7,1,-1
- IB=ISTAT2/(10**(I-1))
- IF(IB.NE.0)OFFSET=OFFSET+2.
- ISTAT2=ISTAT2-(IB*(10**(I-1)))
- 100 CONTINUE
- IF(I230.NE.0)OFFSET=OFFSET+2.
- ENDIF
-*
-* Initialize the drawing parameters
-*
- CBSIZ=TVSIZ(5)/IXWIN
- BOXHEI=CBSIZ*FLOAT(NLINES)*2.
- BOXLEN=CBSIZ*FLOAT(NCHARD)
-*
- XL = XSIZ*((VPNT(1)-VP1(1))/(VP1(2)-VP1(1)))
- YL = YSIZ*((VPNT(3)-VP1(3))/(VP1(4)-VP1(3)))
- XH = XSIZ*((VPNT(2)-VP1(1))/(VP1(2)-VP1(1)))
- YH = YSIZ*((VPNT(4)-VP1(3))/(VP1(4)-VP1(3)))
- XBOXL = XH-BOXLEN
- YBOXL = YH-BOXHEI-OFFSET*CBSIZ
- XBOXH = XH
- YBOXH = YH-OFFSET*CBSIZ
- XOFF = (XH-XL)*SMRIT
- YOFF = (YH-YL)*SMGUP
-*
-* Define starting position for text
-*
- X1 = XBOXL+CBSIZ-XOFF
- XC = (XBOXH-XBOXL)/2.+XBOXL-XOFF
- X2 = XBOXH-CBSIZ-XOFF
- YT = YBOXH+0.5*CBSIZ-YOFF
-*
-* Draw the FIT box
-*
- CALL ISLN(ILTYP)
- CALL ISLN(1)
- CALL ISPLCI(1)
- CALL ISTXCI(1)
- CALL ISLWSC(1.)
- CTEXT='TRS'
- IF(LOSTAT)CTEXT='RS'
- SSIZ=CBSIZ
- IF(ISSCOL.EQ.0)SSIZ=0.
- CALL IGPAVE(XBOXL-SSIZ-XOFF,XBOXH-SSIZ-XOFF
- +, YBOXL-SSIZ-YOFF,YBOXH-SSIZ-YOFF
- +, SSIZ,0,1000+ISSCOL,CTEXT)
- X1=X1-SSIZ
- X2=X2-SSIZ
- YT=YT-SSIZ
-*
-* Set text size, font and precision
-*
- KFONT=IABS(IHFONT(5))
- ISTFON=KFONT/10
- ISTPRE=MOD(KFONT,10)
- IF(IHFONT(5).LT.0)ISTFON=-ISTFON
- CALL ISTXFP(ISTFON,ISTPRE)
- CALL ISCHH(CBSIZ)
- CALL IGSET('TANG',0.)
-*
-* Draws the CHISQUARE
-*
- IF(IBIT(3).NE.0)THEN
- YT=YT-2.0*CBSIZ
- CALL IGTEXT(X1,YT,'[h]^2!/ndf',CBSIZ,0.,'L')
- CTEXT=' '
- WRITE(CTEXT,'(G11.4,''/'',I6)')FITCHI*(NPFITS-NFPAR),
- + NPFITS-NFPAR
- CALL ISTXAL(3,0)
- IF(IBIT(2).NE.0)THEN
- CALL ITX(XC+2*CBSIZ,YT,CTEXT)
- ELSE
- CALL ITX(X2,YT,CTEXT)
- ENDIF
- ENDIF
-*
-* Draws the fit parameters
-*
- IF(IBIT(1).NE.0)THEN
- DO 110 I=1,NFPAR
- IF(FITNAM(I)(1:1).EQ.'-')GOTO 110
- YT=YT-2.0*CBSIZ
- CALL ISTXAL(0,0)
- CALL ITX(X1,YT,FITNAM(I))
- CTEXT=' '
- WRITE(CTEXT,'(G11.4)')FITPAR(I)
- CALL ISTXAL(3,0)
- IF(IBIT(2).NE.0)THEN
- CALL ITX(XC+2*CBSIZ,YT,CTEXT)
- CALL IGTEXT(XC+3*CBSIZ,YT,'"A',CBSIZ,0.,'C')
- CTEXT=' '
- WRITE(CTEXT,'(G11.4)')FITSIG(I)
- ENDIF
- CALL ITX(X2,YT,CTEXT)
- 110 CONTINUE
- ENDIF
-*
-* Reset NT
-*
- IF(NTWIN.NE.NTWOLD)THEN
- NTWIN=NTWOLD
- CALL ISELNT(NTWOLD)
- ENDIF
- IF(LOZFL)CALL IZPICT(' ','O')
- CALL IGSET('PLCI',RPLCI)
- CALL IGSET('TXCI',RTXCI)
- CALL ISTXFP(INT(RTXFP(1)),INT(RTXFP(2)))
- CALL IGSET('CHHE',RCHHE)
- CALL IGSET('TANG',RTANG)
- CALL ISTXAL(INT(RTXAL(1)),INT(RTXAL(2)))
- CALL IGSET('FACI',RFACI)
- CALL IGSET('FAIS',RFAIS)
- CALL IGSET('BORD',RBORD)
- CALL IGSET('LTYP',RLTYP)
- CALL IGSET('LWID',RLWID)
-*
- END
diff --git a/src/graflib/hplot/hplotf77/hplfr3.F b/src/graflib/hplot/hplotf77/hplfr3.F
deleted file mode 100644
index b79f6ed..0000000
--- a/src/graflib/hplot/hplotf77/hplfr3.F
+++ /dev/null
@@ -1,160 +0,0 @@
-*
-* $Id: hplfr3.F,v 1.4 2000/06/06 13:35:28 couet Exp $
-*
-* $Log: hplfr3.F,v $
-* Revision 1.4 2000/06/06 13:35:28 couet
-* - New option 'A' to draw the axis only
-*
-* Revision 1.3 2000/04/10 13:48:28 couet
-* - The axis title in were not placed properlly after a call to HPLFR3
-*
-* Revision 1.2 1996/03/19 11:18:23 couet
-* - The log computation had disapear during the cvs conversion
-*
-* Revision 1.1.1.1 1996/01/19 10:50:08 mclareni
-* Hplot
-*
-*
-#include "hplot/pilot.h"
- SUBROUTINE HPLFR3(X1I,X2I,Y1I,Y2I,Z1I,Z2I,THETA,PHI,CHOPT)
-*.==========>
-*.
-*. Define a 3D frame.
-*.
-*. _Input parameters:
-*.
-*. REAL X1I : Low range in X
-*. REAL X2I : High range in X
-*. REAL Y1I : Low range in Y
-*. REAL Y2I : High range in Y
-*. REAL Z1I : Low range in Z
-*. REAL Z2I : High range in Z
-*. REAL THETA, PHI : Viewing angles
-*. CHARACTER CHOPT : Options
-*. 'B' Draw the back box
-*. 'F' Draw the front box
-*. 'A' Draw the axis
-*. 'W' Start a new window
-*. 'G' forget log scale
-*.
-*..=========>
-#include "hplot/hpl1.inc"
-#include "hplot/hpl2.inc"
-#include "hplot/hpl3.inc"
-#include "hplot/hpl11.inc"
-#include "hplot/quest.inc"
- CHARACTER*(*) CHOPT
- EXTERNAL IHDFL1,IHDFL2
- DIMENSION IOPT(5)
- EQUIVALENCE (IOPTB,IOPT(1)),(IOPTF,IOPT(2))
- EQUIVALENCE (IOPTW,IOPT(3)),(IOPTG,IOPT(4))
- EQUIVALENCE (IOPTA,IOPT(5))
-*
- DIMENSION RMIN(3),RMAX(3),PAR(17)
- EQUIVALENCE (XLINE(1),RMIN(1))
- EQUIVALENCE (XLINE(4),RMAX(1))
- EQUIVALENCE (YLINE(1),PAR(1))
-*.______________________________________
-*
- CALL UOPTC(CHOPT,'BFWGA',IOPT)
-*
- RMIN(1) = X1I
- RMIN(2) = Y1I
- RMIN(3) = Z1I
- RMAX(1) = X2I
- RMAX(2) = Y2I
- RMAX(3) = Z2I
-*
- CALL IGQ('LWID',RLWID)
-*
-* Take the LOG if required
-*
- IF (IOPTG.EQ.0) THEN
- IF (LOGX.NE.0) THEN
- IF(RMAX(1).LE.0)THEN
- CALL HBUG('X2 must be >0 in LOG scale','HPLFR3',0)
- GOTO 10
- ENDIF
- IF (RMIN(1).LE.0.) RMIN(1) = MIN(RMAX(1)/1000.,1.)
- RMIN(1) = LOG10(RMIN(1))
- RMAX(1) = LOG10(RMAX(1))
- ENDIF
-*
- IF (LOGY.NE.0) THEN
- IF(RMAX(2).LE.0)THEN
- CALL HBUG('Y2 must be >0 in LOG scale','HPLFR3',0)
- GOTO 10
- ENDIF
- IF (RMIN(2).LE.0.) RMIN(2) = MIN(RMAX(2)/1000.,1.)
- RMIN(2) = LOG10(RMIN(2))
- RMAX(2) = LOG10(RMAX(2))
- ENDIF
-*
- IF (LOGZ.NE.0) THEN
- IF(RMAX(3).LE.0)THEN
- CALL HBUG('Z2 must be >0 in LOG scale','HPLFR3',0)
- GOTO 10
- ENDIF
- IF (RMIN(3).LE.0.) RMIN(3) = MIN(RMAX(3)/1000.,1.)
- RMIN(3) = LOG10(RMIN(3))
- RMAX(3) = LOG10(RMAX(3))
- ENDIF
- ENDIF
-*
-* Errors control flag is reset
-*
- IQUEST(1) = 0
-*
-* Define the 2D space according to the ZONEs
-*
- IF(IOPTW.NE.0)CALL HPLFRA(-1.,1.,-1.,1.,'AB')
-*
-* Define the 3D space
-*
- CALL ISWN3(NTWIN,
- + RMIN(1),RMAX(1),RMIN(2),RMAX(2),RMIN(3),RMAX(3),
- + -90.-PHI,90-THETA,0.,' ')
- CALL ISVP3(NTWIN,-1.,1.,-1.,1.)
- CALL ISELNT(NTWIN)
- IF ( IQUEST(1) .NE. 0 ) GOTO 10
- LO3DPL = .TRUE.
-*
- CALL IGSET('LWID',1.)
- CALL HPLAX2(PAR)
- IF ( IQUEST(1) .NE. 0 ) THEN
- CALL IGERR('Try option W',' ')
- GOTO 10
- ENDIF
-*
- IF (IOPTG.EQ.0) THEN
- PAR(15) = FLOAT(LOGX)
- PAR(16) = FLOAT(LOGY)
- PAR(17) = FLOAT(LOGZ)
- ELSE
- PAR(15) = 0.
- PAR(16) = 0.
- PAR(17) = 0.
- ENDIF
-*
- IF(IOPTB.NE.0)THEN
- CALL IGTAB4(RMIN,RMAX,PAR(6))
- CALL IGLEV(INT(PAR(3)),RMIN(3),RMAX(3),0,'A')
- CALL ISCLIP(0)
- CALL IHSINI(-1.1,1.1)
- CALL IHBBOX(RMIN,RMAX,90.,IHDFL1)
- ENDIF
-*
- IF(IOPTF.NE.0)THEN
- CALL IHSINI(-1.1,1.1)
- CALL IHFBOX(RMIN,RMAX,90.,IHDFL2)
- ENDIF
-*
- IF(IOPTA.NE.0)THEN
- CALL IHSINI(-1.1,1.1)
- CALL IZSAV
- CALL IGTAB5(RMIN,RMAX,90.,PAR)
- CALL IZSET
- ENDIF
-*
- 10 CALL IGSET('LWID',RLWID)
- END
diff --git a/src/graflib/hplot/hplotf77/hplfra.F b/src/graflib/hplot/hplotf77/hplfra.F
deleted file mode 100644
index 12fcffc..0000000
--- a/src/graflib/hplot/hplotf77/hplfra.F
+++ /dev/null
@@ -1,143 +0,0 @@
-*
-* $Id: hplfra.F,v 1.1.1.1 1996/01/19 10:50:08 mclareni Exp $
-*
-* $Log: hplfra.F,v $
-* Revision 1.1.1.1 1996/01/19 10:50:08 mclareni
-* Hplot
-*
-*
-#include "hplot/pilot.h"
-*CMZ : 5.19/03 08/02/95 11.58.38 by O.Couet
-*-- Author : O.Couet 09/11/89
- SUBROUTINE HPLFRA(X1I,X2I,Y1I,Y2I,CHOPT)
-*.==========>
-*.
-*. Define a FRAme.
-*. If X1, X2, etc. are given, draw a frame box with the window
-*. coordinates set to X1, X2, Y1, Y2. Axis labels and tick marks
-*. are drawn by default.
-*. If option 'S' is also specified, this routine is a convenient
-*. way to redefine the FRAme for the current zone.
-*. If the option 'A' is given then axis labels and tick marks
-*. are not drawn.
-*. If the option 'B' is given the box around the histo is not
-*. not drawn.
-*.
-*. _Input parameters:
-*.
-*. REAL X1I : Low range in X
-*. REAL X2I : High range in X
-*. REAL Y1I : Low range in Y
-*. REAL Y2I : High range in Y
-*. CHARACTER CHOPT : Options 'S,A,B'
-*.
-*..=========>
-#include "hplot/quest.inc"
-#include "hplot/hpl1.inc"
-#include "hplot/hpl2.inc"
-#include "hplot/hpl3.inc"
-#include "hplot/hpl9.inc"
-#include "hplot/hpl12.inc"
-#include "hbook/hcprin.inc"
- CHARACTER*(*) CHOPT
- DIMENSION IOPT(3)
- EQUIVALENCE (IOPTS,IOPT(1)),(IOPTA,IOPT(2))
- EQUIVALENCE (IOPTB,IOPT(3))
- DIMENSION XAX(3),YAX(3)
-*.______________________________________
-*
- CALL UOPTC(CHOPT,'SAB',IOPT)
-*
- X1=X1I
- X2=X2I
- Y1=Y1I
- Y2=Y2I
-*
- IF(LOGX.NE.0)THEN
- LOGXFL=.TRUE.
- ELSE
- LOGXFL=.FALSE.
- ENDIF
- IF(LOGY.NE.0)THEN
- LOGYFL=.TRUE.
- ELSE
- LOGYFL=.FALSE.
- ENDIF
- FACTOR=1.
-*
- IF((X2.LT.X1).OR.(Y2.LT.Y1))THEN
- CALL HBUG('Frame coordinates must be in increasing order'
- + ,'HPLFRA',0)
- GOTO 999
- ENDIF
- IF(X2.EQ.X1)THEN
- X1=X1-1.
- X2=X2+1.
- ENDIF
- IF(Y2.EQ.Y1)THEN
- Y1=Y1-1.
- Y2=Y2+1.
- ENDIF
- IF(LOGX.EQ.0)THEN
- XWMINI=X1
- XWMAXI=X2
- ELSE
- IF(X2.LE.0)THEN
- CALL HBUG('X2 must be >0 in LOG scale','HPLFRA',0)
- GOTO 999
- ENDIF
- IF(X1.LE.0.)X1=MIN(X2/1000.,1.)
- XWMINI=ALOG10(X1)
- XWMAXI=ALOG10(X2)
- ENDIF
- IF(LOGY.EQ.0)THEN
- YWMINI=Y1
- YWMAXI=Y2
- ELSE
- IF(Y2.LE.0)THEN
- CALL HBUG('Y2 must be >0 in LOG scale','HPLFRA',0)
- GOTO 999
- ENDIF
- IF(Y1.LE.0.)Y1=MIN(Y2/1000.,1.)
- YWMINI=ALOG10(Y1)
- YWMAXI=ALOG10(Y2)
- ENDIF
-*
- IF(IOPTB.NE.0)LOHBOX=.FALSE.
- CALL IZSAVA
-*
- IF(IOPTS.EQ.0)THEN
- XMINI=XWMINI
- XMAXI=XWMAXI
- YMINI=YWMINI
- YMAXI=YWMAXI
- CALL HPLNUL
- ELSE
- NTWIN=NTWIN+1
- NTHIST=NTWIN
- ENDIF
-*
- IQUEST(1)=0
- CALL ISVP(NTWIN,XVP1,XVP2,YVP1,YVP2)
- IF(IQUEST(1).NE.0)GOTO 999
- CALL ISWN(NTWIN,XWMINI,XWMAXI,YWMINI,YWMAXI)
- CALL ISELNT(NTWIN)
-*
- IF(IOPTS.NE.0.AND.IOPTA.EQ.0)CALL HPLWIR('XYAR',X2,Y2,'TICK')
- IF(IOPTS.EQ.0.AND.IOPTA.EQ.0)THEN
- XAX(1)=XWMINI
- XAX(2)=XWMINI
- XAX(3)=XWMAXI
- YAX(1)=YWMINI
- YAX(2)=YWMAXI
- YAX(3)=YWMINI
- CALL HPLAXI(XAX,YAX,0)
- ENDIF
- IF((LOTIC).AND.(.NOT.LOSAME).AND.IOPTS.EQ.0)THEN
- CALL HPLWIR(' ',BIGP,BIGP,'TICK')
- ENDIF
-*
- 999 CONTINUE
- LOHBOX=.TRUE.
- CALL IZSETA
- END
diff --git a/src/graflib/hplot/hplotf77/hplfun.F b/src/graflib/hplot/hplotf77/hplfun.F
deleted file mode 100644
index f067e52..0000000
--- a/src/graflib/hplot/hplotf77/hplfun.F
+++ /dev/null
@@ -1,124 +0,0 @@
-*
-* $Id: hplfun.F,v 1.1.1.1 1996/01/19 10:50:08 mclareni Exp $
-*
-* $Log: hplfun.F,v $
-* Revision 1.1.1.1 1996/01/19 10:50:08 mclareni
-* Hplot
-*
-*
-#include "hplot/pilot.h"
-*CMZ : 5.20/00 13/04/95 11.06.15 by O.Couet
-*-- Author :
- SUBROUTINE HPLFUN(XU,YU,N,CHOPT)
-*.==========>
-*. Draws a smooth curve on the picture. the curve will
-*. be smoothed to appear like a function (NN +ve) or like
-*. a contour (NN -ve)
-*. (Transformation NTHIST or 1 is selected
-*. according to CHOPT)
-*..=========>
-#include "hplot/quest.inc"
-#include "hplot/hpl1.inc"
-#include "hplot/hpl2.inc"
-#include "hplot/hpl9.inc"
-#include "hbook/hcbook.inc"
-*
- CHARACTER*(*) CHOPT
- DIMENSION XU(N),YU(N)
-*._____________________________
-*
- CALL IGQ('LWID',RLWID)
- CALL IGQ('FAIS',RFAIS)
- CALL IGQ('FASI',RFASI)
- CALL IGQ('FACI',RFACI)
- CALL IGQ('PLCI',RPLCI)
- CALL IGQ('BORD',RBORD)
-*
- IF (N.LE.2) THEN
- CALL HPLINE(XU,YU,N,CHOPT)
- GOTO 999
- ENDIF
-*----
-* cm are required ?
-*----
- IF (INDEX(CHOPT,'C').NE.0) THEN
- LOCM=.TRUE.
- ELSE
- LOCM=.FALSE.
- ENDIF
-*----
-* Set the function Attributes
-*----
- CALL HPLATT(2)
-*
- IF (LOCM) THEN
- IF (NTWIN.NE.1) CALL ISELNT(1)
- NTWIN = 1
- IF(.NOT.LOASTK)THEN
- CALL IGRAPH(N,XU,YU,'C')
- ELSE
- CALL IGRAPH(N,XU,YU,'*C')
- ENDIF
- GOTO 999
- ELSE
- IF (NTWIN.NE.NTHIST) CALL ISELNT(NTHIST)
- NTWIN = NTHIST
- ENDIF
-*----
-* Create temporary banks to store the points.
-*----
- IF (LQ(LHPLOT-3).NE.0) CALL MZDROP(IHDIV,LQ(LHPLOT-3),' ')
- IF (LQ(LHPLOT-4).NE.0) CALL MZDROP(IHDIV,LQ(LHPLOT-4),' ')
- CALL MZNEED(IHDIV,2*(N+1)+50,'G')
- IF (IQUEST(11).LT.0) THEN
- CALL HBUG('Not enough space in memory','HPLFUN',0)
- GOTO 999
- ENDIF
- CALL MZBOOK(IHDIV,LX,LHPLOT,-3,'TMPX',0,0,N+1,3,0)
- CALL MZBOOK(IHDIV,LY,LHPLOT,-4,'TMPY',0,0,N+1,3,0)
-*----
-* Loop round all user points
-*----
- DO 10 I=1,N
- IF (.NOT.LOGXFL) THEN
- Q(LX+I) = XU(I)
- ELSE
- IF(XU(I).LE.0.)GO TO 20
- Q(LX+I) = LOG10(XU(I))
- ENDIF
- YY = FLOARG(YU(I))*FACTOR
- IF(.NOT.LOGYFL)THEN
- Q(LY+I) = YY
- ELSE
- IF(YY.LE.0.)GO TO 20
- Q(LY+I) = LOG10(YY)
- ENDIF
- 10 CONTINUE
-*----
-* Draw the function
-*----
- IQUEST(81) = LX+1
- IQUEST(82) = LY+1
- IF(.NOT.LOASTK)THEN
- CALL IGRAPH(N,Q(LX),Q(LY),'ZC')
- ELSE
- CALL IGRAPH(N,Q(LX),Q(LY),'Z*C')
- ENDIF
- GOTO 30
-*
- 20 CALL HBUG('Routine called with zero or negative argument with
- +log scale','HPLFUN',0)
-*
- 30 CALL MZDROP(IHDIV,LQ(LHPLOT-3),' ')
- CALL MZDROP(IHDIV,LQ(LHPLOT-4),' ')
- LQ(LHPLOT-3) = 0
- LQ(LHPLOT-4) = 0
-*
- 999 CALL IGSET('LWID',RLWID)
- CALL IGSET('FAIS',RFAIS)
- CALL IGSET('FASI',RFASI)
- CALL IGSET('FACI',RFACI)
- CALL IGSET('PLCI',RPLCI)
- CALL IGSET('BORD',RBORD)
-*
- END
diff --git a/src/graflib/hplot/hplotf77/hplgiv.F b/src/graflib/hplot/hplotf77/hplgiv.F
deleted file mode 100644
index bc22a26..0000000
--- a/src/graflib/hplot/hplotf77/hplgiv.F
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: hplgiv.F,v 1.1.1.1 1996/01/19 10:50:08 mclareni Exp $
-*
-* $Log: hplgiv.F,v $
-* Revision 1.1.1.1 1996/01/19 10:50:08 mclareni
-* Hplot
-*
-*
-#include "hplot/pilot.h"
-*CMZ : 5.04/12 16/01/89 12.08.16 by O.Couet
-*-- Author :
- SUBROUTINE HPLGIV(XL,YL,XH,YH)
-*.==========>
-*. Returns the coordinates of the picture window
-*..=========>
-#include "hplot/hpl2.inc"
-#include "hplot/hpl9.inc"
-#include "hplot/quest.inc"
-*._____________________________
- IQUEST(11)=NTWIN
- IQUEST(12)=NTHIST
- XL=XLOW
- YL=YLOW
- XH=XHIGH
- YH=YHIGH
- RQUEST(21)=XWMINI
- RQUEST(22)=XWMAXI
- RQUEST(23)=YWMINI
- RQUEST(24)=YWMAXI
- END
-
diff --git a/src/graflib/hplot/hplotf77/hplglb.F b/src/graflib/hplot/hplotf77/hplglb.F
deleted file mode 100644
index f02dac6..0000000
--- a/src/graflib/hplot/hplotf77/hplglb.F
+++ /dev/null
@@ -1,59 +0,0 @@
-*
-* $Id: hplglb.F,v 1.1.1.1 1996/01/19 10:50:08 mclareni Exp $
-*
-* $Log: hplglb.F,v $
-* Revision 1.1.1.1 1996/01/19 10:50:08 mclareni
-* Hplot
-*
-*
-#include "hplot/pilot.h"
-*CMZ : 5.18/19 21/10/94 11.04.51 by O.Couet
-*-- Author : O.Couet 03/09/92
- SUBROUTINE HPLGLB(N,NLAB,CHLAB,LENLAB)
-#include "hbook/hcbook.inc"
-#include "hplot/hplstr.inc"
- CHARACTER*(*) CHLAB
-*
- PARAMETER (LABLEN=32)
- LOGICAL FOUND
-*
- FOUND=.FALSE.
- IF(N.GE.1.AND.N.LE.9)THEN
- LTMP = 0
- LN = LQ(LHPLOT-2)
- IF(LN.EQ.0)GOTO 20
- 10 IF(LN.NE.0)THEN
- IF(IQ(LN+1).EQ.N)THEN
- LTMP=LN
- FOUND=.TRUE.
- ENDIF
- LN=LQ(LN)
- GOTO 10
- ENDIF
- ENDIF
- 20 IF(.NOT.FOUND)THEN
- NLAB=0
- LENLAB=1
- CHLAB(1:1)=' '
- RETURN
- ENDIF
-*
- LENLAB=1
- NLAB=IQ(LTMP+2)
- DO 30 I=1,NLAB
- CHLAB(LENLAB:LENLAB)=' '
- LENLAB=LENLAB+1
- CHTEMP=' '
- CALL UHTOC(IQ(LTMP+3+(I-1)*LABLEN/4),4,CHTEMP,LABLEN)
- ILEN=LENOCC(CHTEMP)
- IF(ILEN.LE.0)THEN
- CHLAB(LENLAB:LENLAB+3)=''' '''
- LENLAB=LENLAB+3
- ELSE
- CHLAB(LENLAB:LENLAB+ILEN+2)=''''//CHTEMP(1:ILEN)//''''
- LENLAB=LENLAB+ILEN+2
- ENDIF
- 30 CONTINUE
- CHLAB(LENLAB+1:LENLAB+1)=CHAR(0)
-*
- END
diff --git a/src/graflib/hplot/hplotf77/hplgtl.F b/src/graflib/hplot/hplotf77/hplgtl.F
deleted file mode 100644
index b025f50..0000000
--- a/src/graflib/hplot/hplotf77/hplgtl.F
+++ /dev/null
@@ -1,51 +0,0 @@
-*
-* $Id: hplgtl.F,v 1.1.1.1 1996/01/19 10:50:09 mclareni Exp $
-*
-* $Log: hplgtl.F,v $
-* Revision 1.1.1.1 1996/01/19 10:50:09 mclareni
-* Hplot
-*
-*
-#include "hplot/pilot.h"
-*CMZ : 5.20/00 19/04/95 10.26.37 by O.Couet
-*-- Author :
- SUBROUTINE HPLGTL
-*.==========>
-*. Draws global title
-*. (Cm are used for call to HPLTXT)
-*..=========>
-#include "hbook/hcbook.inc"
-#include "hplot/hpl1.inc"
-#include "hplot/hpl4.inc"
-#include "hplot/hpl6.inc"
-*
- CHARACTER*80 CHGTIT
- DIMENSION RTXFP(2)
-*._____________________________
-*
- IF(LGTIT.EQ.0.OR.LOGTIT)RETURN
- LOGTIT = .TRUE.
-*
- CALL IGQ('TXFP',RTXFP)
-*
- KORNT = 1
- KFLG = 2
-*
- XK = 0.5*XSIZ
- YK = YSIZ-YGTIT-TVSIZ(2)
-*
- NCHR = 4*IQ(LGTIT-1)
- IF(NCHR.GT.80)NCHR=80
-*
- KFONT = IABS(IHFONT(2))
- IGTFON = KFONT/10
- IGTPRE = MOD(KFONT,10)
- IF(IHFONT(2).LT.0)IGTFON=-IGTFON
- CALL ISTXFP(IGTFON,IGTPRE)
-*
- CHGTIT = ' '
- CALL UHTOC(IQ(LGTIT+1),4,CHGTIT,NCHR)
- CALL HPLTXT(XK,YK,CHGTIT,2,KORNT,KFLG)
-*
- CALL ISTXFP(INT(RTXFP(1)),INT(RTXFP(2)))
- END
diff --git a/src/graflib/hplot/hplotf77/hplgzo.F b/src/graflib/hplot/hplotf77/hplgzo.F
deleted file mode 100644
index 3ec72a6..0000000
--- a/src/graflib/hplot/hplotf77/hplgzo.F
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: hplgzo.F,v 1.1.1.1 1996/01/19 10:50:09 mclareni Exp $
-*
-* $Log: hplgzo.F,v $
-* Revision 1.1.1.1 1996/01/19 10:50:09 mclareni
-* Hplot
-*
-*
-#include "hplot/pilot.h"
-*CMZ : 5.14/09 24/11/92 16.47.41 by O.Couet
-*-- Author : O.Couet 03/09/92
- SUBROUTINE HPLGZO(IX,IY)
-#include "hplot/hpl2.inc"
- IX=IXWIN
- IY=IYWIN
- END
diff --git a/src/graflib/hplot/hplotf77/hplh.F b/src/graflib/hplot/hplotf77/hplh.F
deleted file mode 100644
index 73b21f6..0000000
--- a/src/graflib/hplot/hplotf77/hplh.F
+++ /dev/null
@@ -1,485 +0,0 @@
-*
-* $Id: hplh.F,v 1.1.1.1 1996/01/19 10:49:58 mclareni Exp $
-*
-* $Log: hplh.F,v $
-* Revision 1.1.1.1 1996/01/19 10:49:58 mclareni
-* Hplot
-*
-*
-#include "hplot/pilot.h"
-*CMZ : 5.20/00 13/04/95 11.08.54 by O.Couet
-*-- Author :
- SUBROUTINE HPLH
-*.==========>
-*. Draws a histogram
-*.
-*. Description of ZEBRA bank (link LHPLOT)
-*.
-*. Type Address Explanation
-*.
-*. INT IQ(LSDIR+1) : ID (Histogram IDentifier).
-*. INT IQ(LSDIR+2) : NTWIN (transformation number).
-*. INT IQ(LSDIR+3) : ILOGY ( 1 if LOGY=.TRUE.,
-*. 0 otherwise).
-*. INT IQ(LSDIR+4) : ILOGX ( 1 if LOGX=.TRUE.,
-*. 0 otherwise).
-*. INT IQ(LSDIR+5) : I6 ( 1 if non-equidistant bins,
-*. 0 otherwise).
-*. INT IQ(LSDIR+6) : ICMAX (number of channels of the
-*. whole histogram, with no zoom).
-*. INT IQ(LSDIR+7) : First channel plotted.
-*. INT IQ(LSDIR+8) : Last channel plotted.
-*. HOL IQ(LSDIR+9) : CHOPT (option set when calling
-*. IGHIST, eg. "BN" for Non-equidistant
-*. Bars. CHOPT contains always less
-*. than 4 characters)
-*. REA Q(LSDIR+10) : Offset (for option Bar)
-*. REA Q(LSDIR+11) : Width (for option Bar)
-*. REA Q(LSDIR+12) : XLOW
-*. REA Q(LSDIR+13) : XHIGH
-*. REA Q(LSDIR+14) : YLOW
-*. REA Q(LSDIR+15) : YHIGH
-*. REA Q(LSDIR+16) : XWMINI
-*. REA Q(LSDIR+17) : XWMAXI
-*. REA Q(LSDIR+18) : YWMINI
-*. REA Q(LSDIR+19) : YWMAXI
-*. REA Q(LSDIR+20) }
-*. ... } : Y(ICMAX) (Y ordinate of each bin)
-*. REA Q(LSDIR+20+(ICMAX-1)) }
-*. REA Q(LSDIR+20+ICMAX) }
-*. ... } : X(...) (X abcisse of each bin)
-*. REA Q(LSDIR+20+ICMAX+1) } X(2) if bins are equidistants
-*. or
-*. REA Q(LSDIR+20+ICMAX+ICMAX) } X(ICMAX+1) if bins are
-*. non-equidistants.
-*.
-*..=========>
-#include "hplot/hpl1.inc"
-#include "hplot/hpl2.inc"
-#include "hplot/hpl9.inc"
-#include "hplot/hpl13.inc"
-#include "hbook/hcbits.inc"
-#include "hbook/hcbook.inc"
-#include "hplot/quest.inc"
- CHARACTER*4 CHOPTG,CHTMPG
- CHARACTER*16 CHOPTH
- LOGICAL LHBAR,NOKEEP
- DIMENSION IXIO(2)
- SAVE IXIO
-*._____________________________
-*
- CALL IGQ('LWID',RLWID)
- CALL IGQ('FAIS',RFAIS)
- CALL IGQ('FASI',RFASI)
- CALL IGQ('FACI',RFACI)
- CALL IGQ('PLCI',RPLCI)
- CALL IGQ('BORD',RBORD)
-*
- IFIRST = 1
- IF(LOZOOM)IFIRST = NCMIN
- ILAST = ICMAX
- IF(LOZOOM)ILAST = NCMAX
- NBINS = ILAST-IFIRST+1
-*---
-* If the histogram is too big (more than 99999 channels), it is
-* not possible to keep an unpacked copy in memory. In this case,
-* the flag NOKEEP is set ON and all the code to build the keeped
-* structure in memory is skipped.
-*----
- IF(ICMAX.GT.99999)THEN
- NOKEEP = .TRUE.
- RQUEST(80) = XMINI
- RQUEST(81) = XMAXI
- IQUEST(82) = LQ(LCID-1)
- IQUEST(83) = IFIRST
- IQUEST(84) = ILAST
- GOTO 40
- ELSE
- NOKEEP = .FALSE.
- ENDIF
-*---
-* Creation of "LIFE" bank if not option "Update" or "+"
-*----
- IF((IOPTU.NE.0).OR.(IOPTP.NE.0))THEN
- LSDIR=LHPLIP
- LHBAR=.FALSE.
- CALL UHTOC(IQ(LSDIR+9),4,CHOPTG,4)
- CALL UOPTC(CHOPTG,'B',IOPTG)
- IF(IOPTG.NE.0)LHBAR=.TRUE.
- IF(LHBAR)THEN
- ROFZB=Q(LSDIR+10)
- RWDZB=Q(LSDIR+11)
- ENDIF
- IFIRSO = IQ(LSDIR+7)
- ILASTO = IQ(LSDIR+8)
- ELSE
- IF(I6.NE.0)THEN
- MBMAX=22+2*ICMAX+1
- ELSE
- MBMAX=22+ICMAX+2
- ENDIF
- LSDIR = LQ(LHPLOT-1)
- IF(LSDIR.NE.0)THEN
- IF(JBIT(IQ(LSDIR),1).NE.0)THEN
- CALL MZBOOK(IHDIV,LR2,LSDIR,0,'HIST',0,0,MBMAX,IXIO,0)
- LSDIR=LR2
- GOTO 10
- ENDIF
- ENDIF
- IF(LSDIR.EQ.0)THEN
- CALL MZFORM('HIST','8I 1H -F',IXIO)
- IQUEST(1)=0
- CALL MZBOOK(IHDIV,LSDIR,LHPLOT,-1,'HIST',0,0,MBMAX,IXIO,0)
- ELSE
- IF(IQ(LSDIR-1).LT.MBMAX)THEN
- CALL MZPUSH(IHDIV,LSDIR,0,MBMAX-IQ(LSDIR-1),'I')
- ELSE
- IF(IQ(LSDIR-1).GT.200.AND.MBMAX.LT.200)THEN
- CALL MZPUSH(IHDIV,LSDIR,0,200-IQ(LSDIR-1),'I')
- ENDIF
- ENDIF
- ENDIF
- 10 IQ(LSDIR+7)=IFIRST
- IQ(LSDIR+8)=ILAST
- ENDIF
-*----
-* check if there is enough space in memory to create a picture.
-* If not, the option ZFL in turned off.
-*----
- IF(LOZFL)THEN
- NWNEED = 2*NBINS+100
- CALL MZNEED(IXHIGZ,NWNEED,'G')
- IF(IQUEST(11).LT.0)THEN
- IDT = IQ(LSDIR+1)
- CALL HBUG('No space to store the picture','HPLOT',IDT)
- LOZFL = .FALSE.
- CALL IGZSET('G')
- ENDIF
- ENDIF
-*----
-* index initialization of array Y and X
-*----
- LIY=LSDIR+19
- LIX=LIY+ICMAX
-*
- IF(((IOPTU.NE.0).OR.(IOPTP.NE.0)).AND.(IQ(LSDIR+5).EQ.0))
- + DELTAX=(Q(LIX+2)-Q(LIX+1))/(IQ(LSDIR+8)-IQ(LSDIR+7)+1)
-*----
-* loop round histogram bins
-*----
- DO 20 J=IFIRST,ILAST
- LIY = LSDIR+19
- LIX = LIY+ICMAX
- C1 = HCX(J,1)*FACTOR
- IF(ABS(YMAXI-YMINI).GT.0.)THEN
- IF(.NOT.LOGYFL)THEN
- YB = C1
- ELSE
- YB = LOG10(MAX(C1,10**YMINI))
- ENDIF
- ENDIF
- YB = MAX(YB,YMINI)
- YB = MIN(YB,YMAXI)
-*----
-* Options '+', '-', '+-' and 'U'pdate
-* '+' IOPTP = 1
-* '-' IOPTP = -1
-* '+-' IOPTP = 2
-* 'U' IOPTU = 1
-*----
- IF((IOPTU.NE.0).OR.(IOPTP.NE.0))THEN
-*----
-* Compute Y1 Y2
-*----
- Y1 = Q(LIY+J-IFIRST+IFIRSO)
- Y2 = YB
- IF(ABS(IOPTP).EQ.1)THEN
- IF(.NOT.LOGYFL)THEN
- Y2 = Y1+IOPTP*Y2
- ELSE
- Y2 = LOG10(10**Y1+IOPTP*10**Y2)
- ENDIF
- ENDIF
-*----
-* Compute YM1 YM2
-*----
- IF(.NOT.LHBAR)THEN
- YADD = HCX(J,1)*FACTOR
- IF(LOGYFL)THEN
- YCUR = 10**Q(LIY+J-IFIRST+IFIRSO)
- ELSE
- YCUR = Q(LIY+J-IFIRST+IFIRSO)
- ENDIF
- IF(J.NE.ILAST)THEN
- YNC = HCX(J+1,1)*FACTOR
- IF(LOGYFL)THEN
- YNXT = (10**Q(LIY+J+1-IFIRST+IFIRSO))
- ELSE
- YNXT = Q(LIY+J+1-IFIRST+IFIRSO)
- ENDIF
- ELSE
- YNC = 0.
- YNXT = 0.
- ENDIF
- IF(J.NE.IFIRST)THEN
- YPC = HCX(J-1,1)*FACTOR
- IF(LOGYFL)THEN
- YPRE = 10**Q(LIY+J-1-IFIRST+IFIRSO)
- ELSE
- YPRE = Q(LIY+J-1-IFIRST+IFIRSO)
- ENDIF
- ELSE
- YPC = 0.
- YPRE = 0.
- ENDIF
- IF(IOPTP.EQ.1)THEN
- YM1 = MAX(MIN(YCUR+YADD,YPRE),YCUR)
- YM2 = MAX(MIN(YCUR+YADD,YNXT+YNC),YCUR)
- ELSEIF(IOPTP.EQ.-1)THEN
- YM1 = MIN(MAX(YCUR-YADD,YPRE),YCUR)
- YM2 = MIN(MAX(YCUR-YADD,YNXT-YNC),YCUR)
- ELSE
- IF(YCUR.GT.YADD)THEN
- YM1 = MAX(YADD,YPC)
- YM2 = MAX(YADD,YNC)
- ELSE
- YM1 = MIN(YADD,YPC)
- YM2 = MIN(YADD,YNC)
- ENDIF
- ENDIF
- IF(LOGYFL)THEN
- IF(YM1.GT.0.)YM1 = LOG10(YM1)
- IF(YM2.GT.0.)YM2 = LOG10(YM2)
- ENDIF
- ENDIF
-*----
-* Compute X1 X2
-*----
- IF(IQ(LSDIR+5).NE.0)THEN
- IF(.NOT.LHBAR)THEN
- X1 = Q(LIX+J-IFIRST+IFIRSO)
- X2 = Q(LIX+J+1-IFIRST+IFIRSO)
- ELSE
- DELTA = (Q(LIX+J-IFIRST+IFIRSO+1)
- + -Q(LIX+J-IFIRST+IFIRSO))
- X1 = Q(LIX+J-IFIRST+IFIRSO)+ROFZB*DELTA
- X2 = X1+(RWDZB*DELTA)
- ENDIF
- ELSE
- IF(.NOT.LHBAR)THEN
- X1 = Q(LIX+1)+(J-IFIRST)*DELTAX
- X2 = X1+DELTAX
- ELSE
- X1 = Q(LIX+1)+((J-IFIRST)*DELTAX)+(ROFZB*DELTAX)
- X2 = X1+(RWDZB*DELTAX)
- ENDIF
- ENDIF
- IF(LOGYFL.AND.C1.LE.0.)GOTO 20
-*----
-* Update the current plot
-*----
- IF(Y2.NE.Y1)CALL HPLHUP(X1,Y1,X2,Y2,YM1,YM2,LHBAR)
- IF(ABS(IOPTP).EQ.1.OR.IOPTU.NE.0)Q(LIY+J-IFIRST+IFIRSO)=Y2
- ELSE
- Q(LIY+J)=YB
- ENDIF
- 20 CONTINUE
-*
- IF((IOPTU.NE.0).OR.(IOPTP.NE.0))GOTO 999
-*----
-* Option "Update" is not selected.
-* Draw histogram according to value of IHTYP
-* if IHTYP.EQ.0 then Polyline requested
-* if IHTYP.NE.0 then Fill_area requested
-*----
- IF(I6.EQ.0)THEN
- Q(LIX+1)=XMINI
- Q(LIX+2)=XMAXI
- ELSE
-*----
-* Non_equidistant bins
-*----
- LBINS=LQ(LCID-2)
- DO 30 I=1,ICMAX+1
- Q(LIX+I)=Q(LBINS+I)
- 30 CONTINUE
- ENDIF
-*----
-* Prepare Fill area (systematic with option "Barre").
-*----
- 40 CONTINUE
- IHTOLD=IHTYP
- IF((LOBAR).OR.(IHOPTB.NE.0))THEN
- IF(IHTYP.EQ.0.OR.IHTYP.EQ.1000)IHTYP=1001
- ENDIF
- CALL HPLATT(1)
-*----
-* Code option for IGHIST
-*----
- CHOPTH = ' '
- CHOPTG = ' '
- CHTMPG = ' '
- IF(IHOPTL.NE.0)CHOPTH(1:1) = 'L'
- IF(IHOPTT.NE.0)CHOPTH(2:2) = '*'
- IF(IHOPTP.NE.0)CHOPTH(3:3) = 'P'
- IF((IHOPTC.NE.0).OR.(IHOPTH.NE.0).OR.(IHOPTB.NE.0))THEN
- IF(IHOPTC.NE.0)CHOPTH(4:4) = 'C'
- IF(IHOPTH.NE.0)THEN
- CHOPTH(5:5) = 'H'
- CHOPTG = 'H'
- ELSE IF(IHOPTB.NE.0)THEN
- CHOPTH(6:6) = 'B'
- CHOPTG = 'B'
- ENDIF
- IF(IHTYP.NE.1000.AND.IHTYP.NE.0)THEN
- IF(LOGYFL)THEN
- CHOPTH(7:7) = '1'
- IF(CHOPTG.NE.' ')THEN
- CHTMPG = '1'//CHOPTG
- CHOPTG = CHTMPG
- ENDIF
- ENDIF
- IF((IHOPTH.NE.0).OR.(IHOPTC.NE.0))THEN
- CHOPTH(8:8) = 'F'
- IF(CHOPTG.NE.' ')THEN
- CHTMPG = 'F'//CHOPTG
- CHOPTG = CHTMPG
- ENDIF
- ENDIF
- ENDIF
- ENDIF
- IF((I6.NE.0).AND.(CHOPTH.NE.' '))THEN
- CHOPTH(9:9) = 'N'
- IF(CHOPTG.NE.' ')THEN
- CHTMPG = 'N'//CHOPTG
- CHOPTG = CHTMPG
- ENDIF
- ENDIF
-*
- IF(CHOPTH.EQ.' ')THEN
- IF(IHTYP.NE.1000.AND.IHTYP.NE.0)THEN
- IF(.NOT.LOGYFL)THEN
- IF(.NOT.LOBAR)THEN
- IF(I6.EQ.0)THEN
- CHOPTH = 'F'
- CHOPTG = 'F '
- ELSE
- CHOPTH = 'FN'
- CHOPTG = 'FN '
- ENDIF
- ELSE
- IF(I6.EQ.0)THEN
- CHOPTH = 'B'
- CHOPTG = 'B '
- ELSE
- CHOPTH = 'BN'
- CHOPTG = 'BN '
- ENDIF
- ENDIF
- ELSE
- IF(.NOT.LOBAR)THEN
- IF(I6.EQ.0)THEN
- CHOPTH = 'F1'
- CHOPTG = 'F1 '
- ELSE
- CHOPTH = 'F1N'
- CHOPTG = 'F1N '
- ENDIF
- ELSE
- IF(I6.EQ.0)THEN
- CHOPTH = 'B1'
- CHOPTG = 'B1 '
- ELSE
- CHOPTH = 'B1N'
- CHOPTG = 'B1N '
- ENDIF
- ENDIF
- ENDIF
- ELSE
- IF(I6.EQ.0)THEN
- CHOPTH = 'H'
- CHOPTG = 'H '
- ELSE
- CHOPTH = 'HN'
- CHOPTG = 'HN '
- ENDIF
- ENDIF
- ENDIF
-*----
-* Option LOGX
-*----
- IF(LOGXFL)THEN
- CHOPTH(10:11) = 'GX'
- IF(CHOPTG.NE.' ')THEN
- CHTMPG = 'GX'//CHOPTG
- CHOPTG = CHTMPG
- ENDIF
- IF(I6.EQ.0)THEN
- Q(LIX+1) = 10**Q(LIX+1)
- Q(LIX+2) = 10**Q(LIX+2)
- ENDIF
- ENDIF
-*----
-* Draw the histogram
-*----
- IF(NOKEEP)THEN
- CHOPTH(16:16) = 'K'
- CALL IGHIST(NBINS,RQUEST(80),0.,CHOPTH)
- GOTO 999
- ENDIF
- LIY = LSDIR+19
- LIX = LIY+ICMAX
- IF(I6.NE.0)THEN
- IQUEST(81) = LIX+IFIRST
- IQUEST(82) = LIY+IFIRST
- CHOPTH(16:16) = 'Z'
- CALL IGHIST(NBINS,Q(LIX+IFIRST),Q(LIY+IFIRST),CHOPTH)
- ELSE
- IQUEST(81) = LIX+1
- IQUEST(82) = LIY+IFIRST
- CHOPTH(16:16) = 'Z'
- CALL IGHIST(NBINS,Q(LIX+1),Q(LIY+IFIRST),CHOPTH)
- ENDIF
-*----
-* Fill bank with the specification of the histogram
-*----
- IQ(LSDIR+1)=IDZB
- IQ(LSDIR+2)=NTWIN
- IF(LOGYFL)THEN
- IQ(LSDIR+3) = 1
- ELSE
- IQ(LSDIR+3) = 0
- ENDIF
- IF(LOGXFL)THEN
- IQ(LSDIR+4) = 1
- ELSE
- IQ(LSDIR+4) = 0
- ENDIF
- IQ(LSDIR+5) = I6
- IQ(LSDIR+6) = ICMAX
- CALL UCTOH(CHOPTG,IQ(LSDIR+9),4,4)
- Q(LSDIR+10) = ROFFS
- Q(LSDIR+11) = RWDTH
- Q(LSDIR+12) = XLOW
- Q(LSDIR+13) = XHIGH
- Q(LSDIR+14) = YLOW
- Q(LSDIR+15) = YHIGH
- Q(LSDIR+16) = XWMINI
- Q(LSDIR+17) = XWMAXI
- Q(LSDIR+18) = YWMINI
- Q(LSDIR+19) = YWMAXI
-*----
-* If option "KEEP" is selected then keep bank
-*----
- IF(IOPTK.NE.0)CALL SBIT1(IQ(LSDIR),1)
-*
- IHTYP=IHTOLD
-*
- 999 CALL IGSET('LWID',RLWID)
- CALL IGSET('FAIS',RFAIS)
- CALL IGSET('FASI',RFASI)
- CALL IGSET('FACI',RFACI)
- CALL IGSET('PLCI',RPLCI)
- CALL IGSET('BORD',RBORD)
-*
- END
diff --git a/src/graflib/hplot/hplotf77/hplhip.F b/src/graflib/hplot/hplotf77/hplhip.F
deleted file mode 100644
index a34cdc1..0000000
--- a/src/graflib/hplot/hplotf77/hplhip.F
+++ /dev/null
@@ -1,39 +0,0 @@
-*
-* $Id: hplhip.F,v 1.1.1.1 1996/01/19 10:50:09 mclareni Exp $
-*
-* $Log: hplhip.F,v $
-* Revision 1.1.1.1 1996/01/19 10:50:09 mclareni
-* Hplot
-*
-*
-#include "hplot/pilot.h"
-*CMZ : 5.18/16 25/08/94 15.26.44 by O.Couet
-*-- Author :
- INTEGER FUNCTION HPLHIP(ITOK,CHOPT)
-*.==========>
-*. This function returns the ZEBRA adress
-*. of histogram ID if CHOPT='I' or of the
-*. histogram drawned with transformation NT
-*. if CHOPT='T'
-*..=========>
-#include "hbook/hcbook.inc"
- CHARACTER*1 CHOPT
-*._____________________________
-*
- HPLHIP = 0
- IF (CHOPT.EQ.'I') THEN
- IADDR = 1
- ELSE
- IADDR = 2
- ENDIF
-*
- LP = LQ(LHPLOT-1)
- 10 IF (LP.EQ.0) GOTO 999
- IF (IQ(LP+IADDR).EQ.ITOK) THEN
- HPLHIP = LP
- GOTO 999
- ENDIF
- LP = LQ(LP)
- GOTO 10
-*
- 999 END
diff --git a/src/graflib/hplot/hplotf77/hplhup.F b/src/graflib/hplot/hplotf77/hplhup.F
deleted file mode 100644
index 820cca9..0000000
--- a/src/graflib/hplot/hplotf77/hplhup.F
+++ /dev/null
@@ -1,47 +0,0 @@
-*
-* $Id: hplhup.F,v 1.1.1.1 1996/01/19 10:50:09 mclareni Exp $
-*
-* $Log: hplhup.F,v $
-* Revision 1.1.1.1 1996/01/19 10:50:09 mclareni
-* Hplot
-*
-*
-#include "hplot/pilot.h"
-*CMZ : 5.18/13 16/06/94 17.48.23 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE HPLHUP(X1,Y1,X2,Y2,YM1,YM2,LHBAR)
-*.==========>
-*. Draws the histogram (for option "Update")
-*. Only when scale has not changed.
-*..=========>
-#include "hplot/hpl1.inc"
-#include "hplot/hpl11.inc"
- LOGICAL LHBAR
-*._____________________________
-*
- IHTOLD = IHTYP
- IF((LHBAR).AND.(IHTYP.EQ.0))IHTYP = 1000
-*
- CALL HPLATT(1)
-*
- IF(LHBAR)THEN
- CALL IGSET('BORD',1.)
- CALL IGBOX(X1,X2,Y1,Y2)
- ELSE
- IF(IHBCOL.NE.0.OR.IHTYP.NE.0)THEN
- CALL IGSET('BORD',0.)
- CALL IGBOX(X1,X2,Y1,Y2)
- ENDIF
- XLINE(1) = X1
- XLINE(2) = X1
- XLINE(3) = X2
- XLINE(4) = X2
- YLINE(1) = YM1
- YLINE(2) = Y2
- YLINE(3) = Y2
- YLINE(4) = YM2
- CALL IPL(4,XLINE,YLINE)
- ENDIF
-*
- IHTYP=IHTOLD
- END
diff --git a/src/graflib/hplot/hplotf77/hpli.F b/src/graflib/hplot/hplotf77/hpli.F
deleted file mode 100644
index dd7ae67..0000000
--- a/src/graflib/hplot/hplotf77/hpli.F
+++ /dev/null
@@ -1,62 +0,0 @@
-*
-* $Id: hpli.F,v 1.1.1.1 1996/01/19 10:50:09 mclareni Exp $
-*
-* $Log: hpli.F,v $
-* Revision 1.1.1.1 1996/01/19 10:50:09 mclareni
-* Hplot
-*
-*
-#include "hplot/pilot.h"
-*CMZ : 5.14/09 26/11/92 13.42.22 by O.Couet
-*-- Author :
- SUBROUTINE HPLI
-*.==========>
-*. starts new picture :
-*. draws picture surround
-*. and page number.
-*..=========>
-#include "hplot/hpl1.inc"
-#include "hplot/hpl4.inc"
-*._____________________________
-*----
-* start new picture
-*----
- IPLNUM=IPLNUM+1
- IF(LOZFL)IPLTNO=IPLTNO+1
-*----
-* Call optional user routine HPLNXT and internal routine HPLNEW
-* before each new frame
-*----
- CALL HPLNXT
- CALL HPLNEW
-*----
-* (HPLCOL is called at the start of each frame to ensure the
-* correct colours are used even if individual frames are later
-* selected)
-*----
-* draw surround
-*----
- IF (LOBOX) THEN
- CALL ISLN(1)
- IBTOLD = IBTYP
- IBWOLD = IBWID
- IBCOLD = IBCOL
- IBBCOD = IBBCOL
- IBTYP = IPTYP
- IBCOL = IPCOL
- IBBCOL = IPBCOL
- IBWID = IPWID
- CALL HPLBOX(0.,0.,XSIZ,YSIZ,'CM ')
- CALL ISLN(ILTYP)
- IBTYP = IBTOLD
- IBWID = IBWOLD
- IBCOL = IBCOLD
- IBBCOL = IBBCOD
- ENDIF
-*----
-* are page numbers required?
-*----
- IF(IPGSIZ.NE.0) CALL HPLPGN
-*
- END
-
diff --git a/src/graflib/hplot/hplotf77/hpline.F b/src/graflib/hplot/hplotf77/hpline.F
deleted file mode 100644
index 9fd04ac..0000000
--- a/src/graflib/hplot/hplotf77/hpline.F
+++ /dev/null
@@ -1,72 +0,0 @@
-*
-* $Id: hpline.F,v 1.1.1.1 1996/01/19 10:50:09 mclareni Exp $
-*
-* $Log: hpline.F,v $
-* Revision 1.1.1.1 1996/01/19 10:50:09 mclareni
-* Hplot
-*
-*
-#include "hplot/pilot.h"
-*CMZ : 5.19/00 24/10/94 10.56.39 by O.Couet
-*-- Author :
- SUBROUTINE HPLINE(XU,YU,N,CHOPT)
-*.==========>
-*. Draws a line or a series of staight lines
-*. on the picture
-*. (Transformation NTHIST or 1 is selected
-*. according to CHOPT)
-*..=========>
-#include "hplot/hpl1.inc"
-#include "hplot/hpl2.inc"
-#include "hplot/hpl9.inc"
-#include "hplot/hpl11.inc"
- CHARACTER*(*) CHOPT
- DIMENSION XU(N),YU(N)
-*._____________________________
-*
-*----
-* cm are required ?
-*----
- IF (INDEX(CHOPT,'C').NE.0) THEN
- LOCM=.TRUE.
- ELSE
- LOCM=.FALSE.
- ENDIF
-*
- IF(LOCM)THEN
- IF(NTWIN.NE.1)CALL ISELNT(1)
- NTWIN=1
- CALL IPL(N,XU,YU)
- RETURN
- ELSE
- IF(NTWIN.NE.NTHIST)CALL ISELNT(NTHIST)
- NTWIN=NTHIST
- ENDIF
-*
- IF(N.GE.NMAX)THEN
- CALL HBUG('Too many points','HPLINE',0)
- RETURN
- ENDIF
- DO 10 I=1,N
- IF(LOGXFL)THEN
- IF(XU(I).LE.0.)GOTO 20
- XLINE(I)=LOG10(XU(I))
- ELSE
- XLINE(I)=XU(I)
- ENDIF
- YY=FLOARG(YU(I))*FACTOR
- IF(LOGYFL)THEN
- IF(YY.LE.0.)GOTO 20
- YLINE(I)=LOG10(YY)
- ELSE
- YLINE(I)=YY
- ENDIF
- 10 CONTINUE
- CALL IPL(N,XLINE,YLINE)
- RETURN
-*
- 20 CALL HBUG('Routine called with zero or negative argument with log
- +scale','HPLINE',0)
-*
- END
-
diff --git a/src/graflib/hplot/hplotf77/hplint.F b/src/graflib/hplot/hplotf77/hplint.F
deleted file mode 100644
index 1ba5d27..0000000
--- a/src/graflib/hplot/hplotf77/hplint.F
+++ /dev/null
@@ -1,104 +0,0 @@
-*
-* $Id: hplint.F,v 1.2 1998/04/08 14:08:07 couet Exp $
-*
-* $Log: hplint.F,v $
-* Revision 1.2 1998/04/08 14:08:07 couet
-* - VIDQQ was not used, and was initialised as a wrong "what" string.
-*
-* Revision 1.1.1.1 1996/01/19 10:50:09 mclareni
-* Hplot
-*
-*
-#include "hplot/pilot.h"
-*CMZ : 5.20/06 31/10/95 14.51.23 by O.Couet
-*-- Author :
- SUBROUTINE HPLINT(IWTYP)
-*.==========>
-*. Initialisation routine for HPLOT
-*. If IWTYP > 0 : Output to screen
-*..=========>
-#include "hbook/hcbook.inc"
-#include "hbook/hcunit.inc"
-#include "hplot/hpl1.inc"
-#include "hplot/hpl4.inc"
-#include "hplot/hpl9.inc"
-#include "hplot/hpl13.inc"
-#include "hplot/hpl14.inc"
-*._____________________________
-*
-*----
-* HIGZ Initialization (if not already done)
-*----
- IF(IXHIGZ.EQ.0)CALL IGINIT(1000)
- CALL IGSSE(LERR,IWTYP)
-*----
-* COMMON/HPL1/
-*----
- IPLNUM = -1
- IPLTNO = 0
- LOSLIC = .FALSE.
- LOZOOM = .FALSE.
- LOGTIT = .FALSE.
- LO3DPL = .FALSE.
-*----
-* COMMON/HPL4/
-*----
- XYTWN = 1.
-*----
-* COMMON/HPL9/
-*----
- XMINI = 0.
- XMAXI = 1.
- YMINI = 0.
- YMAXI = 1.
-*----
-* COMMON/HPL13/
-*----
- DO 10 I=1,NOPT
- IOPT(I) = 0
- 10 CONTINUE
-*----
-* COMMON/HPL14/
-*----
- DO 30 I=1,NBLIST
- LSTTYP(I) = 0
- NBEL(I) = 6
- DO 20 J=2,7
- ILIST(I,J-1) = J
- 20 CONTINUE
- 30 CONTINUE
- IHLIST = 1
-*----
-* set up defaults via HPLOPT
-*----
- CALL HPLOPT('* ',1)
-*----
-* set up margin constants page and characters sizes
-*----
- CALL HPLSET('*',0)
- CALL HPLSCM
-*----
-* create a top bank on which all the HPLOT data structure is linked
-*
-* ******************************************************
-* * *
-* * Structural links in LHPLOT *
-* * *
-* * LQ(LHPLOT-1) : Zone data structure *
-* * LQ(LHPLOT-2) : Label data structure *
-* * LQ(LHPLOT-3) : Dynamic structure for X arrays *
-* * LQ(LHPLOT-4) : Dynamic structure for Y arrays *
-* * LQ(LHPLOT-5) : Used in HPLAER *
-* * LQ(LHPLOT-6) : Used in HPLAER *
-* * LQ(LHPLOT-7) : Used in HPLAER *
-* * LQ(LHPLOT-8) : Used in HPLAER *
-* * LQ(LHPLOT-9) : Used in HPLAER *
-* * LQ(LHPLOT-10) : Used in HPLAER *
-* * *
-* ******************************************************
-*
-*----
- IF (LHPLOT.NE.0) CALL MZDROP(IHDIV,LHPLOT,' ')
- CALL MZBOOK(IHDIV,LHPLOT,LHPLOT,1,'PLOT',10,10,0,0,0)
-*
- END
diff --git a/src/graflib/hplot/hplotf77/hplist.F b/src/graflib/hplot/hplotf77/hplist.F
deleted file mode 100644
index c9dccbe..0000000
--- a/src/graflib/hplot/hplotf77/hplist.F
+++ /dev/null
@@ -1,89 +0,0 @@
-*
-* $Id: hplist.F,v 1.2 1999/05/18 08:50:56 couet Exp $
-*
-* $Log: hplist.F,v $
-* Revision 1.2 1999/05/18 08:50:56 couet
-* - Protection added if NCOL is too large
-*
-* Revision 1.1.1.1 1996/01/19 10:50:09 mclareni
-* Hplot
-*
-*
-#include "hplot/pilot.h"
-*CMZ : 5.12/01 12/03/92 11.50.17 by O.Couet
-*-- Author : O.Couet 23/10/90
- SUBROUTINE HPLIST(LISTNB,NI,LISTI)
-*.===========>
-*.
-*. Define a list of attributes
-*.
-*. _Input parameters:
-*.
-*. INTEGER LISTNB : List number
-*. INTEGER NI : Number of elements to be define
-*. INTEGER LISTI : List elements
-*.
-*. If NI <= 0, an automatic palette is defined from 9 to
-*. NCOL (defined by IGSET NCOL). If NCOL <= 8
-*. the palette is defined from 1 to NCOL also
-*. but the color definitions are not changed.
-*. If LISTNB <= 0, the list of the defined palettes is printed.
-*.
-*..==========> (O.Couet)
-#include "hplot/hpl14.inc"
- DIMENSION LISTI(*)
- DIMENSION LUT(8)
- DATA LUT /0,5,7,3,6,2,4,1/
-*.______________________________________
-*
-*
-* Print the list of the Defined the palette
-*
- IF(LISTNB.LE.0)THEN
- PRINT*,'The define lists are :'
- DO 10 I=1,NBLIST
- IF(LSTTYP(I).NE.0)PRINT*,I
- 10 CONTINUE
- RETURN
- ENDIF
-*
-* The palette LISTNB is defined automatically
-*
- LN=MIN(NBLIST,LISTNB)
- IF(NI.EQ.0)THEN
- LSTTYP(LN)=1
- CALL IGQ('NCOL',RVAL)
- N=INT(RVAL)
- IF(N.LE.8)THEN
- DO 20 I=1,N
- ILIST(LN,I)=LUT(I)
- 20 CONTINUE
- ELSE
- N=MAX(N-8,2)
- IF (N.GT.MXLIST) THEN
- CALL IGERR('NCOL is too large','HPLIST')
- N = MXLIST
- ENDIF
- DEC=240./N
- H=240.
- DO 30 I=1,N
- CALL IGHTOR(H,0.4,1.,R,G,B)
- CALL ISCR(1,I+7,R,G,B)
- ILIST(LN,I)=I+7
- H=H-DEC
- 30 CONTINUE
- ENDIF
- NBEL(LN)=N
- RETURN
- ENDIF
-*
-* Define the list
-*
- N=MIN(NI,MXLIST)
- NBEL(LN)=N
- LSTTYP(LN)=1
- DO 40 I=1,N
- ILIST(LN,I)=LISTI(I)
- 40 CONTINUE
-*
- END
diff --git a/src/graflib/hplot/hplotf77/hplive.F b/src/graflib/hplot/hplotf77/hplive.F
deleted file mode 100644
index 9f1e146..0000000
--- a/src/graflib/hplot/hplotf77/hplive.F
+++ /dev/null
@@ -1,196 +0,0 @@
-*
-* $Id: hplive.F,v 1.1.1.1 1996/01/19 10:50:09 mclareni Exp $
-*
-* $Log: hplive.F,v $
-* Revision 1.1.1.1 1996/01/19 10:50:09 mclareni
-* Hplot
-*
-*
-#include "hplot/pilot.h"
-*CMZ : 5.18/16 25/08/94 15.26.44 by O.Couet
-*-- Author :
- SUBROUTINE HPLIVE
-*.==========>
-*. define picture coordinates , set window and draw histogram
-*. surrounding frame in case of option "Update" if scale is
-*. no more correct.
-*..=========>
-#include "hplot/hpl1.inc"
-#include "hplot/hpl2.inc"
-#include "hplot/hpl9.inc"
-#include "hplot/hpl13.inc"
-#include "hbook/hcbook.inc"
-#include "hbook/hcbits.inc"
- LOGICAL LOGYSC
- DIMENSION XAX(3),YAX(3)
-*._____________________________
-*
-* Find transformation number and
-* check if we need to change scale.
-* If we do not have to change scale
-* we only select transformation NTZEB.
-*----
- NTZEB = IQ(LHPLIP+2)
- YWMAXZ = Q(LHPLIP+19)
- IF(YMAXI.GT.YWMAXZ)LOSCAL = .TRUE.
-*---
-* If scale must be changed whe have to change the window
-* of transformation NTZEB (YWMAXI must be greater).
-* Final adjustment of YWMAXI is made if HMAXIM not called.
-* We change of picture (HPLI) and we have to redraw all
-* the histogram created with option "Live", in their respective
-* zone.
-*---
- IF(LOSCAL)THEN
-*----
-* New picture
-*----
- CALL HPLI
-*----
-* First we redraw histogram to update
-*----
-* Contour of zone
-*----
- XLOWZ = Q(LHPLIP+12)
- XHIGHZ = Q(LHPLIP+13)
- YLOWZ = Q(LHPLIP+14)
- YHIGHZ = Q(LHPLIP+15)
- XLOW = XLOWZ
- XHIGH = XHIGHZ
- YLOW = YLOWZ
- YHIGH = YHIGHZ
- CALL ISLN(1)
- CALL HPLBOX(XLOW,YLOW,XHIGH,YHIGH,'CM ')
- CALL ISLN(ILTYP)
-*----
-* New window
-*----
- XWMINI = Q(LHPLIP+16)
- XWMAXI = Q(LHPLIP+17)
- YWMINI = Q(LHPLIP+18)
- LOGYSC = .FALSE.
- IF(IQ(LHPLIP+3).NE.0)LOGYSC = .TRUE.
- IF(.NOT.LOGYSC)THEN
- IF(.NOT.LOMAX)THEN
- HSCAL = SCMAX/3.
- ELSE
- HSCAL = SCMAX
- ENDIF
- IF(I20.EQ.0.)THEN
- IF(YMAXI.GT.0.)THEN
- YMAXI = YMAXI*(1./HSCAL)
- ELSE
- YMAXI = YMAXI*HSCAL
- ENDIF
- ENDIF
- ELSE
- IF(.NOT.LOMAX)THEN
- HSCAL = SCMAX*3.
- ELSE
- HSCAL = SCMAX
- ENDIF
- IF(I20.EQ.0)YMAXI = YMAXI+LOG10(2.*(HSCAL/0.9))
- ENDIF
- YWMAXI = YMAXI
- Q(LHPLIP+19) = YWMAXI
- CALL ISWN(NTZEB,XWMINI,XWMAXI,YWMINI,YWMAXI)
- XMINI = XWMINI
- XMAXI = XWMAXI
- YMINI = YWMINI
- YMAXI = YWMAXI
-*----
-* Redraw histogram, axis and title.
-*----
- LIY = LHPLIP+19
-*
- DO 10 J=1,IQ(LHPLIP+6)
- C1 = HCX(J,1)*FACTOR
- IF(ABS(YMAXI-YMINI).GE.0.000001)THEN
- IF(.NOT.LOGYSC)THEN
- YB = C1
- ELSE
- C1 = MAX(C1,10**YMINI)
- YB = LOG10(C1)
- ENDIF
- ENDIF
- YB = MAX(YB,YMINI)
- YB = MIN(YB,YMAXI)
- Q(LIY+J) = YB
- 10 CONTINUE
-*
- XAX(1) = XMINI
- XAX(2) = XMINI
- XAX(3) = XMAXI
- YAX(1) = YMINI
- YAX(2) = YMAXI
- YAX(3) = YMINI
- CALL HPLRDW(NTZEB,LHPLIP,XAX,YAX)
- IF(.NOT.LOUTIT) CALL HPLTIT(' ')
- CALL HPLGTL
-*----
-* Then we have a loop for all other histograms
-* which are "Live"
-*----
- LPTLIV = LQ(LHPLOT-1)
- 20 IF(LPTLIV.EQ.0)GOTO 30
- IF((LPTLIV.NE.LHPLIP).AND.(JBIT(IQ(LPTLIV),1).NE.0))THEN
- NTLIV = IQ(LPTLIV+2)
-*---
-* Contour of zone
-*----
- XLOW = Q(LPTLIV+12)
- XHIGH = Q(LPTLIV+13)
- YLOW = Q(LPTLIV+14)
- YHIGH = Q(LPTLIV+15)
- CALL ISLN(1)
- CALL HPLBOX(XLOW,YLOW,XHIGH,YHIGH,'CM ')
- CALL ISLN(ILTYP)
-*----
-* Redraw histogram and axis
-*----
- XMINI = Q(LPTLIV+16)
- XMAXI = Q(LPTLIV+17)
- YMINI = Q(LPTLIV+18)
- YMAXI = Q(LPTLIV+19)
- XAX(1) = XMINI
- XAX(2) = XMINI
- XAX(3) = XMAXI
- YAX(1) = YMINI
- YAX(2) = YMAXI
- YAX(3) = YMINI
- CALL HPLRDW(NTLIV,LPTLIV,XAX,YAX)
- LCOLD = LCID
- IDPOS = LOCATI(IQ(LTAB+1),IQ(LCDIR+KNRH),IQ(LPTLIV+1))
- IF(IDPOS.GT.0)THEN
- LCID = LQ(LTAB-IDPOS)
- IF(.NOT.LOUTIT) CALL HPLTIT(' ')
- ENDIF
- LCID = LCOLD
- ENDIF
- LPTLIV = LQ(LPTLIV)
- GOTO 20
-*
- 30 CONTINUE
-*----
-* Reset variables XLOW,YLOW,XHIGH,YHIGH,
-* XMINI,XMAXI,YMINI,YMAXI which may have changed
-* when redrawing every "live" histogram.
-*----
- XLOW = XLOWZ
- XHIGH = XHIGHZ
- YLOW = YLOWZ
- YHIGH = YHIGHZ
- XMINI = XWMINI
- XMAXI = XWMAXI
- YMINI = YWMINI
- YMAXI = YWMAXI
-*
- ENDIF
-*----
-* Select transformation NTZEB
-*----
- CALL ISELNT(NTZEB)
- NTWIN = NTZEB
- NTHIST = NTZEB
-*
- END
diff --git a/src/graflib/hplot/hplotf77/hplj.F b/src/graflib/hplot/hplotf77/hplj.F
deleted file mode 100644
index e4627a7..0000000
--- a/src/graflib/hplot/hplotf77/hplj.F
+++ /dev/null
@@ -1,142 +0,0 @@
-*
-* $Id: hplj.F,v 1.1.1.1 1996/01/19 10:50:09 mclareni Exp $
-*
-* $Log: hplj.F,v $
-* Revision 1.1.1.1 1996/01/19 10:50:09 mclareni
-* Hplot
-*
-*
-#include "hplot/pilot.h"
-*CMZ : 5.09/00 03/05/90 16.22.13 by O.Couet
-*-- Author :
- SUBROUTINE HPLJ
-*.==========>
-*. Defines picture coordinates, set window and viewport,
-*. then draws histogram title and global title if request
-*. and histogram surrounding frame.
-*. Sorts the NTs in the current HIGZ picture if (LOZFL is
-*. .TRUE.) via a call to IZPICT with option 'O'.
-*..=========>
-#include "hplot/hpl1.inc"
-#include "hplot/hpl2.inc"
-#include "hplot/hpl4.inc"
-#include "hplot/hpl9.inc"
-#include "hplot/hpl12.inc"
-*._____________________________
-*----
-* Define transformation of normalization
-* and new frame limits
-*----
-* Frame limits of histogram
-*----
- IF (.NOT.LOWIND) THEN
- XLOW=XMLEFT
- XHIGH=XSIZ-XMRIT
- YLOW=YMGLOW
- YHIGH=YSIZ-YMGUP
- ELSE
-*
- IX=MOD(IWIN,IXWIN)-1
- IY=IYWIN-(IWIN/IXWIN)-1
- IF (IX.LT.0) THEN
- IX=IXWIN-1
- IY=IY+1
- ENDIF
-*
- XLOW=XMLEFT+IX*(XWIND+XWDIST)
- XHIGH=XLOW+XWDIST
- YLOW=YMGLOW+IY*(YWIND+YWDIST)
- YHIGH=YLOW+YWDIST
- ENDIF
-*
- IF(.NOT.LOSQR) GOTO 20
-*----
-* Redefine XLOW,XHIGH etc if 'SQR' option in effect
-*----
- XY=((XHIGH-XLOW)-(YHIGH-YLOW))
- IF(XY.EQ.0.0) GOTO 20
- XY=0.5*XY
- IF(XY.GT.0.) GOTO 10
-*----
-* X length less than Y,compensate Y
-*----
- YHIGH=YHIGH+XY
- YLOW=YLOW-XY
- GOTO 20
-*----
-* Y length less than X, compensate X
-*----
- 10 XHIGH=XHIGH-XY
- XLOW=XLOW+XY
-*
- 20 CONTINUE
-*
- IF((XHIGH.EQ.XLOW).OR.(YHIGH.EQ.YLOW))GOTO 40
-*----
-* Determine transformation of normalisation histogram
-*----
- IF (IXWIN.GE.100) GOTO 40
- IF (IYWIN.GE.100) GOTO 50
- NTHIST=NCHIST*10
-*----
-* Test if the histogram is empty
-*----
- IF((XMINI.EQ.XMAXI).OR.(YMINI.EQ.YMAXI))GOTO 30
-*
- XVP1=XLOW*XYTWN+DXWN
- XVP2=XHIGH*XYTWN+DXWN
- YVP1=YLOW*XYTWN+DYWN
- YVP2=YHIGH*XYTWN+DYWN
-*
- CALL ISWN(NTHIST,XMINI,XMAXI,YMINI,YMAXI)
- CALL ISVP(NTHIST,XVP1,XVP2,YVP1,YVP2)
-*----
-* XMINI, XMAXI, YMINI, YMAXI are the histogram coordinates
-* calculated by HPLC after calling HPLOT
-* XWMINI, XWMAXI, YWMINI, YWMAXI are the window coordinates.
-* It is not necessary the same especially when several histograms
-* are plotted on the same picture (the window does not change in
-* that case.
-*----
- XWMINI=XMINI
- XWMAXI=XMAXI
- YWMINI=YMINI
- YWMAXI=YMAXI
-*
- 30 CONTINUE
- IF(LOHBOX)THEN
- CALL ISLN(1)
- IF(LOGXFL.OR.LOGYFL.OR.ISBCOL.NE.0)THEN
- CALL HPLBOX(XLOW,YLOW,XHIGH,YHIGH,'CMS ')
- ELSE
- FACOLD=FACTOR
- FACTOR=1.
- CALL HPLBOX(XMINI,YMINI,XMAXI,YMAXI,'WC ')
- FACTOR=FACOLD
- ENDIF
- CALL ISLN(ILTYP)
- ENDIF
-*----
-* Histogram title
-*----
- IF(.NOT.LOUTIT) CALL HPLTIT(' ')
-*----
-* Draw global title
-*----
- CALL HPLGTL
-*----
-* Select the normalisation transformation for histogram,
-* and sort the NTs in the current picture if LOZFL is .TRUE.
-*----
- CALL ISELNT(NTHIST)
- NTWIN=NTHIST
- IF(LOZFL)CALL IZPICT(' ','O')
-*
- RETURN
- 40 CALL HBUG('Too many windows requested in X : increase plot size or
- + decrease number of windows','HPLZON',0)
- RETURN
- 50 CALL HBUG('Too many windows requested in Y : increase plot size or
- + decrease number of windows','HPLZON',0)
-*
- END
diff --git a/src/graflib/hplot/hplotf77/hplkey.F b/src/graflib/hplot/hplotf77/hplkey.F
deleted file mode 100644
index 690bdf1..0000000
--- a/src/graflib/hplot/hplotf77/hplkey.F
+++ /dev/null
@@ -1,48 +0,0 @@
-*
-* $Id: hplkey.F,v 1.1.1.1 1996/01/19 10:50:09 mclareni Exp $
-*
-* $Log: hplkey.F,v $
-* Revision 1.1.1.1 1996/01/19 10:50:09 mclareni
-* Hplot
-*
-*
-#include "hplot/pilot.h"
-*CMZ : 5.20/00 19/04/95 10.26.37 by O.Couet
-*-- Author :
- SUBROUTINE HPLKEY(XU,YU,ISYM,CHTXT)
-*.==========>
-*. Routine to draw a symbol and its explanation
-*. (Cm are used for call to HPLTXT)
-*..=========>
-#include "hplot/hpl6.inc"
- CHARACTER*(*) CHTXT
- DIMENSION RTXFP(2)
-*._____________________________
-*
- CALL IGQ('TXFP',RTXFP)
-*----
-* Decode position information
-*----
- XK = FLOARG(XU)
- YK = FLOARG(YU)
- KORNT = 1
- KFLG = 1
- CALL HPLSYM(XK,YK,1,ISYM,0,'CM ')
-*----
-* Calculate position for text
-*----
- XK = XK+2.*TVSIZ(1)
- YK = YK-0.5*TVSIZ(5)
-*---
-* Set font and precision
-*----
- KFONT = IABS(IHFONT(5))
- ITXFON = KFONT/10
- ITXPRE = MOD(KFONT,10)
- IF (IHFONT(5).LT.0) ITXFON = -ITXFON
- CALL ISTXFP(ITXFON,ITXPRE)
-*
- CALL HPLTXT(XK,YK,CHTXT,5,KORNT,KFLG)
-*
- CALL ISTXFP(INT(RTXFP(1)),INT(RTXFP(2)))
- END
diff --git a/src/graflib/hplot/hplotf77/hpllgd.F b/src/graflib/hplot/hplotf77/hpllgd.F
deleted file mode 100644
index b9f3abc..0000000
--- a/src/graflib/hplot/hplotf77/hpllgd.F
+++ /dev/null
@@ -1,227 +0,0 @@
-*
-* $Id: hpllgd.F,v 1.2 1998/10/26 16:45:35 couet Exp $
-*
-* $Log: hpllgd.F,v $
-* Revision 1.2 1998/10/26 16:45:35 couet
-* - TVSIZ(3) was used instead of TVSIZ(4) to place the axis titles
-*
-* Revision 1.1.1.1 1996/01/19 10:50:09 mclareni
-* Hplot
-*
-*
-#include "hplot/pilot.h"
-*CMZ : 5.20/00 19/04/95 10.26.37 by O.Couet
-*-- Author : O.Couet 11/04/95
- SUBROUTINE HPLLGD(CHXTIT,CHYTIT,CHZTIT,IALGN,CHOPT)
-*.==========>
-*. HPLOT routine to label axes with a title. The parameter IALGN
-*. defined where in aligned the legend i.e: on the beginning, the
-*. middle or at the end of the axis. The alignment parameter has
-*. 3 digits (one for each axis):
-*.
-*. xyz
-*.
-*. where x, y and z may have independently the following values:
-*.
-*. 1: Begining of the axis
-*. 2: Middle of the axis
-*. 3: End of the axis (0 is equivalent to 3)
-*.
-*. The CHOPT parameter allows to define on which side of the
-*. current zone the X and Y titles are drawn:
-*.
-*. CHOPT = 'R' : Y title is drawn on the right side of the current zone.
-*. CHOPT = 'T' : X title is drawn on the top side of the current zone.
-*.
-*..=========>
-#include "hplot/hpl1.inc"
-#include "hplot/hpl2.inc"
-#include "hplot/hpl4.inc"
-#include "hplot/hpl6.inc"
-#include "hplot/quest.inc"
- DIMENSION RTXFP(2), RTXAL(2)
- CHARACTER*(*) CHOPT,CHXTIT,CHYTIT,CHZTIT
- DIMENSION IOPT(2)
- EQUIVALENCE (IOPTR,IOPT(1)),(IOPTT,IOPT(2))
-*._____________________________
-*
-*----
-* Return immediately if this routine is called before the
-* first HPLOT call
-*----
- IF(IPLNUM.LT.0)THEN
- CALL HBUG('HPLAX must be called after HPLOT','HPLAX ',0)
- RETURN
- ENDIF
-*
- CALL UOPTC(CHOPT,'RT',IOPT)
-*----
-* Get the axis alignment
-*----
- IXXAL = IALGN/100
- IYXAL = IALGN/10-IXXAL*10
- IZXAL = IALGN-IXXAL*100-IYXAL*10
-*----
-* Retrieve the 3D cube coordinates.
-*----
- NTWOLD = NTWIN
- IF (LO3DPL) THEN
- NTWIN = NTHIST
- CALL ISELNT(NTHIST)
- CALL HPLTOC(RQUEST(70),RQUEST(72),XKX1,YKX1,NT)
- CALL HPLTOC(RQUEST(71),RQUEST(73),XKX2,YKX2,NT)
- CALL HPLTOC(RQUEST(74),RQUEST(76),XKY1,YKY1,NT)
- CALL HPLTOC(RQUEST(75),RQUEST(77),XKY2,YKY2,NT)
- CALL HPLTOC(RQUEST(78),RQUEST(80),XKZ1,YKZ1,NT)
- CALL HPLTOC(RQUEST(79),RQUEST(81),XKZ2,YKZ2,NT)
- ENDIF
-*----
-* Save the current NT and the current text angle and alignment.
-* Select the centimeters.
-*----
- IF (NTWIN.NE.1) CALL ISELNT(1)
- NTWIN = 1
- CALL IGQ('TANG',RTANG)
- CALL IGQ('TXAL',RTXAL)
- CALL IGQ('TXFP',RTXFP)
- CALL IGQ('CHHE',RCHHE)
-*----
-* Set axis labels font and precision
-*----
- KFONT = IABS(IHFONT(4))
- ILAFON = KFONT/10
- ILAPRE = MOD(KFONT,10)
- IF (IHFONT(4).LT.0) ILAFON = -ILAFON
- CALL ISTXFP(ILAFON,ILAPRE)
- CALL ISCHH(TVSIZ(4))
-*----
-* Draw the axis title on a 3D plot
-*----
- IF (LO3DPL) THEN
-* X axis label
- IF (XKX1.EQ.XKZ1) THEN
- XK = XKX1
- YK = YKX1
- CALL ISTXAL(0,0)
- ELSEIF (XKX2.EQ.XKZ1) THEN
- XK = XKX2
- YK = YKX2
- CALL ISTXAL(0,0)
- ELSE
- IF (XKX2.GT.XKX1) THEN
- XK = XKX2
- YK = YKX2
- ELSE
- XK = XKX1
- YK = YKX1
- ENDIF
- CALL ISTXAL(3,0)
- ENDIF
- IF (IXXAL.EQ.2) THEN
- XK = (XKX1+XKX2)/2.
- YK = (YKX1+YKX2)/2.
- ENDIF
- IF (XKX2-XKX1.NE.0.) THEN
- RANG = (ATAN((YKX2-YKX1)/(XKX2-XKX1)))*(180./3.14159)
- ELSE
- RANG = 0.
- ENDIF
- CALL IGSET('TANG',RANG)
- CALL ITX(XK,YK-1.5*YLABEL-TVSIZ(4),CHXTIT)
-* Y axis label
- IF (XKY1.EQ.XKZ1) THEN
- XK = XKY1
- YK = YKY1
- CALL ISTXAL(0,0)
- ELSEIF (XKY2.EQ.XKZ1) THEN
- XK = XKY2
- YK = YKY2
- CALL ISTXAL(0,0)
- ELSE
- IF (XKY2.GT.XKY1) THEN
- XK = XKY2
- YK = YKY2
- ELSE
- XK = XKY1
- YK = YKY1
- ENDIF
- CALL ISTXAL(3,0)
- ENDIF
- IF (IYXAL.EQ.2) THEN
- XK = (XKY1+XKY2)/2.
- YK = (YKY1+YKY2)/2.
- ENDIF
- IF (XKY2-XKY1.NE.0.) THEN
- RANG = (ATAN((YKY2-YKY1)/(XKY2-XKY1)))*(180./3.14159)
- ELSE
- RANG = 0.
- ENDIF
- CALL IGSET('TANG',RANG)
- CALL ITX(XK,YK-2.5*YLABEL-TVSIZ(4),CHYTIT)
-* Z axis label
- IF (IZXAL.EQ.1) THEN
- CALL ISTXAL(1,0)
- YK = YKZ1
- ELSEIF (IZXAL.EQ.2) THEN
- CALL ISTXAL(2,0)
- YK = (YKZ1+YKZ2)/2.
- ELSE
- CALL ISTXAL(3,0)
- YK = YKZ2
- ENDIF
- CALL IGSET('TANG',90.)
- CALL ITX(XKZ2-XLABEL,YK,CHZTIT)
-*----
-* Draw the axis title on a 2D plot
-*----
- ELSE
-* X axis label
- CALL IGSET('TANG',0.)
- IF (IOPTT.NE.0) THEN
- YK = YHIGH+YLABEL+TVSIZ(4)
- ELSE
- YK = YLOW-YLABEL-TVSIZ(4)
- ENDIF
- IF (IXXAL.EQ.1) THEN
- CALL ISTXAL(0,0)
- XK = XLOW
- ELSEIF (IXXAL.EQ.2) THEN
- CALL ISTXAL(2,0)
- XK = (XHIGH+XLOW)/2.
- ELSE
- CALL ISTXAL(3,0)
- XK = XHIGH
- ENDIF
- CALL ITX(XK,YK,CHXTIT)
-* Y axis label
- CALL IGSET('TANG',90.)
- IF (IOPTR.NE.0) THEN
- XK = XHIGH+XLABEL
- ELSE
- XK = XLOW-XLABEL
- ENDIF
- IF (IYXAL.EQ.1) THEN
- CALL ISTXAL(0,0)
- YK = YLOW
- ELSEIF (IYXAL.EQ.2) THEN
- CALL ISTXAL(2,0)
- YK = (YHIGH+YLOW)/2.
- ELSE
- CALL ISTXAL(3,0)
- YK = YHIGH
- ENDIF
- CALL ITX(XK,YK,CHYTIT)
- ENDIF
-*----
-* Restore the NT, the text angle and the text alignment.
-*----
- IF(NTWIN.NE.NTWOLD)THEN
- NTWIN = NTWOLD
- CALL ISELNT(NTWOLD)
- ENDIF
- CALL IGSET('TANG',RTANG)
- CALL ISTXAL(INT(RTXAL(1)),INT(RTXAL(2)))
- CALL ISTXFP(INT(RTXFP(1)),INT(RTXFP(2)))
- CALL IGSET('CHHE',RCHHE)
-*
- END
diff --git a/src/graflib/hplot/hplotf77/hplnew.F b/src/graflib/hplot/hplotf77/hplnew.F
deleted file mode 100644
index 82b30c3..0000000
--- a/src/graflib/hplot/hplotf77/hplnew.F
+++ /dev/null
@@ -1,72 +0,0 @@
-*
-* $Id: hplnew.F,v 1.1.1.1 1996/01/19 10:50:09 mclareni Exp $
-*
-* $Log: hplnew.F,v $
-* Revision 1.1.1.1 1996/01/19 10:50:09 mclareni
-* Hplot
-*
-*
-#include "hplot/pilot.h"
-*CMZ : 5.18/16 25/08/94 15.46.49 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE HPLNEW
-*.==========>
-*. Makes a new picture
-*..=========>
-#include "hplot/hpl0.inc"
-#include "hplot/hpl1.inc"
-#include "hplot/hpl13.inc"
-#include "hbook/hcbook.inc"
-*
- CHARACTER*10 CHPTNO,STRING
-*._____________________________
-*
-* Request string (CR) if option PTO selected
-*
- IF (LOPTO) THEN
- IF ((IPLNUM.GE.1).OR.(IPLNUM.EQ.-1)) CALL HPLPTO(' ',STRING)
- ENDIF
-*
-* Create a new picture if necessary
-*
- IF (LOZFL) THEN
- IF (LOZFL1) THEN
- PNAME = 'PICT00'
- IF (IZRPIP(PNAME).NE.0) CALL IZPICT(PNAME,'S')
- ELSE
- 10 WRITE(CHPTNO,'(I10)')IPLTNO
- NLAST = LENOCC(CHPTNO)
- NFIRST = 0
- 20 NFIRST = NFIRST+1
- IF (CHPTNO(NFIRST:NFIRST).EQ.' ') GOTO 20
- PNAME = 'PICT'//CHPTNO(NFIRST:NLAST)
- IF (IZRPIP(PNAME).NE.0) THEN
- IPLTNO = IPLTNO+1
- GOTO 10
- ENDIF
- ENDIF
- CALL IZPICT(PNAME,'M')
- ENDIF
-*
-* Clear screen
-*
- CALL ICLRWK(0,0)
-*
-* the global title will be drawn by HPLGTL
-*
- LOGTIT = .FALSE.
-*
-* Check if there is more than one "LIFE" bank active
-* (unless it is just a change of scale for option "Update".
-*
- LP = LQ(LHPLOT-1)
- IF ((LP.NE.0).AND.(.NOT.LOSCAL)) THEN
- CALL SBIT0(IQ(LP),1)
- IF (LQ(LP).NE.0) THEN
- CALL MZDROP(IHDIV,LQ(LP),'L')
- ENDIF
- ENDIF
-*
- CALL HPLSCM
-*
- END
diff --git a/src/graflib/hplot/hplotf77/hplnot.F b/src/graflib/hplot/hplotf77/hplnot.F
deleted file mode 100644
index e8ac260..0000000
--- a/src/graflib/hplot/hplotf77/hplnot.F
+++ /dev/null
@@ -1,90 +0,0 @@
-*
-* $Id: hplnot.F,v 1.1.1.1 1996/01/19 10:50:09 mclareni Exp $
-*
-* $Log: hplnot.F,v $
-* Revision 1.1.1.1 1996/01/19 10:50:09 mclareni
-* Hplot
-*
-*
-#include "hplot/pilot.h"
-*CMZ : 5.20/01 19/05/95 11.09.24 by O.Couet
-*-- Author : O.Couet 10/05/95
- SUBROUTINE HPLNOT(XU,YU,DX,ISYM,CHTXT,CHOPT)
-*.==========>
-*. Routine to anotate a plot (similar to HPLKEY but
-*. more complete). Cm are used for call to HPLTXT.
-*..=========>
-#include "hplot/hpl2.inc"
-#include "hplot/hpl6.inc"
-#include "hplot/hpl11.inc"
- CHARACTER*(*) CHTXT,CHOPT
- DIMENSION RTXFP(2)
- DIMENSION IOPT(4)
- EQUIVALENCE (IOPTF,IOPT(1)),(IOPTL,IOPT(2))
- EQUIVALENCE (IOPTW,IOPT(3)),(IOPTH,IOPT(4))
-*._____________________________
-*
- CALL UOPTC(CHOPT,'FLWH',IOPT)
-*
- CALL IGQ('TXFP',RTXFP)
- CALL IGQ('FAIS',RFAIS)
- CALL IGQ('FASI',RFASI)
- CALL IGQ('LWID',RLWID)
- CALL IGQ('LTYP',RLTYP)
- CALL IGQ('BORD',RBORD)
- IF(NTWIN.NE.1)CALL ISELNT(1)
- NTWIN = 1
-*----
-* Decode position information
-*----
- XK = FLOARG(XU)
- YK = FLOARG(YU)
- KORNT = 1
- KFLG = 1
- IF (IOPTF+IOPTH.NE.0) THEN
- IF (IOPTF.NE.0) THEN
- CALL ISFAIS(1)
- CALL ISFACI(ISYM)
- ENDIF
- IF (IOPTH.NE.0) THEN
- CALL ISFAIS(3)
- CALL ISFASI(ISYM)
- ENDIF
- CALL IGSET('LWID',1.)
- CALL ISPLCI(1)
- CALL IGSET('BORD',1.)
- CALL IGBOX(XK-DX,XK,YK-0.6*TVSIZ(5),YK+0.6*TVSIZ(5))
- ELSEIF (IOPTL+IOPTW.NE.0) THEN
- IF (IOPTL.NE.0) CALL ISLN(ISYM)
- IF (IOPTW.NE.0) CALL IGSET('LWID',FLOAT(ISYM))
- XLINE(1) = XK
- XLINE(2) = XK-DX
- YLINE(1) = YK
- YLINE(2) = YK
- CALL IPL(2,XLINE,YLINE)
- ELSE
- CALL HPLSYM(XK,YK,1,ISYM,0,'CM ')
- ENDIF
-*----
-* Calculate position for text
-*----
- XK = XK+2.*TVSIZ(1)
- YK = YK-0.5*TVSIZ(5)
-*---
-* Set font and precision
-*----
- KFONT = IABS(IHFONT(5))
- ITXFON = KFONT/10
- ITXPRE = MOD(KFONT,10)
- IF (IHFONT(5).LT.0) ITXFON = -ITXFON
- CALL ISTXFP(ITXFON,ITXPRE)
-*
- CALL HPLTXT(XK,YK,CHTXT,5,KORNT,KFLG)
-*
- CALL IGSET('FAIS',RFAIS)
- CALL IGSET('FASI',RFASI)
- CALL IGSET('LWID',RLWID)
- CALL IGSET('LTYP',RLTYP)
- CALL IGSET('BORD',RBORD)
- CALL ISTXFP(INT(RTXFP(1)),INT(RTXFP(2)))
- END
diff --git a/src/graflib/hplot/hplotf77/hplnt.F b/src/graflib/hplot/hplotf77/hplnt.F
deleted file mode 100644
index 1230ebb..0000000
--- a/src/graflib/hplot/hplotf77/hplnt.F
+++ /dev/null
@@ -1,73 +0,0 @@
-*
-* $Id: hplnt.F,v 1.1.1.1 1996/01/19 10:50:09 mclareni Exp $
-*
-* $Log: hplnt.F,v $
-* Revision 1.1.1.1 1996/01/19 10:50:09 mclareni
-* Hplot
-*
-*
-#include "hplot/pilot.h"
-*CMZ : 5.06/02 29/08/89 11.06.59 by O.Couet
-* X dimension change from 127 to 515
-*-- Author :
- SUBROUTINE HPLNT(IDN,ISEL,UWFUNC,IFROM,ITOM,IVARX,IVARY)
-*.==========>
-*. DRAWS N-tuple IDN as a scatter-plot
-*. (Transformation NTHIST is selected)
-*..=========>
-#include "hbook/hcbook.inc"
-#include "hplot/hpl2.inc"
-#include "hplot/hpl9.inc"
- COMMON/PAWIDN/IDNEVT,X(515)
- COMMON/HPLCSC/U(64),V(64)
- EXTERNAL UWFUNC
-*._____________________________
-*
-*----
-* Transformation NTHIST is selected
-*----
- IF(NTWIN.NE.NTHIST)THEN
- CALL ISELNT(NTHIST)
- NTWIN=NTHIST
- ENDIF
-*
- CALL HGNPAR(IDN,'HPLNT ')
- IF(LCIDN.LE.0)RETURN
- NDIM=IQ(LCIDN+2)
- IF(IVARX.LE.0.OR.IVARX.GT.NDIM)THEN
- CALL HBUG('Non existing option','HPLNT ',IDN)
- RETURN
- ENDIF
- IF(IVARY.LE.0.OR.IVARY.GT.NDIM)THEN
- CALL HBUG('Non existing option','HPLNT ',IDN)
- RETURN
- ENDIF
-*
- NPOINT=0
- ITO=MIN(ITOM,IQ(LCIDN+3))
-*
- DO 10 IDNEVT=IFROM,ITO
- CALL HGNF(IDN,IDNEVT,X,IERROR)
- IF(IERROR.NE.0)GO TO 20
- X1=X(IVARX)
- Y1=X(IVARY)
- IF(X1.LT.XMINI)GO TO 10
- IF(X1.GE.XMAXI)GO TO 10
- IF(Y1.LT.YMINI)GO TO 10
- IF(Y1.GE.YMAXI)GO TO 10
- IF(ISEL.NE.0)THEN
- W=UWFUNC(X,1)
- IF(W.LE.0.)GO TO 10
- ENDIF
- NPOINT=NPOINT+1
- U(NPOINT)=X(IVARX)
- V(NPOINT)=X(IVARY)
- IF(NPOINT.EQ.64)THEN
- CALL IPM(NPOINT,U,V)
- NPOINT=0
- ENDIF
- 10 CONTINUE
- 20 IF(NPOINT.NE.0)CALL IPM(NPOINT,U,V)
-*
- 99 END
-
diff --git a/src/graflib/hplot/hplotf77/hplnul.F b/src/graflib/hplot/hplotf77/hplnul.F
deleted file mode 100644
index 8f87002..0000000
--- a/src/graflib/hplot/hplotf77/hplnul.F
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: hplnul.F,v 1.1.1.1 1996/01/19 10:50:09 mclareni Exp $
-*
-* $Log: hplnul.F,v $
-* Revision 1.1.1.1 1996/01/19 10:50:09 mclareni
-* Hplot
-*
-*
-#include "hplot/pilot.h"
-*CMZ : 5.18/14 29/06/94 11.19.13 by O.Couet
-*-- Author :
- SUBROUTINE HPLNUL
-*.==========>
-*. Draws page number, global title and boxes only.
-*. Transformation NTHIST is selected when calling HPLSWN.
-*. The same coordinates of the last drawned histogram are taken.
-*..=========>
-#include "hplot/hpl1.inc"
-#include "hplot/hpl13.inc"
- LOGICAL LOLD
-*._____________________________
-*
- DO 10 I=1,NOPT
- IOPT(I)=0
- 10 CONTINUE
- LOLD = LOUTIT
- LOUTIT = .TRUE.
- LOSAME = .FALSE.
- LO3DPL = .FALSE.
- CALL HPLSWN
- CALL HPLDES(0)
- CALL HPLDAT
- LOUTIT = LOLD
- END
diff --git a/src/graflib/hplot/hplotf77/hplnxt.F b/src/graflib/hplot/hplotf77/hplnxt.F
deleted file mode 100644
index 0505dbd..0000000
--- a/src/graflib/hplot/hplotf77/hplnxt.F
+++ /dev/null
@@ -1,13 +0,0 @@
-*
-* $Id: hplnxt.F,v 1.1.1.1 1996/01/19 10:50:10 mclareni Exp $
-*
-* $Log: hplnxt.F,v $
-* Revision 1.1.1.1 1996/01/19 10:50:10 mclareni
-* Hplot
-*
-*
-#include "hplot/pilot.h"
-*CMZ : 5.14/09 06/01/93 13.31.29 by O.Couet
-*-- Author :
- SUBROUTINE HPLNXT
- END
diff --git a/src/graflib/hplot/hplotf77/hploc.F b/src/graflib/hplot/hplotf77/hploc.F
deleted file mode 100644
index 582b586..0000000
--- a/src/graflib/hplot/hplotf77/hploc.F
+++ /dev/null
@@ -1,43 +0,0 @@
-*
-* $Id: hploc.F,v 1.1.1.1 1996/01/19 10:50:10 mclareni Exp $
-*
-* $Log: hploc.F,v $
-* Revision 1.1.1.1 1996/01/19 10:50:10 mclareni
-* Hplot
-*
-*
-#include "hplot/pilot.h"
-*CMZ : 5.18/12 09/05/94 18.27.23 by O.Couet
-*-- Author : O.Couet
- SUBROUTINE HPLOC(NTPRI,NTLOC,XLOC,YLOC,IDH,ICX,ICY,ISTAT)
-*.==========>
-*.
-*. Picking of an histogram point and returns its coordinates and
-*. the number of transformation. The location is limited to 100
-*. windows maximum. If NTPRI.LT.0 then automatic selection of NTLOC.
-*. If NTPRI.GE.0 then transformation NTPRI is prioritary
-*.
-*..=========> (N. Somon)
-#include "hplot/hpl2.inc"
-*._____________________________
-*
- LCDNR = 21
- IF(ISTAT.NE.0)LCDNR = 11
- IF(NTPRI.GE.0)THEN
- IF(NTPRI.NE.1)CALL ISELNT(1)
- CALL ISELNT(NTPRI)
- ELSE
- CALL ISELNT(1)
- DO 10 I=10,NTHIST,10
- CALL ISELNT(I)
- 10 CONTINUE
- ENDIF
- CALL IRQLC(1,LCDNR,ISTAT,NTLOC,X,Y)
- IF(ISTAT.NE.0)THEN
- XLOC = X
- YLOC = Y
- CALL HPLCHA(NTLOC,X,Y,IDH,XLOC,YLOC,ICX,ICY)
- ENDIF
-*
- END
-
diff --git a/src/graflib/hplot/hplotf77/hplone.F b/src/graflib/hplot/hplotf77/hplone.F
deleted file mode 100644
index e979f0f..0000000
--- a/src/graflib/hplot/hplotf77/hplone.F
+++ /dev/null
@@ -1,197 +0,0 @@
-*
-* $Id: hplone.F,v 1.2 1998/06/02 09:14:23 couet Exp $
-*
-* $Log: hplone.F,v $
-* Revision 1.2 1998/06/02 09:14:23 couet
-* - if FCOL was > 1000 the axes were redrawn even if option A was used.
-*
-* Revision 1.1.1.1 1996/01/19 10:50:10 mclareni
-* Hplot
-*
-*
-#include "hplot/pilot.h"
-*-- Author : O.Couet
- SUBROUTINE HPLONE(CHOPT,IERROR)
-*.==========>
-*. HPLOT basic routine to draw 1-dim projection.
-*. Transformation NTHIST is selected when calling HPLSWN.
-*..=========>
-#include "hbook/hcbits.inc"
-#include "hbook/hcbook.inc"
-#include "hbook/hcflag.inc"
-#include "hbook/hcprin.inc"
-#include "hplot/hpl1.inc"
-#include "hplot/hpl2.inc"
-#include "hplot/hpl3.inc"
-#include "hplot/hpl9.inc"
-#include "hplot/hpl13.inc"
-#include "hplot/hplstr.inc"
- CHARACTER*(*) CHOPT
- INTEGER HPLHIP
- DIMENSION XAX(3),YAX(3)
-*._____________________________
-*
-*----
-* If error bars required or
-* if HSTAR has been called (function)
-* then option "K", "Update" and "+" are not available.
-*-----
- IF((I11.NE.0).OR.(I12.NE.0).OR.(I28.NE.0))THEN
- IF(IOPTK.NE.0)THEN
- CALL HBUG('Option "K" not available ','HPLOT ',IDZK)
- RETURN
- ENDIF
- IF(IOPTU.NE.0)THEN
- CALL HBUG('Option "Update" not available ','HPLOT ',IDZB)
- RETURN
- ENDIF
- IF(IOPTP.NE.0)THEN
- CALL HBUG('Option "+" not available ','HPLOT ',IDZK)
- RETURN
- ENDIF
- ENDIF
-*----
-* If option "Update" or "+" is selected we set LOGXFL and LOGYFL
-* according to ZEBRA structure otherwise we determine them.
-* If LHPLIP=0 it means that we cannot find histogram IDZB (option "U")
-* or IDZK (option "+") in the structure (not created with option "K"
-* if windowing, or scratched by another histogram if not windowing).
-*----
- IF((IOPTU.NE.0).OR.(IOPTP.NE.0))THEN
- IF(IOPTU.NE.0)THEN
- LHPLIP=HPLHIP(IDZB,'I')
- IF(LHPLIP.EQ.0)THEN
- CALL HBUG('Histogram is not in memory','HPLOT',IDZB)
- RETURN
- ENDIF
- ELSE IF(IOPTP.NE.0)THEN
- LHPLIP=HPLHIP(IDZK,'I')
- IF(LHPLIP.EQ.0)THEN
- CALL HBUG('No histogram in memory','HPLOT',IDZK)
- RETURN
- ENDIF
- ENDIF
- IF(IQ(LHPLIP+3).NE.0)THEN
- LOGYFL=.TRUE.
- ELSE
- LOGYFL=.FALSE.
- ENDIF
- IF(IQ(LHPLIP+4).NE.0)THEN
- LOGXFL=.TRUE.
- ELSE
- LOGXFL=.FALSE.
- ENDIF
- ELSE
-*----
-* The defaults is LINX and LINY. If IDOPT LOGY has been applied
-* on a histogram (I26.NE.0) the option LOGY is forced.
-*----
- LOGXFL=.FALSE.
- IF(LOGX.NE.0)LOGXFL=.TRUE.
- LOGYFL=.FALSE.
- IF(LOGY.NE.0)LOGYFL=.TRUE.
- IF(I26.NE.0)LOGYFL=.TRUE.
- ENDIF
-*----
-* Histogram coordinates
-* abcsissa (XMINI,XMAXI)
-* ordonnee (YMINI,YMAXI)
-*----
- NCX=IQ(LPRX)
- NB=IQ(LCONT+KNBIT)
- IF(I6.EQ.0)THEN
- XXSIZE=(Q(LPRX+2)-Q(LPRX+1))/FLOAT(NCX)
- XX0=Q(LPRX+1)
- IF(LOGXFL.AND.XX0.LE.0.)THEN
- XX0=0.1*XXSIZE
- ENDIF
- ENDIF
-*
- CALL HPLC(IERROR)
-*----
-* Case "LOGYFL and YMINI=YMAXI" or "YMAXI<0"
-*----
- IF(IERROR.NE.0)RETURN
-*----
-* Picture surround (if new page) and page number (if requested).
-* Histogram surround (if not option "Same" nor "Update").
-* If scale has changed (option "Update") all histogram "Live" are
-* completly redraw with axis.
-*----
- LO3DPL = .FALSE.
- CALL HPLSWN
- IF(I1.NE.0)THEN
- CALL IGPID(1,'1d',ID,' ')
- ELSE
- CALL IGPID(1,'2d',ID,' ')
- ENDIF
- IF(LOSCAL)RETURN
-*
- CALL HPLDES(ID)
-*----
-* do not draw histogram if error bars required
-* unless 'eah' option has been selected
-*-----
- IF((.NOT.LOEAH.AND.I34.EQ.1).OR.IOPTE.NE.0) GOTO 10
-*-----
-* if HSTAR has been called (I28.EQ.1) draw function
-*-----
- IF(I28.NE.0)THEN
- CALL HPLF(1)
- ELSE
- IF(IOPTH.NE.0)CALL HPLH
- ENDIF
-*----
-* test for error bars or option E
-*----
- 10 CONTINUE
- CHTEMP = ' '
- IF(IOPTE.NE.0)THEN
- CHTEMP = CHOPT
- CHTEMP(16:16) = 'H'
- CALL HPLAER(0.,0.,0.,0.,0.,0.,0,CHTEMP,0,0)
- ENDIF
- IF(I34.NE.0.AND.IOPTE.EQ.0)THEN
- IF(IOPTH.EQ.2)THEN
- CALL HPLH
- ELSE
- IF(IOPTF.LT.2)THEN
- CHTEMP = CHOPT
- CHTEMP(16:16) = 'H'
- CALL HPLAER(0.,0.,0.,0.,0.,0.,0,CHTEMP,0,0)
- ENDIF
- ENDIF
- ENDIF
-*----
-* test for function
-*---
- IF(I12.NE.0)THEN
- IF(IOPTF.NE.0)CALL HPLF(3)
- ENDIF
-*----
-* draw axes if required.
-*----
- IF (IOPTA.EQ.0) THEN
- IF ((.NOT.LOSAME).AND.(IOPTU.EQ.0).AND.(IOPTP.EQ.0)) THEN
- XAX(1)=XMINI
- XAX(2)=XMINI
- XAX(3)=XMAXI
- YAX(1)=YMINI
- YAX(2)=YMAXI
- YAX(3)=YMINI
- CALL HPLAXI(XAX,YAX,1)
- ENDIF
- IF (LOSAME.AND.RHCOL.GT.1000..OR.IFTYP.GT.1000) THEN
- XAX(1)=XWMINI
- XAX(2)=XWMINI
- XAX(3)=XWMAXI
- YAX(1)=YWMINI
- YAX(2)=YWMAXI
- YAX(3)=YWMINI
- CALL HPLAXI(XAX,YAX,2)
- ENDIF
- ENDIF
-*
- CALL HPLU(ID,1)
-*
- END
diff --git a/src/graflib/hplot/hplotf77/hplopt.F b/src/graflib/hplot/hplotf77/hplopt.F
deleted file mode 100644
index be2035f..0000000
--- a/src/graflib/hplot/hplotf77/hplopt.F
+++ /dev/null
@@ -1,430 +0,0 @@
-*
-* $Id: hplopt.F,v 1.1.1.1 1996/01/19 10:50:10 mclareni Exp $
-*
-* $Log: hplopt.F,v $
-* Revision 1.1.1.1 1996/01/19 10:50:10 mclareni
-* Hplot
-*
-*
-#include "hplot/pilot.h"
-*CMZ : 5.20/05 27/10/95 11.11.59 by O.Couet
-*-- Author :
- SUBROUTINE HPLOPT(CHOPTN,N)
-*.==========>
-*. this routine sets options in /HPL1/ for HPLOT
-*..=========>
-#include "hbook/hcunit.inc"
-#include "hplot/hpl1.inc"
-#include "hplot/hpl3.inc"
-#include "hplot/hpl4.inc"
-#include "hplot/hpl6.inc"
-#include "hplot/quest.inc"
-*
- PARAMETER (IDEF=20, IDEF1=6)
- PARAMETER (KIDEF=40, KIDEF1=12)
- PARAMETER (IOTHER=19)
-*
- DIMENSION LOPTN(IDEF)
- EQUIVALENCE (LOPTN(1),LOVERT)
-*
- LOGICAL LSETOP,LOPTN,LRESET
-*
- CHARACTER*(*) CHOPTN(1)
- CHARACTER*4 CHOPTB
- CHARACTER*32 KEXP(KIDEF)
- CHARACTER*32 KEXP1(KIDEF1)
- CHARACTER*4 KDEF(IDEF),KNDEF(IDEF)
- CHARACTER*4 KDEF1(IDEF1),KNDEF1(IDEF1)
- CHARACTER*4 KTRUE(IDEF),KFALSE(IDEF),KOTHER(IOTHER)
- CHARACTER*4 CHSIZ
- CHARACTER*4 CHOPT
- LOGICAL LOHSTA
- SAVE LOHSTA
-* set up constants for allowed range of A4 paper sizes
-* range of values from 0 to 6 (A0 down to A6)
-*
- DIMENSION ASIZE(14)
- DATA ASIZE /336.,475.2,168.,237.6,84.,118.8
- + ,42.,59.4,21.,29.7,10.5,14.8,5.2,7.4/
-*
- DATA KEXP/' VERTical or HORIzontal',' orientation of paper'
- +,' Error bars And Histogram are',' plotted (if both are present)'
- +,' scatter plots drawn with dots',' (NCHA) or 1 char./bin (CHA)'
- +,' functions drawn with (AST)',' or without (NAST) asterisks'
- +,' SOFTware or HARDware characters',' are used'
- +,' size is set to the largest',' square (SQR)'
- +,' HBOOK TITle (HTIT)',' or User TITle (UTIT) is printed'
- +,' table printed as TABles (TAB)',' or scatter plots (NTAB)'
- +,' a box is (BOX) or is not (NBOX)',' drawn around picture'
- +,' cross-wires are drawned (TIC)',' or not (NTIC) on each plot'
- +,' STAtistics are printed (STA)',' or not (NSTA) on each plot'
- +,' FIT parameters are printed',' or not (NFIT) on each plot'
- +,' picture is (ZFL) or is not',' (NZFL) put in Z data base'
- +,' PTO (Please Turn Over)',' (NPTO)'
- +,' BAR charts for histogram', ' (NBAR)'
- +,' Integer (DVXI) or Real (DVXR)',' divisions for X axis'
- +,' Integer (DVYI) or Real (DVYR)',' divisions for Y axis'
- +,' GRID or not grid (NGRI)',' on X and Y axis'
- +,' DATE is printed (DATE)',' or not (NDAT) on each plot'
- +,' FILE name is printed (FILE)',' or not (NFIL) on each plot'/
-
- DATA KEXP1/' page format for the plotter'
- +,' (A0,A1,A2,A3,A4,A5,A6)'
- +,' page number is (P )',' or is not (NOPG) printed'
- +,' LINear or LOGarithmic scale',' in Y'
- +,' LINear or LOGarithmic scale',' in X'
- +,' LINear or LOGarithmic scale',' in Z (Lego or Surface)'
- +,' Filling statistics (HSTA)',' (HNST)'/
-*
- DATA KDEF/ 'VERT','NEAH','NCHA','NAST'
- +, 'SOFT','NSQR','HTIT','TAB ','BOX '
- +, 'NTIC','NSTA','NFIT','NZFL','NPTO'
- +, 'NBAR','DVXR','DVYR','NGRI','NDAT'
- +, 'NFIL'/
-
- DATA KDEF1/ 'A4 ','NOPG','LINY','LINX','LINZ','HNST'/
-*
- DATA KNDEF/'HORI','EAH ','CHA ','AST '
- +, 'HARD','SQR ','UTIT','NTAB','NBOX'
- +, 'TIC ','STA ','FIT ','ZFL ','PTO '
- +, 'BAR ','DVXI','DVYI','GRID','DATE'
- +, 'FILE'/
-
- DATA KNDEF1/ 'A0/6','P ','LOGY','LOGX','LOGZ','HSTA'/
-*
- DATA KTRUE/'VERT','EAH ','CHA ','AST '
- +, 'SOFT','SQR ','UTIT','TAB ','BOX '
- +, 'TIC ','STA ','FIT ','ZFL ','PTO '
- +, 'BAR ','DVXI','DVYI','GRID','DATE'
- +, 'FILE'/
-*
- DATA KFALSE/'HORI','NEAH','NCHA','NAST'
- +, 'HARD','NSQR','HTIT','NTAB','NBOX'
- +, 'NTIC','NSTA','NFIT','NZFL','NPTO'
- +, 'NBAR','DVXR','DVYR','NGRI','NDAT'
- +, 'NFIL'/
-*
- DATA KOTHER/'A0 ','A1 ','A2 ','A3 ','A4 ','A5 '
- +, 'A6 ','NOPG','LINX','LINY','LOGX','LOGY'
- +, 'LINZ','LOGZ','ZFL1','SHOW','* ','HSTA','HNST'/
-*
- DATA LOHSTA/.FALSE./
-*
-*._____________________________
-*
- NARG=2
- CALL NOARG(NARG)
-*
-* Return in IQUEST(11) the current options selected.
-*
- IF(N.LT.0)THEN
- IQUEST(11)=0
- IF(INDEX(CHOPTN(1)(1:3),'LOG').NE.0)THEN
- IF(CHOPTN(1)(4:4).EQ.'X'.AND.LOGX.NE.0)IQUEST(11)=1
- IF(CHOPTN(1)(4:4).EQ.'Y'.AND.LOGY.NE.0)IQUEST(11)=1
- IF(CHOPTN(1)(4:4).EQ.'Z'.AND.LOGZ.NE.0)IQUEST(11)=1
- RETURN
- ENDIF
- DO 10 K=1,IDEF
- IF(CHOPTN(1)(1:4).EQ.KTRUE(K))THEN
- IF(LOPTN(K))IQUEST(11)=1
- RETURN
- ENDIF
- 10 CONTINUE
- RETURN
- ENDIF
-*
- NUM=1
- IF(NARG.GE.2) NUM=N
- NUMOPT=0
- LRESET=.FALSE.
-*
- 20 NUMOPT=NUMOPT+1
- IF(NUMOPT.GT.NUM) GOTO 120
- I=0
- LSETOP=.TRUE.
- DO 30 K=1,IDEF
- CHOPTB=CHOPTN(NUMOPT)
- IF(CHOPTB.EQ.'STAT')CHOPTB='STA'
- IF(CHOPTB.EQ.KTRUE(K))THEN
- I=K
- IF(I.EQ.1)LRESET=.TRUE.
- IF(I.EQ.13)LOZFL1=.FALSE.
- GOTO 80
- ENDIF
- 30 CONTINUE
- LSETOP=.FALSE.
- DO 40 K=1,IDEF
- IF(CHOPTN(NUMOPT).EQ.KFALSE(K))THEN
- I=K
- IF(I.EQ.1)LRESET=.TRUE.
- IF(I.EQ.13)THEN
- CALL IGZSET('X')
- LOZFL1 = .FALSE.
- ENDIF
- GOTO 80
- ENDIF
- 40 CONTINUE
- DO 50 K=1,IOTHER
- IF(CHOPTN(NUMOPT).EQ.KOTHER(K))THEN
- I=K
- IF(I.LE.7)LRESET=.TRUE.
- GOTO 60
- ENDIF
- 50 CONTINUE
- IF(I.EQ.0) GOTO 70
-*
- 60 CONTINUE
- IF(I.LE.7)THEN
-*
-* Decide here which metric paper sizes to allow
-*
- IVSIZE=I-1
- K=2*IVSIZE+1
- IF (LOVERT) THEN
- XSIZ=ASIZE(K)
- YSIZ=ASIZE(K+1)
- ELSE
- XSIZ=ASIZE(K+1)
- YSIZ=ASIZE(K)
- ENDIF
- GOTO 20
- ENDIF
-*
-* No page requested
-*
- IF(I.EQ.8)THEN
- IPGSIZ=0
- GOTO 20
- ENDIF
-*
-* System of coordinates : linear or logarithmic
-*
- IF(I.EQ.9)THEN
- LINX=1
- LOGX=0
- GOTO 20
- ELSEIF(I.EQ.10)THEN
- LINY=1
- LOGY=0
- GOTO 20
- ELSEIF(I.EQ.11)THEN
- LINX=0
- LOGX=1
- GOTO 20
- ELSEIF(I.EQ.12)THEN
- LINY=0
- LOGY=1
- GOTO 20
- ELSEIF(I.EQ.13)THEN
- LINZ=1
- LOGZ=0
- GOTO 20
- ELSEIF(I.EQ.14)THEN
- LINZ=0
- LOGZ=1
- GOTO 20
- ELSEIF(I.EQ.15)THEN
- LOZFL=.TRUE.
- LOZFL1=.TRUE.
- GOTO 20
- ELSEIF(I.EQ.16)THEN
- GOTO 130
- ENDIF
-*
-* Set default value
-*
- IF(I.EQ.17)THEN
- LRESET=.TRUE.
- LOVERT=.TRUE.
- LOEAH=.FALSE.
- LOCHA=.FALSE.
- LOASTK=.FALSE.
- LOSOFT=.TRUE.
- LOSQR=.FALSE.
- LOUTIT=.FALSE.
- LOTAB=.TRUE.
- LOBOX=.TRUE.
- LOHBOX=.TRUE.
- LOTIC=.FALSE.
- LOSTAT=.FALSE.
- LOFIT=.FALSE.
- LOZFL=.FALSE.
- LOZFL1=.FALSE.
- CALL IGZSET('X')
- LOPTO=.FALSE.
- LOBAR=.FALSE.
- LODVXI=.FALSE.
- LODVYI=.FALSE.
- LOGRID=.FALSE.
- LODATE=.FALSE.
- LOFILE=.FALSE.
- IVSIZE=4
- XSIZ=20.
- YSIZ=20.
- IPGSIZ=0
- LINX=1
- LINY=1
- LOGX=0
- LOGY=0
- LINZ=1
- LOGZ=0
- CALL HSTAF('NO')
- LOHSTA=.FALSE.
- GOTO 20
- ENDIF
-*
-* HSTA and HNST
-*
- IF(I.EQ.18)THEN
- CALL HSTAF('YES')
- LOHSTA=.TRUE.
- GOTO 20
- ENDIF
- IF(I.EQ.19)THEN
- CALL HSTAF('NO')
- LOHSTA=.FALSE.
- GOTO 20
- ENDIF
-*----
-* Check for valid page number
-*----
- 70 CONTINUE
- IF( (CHOPTN(NUMOPT).EQ.'*P ')
- +.OR. (CHOPTN(NUMOPT).EQ.'P '))THEN
- IPGSIZ=1
- GOTO 20
- ELSE IF(CHOPTN(NUMOPT).EQ.'**P ')THEN
- IPGSIZ=2
- GOTO 20
- ELSE IF(CHOPTN(NUMOPT).EQ.'***P')THEN
- IPGSIZ=3
- GOTO 20
- ELSE
- GOTO 110
- ENDIF
-*
- 80 CONTINUE
- LOPTN(I)=LSETOP
-*
-* Option VERT/HORI called
-*
- IF (I.EQ.1) THEN
- IF (LSETOP) THEN
-*
-* On impose XSIZ<=YSIZ
-*
- IF (XSIZ.GT.YSIZ) THEN
- XX=XSIZ
- XSIZ=YSIZ
- YSIZ=XX
- ENDIF
- ELSE
-*
-* On impose YSIZ<=XSIZ
-*
- IF (XSIZ.LT.YSIZ) THEN
- XX=XSIZ
- XSIZ=YSIZ
- YSIZ=XX
- ENDIF
- ENDIF
- GOTO 20
- ENDIF
-*
-* option SOFT/HARD called
-*
- IF (I.EQ.5) THEN
- IF (LSETOP) THEN
- DO 90 I=1,5
- IHFONT(I)=2
- 90 CONTINUE
- ELSE
- DO 100 I=1,5
- IHFONT(I)=10
- 100 CONTINUE
- ENDIF
- GOTO 20
- ENDIF
-*
- GOTO 20
-*
- 110 WRITE(LERR,10000) CHOPTN(NUMOPT)
- GOTO 20
-*
- 120 IF(IPLNUM.LT.0)RETURN
-*
-* Reset windowing if A3/A4 or HORI/VERT options called
-* or if OPT * (set all default value)
-*
- IF(.NOT.LRESET)RETURN
- CALL HPLZON(1,1,1,' ')
- IF(XSIZ.LE.YSIZ)THEN
- LOVERT=.TRUE.
- ELSE
- LOVERT=.FALSE.
- ENDIF
- CALL HPLSCM
- RETURN
-*
-* Show all the options which are set
-*
- 130 CONTINUE
- WRITE (LERR,10100)
- WRITE (LERR,10200)
- WRITE (LERR,10300)
- WRITE (LERR,10400)
- WRITE (LERR,10300)
- DO 140 I=1,IDEF
- IF(LOPTN(I))THEN
- WRITE (LERR,10500) KTRUE(I),KDEF(I),KNDEF(I) ,KEXP(2*I-1),
- + KEXP(2*I)
- ELSE
- WRITE (LERR,10500) KFALSE(I),KDEF(I),KNDEF(I) ,KEXP(2*I-1),
- + KEXP(2*I)
- ENDIF
- 140 CONTINUE
- WRITE (CHSIZ,10600) IVSIZE
- CHOPT='A'//CHSIZ
- WRITE (LERR,10500) CHOPT,KDEF1(1),KNDEF1(1),KEXP1(1),KEXP1(2)
- IF(IPGSIZ.EQ.0)THEN
- CHOPT='NOPG'
- ELSE
- CHOPT='P '
- ENDIF
- WRITE (LERR,10500) CHOPT,KDEF1(2),KNDEF1(2),KEXP1(3),KEXP1(4)
- IF(LOGY.EQ.1)THEN
- CHOPT='LOGY'
- ELSE
- CHOPT='LINY'
- ENDIF
- WRITE (LERR,10500) CHOPT,KDEF1(3),KNDEF1(3),KEXP1(5),KEXP1(6)
- IF(LOGX.EQ.1)THEN
- CHOPT='LOGX'
- ELSE
- CHOPT='LINX'
- ENDIF
- WRITE (LERR,10500) CHOPT,KDEF1(4),KNDEF1(4),KEXP1(7),KEXP1(8)
- IF(LOGZ.EQ.1)THEN
- CHOPT='LOGZ'
- ELSE
- CHOPT='LINZ'
- ENDIF
- WRITE (LERR,10500) CHOPT,KDEF1(5),KNDEF1(5),KEXP1(9),KEXP1(10)
- CHOPT='HNST'
- IF(LOHSTA)CHOPT='HSTA'
- WRITE (LERR,10500) CHOPT,KDEF1(6),KNDEF1(6),KEXP1(11),KEXP1(12)
- WRITE (LERR,10300)
- GOTO 20
-*
-10000 FORMAT(' ***** ERROR in HPLOPT : Unvailable option --> ',A4)
-10100 FORMAT(1X,'+',77(1H-),'+')
-10200 FORMAT(1X,'|',28X,'HPLOPT : Option values',27X,'|')
-10300 FORMAT(1X,'+',13(1H-),'+',13(1H-),'+',15(1H-),'+',33(1H-),'+')
-10400 FORMAT(1X,'| Current | Default | Alternative '
- +, '| Explanation |')
-10500 FORMAT(' |',5X,A4,4X,'|',5X,A4,4X,'|',6X,A4,5X,'|',A32,' |',/
- +,' |',13X,'|',13X,'|',15X,'|',A32,' |')
-10600 FORMAT (I1)
-*
- END
diff --git a/src/graflib/hplot/hplotf77/hplot.F b/src/graflib/hplot/hplotf77/hplot.F
deleted file mode 100644
index af17761..0000000
--- a/src/graflib/hplot/hplotf77/hplot.F
+++ /dev/null
@@ -1,394 +0,0 @@
-*
-* $Id: hplot.F,v 1.1.1.1 1996/01/19 10:50:10 mclareni Exp $
-*
-* $Log: hplot.F,v $
-* Revision 1.1.1.1 1996/01/19 10:50:10 mclareni
-* Hplot
-*
-*
-#include "hplot/pilot.h"
-*CMZ : 5.20/04 04/10/95 17.30.08 by O.Couet
-*-- Author :
- SUBROUTINE HPLOT(IDDD,CHOPT,KICASE,NUMM)
-*.==========>
-*.
-*. HPLOT basic routine
-*.
-*. Input parameter:
-*.
-*. IDDD : Histogram IDentifier.
-*.
-*. CHARACTER*(*) CHOPT :
-*.
-*. CHOPT = 'S' : (or 'SAME' for compatibilty) histogram is
-*. plotted in the same "ZONE" as the last one.
-*. CHOPT = 'K' : option "Keep" (keeping the histogram ZEBRA bank
-*. in memory for later update (option "U") of the
-*. same histogram or later addition
-*. (or contribution : option "+") of other
-*. histograms).
-*. CHOPT = 'U' : Update of the histogram (which must have been
-*. plot the first time with option "K" if
-*. windowing option is selected).
-*. CHOPT = '+' : Addition (or contribution) of histogram IDDD
-*. upon the last histogram plotted or the last
-*. created with option 'K' if windowing option is
-*. selected.
-*. CHOPT = '-' : Same as '+' but the contains of the histogram
-*. is substract.
-*. CHOPT = '+-' : Draw the for each bin delta between
-*. 2 histograms
-*. CHOPT = 'A' : If specified, axis are not drawn
-*. CHOPT = 'BOX' : Draw 2D plot with proportionnal Boxes
-*. CHOPT = 'ARR' : Draw 2D plot with Arrows
-*. CHOPT = 'COL' : Draw 2D plot with Colors
-*. CHOPT = 'LEGO' : Draw 2D plot as a Lego plot
-*. CHOPT = 'LEGO1' : Draw 2D plot as a Lego (mode 1 see IGTABL)
-*. CHOPT = 'LEGO2' : Draw 2D plot as a Lego (mode 2 see IGTABL)
-*. CHOPT = 'SURF' : Draw 2D plot as a Surface
-*. CHOPT = 'SURF1' : Draw 2D plot as a Surface (mode 1 see IGTABL)
-*. CHOPT = 'SURF2' : Draw 2D plot as a Surface (mode 2 see IGTABL)
-*. CHOPT = 'CONT' : Draw 2D plot as a Contour plot
-*. CHOPT = 'SCAT' : Draw 2D plot a Scatter plot
-*. CHOPT = 'TEXT' : Draw 2D plot with the contains of each cell
-*. CHOPT = 'CHAR' : Draw 2D plot with a character set
-*. CHOPT = 'ARR' : Draw 2D plot with arrows
-*. CHOPT = 'HIST' : Draw only the histogram
-*. CHOPT = 'FUNC' : Draw only the function
-*. (for example in case of fit)
-*. CHOPT = 'E' : Errors with current marker type and size
-*. are drawn.
-*. CHOPT = 'L', 'C', 'F', '*', 'M', 'B' or 'N' :
-*. (cf. HIGZ doc., routine IGHIST)
-*.
-*. CHARACTER*(*) KICASE:
-*.
-*. KICASE = 'SLIX' : gives slices in X
-*. KICASE = 'SLIY' : gives slices in Y
-*. KICASE = 'BANX' : gives bands in X
-*. KICASE = 'BANY' : gives bands in Y
-*. KICASE = 'PROX' : gives projection in X
-*. KICASE = 'PROY' : gives projection in Y
-*. KICASE = 'HIST' : gives the histogram (scatter plot) only.
-*.
-*. NUMM : refers to slices or banks (if NUM=n: nth slice
-*. or bank, if NUM=0: all slices or banks).
-*. Remarks :
-*. IDZB = current histogram (when calling HPLOT(ID,...))
-*. IDZK = last histogram created with option "K" (if windowing)
-*. or histogram just plotted before "+" (if no windowing).
-*..=========>
-#include "hbook/hcbits.inc"
-#include "hbook/hcbook.inc"
-#include "hbook/hcprin.inc"
-#include "hplot/hpl1.inc"
-#include "hplot/hpl13.inc"
-#include "hbook/hcflag.inc"
- CHARACTER*(*) CHOPT,KICASE
- CHARACTER*4 KICAS2
- CHARACTER*16 CHOPT2
- DIMENSION PAR(2)
-*._____________________________
-*
- IF(IPLNUM.LT.0)IPLNUM=0
-*----
-* set up defaults
-*----
- IDD = IDDD
- IDZB = IDD
- LHPLIP = 0
- NUM = 0
- IRET = 3
- KTYPE = 1
- LOSLIC = .FALSE.
- LOSAME = .FALSE.
- LOZERO = IDD.EQ.0
- LOCM = .FALSE.
- IERROR = 0
-*----
- NARG=4
- CALL NOARG(NARG)
- IF(NARG.GT.4) NARG=4
- GOTO (50,30,20,10),NARG
-*
- 10 NUM=NUMM
-*
- 20 CALL UCTOH(KICASE,ICASE,4,4)
- KTYPE=IUCOMP(ICASE,IDENT(1),8)
- IF(KTYPE.EQ.0)KTYPE=1
-*----
-* Decode CHOPT
-*----
- 30 CONTINUE
- CHOPT2=CHOPT
- IF(IDEF1D.GT.0.AND.CHOPT2.EQ.' ')THEN
- IF(IDEF1D.EQ.1)CHOPT2 = 'L'
- IF(IDEF1D.EQ.2)CHOPT2 = 'C'
- IF(IDEF1D.EQ.3)CHOPT2 = 'B'
- IF(IDEF1D.EQ.4)CHOPT2 = 'P'
- IF(IDEF1D.EQ.5)CHOPT2 = '*'
- IF(IDEF1D.EQ.6)CHOPT2 = 'E'
- ENDIF
- NCH=LENOCC(CHOPT2)
- IOPTH=1
- IOPT0=0
- IOPTF=1
- IF(NCH.GE.3)THEN
- IOP=INDEX(CHOPT2,'HIST')
- IF(IOP.GT.0)THEN
- CHOPT2(IOP:IOP+3)=' '
- IOPTF=0
- IOPTH=2
- ENDIF
- IOP=INDEX(CHOPT2,'FUNC')
- IF(IOP.GT.0)THEN
- CHOPT2(IOP:IOP+3)=' '
- IF(IOPTH.EQ.1)IOPTH=0
- IOPTF=2
- ENDIF
- IOP=INDEX(CHOPT2,'LEGO1')
- IF(IOP.GT.0)CHOPT2(IOP:IOP+4)=' '
- IOP=INDEX(CHOPT2,'LEGO2')
- IF(IOP.GT.0)CHOPT2(IOP:IOP+4)=' '
- IOP=INDEX(CHOPT2,'LEGO')
- IF(IOP.GT.0)CHOPT2(IOP:IOP+3)=' '
- IOP=INDEX(CHOPT2,'SURF1')
- IF(IOP.GT.0)CHOPT2(IOP:IOP+4)=' '
- IOP=INDEX(CHOPT2,'SURF2')
- IF(IOP.GT.0)CHOPT2(IOP:IOP+4)=' '
- IOP=INDEX(CHOPT2,'SURF')
- IF(IOP.GT.0)CHOPT2(IOP:IOP+3)=' '
- IOP=INDEX(CHOPT2,'BOX')
- IF(IOP.GT.0)CHOPT2(IOP:IOP+2)=' '
- IOP=INDEX(CHOPT2,'ARR')
- IF(IOP.GT.0)CHOPT2(IOP:IOP+2)=' '
- IOP=INDEX(CHOPT2,'COL')
- IF(IOP.GT.0)CHOPT2(IOP:IOP+2)=' '
- IOP=INDEX(CHOPT2,'CONT')
- IF(IOP.GT.0)CHOPT2(IOP:IOP+3)=' '
- IOP=INDEX(CHOPT2,'SCAT')
- IF(IOP.GT.0)CHOPT2(IOP:IOP+3)=' '
- IOP=INDEX(CHOPT2,'TEXT')
- IF(IOP.GT.0)CHOPT2(IOP:IOP+3)=' '
- IOP=INDEX(CHOPT2,'CHAR')
- IF(IOP.GT.0)CHOPT2(IOP:IOP+3)=' '
- IF(INDEX(CHOPT2,'0').NE.0)IOPT0=1
- ENDIF
- CALL UOPTC(CHOPT2,'SUK+EA',IOPT)
- IC=0
- DO 40 I=1,4
- IF(IOPT(I).NE.0)IC=IC+1
- 40 CONTINUE
- IF(IC.GT.1)THEN
- CALL HBUG(' Select only one option "SUK+" at a time'
- + ,'HPLOT',IDD)
- GOTO 999
- ENDIF
- IF(NCH.EQ.4)THEN
- IF(CHOPT2(1:4).EQ.'SAME')THEN
- IOPTA=0
- IOPTE=0
- ENDIF
- ENDIF
-*----
-* Option '+' '-' '+-'
-*----
- IF(INDEX(CHOPT2,'-').NE.0)THEN
- IF(IOPTP.NE.0)THEN
- IOPTP=2
- ELSE
- IOPTP=-1
- ENDIF
- ENDIF
-*
- CALL UOPTC(CHOPT2,'LC*PBH',IHOPT)
-*----
-* Option 'L','C','*' or 'M' are ignored for "live" histograms
-*----
- IF((IOPTU.NE.0).OR.(IOPTK.NE.0).OR.(IOPTP.NE.0))THEN
- IF(IHOPTL.NE.0)THEN
- CALL HBUG('"L" ignored for "live" Histo.','HPLOT',IDD)
- IF((IHOPTH.EQ.0).AND.(IHOPTB.EQ.0))GOTO 999
- ENDIF
- IF(IHOPTC.NE.0)THEN
- CALL HBUG('"C" ignored for "live" Histo.','HPLOT',IDD)
- IF((IHOPTH.EQ.0).AND.(IHOPTB.EQ.0))GOTO 999
- ENDIF
- IF(IHOPTT.NE.0)THEN
- CALL HBUG('"*" ignored for "live" Histo.','HPLOT',IDD)
- IF((IHOPTH.EQ.0).AND.(IHOPTB.EQ.0))GOTO 999
- ENDIF
- IF(IHOPTP.NE.0)THEN
- CALL HBUG('"P" ignored for "live" Histo.','HPLOT',IDD)
- IF((IHOPTH.EQ.0).AND.(IHOPTB.EQ.0))GOTO 999
- ENDIF
- ENDIF
-*
- IF(IOPTS.NE.0)LOSAME=.TRUE.
-*
- IF(LOWIND)THEN
- IF(IOPTK.NE.0)IDZK=IDD
- ELSE
- IF((IOPTP.EQ.0).AND.(IOPTU.EQ.0))IDZK=IDD
- ENDIF
-*----
-* option SAME with DMOD set to 0 (default value) :
-* automatic incrementation of line type.
-*----
- 50 CONTINUE
- IF(.NOT.LOSAME)ILTSAM=ILTYP
- IF((LOSAME).AND.LTYPFL)THEN
- IF(IHTYP.EQ.0)THEN
- ILTSAM=ILTSAM+1
- IF(ILTSAM.GT.5)ILTSAM=1
- ENDIF
- CALL ISLN(ILTSAM)
- ENDIF
-*
- 60 CALL HLOOP(IDD,'HPLOT ',IRET)
- IF(IRET.EQ.0) GOTO 120
- CALL HDCOFL
- IF(I123.EQ.0)GOTO 110
- LCONT=LQ(LCID-1)
-*
-* 1-DIM histogram
-*
- IF(KTYPE.LT.3.AND.I1.NE.0)THEN
- LPRX=LCID+KNCX
- NOENT=I9
- CALL HPLONE(CHOPT,IERROR)
- ENDIF
-*
-* 2-DIM histogram
-*
- IF(KTYPE.LT.3.AND.I1.EQ.0)THEN
- LCONT=LQ(LCID-1)
- LSCAT=LCONT
- IF(INDEX(CHOPT,'LEGO').NE.0.OR.INDEX(CHOPT,'SURF').NE.0)THEN
- NPAR=2
- PAR(1)=30.
- PAR(2)=30.
- ELSE
- NPAR=0
- ENDIF
- CALL HPLTAB(ID,NPAR,PAR,CHOPT)
- IF(IQ(LCONT+KNOENT).EQ.0)GOTO 110
- ENDIF
- IF(I230.EQ.0)GOTO 110
-*
-* Projection X
-*
- IF(KTYPE.EQ.3.OR.KTYPE.EQ.0)THEN
- LCONT=LQ(LCID-2)
- LPRX=LCID+KNCX
- IF(LCONT.NE.0)THEN
- NOENT=I9
- CALL HPLONE(CHOPT,IERROR)
- ENDIF
- ENDIF
-*
-* Projection Y
-*
- IF(KTYPE.EQ.4.OR.KTYPE.EQ.0)THEN
- LCONT=LQ(LCID-3)
- LPRX=LCID+KNCY
- IF(LCONT.NE.0)THEN
- NOENT=I10
- CALL HPLONE(CHOPT,IERROR)
- ENDIF
- ENDIF
-*
-* Slices X
-*
- IF(KTYPE.EQ.5.OR.KTYPE.EQ.0)THEN
- LSLIX=LQ(LCID-4)
- LPRX=LCID+KNCX
- IF(LSLIX.NE.0)THEN
- NOENT=I9
- IF(NUM.NE.999)THEN
- DO 70 I=1,IQ(LSLIX-2)
- IF(NUM.NE.0.AND.NUM.NE.I)GOTO 70
- LCONT=LQ(LSLIX-I)
- CALL HPLONE(CHOPT,IERROR)
- 70 CONTINUE
- ENDIF
- ENDIF
- ENDIF
-*
-* Slices Y
-*
- IF(KTYPE.EQ.6.OR.KTYPE.EQ.0)THEN
- LSLIY=LQ(LCID-5)
- LPRX=LCID+KNCY
- IF(LSLIY.NE.0)THEN
- NOENT=I10
- IF(NUM.NE.999)THEN
- DO 80 I=1,IQ(LSLIY-2)
- IF(NUM.NE.0.AND.NUM.NE.I)GOTO 80
- LCONT=LQ(LSLIY-I)
- CALL HPLONE(CHOPT,IERROR)
- 80 CONTINUE
- ENDIF
- ENDIF
- ENDIF
-*
-* Bande X
-*
- IF(KTYPE.EQ.7.OR.KTYPE.EQ.0)THEN
- LBANX=LQ(LCID-6)
- LPRX=LCID+KNCX
- IF(LBANX.NE.0)THEN
- NOENT=I9
- NBX=1
- 90 IF(NUM.EQ.0.OR.NUM.EQ.NBX)THEN
- LCONT=LQ(LBANX-1)
- CALL HPLONE(CHOPT,IERROR)
- ENDIF
- NBX=NBX+1
- LBANX=LQ(LBANX)
- IF(LBANX.NE.0)GOTO 90
- ENDIF
- ENDIF
-*
-* Bande Y
-*
- IF(KTYPE.EQ.8.OR.KTYPE.EQ.0)THEN
- LBANY=LQ(LCID-7)
- LPRX=LCID+KNCY
- IF(LBANY.NE.0)THEN
- NOENT=I10
- NBY=1
- 100 IF(NUM.EQ.0.OR.NUM.EQ.NBY)THEN
- LCONT=LQ(LBANY-1)
- CALL HPLONE(CHOPT,IERROR)
- ENDIF
- NBY=NBY+1
- LBANY=LQ(LBANY)
- IF(LBANY.NE.0)GOTO 100
- ENDIF
- ENDIF
-*
-* GOTO next histogram
-*
- 110 IRET=2
-* Case of error (ie LOG scale on Y=<0)
- IF(IERROR.NE.0)GOTO 60
-* With 2D histos STAT, FILE, DATE etc... are drawn in HPLTAB
- IF(KTYPE.LT.3.AND.I1.EQ.0)GOTO 60
-* Draw STAT, FILE, DATE etc...
- IF((LOTIC).AND.(.NOT.LOSAME))CALL HPLWIR(' ',BIGP,BIGP,'TICK')
- IF((LOSTAT).AND.(.NOT.LOSAME))THEN
- KICAS2=' '
- NUM2=0
- IF(NARG.GE.3)KICAS2=KICASE
- IF(NARG.GE.4)NUM2=NUMM
- CALL HPLSTA(ID,KICAS2,NUM2)
- ENDIF
- IF((I12.NE.0).AND.(LOFIT).AND.(.NOT.LOSAME))CALL HPLFIT
- CALL HPLFIL
- CALL HPLDAT
- GOTO 60
-*
- 120 CALL ISLN(ILTYP)
-*
- 999 END
diff --git a/src/graflib/hplot/hplotf77/hplpgn.F b/src/graflib/hplot/hplotf77/hplpgn.F
deleted file mode 100644
index 1f28e8d..0000000
--- a/src/graflib/hplot/hplotf77/hplpgn.F
+++ /dev/null
@@ -1,78 +0,0 @@
-*
-* $Id: hplpgn.F,v 1.1.1.1 1996/01/19 10:50:11 mclareni Exp $
-*
-* $Log: hplpgn.F,v $
-* Revision 1.1.1.1 1996/01/19 10:50:11 mclareni
-* Hplot
-*
-*
-#include "hplot/pilot.h"
-*CMZ : 5.18/07 14/01/94 15.33.32 by O.Couet
-*-- Author :
- SUBROUTINE HPLPGN
-*.==========>
-*. Draws page number
-*. (Cm are used for call to HPLTXT)
-*..=========>
-#include "hplot/hpl1.inc"
-#include "hplot/hpl4.inc"
- CHARACTER*8 CODED,CHPAGE
- LOGICAL LOLD
-*._____________________________
-*
- LOLD = LOSOFT
-*----
-* Draw page number in form '- 123 -'
-* according to the option set in HPLOPT
-* (*P, **P, ***P for 1, 2, or 3 digits).
-* Page number must be .LT. 1000
-*----
- IF(IOPAGE.GE.1000)THEN
- CALL HBUG('Page number must be .LT. 1000','HPLOPT',0)
- GOTO 30
- ELSE IF(IOPAGE.GE.100)THEN
- NDIGIT = 3
- ELSE IF(IOPAGE.GE.10)THEN
- NDIGIT = 2
- ELSE
- NDIGIT = 1
- ENDIF
- NDIGIT = MAX(NDIGIT,IPGSIZ)
- WRITE(CODED,'(2H(I,I1,1H.,I1,1H))')NDIGIT,NDIGIT
- CHPAGE = '- '
- WRITE(CHPAGE(3:),CODED)IOPAGE
- CHPAGE(LENOCC(CHPAGE)+1:) = ' -'
-*----
-* Set up parameters for HPLTXT
-*----
- KFLG = 2
- IF(.NOT.LOVERT) GOTO 10
- KORNT = 1
-*----
-* Define position for A4-vertical
-*----
- XK = 0.5*XSIZ
- YK = YSIZ
- YK = YK-YNPAGE
- GOTO 20
-*-----
-* Software characters should be used for horizontal plots
-* (metric paper sizes only)
-*-----
- 10 KORNT = 4
- LOSOFT = .TRUE.
- XK = XSIZ
- YK = 0.5*YSIZ
- XK = XK-0.5*XMRIT
-*----
-* Plot page number
-*----
- 20 CALL HPLTXT(XK,YK,CHPAGE,6,KORNT,KFLG)
-*-----
-* Increase page no.
-*-----
- IOPAGE = IOPAGE+1
-*
- 30 LOSOFT = LOLD
-*
- END
diff --git a/src/graflib/hplot/hplotf77/hplpro.F b/src/graflib/hplot/hplotf77/hplpro.F
deleted file mode 100644
index 8b92e3d..0000000
--- a/src/graflib/hplot/hplotf77/hplpro.F
+++ /dev/null
@@ -1,66 +0,0 @@
-*
-* $Id: hplpro.F,v 1.1.1.1 1996/01/19 10:50:11 mclareni Exp $
-*
-* $Log: hplpro.F,v $
-* Revision 1.1.1.1 1996/01/19 10:50:11 mclareni
-* Hplot
-*
-*
-#include "hplot/pilot.h"
-*CMZ : 5.04/12 16/01/89 12.08.22 by O.Couet
-*-- Author :
- SUBROUTINE HPLPRO(ID,CHXTIT,CHYTIT)
-*.==========>
-*. Plots scatter plots with associated X and Y projection
-*. on a 2*2 grid
-*..=========>
-#include "hplot/hpl1.inc"
- CHARACTER*(*) CHXTIT,CHYTIT
- LOGICAL LOLD
-*._____________________________
-*
- NARG=3
- CALL NOARG(NARG)
- LOLD=LOUTIT
-*----
-* Plot Y projection in top LH corner,
-* rotated and reversed
-*----
- CALL HPLZON(2,2,1,' ')
- IF(NARG.GE.3)THEN
- IF(CHYTIT.NE.' ')THEN
- LOUTIT=.TRUE.
- CALL HPLOT(ID,' ','PROY',0)
- CALL HPLTIT(CHYTIT)
- LOUTIT=LOLD
- GOTO 10
- ENDIF
- ENDIF
- CALL HPLOT(ID,' ','PROY',0)
-*----
-* Plot X projection in bottom RH corner
-* reset rotation and reverse options
-*----
- 10 CALL HPLZON(2,2,4,'SAME')
- IF(NARG.NE.1)THEN
- IF(CHXTIT.NE.' ')THEN
- LOUTIT=.TRUE.
- CALL HPLOT(ID,' ','PROX',0)
- CALL HPLTIT(CHXTIT)
- LOUTIT=LOLD
- GOTO 20
- ENDIF
- ENDIF
- CALL HPLOT(ID,' ','PROX',0)
-*----
-* Plot scatter plot in top right hand corner
-*----
- 20 CALL HPLZON(2,2,2,'S')
- CALL HPLOT(ID,' ','HIST',0)
-*----
-* Reset window option
-*----
- CALL HPLZON(1,1,1,' ')
-*
- END
-
diff --git a/src/graflib/hplot/hplotf77/hplpto.F b/src/graflib/hplot/hplotf77/hplpto.F
deleted file mode 100644
index 9bd16f5..0000000
--- a/src/graflib/hplot/hplotf77/hplpto.F
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: hplpto.F,v 1.2 2001/12/07 15:19:56 couet Exp $
-*
-* $Log: hplpto.F,v $
-* Revision 1.2 2001/12/07 15:19:56 couet
-* - use higz include files from the higz include file directory.
-* option Z is now working in hplaer.F
-* option Z has been implemented in hplsym.F
-*
-* Revision 1.1.1.1 1996/01/19 10:50:11 mclareni
-* Hplot
-*
-*
-#include "hplot/pilot.h"
-*CMZ : 5.12/00 26/02/92 16.46.39 by O.Couet
-*-- Author :
- SUBROUTINE HPLPTO(TEXTIN,TEXTUT)
-*.==========>
-*. Request string (eg. <CR>)
-*. Subroutine to allow users to pause with a prompt and
-* receive a reply in interactive systems.
-*..=========>
-#include "higz/himeta.inc"
- CHARACTER*(*) TEXTIN,TEXTUT
-*._____________________________
-*
- IF(.NOT.TEKACT)RETURN
- IWKID=1
- ISTDNR=1
- TEXTUT=' '
- CALL IRQST(IWKID,ISTDNR,ISTAT,NCH,TEXTUT)
- END
-
diff --git a/src/graflib/hplot/hplotf77/hplqop.F b/src/graflib/hplot/hplotf77/hplqop.F
deleted file mode 100644
index 4b1c1d4..0000000
--- a/src/graflib/hplot/hplotf77/hplqop.F
+++ /dev/null
@@ -1,268 +0,0 @@
-*
-* $Id: hplqop.F,v 1.1.1.1 1996/01/19 10:50:11 mclareni Exp $
-*
-* $Log: hplqop.F,v $
-* Revision 1.1.1.1 1996/01/19 10:50:11 mclareni
-* Hplot
-*
-*
-#include "hplot/pilot.h"
-*CMZ : 5.20/05 27/10/95 11.40.19 by O.Couet
-*-- Author : O.Couet 25/10/95
- SUBROUTINE HPLQOP(CHOPT,R)
-*
-* Routine used by the PAW function $OPTION
-*
-#include "hplot/hpl1.inc"
-#include "hplot/hpl3.inc"
-#include "hbook/hcopt.inc"
- CHARACTER*(*) CHOPT
-*
- R = 0.
-*
- IF (INDEX(CHOPT(1:4),'LINX').NE.0) THEN
- IF (LOGX.EQ.0) R=1.
- RETURN
- ENDIF
- IF (INDEX(CHOPT(1:4),'LINY').NE.0) THEN
- IF (LOGY.EQ.0) R=1.
- RETURN
- ENDIF
- IF (INDEX(CHOPT(1:4),'LINZ').NE.0) THEN
- IF (LOGZ.EQ.0) R=1.
- RETURN
- ENDIF
- IF (INDEX(CHOPT(1:4),'LOGX').NE.0) THEN
- IF (LOGX.EQ.1) R=1.
- RETURN
- ENDIF
- IF (INDEX(CHOPT(1:4),'LOGY').NE.0) THEN
- IF (LOGY.EQ.1) R=1.
- RETURN
- ENDIF
- IF (INDEX(CHOPT(1:4),'LOGZ').NE.0) THEN
- IF (LOGZ.EQ.1) R=1.
- RETURN
- ENDIF
- IF (INDEX(CHOPT(1:4),'ZFL1').NE.0) THEN
- IF (LOZFL1) R=1.
- RETURN
- ENDIF
- IF (INDEX(CHOPT(1:3),'ZFL').NE.0) THEN
- IF (LOZFL) R=1.
- RETURN
- ENDIF
- IF (INDEX(CHOPT(1:4),'NZFL').NE.0) THEN
- IF (.NOT.LOZFL1.AND..NOT.LOZFL) R=1.
- RETURN
- ENDIF
- IF (INDEX(CHOPT(1:4),'HSTA').NE.0) THEN
- IF (ISTAF.EQ.1) R=1.
- RETURN
- ENDIF
- IF (INDEX(CHOPT(1:4),'HNST').NE.0) THEN
- IF (ISTAF.EQ.0) R=1.
- RETURN
- ENDIF
- IF (INDEX(CHOPT(1:4),'VERT').NE.0) THEN
- IF (LOVERT) R=1.
- RETURN
- ENDIF
- IF (INDEX(CHOPT(1:4),'HORI').NE.0) THEN
- IF (.NOT.LOVERT) R=1.
- RETURN
- ENDIF
- IF (INDEX(CHOPT(1:3),'EAH').NE.0) THEN
- IF (LOEAH) R=1.
- RETURN
- ENDIF
- IF (INDEX(CHOPT(1:4),'NEAH').NE.0) THEN
- IF (.NOT.LOEAH) R=1.
- RETURN
- ENDIF
- IF (INDEX(CHOPT(1:3),'CHA').NE.0) THEN
- IF (LOCHA) R=1.
- RETURN
- ENDIF
- IF (INDEX(CHOPT(1:4),'NCHA').NE.0) THEN
- IF (.NOT.LOCHA) R=1.
- RETURN
- ENDIF
- IF (INDEX(CHOPT(1:3),'AST').NE.0) THEN
- IF (LOASTK) R=1.
- RETURN
- ENDIF
- IF (INDEX(CHOPT(1:4),'NAST').NE.0) THEN
- IF (.NOT.LOASTK) R=1.
- RETURN
- ENDIF
- IF (INDEX(CHOPT(1:4),'SOFT').NE.0) THEN
- IF (LOSOFT) R=1.
- RETURN
- ENDIF
- IF (INDEX(CHOPT(1:4),'HARD').NE.0) THEN
- IF (.NOT.LOSOFT) R=1.
- RETURN
- ENDIF
- IF (INDEX(CHOPT(1:3),'SQR').NE.0) THEN
- IF (LOSQR) R=1.
- RETURN
- ENDIF
- IF (INDEX(CHOPT(1:4),'NSQR').NE.0) THEN
- IF (.NOT.LOSQR) R=1.
- RETURN
- ENDIF
- IF (INDEX(CHOPT(1:4),'UTIT').NE.0) THEN
- IF (LOUTIT) R=1.
- RETURN
- ENDIF
- IF (INDEX(CHOPT(1:4),'HTIT').NE.0) THEN
- IF (.NOT.LOUTIT) R=1.
- RETURN
- ENDIF
- IF (INDEX(CHOPT(1:3),'TAB').NE.0) THEN
- IF (LOTAB) R=1.
- RETURN
- ENDIF
- IF (INDEX(CHOPT(1:4),'NTAB').NE.0) THEN
- IF (.NOT.LOTAB) R=1.
- RETURN
- ENDIF
- IF (INDEX(CHOPT(1:3),'BOX').NE.0) THEN
- IF (LOBOX) R=1.
- RETURN
- ENDIF
- IF (INDEX(CHOPT(1:4),'NBOX').NE.0) THEN
- IF (.NOT.LOBOX) R=1.
- RETURN
- ENDIF
- IF (INDEX(CHOPT(1:3),'TIC').NE.0) THEN
- IF (LOTIC) R=1.
- RETURN
- ENDIF
- IF (INDEX(CHOPT(1:4),'NTIC').NE.0) THEN
- IF (.NOT.LOTIC) R=1.
- RETURN
- ENDIF
- IF (INDEX(CHOPT(1:3),'STA').NE.0) THEN
- IF (LOSTAT) R=1.
- RETURN
- ENDIF
- IF (INDEX(CHOPT(1:4),'NSTA').NE.0) THEN
- IF (.NOT.LOSTAT) R=1.
- RETURN
- ENDIF
- IF (INDEX(CHOPT(1:3),'FIT').NE.0) THEN
- IF (LOFIT) R=1.
- RETURN
- ENDIF
- IF (INDEX(CHOPT(1:4),'NFIT').NE.0) THEN
- IF (.NOT.LOFIT) R=1.
- RETURN
- ENDIF
- IF (INDEX(CHOPT(1:3),'PTO').NE.0) THEN
- IF (LOPTO) R=1.
- RETURN
- ENDIF
- IF (INDEX(CHOPT(1:4),'NPTO').NE.0) THEN
- IF (.NOT.LOPTO) R=1.
- RETURN
- ENDIF
- IF (INDEX(CHOPT(1:3),'BAR').NE.0) THEN
- IF (LOBAR) R=1.
- RETURN
- ENDIF
- IF (INDEX(CHOPT(1:4),'NBAR').NE.0) THEN
- IF (.NOT.LOBAR) R=1.
- RETURN
- ENDIF
- IF (INDEX(CHOPT(1:4),'DVXI').NE.0) THEN
- IF (LODVXI) R=1.
- RETURN
- ENDIF
- IF (INDEX(CHOPT(1:4),'DVXR').NE.0) THEN
- IF (.NOT.LODVXI) R=1.
- RETURN
- ENDIF
- IF (INDEX(CHOPT(1:4),'DVYI').NE.0) THEN
- IF (LODVYI) R=1.
- RETURN
- ENDIF
- IF (INDEX(CHOPT(1:4),'DVYR').NE.0) THEN
- IF (.NOT.LODVYI) R=1.
- RETURN
- ENDIF
- IF (INDEX(CHOPT(1:4),'GRID').NE.0) THEN
- IF (LOGRID) R=1.
- RETURN
- ENDIF
- IF (INDEX(CHOPT(1:4),'NGRI').NE.0) THEN
- IF (.NOT.LOGRID) R=1.
- RETURN
- ENDIF
- IF (INDEX(CHOPT(1:4),'DATE').NE.0) THEN
- IF (LODATE) R=1.
- RETURN
- ENDIF
- IF (INDEX(CHOPT(1:4),'NDAT').NE.0) THEN
- IF (.NOT.LODATE) R=1.
- RETURN
- ENDIF
- IF (INDEX(CHOPT(1:4),'FILE').NE.0) THEN
- IF (LOFILE) R=1.
- RETURN
- ENDIF
- IF (INDEX(CHOPT(1:4),'NFIL').NE.0) THEN
- IF (.NOT.LOFILE) R=1.
- RETURN
- ENDIF
- IF (INDEX(CHOPT(1:2),'A0').NE.0) THEN
- IF (IVSIZE.EQ.0) R=1.
- RETURN
- ENDIF
- IF (INDEX(CHOPT(1:2),'A1').NE.0) THEN
- IF (IVSIZE.EQ.1) R=1.
- RETURN
- ENDIF
- IF (INDEX(CHOPT(1:2),'A2').NE.0) THEN
- IF (IVSIZE.EQ.2) R=1.
- RETURN
- ENDIF
- IF (INDEX(CHOPT(1:2),'A3').NE.0) THEN
- IF (IVSIZE.EQ.3) R=1.
- RETURN
- ENDIF
- IF (INDEX(CHOPT(1:2),'A4').NE.0) THEN
- IF (IVSIZE.EQ.4) R=1.
- RETURN
- ENDIF
- IF (INDEX(CHOPT(1:2),'A5').NE.0) THEN
- IF (IVSIZE.EQ.5) R=1.
- RETURN
- ENDIF
- IF (INDEX(CHOPT(1:2),'A6').NE.0) THEN
- IF (IVSIZE.EQ.6) R=1.
- RETURN
- ENDIF
- IF (INDEX(CHOPT(1:1),'P').NE.0) THEN
- IF (IPGSIZ.EQ.1) R=1.
- RETURN
- ENDIF
- IF (INDEX(CHOPT(1:2),'*P').NE.0) THEN
- IF (IPGSIZ.EQ.1) R=1.
- RETURN
- ENDIF
- IF (INDEX(CHOPT(1:3),'**P').NE.0) THEN
- IF (IPGSIZ.EQ.2) R=1.
- RETURN
- ENDIF
- IF (INDEX(CHOPT(1:4),'***P').NE.0) THEN
- IF (IPGSIZ.EQ.3) R=1.
- RETURN
- ENDIF
- IF (INDEX(CHOPT(1:4),'NOPG').NE.0) THEN
- IF (IPGSIZ.EQ.0) R=1.
- RETURN
- ENDIF
-*
- END
diff --git a/src/graflib/hplot/hplotf77/hplqse.F b/src/graflib/hplot/hplotf77/hplqse.F
deleted file mode 100644
index 6c78a66..0000000
--- a/src/graflib/hplot/hplotf77/hplqse.F
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: hplqse.F,v 1.1.1.1 1996/01/19 10:50:11 mclareni Exp $
-*
-* $Log: hplqse.F,v $
-* Revision 1.1.1.1 1996/01/19 10:50:11 mclareni
-* Hplot
-*
-*
-#include "hplot/pilot.h"
-*CMZ : 5.20/06 31/10/95 11.19.41 by O.Couet
-*-- Author : O.Couet 31/10/95
- SUBROUTINE HPLQSE(CHOPT,R)
-*
-* Routine used by the PAW function $GRAFINFO
-*
- CHARACTER*(*) CHOPT
- CHARACTER*8 CHOPTN
-*
- IF (CHOPT(1:1).EQ.'?') THEN
- CALL HPLSET (CHOPT,R)
- ELSE
- CHOPTN(1:1) = '?'
- CHOPTN(2:5) = CHOPT
- CALL HPLSET (CHOPTN(1:5),R)
- ENDIF
-*
- END
diff --git a/src/graflib/hplot/hplotf77/hplrdw.F b/src/graflib/hplot/hplotf77/hplrdw.F
deleted file mode 100644
index 33f79dd..0000000
--- a/src/graflib/hplot/hplotf77/hplrdw.F
+++ /dev/null
@@ -1,92 +0,0 @@
-*
-* $Id: hplrdw.F,v 1.1.1.1 1996/01/19 10:50:11 mclareni Exp $
-*
-* $Log: hplrdw.F,v $
-* Revision 1.1.1.1 1996/01/19 10:50:11 mclareni
-* Hplot
-*
-*
-#include "hplot/pilot.h"
-*CMZ : 5.20/00 13/04/95 11.13.43 by O.Couet
-*-- Author :
- SUBROUTINE HPLRDW(NT,LPT,XAX,YAX)
-*.==========>
-*. Redraw histogram and axis in the same zone than the previous
-*. one, in case scale has changed for option "Update".
-*. parameter:
-*. NT= number of transformation
-*. LPT= pointer in ZEBRA structure.
-*..=========>
-#include "hplot/hpl1.inc"
-#include "hplot/hpl2.inc"
-#include "hbook/hcbook.inc"
-#include "hplot/quest.inc"
- LOGICAL LBAR
- CHARACTER*8 CHOPTG
- DIMENSION XAX(3),YAX(3)
-*._____________________________
-*
- CALL IGQ('LWID',RLWID)
- CALL IGQ('FAIS',RFAIS)
- CALL IGQ('FASI',RFASI)
- CALL IGQ('FACI',RFACI)
- CALL IGQ('PLCI',RPLCI)
- CALL IGQ('BORD',RBORD)
-*----
-* Select the right transformation (histogram transformation)
-*----
- CALL ISELNT(NT)
- NTWIN=NT
- NTHIST=NTWIN
-*----
-* Redraw histogram
-*----
- IF(LOZFL)THEN
- NWNEED=2*IQ(LPT+6)+100
- CALL MZNEED(IXHIGZ,NWNEED,'G')
- IF(IQUEST(11).LT.0)THEN
- CALL HBUG('No space to store the picture','HPLRDW',0)
- LOZFL=.FALSE.
- CALL IGZSET('G')
- ENDIF
- ENDIF
- LIY=LPT+19
- LIX=LIY+IQ(LPT+6)
-*
- IHTOLD=IHTYP
-*
- LBAR=.FALSE.
- CALL UHTOC(IQ(LPT+9),4,CHOPTG,4)
- CALL UOPTC(CHOPTG,'B',IOPTG)
- IF(IOPTG.NE.0)LBAR=.TRUE.
- IF(LBAR)THEN
- RBARO=Q(LPT+10)
- RBARW=Q(LPT+11)
- CALL IGSET('BARO',RBARO)
- CALL IGSET('BARW',RBARW)
- ENDIF
- IF((LBAR).AND.(IHTYP.EQ.0))IHTYP=1000
-*
- CALL HPLATT(1)
-*
- NB = IQ(LPT+6)
- IQUEST(81) = LIX+1
- IQUEST(82) = LIY+1
- CHOPTG(8:8) = 'Z'
- CALL IGHIST(NB,Q(LIX+1),Q(LIY+1),CHOPTG)
-*----
-* Draw axes
-*----
- CALL HPLAXI(XAX,YAX,1)
-*
- IHTYP=IHTOLD
- CALL IGSET('BARO',ROFFS)
- CALL IGSET('BARW',RWDTH)
- CALL IGSET('LWID',RLWID)
- CALL IGSET('FAIS',RFAIS)
- CALL IGSET('FASI',RFASI)
- CALL IGSET('FACI',RFACI)
- CALL IGSET('PLCI',RPLCI)
- CALL IGSET('BORD',RBORD)
-*
- END
diff --git a/src/graflib/hplot/hplotf77/hplscm.F b/src/graflib/hplot/hplotf77/hplscm.F
deleted file mode 100644
index 73e9652..0000000
--- a/src/graflib/hplot/hplotf77/hplscm.F
+++ /dev/null
@@ -1,30 +0,0 @@
-*
-* $Id: hplscm.F,v 1.1.1.1 1996/01/19 10:50:11 mclareni Exp $
-*
-* $Log: hplscm.F,v $
-* Revision 1.1.1.1 1996/01/19 10:50:11 mclareni
-* Hplot
-*
-*
-#include "hplot/pilot.h"
-*CMZ : 5.04/12 16/01/89 12.08.22 by O.Couet
-*-- Author :
- SUBROUTINE HPLSCM
-*.==========>
-*. sets and selects transformation no 1 , which allows to
-*. use centimeters , according to XSIZ/YSIZ
-*. and the option VERT/HORI .
-*.=========>
-#include "hplot/quest.inc"
-#include "hplot/hpl2.inc"
-#include "hplot/hpl4.inc"
-*._____________________________
-*
- CALL IGRNG(XSIZ,YSIZ)
- NTWIN=1
- XYTWN=RQUEST(11)
- DXWN =RQUEST(12)
- DYWN =RQUEST(13)
-*
- END
-
diff --git a/src/graflib/hplot/hplotf77/hplsel.F b/src/graflib/hplot/hplotf77/hplsel.F
deleted file mode 100644
index 91b225c..0000000
--- a/src/graflib/hplot/hplotf77/hplsel.F
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: hplsel.F,v 1.1.1.1 1996/01/19 10:50:11 mclareni Exp $
-*
-* $Log: hplsel.F,v $
-* Revision 1.1.1.1 1996/01/19 10:50:11 mclareni
-* Hplot
-*
-*
-#include "hplot/pilot.h"
-*CMZ : 5.17/07 27/09/93 10.49.15 by O.Couet
-*-- Author : O.Couet 27/09/93
- SUBROUTINE HPLSEL(NT)
-*.==========>
-*. Set the current normalization transformation NT for HIGZ and HPLOT
-*..=========>
-#include "hplot/hpl2.inc"
- CALL ISELNT(NT)
- NTWIN=NT
- END
diff --git a/src/graflib/hplot/hplotf77/hplset.F b/src/graflib/hplot/hplotf77/hplset.F
deleted file mode 100644
index ed506af..0000000
--- a/src/graflib/hplot/hplotf77/hplset.F
+++ /dev/null
@@ -1,918 +0,0 @@
-*
-* $Id: hplset.F,v 1.6 2002/04/04 10:24:34 couet Exp $
-*
-* $Log: hplset.F,v $
-* Revision 1.6 2002/04/04 10:24:34 couet
-* - Use IGCOL1 to set the number of axis division for the axis colour palette.
-*
-* Revision 1.5 2001/03/06 10:32:57 couet
-* The previous fix (Some rounding problem on IEEE machines) introduced problems
-* in case of negative division number. This is now fixed.
-*
-* Revision 1.4 2000/09/06 09:44:55 couet
-* Some rounding problem on IEEE machines. The following small macro is enough
-* to demonstrate it:
-*
-* label 2 5 a b c d e
-* set ndvx 10.20
-* nul 0 1
-*
-* On RS6000, Linux and Windows the labels are not visible.
-* On these machine 10.20 becomes 10.1999999 and the label list used is 1
-* instead of 2. To fix that 0.001 is now added to the number of divisions.
-*
-* Revision 1.3 1998/12/07 13:47:04 couet
-* - set 2siz is available again. It define the size of the charecters when
-* 2D histos are plotted with options TEXT of CHAR. The size is defined in
-* percent of the bin heigh.
-*
-* Revision 1.2 1998/12/02 15:05:39 couet
-* - 2SIZ not used anymore
-*
-* Revision 1.1.1.1 1996/01/19 10:50:11 mclareni
-* Hplot
-*
-*
-#include "hplot/pilot.h"
-*CMZ : 09/11/95 17.46.23 by O.Couet
-*-- Author :
- SUBROUTINE HPLSET(CASE,ARG)
-*.==========>
-*. subroutine to allow the user to define values for
-*. variables within HPLOT
-*..=========>
-#include "hplot/quest.inc"
-#include "hplot/hpl1.inc"
-#include "hplot/hpl2.inc"
-#include "hplot/hpl4.inc"
-#include "hplot/hpl6.inc"
-#include "hplot/hpl9.inc"
-#include "hbook/hcunit.inc"
-*
- PARAMETER (NCASE=74, NCASE1=72)
-*
- DIMENSION PL4(18),DEFVAL(NCASE1)
- EQUIVALENCE (PL4(1),XSIZ)
- CHARACTER*4 KKASE(NCASE)
- DIMENSION XSHOW(44)
- CHARACTER*32 CHEXP1(28),CHEXP2(44)
- CHARACTER*(*) CASE
-*
- DATA DEFVAL/20.,20.,2.0,2.0,1.4,0.4,0.3,
- + 2.0,2.0,0.8,0.2,0.3,0.6,1.5,1.2,0.,0.,0.3,0.2,
- + 0.28,0.28,0.28,0.28,0.28,0.28,0.28,0.28,0.28,
- + 2.0,2.0,0.9,1.,0.03,0.25,0.5,
- + 0.15,1.,3.,1.,2.,1.,1111.,101.,
- + 0.,0.,0.,0.,
- + 1.,1.,1.,1.,1.,1.,
- + 1.,1.,1.,1.,1.,1.,0.5,
- + 2.,2.,2.,2.,2.,
- + 10510.00,10510.00,10510.00,1.,0.5,0.,0./
-*
- DATA KKASE/'XSIZ','YSIZ','XMGL','XMGR','XLAB','XVAL','XTIC'
- +, 'YMGL','YMGU','YLAB','YVAL','YTIC','YNPG','YGTI'
- +, 'YHTI','SMGR','SMGU','CMMG','CVAL'
- +, 'KSIZ','GSIZ','TSIZ','ASIZ','CSIZ','PSIZ','VSIZ'
- +, 'SSIZ','2SIZ'
- +, 'XWIN','YWIN','HMAX','PASS','CSHI','BARO','BARW'
- +, 'DASH','DMOD','GRID','CMAP','DATE','FILE','STAT','FIT '
- +, 'HTYP','BTYP','PTYP','FTYP'
- +, 'HCOL','BCOL','PCOL','FCOL','XCOL','YCOL'
- +, 'HWID','BWID','PWID','FWID','XWID','YWID','CWID'
- +, 'TFON','GFON','VFON','LFON','CFON'
- +, 'NDVX','NDVY','NDVZ','FPGN','ERRX'
- +, '1DEF','2DEF','SHOW','0 '/
-*
-* Explanations when SET SHOW is requested :
-* XSIZ, YSIZ, XMGL, XMGR, XLAB, XVAL, XTIC, YMGL,
-* YMGU, YLAB, YVAL, YTIC, YNPG, YGTI, YHTI, SMGR, SMGU, CMMG, CVAL,
-* KSIZ, GSIZ, TSIZ, ASIZ, CSIZ, PSIZ, VSIZ, SSIZ, 2SIZ
-*
- DATA CHEXP1/' Size along X ',' Size along Y ',' X MarGin Lef
- +t',' X MarGin Right',' distance y axis to LABel',' distance y axis
- + to axis VALues',' X axis TICk marks length',' Y MarGin Low',' Y M
- +arGin Up',' distance x axis to LABel',' distance x axis to axis VA
- +Lues',' Y axis TICk marks length',' Y position for Number of PaGe'
- +,' Y position of Global TItle',' Y position of Histogram TItle','
- +Stat MarGin Right (%)',' Stat MarGin Up (%)',' ColorMap MarGin','
- +distance Color map axis VALues',' Hershey charact. (HPLKEY) SIZe+'
- +,' Global title SIZe',' histogram Title SIZe',' Axis label SIZe','
- + Comment and stat SIZe',' Page number SIZe',' axis Values SIZe','
- +aSterisk SIZe (for functions)',' scatter-plot & table-char. SIZe'/
-*
-* Explanations when SET SHOW is requested :
-* XWIN, YWIN, PASS, HMAX, CSHI
-* BARO, BARW, DASH, DMOD, GRID, DATE, FILE, STAT, FIT
-* HTYP, BTYP, PTYP, FTYP
-* HCOL, BCOL, PCOL, FCOL
-* HWID, BWID, PWID, FWID, XWID, YWID, CWID
-* TFON, GFON, VFON, LFON, NDVX, NDVY, NDVZ
-* FPGN, ERRX, 1DEF, 2DEF
-*
- DATA CHEXP2/' X space between WINdows',' Y space between WINdows',
- +' Histogram MAXimum for scale',' number of PASS for characters','
- +Character SHIft between 2 pass',' BAR histogram Offset (%)',' BAR
- +histogram Width (%)',' length of basic DASHed segment',' Dash MODe
- + (or type) for lines',' GRID line type',' Color MAP position',' DA
- +TE position',' FILE name position',' STAT values to be plotted','
- +FIT values to be plotted',' Histogram fill area TYPe',' Box fill
- +area TYPe',' Picture fill area TYPe',' Function fill area TYPe','
- +Histogram fill area COLor',' Box fill area and shading COLor',' Pi
- +cture fill area COLor',' Function fill area COLor',' X axis COLor'
- +,' Y axis COLor',' Histogram line WIDth',' Box line WIDth',' Pictu
- +re line WIDth',' Function line WIDth',' X ticks WIDth',' Y ticks W
- +IDth',' Color map WIDth',' Text (and Title) FONT and PREC',' Globa
- +l title FONT and PREC',' axis Values FONT and PREC',' axis Labels
- +FONT and PREC',' Comment FONT and PREC',' Number of DIVisions for
- +X axis',' Number of DIVisions for Y axis',' Number of DIVisions fo
- +r Z axis',' First PaGe Number',' ERRor on X (% of bin width)',' 1D
- +Plot Option',' 2D Plot Option'/
-*._____________________________
-*
- IF(CASE.EQ.'*')GO TO 100
-*
- IQCASE=0
- IF(CASE(1:1).EQ.'?') THEN
- DO 3 I=1,NCASE
- IF(CASE(2:LENOCC(CASE)).EQ.KKASE(I))THEN
- IQCASE=I
- GOTO 125
- ENDIF
- 3 CONTINUE
- CALL IGQ(CASE(2:5),ARG)
- GOTO 999
- ENDIF
-*
- DO 5 I=1,NCASE
- IF(CASE.EQ.KKASE(I))THEN
- K=I
- GO TO 6
- ENDIF
- 5 CONTINUE
- K=0
-*
- 6 VAL1=FLOARG(ARG)
-*
- IF(CASE.EQ.'*WID')THEN
- IF(VAL1.NE.0.)THEN
- IHWID=INT(VAL1)
- ELSE
- IHWID=1
- ENDIF
- IBWID=IHWID
- IPWID=IHWID
- IFWID=IHWID
- IXWID=IHWID
- IYWID=IHWID
- GOTO 999
- ENDIF
- IF(CASE.EQ.'*FON')THEN
- IF(VAL1.NE.0.)THEN
- IHFONT(1)=INT(VAL1)
- ELSE
- IHFONT(1)=2
- ENDIF
- DO 7 I=2,5
- IHFONT(I)=IHFONT(1)
- 7 CONTINUE
- GOTO 999
- ENDIF
- IF(CASE.EQ.'*SIZ')THEN
- IF(VAL1.NE.0.)THEN
- TVSIZ(1)=VAL1
- ELSE
- TVSIZ(1)=0.28
- ENDIF
- DO 8 I=2,9
- TVSIZ(I)=TVSIZ(1)
- 8 CONTINUE
- GOTO 999
- ENDIF
- IF(CASE.EQ.'*TYP')THEN
- IHTYP=INT(VAL1)
- IBTYP=IHTYP
- IPTYP=IHTYP
- IFTYP=IHTYP
- GOTO 999
- ENDIF
- IF(CASE.EQ.'*COL')THEN
- IF(VAL1.NE.0.)THEN
- RHCOL=VAL1
- ELSE
- RHCOL=1.
- ENDIF
- IHCOL=INT(RHCOL)
- IF(IHCOL.GT.1000)THEN
- IHBCOL = MOD(IHCOL,1000)/100
- IHCOL = MOD(IHCOL,100)
- IHTYP = 2001
- ELSE
- IHBCOL = 0
- IHTYP = 1000
- ENDIF
- RBCOL = RHCOL
- IBCOL = IHCOL
- IBBCOL = IHBCOL
- IBTYP = IHTYP
- IPCOL = IHCOL
- IPBCOL = IHBCOL
- IPTYP = IHTYP
- IFCOL = IHCOL
- IFBCOL = IHBCOL
- IFTYP = IHTYP
- IXCOL = IHCOL
- IYCOL = IHCOL
- GOTO 999
- ENDIF
-*
- IF(K.EQ.NCASE)GOTO 100
- IF(K.EQ.0)THEN
- CALL IGSET(CASE,ARG)
- GOTO 999
- ENDIF
-*
-* Margins and tick marks size (1 <= K <= 19)
-*
- IF (K.LE.19) THEN
- XSZOLD = PL4(1)
- YSZOLD = PL4(2)
- IF (VAL1.NE.0.) THEN
- PL4(K) = VAL1
- ELSE
- PL4(K) = DEFVAL(K)
- ENDIF
- IF (K.EQ.1.OR.K.EQ.2) GOTO 80
- GOTO 999
- ENDIF
-*
-* Character size (20 <= K <= 28)
-*
- IF (K.LE.28) THEN
- IF (VAL1.NE.0.) THEN
- TVSIZ(K-19) = VAL1
- ELSE
- TVSIZ(K-19) = DEFVAL(K)
- ENDIF
- GOTO 999
- ENDIF
-*
- IF (K.GT.(NCASE-1)) GOTO 90
-*
- ILAB = K-28
- GOTO (31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,50,
- + 51,52,53,54,55,56,57,58,59,60,61,62,63,64,65,66,67,68,69,70,
- + 71,72,73,74,75) ILAB
-*
-* Real values first are treated
-*
-* Window margins
-*
- 31 CONTINUE
- IF(VAL1.NE.0.)THEN
- XWIND=VAL1
- ELSE
- XWIND=DEFVAL(K)
- ENDIF
- GOTO 999
-*
- 32 CONTINUE
- IF(VAL1.NE.0.)THEN
- YWIND=VAL1
- ELSE
- YWIND=DEFVAL(K)
- ENDIF
- GOTO 999
-*
-* Histogram maximum
-*
- 33 CONTINUE
- IF(VAL1.GT.1.)THEN
- CALL HBUG(' HMAX must be .LE. 1','HPLSET',0)
- GOTO 999
- ENDIF
- IF(VAL1.NE.0.)THEN
- SCMAX=VAL1
- LOMAX=.TRUE.
- ELSE
- SCMAX=DEFVAL(K)
- LOMAX=.FALSE.
- ENDIF
- GOTO 999
-*
-* Boldface characters
-*
- 34 CONTINUE
- CPASS=VAL1
- CALL IGSET('PASS',CPASS)
- GOTO 999
-*
- 35 CONTINUE
- IF(VAL1.NE.0.)THEN
- CSHIFT=VAL1
- ELSE
- CSHIFT=DEFVAL(K)
- ENDIF
- CALL IGSET('CSHI',CSHIFT)
- GOTO 999
-*
-* Offset for "Bar" histogram
-*
- 36 CONTINUE
- IF(VAL1.GT.1.)THEN
- CALL HBUG(' BARO must be .LE. 1','HPLSET',0)
- GOTO 999
- ENDIF
- ROFFS=VAL1
- CALL IGSET('BARO',ROFFS)
- GOTO 999
-*
-* Width of "Bar"
-*
- 37 CONTINUE
- IF(VAL1.GT.1.)THEN
- CALL HBUG(' BARW must be .LE. 1','HPLSET',0)
- GOTO 999
- ENDIF
- IF(VAL1.NE.0.)THEN
- RWDTH=VAL1
- ELSE
- RWDTH=DEFVAL(K)
- ENDIF
- CALL IGSET('BARW',RWDTH)
- GOTO 999
-*
-* Length of basic dashed segment
-*
- 38 CONTINUE
- IF(VAL1.NE.0.)THEN
- DLEN=VAL1
- ELSE
- DLEN=DEFVAL(K)
- ENDIF
- DLENN=DLEN*XYTWN
- CALL IGSET('BASL',DLENN)
- GOTO 999
-*
-* Integer values then are treated
-*
-* Line type
-*
- 39 CONTINUE
- IF(VAL1.NE.0.)THEN
- ILTYP=INT(VAL1)
- LTYPFL=.FALSE.
- ELSE
- ILTYP=INT(DEFVAL(K))
- LTYPFL=.TRUE.
- ENDIF
- CALL ISLN(ILTYP)
- GOTO 999
-*
-* Line type of the grid
-*
- 40 CONTINUE
- IGTYP=INT(VAL1)
- IF(IGTYP.LT.1)IGTYP=3
- GOTO 999
-*
-* Color map position
-*
- 41 CONTINUE
- ICOLMP=INT(VAL1)
- IF(ICOLMP.LT.1.OR.ICOLMP.GT.4)ICOLMP=1
- GOTO 999
-*
-* Date position
-*
- 42 CONTINUE
- IDATE=INT(VAL1)
- IF(IDATE.LT.1.OR.IDATE.GT.4)IDATE=1
- GOTO 999
-*
-* File name position
-*
- 43 CONTINUE
- IFILE=INT(VAL1)
- IF(IFILE.LT.1.OR.IFILE.GT.4)IFILE=1
- GOTO 999
-*
-* STAT Values
-*
- 44 CONTINUE
- IF (ABS(VAL1).GT.1111111.) VAL1=1111111.
- ISTAT=INT(VAL1)
- IF(ISTAT.LT.1)ISTAT=1111
- GOTO 999
-*
-* FIT Values
-*
- 45 CONTINUE
- IF (ABS(VAL1).GT.111.) VAL1=111.
- IFIT=INT(VAL1)
- IF(IFIT.LT.1)IFIT=101
- GOTO 999
-*
-* Histogram hatch type
-*
- 46 CONTINUE
- IHTYP=INT(VAL1)
- GOTO 999
-*
-* Box hatch type
-*
- 47 CONTINUE
- IBTYP=INT(VAL1)
- GOTO 999
-*
-* Picture box hatch type
-*
- 48 CONTINUE
- IPTYP=INT(VAL1)
- GOTO 999
-*
-* Function hatch type
-*
- 49 CONTINUE
- IFTYP=INT(VAL1)
- GOTO 999
-*
-* Histogram color
-* (Interior Style is set to 1 (solid) by default and
-* must be reset (with SET HTYP) if user doesn't agree.)
-*
- 50 CONTINUE
- IF(VAL1.NE.0.)THEN
- RHCOL = VAL1
- ELSE
- RHCOL = DEFVAL(K)
- ENDIF
- IHCOL = INT(RHCOL)
- IHLIST = MAX(INT(10.*(RHCOL-IHCOL)),1)
- IF(IHCOL.EQ.0)IHCOL = 1
- IF(IHCOL.GT.1000)THEN
- IHBCOL = MOD(IHCOL,1000)/100
- IHCOL = MOD(IHCOL,100)
- IHTYP = 2001
- ELSE
- IHBCOL = 0
- IHTYP = 1000
- ENDIF
- GOTO 999
-*
-* Box color
-*
- 51 CONTINUE
- IF(VAL1.NE.0.)THEN
- RBCOL = VAL1
- ELSE
- RBCOL = DEFVAL(K)
- ENDIF
- IBCOL = INT(RBCOL)
- ISBCOL = INT(10.*(RBCOL-IBCOL)+0.01)
- ISSCOL = NINT(100.*(RBCOL-IBCOL)-10.*ISBCOL)
- IF(IBCOL.GT.1000)THEN
- IBBCOL = MOD(IBCOL,1000)/100
- IBCOL = MOD(IBCOL,100)
- IBTYP = 2001
- ELSE
- IBBCOL = 0
- IBTYP = 1000
- ENDIF
- GOTO 999
-*
-* Picture box color
-*
- 52 CONTINUE
- IF(VAL1.NE.0.)THEN
- IPCOL = INT(VAL1)
- ELSE
- IPCOL = INT(DEFVAL(K))
- ENDIF
- IF(IPCOL.GT.1000)THEN
- IPBCOL = MOD(IPCOL,1000)/100
- IPCOL = MOD(IPCOL,100)
- IPTYP = 2001
- ELSE
- IPBCOL = 0
- IPTYP = 1000
- ENDIF
- GOTO 999
-*
-* Function color
-*
- 53 CONTINUE
- IF(VAL1.NE.0.)THEN
- IFCOL = INT(VAL1)
- ELSE
- IFCOL = INT(DEFVAL(K))
- ENDIF
- IF(IFCOL.GT.1000)THEN
- IFBCOL = MOD(IFCOL,1000)/100
- IFCOL = MOD(IFCOL,100)
- IFTYP = 2001
- ELSE
- IFBCOL = 0
- IFTYP = 1000
- ENDIF
- GOTO 999
-*
-* X axis color
-*
- 54 CONTINUE
- IXCOL=INT(VAL1)
- GOTO 999
-*
-* Y axis color
-*
- 55 CONTINUE
- IYCOL=INT(VAL1)
- GOTO 999
-*
-* Histogram line width
-*
- 56 CONTINUE
- IHWID=MAX(INT(VAL1),1)
- GOTO 999
-*
-* Box line width
-*
- 57 CONTINUE
- IBWID=MAX(INT(VAL1),1)
- GOTO 999
-*
-* Picture box line width
-*
- 58 CONTINUE
- IPWID=MAX(INT(VAL1),1)
- GOTO 999
-*
-* Function line width
-*
- 59 CONTINUE
- IFWID=MAX(INT(VAL1),1)
- GOTO 999
-*
-* X axis ticks width
-*
- 60 CONTINUE
- IXWID=MAX(INT(VAL1),1)
- GOTO 999
-*
-* Y axis ticks width
-*
- 61 CONTINUE
- IYWID=MAX(INT(VAL1),1)
- GOTO 999
-*
-* Color map width
-*
- 62 CONTINUE
- IF(VAL1.GT.0.)THEN
- CWID=VAL1
- ELSE
- CWID=DEFVAL(K)
- ENDIF
- GOTO 999
-*
-* Title and text font and precision
-*
- 63 CONTINUE
- IF(VAL1.NE.0.)THEN
- IHFONT(1)=INT(VAL1)
- ELSE
- IHFONT(1)=INT(DEFVAL(K))
- ENDIF
- GOTO 999
-*
-* Global title font and precision
-*
- 64 CONTINUE
- IF(VAL1.NE.0.)THEN
- IHFONT(2)=INT(VAL1)
- ELSE
- IHFONT(2)=INT(DEFVAL(K))
- ENDIF
- GOTO 999
-*
-* Axis values font and precision
-*
- 65 CONTINUE
- IF(VAL1.NE.0.)THEN
- IHFONT(3)=INT(VAL1)
- ELSE
- IHFONT(3)=INT(DEFVAL(K))
- ENDIF
- GOTO 999
-*
-* Axis labels font and precision
-*
- 66 CONTINUE
- IF(VAL1.NE.0.)THEN
- IHFONT(4)=INT(VAL1)
- ELSE
- IHFONT(4)=INT(DEFVAL(K))
- ENDIF
- GOTO 999
-*
-* Comment font and precision
-*
- 67 CONTINUE
- IF(VAL1.NE.0.)THEN
- IHFONT(5)=INT(VAL1)
- ELSE
- IHFONT(5)=INT(DEFVAL(K))
- ENDIF
- GOTO 999
-*
-* Number of divisions for X axis
-*
- 68 CONTINUE
- IF(VAL1.NE.0.)THEN
- IF(VAL1.GE.0)THEN
- RDIVX=VAL1+0.001
- ELSE
- RDIVX=-VAL1+0.001
- RDIVX=-RDIVX
- ENDIF
- ELSE
- RDIVX=DEFVAL(K)
- ENDIF
- GOTO 999
-*
-* Number of divisions for Y axis
-*
- 69 CONTINUE
- IF(VAL1.NE.0.)THEN
- IF(VAL1.GE.0)THEN
- RDIVY=VAL1+0.001
- ELSE
- RDIVY=-VAL1+0.001
- RDIVY=-RDIVY
- ENDIF
- ELSE
- RDIVY=DEFVAL(K)
- ENDIF
- GOTO 999
-*
-* Number of divisions for Z axis
-*
- 70 CONTINUE
- IF(VAL1.NE.0.)THEN
- RDIVZ=VAL1
- ELSE
- RDIVZ=DEFVAL(K)
- ENDIF
- CALL IGCOL1(INT(RDIVZ))
- GOTO 999
-*
-* First page number
-*
- 71 CONTINUE
- IF(VAL1.NE.0.)THEN
- IOPAGE=MAX(1,INT(VAL1))
- ELSE
- IOPAGE=INT(DEFVAL(K))
- ENDIF
- GOTO 999
-*
-* % of error on X
-*
- 72 CONTINUE
- IF(VAL1.NE.0.)THEN
- RERRX=VAL1
- ELSE
- RERRX=DEFVAL(K)
- ENDIF
- GOTO 999
-*
-* Default 1D and 2D plot options
-*
- 73 CONTINUE
- IDEF1D=INT(VAL1)
- GOTO 999
- 74 CONTINUE
- IDEF2D=INT(VAL1)
- GOTO 999
-*
-* Option SHOW
-*
- 75 CONTINUE
- WRITE(LERR,1010)
- WRITE(LERR,1000)
- WRITE(LERR,2000)
- WRITE(LERR,3000)
- WRITE(LERR,2000)
- DO 110 I=1,19
- WRITE(LERR,4000) KKASE(I),PL4(I),DEFVAL(I),CHEXP1(I)
- 110 CONTINUE
- DO 120 I=20,28
- WRITE(LERR,4000) KKASE(I),TVSIZ(I-19),DEFVAL(I),CHEXP1(I)
- 120 CONTINUE
-*
- 125 XSHOW(1) = XWIND
- XSHOW(2) = YWIND
- XSHOW(3) = SCMAX
- XSHOW(4) = CPASS
- XSHOW(5) = CSHIFT
- XSHOW(6) = ROFFS
- XSHOW(7) = RWDTH
- XSHOW(8) = DLEN
- XSHOW(9) = ILTYP
- XSHOW(10) = IGTYP
- XSHOW(11) = ICOLMP
- XSHOW(12) = IDATE
- XSHOW(13) = IFILE
- XSHOW(14) = ISTAT
- XSHOW(15) = IFIT
- XSHOW(16) = IHTYP
- XSHOW(17) = IBTYP
- XSHOW(18) = IPTYP
- XSHOW(19) = IFTYP
- XSHOW(20) = RHCOL
- XSHOW(21) = RBCOL
- XSHOW(22) = IPCOL
- XSHOW(23) = IFCOL
- XSHOW(24) = IXCOL
- XSHOW(25) = IYCOL
- XSHOW(26) = IHWID
- XSHOW(27) = IBWID
- XSHOW(28) = IPWID
- XSHOW(29) = IFWID
- XSHOW(30) = IXWID
- XSHOW(31) = IYWID
- XSHOW(32) = CWID
- XSHOW(33) = IHFONT(1)
- XSHOW(34) = IHFONT(2)
- XSHOW(35) = IHFONT(3)
- XSHOW(36) = IHFONT(4)
- XSHOW(37) = IHFONT(5)
- XSHOW(38) = RDIVX
- XSHOW(39) = RDIVY
- XSHOW(40) = RDIVZ
- XSHOW(41) = IOPAGE
- XSHOW(42) = RERRX
- XSHOW(43) = IDEF1D
- XSHOW(44) = IDEF2D
-*
- IF (IQCASE.NE.0) GOTO 140
-*
-*
-* Real values
-*
- DO 130 I=29,36
- K = I-28
- WRITE(LERR,4000) KKASE(I),XSHOW(K),DEFVAL(I),CHEXP2(K)
- 130 CONTINUE
-*
-* Integer values
-*
- DO 135 I=37,65
- K=I-28
- IF(K.NE.19.AND.
- + K.NE.20.AND.
- + K.NE.32)THEN
- WRITE(LERR,5000) KKASE(I)
- + ,INT(XSHOW(K)),INT(DEFVAL(I)),CHEXP2(K)
- ELSE
- WRITE(LERR,4000) KKASE(I),XSHOW(K),DEFVAL(I),CHEXP2(K)
- ENDIF
- 135 CONTINUE
-*
-* Real values
-*
- DO 137 I=66,68
- K=I-28
- WRITE(LERR,4000) KKASE(I),XSHOW(K),DEFVAL(I),CHEXP2(K)
- 137 CONTINUE
-*
-* Integer value
-*
- WRITE(LERR,5000) KKASE(69)
- + ,INT(XSHOW(41)),INT(DEFVAL(69)),CHEXP2(41)
-*
- WRITE(LERR,4000) KKASE(70),XSHOW(42),DEFVAL(70),CHEXP2(42)
- WRITE(LERR,5000) KKASE(71)
- + ,INT(XSHOW(43)),INT(DEFVAL(71)),CHEXP2(43)
- WRITE(LERR,5000) KKASE(72)
- + ,INT(XSHOW(44)),INT(DEFVAL(72)),CHEXP2(44)
-*
- WRITE(LERR,2000)
- CALL IGSET('SHOW',0.)
- GOTO 999
-*
- 140 CONTINUE
- IF (IQCASE .LE. 19) THEN
- ARG = PL4(I)
- ELSE IF (IQCASE .LE. 27) THEN
- ARG = TVSIZ(I-19)
- ELSE IF (IQCASE .LE. NCASE) THEN
- ARG = XSHOW(I-28)
- ENDIF
- GOTO 999
-*
-* Set all default values
-*
- 100 CONTINUE
- CALL IGSET('*',0.)
- DO 555 I=1,19
- PL4(I)=DEFVAL(I)
- 555 CONTINUE
-*
- IVSIZE = 4
- LOVERT = .TRUE.
-*
- DO 556 I=1,9
- TVSIZ(I) = DEFVAL(I+19)
- 556 CONTINUE
- XWIND = DEFVAL(29)
- YWIND = DEFVAL(30)
- SCMAX = DEFVAL(31)
- LOMAX = .FALSE.
- CPASS = DEFVAL(32)
- CALL IGSET('PASS',CPASS)
- CSHIFT = DEFVAL(33)
- CALL IGSET('CSHI',CSHIFT)
- ROFFS = DEFVAL(34)
- CALL IGSET('BARO',ROFFS)
- RWDTH = DEFVAL(35)
- CALL IGSET('BARW',RWDTH)
- DLEN = DEFVAL(36)
- DLENN = XYTWN*DLEN
- CALL IGSET('BASL',DLENN)
- ILTYP = INT(DEFVAL(37))
- LTYPFL = .TRUE.
- CALL ISLN(ILTYP)
- IGTYP = INT(DEFVAL(38))
- ICOLMP = INT(DEFVAL(39))
- IDATE = INT(DEFVAL(40))
- IFILE = INT(DEFVAL(41))
- ISTAT = INT(DEFVAL(42))
- IFIT = INT(DEFVAL(43))
- IHTYP = INT(DEFVAL(44))
- IBTYP = INT(DEFVAL(45))
- IPTYP = INT(DEFVAL(46))
- IFTYP = INT(DEFVAL(47))
- IHCOL = INT(DEFVAL(48))
- IHBCOL = 0
- RBCOL = DEFVAL(49)
- IBCOL = INT(RBCOL)
- IBBCOL = 0
- ISBCOL = 0
- ISSCOL = 0
- IPCOL = INT(DEFVAL(50))
- IPBCOL = 0
- IFCOL = INT(DEFVAL(51))
- IFBCOL = 0
- IXCOL = INT(DEFVAL(52))
- IYCOL = INT(DEFVAL(53))
- IHWID = INT(DEFVAL(54))
- IBWID = INT(DEFVAL(55))
- IPWID = INT(DEFVAL(56))
- IFWID = INT(DEFVAL(57))
- IXWID = INT(DEFVAL(58))
- IYWID = INT(DEFVAL(59))
- CWID = DEFVAL(60)
- IHFONT(1) = INT(DEFVAL(61))
- IHFONT(2) = INT(DEFVAL(62))
- IHFONT(3) = INT(DEFVAL(63))
- IHFONT(4) = INT(DEFVAL(64))
- IHFONT(5) = INT(DEFVAL(65))
- RDIVX = DEFVAL(66)
- RDIVY = DEFVAL(67)
- RDIVZ = DEFVAL(68)
- IOPAGE = INT(DEFVAL(69))
- RERRX = DEFVAL(70)
- IDEF1D = INT(DEFVAL(71))
- IDEF2D = INT(DEFVAL(72))
-*
- 80 CONTINUE
-*
-* XSIZ and YSIZ have changed, we have to evaluate LOVERT,
-* windowing is reset to (1,1,1), transformation 1 is selected
-*
- CALL HPLZON(1,1,1,' ')
- IF (IQUEST(1).NE.0) THEN
- XSIZ = XSZOLD
- YSIZ = YSZOLD
- GOTO 999
- ENDIF
- IF (XSIZ.LE.0..OR.YSIZ.LE.0.) GOTO 90
- IF (XSIZ.LE.YSIZ) THEN
- LOVERT = .TRUE.
- ELSE
- LOVERT = .FALSE.
- ENDIF
- GOTO 999
-*
- 90 CALL HBUG('Illegal parameter','HPLSET',0)
- GOTO 999
-*
- 1000 FORMAT(1X,'|',23X,'HPLSET : Current values in use',24X,'|')
- 1010 FORMAT(1X,'+',77(1H-),'+')
- 2000 FORMAT(1X,'+',12(1H-),'+',15(1H-),'+',15(1H-),'+',32(1H-),'+')
- 3000 FORMAT(1X,'| Parameter | Current value | Default value '
- +, '| Explanation |')
- 4000 FORMAT(' |',4X,A4,4X,'|',1X,F9.2,5X,'|',1X,F9.2,5X,'|',A32,'|')
- 5000 FORMAT(' |',4X,A4,4X,'|',2X,I8,5X,'|',2X,I8,5X,'|',A32,'|')
-*
- 999 END
diff --git a/src/graflib/hplot/hplotf77/hplsiz.F b/src/graflib/hplot/hplotf77/hplsiz.F
deleted file mode 100644
index f365fde..0000000
--- a/src/graflib/hplot/hplotf77/hplsiz.F
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: hplsiz.F,v 1.1.1.1 1996/01/19 10:50:11 mclareni Exp $
-*
-* $Log: hplsiz.F,v $
-* Revision 1.1.1.1 1996/01/19 10:50:11 mclareni
-* Hplot
-*
-*
-#include "hplot/pilot.h"
-*CMZ : 5.04/12 16/01/89 12.08.24 by O.Couet
-*-- Author :
- SUBROUTINE HPLSIZ(XSZ,YSZ,CHOPT)
-*.==========>
-*. Sets or returns picture size in cm according to
-*. the option CHOPT.
-*. CHOPT = ' ' set picture size with values XSZ and YSZ
-*. CHOPT = 'R' returns picture size in XSZ and YSZ variable.
-*..=========>
-*
-#include "hplot/hpl4.inc"
-*
- CHARACTER*1 CHOPT
-*._____________________________
- IF (CHOPT.EQ.' ')THEN
- CALL HPLSET('XSIZ',XSZ)
- CALL HPLSET('YSIZ',YSZ)
- ELSE IF(CHOPT.EQ.'R')THEN
- XSZ=XSIZ
- YSZ=YSIZ
- ENDIF
- END
-
diff --git a/src/graflib/hplot/hplotf77/hplsof.F b/src/graflib/hplot/hplotf77/hplsof.F
deleted file mode 100644
index aecefb3..0000000
--- a/src/graflib/hplot/hplotf77/hplsof.F
+++ /dev/null
@@ -1,37 +0,0 @@
-*
-* $Id: hplsof.F,v 1.1.1.1 1996/01/19 10:50:11 mclareni Exp $
-*
-* $Log: hplsof.F,v $
-* Revision 1.1.1.1 1996/01/19 10:50:11 mclareni
-* Hplot
-*
-*
-#include "hplot/pilot.h"
-*CMZ : 5.04/12 16/01/89 12.08.24 by O.Couet
-*-- Author :
- SUBROUTINE HPLSOF(X,Y,CHTEXT,SSIZE,ANGLE,XMAX,IGOTO)
-*.==========>
-*. Software characters : character HERSHEY
-*. cm are requested for X and Y.
-*. (Transformation no 1 is selected)
-*..=========>
-#include "hplot/hpl2.inc"
- CHARACTER*(*) CHTEXT
- CHARACTER*1 CHOPT
-*._____________________________
-*
- IF(NTWIN.NE.1)THEN
- CALL ISELNT(1)
- NTWIN=1
- ENDIF
-*
- IF(IGOTO.GT.0)THEN
- CHOPT='R'
- ELSEIF(IGOTO.EQ.0)THEN
- CHOPT='C'
- ELSE
- CHOPT='L'
- ENDIF
- CALL IGTEXT(X,Y,CHTEXT,SSIZE,ANGLE,CHOPT)
- END
-
diff --git a/src/graflib/hplot/hplotf77/hplsta.F b/src/graflib/hplot/hplotf77/hplsta.F
deleted file mode 100644
index 6ef139b..0000000
--- a/src/graflib/hplot/hplotf77/hplsta.F
+++ /dev/null
@@ -1,396 +0,0 @@
-*
-* $Id: hplsta.F,v 1.1.1.1 1996/01/19 10:50:11 mclareni Exp $
-*
-* $Log: hplsta.F,v $
-* Revision 1.1.1.1 1996/01/19 10:50:11 mclareni
-* Hplot
-*
-*
-#include "hplot/pilot.h"
-*CMZ : 5.20/03 04/09/95 12.11.53 by O.Couet
-*-- Author :
- SUBROUTINE HPLSTA(ID,KICASE,NUM)
-*.==========>
-*. Print statistics informations on picture.
-*. (Transformation no 1 is selected)
-*..=========>
-#include "hplot/hpl1.inc"
-#include "hplot/hpl2.inc"
-#include "hplot/hpl4.inc"
-#include "hplot/hpl6.inc"
-#include "hplot/hpl13.inc"
-#include "hbook/hcbits.inc"
- LOGICAL HEXIST
- DIMENSION W(9),XLINE(2),YLINE(2),VPNT(4),VP1(4)
- DIMENSION IBIT(7),NCHARD(2)
- DIMENSION RTXFP(2), RTXAL(2)
- CHARACTER*(*) KICASE
- CHARACTER*30 CTEXT
- CHARACTER*8 CHTEXT(7)
- SAVE ICOLER
- DATA ICOLER /0/
- DATA CHTEXT /'ID','Entries','Mean','RMS','UDFLW','OVFLW'
- +, 'ALLCHAN'/
-*._____________________________
-*
- IF(.NOT.HEXIST(ID))RETURN
- IF(I123.EQ.0)RETURN
- NCHARD(1)=20
- NCHARD(2)=20
- CALL IGQ('PLCI',RPLCI)
- CALL IGQ('TXCI',RTXCI)
- CALL IGQ('TXFP',RTXFP)
- CALL IGQ('CHHE',RCHHE)
- CALL IGQ('TANG',RTANG)
- CALL IGQ('TXAL',RTXAL)
- CALL IGQ('FACI',RFACI)
- CALL IGQ('FAIS',RFAIS)
- CALL IGQ('BORD',RBORD)
- CALL IGQ('LTYP',RLTYP)
- CALL IGQ('LWID',RLWID)
-*
-* Set transformation no 1 (cm)
-*
- NTWOLD=NTWIN
- CALL ISELNT(NTHIST)
- CALL IGQWK(1,'NTVP',VPNT)
- CALL ISELNT(1)
- CALL IGQWK(1,'NTVP',VP1)
- NTWIN=1
-*
-* Set defaults and get common information
-*
- CALL HNOENT(ID,NOENT)
- CALL HGSTAT(ID,W)
- IF(W(4).LT.-1.0E10)GOTO 20
-*
-* 2-D Histogram
-*
- NLINES=5
- NLINES=0
- NOPTIO=3
- ISTAT2=ISTAT
- DO 10 I=NOPTIO,1,-1
- IBIT(I)=ISTAT2/(10**(I-1))
- IF(IBIT(I).NE.0)THEN
- NLINES=NLINES+1
- IF(I.EQ.3)THEN
- NLINES=NLINES+2
- NCHARD(2)=30
- ENDIF
- ENDIF
- ISTAT2=ISTAT2-(IBIT(I)*(10**(I-1)))
- 10 CONTINUE
- IDIM=2
- GOTO 50
-*
- 20 CONTINUE
-*
-* 1-D Histogram
-*
- CALL IGPID(1,'stat-box',ID,' ')
- IFIT2=IFIT
- IF(IFIT.GE.100)IFIT2=IFIT-100
- IF(LOFIT.AND.IFIT2-10.GT.0)NCHARD(1)=30
- NLINES=0
- NOPTIO=7
- ISTAT2=ISTAT
- DO 30 I=NOPTIO,1,-1
- IBIT(I)=ISTAT2/(10**(I-1))
- IF(IBIT(I).NE.0)NLINES=NLINES+1
- ISTAT2=ISTAT2-(IBIT(I)*(10**(I-1)))
- 30 CONTINUE
- IDIM=1
- AMEAN=HSTATI(ID,1,KICASE,NUM)
- STDEV=HSTATI(ID,2,KICASE,NUM)
- ALLCHA=0.
- DO 40 I=1,NCX
- ALLCHA=ALLCHA+HCX(I,1)
- 40 CONTINUE
-*
- 50 CONTINUE
- CBSIZ=TVSIZ(5)/IXWIN
- BOXHEI=CBSIZ*FLOAT(NLINES)*2.
- BOXLEN=CBSIZ*FLOAT(NCHARD(IDIM))
-*
- XL = XSIZ*((VPNT(1)-VP1(1))/(VP1(2)-VP1(1)))
- YL = YSIZ*((VPNT(3)-VP1(3))/(VP1(4)-VP1(3)))
- XH = XSIZ*((VPNT(2)-VP1(1))/(VP1(2)-VP1(1)))
- YH = YSIZ*((VPNT(4)-VP1(3))/(VP1(4)-VP1(3)))
- XBOXL = XH-BOXLEN
- YBOXL = YH-BOXHEI
- XBOXH = XH
- YBOXH = YH
- XOFF = (XH-XL)*SMRIT
- YOFF = (YH-YL)*SMGUP
-*
-* Define starting position for text
-*
- X1 = XBOXL+CBSIZ-XOFF
- XC = (XBOXH-XBOXL)/2.0+XBOXL-XOFF
- X2 = XBOXH-CBSIZ-XOFF
- Y = YBOXH+0.5*CBSIZ-YOFF
- Y2 = Y
-*
-* Draw the STAT box
-*
- CALL ISLN(ILTYP)
- CALL ISLN(1)
- CALL ISPLCI(IXCOL)
- CALL ISTXCI(IXCOL)
- CALL ISLWSC(1.)
- SSIZ=0.
- IF(IOPTU.NE.0)THEN
- I=INT(IBTYP/1000)-1
- IF(I.EQ.1)THEN
- ICOLER=IBCOL
- ELSE
- ICOLER=0
- ENDIF
- CALL ISFAIS(1)
- CALL IGSET('BORD',1.)
- CALL ISFACI(ICOLER)
- CALL IGBOX(XBOXL-XOFF,XBOXH-XOFF,YBOXL-YOFF,YBOXH-YOFF)
- ELSE
- CTEXT='TRS'
- SSIZ=CBSIZ
- IF(ISSCOL.EQ.0)SSIZ=0.
- CALL IGPAVE(XBOXL-SSIZ-XOFF,XBOXH-SSIZ-XOFF
- +, YBOXL-SSIZ-YOFF,YBOXH-SSIZ-YOFF
- +, SSIZ,0,1000+ISSCOL,CTEXT)
- Y = Y-SSIZ
- Y2 = Y2-SSIZ
- X2 = X2-SSIZ
- X1 = X1
- XC = XC-SSIZ
- ENDIF
-*
-* Set text size, font and precision
-*
- KFONT=IABS(IHFONT(5))
- ISTFON=KFONT/10
- ISTPRE=MOD(KFONT,10)
- IF(IHFONT(5).LT.0)ISTFON=-ISTFON
- CALL ISTXFP(ISTFON,ISTPRE)
- CALL ISCHH(CBSIZ)
- CALL IGSET('TANG',0.)
-*
- IF (IDIM.EQ.2)GOTO 70
-*
-* Draw the comments for 1D histograms
-*
- CALL ISTXAL(0,0)
- DO 60 I=1,NOPTIO
- IF(IBIT(I).NE.0)THEN
- Y2=Y2-2.0*CBSIZ
- CALL ITX(X1,Y2,CHTEXT(I))
- ENDIF
- 60 CONTINUE
-*
-* STAT for 1-D histo
-*
- CALL ISTXAL(3,0)
- IF(NCHARD(1).EQ.30)THEN
- XX=XC+2*CBSIZ
- ELSE
- XX=X2
- ENDIF
-*
-* - 1) ID
-*
- IF(IBIT(1).NE.0)THEN
- Y=Y-2.0*CBSIZ
- CTEXT=' '
- WRITE(CTEXT,10000) ID
- CALL ITX(XX,Y,CTEXT)
- ENDIF
-*
-* - 2) Number of entries
-*
- IF(IBIT(2).NE.0)THEN
- Y=Y-2.0*CBSIZ
- CTEXT=' '
- WRITE(CTEXT,10000) NOENT
- CALL ITX(XX,Y,CTEXT)
- ENDIF
-*
-* - 3) Mean value
-*
- IF(IBIT(3).NE.0)THEN
- Y=Y-2.0*CBSIZ
- CTEXT=' '
- WRITE(CTEXT,10100) AMEAN
- CALL ITX(XX,Y,CTEXT)
- ENDIF
-*
-* - 4) Standard deviation
-*
- IF(IBIT(4).NE.0)THEN
- Y=Y-2.0*CBSIZ
- CTEXT=' '
- WRITE(CTEXT,10100) STDEV
- CALL ITX(XX,Y,CTEXT)
- ENDIF
-*
-* - 5) Number of underflow
-*
- IF(IBIT(5).NE.0)THEN
- Y=Y-2.0*CBSIZ
- CTEXT=' '
- WRITE(CTEXT,10100) W(1)
- CALL ITX(XX,Y,CTEXT)
- ENDIF
-*
-* - 6) Number of overflow
-*
- IF(IBIT(6).NE.0)THEN
- Y=Y-2.0*CBSIZ
- CTEXT=' '
- WRITE(CTEXT,10100) W(3)
- CALL ITX(XX,Y,CTEXT)
- ENDIF
-*
-* - 7) All channels
-*
- IF(IBIT(7).NE.0)THEN
- Y=Y-2.0*CBSIZ
- CTEXT=' '
- WRITE(CTEXT,10100) ALLCHA
- CALL ITX(XX,Y,CTEXT)
- ENDIF
- GOTO 80
-*
-*
-* STAT for 2-D histo
-*
-* - 1) ID
-*
- 70 IF(IBIT(1).NE.0)THEN
- Y=Y-2.0*CBSIZ
- CALL ISTXAL(0,0)
- CALL ITX(X1,Y,'ID')
- CTEXT=' '
- WRITE(CTEXT,10000) ID
- CALL ISTXAL(3,0)
- CALL ITX(X2,Y,CTEXT)
- ENDIF
-*
-*
-* - 2) Number of entries
-*
- IF(IBIT(2).NE.0)THEN
- Y=Y-2.0*CBSIZ
- CALL ISTXAL(0,0)
- CALL ITX(X1,Y,'ENTRIES')
- CTEXT=' '
- WRITE(CTEXT,10000) NOENT
- CALL ISTXAL(3,0)
- CALL ITX(X2,Y,CTEXT)
- ENDIF
-*
-* - 3) Draw grid for STAT
-*
-* - 3.1) Horizontal lines
-*
- IF(IBIT(3).NE.0)THEN
- YBACK=Y
- Y=Y-0.5*CBSIZ
- XLINE(1)=XBOXL-SSIZ-XOFF
- XLINE(2)=XBOXH-SSIZ-XOFF
- YLINE(1)=Y
- YLINE(2)=Y
- CALL IPL(2,XLINE,YLINE)
- Y=Y-2.0*CBSIZ
- YLINE(1)=Y
- YLINE(2)=Y
- CALL IPL(2,XLINE,YLINE)
- Y=Y-2.0*CBSIZ
- YLINE(1)=Y
- YLINE(2)=Y
- CALL IPL(2,XLINE,YLINE)
-*
-* - 3.2) Vertical lines
-*
- YLINE(2)=YBOXL-SSIZ-YOFF
- YLINE(1)=YBACK-0.5*CBSIZ
- XLINE(1)=(XBOXH-XBOXL)/3.+XBOXL-XOFF
- XLINE(2)=XLINE(1)
- CALL IPL(2,XLINE,YLINE)
- XLINE(1)=(XBOXH-XBOXL)*2./3.+XBOXL-XOFF
- XLINE(2)=XLINE(1)
- CALL IPL(2,XLINE,YLINE)
- Y=YBACK
-*
-* - 4) Output 1st STAT line
-*
- Y=Y-2.0*CBSIZ
- CTEXT=' '
- WRITE(CTEXT,10200) W(1)
- CALL ISTXAL(0,0)
- CALL ITX(X1,Y,CTEXT)
- CTEXT=' '
- WRITE(CTEXT,10200) W(2)
- CALL ISTXAL(2,0)
- CALL ITX(XC,Y,CTEXT)
- CTEXT=' '
- WRITE(CTEXT,10200) W(3)
- CALL ISTXAL(3,0)
- CALL ITX(X2,Y,CTEXT)
-*
-* - 5) Output 2nd STAT line
-*
- Y=Y-2.0*CBSIZ
- CTEXT=' '
- WRITE(CTEXT,10200) W(4)
- CALL ISTXAL(0,0)
- CALL ITX(X1,Y,CTEXT)
- CTEXT=' '
- WRITE(CTEXT,10200) W(5)
- CALL ISTXAL(2,0)
- CALL ITX(XC,Y,CTEXT)
- CTEXT=' '
- WRITE(CTEXT,10200) W(6)
- CALL ISTXAL(3,0)
- CALL ITX(X2,Y,CTEXT)
-*
-* - 6) Output 3rd STAT line
-*
- Y=Y-2.0*CBSIZ
- CTEXT=' '
- WRITE(CTEXT,10200) W(7)
- CALL ISTXAL(0,0)
- CALL ITX(X1,Y,CTEXT)
- CTEXT=' '
- WRITE(CTEXT,10200) W(8)
- CALL ISTXAL(2,0)
- CALL ITX(XC,Y,CTEXT)
- CTEXT=' '
- WRITE(CTEXT,10200) W(9)
- CALL ISTXAL(3,0)
- CALL ITX(X2,Y,CTEXT)
- ENDIF
-*
-* Reset NT
-*
- 80 IF(NTWIN.NE.NTWOLD)THEN
- NTWIN=NTWOLD
- CALL ISELNT(NTWOLD)
- ENDIF
- IF(LOZFL)CALL IZPICT(' ','O')
- CALL IGSET('PLCI',RPLCI)
- CALL IGSET('TXCI',RTXCI)
- CALL ISTXFP(INT(RTXFP(1)),INT(RTXFP(2)))
- CALL IGSET('CHHE',RCHHE)
- CALL IGSET('TANG',RTANG)
- CALL ISTXAL(INT(RTXAL(1)),INT(RTXAL(2)))
- CALL IGSET('FACI',RFACI)
- CALL IGSET('FAIS',RFAIS)
- CALL IGSET('BORD',RBORD)
- CALL IGSET('LTYP',RLTYP)
- CALL IGSET('LWID',RLWID)
-*
-10000 FORMAT(I15)
-10100 FORMAT(G11.4)
-10200 FORMAT(G10.3)
-*
- END
diff --git a/src/graflib/hplot/hplotf77/hplsur.F b/src/graflib/hplot/hplotf77/hplsur.F
deleted file mode 100644
index c5c552e..0000000
--- a/src/graflib/hplot/hplotf77/hplsur.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: hplsur.F,v 1.1.1.1 1996/01/19 10:50:11 mclareni Exp $
-*
-* $Log: hplsur.F,v $
-* Revision 1.1.1.1 1996/01/19 10:50:11 mclareni
-* Hplot
-*
-*
-#include "hplot/pilot.h"
-*CMZ : 5.17/08 29/09/93 11.59.27 by O.Couet
-*-- Author :
- SUBROUTINE HPLSUR(IDD,THETA,PHI,ICASE)
-*.==========>
-*. 3-d viewing routine
-*. surface drawn with automatic hidden line removal
-*. THETA must be between 0 and 90 degrees
-*. PHI can have any value
-*..=========>
- DIMENSION PAR(2)
-*._____________________________
-*
- PAR(1)=THETA
- PAR(2)=PHI
- CALL HPLTAB(IDD,2,PAR,'SURF')
-*
- END
diff --git a/src/graflib/hplot/hplotf77/hplswn.F b/src/graflib/hplot/hplotf77/hplswn.F
deleted file mode 100644
index 360cc2b..0000000
--- a/src/graflib/hplot/hplotf77/hplswn.F
+++ /dev/null
@@ -1,59 +0,0 @@
-*
-* $Id: hplswn.F,v 1.1.1.1 1996/01/19 10:50:11 mclareni Exp $
-*
-* $Log: hplswn.F,v $
-* Revision 1.1.1.1 1996/01/19 10:50:11 mclareni
-* Hplot
-*
-*
-#include "hplot/pilot.h"
-*CMZ : 5.16/01 30/04/93 17.25.41 by Rene Brun
-*-- Author :
- SUBROUTINE HPLSWN
-*.==========>
-*. Set system coordinates and the appropriate window according
-*. to transformation.
-*. Draws page surround, if request, and histogram surround.
-*. If option "Same" is selected when plotting nothing is done.
-*. If option "Update" is selected when plotting we must verify if
-*. scale is OK (otherwise we have to redraw axes and complete
-*. histogram), and select the right transformation.
-*. Initialise and selects histogram transformation NTHIST
-*. (see HPLIVE and HPLJ).
-*..=========>
-#include "hplot/hpl1.inc"
-#include "hplot/hpl2.inc"
-#include "hplot/hpl13.inc"
-#include "hbook/hcbook.inc"
-*._____________________________
-*
- LOSCAL=.FALSE.
- IF (LOSAME) THEN
- IF (NTWIN.NE.NTHIST) CALL ISELNT (NTHIST)
- NTWIN = NTHIST
- RETURN
- ENDIF
-*
- IF(IOPTU.NE.0)THEN
- CALL HPLIVE
- ELSE IF(IOPTP.NE.0)THEN
- NTZEB=IQ(LHPLIP+2)
- CALL ISELNT(NTZEB)
- NTWIN=NTZEB
- NTHIST=NTZEB
- ELSE
- IF (.NOT.LOWIND) THEN
- CALL HPLI
- ELSE
- IWIN=IWIN+1
- NCHIST=NCHIST+1
- NWIN=IXWIN*IYWIN
- IF ((NCHIST.GT.NWIN).AND.(.NOT.LWSAME)) NCHIST=1
- IF (IWIN.GT.NWIN) IWIN=1
- IF ((IWIN.EQ.IWIN0).AND.(.NOT.LWSAME)) CALL HPLI
- ENDIF
- CALL HPLJ
- ENDIF
-*
- END
-
diff --git a/src/graflib/hplot/hplotf77/hplsym.F b/src/graflib/hplot/hplotf77/hplsym.F
deleted file mode 100644
index 22a3b58..0000000
--- a/src/graflib/hplot/hplotf77/hplsym.F
+++ /dev/null
@@ -1,111 +0,0 @@
-*
-* $Id: hplsym.F,v 1.2 2001/12/07 15:19:56 couet Exp $
-*
-* $Log: hplsym.F,v $
-* Revision 1.2 2001/12/07 15:19:56 couet
-* - use higz include files from the higz include file directory.
-* option Z is now working in hplaer.F
-* option Z has been implemented in hplsym.F
-*
-* Revision 1.1.1.1 1996/01/19 10:50:11 mclareni
-* Hplot
-*
-*
-#include "hplot/pilot.h"
-*CMZ : 5.20/00 19/04/95 10.52.25 by O.Couet
-*-- Author :
- SUBROUTINE HPLSYM(XU,YU,N,JISYM,USIZE,CHOPT)
-*.==========>
-*.
-*. Draws symbols (or a point) on the picture at the point defined by XU(N)
-*. and YU(N) according to CHOPT:
-*.
-*. ' ' Transformation NTHIST is selected
-*. 'C' Transformation 1 is selected
-*. 'Z' The vectors XU,YU,DXU1,DXU2,DYU1 and DYU2 are taken into PAWC at the
-*. adresses IQUEST(81) and IQUEST(82)
-*.
-*..=========>
-#include "hplot/hpl1.inc"
-#include "hplot/hpl2.inc"
-#include "hplot/hpl4.inc"
-#include "hplot/hpl6.inc"
-#include "hbook/hcbook.inc"
-#include "hplot/quest.inc"
-#include "higz/hilink.inc"
- EQUIVALENCE (LXU,LSTACK(1)),(LYU,LSTACK(2))
- DIMENSION XU(N),YU(N)
- DIMENSION KSYM(12),KOLD(12)
- CHARACTER*(*) CHOPT
- DATA KOLD/840,841,842,843,850,851,852,853,2261,2262,2263,2264/
- DATA KSYM/ 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31/
-*._____________________________
-*
- LOCM = .FALSE.
- IF (USIZE.GT.0.0) THEN
- SYMSIZ = USIZE
- ELSE
- SYMSIZ = TVSIZ(1)
- ENDIF
- KISYM = JISYM
- DO 10 I=1,12
- IF (KISYM.EQ.KOLD(I)) KISYM = KSYM(I)
- 10 CONTINUE
- IF (KISYM.LE.0) KISYM = 1
-*----
-* If necessary the adresses of the vectors are saved in
-* a link area.
-*----
- IF(INDEX(CHOPT,'Z').NE.0)THEN
- LXU = IQUEST(81)
- LYU = IQUEST(82)
- IOPTZ = 1
- ELSE
- IOPTZ = 0
- ENDIF
-*----
-* Sets markers attributes
-*----
- CALL IGQ('MSCF',SMSF)
- CALL IGQ('MTYP',RMTYP)
- CALL ISMKSC((SYMSIZ*XYTWN)/0.009)
- CALL ISMK(KISYM)
-*----
-* Selects cm transformation if necessary
-*----
- IF (INDEX(CHOPT,'C').NE.0) LOCM = .TRUE.
- IF (LOCM) THEN
- IF(NTWIN.NE.1)CALL ISELNT(1)
- NTWIN = 1
- ELSE
- IF(NTWIN.NE.NTHIST)CALL ISELNT(NTHIST)
- NTWIN = NTHIST
- ENDIF
-*----
-* loop round coordinates
-*----
- DO 20 K=1,N
- IF (IOPTZ.NE.0) THEN
- XP = Q(LXU+K-1)
- YP = Q(LYU+K-1)
- ELSE
- XP = XU(K)
- YP = YU(K)
- ENDIF
- IF (.NOT.LOCM) THEN
- IF (LOGXFL) THEN
- IF(XP.LE.0.)GO TO 20
- XP = LOG10(XP)
- ENDIF
- IF (LOGYFL) THEN
- IF(YP.LE.0)GO TO 20
- YP = LOG10(YP)
- ENDIF
- ENDIF
- CALL IPM(1,XP,YP)
- 20 CONTINUE
-*
- CALL IGSET('MSCF',SMSF)
- CALL IGSET('MTYP',RMTYP)
-*
- END
diff --git a/src/graflib/hplot/hplotf77/hpltab.F b/src/graflib/hplot/hplotf77/hpltab.F
deleted file mode 100644
index 0057fb8..0000000
--- a/src/graflib/hplot/hplotf77/hpltab.F
+++ /dev/null
@@ -1,1028 +0,0 @@
-*
-* $Id: hpltab.F,v 1.5 1998/12/07 13:47:05 couet Exp $
-*
-* $Log: hpltab.F,v $
-* Revision 1.5 1998/12/07 13:47:05 couet
-* - set 2siz is available again. It define the size of the charecters when
-* 2D histos are plotted with options TEXT of CHAR. The size is defined in
-* percent of the bin heigh.
-*
-* Revision 1.4 1998/12/02 08:57:39 couet
-* - clean up: commented lines of code removed
-*
-* Revision 1.3 1998/01/30 15:27:20 couet
-* - previous commit was wrong.
-*
-* Revision 1.2 1998/01/30 15:25:18 couet
-* - APOLLO version removed
-*
-* Revision 1.1.1.1 1996/01/19 10:50:11 mclareni
-* Hplot
-*
-*
-#include "hplot/pilot.h"
-*CMZ : 10/11/95 09.37.14 by O.Couet
-*-- Author : O.Couet 04/09/89
- SUBROUTINE HPLTAB(IDD,IPAR,PAR,CHOPTI)
-*.===========>
-*.
-*. This routine draws a table with the 2D histo IDD
-*. according to the value of CHOPT
-*.
-*. _Input parameters:
-*.
-*. INTEGER IDD : Histogram ID.
-*. REAL PAR : Array of real parameters
-*. CHARACTER CHOPT : Options
-*.
-*. +-------+---------------------------------------------------------+---------+
-*. | CHOPT | Corresponding values of PAR | Default |
-*. +-------+---------------------------------------------------------+---------+
-*. | SCAT | Points (scatter plot) | |
-*. | | PAR(1) = Marker type | 1. |
-*. | | PAR(2) = Maximum number of random points per cell | 50. |
-*. | | PAR(3) = ZMIN Minimal Z value | ZMIN |
-*. | | PAR(4) = ZMAX Maximal Z value | ZMAX |
-*. | | PAR(5) = 1000*IXMIN + IXMAX (Usefull for ZOOM) | 1-NX |
-*. | | PAR(6) = 1000*IYMIN + IYMAX (Usefull for ZOOM) | 1-NY |
-*. +-------+---------------------------------------------------------+---------+
-*. | BOX | Boxes | |
-*. | | PAR(1) = ... | ... |
-*. | | PAR(2) = ... | ... |
-*. | | PAR(3) = ZMIN Minimal Z value | ZMIN |
-*. | | PAR(4) = ZMAX Maximal Z value | ZMAX |
-*. | | PAR(5) = 1000*IXMIN + IXMAX (Usefull for ZOOM) | 1-NX |
-*. | | PAR(6) = 1000*IYMIN + IYMAX (Usefull for ZOOM) | 1-NY |
-*. +-------+---------------------------------------------------------+---------+
-*. | ARR | Arrows | |
-*. | | PAR(1) = ... | ... |
-*. | | PAR(2) = ... | ... |
-*. | | PAR(3) = ZMIN Minimal Z value | ZMIN |
-*. | | PAR(4) = ZMAX Maximal Z value | ZMAX |
-*. | | PAR(5) = 1000*IXMIN + IXMAX (Usefull for ZOOM) | 1-NX |
-*. | | PAR(6) = 1000*IYMIN + IYMAX (Usefull for ZOOM) | 1-NY |
-*. +-------+---------------------------------------------------------+---------+
-*. | CONT | Contour plot | |
-*. | | PAR(1) = Nlevel (min=2 max=50) | 20. |
-*. | | PAR(2) = 0 use colour to distinguish contours | 0. |
-*. | | 1 use line style to distinguish contours | |
-*. | | 2 line style and colour are the same for all| |
-*. | | contours | |
-*. | | 3 draw the contour with fill colored fill | |
-*. | | area | |
-*. | | PAR(3) = ZMIN Minimal Z value | ZMIN |
-*. | | PAR(4) = ZMAX Maximal Z value | ZMAX |
-*. | | PAR(5) = 1000*IXMIN + IXMAX (Usefull for ZOOM) | 1-NX |
-*. | | PAR(6) = 1000*IYMIN + IYMAX (Usefull for ZOOM) | 1-NY |
-*. | | PAR(7) = --+ | |
-*. | | . | | |
-*. | | . +-> Level to be drawn | |
-*. | | . | | |
-*. | | PAR(NPAR) = --+ | |
-*. +-------+---------------------------------------------------------+---------+
-*. | COL | COLour plot | |
-*. | | PAR(1) = 0 use the standard 8 colours | 0. |
-*. | | 1 use versacolor pattern table | |
-*. | | PAR(2) = ... | |
-*. | | PAR(3) = ZMIN Minimal Z value | ZMIN |
-*. | | PAR(4) = ZMAX Maximal Z value | ZMAX |
-*. | | PAR(5) = 1000*IXMIN + IXMAX (Usefull for ZOOM) | 1-NX |
-*. | | PAR(6) = 1000*IYMIN + IYMAX (Usefull for ZOOM) | 1-NY |
-*. +-------+---------------------------------------------------------+---------+
-*. | TEXT | Table (Text) | |
-*. | | PAR(1) = Text size | 0.3 |
-*. | | PAR(2) = ... | |
-*. | | PAR(3) = ZMIN Minimal Z value | ZMIN |
-*. | | PAR(4) = ZMAX Maximal Z value | ZMAX |
-*. | | PAR(5) = 1000*IXMIN + IXMAX (Usefull for ZOOM) | 1-NX |
-*. | | PAR(6) = 1000*IYMIN + IYMAX (Usefull for ZOOM) | 1-NY |
-*. +-------+---------------------------------------------------------+---------+
-*. | CHAR | Character, the contains is one single character | |
-*. | | PAR(1) = Text size | 0.3 |
-*. | | PAR(2) = ... | |
-*. | | PAR(3) = ZMIN Minimal Z value | ZMIN |
-*. | | PAR(4) = ZMAX Maximal Z value | ZMAX |
-*. | | PAR(5) = 1000*IXMIN + IXMAX (Usefull for ZOOM) | 1-NX |
-*. | | PAR(6) = 1000*IYMIN + IYMAX (Usefull for ZOOM) | 1-NY |
-*. +-------+---------------------------------------------------------+---------+
-*. | LEGO | Lego. Options 1 to 2 see IGTABL | |
-*. | | PAR(1) = THETA | 30. |
-*. | | PAR(2) = PHI | 30. |
-*. | | PAR(3) = ZMIN Minimal Z value | ZMIN |
-*. | | PAR(4) = ZMAX Maximal Z value | ZMAX |
-*. | | PAR(5) = 1000*IXMIN + IXMAX (Usefull for ZOOM) | 1-NX |
-*. | | PAR(6) = 1000*IYMIN + IYMAX (Usefull for ZOOM) | 1-NY |
-*. +-------+---------------------------------------------------------+---------+
-*. | SURF | Surface. Options 1 to 4 see IGTABL | |
-*. | | PAR(1) = THETA | 30. |
-*. | | PAR(2) = PHI | 30. |
-*. | | PAR(3) = ZMIN Minimal Z value | ZMIN |
-*. | | PAR(4) = ZMAX Maximal Z value | ZMAX |
-*. | | PAR(5) = 1000*IXMIN + IXMAX (Usefull for ZOOM) | 1-NX |
-*. | | PAR(6) = 1000*IYMIN + IYMAX (Usefull for ZOOM) | 1-NY |
-*. +-------+---------------------------------------------------------+---------+
-*. | SAME | Option SAME (or S) | |
-*. +-------+---------------------------------------------------------+---------+
-*. | + | For stacked histogram (legos) | |
-*. +-------+---------------------------------------------------------+---------+
-*. | 'FB' | With LEGO or SURFACE, it suppress the Front-Box | |
-*. +-------+---------------------------------------------------------+---------+
-*. | 'BB' | With LEGO or SURFACE, it suppress the Back-Box | |
-*. +-------+---------------------------------------------------------+---------+
-*. | 'AX' | Suppress the axis drawing on 3D representations | |
-*. +-------+---------------------------------------------------------+---------+
-*.
-*..==========> (O.Couet)
-#include "hbook/hcbook.inc"
-#include "hbook/hcprin.inc"
-#include "hbook/hcflag.inc"
-#include "hbook/hcbits.inc"
-#include "hbook/hcfits.inc"
-#include "hbook/hcfitd.inc"
-#include "hplot/hpl1.inc"
-#include "hplot/hpl2.inc"
-#include "hplot/hpl3.inc"
-#include "hplot/hpl4.inc"
-#include "hplot/hpl6.inc"
-#include "hplot/hpl9.inc"
-#include "hplot/hpl11.inc"
-#include "hplot/hpl13.inc"
-#include "hplot/hpl14.inc"
-#include "hplot/quest.inc"
- INTEGER ICMAP(MXLIST)
- COMMON /HPLYZO/ Y1ZOOM,Y2ZOOM
- CHARACTER*(*) CHOPTI
- DIMENSION PAR(*)
- CHARACTER*4 NAME
- CHARACTER*32 CHOPT,CHOPT2
- DIMENSION COORD(6),PAR2(NMAX)
- EQUIVALENCE (XLINE(1),PAR2(1))
- LOGICAL D3,D2,LOLOG,LOCOL,LOCOLZ
- LOGICAL LVALUE, LPARAM, LUTSAV
-#if defined(CERNLIB_DOUBLE)
- PARAMETER (NWW=2)
- DOUBLE PRECISION SS
-#endif
-#if !defined(CERNLIB_DOUBLE)
- PARAMETER (NWW=1)
- REAL SS
-#endif
- REAL VVV (2), XXX, YYY
- EQUIVALENCE (XXX, VVV(1)), (YYY, VVV(2))
- PARAMETER (NVFIT = 50)
- REAL VFIT (NVFIT, NVFIT)
- EXTERNAL HQF
- SAVE NIDS
- DATA NIDS /1/
-*._____________________________
-*
- NPAR=IPAR
- IF(NPAR.GT.NMAX)NPAR=NMAX
- IF(NPAR.GE.2)THEN
- PAR2(1)=PAR(1)
- PAR2(2)=PAR(2)
- ELSE
- PAR2(1)=0.
- PAR2(2)=0.
- ENDIF
-*
- CALL IGQ('LWID',RLWID)
- CALL IGQ('FAIS',RFAIS)
- CALL IGQ('FASI',RFASI)
- CALL IGQ('FACI',RFACI)
- CALL IGQ('PLCI',RPLCI)
- CALL IGQ('PMCI',RPMCI)
- CALL IGQ('BORD',RBORD)
- CALL IGQ('MTYP',RMK)
- CALL IGQ('TXCI',RTXCI)
-*
-* Determine the options
-*
- D3 = .FALSE.
- D2 = .FALSE.
- LOLOG = .FALSE.
- LOCOL = .FALSE.
- LOCOLZ = .FALSE.
- CHOPT = CHOPTI
- IF (IDEF2D.GT.0.AND.CHOPT.EQ.' ') THEN
- IF (IDEF2D.EQ.7) CHOPT = 'BOX'
- IF (IDEF2D.EQ.8) CHOPT = 'COL'
- IF (IDEF2D.EQ.17) CHOPT = 'CONT'
- IF (IDEF2D.EQ.18) CHOPT = 'TEXT'
- IF (IDEF2D.EQ.19) CHOPT = 'CHAR'
- IF (IDEF2D.EQ.20) CHOPT = 'ARR'
- IF (IDEF2D.EQ.21) CHOPT = 'SCAT'
- ENDIF
- IF ((IDEF2D.GT.0.OR.IDEF1D.GT.0).AND.CHOPT.EQ.' ') THEN
- IDEF = IDEF2D
- IF (IDEF.EQ.0) IDEF = IDEF1D
- IF (IDEF.EQ.9) CHOPT = 'SURF'
- IF (IDEF.EQ.10) CHOPT = 'SURF1'
- IF (IDEF.EQ.11) CHOPT = 'SURF2'
- IF (IDEF.EQ.12) CHOPT = 'SURF3'
- IF (IDEF.EQ.13) CHOPT = 'SURF4'
- IF (IDEF.EQ.14) CHOPT = 'LEGO'
- IF (IDEF.EQ.15) CHOPT = 'LEGO1'
- IF (IDEF.EQ.16) CHOPT = 'LEGO2'
- ENDIF
- CHOPT2=' '
- IF(INDEX(CHOPT,'+').NE.0)CHOPT2(22:22)='+'
-*
- IOP=INDEX(CHOPT,'POL')
- IF(IOP.GT.0)THEN
- CHOPT(IOP:IOP+3)=' '
- CHOPT2(30:32)='POL'
- ENDIF
- IOP=INDEX(CHOPT,'CYL')
- IF(IOP.GT.0)THEN
- CHOPT(IOP:IOP+3)=' '
- CHOPT2(30:32)='CYL'
- ENDIF
- IOP=INDEX(CHOPT,'SPH')
- IF(IOP.GT.0)THEN
- CHOPT(IOP:IOP+3)=' '
- CHOPT2(30:32)='SPH'
- ENDIF
- IOP=INDEX(CHOPT,'PSD')
- IF(IOP.GT.0)THEN
- CHOPT(IOP:IOP+3)=' '
- CHOPT2(30:32)='PSD'
- ENDIF
- IOP=INDEX(CHOPT,'FB')
- IF(IOP.GT.0)THEN
- CHOPT(IOP:IOP+1)=' '
- CHOPT2(28:29)='FB '
- ENDIF
- IOP=INDEX(CHOPT,'BB')
- IF(IOP.GT.0)THEN
- CHOPT(IOP:IOP+1)=' '
- CHOPT2(26:27)='BB'
- ENDIF
-*
- IOP=INDEX(CHOPT,'LEGO')
- IF(IOP.GT.0)THEN
- IF(LOGX.NE.0)CHOPT2(18:19)='GX'
- IF(LOGY.NE.0)CHOPT2(20:21)='GY'
- CHOPT(IOP:IOP+3)=' '
- IF(LOBAR)THEN
- CHOPT2(1:2)='LB'
- ELSE
- CHOPT2(2:2)='L'
- ENDIF
- IF(CHOPT(IOP+4:IOP+4).EQ.'1')CHOPT2(3:3)='1'
- IF(CHOPT(IOP+4:IOP+4).EQ.'2')THEN
- CHOPT2(3:3)='2'
- LOCOL=.TRUE.
- ENDIF
- D3=.TRUE.
- CALL ISPLCI(IHCOL)
- LOHBOX=.FALSE.
- IF (INDEX(CHOPT,'Z').NE.0) LOCOLZ = .TRUE.
- ENDIF
-*
- IOP=INDEX(CHOPT,'SURF')
- IF(IOP.GT.0)THEN
- IF(LOGX.NE.0)CHOPT2(18:19)='GX'
- IF(LOGY.NE.0)CHOPT2(20:21)='GY'
- CHOPT(IOP:IOP+3)=' '
- CHOPT2(3:3)='S'
- IF(CHOPT(IOP+4:IOP+4).EQ.'1')THEN
- CHOPT2(4:4)='1'
- LOCOL=.TRUE.
- ENDIF
- IF(CHOPT(IOP+4:IOP+4).EQ.'2')THEN
- CHOPT2(4:4)='2'
- LOCOL=.TRUE.
- ENDIF
- IF(CHOPT(IOP+4:IOP+4).EQ.'3')THEN
- CHOPT2(4:4)='3'
- LOCOL=.TRUE.
- ENDIF
- IF(CHOPT(IOP+4:IOP+4).EQ.'4')THEN
- CHOPT2(4:4)='4'
- LOCOL=.TRUE.
- ENDIF
- D3=.TRUE.
- CALL ISPLCI(IHCOL)
- CALL ISFACI(IHCOL)
- CALL ISLWSC(FLOAT(IHWID))
- LOHBOX=.FALSE.
- IF (INDEX(CHOPT,'Z').NE.0) LOCOLZ = .TRUE.
- ENDIF
-*
- IOP=INDEX(CHOPT,'BOX')
- IF(IOP.GT.0)THEN
- CHOPT(IOP:IOP+2) = ' '
- CHOPT2(4:4) = 'B'
- D2 = .TRUE.
- LOLOG = .TRUE.
- CALL HPLATT(1)
- ENDIF
-*
- IOP=INDEX(CHOPT,'COL')
- IF(IOP.GT.0)THEN
- CHOPT(IOP:IOP+2)=' '
- CHOPT2(5:7)='COL'
- D2=.TRUE.
- LOLOG=.TRUE.
- IF(IHTYP.EQ.3001)THEN
- PAR2(1)=1.
- ELSE
- PAR2(1)=0.
- ENDIF
- IF (INDEX(CHOPT,'Z').NE.0) LOCOLZ = .TRUE.
- ENDIF
-*
- IOP=INDEX(CHOPT,'CONT')
- IF(IOP.GT.0)THEN
- CHOPT(IOP:IOP+3)=' '
- IF(PAR2(2).EQ.3.)THEN
- CHOPT2(3:4)='C3'
- LOCOL=.TRUE.
- D3=.TRUE.
- NBLEVL=MIN(MAX(2,INT(PAR2(1))),50)
- ELSE
- CHOPT2(8:8)='C'
- PAR2(2)=PAR2(2)+(FLOAT(IHCOL)/1000.)
- D2=.TRUE.
- ENDIF
- ENDIF
-*
- IOP=INDEX(CHOPT,'ARR')
- IF(IOP.GT.0)THEN
- CHOPT(IOP:IOP+2)=' '
- CHOPT2(14:14)='R'
- D2=.TRUE.
- CALL ISPLCI(IHCOL)
- ENDIF
-*
- IOP=INDEX(CHOPT,'SCAT')
- IF(IOP.GT.0)THEN
- CHOPT(IOP:IOP+3)=' '
- CHOPT2(9:9)='P'
- D2=.TRUE.
- LOLOG=.TRUE.
- CALL ISPMCI(IHCOL)
- IF(IHOPTP.EQ.0)THEN
- IF(IHOPTT.EQ.0)THEN
- IF(RMK.NE.1.)CALL ISMK(1)
- ELSE
- IF(RMK.NE.3.)CALL ISMK(3)
- ENDIF
- ENDIF
- ENDIF
-*
- IOP=INDEX(CHOPT,'TEXT')
- IF(IOP.GT.0)THEN
- CHOPT(IOP:IOP+3)=' '
- CHOPT2(10:10)='T'
- D2=.TRUE.
- CALL ISTXCI(IHCOL)
- PAR2(1) = TVSIZ(9)
- ENDIF
-*
- IOP=INDEX(CHOPT,'CHAR')
- IF(IOP.GT.0)THEN
- CHOPT(IOP:IOP+3)=' '
- CHOPT2(11:11)='K'
- D2=.TRUE.
- CALL ISTXCI(IHCOL)
- PAR2(1) = TVSIZ(9)
- ENDIF
-*
- IOP=INDEX(CHOPT,'E')
- IF(IOP.GT.0)THEN
- CHOPT(IOP:IOP)=' '
- CHOPT2(25:25)='E'
- D3=.TRUE.
- ENDIF
-*
- IF(CHOPT2.EQ.' ')THEN
- IF(LOTAB.AND.I3.NE.0)THEN
- D2=.TRUE.
- CHOPT2='T'
- CALL ISTXCI(IHCOL)
- ELSE IF(LOCHA)THEN
- D2=.TRUE.
- CHOPT2='K'
- CALL ISTXCI(IHCOL)
- ELSE
- CALL ISPMCI(IHCOL)
- ENDIF
- IF(LOSOFT)THEN
- PAR2(1)=0.
- PAR2(2)=2.
- ELSE
- PAR2(1)=1.
- PAR2(2)=0.
- ENDIF
- ENDIF
-*
- IOP=INDEX(CHOPT,'A')
- IOPTAX=0
- IF(IOP.GT.0)THEN
- CHOPT(IOP:IOP)=' '
- IOPTAX=1
- ENDIF
-*
- IOP=INDEX(CHOPT,'S')
- IF(IOP.GT.0)THEN
- LOSAME=.TRUE.
- ELSE
- LOSAME=.FALSE.
- ENDIF
- IF(.NOT.D2.AND..NOT.D3)THEN
- D2=.TRUE.
- LOLOG=.TRUE.
- CHOPT2(9:9)='P'
- ENDIF
-*
- CHOPT2(13:13)='H'
-*
-* Initialise COMMON/HPL13/
-*
- CALL VZERO(IOPT,NOPT)
-*
- IRET=3
-*
-* Loop over all histograms in booking order
-*
- 10 CALL HLOOP(IDD,'HPLTAB',IRET)
- IF(IRET.EQ.0)GOTO 230
- CALL HDCOFL
-*
-* Check for 2 dimensional
-*
- IF(I123.EQ.0)GOTO 230
- LCONT=LQ(LCID-1)
- LSCAT=LCONT
-*
-* Check if the LOG scales are requested
-*
- IF (LOGZ.NE.0) LOGZFL = .TRUE.
- IF (I26.NE.0) LOGZFL = .TRUE.
- IF (LINZ.NE.0) LOGZFL = .FALSE.
- LOGXFL = .FALSE.
- LOGYFL = .FALSE.
- IF (LOLOG.AND.LOGX.NE.0) LOGXFL = .TRUE.
- IF (LOLOG.AND.LOGY.NE.0) LOGYFL = .TRUE.
-*
-* Fills /HPL9/ with HBOOK information
-* determines XMINI and XMAXI, YMINI and YMAXI.
-*
- ICMAX = IQ(LCID+KNCX)
- XXSIZE = (Q(LCID+KXMAX)-Q(LCID+KXMIN))/FLOAT(IQ(LCID+KNCX))
- XX0 = Q(LCID+KXMIN)
- XMINI = XX0
- XMAXI = XX0+(XXSIZE*FLOAT(ICMAX))
-*
- IF(I1.NE.0)THEN
- ICMAY = 0
- YYSIZE = 1.
- YY0 = 0.
- YMINI = 0.
- YMAXI = 1.
- ELSE
- ICMAY = IQ(LCID+KNCY)
- YYSIZE = (Q(LCID+KYMAX)-Q(LCID+KYMIN))/FLOAT(IQ(LCID+KNCY))
- YY0 = Q(LCID+KYMIN)
- YMINI = YY0
- YMAXI = YY0+(YYSIZE*FLOAT(ICMAY))
- ENDIF
-*
-* Prepare parameter for IGTABL
-*
- IF(NPAR.GT.2)THEN
- DO 20 I=3,NPAR
- PAR2(I+4) = PAR(I)
- 20 CONTINUE
- ENDIF
- NPAR2 = MAX(NPAR,2)+4
- IF (NPAR.GE.6) THEN
- IF (PAR(5).GT.0.) THEN
- IXMIN = INT(PAR(5)/1000)
- IXMAX = INT(PAR(5)-(1000*IXMIN))
- ELSEIF (PAR(5).LT.0.) THEN
- IXMIN = -PAR(5)
- IXMAX = IQUEST(60)
- ELSE
- IXMIN = 1
- IXMAX = ICMAX
- ENDIF
- IF (PAR(6).GT.0.) THEN
- IYMIN = INT(PAR(6)/1000)
- IYMAX = INT(PAR(6)-(1000*IYMIN))
- ELSEIF (PAR(6).LT.0.) THEN
- IYMIN = -PAR(6)
- IYMAX = IQUEST(61)
- ELSE
- IYMIN = 1
- IYMAX = ICMAY
- ENDIF
- XMINI = XX0+(XXSIZE*FLOAT(IXMIN-1))
- XMAXI = XX0+(XXSIZE*FLOAT(IXMAX))
- YMINI = YY0+(YYSIZE*FLOAT(IYMIN-1))
- YMAXI = YY0+(YYSIZE*FLOAT(IYMAX))
- ENDIF
- IF (XMINI.GE.XMAXI) XMAXI = XMINI+XXSIZE
- IF (YMINI.GE.YMAXI) YMAXI = YMINI+YYSIZE
- IF (LOLOG.AND.LOGX.NE.0) THEN
- IF (XMAXI.LE.0.) GOTO 30
- IF (XMINI.LE.0.) XMINI = 0.1*XXSIZE
- XMINI = LOG10(XMINI)
- XMAXI = LOG10(XMAXI)
- ENDIF
- IF (LOLOG.AND.LOGY.NE.0) THEN
- IF (YMAXI.LE.0.) GOTO 30
- IF (YMINI.LE.0.) YMINI = 0.1*YYSIZE
- YMINI = LOG10(YMINI)
- YMAXI = LOG10(YMAXI)
- ENDIF
- GOTO 40
- 30 CALL HBUG('Routine called with zero or negative argument with log
- +scale','HPLOT ',IDD)
- GOTO 230
- 40 CONTINUE
- PAR2(3) = XMINI
- PAR2(4) = XMAXI
- PAR2(5) = YMINI
- PAR2(6) = YMAXI
- IF(LOMAX.AND.I1.NE.0)PAR2(5) = SCMAX
-*
- FACTOR=1.0
- IF(I19.NE.0)FACTOR=Q(LCID+KSCAL2)
-*
-* HPLSWN defines the world coordinates and draw the histogram titles.
-* The histogram titles drawing need to be postponed (with LOUTIT) after
-* the histogram drawing because in case of 3D plots, the axis positions
-* is computed in IGTABL.
-*
- IF(NIDS.EQ.1)THEN
- CALL IZSAVA
- LUTSAV = LOUTIT
- LOUTIT = .TRUE.
- IF (D3.AND.I1.EQ.0.AND.INDEX(CHOPT2,'C3').EQ.0) THEN
- LO3DPL = .TRUE.
- ELSE
- LO3DPL = .FALSE.
- ENDIF
- CALL HPLSWN
- LOUTIT = LUTSAV
- CALL IZSETA
- ENDIF
-*
-* Store the primitive identifier in the current HIGZ picture.
-*
- IF(I1.NE.0)THEN
- CALL IGPID(1,'1d',IDD,' ')
- ELSE
- CALL IGPID(1,'2d',IDD,' ')
- ENDIF
-*
-* In case of Contour plots (CHOPTI='CONT'), PAR2(25) could be a level
-* to be drawn and should not be changed.
-*
- IF(INDEX(CHOPTI,'CONT').EQ.0)THEN
- IF(INDEX(CHOPT,'+').GT.0)THEN
- I=NIDS
- IF(I.GT.NBEL(IHLIST))THEN
- I=MOD(I,NBEL(IHLIST))
- IF(I.EQ.0)I=NBEL(IHLIST)
- ENDIF
- PAR2(25)=FLOAT(ILIST(IHLIST,I))
- NIDS=NIDS+1
- ENDIF
- IF(INDEX(CHOPT,'+').LE.0)THEN
- IF(NIDS.GT.1)THEN
- I=NIDS
- IF(I.GT.NBEL(IHLIST))THEN
- I=MOD(I,NBEL(IHLIST))
- IF(I.EQ.0)I=NBEL(IHLIST)
- ENDIF
- PAR2(25)=FLOAT(ILIST(IHLIST,I))
- ELSE
- PAR2(25)=FLOAT(IHCOL)
- ENDIF
- NIDS=1
- ENDIF
- IF(PAR2(25).EQ.1..AND.INDEX(CHOPT2,'L1').NE.0)PAR2(25)=0.
- ENDIF
-*
- CALL HPLDES(ID)
-*
-* Set up the IGTABL log options (if required).
-*
- IF(LOGZFL)CHOPT2(16:17)='GZ'
- IF(LOGXFL)CHOPT2(18:19)='GX'
- IF(LOGYFL)CHOPT2(20:21)='GY'
-*
-* ZMAX and ZMIN management
-*
- IF(I20.NE.0.OR.I21.NE.0.OR.NPAR.GE.4)THEN
- NPAR2=MAX(8,NPAR2)
- IF(I20.NE.0.OR.I21.NE.0)THEN
- IF(I1.NE.0)THEN
- PAR2(7)=HCX(1,1)
- LOOPY=1
- ELSE
- PAR2(7)=HCXY(1,1,1)
- LOOPY=ICMAY
- ENDIF
- PAR2(8)=PAR2(7)
- DO 60 J=1,LOOPY
- DO 50 I=1,ICMAX
- IF(I1.NE.0)THEN
- Z=HCX(I,1)
- ELSE
- Z=HCXY(I,J,1)
- ENDIF
- PAR2(7)=MIN(PAR2(7),Z)
- PAR2(8)=MAX(PAR2(8),Z)
- 50 CONTINUE
- 60 CONTINUE
- IF(I21.NE.0)THEN
- IF(I1.NE.0)THEN
- PAR2(7)=Q(LCID+KMIN1)
- IF(I20.EQ.0)PAR2(8)=1.1*PAR2(8)
- ELSE
- PAR2(7)=Q(LCID+KMIN2)
- ENDIF
- ENDIF
- IF(I20.NE.0)THEN
- IF(I1.NE.0)THEN
- PAR2(8)=Q(LCID+KMAX1)
- ELSE
- PAR2(8)=Q(LCID+KMAX2)
- ENDIF
- ENDIF
- GOTO 70
- ENDIF
- IF(NPAR.GE.4)THEN
- PAR2(7)=PAR(3)
- PAR2(8)=PAR(4)
- ENDIF
- ENDIF
- 70 CONTINUE
-*.______________________________________
-*
-* If fit parameters exist and are requested, get them.
-*
- LVALUE = .FALSE.
- LPARAM = .FALSE.
- IF(INDEX(CHOPTI,'FUNC').NE.0.OR.D2)THEN
- IF(IQ(LCONT-2).EQ.0)GO TO 150
- LFUNC=LQ(LCONT-1)
- IF(LFUNC.EQ.0)GO TO 150
- IF(IQ(LFUNC-2).EQ.0)GO TO 150
-*
-* There is an LFUNC bank with function values.
-*
- LVALUE = .TRUE.
- LHFIT =LQ(LFUNC-1)
- IF(LHFIT.NE.0)THEN
-*
-* There is also an LHFIT bank with function parameters.
-*
- IFITTY=IQ(LHFIT+1)
- NFPAR=IQ(LHFIT+2)
- IF(NFPAR.LE.0)THEN
- GO TO 150
- ELSE
- LPARAM = .TRUE.
- NPFITS=IQ(LHFIT+3)
- NOTHER=IQ(LHFIT+4)
- FITCHI=Q(LHFIT+6)
- IF(IFITTY.EQ.4)THEN
- CALL HQGETF(LHFIT)
- ELSE
- NP=MIN(NFPAR,35)
- II=11
- DO 80 I=1,NP
- CALL UCOPY(Q(LHFIT+II),SS,NWW)
- FITPAR(I)=SS
-* Note: FITPAR is only single precision.
- II=II+NWW
- 80 CONTINUE
- NWERR=IQ(LHFIT-1)-NWW*(NFPAR+NOTHER)
- IF(NWERR.GT.0)THEN
- II=IQ(LHFIT-1)-NWERR+1
- DO 90 I=1,NP
- CALL UCOPY(Q(LHFIT+II),SS,NWW)
- FITPAD(I)=SS
- FITSIG(I)=SS
-* Note: FITSIG is only single precision.
- II=II+NWW
- 90 CONTINUE
- ELSE
- CALL VZERO(FITSIG,NP)
- ENDIF
-* Get names if available, otherwise generate from IFITTY.
- DO 100 I=1,NP
- FITNAM(I)=' '
- 100 CONTINUE
- IF(IFITTY.EQ.1)THEN
-* Polynomial.
- N1=MAX(NP,10)
- DO 110 I=1,N1
- WRITE(FITNAM(I),'(''A'',I1,6X)')I-1
- 110 CONTINUE
- IF(NP.GT.10)THEN
- DO 120 I=11,NP
- WRITE(FITNAM(I),'(''A'',I2,5X)')I-1
- 120 CONTINUE
- END IF
- ELSE IF(IFITTY.EQ.2)THEN
-* Exponential.
- FITNAM(1)='Constant'
- FITNAM(2)='Slope'
- ELSE IF(IFITTY.EQ.3)THEN
-* Gaussian.
- FITNAM(1)='Constant'
- FITNAM(2)='Mean'
- FITNAM(3)='Sigma'
- ELSE IF(IFITTY.NE.4)THEN
- L=LQ(LHFIT)
- 130 CONTINUE
- IF(L.NE.0)THEN
- CALL UHTOC(IQ(L-4),4,NAME,4)
- IF(NAME.EQ.'HFNA')THEN
- DO 140 I=1,NP
- CALL UHTOC(Q(L+2*I-1),4,FITNAM(I),8)
- 140 CONTINUE
- ELSE
- GO TO 130
- END IF
- END IF
- END IF
- END IF
-* Get covariances if required and when available.
- END IF
- END IF
- 150 CONTINUE
- END IF
-*.______________________________________
-*
-* Draw 3D representations
-*
- IF(D3)THEN
- DO 160 I=NPAR2+1,10
- PAR2(I)=0.
- 160 CONTINUE
- IF(PAR2(9).EQ.0..AND.PAR2(10).EQ.0..AND.
- + ICMAX.LT.1000.AND.ICMAY.LT.1000)THEN
- PAR2(9) =FLOAT(1000+ICMAX)
- IF(I1.NE.0)THEN
- PAR2(10)=0.
- ELSE
- PAR2(10)=FLOAT(1000+ICMAY)
- ENDIF
- ENDIF
- CALL HPLAX2(PAR2(11))
- NPAR2=25
-*
-* Initialize the color level if needed (LOCOL = .TRUE.)
-*
- IF(LOCOL)THEN
- IF(CHOPT2(3:4).NE.'C3')NBLEVL=NBEL(IHLIST)
- DO 170 I=1,NBLEVL
- J=MOD(I,NBEL(IHLIST))
- IF(J.EQ.0)J=NBEL(IHLIST)
- PAR2(24+I)=FLOAT(ILIST(IHLIST,J))
- 170 CONTINUE
- NPAR2=24+NBLEVL
- ENDIF
-*
-* Contour with colours. This option needs 3D drawing but 2D axis.
-* THETA=90, PHI=0., and NDVX=0.
-*
- IF(CHOPT2(3:4).EQ.'C3')THEN
- PAR2(1) = 90.
- PAR2(2) = 0.
- PAR2(11) = 0.
- CHOPT2(3:4) = 'S2'
- D2=.TRUE.
- ENDIF
-*
-* Suppress the Axis if required
-*
- IF(IOPTAX.NE.0)PAR2(11)=0.
-*
-* Draw the 3D table accoding to CHOPT2
-*
- IF(INDEX(CHOPTI,'FUNC').NE.0.AND.LVALUE)THEN
-* Plot function - for details see 2-D.
- CHOPT = CHOPT2
- III = INDEX(CHOPT,'H')
- IF (III .NE. 0) CHOPT (III:III) = ' '
- IF(LPARAM)THEN
- DXXX = (XMAXI - XMINI) / NVFIT
- DYYY = (YMAXI - YMINI) / NVFIT
- DO 190 IX = 1, NVFIT
- XXX = XMINI + (IX - 0.5) * DXXX
- DO 180 IY = 1, NVFIT
- YYY = YMINI + (IY - 0.5) * DYYY
- IF (IFITTY.EQ.4) VFIT (IX, IY) = HQF (VVV)
- 180 CONTINUE
- 190 CONTINUE
- PAR2 (9) = 1000 + NVFIT
- PAR2 (10) = 1000 + NVFIT
- CALL IGTABL(NVFIT,NVFIT,VFIT,NPAR2,PAR2,CHOPT)
- ELSE
- CALL IGTABL(ICMAX,ICMAY,Q(LFUNC+5),NPAR2,PAR2,CHOPT)
- END IF
- ELSE
- CALL IGTABL(ICMAX,ICMAY,FLOAT(LSCAT),NPAR2,PAR2,CHOPT2)
- ENDIF
- ENDIF
-*.______________________________________
-*
-* Draw 2D representations
-*
- IF(D2)THEN
-*
-* Draw the 2D table accoding to CHOPT2
-*
- IF(INDEX(CHOPTI,'FUNC').EQ.0)THEN
- IF(IQ(LCONT+KNOENT).NE.0.AND..NOT.D3)THEN
- CALL IGTABL(ICMAX,ICMAY,FLOAT(LSCAT),NPAR2,PAR2,CHOPT2)
- CALL HPLU(IDD,2)
- ENDIF
- ENDIF
-*
-* Draw the 2D fit
-*
- IF(INDEX(CHOPTI,'HIST').EQ.0.AND.LVALUE)THEN
- IF(INDEX(CHOPTI,'FUNC').NE.0)THEN
- CHOPT = CHOPT2
- ELSE
- PAR2(1)=20.
- PAR2(2)=0.
- CHOPT = 'C'
- ENDIF
- III = INDEX(CHOPT,'H')
- IF (III .NE. 0) CHOPT (III:III) = ' '
- IF(LPARAM)THEN
-*
-* Plot function from parameters.
-*
-* IFITTY = 1 --> Polynomial (not implemented for 2-D)
-* IFITTY = 2 --> Exponential (not implemented for 2-D)
-* IFITTY = 3 --> Gaussian (not implemented for 2-D)
-* IFITTY = 4 --> Multiquadric
-*
- DXXX = (XMAXI - XMINI) / NVFIT
- DYYY = (YMAXI - YMINI) / NVFIT
- DO 210 IX = 1, NVFIT
- XXX = XMINI + (IX - 0.5) * DXXX
- DO 200 IY = 1, NVFIT
- YYY = YMINI + (IY - 0.5) * DYYY
- IF (IFITTY.EQ.4) VFIT (IX, IY) = HQF (VVV)
- 200 CONTINUE
- 210 CONTINUE
- IF (NPAR2 .GE. 10) THEN
- PAR2 (9) = 1000 + NVFIT
- PAR2 (10) = 1000 + NVFIT
- END IF
- CALL IGTABL(NVFIT,NVFIT,VFIT,NPAR2,PAR2,CHOPT)
- ELSE
-*
-* Plot function from values.
-*
- CALL IGTABL(ICMAX,ICMAY,Q(LFUNC+5),NPAR2,PAR2,CHOPT)
- END IF
- END IF
-*
-* Draw the 2D Axis
-*
- IF(.NOT.LOSAME) THEN
- COORD(1) = XMINI
- COORD(3) = XMAXI
- COORD(4) = YMINI
- COORD(5) = YMAXI
- COORD(2) = COORD(1)
- COORD(6) = COORD(4)
- IF(IOPTAX.EQ.0)THEN
- LOZOOM = .TRUE.
- IF(NPAR.GE.6)THEN
- NCMIN = IXMIN
- NCMAX = IXMAX
- Y1ZOOM = IYMIN
- Y2ZOOM = IYMAX
- ELSE
- NCMIN = 1
- NCMAX = ICMAX
- Y1ZOOM = 1
- Y2ZOOM = ICMAY
- ENDIF
- CALL HPLAXI(COORD(1),COORD(4),1)
- LOZOOM = .FALSE.
- ENDIF
- ENDIF
- ENDIF
-*
-* Draw the color map
-*
- IF (LOCOLZ) THEN
- CHOPT2 = ' '
-*
-* Set the color indeces
-*
- CALL IGQ('NCOL',RVAL)
- INBCOL = INT(RVAL)
- IF (INBCOL.GT.8) THEN
- IC1 = 8
- IC2 = INBCOL
- ELSE
- IC1 = 0
- IC2 = 7
- ENDIF
-*
-* Axis font
-*
- KFONT = IABS(IHFONT(3))
- IAXFON = KFONT/10
- IAXPRE = MOD(KFONT,10)
- IF(IHFONT(3).LT.0)IAXFON = -IAXFON
- CALL ISTXFP(IAXFON,IAXPRE)
-*
-* The color map is drawn in cm coordinates.
-*
- NTOLD = NTWIN
- CALL ISELNT(1)
- IF (ICOLMP.EQ.2) THEN
- X1MAP = XLOW
- X2MAP = XHIGH
- Y1MAP = YHIGH+CMMG
- Y2MAP = YHIGH+CWID+CMMG
- CHOPT2(1:1) = 'H'
- CHOPT2(8:8) = 'T'
- ELSEIF (ICOLMP.EQ.3) THEN
- X1MAP = XLOW-CWID-CMMG
- X2MAP = XLOW-CMMG
- Y1MAP = YLOW
- Y2MAP = YHIGH
- CHOPT2(1:1) = 'R'
- ELSEIF (ICOLMP.EQ.4) THEN
- X1MAP = XLOW
- X2MAP = XHIGH
- Y1MAP = YLOW-CWID-CMMG
- Y2MAP = YLOW-CMMG
- CHOPT2(1:1) = 'H'
- ELSE
- X1MAP = XHIGH+CMMG
- X2MAP = XHIGH+CWID+CMMG
- Y1MAP = YLOW
- Y2MAP = YHIGH
- ENDIF
-*
- CALL IGSET('LASI',TVSIZ(7))
- CALL IGSET('LAOF',CLVAL)
- Z1 = RQUEST(11)
- Z2 = RQUEST(12)
- CHOPT2(2:3) = 'CA'
- IF (LOGZFL) THEN
- Z1 = 10.**Z1
- Z2 = 10.**Z2
- CHOPT2(2:4) = 'CAG'
- ENDIF
- IF (D3) THEN
- NBCOL=MIN(NBEL(IHLIST),MXLIST)
- DO 220 I=1,NBCOL
- ICMAP(I) = ILIST(IHLIST,i)
- 220 CONTINUE
- CHOPT2(5:5) = 'P'
- CALL IGCOLM (X1MAP,X2MAP,Y1MAP,Y2MAP,J,ICMAP,Z1,Z2,CHOPT2)
- ELSE
- CALL IGCOLM(X1MAP,X2MAP,Y1MAP,Y2MAP,IC1,IC2,Z1,Z2,CHOPT2)
- ENDIF
- CALL ISELNT(NTOLD)
- ENDIF
-*
- IRET=2
- CALL IGSET('TXCI',RTXCI)
- IF((LOSTAT).AND.(.NOT.LOSAME))CALL HPLSTA(IDD,'HIST',1)
- IF((LOTIC).AND.(.NOT.LOSAME).AND.D2)
- + CALL HPLWIR(' ',BIGP,BIGP,'TICK')
- CALL HPLFIL
- CALL HPLDAT
- IF (.NOT.LOUTIT.AND..NOT.LOSAME) CALL HPLTIT(' ')
- GOTO 10
-*
- 230 LOSAME=.FALSE.
- LOHBOX=.TRUE.
- IF(IHOPTP.EQ.0)THEN
- IF(IHOPTT.EQ.0)THEN
- IF(RMK.NE.1.)CALL IGSET('MTYP',RMK)
- ELSE
- IF(RMK.NE.3.)CALL IGSET('MTYP',RMK)
- ENDIF
- ENDIF
- CALL IGSET('LWID',RLWID)
- CALL IGSET('FAIS',RFAIS)
- CALL IGSET('FASI',RFASI)
- CALL IGSET('FACI',RFACI)
- CALL IGSET('PLCI',RPLCI)
- CALL IGSET('PMCI',RPMCI)
- CALL IGSET('BORD',RBORD)
-*
- END
diff --git a/src/graflib/hplot/hplotf77/hpltit.F b/src/graflib/hplot/hplotf77/hpltit.F
deleted file mode 100644
index 5345b5f..0000000
--- a/src/graflib/hplot/hplotf77/hpltit.F
+++ /dev/null
@@ -1,115 +0,0 @@
-*
-* $Id: hpltit.F,v 1.1.1.1 1996/01/19 10:50:11 mclareni Exp $
-*
-* $Log: hpltit.F,v $
-* Revision 1.1.1.1 1996/01/19 10:50:11 mclareni
-* Hplot
-*
-*
-#include "hplot/pilot.h"
-*CMZ : 5.20/00 19/04/95 10.26.37 by O.Couet
-*-- Author :
- SUBROUTINE HPLTIT(CHHTIT)
-*.==========>
-*. Draws histogram title or user supplied title
-*. (Cm are used for call to HPLTXT)
-*..=========>
-#include "hbook/hcbook.inc"
-#include "hbook/hcbits.inc"
-#include "hplot/hpl2.inc"
-#include "hplot/hpl4.inc"
-#include "hplot/hpl6.inc"
-#include "hplot/hplstr.inc"
- CHARACTER*(*) CHHTIT
- DIMENSION ITIT(2)
- DIMENSION RTXFP(2)
-*._____________________________
-*
- TVTIT = TVSIZ(3)
- CALL IGQ('TXFP',RTXFP)
-*----
-* Set histogram Title font and precision
-*----
- NTWOLD = NTWIN
- KFONT = IABS(IHFONT(1))
- ITXFON = KFONT/10
- ITXPRE = MOD(KFONT,10)
- IF(IHFONT(1).LT.0)ITXFON = -ITXFON
- CALL ISTXFP(ITXFON,ITXPRE)
-*
- IF(CHHTIT.NE.' ')THEN
- CHTEMP = CHHTIT
- GOTO 10
- ENDIF
-*-----
-* If CHHTIT = ' ', the histogram title is taken from the
-* histogram data structure. The maximum length of the title
-* is ISTRSZ characters (HPLOT limitation)
-*-----
- J1 = KTIT1
- IF(I230.NE.0)J1 = KTIT2
- NCHR = (IQ(LCID-1)-J1+1)*4
- IF(NCHR.EQ.0)GOTO 999
- NCHR = MIN(NCHR,ISTRSZ)
- CHTEMP = ' '
- CALL UHTOC(IQ(LCID+J1),4,CHTEMP,NCHR)
-*----
-* Automatic calculation of character size if
-* TVSIZ(3) (TSIZ) equal to 0.
-* (0.28 is a maximum value, unless the user sets
-* it with SET TSIZ).
-*----
- 10 NBCHAR = LENOCC(CHTEMP)
- IF(NBCHAR.EQ.0)GOTO 999
- IF(TVSIZ(3).EQ.0.)THEN
- TVSIZ(3) = (XHIGH-XLOW)/NBCHAR
- IF(TVSIZ(3).GT.0.28)TVSIZ(3) = 0.28
- ENDIF
-*----
-* Decode the title to find if some axis title are required.
-* The histogram title can have the format:
-* 'histo_title ; X_axis_title ; Y_axis_title ; Z_axis_title'
-* The position of each ';' is returned in ITIT.
-*----
- J = 0
- ITIT(1) = 0
- ITIT(2) = 0
- DO 20 I=1,NBCHAR
- IF(CHTEMP(I:I).EQ.';')THEN
- J = J+1
- IF(J.EQ.3)GOTO 30
- ITIT(J) = MAX(I-1,0)
- ENDIF
- 20 CONTINUE
- 30 IF (J.EQ.0) THEN
- ITIT(1) = NBCHAR
- ITIT(2) = NBCHAR
- ELSEIF (J.LT.2) THEN
- IF (NBCHAR.GT.ITIT(J)+1) THEN
- ITIT(J+1) = NBCHAR
- ENDIF
- ENDIF
-*
- IF (ITIT(1).GE.1) THEN
- XK = 0.5*(XHIGH+XLOW)
- YK = YLOW-YHTIT-TVSIZ(3)
- CALL HPLTXT(XK,YK,CHTEMP(1:ITIT(1)),3,1,2)
- ENDIF
- IF (ITIT(2).GE.ITIT(1)+2) THEN
- CALL HPLAX(CHTEMP(ITIT(1)+2:ITIT(2)),' ')
- ENDIF
- IF (NBCHAR .GE.ITIT(2)+2) THEN
- CALL HPLAX(' ',CHTEMP(ITIT(2)+2:NBCHAR))
- ENDIF
-*
- TVSIZ(3) = TVTIT
-*----
-* Reset NT
-*----
- IF(NTWIN.NE.NTWOLD)THEN
- NTWIN = NTWOLD
- CALL ISELNT(NTWOLD)
- ENDIF
-*
- 999 CALL ISTXFP(INT(RTXFP(1)),INT(RTXFP(2)))
- END
diff --git a/src/graflib/hplot/hplotf77/hpltoc.F b/src/graflib/hplot/hplotf77/hpltoc.F
deleted file mode 100644
index 0725b92..0000000
--- a/src/graflib/hplot/hplotf77/hpltoc.F
+++ /dev/null
@@ -1,54 +0,0 @@
-*
-* $Id: hpltoc.F,v 1.1.1.1 1996/01/19 10:50:11 mclareni Exp $
-*
-* $Log: hpltoc.F,v $
-* Revision 1.1.1.1 1996/01/19 10:50:11 mclareni
-* Hplot
-*
-*
-#include "hplot/pilot.h"
-*CMZ : 5.18/00 01/11/93 10.09.36 by O.Couet
-*-- Author :
- SUBROUTINE HPLTOC(X,Y,XCM,YCM,NT)
-*.==========>
-*. Converts X and Y coordinates in the current transformation
-*. to cm.
-*..=========>
-#include "hplot/hpl1.inc"
- DIMENSION RWIN(4),RVP(4)
-*._____________________________
-*
- CALL IGQWK(1,'NTNB',RNT)
- CALL IGQWK(1,'NTWN',RWIN)
- CALL IGQWK(1,'NTVP',RVP)
- NT=INT(RNT)
-*
- IF(NT.EQ.1)THEN
- XCM=X
- YCM=Y
- ELSE
- IF(.NOT.LOGXFL)THEN
- DX=X-RWIN(1)
- ELSE
- IF(X.LE.0.)GOTO 10
- DX=LOG10(X)-RWIN(1)
- ENDIF
- IF(.NOT.LOGYFL)THEN
- DY=Y-RWIN(3)
- ELSE
- IF(Y.LE.0.)GOTO 10
- DY=LOG10(Y)-RWIN(3)
- ENDIF
- XVP=((RVP(2)-RVP(1))*DX)/(RWIN(2)-RWIN(1))+RVP(1)
- YVP=((RVP(4)-RVP(3))*DY)/(RWIN(4)-RWIN(3))+RVP(3)
- CALL ISELNT(1)
- CALL IGQWK(1,'NTWN',RWIN)
- CALL IGQWK(1,'NTVP',RVP)
- XCM=((XVP-RVP(1))*(RWIN(2)-RWIN(1)))/(RVP(2)-RVP(1))+RWIN(1)
- YCM=((YVP-RVP(3))*(RWIN(4)-RWIN(3)))/(RVP(4)-RVP(3))+RWIN(3)
- CALL ISELNT(NT)
- ENDIF
- RETURN
-*
- 10 CALL HBUG('Illegal coordinate in Log scale','HPLTOC',0)
- END
diff --git a/src/graflib/hplot/hplotf77/hpltx1.F b/src/graflib/hplot/hplotf77/hpltx1.F
deleted file mode 100644
index 31c74c9..0000000
--- a/src/graflib/hplot/hplotf77/hpltx1.F
+++ /dev/null
@@ -1,59 +0,0 @@
-*
-* $Id: hpltx1.F,v 1.1.1.1 1996/01/19 10:50:11 mclareni Exp $
-*
-* $Log: hpltx1.F,v $
-* Revision 1.1.1.1 1996/01/19 10:50:11 mclareni
-* Hplot
-*
-*
-#include "hplot/pilot.h"
-*CMZ : 5.18/01 03/11/93 08.59.34 by O.Couet
-*-- Author :
- SUBROUTINE HPLTX1(KTYP,KORNT)
-*.==========>
-*. Checks various types of character strings to ensure they
-*. do not go outside certain limits.
-*..=========>
-#include "hplot/hpl2.inc"
-#include "hplot/hpl4.inc"
-*._____________________________
- GOTO (999,10,20,30,40,999,999,999,50),KTYP
-*----
-* Global title
-*----
- 10 CONTINUE
- X1=0
- X2=XSIZ
- GOTO 900
-*----
-* Histogram title
-*----
- 20 X1=XLOW
- X2=XHIGH
- GOTO 900
-*----
-* Axis labels
-*----
- 30 IF(KORNT.EQ.1)THEN
- X1=XLOW
- X2=XHIGH
- ELSE
- X1=YLOW
- X2=YHIGH
- ENDIF
- GOTO 900
-*----
-* Comments
-*----
- 40 CONTINUE
- X1=0
- X2=XSIZ
- GOTO 900
-*----
-* Characters and numbers for scatter plots and tables
-*----
- 50 GOTO 999
-*
- 900 CONTINUE
-*
- 999 END
diff --git a/src/graflib/hplot/hplotf77/hpltxt.F b/src/graflib/hplot/hplotf77/hpltxt.F
deleted file mode 100644
index b5ed66d..0000000
--- a/src/graflib/hplot/hplotf77/hpltxt.F
+++ /dev/null
@@ -1,87 +0,0 @@
-*
-* $Id: hpltxt.F,v 1.1.1.1 1996/01/19 10:50:11 mclareni Exp $
-*
-* $Log: hpltxt.F,v $
-* Revision 1.1.1.1 1996/01/19 10:50:11 mclareni
-* Hplot
-*
-*
-#include "hplot/pilot.h"
-*CMZ : 5.20/00 19/04/95 10.27.47 by O.Couet
-*-- Author :
- SUBROUTINE HPLTXT(X,Y,CHTXT,KTYP,KORNT,KFLG)
-*.==========>
-*. General text writing routine
-*. (Transformation no1 cm is selected)
-*..=========>
-#include "hplot/hpl2.inc"
-#include "hplot/hpl6.inc"
- CHARACTER*(*) CHTXT
- DIMENSION RTXAL(2)
-*._____________________________
-*
-*----
-* Cm are used
-*----
- IF(NTWIN.NE.1)CALL ISELNT(1)
- NTWIN = 1
- NCHR = LENOCC(CHTXT)
- IF (NCHR.EQ.0) RETURN
-*
- CALL IGQ('CHHE',RCHHE)
- CALL IGQ('TXAL',RTXAL)
- CALL IGQ('TANG',RTANG)
-*----
-* Character size
-*----
- SZ=TVSIZ(KTYP)
- CALL ISCHH(SZ)
-*----
-* Text adjustment :
-* test if text is to be centred/moved
-*----
- IALV=0
-*
-* Left adjusted
-*
- IF(KFLG.EQ.1)THEN
- IALH=0
-*
-* Centered
-*
- ELSE IF(KFLG.EQ.2)THEN
- IALH=2
-*
-* Right adjusted
-*
- ELSE IF(KFLG.EQ.3)THEN
- IALH=3
- ENDIF
- CALL ISTXAL(IALH,IALV)
-*----
-* Text orientation
-*----
- IF(KORNT.EQ.1)THEN
- CALL ISCHUP(0.,1.)
- ELSEIF(KORNT.EQ.2)THEN
- CALL ISCHUP(-1.,0.)
- ELSEIF(KORNT.EQ.3)THEN
- CALL ISCHUP(0.,-1.)
- ELSEIF(KORNT.EQ.4)THEN
- CALL ISCHUP(1.,0.)
- ENDIF
-*----
-* Verify text length
-* if too long text is truncated
-*----
- 80 GOTO (82,81,81,81,81,82,82,82,81),KTYP
- 81 CALL HPLTX1(KTYP,KORNT)
- 82 CONTINUE
-*
- CALL ITX(X,Y,CHTXT(1:NCHR))
-*
- CALL IGSET('CHHE',RCHHE)
- CALL ISTXAL(INT(RTXAL(1)),INT(RTXAL(2)))
- CALL IGSET('TANG',RTANG)
-*
- END
diff --git a/src/graflib/hplot/hplotf77/hplu.F b/src/graflib/hplot/hplotf77/hplu.F
deleted file mode 100644
index 1901161..0000000
--- a/src/graflib/hplot/hplotf77/hplu.F
+++ /dev/null
@@ -1,47 +0,0 @@
-*
-* $Id: hplu.F,v 1.1.1.1 1996/01/19 10:50:11 mclareni Exp $
-*
-* $Log: hplu.F,v $
-* Revision 1.1.1.1 1996/01/19 10:50:11 mclareni
-* Hplot
-*
-*
-#include "hplot/pilot.h"
-*CMZ : 5.04/12 19/01/89 09.42.31 by O.Couet
-*-- Author :
- SUBROUTINE HPLU(ID,JTYPE)
-*.==========>
-*. a call is done to HPLUSR
-*. after each plot.
-*. trap recursive calls to
-* HPLOT via HPLUSR
-*..=========>
-#include "hbook/hcbits.inc"
-#include "hplot/hpl1.inc"
- LOGICAL LTWICE
- SAVE LTWICE
- CHARACTER*4 KICASE(9),KCASE
- DATA KICASE/'1DIM','2DIM','PROX','PROY',
- + 'SLIX','SLIY','BANX','BANY','FUNC'/
- DATA LTWICE/.FALSE./
-*._____________________________
-*----
-* the variable 'LTWICE' is used to trap recursive calls to
-* HPLOT via HPLUSR
-*----
- IF(.NOT.LTWICE)THEN
- KID=1
- IF(LOZERO) KID=0
- KCASE=KICASE(JTYPE)
- IF(I3.NE.0) KCASE='TABL'
- LTWICE=.TRUE.
- CALL HPLUSR(ID,KCASE,KID)
- LTWICE=.FALSE.
- ELSE
- CALL HBUG('HPLOT called from HPLUSR : Program terminated',
- + 'HPLUSR',0)
- CALL HPLEND
- STOP
- ENDIF
- END
-
diff --git a/src/graflib/hplot/hplotf77/hplusr.F b/src/graflib/hplot/hplotf77/hplusr.F
deleted file mode 100644
index c973df5..0000000
--- a/src/graflib/hplot/hplotf77/hplusr.F
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: hplusr.F,v 1.1.1.1 1996/01/19 10:50:12 mclareni Exp $
-*
-* $Log: hplusr.F,v $
-* Revision 1.1.1.1 1996/01/19 10:50:12 mclareni
-* Hplot
-*
-*
-#include "hplot/pilot.h"
-*CMZ : 5.04/12 16/01/89 12.08.26 by O.Couet
-*-- Author :
- SUBROUTINE HPLUSR(ID,ICASE,KID)
-*.==========>
-*. this subroutine is supplied as a dummy user routine,so it
-*. can be replaced by the user if required. it is called during
-*. processing of calls to HPLOT/HPLSUR/HPL3D
-*. and is called after each histogram has been plotted. this
-*. enables the user to specify his own axis titles etc. even
-*. with HPLOT(0)
-*.
-*. KID=0 if HPLOT(0)/HPLSUR(0)/HPL3D(0) called
-*. =1 if a specific id has been requested e.g. CALL HPLOT(220)
-*..=========>
- CHARACTER*4 ICASE
-*._____________________________
-*
- END
-
-
diff --git a/src/graflib/hplot/hplotf77/hplwin.F b/src/graflib/hplot/hplotf77/hplwin.F
deleted file mode 100644
index aef4ebe..0000000
--- a/src/graflib/hplot/hplotf77/hplwin.F
+++ /dev/null
@@ -1,15 +0,0 @@
-*
-* $Id: hplwin.F,v 1.1.1.1 1996/01/19 10:50:12 mclareni Exp $
-*
-* $Log: hplwin.F,v $
-* Revision 1.1.1.1 1996/01/19 10:50:12 mclareni
-* Hplot
-*
-*
-#include "hplot/pilot.h"
-*CMZ : 5.17/07 27/09/93 11.23.40 by O.Couet
-*-- Author :
- SUBROUTINE HPLWIN(IX,IY,IW,KIC)
- CALL IGERR('HPLWIN is now called HPLZON',' ')
- CALL HPLZON(IX,IY,IW,KIC)
- END
diff --git a/src/graflib/hplot/hplotf77/hplwir.F b/src/graflib/hplot/hplotf77/hplwir.F
deleted file mode 100644
index afe21ee..0000000
--- a/src/graflib/hplot/hplotf77/hplwir.F
+++ /dev/null
@@ -1,471 +0,0 @@
-*
-* $Id: hplwir.F,v 1.2 2001/12/07 15:19:56 couet Exp $
-*
-* $Log: hplwir.F,v $
-* Revision 1.2 2001/12/07 15:19:56 couet
-* - use higz include files from the higz include file directory.
-* option Z is now working in hplaer.F
-* option Z has been implemented in hplsym.F
-*
-* Revision 1.1.1.1 1996/01/19 10:50:12 mclareni
-* Hplot
-*
-*
-#include "hplot/pilot.h"
-*CMZ : 5.20/00 19/04/95 10.26.37 by O.Couet
-*-- Author :
- SUBROUTINE HPLWIR(CHOPT,XXVAL,YYVAL,KIMARK)
-*.==========>
-*. Routine to draw cross-wires and optionally tick-marks
-*. on the plot
-*. (Transformation NTHIST is selected.)
-*..=========>
-#include "hplot/hpl1.inc"
-#include "hplot/hpl2.inc"
-#include "hplot/hpl4.inc"
-#include "hplot/hpl6.inc"
-#include "hplot/hpl9.inc"
-#include "hbook/hcprin.inc"
-#include "hbook/hcbook.inc"
-#include "higz/hilabs.inc"
-#include "hbook/hcflag.inc"
- PARAMETER (LABLEN=32)
- INTEGER CX,CY
- CHARACTER*10 CHAXI,CHAXI1
- CHARACTER*(*) CHOPT,KIMARK
- DIMENSION RTXFP(2)
- DIMENSION IOPT(7)
- EQUIVALENCE (IOPTX ,IOPT(1)),(IOPTY ,IOPT(2))
- EQUIVALENCE (IOPTA ,IOPT(3)),(IOPTB ,IOPT(4))
- EQUIVALENCE (IOPTL ,IOPT(5)),(IOPTR ,IOPT(6))
- EQUIVALENCE (IOPTW ,IOPT(7))
- DIMENSION XAX(2),YAX(2)
- EQUIVALENCE (XAX1,XAX(1)),(XAX2,XAX(2))
- EQUIVALENCE (YAX1,YAX(1)),(YAX2,YAX(2))
- LOGICAL LTICK
-*._____________________________
-*
-* Prepare the NDIV parameters
-*
- NDIVX=INT(RDIVX)
- NDIVY=INT(RDIVY)
- RDIVXA=ABS(RDIVX)
- RDIVYA=ABS(RDIVY)
- IX=100*(RDIVXA+0.005)
- IY=100*(RDIVYA+0.005)
- NX=INT(10*RDIVXA-10*IABS(NDIVX))
- NY=INT(10*RDIVYA-10*IABS(NDIVY))
- CX=IX-100*IABS(NDIVX)-10*NX
- CY=IY-100*IABS(NDIVY)-10*NY
- LW=LABLEN/4
-*
-* Optimize the number of divisions as a
-* function of ZONE numbers
-*
- IF(IXWIN.GT.1.AND.RDIVX.GT.0)THEN
- NX2=INT(NDIVX/100)
- NX1=MAX(NDIVX-(100*NX2),1)
- NDIVX=(100*NX2)+(NX1/IXWIN)
- ENDIF
- IF(IYWIN.GT.1.AND.RDIVY.GT.0)THEN
- NY2=INT(NDIVY/100)
- NY1=MAX(NDIVY-(100*NY2),1)
- NDIVY=(100*NY2)+(NY1/((IYWIN+1)/2))
- ENDIF
-*----
-* Transformation NTHIST is selected
-*----
- IF(NTWIN.NE.NTHIST)THEN
- CALL ISELNT(NTHIST)
- NTWIN=NTHIST
- ENDIF
-*
- CALL IGQ('TXCI',RTXCI)
- CALL IGQ('TXFP',RTXFP)
- CALL IGQ('PLCI',RPLCI)
- CALL IGQ('LWID',RLWID)
- CALL ISLN(1)
- CALL ISPLCI(IBCOL)
- CALL ISCLIP(0)
-*
- NARG=4
- CALL NOARG(NARG)
- NARG=MIN(NARG,4)
-*----
-* Set up defaults
-*----
- LTICK=.FALSE.
- XVAL=0.
- YVAL=0.
- IF(NARG.GT.4)NARG=4
- GOTO (40,30,20,10),NARG
-*
- 10 IF(KIMARK(1:1).EQ.'T')LTICK=.TRUE.
-*
- 20 YVAL=FLOARG(YYVAL)
-*
- 30 XVAL=FLOARG(XXVAL)
-*
- 40 CONTINUE
-*----
-* Decode options
-*----
- CALL UOPTC(CHOPT,'XYABLRW',IOPT)
- IF(CHOPT.EQ.' ')THEN
- IOPTX=1
- IOPTY=1
- ENDIF
-*----
-*. Initialization of axis attributes
-*-----
- RTX=(XWMAXI-XWMINI)/(XHIGH-XLOW)
- RTY=(YWMAXI-YWMINI)/(YHIGH-YLOW)
-*
-* Set axis label size
-*
- ALSIZ=TVSIZ(7)*RTY
- CALL IGSET('LASI',ALSIZ)
-*
-* Set axis value font and precision
-*
- KFONT = IABS(IHFONT(3))
- IAXFON = KFONT/10
- IAXPRE = MOD(KFONT,10)
- IF(IHFONT(3).LT.0)IAXFON = -IAXFON
- CALL ISTXFP(IAXFON,IAXPRE)
-*
-* Calculate axis ticks mark
-*
- YTISIZ=YLTICK*RTX
- XTISIZ=XLTICK*RTY
-*
-* Calculate axis label distance
-*
- YALDIS=XLVAL*RTX
- XALDIS=YLVAL*RTY
-*----
-* Test if cross-wires required perpendicular to x-axis
-*----
- IF(IOPTX.EQ.0) GOTO 70
- CALL IGPID(1,'y-axis',ID,' ')
-*
- ATEST=(XWMAXI-XWMINI)*0.001
-*
- CHAXI='SHD'
- CHAXI1=CHAXI
-*
- CALL IGSET('LAOF',YALDIS)
- CALL IGSET('TMSI',YTISIZ)
-*
- IF(.NOT.LOGXFL)THEN
- XAX1=XVAL
- ELSE
- IF(XVAL.LE.0.)XVAL=BIGP
- XAX1=LOG10(XVAL)
- ENDIF
-*----
-* Test if cross-wires outside range, or if at the edge (where
-* the line is not removed)
-*----
- IF(XAX1.GT.XWMAXI)XAX1=XWMAXI
- IF(XAX1.LT.XWMINI) XAX1=XWMINI
- XAX2=XAX1
- YAX1=YWMINI
- YAX2=YWMAXI
- IF(.NOT.LTICK) THEN
- IF((ABS(XAX1-XWMAXI).GE.ATEST) .AND. (ABS(XAX1-XWMINI).GE.
- + ATEST))THEN
- CALL IPL(2,XAX,YAX)
- ENDIF
- GOTO 70
- ENDIF
- IF(ABS(XAX1-XWMAXI).LT.ATEST)THEN
- CHAXI='+'//CHAXI1
- CHAXI1=CHAXI
- IF(IOPTL.NE.0)THEN
- CHAXI='='//CHAXI1
- CHAXI1=CHAXI
- ENDIF
- ELSE IF(ABS(XAX1-XWMINI).LT.ATEST)THEN
- CHAXI='-'//CHAXI1
- CHAXI1=CHAXI
- IF(IOPTR.NE.0)THEN
- CHAXI='='//CHAXI1
- CHAXI1=CHAXI
- ENDIF
- ELSE
- CHAXI='+-'//CHAXI1
- CHAXI1=CHAXI
- IF(IOPTL.NE.0)THEN
- CHAXI='='//CHAXI1
- CHAXI1=CHAXI
- ENDIF
- ENDIF
-*----
-* Plot tick-marks along the cross wire
-*----
- IF(.NOT.LOGYFL)THEN
- BMIN=YWMINI
- BMAX=YWMAXI
- ELSE
- BMIN=10**YWMINI
- BMAX=10**YWMAXI
- ENDIF
-*
- IF((IOPTR.EQ.0).AND.(IOPTL.EQ.0))THEN
- CHAXI='U'//CHAXI1
- CHAXI1=CHAXI
- ENDIF
- IF(LOGYFL)THEN
- CHAXI='G'//CHAXI1
- CHAXI1=CHAXI
- ENDIF
- IF(IOPTW.NE.0)THEN
- CHAXI='W'//CHAXI1
- CHAXI1=CHAXI
- ENDIF
- IF(LODVYI)THEN
- CHAXI='I'//CHAXI1
- CHAXI1=CHAXI
- ENDIF
- IF(NDIVY.LT.0)THEN
- CHAXI='N'//CHAXI1
- CHAXI1=CHAXI
- ENDIF
-*
-* Define the label alignment on the Y Axis. Note that if
-* the labels are on the right, Left and Right text alignments
-* are inverted
-*
- IF(CY.EQ.1)THEN
- CHAXI1=CHAXI
- IF (IOPTR.NE.0) THEN
- CHAXI='R'//CHAXI1
- ELSE
- CHAXI='L'//CHAXI1
- ENDIF
- ENDIF
- IF(CY.EQ.2)THEN
- CHAXI1=CHAXI
- CHAXI='C'//CHAXI1
- ENDIF
- IF(CY.EQ.3)THEN
- CHAXI1=CHAXI
- IF (IOPTR.NE.0) THEN
- CHAXI='L'//CHAXI1
- ELSE
- CHAXI='R'//CHAXI1
- ENDIF
- ENDIF
- IF(CY.EQ.4)THEN
- CHAXI1=CHAXI
- IF (IOPTR.NE.0) THEN
- CHAXI='RM'//CHAXI1
- ELSE
- CHAXI='LM'//CHAXI1
- ENDIF
- ENDIF
- IF(CY.EQ.5)THEN
- CHAXI1=CHAXI
- CHAXI='CM'//CHAXI1
- ENDIF
- IF(CY.EQ.6)THEN
- CHAXI1=CHAXI
- IF (IOPTR.NE.0) THEN
- CHAXI='LM'//CHAXI1
- ELSE
- CHAXI='RM'//CHAXI1
- ENDIF
- ENDIF
- IF(CY.EQ.0)THEN
- IF(NY.NE.0)THEN
- CHAXI1=CHAXI
- CHAXI='M'//CHAXI1
- ENDIF
- IF (IOPTR.NE.0) THEN
- CHAXI1=CHAXI
- CHAXI='L'//CHAXI1
- ENDIF
- ENDIF
-*
- IF(NY.NE.0)THEN
- LNY = 0
- LN = LQ(LHPLOT-2)
- 50 IF(LN.NE.0)THEN
- IF(IQ(LN+1).EQ.NY)LNY=LN
- LN=LQ(LN)
- GOTO 50
- ENDIF
- DO 60 I=1,IQ(LNY+2)
- HILABS(I)=' '
- CALL UHTOC(IQ(LNY+3+(I-1)*LW),4,HILABS(I),LABLEN)
- 60 CONTINUE
- NHILAB=IQ(LNY+2)
- CALL IZLBL
- CHAXI1=CHAXI
- CHAXI='TN'//CHAXI1
- ENDIF
-*
- CALL ISTXCI(IYCOL)
- CALL ISLWSC(FLOAT(IYWID))
- CALL IGAXIS(XAX1,XAX2,YAX1,YAX2,BMIN,BMAX,IABS(NDIVY),CHAXI)
-*----
-* Test if cross-wires required perpendicular to y-axis
-*----
- 70 IF(IOPTY.EQ.0) GOTO 999
- CALL IGPID(1,'x-axis',ID,' ')
-*
- ATEST=(YWMAXI-YWMINI)*0.001
-*
- CHAXI='SHD'
- CHAXI1=CHAXI
-*
- CALL IGSET('LAOF',XALDIS)
- CALL IGSET('TMSI',XTISIZ)
-*
- IF(.NOT.LOGYFL)THEN
- YAX1=YVAL
- ELSE
- IF(YVAL.LE.0.)YVAL=BIGP
- YAX1=LOG10(YVAL)
- ENDIF
-*----
-* Test if cross-wires outside range
-*----
- IF(YAX1.GT.YWMAXI)YAX1=YWMAXI
- IF(YAX1.LT.YWMINI) YAX1=YWMINI
- YAX2=YAX1
- XAX1=XWMINI
- XAX2=XWMAXI
- IF(.NOT.LTICK) THEN
- IF((ABS(YAX1-YWMAXI).GE.ATEST) .AND. (ABS(YAX1-YWMINI).GE.
- + ATEST))THEN
- CALL IPL(2,XAX,YAX)
- ENDIF
- GOTO 999
- ENDIF
- IF(ABS(YAX1-YWMAXI).LT.ATEST)THEN
- CHAXI='-'//CHAXI1
- CHAXI1=CHAXI
- IF(IOPTB.NE.0)THEN
- CHAXI='='//CHAXI1
- CHAXI1=CHAXI
- ENDIF
- ELSE IF(ABS(YAX1-YWMINI).LT.ATEST)THEN
- CHAXI='+'//CHAXI1
- CHAXI1=CHAXI
- IF(IOPTA.NE.0)THEN
- CHAXI='='//CHAXI1
- CHAXI1=CHAXI
- ENDIF
- ELSE
- CHAXI='+-'//CHAXI1
- CHAXI1=CHAXI
- IF(IOPTA.NE.0)THEN
- CHAXI='='//CHAXI1
- CHAXI1=CHAXI
- ENDIF
- ENDIF
-*----
-* Plot tick marks along the cross-wire
-*----
- IF(.NOT.LOGXFL)THEN
- BMIN=XWMINI
- BMAX=XWMAXI
- ELSE
- BMIN=10**XWMINI
- BMAX=10**XWMAXI
- ENDIF
-*
- IF((IOPTA.EQ.0).AND.(IOPTB.EQ.0))THEN
- CHAXI='U'//CHAXI1
- CHAXI1=CHAXI
- ENDIF
- IF(LOGXFL)THEN
- CHAXI='G'//CHAXI1
- CHAXI1=CHAXI
- ENDIF
- IF(IOPTW.NE.0)THEN
- CHAXI='W'//CHAXI1
- CHAXI1=CHAXI
- ENDIF
- IF(LODVXI)THEN
- CHAXI='I'//CHAXI1
- CHAXI1=CHAXI
- ENDIF
- IF(NDIVX.LT.0)THEN
- CHAXI='N'//CHAXI1
- CHAXI1=CHAXI
- ENDIF
-*
- IF(CX.EQ.1)THEN
- CHAXI1=CHAXI
- CHAXI='C'//CHAXI1
- ENDIF
- IF(CX.EQ.2)THEN
- CHAXI1=CHAXI
- CHAXI='YC'//CHAXI1
- ENDIF
- IF(CX.EQ.3)THEN
- CHAXI1=CHAXI
- CHAXI='LO'//CHAXI1
- ENDIF
- IF(CX.EQ.4)THEN
- CHAXI1=CHAXI
- CHAXI='R0'//CHAXI1
- ENDIF
- IF(CX.EQ.5)THEN
- CHAXI1=CHAXI
- CHAXI='MC'//CHAXI1
- ENDIF
- IF(CX.EQ.6)THEN
- CHAXI1=CHAXI
- CHAXI='MCY'//CHAXI1
- ENDIF
- IF(CX.EQ.7)THEN
- CHAXI1=CHAXI
- CHAXI='MLO'//CHAXI1
- ENDIF
- IF(CX.EQ.8)THEN
- CHAXI1=CHAXI
- CHAXI='MR0'//CHAXI1
- ENDIF
- IF(CX.EQ.0)THEN
- IF(NX.NE.0)THEN
- CHAXI1=CHAXI
- CHAXI='MC'//CHAXI1
- ELSE
- CHAXI1=CHAXI
- CHAXI='C'//CHAXI1
- ENDIF
- ENDIF
- IF(NX.NE.0)THEN
- LNX = 0
- LN = LQ(LHPLOT-2)
- 80 IF(LN.NE.0)THEN
- IF(IQ(LN+1).EQ.NX)LNX=LN
- LN=LQ(LN)
- GOTO 80
- ENDIF
- DO 90 I=1,IQ(LNX+2)
- HILABS(I)=' '
- CALL UHTOC(IQ(LNX+3+(I-1)*LW),4,HILABS(I),LABLEN)
- 90 CONTINUE
- NHILAB=IQ(LNX+2)
- CALL IZLBL
- CHAXI1=CHAXI
- CHAXI='TN'//CHAXI1
- ENDIF
-*
- CALL ISTXCI(IXCOL)
- CALL ISLWSC(FLOAT(IXWID))
- CALL IGAXIS(XAX1,XAX2,YAX1,YAX2,BMIN,BMAX,IABS(NDIVX),CHAXI)
-*
- 999 CALL ISCLIP(1)
- CALL ISLN(ILTYP)
- CALL IGSET('TXCI',RTXCI)
- CALL ISTXFP(INT(RTXFP(1)),INT(RTXFP(2)))
- CALL IGSET('PLCI',RPLCI)
- CALL IGSET('LWID',RLWID)
-*
- END
diff --git a/src/graflib/hplot/hplotf77/hplwn.F b/src/graflib/hplot/hplotf77/hplwn.F
deleted file mode 100644
index 69d9fb7..0000000
--- a/src/graflib/hplot/hplotf77/hplwn.F
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: hplwn.F,v 1.1.1.1 1996/01/19 10:50:12 mclareni Exp $
-*
-* $Log: hplwn.F,v $
-* Revision 1.1.1.1 1996/01/19 10:50:12 mclareni
-* Hplot
-*
-*
-#include "hplot/pilot.h"
-*CMZ : 5.18/00 01/11/93 11.30.38 by O.Couet
-*-- Author : O.Couet 27/09/93
- SUBROUTINE HPLWN(NT,X1,X2,Y1,Y2)
-#include "hplot/hpl3.inc"
-#include "hplot/hpl9.inc"
- XWMINI = X1
- XWMAXI = X2
- YWMINI = Y1
- YWMAXI = Y2
- IF(LOGX.NE.0)THEN
- IF(X1.LE.0..OR.X2.LE.0.)GO TO 10
- XWMINI = ALOG10(X1)
- XWMAXI = ALOG10(X2)
- ENDIF
- IF(LOGY.NE.0)THEN
- IF(Y1.LE.0..OR.Y2.LE.0.)GO TO 10
- YWMINI = ALOG10(Y1)
- YWMAXI = ALOG10(Y2)
- ENDIF
- CALL ISWN(NT,XWMINI,XWMAXI,YWMINI,YWMAXI)
- RETURN
- 10 CALL HBUG('+Illegal values for Log scale','HPLWN',0)
- END
diff --git a/src/graflib/hplot/hplotf77/hplzom.F b/src/graflib/hplot/hplotf77/hplzom.F
deleted file mode 100644
index f66349a..0000000
--- a/src/graflib/hplot/hplotf77/hplzom.F
+++ /dev/null
@@ -1,47 +0,0 @@
-*
-* $Id: hplzom.F,v 1.1.1.1 1996/01/19 10:50:12 mclareni Exp $
-*
-* $Log: hplzom.F,v $
-* Revision 1.1.1.1 1996/01/19 10:50:12 mclareni
-* Hplot
-*
-*
-#include "hplot/pilot.h"
-*CMZ : 5.14/09 27/11/92 13.49.55 by O.Couet
-*-- Author :
- SUBROUTINE HPLZOM(IDDD,CHOPT,IMIN,IMAX)
-*.==========>
-*. HPLOT basic routine for histogram zooms.
-*.
-*. Input parameter:
-*.
-*. IDDD : Histogram IDentifier.
-*. CHARACTER*(*) CHOPT : cf. HPLOT (idem)
-*. IMIN : first channel number
-*. IMAX : last channel number
-*.
-*..=========>
-#include "hplot/hpl1.inc"
-#include "hplot/hpl2.inc"
-#include "hplot/hpl9.inc"
-#include "hbook/hcbook.inc"
- CHARACTER*(*) CHOPT
-*._____________________________
-*
- IDD = IDDD
- LOZOOM = .TRUE.
- CALL HFIND(IDD,'HPLZOM')
- IF(LCID.LE.0)GO TO 99
- NCMIN = MAX(1,IMIN)
- NCX = IQ(LCID+KNCX)
- NCMAX = MIN(IMAX,NCX)
- IF(NCMIN.GT.NCMAX)THEN
- CALL HBUG('Bad values for IMIN, IMAX','HPLZOM',IDD)
- GOTO 99
- ENDIF
-*
- CALL HPLOT(IDD,CHOPT,' ',0)
-*
- 99 LOZOOM=.FALSE.
-*
- END
diff --git a/src/graflib/hplot/hplotf77/hplzon.F b/src/graflib/hplot/hplotf77/hplzon.F
deleted file mode 100644
index 730ae66..0000000
--- a/src/graflib/hplot/hplotf77/hplzon.F
+++ /dev/null
@@ -1,89 +0,0 @@
-*
-* $Id: hplzon.F,v 1.1.1.1 1996/01/19 10:50:12 mclareni Exp $
-*
-* $Log: hplzon.F,v $
-* Revision 1.1.1.1 1996/01/19 10:50:12 mclareni
-* Hplot
-*
-*
-#include "hplot/pilot.h"
-*CMZ : 5.17/01 13/07/93 15.43.22 by O.Couet
-*-- Author :
- SUBROUTINE HPLZON(IX,IY,IWI,KIC)
-*.==========>
-*. sets up window options
-*..=========>
-#include "hbook/hcbook.inc"
-#include "hplot/quest.inc"
-#include "hplot/hpl1.inc"
-#include "hplot/hpl2.inc"
-#include "hplot/hpl4.inc"
- CHARACTER*(*) KIC
-*._____________________________
-*
- IQUEST(1)=0
- IW = MAX(1,IWI)
-*
- NARG=4
- CALL NOARG(NARG)
- IF(NARG.LT.2) GOTO 996
- LWSAME=.FALSE.
-*
- IF(NARG.GE.4)THEN
- IF(KIC(1:1).EQ.'S') LWSAME=.TRUE.
- ENDIF
-*----
-* check if space for IX and IY windows
-*----
- IXWIN=IABS(IX)
- IF(IXWIN.EQ.0) GOTO 996
- XWDIST=XMLEFT+((IXWIN-1)*XWIND)+XMRIT
- IF (XWDIST.GE.XSIZ) GOTO 997
- XWDIST=(XSIZ-XWDIST)/IXWIN
- 20 IYWIN=IABS(IY)
- IF(IYWIN.EQ.0) GOTO 996
- YWDIST=YMGLOW+((IYWIN-1)*YWIND)+YMGUP
- IF (YWDIST.GE.YSIZ) GOTO 998
- YWDIST=(YSIZ-YWDIST)/IYWIN
-*
- LOWIND=.FALSE.
- IF(NARG.LT.3) THEN
- IWIN=0
- NCHIST=0
- IWIN0=1
- ELSE
- IWIN=MAX(IW-1,0)
- IF(.NOT.LWSAME)NCHIST=IWIN
- IWIN0=IW
- ENDIF
-*
- IF(IXWIN*IYWIN.GT.1) LOWIND=.TRUE.
- IF(LOWIND) GOTO 999
-*
- 996 CONTINUE
- NCHIST=1
- IWIN=1
- IWIN0=1
- IXWIN=1
- IYWIN=1
- LOWIND=.FALSE.
- GOTO 999
-*
- 997 CALL HBUG('Too many windows requested in X : increase plot size or
- + decrease number of windows','HPLZON',0)
- IQUEST(1)=1
- IXWIN=1
- XWDIST=XMLEFT+XMRIT
- XWDIST=XSIZ-XWDIST
- GOTO 20
-*
- 998 CALL HBUG('Too many windows requested in Y : increase plot size or
- + decrease number of windows','HPLZON',0)
- IQUEST(1)=1
- IYWIN=1
- YWDIST=YMGLOW+YMGUP
- YWDIST=YSIZ-YWDIST
- 999 CONTINUE
- END
-
-
diff --git a/src/include/cfortran b/src/include/cfortran
deleted file mode 120000
index afb4296..0000000
--- a/src/include/cfortran
+++ /dev/null
@@ -1 +0,0 @@
-../cfortran
\ No newline at end of file
diff --git a/src/include/hbook b/src/include/hbook
deleted file mode 120000
index 80c94f6..0000000
--- a/src/include/hbook
+++ /dev/null
@@ -1 +0,0 @@
-../packlib/hbook/hbook
\ No newline at end of file
diff --git a/src/include/higz b/src/include/higz
deleted file mode 120000
index 1770f4c..0000000
--- a/src/include/higz
+++ /dev/null
@@ -1 +0,0 @@
-../graflib/higz/higz
\ No newline at end of file
diff --git a/src/include/paw b/src/include/paw
deleted file mode 120000
index a2cd8c0..0000000
--- a/src/include/paw
+++ /dev/null
@@ -1 +0,0 @@
-../pawlib/paw/paw
\ No newline at end of file
diff --git a/src/include/zebra b/src/include/zebra
deleted file mode 120000
index 8c6467d..0000000
--- a/src/include/zebra
+++ /dev/null
@@ -1 +0,0 @@
-../packlib/zebra/zebra
\ No newline at end of file
diff --git a/src/man/man1/cernlib.1 b/src/man/man1/cernlib.1
deleted file mode 100644
index 7fb43ea..0000000
--- a/src/man/man1/cernlib.1
+++ /dev/null
@@ -1,157 +0,0 @@
-.TH cernlib 1 "$Date: 1998/05/19 16:32:03 $" "CERN Program Library"
-"CERNlib commands"
-.ds )H Cern Program Library
-.ds ]W cernlib
-.SH NAME
-cernlib \- get libraries needed to link with CERN Program Library
-.SH SYNOPSIS
-.B cernlib
-.RI [options]
-.I library[/version]
-.I ...
-
-.SH DESCRIPTION
-
-.B cernlib
-writes to standard output a list of object libraries needed to link
-a program with the given
-.I library(s)
-of CERNlib; other libraries needed implicitely, both
-CERNlib and system libraries, are added automatically.
-.I library
-may be any of the CERNlib libraries using a short name like packlib,
-mathlib, graflib, phtools...
-.PP
-.I version
-allows to specify which version to use for this library, see usage notes.
-
-.SS Options
-
-.B cernlib
-recognizes the following options:
-
-.TP 11
-.BI "-G\ " "driver"
-specifies the graphics interface to use. Defaults to X11.
-The choices available depend on the system in use:
-.RS 14
-.IP X11 7
-all systems. On HP/UX X11R5 is used when available on the system.
-.IP Motif
-all systems. On HP/UX Motif1.2 is used when available on the system.
-.IP GKS
-Vendor specific graphics, DEC Ultrix, IBM/RS6000, SUN only
-.IP GPR
-Vendor specific graphics, Apollo only.
-.IP GL
-Vendor specific graphics, IBM/RS6000 and SGI only.
-.RE
-
-.TP 11
-.B -s
-obsolete option. Ignored.
-
-.TP 11
-.B -u
-do
-.B not
-automatically add vendor libraries needed to link,
-but not specified by the user.
-
-.TP
-.BI "-v\ " "version"
-Use level
-.I version
-of CERNlib libraries;
-.I version
-can be pro, new or old, or you may specify the explicit version number; the
-default version is pro. The global version can be overwritten for an
-individual library by specifying the
-.I library
-as
-.I library/version.
-
-.SS USAGE
-
-.B cernlib
-expects to find the CERNlib directory tree in /cern; if your system does
-not have this, set the environment variable CERN to contain the name of the
-root directory for the CERNlib tree.
-.PP
-After the
-.I library
-a version for that library different from the default version may be
-specified. The possible values are as for the
-.B -v
-option, or in the case of
-graflib as for the
-.B -G
-option.
-
-.SS EXAMPLES
-
-As
-.B cernlib
-writes the list of libraries to standard output, using it as a command will
-show the list of libraries generated by cernlib. Also, it can be used like
-other commands in the command line surrounded by back quotes(`).
-At CERN you should use the hepf77 command to link on your system as this
-gives the compiler parameters which are compatible with Cernlib
-(in particular for xlf on IBM/RS6000 and fort77 on HP/UX )
-you could type:
-.RS 5
-hepf77 your.o `cernlib`
-.RE
-to link your object file with routines from packlib and kernlib; you need
-not specify packlib, as this is added automatically. Also all
-kernlib routines are included in packlib.
-If your application uses graflib and the Motif interface, the command would
-be:
-.RS 5
-hepf77 your.o `cernlib graflib/Motif`
-.RE
-Again packlib need not be specified.
-.PP
-If you prefer to have an environment variable CERNLIB set at login time,
-put the following into
-.RS 5
- .profile for sh, ksh or similar
-.RS 5
-CERNLIB=`cernlib graflib`; export CERNLIB
-.RE
- .login for users of csh of similar
-.RS 5
-setenv CERNLIB "`cernlib graflib`"
-.RE
-.RE
-The CERNLIB variable can then be used in the link command instead of
-calling the cernlib command.
-
-.SS BUGS
-
-There is no checking that any of the libraries (or options) are valid or exist.
-Most loaders only check the libraries once for symbols, hence the order
-the libraries given is important. This command does not check that the
-order given is correct.
-
-For systems other than Alliant, Apollo, DEC Ultrix, Digital Unix (or DEC OSF),
-HP/UX, SGI, Linux, Sun OS, Sun Solaris
-the libraries given for the graphics interface are likely to be wrong,
-even for X11 and Motif.
-
-.SS FILES
-
-The cernlib command is available in the /cern/pro/bin directory
-in the CERNlib tree.
-
-.SS CONTACT Address
-
-If you have suggestions for improvements, or find bugs, please report them to
-.RS 5
-cernlib at cern.ch.
-.RE
-Your report must state which version of CERNlib you are using, or the output of
-the command:
-.RS 5
-what `which cernlib`
-.RE
diff --git a/src/mathlib/Imakefile b/src/mathlib/Imakefile
deleted file mode 100644
index f85db60..0000000
--- a/src/mathlib/Imakefile
+++ /dev/null
@@ -1,22 +0,0 @@
-
-#define IHaveSubdirs
-#define PassCDebugFlags
-
-
-LIBDIRS= gen bvsl
-
-#ifndef WIN32
- LIBDIRS := $(LIBDIRS) lapack
-#endif
-
-SUBDIRS= $(LIBDIRS)
-
-MakeSubdirs($(SUBDIRS))
-
-SubdirLibraryTarget(mathlib,$(LIBDIRS))
-
-InstallLibrary(mathlib,$(CERN_LIBDIR))
-
-InstallIncludeSubdirs($(LIBDIRS))
-
-TestSubdirs(gen bvsl)
diff --git a/src/mathlib/bvsl/Imakefile b/src/mathlib/bvsl/Imakefile
deleted file mode 100644
index 36f00da..0000000
--- a/src/mathlib/bvsl/Imakefile
+++ /dev/null
@@ -1,19 +0,0 @@
-
-#define IHaveSubdirs
-#define PassCDebugFlags
-
-#if defined(CERNLIB_SGI)
-IMAKE_DEFINES=-DFortranDoesCpp=NO
-#endif
-
-LIBDIRS= bvslftn
-
-SUBDIRS= $(LIBDIRS) test
-
-TopOfPackage(bvsl)
-
-SubdirLibraryTarget(bvsl,$(LIBDIRS))
-
-TestSubdirs(test)
-
-install.include:
diff --git a/src/mathlib/bvsl/bvslftn/Imakefile b/src/mathlib/bvsl/bvslftn/Imakefile
deleted file mode 100644
index ffec884..0000000
--- a/src/mathlib/bvsl/bvslftn/Imakefile
+++ /dev/null
@@ -1,17 +0,0 @@
-#if defined(CERNLIB_SGI)
-IMAKE_DEFINES=-DFortranDoesCpp=NO
-#endif
-
-SRCS_F= aintgb.F alosb.F andb.F andntb.F binvec.F cntob.F \ @@\
- cntzb.F copyb.F cprsb.F dalosb.F dcopyb.F ddotb.F dgthrb.F \ @@\
- dmod3b.F dotb.F drangb.F dscalb.F dscttb.F dsxpyb.F dsxyb.F \ @@\
- dvsetb.F dvxpyb.F dxypwzb.F dylosb.F dyloxb.F gthrb.F idlosb.F \ @@\
- intgb.F iylosb.F iyloxb.F nandb.F norb.F notb.F oneb.F orb.F \ @@\
- ornotb.F rangb.F rjctb.F scalb.F scttb.F smod3b.F sxpyb.F \ @@\
- sxyb.F vsetb.F vxpyb.F xorb.F xypwzb.F ylosb.F yloxb.F zerob.F
-
-#ifdef CERNLIB_HPUX
-FORTRANOPTIONS += -WF,-P
-#endif
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/mathlib/bvsl/bvslftn/aintgb.F b/src/mathlib/bvsl/bvslftn/aintgb.F
deleted file mode 100644
index dfa17a9..0000000
--- a/src/mathlib/bvsl/bvslftn/aintgb.F
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: aintgb.F,v 1.1.1.1 1996/03/21 17:19:55 mclareni Exp $
-*
-* $Log: aintgb.F,v $
-* Revision 1.1.1.1 1996/03/21 17:19:55 mclareni
-* Bvsl
-*
-*
-#include "pilot.h"
-*CMZ : 06/11/90 14.36.25 by Michel Roethlisberger/IBM
-*-- Author :
- SUBROUTINE AINTGB (N,X,X2B,X1B,LV,NB)
-C
-C ************************************************************
-C * *
-C * Author: M.Roethlisberger/IBM *
-C * *
-C * Date: 6 Nov 1990, V1.01, Creation of the module *
-C * *
-C ************************************************************
-C
- LOGICAL LV(*)
-#include "defsp.inc"
- + X (*), X2B(*), X1B(*)
- NB = 0
- DO 1 I = 1,N
- LV(I) = X(I).LT.X2B(I) .AND. X(I).GT.X1B(I)
- IF (LV(I)) NB = NB + 1
- 1 CONTINUE
- RETURN
- END
diff --git a/src/mathlib/bvsl/bvslftn/alosb.F b/src/mathlib/bvsl/bvslftn/alosb.F
deleted file mode 100644
index bbf4f31..0000000
--- a/src/mathlib/bvsl/bvslftn/alosb.F
+++ /dev/null
@@ -1,80 +0,0 @@
-*
-* $Id: alosb.F,v 1.1.1.1 1996/03/21 17:19:55 mclareni Exp $
-*
-* $Log: alosb.F,v $
-* Revision 1.1.1.1 1996/03/21 17:19:55 mclareni
-* Bvsl
-*
-*
-#include "pilot.h"
-*CMZ : 06/11/90 14.36.24 by Michel Roethlisberger/IBM
-*-- Author :
- SUBROUTINE ALOSB (N,Y,S,LV,NB,LO)
-C
-C ************************************************************
-C * *
-C * Author: M.Roethlisberger/IBM *
-C * *
-C * Date: 6 Nov 1990, V1.01, Creation of the module *
-C * *
-C ************************************************************
-C
- LOGICAL LV (N)
- DIMENSION Y (N)
- CHARACTER*2 LO
-
- IF (LO.EQ.'EQ') THEN
- NB = 0
- DO 110 I=1,N
- LV(I) = ABS(Y(I)).EQ.S
- IF (LV(I)) NB = NB + 1
- 110 CONTINUE
- GOTO 999
- ENDIF
-
- IF (LO.EQ.'LT') THEN
- NB = 0
- DO 120 I=1,N
- LV(I) = ABS(Y(I)).LT.S
- IF (LV(I)) NB = NB + 1
- 120 CONTINUE
- GOTO 999
- ENDIF
-
- IF (LO.EQ.'LE') THEN
- NB = 0
- DO 130 I=1,N
- LV(I) = ABS(Y(I)).LE.S
- IF (LV(I)) NB = NB + 1
- 130 CONTINUE
- GOTO 999
- ENDIF
-
- IF (LO.EQ.'GT') THEN
- NB = 0
- DO 140 I=1,N
- LV(I) = ABS(Y(I)).GT.S
- IF (LV(I)) NB = NB + 1
- 140 CONTINUE
- GOTO 999
- ENDIF
-
- IF (LO.EQ.'GE') THEN
- NB = 0
- DO 150 I=1,N
- LV(I) = ABS(Y(I)).GE.S
- IF (LV(I)) NB = NB + 1
- 150 CONTINUE
- GOTO 999
- ENDIF
-
- IF (LO.EQ.'NE') THEN
- NB = 0
- DO 160 I=1,N
- LV(I) = ABS(Y(I)).NE.S
- IF (LV(I)) NB = NB + 1
- 160 CONTINUE
- ENDIF
-
- 999 RETURN
- END
diff --git a/src/mathlib/bvsl/bvslftn/andb.F b/src/mathlib/bvsl/bvslftn/andb.F
deleted file mode 100644
index 8579665..0000000
--- a/src/mathlib/bvsl/bvslftn/andb.F
+++ /dev/null
@@ -1,30 +0,0 @@
-*
-* $Id: andb.F,v 1.1.1.1 1996/03/21 17:19:55 mclareni Exp $
-*
-* $Log: andb.F,v $
-* Revision 1.1.1.1 1996/03/21 17:19:55 mclareni
-* Bvsl
-*
-*
-#include "pilot.h"
-*CMZ : 06/11/90 14.36.25 by Michel Roethlisberger/IBM
-*-- Author :
- SUBROUTINE ANDB (NW,LV1,LV2,LV3,N)
-C
-C ************************************************************
-C * *
-C * Author: M.Roethlisberger/IBM *
-C * *
-C * Date: 6 Nov 1990, V1.01, Creation of the module *
-C * *
-C ************************************************************
-C
- LOGICAL LV1(NW),LV2(NW),LV3(NW)
-
- N = 0
- DO 1 I = 1,NW
- LV3(I) = LV1(I).AND.LV2(I)
- IF (LV3(I)) N = N + 1
- 1 CONTINUE
- RETURN
- END
diff --git a/src/mathlib/bvsl/bvslftn/andntb.F b/src/mathlib/bvsl/bvslftn/andntb.F
deleted file mode 100644
index faab93b..0000000
--- a/src/mathlib/bvsl/bvslftn/andntb.F
+++ /dev/null
@@ -1,30 +0,0 @@
-*
-* $Id: andntb.F,v 1.1.1.1 1996/03/21 17:19:55 mclareni Exp $
-*
-* $Log: andntb.F,v $
-* Revision 1.1.1.1 1996/03/21 17:19:55 mclareni
-* Bvsl
-*
-*
-#include "pilot.h"
-*CMZ : 06/11/90 14.36.25 by Michel Roethlisberger/IBM
-*-- Author :
- SUBROUTINE ANDNTB (NW,LV1,LV2,LV3,N)
-C
-C ************************************************************
-C * *
-C * Author: M.Roethlisberger/IBM *
-C * *
-C * Date: 6 Nov 1990, V1.01, Creation of the module *
-C * *
-C ************************************************************
-C
- LOGICAL LV1(NW),LV2(NW),LV3(NW)
-
- N = 0
- DO 1 I = 1,NW
- LV3(I) = LV1(I).AND..NOT.LV2(I)
- IF (LV3(I)) N = N + 1
- 1 CONTINUE
- RETURN
- END
diff --git a/src/mathlib/bvsl/bvslftn/binvec.F b/src/mathlib/bvsl/bvslftn/binvec.F
deleted file mode 100644
index d445b7e..0000000
--- a/src/mathlib/bvsl/bvslftn/binvec.F
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: binvec.F,v 1.1.1.1 1996/03/21 17:19:55 mclareni Exp $
-*
-* $Log: binvec.F,v $
-* Revision 1.1.1.1 1996/03/21 17:19:55 mclareni
-* Bvsl
-*
-*
-#include "pilot.h"
-*CMZ : 06/11/90 14.36.25 by Michel Roethlisberger/IBM
-*-- Author :
-C -------------------- INDEX - BIT OPERERATIONS ----------------
- SUBROUTINE BINVEC (NW,LV,INDX)
-C
-C ************************************************************
-C * *
-C * Author: M.Roethlisberger/IBM *
-C * *
-C * Date: 6 Nov 1990, V1.01, Creation of the module *
-C * *
-C ************************************************************
-C
- DIMENSION LV(NW), INDX(NW)
- LOGICAL LV
- JJ = 0
- DO 1 I = 1,NW
- IF (LV(I)) THEN
- JJ = JJ + 1
- INDX(JJ) = I
- ENDIF
- 1 CONTINUE
- RETURN
- END
diff --git a/src/mathlib/bvsl/bvslftn/cntob.F b/src/mathlib/bvsl/bvslftn/cntob.F
deleted file mode 100644
index 44dd3a7..0000000
--- a/src/mathlib/bvsl/bvslftn/cntob.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: cntob.F,v 1.1.1.1 1996/03/21 17:19:55 mclareni Exp $
-*
-* $Log: cntob.F,v $
-* Revision 1.1.1.1 1996/03/21 17:19:55 mclareni
-* Bvsl
-*
-*
-#include "pilot.h"
-*CMZ : 06/11/90 14.36.25 by Michel Roethlisberger/IBM
-*-- Author :
- SUBROUTINE CNTOB (NW,LV,NFND)
-C
-C ************************************************************
-C * *
-C * Author: M.Roethlisberger/IBM *
-C * *
-C * Date: 6 Nov 1990, V1.01, Creation of the module *
-C * *
-C ************************************************************
-C
- LOGICAL LV(*)
- NFND = 0
- DO 1 I = 1,NW
- IF (LV(I)) NFND=NFND+1
- 1 CONTINUE
- RETURN
- END
diff --git a/src/mathlib/bvsl/bvslftn/cntzb.F b/src/mathlib/bvsl/bvslftn/cntzb.F
deleted file mode 100644
index 7e7c96d..0000000
--- a/src/mathlib/bvsl/bvslftn/cntzb.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: cntzb.F,v 1.1.1.1 1996/03/21 17:19:55 mclareni Exp $
-*
-* $Log: cntzb.F,v $
-* Revision 1.1.1.1 1996/03/21 17:19:55 mclareni
-* Bvsl
-*
-*
-#include "pilot.h"
-*CMZ : 06/11/90 14.36.25 by Michel Roethlisberger/IBM
-*-- Author :
- SUBROUTINE CNTZB (NW,LV,NFND)
-C
-C ************************************************************
-C * *
-C * Author: M.Roethlisberger/IBM *
-C * *
-C * Date: 6 Nov 1990, V1.01, Creation of the module *
-C * *
-C ************************************************************
-C
- LOGICAL LV(*)
- NFND = 0
- DO 1 I = 1,NW
- IF (.NOT.LV(I)) NFND=NFND+1
- 1 CONTINUE
- RETURN
- END
diff --git a/src/mathlib/bvsl/bvslftn/copyb.F b/src/mathlib/bvsl/bvslftn/copyb.F
deleted file mode 100644
index dd936d9..0000000
--- a/src/mathlib/bvsl/bvslftn/copyb.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: copyb.F,v 1.1.1.1 1996/03/21 17:19:55 mclareni Exp $
-*
-* $Log: copyb.F,v $
-* Revision 1.1.1.1 1996/03/21 17:19:55 mclareni
-* Bvsl
-*
-*
-#include "pilot.h"
-*CMZ : 06/11/90 14.36.25 by Michel Roethlisberger/IBM
-*-- Author :
- SUBROUTINE COPYB (NW,LV,Y,X)
-C
-C ************************************************************
-C * *
-C * Author: M.Roethlisberger/IBM *
-C * *
-C * Date: 6 Nov 1990, V1.01, Creation of the module *
-C * *
-C ************************************************************
-C
- LOGICAL LV(*)
- DIMENSION X (*), Y(*)
- DO 1 I = 1,NW
- IF (LV(I)) Y(I) = X(I)
- 1 CONTINUE
- RETURN
- END
diff --git a/src/mathlib/bvsl/bvslftn/cprsb.F b/src/mathlib/bvsl/bvslftn/cprsb.F
deleted file mode 100644
index 63fbd34..0000000
--- a/src/mathlib/bvsl/bvslftn/cprsb.F
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: cprsb.F,v 1.1.1.1 1996/03/21 17:19:55 mclareni Exp $
-*
-* $Log: cprsb.F,v $
-* Revision 1.1.1.1 1996/03/21 17:19:55 mclareni
-* Bvsl
-*
-*
-#include "pilot.h"
-*CMZ : 06/11/90 14.36.25 by Michel Roethlisberger/IBM
-*-- Author :
-C --------------- GATHER/SCATTER OPERATIONS -------------------
- SUBROUTINE CPRSB (NW,X,LV)
-C
-C ************************************************************
-C * *
-C * Author: M.Roethlisberger/IBM *
-C * *
-C * Date: 6 Nov 1990, V1.01, Creation of the module *
-C * *
-C ************************************************************
-C
- LOGICAL LV(NW)
- DIMENSION X (NW)
-
- J = 0
- DO 1 I = 1,NW
- IF (LV(I)) THEN
- J = J + 1
- X(J) = X(I)
- ENDIF
- 1 CONTINUE
- RETURN
- END
diff --git a/src/mathlib/bvsl/bvslftn/dalosb.F b/src/mathlib/bvsl/bvslftn/dalosb.F
deleted file mode 100644
index 4a67ff3..0000000
--- a/src/mathlib/bvsl/bvslftn/dalosb.F
+++ /dev/null
@@ -1,81 +0,0 @@
-*
-* $Id: dalosb.F,v 1.1.1.1 1996/03/21 17:19:55 mclareni Exp $
-*
-* $Log: dalosb.F,v $
-* Revision 1.1.1.1 1996/03/21 17:19:55 mclareni
-* Bvsl
-*
-*
-#include "pilot.h"
-*CMZ : 06/11/90 14.36.25 by Michel Roethlisberger/IBM
-*-- Author :
- SUBROUTINE DALOSB (N,Y,S,LV,NB,LO)
-C
-C ************************************************************
-C * *
-C * Author: M.Roethlisberger/IBM *
-C * *
-C * Date: 6 Nov 1990, V1.01, Creation of the module *
-C * *
-C ************************************************************
-C
- LOGICAL LV (N)
-#include "defsp.inc"
- + Y (N), S
- CHARACTER*2 LO
-
- IF (LO.EQ.'EQ') THEN
- NB = 0
- DO 110 I=1,N
- LV(I) = ABS(Y(I)).EQ.S
- IF (LV(I)) NB = NB + 1
- 110 CONTINUE
- GOTO 999
- ENDIF
-
- IF (LO.EQ.'LT') THEN
- NB = 0
- DO 120 I=1,N
- LV(I) = ABS(Y(I)).LT.S
- IF (LV(I)) NB = NB + 1
- 120 CONTINUE
- GOTO 999
- ENDIF
-
- IF (LO.EQ.'LE') THEN
- NB = 0
- DO 130 I=1,N
- LV(I) = ABS(Y(I)).LE.S
- IF (LV(I)) NB = NB + 1
- 130 CONTINUE
- GOTO 999
- ENDIF
-
- IF (LO.EQ.'GT') THEN
- NB = 0
- DO 140 I=1,N
- LV(I) = ABS(Y(I)).GT.S
- IF (LV(I)) NB = NB + 1
- 140 CONTINUE
- GOTO 999
- ENDIF
-
- IF (LO.EQ.'GE') THEN
- NB = 0
- DO 150 I=1,N
- LV(I) = ABS(Y(I)).GE.S
- IF (LV(I)) NB = NB + 1
- 150 CONTINUE
- GOTO 999
- ENDIF
-
- IF (LO.EQ.'NE') THEN
- NB = 0
- DO 160 I=1,N
- LV(I) = ABS(Y(I)).NE.S
- IF (LV(I)) NB = NB + 1
- 160 CONTINUE
- ENDIF
-
- 999 RETURN
- END
diff --git a/src/mathlib/bvsl/bvslftn/dcopyb.F b/src/mathlib/bvsl/bvslftn/dcopyb.F
deleted file mode 100644
index 2d27e6b..0000000
--- a/src/mathlib/bvsl/bvslftn/dcopyb.F
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: dcopyb.F,v 1.1.1.1 1996/03/21 17:19:55 mclareni Exp $
-*
-* $Log: dcopyb.F,v $
-* Revision 1.1.1.1 1996/03/21 17:19:55 mclareni
-* Bvsl
-*
-*
-#include "pilot.h"
-*CMZ : 06/11/90 14.36.25 by Michel Roethlisberger/IBM
-*-- Author :
- SUBROUTINE DCOPYB (NW,LV,Y,X)
-C
-C ************************************************************
-C * *
-C * Author: M.Roethlisberger/IBM *
-C * *
-C * Date: 6 Nov 1990, V1.01, Creation of the module *
-C * *
-C ************************************************************
-C
- LOGICAL LV(*)
-#include "defsp.inc"
- + X (*), Y(*)
- DO 1 I = 1,NW
- IF (LV(I)) Y(I) = X(I)
- 1 CONTINUE
- RETURN
- END
diff --git a/src/mathlib/bvsl/bvslftn/ddotb.F b/src/mathlib/bvsl/bvslftn/ddotb.F
deleted file mode 100644
index aaa97cb..0000000
--- a/src/mathlib/bvsl/bvslftn/ddotb.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: ddotb.F,v 1.1.1.1 1996/03/21 17:19:55 mclareni Exp $
-*
-* $Log: ddotb.F,v $
-* Revision 1.1.1.1 1996/03/21 17:19:55 mclareni
-* Bvsl
-*
-*
-#include "pilot.h"
-*CMZ : 06/11/90 14.36.25 by Michel Roethlisberger/IBM
-*-- Author :
- FUNCTION DDOTB (NW,LV,Y,X)
- LOGICAL LV(*)
-#include "defsp.inc"
- + Y (*), X(*), DDOTB
- DDOTB=0.
- DO 1 I = 1,NW
- IF(LV(I)) DDOTB=DDOTB+Y(I)*X(I)
- 1 CONTINUE
- RETURN
- END
diff --git a/src/mathlib/bvsl/bvslftn/defsp.inc b/src/mathlib/bvsl/bvslftn/defsp.inc
deleted file mode 100644
index 6fc15ab..0000000
--- a/src/mathlib/bvsl/bvslftn/defsp.inc
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: defsp.inc,v 1.1.1.1 1996/03/21 17:19:55 mclareni Exp $
-*
-* $Log: defsp.inc,v $
-* Revision 1.1.1.1 1996/03/21 17:19:55 mclareni
-* Bvsl
-*
-*
-*
-* defsp.inc
-*
-#if defined(CERNLIB_SINGLE)
- REAL
-#endif
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION
-#endif
diff --git a/src/mathlib/bvsl/bvslftn/dgthrb.F b/src/mathlib/bvsl/bvslftn/dgthrb.F
deleted file mode 100644
index b630fad..0000000
--- a/src/mathlib/bvsl/bvslftn/dgthrb.F
+++ /dev/null
@@ -1,35 +0,0 @@
-*
-* $Id: dgthrb.F,v 1.1.1.1 1996/03/21 17:19:55 mclareni Exp $
-*
-* $Log: dgthrb.F,v $
-* Revision 1.1.1.1 1996/03/21 17:19:55 mclareni
-* Bvsl
-*
-*
-#include "pilot.h"
-*CMZ : 06/11/90 14.36.25 by Michel Roethlisberger/IBM
-*-- Author :
- SUBROUTINE DGTHRB (NW,X,LV,XGAT)
-C
-C ************************************************************
-C * *
-C * Author: M.Roethlisberger/IBM *
-C * *
-C * Date: 6 Nov 1990, V1.01, Creation of the module *
-C * *
-C ************************************************************
-C
-C
- LOGICAL LV(NW)
-#include "defsp.inc"
- + X (NW) , XGAT(NW)
-
- J = 0
- DO 1 I = 1,NW
- IF (LV(I)) THEN
- J = J + 1
- XGAT(J) = X(I)
- ENDIF
- 1 CONTINUE
- RETURN
- END
diff --git a/src/mathlib/bvsl/bvslftn/dmod3b.F b/src/mathlib/bvsl/bvslftn/dmod3b.F
deleted file mode 100644
index 5d54d2d..0000000
--- a/src/mathlib/bvsl/bvslftn/dmod3b.F
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: dmod3b.F,v 1.1.1.1 1996/03/21 17:19:55 mclareni Exp $
-*
-* $Log: dmod3b.F,v $
-* Revision 1.1.1.1 1996/03/21 17:19:55 mclareni
-* Bvsl
-*
-*
-#include "pilot.h"
-*CMZ : 06/11/90 14.36.25 by Michel Roethlisberger/IBM
-*-- Author :
- SUBROUTINE DMOD3B (N,A1,A2,A3,OUT,LV)
-C
-C ************************************************************
-C * *
-C * Author: M.Roethlisberger/IBM *
-C * *
-C * Date: 6 Nov 1990, V1.01, Creation of the module *
-C * *
-C ************************************************************
-C
-#include "defsp.inc"
- + A1(N), A2(N), A3(N), OUT(N)
- LOGICAL LV(N)
- DO 1 I = 1,N
- IF (LV(I)) OUT(I)=SQRT(A1(I)**2+A2(I)**2+A3(I)**2)
- 1 CONTINUE
- RETURN
- END
diff --git a/src/mathlib/bvsl/bvslftn/dotb.F b/src/mathlib/bvsl/bvslftn/dotb.F
deleted file mode 100644
index f255f17..0000000
--- a/src/mathlib/bvsl/bvslftn/dotb.F
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: dotb.F,v 1.1.1.1 1996/03/21 17:19:55 mclareni Exp $
-*
-* $Log: dotb.F,v $
-* Revision 1.1.1.1 1996/03/21 17:19:55 mclareni
-* Bvsl
-*
-*
-#include "pilot.h"
-*CMZ : 06/11/90 14.36.25 by Michel Roethlisberger/IBM
-*-- Author :
- FUNCTION DOTB (NW,LV,Y,X)
- LOGICAL LV(*)
- DIMENSION Y (*), X(*)
- DOTB=0.
- DO 1 I = 1,NW
- IF(LV(I)) DOTB=DOTB+Y(I)*X(I)
- 1 CONTINUE
- RETURN
- END
diff --git a/src/mathlib/bvsl/bvslftn/drangb.F b/src/mathlib/bvsl/bvslftn/drangb.F
deleted file mode 100644
index aaa5453..0000000
--- a/src/mathlib/bvsl/bvslftn/drangb.F
+++ /dev/null
@@ -1,35 +0,0 @@
-*
-* $Id: drangb.F,v 1.1.1.1 1996/03/21 17:19:55 mclareni Exp $
-*
-* $Log: drangb.F,v $
-* Revision 1.1.1.1 1996/03/21 17:19:55 mclareni
-* Bvsl
-*
-*
-#include "pilot.h"
-*CMZ : 06/11/90 14.36.25 by Michel Roethlisberger/IBM
-*-- Author :
- SUBROUTINE DRANGB (NW,V,HIGH,LOW,LV,NFND)
-C
-C ************************************************************
-C * *
-C * Author: M.Roethlisberger/IBM *
-C * *
-C * Date: 6 Nov 1990, V1.01, Creation of the module *
-C * *
-C ************************************************************
-C
- LOGICAL LV(NW)
-#include "defsp.inc"
- + LOW , HIGH , V(NW)
-
- DO 1 I = 1,NW
- LV(I) = V(I).GE.LOW.AND.V(I).LE.HIGH
- 1 CONTINUE
-
- NFND = 0
- DO 2 I = 1,NW
- IF(LV(I)) NFND = NFND+1
- 2 CONTINUE
- RETURN
- END
diff --git a/src/mathlib/bvsl/bvslftn/dscalb.F b/src/mathlib/bvsl/bvslftn/dscalb.F
deleted file mode 100644
index 263bd26..0000000
--- a/src/mathlib/bvsl/bvslftn/dscalb.F
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: dscalb.F,v 1.1.1.1 1996/03/21 17:19:55 mclareni Exp $
-*
-* $Log: dscalb.F,v $
-* Revision 1.1.1.1 1996/03/21 17:19:55 mclareni
-* Bvsl
-*
-*
-#include "pilot.h"
-*CMZ : 06/11/90 14.36.25 by Michel Roethlisberger/IBM
-*-- Author :
- SUBROUTINE DSCALB (NW,LV,Y,ALPHA)
-C
-C ************************************************************
-C * *
-C * Author: M.Roethlisberger/IBM *
-C * *
-C * Date: 6 Nov 1990, V1.01, Creation of the module *
-C * *
-C ************************************************************
-C
- LOGICAL LV(*)
-#include "defsp.inc"
- + Y (*), ALPHA
- DO 1 I = 1,NW
- IF (LV(I)) Y(I)=Y(I)*ALPHA
- 1 CONTINUE
- RETURN
- END
diff --git a/src/mathlib/bvsl/bvslftn/dscttb.F b/src/mathlib/bvsl/bvslftn/dscttb.F
deleted file mode 100644
index 03c229f..0000000
--- a/src/mathlib/bvsl/bvslftn/dscttb.F
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: dscttb.F,v 1.1.1.1 1996/03/21 17:19:55 mclareni Exp $
-*
-* $Log: dscttb.F,v $
-* Revision 1.1.1.1 1996/03/21 17:19:55 mclareni
-* Bvsl
-*
-*
-#include "pilot.h"
-*CMZ : 06/11/90 14.36.25 by Michel Roethlisberger/IBM
-*-- Author :
- SUBROUTINE DSCTTB (NW,XSCAT,LV,X)
-C
-C ************************************************************
-C * *
-C * Author: M.Roethlisberger/IBM *
-C * *
-C * Date: 6 Nov 1990, V1.01, Creation of the module *
-C * *
-C ************************************************************
-C
- LOGICAL LV(NW)
-#include "defsp.inc"
- + X (NW) , XSCAT(NW)
-
- J = 0
- DO 1 I = 1,NW
- IF (LV(I)) THEN
- J = J + 1
- XSCAT(I) = X(J)
- ENDIF
- 1 CONTINUE
- RETURN
- END
diff --git a/src/mathlib/bvsl/bvslftn/dsxpyb.F b/src/mathlib/bvsl/bvslftn/dsxpyb.F
deleted file mode 100644
index 52a706f..0000000
--- a/src/mathlib/bvsl/bvslftn/dsxpyb.F
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: dsxpyb.F,v 1.1.1.1 1996/03/21 17:19:55 mclareni Exp $
-*
-* $Log: dsxpyb.F,v $
-* Revision 1.1.1.1 1996/03/21 17:19:55 mclareni
-* Bvsl
-*
-*
-#include "pilot.h"
-*CMZ : 06/11/90 14.36.25 by Michel Roethlisberger/IBM
-*-- Author :
- SUBROUTINE DSXPYB (NW,LV,Y,X,ALPHA)
-C
-C ************************************************************
-C * *
-C * Author: M.Roethlisberger/IBM *
-C * *
-C * Date: 6 Nov 1990, V1.01, Creation of the module *
-C * *
-C ************************************************************
-C
- LOGICAL LV(*)
-#include "defsp.inc"
- + Y (*), X(*), ALPHA
- DO 1 I = 1,NW
- IF(LV(I)) Y(I) = Y(I) + ALPHA*X(I)
- 1 CONTINUE
- RETURN
- END
diff --git a/src/mathlib/bvsl/bvslftn/dsxyb.F b/src/mathlib/bvsl/bvslftn/dsxyb.F
deleted file mode 100644
index 787c2ed..0000000
--- a/src/mathlib/bvsl/bvslftn/dsxyb.F
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: dsxyb.F,v 1.1.1.1 1996/03/21 17:19:55 mclareni Exp $
-*
-* $Log: dsxyb.F,v $
-* Revision 1.1.1.1 1996/03/21 17:19:55 mclareni
-* Bvsl
-*
-*
-#include "pilot.h"
-*CMZ : 06/11/90 14.36.25 by Michel Roethlisberger/IBM
-*-- Author :
- SUBROUTINE DSXYB (NW,LV,Y,X,SCAL)
-C
-C ************************************************************
-C * *
-C * Author: M.Roethlisberger/IBM *
-C * *
-C * Date: 6 Nov 1990, V1.01, Creation of the module *
-C * *
-C ************************************************************
-C
- LOGICAL LV(*)
-#include "defsp.inc"
- + Y (*), X(*), SCAL
- DO 1 I = 1,NW
- IF (LV(I)) Y(I) = SCAL*X(I)*Y(I)
- 1 CONTINUE
- RETURN
- END
diff --git a/src/mathlib/bvsl/bvslftn/dvsetb.F b/src/mathlib/bvsl/bvslftn/dvsetb.F
deleted file mode 100644
index 6c97686..0000000
--- a/src/mathlib/bvsl/bvslftn/dvsetb.F
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: dvsetb.F,v 1.1.1.1 1996/03/21 17:19:55 mclareni Exp $
-*
-* $Log: dvsetb.F,v $
-* Revision 1.1.1.1 1996/03/21 17:19:55 mclareni
-* Bvsl
-*
-*
-#include "pilot.h"
-*CMZ : 06/11/90 14.36.25 by Michel Roethlisberger/IBM
-*-- Author :
- SUBROUTINE DVSETB (NW,LV,Y,S)
-C
-C ************************************************************
-C * *
-C * Author: M.Roethlisberger/IBM *
-C * *
-C * Date: 6 Nov 1990, V1.01, Creation of the module *
-C * *
-C ************************************************************
-C
- LOGICAL LV
- DIMENSION LV(NW)
-#include "defsp.inc"
- + Y(NW), S
-
- DO 1 I = 1,NW
- IF (LV(I)) Y(I) = S
- 1 CONTINUE
- RETURN
- END
diff --git a/src/mathlib/bvsl/bvslftn/dvxpyb.F b/src/mathlib/bvsl/bvslftn/dvxpyb.F
deleted file mode 100644
index 601ecdf..0000000
--- a/src/mathlib/bvsl/bvslftn/dvxpyb.F
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: dvxpyb.F,v 1.1.1.1 1996/03/21 17:19:55 mclareni Exp $
-*
-* $Log: dvxpyb.F,v $
-* Revision 1.1.1.1 1996/03/21 17:19:55 mclareni
-* Bvsl
-*
-*
-#include "pilot.h"
-*CMZ : 06/11/90 14.36.25 by Michel Roethlisberger/IBM
-*-- Author :
- SUBROUTINE DVXPYB (NW,LV,Y,X,V)
-C
-C ************************************************************
-C * *
-C * Author: M.Roethlisberger/IBM *
-C * *
-C * Date: 6 Nov 1990, V1.01, Creation of the module *
-C * *
-C ************************************************************
-C
- LOGICAL LV(*)
-#include "defsp.inc"
- + Y (*), X(*), V(*)
- DO 1 I = 1,NW
- IF (LV(I)) Y(I)=Y(I)+V(I)*X(I)
- 1 CONTINUE
- RETURN
- END
diff --git a/src/mathlib/bvsl/bvslftn/dxypwzb.F b/src/mathlib/bvsl/bvslftn/dxypwzb.F
deleted file mode 100644
index eb938c4..0000000
--- a/src/mathlib/bvsl/bvslftn/dxypwzb.F
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: dxypwzb.F,v 1.1.1.1 1996/03/21 17:19:55 mclareni Exp $
-*
-* $Log: dxypwzb.F,v $
-* Revision 1.1.1.1 1996/03/21 17:19:55 mclareni
-* Bvsl
-*
-*
-#include "pilot.h"
-*CMZ : 06/11/90 14.36.25 by Michel Roethlisberger/IBM
-*-- Author :
- SUBROUTINE DXYPWZB (NW,LV,S,Y,X,T,V,W)
-C
-C ************************************************************
-C * *
-C * Author: M.Roethlisberger/IBM *
-C * *
-C * Date: 6 Nov 1990, V1.01, Creation of the module *
-C * *
-C ************************************************************
-C
- LOGICAL LV(*)
-#include "defsp.inc"
- + X(*), Y(*), V(*), W(*)
-#include "defsp.inc"
- + S , T
- DO 1 I = 1,NW
- IF(LV(I)) Y(I)=S*X(I)*Y(I)+T*V(I)*W(I)
- 1 CONTINUE
- RETURN
- END
diff --git a/src/mathlib/bvsl/bvslftn/dylosb.F b/src/mathlib/bvsl/bvslftn/dylosb.F
deleted file mode 100644
index 49fbfad..0000000
--- a/src/mathlib/bvsl/bvslftn/dylosb.F
+++ /dev/null
@@ -1,82 +0,0 @@
-*
-* $Id: dylosb.F,v 1.1.1.1 1996/03/21 17:19:56 mclareni Exp $
-*
-* $Log: dylosb.F,v $
-* Revision 1.1.1.1 1996/03/21 17:19:56 mclareni
-* Bvsl
-*
-*
-#include "pilot.h"
-*CMZ : 06/11/90 14.36.25 by Michel Roethlisberger/IBM
-*-- Author :
- SUBROUTINE DYLOSB (N,Y,S,LV,NB,LO)
-C
-C ************************************************************
-C * *
-C * Author: M.Roethlisberger/IBM *
-C * *
-C * Date: 6 Nov 1990, V1.01, Creation of the module *
-C * *
-C ************************************************************
-C
-C
- LOGICAL LV (N)
-#include "defsp.inc"
- + Y (N), S
- CHARACTER*2 LO
-
- IF (LO.EQ.'EQ') THEN
- NB = 0
- DO 110 I=1,N
- LV(I) = Y(I).EQ.S
- IF (LV(I)) NB = NB + 1
- 110 CONTINUE
- GOTO 999
- ENDIF
-
- IF (LO.EQ.'LT') THEN
- NB = 0
- DO 120 I=1,N
- LV(I) = Y(I).LT.S
- IF (LV(I)) NB = NB + 1
- 120 CONTINUE
- GOTO 999
- ENDIF
-
- IF (LO.EQ.'LE') THEN
- NB = 0
- DO 130 I=1,N
- LV(I) = Y(I).LE.S
- IF (LV(I)) NB = NB + 1
- 130 CONTINUE
- GOTO 999
- ENDIF
-
- IF (LO.EQ.'GT') THEN
- NB = 0
- DO 140 I=1,N
- LV(I) = Y(I).GT.S
- IF (LV(I)) NB = NB + 1
- 140 CONTINUE
- GOTO 999
- ENDIF
-
- IF (LO.EQ.'GE') THEN
- NB = 0
- DO 150 I=1,N
- LV(I) = Y(I).GE.S
- IF (LV(I)) NB = NB + 1
- 150 CONTINUE
- GOTO 999
- ENDIF
-
- IF (LO.EQ.'NE') THEN
- NB = 0
- DO 160 I=1,N
- LV(I) = Y(I).NE.S
- IF (LV(I)) NB = NB + 1
- 160 CONTINUE
- ENDIF
-
- 999 RETURN
- END
diff --git a/src/mathlib/bvsl/bvslftn/dyloxb.F b/src/mathlib/bvsl/bvslftn/dyloxb.F
deleted file mode 100644
index 4e3a23f..0000000
--- a/src/mathlib/bvsl/bvslftn/dyloxb.F
+++ /dev/null
@@ -1,82 +0,0 @@
-*
-* $Id: dyloxb.F,v 1.1.1.1 1996/03/21 17:19:56 mclareni Exp $
-*
-* $Log: dyloxb.F,v $
-* Revision 1.1.1.1 1996/03/21 17:19:56 mclareni
-* Bvsl
-*
-*
-#include "pilot.h"
-*CMZ : 06/11/90 14.36.25 by Michel Roethlisberger/IBM
-*-- Author :
- SUBROUTINE DYLOXB (N,Y,X,LV,NB,LO)
-C
-C ************************************************************
-C * *
-C * Author: M.Roethlisberger/IBM *
-C * *
-C * Date: 6 Nov 1990, V1.01, Creation of the module *
-C * *
-C ************************************************************
-C
-C
- LOGICAL LV (N)
-#include "defsp.inc"
- + Y (N), X(N)
- CHARACTER*2 LO
-
- IF (LO.EQ.'EQ') THEN
- NB = 0
- DO 110 I=1,N
- LV(I) = Y(I).EQ.X(I)
- IF (LV(I)) NB = NB + 1
- 110 CONTINUE
- GOTO 999
- ENDIF
-
- IF (LO.EQ.'LT') THEN
- NB = 0
- DO 120 I=1,N
- LV(I) = Y(I).LT.X(I)
- IF (LV(I)) NB = NB + 1
- 120 CONTINUE
- GOTO 999
- ENDIF
-
- IF (LO.EQ.'LE') THEN
- NB = 0
- DO 130 I=1,N
- LV(I) = Y(I).LE.X(I)
- IF (LV(I)) NB = NB + 1
- 130 CONTINUE
- GOTO 999
- ENDIF
-
- IF (LO.EQ.'GT') THEN
- NB = 0
- DO 140 I=1,N
- LV(I) = Y(I).GT.X(I)
- IF (LV(I)) NB = NB + 1
- 140 CONTINUE
- GOTO 999
- ENDIF
-
- IF (LO.EQ.'GE') THEN
- NB = 0
- DO 150 I=1,N
- LV(I) = Y(I).GE.X(I)
- IF (LV(I)) NB = NB + 1
- 150 CONTINUE
- GOTO 999
- ENDIF
-
- IF (LO.EQ.'NE') THEN
- NB = 0
- DO 160 I=1,N
- LV(I) = Y(I).NE.X(I)
- IF (LV(I)) NB = NB + 1
- 160 CONTINUE
- ENDIF
-
- 999 RETURN
- END
diff --git a/src/mathlib/bvsl/bvslftn/gthrb.F b/src/mathlib/bvsl/bvslftn/gthrb.F
deleted file mode 100644
index 4887c1d..0000000
--- a/src/mathlib/bvsl/bvslftn/gthrb.F
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: gthrb.F,v 1.1.1.1 1996/03/21 17:19:56 mclareni Exp $
-*
-* $Log: gthrb.F,v $
-* Revision 1.1.1.1 1996/03/21 17:19:56 mclareni
-* Bvsl
-*
-*
-#include "pilot.h"
-*CMZ : 06/11/90 14.36.25 by Michel Roethlisberger/IBM
-*-- Author :
- SUBROUTINE GTHRB (NW,X,LV,XGAT)
-C
-C ************************************************************
-C * *
-C * Author: M.Roethlisberger/IBM *
-C * *
-C * Date: 6 Nov 1990, V1.01, Creation of the module *
-C * *
-C ************************************************************
-C
- LOGICAL LV(NW)
- DIMENSION X (NW) , XGAT(NW)
-
- J = 0
- DO 1 I = 1,NW
- IF (LV(I)) THEN
- J = J + 1
- XGAT(J) = X(I)
- ENDIF
- 1 CONTINUE
- RETURN
- END
diff --git a/src/mathlib/bvsl/bvslftn/idlosb.F b/src/mathlib/bvsl/bvslftn/idlosb.F
deleted file mode 100644
index 0602c11..0000000
--- a/src/mathlib/bvsl/bvslftn/idlosb.F
+++ /dev/null
@@ -1,85 +0,0 @@
-*
-* $Id: idlosb.F,v 1.1.1.1 1996/03/21 17:19:56 mclareni Exp $
-*
-* $Log: idlosb.F,v $
-* Revision 1.1.1.1 1996/03/21 17:19:56 mclareni
-* Bvsl
-*
-*
-#include "pilot.h"
-*CMZ : 06/11/90 14.36.25 by Michel Roethlisberger/IBM
-*-- Author :
- SUBROUTINE IDLOSB (N,IY,IX,LV,NB,LO,JS)
-C
-C. *****************************************************************
-C. * *
-C. * FORTRAN version of BVSL subroutine. *
-C. * See BVSL description for purpose and usages. *
-C. * The Pseudo-BIT must be dimensioned to N, that *
-C. * is the only constraint to use both BVSL and P_BVSL *
-C. * *
-C. * Author: M.Roethlisberger/IBM *
-C. * *
-C. * DATE : 20-05-90, VERSION 1.01, CREATION *
-C. * *
-C. *****************************************************************
-C
- LOGICAL LV (N)
- DIMENSION IY (N), IX (N)
- CHARACTER*2 LO
-
- IF (LO.EQ.'EQ') THEN
- NB = 0
- DO 110 I=1,N
- LV(I) = IY(I)-IX(I).EQ.JS
- IF (LV(I)) NB = NB + 1
- 110 CONTINUE
- GOTO 999
- ENDIF
-
- IF (LO.EQ.'LT') THEN
- NB = 0
- DO 120 I=1,N
- LV(I) = IY(I)-IX(I).LT.JS
- IF (LV(I)) NB = NB + 1
- 120 CONTINUE
- GOTO 999
- ENDIF
-
- IF (LO.EQ.'LE') THEN
- NB = 0
- DO 130 I=1,N
- LV(I) = IY(I)-IX(I).LE.JS
- IF (LV(I)) NB = NB + 1
- 130 CONTINUE
- GOTO 999
- ENDIF
-
- IF (LO.EQ.'GT') THEN
- NB = 0
- DO 140 I=1,N
- LV(I) = IY(I)-IX(I).GT.JS
- IF (LV(I)) NB = NB + 1
- 140 CONTINUE
- GOTO 999
- ENDIF
-
- IF (LO.EQ.'GE') THEN
- NB = 0
- DO 150 I=1,N
- LV(I) = IY(I)-IX(I).GE.JS
- IF (LV(I)) NB = NB + 1
- 150 CONTINUE
- GOTO 999
- ENDIF
-
- IF (LO.EQ.'NE') THEN
- NB = 0
- DO 160 I=1,N
- LV(I) = IY(I)-IX(I).NE.JS
- IF (LV(I)) NB = NB + 1
- 160 CONTINUE
- ENDIF
-
- 999 RETURN
- END
diff --git a/src/mathlib/bvsl/bvslftn/intgb.F b/src/mathlib/bvsl/bvslftn/intgb.F
deleted file mode 100644
index a537a1f..0000000
--- a/src/mathlib/bvsl/bvslftn/intgb.F
+++ /dev/null
@@ -1,30 +0,0 @@
-*
-* $Id: intgb.F,v 1.1.1.1 1996/03/21 17:19:56 mclareni Exp $
-*
-* $Log: intgb.F,v $
-* Revision 1.1.1.1 1996/03/21 17:19:56 mclareni
-* Bvsl
-*
-*
-#include "pilot.h"
-*CMZ : 06/11/90 14.36.25 by Michel Roethlisberger/IBM
-*-- Author :
- SUBROUTINE INTGB (N,X,X2B,X1B,LV,NB)
-C
-C ************************************************************
-C * *
-C * Author: M.Roethlisberger/IBM *
-C * *
-C * Date: 6 Nov 1990, V1.01, Creation of the module *
-C * *
-C ************************************************************
-C
- LOGICAL LV(*)
- DIMENSION X (*), X2B(*), X1B(*)
- NB = 0
- DO 1 I = 1,N
- LV(I) = X(I).LT.X2B(I) .AND. X(I).GT.X1B(I)
- IF (LV(I)) NB = NB + 1
- 1 CONTINUE
- RETURN
- END
diff --git a/src/mathlib/bvsl/bvslftn/iylosb.F b/src/mathlib/bvsl/bvslftn/iylosb.F
deleted file mode 100644
index 160176b..0000000
--- a/src/mathlib/bvsl/bvslftn/iylosb.F
+++ /dev/null
@@ -1,88 +0,0 @@
-*
-* $Id: iylosb.F,v 1.1.1.1 1996/03/21 17:19:56 mclareni Exp $
-*
-* $Log: iylosb.F,v $
-* Revision 1.1.1.1 1996/03/21 17:19:56 mclareni
-* Bvsl
-*
-*
-#include "pilot.h"
-*CMZ : 06/11/90 14.36.24 by Michel Roethlisberger/IBM
-*-- Author :
-* Last modif.: 6 Nov 1990 at 14:19:34
- SUBROUTINE IYLOSB (N,IY,JS,LV,NB,LO)
-C
-C. *****************************************************************
-C. * *
-C. * FORTRAN version of BVSL subroutine. *
-C. * See BVSL description for purpose and usages. *
-C. * The Pseudo-BIT must be dimensioned to N, that *
-C. * is the only constraint to use both BVSL and P_BVSL *
-C. * *
-C. * Author: M.Roethlisberger/IBM *
-C. * *
-C. * Date : 20-03-90, Version 1.01, Creation *
-C. * Date : 14-05-90, Version 2.01, YGESB,YGTSB,YEQSB, *
-C. * YLESB,YLTSB,YneSB becomes*
-C. * YLOSB. *
-C. *****************************************************************
-C
- LOGICAL LV (N)
- DIMENSION IY (N)
- CHARACTER*2 LO
-
- IF (LO.EQ.'EQ') THEN
- NB = 0
- DO 110 I=1,N
- LV(I) = IY(I).EQ.JS
- IF (LV(I)) NB = NB + 1
- 110 CONTINUE
- GOTO 999
- ENDIF
-
- IF (LO.EQ.'LT') THEN
- NB = 0
- DO 120 I=1,N
- LV(I) = IY(I).LT.JS
- IF (LV(I)) NB = NB + 1
- 120 CONTINUE
- GOTO 999
- ENDIF
-
- IF (LO.EQ.'LE') THEN
- NB = 0
- DO 130 I=1,N
- LV(I) = IY(I).LE.JS
- IF (LV(I)) NB = NB + 1
- 130 CONTINUE
- GOTO 999
- ENDIF
-
- IF (LO.EQ.'GT') THEN
- NB = 0
- DO 140 I=1,N
- LV(I) = IY(I).GT.JS
- IF (LV(I)) NB = NB + 1
- 140 CONTINUE
- GOTO 999
- ENDIF
-
- IF (LO.EQ.'GE') THEN
- NB = 0
- DO 150 I=1,N
- LV(I) = IY(I).GE.JS
- IF (LV(I)) NB = NB + 1
- 150 CONTINUE
- GOTO 999
- ENDIF
-
- IF (LO.EQ.'NE') THEN
- NB = 0
- DO 160 I=1,N
- LV(I) = IY(I).NE.JS
- IF (LV(I)) NB = NB + 1
- 160 CONTINUE
- ENDIF
-
- 999 RETURN
- END
diff --git a/src/mathlib/bvsl/bvslftn/iyloxb.F b/src/mathlib/bvsl/bvslftn/iyloxb.F
deleted file mode 100644
index 7d1bac1..0000000
--- a/src/mathlib/bvsl/bvslftn/iyloxb.F
+++ /dev/null
@@ -1,81 +0,0 @@
-*
-* $Id: iyloxb.F,v 1.1.1.1 1996/03/21 17:19:56 mclareni Exp $
-*
-* $Log: iyloxb.F,v $
-* Revision 1.1.1.1 1996/03/21 17:19:56 mclareni
-* Bvsl
-*
-*
-#include "pilot.h"
-*CMZ : 06/11/90 14.36.24 by Michel Roethlisberger/IBM
-*-- Author :
- SUBROUTINE IYLOXB (N,IY,IX,LV,NB,LO)
-C
-C ************************************************************
-C * *
-C * Author: M.Roethlisberger/IBM *
-C * *
-C * Date: 6 Nov 1990, V1.01, Creation of the module *
-C * *
-C ************************************************************
-C
- LOGICAL LV (N)
- DIMENSION IY (N)
- DIMENSION IX (N)
- CHARACTER*2 LO
-
- IF (LO.EQ.'EQ') THEN
- NB = 0
- DO 110 I=1,N
- LV(I) = IY(I).EQ.IX(I)
- IF (LV(I)) NB = NB + 1
- 110 CONTINUE
- GOTO 999
- ENDIF
-
- IF (LO.EQ.'LT') THEN
- NB = 0
- DO 120 I=1,N
- LV(I) = IY(I).LT.IX(I)
- IF (LV(I)) NB = NB + 1
- 120 CONTINUE
- GOTO 999
- ENDIF
-
- IF (LO.EQ.'LE') THEN
- NB = 0
- DO 130 I=1,N
- LV(I) = IY(I).LE.IX(I)
- IF (LV(I)) NB = NB + 1
- 130 CONTINUE
- GOTO 999
- ENDIF
-
- IF (LO.EQ.'GT') THEN
- NB = 0
- DO 140 I=1,N
- LV(I) = IY(I).GT.IX(I)
- IF (LV(I)) NB = NB + 1
- 140 CONTINUE
- GOTO 999
- ENDIF
-
- IF (LO.EQ.'GE') THEN
- NB = 0
- DO 150 I=1,N
- LV(I) = IY(I).GE.IX(I)
- IF (LV(I)) NB = NB + 1
- 150 CONTINUE
- GOTO 999
- ENDIF
-
- IF (LO.EQ.'NE') THEN
- NB = 0
- DO 160 I=1,N
- LV(I) = IY(I).NE.IX(I)
- IF (LV(I)) NB = NB + 1
- 160 CONTINUE
- ENDIF
-
- 999 RETURN
- END
diff --git a/src/mathlib/bvsl/bvslftn/nandb.F b/src/mathlib/bvsl/bvslftn/nandb.F
deleted file mode 100644
index a85bfd6..0000000
--- a/src/mathlib/bvsl/bvslftn/nandb.F
+++ /dev/null
@@ -1,30 +0,0 @@
-*
-* $Id: nandb.F,v 1.1.1.1 1996/03/21 17:19:56 mclareni Exp $
-*
-* $Log: nandb.F,v $
-* Revision 1.1.1.1 1996/03/21 17:19:56 mclareni
-* Bvsl
-*
-*
-#include "pilot.h"
-*CMZ : 06/11/90 14.36.25 by Michel Roethlisberger/IBM
-*-- Author :
- SUBROUTINE NANDB (NW,LV1,LV2,LV3,N)
-C
-C ************************************************************
-C * *
-C * Author: M.Roethlisberger/IBM *
-C * *
-C * Date: 6 Nov 1990, V1.01, Creation of the module *
-C * *
-C ************************************************************
-C
- LOGICAL LV1(NW), LV2(NW), LV3(NW)
-
- N = 0
- DO 1 I = 1,NW
- LV3(I) = .NOT.(LV1(I).AND.LV2(I))
- IF (LV3(I)) N = N + 1
- 1 CONTINUE
- RETURN
- END
diff --git a/src/mathlib/bvsl/bvslftn/norb.F b/src/mathlib/bvsl/bvslftn/norb.F
deleted file mode 100644
index e565198..0000000
--- a/src/mathlib/bvsl/bvslftn/norb.F
+++ /dev/null
@@ -1,30 +0,0 @@
-*
-* $Id: norb.F,v 1.1.1.1 1996/03/21 17:19:56 mclareni Exp $
-*
-* $Log: norb.F,v $
-* Revision 1.1.1.1 1996/03/21 17:19:56 mclareni
-* Bvsl
-*
-*
-#include "pilot.h"
-*CMZ : 06/11/90 14.36.25 by Michel Roethlisberger/IBM
-*-- Author :
- SUBROUTINE NORB (NW,LV1,LV2,LV3,N)
-C
-C ************************************************************
-C * *
-C * Author: M.Roethlisberger/IBM *
-C * *
-C * Date: 6 Nov 1990, V1.01, Creation of the module *
-C * *
-C ************************************************************
-C
- LOGICAL LV1(NW), LV2(NW), LV3(NW)
-
- N = 0
- DO 1 I = 1,NW
- LV3(I) = LV1(I).EQV.LV2(I)
- IF (LV3(I)) N = N + 1
- 1 CONTINUE
- RETURN
- END
diff --git a/src/mathlib/bvsl/bvslftn/notb.F b/src/mathlib/bvsl/bvslftn/notb.F
deleted file mode 100644
index de2bb6e..0000000
--- a/src/mathlib/bvsl/bvslftn/notb.F
+++ /dev/null
@@ -1,30 +0,0 @@
-*
-* $Id: notb.F,v 1.1.1.1 1996/03/21 17:19:56 mclareni Exp $
-*
-* $Log: notb.F,v $
-* Revision 1.1.1.1 1996/03/21 17:19:56 mclareni
-* Bvsl
-*
-*
-#include "pilot.h"
-*CMZ : 06/11/90 14.36.25 by Michel Roethlisberger/IBM
-*-- Author :
- SUBROUTINE NOTB (NW,LV1,LV2,N)
-C
-C ************************************************************
-C * *
-C * Author: M.Roethlisberger/IBM *
-C * *
-C * Date: 6 Nov 1990, V1.01, Creation of the module *
-C * *
-C ************************************************************
-C
- LOGICAL LV1(NW), LV2(NW)
-
- N = 0
- DO 1 I = 1,NW
- LV2(I) = .NOT.LV1(I)
- IF (LV2(I)) N = N +1
- 1 CONTINUE
- RETURN
- END
diff --git a/src/mathlib/bvsl/bvslftn/oneb.F b/src/mathlib/bvsl/bvslftn/oneb.F
deleted file mode 100644
index 6a87ff2..0000000
--- a/src/mathlib/bvsl/bvslftn/oneb.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: oneb.F,v 1.1.1.1 1996/03/21 17:19:56 mclareni Exp $
-*
-* $Log: oneb.F,v $
-* Revision 1.1.1.1 1996/03/21 17:19:56 mclareni
-* Bvsl
-*
-*
-#include "pilot.h"
-*CMZ : 06/11/90 14.36.25 by Michel Roethlisberger/IBM
-*-- Author :
-C --------------------- BIT OPERATIONS ------------------------
- SUBROUTINE ONEB (NW,LV)
-C
-C ************************************************************
-C * *
-C * Author: M.Roethlisberger/IBM *
-C * *
-C * Date: 6 Nov 1990, V1.01, Creation of the module *
-C * *
-C ************************************************************
-C
- LOGICAL LV(NW)
- DO 1 I = 1,NW
- LV(I) = .TRUE.
- 1 CONTINUE
- RETURN
- END
diff --git a/src/mathlib/bvsl/bvslftn/orb.F b/src/mathlib/bvsl/bvslftn/orb.F
deleted file mode 100644
index 39fc7bd..0000000
--- a/src/mathlib/bvsl/bvslftn/orb.F
+++ /dev/null
@@ -1,30 +0,0 @@
-*
-* $Id: orb.F,v 1.1.1.1 1996/03/21 17:19:56 mclareni Exp $
-*
-* $Log: orb.F,v $
-* Revision 1.1.1.1 1996/03/21 17:19:56 mclareni
-* Bvsl
-*
-*
-#include "pilot.h"
-*CMZ : 06/11/90 14.36.25 by Michel Roethlisberger/IBM
-*-- Author :
- SUBROUTINE ORB (NW,LV1,LV2,LV3,N)
-C
-C ************************************************************
-C * *
-C * Author: M.Roethlisberger/IBM *
-C * *
-C * Date: 6 Nov 1990, V1.01, Creation of the module *
-C * *
-C ************************************************************
-C
- LOGICAL LV1(NW), LV2(NW), LV3(NW)
-
- N = 0
- DO 1 I = 1,NW
- LV3(I) = LV1(I).OR.LV2(I)
- IF (LV3(I)) N = N + 1
- 1 CONTINUE
- RETURN
- END
diff --git a/src/mathlib/bvsl/bvslftn/ornotb.F b/src/mathlib/bvsl/bvslftn/ornotb.F
deleted file mode 100644
index 1e7ed7f..0000000
--- a/src/mathlib/bvsl/bvslftn/ornotb.F
+++ /dev/null
@@ -1,30 +0,0 @@
-*
-* $Id: ornotb.F,v 1.1.1.1 1996/03/21 17:19:56 mclareni Exp $
-*
-* $Log: ornotb.F,v $
-* Revision 1.1.1.1 1996/03/21 17:19:56 mclareni
-* Bvsl
-*
-*
-#include "pilot.h"
-*CMZ : 06/11/90 14.36.25 by Michel Roethlisberger/IBM
-*-- Author :
- SUBROUTINE ORNOTB (NW,LV1,LV2,LV3,N)
-C
-C ************************************************************
-C * *
-C * Author: M.Roethlisberger/IBM *
-C * *
-C * Date: 6 Nov 1990, V1.01, Creation of the module *
-C * *
-C ************************************************************
-C
- LOGICAL LV1(NW),LV2(NW),LV3(NW)
-
- N = 0
- DO 1 I = 1,NW
- LV3(I) = LV1(I).OR..NOT.LV2(I)
- IF (LV3(I)) N = N + 1
- 1 CONTINUE
- RETURN
- END
diff --git a/src/mathlib/bvsl/bvslftn/pilot.h b/src/mathlib/bvsl/bvslftn/pilot.h
deleted file mode 100644
index f148821..0000000
--- a/src/mathlib/bvsl/bvslftn/pilot.h
+++ /dev/null
@@ -1,11 +0,0 @@
-#if defined(CERNLIB_IBM)||defined(CERNLIB_VAX)||defined(CERNLIB_NORD)
-#ifndef CERNLIB_DOUBLE
-#define CERNLIB_DOUBLE
-#endif
-#endif
-
-#if (defined(CERNLIB_UNIX))&&(!defined(CERNLIB_SINGLE))
-#ifndef CERNLIB_DOUBLE
-#define CERNLIB_DOUBLE
-#endif
-#endif
diff --git a/src/mathlib/bvsl/bvslftn/rangb.F b/src/mathlib/bvsl/bvslftn/rangb.F
deleted file mode 100644
index 7b7d089..0000000
--- a/src/mathlib/bvsl/bvslftn/rangb.F
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: rangb.F,v 1.1.1.1 1996/03/21 17:19:56 mclareni Exp $
-*
-* $Log: rangb.F,v $
-* Revision 1.1.1.1 1996/03/21 17:19:56 mclareni
-* Bvsl
-*
-*
-#include "pilot.h"
-*CMZ : 06/11/90 14.36.24 by Michel Roethlisberger/IBM
-*-- Author :
- SUBROUTINE RANGB (NW,V,HIGH,LOW,LV,NFND)
-C
-C ************************************************************
-C * *
-C * Author: M.Roethlisberger/IBM *
-C * *
-C * Date: 6 Nov 1990, V1.01, Creation of the module *
-C * *
-C ************************************************************
-C
- DIMENSION V (NW)
- LOGICAL LV(NW)
- REAL LOW
- DO 1 I = 1,NW
- LV(I) = V(I).GE.LOW.AND.V(I).LE.HIGH
- 1 CONTINUE
-
- NFND = 0
- DO 2 I = 1,NW
- IF(LV(I)) NFND = NFND+1
- 2 CONTINUE
- RETURN
- END
diff --git a/src/mathlib/bvsl/bvslftn/rjctb.F b/src/mathlib/bvsl/bvslftn/rjctb.F
deleted file mode 100644
index aa70b7f..0000000
--- a/src/mathlib/bvsl/bvslftn/rjctb.F
+++ /dev/null
@@ -1,57 +0,0 @@
-*
-* $Id: rjctb.F,v 1.1.1.1 1996/03/21 17:19:56 mclareni Exp $
-*
-* $Log: rjctb.F,v $
-* Revision 1.1.1.1 1996/03/21 17:19:56 mclareni
-* Bvsl
-*
-*
-#include "pilot.h"
-*CMZ : 06/11/90 14.36.25 by Michel Roethlisberger/IBM
-*-- Author :
- SUBROUTINE RJCTB (RAN,XIN,FREJ,XOUT,LV,N,NWOUT,ISW)
-C
-C ************************************************************
-C * *
-C * Author: M.Roethlisberger/IBM *
-C * *
-C * Date: 6 Nov 1990, V1.01, Creation of the module *
-C * *
-C ************************************************************
-C
- LOGICAL LV (*)
- DIMENSION RAN(*), XIN(*), FREJ(*), XOUT(*)
-
- K = 0
-
- IF (ISW.EQ.1) THEN
- DO 1 I = 1,N
- IF (FREJ(I).GT.RAN(I)) THEN
- XOUT(I) = XIN(I)
- LV(I) = .FALSE.
- ELSE
- LV(I) = .TRUE.
- K = K + 1
- ENDIF
- 1 CONTINUE
- ISW = 2
-
- ELSE
-
- J = 0
- DO 2 I = 1,N
- IF (LV(I)) THEN
- J=J+1
- IF (FREJ(J).GT.RAN(J)) THEN
- XOUT(I) = XIN(J)
- LV (I) = .FALSE.
- ELSE
- K = K + 1
- ENDIF
- ENDIF
- 2 CONTINUE
-
- ENDIF
- NWOUT = K
- RETURN
- END
diff --git a/src/mathlib/bvsl/bvslftn/scalb.F b/src/mathlib/bvsl/bvslftn/scalb.F
deleted file mode 100644
index 8222ca0..0000000
--- a/src/mathlib/bvsl/bvslftn/scalb.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: scalb.F,v 1.1.1.1 1996/03/21 17:19:56 mclareni Exp $
-*
-* $Log: scalb.F,v $
-* Revision 1.1.1.1 1996/03/21 17:19:56 mclareni
-* Bvsl
-*
-*
-#include "pilot.h"
-*CMZ : 06/11/90 14.36.25 by Michel Roethlisberger/IBM
-*-- Author :
- SUBROUTINE SCALB (NW,LV,Y,ALPHA)
-C
-C ************************************************************
-C * *
-C * Author: M.Roethlisberger/IBM *
-C * *
-C * Date: 6 Nov 1990, V1.01, Creation of the module *
-C * *
-C ************************************************************
-C
- LOGICAL LV(*)
- DIMENSION Y (*)
- DO 1 I = 1,NW
- IF (LV(I)) Y(I)=Y(I)*ALPHA
- 1 CONTINUE
- RETURN
- END
diff --git a/src/mathlib/bvsl/bvslftn/scttb.F b/src/mathlib/bvsl/bvslftn/scttb.F
deleted file mode 100644
index d6a1084..0000000
--- a/src/mathlib/bvsl/bvslftn/scttb.F
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: scttb.F,v 1.1.1.1 1996/03/21 17:19:56 mclareni Exp $
-*
-* $Log: scttb.F,v $
-* Revision 1.1.1.1 1996/03/21 17:19:56 mclareni
-* Bvsl
-*
-*
-#include "pilot.h"
-*CMZ : 06/11/90 14.36.25 by Michel Roethlisberger/IBM
-*-- Author :
- SUBROUTINE SCTTB (NW,XSCAT,LV,X)
-C
-C ************************************************************
-C * *
-C * Author: M.Roethlisberger/IBM *
-C * *
-C * Date: 6 Nov 1990, V1.01, Creation of the module *
-C * *
-C ************************************************************
-C
- LOGICAL LV(NW)
- DIMENSION X (NW) , XSCAT(NW)
-
- J = 0
- DO 1 I = 1,NW
- IF (LV(I)) THEN
- J = J + 1
- XSCAT(I) = X(J)
- ENDIF
- 1 CONTINUE
- RETURN
- END
diff --git a/src/mathlib/bvsl/bvslftn/smod3b.F b/src/mathlib/bvsl/bvslftn/smod3b.F
deleted file mode 100644
index 0aa3579..0000000
--- a/src/mathlib/bvsl/bvslftn/smod3b.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: smod3b.F,v 1.1.1.1 1996/03/21 17:19:56 mclareni Exp $
-*
-* $Log: smod3b.F,v $
-* Revision 1.1.1.1 1996/03/21 17:19:56 mclareni
-* Bvsl
-*
-*
-#include "pilot.h"
-*CMZ : 06/11/90 14.36.25 by Michel Roethlisberger/IBM
-*-- Author :
- SUBROUTINE SMOD3B (N,A1,A2,A3,OUT,LV)
-C
-C ************************************************************
-C * *
-C * Author: M.Roethlisberger/IBM *
-C * *
-C * Date: 6 Nov 1990, V1.01, Creation of the module *
-C * *
-C ************************************************************
-C
- DIMENSION A1(N), A2(N), A3(N), OUT(N)
- LOGICAL LV(N)
- DO 1 I = 1,N
- IF (LV(I)) OUT(I)=SQRT(A1(I)**2+A2(I)**2+A3(I)**2)
- 1 CONTINUE
- RETURN
- END
diff --git a/src/mathlib/bvsl/bvslftn/sxpyb.F b/src/mathlib/bvsl/bvslftn/sxpyb.F
deleted file mode 100644
index 374bd3f..0000000
--- a/src/mathlib/bvsl/bvslftn/sxpyb.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: sxpyb.F,v 1.1.1.1 1996/03/21 17:19:56 mclareni Exp $
-*
-* $Log: sxpyb.F,v $
-* Revision 1.1.1.1 1996/03/21 17:19:56 mclareni
-* Bvsl
-*
-*
-#include "pilot.h"
-*CMZ : 06/11/90 14.36.25 by Michel Roethlisberger/IBM
-*-- Author :
- SUBROUTINE SXPYB (NW,LV,Y,X,ALPHA)
-C
-C ************************************************************
-C * *
-C * Author: M.Roethlisberger/IBM *
-C * *
-C * Date: 6 Nov 1990, V1.01, Creation of the module *
-C * *
-C ************************************************************
-C
- LOGICAL LV(*)
- DIMENSION Y (*), X(*)
- DO 1 I = 1,NW
- IF(LV(I)) Y(I) = Y(I) + ALPHA*X(I)
- 1 CONTINUE
- RETURN
- END
diff --git a/src/mathlib/bvsl/bvslftn/sxyb.F b/src/mathlib/bvsl/bvslftn/sxyb.F
deleted file mode 100644
index a450494..0000000
--- a/src/mathlib/bvsl/bvslftn/sxyb.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: sxyb.F,v 1.1.1.1 1996/03/21 17:19:56 mclareni Exp $
-*
-* $Log: sxyb.F,v $
-* Revision 1.1.1.1 1996/03/21 17:19:56 mclareni
-* Bvsl
-*
-*
-#include "pilot.h"
-*CMZ : 06/11/90 14.36.25 by Michel Roethlisberger/IBM
-*-- Author :
- SUBROUTINE SXYB (NW,LV,Y,X,SCAL)
-C
-C ************************************************************
-C * *
-C * Author: M.Roethlisberger/IBM *
-C * *
-C * Date: 6 Nov 1990, V1.01, Creation of the module *
-C * *
-C ************************************************************
-C
- LOGICAL LV(*)
- DIMENSION Y (*), X(*)
- DO 1 I = 1,NW
- IF (LV(I)) Y(I) = SCAL*X(I)*Y(I)
- 1 CONTINUE
- RETURN
- END
diff --git a/src/mathlib/bvsl/bvslftn/vsetb.F b/src/mathlib/bvsl/bvslftn/vsetb.F
deleted file mode 100644
index 2bcbca6..0000000
--- a/src/mathlib/bvsl/bvslftn/vsetb.F
+++ /dev/null
@@ -1,30 +0,0 @@
-*
-* $Id: vsetb.F,v 1.1.1.1 1996/03/21 17:19:56 mclareni Exp $
-*
-* $Log: vsetb.F,v $
-* Revision 1.1.1.1 1996/03/21 17:19:56 mclareni
-* Bvsl
-*
-*
-#include "pilot.h"
-*CMZ : 06/11/90 14.36.25 by Michel Roethlisberger/IBM
-*-- Author :
-C ------------------ EXTENDED LINEAR ALGEBRA -------------------------
- SUBROUTINE VSETB (NW,LV,Y,S)
-C
-C ************************************************************
-C * *
-C * Author: M.Roethlisberger/IBM *
-C * *
-C * Date: 6 Nov 1990, V1.01, Creation of the module *
-C * *
-C ************************************************************
-C
- LOGICAL LV
- DIMENSION LV(NW), Y(NW)
-
- DO 1 I = 1,NW
- IF (LV(I)) Y(I) = S
- 1 CONTINUE
- RETURN
- END
diff --git a/src/mathlib/bvsl/bvslftn/vxpyb.F b/src/mathlib/bvsl/bvslftn/vxpyb.F
deleted file mode 100644
index 9945fa0..0000000
--- a/src/mathlib/bvsl/bvslftn/vxpyb.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: vxpyb.F,v 1.1.1.1 1996/03/21 17:19:56 mclareni Exp $
-*
-* $Log: vxpyb.F,v $
-* Revision 1.1.1.1 1996/03/21 17:19:56 mclareni
-* Bvsl
-*
-*
-#include "pilot.h"
-*CMZ : 06/11/90 14.36.25 by Michel Roethlisberger/IBM
-*-- Author :
- SUBROUTINE VXPYB (NW,LV,Y,X,V)
-C
-C ************************************************************
-C * *
-C * Author: M.Roethlisberger/IBM *
-C * *
-C * Date: 6 Nov 1990, V1.01, Creation of the module *
-C * *
-C ************************************************************
-C
- LOGICAL LV(*)
- DIMENSION Y (*), X(*), V(*)
- DO 1 I = 1,NW
- IF (LV(I)) Y(I)=Y(I)+V(I)*X(I)
- 1 CONTINUE
- RETURN
- END
diff --git a/src/mathlib/bvsl/bvslftn/xorb.F b/src/mathlib/bvsl/bvslftn/xorb.F
deleted file mode 100644
index ccc53f3..0000000
--- a/src/mathlib/bvsl/bvslftn/xorb.F
+++ /dev/null
@@ -1,30 +0,0 @@
-*
-* $Id: xorb.F,v 1.1.1.1 1996/03/21 17:19:56 mclareni Exp $
-*
-* $Log: xorb.F,v $
-* Revision 1.1.1.1 1996/03/21 17:19:56 mclareni
-* Bvsl
-*
-*
-#include "pilot.h"
-*CMZ : 06/11/90 14.36.25 by Michel Roethlisberger/IBM
-*-- Author :
- SUBROUTINE XORB (NW,LV1,LV2,LV3,N)
-C
-C ************************************************************
-C * *
-C * Author: M.Roethlisberger/IBM *
-C * *
-C * Date: 6 Nov 1990, V1.01, Creation of the module *
-C * *
-C ************************************************************
-C
- LOGICAL LV1(NW), LV2(NW), LV3(NW)
-
- N = 0
- DO 1 I = 1,NW
- LV3(I) = LV1(I).NEQV.LV2(I)
- IF (LV3(I)) N = N + 1
- 1 CONTINUE
- RETURN
- END
diff --git a/src/mathlib/bvsl/bvslftn/xypwzb.F b/src/mathlib/bvsl/bvslftn/xypwzb.F
deleted file mode 100644
index 297e116..0000000
--- a/src/mathlib/bvsl/bvslftn/xypwzb.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: xypwzb.F,v 1.1.1.1 1996/03/21 17:19:56 mclareni Exp $
-*
-* $Log: xypwzb.F,v $
-* Revision 1.1.1.1 1996/03/21 17:19:56 mclareni
-* Bvsl
-*
-*
-#include "pilot.h"
-*CMZ : 06/11/90 14.36.25 by Michel Roethlisberger/IBM
-*-- Author :
- SUBROUTINE XYPWZB (NW,LV,S,Y,X,T,V,W)
-C
-C ************************************************************
-C * *
-C * Author: M.Roethlisberger/IBM *
-C * *
-C * Date: 6 Nov 1990, V1.01, Creation of the module *
-C * *
-C ************************************************************
-C
- LOGICAL LV(*)
- DIMENSION X(*), Y(*), V(*), W(*)
- DO 1 I = 1,NW
- IF(LV(I)) Y(I)=S*X(I)*Y(I)+T*V(I)*W(I)
- 1 CONTINUE
- RETURN
- END
diff --git a/src/mathlib/bvsl/bvslftn/ylosb.F b/src/mathlib/bvsl/bvslftn/ylosb.F
deleted file mode 100644
index ae01211..0000000
--- a/src/mathlib/bvsl/bvslftn/ylosb.F
+++ /dev/null
@@ -1,87 +0,0 @@
-*
-* $Id: ylosb.F,v 1.1.1.1 1996/03/21 17:19:56 mclareni Exp $
-*
-* $Log: ylosb.F,v $
-* Revision 1.1.1.1 1996/03/21 17:19:56 mclareni
-* Bvsl
-*
-*
-#include "pilot.h"
-*CMZ : 06/11/90 14.36.24 by Michel Roethlisberger/IBM
-*-- Author :
- SUBROUTINE YLOSB (N,Y,S,LV,NB,LO)
-C
-C. *****************************************************************
-C. * *
-C. * FORTRAN version of BVSL subroutine. *
-C. * See BVSL description for purpose and usages. *
-C. * The Pseudo-BIT must be dimensioned to N, that *
-C. * is the only constraint to use both BVSL and P_BVSL *
-C. * *
-C. * Author: M.Roethlisberger/IBM *
-C. * *
-C. * Date : 20-03-90, Version 1.01, Creation *
-C. * Date : 14-05-90, Version 2.01, YGESB,YGTSB,YEQSB, *
-C. * YLESB,YLTSB,YneSB becomes*
-C. * YLOSB. *
-C. *****************************************************************
-C
- LOGICAL LV (N)
- DIMENSION Y (N)
- CHARACTER*2 LO
-
- IF (LO.EQ.'EQ') THEN
- NB = 0
- DO 110 I=1,N
- LV(I) = Y(I).EQ.S
- IF (LV(I)) NB = NB + 1
- 110 CONTINUE
- GOTO 999
- ENDIF
-
- IF (LO.EQ.'LT') THEN
- NB = 0
- DO 120 I=1,N
- LV(I) = Y(I).LT.S
- IF (LV(I)) NB = NB + 1
- 120 CONTINUE
- GOTO 999
- ENDIF
-
- IF (LO.EQ.'LE') THEN
- NB = 0
- DO 130 I=1,N
- LV(I) = Y(I).LE.S
- IF (LV(I)) NB = NB + 1
- 130 CONTINUE
- GOTO 999
- ENDIF
-
- IF (LO.EQ.'GT') THEN
- NB = 0
- DO 140 I=1,N
- LV(I) = Y(I).GT.S
- IF (LV(I)) NB = NB + 1
- 140 CONTINUE
- GOTO 999
- ENDIF
-
- IF (LO.EQ.'GE') THEN
- NB = 0
- DO 150 I=1,N
- LV(I) = Y(I).GE.S
- IF (LV(I)) NB = NB + 1
- 150 CONTINUE
- GOTO 999
- ENDIF
-
- IF (LO.EQ.'NE') THEN
- NB = 0
- DO 160 I=1,N
- LV(I) = Y(I).NE.S
- IF (LV(I)) NB = NB + 1
- 160 CONTINUE
- ENDIF
-
- 999 RETURN
- END
diff --git a/src/mathlib/bvsl/bvslftn/yloxb.F b/src/mathlib/bvsl/bvslftn/yloxb.F
deleted file mode 100644
index 560dc6f..0000000
--- a/src/mathlib/bvsl/bvslftn/yloxb.F
+++ /dev/null
@@ -1,88 +0,0 @@
-*
-* $Id: yloxb.F,v 1.1.1.1 1996/03/21 17:19:56 mclareni Exp $
-*
-* $Log: yloxb.F,v $
-* Revision 1.1.1.1 1996/03/21 17:19:56 mclareni
-* Bvsl
-*
-*
-#include "pilot.h"
-*CMZ : 06/11/90 14.36.24 by Michel Roethlisberger/IBM
-*-- Author :
- SUBROUTINE YLOXB (N,Y,X,LV,NB,LO)
-C
-C. *****************************************************************
-C. * *
-C. * FORTRAN version of BVSL subroutine. *
-C. * See BVSL description for purpose and usages. *
-C. * The Pseudo-BIT must be dimensioned to N, that *
-C. * is the only constraint to use both BVSL and P_BVSL *
-C. * *
-C. * Author: M.Roethlisberger/IBM *
-C. * *
-C. * Date : 20-03-90, Version 1.01, Creation *
-C. * Date : 14-05-90, Version 2.01, YGESB,YGTSB,YEQSB, *
-C. * YLESB,YLTSB,YneSB becomes*
-C. * YLOSB. *
-C. *****************************************************************
-C
- LOGICAL LV (N)
- DIMENSION Y (N)
- DIMENSION X (N)
- CHARACTER*2 LO
-
- IF (LO.EQ.'EQ') THEN
- NB = 0
- DO 110 I=1,N
- LV(I) = Y(I).EQ.X(I)
- IF (LV(I)) NB = NB + 1
- 110 CONTINUE
- GOTO 999
- ENDIF
-
- IF (LO.EQ.'LT') THEN
- NB = 0
- DO 120 I=1,N
- LV(I) = Y(I).LT.X(I)
- IF (LV(I)) NB = NB + 1
- 120 CONTINUE
- GOTO 999
- ENDIF
-
- IF (LO.EQ.'LE') THEN
- NB = 0
- DO 130 I=1,N
- LV(I) = Y(I).LE.X(I)
- IF (LV(I)) NB = NB + 1
- 130 CONTINUE
- GOTO 999
- ENDIF
-
- IF (LO.EQ.'GT') THEN
- NB = 0
- DO 140 I=1,N
- LV(I) = Y(I).GT.X(I)
- IF (LV(I)) NB = NB + 1
- 140 CONTINUE
- GOTO 999
- ENDIF
-
- IF (LO.EQ.'GE') THEN
- NB = 0
- DO 150 I=1,N
- LV(I) = Y(I).GE.X(I)
- IF (LV(I)) NB = NB + 1
- 150 CONTINUE
- GOTO 999
- ENDIF
-
- IF (LO.EQ.'NE') THEN
- NB = 0
- DO 160 I=1,N
- LV(I) = Y(I).NE.X(I)
- IF (LV(I)) NB = NB + 1
- 160 CONTINUE
- ENDIF
-
- 999 RETURN
- END
diff --git a/src/mathlib/bvsl/bvslftn/zerob.F b/src/mathlib/bvsl/bvslftn/zerob.F
deleted file mode 100644
index 728f009..0000000
--- a/src/mathlib/bvsl/bvslftn/zerob.F
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: zerob.F,v 1.1.1.1 1996/03/21 17:19:56 mclareni Exp $
-*
-* $Log: zerob.F,v $
-* Revision 1.1.1.1 1996/03/21 17:19:56 mclareni
-* Bvsl
-*
-*
-#include "pilot.h"
-*CMZ : 06/11/90 14.36.25 by Michel Roethlisberger/IBM
-*-- Author :
- SUBROUTINE ZEROB (NW,LV)
-C
-C ************************************************************
-C * *
-C * Author: M.Roethlisberger/IBM *
-C * *
-C * Date: 6 Nov 1990, V1.01, Creation of the module *
-C * *
-C ************************************************************
-C
- LOGICAL LV(NW)
- DO 1 I = 1,NW
- LV(I) = .FALSE.
- 1 CONTINUE
- RETURN
- END
diff --git a/src/mathlib/bvsl/bvslibm/aintgb.s b/src/mathlib/bvsl/bvslibm/aintgb.s
deleted file mode 100644
index b8ddcd3..0000000
--- a/src/mathlib/bvsl/bvslibm/aintgb.s
+++ /dev/null
@@ -1,50 +0,0 @@
-*
-* $Id: aintgb.s,v 1.1.1.1 1996/03/21 17:19:58 mclareni Exp $
-*
-* $Log: aintgb.s,v $
-* Revision 1.1.1.1 1996/03/21 17:19:58 mclareni
-* Bvsl
-*
-*
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB_QMIBMVF))
-*********************************************************************
-* SUBROUTINE AINTGB(NW,AIN,UVEC,ALVEC,BV,IFOUND)
-*
-* AUTOR: F. ANTONELLI LIBRARY: BVSL
-*
-*********************************************************************
-AINTGB CSECT
-#if defined(CERNLIB_QMIBMXA)
-AINTGB AMODE 31
-AINTGB RMODE ANY
-#endif
-#include "cachesz.inc"
- USING *,15
- STM 1,10,24(13)
-*
- LM 1,6,0(1)
-*
- L 1,0(0,1)
- LR 10,2
-*
- SR 8,8
-LOOP VLVCU 1
- LA 7,VMASK
- LR 9,7
- VLD 4,4(0)
- VLD 6,3(0)
- VCD 12,4,2
- VSTVM 7
- VCD 10,6,10
- VNVM 9
- VCOVM 8
- VSTVM 5
- LTR 1,1
- BC 2,LOOP
- ST 8,0(6)
- LM 1,10,24(13)
- BR 14
-VMASK DS 4F
-*
- END
-#endif
diff --git a/src/mathlib/bvsl/bvslibm/alosb.s b/src/mathlib/bvsl/bvslibm/alosb.s
deleted file mode 100644
index 15b5462..0000000
--- a/src/mathlib/bvsl/bvslibm/alosb.s
+++ /dev/null
@@ -1,247 +0,0 @@
-*
-* $Id: alosb.s,v 1.1.1.1 1996/03/21 17:19:57 mclareni Exp $
-*
-* $Log: alosb.s,v $
-* Revision 1.1.1.1 1996/03/21 17:19:57 mclareni
-* Bvsl
-*
-*
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB_QMIBMVF))
-*CMZ : 01/05/90 14.22.46 by Michel Roethlisberger/IBM
-*-- Author :
-*********************************************************************
-* SUBROUTINE ALOSB (NW,VIN,TEST,BIT,NFND,'LO') *
-* -------------------------------------------- *
-* *
-* Library: BVSL *
-* *
-* *
-* Selects i's for which |VIN(i)| 'lo' TEST *
-* 'lo' being one of the logical operator =, <, <=, >, >=, ^= *
-* *
-* Result via Bit-vector form *
-* *
-* Input *
-* NW : Number of elements to be processed *
-* VIN : REAL*4 Input Vector *
-* TEST : REAL*4 Test Value *
-* LO : Character*2 Logical Operator *
-* ('EQ','LT','LE','GE','GT' OR 'NE') *
-* *
-* Output *
-* BIT : Bit-Vector *
-* NFND : Number of test passed (ones in BIT) *
-* *
-* *
-* Author: F.Antonelli/IBM, M.Roethlisberger/IBM *
-* Date : 24-04-90 , Vers 1.02 *
-* *
-*********************************************************************
-ALOSB CSECT
-#if defined(CERNLIB_QMIBMXA)
-ALOSB AMODE 31
-ALOSB RMODE ANY
-#endif
-#include "cachesz.inc"
- USING *,15
- STM G0,G9,20(13)
- LM G1,G6,0(1) Get addresses of parameter list
- L G1,0(0,G1) NW in G1
- LE F4,0(0,G3) TEST in F4
- SR G9,G9 Reset Register
- LA G8,SZ Load Section size
-*
- LH G6,0(0,G6)
- LA G7,CENTER
- LH G7,0(0,G7)
- CR G6,G7
- BC LT,DOWNPART LO is 'QE' or 'GE' or 'GT'
-*
- LA G7,CLT
- LH G7,0(0,G7)
- CR G6,G7
- BC LT,LESSEQUA LO IS 'LE'
- BC EQ,LESSTHAN LO IS 'LT'
-*
-* LO is 'NE'
-* --------------
-NOTEQUAL SR G8,G1 SZ - NW
- BC GE,NOSECTNE > = 0
-*
-LOOPNE VLVCU G1
- VLE V0,G2(0) Load VIN
- VLPER V0,V0 Take positive value
- VCEQ NE,F4,V0 When TEST ^= ABS(VIN)
- VCOVM G9 Count and accumulate 1's bits
- VSTVM G4 Store Vector Mask Register
- LTR G1,G1 Restore proper OC
- BC GT,LOOPNE Go back to LOOP
-*
- ST G9,0(G5) Store G9 thru NFND
- LM G0,G9,20(13)
- BR 14
-*
-NOSECTNE VLVCA 0(G1)
- VLE V0,G2(0) Load VIN
- VLPER V0,V0 Take positive value
- VCEQ NE,F4,V0 When TEST ^= ABS(VIN)
- VCOVM G9 Count and accumulate 1's bits
- VSTVM G4 Store Vector MAsk Register
- ST G9,0(G5) Store G9 thru NFND
- LM 0,9,20(13)
- BR 14
-*
-* LO is 'LE'
-* --------------
-LESSEQUA SR G8,G1 SZ - NW
- BC GE,NOSECTLE > = 0
-*
-LOOPLE VLVCU G1
- VLE V0,G2(0) Load VIN
- VLPER V0,V0 Take positive value
- VCEQ GE,F4,V0 When TEST >= ABS(VIN)
- VCOVM G9 Count and accumulate 1's bits
- VSTVM G4 Store Vector Mask Register
- LTR G1,G1 Restore proper OC
- BC GT,LOOPLE Go back to LOOP
-*
- ST G9,0(G5) Store G9 thru NFND
- LM G0,G9,20(13)
- BR 14
-*
-NOSECTLE VLVCA 0(G1)
- VLE V0,G2(0) Load VIN
- VLPER V0,V0 Take positive value
- VCEQ GE,F4,V0 When TEST >= ABS(VIN)
- VCOVM G9 Count and accumulate 1's bits
- VSTVM G4 Store Vector MAsk Register
- ST G9,0(G5) Store G9 thru NFND
- LM 0,9,20(13)
- BR 14
-*
-* LO is 'LT'
-* --------------
-LESSTHAN SR G8,G1 SZ - NW
- BC GE,NOSECTLT > = 0
-*
-LOOPLT VLVCU G1
- VLE V0,G2(0) Load VIN
- VLPER V0,V0 Take positive value
- VCEQ GT,F4,V0 When TEST > ABS(VIN)
- VCOVM G9 Count and accumulate 1's bits
- VSTVM G4 Store Vector Mask Register
- LTR G1,G1 Restore proper OC
- BC GT,LOOPLT Go back to LOOP
-*
- ST G9,0(G5) Store G9 thru NFND
- LM G0,G9,20(13)
- BR 14
-*
-NOSECTLT VLVCA 0(G1)
- VLE V0,G2(0) Load VIN
- VLPER V0,V0 Take positive value
- VCEQ GT,F4,V0 When TEST > ABS(VIN)
- VCOVM G9 Count and accumulate 1's bits
- VSTVM G4 Store Vector MAsk Register
- ST G9,0(G5) Store G9 thru NFND
- LM 0,9,20(13)
- BR 14
-*
-*
-DOWNPART LA G7,CGE
- LH G7,0(0,G7)
- CR G6,G7
- BC LT,EQUALITY LO IS 'EQ'
- BC EQ,GREATEQ LO IS 'LE'
-*
-* LO is 'GT'
-* --------------
-GREATHAN SR G8,G1 SZ - NW
- BC GE,NOSECTGT > = 0
-*
-LOOPGT VLVCU G1
- VLE V0,G2(0) Load VIN
- VLPER V0,V0 Take positive value
- VCEQ LT,F4,V0 When TEST < ABS(VIN)
- VCOVM G9 Count and accumulate 1's bits
- VSTVM G4 Store Vector Mask Register
- LTR G1,G1 Restore proper OC
- BC GT,LOOPGT Go back to LOOP
-*
- ST G9,0(G5) Store G9 thru NFND
- LM G0,G9,20(13)
- BR 14
-*
-NOSECTGT VLVCA 0(G1)
- VLE V0,G2(0) Load VIN
- VLPER V0,V0 Take positive value
- VCEQ LT,F4,V0 When TEST < ABS(VIN)
- VCOVM G9 Count and accumulate 1's bits
- VSTVM G4 Store Vector MAsk Register
- ST G9,0(G5) Store G9 thru NFND
- LM 0,9,20(13)
- BR 14
-*
-* LO is 'EQ'
-* --------------
-EQUALITY SR G8,G1 SZ - NW
- BC GE,NOSECTEQ > = 0
-*
-LOOPEQ VLVCU G1
- VLE V0,G2(0) Load VIN
- VLPER V0,V0 Take positive value
- VCEQ EQ,F4,V0 When TEST = ABS(VIN)
- VCOVM G9 Count and accumulate 1's bits
- VSTVM G4 Store Vector Mask Register
- LTR G1,G1 Restore proper OC
- BC GT,LOOPEQ Go back to LOOP
-*
- ST G9,0(G5) Store G9 thru NFND
- LM G0,G9,20(13)
- BR 14
-*
-NOSECTEQ VLVCA 0(G1)
- VLE V0,G2(0) Load VIN
- VLPER V0,V0 Take positive value
- VCEQ EQ,F4,V0 When TEST = ABS(VIN)
- VCOVM G9 Count and accumulate 1's bits
- VSTVM G4 Store Vector MAsk Register
- ST G9,0(G5) Store G9 thru NFND
- LM 0,9,20(13)
- BR 14
-*
-* LO is 'GE'
-* --------------
-GREATEQ SR G8,G1 SZ - NW
- BC GE,NOSECTGE > = 0
-*
-LOOPGE VLVCU G1
- VLE V0,G2(0) Load VIN
- VLPER V0,V0 Take positive value
- VCEQ LE,F4,V0 When TEST <= ABS(VIN)
- VCOVM G9 Count and accumulate 1's bits
- VSTVM G4 Store Vector Mask Register
- LTR G1,G1 Restore proper OC
- BC GT,LOOPGE Go back to LOOP
-*
- ST G9,0(G5) Store G9 thru NFND
- LM G0,G9,20(13)
- BR 14
-*
-NOSECTGE VLVCA 0(G1)
- VLE V0,G2(0) Load VIN
- VLPER V0,V0 Take positive value
- VCEQ LE,F4,V0 When TEST <= ABS(VIN)
- VCOVM G9 Count and accumulate 1's bits
- VSTVM G4 Store Vector MAsk Register
- ST G9,0(G5) Store G9 thru NFND
- LM 0,9,20(13)
- BR 14
-*
-*
-CGE DC XL2'C7C5'
-CENTER DC XL2'CCCC'
-CLT DC XL2'D3E3'
-#include "equats.inc"
- END
-#endif
diff --git a/src/mathlib/bvsl/bvslibm/andb.s b/src/mathlib/bvsl/bvslibm/andb.s
deleted file mode 100644
index 4f71a7b..0000000
--- a/src/mathlib/bvsl/bvslibm/andb.s
+++ /dev/null
@@ -1,40 +0,0 @@
-*
-* $Id: andb.s,v 1.1.1.1 1996/03/21 17:19:58 mclareni Exp $
-*
-* $Log: andb.s,v $
-* Revision 1.1.1.1 1996/03/21 17:19:58 mclareni
-* Bvsl
-*
-*
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB_QMIBMVF))
-*********************************************************************
-* SUBROUTINE ANDB(NW,BINV1,BINV2,BINVOU,NWOUT)
-*
-* PERFORMS AND OF TWO BINARY VECTORS
-* NW1 INPUT VECTOR LENGTH
-*
-*********************************************************************
-ANDB CSECT
-#if defined(CERNLIB_QMIBMXA)
-ANDB AMODE 31
-ANDB RMODE ANY
-#endif
- USING *,15
- STM 1,6,24(13)
-* R2 IN, R3 ISRT, R4 ITEST, R5 INDEX, R6 IFOUND
- LM 1,5,0(1)
-*
- SR 6,6
- L 1,0(0,1)
-LOOP VLVCU 1
- VLVM 2
- VNVM 3
- VCOVM 6
- VSTVM 4
- LTR 1,1
- BC 2,LOOP
- ST 6,0(5)
- LM 1,6,24(13)
- BR 14
- END
-#endif
diff --git a/src/mathlib/bvsl/bvslibm/andntb.s b/src/mathlib/bvsl/bvslibm/andntb.s
deleted file mode 100644
index 7e496fe..0000000
--- a/src/mathlib/bvsl/bvslibm/andntb.s
+++ /dev/null
@@ -1,43 +0,0 @@
-*
-* $Id: andntb.s,v 1.1.1.1 1996/03/21 17:19:59 mclareni Exp $
-*
-* $Log: andntb.s,v $
-* Revision 1.1.1.1 1996/03/21 17:19:59 mclareni
-* Bvsl
-*
-*
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB_QMIBMVF))
-*********************************************************************
-* SUBROUTINE ANDNTB(NW,BINV1,BINV2,BINVOU,NWOUT)
-*
-* PERFORMS NOT AND OF TWO BINARY VECTORS
-* NW1 INPUT VECTOR LENGTH
-* AUTOR: F. ANTONELLI LIBRARY: BVSL
-*
-*********************************************************************
-ANDNTB CSECT
-#if defined(CERNLIB_QMIBMXA)
-ANDNTB AMODE 31
-ANDNTB RMODE ANY
-#endif
- USING *,15
- STM G1,G6,24(13)
-* R2 IN, R3 ISRT, R4 ITEST, R5 INDEX, R6 IFOUND
- LM 1,5,0(1)
-*
- SR 6,6
- L 1,0(0,1)
-LOOP VLVCU 1
- VLVM 3
- VCVM
- VNVM 2
- VCOVM 6
- VSTVM 4
- LTR G1,G1 Restore proper OC
- BC 2,LOOP
- ST 6,0(5)
- LM 1,6,24(13)
- BR 14
-#include "equats.inc"
- END
-#endif
diff --git a/src/mathlib/bvsl/bvslibm/binvec.s b/src/mathlib/bvsl/bvslibm/binvec.s
deleted file mode 100644
index e382534..0000000
--- a/src/mathlib/bvsl/bvslibm/binvec.s
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: binvec.s,v 1.1.1.1 1996/03/21 17:19:58 mclareni Exp $
-*
-* $Log: binvec.s,v $
-* Revision 1.1.1.1 1996/03/21 17:19:58 mclareni
-* Bvsl
-*
-*
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB_QMIBMVF))
-*********************************************************************
-* SUBROUTINE BINVEC(NW,IBIN,IVEC)
-* CONVERSION FROM BINARY TO INDEX VECTOR
-*
-* AUTOR: F. ANTONELLI LIBRARY: BVSL
-*
-*********************************************************************
-BINVEC CSECT
-#if defined(CERNLIB_QMIBMXA)
-BINVEC AMODE 31
-BINVEC RMODE ANY
-#endif
-#include "cachesz.inc"
- USING *,15
- STM 1,6,24(13)
-* R2 IN, R3 ISRT, R4 ITEST, R5 INDEX, R6 IFOUND
- LM 1,3,0(1)
-*
-*IN R1 NW - IN R2 IBIN - IN R3 IVEC
- L 5,0(0,1)
- LA 6,1
-*
- SR 4,4
-LOOP VLBIX 0,4,0(2)
- VAQ 1,6,0
- VST 1,3(0)
- BC 2,LOOP
- LM 1,6,24(13)
- BR 14
-*
- END
-#endif
diff --git a/src/mathlib/bvsl/bvslibm/cachesz.inc b/src/mathlib/bvsl/bvslibm/cachesz.inc
deleted file mode 100644
index aeab643..0000000
--- a/src/mathlib/bvsl/bvslibm/cachesz.inc
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: cachesz.inc,v 1.1.1.1 1996/03/21 17:19:57 mclareni Exp $
-*
-* $Log: cachesz.inc,v $
-* Revision 1.1.1.1 1996/03/21 17:19:57 mclareni
-* Bvsl
-*
-*
-*
-* cachesz.inc
-*
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB_QMIBMVF))
-#if defined(CERNLIB_3090S)||defined(CERNLIB_3090J)
-SZ EQU 256
-#endif
-#endif
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB_QMIBMVF))
-SZ EQU 128
-#endif
diff --git a/src/mathlib/bvsl/bvslibm/cmprsb.s b/src/mathlib/bvsl/bvslibm/cmprsb.s
deleted file mode 100644
index 50c9f26..0000000
--- a/src/mathlib/bvsl/bvslibm/cmprsb.s
+++ /dev/null
@@ -1,79 +0,0 @@
-*
-* $Id: cmprsb.s,v 1.1.1.1 1996/03/21 17:19:57 mclareni Exp $
-*
-* $Log: cmprsb.s,v $
-* Revision 1.1.1.1 1996/03/21 17:19:57 mclareni
-* Bvsl
-*
-*
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB_QMIBMVF))
-*********************************************************************
-* SUBROUTINE CMPRSB (NW,VEC,BIT) *
-* *
-* *
-* Compresses the vector VEC(NW) according to BIT pattern *
-* *
-* Author: M.Roethlisberger/IBM *
-* Date : 18-08-89 *
-* *
-*********************************************************************
-CMPRSB CSECT
-#if defined(CERNLIB_QMIBMXA)
-CMPRSB AMODE 31
-CMPRSB RMODE ANY
-#endif
-#if defined(CERNLIB_3090S)||defined(CERNLIB_3090J)
-SZ EQU 257
-#endif
-#if (!defined(CERNLIB_3090S))&&(!defined(CERNLIB_3090J))
-SZ EQU 129
-#endif
- USING *,15
- STM 1,5,24(13)
-*GET ADDRESS OF PARM LIST
- LM G1,G3,0(G1) GET ADDRESSES
- L G1,0(0,1) GET COUNT
- LR G5,G2
-*
-* TEST ON VECTOR SIZE IF VS LT "SZ" NOSECTIONING
- LA G4,SZ
- SR G4,G1
- BC 2,NOSECT
-*
-*
-* IN R2 R3 ADDRESSES OF VECT AND INDEX
-* ADDRESSES OF SUBSEQUENT INDEX SECTION
-LOOPV VLVCU G1
- VLVM G3
- VLME V2,G2(0)
- VSTKE V2,G5(0)
- LTR G1,G1
- BC 2,LOOPV
-* CONCLUSION VECTOR
-*
- LM 1,5,24(13)
- BR 14
-*
-* NO SECTIONING
-*
-*
-NOSECT VLVCA 0(1)
- VLVM G3
- LR G5,G2
- VLME V2,G2(0)
- VSTKE V2,G5(0)
-* CONCLUSION NO SECTIONING
-*
- LM 1,5,24(13)
- BR 14
-*
-G1 EQU 1
-G2 EQU 2
-G3 EQU 3
-G4 EQU 4
-G5 EQU 5
-V2 EQU 2
-*
-*
- END
-#endif
diff --git a/src/mathlib/bvsl/bvslibm/cntob.s b/src/mathlib/bvsl/bvslibm/cntob.s
deleted file mode 100644
index a9c16ab..0000000
--- a/src/mathlib/bvsl/bvslibm/cntob.s
+++ /dev/null
@@ -1,35 +0,0 @@
-*
-* $Id: cntob.s,v 1.1.1.1 1996/03/21 17:19:58 mclareni Exp $
-*
-* $Log: cntob.s,v $
-* Revision 1.1.1.1 1996/03/21 17:19:58 mclareni
-* Bvsl
-*
-*
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB_QMIBMVF))
-*********************************************************************
-* SUBROUTINE CNTOB(NW,BV,IFOUND)
-*
-*********************************************************************
-CNTOB CSECT
-#if defined(CERNLIB_QMIBMXA)
-CNTOB AMODE 31
-CNTOB RMODE ANY
-#endif
- USING *,15
- STM 1,4,24(13)
-* R2 IN, R3 ISRT, R4 ITEST, R5 INDEX, R6 IFOUND
- LM 1,3,0(1)
-*
- SR 4,4
- L 1,0(0,1)
-LOOP VLVCU 1
- VLVM 2
- VCOVM 4
- LTR 1,1
- BC 2,LOOP
- ST 4,0(3)
- LM 1,4,24(13)
- BR 14
- END
-#endif
diff --git a/src/mathlib/bvsl/bvslibm/cntzb.s b/src/mathlib/bvsl/bvslibm/cntzb.s
deleted file mode 100644
index 45443f5..0000000
--- a/src/mathlib/bvsl/bvslibm/cntzb.s
+++ /dev/null
@@ -1,35 +0,0 @@
-*
-* $Id: cntzb.s,v 1.1.1.1 1996/03/21 17:19:58 mclareni Exp $
-*
-* $Log: cntzb.s,v $
-* Revision 1.1.1.1 1996/03/21 17:19:58 mclareni
-* Bvsl
-*
-*
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB_QMIBMVF))
-*********************************************************************
-* SUBROUTINE CNTZB(NW,BV,IFOUND)
-*
-*********************************************************************
-CNTZB CSECT
-#if defined(CERNLIB_QMIBMXA)
-CNTZB AMODE 31
-CNTZB RMODE ANY
-#endif
- USING *,15
- STM 1,4,24(13)
-* R2 IN, R3 ISRT, R4 ITEST, R5 INDEX, R6 IFOUND
- LM 1,3,0(1)
-*
- SR 4,4
- L 1,0(0,1)
-LOOP VLVCU 1
- VLVM 2
- VCZVM 4
- LTR 1,1
- BC 2,LOOP
- ST 4,0(3)
- LM 1,4,24(13)
- BR 14
- END
-#endif
diff --git a/src/mathlib/bvsl/bvslibm/copyb.s b/src/mathlib/bvsl/bvslibm/copyb.s
deleted file mode 100644
index 0967733..0000000
--- a/src/mathlib/bvsl/bvslibm/copyb.s
+++ /dev/null
@@ -1,38 +0,0 @@
-*
-* $Id: copyb.s,v 1.1.1.1 1996/03/21 17:19:59 mclareni Exp $
-*
-* $Log: copyb.s,v $
-* Revision 1.1.1.1 1996/03/21 17:19:59 mclareni
-* Bvsl
-*
-*
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB_QMIBMVF))
-*********************************************************************
-* SUBROUTINE COPYB(NW,BINV,Y,X)
-*
-* Y(BV) = X(BV)
-*
-*********************************************************************
-COPYB CSECT
-#if defined(CERNLIB_QMIBMXA)
-COPYB AMODE 31
-COPYB RMODE ANY
-#endif
- USING *,15
- STM 0,4,20(13)
-* R1 NW, R2 BINV, R3 Y, R4 X
- LM 1,4,0(1)
-*
-*IN R1 NW
- L 1,0(0,1)
-*
-LOOP VLVCU 1
- VLVM 2
- VLME 4,4
- VSTME 4,3
- BC 2,LOOP
- LM 0,4,20(13)
- BR 14
-*
- END
-#endif
diff --git a/src/mathlib/bvsl/bvslibm/cprsb.s b/src/mathlib/bvsl/bvslibm/cprsb.s
deleted file mode 100644
index 4b28b56..0000000
--- a/src/mathlib/bvsl/bvslibm/cprsb.s
+++ /dev/null
@@ -1,58 +0,0 @@
-*
-* $Id: cprsb.s,v 1.1.1.1 1996/03/21 17:19:59 mclareni Exp $
-*
-* $Log: cprsb.s,v $
-* Revision 1.1.1.1 1996/03/21 17:19:59 mclareni
-* Bvsl
-*
-*
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB_QMIBMVF))
-*********************************************************************
-* SUBROUTINE CPRSB (NW,VEC,BIT) *
-* *
-* *
-* Compresses the vector VEC(NW) according to BIT pattern *
-* *
-* Author: M.Roethlisberger/IBM *
-* Date : 01-11-89, Vers 1.01 *
-* *
-*********************************************************************
-CPRSB CSECT
-#if defined(CERNLIB_QMIBMXA)
-CPRSB AMODE 31
-CPRSB RMODE ANY
-#endif
-#include "cachesz.inc"
-*PRSB START 0
- USING *,15
- STM G1,G5,24(13)
- LM G1,G3,0(G1) Get addresses of parameter list
- L G1,0(0,G1) NW in G1
- LR G5,G2 Save address of VEC for writing
-*
- LA G4,SZ
- SR G4,G1 SZ - NW
- BC GE,NOSECT When G4.ge.G1
-*
-LOOPV VLVCU G1 Set vector loop
- VLVM G3 Load vector mask register
- VLME V2,G2(0) Load matched of VEC
- VSTKE V2,G5(0) Store compressed on VEC
- BC GT,LOOPV go back to loopv
-*
- LM 1,5,24(13)
- BR 14
-*
-* No Sectioning
-* -------------
-NOSECT VLVCA 0(1)
- VLVM G3 Load Vector Mask Register
- VLME V2,G2(0) Load matched of VEC
- VSTKE V2,G5(0) Store compressed on VEC
- LM 1,5,24(13)
- BR 14
-*
-#include "equats.inc"
-*
- END
-#endif
diff --git a/src/mathlib/bvsl/bvslibm/dalosb.s b/src/mathlib/bvsl/bvslibm/dalosb.s
deleted file mode 100644
index a1d7a89..0000000
--- a/src/mathlib/bvsl/bvslibm/dalosb.s
+++ /dev/null
@@ -1,245 +0,0 @@
-*
-* $Id: dalosb.s,v 1.1.1.1 1996/03/21 17:19:57 mclareni Exp $
-*
-* $Log: dalosb.s,v $
-* Revision 1.1.1.1 1996/03/21 17:19:57 mclareni
-* Bvsl
-*
-*
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB_QMIBMVF))
-*********************************************************************
-* SUBROUTINE DALOSB (NW,VIN,TEST,BIT,NFND,'LO') *
-* -------------------------------------------- *
-* *
-* Library: BVSL *
-* *
-* *
-* Selects i's for which |VIN(i)| 'lo' TEST *
-* 'lo' being one of the logical operator =, <, <=, >, >=, ^= *
-* *
-* Result via Bit-vector form *
-* *
-* Input *
-* NW : Number of elements to be processed *
-* VIN : REAL*8 Input Vector *
-* TEST : REAL*8 Test Value *
-* LO : Character*2 Logical Operator *
-* ('EQ','LT','LE','GE','GT' OR 'NE') *
-* *
-* Output *
-* BIT : Bit-Vector *
-* NFND : Number of test passed (ones in BIT) *
-* *
-* *
-* Author: F.Antonelli/IBM, M.Roethlisberger/IBM *
-* Date : 24-04-90 , Vers 1.02 *
-* *
-*********************************************************************
-DALOSB CSECT
-#if defined(CERNLIB_QMIBMXA)
-DALOSB AMODE 31
-DALOSB RMODE ANY
-#endif
-#include "cachesz.inc"
- USING *,15
- STM G0,G9,20(13)
- LM G1,G6,0(1) Get addresses of parameter list
- L G1,0(0,G1) NW in G1
- LD F4,0(0,G3) TEST IN F4
- SR G9,G9 Reset Register
- LA G8,SZ Load Section size
-*
- LH G6,0(0,G6)
- LA G7,CENTER
- LH G7,0(0,G7)
- CR G6,G7
- BC LT,DOWNPART LO is 'QE' or 'GE' or 'GT'
-*
- LA G7,CLT
- LH G7,0(0,G7)
- CR G6,G7
- BC LT,LESSEQUA LO IS 'LE'
- BC EQ,LESSTHAN LO IS 'LT'
-*
-* LO is 'NE'
-* --------------
-NOTEQUAL SR G8,G1 SZ - NW
- BC GE,NOSECTNE > = 0
-*
-LOOPNE VLVCU G1
- VLD V0,G2(0) Load VIN
- VLPDR V0,V0 Take positive value
- VCDQ NE,F4,V0 When TEST ^= ABS(VIN)
- VCOVM G9 Count and accumulate 1's bits
- VSTVM G4 Store Vector Mask Register
- LTR G1,G1 Restore proper OC
- BC GT,LOOPNE Go back to LOOP
-*
- ST G9,0(G5) Store G9 thru NFND
- LM G0,G9,20(13)
- BR 14
-*
-NOSECTNE VLVCA 0(G1)
- VLD V0,G2(0) Load VIN
- VLPDR V0,V0 Take positive value
- VCDQ NE,F4,V0 When TEST ^= ABS(VIN)
- VCOVM G9 Count and accumulate 1's bits
- VSTVM G4 Store Vector MAsk Register
- ST G9,0(G5) Store G9 thru NFND
- LM 0,9,20(13)
- BR 14
-*
-* LO is 'LE'
-* --------------
-LESSEQUA SR G8,G1 SZ - NW
- BC GE,NOSECTLE > = 0
-*
-LOOPLE VLVCU G1
- VLD V0,G2(0) Load VIN
- VLPDR V0,V0 Take positive value
- VCDQ GE,F4,V0 When TEST >= ABS(VIN)
- VCOVM G9 Count and accumulate 1's bits
- VSTVM G4 Store Vector Mask Register
- LTR G1,G1 Restore proper OC
- BC GT,LOOPLE Go back to LOOP
-*
- ST G9,0(G5) Store G9 thru NFND
- LM G0,G9,20(13)
- BR 14
-*
-NOSECTLE VLVCA 0(G1)
- VLD V0,G2(0) Load VIN
- VLPDR V0,V0 Take positive value
- VCDQ GE,F4,V0 When TEST >= ABS(VIN)
- VCOVM G9 Count and accumulate 1's bits
- VSTVM G4 Store Vector MAsk Register
- ST G9,0(G5) Store G9 thru NFND
- LM 0,9,20(13)
- BR 14
-*
-* LO is 'LT'
-* --------------
-LESSTHAN SR G8,G1 SZ - NW
- BC GE,NOSECTLT > = 0
-*
-LOOPLT VLVCU G1
- VLD V0,G2(0) Load VIN
- VLPDR V0,V0 Take positive value
- VCDQ GT,F4,V0 When TEST > ABS(VIN)
- VCOVM G9 Count and accumulate 1's bits
- VSTVM G4 Store Vector Mask Register
- LTR G1,G1 Restore proper OC
- BC GT,LOOPLT Go back to LOOP
-*
- ST G9,0(G5) Store G9 thru NFND
- LM G0,G9,20(13)
- BR 14
-*
-NOSECTLT VLVCA 0(G1)
- VLD V0,G2(0) Load VIN
- VLPDR V0,V0 Take positive value
- VCDQ GT,F4,V0 When TEST > ABS(VIN)
- VCOVM G9 Count and accumulate 1's bits
- VSTVM G4 Store Vector MAsk Register
- ST G9,0(G5) Store G9 thru NFND
- LM 0,9,20(13)
- BR 14
-*
-*
-DOWNPART LA G7,CGE
- LH G7,0(0,G7)
- CR G6,G7
- BC LT,EQUALITY LO IS 'EQ'
- BC EQ,GREATEQ LO IS 'LE'
-*
-* LO is 'GT'
-* --------------
-GREATHAN SR G8,G1 SZ - NW
- BC GE,NOSECTGT > = 0
-*
-LOOPGT VLVCU G1
- VLD V0,G2(0) Load VIN
- VLPDR V0,V0 Take positive value
- VCDQ LT,F4,V0 When TEST < ABS(VIN)
- VCOVM G9 Count and accumulate 1's bits
- VSTVM G4 Store Vector Mask Register
- LTR G1,G1 Restore proper OC
- BC GT,LOOPGT Go back to LOOP
-*
- ST G9,0(G5) Store G9 thru NFND
- LM G0,G9,20(13)
- BR 14
-*
-NOSECTGT VLVCA 0(G1)
- VLD V0,G2(0) Load VIN
- VLPDR V0,V0 Take positive value
- VCDQ LT,F4,V0 When TEST < ABS(VIN)
- VCOVM G9 Count and accumulate 1's bits
- VSTVM G4 Store Vector MAsk Register
- ST G9,0(G5) Store G9 thru NFND
- LM 0,9,20(13)
- BR 14
-*
-* LO is 'EQ'
-* --------------
-EQUALITY SR G8,G1 SZ - NW
- BC GE,NOSECTEQ > = 0
-*
-LOOPEQ VLVCU G1
- VLD V0,G2(0) Load VIN
- VLPDR V0,V0 Take positive value
- VCDQ EQ,F4,V0 When TEST = ABS(VIN)
- VCOVM G9 Count and accumulate 1's bits
- VSTVM G4 Store Vector Mask Register
- LTR G1,G1 Restore proper OC
- BC GT,LOOPEQ Go back to LOOP
-*
- ST G9,0(G5) Store G9 thru NFND
- LM G0,G9,20(13)
- BR 14
-*
-NOSECTEQ VLVCA 0(G1)
- VLD V0,G2(0) Load VIN
- VLPDR V0,V0 Take positive value
- VCDQ EQ,F4,V0 When TEST = ABS(VIN)
- VCOVM G9 Count and accumulate 1's bits
- VSTVM G4 Store Vector MAsk Register
- ST G9,0(G5) Store G9 thru NFND
- LM 0,9,20(13)
- BR 14
-*
-* LO is 'GE'
-* --------------
-GREATEQ SR G8,G1 SZ - NW
- BC GE,NOSECTGE > = 0
-*
-LOOPGE VLVCU G1
- VLD V0,G2(0) Load VIN
- VLPDR V0,V0 Take positive value
- VCDQ LE,F4,V0 When TEST <= ABS(VIN)
- VCOVM G9 Count and accumulate 1's bits
- VSTVM G4 Store Vector Mask Register
- LTR G1,G1 Restore proper OC
- BC GT,LOOPGE Go back to LOOP
-*
- ST G9,0(G5) Store G9 thru NFND
- LM G0,G9,20(13)
- BR 14
-*
-NOSECTGE VLVCA 0(G1)
- VLD V0,G2(0) Load VIN
- VLPDR V0,V0 Take positive value
- VCDQ LE,F4,V0 When TEST <= ABS(VIN)
- VCOVM G9 Count and accumulate 1's bits
- VSTVM G4 Store Vector MAsk Register
- ST G9,0(G5) Store G9 thru NFND
- LM 0,9,20(13)
- BR 14
-*
-*
-CGE DC XL2'C7C5'
-CENTER DC XL2'CCCC'
-CLT DC XL2'D3E3'
-#include "equats.inc"
- END
-#endif
diff --git a/src/mathlib/bvsl/bvslibm/dcopyb.s b/src/mathlib/bvsl/bvslibm/dcopyb.s
deleted file mode 100644
index 5764106..0000000
--- a/src/mathlib/bvsl/bvslibm/dcopyb.s
+++ /dev/null
@@ -1,40 +0,0 @@
-*
-* $Id: dcopyb.s,v 1.1.1.1 1996/03/21 17:19:58 mclareni Exp $
-*
-* $Log: dcopyb.s,v $
-* Revision 1.1.1.1 1996/03/21 17:19:58 mclareni
-* Bvsl
-*
-*
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB_QMIBMVF))
-*********************************************************************
-* SUBROUTINE DCOPYB(NW,BINV,Y,X)
-*
-* Y(BV) = X(BV)
-* AUTOR: F. ANTONELLI LIBRARY: BVSL
-*
-*********************************************************************
-DCOPYB CSECT
-#if defined(CERNLIB_QMIBMXA)
-DCOPYB AMODE 31
-DCOPYB RMODE ANY
-#endif
-#include "cachesz.inc"
- USING *,15
- STM 0,4,20(13)
-* R1 NW, R2 BINV, R3 Y, R4 X
- LM 1,4,0(1)
-*
-*IN R1 NW
- L 1,0(0,1)
-*
-LOOP VLVCU 1
- VLVM 2
- VLMD 4,4
- VSTMD 4,3
- BC 2,LOOP
- LM 0,4,20(13)
- BR 14
-*
- END
-#endif
diff --git a/src/mathlib/bvsl/bvslibm/ddotb.s b/src/mathlib/bvsl/bvslibm/ddotb.s
deleted file mode 100644
index 28d0fef..0000000
--- a/src/mathlib/bvsl/bvslibm/ddotb.s
+++ /dev/null
@@ -1,46 +0,0 @@
-*
-* $Id: ddotb.s,v 1.1.1.1 1996/03/21 17:19:58 mclareni Exp $
-*
-* $Log: ddotb.s,v $
-* Revision 1.1.1.1 1996/03/21 17:19:58 mclareni
-* Bvsl
-*
-*
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB_QMIBMVF))
-*********************************************************************
-* FUNCTION DDOTB(NW,BINV,Y,X,V)
-*
-* DDOTB = SUM( V(BV)*X(BV) )
-* AUTOR: F. ANTONELLI LIBRARY: BVSL
-*
-*********************************************************************
-DDOTB CSECT
-#if defined(CERNLIB_QMIBMXA)
-DDOTB AMODE 31
-DDOTB RMODE ANY
-#endif
-#include "cachesz.inc"
- USING *,15
- STM 0,4,20(13)
-* R1 NW, R2 BINV, R3 Y, R4 X
- LM 1,4,0(1)
-*
-*IN R1 NW
- L 1,0(0,1)
- SDR 0,0
-*
- VZPSD 0
- VSVMM 1
-LOOP VLVCU 1
- VLVM 2
- VLMD 2,3
- VLMD 4,4
- VMCDR 0,2,4
- BC 2,LOOP
- VSVMM 0
- VSPSD 0,0
- LM 0,4,20(13)
- BR 14
-*
- END
-#endif
diff --git a/src/mathlib/bvsl/bvslibm/dgthrb.s b/src/mathlib/bvsl/bvslibm/dgthrb.s
deleted file mode 100644
index f37ca9b..0000000
--- a/src/mathlib/bvsl/bvslibm/dgthrb.s
+++ /dev/null
@@ -1,61 +0,0 @@
-*
-* $Id: dgthrb.s,v 1.1.1.1 1996/03/21 17:19:57 mclareni Exp $
-*
-* $Log: dgthrb.s,v $
-* Revision 1.1.1.1 1996/03/21 17:19:57 mclareni
-* Bvsl
-*
-*
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB_QMIBMVF))
-*********************************************************************
-* SUBROUTINE DGTHRB(NW,DIN,BV,DOUT)
-*
-* AUTOR: F. ANTONELLI LIBRARY: BVSL
-*
-*********************************************************************
-DGTHRB CSECT
-#if defined(CERNLIB_QMIBMXA)
-DGTHRB AMODE 31
-DGTHRB RMODE ANY
-#endif
-#include "cachesz.inc"
- USING *,15
- STM 1,5,24(13)
-*GET ADDRESS OF PARM LIST
- LM 1,4,0(1)
-*
-*IN R1 NW
- L 1,0(0,1)
-* TEST ON VECTOR SIZE IF VS LT 'SZ' NOSECTIONING
- LA 5,SZ
- SR 5,1
- BC 2,NOSECT
-*
-*
-*IN R2 R3 R4 ADDRESSES OF IN BV OUT
-* ADDRESSES OF SUBSEQUENT INDEX SECTION
-LOOPV VLVCU 1
- VLVM 3
- VLMD 2,2(0)
- VSTKD 2,4(0)
- BC 2,LOOPV
-* CONCLUSION VECTOR
-*
- LM 1,5,24(13)
- BR 14
-*
-* NO SECTIONING
-*
-*
-NOSECT VLVCA 0(1)
- VLVM 3
- VLMD 2,2(0)
- VSTKD 2,4(0)
-* CONCLUSION NO SECTIONING
-*
- LM 1,5,24(13)
- BR 14
-*
-*
- END
-#endif
diff --git a/src/mathlib/bvsl/bvslibm/dotb.s b/src/mathlib/bvsl/bvslibm/dotb.s
deleted file mode 100644
index 599603e..0000000
--- a/src/mathlib/bvsl/bvslibm/dotb.s
+++ /dev/null
@@ -1,45 +0,0 @@
-*
-* $Id: dotb.s,v 1.1.1.1 1996/03/21 17:19:59 mclareni Exp $
-*
-* $Log: dotb.s,v $
-* Revision 1.1.1.1 1996/03/21 17:19:59 mclareni
-* Bvsl
-*
-*
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB_QMIBMVF))
-*********************************************************************
-* FUNCTION DOTB(NW,BINV,Y,X,V)
-*
-* DOTB = SUM( V(BV)*X(BV) )
-* AUTOR: F. ANTONELLI LIBRARY: BVSL
-*
-*********************************************************************
-DOTB CSECT
-#if defined(CERNLIB_QMIBMXA)
-DOTB AMODE 31
-DOTB RMODE ANY
-#endif
- USING *,15
- STM 0,4,20(13)
-* R1 NW, R2 BINV, R3 Y, R4 X
- LM 1,4,0(1)
-*
-*IN R1 NW
- L 1,0(0,1)
- SDR 0,0
-*
- VZPSD 0
- VSVMM 1
-LOOP VLVCU 1
- VLVM 2
- VLME 2,3
- VLME 4,4
- VMCER 0,2,4
- BC 2,LOOP
- VSVMM 0
- VSPSD 0,0
- LM 0,4,20(13)
- BR 14
-*
- END
-#endif
diff --git a/src/mathlib/bvsl/bvslibm/drangb.s b/src/mathlib/bvsl/bvslibm/drangb.s
deleted file mode 100644
index 1c0caef..0000000
--- a/src/mathlib/bvsl/bvslibm/drangb.s
+++ /dev/null
@@ -1,51 +0,0 @@
-*
-* $Id: drangb.s,v 1.1.1.1 1996/03/21 17:19:58 mclareni Exp $
-*
-* $Log: drangb.s,v $
-* Revision 1.1.1.1 1996/03/21 17:19:58 mclareni
-* Bvsl
-*
-*
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB_QMIBMVF))
-*********************************************************************
-* SUBROUTINE DRANGB(NW,AIN,UBOUND,ALBOUND,INDEX,IFOUND)
-*
-*
-* AUTOR: F. ANTONELLI LIBRARY: BVSL
-*
-*********************************************************************
-DRANGB CSECT
-#if defined(CERNLIB_QMIBMXA)
-DRANGB AMODE 31
-DRANGB RMODE ANY
-#endif
-#include "cachesz.inc"
- USING *,15
- STM 1,9,24(13)
-*
- LM 1,6,0(1)
-*
- L 1,0(0,1)
- LD 0,0(0,3)
- LD 2,0(0,4)
-*
- SR 8,8
-LOOP VLVCU 1
- LA 7,VMASK
- LR 9,7
- VLD 2,2(0)
- VCDQ 12,2,2
- VSTVM 7
- VCDQ 10,0,2
- VNVM 9
- VCOVM 8
- VSTVM 5
- LTR 1,1
- BC 2,LOOP
- ST 8,0(6)
- LM 1,9,24(13)
- BR 14
-VMASK DS 4F
-*
- END
-#endif
diff --git a/src/mathlib/bvsl/bvslibm/dscalb.s b/src/mathlib/bvsl/bvslibm/dscalb.s
deleted file mode 100644
index b9a1aa9..0000000
--- a/src/mathlib/bvsl/bvslibm/dscalb.s
+++ /dev/null
@@ -1,45 +0,0 @@
-*
-* $Id: dscalb.s,v 1.1.1.1 1996/03/21 17:19:58 mclareni Exp $
-*
-* $Log: dscalb.s,v $
-* Revision 1.1.1.1 1996/03/21 17:19:58 mclareni
-* Bvsl
-*
-*
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB_QMIBMVF))
-* SUBROUTINE DSCALB(NW,BINV,Y,ALPHA)
-*
-* Y = ALPHA*X
-* AUTOR: F. ANTONELLI LIBRARY: BVSL
-*
-*********************************************************************
-DSCALB CSECT
-#if defined(CERNLIB_QMIBMXA)
-DSCALB AMODE 31
-DSCALB RMODE ANY
-#endif
-#include "cachesz.inc"
- USING *,15
- STM 0,7,20(13)
-* R1 NW, R2 BINV, R3 Y, R4 ALPHA
- LM 1,4,0(1)
-*
-*IN R1 NW
- L 1,0(0,1)
-*IN F6 ALPHA
- LD 2,0(0,4)
- LR 7,3
-*
- VSVMM 1
-LOOP VLVCU 1
- VLVM 2
- VLMD 0,3
- VMDQ 2,2,0
- VSTMD 2,7
- BC 2,LOOP
- VSVMM 0
- LM 0,7,20(13)
- BR 14
-*
- END
-#endif
diff --git a/src/mathlib/bvsl/bvslibm/dscttb.s b/src/mathlib/bvsl/bvslibm/dscttb.s
deleted file mode 100644
index af2067d..0000000
--- a/src/mathlib/bvsl/bvslibm/dscttb.s
+++ /dev/null
@@ -1,60 +0,0 @@
-*
-* $Id: dscttb.s,v 1.1.1.1 1996/03/21 17:19:57 mclareni Exp $
-*
-* $Log: dscttb.s,v $
-* Revision 1.1.1.1 1996/03/21 17:19:57 mclareni
-* Bvsl
-*
-*
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB_QMIBMVF))
-*********************************************************************
-* SUBROUTINE DSCTTB(NW,OUT,INDEX,HIN)
-*
-*
-*********************************************************************
-DSCTTB CSECT
-#if defined(CERNLIB_QMIBMXA)
-DSCTTB AMODE 31
-DSCTTB RMODE ANY
-#endif
-#include "cachesz.inc"
- USING *,15
- STM 1,5,24(13)
-*GET ADDRESS OF PARM LIST
- LM 1,4,0(1)
-*
-*IN R1 NW
- L 1,0(0,1)
-* TEST ON VECTOR SIZE IF VS LT 'SZ' NOSECTIONING
- LA 5,SZ
- SR 5,1
- BC 2,NOSECT
-*
-*
-*IN R2 R3 R4 ADDRESSES OF OUT HIN INDEX
-* ADDRESSES OF SUBSEQUENT INDEX SECTION
-LOOPV VLVCU 1
- VLVM 3
- VLYD 2,2(0)
- VSTMD 2,4(0)
- BC 2,LOOPV
-* CONCLUSION VECTOR
-*
- LM 1,5,24(13)
- BR 14
-*
-* NO SECTIONING
-*
-*
-NOSECT VLVCA 0(1)
- VLVM 3
- VLYD 2,2(0)
- VSTMD 2,4(0)
-* CONCLUSION NO SECTIONING
-*
- LM 1,5,24(13)
- BR 14
-*
-*
- END
-#endif
diff --git a/src/mathlib/bvsl/bvslibm/dsxpyb.s b/src/mathlib/bvsl/bvslibm/dsxpyb.s
deleted file mode 100644
index f4d57c7..0000000
--- a/src/mathlib/bvsl/bvslibm/dsxpyb.s
+++ /dev/null
@@ -1,46 +0,0 @@
-*
-* $Id: dsxpyb.s,v 1.1.1.1 1996/03/21 17:19:58 mclareni Exp $
-*
-* $Log: dsxpyb.s,v $
-* Revision 1.1.1.1 1996/03/21 17:19:58 mclareni
-* Bvsl
-*
-*
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB_QMIBMVF))
-*********************************************************************
-* SUBROUTINE DSXPYB(NW,BINV,Y,X,ALPHA)
-*
-* Y = Y + ALPHA*X
-* AUTOR: F. ANTONELLI LIBRARY: BVSL
-*
-*********************************************************************
-DSXPYB CSECT
-#if defined(CERNLIB_QMIBMXA)
-DSXPYB AMODE 31
-DSXPYB RMODE ANY
-#endif
-#include "cachesz.inc"
- USING *,15
- STM 0,7,20(13)
-* R1 NW, R2 BINV, R3 Y, R4 X, R5 ALPHA
- LM 1,5,0(1)
-*
-*IN R1 NW
- L 1,0(0,1)
-*IN F6 ALPHA
- LD 2,0(0,5)
- LR 7,3
-*
- VSVMM 1
-LOOP VLVCU 1
- VLVM 2
- VLMD 0,3
- VMADS 0,2,4
- VSTMD 0,7
- BC 2,LOOP
- VSVMM 0
- LM 0,7,20(13)
- BR 14
-*
- END
-#endif
diff --git a/src/mathlib/bvsl/bvslibm/dsxyb.s b/src/mathlib/bvsl/bvslibm/dsxyb.s
deleted file mode 100644
index b176f7a..0000000
--- a/src/mathlib/bvsl/bvslibm/dsxyb.s
+++ /dev/null
@@ -1,45 +0,0 @@
-*
-* $Id: dsxyb.s,v 1.1.1.1 1996/03/21 17:19:58 mclareni Exp $
-*
-* $Log: dsxyb.s,v $
-* Revision 1.1.1.1 1996/03/21 17:19:58 mclareni
-* Bvsl
-*
-*
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB_QMIBMVF))
-*********************************************************************
-* SUBROUTINE DSXYB(NW,BINV,SCAL,Y,X)
-*
-* Y = SCAL*X*Y
-*
-*********************************************************************
-DSXYB CSECT
-#if defined(CERNLIB_QMIBMXA)
-DSXYB AMODE 31
-DSXYB RMODE ANY
-#endif
-#include "cachesz.inc"
- USING *,15
- STM 0,9,20(13)
-* R1 NW, R2 BINV, R3 SCAL , R4 Y , R 2
- LM 1,5,0(1)
-*
-*IN R1 NW
- L 1,0(0,1)
- LD 0,0(0,5)
- LR 7,3
-*
- VSVMM 1
-LOOP VLVCU 1
- VLVM 2
- VLMD 0,4
- VMD 2,0,3
- VMDQ 4,0,2
- VSTMD 4,7
- BC 2,LOOP
- VSVMM 0
- LM 0,9,20(13)
- BR 14
-*
- END
-#endif
diff --git a/src/mathlib/bvsl/bvslibm/dvsetb.s b/src/mathlib/bvsl/bvslibm/dvsetb.s
deleted file mode 100644
index 01cf763..0000000
--- a/src/mathlib/bvsl/bvslibm/dvsetb.s
+++ /dev/null
@@ -1,43 +0,0 @@
-*
-* $Id: dvsetb.s,v 1.1.1.1 1996/03/21 17:19:58 mclareni Exp $
-*
-* $Log: dvsetb.s,v $
-* Revision 1.1.1.1 1996/03/21 17:19:58 mclareni
-* Bvsl
-*
-*
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB_QMIBMVF))
-*********************************************************************
-* SUBROUTINE DVSETB(NW,BINV,Y,CONST)
-*
-* SET Y TO CONST FOR GIVEN INDEX
-* AUTOR: F. ANTONELLI LIBRARY: BVSL
-*
-*********************************************************************
-DVSETB CSECT
-#if defined(CERNLIB_QMIBMXA)
-DVSETB AMODE 31
-DVSETB RMODE ANY
-#endif
-#include "cachesz.inc"
- USING *,15
- STM 0,4,20(13)
-* R1 NW, R2 BINV, R3 Y, R4 ALPHA
- LM 1,4,0(1)
-*
-*IN R1 NW
- L 1,0(0,1)
-*IN F4 CONST
- LD 2,0(0,4)
-*
-LOOP VLVCU 1
- VLVM 2
- VLMDQ 0,2
- VSTMD 0,3
- BC 2,LOOP
- VSVMM 0
- LM 0,4,20(13)
- BR 14
-*
- END
-#endif
diff --git a/src/mathlib/bvsl/bvslibm/dxypwzb.s b/src/mathlib/bvsl/bvslibm/dxypwzb.s
deleted file mode 100644
index 3b5f4dd..0000000
--- a/src/mathlib/bvsl/bvslibm/dxypwzb.s
+++ /dev/null
@@ -1,52 +0,0 @@
-*
-* $Id: dxypwzb.s,v 1.1.1.1 1996/03/21 17:19:58 mclareni Exp $
-*
-* $Log: dxypwzb.s,v $
-* Revision 1.1.1.1 1996/03/21 17:19:58 mclareni
-* Bvsl
-*
-*
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB_QMIBMVF))
-*********************************************************************
-* SUBROUTINE DXYPWZB(NW,BV,S,X,Y,T,V,W)
-*
-* Y = S*X(BV)*Y(BV)+T*V(BV)*W(BV)
-* AUTOR: F. ANTONELLI LIBRARY: BVSL
-*
-*********************************************************************
-DXYPWZB CSECT
-#if defined(CERNLIB_QMIBMXA)
-DXYPWZB AMODE 31
-DXYPWZB RMODE ANY
-#endif
-#include "cachesz.inc"
- USING *,15
- STM 0,9,20(13)
-* R1 NW, R2 BV, R3 S , R4 Y , R5 X , R6 T , R7 V , R8 W
- LM 1,8,0(1)
-*
-*IN R1 NW
- L 1,0(0,1)
- LD 0,0(0,3)
- LD 2,0(0,6)
- LR 9,4
-*
- VSVMM 1
-LOOP VLVCU 1
- VLVM 2
- VLMD 0,4
- VMD 2,0,5
- VMDQ 4,0,2
-* FIRST PART
- VLMD 6,7
- VMD 8,6,8
- VMDQ 10,2,8
- VADR 12,10,4
- VSTMD 12,9
- BC 2,LOOP
- VSVMM 0
- LM 0,9,20(13)
- BR 14
-*
- END
-#endif
diff --git a/src/mathlib/bvsl/bvslibm/dylosb.s b/src/mathlib/bvsl/bvslibm/dylosb.s
deleted file mode 100644
index f41e781..0000000
--- a/src/mathlib/bvsl/bvslibm/dylosb.s
+++ /dev/null
@@ -1,261 +0,0 @@
-*
-* $Id: dylosb.s,v 1.1.1.1 1996/03/21 17:19:58 mclareni Exp $
-*
-* $Log: dylosb.s,v $
-* Revision 1.1.1.1 1996/03/21 17:19:58 mclareni
-* Bvsl
-*
-*
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB_QMIBMVF))
-* SUBROUTINE DYLOSB(NW,Y,S,BV,IFOUND,'LO')
-*
-*
-*
-*********************************************************************
-DYLOSB CSECT
-#if defined(CERNLIB_QMIBMXA)
-DYLOSB AMODE 31
-DYLOSB RMODE ANY
-#endif
-#include "cachesz.inc"
- USING *,15
- STM 1,8,24(13)
-* R1 NW
- LM 1,6,0(1)
- L 1,0(0,1)
-*
- LH 6,0(0,6)
- LA 7,CENTRO
- LH 7,0(0,7)
- CR 6,7
- BC 4,MIN0
-*
-* RESULT 1 > CENTRO
-*
- LA 7,LT
- LH 7,0(0,7)
- CR 6,7
- BC 4,MAX1
-* RESULT 1 > = LT
- BC 8,MAX2
-* RESULT 1 NE LT END WITH NE
-*********************************************************************
-* SUBROUTINE YNESB(NW,IN,ITEST,INDEX,IFOUND)
-*
-*
-*********************************************************************
-*
-*IN R1 NW - IN R3 ISTR - IN R4 ITEST
- LD 4,0(0,3)
-* TEST ON VECTOR SIZE IF VS LE 'SZ' NO SECTIONING
- LA 7,SZ
- SR 7,1
- BC 2,NOSNE
-*
- SR 8,8
-LOONE VLVCU 1
- VCDS 6,4,2(0)
- VCOVM 8
- VSTVM 4
- LTR 1,1
- BC 2,LOONE
- ST 8,0(5)
- LM 1,8,24(13)
- BR 14
-*
-NOSNE VLVCA 0(1)
- SR 8,8
-*
- VCDS 6,4,2(0)
- VCOVM 8
- VSTVM 4
- ST 8,0(5)
- LM 1,8,24(13)
- BR 14
-*********************************************************************
-* RESULT 1 = LT END WITH LT
-*********************************************************************
-* SUBROUTINE YLTSB(NW,Y,S,INDB,IFOUND)
-*
-*********************************************************************
-*
-MAX2 LD 4,0(0,3)
-* TEST ON VECTOR SIZE IF VS LE 'SZ' NO SECTIONING
- LA 7,SZ
- SR 7,1
- BC 2,NOSLT
-*
- SR 8,8
-LOOLT VLVCU 1
- VCDS 2,4,2(0)
- VCOVM 8
- VSTVM 4
- LTR 1,1
- BC 2,LOOLT
- ST 8,0(5)
- LM 1,8,24(13)
- BR 14
-*
-NOSLT VLVCA 0(1)
- SR 8,8
-*
- VCDS 2,4,2(0)
- VCOVM 8
- VSTVM 4
- ST 8,0(5)
- LM 1,8,24(13)
- BR 14
-*********************************************************************
-* RESULT 1 > LT END WITH LE
-*********************************************************************
-* SUBROUTINE YLESB(NW,AIN,ISTR,ATEST,INDEX,IFOUND)
-*
-*
-*********************************************************************
-MAX1 LD 4,0(0,3)
-* TEST ON VECTOR SIZE IF VS LE 'SZ' NO SECTIONING
- LA 7,SZ
- SR 7,1
- BC 2,NOSLE
-*
- SR 8,8
-LOOLE VLVCU 1
- VCDS 10,4,2(0)
- VCOVM 8
- VSTVM 4
- LTR 1,1
- BC 2,LOOLE
- ST 8,0(5)
- LM 1,8,24(13)
- BR 14
-*
-NOSLE VLVCA 0(1)
- SR 8,8
-*
- VCDS 10,4,2(0)
- VCOVM 8
- VSTVM 4
- ST 8,0(5)
- LM 1,8,24(13)
- BR 14
-*********************************************************************
-* RESULT 1 < CENTRO
-MIN0 LA 7,GE
- LH 7,0(0,7)
- CR 6,7
- BC 4,MIN1
-* RESULT 1 > = GE
- BC 8,MIN2
-* RESULT 1 NE GE END WITH GT
-*********************************************************************
-* SUBROUTINE YGTSB(NW,AIN,ATEST,INDEX,IFOUND)
-*
-*
-*
-*********************************************************************
- LD 4,0(0,3)
-* TEST ON VECTOR SIZE IF VS LE 'SZ' NO SECTIONING
- LA 7,SZ
- SR 7,1
- BC 2,NOSGT
-*
- SR 8,8
-LOOGT VLVCU 1
- VCDS 4,4,2(0)
- VCOVM 8
- VSTVM 4
- LTR 1,1
- BC 2,LOOGT
- ST 8,0(5)
- LM 1,8,24(13)
- BR 14
-*
-NOSGT VLVCA 0(1)
- SR 8,8
-*
- VCDS 4,4,2(0)
- VCOVM 8
- VSTVM 4
- ST 8,0(5)
- LM 1,8,24(13)
- BR 14
-********************************************************************
-* RESULT 1 = GE END WITH GE
-*********************************************************************
-* SUBROUTINE YGESB(NW,AIN,ISTR,ATEST,INDEX,IFOUND)
-*
-*
-*********************************************************************
-*
-*IN R1 NW - IN R3 ISTR - IN R4 ITEST
-MIN2 LD 4,0(0,3)
-* TEST ON VECTOR SIZE IF VS LE 'SZ' NO SECTIONING
- LA 7,SZ
- SR 7,1
- BC 2,NOSGE
-*
- SR 8,8
-LOOGE VLVCU 1
- VCDS 12,4,2(0)
- VCOVM 8
- VSTVM 4
- LTR 1,1
- BC 2,LOOGE
- ST 8,0(5)
- LM 1,8,24(13)
- BR 14
-*
-NOSGE VLVCA 0(1)
- SR 8,8
-*
- VCDS 12,4,2(0)
- VCOVM 8
- VSTVM 4
- ST 8,0(5)
- LM 1,8,24(13)
- BR 14
-*********************************************************************
-* END WITH EQ
-*********************************************************************
-* SUBROUTINE YEQSB(NW,IN,ITEST,INDEX,IFOUND)
-*
-*
-*********************************************************************
-MIN1 LD 4,0(0,3)
-* TEST ON VECTOR SIZE IF VS LE 'SZ' NO SECTIONING
- LA 7,SZ
- SR 7,1
- BC 2,NOSEQ
-*
- SR 8,8
-LOOEQ VLVCU 1
- VCDS 8,4,2(0)
- VCOVM 8
- VSTVM 4
- LTR 1,1
- BC 2,LOOEQ
- ST 8,0(5)
- LM 1,8,24(13)
- BR 14
-*
-NOSEQ VLVCA 0(1)
- SR 8,8
-*
- VCDS 8,4,2(0)
- VCOVM 8
- VSTVM 4
- ST 8,0(5)
- LM 1,8,24(13)
- BR 14
-*********************************************************************
-********************************************************************
-EQ DC XL2'C5D8'
-GE DC XL2'C7C5'
-GT DC XL2'C7E3'
-CENTRO DC XL2'CCCC'
-LE DC XL2'D3C5'
-LT DC XL2'D3E3'
-NE DC XL2'D5C5'
-*
- END
-#endif
diff --git a/src/mathlib/bvsl/bvslibm/dyloxb.s b/src/mathlib/bvsl/bvslibm/dyloxb.s
deleted file mode 100644
index a6a84bd..0000000
--- a/src/mathlib/bvsl/bvslibm/dyloxb.s
+++ /dev/null
@@ -1,267 +0,0 @@
-*
-* $Id: dyloxb.s,v 1.1.1.1 1996/03/21 17:19:58 mclareni Exp $
-*
-* $Log: dyloxb.s,v $
-* Revision 1.1.1.1 1996/03/21 17:19:58 mclareni
-* Bvsl
-*
-*
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB_QMIBMVF))
-* SUBROUTINE DYLOXB(NW,Y,X,BV,IFOUND,'LO')
-*
-*
-*
-*********************************************************************
-DYLOXB CSECT
-#if defined(CERNLIB_QMIBMXA)
-DYLOXB AMODE 31
-DYLOXB RMODE ANY
-#endif
-#include "cachesz.inc"
- USING *,15
- STM 1,8,24(13)
-* R1 NW
- LM 1,6,0(1)
- L 1,0(0,1)
-*
- LH 6,0(0,6)
- LA 7,CENTRO
- LH 7,0(0,7)
- CR 6,7
- BC 4,MIN0
-*
-* RESULT 1 > CENTRO
-*
- LA 7,LT
- LH 7,0(0,7)
- CR 6,7
- BC 4,MAX1
-* RESULT 1 > = LT
- BC 8,MAX2
-* RESULT 1 NE LT END WITH NE
-*********************************************************************
-* SUBROUTINE YNEXB(NW,IN,ITEST,INDEX,IFOUND)
-*
-*
-*********************************************************************
-*
-*IN R1 NW - IN R3 ISTR - IN R4 ITEST
-* TEST ON VECTOR SIZE IF VS LE 'SZ' NO SECTIONING
- LA 7,SZ
- SR 7,1
- BC 2,NOSNE
-*
- SR 8,8
-LOONE VLVCU 1
- VLD 4,3
- VCD 6,4,2(0)
- VCOVM 8
- VSTVM 4
- LTR 1,1
- BC 2,LOONE
- ST 8,0(5)
- LM 1,8,24(13)
- BR 14
-*
-NOSNE VLVCA 0(1)
- SR 8,8
-*
- VLD 4,3
- VCD 6,4,2(0)
- VCOVM 8
- VSTVM 4
- ST 8,0(5)
- LM 1,8,24(13)
- BR 14
-*********************************************************************
-* RESULT 1 = LT END WITH LT
-*********************************************************************
-* SUBROUTINE YLTSB(NW,Y,S,INDB,IFOUND)
-*
-*********************************************************************
-*
-* TEST ON VECTOR SIZE IF VS LE 'SZ' NO SECTIONING
-MAX2 LA 7,SZ
- SR 7,1
- BC 2,NOSLT
-*
- SR 8,8
-LOOLT VLVCU 1
- VLD 4,3
- VCD 2,4,2(0)
- VCOVM 8
- VSTVM 4
- LTR 1,1
- BC 2,LOOLT
- ST 8,0(5)
- LM 1,8,24(13)
- BR 14
-*
-NOSLT VLVCA 0(1)
- SR 8,8
-*
- VLD 4,3
- VCD 2,4,2(0)
- VCOVM 8
- VSTVM 4
- ST 8,0(5)
- LM 1,8,24(13)
- BR 14
-*********************************************************************
-* RESULT 1 > LT END WITH LE
-*********************************************************************
-* SUBROUTINE YLESB(NW,AIN,ISTR,ATEST,INDEX,IFOUND)
-*
-*
-*********************************************************************
-* TEST ON VECTOR SIZE IF VS LE 'SZ' NO SECTIONING
-MAX1 LA 7,SZ
- SR 7,1
- BC 2,NOSLE
-*
- SR 8,8
-LOOLE VLVCU 1
- VLD 4,3
- VCD 10,4,2(0)
- VCOVM 8
- VSTVM 4
- LTR 1,1
- BC 2,LOOLE
- ST 8,0(5)
- LM 1,8,24(13)
- BR 14
-*
-NOSLE VLVCA 0(1)
- SR 8,8
-*
- VLD 4,3
- VCD 10,4,2(0)
- VCOVM 8
- VSTVM 4
- ST 8,0(5)
- LM 1,8,24(13)
- BR 14
-*********************************************************************
-* RESULT 1 < CENTRO
-MIN0 LA 7,GE
- LH 7,0(0,7)
- CR 6,7
- BC 4,MIN1
-* RESULT 1 > = GE
- BC 8,MIN2
-* RESULT 1 NE GE END WITH GT
-*********************************************************************
-* SUBROUTINE YGTSB(NW,AIN,ATEST,INDEX,IFOUND)
-*
-*
-*
-*********************************************************************
-* TEST ON VECTOR SIZE IF VS LE 'SZ' NO SECTIONING
- LA 7,SZ
- SR 7,1
- BC 2,NOSGT
-*
- SR 8,8
-LOOGT VLVCU 1
- VLD 4,3
- VCD 4,4,2(0)
- VCOVM 8
- VSTVM 4
- LTR 1,1
- BC 2,LOOGT
- ST 8,0(5)
- LM 1,8,24(13)
- BR 14
-*
-NOSGT VLVCA 0(1)
- SR 8,8
-*
- VLD 4,3
- VCD 4,4,2(0)
- VCOVM 8
- VSTVM 4
- ST 8,0(5)
- LM 1,8,24(13)
- BR 14
-********************************************************************
-* RESULT 1 = GE END WITH GE
-*********************************************************************
-* SUBROUTINE YGESB(NW,AIN,ISTR,ATEST,INDEX,IFOUND)
-*
-*
-*********************************************************************
-*
-*IN R1 NW - IN R3 ISTR - IN R4 ITEST
-* TEST ON VECTOR SIZE IF VS LE 'SZ' NO SECTIONING
-MIN2 LA 7,SZ
- SR 7,1
- BC 2,NOSGE
-*
- SR 8,8
-LOOGE VLVCU 1
- VLD 4,3
- VCD 12,4,2(0)
- VCOVM 8
- VSTVM 4
- LTR 1,1
- BC 2,LOOGE
- ST 8,0(5)
- LM 1,8,24(13)
- BR 14
-*
-NOSGE VLVCA 0(1)
- SR 8,8
-*
- VLD 4,3
- VCD 12,4,2(0)
- VCOVM 8
- VSTVM 4
- ST 8,0(5)
- LM 1,8,24(13)
- BR 14
-*********************************************************************
-* END WITH EQ
-*********************************************************************
-* SUBROUTINE YEQSB(NW,IN,ITEST,INDEX,IFOUND)
-*
-*
-*********************************************************************
-* TEST ON VECTOR SIZE IF VS LE 'SZ' NO SECTIONING
-MIN1 LA 7,SZ
- SR 7,1
- BC 2,NOSEQ
-*
- SR 8,8
-LOOEQ VLVCU 1
- VLD 4,3
- VCD 8,4,2(0)
- VCOVM 8
- VSTVM 4
- LTR 1,1
- BC 2,LOOEQ
- ST 8,0(5)
- LM 1,8,24(13)
- BR 14
-*
-NOSEQ VLVCA 0(1)
- SR 8,8
-*
- VLD 4,3
- VCD 8,4,2(0)
- VCOVM 8
- VSTVM 4
- ST 8,0(5)
- LM 1,8,24(13)
- BR 14
-*********************************************************************
-********************************************************************
-EQ DC XL2'C5D8'
-GE DC XL2'C7C5'
-GT DC XL2'C7E3'
-CENTRO DC XL2'CCCC'
-LE DC XL2'D3C5'
-LT DC XL2'D3E3'
-NE DC XL2'D5C5'
-*
- END
-#endif
diff --git a/src/mathlib/bvsl/bvslibm/equats.inc b/src/mathlib/bvsl/bvslibm/equats.inc
deleted file mode 100644
index 9d6c68a..0000000
--- a/src/mathlib/bvsl/bvslibm/equats.inc
+++ /dev/null
@@ -1,56 +0,0 @@
-*
-* $Id: equats.inc,v 1.1.1.1 1996/03/21 17:19:57 mclareni Exp $
-*
-* $Log: equats.inc,v $
-* Revision 1.1.1.1 1996/03/21 17:19:57 mclareni
-* Bvsl
-*
-*
-*
-* equats.inc
-*
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB_QMIBMVF))
-GT EQU 2
-LT EQU 4
-NE EQU 7
-EQ EQU 8
-GE EQU 10
-LE EQU 12
-G0 EQU 0
-G1 EQU 1
-G2 EQU 2
-G3 EQU 3
-G4 EQU 4
-G5 EQU 5
-G6 EQU 6
-G7 EQU 7
-G8 EQU 8
-G9 EQU 9
-G10 EQU 10
-G11 EQU 11
-G12 EQU 12
-G13 EQU 13
-G14 EQU 14
-G15 EQU 15
-F0 EQU 0
-F2 EQU 2
-F4 EQU 4
-F6 EQU 6
-V0 EQU 0
-V1 EQU 1
-V2 EQU 2
-V3 EQU 3
-V4 EQU 4
-V5 EQU 5
-V6 EQU 6
-V7 EQU 7
-V8 EQU 8
-V9 EQU 9
-V10 EQU 10
-V11 EQU 11
-V12 EQU 12
-V13 EQU 13
-V14 EQU 14
-V15 EQU 15
-*
-#endif
diff --git a/src/mathlib/bvsl/bvslibm/gthrb.s b/src/mathlib/bvsl/bvslibm/gthrb.s
deleted file mode 100644
index 088fbaa..0000000
--- a/src/mathlib/bvsl/bvslibm/gthrb.s
+++ /dev/null
@@ -1,60 +0,0 @@
-*
-* $Id: gthrb.s,v 1.1.1.1 1996/03/21 17:19:57 mclareni Exp $
-*
-* $Log: gthrb.s,v $
-* Revision 1.1.1.1 1996/03/21 17:19:57 mclareni
-* Bvsl
-*
-*
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB_QMIBMVF))
-*********************************************************************
-* SUBROUTINE GTHRB(NW,IN,BV,OUT)
-*
-*
-*********************************************************************
-GTHRB CSECT
-#if defined(CERNLIB_QMIBMXA)
-GTHRB AMODE 31
-GTHRB RMODE ANY
-#endif
-#include "cachesz.inc"
- USING *,15
- STM 1,5,24(13)
-*GET ADDRESS OF PARM LIST
- LM 1,4,0(1)
-*
-*IN R1 NW
- L 1,0(0,1)
-* TEST ON VECTOR SIZE IF VS LT "SZ" NOSECTIONING
- LA 5,SZ
- SR 5,1
- BC 2,NOSECT
-*
-*
-*IN R2 R3 R4 ADDRESSES OF IN BV OUT
-* ADDRESSES OF SUBSEQUENT INDEX SECTION
-LOOPV VLVCU 1
- VLVM 3
- VLME 2,2(0)
- VSTKE 2,4(0)
- BC 2,LOOPV
-* CONCLUSION VECTOR
-*
- LM 1,5,24(13)
- BR 14
-*
-* NO SECTIONING
-*
-*
-NOSECT VLVCA 0(1)
- VLVM 3
- VLME 2,2(0)
- VSTKE 2,4(0)
-* CONCLUSION NO SECTIONING
-*
- LM 1,5,24(13)
- BR 14
-*
-*
- END
-#endif
diff --git a/src/mathlib/bvsl/bvslibm/idlosb.s b/src/mathlib/bvsl/bvslibm/idlosb.s
deleted file mode 100644
index 161a34d..0000000
--- a/src/mathlib/bvsl/bvslibm/idlosb.s
+++ /dev/null
@@ -1,245 +0,0 @@
-*
-* $Id: idlosb.s,v 1.1.1.1 1996/03/21 17:19:59 mclareni Exp $
-*
-* $Log: idlosb.s,v $
-* Revision 1.1.1.1 1996/03/21 17:19:59 mclareni
-* Bvsl
-*
-*
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB_QMIBMVF))
-*********************************************************************
-* SUBROUTINE IDLOSB (NW,IY,IX,BIT,NFND,'LO',IMORE) *
-* ------------------------------------------------- *
-* *
-* Library: BVSL *
-* *
-* *
-* Selects i's for which |VIN(i)| 'lo' TEST *
-* 'lo' being one of the logical operator =, <, <=, >, >=, ^= *
-* *
-* Result via Bit-vector form *
-* *
-* Input *
-* NW : Number of elements to be processed *
-* VIN : REAL*4 Input Vector *
-* TEST : REAL*4 Test Value *
-* LO : Character*2 Logical Operator *
-* ('EQ','LT','LE','GE','GT' OR 'NE') *
-* *
-* Output *
-* BIT : Bit-Vector *
-* NFND : Number of test passed (ones in BIT) *
-* *
-* *
-* Author: F.Antonelli/IBM, M.Roethlisberger/IBM *
-* Date : 24-04-90 , Vers 1.02 *
-* *
-*********************************************************************
-IDLOSB CSECT
-#if defined(CERNLIB_QMIBMXA)
-IDLOSB AMODE 31
-IDLOSB RMODE ANY
-#endif
-#include "cachesz.inc"
- USING *,15
- STM G0,G9,20(13)
- LM G1,G7,0(1) GET ADDRESSES OF PARAMETER LIST
- L G1,0(0,G1) NW in G1
- L G7,0(0,G7) IDIFF in G7
- SR G9,G9 Reset Register
- LA G8,SZ Load Section size
-*
- LH G6,0(0,G6)
- LA G0,CENTER
- LH G0,0(0,G0)
- CR G6,G0
- BC LT,DOWNPART LO is 'QE' or 'GE' or 'GT'
-*
- LA G0,CLT
- LH G0,0(0,G0)
- CR G6,G0
- BC LT,LESSEQUA LO IS 'LE'
- BC EQ,LESSTHAN LO IS 'LT'
-*
-* LO is 'NE'
-* --------------
-NOTEQUAL SR G8,G1 SZ - NW
- BC GE,NOSECTNE > = 0
-*
-LOOPNE VLVCU G1
- VLE V0,G2(0) Load VIN
- VS V0,V0,G3(0) IY - IX
- VCQ NE,G7,V0 WHEN IY-IX ^= IDIFF
- VCOVM G9 Count and accumulate 1's bits
- VSTVM G4 Store Vector Mask Register
- LTR G1,G1 Restore proper OC
- BC GT,LOOPNE Go back to LOOP
-*
- ST G9,0(G5) Store G9 thru NFND
- LM G0,G9,20(13)
- BR 14
-*
-NOSECTNE VLVCA 0(G1)
- VLE V0,G2(0) Load VIN
- VS V0,V0,G3(0) IY - IX
- VCQ NE,G7,V0 WHEN IY-IX ^= IDIFF
- VCOVM G9 Count and accumulate 1's bits
- VSTVM G4 Store Vector MAsk Register
- ST G9,0(G5) Store G9 thru NFND
- LM 0,9,20(13)
- BR 14
-*
-* LO is 'LE'
-* --------------
-LESSEQUA SR G8,G1 SZ - NW
- BC GE,NOSECTLE > = 0
-*
-LOOPLE VLVCU G1
- VLE V0,G2(0) Load VIN
- VS V0,V0,G3(0) IY - IX
- VCQ GE,G7,V0 WHEN IY-IX >= IDIFF
- VCOVM G9 Count and accumulate 1's bits
- VSTVM G4 Store Vector Mask Register
- LTR G1,G1 Restore proper OC
- BC GT,LOOPLE Go back to LOOP
-*
- ST G9,0(G5) Store G9 thru NFND
- LM G0,G9,20(13)
- BR 14
-*
-NOSECTLE VLVCA 0(G1)
- VLE V0,G2(0) Load VIN
- VS V0,V0,G3(0) IY - IX
- VCQ GE,G7,V0 WHEN IY-IX >= IDIFF
- VCOVM G9 Count and accumulate 1's bits
- VSTVM G4 Store Vector MAsk Register
- ST G9,0(G5) Store G9 thru NFND
- LM 0,9,20(13)
- BR 14
-*
-* LO is 'LT'
-* --------------
-LESSTHAN SR G8,G1 SZ - NW
- BC GE,NOSECTLT > = 0
-*
-LOOPLT VLVCU G1
- VLE V0,G2(0) Load VIN
- VS V0,V0,G3(0) IY - IX
- VCQ GT,G7,V0 WHEN IY-IX > IDIFF
- VCOVM G9 Count and accumulate 1's bits
- VSTVM G4 Store Vector Mask Register
- LTR G1,G1 Restore proper OC
- BC GT,LOOPLT Go back to LOOP
-*
- ST G9,0(G5) Store G9 thru NFND
- LM G0,G9,20(13)
- BR 14
-*
-NOSECTLT VLVCA 0(G1)
- VLE V0,G2(0) Load VIN
- VS V0,V0,G3(0) IY - IX
- VCQ GT,G7,V0 WHEN IY-IX > IDIFF
- VCOVM G9 Count and accumulate 1's bits
- VSTVM G4 Store Vector MAsk Register
- ST G9,0(G5) Store G9 thru NFND
- LM 0,9,20(13)
- BR 14
-*
-*
-DOWNPART LA G0,CGE
- LH G0,0(0,G0)
- CR G6,G0
- BC LT,EQUALITY LO IS 'EQ'
- BC EQ,GREATEQ LO IS 'LE'
-*
-* LO is 'GT'
-* --------------
-GREATHAN SR G8,G1 SZ - NW
- BC GE,NOSECTGT > = 0
-*
-LOOPGT VLVCU G1
- VLE V0,G2(0) Load VIN
- VS V0,V0,G3(0) IY - IX
- VCQ LT,G7,V0 WHEN IY-IX < IDIFF
- VCOVM G9 Count and accumulate 1's bits
- VSTVM G4 Store Vector Mask Register
- LTR G1,G1 Restore proper OC
- BC GT,LOOPGT Go back to LOOP
-*
- ST G9,0(G5) Store G9 thru NFND
- LM G0,G9,20(13)
- BR 14
-*
-NOSECTGT VLVCA 0(G1)
- VLE V0,G2(0) Load VIN
- VS V0,V0,G3(0) IY - IX
- VCQ LT,G7,V0 WHEN IY-IX < IDIFF
- VCOVM G9 Count and accumulate 1's bits
- VSTVM G4 Store Vector MAsk Register
- ST G9,0(G5) Store G9 thru NFND
- LM 0,9,20(13)
- BR 14
-*
-* LO is 'EQ'
-* --------------
-EQUALITY SR G8,G1 SZ - NW
- BC GE,NOSECTEQ > = 0
-*
-LOOPEQ VLVCU G1
- VLE V0,G2(0) Load VIN
- VS V0,V0,G3(0) IY - IX
- VCQ EQ,G7,V0 WHEN IY-IX = IDIFF
- VCOVM G9 Count and accumulate 1's bits
- VSTVM G4 Store Vector Mask Register
- LTR G1,G1 Restore proper OC
- BC GT,LOOPEQ Go back to LOOP
-*
- ST G9,0(G5) Store G9 thru NFND
- LM G0,G9,20(13)
- BR 14
-*
-NOSECTEQ VLVCA 0(G1)
- VLE V0,G2(0) Load VIN
- VS V0,V0,G3(0) IY - IX
- VCQ EQ,G7,V0 WHEN IY-IX = IDIFF
- VCOVM G9 Count and accumulate 1's bits
- VSTVM G4 Store Vector MAsk Register
- ST G9,0(G5) Store G9 thru NFND
- LM 0,9,20(13)
- BR 14
-*
-* LO is 'GE'
-* --------------
-GREATEQ SR G8,G1 SZ - NW
- BC GE,NOSECTGE > = 0
-*
-LOOPGE VLVCU G1
- VLE V0,G2(0) Load VIN
- VS V0,V0,G3(0) IY - IX
- VCQ LE,G7,V0 WHEN IY-IX <= IDIFF
- VCOVM G9 Count and accumulate 1's bits
- VSTVM G4 Store Vector Mask Register
- LTR G1,G1 Restore proper OC
- BC GT,LOOPGE Go back to LOOP
-*
- ST G9,0(G5) Store G9 thru NFND
- LM G0,G9,20(13)
- BR 14
-*
-NOSECTGE VLVCA 0(G1)
- VLE V0,G2(0) Load VIN
- VS V0,V0,G3(0) IY - IX
- VCQ LE,G7,V0 WHEN IY-IX <= IDIFF
- VCOVM G9 Count and accumulate 1's bits
- VSTVM G4 Store Vector MAsk Register
- ST G9,0(G5) Store G9 thru NFND
- LM 0,9,20(13)
- BR 14
-*
-*
-CGE DC XL2'C7C5'
-CENTER DC XL2'CCCC'
-CLT DC XL2'D3E3'
-#include "equats.inc"
- END
-#endif
diff --git a/src/mathlib/bvsl/bvslibm/intgb.s b/src/mathlib/bvsl/bvslibm/intgb.s
deleted file mode 100644
index d703471..0000000
--- a/src/mathlib/bvsl/bvslibm/intgb.s
+++ /dev/null
@@ -1,48 +0,0 @@
-*
-* $Id: intgb.s,v 1.1.1.1 1996/03/21 17:19:59 mclareni Exp $
-*
-* $Log: intgb.s,v $
-* Revision 1.1.1.1 1996/03/21 17:19:59 mclareni
-* Bvsl
-*
-*
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB_QMIBMVF))
-*********************************************************************
-* SUBROUTINE INTGB(NW,AIN,UVEC,ALVEC,BV,IFOUND)
-*
-*
-*********************************************************************
-INTGB CSECT
-#if defined(CERNLIB_QMIBMXA)
-INTGB AMODE 31
-INTGB RMODE ANY
-#endif
- USING *,15
- STM 1,10,24(13)
-*
- LM 1,6,0(1)
-*
- L 1,0(0,1)
- LR 10,2
-*
- SR 8,8
-LOOP VLVCU 1
- LA 7,VMASK
- LR 9,7
- VLE 4,4(0)
- VLE 6,3(0)
- VCE 12,4,2
- VSTVM 7
- VCE 10,6,10
- VNVM 9
- VCOVM 8
- VSTVM 5
- LTR 1,1
- BC 2,LOOP
- ST 8,0(6)
- LM 1,10,24(13)
- BR 14
-VMASK DS 4F
-*
- END
-#endif
diff --git a/src/mathlib/bvsl/bvslibm/iygesb.s b/src/mathlib/bvsl/bvslibm/iygesb.s
deleted file mode 100644
index 204f6ab..0000000
--- a/src/mathlib/bvsl/bvslibm/iygesb.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: iygesb.s,v 1.1.1.1 1996/03/21 17:19:57 mclareni Exp $
-*
-* $Log: iygesb.s,v $
-* Revision 1.1.1.1 1996/03/21 17:19:57 mclareni
-* Bvsl
-*
-*
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB_QMIBMVF))
-*CMZ : 04/05/90 16.17.26 by Michel Roethlisberger/IBM
-*--
-#endif
diff --git a/src/mathlib/bvsl/bvslibm/iygtsb.s b/src/mathlib/bvsl/bvslibm/iygtsb.s
deleted file mode 100644
index 7cf427f..0000000
--- a/src/mathlib/bvsl/bvslibm/iygtsb.s
+++ /dev/null
@@ -1,57 +0,0 @@
-*
-* $Id: iygtsb.s,v 1.1.1.1 1996/03/21 17:19:57 mclareni Exp $
-*
-* $Log: iygtsb.s,v $
-* Revision 1.1.1.1 1996/03/21 17:19:57 mclareni
-* Bvsl
-*
-*
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB_QMIBMVF))
-*CMZ : 04/05/90 16.17.26 by Michel Roethlisberger/IBM
-*-- Author :
-*********************************************************************
-* SUBROUTINE IYGTSB(NW,AIN,ATEST,INDEX,IFOUND)
-*
-*
-*
-*********************************************************************
-IYGTSB CSECT
-#if defined(CERNLIB_QMIBMXA)
-IYGTSB AMODE 31
-IYGTSB RMODE ANY
-#endif
- USING *,15
- STM 0,9,20(13)
-* R2 AIN, R3 ATEST, R4 INDEX, R5 IFOUND
- LM 1,5,0(1)
-*
-*IN R1 NW - IN R3 ISTR - IN R4 ITEST
- L 8,0(0,1)
- L 3,0(0,3)
-* TEST ON VECTOR SIZE IF VS LE 128 NO SECTIONING
- LA 1,128
- SR 1,8
- BC 2,NOSECT
-*
- SR 9,9
-LOOP VLVCU 8
- VCS 4,3,2(0)
- VCOVM 9
- VSTVM 4
- LTR 8,8
- BC 2,LOOP
- ST 9,0(5)
- LM 0,9,20(13)
- BR 14
-*
-NOSECT VLVCA 0(8)
- SR 9,9
-*
- VCS 4,3,2(0)
- VCOVM 9
- VSTVM 4
- ST 9,0(5)
- LM 0,9,20(13)
- BR 14
- END
-#endif
diff --git a/src/mathlib/bvsl/bvslibm/iylosb.s b/src/mathlib/bvsl/bvslibm/iylosb.s
deleted file mode 100644
index d4ebc55..0000000
--- a/src/mathlib/bvsl/bvslibm/iylosb.s
+++ /dev/null
@@ -1,262 +0,0 @@
-*
-* $Id: iylosb.s,v 1.1.1.1 1996/03/21 17:19:57 mclareni Exp $
-*
-* $Log: iylosb.s,v $
-* Revision 1.1.1.1 1996/03/21 17:19:57 mclareni
-* Bvsl
-*
-*
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB_QMIBMVF))
-*
-* SUBROUTINE IYLOSB(NW,IY,IS,BV,IFOUND,'LO')
-*
-*
-*
-*********************************************************************
-IYLOSB CSECT
-#if defined(CERNLIB_QMIBMXA)
-IYLOSB AMODE 31
-IYLOSB RMODE ANY
-#endif
-#include "cachesz.inc"
- USING *,15
- STM 1,8,24(13)
-* R1 NW
- LM 1,6,0(1)
- L 1,0(0,1)
-*
- LH 6,0(0,6)
- LA 7,CENTRO
- LH 7,0(0,7)
- CR 6,7
- BC 4,MIN0
-*
-* RESULT 1 > CENTRO
-*
- LA 7,LT
- LH 7,0(0,7)
- CR 6,7
- BC 4,MAX1
-* RESULT 1 > = LT
- BC 8,MAX2
-* RESULT 1 NE LT END WITH NE
-*********************************************************************
-* SUBROUTINE YNESB(NW,IN,ITEST,INDEX,IFOUND)
-*
-*
-*********************************************************************
-*
-*IN R1 NW - IN R3 ISTR - IN R4 ITEST
- L 3,0(0,3)
-* TEST ON VECTOR SIZE IF VS LE 'SZ' NO SECTIONING
- LA 7,SZ
- SR 7,1
- BC 2,NOSNE
-*
- SR 8,8
-LOONE VLVCU 1
- VCS 6,3,2(0)
- VCOVM 8
- VSTVM 4
- LTR 1,1
- BC 2,LOONE
- ST 8,0(5)
- LM 1,8,24(13)
- BR 14
-*
-NOSNE VLVCA 0(1)
- SR 8,8
-*
- VCS 6,3,2(0)
- VCOVM 8
- VSTVM 4
- ST 8,0(5)
- LM 1,8,24(13)
- BR 14
-*********************************************************************
-* RESULT 1 = LT END WITH LT
-*********************************************************************
-* SUBROUTINE YLTSB(NW,Y,S,INDB,IFOUND)
-*
-*********************************************************************
-*
-MAX2 L 3,0(0,3)
-* TEST ON VECTOR SIZE IF VS LE 'SZ' NO SECTIONING
- LA 7,SZ
- SR 7,1
- BC 2,NOSLT
-*
- SR 8,8
-LOOLT VLVCU 1
- VCS 2,3,2(0)
- VCOVM 8
- VSTVM 4
- LTR 1,1
- BC 2,LOOLT
- ST 8,0(5)
- LM 1,8,24(13)
- BR 14
-*
-NOSLT VLVCA 0(1)
- SR 8,8
-*
- VCS 2,3,2(0)
- VCOVM 8
- VSTVM 4
- ST 8,0(5)
- LM 1,8,24(13)
- BR 14
-*********************************************************************
-* RESULT 1 > LT END WITH LE
-*********************************************************************
-* SUBROUTINE YLESB(NW,AIN,ISTR,ATEST,INDEX,IFOUND)
-*
-*
-*********************************************************************
-MAX1 L 3,0(0,3)
-* TEST ON VECTOR SIZE IF VS LE 'SZ' NO SECTIONING
- LA 7,SZ
- SR 7,1
- BC 2,NOSLE
-*
- SR 8,8
-LOOLE VLVCU 1
- VCS 10,3,2(0)
- VCOVM 8
- VSTVM 4
- LTR 1,1
- BC 2,LOOLE
- ST 8,0(5)
- LM 1,8,24(13)
- BR 14
-*
-NOSLE VLVCA 0(1)
- SR 8,8
-*
- VCS 10,3,2(0)
- VCOVM 8
- VSTVM 4
- ST 8,0(5)
- LM 1,8,24(13)
- BR 14
-*********************************************************************
-* RESULT 1 < CENTRO
-MIN0 LA 7,GE
- LH 7,0(0,7)
- CR 6,7
- BC 4,MIN1
-* RESULT 1 > = GE
- BC 8,MIN2
-* RESULT 1 NE GE END WITH GT
-*********************************************************************
-* SUBROUTINE YGTSB(NW,AIN,ATEST,INDEX,IFOUND)
-*
-*
-*
-*********************************************************************
- L 3,0(0,3)
-* TEST ON VECTOR SIZE IF VS LE 'SZ' NO SECTIONING
- LA 7,SZ
- SR 7,1
- BC 2,NOSGT
-*
- SR 8,8
-LOOGT VLVCU 1
- VCS 4,3,2(0)
- VCOVM 8
- VSTVM 4
- LTR 1,1
- BC 2,LOOGT
- ST 8,0(5)
- LM 1,8,24(13)
- BR 14
-*
-NOSGT VLVCA 0(1)
- SR 8,8
-*
- VCS 4,3,2(0)
- VCOVM 8
- VSTVM 4
- ST 8,0(5)
- LM 1,8,24(13)
- BR 14
-********************************************************************
-* RESULT 1 = GE END WITH GE
-*********************************************************************
-* SUBROUTINE YGESB(NW,AIN,ISTR,ATEST,INDEX,IFOUND)
-*
-*
-*********************************************************************
-*
-*IN R1 NW - IN R3 ISTR - IN R4 ITEST
-MIN2 L 3,0(0,3)
-* TEST ON VECTOR SIZE IF VS LE 'SZ' NO SECTIONING
- LA 7,SZ
- SR 7,1
- BC 2,NOSGE
-*
- SR 8,8
-LOOGE VLVCU 1
- VCS 12,3,2(0)
- VCOVM 8
- VSTVM 4
- LTR 1,1
- BC 2,LOOGE
- ST 8,0(5)
- LM 1,8,24(13)
- BR 14
-*
-NOSGE VLVCA 0(1)
- SR 8,8
-*
- VCS 12,3,2(0)
- VCOVM 8
- VSTVM 4
- ST 8,0(5)
- LM 1,8,24(13)
- BR 14
-*********************************************************************
-* END WITH EQ
-*********************************************************************
-* SUBROUTINE YEQSB(NW,IN,ITEST,INDEX,IFOUND)
-*
-*
-*********************************************************************
-MIN1 L 3,0(0,3)
-* TEST ON VECTOR SIZE IF VS LE 'SZ' NO SECTIONING
- LA 7,SZ
- SR 7,1
- BC 2,NOSEQ
-*
- SR 8,8
-LOOEQ VLVCU 1
- VCS 8,3,2(0)
- VCOVM 8
- VSTVM 4
- LTR 1,1
- BC 2,LOOEQ
- ST 8,0(5)
- LM 1,8,24(13)
- BR 14
-*
-NOSEQ VLVCA 0(1)
- SR 8,8
-*
- VCS 8,3,2(0)
- VCOVM 8
- VSTVM 4
- ST 8,0(5)
- LM 1,8,24(13)
- BR 14
-*********************************************************************
-********************************************************************
-EQ DC XL2'C5D8'
-GE DC XL2'C7C5'
-GT DC XL2'C7E3'
-CENTRO DC XL2'CCCC'
-LE DC XL2'D3C5'
-LT DC XL2'D3E3'
-NE DC XL2'D5C5'
-*
- END
-#endif
diff --git a/src/mathlib/bvsl/bvslibm/iyloxb.s b/src/mathlib/bvsl/bvslibm/iyloxb.s
deleted file mode 100644
index 99e2051..0000000
--- a/src/mathlib/bvsl/bvslibm/iyloxb.s
+++ /dev/null
@@ -1,267 +0,0 @@
-*
-* $Id: iyloxb.s,v 1.1.1.1 1996/03/21 17:19:57 mclareni Exp $
-*
-* $Log: iyloxb.s,v $
-* Revision 1.1.1.1 1996/03/21 17:19:57 mclareni
-* Bvsl
-*
-*
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB_QMIBMVF))
-* SUBROUTINE IYLOXB(NW,Y,X,BV,IFOUND,'LO')
-*
-*
-*
-*********************************************************************
-IYLOXB CSECT
-#if defined(CERNLIB_QMIBMXA)
-IYLOXB AMODE 31
-IYLOXB RMODE ANY
-#endif
-#include "cachesz.inc"
- USING *,15
- STM 1,8,24(13)
-* R1 NW
- LM 1,6,0(1)
- L 1,0(0,1)
-*
- LH 6,0(0,6)
- LA 7,CENTRO
- LH 7,0(0,7)
- CR 6,7
- BC 4,MIN0
-*
-* RESULT 1 > CENTRO
-*
- LA 7,LT
- LH 7,0(0,7)
- CR 6,7
- BC 4,MAX1
-* RESULT 1 > = LT
- BC 8,MAX2
-* RESULT 1 NE LT END WITH NE
-*********************************************************************
-* SUBROUTINE YNEXB(NW,IN,ITEST,INDEX,IFOUND)
-*
-*
-*********************************************************************
-*
-*IN R1 NW - IN R3 ISTR - IN R4 ITEST
-* TEST ON VECTOR SIZE IF VS LE 'SZ' NO SECTIONING
- LA 7,SZ
- SR 7,1
- BC 2,NOSNE
-*
- SR 8,8
-LOONE VLVCU 1
- VL 4,3
- VC 6,4,2(0)
- VCOVM 8
- VSTVM 4
- LTR 1,1
- BC 2,LOONE
- ST 8,0(5)
- LM 1,8,24(13)
- BR 14
-*
-NOSNE VLVCA 0(1)
- SR 8,8
-*
- VL 4,3
- VC 6,4,2(0)
- VCOVM 8
- VSTVM 4
- ST 8,0(5)
- LM 1,8,24(13)
- BR 14
-*********************************************************************
-* RESULT 1 = LT END WITH LT
-*********************************************************************
-* SUBROUTINE YLTSB(NW,Y,S,INDB,IFOUND)
-*
-*********************************************************************
-*
-* TEST ON VECTOR SIZE IF VS LE 'SZ' NO SECTIONING
-MAX2 LA 7,SZ
- SR 7,1
- BC 2,NOSLT
-*
- SR 8,8
-LOOLT VLVCU 1
- VL 4,3
- VC 2,4,2(0)
- VCOVM 8
- VSTVM 4
- LTR 1,1
- BC 2,LOOLT
- ST 8,0(5)
- LM 1,8,24(13)
- BR 14
-*
-NOSLT VLVCA 0(1)
- SR 8,8
-*
- VL 4,3
- VC 2,4,2(0)
- VCOVM 8
- VSTVM 4
- ST 8,0(5)
- LM 1,8,24(13)
- BR 14
-*********************************************************************
-* RESULT 1 > LT END WITH LE
-*********************************************************************
-* SUBROUTINE YLESB(NW,AIN,ISTR,ATEST,INDEX,IFOUND)
-*
-*
-*********************************************************************
-* TEST ON VECTOR SIZE IF VS LE 'SZ' NO SECTIONING
-MAX1 LA 7,SZ
- SR 7,1
- BC 2,NOSLE
-*
- SR 8,8
-LOOLE VLVCU 1
- VL 4,3
- VC 10,4,2(0)
- VCOVM 8
- VSTVM 4
- LTR 1,1
- BC 2,LOOLE
- ST 8,0(5)
- LM 1,8,24(13)
- BR 14
-*
-NOSLE VLVCA 0(1)
- SR 8,8
-*
- VL 4,3
- VC 10,4,2(0)
- VCOVM 8
- VSTVM 4
- ST 8,0(5)
- LM 1,8,24(13)
- BR 14
-*********************************************************************
-* RESULT 1 < CENTRO
-MIN0 LA 7,GE
- LH 7,0(0,7)
- CR 6,7
- BC 4,MIN1
-* RESULT 1 > = GE
- BC 8,MIN2
-* RESULT 1 NE GE END WITH GT
-*********************************************************************
-* SUBROUTINE YGTSB(NW,AIN,ATEST,INDEX,IFOUND)
-*
-*
-*
-*********************************************************************
-* TEST ON VECTOR SIZE IF VS LE 'SZ' NO SECTIONING
- LA 7,SZ
- SR 7,1
- BC 2,NOSGT
-*
- SR 8,8
-LOOGT VLVCU 1
- VL 4,3
- VC 4,4,2(0)
- VCOVM 8
- VSTVM 4
- LTR 1,1
- BC 2,LOOGT
- ST 8,0(5)
- LM 1,8,24(13)
- BR 14
-*
-NOSGT VLVCA 0(1)
- SR 8,8
-*
- VL 4,3
- VC 4,4,2(0)
- VCOVM 8
- VSTVM 4
- ST 8,0(5)
- LM 1,8,24(13)
- BR 14
-********************************************************************
-* RESULT 1 = GE END WITH GE
-*********************************************************************
-* SUBROUTINE YGESB(NW,AIN,ISTR,ATEST,INDEX,IFOUND)
-*
-*
-*********************************************************************
-*
-*IN R1 NW - IN R3 ISTR - IN R4 ITEST
-* TEST ON VECTOR SIZE IF VS LE 'SZ' NO SECTIONING
-MIN2 LA 7,SZ
- SR 7,1
- BC 2,NOSGE
-*
- SR 8,8
-LOOGE VLVCU 1
- VL 4,3
- VC 12,4,2(0)
- VCOVM 8
- VSTVM 4
- LTR 1,1
- BC 2,LOOGE
- ST 8,0(5)
- LM 1,8,24(13)
- BR 14
-*
-NOSGE VLVCA 0(1)
- SR 8,8
-*
- VL 4,3
- VC 12,4,2(0)
- VCOVM 8
- VSTVM 4
- ST 8,0(5)
- LM 1,8,24(13)
- BR 14
-*********************************************************************
-* END WITH EQ
-*********************************************************************
-* SUBROUTINE YEQSB(NW,IN,ITEST,INDEX,IFOUND)
-*
-*
-*********************************************************************
-* TEST ON VECTOR SIZE IF VS LE 'SZ' NO SECTIONING
-MIN1 LA 7,SZ
- SR 7,1
- BC 2,NOSEQ
-*
- SR 8,8
-LOOEQ VLVCU 1
- VL 4,3
- VC 8,4,2(0)
- VCOVM 8
- VSTVM 4
- LTR 1,1
- BC 2,LOOEQ
- ST 8,0(5)
- LM 1,8,24(13)
- BR 14
-*
-NOSEQ VLVCA 0(1)
- SR 8,8
-*
- VL 4,3
- VC 8,4,2(0)
- VCOVM 8
- VSTVM 4
- ST 8,0(5)
- LM 1,8,24(13)
- BR 14
-*********************************************************************
-********************************************************************
-EQ DC XL2'C5D8'
-GE DC XL2'C7C5'
-GT DC XL2'C7E3'
-CENTRO DC XL2'CCCC'
-LE DC XL2'D3C5'
-LT DC XL2'D3E3'
-NE DC XL2'D5C5'
-*
- END
-#endif
diff --git a/src/mathlib/bvsl/bvslibm/iyltsb.s b/src/mathlib/bvsl/bvslibm/iyltsb.s
deleted file mode 100644
index 21a83b4..0000000
--- a/src/mathlib/bvsl/bvslibm/iyltsb.s
+++ /dev/null
@@ -1,57 +0,0 @@
-*
-* $Id: iyltsb.s,v 1.1.1.1 1996/03/21 17:19:57 mclareni Exp $
-*
-* $Log: iyltsb.s,v $
-* Revision 1.1.1.1 1996/03/21 17:19:57 mclareni
-* Bvsl
-*
-*
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB_QMIBMVF))
-*CMZ : 04/05/90 16.17.26 by Michel Roethlisberger/IBM
-*-- Author :
-*********************************************************************
-* SUBROUTINE IYLTSB(NW,IN,ITEST,INDEX,IFOUND)
-*
-*
-*
-*********************************************************************
-IYLTSB CSECT
-#if defined(CERNLIB_QMIBMXA)
-IYLTSB AMODE 31
-IYLTSB RMODE ANY
-#endif
- USING *,15
- STM 0,9,20(13)
-* R2 IN, R3 ITEST, R4 INDEX, R5 IFOUND
- LM 1,5,0(1)
-*
-*IN R1 NW - IN R3 ISTR - IN R4 ITEST
- L 8,0(0,1)
- L 3,0(0,3)
-* TEST ON VECTOR SIZE IF VS LE 128 NO SECTIONING
- LA 1,128
- SR 1,8
- BC 2,NOSECT
-*
- SR 9,9
-LOOP VLVCU 8
- VCS 2,3,2(0)
- VCOVM 9
- VSTVM 4
- LTR 8,8
- BC 2,LOOP
- ST 9,0(5)
- LM 0,9,20(13)
- BR 14
-*
-NOSECT VLVCA 0(8)
- SR 9,9
-*
- VCS 2,3,2(0)
- VCOVM 9
- VSTVM 4
- ST 9,0(5)
- LM 0,9,20(13)
- BR 14
- END
-#endif
diff --git a/src/mathlib/bvsl/bvslibm/nandb.s b/src/mathlib/bvsl/bvslibm/nandb.s
deleted file mode 100644
index 4076b53..0000000
--- a/src/mathlib/bvsl/bvslibm/nandb.s
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: nandb.s,v 1.1.1.1 1996/03/21 17:19:58 mclareni Exp $
-*
-* $Log: nandb.s,v $
-* Revision 1.1.1.1 1996/03/21 17:19:58 mclareni
-* Bvsl
-*
-*
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB_QMIBMVF))
-*********************************************************************
-* SUBROUTINE NANDB(NW,BINV1,BINV2,BINVOU,NWOUT)
-*
-* PERFORMS NOT AND OF TWO BINARY VECTORS
-* NW1 INPUT VECTOR LENGTH
-*
-*********************************************************************
-NAND CSECT
-#if defined(CERNLIB_QMIBMXA)
-NAND AMODE 31
-NAND RMODE ANY
-#endif
- USING *,15
- STM 1,6,24(13)
-* R2 IN, R3 ISRT, R4 ITEST, R5 INDEX, R6 IFOUND
- LM 1,5,0(1)
-*
- SR 6,6
- L 1,0(0,1)
-LOOP VLVCU 1
- VLVM 2
- VNVM 3
- VCVM
- VCOVM 6
- VSTVM 4
- LTR 1,1
- BC 2,LOOP
- ST 6,0(5)
- LM 1,6,24(13)
- BR 14
- END
-#endif
diff --git a/src/mathlib/bvsl/bvslibm/norb.s b/src/mathlib/bvsl/bvslibm/norb.s
deleted file mode 100644
index aa80661..0000000
--- a/src/mathlib/bvsl/bvslibm/norb.s
+++ /dev/null
@@ -1,40 +0,0 @@
-*
-* $Id: norb.s,v 1.1.1.1 1996/03/21 17:19:58 mclareni Exp $
-*
-* $Log: norb.s,v $
-* Revision 1.1.1.1 1996/03/21 17:19:58 mclareni
-* Bvsl
-*
-*
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB_QMIBMVF))
-*********************************************************************
-* SUBROUTINE NORB(NW,BINV1,BINV2,BINVOU,NWOUT)
-*
-* PERFORMS NOT XOR OF TWO BINARY VECTORS
-* NW1 INPUT VECTOR LENGTH
-*
-*********************************************************************
-NORB CSECT
-#if defined(CERNLIB_QMIBMXA)
-NORB AMODE 31
-NORB RMODE ANY
-#endif
- USING *,15
- STM 1,6,24(13)
- LM 1,5,0(1)
-*
- SR 6,6
- L 1,0(0,1)
-LOOP VLVCU 1
- VLVM 2
- VXVM 3
- VCVM
- VCOVM 6
- VSTVM 4
- LTR 1,1
- BC 2,LOOP
- ST 6,0(5)
- LM 1,6,24(13)
- BR 14
- END
-#endif
diff --git a/src/mathlib/bvsl/bvslibm/notb.s b/src/mathlib/bvsl/bvslibm/notb.s
deleted file mode 100644
index 72711bc..0000000
--- a/src/mathlib/bvsl/bvslibm/notb.s
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: notb.s,v 1.1.1.1 1996/03/21 17:19:58 mclareni Exp $
-*
-* $Log: notb.s,v $
-* Revision 1.1.1.1 1996/03/21 17:19:58 mclareni
-* Bvsl
-*
-*
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB_QMIBMVF))
-*********************************************************************
-* SUBROUTINE NOTB(NW,BINV1,BINVOU,NWOUT)
-*
-* PERFORMS AND OF TWO BINARY VECTORS
-* NW1 INPUT VECTOR LENGTH
-*
-* Modif.
-* 25-08-89 M.Roethlisberger Replaces VLVM 1 + VCVMwith VLCVM1
-*
-*********************************************************************
-NOTB CSECT
-#if defined(CERNLIB_QMIBMXA)
-NOTB AMODE 31
-NOTB RMODE ANY
-#endif
- USING *,15
- STM 1,5,24(13)
- LM 1,4,0(1)
-*
- SR 5,5
- L 1,0(0,1)
-LOOP VLVCU 1
- VLCVM 2
- VCOVM 5
- VSTVM 3
- LTR 1,1
- BC 2,LOOP
- ST 5,0(4)
- LM 1,5,24(13)
- BR 14
- END
-#endif
diff --git a/src/mathlib/bvsl/bvslibm/oneb.s b/src/mathlib/bvsl/bvslibm/oneb.s
deleted file mode 100644
index 7f1f02a..0000000
--- a/src/mathlib/bvsl/bvslibm/oneb.s
+++ /dev/null
@@ -1,40 +0,0 @@
-*
-* $Id: oneb.s,v 1.1.1.1 1996/03/21 17:19:59 mclareni Exp $
-*
-* $Log: oneb.s,v $
-* Revision 1.1.1.1 1996/03/21 17:19:59 mclareni
-* Bvsl
-*
-*
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB_QMIBMVF))
-*********************************************************************
-* SUBROUTINE ONEB(NW,BV)
-* SET TO 1 THE BV
-* AUTOR: F. ANTONELLI LIBRARY: BVSL
-*********************************************************************
-ONEB CSECT
-#if defined(CERNLIB_QMIBMXA)
-ONEB AMODE 31
-ONEB RMODE ANY
-#endif
- USING *,15
- STM G1,G3,24(13)
-* R2 IN, R3 ISRT, R4 ITEST, R5 INDEX, R6 IFOUND
- LM 1,2,0(1)
-*
-*IN R1 NW
- L 1,0(0,1)
- LA 3,ONE
-*
- VLVCU 1
- VLVM 3
-LOOP VSTVM 2
- VLVCU 1
- BC 3,LOOP
- LM 1,3,24(13)
- BR 14
-ONE DC XL16'FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF'
-*
-#include "equats.inc"
- END
-#endif
diff --git a/src/mathlib/bvsl/bvslibm/orb.s b/src/mathlib/bvsl/bvslibm/orb.s
deleted file mode 100644
index df2e70c..0000000
--- a/src/mathlib/bvsl/bvslibm/orb.s
+++ /dev/null
@@ -1,39 +0,0 @@
-*
-* $Id: orb.s,v 1.1.1.1 1996/03/21 17:19:58 mclareni Exp $
-*
-* $Log: orb.s,v $
-* Revision 1.1.1.1 1996/03/21 17:19:58 mclareni
-* Bvsl
-*
-*
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB_QMIBMVF))
-*********************************************************************
-* SUBROUTINE ORB(NW,BINV1,BINV2,BINVOU,NWOUT)
-*
-* PERFORMS AND OF TWO BINARY VECTORS
-* NW1 INPUT VECTOR LENGTH
-*
-*********************************************************************
-ORB CSECT
-#if defined(CERNLIB_QMIBMXA)
-ORB AMODE 31
-ORB RMODE ANY
-#endif
- USING *,15
- STM 1,6,24(13)
- LM 1,5,0(1)
-*
- SR 6,6
- L 1,0(0,1)
-LOOP VLVCU 1
- VLVM 2
- VOVM 3
- VCOVM 6
- VSTVM 4
- LTR 1,1
- BC 2,LOOP
- ST 6,0(5)
- LM 1,6,24(13)
- BR 14
- END
-#endif
diff --git a/src/mathlib/bvsl/bvslibm/ornotb.s b/src/mathlib/bvsl/bvslibm/ornotb.s
deleted file mode 100644
index 1660a0f..0000000
--- a/src/mathlib/bvsl/bvslibm/ornotb.s
+++ /dev/null
@@ -1,42 +0,0 @@
-*
-* $Id: ornotb.s,v 1.1.1.1 1996/03/21 17:19:59 mclareni Exp $
-*
-* $Log: ornotb.s,v $
-* Revision 1.1.1.1 1996/03/21 17:19:59 mclareni
-* Bvsl
-*
-*
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB_QMIBMVF))
-*********************************************************************
-* SUBROUTINE ORNOTB(NW,BINV1,BINV2,BINVOU,NWOUT)
-*
-* PERFORMS NOT XOR OF TWO BINARY VECTORS
-* NW1 INPUT VECTOR LENGTH
-* AUTOR: F. ANTONELLI LIBRARY: BVSL
-*
-*********************************************************************
-ORNOTB CSECT
-#if defined(CERNLIB_QMIBMXA)
-ORNOTB AMODE 31
-ORNOTB RMODE ANY
-#endif
- USING *,15
- STM G1,G6,24(13)
- LM 1,5,0(1)
-*
- SR 6,6
- L 1,0(0,1)
-LOOP VLVCU 1
- VLVM 3
- VCVM
- VXVM 2
- VCOVM 6
- VSTVM 4
- LTR G1,G1 Restore proper OC
- BC 2,LOOP
- ST 6,0(5)
- LM 1,6,24(13)
- BR 14
-#include "equats.inc"
- END
-#endif
diff --git a/src/mathlib/bvsl/bvslibm/rangb.s b/src/mathlib/bvsl/bvslibm/rangb.s
deleted file mode 100644
index b520504..0000000
--- a/src/mathlib/bvsl/bvslibm/rangb.s
+++ /dev/null
@@ -1,49 +0,0 @@
-*
-* $Id: rangb.s,v 1.1.1.1 1996/03/21 17:19:58 mclareni Exp $
-*
-* $Log: rangb.s,v $
-* Revision 1.1.1.1 1996/03/21 17:19:58 mclareni
-* Bvsl
-*
-*
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB_QMIBMVF))
-*********************************************************************
-* SUBROUTINE RANGB(NW,AIN,UBOUND,ALBOUND,INDEX,IFOUND)
-*
-*
-*
-*********************************************************************
-RANGB CSECT
-#if defined(CERNLIB_QMIBMXA)
-RANGB AMODE 31
-RANGB RMODE ANY
-#endif
- USING *,15
- STM 1,9,24(13)
-*
- LM 1,6,0(1)
-*
- L 1,0(0,1)
- LE 2,0(0,3)
- LE 4,0(0,4)
-*
- SR 8,8
-LOOP VLVCU 1
- LA 7,VMASK
- LR 9,7
- VLE 2,2(0)
- VCEQ 12,4,2
- VSTVM 7
- VCEQ 10,2,2
- VNVM 9
- VCOVM 8
- VSTVM 5
- LTR 1,1
- BC 2,LOOP
- ST 8,0(6)
- LM 1,9,24(13)
- BR 14
-VMASK DS 4F
-*
- END
-#endif
diff --git a/src/mathlib/bvsl/bvslibm/rjctb.s b/src/mathlib/bvsl/bvslibm/rjctb.s
deleted file mode 100644
index d539913..0000000
--- a/src/mathlib/bvsl/bvslibm/rjctb.s
+++ /dev/null
@@ -1,96 +0,0 @@
-*
-* $Id: rjctb.s,v 1.1.1.1 1996/03/21 17:19:59 mclareni Exp $
-*
-* $Log: rjctb.s,v $
-* Revision 1.1.1.1 1996/03/21 17:19:59 mclareni
-* Bvsl
-*
-*
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB_QMIBMVF))
-**********************************************************************
-* *
-* SUBROUTINE RJCTB(RAN,XIN,FREJ,XOUT,INDIN,NW,NWOUT,ISWTCH) *
-* *
-* PERFORM REJECTION TECHNIQUE IN VECTOR MODE *
-* AND WITH MINIMUM RANDOM NUMBERS GENERATION *
-* *
-* *
-**********************************************************************
-* DIMENSION RAN(1000),XIN(1000),XOUT(1000),INDOUT(1000)
-* +,FREJ(1000),INDIN(1000)
-* J=0
-* DO 10 I=1, NW
-* IF(RAN(INDIN(I)).LT.FREJ(INDIN(I)))THEN
-* XOUT(INDIN(I))=XIN(INDIN(I))
-* ELSE
-* J=J+1
-* INDOUT(J)=INDIN(I)
-* ENDIF
-*10 CONTINUE
-* NW=J
-* RETURN
-* END
-**********************************************************************
-RJCTB CSECT
-#if defined(CERNLIB_QMIBMXA)
-RJCTB AMODE 31
-RJCTB RMODE ANY
-#endif
- USING *,15
- STM 14,12,12(13)
-* R1 RAN, R2 XIN, R3 FREJ, R4 XOUT, R5 INDIN , R6 NW
- LM 1,8,0(1)
- L 9,0(0,6)
-* IF FIRST STEP OR GATHER
-* TEST SWITCH
- LA 10,1
- S 10,0(0,8)
- BC 6,SWITCH
-* NO INDEX FIRST CALL OR GATHER
- SR 10,10
-*
-LOOP0 VLVCU 9
- VLE 3,3
- VLE 2,2
- VCE 2,3,1
- VSTME 2,4
- VCVM
- VCOVM 10
- VSTVM 5
-*
- LTR 9,9
- BC 2,LOOP0
- ST 10,0(0,7)
- LA 10,2
- ST 10,0(0,8)
- LM 14,12,12(13)
- BR 14
-*
-*
-* WITH INDEX
-SWITCH SR 10,10
- LR 11,5
- LR 12,5
- LR 14,5
-*
-LOOP1 VLVCU 9
- VLVM 5
- VLYE 1,1(0)
- VCE 4,1,3
- VNVM 11
- VLME 2,2
- VSTME 2,4
- VXVM 12
- VCOVM 10
- VSTVM 14
-*
- LTR 9,9
- BC 2,LOOP1
- ST 10,0(0,7)
- LA 0,2
- ST 0,0(0,8)
- LM 14,12,12(13)
- BR 14
-*
- END
-#endif
diff --git a/src/mathlib/bvsl/bvslibm/scalb.s b/src/mathlib/bvsl/bvslibm/scalb.s
deleted file mode 100644
index d9f0f97..0000000
--- a/src/mathlib/bvsl/bvslibm/scalb.s
+++ /dev/null
@@ -1,44 +0,0 @@
-*
-* $Id: scalb.s,v 1.1.1.1 1996/03/21 17:19:59 mclareni Exp $
-*
-* $Log: scalb.s,v $
-* Revision 1.1.1.1 1996/03/21 17:19:59 mclareni
-* Bvsl
-*
-*
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB_QMIBMVF))
-*********************************************************************
-* SUBROUTINE SCALB(NW,BINV,Y,ALPHA)
-*
-* Y = ALPHA*X
-*
-*********************************************************************
-SCALB CSECT
-#if defined(CERNLIB_QMIBMXA)
-SCALB AMODE 31
-SCALB RMODE ANY
-#endif
- USING *,15
- STM 0,7,20(13)
-* R1 NW, R2 BINV, R3 Y, R4 ALPHA
- LM 1,4,0(1)
-*
-*IN R1 NW
- L 1,0(0,1)
-*IN F6 ALPHA
- LE 6,0(0,4)
- LR 7,3
-*
- VSVMM 1
-LOOP VLVCU 1
- VLVM 2
- VLME 0,3
- VMEQ 2,6,0
- VSTME 2,7
- BC 2,LOOP
- VSVMM 0
- LM 0,7,20(13)
- BR 14
-*
- END
-#endif
diff --git a/src/mathlib/bvsl/bvslibm/scttb.s b/src/mathlib/bvsl/bvslibm/scttb.s
deleted file mode 100644
index 1154041..0000000
--- a/src/mathlib/bvsl/bvslibm/scttb.s
+++ /dev/null
@@ -1,60 +0,0 @@
-*
-* $Id: scttb.s,v 1.1.1.1 1996/03/21 17:19:57 mclareni Exp $
-*
-* $Log: scttb.s,v $
-* Revision 1.1.1.1 1996/03/21 17:19:57 mclareni
-* Bvsl
-*
-*
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB_QMIBMVF))
-*********************************************************************
-* SUBROUTINE SCTTB(NW,OUT,INDEX,HIN)
-*
-*
-*********************************************************************
-SCTTB CSECT
-#if defined(CERNLIB_QMIBMXA)
-SCTTB AMODE 31
-SCTTB RMODE ANY
-#endif
-#include "cachesz.inc"
- USING *,15
- STM 1,5,24(13)
-*GET ADDRESS OF PARM LIST
- LM 1,4,0(1)
-*
-*IN R1 NW
- L 1,0(0,1)
-* TEST ON VECTOR SIZE IF VS LT "SZ" NOSECTIONING
- LA 5,SZ
- SR 5,1
- BC 2,NOSECT
-*
-*
-*IN R2 R3 R4 ADDRESSES OF OUT HIN INDEX
-* ADDRESSES OF SUBSEQUENT INDEX SECTION
-LOOPV VLVCU 1
- VLVM 3
- VLYE 2,2(0)
- VSTME 2,4(0)
- BC 2,LOOPV
-* CONCLUSION VECTOR
-*
- LM 1,5,24(13)
- BR 14
-*
-* NO SECTIONING
-*
-*
-NOSECT VLVCA 0(1)
- VLVM 3
- VLYE 2,2(0)
- VSTME 2,4(0)
-* CONCLUSION NO SECTIONING
-*
- LM 1,5,24(13)
- BR 14
-*
-*
- END
-#endif
diff --git a/src/mathlib/bvsl/bvslibm/smod3b.s b/src/mathlib/bvsl/bvslibm/smod3b.s
deleted file mode 100644
index 3e05ded..0000000
--- a/src/mathlib/bvsl/bvslibm/smod3b.s
+++ /dev/null
@@ -1,66 +0,0 @@
-*
-* $Id: smod3b.s,v 1.1.1.1 1996/03/21 17:19:59 mclareni Exp $
-*
-* $Log: smod3b.s,v $
-* Revision 1.1.1.1 1996/03/21 17:19:59 mclareni
-* Bvsl
-*
-*
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB_QMIBMVF))
-*********************************************************************
-* SUBROUTINE SMOD3B(NW,A1,A2,A3,OUT,IBV)
-*
-* AUTOR: F. ANTONELLI LIBRARY: BVSL
-*
-*********************************************************************
-SMOD3B CSECT
-#if defined(CERNLIB_QMIBMXA)
-SMOD3B AMODE 31
-SMOD3B RMODE ANY
-#endif
- USING SMOD3B,12
- STM G14,G12,12(13)
- LR 12,15
- ST 13,SAVA+4
- LR 2,13
- LA 13,SAVA
- ST 13,8(2)
-*GET ADDRESS OF PARM LIST NW , IN , OUT
- LM 1,6,0(1)
-*
-*IN R1 NW
- L 1,0(0,1)
-* NO SECTIONING
-*
- LR 7,3
- LR 8,4
-*
- VSVMM 1 Set Vector Mask Mode ON
-*
-LOOPV VLVCU 1
- VLVM 6
- VLME 2,2
- VMER 14,2,2
- VLME 4,3
- VMAE 14,4,7
- VLME 6,4
- VMAE 14,6,8
- L 15,=V(W#SQRT)
- BALR 14,15
-*
- VSTME 0,5
- LTR G1,G1 Restore proper OC
- BC 2,LOOPV
- VSVMM 0 Set Vector MAsk Mode OFF
-* CONCLUSION NO SECTIONING
-*
- L 13,SAVA+4
- LM G14,G12,12(G13)
- BR 14
-SAVA DS 18F
-*
- DC V(VFVIX#)
-*
-#include "equats.inc"
- END
-#endif
diff --git a/src/mathlib/bvsl/bvslibm/sxpyb.s b/src/mathlib/bvsl/bvslibm/sxpyb.s
deleted file mode 100644
index 0455844..0000000
--- a/src/mathlib/bvsl/bvslibm/sxpyb.s
+++ /dev/null
@@ -1,44 +0,0 @@
-*
-* $Id: sxpyb.s,v 1.1.1.1 1996/03/21 17:19:58 mclareni Exp $
-*
-* $Log: sxpyb.s,v $
-* Revision 1.1.1.1 1996/03/21 17:19:58 mclareni
-* Bvsl
-*
-*
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB_QMIBMVF))
-*********************************************************************
-* SUBROUTINE SXPYB(NW,BINV,Y,X,ALPHA)
-*
-* Y = Y + ALPHA*X
-*
-*********************************************************************
-SXPYB CSECT
-#if defined(CERNLIB_QMIBMXA)
-SXPYB AMODE 31
-SXPYB RMODE ANY
-#endif
- USING *,15
- STM 0,7,20(13)
-* R1 NW, R2 BINV, R3 Y, R4 X, R5 ALPHA
- LM 1,5,0(1)
-*
-*IN R1 NW
- L 1,0(0,1)
-*IN F6 ALPHA
- LE 6,0(0,5)
- LR 7,3
-*
- VSVMM 1
-LOOP VLVCU 1
- VLVM 2
- VLME 0,3
- VMAES 0,6,4
- VSTME 0,7
- BC 2,LOOP
- VSVMM 0
- LM 0,7,20(13)
- BR 14
-*
- END
-#endif
diff --git a/src/mathlib/bvsl/bvslibm/sxyb.s b/src/mathlib/bvsl/bvslibm/sxyb.s
deleted file mode 100644
index d733e98..0000000
--- a/src/mathlib/bvsl/bvslibm/sxyb.s
+++ /dev/null
@@ -1,44 +0,0 @@
-*
-* $Id: sxyb.s,v 1.1.1.1 1996/03/21 17:19:58 mclareni Exp $
-*
-* $Log: sxyb.s,v $
-* Revision 1.1.1.1 1996/03/21 17:19:58 mclareni
-* Bvsl
-*
-*
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB_QMIBMVF))
-*********************************************************************
-* SUBROUTINE SXYB(NW,BINV,SCAL,Y,X)
-*
-* Y = SCAL*X*Y
-*
-*********************************************************************
-SXYB CSECT
-#if defined(CERNLIB_QMIBMXA)
-SXYB AMODE 31
-SXYB RMODE ANY
-#endif
- USING *,15
- STM 0,9,20(13)
-* R1 NW, R2 BINV, R3 SCAL , R4 Y , R5 X
- LM 1,5,0(1)
-*
-*IN R1 NW
- L 1,0(0,1)
- LE 0,0(0,5)
- LR 7,3
-*
- VSVMM 1
-LOOP VLVCU 1
- VLVM 2
- VLME 0,4
- VME 2,0,3
- VMEQ 4,0,2
- VSTME 4,7
- BC 2,LOOP
- VSVMM 0
- LM 0,9,20(13)
- BR 14
-*
- END
-#endif
diff --git a/src/mathlib/bvsl/bvslibm/vsetb.s b/src/mathlib/bvsl/bvslibm/vsetb.s
deleted file mode 100644
index f757443..0000000
--- a/src/mathlib/bvsl/bvslibm/vsetb.s
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: vsetb.s,v 1.1.1.1 1996/03/21 17:19:59 mclareni Exp $
-*
-* $Log: vsetb.s,v $
-* Revision 1.1.1.1 1996/03/21 17:19:59 mclareni
-* Bvsl
-*
-*
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB_QMIBMVF))
-*********************************************************************
-* SUBROUTINE VSETB(NW,BINV,Y,CONST)
-*
-* SET Y TO CONST FOR GIVEN INDEX
-*
-*********************************************************************
-VSETB CSECT
-#if defined(CERNLIB_QMIBMXA)
-VSETB AMODE 31
-VSETB RMODE ANY
-#endif
- USING *,15
- STM 0,4,20(13)
-* R1 NW, R2 BINV, R3 Y, R4 ALPHA
- LM 1,4,0(1)
-*
-*IN R1 NW
- L 1,0(0,1)
-*IN F4 CONST
- LE 4,0(0,4)
-*
-LOOP VLVCU 1
- VLVM 2
- VLMEQ 0,4
- VSTME 0,3
- BC 2,LOOP
- VSVMM 0
- LM 0,4,20(13)
- BR 14
-*
- END
-#endif
diff --git a/src/mathlib/bvsl/bvslibm/vxpyb.s b/src/mathlib/bvsl/bvslibm/vxpyb.s
deleted file mode 100644
index e904e2e..0000000
--- a/src/mathlib/bvsl/bvslibm/vxpyb.s
+++ /dev/null
@@ -1,43 +0,0 @@
-*
-* $Id: vxpyb.s,v 1.1.1.1 1996/03/21 17:19:58 mclareni Exp $
-*
-* $Log: vxpyb.s,v $
-* Revision 1.1.1.1 1996/03/21 17:19:58 mclareni
-* Bvsl
-*
-*
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB_QMIBMVF))
-*********************************************************************
-* SUBROUTINE VXPYB(NW,BINV,Y,X,V)
-*
-* Y(BV) = Y(BV) + V(BV)*X(BV)
-*
-*********************************************************************
-VXPYB CSECT
-#if defined(CERNLIB_QMIBMXA)
-VXPYB AMODE 31
-VXPYB RMODE ANY
-#endif
- USING *,15
- STM 0,7,20(13)
-* R1 NW, R2 BINV, R3 Y, R4 X, R5 V
- LM 1,5,0(1)
-*
-*IN R1 NW
- L 1,0(0,1)
- LR 7,3
-*
- VSVMM 1
-LOOP VLVCU 1
- VLVM 2
- VLME 0,3
- VLME 4,4
- VMAE 0,4,5
- VSTME 0,7
- BC 2,LOOP
- VSVMM 0
- LM 0,7,20(13)
- BR 14
-*
- END
-#endif
diff --git a/src/mathlib/bvsl/bvslibm/xorb.s b/src/mathlib/bvsl/bvslibm/xorb.s
deleted file mode 100644
index 4de9b67..0000000
--- a/src/mathlib/bvsl/bvslibm/xorb.s
+++ /dev/null
@@ -1,39 +0,0 @@
-*
-* $Id: xorb.s,v 1.1.1.1 1996/03/21 17:19:58 mclareni Exp $
-*
-* $Log: xorb.s,v $
-* Revision 1.1.1.1 1996/03/21 17:19:58 mclareni
-* Bvsl
-*
-*
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB_QMIBMVF))
-*********************************************************************
-* SUBROUTINE XORB(NW,BINV1,BINV2,BINVOU,NWOUT)
-*
-* PERFORMS AND OF TWO BINARY VECTORS
-* NW1 INPUT VECTOR LENGTH
-*
-*********************************************************************
-XORB CSECT
-#if defined(CERNLIB_QMIBMXA)
-XORB AMODE 31
-XORB RMODE ANY
-#endif
- USING *,15
- STM 1,6,24(13)
- LM 1,5,0(1)
-*
- SR 6,6
- L 1,0(0,1)
-LOOP VLVCU 1
- VLVM 2
- VXVM 3
- VCOVM 6
- VSTVM 4
- LTR 1,1
- BC 2,LOOP
- ST 6,0(5)
- LM 1,6,24(13)
- BR 14
- END
-#endif
diff --git a/src/mathlib/bvsl/bvslibm/xypwzb.s b/src/mathlib/bvsl/bvslibm/xypwzb.s
deleted file mode 100644
index e397399..0000000
--- a/src/mathlib/bvsl/bvslibm/xypwzb.s
+++ /dev/null
@@ -1,50 +0,0 @@
-*
-* $Id: xypwzb.s,v 1.1.1.1 1996/03/21 17:19:59 mclareni Exp $
-*
-* $Log: xypwzb.s,v $
-* Revision 1.1.1.1 1996/03/21 17:19:59 mclareni
-* Bvsl
-*
-*
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB_QMIBMVF))
-*********************************************************************
-* SUBROUTINE XYPWZB(NW,BV,S,X,Y,T,V,W)
-*
-* Y = S*X(BV)*Y(BV)+T*V(BV)*W(BV)
-*
-*********************************************************************
-XYPWZB CSECT
-#if defined(CERNLIB_QMIBMXA)
-XYPWZB AMODE 31
-XYPWZB RMODE ANY
-#endif
- USING *,15
- STM 0,9,20(13)
-* R1 NW, R2 BV, R3 S , R4 Y , R5 X , R6 T , R7 V , R8 W
- LM 1,8,0(1)
-*
-*IN R1 NW
- L 1,0(0,1)
- LE 0,0(0,3)
- LE 2,0(0,6)
- LR 9,4
-*
- VSVMM 1
-LOOP VLVCU 1
- VLVM 2
- VLME 0,4
- VME 2,0,5
- VMEQ 4,0,2
-* FIRST PART
- VLME 6,7
- VME 8,6,8
- VMEQ 10,2,8
- VAER 12,10,4
- VSTME 12,9
- BC 2,LOOP
- VSVMM 0
- LM 0,9,20(13)
- BR 14
-*
- END
-#endif
diff --git a/src/mathlib/bvsl/bvslibm/ygesb.s b/src/mathlib/bvsl/bvslibm/ygesb.s
deleted file mode 100644
index b95659c..0000000
--- a/src/mathlib/bvsl/bvslibm/ygesb.s
+++ /dev/null
@@ -1,59 +0,0 @@
-*
-* $Id: ygesb.s,v 1.1.1.1 1996/03/21 17:19:57 mclareni Exp $
-*
-* $Log: ygesb.s,v $
-* Revision 1.1.1.1 1996/03/21 17:19:57 mclareni
-* Bvsl
-*
-*
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB_QMIBMVF))
-*CMZ : 04/05/90 16.17.26 by Michel Roethlisberger/IBM
-*-- Author :
-*********************************************************************
-* SUBROUTINE YGESB(NW,AIN,ISTR,ATEST,INDEX,IFOUND)
-*
-*
-*
-*********************************************************************
-YGESB CSECT
-#if defined(CERNLIB_QMIBMXA)
-YGESB AMODE 31
-YGESB RMODE ANY
-#endif
- USING *,15
- STM 0,9,20(13)
-* R2 AIN, R3 ISRT, R4 ATEST, R5 INDEX, R6 IFOUND
- LM 1,5,0(1)
-*
-*IN R1 NW - IN R3 ISTR - IN R4 ITEST
- L 8,0(0,1)
- LE 4,0(0,3)
-* TEST ON VECTOR SIZE IF VS LE 128 NO SECTIONING
- LA 1,128
- SR 1,8
- BC 2,NOSECT
-*
- LA 7,1
- SR 9,9
-LOOP VLVCU 8
- VCES 12,4,2(0)
- VCOVM 9
- VSTVM 4
- LTR 8,8
- BC 2,LOOP
- ST 9,0(5)
- LM 0,9,20(13)
- BR 14
-*
-NOSECT VLVCA 0(8)
- LA 7,1
- SR 9,9
-*
- VCES 12,4,2(0)
- VCOVM 9
- VSTVM 4
- ST 9,0(5)
- LM 0,9,20(13)
- BR 14
- END
-#endif
diff --git a/src/mathlib/bvsl/bvslibm/ygtsb.s b/src/mathlib/bvsl/bvslibm/ygtsb.s
deleted file mode 100644
index 5bd78cc..0000000
--- a/src/mathlib/bvsl/bvslibm/ygtsb.s
+++ /dev/null
@@ -1,59 +0,0 @@
-*
-* $Id: ygtsb.s,v 1.1.1.1 1996/03/21 17:19:57 mclareni Exp $
-*
-* $Log: ygtsb.s,v $
-* Revision 1.1.1.1 1996/03/21 17:19:57 mclareni
-* Bvsl
-*
-*
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB_QMIBMVF))
-*CMZ : 04/05/90 16.17.26 by Michel Roethlisberger/IBM
-*-- Author :
-*********************************************************************
-* SUBROUTINE YGTSB(NW,AIN,ATEST,INDEX,IFOUND)
-*
-*
-*
-*********************************************************************
-YGTSB CSECT
-#if defined(CERNLIB_QMIBMXA)
-YGTSB AMODE 31
-YGTSB RMODE ANY
-#endif
- USING *,15
- STM 0,9,20(13)
-* R2 AIN, R3 ISRT, R4 ATEST, R5 INDEX, R6 IFOUND
- LM 1,5,0(1)
-*
-*IN R1 NW - IN R3 ISTR - IN R4 ITEST
- L 8,0(0,1)
- LE 4,0(0,3)
-* TEST ON VECTOR SIZE IF VS LE 128 NO SECTIONING
- LA 1,128
- SR 1,8
- BC 2,NOSECT
-*
- LA 7,1
- SR 9,9
-LOOP VLVCU 8
- VCES 4,4,2(0)
- VCOVM 9
- VSTVM 4
- LTR 8,8
- BC 2,LOOP
- ST 9,0(5)
- LM 0,9,20(13)
- BR 14
-*
-NOSECT VLVCA 0(8)
- LA 7,1
- SR 9,9
-*
- VCES 4,4,2(0)
- VCOVM 9
- VSTVM 4
- ST 9,0(5)
- LM 0,9,20(13)
- BR 14
- END
-#endif
diff --git a/src/mathlib/bvsl/bvslibm/ylesb.s b/src/mathlib/bvsl/bvslibm/ylesb.s
deleted file mode 100644
index 193ef97..0000000
--- a/src/mathlib/bvsl/bvslibm/ylesb.s
+++ /dev/null
@@ -1,59 +0,0 @@
-*
-* $Id: ylesb.s,v 1.1.1.1 1996/03/21 17:19:57 mclareni Exp $
-*
-* $Log: ylesb.s,v $
-* Revision 1.1.1.1 1996/03/21 17:19:57 mclareni
-* Bvsl
-*
-*
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB_QMIBMVF))
-*CMZ : 04/05/90 16.17.26 by Michel Roethlisberger/IBM
-*-- Author :
-*********************************************************************
-* SUBROUTINE YLESB(NW,AIN,ISTR,ATEST,INDEX,IFOUND)
-*
-*
-*
-*********************************************************************
-YLESB CSECT
-#if defined(CERNLIB_QMIBMXA)
-YLESB AMODE 31
-YLESB RMODE ANY
-#endif
- USING *,15
- STM 0,9,20(13)
-* R2 AIN, R3 ISRT, R4 ATEST, R5 INDEX, R6 IFOUND
- LM 1,5,0(1)
-*
-*IN R1 NW - IN R3 ISTR - IN R4 ITEST
- L 8,0(0,1)
- LE 4,0(0,3)
-* TEST ON VECTOR SIZE IF VS LE 128 NO SECTIONING
- LA 1,128
- SR 1,8
- BC 2,NOSECT
-*
- LA 7,1
- SR 9,9
-LOOP VLVCU 8
- VCES 10,4,2(0)
- VCOVM 9
- VSTVM 4
- LTR 8,8
- BC 2,LOOP
- ST 9,0(5)
- LM 0,9,20(13)
- BR 14
-*
-NOSECT VLVCA 0(8)
- LA 7,1
- SR 9,9
-*
- VCES 10,4,2(0)
- VCOVM 9
- VSTVM 4
- ST 9,0(5)
- LM 0,9,20(13)
- BR 14
- END
-#endif
diff --git a/src/mathlib/bvsl/bvslibm/ylosb.s b/src/mathlib/bvsl/bvslibm/ylosb.s
deleted file mode 100644
index 866b9ff..0000000
--- a/src/mathlib/bvsl/bvslibm/ylosb.s
+++ /dev/null
@@ -1,261 +0,0 @@
-*
-* $Id: ylosb.s,v 1.1.1.1 1996/03/21 17:19:57 mclareni Exp $
-*
-* $Log: ylosb.s,v $
-* Revision 1.1.1.1 1996/03/21 17:19:57 mclareni
-* Bvsl
-*
-*
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB_QMIBMVF))
-* SUBROUTINE YLOSB(NW,Y,S,BV,IFOUND,'LO')
-*
-*
-*
-*********************************************************************
-YLOSB CSECT
-#if defined(CERNLIB_QMIBMXA)
-YLOSB AMODE 31
-YLOSB RMODE ANY
-#endif
-#include "cachesz.inc"
- USING *,15
- STM 1,8,24(13)
-* R1 NW
- LM 1,6,0(1)
- L 1,0(0,1)
-*
- LH 6,0(0,6)
- LA 7,CENTRO
- LH 7,0(0,7)
- CR 6,7
- BC 4,MIN0
-*
-* RESULT 1 > CENTRO
-*
- LA 7,LT
- LH 7,0(0,7)
- CR 6,7
- BC 4,MAX1
-* RESULT 1 > = LT
- BC 8,MAX2
-* RESULT 1 NE LT END WITH NE
-*********************************************************************
-* SUBROUTINE YNESB(NW,IN,ITEST,INDEX,IFOUND)
-*
-*
-*********************************************************************
-*
-*IN R1 NW - IN R3 ISTR - IN R4 ITEST
- LE 4,0(0,3)
-* TEST ON VECTOR SIZE IF VS LE 'SZ' NO SECTIONING
- LA 7,SZ
- SR 7,1
- BC 2,NOSNE
-*
- SR 8,8
-LOONE VLVCU 1
- VCES 6,4,2(0)
- VCOVM 8
- VSTVM 4
- LTR 1,1
- BC 2,LOONE
- ST 8,0(5)
- LM 1,8,24(13)
- BR 14
-*
-NOSNE VLVCA 0(1)
- SR 8,8
-*
- VCES 6,4,2(0)
- VCOVM 8
- VSTVM 4
- ST 8,0(5)
- LM 1,8,24(13)
- BR 14
-*********************************************************************
-* RESULT 1 = LT END WITH LT
-*********************************************************************
-* SUBROUTINE YLTSB(NW,Y,S,INDB,IFOUND)
-*
-*********************************************************************
-*
-MAX2 LE 4,0(0,3)
-* TEST ON VECTOR SIZE IF VS LE 'SZ' NO SECTIONING
- LA 7,SZ
- SR 7,1
- BC 2,NOSLT
-*
- SR 8,8
-LOOLT VLVCU 1
- VCES 2,4,2(0)
- VCOVM 8
- VSTVM 4
- LTR 1,1
- BC 2,LOOLT
- ST 8,0(5)
- LM 1,8,24(13)
- BR 14
-*
-NOSLT VLVCA 0(1)
- SR 8,8
-*
- VCES 2,4,2(0)
- VCOVM 8
- VSTVM 4
- ST 8,0(5)
- LM 1,8,24(13)
- BR 14
-*********************************************************************
-* RESULT 1 > LT END WITH LE
-*********************************************************************
-* SUBROUTINE YLESB(NW,AIN,ISTR,ATEST,INDEX,IFOUND)
-*
-*
-*********************************************************************
-MAX1 LE 4,0(0,3)
-* TEST ON VECTOR SIZE IF VS LE 'SZ' NO SECTIONING
- LA 7,SZ
- SR 7,1
- BC 2,NOSLE
-*
- SR 8,8
-LOOLE VLVCU 1
- VCES 10,4,2(0)
- VCOVM 8
- VSTVM 4
- LTR 1,1
- BC 2,LOOLE
- ST 8,0(5)
- LM 1,8,24(13)
- BR 14
-*
-NOSLE VLVCA 0(1)
- SR 8,8
-*
- VCES 10,4,2(0)
- VCOVM 8
- VSTVM 4
- ST 8,0(5)
- LM 1,8,24(13)
- BR 14
-*********************************************************************
-* RESULT 1 < CENTRO
-MIN0 LA 7,GE
- LH 7,0(0,7)
- CR 6,7
- BC 4,MIN1
-* RESULT 1 > = GE
- BC 8,MIN2
-* RESULT 1 NE GE END WITH GT
-*********************************************************************
-* SUBROUTINE YGTSB(NW,AIN,ATEST,INDEX,IFOUND)
-*
-*
-*
-*********************************************************************
- LE 4,0(0,3)
-* TEST ON VECTOR SIZE IF VS LE 'SZ' NO SECTIONING
- LA 7,SZ
- SR 7,1
- BC 2,NOSGT
-*
- SR 8,8
-LOOGT VLVCU 1
- VCES 4,4,2(0)
- VCOVM 8
- VSTVM 4
- LTR 1,1
- BC 2,LOOGT
- ST 8,0(5)
- LM 1,8,24(13)
- BR 14
-*
-NOSGT VLVCA 0(1)
- SR 8,8
-*
- VCES 4,4,2(0)
- VCOVM 8
- VSTVM 4
- ST 8,0(5)
- LM 1,8,24(13)
- BR 14
-********************************************************************
-* RESULT 1 = GE END WITH GE
-*********************************************************************
-* SUBROUTINE YGESB(NW,AIN,ISTR,ATEST,INDEX,IFOUND)
-*
-*
-*********************************************************************
-*
-*IN R1 NW - IN R3 ISTR - IN R4 ITEST
-MIN2 LE 4,0(0,3)
-* TEST ON VECTOR SIZE IF VS LE 'SZ' NO SECTIONING
- LA 7,SZ
- SR 7,1
- BC 2,NOSGE
-*
- SR 8,8
-LOOGE VLVCU 1
- VCES 12,4,2(0)
- VCOVM 8
- VSTVM 4
- LTR 1,1
- BC 2,LOOGE
- ST 8,0(5)
- LM 1,8,24(13)
- BR 14
-*
-NOSGE VLVCA 0(1)
- SR 8,8
-*
- VCES 12,4,2(0)
- VCOVM 8
- VSTVM 4
- ST 8,0(5)
- LM 1,8,24(13)
- BR 14
-*********************************************************************
-* END WITH EQ
-*********************************************************************
-* SUBROUTINE YEQSB(NW,IN,ITEST,INDEX,IFOUND)
-*
-*
-*********************************************************************
-MIN1 LE 4,0(0,3)
-* TEST ON VECTOR SIZE IF VS LE 'SZ' NO SECTIONING
- LA 7,SZ
- SR 7,1
- BC 2,NOSEQ
-*
- SR 8,8
-LOOEQ VLVCU 1
- VCES 8,4,2(0)
- VCOVM 8
- VSTVM 4
- LTR 1,1
- BC 2,LOOEQ
- ST 8,0(5)
- LM 1,8,24(13)
- BR 14
-*
-NOSEQ VLVCA 0(1)
- SR 8,8
-*
- VCES 8,4,2(0)
- VCOVM 8
- VSTVM 4
- ST 8,0(5)
- LM 1,8,24(13)
- BR 14
-*********************************************************************
-********************************************************************
-EQ DC XL2'C5D8'
-GE DC XL2'C7C5'
-GT DC XL2'C7E3'
-CENTRO DC XL2'CCCC'
-LE DC XL2'D3C5'
-LT DC XL2'D3E3'
-NE DC XL2'D5C5'
-*
- END
-#endif
diff --git a/src/mathlib/bvsl/bvslibm/yloxb.s b/src/mathlib/bvsl/bvslibm/yloxb.s
deleted file mode 100644
index 6b0ef67..0000000
--- a/src/mathlib/bvsl/bvslibm/yloxb.s
+++ /dev/null
@@ -1,267 +0,0 @@
-*
-* $Id: yloxb.s,v 1.1.1.1 1996/03/21 17:19:57 mclareni Exp $
-*
-* $Log: yloxb.s,v $
-* Revision 1.1.1.1 1996/03/21 17:19:57 mclareni
-* Bvsl
-*
-*
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB_QMIBMVF))
-* SUBROUTINE YLOXB(NW,Y,X,BV,IFOUND,'LO')
-*
-*
-*
-*********************************************************************
-YLOXB CSECT
-#if defined(CERNLIB_QMIBMXA)
-YLOXB AMODE 31
-YLOXB RMODE ANY
-#endif
-#include "cachesz.inc"
- USING *,15
- STM 1,8,24(13)
-* R1 NW
- LM 1,6,0(1)
- L 1,0(0,1)
-*
- LH 6,0(0,6)
- LA 7,CENTRO
- LH 7,0(0,7)
- CR 6,7
- BC 4,MIN0
-*
-* RESULT 1 > CENTRO
-*
- LA 7,LT
- LH 7,0(0,7)
- CR 6,7
- BC 4,MAX1
-* RESULT 1 > = LT
- BC 8,MAX2
-* RESULT 1 NE LT END WITH NE
-*********************************************************************
-* SUBROUTINE YNEXB(NW,IN,ITEST,INDEX,IFOUND)
-*
-*
-*********************************************************************
-*
-*IN R1 NW - IN R3 ISTR - IN R4 ITEST
-* TEST ON VECTOR SIZE IF VS LE 'SZ' NO SECTIONING
- LA 7,SZ
- SR 7,1
- BC 2,NOSNE
-*
- SR 8,8
-LOONE VLVCU 1
- VLE 4,3
- VCE 6,4,2(0)
- VCOVM 8
- VSTVM 4
- LTR 1,1
- BC 2,LOONE
- ST 8,0(5)
- LM 1,8,24(13)
- BR 14
-*
-NOSNE VLVCA 0(1)
- SR 8,8
-*
- VLE 4,3
- VCE 6,4,2(0)
- VCOVM 8
- VSTVM 4
- ST 8,0(5)
- LM 1,8,24(13)
- BR 14
-*********************************************************************
-* RESULT 1 = LT END WITH LT
-*********************************************************************
-* SUBROUTINE YLTSB(NW,Y,S,INDB,IFOUND)
-*
-*********************************************************************
-*
-* TEST ON VECTOR SIZE IF VS LE 'SZ' NO SECTIONING
-MAX2 LA 7,SZ
- SR 7,1
- BC 2,NOSLT
-*
- SR 8,8
-LOOLT VLVCU 1
- VLE 4,3
- VCE 2,4,2(0)
- VCOVM 8
- VSTVM 4
- LTR 1,1
- BC 2,LOOLT
- ST 8,0(5)
- LM 1,8,24(13)
- BR 14
-*
-NOSLT VLVCA 0(1)
- SR 8,8
-*
- VLE 4,3
- VCE 2,4,2(0)
- VCOVM 8
- VSTVM 4
- ST 8,0(5)
- LM 1,8,24(13)
- BR 14
-*********************************************************************
-* RESULT 1 > LT END WITH LE
-*********************************************************************
-* SUBROUTINE YLESB(NW,AIN,ISTR,ATEST,INDEX,IFOUND)
-*
-*
-*********************************************************************
-* TEST ON VECTOR SIZE IF VS LE 'SZ' NO SECTIONING
-MAX1 LA 7,SZ
- SR 7,1
- BC 2,NOSLE
-*
- SR 8,8
-LOOLE VLVCU 1
- VLE 4,3
- VCE 10,4,2(0)
- VCOVM 8
- VSTVM 4
- LTR 1,1
- BC 2,LOOLE
- ST 8,0(5)
- LM 1,8,24(13)
- BR 14
-*
-NOSLE VLVCA 0(1)
- SR 8,8
-*
- VLE 4,3
- VCE 10,4,2(0)
- VCOVM 8
- VSTVM 4
- ST 8,0(5)
- LM 1,8,24(13)
- BR 14
-*********************************************************************
-* RESULT 1 < CENTRO
-MIN0 LA 7,GE
- LH 7,0(0,7)
- CR 6,7
- BC 4,MIN1
-* RESULT 1 > = GE
- BC 8,MIN2
-* RESULT 1 NE GE END WITH GT
-*********************************************************************
-* SUBROUTINE YGTSB(NW,AIN,ATEST,INDEX,IFOUND)
-*
-*
-*
-*********************************************************************
-* TEST ON VECTOR SIZE IF VS LE 'SZ' NO SECTIONING
- LA 7,SZ
- SR 7,1
- BC 2,NOSGT
-*
- SR 8,8
-LOOGT VLVCU 1
- VLE 4,3
- VCE 4,4,2(0)
- VCOVM 8
- VSTVM 4
- LTR 1,1
- BC 2,LOOGT
- ST 8,0(5)
- LM 1,8,24(13)
- BR 14
-*
-NOSGT VLVCA 0(1)
- SR 8,8
-*
- VLE 4,3
- VCE 4,4,2(0)
- VCOVM 8
- VSTVM 4
- ST 8,0(5)
- LM 1,8,24(13)
- BR 14
-********************************************************************
-* RESULT 1 = GE END WITH GE
-*********************************************************************
-* SUBROUTINE YGESB(NW,AIN,ISTR,ATEST,INDEX,IFOUND)
-*
-*
-*********************************************************************
-*
-*IN R1 NW - IN R3 ISTR - IN R4 ITEST
-* TEST ON VECTOR SIZE IF VS LE 'SZ' NO SECTIONING
-MIN2 LA 7,SZ
- SR 7,1
- BC 2,NOSGE
-*
- SR 8,8
-LOOGE VLVCU 1
- VLE 4,3
- VCE 12,4,2(0)
- VCOVM 8
- VSTVM 4
- LTR 1,1
- BC 2,LOOGE
- ST 8,0(5)
- LM 1,8,24(13)
- BR 14
-*
-NOSGE VLVCA 0(1)
- SR 8,8
-*
- VLE 4,3
- VCE 12,4,2(0)
- VCOVM 8
- VSTVM 4
- ST 8,0(5)
- LM 1,8,24(13)
- BR 14
-*********************************************************************
-* END WITH EQ
-*********************************************************************
-* SUBROUTINE YEQSB(NW,IN,ITEST,INDEX,IFOUND)
-*
-*
-*********************************************************************
-* TEST ON VECTOR SIZE IF VS LE 'SZ' NO SECTIONING
-MIN1 LA 7,SZ
- SR 7,1
- BC 2,NOSEQ
-*
- SR 8,8
-LOOEQ VLVCU 1
- VLE 4,3
- VCE 8,4,2(0)
- VCOVM 8
- VSTVM 4
- LTR 1,1
- BC 2,LOOEQ
- ST 8,0(5)
- LM 1,8,24(13)
- BR 14
-*
-NOSEQ VLVCA 0(1)
- SR 8,8
-*
- VLE 4,3
- VCE 8,4,2(0)
- VCOVM 8
- VSTVM 4
- ST 8,0(5)
- LM 1,8,24(13)
- BR 14
-*********************************************************************
-********************************************************************
-EQ DC XL2'C5D8'
-GE DC XL2'C7C5'
-GT DC XL2'C7E3'
-CENTRO DC XL2'CCCC'
-LE DC XL2'D3C5'
-LT DC XL2'D3E3'
-NE DC XL2'D5C5'
-*
- END
-#endif
diff --git a/src/mathlib/bvsl/bvslibm/ylysb.s b/src/mathlib/bvsl/bvslibm/ylysb.s
deleted file mode 100644
index a45208a..0000000
--- a/src/mathlib/bvsl/bvslibm/ylysb.s
+++ /dev/null
@@ -1,59 +0,0 @@
-*
-* $Id: ylysb.s,v 1.1.1.1 1996/03/21 17:19:57 mclareni Exp $
-*
-* $Log: ylysb.s,v $
-* Revision 1.1.1.1 1996/03/21 17:19:57 mclareni
-* Bvsl
-*
-*
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB_QMIBMVF))
-*CMZ : 04/05/90 16.17.26 by Michel Roethlisberger/IBM
-*-- Author :
-*********************************************************************
-* SUBROUTINE YLTSB(NW,AIN,ISTR,ATEST,INDEX,IFOUND)
-*
-*
-*
-*********************************************************************
-YLTSB CSECT
-#if defined(CERNLIB_QMIBMXA)
-YLTSB AMODE 31
-YLTSB RMODE ANY
-#endif
- USING *,15
- STM 0,9,20(13)
-* R2 AIN, R4 ATEST, R5 INDEX, R6 IFOUND
- LM 1,5,0(1)
-*
-*IN R1 NW - IN R3 ISTR - IN R4 ITEST
- L 8,0(0,1)
- LE 4,0(0,3)
-* TEST ON VECTOR SIZE IF VS LE 128 NO SECTIONING
- LA 1,128
- SR 1,8
- BC 2,NOSECT
-*
- LA 7,1
- SR 9,9
-LOOP VLVCU 8
- VCES 2,4,2(0)
- VCOVM 9
- VSTVM 4
- LTR 8,8
- BC 2,LOOP
- ST 9,0(5)
- LM 0,9,20(13)
- BR 14
-*
-NOSECT VLVCA 0(8)
- LA 7,1
- SR 9,9
-*
- VCES 2,4,2(0)
- VCOVM 9
- VSTVM 4
- ST 9,0(5)
- LM 0,9,20(13)
- BR 14
- END
-#endif
diff --git a/src/mathlib/bvsl/bvslibm/ynesb.s b/src/mathlib/bvsl/bvslibm/ynesb.s
deleted file mode 100644
index b642876..0000000
--- a/src/mathlib/bvsl/bvslibm/ynesb.s
+++ /dev/null
@@ -1,59 +0,0 @@
-*
-* $Id: ynesb.s,v 1.1.1.1 1996/03/21 17:19:57 mclareni Exp $
-*
-* $Log: ynesb.s,v $
-* Revision 1.1.1.1 1996/03/21 17:19:57 mclareni
-* Bvsl
-*
-*
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB_QMIBMVF))
-*CMZ : 04/05/90 16.17.26 by Michel Roethlisberger/IBM
-*-- Author :
-*********************************************************************
-* SUBROUTINE YNESB(NW,IN,ITEST,INDEX,IFOUND)
-*
-*
-*
-*********************************************************************
-YNESB CSECT
-#if defined(CERNLIB_QMIBMXA)
-YNESB AMODE 31
-YNESB RMODE ANY
-#endif
- USING *,15
- STM 0,9,20(13)
-* R2 IN, R3 ITEST, R4 INDEX, R5 IFOUND
- LM 1,5,0(1)
-*
-*IN R1 NW - IN R3 ISTR - IN R4 ITEST
- L 8,0(0,1)
- L 3,0(0,3)
-* TEST ON VECTOR SIZE IF VS LE 128 NO SECTIONING
- LA 1,128
- SR 1,8
- BC 2,NOSECT
-*
- LA 7,1
- SR 9,9
-LOOP VLVCU 8
- VCS 6,3,2(0)
- VCOVM 9
- VSTVM 4
- LTR 8,8
- BC 2,LOOP
- ST 9,0(5)
- LM 0,9,20(13)
- BR 14
-*
-NOSECT VLVCA 0(8)
- LA 7,1
- SR 9,9
-*
- VCS 6,3,2(0)
- VCOVM 9
- VSTVM 4
- ST 9,0(5)
- LM 0,9,20(13)
- BR 14
- END
-#endif
diff --git a/src/mathlib/bvsl/bvslibm/zerob.s b/src/mathlib/bvsl/bvslibm/zerob.s
deleted file mode 100644
index 821637d..0000000
--- a/src/mathlib/bvsl/bvslibm/zerob.s
+++ /dev/null
@@ -1,38 +0,0 @@
-*
-* $Id: zerob.s,v 1.1.1.1 1996/03/21 17:19:58 mclareni Exp $
-*
-* $Log: zerob.s,v $
-* Revision 1.1.1.1 1996/03/21 17:19:58 mclareni
-* Bvsl
-*
-*
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB_QMIBMVF))
-*********************************************************************
-* SUBROUTINE ZEROB(NW,BV)
-* SET TO 0 THE BV
-*********************************************************************
-ZEROB CSECT
-#if defined(CERNLIB_QMIBMXA)
-ZEROB AMODE 31
-ZEROB RMODE ANY
-#endif
- USING *,15
- STM 1,3,24(13)
-* R2 IN, R3 ISRT, R4 ITEST, R5 INDEX, R6 IFOUND
- LM 1,2,0(1)
-*
-*IN R1 NW
- L 1,0(0,1)
- LA 3,ZERO
-*
- VLVCU 1
- VLVM 3
-LOOP VLVCU 1
- VSTVM 2
- BC 2,LOOP
- LM 1,3,24(13)
- BR 14
-ZERO DC XL16'00000000000000000000000000000000'
-*
- END
-#endif
diff --git a/src/mathlib/bvsl/history/v100.dat b/src/mathlib/bvsl/history/v100.dat
deleted file mode 100644
index d8b50b2..0000000
--- a/src/mathlib/bvsl/history/v100.dat
+++ /dev/null
@@ -1,11 +0,0 @@
-*
-* $Id: v100.dat,v 1.1.1.1 1996/03/21 17:19:54 mclareni Exp $
-*
-* $Log: v100.dat,v $
-* Revision 1.1.1.1 1996/03/21 17:19:54 mclareni
-* Bvsl
-*
-*
-* Version 1.00 891221 12.40
-C- First release
-C
diff --git a/src/mathlib/bvsl/history/v101.dat b/src/mathlib/bvsl/history/v101.dat
deleted file mode 100644
index cbefb40..0000000
--- a/src/mathlib/bvsl/history/v101.dat
+++ /dev/null
@@ -1,9 +0,0 @@
-*
-* $Id: v101.dat,v 1.1.1.1 1996/03/21 17:19:54 mclareni Exp $
-*
-* $Log: v101.dat,v $
-* Revision 1.1.1.1 1996/03/21 17:19:54 mclareni
-* Bvsl
-*
-*
-* Version 1.01 900405 18.22
diff --git a/src/mathlib/bvsl/history/v102.dat b/src/mathlib/bvsl/history/v102.dat
deleted file mode 100644
index db1b567..0000000
--- a/src/mathlib/bvsl/history/v102.dat
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: v102.dat,v 1.1.1.1 1996/03/21 17:19:54 mclareni Exp $
-*
-* $Log: v102.dat,v $
-* Revision 1.1.1.1 1996/03/21 17:19:54 mclareni
-* Bvsl
-*
-*
-* Version 1.02 901113 23.30
-C- Introduce the following patches/flags:
-C > DBVSL : documentation patch
-C
-C- Additions/modifications
-C > P=*BVSLEX deleted
-C > P=EQUDEF moved into P=BVSLIBM
-C > P=BVSLFTN added. FORTRAN-compatible version
-C > P=BVSLIBM ,D=ONEB-SMOD3B added
-C > P=BVSLEX renamed to P=BVSLTEST,add tests for new routines
diff --git a/src/mathlib/bvsl/history/v103.dat b/src/mathlib/bvsl/history/v103.dat
deleted file mode 100644
index b9a12c4..0000000
--- a/src/mathlib/bvsl/history/v103.dat
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: v103.dat,v 1.1.1.1 1996/03/21 17:19:54 mclareni Exp $
-*
-* $Log: v103.dat,v $
-* Revision 1.1.1.1 1996/03/21 17:19:54 mclareni
-* Bvsl
-*
-*
-* Version 1.03 920307 14.30
-C- Additions/modifications
-C > P=*BVSL Do not activate QMIBMVF on IBM by default
-C > P=BVSLIBM ,D=DDOTB correct deck and comment header name
-C > P=BVSLIBM ,D= Add sequence CACHESZ
-C
-C- Introduce the following patches/flags:
-C > IBMMVS,IBMVM,VAXVMS,VAXULX,HPUX,MIPS,NECSX
-C
-C- Modify all routines using DOUBLE PRECISION arithmetics to accept
-C SINGLE (as Cray)
-C
diff --git a/src/mathlib/bvsl/history/v104.dat b/src/mathlib/bvsl/history/v104.dat
deleted file mode 100644
index 2781d99..0000000
--- a/src/mathlib/bvsl/history/v104.dat
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: v104.dat,v 1.1.1.1 1996/03/21 17:19:53 mclareni Exp $
-*
-* $Log: v104.dat,v $
-* Revision 1.1.1.1 1996/03/21 17:19:53 mclareni
-* Bvsl
-*
-*
-* Version 1.04 920719 23.00
-C- Introduce the following patches/flags:
-C > IPSC, MSDOS
-C
diff --git a/src/mathlib/bvsl/history/v105.dat b/src/mathlib/bvsl/history/v105.dat
deleted file mode 100644
index f89b83f..0000000
--- a/src/mathlib/bvsl/history/v105.dat
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: v105.dat,v 1.1.1.1 1996/03/21 17:19:53 mclareni Exp $
-*
-* $Log: v105.dat,v $
-* Revision 1.1.1.1 1996/03/21 17:19:53 mclareni
-* Bvsl
-*
-*
-* Version 1.05 930902 11.30
-C- Introduce the following patches/flags:
-C > NEXT, LINUX
-C
diff --git a/src/mathlib/bvsl/history/v106.dat b/src/mathlib/bvsl/history/v106.dat
deleted file mode 100644
index ea758c0..0000000
--- a/src/mathlib/bvsl/history/v106.dat
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: v106.dat,v 1.1.1.1 1996/03/21 17:19:53 mclareni Exp $
-*
-* $Log: v106.dat,v $
-* Revision 1.1.1.1 1996/03/21 17:19:53 mclareni
-* Bvsl
-*
-*
-* Version 1.06 940207 10.58
-C- Introduce the following patches/flags:
-C > WINNT for Windows/NT operating system
-C
diff --git a/src/mathlib/bvsl/test/Imakefile b/src/mathlib/bvsl/test/Imakefile
deleted file mode 100644
index 9330314..0000000
--- a/src/mathlib/bvsl/test/Imakefile
+++ /dev/null
@@ -1,12 +0,0 @@
-SRCS_F= copy.F dot.F intg.F iyeqx.F iygex.F iygtx.F iylex.F \ @@\
- iyltx.F iynex.F scal.F smod3.F sxpy.F sxy.F vset.F \ @@\
- vxpy.F xypwz.F yeqx.F ygex.F ygtx.F ylex.F yltx.F ynex.F
-
-SubdirLibraryTarget(bvsltst,NullParameter)
-
-DefinePackageLibrary(bvsltst)
-
-CernlibFortranProgramTarget(bvslt,tsbvsl.o,$(PACKAGE_LIB),$(PACKAGE_LIB),mathlib kernlib)
-
-TestTarget(bvslt,NullParameter,NullParameter)
-
diff --git a/src/mathlib/bvsl/test/copy.F b/src/mathlib/bvsl/test/copy.F
deleted file mode 100644
index 6d89c82..0000000
--- a/src/mathlib/bvsl/test/copy.F
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: copy.F,v 1.1.1.1 1996/03/21 17:19:54 mclareni Exp $
-*
-* $Log: copy.F,v $
-* Revision 1.1.1.1 1996/03/21 17:19:54 mclareni
-* Bvsl
-*
-*
-*CMZ : 06/11/90 10.43.59 by Michel Roethlisberger/IBM
-*-- Author :
-*********************************************************************
-*CMZ : 04/05/90 16.17.27 by Michel Roethlisberger/IBM
-*-- Author :
- SUBROUTINE COPY(NW,IV,Y,X)
- DIMENSION X(*),Y(*),IV(*)
- DO I=1,NW
- Y(IV(I)) = X(IV(I))
- ENDDO
- RETURN
- END
diff --git a/src/mathlib/bvsl/test/dot.F b/src/mathlib/bvsl/test/dot.F
deleted file mode 100644
index da234a3..0000000
--- a/src/mathlib/bvsl/test/dot.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: dot.F,v 1.1.1.1 1996/03/21 17:19:54 mclareni Exp $
-*
-* $Log: dot.F,v $
-* Revision 1.1.1.1 1996/03/21 17:19:54 mclareni
-* Bvsl
-*
-*
-*CMZ : 06/11/90 10.43.59 by Michel Roethlisberger/IBM
-*-- Author :
-* Last modif.: 6 Nov 1990 at 09:52:11
-C Last modif.: 6 Nov 1990 at 09:08:34
- FUNCTION DOT(NW,IV,Y,X)
- DIMENSION X(500),Y(500),IV(500)
- TEM= 0.0
- DO I=1,NW
- TEM = TEM + Y(IV(I))*X(IV(I))
- ENDDO
- DOT = TEM
- RETURN
- END
diff --git a/src/mathlib/bvsl/test/intg.F b/src/mathlib/bvsl/test/intg.F
deleted file mode 100644
index 5eee151..0000000
--- a/src/mathlib/bvsl/test/intg.F
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: intg.F,v 1.1.1.1 1996/03/21 17:19:54 mclareni Exp $
-*
-* $Log: intg.F,v $
-* Revision 1.1.1.1 1996/03/21 17:19:54 mclareni
-* Bvsl
-*
-*
-*CMZ : 06/11/90 10.43.59 by Michel Roethlisberger/IBM
-*-- Author :
-*********************************************************************
-*CMZ : 04/05/90 16.17.27 by Michel Roethlisberger/IBM
-*-- Author :
- SUBROUTINE INTG(NW,AIN,UVEC,ALVEC,IV,IFOUND)
- DIMENSION AIN(*), UVEC(*),ALVEC(*),IV(*)
- IFOUND=0
- DO I=1,NW
- IF(AIN(I).LT.UVEC(I).AND.AIN(I).GT.ALVEC(I))THEN
- IFOUND=IFOUND+1
- IV(IFOUND)=I
- ENDIF
- ENDDO
- RETURN
- END
diff --git a/src/mathlib/bvsl/test/iyeqx.F b/src/mathlib/bvsl/test/iyeqx.F
deleted file mode 100644
index 4d601e9..0000000
--- a/src/mathlib/bvsl/test/iyeqx.F
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: iyeqx.F,v 1.1.1.1 1996/03/21 17:19:54 mclareni Exp $
-*
-* $Log: iyeqx.F,v $
-* Revision 1.1.1.1 1996/03/21 17:19:54 mclareni
-* Bvsl
-*
-*
-*CMZ : 06/11/90 10.44.00 by Michel Roethlisberger/IBM
-*-- Author :
-*********************************************************************
-*CMZ : 04/05/90 16.17.28 by Michel Roethlisberger/IBM
-*-- Author :
- SUBROUTINE IYEQX(ILENG,IVEC,IX,IY,NFOUND)
- DIMENSION IVEC(*),IX(*),IY(*)
-C
- NFOUND = 0
- DO J=1,ILENG
- IF(IVEC(J).EQ.IX(J)) THEN
- NFOUND = NFOUND+1
- IY(NFOUND) = J
- END IF
- ENDDO
- RETURN
- END
diff --git a/src/mathlib/bvsl/test/iygex.F b/src/mathlib/bvsl/test/iygex.F
deleted file mode 100644
index aa54c5b..0000000
--- a/src/mathlib/bvsl/test/iygex.F
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: iygex.F,v 1.1.1.1 1996/03/21 17:19:55 mclareni Exp $
-*
-* $Log: iygex.F,v $
-* Revision 1.1.1.1 1996/03/21 17:19:55 mclareni
-* Bvsl
-*
-*
-*CMZ : 06/11/90 10.44.00 by Michel Roethlisberger/IBM
-*-- Author :
-*********************************************************************
-*CMZ : 04/05/90 16.17.28 by Michel Roethlisberger/IBM
-*-- Author :
- SUBROUTINE IYGEX(ILENG,IVEC,IX,IY,NFOUND)
- DIMENSION IVEC(*),IX(*),IY(*)
-C
- NFOUND = 0
- DO J=1,ILENG
- IF(IVEC(J).GE.IX(J)) THEN
- NFOUND = NFOUND+1
- IY(NFOUND) = J
- END IF
- ENDDO
- RETURN
- END
diff --git a/src/mathlib/bvsl/test/iygtx.F b/src/mathlib/bvsl/test/iygtx.F
deleted file mode 100644
index fe775c1..0000000
--- a/src/mathlib/bvsl/test/iygtx.F
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: iygtx.F,v 1.1.1.1 1996/03/21 17:19:54 mclareni Exp $
-*
-* $Log: iygtx.F,v $
-* Revision 1.1.1.1 1996/03/21 17:19:54 mclareni
-* Bvsl
-*
-*
-*CMZ : 06/11/90 10.44.00 by Michel Roethlisberger/IBM
-*-- Author :
-*********************************************************************
-*CMZ : 04/05/90 16.17.28 by Michel Roethlisberger/IBM
-*-- Author :
- SUBROUTINE IYGTX(ILENG,IVEC,IX,IY,NFOUND)
- DIMENSION IVEC(*),IX(*),IY(*)
-C
- NFOUND = 0
- DO J=1,ILENG
- IF(IVEC(J).GT.IX(J)) THEN
- NFOUND = NFOUND+1
- IY(NFOUND) = J
- END IF
- ENDDO
- RETURN
- END
diff --git a/src/mathlib/bvsl/test/iylex.F b/src/mathlib/bvsl/test/iylex.F
deleted file mode 100644
index 466106a..0000000
--- a/src/mathlib/bvsl/test/iylex.F
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: iylex.F,v 1.1.1.1 1996/03/21 17:19:55 mclareni Exp $
-*
-* $Log: iylex.F,v $
-* Revision 1.1.1.1 1996/03/21 17:19:55 mclareni
-* Bvsl
-*
-*
-*CMZ : 06/11/90 10.44.00 by Michel Roethlisberger/IBM
-*-- Author :
-*********************************************************************
-*CMZ : 04/05/90 16.17.28 by Michel Roethlisberger/IBM
-*-- Author :
- SUBROUTINE IYLEX(ILENG,IVEC,IX,IY,NFOUND)
- DIMENSION IVEC(*),IX(*),IY(*)
-C
- NFOUND = 0
- DO J=1,ILENG
- IF(IVEC(J).LE.IX(J)) THEN
- NFOUND = NFOUND+1
- IY(NFOUND) = J
- END IF
- ENDDO
- RETURN
- END
diff --git a/src/mathlib/bvsl/test/iyltx.F b/src/mathlib/bvsl/test/iyltx.F
deleted file mode 100644
index 873b6a6..0000000
--- a/src/mathlib/bvsl/test/iyltx.F
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: iyltx.F,v 1.1.1.1 1996/03/21 17:19:54 mclareni Exp $
-*
-* $Log: iyltx.F,v $
-* Revision 1.1.1.1 1996/03/21 17:19:54 mclareni
-* Bvsl
-*
-*
-*CMZ : 06/11/90 10.44.00 by Michel Roethlisberger/IBM
-*-- Author :
-*********************************************************************
-*CMZ : 04/05/90 16.17.28 by Michel Roethlisberger/IBM
-*-- Author :
- SUBROUTINE IYLTX(ILENG,IVEC,IX,IY,NFOUND)
- DIMENSION IVEC(*),IX(*),IY(*)
-C
- NFOUND = 0
- DO J=1,ILENG
- IF(IVEC(J).LT.IX(J)) THEN
- NFOUND = NFOUND+1
- IY(NFOUND) = J
- END IF
- ENDDO
- RETURN
- END
diff --git a/src/mathlib/bvsl/test/iynex.F b/src/mathlib/bvsl/test/iynex.F
deleted file mode 100644
index a79b51b..0000000
--- a/src/mathlib/bvsl/test/iynex.F
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: iynex.F,v 1.1.1.1 1996/03/21 17:19:54 mclareni Exp $
-*
-* $Log: iynex.F,v $
-* Revision 1.1.1.1 1996/03/21 17:19:54 mclareni
-* Bvsl
-*
-*
-*CMZ : 06/11/90 10.44.00 by Michel Roethlisberger/IBM
-*-- Author :
-*********************************************************************
-*CMZ : 04/05/90 16.17.28 by Michel Roethlisberger/IBM
-*-- Author :
- SUBROUTINE IYNEX(ILENG,IVEC,IX,IY,NFOUND)
- DIMENSION IVEC(*),IX(*),IY(*)
-C
- NFOUND = 0
- DO J=1,ILENG
- IF(IVEC(J).NE.IX(J)) THEN
- NFOUND = NFOUND+1
- IY(NFOUND) = J
- END IF
- ENDDO
- RETURN
- END
diff --git a/src/mathlib/bvsl/test/scal.F b/src/mathlib/bvsl/test/scal.F
deleted file mode 100644
index ebbd343..0000000
--- a/src/mathlib/bvsl/test/scal.F
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: scal.F,v 1.1.1.1 1996/03/21 17:19:54 mclareni Exp $
-*
-* $Log: scal.F,v $
-* Revision 1.1.1.1 1996/03/21 17:19:54 mclareni
-* Bvsl
-*
-*
-*CMZ : 06/11/90 10.43.59 by Michel Roethlisberger/IBM
-*-- Author :
-*********************************************************************
-*CMZ : 04/05/90 16.17.27 by Michel Roethlisberger/IBM
-*-- Author :
- SUBROUTINE SCAL(NW,IV,Y,S)
- DIMENSION IV(*),Y(*)
- DO I=1,NW
- Y(IV(I)) = S*Y(IV(I))
- ENDDO
- RETURN
- END
diff --git a/src/mathlib/bvsl/test/smod3.F b/src/mathlib/bvsl/test/smod3.F
deleted file mode 100644
index f732973..0000000
--- a/src/mathlib/bvsl/test/smod3.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: smod3.F,v 1.1.1.1 1996/03/21 17:19:55 mclareni Exp $
-*
-* $Log: smod3.F,v $
-* Revision 1.1.1.1 1996/03/21 17:19:55 mclareni
-* Bvsl
-*
-*
-*CMZ : 06/11/90 10.44.00 by Michel Roethlisberger/IBM
-*-- Author :
-*********************************************************************
-*CMZ : 04/05/90 16.17.28 by Michel Roethlisberger/IBM
-*-- Author :
- SUBROUTINE SMOD3 (ILENG,A1,A2,A3,OUT,IVEC)
- DIMENSION IVEC(*),A1(*),A2(*),A3(*),OUT(*)
- DO I = 1,ILENG
- OUT(IVEC(I)) = SQRT (A1(IVEC(I))**2+A2(IVEC(I))**2+
- . A3(IVEC(I))**2)
- ENDDO
- RETURN
- END
diff --git a/src/mathlib/bvsl/test/sxpy.F b/src/mathlib/bvsl/test/sxpy.F
deleted file mode 100644
index 8468605..0000000
--- a/src/mathlib/bvsl/test/sxpy.F
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: sxpy.F,v 1.1.1.1 1996/03/21 17:19:54 mclareni Exp $
-*
-* $Log: sxpy.F,v $
-* Revision 1.1.1.1 1996/03/21 17:19:54 mclareni
-* Bvsl
-*
-*
-*CMZ : 06/11/90 10.43.59 by Michel Roethlisberger/IBM
-*-- Author :
-*********************************************************************
-*CMZ : 04/05/90 16.17.27 by Michel Roethlisberger/IBM
-*-- Author :
- SUBROUTINE SXPY(NW,IV,Y,X,S)
- DIMENSION IV(*),X(*),Y(*)
- DO I= 1, NW
- Y(IV(I)) = S*X(IV(I))+Y(IV(I))
- ENDDO
- RETURN
- END
diff --git a/src/mathlib/bvsl/test/sxy.F b/src/mathlib/bvsl/test/sxy.F
deleted file mode 100644
index de322f9..0000000
--- a/src/mathlib/bvsl/test/sxy.F
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: sxy.F,v 1.1.1.1 1996/03/21 17:19:54 mclareni Exp $
-*
-* $Log: sxy.F,v $
-* Revision 1.1.1.1 1996/03/21 17:19:54 mclareni
-* Bvsl
-*
-*
-*CMZ : 06/11/90 10.43.59 by Michel Roethlisberger/IBM
-*-- Author :
-*********************************************************************
-*CMZ : 04/05/90 16.17.27 by Michel Roethlisberger/IBM
-*-- Author :
- SUBROUTINE SXY(NW,IV,Y,X,S)
- DIMENSION IV(*),X(*),Y(*)
- DO I= 1, NW
- Y(IV(I)) = S*X(IV(I))*Y(IV(I))
- ENDDO
- RETURN
- END
diff --git a/src/mathlib/bvsl/test/tsbvsl.F b/src/mathlib/bvsl/test/tsbvsl.F
deleted file mode 100644
index 33065ec..0000000
--- a/src/mathlib/bvsl/test/tsbvsl.F
+++ /dev/null
@@ -1,1060 +0,0 @@
-*
-* $Id: tsbvsl.F,v 1.3 2006/09/15 09:34:52 mclareni Exp $
-*
-* $Log: tsbvsl.F,v $
-* Revision 1.3 2006/09/15 09:34:52 mclareni
-* Submitted mods for gcc4/gfortran and MacOSX, corrected to work also on slc4 with gcc3.4 and 4.1
-*
-* Revision 1.2 1997/04/07 10:00:45 mclareni
-* Mods for winnt
-*
-* Revision 1.1.1.1.2.1 1997/01/21 11:25:48 mclareni
-* All mods for Winnt 96a on winnt branch
-*
-* Revision 1.1.1.1 1996/03/21 17:19:54 mclareni
-* Bvsl
-*
-*
-*CMZ : 06/11/90 10.43.17 by Michel Roethlisberger/IBM
-*-- Author :
-* Last modif.: 6 Nov 1990 at 10:30:03
-*CMZ : 04/05/90 16.17.27 by Michel Roethlisberger/IBM
-*-- Author :
- PROGRAM TSBVSL
- PARAMETER (LENG=500)
- PARAMETER (LENGB=LENG)
-* PARAMETER (LENGB=(LENG-1)/32 +1)
- PARAMETER (TSVAL=0.5,ISVAL=5,IBOUND=10)
- PARAMETER (S= 2.0 , T = 3.0)
- DIMENSION X(LENG),Y(LENG),Z(LENG),W(LENG),VEC(LENG),IVEC(LENG),
- + X1(LENG),Y1(LENG),Z1(LENG),W1(LENG),
- + IX(LENG),IX1(LENG),IY(LENG),IY1(LENG),IZ(LENG),IZ1(LENG),
- + XB(LENGB),YB(LENGB),ZB(LENG),VECB(LENGB)
- DIMENSION NP(3)
- DATA NP/50,150,300/
-*
- WRITE(6,*)'1************************************* '
- WRITE(6,*)' TEST PART FOR VEC. TO SCAL COMP. ROUT.'
- WRITE(6,*)' ************************************* '
-* TEST FOR YLOSB SUBROUTINE
- IERR=0
- WRITE(6,*)' #####################################'
- WRITE(6,*)' TEST YLOSB (EQ)'
- DO J=1,3
- ILENG=NP(J)
- CALL NRANIN(54321.)
- CALL NRAN(VEC,ILENG)
-*
-#if defined(CERNLIB_GFORTRAN)
- do kkk=1, leng
- iy (kkk) = 0
- iy1(kkk) = 0
- end do
-#endif
- CALL WHENEQ(ILENG,VEC,1,TSVAL,IY,NFOUND)
- CALL YLOSB(ILENG,VEC,TSVAL,YB,IFOUND,'EQ')
- CALL BINVEC(ILENG,YB,IY1)
-
-*
-*
- DO I=1,ILENG
- IF(IY(I).NE.IY1(I))THEN
- IELEM=I
- GO TO 100
- ENDIF
- ENDDO
- GO TO 200
- 100 IERR=1
- WRITE(6,*)' ERROR ON SUB. YLOSB (EQ) FOR LENGTH = ', ILENG
- WRITE(6,*)' AND ELEMENT = ' , IELEM
- 200 CONTINUE
- ENDDO
- IF(IERR.NE.1)WRITE(6,*)' SUBROUTINE YLOSB (EQ) OK '
-
-* TEST FOR YLOSB (NE) SUBROUTINE
- IERR=0
- WRITE(6,*)' #####################################'
- WRITE(6,*)' TEST YLOSB (NE)'
- DO J=1,3
- ILENG=NP(J)
- CALL NRANIN(54321.)
- CALL NRAN(VEC,ILENG)
-*
- CALL WHENNE(ILENG,VEC,1,TSVAL,IY,NFOUND)
- CALL YLOSB(ILENG,VEC,TSVAL,YB,IFOUND,'NE')
- CALL BINVEC(ILENG,YB,IY1)
-
-*
-*
- DO I=1,ILENG
- IF(IY(I).NE.IY1(I))THEN
- IELEM=I
- GO TO 101
- ENDIF
- ENDDO
- GO TO 201
- 101 IERR=1
- WRITE(6,*)' ERROR ON SUB. YNESB FOR LENGTH = ', ILENG
- WRITE(6,*)' AND ELEMENT = ' , IELEM
- 201 CONTINUE
- ENDDO
- IF(IERR.NE.1)WRITE(6,*)' SUBROUTINE YLOSB (NE) OK '
-
-* TEST FOR YLOSB (GT) SUBROUTINE
- IERR=0
- WRITE(6,*)' #####################################'
- WRITE(6,*)' TEST YLOSB (GT) '
- DO J=1,3
- ILENG=NP(J)
- CALL NRANIN(54321.)
- CALL NRAN(VEC,ILENG)
-*
- CALL WHENFGT(ILENG,VEC,1,TSVAL,IY,NFOUND)
- CALL YLOSB(ILENG,VEC,TSVAL,YB,IFOUND,'GT')
- CALL BINVEC(ILENG,YB,IY1)
-
-*
-*
- DO I=1,ILENG
- IF(IY(I).NE.IY1(I))THEN
- IELEM=I
- GO TO 102
- ENDIF
- ENDDO
- GO TO 202
- 102 IERR=1
- WRITE(6,*)' ERROR ON SUB. YLOSB (EQ) FOR LENGTH = ', ILENG
- WRITE(6,*)' AND ELEMENT = ' , IELEM
- 202 CONTINUE
- ENDDO
- IF(IERR.NE.1)WRITE(6,*)' SUBROUTINE YLOSB (GT) OK '
-
-* TEST FOR YLOSB (LT) SUBROUTINE
- IERR=0
- WRITE(6,*)' #####################################'
- WRITE(6,*)' TEST YLOSB (LT) '
- DO J=1,3
- ILENG=NP(J)
- CALL NRANIN(54321.)
- CALL NRAN(VEC,ILENG)
-*
- CALL WHENFLT(ILENG,VEC,1,TSVAL,IY,NFOUND)
- CALL YLOSB(ILENG,VEC,TSVAL,YB,IFOUND,'LT')
- CALL BINVEC(ILENG,YB,IY1)
-
-*
-*
- DO I=1,ILENG
- IF(IY(I).NE.IY1(I))THEN
- IELEM=I
- GO TO 103
- ENDIF
- ENDDO
- GO TO 203
- 103 IERR=1
- WRITE(6,*)' ERROR ON SUB. YLOSB (LT) FOR LENGTH = ', ILENG
- WRITE(6,*)' AND ELEMENT = ' , IELEM
- 203 CONTINUE
- ENDDO
- IF(IERR.NE.1)WRITE(6,*)' SUBROUTINE YLOSB (LT) OK '
-
-* TEST FOR YLOSB (GE) SUBROUTINE
- IERR=0
- WRITE(6,*)' #####################################'
- WRITE(6,*)' TEST YLOSB (GE) '
- DO J=1,3
- ILENG=NP(J)
- CALL NRANIN(54321.)
- CALL NRAN(VEC,ILENG)
-*
- CALL WHENFGE(ILENG,VEC,1,TSVAL,IY,NFOUND)
- CALL YLOSB(ILENG,VEC,TSVAL,YB,IFOUND,'GE')
- CALL BINVEC(ILENG,YB,IY1)
-
-*
-*
- DO I=1,ILENG
- IF(IY(I).NE.IY1(I))THEN
- IELEM=I
- GO TO 104
- ENDIF
- ENDDO
- GO TO 204
- 104 IERR=1
- WRITE(6,*)' ERROR ON SUB. YLOSB (GE) FOR LENGTH = ', ILENG
- WRITE(6,*)' AND ELEMENT = ' , IELEM
- 204 CONTINUE
- ENDDO
- IF(IERR.NE.1)WRITE(6,*)' SUBROUTINE YLOSB (GE) OK '
-* TEST FOR YLOSB (LE) SUBROUTINE
- IERR=0
- WRITE(6,*)' #####################################'
- WRITE(6,*)' TEST YLOSB (LE) '
- DO J=1,3
- ILENG=NP(J)
- CALL NRANIN(54321.)
- CALL NRAN(VEC,ILENG)
-*
- CALL WHENFLE(ILENG,VEC,1,TSVAL,IY,NFOUND)
- CALL YLOSB(ILENG,VEC,TSVAL,YB,IFOUND,'LE')
- CALL BINVEC(ILENG,YB,IY1)
-
-*
-*
- DO I=1,ILENG
- IF(IY(I).NE.IY1(I))THEN
- IELEM=I
- GO TO 105
- ENDIF
- ENDDO
- GO TO 205
- 105 IERR=1
- WRITE(6,*)' ERROR ON SUB. YLOSB (LE) FOR LENGTH = ', ILENG
- WRITE(6,*)' AND ELEMENT = ' , IELEM
- 205 CONTINUE
- ENDDO
- IF(IERR.NE.1)WRITE(6,*)' SUBROUTINE YLOSB (LE) OK '
-* TEST FOR IYLOSB (GT) SUBROUTINE
- IERR=0
- WRITE(6,*)' #####################################'
- WRITE(6,*)' TEST IYLOSB (GT)'
- DO J=1,3
- ILENG=NP(J)
- CALL NRANIN(54321.)
- CALL NRAN(VEC,ILENG)
- DO L=1,ILENG
- IVEC(L)=INT(VEC(L)*IBAUND)
- ENDDO
-*
- CALL WHENIGT(ILENG,IVEC,1,ISVAL,IY,NFOUND)
- CALL IYLOSB(ILENG,IVEC,ISVAL,YB,IFOUND,'GT')
- CALL BINVEC(ILENG,YB,IY1)
-
-*
-*
- DO I=1,ILENG
- IF(IY(I).NE.IY1(I))THEN
- IELEM=I
- GO TO 106
- ENDIF
- ENDDO
- GO TO 206
- 106 IERR=1
- WRITE(6,*)' ERROR ON SUB. IYLOSB (GT) FOR LENGTH = ', ILENG
- WRITE(6,*)' AND ELEMENT = ' , IELEM
- 206 CONTINUE
- ENDDO
- IF(IERR.NE.1)WRITE(6,*)' SUBROUTINE IYLOSB (GT) OK '
-* TEST FOR IYLOSB (LT) SUBROUTINE
- IERR=0
- WRITE(6,*)' #####################################'
- WRITE(6,*)' TEST IYLOSB (LT) '
- DO J=1,3
- ILENG=NP(J)
- CALL NRANIN(54321.)
- CALL NRAN(VEC,ILENG)
- DO L=1,ILENG
- IVEC(L)=INT(VEC(L)*IBAUND)
- ENDDO
-*
- CALL WHENILT(ILENG,IVEC,1,ISVAL,IY,NFOUND)
- CALL IYLOSB(ILENG,IVEC,ISVAL,YB,IFOUND,'LT')
- CALL BINVEC(ILENG,YB,IY1)
-
-*
-*
- DO I=1,ILENG
- IF(IY(I).NE.IY1(I))THEN
- IELEM=I
- GO TO 107
- ENDIF
- ENDDO
- GO TO 207
- 107 IERR=1
- WRITE(6,*)' ERROR ON SUB. IYLOSB (LT) FOR LENGTH = ', ILENG
- WRITE(6,*)' AND ELEMENT = ' , IELEM
- 207 CONTINUE
- ENDDO
- IF(IERR.NE.1)WRITE(6,*)' SUBROUTINE IYLOSB (LT) OK '
-* TEST FOR IYLOSB (GE) SUBROUTINE
- IERR=0
- WRITE(6,*)' #####################################'
- WRITE(6,*)' TEST IYLOSB '
- DO J=1,3
- ILENG=NP(J)
- CALL NRANIN(54321.)
- CALL NRAN(VEC,ILENG)
- DO L=1,ILENG
- IVEC(L)=INT(VEC(L)*IBAUND)
- ENDDO
-*
- CALL WHENIGE(ILENG,IVEC,1,ISVAL,IY,NFOUND)
- CALL IYLOSB(ILENG,IVEC,ISVAL,YB,IFOUND,'GE')
- CALL BINVEC(ILENG,YB,IY1)
-
-*
-*
- DO I=1,ILENG
- IF(IY(I).NE.IY1(I))THEN
- IELEM=I
- GO TO 108
- ENDIF
- ENDDO
- GO TO 208
- 108 IERR=1
- WRITE(6,*)' ERROR ON SUB. IYLOSB (GE) FOR LENGTH = ', ILENG
- WRITE(6,*)' AND ELEMENT = ' , IELEM
- 208 CONTINUE
- ENDDO
- IF(IERR.NE.1)WRITE(6,*)' SUBROUTINE IYLOSB (GE) OK '
-* TEST FOR IYLOSB (LE) SUBROUTINE
- IERR=0
- WRITE(6,*)' #####################################'
- WRITE(6,*)' TEST IYLOSB (LE)'
- DO J=1,3
- ILENG=NP(J)
- CALL NRANIN(54321.)
- CALL NRAN(VEC,ILENG)
- DO L=1,ILENG
- IVEC(L)=INT(VEC(L)*IBAUND)
- ENDDO
-*
- CALL WHENILE(ILENG,IVEC,1,ISVAL,IY,NFOUND)
- CALL IYLOSB(ILENG,IVEC,ISVAL,YB,IFOUND,'LE')
- CALL BINVEC(ILENG,YB,IY1)
-
-*
-*
- DO I=1,ILENG
- IF(IY(I).NE.IY1(I))THEN
- IELEM=I
- GO TO 109
- ENDIF
- ENDDO
- GO TO 209
- 109 IERR=1
- WRITE(6,*)' ERROR ON SUB. IYLOSB FOR (LE) LENGTH = ', ILENG
- WRITE(6,*)' AND ELEMENT = ' , IELEM
- 209 CONTINUE
- ENDDO
- IF(IERR.NE.1)WRITE(6,*)' SUBROUTINE IYLOSB (LE) OK '
-*
- WRITE(6,*)'1************************************* '
- WRITE(6,*)' TEST PART FOR VEC. TO VEC. COMPARIS. '
- WRITE(6,*)' ************************************* '
-
-* TEST FOR YLOXB SUBROUTINE
- IERR=0
- WRITE(6,*)' #####################################'
- WRITE(6,*)' TEST YLOXB (EQ)'
- DO J=1,3
- ILENG=NP(J)
- CALL NRANIN(54321.)
- CALL NRAN(VEC,ILENG)
- CALL NRAN(X,ILENG)
-*
- CALL YEQX(ILENG,VEC,X,IY,NFOUND)
- CALL YLOXB(ILENG,VEC,X,YB,IFOUND,'EQ')
- CALL BINVEC(ILENG,YB,IY1)
-
-*
-*
- DO I=1,ILENG
- IF(IY(I).NE.IY1(I))THEN
- IELEM=I
- GO TO 110
- ENDIF
- ENDDO
- GO TO 210
- 110 IERR=1
- WRITE(6,*)' ERROR ON SUB. YLOXB (EQ) FOR LENGTH = ', ILENG
- WRITE(6,*)' AND ELEMENT = ' , IELEM
- 210 CONTINUE
- ENDDO
- IF(IERR.NE.1)WRITE(6,*)' SUBROUTINE YLOXB (EQ) OK '
-
-* TEST FOR YLOXB SUBROUTINE
- IERR=0
- WRITE(6,*)' #####################################'
- WRITE(6,*)' TEST YLOXB (NE)'
- DO J=1,3
- ILENG=NP(J)
- CALL NRANIN(54321.)
- CALL NRAN(VEC,ILENG)
- CALL NRAN(X,ILENG)
-*
- CALL YNEX(ILENG,VEC,X,IY,NFOUND)
- CALL YLOXB(ILENG,VEC,X,YB,IFOUND,'NE')
- CALL BINVEC(ILENG,YB,IY1)
-
-*
-*
- DO I=1,ILENG
- IF(IY(I).NE.IY1(I))THEN
- IELEM=I
- GO TO 111
- ENDIF
- ENDDO
- GO TO 211
- 111 IERR=1
- WRITE(6,*)' ERROR ON SUB. YLOXB (NE) FOR LENGTH = ', ILENG
- WRITE(6,*)' AND ELEMENT = ' , IELEM
- 211 CONTINUE
- ENDDO
- IF(IERR.NE.1)WRITE(6,*)' SUBROUTINE YLOXB (NE) OK '
-
-* TEST FOR YLOXB SUBROUTINE
- IERR=0
- WRITE(6,*)' #####################################'
- WRITE(6,*)' TEST YLOXB (GT)'
- DO J=1,3
- ILENG=NP(J)
- CALL NRANIN(54321.)
- CALL NRAN(VEC,ILENG)
- CALL NRAN(X,ILENG)
-*
- CALL YGTX(ILENG,VEC,X,IY,NFOUND)
- CALL YLOXB(ILENG,VEC,X,YB,IFOUND,'GT')
- CALL BINVEC(ILENG,YB,IY1)
-
-*
-*
- DO I=1,ILENG
- IF(IY(I).NE.IY1(I))THEN
- IELEM=I
- GO TO 112
- ENDIF
- ENDDO
- GO TO 212
- 112 IERR=1
- WRITE(6,*)' ERROR ON SUB. YLOXB (GT) FOR LENGTH = ', ILENG
- WRITE(6,*)' AND ELEMENT = ' , IELEM
- 212 CONTINUE
- ENDDO
- IF(IERR.NE.1)WRITE(6,*)' SUBROUTINE YLOXB (GT) OK '
-
-* TEST FOR YLOXB SUBROUTINE
- IERR=0
- WRITE(6,*)' #####################################'
- WRITE(6,*)' TEST YLOXB (LT)'
- DO J=1,3
- ILENG=NP(J)
- CALL NRANIN(54321.)
- CALL NRAN(VEC,ILENG)
- CALL NRAN(X,ILENG)
-*
- CALL YLTX(ILENG,VEC,X,IY,NFOUND)
- CALL YLOXB(ILENG,VEC,X,YB,IFOUND,'LT')
- CALL BINVEC(ILENG,YB,IY1)
-
-*
-*
- DO I=1,ILENG
- IF(IY(I).NE.IY1(I))THEN
- IELEM=I
- GO TO 113
- ENDIF
- ENDDO
- GO TO 213
- 113 IERR=1
- WRITE(6,*)' ERROR ON SUB. YLOXB (LT) FOR LENGTH = ', ILENG
- WRITE(6,*)' AND ELEMENT = ' , IELEM
- 213 CONTINUE
- ENDDO
- IF(IERR.NE.1)WRITE(6,*)' SUBROUTINE YLOXB (LT) OK '
-
- IERR=0
- WRITE(6,*)' #####################################'
- WRITE(6,*)' TEST YLOXB (GE)'
- DO J=1,3
- ILENG=NP(J)
- CALL NRANIN(54321.)
- CALL NRAN(VEC,ILENG)
- CALL NRAN(X,ILENG)
-*
- CALL YGEX(ILENG,VEC,X,IY,NFOUND)
- CALL YLOXB(ILENG,VEC,X,YB,IFOUND,'GE')
- CALL BINVEC(ILENG,YB,IY1)
-
-*
-*
- DO I=1,ILENG
- IF(IY(I).NE.IY1(I))THEN
- IELEM=I
- GO TO 114
- ENDIF
- ENDDO
- GO TO 214
- 114 IERR=1
- WRITE(6,*)' ERROR ON SUB. YLOXB (GE) FOR LENGTH = ', ILENG
- WRITE(6,*)' AND ELEMENT = ' , IELEM
- 214 CONTINUE
- ENDDO
- IF(IERR.NE.1)WRITE(6,*)' SUBROUTINE YLOXB (GE) OK '
-
-* TEST FOR YLOXB SUBROUTINE
- IERR=0
- WRITE(6,*)' #####################################'
- WRITE(6,*)' TEST YLOXB (LT)'
- DO J=1,3
- ILENG=NP(J)
- CALL NRANIN(54321.)
- CALL NRAN(VEC,ILENG)
- CALL NRAN(X,ILENG)
-*
- CALL YLEX(ILENG,VEC,X,IY,NFOUND)
- CALL YLOXB(ILENG,VEC,X,YB,IFOUND,'LT')
- CALL BINVEC(ILENG,YB,IY1)
-
-*
-*
- DO I=1,ILENG
- IF(IY(I).NE.IY1(I))THEN
- IELEM=I
- GO TO 115
- ENDIF
- ENDDO
- GO TO 215
- 115 IERR=1
- WRITE(6,*)' ERROR ON SUB. YLOXB (LT) FOR LENGTH = ', ILENG
- WRITE(6,*)' AND ELEMENT = ' , IELEM
- 215 CONTINUE
- ENDDO
- IF(IERR.NE.1)WRITE(6,*)' SUBROUTINE YLOXB (LT) OK '
-
-* TEST FOR IYLOXB SUBROUTINE
- IERR=0
- WRITE(6,*)' #####################################'
- WRITE(6,*)' TEST IYLOXB (GT)'
- DO J=1,3
- ILENG=NP(J)
- CALL NRANIN(54321.)
- CALL NRAN(VEC,ILENG)
- CALL NRAN(X,ILENG)
- DO L=1,LENG
- IVEC(L)=INT(VEC(L)*IBOUND)
- IX(L)=INT(X(L)*IBOUND)
- ENDDO
-*
- CALL IYGTX(ILENG,IVEC,IX,IY,NFOUND)
- CALL IYLOXB(ILENG,IVEC,IX,YB,IFOUND,'GT')
- CALL BINVEC(ILENG,YB,IY1)
-
-*
-*
- DO I=1,ILENG
- IF(IY(I).NE.IY1(I))THEN
- IELEM=I
- GO TO 116
- ENDIF
- ENDDO
- GO TO 216
- 116 IERR=1
- WRITE(6,*)' ERROR ON SUB. IYLOXB (GT) FOR LENGTH = ', ILENG
- WRITE(6,*)' AND ELEMENT = ' , IELEM
- 216 CONTINUE
- ENDDO
- IF(IERR.NE.1)WRITE(6,*)' SUBROUTINE IYLOXB OK '
-
-* TEST FOR IYLOXB SUBROUTINE
- IERR=0
- WRITE(6,*)' #####################################'
- WRITE(6,*)' TEST IYLOXB (LT)'
- DO J=1,3
- ILENG=NP(J)
- CALL NRANIN(54321.)
- CALL NRAN(VEC,ILENG)
- CALL NRAN(X,ILENG)
- DO L=1,LENG
- IVEC(L)=INT(VEC(L)*IBOUND)
- IX(L)=INT(X(L)*IBOUND)
- ENDDO
-*
- CALL IYLTX(ILENG,IVEC,IX,IY,NFOUND)
- CALL IYLOXB(ILENG,IVEC,IX,YB,IFOUND,'LT')
- CALL BINVEC(ILENG,YB,IY1)
-
-*
-*
- DO I=1,ILENG
- IF(IY(I).NE.IY1(I))THEN
- IELEM=I
- GO TO 117
- ENDIF
- ENDDO
- GO TO 217
- 117 IERR=1
- WRITE(6,*)' ERROR ON SUB. IYLOXB (LT) FOR LENGTH = ', ILENG
- WRITE(6,*)' AND ELEMENT = ' , IELEM
- 217 CONTINUE
- ENDDO
- IF(IERR.NE.1)WRITE(6,*)' SUBROUTINE IYLOXB (LT) OK '
-
-* TEST FOR IYLOXB SUBROUTINE
- IERR=0
- WRITE(6,*)' #####################################'
- WRITE(6,*)' TEST IYLOXB '
- DO J=1,3
- ILENG=NP(J)
- CALL NRANIN(54321.)
- CALL NRAN(VEC,ILENG)
- CALL NRAN(X,ILENG)
- DO L=1,LENG
- IVEC(L)=INT(VEC(L)*IBOUND)
- IX(L)=INT(X(L)*IBOUND)
- ENDDO
-*
- CALL IYGEX(ILENG,IVEC,IX,IY,NFOUND)
- CALL IYLOXB(ILENG,IVEC,IX,YB,IFOUND,'GE')
- CALL BINVEC(ILENG,YB,IY1)
-
-*
-*
- DO I=1,ILENG
- IF(IY(I).NE.IY1(I))THEN
- IELEM=I
- GO TO 118
- ENDIF
- ENDDO
- GO TO 218
- 118 IERR=1
- WRITE(6,*)' ERROR ON SUB. YLOXB (GE) FOR LENGTH = ', ILENG
- WRITE(6,*)' AND ELEMENT = ' , IELEM
- 218 CONTINUE
- ENDDO
- IF(IERR.NE.1)WRITE(6,*)' SUBROUTINE YLOXB (GE) OK '
-
-* TEST FOR IYLOXB SUBROUTINE
- IERR=0
- WRITE(6,*)' #####################################'
- WRITE(6,*)' TEST IYLOXB (LE)'
- DO J=1,3
- ILENG=NP(J)
- CALL NRANIN(54321.)
- CALL NRAN(VEC,ILENG)
- CALL NRAN(X,ILENG)
- DO L=1,LENG
- IVEC(L)=INT(VEC(L)*IBOUND)
- IX(L)=INT(X(L)*IBOUND)
- ENDDO
-*
- CALL IYLEX(ILENG,IVEC,IX,IY,NFOUND)
- CALL IYLOXB(ILENG,IVEC,IX,YB,IFOUND,'LE')
- CALL BINVEC(ILENG,YB,IY1)
-
-*
-*
- DO I=1,ILENG
- IF(IY(I).NE.IY1(I))THEN
- IELEM=I
- GO TO 119
- ENDIF
- ENDDO
- GO TO 219
- 119 IERR=1
- WRITE(6,*)' ERROR ON SUB. IYLOXB (LE) FOR LENGTH = ', ILENG
- WRITE(6,*)' AND ELEMENT = ' , IELEM
- 219 CONTINUE
- ENDDO
- IF(IERR.NE.1)WRITE(6,*)' SUBROUTINE IYLOXB (LE) OK '
-
- WRITE(6,*)'1************************************* '
- WRITE(6,*)' TEST PART FOR MISCELLANEOUS ROUTINES '
- WRITE(6,*)' ************************************* '
-* TEST FOR INTGB SUBROUTINE
-
- WRITE(6,*)' #####################################'
- WRITE(6,*)' TEST INTGB '
- DO J=1,3
- ILENG=NP(J)
- CALL NRANIN(54321.)
- CALL NRAN(VEC,ILENG)
- CALL NRAN(X,ILENG)
- CALL NRAN(X1,ILENG)
-*
-
-*
- IERR=0
- DO I=1,ILENG
- X1(I)=X(I)+1.0
- VEC(I)=VEC(I)*2.
- IY(I)=0.0
- IY1(I)=0.0
- ENDDO
- DO I=1,LENGB
- YB(I)=0
- ENDDO
- CALL INTG(ILENG,VEC,X1,X,IY,NFOUND)
- CALL INTGB(ILENG,VEC,X1,X,YB,IFOUND)
- CALL BINVEC(ILENG,YB,IY1)
-*
- DO I=1,ILENG
- IF(IY(I).NE.IY1(I))THEN
- IELEM=I
- GO TO 11
- ENDIF
- ENDDO
- GO TO 21
- 11 IERR=1
- WRITE(6,*)' ERROR ON SUB. INTGB FOR LENGTH = ', ILENG
- WRITE(6,*)' AND ELEMENT = ' , IELEM
- 21 CONTINUE
- ENDDO
- IF(IERR.NE.1)WRITE(6,*)' SUBROUTINE INTGB OK '
-
-* TEST FOR RJCTB SUBROUTINE
-
- WRITE(6,*)' #####################################'
- WRITE(6,*)' TEST RJCTB '
- DO I1=1,3
- IERR=0
- ILENG=NP(I1)
- DO L=1,ILENG
- Z(L)=L
- IX(L)=L
- W(L)=0.0
- W1(L)=0.0
- ENDDO
- CALL NRANIN(54321.)
- CALL NRAN(Y,ILENG)
- CALL NRAN(Y1,ILENG)
-*
- ISW=1
- CALL RJCTB(Y,Z,Y1,W,YB,ILENG,N2,ISW)
- CALL BINVEC(ILENG,YB,IY)
-*
- M=0
- DO L=1,ILENG
- IF(Y1(L).GT.Y(L))THEN
- W1(IX(L))=Z(L)
- ELSE
- M=M+1
- IZ(M)=IX(L)
- ENDIF
- ENDDO
- N3=M
- DO L=1,ILENG
- IF(W(L).NE.W1(L))THEN
- IERR=1
- WRITE(6,*)' ERROR FOR OUT' ,L
- ENDIF
- ENDDO
- ENDDO
- IF(ISW.EQ.1)IERR=2
- IF(IERR.EQ.0)WRITE(6,*)' TEST RJCTB OK'
- IF(IERR.EQ.2)WRITE(6,*)' ERROR FOR ISW'
- WRITE(6,*)'1************************************* '
- WRITE(6,*)' TEST PART FOR EXTENDED L. A. ROUTINES '
- WRITE(6,*)' ************************************* '
-* TEST FOR DOTB FUNCTION
- IERR=0
- WRITE(6,*)' #####################################'
- WRITE(6,*)' TEST DOTB '
- DO J=1,3
- ILENG=NP(J)
- CALL NRANIN(54321.)
- CALL NRAN(VEC,ILENG)
-*
- CALL WHENFGT(ILENG,VEC,1,TSVAL,IVEC,NFOUND)
- CALL YLOSB(ILENG,VEC,TSVAL,VECB,IFOUND,'GT')
-
-*
- DO I=1,ILENG
- X(I)=I
- Y(I)=I
- ENDDO
- BDOT=DOTB(ILENG,VECB,X,Y)
- SDOT=DOT(NFOUND,IVEC,X,Y)
- IF(SDOT.NE.BDOT)THEN
- IERR=1
- WRITE(6,*)' ERROR ON FUNCTION DOTB FOR LENGTH = ', ILENG
- ENDIF
- ENDDO
- IF(IERR.NE.1)WRITE(6,*)' FUNCTION DOTB OK '
- WRITE(6,*)' #####################################'
-* TEST FOR COPYB SUBROUTINE
- IERR=0
- WRITE(6,*)' #####################################'
- WRITE(6,*)' TEST COPYB '
- DO J=1,3
- ILENG=NP(J)
- CALL NRANIN(54321.)
- CALL NRAN(VEC,ILENG)
-*
- CALL WHENFGT(ILENG,VEC,1,TSVAL,IVEC,NFOUND)
- CALL YLOSB(ILENG,VEC,TSVAL,VECB,IFOUND,'GT')
-
-*
- DO I=1,ILENG
- X(I)=I
- Y(I)=0.0
- Y1(I)=0.0
- ENDDO
- CALL COPY(NFOUND,IVEC,Y,X)
- CALL COPYB(ILENG,VECB,Y1,X)
-*
- DO I=1,ILENG
- IF(Y(I).NE.Y1(I))THEN
- IELEM=I
- GO TO 10
- ENDIF
- ENDDO
- GO TO 20
- 10 IERR=1
- WRITE(6,*)' ERROR ON SUB. COPYB FOR LENGTH = ', ILENG
- WRITE(6,*)' AND ELEMENT = ' , IELEM
- 20 CONTINUE
- ENDDO
- IF(IERR.NE.1)WRITE(6,*)' SUBROUTINE COPYB OK '
-* TEST FOR SXYB SUBROUTINE
- WRITE(6,*)' #####################################'
- WRITE(6,*)' TEST SXYB '
- IERR=0
- DO J=1,3
- ILENG=NP(J)
- CALL NRANIN(54321.)
- CALL NRAN(VEC,ILENG)
-*
- CALL WHENFGT(ILENG,VEC,1,TSVAL,IVEC,NFOUND)
- CALL YLOSB(ILENG,VEC,TSVAL,VECB,IFOUND,'GT')
-
-*
- DO I=1,ILENG
- X(I)=I
- Y(I)=2.*I
- Y1(I)=Y(I)
- ENDDO
- CALL SXY(NFOUND,IVEC,Y,X,S)
- CALL SXYB(ILENG,VECB,Y1,X,S)
-*
- DO I=1,ILENG
- IF(Y(I).NE.Y1(I))THEN
- IELEM=I
- GO TO 12
- ENDIF
- ENDDO
- GO TO 22
- 12 IERR=1
- WRITE(6,*)' ERROR ON SUB. SXYB FOR LENGTH = ', ILENG
- WRITE(6,*)' AND ELEMENT = ' , IELEM
- 22 CONTINUE
- ENDDO
- IF(IERR.NE.1)WRITE(6,*)' SUBROUTINE SXYB OK '
-* TEST FOR SXPYB SUBROUTINE
- WRITE(6,*)' #####################################'
- WRITE(6,*)' TEST SXPYB '
- IERR=0
- DO J=1,3
- ILENG=NP(J)
- CALL NRANIN(54321.)
- CALL NRAN(VEC,ILENG)
-*
- CALL WHENFGT(ILENG,VEC,1,TSVAL,IVEC,NFOUND)
- CALL YLOSB(ILENG,VEC,TSVAL,VECB,IFOUND,'GT')
-
-*
- DO I=1,ILENG
- X(I)=I
- Y(I)=2.*I
- Y1(I)=Y(I)
- ENDDO
- CALL SXPY(NFOUND,IVEC,Y,X,S)
- CALL SXPYB(ILENG,VECB,Y1,X,S)
-*
- DO I=1,ILENG
- IF(Y(I).NE.Y1(I))THEN
- IELEM=I
- GO TO 13
- ENDIF
- ENDDO
- GO TO 23
- 13 IERR=1
- WRITE(6,*)' ERROR ON SUB. SXPYB FOR LENGTH = ', ILENG
- WRITE(6,*)' AND ELEMENT = ' , IELEM
- 23 CONTINUE
- ENDDO
- IF(IERR.NE.1)WRITE(6,*)' SUBROUTINE SXPYB OK '
-* TEST FOR VXPYB SUBROUTINE
- WRITE(6,*)' #####################################'
- WRITE(6,*)' TEST VXPYB '
- IERR=0
- DO J=1,3
- ILENG=NP(J)
- CALL NRANIN(54321.)
- CALL NRAN(VEC,ILENG)
-*
- CALL WHENFGT(ILENG,VEC,1,TSVAL,IVEC,NFOUND)
- CALL YLOSB(ILENG,VEC,TSVAL,VECB,IFOUND,'GT')
-
-*
- DO I=1,ILENG
- X(I)=I
- W(I)=0.5*I
- Y(I)=2.*I
- Y1(I)=Y(I)
- ENDDO
- CALL VXPY(NFOUND,IVEC,Y,X,W)
- CALL VXPYB(ILENG,VECB,Y1,X,W)
-*
- DO I=1,ILENG
- IF(Y(I).NE.Y1(I))THEN
- IELEM=I
- GO TO 14
- ENDIF
- ENDDO
- GO TO 24
- 14 IERR=1
- WRITE(6,*)' ERROR ON SUB. VXPYB FOR LENGTH = ', ILENG
- WRITE(6,*)' AND ELEMENT = ' , IELEM
- 24 CONTINUE
- ENDDO
- WRITE(6,*)' SUBROUTINE VXPYB OK '
-* TEST FOR XYPWZB SUBROUTINE
- WRITE(6,*)' #####################################'
- WRITE(6,*)' TEST XYPWZB '
- IERR=0
- DO J=1,3
- ILENG=NP(J)
- CALL NRANIN(54321.)
- CALL NRAN(VEC,ILENG)
-*
- CALL WHENFGT(ILENG,VEC,1,TSVAL,IVEC,NFOUND)
- CALL YLOSB(ILENG,VEC,TSVAL,VECB,IFOUND,'GT')
-
-*
- DO I=1,ILENG
- X(I)=I
- Y(I)=2.*I
- Y1(I)=Y(I)
- W(I)=I
- Z(I)=0.5*I
- ENDDO
- CALL XYPWZ(NFOUND,IVEC,S,Y,X,T,W,Z)
- CALL XYPWZB(ILENG,VECB,S,Y1,X,T,W,Z)
-*
- DO I=1,ILENG
- IF(Y(I).NE.Y1(I))THEN
- IELEM=I
- GO TO 15
- ENDIF
- ENDDO
- GO TO 25
- 15 IERR=1
- WRITE(6,*)' ERROR ON SUB. XYPWZB FOR LENGTH = ', ILENG
- WRITE(6,*)' AND ELEMENT = ' , IELEM
- 25 CONTINUE
- ENDDO
- IF(IERR.NE.1)WRITE(6,*)' SUBROUTINE XYPWZB OK '
-* TEST FOR SCALB SUBROUTINE
- WRITE(6,*)' #####################################'
- WRITE(6,*)' TEST SCALB '
- IERR=0
- DO J=1,3
- ILENG=NP(J)
- CALL NRANIN(54321.)
- CALL NRAN(VEC,ILENG)
-*
- CALL WHENFGT(ILENG,VEC,1,TSVAL,IVEC,NFOUND)
- CALL YLOSB(ILENG,VEC,TSVAL,VECB,IFOUND,'GT')
-
-*
- DO I=1,ILENG
- Y(I)=2.*I
- Y1(I)=Y(I)
- ENDDO
- CALL SCAL(NFOUND,IVEC,Y,S)
- CALL SCALB(ILENG,VECB,Y1,S)
-*
- DO I=1,ILENG
- IF(Y(I).NE.Y1(I))THEN
- IELEM=I
- GO TO 17
- ENDIF
- ENDDO
- GO TO 27
- 17 IERR=1
- WRITE(6,*)' ERROR ON SUB. SCALB FOR LENGTH = ', ILENG
- WRITE(6,*)' AND ELEMENT = ' , IELEM
- 27 CONTINUE
- ENDDO
- IF(IERR.NE.1)WRITE(6,*)' SUBROUTINE SCALB OK '
-* TEST FOR VSETB SUBROUTINE
- WRITE(6,*)' #####################################'
- WRITE(6,*)' TEST VSETB '
- IERR=0
- DO J=1,3
- ILENG=NP(J)
- CALL NRANIN(54321.)
- CALL NRAN(VEC,ILENG)
-*
- CALL WHENFGT (ILENG,VEC,1,TSVAL,IVEC,NFOUND)
- CALL YLOSB (ILENG,VEC, TSVAL,VECB,IFOUND,'GT')
-
-*
- DO I=1,ILENG
- Y(I)=2.*I
- Y1(I)=Y(I)
- ENDDO
- CALL VSET(NFOUND,IVEC,Y,S)
- CALL VSETB(ILENG,VECB,Y1,S)
-*
- DO I=1,ILENG
- IF(Y(I).NE.Y1(I))THEN
- IELEM=I
- GO TO 16
- ENDIF
- ENDDO
- GO TO 26
- 16 IERR=1
- WRITE(6,*)' ERROR ON SUB. VSETB FOR LENGTH = ', ILENG
- WRITE(6,*)' AND ELEMENT = ' , IELEM
- 26 CONTINUE
- ENDDO
- IF(IERR.NE.1)WRITE(6,*)' SUBROUTINE VSETB OK '
-*
- WRITE(6,*)'1************************************* '
- WRITE(6,*)' TEST FOR NON LINEAR OPERATIONS .'
- WRITE(6,*)' ************************************* '
-*........................................................
-* TEST FOR SMOD3B SUBROUTINE
- IERR=0
- WRITE(6,*)' #####################################'
- WRITE(6,*)' TEST SMOD3B '
- DO J=1,3
- ILENG=NP(J)
- CALL NRANIN(54321.)
- CALL NRAN(VEC,ILENG)
-*
- CALL WHENFGT (ILENG,VEC,1,TSVAL,IVEC,NFOUND)
- CALL YLOSB (ILENG,VEC, TSVAL,VECB,IFOUND,'GT')
-
-*
- DO I=1,ILENG
- X(I)=I
- Y(I)=2*I
- Z(I)=3*I
- W(I)=-999.
- X1(I)=I
- Y1(I)=2*I
- Z1(I)=3*I
- W1(I)=-999.
- ENDDO
-
- CALL SMOD3B (ILENG,X,Y,Z,W,VECB)
- CALL SMOD3 (NFOUND,X1,Y1,Z1,W1,IVEC)
-
- DO I = 1,ILENG
- IF (W(I).NE.W1(I)) THEN
- IERR = 1
- WRITE(6,*)' ERROR ON SUBROUTINE SMOD3B FOR LENGTH = ', ILENG
- WRITE(6,*)' ELEMENT = ', I
- GOTO 401
- ENDIF
- ENDDO
- 401 CONTINUE
- ENDDO
-
- IF(IERR.NE.1)WRITE(6,*)' SUBROUTINE SMOD3B OK '
- WRITE(6,*)' #####################################'
- STOP
- END
diff --git a/src/mathlib/bvsl/test/vset.F b/src/mathlib/bvsl/test/vset.F
deleted file mode 100644
index 2cef3fa..0000000
--- a/src/mathlib/bvsl/test/vset.F
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: vset.F,v 1.1.1.1 1996/03/21 17:19:54 mclareni Exp $
-*
-* $Log: vset.F,v $
-* Revision 1.1.1.1 1996/03/21 17:19:54 mclareni
-* Bvsl
-*
-*
-*CMZ : 06/11/90 10.43.59 by Michel Roethlisberger/IBM
-*-- Author :
-*********************************************************************
-*CMZ : 04/05/90 16.17.27 by Michel Roethlisberger/IBM
-*-- Author :
- SUBROUTINE VSET(NW,IV,Y,S)
- DIMENSION IV(*),Y(*)
- DO I =1,NW
- Y(IV(I))=S
- ENDDO
- RETURN
- END
diff --git a/src/mathlib/bvsl/test/vxpy.F b/src/mathlib/bvsl/test/vxpy.F
deleted file mode 100644
index d9b586d..0000000
--- a/src/mathlib/bvsl/test/vxpy.F
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: vxpy.F,v 1.1.1.1 1996/03/21 17:19:54 mclareni Exp $
-*
-* $Log: vxpy.F,v $
-* Revision 1.1.1.1 1996/03/21 17:19:54 mclareni
-* Bvsl
-*
-*
-*CMZ : 06/11/90 10.43.59 by Michel Roethlisberger/IBM
-*-- Author :
-*********************************************************************
-*CMZ : 04/05/90 16.17.27 by Michel Roethlisberger/IBM
-*-- Author :
- SUBROUTINE VXPY(NW,IV,Y,X,V)
- DIMENSION IV(*),X(*),Y(*),V(*)
- DO I=1,NW
- Y(IV(I)) = Y(IV(I)) + V(IV(I))*X(IV(I))
- ENDDO
- RETURN
- END
diff --git a/src/mathlib/bvsl/test/xypwz.F b/src/mathlib/bvsl/test/xypwz.F
deleted file mode 100644
index 3d35c5a..0000000
--- a/src/mathlib/bvsl/test/xypwz.F
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: xypwz.F,v 1.1.1.1 1996/03/21 17:19:54 mclareni Exp $
-*
-* $Log: xypwz.F,v $
-* Revision 1.1.1.1 1996/03/21 17:19:54 mclareni
-* Bvsl
-*
-*
-*CMZ : 06/11/90 10.43.59 by Michel Roethlisberger/IBM
-*-- Author :
-*********************************************************************
-*CMZ : 04/05/90 16.17.27 by Michel Roethlisberger/IBM
-*-- Author :
- SUBROUTINE XYPWZ(NW,IV,S,Y,X,T,W,Z)
- DIMENSION IV(*),X(*),Y(*),W(*),Z(*)
- DO I= 1, NW
- Y(IV(I)) = S*X(IV(I))*Y(IV(I))+T*W(IV(I))*Z(IV(I))
- ENDDO
- RETURN
- END
diff --git a/src/mathlib/bvsl/test/yeqx.F b/src/mathlib/bvsl/test/yeqx.F
deleted file mode 100644
index b97dc52..0000000
--- a/src/mathlib/bvsl/test/yeqx.F
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: yeqx.F,v 1.1.1.1 1996/03/21 17:19:54 mclareni Exp $
-*
-* $Log: yeqx.F,v $
-* Revision 1.1.1.1 1996/03/21 17:19:54 mclareni
-* Bvsl
-*
-*
-*CMZ : 06/11/90 10.43.59 by Michel Roethlisberger/IBM
-*-- Author :
-*********************************************************************
-*CMZ : 04/05/90 16.17.27 by Michel Roethlisberger/IBM
-*-- Author :
- SUBROUTINE YEQX(ILENG,VEC,X,IY,NFOUND)
- DIMENSION VEC(*),X(*),IY(*)
-C
- NFOUND = 0
- DO J=1,ILENG
- IF(VEC(J).EQ.X(J)) THEN
- NFOUND = NFOUND+1
- IY(NFOUND) = J
- END IF
- ENDDO
- RETURN
- END
diff --git a/src/mathlib/bvsl/test/ygex.F b/src/mathlib/bvsl/test/ygex.F
deleted file mode 100644
index 839f8ca..0000000
--- a/src/mathlib/bvsl/test/ygex.F
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: ygex.F,v 1.1.1.1 1996/03/21 17:19:54 mclareni Exp $
-*
-* $Log: ygex.F,v $
-* Revision 1.1.1.1 1996/03/21 17:19:54 mclareni
-* Bvsl
-*
-*
-*CMZ : 06/11/90 10.44.00 by Michel Roethlisberger/IBM
-*-- Author :
-*********************************************************************
-*CMZ : 04/05/90 16.17.27 by Michel Roethlisberger/IBM
-*-- Author :
- SUBROUTINE YGEX(ILENG,VEC,X,IY,NFOUND)
- DIMENSION VEC(*),X(*),IY(*)
-C
- NFOUND = 0
- DO J=1,ILENG
- IF(VEC(J).GE.X(J)) THEN
- NFOUND = NFOUND+1
- IY(NFOUND) = J
- END IF
- ENDDO
- RETURN
- END
diff --git a/src/mathlib/bvsl/test/ygtx.F b/src/mathlib/bvsl/test/ygtx.F
deleted file mode 100644
index cf4326a..0000000
--- a/src/mathlib/bvsl/test/ygtx.F
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: ygtx.F,v 1.1.1.1 1996/03/21 17:19:54 mclareni Exp $
-*
-* $Log: ygtx.F,v $
-* Revision 1.1.1.1 1996/03/21 17:19:54 mclareni
-* Bvsl
-*
-*
-*CMZ : 06/11/90 10.44.00 by Michel Roethlisberger/IBM
-*-- Author :
-*********************************************************************
-*CMZ : 04/05/90 16.17.27 by Michel Roethlisberger/IBM
-*-- Author :
- SUBROUTINE YGTX(ILENG,VEC,X,IY,NFOUND)
- DIMENSION VEC(*),X(*),IY(*)
-C
- NFOUND = 0
- DO J=1,ILENG
- IF(VEC(J).GT.X(J)) THEN
- NFOUND = NFOUND+1
- IY(NFOUND) = J
- END IF
- ENDDO
- RETURN
- END
diff --git a/src/mathlib/bvsl/test/ylex.F b/src/mathlib/bvsl/test/ylex.F
deleted file mode 100644
index 1092515..0000000
--- a/src/mathlib/bvsl/test/ylex.F
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: ylex.F,v 1.1.1.1 1996/03/21 17:19:54 mclareni Exp $
-*
-* $Log: ylex.F,v $
-* Revision 1.1.1.1 1996/03/21 17:19:54 mclareni
-* Bvsl
-*
-*
-*CMZ : 06/11/90 10.44.00 by Michel Roethlisberger/IBM
-*-- Author :
-*********************************************************************
-*CMZ : 04/05/90 16.17.28 by Michel Roethlisberger/IBM
-*-- Author :
- SUBROUTINE YLEX(ILENG,VEC,X,IY,NFOUND)
- DIMENSION VEC(*),X(*),IY(*)
-C
- NFOUND = 0
- DO J=1,ILENG
- IF(VEC(J).LE.X(J)) THEN
- NFOUND = NFOUND+1
- IY(NFOUND) = J
- END IF
- ENDDO
- RETURN
- END
diff --git a/src/mathlib/bvsl/test/yltx.F b/src/mathlib/bvsl/test/yltx.F
deleted file mode 100644
index 467c7a1..0000000
--- a/src/mathlib/bvsl/test/yltx.F
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: yltx.F,v 1.1.1.1 1996/03/21 17:19:54 mclareni Exp $
-*
-* $Log: yltx.F,v $
-* Revision 1.1.1.1 1996/03/21 17:19:54 mclareni
-* Bvsl
-*
-*
-*CMZ : 06/11/90 10.44.00 by Michel Roethlisberger/IBM
-*-- Author :
-*********************************************************************
-*CMZ : 04/05/90 16.17.27 by Michel Roethlisberger/IBM
-*-- Author :
- SUBROUTINE YLTX(ILENG,VEC,X,IY,NFOUND)
- DIMENSION VEC(*),X(*),IY(*)
-C
- NFOUND = 0
- DO J=1,ILENG
- IF(VEC(J).LT.X(J)) THEN
- NFOUND = NFOUND+1
- IY(NFOUND) = J
- END IF
- ENDDO
- RETURN
- END
diff --git a/src/mathlib/bvsl/test/ynex.F b/src/mathlib/bvsl/test/ynex.F
deleted file mode 100644
index 93434de..0000000
--- a/src/mathlib/bvsl/test/ynex.F
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: ynex.F,v 1.1.1.1 1996/03/21 17:19:54 mclareni Exp $
-*
-* $Log: ynex.F,v $
-* Revision 1.1.1.1 1996/03/21 17:19:54 mclareni
-* Bvsl
-*
-*
-*CMZ : 06/11/90 10.44.00 by Michel Roethlisberger/IBM
-*-- Author :
-*********************************************************************
-*CMZ : 04/05/90 16.17.27 by Michel Roethlisberger/IBM
-*-- Author :
- SUBROUTINE YNEX(ILENG,VEC,X,IY,NFOUND)
- DIMENSION VEC(*),X(*),IY(*)
-C
- NFOUND = 0
- DO J=1,ILENG
- IF(VEC(J).NE.X(J)) THEN
- NFOUND = NFOUND+1
- IY(NFOUND) = J
- END IF
- ENDDO
- RETURN
- END
diff --git a/src/mathlib/gen/Imakefile b/src/mathlib/gen/Imakefile
deleted file mode 100644
index 20f67d6..0000000
--- a/src/mathlib/gen/Imakefile
+++ /dev/null
@@ -1,21 +0,0 @@
-
-DoIncludePackage(gen)
-
-#define IHaveSubdirs
-#define PassCDebugFlags
-
-#if defined(CERNLIB_SGI)
-IMAKE_DEFINES=-DFortranDoesCpp=NO
-#endif
-
-LIBDIRS= a b c d divon e f g h j m n s u v x
-
-SUBDIRS= $(LIBDIRS) gen tests
-
-TopOfPackage(gen)
-
-SubdirLibraryTarget(gen,$(LIBDIRS))
-
-TestSubdirs(tests)
-
-InstallIncludeSubdirs(gen)
diff --git a/src/mathlib/gen/a/Imakefile b/src/mathlib/gen/a/Imakefile
deleted file mode 100644
index 27f7f9b..0000000
--- a/src/mathlib/gen/a/Imakefile
+++ /dev/null
@@ -1,22 +0,0 @@
-DoIncludePackage(gen)
-#include "pilot.h"
-
-#if defined(CERNLIB_QF2C)
-
-SRCS_F= dreal.F
-
-#if !defined(CERNLIB_LINUX)
-SRCS_F= $(SRCS_F) dcmplx.F dconjg.F dimag.F gcmplx.F gconjg.F gimag.F greal.F
-#endif
-
-#endif
-
-#if defined(CERNLIB_SGI)
-IMAKE_DEFINES=-DFortranDoesCpp=NO
-#endif
-
-FORTRANSAVEOPTION = FortranSaveFlags
-
-SubdirLibraryTarget(NullParameter,NullParameter)
-
-
diff --git a/src/mathlib/gen/a/dcmplx.F b/src/mathlib/gen/a/dcmplx.F
deleted file mode 100644
index 1a260fd..0000000
--- a/src/mathlib/gen/a/dcmplx.F
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: dcmplx.F,v 1.1.1.1 1996/04/01 15:03:28 mclareni Exp $
-*
-* $Log: dcmplx.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:28 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if (defined(CERNLIB_QF2C))&&(!defined(CERNLIB_LINUX))
- SUBROUTINE DCMPLX(A,X,Y)
- DOUBLE PRECISION X,Y,A(2)
- A(1)=X
- A(2)=Y
- END
-#endif
diff --git a/src/mathlib/gen/a/dconjg.F b/src/mathlib/gen/a/dconjg.F
deleted file mode 100644
index a4a497a..0000000
--- a/src/mathlib/gen/a/dconjg.F
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: dconjg.F,v 1.1.1.1 1996/04/01 15:03:29 mclareni Exp $
-*
-* $Log: dconjg.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:29 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if (defined(CERNLIB_QF2C))&&(!defined(CERNLIB_LINUX))
- SUBROUTINE DCONJG(A,Z)
- DOUBLE PRECISION Z(2),A(2)
- A(1)=Z(1)
- A(2)=-Z(2)
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/a/dimag.F b/src/mathlib/gen/a/dimag.F
deleted file mode 100644
index 59f22ed..0000000
--- a/src/mathlib/gen/a/dimag.F
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: dimag.F,v 1.1.1.1 1996/04/01 15:03:28 mclareni Exp $
-*
-* $Log: dimag.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:28 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if (defined(CERNLIB_QF2C))&&(!defined(CERNLIB_LINUX))
- DOUBLE PRECISION FUNCTION DIMAG(Z)
- DOUBLE PRECISION Z(2)
- DIMAG=Z(2)
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/a/dreal.F b/src/mathlib/gen/a/dreal.F
deleted file mode 100644
index 4d529ce..0000000
--- a/src/mathlib/gen/a/dreal.F
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: dreal.F,v 1.1.1.1 1996/04/01 15:03:28 mclareni Exp $
-*
-* $Log: dreal.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:28 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_QF2C)
- DOUBLE PRECISION FUNCTION DREAL(Z)
- DOUBLE PRECISION Z(2)
- DREAL=Z(1)
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/a/gcmplx.F b/src/mathlib/gen/a/gcmplx.F
deleted file mode 100644
index 4c479a9..0000000
--- a/src/mathlib/gen/a/gcmplx.F
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: gcmplx.F,v 1.1.1.1 1996/04/01 15:03:29 mclareni Exp $
-*
-* $Log: gcmplx.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:29 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if (defined(CERNLIB_QF2C))&&(!defined(CERNLIB_LINUX))
- SUBROUTINE GCMPLX(A,X,Y)
- DOUBLE PRECISION X,Y,A(2)
- A(1)=X
- A(2)=Y
- END
-#endif
diff --git a/src/mathlib/gen/a/gconjg.F b/src/mathlib/gen/a/gconjg.F
deleted file mode 100644
index 1dc96bf..0000000
--- a/src/mathlib/gen/a/gconjg.F
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: gconjg.F,v 1.1.1.1 1996/04/01 15:03:29 mclareni Exp $
-*
-* $Log: gconjg.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:29 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if (defined(CERNLIB_QF2C))&&(!defined(CERNLIB_LINUX))
- SUBROUTINE GCONJG(A,Z)
- DOUBLE PRECISION Z(2),A(2)
- A(1)=Z(1)
- A(2)=-Z(2)
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/a/gimag.F b/src/mathlib/gen/a/gimag.F
deleted file mode 100644
index aef0eef..0000000
--- a/src/mathlib/gen/a/gimag.F
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: gimag.F,v 1.1.1.1 1996/04/01 15:03:29 mclareni Exp $
-*
-* $Log: gimag.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:29 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if (defined(CERNLIB_QF2C))&&(!defined(CERNLIB_LINUX))
- DOUBLE PRECISION FUNCTION GIMAG(Z)
- DOUBLE PRECISION Z(2)
- GIMAG=Z(2)
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/a/greal.F b/src/mathlib/gen/a/greal.F
deleted file mode 100644
index abc393b..0000000
--- a/src/mathlib/gen/a/greal.F
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: greal.F,v 1.1.1.1 1996/04/01 15:03:29 mclareni Exp $
-*
-* $Log: greal.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:29 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if (defined(CERNLIB_QF2C))&&(!defined(CERNLIB_LINUX))
- DOUBLE PRECISION FUNCTION GREAL(Z)
- DOUBLE PRECISION Z(2)
- GREAL=Z(1)
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/b/Imakefile b/src/mathlib/gen/b/Imakefile
deleted file mode 100644
index 0be457d..0000000
--- a/src/mathlib/gen/b/Imakefile
+++ /dev/null
@@ -1,22 +0,0 @@
-DoIncludePackage(gen)
-#include "pilot.h"
-
-SRCS_F= asinh64.F atg.F binom64.F dplnml.F prmfct.F rplnml.F rsrtnt64.F
-
-#if defined(CERNLIB_DOUBLE)
-SRCS_F:= $(SRCS_F) asinh.F binom.F rsrtnt.F
-#else
-SRCS_F:= $(SRCS_F) asinh128.F binom128.F rsrtnt128.F
-#endif
-
-#ifdef CERNLIB_HPUX
-FORTRANOPTIONS += -WF,-P
-#endif
-
-#if defined(CERNLIB_SGI)
-IMAKE_DEFINES=-DFortranDoesCpp=NO
-#endif
-
-FORTRANSAVEOPTION = FortranSaveFlags
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/mathlib/gen/b/asinh.F b/src/mathlib/gen/b/asinh.F
deleted file mode 100644
index 968569a..0000000
--- a/src/mathlib/gen/b/asinh.F
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: asinh.F,v 1.1.1.1 1996/04/01 15:01:50 mclareni Exp $
-*
-* $Log: asinh.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:50 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- FUNCTION ASINH(X)
-#include "gen/def64.inc"
- + D,DASINH
-
- SROUND(D)=D+(D-DBLE(SNGL(D)))
- ASINH=SROUND(DASINH(DBLE(X)))
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/b/asinh128.F b/src/mathlib/gen/b/asinh128.F
deleted file mode 100644
index 234307e..0000000
--- a/src/mathlib/gen/b/asinh128.F
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: asinh128.F,v 1.1.1.1 1996/04/01 15:01:50 mclareni Exp $
-*
-* $Log: asinh128.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:50 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION DASINH(X)
-C
-#include "gen/imp128.inc"
- CHARACTER*(*) NAME
- PARAMETER( NAME='DASINH')
- DASINH=0
- CALL MTLPRT(NAME,'B102.0','Not available on this machine')
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/b/asinh64.F b/src/mathlib/gen/b/asinh64.F
deleted file mode 100644
index 09a5549..0000000
--- a/src/mathlib/gen/b/asinh64.F
+++ /dev/null
@@ -1,68 +0,0 @@
-*
-* $Id: asinh64.F,v 1.1.1.1 1996/04/01 15:01:50 mclareni Exp $
-*
-* $Log: asinh64.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:50 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- FUNCTION DASINH(X)
-C
-#include "gen/imp64.inc"
-C
- CHARACTER*(*) NAME
- PARAMETER(NAME='DASINH')
-#endif
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION ASINH(X)
-C
- CHARACTER*(*) NAME
- PARAMETER(NAME='ASINH')
-#endif
- DIMENSION C(0:19)
-
- DATA C( 0) / 0.90649 39198 46333 18D0/
- DATA C( 1) /-0.02704 21478 78869 64D0/
- DATA C( 2) / 0.00211 68145 57973 56D0/
- DATA C( 3) /-0.00021 76650 54603 40D0/
- DATA C( 4) / 0.00002 55196 04364 81D0/
- DATA C( 5) /-0.00000 32329 14485 29D0/
- DATA C( 6) / 0.00000 04310 66959 88D0/
- DATA C( 7) /-0.00000 00596 06134 55D0/
- DATA C( 8) / 0.00000 00084 69211 32D0/
- DATA C( 9) /-0.00000 00012 29008 59D0/
- DATA C(10) / 0.00000 00001 81376 79D0/
- DATA C(11) /-0.00000 00000 27138 46D0/
- DATA C(12) / 0.00000 00000 04107 37D0/
- DATA C(13) /-0.00000 00000 00627 70D0/
- DATA C(14) / 0.00000 00000 00096 72D0/
- DATA C(15) /-0.00000 00000 00015 01D0/
- DATA C(16) / 0.00000 00000 00002 34D0/
- DATA C(17) /-0.00000 00000 00000 37D0/
- DATA C(18) / 0.00000 00000 00000 06D0/
- DATA C(19) /-0.00000 00000 00000 01D0/
-
- V=ABS(X)
- IF(V .LE. 1) THEN
- H=2*V**2-1
- ALFA=H+H
- B1=0
- B2=0
- DO 1 I = 19,0,-1
- B0=C(I)+ALFA*B1-B2
- B2=B1
- 1 B1=B0
- R=SIGN(V*(B0-B2),X)
- ELSE
- R=LOG(X+SQRT(1+X**2))
- ENDIF
-#if defined(CERNLIB_DOUBLE)
- DASINH=R
-#endif
-#if !defined(CERNLIB_DOUBLE)
- ASINH=R
-#endif
- RETURN
- END
diff --git a/src/mathlib/gen/b/atg.F b/src/mathlib/gen/b/atg.F
deleted file mode 100644
index e5ecf76..0000000
--- a/src/mathlib/gen/b/atg.F
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: atg.F,v 1.1.1.1 1996/04/01 15:01:49 mclareni Exp $
-*
-* $Log: atg.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:49 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- FUNCTION ATG(X1,X2)
-
- PARAMETER (PI = 3.14159 26535 89793D0)
-
- ATG=ATAN2(X1,X2)+(PI-SIGN(PI,X1))
- RETURN
- END
diff --git a/src/mathlib/gen/b/binom.F b/src/mathlib/gen/b/binom.F
deleted file mode 100644
index 9ac06bd..0000000
--- a/src/mathlib/gen/b/binom.F
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: binom.F,v 1.1.1.1 1996/04/01 15:01:49 mclareni Exp $
-*
-* $Log: binom.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:49 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- FUNCTION BINOM(X,K)
-#include "gen/def64.inc"
- + D,DBINOM
-
- SROUND(D)=D+(D-SNGL(D))
- BINOM=SROUND(DBINOM(DBLE(X),K))
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/b/binom128.F b/src/mathlib/gen/b/binom128.F
deleted file mode 100644
index bfb1b2c..0000000
--- a/src/mathlib/gen/b/binom128.F
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: binom128.F,v 1.1.1.1 1996/04/01 15:01:49 mclareni Exp $
-*
-* $Log: binom128.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:49 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION DBINOM(X)
-C
-#include "gen/imp128.inc"
- CHARACTER*(*) NAME
- PARAMETER( NAME='DBINOM')
- DBINOM=0
- CALL MTLPRT(NAME,'B100.0','Not available on this machine')
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/b/binom64.F b/src/mathlib/gen/b/binom64.F
deleted file mode 100644
index b881bd7..0000000
--- a/src/mathlib/gen/b/binom64.F
+++ /dev/null
@@ -1,81 +0,0 @@
-*
-* $Id: binom64.F,v 1.1.1.1 1996/04/01 15:01:49 mclareni Exp $
-*
-* $Log: binom64.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:49 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- FUNCTION DBINOM(X,K)
-#include "gen/imp64.inc"
-C PARAMETER (IMX = (2**31)-1)
- PARAMETER (IMX = 2147483647)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION BINOM(X,K)
-C PARAMETER (IMX = (2**31)-1)
- PARAMETER (IMX = 70368744177663)
-#endif
- CHARACTER NAME*(*)
- CHARACTER*80 ERRTXT
-
- PARAMETER (NAME = 'KBINOM')
-
- IF(K .LT. 0) THEN
- H=0
- ELSEIF(K .EQ. 0) THEN
- H=1
- ELSE
- H=X
- A=H
- DO 1 I = 2,K
- A=A-1
- 1 H=H*(A/I)
- ENDIF
-#if defined(CERNLIB_DOUBLE)
- DBINOM=H
-#endif
-#if !defined(CERNLIB_DOUBLE)
- BINOM=H
-#endif
- RETURN
-
- ENTRY KBINOM(N,K)
-
- 3 IF(N .GE. 0) THEN
- N1=N
- IS=1
- ELSE
- N1=K-N-1
- IS=(-1)**K
- ENDIF
- IF(K .LT. 0 .OR. K .GT. N1) THEN
- IH=0
- ELSEIF(K .EQ. 0 .OR. K .EQ. N1) THEN
- IH=IS
- ELSE
- IF(K+K .LE. N1) THEN
- K1=K
- ELSE
- K1=N1-K
- ENDIF
- H=N1
- A=H
- DO 2 I = 2,K1
- A=A-1
- 2 H=H*(A/I)
- IF(H .LE. IMX) THEN
- IH=IS*NINT(H)
- ELSE
- IH=0
- WRITE(ERRTXT,101) N,K
- CALL MTLPRT(NAME,'B100.1',ERRTXT)
- ENDIF
- ENDIF
- KBINOM=IH
- RETURN
- 101 FORMAT('INTEGER RANGE EXCEEDED, N =',I10,', K = ',I10)
- END
-
diff --git a/src/mathlib/gen/b/dplnml.F b/src/mathlib/gen/b/dplnml.F
deleted file mode 100644
index 603584e..0000000
--- a/src/mathlib/gen/b/dplnml.F
+++ /dev/null
@@ -1,63 +0,0 @@
-*
-* $Id: dplnml.F,v 1.1.1.1 1996/04/01 15:01:50 mclareni Exp $
-*
-* $Log: dplnml.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:50 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION DPLNML(DX,N,DA,MODE)
-#include "gen/imp128.inc"
- CHARACTER*6 NAME
- NAME = 'DPLNML'
- CALL MTLPRT(NAME,'B105',
- +'not available on this machine - see documentation')
- DPLNML=0.
- RETURN
- END
-#endif
-#if defined(CERNLIB_DOUBLE)
- FUNCTION DPLNML(DX,N,DA,MODE)
- DOUBLE PRECISION DPLNML,DX,DA,DS
-
- DIMENSION DA(0:*)
-
- DS=0
- IF(MODE .EQ. 1) THEN
- IF(N .GE. 0) DS=DA(N)
- DO 1 J = N-1,0,-1
- DS=DA(J)+DX*DS
- 1 CONTINUE
- ELSEIF(MODE .EQ. -1) THEN
- IF(N .GE. 0) DS=DA(0)
- DO 2 J = 1,N
- DS=DA(J)+DX*DS
- 2 CONTINUE
- ENDIF
- DPLNML=DS
- RETURN
- END
-
- FUNCTION WPLNML(WX,N,WA,MODE)
- COMPLEX*16 WPLNML,WX,WA,WS
-
- DIMENSION WA(0:*)
-
- WS=0
- IF(MODE .EQ. 1) THEN
- IF(N .GE. 0) WS=WA(N)
- DO 3 J = N-1,0,-1
- WS=WA(J)+WX*WS
- 3 CONTINUE
- ELSEIF(MODE .EQ. -1) THEN
- IF(N .GE. 0) WS=WA(0)
- DO 4 J = 1,N
- WS=WA(J)+WX*WS
- 4 CONTINUE
- ENDIF
- WPLNML=WS
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/b/prmfct.F b/src/mathlib/gen/b/prmfct.F
deleted file mode 100644
index 909c629..0000000
--- a/src/mathlib/gen/b/prmfct.F
+++ /dev/null
@@ -1,222 +0,0 @@
-*
-* $Id: prmfct.F,v 1.2 1997/04/08 14:11:55 mclareni Exp $
-*
-* $Log: prmfct.F,v $
-* Revision 1.2 1997/04/08 14:11:55 mclareni
-* 909th prime should be 7079
-*
-* Revision 1.1.1.1 1996/04/01 15:01:49 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE PRMFCT(MODE,N,NPRIME,NPOWER,M)
-
- PARAMETER (NPR = 1229)
- DIMENSION NPRIME(*),NPOWER(*),IPRIME(NPR)
-
- CHARACTER NAME*(*)
- CHARACTER*80 ERRTXT
- PARAMETER (NAME = 'PRMFCT')
-
- DATA (IPRIME(K),K=1,100)
- 1/ 2, 3, 5, 7, 11, 13, 17, 19, 23, 29, 31, 37,
- 2 41, 43, 47, 53, 59, 61, 67, 71, 73, 79, 83, 89,
- 3 97, 101, 103, 107, 109, 113, 127, 131, 137, 139, 149, 151,
- 4 157, 163, 167, 173, 179, 181, 191, 193, 197, 199, 211, 223,
- 5 227, 229, 233, 239, 241, 251, 257, 263, 269, 271, 277, 281,
- 6 283, 293, 307, 311, 313, 317, 331, 337, 347, 349, 353, 359,
- 7 367, 373, 379, 383, 389, 397, 401, 409, 419, 421, 431, 433,
- 8 439, 443, 449, 457, 461, 463, 467, 479, 487, 491, 499, 503,
- 9 509, 521, 523, 541/
-
- DATA (IPRIME(K),K=101,200)
- 1/ 547, 557, 563, 569, 571, 577, 587, 593, 599, 601, 607, 613,
- 2 617, 619, 631, 641, 643, 647, 653, 659, 661, 673, 677, 683,
- 3 691, 701, 709, 719, 727, 733, 739, 743, 751, 757, 761, 769,
- 4 773, 787, 797, 809, 811, 821, 823, 827, 829, 839, 853, 857,
- 5 859, 863, 877, 881, 883, 887, 907, 911, 919, 929, 937, 941,
- 6 947, 953, 967, 971, 977, 983, 991, 997,1009,1013,1019,1021,
- 7 1031,1033,1039,1049,1051,1061,1063,1069,1087,1091,1093,1097,
- 8 1103,1109,1117,1123,1129,1151,1153,1163,1171,1181,1187,1193,
- 9 1201,1213,1217,1223/
-
- DATA (IPRIME(K),K=201,300)
- 1/ 1229,1231,1237,1249,1259,1277,1279,1283,1289,1291,1297,1301,
- 2 1303,1307,1319,1321,1327,1361,1367,1373,1381,1399,1409,1423,
- 3 1427,1429,1433,1439,1447,1451,1453,1459,1471,1481,1483,1487,
- 4 1489,1493,1499,1511,1523,1531,1543,1549,1553,1559,1567,1571,
- 5 1579,1583,1597,1601,1607,1609,1613,1619,1621,1627,1637,1657,
- 6 1663,1667,1669,1693,1697,1699,1709,1721,1723,1733,1741,1747,
- 7 1753,1759,1777,1783,1787,1789,1801,1811,1823,1831,1847,1861,
- 8 1867,1871,1873,1877,1879,1889,1901,1907,1913,1931,1933,1949,
- 9 1951,1973,1979,1987/
-
- DATA (IPRIME(K),K=301,400)
- 1/ 1993,1997,1999,2003,2011,2017,2027,2029,2039,2053,2063,2069,
- 2 2081,2083,2087,2089,2099,2111,2113,2129,2131,2137,2141,2143,
- 3 2153,2161,2179,2203,2207,2213,2221,2237,2239,2243,2251,2267,
- 4 2269,2273,2281,2287,2293,2297,2309,2311,2333,2339,2341,2347,
- 5 2351,2357,2371,2377,2381,2383,2389,2393,2399,2411,2417,2423,
- 6 2437,2441,2447,2459,2467,2473,2477,2503,2521,2531,2539,2543,
- 7 2549,2551,2557,2579,2591,2593,2609,2617,2621,2633,2647,2657,
- 8 2659,2663,2671,2677,2683,2687,2689,2693,2699,2707,2711,2713,
- 9 2719,2729,2731,2741/
-
- DATA (IPRIME(K),K=401,500)
- 1/ 2749,2753,2767,2777,2789,2791,2797,2801,2803,2819,2833,2837,
- 2 2843,2851,2857,2861,2879,2887,2897,2903,2909,2917,2927,2939,
- 3 2953,2957,2963,2969,2971,2999,3001,3011,3019,3023,3037,3041,
- 4 3049,3061,3067,3079,3083,3089,3109,3119,3121,3137,3163,3167,
- 5 3169,3181,3187,3191,3203,3209,3217,3221,3229,3251,3253,3257,
- 6 3259,3271,3299,3301,3307,3313,3319,3323,3329,3331,3343,3347,
- 7 3359,3361,3371,3373,3389,3391,3407,3413,3433,3449,3457,3461,
- 8 3463,3467,3469,3491,3499,3511,3517,3527,3529,3533,3539,3541,
- 9 3547,3557,3559,3571/
-
- DATA (IPRIME(K),K=501,600)
- 1/ 3581,3583,3593,3607,3613,3617,3623,3631,3637,3643,3659,3671,
- 2 3673,3677,3691,3697,3701,3709,3719,3727,3733,3739,3761,3767,
- 3 3769,3779,3793,3797,3803,3821,3823,3833,3847,3851,3853,3863,
- 4 3877,3881,3889,3907,3911,3917,3919,3923,3929,3931,3943,3947,
- 5 3967,3989,4001,4003,4007,4013,4019,4021,4027,4049,4051,4057,
- 6 4073,4079,4091,4093,4099,4111,4127,4129,4133,4139,4153,4157,
- 7 4159,4177,4201,4211,4217,4219,4229,4231,4241,4243,4253,4259,
- 8 4261,4271,4273,4283,4289,4297,4327,4337,4339,4349,4357,4363,
- 9 4373,4391,4397,4409/
-
- DATA (IPRIME(K),K=601,700)
- 1/ 4421,4423,4441,4447,4451,4457,4463,4481,4483,4493,4507,4513,
- 2 4517,4519,4523,4547,4549,4561,4567,4583,4591,4597,4603,4621,
- 3 4637,4639,4643,4649,4651,4657,4663,4673,4679,4691,4703,4721,
- 4 4723,4729,4733,4751,4759,4783,4787,4789,4793,4799,4801,4813,
- 5 4817,4831,4861,4871,4877,4889,4903,4909,4919,4931,4933,4937,
- 6 4943,4951,4957,4967,4969,4973,4987,4993,4999,5003,5009,5011,
- 7 5021,5023,5039,5051,5059,5077,5081,5087,5099,5101,5107,5113,
- 8 5119,5147,5153,5167,5171,5179,5189,5197,5209,5227,5231,5233,
- 9 5237,5261,5273,5279/
-
- DATA (IPRIME(K),K=701,800)
- 1/ 5281,5297,5303,5309,5323,5333,5347,5351,5381,5387,5393,5399,
- 2 5407,5413,5417,5419,5431,5437,5441,5443,5449,5471,5477,5479,
- 3 5483,5501,5503,5507,5519,5521,5527,5531,5557,5563,5569,5573,
- 4 5581,5591,5623,5639,5641,5647,5651,5653,5657,5659,5669,5683,
- 5 5689,5693,5701,5711,5717,5737,5741,5743,5749,5779,5783,5791,
- 6 5801,5807,5813,5821,5827,5839,5843,5849,5851,5857,5861,5867,
- 7 5869,5879,5881,5897,5903,5923,5927,5939,5953,5981,5987,6007,
- 8 6011,6029,6037,6043,6047,6053,6067,6073,6079,6089,6091,6101,
- 9 6113,6121,6131,6133/
-
- DATA (IPRIME(K),K=801,900)
- 1/ 6143,6151,6163,6173,6197,6199,6203,6211,6217,6221,6229,6247,
- 2 6257,6263,6269,6271,6277,6287,6299,6301,6311,6317,6323,6329,
- 3 6337,6343,6353,6359,6361,6367,6373,6379,6389,6397,6421,6427,
- 4 6449,6451,6469,6473,6481,6491,6521,6529,6547,6551,6553,6563,
- 5 6569,6571,6577,6581,6599,6607,6619,6637,6653,6659,6661,6673,
- 6 6679,6689,6691,6701,6703,6709,6719,6733,6737,6761,6763,6779,
- 7 6781,6791,6793,6803,6823,6827,6829,6833,6841,6857,6863,6869,
- 8 6871,6883,6899,6907,6911,6917,6947,6949,6959,6961,6967,6971,
- 9 6977,6983,6991,6997/
-
- DATA (IPRIME(K),K=901,1000)
- 1/ 7001,7013,7019,7027,7039,7043,7057,7069,7079,7103,7109,7121,
- 2 7127,7129,7151,7159,7177,7187,7193,7207,7211,7213,7219,7229,
- 3 7237,7243,7247,7253,7283,7297,7307,7309,7321,7331,7333,7349,
- 4 7351,7369,7393,7411,7417,7433,7451,7457,7459,7477,7481,7487,
- 5 7489,7499,7507,7517,7523,7529,7537,7541,7547,7549,7559,7561,
- 6 7573,7577,7583,7589,7591,7603,7607,7621,7639,7643,7649,7669,
- 7 7673,7681,7687,7691,7699,7703,7717,7723,7727,7741,7753,7757,
- 8 7759,7789,7793,7817,7823,7829,7841,7853,7867,7873,7877,7879,
- 9 7883,7901,7907,7919/
-
- DATA (IPRIME(K),K=1001,1100)
- 1/ 7927,7933,7937,7949,7951,7963,7993,8009,8011,8017,8039,8053,
- 2 8059,8069,8081,8087,8089,8093,8101,8111,8117,8123,8147,8161,
- 3 8167,8171,8179,8191,8209,8219,8221,8231,8233,8237,8243,8263,
- 4 8269,8273,8287,8291,8293,8297,8311,8317,8329,8353,8363,8369,
- 5 8377,8387,8389,8419,8423,8429,8431,8443,8447,8461,8467,8501,
- 6 8513,8521,8527,8537,8539,8543,8563,8573,8581,8597,8599,8609,
- 7 8623,8627,8629,8641,8647,8663,8669,8677,8681,8689,8693,8699,
- 8 8707,8713,8719,8731,8737,8741,8747,8753,8761,8779,8783,8803,
- 9 8807,8819,8821,8831/
-
- DATA (IPRIME(K),K=1101,1200)
- 1/ 8837,8839,8849,8861,8863,8867,8887,8893,8923,8929,8933,8941,
- 2 8951,8963,8969,8971,8999,9001,9007,9011,9013,9029,9041,9043,
- 3 9049,9059,9067,9091,9103,9109,9127,9133,9137,9151,9157,9161,
- 4 9173,9181,9187,9199,9203,9209,9221,9227,9239,9241,9257,9277,
- 5 9281,9283,9293,9311,9319,9323,9337,9341,9343,9349,9371,9377,
- 6 9391,9397,9403,9413,9419,9421,9431,9433,9437,9439,9461,9463,
- 7 9467,9473,9479,9491,9497,9511,9521,9533,9539,9547,9551,9587,
- 8 9601,9613,9619,9623,9629,9631,9643,9649,9661,9677,9679,9689,
- 9 9697,9719,9721,9733/
-
- DATA (IPRIME(K),K=1201,1229)
- 1/ 9739,9743,9749,9767,9769,9781,9787,9791,9803,9811,9817,9829,
- 2 9833,9839,9851,9857,9859,9871,9883,9887,9901,9907,9923,9929,
- 3 9931,9941,9949,9967,9973/
-
- IF(MODE .NE. 0 .AND. MODE .NE. 1 .AND. MODE .NE. 2) THEN
- WRITE(ERRTXT,101) MODE
- CALL MTLPRT(NAME,'B002.1',ERRTXT)
- RETURN
- ELSEIF(MODE .EQ. 0) THEN
- IF(0 .LT. N .AND. N .LE. NPR) THEN
- DO 10 J = 1,N
- NPRIME(J)=IPRIME(J)
- 10 NPOWER(J)=1
- M=N
- ELSE
- WRITE(ERRTXT,102) N
- CALL MTLPRT(NAME,'B002.2',ERRTXT)
- ENDIF
- RETURN
- ELSE
- IF(N .LE. 1 .OR. N .GE. 10007) THEN
- WRITE(ERRTXT,102) N
- CALL MTLPRT(NAME,'B002.2',ERRTXT)
- RETURN
- ENDIF
- ENDIF
-
- N0=MIN(N,NPR)
- DO 7 J = 1,N0
- 7 NPRIME(J)=IPRIME(J)
- IF(N .GE. NPRIME(NPR)) THEN
- L=NPR
- GO TO 2
- ELSE
- DO 1 J = 1,N0
- IF(NPRIME(J) .GT. N) THEN
- L=J-1
- GO TO 2
- ELSEIF(NPRIME(J) .EQ. N) THEN
- L=J
- GO TO 2
- ENDIF
- 1 CONTINUE
- ENDIF
-
- 2 DO 3 J = 1,L
- 3 NPOWER(J)=0
- K0=N
- IF(MODE .EQ. 2) K0=2
- DO 4 K = K0,N
- N1=K
- DO 5 J = 1,L
- 6 IF(MOD(N1,NPRIME(J)) .EQ. 0) THEN
- NPOWER(J)=NPOWER(J)+1
- N1=N1/NPRIME(J)
- IF(N1 .EQ. 1) GO TO 4
- GO TO 6
- ENDIF
- 5 CONTINUE
- 4 CONTINUE
- DO 8 J = L,1,-1
- IF(NPOWER(J) .GT. 0) GO TO 9
- 8 CONTINUE
- 9 M=J
- RETURN
- 101 FORMAT('MODE = ',I5,' ILLEGAL')
- 102 FORMAT('N = ',I8,' ILLEGAL')
- END
diff --git a/src/mathlib/gen/b/rplnml.F b/src/mathlib/gen/b/rplnml.F
deleted file mode 100644
index 275021c..0000000
--- a/src/mathlib/gen/b/rplnml.F
+++ /dev/null
@@ -1,50 +0,0 @@
-*
-* $Id: rplnml.F,v 1.1.1.1 1996/04/01 15:01:50 mclareni Exp $
-*
-* $Log: rplnml.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:50 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- FUNCTION RPLNML(RX,N,RA,MODE)
- REAL RPLNML,RX,RA,RS
-
- DIMENSION RA(0:*)
-
- RS=0
- IF(MODE .EQ. 1) THEN
- IF(N .GE. 0) RS=RA(N)
- DO 1 J = N-1,0,-1
- RS=RA(J)+RX*RS
- 1 CONTINUE
- ELSEIF(MODE .EQ. -1) THEN
- IF(N .GE. 0) RS=RA(0)
- DO 2 J = 1,N
- RS=RA(J)+RX*RS
- 2 CONTINUE
- ENDIF
- RPLNML=RS
- RETURN
- END
-
- FUNCTION CPLNML(CX,N,CA,MODE)
- COMPLEX CPLNML,CX,CA,CS
-
- DIMENSION CA(0:*)
-
- CS=0
- IF(MODE .EQ. 1) THEN
- IF(N .GE. 0) CS=CA(N)
- DO 3 J = N-1,0,-1
- CS=CA(J)+CX*CS
- 3 CONTINUE
- ELSEIF(MODE .EQ. -1) THEN
- IF(N .GE. 0) CS=CA(0)
- DO 4 J = 1,N
- CS=CA(J)+CX*CS
- 4 CONTINUE
- ENDIF
- CPLNML=CS
- RETURN
- END
diff --git a/src/mathlib/gen/b/rsrtnt.F b/src/mathlib/gen/b/rsrtnt.F
deleted file mode 100644
index 4d42c60..0000000
--- a/src/mathlib/gen/b/rsrtnt.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: rsrtnt.F,v 1.1.1.1 1996/04/01 15:01:50 mclareni Exp $
-*
-* $Log: rsrtnt.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:50 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- SUBROUTINE RSRTNT(K,N,A,B,C,U1,V1,RES,LRL)
-#include "gen/def64.inc"
- + DRS,D
- LOGICAL LRL
-
- SROUND(D)=D+(D-SNGL(D))
- CALL DSRTNT(K,N,DBLE(A),DBLE(B),DBLE(C),DBLE(U1),DBLE(V1),DRS,LRL)
- RES=SROUND(DRS)
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/b/rsrtnt128.F b/src/mathlib/gen/b/rsrtnt128.F
deleted file mode 100644
index bf9c6ec..0000000
--- a/src/mathlib/gen/b/rsrtnt128.F
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: rsrtnt128.F,v 1.1.1.1 1996/04/01 15:01:51 mclareni Exp $
-*
-* $Log: rsrtnt128.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:51 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if !defined(CERNLIB_DOUBLE)
- SUBROUTINE DSRTNT(K,N,A,B,C,U1,V1,RES,LRL)
-C
-#include "gen/imp128.inc"
-C
- CHARACTER NAME*(*)
- PARAMETER (NAME = 'DSRTNT')
- CALL MTLPRT(NAME,'B300.0','Not available on this machine')
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/b/rsrtnt64.F b/src/mathlib/gen/b/rsrtnt64.F
deleted file mode 100644
index 238395a..0000000
--- a/src/mathlib/gen/b/rsrtnt64.F
+++ /dev/null
@@ -1,360 +0,0 @@
-*
-* $Id: rsrtnt64.F,v 1.2 2006/09/15 09:34:52 mclareni Exp $
-*
-* $Log: rsrtnt64.F,v $
-* Revision 1.2 2006/09/15 09:34:52 mclareni
-* Submitted mods for gcc4/gfortran and MacOSX, corrected to work also on slc4 with gcc3.4 and 4.1
-*
-* Revision 1.1.1.1 1996/04/01 15:01:51 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- SUBROUTINE DSRTNT(K,N,A,B,C,U1,V1,RES,LRL)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- SUBROUTINE RSRTNT(K,N,A,B,C,U1,V1,RES,LRL)
-#endif
-#include "gen/imp64.inc"
- LOGICAL LRL,LLL
- CHARACTER NAME*(*)
- CHARACTER*80 ERRTXT
-#if defined(CERNLIB_DOUBLE)
- PARAMETER (NAME = 'DSRTNT')
-#endif
-#if !defined(CERNLIB_DOUBLE)
- PARAMETER (NAME = 'RSRTNT')
-#endif
- PARAMETER (R1 = 1, HF = R1/2)
-
- DIMENSION BK(0:4,0:4),SGN(0:4)
-
- DATA BK(0,0) /1/, (BK(1,J),J=0,1) /1,1/, (BK(2,J),J=0,2) /1,2,1/
- DATA (BK(3,J),J=0,3) /1,3,3,1/, (BK(4,J),J=0,4) /1,4,6,4,1/
- DATA (SGN(J),J=0,4) /1,-1,1,-1,1/
-
- P(X)=A+B*X+C*X**2
- RT(X)=SQRT(P(X))
-
- H=0
- LLL=ABS(A)+ABS(B)+ABS(C) .GT. 0
- IF(.NOT.LLL) THEN
- CALL MTLPRT(NAME,'B300.1','A = B = C = 0')
- GO TO 9
- ENDIF
- LLL=ABS(K) .LE. 3 .AND. (N .EQ. 1 .OR. N .EQ. 3)
- IF(.NOT.LLL) THEN
- WRITE(ERRTXT,102) K,N
- CALL MTLPRT(NAME,'B300.2',ERRTXT)
- GO TO 9
- ENDIF
-
- U=MIN(U1,V1)
- V=MAX(U1,V1)
- LLL=U .EQ. V
- IF(LLL) GO TO 9
-
- LLL=K .GE. 0 .OR. K .EQ. -1 .AND. U*V .NE. 0
- 1 .OR. K .LE. -2 .AND. U*V .GT. 0
- IF(.NOT.LLL) GO TO 9
-
- DELTA=4*A*C-B**2
- RTD=SQRT(ABS(DELTA))
- IF(C .EQ. 0) THEN
- IF(B .LT. 0) THEN
- X0=-A/B
- LLL=U .LE. X0 .AND. V .LE. X0
- ELSEIF(B .EQ. 0) THEN
- LLL=A .GT. 0
- ELSE
- X0=-A/B
- LLL=U .GE. X0 .AND. V .GE. X0
- ENDIF
- ELSE
- IF(DELTA .GT. 0) THEN
- LLL=C .GT. 0
- ELSEIF(DELTA .EQ. 0) THEN
- IF(C .LT. 0) THEN
- LLL=.FALSE.
- ELSE
- X0=-B/(2*C)
- LLL=U .LT. X0 .AND. V .LT. X0 .OR. U .GT. X0 .AND. V .GT. X0
- ENDIF
- ELSE
- A1=(-B+RTD)/(2*C)
- A2=(-B-RTD)/(2*C)
- W1=MIN(A1,A2)
- W2=MAX(A1,A2)
- IF(C .LT. 0) THEN
- LLL=W1 .LE. U .AND. U .LE. W2 .AND. W1 .LE. V .AND. V .LE. W2
- ELSE
- LLL=U .LE. W1 .AND. V .LE. W1 .OR. U .GE. W2 .AND. V .GE. W2
- ENDIF
- ENDIF
- ENDIF
- IF(.NOT.LLL) GO TO 9
-
- IF(K .GE. 0) THEN
- IF(C .EQ. 0) THEN
- IF(B .EQ. 0) THEN
- K1=K+1
- H=(V**K1-U**K1)/(K1*SQRT(A)**N)
- ELSE
- N1=2-N
- XV=A+B*V
- XU=A+B*U
- IF(A .EQ. 0) THEN
- K1=2*K+N1
- H=2*(SQRT(XV)**K1-SQRT(XU)**K1)/(K1*B**(K+1))
- ELSE
- HV=SQRT(XV)**N1
- HU=SQRT(XU)**N1
- H1=-XV/A
- H2=-XU/A
- S=N1*(HV-HU)
- DO 1 J = 1,K
- 1 S=S+BK(K,J)*(H1**J*HV-H2**J*HU)/(2*J+N1)
- H=2*(-A/B)**K*S/B
- ENDIF
- ENDIF
- ELSE
- IF(N .EQ. 1) THEN
-#if !defined(CERNLIB_GFORTRAN)
- ASSIGN 11 TO JMP1
- GO TO 10
-#else
-#include "rsrtnt64p1.inc"
-#endif
- 11 IF(K .EQ. 0) THEN
- H=H
- ELSEIF(K .EQ. 1) THEN
- H=(RT(V)-RT(U)-HF*B*H)/C
- ELSEIF(K .EQ. 2) THEN
- H1=4*C
- H2=6*B
- H=((H1*V-H2)*RT(V)-(H1*U-H2)*RT(U)+(2*B**2-DELTA)*H)/(8*C**2)
- ELSEIF(K .EQ. 3) THEN
- H1=8*C**2
- H2=10*B*C
- G1=15*B**2
- G2=A*C
- H3=G1-16*G2
- H=(((H1*V-H2)*V+H3)*RT(V)-((H1*U-H2)*U+H3)*RT(U)-
- 1 (HF*G1-18*G2)*B*H)/(24*C**3)
- ENDIF
- ELSE
- IF(DELTA .EQ. 0) THEN
- IF(B .EQ. 0) THEN
- IF(K .EQ. 2) THEN
- H=LOG(ABS(V/U))/SQRT(C)**3
- ELSE
- K1=K-2
- H=(V**K1-U**K1)/(K1*SQRT(C)**3)
- ENDIF
- H=SIGN(R1,U)*H
- ELSE
- X0=B/(2*C)
- XV=V+X0
- XU=U+X0
- HV=1/XV**2
- HU=1/XU**2
- H1=-XV/X0
- H2=-XU/X0
- S=HF*(HU-HV)
- DO 2 J = 1,K
- IF(J .NE. 2) THEN
- S=S+BK(K,J)*(H1**J*HV-H2**J*HU)/(J-2)
- ELSE
- S=S+BK(K,2)*LOG(ABS(XV/XU))/X0**2
- ENDIF
- 2 CONTINUE
- H=(-X0)**K*S/SQRT(C)**3
- IF(U .LT. -X0) H=-H
- ENDIF
- ELSE
- IF(K .EQ. 0) THEN
- H1=2*C
- H=2*((H1*V+B)/RT(V)-(H1*U+B)/RT(U))/DELTA
- ELSEIF(K .EQ. 1) THEN
- H1=2*A
- H=2*((H1+B*U)/RT(U)-(H1+B*V)/RT(V))/DELTA
- LB1=11
- ELSEIF(K .EQ. 2) THEN
-#if !defined(CERNLIB_GFORTRAN)
- ASSIGN 12 TO JMP1
- GO TO 10
-#else
-#include "rsrtnt64p1.inc"
-#endif
- 12 H1=DELTA-B**2
- H2=2*A*B
- H=(((H1*U-H2)/RT(U)-(H1*V-H2)/RT(V))/DELTA+H)/C
- ELSEIF(K .EQ. 3) THEN
-#if !defined(CERNLIB_GFORTRAN)
- ASSIGN 13 TO JMP1
- GO TO 10
-#else
-#include "rsrtnt64p1.inc"
-#endif
- 13 H1=C*DELTA
- G1=A*C
- G2=3*B**2
- H2=B*(10*G1-G2)
- H3=A*(8*G1-G2)
- H=(2*(((H1*V+H2)*V+H3)/RT(V)-((H1*U+H2)*U+H3)/RT(U))/
- 1 DELTA-3*B*H)/(2*C**2)
- ENDIF
- ENDIF
- ENDIF
- ENDIF
- ELSE
- IF(A .EQ. 0) THEN
- IF(B .EQ. 0) THEN
- K1=K-N+1
- H=SIGN(R1,U)*(V**K1-U**K1)/(K1*SQRT(C)**N)
- ELSE
- IF(C .EQ. 0) THEN
- K1=2*K-N+2
- H=2*(SQRT(B*V)**K1-SQRT(B*U)**K1)/(K1*B**(K+1))
- ELSE
- XV=SQRT(C+B/V)
- XU=SQRT(C+B/U)
- N1=N-2
- K1=-K+N1
- S=0
- DO 4 J = 0,K1
- KJ=2*J-N1
- 4 S=S+SGN(J)*BK(K1,J)*(XU**KJ-XV**KJ)/(KJ*C**J)
- H=2*(-C/B)**K1*S/B
- IF(U .LT. 0 .AND. V .LT. 0) H=-H
- ENDIF
- ENDIF
- ELSE
- IF(N .EQ. 1) THEN
-#if !defined(CERNLIB_GFORTRAN)
- ASSIGN 21 TO JMP2
- GO TO 20
-#else
-#include "rsrtnt64p2.inc"
-#endif
- 21 IF(K .EQ. -1) THEN
- H=H
- ELSEIF(K .EQ. -2) THEN
- H=(RT(U)/U-RT(V)/V-HF*B*H)/A
- ELSEIF(K .EQ. -3) THEN
- H1=6*B
- H2=4*A
- H=((H1*V-H2)*RT(V)/V**2-(H1*U-H2)*RT(U)/U**2+
- 1 (3*B**2-H2*C)*H)/(8*A**2)
- ENDIF
- ELSE
- IF(DELTA .EQ. 0) THEN
- IF(C .EQ. 0) THEN
- IF(K .EQ. -1) THEN
- H=LOG(ABS(V/U))/SQRT(A)**3
- ELSE
- K1=K+1
- H=(V**K1-U**K1)/(K1*SQRT(A)**3)
- ENDIF
- ELSE
- X0=B/(2*C)
- XV=1+X0/V
- XU=1+X0/U
- K1=-K+1
- K2=-K-1
- S=0
- DO 3 J = 0,K1
- KJ=K2-J
- IF(KJ .NE. 0) THEN
- S=S+SGN(J)*BK(K1,J)*(XV**KJ-XU**KJ)/KJ
- ELSE
- S=S+SGN(K2)*BK(K1,K2)*LOG(ABS(XV/XU))
- ENDIF
- 3 CONTINUE
- H=-S/(SQRT(C)**3*X0**(K1+1))
- IF(U. LT. -X0) H=-H
- ENDIF
- ELSE
-#if !defined(CERNLIB_GFORTRAN)
- ASSIGN 22 TO JMP2
- GO TO 20
-#else
-#include "rsrtnt64p2.inc"
-#endif
- 22 IF(K .EQ. -1) THEN
- H1=B*C
- H2=B**2-2*A*C
- H=(2*((H1*U+H2)/RT(U)-(H1*V+H2)/RT(V))/DELTA+H)/A
- ELSEIF(K .EQ. -2) THEN
- G1=3*B**2
- G2=A*C
- H1=(G1-8*G2)*C
- H2=(G1-10*G2)*B
- H3=A*DELTA
- H=(((H1*V+H2-H3/V)/RT(V)-(H1*U+H2-H3/U)/RT(U))/DELTA
- 1 -3*HF*B*H)/A**2
- ELSEIF(K .EQ. -3) THEN
- G1=A*DELTA
- G2=A*C
- G3=B**2
- G4=15*G3
- H1=2*A*G1
- H2=5*B*G1
- H3=(G4-62*G2)*G3+24*G2**2
- H4=B*C*(G4-52*G2)
- H=((((H2-H1/V)/V-H3-H4*V)/RT(V)-((H2-H1/U)/U-H3-H4*U)/RT(U))
- 1 /DELTA+HF*(G4-12*G2)*H)/(4*A**3)
- ENDIF
- ENDIF
- ENDIF
- ENDIF
- ENDIF
-#if !defined(CERNLIB_GFORTRAN)
- GO TO 9
-
- 10 C2=2*C
- IF(DELTA .GT. 0 .OR. DELTA .LT. 0 .AND. C .GT. 0) THEN
- H=LOG(ABS((2*SQRT(C*P(V))+C2*V+B)/
- 1 (2*SQRT(C*P(U))+C2*U+B)))/SQRT(C)
- ELSEIF(DELTA .EQ. 0) THEN
- H=ABS(LOG(ABS((C2*V+B)/(C2*U+B))))/SQRT(C)
- ELSE
- H=(ASIN((C2*U+B)/RTD)-ASIN((C2*V+B)/RTD))/SQRT(-C)
- ENDIF
- GO TO JMP1, (11,12,13)
-
- 20 IF(C .EQ. 0) THEN
- IF(B .EQ. 0) THEN
- H=LOG(ABS(V/U))/SQRT(A)
- ELSE
- IF(A .LT. 0) THEN
- H=2*(ATAN(SQRT(-(A+B*V)/A))-ATAN(SQRT(-(A+B*U)/A)))/SQRT(-A)
- ELSE
- WA=SQRT(A)
- WU=SQRT(A+B*U)
- WV=SQRT(A+B*V)
- H=LOG(ABS((WV-WA)*(WU+WA)/((WV+WA)*(WU-WA))))/WA
- ENDIF
- ENDIF
- ELSE
- A2=2*A
- IF(DELTA .GT. 0 .OR. DELTA .LT. 0 .AND. A .GT. 0) THEN
- H=LOG(ABS((-2*SQRT(A*P(V))+B*V+A2)*U/
- 1 ((-2*SQRT(A*P(U))+B*U+A2)*V)))/SQRT(A)
- ELSEIF(DELTA .EQ. 0) THEN
- H=LOG(ABS((B*U+A2)*V/((B*V+A2)*U)))/SQRT(A)
- IF(U*V .GT. 0) H=SIGN(H,U)
- ELSE
- H=(ASIN((B*V+A2)/(V*RTD))-ASIN((B*U+A2)/(U*RTD)))/SQRT(-A)
- IF(U .LT. 0 .AND. V .LT. 0) H=-H
- ENDIF
- ENDIF
- GO TO JMP2, (21,22)
-#endif
-
- 9 RES=SIGN(R1,V1-U1)*H
- LRL=LLL
- RETURN
- 102 FORMAT('ILLEGAL VALUE(S) K = ',I5,', N = ',I5)
- END
diff --git a/src/mathlib/gen/b/rsrtnt64p1.inc b/src/mathlib/gen/b/rsrtnt64p1.inc
deleted file mode 100644
index 365ad61..0000000
--- a/src/mathlib/gen/b/rsrtnt64p1.inc
+++ /dev/null
@@ -1,9 +0,0 @@
- C2=2*C
- IF(DELTA .GT. 0 .OR. DELTA .LT. 0 .AND. C .GT. 0) THEN
- H=LOG(ABS((2*SQRT(C*P(V))+C2*V+B)/
- 1 (2*SQRT(C*P(U))+C2*U+B)))/SQRT(C)
- ELSEIF(DELTA .EQ. 0) THEN
- H=ABS(LOG(ABS((C2*V+B)/(C2*U+B))))/SQRT(C)
- ELSE
- H=(ASIN((C2*U+B)/RTD)-ASIN((C2*V+B)/RTD))/SQRT(-C)
- ENDIF
diff --git a/src/mathlib/gen/b/rsrtnt64p2.inc b/src/mathlib/gen/b/rsrtnt64p2.inc
deleted file mode 100644
index 60e7e8d..0000000
--- a/src/mathlib/gen/b/rsrtnt64p2.inc
+++ /dev/null
@@ -1,26 +0,0 @@
- IF(C .EQ. 0) THEN
- IF(B .EQ. 0) THEN
- H=LOG(ABS(V/U))/SQRT(A)
- ELSE
- IF(A .LT. 0) THEN
- H=2*(ATAN(SQRT(-(A+B*V)/A))-ATAN(SQRT(-(A+B*U)/A)))/SQRT(-A)
- ELSE
- WA=SQRT(A)
- WU=SQRT(A+B*U)
- WV=SQRT(A+B*V)
- H=LOG(ABS((WV-WA)*(WU+WA)/((WV+WA)*(WU-WA))))/WA
- ENDIF
- ENDIF
- ELSE
- A2=2*A
- IF(DELTA .GT. 0 .OR. DELTA .LT. 0 .AND. A .GT. 0) THEN
- H=LOG(ABS((-2*SQRT(A*P(V))+B*V+A2)*U/
- 1 ((-2*SQRT(A*P(U))+B*U+A2)*V)))/SQRT(A)
- ELSEIF(DELTA .EQ. 0) THEN
- H=LOG(ABS((B*U+A2)*V/((B*V+A2)*U)))/SQRT(A)
- IF(U*V .GT. 0) H=SIGN(H,U)
- ELSE
- H=(ASIN((B*V+A2)/(V*RTD))-ASIN((B*U+A2)/(U*RTD)))/SQRT(-A)
- IF(U .LT. 0 .AND. V .LT. 0) H=-H
- ENDIF
- ENDIF
diff --git a/src/mathlib/gen/c/Imakefile b/src/mathlib/gen/c/Imakefile
deleted file mode 100644
index 540af4f..0000000
--- a/src/mathlib/gen/c/Imakefile
+++ /dev/null
@@ -1,119 +0,0 @@
-DoIncludePackage(gen)
-#include "pilot.h"
-
-SRCS_F= aslgf64.F atani64.F besi064.F besj064.F bsir364.F bsir464.F \ @@\
- bsja64.F bzejy64.F c311bd.F cbsja64.F cdigam64.F celfun64.F \ @@\
- celint64.F cexpin64.F cgamma64.F cgplg64.F clogam64.F \ @@\
- clogok.F cpolyz64.F cpolyzd.F cpsipg.F crit.F csqrtk.F cwerf64.F \ @@\
- cwhitm64.F dawson64.F dbska64.F dclaus64.F dilog64.F elfun64.F \ @@\
- fconc64.F ferfr64.F freq64.F frsin64.F gagnc64.F \ @@\
- gammf64.F gapnc64.F hypgm.F leg1.F legfn.F legor.F legv.F \ @@\
- legz.F nic311.F nzerfz64.F qfunct.F reli164.F reli1c64.F \ @@\
- reli264.F reli364.F religc64.F relikc64.F rexpin64.F rgam.F \ @@\
- rmullz64.F rpsipg64.F rrizet64.F rrteq4.F rsnleq.F \ @@\
- rteq3.F rteq364.F rteq464.F rtheta64.F sinint64.F snleq64.F \ @@\
- strh064.F theta1.F trdz.F wpsipg.F zerox64.F
-
-#if defined(CERNLIB_DOUBLE)
-SRCS_F:= $(SRCS_F) atani.F besi0.F besj0.F bsir3.F bsir4.F bsja.F \ @@\
- cbsja.F cdigam.F celfun.F celint.F cexpin.F cgamma.F cgplg.F \ @@\
- clogam.F cwerf.F cwhitm.F freq.F gammf.F raslgf.F rbzejy.F \ @@\
- rclaus.F rdawsn.F rdilog.F relfun.F reli1.F reli1c.F rexpin.F \ @@\
- rfconc.F rferfr.F rfrsin.F rgapnc.F rmullz.F rpsipg.F rrizet.F \ @@\
- rsinin.F rstrh0.F rtheta.F rzerox.F r1dp.F r2dp.F r3dp.F r4dp.F \ @@\
- r5dp.F r6dp.F r7dp.F r8dp.F wclbes.F
-
-#if defined(CERNLIB_IBM)
-SRCS_F:= $(SRCS_F) alogam.F
-#else
-SRCS_F:= $(SRCS_F) gamma.F algama.F
-#endif
-
-#else
-SRCS_F:= $(SRCS_F) atani128.F aslgf128.F besi0128.F besj0128.F bsir3128.F \ @@\
- bsir4128.F bska.F dbska.F bzejy128.F cbsja128.F cdigam128.F \ @@\
- cexpin128.F cgplg128.F cgamma128.F clogam128.F cwerf128.F \ @@\
- cwhitm128.F dawson.F dawson128.F dclaus.F deli1128.F dilog.F \ @@\
- dilog128.F dpsipg128.F erf128.F fconc128.F ferdr128.F ferfr.F \ @@\
- rexpin128.F freq128.F frsin.F frsin128.F gammf128.F gapnc.F \ @@\
- gapnc128.F snleq128.F strh0.F strh0128.F reli1c128.F rmullz128.F \ @@\
- rteq3128.F rtheta128.F rteq4128.F sinint.F sinint128.F \ @@\
- welfun128.F zerox128.F
-#endif
-
-#if defined(CERNLIB_IBMVM)
-SRCS_F:= $(SRCS_F) cbsja128.F
-#endif
-
-
-#if defined(CERNLIB_SINGLE)
-SRCS_F:= $(SRCS_F) cclbes.F r1sp.F r2sp.F r3sp.F r4sp.F r5sp.F r6sp.F r7sp.F
-#endif
-
-
-#if defined(CERNLIB_QUAD)
-SRCS_F:= $(SRCS_F) gamma128.F algama128.F bsja128.F
-#endif
-
-#if defined(CERNLIB_IBM)
-SRCS_F:= $(SRCS_F) dlogam.F
-#else
-SRCS_F:= $(SRCS_F) gamma64.F algama64.F
-#endif
-
-/* The systems that don't have erf or not in a form that we can call
- particularly in pawcs.F */
-
-#if defined(CERNLIB_HPUX)
-SRCS_F:= $(SRCS_F) erf64.F erf.F
-#endif
-
-#if defined(CERNLIB_IBMRT)
-SRCS_F:= $(SRCS_F) erf64.F erf.F
-#endif
-
-#if defined(CERNLIB_SOLARIS)
-SRCS_F:= $(SRCS_F) erf64.F erf.F
-#endif
-
-#if defined(CERNLIB_WINNT)
-SRCS_F:= $(SRCS_F) erf64.F erf.F
-#endif
-
-#if defined(CERNLIB_LINUX)
-SRCS_F:= $(SRCS_F) erf64.F erf.F
-#endif
-
-#if defined(CERNLIB_VAXVMS)
-SRCS_F:= $(SRCS_F) erf64.F erf.F
-#endif
-
-/* End of erf section */
-
-#ifdef CERNLIB_HPUX
-FORTRANOPTIONS += -WF,-P
-#endif
-
-#if defined(CERNLIB_IBMRT)
-SpecialFortranLibObjectRule(cpolyz64,cpolyz64,NullParameter,NullParameter)
-#endif
-
-#if defined(CERNLIB_QFAPOGEE)
-/* without optimization compiler crashes */
-SpecialFortranLibObjectRule(clogam,clogam,'-O',NullParameter)
-SpecialFortranLibObjectRule(clogam64,clogam64,'-O',NullParameter)
-#endif
-
-#if defined(CERNLIB_SGI)
-IMAKE_DEFINES=-DFortranDoesCpp=NO
-#endif
-
-FORTRANSAVEOPTION = FortranSaveFlags
-
-SubdirLibraryTarget(NullParameter,NullParameter)
-
-#if defined(CERNLIB_QMVAOS)
-SpecialFortranLibObjectRule(cwhitm64,cwhitm64,-O,NullParameter)
-SpecialFortranLibObjectRule(nzerfz64,nzerfz64,-O,NullParameter)
-SpecialFortranLibObjectRule(wclbes,wclbes,-O,NullParameter)
-#endif
diff --git a/src/mathlib/gen/c/adigam.F b/src/mathlib/gen/c/adigam.F
deleted file mode 100644
index 1a33c4c..0000000
--- a/src/mathlib/gen/c/adigam.F
+++ /dev/null
@@ -1,99 +0,0 @@
-*
-* $Id: adigam.F,v 1.1.1.1 1996/04/01 15:02:13 mclareni Exp $
-*
-* $Log: adigam.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:13 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- FUNCTION ADIGAM(RX)
-#include "gen/def64.inc"
- + DDIGAM,DX,X,C(6),ZERO,ONE,HALF,C0,PI,A,V,H,R,P
- CHARACTER NAME*6
-
- DATA ZERO /0D0/, ONE /1D0/, HALF /0.5D0/, C0 /15D0/
-
- DATA PI /3.14159 26535 89793 24D0/
- DATA C(1) / 8.33333 33333 33333 33D-2/
- DATA C(2) /-8.33333 33333 33333 33D-3/
- DATA C(3) / 3.96825 39682 53968 25D-3/
- DATA C(4) /-4.16666 66666 66666 67D-3/
- DATA C(5) / 7.57575 75757 57575 76D-3/
- DATA C(6) /-2.10927 96092 79609 28D-2/
-
- X=RX
- NAME='ADIGAM'
- ADIGAM = ZERO
- 9 A=ABS(X)
- IF(-A .EQ. INT(X)) THEN
- WRITE(6,100) NAME,X
- RETURN
- END IF
- V=A
- H=ZERO
- IF(A .LT. C0) THEN
- H=ONE/V
- DO 1 I = 1,14-INT(A)
- V=V+ONE
- 1 H=H+ONE/V
- V=V+ONE
- END IF
- R=ONE/V**2
- P=R*C(1)
- DO 2 I = 6,1,-1
- 2 P=R*(C(I)+P)
- H=LOG(V)-HALF/V-P-H
- IF(X .LT. ZERO) H=H+ONE/A+PI/TAN(PI*A)
- IF(NAME .EQ. 'DDIGAM') THEN
- GO TO 10
- ELSE
- ADIGAM=SNGL(H+(H-DBLE(SNGL(H))))
- END IF
- RETURN
-
- ENTRY DDIGAM(DX)
- X=DX
- NAME='DDIGAM'
- DDIGAM = ZERO
- GO TO 9
- 10 DDIGAM = H
-
-
- 100 FORMAT(7X,'***** CERN C317 ',A6,' ... ARGUMENT EQUALS ',
- 1 'NON-POSITIVE INTEGER =',E10.1)
- END
-#endif
-#if defined(CERNLIB_SINGLE)
- FUNCTION ADIGAM(X)
- DIMENSION B(6)
- DATA PI /3.14159 26535 89793/
- DATA B /+8.33333 33333 33333E-2, -8.33333 33333 33333E-3,
- 1 +3.96825 39682 53968E-3, -4.16666 66666 66667E-3,
- 2 +7.57575 75757 57576E-3, -2.10927 96092 79609E-2/
- A=ABS(X)
- IF(-A .EQ. AINT(X)) GO TO 4
- V=A
- H=0.
- IF(A .GE. 15.0) GO TO 3
- N=14-INT(A)
- H=1.0/V
- IF(N .EQ. 0) GO TO 2
- DO 1 I = 1,N
- V=V+1.0
- 1 H=H+1.0/V
- 2 V=V+1.0
- 3 R=1.0/V**2
- ADIGAM=LOG(V)-0.5/V-R*(B(1)+R*(B(2)+R*(B(3)+R*(B(4)+R*(B(5)+R*
- 1 (B(6)+R*B(1)))))))-H
- IF(X .GE. 0.0) RETURN
- H=PI*A
- ADIGAM=ADIGAM+1.0/A+PI*COS(H)/SIN(H)
- RETURN
- 4 WRITE(6,100)X
- ADIGAM=0.
- RETURN
- 100 FORMAT(' ADIGAM ... ARGUMENT IS NON-POSITIVE INTEGER =',F20.2)
- END
-#endif
diff --git a/src/mathlib/gen/c/algama.F b/src/mathlib/gen/c/algama.F
deleted file mode 100644
index 65a7862..0000000
--- a/src/mathlib/gen/c/algama.F
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: algama.F,v 1.1.1.1 1996/04/01 15:01:54 mclareni Exp $
-*
-* $Log: algama.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:54 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if (defined(CERNLIB_DOUBLE))&&(!defined(CERNLIB_IBM))
- FUNCTION ALGAMA(X)
- DOUBLE PRECISION DLGAMA,D
-
- ENTRY ALOGAM(X)
-
- SROUND(D)=D+(D-SNGL(D))
- ALGAMA=SROUND(DLGAMA(DBLE(X)))
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/c/algama128.F b/src/mathlib/gen/c/algama128.F
deleted file mode 100644
index 5edfe58..0000000
--- a/src/mathlib/gen/c/algama128.F
+++ /dev/null
@@ -1,137 +0,0 @@
-*
-* $Id: algama128.F,v 1.1.1.1 1996/04/01 15:01:54 mclareni Exp $
-*
-* $Log: algama128.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:54 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_QUAD)
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION DLGAMA(X)
-#endif
-#if defined(CERNLIB_DOUBLE)
- FUNCTION QLGAMA(X)
-#endif
-#include "gen/imp128.inc"
- CHARACTER NAME*(*)
- CHARACTER*80 ERRTXT
-#if defined(CERNLIB_DOUBLE)
- PARAMETER (NAME = 'QLGAMA')
- DIMENSION C(0:27)
-
- PARAMETER (AL2 = 0.69314 71805 59945 30941 72321 21458 18Q0)
-
- DATA C( 0) / 0.52854 30369 82234 59886 70146 10587 97Q0/
- DATA C( 1) / 0.54987 64461 21414 11418 47224 01104 36Q0/
- DATA C( 2) / 0.02073 98006 16136 65135 91673 63567 71Q0/
- DATA C( 3) /-0.00056 91677 04215 43842 38953 35739 98Q0/
- DATA C( 4) / 0.00002 32458 72104 00168 83522 53120 41Q0/
- DATA C( 5) /-0.00000 11306 07585 70393 43721 97663 24Q0/
- DATA C( 6) / 0.00000 00606 56530 98948 08283 26590 28Q0/
- DATA C( 7) /-0.00000 00034 62843 57769 83164 91206 97Q0/
- DATA C( 8) / 0.00000 00002 06249 98805 67913 53392 37Q0/
- DATA C( 9) /-0.00000 00000 12663 51115 66776 12652 22Q0/
- DATA C(10) / 0.00000 00000 00795 31006 91836 38345 01Q0/
- DATA C(11) /-0.00000 00000 00050 82076 64160 41154 37Q0/
- DATA C(12) / 0.00000 00000 00003 29187 26043 65876 53Q0/
- DATA C(13) /-0.00000 00000 00000 21555 55420 93157 81Q0/
- DATA C(14) / 0.00000 00000 00000 01423 99484 99073 76Q0/
- DATA C(15) /-0.00000 00000 00000 00094 75908 48729 10Q0/
- DATA C(16) / 0.00000 00000 00000 00006 34422 73080 16Q0/
- DATA C(17) /-0.00000 00000 00000 00000 42694 88760 51Q0/
- DATA C(18) / 0.00000 00000 00000 00000 02885 95426 13Q0/
- DATA C(19) /-0.00000 00000 00000 00000 00195 82123 61Q0/
- DATA C(20) / 0.00000 00000 00000 00000 00013 33140 05Q0/
- DATA C(21) /-0.00000 00000 00000 00000 00000 91025 69Q0/
- DATA C(22) / 0.00000 00000 00000 00000 00000 06231 33Q0/
- DATA C(23) /-0.00000 00000 00000 00000 00000 00427 57Q0/
- DATA C(24) / 0.00000 00000 00000 00000 00000 00029 40Q0/
- DATA C(25) /-0.00000 00000 00000 00000 00000 00002 02Q0/
- DATA C(26) / 0.00000 00000 00000 00000 00000 00000 14Q0/
- DATA C(27) /-0.00000 00000 00000 00000 00000 00000 01Q0/
-
- PARAMETER (FM = 1Q20)
-
-#endif
-#if !defined(CERNLIB_DOUBLE)
- PARAMETER (NAME = 'DLGAMA')
- DIMENSION C(0:25)
-
- PARAMETER (AL2 = 0.69314 71805 59945 30941 72321 21458 18D0)
-
- DATA C( 0) / 0.52854 30369 82234 59886 70146 10587 97D0/
- DATA C( 1) / 0.54987 64461 21414 11418 47224 01104 36D0/
- DATA C( 2) / 0.02073 98006 16136 65135 91673 63567 71D0/
- DATA C( 3) /-0.00056 91677 04215 43842 38953 35739 98D0/
- DATA C( 4) / 0.00002 32458 72104 00168 83522 53120 41D0/
- DATA C( 5) /-0.00000 11306 07585 70393 43721 97663 24D0/
- DATA C( 6) / 0.00000 00606 56530 98948 08283 26590 28D0/
- DATA C( 7) /-0.00000 00034 62843 57769 83164 91206 97D0/
- DATA C( 8) / 0.00000 00002 06249 98805 67913 53392 37D0/
- DATA C( 9) /-0.00000 00000 12663 51115 66776 12652 22D0/
- DATA C(10) / 0.00000 00000 00795 31006 91836 38345 01D0/
- DATA C(11) /-0.00000 00000 00050 82076 64160 41154 37D0/
- DATA C(12) / 0.00000 00000 00003 29187 26043 65876 53D0/
- DATA C(13) /-0.00000 00000 00000 21555 55420 93157 81D0/
- DATA C(14) / 0.00000 00000 00000 01423 99484 99073 76D0/
- DATA C(15) /-0.00000 00000 00000 00094 75908 48729 10D0/
- DATA C(16) / 0.00000 00000 00000 00006 34422 73080 16D0/
- DATA C(17) /-0.00000 00000 00000 00000 42694 88760 51D0/
- DATA C(18) / 0.00000 00000 00000 00000 02885 95426 13D0/
- DATA C(19) /-0.00000 00000 00000 00000 00195 82123 61D0/
- DATA C(20) / 0.00000 00000 00000 00000 00013 33140 05D0/
- DATA C(21) /-0.00000 00000 00000 00000 00000 91025 69D0/
- DATA C(22) / 0.00000 00000 00000 00000 00000 06231 33D0/
- DATA C(23) /-0.00000 00000 00000 00000 00000 00427 57D0/
- DATA C(24) / 0.00000 00000 00000 00000 00000 00029 40D0/
- DATA C(25) /-0.00000 00000 00000 00000 00000 00002 02D0/
-
- PARAMETER (FM = 1D20)
-#endif
-
- U=X
- IF(X .LE. 0) THEN
- H=0
- WRITE(ERRTXT,101) X
- CALL MTLPRT(NAME,'C304.1',ERRTXT)
- GO TO 9
- ENDIF
- F=1
- IF(U .LT. 3) THEN
- DO 1 I = 1,INT(4-U)
- F=F/U
- 1 U=U+1
- FL=LOG(F)+AL2
- ELSE
- FL=AL2
- DO 2 I = 1,INT(U-3)
- U=U-1
- F=F*U
- IF(F .GT. FM) THEN
- FL=FL+LOG(F)
- F=1
- ENDIF
- 2 CONTINUE
- FL=FL+LOG(F)
- END IF
- H=U+U-7
- ALFA=H+H
- B1=0
- B2=0
- DO 3 I = 27,0,-1
- B0=C(I)+ALFA*B1-B2
- B2=B1
- 3 B1=B0
- H=FL+B0-H*B2
-#if defined(CERNLIB_DOUBLE)
- 9 QLGAMA=H
-#endif
-#if !defined(CERNLIB_DOUBLE)
- 9 DLGAMA=H
-#endif
- RETURN
- 101 FORMAT('ARGUMENT IS NEGATIVE = ',1P,E15.1)
- END
-#endif
diff --git a/src/mathlib/gen/c/algama64.F b/src/mathlib/gen/c/algama64.F
deleted file mode 100644
index 466b934..0000000
--- a/src/mathlib/gen/c/algama64.F
+++ /dev/null
@@ -1,122 +0,0 @@
-*
-* $Id: algama64.F,v 1.1.1.1 1996/04/01 15:01:54 mclareni Exp $
-*
-* $Log: algama64.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:54 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if !defined(CERNLIB_IBM)
-#if defined(CERNLIB_DOUBLE)
- FUNCTION DLGAMA(X)
-C
-#include "gen/imp64.inc"
-C
- CHARACTER*(*) NAME
- PARAMETER(NAME='ALGAMA/DLGAMA')
-#endif
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION ALGAMA(X)
-C
- CHARACTER*(*) NAME
- PARAMETER(NAME='ALGAMA')
-#endif
-C
- DIMENSION P1(7),Q1(7),P2(7),Q2(7),P3(7),Q3(7),C(5)
-
- PARAMETER (Z1 = 1, HF = Z1/2, HF1 = 1+HF)
- CHARACTER*80 ERRTXT
- DATA P1
- 1/+3.84287 36567 45991D+0, +5.27068 93753 00983D+1,
- 2 +5.55840 45723 51531D+1, -2.15135 13573 72570D+2,
- 3 -2.45872 61722 29242D+2, -5.75008 93603 04123D+1,
- 4 -2.33590 98949 51284D+0/
- DATA Q1
- 1/+1.00000 00000 00000D+0, +3.37330 47907 07074D+1,
- 2 +1.93877 84034 37713D+2, +3.08829 54973 42428D+2,
- 3 +1.50068 39064 89095D+2, +2.01068 51344 33395D+1,
- 4 +4.57174 20282 50299D-1/
- DATA P2
- 1/+4.87402 01396 83863 6D+0, +2.48845 25168 57407 6D+2,
- 2 +2.17973 66058 89591 5D+3, +3.79751 24011 52511 8D+3,
- 3 -1.97780 70769 84164 6D+3, -3.69298 34005 59128 2D+3,
- 4 -5.60177 73537 80387 7D+2/
- DATA Q2
- 1/+1.00000 00000 00000 0D+0, +9.50999 17418 20893 8D+1,
- 2 +1.56120 45277 92863 5D+3, +7.23400 87928 94807 1D+3,
- 3 +1.04595 76594 05895 9D+4, +4.16994 15153 20023 1D+3,
- 4 +2.76785 83623 80410 1D+2/
- DATA P3
- 1/-6.88062 40094 59425D+3, -4.30699 69819 57098D+5,
- 2 -4.75045 94653 43956D+6, -2.94234 45930 32234D+6,
- 3 +3.63218 04931 54257D+7, -3.35677 82814 54576D+6,
- 4 -2.48043 69488 28593D+7/
- DATA Q3
- 1/+1.00000 00000 00000D+0, -1.42168 29839 65146D+3,
- 2 -1.55528 90280 85353D+5, -3.41525 17108 01107D+6,
- 3 -2.09696 23255 80444D+7, -3.45441 75093 34395D+7,
- 4 -9.16055 82863 71317D+6/
- DATA C
- 1/ 1.12249 21356 561D-1, 7.95916 92961 204D-2,
- 1 -1.70877 94611 020D-3, 9.18938 53320 467D-1,
- 2 1.34699 05627 879D+0/
-
-
-#if defined(CERNLIB_DOUBLE)
- ENTRY DLOGAM(X)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- ENTRY ALOGAM(X)
-#endif
-
- IF(X .LE. 0) THEN
- H=0
- WRITE(ERRTXT,101) X
- CALL MTLPRT(NAME,'C304.1',ERRTXT)
- ELSE IF(X .EQ. 1 .OR. X .EQ. 2) THEN
- H=0
- ELSE IF(X .LE. HF) THEN
- Y=X+1
- AP=P1(1)
- AQ=Q1(1)
- DO 2 I = 2,7
- AP=P1(I)+Y*AP
- 2 AQ=Q1(I)+Y*AQ
- H=-LOG(X)+X*AP/AQ
- ELSE IF(X .LE. HF1) THEN
- AP=P1(1)
- AQ=Q1(1)
- DO 3 I = 2,7
- AP=P1(I)+X*AP
- 3 AQ=Q1(I)+X*AQ
- H=(X-1)*AP/AQ
- ELSE IF(X .LE. 4) THEN
- AP=P2(1)
- AQ=Q2(1)
- DO 4 I = 2,7
- AP=P2(I)+X*AP
- 4 AQ=Q2(I)+X*AQ
- H=(X-2)*AP/AQ
- ELSE IF(X .LE. 12) THEN
- AP=P3(1)
- AQ=Q3(1)
- DO 5 I = 2,7
- AP=P3(I)+X*AP
- 5 AQ=Q3(I)+X*AQ
- H=AP/AQ
- ELSE
- Y=1/X**2
- H=(X-HF)*LOG(X)-X+C(4)+(C(1)+Y*(C(2)+Y*C(3)))/
- 1 ((C(5)+Y)*X)
- ENDIF
-#if defined(CERNLIB_DOUBLE)
- DLGAMA=H
-#endif
-#if !defined(CERNLIB_DOUBLE)
- ALGAMA=H
-#endif
- RETURN
- 101 FORMAT('NON-POSITIVE ARGUMENT X = ',1P,E15.6)
- END
-#endif
diff --git a/src/mathlib/gen/c/alogam.F b/src/mathlib/gen/c/alogam.F
deleted file mode 100644
index c3b26f2..0000000
--- a/src/mathlib/gen/c/alogam.F
+++ /dev/null
@@ -1,14 +0,0 @@
-*
-* $Id: alogam.F,v 1.1.1.1 1996/04/01 15:01:54 mclareni Exp $
-*
-* $Log: alogam.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:54 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if (defined(CERNLIB_DOUBLE))&&(defined(CERNLIB_IBM))
- FUNCTION ALOGAM(X)
- ALOGAM = ALGAMA(X)
- END
-#endif
diff --git a/src/mathlib/gen/c/aslgf128.F b/src/mathlib/gen/c/aslgf128.F
deleted file mode 100644
index ab094a2..0000000
--- a/src/mathlib/gen/c/aslgf128.F
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: aslgf128.F,v 1.1.1.1 1996/04/01 15:02:04 mclareni Exp $
-*
-* $Log: aslgf128.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:04 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if !defined(CERNLIB_DOUBLE)
- SUBROUTINE DASLGF(MODE,X,MS,NL,P)
-C
-#include "gen/imp128.inc"
-C
- CHARACTER*(*) NAME
- PARAMETER( NAME='DASLGF')
- CALL MTLPRT(NAME,'C330.0','Not available on this machine')
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/c/aslgf64.F b/src/mathlib/gen/c/aslgf64.F
deleted file mode 100644
index 1386298..0000000
--- a/src/mathlib/gen/c/aslgf64.F
+++ /dev/null
@@ -1,149 +0,0 @@
-*
-* $Id: aslgf64.F,v 1.1.1.1 1996/04/01 15:02:04 mclareni Exp $
-*
-* $Log: aslgf64.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:04 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if !defined(CERNLIB_DOUBLE)
- SUBROUTINE RASLGF(MODE,X,MS,NL,P)
-#endif
-#if defined(CERNLIB_DOUBLE)
- SUBROUTINE DASLGF(MODE,X,MS,NL,P)
-#include "gen/imp64.inc"
-#endif
- CHARACTER NAME*(*)
- CHARACTER*80 ERRTXT
-#if !defined(CERNLIB_DOUBLE)
- PARAMETER (NAME = 'RASLGF')
-#endif
-#if defined(CERNLIB_DOUBLE)
- PARAMETER (NAME = 'RASLGF/DASLGF')
-#endif
-#if defined(CERNLIB_VAX)
- PARAMETER (ML=33)
-#endif
-#if !defined(CERNLIB_VAX)
- PARAMETER (ML=55)
-#endif
- DIMENSION P(0:*),FCT(0:ML)
-
- PARAMETER (Z1 = 1, HF = Z1/2)
-
- DATA FCT( 0) /0.100000000000000000D+01/
- DATA FCT( 1) /0.100000000000000000D+01/
- DATA FCT( 2) /0.200000000000000000D+01/
- DATA FCT( 3) /0.600000000000000000D+01/
- DATA FCT( 4) /0.240000000000000000D+02/
- DATA FCT( 5) /0.120000000000000000D+03/
- DATA FCT( 6) /0.720000000000000000D+03/
- DATA FCT( 7) /0.504000000000000000D+04/
- DATA FCT( 8) /0.403200000000000000D+05/
- DATA FCT( 9) /0.362880000000000000D+06/
- DATA FCT(10) /0.362880000000000000D+07/
- DATA FCT(11) /0.399168000000000000D+08/
- DATA FCT(12) /0.479001600000000000D+09/
- DATA FCT(13) /0.622702080000000000D+10/
- DATA FCT(14) /0.871782912000000000D+11/
- DATA FCT(15) /0.130767436800000000D+13/
- DATA FCT(16) /0.209227898880000000D+14/
- DATA FCT(17) /0.355687428096000000D+15/
- DATA FCT(18) /0.640237370572800000D+16/
- DATA FCT(19) /0.121645100408832000D+18/
- DATA FCT(20) /0.243290200817664000D+19/
- DATA FCT(21) /0.510909421717094400D+20/
- DATA FCT(22) /0.112400072777760768D+22/
- DATA FCT(23) /0.258520167388849766D+23/
- DATA FCT(24) /0.620448401733239439D+24/
- DATA FCT(25) /0.155112100433309860D+26/
- DATA FCT(26) /0.403291461126605636D+27/
- DATA FCT(27) /0.108888694504183522D+29/
- DATA FCT(28) /0.304888344611713861D+30/
- DATA FCT(29) /0.884176199373970195D+31/
- DATA FCT(30) /0.265252859812191059D+33/
- DATA FCT(31) /0.822283865417792282D+34/
- DATA FCT(32) /0.263130836933693530D+36/
- DATA FCT(33) /0.868331761881188650D+37/
-#if !defined(CERNLIB_VAX)
- DATA FCT(34) /0.295232799039604141D+39/
- DATA FCT(35) /0.103331479663861449D+41/
- DATA FCT(36) /0.371993326789901217D+42/
- DATA FCT(37) /0.137637530912263450D+44/
- DATA FCT(38) /0.523022617466601112D+45/
- DATA FCT(39) /0.203978820811974434D+47/
- DATA FCT(40) /0.815915283247897734D+48/
- DATA FCT(41) /0.334525266131638071D+50/
- DATA FCT(42) /0.140500611775287990D+52/
- DATA FCT(43) /0.604152630633738356D+53/
- DATA FCT(44) /0.265827157478844877D+55/
- DATA FCT(45) /0.119622220865480195D+57/
- DATA FCT(46) /0.550262215981208895D+58/
- DATA FCT(47) /0.258623241511168181D+60/
- DATA FCT(48) /0.124139155925360727D+62/
- DATA FCT(49) /0.608281864034267561D+63/
- DATA FCT(50) /0.304140932017133780D+65/
- DATA FCT(51) /0.155111875328738228D+67/
- DATA FCT(52) /0.806581751709438786D+68/
- DATA FCT(53) /0.427488328406002556D+70/
- DATA FCT(54) /0.230843697339241380D+72/
- DATA FCT(55) /0.126964033536582759D+74/
-#endif
-
-#if !defined(CERNLIB_DOUBLE)
- ENTRY ASLGF(MODE,X,MS,NL,P)
-#endif
- 10 IF(ABS(X) .GT. 1) THEN
- WRITE(ERRTXT,101) X
- CALL MTLPRT(NAME,'C330.1',ERRTXT)
- RETURN
- ENDIF
- IF(MODE .NE. 1 .AND. MODE .NE. 2) THEN
- WRITE(ERRTXT,102) MODE
- CALL MTLPRT(NAME,'C330.2',ERRTXT)
- RETURN
- ENDIF
-
- M=ABS(MS)
- IF(M .EQ. 0) THEN
- IF(NL .LT. 0 .OR. NL .GT. 100) THEN
- WRITE(ERRTXT,103) MS,NL
- CALL MTLPRT(NAME,'C330.3',ERRTXT)
- RETURN
- ENDIF
- P(0)=1
- P(1)=X
- DO 1 N = 1,NL-1
- 1 P(N+1)=((2*N+1)*X*P(N)-N*P(N-1))/(N+1)
- IF(MODE .EQ. 2) THEN
- DO 2 N = 0,NL
- 2 P(N)=SQRT(N+HF)*P(N)
- ENDIF
- ELSE
- IF(NL .LT. 0 .OR. M .GT. 27 .OR. NL .GT. ML-M) THEN
- WRITE(ERRTXT,103) MS,NL
- CALL MTLPRT(NAME,'C330.3',ERRTXT)
- RETURN
- ENDIF
- DO 3 N = 0,M-1
- 3 P(N)=0
- P(M)=HF**M*FCT(2*M)/FCT(M)
- DO 4 N = M,NL-1
- 4 P(N+1)=((2*N+1)*X*P(N)-(N+M)*P(N-1))/(N-M+1)
- R=SQRT(1-X**2)**M
- DO 5 N = M,NL
- 5 P(N)=R*P(N)
- IF(MODE .EQ. 2) THEN
- DO 6 N = M,NL
- 6 P(N)=SQRT((N+HF)*(FCT(N-M)/FCT(N+M)))*P(N)
- ELSEIF(MS .LT. 0) THEN
- DO 7 N = M,NL
- 7 P(N)=(FCT(N-M)/FCT(N+M))*P(N)
- ENDIF
- ENDIF
- RETURN
- 101 FORMAT('INCORRECT ARGUMENT X = ',1P,E15.6)
- 102 FORMAT('INCORRECT MODE = ',I5)
- 103 FORMAT('INDICES M = ',I5,' OR NL = ',I5,' NOT PERMITTED')
- END
diff --git a/src/mathlib/gen/c/atani.F b/src/mathlib/gen/c/atani.F
deleted file mode 100644
index 717819f..0000000
--- a/src/mathlib/gen/c/atani.F
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: atani.F,v 1.1.1.1 1996/04/01 15:02:03 mclareni Exp $
-*
-* $Log: atani.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:03 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- FUNCTION ATANI(X)
-#include "gen/def64.inc"
- + DATANI,D
-
- SROUND(D)=D+(D-SNGL(D))
- ATANI=SROUND(DATANI(DBLE(X)))
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/c/atani128.F b/src/mathlib/gen/c/atani128.F
deleted file mode 100644
index 8be2055..0000000
--- a/src/mathlib/gen/c/atani128.F
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: atani128.F,v 1.1.1.1 1996/04/01 15:02:03 mclareni Exp $
-*
-* $Log: atani128.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:03 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION DATANI(X)
-#include "gen/imp128.inc"
- CHARACTER*(*) NAME
- PARAMETER( NAME ='DATANI')
- DATANI=0
- CALL MTLPRT(NAME1,'C324.0','Not available on this machine')
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/c/atani64.F b/src/mathlib/gen/c/atani64.F
deleted file mode 100644
index 6b01649..0000000
--- a/src/mathlib/gen/c/atani64.F
+++ /dev/null
@@ -1,66 +0,0 @@
-*
-* $Id: atani64.F,v 1.1.1.1 1996/04/01 15:02:03 mclareni Exp $
-*
-* $Log: atani64.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:03 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION ATANI(X)
-#endif
-#if defined(CERNLIB_DOUBLE)
- FUNCTION DATANI(X)
-#include "gen/imp64.inc"
-#endif
- DIMENSION C(0:18)
-
- PARAMETER (PI = 3.14159 26535 89793 24D0, PIH = PI/2)
-
- DATA C( 0) / 0.93432 00492 92895 95D0/
- DATA C( 1) /-0.01950 47944 34351 90D0/
- DATA C( 2) / 0.00125 17037 06300 59D0/
- DATA C( 3) /-0.00011 19241 41205 64D0/
- DATA C( 4) / 0.00001 17754 53855 07D0/
- DATA C( 5) /-0.00000 13652 83304 87D0/
- DATA C( 6) / 0.00000 01688 82892 74D0/
- DATA C( 7) /-0.00000 00218 80246 51D0/
- DATA C( 8) / 0.00000 00029 35063 61D0/
- DATA C( 9) /-0.00000 00004 04523 41D0/
- DATA C(10) / 0.00000 00000 56976 00D0/
- DATA C(11) /-0.00000 00000 08168 83D0/
- DATA C(12) / 0.00000 00000 01188 69D0/
- DATA C(13) /-0.00000 00000 00175 16D0/
- DATA C(14) / 0.00000 00000 00026 09D0/
- DATA C(15) /-0.00000 00000 00003 92D0/
- DATA C(16) / 0.00000 00000 00000 59D0/
- DATA C(17) /-0.00000 00000 00000 09D0/
- DATA C(18) / 0.00000 00000 00000 01D0/
-
- V=ABS(X)
- IF(V .LE. 1) THEN
- R=0
- Y=V
- ELSE
- R=PIH*LOG(V)
- Y=1/V
- END IF
- H=2*Y**2-1
- ALFA=H+H
- B1=0
- B2=0
- DO 1 I = 18,0,-1
- B0=C(I)+ALFA*B1-B2
- B2=B1
- 1 B1=B0
- R=R+Y*(B0-B2)
- IF(X .LT. 0) R=-R
-#if !defined(CERNLIB_DOUBLE)
- ATANI=R
-#endif
-#if defined(CERNLIB_DOUBLE)
- DATANI=R
-#endif
- RETURN
- END
diff --git a/src/mathlib/gen/c/besi0.F b/src/mathlib/gen/c/besi0.F
deleted file mode 100644
index 54f56ee..0000000
--- a/src/mathlib/gen/c/besi0.F
+++ /dev/null
@@ -1,46 +0,0 @@
-*
-* $Id: besi0.F,v 1.1.1.1 1996/04/01 15:02:00 mclareni Exp $
-*
-* $Log: besi0.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:00 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- FUNCTION BESI0(X)
- IMPLICIT DOUBLE PRECISION (D)
-
- SROUND(D)=D+(D-SNGL(D))
- BESI0=SROUND(DBESI0(DBLE(X)))
- RETURN
-
- ENTRY BESI1(X)
- BESI1=SROUND(DBESI1(DBLE(X)))
- RETURN
-
- ENTRY EBESI0(X)
- EBESI0=SROUND(DEBSI0(DBLE(X)))
- RETURN
-
- ENTRY EBESI1(X)
- EBESI1=SROUND(DEBSI1(DBLE(X)))
- RETURN
-
- ENTRY BESK0(X)
- BESK0=SROUND(DBESK0(DBLE(X)))
- RETURN
-
- ENTRY BESK1(X)
- BESK1=SROUND(DBESK1(DBLE(X)))
- RETURN
-
- ENTRY EBESK0(X)
- EBESK0=SROUND(DEBSK0(DBLE(X)))
- RETURN
-
- ENTRY EBESK1(X)
- EBESK1=SROUND(DEBSK1(DBLE(X)))
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/c/besi0128.F b/src/mathlib/gen/c/besi0128.F
deleted file mode 100644
index 80d349e..0000000
--- a/src/mathlib/gen/c/besi0128.F
+++ /dev/null
@@ -1,61 +0,0 @@
-*
-* $Id: besi0128.F,v 1.1.1.1 1996/04/01 15:02:00 mclareni Exp $
-*
-* $Log: besi0128.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:00 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION DBESI0(X)
-#include "gen/imp128.inc"
- CHARACTER*(*) NAME1, NAME2, NAME3, NAME4,
- + NAME5, NAME6, NAME7, NAME8
- PARAMETER( NAME1='DBESI0')
- PARAMETER( NAME2='DEBSI0')
- PARAMETER( NAME3='DBESI1')
- PARAMETER( NAME4='DEBSI1')
- PARAMETER( NAME5='DBESK0')
- PARAMETER( NAME6='DEBSK0')
- PARAMETER( NAME7='DBESK1')
- PARAMETER( NAME8='DEBSK1')
- CALL MTLPRT(NAME1,'C313.0','Not available on this machine')
- RETURN
-
- ENTRY DEBSI0(X)
- DEBSI0=0
- CALL MTLPRT(NAME2,'C313.0','Not available on this machine')
- RETURN
-
- ENTRY DBESI1(X)
- DBESI1=0
- CALL MTLPRT(NAME3,'C313.0','Not available on this machine')
- RETURN
-
- ENTRY DEBSI1(X)
- DEBSI1=0
- CALL MTLPRT(NAME4,'C313.0','Not available on this machine')
- RETURN
-
- ENTRY DBESK0(X)
- DBESK0=0
- CALL MTLPRT(NAME5,'C313.0','Not available on this machine')
- RETURN
-
- ENTRY DEBSK0(X)
- DEBSK0=0
- CALL MTLPRT(NAME6,'C313.0','Not available on this machine')
- RETURN
-
- ENTRY DBESK1(X)
- DBESK1=0
- CALL MTLPRT(NAME7,'C313.0','Not available on this machine')
- RETURN
-
- ENTRY DEBSK1(X)
- DEBSK1=0
- CALL MTLPRT(NAME8,'C313.0','Not available on this machine')
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/c/besi064.F b/src/mathlib/gen/c/besi064.F
deleted file mode 100644
index cd1a825..0000000
--- a/src/mathlib/gen/c/besi064.F
+++ /dev/null
@@ -1,351 +0,0 @@
-*
-* $Id: besi064.F,v 1.1.1.1 1996/04/01 15:02:00 mclareni Exp $
-*
-* $Log: besi064.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:00 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION BESI0(X)
-#endif
-#if defined(CERNLIB_DOUBLE)
- FUNCTION DBESI0(X)
-#include "gen/imp64.inc"
-#endif
- LOGICAL LEX
- CHARACTER NAME0*(*),NAME1*(*),NAME0E*(*),NAME1E*(*)
- CHARACTER*80 ERRTXT
- DIMENSION CI(0:24,0:1),CK(0:16,0:1)
-
-#if !defined(CERNLIB_DOUBLE)
- PARAMETER (NAME0 = 'BESK0', NAME0E = 'EBESK0')
- PARAMETER (NAME1 = 'BESK1', NAME1E = 'EBESK1')
-#endif
-#if defined(CERNLIB_DOUBLE)
- PARAMETER (NAME0 = 'BESK0/DBESK0', NAME0E = 'EBESK0/DBESK0')
- PARAMETER (NAME1 = 'BESK1/DBESK1', NAME1E = 'EBESK1/DBESK1')
-#endif
- PARAMETER (EPS=1D-15)
- PARAMETER (Z1 = 1, HF = Z1/2)
- PARAMETER (PI = 3.14159 26535 89793 24D0)
- PARAMETER (CE = 0.57721 56649 01532 86D0)
- PARAMETER (PIH = PI/2, RPIH = 2/PI, RPI2 = 1/(2*PI))
-
- DATA CI( 0,0) /+1.00827 92054 58740 032D0/
- DATA CI( 1,0) /+0.00844 51226 24920 943D0/
- DATA CI( 2,0) /+0.00017 27006 30777 567D0/
- DATA CI( 3,0) /+0.00000 72475 91099 959D0/
- DATA CI( 4,0) /+0.00000 05135 87726 878D0/
- DATA CI( 5,0) /+0.00000 00568 16965 808D0/
- DATA CI( 6,0) /+0.00000 00085 13091 223D0/
- DATA CI( 7,0) /+0.00000 00012 38425 364D0/
- DATA CI( 8,0) /+0.00000 00000 29801 672D0/
- DATA CI( 9,0) /-0.00000 00000 78956 698D0/
- DATA CI(10,0) /-0.00000 00000 33127 128D0/
- DATA CI(11,0) /-0.00000 00000 04497 339D0/
- DATA CI(12,0) /+0.00000 00000 01799 790D0/
- DATA CI(13,0) /+0.00000 00000 00965 748D0/
- DATA CI(14,0) /+0.00000 00000 00038 604D0/
- DATA CI(15,0) /-0.00000 00000 00104 039D0/
- DATA CI(16,0) /-0.00000 00000 00023 950D0/
- DATA CI(17,0) /+0.00000 00000 00009 554D0/
- DATA CI(18,0) /+0.00000 00000 00004 443D0/
- DATA CI(19,0) /-0.00000 00000 00000 859D0/
- DATA CI(20,0) /-0.00000 00000 00000 709D0/
- DATA CI(21,0) /+0.00000 00000 00000 087D0/
- DATA CI(22,0) /+0.00000 00000 00000 112D0/
- DATA CI(23,0) /-0.00000 00000 00000 012D0/
- DATA CI(24,0) /-0.00000 00000 00000 018D0/
-
- DATA CI( 0,1) /+0.97580 06023 26285 926D0/
- DATA CI( 1,1) /-0.02446 74429 63276 385D0/
- DATA CI( 2,1) /-0.00027 72053 60763 829D0/
- DATA CI( 3,1) /-0.00000 97321 46728 020D0/
- DATA CI( 4,1) /-0.00000 06297 24238 640D0/
- DATA CI( 5,1) /-0.00000 00659 61142 154D0/
- DATA CI( 6,1) /-0.00000 00096 13872 919D0/
- DATA CI( 7,1) /-0.00000 00014 01140 901D0/
- DATA CI( 8,1) /-0.00000 00000 47563 167D0/
- DATA CI( 9,1) /+0.00000 00000 81530 681D0/
- DATA CI(10,1) /+0.00000 00000 35408 148D0/
- DATA CI(11,1) /+0.00000 00000 05102 564D0/
- DATA CI(12,1) /-0.00000 00000 01804 409D0/
- DATA CI(13,1) /-0.00000 00000 01023 594D0/
- DATA CI(14,1) /-0.00000 00000 00052 678D0/
- DATA CI(15,1) /+0.00000 00000 00107 094D0/
- DATA CI(16,1) /+0.00000 00000 00026 120D0/
- DATA CI(17,1) /-0.00000 00000 00009 561D0/
- DATA CI(18,1) /-0.00000 00000 00004 713D0/
- DATA CI(19,1) /+0.00000 00000 00000 829D0/
- DATA CI(20,1) /+0.00000 00000 00000 743D0/
- DATA CI(21,1) /-0.00000 00000 00000 080D0/
- DATA CI(22,1) /-0.00000 00000 00000 117D0/
- DATA CI(23,1) /+0.00000 00000 00000 011D0/
- DATA CI(24,1) /+0.00000 00000 00000 019D0/
-
- DATA CK( 0,0) /+0.98840 81742 30825 800D0/
- DATA CK( 1,0) /-0.01131 05046 46928 281D0/
- DATA CK( 2,0) /+0.00026 95326 12762 724D0/
- DATA CK( 3,0) /-0.00001 11066 85196 665D0/
- DATA CK( 4,0) /+0.00000 06325 75108 500D0/
- DATA CK( 5,0) /-0.00000 00450 47337 641D0/
- DATA CK( 6,0) /+0.00000 00037 92996 456D0/
- DATA CK( 7,0) /-0.00000 00003 64547 179D0/
- DATA CK( 8,0) /+0.00000 00000 39043 756D0/
- DATA CK( 9,0) /-0.00000 00000 04579 936D0/
- DATA CK(10,0) /+0.00000 00000 00580 811D0/
- DATA CK(11,0) /-0.00000 00000 00078 832D0/
- DATA CK(12,0) /+0.00000 00000 00011 360D0/
- DATA CK(13,0) /-0.00000 00000 00001 727D0/
- DATA CK(14,0) /+0.00000 00000 00000 275D0/
- DATA CK(15,0) /-0.00000 00000 00000 046D0/
- DATA CK(16,0) /+0.00000 00000 00000 008D0/
-
- DATA CK( 0,1) /+1.03595 08587 72358 331D0/
- DATA CK( 1,1) /+0.03546 52912 43331 114D0/
- DATA CK( 2,1) /-0.00046 84750 28166 889D0/
- DATA CK( 3,1) /+0.00001 61850 63810 053D0/
- DATA CK( 4,1) /-0.00000 08451 72048 124D0/
- DATA CK( 5,1) /+0.00000 00571 32218 103D0/
- DATA CK( 6,1) /-0.00000 00046 45554 607D0/
- DATA CK( 7,1) /+0.00000 00004 35417 339D0/
- DATA CK( 8,1) /-0.00000 00000 45757 297D0/
- DATA CK( 9,1) /+0.00000 00000 05288 133D0/
- DATA CK(10,1) /-0.00000 00000 00662 613D0/
- DATA CK(11,1) /+0.00000 00000 00089 048D0/
- DATA CK(12,1) /-0.00000 00000 00012 726D0/
- DATA CK(13,1) /+0.00000 00000 00001 921D0/
- DATA CK(14,1) /-0.00000 00000 00000 305D0/
- DATA CK(15,1) /+0.00000 00000 00000 050D0/
- DATA CK(16,1) /-0.00000 00000 00000 009D0/
-
- NU=0
- LEX=.FALSE.
- GO TO 6
-
-#if !defined(CERNLIB_DOUBLE)
- ENTRY EBESI0(X)
-#endif
-#if defined(CERNLIB_DOUBLE)
- ENTRY DEBSI0(X)
-#endif
- NU=0
- LEX=.TRUE.
- GO TO 6
-
-#if !defined(CERNLIB_DOUBLE)
- ENTRY BESI1(X)
-#endif
-#if defined(CERNLIB_DOUBLE)
- ENTRY DBESI1(X)
-#endif
- NU=1
- LEX=.FALSE.
- GO TO 6
-
-#if !defined(CERNLIB_DOUBLE)
- ENTRY EBESI1(X)
-#endif
-#if defined(CERNLIB_DOUBLE)
- ENTRY DEBSI1(X)
-#endif
- NU=1
- LEX=.TRUE.
-
- 6 V=ABS(X)
- IF(V .LT. 8) THEN
- Y=(HF*V)**2
- XL=NU+2
- A0=1
- A1=1+2*Y/((XL+1)*(XL-1))
- A2=1+Y*(4+3*Y/((XL+2)*XL))/((XL+3)*(XL-1))
- B0=1
- B1=1-Y/(XL+1)
- B2=1-Y*(1-Y/(2*(XL+2)))/(XL+3)
- W1=3+XL
- V1=3-XL
- V3=XL-1
- V2=V3+V3
- C=0
- DO 3 N = 3,30
- C0=C
- FN=N
- W1=W1+2
- W2=W1-1
- W3=W2-1
- W4=W3-1
- W5=W4-1
- W6=W5-1
- V1=V1+1
- V2=V2+1
- V3=V3+1
- U1=FN*W4
- E=V3/(U1*W3)
- U2=E*Y
- F1=1+Y*V1/(U1*W1)
- F2=(1+Y*V2/(V3*W2*W5))*U2
- F3=-Y*Y*U2/(W4*W5*W5*W6)
- A=F1*A2+F2*A1+F3*A0
- B=F1*B2+F2*B1+F3*B0
- C=A/B
- IF(ABS(C0-C) .LT. EPS*ABS(C)) GO TO 4
- A0=A1
- A1=A2
- A2=A
- B0=B1
- B1=B2
- B2=B
- 3 CONTINUE
- 4 H=C
- IF(NU .EQ. 1) H=HF*X*H
- IF(LEX) H=EXP(-V)*H
- ELSE
- R=1/V
- H=16*R-1
- ALFA=H+H
- B1=0
- B2=0
- DO 1 I = 24,0,-1
- B0=CI(I,NU)+ALFA*B1-B2
- B2=B1
- 1 B1=B0
- H=SQRT(RPI2*R)*(B0-H*B2)
- IF(NU*X .LT. 0) H=-H
- IF(.NOT.LEX) H=EXP(V)*H
- ENDIF
- GO TO 9
-
-#if !defined(CERNLIB_DOUBLE)
- ENTRY BESK0(X)
-#endif
-#if defined(CERNLIB_DOUBLE)
- ENTRY DBESK0(X)
-#endif
- NU=0
- LEX=.FALSE.
- GO TO 8
-
-#if !defined(CERNLIB_DOUBLE)
- ENTRY EBESK0(X)
-#endif
-#if defined(CERNLIB_DOUBLE)
- ENTRY DEBSK0(X)
-#endif
- NU=0
- LEX=.TRUE.
- GO TO 8
-
-#if !defined(CERNLIB_DOUBLE)
- ENTRY BESK1(X)
-#endif
-#if defined(CERNLIB_DOUBLE)
- ENTRY DBESK1(X)
-#endif
- NU=1
- LEX=.FALSE.
- GO TO 8
-
-#if !defined(CERNLIB_DOUBLE)
- ENTRY EBESK1(X)
-#endif
-#if defined(CERNLIB_DOUBLE)
- ENTRY DEBSK1(X)
-#endif
- NU=1
- LEX=.TRUE.
-
- 8 IF(X .LE. 0) THEN
- H=0
- WRITE(ERRTXT,101) X
- IF(NU .EQ. 0 .AND. .NOT.LEX) CALL MTLPRT(NAME0 ,'C313.1',ERRTXT)
- IF(NU .EQ. 0 .AND. LEX) CALL MTLPRT(NAME0E,'C313.1',ERRTXT)
- IF(NU .EQ. 1 .AND. .NOT.LEX) CALL MTLPRT(NAME1 ,'C313.1',ERRTXT)
- IF(NU .EQ. 1 .AND. LEX) CALL MTLPRT(NAME1E,'C313.1',ERRTXT)
- ELSEIF(X .LT. 1) THEN
- B=HF*X
- BK=-(LOG(B)+CE)
- F=BK
- P=HF
- Q=HF
- C=1
- D=B**2
- BK1=P
- DO 11 N = 1,15
- FN=N
- RFN=1/FN
- P=P*RFN
- Q=Q*RFN
- F=(F+P+Q)*RFN
- C=C*D*RFN
- G=C*(P-FN*F)
- H=C*F
- BK=BK+H
- BK1=BK1+G
- IF(BK1*H+ABS(G)*BK .LE. EPS*BK*BK1) GO TO 12
- 11 CONTINUE
- 12 H=BK
- IF(NU .EQ. 1) H=BK1/B
- IF(LEX) H=EXP(X)*H
- ELSEIF(X .LE. 5) THEN
- XN=4*NU**2
- A=9-XN
- B=25-XN
- C=768*X**2
- C0=48*X
- A0=1
- A1=(16*X+7+XN)/A
- A2=(C+C0*(XN+23)+XN*(XN+62)+129)/(A*B)
- B0=1
- B1=(16*X+9-XN)/A
- B2=(C+C0*B)/(A*B)+1
- C=0
- DO 24 N = 3,30
- C0=C
- FN=N
- FN2=FN+FN
- FN1=FN2-1
- FN3=FN1/(FN2-3)
- FN4=12*FN**2-(1-XN)
- FN5=16*FN1*X
- RAN=1/((FN2+1)**2-XN)
- F1=FN3*(FN4-20*FN)+FN5
- F2=28*FN-FN4-8+FN5
- F3=FN3*((FN2-5)**2-XN)
- A=(F1*A2+F2*A1+F3*A0)*RAN
- B=(F1*B2+F2*B1+F3*B0)*RAN
- C=A/B
- IF(ABS(C0-C) .LT. EPS*ABS(C)) GO TO 25
- A0=A1
- A1=A2
- A2=A
- B0=B1
- B1=B2
- B2=B
- 24 CONTINUE
- 25 H=C/SQRT(RPIH*X)
- IF(.NOT.LEX) H=EXP(-X)*H
- ELSE
- R=1/X
- H=10*R-1
- ALFA=H+H
- B1=0
- B2=0
- DO 23 I = 16,0,-1
- B0=CK(I,NU)+ALFA*B1-B2
- B2=B1
- 23 B1=B0
- H=SQRT(PIH*R)*(B0-H*B2)
- IF(.NOT.LEX) H=EXP(-X)*H
- ENDIF
- 9 CONTINUE
-#if !defined(CERNLIB_DOUBLE)
- BESI0=H
-#endif
-#if defined(CERNLIB_DOUBLE)
- DBESI0=H
-#endif
- RETURN
- 101 FORMAT(' NON-POSITIVE ARGUMENT X = ',1P,E15.6)
- END
diff --git a/src/mathlib/gen/c/besj0.F b/src/mathlib/gen/c/besj0.F
deleted file mode 100644
index 7e24bb7..0000000
--- a/src/mathlib/gen/c/besj0.F
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: besj0.F,v 1.1.1.1 1996/04/01 15:01:59 mclareni Exp $
-*
-* $Log: besj0.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:59 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- FUNCTION BESJ0(X)
-#include "gen/def64.inc"
- + D,DBESJ0,DBESJ1,DBESY0,DBESY1
-
- SROUND(D)=D+(D-SNGL(D))
- BESJ0=SROUND(DBESJ0(DBLE(X)))
- RETURN
-
- ENTRY BESJ1(X)
- BESJ1=SROUND(DBESJ1(DBLE(X)))
- RETURN
-
- ENTRY BESY0(X)
- BESY0=SROUND(DBESY0(DBLE(X)))
- RETURN
-
- ENTRY BESY1(X)
- BESY1=SROUND(DBESY1(DBLE(X)))
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/c/besj0128.F b/src/mathlib/gen/c/besj0128.F
deleted file mode 100644
index f298268..0000000
--- a/src/mathlib/gen/c/besj0128.F
+++ /dev/null
@@ -1,37 +0,0 @@
-*
-* $Id: besj0128.F,v 1.1.1.1 1996/04/01 15:01:59 mclareni Exp $
-*
-* $Log: besj0128.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:59 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION DBESJ0(X)
-#include "gen/imp128.inc"
- CHARACTER*(*) NAME1, NAME2, NAME3, NAME4
- PARAMETER( NAME1='DBESJ0')
- PARAMETER( NAME2='DBESJ1')
- PARAMETER( NAME3='DBESY0')
- PARAMETER( NAME4='DBESY1')
- DBESJ0=0
- CALL MTLPRT(NAME1,'C312.0','Not available on this machine')
- RETURN
-
- ENTRY DBESJ1(X)
- DBESJ1=0
- CALL MTLPRT(NAME2,'C312.0','Not available on this machine')
- RETURN
-
- ENTRY DBESY0(X)
- DBESY0=0
- CALL MTLPRT(NAME3,'C312.0','Not available on this machine')
- RETURN
-
- ENTRY DBESY1(X)
- DBESY1=0
- CALL MTLPRT(NAME4,'C312.0','Not available on this machine')
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/c/besj064.F b/src/mathlib/gen/c/besj064.F
deleted file mode 100644
index 4bcb742..0000000
--- a/src/mathlib/gen/c/besj064.F
+++ /dev/null
@@ -1,331 +0,0 @@
-*
-* $Id: besj064.F,v 1.1.1.1 1996/04/01 15:01:59 mclareni Exp $
-*
-* $Log: besj064.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:59 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION BESJ0(X)
-#endif
-#if defined(CERNLIB_DOUBLE)
- FUNCTION DBESJ0(X)
-#include "gen/imp64.inc"
-#endif
-#include "gen/defc64.inc"
- + C,F,I,CB0,CB1,CB2
- CHARACTER NAME0*(*),NAME1*(*)
- CHARACTER*80 ERRTXT
- LOGICAL LJ0,LY0,LJ1,LY1
- DIMENSION A(0:16),B(0:16),C(0:19),D(0:16),E(0:16),F(0:19)
-
-#if !defined(CERNLIB_DOUBLE)
- PARAMETER (NAME0 = 'BESY0', NAME1 = 'BESY1')
-#endif
-#if defined(CERNLIB_DOUBLE)
- PARAMETER (NAME0 = 'BESY0/DBESY0', NAME1 = 'BESY1/DBESY1')
-#endif
- PARAMETER (I = (0,1))
- PARAMETER (Z1 = 1, HF = Z1/2, R8 = Z1/8, R32 = Z1/32)
- PARAMETER (CE = 0.57721 56649 01532 861D0)
- PARAMETER (PI = 3.14159 26535 89793 238D0)
- PARAMETER (PI1 = 2/PI, PI3 = 3*PI/4, PI4 = PI/4)
-
- DATA A( 0) /+0.15772 79714 74890 120D0/
- DATA A( 1) /-0.00872 34423 52852 221D0/
- DATA A( 2) /+0.26517 86132 03336 810D0/
- DATA A( 3) /-0.37009 49938 72649 779D0/
- DATA A( 4) /+0.15806 71023 32097 261D0/
- DATA A( 5) /-0.03489 37694 11408 885D0/
- DATA A( 6) /+0.00481 91800 69467 605D0/
- DATA A( 7) /-0.00046 06261 66206 275D0/
- DATA A( 8) /+0.00003 24603 28821 005D0/
- DATA A( 9) /-0.00000 17619 46907 762D0/
- DATA A(10) /+0.00000 00760 81635 924D0/
- DATA A(11) /-0.00000 00026 79253 531D0/
- DATA A(12) /+0.00000 00000 78486 963D0/
- DATA A(13) /-0.00000 00000 01943 835D0/
- DATA A(14) /+0.00000 00000 00041 253D0/
- DATA A(15) /-0.00000 00000 00000 759D0/
- DATA A(16) /+0.00000 00000 00000 012D0/
-
- DATA B( 0) /-0.02150 51114 49657 551D0/
- DATA B( 1) /-0.27511 81330 43518 791D0/
- DATA B( 2) /+0.19860 56347 02554 156D0/
- DATA B( 3) /+0.23425 27461 09021 802D0/
- DATA B( 4) /-0.16563 59817 13650 413D0/
- DATA B( 5) /+0.04462 13795 40669 282D0/
- DATA B( 6) /-0.00693 22862 91523 188D0/
- DATA B( 7) /+0.00071 91174 03752 303D0/
- DATA B( 8) /-0.00005 39250 79722 939D0/
- DATA B( 9) /+0.00000 30764 93288 108D0/
- DATA B(10) /-0.00000 01384 57181 230D0/
- DATA B(11) /+0.00000 00050 51054 369D0/
- DATA B(12) /-0.00000 00001 52582 850D0/
- DATA B(13) /+0.00000 00000 03882 867D0/
- DATA B(14) /-0.00000 00000 00084 429D0/
- DATA B(15) /+0.00000 00000 00001 587D0/
- DATA B(16) /-0.00000 00000 00000 026D0/
-
-#if defined(CERNLIB_DOUBLE)
- DATA
- + C( 0)/ (+0.99898 80898 58965 153D0, -0.01233 15205 78544 144D0)/,
- 1 C( 1)/ (-0.00133 84285 49971 856D0, -0.01224 94962 81259 475D0)/,
- 2 C( 2)/ (-0.00031 87898 78061 893D0, +0.00009 64941 84993 423D0)/,
- 3 C( 3)/ (+0.00000 85112 32210 657D0, +0.00001 36555 70490 357D0)/,
- 4 C( 4)/ (+0.00000 06915 42349 139D0, -0.00000 08518 06644 426D0)/,
- 5 C( 5)/ (-0.00000 00907 70101 537D0, -0.00000 00272 44053 414D0)/,
- 6 C( 6)/ (+0.00000 00014 54928 079D0, +0.00000 00096 46421 338D0)/,
- 7 C( 7)/ (+0.00000 00009 26762 487D0, -0.00000 00006 83347 518D0)/,
- 8 C( 8)/ (-0.00000 00001 39166 198D0, -0.00000 00000 60627 380D0)/,
- 9 C( 9)/ (+0.00000 00000 03237 975D0, +0.00000 00000 21695 716D0)/,
- * C(10)/ (+0.00000 00000 02535 357D0, -0.00000 00000 02304 899D0)/
- DATA
- A C(11)/ (-0.00000 00000 00559 090D0, -0.00000 00000 00122 554D0)/,
- B C(12)/ (+0.00000 00000 00041 919D0, +0.00000 00000 00092 314D0)/,
- C C(13)/ (+0.00000 00000 00008 733D0, -0.00000 00000 00016 778D0)/,
- D C(14)/ (-0.00000 00000 00003 619D0, +0.00000 00000 00000 754D0)/,
- E C(15)/ (+0.00000 00000 00000 594D0, +0.00000 00000 00000 462D0)/,
- F C(16)/ (-0.00000 00000 00000 010D0, -0.00000 00000 00000 159D0)/,
- G C(17)/ (-0.00000 00000 00000 024D0, +0.00000 00000 00000 025D0)/,
- H C(18)/ (+0.00000 00000 00000 008D0, +0.00000 00000 00000 000D0)/,
- I C(19)/ (-0.00000 00000 00000 001D0, -0.00000 00000 00000 001D0)/
-#endif
-#if !defined(CERNLIB_DOUBLE)
- DATA
- + C( 0)/ (+0.99898 80898 58965 153E0, -0.01233 15205 78544 144E0)/,
- 1 C( 1)/ (-0.00133 84285 49971 856E0, -0.01224 94962 81259 475E0)/,
- 2 C( 2)/ (-0.00031 87898 78061 893E0, +0.00009 64941 84993 423E0)/,
- 3 C( 3)/ (+0.00000 85112 32210 657E0, +0.00001 36555 70490 357E0)/,
- 4 C( 4)/ (+0.00000 06915 42349 139E0, -0.00000 08518 06644 426E0)/,
- 5 C( 5)/ (-0.00000 00907 70101 537E0, -0.00000 00272 44053 414E0)/,
- 6 C( 6)/ (+0.00000 00014 54928 079E0, +0.00000 00096 46421 338E0)/,
- 7 C( 7)/ (+0.00000 00009 26762 487E0, -0.00000 00006 83347 518E0)/,
- 8 C( 8)/ (-0.00000 00001 39166 198E0, -0.00000 00000 60627 380E0)/,
- 9 C( 9)/ (+0.00000 00000 03237 975E0, +0.00000 00000 21695 716E0)/,
- * C(10)/ (+0.00000 00000 02535 357E0, -0.00000 00000 02304 899E0)/
- DATA
- A C(11)/ (-0.00000 00000 00559 090E0, -0.00000 00000 00122 554E0)/,
- B C(12)/ (+0.00000 00000 00041 919E0, +0.00000 00000 00092 314E0)/,
- C C(13)/ (+0.00000 00000 00008 733E0, -0.00000 00000 00016 778E0)/,
- D C(14)/ (-0.00000 00000 00003 619E0, +0.00000 00000 00000 754E0)/,
- E C(15)/ (+0.00000 00000 00000 594E0, +0.00000 00000 00000 462E0)/,
- F C(16)/ (-0.00000 00000 00000 010E0, -0.00000 00000 00000 159E0)/,
- G C(17)/ (-0.00000 00000 00000 024E0, +0.00000 00000 00000 025E0)/,
- H C(18)/ (+0.00000 00000 00000 008E0, +0.00000 00000 00000 000E0)/,
- I C(19)/ (-0.00000 00000 00000 001E0, -0.00000 00000 00000 001E0)/
-#endif
-
- DATA D( 0) /+0.64835 87706 05264 921D0/
- DATA D( 1) /-1.19180 11605 41216 873D0/
- DATA D( 2) /+1.28799 40988 57677 620D0/
- DATA D( 3) /-0.66144 39341 34543 253D0/
- DATA D( 4) /+0.17770 91172 39728 283D0/
- DATA D( 5) /-0.02917 55248 06154 208D0/
- DATA D( 6) /+0.00324 02701 82683 857D0/
- DATA D( 7) /-0.00026 04443 89348 581D0/
- DATA D( 8) /+0.00001 58870 19239 932D0/
- DATA D( 9) /-0.00000 07617 58780 540D0/
- DATA D(10) /+0.00000 00294 97070 073D0/
- DATA D(11) /-0.00000 00009 42421 298D0/
- DATA D(12) /+0.00000 00000 25281 237D0/
- DATA D(13) /-0.00000 00000 00577 740D0/
- DATA D(14) /+0.00000 00000 00011 386D0/
- DATA D(15) /-0.00000 00000 00000 196D0/
- DATA D(16) /+0.00000 00000 00000 003D0/
-
- DATA E( 0) /-0.04017 29465 44414 076D0/
- DATA E( 1) /-0.44444 71476 30558 063D0/
- DATA E( 2) /-0.02271 92444 28417 736D0/
- DATA E( 3) /+0.20664 45410 17490 520D0/
- DATA E( 4) /-0.08667 16970 56948 524D0/
- DATA E( 5) /+0.01763 67030 03163 134D0/
- DATA E( 6) /-0.00223 56192 94485 095D0/
- DATA E( 7) /+0.00019 70623 02701 541D0/
- DATA E( 8) /-0.00001 28858 53299 241D0/
- DATA E( 9) /+0.00000 06528 47952 359D0/
- DATA E(10) /-0.00000 00264 50737 175D0/
- DATA E(11) /+0.00000 00008 78030 117D0/
- DATA E(12) /-0.00000 00000 24343 279D0/
- DATA E(13) /+0.00000 00000 00572 612D0/
- DATA E(14) /-0.00000 00000 00011 578D0/
- DATA E(15) /+0.00000 00000 00000 203D0/
- DATA E(16) /-0.00000 00000 00000 003D0/
-#if defined(CERNLIB_DOUBLE)
- DATA
- + F( 0)/ (+1.00170 22348 53820 996D0, +0.03726 17150 00537 654D0)/,
- 1 F( 1)/ (+0.00225 55728 46561 180D0, +0.03714 53224 79807 690D0)/,
- 2 F( 2)/ (+0.00054 32164 87508 013D0, -0.00013 72632 38201 907D0)/,
- 3 F( 3)/ (-0.00001 11794 61895 408D0, -0.00001 98512 94687 597D0)/,
- 4 F( 4)/ (-0.00000 09469 01382 392D0, +0.00000 10700 14057 386D0)/,
- 5 F( 5)/ (+0.00000 01110 32677 121D0, +0.00000 00383 05261 714D0)/,
- 6 F( 6)/ (-0.00000 00012 94398 927D0, -0.00000 00116 28723 277D0)/,
- 7 F( 7)/ (-0.00000 00011 14905 944D0, +0.00000 00007 59733 092D0)/,
- 8 F( 8)/ (+0.00000 00001 57637 232D0, +0.00000 00000 75476 075D0)/,
- 9 F( 9)/ (-0.00000 00000 02830 457D0, -0.00000 00000 24752 781D0)/
- DATA
- * F(10)/ (-0.00000 00000 02932 169D0, +0.00000 00000 02493 893D0)/,
- A F(11)/ (+0.00000 00000 00617 809D0, +0.00000 00000 00156 198D0)/,
- B F(12)/ (-0.00000 00000 00043 162D0, -0.00000 00000 00103 385D0)/,
- C F(13)/ (-0.00000 00000 00010 133D0, +0.00000 00000 00018 129D0)/,
- D F(14)/ (+0.00000 00000 00003 973D0, -0.00000 00000 00000 709D0)/,
- E F(15)/ (-0.00000 00000 00000 632D0, -0.00000 00000 00000 520D0)/,
- F F(16)/ (+0.00000 00000 00000 006D0, +0.00000 00000 00000 172D0)/,
- G F(17)/ (+0.00000 00000 00000 027D0, -0.00000 00000 00000 026D0)/,
- H F(18)/ (-0.00000 00000 00000 008D0, -0.00000 00000 00000 000D0)/,
- I F(19)/ (+0.00000 00000 00000 001D0, +0.00000 00000 00000 001D0)/
-#endif
-#if !defined(CERNLIB_DOUBLE)
- DATA
- + F( 0)/ (+1.00170 22348 53820 996E0, +0.03726 17150 00537 654E0)/,
- 1 F( 1)/ (+0.00225 55728 46561 180E0, +0.03714 53224 79807 690E0)/,
- 2 F( 2)/ (+0.00054 32164 87508 013E0, -0.00013 72632 38201 907E0)/,
- 3 F( 3)/ (-0.00001 11794 61895 408E0, -0.00001 98512 94687 597E0)/,
- 4 F( 4)/ (-0.00000 09469 01382 392E0, +0.00000 10700 14057 386E0)/,
- 5 F( 5)/ (+0.00000 01110 32677 121E0, +0.00000 00383 05261 714E0)/,
- 6 F( 6)/ (-0.00000 00012 94398 927E0, -0.00000 00116 28723 277E0)/,
- 7 F( 7)/ (-0.00000 00011 14905 944E0, +0.00000 00007 59733 092E0)/,
- 8 F( 8)/ (+0.00000 00001 57637 232E0, +0.00000 00000 75476 075E0)/,
- 9 F( 9)/ (-0.00000 00000 02830 457E0, -0.00000 00000 24752 781E0)/
- DATA
- * F(10)/ (-0.00000 00000 02932 169E0, +0.00000 00000 02493 893E0)/,
- A F(11)/ (+0.00000 00000 00617 809E0, +0.00000 00000 00156 198E0)/,
- B F(12)/ (-0.00000 00000 00043 162E0, -0.00000 00000 00103 385E0)/,
- C F(13)/ (-0.00000 00000 00010 133E0, +0.00000 00000 00018 129E0)/,
- D F(14)/ (+0.00000 00000 00003 973E0, -0.00000 00000 00000 709E0)/,
- E F(15)/ (-0.00000 00000 00000 632E0, -0.00000 00000 00000 520E0)/,
- F F(16)/ (+0.00000 00000 00000 006E0, +0.00000 00000 00000 172E0)/,
- G F(17)/ (+0.00000 00000 00000 027E0, -0.00000 00000 00000 026E0)/,
- H F(18)/ (-0.00000 00000 00000 008E0, -0.00000 00000 00000 000E0)/,
- I F(19)/ (+0.00000 00000 00000 001E0, +0.00000 00000 00000 001E0)/
-#endif
-
- LJ0=.TRUE.
- LY0=.FALSE.
- GO TO 11
-
-#if !defined(CERNLIB_DOUBLE)
- ENTRY BESY0(X)
-#endif
-#if defined(CERNLIB_DOUBLE)
- ENTRY DBESY0(X)
-#endif
- LJ0=.FALSE.
- LY0=.TRUE.
- IF(X .LE. 0) THEN
- P=0
- WRITE(ERRTXT,101) X
- CALL MTLPRT(NAME0,'C312.1',ERRTXT)
- GO TO 9
- END IF
-
- 11 V=ABS(X)
- IF(V .LT. 8) THEN
- H=R32*V**2-1
- ALFA=H+H
- B1=0
- B2=0
- DO 1 IT = 16,0,-1
- B0=A(IT)+ALFA*B1-B2
- B2=B1
- 1 B1=B0
- P=B0-H*B2
- IF(LY0) THEN
- B1=0
- B2=0
- DO 2 IT = 16,0,-1
- B0=B(IT)+ALFA*B1-B2
- B2=B1
- 2 B1=B0
- P=PI1*(CE+LOG(HF*X))*P+B0-H*B2
- ENDIF
- ELSE
- R=1/V
- H=10*R-1
- ALFA=H+H
- CB1=0
- CB2=0
- DO 3 IT = 19,0,-1
- CB0=C(IT)+ALFA*CB1-CB2
- CB2=CB1
- 3 CB1=CB0
- CB0=SQRT(PI1*R)*EXP(I*(V-PI4))*(CB0-H*CB2)
- IF(LJ0) P=CB0
- IF(LY0) P=-I*CB0
- ENDIF
- GO TO 9
-
-#if !defined(CERNLIB_DOUBLE)
- ENTRY BESJ1(X)
-#endif
-#if defined(CERNLIB_DOUBLE)
- ENTRY DBESJ1(X)
-#endif
-
- LJ1=.TRUE.
- LY1=.FALSE.
- GO TO 12
-
-#if !defined(CERNLIB_DOUBLE)
- ENTRY BESY1(X)
-#endif
-#if defined(CERNLIB_DOUBLE)
- ENTRY DBESY1(X)
-#endif
- LJ1=.FALSE.
- LY1=.TRUE.
- IF(X .LE. 0) THEN
- P=0
- WRITE(ERRTXT,101) X
- CALL MTLPRT(NAME1,'C312.1',ERRTXT)
- GO TO 9
- END IF
-
- 12 V=ABS(X)
- IF(V .LT. 8) THEN
- Y=R8*V
- H=2*Y**2-1
- ALFA=H+H
- B1=0
- B2=0
- DO 4 IT = 16,0,-1
- B0=D(IT)+ALFA*B1-B2
- B2=B1
- 4 B1=B0
- P=Y*(B0-H*B2)
- IF(LY1) THEN
- B1=0
- B2=0
- DO 5 IT = 16,0,-1
- B0=E(IT)+ALFA*B1-B2
- B2=B1
- 5 B1=B0
- P=PI1*((CE+LOG(HF*X))*P-1/X)+Y*(B0-B2)
- ENDIF
- ELSE
- R=1/V
- H=10*R-1
- ALFA=H+H
- CB1=0
- CB2=0
- DO 6 IT = 19,0,-1
- CB0=F(IT)+ALFA*CB1-CB2
- CB2=CB1
- 6 CB1=CB0
- CB0=SQRT(PI1*R)*EXP(I*(V-PI3))*(CB0-H*CB2)
- IF(LJ1) P=CB0
- IF(LY1) P=-I*CB0
- ENDIF
- IF(X .LT. 0) P=-P
- 9 CONTINUE
-#if !defined(CERNLIB_DOUBLE)
- BESJ0=P
-#endif
-#if defined(CERNLIB_DOUBLE)
- DBESJ0=P
-#endif
- RETURN
- 101 FORMAT('NON-POSITIVE ARGUMENT X = ',1P,E15.6)
- END
diff --git a/src/mathlib/gen/c/bsir3.F b/src/mathlib/gen/c/bsir3.F
deleted file mode 100644
index 1d27c97..0000000
--- a/src/mathlib/gen/c/bsir3.F
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: bsir3.F,v 1.1.1.1 1996/04/01 15:02:07 mclareni Exp $
-*
-* $Log: bsir3.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:07 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- FUNCTION BSIR3(X,NU)
-C IMPLICIT DOUBLE PRECISION (D)
-#include "gen/def64.inc"
- + D,DBSIR3,DBLE,DBSKR3,DEBIR3,DEBKR3
-
- SROUND(D)=D+(D-SNGL(D))
- BSIR3=SROUND(DBSIR3(DBLE(X),NU))
- RETURN
-
- ENTRY BSKR3(X,NU)
- BSKR3=SROUND(DBSKR3(DBLE(X),NU))
- RETURN
-
- ENTRY EBSIR3(X,NU)
- EBSIR3=SROUND(DEBIR3(DBLE(X),NU))
- RETURN
-
- ENTRY EBSKR3(X,NU)
- EBSKR3=SROUND(DEBKR3(DBLE(X),NU))
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/c/bsir3128.F b/src/mathlib/gen/c/bsir3128.F
deleted file mode 100644
index 990a250..0000000
--- a/src/mathlib/gen/c/bsir3128.F
+++ /dev/null
@@ -1,37 +0,0 @@
-*
-* $Id: bsir3128.F,v 1.1.1.1 1996/04/01 15:02:07 mclareni Exp $
-*
-* $Log: bsir3128.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:07 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION DBSIR3(X,NU)
-#include "gen/imp128.inc"
- CHARACTER*(*) NAME1, NAME2, NAME3, NAME4
- PARAMETER( NAME1='DBSIR3')
- PARAMETER( NAME2='DEBIR3')
- PARAMETER( NAME3='DBSKR3')
- PARAMETER( NAME4='DEBKR3')
- DBSIR3=0
- CALL MTLPRT(NAME1,'C340.0','Not available on this machine')
- RETURN
-
- ENTRY DEBIR3(X,NU)
- DEBIR3=0
- CALL MTLPRT(NAME2,'C340.0','Not available on this machine')
- RETURN
-
- ENTRY DBSKR3(X,NU)
- DBSKR3=0
- CALL MTLPRT(NAME3,'C340.0','Not available on this machine')
- RETURN
-
- ENTRY DEBKR3(X,NU)
- DEBKR3=0
- CALL MTLPRT(NAME4,'C340.0','Not available on this machine')
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/c/bsir364.F b/src/mathlib/gen/c/bsir364.F
deleted file mode 100644
index 37e7115..0000000
--- a/src/mathlib/gen/c/bsir364.F
+++ /dev/null
@@ -1,343 +0,0 @@
-*
-* $Id: bsir364.F,v 1.1.1.1 1996/04/01 15:02:07 mclareni Exp $
-*
-* $Log: bsir364.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:07 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION BSIR3(X,NU)
-#endif
-#if defined(CERNLIB_DOUBLE)
- FUNCTION DBSIR3(X,NU)
-#include "gen/imp64.inc"
-#endif
- CHARACTER*80 ERRTXT
- CHARACTER NAMEI*(*),NAMEK*(*),NAMEIE*(*),NAMEKE*(*)
-#if !defined(CERNLIB_DOUBLE)
- PARAMETER (NAMEI = 'BSIR3', NAMEIE = 'EBSIR3')
- PARAMETER (NAMEK = 'BSKR3', NAMEKE = 'EBSKR3')
-#endif
-#if defined(CERNLIB_DOUBLE)
- PARAMETER (NAMEI = 'BSIR3/DBSIR3', NAMEIE = 'EBSIR3/DEBIR3')
- PARAMETER (NAMEK = 'BSKR3/DBSKR3', NAMEKE = 'EBSKR3/DEBKR3')
-#endif
- LOGICAL LEX
-
- DIMENSION BC(0:23,2),CC(0:15,2),PP(-2:2),GG(-2:2)
-
- PARAMETER (EPS = 1D-15)
- PARAMETER (Z1 = 1, HF = Z1/2)
- PARAMETER (PI = 3.14159 26535 89793 24D0)
- PARAMETER (W3 = 1.73205 08075 68877 29D0)
- PARAMETER (G1 = 2.67893 85347 07747 63D0)
- PARAMETER (G2 = 1.35411 79394 26400 42D0)
- PARAMETER (PIH = PI/2, RPIH = 2/PI, RPI2 = 1/(2*PI))
- PARAMETER (C1 = 2*PI/(3*W3))
- PARAMETER (GM = 3*(1/G2-3/G1)/2, GP = (3/G1+1/G2)/2)
-
- DATA PP(-2) /-0.66666 66666 66666 67D0/
- DATA PP(-1) /-0.33333 33333 33333 33D0/
- DATA PP( 1) / 0.33333 33333 33333 33D0/
- DATA PP( 2) / 0.66666 66666 66666 67D0/
-
- DATA GG(-2) / 0.37328 21739 07395 23D0/
- DATA GG(-1) / 0.73848 81116 21648 31D0/
- DATA GG( 1) / 1.11984 65217 22185 68D0/
- DATA GG( 2) / 1.10773 21674 32472 47D0/
-
- DATA BC( 0,1) / 1.00458 61710 93207 35D0/
- DATA BC( 1,1) / 0.00467 34791 99873 60D0/
- DATA BC( 2,1) / 0.00009 08034 04815 04D0/
- DATA BC( 3,1) / 0.00000 37262 16110 59D0/
- DATA BC( 4,1) / 0.00000 02520 73237 90D0/
- DATA BC( 5,1) / 0.00000 00227 82110 77D0/
- DATA BC( 6,1) / 0.00000 00012 91332 28D0/
- DATA BC( 7,1) /-0.00000 00006 11915 16D0/
- DATA BC( 8,1) /-0.00000 00003 75616 85D0/
- DATA BC( 9,1) /-0.00000 00001 16415 46D0/
- DATA BC(10,1) /-0.00000 00000 14443 25D0/
- DATA BC(11,1) / 0.00000 00000 05373 69D0/
- DATA BC(12,1) / 0.00000 00000 03074 27D0/
- DATA BC(13,1) / 0.00000 00000 00297 66D0/
- DATA BC(14,1) /-0.00000 00000 00265 20D0/
- DATA BC(15,1) /-0.00000 00000 00091 37D0/
- DATA BC(16,1) / 0.00000 00000 00015 52D0/
- DATA BC(17,1) / 0.00000 00000 00014 12D0/
- DATA BC(18,1) /-0.00000 00000 00000 23D0/
- DATA BC(19,1) /-0.00000 00000 00001 98D0/
- DATA BC(20,1) /-0.00000 00000 00000 13D0/
- DATA BC(21,1) / 0.00000 00000 00000 29D0/
- DATA BC(22,1) / 0.00000 00000 00000 03D0/
- DATA BC(23,1) /-0.00000 00000 00000 05D0/
-
- DATA BC( 0,2) / 0.99363 49867 16925 14D0/
- DATA BC( 1,2) /-0.00646 71526 00616 03D0/
- DATA BC( 2,2) /-0.00010 60188 22351 55D0/
- DATA BC( 3,2) /-0.00000 41406 57716 24D0/
- DATA BC( 4,2) /-0.00000 02916 95418 21D0/
- DATA BC( 5,2) /-0.00000 00365 71574 33D0/
- DATA BC( 6,2) /-0.00000 00075 81590 37D0/
- DATA BC( 7,2) /-0.00000 00019 23008 52D0/
- DATA BC( 8,2) /-0.00000 00004 20438 80D0/
- DATA BC( 9,2) /-0.00000 00000 39372 04D0/
- DATA BC(10,2) / 0.00000 00000 19007 44D0/
- DATA BC(11,2) / 0.00000 00000 10137 64D0/
- DATA BC(12,2) / 0.00000 00000 01331 30D0/
- DATA BC(13,2) /-0.00000 00000 00676 92D0/
- DATA BC(14,2) /-0.00000 00000 00311 72D0/
- DATA BC(15,2) / 0.00000 00000 00011 87D0/
- DATA BC(16,2) / 0.00000 00000 00040 21D0/
- DATA BC(17,2) / 0.00000 00000 00004 78D0/
- DATA BC(18,2) /-0.00000 00000 00004 74D0/
- DATA BC(19,2) /-0.00000 00000 00001 16D0/
- DATA BC(20,2) / 0.00000 00000 00000 59D0/
- DATA BC(21,2) / 0.00000 00000 00000 21D0/
- DATA BC(22,2) /-0.00000 00000 00000 08D0/
- DATA BC(23,2) /-0.00000 00000 00000 03D0/
-
- DATA CC( 0,1) / 0.99353 64122 76093 39D0/
- DATA CC( 1,1) /-0.00631 44392 60798 63D0/
- DATA CC( 2,1) / 0.00014 30095 80961 13D0/
- DATA CC( 3,1) /-0.00000 57870 60592 03D0/
- DATA CC( 4,1) / 0.00000 03265 50333 20D0/
- DATA CC( 5,1) /-0.00000 00231 23231 95D0/
- DATA CC( 6,1) / 0.00000 00019 39555 14D0/
- DATA CC( 7,1) /-0.00000 00001 85897 89D0/
- DATA CC( 8,1) / 0.00000 00000 19868 42D0/
- DATA CC( 9,1) /-0.00000 00000 02326 79D0/
- DATA CC(10,1) / 0.00000 00000 00294 68D0/
- DATA CC(11,1) /-0.00000 00000 00039 95D0/
- DATA CC(12,1) / 0.00000 00000 00005 75D0/
- DATA CC(13,1) /-0.00000 00000 00000 87D0/
- DATA CC(14,1) / 0.00000 00000 00000 14D0/
- DATA CC(15,1) /-0.00000 00000 00000 02D0/
-
- DATA CC( 0,2) / 1.00914 95380 72789 40D0/
- DATA CC( 1,2) / 0.00897 12068 42483 60D0/
- DATA CC( 2,2) /-0.00017 13895 98261 54D0/
- DATA CC( 3,2) / 0.00000 65547 92549 82D0/
- DATA CC( 4,2) /-0.00000 03595 19190 49D0/
- DATA CC( 5,2) / 0.00000 00250 24412 19D0/
- DATA CC( 6,2) /-0.00000 00020 74924 13D0/
- DATA CC( 7,2) / 0.00000 00001 97223 67D0/
- DATA CC( 8,2) /-0.00000 00000 20946 47D0/
- DATA CC( 9,2) / 0.00000 00000 02440 93D0/
- DATA CC(10,2) /-0.00000 00000 00307 91D0/
- DATA CC(11,2) / 0.00000 00000 00041 61D0/
- DATA CC(12,2) /-0.00000 00000 00005 97D0/
- DATA CC(13,2) / 0.00000 00000 00000 91D0/
- DATA CC(14,2) /-0.00000 00000 00000 14D0/
- DATA CC(15,2) / 0.00000 00000 00000 02D0/
-
- LEX=.FALSE.
- GO TO 8
-
-#if !defined(CERNLIB_DOUBLE)
- ENTRY EBSIR3(X,NU)
-#endif
-#if defined(CERNLIB_DOUBLE)
- ENTRY DEBIR3(X,NU)
-#endif
- LEX=.TRUE.
-
- 8 MU=ABS(NU)
- IF(MU .NE. 1 .AND. MU .NE. 2 .OR. NU .LT. 0 .AND. X .LE. 0
- 1 .OR. NU .GT. 0 .AND. X .LT. 0) THEN
- S=0
- WRITE(ERRTXT,101) X,NU
- IF(.NOT.LEX) CALL MTLPRT(NAMEI ,'C340.1',ERRTXT)
- IF( LEX) CALL MTLPRT(NAMEIE,'C340.1',ERRTXT)
- ELSEIF(X .EQ. 0) THEN
- S=0
- ELSEIF(X .LT. 8) THEN
- Y=(HF*X)**2
- XN=PP(NU)
- XL=XN+2
- A0=1
- A1=1+2*Y/((XL+1)*(XN+1))
- A2=1+Y*(4+3*Y/((XL+2)*(XN+2)))/((XL+3)*(XN+1))
- B0=1
- B1=1-Y/(XL+1)
- B2=1-Y*(1-Y/(2*(XL+2)))/(XL+3)
- T1=3+XL
- V1=3-XL
- V3=XL-1
- V2=V3+V3
- C=0
- DO 33 N = 3,30
- C0=C
- T1=T1+2
- T2=T1-1
- T3=T2-1
- T4=T3-1
- T5=T4-1
- T6=T5-1
- V1=V1+1
- V2=V2+1
- V3=V3+1
- U1=N*T4
- E=V3/(U1*T3)
- U2=E*Y
- F1=1+Y*V1/(U1*T1)
- F2=(1+Y*V2/(V3*T2*T5))*U2
- F3=-Y*Y*U2/(T4*T5*T5*T6)
- A=F1*A2+F2*A1+F3*A0
- B=F1*B2+F2*B1+F3*B0
- C=A/B
- IF(ABS(C0-C) .LT. EPS*ABS(C)) GO TO 34
- A0=A1
- A1=A2
- A2=A
- B0=B1
- B1=B2
- B2=B
- 33 CONTINUE
- 34 S=GG(NU)*(HF*X)**PP(NU)*C
- IF(LEX) S=EXP(-X)*S
- ELSE
- R=1/X
- W=SQRT(RPI2*R)
- H=16*R-1
- ALFA=H+H
- B1=0
- B2=0
- DO 2 I = 23,0,-1
- B0=BC(I,MU)+ALFA*B1-B2
- B2=B1
- 2 B1=B0
- S=W*(B0-H*B2)
- IF(.NOT.LEX) S=EXP(X)*S
- T=0
- IF(NU .LT. 0) THEN
- H=10*R-1
- ALFA=H+H
- B1=0
- B2=0
- DO 3 I = 15,0,-1
- B0=CC(I,MU)+ALFA*B1-B2
- B2=B1
- 3 B1=B0
- R=EXP(-X)
- T=W3*W*R*(B0-H*B2)
- IF(LEX) T=R*T
- END IF
- S=S+T
- END IF
- GO TO 99
-
-#if !defined(CERNLIB_DOUBLE)
- ENTRY BSKR3(X,NU)
-#endif
-#if defined(CERNLIB_DOUBLE)
- ENTRY DBSKR3(X,NU)
-#endif
- LEX=.FALSE.
- GO TO 9
-
-#if !defined(CERNLIB_DOUBLE)
- ENTRY EBSKR3(X,NU)
-#endif
-#if defined(CERNLIB_DOUBLE)
- ENTRY DEBKR3(X,NU)
-#endif
- LEX=.TRUE.
-
- 9 MU=ABS(NU)
- IF(MU .NE. 1 .AND. MU .NE. 2 .OR. X .LE. 0) THEN
- S=0
- WRITE(ERRTXT,101) X,NU
- IF(.NOT.LEX) CALL MTLPRT(NAMEK ,'C340.1',ERRTXT)
- IF( LEX) CALL MTLPRT(NAMEKE,'C340.1',ERRTXT)
- ELSEIF(X .LE. 1) THEN
- A0=PP(-1)
- B=HF*X
- D=-LOG(B)
- F=A0*D
- E=EXP(F)
- G=(GM*A0+GP)*E
- BK=C1*(HF*GM*(E+1/E)+GP*D*SINH(F)/F)
- F=BK
- E=A0**2
- P=HF*C1*G
- Q=HF/G
- C=1
- D=B**2
- BK1=P
- DO 11 N = 1,15
- FN=N
- F=(FN*F+P+Q)/(FN**2-E)
- C=C*D/FN
- P=P/(FN-A0)
- Q=Q/(FN+A0)
- G=C*(P-FN*F)
- H=C*F
- BK=BK+H
- BK1=BK1+G
- IF(H*BK1+ABS(G)*BK .LE. EPS*BK*BK1) GO TO 12
- 11 CONTINUE
- 12 S=BK
- IF(MU .EQ. 2) S=BK1/B
- IF(LEX) S=EXP(X)*S
- ELSEIF(X .LE. 5) THEN
- XN=4*PP(MU)**2
- A=9-XN
- B=25-XN
- C=768*X**2
- C0=48*X
- A0=1
- A1=(16*X+7+XN)/A
- A2=(C+C0*(XN+23)+XN*(XN+62)+129)/(A*B)
- B0=1
- B1=(16*X+9-XN)/A
- B2=(C+C0*B)/(A*B)+1
- C=0
- DO 24 N = 3,30
- C0=C
- FN=N
- FN2=FN+FN
- FN1=FN2-1
- FN3=FN1/(FN2-3)
- FN4=12*FN**2-(1-XN)
- FN5=16*FN1*X
- RAN=1/((FN2+1)**2-XN)
- F1=FN3*(FN4-20*FN)+FN5
- F2=28*FN-FN4-8+FN5
- F3=FN3*((FN2-5)**2-XN)
- A=(F1*A2+F2*A1+F3*A0)*RAN
- B=(F1*B2+F2*B1+F3*B0)*RAN
- C=A/B
- IF(ABS(C0-C) .LT. EPS*ABS(C)) GO TO 25
- A0=A1
- A1=A2
- A2=A
- B0=B1
- B1=B2
- B2=B
- 24 CONTINUE
- 25 S=C/SQRT(RPIH*X)
- IF(.NOT.LEX) S=EXP(-X)*S
- ELSE
- R=1/X
- H=10*R-1
- ALFA=H+H
- B1=0
- B2=0
- DO 13 I = 15,0,-1
- B0=CC(I,MU)+ALFA*B1-B2
- B2=B1
- 13 B1=B0
- S=SQRT(PIH*R)*(B0-H*B2)
- IF(.NOT.LEX) S=EXP(-X)*S
- END IF
-#if !defined(CERNLIB_DOUBLE)
- 99 BSIR3=S
-#endif
-#if defined(CERNLIB_DOUBLE)
- 99 DBSIR3=S
-#endif
- RETURN
- 101 FORMAT('INCORRECT ARGUMENT OR INDEX, X = ',1P,E15.6,' NU = ',I5)
- END
diff --git a/src/mathlib/gen/c/bsir4.F b/src/mathlib/gen/c/bsir4.F
deleted file mode 100644
index 58cfa8c..0000000
--- a/src/mathlib/gen/c/bsir4.F
+++ /dev/null
@@ -1,30 +0,0 @@
-*
-* $Id: bsir4.F,v 1.1.1.1 1996/04/01 15:02:03 mclareni Exp $
-*
-* $Log: bsir4.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:03 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- FUNCTION BSIR4(X,NU)
- IMPLICIT DOUBLE PRECISION (D)
-
- SROUND(D)=D+(D-SNGL(D))
- BSIR4=SROUND(DBSIR4(DBLE(X),NU))
- RETURN
-
- ENTRY BSKR4(X,NU)
- BSKR4=SROUND(DBSKR4(DBLE(X),NU))
- RETURN
-
- ENTRY EBSIR4(X,NU)
- EBSIR4=SROUND(DEBIR4(DBLE(X),NU))
- RETURN
-
- ENTRY EBSKR4(X,NU)
- EBSKR4=SROUND(DEBKR4(DBLE(X),NU))
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/c/bsir4128.F b/src/mathlib/gen/c/bsir4128.F
deleted file mode 100644
index 08ca3db..0000000
--- a/src/mathlib/gen/c/bsir4128.F
+++ /dev/null
@@ -1,37 +0,0 @@
-*
-* $Id: bsir4128.F,v 1.1.1.1 1996/04/01 15:02:03 mclareni Exp $
-*
-* $Log: bsir4128.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:03 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION DBSIR4(X,NU)
-#include "gen/imp128.inc"
- CHARACTER*(*) NAME1, NAME2, NAME3, NAME4
- PARAMETER( NAME1='DBSIR4')
- PARAMETER( NAME2='DEBIR4')
- PARAMETER( NAME3='DBSKR4')
- PARAMETER( NAME4='DEBKR4')
- DBSIR4=0
- CALL MTLPRT(NAME1,'C327.0','Not available on this machine')
- RETURN
-
- ENTRY DEBIR4(X,NU)
- DEBIR4=0
- CALL MTLPRT(NAME2,'C327.0','Not available on this machine')
- RETURN
-
- ENTRY DBSKR4(X,NU)
- DBSKR4=0
- CALL MTLPRT(NAME3,'C327.0','Not available on this machine')
- RETURN
-
- ENTRY DEBKR4(X,NU)
- DEBKR4=0
- CALL MTLPRT(NAME4,'C327.0','Not available on this machine')
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/c/bsir464.F b/src/mathlib/gen/c/bsir464.F
deleted file mode 100644
index c245c11..0000000
--- a/src/mathlib/gen/c/bsir464.F
+++ /dev/null
@@ -1,360 +0,0 @@
-*
-* $Id: bsir464.F,v 1.1.1.1 1996/04/01 15:02:03 mclareni Exp $
-*
-* $Log: bsir464.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:03 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION BSIR4(X,NU)
-#endif
-#if defined(CERNLIB_DOUBLE)
- FUNCTION DBSIR4(X,NU)
-#include "gen/imp64.inc"
-#endif
- CHARACTER*80 ERRTXT
- CHARACTER NAMEI*(*),NAMEK*(*),NAMEIE*(*),NAMEKE*(*)
-#if !defined(CERNLIB_DOUBLE)
- PARAMETER (NAMEI = 'BSIR4/DBSIR4', NAMEIE = 'EBSIR4/DEBIR4')
- PARAMETER (NAMEK = 'BSKR4/DBSKR4', NAMEKE = 'EBSKR4/DEBKR4')
-#endif
-#if defined(CERNLIB_DOUBLE)
- PARAMETER (NAMEI = 'BSIR4/DBSIR4', NAMEIE = 'EBSIR4/DEBIR4')
- PARAMETER (NAMEK = 'BSKR4/DBSKR4', NAMEKE = 'EBSKR4/DEBKR4')
-#endif
- LOGICAL LEX
-
- DIMENSION BC(0:23,2),CC(0:15,2),PP(-3:3),GG(-3:3)
-
- PARAMETER (EPS = 1D-14)
- PARAMETER (Z1 = 1, HF =Z1/2)
- PARAMETER (PI = 3.14159 26535 89793 24D0)
- PARAMETER (W2 = 1.41421 35623 73095 05D0)
- PARAMETER (G1 = 3.62560 99082 21908 31D0)
- PARAMETER (G3 = 1.22541 67024 65177 65D0)
- PARAMETER (PIH = PI/2, RPIH = 2/PI, RPI = 1/PI, RW2 = 1/W2)
- PARAMETER (C1 = PI/(2*W2))
- PARAMETER (GM = 2*(1/G3-4/G1), GP = (4/G1+1/G3)/2)
-
- DATA GG(-3) /0.27581 56628 30209 31D0/, PP(-3) /-0.75D0/
- DATA GG(-1) /0.81604 89390 98262 98D0/, PP(-1) /-0.25D0/
- DATA GG( 1) /1.10326 26513 20837 26D0/, PP( 1) / 0.25D0/
- DATA GG( 3) /1.08806 52521 31017 31D0/, PP( 3) / 0.75D0/
-
- DATA BC( 0,1) / 1.00619 92270 14122 57D0/
- DATA BC( 1,1) / 0.00631 99620 31140 72D0/
- DATA BC( 2,1) / 0.00012 56131 27965 64D0/
- DATA BC( 3,1) / 0.00000 52052 40761 57D0/
- DATA BC( 4,1) / 0.00000 03591 84411 39D0/
- DATA BC( 5,1) / 0.00000 00355 85362 89D0/
- DATA BC( 6,1) / 0.00000 00036 05011 66D0/
- DATA BC( 7,1) /-0.00000 00001 26294 10D0/
- DATA BC( 8,1) /-0.00000 00002 96595 12D0/
- DATA BC( 9,1) /-0.00000 00001 18337 70D0/
- DATA BC(10,1) /-0.00000 00000 21655 68D0/
- DATA BC(11,1) / 0.00000 00000 03032 04D0/
- DATA BC(12,1) / 0.00000 00000 03041 10D0/
- DATA BC(13,1) / 0.00000 00000 00530 77D0/
- DATA BC(14,1) /-0.00000 00000 00204 53D0/
- DATA BC(15,1) /-0.00000 00000 00105 49D0/
- DATA BC(16,1) / 0.00000 00000 00005 50D0/
- DATA BC(17,1) / 0.00000 00000 00014 36D0/
- DATA BC(18,1) / 0.00000 00000 00001 14D0/
- DATA BC(19,1) /-0.00000 00000 00001 87D0/
- DATA BC(20,1) /-0.00000 00000 00000 32D0/
- DATA BC(21,1) / 0.00000 00000 00000 26D0/
- DATA BC(22,1) / 0.00000 00000 00000 06D0/
- DATA BC(23,1) /-0.00000 00000 00000 04D0/
-
- DATA BC( 0,2) / 0.98980 19115 24008 91D0/
- DATA BC( 1,2) /-0.01035 09365 14827 02D0/
- DATA BC( 2,2) /-0.00015 85263 84973 08D0/
- DATA BC( 3,2) /-0.00000 60527 21962 69D0/
- DATA BC( 4,2) /-0.00000 04158 38597 31D0/
- DATA BC( 5,2) /-0.00000 00487 99346 57D0/
- DATA BC( 6,2) /-0.00000 00089 86835 44D0/
- DATA BC( 7,2) /-0.00000 00019 83283 58D0/
- DATA BC( 8,2) /-0.00000 00003 58969 60D0/
- DATA BC( 9,2) /-0.00000 00000 08766 62D0/
- DATA BC(10,2) / 0.00000 00000 25819 45D0/
- DATA BC(11,2) / 0.00000 00000 09780 24D0/
- DATA BC(12,2) / 0.00000 00000 00565 05D0/
- DATA BC(13,2) /-0.00000 00000 00851 66D0/
- DATA BC(14,2) /-0.00000 00000 00270 25D0/
- DATA BC(15,2) / 0.00000 00000 00040 96D0/
- DATA BC(16,2) / 0.00000 00000 00040 50D0/
- DATA BC(17,2) / 0.00000 00000 00001 11D0/
- DATA BC(18,2) /-0.00000 00000 00005 25D0/
- DATA BC(19,2) /-0.00000 00000 00000 70D0/
- DATA BC(20,2) / 0.00000 00000 00000 70D0/
- DATA BC(21,2) / 0.00000 00000 00000 14D0/
- DATA BC(22,2) /-0.00000 00000 00000 10D0/
- DATA BC(23,2) /-0.00000 00000 00000 02D0/
-
- DATA CC( 0,1) / 0.99128 81656 75147 07D0/
- DATA CC( 1,1) /-0.00850 62567 20022 24D0/
- DATA CC( 2,1) / 0.00019 70491 57408 35D0/
- DATA CC( 3,1) /-0.00000 80377 10166 54D0/
- DATA CC( 4,1) / 0.00000 04554 01498 43D0/
- DATA CC( 5,1) /-0.00000 00323 27352 82D0/
- DATA CC( 6,1) / 0.00000 00027 16130 28D0/
- DATA CC( 7,1) /-0.00000 00002 60644 07D0/
- DATA CC( 8,1) / 0.00000 00000 27882 69D0/
- DATA CC( 9,1) /-0.00000 00000 03267 69D0/
- DATA CC(10,1) / 0.00000 00000 00414 09D0/
- DATA CC(11,1) /-0.00000 00000 00056 17D0/
- DATA CC(12,1) / 0.00000 00000 00008 09D0/
- DATA CC(13,1) /-0.00000 00000 00001 23D0/
- DATA CC(14,1) / 0.00000 00000 00000 20D0/
- DATA CC(15,1) /-0.00000 00000 00000 03D0/
-
- DATA CC( 0,2) / 1.01476 24350 64637 87D0/
- DATA CC( 1,2) / 0.01449 34617 87809 66D0/
- DATA CC( 2,2) /-0.00025 87162 07241 80D0/
- DATA CC( 3,2) / 0.00000 96912 18911 49D0/
- DATA CC( 4,2) /-0.00000 05261 29313 99D0/
- DATA CC( 5,2) / 0.00000 00363 96854 29D0/
- DATA CC( 6,2) /-0.00000 00030 05472 76D0/
- DATA CC( 7,2) / 0.00000 00002 84827 80D0/
- DATA CC( 8,2) /-0.00000 00000 30182 91D0/
- DATA CC( 9,2) / 0.00000 00000 03511 10D0/
- DATA CC(10,2) /-0.00000 00000 00442 27D0/
- DATA CC(11,2) / 0.00000 00000 00059 70D0/
- DATA CC(12,2) /-0.00000 00000 00008 56D0/
- DATA CC(13,2) / 0.00000 00000 00001 30D0/
- DATA CC(14,2) /-0.00000 00000 00000 21D0/
- DATA CC(15,2) / 0.00000 00000 00000 03D0/
-
- LEX=.FALSE.
- GO TO 8
-
-#if !defined(CERNLIB_DOUBLE)
- ENTRY EBSIR4(X,NU)
-#endif
-#if defined(CERNLIB_DOUBLE)
- ENTRY DEBIR4(X,NU)
-#endif
- LEX=.TRUE.
-
- 8 MU=ABS(NU)
- IF(MU .NE. 1 .AND. MU .NE. 2 .AND. MU .NE. 3 .OR.
- 1 NU .LT. 0 .AND. X .LE. 0 .OR. NU .GT. 0 .AND. X .LT. 0) THEN
- S=0
- WRITE(ERRTXT,101) X,NU
- IF(.NOT.LEX) CALL MTLPRT(NAMEI ,'C327.1',ERRTXT)
- IF( LEX) CALL MTLPRT(NAMEIE,'C327.1',ERRTXT)
- ELSEIF(X .EQ. 0) THEN
- S=0
- ELSEIF(NU .EQ. -2) THEN
- IF(LEX) THEN
- S=HF*(1+EXP(-X-X))/SQRT(PIH*X)
- ELSE
- S=COSH(X)/SQRT(PIH*X)
- ENDIF
- ELSEIF(NU .EQ. 2) THEN
- IF(LEX) THEN
- IF(X .LT. HF) THEN
- S=SINH(X)*EXP(-X)/SQRT(PIH*X)
- ELSE
- S=HF*(1-EXP(-X-X))/SQRT(PIH*X)
- ENDIF
- ELSE
- S=SINH(X)/SQRT(PIH*X)
- ENDIF
- ELSEIF(X .LT. 8) THEN
- Y=(HF*X)**2
- XN=PP(NU)
- XL=XN+2
- A0=1
- A1=1+2*Y/((XL+1)*(XN+1))
- A2=1+Y*(4+3*Y/((XL+2)*(XN+2)))/((XL+3)*(XN+1))
- B0=1
- B1=1-Y/(XL+1)
- B2=1-Y*(1-Y/(2*(XL+2)))/(XL+3)
- T1=3+XL
- V1=3-XL
- V3=XL-1
- V2=V3+V3
- C=0
- DO 33 N = 3,30
- C0=C
- T1=T1+2
- T2=T1-1
- T3=T2-1
- T4=T3-1
- T5=T4-1
- T6=T5-1
- V1=V1+1
- V2=V2+1
- V3=V3+1
- U1=N*T4
- E=V3/(U1*T3)
- U2=E*Y
- F1=1+Y*V1/(U1*T1)
- F2=(1+Y*V2/(V3*T2*T5))*U2
- F3=-Y*Y*U2/(T4*T5*T5*T6)
- A=F1*A2+F2*A1+F3*A0
- B=F1*B2+F2*B1+F3*B0
- C=A/B
- IF(ABS(C0-C) .LT. EPS*ABS(C)) GO TO 34
- A0=A1
- A1=A2
- A2=A
- B0=B1
- B1=B2
- B2=B
- 33 CONTINUE
- 34 S=GG(NU)*(HF*X)**PP(NU)*C
- IF(LEX) S=EXP(-X)*S
- ELSE
- K=(MU+1)/2
- R=1/X
- W=SQRT(RPI*R)
- H=16*R-1
- ALFA=H+H
- B1=0
- B2=0
- DO 2 I = 23,0,-1
- B0=BC(I,K)+ALFA*B1-B2
- B2=B1
- 2 B1=B0
- S=RW2*W*(B0-H*B2)
- IF(.NOT.LEX) S=EXP(X)*S
- T=0
- IF(NU .LT. 0) THEN
- H=10*R-1
- ALFA=H+H
- B1=0
- B2=0
- DO 3 I = 15,0,-1
- B0=CC(I,K)+ALFA*B1-B2
- B2=B1
- 3 B1=B0
- R=EXP(-X)
- T=W*R*(B0-H*B2)
- IF(LEX) T=R*T
- ENDIF
- S=S+T
- ENDIF
- GO TO 99
-
-#if !defined(CERNLIB_DOUBLE)
- ENTRY BSKR4(X,NU)
-#endif
-#if defined(CERNLIB_DOUBLE)
- ENTRY DBSKR4(X,NU)
-#endif
- LEX=.FALSE.
- GO TO 9
-
-#if !defined(CERNLIB_DOUBLE)
- ENTRY EBSKR4(X,NU)
-#endif
-#if defined(CERNLIB_DOUBLE)
- ENTRY DEBKR4(X,NU)
-#endif
- LEX=.TRUE.
-
- 9 MU=ABS(NU)
- IF(MU .NE. 1 .AND. MU .NE. 2 .AND. MU .NE. 3 .OR. X .LE. 0) THEN
- S=0
- WRITE(ERRTXT,101) X,NU
- IF(.NOT.LEX) CALL MTLPRT(NAMEK ,'C327.1',ERRTXT)
- IF( LEX) CALL MTLPRT(NAMEKE,'C327.1',ERRTXT)
- ELSEIF(MU .EQ. 2) THEN
- S=SQRT(PIH/X)
- IF(.NOT.LEX) S=EXP(-X)*S
- ELSEIF(X .LE. 1) THEN
- A0=PP(-1)
- B=HF*X
- D=-LOG(B)
- F=A0*D
- E=EXP(F)
- G=(GM*A0+GP)*E
- BK=C1*(HF*GM*(E+1/E)+GP*D*SINH(F)/F)
- F=BK
- E=A0**2
- P=HF*C1*G
- Q=HF/G
- C=1
- D=B**2
- BK1=P
- DO 11 N = 1,15
- FN=N
- F=(FN*F+P+Q)/(FN**2-E)
- C=C*D/FN
- P=P/(FN-A0)
- Q=Q/(FN+A0)
- G=C*(P-FN*F)
- H=C*F
- BK=BK+H
- BK1=BK1+G
- IF(H*BK1+ABS(G)*BK .LE. EPS*BK*BK1) GO TO 12
- 11 CONTINUE
- 12 S=BK
- IF(MU .EQ. 3) S=BK1/B
- IF(LEX) S=EXP(X)*S
- ELSEIF(X .LE. 5) THEN
- XN=4*PP(MU)**2
- A=9-XN
- B=25-XN
- C=768*X**2
- C0=48*X
- A0=1
- A1=(16*X+7+XN)/A
- A2=(C+C0*(XN+23)+XN*(XN+62)+129)/(A*B)
- B0=1
- B1=(16*X+9-XN)/A
- B2=(C+C0*B)/(A*B)+1
- C=0
- DO 24 N = 3,30
- C0=C
- FN=N
- FN2=FN+FN
- FN1=FN2-1
- FN3=FN1/(FN2-3)
- FN4=12*FN**2-(1-XN)
- FN5=16*FN1*X
- RAN=1/((FN2+1)**2-XN)
- F1=FN3*(FN4-20*FN)+FN5
- F2=28*FN-FN4-8+FN5
- F3=FN3*((FN2-5)**2-XN)
- A=(F1*A2+F2*A1+F3*A0)*RAN
- B=(F1*B2+F2*B1+F3*B0)*RAN
- C=A/B
- IF(ABS(C0-C) .LT. EPS*ABS(C)) GO TO 25
- A0=A1
- A1=A2
- A2=A
- B0=B1
- B1=B2
- B2=B
- 24 CONTINUE
- 25 S=C/SQRT(RPIH*X)
- IF(.NOT.LEX) S=EXP(-X)*S
- ELSE
- K=(MU+1)/2
- R=1/X
- Y=5*R
- H=10*R-1
- ALFA=H+H
- B1=0
- B2=0
- DO 13 I = 15,0,-1
- B0=CC(I,K)+ALFA*B1-B2
- B2=B1
- 13 B1=B0
- S=SQRT(PIH*R)*(B0-H*B2)
- IF(.NOT.LEX) S=EXP(-X)*S
- ENDIF
-#if !defined(CERNLIB_DOUBLE)
- 99 BSIR4=S
-#endif
-#if defined(CERNLIB_DOUBLE)
- 99 DBSIR4=S
-#endif
- RETURN
- 101 FORMAT('INCORRECT ARGUMENT OR INDEX, X = ',1P,E15.6,5X,'NU = ',I5)
- END
diff --git a/src/mathlib/gen/c/bsja.F b/src/mathlib/gen/c/bsja.F
deleted file mode 100644
index 402e208..0000000
--- a/src/mathlib/gen/c/bsja.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: bsja.F,v 1.1.1.1 1996/04/01 15:02:08 mclareni Exp $
-*
-* $Log: bsja.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:08 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- SUBROUTINE BSJA(X,A,NMAX,ND,B)
- DOUBLE PRECISION D,DB(0:101)
- DIMENSION B(0:*)
-
- SROUND(D)=D+(D-SNGL(D))
- CALL DBSJA(DBLE(X),DBLE(A),NMAX,ND,DB)
- GO TO 2
-
- ENTRY BSIA(X,A,NMAX,ND,B)
-
- CALL DBSIA(DBLE(X),DBLE(A),NMAX,ND,DB)
- 2 DO 1 N = 0,ABS(NMAX)
- 1 B(N)=SROUND(DB(N))
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/c/bsja128.F b/src/mathlib/gen/c/bsja128.F
deleted file mode 100644
index 33e0a1d..0000000
--- a/src/mathlib/gen/c/bsja128.F
+++ /dev/null
@@ -1,183 +0,0 @@
-*
-* $Id: bsja128.F,v 1.1.1.1 1996/04/01 15:02:08 mclareni Exp $
-*
-* $Log: bsja128.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:08 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_QUAD)
-#if defined(CERNLIB_DOUBLE)
- SUBROUTINE QBSJA(X,A,NMAX,ND,B)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- SUBROUTINE DBSJA(X,A,NMAX,ND,B)
-#endif
-
-#include "gen/imp128.inc"
- REAL SX,D,T,Q,U,V,TC(11)
- CHARACTER*80 ERRTXT
- CHARACTER NAMEJ*(*),NAMEI*(*)
-#if defined(CERNLIB_DOUBLE)
- PARAMETER (NAMEJ = 'DBSJA/QBSJA',
- 1 NAMEI = 'DBSIA/QBSIA')
-#endif
-#if !defined(CERNLIB_DOUBLE)
- PARAMETER (NAMEJ = 'DBSJA', NAMEI = 'DBSIA')
-#endif
- LOGICAL LJA,LIA,LEV,LER
- DIMENSION B(0:*),BA(0:100),RR(0:100)
-
- PARAMETER (Z1 = 1, HF = Z1/2, Z10 = 10)
-
- DATA TC / 5.7941 E-5,-1.76148E-3, 2.08645E-2,-1.29013E-1,
- 1 8.5777 E-1, 1.0125 E+0, 7.75 E-1, 2.3026 E+0,
- 2 1.3863 E+0, 7.3576 E-1, 1.3591 E+0/
-
- LJA=.TRUE.
- LIA=.FALSE.
- SGN=-1
- GO TO 9
-
-#if defined(CERNLIB_DOUBLE)
- ENTRY QBSIA(X,A,NMAX,ND,B)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- ENTRY DBSIA(X,A,NMAX,ND,B)
-#endif
- LJA=.FALSE.
- LIA=.TRUE.
- SGN=1
-
- 9 LER=.FALSE.
- IF(X .LE. 0) THEN
- WRITE(ERRTXT,101) X
- IF(LJA) CALL MTLPRT(NAMEJ,'C343.1',ERRTXT)
- IF(LIA) CALL MTLPRT(NAMEI,'C343.1',ERRTXT)
- LER=.TRUE.
- ELSEIF(.NOT.(0 .LE. A .AND. A .LT. 1)) THEN
- WRITE(ERRTXT,102) A
- IF(LJA) CALL MTLPRT(NAMEJ,'C343.2',ERRTXT)
- IF(LIA) CALL MTLPRT(NAMEI,'C343.2',ERRTXT)
- LER=.TRUE.
- ELSEIF(ABS(NMAX) .GT. 100) THEN
- WRITE(ERRTXT,103) NMAX
- IF(LJA) CALL MTLPRT(NAMEJ,'C343.3',ERRTXT)
- IF(LIA) CALL MTLPRT(NAMEI,'C343.3',ERRTXT)
- LER=.TRUE.
- END IF
- IF(LER) RETURN
- EPS=HF*Z10**(-ND)
- NMX=ABS(NMAX)
- IF(NMAX .LE. 0) NMX=1
- DO 5 N = 0,NMX
- RR(N)=0
- 5 BA(N)=0
- D=TC(8)*ND+TC(9)
- SX=X
- Q=0
- IF(NMX .GT. 0) THEN
- V=0.5*D/NMX
- IF(V .LE. 10) THEN
- T=TC(1)
- DO 6 I = 2,6
- 6 T=V*T+TC(I)
- ELSE
- U=LOG(V)-TC(7)
- T=V/(U*(1+(TC(7)-LOG(U))/(1+U)))
- ENDIF
- Q=NMX*T
- ENDIF
-#if defined(CERNLIB_DOUBLE)
- F=(HF*X)**A/QGAMMA(1+A)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- F=(HF*X)**A/DGAMMA(1+A)
-#endif
- T=1
- V=TC(10)*D/SX
- IF(LIA) THEN
- F=EXP(X)*F
- V=V-TC(10)
- ENDIF
- IF(LJA .OR. LIA .AND. X .LT. D) THEN
- IF(V .LE. 10) THEN
- T=TC(1)
- DO 7 I = 2,6
- 7 T=V*T+TC(I)
- ELSE
- U=LOG(V)-TC(7)
- T=V/(U*(1+(TC(7)-LOG(U))/(1+U)))
- ENDIF
- ENDIF
- NU=1+MAX(Q,TC(11)*SX*T)
-
- MU=-1
- 2 MU=MU+1
- AL=1
- IF(LJA) THEN
- DO 3 N = 1,NU/2
- XN=N
- 3 AL=AL*(XN+A)/(XN+1)
- R=0
- S=0
- LEV=.TRUE.
- DO 4 N = 2*(NU/2),1,-1
- XN=N
- XA=XN+A
- R=1/(2*XA/X-R)
- IF(N .LE. NMX) RR(N-1)=R
- IF(LEV) THEN
- AL=AL*(XN+2)/(XA+A)
- S=R*(AL*XA+S)
- ELSE
- S=R*S
- ENDIF
- LEV=.NOT.LEV
- 4 CONTINUE
- ELSE
- DO 23 N = 1,NU
- XN=N
- 23 AL=AL*(XN+2*A)/(XN+1)
- R=0
- S=0
- DO 24 N = NU,1,-1
- XN=N
- XA=XN+A
- XA2=XA+XA
- R=1/(XA2/X+R)
- IF(N .LE. NMX) RR(N-1)=R
- AL=AL*(XN+1)/(XA+A)
- S=R*(XA2*AL+S)
- 24 CONTINUE
- ENDIF
- B(0)=F/(1+S)
- DO 10 N = 0,NMX-1
- 10 B(N+1)=RR(N)*B(N)
- DO 11 N = 0,NMX
- IF(ABS(B(N)-BA(N)) .GT. EPS*ABS(B(N))) THEN
- DO 12 M = 0,NMX
- 12 BA(M)=B(M)
- NU=NU+5
- IF(MU .LE. 50) GO TO 2
- WRITE(ERRTXT,104) X,A
- IF(LJA) CALL MTLPRT(NAMEJ,'C343.4',ERRTXT)
- IF(LIA) CALL MTLPRT(NAMEI,'C343.4',ERRTXT)
- RETURN
- ENDIF
- 11 CONTINUE
- IF(NMAX .LT. 0) THEN
- AL=2/X
- B(1)=AL*A*B(0)+SGN*B(1)
- DO 13 N = 1,-NMAX-1
- 13 B(N+1)=AL*(A-N)*B(N)+SGN*B(N-1)
- ENDIF
- RETURN
- 101 FORMAT('ILLEGAL ARGUMENT X = ',1P,D15.8)
- 102 FORMAT('ILLEGAL ORDER A = ',1P,D15.8)
- 103 FORMAT('ILLEGAL NMAX = ',I5)
- 104 FORMAT('NO CONVERGENCE FOR X = ',1P,D15.8,' A = ',D15.8,
- 1 ' TRY SMALLER ND')
- END
-#endif
diff --git a/src/mathlib/gen/c/bsja64.F b/src/mathlib/gen/c/bsja64.F
deleted file mode 100644
index 65cf9b5..0000000
--- a/src/mathlib/gen/c/bsja64.F
+++ /dev/null
@@ -1,181 +0,0 @@
-*
-* $Id: bsja64.F,v 1.1.1.1 1996/04/01 15:02:08 mclareni Exp $
-*
-* $Log: bsja64.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:08 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- SUBROUTINE DBSJA(X,A,NMAX,ND,B)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- SUBROUTINE BSJA(X,A,NMAX,ND,B)
-#endif
-
-#include "gen/imp64.inc"
- REAL SX,D,T,Q,U,V,TC(11)
- CHARACTER*80 ERRTXT
- CHARACTER NAMEJ*(*),NAMEI*(*)
-#if defined(CERNLIB_DOUBLE)
- PARAMETER (NAMEJ = 'BSJA/DBSJA',
- 1 NAMEI = 'BSIA/DBSIA')
-#endif
-#if !defined(CERNLIB_DOUBLE)
- PARAMETER (NAMEJ = 'BSJA', NAMEI = 'BSIA')
-#endif
- LOGICAL LJA,LIA,LEV,LER
- DIMENSION B(0:*),BA(0:100),RR(0:100)
-
- PARAMETER (Z1 = 1, HF = Z1/2, Z10 = 10)
-
- DATA TC / 5.7941 E-5,-1.76148E-3, 2.08645E-2,-1.29013E-1,
- 1 8.5777 E-1, 1.0125 E+0, 7.75 E-1, 2.3026 E+0,
- 2 1.3863 E+0, 7.3576 E-1, 1.3591 E+0/
-
- LJA=.TRUE.
- LIA=.FALSE.
- SGN=-1
- GO TO 9
-
-#if defined(CERNLIB_DOUBLE)
- ENTRY DBSIA(X,A,NMAX,ND,B)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- ENTRY BSIA(X,A,NMAX,ND,B)
-#endif
- LJA=.FALSE.
- LIA=.TRUE.
- SGN=1
-
- 9 LER=.FALSE.
- IF(X .LE. 0) THEN
- WRITE(ERRTXT,101) X
- IF(LJA) CALL MTLPRT(NAMEJ,'C343.1',ERRTXT)
- IF(LIA) CALL MTLPRT(NAMEI,'C343.1',ERRTXT)
- LER=.TRUE.
- ELSEIF(.NOT.(0 .LE. A .AND. A .LT. 1)) THEN
- WRITE(ERRTXT,102) A
- IF(LJA) CALL MTLPRT(NAMEJ,'C343.2',ERRTXT)
- IF(LIA) CALL MTLPRT(NAMEI,'C343.2',ERRTXT)
- LER=.TRUE.
- ELSEIF(ABS(NMAX) .GT. 100) THEN
- WRITE(ERRTXT,103) NMAX
- IF(LJA) CALL MTLPRT(NAMEJ,'C343.3',ERRTXT)
- IF(LIA) CALL MTLPRT(NAMEI,'C343.3',ERRTXT)
- LER=.TRUE.
- END IF
- IF(LER) RETURN
- EPS=HF*Z10**(-ND)
- NMX=ABS(NMAX)
- IF(NMAX .LE. 0) NMX=1
- DO 5 N = 0,NMX
- RR(N)=0
- 5 BA(N)=0
- D=TC(8)*ND+TC(9)
- SX=X
- Q=0
- IF(NMX .GT. 0) THEN
- V=0.5*D/NMX
- IF(V .LE. 10) THEN
- T=TC(1)
- DO 6 I = 2,6
- 6 T=V*T+TC(I)
- ELSE
- U=LOG(V)-TC(7)
- T=V/(U*(1+(TC(7)-LOG(U))/(1+U)))
- ENDIF
- Q=NMX*T
- ENDIF
-#if defined(CERNLIB_DOUBLE)
- F=(HF*X)**A/DGAMMA(1+A)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- F=(HF*X)**A/GAMMA(1+A)
-#endif
- T=1
- V=TC(10)*D/SX
- IF(LIA) THEN
- F=EXP(X)*F
- V=V-TC(10)
- ENDIF
- IF(LJA .OR. LIA .AND. X .LT. D) THEN
- IF(V .LE. 10) THEN
- T=TC(1)
- DO 7 I = 2,6
- 7 T=V*T+TC(I)
- ELSE
- U=LOG(V)-TC(7)
- T=V/(U*(1+(TC(7)-LOG(U))/(1+U)))
- ENDIF
- ENDIF
- NU=1+MAX(Q,TC(11)*SX*T)
-
- MU=-1
- 2 MU=MU+1
- AL=1
- IF(LJA) THEN
- DO 3 N = 1,NU/2
- XN=N
- 3 AL=AL*(XN+A)/(XN+1)
- R=0
- S=0
- LEV=.TRUE.
- DO 4 N = 2*(NU/2),1,-1
- XN=N
- XA=XN+A
- R=1/(2*XA/X-R)
- IF(N .LE. NMX) RR(N-1)=R
- IF(LEV) THEN
- AL=AL*(XN+2)/(XA+A)
- S=R*(AL*XA+S)
- ELSE
- S=R*S
- ENDIF
- LEV=.NOT.LEV
- 4 CONTINUE
- ELSE
- DO 23 N = 1,NU
- XN=N
- 23 AL=AL*(XN+2*A)/(XN+1)
- R=0
- S=0
- DO 24 N = NU,1,-1
- XN=N
- XA=XN+A
- XA2=XA+XA
- R=1/(XA2/X+R)
- IF(N .LE. NMX) RR(N-1)=R
- AL=AL*(XN+1)/(XA+A)
- S=R*(XA2*AL+S)
- 24 CONTINUE
- ENDIF
- B(0)=F/(1+S)
- DO 10 N = 0,NMX-1
- 10 B(N+1)=RR(N)*B(N)
- DO 11 N = 0,NMX
- IF(ABS(B(N)-BA(N)) .GT. EPS*ABS(B(N))) THEN
- DO 12 M = 0,NMX
- 12 BA(M)=B(M)
- NU=NU+5
- IF(MU .LE. 50) GO TO 2
- WRITE(ERRTXT,104) X,A
- IF(LJA) CALL MTLPRT(NAMEJ,'C343.4',ERRTXT)
- IF(LIA) CALL MTLPRT(NAMEI,'C343.4',ERRTXT)
- RETURN
- ENDIF
- 11 CONTINUE
- IF(NMAX .LT. 0) THEN
- AL=2/X
- B(1)=AL*A*B(0)+SGN*B(1)
- DO 13 N = 1,-NMAX-1
- 13 B(N+1)=AL*(A-N)*B(N)+SGN*B(N-1)
- ENDIF
- RETURN
- 101 FORMAT('ILLEGAL ARGUMENT X = ',1P,D15.8)
- 102 FORMAT('ILLEGAL ORDER A = ',1P,D15.8)
- 103 FORMAT('ILLEGAL NMAX = ',I5)
- 104 FORMAT('NO CONVERGENCE FOR X = ',1P,D15.8,' A = ',D15.8,
- 1 ' TRY SMALLER ND')
- END
diff --git a/src/mathlib/gen/c/bska.F b/src/mathlib/gen/c/bska.F
deleted file mode 100644
index b12e791..0000000
--- a/src/mathlib/gen/c/bska.F
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: bska.F,v 1.1.1.1 1996/04/01 15:02:07 mclareni Exp $
-*
-* $Log: bska.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:07 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if !defined(CERNLIB_DOUBLE)
- SUBROUTINE BSKA(X,IA,JA,NL,B)
- DOUBLE PRECISION D,DB(0:100)
- DIMENSION B(0:*)
-
- SROUND(D)=D+(D-SNGL(D))
-
- CALL DBSKA(DBLE(X),IA,JA,NL,DB)
- GO TO 9
-
- ENTRY EBSKA(X,IA,JA,NL,B)
-
- CALL DEBKA(DBLE(X),IA,JA,NL,DB)
- 9 DO 1 N = 1,NL
- 1 B(N)=SROUND(DB(N))
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/c/bzejy128.F b/src/mathlib/gen/c/bzejy128.F
deleted file mode 100644
index 7605375..0000000
--- a/src/mathlib/gen/c/bzejy128.F
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: bzejy128.F,v 1.1.1.1 1996/04/01 15:02:09 mclareni Exp $
-*
-* $Log: bzejy128.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:09 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if !defined(CERNLIB_DOUBLE)
- SUBROUTINE DBZEJY(A,N,MODE,REL,X)
-#include "gen/imp128.inc"
- CHARACTER*(*) NAME
- PARAMETER( NAME='DBZEJY')
- CALL MTLPRT(NAME,'C345.0','Not available on this machine')
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/c/bzejy64.F b/src/mathlib/gen/c/bzejy64.F
deleted file mode 100644
index b7ca745..0000000
--- a/src/mathlib/gen/c/bzejy64.F
+++ /dev/null
@@ -1,223 +0,0 @@
-*
-* $Id: bzejy64.F,v 1.1.1.1 1996/04/01 15:02:09 mclareni Exp $
-*
-* $Log: bzejy64.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:09 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if !defined(CERNLIB_DOUBLE)
- SUBROUTINE RBZEJY(A,N,MODE,REL,X)
-#endif
-#if defined(CERNLIB_DOUBLE)
- SUBROUTINE DBZEJY(A,N,MODE,REL,X)
-#include "gen/imp64.inc"
-#endif
-C Computes the first n positive (in the case Jo'(x) the first n
-C non-negative) zeros of the Bessel functions
-C Ja(x), Ya(x), Ja'(x), Ya'(x),
-C where a >= 0 and ' = d/dx.
-C
-C Based on Algol procedures published in
-C
-C N.M. TEMME, An algorithm with Algol 60 program for the compu-
-C tation of the zeros of ordinary Bessel functions and those of
-C their derivatives, J. Comput. Phys. 32 (1979) 270-279, and
-C
-C N.M. TEMME, On the numerical evaluation of the ordinary Bessel
-C function of the second kind, J. Comput. Phys. 21 (1976) 343-350.
-
- DIMENSION X(*),FCO(4),ICO(4),H(13)
- CHARACTER NAME*(*)
- CHARACTER*80 ERRTXT
-#if !defined(CERNLIB_DOUBLE)
- PARAMETER (NAME = 'RBZEJY')
-#endif
-#if defined(CERNLIB_DOUBLE)
- PARAMETER (NAME = 'RBZEJY/DBZEJY')
-#endif
-
- PARAMETER (Z1 = 1, Z2 = 2, Z5 = 5, Z6 = 6, Z7 = 7)
- PARAMETER (C1 = Z5/48, C2 = -Z5/36, C3 = -Z7/48)
- PARAMETER (C4 = 5*Z7/288, C5 = Z1/64, C6 = Z6/5, C7 = 3*Z6/7)
- PARAMETER (E1 = Z1/3, E2 = Z2/3, HALF = Z1/2)
- PARAMETER (PI = 3.14159 26535 89793 24D0)
- PARAMETER (PIH = PI/2, PI1 = 3*PI/8)
-
- DATA FCO /-2.33811,-1.17371,-1.01879,-2.29444/, ICO /1,3,3,1/
-
-#if !defined(CERNLIB_DOUBLE)
- ENTRY BZEJY(A,N,MODE,REL,X)
-#endif
-
- IF(N .LE. 0) RETURN
- IF(A .LT. 0) THEN
- WRITE(ERRTXT,101) A
- CALL MTLPRT(NAME,'C345.1',ERRTXT)
- RETURN
- ENDIF
- NA=NINT(A)
- A0=A-NA
- H(1)=A**2
- H(2)=4*H(1)
- H(3)=H(2)**2
- H(4)=H(3)+H(3)
- H(5)=12*A+6
- H(6)=H(5)-4
- H(7)=3*A-8
- H(8)=HALF*(A-HALF*ICO(MODE))
- H(9)=COS(A0*PI)/(PI*REL)
- H(10)=PIH*(A+HALF)
- H(11)=HALF+A0
- H(12)=H(11)*(HALF-A0)
- H(13)=1
- IF(A .GE. 3) H(13)=A**(-E2)
- P1=0
- Q1=0
- IF(MODE .LT. 3) THEN
- IF(N .GE. H(7)) THEN
- P=7*H(2)-31
- PP=H(2)-1
- IF(1+P .NE. P) THEN
- P1=PP*((1012*H(2)-14888)*H(2)+71476)/(15*P)
- Q1=((664*H(2)-7856)*H(2)+30232)/(5*P)
- ENDIF
- ENDIF
- P2=C1
- Q2=C2
- R2=C6
- ELSE
- IF(N .GE. H(7)) THEN
- P=(7*H(2)+82)*H(2)-9
- PP=H(2)+3
- IF(1+P .NE. P) THEN
- P1=((((1012*H(2)+32816)*H(2)-55496)*H(2)-104400)*H(2)+
- 1 253044)/(15*P)
- Q1=(((664*H(2)+16600)*H(2)-24312)*H(2)+28296)/(5*P)
- ENDIF
- ENDIF
- P2=C3
- Q2=C4
- R2=C7
- ENDIF
- X(1)=0
- N0=1
- IF(A .EQ. 0 .AND. MODE .EQ. 3) N0=2
-
- DO 1 L = N0,N
- IF(L .GE. H(7)) THEN
- B=(L+H(8))*PI
- C=C5/B**2
- X0=B-(PP-P1*C)/(8*B*(1-Q1*C))
- ELSE
- IF(L .EQ. 1) THEN
- X0=FCO(MODE)
- ELSE
- X0=PI1*(4*L-ICO(MODE))
- V=1/X0**2
- X0=-X0**E2*(1+V*(P2+Q2*V))
- ENDIF
- U=H(13)*X0
- Y=E2*SQRT(ABS(U)**3)
-
- IF(Y .LT. 1) THEN
- G0=(3*Y)**E1
- G1=G0**2
- G0=G0*(1-G1*(210+G1*(G1+G1-27))/1575)
- ELSE
- G0=1/(Y+PIH)
- G1=G0**2
- G0=PIH-G0*(1+G1*(2310+G1*(3003+G1*(4818+G1*
- 1 (8591+G1*16328))))/3465)
- ENDIF
- G2=Y+G0
- G1=G2**2
- G=(G0-ATAN(G2))/G1
- W=1/COS(G0-(1+G1)*(1+G/G2)*G)
- G=1/(1-W**2)
- C=SQRT(U*G)
- X0=W*(A-P2*C*(1/U-C*(G+G-R2))/(A*U))
- ENDIF
-
- DO 2 J = 1,5
- XX=X0**2
- AX=H(1)-XX
-
- B=X0+X0
- E=(H(9)*X0)**2
- P=1
- Q=-X0
- S=1+XX
- R=S
- DO 3 K = 2,500
- IF(R*(K**2) .GE. E) GO TO 9
- RK=Z1/(K+1)
- D=((K-1)+H(12)/K)/S
- P=RK*((K+K)-P*D)
- Q=RK*(Q*D-B)
- S=P**2+Q**2
- R=R*S
- 3 CONTINUE
- 9 G=1/S
- P=G*P
- F=P
- Q=-G*Q
- G=Q
- DO 4 M = K+1,2,-1
- R=M*(2-P)-2
- S=B+M*Q
- D=((M-2)+H(12)/(M-1))/(R**2+S**2)
- P=D*R
- Q=D*S
- E=F+1
- F=P*E-G*Q
- G=Q*E+P*G
- 4 CONTINUE
- F=F+1
- D=1/(F**2+G**2)
- PA=F*D
- QA=-G*D
- D=H(11)-P
- Q=Q+X0
- RX=1/X0
- PA1=RX*(PA*Q-QA*D)
- QA1=RX*(QA*Q+PA*D)
- XR=RX+RX
- B=(1+A0)*XR
- DO 5 M = 1,NA
- P0=PA-QA1*B
- Q0=QA+PA1*B
- PA=PA1
- PA1=P0
- QA=QA1
- QA1=Q0
- B=B+XR
- 5 CONTINUE
-
- SX=SIN(X0-H(10))
- CX=COS(X0-H(10))
- GO TO (11,12,13,14), MODE
- 11 R0=(PA*CX-QA*SX)/(PA1*SX+QA1*CX)
- V=R0/(H(5)*X0)
- W=R0*(1+V*(1-4*AX))/(1+V*(4*(XX-H(2))-H(6)))
- GO TO 10
- 12 R0=(PA*SX+QA*CX)/(QA1*SX-PA1*CX)
- V=R0/(H(5)*X0)
- W=R0*(1+V*(1-4*AX))/(1+V*(4*(XX-H(2))-H(6)))
- GO TO 10
- 13 R0=A/X0-(PA1*SX+QA1*CX)/(PA*CX-QA*SX)
- GO TO 15
- 14 R0=A/X0-(QA1*SX-PA1*CX)/(PA*SX+QA*CX)
- 15 V=E2*R0*X0*AX/(H(1)+XX)
- W=C5/AX**3
- W=-XX*R0*(1+V*(1-W*(H(3)-XX*(40*H(2)+48*XX))))/
- 1 (AX*(1+V*(1+W*(H(4)+XX*(64*H(2)+96*XX)))))
- 10 X0=X0+W
- IF(ABS(W) .LE. REL*X0) GO TO 6
- 2 CONTINUE
- 6 X(L)=X0
- 1 CONTINUE
- RETURN
- 101 FORMAT('NEGATIVE INDEX A = ',1P,D15.8)
- END
diff --git a/src/mathlib/gen/c/c309prec.inc b/src/mathlib/gen/c/c309prec.inc
deleted file mode 100644
index 0739461..0000000
--- a/src/mathlib/gen/c/c309prec.inc
+++ /dev/null
@@ -1,44 +0,0 @@
-*
-* $Id: c309prec.inc,v 1.1.1.1 1996/04/01 15:01:56 mclareni Exp $
-*
-* $Log: c309prec.inc,v $
-* Revision 1.1.1.1 1996/04/01 15:01:56 mclareni
-* Mathlib gen
-*
-*
-*
-* c309prec.inc
-*
-
-#if defined(CERNLIB_IBM)||defined(CERNLIB_IBMAIX)
- PARAMETER(FPMAX = 1D60, FPMIN = 2D-61)
- PARAMETER(ACCU = 1D-14, ACC8 = 2D-16, ACC16 = 3D-33)
-
-#elif defined(CERNLIB_VAX)
- PARAMETER(FPMAX = 1D21, FPMIN = 3D-22)
- PARAMETER(ACCU = 5D-15, ACC8 = 2D-17, ACC16 = 3D-34)
-
-#elif defined(CERNLIB_CDC)
- PARAMETER(FPMAX = 1E250, FPMIN = 1E-250)
- PARAMETER(ACCU = 1D-13, ACC8 = 4D-15, ACC16 = 2D-29)
-
-#elif (defined(CERNLIB_CONVEX))&&(defined(CERNLIB_SINGLE))
- PARAMETER(FPMAX = 3D292, FPMIN = 2D-293)
- PARAMETER(ACCU = 1D-14, ACC8 = 2D-16, ACC16 = 2D-34)
-
-#elif defined(CERNLIB_NECSX)
- PARAMETER(FPMAX = 4D74 , FPMIN = 5D-79 )
- PARAMETER(ACCU = 1D-14, ACC8 = 2D-16, ACC16 = 2D-16)
-
-#elif (defined(CERNLIB_SINGLE))&&(!defined(CERNLIB_CDC))&&(!defined(CERNLIB_CONVEX))
- PARAMETER(FPMAX = 1E2451, FPMIN = 1E-2451)
- PARAMETER(ACCU = 1D-12, ACC8 = 7D-15, ACC16 = 2D-29)
-
-#elif defined(CERNLIB_QUAD)
- PARAMETER(FPMAX = 3D292, FPMIN = 2D-292)
- PARAMETER(ACCU = 1D-14, ACC8 = 2D-16, ACC16 = 2D-34)
-
-#elif 1
- PARAMETER(FPMAX = 3D292, FPMIN = 2D-292)
- PARAMETER(ACCU = 1D-14, ACC8 = 2D-16, ACC16 = 2D-16)
-#endif
diff --git a/src/mathlib/gen/c/c311bd.F b/src/mathlib/gen/c/c311bd.F
deleted file mode 100644
index b9b470e..0000000
--- a/src/mathlib/gen/c/c311bd.F
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: c311bd.F,v 1.1.1.1 1996/04/01 15:01:58 mclareni Exp $
-*
-* $Log: c311bd.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:58 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE C311BD
-#include "legbl.inc"
- DATA IBD/0/
- IF(IBD.NE.0) RETURN
- IBD=1
- PISR=1.7724 53850 90552
- PI=3.141592653589793
- U=(0.0,1.0)
- RETURN
- END
diff --git a/src/mathlib/gen/c/c344cod1.inc b/src/mathlib/gen/c/c344cod1.inc
deleted file mode 100644
index 7da2af7..0000000
--- a/src/mathlib/gen/c/c344cod1.inc
+++ /dev/null
@@ -1,35 +0,0 @@
-*
-* $Id: c344cod1.inc,v 1.1.1.1 1996/04/01 15:02:09 mclareni Exp $
-*
-* $Log: c344cod1.inc,v $
-* Revision 1.1.1.1 1996/04/01 15:02:09 mclareni
-* Mathlib gen
-*
-*
-*
-* c344cod1.inc
-*
- X=Z
- Y=-I*Z
- LER=.FALSE.
- IF(X .LE. 0 .AND. Y .EQ. 0) THEN
- WRITE(ERRTXT,101) Z
- CALL MTLPRT(NAME,'C344.1',ERRTXT)
- LER=.TRUE.
- ELSEIF(.NOT.(0 .LE. A .AND. A .LT. 1)) THEN
- WRITE(ERRTXT,102) A
- CALL MTLPRT(NAME,'C344.2',ERRTXT)
- LER=.TRUE.
- ELSEIF(.NOT.(0 .LE. NMAX .AND. NMAX .LE. 100)) THEN
- WRITE(ERRTXT,103) NMAX
- CALL MTLPRT(NAME,'C344.3',ERRTXT)
- LER=.TRUE.
- END IF
- IF(LER) RETURN
- AZ=ABS(Z)
- YA=ABS(Y)
- ZA=X+I*YA
- EPS=HF*Z10**(-ND)
- DO 5 N = 0,NMAX
- RR(N)=0
- 5 CBA(N)=0
diff --git a/src/mathlib/gen/c/c344cod2.inc b/src/mathlib/gen/c/c344cod2.inc
deleted file mode 100644
index 0db162a..0000000
--- a/src/mathlib/gen/c/c344cod2.inc
+++ /dev/null
@@ -1,83 +0,0 @@
-*
-* $Id: c344cod2.inc,v 1.1.1.1 1996/04/01 15:02:09 mclareni Exp $
-*
-* $Log: c344cod2.inc,v $
-* Revision 1.1.1.1 1996/04/01 15:02:09 mclareni
-* Mathlib gen
-*
-*
-*
-* c344cod2.inc
-*
- D=TC(8)*ND+TC(9)
- Q=0
- R0=AZ
- IF(NMAX .GT. 0) THEN
- V=0.5*D/NMAX
- IF(V .LE. 10) THEN
- T=TC(1)
- DO 6 J = 2,6
- 6 T=V*T+TC(J)
- ELSE
- U=LOG(V)-TC(7)
- T=V/(U*(1+(TC(7)-LOG(U))/(1+U)))
- END IF
- Q=NMAX*T
- END IF
- T=1
- IF(YA .LT. D) THEN
- V=TC(10)*(D-YA)/R0
- IF(V .LE. 10) THEN
- T=TC(1)
- DO 7 J = 2,6
- 7 T=V*T+TC(J)
- ELSE
- U=LOG(V)-TC(7)
- T=V/(U*(1+(TC(7)-LOG(U))/(1+U)))
- END IF
- END IF
- NU=1+MAX(Q,TC(11)*R0*T)
-
- A2=A+A
- MU=-1
- 2 MU=MU+1
- AL=1
- DO 3 N = 1,NU
- XN=N
- 3 AL=AL*(XN+A2)/(XN+1)
- C=(-I)**NU
- R=0
- S=0
- DO 4 N = NU,1,-1
- XN=N
- A2N=2*(A+XN)
- R=ZA/(A2N-ZA*R)
- IF(N .LE. NMAX) RR(N-1)=R
- AL=AL*(XN+1)/(XN+A2)
- S=R*(A2N*AL*C+S)
- 4 C=I*C
- CB(0)=F/(1+S)
- DO 10 N = 0,NMAX-1
- 10 CB(N+1)=RR(N)*CB(N)
- IF(Y .LT. 0) THEN
- DO 11 N = 0,NMAX
- 11 CB(N)=GCONJG(CB(N))
- END IF
- DO 12 N = 0,NMAX
- IF(ABS(CB(N)-CBA(N)) .GT. EPS*ABS(CB(N))) THEN
- DO 13 M = 0,NMAX
- 13 CBA(M)=CB(M)
- NU=NU+5
- IF(MU .LE. 50) GO TO 2
- WRITE(ERRTXT,104) Z,A
- CALL MTLPRT(NAME,'C344.4',ERRTXT)
- RETURN
- END IF
- 12 CONTINUE
- RETURN
- 101 FORMAT('ILLEGAL ARGUMENT Z = ',1P,2D15.8)
- 102 FORMAT('ILLEGAL ORDER A = ',1P,D15.8)
- 103 FORMAT('ILLEGAL NMAX = ',I5)
- 104 FORMAT('NO CONVERGENCE, Z = ',1P,2D13.6,' A = ',D13.6,
- 1 ' TRY SMALLER ND')
- END
diff --git a/src/mathlib/gen/c/cbsja.F b/src/mathlib/gen/c/cbsja.F
deleted file mode 100644
index 976ba63..0000000
--- a/src/mathlib/gen/c/cbsja.F
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: cbsja.F,v 1.1.1.1 1996/04/01 15:02:09 mclareni Exp $
-*
-* $Log: cbsja.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:09 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- SUBROUTINE CBSJA(Z,A,NMAX,ND,CB)
- COMPLEX Z,CB(0:*)
-#include "gen/defc64.inc"
- + V(0:100),W
-#include "gen/def64.inc"
- + D
-#if defined(CERNLIB_QF2C)
-#include "defdr.inc"
-#endif
- SROUND(D)=D+(D-SNGL(D))
- W=Z
- CALL WBSJA(W,DBLE(A),NMAX,ND,V)
- DO 1 N = 0,NMAX
- 1 CB(N)=CMPLX(SROUND(DREAL(V(N))),SROUND(DIMAG(V(N))))
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/c/cbsja128.F b/src/mathlib/gen/c/cbsja128.F
deleted file mode 100644
index 44c5a1b..0000000
--- a/src/mathlib/gen/c/cbsja128.F
+++ /dev/null
@@ -1,181 +0,0 @@
-*
-* $Id: cbsja128.F,v 1.1.1.1 1996/04/01 15:02:09 mclareni Exp $
-*
-* $Log: cbsja128.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:09 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_IBMVM)
- SUBROUTINE WQBSJA(Z,A,NMAX,ND,CB)
-
-#include "gen/imp128.inc"
-#include "gen/defc128.inc"
- + Z,ZA,CB,I,CBA,RR,F,C,S,R,GCONJG,ZZ
- REAL R0,D,T,Q,U,V,TC(11)
- CHARACTER*80 ERRTXT
- CHARACTER NAME*(*)
- PARAMETER (NAME = 'WQBSJA')
- LOGICAL LER
- DIMENSION CB(0:*),CBA(0:100),RR(0:100)
-
- PARAMETER (I = (0Q0,1Q0))
- PARAMETER (Z0 = 0, Z1 = 1, HF = Z1/2, Z10 = 10)
-
- DATA TC / 5.7941 E-5,-1.76148E-3, 2.08645E-2,-1.29013E-1,
- 1 8.5777 E-1, 1.0125 E+0, 7.75 E-1, 2.3026 E+0,
- 2 1.3863 E+0, 7.3576 E-1, 1.3591 E+0/
-
- GCONJG(ZZ)=QCONJG(ZZ)
-#include "c344cod1.inc"
- F=EXP(YA+I*(A*ATAN2(YA,X)-X))*(HF*AZ)**A/QGAMMA(1+A)
-#include "c344cod2.inc"
-#endif
-*
-#if !defined(CERNLIB_DOUBLE)
- SUBROUTINE WBSJA(Z,A,NMAX,ND,CB)
-
-#include "gen/imp128.inc"
- REAL R0,D,T,Q,U,V,TC
- LOGICAL LER
- DIMENSION Z(2),CB(2,0:*),CBA(2,0:100),RR(2,0:100)
- CHARACTER NAME*(*)
- CHARACTER*80 ERRTXT
- PARAMETER (NAME = 'WBSJA')
- DIMENSION TC(11)
-
- PARAMETER (Z0 = 0, Z1 = 1, Z2 = 2, Z10 = 10, HF = Z1/2)
-
- DATA TC / 5.7941 E-5,-1.76148E-3, 2.08645E-2,-1.29013E-1,
- 1 8.5777 E-1, 1.0125 E+0, 7.75 E-1, 2.3026 E+0,
- 2 1.3863 E+0, 7.3576 E-1, 1.3591 E+0/
-
- X=Z(1)
- Y=Z(2)
- LER=.FALSE.
- IF(X .LE. 0 .AND. Y .EQ. 0) THEN
- WRITE(ERRTXT,101) Z(1),Z(2)
- CALL MTLPRT(NAME,'C344.1',ERRTXT)
- LER=.TRUE.
- ELSEIF(.NOT.(0 .LE. A .AND. A .LT. 1)) THEN
- WRITE(ERRTXT,102) A
- CALL MTLPRT(NAME,'C344.2',ERRTXT)
- LER=.TRUE.
- ELSEIF(.NOT.(0 .LE. NMAX .AND. NMAX .LT. 100)) THEN
- WRITE(ERRTXT,103) NMAX
- CALL MTLPRT(NAME,'C344.3',ERRTXT)
- LER=.TRUE.
- END IF
- IF(LER) RETURN
- RS=X**2+Y**2
- R1=SQRT(RS)
- YA=ABS(Y)
- DEPS=HF*Z10**(-ND)
- DO 5 N = 0,NMAX
- DO 5 I = 1,2
- RR(I,N)=0
- 5 CBA(I,N)=0
- PHI=A*ATAN2(YA,X)-X
- C=EXP(YA)*(HF*R1)**A/DGAMMA(1+A)
- SU1=C*COS(PHI)
- SU2=C*SIN(PHI)
- R0=R1
- D=TC(8)*ND+TC(9)
- Q=0
- IF(NMAX .GT. 0) THEN
- V=D/(2*NMAX)
- IF(V .LE. 10) THEN
- T=TC(1)
- DO 6 I = 2,6
- 6 T=V*T+TC(I)
- ELSE
- U=LOG(V)-TC(7)
- T=V/(U*(1+(TC(7)-LOG(U))/(1+U)))
- END IF
- Q=NMAX*T
- END IF
- T=1
- IF(YA .LT. D) THEN
- V=TC(10)*(D-YA)/R0
- IF(V .LE. 10) THEN
- T=TC(1)
- DO 7 I = 2,6
- 7 T=V*T+TC(I)
- ELSE
- U=LOG(V)-TC(7)
- T=V/(U*(1+(TC(7)-LOG(U))/(1+U)))
- END IF
- END IF
- NU=1+MAX(Q,TC(11)*R0*T)
-
- H1=A+A
- MU=-1
- 2 MU=MU+1
- AL=1
- C1=1
- C2=0
- DO 3 N = 1,NU
- DN=N
- AL=AL*(DN+H1)/(DN+1)
- C=-C1
- C1=C2
- 3 C2=C
- R1=0
- R2=0
- S1=0
- S2=0
- DO 4 N = NU,1,-1
- DN=N
- H=2*(A+DN)
- C=1/((H-X*R1+YA*R2)**2+(X*R2+YA*R1)**2)
- R1=(H*X-RS*R1)*C
- R2=(H*YA+RS*R2)*C
- IF(N .LE. NMAX) THEN
- RR(1,N-1)=R1
- RR(2,N-1)=R2
- END IF
- AL=AL*(DN+1)/(DN+H1)
- C=H*AL
- A1=C*C1
- A2=C*C2
- C=C1
- C1=-C2
- C2=C
- AS1=A1+S1
- AS2=A2+S2
- S=R1*AS1-R2*AS2
- S2=R1*AS2+R2*AS1
- 4 S1=S
- AS1=1+S1
- C=1/(AS1**2+S2**2)
- CB(1,0)=(SU1*AS1+SU2*S2)*C
- CB(2,0)=(SU2*AS1-SU1*S2)*C
- DO 10 N = 0,NMAX-1
- CB(1,N+1)=RR(1,N)*CB(1,N)-RR(2,N)*CB(2,N)
- 10 CB(2,N+1)=RR(1,N)*CB(2,N)+RR(2,N)*CB(1,N)
- IF(Y .LT. 0) THEN
- DO 11 N = 0,NMAX
- 11 CB(2,N)=-CB(2,N)
- END IF
- DO 12 N = 0,NMAX
- IF(SQRT((CB(1,N)-CBA(1,N))**2+(CB(2,N)-CBA(2,N))**2)
- 1 .GT. DEPS*SQRT(CB(1,N)**2+CB(2,N)**2)) THEN
- DO 13 M = 0,NMAX
- CBA(1,M)=CB(1,M)
- 13 CBA(2,M)=CB(2,M)
- NU=NU+5
- IF(MU .LE. 50) GO TO 2
- WRITE(ERRTXT,104) Z(1),Z(2),A
- CALL MTLPRT(NAME,'C344.4',ERRTXT)
- RETURN
- END IF
- 12 CONTINUE
- RETURN
- 101 FORMAT('ILLEGAL ARGUMENT Z = (',1P,D15.8,', ',D15.8,')')
- 102 FORMAT('ILLEGAL ORDER A = ',1P,D15.8)
- 103 FORMAT('ILLEGAL NMAX = ',I5)
- 104 FORMAT('NO CONVERGENCE, Z = (',1P,D13.6,', ',D13.6,')',
- 1 ' A = ',D13.6,' TRY SMALLER ND')
- END
-#endif
diff --git a/src/mathlib/gen/c/cbsja64.F b/src/mathlib/gen/c/cbsja64.F
deleted file mode 100644
index 0a3b199..0000000
--- a/src/mathlib/gen/c/cbsja64.F
+++ /dev/null
@@ -1,60 +0,0 @@
-*
-* $Id: cbsja64.F,v 1.1.1.1 1996/04/01 15:02:09 mclareni Exp $
-*
-* $Log: cbsja64.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:09 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- SUBROUTINE WBSJA(Z,A,NMAX,ND,CB)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- SUBROUTINE CBSJA(Z,A,NMAX,ND,CB)
-#endif
-#include "gen/imp64.inc"
-#include "gen/defc64.inc"
- + Z,ZA,CB,I,CBA,RR,F,C,S,R,GCONJG,ZZ
- REAL R0,D,T,Q,U,V,TC(11)
- CHARACTER*80 ERRTXT
- CHARACTER NAME*(*)
-#if defined(CERNLIB_DOUBLE)
- PARAMETER (NAME = 'CBSJA/WBSJA')
-#endif
-#if !defined(CERNLIB_DOUBLE)
- PARAMETER (NAME = 'CBSJA')
-#endif
- LOGICAL LER
- DIMENSION CB(0:*),CBA(0:100),RR(0:100)
-
-#if defined(CERNLIB_QF2C)
-#include "defdr.inc"
-#endif
-
-#if defined(CERNLIB_DOUBLE)
- PARAMETER (I = (0D0,1D0))
-#endif
-#if !defined(CERNLIB_DOUBLE)
- PARAMETER (I = (0E0,1E0))
-#endif
- PARAMETER (Z0 = 0, Z1 = 1, HF = Z1/2, Z10 = 10)
-
- DATA TC / 5.7941 E-5,-1.76148E-3, 2.08645E-2,-1.29013E-1,
- 1 8.5777 E-1, 1.0125 E+0, 7.75 E-1, 2.3026 E+0,
- 2 1.3863 E+0, 7.3576 E-1, 1.3591 E+0/
-
-#if defined(CERNLIB_DOUBLE)
- GCONJG(ZZ)=DCONJG(ZZ)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- GCONJG(ZZ)=CONJG(ZZ)
-#endif
-#include "c344cod1.inc"
-#if defined(CERNLIB_DOUBLE)
- F=EXP(YA+I*(A*ATAN2(YA,X)-X))*(HF*AZ)**A/DGAMMA(1+A)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- F=EXP(YA+I*(A*ATAN2(YA,X)-X))*(HF*AZ)**A/GAMMA(1+A)
-#endif
-#include "c344cod2.inc"
diff --git a/src/mathlib/gen/c/cclbes.F b/src/mathlib/gen/c/cclbes.F
deleted file mode 100644
index 59ffc46..0000000
--- a/src/mathlib/gen/c/cclbes.F
+++ /dev/null
@@ -1,820 +0,0 @@
-*
-* $Id: cclbes.F,v 1.1.1.1 1996/04/01 15:01:56 mclareni Exp $
-*
-* $Log: cclbes.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:56 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_SINGLE)
- SUBROUTINE CCLBES(ZZ,ETA1,ZLMIN,NL,FC,GC,FCP,GCP,SIG,KFN,MODE1,
- 1 IFAIL,IPR)
-C
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-C C
-C COMPLEX COULOMB WAVEFUNCTION PROGRAM USING STEED'S METHOD C
-C Original title : COULCC C
-C C
-C A. R. Barnett Manchester March 1981 C
-C modified I.J. Thompson Daresbury, Sept. 1983 for Complex Functions C
-C C
-C The FORM (not the SUBSTANCE) of this program has been modified C
-C by K.S. KOLBIG (CERN) December 1987 C
-C C
-C original program RCWFN in CPC 8 (1974) 377-395 C
-C + RCWFF in CPC 11 (1976) 141-142 C
-C + COULFG in CPC 27 (1982) 147-166 C
-C description of real algorithm in CPC 21 (1981) 297-314 C
-C description of complex algorithm JCP 64 (1986) 490-509 C
-C this version written up in CPC 36 (1985) 363-372 C
-C C
-C CCLBES returns F,G,G',G',SIG for complex ETA, ZZ, and ZLMIN, C
-C for NL integer-spaced lambda values ZLMIN to ZLMIN+NL inclusive, C
-C thus giving complex-energy solutions to the Coulomb Schrodinger C
-C equation,to the Klein-Gordon equation and to suitable forms of C
-C the Dirac equation ,also spherical & cylindrical Bessel equations C
-C C
-C if ABS(MODE1) C
-C = 1 get F,G,F',G' for integer-spaced lambda values C
-C = 2 F,G unused arrays must be dimensioned in C
-C = 3 F, F' call to at least length (0:1) C
-C = 4 F C
-C = 11 get F,H+,F',H+' ) if KFN=0, H+ = G + i.F ) C
-C = 12 F,H+ ) >0, H+ = J + i.Y = H(1) ) in C
-C = 21 get F,H-,F',H-' ) if KFN=0, H- = G - i.F ) GC C
-C = 22 F,H- ) >0, H- = J - i.Y = H(2) ) C
-C C
-C if MODE1 < 0 then the values returned are scaled by an exponen- C
-C tial factor (dependent only on ZZ) to bring nearer C
-C unity the functions for large ABS(ZZ), small ETA , C
-C and ABS(ZL) < ABS(ZZ). C
-C Define SCALE = ( 0 if MODE1 > 0 C
-C ( IMAG(ZZ) if MODE1 < 0 & KFN < 3 C
-C ( REAL(ZZ) if MODE1 < 0 & KFN = 3 C
-C then FC = EXP(-ABS(SCALE)) * ( F, j, J, or I) C
-C and GC = EXP(-ABS(SCALE)) * ( G, y, or Y ) C
-C or EXP(SCALE) * ( H+, H(1), or K) C
-C or EXP(-SCALE) * ( H- or H(2) ) C
-C C
-C if KFN = 0,-1 complex Coulomb functions are returned F & G C
-C = 1 spherical Bessel " " " j & y C
-C = 2 cylindrical Bessel " " " J & Y C
-C = 3 modified cyl. Bessel " " " I & K C
-C C
-C and where Coulomb phase shifts put in SIG if KFN=0 (not -1) C
-C C
-C The use of MODE and KFN is independent C
-C (except that for KFN=3, H(1) & H(2) are not given) C
-C C
-C With negative orders lambda, CCLBES can still be used but with C
-C reduced accuracy as CF1 becomes unstable. The user is thus C
-C strongly advised to use reflection formulae based on C
-C H+-(ZL,,) = H+-(-ZL-1,,) * exp +-i(sig(ZL)-sig(-ZL-1)-(ZL+1/2)pi) C
-C C
-C Precision: results to within 2-3 decimals of 'machine accuracy', C
-C except in the following cases: C
-C (1) if CF1A fails because X too small or ETA too large C
-C the F solution is less accurate if it decreases with C
-C decreasing lambda (e.g. for lambda.LE.-1 & ETA.NE.0) C
-C (2) if ETA is large (e.g. >> 50) and X inside the C
-C turning point, then progressively less accuracy C
-C (3) if ZLMIN is around sqrt(ACCUR) distance from an C
-C integral order and abs(X) << 1, then errors present. C
-C RERR traces the main roundoff errors. C
-C C
-C CCLBES is coded for real*8 on IBM or equivalent ACCUR >= 10**-14 C
-C with a section of doubled REAL*16 for less roundoff errors. C
-C (If no doubled precision available, increase JMAX to eg 100)C
-C Use IMPLICIT COMPLEX*32 & REAL*16 on VS compiler ACCUR >= 10**-32 C
-C For single precision CDC (48 bits) reassign C
-C DOUBLE PRECISION=REAL etc. C
-C C
-C IPR on input = 0 : no printing of error messages C
-C ne 0 : print error messages on file 6 C
-C IFAIL in output = -2 : argument out of range C
-C = -1 : one of the continued fractions failed, C
-C or arithmetic check before final recursion C
-C = 0 : All Calculations satisfactory C
-C ge 0 : results available for orders up to & at C
-C position NL-IFAIL in the output arrays. C
-C = -3 : values at ZLMIN not found as over/underflowC
-C = -4 : roundoff errors make results meaningless C
-C C
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-C C
-C Machine dependent constants : C
-C C
-C ACCU target bound on relative error (except near 0 crossings)C
-C (ACCUR should be at least 100 * ACC8) C
-C ACC8 smallest number with 1+ACC8 .ne.1 in REAL*8 arithmetic C
-C ACC16 smallest number with 1+ACC16.ne.1 in REAL*16 arithmetic C
-C FPMAX magnitude of largest floating point number * ACC8 C
-C FPMIN magnitude of smallest floating point number / ACC8 C
-C C
-C Parameters determining region of calculations : C
-C C
-C R20 estimate of (2F0 iterations)/(CF2 iterations) C
-C ASYM minimum X/(ETA**2+L) for CF1A to converge easily C
-C XNEAR minimum ABS(X) for CF2 to converge accurately C
-C LIMIT maximum no. iterations for CF1, CF2, and 1F1 series C
-C JMAX size of work arrays for Pade accelerations C
-C NDROP number of successive decrements to define instabilityC
-C C
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-C
-C C309R1 = CF2, C309R2 = F11, C309R3 = F20,
-C C309R4 = CF1R, C309R5 = CF1C, C309R6 = CF1A,
-C C309R7 = RCF, C309R8 = CTIDY.
-C
- IMPLICIT COMPLEX (A-H,O-Z)
-C
- COMMON /COULC2/ NFP,N11,NPQ1,NPQ2,N20,KAS1,KAS2
- EQUIVALENCE (NPQ(1),NPQ1),(NPQ(2),NPQ2)
- EQUIVALENCE (KAS(1),KAS1),(KAS(2),KAS2)
- REAL ZERO,ONE,TWO,HALF
- REAL R20,ASYM,XNEAR
- REAL FPMAX,FPMIN,FPLMAX,FPLMIN
- REAL ACCU,ACC8,ACC16
- REAL HPI,TLOG
- REAL ERR,RERR,ABSC,ACCUR,ACCT,ACCH,ACCB,C309R4
- REAL PACCQ,EPS,OFF,SCALE,SF,SFSH,TA,RK,OMEGA,ABSX
- REAL SX1,SETA,SZLL
-
- LOGICAL LPR,ETANE0,IFCP,RLEL,DONEM,UNSTAB,ZLNEG,AXIAL,NOCF2,NPINT
-
- PARAMETER(ZERO = 0, ONE = 1, TWO = 2, HALF = ONE/TWO)
- PARAMETER(CI = (0,1), CIH = CI/TWO)
- PARAMETER(R20 = 3, ASYM = 3, XNEAR = HALF)
- PARAMETER(LIMIT = 20000, NDROP = 8, JMAX = 50)
-
-#include "c309prec.inc"
-
- PARAMETER(HPI = 1.57079 63267 94896 619D0)
- PARAMETER(TLOG = 0.69314 71805 59945 309D0)
-
- DIMENSION FC(0:*),GC(0:*),FCP(0:*),GCP(0:*),SIG(0:*)
- DIMENSION XRCF(JMAX,4)
- INTEGER NPQ(2),KAS(2)
-
- NINTC(W)=NINT(REAL(W))
- ABSC(W)=ABS(REAL(W))+ABS(AIMAG(W))
- NPINT(W,ACCB)=ABSC(NINTC(W)-W) .LT. ACCB .AND. REAL(W) .LT. HALF
-C
- MODE=MOD(ABS(MODE1),10)
- IFCP=MOD(MODE,2) .EQ. 1
- LPR=IPR .NE. 0
- IFAIL=-2
- N11=0
- NFP=0
- KAS(1)=0
- KAS(2)=0
- NPQ(1)=0
- NPQ(2)=0
- N20=0
-
- ACCUR=MAX(ACCU,50*ACC8)
- ACCT=HALF*ACCUR
- ACCH=SQRT(ACCUR)
- ACCB=SQRT(ACCH)
- RERR=ACCT
- FPLMAX=LOG(FPMAX)
- FPLMIN=LOG(FPMIN)
-C
- CIK=ONE
- IF(KFN .GE. 3) CIK=CI*SIGN(ONE,FPMIN-AIMAG(ZZ))
- X=ZZ*CIK
- ETA=ETA1
- IF(KFN .GT. 0) ETA=ZERO
- ETANE0=ABSC(ETA) .GT. ACC8
- ETAI=ETA*CI
- DELL=ZERO
- IF(KFN .GE. 2) DELL=HALF
- ZM1=ZLMIN-DELL
- SCALE=ZERO
- IF(MODE1 .LT. 0) SCALE=AIMAG(X)
-C
- M1=1
- L1=M1+NL
- RLEL=ABS(AIMAG(ETA))+ABS(AIMAG(ZM1)) .LT. ACC8
- ABSX=ABS(X)
- AXIAL=RLEL .AND. ABS(AIMAG(X)) .LT. ACC8*ABSX
- IF(MODE .LE. 2 .AND. ABSX .LT. FPMIN) GO TO 310
- XI=ONE/X
- XLOG=LOG(X)
-
-C log with cut along the negative real axis, see also OMEGA
-
- ID=1
- DONEM=.FALSE.
- UNSTAB=.FALSE.
- LF=M1
- IFAIL=-1
- 10 ZLM=ZM1+(LF-M1)
- ZLL=ZM1+(L1-M1)
-C
-C *** ZLL is final lambda value, or 0.5 smaller for J,Y Bessels
-C
- Z11=ZLL
- IF(ID .LT. 0) Z11=ZLM
- P11=CI*SIGN(ONE,ACC8-AIMAG(ETA))
- LAST=L1
-C
-C *** Find phase shifts and Gamow factor at lambda = ZLL
-C
- PK=ZLL+ONE
- AA=PK-ETAI
- AB=PK+ETAI
- BB=TWO*PK
- ZLNEG=NPINT(BB,ACCB)
- CLGAA=CLOGAM(AA)
- CLGAB=CLGAA
- IF(ETANE0 .AND. .NOT.RLEL) CLGAB=CLOGAM(AB)
- IF(ETANE0 .AND. RLEL) CLGAB=CONJG(CLGAA)
- SIGMA=(CLGAA-CLGAB)*CIH
- IF(KFN .EQ. 0) SIG(L1)=SIGMA
- IF(.NOT.ZLNEG) CLL=ZLL*TLOG-HPI*ETA-CLOGAM(BB)+(CLGAA+CLGAB)*HALF
- THETA=X-ETA*(XLOG+TLOG)-ZLL*HPI+SIGMA
-C
- TA=(AIMAG(AA)**2+AIMAG(AB)**2+ABS(REAL(AA))+ABS(REAL(AB)))*HALF
- IF(ID .GT. 0 .AND. ABSX .LT. TA*ASYM .AND. .NOT.ZLNEG) GO TO 20
-C
-C *** use CF1 instead of CF1A, if predicted to converge faster,
-C (otherwise using CF1A as it treats negative lambda &
-C recurrence-unstable cases properly)
-C
- RK=SIGN(ONE,REAL(X)+ACC8)
- P=THETA
- IF(RK .LT. 0) P=-X+ETA*(LOG(-X)+TLOG)-ZLL*HPI-SIGMA
- XRCF(1,1)=PK
- F=RK*C309R6(X*RK,ETA*RK,ZLL,P,ACCT,JMAX,NFP,FEST,ERR,FPMAX,XRCF,
- 1 XRCF(1,3),XRCF(1,4))
- FESL=LOG(FEST)+ABS(AIMAG(X))
- NFP=-NFP
- IF(NFP .LT. 0 .OR. UNSTAB .AND. ERR .LT. ACCB) GO TO 40
- IF(.NOT.ZLNEG .OR. UNSTAB .AND. ERR .GT. ACCB) GO TO 20
- IF(LPR) WRITE(6,1060) '-L',ERR
- IF(ERR.GT.ACCB) GO TO 280
- GO TO 40
-C
-C *** evaluate CF1 = f = F'(ZLL,ETA,X)/F(ZLL,ETA,X)
-C
- 20 IF(AXIAL) THEN
- SX1=X
- SETA=ETA
- SZLL=ZLL
- F=C309R4(SX1,SETA,SZLL,ACC8,SF,RK,ETANE0,LIMIT,ERR,NFP,
- 1 FPMIN,FPMAX,LPR)
- FCL=SF
- TPK1=RK
- ELSE
- F=C309R5(X,ETA,ZLL,ACC8,FCL,TPK1,ETANE0,LIMIT,ERR,NFP,
- 1 FPMIN,FPMAX,LPR)
- END IF
- IF(ERR .GT. ONE) THEN
- IFAIL=-1
- GO TO 290
- END IF
-C
-C *** Make a simple check for CF1 being badly unstable:
-C
- IF(ID .GE. 0) THEN
- UNSTAB=REAL((ONE-ETA*XI)*CI*AIMAG(THETA)/F) .GT. ZERO
- 1 .AND. .NOT.AXIAL .AND. ABS(AIMAG(THETA)) .GT. -LOG(ACC8)*HALF
- 2 .AND. ABSC(ETA)+ABSC(ZLL) .LT. ABSC(X)
- IF(UNSTAB) THEN
- ID=-1
- LF=L1
- L1=M1
- RERR=ACCT
- GO TO 10
- END IF
- END IF
-C
-C *** compare accumulated phase FCL with asymptotic phase for G(k+1) :
-C to determine estimate of F(ZLL) (with correct sign) to start recur
-C
- W=X*X*(HALF/TPK1+ONE/TPK1**2)+ETA*(ETA-TWO*X)/TPK1
- FESL=(ZLL+ONE)*XLOG+CLL-W-LOG(FCL)
- 40 FESL=FESL-ABS(SCALE)
- RK=MAX(REAL(FESL),FPLMIN*HALF)
- FESL=CMPLX(MIN(RK,FPLMAX*HALF),AIMAG(FESL))
- FEST=EXP(FESL)
-C
- RERR=MAX(RERR,ERR,ACC8*ABS(REAL(THETA)))
-C
- FCL=FEST
- FPL=FCL*F
- IF(IFCP) FCP(L1)=FPL
- FC(L1)=FCL
-C
-C *** downward recurrence to lambda = ZLM. array GC,if present,stores RL
-C
- I=MAX(-ID,0)
- ZL=ZLL+I
- MONO=0
- OFF=ABS(FCL)
- TA=ABSC(SIGMA)
-
-C
-C CORRESPONDS TO DO 70 L = L1-ID,LF,-ID
-C
- L=L1-ID
- LC70=(L1-LF)/ID
- 70 IF(LC70 .LE. 0) GO TO 80
- IF(ETANE0) THEN
- IF(RLEL) THEN
- DSIG=ATAN2(REAL(ETA),REAL(ZL))
- RL=SQRT(REAL(ZL)**2+REAL(ETA)**2)
- ELSE
- AA=ZL-ETAI
- BB=ZL+ETAI
- IF(ABSC(AA) .LT. ACCH .OR. ABSC(BB) .LT. ACCH) GOTO 50
- DSIG=(LOG(AA)-LOG(BB))*CIH
- RL=AA*EXP(CI*DSIG)
- END IF
- IF(ABSC(SIGMA) .LT. TA*HALF) THEN
-
-C re-calculate SIGMA because of accumulating roundoffs:
-
- SL=(CLOGAM(ZL+I-ETAI)-CLOGAM(ZL+I+ETAI))*CIH
- RL=(ZL-ETAI)*EXP(CI*ID*(SIGMA-SL))
- SIGMA=SL
- TA=ZERO
- ELSE
- SIGMA=SIGMA-DSIG*ID
- END IF
- TA=MAX(TA,ABSC(SIGMA))
- SL=ETA+ZL*ZL*XI
- PL=ZERO
- IF(ABSC(ZL) .GT. ACCH) PL=(SL*SL-RL*RL)/ZL
- FCL1=(FCL*SL+ID*ZL*FPL)/RL
- SF=ABS(FCL1)
- IF(SF .GT. FPMAX) GO TO 350
- FPL=(FPL*SL+ID*PL*FCL)/RL
- IF(MODE .LE. 1) GCP(L+ID)=PL*ID
- ELSE
-
-C ETA = 0, including Bessels. NB RL==SL
-
- RL=ZL*XI
- FCL1=FCL*RL+FPL*ID
- SF=ABS(FCL1)
- IF(SF .GT. FPMAX) GO TO 350
- FPL=(FCL1*RL-FCL)*ID
- END IF
- MONO=MONO+1
- IF(SF .GE. OFF) MONO=0
- FCL=FCL1
- OFF=SF
- FC(L)=FCL
- IF(IFCP) FCP(L)=FPL
- IF(KFN .EQ. 0) SIG(L)=SIGMA
- IF(MODE .LE. 2) GC(L+ID)=RL
- ZL=ZL-ID
- IF(MONO .LT. NDROP .OR. AXIAL .OR.
- 1 REAL(ZLM)*ID .GT. -NDROP .AND. .NOT.ETANE0) THEN
- L=L-ID
- LC70=LC70-1
- GO TO 70
- END IF
- UNSTAB=.TRUE.
-C
-C *** take action if cannot or should not recur below this ZL:
-
- 50 ZLM=ZL
- LF=L
- IF(ID .LT. 0) GO TO 380
- IF(.NOT.UNSTAB) LF=L+1
- IF(L+MONO .LT. L1-2 .OR. ID .LT. 0 .OR. .NOT.UNSTAB) GO TO 80
-
-C otherwise, all L values (for stability) should be done
-C in the reverse direction:
-
- ID=-1
- LF=L1
- L1=M1
- RERR=ACCT
- GO TO 10
-
- 80 IF(FCL .EQ. ZERO) FCL=ACC8
- F=FPL/FCL
-C
-C *** Check, if second time around, that the 'f' values agree!
-C
- IF(ID .GT. 0) FIRST=F
- IF(DONEM) RERR=MAX(RERR,ABSC(F-FIRST)/ABSC(F))
- IF(DONEM) GO TO 90
-C
- NOCF2=.FALSE.
- THETAM=X-ETA*(XLOG+TLOG)-ZLM*HPI+SIGMA
-C
-C *** on left x-plane, determine OMEGA by requiring cut on -x axis
-C on right x-plane, choose OMEGA (using estimate based on THETAM)
-C so H(omega) is smaller and recurs upwards accurately.
-C (x-plane boundary is shifted to give CF2(LH) a chance to converge)
-C
- OMEGA=SIGN(ONE,AIMAG(X)+ACC8)
- IF(REAL(X) .GE. XNEAR) OMEGA=SIGN(ONE,AIMAG(THETAM)+ACC8)
- SFSH=EXP(OMEGA*SCALE-ABS(SCALE))
- OFF=EXP(MIN(TWO*MAX(ABS(AIMAG(X)),ABS(AIMAG(THETAM)),
- 1 ABS(AIMAG(ZLM))*3),FPLMAX))
- EPS=MAX(ACC8,ACCT*HALF/OFF)
-C
-C *** Try first estimated omega, then its opposite,
-C to find the H(omega) linearly independent of F
-C i.e. maximise CF1-CF2 = 1/(F H(omega)) , to minimise H(omega)
-C
- 90 DO 100 L = 1,2
- LH=1
- IF(OMEGA .LT. ZERO) LH=2
- PM=CI*OMEGA
- ETAP=ETA*PM
- IF(DONEM) GO TO 130
- PQ1=ZERO
- PACCQ=ONE
- KASE=0
-C
-C *** Check for small X, i.e. whether to avoid CF2 :
-C
- IF(MODE .GE. 3 .AND. ABSX .LT. ONE ) GO TO 190
- IF(MODE .LT. 3 .AND. (NOCF2 .OR. ABSX .LT. XNEAR .AND.
- 1 ABSC(ETA)*ABSX .LT. 5 .AND. ABSC(ZLM) .LT. 4)) THEN
- KASE=5
- GO TO 120
- END IF
-C
-C *** Evaluate CF2 : PQ1 = p + i.omega.q at lambda = ZLM
-C
- PQ1=C309R1(X,ETA,ZLM,PM,EPS,LIMIT,ERR,NPQ(LH),ACC8,ACCH,
- 1 LPR,ACCUR,DELL)
- ERR=ERR*MAX(ONE,ABSC(PQ1)/MAX(ABSC(F-PQ1),ACC8))
-C
-C *** check if impossible to get F-PQ accurately because of cancellation
-C original guess for OMEGA (based on THETAM) was wrong
-C Use KASE 5 or 6 if necessary if Re(X) < XNEAR
- IF(ERR .LT. ACCH) GO TO 110
- NOCF2=REAL(X) .LT. XNEAR .AND. ABS(AIMAG(X)) .LT. -LOG(ACC8)
- 100 OMEGA=-OMEGA
- IF(UNSTAB) GO TO 360
- IF(LPR .AND. REAL(X) .LT. -XNEAR) WRITE(6,1060) '-X',ERR
- 110 RERR=MAX(RERR,ERR)
-C
-C *** establish case of calculation required for irregular solution
-C
- 120 IF(KASE .GE. 5) GO TO 130
- IF(REAL(X) .GT. XNEAR) THEN
-
-C estimate errors if KASE 2 or 3 were to be used:
-
- PACCQ=EPS*OFF*ABSC(PQ1)/MAX(ABS(AIMAG(PQ1)),ACC8)
- END IF
- IF(PACCQ .LT. ACCUR) THEN
- KASE=2
- IF(AXIAL) KASE=3
- ELSE
- KASE=1
- IF(NPQ(1)*R20 .LT. JMAX) KASE=4
-C i.e. change to kase=4 if the 2F0 predicted to converge
- END IF
- 130 GO TO (190,140,150,170,190,190), ABS(KASE)
- 140 IF(.NOT.DONEM)
-C
-C *** Evaluate CF2 : PQ2 = p - i.omega.q at lambda = ZLM (Kase 2)
-C
- 1 PQ2=C309R1(X,ETA,ZLM,-PM,EPS,LIMIT,ERR,NPQ(3-LH),ACC8,ACCH,
- 2 LPR,ACCUR,DELL)
- P=(PQ2+PQ1)*HALF
- Q=(PQ2-PQ1)*HALF*PM
- GO TO 160
- 150 P=REAL(PQ1)
- Q=AIMAG(PQ1)
-C
-C *** With Kase = 3 on the real axes, P and Q are real & PQ2 = PQ1*
-C
- PQ2=CONJG(PQ1)
-C
-C *** solve for FCM = F at lambda = ZLM,then find norm factor W=FCM/FCL
-C
- 160 W=(PQ1-F)*(PQ2-F)
- SF=EXP(-ABS(SCALE))
- FCM=SQRT(Q/W)*SF
-
-C any SQRT given here is corrected by
-C using sign for FCM nearest to phase of FCL
-
- IF(REAL(FCM/FCL) .LT. ZERO) FCM=-FCM
- GAM=(F-P)/Q
- TA=ABSC(GAM+PM)
- PACCQ=EPS*MAX(TA,ONE/TA)
- HCL=FCM*(GAM+PM)*(SFSH/(SF*SF))
-
-C Consider a KASE = 1 Calculation
-
- IF(PACCQ .GT. ACCUR .AND. KASE .GT. 0) THEN
- F11V=C309R2(X,ETA,Z11,P11,ACCT,LIMIT,0,ERR,N11,FPMAX,ACC8,ACC16)
- IF(ERR .LT. PACCQ) GO TO 200
- END IF
- RERR=MAX(RERR,PACCQ)
- GO TO 230
-C
-C *** Arrive here if KASE = 4
-C to evaluate the exponentially decreasing H(LH) directly.
-C
- 170 IF(DONEM) GO TO 180
- AA=ETAP-ZLM
- BB=ETAP+ZLM+ONE
- F20V=C309R3(AA,BB,-HALF*PM*XI,ACCT,JMAX,ERR,FPMAX,N20,XRCF)
- IF(N20 .LE. 0) GO TO 190
- RERR=MAX(RERR,ERR)
- HCL=FPMIN
- IF(ABS(REAL(PM*THETAM)+OMEGA*SCALE) .GT. FPLMAX) GO TO 330
- 180 HCL=F20V*EXP(PM*THETAM+OMEGA*SCALE)
- FCM=SFSH/((F-PQ1)*HCL)
- GO TO 230
-C
-C *** Arrive here if KASE=1 (or if 2F0 tried mistakenly & failed)
-C
-C for small values of X, calculate F(X,SL) directly from 1F1
-C using REAL*16 arithmetic if possible.
-C where Z11 = ZLL if ID>0, or = ZLM if ID<0
-C
- 190 F11V=C309R2(X,ETA,Z11,P11,ACCT,LIMIT,0,ERR,N11,FPMAX,ACC8,ACC16)
- 200 IF(N11 .LT. 0) THEN
-
-C F11 failed from BB = negative integer
-
- IF(LPR) WRITE(6,1060) '-L',ONE
- IFAIL=-1
- GO TO 290
- END IF
-
-C Consider a KASE 2 or 3 calculation :
-
- IF(ERR .GT. PACCQ .AND. PACCQ .LT. ACCB) THEN
- KASE=-2
- IF(AXIAL) KASE=-3
- GO TO 130
- END IF
- RERR=MAX(RERR,ERR)
- IF(ERR .GT. FPMAX) GO TO 370
- IF(ID .LT. 0) CLL=Z11*TLOG-HPI*ETA-CLOGAM(BB)
- 1 +CLOGAM(Z11+ONE+P11*ETA)-P11*SIGMA
- EK=(Z11+ONE)*XLOG-P11*X+CLL-ABS(SCALE)
- IF(ID .GT. 0) EK=EK-FESL+LOG(FCL)
- IF(REAL(EK) .GT. FPLMAX) GO TO 350
- IF(REAL(EK) .LT. FPLMIN) GO TO 340
- FCM=F11V*EXP(EK)
- IF(KASE .GE. 5) THEN
- IF(ABSC(ZLM+ZLM-NINTC(ZLM+ZLM)) .LT. ACCH) KASE=6
-C
-C *** For abs(X) < XNEAR, then CF2 may not converge accurately, so
-C *** use an expansion for irregular soln from origin :
-C
- SL=ZLM
- ZLNEG=REAL(ZLM) .LT. -ONE+ACCB
- IF(KASE .EQ. 5 .OR. ZLNEG) SL=-ZLM-ONE
- PK=SL+ONE
- AA=PK-ETAP
- AB=PK+ETAP
- BB=TWO*PK
- CLGAA=CLOGAM(AA)
- CLGAB=CLGAA
- IF(ETANE0) CLGAB=CLOGAM(AB)
- CLGBB=CLOGAM(BB)
- IF(KASE .EQ. 6 .AND. .NOT.ZLNEG) THEN
- IF(NPINT(AA,ACCUR)) CLGAA=CLGAB-TWO*PM*SIGMA
- IF(NPINT(AB,ACCUR)) CLGAB=CLGAA+TWO*PM*SIGMA
- END IF
- CLL=SL*TLOG-HPI*ETA-CLGBB+(CLGAA+CLGAB)*HALF
- DSIG=(CLGAA-CLGAB)*PM*HALF
- IF(KASE .EQ. 6) P11=-PM
- EK=PK*XLOG-P11*X+CLL-ABS(SCALE)
- SF=EXP(-ABS(SCALE))
- CHI=ZERO
- IF(.NOT.(KASE .EQ. 5 .OR. ZLNEG)) GO TO 210
-C
-C *** Use G(l) = (cos(CHI) * F(l) - F(-l-1)) / sin(CHI)
-C
-C where CHI = sig(l) - sig(-l-1) - (2l+1)*pi/2
-C
- CHI=SIGMA-DSIG-(ZLM-SL)*HPI
- F11V=C309R2(X,ETA,SL,P11,ACCT,LIMIT,0,ERR,NPQ(1),
- 1 FPMAX,ACC8,ACC16)
- RERR=MAX(RERR,ERR)
- IF(KASE .EQ. 6) GO TO 210
- FESL=F11V*EXP(EK)
- FCL1=EXP(PM*CHI)*FCM
- HCL=FCL1-FESL
- RERR=MAX(RERR,ACCT*MAX(ABSC(FCL1),ABSC(FESL))/ABSC(HCL))
- HCL=HCL/SIN(CHI)*(SFSH/(SF*SF))
- GO TO 220
-C
-C *** Use the logarithmic expansion for the irregular solution (KASE 6)
-C for the case that BB is integral so sin(CHI) would be zero.
-C
- 210 RL=BB-ONE
- N=NINTC(RL)
- ZLOG=XLOG+TLOG-PM*HPI
- CHI=CHI+PM*THETAM+OMEGA*SCALE+AB*ZLOG
- AA=ONE-AA
- IF(NPINT(AA,ACCUR)) THEN
- HCL=ZERO
- ELSE
- IF(ID .GT. 0 .AND. .NOT.ZLNEG) F11V=FCM*EXP(-EK)
- HCL=EXP(CHI-CLGBB-CLOGAM(AA))*(-1)**(N+1)*(F11V*ZLOG+
- 1 C309R2(X,ETA,SL,-PM,ACCT,LIMIT,2,ERR,NPQ(2),FPMAX,ACC8,ACC16))
- RERR=MAX(RERR,ERR)
- END IF
- IF(N .GT. 0) THEN
- EK=CHI+CLOGAM(RL)-CLGAB-RL*ZLOG
- DF=C309R2(X,ETA,-SL-ONE,-PM,ZERO,N,0,ERR,L,FPMAX,ACC8,ACC16)
- HCL=HCL+EXP(EK)*DF
- END IF
- RERR=MAX(RERR,TWO*ABS(BB-NINTC(BB)))
- 220 PQ1=F-SFSH/(FCM*HCL)
- ELSE
- IF(MODE .LE. 2) HCL=SFSH/((F-PQ1)*FCM)
- KASE=1
- END IF
-C
-C *** Now have absolute normalisations for Coulomb Functions
-C FCM & HCL at lambda = ZLM
-C so determine linear transformations for Functions required :
-C
- 230 IH=ABS(MODE1)/10
- IF(KFN .EQ. 3) IH=(3-AIMAG(CIK))/2+HALF
- P11=ONE
- IF(IH .EQ. 1) P11=CI
- IF(IH .EQ. 2) P11=-CI
- DF=-PM
- IF(IH .GE. 1) DF=-PM+P11
- IF(ABSC(DF) .LT. ACCH) DF=ZERO
-C
-C *** Normalisations for spherical or cylindrical Bessel functions
-C
- IF(KFN .LE. 0) THEN
- ALFA=ZERO
- BETA=ONE
- ELSE IF(KFN .EQ. 1) THEN
- ALFA=XI
- BETA=XI
- ELSE
- ALFA=XI*HALF
- BETA=SQRT(XI/HPI)
- IF(REAL(BETA) .LT. ZERO) BETA=-BETA
- END IF
- AA=ONE
- IF(KFN .GT. 0) AA=-P11*BETA
-
-C Calculate rescaling factors for I & K output
-
- IF(KFN .GE. 3) THEN
- P=EXP((ZLM+DELL)*HPI*CIK)
- AA=BETA*HPI*P
- BETA=BETA/P
- Q=CIK*ID
- END IF
-
-C Calculate rescaling factors for GC output
-
- IF(IH .EQ. 0) THEN
- TA=ABS(SCALE)+AIMAG(PM)*SCALE
- RK=ZERO
- IF(TA .LT. FPLMAX) RK=EXP(-TA)
- ELSE
- TA=ABS(SCALE)+AIMAG(P11)*SCALE
- IF(ABSC(DF) .GT. ACCH .AND. TA .GT. FPLMAX) GO TO 320
- IF(ABSC(DF) .GT. ACCH) DF=DF*EXP(TA)
- SF=TWO*(LH-IH)*SCALE
- RK=ZERO
- IF(SF .GT. FPLMAX) GO TO 320
- IF(SF .GT. FPLMIN) RK=EXP(SF)
- END IF
- KAS((3-ID)/2)=KASE
- W=FCM/FCL
- IF(LOG(ABSC(W))+LOG(ABSC(FC(LF))) .LT. FPLMIN) GO TO 340
- IF(MODE .GE. 3) GO TO 240
- IF(LPR .AND. ABSC(F-PQ1) .LT. ACCH*ABSC(F))
- 1 WRITE(6,1020) LH,ZLM+DELL
- HPL=HCL*PQ1
- IF(ABSC(HPL) .LT. FPMIN .OR. ABSC(HCL) .LT. FPMIN) GO TO 330
-C
-C *** IDward recurrence from HCL,HPL(LF) (stored GC(L) is RL if reqd)
-C *** renormalise FC,FCP at each lambda
-C *** ZL = ZLM - MIN(ID,0) here
-C
- 240 DO 270 L = LF,L1,ID
- FCL=W*FC(L)
- IF(ABSC(FCL) .LT. FPMIN) GO TO 340
- IF(IFCP) FPL=W*FCP(L)
- FC(L)=BETA*FCL
- IF(IFCP) FCP(L)=BETA*(FPL-ALFA*FCL)*CIK
- FC(L)=C309R8(FC(L),ACCUR)
- IF(IFCP) FCP(L)=C309R8(FCP(L),ACCUR)
- IF(MODE .GE. 3) GO TO 260
- IF(L .EQ. LF) GO TO 250
- ZL=ZL+ID
- ZID=ZL*ID
- RL=GC(L)
- IF(ETANE0) THEN
- SL=ETA+ZL*ZL*XI
- IF(MODE .EQ. 1) THEN
- PL=GCP(L)
- ELSE
- PL=ZERO
- IF(ABSC(ZL) .GT. ACCH) PL=(SL*SL-RL*RL)/ZID
- END IF
- HCL1=(SL*HCL-ZID*HPL)/RL
- HPL=(SL*HPL-PL*HCL)/RL
- ELSE
- HCL1=RL*HCL-HPL*ID
- HPL=(HCL-RL*HCL1)*ID
- END IF
- HCL=HCL1
- IF(ABSC(HCL) .GT. FPMAX) GO TO 320
- 250 GC(L)=AA*(RK*HCL+DF*FCL)
- IF(MODE .EQ. 1) GCP(L)=(AA*(RK*HPL+DF*FPL)-ALFA*GC(L))*CIK
- GC(L)=C309R8(GC(L),ACCUR)
- IF(MODE .EQ. 1) GCP(L)=C309R8(GCP(L),ACCUR)
- IF(KFN .GE. 3) AA=AA*Q
- 260 IF(KFN .GE. 3) BETA=-BETA*Q
- 270 LAST=MIN(LAST,(L1-L)*ID)
- GO TO 280
-C
-C *** Come here after all soft errors to determine how many L values ok
-C
- 310 IF(LPR) WRITE(6,1000) ZZ
- GO TO 999
- 320 IF(LPR) WRITE(6,1010) ZL+DELL,'IR',HCL,'>',FPMAX
- GO TO 280
- 330 IF(LPR) WRITE(6,1010) ZL+DELL,'IR',HCL,'<',FPMIN
- GO TO 280
- 340 IF(LPR) WRITE(6,1010) ZL+DELL,' ',FCL,'<',FPMIN
- GO TO 280
- 350 IF(LPR) WRITE(6,1010) ZL+DELL,' ',FCL,'>',FPMAX
- GO TO 280
- 360 IF(LPR) WRITE(6,1030) ZL+DELL
- GO TO 280
- 370 IF(LPR) WRITE(6,1040) Z11,I
- IFAIL=-1
- GO TO 290
- 380 IF(LPR) WRITE(6,1050) ZLMIN,ZLM,ZLM+ONE,ZLMIN+NL
- IFAIL=-1
- GO TO 290
- 280 IF(ID .GT. 0 .OR. LAST .EQ. 0) IFAIL=LAST
- IF(ID .LT. 0 .AND. LAST .NE. 0) IFAIL=-3
-C
-C *** Come here after ALL errors for this L range (ZLM,ZLL)
-C
-C *** so on first block, 'F' started decreasing monotonically,
-C or hit bound states for low ZL.
-C thus redo M1 to LF-1 in reverse direction, i.e. do
-C CF1A at ZLMIN & CF2 at ZLM (midway between ZLMIN & ZLMAX)
-C
- 290 IF(ID .GT. 0 .AND. LF .NE. M1) THEN
- ID=-1
- IF(.NOT.UNSTAB) LF=LF-1
- DONEM=UNSTAB
- LF=MIN(LF,L1)
- L1=M1
- GO TO 10
- END IF
- IF(IFAIL .LT. 0) GO TO 999
- IF(LPR .AND. RERR .GT. ACCB) WRITE(6,1070) RERR
- IF(RERR .GT. 0.1D0) IFAIL=-4
- 999 DO 998 L = 1,NL+1
- FC(L-1)=FC(L)
- GC(L-1)=GC(L)
- FCP(L-1)=FCP(L)
- GCP(L-1)=GCP(L)
- 998 SIG(L-1)=SIG(L)
- RETURN
-C
- 1000 FORMAT(1X,'***** CERN C309 CCLBES ... ',
- 1 'CANNOT CALCULATE IRREGULAR SOLUTIONS FOR X =',
- 2 1P2D10.2,' ABS(X) TOO SMALL')
- 1010 FORMAT(1X,'***** CERN C309 CCLBES ... ',
- 1 'AT ZL =',2F8.3,' ',A2,'REGULAR SOLUTION (',1P2E10.1,') ',
- 2 A1,E10.1)
- 1020 FORMAT(1X,'***** CERN C309 CCLBES ... ',
- 1 'WARNING: LINEAR INDEPENDENCE BETWEEN ''F'' AND ''H(',I1,
- 2 ')'' IS LOST AT ZL = ',2F7.2/1X,'*****',22X,'(EG. COULOMB ',
- 3 'EIGENSTATE OR CF1 UNSTABLE)')
- 1030 FORMAT(1X,'***** CERN C309 CCLBES ... ',
- 2 '(ETA & L)/X TOO LARGE FOR CF1A, AND CF1 UNSTABLE AT L = ',2F8.2)
- 1040 FORMAT(1X,'***** CERN C309 CCLBES ... ',
- 1 'OVERFLOW IN 1F1 SERIES AT ZL = ',2F8.3,' AT TERM',I5)
- 1050 FORMAT(1X,'***** CERN C309 CCLBES ... ',
- 1 'BOTH BOUND-STATE POLES AND F-INSTABILITIES OCCUR OR MULTIPLE',
- 2 ' INSTABILITIES PRESENT'/
- 3 1X,'*****',22X,'TRY CALLING TWICE, 1ST FOR ZL FROM',2F8.3,
- 4 ' TO',2F8.3,' (INCL)'/1X,'*****',41X,'2ND FOR ZL FROM',2F8.3,
- 5 ' TO',2F8.3)
- 1060 FORMAT(1X,'***** CERN C309 CCLBES ... ',
- 1 'WARNING: AS ''',A2,''' REFLECTION RULES NOT USED ',
- 2 'ERRORS CAN BE UP TO',1PD12.2)
- 1070 FORMAT(1X,'***** CERN C309 CCLBES ... ',
- 1 'WARNING: OVERALL ROUNDOFF ERROR APPROXIMATELY',1PE11.1)
- END
-#endif
diff --git a/src/mathlib/gen/c/cdigam.F b/src/mathlib/gen/c/cdigam.F
deleted file mode 100644
index 26bfc95..0000000
--- a/src/mathlib/gen/c/cdigam.F
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: cdigam.F,v 1.1.1.1 1996/04/01 15:01:55 mclareni Exp $
-*
-* $Log: cdigam.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:55 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- FUNCTION CDIGAM(Z)
- COMPLEX CDIGAM,Z
-#include "gen/defc64.inc"
- + WDIGAM,W
-#include "gen/def64.inc"
- + D
-
-#include "gen/gcmpfun.inc"
- SROUND(D)=D+(D-SNGL(D))
- W=Z
- W=WDIGAM(W)
- CDIGAM=CMPLX(SROUND(GREAL(W)),SROUND(GIMAG(W)))
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/c/cdigam128.F b/src/mathlib/gen/c/cdigam128.F
deleted file mode 100644
index 24ad87b..0000000
--- a/src/mathlib/gen/c/cdigam128.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: cdigam128.F,v 1.1.1.1 1996/04/01 15:01:55 mclareni Exp $
-*
-* $Log: cdigam128.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:55 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION WDIGAM(Z)
-C
-#if (!defined(CERNLIB_F90))&&(!defined(CERNLIB_DOUBLE))
- COMPLEX*16 WDIGAM,Z
-#endif
-#if (defined(CERNLIB_F90))&&(!defined(CERNLIB_DOUBLE))
- COMPLEX(2) WDIGAM,Z
-#endif
-#if !defined(CERNLIB_DOUBLE)
-C
- CHARACTER NAME*(*)
- PARAMETER (NAME = 'WDIGAM')
- WDIGAM=0
- CALL MTLPRT(NAME,'C307.0','Not available on this machine')
- RETURN
- END
-#endif
-#endif
diff --git a/src/mathlib/gen/c/cdigam64.F b/src/mathlib/gen/c/cdigam64.F
deleted file mode 100644
index f20dc42..0000000
--- a/src/mathlib/gen/c/cdigam64.F
+++ /dev/null
@@ -1,86 +0,0 @@
-*
-* $Id: cdigam64.F,v 1.1.1.1 1996/04/01 15:01:56 mclareni Exp $
-*
-* $Log: cdigam64.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:56 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION CDIGAM(Z)
-#include "gen/defc64.inc"
- + CDIGAM
-#endif
-#if defined(CERNLIB_DOUBLE)
- FUNCTION WDIGAM(Z)
-#include "gen/imp64.inc"
-#include "gen/defc64.inc"
- + WDIGAM
-#endif
-#include "gen/defc64.inc"
- + Z,U,V,H,R,P
- CHARACTER NAME*(*)
- CHARACTER*80 ERRTXT
-#if !defined(CERNLIB_DOUBLE)
- PARAMETER (NAME = 'CDIGAM')
-#endif
-#if defined(CERNLIB_DOUBLE)
- PARAMETER (NAME = 'CDIGAM/WDIGAM')
-#endif
- DIMENSION C(6)
-
- PARAMETER (Z1 = 1, HF = Z1/2)
- PARAMETER (PI = 3.14159 26535 89793 24D0)
-
-#include "gen/gcmpfun.inc"
-CSEQ,GCMPLX.
-
- DATA C(1) / 8.33333 33333 33333 33D-2/
- DATA C(2) /-8.33333 33333 33333 33D-3/
- DATA C(3) / 3.96825 39682 53968 25D-3/
- DATA C(4) /-4.16666 66666 66666 67D-3/
- DATA C(5) / 7.57575 75757 57575 76D-3/
- DATA C(6) /-2.10927 96092 79609 28D-2/
-
- U=Z
- X=U
- A=ABS(X)
- IF(GIMAG(U) .EQ. 0 .AND. -A .EQ. INT(X)) THEN
- H=0
- WRITE(ERRTXT,101) X
- CALL MTLPRT(NAME,'C307.1',ERRTXT)
- ELSE
- IF(X .LT. 0) U=-U
- V=U
- H=0
- IF(A .LT. 15) THEN
- H=1/V
- DO 1 I = 1,14-INT(A)
- V=V+1
- 1 H=H+1/V
- V=V+1
- END IF
- R=1/V**2
- P=R*C(1)
- DO 2 I = 6,1,-1
- 2 P=R*(C(I)+P)
- H=LOG(V)-HF/V-P-H
- IF(X .LT. 0) THEN
- V=PI*U
- X=V
- A=SIN(X)
- X=COS(X)
- Y=TANH(GIMAG(V))
- H=H+1/U+PI*GCMPLX(X,-A*Y)/GCMPLX(A,X*Y)
- END IF
- ENDIF
-#if defined(CERNLIB_DOUBLE)
- WDIGAM=H
-#endif
-#if !defined(CERNLIB_DOUBLE)
- CDIGAM=H
-#endif
- RETURN
- 101 FORMAT(1X,'ARGUMENT EQUALS NON-POSITIVE INTEGER = ',1P,E15.1)
- END
diff --git a/src/mathlib/gen/c/celfun.F b/src/mathlib/gen/c/celfun.F
deleted file mode 100644
index 1a42dc0..0000000
--- a/src/mathlib/gen/c/celfun.F
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: celfun.F,v 1.1.1.1 1996/04/01 15:02:01 mclareni Exp $
-*
-* $Log: celfun.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:01 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- SUBROUTINE CELFUN(Z,AK2,SN,CN,DN)
- COMPLEX Z,SN,CN,DN
-#include "gen/defc64.inc"
- + WSN,WCN,WDN
-#include "gen/def64.inc"
- + D
-#if defined(CERNLIB_QF2C)
-#include "defdr.inc"
-#endif
-#include "gen/gcmpfun.inc"
- SROUND(D)=D+(D-SNGL(D))
- CALL WELFUN
- 1 (DCMPLX(DBLE(REAL(Z)),DBLE(AIMAG(Z))),DBLE(AK2),WSN,WCN,WDN)
- SN=CMPLX(SROUND(DREAL(WSN)),SROUND(DIMAG(WSN)))
- CN=CMPLX(SROUND(DREAL(WCN)),SROUND(DIMAG(WCN)))
- DN=CMPLX(SROUND(DREAL(WDN)),SROUND(DIMAG(WDN)))
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/c/celfun64.F b/src/mathlib/gen/c/celfun64.F
deleted file mode 100644
index 1f167e9..0000000
--- a/src/mathlib/gen/c/celfun64.F
+++ /dev/null
@@ -1,179 +0,0 @@
-*
-* $Id: celfun64.F,v 1.3 2006/09/15 09:34:53 mclareni Exp $
-*
-* $Log: celfun64.F,v $
-* Revision 1.3 2006/09/15 09:34:53 mclareni
-* Submitted mods for gcc4/gfortran and MacOSX, corrected to work also on slc4 with gcc3.4 and 4.1
-*
-* Revision 1.2 1997/12/15 16:18:35 mclareni
-* Changes for the Portland Group f77 compiler inside cpp define CERNLIB_QFPGF77
-*
-* Revision 1.1.1.1 1996/04/01 15:02:01 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- SUBROUTINE WELFUN(W,AK2,SN,CN,DN)
-C
-#include "gen/imp64.inc"
-C
- CHARACTER*(*) NAME
- PARAMETER(NAME='CELFUN/WELFUN')
-#endif
-#if !defined(CERNLIB_DOUBLE)
- SUBROUTINE CELFUN(W,AK2,SN,CN,DN)
-C
- CHARACTER*(*) NAME
- PARAMETER(NAME='CELFUN')
-#endif
-C
-C Jacobian Elliptic Functions SN(W,M),CN(W,M),DN(W,M) for
-C complex argument w = u+i*v.
-C Iterates for parameter m = k**2 or mc= 1-m if mc < m to obtain
-C fastest convergence and uses finally Jacobi's
-C imaginary transformation to go back to sn, cn, dn of m.
-C
-#include "gen/defc64.inc"
- + W,SN,CN,DN,I
- DIMENSION C(4)
-
-C MACHINE-DEPENDENT: EPS1=2**-(MB/2), EPS2=2**-(MB+3)
-C Where M = Number of bits in mantissa
-
- PARAMETER (MB = 64)
- PARAMETER (Z0 = 0, Z1 = 1, Z2 = 2, HF = Z1/2, QU = Z1/4)
-#if !defined(CERNLIB_CRAY)
- PARAMETER (I = (0D0,1D0))
-#endif
-#if defined(CERNLIB_CRAY)
- PARAMETER (I = (0E0,1E0))
-#endif
- PARAMETER (PI = 3.14159 26535 89793 24D0, PIH = PI/2)
- PARAMETER (EPS1 = Z2**(-MB/2), EPS2 = Z2**(-(MB+3)))
-
- CHARACTER*80 ERRTXT
-
-#if defined(CERNLIB_QFPGF77)
- DATA AM0 /-1D20/
-
- SAVE AM0,C,A,L,BIGK
-#endif
-
-#if defined(CERNLIB_QF2C)
-#include "gen/gcmpfun.inc"
-#endif
-
-#if ! defined(CERNLIB_QFPGF77)
- DATA AM0 /-1D20/
-
-#if !defined(CERNLIB_GFORTRAN)
- SAVE AM0,C,A,L,BIGK
-#else
- SAVE
-#endif
-#endif
-
-#if !defined(CERNLIB_QF2C)
-#include "gen/gcmpfun.inc"
-#endif
-
- AM=ABS(AK2)
- IF(AM .GT. 1) THEN
- WRITE(ERRTXT,101) AM
- CALL MTLPRT(NAME,'C320.1',ERRTXT)
- RETURN
- ENDIF
- IF(AM .LE. HF) THEN
- U=W
- V=GIMAG(W)
- IF(AM .EQ. AM0) GO TO 1
- XK2=AM
- B=SQRT(1-AM)
- ELSE
- U=GIMAG(W)
- V=-W
- IF(AM .EQ. AM0) GO TO 1
- XK2=1-AM
- B=SQRT(AM)
- ENDIF
-
- AM0=AM
- A=1
- L=4
- C(L)=QU*XK2
-
-C Gaussian arithmetic-geometric mean. Skipped if previous M.
-
- 2 IF(C(L) .GE. EPS1) THEN
- L=L-1
- C(L)=(QU*(A-B))**2
- A1=HF*(A+B)
- B=SQRT(A*B)
- A=A1
- GO TO 2
- ENDIF
- A=HF*(A+B)
- BIGK=PIH/A
-
-C Descending Landen-Gauss Trafo for real U
-
- 1 X=SIN(A*U)
- IF(V .NE. 0 .OR. X .NE. 0) THEN
- IF(X .NE. 0) THEN
- X=A/X
- DO 3 J = L,4
- X1=C(J)/X
- 3 X=X1+X
- SU=1/X
- DU=1-2*X1*SU
- CU=SIGN(SQRT(ABS(1-SU**2)),BIGK-ABS(U))
- ENDIF
- IF(V .NE. 0) THEN
- Y=A/SINH(A*V)
- DO 4 J = L,4
- Y1=C(J)/Y
- Y=Y-Y1
- IF(Y .EQ. 0) Y=EPS2
- 4 CONTINUE
- SV=1/Y
- Y1=2*Y1*SV
- DV=1+Y1
- CV=SIGN(SQRT((SV+Y)*SV),Y1)
-
-C Evaluation of complex sn, cn, dn from real and imaginary ones and
-C Jacobi's imaginary argument trafo if necessary
-
- IF(U .NE. 0) THEN
- SS=-SU*SV
- D=1/(XK2*SS**2+1)
- DV=DV*D
- CU=CU*D
- CC=CU*CV
- DD=DU*DV
- DN=GCMPLX(DD,XK2*SS*CC)
- CN=GCMPLX(CC,SS*DD)
- SN=GCMPLX(SU*CV*DV,SV*CU*DU)
- ELSE
- SN=GCMPLX(Z0,SV)
- CN=CV
- DN=DV
- ENDIF
- ELSE
- SN=SU
- CN=CU
- DN=DU
- ENDIF
- IF(AM .GT. HF) THEN
- CN=1/CN
- DN=DN*CN
- SN=I*SN*CN
- ENDIF
- ELSE
- SN=0
- CN=1
- DN=1
- ENDIF
- RETURN
- 101 FORMAT('MODULUS AK2 = ',1P,E15.6,' OUT OF RANGE')
- END
diff --git a/src/mathlib/gen/c/celint.F b/src/mathlib/gen/c/celint.F
deleted file mode 100644
index 34d3246..0000000
--- a/src/mathlib/gen/c/celint.F
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: celint.F,v 1.1.1.1 1996/04/01 15:02:11 mclareni Exp $
-*
-* $Log: celint.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:11 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- FUNCTION CELINT(Z,AKC,A,B)
-C
- COMPLEX CELINT,Z
- COMPLEX*16 WELINT,W
- DOUBLE PRECISION D
-
- SROUND(D)=D+(D-SNGL(D))
- W=WELINT(DCMPLX(DBLE(REAL(Z)),DBLE(AIMAG(Z))),DBLE(AKC),DBLE(A),
- 1 DBLE(B))
- CELINT=CMPLX(SROUND(DREAL(W)),SROUND(DIMAG(W)))
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/c/celint64.F b/src/mathlib/gen/c/celint64.F
deleted file mode 100644
index 811d74f..0000000
--- a/src/mathlib/gen/c/celint64.F
+++ /dev/null
@@ -1,151 +0,0 @@
-*
-* $Id: celint64.F,v 1.1.1.1 1996/04/01 15:02:11 mclareni Exp $
-*
-* $Log: celint64.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:11 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- FUNCTION WELINT(Z,AKC,A,B)
-C
-#include "gen/imp64.inc"
-C
- CHARACTER*(*) NAME
- PARAMETER(NAME='CELINT/WELINT')
- COMPLEX*16 WELINT
-#endif
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION CELINT(Z,AKC,A,B)
-C
- CHARACTER*(*) NAME
- PARAMETER(NAME='CELINT')
- COMPLEX CELINT
-#endif
-C
-C Translation of Algol procedure elco2(x,y,kc,a,b,u,v) in
-C R. BULIRSCH Numerical Calculation of Elliptic Integrals and
-C Elliptic Functions, Numer. Math. 7 (1965) 78-90
-C
-#include "gen/defc64.inc"
- + Z,I,W,C0
- DIMENSION D1(0:12),D2(0:12)
-
- PARAMETER (ID = 16)
-#if !defined(CERNLIB_CRAY)
- PARAMETER (I = (0D0,1D0))
-#endif
-#if defined(CERNLIB_CRAY)
- PARAMETER (I = (0E0,1E0))
-#endif
- PARAMETER (Z1 = 1, Z10 = 10, HF = Z1/2)
- PARAMETER (CC = Z10**(-ID), C0 = I-I)
-
- CHARACTER*80 ERRTXT
-
- X=Z
- Y=-I*Z
- IF(Z .EQ. C0 .OR. AKC .EQ. 0) THEN
- W=SQRT(1+Z**2)
- W=B*LOG(Z+W)+(A-B)*Z/W
- ELSEIF(X .LT. 0) THEN
- W=0
- WRITE(ERRTXT,101) X
- CALL MTLPRT(NAME,'C348.1',ERRTXT)
- ELSE
- AA=A
- BB=B
- SY=SIGN(Z1,Y)
- Y=ABS(Y)
- C=X**2-Y**2
- E2=2*X*Y
- D=AKC**2
- XK=1-D
- E1=1+C
- F2=1/(E1**2+E2**2)
- F1=((1+D*C)*E1+D*E2**2)*F2
- F2=-2*XK*X*Y*F2
- DN1=SQRT(HF*(SQRT(F1**2+F2**2)+ABS(F1)))
- DN2=HF*F2/DN1
- IF(F1 .LT. 0) THEN
- F1=DN1
- DN1=-DN2
- DN2=-F1
- ENDIF
- IF(XK .LT. 0) THEN
- DN1=ABS(DN1)
- DN2=ABS(DN2)
- ENDIF
- C=1+DN1
- F1=E1*C-E2*DN2
- F2=E1*DN2+E2*C
- D2(0)=1/(F1**2+F2**2)
- D1(0)=(X*F1+Y*F2)*D2(0)
- D2(0)=(Y*F1-X*F2)*D2(0)
- H=AA-BB
- N=1
- XM=1
- F=1
- D=1
- YKC=ABS(AKC)
- E=AA
- AA=BB+AA
- L=4
- 1 XM1=HF*(YKC+XM)
- XM2=XM1**2
- XK=F*XK/(4*XM2)
- BB=E*YKC+BB
- E=AA
- F2=1/(C**2+DN2**2)
- F1=((YKC+XM*DN1)*C+XM*DN2**2)*F2
- E1=F1/XM1
- E2=XK*DN2*F2
- DN1=SQRT(HF*(SQRT(E1**2+(2*E2)**2)+ABS(E1)))
- DN2=E2/DN1
- F1=DN1*X-DN2*Y
- F2=DN1*Y+DN2*X
- X=ABS(F1)
- Y=ABS(F2)
- AA=BB/XM1+AA
- L=2*L
- C=1+DN1
- D=HF*XK*D
- E1=1+(X**2-Y**2)*XM2
- E2=2*X*Y*XM2
- F1=C*E1-DN2*E2
- F2=C*E2+DN2*E1
- E1=D/(F1**2+F2**2)
- D1(N)=(X*F1+Y*F2)*E1
- D2(N)=(Y*F1-X*F2)*E1
- XK=XK**2
- IF(XK .GT. CC) THEN
- YKC=SQRT(XM*YKC)
- F=XM2
- XM=XM1
- N=N+1
- GO TO 1
- ENDIF
- F2=0
- F1=0
- DO 2 J = N,0,-1
- F1=D1(J)+F1
- 2 F2=D2(J)+F2
- X=XM1*X
- Y=XM1*Y
- C=X**2+Y**2
- E2=1/(1+2*Y+C)
- E1=(1-C)*E2
- E2=2*X*E2
- D=AA/(XM1*L)
- W=D*ATAN2(E2,E1)+H*F1+I*SY*(H*F2-LOG(E1**2+E2**2)*HF*D)
- ENDIF
-#if defined(CERNLIB_DOUBLE)
- WELINT=W
-#endif
-#if !defined(CERNLIB_DOUBLE)
- CELINT=W
-#endif
- RETURN
- 101 FORMAT('RE(Z) = ',1P,D15.8,' < 0')
- END
diff --git a/src/mathlib/gen/c/cexpin.F b/src/mathlib/gen/c/cexpin.F
deleted file mode 100644
index dcb58ca..0000000
--- a/src/mathlib/gen/c/cexpin.F
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: cexpin.F,v 1.1.1.1 1996/04/01 15:02:06 mclareni Exp $
-*
-* $Log: cexpin.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:06 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- FUNCTION CEXPIN(Z)
- COMPLEX CEXPIN,Z
-#include "gen/defc64.inc"
- + WEXPIN,W
-#include "gen/def64.inc"
- + D
-#if defined(CERNLIB_QF2C)
-#include "defdr.inc"
-#endif
-
- SROUND(D)=D+(D-SNGL(D))
- W=Z
- W=WEXPIN(W)
- CEXPIN=CMPLX(SROUND(DREAL(W)),SROUND(DIMAG(W)))
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/c/cexpin128.F b/src/mathlib/gen/c/cexpin128.F
deleted file mode 100644
index a3d87dd..0000000
--- a/src/mathlib/gen/c/cexpin128.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: cexpin128.F,v 1.1.1.1 1996/04/01 15:02:06 mclareni Exp $
-*
-* $Log: cexpin128.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:06 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION WEXPIN(Z)
-#include "gen/imp128.inc"
-#if (!defined(CERNLIB_F90))&&(!defined(CERNLIB_DOUBLE))
- COMPLEX*16 WEXPIN
-#endif
-#if (defined(CERNLIB_F90))&&(!defined(CERNLIB_DOUBLE))
- COMPLEX(2) WEXPIN
-#endif
-#if !defined(CERNLIB_DOUBLE)
-C
- CHARACTER*(*) NAME
- PARAMETER( NAME='WEXPIN')
- WEXPIN=0
- CALL MTLPRT(NAME,'C338.0','Not available on this machine')
- RETURN
- END
-#endif
-#endif
diff --git a/src/mathlib/gen/c/cexpin64.F b/src/mathlib/gen/c/cexpin64.F
deleted file mode 100644
index c8a5aa0..0000000
--- a/src/mathlib/gen/c/cexpin64.F
+++ /dev/null
@@ -1,171 +0,0 @@
-*
-* $Id: cexpin64.F,v 1.1.1.1 1996/04/01 15:02:06 mclareni Exp $
-*
-* $Log: cexpin64.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:06 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION CEXPIN(Z)
-#endif
-#if defined(CERNLIB_DOUBLE)
- FUNCTION WEXPIN(Z)
-#endif
-#include "gen/impc64.inc"
-#include "gen/def64.inc"
- + AC,BC,CC,DC,CE,W,X,EPS,CONST,Z1,HF,HC,ZR,ZI,R1,R2,R3,R4
- CHARACTER NAME*(*)
-#if !defined(CERNLIB_DOUBLE)
- PARAMETER (NAME = 'CEXPIN')
-#endif
-#if defined(CERNLIB_DOUBLE)
- PARAMETER (NAME = 'CEXPIN/WEXPIN')
-#endif
- PARAMETER (EPS = 1D-13)
- PARAMETER (CE = 0.57721 56649 01532 86D0)
- PARAMETER (Z1 = 1, HF = Z1/2, HC = 0.005D0)
- PARAMETER (R1 = Z1/7, R2 = Z1/5, R3 = Z1/15, R4 = Z1/12)
-
-
- DIMENSION AC(10),BC(10),CC(16),DC(16),W(12),X(12)
-
-#if defined(CERNLIB_QF2C)
-#include "gen/gcmpfun.inc"
-#endif
-
- DATA AC( 1) /0.20502 08456 77917 066D 0/
- DATA AC( 2) /0.39390 75193 16296 552D -1/
- DATA AC( 3) /0.34858 23655 29237 912D -2/
- DATA AC( 4) /0.29317 75506 14266 489D -3/
- DATA AC( 5) /0.13754 73570 29922 394D -4/
- DATA AC( 6) /0.60964 46174 77455 800D -6/
- DATA AC( 7) /0.14447 18655 00891 748D -7/
- DATA AC( 8) /0.30430 04327 31332 247D -9/
- DATA AC( 9) /0.22059 38908 74765 263D-11/
- DATA AC(10) /0.49848 28058 16872 883D-14/
-
- DATA BC( 1) /0.45502 08456 77917 066D 0/
- DATA BC( 2) /0.97590 40779 55533 663D -1/
- DATA BC( 3) /0.13021 15639 98519 948D -1/
- DATA BC( 4) /0.11999 11137 74704 761D -2/
- DATA BC( 5) /0.80015 09559 21661 460D -4/
- DATA BC( 6) /0.39222 83073 88575 923D -5/
- DATA BC( 7) /0.14003 62118 96032 452D -6/
- DATA BC( 8) /0.34984 41348 05290 456D -8/
- DATA BC( 9) /0.55465 89453 73869 458D-10/
- DATA BC(10) /0.42591 33901 24021 430D-12/
-
- DATA CC( 1) / 271D0/
- DATA CC( 2) / 32370D0/
- DATA CC( 3) / 22 52698D0/
- DATA CC( 4) / 1017 37272D0/
- DATA CC( 5) / 31439 23848D0/
- DATA CC( 6) / 6 83085 03120D0/
- DATA CC( 7) / 105 58823 22000D0/
- DATA CC( 8) / 1161 90773 74080D0/
- DATA CC( 9) / 9018 57120 59520D0/
- DATA CC(10) / 48411 83190 41280D0/
- DATA CC(11) /1 73907 98760 38400D0/
- DATA CC(12) /3 96823 48312 32000D0/
- DATA CC(13) /5 28572 15615 23200D0/
- DATA CC(14) /3 54121 43251 96800D0/
- DATA CC(15) / 86771 81624 83200D0/
- DATA CC(16) / 2092 27898 88000D0/
-
- DATA DC( 1) / 272D0/
- DATA DC( 2) / 32640D0/
- DATA DC( 3) / 22 84800D0/
- DATA DC( 4) / 1039 58400D0/
- DATA DC( 5) / 32435 02080D0/
- DATA DC( 6) / 7 13570 45760D0/
- DATA DC( 7) / 112 13250 04800D0/
- DATA DC( 8) / 1261 49063 04000D0/
- DATA DC( 9) / 10091 92504 32000D0/
- DATA DC(10) / 56514 78024 19200D0/
- DATA DC(11) /2 15783 70637 82400D0/
- DATA DC(12) /5 39459 26594 56000D0/
- DATA DC(13) /8 29937 33222 40000D0/
- DATA DC(14) /7 11374 85619 20000D0/
- DATA DC(15) /2 84549 94247 68000D0/
- DATA DC(16) / 35568 74280 96000D0/
-
- DATA X( 1) /9.6028985649753623D-1/, W( 1) /1.0122853629037626D-1/
- DATA X( 2) /7.9666647741362674D-1/, W( 2) /2.2238103445337447D-1/
- DATA X( 3) /5.2553240991632899D-1/, W( 3) /3.1370664587788729D-1/
- DATA X( 4) /1.8343464249564980D-1/, W( 4) /3.6268378337836198D-1/
- DATA X( 5) /9.8940093499164993D-1/, W( 5) /2.7152459411754095D-2/
- DATA X( 6) /9.4457502307323258D-1/, W( 6) /6.2253523938647893D-2/
- DATA X( 7) /8.6563120238783174D-1/, W( 7) /9.5158511682492785D-2/
- DATA X( 8) /7.5540440835500303D-1/, W( 8) /1.2462897125553387D-1/
- DATA X( 9) /6.1787624440264375D-1/, W( 9) /1.4959598881657673D-1/
- DATA X(10) /4.5801677765722739D-1/, W(10) /1.6915651939500254D-1/
- DATA X(11) /2.8160355077925891D-1/, W(11) /1.8260341504492359D-1/
- DATA X(12) /9.5012509837637440D-2/, W(12) /1.8945061045506850D-1/
-
-#if !defined(CERNLIB_QF2C)
-#include "gen/gcmpfun.inc"
-#endif
-
- F(T)=(1-EXP(-T))/T
-
- ZI=ABS(GIMAG(Z))
- ZR=Z
- IF(ZR .GE. -5 .AND. (R1*(ZR-1))**2+(R2*ZI)**2 .LE. 1) THEN
- G=AC(10)
- H=BC(10)
- DO 1 K = 9,1,-1
- G=G*Z+AC(K)
- 1 H=H*Z+BC(K)
- H=((1+G*Z)/(1+H*Z))*Z
- ELSEIF(ZI .GE. 12 .OR.
- 1 ZR .GT. -12 .AND. (R3*(ZR+12))**2+(R4*ZI)**2 .GE. 1) THEN
- G=Z+CC(1)
- H=Z+DC(1)
- DO 2 K = 2,16
- G=G*Z+CC(K)
- 2 H=H*Z+DC(K)
- H=(G/H)*EXP(-Z)/Z+LOG(Z)+CE
- ELSE
- H=0
- CONST=HC/ABS(Z)
- BB=0
- 11 AA=BB
- BB=Z
- 12 C1=HF*(BB+AA)
- C2=HF*(BB-AA)
- S8=0
- DO 13 K = 1,4
- U=C2*X(K)
- 13 S8=S8+W(K)*(F(C1+U)+F(C1-U))
- S16=0
- DO 14 K = 5,12
- U=C2*X(K)
- 14 S16=S16+W(K)*(F(C1+U)+F(C1-U))
- S16=C2*S16
- IF(ABS(S16-C2*S8) .LE. EPS*(1+ABS(S16))) THEN
- H=H+S16
- IF(BB .NE. Z) GO TO 11
- ELSE
- BB=C1
- IF(1+CONST*ABS(C2) .NE. 1) GO TO 12
- H=0
- CALL MTLPRT(NAME,'C338.1','TOO HIGH ACCURACY REQUIRED')
-#if !defined(CERNLIB_DOUBLE)
- CEXPIN=0.
-#endif
-#if defined(CERNLIB_DOUBLE)
- WEXPIN=0.
-#endif
- RETURN
- END IF
- ENDIF
-#if !defined(CERNLIB_DOUBLE)
- CEXPIN=H
-#endif
-#if defined(CERNLIB_DOUBLE)
- WEXPIN=H
-#endif
- RETURN
- END
diff --git a/src/mathlib/gen/c/cgamma.F b/src/mathlib/gen/c/cgamma.F
deleted file mode 100644
index 0bedeae..0000000
--- a/src/mathlib/gen/c/cgamma.F
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: cgamma.F,v 1.1.1.1 1996/04/01 15:01:55 mclareni Exp $
-*
-* $Log: cgamma.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:55 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- FUNCTION CGAMMA(Z)
- COMPLEX CGAMMA,Z
-#include "gen/defc64.inc"
- + WGAMMA,W
-#include "gen/def64.inc"
- + D
-#include "gen/gcmpfun.inc"
- SROUND(D)=D+(D-SNGL(D))
- W=Z
- W=WGAMMA(W)
- CGAMMA=CMPLX(SROUND(GREAL(W)),SROUND(GIMAG(W)))
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/c/cgamma128.F b/src/mathlib/gen/c/cgamma128.F
deleted file mode 100644
index 309a26f..0000000
--- a/src/mathlib/gen/c/cgamma128.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: cgamma128.F,v 1.1.1.1 1996/04/01 15:01:55 mclareni Exp $
-*
-* $Log: cgamma128.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:55 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION WGAMMA(Z)
-C
-#if (!defined(CERNLIB_F90))&&(!defined(CERNLIB_DOUBLE))
- COMPLEX*16 WGAMMA,Z
-#endif
-#if (defined(CERNLIB_F90))&&(!defined(CERNLIB_DOUBLE))
- COMPLEX(2) WGAMMA,Z
-#endif
-#if !defined(CERNLIB_DOUBLE)
-C
- CHARACTER NAME*(*)
- PARAMETER (NAME = 'WGAMMA')
- WGAMMA=0
- CALL MTLPRT(NAME,'C305.0','Not available on this machine')
- RETURN
- END
-#endif
-#endif
diff --git a/src/mathlib/gen/c/cgamma64.F b/src/mathlib/gen/c/cgamma64.F
deleted file mode 100644
index 93c0a8f..0000000
--- a/src/mathlib/gen/c/cgamma64.F
+++ /dev/null
@@ -1,98 +0,0 @@
-*
-* $Id: cgamma64.F,v 1.1.1.1 1996/04/01 15:01:55 mclareni Exp $
-*
-* $Log: cgamma64.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:55 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION CGAMMA(Z)
-#include "gen/defc64.inc"
- + CGAMMA
-#endif
-#if defined(CERNLIB_DOUBLE)
- FUNCTION WGAMMA(Z)
-#include "gen/imp64.inc"
-#include "gen/defc64.inc"
- + WGAMMA
-#endif
-#include "gen/defc64.inc"
- + Z,U,V,F,H,S
- CHARACTER NAME*(*)
- CHARACTER*80 ERRTXT
-#if !defined(CERNLIB_DOUBLE)
- PARAMETER (NAME = 'CGAMMA')
-#endif
-#if defined(CERNLIB_DOUBLE)
- PARAMETER (NAME = 'CGAMMA/WGAMMA')
-#endif
- DIMENSION C(0:15)
-
- PARAMETER (Z1 = 1, HF = Z1/2)
-
-#if defined(CERNLIB_QF2C)
-#include "gen/gcmpfun.inc"
-#endif
-
- DATA PI /3.14159 26535 89793 24D0/
- DATA C1 /2.50662 82746 31000 50D0/
-
- DATA C( 0) / 41.62443 69164 39068D0/
- DATA C( 1) /-51.22424 10223 74774D0/
- DATA C( 2) / 11.33875 58134 88977D0/
- DATA C( 3) / -0.74773 26877 72388D0/
- DATA C( 4) / 0.00878 28774 93061D0/
- DATA C( 5) / -0.00000 18990 30264D0/
- DATA C( 6) / 0.00000 00019 46335D0/
- DATA C( 7) / -0.00000 00001 99345D0/
- DATA C( 8) / 0.00000 00000 08433D0/
- DATA C( 9) / 0.00000 00000 01486D0/
- DATA C(10) / -0.00000 00000 00806D0/
- DATA C(11) / 0.00000 00000 00293D0/
- DATA C(12) / -0.00000 00000 00102D0/
- DATA C(13) / 0.00000 00000 00037D0/
- DATA C(14) / -0.00000 00000 00014D0/
- DATA C(15) / 0.00000 00000 00006D0/
-
-#if !defined(CERNLIB_QF2C)
-#include "gen/gcmpfun.inc"
-#endif
-
- U=Z
- X=U
- IF(GIMAG(U) .EQ. 0 .AND. -ABS(X) .EQ. INT(X)) THEN
- F=0
- H=0
- WRITE(ERRTXT,101) X
- CALL MTLPRT(NAME,'C305.1',ERRTXT)
- ELSE
- IF(X .GE. 1) THEN
- F=1
- V=U
- ELSEIF(X .GE. 0) THEN
- F=1/U
- V=1+U
- ELSE
- F=1
- V=1-U
- END IF
- H=1
- S=C(0)
- DO 1 K = 1,15
- H=((V-K)/(V+(K-1)))*H
- 1 S=S+C(K)*H
- H=V+(4+HF)
- H=C1*EXP((V-HF)*LOG(H)-H)*S
- IF(X .LT. 0) H=PI/(SIN(PI*U)*H)
- ENDIF
-#if !defined(CERNLIB_DOUBLE)
- CGAMMA=F*H
-#endif
-#if defined(CERNLIB_DOUBLE)
- WGAMMA=F*H
-#endif
- RETURN
- 101 FORMAT('ARGUMENT EQUALS NON-POSITIVE INTEGER = ',1P,E15.1)
- END
diff --git a/src/mathlib/gen/c/cgplg.F b/src/mathlib/gen/c/cgplg.F
deleted file mode 100644
index 1db3662..0000000
--- a/src/mathlib/gen/c/cgplg.F
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: cgplg.F,v 1.1.1.1 1996/04/01 15:02:00 mclareni Exp $
-*
-* $Log: cgplg.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:00 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- FUNCTION CGPLG(N,M,X)
-C
- COMPLEX CGPLG
-#include "gen/defc64.inc"
- + WGPLG,W
-#include "gen/def64.inc"
- + D
-#if defined(CERNLIB_QF2C)
-#include "defdr.inc"
-#endif
-#include "gen/gcmpfun.inc"
- SROUND(D)=D+(D-SNGL(D))
- W=WGPLG(N,M,DBLE(X))
- CGPLG =CMPLX(SROUND(DREAL(W)),SROUND(DIMAG(W)))
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/c/cgplg128.F b/src/mathlib/gen/c/cgplg128.F
deleted file mode 100644
index d683643..0000000
--- a/src/mathlib/gen/c/cgplg128.F
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: cgplg128.F,v 1.1.1.1 1996/04/01 15:02:01 mclareni Exp $
-*
-* $Log: cgplg128.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:01 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION WGPLG(N,M,X)
-C
-#include "gen/imp128.inc"
-#if (!defined(CERNLIB_F90))&&(!defined(CERNLIB_DOUBLE))
- COMPLEX*16 WGPLG
-#endif
-#if (defined(CERNLIB_F90))&&(!defined(CERNLIB_DOUBLE))
- COMPLEX(2) WGPLG
-#endif
-#if !defined(CERNLIB_DOUBLE)
-#include "gen/def128.inc"
- + X
-C
- CHARACTER*(*) NAME
- PARAMETER( NAME='WGPLG')
- WGPLG=0
- CALL MTLPRT(NAME,'C321.0','Not available on this machine')
- RETURN
- END
-#endif
-#endif
diff --git a/src/mathlib/gen/c/cgplg64.F b/src/mathlib/gen/c/cgplg64.F
deleted file mode 100644
index ea54cae..0000000
--- a/src/mathlib/gen/c/cgplg64.F
+++ /dev/null
@@ -1,410 +0,0 @@
-*
-* $Id: cgplg64.F,v 1.1.1.1 1996/04/01 15:02:01 mclareni Exp $
-*
-* $Log: cgplg64.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:01 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- FUNCTION WGPLG(N,M,X)
-#include "gen/imp64.inc"
-#include "gen/defc64.inc"
- + WGPLG
-#endif
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION CGPLG(N,M,X)
-#include "gen/defc64.inc"
- + CGPLG
-#endif
-#include "gen/defc64.inc"
- + Z,I,V(0:5),SK,SJ
-C
- CHARACTER NAME*(*)
- CHARACTER*80 ERRTXT
-#if defined(CERNLIB_DOUBLE)
- PARAMETER (NAME = 'CGPLG/WGPLG')
-#endif
-#if !defined(CERNLIB_DOUBLE)
- PARAMETER (NAME = 'CGPLG')
-#endif
- DIMENSION FCT(0:4),SGN(0:4),U(0:4),S1(4,4),C(4,4),A(0:30,10)
- DIMENSION NC(10),INDEX(31)
-
- PARAMETER (I = (0,1))
- PARAMETER (Z0 = 0, Z1 = 1, HF = Z1/2, C1 = 4*Z1/3, C2 = Z1/3)
-
- DATA FCT /1,1,2,6,24/, SGN /1,-1,1,-1,1/
-
- DATA S1(1,1) /1.64493 40668 482D 0/
- DATA S1(1,2) /1.20205 69031 596D 0/
- DATA S1(1,3) /1.08232 32337 111D 0/
- DATA S1(1,4) /1.03692 77551 434D 0/
- DATA S1(2,1) /1.20205 69031 596D 0/
- DATA S1(2,2) /2.70580 80842 778D-1/
- DATA S1(2,3) /9.65511 59989 444D-2/
- DATA S1(3,1) /1.08232 32337 111D 0/
- DATA S1(3,2) /9.65511 59989 444D-2/
- DATA S1(4,1) /1.03692 77551 434D 0/
-
- DATA C(1,1) / 1.64493 40668 482D0/
- DATA C(1,2) / 1.20205 69031 596D0/
- DATA C(1,3) / 1.08232 32337 111D0/
- DATA C(1,4) / 1.03692 77551 434D0/
- DATA C(2,1) / 0.00000 00000 000D0/
- DATA C(2,2) /-1.89406 56589 945D0/
- DATA C(2,3) /-3.01423 21054 407D0/
- DATA C(3,1) / 1.89406 56589 945D0/
- DATA C(3,2) / 3.01423 21054 407D0/
- DATA C(4,1) / 0.00000 00000 000D0/
-
- DATA INDEX /1,2,3,4,6*0,5,6,7,7*0,8,9,8*0,10/
-
- DATA NC /24,26,28,30,22,24,26,19,22,17/
-
- DATA A( 0,1) / .96753 21504 3498D0/
- DATA A( 1,1) / .16607 30329 2785D0/
- DATA A( 2,1) / .02487 93229 2423D0/
- DATA A( 3,1) / .00468 63619 5945D0/
- DATA A( 4,1) / .00100 16274 9616D0/
- DATA A( 5,1) / .00023 20021 9609D0/
- DATA A( 6,1) / .00005 68178 2272D0/
- DATA A( 7,1) / .00001 44963 0056D0/
- DATA A( 8,1) / .00000 38163 2946D0/
- DATA A( 9,1) / .00000 10299 0426D0/
- DATA A(10,1) / .00000 02835 7538D0/
- DATA A(11,1) / .00000 00793 8705D0/
- DATA A(12,1) / .00000 00225 3670D0/
- DATA A(13,1) / .00000 00064 7434D0/
- DATA A(14,1) / .00000 00018 7912D0/
- DATA A(15,1) / .00000 00005 5029D0/
- DATA A(16,1) / .00000 00001 6242D0/
- DATA A(17,1) / .00000 00000 4827D0/
- DATA A(18,1) / .00000 00000 1444D0/
- DATA A(19,1) / .00000 00000 0434D0/
- DATA A(20,1) / .00000 00000 0131D0/
- DATA A(21,1) / .00000 00000 0040D0/
- DATA A(22,1) / .00000 00000 0012D0/
- DATA A(23,1) / .00000 00000 0004D0/
- DATA A(24,1) / .00000 00000 0001D0/
-
- DATA A( 0,2) / .95180 88912 7832D0/
- DATA A( 1,2) / .43131 13184 6532D0/
- DATA A( 2,2) / .10002 25071 4905D0/
- DATA A( 3,2) / .02442 41559 5220D0/
- DATA A( 4,2) / .00622 51246 3724D0/
- DATA A( 5,2) / .00164 07883 1235D0/
- DATA A( 6,2) / .00044 40792 0265D0/
- DATA A( 7,2) / .00012 27749 4168D0/
- DATA A( 8,2) / .00003 45398 1284D0/
- DATA A( 9,2) / .00000 98586 9565D0/
- DATA A(10,2) / .00000 28485 6995D0/
- DATA A(11,2) / .00000 08317 0847D0/
- DATA A(12,2) / .00000 02450 3950D0/
- DATA A(13,2) / .00000 00727 6496D0/
- DATA A(14,2) / .00000 00217 5802D0/
- DATA A(15,2) / .00000 00065 4616D0/
- DATA A(16,2) / .00000 00019 8033D0/
- DATA A(17,2) / .00000 00006 0204D0/
- DATA A(18,2) / .00000 00001 8385D0/
- DATA A(19,2) / .00000 00000 5637D0/
- DATA A(20,2) / .00000 00000 1735D0/
- DATA A(21,2) / .00000 00000 0536D0/
- DATA A(22,2) / .00000 00000 0166D0/
- DATA A(23,2) / .00000 00000 0052D0/
- DATA A(24,2) / .00000 00000 0016D0/
- DATA A(25,2) / .00000 00000 0005D0/
- DATA A(26,2) / .00000 00000 0002D0/
-
- DATA A( 0,3) / .98161 02799 1365D0/
- DATA A( 1,3) / .72926 80632 0726D0/
- DATA A( 2,3) / .22774 71490 9321D0/
- DATA A( 3,3) / .06809 08329 6197D0/
- DATA A( 4,3) / .02013 70118 3064D0/
- DATA A( 5,3) / .00595 47848 0197D0/
- DATA A( 6,3) / .00176 76901 3959D0/
- DATA A( 7,3) / .00052 74821 8502D0/
- DATA A( 8,3) / .00015 82746 1460D0/
- DATA A( 9,3) / .00004 77492 2076D0/
- DATA A(10,3) / .00001 44792 0408D0/
- DATA A(11,3) / .00000 44115 4886D0/
- DATA A(12,3) / .00000 13500 3870D0/
- DATA A(13,3) / .00000 04148 1779D0/
- DATA A(14,3) / .00000 01279 3307D0/
- DATA A(15,3) / .00000 00395 9070D0/
- DATA A(16,3) / .00000 00122 9055D0/
- DATA A(17,3) / .00000 00038 2658D0/
- DATA A(18,3) / .00000 00011 9459D0/
- DATA A(19,3) / .00000 00003 7386D0/
- DATA A(20,3) / .00000 00001 1727D0/
- DATA A(21,3) / .00000 00000 3687D0/
- DATA A(22,3) / .00000 00000 1161D0/
- DATA A(23,3) / .00000 00000 0366D0/
- DATA A(24,3) / .00000 00000 0116D0/
- DATA A(25,3) / .00000 00000 0037D0/
- DATA A(26,3) / .00000 00000 0012D0/
- DATA A(27,3) / .00000 00000 0004D0/
- DATA A(28,3) / .00000 00000 0001D0/
-
- DATA A( 0,4) /1.06405 21184 614 D0/
- DATA A( 1,4) /1.06917 20744 981 D0/
- DATA A( 2,4) / .41527 19325 1768D0/
- DATA A( 3,4) / .14610 33293 6222D0/
- DATA A( 4,4) / .04904 73264 8784D0/
- DATA A( 5,4) / .01606 34086 0396D0/
- DATA A( 6,4) / .00518 88935 0790D0/
- DATA A( 7,4) / .00166 29871 7324D0/
- DATA A( 8,4) / .00053 05827 9969D0/
- DATA A( 9,4) / .00016 88702 9251D0/
- DATA A(10,4) / .00005 36832 8059D0/
- DATA A(11,4) / .00001 70592 3313D0/
- DATA A(12,4) / .00000 54217 4374D0/
- DATA A(13,4) / .00000 17239 4082D0/
- DATA A(14,4) / .00000 05485 3275D0/
- DATA A(15,4) / .00000 01746 7795D0/
- DATA A(16,4) / .00000 00556 7550D0/
- DATA A(17,4) / .00000 00177 6234D0/
- DATA A(18,4) / .00000 00056 7224D0/
- DATA A(19,4) / .00000 00018 1313D0/
- DATA A(20,4) / .00000 00005 8012D0/
- DATA A(21,4) / .00000 00001 8579D0/
- DATA A(22,4) / .00000 00000 5955D0/
- DATA A(23,4) / .00000 00000 1911D0/
- DATA A(24,4) / .00000 00000 0614D0/
- DATA A(25,4) / .00000 00000 0197D0/
- DATA A(26,4) / .00000 00000 0063D0/
- DATA A(27,4) / .00000 00000 0020D0/
- DATA A(28,4) / .00000 00000 0007D0/
- DATA A(29,4) / .00000 00000 0002D0/
- DATA A(30,4) / .00000 00000 0001D0/
-
- DATA A( 0,5) / .97920 86066 9175D0/
- DATA A( 1,5) / .08518 81314 8683D0/
- DATA A( 2,5) / .00855 98522 2013D0/
- DATA A( 3,5) / .00121 17721 4413D0/
- DATA A( 4,5) / .00020 72276 8531D0/
- DATA A( 5,5) / .00003 99695 8691D0/
- DATA A( 6,5) / .00000 83806 4065D0/
- DATA A( 7,5) / .00000 18684 8945D0/
- DATA A( 8,5) / .00000 04366 6087D0/
- DATA A( 9,5) / .00000 01059 1733D0/
- DATA A(10,5) / .00000 00264 7892D0/
- DATA A(11,5) / .00000 00067 8700D0/
- DATA A(12,5) / .00000 00017 7654D0/
- DATA A(13,5) / .00000 00004 7342D0/
- DATA A(14,5) / .00000 00001 2812D0/
- DATA A(15,5) / .00000 00000 3514D0/
- DATA A(16,5) / .00000 00000 0975D0/
- DATA A(17,5) / .00000 00000 0274D0/
- DATA A(18,5) / .00000 00000 0077D0/
- DATA A(19,5) / .00000 00000 0022D0/
- DATA A(20,5) / .00000 00000 0006D0/
- DATA A(21,5) / .00000 00000 0002D0/
- DATA A(22,5) / .00000 00000 0001D0/
-
- DATA A( 0,6) / .95021 85196 3952D0/
- DATA A( 1,6) / .29052 52916 1433D0/
- DATA A( 2,6) / .05081 77406 1716D0/
- DATA A( 3,6) / .00995 54376 7280D0/
- DATA A( 4,6) / .00211 73389 5031D0/
- DATA A( 5,6) / .00047 85947 0550D0/
- DATA A( 6,6) / .00011 33432 1308D0/
- DATA A( 7,6) / .00002 78473 3104D0/
- DATA A( 8,6) / .00000 70478 8108D0/
- DATA A( 9,6) / .00000 18278 8740D0/
- DATA A(10,6) / .00000 04838 7492D0/
- DATA A(11,6) / .00000 01303 3842D0/
- DATA A(12,6) / .00000 00356 3769D0/
- DATA A(13,6) / .00000 00098 7174D0/
- DATA A(14,6) / .00000 00027 6586D0/
- DATA A(15,6) / .00000 00007 8279D0/
- DATA A(16,6) / .00000 00002 2354D0/
- DATA A(17,6) / .00000 00000 6435D0/
- DATA A(18,6) / .00000 00000 1866D0/
- DATA A(19,6) / .00000 00000 0545D0/
- DATA A(20,6) / .00000 00000 0160D0/
- DATA A(21,6) / .00000 00000 0047D0/
- DATA A(22,6) / .00000 00000 0014D0/
- DATA A(23,6) / .00000 00000 0004D0/
- DATA A(24,6) / .00000 00000 0001D0/
-
- DATA A( 0,7) / .95064 03218 6777D0/
- DATA A( 1,7) / .54138 28546 5171D0/
- DATA A( 2,7) / .13649 97959 0321D0/
- DATA A( 3,7) / .03417 94232 8207D0/
- DATA A( 4,7) / .00869 02788 3583D0/
- DATA A( 5,7) / .00225 28408 4155D0/
- DATA A( 6,7) / .00059 51608 9806D0/
- DATA A( 7,7) / .00015 99561 7766D0/
- DATA A( 8,7) / .00004 36521 3096D0/
- DATA A( 9,7) / .00001 20747 4688D0/
- DATA A(10,7) / .00000 33801 8176D0/
- DATA A(11,7) / .00000 09563 2476D0/
- DATA A(12,7) / .00000 02731 3129D0/
- DATA A(13,7) / .00000 00786 6968D0/
- DATA A(14,7) / .00000 00228 3195D0/
- DATA A(15,7) / .00000 00066 7205D0/
- DATA A(16,7) / .00000 00019 6191D0/
- DATA A(17,7) / .00000 00005 8018D0/
- DATA A(18,7) / .00000 00001 7246D0/
- DATA A(19,7) / .00000 00000 5151D0/
- DATA A(20,7) / .00000 00000 1545D0/
- DATA A(21,7) / .00000 00000 0465D0/
- DATA A(22,7) / .00000 00000 0141D0/
- DATA A(23,7) / .00000 00000 0043D0/
- DATA A(24,7) / .00000 00000 0013D0/
- DATA A(25,7) / .00000 00000 0004D0/
- DATA A(26,7) / .00000 00000 0001D0/
-
- DATA A( 0,8) / .98800 01167 2229D0/
- DATA A( 1,8) / .04364 06760 9601D0/
- DATA A( 2,8) / .00295 09117 8278D0/
- DATA A( 3,8) / .00031 47780 9720D0/
- DATA A( 4,8) / .00004 31484 6029D0/
- DATA A( 5,8) / .00000 69381 8230D0/
- DATA A( 6,8) / .00000 12464 0350D0/
- DATA A( 7,8) / .00000 02429 3628D0/
- DATA A( 8,8) / .00000 00504 0827D0/
- DATA A( 9,8) / .00000 00109 9075D0/
- DATA A(10,8) / .00000 00024 9467D0/
- DATA A(11,8) / .00000 00005 8540D0/
- DATA A(12,8) / .00000 00001 4127D0/
- DATA A(13,8) / .00000 00000 3492D0/
- DATA A(14,8) / .00000 00000 0881D0/
- DATA A(15,8) / .00000 00000 0226D0/
- DATA A(16,8) / .00000 00000 0059D0/
- DATA A(17,8) / .00000 00000 0016D0/
- DATA A(18,8) / .00000 00000 0004D0/
- DATA A(19,8) / .00000 00000 0001D0/
-
- DATA A( 0,9) / .95768 50654 6350D0/
- DATA A( 1,9) / .19725 24967 9534D0/
- DATA A( 2,9) / .02603 37031 3918D0/
- DATA A( 3,9) / .00409 38216 8261D0/
- DATA A( 4,9) / .00072 68170 7110D0/
- DATA A( 5,9) / .00014 09187 9261D0/
- DATA A( 6,9) / .00002 92045 8914D0/
- DATA A( 7,9) / .00000 63763 1144D0/
- DATA A( 8,9) / .00000 14516 7850D0/
- DATA A( 9,9) / .00000 03420 5281D0/
- DATA A(10,9) / .00000 00829 4302D0/
- DATA A(11,9) / .00000 00206 0784D0/
- DATA A(12,9) / .00000 00052 2823D0/
- DATA A(13,9) / .00000 00013 5066D0/
- DATA A(14,9) / .00000 00003 5451D0/
- DATA A(15,9) / .00000 00000 9436D0/
- DATA A(16,9) / .00000 00000 2543D0/
- DATA A(17,9) / .00000 00000 0693D0/
- DATA A(18,9) / .00000 00000 0191D0/
- DATA A(19,9) / .00000 00000 0053D0/
- DATA A(20,9) / .00000 00000 0015D0/
- DATA A(21,9) / .00000 00000 0004D0/
- DATA A(22,9) / .00000 00000 0001D0/
-
- DATA A( 0,10) / .99343 65167 1347D0/
- DATA A( 1,10) / .02225 77012 6826D0/
- DATA A( 2,10) / .00101 47557 4703D0/
- DATA A( 3,10) / .00008 17515 6250D0/
- DATA A( 4,10) / .00000 89997 3547D0/
- DATA A( 5,10) / .00000 12082 3987D0/
- DATA A( 6,10) / .00000 01861 6913D0/
- DATA A( 7,10) / .00000 00317 4723D0/
- DATA A( 8,10) / .00000 00058 5215D0/
- DATA A( 9,10) / .00000 00011 4739D0/
- DATA A(10,10) / .00000 00002 3652D0/
- DATA A(11,10) / .00000 00000 5082D0/
- DATA A(12,10) / .00000 00000 1131D0/
- DATA A(13,10) / .00000 00000 0259D0/
- DATA A(14,10) / .00000 00000 0061D0/
- DATA A(15,10) / .00000 00000 0015D0/
- DATA A(16,10) / .00000 00000 0004D0/
- DATA A(17,10) / .00000 00000 0001D0/
-
- IF(N .LT. 1 .OR. N .GT. 4 .OR. M .LT. 1 .OR. M .GT. 4 .OR.
- 1 N+M .GT. 5) THEN
- Z=0
- WRITE(ERRTXT,101) N,M
- CALL MTLPRT(NAME,'C321.1',ERRTXT)
- ELSEIF(X .EQ. 1) THEN
- Z=S1(N,M)
- ELSEIF(X .GT. 2 .OR. X .LT. -1) THEN
- X1=1/X
- H=C1*X1+C2
- ALFA=H+H
- V(0)=1
- V(1)=LOG(-X+I*Z0)
- DO 33 L = 2,N+M
- 33 V(L)=V(1)*V(L-1)/L
- SK=0
- DO 34 K = 0,M-1
- M1=M-K
- R=X1**M1/(FCT(M1)*FCT(N-1))
- SJ=0
- DO 35 J = 0,K
- N1=N+K-J
- L=INDEX(10*N1+M1-10)
- B1=0
- B2=0
- DO 31 IT = NC(L),0,-1
- B0=A(IT,L)+ALFA*B1-B2
- B2=B1
- 31 B1=B0
- Q=(FCT(N1-1)/FCT(K-J))*(B0-H*B2)*R/M1**N1
- 35 SJ=SJ+V(J)*Q
- 34 SK=SK+SGN(K)*SJ
- SJ=0
- DO 36 J = 0,N-1
- 36 SJ=SJ+V(J)*C(N-J,M)
- Z=SGN(N)*SK+SGN(M)*(SJ+V(N+M))
- ELSEIF(X .GT. HF) THEN
- X1=1-X
- H=C1*X1+C2
- ALFA=H+H
- V(0)=1
- U(0)=1
- V(1)=LOG(X1+I*Z0)
- U(1)=LOG(X)
- DO 23 L = 2,M
- 23 V(L)=V(1)*V(L-1)/L
- DO 26 L = 2,N
- 26 U(L)=U(1)*U(L-1)/L
- SK=0
- DO 24 K = 0,N-1
- M1=N-K
- R=X1**M1/FCT(M1)
- SJ=0
- DO 25 J = 0,M-1
- N1=M-J
- L=INDEX(10*N1+M1-10)
- B1=0
- B2=0
- DO 12 IT = NC(L),0,-1
- B0=A(IT,L)+ALFA*B1-B2
- B2=B1
- 12 B1=B0
- Q=SGN(J)*(B0-H*B2)*R/M1**N1
- 25 SJ=SJ+V(J)*Q
- 24 SK=SK+U(K)*(S1(M1,M)-SJ)
- Z=SK+SGN(M)*U(N)*V(M)
- ELSE
- L=INDEX(10*N+M-10)
- H=C1*X+C2
- ALFA=H+H
- B1=0
- B2=0
- DO 11 IT = NC(L),0,-1
- B0=A(IT,L)+ALFA*B1-B2
- B2=B1
- 11 B1=B0
- Z=(B0-H*B2)*X**M/(FCT(M)*M**N)
- ENDIF
-#if defined(CERNLIB_DOUBLE)
- WGPLG=Z
-#endif
-#if !defined(CERNLIB_DOUBLE)
- CGPLG=Z
-#endif
- RETURN
- 101 FORMAT('ILLEGAL VALUES N = ',I3,' M = ',I3)
- END
diff --git a/src/mathlib/gen/c/clogam.F b/src/mathlib/gen/c/clogam.F
deleted file mode 100644
index baf37ca..0000000
--- a/src/mathlib/gen/c/clogam.F
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: clogam.F,v 1.1.1.1 1996/04/01 15:01:55 mclareni Exp $
-*
-* $Log: clogam.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:55 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- FUNCTION CLGAMA(Z)
- COMPLEX CLGAMA,Z
- COMPLEX CLOGAM
-#include "gen/defc64.inc"
- + WLGAMA,W
-#include "gen/def64.inc"
- + D
-#if defined(CERNLIB_QF2C)
-#include "defdr.inc"
-#endif
-
- SROUND(D)=D+(D-SNGL(D))
-
- ENTRY CLOGAM(Z)
-
- W=Z
- W=WLGAMA(W)
- CLGAMA=CMPLX(SROUND(DREAL(W)),SROUND(DIMAG(W)))
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/c/clogam128.F b/src/mathlib/gen/c/clogam128.F
deleted file mode 100644
index 975d0e5..0000000
--- a/src/mathlib/gen/c/clogam128.F
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: clogam128.F,v 1.1.1.1 1996/04/01 15:01:55 mclareni Exp $
-*
-* $Log: clogam128.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:55 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION WLGAMA(Z)
-#include "gen/imp128.inc"
-#if (!defined(CERNLIB_F90))&&(!defined(CERNLIB_DOUBLE))
- COMPLEX*16 WLGAMA,WLOGAM
-#endif
-#if (defined(CERNLIB_F90))&&(!defined(CERNLIB_DOUBLE))
- COMPLEX(2) WLGAMA,WLOGAM
-#endif
-C
- CHARACTER*(*) NAME
- PARAMETER( NAME='WLGAMA')
-
- ENTRY WLOGAM(Z)
-
- WLGAMA=0
- CALL MTLPRT(NAME,'C306.0','Not available on this machine')
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/c/clogam64.F b/src/mathlib/gen/c/clogam64.F
deleted file mode 100644
index 51731f0..0000000
--- a/src/mathlib/gen/c/clogam64.F
+++ /dev/null
@@ -1,115 +0,0 @@
-*
-* $Id: clogam64.F,v 1.1.1.1 1996/04/01 15:01:55 mclareni Exp $
-*
-* $Log: clogam64.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:55 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION CLGAMA(Z)
-#include "gen/defc64.inc"
- + CLGAMA
- + ,CLOGAM
-#endif
-#if defined(CERNLIB_DOUBLE)
- FUNCTION WLGAMA(Z)
-#include "gen/imp64.inc"
-#include "gen/defc64.inc"
- + WLGAMA
- + ,WLOGAM
-#endif
-#include "gen/defc64.inc"
-C + Z,W,U,V,H,P,R,GCONJG,GCMPLX
- + Z, U,V,H,P,R
- CHARACTER NAME*(*)
- CHARACTER*80 ERRTXT
-#if !defined(CERNLIB_DOUBLE)
- PARAMETER (NAME = 'CLGAMA')
-#endif
-#if defined(CERNLIB_DOUBLE)
- PARAMETER (NAME = 'CLGAMA/WLGAMA')
-#endif
- DIMENSION C(10)
-
- PARAMETER (Z1 = 1, HF = Z1/2)
-
-#include "gen/gcmpfun.inc"
-
- DATA PI /3.14159 26535 89793 24D+0/
- DATA C1 /9.18938 53320 46727 42D-1/
- DATA C2 /1.14472 98858 49400 17D+0/
-
- DATA C( 1) / 8.33333 33333 33333 33D-2/
- DATA C( 2) /-2.77777 77777 77777 78D-3/
- DATA C( 3) / 7.93650 79365 07936 51D-4/
- DATA C( 4) /-5.95238 09523 80952 38D-4/
- DATA C( 5) / 8.41750 84175 08417 51D-4/
- DATA C( 6) /-1.91752 69175 26917 53D-3/
- DATA C( 7) / 6.41025 64102 56410 26D-3/
- DATA C( 8) /-2.95506 53594 77124 18D-2/
- DATA C( 9) / 1.79644 37236 88305 73D-1/
- DATA C(10) /-1.39243 22169 05901 12D+0/
-C GREAL(U)=DREAL(U)
-C GIMAG(U)=DIMAG(U)
-C GCONJG(U)=DCONJG(U)
-C GCMPLX(X,Y)=DCMPLX(X,Y)
-
-#if !defined(CERNLIB_DOUBLE)
- ENTRY CLOGAM(Z)
-#endif
-#if defined(CERNLIB_DOUBLE)
- ENTRY WLOGAM(Z)
-#endif
-
- X=Z
- Y=GIMAG(Z)
- IF(Y .EQ. 0 .AND. -ABS(X) .EQ. INT(X)) THEN
- H=0
- WRITE(ERRTXT,101) X
- CALL MTLPRT(NAME,'C306.1',ERRTXT)
- ELSE
- YA=ABS(Y)
- U=GCMPLX(X,YA)
- IF(X .LT. 0) U=1-U
- H=0
- UR=U
- IF(UR .LT. 7) THEN
- UI=GIMAG(U)
- A=ATAN2(UI,UR)
- H=U
- DO 1 I = 1,6-INT(UR)
- UR=UR+1
- U=GCMPLX(UR,UI)
- H=H*U
- 1 A=A+ATAN2(UI,UR)
- H=GCMPLX(HF*LOG(GREAL(H)**2+GIMAG(H)**2),A)
- U=U+1
- ENDIF
- R=1/U**2
- P=R*C(10)
- DO 2 I = 9,2,-1
- 2 P=R*(C(I)+P)
- H=C1+(U-HF)*LOG(U)-U+(C(1)+P)/U-H
- IF(X .LT. 0) THEN
- UR=INT(X)-1
- UI=PI*(X-UR)
- X=PI*YA
- T=EXP(-X-X)
- A=SIN(UI)
- T=X+HF*LOG(T*A**2+(HF*(1-T))**2)
- A=ATAN2(COS(UI)*TANH(X),A)-UR*PI
- H=C2-GCMPLX(T,A)-H
- ENDIF
- IF(Y .LT. 0) H=GCONJG(H)
- ENDIF
-#if defined(CERNLIB_DOUBLE)
- WLGAMA=H
-#endif
-#if !defined(CERNLIB_DOUBLE)
- CLGAMA=H
-#endif
- RETURN
- 101 FORMAT('ARGUMENT EQUALS NON-POSITIVE INTEGER = ',1P,E15.1)
- END
diff --git a/src/mathlib/gen/c/clogok.F b/src/mathlib/gen/c/clogok.F
deleted file mode 100644
index 81fa2e0..0000000
--- a/src/mathlib/gen/c/clogok.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: clogok.F,v 1.1.1.1 1996/04/01 15:01:58 mclareni Exp $
-*
-* $Log: clogok.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:58 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- COMPLEX FUNCTION CLOGOK(Z,N,M)
- COMPLEX Z,SZ
- DATA PI/3.1415926535898/
- SZ=LOG(Z)
- S=REAL(SZ)
- NF=N+5
- GOTO (21,22,23) ,M
- 21 GOTO (2,2,2,11,10,9,2,2,2),NF
- 22 GOTO (2,11,2,2,2,2,2,9,2),NF
- 23 GOTO (2,11,2,2,2,2,2,9,2),NF
- 9 SZ=CMPLX(S,-PI)
- GOTO 2
- 10 SZ=CMPLX(S,0.0)
- GOTO 2
- 11 SZ=CMPLX(S,PI)
- 2 CLOGOK=SZ
-C*UL 80 RETURN
- RETURN
- END
diff --git a/src/mathlib/gen/c/cpolyz64.F b/src/mathlib/gen/c/cpolyz64.F
deleted file mode 100644
index 660085f..0000000
--- a/src/mathlib/gen/c/cpolyz64.F
+++ /dev/null
@@ -1,264 +0,0 @@
-*
-* $Id: cpolyz64.F,v 1.1.1.1 1996/04/01 15:01:53 mclareni Exp $
-*
-* $Log: cpolyz64.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:53 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- SUBROUTINE WPOLYZ(C,N,MAXIT,Z0,H)
-C
-#include "gen/imp64.inc"
-C
- CHARACTER NAME*(*)
- PARAMETER (NAME = 'WPOLYZ')
-#endif
-#if !defined(CERNLIB_DOUBLE)
- SUBROUTINE CPOLYZ(C,N,MAXIT,Z0,H)
-C
- CHARACTER NAME*(*)
- PARAMETER (NAME = 'CPOLYZ')
-#endif
-C
-C Based on
-C T. Pomentale, Homotopy methods for polynomial equations,
-C J. Inst. Maths Applics 13 (1974) 201-213
-
-C Revised version of a routine originally written by T. Pomentale
-
-#include "gen/defc64.inc"
- + C(0:*),Z0(*),F(100),B(100),Z,CN,CD,FZ,FF,F1,F2,V,ZZ,Z1,ZV,IU
- LOGICAL LMD
- DIMENSION H(*)
- CHARACTER*80 ERRTXT
-
- PARAMETER (EPS = 1D-14)
-#if defined(CERNLIB_CRAY)
- PARAMETER (IU = (0E0,1E0))
-#endif
-#if !defined(CERNLIB_CRAY)
- PARAMETER (IU = (0D0,1D0))
-#endif
- PARAMETER (R0 = 0, R1 = 1, BIG1 = 1D7, BIG2 = BIG1/10, HF = R1/2)
- PARAMETER (FAC1 = 9*R1/10, FAC2 = 2+100*FAC1*EPS)
- PARAMETER (PI = 3.14159 26535 89793 24D0, PI2 = 2*PI)
-
-#if defined(CERNLIB_QF2C)
-#include "defdr.inc"
-#endif
-#if defined(CERNLIB_DOUBLE)
- TST(Z1,ZV)=DREAL(Z1)*DREAL(ZV)+DIMAG(Z1)*DIMAG(ZV)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- TST(Z1,ZV)=REAL(Z1)*REAL(ZV)+AIMAG(Z1)*AIMAG(ZV)
-#endif
-
- IF(N .LE. 0) RETURN
- IF(C(0) .EQ. 0) THEN
- CALL MTLPRT(NAME,'C209.1','A(0) = 0')
- RETURN
- ENDIF
- IF(N .EQ. 1) THEN
- Z0(1)=-C(1)/C(0)
- H(1)=0
- RETURN
- ENDIF
- IF(N .EQ. 2) THEN
- H(1)=0
- H(2)=0
- Z0(2)=(-C(1)+SQRT(C(1)**2-4*C(0)*C(2)))/(2*C(0))
- Z0(1)=-Z0(2)-C(1)/C(0)
- RETURN
- ENDIF
- LMD=.FALSE.
- DO 1 K = 1,N
- 1 LMD=LMD .OR. Z0(K) .NE. 0
- M=0
- WN=SQRT(N+R0)
- Z=1+IU
- N1=N
-
- DO 3 K = 1,N+1
- H(K)=1
- 3 B(K)=C(K-1)
- 6 DO 10 K = 1,N-2
- IF(B(N1+1) .EQ. 0) GO TO 18
- IF(LMD) Z=Z0(K)
- IF(M .GE. MAXIT) THEN
- CALL MTLPRT(NAME,'C209.2','TOO MANY ITERATIONS')
- RETURN
- ENDIF
-
- S=BIG1
- DO 61 I = 1,N1+1
- 61 F(I)=B(I)
- ZA=ABS(Z)
- HH=HF*ABS(B(1))
- DO 62 I = 2,N1+1
- F(I)=Z*F(I-1)+F(I)
- D=ABS(F(I))
- 62 HH=ZA*HH+D
- DO 63 L = 1,2
- DO 63 I = 2,N1-L+1
- 63 F(I)=Z*F(I-1)+F(I)
- M=M+1
- IF(D .LE. EPS*(FAC2*HH-D)) GO TO 13
-
- 7 D1=S
- 8 NI=0
- V=Z
- FZ=F(N1+1)
- FF=FZ
- F1=F(N1)
- F2=F(N1-1)
-
- 9 NI=NI+1
- IH=0
- Z=V
- F(N1+1)=FF
- F(N1)=F1
- F(N1-1)=F2
- 11 IH=IH+1
- IF(IH .GT. NI) GO TO 9
- CN=F(N1+1)-(NI-IH)*FZ/(NI+R0)
- CD=F(N1)**2-2*F(N1-1)*CN
- CN=CN*F(N1)
- IF(ABS(CN) .GT. 10*ABS(CD)) GO TO 9
- Z=Z-CN/CD
- IF(M .GE. MAXIT) THEN
- CALL MTLPRT(NAME,'C209.2','TOO MANY ITERATIONS')
- RETURN
- ENDIF
-
- DO 71 I = 1,N1+1
- 71 F(I)=B(I)
- ZA=ABS(Z)
- HH=HF*ABS(B(1))
- DO 72 I = 2,N1+1
- F(I)=Z*F(I-1)+F(I)
- D=ABS(F(I))
- 72 HH=ZA*HH+D
- DO 73 L = 1,2
- DO 73 I = 2,N1-L+1
- 73 F(I)=Z*F(I-1)+F(I)
- M=M+1
- ERR=EPS*(FAC2*HH-D)
- IF(D .LE. ERR) GO TO 13
- S=ABS(F(N1+1))
- IF(S .LE. FAC1*D1) GO TO 7
- IF(S .LT. BIG2*ERR) GO TO 13
- S1=ABS(F(N1))
- S2=ABS(F(N1-1))
- S3=1+ABS(Z)
- IF(2*S1 .GT. S2*S3 .OR. 10*S .LT. S1*S3) GO TO 11
-
- ZZ=Z
- KK=2
- M1=1
- S=S1/S2
- 40 DT=PI2/KK
- DO 42 J=1,KK,M1
- ZV=S*EXP(IU*(J*DT))
- Z=ZZ+ZV
- IF(M .GE. MAXIT) GO TO 44
- DO 41 I = 1,N1+1
- 41 F(I)=B(I)
- DO 43 L = 0,1
- DO 43 I = 2,N1-L+1
- 43 F(I)=Z*F(I-1)+F(I)
- M=M+1
- IF(F(N1) .NE. 0) THEN
- Z1=(ABS(F(N1))*F(N1+1))/F(N1)
- IF(TST(Z1,ZV) .LT. 0) GO TO 44
- ENDIF
- 42 CONTINUE
- M1=2
- KK=2*KK
- IF(KK .LE. 8) GO TO 40
-
- 44 S2=1
- S=ABS(F(N1+1))
- S1=ABS(F(N1))
- IF(S .GT. S1*(1+ABS(Z))) S2=S1/(2*S)
- Z=Z-S2*F(N1+1)/F(N1)
- IF(M .GE. MAXIT) THEN
- CALL MTLPRT(NAME,'C209.2','TOO MANY ITERATIONS')
- RETURN
- ENDIF
- DO 81 I = 1,N1+1
- 81 F(I)=B(I)
- DO 83 L = 0,2
- DO 83 I = 2,N1-L+1
- 83 F(I)=Z*F(I-1)+F(I)
- M=M+1
- GO TO 8
-
- 18 Z=0
- H(K)=0
-
- 13 IF(Z .EQ. 0) GO TO 53
- X=ABS(B(N1+1))
- Z1=1
- JR=0
- DO 51 J = 2,N1
- Z1=Z*Z1
- Y=ABS(Z1*B(N1-J+2))
- IF(Y .GT. X) THEN
- X=Y
- JR=J-1
- ENDIF
- 51 CONTINUE
- IF(JR .GT. 0) THEN
- B(N1+1)=-B(N1+1)/Z
- DO 52 J = N1,N1-JR+2,-1
- 52 B(J)=(B(J+1)-B(J))/Z
- DO 55 J = N1-JR+1,N1
- 55 B(J)=B(J+1)
- ENDIF
- DO 54 J = 2,N1-JR
- 54 B(J)=B(J)+Z*B(J-1)
-
- 53 N1=N1-1
- Z0(K)=Z
- 10 CONTINUE
- Z0(N)=(-B(2)+SQRT(B(2)**2-4*B(1)*B(3)))/(2*B(1))
- Z0(N-1)=-Z0(N)-B(2)/B(1)
- IF(B(3) .EQ. 0) H(N)=0
- IF(B(2) .EQ. 0 .AND. B(3) .EQ. 0) H(N-1)=0
- 12 CONTINUE
-
- DO 14 K=1,N
- IF(H(K) .EQ. 0) GO TO 14
- H(K)=0
-
- DO 91 I = 1,N+1
- 91 F(I)=C(I-1)
- ZA=ABS(Z0(K))
- HH=HF*ABS(C(0))
- DO 92 I = 2,N+1
- F(I)=Z0(K)*F(I-1)+F(I)
- D=ABS(F(I))
- 92 HH=ZA*HH+D
- DO 93 L = 1,2
- DO 93 I = 2,N-L+1
- 93 F(I)=Z0(K)*F(I-1)+F(I)
- IF(F(N+1) .EQ. 0 .AND. F(N) .EQ. 0) GO TO 14
- ERR=EPS*(FAC2*HH-D)
- IF(D .LE. ERR) THEN
- S=WN*ERR
- ELSE
- S=WN*ABS(F(N+1))
- ENDIF
- S1=SQRT(ABS(F(N)**2-2*F(N-1)*F(N+1)))
- IF(S .LE. 10*S1*ABS(Z0(K))) THEN
- H(K)=S/S1
- ELSE
- WRITE(ERRTXT,103) M
- CALL MTLPRT(NAME,'C209.3',ERRTXT)
- ENDIF
- 14 CONTINUE
- RETURN
-103 FORMAT('BOUND FOR Z0',I3,' CANNOT BE FOUND')
- END
diff --git a/src/mathlib/gen/c/cpolyzd.F b/src/mathlib/gen/c/cpolyzd.F
deleted file mode 100644
index 57992a7..0000000
--- a/src/mathlib/gen/c/cpolyzd.F
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: cpolyzd.F,v 1.1.1.1 1996/04/01 15:01:53 mclareni Exp $
-*
-* $Log: cpolyzd.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:53 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if !defined(CERNLIB_DOUBLE)
- SUBROUTINE WPOLYZ(C,N,MAXIT,Z0,H)
-C
- CHARACTER NAME*(*)
- PARAMETER (NAME = 'WPOLYZ')
-#endif
-#if defined(CERNLIB_DOUBLE)
- SUBROUTINE CPOLYZ(C,N,MAXIT,Z0,H)
-C
- CHARACTER NAME*(*)
- PARAMETER (NAME = 'CPOLYZ')
-#endif
- CALL MTLPRT(NAME,'C209.0','Not available on this machine')
- RETURN
- END
diff --git a/src/mathlib/gen/c/cpsipg.F b/src/mathlib/gen/c/cpsipg.F
deleted file mode 100644
index 28a23c7..0000000
--- a/src/mathlib/gen/c/cpsipg.F
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: cpsipg.F,v 1.1.1.1 1996/04/01 15:02:01 mclareni Exp $
-*
-* $Log: cpsipg.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:01 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- FUNCTION CPSIPG(Z,K)
- COMPLEX CPSIPG,Z
- COMPLEX*16 WPSIPG,W
- DOUBLE PRECISION D
-
- SROUND(D)=D+(D-SNGL(D))
- W=Z
- W=WPSIPG(W,K)
- CPSIPG=CMPLX(SROUND(DREAL(W)),SROUND(DIMAG(W)))
- RETURN
- END
diff --git a/src/mathlib/gen/c/crit.F b/src/mathlib/gen/c/crit.F
deleted file mode 100644
index 31dfdf2..0000000
--- a/src/mathlib/gen/c/crit.F
+++ /dev/null
@@ -1,14 +0,0 @@
-*
-* $Id: crit.F,v 1.1.1.1 1996/04/01 15:01:58 mclareni Exp $
-*
-* $Log: crit.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:58 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- FUNCTION CRIT(SUM,DEL,ACCS)
- COMPLEX SUM,DEL
- CRIT=REAL(DEL)**2+AIMAG(DEL)**2-ACCS*(REAL(SUM)**2+AIMAG(SUM)**2)
- RETURN
- END
diff --git a/src/mathlib/gen/c/csqrtk.F b/src/mathlib/gen/c/csqrtk.F
deleted file mode 100644
index 5595f01..0000000
--- a/src/mathlib/gen/c/csqrtk.F
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: csqrtk.F,v 1.1.1.1 1996/04/01 15:01:58 mclareni Exp $
-*
-* $Log: csqrtk.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:58 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- COMPLEX FUNCTION CSQRTK(Z,N,M)
- COMPLEX Z,SZ
- NF=N+5
- SZ=SQRT(Z)
- S=ABS(AIMAG(SZ))
- GOTO (21,22),M
- 21 GOTO (9,2,2,9,11,11,2,2,11),NF
- 22 GOTO (2,11,2,2,2,2,2,9,2),NF
- 9 SZ=CMPLX(0.0,-S)
- GOTO 2
- 11 SZ=CMPLX(0.0,S)
- 2 CSQRTK=SZ
- RETURN
- END
diff --git a/src/mathlib/gen/c/cwerf.F b/src/mathlib/gen/c/cwerf.F
deleted file mode 100644
index 9455f17..0000000
--- a/src/mathlib/gen/c/cwerf.F
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: cwerf.F,v 1.1.1.1 1996/04/01 15:02:05 mclareni Exp $
-*
-* $Log: cwerf.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:05 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- FUNCTION CWERF(Z)
- COMPLEX CWERF,Z
-#include "gen/defc64.inc"
- + WWERF,W
-#include "gen/def64.inc"
- + D
-
-#if defined(CERNLIB_QF2C)
-#include "defdr.inc"
-#endif
-
- SROUND(D)=D+(D-SNGL(D))
- W=Z
- W=WWERF(W)
- CWERF=CMPLX(SROUND(DREAL(W)),SROUND(DIMAG(W)))
- END
-#endif
diff --git a/src/mathlib/gen/c/cwerf128.F b/src/mathlib/gen/c/cwerf128.F
deleted file mode 100644
index 074c84b..0000000
--- a/src/mathlib/gen/c/cwerf128.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: cwerf128.F,v 1.1.1.1 1996/04/01 15:02:05 mclareni Exp $
-*
-* $Log: cwerf128.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:05 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION WWERF(Z)
-#include "gen/imp128.inc"
-#if (!defined(CERNLIB_F90))&&(!defined(CERNLIB_DOUBLE))
- COMPLEX*16 WWERF
-#endif
-#if (defined(CERNLIB_F90))&&(!defined(CERNLIB_DOUBLE))
- COMPLEX(2) WWERF
-#endif
-#if !defined(CERNLIB_DOUBLE)
-C
- CHARACTER*(*) NAME
- PARAMETER( NAME='WWERF')
- WWERF=0
- CALL MTLPRT(NAME,'C335.0','Not available on this machine')
- RETURN
- END
-#endif
-#endif
diff --git a/src/mathlib/gen/c/cwerf64.F b/src/mathlib/gen/c/cwerf64.F
deleted file mode 100644
index d23c39a..0000000
--- a/src/mathlib/gen/c/cwerf64.F
+++ /dev/null
@@ -1,74 +0,0 @@
-*
-* $Id: cwerf64.F,v 1.1.1.1 1996/04/01 15:02:05 mclareni Exp $
-*
-* $Log: cwerf64.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:05 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION CWERF(Z)
-#include "gen/defc64.inc"
- + CWERF
-#endif
-#if defined(CERNLIB_DOUBLE)
- FUNCTION WWERF(Z)
-#include "gen/imp64.inc"
-#include "gen/defc64.inc"
- + WWERF
-#endif
-#include "gen/defc64.inc"
-C + Z,ZH,R(37),S,T,V,W,GCMPLX,GCONJG
- + Z,ZH,R(37),S,T,V,W
-
- PARAMETER (Z1 = 1, HF = Z1/2, Z10 = 10)
- PARAMETER (C1 = 74/Z10, C2 = 83/Z10, C3 = Z10/32, C4 = 16/Z10)
- PARAMETER (C = 1.12837 91670 95512 57D0, P = (2*C4)**33)
-
-#include "gen/gcmpfun.inc"
-
-C GREAL(W)=DREAL(W)
-C GIMAG(W)=DIMAG(W)
-C GCONJG(W)=DCONJG(W)
-C GCMPLX(X,Y)=DCMPLX(X,Y)
-
- X=Z
- Y=GIMAG(Z)
- XA=ABS(X)
- YA=ABS(Y)
- IF(YA .LT. C1 .AND. XA .LT. C2) THEN
- ZH=GCMPLX(YA+C4,XA)
- R(37)=0
- DO 1 N = 36,1,-1
- T=ZH+N*GCONJG(R(N+1))
- 1 R(N)=HF*T/(GREAL(T)**2+GIMAG(T)**2)
- XL=P
- S=0
- DO 2 N = 33,1,-1
- XL=C3*XL
- 2 S=R(N)*(S+XL)
- V=C*S
- ELSE
- ZH=GCMPLX(YA,XA)
- R(1)=0
- DO 3 N = 9,1,-1
- T=ZH+N*GCONJG(R(1))
- 3 R(1)=HF*T/(GREAL(T)**2+GIMAG(T)**2)
- V=C*R(1)
- END IF
- IF(YA .EQ. 0) V=GCMPLX(EXP(-XA**2),GIMAG(V))
- IF(Y .LT. 0) THEN
- V=2*EXP(-GCMPLX(XA,YA)**2)-V
- IF(X .GT. 0) V=GCONJG(V)
- ELSE
- IF(X .LT. 0) V=GCONJG(V)
- END IF
-#if !defined(CERNLIB_DOUBLE)
- CWERF=V
-#endif
-#if defined(CERNLIB_DOUBLE)
- WWERF=V
-#endif
- RETURN
- END
diff --git a/src/mathlib/gen/c/cwhitm.F b/src/mathlib/gen/c/cwhitm.F
deleted file mode 100644
index c74c292..0000000
--- a/src/mathlib/gen/c/cwhitm.F
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: cwhitm.F,v 1.1.1.1 1996/04/01 15:02:03 mclareni Exp $
-*
-* $Log: cwhitm.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:03 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- FUNCTION CWHITM(Z,KA,MU)
- COMPLEX CWHITM,Z,KA,MU
-#include "gen/defc64.inc"
- + WWHITM,WZ,WKA,WMU,W
-#include "gen/def64.inc"
- + D
-#if defined(CERNLIB_QF2C)
-#include "defdr.inc"
-#endif
-#include "gen/gcmpfun.inc"
- SROUND(D)=D+(D-SNGL(D))
- WZ=Z
- WKA=KA
- WMU=MU
- W=WWHITM(WZ,WKA,WMU)
- CWHITM=CMPLX(SROUND(DREAL(W)),SROUND(DIMAG(W)))
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/c/cwhitm128.F b/src/mathlib/gen/c/cwhitm128.F
deleted file mode 100644
index bb79783..0000000
--- a/src/mathlib/gen/c/cwhitm128.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: cwhitm128.F,v 1.1.1.1 1996/04/01 15:02:03 mclareni Exp $
-*
-* $Log: cwhitm128.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:03 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION WWHITM(Z,KA,MU)
-C
-#if (!defined(CERNLIB_F90))&&(!defined(CERNLIB_DOUBLE))
- COMPLEX*16 WWHITM,Z,KA,MU
-#endif
-#if (defined(CERNLIB_F90))&&(!defined(CERNLIB_DOUBLE))
- COMPLEX(2) WWHITM,Z,KA,MU
-#endif
-#if !defined(CERNLIB_DOUBLE)
-C
- CHARACTER*(*) NAME
- PARAMETER( NAME='WWHITM')
- WWHITM=0
- CALL MTLPRT(NAME,'C328.0','Not available on this machine')
- RETURN
- END
-#endif
-#endif
diff --git a/src/mathlib/gen/c/cwhitm64.F b/src/mathlib/gen/c/cwhitm64.F
deleted file mode 100644
index 968bf49..0000000
--- a/src/mathlib/gen/c/cwhitm64.F
+++ /dev/null
@@ -1,125 +0,0 @@
-*
-* $Id: cwhitm64.F,v 1.1.1.1 1996/04/01 15:02:04 mclareni Exp $
-*
-* $Log: cwhitm64.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:04 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- FUNCTION WWHITM(Z,KA,MU)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION CWHITM(Z,KA,MU)
-#endif
-C Computes the Whittaker function
-C M ka,mu (z) = exp(z/2) * z**(mu+1/2) * 1F1(mu-ka+1/2;1+2*mu;z)
-C using
-C 1F1(a;b;z) = ro**(-la-1) * exp(-i*ro) * F la (et,ro) / C la (et)
-C where F la (et,ro) is the regular Coulomb Wave Function,
-C a = 1+la+i*et, b = 2*la+2, z = -2*i*ro,
-C and where
-C C la (et) = 2**la * exp(-pi*et/2 + (ln gamma(1+la+i*et) +
-C ln gamma(1+la-i*et))/2 - ln gamma(2*la+2))
-C is the Gamow factor (cf. Coulomb Wave Functions)
-#include "gen/impc64.inc"
-#include "gen/defc64.inc"
- + KA,LA,MU
-C IMPLICIT COMPLEX*16 (A-H,I,K,L,M,O-Z)
-#include "gen/def64.inc"
- + AI,AR,BI,BR,CI,CR,ZI,ZR, R1,DELTA,DLN2,HF,PI,PIH
- CHARACTER NAME*(*)
- CHARACTER*80 ERRTXT
-#if defined(CERNLIB_DOUBLE)
- PARAMETER (NAME = 'CWHITM/WWHITM')
-#endif
-#if !defined(CERNLIB_DOUBLE)
- PARAMETER (NAME = 'CWHITM')
-#endif
- DIMENSION F(0:1),G(0:1),FP(0:1),GP(0:1),SG(0:1)
-
- PARAMETER (DELTA = 1D-13)
- PARAMETER (R1 = 1, HF = R1/2)
- PARAMETER (PI = 3.14159 26535 89793 238D0, PIH = PI/2)
- PARAMETER (DLN2 = 0.69314 71805 59945 309D0)
- PARAMETER (I = (0,1), IPI = I*PI, IHF= I/2)
-
-#if defined(CERNLIB_DOUBLE)
- GLOGAM(Q)=WLOGAM(Q)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- GLOGAM(Q)=CLOGAM(Q)
-#endif
- A=MU-KA+HF
- B=1+2*MU
- C=MU+KA+HF
- AR=A
- BR=B
- CR=C
- ZR=Z
- AI=-I*A
- BI=-I*B
- CI=-I*C
- ZI=-I*Z
- IF(ZR .LE. 0 .AND. ZI .EQ. 0) THEN
- H=0
- WRITE(ERRTXT,101) ZR
- CALL MTLPRT(NAME,'C328.1',ERRTXT)
- ELSE IF(ABS(BI) .LE. DELTA .AND.
- 1 ABS(INT(BR+SIGN(DELTA,BR))+ABS(BR)) .LE .DELTA) THEN
- H=0
- WRITE(ERRTXT,102) (BR-1)/2
- CALL MTLPRT(NAME,'C328.2',ERRTXT)
- ELSE IF(ABS(AI) .LE. DELTA .AND.
- 1 ABS(INT(AR+SIGN(DELTA,AR))+ABS(AR)) .LE .DELTA) THEN
- S=1
- Q=1
- N1=AR+SIGN(DELTA,AR)
- DO 1 N = 1,-N1
- Q=Q*((N1+N-1)/(B+(N-1)))*Z/N
- 1 S=S+Q
- H=EXP(-HF*Z)*Z**(HF+MU)*S
- ELSE IF(ABS(CI) .LE. DELTA .AND.
- 1 ABS(INT(CR+SIGN(DELTA,CR))+ABS(CR)) .LE .DELTA) THEN
- S=1
- Q=1
- N1=CR+SIGN(DELTA,CR)
- DO 2 N = 1,-N1
- Q=-Q*((N1+N-1)/(B+(N-1)))*Z/N
- 2 S=S+Q
- H=EXP(HF*Z)*Z**(HF+MU)*S
- ELSE
- ET=I*KA
- RO=IHF*Z
- LA=MU-HF
- Q=GLOGAM(B)-HF*(GLOGAM(A)+GLOGAM(C))+DLN2
- IF(ZR .LE. 0 .AND. ZI .GT. 0) THEN
- ET=-ET
- RO=-RO
- Q=Q+IPI*(MU+HF)
- END IF
-#if defined(CERNLIB_DOUBLE)
- CALL WCLBES(RO,ET,LA,0,F,G,FP,GP,SG,-1,4,JFAIL,0)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- CALL CCLBES(RO,ET,LA,0,F,G,FP,GP,SG,-1,4,JFAIL,0)
-#endif
- H=EXP(Q+PIH*(ET-(MU+HF)*I))*F(0)
- IF(JFAIL .NE. 0) THEN
- WRITE(ERRTXT,103) JFAIL
- CALL MTLPRT(NAME,'C328.3',ERRTXT)
- ENDIF
- ENDIF
-#if defined(CERNLIB_DOUBLE)
- WWHITM=H
-#endif
-#if !defined(CERNLIB_DOUBLE)
- CWHITM=H
-#endif
- RETURN
- 101 FORMAT('ARGUMENT Z =',1P,D15.8,' ON NEGATIVE REAL AXIS')
- 102 FORMAT('M KA,MU (Z) UNDEFINED OR INFINITE FOR M = ',F8.1,
- 1 ' NEGATIVE HALF-INTEGER')
- 103 FORMAT('SUBROUTINE C309 CCLBES/WCLBES RETURNS IFAIL = ',I4)
- END
diff --git a/src/mathlib/gen/c/dawson.F b/src/mathlib/gen/c/dawson.F
deleted file mode 100644
index f0df74f..0000000
--- a/src/mathlib/gen/c/dawson.F
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: dawson.F,v 1.1.1.1 1996/04/01 15:02:07 mclareni Exp $
-*
-* $Log: dawson.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:07 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION DAWSON(X)
-
- DAWSON=RDAWSN(X)
- RETURN
-
- END
-#endif
diff --git a/src/mathlib/gen/c/dawson128.F b/src/mathlib/gen/c/dawson128.F
deleted file mode 100644
index df44b47..0000000
--- a/src/mathlib/gen/c/dawson128.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: dawson128.F,v 1.1.1.1 1996/04/01 15:02:07 mclareni Exp $
-*
-* $Log: dawson128.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:07 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION DDAWSN(X)
-C
-#include "gen/imp128.inc"
-C
- CHARACTER*(*) NAME
- PARAMETER( NAME='DDAWSN')
- DDAWSN=0
- CALL MTLPRT(NAME,'C339.0','Not available on this machine')
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/c/dawson64.F b/src/mathlib/gen/c/dawson64.F
deleted file mode 100644
index 4ffdd02..0000000
--- a/src/mathlib/gen/c/dawson64.F
+++ /dev/null
@@ -1,96 +0,0 @@
-*
-* $Id: dawson64.F,v 1.1.1.1 1996/04/01 15:02:07 mclareni Exp $
-*
-* $Log: dawson64.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:07 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION RDAWSN(X)
-#endif
-#if defined(CERNLIB_DOUBLE)
- FUNCTION DDAWSN(X)
-#include "gen/imp64.inc"
-#endif
-
- DIMENSION P1(0:8),Q1(0:8)
- DIMENSION A1(0:7),B1(0:6),A2(0:7),B2(0:6),A3(0:5),B3(0:4)
-
- PARAMETER (Z1 = 1, HF = Z1/2, C1 = 2+HF, C2 = 3+HF)
-
- DATA P1
- 1/+1.73971 38358 72305 8D+8, -2.35903 54309 49078 4D+7,
- 2 +7.94595 11256 26974 7D+6, -4.49408 95997 95344 8D+5,
- 3 +6.26435 22480 53304 3D+4, -1.64294 23044 87861 4D+3,
- 4 +1.10415 15859 64097 2D+2, -1.23806 01126 69044 4D+0,
- 5 +1.70141 56251 64813 2D-2/
- DATA Q1
- 1/+1.73971 38358 72305 8D+8, +9.23905 68081 99581 7D+7,
- 2 +2.31472 94223 70433 8D+7, +3.59959 82595 90670 4D+6,
- 3 +3.83498 04512 71685 6D+5, +2.90022 12938 95164 3D+4,
- 4 +1.54480 44953 25198 3D+3, +5.42357 27435 06117 3D+1,
- 5 +1.00000 00000 00000 0D+0/
- DATA A1
- 1/+5.00236 89608 86678 8D-1, -5.97678 08682 34888 6D+0,
- 2 +1.52644 09962 36985 9D+1, -8.89106 47974 78123 3D+0,
- 3 -7.57931 91808 93692 7D-2, -4.00000 89364 35497 2D+1,
- 4 +2.93365 74739 54485 3D+1, -1.50695 65118 71605 5D+0/
- DATA A2
- 1/+4.99999 90270 50535 9D-1, -1.49838 04203 66907 2D+0,
- 2 -4.98544 80298 66076 7D+0, +5.06460 15374 22307 7D+0,
- 3 -1.50507 70349 66919 6D+1, -9.16804 87981 35517 1D+0,
- 4 -2.66167 67489 63992 8D+1, +4.76405 64527 32287 8D+0/
- DATA A3
- 1/+5.00000 00000 87358 0D-1, -2.50000 27830 30495 0D+0,
- 2 -4.51057 82777 83269 5D+0, -7.82636 28103 36344 1D+0,
- 3 -4.05239 81738 80339 4D+1, +4.12716 33274 69802 1D+0/
- DATA B1
- 1/+2.26064 66607 43091 6D-1, +1.15840 29255 18881 3D+2,
- 2 +7.29177 55641 55315 0D+1, +1.12461 66202 45754 3D+2,
- 3 +7.21193 21760 02290 6D+0, +1.24486 78826 22516 2D+3,
- 4 -6.73106 06974 48133 1D-1/
- DATA B2
- 1/+2.50011 45961 18389 4D-1, -1.48715 81178 71947 5D+0,
- 2 +3.30707 72467 61143 7D+1, +1.46515 16778 31092 9D+2,
- 3 +7.51701 27774 40669 3D+1, +2.56105 72234 22263 5D+1,
- 4 +2.87776 12297 31873 6D+2/
- DATA B3
- 1/+7.49999 99263 58122 3D-1, -2.49963 00606 78980 2D+0,
- 2 -6.58834 68001 31477 4D+0, -6.89636 11433 76130 9D-1,
- 3 +5.20416 17289 69394 6D+2/
-
- V=ABS(X)
- Y=V**2
- IF(V .LT. C1) THEN
- P=P1(8)
- Q=Q1(8)
- DO 1 I = 7,0,-1
- P=Y*P+P1(I)
- 1 Q=Y*Q+Q1(I)
- H=X*P/Q
- ELSE IF(V .LT. C2) THEN
- P=Y+A1(7)
- DO 2 I = 6,1,-1
- 2 P=Y+A1(I)+B1(I)/P
- H=(A1(0)+B1(0)/P)/X
- ELSE IF(V .LT. 5) THEN
- P=Y+A2(7)
- DO 3 I = 6,1,-1
- 3 P=Y+A2(I)+B2(I)/P
- H=(A2(0)+B2(0)/P)/X
- ELSE
- P=Y+A3(5)
- DO 4 I = 4,1,-1
- 4 P=Y+A3(I)+B3(I)/P
- H=(HF+HF*(A3(0)+B3(0)/P)/Y)/X
- END IF
-#if !defined(CERNLIB_DOUBLE)
- RDAWSN=H
-#endif
-#if defined(CERNLIB_DOUBLE)
- DDAWSN=H
-#endif
- RETURN
- END
diff --git a/src/mathlib/gen/c/dbska.F b/src/mathlib/gen/c/dbska.F
deleted file mode 100644
index 61897bb..0000000
--- a/src/mathlib/gen/c/dbska.F
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: dbska.F,v 1.1.1.1 1996/04/01 15:02:07 mclareni Exp $
-*
-* $Log: dbska.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:07 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if !defined(CERNLIB_DOUBLE)
- SUBROUTINE DBSKA(X,IA,JA,NL,B)
-#include "gen/imp128.inc"
- CHARACTER*6 NAME
- NAME = 'DBSKA'
- CALL MTLPRT(NAME,'C341',
- +'not available on this machine - see documentation')
- RETURN
-
- ENTRY DEBSKA(X,IA,JA,NL,B)
- NAME = 'DEBSKA'
- CALL MTLPRT(NAME,'C341',
- +'not available on this machine - see documentation')
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/c/dbska64.F b/src/mathlib/gen/c/dbska64.F
deleted file mode 100644
index 5bce2ae..0000000
--- a/src/mathlib/gen/c/dbska64.F
+++ /dev/null
@@ -1,130 +0,0 @@
-*
-* $Id: dbska64.F,v 1.1.1.1 1996/04/01 15:02:08 mclareni Exp $
-*
-* $Log: dbska64.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:08 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- SUBROUTINE DBSKA(X,IA,JA,NL,B)
- IMPLICIT DOUBLE PRECISION (A-H,O-Z)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- SUBROUTINE BSKA(X,IA,JA,NL,B)
-#include "gen/imp64.inc"
-#endif
- LOGICAL LEX
-
- CHARACTER NAME*(*),ENAM*(*)
- CHARACTER*80 ERRTXT
- PARAMETER (NAME = 'BSKA/DBSKA', ENAM = 'EBSKA/DEBKA')
-
- PARAMETER (Z1 = 1, Z2 = 2, Z3 = 3, Z4 = 4)
- PARAMETER (Z12 = Z1/Z2, Z13 = Z1/Z3, Z14 = Z1/Z4, Z23 = Z2/Z3)
- PARAMETER (Z34 = Z3/Z4)
-
- DIMENSION B(0:*)
-
- PARAMETER (PI = 3.14159 26535 89793D0, PIV = PI/4)
-
- LEX=.FALSE.
- GO TO 9
-
-#if defined(CERNLIB_DOUBLE)
- ENTRY DEBKA(X,IA,JA,NL,B)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- ENTRY EBKA(X,IA,JA,NL,B)
-#endif
- LEX=.TRUE.
-
- 9 MODE=10*IA+JA
- N=NL-1
- U=2/X
- IF(LEX) THEN
- IF(X .LE. 0) THEN
- N=0
- WRITE(ERRTXT,101) X
- CALL MTLPRT(ENAM,'C341.1',ERRTXT)
- ELSEIF(NL .LT. 0 .OR. NL .GT. 100) THEN
- N=0
- WRITE(ERRTXT,103) NL
- CALL MTLPRT(ENAM,'C341.3',ERRTXT)
- ELSEIF(IA .EQ. 0) THEN
- A=0
- B(0)=DEBSK0(X)
- B(1)=DEBSK1(X)
- ELSEIF(MODE .EQ. 12) THEN
- A=Z12
- B(0)=SQRT(PIV*U)
- B(1)=B(0)*(1+A*U)
- ELSEIF(MODE .EQ. 13) THEN
- A=Z13
- B(0)=DEBKR3(X,1)
- B(1)=DEBKR3(X,2)+A*U*B(0)
- ELSEIF(MODE .EQ. 14) THEN
- A=Z14
- B(0)=DEBKR4(X,1)
- B(1)=DEBKR4(X,3)+A*U*B(0)
- ELSEIF(MODE .EQ. 23) THEN
- A=Z23
- B(0)=DEBKR3(X,2)
- B(1)=DEBKR3(X,1)+A*U*B(0)
- ELSEIF(MODE .EQ. 34) THEN
- A=Z34
- B(0)=DEBKR4(X,3)
- B(1)=DEBKR4(X,1)+A*U*B(0)
- ELSE
- N=0
- WRITE(ERRTXT,102) IA,JA
- CALL MTLPRT(ENAM,'C341.2',ERRTXT)
- ENDIF
- ELSE
- IF(X .LE. 0) THEN
- N=0
- WRITE(ERRTXT,101) X
- CALL MTLPRT(NAME,'C341.1',ERRTXT)
- ELSEIF(NL .LT. 0 .OR. NL .GT. 100) THEN
- N=0
- WRITE(ERRTXT,103) NL
- CALL MTLPRT(NAME,'C341.3',ERRTXT)
- ELSEIF(IA .EQ. 0) THEN
- A=0
- B(0)=DBESK0(X)
- B(1)=DBESK1(X)
- ELSEIF(MODE .EQ. 12) THEN
- A=Z12
- B(0)=EXP(-X)*SQRT(PIV*U)
- B(1)=B(0)*(1+A*U)
- ELSEIF(MODE .EQ. 13) THEN
- A=Z13
- B(0)=DBSKR3(X,1)
- B(1)=DBSKR3(X,2)+A*U*B(0)
- ELSEIF(MODE .EQ. 14) THEN
- A=Z14
- B(0)=DBSKR4(X,1)
- B(1)=DBSKR4(X,3)+A*U*B(0)
- ELSEIF(MODE .EQ. 23) THEN
- A=Z23
- B(0)=DBSKR3(X,2)
- B(1)=DBSKR3(X,1)+A*U*B(0)
- ELSEIF(MODE .EQ. 34) THEN
- A=Z34
- B(0)=DBSKR4(X,3)
- B(1)=DBSKR4(X,1)+A*U*B(0)
- ELSE
- N=0
- WRITE(ERRTXT,102) IA,JA
- CALL MTLPRT(NAME,'C341.2',ERRTXT)
- ENDIF
- ENDIF
- DO 1 J = 1,N
- A=A+1
- 1 B(J+1)=B(J-1)+A*U*B(J)
- RETURN
- 101 FORMAT('NON-POSITIVE ARGUMENT X = ',E15.6)
- 102 FORMAT('PAIR (IA,JA) = (',I5,I5,') ILLEGAL')
- 103 FORMAT('ILLEGAL NL =',I5)
- END
diff --git a/src/mathlib/gen/c/dclaus.F b/src/mathlib/gen/c/dclaus.F
deleted file mode 100644
index 80baab2..0000000
--- a/src/mathlib/gen/c/dclaus.F
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: dclaus.F,v 1.1.1.1 1996/04/01 15:02:03 mclareni Exp $
-*
-* $Log: dclaus.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:03 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION DCLAUS(X)
- CHARACTER*6 NAME
- NAME = 'DCLAUS'
- CALL MTLPRT(NAME,'C326',
- +'not available on this machine - see documentation')
- DCLAUS = 0.D0
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/c/dclaus64.F b/src/mathlib/gen/c/dclaus64.F
deleted file mode 100644
index 9dbd17d..0000000
--- a/src/mathlib/gen/c/dclaus64.F
+++ /dev/null
@@ -1,86 +0,0 @@
-*
-* $Id: dclaus64.F,v 1.2 1996/04/02 16:23:45 mclareni Exp $
-*
-* $Log: dclaus64.F,v $
-* Revision 1.2 1996/04/02 16:23:45 mclareni
-* More precise dclaus64 (C326), test added and C344 removed from TESTALL
-*
-* Revision 1.1.1.1 1996/04/01 15:02:03 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- FUNCTION DCLAUS(X)
- IMPLICIT DOUBLE PRECISION (A-H,O-Z)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION RCLAUS(X)
-#include "gen/imp64.inc"
-#endif
-
- DIMENSION A(0:8),B(0:13)
-
- PARAMETER (R1 = 1, HF =R1/2)
- PARAMETER (PI = 3.14159 26535 89793 24D0)
- PARAMETER (PI2 = 2*PI, PIH = PI/2, RPIH = 2/PI)
-
- DATA A( 0) / 0.02795 28319 73575 6613D0/
- DATA A( 1) / 0.00017 63088 74389 8116D0/
- DATA A( 2) / 0.00000 12662 74146 1157D0/
- DATA A( 3) / 0.00000 00117 17181 8134D0/
- DATA A( 4) / 0.00000 00001 23006 4129D0/
- DATA A( 5) / 0.00000 00000 01395 2729D0/
- DATA A( 6) / 0.00000 00000 00016 6908D0/
- DATA A( 7) / 0.00000 00000 00000 2076D0/
- DATA A( 8) / 0.00000 00000 00000 0027D0/
-
- DATA B( 0) / 0.63909 70888 57265 341D0/
- DATA B( 1) /-0.05498 05693 01851 716D0/
- DATA B( 2) /-0.00096 12619 45950 606D0/
- DATA B( 3) /-0.00003 20546 86822 550D0/
- DATA B( 4) /-0.00000 13294 61695 426D0/
- DATA B( 5) /-0.00000 00620 93601 824D0/
- DATA B( 6) /-0.00000 00031 29600 656D0/
- DATA B( 7) /-0.00000 00001 66351 954D0/
- DATA B( 8) /-0.00000 00000 09196 527D0/
- DATA B( 9) /-0.00000 00000 00524 004D0/
- DATA B(10) /-0.00000 00000 00030 580D0/
- DATA B(11) /-0.00000 00000 00001 820D0/
- DATA B(12) /-0.00000 00000 00000 110D0/
- DATA B(13) /-0.00000 00000 00000 007D0/
-
- V=MOD(ABS(X),PI2)
- S=SIGN(R1,X)
- IF(V .GT. PI) THEN
- V=PI2-V
- S=-S
- ENDIF
- IF(V .EQ. 0 .OR. V .EQ. PI) THEN
- H=0
- ELSEIF(V .LT. PIH) THEN
- U=RPIH*V
- H=2*U**2-1
- ALFA=H+H
- B1=0
- B2=0
- DO 1 I = 8,0,-1
- B0=A(I)+ALFA*B1-B2
- B2=B1
- 1 B1=B0
- H=V*(1-LOG(V)+HF*V**2*(B0-H*B2))
- ELSE
- U=RPIH*V-2
- H=2*U**2-1
- ALFA=H+H
- B1=0
- B2=0
- DO 2 I = 13,0,-1
- B0=B(I)+ALFA*B1-B2
- B2=B1
- 2 B1=B0
- H=(PI-V)*(B0-H*B2)
- ENDIF
- DCLAUS=S*H
- RETURN
- END
diff --git a/src/mathlib/gen/c/def128.inc b/src/mathlib/gen/c/def128.inc
deleted file mode 100644
index ff030c8..0000000
--- a/src/mathlib/gen/c/def128.inc
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: def128.inc,v 1.1.1.1 1996/04/01 15:02:12 mclareni Exp $
-*
-* $Log: def128.inc,v $
-* Revision 1.1.1.1 1996/04/01 15:02:12 mclareni
-* Mathlib gen
-*
-*
-*
-* def128.inc
-*
-#if (defined(CERNLIB_DOUBLE))&&(defined(CERNLIB_F90))
- REAL(4)
-#endif
-#if (!defined(CERNLIB_DOUBLE))&&(defined(CERNLIB_F90))
- REAL(2)
-#endif
-#if (!defined(CERNLIB_F90))&&(defined(CERNLIB_NOQUAD)||!defined(CERNLIB_DOUBLE))
- DOUBLE PRECISION
-#endif
- REAL*16
diff --git a/src/mathlib/gen/c/defc128.inc b/src/mathlib/gen/c/defc128.inc
deleted file mode 100644
index 00bfccf..0000000
--- a/src/mathlib/gen/c/defc128.inc
+++ /dev/null
@@ -1,14 +0,0 @@
-*
-* $Id: defc128.inc,v 1.1.1.1 1996/04/01 15:02:12 mclareni Exp $
-*
-* $Log: defc128.inc,v $
-* Revision 1.1.1.1 1996/04/01 15:02:12 mclareni
-* Mathlib gen
-*
-*
-*
-* defc128.inc
-*
-#if defined(CERNLIB_DOUBLE)
- COMPLEX*32
-#endif
diff --git a/src/mathlib/gen/c/defdr.inc b/src/mathlib/gen/c/defdr.inc
deleted file mode 100644
index 62c646f..0000000
--- a/src/mathlib/gen/c/defdr.inc
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: defdr.inc,v 1.1.1.1 1996/04/01 15:02:12 mclareni Exp $
-*
-* $Log: defdr.inc,v $
-* Revision 1.1.1.1 1996/04/01 15:02:12 mclareni
-* Mathlib gen
-*
-*
-*
-* defdr.inc
-*
-#if (defined(CERNLIB_QF2C))&&(!defined(CERNLIB_LINUX))
- DOUBLE PRECISION DREAL,DIMAG,DCONJG,DCMPLX
- EXTERNAL DREAL,DIMAG,DCONJG,DCMPLX
-#endif
-#if (defined(CERNLIB_QF2C))&&(defined(CERNLIB_LINUX))
- DOUBLE PRECISION DREAL
- EXTERNAL DREAL
-#endif
diff --git a/src/mathlib/gen/c/deli1128.F b/src/mathlib/gen/c/deli1128.F
deleted file mode 100644
index 62f714c..0000000
--- a/src/mathlib/gen/c/deli1128.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: deli1128.F,v 1.1.1.1 1996/04/01 15:02:10 mclareni Exp $
-*
-* $Log: deli1128.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:10 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION DELI1(X,AKP)
-C
-#include "gen/imp128.inc"
- DELI1=0
- CALL MTLPRT('DELI1','C346.0','Not available on this machine')
- RETURN
-
- ENTRY DELI2(X,AKP,A,B,MODE)
- DELI2=0
- CALL MTLPRT('DELI2','C346.0','Not available on this machine')
- RETURN
-
- ENTRY DELI3(X,AKP,P)
- DELI3=0
- CALL MTLPRT('DELI3','C346.0','Not available on this machine')
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/c/dilog.F b/src/mathlib/gen/c/dilog.F
deleted file mode 100644
index 9c40053..0000000
--- a/src/mathlib/gen/c/dilog.F
+++ /dev/null
@@ -1,14 +0,0 @@
-*
-* $Id: dilog.F,v 1.1.1.1 1996/04/01 15:02:04 mclareni Exp $
-*
-* $Log: dilog.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:04 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION DILOG(X)
- DILOG = RDILOG(X)
- END
-#endif
diff --git a/src/mathlib/gen/c/dilog128.F b/src/mathlib/gen/c/dilog128.F
deleted file mode 100644
index 5da007c..0000000
--- a/src/mathlib/gen/c/dilog128.F
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: dilog128.F,v 1.1.1.1 1996/04/01 15:02:04 mclareni Exp $
-*
-* $Log: dilog128.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:04 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if !defined(CERNLIB_DOUBLE)
- SUBROUTINE DDILOG(X)
-C
-#include "gen/imp128.inc"
-C
- CHARACTER NAME*(*)
- PARAMETER (NAME = 'DDILOG')
- CALL MTLPRT(NAME,'C304.0','Not available on this machine')
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/c/dilog64.F b/src/mathlib/gen/c/dilog64.F
deleted file mode 100644
index 8534ccb..0000000
--- a/src/mathlib/gen/c/dilog64.F
+++ /dev/null
@@ -1,94 +0,0 @@
-*
-* $Id: dilog64.F,v 1.1.1.1 1996/04/01 15:02:05 mclareni Exp $
-*
-* $Log: dilog64.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:05 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- FUNCTION DDILOG(X)
-#include "gen/imp64.inc"
-#endif
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION RDILOG(X)
-#endif
- DIMENSION C(0:19)
-
- PARAMETER (Z1 = 1, HF = Z1/2)
- PARAMETER (PI = 3.14159 26535 89793 24D0)
- PARAMETER (PI3 = PI**2/3, PI6 = PI**2/6, PI12 = PI**2/12)
-
- DATA C( 0) / 0.42996 69356 08136 97D0/
- DATA C( 1) / 0.40975 98753 30771 05D0/
- DATA C( 2) /-0.01858 84366 50145 92D0/
- DATA C( 3) / 0.00145 75108 40622 68D0/
- DATA C( 4) /-0.00014 30418 44423 40D0/
- DATA C( 5) / 0.00001 58841 55418 80D0/
- DATA C( 6) /-0.00000 19078 49593 87D0/
- DATA C( 7) / 0.00000 02419 51808 54D0/
- DATA C( 8) /-0.00000 00319 33412 74D0/
- DATA C( 9) / 0.00000 00043 45450 63D0/
- DATA C(10) /-0.00000 00006 05784 80D0/
- DATA C(11) / 0.00000 00000 86120 98D0/
- DATA C(12) /-0.00000 00000 12443 32D0/
- DATA C(13) / 0.00000 00000 01822 56D0/
- DATA C(14) /-0.00000 00000 00270 07D0/
- DATA C(15) / 0.00000 00000 00040 42D0/
- DATA C(16) /-0.00000 00000 00006 10D0/
- DATA C(17) / 0.00000 00000 00000 93D0/
- DATA C(18) /-0.00000 00000 00000 14D0/
- DATA C(19) /+0.00000 00000 00000 02D0/
-
- IF(X .EQ. 1) THEN
- H=PI6
- ELSEIF(X .EQ. -1) THEN
- H=-PI12
- ELSE
- T=-X
- IF(T .LE. -2) THEN
- Y=-1/(1+T)
- S=1
- A=-PI3+HF*(LOG(-T)**2-LOG(1+1/T)**2)
- ELSEIF(T .LT. -1) THEN
- Y=-1-T
- S=-1
- A=LOG(-T)
- A=-PI6+A*(A+LOG(1+1/T))
- ELSE IF(T .LE. -HF) THEN
- Y=-(1+T)/T
- S=1
- A=LOG(-T)
- A=-PI6+A*(-HF*A+LOG(1+T))
- ELSE IF(T .LT. 0) THEN
- Y=-T/(1+T)
- S=-1
- A=HF*LOG(1+T)**2
- ELSE IF(T .LE. 1) THEN
- Y=T
- S=1
- A=0
- ELSE
- Y=1/T
- S=-1
- A=PI6+HF*LOG(T)**2
- ENDIF
- H=Y+Y-1
- ALFA=H+H
- B1=0
- B2=0
- DO 1 I = 19,0,-1
- B0=C(I)+ALFA*B1-B2
- B2=B1
- 1 B1=B0
- H=-(S*(B0-H*B2)+A)
- ENDIF
-#if defined(CERNLIB_DOUBLE)
- DDILOG=H
-#endif
-#if !defined(CERNLIB_DOUBLE)
- DILOG=H
-#endif
- RETURN
- END
diff --git a/src/mathlib/gen/c/dlogam.F b/src/mathlib/gen/c/dlogam.F
deleted file mode 100644
index b252576..0000000
--- a/src/mathlib/gen/c/dlogam.F
+++ /dev/null
@@ -1,15 +0,0 @@
-*
-* $Id: dlogam.F,v 1.1.1.1 1996/04/01 15:01:55 mclareni Exp $
-*
-* $Log: dlogam.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:55 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_IBM)
- FUNCTION DLOGAM(X)
-#include "gen/imp64.inc"
- DLOGAM = DLGAMA(X)
- END
-#endif
diff --git a/src/mathlib/gen/c/dpsipg128.F b/src/mathlib/gen/c/dpsipg128.F
deleted file mode 100644
index 93ad9f1..0000000
--- a/src/mathlib/gen/c/dpsipg128.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: dpsipg128.F,v 1.1.1.1 1996/04/01 15:02:00 mclareni Exp $
-*
-* $Log: dpsipg128.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:00 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION DPSIPG(X,K)
-C
-#include "gen/imp128.inc"
- CHARACTER*(*) NAME
- PARAMETER(NAME='DPSIPG')
-C
- DPSIPG=0
- CALL MTLPRT(NAME,'C316.0','Not available on this machine')
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/c/elfun64.F b/src/mathlib/gen/c/elfun64.F
deleted file mode 100644
index c4a5885..0000000
--- a/src/mathlib/gen/c/elfun64.F
+++ /dev/null
@@ -1,126 +0,0 @@
-*
-* $Id: elfun64.F,v 1.1.1.1 1996/04/01 15:02:01 mclareni Exp $
-*
-* $Log: elfun64.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:01 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- SUBROUTINE DELFUN(U,AK2,SN,CN,DN)
-#include "gen/imp64.inc"
-#endif
-#if defined(CERNLIB_SINGLE)
- SUBROUTINE RELFUN(U,AK2,SN,CN,DN)
-#endif
- DIMENSION C(4)
-
-C Machine-dependent: EPS1=2**-(MB/2), EPS2=2**-(MB+3)
-C Where M = Number of bits in mantissa
-
- PARAMETER (MB = 64)
- PARAMETER (Z0 = 0, Z1 = 1, Z2 = 2, HF = Z1/2, QU = Z1/4)
- PARAMETER (PI = 3.14159 26535 89793 24D0, PIH = PI/2)
- PARAMETER (EPS1 = Z2**(-MB/2), EPS2 = Z2**(-(MB+3)))
-
- DATA AM0 /-1D20/
-
- SAVE AM0,C,A,L,BIGK
-
-#if defined(CERNLIB_SINGLE)
- ENTRY ELFUN(U,AK2,SN,CN,DN)
-#endif
-
- XM=ABS(AK2)
- IF(U .EQ. 0) THEN
- SN=0
- DN=1
- CN=1
- ELSEIF(XM .EQ. 0) THEN
- SN=SIN(U)
- DN=1
- CN=COS(U)
- ELSEIF(XM .EQ. 1) THEN
- SN=TANH(U)
- DN=1/COSH(U)
- CN=DN
- ELSE
- IF(XM .LE. 1) THEN
- U1=U
- AM=XM
- ELSE
- W=SQRT(XM)
- U1=W*U
- AM=1/XM
- ENDIF
- IF(AM .LE. HF) THEN
- IF(AM .EQ. AM0) GO TO 1
- AM0=AM
- C(4)=QU*AM
- B=SQRT(1-AM)
- ELSE
- AMC=1-AM
- IF(AMC .EQ. AM0) GO TO 1
- AM0=AMC
- C(4)=QU*AMC
- B=SQRT(AM)
- ENDIF
-
-C Gauss arithmetic-geometric mean. Skipped if previous modulus.
-
- A=1
- L=4
- 2 IF(C(L) .GE. EPS1) THEN
- L=L-1
- C(L)=(QU*(A-B))**2
- A1=HF*(A+B)
- B=SQRT(A*B)
- A=A1
- GO TO 2
- ENDIF
- A=HF*(A+B)
- BIGK=PIH/A
-
-C Descending Landen-Gauss transformation for real argument
-
- 1 IF(AM .LE. HF) THEN
- X=SIN(A*U1)
- IF(X .EQ. 0) THEN
- SN=0
- DN=1
- CN=1
- ELSE
- X=A/X
- DO 3 J = L,4
- X1=C(J)/X
- 3 X=X1+X
- H=1/X
- SN=H
- DN=1-2*X1*H
- CN=SIGN(SQRT(ABS(1-H**2)),BIGK-ABS(U1))
- ENDIF
- ELSE
-
-C Descending Landen-Gauss Transformation for imaginary argument
-
- Y=A/SINH(A*U1)
- DO 4 J=L,4
- Y1=C(J)/Y
- Y=Y-Y1
- 4 IF(Y .EQ. 0) Y=EPS2
- H=1/Y
- Y1=2*Y1*H
- CN=SIGN(SQRT(Y/(H+Y)),Y1)
- DN=CN*(1+Y1)
- SN=CN*H
- ENDIF
- IF(XM .GT. 1) THEN
- SN=SN/W
- H=DN
- DN=CN
- CN=H
- ENDIF
- ENDIF
- RETURN
- END
diff --git a/src/mathlib/gen/c/erf.F b/src/mathlib/gen/c/erf.F
deleted file mode 100644
index 91eddd4..0000000
--- a/src/mathlib/gen/c/erf.F
+++ /dev/null
@@ -1,80 +0,0 @@
-*
-* $Id: erf.F,v 1.2 1997/07/01 15:31:41 mclareni Exp $
-*
-* $Log: erf.F,v $
-* Revision 1.2 1997/07/01 15:31:41 mclareni
-* Correction for FP exceptions and restriction of calculations to realistic values, from M. Schroder
-*
-* Revision 1.1.1.1 1996/04/01 15:01:53 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- FUNCTION ERF(X)
-
- LOGICAL LEF
- DIMENSION P2(0:4),Q2(0:4)
-
- PARAMETER(Z1 = 1, HF = Z1/2, C1 = 0.56418 958)
-
-C Above the value of VMAX any calculation is pointless. The value is
-C choosen with a big safety margin - even the double precision
-C version only returns 1. for V (=ABS(X)) >= 5.9
- PARAMETER(VMAX = 7.)
-C The value for SWITCH is badly chosen for the single precision
-C version, which returns 1. already for V >= 3.9
- PARAMETER(SWITCH = 4.)
-
- DATA P10,Q10,P11 /+3.67678 77, +3.25845 93, -9.79704 65E-2/
-
- DATA (P2(I),Q2(I),I=0,4)
- +/+7.37388 83E+0, +7.37396 09E+0, +6.86501 85E+0, +1.51849 08E+1,
- 1 +3.03179 93E+0, +1.27955 30E+1, +5.63169 62E-1, +5.35421 68E+0,
- 2 +4.31877 87E-5, +1/
-
- DATA P30,Q30,P31 /-1.24368 54E-1, +4.40917 06E-1, -9.68210 36E-2/
-
- LEF=.TRUE.
- GO TO 9
-
- ENTRY ERFC(X)
- LEF=.FALSE.
-
- 9 V=ABS(X)
- IF(V .LT. HF) THEN
- Y=V**2
- H=X*(P10+P11*Y)/(Q10+Y)
- HC=1-H
- ELSE
- IF(V .LT. SWITCH) THEN
- AP=P2(4)
- AQ=Q2(4)
- DO 2 I = 3,0,-1
- AP=P2(I)+V*AP
- 2 AQ=Q2(I)+V*AQ
- HC=EXP(-V**2)*AP/AQ
- H=1-HC
- ELSEIF ( V .LT. VMAX) THEN
- Y=1/V**2
- HC=EXP(-V**2)*(C1+Y*(P30+P31*Y)/(Q30+Y))/V
- H=1-HC
-C for very big values we can save us any calculation, and the
-C FP-exceptions we would get from EXP.
- ELSE
- H = 1.
- HC = 0.
- ENDIF
- IF(X .LT. 0) THEN
- H=-H
- HC=2-HC
- ENDIF
- ENDIF
- IF(LEF) THEN
- ERF=H
- ELSE
- ERFC=HC
- ENDIF
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/c/erf128.F b/src/mathlib/gen/c/erf128.F
deleted file mode 100644
index 6fcfbbd..0000000
--- a/src/mathlib/gen/c/erf128.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: erf128.F,v 1.1.1.1 1996/04/01 15:01:53 mclareni Exp $
-*
-* $Log: erf128.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:53 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION DERF(X)
-C
-#include "gen/imp128.inc"
- CHARACTER*(*) NAME1,NAME2
- PARAMETER(NAME1='DERF')
- PARAMETER(NAME2='DERFC')
- DERF=0
- CALL MTLPRT(NAME,'C300.0','Not available on this machine')
-C
- ENTRY DERFC(X)
- DERFC=0
-C
- CALL MTLPRT(NAME,'C300.0','Not available on this machine')
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/c/erf64.F b/src/mathlib/gen/c/erf64.F
deleted file mode 100644
index 1202456..0000000
--- a/src/mathlib/gen/c/erf64.F
+++ /dev/null
@@ -1,111 +0,0 @@
-*
-* $Id: erf64.F,v 1.1.1.1 1996/04/01 15:01:53 mclareni Exp $
-*
-* $Log: erf64.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:53 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- FUNCTION DERF(X)
-C
-#include "gen/imp64.inc"
-C
- CHARACTER*(*) NAME
- PARAMETER(NAME='DERF')
-#endif
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION ERF(X)
-C
- CHARACTER*(*) NAME
- PARAMETER(NAME='ERF')
-#endif
-C
- LOGICAL LEF
- DIMENSION P1(0:3),Q1(0:3),P2(0:7),Q2(0:7),P3(0:4),Q3(0:4)
-
- PARAMETER(Z1 = 1, HF = Z1/2, C1 = 0.56418 95835 47756 29D0)
-
- DATA (P1(I),Q1(I),I=0,3)
- +/+2.42667 95523 05317 5D+2, +2.15058 87586 98612 0D+2,
- 1 +2.19792 61618 29415 2D+1, +9.11649 05404 51490 1D+1,
- 2 +6.99638 34886 19135 5D+0, +1.50827 97630 40778 7D+1,
- 3 -3.56098 43701 81538 5D-2, +1/
-
- DATA (P2(I),Q2(I),I=0,7)
- +/+3.00459 26102 01616 01D+2, +3.00459 26095 69832 93D+2,
- 1 +4.51918 95371 18729 42D+2, +7.90950 92532 78980 27D+2,
- 2 +3.39320 81673 43436 87D+2, +9.31354 09485 06096 21D+2,
- 3 +1.52989 28504 69404 04D+2, +6.38980 26446 56311 67D+2,
- 4 +4.31622 27222 05673 53D+1, +2.77585 44474 39876 43D+2,
- 5 +7.21175 82508 83093 66D+0, +7.70001 52935 22947 30D+1,
- 6 +5.64195 51747 89739 71D-1, +1.27827 27319 62942 35D+1,
- 7 -1.36864 85738 27167 07D-7, +1/
-
- DATA (P3(I),Q3(I),I=0,4)
- +/-2.99610 70770 35421 74D-3, +1.06209 23052 84679 18D-2,
- 1 -4.94730 91062 32507 34D-2, +1.91308 92610 78298 41D-1,
- 2 -2.26956 59353 96869 30D-1, +1.05167 51070 67932 07D+0,
- 3 -2.78661 30860 96477 88D-1, +1.98733 20181 71352 56D+0,
- 4 -2.23192 45973 41846 86D-2, +1/
-
- LEF=.TRUE.
- GO TO 9
-
-#if defined(CERNLIB_DOUBLE)
- ENTRY DERFC(X)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- ENTRY ERFC(X)
-#endif
- LEF=.FALSE.
-
- 9 V=ABS(X)
- IF(V .LT. HF) THEN
- Y=V**2
- AP=P1(3)
- AQ=Q1(3)
- DO 1 I = 2,0,-1
- AP=P1(I)+Y*AP
- 1 AQ=Q1(I)+Y*AQ
- H=X*AP/AQ
- HC=1-H
- ELSE
- IF(V .LT. 4) THEN
- AP=P2(7)
- AQ=Q2(7)
- DO 2 I = 6,0,-1
- AP=P2(I)+V*AP
- 2 AQ=Q2(I)+V*AQ
- HC=EXP(-V**2)*AP/AQ
- H=1-HC
- ELSE
- Y=1/V**2
- AP=P3(4)
- AQ=Q3(4)
- DO 3 I = 3,0,-1
- AP=P3(I)+Y*AP
- 3 AQ=Q3(I)+Y*AQ
- HC=EXP(-V**2)*(C1+Y*AP/AQ)/V
- H=1-HC
- ENDIF
- IF(X .LT. 0) THEN
- H=-H
- HC=2-HC
- ENDIF
- ENDIF
- IF(LEF) THEN
-#if defined(CERNLIB_DOUBLE)
- DERF=H
- ELSE
- DERFC=HC
-#endif
-#if !defined(CERNLIB_DOUBLE)
- ERF=H
- ELSE
- ERFC=HC
-#endif
- ENDIF
- RETURN
- END
diff --git a/src/mathlib/gen/c/fconc128.F b/src/mathlib/gen/c/fconc128.F
deleted file mode 100644
index 75f8ca3..0000000
--- a/src/mathlib/gen/c/fconc128.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: fconc128.F,v 1.1.1.1 1996/04/01 15:02:04 mclareni Exp $
-*
-* $Log: fconc128.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:04 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION DFCONC(X,TAU,M)
-#include "gen/imp128.inc"
-#if (!defined(CERNLIB_F90))&&(!defined(CERNLIB_DOUBLE))
- COMPLEX*16 WGAMMA,WLOGAM
-#endif
-#if (defined(CERNLIB_F90))&&(!defined(CERNLIB_DOUBLE))
- COMPLEX(2) WGAMMA,WLOGAM
-#endif
-#if !defined(CERNLIB_DOUBLE)
-C
- CHARACTER*(*) NAME
- PARAMETER( NAME='DFCONC')
- DFCONC=0
- CALL MTLPRT(NAME,'C331.0','Not available on this machine')
- RETURN
- END
-#endif
-#endif
diff --git a/src/mathlib/gen/c/fconc64.F b/src/mathlib/gen/c/fconc64.F
deleted file mode 100644
index a144800..0000000
--- a/src/mathlib/gen/c/fconc64.F
+++ /dev/null
@@ -1,323 +0,0 @@
-*
-* $Id: fconc64.F,v 1.1.1.1 1996/04/01 15:02:04 mclareni Exp $
-*
-* $Log: fconc64.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:04 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION RFCONC(X,TAU,M)
-#include "gen/defc64.inc"
- + CGAMMA,CLOGAM
-#endif
-#if defined(CERNLIB_DOUBLE)
- FUNCTION DFCONC(X,TAU,M)
-#include "gen/imp64.inc"
-#include "gen/defc64.inc"
- + WGAMMA,WLOGAM
-#endif
-C
-C Computes the (real) Conical Function of the first kind
-C P M (-1/2 + I*TAU) (X)
-C for M = 0 and M = 1. P m nu (x) is the Legendre function of
-C the first kind.
-C Based on K.S. Koelbig, A program for computing the conical
-C functions of the first kind P ... for m = 0 and m = 1,
-C Computer Phys. Comm. 23 (1981) 51-61.
-C
-#include "gen/defc64.inc"
- + CGM,CLG,CRG,I,A,B,C,TI,R,RR,U(0:3),V(0:3),W(19)
- LOGICAL LM0,LM1,LTA
- CHARACTER NAME*(*)
- CHARACTER*80 ERRTXT
-#if !defined(CERNLIB_DOUBLE)
- PARAMETER (NAME = 'RFCONC')
-#endif
-#if defined(CERNLIB_DOUBLE)
- PARAMETER (NAME = 'RFCONC/DFCONC')
-#endif
- DIMENSION T(7),H(9),S(5),P(11),D(-1:6)
-
-
- PARAMETER (PI = 3.14159 26535 89793 24D+0)
- PARAMETER (RPI = 1.77245 38509 05516 03D+0)
- PARAMETER (I = (0,1))
- PARAMETER (Z1 = 1, HF = Z1/2, TH = 1+HF, C1 = Z1/10, C2 = Z1/5)
- PARAMETER (RPH = 2/PI, RPW = 2/RPI, TW = 20, NMAX = 200)
-
- DATA EPS /1D-14/
-
-#if !defined(CERNLIB_DOUBLE)
- ENTRY FCONC(X,TAU,M)
-#endif
-
-#if defined(CERNLIB_DOUBLE)
- FEK(ARG)=DELIKC(ARG)
- FEE(ARG)=DELIEC(ARG)
- FJ0(ARG)=DBESJ0(ARG)
- FJ1(ARG)=DBESJ1(ARG)
- FI0(ARG)=DBESI0(ARG)
- FI1(ARG)=DBESI1(ARG)
- CGM(CRG)=WGAMMA(CRG)
- CLG(CRG)=WLOGAM(CRG)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- FEK(ARG)=RELIKC(ARG)
- FEE(ARG)=RELIEC(ARG)
- FJ0(ARG)= BESJ0(ARG)
- FJ1(ARG)= BESJ1(ARG)
- FI0(ARG)= BESI0(ARG)
- FI1(ARG)= BESI1(ARG)
- CGM(CRG)=CGAMMA(CRG)
- CLG(CRG)=CLOGAM(CRG)
-#endif
- LM0=M .EQ. 0
- LM1=M .EQ. 1
- IF(X .LE. -1 .OR. TAU .LT. 0 .OR. .NOT.(LM0 .OR. LM1)) THEN
- FC=0
- WRITE(ERRTXT,101) X,TAU,M
- CALL MTLPRT(NAME,'C331.1',ERRTXT)
- GO TO 99
- END IF
- FC=1-M
- IF(X .EQ. 1) GO TO 99
-
- IF(TAU .EQ. 0) THEN
- IF(X .LT. 1) THEN
- Y=SQRT(HF*(1-X))
- IF(LM0) THEN
- FC=RPH*FEK(Y)
- ELSE
- FC=RPH*(FEE(Y)-HF*(1+X)*FEK(Y))/SQRT(1-X**2)
- END IF
- ELSE
- Y=SQRT((X-1)/(X+1))
- IF(LM0) THEN
- FC=RPH*FEK(Y)/SQRT(HF*(X+1))
- ELSE
- FC=RPH*SQRT(HF/(X-1))*(FEE(Y)-FEK(Y))
- END IF
- END IF
- GO TO 99
- END IF
-
- TI=I*TAU
- FM=M
- IF(-1 .LT. X .AND. X .LE. 0) GO TO 11
- IF(0 .LT. X .AND. X .LE. C1 .AND. TAU .LE. 17) GO TO 11
- IF(C1 .LT. X .AND. X .LE. C2 .AND. TAU .LE. 5) GO TO 11
- IF(C1 .LT. X .AND. X .LE. C2 .AND. TAU .LE. 17) GO TO 12
- IF(C2 .LT. X .AND. X .LE. TH .AND. TAU .LE. 20) GO TO 12
- IF(TH .LT. X .AND. TAU .LE. MAX(TW,X)) GO TO 13
-
- IF(X .LT. 1) THEN
- Y=SQRT(1-X**2)
- T(1)=ACOS(X)
- H(1)=TAU*T(1)
- B0=FI0(H(1))
- B1=FI1(H(1))
- Z=-1
- ELSE
- Y=SQRT(X**2-1)
- T(1)=LOG(X+Y)
- H(1)=TAU*T(1)
- B0=FJ0(H(1))
- B1=FJ1(H(1))
- Z=1
- END IF
- H(1)=T(1)*X/Y
- P(1)=1/TAU
- S(1)=1/T(1)
- DO 5 J = 2,7
- T(J)=T(J-1)*T(1)
- 5 H(J)=H(J-1)*H(1)
- DO 6 J = 2,11
- 6 P(J)=P(J-1)*P(1)
- DO 7 J = 2,5
- 7 S(J)=S(J-1)*S(1)
-C
- IF(LM0) THEN
- D(-1)=0
- D(0)=1
- D(1)=(H(1)-1)/(8*T(1))
- D(2)=(9*H(2)+6*H(1)-15-Z*8*T(2))/(128*T(2))
- D(3)=5*(15*H(3)+27*H(2)+21*H(1)-63-Z*T(2)*(16*H(1)+24))/
- 1 (1024*T(3))
- D(4)=7*(525*H(4)+1500*H(3)+2430*H(2)+1980*H(1)-6435
- 1 +192*T(4)-Z*T(2)*(720*H(2)+1600*H(1)+2160))/(32768*T(4))
- D(5)=21*(2835*H(5)+11025*H(4)+24750*H(3)+38610*H(2)
- 1 +32175*H(1)-109395+T(4)*(1984*H(1)+4032)
- 2 -Z*T(2)*(4800*H(3)+15120*H(2)+26400*H(1)+34320))/
- 3 (262144*T(5))
- D(6)=11*(218295*H(6)+1071630*H(5)+3009825*H(4)+6142500*
- 1 H(3)+9398025*H(2)+7936110*H(1)-27776385+T(4)*(254016*H(2)
- 2 +749952*H(1)+1100736)-Z*T(2)*(441000*H(4)+1814400*H(3)
- 3 +4127760*H(2)+6552000*H(1)+8353800+31232*T(4)))/
- 4 (4194304*T(6))
- ELSE
- D(-1)=-1
- D(0)=3*(1-H(1))/(8*T(1))
- D(1)=(-15*H(2)+6*H(1)+9+Z*8*T(2))/(128*T(2))
- D(2)=3*(-35*H(3)-15*H(2)+15*H(1)+35+Z*T(2)*(32*H(1)+8))/
- 1 (1024*T(3))
- D(3)=(-4725*H(4)-6300*H(3)-3150*H(2)+3780*H(1)+10395
- 1 -1216*T(4)+Z*T(2)*(6000*H(2)+5760*H(1)+1680))/(32768*T(4))
- D(4)=7*(-10395*H(5)-23625*H(4)-28350*H(3)-14850*H(2)
- 1 +19305*H(1)+57915-T(4)*(6336*H(1)+6080)+Z*T(2)*
- 2 (16800*H(3)+30000*H(2)+25920*H(1)+7920))/(262144*T(5))
- D(5)=(-2837835*H(6)-9168390*H(5)-16372125*H(4)-18918900*H(3)
- 1 -10135125*H(2)+13783770*H(1)+43648605-T(4)*(3044160*H(2)
- 2 +5588352*H(1)+4213440)+Z*T(2)*(5556600*H(4)+14817600*H(3)
- 3 +20790000*H(2)+17297280*H(1)+5405400+323072*T(4)))/
- 4 (4194304*T(6))
- D(6)=0
- END IF
- S0=D(0)+(-4*D(3)*S(1)+D(4))*P(4)+
- 1 (-192*D(5)*S(3)+144*D(6)*S(2))*P(8)
- 2 +Z*(-D(2)*P(2)+(-24*D(4)*S(2)+12*D(5)*S(1)-D(6))*P(6)
- 3 +(-1920*D(6)*S(4))*P(10))
- S1=D(1)*P(1)+(8*(D(3)*S(2)-D(4)*S(1))+D(5))*P(5)
- 1 +(384*D(5)*S(4)-768*D(6)*S(3))*P(9)
- 2 +Z*(D(-1)*TAU+(2*D(2)*S(1)-D(3))*P(3)+(48*D(4)*S(3)
- 3 -72*D(5)*S(2)+18*D(6)*S(1))*P(7)+(3840*D(6)*S(5))*P(11))
- FC=SQRT(T(1)/Y)*(B0*S0+B1*S1)
- GO TO 99
-
- 11 LTA=TAU .LE. 10
- X1=X**2
- A=HF*((HF-FM)-TI)
- B=HF*((HF-FM)+TI)
- C=HF
- ASSIGN 1 TO JP
- GO TO 20
- 1 R1=R
- R1=R1/ABS(CGM(A+HF))**2
- A=HF*((TH-FM)-TI)
- B=HF*((TH-FM)+TI)
- C=TH
- ASSIGN 2 TO JP
- GO TO 20
- 2 R2=R
- FC=RPI*(R1-2*X*R2/ABS(CGM(A-HF))**2)
- IF(LM1) FC=2*FC/SQRT(1-X1)
- GO TO 99
-
- 12 LTA=X .GT. 1 .OR. X .LE. 1 .AND. TAU .LE. 5
- X1=HF*(1-X)
- A=(HF+FM)-TI
- B=(HF+FM)+TI
- C=FM+1
- ASSIGN 3 TO JP
- GO TO 20
- 3 FC=R
- IF(LM1) FC=SIGN(HF,1-X)*(TAU**2+HF**2)*SQRT(ABS(X**2-1))*FC
- GO TO 99
-
- 13 LTA=.TRUE.
- X1=1/X**2
- A=HF*((HF-FM)-TI)
- B=HF*((TH-FM)-TI)
- C=1-TI
- ASSIGN 4 TO JP
- GO TO 20
- 4 R1=EXP((TI-HF)*LOG(X+X)+CLG(1+TI)-CLG((TH-FM)+TI))*
- 1 R*((HF-FM)+TI)/TI
- FC=RPW*R1
- IF(LM1) FC=FC/SQRT(1-X1)
- GO TO 99
-
- 20 IF(LTA) THEN
- Y=-X1
- Y2=Y**2
- Y3=Y*Y2
- W(1)=A+1
- W(2)=A+2
- W(3)=B+1
- W(4)=B+2
- W(5)=C+1
- W(6)=C*W(5)
- W(7)=A+B
- W(8)=A*B
- W(9)=(W(8)/C)*Y
- W(10)=W(1)*W(3)
- W(11)=W(2)*W(4)
- W(12)=1+(W(11)/(W(5)+W(5)))*Y
- W(13)=W(7)-6
- W(14)=W(7)+6
- W(15)=2-W(8)
- W(16)=W(15)-W(7)-W(7)
-
- V(0)=1
- V(1)=1+(W(10)/(C+C))*Y
- V(2)=W(12)+(W(10)*W(11)/(12*W(6)))*Y2
- U(0)=1
- U(1)=V(1)-W(9)
- U(2)=V(2)-W(9)*W(12)+(W(8)*W(10)/(W(6)+W(6)))*Y2
-
- R=1
- DO 21 N = 3,NMAX
- FN=N
- RR=R
- H(1)=FN-1
- H(2)=FN-2
- H(3)=FN-3
- H(4)=FN+FN
- H(5)=H(4)-3
- H(6)=H(5)+H(5)
- H(7)=4*(H(4)-1)*H(5)
- H(8)=8*H(5)**2*(H(4)-5)
- H(9)=3*FN**2
- W(1)=A+H(1)
- W(2)=A+H(2)
- W(3)=B+H(1)
- W(4)=B+H(2)
- W(5)=C+H(1)
- W(6)=C+H(2)
- W(7)=C+H(3)
- W(8)=H(2)-A
- W(9)=H(2)-B
- W(10)=H(1)-C
- W(11)=W(1)*W(3)
- W(12)=W(5)*W(6)
-
- W(17)=1+((H(9)+W(13)*FN+W(16))/(H(6)*W(5)))*Y
- W(18)=-((W(11)*W(10)/H(6)+(H(9)-W(14)*FN+W(15))*W(11)*Y/H(7))/
- 1 W(12))*Y
- W(19)=(W(2)*W(11)*W(4)*W(8)*W(9)/(H(8)*W(7)*W(12)))*Y3
- V(3)=W(17)*V(2)+W(18)*V(1)+W(19)*V(0)
- U(3)=W(17)*U(2)+W(18)*U(1)+W(19)*U(0)
- R=U(3)/V(3)
- IF(ABS(R-RR) .LT. EPS) GO TO JP, (1,2,3,4)
- DO 22 J = 1,3
- V(J-1)=V(J)
- 22 U(J-1)=U(J)
- 21 CONTINUE
- ELSE
- W(1)=X1*A*B/C
- R=1+W(1)
- DO 23 N = 1,NMAX
- FN=N
- RR=R
- W(1)=W(1)*X1*(A+FN)*(B+FN)/((C+FN)*(FN+1))
- R=R+W(1)
- IF(ABS(R-RR) .LT. EPS) GO TO JP, (1,2,3,4)
- 23 CONTINUE
- END IF
- FC=0
- WRITE(ERRTXT,102) X
- CALL MTLPRT(NAME,'C331.2',ERRTXT)
-#if defined(CERNLIB_DOUBLE)
- 99 DFCONC=FC
-#endif
-#if !defined(CERNLIB_DOUBLE)
- 99 RFCONC=FC
-#endif
- RETURN
-
- 101 FORMAT('ILLEGAL ARGUMENT(S) X = ',D15.8,' TAU = ',D15.8,
- 1 ' M = ',I3)
- 102 FORMAT('CONVERGENCE PROBLEM FOR HYPERGEOMETRIC FUNCTION, X = ',
- 1 D15.8)
- END
diff --git a/src/mathlib/gen/c/ferdr128.F b/src/mathlib/gen/c/ferdr128.F
deleted file mode 100644
index 26a0b4c..0000000
--- a/src/mathlib/gen/c/ferdr128.F
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: ferdr128.F,v 1.1.1.1 1996/04/01 15:02:02 mclareni Exp $
-*
-* $Log: ferdr128.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:02 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION DFERDR(X,K)
-#include "gen/imp128.inc"
- CHARACTER*(*) NAME
- PARAMETER( NAME ='DFERDR')
- DFERDR=0
- CALL MTLPRT(NAME1,'C323.0','Not available on this machine')
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/c/ferfr.F b/src/mathlib/gen/c/ferfr.F
deleted file mode 100644
index 6510f4e..0000000
--- a/src/mathlib/gen/c/ferfr.F
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: ferfr.F,v 1.1.1.1 1996/04/01 15:02:02 mclareni Exp $
-*
-* $Log: ferfr.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:02 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION FERDR(X,K)
- SROUND(D)=D+(D-SNGL(D))
-
- FERDR=SROUND(DFERDR(DBLE(X),K))
- RETURN
-
- END
-#endif
diff --git a/src/mathlib/gen/c/ferfr64.F b/src/mathlib/gen/c/ferfr64.F
deleted file mode 100644
index 1afe95c..0000000
--- a/src/mathlib/gen/c/ferfr64.F
+++ /dev/null
@@ -1,148 +0,0 @@
-*
-* $Id: ferfr64.F,v 1.1.1.1 1996/04/01 15:02:02 mclareni Exp $
-*
-* $Log: ferfr64.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:02 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION RFERDR(X,K)
-#endif
-#if defined(CERNLIB_DOUBLE)
- FUNCTION DFERDR(X,K)
-#include "gen/imp64.inc"
-#endif
- CHARACTER NAME*(*)
- CHARACTER*80 ERRTXT
-#if !defined(CERNLIB_DOUBLE)
- PARAMETER (NAME = 'RFERDR')
-#endif
-#if defined(CERNLIB_DOUBLE)
- PARAMETER (NAME = 'FRERDR/DFERDR')
-#endif
-
- DIMENSION P1(5),P2(5),P3(5),P4(5),P5(5),P6(5),P7(5),P8(5),P9(5)
- DIMENSION Q1(5),Q2(5),Q3(5),Q4(5),Q5(5),Q6(5),Q7(5),Q8(5),Q9(5)
-
- DATA C1 /1.77245 38509 05516 03D0/
- DATA C2 /0.88622 69254 52758 01D0/
- DATA C3 /1.32934 03881 79137 02D0/
- DATA C4 /0.66666 66666 66666 67D0/
- DATA C5 /0.40000 00000 00000 00D0/
-
- DATA P1
- 1/-1.25331 41288 20D+0, -1.72366 35577 01D+0, -6.55904 57292 58D-1,
- 2 -6.34228 31976 82D-2, -1.48838 31061 16D-5/
- DATA Q1
- 1/+1.00000 00000 00D+0, +2.19178 09259 80D+0, +1.60581 29554 06D+0,
- 2 +4.44366 95274 81D-1, +3.62423 22881 12D-2/
- DATA P2
- 1/-3.13328 53055 70D-1, -4.16187 38522 93D-1, -1.50220 84005 88D-1,
- 2 -1.33957 93751 73D-2, -1.51335 07001 38D-5/
- DATA Q2
- 1/+1.00000 00000 00D+0, +1.87260 86759 02D+0, +1.14520 44465 78D+0,
- 2 +2.57022 55875 73D-1, +1.63990 25435 68D-2/
- DATA P3
- 1/-2.34996 39854 06D-1, -2.92737 36375 47D-1, -9.88309 75887 38D-2,
- 2 -8.25138 63795 51D-3, -1.87438 41532 23D-5/
- DATA Q3
- 1/+1.00000 00000 00D+0, +1.60859 71091 46D+0, +8.27528 95308 80D-1,
- 2 +1.52232 23828 50D-1, +7.69512 04750 64D-3/
- DATA P4
- 1/+1.07381 27694D+0, +5.60033 03660D+0, +3.68822 11270D+0,
- 2 +1.17433 92816D+0, +2.36419 35527D-1/
- DATA Q4
- 1/+1.00000 00000D+0, +4.60318 40667D+0, +4.30759 10674D-1,
- 2 +4.21511 32145D-1, +1.18326 01601D-2/
- DATA P5
- 1/+6.78176 62666 0D-1, +6.33124 01791 0D-1, +2.94479 65177 2D-1,
- 2 +8.01320 71141 9D-2, +1.33918 21294 0D-2/
- DATA Q5
- 1/+1.00000 00000 0D+0, +1.43740 40039 7D-1, +7.08662 14845 0D-2,
- 2 +2.34579 49473 5D-3, -1.29449 92883 5D-5/
- DATA P6
- 1/+1.15302 13402D+0, +1.05915 58972D+0, +4.68988 03095D-1,
- 2 +1.18829 08784D-1, +1.94387 55787D-2/
- DATA Q6
- 1/+1.00000 00000D+0, +3.73489 53841D-2, +2.32484 58137D-2,
- 2 -1.37667 70874D-3, +4.64663 92781D-5/
- DATA P7
- 1/-8.22255 9330D-1, -3.62036 9345D+1, -3.01538 5410D+3,
- 2 -7.04987 1579D+4, -5.69814 5924D+4/
- DATA Q7
- 1/+1.00000 0000D+0, +3.93568 9841D+1, +3.56875 6266D+3,
- 2 +4.18189 3625D+4, +3.38513 8907D+5/
- DATA P8
- 1/+8.22449 97626D-1, +2.00463 03393D+1, +1.82680 93446D+3,
- 2 +1.22265 30374D+4, +1.40407 50092D+5/
- DATA Q8
- 1/+1.00000 00000D+0, +2.34862 07659D+1, +2.20134 83743D+3,
- 1 +1.14426 73596D+4, +1.65847 15900D+5/
- DATA P9
- 1/+2.46740 02368 4D+0, +2.19167 58236 8D+2, +1.23829 37907 5D+4,
- 2 +2.20667 72496 8D+5, +8.49442 92003 4D+5/
- DATA Q9
- 1/+1.00000 00000 0D+0, +8.91125 14061 9D+1, +5.04575 66966 7D+3,
- 2 +9.09075 94630 4D+4, +3.89960 91564 1D+5/
-
- IF(K .EQ. -1) THEN
- IF(X .LE. 1) THEN
- Y=EXP(X)
- H=Y*(C1+Y*
- 1 (P1(1)+Y*(P1(2)+Y*(P1(3)+Y*(P1(4)+Y*P1(5)))))/
- 2 (Q1(1)+Y*(Q1(2)+Y*(Q1(3)+Y*(Q1(4)+Y*Q1(5))))))
- ELSE IF(X .LE. 4) THEN
- H=(P4(1)+X*(P4(2)+X*(P4(3)+X*(P4(4)+X*P4(5)))))/
- 1 (Q4(1)+X*(Q4(2)+X*(Q4(3)+X*(Q4(4)+X*Q4(5)))))
- ELSE
- Y=1/X**2
- H=SQRT(X)*(2+Y*
- 1 (P7(1)+Y*(P7(2)+Y*(P7(3)+Y*(P7(4)+Y*P7(5)))))/
- 2 (Q7(1)+Y*(Q7(2)+Y*(Q7(3)+Y*(Q7(4)+Y*Q7(5))))))
- END IF
- ELSE IF(K .EQ. 1) THEN
- IF(X .LE. 1) THEN
- Y=EXP(X)
- H=Y*(C2+Y*
- 1 (P2(1)+Y*(P2(2)+Y*(P2(3)+Y*(P2(4)+Y*P2(5)))))/
- 2 (Q2(1)+Y*(Q2(2)+Y*(Q2(3)+Y*(Q2(4)+Y*Q2(5))))))
- ELSE IF(X .LE. 4) THEN
- H=(P5(1)+X*(P5(2)+X*(P5(3)+X*(P5(4)+X*P5(5)))))/
- 1 (Q5(1)+X*(Q5(2)+X*(Q5(3)+X*(Q5(4)+X*Q5(5)))))
- ELSE
- Y=1/X**2
- H=X*SQRT(X)*(C4+Y*
- 1 (P8(1)+Y*(P8(2)+Y*(P8(3)+Y*(P8(4)+Y*P8(5)))))/
- 2 (Q8(1)+Y*(Q8(2)+Y*(Q8(3)+Y*(Q8(4)+Y*Q8(5))))))
- END IF
- ELSE IF(K .EQ. 3) THEN
- IF(X .LE. 1) THEN
- Y=EXP(X)
- H=Y*(C3+Y*
- 1 (P3(1)+Y*(P3(2)+Y*(P3(3)+Y*(P3(4)+Y*P3(5)))))/
- 2 (Q3(1)+Y*(Q3(2)+Y*(Q3(3)+Y*(Q3(4)+Y*Q3(5))))))
- ELSE IF(X .LE. 4) THEN
- H=(P6(1)+X*(P6(2)+X*(P6(3)+X*(P6(4)+X*P6(5)))))/
- 1 (Q6(1)+X*(Q6(2)+X*(Q6(3)+X*(Q6(4)+X*Q6(5)))))
- ELSE
- Y=1/X**2
- H=X**2*SQRT(X)*(C5+Y*
- 1 (P9(1)+Y*(P9(2)+Y*(P9(3)+Y*(P9(4)+Y*P9(5)))))/
- 2 (Q9(1)+Y*(Q9(2)+Y*(Q9(3)+Y*(Q9(4)+Y*Q9(5))))))
- END IF
- ELSE
- H=0
- WRITE(ERRTXT,101) K
- CALL MTLPRT(NAME,'C323.1',ERRTXT)
- END IF
-#if defined(CERNLIB_DOUBLE)
- DFERDR=H
-#endif
-#if !defined(CERNLIB_DOUBLE)
- RFERDR=H
-#endif
- RETURN
- 101 FORMAT('INCORRECT K = ',I5)
- END
diff --git a/src/mathlib/gen/c/freq.F b/src/mathlib/gen/c/freq.F
deleted file mode 100644
index 64cd109..0000000
--- a/src/mathlib/gen/c/freq.F
+++ /dev/null
@@ -1,52 +0,0 @@
-*
-* $Id: freq.F,v 1.1.1.1 1996/04/01 15:01:53 mclareni Exp $
-*
-* $Log: freq.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:53 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- FUNCTION FREQ(X)
-
- DIMENSION P2(0:4),Q2(0:4)
-
- PARAMETER(Z1 = 1, HF = Z1/2)
- PARAMETER(C1 = 0.56418 958, W2 = 1.41421 356, RW2 = 1/W2)
-
- DATA P10,Q10,P11 /+3.67678 77, +3.25845 93, -9.79704 65E-2/
-
- DATA (P2(I),Q2(I),I=0,4)
- +/+7.37388 83E+0, +7.37396 09E+0, +6.86501 85E+0, +1.51849 08E+1,
- 1 +3.03179 93E+0, +1.27955 30E+1, +5.63169 62E-1, +5.35421 68E+0,
- 2 +4.31877 87E-5, +1/
-
- DATA P30,Q30,P31 /-1.24368 54E-1, +4.40917 06E-1, -9.68210 36E-2/
-
- V=RW2*ABS(X)
- IF(V .LT. HF) THEN
- Y=V**2
- H=V*(P10+P11*Y)/(Q10+Y)
- HC=1-H
- ELSEIF(V .LT. 4) THEN
- AP=P2(4)
- AQ=Q2(4)
- DO 2 I = 3,0,-1
- AP=P2(I)+V*AP
- 2 AQ=Q2(I)+V*AQ
- HC=EXP(-V**2)*AP/AQ
- H=1-HC
- ELSE
- Y=1/V**2
- HC=EXP(-V**2)*(C1+Y*(P30+P31*Y)/(Q30+Y))/V
- H=1-HC
- ENDIF
- IF(X .GT. 0) THEN
- FREQ=HF+HF*H
- ELSE
- FREQ=HF*HC
- ENDIF
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/c/freq128.F b/src/mathlib/gen/c/freq128.F
deleted file mode 100644
index ee6fb78..0000000
--- a/src/mathlib/gen/c/freq128.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: freq128.F,v 1.1.1.1 1996/04/01 15:01:53 mclareni Exp $
-*
-* $Log: freq128.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:53 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION DFREQ(X)
-C
-#include "gen/imp128.inc"
- CHARACTER*(*) NAME
- PARAMETER(NAME='DFREQ')
-C
- DFREQ=0
- CALL MTLPRT(NAME,'C301.0','Not available on this machine')
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/c/freq64.F b/src/mathlib/gen/c/freq64.F
deleted file mode 100644
index 7ff5a3b..0000000
--- a/src/mathlib/gen/c/freq64.F
+++ /dev/null
@@ -1,95 +0,0 @@
-*
-* $Id: freq64.F,v 1.1.1.1 1996/04/01 15:01:53 mclareni Exp $
-*
-* $Log: freq64.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:53 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- FUNCTION DFREQ(X)
-C
-#include "gen/imp64.inc"
-C
- CHARACTER*(*) NAME
- PARAMETER(NAME='DFREQ')
-#endif
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION FREQ(X)
-C
- CHARACTER*(*) NAME
- PARAMETER(NAME='FREQ')
-#endif
-C
- DIMENSION P1(0:3),Q1(0:3),P2(0:7),Q2(0:7),P3(0:4),Q3(0:4)
-
- PARAMETER(Z1 = 1, HF = Z1/2)
- PARAMETER(C1 = 0.56418 95835 47756 29D0)
- PARAMETER(W2 = 1.41421 35623 73095 05D0, RW2 = 1/W2)
-
- DATA (P1(I),Q1(I),I=0,3)
- +/+2.42667 95523 05317 5D+2, +2.15058 87586 98612 0D+2,
- 1 +2.19792 61618 29415 2D+1, +9.11649 05404 51490 1D+1,
- 2 +6.99638 34886 19135 5D+0, +1.50827 97630 40778 7D+1,
- 3 -3.56098 43701 81538 5D-2, +1/
-
- DATA (P2(I),Q2(I),I=0,7)
- +/+3.00459 26102 01616 01D+2, +3.00459 26095 69832 93D+2,
- 1 +4.51918 95371 18729 42D+2, +7.90950 92532 78980 27D+2,
- 2 +3.39320 81673 43436 87D+2, +9.31354 09485 06096 21D+2,
- 3 +1.52989 28504 69404 04D+2, +6.38980 26446 56311 67D+2,
- 4 +4.31622 27222 05673 53D+1, +2.77585 44474 39876 43D+2,
- 5 +7.21175 82508 83093 66D+0, +7.70001 52935 22947 30D+1,
- 6 +5.64195 51747 89739 71D-1, +1.27827 27319 62942 35D+1,
- 7 -1.36864 85738 27167 07D-7, +1/
-
- DATA (P3(I),Q3(I),I=0,4)
- +/-2.99610 70770 35421 74D-3, +1.06209 23052 84679 18D-2,
- 1 -4.94730 91062 32507 34D-2, +1.91308 92610 78298 41D-1,
- 2 -2.26956 59353 96869 30D-1, +1.05167 51070 67932 07D+0,
- 3 -2.78661 30860 96477 88D-1, +1.98733 20181 71352 56D+0,
- 4 -2.23192 45973 41846 86D-2, +1/
-
- V=RW2*ABS(X)
- IF(V .LT. HF) THEN
- Y=V**2
- AP=P1(3)
- AQ=Q1(3)
- DO 1 I = 2,0,-1
- AP=P1(I)+Y*AP
- 1 AQ=Q1(I)+Y*AQ
- H=V*AP/AQ
- HC=1-H
- ELSEIF(V .LT. 4) THEN
- AP=P2(7)
- AQ=Q2(7)
- DO 2 I = 6,0,-1
- AP=P2(I)+V*AP
- 2 AQ=Q2(I)+V*AQ
- HC=EXP(-V**2)*AP/AQ
- H=1-HC
- ELSE
- Y=1/V**2
- AP=P3(4)
- AQ=Q3(4)
- DO 3 I = 3,0,-1
- AP=P3(I)+Y*AP
- 3 AQ=Q3(I)+Y*AQ
- HC=EXP(-V**2)*(C1+Y*AP/AQ)/V
- H=1-HC
- ENDIF
- IF(X .GT. 0) THEN
-#if defined(CERNLIB_DOUBLE)
- DFREQ=HF+HF*H
- ELSE
- DFREQ=HF*HC
-#endif
-#if !defined(CERNLIB_DOUBLE)
- FREQ=HF+HF*H
- ELSE
- FREQ=HF*HC
-#endif
- ENDIF
- RETURN
- END
diff --git a/src/mathlib/gen/c/frsin.F b/src/mathlib/gen/c/frsin.F
deleted file mode 100644
index f1de58f..0000000
--- a/src/mathlib/gen/c/frsin.F
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: frsin.F,v 1.1.1.1 1996/04/01 15:02:02 mclareni Exp $
-*
-* $Log: frsin.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:02 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION FRSIN(X)
- FRSIN=RFRSIN(X)
- RETURN
- ENTRY FRCOS(X)
- FRCOS=RFRCOS(X)
- END
-#endif
diff --git a/src/mathlib/gen/c/frsin128.F b/src/mathlib/gen/c/frsin128.F
deleted file mode 100644
index 25c25da..0000000
--- a/src/mathlib/gen/c/frsin128.F
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: frsin128.F,v 1.1.1.1 1996/04/01 15:02:02 mclareni Exp $
-*
-* $Log: frsin128.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:02 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION DFRSIN(X)
-#include "gen/imp128.inc"
- CHARACTER*(*) NAME1, NAME2
- PARAMETER( NAME1='DFRSIN')
- PARAMETER( NAME2='DFRCOS')
- DFRSIN=0
- CALL MTLPRT(NAME1,'C322.0','Not available on this machine')
- RETURN
-
- ENTRY DFRCOS(X)
- DFRCOS=0
- CALL MTLPRT(NAME2,'C322.0','Not available on this machine')
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/c/frsin64.F b/src/mathlib/gen/c/frsin64.F
deleted file mode 100644
index a748aa5..0000000
--- a/src/mathlib/gen/c/frsin64.F
+++ /dev/null
@@ -1,196 +0,0 @@
-*
-* $Id: frsin64.F,v 1.1.1.1 1996/04/01 15:02:02 mclareni Exp $
-*
-* $Log: frsin64.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:02 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION RFRSIN(X)
-#endif
-#if defined(CERNLIB_DOUBLE)
- FUNCTION DFRSIN(X)
-#include "gen/imp64.inc"
-#endif
-
- DIMENSION A(0:16),B(0:15),C1(0:25),C2(0:28)
-
- PARAMETER (Z1 = 1, R8 = Z1/8, R32 = Z1/32)
-
- DATA C0 /1.25331 41373 15500 3D0/
-
- DATA NA,NB,NC1,NC2 /16,15,25,28/
-
- DATA A( 0) / 0.76435 13866 41860 002D0/
- DATA A( 1) /-0.43135 54754 76601 793D0/
- DATA A( 2) / 0.43288 19997 97266 531D0/
- DATA A( 3) /-0.26973 31033 83871 110D0/
- DATA A( 4) / 0.08416 04532 08769 354D0/
- DATA A( 5) /-0.01546 52448 44613 820D0/
- DATA A( 6) / 0.00187 85542 34398 220D0/
- DATA A( 7) /-0.00016 26497 76188 875D0/
- DATA A( 8) / 0.00001 05739 76563 833D0/
- DATA A( 9) /-0.00000 05360 93398 892D0/
- DATA A(10) / 0.00000 00218 16584 549D0/
- DATA A(11) /-0.00000 00007 29016 212D0/
- DATA A(12) / 0.00000 00000 20373 325D0/
- DATA A(13) /-0.00000 00000 00483 440D0/
- DATA A(14) / 0.00000 00000 00009 865D0/
- DATA A(15) /-0.00000 00000 00000 175D0/
- DATA A(16) / 0.00000 00000 00000 003D0/
-
- DATA B( 0) / 0.63041 40431 45705 392D0/
- DATA B( 1) /-0.42344 51140 57053 335D0/
- DATA B( 2) / 0.37617 17264 33436 566D0/
- DATA B( 3) /-0.16249 48915 45095 674D0/
- DATA B( 4) / 0.03822 25577 86330 087D0/
- DATA B( 5) /-0.00564 56347 71321 909D0/
- DATA B( 6) / 0.00057 45495 19768 974D0/
- DATA B( 7) /-0.00004 28707 15321 020D0/
- DATA B( 8) / 0.00000 24512 07499 233D0/
- DATA B( 9) /-0.00000 01109 88418 409D0/
- DATA B(10) / 0.00000 00040 82497 317D0/
- DATA B(11) /-0.00000 00001 24498 302D0/
- DATA B(12) / 0.00000 00000 03200 484D0/
- DATA B(13) /-0.00000 00000 00070 324D0/
- DATA B(14) / 0.00000 00000 00001 336D0/
- DATA B(15) /-0.00000 00000 00000 022D0/
-
- DATA C1( 0) / 0.99056 04793 73497 549D0/
- DATA C1( 1) /-0.01218 35098 31478 997D0/
- DATA C1( 2) /-0.00248 27428 23113 060D0/
- DATA C1( 3) / 0.00026 60949 52647 247D0/
- DATA C1( 4) /-0.00000 10790 68987 406D0/
- DATA C1( 5) /-0.00000 48836 81753 933D0/
- DATA C1( 6) / 0.00000 09990 55266 368D0/
- DATA C1( 7) /-0.00000 00750 92717 372D0/
- DATA C1( 8) /-0.00000 00190 79487 573D0/
- DATA C1( 9) / 0.00000 00090 90797 293D0/
- DATA C1(10) /-0.00000 00019 66236 033D0/
- DATA C1(11) / 0.00000 00001 64772 911D0/
- DATA C1(12) / 0.00000 00000 63079 714D0/
- DATA C1(13) /-0.00000 00000 36432 219D0/
- DATA C1(14) / 0.00000 00000 10536 930D0/
- DATA C1(15) /-0.00000 00000 01716 438D0/
- DATA C1(16) /-0.00000 00000 00107 124D0/
- DATA C1(17) / 0.00000 00000 00204 099D0/
- DATA C1(18) /-0.00000 00000 00090 064D0/
- DATA C1(19) / 0.00000 00000 00025 506D0/
- DATA C1(20) /-0.00000 00000 00004 036D0/
- DATA C1(21) /-0.00000 00000 00000 570D0/
- DATA C1(22) / 0.00000 00000 00000 762D0/
- DATA C1(23) /-0.00000 00000 00000 363D0/
- DATA C1(24) / 0.00000 00000 00000 118D0/
- DATA C1(25) /-0.00000 00000 00000 025D0/
-
- DATA C2( 0) / 0.04655 77987 37516 4561D0/
- DATA C2( 1) / 0.04499 21302 01239 4140D0/
- DATA C2( 2) /-0.00175 42871 39651 4532D0/
- DATA C2( 3) /-0.00014 65340 02581 0678D0/
- DATA C2( 4) / 0.00003 91330 40863 0159D0/
- DATA C2( 5) /-0.00000 34932 28659 7731D0/
- DATA C2( 6) /-0.00000 03153 53003 2345D0/
- DATA C2( 7) / 0.00000 01876 58200 8529D0/
- DATA C2( 8) /-0.00000 00377 55280 4930D0/
- DATA C2( 9) / 0.00000 00026 65516 5010D0/
- DATA C2(10) / 0.00000 00010 88144 8122D0/
- DATA C2(11) /-0.00000 00005 35500 7671D0/
- DATA C2(12) / 0.00000 00001 31576 5447D0/
- DATA C2(13) /-0.00000 00000 15286 0881D0/
- DATA C2(14) /-0.00000 00000 03394 7646D0/
- DATA C2(15) / 0.00000 00000 02702 0267D0/
- DATA C2(16) /-0.00000 00000 00946 3142D0/
- DATA C2(17) / 0.00000 00000 00207 1565D0/
- DATA C2(18) /-0.00000 00000 00012 6931D0/
- DATA C2(19) /-0.00000 00000 00013 9756D0/
- DATA C2(20) / 0.00000 00000 00008 5929D0/
- DATA C2(21) /-0.00000 00000 00003 1070D0/
- DATA C2(22) / 0.00000 00000 00000 7515D0/
- DATA C2(23) /-0.00000 00000 00000 0648D0/
- DATA C2(24) /-0.00000 00000 00000 0522D0/
- DATA C2(25) / 0.00000 00000 00000 0386D0/
- DATA C2(26) /-0.00000 00000 00000 0165D0/
- DATA C2(27) / 0.00000 00000 00000 0050D0/
- DATA C2(28) /-0.00000 00000 00000 0009D0/
-
- V=ABS(X)
- IF(V .LT. 8) THEN
- Y=R8*V
- H=2*Y**2-1
- ALFA=H+H
- B1=0
- B2=0
- DO 4 I = NB,0,-1
- B0=B(I)+ALFA*B1-B2
- B2=B1
- 4 B1=B0
- H=SQRT(V)*Y*(B0-B2)
- ELSE
- R=1/V
- H=10*R-1
- ALFA=H+H
- B1=0
- B2=0
- DO 5 I = NC1,0,-1
- B0=C1(I)+ALFA*B1-B2
- B2=B1
- 5 B1=B0
- S=B0-H*B2
- B1=0
- B2=0
- DO 6 I = NC2,0,-1
- B0=C2(I)+ALFA*B1-B2
- B2=B1
- 6 B1=B0
- H=C0-SQRT(R)*(S*COS(V)+(B0-H*B2)*SIN(V))
- END IF
- IF(X .LT. 0) H=-H
- GO TO 9
-
-#if !defined(CERNLIB_DOUBLE)
- ENTRY RFRCOS(X)
-#endif
-#if defined(CERNLIB_DOUBLE)
- ENTRY DFRCOS(X)
-#endif
- V=ABS(X)
- IF(V .LT. 8) THEN
- H=R32*V**2-1
- ALFA=H+H
- B1=0
- B2=0
- DO 1 I = NA,0,-1
- B0=A(I)+ALFA*B1-B2
- B2=B1
- 1 B1=B0
- H=SQRT(V)*(B0-H*B2)
- ELSE
- R=1/V
- H=10*R-1
- ALFA=H+H
- B1=0
- B2=0
- DO 2 I = NC1,0,-1
- B0=C1(I)+ALFA*B1-B2
- B2=B1
- 2 B1=B0
- S=B0-H*B2
- B1=0
- B2=0
- DO 3 I = NC2,0,-1
- B0=C2(I)+ALFA*B1-B2
- B2=B1
- 3 B1=B0
- H=C0-SQRT(R)*((B0-H*B2)*COS(V)-S*SIN(V))
- END IF
- IF(X .LT. 0) H=-H
-#if !defined(CERNLIB_DOUBLE)
- 9 RFRSIN=H
-#endif
-#if defined(CERNLIB_DOUBLE)
- 9 DFRSIN=H
-#endif
- RETURN
- END
diff --git a/src/mathlib/gen/c/gagnc64.F b/src/mathlib/gen/c/gagnc64.F
deleted file mode 100644
index 804b4a5..0000000
--- a/src/mathlib/gen/c/gagnc64.F
+++ /dev/null
@@ -1,207 +0,0 @@
-*
-* $Id: gagnc64.F,v 1.1.1.1 1996/04/01 15:02:05 mclareni Exp $
-*
-* $Log: gagnc64.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:05 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION RGAGNC(A,X)
-#endif
-#if defined(CERNLIB_DOUBLE)
- FUNCTION DGAGNC(A,X)
-#include "gen/imp64.inc"
-#endif
-
-C Calculates the complementary incomplete gamma function G(A,X)
-C as defined in Ref. 1. Based on
-C 1. W. Gautschi, ALGORITHM 542 Incomplete Gamma Functions,
-C ACM Trans. Math. Software 5 (1979) 482-489
-C 2. W. Gautschi, A computational procedure for incomplete gamma
-C functions, ACM Trans. Math. Software 5 (1979) 466-481
-
- CHARACTER NAME*(*)
- CHARACTER*80 ERRTXT
-#if !defined(CERNLIB_DOUBLE)
- PARAMETER (NAME = 'RGAGNC')
-#endif
-#if defined(CERNLIB_DOUBLE)
- PARAMETER (NAME = 'RGAGNC/DGAGNC')
-#endif
-
- PARAMETER (EPS = 5D-14)
- PARAMETER (ALH = -0.69314 71805 59945 31D0)
- PARAMETER (Z1 = 1, HALF = Z1/2, QUAR = Z1/4)
- PARAMETER (C1 = 3*Z1/2, KMAX = 600, EPS1 = EPS/100)
-
- DIMENSION C(25)
-
- DATA C( 1) / 0.57721 56649 01532 86D0/
- DATA C( 2) /-0.65587 80715 20253 88D0/
- DATA C( 3) /-0.04200 26350 34095 24D0/
- DATA C( 4) / 0.16653 86113 82291 49D0/
- DATA C( 5) /-0.04219 77345 55544 34D0/
- DATA C( 6) /-0.00962 19715 27876 97D0/
- DATA C( 7) / 0.00721 89432 46663 10D0/
- DATA C( 8) /-0.00116 51675 91859 07D0/
- DATA C( 9) /-0.00021 52416 74114 95D0/
- DATA C(10) / 0.00012 80502 82388 12D0/
- DATA C(11) /-0.00002 01348 54780 79D0/
- DATA C(12) /-0.00000 12504 93482 14D0/
- DATA C(13) / 0.00000 11330 27231 98D0/
- DATA C(14) /-0.00000 02056 33841 70D0/
- DATA C(15) / 0.00000 00061 16095 10D0/
- DATA C(16) / 0.00000 00050 02007 64D0/
- DATA C(17) /-0.00000 00011 81274 57D0/
- DATA C(18) / 0.00000 00001 04342 67D0/
- DATA C(19) / 0.00000 00000 07782 26D0/
- DATA C(20) /-0.00000 00000 03696 81D0/
- DATA C(21) / 0.00000 00000 00510 04D0/
- DATA C(22) /-0.00000 00000 00020 58D0/
- DATA C(23) /-0.00000 00000 00005 35D0/
- DATA C(24) / 0.00000 00000 00001 23D0/
- DATA C(25) /-0.00000 00000 00000 12D0/
-
-#if defined(CERNLIB_DOUBLE)
- GLGAMA(V)=DLGAMA(V)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- GLGAMA(V)=ALGAMA(V)
-#endif
-
- H=0
- IF(X .LT. 0) THEN
- WRITE(ERRTXT,101) X
- CALL MTLPRT(NAME,'C334.1',ERRTXT)
- GO TO 99
- ELSEIF(X .EQ. 0) THEN
- IF(A .LT. 0) THEN
- H=-1/A
- ELSEIF(A .EQ. 0) THEN
- CALL MTLPRT(NAME,'C334.2','ILLEGAL ARGUMENTS A = X = 0')
- ELSE
- H=1
- ENDIF
- GO TO 99
- ELSE
- ALX=LOG(X)
- ENDIF
- IF(X .LT. QUAR) THEN
- ALFA=ALH/ALX
- ELSE
- ALFA=X+QUAR
- ENDIF
- MA=HALF-A
- AEPS=A+MA
-
- IF(MA .GT. 0) THEN
- IF(AEPS .NE. 0) THEN
- ALGP1=GLGAMA(1+AEPS)-LOG(ABS(AEPS))
- IF(MA .NE. 1) ALGP1=ALGP1+GLGAMA(1-AEPS)-GLGAMA(MA-AEPS)
- ELSE
- ALGP1=0
- ENDIF
- ELSE
- ALGP1=GLGAMA(1+A)
- ENDIF
- IF(A .GT. ALFA) THEN
- TERM=1
- SUM=1
- DO 1 K = 1,KMAX
- TERM=X*TERM/(A+K)
- SUM=SUM+TERM
- IF(ABS(TERM) .LE. EPS*SUM) GO TO 2
- 1 CONTINUE
- GO TO 98
- 2 H=1-EXP(A*ALX-X+LOG(SUM)-ALGP1)
- ELSEIF(X .GT. C1) THEN
- P=0
- S=1-A
- Q=(X+S)*(X-1-A)
- R=4*(X+S)
- TERM=1
- SUM=1
- RHO=0
- DO 3 K = 2,KMAX
- P=P+S
- Q=Q+R
- R=R+8
- S=S+2
- T=P*(1+RHO)
- RHO=T/(Q-T)
- TERM=RHO*TERM
- SUM=SUM+TERM
- IF(ABS(TERM) .LE. EPS*SUM) GO TO 4
- 3 CONTINUE
- GO TO 98
- 4 IF(A .LE. 0) THEN
- H=SUM/(X+1-A)
- ELSE
- H=EXP(A*ALX-X+LOG(A*SUM/(X+1-A))-ALGP1)
- ENDIF
- ELSE
- AE=A
- IF(A .LT. HALF) THEN
- IF(A .LT. -HALF) AE=AEPS
- SUM=C(25)
- DO 12 K = 24,1,-1
- 12 SUM=AE*SUM+C(K)
- GA=-SUM/(1+AE*SUM)
- Y=AE*ALX
- IF(ABS(Y) .GE. 1) THEN
- U=GA-(EXP(Y)-1)/AE
- ELSE
- SUM=1
- TERM=1
- DO 7 K = 2,KMAX
- TERM=Y*TERM/K
- SUM=SUM+TERM
- IF(ABS(TERM) .LE. EPS1*SUM) GO TO 8
- 7 CONTINUE
- GO TO 98
- 8 U=GA-SUM*ALX
- ENDIF
- ELSE
- U=EXP(GLGAMA(A))-X**A/A
- ENDIF
- P=AE*X
- Q=AE+1
- R=AE+3
- TERM=1
- SUM=1
- DO 9 K = 2,KMAX
- P=P+X
- Q=Q+R
- R=R+2
- TERM=-P*TERM/Q
- SUM=SUM+TERM
- IF(ABS(TERM) .LE. EPS1*SUM) GO TO 10
- 9 CONTINUE
- GO TO 98
- 10 H=U+SUM*X**(AE+1)/(AE+1)
- IF(A .LT. -HALF) THEN
- H=H*EXP(X-AE*ALX)
- DO 13 J = 1,MA
- 13 H=(1-X*H)/(J-AE)
- ELSEIF(A .LE. 0) THEN
- H=H*EXP(X-A*ALX)
- ELSE
- H=A*H*EXP(-ALGP1)
- ENDIF
- ENDIF
-#if defined(CERNLIB_DOUBLE)
- 99 DGAGNC=H
-#endif
-#if !defined(CERNLIB_DOUBLE)
- 99 RGAGNC=H
-#endif
- RETURN
-
- 98 WRITE(ERRTXT,103) A,X
- CALL MTLPRT(NAME,'C334.3',ERRTXT)
- GO TO 99
- 101 FORMAT('ILLEGAL ARGUMENT X = ',1P,E15.6,' < 0')
- 103 FORMAT('PROBLEMS WITH CONVERGENCE, A = ',1P,E15.8,' X = ',E15.6)
- END
diff --git a/src/mathlib/gen/c/gamma.F b/src/mathlib/gen/c/gamma.F
deleted file mode 100644
index 83a8ebf..0000000
--- a/src/mathlib/gen/c/gamma.F
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: gamma.F,v 1.1.1.1 1996/04/01 15:01:54 mclareni Exp $
-*
-* $Log: gamma.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:54 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if (defined(CERNLIB_DOUBLE))&&(!defined(CERNLIB_IBM))
- FUNCTION GAMMA(X)
- DOUBLE PRECISION DGAMMA,D
-
- SROUND(D)=D+(D-SNGL(D))
- GAMMA=SROUND(DGAMMA(DBLE(X)))
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/c/gamma128.F b/src/mathlib/gen/c/gamma128.F
deleted file mode 100644
index 9e58ff1..0000000
--- a/src/mathlib/gen/c/gamma128.F
+++ /dev/null
@@ -1,127 +0,0 @@
-*
-* $Id: gamma128.F,v 1.1.1.1 1996/04/01 15:01:54 mclareni Exp $
-*
-* $Log: gamma128.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:54 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_QUAD)
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION DGAMMA(X)
-#endif
-#if defined(CERNLIB_DOUBLE)
- FUNCTION QGAMMA(X)
-#endif
-
-#include "gen/imp128.inc"
- CHARACTER NAME*(*)
- CHARACTER*80 ERRTXT
-#if !defined(CERNLIB_DOUBLE)
- PARAMETER (NAME = 'DGAMMA')
- DIMENSION C(0:26)
-
- DATA C( 0) / 3.65738 77250 83382 43849 88068 52039D0/
- DATA C( 1) / 1.95754 34566 61268 26928 33742 32877D0/
- DATA C( 2) / 0.33829 71138 26160 38915 58510 72725D0/
- DATA C( 3) / 0.04208 95127 65575 49198 51083 97028D0/
- DATA C( 4) / 0.00428 76504 82129 08770 04289 08116D0/
- DATA C( 5) / 0.00036 52121 69294 61767 02198 21538D0/
- DATA C( 6) / 0.00002 74006 42226 42200 27170 66599D0/
- DATA C( 7) / 0.00000 18124 02333 65124 44603 04653D0/
- DATA C( 8) / 0.00000 01096 57758 65997 06993 06003D0/
- DATA C( 9) / 0.00000 00059 87184 04552 00046 94981D0/
- DATA C(10) / 0.00000 00003 07690 80535 24777 70970D0/
- DATA C(11) / 0.00000 00000 14317 93029 61915 76369D0/
- DATA C(12) / 0.00000 00000 00651 08773 34803 70077D0/
- DATA C(13) / 0.00000 00000 00025 95849 89822 27998D0/
- DATA C(14) / 0.00000 00000 00001 10789 38922 59522D0/
- DATA C(15) / 0.00000 00000 00000 03547 43620 16354D0/
- DATA C(16) / 0.00000 00000 00000 00168 86075 02335D0/
- DATA C(17) / 0.00000 00000 00000 00002 73543 57562D0/
- DATA C(18) / 0.00000 00000 00000 00000 30297 74054D0/
- DATA C(19) /-0.00000 00000 00000 00000 00571 22030D0/
- DATA C(20) / 0.00000 00000 00000 00000 00090 76859D0/
- DATA C(21) /-0.00000 00000 00000 00000 00005 04522D0/
- DATA C(22) / 0.00000 00000 00000 00000 00000 40496D0/
- DATA C(23) /-0.00000 00000 00000 00000 00000 02792D0/
- DATA C(24) / 0.00000 00000 00000 00000 00000 00204D0/
- DATA C(25) /-0.00000 00000 00000 00000 00000 00015D0/
- DATA C(26) / 0.00000 00000 00000 00000 00000 00001D0/
-
-#endif
-#if defined(CERNLIB_DOUBLE)
- PARAMETER (NAME = 'QGAMMA')
- DIMENSION C(0:27)
-
- DATA C( 0) / 3.65738 77250 83382 43849 88068 52039 34Q0/
- DATA C( 1) / 1.95754 34566 61268 26928 33742 32876 84Q0/
- DATA C( 2) / 0.33829 71138 26160 38915 58510 72725 40Q0/
- DATA C( 3) / 0.04208 95127 65575 49198 51083 97027 90Q0/
- DATA C( 4) / 0.00428 76504 82129 08770 04289 08116 23Q0/
- DATA C( 5) / 0.00036 52121 69294 61767 02198 21538 33Q0/
- DATA C( 6) / 0.00002 74006 42226 42200 27170 66598 98Q0/
- DATA C( 7) / 0.00000 18124 02333 65124 44603 04653 06Q0/
- DATA C( 8) / 0.00000 01096 57758 65997 06993 06002 52Q0/
- DATA C( 9) / 0.00000 00059 87184 04552 00046 94980 50Q0/
- DATA C(10) / 0.00000 00003 07690 80535 24777 70969 71Q0/
- DATA C(11) / 0.00000 00000 14317 93029 61915 76369 12Q0/
- DATA C(12) / 0.00000 00000 00651 08773 34803 70076 65Q0/
- DATA C(13) / 0.00000 00000 00025 95849 89822 27997 94Q0/
- DATA C(14) / 0.00000 00000 00001 10789 38922 59521 65Q0/
- DATA C(15) / 0.00000 00000 00000 03547 43620 16353 80Q0/
- DATA C(16) / 0.00000 00000 00000 00168 86075 02335 19Q0/
- DATA C(17) / 0.00000 00000 00000 00002 73543 57561 54Q0/
- DATA C(18) / 0.00000 00000 00000 00000 30297 74054 44Q0/
- DATA C(19) /-0.00000 00000 00000 00000 00571 22030 32Q0/
- DATA C(20) / 0.00000 00000 00000 00000 00090 76858 53Q0/
- DATA C(21) /-0.00000 00000 00000 00000 00005 04522 44Q0/
- DATA C(22) / 0.00000 00000 00000 00000 00000 40496 46Q0/
- DATA C(23) /-0.00000 00000 00000 00000 00000 02791 84Q0/
- DATA C(24) / 0.00000 00000 00000 00000 00000 00203 70Q0/
- DATA C(25) /-0.00000 00000 00000 00000 00000 00014 54Q0/
- DATA C(26) / 0.00000 00000 00000 00000 00000 00001 06Q0/
- DATA C(27) /-0.00000 00000 00000 00000 00000 00000 07Q0/
-#endif
- U=X
- IF(U .LE. 0) THEN
- H=0
- WRITE(ERRTXT,101) U
- CALL MTLPRT(NAME,'C302.1',ERRTXT)
- GO TO 9
- ENDIF
- F=1
- IF(U .LT. 3) THEN
- DO 1 I = 1,INT(4-U)
- F=F/U
- 1 U=U+1
- ELSE
- DO 2 I = 1,INT(U-3)
- U=U-1
- 2 F=F*U
- END IF
- H=U+U-7
- ALFA=H+H
- B1=0
- B2=0
-#if !defined(CERNLIB_DOUBLE)
- DO 3 I = 26,0,-1
-#endif
-#if defined(CERNLIB_DOUBLE)
- DO 3 I = 27,0,-1
-#endif
- B0=C(I)+ALFA*B1-B2
- B2=B1
- 3 B1=B0
- H=F*(B0-H*B2)
-#if !defined(CERNLIB_DOUBLE)
- 9 DGAMMA=H
-#endif
-#if defined(CERNLIB_DOUBLE)
- 9 QGAMMA=H
-#endif
- RETURN
- 101 FORMAT('ARGUMENT IS NEGATIVE = ',1P,E15.1)
- END
-#endif
diff --git a/src/mathlib/gen/c/gamma64.F b/src/mathlib/gen/c/gamma64.F
deleted file mode 100644
index 75b7810..0000000
--- a/src/mathlib/gen/c/gamma64.F
+++ /dev/null
@@ -1,81 +0,0 @@
-*
-* $Id: gamma64.F,v 1.1.1.1 1996/04/01 15:01:54 mclareni Exp $
-*
-* $Log: gamma64.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:54 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if !defined(CERNLIB_IBM)
-#if defined(CERNLIB_DOUBLE)
- FUNCTION DGAMMA(X)
-C
-#include "gen/imp64.inc"
-C
- CHARACTER*(*) NAME
- PARAMETER(NAME='GAMMA/DGAMMA')
-#endif
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION GAMMA(X)
-C
- CHARACTER*(*) NAME
- PARAMETER(NAME='GAMMA')
-#endif
-C
- CHARACTER*80 ERRTXT
-
- DIMENSION C(0:15)
-
- DATA C( 0) /3.65738 77250 83382 44D0/
- DATA C( 1) /1.95754 34566 61268 27D0/
- DATA C( 2) /0.33829 71138 26160 39D0/
- DATA C( 3) /0.04208 95127 65575 49D0/
- DATA C( 4) /0.00428 76504 82129 09D0/
- DATA C( 5) /0.00036 52121 69294 62D0/
- DATA C( 6) /0.00002 74006 42226 42D0/
- DATA C( 7) /0.00000 18124 02333 65D0/
- DATA C( 8) /0.00000 01096 57758 66D0/
- DATA C( 9) /0.00000 00059 87184 05D0/
- DATA C(10) /0.00000 00003 07690 81D0/
- DATA C(11) /0.00000 00000 14317 93D0/
- DATA C(12) /0.00000 00000 00651 09D0/
- DATA C(13) /0.00000 00000 00025 96D0/
- DATA C(14) /0.00000 00000 00001 11D0/
- DATA C(15) /0.00000 00000 00000 04D0/
-
- U=X
- IF(U .LE. 0) THEN
- WRITE(ERRTXT,101) U
- CALL MTLPRT(NAME,'C302.1',ERRTXT)
- H=0
- GO TO 9
- ENDIF
- 8 F=1
- IF(U .LT. 3) THEN
- DO 1 I = 1,INT(4-U)
- F=F/U
- 1 U=U+1
- ELSE
- DO 2 I = 1,INT(U-3)
- U=U-1
- 2 F=F*U
- END IF
- H=U+U-7
- ALFA=H+H
- B1=0
- B2=0
- DO 3 I = 15,0,-1
- B0=C(I)+ALFA*B1-B2
- B2=B1
- 3 B1=B0
-#if defined(CERNLIB_DOUBLE)
- 9 DGAMMA=F*(B0-H*B2)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- 9 GAMMA =F*(B0-H*B2)
-#endif
- RETURN
- 101 FORMAT('ARGUMENT IS NEGATIVE = ',1P,E15.1)
- END
-#endif
diff --git a/src/mathlib/gen/c/gammf.F b/src/mathlib/gen/c/gammf.F
deleted file mode 100644
index 4c3c447..0000000
--- a/src/mathlib/gen/c/gammf.F
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: gammf.F,v 1.1.1.1 1996/04/01 15:01:54 mclareni Exp $
-*
-* $Log: gammf.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:54 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- FUNCTION GAMMF(X)
- DOUBLE PRECISION DGAMMF,D
-
- SROUND(D)=D+(D-SNGL(D))
- GAMMF=SROUND(DGAMMF(DBLE(X)))
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/c/gammf128.F b/src/mathlib/gen/c/gammf128.F
deleted file mode 100644
index 061e873..0000000
--- a/src/mathlib/gen/c/gammf128.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: gammf128.F,v 1.1.1.1 1996/04/01 15:01:54 mclareni Exp $
-*
-* $Log: gammf128.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:54 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION DGAMMF(X)
-C
-#include "gen/imp128.inc"
- CHARACTER*(*) NAME
- PARAMETER(NAME='DGAMMF')
-C
- DGAMMF=0
- CALL MTLPRT(NAME,'C303.0','Not available on this machine')
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/c/gammf64.F b/src/mathlib/gen/c/gammf64.F
deleted file mode 100644
index bf08cfa..0000000
--- a/src/mathlib/gen/c/gammf64.F
+++ /dev/null
@@ -1,87 +0,0 @@
-*
-* $Id: gammf64.F,v 1.1.1.1 1996/04/01 15:01:54 mclareni Exp $
-*
-* $Log: gammf64.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:54 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- FUNCTION DGAMMF(X)
-C
-#include "gen/imp64.inc"
-C
- CHARACTER*(*) NAME
- PARAMETER(NAME='GAMMF/DGAMMF')
-#endif
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION GAMMF(X)
-C
- CHARACTER*(*) NAME
- PARAMETER(NAME='GAMMF')
-#endif
- CHARACTER*80 ERRTXT
-C
- DIMENSION C(0:15)
-
- PARAMETER (PI = 3.14159 26535 89793 24D0)
-
- DATA C( 0) /3.65738 77250 83382 44D0/
- DATA C( 1) /1.95754 34566 61268 27D0/
- DATA C( 2) /0.33829 71138 26160 39D0/
- DATA C( 3) /0.04208 95127 65575 49D0/
- DATA C( 4) /0.00428 76504 82129 09D0/
- DATA C( 5) /0.00036 52121 69294 62D0/
- DATA C( 6) /0.00002 74006 42226 42D0/
- DATA C( 7) /0.00000 18124 02333 65D0/
- DATA C( 8) /0.00000 01096 57758 66D0/
- DATA C( 9) /0.00000 00059 87184 05D0/
- DATA C(10) /0.00000 00003 07690 81D0/
- DATA C(11) /0.00000 00000 14317 93D0/
- DATA C(12) /0.00000 00000 00651 09D0/
- DATA C(13) /0.00000 00000 00025 96D0/
- DATA C(14) /0.00000 00000 00001 11D0/
- DATA C(15) /0.00000 00000 00000 04D0/
-
- U=X
- IF(U .LE. 0) THEN
- IF(U .EQ. INT(X)) THEN
- WRITE(ERRTXT,101) U
- CALL MTLPRT(NAME,'C303.1',ERRTXT)
- H=0
- GO TO 9
- ELSE
- U=1-X
- END IF
- ENDIF
- 8 F=1
- IF(U .LT. 3) THEN
- DO 1 I = 1,INT(4-U)
- F=F/U
- 1 U=U+1
- ELSE
- DO 2 I = 1,INT(U-3)
- U=U-1
- 2 F=F*U
- END IF
- H=U+U-7
- ALFA=H+H
- B1=0
- B2=0
- DO 3 I = 15,0,-1
- B0=C(I)+ALFA*B1-B2
- B2=B1
- 3 B1=B0
- H=F*(B0-H*B2)
- IF(X .LT. 0) H=PI/(SIN(PI*X)*H)
-#if defined(CERNLIB_DOUBLE)
- 9 DGAMMF=H
-#endif
-#if !defined(CERNLIB_DOUBLE)
- 9 GAMMF=H
-#endif
- RETURN
-
- 101 FORMAT('ARGUMENT IS NON-POSITIVE INTEGER = ',1P,E15.1)
- END
diff --git a/src/mathlib/gen/c/gapnc.F b/src/mathlib/gen/c/gapnc.F
deleted file mode 100644
index 03833fa..0000000
--- a/src/mathlib/gen/c/gapnc.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: gapnc.F,v 1.1.1.1 1996/04/01 15:02:05 mclareni Exp $
-*
-* $Log: gapnc.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:05 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION GAPNC(A,X)
-
- GAPNC=RGAPNC(A,X)
- RETURN
-
- ENTRY GAGNC(A,X)
- GAGNC=RGAGNC(A,X)
- RETURN
-
- END
-#endif
diff --git a/src/mathlib/gen/c/gapnc128.F b/src/mathlib/gen/c/gapnc128.F
deleted file mode 100644
index 99e6c77..0000000
--- a/src/mathlib/gen/c/gapnc128.F
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: gapnc128.F,v 1.1.1.1 1996/04/01 15:02:05 mclareni Exp $
-*
-* $Log: gapnc128.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:05 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION DGAPNC(A,X)
-#include "gen/imp128.inc"
-C
- CHARACTER*(*) NAME1, NAME2
- PARAMETER( NAME1='DGAPNC')
- PARAMETER( NAME2='DGAGNC')
- DGAPNC=0
- CALL MTLPRT(NAME1,'C334.0','Not available on this machine')
- RETURN
-
- ENTRY DGAGNC(A,X)
- DGAGNC=0
- CALL MTLPRT(NAME2,'C334.0','Not available on this machine')
- END
-#endif
diff --git a/src/mathlib/gen/c/gapnc64.F b/src/mathlib/gen/c/gapnc64.F
deleted file mode 100644
index 095e527..0000000
--- a/src/mathlib/gen/c/gapnc64.F
+++ /dev/null
@@ -1,215 +0,0 @@
-*
-* $Id: gapnc64.F,v 1.1.1.1 1996/04/01 15:02:05 mclareni Exp $
-*
-* $Log: gapnc64.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:05 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION RGAPNC(A,X)
-#endif
-#if defined(CERNLIB_DOUBLE)
- FUNCTION DGAPNC(A,X)
-#include "gen/imp64.inc"
-#endif
-C Calculates the incomplete gamma function P(A,X) as defined by
-C GSTAR(A,X) in Ref. 1. Based on
-C 1. W. Gautschi, ALGORITHM 542 Incomplete Gamma Functions,
-C ACM Trans. Math. Software 5 (1979) 482-489
-C 2. W. Gautschi, A computational procedure for incomplete gamma
-C functions, ACM Trans. Math. Software 5 (1979) 466-481
-
- CHARACTER NAME*(*)
- CHARACTER*80 ERRTXT
-#if !defined(CERNLIB_DOUBLE)
- PARAMETER (NAME = 'RGAPNC')
-#endif
-#if defined(CERNLIB_DOUBLE)
- PARAMETER (NAME = 'RGAPNC/DGAPNC')
-#endif
- PARAMETER (EPS = 5D-14)
- PARAMETER (ALH = -0.69314 71805 59945 31D0)
- PARAMETER (Z1 = 1, HALF = Z1/2, QUAR = Z1/4)
- PARAMETER (C1 = 3*Z1/2, KMAX = 600, EPS1 = EPS/100)
-
- DIMENSION C(25)
-
- DATA C( 1) / 0.57721 56649 01532 86D0/
- DATA C( 2) /-0.65587 80715 20253 88D0/
- DATA C( 3) /-0.04200 26350 34095 24D0/
- DATA C( 4) / 0.16653 86113 82291 49D0/
- DATA C( 5) /-0.04219 77345 55544 34D0/
- DATA C( 6) /-0.00962 19715 27876 97D0/
- DATA C( 7) / 0.00721 89432 46663 10D0/
- DATA C( 8) /-0.00116 51675 91859 07D0/
- DATA C( 9) /-0.00021 52416 74114 95D0/
- DATA C(10) / 0.00012 80502 82388 12D0/
- DATA C(11) /-0.00002 01348 54780 79D0/
- DATA C(12) /-0.00000 12504 93482 14D0/
- DATA C(13) / 0.00000 11330 27231 98D0/
- DATA C(14) /-0.00000 02056 33841 70D0/
- DATA C(15) / 0.00000 00061 16095 10D0/
- DATA C(16) / 0.00000 00050 02007 64D0/
- DATA C(17) /-0.00000 00011 81274 57D0/
- DATA C(18) / 0.00000 00001 04342 67D0/
- DATA C(19) / 0.00000 00000 07782 26D0/
- DATA C(20) /-0.00000 00000 03696 81D0/
- DATA C(21) / 0.00000 00000 00510 04D0/
- DATA C(22) /-0.00000 00000 00020 58D0/
- DATA C(23) /-0.00000 00000 00005 35D0/
- DATA C(24) / 0.00000 00000 00001 23D0/
- DATA C(25) /-0.00000 00000 00000 12D0/
-
-#if !defined(CERNLIB_DOUBLE)
- GLGAMA(V)=ALGAMA(V)
-#endif
-#if defined(CERNLIB_DOUBLE)
- GLGAMA(V)=DLGAMA(V)
-#endif
-
- HST=0
- IF(X .LT. 0) THEN
- WRITE(ERRTXT,101) X
- CALL MTLPRT(NAME,'C334.1',ERRTXT)
- GO TO 99
- ELSEIF(X .EQ. 0) THEN
- IF(A .LT. 0) THEN
- WRITE(ERRTXT,102) A
- CALL MTLPRT(NAME,'C334.2',ERRTXT)
- ELSEIF(A .EQ. 0) THEN
- HST=1
- ENDIF
- GO TO 99
- ELSE
- ALX=LOG(X)
- ENDIF
- IF(X .LT. QUAR) THEN
- ALFA=ALH/ALX
- ELSE
- ALFA=X+QUAR
- ENDIF
- MA=HALF-A
- AEPS=A+MA
-
- IF(MA .GT. 0) THEN
- IF(AEPS .NE. 0) THEN
- SG=(-1)**(MA-1)*SIGN(Z1,A)*SIGN(Z1,AEPS)
- ALGP1=GLGAMA(1+AEPS)-LOG(ABS(AEPS))
- IF(MA .NE. 1) ALGP1=ALGP1+GLGAMA(1-AEPS)-GLGAMA(MA-AEPS)
- ELSE
- SG=0
- ALGP1=0
- ENDIF
- ELSE
- SG=SIGN(Z1,A)
- ALGP1=GLGAMA(1+A)
- ENDIF
- IF(A .GT. ALFA) THEN
- TERM=1
- SUM=1
- DO 1 K = 1,KMAX
- TERM=X*TERM/(A+K)
- SUM=SUM+TERM
- IF(ABS(TERM) .LE. EPS*SUM) GO TO 2
- 1 CONTINUE
- GO TO 98
- 2 HST=EXP(A*ALX-X+LOG(SUM)-ALGP1)
- ELSEIF(X .GT. C1) THEN
- P=0
- S=1-A
- Q=(X+S)*(X-1-A)
- R=4*(X+S)
- TERM=1
- SUM=1
- RHO=0
- DO 3 K = 2,KMAX
- P=P+S
- Q=Q+R
- R=R+8
- S=S+2
- T=P*(1+RHO)
- RHO=T/(Q-T)
- TERM=RHO*TERM
- SUM=SUM+TERM
- IF(ABS(TERM) .LE. EPS*SUM) GO TO 4
- 3 CONTINUE
- GO TO 98
- 4 IF(A .LT. 0) THEN
- HST=1
- IF(MA .LT. 0 .OR. AEPS .NE. 0)
- 1 HST=1-SG*EXP(LOG(ABS(A)*SUM/(X+1-A))-X+A*ALX-ALGP1)
- ELSEIF(A .EQ. 0) THEN
- HST=1
- ELSE
- HST=1-EXP(A*ALX-X+LOG(A*SUM/(X+1-A))-ALGP1)
- ENDIF
- ELSE
- AE=A
- IF(A .LT. HALF) THEN
- IF(A .LT. -HALF) AE=AEPS
- SUM=C(25)
- DO 12 K = 24,1,-1
- 12 SUM=AE*SUM+C(K)
- GA=-SUM/(1+AE*SUM)
- Y=AE*ALX
- IF(ABS(Y) .GE. 1) THEN
- U=GA-(EXP(Y)-1)/AE
- ELSE
- SUM=1
- TERM=1
- DO 7 K = 2,KMAX
- TERM=Y*TERM/K
- SUM=SUM+TERM
- IF(ABS(TERM) .LE. EPS1*SUM) GO TO 8
- 7 CONTINUE
- GO TO 98
- 8 U=GA-SUM*ALX
- ENDIF
- ELSE
- U=EXP(GLGAMA(A))-X**A/A
- ENDIF
- P=AE*X
- Q=AE+1
- R=AE+3
- TERM=1
- SUM=1
- DO 9 K = 2,KMAX
- P=P+X
- Q=Q+R
- R=R+2
- TERM=-P*TERM/Q
- SUM=SUM+TERM
- IF(ABS(TERM) .LE. EPS1*SUM) GO TO 10
- 9 CONTINUE
- GO TO 98
- 10 H=U+X**(AE+1)*SUM/(AE+1)
- IF(A .LT. -HALF) THEN
- H=H*EXP(X-AE*ALX)
- DO 13 J = 1,MA
- 13 H=(1-X*H)/(J-AE)
- HST=1
- IF(MA .LT. 0 .OR. AEPS .NE. 0)
- 1 HST=1-SG*EXP(LOG(ABS(A)*H)-X+A*ALX-ALGP1)
- ELSEIF(A .EQ. 0) THEN
- HST=1
- ELSE
- HST=1-A*H*EXP(-ALGP1)
- ENDIF
- ENDIF
-#if defined(CERNLIB_DOUBLE)
- 99 DGAPNC=HST
-#endif
-#if !defined(CERNLIB_DOUBLE)
- 99 RGAPNC=HST
-#endif
- RETURN
-
- 98 WRITE(ERRTXT,103) A,X
- CALL MTLPRT(NAME,'C334.3',ERRTXT)
- GO TO 99
- 101 FORMAT('ILLEGAL ARGUMENT X = ',1P,D15.8,' < 0')
- 102 FORMAT('ILLEGAL ARGUMENTS A = ',1P,D15.8,' < 0, X = 0')
- 103 FORMAT('PROBLEMS WITH CONVERGENCE, A = ',1P,D15.8,' X = ',D15.8)
- END
diff --git a/src/mathlib/gen/c/gcmpfun.inc b/src/mathlib/gen/c/gcmpfun.inc
deleted file mode 100644
index 6208297..0000000
--- a/src/mathlib/gen/c/gcmpfun.inc
+++ /dev/null
@@ -1,45 +0,0 @@
-*
-* $Id: gcmpfun.inc,v 1.1.1.1 1996/04/01 15:02:12 mclareni Exp $
-*
-* $Log: gcmpfun.inc,v $
-* Revision 1.1.1.1 1996/04/01 15:02:12 mclareni
-* Mathlib gen
-*
-*
-*
-* gcmpfun.inc
-*
-#if (defined(CERNLIB_DOUBLE))&&(!defined(CERNLIB_F90))&&(defined(CERNLIB_LINUX)||!defined(CERNLIB_QF2C))
-#include "def64.inc"
- + GREAL,GIMAG,XARG,YARG
-#include "defc64.inc"
- + ZARG,GCONJG,GCMPLX
- GREAL( ZARG)=DREAL( ZARG)
- GIMAG( ZARG)=DIMAG( ZARG)
- GCONJG(ZARG)=DCONJG(ZARG)
- GCMPLX(XARG,YARG)=DCMPLX(XARG,YARG)
-#endif
-#if (defined(CERNLIB_DOUBLE))&&(defined(CERNLIB_QF2C))&&(!defined(CERNLIB_LINUX))
-#include "def64.inc"
- + GREAL,GIMAG,XARG,YARG
-#include "defc64.inc"
- + ZARG,GCONJG,GCMPLX
-#endif
-#if (defined(CERNLIB_DOUBLE))&&(defined(CERNLIB_F90))
-#include "def64.inc"
- + GREAL,GIMAG,XARG,YARG
-#include "defc64.inc"
- + ZARG,GCONJG,GCMPLX
- GREAL( ZARG)= REAL( ZARG,2)
- GIMAG( ZARG)=AIMAG( ZARG)
- GCONJG(ZARG)= CONJG(ZARG)
- GCMPLX(XARG,YARG)= CMPLX(XARG,YARG,2)
-#endif
-#include "def64.inc"
- + GREAL,GIMAG,XARG,YARG
-#include "defc64.inc"
- + ZARG,GCONJG,GCMPLX
- GREAL( ZARG)=REAL( ZARG)
- GIMAG( ZARG)=AIMAG(ZARG)
- GCONJG(ZARG)=CONJG(ZARG)
- GCMPLX(XARG,YARG)= CMPLX(XARG,YARG)
diff --git a/src/mathlib/gen/c/hypgm.F b/src/mathlib/gen/c/hypgm.F
deleted file mode 100644
index 41901ef..0000000
--- a/src/mathlib/gen/c/hypgm.F
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: hypgm.F,v 1.1.1.1 1996/04/01 15:01:58 mclareni Exp $
-*
-* $Log: hypgm.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:58 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE HYPGM(A,B,C,Z,H,ACC,NCVG)
- COMPLEX A,B,C,Z,H,AA,BB,CC,ZZ,ADD,DD,HH
- NCVG=0
- ZZ=Z
- HH=(1.0,0.0)
- AA=A
- BB=B
- CC=C
- ADD=(1.0,0.0)
- DD=(1.0,0.0)
- DO 21 I=1,50
- ADD=ADD*ZZ*AA/DD*BB/CC
- HH=HH+ADD
- IF(CRIT(HH,ADD,ACC))3,4,4
- 4 AA=AA+1.0
- BB=BB+1.0
- CC=CC+1.0
- DD=DD+1.0
- 21 CONTINUE
- NCVG=1
- 3 H=HH
- RETURN
- END
diff --git a/src/mathlib/gen/c/impc64.inc b/src/mathlib/gen/c/impc64.inc
deleted file mode 100644
index ee525ff..0000000
--- a/src/mathlib/gen/c/impc64.inc
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: impc64.inc,v 1.1.1.1 1996/04/01 15:02:13 mclareni Exp $
-*
-* $Log: impc64.inc,v $
-* Revision 1.1.1.1 1996/04/01 15:02:13 mclareni
-* Mathlib gen
-*
-*
-*
-* impc64.inc
-*
-#if (defined(CERNLIB_DOUBLE))&&(defined(CERNLIB_F90))
- IMPLICIT COMPLEX(2) (A-H,I,O-Z)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- IMPLICIT COMPLEX (A-H,I,O-Z)
-#endif
- IMPLICIT COMPLEX*16 (A-H,I,O-Z)
diff --git a/src/mathlib/gen/c/leg1.F b/src/mathlib/gen/c/leg1.F
deleted file mode 100644
index 7cdd768..0000000
--- a/src/mathlib/gen/c/leg1.F
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: leg1.F,v 1.1.1.1 1996/04/01 15:01:58 mclareni Exp $
-*
-* $Log: leg1.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:58 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE LEG1
-#include "legbl.inc"
- 1,SIGMA,FAC
- 2,CLOGOK,CDIGAM
- DATA GAMMA/0.5772156649/
- A=-VV
- B=VV+1.0
- C=(1.0,0.0)
- CALL HYPGM(A,B,C,Z1,PP,ACC,NCVG)
- SIGMA=(0.0,0.0)
- FAC=(1.0,0.0)
- A=0.5*CLOGOK((ZZ+1.0)/(ZZ-1.0),NFRIG,1)-GAMMA-CDIGAM(B)
- QQ=A
- DO 17 L=1,50
- EL=L
- SIGMA=SIGMA+1.0/EL
- FAC=-FAC*(VV+EL)*(VV-EL+1.0)*Z1/(EL*EL)
- B=(A+SIGMA)*FAC
- QQ=QQ+B
- IF(CRIT(QQ,B,ACC))80,17,17
- 17 CONTINUE
- NCVG=NCVG+2
- 80 RETURN
- END
diff --git a/src/mathlib/gen/c/legbl.inc b/src/mathlib/gen/c/legbl.inc
deleted file mode 100644
index 5a30e43..0000000
--- a/src/mathlib/gen/c/legbl.inc
+++ /dev/null
@@ -1,14 +0,0 @@
-*
-* $Id: legbl.inc,v 1.1.1.1 1996/04/01 15:01:58 mclareni Exp $
-*
-* $Log: legbl.inc,v $
-* Revision 1.1.1.1 1996/04/01 15:01:58 mclareni
-* Mathlib gen
-*
-*
-*
-* legbl.inc
-*
- COMMON/LEGBL/VV,ZZ,PP,QQ,ACC,NCVG,Z1,Z2,CVV,SVV,NFRIG,XDUMX,U
- 1,PISR,PI,A,B,C,GR,R1,R2,R3,R4,ZZ1,ZZ2,SRZ
- COMPLEX VV,ZZ,PP,QQ,Z1,Z2,U,A,B,C,GR,CVV,SVV,ZZ1,ZZ2,SRZ
diff --git a/src/mathlib/gen/c/legfn.F b/src/mathlib/gen/c/legfn.F
deleted file mode 100644
index 9f70363..0000000
--- a/src/mathlib/gen/c/legfn.F
+++ /dev/null
@@ -1,157 +0,0 @@
-*
-* $Id: legfn.F,v 1.1.1.1 1996/04/01 15:01:59 mclareni Exp $
-*
-* $Log: legfn.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:59 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE LEGFN (V,Z,P,Q,NC,NF)
-#include "legbl.inc"
- 1,V,Z,P,Q
- 2,ZZS,CISP,CISM,PT,VVP,ZZZ
- 3,CSQRTK
- DATA AC/0.0000001/
-#if (defined(CERNLIB_CDC))&&(defined(CERNLIB_F4))
- DATA QINF/37770000000000000000B/
-#endif
-#if (defined(CERNLIB_CDC))&&(!defined(CERNLIB_F4))
- DATA QINF/O"37770000000000000000"/
-#endif
-#if defined(CERNLIB_IBM)
- DATA QINF/.1E70/
-#endif
-#if (!defined(CERNLIB_CDC))&&(!defined(CERNLIB_IBM))
- DATA QINF / .1E36/
-#endif
- CALL C311BD
- ACC=AC**2
- IF(REAL(V)+0.5) 16,17,17
- 16 VV=-V-1.0
- GOTO 18
- 17 VV=V
-C--- It seems that NIC311 expects a REAL argument
-C NVV=NIC311(VV)
- 18 NVV=NIC311(REAL(VV))
-C*UL 30 VVP=VV*PI
- VVP=VV*PI
- GOTO (21,22,23,24,25),NVV
- 21 SV=1.0
- GOTO 26
- 23 SV=-1.0
- 26 CV=0.0
- GOTO 28
- 22 CV=-1.0
- GOTO 27
- 24 CV=1.0
- 27 SV=0.0
- GOTO 28
- 25 SV=SIN(REAL(VVP))
- CV=COS(REAL(VVP))
- 28 EIP=EXP(AIMAG(VVP))
- EIM=EXP(-AIMAG(VVP))
- SHV=0.5*(EIP-EIM)
- CHV=0.5*(EIP+EIM)
- SVV=SV*CHV+U*CV*SHV
- CVV=CV*CHV-U*SV*SHV
- CISP=CVV+U*SVV
- CISM=CVV-U*SVV
- IF(REAL(Z))9,10,11
- 9 ZZ=-Z
- N23=3
- NFF=-NF
- GOTO 12
- 10 N24=4
- ZZ=Z
- IF(AIMAG(ZZ))13,77,13
- 11 ZZ=Z
- N23=2
- NFF=NF
- 12 N24=2
- 13 ZZS=ZZ**2
- Z1=(1.0-ZZ)/2.0
- IF(AIMAG(ZZ))7,6,7
- 6 IF(REAL(Z1))4,70,5
- 4 NFRIG=SIGN(N23,NFF)
- GOTO 8
- 5 NFRIG=NFF
- GOTO 8
- 7 NFRIG=SIGN(REAL(N24),AIMAG(ZZ))
- 8 Z2=1.0/ZZS
- SRZ=CSQRTK(ZZS-1.0,NFRIG,1)
- ZZ1=(ZZ+SRZ)/(2.0*SRZ)
- ZZ2=(-ZZ+SRZ)/(2.0*SRZ)
- IF(REAL(Z))1,2,2
- 1 SRZ=-SRZ
- 2 ZZZ=ZZ
- ZZ=Z
- VR=REAL(VV)**2
- VI=AIMAG(VV)**2
- R1=ABS(Z1)
- R2=ABS(Z2)
- R3=ABS(ZZ1)
- R4=ABS(ZZ2)
- IF(R1-R2)61,61,62
- 61 RR=MAX(R3,R4)/0.045-19.5
- IF(RR)66,66,65
- 65 VRI=VR+VI
- IF(VRI)165,67,165
- 165 IF(RR**2-VRI+VI**2/(2.0*VRI))66,67,67
- 66 CALL LEGV
- IF(NCVG)166,97,166
- 166 ZZ=ZZZ
- CALL LEG1
- GOTO 90
- 67 ZZ=ZZZ
- CALL LEG1
- IF(NCVG)167,90,167
- 167 ZZ=Z
- CALL LEGV
- GOTO 97
- 62 IF(VR+VI-16.0*R2**2)63,64,64
- 64 CALL LEGV
- IF(NCVG)164,97,164
- 164 CALL LEGZ
- GOTO 97
- 63 CALL LEGZ
- IF(NCVG)163,97,163
- 163 CALL LEGV
- GOTO 97
- 90 IF(REAL(Z)) 93,97,97
- 93 PT=-2.0/PI*SVV*QQ
- IF(NFRIG) 94,95,96
- 94 PP=CISP*PP+PT
- QQ=-CISM*QQ
- GOTO 97
- 95 QQ=-CVV*QQ-PI/2.0*SVV*PP
- PP=CVV*PP+PT
- GOTO 97
- 96 PP=CISM*PP+PT
- QQ=-CISP*QQ
- GOTO 97
- 97 IF(REAL(V)+0.5) 91,92,92
- 91 IF(ABS(SVV).NE.0.) GOTO 98
- QQ=QINF
- GOTO 92
- 98 QQ=(QQ*SVV-PI*CVV*PP)/SVV
- 92 P=PP
- Q=QQ
- NC=NCVG
- RETURN
- 70 QQ=QINF
-C
- IF(REAL(Z))173,173,74
- 173 IF(AIMAG(V))71,73,71
- 73 GOTO (71,72,71,74,71),NVV
- 71 PP=QQ
- GOTO 82
- 72 PP=-1.0
- GOTO 82
- 74 PP=1.0
- GOTO 82
- 77 NFRIG=NF
- CALL LEGOR
- 82 NCVG=0
- GOTO 92
- END
diff --git a/src/mathlib/gen/c/legor.F b/src/mathlib/gen/c/legor.F
deleted file mode 100644
index a503593..0000000
--- a/src/mathlib/gen/c/legor.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: legor.F,v 1.1.1.1 1996/04/01 15:01:59 mclareni Exp $
-*
-* $Log: legor.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:59 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE LEGOR
-#include "legbl.inc"
- 1,RGAM
- A=0.5*(1.0+VV)
- B=0.0
- C=0.5
- GR=RGAM(A,B,C)
- C=U*PI*VV*0.5
- A=EXP(C)
- B=EXP(-C)
- IF(NFRIG)9,10,11
- 9 QQ=PISR*0.5*GR*U*A
- GOTO 12
- 10 QQ=U*PISR/4.0*GR*(A-B)
- GOTO 12
- 11 QQ=-PISR/2.0*GR*B*U
- 12 PP=GR*(A+B)/(2.0*PISR)
- RETURN
- END
diff --git a/src/mathlib/gen/c/legv.F b/src/mathlib/gen/c/legv.F
deleted file mode 100644
index 6223071..0000000
--- a/src/mathlib/gen/c/legv.F
+++ /dev/null
@@ -1,36 +0,0 @@
-*
-* $Id: legv.F,v 1.1.1.1 1996/04/01 15:01:59 mclareni Exp $
-*
-* $Log: legv.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:59 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE LEGV
-#include "legbl.inc"
- 1,F1,F2,SSRZ
- 2,CLOGOK,CSQRTK,RGAM
- A=0.5
- C=VV+1.5
- CALL HYPGM(A,A,C,ZZ1,F1,ACC,NCVG)
- CALL HYPGM(A,A,C,ZZ2,F2,ACC,NCV )
- NCVG=NCVG+2*NCV
-C*UL6 F1=F1*EXP((VV+0.5)*CLOGOK(ZZ +SRZ,NFRIG,3))
- F1=F1*EXP((VV+0.5)*CLOGOK(ZZ +SRZ,NFRIG,3))
- F2=F2*EXP((VV+0.5)*CLOGOK(ZZ -SRZ,-NFRIG,3))
- A=1.5
- B=1.0
- SSRZ=CSQRTK(2.0*SRZ,NFRIG,2)*RGAM(VV,A,B)
- SGN=1.0
- IF(AIMAG(ZZ))8,14,12
- 8 SGN=-1.0
- GOTO 12
- 14 SGN=SIGN(1.0,(NFRIG+0.5)*REAL(ZZ))
- 12 PP=(F1+SGN*U*F2)/(PISR*SSRZ)
- IF(NFRIG)11,10,11
- 10 QQ=0.5*PISR*(F2+SGN*U*F1)/SSRZ
- GOTO 80
- 11 QQ=PISR*F2/SSRZ
- 80 RETURN
- END
diff --git a/src/mathlib/gen/c/legz.F b/src/mathlib/gen/c/legz.F
deleted file mode 100644
index d81e5f3..0000000
--- a/src/mathlib/gen/c/legz.F
+++ /dev/null
@@ -1,37 +0,0 @@
-*
-* $Id: legz.F,v 1.1.1.1 1996/04/01 15:01:59 mclareni Exp $
-*
-* $Log: legz.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:59 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE LEGZ
-#include "legbl.inc"
- 1,F1,F2,ZV
- 2,CLOGOK,RGAM
- GR=CLOGOK(2.0*ZZ,NFRIG,2)
- A=1.5
- B=1.0
- ZV=RGAM(VV,A,B)*EXP(VV*GR)
- A=VV/2.0+1.0
- B=VV/2.0+0.5
- C=VV+1.5
- ACCC=ACC/100.
- CALL HYPGM(A,B,C,Z2,F1,ACCC,NCVG)
- F1=F1/(2.0*ZZ*ZV)
- QQ=PISR*F1
- IF(ABS(CVV).GT.0.001) GOTO 9
-C TRDZ EXPECTS GR=CLOGOK(2.0*ZZ,NFRIG,2) BUT DESTROYS CONTENTS
- CALL TRDZ
- GOTO 80
- 9 A=-VV/2.0
- B=(1.0-VV)/2.0
- C=0.5-VV
- CALL HYPGM(A,B,C,Z2,F2,ACCC,NCV )
- NCVG=NCVG+2*NCV
- F2=F2*ZV/(VV+0.5)
- PP=(F1*SVV/CVV+F2)/PISR
- 80 RETURN
- END
diff --git a/src/mathlib/gen/c/nic311.F b/src/mathlib/gen/c/nic311.F
deleted file mode 100644
index 42cc3a4..0000000
--- a/src/mathlib/gen/c/nic311.F
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: nic311.F,v 1.1.1.1 1996/04/01 15:01:59 mclareni Exp $
-*
-* $Log: nic311.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:59 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- FUNCTION NIC311(X)
-C X=1/2 OF 4N+1 SET NIC311=1
-C X=1/2 OF 4N+2 SET NIC311=2
-C X=1/2 OF 4N+3 SET NIC311=3
-C X=1/2 OF 4N+4 SET NIC311=4
-C OTHERWISE SET NIC311=5
- Y=X+X
- N=INT(Y)
- IF(Y-N)9,10,9
- 9 NIC311=5
- RETURN
- 10 NIC311=MOD(N,4)
- IF(NIC311.LE.0) NIC311=4+NIC311
- RETURN
- END
diff --git a/src/mathlib/gen/c/nzerfz64.F b/src/mathlib/gen/c/nzerfz64.F
deleted file mode 100644
index 1c42ccc..0000000
--- a/src/mathlib/gen/c/nzerfz64.F
+++ /dev/null
@@ -1,93 +0,0 @@
-*
-* $Id: nzerfz64.F,v 1.1.1.1 1996/04/01 15:01:53 mclareni Exp $
-*
-* $Log: nzerfz64.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:53 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- FUNCTION NZERFZ(F,ZP,N)
-C
-#include "gen/impc64.inc"
-C
- CHARACTER*(*) NAME
- PARAMETER(NAME='NZERFZ')
-#include "gen/def64.inc"
- + W,X,R,EPS,CST,CONST,R1,HF
- DIMENSION ZP(*),W(12),X(12)
-
- PARAMETER (PI = 3.14159 26535 89793 24D0)
-#if defined(CERNLIB_CRAY)
- PARAMETER (I = (0E0,1E0))
-#endif
-#if !defined(CERNLIB_CRAY)
- PARAMETER (I = (0D0,1D0))
-#endif
- PARAMETER ( CPI2 = 2*PI*I)
- PARAMETER (R1 = 1, HF = R1/2, DZ = (1+I)*1D-8)
- PARAMETER (EPS = 1D-4, CST = 0.005D0, NFMAX = 200000)
-
- DATA X( 1) /9.6028985649753623D-1/, W( 1) /1.0122853629037626D-1/
- DATA X( 2) /7.9666647741362674D-1/, W( 2) /2.2238103445337447D-1/
- DATA X( 3) /5.2553240991632899D-1/, W( 3) /3.1370664587788729D-1/
- DATA X( 4) /1.8343464249564980D-1/, W( 4) /3.6268378337836198D-1/
- DATA X( 5) /9.8940093499164993D-1/, W( 5) /2.7152459411754095D-2/
- DATA X( 6) /9.4457502307323258D-1/, W( 6) /6.2253523938647893D-2/
- DATA X( 7) /8.6563120238783174D-1/, W( 7) /9.5158511682492785D-2/
- DATA X( 8) /7.5540440835500303D-1/, W( 8) /1.2462897125553387D-1/
- DATA X( 9) /6.1787624440264375D-1/, W( 9) /1.4959598881657673D-1/
- DATA X(10) /4.5801677765722739D-1/, W(10) /1.6915651939500254D-1/
- DATA X(11) /2.8160355077925891D-1/, W(11) /1.8260341504492359D-1/
- DATA X(12) /9.5012509837637440D-2/, W(12) /1.8945061045506850D-1/
-
- H=0
- DO 10 J = 1,N
- NF=0
- A=ZP(J)
- IF(J .LT. N) THEN
- B=ZP(J+1)
- ELSE
- B=ZP(1)
- ENDIF
- IF(B .EQ. A) GO TO 10
- CONST=CST/ABS(B-A)
- BB=A
- 1 AA=BB
- BB=B
- 2 C1=HF*(BB+AA)
- C2=HF*(BB-AA)
- S8=0
- DO 3 K = 1,4
- U=C2*X(K)
- FPP=F(C1+U+DZ)
- FPM=F(C1+U-DZ)
- FMP=F(C1-U+DZ)
- FMM=F(C1-U-DZ)
- 3 S8=S8+W(K)*(((FPP-FPM)/DZ)/(FPP+FPM)+((FMP-FMM)/DZ)/(FMP+FMM))
- S16=0
- DO 4 K = 5,12
- U=C2*X(K)
- FPP=F(C1+U+DZ)
- FPM=F(C1+U-DZ)
- FMP=F(C1-U+DZ)
- FMM=F(C1-U-DZ)
- 4 S16=S16+W(K)*(((FPP-FPM)/DZ)/(FPP+FPM)+((FMP-FMM)/DZ)/(FMP+FMM))
- S16=C2*S16
- NF=NF+48
- IF(ABS(S16-C2*S8) .LE. EPS*(1+ABS(S16))) THEN
- H=H+S16
- IF(BB .NE. B) GO TO 1
- ELSE
- BB=C1
- IF(1+CONST*ABS(C2) .NE. 1 .AND. NF .LE. NFMAX) GO TO 2
- R=0
- CALL MTLPRT(NAME,'C210.1','PROBLEMS WITH INTEGRATION,'//
- + 'POLYGON TOO NEAR TO A ZERO OR SINGULARITY ?')
- GO TO 99
- ENDIF
- 10 CONTINUE
- R=H/CPI2
- 99 NZERFZ=NINT(ABS(R))
- RETURN
- END
diff --git a/src/mathlib/gen/c/qfunct.F b/src/mathlib/gen/c/qfunct.F
deleted file mode 100644
index cd6d6cd..0000000
--- a/src/mathlib/gen/c/qfunct.F
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: qfunct.F,v 1.1.1.1 1996/04/01 15:02:00 mclareni Exp $
-*
-* $Log: qfunct.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:00 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE QFUNCT(XK,XKPRIM,Q)
- XKPRIM=SQRT(1.-XK**2)
- A=MAX(ABS(XK),XKPRIM)
- EPSI=(1.-A)/(2.*A+4.*SQRT(A)+2.)
- E=EPSI**4
- Q=EPSI+EPSI*E*(2.+E*(15.+E*150.))
- IF(XKPRIM.LT.A) Q=EXP(9.869604401089359/LOG(Q))
- RETURN
- END
diff --git a/src/mathlib/gen/c/r1dp.F b/src/mathlib/gen/c/r1dp.F
deleted file mode 100644
index 790f484..0000000
--- a/src/mathlib/gen/c/r1dp.F
+++ /dev/null
@@ -1,67 +0,0 @@
-*
-* $Id: r1dp.F,v 1.1.1.1 1996/04/01 15:01:56 mclareni Exp $
-*
-* $Log: r1dp.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:56 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- FUNCTION C309R1(X,ETA,ZL,PM,EPS,LIMIT,ERR,NPQ,ACC8,ACCH,
- 1 LPR,ACCUR,DELL)
-C
-C (omega) (omega)
-C *** Evaluate CF2 = p + PM.q = H (ETA,X)' / H (ETA,X)
-C ZL ZL
-C where PM = omega.i
-C
- IMPLICIT COMPLEX*16(A-H,O-Z)
- LOGICAL LPR
- DOUBLE PRECISION EPS,ERR,ACC8,ACCH,ACCUR,TA,RK
- DOUBLE PRECISION ABSC,HALF
-
- PARAMETER(HALF = 1D0/2D0)
-
-#if defined(CERNLIB_QF2C)
-#include "defdr.inc"
-#endif
- ABSC(W)=ABS(DREAL(W))+ABS(DIMAG(W))
-
- TA=LIMIT+LIMIT
- ETAP=ETA*PM
- XI=1/X
- WI=ETAP+ETAP
- RK=0
- PQ=(1-ETA*XI)*PM
- AA=-(ETA*ETA+ZL*ZL+ZL)+ETAP
- BB=2*(X-ETA+PM)
- RL=XI*PM
- IF(ABSC(BB) .LT. ACCH) THEN
- RL=RL*AA/(AA+RK+WI)
- PQ=PQ+RL*(BB+PM+PM)
- AA=AA+2*(RK+1+WI)
- BB=BB+4*PM
- RK=RK+4
- END IF
- DD=1/BB
- DL=AA*DD*RL
- 10 PQ=PQ+DL
- RK=RK+2
- AA=AA+RK+WI
- BB=BB+PM+PM
- DD=1/(AA*DD+BB)
- DL=DL*(BB*DD-1)
- ERR=ABSC(DL)/ABSC(PQ)
- IF(ERR .GE. MAX(EPS,ACC8*RK*HALF) .AND. RK .LE. TA) GO TO 10
-C
- NPQ=HALF*RK
- C309R1=PQ+DL
- IF(LPR .AND. NPQ .GE. LIMIT-1 .AND. ERR .GT. ACCUR)
- 1 WRITE(6,1000) INT(DIMAG(PM)),NPQ,ERR,ZL+DELL
- RETURN
- 1000 FORMAT(1X,'***** CERN C309 WCLBES ... ',
- 2 'CF2(',I2,') NOT CONVERGED FULLY IN ',I7,' ITERATIONS'/1X,27X,
- 3 'ERROR IN IRREGULAR SOLUTION =',1P,D11.2,' AT ZL = ',2F8.3)
- END
-#endif
diff --git a/src/mathlib/gen/c/r1sp.F b/src/mathlib/gen/c/r1sp.F
deleted file mode 100644
index 9183b6d..0000000
--- a/src/mathlib/gen/c/r1sp.F
+++ /dev/null
@@ -1,64 +0,0 @@
-*
-* $Id: r1sp.F,v 1.1.1.1 1996/04/01 15:01:56 mclareni Exp $
-*
-* $Log: r1sp.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:56 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_SINGLE)
- FUNCTION C309R1(X,ETA,ZL,PM,EPS,LIMIT,ERR,NPQ,ACC8,ACCH,
- 1 LPR,ACCUR,DELL)
-C
-C (omega) (omega)
-C *** Evaluate CF2 = p + PM.q = H (ETA,X)' / H (ETA,X)
-C ZL ZL
-C where PM = omega.i
-C
- IMPLICIT COMPLEX(A-H,O-Z)
- LOGICAL LPR
- REAL EPS,ERR,ACC8,ACCH,ACCUR,TA,RK
- REAL ABSC,HALF
-
- PARAMETER(HALF = 1D0/2D0)
-
- ABSC(W)=ABS(REAL(W))+ABS(AIMAG(W))
-
- TA=LIMIT+LIMIT
- ETAP=ETA*PM
- XI=1/X
- WI=ETAP+ETAP
- RK=0
- PQ=(1-ETA*XI)*PM
- AA=-(ETA*ETA+ZL*ZL+ZL)+ETAP
- BB=2*(X-ETA+PM)
- RL=XI*PM
- IF(ABSC(BB) .LT. ACCH) THEN
- RL=RL*AA/(AA+RK+WI)
- PQ=PQ+RL*(BB+PM+PM)
- AA=AA+2*(RK+1+WI)
- BB=BB+4*PM
- RK=RK+4
- END IF
- DD=1/BB
- DL=AA*DD*RL
- 10 PQ=PQ+DL
- RK=RK+2
- AA=AA+RK+WI
- BB=BB+PM+PM
- DD=1/(AA*DD+BB)
- DL=DL*(BB*DD-1)
- ERR=ABSC(DL)/ABSC(PQ)
- IF(ERR .GE. MAX(EPS,ACC8*RK*HALF) .AND. RK .LE. TA) GO TO 10
-C
- NPQ=HALF*RK
- C309R1=PQ+DL
- IF(LPR .AND. NPQ .GE. LIMIT-1 .AND. ERR .GT. ACCUR)
- 1 WRITE(6,1000) INT(AIMAG(PM)),NPQ,ERR,ZL+DELL
- RETURN
- 1000 FORMAT(1X,'***** CERN C309 CCLBES ... ',
- 2 'CF2(',I2,') NOT CONVERGED FULLY IN ',I7,' ITERATIONS'/1X,27X,
- 3 'ERROR IN IRREGULAR SOLUTION =',1P,D11.2,' AT ZL = ',2F8.3)
- END
-#endif
diff --git a/src/mathlib/gen/c/r2dp.F b/src/mathlib/gen/c/r2dp.F
deleted file mode 100644
index 73c75c4..0000000
--- a/src/mathlib/gen/c/r2dp.F
+++ /dev/null
@@ -1,128 +0,0 @@
-*
-* $Id: r2dp.F,v 1.1.1.1 1996/04/01 15:01:56 mclareni Exp $
-*
-* $Log: r2dp.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:56 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- FUNCTION C309R2(X,ETA,ZL,P,EPS,LIMIT,KIND,ERR,NITS,
- 1 FPMAX,ACC8,ACC16)
-C
-C *** evaluate the HYPERGEOMETRIC FUNCTION
-C i
-C F (AA;BB; Z) = SUM (AA) Z / ( (BB) i! )
-C 1 1 i i i
-C
-C to accuracy EPS with at most LIMIT terms.
-C If KIND = 0 : using extended precision but real arithmetic only,
-C 1 : using normal precision in complex arithmetic,
-C or 2 : using normal complex arithmetic, but with WDIGAM factor
-C
-C where AA, BB, and Z are defined below
-C
- IMPLICIT DOUBLE PRECISION(A-H,O-Z)
- COMPLEX*16 X,ETA,ZL,P,AA,BB,Z,C309R2,WDIGAM
- COMPLEX*16 DD,G,F,AI,BI,T
-#if (!defined(CERNLIB_UNIX))&&(!defined(CERNLIB_QMALPH))
- REAL*16 AR,BR,GR,GI,DR,DI,TR,TI,UR,UI,FI,FI1,DEN
-#endif
-#if defined(CERNLIB_UNIX)||defined(CERNLIB_QMALPH)
- DOUBLE PRECISION AR,BR,GR,GI,DR,DI,TR,TI,UR,UI,FI,FI1,DEN
-#endif
-
- PARAMETER(TBBB = 3D0/2D0)
-
-#if defined(CERNLIB_QF2C)
-#include "defdr.inc"
-#endif
-
- ABSC(AA)=ABS(DREAL(AA))+ABS(DIMAG(AA))
- NINTC(AA)=NINT(DREAL(AA))
-
- C309R2 = 0.
-
- AA=ZL+1-ETA*P
- BB=2*ZL+2
- Z=2*P*X
- IF(DREAL(BB) .LE. 0 .AND. ABS(BB-NINTC(BB)) .LT.
- 1 SQRT(SQRT(ACC8))**3 .AND. DREAL(BB)+LIMIT .GE. TBBB) THEN
- NITS=-1
- RETURN
- END IF
- IF(LIMIT .LE. 0) THEN
- C309R2=0
- ERR=0
- NITS=1
- RETURN
- END IF
- TA=1
- RK=1
- IF(KIND .LE. 0 .AND. ABSC(Z)*ABSC(AA) .GT. ABSC(BB)*1.0) THEN
- DR=1
- DI=0
- GR=1
- GI=0
- AR=DREAL(AA)
- BR=DREAL(BB)
- FI=0
- DO 20 I = 2,LIMIT
- FI1=FI+1
- TR=BR*FI1
- TI=DIMAG(BB)*FI1
- DEN=1/(TR*TR+TI*TI)
- UR=(AR*TR+DIMAG(AA)*TI)*DEN
- UI=(DIMAG(AA)*TR-AR*TI)*DEN
- TR=UR*GR-UI*GI
- TI=UR*GI+UI*GR
- GR=DREAL(Z)*TR-DIMAG(Z)*TI
- GI=DREAL(Z)*TI+DIMAG(Z)*TR
- DR=DR+GR
- DI=DI+GI
- ERR=ABS(GR)+ABS(GI)
- IF(ERR .GT. FPMAX) GO TO 60
- RK=ABS(DR)+ABS(DI)
- TA=MAX(TA,RK)
- IF(ERR .LT. RK*EPS .OR. I .GE. 4 .AND. ERR .LT. ACC16) GO TO 30
- FI=FI1
- AR=AR+1
- 20 BR=BR+1
-C
- 30 C309R2=DR+(0,1)*DI
- ERR=ACC16*TA/RK
- ELSE
-C
-C* If REAL*16 arithmetic is not available, (or already using it!),
-C* then use KIND > 0
-C
- G=1
- F=1
- IF(KIND .GE. 2) F=WDIGAM(AA)-WDIGAM(BB)-WDIGAM(G)
- DD=F
- DO 40 I = 2,LIMIT
- AI=AA+(I-2)
- BI=BB+(I-2)
- R=I-1
- G=G*Z*AI/(BI*R)
-C
-C multiply by (psi(a+r)-psi(b+r)-psi(1+r))
-C
- IF(KIND .EQ. 2) F=F+1/AI-1/BI-1/R
- T=G*F
- DD=DD+T
- ERR=ABSC(T)
- IF(ERR .GT. FPMAX) GO TO 60
- RK=ABSC(DD)
- TA=MAX(TA,RK)
- IF(ERR .LT. RK*EPS .OR. ERR .LT. ACC8 .AND. I .GE. 4) GO TO 50
- 40 CONTINUE
-
- 50 ERR=ACC8*TA/RK
- C309R2=DD
- END IF
- 60 NITS=I
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/c/r2sp.F b/src/mathlib/gen/c/r2sp.F
deleted file mode 100644
index 187b7b4..0000000
--- a/src/mathlib/gen/c/r2sp.F
+++ /dev/null
@@ -1,117 +0,0 @@
-*
-* $Id: r2sp.F,v 1.1.1.1 1996/04/01 15:01:56 mclareni Exp $
-*
-* $Log: r2sp.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:56 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_SINGLE)
- FUNCTION C309R2(X,ETA,ZL,P,EPS,LIMIT,KIND,ERR,NITS,
- 1 FPMAX,ACC8,ACC16)
-C
-C *** evaluate the HYPERGEOMETRIC FUNCTION
-C i
-C F (AA;BB; Z) = SUM (AA) Z / ( (BB) i! )
-C 1 1 i i i
-C
-C to accuracy EPS with at most LIMIT terms.
-C If KIND = 0 : using extended precision but real arithmetic only,
-C 1 : using normal precision in complex arithmetic,
-C or 2 : using normal complex arithmetic, but with CDIGAM factor
-C
-C where AA, BB, and Z are defined below
-C
- IMPLICIT REAL(A-H,O-Z)
- COMPLEX X,ETA,ZL,P,AA,BB,Z,C309R2,CDIGAM
- COMPLEX DD,G,F,AI,BI,T
- DOUBLE PRECISION AR,BR,GR,GI,DR,DI,TR,TI,UR,UI,FI,FI1,DEN
-
- PARAMETER(TBBB = 3D0/2D0)
-
- ABSC(AA)=ABS(REAL(AA))+ABS(AIMAG(AA))
- NINTC(AA)=NINT(REAL(AA))
-
- AA=ZL+1-ETA*P
- BB=2*ZL+2
- Z=2*P*X
- IF(REAL(BB) .LE. 0 .AND. ABS(BB-NINTC(BB)) .LT.
- 1 SQRT(SQRT(ACC8))**3 .AND. REAL(BB)+LIMIT .GE. TBBB) THEN
- NITS=-1
- RETURN
- END IF
- IF(LIMIT .LE. 0) THEN
- C309R2=0
- ERR=0
- NITS=1
- RETURN
- END IF
- TA=1
- RK=1
- IF(KIND .LE. 0 .AND. ABSC(Z)*ABSC(AA) .GT. ABSC(BB)*1.0) THEN
- DR=1
- DI=0
- GR=1
- GI=0
- AR=REAL(AA)
- BR=REAL(BB)
- FI=0
- DO 20 I = 2,LIMIT
- FI1=FI+1
- TR=BR*FI1
- TI=AIMAG(BB)*FI1
- DEN=1/(TR*TR+TI*TI)
- UR=(AR*TR+AIMAG(AA)*TI)*DEN
- UI=(AIMAG(AA)*TR-AR*TI)*DEN
- TR=UR*GR-UI*GI
- TI=UR*GI+UI*GR
- GR=REAL(Z)*TR-AIMAG(Z)*TI
- GI=REAL(Z)*TI+AIMAG(Z)*TR
- DR=DR+GR
- DI=DI+GI
- ERR=ABS(GR)+ABS(GI)
- IF(ERR .GT. FPMAX) GO TO 60
- RK=ABS(DR)+ABS(DI)
- TA=MAX(TA,RK)
- IF(ERR .LT. RK*EPS .OR. I .GE. 4 .AND. ERR .LT. ACC16) GO TO 30
- FI=FI1
- AR=AR+1
- 20 BR=BR+1
-C
- 30 C309R2=DR+(0,1)*DI
- ERR=ACC16*TA/RK
- ELSE
-C
-C* If REAL*16 arithmetic is not available, (or already using it!),
-C* then use KIND > 0
-C
- G=1
- F=1
- IF(KIND .GE. 2) F=CDIGAM(AA)-CDIGAM(BB)-CDIGAM(G)
- DD=F
- DO 40 I = 2,LIMIT
- AI=AA+(I-2)
- BI=BB+(I-2)
- R=I-1
- G=G*Z*AI/(BI*R)
-C
-C multiply by (psi(a+r)-psi(b+r)-psi(1+r))
-C
- IF(KIND .EQ. 2) F=F+1/AI-1/BI-1/R
- T=G*F
- DD=DD+T
- ERR=ABSC(T)
- IF(ERR .GT. FPMAX) GO TO 60
- RK=ABSC(DD)
- TA=MAX(TA,RK)
- IF(ERR .LT. RK*EPS .OR. ERR .LT. ACC8 .AND. I .GE. 4) GO TO 50
- 40 CONTINUE
-
- 50 ERR=ACC8*TA/RK
- C309R2=DD
- END IF
- 60 NITS=I
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/c/r3dp.F b/src/mathlib/gen/c/r3dp.F
deleted file mode 100644
index e052080..0000000
--- a/src/mathlib/gen/c/r3dp.F
+++ /dev/null
@@ -1,99 +0,0 @@
-*
-* $Id: r3dp.F,v 1.1.1.1 1996/04/01 15:01:56 mclareni Exp $
-*
-* $Log: r3dp.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:56 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- FUNCTION C309R3(AA,BB,Z,EPS,JMAX,RE,FPMAX,N,X)
-C
-C evaluate the HYPERGEOMETRIC FUNCTION
-C i
-C F (AA,BB;;Z) = SUM (AA) (BB) Z / i!
-C 2 0 i i i
-C
-C to accuracy EPS with at most JMAX terms.
-C
-C if the terms start diverging,
-C the corresponding continued fraction is found by RCF
-C & evaluated progressively by Steed's method to obtain convergence.
-C
- IMPLICIT COMPLEX*16(A-H,O-Z)
- DIMENSION X(JMAX,4)
- LOGICAL FINITE
- DOUBLE PRECISION EP,EPS,AT,ATL,ABSC,RE,FPMAX
-
-#if defined(CERNLIB_QF2C)
-#include "defdr.inc"
-#endif
- ABSC(W)=ABS(DREAL(W))+ABS(DIMAG(W))
- NINTC(W)=NINT(DREAL(W))
-C
- RE=0
- X(1,1)=1
- SUM=X(1,1)
- ATL=ABSC(X(1,1))
- F=SUM
- D=1
- DF=SUM
- J=0
- EP=EPS*(10*JMAX)
- MA=-NINTC(AA)
- MB=-NINTC(BB)
- FINITE=ABS(ABS(DREAL(AA))-MA) .LT. EP .AND. ABS(DIMAG(AA)) .LT. EP
- 1 .OR. ABS(ABS(DREAL(BB))-MB) .LT. EP .AND. ABS(DIMAG(BB)) .LT. EP
- IMAX=JMAX
- IF(FINITE .AND. MA .GE. 0) IMAX=MIN(MA+1,IMAX)
- IF(FINITE .AND. MB .GE. 0) IMAX=MIN(MB+1,IMAX)
- DO 10 I = 2,IMAX
- X(I,1)=X(I-1,1)*Z*(AA+I-2)*(BB+I-2)/(I-1)
- IF(ABSC(X(I,1)) .GT. FPMAX) THEN
- N=0
- C309R3=SUM
- IF(.NOT.FINITE) RE=AT/ABSC(SUM)
- RETURN
- END IF
- AT=ABSC(X(I,1))
- IF(J .EQ. 0) THEN
- SUM=SUM+X(I,1)
- IF(AT .LT. ABSC(SUM)*EPS) THEN
- N=I
- C309R3=SUM
- IF(.NOT.FINITE) RE=AT/ABSC(SUM)
- RETURN
- END IF
- END IF
- IF(FINITE) GO TO 10
- IF(J .GT. 0 .OR. AT .GT. ATL .OR. I .GE. JMAX-2) J=J+1
- IF(J .EQ. 0) GO TO 10
- CALL C309R7(X(1,1),X(1,2),J,I,X(1,3),EPS)
- IF(I .LT. 0) THEN
- N=0
- C309R3=SUM
- IF(.NOT.FINITE) RE=AT/ABSC(SUM)
- RETURN
- END IF
- DO 50 K = MAX(J,2),I
- D=1/(D*X(K,2)+1)
- DF=DF*D-DF
- F=F+DF
- IF(ABSC(DF) .LT. ABSC(F)*EPS .OR.
- 1 DF .EQ. 0 .AND. F .EQ. 0 .AND. I .GE. 4) THEN
- N=K
- C309R3=F
- RE=ABSC(DF)/ABSC(F)
- RETURN
- END IF
- 50 CONTINUE
- J=I
- 10 ATL=AT
- IF(.NOT.FINITE) I=-JMAX
- N=I
- C309R3=SUM
- IF(.NOT.FINITE) RE=AT/ABSC(SUM)
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/c/r3sp.F b/src/mathlib/gen/c/r3sp.F
deleted file mode 100644
index 289981c..0000000
--- a/src/mathlib/gen/c/r3sp.F
+++ /dev/null
@@ -1,96 +0,0 @@
-*
-* $Id: r3sp.F,v 1.1.1.1 1996/04/01 15:01:57 mclareni Exp $
-*
-* $Log: r3sp.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:57 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_SINGLE)
- FUNCTION C309R3(AA,BB,Z,EPS,JMAX,RE,FPMAX,N,X)
-C
-C evaluate the HYPERGEOMETRIC FUNCTION
-C i
-C F (AA,BB;;Z) = SUM (AA) (BB) Z / i!
-C 2 0 i i i
-C
-C to accuracy EPS with at most JMAX terms.
-C
-C if the terms start diverging,
-C the corresponding continued fraction is found by RCF
-C & evaluated progressively by Steed's method to obtain convergence.
-C
- IMPLICIT COMPLEX(A-H,O-Z)
- DIMENSION X(JMAX,4)
- LOGICAL FINITE
- REAL EP,EPS,AT,ATL,ABSC,RE,FPMAX
-
- ABSC(W)=ABS(REAL(W))+ABS(AIMAG(W))
- NINTC(W)=NINT(REAL(W))
-C
- RE=0
- X(1,1)=1
- SUM=X(1,1)
- ATL=ABSC(X(1,1))
- F=SUM
- D=1
- DF=SUM
- J=0
- EP=EPS*(10*JMAX)
- MA=-NINTC(AA)
- MB=-NINTC(BB)
- FINITE=ABS(ABS(REAL(AA))-MA) .LT. EP .AND. ABS(AIMAG(AA)) .LT. EP
- 1 .OR. ABS(ABS(REAL(BB))-MB) .LT. EP .AND. ABS(AIMAG(BB)) .LT. EP
- IMAX=JMAX
- IF(FINITE .AND. MA .GE. 0) IMAX=MIN(MA+1,IMAX)
- IF(FINITE .AND. MB .GE. 0) IMAX=MIN(MB+1,IMAX)
- DO 10 I = 2,IMAX
- X(I,1)=X(I-1,1)*Z*(AA+I-2)*(BB+I-2)/(I-1)
- IF(ABSC(X(I,1)) .GT. FPMAX) THEN
- N=0
- C309R3=SUM
- IF(.NOT.FINITE) RE=AT/ABSC(SUM)
- RETURN
- END IF
- AT=ABSC(X(I,1))
- IF(J .EQ. 0) THEN
- SUM=SUM+X(I,1)
- IF(AT .LT. ABSC(SUM)*EPS) THEN
- N=I
- C309R3=SUM
- IF(.NOT.FINITE) RE=AT/ABSC(SUM)
- RETURN
- END IF
- END IF
- IF(FINITE) GO TO 10
- IF(J .GT. 0 .OR. AT .GT. ATL .OR. I .GE. JMAX-2) J=J+1
- IF(J .EQ. 0) GO TO 10
- CALL C309R7(X(1,1),X(1,2),J,I,X(1,3),EPS)
- IF(I .LT. 0) THEN
- N=0
- C309R3=SUM
- IF(.NOT.FINITE) RE=AT/ABSC(SUM)
- RETURN
- END IF
- DO 50 K = MAX(J,2),I
- D=1/(D*X(K,2)+1)
- DF=DF*D-DF
- F=F+DF
- IF(ABSC(DF) .LT. ABSC(F)*EPS .OR.
- 1 DF .EQ. 0 .AND. F .EQ. 0 .AND. I .GE. 4) THEN
- N=K
- C309R3=F
- RE=ABSC(DF)/ABSC(F)
- RETURN
- END IF
- 50 CONTINUE
- J=I
- 10 ATL=AT
- IF(.NOT.FINITE) I=-JMAX
- N=I
- C309R3=SUM
- IF(.NOT.FINITE) RE=AT/ABSC(SUM)
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/c/r4dp.F b/src/mathlib/gen/c/r4dp.F
deleted file mode 100644
index b038949..0000000
--- a/src/mathlib/gen/c/r4dp.F
+++ /dev/null
@@ -1,66 +0,0 @@
-*
-* $Id: r4dp.F,v 1.1.1.1 1996/04/01 15:01:57 mclareni Exp $
-*
-* $Log: r4dp.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:57 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- FUNCTION C309R4(X,ETA,ZL,EPS,FCL,TPK1,ETANE0,LIMIT,ERR,NFP,
- 1 FPMIN,FPMAX,LPR)
-C
-C *** Evaluate CF1 = F'(ZL,ETA,X)/F(ZL,ETA,X) (REAL)
-C
- IMPLICIT DOUBLE PRECISION(A-H,O-Z)
- LOGICAL LPR,ETANE0
-
- FCL=1
- XI=1/X
- PK=ZL+1
- PX=PK+LIMIT
- EK=ETA/PK
- F=EK+PK*XI
- IF(ABS(F) .LT. FPMIN) F=FPMIN
- D=0
- C=F
- SMALL=SQRT(FPMIN)
- RK2=1+EK*EK
-C
-C *** begin CF1 loop on PK = k = lambda + 1
-C
- 10 PK1=PK+1
- TPK1=PK+PK1
- IF(ETANE0) THEN
- EK=ETA/PK
- RK2=1+EK*EK
- TK=TPK1*(XI+EK/PK1)
- ELSE
- TK=TPK1*XI
- END IF
- C=TK-RK2/C
- D=TK-RK2*D
- IF(ABS(C) .LT. FPMIN) C=FPMIN
- IF(ABS(D) .LT. FPMIN) D=FPMIN
- D=1/D
- DF=D*C
- F=F*DF
- FCL=FCL*D*TPK1*XI
- IF(ABS(FCL) .LT. SMALL) FCL=FCL/SMALL
- IF(ABS(FCL) .GT. FPMAX) FCL=FCL*FPMIN
- PK=PK1
- IF(PK .LE. PX) THEN
- IF(ABS(DF-1) .GE. EPS) GO TO 10
- NFP=PK-ZL-1
- ERR=EPS*SQRT(REAL(NFP))
- C309R4=F
- ELSE
- IF(LPR) WRITE (6,1000) LIMIT,ABS(X)
- ERR=2
- END IF
- RETURN
- 1000 FORMAT(1X,'***** CERN C309 WCLBES ... CF1 (REAL) HAS FAILED ',
- 1'TO CONVERGE AFTER',I10,' ITERATIONS AS ABS(X) =',F15.0)
- END
-#endif
diff --git a/src/mathlib/gen/c/r4sp.F b/src/mathlib/gen/c/r4sp.F
deleted file mode 100644
index bfeac72..0000000
--- a/src/mathlib/gen/c/r4sp.F
+++ /dev/null
@@ -1,66 +0,0 @@
-*
-* $Id: r4sp.F,v 1.1.1.1 1996/04/01 15:01:57 mclareni Exp $
-*
-* $Log: r4sp.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:57 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_SINGLE)
- FUNCTION C309R4(X,ETA,ZL,EPS,FCL,TPK1,ETANE0,LIMIT,ERR,NFP,
- 1 FPMIN,FPMAX,LPR)
-C
-C *** Evaluate CF1 = F'(ZL,ETA,X)/F(ZL,ETA,X) (REAL)
-C
- IMPLICIT REAL(A-H,O-Z)
- LOGICAL LPR,ETANE0
-
- FCL=1
- XI=1/X
- PK=ZL+1
- PX=PK+LIMIT
- EK=ETA/PK
- F=EK+PK*XI
- IF(ABS(F) .LT. FPMIN) F=FPMIN
- D=0
- C=F
- SMALL=SQRT(FPMIN)
- RK2=1+EK*EK
-C
-C *** begin CF1 loop on PK = k = lambda + 1
-C
- 10 PK1=PK+1
- TPK1=PK+PK1
- IF(ETANE0) THEN
- EK=ETA/PK
- RK2=1+EK*EK
- TK=TPK1*(XI+EK/PK1)
- ELSE
- TK=TPK1*XI
- END IF
- C=TK-RK2/C
- D=TK-RK2*D
- IF(ABS(C) .LT. FPMIN) C=FPMIN
- IF(ABS(D) .LT. FPMIN) D=FPMIN
- D=1/D
- DF=D*C
- F=F*DF
- FCL=FCL*D*TPK1*XI
- IF(ABS(FCL) .LT. SMALL) FCL=FCL/SMALL
- IF(ABS(FCL) .GT. FPMAX) FCL=FCL*FPMIN
- PK=PK1
- IF(PK .LE. PX) THEN
- IF(ABS(DF-1) .GE. EPS) GO TO 10
- NFP=PK-ZL-1
- ERR=EPS*SQRT(REAL(NFP))
- C309R4=F
- ELSE
- IF(LPR) WRITE (6,1000) LIMIT,ABS(X)
- ERR=2
- END IF
- RETURN
- 1000 FORMAT(1X,'***** CERN C309 CCLBES ... CF1 (REAL) HAS FAILED ',
- 1'TO CONVERGE AFTER',I10,' ITERATIONS AS ABS(X) =',F15.0)
- END
-#endif
diff --git a/src/mathlib/gen/c/r5dp.F b/src/mathlib/gen/c/r5dp.F
deleted file mode 100644
index 0c55225..0000000
--- a/src/mathlib/gen/c/r5dp.F
+++ /dev/null
@@ -1,73 +0,0 @@
-*
-* $Id: r5dp.F,v 1.1.1.1 1996/04/01 15:01:57 mclareni Exp $
-*
-* $Log: r5dp.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:57 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- FUNCTION C309R5(X,ETA,ZL,EPS,FCL,TPK1,ETANE0,LIMIT,ERR,NFP,
- 1 FPMIN,FPMAX,LPR)
-C
-C *** Evaluate CF1 = F'(ZL,ETA,X)/F(ZL,ETA,X) (COMPLEX)
-C
- IMPLICIT COMPLEX*16(A-H,O-Z)
- LOGICAL LPR,ETANE0
- DOUBLE PRECISION EPS,ERR,FPMIN,FPMAX,ABSC,SMALL,PX
-
-
-#if defined(CERNLIB_QF2C)
-#include "defdr.inc"
-#endif
- ABSC(W)=ABS(DREAL(W))+ABS(DIMAG(W))
-
- FCL=1
- XI=1/X
- PK=ZL+1
- PX=PK+LIMIT
- EK=ETA/PK
- F=EK+PK*XI
- IF(ABSC(F) .LT. FPMIN) F=FPMIN
- D=0
- C=F
- SMALL=SQRT(FPMIN)
- RK2=1+EK*EK
-C
-C *** begin CF1 loop on PK = k = lambda + 1
-C
- 10 PK1=PK+1
- TPK1=PK+PK1
- IF(ETANE0) THEN
- EK=ETA/PK
- RK2=1+EK*EK
- TK=TPK1*(XI+EK/PK1)
- ELSE
- TK=TPK1*XI
- END IF
- C=TK-RK2/C
- D=TK-RK2*D
- IF(ABSC(C) .LT. FPMIN) C=FPMIN
- IF(ABSC(D) .LT. FPMIN) D=FPMIN
- D=1/D
- DF=D*C
- F=F*DF
- FCL=FCL*D*TPK1*XI
- IF(ABSC(FCL) .LT. SMALL) FCL=FCL/SMALL
- IF(ABSC(FCL) .GT. FPMAX) FCL=FCL*FPMIN
- PK=PK1
- IF(DREAL(PK) .LE. PX) THEN
- IF(ABSC(DF-1) .GE. EPS) GO TO 10
- NFP=PK-ZL-1
- ERR=EPS*SQRT(REAL(NFP))
- C309R5=F
- ELSE
- IF(LPR) WRITE (6,1000) LIMIT,ABS(X)
- ERR=2
- END IF
- RETURN
- 1000 FORMAT(1X,'***** CERN C309 WCLBES ... CF1 (COMPLEX) HAS FAILED ',
- 1'TO CONVERGE AFTER',I10,' ITERATIONS AS ABS(X) =',F15.0)
- END
-#endif
diff --git a/src/mathlib/gen/c/r5sp.F b/src/mathlib/gen/c/r5sp.F
deleted file mode 100644
index f0103e1..0000000
--- a/src/mathlib/gen/c/r5sp.F
+++ /dev/null
@@ -1,70 +0,0 @@
-*
-* $Id: r5sp.F,v 1.1.1.1 1996/04/01 15:01:57 mclareni Exp $
-*
-* $Log: r5sp.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:57 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_SINGLE)
- FUNCTION C309R5(X,ETA,ZL,EPS,FCL,TPK1,ETANE0,LIMIT,ERR,NFP,
- 1 FPMIN,FPMAX,LPR)
-C
-C *** Evaluate CF1 = F'(ZL,ETA,X)/F(ZL,ETA,X) (COMPLEX)
-C
- IMPLICIT COMPLEX(A-H,O-Z)
- LOGICAL LPR,ETANE0
- REAL EPS,ERR,FPMIN,FPMAX,ABSC,SMALL,PX
-
-
- ABSC(W)=ABS(REAL(W))+ABS(AIMAG(W))
-
- FCL=1
- XI=1/X
- PK=ZL+1
- PX=PK+LIMIT
- EK=ETA/PK
- F=EK+PK*XI
- IF(ABSC(F) .LT. FPMIN) F=FPMIN
- D=0
- C=F
- SMALL=SQRT(FPMIN)
- RK2=1+EK*EK
-C
-C *** begin CF1 loop on PK = k = lambda + 1
-C
- 10 PK1=PK+1
- TPK1=PK+PK1
- IF(ETANE0) THEN
- EK=ETA/PK
- RK2=1+EK*EK
- TK=TPK1*(XI+EK/PK1)
- ELSE
- TK=TPK1*XI
- END IF
- C=TK-RK2/C
- D=TK-RK2*D
- IF(ABSC(C) .LT. FPMIN) C=FPMIN
- IF(ABSC(D) .LT. FPMIN) D=FPMIN
- D=1/D
- DF=D*C
- F=F*DF
- FCL=FCL*D*TPK1*XI
- IF(ABSC(FCL) .LT. SMALL) FCL=FCL/SMALL
- IF(ABSC(FCL) .GT. FPMAX) FCL=FCL*FPMIN
- PK=PK1
- IF(REAL(PK) .LE. PX) THEN
- IF(ABSC(DF-1) .GE. EPS) GO TO 10
- NFP=PK-ZL-1
- ERR=EPS*SQRT(REAL(NFP))
- C309R5=F
- ELSE
- IF(LPR) WRITE (6,1000) LIMIT,ABS(X)
- ERR=2
- END IF
- RETURN
- 1000 FORMAT(1X,'***** CERN C309 CCLBES ... CF1 (COMPLEX) HAS FAILED ',
- 1'TO CONVERGE AFTER',I10,' ITERATIONS AS ABS(X) =',F15.0)
- END
-#endif
diff --git a/src/mathlib/gen/c/r6dp.F b/src/mathlib/gen/c/r6dp.F
deleted file mode 100644
index 8b04eef..0000000
--- a/src/mathlib/gen/c/r6dp.F
+++ /dev/null
@@ -1,138 +0,0 @@
-*
-* $Id: r6dp.F,v 1.1.1.1 1996/04/01 15:01:57 mclareni Exp $
-*
-* $Log: r6dp.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:57 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- FUNCTION C309R6(RHO,ETA,XL,PSI,EPS,NMAX,NUSED,FCL,RE,FPMAX,XX,G,C)
-C
-C evaluate the ASYMPTOTIC EXPANSION for the
-C LOGARITHMIC DERIVATIVE OF THE REGULAR SOLUTION
-C
-C *** CF1A = f = F'(XL,ETA,RHO)/F(XL,ETA,RHO)
-C
-C that is valid for DREAL(RHO)>0, and best for RHO >> ETA**2, XL,
-C and is derived from the 2F0 expansions for H+ and H-
-C e.g. by Froeberg (Rev. Mod. Physics Vol 27, p399 , 1955)
-C Some lines of this subprogram are for convenience copied from
-C Takemasa, Tamura & Wolter CPC 17 (1979) 351.
-C
-C Evaluate to accuracy EPS with at most NMAX terms.
-C
-C If the terms start diverging,
-C the corresponding continued fraction is found by RCF
-C & evaluated progressively by Steed's method to obtain convergence.
-C
- IMPLICIT COMPLEX*16(A-H,O-Z)
- DIMENSION XX(2,NMAX),G(NMAX),C(NMAX)
- DOUBLE PRECISION RE,EPS,T1,T2,T3,AT,ATL,ABSC,FPMAX
- DOUBLE PRECISION HPI
-
- PARAMETER(HPI = 1.57079 63267 94896 619D0)
-
-#if defined(CERNLIB_QF2C)
-#include "defdr.inc"
-#endif
- ABSC(W)=ABS(DREAL(W))+ABS(DIMAG(W))
-C
- T1=SIN(DREAL(PSI))
- T2=COS(DREAL(PSI))
- ATL=TANH(DIMAG(PSI))
-
-C GIVE COS(PSI)/COSH(IM(PSI)), WHICH ALWAYS HAS CORRECT SIGN
-
- COSL=DCMPLX(T2,-T1*ATL)
- TANL=DCMPLX(T1,T2*ATL)/COSL
- RE=0
- XLL1=XL*XL+XL
- ETASQ=ETA*ETA
- SL1=1
- SL=SL1
- SC1=0
- SC=SC1
- TL1=SC
- TL=TL1
- TC1=1-ETA/RHO
- TC=TC1
- FCL=TL+SL*TANL
- G(1)=(TC+SC*TANL)/FCL
- GLAST=G(1)
- ATL=ABSC(GLAST)
- F=GLAST
- D=1
- DF=GLAST
- J=0
- DO 10 N = 2,NMAX
- T1=N-1
- T2=2*T1-1
- T3=T1*T1-T1
- DENOM=2*RHO*T1
- C1=(ETA*T2)/DENOM
- C2=(ETASQ+XLL1-T3)/DENOM
- SL2=C1*SL1-C2*TL1
- TL2=C1*TL1+C2*SL1
- SC2=C1*SC1-C2*TC1-SL2/RHO
- TC2=C1*TC1+C2*SC1-TL2/RHO
- SL=SL+SL2
- TL=TL+TL2
- SC=SC+SC2
- TC=TC+TC2
- SL1=SL2
- TL1=TL2
- SC1=SC2
- TC1=TC2
- FCL=TL+SL*TANL
- IF(ABSC(FCL) .GT. FPMAX .OR. ABSC(FCL) .LT. 1./FPMAX) THEN
- C309R6=G(1)
- FCL=1
- RE=1
- NUSED=0
- RETURN
- END IF
- GSUM=(TC+SC*TANL)/FCL
- G(N)=GSUM-GLAST
- GLAST=GSUM
- AT=ABSC(G(N))
- IF(AT .LT. ABSC(GSUM)*EPS) THEN
- FCL=FCL*COSL
- C309R6=GSUM
- RE=AT/ABSC(GSUM)
- NUSED=N
- RETURN
- END IF
- IF(J .GT. 0 .OR. AT .GT. ATL .OR. N .GE. NMAX-2) J=J+1
- IF(J .EQ. 0) GO TO 10
- CALL C309R7(G,C,J,N,XX,EPS)
- IF(N .LT. 0) THEN
- C309R6=G(1)
- FCL=1
- RE=1
- NUSED=0
- RETURN
- END IF
- DO 60 K = MAX(J,2),N
- D=1/(D*C(K)+1)
- DF=DF*D-DF
- F=F+DF
- IF(ABSC(DF) .LT. ABSC(F)*EPS .OR.
- 1 DF .EQ. 0 .AND. F .EQ. 0 .AND. N .GE. 4) THEN
- C309R6=F
- FCL=FCL*COSL
- RE=ABSC(DF)/ABSC(F)
- NUSED=K
- RETURN
- END IF
- 60 CONTINUE
- J=N
- 10 ATL=AT
- C309R6=F
- FCL=FCL*COSL
- RE=ABSC(DF)/ABSC(F)
- NUSED=-NMAX
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/c/r6sp.F b/src/mathlib/gen/c/r6sp.F
deleted file mode 100644
index c8c04e9..0000000
--- a/src/mathlib/gen/c/r6sp.F
+++ /dev/null
@@ -1,135 +0,0 @@
-*
-* $Id: r6sp.F,v 1.1.1.1 1996/04/01 15:01:57 mclareni Exp $
-*
-* $Log: r6sp.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:57 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_SINGLE)
- FUNCTION C309R6(RHO,ETA,XL,PSI,EPS,NMAX,NUSED,FCL,RE,FPMAX,XX,G,C)
-C
-C evaluate the ASYMPTOTIC EXPANSION for the
-C LOGARITHMIC DERIVATIVE OF THE REGULAR SOLUTION
-C
-C *** CF1A = f = F'(XL,ETA,RHO)/F(XL,ETA,RHO)
-C
-C that is valid for REAL(RHO)>0, and best for RHO >> ETA**2, XL,
-C and is derived from the 2F0 expansions for H+ and H-
-C e.g. by Froeberg (Rev. Mod. Physics Vol 27, p399 , 1955)
-C Some lines of this subprogram are for convenience copied from
-C Takemasa, Tamura & Wolter CPC 17 (1979) 351.
-C
-C Evaluate to accuracy EPS with at most NMAX terms.
-C
-C If the terms start diverging,
-C the corresponding continued fraction is found by RCF
-C & evaluated progressively by Steed's method to obtain convergence.
-C
- IMPLICIT COMPLEX(A-H,O-Z)
- DIMENSION XX(2,NMAX),G(NMAX),C(NMAX)
- REAL RE,EPS,T1,T2,T3,AT,ATL,ABSC,FPMAX
- REAL HPI
-
- PARAMETER(HPI = 1.57079 63267 94896 619D0)
-
- ABSC(W)=ABS(REAL(W))+ABS(AIMAG(W))
-C
- T1=SIN(REAL(PSI))
- T2=COS(REAL(PSI))
- ATL=TANH(AIMAG(PSI))
-
-C GIVE COS(PSI)/COSH(IM(PSI)), WHICH ALWAYS HAS CORRECT SIGN
-
- COSL=CMPLX(T2,-T1*ATL)
- TANL=CMPLX(T1,T2*ATL)/COSL
- RE=0
- XLL1=XL*XL+XL
- ETASQ=ETA*ETA
- SL1=1
- SL=SL1
- SC1=0
- SC=SC1
- TL1=SC
- TL=TL1
- TC1=1-ETA/RHO
- TC=TC1
- FCL=TL+SL*TANL
- G(1)=(TC+SC*TANL)/FCL
- GLAST=G(1)
- ATL=ABSC(GLAST)
- F=GLAST
- D=1
- DF=GLAST
- J=0
- DO 10 N = 2,NMAX
- T1=N-1
- T2=2*T1-1
- T3=T1*T1-T1
- DENOM=2*RHO*T1
- C1=(ETA*T2)/DENOM
- C2=(ETASQ+XLL1-T3)/DENOM
- SL2=C1*SL1-C2*TL1
- TL2=C1*TL1+C2*SL1
- SC2=C1*SC1-C2*TC1-SL2/RHO
- TC2=C1*TC1+C2*SC1-TL2/RHO
- SL=SL+SL2
- TL=TL+TL2
- SC=SC+SC2
- TC=TC+TC2
- SL1=SL2
- TL1=TL2
- SC1=SC2
- TC1=TC2
- FCL=TL+SL*TANL
- IF(ABSC(FCL) .GT. FPMAX .OR. ABSC(FCL) .LT. 1./FPMAX) THEN
- C309R6=G(1)
- FCL=1
- RE=1
- NUSED=0
- RETURN
- END IF
- GSUM=(TC+SC*TANL)/FCL
- G(N)=GSUM-GLAST
- GLAST=GSUM
- AT=ABSC(G(N))
- IF(AT .LT. ABSC(GSUM)*EPS) THEN
- FCL=FCL*COSL
- C309R6=GSUM
- RE=AT/ABSC(GSUM)
- NUSED=N
- RETURN
- END IF
- IF(J .GT. 0 .OR. AT .GT. ATL .OR. N .GE. NMAX-2) J=J+1
- IF(J .EQ. 0) GO TO 10
- CALL C309R7(G,C,J,N,XX,EPS)
- IF(N .LT. 0) THEN
- C309R6=G(1)
- FCL=1
- RE=1
- NUSED=0
- RETURN
- END IF
- DO 60 K = MAX(J,2),N
- D=1/(D*C(K)+1)
- DF=DF*D-DF
- F=F+DF
- IF(ABSC(DF) .LT. ABSC(F)*EPS .OR.
- 1 DF .EQ. 0 .AND. F .EQ. 0 .AND. N .GE. 4) THEN
- C309R6=F
- FCL=FCL*COSL
- RE=ABSC(DF)/ABSC(F)
- NUSED=K
- RETURN
- END IF
- 60 CONTINUE
- J=N
- 10 ATL=AT
- C309R6=F
- FCL=FCL*COSL
- RE=ABSC(DF)/ABSC(F)
- NUSED=-NMAX
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/c/r7dp.F b/src/mathlib/gen/c/r7dp.F
deleted file mode 100644
index f22977f..0000000
--- a/src/mathlib/gen/c/r7dp.F
+++ /dev/null
@@ -1,98 +0,0 @@
-*
-* $Id: r7dp.F,v 1.1.1.1 1996/04/01 15:01:57 mclareni Exp $
-*
-* $Log: r7dp.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:57 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- SUBROUTINE C309R7(A,B,IBEG,INUM,XX,EPS)
-C
-C*******************************************************************
-C
-C RCF converts polynomial A to the corresponding continued
-C fraction, in 'normal' form with coefficients B
-C by the 'P algorithm' of Patry & Gupta
-C
-C A(z) = A1/z + A2/z**3 + A3/z**5 + ... + An/z**(2n-1)
-C
-C B(z) = B1/z+ B2/z+ B3/z+ .../(z+ Bn/z)
-C
-C data:
-C A vector A(k), k=1,INUM input
-C B vector B(k), k=IBEG,INUM output
-C IBEG order of first coef. calc. input
-C INUM order of A, even or odd input
-C XX auxiliary vector of length .ge. length of vector B
-C caller provides space for A,B,XX
-C Note that neither of the first two terms A(1) A(2) should be zero
-C & the user can start the calculation with any value of
-C IBEG provided the c.f. coefs have been already
-C calculated up to INUM = IBEG-1
-C & the method breaks down as soon as the absolute value
-C of a c.f. coef. is less than EPS. At the time of the
-C break up INUM has been replaced by minus times the number
-C of this coefficient.
-C algorithm: J. Patry & S. Gupta, EIR-Bericht 247, November 1973
-C Eidg. Institut fur Reaktorforschung
-C Wuerenlingen, Switzerland
-C see also: Haenggi, Roesel & Trautmann,
-C J. Comput. Phys., v. 137, (1980) 242-258
-C note: restart procedure modified by I.J.Thompson
-C
-C*******************************************************************
-C
- IMPLICIT COMPLEX*16(A-H,O-Z)
- DIMENSION A(100),B(100),XX(2,100)
- LOGICAL EVEN
- DOUBLE PRECISION EPS
-
- IBN=INUM
- IF(IBEG .GT. 4) GO TO 50
- IF(IBEG .EQ. 4) GO TO 20
- B(1)=A(1)
- IF(IBN .GE. 2) B(2)=-A(2)/A(1)
- IF(IBN .LT. 3) RETURN
- X0=A(3)/A(2)
- XX(2,1)=B(2)
- XX(1,1)=-X0
- XX(1,2)=0
- B(3)=-X0-B(2)
- X0=-B(3)*A(2)
- M=3
- MP12=2
- EVEN=.TRUE.
- IF(IBN .LE. 3) RETURN
- 20 IF(ABS(B(3)) .LT. EPS*ABS(X0)) THEN
- INUM=-M
- RETURN
- END IF
- M=4
- 30 X1=A(M)
- M2M1=MP12
- MP12=M2M1+1
- IF(EVEN) MP12=M2M1
- DO 40 K = 2,MP12
- 40 X1=X1+A(M-K+1)*XX(1,K-1)
- B(M)=-X1/X0
- IF(M .GE. IBN) RETURN
- 50 IF(ABS(B(M)) .LT. EPS*ABS(X0)) THEN
- INUM=-M
- RETURN
- END IF
- DO 60 K = M2M1,2,-1
- 60 XX(2,K)=XX(1,K)+B(M)*XX(2,K-1)
- XX(2,1)=XX(1,1)+B(M)
- DO 70 K = 1,M2M1
- X0=XX(2,K)
- XX(2,K)=XX(1,K)
- 70 XX(1,K)=X0
- X0=X1
- XX(1,M2M1+1)=0
- M=M+1
- EVEN=.NOT.EVEN
- GO TO 30
- END
-#endif
diff --git a/src/mathlib/gen/c/r7sp.F b/src/mathlib/gen/c/r7sp.F
deleted file mode 100644
index 056d95c..0000000
--- a/src/mathlib/gen/c/r7sp.F
+++ /dev/null
@@ -1,113 +0,0 @@
-*
-* $Id: r7sp.F,v 1.1.1.1 1996/04/01 15:01:57 mclareni Exp $
-*
-* $Log: r7sp.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:57 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_SINGLE)
- SUBROUTINE C309R7(A,B,IBEG,INUM,XX,EPS)
-C
-C*******************************************************************
-C
-C RCF converts polynomial A to the corresponding continued
-C fraction, in 'normal' form with coefficients B
-C by the 'P algorithm' of Patry & Gupta
-C
-C A(z) = A1/z + A2/z**3 + A3/z**5 + ... + An/z**(2n-1)
-C
-C B(z) = B1/z+ B2/z+ B3/z+ .../(z+ Bn/z)
-C
-C data:
-C A vector A(k), k=1,INUM input
-C B vector B(k), k=IBEG,INUM output
-C IBEG order of first coef. calc. input
-C INUM order of A, even or odd input
-C XX auxiliary vector of length .ge. length of vector B
-C caller provides space for A,B,XX
-C Note that neither of the first two terms A(1) A(2) should be zero
-C & the user can start the calculation with any value of
-C IBEG provided the c.f. coefs have been already
-C calculated up to INUM = IBEG-1
-C & the method breaks down as soon as the absolute value
-C of a c.f. coef. is less than EPS. At the time of the
-C break up INUM has been replaced by minus times the number
-C of this coefficient.
-C algorithm: J. Patry & S. Gupta, EIR-Bericht 247, November 1973
-C Eidg. Institut fur Reaktorforschung
-C Wuerenlingen, Switzerland
-C see also: Haenggi, Roesel & Trautmann,
-C J. Comput. Phys., v. 137, (1980) 242-258
-C note: restart procedure modified by I.J.Thompson
-C
-C*******************************************************************
-C
- IMPLICIT COMPLEX(A-H,O-Z)
- DIMENSION A(100),B(100),XX(2,100)
- LOGICAL EVEN
- REAL EPS
-
- IBN=INUM
- IF(IBEG .GT. 4) GO TO 50
- IF(IBEG .EQ. 4) GO TO 20
- B(1)=A(1)
- IF(IBN .GE. 2) B(2)=-A(2)/A(1)
- IF(IBN .LT. 3) RETURN
- X0=A(3)/A(2)
- XX(2,1)=B(2)
- XX(1,1)=-X0
- XX(1,2)=0
- B(3)=-X0-B(2)
- X0=-B(3)*A(2)
- M=3
- MP12=2
- EVEN=.TRUE.
- IF(IBN .LE. 3) RETURN
- 20 IF(ABS(B(3)) .LT. EPS*ABS(X0)) THEN
- INUM=-M
- RETURN
- END IF
- M=4
- 30 X1=A(M)
- M2M1=MP12
- MP12=M2M1+1
- IF(EVEN) MP12=M2M1
- DO 40 K = 2,MP12
- 40 X1=X1+A(M-K+1)*XX(1,K-1)
- B(M)=-X1/X0
- IF(M .GE. IBN) RETURN
- 50 IF(ABS(B(M)) .LT. EPS*ABS(X0)) THEN
- INUM=-M
- RETURN
- END IF
- DO 60 K = M2M1,2,-1
- 60 XX(2,K)=XX(1,K)+B(M)*XX(2,K-1)
- XX(2,1)=XX(1,1)+B(M)
- DO 70 K = 1,M2M1
- X0=XX(2,K)
- XX(2,K)=XX(1,K)
- 70 XX(1,K)=X0
- X0=X1
- XX(1,M2M1+1)=0
- M=M+1
- EVEN=.NOT.EVEN
- GO TO 30
- END
- FUNCTION C309R8(Z,ACC)
- COMPLEX C309R8,Z
- REAL ACC
- REAL X,Y,AX,AY,A
-
- X=REAL(Z)
- Y=AIMAG(Z)
- AX=ABS(X)
- AY=ABS(Y)
- A=5*ACC*(AX+AY)
- IF(AX .LT. A) X=0
- IF(AY .LT. A) Y=0
- C309R8=CMPLX(X,Y)
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/c/r8dp.F b/src/mathlib/gen/c/r8dp.F
deleted file mode 100644
index 3405620..0000000
--- a/src/mathlib/gen/c/r8dp.F
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: r8dp.F,v 1.1.1.1 1996/04/01 15:01:57 mclareni Exp $
-*
-* $Log: r8dp.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:57 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- FUNCTION C309R8(Z,ACC)
- COMPLEX*16 C309R8,Z
- DOUBLE PRECISION ACC
- DOUBLE PRECISION X,Y,AX,AY,A
-
-#if defined(CERNLIB_QF2C)
-#include "defdr.inc"
-#endif
- X=DREAL(Z)
- Y=DIMAG(Z)
- AX=ABS(X)
- AY=ABS(Y)
- A=5*ACC*(AX+AY)
- IF(AX .LT. A) X=0
- IF(AY .LT. A) Y=0
- C309R8=DCMPLX(X,Y)
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/c/raslgf.F b/src/mathlib/gen/c/raslgf.F
deleted file mode 100644
index e84d0ad..0000000
--- a/src/mathlib/gen/c/raslgf.F
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: raslgf.F,v 1.1.1.1 1996/04/01 15:02:04 mclareni Exp $
-*
-* $Log: raslgf.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:04 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- SUBROUTINE RASLGF(MODE,X,M,NL,P)
- DIMENSION P(0:*)
-#include "gen/def64.inc"
- + D,DP(0:100)
-
- SROUND(D)=D+(D-SNGL(D))
-
- ENTRY ASLGF(MODE,X,M,NL,P)
-
- CALL DASLGF(MODE,DBLE(X),M,NL,DP)
- DO 1 N = 0,NL
- 1 P(N)=SROUND(DP(N))
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/c/rbzejy.F b/src/mathlib/gen/c/rbzejy.F
deleted file mode 100644
index d1367e0..0000000
--- a/src/mathlib/gen/c/rbzejy.F
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: rbzejy.F,v 1.1.1.1 1996/04/01 15:02:09 mclareni Exp $
-*
-* $Log: rbzejy.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:09 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- SUBROUTINE RBZEJY(A,N,MODE,REL,X)
-#include "gen/def64.inc"
- + DX,D
- DIMENSION X(*),DX(200)
-
- SROUND(D)=D+(D-SNGL(D))
-
- ENTRY BZEJY(A,N,MODE,REL,X)
-
- CALL DBZEJY(DBLE(A),N,MODE,DBLE(REL),DX)
- DO 1 I = 1,N
- 1 X(I)=SROUND(DX(I))
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/c/rclaus.F b/src/mathlib/gen/c/rclaus.F
deleted file mode 100644
index 81a523f..0000000
--- a/src/mathlib/gen/c/rclaus.F
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: rclaus.F,v 1.1.1.1 1996/04/01 15:02:03 mclareni Exp $
-*
-* $Log: rclaus.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:03 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- FUNCTION RCLAUS(X)
- DOUBLE PRECISION DCLAUS,D
-
- SROUND(D)=D+(D-SNGL(D))
- RCLAUS=SROUND(DCLAUS(DBLE(X)))
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/c/rdawsn.F b/src/mathlib/gen/c/rdawsn.F
deleted file mode 100644
index dc68c5c..0000000
--- a/src/mathlib/gen/c/rdawsn.F
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: rdawsn.F,v 1.1.1.1 1996/04/01 15:02:07 mclareni Exp $
-*
-* $Log: rdawsn.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:07 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- FUNCTION RDAWSN(X)
-#include "gen/def64.inc"
- + DDAWSN,D
-
- SROUND(D)=D+(D-SNGL(D))
-
- RDAWSN=SROUND(DDAWSN(DBLE(X)))
- RETURN
-
- ENTRY DAWSON(X)
- DAWSON=SROUND(DDAWSN(DBLE(X)))
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/c/rdilog.F b/src/mathlib/gen/c/rdilog.F
deleted file mode 100644
index 375a653..0000000
--- a/src/mathlib/gen/c/rdilog.F
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: rdilog.F,v 1.1.1.1 1996/04/01 15:02:05 mclareni Exp $
-*
-* $Log: rdilog.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:05 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- FUNCTION RDILOG(X)
- DOUBLE PRECISION D,DDILOG
-
- SROUND(D)=D+(D-SNGL(D))
-
- RDILOG=SROUND(DDILOG(DBLE(X)))
- RETURN
-
- ENTRY DILOG(X)
-
- DILOG=SROUND(DDILOG(DBLE(X)))
- RETURN
-
- END
-#endif
diff --git a/src/mathlib/gen/c/relfun.F b/src/mathlib/gen/c/relfun.F
deleted file mode 100644
index e5b6745..0000000
--- a/src/mathlib/gen/c/relfun.F
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: relfun.F,v 1.1.1.1 1996/04/01 15:02:01 mclareni Exp $
-*
-* $Log: relfun.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:01 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- SUBROUTINE RELFUN(X,AK2,SN,CN,DN)
-#include "gen/def64.inc"
- + DSN,DCN,DDN,D
-
- ENTRY ELFUN(X,AK2,SN,CN,DN)
- SROUND(D)=D+(D-SNGL(D))
- CALL DELFUN(DBLE(X),DBLE(AK2),DSN,DCN,DDN)
- SN=SROUND(DSN)
- CN=SROUND(DCN)
- DN=SROUND(DDN)
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/c/reli1.F b/src/mathlib/gen/c/reli1.F
deleted file mode 100644
index e2cbba0..0000000
--- a/src/mathlib/gen/c/reli1.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: reli1.F,v 1.1.1.1 1996/04/01 15:02:10 mclareni Exp $
-*
-* $Log: reli1.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:10 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- FUNCTION RELI1(X,AKP)
- IMPLICIT DOUBLE PRECISION (D)
-
- SROUND(D)=D+(D-SNGL(D))
- RELI1=SROUND(DELI1(DBLE(X),DBLE(AKP)))
- RETURN
-
- ENTRY RELI2(X,AKP,A,B,MODE)
- RELI2=SROUND(DELI2(DBLE(X),DBLE(AKP),DBLE(A),DBLE(B),MODE))
- RETURN
-
- ENTRY RELI3(X,AKP,P)
- RELI3=SROUND(DELI3(DBLE(X),DBLE(AKP),DBLE(P)))
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/c/reli164.F b/src/mathlib/gen/c/reli164.F
deleted file mode 100644
index 4d9885d..0000000
--- a/src/mathlib/gen/c/reli164.F
+++ /dev/null
@@ -1,67 +0,0 @@
-*
-* $Id: reli164.F,v 1.1.1.1 1996/04/01 15:02:10 mclareni Exp $
-*
-* $Log: reli164.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:10 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- FUNCTION DELI1(X,AKP)
-C
-#include "gen/imp64.inc"
-C
-#endif
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION RELI1(X,AKP)
-C
-#endif
-C
-C Translation of Algol procedure el1(x,kc) in
-C R. BULIRSCH Numerical Calculation of Elliptic Integrals and
-C Elliptic Functions, Numer. Math. 7 (1965) 78-90
-C
- PARAMETER (ID = 16)
- PARAMETER (PI = 3.14159 26535 89793 24D0)
- PARAMETER (Z10 = 10)
- PARAMETER (CA = Z10**(-ID/2), CB = Z10**(-(ID+2)))
-
- IF(X .EQ. 0) THEN
- H=0
- ELSEIF(AKP .EQ. 0) THEN
-#if defined(CERNLIB_DOUBLE)
- H=DASINH(X)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- H=ASINH(X)
-#endif
- ELSE
- Y=ABS(1/X)
- YKP=ABS(AKP)
- XM=1
- L=0
- 1 E=XM*YKP
- G=XM
- XM=YKP+XM
- Y=-E/Y+Y
- IF(Y .EQ. 0) Y=SQRT(E)*CB
- IF(ABS(G-YKP) .GT. CA*G) THEN
- YKP=2*SQRT(E)
- L=2*L
- IF(Y .LT. 0) L=L+1
- GO TO 1
- ENDIF
- IF(Y .LT. 0) L=L+1
- E=(ATAN(XM/Y)+PI*L)/XM
- IF(X .LT. 0) E=-E
- H=E
- ENDIF
-#if defined(CERNLIB_DOUBLE)
- DELI1=H
-#endif
-#if !defined(CERNLIB_DOUBLE)
- RELI1=H
-#endif
- RETURN
- END
diff --git a/src/mathlib/gen/c/reli1c.F b/src/mathlib/gen/c/reli1c.F
deleted file mode 100644
index 72cbd5f..0000000
--- a/src/mathlib/gen/c/reli1c.F
+++ /dev/null
@@ -1,40 +0,0 @@
-*
-* $Id: reli1c.F,v 1.1.1.1 1996/04/01 15:02:11 mclareni Exp $
-*
-* $Log: reli1c.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:11 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- FUNCTION RELI1C(AKP)
- IMPLICIT DOUBLE PRECISION (D)
-
- SROUND(D)=D+(D-SNGL(D))
- RELI1C=SROUND(DELI1C(DBLE(AKP)))
- RETURN
-
- ENTRY RELI2C(AKP,A,B)
- RELI2C=SROUND(DELI2C(DBLE(AKP),DBLE(A),DBLE(B)))
- RETURN
-
- ENTRY RELI3C(AKP,AK2,P)
- RELI3C=SROUND(DELI3C(DBLE(AKP),DBLE(AK2),DBLE(P)))
- RETURN
-
- ENTRY RELIGC(AKP,P,A,B)
- RELIGC=SROUND(DELIGC(DBLE(AKP),DBLE(P),DBLE(A),DBLE(B)))
- RETURN
-
- ENTRY RELIKC(AK)
- ENTRY ELLICK(AK)
- RELIKC=SROUND(DELIKC(DBLE(AK)))
- RETURN
-
- ENTRY RELIEC(AK)
- ENTRY ELLICE(AK)
- RELIEC=SROUND(DELIEC(DBLE(AK)))
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/c/reli1c128.F b/src/mathlib/gen/c/reli1c128.F
deleted file mode 100644
index c251750..0000000
--- a/src/mathlib/gen/c/reli1c128.F
+++ /dev/null
@@ -1,48 +0,0 @@
-*
-* $Id: reli1c128.F,v 1.1.1.1 1996/04/01 15:02:11 mclareni Exp $
-*
-* $Log: reli1c128.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:11 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION DELI1C(AKP)
-C
-#include "gen/imp128.inc"
-C
- DELI1C=0
- CALL MTLPRT('DELI1C','C347.0','Not available on this machine')
- RETURN
-
- ENTRY DELI2C(AKP,A,B)
- DELI2C=0
- CALL MTLPRT('DELI2C','C347.0','Not available on this machine')
- RETURN
-
- ENTRY DELI3C(AKP,AK2,P)
- DELI3C=0
- CALL MTLPRT('DELI3C','C347.0','Not available on this machine')
- RETURN
-
- ENTRY DELIGC(AKP,P,A,B)
- DELIGC=0
- CALL MTLPRT('DELIGC','C347.0','Not available on this machine')
- RETURN
-
- ENTRY DELIKC(AKP,P,A,B)
- ENTRY DELLIK(AKP,P,A,B)
- DELIKC=0
- DELLIK=0
- CALL MTLPRT('DELIKC','C347.0','Not available on this machine')
- RETURN
-
- ENTRY DELIEC(AKP,P,A,B)
- ENTRY DELLIE(AKP,P,A,B)
- DELIEC=0
- DELLIE=0
- CALL MTLPRT('DELIEC','C347.0','Not available on this machine')
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/c/reli1c64.F b/src/mathlib/gen/c/reli1c64.F
deleted file mode 100644
index 19b99d1..0000000
--- a/src/mathlib/gen/c/reli1c64.F
+++ /dev/null
@@ -1,140 +0,0 @@
-*
-* $Id: reli1c64.F,v 1.1.1.1 1996/04/01 15:02:11 mclareni Exp $
-*
-* $Log: reli1c64.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:11 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- FUNCTION DELI1C(AKP)
-C
-#include "gen/imp64.inc"
-C
- CHARACTER*(*) NAME1,NAME2,NAME3
- PARAMETER(NAME1='RELI1C/DELI1C')
- PARAMETER(NAME2='RELI2C/DELI2C')
- PARAMETER(NAME3='RELI3C/DELI3C')
-#endif
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION RELI1C(AKP)
-C
- CHARACTER*(*) NAME1,NAME2,NAME3
- PARAMETER(NAME1='RELI1C')
- PARAMETER(NAME2='RELI2C')
- PARAMETER(NAME3='RELI3C')
-#endif
-C
-C Translation of Algol procedures cel1(kc), cel2(kc,a,b) in
-C R. BULIRSCH Numerical Calculation of Elliptic Integrals and
-C Elliptic Functions, Numer. Math. 7 (1965) 78-90
-C and of Algol procedure cel3(kc,m,p) in
-C R. BULIRSCH Numerical Calculation of Elliptic Integrals and
-C Elliptic Functions II., Numer. Math. 7 (1965) 353-354
-C
- PARAMETER (ID = 16)
- PARAMETER (PI = 3.14159 26535 89793 24D0)
- PARAMETER (PIH = PI/2, PIQ = PI/4)
- PARAMETER (Z1 = 1, Z10 = 10, HF = Z1/2)
- PARAMETER (CA = Z10**(-ID/2))
-
- IF(AKP .EQ. 0) THEN
- H=0
- CALL MTLPRT(NAME1,'C347.1','AKP = 0')
- ELSE
- YKP=ABS(AKP)
- XM=1
- 1 G=XM
- XM=YKP+XM
- IF(ABS(G-YKP) .GT. CA*G) THEN
- YKP=SQRT(G*YKP)
- XM=HF*XM
- GO TO 1
- ENDIF
- H=PI/XM
- ENDIF
- GO TO 9
-
-#if defined(CERNLIB_DOUBLE)
- ENTRY DELI2C(AKP,A,B)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- ENTRY RELI2C(AKP,A,B)
-#endif
-
- IF(AKP .EQ. 0) THEN
- IF(B .EQ. 0) THEN
- H=A
- ELSE
- H=0
- CALL MTLPRT(NAME2,'C347.2','AKP = 0, B NE 0')
- ENDIF
- ELSE
- AA=A
- BB=B
- XM=1
- C=AA
- AA=BB+AA
- YKP=ABS(AKP)
- 2 BB=2*(C*YKP+BB)
- C=AA
- XM0=XM
- XM=YKP+XM
- AA=BB/XM+AA
- IF(ABS(XM0-YKP) .GT. CA*XM0) THEN
- YKP=2*SQRT(YKP*XM0)
- GO TO 2
- ENDIF
- H=PIQ*AA/XM
- ENDIF
- GO TO 9
-
-#if defined(CERNLIB_DOUBLE)
- ENTRY DELI3C(AKP,AK2,P)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- ENTRY RELI3C(AKP,AK2,P)
-#endif
-
- IF(AKP*P .EQ. 0) THEN
- H=0
- CALL MTLPRT(NAME3,'C347.3','AKP * P = 0')
- ELSE
- YKP=ABS(AKP)
- E=YKP
- AM0=1
- PP=P
- IF(PP .GT. 0) THEN
- C=1
- PP=SQRT(PP)
- D=1/PP
- ELSE
- G=1-PP
- F=YKP**2-PP
- PP=SQRT(F/G)
- D=-AK2/(G*PP)
- C=0
- ENDIF
- 3 F=C
- C=D/PP+C
- G=E/PP
- D=2*(F*G+D)
- PP=G+PP
- G=AM0
- AM0=YKP+AM0
- IF(ABS(G-YKP) .GT. CA*G) THEN
- YKP=2*SQRT(E)
- E=YKP*AM0
- GO TO 3
- ENDIF
- H=PIH*(C*AM0+D)/(AM0*(AM0+PP))
- ENDIF
-#if defined(CERNLIB_DOUBLE)
- 9 DELI1C=H
-#endif
-#if !defined(CERNLIB_DOUBLE)
- 9 RELI1C=H
-#endif
- RETURN
- END
diff --git a/src/mathlib/gen/c/reli264.F b/src/mathlib/gen/c/reli264.F
deleted file mode 100644
index f654635..0000000
--- a/src/mathlib/gen/c/reli264.F
+++ /dev/null
@@ -1,117 +0,0 @@
-*
-* $Id: reli264.F,v 1.1.1.1 1996/04/01 15:02:11 mclareni Exp $
-*
-* $Log: reli264.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:11 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- FUNCTION DELI2(X,AKP,A,B,MODE)
-C
-#include "gen/imp64.inc"
-C
- CHARACTER*(*) NAME
- PARAMETER(NAME='RELI2/DELI2')
-#endif
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION RELI2(X,AKP,A,B,MODE)
-C
- CHARACTER*(*) NAME
- PARAMETER(NAME='RELI2')
-#endif
-C
-C Translation of Algol procedure el2(x,kc,a,b) in
-C R. BULIRSCH Numerical Calculation of Elliptic Integrals and
-C Elliptic Functions, Numer. Math. 7 (1965) 78-90,
-C extended for (k sub c)**2 < 0 (MODE = -1)
-C
- PARAMETER (ID = 16)
- PARAMETER (PI = 3.14159 26535 89793 24D0)
- PARAMETER (Z1 = 1, Z10 = 10, HF = Z1/2)
- PARAMETER (CA = Z10**(-ID/2), CB = Z10**(-(ID+2)))
-
- CHARACTER*80 ERRTXT
-
- IF(X .EQ. 0 .OR. AKP .EQ. 0) THEN
-#if defined(CERNLIB_DOUBLE)
- H=B*DASINH(X)+(A-B)*X/SQRT(1+X**2)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- H=B*ASINH(X)+(A-B)*X/SQRT(1+X**2)
-#endif
- ELSE
- IF(MODE .EQ. 1) THEN
- XX=X
- BKP=AKP
- AA=A
- BB=B
- ELSEIF(MODE .EQ. -1) THEN
- W=1-(AKP*X)**2
- IF(W .GT. 0) THEN
- W1=1/SQRT(1+AKP**2)
- XX=X/(W1*SQRT(W))
- BKP=AKP*W1
- AA=A*W1
- BB=(B+A*AKP**2)*W1**3
- ELSE
- H=0
- WRITE(ERRTXT,101) X,AKP
- CALL MTLPRT(NAME,'C346.1',ERRTXT)
- GO TO 9
- ENDIF
- ELSE
- H=0
- WRITE(ERRTXT,102) MODE
- CALL MTLPRT(NAME,'C346.2',ERRTXT)
- GO TO 9
- ENDIF
- C=XX**2
- D=1+C
- PP=SQRT((1+BKP**2*C)/D)
- D=XX/D
- C=D/(2*PP)
- Z=AA-BB
- XI=AA
- AA=HF*(AA+BB)
- Y=ABS(1/XX)
- F=0
- L=0
- XM=1
- YKP=ABS(BKP)
- 1 BB=XI*YKP+BB
- E=XM*YKP
- G=E/PP
- D=F*G+D
- F=C
- XI=AA
- PP=G+PP
- C=HF*(D/PP+C)
- G=XM
- XM=YKP+XM
- AA=HF*(BB/XM+AA)
- Y=Y-E/Y
- IF(Y .EQ. 0) Y=SQRT(E)*CB
- IF(ABS(G-YKP) .GT. CA*G) THEN
- YKP=2*SQRT(E)
- L=2*L
- IF(Y .LT. 0) L=L+1
- GO TO 1
- ENDIF
- IF(Y .LT. 0) L=L+1
- E=(ATAN(XM/Y)+PI*L)*AA/XM
- IF(XX .LT. 0) E=-E
- H=E+C*Z
- ENDIF
-#if defined(CERNLIB_DOUBLE)
- 9 DELI2=H
-#endif
-#if !defined(CERNLIB_DOUBLE)
- 9 RELI2=H
-#endif
- RETURN
- 101 FORMAT('X = ',1P,D15.8,' AKP = ',D15.8,' ILLEGAL',
- 1 '[(AKP * X)**2 >= 1]')
- 102 FORMAT('MODE = ',I5,' ILLEGAL')
- END
diff --git a/src/mathlib/gen/c/reli364.F b/src/mathlib/gen/c/reli364.F
deleted file mode 100644
index ee1ab82..0000000
--- a/src/mathlib/gen/c/reli364.F
+++ /dev/null
@@ -1,275 +0,0 @@
-*
-* $Id: reli364.F,v 1.1.1.1 1996/04/01 15:02:11 mclareni Exp $
-*
-* $Log: reli364.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:11 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- FUNCTION DELI3(X,AKP,P)
-C
-#include "gen/imp64.inc"
-C
- CHARACTER*(*) NAME
- PARAMETER(NAME='RELI3/DELI3')
-#endif
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION RELI3(X,AKP,P)
-C
- CHARACTER*(*) NAME
- PARAMETER(NAME='RELI3')
-#endif
-C
-C Translation of Algol procedure el3(x,kc,p) in
-C R. BULIRSCH Numerical Calculation of Elliptic Integrals and
-C Elliptic Functions III., Numer. Math. 13 (1969) 305-315
-C
- LOGICAL LBO,LBK
-
- PARAMETER (ID = 16, IB = 4)
- PARAMETER (PI = 3.14159 26535 89793 24D0)
- PARAMETER (AL2 = 0.69314 71805 59945 31D0)
- PARAMETER (ALB = IB*AL2, RLB = 1/ALB)
- PARAMETER (Z1 = 1, Z10 = 10, HF = Z1/2, C1 = Z1/10)
- PARAMETER (ND = ID-2, CA = Z10**(-ID/2), CB = Z10**(-(ID+2)))
- PARAMETER (ZD = HF/(ND+1))
-
- CHARACTER*80 ERRTXT
-
- DIMENSION RA(2:ND),RB(2:ND),RR(2:ND)
-
- DATA (RB(K),RA(K),K=2,ND)
- 2/2.50000000000000000D-01, 7.50000000000000000D-01,
- 3 1.66666666666666667D-01, 8.33333333333333333D-01,
- 4 1.25000000000000000D-01, 8.75000000000000000D-01,
- 5 1.00000000000000000D-01, 9.00000000000000000D-01,
- 6 8.33333333333333333D-02, 9.16666666666666667D-01,
- 7 7.14285714285714286D-02, 9.28571428571428571D-01,
- 8 6.25000000000000000D-02, 9.37500000000000000D-01,
- 9 5.55555555555555556D-02, 9.44444444444444445D-01,
- A 5.00000000000000000D-02, 9.50000000000000000D-01,
- B 4.54545454545454545D-02, 9.54545454545454545D-01,
- C 4.16666666666666667D-02, 9.58333333333333333D-01,
- D 3.84615384615384615D-02, 9.61538461538461538D-01,
- E 3.57142857142857143D-02, 9.64285714285714286D-01/
-
- IF(X .EQ. 0) THEN
- H=0
- GO TO 9
- ENDIF
- HH=X**2
- F=P*HH
- S=AKP
- IF(S .EQ. 0) S=CA/(1+ABS(X))
- T=S**2
- PM=HF*T
- E=HH*T
- Z=ABS(F)
- R=ABS(P)
- H1=HH+1
- IF(E .LT. C1 .AND. Z .LT. C1 .AND. T .LT. 1 .AND. R .LT. 1) THEN
- S=P+PM
- DO 1 K = 2,ND
- RR(K)=S
- PM=PM*T*RA(K)
- 1 S=S*P+PM
- U=S*ZD
- S=U
- LBO=.FALSE.
- DO 2 K = ND,2,-1
- U=U+(RR(K)-U)*RB(K)
- LBO=.NOT.LBO
- V=U
- IF(LBO) V=-U
- 2 S=S*HH+V
- IF(LBO) S=-S
- U=HF*(U+1)
-#if defined(CERNLIB_DOUBLE)
- H=(U-S*H1)*SQRT(H1)*X+U*DASINH(X)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- H=(U-S*H1)*SQRT(H1)*X+U*ASINH(X)
-#endif
- ELSE
- W=1+F
- IF(W .EQ. 0) THEN
- H=0
- WRITE(ERRTXT,103) X,P
- CALL MTLPRT(NAME,'C346.3',ERRTXT)
- GO TO 9
- ENDIF
- PP=P
- IF(PP .EQ. 0) PP=CB/HH
- S=ABS(S)
- Y=ABS(X)
- G=PP-1
- IF(G .EQ. 0) G=CB
- F=PP-T
- IF(F .EQ. 0) F=CB*T
- AM=1-T
- AP=1+E
- R=PP*H1
- FA=G/(F*PP)
- LBO=FA .GT. 0
- FA=ABS(FA)
- PZ=ABS(G*F)
- DE=SQRT(PZ)
- Q=SQRT(ABS(PP))
- PM=PP-MIN(PM,HF)
- IF(PM .GE. 0) THEN
- U=SQRT(R*AP)
- V=Y*DE
- IF(G .LT. 0) V=-V
- D=1/Q
- C=1
- ELSE
- U=SQRT(H1*AP*PZ)
- YE=Y*Q
- V=AM*YE
- Q=-DE/G
- D=-AM/DE
- C=0
- PZ=AP-R
- ENDIF
- IF(LBO) THEN
- R=V/U
- Z=1
- K=1
- IF(PM .LT. 0) THEN
- H1=Y*SQRT(H1/(AP*FA))
- H1=1/H1-H1
- Z=H1-2*R
- R=2+R*H1
- IF(R .EQ. 0) R=CB
- IF(Z .EQ. 0) Z=H1*CB
- R=R/Z
- Z=R
- W=PZ
- ENDIF
- U=U/W
- V=V/W
- ELSE
- T=U+ABS(V)
- LBK=.TRUE.
- IF(PP .LT. 0) THEN
- DE=V/PZ
- YE=2*U*YE
- U=T/PZ
- V=-(F+G*E)/T
- T=PZ*ABS(W)
- Z=(HH*R*F-G*AP+YE)/T
- YE=YE/T
- ELSE
- DE=V/W
- YE=0
- U=(E+PP)/T
- V=T/W
- Z=1
- ENDIF
- IF(S .GT. 1) THEN
- H1=U
- U=V
- V=H1
- ENDIF
- ENDIF
- Y=1/Y
- E=S
- T=1
- N=1
- L=0
- M=0
- 3 Y=Y-E/Y
- IF(Y .EQ. 0) Y =SQRT(E)*CB
- F=C
- C=D/Q+C
- G=E/Q
- D=2*(F*G+D)
- Q=G+Q
- G=T
- T=S+T
- N=2*N
- M=2*M
- IF(LBO) THEN
- IF(Z .LT. 0) M=K+M
- K=0
- IF(R .GT. 0) K=1
- IF(R .LT. 0) K=-1
- H1=E/(U**2+V**2)
- U=U*(1+H1)
- V=V*(1-H1)
- ELSE
- R=U/V
- H1=Z*R
- Z=H1*Z
- HH=E/V
- IF(LBK) THEN
- DE=DE/U
- YE=YE*(H1+1/H1)+DE*(1+R)
- DE=DE*(U-HH)
- LBK=ABS(YE) .LT. 1
- ELSE
- A=LOG(Z)
- K=RLB*A
- IF(Z .GE. 1) K=K+1
- Z=EXP(A-K*ALB)
- M=M+K
- ENDIF
- ENDIF
- IF(ABS(G-S) .GT. CA*G) THEN
- IF(LBO) THEN
- G=HF*(1/R-R)
- HH=U+V*G
- H1=G*U-V
- IF(HH .EQ. 0) HH=U*CB
- IF(H1 .EQ. 0) H1=V*CB
- Z=R*H1
- R=HH/H1
- ELSE
- U=U+E/U
- V=V+HH
- ENDIF
- S=2*SQRT(E)
- E=S*T
- L=2*L
- IF(Y .LT. 0) L=L+1
- GO TO 3
- ENDIF
- IF(Y .LT. 0) L=L+1
- E=(ATAN(T/Y)+PI*L)*(C*T+D)/(T*(T+Q))
- IF(LBO) THEN
- H1=V/(T+U)
- Z=1-R*H1
- H1=R+H1
- IF(Z .EQ. 0) Z=CB
- IF(Z .LT. 0) THEN
- IF(H1 .GT. 0) M=M+1
- IF(H1 .LT. 0) M=M-1
- ENDIF
- S=ATAN(H1/Z)+M*PI
- ELSE
- IF(LBK) THEN
-#if defined(CERNLIB_DOUBLE)
- S=HF*DASINH(YE)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- S=HF*ASINH(YE)
-#endif
- ELSE
- S=HF*(LOG(Z)+M*ALB)
- ENDIF
- ENDIF
- H=(E+SQRT(FA)*S)/N
- IF(X .LT. 0) H=-H
- ENDIF
-#if defined(CERNLIB_DOUBLE)
- 9 DELI3=H
-#endif
-#if !defined(CERNLIB_DOUBLE)
- 9 RELI3=H
-#endif
- RETURN
- 103 FORMAT('FUNCTION SINGULAR FOR ',1P,
- 1 'X = ',D15.8,3X,'P = ',D15.8,4X,'(P*X**2 = -1)')
- END
diff --git a/src/mathlib/gen/c/religc64.F b/src/mathlib/gen/c/religc64.F
deleted file mode 100644
index 0abc79b..0000000
--- a/src/mathlib/gen/c/religc64.F
+++ /dev/null
@@ -1,78 +0,0 @@
-*
-* $Id: religc64.F,v 1.1.1.1 1996/04/01 15:02:11 mclareni Exp $
-*
-* $Log: religc64.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:11 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- FUNCTION DELIGC(AKP,P,A,B)
-C
-#include "gen/imp64.inc"
-C
- CHARACTER*(*) NAME
- PARAMETER(NAME='RELIGC/DELIGC')
-#endif
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION RELIGC(AKP,P,A,B)
-C
- CHARACTER*(*) NAME
- PARAMETER(NAME='RELIGC')
-#endif
-C
-C Translation of Algol procedure cel(kc,p,a,b) in
-C R. BULIRSCH Numerical Calculation of Elliptic Integrals and
-C Elliptic Functions III., Numer. Math. 13 (1969) 305-315
-C
- PARAMETER (ID = 16)
- PARAMETER (PI = 3.14159 26535 89793 24D0, PIH = PI/2)
- PARAMETER (Z10 = 10)
- PARAMETER (CA = Z10**(-ID/2))
-
- IF(AKP .EQ. 0) THEN
- H=0
- CALL MTLPRT(NAME,'C347.4','AKP = 0')
- ELSE
- PP=P
- AA=A
- BB=B
- YKP=ABS(AKP)
- E=YKP
- XM=1
- IF(PP .GT. 0) THEN
- PP=SQRT(PP)
- BB=BB/PP
- ELSE
- F=YKP**2
- Q=1-F
- G=1-PP
- F=F-PP
- Q=(BB-AA*PP)*Q
- PP=SQRT(F/G)
- AA=(AA-BB)/G
- BB=-Q/(G**2*PP)+AA*PP
- ENDIF
- 1 F=AA
- AA=BB/PP+AA
- G=E/PP
- BB=2*(F*G+BB)
- PP=G+PP
- G=XM
- XM=YKP+XM
- IF(ABS(G-YKP) .GT. G*CA) THEN
- YKP=2*SQRT(E)
- E=YKP*XM
- GO TO 1
- ENDIF
- H=PIH*(AA*XM+BB)/(XM*(XM+PP))
- ENDIF
-#if defined(CERNLIB_DOUBLE)
- DELIGC=H
-#endif
-#if !defined(CERNLIB_DOUBLE)
- RELIGC=H
-#endif
- RETURN
- END
diff --git a/src/mathlib/gen/c/relikc64.F b/src/mathlib/gen/c/relikc64.F
deleted file mode 100644
index bde8a42..0000000
--- a/src/mathlib/gen/c/relikc64.F
+++ /dev/null
@@ -1,110 +0,0 @@
-*
-* $Id: relikc64.F,v 1.1.1.1 1996/04/01 15:02:11 mclareni Exp $
-*
-* $Log: relikc64.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:11 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- FUNCTION DELIKC(AK)
-C
-#include "gen/imp64.inc"
-C
- CHARACTER*(*) NAMEK,NAMEE
- PARAMETER(NAMEK='RELIKC/DELIKC',NAMEE='RELIEC/DELIEC')
-#endif
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION RELIKC(AK)
-C
- CHARACTER*(*) NAMEK,NAMEE
- PARAMETER(NAMEK='RELIKC',NAMEE='RELIEC')
-#endif
- CHARACTER*80 ERRTXT
-C
-C Based on
-C W.J. Cody, Chebyshev approximations for the complete elliptic
-C integrals K and E, Math. Comp. l9 (1965) 105-112
-C
- DIMENSION A(8),B(8),P(8),Q(8)
-
- PARAMETER (Z1 = 1, HF = Z1/2, C = 1.38629 43611 19890 6D0)
- DATA A
- 1/6.49984 43329 39018 0D-4, 6.69055 09906 89793 6D-3,
- 2 1.38556 01247 15656 0D-2, 1.12089 18554 64409 2D-2,
- 3 9.65875 79861 75311 3D-3, 1.49789 88178 70462 9D-2,
- 4 3.08855 73486 75269 4D-2, 9.65735 90797 58901 8D-2/
- DATA B
- 1/1.50491 81783 60188 3D-4, 3.18313 09927 86288 6D-3,
- 2 1.41053 80776 15804 8D-2, 2.71898 61116 78825 0D-2,
- 3 3.70683 98934 15542 2D-2, 4.88180 58565 40395 2D-2,
- 4 7.03124 26464 62736 1D-2, 1.24999 99994 11792 3D-1/
- DATA P
- 1/7.09809 64089 98722 9D-4, 7.33561 64974 29036 5D-3,
- 2 1.53771 02528 55201 9D-2, 1.30341 46073 73143 2D-2,
- 3 1.25105 92410 84464 4D-2, 2.18762 20647 18619 8D-2,
- 4 5.68056 57874 69535 8D-2, 4.43147 18112 15580 6D-1/
- DATA Q
- 1/1.64272 10797 04802 5D-4, 3.48386 79435 89649 2D-3,
- 2 1.55251 29948 04072 1D-2, 3.03027 47728 41284 8D-2,
- 3 4.23828 07456 94790 0D-2, 5.85828 39536 55902 4D-2,
- 4 9.37499 20249 68011 3D-2, 2.49999 99993 61762 2D-1/
-
-#if defined(CERNLIB_DOUBLE)
- ENTRY DELLIK(AK)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- ENTRY ELLICK(AK)
-#endif
-
- U=AK**2
- IF(U .LT. 1) THEN
- Y=1-U
- PA=A(1)
- PB=B(1)
- DO 1 I = 2,8
- PA=PA*Y+A(I)
- 1 PB=PB*Y+B(I)
- H=C+PA*Y-LOG(Y)*(HF+PB*Y)
- ELSE
- H=0
- WRITE(ERRTXT,105) AK
- CALL MTLPRT(NAMEK,'C347.5',ERRTXT)
- ENDIF
- GO TO 9
-
-#if defined(CERNLIB_DOUBLE)
- ENTRY DELIEC(AK)
- ENTRY DELLIE(AK)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- ENTRY RELIEC(AK)
- ENTRY ELLICE(AK)
-#endif
-
- U=AK**2
- IF(U .LT. 1) THEN
- Y=1-U
- PA=P(1)
- PB=Q(1)
- DO 2 I = 2,8
- PA=PA*Y+P(I)
- 2 PB=PB*Y+Q(I)
- H=1+(PA-LOG(Y)*PB)*Y
- ELSE IF(U .EQ. 1) THEN
- H=1
- ELSE
- H=0
- WRITE(ERRTXT,105) AK
- CALL MTLPRT(NAMEE,'C347.6',ERRTXT)
- ENDIF
-#if defined(CERNLIB_DOUBLE)
- 9 DELIKC=H
-#endif
-#if !defined(CERNLIB_DOUBLE)
- 9 RELIKC=H
-#endif
- RETURN
- 105 FORMAT('ILLEGAL AK = ',1P,D15.8)
- END
diff --git a/src/mathlib/gen/c/rexpin.F b/src/mathlib/gen/c/rexpin.F
deleted file mode 100644
index 866d7d8..0000000
--- a/src/mathlib/gen/c/rexpin.F
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: rexpin.F,v 1.1.1.1 1996/04/01 15:02:06 mclareni Exp $
-*
-* $Log: rexpin.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:06 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- FUNCTION REXPIN(X)
-C IMPLICIT DOUBLE PRECISION (D)
-#include "gen/def64.inc"
- + D,DEXPIN,DEXPIE
-
- SROUND(D)=D+(D-SNGL(D))
-
- ENTRY EXPINT(X)
-
- REXPIN=SROUND(DEXPIN(DBLE(X)))
- RETURN
-
- ENTRY REXPIE(X)
- REXPIE=SROUND(DEXPIE(DBLE(X)))
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/c/rexpin128.F b/src/mathlib/gen/c/rexpin128.F
deleted file mode 100644
index 0327ff9..0000000
--- a/src/mathlib/gen/c/rexpin128.F
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: rexpin128.F,v 1.1.1.1 1996/04/01 15:02:06 mclareni Exp $
-*
-* $Log: rexpin128.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:06 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION DEXPIN(X)
-#include "gen/imp128.inc"
-C
- CHARACTER*(*) NAME1, NAME2
- PARAMETER( NAME1='DEXPIN')
- PARAMETER( NAME2='DEXPIE')
- DEXPIN=0
- CALL MTLPRT(NAME1,'C337.0','Not available on this machine')
- RETURN
-
- ENTRY DEXPIE(X)
- DEXPIE=0
- CALL MTLPRT(NAME2,'C337.0','Not available on this machine')
- END
-#endif
diff --git a/src/mathlib/gen/c/rexpin64.F b/src/mathlib/gen/c/rexpin64.F
deleted file mode 100644
index 7b25267..0000000
--- a/src/mathlib/gen/c/rexpin64.F
+++ /dev/null
@@ -1,200 +0,0 @@
-*
-* $Id: rexpin64.F,v 1.4 1997/09/04 12:10:28 mclareni Exp $
-*
-* $Log: rexpin64.F,v $
-* Revision 1.4 1997/09/04 12:10:28 mclareni
-* Remove non NT mod introduced with NT mods, the test and Sigma fail
-*
-* Revision 1.3 1997/09/02 16:09:37 mclareni
-* WINNT corrections
-*
-* Revision 1.2 1997/04/07 10:01:01 mclareni
-* Mods for winnt
-*
-* Revision 1.1.1.1.2.1 1997/01/21 11:26:01 mclareni
-* All mods for Winnt 96a on winnt branch
-*
-* Revision 1.1.1.1 1996/04/01 15:02:06 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION REXPIN(X)
-#endif
-#if defined(CERNLIB_DOUBLE)
- FUNCTION DEXPIN(X)
-#include "gen/imp64.inc"
-#endif
- LOGICAL LEX
- CHARACTER NAME*(*),NAMEE*(*)
-#if !defined(CERNLIB_DOUBLE)
- PARAMETER (NAME = 'REXPIN', NAMEE = 'REXPIE')
-#endif
-#if defined(CERNLIB_DOUBLE)
- PARAMETER (NAME = 'REXPIN/DEXPIN', NAMEE = 'REXPIE/DEXPIE')
-#endif
- DIMENSION P1(5),Q1(5),P2(7),Q2(7),P3(7),Q3(7),P4(8),Q4(8)
- DIMENSION A1(8),B1(8),A2(8),B2(8),A3(8),B3(8)
-
- PARAMETER (Z1 = 1, R3 = -2*Z1/3, X0 = 0.37250 74107 81366 63D0)
- DATA P1
- 1/+4.29312 52343 20972 6D+0, +3.98941 53870 32106 6D+1,
- 2 +2.92525 18866 92054 9D+2, +4.25696 82638 59170 3D+2,
- 3 -4.34981 43832 95212 0D+2/
- DATA Q1
- 1/+1.00000 00000 00000 0D+0, +1.88992 88395 00296 9D+1,
- 2 +1.50950 38744 25130 9D+2, +5.68052 52718 98695 5D+2,
- 3 +7.53585 64359 84293 2D+2/
- DATA P2
- 1/+4.30967 83946 93887 8D-1, +6.90522 52278 44435 7D+0,
- 2 +2.30192 55939 13334 6D+1, +2.43784 08879 13167 3D+1,
- 3 +9.04161 55694 63286 6D+0, +9.99979 57705 15949 7D-1,
- 4 +4.65627 10797 50956 60D-7/
- DATA Q2
- 1/+1.03400 13040 48739 8D-1, +3.31909 21359 33016 0D+0,
- 2 +2.04494 78501 37941 7D+1, +4.12807 84189 14243 4D+1,
- 3 +3.24264 21069 51380 5D+1, +1.00411 64382 90544 8D+1,
- 4 +1.00000 00000 00000 0D+0/
- DATA P3
- 1/-5.66575 20653 38687 4D+0, -5.45374 15888 31328 7D+2,
- 2 -1.29885 68874 64841 0D+3, -8.95927 95777 29368 1D+2,
- 3 -2.41055 82709 70148 5D+2, -2.66271 06043 18114 5D+1,
- 4 -9.99999 99999 84469 1D-1/
- DATA Q3
- 1/+6.31657 48328 08002 3D+2, +2.40401 71322 59089 5D+3,
- 2 +2.77761 94950 91629 6D+3, +1.33278 53774 82572 3D+3,
- 3 +2.92310 03938 85332 5D+2, +2.86271 06042 21919 0D+1,
- 4 +1.00000 00000 00000 0D+0/
- DATA P4
- 1/-8.66937 33995 10695 6D+0, -5.49142 26552 10851 5D+2,
- 2 -4.21001 61535 70699 3D+3, -2.49301 39345 86475 9D+5,
- 3 -1.19623 66934 92468 7D+5, -2.21744 62775 88453 8D+7,
- 4 +3.89280 42131 12014 1D+6, -3.91546 07380 90955 5D+8/
- DATA Q4
- 1/+3.41718 75000 00000 0D+1, -1.60708 92658 72208 5D+3,
- 2 +3.57300 29805 85081 1D+4, -4.83547 43616 21635 1D+5,
- 3 +4.28559 62461 17490 4D+6, -2.49033 37574 05403 3D+7,
- 4 +8.91925 76757 56121 1D+7, -1.65254 29972 52109 1D+8/
- DATA A1
- 1/-2.18086 38152 07237 1D+0, -2.19010 23385 48806 9D+1,
- 2 +9.30816 38566 21651 5D+0, +2.50762 81129 35598 3D+1,
- 3 -3.31842 53199 72211 2D+1, +6.01217 99083 00804 8D+1,
- 4 -4.32531 13287 81345 8D+1, +1.00443 10922 80779 1D+0/
- DATA B1
- 1/+0.00000 00000 00000 0D+0, +3.93707 70185 27150 0D+0,
- 2 +3.00892 64837 29152 0D+2, -6.25041 16167 18755 4D+0,
- 3 +1.00367 43951 67257 7D+3, +1.43256 73812 19376 0D+1,
- 4 +2.73624 11988 93280 6D+3, +5.27468 85196 29078 5D-1/
- DATA A2
- 1/-3.48334 65360 28526 1D+0, -1.86545 45488 33988 4D+1,
- 2 -8.28561 99414 06413 2D+0, -3.23467 33030 54034 6D+1,
- 3 +1.79601 68876 92516 4D+1, +1.75656 31546 96144 2D+0,
- 4 -1.95022 32128 96598 2D+0, +9.99994 29607 47082 9D-1/
- DATA B2
- 1/+0.00000 00000 00000 0D+0, +6.95000 65588 74339 8D+1,
- 2 +5.72837 19383 73237 2D+1, +2.57776 38423 84398 7D+1,
- 3 +7.60761 14800 77345 8D+2, +2.89516 72792 51350 5D+1,
- 4 -3.43942 26689 98699 7D+0, +1.00083 86740 26391 2D+0/
- DATA A3
- 1/-5.31686 62349 44816 2D+1, +8.91263 82257 37077 5D+0,
- 2 -1.39381 36036 44050 7D+0, -3.08336 26905 17627 0D+1,
- 3 -7.49289 16779 28844 3D+0, -5.00140 34551 59243 5D+0,
- 4 -3.00000 01678 20851 8D+0, +1.00000 00000 00583 9D+0/
- DATA B3
- 1/+0.00000 00000 00000 0D+0, +1.04745 36265 24683 0D+3,
- 2 -6.74704 58046 58324 3D+0, +2.95999 39948 68313 3D+2,
- 3 -4.31325 83614 66279 6D+0, -7.90404 99229 89255 1D+0,
- 4 -2.99996 43294 44464 6D+0, +1.99999 99992 41308 9D+0/
-
-#if !defined(CERNLIB_DOUBLE)
- ENTRY EXPINT
-#endif
- LEX=.FALSE.
- GO TO 9
-
-#if !defined(CERNLIB_DOUBLE)
- ENTRY REXPIE
-#endif
-#if defined(CERNLIB_DOUBLE)
-# ifdef CERNLIB_MSSTDCALL
- ENTRY DEXPIE(x)
-# else
- ENTRY DEXPIE
-# endif
-#endif
- LEX=.TRUE.
-
- 9 IF(X .LE. -24) THEN
- AP=A3(1)-X
- DO 1 I = 2,7
- 1 AP=A3(I)-X+B3(I)/AP
- H=(1-(A3(8)+B3(8)/AP)/X)/X
- IF(.NOT.LEX) H=EXP(-X)*H
- ELSE IF(X .LE. -12) THEN
- AP=A2(1)-X
- DO 2 I = 2,7
- 2 AP=A2(I)-X+B2(I)/AP
- H=(A2(8)+B2(8)/AP)/X
- IF(.NOT.LEX) H=EXP(-X)*H
- ELSE IF(X .LE. -6) THEN
- AP=A1(1)-X
- DO 3 I = 2,7
- 3 AP=A1(I)-X+B1(I)/AP
- H=(A1(8)+B1(8)/AP)/X
- IF(.NOT.LEX) H=EXP(-X)*H
- ELSE IF(X .LT. 0) THEN
- V=R3*X-2
- BP=0
- DP=P4(1)
- DO 4 I = 2,8
- AP=BP
- BP=DP
- 4 DP=P4(I)-AP+V*BP
- BQ=0
- DQ=Q4(1)
- DO 14 I = 2,8
- AQ=BQ
- BQ=DQ
- 14 DQ=Q4(I)-AQ+V*BQ
- H=-LOG(-X/X0)+(X+X0)*(DP-AP)/(DQ-AQ)
- IF(LEX) H=EXP(X)*H
- ELSE IF(X .EQ. 0) THEN
- H=0
- IF(.NOT.LEX) CALL MTLPRT(NAME ,'C337.1','ARGUMENT X = 0')
- IF( LEX) CALL MTLPRT(NAMEE,'C337.1','ARGUMENT X = 0')
- ELSE IF(X .LT. 1) THEN
- AP=P1(1)
- AQ=Q1(1)
- DO 5 I = 2,5
- AP=P1(I)+X*AP
- 5 AQ=Q1(I)+X*AQ
- H=-LOG(X)+AP/AQ
- IF(LEX) H=EXP(X)*H
- ELSE IF(X .LE. 4) THEN
- Y=1/X
- AP=P2(1)
- AQ=Q2(1)
- DO 6 I = 2,7
- AP=P2(I)+Y*AP
- 6 AQ=Q2(I)+Y*AQ
- H=AP/AQ
- IF(.NOT.LEX) H=EXP(-X)*H
- ELSE
- Y=1/X
- AP=P3(1)
- AQ=Q3(1)
- DO 7 I = 2,7
- AP=P3(I)+Y*AP
- 7 AQ=Q3(I)+Y*AQ
- H=Y*(1+Y*AP/AQ)
- IF(.NOT.LEX) H=EXP(-X)*H
- END IF
-#if !defined(CERNLIB_DOUBLE)
- REXPIN=H
-#endif
-#if defined(CERNLIB_DOUBLE)
- DEXPIN=H
-#endif
- RETURN
- END
diff --git a/src/mathlib/gen/c/rfconc.F b/src/mathlib/gen/c/rfconc.F
deleted file mode 100644
index fa1cdf9..0000000
--- a/src/mathlib/gen/c/rfconc.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: rfconc.F,v 1.1.1.1 1996/04/01 15:02:04 mclareni Exp $
-*
-* $Log: rfconc.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:04 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- FUNCTION RFCONC(X,TAU,M)
-#include "gen/def64.inc"
- + DFCONC,D
-
- SROUND(D)=D+(D-SNGL(D))
-
- RFCONC=SROUND(DFCONC(DBLE(X),DBLE(TAU),M))
- RETURN
-
- ENTRY FCONC(X,TAU,M)
-
- FCONC=SROUND(DFCONC(DBLE(X),DBLE(TAU),M))
- RETURN
-
- END
-#endif
diff --git a/src/mathlib/gen/c/rferfr.F b/src/mathlib/gen/c/rferfr.F
deleted file mode 100644
index 92c5ca3..0000000
--- a/src/mathlib/gen/c/rferfr.F
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: rferfr.F,v 1.1.1.1 1996/04/01 15:02:02 mclareni Exp $
-*
-* $Log: rferfr.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:02 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- FUNCTION RFERDR(X,K)
-#include "gen/def64.inc"
- + DFERDR,D
-
- SROUND(D)=D+(D-SNGL(D))
-
- RFERDR=SROUND(DFERDR(DBLE(X),K))
- RETURN
-
- ENTRY FERDR(X,K)
- FERDR=SROUND(DFERDR(DBLE(X),K))
- RETURN
-
- END
-#endif
diff --git a/src/mathlib/gen/c/rfrsin.F b/src/mathlib/gen/c/rfrsin.F
deleted file mode 100644
index 71342bf..0000000
--- a/src/mathlib/gen/c/rfrsin.F
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: rfrsin.F,v 1.1.1.1 1996/04/01 15:02:02 mclareni Exp $
-*
-* $Log: rfrsin.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:02 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- FUNCTION RFRSIN(X)
-#include "gen/def64.inc"
- + DFRSIN,DFRCOS,D
-
- SROUND(D)=D+(D-SNGL(D))
-
- RFRSIN=SROUND(DFRSIN(DBLE(X)))
- RETURN
-
- ENTRY FRSIN(X)
- FRSIN=SROUND(DFRSIN(DBLE(X)))
- RETURN
-
- ENTRY RFRCOS(X)
- RFRCOS=SROUND(DFRCOS(DBLE(X)))
- RETURN
-
- ENTRY FRCOS(X)
- FRCOS=SROUND(DFRCOS(DBLE(X)))
- RETURN
-
- END
-#endif
diff --git a/src/mathlib/gen/c/rgam.F b/src/mathlib/gen/c/rgam.F
deleted file mode 100644
index 1073569..0000000
--- a/src/mathlib/gen/c/rgam.F
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: rgam.F,v 1.1.1.1 1996/04/01 15:01:59 mclareni Exp $
-*
-* $Log: rgam.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:59 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- COMPLEX FUNCTION RGAM(Z,A,B)
-
- COMPLEX Z,A,B,CLOGAM
-
- RGAM=EXP(CLOGAM(Z+A)-CLOGAM(Z+B))
- RETURN
- END
diff --git a/src/mathlib/gen/c/rgapnc.F b/src/mathlib/gen/c/rgapnc.F
deleted file mode 100644
index eb58297..0000000
--- a/src/mathlib/gen/c/rgapnc.F
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: rgapnc.F,v 1.1.1.1 1996/04/01 15:02:05 mclareni Exp $
-*
-* $Log: rgapnc.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:05 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- FUNCTION RGAPNC(A,X)
-#include "gen/def64.inc"
- + DGAPNC,DGAGNC,D
-
- SROUND(D)=D+(D-SNGL(D))
-
- RGAPNC=SROUND(DGAPNC(DBLE(A),DBLE(X)))
- RETURN
-
- ENTRY RGAGNC(A,X)
- RGAGNC=SROUND(DGAGNC(DBLE(A),DBLE(X)))
- RETURN
-
- ENTRY GAPNC(A,X)
- GAPNC=SROUND(DGAPNC(DBLE(A),DBLE(X)))
- RETURN
-
- ENTRY GAGNC(A,X)
- GAGNC=SROUND(DGAGNC(DBLE(A),DBLE(X)))
- RETURN
-
- END
-#endif
diff --git a/src/mathlib/gen/c/rmullz.F b/src/mathlib/gen/c/rmullz.F
deleted file mode 100644
index 11f6128..0000000
--- a/src/mathlib/gen/c/rmullz.F
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: rmullz.F,v 1.1.1.1 1996/04/01 15:01:52 mclareni Exp $
-*
-* $Log: rmullz.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:52 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- SUBROUTINE RMULLZ(A,N,MAXITR,Z0)
-C
- CHARACTER*(*) NAME
- PARAMETER( NAME='RMULLZ')
- CALL MTLPRT(NAME,'C202.0','Not available on this machine')
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/c/rmullz128.F b/src/mathlib/gen/c/rmullz128.F
deleted file mode 100644
index 16520a8..0000000
--- a/src/mathlib/gen/c/rmullz128.F
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: rmullz128.F,v 1.1.1.1 1996/04/01 15:01:52 mclareni Exp $
-*
-* $Log: rmullz128.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:52 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if !defined(CERNLIB_DOUBLE)
- SUBROUTINE DMULLZ(A,N,MAXITR,Z0)
-C
-#include "gen/imp128.inc"
-C
- CHARACTER*(*) NAME
- PARAMETER( NAME='DMULLZ')
- CALL MTLPRT(NAME,'C202.0','Not available on this machine')
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/c/rmullz64.F b/src/mathlib/gen/c/rmullz64.F
deleted file mode 100644
index d82efcc..0000000
--- a/src/mathlib/gen/c/rmullz64.F
+++ /dev/null
@@ -1,159 +0,0 @@
-*
-* $Id: rmullz64.F,v 1.1.1.1 1996/04/01 15:01:52 mclareni Exp $
-*
-* $Log: rmullz64.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:52 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- SUBROUTINE DMULLZ(A,N,MAXITR,Z0)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- SUBROUTINE RMULLZ(A,N,MAXITR,Z0)
-#endif
-#include "gen/imp64.inc"
-#include "gen/defc64.inc"
- + Z0,Z,DX,X,X3,Y1,Y2,Y,TE(7)
- LOGICAL LSW
- DIMENSION A(0:*),Z0(*)
- CHARACTER*(*) NAME
-#if defined(CERNLIB_DOUBLE)
- PARAMETER( NAME='DMULLZ')
-#endif
-#if !defined(CERNLIB_DOUBLE)
- PARAMETER( NAME='RMULLZ')
-#endif
- PARAMETER (Z1 = 1, HF = Z1/2)
- PARAMETER (ETA1 = 1D-14, ETA2 = 6D-8, BIG = 1D20)
- PARAMETER (C1 = 0.9D0, C2 = 0.002D0, C3 = 0.1D0)
-
-#include "gen/gcmpfun.inc"
- SUMABS(Z)=ABS(GREAL(Z))+ABS(GIMAG(Z))
-
- IF(N .LE. 0) RETURN
- IF(A(0) .EQ. 0) THEN
- CALL MTLPRT(NAME,'C202.1','A(0) = 0')
- RETURN
- ENDIF
-
- N1=N
- 2 IF(N1 .EQ. 1) THEN
- Z0(1)=-A(1)/A(0)
- RETURN
- ENDIF
- IF(A(N1) .EQ. 0) THEN
- Z0(N1)=0
- N1=N1-1
- GO TO 2
- ENDIF
-
- SCALE=ABS(A(N1)/A(0))**(Z1/N1)
- B=A(0)
- DO 6 I = 1,N1
- B=B*SCALE
- 6 Z0(I)=A(I)/B
- IF(N1 .EQ. 2) GO TO 1
-
- 10 LSW=.TRUE.
- Y1=Z0(1)+1
- Y2=Z0(1)-1
- DO 11 I = 2,N1
- Y1=Z0(I)+Y1
- 11 Y2=Z0(I)-Y2
- Y=Z0(N1)
- X=0
- DX=1
-
- TE(1)=-2
- 12 TE(2)=Y2/Y
- TE(3)=(Y1-Y2)/(Y*TE(1))
- DO 17 ITER = 1,MAXITR
- TE(4)=TE(2)-1
- TE(5)=(TE(4)-TE(3))/(TE(1)+1)
- TE(6)=HF*(TE(5)+TE(4))
- TE(7)=SQRT(TE(6)**2+TE(5))
- TE(1)=TE(6)+TE(7)
- TE(7)=TE(6)-TE(7)
- IF(ABS(TE(1)) .LE. ABS(TE(7))) THEN
- IF(TE(7) .EQ. 0) TE(7)=C1
- TE(1)=TE(7)
- ENDIF
- DX=DX/TE(1)
- X=DX+X
- EPSI=SUMABS(X)*ETA1
- IF(SUMABS(DX) .LT. EPSI .AND. SUMABS(Y) .LT. C2) GO TO 18
- Y2=Y
- Y=X+Z0(1)
- DO 21 I = 2,N1
- 21 Y=Y*X+Z0(I)
- IF(Y .EQ. 0) GO TO 18
-
- 15 IF(SUMABS(Y) .GE. 100*SUMABS(Y2) .AND. SUMABS(DX) .GE. EPSI) THEN
- TE(1)=2*TE(1)
- DX=HF*DX
- X=X-DX
- Y=X+Z0(1)
- DO 22 I = 2,N1
- 22 Y=Y*X+Z0(I)
- IF(Y .EQ. 0) GO TO 18
- GOTO 15
- ENDIF
-
- TE(2)=Y2/Y
- TE(3)=(TE(2)/TE(1))*TE(4)
- 17 CONTINUE
-
- CN=ABS(Z0(N1))
- IF(ABS(CN-1) .LT. C3) THEN
- DO 40 I = 1,N1
- 40 Z0(I)=BIG
- CALL MTLPRT(NAME,'C202.2','TOO MANY ITERATIONS')
- RETURN
- ENDIF
- S=CN**(-Z1/N1)
- SCALE=SCALE/S
- B=1
- DO 30 I = 1,N1
- B=B*S
- 30 Z0(I)=Z0(I)*B
- GO TO 10
-
- 20 IF(ABS(GIMAG(X)) .LT. ABS(GREAL(X))*ETA2) GO TO 10
- LSW=.FALSE.
- X3=GCONJG(X)
- DX=GCONJG(DX)
- TE(1)=GCONJG(TE(1))
- X=X3-DX
- Y=X+Z0(1)
- DO 51 I = 2,N1
- 51 Y=Y*X+Z0(I)
- IF(Y .EQ. 0) GO TO 18
- Y2=Y
- X=X-DX*TE(1)
- Y=X+Z0(1)
- DO 52 I = 2,N1
- 52 Y=Y*X+Z0(I)
- IF(Y .EQ. 0) GO TO 18
- Y1=Y
- X=X3
- Y=X+Z0(1)
- DO 53 I = 2,N1
- 53 Y=Y*X+Z0(I)
- IF(Y .NE. 0) GO TO 12
-
- 18 Z0(N1)=X*SCALE
- N1=N1-1
- Z0(1)=X+Z0(1)
- DO 19 I = 2,N1
- 19 Z0(I)=Z0(I-1)*X+Z0(I)
- IF(N1 .GT. 2) THEN
- IF(LSW) GO TO 20
- GO TO 10
- ENDIF
-
- 1 Z0(2)=(SQRT((HF*Z0(1))**2-Z0(2))-HF*Z0(1))*SCALE
- Z0(1)=-Z0(1)*SCALE-Z0(2)
- RETURN
- END
diff --git a/src/mathlib/gen/c/rpsipg.F b/src/mathlib/gen/c/rpsipg.F
deleted file mode 100644
index d2e58ed..0000000
--- a/src/mathlib/gen/c/rpsipg.F
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: rpsipg.F,v 1.1.1.1 1996/04/01 15:02:00 mclareni Exp $
-*
-* $Log: rpsipg.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:00 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- FUNCTION RPSIPG(X,K)
-#include "gen/def64.inc"
- + D,DPSIPG
-
- SROUND(D)=D+(D-SNGL(D))
- RPSIPG=SROUND(DPSIPG(DBLE(X),K))
- RETURN
-
- ENTRY ADIGAM(X)
- ADIGAM=SROUND(DPSIPG(DBLE(X),0))
- END
-#endif
diff --git a/src/mathlib/gen/c/rpsipg64.F b/src/mathlib/gen/c/rpsipg64.F
deleted file mode 100644
index f0cda23..0000000
--- a/src/mathlib/gen/c/rpsipg64.F
+++ /dev/null
@@ -1,312 +0,0 @@
-*
-* $Id: rpsipg64.F,v 1.1.1.1 1996/04/01 15:02:01 mclareni Exp $
-*
-* $Log: rpsipg64.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:01 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- FUNCTION DPSIPG(X,K)
-C
-#include "gen/imp64.inc"
-C
- CHARACTER*(*) NAME
- PARAMETER(NAME='RPSIPG/DPSIPG')
-#endif
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION RPSIPG(X,K)
-C
- CHARACTER*(*) NAME
- PARAMETER(NAME='RPSIPG')
-#endif
-C
- DIMENSION B(0:20,6),C(7,6),NB(6),P1(0:7),Q1(0:7),P2(0:4),Q2(0:4)
- DIMENSION SGN(6),SGF(0:6),SGH(6)
-
- PARAMETER (DELTA = 1D-13)
- PARAMETER (Z1 = 1, HF = Z1/2)
- PARAMETER (PI = 3.14159 26535 89793 24D0)
- PARAMETER (C1 = -PI**2, C2 = 2*PI**3, C3 = 2*PI**4)
- PARAMETER (C4 = -8*PI**5, C5 = -8*PI**6, C6 = 16*PI**7)
-
- CHARACTER*80 ERRTXT
-
- DATA NB /16,17,17,18,19,20/
- DATA SGN /-1,1,-1,1,-1,1/, SGF /1,-1,2,-6,24,-120,720/
- DATA SGH /-0.5D0,1,-3,12,-60,360/
- DATA X0 /1.46163 21449 68362 34D0/
-
- DATA (P1(J),Q1(J),J=0,7)
- A/ 1.35249 99667 72634 64D+4, 6.93891 11753 76344 44D-7,
- 1 4.52856 01699 54728 97D+4, 1.97685 74263 04673 64D+4,
- 2 4.51351 68469 73666 26D+4, 4.12551 60835 35383 23D+4,
- 3 1.85290 11818 58261 02D+4, 2.93902 87119 93268 19D+4,
- 4 3.32915 25149 40693 55D+3, 9.08196 66074 85517 03D+3,
- 5 2.40680 32474 35720 18D+2, 1.24474 77785 67085 60D+3,
- 6 5.15778 92000 13908 47D+0, 6.74291 29516 37859 38D+1,
- 7 6.22835 06918 98474 58D-3, 1/
-
- DATA (P2(J),Q2(J),J=0,4)
- A/-2.72817 57513 15296 78D-15,7.77788 54852 29616 04D+0,
- 1 -6.48157 12376 61965 10D-1, 5.46117 73810 32150 70D+1,
- 2 -4.48616 54391 80193 58D+0, 8.92920 70048 18613 70D+1,
- 3 -7.01677 22776 67586 64D+0, 3.22703 49379 11433 61D+1,
- 7 -2.12940 44513 10105 17D+0, 1/
-
- DATA B( 0,1) / 0.33483 86979 10949 386D0/
- DATA B( 1,1) /-0.05518 74820 48730 095D0/
- DATA B( 2,1) / 0.00451 01907 36011 502D0/
- DATA B( 3,1) /-0.00036 57058 88303 721D0/
- DATA B( 4,1) / 0.00002 94346 27468 223D0/
- DATA B( 5,1) /-0.00000 23527 76815 151D0/
- DATA B( 6,1) / 0.00000 01868 53176 633D0/
- DATA B( 7,1) /-0.00000 00147 50720 184D0/
- DATA B( 8,1) / 0.00000 00011 57993 337D0/
- DATA B( 9,1) /-0.00000 00000 90439 179D0/
- DATA B(10,1) / 0.00000 00000 07029 627D0/
- DATA B(11,1) /-0.00000 00000 00543 989D0/
- DATA B(12,1) / 0.00000 00000 00041 925D0/
- DATA B(13,1) /-0.00000 00000 00003 219D0/
- DATA B(14,1) / 0.00000 00000 00000 246D0/
- DATA B(15,1) /-0.00000 00000 00000 019D0/
- DATA B(16,1) / 0.00000 00000 00000 001D0/
-
- DATA B( 0,2) /-0.11259 29353 45473 830D0/
- DATA B( 1,2) / 0.03655 70017 42820 941D0/
- DATA B( 2,2) /-0.00443 59424 96027 282D0/
- DATA B( 3,2) / 0.00047 54758 54728 926D0/
- DATA B( 4,2) /-0.00004 74718 36382 632D0/
- DATA B( 5,2) / 0.00000 45218 15237 353D0/
- DATA B( 6,2) /-0.00000 04163 00079 620D0/
- DATA B( 7,2) / 0.00000 00373 38998 165D0/
- DATA B( 8,2) /-0.00000 00032 79914 474D0/
- DATA B( 9,2) / 0.00000 00002 83211 377D0/
- DATA B(10,2) /-0.00000 00000 24104 028D0/
- DATA B(11,2) / 0.00000 00000 02026 297D0/
- DATA B(12,2) /-0.00000 00000 00168 524D0/
- DATA B(13,2) / 0.00000 00000 00013 885D0/
- DATA B(14,2) /-0.00000 00000 00001 135D0/
- DATA B(15,2) / 0.00000 00000 00000 092D0/
- DATA B(16,2) /-0.00000 00000 00000 007D0/
- DATA B(17,2) / 0.00000 00000 00000 001D0/
-
- DATA B( 0,3) / 0.07601 26046 55110 384D0/
- DATA B( 1,3) /-0.03625 71864 81828 739D0/
- DATA B( 2,3) / 0.00579 72023 38937 002D0/
- DATA B( 3,3) /-0.00076 96465 13610 481D0/
- DATA B( 4,3) / 0.00009 14920 82189 884D0/
- DATA B( 5,3) /-0.00001 00971 31488 364D0/
- DATA B( 6,3) / 0.00000 10557 77442 831D0/
- DATA B( 7,3) /-0.00000 01059 29577 481D0/
- DATA B( 8,3) / 0.00000 00102 85494 201D0/
- DATA B( 9,3) /-0.00000 00009 72314 310D0/
- DATA B(10,3) / 0.00000 00000 89884 635D0/
- DATA B(11,3) /-0.00000 00000 08153 171D0/
- DATA B(12,3) / 0.00000 00000 00727 572D0/
- DATA B(13,3) /-0.00000 00000 00064 010D0/
- DATA B(14,3) / 0.00000 00000 00005 562D0/
- DATA B(15,3) /-0.00000 00000 00000 478D0/
- DATA B(16,3) / 0.00000 00000 00000 041D0/
- DATA B(17,3) /-0.00000 00000 00000 003D0/
-
- DATA B( 0,4) /-0.07723 47240 56994 793D0/
- DATA B( 1,4) / 0.04786 71634 51599 467D0/
- DATA B( 2,4) /-0.00944 07021 86674 632D0/
- DATA B( 3,4) / 0.00148 95447 40103 448D0/
- DATA B( 4,4) /-0.00020 49440 23348 860D0/
- DATA B( 5,4) / 0.00002 56714 25065 297D0/
- DATA B( 6,4) /-0.00000 30013 93581 584D0/
- DATA B( 7,4) / 0.00000 03327 66437 356D0/
- DATA B( 8,4) /-0.00000 00353 65412 111D0/
- DATA B( 9,4) / 0.00000 00036 30622 927D0/
- DATA B(10,4) /-0.00000 00003 62096 951D0/
- DATA B(11,4) / 0.00000 00000 35237 509D0/
- DATA B(12,4) /-0.00000 00000 03357 440D0/
- DATA B(13,4) / 0.00000 00000 00314 068D0/
- DATA B(14,4) /-0.00000 00000 00028 908D0/
- DATA B(15,4) / 0.00000 00000 00002 623D0/
- DATA B(16,4) /-0.00000 00000 00000 235D0/
- DATA B(17,4) / 0.00000 00000 00000 021D0/
- DATA B(18,4) /-0.00000 00000 00000 002D0/
-
- DATA B( 0,5) / 0.10493 30344 59278 632D0/
- DATA B( 1,5) /-0.07887 79016 52793 557D0/
- DATA B( 2,5) / 0.01839 74151 12159 397D0/
- DATA B( 3,5) /-0.00335 22841 59396 504D0/
- DATA B( 4,5) / 0.00052 28782 30918 016D0/
- DATA B( 5,5) /-0.00007 31797 85814 740D0/
- DATA B( 6,5) / 0.00000 94497 29612 085D0/
- DATA B( 7,5) /-0.00000 11463 39856 723D0/
- DATA B( 8,5) / 0.00000 01322 69366 108D0/
- DATA B( 9,5) /-0.00000 00146 46669 180D0/
- DATA B(10,5) / 0.00000 00015 66940 742D0/
- DATA B(11,5) /-0.00000 00001 62791 157D0/
- DATA B(12,5) / 0.00000 00000 16490 345D0/
- DATA B(13,5) /-0.00000 00000 01634 028D0/
- DATA B(14,5) / 0.00000 00000 00158 807D0/
- DATA B(15,5) /-0.00000 00000 00015 171D0/
- DATA B(16,5) / 0.00000 00000 00001 427D0/
- DATA B(17,5) /-0.00000 00000 00000 132D0/
- DATA B(18,5) / 0.00000 00000 00000 012D0/
- DATA B(19,5) /-0.00000 00000 00000 001D0/
-
- DATA B( 0,6) /-0.17861 76221 42502 753D0/
- DATA B( 1,6) / 0.15577 64622 00520 579D0/
- DATA B( 2,6) /-0.04172 36376 73831 277D0/
- DATA B( 3,6) / 0.00859 71413 03245 400D0/
- DATA B( 4,6) /-0.00149 62277 61073 229D0/
- DATA B( 5,6) / 0.00023 10896 08557 137D0/
- DATA B( 6,6) /-0.00003 26320 44778 436D0/
- DATA B( 7,6) / 0.00000 42960 97867 090D0/
- DATA B( 8,6) /-0.00000 05345 28790 204D0/
- DATA B( 9,6) / 0.00000 00634 78151 644D0/
- DATA B(10,6) /-0.00000 00072 48699 714D0/
- DATA B(11,6) / 0.00000 00008 00521 979D0/
- DATA B(12,6) /-0.00000 00000 85888 793D0/
- DATA B(13,6) / 0.00000 00000 08985 442D0/
- DATA B(14,6) /-0.00000 00000 00919 356D0/
- DATA B(15,6) / 0.00000 00000 00092 225D0/
- DATA B(16,6) /-0.00000 00000 00009 090D0/
- DATA B(17,6) / 0.00000 00000 00000 882D0/
- DATA B(18,6) /-0.00000 00000 00000 084D0/
- DATA B(19,6) / 0.00000 00000 00000 008D0/
- DATA B(20,6) /-0.00000 00000 00000 001D0/
-
- DATA C(1,1) / 1.66666 66666 66666 67D-1/
- DATA C(2,1) /-3.33333 33333 33333 33D-2/
- DATA C(3,1) / 2.38095 23809 52380 95D-2/
- DATA C(4,1) /-3.33333 33333 33333 33D-2/
- DATA C(5,1) / 7.57575 75757 57575 76D-2/
- DATA C(6,1) /-2.53113 55311 35531 14D-1/
- DATA C(7,1) / 1.16666 66666 66666 67D 0/
-
- DATA C(1,2) / 5.00000 00000 00000 00D-1/
- DATA C(2,2) /-1.66666 66666 66666 67D-1/
- DATA C(3,2) / 1.66666 66666 66666 67D-1/
- DATA C(4,2) /-3.00000 00000 00000 00D-1/
- DATA C(5,2) / 8.33333 33333 33333 33D-1/
- DATA C(6,2) /-3.29047 61904 76190 48D 0/
- DATA C(7,2) / 1.75000 00000 00000 00D 1/
-
- DATA C(1,3) / 2.00000 00000 00000 00D 0/
- DATA C(2,3) /-1.00000 00000 00000 00D 0/
- DATA C(3,3) / 1.33333 33333 33333 33D 0/
- DATA C(4,3) /-3.00000 00000 00000 00D 0/
- DATA C(5,3) / 1.00000 00000 00000 00D+1/
- DATA C(6,3) /-4.60666 66666 66666 67D+1/
- DATA C(7,3) / 2.80000 00000 00000 00D+2/
-
- DATA (C(J,4),J=1,7) /10,-7,12,-33,130,-691,4760/
- DATA (C(J,5),J=1,7) /60,-56,120,-396,1820,-11056,85680/
- DATA (C(J,6),J=1,7) /420,-504,1320,-5148,27300,-187952,1627920/
-
- A=ABS(X)
- V=A
- IX=X-DELTA
- IF(K .LT. 0 .OR. K .GT. 6) THEN
- H=0
- WRITE(ERRTXT,101) K
- CALL MTLPRT(NAME,'C316.1',ERRTXT)
- ELSEIF(ABS(IX-X) .LE. DELTA) THEN
- H=0
- WRITE(ERRTXT,102) X
- CALL MTLPRT(NAME,'C316.2',ERRTXT)
- ELSEIF(K .EQ. 0) THEN
- IF(A .LE. 3) THEN
- S=0
- IF(A .LT. HF) THEN
- S=1/V
- V=V+1
- ENDIF
- AP=P1(7)
- AQ=Q1(7)
- DO 11 I = 6,0,-1
- AP=P1(I)+V*AP
- 11 AQ=Q1(I)+V*AQ
- H=(V-X0)*AP/AQ-S
- ELSE
- R=1/V**2
- AP=P2(4)
- AQ=Q2(4)
- DO 12 I = 3,0,-1
- AP=P2(I)+R*AP
- 12 AQ=Q2(I)+R*AQ
- H=LOG(V)-HF/V+AP/AQ
- ENDIF
- IF(X .LT. 0) H=H+1/A+PI/TAN(PI*A)
- ELSE
- K1=K+1
- IF(A .LE. 10) THEN
- IF(A .LT. 3) THEN
- S=-1/V**K1
- DO 1 J = 1,2-INT(A)
- V=V+1
- 1 S=S-1/V**K1
- V=V+1
- ELSEIF(A .LE. 4) THEN
- S=0
- ELSE
- V=V-1
- S=1/V**K1
- DO 5 J = 1,INT(A)-4
- V=V-1
- 5 S=S+1/V**K1
- ENDIF
- H=2*V-7
- ALFA=H+H
- B1=0
- B2=0
- DO 2 J = NB(K),0,-1
- B0=B(J,K)+ALFA*B1-B2
- B2=B1
- 2 B1=B0
- H=B0-H*B2+SGF(K)*S
- ELSE
- S=0
- IF(A .LT. 15) THEN
- S=1/V**K1
- DO 3 J = 1,14-INT(A)
- V=V+1
- 3 S=S+1/V**K1
- V=V+1
- ENDIF
- R=1/V**2
- P=R*C(7,K)
- DO 4 J = 6,1,-1
- 4 P=R*(C(J,K)+P)
- H=((SGF(K-1)-SGN(K)*P)*V-SGH(K))/V**K1-SGF(K)*S
- ENDIF
- IF(X .LT. 0) THEN
- P=PI*A
- IF(K .EQ. 1) THEN
- V=C1/SIN(P)**2
- ELSEIF(K .EQ. 2) THEN
- V=C2*COS(P)/SIN(P)**3
- ELSEIF(K .EQ. 3) THEN
- S=SIN(P)**2
- V=C3*(2*S-3)/S**2
- ELSEIF(K .EQ. 4) THEN
- S=SIN(P)
- V=C4*COS(P)*(S**2-3)/S**5
- ELSEIF(K .EQ. 5) THEN
- S=SIN(P)**2
- V=C5*(15-15*S+2*S**2)/S**3
- ELSEIF(K .EQ. 6) THEN
- S=SIN(P)
- V=C6*COS(P)*(45-30*S**2+2*S**4)/S**7
- ENDIF
- H=SGN(K)*(H+V+SGF(K)/A**K1)
- ENDIF
- ENDIF
-#if defined(CERNLIB_DOUBLE)
- DPSIPG=H
-#endif
-#if !defined(CERNLIB_DOUBLE)
- RPSIPG=H
-#endif
- RETURN
- 101 FORMAT('K = ',I5,' (< 0 OR > 6)')
- 102 FORMAT('ARGUMENT EQUALS NON-POSITIVE INTEGER =',1P,E15.6)
- END
diff --git a/src/mathlib/gen/c/rrizet.F b/src/mathlib/gen/c/rrizet.F
deleted file mode 100644
index 33df640..0000000
--- a/src/mathlib/gen/c/rrizet.F
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: rrizet.F,v 1.1.1.1 1996/04/01 15:02:00 mclareni Exp $
-*
-* $Log: rrizet.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:00 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- FUNCTION RRIZET(X)
- DOUBLE PRECISION D,DRIZET
-
- SROUND(D)=D+(D-SNGL(D))
- RRIZET=SROUND(DRIZET(DBLE(X)))
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/c/rrizet64.F b/src/mathlib/gen/c/rrizet64.F
deleted file mode 100644
index 2a0eb39..0000000
--- a/src/mathlib/gen/c/rrizet64.F
+++ /dev/null
@@ -1,164 +0,0 @@
-*
-* $Id: rrizet64.F,v 1.1.1.1 1996/04/01 15:02:00 mclareni Exp $
-*
-* $Log: rrizet64.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:00 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- FUNCTION DRIZET(X)
-C
-#include "gen/imp64.inc"
-C
- CHARACTER*(*) NAME
- PARAMETER(NAME='RRIZET/DRIZET')
-#endif
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION RRIZET(X)
-C
- CHARACTER*(*) NAME
- PARAMETER(NAME='RRIZET')
-#endif
-C
- DIMENSION P1(0:8),P2(0:8),P3(0:9),P4(0:8)
- DIMENSION Q1(0:8),Q2(0:8),Q3(0:9),Q4(0:8)
-
- PARAMETER (DELTA = 1D-13)
- PARAMETER (Z1 = 1, HF = Z1/2, TH = Z1/3)
- PARAMETER (PI = 3.14159 26535 89793 24D0)
- PARAMETER (PIH = PI/2, PI2 = 2*PI)
-
- DATA (P1(J),Q1(J),J=0,8)
- A/ 1.28716 81214 82446 39D+10, 2.57433 62429 64846 24D+10,
- 1 1.37539 69320 37025 11D+10, 5.93816 56486 79590 16D+09,
- 2 5.10665 59183 64406 10D+09, 9.00633 03732 61233 44D+08,
- 3 8.56147 10024 33314 86D+08, 8.04253 66342 83289 89D+07,
- 4 7.48361 81243 80232 98D+07, 5.60971 17595 41920 06D+06,
- 5 4.86010 65854 61882 51D+06, 2.24743 12028 99137 52D+05,
- 6 2.73957 49902 21406 09D+05, 7.57457 89093 41537 56D+03,
- 7 4.63171 08431 83427 12D+03,-2.37383 57813 73772 62D+01,
- 8 5.78758 10040 96660 66D+01, 1/
-
- DATA (P2(J),Q2(J),J=0,8)
- A/-6.88197 29321 63489 54D+06,-1.29725 62493 48915 54D+09,
- 1 7.48218 91630 53159 72D+06,-9.48715 40757 99078 17D+08,
- 2 -2.07584 50481 02110 14D+06,-1.05496 19347 40052 03D+08,
- 3 3.55302 55709 62142 95D+05, 4.67774 48821 19930 48D+06,
- 4 -4.06706 44955 18548 89D+04, 3.12936 04057 38135 34D+06,
- 5 3.19804 86402 71469 11D+03, 4.59581 80383 93050 70D+05,
- 6 -1.69820 93703 37228 53D+02, 3.88176 10961 03968 34D+04,
- 7 5.61485 84239 42890 48D+00, 1.92561 54483 44914 23D+03,
- 8 -8.93888 70592 61549 44D-02, 5.12578 12500 00000 00D+01/
-
- DATA (P3(J),Q3(J),J=0,9)
- A/ 1.66156 48051 57746 76D-11,-6.99562 63351 91916 55D-10,
- 1 -4.68068 82766 06545 29D-09,-1.77757 96189 51492 57D-08,
- 2 5.83519 72731 91470 47D-07,-9.82231 82573 40780 36D-07,
- 3 -4.17644 01264 31456 02D-05,-2.84927 28275 90964 88D-05,
- 4 1.85468 42284 35979 59D-03,-5.81727 90938 80480 94D-04,
- 5 -5.11288 80022 04902 41D-02,-1.15848 74916 97665 86D-02,
- 6 8.10450 23175 11003 53D-01,-1.28149 12405 19781 96D-01,
- 7 -5.69951 94876 84789 23D+00,-1.11913 05734 90977 09D+00,
- 8 0 ,-7.67928 76160 46288 13D-01,
- 9 0 , 1/
-
- DATA (P4(J),Q4(J),J=0,8)
- A/ 1.03144 87718 88597 12D-15, 5.93959 41728 84190 50D-11,
- 1 -5.12584 61396 46882 41D-13,-6.04755 35907 99918 06D-09,
- 2 1.12948 79419 48735 48D-10, 3.64680 20866 83885 63D-07,
- 3 -1.44234 66537 31309 52D-08,-1.29456 90556 80118 12D-05,
- 4 1.16824 67698 44580 98D-06, 3.20189 49847 02292 50D-04,
- 5 -6.14975 16799 03148 06D-05,-5.07801 55709 99940 77D-03,
- 6 2.05594 67798 88303 28D-03, 5.49628 90788 15872 66D-02,
- 7 -3.99339 42939 46688 69D-02,-3.24517 61115 59724 19D-01,
- 8 3.45234 97673 61784 57D-01, 1/
-
- V=X
- F=1
- IF(X .NE. 0 .AND. X .LT. HF) THEN
- IX=X-DELTA
- IF(ABS(IX-X) .LE. DELTA) THEN
- IF(MOD(-IX,2) .EQ. 0) THEN
- H=0
- GO TO 9
- ELSE
- V=1-X
-#if defined(CERNLIB_DOUBLE)
- F=2*(-Z1)**((1-IX)/2)*DGAMMA(V)/PI2**V
-#endif
-#if !defined(CERNLIB_DOUBLE)
- F=2*(-Z1)**((1-IX)/2)*GAMMA(V)/PI2**V
-#endif
- ENDIF
- ELSE
- V=1-X
-#if defined(CERNLIB_DOUBLE)
- F=2*SIN(PIH*X)*DGAMMA(V)/PI2**V
-#endif
-#if !defined(CERNLIB_DOUBLE)
- F=2*SIN(PIH*X)*GAMMA(V)/PI2**V
-#endif
- ENDIF
- ENDIF
- IF(X .EQ. 0) THEN
- H=-3*HF
- ELSEIF(X .EQ. 1) THEN
- H=0
- CALL MTLPRT(NAME,'C315.1','ZETA(X) HAS POLE AT X = 1')
- ELSEIF(V .LE. 5) THEN
- AP=P1(8)
- AQ=Q1(8)
- DO 1 J = 7,0,-1
- AP=P1(J)+V*AP
- 1 AQ=Q1(J)+V*AQ
- H=AP/(AQ*(V-1))-1
- ELSEIF(V .LE. 11) THEN
- T=TH*(V-8)
- ALFA=T+T
- B1=0
- B2=0
- DO 2 J = 8,0,-1
- B0=P2(J)+ALFA*B1-B2
- B2=B1
- 2 B1=B0
- H=B0-T*B2
- B1=0
- B2=0
- DO 12 J = 8,0,-1
- B0=Q2(J)+ALFA*B1-B2
- B2=B1
- 12 B1=B0
- H=H/(B0-T*B2)
- ELSEIF(V .LE. 25) THEN
- T=1/V
- AP=P3(7)
- DO 3 J = 6,0,-1
- 3 AP=P3(J)+T*AP
- AQ=Q3(9)
- DO 13 J = 8,0,-1
- 13 AQ=Q3(J)+T*AQ
- H=HF**(V-T*AP/AQ)
- ELSEIF(V .LE. 55) THEN
- T=1/V
- AP=P4(8)
- AQ=Q4(8)
- DO 4 J = 7,0,-1
- AP=P4(J)+T*AP
- 4 AQ=Q4(J)+T*AQ
- H=HF**(V-T*AP/AQ)
- ELSEIF(V .LE. 90) THEN
- H=HF**V+TH**V
- ELSE
- H=HF**V
- ENDIF
- IF(X .LT. 1) H=F*(1+H)
-#if defined(CERNLIB_DOUBLE)
- 9 DRIZET=H
-#endif
-#if !defined(CERNLIB_DOUBLE)
- 9 RRIZET=H
-#endif
- RETURN
- END
diff --git a/src/mathlib/gen/c/rrteq4.F b/src/mathlib/gen/c/rrteq4.F
deleted file mode 100644
index ae8c0a8..0000000
--- a/src/mathlib/gen/c/rrteq4.F
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: rrteq4.F,v 1.1.1.1 1996/04/01 15:01:52 mclareni Exp $
-*
-* $Log: rrteq4.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:52 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE RRTEQ4(A,B,C,D,Z,DC,MT)
-#if defined(CERNLIB_DOUBLE)
-C
- CHARACTER NAME*6
- NAME = 'RRTEQ4'
- CALL MTLPRT(NAME,'C208.0','Not available on this machine')
- RETURN
-#endif
- ENTRY RTEQ4(A,B,C,D,Z,DC,MT)
-#if defined(CERNLIB_DOUBLE)
- NAME = 'RTEQ4'
- CALL MTLPRT(NAME,'C208.0','Not available on this machine')
- RETURN
-#endif
-#if !defined(CERNLIB_DOUBLE)
- CALL RRTEQ4(A,B,C,D,Z,DC,MT)
-#endif
- END
diff --git a/src/mathlib/gen/c/rsinin.F b/src/mathlib/gen/c/rsinin.F
deleted file mode 100644
index 34684e8..0000000
--- a/src/mathlib/gen/c/rsinin.F
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: rsinin.F,v 1.1.1.1 1996/04/01 15:02:06 mclareni Exp $
-*
-* $Log: rsinin.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:06 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- FUNCTION RSININ(X)
-#include "gen/def64.inc"
- + DSININ,DCOSIN,D
-
- SROUND(D)=D+(D-SNGL(D))
-
- RSININ=SROUND(DSININ(DBLE(X)))
- RETURN
-
- ENTRY SININT(X)
- SININT=SROUND(DSININ(DBLE(X)))
- RETURN
-
- ENTRY RCOSIN(X)
- RCOSIN=SROUND(DCOSIN(DBLE(X)))
- RETURN
-
- ENTRY COSINT(X)
- COSINT=SROUND(DCOSIN(DBLE(X)))
- RETURN
-
- END
-#endif
diff --git a/src/mathlib/gen/c/rsnleq.F b/src/mathlib/gen/c/rsnleq.F
deleted file mode 100644
index 294548c..0000000
--- a/src/mathlib/gen/c/rsnleq.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: rsnleq.F,v 1.1.1.1 1996/04/01 15:01:52 mclareni Exp $
-*
-* $Log: rsnleq.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:52 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE RSNLEQ(N,X,F,FTOL,XTOL,MAXF,IPRT,INFO,SUB,W)
-#if defined(CERNLIB_DOUBLE)
-C
- CHARACTER NAME*6
- NAME = 'RSNLEQ'
- CALL MTLPRT(NAME,'C201.0','Not available on this machine')
- RETURN
-#endif
- ENTRY SNLEQ(N,X,F,FTOL,XTOL,MAXF,IPRT,INFO,SUB,W)
-#if defined(CERNLIB_DOUBLE)
- NAME = 'SNLEQ'
- CALL MTLPRT(NAME,'C201.0','Not available on this machine')
-#endif
-#if !defined(CERNLIB_DOUBLE)
- CALL RSNLEQ(N,X,F,FTOL,XTOL,MAXF,IPRT,INFO,SUB,W)
-#endif
- END
diff --git a/src/mathlib/gen/c/rstrh0.F b/src/mathlib/gen/c/rstrh0.F
deleted file mode 100644
index 81afb6c..0000000
--- a/src/mathlib/gen/c/rstrh0.F
+++ /dev/null
@@ -1,35 +0,0 @@
-*
-* $Id: rstrh0.F,v 1.1.1.1 1996/04/01 15:02:08 mclareni Exp $
-*
-* $Log: rstrh0.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:08 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- FUNCTION RSTRH0(X)
-#include "gen/def64.inc"
- + DSTRH0,DSTRH1,D
-
- SROUND(D)=D+(D-SNGL(D))
-
- RSTRH0=SROUND(DSTRH0(DBLE(X)))
- RETURN
-
- ENTRY STRH0(X)
- STRH0=SROUND(DSTRH0(DBLE(X)))
- RETURN
-
- ENTRY RSTRH1(X)
-
- RSTRH1=SROUND(DSTRH1(DBLE(X)))
- RETURN
-
- ENTRY STRH1(X)
-
- STRH1=SROUND(DSTRH1(DBLE(X)))
- RETURN
-
- END
-#endif
diff --git a/src/mathlib/gen/c/rteq3.F b/src/mathlib/gen/c/rteq3.F
deleted file mode 100644
index dc61825..0000000
--- a/src/mathlib/gen/c/rteq3.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: rteq3.F,v 1.1.1.1 1996/04/01 15:01:52 mclareni Exp $
-*
-* $Log: rteq3.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:52 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE RRTEQ3(R,S,T,X,D)
-#if defined(CERNLIB_DOUBLE)
-C
- CHARACTER NAME*6
- NAME = 'RRTEQ3'
- CALL MTLPRT(NAME,'C207.0','Not available on this machine')
- RETURN
-#endif
- ENTRY RTEQ3(R,S,T,X,D)
-#if defined(CERNLIB_DOUBLE)
- NAME = 'RTEQ3'
- CALL MTLPRT(NAME,'C207.0','Not available on this machine')
-#endif
-#if !defined(CERNLIB_DOUBLE)
- CALL RRTEQ3(R,S,T,X,D)
-#endif
- END
diff --git a/src/mathlib/gen/c/rteq3128.F b/src/mathlib/gen/c/rteq3128.F
deleted file mode 100644
index 178300f..0000000
--- a/src/mathlib/gen/c/rteq3128.F
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: rteq3128.F,v 1.1.1.1 1996/04/01 15:01:52 mclareni Exp $
-*
-* $Log: rteq3128.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:52 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if !defined(CERNLIB_DOUBLE)
- SUBROUTINE DRTEQ3(R,S,T,X,D)
-C
-#include "gen/imp128.inc"
-C
- CHARACTER NAME*(*)
- PARAMETER (NAME = 'DRTEQ3')
- CALL MTLPRT(NAME,'C207.0','Not available on this machine')
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/c/rteq364.F b/src/mathlib/gen/c/rteq364.F
deleted file mode 100644
index 276aa46..0000000
--- a/src/mathlib/gen/c/rteq364.F
+++ /dev/null
@@ -1,110 +0,0 @@
-*
-* $Id: rteq364.F,v 1.1.1.1 1996/04/01 15:01:52 mclareni Exp $
-*
-* $Log: rteq364.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:52 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if !defined(CERNLIB_DOUBLE)
- SUBROUTINE RRTEQ3(R,S,T,X,D)
-#endif
-#if defined(CERNLIB_DOUBLE)
- SUBROUTINE DRTEQ3(R,S,T,X,D)
-#endif
-#include "gen/imp64.inc"
-#include "gen/defc64.inc"
- + I,Z(0:2)
-#include "gen/def128.inc"
- + ZQ1,QQ,PP,Q1,Q2,Q3
- DIMENSION X(*),Y(0:2)
-
- PARAMETER(EPS = 1D-6, DELTA = 1D-15)
- PARAMETER(I = (0,1), ZD1 = 1, ZQ1 = 1)
- PARAMETER(R1 = 2*ZD1/27, R2 = ZD1/2, R3 = ZD1/3)
- PARAMETER(W3 = 1.73205 08075 68877 294D0, R4 = W3/2)
- PARAMETER(Q1 = 2*ZQ1/27, Q2 = ZQ1/2, Q3 = ZQ1/3)
-
- IF(S .EQ. 0 .AND. T .EQ. 0) THEN
- X(1)=-R
- X(2)=0
- X(3)=0
- D=0
- RETURN
- ENDIF
- P=S-R3*R**2
- Q=(R1*R**2-R3*S)*R+T
- D=(R2*Q)**2+(R3*P)**3
- IF(ABS(D) .LE. EPS) THEN
- PP=S-Q3*R**2
- QQ=(Q1*R**2-Q3*S)*R+T
- D=(Q2*QQ)**2+(Q3*PP)**3
- P=PP
- Q=QQ
- ENDIF
- H=R3*R
- H1=R2*Q
- IF(D .GT. DELTA) THEN
- H2=SQRT(D)
- U0=-H1+H2
- V0=-H1-H2
- U=SIGN(ABS(U0)**R3,U0)
- V=SIGN(ABS(V0)**R3,V0)
- X(1)=U+V-H
- X(2)=-R2*(U+V)-H
- X(3)=R4*ABS(U-V)
- IF(ABS(U0) .LE. EPS .OR. ABS(V0) .LE. EPS) THEN
- Y(0)=X(1)
- DO 1 K = 0,1
- 1 Y(K+1)=Y(K)-(((Y(K)+R)*Y(K)+S)*Y(K)+T)/((3*Y(K)+2*R)*Y(K)+S)
- X(1)=Y(2)
- Z(0)=X(2)+I*X(3)
- DO 2 K = 0,1
- 2 Z(K+1)=Z(K)-(((Z(K)+R)*Z(K)+S)*Z(K)+T)/((3*Z(K)+2*R)*Z(K)+S)
- X(2)=Z(2)
- X(3)=-I*Z(2)
- ENDIF
- ELSEIF(ABS(D) .LE. DELTA) THEN
- D=0
- U=SIGN(ABS(H1)**R3,-H1)
- X(1)=U+U-H
- X(2)=-U-H
- X(3)=X(2)
- IF(ABS(H1) .LE. EPS) THEN
- Y(0)=X(1)
- DO 5 K = 0,1
- H1=(3*Y(K)+2*R)*Y(K)+S
- IF(ABS(H1) .GT. DELTA) THEN
- Y(K+1)=Y(K)-(((Y(K)+R)*Y(K)+S)*Y(K)+T)/H1
- ELSE
- X(1)=-R3*R
- X(2)=X(1)
- X(3)=X(1)
- RETURN
- ENDIF
- 5 CONTINUE
- X(1)=Y(2)
- X(2)=-R2*(R+X(1))
- X(3)=X(2)
- ENDIF
- ELSE
- H3=SQRT(ABS(R3*P)**3)
- H2=R3*ACOS(-H1/H3)
- H1=H3**R3
- U=H1*COS(H2)
- V=W3*H1*SIN(H2)
- X(1)=U+U-H
- X(2)=-U-V-H
- X(3)=-U+V-H
- IF(H3 .LE. EPS .OR. X(1) .LE. EPS .OR. X(2) .LE .EPS .OR.
- 1 X(3) .LE. EPS) THEN
- DO 3 J = 1,3
- Y(0)=X(J)
- DO 4 K = 0,1
- 4 Y(K+1)=Y(K)-(((Y(K)+R)*Y(K)+S)*Y(K)+T)/((3*Y(K)+2*R)*Y(K)+S)
- 3 X(J)=Y(2)
- ENDIF
- ENDIF
- RETURN
- END
diff --git a/src/mathlib/gen/c/rteq4128.F b/src/mathlib/gen/c/rteq4128.F
deleted file mode 100644
index bbf3653..0000000
--- a/src/mathlib/gen/c/rteq4128.F
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: rteq4128.F,v 1.1.1.1 1996/04/01 15:01:52 mclareni Exp $
-*
-* $Log: rteq4128.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:52 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if !defined(CERNLIB_DOUBLE)
- SUBROUTINE DRTEQ4(A,B,C,D,Z,DC,MT)
-C
-#include "gen/imp128.inc"
-C
- CHARACTER NAME*(*)
- PARAMETER (NAME = 'DRTEQ4')
- CALL MTLPRT(NAME,'C208.0','Not available on this machine')
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/c/rteq464.F b/src/mathlib/gen/c/rteq464.F
deleted file mode 100644
index aff8d6c..0000000
--- a/src/mathlib/gen/c/rteq464.F
+++ /dev/null
@@ -1,137 +0,0 @@
-*
-* $Id: rteq464.F,v 1.1.1.1 1996/04/01 15:01:53 mclareni Exp $
-*
-* $Log: rteq464.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:53 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if !defined(CERNLIB_DOUBLE)
- SUBROUTINE RRTEQ4(A,B,C,D,Z,DC,MT)
-#endif
-#if defined(CERNLIB_DOUBLE)
- SUBROUTINE DRTEQ4(A,B,C,D,Z,DC,MT)
-#endif
-#include "gen/imp64.inc"
-#include "gen/defc64.inc"
- + I,Z,Z0,W1,W2,W3
-#include "gen/def128.inc"
- + ZQ1,AA,PP,QQ,RR,Q1,Q2,Q3,Q4,Q8
- DIMENSION Z(*),Z0(4),U(3),V(3)
-
- PARAMETER(I = (0,1), ZD1 = 1, ZQ1 = 1)
- PARAMETER(R4 = ZD1/4, R12 = ZD1/12)
- PARAMETER(Q2 = ZQ1/2, Q4 = ZQ1/4, Q8 = ZQ1/8)
- PARAMETER(Q1 = 3*ZQ1/8, Q3 = 3*ZQ1/16)
-
- IF(B .EQ. 0 .AND. C .EQ. 0) THEN
- IF(D .EQ. 0) THEN
- MT=1
- Z(1)=-A
- Z(2)=0
- Z(3)=0
- Z(4)=0
- DC=0
- RETURN
- ELSEIF(A .EQ. 0) THEN
- IF(D .GT. 0) THEN
- MT=2
- Z(1)=SQRT(I*SQRT(D))
- Z(2)=-Z(1)
- Z(4)=SQRT(-Z(1)**2)
- Z(3)=-Z(4)
- ELSE
- MT=3
- Z(1)=SQRT(SQRT(-D))
- Z(2)=-Z(1)
- Z(3)=SQRT(-Z(1)**2)
- Z(4)=-Z(3)
- ENDIF
- DC=(-R12*D)**3
- RETURN
- ENDIF
- ENDIF
- AA=A**2
- PP=B-Q1*AA
- QQ=C-Q2*A*(B-Q4*AA)
- RR=D-Q4*(A*C-Q4*AA*(B-Q3*AA))
- RC=Q2*PP
- SC=Q4*(Q4*PP**2-RR)
- TC=-(Q8*QQ)**2
-#if defined(CERNLIB_DOUBLE)
- CALL DRTEQ3(RC,SC,TC,U,DC)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- CALL RRTEQ3(RC,SC,TC,U,DC)
-#endif
- Q=QQ
- H=R4*A
- IF(DC .EQ. 0) U(3)=U(2)
- IF(DC .LE. 0) THEN
- MT=2
- V(1)=ABS(U(1))
- V(2)=ABS(U(2))
- V(3)=ABS(U(3))
- V1=MAX(V(1),V(2),V(3))
- IF(V1 .EQ. V(1)) THEN
- K1=1
- V2=MAX(V(2),V(3))
- ELSEIF(V1 .EQ. V(2)) THEN
- K1=2
- V2=MAX(V(1),V(3))
- ELSE
- K1=3
- V2=MAX(V(1),V(2))
- ENDIF
- IF(V2 .EQ. V(1)) THEN
- K2=1
- ELSEIF(V2 .EQ. V(2)) THEN
- K2=2
- ELSE
- K2=3
- ENDIF
- W1=SQRT(U(K1)+I*0)
- W2=SQRT(U(K2)+I*0)
- ELSE
- MT=3
- W1=SQRT(U(2)+I*U(3))
- W2=SQRT(U(2)-I*U(3))
- ENDIF
- W3=0
- IF(W1*W2 .NE. 0) W3=-Q/(8*W1*W2)
- Z0(1)=W1+W2+W3-H
- Z0(2)=-W1-W2+W3-H
- Z0(3)=-W1+W2-W3-H
- Z0(4)=W1-W2-W3-H
- IF(MT .EQ. 2) THEN
- IF(U(K1) .GE. 0 .AND. U(K2) .GE. 0) THEN
- MT=1
- DO 1 J = 1,4
- RZ0=Z0(J)
- 1 Z(J)=RZ0
- ELSEIF(U(K1) .GE. 0 .AND. U(K2) .LT. 0) THEN
- Z(1)=Z0(1)
- Z(2)=Z0(4)
- Z(3)=Z0(3)
- Z(4)=Z0(2)
- ELSEIF(U(K1) .LT. 0 .AND. U(K2) .GE. 0) THEN
- Z(1)=Z0(1)
- Z(2)=Z0(3)
- Z(3)=Z0(4)
- Z(4)=Z0(2)
- ELSEIF(U(K1) .LT. 0 .AND. U(K2) .LT. 0) THEN
- Z(1)=Z0(1)
- Z(2)=Z0(2)
- Z(3)=Z0(4)
- Z(4)=Z0(3)
- ENDIF
- ELSEIF(MT .EQ. 3) THEN
- DO 2 J = 1,2
- RZ0=Z0(J)
- 2 Z(J)=RZ0
- Z(3)=Z0(4)
- Z(4)=Z0(3)
- ENDIF
- RETURN
- END
diff --git a/src/mathlib/gen/c/rtheta.F b/src/mathlib/gen/c/rtheta.F
deleted file mode 100644
index c96d41f..0000000
--- a/src/mathlib/gen/c/rtheta.F
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: rtheta.F,v 1.1.1.1 1996/04/01 15:02:12 mclareni Exp $
-*
-* $Log: rtheta.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:12 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- FUNCTION RTHETA( K, X, Q )
- DOUBLE PRECISION D,DTHETA
-C
-C RTHETA is set equal to the correctly rounded value of DTHETA.
-C (Version 9.04.1992)
-C
-C--Start.
- D = DTHETA( K, DBLE(X), DBLE(Q) )
- RTHETA = D + ( D - SNGL(D) )
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/c/rtheta128.F b/src/mathlib/gen/c/rtheta128.F
deleted file mode 100644
index 9967cab..0000000
--- a/src/mathlib/gen/c/rtheta128.F
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: rtheta128.F,v 1.1.1.1 1996/04/01 15:02:12 mclareni Exp $
-*
-* $Log: rtheta128.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:12 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION DTHETA( K, X, Q )
-C
-#include "gen/imp128.inc"
-C
- DTHETA=0
- CALL MTLPRT('DTHETA','C349.0','Not available on this machine')
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/c/rtheta64.F b/src/mathlib/gen/c/rtheta64.F
deleted file mode 100644
index 2d874ae..0000000
--- a/src/mathlib/gen/c/rtheta64.F
+++ /dev/null
@@ -1,289 +0,0 @@
-*
-* $Id: rtheta64.F,v 1.1.1.1 1996/04/01 15:02:12 mclareni Exp $
-*
-* $Log: rtheta64.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:12 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- FUNCTION DTHETA( K, X, Q )
-C
-#include "gen/imp64.inc"
-C
- CHARACTER*(*) NAME
- PARAMETER(NAME='RTHETA/DTHETA')
-#endif
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION RTHETA( K, X, Q )
-C
- CHARACTER*(*) NAME
- PARAMETER(NAME='RTHETA')
-#endif
- PARAMETER ( TWO=2, HALF=1/TWO, FOURTH=HALF**2 )
- PARAMETER ( PI = 3.14159 26535 89793 24 D0, PISQ=PI**2 )
- PARAMETER ( IADIM = 20 )
- DIMENSION A1(0:IADIM), A3(0:IADIM)
-C Set NBITS = number of mantissa bits.
-#if !defined(CERNLIB_DOUBLE)
- PARAMETER ( NBITS = 48 )
-C Set QZ to the value specified in the comments.
- PARAMETER ( QZ = 0.7504 )
-#endif
-#if defined(CERNLIB_DOUBLE)
- PARAMETER ( NBITS = 56 )
-C Set QZ to the value specified in the comments.
- PARAMETER ( QZ = 0.7809 )
-#endif
-C
-C The following statements set various constants (see comments).
- PARAMETER ( ELOW = -0.693*NBITS )
- PARAMETER ( QZSQ = QZ**2 )
- PARAMETER ( C10 = QZSQ, C11 = 2*QZ*(1-QZ) )
- PARAMETER ( C30 = QZSQ**2, C31 = 2*QZSQ*(1-QZSQ) )
-C
- CHARACTER*130 ERRTXT
-
- DATA QPRV1A, QPRV1B, QPRV3A, QPRV3B / 4*-9999. /
- SAVE A1, A3, QPRV1A, QPRV1B, QPRV3A, QPRV3B, B3, R, COEFF
- SAVE N1, N3
-C
-C *********************************************************************
-C
-C function is set equal to the value of theta(K,pi*X,Q), where
-C theta(k,u,q) is the theta function with subscript k (=1,2,3,4)
-C as defined in "Handbook of Mathematical Functions", M.Abramowitz
-C & I.A. Stegun (eds.), Washington, 1964. K=0 is accepted as equiv-
-C alent to K=4.
-C
-C The constant QZ in the parameter statement should be set as follows:
-C QZ = exp( (pi**2)/log(eps/3) ),
-C where eps=2**(-NBITS).
-C
-C The constants Cj0 and Cj1 (j=1,3) then have values such that the two
-C inequalities
-C
-C 0 .le. t .le. 1/2,
-C 0 .le. q .le. cj0 + cj1*t,
-C
-C define a region within which the theta function can be approximated
-C with relative error less than eps by using either one (k=1,2) or two
-C (k=3,4) terms of the transformed series.
-C
-C The constant ELOW has a value such that 1-EXP(u) is equal to 1 to
-C machine accuracy if u.lt.ELOW.
-C
-C NOTE. The value of NBITS and the corresponding QZ do not have to be
-C set separately for each computer. All that is required is
-C that the number of mantissa bits shall not be greater than
-C NBITS. Too large a value of NBITS merely causes the program
-C to run somewhat slower for certain values of X and Q.
-C
-C (Version 11.02.1992)
-C
-C *********************************************************************
-C
-C--Start. Check Q and select basic function theta1 or theta3.
- IF ( Q.LT.0 .OR. Q.GT.1 ) THEN
- WRITE(ERRTXT,101) K,X,Q
- CALL MTLPRT(NAME,'C349.1',ERRTXT)
- RESULT = 0
- GO TO 50
- ENDIF
- IF ( K.EQ.1 ) THEN
- T = X
- GO TO 10
- ELSEIF ( K.EQ.2 ) THEN
- T = HALF - ABS(X)
- GO TO 10
- ELSEIF ( K.EQ.3 ) THEN
- T = X
- GO TO 30
- ELSEIF ( K.EQ.4 .OR. K.EQ.0 ) THEN
- T = HALF - ABS(X)
- GO TO 30
- ELSE
- WRITE(ERRTXT,102) K,X,Q
- CALL MTLPRT(NAME,'C349.2',ERRTXT)
- RESULT = 0
- GO TO 50
- ENDIF
-C----------------------------------------------------------------------
-C
-C--Basic function THETA1.
-C
-C Reduce argument T to the interval (0,1/2).
- 10 FSIGN = +1
- IF ( T.LT.0 ) FSIGN = -FSIGN
- T = ABS(T)
- TINT = AINT(T)
- IF ( MOD(TINT,TWO) .NE. 0 ) FSIGN = -FSIGN
- T = T - TINT
- IF ( T.GE.HALF ) THEN
- T = 1 - T
- ELSEIF( T.EQ.0 ) THEN
- RESULT = 0
- GO TO 50
- ENDIF
- IF ( Q .GT. C10+C11*T ) GO TO 14
-C
-C Classical series.
-C (If Q has changed value, compute N1 and A1(j), j=0,1,...,N1)
- IF ( Q.NE.QPRV1A ) THEN
- AZERO = 2*SQRT(SQRT(Q))
- QSQ = Q**2
- P = -1
- ATEMP = 1
- DO 11 J = 0,IADIM
- A1(J) = AZERO*ATEMP
- N1 = J
- P = QSQ*P
- ATEMP = P*ATEMP
- IF ( 1-ABS(ATEMP) .EQ. 1 ) GO TO 12
- 11 CONTINUE
- 12 QPRV1A = Q
- ENDIF
-C (Compute the series using forwards recurrence for sines)
- S = SIN(PI*T)
- ALPHA = 2 - 4*(S**2)
- U = -S
- SUM = A1(0)*S
- DO 13 J = 1,N1
- V = U
- U = S
- S = ALPHA*U - V
- SUM = SUM + A1(J)*S
- 13 CONTINUE
- RESULT = FSIGN*SUM
- GO TO 50
-C
-C One-term sinh approximation.
- 14 IF ( Q.EQ.1 ) THEN
- RESULT = 0
- IF ( T.EQ.HALF ) THEN
- WRITE(ERRTXT,103) K,X,Q
- CALL MTLPRT(NAME,'C349.3',ERRTXT)
- ENDIF
- GO TO 50
- ENDIF
-C (If Q has changed value, compute R and COEFF)
- IF ( Q.NE.QPRV1B ) THEN
- ABSLOG = ABS(LOG(Q))
- R = PISQ/ABSLOG
- COEFF = SQRT(PI/ABSLOG)
- QPRV1B = Q
- ENDIF
-C (Compute function)
- U = R*T
- IF ( U.LT.HALF ) THEN
- E = -R*( T**2 + FOURTH )
- ETERM = EXP(E)
- IF ( ETERM.NE.0 ) THEN
- RESULT = 2*COEFF*ETERM*SINH(U)
- ELSE
- RESULT = EXP( E + LOG(2*COEFF) )*SINH(U)
- ENDIF
- ELSE
- E = -R*(T-HALF)**2
- ETERM = EXP(E)
- IF ( ETERM.NE.0 ) THEN
- RESULT = COEFF*ETERM
- ELSE
- RESULT = EXP( E + LOG(COEFF) )
- ENDIF
- E = -2*U
- IF ( E.GT.ELOW ) RESULT = RESULT*( 1 - EXP(E) )
- ENDIF
- RESULT = FSIGN*RESULT
- GO TO 50
-C----------------------------------------------------------------------
-C
-C--Basic function THETA3.
-C
-C Reduce argument T to the interval (0,1/2).
- 30 T = ABS(T) - AINT(ABS(T))
- IF ( T.GE.HALF ) T = 1 - T
- IF ( Q .GT. C30+C31*T ) GO TO 34
-C
-C Classical series.
-C (If Q has changed value, compute N3 and A3(j), j=0,1,...,N3)
- IF ( Q.NE.QPRV3A ) THEN
- QSQ = Q**2
- P = Q
- ATEMP = 1
- DO 31 J = 0,IADIM
- A3(J) = ATEMP
- N3 = J
- ATEMP = P*ATEMP
- P = QSQ*P
- IF ( 1-ATEMP .EQ. 1 ) GO TO 32
- 31 CONTINUE
- 32 QPRV3A= Q
- ENDIF
-C (Compute the series using Clenshaw recurrence)
- ALPHA = 2*COS(2*PI*T)
- W = 0
- V = 0
- U = A3(N3)
- DO 33 J = N3-1,0,-1
- W = V
- V = U
- U = A3(J) + ALPHA*V - W
- 33 CONTINUE
- RESULT = U - W
- GO TO 50
-C
-C Two-term cosh approximation.
- 34 IF ( Q.EQ.1 ) THEN
- IF ( T.EQ.0 ) THEN
- WRITE(ERRTXT,103) K,X,Q
- CALL MTLPRT(NAME,'C349.3',ERRTXT)
- ENDIF
- RESULT = 0
- GO TO 50
- ENDIF
-C
-C (If Q has changed value, compute R, B3 and COEFF)
- IF ( Q.NE.QPRV3B ) THEN
- ABSLOG = ABS(LOG(Q))
- R = PISQ/ABSLOG
- IF ( -R.GE.ELOW ) B3 = 2*EXP(-R)
- COEFF = SQRT(PI/ABSLOG)
- QPRV3B = Q
- ENDIF
-C (Compute function)
- E = - R*(T**2)
- RESULT = COEFF*EXP(E)
- IF ( RESULT.EQ.0 ) THEN
- RESULT = EXP( E + LOG(COEFF) )
- ENDIF
- E = -R*(1-2*T)
- IF ( E.GT.ELOW ) THEN
- ETEST = -R*(1+2*T)
- IF ( ETEST.GE.ELOW ) THEN
- RESULT = RESULT*( 1 + B3*COSH(2*R*T) )
- ELSE
- RESULT = RESULT*( 1 + EXP(E) )
- ENDIF
- ENDIF
-C
-C
-C--Terminate.
-#if !defined(CERNLIB_DOUBLE)
- 50 RTHETA = RESULT
-#endif
-#if defined(CERNLIB_DOUBLE)
- 50 DTHETA = RESULT
-#endif
- RETURN
-C----------------------------------------------------------------------
-C
-C--Formats for error messages.
- 101 FORMAT('Q < 0 or Q > 1 ',
- + ' K=',I2,5X,'X=',1P,E13.5,5X,'Q=',E13.5)
- 102 FORMAT('Impermissible K value',
- $ ' K=',I2,5X,'X=',1P,E13.5,5X,'Q=',E13.5)
- 103 FORMAT('Function is infinite ',
- $ ' K=',I2,5X,'X=',1P,E13.5,5X,'Q=',E13.5)
- END
diff --git a/src/mathlib/gen/c/rzerox.F b/src/mathlib/gen/c/rzerox.F
deleted file mode 100644
index 96c5ea1..0000000
--- a/src/mathlib/gen/c/rzerox.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: rzerox.F,v 1.1.1.1 1996/04/01 15:01:51 mclareni Exp $
-*
-* $Log: rzerox.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:51 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- SUBROUTINE RZEROX(A0,B0,EPS,MAXF,F,MODE)
-C
- CHARACTER NAME*6
- NAME = 'RZEROX'
- CALL MTLPRT(NAME,'C200.0','Not available on this machine')
- RETURN
- ENTRY ZEROX(A0,B0,EPS,MAXF,F,MODE)
- NAME = 'ZEROX'
- CALL MTLPRT(NAME,'C200.0','Not available on this machine')
- END
-#endif
diff --git a/src/mathlib/gen/c/sinint.F b/src/mathlib/gen/c/sinint.F
deleted file mode 100644
index b6f09d8..0000000
--- a/src/mathlib/gen/c/sinint.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: sinint.F,v 1.1.1.1 1996/04/01 15:02:06 mclareni Exp $
-*
-* $Log: sinint.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:06 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION SININT(X)
-
- SININT=RSININ(X)
- RETURN
-
- ENTRY COSINT(X)
- COSINT=RCOSIN(X)
- RETURN
-
- END
-#endif
diff --git a/src/mathlib/gen/c/sinint128.F b/src/mathlib/gen/c/sinint128.F
deleted file mode 100644
index 6a6b22d..0000000
--- a/src/mathlib/gen/c/sinint128.F
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: sinint128.F,v 1.1.1.1 1996/04/01 15:02:06 mclareni Exp $
-*
-* $Log: sinint128.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:06 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION DSININ(X)
-#include "gen/imp128.inc"
-C
- CHARACTER*(*) NAME1, NAME2
- PARAMETER( NAME1='DSININ')
- PARAMETER( NAME2='DCOSIN')
- DSININ=0
- CALL MTLPRT(NAME1,'C336.0','Not available on this machine')
- RETURN
-
- ENTRY DCOSIN(X)
- DCOSIN=0
- CALL MTLPRT(NAME2,'C336.0','Not available on this machine')
- END
-#endif
diff --git a/src/mathlib/gen/c/sinint64.F b/src/mathlib/gen/c/sinint64.F
deleted file mode 100644
index 8b420de..0000000
--- a/src/mathlib/gen/c/sinint64.F
+++ /dev/null
@@ -1,201 +0,0 @@
-*
-* $Id: sinint64.F,v 1.1.1.1 1996/04/01 15:02:06 mclareni Exp $
-*
-* $Log: sinint64.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:06 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION RSININ(X)
-#endif
-#if defined(CERNLIB_DOUBLE)
- FUNCTION DSININ(X)
-#endif
-#include "gen/imp64.inc"
- CHARACTER NAME*(*)
- CHARACTER*80 ERRTXT
-#if !defined(CERNLIB_DOUBLE)
- PARAMETER (NAME = 'RCOSIN')
-#endif
-#if defined(CERNLIB_DOUBLE)
- PARAMETER (NAME = 'RCOSIN/DCOSIN')
-#endif
- DIMENSION S(0:15),C(0:15),P(0:28),Q(0:24)
-
- PARAMETER (Z1 = 1, R8 = Z1/8, R32 = Z1/32)
-
- PARAMETER (PI = 3.14159 26535 89793 24D0)
- PARAMETER (CE = 0.57721 56649 01532 86D0)
- PARAMETER (PIH = PI/2)
-
- DATA S( 0) /+1.95222 09759 53071 08D0/
- DATA S( 1) /-0.68840 42321 25715 44D0/
- DATA S( 2) /+0.45518 55132 25584 84D0/
- DATA S( 3) /-0.18045 71236 83877 85D0/
- DATA S( 4) /+0.04104 22133 75859 24D0/
- DATA S( 5) /-0.00595 86169 55588 85D0/
- DATA S( 6) /+0.00060 01427 41414 43D0/
- DATA S( 7) /-0.00004 44708 32910 75D0/
- DATA S( 8) /+0.00000 25300 78230 75D0/
- DATA S( 9) /-0.00000 01141 30759 30D0/
- DATA S(10) /+0.00000 00041 85783 94D0/
- DATA S(11) /-0.00000 00001 27347 06D0/
- DATA S(12) /+0.00000 00000 03267 36D0/
- DATA S(13) /-0.00000 00000 00071 68D0/
- DATA S(14) /+0.00000 00000 00001 36D0/
- DATA S(15) /-0.00000 00000 00000 02D0/
-
- DATA C( 0) /+1.94054 91464 83554 93D0/
- DATA C( 1) /+0.94134 09132 86521 34D0/
- DATA C( 2) /-0.57984 50342 92992 76D0/
- DATA C( 3) /+0.30915 72011 15927 13D0/
- DATA C( 4) /-0.09161 01792 20771 34D0/
- DATA C( 5) /+0.01644 37407 51546 25D0/
- DATA C( 6) /-0.00197 13091 95216 41D0/
- DATA C( 7) /+0.00016 92538 85083 50D0/
- DATA C( 8) /-0.00001 09393 29573 11D0/
- DATA C( 9) /+0.00000 05522 38574 84D0/
- DATA C(10) /-0.00000 00223 99493 31D0/
- DATA C(11) /+0.00000 00007 46533 25D0/
- DATA C(12) /-0.00000 00000 20818 33D0/
- DATA C(13) /+0.00000 00000 00493 12D0/
- DATA C(14) /-0.00000 00000 00010 05D0/
- DATA C(15) /+0.00000 00000 00000 18D0/
-
- DATA P( 0) /+0.96074 78397 52035 96D0/
- DATA P( 1) /-0.03711 38962 12398 06D0/
- DATA P( 2) /+0.00194 14398 88991 90D0/
- DATA P( 3) /-0.00017 16598 84251 47D0/
- DATA P( 4) /+0.00002 11263 77532 31D0/
- DATA P( 5) /-0.00000 32716 32567 12D0/
- DATA P( 6) /+0.00000 06006 92116 15D0/
- DATA P( 7) /-0.00000 01258 67944 03D0/
- DATA P( 8) /+0.00000 00293 25634 58D0/
- DATA P( 9) /-0.00000 00074 56959 21D0/
- DATA P(10) /+0.00000 00020 41054 78D0/
- DATA P(11) /-0.00000 00005 95022 30D0/
- DATA P(12) /+0.00000 00001 83229 67D0/
- DATA P(13) /-0.00000 00000 59205 06D0/
- DATA P(14) /+0.00000 00000 19965 17D0/
- DATA P(15) /-0.00000 00000 06995 11D0/
- DATA P(16) /+0.00000 00000 02536 86D0/
- DATA P(17) /-0.00000 00000 00949 29D0/
- DATA P(18) /+0.00000 00000 00365 52D0/
- DATA P(19) /-0.00000 00000 00144 49D0/
- DATA P(20) /+0.00000 00000 00058 51D0/
- DATA P(21) /-0.00000 00000 00024 23D0/
- DATA P(22) /+0.00000 00000 00010 25D0/
- DATA P(23) /-0.00000 00000 00004 42D0/
- DATA P(24) /+0.00000 00000 00001 94D0/
- DATA P(25) /-0.00000 00000 00000 87D0/
- DATA P(26) /+0.00000 00000 00000 39D0/
- DATA P(27) /-0.00000 00000 00000 18D0/
- DATA P(28) /+0.00000 00000 00000 08D0/
-
- DATA Q( 0) /+0.98604 06569 62382 60D0/
- DATA Q( 1) /-0.01347 17382 08295 21D0/
- DATA Q( 2) /+0.00045 32928 41165 23D0/
- DATA Q( 3) /-0.00003 06728 86516 55D0/
- DATA Q( 4) /+0.00000 31319 91976 01D0/
- DATA Q( 5) /-0.00000 04211 01964 96D0/
- DATA Q( 6) /+0.00000 00690 72448 30D0/
- DATA Q( 7) /-0.00000 00131 83212 90D0/
- DATA Q( 8) /+0.00000 00028 36974 33D0/
- DATA Q( 9) /-0.00000 00006 73292 34D0/
- DATA Q(10) /+0.00000 00001 73396 87D0/
- DATA Q(11) /-0.00000 00000 47869 39D0/
- DATA Q(12) /+0.00000 00000 14032 35D0/
- DATA Q(13) /-0.00000 00000 04334 96D0/
- DATA Q(14) /+0.00000 00000 01402 73D0/
- DATA Q(15) /-0.00000 00000 00473 06D0/
- DATA Q(16) /+0.00000 00000 00165 58D0/
- DATA Q(17) /-0.00000 00000 00059 94D0/
- DATA Q(18) /+0.00000 00000 00022 37D0/
- DATA Q(19) /-0.00000 00000 00008 59D0/
- DATA Q(20) /+0.00000 00000 00003 38D0/
- DATA Q(21) /-0.00000 00000 00001 36D0/
- DATA Q(22) /+0.00000 00000 00000 56D0/
- DATA Q(23) /-0.00000 00000 00000 24D0/
- DATA Q(24) /+0.00000 00000 00000 10D0/
-
- IF(ABS(X) .LE. 8) THEN
- Y=R8*X
- H=2*Y**2-1
- ALFA=H+H
- B1=0
- B2=0
- DO 1 I = 15,0,-1
- B0=S(I)+ALFA*B1-B2
- B2=B1
- 1 B1=B0
- H=Y*(B0-B2)
- ELSE
- R=1/X
- H=128*R**2-1
- ALFA=H+H
- B1=0
- B2=0
- DO 2 I = 28,0,-1
- B0=P(I)+ALFA*B1-B2
- B2=B1
- 2 B1=B0
- PP=B0-H*B2
- B1=0
- B2=0
- DO 3 I = 24,0,-1
- B0=Q(I)+ALFA*B1-B2
- B2=B1
- 3 B1=B0
- H=SIGN(PIH,X)-R*(R*PP*SIN(X)+(B0-H*B2)*COS(X))
- END IF
- GO TO 9
-
-#if !defined(CERNLIB_DOUBLE)
- ENTRY RCOSIN(X)
-#endif
-#if defined(CERNLIB_DOUBLE)
- ENTRY DCOSIN(X)
-#endif
-
- IF(X .EQ. 0) THEN
- H=0
- CALL MTLPRT(NAME,'C336.1','ARGUMENT X = 0')
- ELSEIF(ABS(X) .LE. 8) THEN
- H=R32*X**2-1
- ALFA=H+H
- B1=0
- B2=0
- DO 4 I = 15,0,-1
- B0=C(I)+ALFA*B1-B2
- B2=B1
- 4 B1=B0
- H=CE+LOG(ABS(X))-B0+H*B2
- ELSE
- R=1/X
- H=128*R**2-1
- ALFA=H+H
- B1=0
- B2=0
- DO 5 I = 28,0,-1
- B0=P(I)+ALFA*B1-B2
- B2=B1
- 5 B1=B0
- PP=B0-H*B2
- B1=0
- B2=0
- DO 6 I = 24,0,-1
- B0=Q(I)+ALFA*B1-B2
- B2=B1
- 6 B1=B0
- H=R*((B0-H*B2)*SIN(X)-R*PP*COS(X))
- END IF
-#if !defined(CERNLIB_DOUBLE)
- 9 RSININ=H
-#endif
-#if defined(CERNLIB_DOUBLE)
- 9 DSININ=H
-#endif
- RETURN
- END
diff --git a/src/mathlib/gen/c/snleq128.F b/src/mathlib/gen/c/snleq128.F
deleted file mode 100644
index 4bbd55f..0000000
--- a/src/mathlib/gen/c/snleq128.F
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: snleq128.F,v 1.1.1.1 1996/04/01 15:01:52 mclareni Exp $
-*
-* $Log: snleq128.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:52 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if !defined(CERNLIB_DOUBLE)
- SUBROUTINE DSNLEQ(N,X,F,FTOL,XTOL,MAXF,IPRT,INFO,SUB,W)
-C
-#include "gen/imp128.inc"
-C
- CHARACTER NAME*(*)
- PARAMETER (NAME = 'DSNLEQ')
- CALL MTLPRT(NAME,'C201.0','Not available on this machine')
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/c/snleq64.F b/src/mathlib/gen/c/snleq64.F
deleted file mode 100644
index 1150b30..0000000
--- a/src/mathlib/gen/c/snleq64.F
+++ /dev/null
@@ -1,248 +0,0 @@
-*
-* $Id: snleq64.F,v 1.1.1.1 1996/04/01 15:01:52 mclareni Exp $
-*
-* $Log: snleq64.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:52 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- SUBROUTINE DSNLEQ(N,X,F,FTOL,XTOL,MAXF,IPRT,INFO,SUB,W)
-#include "gen/imp64.inc"
-#endif
-#if !defined(CERNLIB_DOUBLE)
- SUBROUTINE RSNLEQ(N,X,F,FTOL,XTOL,MAXF,IPRT,INFO,SUB,W)
-#endif
-
-C Based on J.J. More and M.Y. Cosnard
-C
-C ALGORITHM 554 BRENTM, A Fortran Subroutine for the
-C Numerical Solution of Systems of Nonlinear Equations [C5]
-C
-C ACM Trans. Math. Software 6 (1980) 240-251.
-
- DIMENSION X(N),F(N),W(N,*),MPT(288)
- LOGICAL LCV
-
- PARAMETER (Z1 = 1, SCALE = 10, P05 = 5*Z1/100)
-C**** EPS = SQRT(SMALLEST FP.NUMBER)
-C EPS = 1 / SQRT( 16D0**13 )
-#if !defined(CERNLIB_DOUBLE)
- PARAMETER (EPS = 0.84293 69702 17878 97282 52636 392E-07)
-#endif
-#if defined(CERNLIB_IBM)
- PARAMETER (EPS = 0.14901 16119 38476 562D-07)
-#endif
-#if defined(CERNLIB_VAX)
- PARAMETER (EPS = 0.37252 90298 46191 40625D-08)
-#endif
-#if (defined(CERNLIB_UNIX))&&(defined(CERNLIB_DOUBLE))
- PARAMETER (EPS = 0.14901 16119 38476 600D-07)
-#endif
- DATA (MPT(I),I=1,288)
- 1/1* 1,1* 2,3* 3,3* 4,4* 5,4* 6,4* 7,4* 8,5* 9,5*10,5*11,5*12,
- 2 5*13,5*14,6*15,6*16,5*17,6*18,6*19,6*20,7*21,6*22,6*23,7*24,
- 3 6*25,7*26,6*27,7*28,7*29,7*30,7*31,7*32,7*33,7*34,7*35,7*36,
- 4 8*37,7*38,7*39,8*40,7*41,8*42,7*43,8*44,8*45,7*46,8*47,8*48/
-
- INFO=0
- IF(N .LE. 0 .OR. FTOL .LE. 0 .OR. XTOL .LE. 0) RETURN
-C
-C Find optimal MOPT for iterative refinement
-C
- IF(N .LE. 288) THEN
- MOPT=MPT(N)
- ELSE
- H=0
- DO 1 I = 49,N
- TEMP=LOG(I+Z1)/(N+2*I+1)
- IF(TEMP .LT. H) THEN
- MOPT=I-1
- GO TO 2
- ENDIF
- 1 H=TEMP
- ENDIF
-
- 2 IFLAG=0
- NUMF=0
- NFCALL=0
-
- NIER6=-1
- NIER7=-1
- NIER8=0
- FNORM=0
- DIFIT=0
- XNORM=0
- DO 10 I = 1,N
- 10 XNORM=MAX(XNORM,ABS(X(I)))
- DELTA=SCALE*XNORM
- IF(XNORM .EQ. 0) DELTA=SCALE
-
- 20 IF(IPRT .NE. 0) WRITE(6,'(1X,I5,D25.14)') (I,X(I),I=1,N)
-
- NSING=N
- FNORM1=FNORM
- DIFIT1=DIFIT
- FNORM=0
-C
-C Compute step H for the divided difference which approximates
-C the K-th row of the Jacobian matrix
-C
- H=EPS*XNORM
- IF(H .EQ. 0) H=EPS
- DO 40 J = 1,N
- DO 30 I = 1,N
- 30 W(I,J+3)=0
- W(J,J+3)=H
- 40 W(J,2)=X(J)
-C
-C Enter a subiteration
-C
- DO 150 K = 1,N
- IFLAG=K
- CALL SUB(N,W(1,2),F,IFLAG)
- FKY=F(K)
- NFCALL=NFCALL+1
- NUMF=NFCALL/N
- IF(IFLAG .LT. 0) GO TO 230
- FNORM=MAX(FNORM,ABS(FKY))
-C
-C Compute the K-th row of the Jacobian matrix
-C
- DO 60 J = K,N
- DO 50 I = 1,N
- 50 W(I,3)=W(I,2)+W(I,J+3)
- CALL SUB(N,W(1,3),F,IFLAG)
- FKZ=F(K)
- NFCALL=NFCALL+1
- NUMF=NFCALL/N
- IF(IFLAG .LT. 0) GO TO 230
- 60 W(J,1)=FKZ-FKY
- F(K)=FKY
-C
-C Compute the Householder transformation to reduce the K-th row
-C of the Jacobian matrix to a multiple of the K-th unit vector
-C
- ETA=0
- DO 70 I = K,N
- 70 ETA=MAX(ETA,ABS(W(I,1)))
- IF(ETA .EQ. 0) GO TO 150
- NSING=NSING-1
- SKNORM=0
- DO 80 I = K,N
- W(I,1)=W(I,1)/ETA
- 80 SKNORM=SKNORM+W(I,1)**2
- SKNORM=SQRT(SKNORM)
- IF(W(K,1) .LT. 0) SKNORM=-SKNORM
- W(K,1)=W(K,1)+SKNORM
-C
-C Apply the transformation
-C
- DO 90 I = 1,N
- 90 W(I,3)=0
- DO 100 J = K,N
- DO 100 I = 1,N
- 100 W(I,3)=W(I,3)+W(J,1)*W(I,J+3)
- DO 120 J = K,N
- TEMP=W(J,1)/(SKNORM*W(K,1))
- DO 120 I = 1,N
- 120 W(I,J+3)=W(I,J+3)-TEMP*W(I,3)
-C
-C Compute the subiterate
-C
- W(K,1)=SKNORM*ETA
- TEMP=FKY/W(K,1)
- IF(H*ABS(TEMP) .GT. DELTA) TEMP=SIGN(DELTA/H,TEMP)
- DO 140 I = 1,N
- 140 W(I,2)=W(I,2)+TEMP*W(I,K+3)
- 150 CONTINUE
-C
-C Compute the norms of the iterate and correction vector
-C
- XNORM=0
- DIFIT=0
- DO 160 I = 1,N
- XNORM=MAX(XNORM,ABS(W(I,2)))
- DIFIT=MAX(DIFIT,ABS(X(I)-W(I,2)))
- 160 X(I)=W(I,2)
-C
-C Update the bound on the correction vector
-C
- DELTA=MAX(DELTA,SCALE*XNORM)
-C
-C Determine the progress of the iteration
-C
- LCV=FNORM .LT. FNORM1 .AND. DIFIT .LT. DIFIT1 .AND. NSING .EQ. 0
- NIER6=NIER6+1
- NIER7=NIER7+1
- NIER8=NIER8+1
- IF(LCV) NIER6=0
- IF(FNORM .LT. FNORM1 .OR. DIFIT .LT. DIFIT1) NIER7=0
- IF(DIFIT .GT. EPS*XNORM) NIER8=0
-C
-C Tests for convergence
-C
- IF(FNORM .LE. FTOL) INFO=1
- IF(DIFIT .LE. XTOL*XNORM .AND. LCV) INFO=2
- IF(FNORM .LE. FTOL .AND. INFO .EQ. 2) INFO=3
- IF(INFO .NE. 0) GO TO 230
-C
-C Tests for termination
-C
- IF(NUMF .GE. MAXF) INFO=4
- IF(NSING .EQ. N) INFO=5
- IF(NIER6 .EQ. 5) INFO=6
- IF(NIER7 .EQ. 3) INFO=7
- IF(NIER8 .EQ. 4) INFO=8
- IF(INFO .NE. 0) GO TO 230
- IF(.NOT.LCV .OR. DIFIT .GT. P05*XNORM) GO TO 20
-C
-C Iterative refinement (if the iteration is converging)
-C
- DO 210 M = 2,MOPT
- FNORM1=FNORM
- FNORM=0
- DO 190 K = 1,N
- IFLAG=K
- CALL SUB(N,W(1,2),F,IFLAG)
- FKY=F(K)
- NFCALL=NFCALL+1
- NUMF=NFCALL/N
- IF(IFLAG .LT. 0) GO TO 230
- FNORM=MAX(FNORM,ABS(FKY))
-C
-C Iterative refinement is terminated if it does not give a
-C reduction on residuals
-C
- IF(FNORM .GE. FNORM1) THEN
- FNORM=FNORM1
- GO TO 20
- ENDIF
- TEMP=FKY/W(K,1)
- DO 180 I = 1,N
- 180 W(I,2)=W(I,2)+TEMP*W(I,K+3)
- 190 CONTINUE
-C
-C Compute the norms of the iterate and correction vector
-C
- XNORM=0
- DIFIT=0
- DO 200 I = 1,N
- XNORM=MAX(XNORM,ABS(W(I,2)))
- DIFIT=MAX(DIFIT,ABS(X(I)-W(I,2)))
- 200 X(I)=W(I,2)
-C
-C Stopping criteria for iterative refinement
-C
- IF(FNORM .LE. FTOL) INFO=1
- IF(DIFIT .LE. XTOL*XNORM) INFO=2
- IF(FNORM .LE. FTOL .AND. INFO .EQ. 2) INFO=3
- IF(NUMF .GE. MAXF .AND. INFO .EQ. 0) INFO=4
- IF(INFO .NE. 0) GO TO 230
- 210 CONTINUE
- GO TO 20
-
- 230 IF(IFLAG .LT. 0) INFO=IFLAG
- RETURN
- END
diff --git a/src/mathlib/gen/c/strh0.F b/src/mathlib/gen/c/strh0.F
deleted file mode 100644
index a4b670d..0000000
--- a/src/mathlib/gen/c/strh0.F
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: strh0.F,v 1.1.1.1 1996/04/01 15:02:08 mclareni Exp $
-*
-* $Log: strh0.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:08 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION STRH0(X)
-
- STRH0=RSTRH0(X)
- RETURN
-
- ENTRY STRH1(X)
-
- STRH1=RSTRH1(X)
- RETURN
-
- END
-#endif
diff --git a/src/mathlib/gen/c/strh0128.F b/src/mathlib/gen/c/strh0128.F
deleted file mode 100644
index c134e92..0000000
--- a/src/mathlib/gen/c/strh0128.F
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: strh0128.F,v 1.1.1.1 1996/04/01 15:02:08 mclareni Exp $
-*
-* $Log: strh0128.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:08 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION DSTRH0(X)
-#include "gen/imp128.inc"
- CHARACTER*(*) NAME1,NAME2
- PARAMETER( NAME1='DSTRH0')
- PARAMETER( NAME2='DSTRH1')
- DSTRH0=0
- CALL MTLPRT(NAME,'C342.0','Not available on this machine')
- RETURN
- ENTRY DSTRH1(X)
- DSTRH1=0
- CALL MTLPRT(NAME,'C342.0','Not available on this machine')
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/c/strh064.F b/src/mathlib/gen/c/strh064.F
deleted file mode 100644
index 17cf6db..0000000
--- a/src/mathlib/gen/c/strh064.F
+++ /dev/null
@@ -1,195 +0,0 @@
-*
-* $Id: strh064.F,v 1.1.1.1 1996/04/01 15:02:08 mclareni Exp $
-*
-* $Log: strh064.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:08 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION RSTRH0(X)
-#endif
-#if defined(CERNLIB_DOUBLE)
- FUNCTION DSTRH0(X)
-#include "gen/imp64.inc"
-#endif
-
- DIMENSION C1(0:15),C2(0:25),C3(0:16),C4(0:22)
-
- PARAMETER (Z1 = 1, R8 = Z1/8, R32 = Z1/32, CS = 3*Z1/10)
- PARAMETER (PI = 3.14159 26535 89793 24D0)
- PARAMETER (C0 = 2/PI, CC = 2/(3*PI))
-
- DATA N1,N2,N3,N4 /15,25,16,22/
-
- DATA C1( 0) / 1.00215 84560 99119 81D0/
- DATA C1( 1) /-1.63969 29268 13091 47D0/
- DATA C1( 2) / 1.50236 93961 82928 19D0/
- DATA C1( 3) /-0.72485 11530 21218 72D0/
- DATA C1( 4) / 0.18955 32737 10931 36D0/
- DATA C1( 5) /-0.03067 05202 29880 00D0/
- DATA C1( 6) / 0.00337 56144 73751 94D0/
- DATA C1( 7) /-0.00026 96501 43126 02D0/
- DATA C1( 8) / 0.00001 63746 16926 12D0/
- DATA C1( 9) /-0.00000 07824 44085 08D0/
- DATA C1(10) / 0.00000 00302 15931 88D0/
- DATA C1(11) /-0.00000 00009 63266 45D0/
- DATA C1(12) / 0.00000 00000 25793 37D0/
- DATA C1(13) /-0.00000 00000 00588 54D0/
- DATA C1(14) / 0.00000 00000 00011 58D0/
- DATA C1(15) /-0.00000 00000 00000 20D0/
-
- DATA C2( 0) / 0.99283 72757 64239 43D0/
- DATA C2( 1) /-0.00696 89128 11386 25D0/
- DATA C2( 2) / 0.00018 20510 37870 37D0/
- DATA C2( 3) /-0.00001 06325 82528 44D0/
- DATA C2( 4) / 0.00000 09819 82942 87D0/
- DATA C2( 5) /-0.00000 01225 06454 45D0/
- DATA C2( 6) / 0.00000 00189 40833 12D0/
- DATA C2( 7) /-0.00000 00034 43582 26D0/
- DATA C2( 8) / 0.00000 00007 11191 02D0/
- DATA C2( 9) /-0.00000 00001 62887 44D0/
- DATA C2(10) / 0.00000 00000 40656 81D0/
- DATA C2(11) /-0.00000 00000 10915 05D0/
- DATA C2(12) / 0.00000 00000 03120 05D0/
- DATA C2(13) /-0.00000 00000 00942 02D0/
- DATA C2(14) / 0.00000 00000 00298 48D0/
- DATA C2(15) /-0.00000 00000 00098 72D0/
- DATA C2(16) / 0.00000 00000 00033 94D0/
- DATA C2(17) /-0.00000 00000 00012 08D0/
- DATA C2(18) / 0.00000 00000 00004 44D0/
- DATA C2(19) /-0.00000 00000 00001 68D0/
- DATA C2(20) / 0.00000 00000 00000 65D0/
- DATA C2(21) /-0.00000 00000 00000 26D0/
- DATA C2(22) / 0.00000 00000 00000 11D0/
- DATA C2(23) /-0.00000 00000 00000 04D0/
- DATA C2(24) / 0.00000 00000 00000 02D0/
- DATA C2(25) /-0.00000 00000 00000 01D0/
-
- DATA C3( 0) / 0.55788 91446 48160 50D0/
- DATA C3( 1) /-0.11188 32572 65698 16D0/
- DATA C3( 2) /-0.16337 95812 52009 39D0/
- DATA C3( 3) / 0.32256 93207 24059 02D0/
- DATA C3( 4) /-0.14581 63236 72442 42D0/
- DATA C3( 5) / 0.03292 67739 93740 35D0/
- DATA C3( 6) /-0.00460 37214 20935 73D0/
- DATA C3( 7) / 0.00044 34706 16331 40D0/
- DATA C3( 8) /-0.00003 14209 95293 41D0/
- DATA C3( 9) / 0.00000 17123 71993 80D0/
- DATA C3(10) /-0.00000 00741 69870 05D0/
- DATA C3(11) / 0.00000 00026 18376 71D0/
- DATA C3(12) /-0.00000 00000 76858 39D0/
- DATA C3(13) / 0.00000 00000 01906 70D0/
- DATA C3(14) /-0.00000 00000 00040 52D0/
- DATA C3(15) / 0.00000 00000 00000 75D0/
- DATA C3(16) /-0.00000 00000 00000 01D0/
-
- DATA C4( 0) / 1.00757 64729 38656 41D0/
- DATA C4( 1) / 0.00750 31605 12482 57D0/
- DATA C4( 2) /-0.00007 04393 32645 19D0/
- DATA C4( 3) / 0.00000 26620 53933 82D0/
- DATA C4( 4) /-0.00000 01884 11577 53D0/
- DATA C4( 5) / 0.00000 00194 90149 58D0/
- DATA C4( 6) /-0.00000 00026 12619 90D0/
- DATA C4( 7) / 0.00000 00004 23626 90D0/
- DATA C4( 8) /-0.00000 00000 79551 56D0/
- DATA C4( 9) / 0.00000 00000 16799 73D0/
- DATA C4(10) /-0.00000 00000 03907 20D0/
- DATA C4(11) / 0.00000 00000 00985 43D0/
- DATA C4(12) /-0.00000 00000 00266 36D0/
- DATA C4(13) / 0.00000 00000 00076 45D0/
- DATA C4(14) /-0.00000 00000 00023 13D0/
- DATA C4(15) / 0.00000 00000 00007 33D0/
- DATA C4(16) /-0.00000 00000 00002 42D0/
- DATA C4(17) / 0.00000 00000 00000 83D0/
- DATA C4(18) /-0.00000 00000 00000 30D0/
- DATA C4(19) / 0.00000 00000 00000 11D0/
- DATA C4(20) /-0.00000 00000 00000 04D0/
- DATA C4(21) / 0.00000 00000 00000 02D0/
- DATA C4(22) /-0.00000 00000 00000 01D0/
-
- V=ABS(X)
- IF(V .LT. 8) THEN
- Y=R8*V
- H=2*Y**2-1
- ALFA=H+H
- B1=0
- B2=0
- DO 1 I = N1,0,-1
- B0=C1(I)+ALFA*B1-B2
- B2=B1
- 1 B1=B0
- H=Y*(B0-H*B2)
- ELSE
- R=1/V
- H=128*R**2-1
- ALFA=H+H
- B1=0
- B2=0
- DO 2 I = N2,0,-1
- B0=C2(I)+ALFA*B1-B2
- B2=B1
- 2 B1=B0
-#if defined(CERNLIB_DOUBLE)
- H=DBESY0(V)+C0*R*(B0-H*B2)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- H= BESY0(V)+C0*R*(B0-H*B2)
-#endif
- END IF
- IF(X .LT. 0) H=-H
- GO TO 9
-
-#if defined(CERNLIB_DOUBLE)
- ENTRY DSTRH1(X)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- ENTRY RSTRH1(X)
-#endif
-
- V=ABS(X)
- IF(V .EQ. 0) THEN
- H=0
- ELSEIF(V .LE. CS) THEN
- Y=V**2
- R=1
- H=1
- DO 5 N = 1,INT(-8/LOG10(V))
- H=-H*Y/((2*N+1)*(2*N+3))
- 5 R=R+H
- H=CC*Y*R
- ELSE IF(V .LT. 8) THEN
- H=R32*V**2-1
- ALFA=H+H
- B1=0
- B2=0
- DO 3 I = N3,0,-1
- B0=C3(I)+ALFA*B1-B2
- B2=B1
- 3 B1=B0
- H=B0-H*B2
- ELSE
- H=128/V**2-1
- ALFA=H+H
- B1=0
- B2=0
- DO 4 I = N4,0,-1
- B0=C4(I)+ALFA*B1-B2
- B2=B1
- 4 B1=B0
-#if defined(CERNLIB_DOUBLE)
- H=DBESY1(V)+C0*(B0-H*B2)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- H= BESY1(V)+C0*(B0-H*B2)
-#endif
- END IF
-#if !defined(CERNLIB_DOUBLE)
- 9 RSTRH0=H
-#endif
-#if defined(CERNLIB_DOUBLE)
- 9 DSTRH0=H
-#endif
- RETURN
- END
diff --git a/src/mathlib/gen/c/theta1.F b/src/mathlib/gen/c/theta1.F
deleted file mode 100644
index 3657990..0000000
--- a/src/mathlib/gen/c/theta1.F
+++ /dev/null
@@ -1,63 +0,0 @@
-*
-* $Id: theta1.F,v 1.1.1.1 1996/04/01 15:02:00 mclareni Exp $
-*
-* $Log: theta1.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:00 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- FUNCTION THETA1(U,Q)
-C-----COMPUTATION OF THETA-SERIES. U=ARGUMENT, Q=JACOBI'S NOME.
- THETA1=2.*SIN(U)
- GO TO 1
-#if (defined(CERNLIB_CDC))&&(defined(CERNLIB_F4))
- ENTRY THETA2
-#endif
-#if !defined(CERNLIB_CDC)||!defined(CERNLIB_F4)
- ENTRY THETA2(U,Q)
-#endif
- THETA1=2.*COS(U)
- 1 IF(THETA1.EQ.0.) RETURN
- C=THETA1**2-2.
- B=THETA1*SQRT(SQRT(Q))
- A=C*B-B
- QQ=Q**2
- THETA1=QQ*A+B
- QM=QQ
- QN=QQ
- GO TO 3
-#if (defined(CERNLIB_CDC))&&(defined(CERNLIB_F4))
- ENTRY THETA3
-#endif
-#if !defined(CERNLIB_CDC)||!defined(CERNLIB_F4)
- ENTRY THETA3(U,Q)
-#endif
- A= 2.*COS(U+U)
- GO TO 2
-#if (defined(CERNLIB_CDC))&&(defined(CERNLIB_F4))
- ENTRY THETA4
-#endif
-#if !defined(CERNLIB_CDC)||!defined(CERNLIB_F4)
- ENTRY THETA4(U,Q)
-#endif
- A=-2.*COS(U+U)
- 2 C=A
- THETA1=Q*A+1.
- QM=Q
- QN=Q
- QQ=Q**2
- B=2.
- 3 DO 4 I=1,30
- QM=QQ*QM
- QN=QM*QN
- IF(QN.LT.3E-15) GO TO 5
- B=C*A-B
- THETA1=QN*B+THETA1
- QM=QQ*QM
- QN=QM*QN
- IF(QN.LT.3E-15) GO TO 5
- A=C*B-A
- 4 THETA1=QN*A+THETA1
- 5 RETURN
- END
diff --git a/src/mathlib/gen/c/trdz.F b/src/mathlib/gen/c/trdz.F
deleted file mode 100644
index 3915d16..0000000
--- a/src/mathlib/gen/c/trdz.F
+++ /dev/null
@@ -1,74 +0,0 @@
-*
-* $Id: trdz.F,v 1.1.1.1 1996/04/01 15:01:59 mclareni Exp $
-*
-* $Log: trdz.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:59 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE TRDZ
-#include "legbl.inc"
- 1,EP
- 2, RGAM,CDIGAM
- 3,EP2,PIE,ZZS2,AA,BB,CC,FAC,SUM,ADD
-C*NS 2,CLOGOK,RGAM,CDIGAM
-C TRDZ EXPECTS GR SET=CLOGOK(2.0*ZZ,NFRIG,2)
- K=REAL(VV+1.0)
- EK=K
- EP=VV+0.5-EK
- ZZS2=Z2/4.0
- KK=K-1
- SUM=0.0
- IF(K)9,9,10
- 10 B=0.5
- C=1.0
- FAC=RGAM(VV,B,C)*EXP(VV*GR)
- SUM=FAC
- IF(KK)9,11,12
- 12 AA=-VV-2.0
- BB=-VV-0.5
- DO 2 I=1,KK
- BB=BB+1.0
- AA=AA+2.0
- FAC=FAC*(1.0+AA)*AA*ZZS2/(BB*I)
- SUM=SUM+FAC
- IF(CRIT(SUM,FAC,ACC))51,2,2
- 2 CONTINUE
- GOTO 11
- 9 SUM=0.0
- 51 CONTINUE
- 11 PIE=PI*EP
- EP2=EP/2.0
- A=EK
- B=0.5-EP
- C=1.0
- BB=0.0
- FAC=-(1.0-PIE**2/3.0)*RGAM(A,B,C)*RGAM(C,BB,-EP)
- 1 / (PI*EXP((2.0*EK-VV)*GR))
- A=EK+0.5
- B=1.0-EP2
- C=EK+1.0+EP2
- ADD=2.*CDIGAM(A)-CDIGAM(B)-CDIGAM(C)-2.0*GR
- GR=FAC*ADD*(1.0+EP2*ADD)
- SUM=SUM+GR
- AA=EK-1.5-EP
- BB=-EP
- CC=EK
- DO 22 I=1,50
- AA=AA+2.0
- BB=BB+1.0
- CC=CC+1.0
- FAC=FAC*(1.0+AA)*AA*ZZS2/(BB*CC)
- ADD=ADD+2.0/(A+1.0)+2.0/A-1.0/B-1.0/C
- A=A+2.0
- B=B+1.0
- C=C+1.0
- GR=FAC*ADD*(1.0+EP2*ADD)
- SUM=SUM+GR
- IF(CRIT(SUM,GR,ACC))52,22,22
- 22 CONTINUE
- NCVG=NCVG+4
- 52 PP=SUM/PISR
- RETURN
- END
diff --git a/src/mathlib/gen/c/wclbes.F b/src/mathlib/gen/c/wclbes.F
deleted file mode 100644
index d6c90d7..0000000
--- a/src/mathlib/gen/c/wclbes.F
+++ /dev/null
@@ -1,823 +0,0 @@
-*
-* $Id: wclbes.F,v 1.1.1.1 1996/04/01 15:01:57 mclareni Exp $
-*
-* $Log: wclbes.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:57 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- SUBROUTINE WCLBES(ZZ,ETA1,ZLMIN,NL,FC,GC,FCP,GCP,SIG,KFN,MODE1,
- 1 IFAIL,IPR)
-C
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-C C
-C COMPLEX COULOMB WAVEFUNCTION PROGRAM USING STEED'S METHOD C
-C Original title : COULCC C
-C C
-C A. R. Barnett Manchester March 1981 C
-C modified I.J. Thompson Daresbury, Sept. 1983 for Complex Functions C
-C C
-C The FORM (not the SUBSTANCE) of this program has been modified C
-C by K.S. KOLBIG (CERN) December 1987 C
-C C
-C original program RCWFN in CPC 8 (1974) 377-395 C
-C + RCWFF in CPC 11 (1976) 141-142 C
-C + COULFG in CPC 27 (1982) 147-166 C
-C description of real algorithm in CPC 21 (1981) 297-314 C
-C description of complex algorithm JCP 64 (1986) 490-509 C
-C this version written up in CPC 36 (1985) 363-372 C
-C C
-C WCLBES returns F,G,G',G',SIG for complex ETA, ZZ, and ZLMIN, C
-C for NL integer-spaced lambda values ZLMIN to ZLMIN+NL inclusive, C
-C thus giving complex-energy solutions to the Coulomb Schrodinger C
-C equation,to the Klein-Gordon equation and to suitable forms of C
-C the Dirac equation ,also spherical & cylindrical Bessel equations C
-C C
-C if ABS(MODE1) C
-C = 1 get F,G,F',G' for integer-spaced lambda values C
-C = 2 F,G unused arrays must be dimensioned in C
-C = 3 F, F' call to at least length (0:1) C
-C = 4 F C
-C = 11 get F,H+,F',H+' ) if KFN=0, H+ = G + i.F ) C
-C = 12 F,H+ ) >0, H+ = J + i.Y = H(1) ) in C
-C = 21 get F,H-,F',H-' ) if KFN=0, H- = G - i.F ) GC C
-C = 22 F,H- ) >0, H- = J - i.Y = H(2) ) C
-C C
-C if MODE1 < 0 then the values returned are scaled by an exponen- C
-C tial factor (dependent only on ZZ) to bring nearer C
-C unity the functions for large ABS(ZZ), small ETA , C
-C and ABS(ZL) < ABS(ZZ). C
-C Define SCALE = ( 0 if MODE1 > 0 C
-C ( IMAG(ZZ) if MODE1 < 0 & KFN < 3 C
-C ( REAL(ZZ) if MODE1 < 0 & KFN = 3 C
-C then FC = EXP(-ABS(SCALE)) * ( F, j, J, or I) C
-C and GC = EXP(-ABS(SCALE)) * ( G, y, or Y ) C
-C or EXP(SCALE) * ( H+, H(1), or K) C
-C or EXP(-SCALE) * ( H- or H(2) ) C
-C C
-C if KFN = 0,-1 complex Coulomb functions are returned F & G C
-C = 1 spherical Bessel " " " j & y C
-C = 2 cylindrical Bessel " " " J & Y C
-C = 3 modified cyl. Bessel " " " I & K C
-C C
-C and where Coulomb phase shifts put in SIG if KFN=0 (not -1) C
-C C
-C The use of MODE and KFN is independent C
-C (except that for KFN=3, H(1) & H(2) are not given) C
-C C
-C With negative orders lambda, WCLBES can still be used but with C
-C reduced accuracy as CF1 becomes unstable. The user is thus C
-C strongly advised to use reflection formulae based on C
-C H+-(ZL,,) = H+-(-ZL-1,,) * exp +-i(sig(ZL)-sig(-ZL-1)-(ZL+1/2)pi) C
-C C
-C Precision: results to within 2-3 decimals of 'machine accuracy', C
-C except in the following cases: C
-C (1) if CF1A fails because X too small or ETA too large C
-C the F solution is less accurate if it decreases with C
-C decreasing lambda (e.g. for lambda.LE.-1 & ETA.NE.0) C
-C (2) if ETA is large (e.g. >> 50) and X inside the C
-C turning point, then progressively less accuracy C
-C (3) if ZLMIN is around sqrt(ACCUR) distance from an C
-C integral order and abs(X) << 1, then errors present. C
-C RERR traces the main roundoff errors. C
-C C
-C WCLBES is coded for real*8 on IBM or equivalent ACCUR >= 10**-14 C
-C with a section of doubled REAL*16 for less roundoff errors. C
-C (If no doubled precision available, increase JMAX to eg 100)C
-C Use IMPLICIT COMPLEX*32 & REAL*16 on VS compiler ACCUR >= 10**-32 C
-C For single precision CDC (48 bits) reassign C
-C DOUBLE PRECISION=REAL etc. C
-C C
-C IPR on input = 0 : no printing of error messages C
-C ne 0 : print error messages on file 6 C
-C IFAIL in output = -2 : argument out of range C
-C = -1 : one of the continued fractions failed, C
-C or arithmetic check before final recursion C
-C = 0 : All Calculations satisfactory C
-C ge 0 : results available for orders up to & at C
-C position NL-IFAIL in the output arrays. C
-C = -3 : values at ZLMIN not found as over/underflowC
-C = -4 : roundoff errors make results meaningless C
-C C
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-C C
-C Machine dependent constants : C
-C C
-C ACCU target bound on relative error (except near 0 crossings)C
-C (ACCUR should be at least 100 * ACC8) C
-C ACC8 smallest number with 1+ACC8 .ne.1 in REAL*8 arithmetic C
-C ACC16 smallest number with 1+ACC16.ne.1 in REAL*16 arithmetic C
-C FPMAX magnitude of largest floating point number * ACC8 C
-C FPMIN magnitude of smallest floating point number / ACC8 C
-C C
-C Parameters determining region of calculations : C
-C C
-C R20 estimate of (2F0 iterations)/(CF2 iterations) C
-C ASYM minimum X/(ETA**2+L) for CF1A to converge easily C
-C XNEAR minimum ABS(X) for CF2 to converge accurately C
-C LIMIT maximum no. iterations for CF1, CF2, and 1F1 series C
-C JMAX size of work arrays for Pade accelerations C
-C NDROP number of successive decrements to define instabilityC
-C C
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-C
-C C309R1 = CF2, C309R2 = F11, C309R3 = F20,
-C C309R4 = CF1R, C309R5 = CF1C, C309R6 = CF1A,
-C C309R7 = RCF, C309R8 = CTIDY.
-C
- IMPLICIT COMPLEX*16 (A-H,O-Z)
-C
- COMMON /COULC2/ NFP,N11,NPQ1,NPQ2,N20,KAS1,KAS2
- INTEGER NPQ(2),KAS(2)
- EQUIVALENCE (NPQ(1),NPQ1),(NPQ(2),NPQ2)
- EQUIVALENCE (KAS(1),KAS1),(KAS(2),KAS2)
- DOUBLE PRECISION ZERO,ONE,TWO,HALF
- DOUBLE PRECISION R20,ASYM,XNEAR
- DOUBLE PRECISION FPMAX,FPMIN,FPLMAX,FPLMIN
- DOUBLE PRECISION ACCU,ACC8,ACC16
- DOUBLE PRECISION HPI,TLOG
- DOUBLE PRECISION ERR,RERR,ABSC,ACCUR,ACCT,ACCH,ACCB,C309R4
- DOUBLE PRECISION PACCQ,EPS,OFF,SCALE,SF,SFSH,TA,RK,OMEGA,ABSX
- DOUBLE PRECISION DX1,DETA,DZLL
-
- LOGICAL LPR,ETANE0,IFCP,RLEL,DONEM,UNSTAB,ZLNEG,AXIAL,NOCF2,NPINT
-
- PARAMETER(ZERO = 0, ONE = 1, TWO = 2, HALF = ONE/TWO)
- PARAMETER(CI = (0,1), CIH = HALF*CI)
- PARAMETER(R20 = 3, ASYM = 3, XNEAR = HALF)
- PARAMETER(LIMIT = 20000, NDROP = 5, JMAX = 50)
-
-#include "c309prec.inc"
-
- PARAMETER(HPI = 1.57079 63267 94896 619D0)
- PARAMETER(TLOG = 0.69314 71805 59945 309D0)
-
- DIMENSION FC(0:*),GC(0:*),FCP(0:*),GCP(0:*),SIG(0:*)
- DIMENSION XRCF(JMAX,4)
-
-#if defined(CERNLIB_QF2C)
-#include "defdr.inc"
-#endif
- NINTC(W)=NINT(DREAL(W))
- ABSC(W)=ABS(DREAL(W))+ABS(DIMAG(W))
- NPINT(W,ACCB)=ABSC(NINTC(W)-W) .LT. ACCB .AND. DREAL(W) .LT. HALF
-C
- MODE=MOD(ABS(MODE1),10)
- IFCP=MOD(MODE,2) .EQ. 1
- LPR=IPR .NE. 0
- IFAIL=-2
- N11=0
- NFP=0
- KAS(1)=0
- KAS(2)=0
- NPQ(1)=0
- NPQ(2)=0
- N20=0
-
- ACCUR=MAX(ACCU,50*ACC8)
- ACCT=HALF*ACCUR
- ACCH=SQRT(ACCUR)
- ACCB=SQRT(ACCH)
- RERR=ACCT
- FPLMAX=LOG(FPMAX)
- FPLMIN=LOG(FPMIN)
-C
- CIK=ONE
- IF(KFN .GE. 3) CIK=CI*SIGN(ONE,FPMIN-DIMAG(ZZ))
- X=ZZ*CIK
- ETA=ETA1
- IF(KFN .GT. 0) ETA=ZERO
- ETANE0=ABSC(ETA) .GT. ACC8
- ETAI=ETA*CI
- DELL=ZERO
- IF(KFN .GE. 2) DELL=HALF
- ZM1=ZLMIN-DELL
- SCALE=ZERO
- IF(MODE1 .LT. 0) SCALE=DIMAG(X)
-C
- M1=1
- L1=M1+NL
- RLEL=ABS(DIMAG(ETA))+ABS(DIMAG(ZM1)) .LT. ACC8
- ABSX=ABS(X)
- AXIAL=RLEL .AND. ABS(DIMAG(X)) .LT. ACC8*ABSX
- IF(MODE .LE. 2 .AND. ABSX .LT. FPMIN) GO TO 310
- XI=ONE/X
- XLOG=LOG(X)
-
-C log with cut along the negative real axis, see also OMEGA
-
- ID=1
- DONEM=.FALSE.
- UNSTAB=.FALSE.
- LF=M1
- IFAIL=-1
- 10 ZLM=ZM1+(LF-M1)
- ZLL=ZM1+(L1-M1)
-C
-C *** ZLL is final lambda value, or 0.5 smaller for J,Y Bessels
-C
- Z11=ZLL
- IF(ID .LT. 0) Z11=ZLM
- P11=CI*SIGN(ONE,ACC8-DIMAG(ETA))
- LAST=L1
-C
-C *** Find phase shifts and Gamow factor at lambda = ZLL
-C
- PK=ZLL+ONE
- AA=PK-ETAI
- AB=PK+ETAI
- BB=TWO*PK
- ZLNEG=NPINT(BB,ACCB)
- CLGAA=WLOGAM(AA)
- CLGAB=CLGAA
- IF(ETANE0 .AND. .NOT.RLEL) CLGAB=WLOGAM(AB)
- IF(ETANE0 .AND. RLEL) CLGAB=DCONJG(CLGAA)
- SIGMA=(CLGAA-CLGAB)*CIH
- IF(KFN .EQ. 0) SIG(L1)=SIGMA
- IF(.NOT.ZLNEG) CLL=ZLL*TLOG-HPI*ETA-WLOGAM(BB)+(CLGAA+CLGAB)*HALF
- THETA=X-ETA*(XLOG+TLOG)-ZLL*HPI+SIGMA
-C
- TA=(DIMAG(AA)**2+DIMAG(AB)**2+ABS(DREAL(AA))+ABS(DREAL(AB)))*HALF
- IF(ID .GT. 0 .AND. ABSX .LT. TA*ASYM .AND. .NOT.ZLNEG) GO TO 20
-C
-C *** use CF1 instead of CF1A, if predicted to converge faster,
-C (otherwise using CF1A as it treats negative lambda &
-C recurrence-unstable cases properly)
-C
- RK=SIGN(ONE,DREAL(X)+ACC8)
- P=THETA
- IF(RK .LT. 0) P=-X+ETA*(LOG(-X)+TLOG)-ZLL*HPI-SIGMA
- XRCF(1,1)=PK
- F=RK*C309R6(X*RK,ETA*RK,ZLL,P,ACCT,JMAX,NFP,FEST,ERR,FPMAX,XRCF,
- 1 XRCF(1,3),XRCF(1,4))
- FESL=LOG(FEST)+ABS(DIMAG(X))
- NFP=-NFP
- IF(NFP .LT. 0 .OR. UNSTAB .AND. ERR .LT. ACCB) GO TO 40
- IF(.NOT.ZLNEG .OR. UNSTAB .AND. ERR .GT. ACCB) GO TO 20
- IF(LPR) WRITE(6,1060) '-L',ERR
- IF(ERR.GT.ACCB) GO TO 280
- GO TO 40
-C
-C *** evaluate CF1 = f = F'(ZLL,ETA,X)/F(ZLL,ETA,X)
-C
- 20 IF(AXIAL) THEN
- DX1=X
- DETA=ETA
- DZLL=ZLL
- F=C309R4(DX1,DETA,DZLL,ACC8,SF,RK,ETANE0,LIMIT,ERR,NFP,
- 1 FPMIN,FPMAX,LPR)
- FCL=SF
- TPK1=RK
- ELSE
- F=C309R5(X,ETA,ZLL,ACC8,FCL,TPK1,ETANE0,LIMIT,ERR,NFP,
- 1 FPMIN,FPMAX,LPR)
- END IF
- IF(ERR .GT. ONE) THEN
- IFAIL=-1
- GO TO 290
- END IF
-C
-C *** Make a simple check for CF1 being badly unstable:
-C
- IF(ID .GE. 0) THEN
- UNSTAB=DREAL((ONE-ETA*XI)*CI*DIMAG(THETA)/F) .GT. ZERO
- 1 .AND. .NOT.AXIAL .AND. ABS(DIMAG(THETA)) .GT. -LOG(ACC8)*HALF
- 2 .AND. ABSC(ETA)+ABSC(ZLL) .LT. ABSC(X)
- IF(UNSTAB) THEN
- ID=-1
- LF=L1
- L1=M1
- RERR=ACCT
- GO TO 10
- END IF
- END IF
-C
-C *** compare accumulated phase FCL with asymptotic phase for G(k+1) :
-C to determine estimate of F(ZLL) (with correct sign) to start recur
-C
- W=X*X*(HALF/TPK1+ONE/TPK1**2)+ETA*(ETA-TWO*X)/TPK1
- FESL=(ZLL+ONE)*XLOG+CLL-W-LOG(FCL)
- 40 FESL=FESL-ABS(SCALE)
- RK=MAX(DREAL(FESL),FPLMIN*HALF)
- FESL=DCMPLX(MIN(RK,FPLMAX*HALF),DIMAG(FESL))
- FEST=EXP(FESL)
-C
- RERR=MAX(RERR,ERR,ACC8*ABS(DREAL(THETA)))
-C
- FCL=FEST
- FPL=FCL*F
- IF(IFCP) FCP(L1)=FPL
- FC(L1)=FCL
-C
-C *** downward recurrence to lambda = ZLM. array GC,if present,stores RL
-C
- I=MAX(-ID,0)
- ZL=ZLL+I
- MONO=0
- OFF=ABS(FCL)
- TA=ABSC(SIGMA)
-
-C
-C CORRESPONDS TO DO 70 L = L1-ID,LF,-ID
-C
- L=L1-ID
- LC70=(L1-LF)/ID
- 70 IF(LC70 .LE. 0) GO TO 80
- IF(ETANE0) THEN
- IF(RLEL) THEN
- DSIG=ATAN2(DREAL(ETA),DREAL(ZL))
- RL=SQRT(DREAL(ZL)**2+DREAL(ETA)**2)
- ELSE
- AA=ZL-ETAI
- BB=ZL+ETAI
- IF(ABSC(AA) .LT. ACCH .OR. ABSC(BB) .LT. ACCH) GOTO 50
- DSIG=(LOG(AA)-LOG(BB))*CIH
- RL=AA*EXP(CI*DSIG)
- END IF
- IF(ABSC(SIGMA) .LT. TA*HALF) THEN
-
-C re-calculate SIGMA because of accumulating roundoffs:
-
- SL=(WLOGAM(ZL+I-ETAI)-WLOGAM(ZL+I+ETAI))*CIH
- RL=(ZL-ETAI)*EXP(CI*ID*(SIGMA-SL))
- SIGMA=SL
- TA=ZERO
- ELSE
- SIGMA=SIGMA-DSIG*ID
- END IF
- TA=MAX(TA,ABSC(SIGMA))
- SL=ETA+ZL*ZL*XI
- PL=ZERO
- IF(ABSC(ZL) .GT. ACCH) PL=(SL*SL-RL*RL)/ZL
- FCL1=(FCL*SL+ID*ZL*FPL)/RL
- SF=ABS(FCL1)
- IF(SF .GT. FPMAX) GO TO 350
- FPL=(FPL*SL+ID*PL*FCL)/RL
- IF(MODE .LE. 1) GCP(L+ID)=PL*ID
- ELSE
-
-C ETA = 0, including Bessels. NB RL==SL
-
- RL=ZL*XI
- FCL1=FCL*RL+FPL*ID
- SF=ABS(FCL1)
- IF(SF .GT. FPMAX) GO TO 350
- FPL=(FCL1*RL-FCL)*ID
- END IF
- MONO=MONO+1
- IF(SF .GE. OFF) MONO=0
- FCL=FCL1
- OFF=SF
- FC(L)=FCL
- IF(IFCP) FCP(L)=FPL
- IF(KFN .EQ. 0) SIG(L)=SIGMA
- IF(MODE .LE. 2) GC(L+ID)=RL
- ZL=ZL-ID
- IF(MONO .LT. NDROP .OR. AXIAL .OR.
- 1 DREAL(ZLM)*ID .GT. -NDROP .AND. .NOT.ETANE0) THEN
- L=L-ID
- LC70=LC70-1
- GO TO 70
- END IF
- UNSTAB=.TRUE.
-C
-C *** take action if cannot or should not recur below this ZL:
-
- 50 ZLM=ZL
- LF=L
- IF(ID .LT. 0) GO TO 380
- IF(.NOT.UNSTAB) LF=L+1
- IF(L+MONO .LT. L1-2 .OR. ID .LT. 0 .OR. .NOT.UNSTAB) GO TO 80
-
-C otherwise, all L values (for stability) should be done
-C in the reverse direction:
-
- ID=-1
- LF=L1
- L1=M1
- RERR=ACCT
- GO TO 10
-
- 80 IF(FCL .EQ. ZERO) FCL=ACC8
- F=FPL/FCL
-C
-C *** Check, if second time around, that the 'f' values agree!
-C
- IF(ID .GT. 0) FIRST=F
- IF(DONEM) RERR=MAX(RERR,ABSC(F-FIRST)/ABSC(F))
- IF(DONEM) GO TO 90
-C
- NOCF2=.FALSE.
- THETAM=X-ETA*(XLOG+TLOG)-ZLM*HPI+SIGMA
-C
-C *** on left x-plane, determine OMEGA by requiring cut on -x axis
-C on right x-plane, choose OMEGA (using estimate based on THETAM)
-C so H(omega) is smaller and recurs upwards accurately.
-C (x-plane boundary is shifted to give CF2(LH) a chance to converge)
-C
- OMEGA=SIGN(ONE,DIMAG(X)+ACC8)
- IF(DREAL(X) .GE. XNEAR) OMEGA=SIGN(ONE,DIMAG(THETAM)+ACC8)
- SFSH=EXP(OMEGA*SCALE-ABS(SCALE))
- OFF=EXP(MIN(TWO*MAX(ABS(DIMAG(X)),ABS(DIMAG(THETAM)),
- 1 ABS(DIMAG(ZLM))*3),FPLMAX))
- EPS=MAX(ACC8,ACCT*HALF/OFF)
-C
-C *** Try first estimated omega, then its opposite,
-C to find the H(omega) linearly independent of F
-C i.e. maximise CF1-CF2 = 1/(F H(omega)) , to minimise H(omega)
-C
- 90 DO 100 L = 1,2
- LH=1
- IF(OMEGA .LT. ZERO) LH=2
- PM=CI*OMEGA
- ETAP=ETA*PM
- IF(DONEM) GO TO 130
- PQ1=ZERO
- PACCQ=ONE
- KASE=0
-C
-C *** Check for small X, i.e. whether to avoid CF2 :
-C
- IF(MODE .GE. 3 .AND. ABSX .LT. ONE ) GO TO 190
- IF(MODE .LT. 3 .AND. (NOCF2 .OR. ABSX .LT. XNEAR .AND.
- 1 ABSC(ETA)*ABSX .LT. 5 .AND. ABSC(ZLM) .LT. 4)) THEN
- KASE=5
- GO TO 120
- END IF
-C
-C *** Evaluate CF2 : PQ1 = p + i.omega.q at lambda = ZLM
-C
- PQ1=C309R1(X,ETA,ZLM,PM,EPS,LIMIT,ERR,NPQ(LH),ACC8,ACCH,
- 1 LPR,ACCUR,DELL)
- ERR=ERR*MAX(ONE,ABSC(PQ1)/MAX(ABSC(F-PQ1),ACC8))
-C
-C *** check if impossible to get F-PQ accurately because of cancellation
-C original guess for OMEGA (based on THETAM) was wrong
-C Use KASE 5 or 6 if necessary if Re(X) < XNEAR
- IF(ERR .LT. ACCH) GO TO 110
- NOCF2=DREAL(X) .LT. XNEAR .AND. ABS(DIMAG(X)) .LT. -LOG(ACC8)
- 100 OMEGA=-OMEGA
- IF(UNSTAB) GO TO 360
- IF(LPR .AND. DREAL(X) .LT. -XNEAR) WRITE(6,1060) '-X',ERR
- 110 RERR=MAX(RERR,ERR)
-C
-C *** establish case of calculation required for irregular solution
-C
- 120 IF(KASE .GE. 5) GO TO 130
- IF(DREAL(X) .GT. XNEAR) THEN
-
-C estimate errors if KASE 2 or 3 were to be used:
-
- PACCQ=EPS*OFF*ABSC(PQ1)/MAX(ABS(DIMAG(PQ1)),ACC8)
- END IF
- IF(PACCQ .LT. ACCUR) THEN
- KASE=2
- IF(AXIAL) KASE=3
- ELSE
- KASE=1
- IF(NPQ(1)*R20 .LT. JMAX) KASE=4
-C i.e. change to kase=4 if the 2F0 predicted to converge
- END IF
- 130 GO TO (190,140,150,170,190,190), ABS(KASE)
- 140 IF(.NOT.DONEM)
-C
-C *** Evaluate CF2 : PQ2 = p - i.omega.q at lambda = ZLM (Kase 2)
-C
- 1 PQ2=C309R1(X,ETA,ZLM,-PM,EPS,LIMIT,ERR,NPQ(3-LH),ACC8,ACCH,
- 2 LPR,ACCUR,DELL)
- P=(PQ2+PQ1)*HALF
- Q=(PQ2-PQ1)*HALF*PM
- GO TO 160
- 150 P=DREAL(PQ1)
- Q=DIMAG(PQ1)
-C
-C *** With Kase = 3 on the real axes, P and Q are real & PQ2 = PQ1*
-C
- PQ2=DCONJG(PQ1)
-C
-C *** solve for FCM = F at lambda = ZLM,then find norm factor W=FCM/FCL
-C
- 160 W=(PQ1-F)*(PQ2-F)
- SF=EXP(-ABS(SCALE))
- FCM=SQRT(Q/W)*SF
-
-C any SQRT given here is corrected by
-C using sign for FCM nearest to phase of FCL
-
- IF(DREAL(FCM/FCL) .LT. ZERO) FCM=-FCM
- GAM=(F-P)/Q
- TA=ABSC(GAM+PM)
- PACCQ=EPS*MAX(TA,ONE/TA)
- HCL=FCM*(GAM+PM)*(SFSH/(SF*SF))
-
-C Consider a KASE = 1 Calculation
-
- IF(PACCQ .GT. ACCUR .AND. KASE .GT. 0) THEN
- F11V=C309R2(X,ETA,Z11,P11,ACCT,LIMIT,0,ERR,N11,FPMAX,ACC8,ACC16)
- IF(ERR .LT. PACCQ) GO TO 200
- END IF
- RERR=MAX(RERR,PACCQ)
- GO TO 230
-C
-C *** Arrive here if KASE = 4
-C to evaluate the exponentially decreasing H(LH) directly.
-C
- 170 IF(DONEM) GO TO 180
- AA=ETAP-ZLM
- BB=ETAP+ZLM+ONE
- F20V=C309R3(AA,BB,-HALF*PM*XI,ACCT,JMAX,ERR,FPMAX,N20,XRCF)
- IF(N20 .LE. 0) GO TO 190
- RERR=MAX(RERR,ERR)
- HCL=FPMIN
- IF(ABS(DREAL(PM*THETAM)+OMEGA*SCALE) .GT. FPLMAX) GO TO 330
- 180 HCL=F20V*EXP(PM*THETAM+OMEGA*SCALE)
- FCM=SFSH/((F-PQ1)*HCL)
- GO TO 230
-C
-C *** Arrive here if KASE=1 (or if 2F0 tried mistakenly & failed)
-C
-C for small values of X, calculate F(X,SL) directly from 1F1
-C using DREAL*16 arithmetic if possible.
-C where Z11 = ZLL if ID>0, or = ZLM if ID<0
-C
- 190 F11V=C309R2(X,ETA,Z11,P11,ACCT,LIMIT,0,ERR,N11,FPMAX,ACC8,ACC16)
- 200 IF(N11 .LT. 0) THEN
-
-C F11 failed from BB = negative integer
-
- IF(LPR) WRITE(6,1060) '-L',ONE
- IFAIL=-1
- GO TO 290
- END IF
-
-C Consider a KASE 2 or 3 calculation :
-
- IF(ERR .GT. PACCQ .AND. PACCQ .LT. ACCB) THEN
- KASE=-2
- IF(AXIAL) KASE=-3
- GO TO 130
- END IF
- RERR=MAX(RERR,ERR)
- IF(ERR .GT. FPMAX) GO TO 370
- IF(ID .LT. 0) CLL=Z11*TLOG-HPI*ETA-WLOGAM(BB)
- 1 +WLOGAM(Z11+ONE+P11*ETA)-P11*SIGMA
- EK=(Z11+ONE)*XLOG-P11*X+CLL-ABS(SCALE)
- IF(ID .GT. 0) EK=EK-FESL+LOG(FCL)
- IF(DREAL(EK) .GT. FPLMAX) GO TO 350
- IF(DREAL(EK) .LT. FPLMIN) GO TO 340
- FCM=F11V*EXP(EK)
- IF(KASE .GE. 5) THEN
- IF(ABSC(ZLM+ZLM-NINTC(ZLM+ZLM)) .LT. ACCH) KASE=6
-C
-C *** For abs(X) < XNEAR, then CF2 may not converge accurately, so
-C *** use an expansion for irregular soln from origin :
-C
- SL=ZLM
- ZLNEG=DREAL(ZLM) .LT. -ONE+ACCB
- IF(KASE .EQ. 5 .OR. ZLNEG) SL=-ZLM-ONE
- PK=SL+ONE
- AA=PK-ETAP
- AB=PK+ETAP
- BB=TWO*PK
- CLGAA=WLOGAM(AA)
- CLGAB=CLGAA
- IF(ETANE0) CLGAB=WLOGAM(AB)
- CLGBB=WLOGAM(BB)
- IF(KASE .EQ. 6 .AND. .NOT.ZLNEG) THEN
- IF(NPINT(AA,ACCUR)) CLGAA=CLGAB-TWO*PM*SIGMA
- IF(NPINT(AB,ACCUR)) CLGAB=CLGAA+TWO*PM*SIGMA
- END IF
- CLL=SL*TLOG-HPI*ETA-CLGBB+(CLGAA+CLGAB)*HALF
- DSIG=(CLGAA-CLGAB)*PM*HALF
- IF(KASE .EQ. 6) P11=-PM
- EK=PK*XLOG-P11*X+CLL-ABS(SCALE)
- SF=EXP(-ABS(SCALE))
- CHI=ZERO
- IF(.NOT.(KASE .EQ. 5 .OR. ZLNEG)) GO TO 210
-C
-C *** Use G(l) = (cos(CHI) * F(l) - F(-l-1)) / sin(CHI)
-C
-C where CHI = sig(l) - sig(-l-1) - (2l+1)*pi/2
-C
- CHI=SIGMA-DSIG-(ZLM-SL)*HPI
- F11V=C309R2(X,ETA,SL,P11,ACCT,LIMIT,0,ERR,NPQ(1),
- 1 FPMAX,ACC8,ACC16)
- RERR=MAX(RERR,ERR)
- IF(KASE .EQ. 6) GO TO 210
- FESL=F11V*EXP(EK)
- FCL1=EXP(PM*CHI)*FCM
- HCL=FCL1-FESL
- RERR=MAX(RERR,ACCT*MAX(ABSC(FCL1),ABSC(FESL))/ABSC(HCL))
- HCL=HCL/SIN(CHI)*(SFSH/(SF*SF))
- GO TO 220
-C
-C *** Use the logarithmic expansion for the irregular solution (KASE 6)
-C for the case that BB is integral so sin(CHI) would be zero.
-C
- 210 RL=BB-ONE
- N=NINTC(RL)
- ZLOG=XLOG+TLOG-PM*HPI
- CHI=CHI+PM*THETAM+OMEGA*SCALE+AB*ZLOG
- AA=ONE-AA
- IF(NPINT(AA,ACCUR)) THEN
- HCL=ZERO
- ELSE
- IF(ID .GT. 0 .AND. .NOT.ZLNEG) F11V=FCM*EXP(-EK)
- HCL=EXP(CHI-CLGBB-WLOGAM(AA))*(-1)**(N+1)*(F11V*ZLOG+
- 1 C309R2(X,ETA,SL,-PM,ACCT,LIMIT,2,ERR,NPQ(2),FPMAX,ACC8,ACC16))
- RERR=MAX(RERR,ERR)
- END IF
- IF(N .GT. 0) THEN
- EK=CHI+WLOGAM(RL)-CLGAB-RL*ZLOG
- DF=C309R2(X,ETA,-SL-ONE,-PM,ZERO,N,0,ERR,L,FPMAX,ACC8,ACC16)
- HCL=HCL+EXP(EK)*DF
- END IF
- RERR=MAX(RERR,TWO*ABS(BB-NINTC(BB)))
- 220 PQ1=F-SFSH/(FCM*HCL)
- ELSE
- IF(MODE .LE. 2) HCL=SFSH/((F-PQ1)*FCM)
- KASE=1
- END IF
-C
-C *** Now have absolute normalisations for Coulomb Functions
-C FCM & HCL at lambda = ZLM
-C so determine linear transformations for Functions required :
-C
- 230 IH=ABS(MODE1)/10
- IF(KFN .EQ. 3) IH=(3-DIMAG(CIK))/2+HALF
- P11=ONE
- IF(IH .EQ. 1) P11=CI
- IF(IH .EQ. 2) P11=-CI
- DF=-PM
- IF(IH .GE. 1) DF=-PM+P11
- IF(ABSC(DF) .LT. ACCH) DF=ZERO
-C
-C *** Normalisations for spherical or cylindrical Bessel functions
-C
- IF(KFN .LE. 0) THEN
- ALFA=ZERO
- BETA=ONE
- ELSE IF(KFN .EQ. 1) THEN
- ALFA=XI
- BETA=XI
- ELSE
- ALFA=XI*HALF
- BETA=SQRT(XI/HPI)
- IF(DREAL(BETA) .LT. ZERO) BETA=-BETA
- END IF
- AA=ONE
- IF(KFN .GT. 0) AA=-P11*BETA
-
-C Calculate rescaling factors for I & K output
-
- IF(KFN .GE. 3) THEN
- P=EXP((ZLM+DELL)*HPI*CIK)
- AA=BETA*HPI*P
- BETA=BETA/P
- Q=CIK*ID
- END IF
-
-C Calculate rescaling factors for GC output
-
- IF(IH .EQ. 0) THEN
- TA=ABS(SCALE)+DIMAG(PM)*SCALE
- RK=ZERO
- IF(TA .LT. FPLMAX) RK=EXP(-TA)
- ELSE
- TA=ABS(SCALE)+DIMAG(P11)*SCALE
- IF(ABSC(DF) .GT. ACCH .AND. TA .GT. FPLMAX) GO TO 320
- IF(ABSC(DF) .GT. ACCH) DF=DF*EXP(TA)
- SF=TWO*(LH-IH)*SCALE
- RK=ZERO
- IF(SF .GT. FPLMAX) GO TO 320
- IF(SF .GT. FPLMIN) RK=EXP(SF)
- END IF
- KAS((3-ID)/2)=KASE
- W=FCM/FCL
- IF(LOG(ABSC(W))+LOG(ABSC(FC(LF))) .LT. FPLMIN) GO TO 340
- IF(MODE .GE. 3) GO TO 240
- IF(LPR .AND. ABSC(F-PQ1) .LT. ACCH*ABSC(F))
- 1 WRITE(6,1020) LH,ZLM+DELL
- HPL=HCL*PQ1
- IF(ABSC(HPL) .LT. FPMIN .OR. ABSC(HCL) .LT. FPMIN) GO TO 330
-C
-C *** IDward recurrence from HCL,HPL(LF) (stored GC(L) is RL if reqd)
-C *** renormalise FC,FCP at each lambda
-C *** ZL = ZLM - MIN(ID,0) here
-C
- 240 DO 270 L = LF,L1,ID
- FCL=W*FC(L)
- IF(ABSC(FCL) .LT. FPMIN) GO TO 340
- IF(IFCP) FPL=W*FCP(L)
- FC(L)=BETA*FCL
- IF(IFCP) FCP(L)=BETA*(FPL-ALFA*FCL)*CIK
- FC(L)=C309R8(FC(L),ACCUR)
- IF(IFCP) FCP(L)=C309R8(FCP(L),ACCUR)
- IF(MODE .GE. 3) GO TO 260
- IF(L .EQ. LF) GO TO 250
- ZL=ZL+ID
- ZID=ZL*ID
- RL=GC(L)
- IF(ETANE0) THEN
- SL=ETA+ZL*ZL*XI
- IF(MODE .EQ. 1) THEN
- PL=GCP(L)
- ELSE
- PL=ZERO
- IF(ABSC(ZL) .GT. ACCH) PL=(SL*SL-RL*RL)/ZID
- END IF
- HCL1=(SL*HCL-ZID*HPL)/RL
- HPL=(SL*HPL-PL*HCL)/RL
- ELSE
- HCL1=RL*HCL-HPL*ID
- HPL=(HCL-RL*HCL1)*ID
- END IF
- HCL=HCL1
- IF(ABSC(HCL) .GT. FPMAX) GO TO 320
- 250 GC(L)=AA*(RK*HCL+DF*FCL)
- IF(MODE .EQ. 1) GCP(L)=(AA*(RK*HPL+DF*FPL)-ALFA*GC(L))*CIK
- GC(L)=C309R8(GC(L),ACCUR)
- IF(MODE .EQ. 1) GCP(L)=C309R8(GCP(L),ACCUR)
- IF(KFN .GE. 3) AA=AA*Q
- 260 IF(KFN .GE. 3) BETA=-BETA*Q
- 270 LAST=MIN(LAST,(L1-L)*ID)
- GO TO 280
-C
-C *** Come here after all soft errors to determine how many L values ok
-C
- 310 IF(LPR) WRITE(6,1000) ZZ
- GO TO 999
- 320 IF(LPR) WRITE(6,1010) ZL+DELL,'IR',HCL,'>',FPMAX
- GO TO 280
- 330 IF(LPR) WRITE(6,1010) ZL+DELL,'IR',HCL,'<',FPMIN
- GO TO 280
- 340 IF(LPR) WRITE(6,1010) ZL+DELL,' ',FCL,'<',FPMIN
- GO TO 280
- 350 IF(LPR) WRITE(6,1010) ZL+DELL,' ',FCL,'>',FPMAX
- GO TO 280
- 360 IF(LPR) WRITE(6,1030) ZL+DELL
- GO TO 280
- 370 IF(LPR) WRITE(6,1040) Z11,I
- IFAIL=-1
- GO TO 290
- 380 IF(LPR) WRITE(6,1050) ZLMIN,ZLM,ZLM+ONE,ZLMIN+NL
- IFAIL=-1
- GO TO 290
- 280 IF(ID .GT. 0 .OR. LAST .EQ. 0) IFAIL=LAST
- IF(ID .LT. 0 .AND. LAST .NE. 0) IFAIL=-3
-C
-C *** Come here after ALL errors for this L range (ZLM,ZLL)
-C
-C *** so on first block, 'F' started decreasing monotonically,
-C or hit bound states for low ZL.
-C thus redo M1 to LF-1 in reverse direction, i.e. do
-C CF1A at ZLMIN & CF2 at ZLM (midway between ZLMIN & ZLMAX)
-C
- 290 IF(ID .GT. 0 .AND. LF .NE. M1) THEN
- ID=-1
- IF(.NOT.UNSTAB) LF=LF-1
- DONEM=UNSTAB
- LF=MIN(LF,L1)
- L1=M1
- GO TO 10
- END IF
- IF(IFAIL .LT. 0) GO TO 999
- IF(LPR .AND. RERR .GT. ACCB) WRITE(6,1070) RERR
- IF(RERR .GT. 0.1D0) IFAIL=-4
- 999 DO 998 L = 1,NL+1
- FC(L-1)=FC(L)
- GC(L-1)=GC(L)
- FCP(L-1)=FCP(L)
- GCP(L-1)=GCP(L)
- 998 SIG(L-1)=SIG(L)
- RETURN
-C
- 1000 FORMAT(1X,'***** CERN C309 WCLBES ... ',
- 1 'CANNOT CALCULATE IRREGULAR SOLUTIONS FOR X =',
- 2 1P,2D10.2,' ABS(X) TOO SMALL')
- 1010 FORMAT(1X,'***** CERN C309 WCLBES ... ',
- 1 'AT ZL =',2F8.3,' ',A2,'REGULAR SOLUTION (',1P,2E10.1,') ',
- 2 A1,E10.1)
- 1020 FORMAT(1X,'***** CERN C309 WCLBES ... ',
- 1 'WARNING: LINEAR INDEPENDENCE BETWEEN ''F'' AND ''H(',I1,
- 2 ')'' IS LOST AT ZL = ',2F7.2/1X,'*****',22X,'(EG. COULOMB ',
- 3 'EIGENSTATE OR CF1 UNSTABLE)')
- 1030 FORMAT(1X,'***** CERN C309 WCLBES ... ',
- 2 '(ETA & L)/X TOO LARGE FOR CF1A, AND CF1 UNSTABLE AT L = ',2F8.2)
- 1040 FORMAT(1X,'***** CERN C309 WCLBES ... ',
- 1 'OVERFLOW IN 1F1 SERIES AT ZL = ',2F8.3,' AT TERM',I5)
- 1050 FORMAT(1X,'***** CERN C309 WCLBES ... ',
- 1 'BOTH BOUND-STATE POLES AND F-INSTABILITIES OCCUR OR MULTIPLE',
- 2 ' INSTABILITIES PRESENT'/
- 3 1X,'*****',22X,'TRY CALLING TWICE, 1ST FOR ZL FROM',2F8.3,
- 4 ' TO',2F8.3,' (INCL)'/1X,'*****',41X,'2ND FOR ZL FROM',2F8.3,
- 5 ' TO',2F8.3)
- 1060 FORMAT(1X,'***** CERN C309 WCLBES ... ',
- 1 'WARNING: AS ''',A2,''' REFLECTION RULES NOT USED ',
- 2 'ERRORS CAN BE UP TO',1PD12.2)
- 1070 FORMAT(1X,'***** CERN C309 WCLBES ... ',
- 1 'WARNING: OVERALL ROUNDOFF ERROR APPROXIMATELY',1PE11.1)
- END
-#endif
diff --git a/src/mathlib/gen/c/welfun128.F b/src/mathlib/gen/c/welfun128.F
deleted file mode 100644
index 85d8718..0000000
--- a/src/mathlib/gen/c/welfun128.F
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: welfun128.F,v 1.1.1.1 1996/04/01 15:02:01 mclareni Exp $
-*
-* $Log: welfun128.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:01 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if !defined(CERNLIB_DOUBLE)
- SUBROUTINE WELFUN(W,AK2,SN,CN,DN)
-C
-#include "gen/imp128.inc"
- CHARACTER*(*) NAME
- PARAMETER(NAME='WELFUN')
-C
- CALL MTLPRT(NAME,'C320.0','Not available on this machine')
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/c/wpsipg.F b/src/mathlib/gen/c/wpsipg.F
deleted file mode 100644
index eeaaab0..0000000
--- a/src/mathlib/gen/c/wpsipg.F
+++ /dev/null
@@ -1,126 +0,0 @@
-*
-* $Id: wpsipg.F,v 1.2 2006/09/15 09:34:53 mclareni Exp $
-*
-* $Log: wpsipg.F,v $
-* Revision 1.2 2006/09/15 09:34:53 mclareni
-* Submitted mods for gcc4/gfortran and MacOSX, corrected to work also on slc4 with gcc3.4 and 4.1
-*
-* Revision 1.1.1.1 1996/04/01 15:02:01 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- FUNCTION WPSIPG(Z,K)
-
- IMPLICIT DOUBLE PRECISION (A-H,O-Z)
- COMPLEX*16 WPSIPG,Z,U,V,H,R,P,GCMPLX
- CHARACTER NAME*(*)
- CHARACTER*80 ERRTXT
- PARAMETER (NAME = 'CPSIPG/WPSIPG')
- DIMENSION C(6,0:4),FCT(-1:4),SGN(0:4)
-
- PARAMETER (DELTA = 5D-13)
- PARAMETER (R1 = 1, HF = R1/2)
- PARAMETER (PI = 3.14159 26535 89793 24D0)
- PARAMETER (C1 = PI**2, C2 = 2*PI**3, C3 = 2*PI**4, C4 = 8*PI**5)
-
- DATA SGN /-1,+1,-1,+1,-1/, FCT /0,1,1,2,6,24/
-
- DATA C(1,0) / 8.33333 33333 33333 33D-2/
- DATA C(2,0) /-8.33333 33333 33333 33D-3/
- DATA C(3,0) / 3.96825 39682 53968 25D-3/
- DATA C(4,0) /-4.16666 66666 66666 67D-3/
- DATA C(5,0) / 7.57575 75757 57575 76D-3/
- DATA C(6,0) /-2.10927 96092 79609 28D-2/
-
- DATA C(1,1) / 1.66666 66666 66666 67D-1/
- DATA C(2,1) /-3.33333 33333 33333 33D-2/
- DATA C(3,1) / 2.38095 23809 52380 95D-2/
- DATA C(4,1) /-3.33333 33333 33333 33D-2/
- DATA C(5,1) / 7.57575 75757 57575 76D-2/
- DATA C(6,1) /-2.53113 55311 35531 14D-1/
-
- DATA C(1,2) / 5.00000 00000 00000 00D-1/
- DATA C(2,2) /-1.66666 66666 66666 67D-1/
- DATA C(3,2) / 1.66666 66666 66666 67D-1/
- DATA C(4,2) /-3.00000 00000 00000 00D-1/
- DATA C(5,2) / 8.33333 33333 33333 33D-1/
- DATA C(6,2) /-3.29047 61904 76190 48D+0/
-
- DATA C(1,3) / 2.00000 00000 00000 00D+0/
- DATA C(2,3) /-1.00000 00000 00000 00D+0/
- DATA C(3,3) / 1.33333 33333 33333 33D+0/
- DATA C(4,3) /-3.00000 00000 00000 00D+0/
- DATA C(5,3) / 1.00000 00000 00000 00D+1/
- DATA C(6,3) /-4.60666 66666 66666 67D+1/
-
- DATA (C(I,4),I=1,6) / 10, -7, 12, -33, 130, -691/
-
- GCMPLX(X,Y)=DCMPLX(X,Y)
-
- U=Z
- X=U
- A=ABS(X)
- IF(K .LT. 0 .OR. K .GT. 4) THEN
- H=0
- WRITE(ERRTXT,101) K
- CALL MTLPRT(NAME,'C317.1',ERRTXT)
-#if !defined(CERNLIB_GFORTRAN)
- ELSEIF(ABS(IMAG(U)) .LT. DELTA .AND. ABS(X+NINT(A)) .LT. DELTA)
-#else
- ELSEIF(ABS(AIMAG(U)) .LT. DELTA .AND. ABS(X+NINT(A)) .LT. DELTA)
-#endif
- 1 THEN
- H=0
- WRITE(ERRTXT,102) X
- CALL MTLPRT(NAME,'C317.2',ERRTXT)
- ELSE
- K1=K+1
- IF(X .LT. 0) U=-U
- V=U
- H=0
- IF(A .LT. 15) THEN
- H=1/V**K1
- DO 1 I = 1,14-INT(A)
- V=V+1
- 1 H=H+1/V**K1
- V=V+1
- END IF
- R=1/V**2
- P=R*C(6,K)
- DO 2 I = 5,1,-1
- 2 P=R*(C(I,K)+P)
- H=SGN(K)*(FCT(K)*H+(V*(FCT(K-1)+P)+HF*FCT(K))/V**K1)
- IF(K .EQ. 0) H=H+LOG(V)
- IF(X .LT. 0) THEN
- V=PI*U
- X=V
-#if !defined(CERNLIB_GFORTRAN)
- Y=IMAG(V)
-#else
- Y=AIMAG(V)
-#endif
- A=SIN(X)
- B=COS(X)
- T=TANH(Y)
- P=GCMPLX(B,-A*T)/GCMPLX(A,B*T)
- IF(K .EQ. 0) THEN
- H=H+1/U+PI*P
- ELSEIF(K .EQ. 1) THEN
- H=-H+1/U**2+C1*(P**2+1)
- ELSEIF(K .EQ. 2) THEN
- H=H+2/U**3+C2*P*(P**2+1)
- ELSEIF(K .EQ. 3) THEN
- R=P**2
- H=-H+6/U**4+C3*((3*R+4)*R+1)
- ELSEIF(K .EQ. 4) THEN
- R=P**2
- H=H+24/U**5+C4*P*((3*R+5)*R+2)
- ENDIF
- ENDIF
- ENDIF
- WPSIPG=H
- RETURN
- 101 FORMAT('K = ',I5,' (< 0 OR > 4)')
- 102 FORMAT('ARGUMENT EQUALS NON-POSITIVE INTEGER = ',F8.1)
- END
diff --git a/src/mathlib/gen/c/zerox128.F b/src/mathlib/gen/c/zerox128.F
deleted file mode 100644
index 312e7aa..0000000
--- a/src/mathlib/gen/c/zerox128.F
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: zerox128.F,v 1.1.1.1 1996/04/01 15:01:51 mclareni Exp $
-*
-* $Log: zerox128.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:51 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if !defined(CERNLIB_DOUBLE)
- SUBROUTINE DZEROX(A0,B0,EPS,MAXF,F,MODE)
-C
-#include "gen/imp128.inc"
-C
- CHARACTER NAME*(*)
- PARAMETER (NAME = 'DZEROX')
- CALL MTLPRT(NAME,'C200.0','Not available on this machine')
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/c/zerox64.F b/src/mathlib/gen/c/zerox64.F
deleted file mode 100644
index 4e46c29..0000000
--- a/src/mathlib/gen/c/zerox64.F
+++ /dev/null
@@ -1,138 +0,0 @@
-*
-* $Id: zerox64.F,v 1.1.1.1 1996/04/01 15:01:51 mclareni Exp $
-*
-* $Log: zerox64.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:51 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- FUNCTION DZEROX(A0,B0,EPS,MAXF,F,MODE)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION RZEROX(A0,B0,EPS,MAXF,F,MODE)
-#endif
-C Based on
-C
-C J.C.P. Bus and T.J. Dekker, Two Efficient Algorithms with
-C Guaranteed Convergence for Finding a Zero of a Function,
-C ACM Trans. Math. Software 1 (1975) 330-345.
-C
-C (MODE = 1: Algorithm M; MODE = 2: Algorithm R)
-#include "gen/imp64.inc"
- CHARACTER NAME*(*)
- CHARACTER*80 ERRTXT
-#if defined(CERNLIB_DOUBLE)
- PARAMETER (NAME = 'DZEROX')
-#endif
-#if !defined(CERNLIB_DOUBLE)
- PARAMETER (NAME = 'RZEROX')
-#endif
- LOGICAL LMT
-
- DIMENSION IM1(2),IM2(2),LMT(2)
-
- PARAMETER (Z1 = 1, HALF = Z1/2)
-
- DATA IM1 /2,3/, IM2 /-1,3/
-
- IF(MODE .NE. 1 .AND. MODE .NE. 2) THEN
- C=0
- WRITE(ERRTXT,101) MODE
- CALL MTLPRT(NAME,'C200.1',ERRTXT)
- GO TO 99
- ENDIF
- FA=F(B0)
- FB=F(A0)
- IF(FA*FB .GT. 0) THEN
- C=0
- WRITE(ERRTXT,102) A0,B0
- CALL MTLPRT(NAME,'C200.2',ERRTXT)
- GO TO 99
- ENDIF
- ATL=ABS(EPS)
- B=A0
- A=B0
- LMT(2)=.TRUE.
- MF=2
- 1 C=A
- FC=FA
- 2 IE=0
- 3 IF(ABS(FC) .LT. ABS(FB)) THEN
- IF(C .NE. A) THEN
- D=A
- FD=FA
- END IF
- A=B
- B=C
- C=A
- FA=FB
- FB=FC
- FC=FA
- END IF
- TOL=ATL*(1+ABS(C))
- H=HALF*(C+B)
- HB=H-B
- IF(ABS(HB) .GT. TOL) THEN
- IF(IE .GT. IM1(MODE)) THEN
- W=HB
- ELSE
- TOL=TOL*SIGN(Z1,HB)
- P=(B-A)*FB
- LMT(1)=IE .LE. 1
- IF(LMT(MODE)) THEN
- Q=FA-FB
- LMT(2)=.FALSE.
- ELSE
- FDB=(FD-FB)/(D-B)
- FDA=(FD-FA)/(D-A)
- P=FDA*P
- Q=FDB*FA-FDA*FB
- END IF
- IF(P .LT. 0) THEN
- P=-P
- Q=-Q
- END IF
- IF(IE .EQ. IM2(MODE)) P=P+P
- IF(P .EQ. 0 .OR. P .LE. Q*TOL) THEN
- W=TOL
- ELSEIF(P .LT. HB*Q) THEN
- W=P/Q
- ELSE
- W=HB
- END IF
- END IF
- D=A
- A=B
- FD=FA
- FA=FB
- B=B+W
- MF=MF+1
- IF(MF .GT. MAXF) THEN
- CALL MTLPRT(NAME,'C200.3','TOO MANY FUNCTION CALLS')
- GO TO 99
- ENDIF
- FB=F(B)
- IF(FB .EQ. 0 .OR. SIGN(Z1,FC) .EQ. SIGN(Z1,FB)) GO TO 1
- IF(W .EQ. HB) GO TO 2
- IE=IE+1
- GO TO 3
- END IF
-#if defined(CERNLIB_DOUBLE)
- DZEROX=C
-#endif
-#if !defined(CERNLIB_DOUBLE)
- RZEROX=C
-#endif
- 99 CONTINUE
- RETURN
- 101 FORMAT('MODE = ',I3,' ILLEGAL')
- 102 FORMAT('F(A) AND F(B) HAVE THE SAME SIGN, A = ',1P,D15.8,
- 1 ', B = ',D15.8)
- END
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION ZEROX(A0,B0,EPS,MAXF,F,MODE)
- ZEROX=RZEROX(A0,B0,EPS,MAXF,F,MODE)
- END
-#endif
diff --git a/src/mathlib/gen/d/Imakefile b/src/mathlib/gen/d/Imakefile
deleted file mode 100644
index c65e6a5..0000000
--- a/src/mathlib/gen/d/Imakefile
+++ /dev/null
@@ -1,42 +0,0 @@
-DoIncludePackage(gen)
-#include "pilot.h"
-
-SRCS_F= arithm.F c128.F c256.F c512.F c64.F cauchy64.F cft.F cfstft.F \ @@\
- rfstft.F cgauss.F d107d1.F d107r1.F d501l1.F d501l2.F d501n1.F \ @@\
- d501n2.F d501p1.F d501p2.F d501sf.F d700su.F d701bd.F \ @@\
- dadapt.F deqbs64.F deqmr64.F deriv64.F dfunft.F dgs56p.F \ @@\
- dmaxlk.F dsumsq.F elanal.F elpahy.F epdbps.F epdchk.F \ @@\
- epdchn.F epdcj.F epde1.F epdecc.F epdfix.F epdin.F \ @@\
- epditr.F epdje.F epdloc.F epdsrt.F epdtab.F errorf.F esolve.F \ @@\
- fcn1.F fftrc.F fumili.F gauss.F i128.F i32.F i64.F linsq.F \ @@\
- mconv.F mft.F minfc.F minsq.F monito.F newro.F old506.F radapt.F \ @@\
- radmul.F rca.F rfrdh164.F rfrdh264.F rft.F rgmlt64.F rgquad.F \ @@\
- rgs56p.F rgset.F riwiad.F riwibd.F rknys64.F rknysd.F rkstp.F \ @@\
- rpa.F rps.F rrkstp.F rsa.F rtriint.F s128.F s256.F s512.F \ @@\
- s64.F scal.F sgz.F simps.F synt.F traper.F triint.F vd01a.F
-
-#if defined(CERNLIB_DOUBLE)
-SRCS_F:= $(SRCS_F) cgauss64.F dgquad.F dgset.F gauss64.F minfc64.F \ @@\
- rcauch.F rdeqbs.F rdeqmr.F rderiv.F rfrdh1.F rgmlt.F rkstp64.F \ @@\
- simps64.F triint64.F
-#else
-SRCS_F:= $(SRCS_F) cgauss128.F cauchy.F cauchy128.F deqbs128.F deqmr128.F \ @@\
- deriv128.F minfc128.F rfrdh128.F rgmlt128.F rkstp128.F simps128.F \ @@\
- triint128.F
-#endif
-
-#if defined(CERNLIB_QUAD)
-SRCS_F:= $(SRCS_F) gauss128.F
-#endif
-
-#ifdef CERNLIB_HPUX
-FORTRANOPTIONS += -WF,-P
-#endif
-
-#if defined(CERNLIB_SGI)
-IMAKE_DEFINES=-DFortranDoesCpp=NO
-#endif
-
-FORTRANSAVEOPTION = FortranSaveFlags
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/mathlib/gen/d/arithm.F b/src/mathlib/gen/d/arithm.F
deleted file mode 100644
index 8f6b84d..0000000
--- a/src/mathlib/gen/d/arithm.F
+++ /dev/null
@@ -1,38 +0,0 @@
-*
-* $Id: arithm.F,v 1.1.1.1 1996/04/01 15:02:21 mclareni Exp $
-*
-* $Log: arithm.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:21 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE ARITHM (Y)
-C-----ARITHM SETS Y AND CALCULATES DY/DA
-#include "d510si.inc"
-#include "d510ui.inc"
-C-----10.*MAXIMUM RELATIVE PRECISION ON CDC 6000
- DATA RP/1.E-14/
- Y=FUNCT(X)
- DO 6 I=1,NA
- DF(I)=0.
- IF (PL0(I)) 6,6,1
- 1 AI=A(I)
- HI=0.01*PL0(I)
- PI=RP*ABS(AI)
- IF (HI.LE.PI) HI=PI
- A(I)=AI+HI
- IF (A(I)-AMX(I)) 5,5,2
- 2 A(I)=AI-HI
- HI=-HI
- IF (A(I)-AMN(I)) 3,5,5
- 3 A(I)=AMX(I)
- HI=AMX(I)-AI
- IF (AMN(I)-AI+HI) 4,5,5
- 4 A(I)=AMN(I)
- HI=AMN(I)-AI
- 5 DF(I)=(FUNCT(X)-Y)/HI
- A(I)=AI
- 6 CONTINUE
- RETURN
- END
diff --git a/src/mathlib/gen/d/c128.F b/src/mathlib/gen/d/c128.F
deleted file mode 100644
index 074d0ee..0000000
--- a/src/mathlib/gen/d/c128.F
+++ /dev/null
@@ -1,46 +0,0 @@
-*
-* $Id: c128.F,v 1.1.1.1 1996/04/01 15:02:22 mclareni Exp $
-*
-* $Log: c128.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:22 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE C128(A,B)
- REAL A(65),B(65),C(64)
- COMMON /TAB/D(126),E(127)
- CALL D701BD
- S2 = A(32)+A(34)
- DO 10 I=3,31,2
- S2 = S2+A(I-1)+A(67-I)
- A1 = A(I+1)-A(I-1)
- A2 = A(67-I)-A(65-I)
- C1R = A(I)+A(66-I)
- C2R = A(I)-A(66-I)
- C1I = A1-A2
- C2I = A1+A2
- C1 = -D(4*I-5)
- C2 = D(4*I-4)
- C3R = C1*C2R-C2*C2I
- C3I = C1*C2I+C2*C2R
- C(I) = C1R+C3R
- C(I+1) = C1I+C3I
- C(66-I) = C1R-C3R
- 10 C(67-I) = C3I-C1I
- C(1) = A(1)+A(65)
- C(2) = A(1)-A(65)
- C(33) = 2.*A(33)
- C(34) = 2.*(A(32)-A(34))
- CALL D32(C,C(2),2,C,C(2),2)
- S2 = 2.*S2
- B(1) = C(1)+S2
- B(65) = C(1)-S2
- B(33) = C(33)
- DO 20 I=2,32
- E1 = 0.5*(C(I)+C(66-I))
- E2 = E(4*I-4)*(C(I)-C(66-I))
- B(I) = E1+E2
- 20 B(66-I) = E1-E2
- RETURN
- END
diff --git a/src/mathlib/gen/d/c256.F b/src/mathlib/gen/d/c256.F
deleted file mode 100644
index ee41b7c..0000000
--- a/src/mathlib/gen/d/c256.F
+++ /dev/null
@@ -1,46 +0,0 @@
-*
-* $Id: c256.F,v 1.1.1.1 1996/04/01 15:02:23 mclareni Exp $
-*
-* $Log: c256.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:23 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE C256(A,B)
- REAL A(129),B(129),C(128)
- COMMON /TAB/D(126),E(127)
- CALL D701BD
- S2 = A(64)+A(66)
- DO 10 I=3,63,2
- S2 = S2+A(I-1)+A(131-I)
- A1 = A(I+1)-A(I-1)
- A2 = A(131-I)-A(129-I)
- C1R = A(I)+A(130-I)
- C2R = A(I)-A(130-I)
- C1I = A1-A2
- C2I = A1+A2
- C1 = -D(2*I-3)
- C2 = D(2*I-2)
- C3R = C1*C2R-C2*C2I
- C3I = C1*C2I+C2*C2R
- C(I) = C1R+C3R
- C(I+1) = C1I+C3I
- C(130-I) = C1R-C3R
- 10 C(131-I) = C3I-C1I
- C(1) = A(1)+A(129)
- C(2) = A(1)-A(129)
- C(65) = 2.*A(65)
- C(66) = 2.*(A(64)-A(66))
- CALL D64(C,C(2),2,C,C(2),2)
- S2 = 2.*S2
- B(1) = C(1)+S2
- B(129) = C(1)-S2
- B(65) = C(65)
- DO 20 I=2,64
- E1 = 0.5*(C(I)+C(130-I))
- E2 = E(2*I-2)*(C(I)-C(130-I))
- B(I) = E1+E2
- 20 B(130-I) = E1-E2
- RETURN
- END
diff --git a/src/mathlib/gen/d/c512.F b/src/mathlib/gen/d/c512.F
deleted file mode 100644
index 93d5bae..0000000
--- a/src/mathlib/gen/d/c512.F
+++ /dev/null
@@ -1,46 +0,0 @@
-*
-* $Id: c512.F,v 1.1.1.1 1996/04/01 15:02:23 mclareni Exp $
-*
-* $Log: c512.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:23 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE C512(A,B)
- REAL A(257),B(257),C(256)
- COMMON /TAB/D(126),E(127)
- CALL D701BD
- S2 = A(128)+A(130)
- DO 10 I=3,127,2
- S2 = S2+A(I-1)+A(259-I)
- A1 = A(I+1)-A(I-1)
- A2 = A(259-I)-A(257-I)
- C1R = A(I)+A(258-I)
- C2R = A(I)-A(258-I)
- C1I = A1-A2
- C2I = A1+A2
- C1 = -D(I-2)
- C2 = D(I-1)
- C3R = C1*C2R-C2*C2I
- C3I = C1*C2I+C2*C2R
- C(I) = C1R+C3R
- C(I+1) = C1I+C3I
- C(258-I) = C1R-C3R
- 10 C(259-I) = C3I-C1I
- C(1) = A(1)+A(257)
- C(2) = A(1)-A(257)
- C(129) = 2.*A(129)
- C(130) = 2.*(A(128)-A(130))
- CALL D128(C,C(2),2,C,C(2),2)
- S2 = 2.*S2
- B(1) = C(1)+S2
- B(257) = C(1)-S2
- B(129) = C(129)
- DO 20 I=2,128
- E1 = 0.5*(C(I)+C(258-I))
- E2 = E(I-1)*(C(I)-C(258-I))
- B(I) = E1+E2
- 20 B(258-I) = E1-E2
- RETURN
- END
diff --git a/src/mathlib/gen/d/c64.F b/src/mathlib/gen/d/c64.F
deleted file mode 100644
index 3f4eaa8..0000000
--- a/src/mathlib/gen/d/c64.F
+++ /dev/null
@@ -1,46 +0,0 @@
-*
-* $Id: c64.F,v 1.1.1.1 1996/04/01 15:02:23 mclareni Exp $
-*
-* $Log: c64.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:23 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE C64(A,B)
- REAL A(33),B(33),C(32)
- COMMON /TAB/D(126),E(127)
- CALL D701BD
- S2 = A(16)+A(18)
- DO 10 I=3,15,2
- S2 = S2+A(I-1)+A(35-I)
- A1 = A(I+1)-A(I-1)
- A2 = A(35-I)-A(33-I)
- C1R = A(I)+A(34-I)
- C2R = A(I)-A(34-I)
- C1I = A1-A2
- C2I = A1+A2
- C1 = -D(8*I-9)
- C2 = D(8*I-8)
- C3R = C1*C2R-C2*C2I
- C3I = C1*C2I+C2*C2R
- C(I) = C1R+C3R
- C(I+1) = C1I+C3I
- C(34-I) = C1R-C3R
- 10 C(35-I) = C3I-C1I
- C(1) = A(1)+A(33)
- C(2) = A(1)-A(33)
- C(17) = 2.*A(17)
- C(18) = 2.*(A(16)-A(18))
- CALL D16(C,C(2),2,C,C(2),2)
- S2 = 2.*S2
- B(1) = C(1)+S2
- B(33) = C(1)-S2
- B(17) = C(17)
- DO 20 I=2,16
- E1 = 0.5*(C(I)+C(34-I))
- E2 = E(8*I-8)*(C(I)-C(34-I))
- B(I) = E1+E2
- 20 B(34-I) = E1-E2
- RETURN
- END
diff --git a/src/mathlib/gen/d/cauchy.F b/src/mathlib/gen/d/cauchy.F
deleted file mode 100644
index a0fec2e..0000000
--- a/src/mathlib/gen/d/cauchy.F
+++ /dev/null
@@ -1,15 +0,0 @@
-*
-* $Id: cauchy.F,v 1.1.1.1 1996/04/01 15:02:13 mclareni Exp $
-*
-* $Log: cauchy.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:13 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION CAUCHY(F,A,B,S,EPS)
- CAUCHY=RCAUCH(F,A,B,S,EPS)
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/d/cauchy128.F b/src/mathlib/gen/d/cauchy128.F
deleted file mode 100644
index 69c96a1..0000000
--- a/src/mathlib/gen/d/cauchy128.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: cauchy128.F,v 1.1.1.1 1996/04/01 15:02:14 mclareni Exp $
-*
-* $Log: cauchy128.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:14 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION DCAUCH(F,A,B,S,EPS)
-C
-#include "gen/imp128.inc"
-C
- CHARACTER NAME*(*)
- PARAMETER (NAME = 'DCAUCH')
- DCAUCH=0
- CALL MTLPRT(NAME,'D104.0','Not available on this machine')
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/d/cauchy64.F b/src/mathlib/gen/d/cauchy64.F
deleted file mode 100644
index fb35b60..0000000
--- a/src/mathlib/gen/d/cauchy64.F
+++ /dev/null
@@ -1,109 +0,0 @@
-*
-* $Id: cauchy64.F,v 1.1.1.1 1996/04/01 15:02:14 mclareni Exp $
-*
-* $Log: cauchy64.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:14 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- FUNCTION DCAUCH(F,A,B,S,EPS)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION RCAUCH(F,A,B,S,EPS)
-#endif
-#include "gen/imp64.inc"
- CHARACTER NAME*(*)
- CHARACTER*80 ERRTXT
-#if defined(CERNLIB_DOUBLE)
- PARAMETER (NAME = 'DCAUCH')
-#endif
-#if !defined(CERNLIB_DOUBLE)
- PARAMETER (NAME = 'RCAUCH')
-#endif
- EXTERNAL F
-
- DIMENSION X(12),W(12)
-
- PARAMETER (Z1 = 1, HF = Z1/2, CST = 5*Z1/1000)
-
- DATA X( 1) /9.6028985649753623D-1/, W( 1) /1.0122853629037626D-1/
- DATA X( 2) /7.9666647741362674D-1/, W( 2) /2.2238103445337447D-1/
- DATA X( 3) /5.2553240991632899D-1/, W( 3) /3.1370664587788729D-1/
- DATA X( 4) /1.8343464249564980D-1/, W( 4) /3.6268378337836198D-1/
- DATA X( 5) /9.8940093499164993D-1/, W( 5) /2.7152459411754095D-2/
- DATA X( 6) /9.4457502307323258D-1/, W( 6) /6.2253523938647893D-2/
- DATA X( 7) /8.6563120238783174D-1/, W( 7) /9.5158511682492785D-2/
- DATA X( 8) /7.5540440835500303D-1/, W( 8) /1.2462897125553387D-1/
- DATA X( 9) /6.1787624440264375D-1/, W( 9) /1.4959598881657673D-1/
- DATA X(10) /4.5801677765722739D-1/, W(10) /1.6915651939500254D-1/
- DATA X(11) /2.8160355077925891D-1/, W(11) /1.8260341504492359D-1/
- DATA X(12) /9.5012509837637440D-2/, W(12) /1.8945061045506850D-1/
-
- IF(S .EQ. A .OR. S .EQ. B) THEN
- H=0
- WRITE(ERRTXT,101) S
- CALL MTLPRT(NAME,'D104.1',ERRTXT)
- ELSEIF(S .LT. MIN(A,B) .OR. S .GT. MAX(A,B)) THEN
-#if defined(CERNLIB_DOUBLE)
- H=DGAUSS(F,A,B,EPS)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- H= GAUSS(F,A,B,EPS)
-#endif
- ELSE
- IF(2*S .LE. A+B) THEN
-#if defined(CERNLIB_DOUBLE)
- H=DGAUSS(F,2*S-A,B,EPS)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- H= GAUSS(F,2*S-A,B,EPS)
-#endif
- B0=S-A
- ELSE
-#if defined(CERNLIB_DOUBLE)
- H=DGAUSS(F,A,2*S-B,EPS)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- H= GAUSS(F,A,2*S-B,EPS)
-#endif
- B0=B-S
- ENDIF
- C=CST/B0
- BB=0
-
- 1 AA=BB
- BB=B0
- 2 C1=HF*(BB+AA)
- C2=HF*(BB-AA)
- C3=S+C1
- C4=S-C1
- S8=0
- DO 3 I = 1,4
- U=C2*X(I)
- 3 S8=S8+W(I)*((F(C3+U)+F(C4-U))+(F(C3-U)+F(C4+U)))
- S8=C2*S8
- S16=0
- DO 4 I = 5,12
- U=C2*X(I)
- 4 S16=S16+W(I)*((F(C3+U)+F(C4-U))+(F(C3-U)+F(C4+U)))
- S16=C2*S16
- IF(ABS(S16-S8) .LE. EPS*(1+ABS(S16))) GO TO 5
- BB=C1
- IF(1+ABS(C*C2) .NE. 1) GO TO 2
- H=0
- CALL MTLPRT(NAME,'D104.2','TOO HIGH ACCURACY REQUIRED')
- GO TO 9
- 5 H=H+S16
- IF(BB .NE. B0) GO TO 1
- END IF
-#if defined(CERNLIB_DOUBLE)
- 9 DCAUCH=H
-#endif
-#if !defined(CERNLIB_DOUBLE)
- 9 RCAUCH=H
-#endif
- RETURN
- 101 FORMAT('SINGULARITY S = ',D15.8,' AT END-POINT OF INTERVAL')
- END
diff --git a/src/mathlib/gen/d/cfstft.F b/src/mathlib/gen/d/cfstft.F
deleted file mode 100644
index b6809e3..0000000
--- a/src/mathlib/gen/d/cfstft.F
+++ /dev/null
@@ -1,70 +0,0 @@
-*
-* $Id: cfstft.F,v 1.3 2006/09/15 09:34:54 mclareni Exp $
-*
-* $Log: cfstft.F,v $
-* Revision 1.3 2006/09/15 09:34:54 mclareni
-* Submitted mods for gcc4/gfortran and MacOSX, corrected to work also on slc4 with gcc3.4 and 4.1
-*
-* Revision 1.2 1997/12/15 16:18:42 mclareni
-* Changes for the Portland Group f77 compiler inside cpp define CERNLIB_QFPGF77
-*
-* Revision 1.1 1996/04/16 15:57:01 mclareni
-* The name of cfstft was mistyped and also becomes D706, not 705
-*
-*
-*
- SUBROUTINE CFSTFT(MS,A)
-
- COMPLEX A(0:*),U,W,T
-
- IF(MS .EQ. 0) GO TO 3
- M=ABS(MS)
- N=2**M
- J=0
- DO 7 I = 0,N-2
- IF(I .LT. J) THEN
- T=A(J)
- A(J)=A(I)
- A(I)=T
- ENDIF
- K=N/2
- 6 IF(K .LE. J) THEN
- J=J-K
- K=K/2
- GO TO 6
- ENDIF
- 7 J=J+K
- DO 8 I = 0,N-1,2
- T=A(I+1)
- A(I+1)=A(I)-T
- A(I)=A(I)+T
- 8 CONTINUE
- C=0
- S=SIGN(1,MS)
- LE=2
- DO 2 L = 2,M
- W=CMPLX(C,S)
- U=W
- C=SQRT(0.5*C+0.5)
-#if defined(CERNLIB_QFPGF77) || defined(CERNLIB_GFORTRAN)
- S=AIMAG(W)/(C+C)
-#else
- S=IMAG(W)/(C+C)
-#endif
- LE1=LE
- LE=LE1+LE1
- DO 9 I = 0,N-1,LE
- T=A(I+LE1)
- A(I+LE1)=A(I)-T
- A(I)=A(I)+T
- 9 CONTINUE
- DO 2 J = 2,LE1
- DO 1 I = J-1,N-1,LE
- T=A(I+LE1)*U
- A(I+LE1)=A(I)-T
- A(I)=A(I)+T
- 1 CONTINUE
- U=U*W
- 2 CONTINUE
- 3 RETURN
- END
diff --git a/src/mathlib/gen/d/cft.F b/src/mathlib/gen/d/cft.F
deleted file mode 100644
index 909bc18..0000000
--- a/src/mathlib/gen/d/cft.F
+++ /dev/null
@@ -1,576 +0,0 @@
-*
-* $Id: cft.F,v 1.1.1.1 1996/04/01 15:02:24 mclareni Exp $
-*
-* $Log: cft.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:24 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE CFT(A,B,NTOT,N,NSPAN,ISN)
-C
-C MULTIVARIATE COMPLEX FOURIER TRANSFORM, COMPUTED IN PLACE
-C USING MIXED-RADIX FAST FOURIER TRANSFORM ALGORITHM.
-C BY R. C. SINGLETON, STANFORD RESEARCH INSTITUTE, OCT. 1968
-C ARRAYS A AND B ORIGINALLY HOLD THE REAL AND IMAGINARY
-C COMPONENTS OF THE DATA, AND RETURN THE REAL AND
-C IMAGINARY COMPONENTS OF THE RESULTING FOURIER COEFFICIENTS.
-C MULTIVARIATE DATA IS INDEXED ACCORDING TO THE FORTRAN
-C ARRAY ELEMENT SUCCESSOR FUNCTION, WITHOUT LIMIT
-C ON THE NUMBER OF IMPLIED MULTIPLE SUBSCRIPTS.
-C THE SUBROUTINE IS CALLED ONCE FOR EACH VARIATE.
-C THE CALLS FOR A MULTIVARIATE TRANSFORM MAY BE IN ANY ORDER.
-C NTOT IS THE TOTAL NUMBER OF COMPLEX DATA VALUES.
-C N IS THE DIMENSION OF THE CURRENT VARIABLE.
-C NSPAN/N IS THE SPACING OF CONSUCUTIVE DATA VALUES
-C WHILE INDEXING THE CURRENT VARIABLE.
-C THE SIGN OF ISN DETERMINES THE SIGN OF THE COMPLEX
-C EXPONENTIAL, AND THE MAGNITUDE OF ISN IS NORMALLY ONE.
-C
-C FOR A SINGLE-VARIATE TRANSFORM,
-C NTOT = N = NSPAN = (NUMBER OF COMPLEX DATA VALUES), F.G.
-C CALL CFT(A,B,N,N,N,1)
-C
-C A TRI-VARIATE TRANSFORM WITH A(N1,N2,N3), B(N1,N2,N3)
-C IS COMPUTED BY
-C CALL CFT(A,B,N1*N2*N3,N1,N1,1)
-C CALL CFT(A,B,N1*N2*N3,N2,N1*N2,1)
-C CALL CFT(A,B,N1*N2*N3,N3,N1*N2*N3,1)
-C
-C THE DATA MAY ALTERNATIVELY BE STORED IN A SINGLE COMPLEX
-C ARRAY A, THEN THE MAGNITUDE OF ISN CHANGED TO TWO TO
-C GIVE THE CORRECT INDEXING INCREMENT AND THE SECOND PARAMETER
-C USED TO PASS THE INITIAL ADDRESS FOR THE SEQUENCE OF
-C IMAGINARY VALUES, E.G.
-C
-C REAL S(2)
-C EQUIVALENCE (A,S)
-C ....
-C ....
-C CALL CFT(A,S(2),NTOT,N,NSPAN,2)
-C
-C ARRAYS AT(MAXF), CK(MAXF), BT(MAXF), SK(MAXF), AND NP(MAXP)
-C ARE USED FOR TEMPORARY STORAGE. IF THE AVAILABLE STORAGE
-C IS INSUFFICIENT, THE PROGRAM IS TERMINATED BY A STOP.
-C MAXF MUST BE .GE. THE MAXIMUM PRIME FACTOR OF N.
-C MAXP MUST BE .GT. THE NUMBER OF PRIME FACTORS OF N.
-C IN ADDITION, IF THE SQUARE-FREE PORTION K CF N HAS TWO OR
-C MORE PRIME FACTORS, THEN MAXP MUST BE .GE. K-1.
-C ARRAY STORAGE IN NFAC FOR A MAXIMUM OF 11 FACTORS OF N.
-C IF N HAS MORE THAN ONE SQUARE-FREE FACTOR, THE PRODUCT OF THE
-C SQUARE-FREE FACTORS MUST BE .LE. 210
-C
- DIMENSION A(1),B(1)
- DIMENSION NFAC(11),NP(209)
-C ARRAY STORAGE FOR MAXIMUM PRIME FACTOR OF 23
- DIMENSION AT(23),CK(23),BT(23),SK(23)
- EQUIVALENCE (I,II)
-C THE FOLLOWING TWO CONSTANTS SHOULD AGREE WITH THE ARRAY DIMENSIONS
- MAXF=23
- MAXP=209
- IF(N .LT. 2) RETURN
- INC=ISN
-C THE FOLLOWING CONSTANTS ARE RAD = 2.*PI , S72 = SIN(0.4*PI) ,
-C C72 = COS(0.4*PI) AND S120 = SQRT(0.75)
- RAD = 6.2831853071796
- S72 = 0.95105651629515
- C72 = 0.30901699437495
- S120 = 0.86602540378444
- IF(ISN .GE. 0) GO TO 10
- S72=-S72
- S120=-S120
- RAD=-RAD
- INC=-INC
- 10 NT=INC*NTOT
- KS=INC*NSPAN
- KSPAN=KS
- NN=NT-INC
- JC=KS/N
- RADF=RAD*JC*0.5
- I=0
- JF=0
-C DETERMINE THE FACTORS OF N
- M=0
- K=N
- GO TO 20
- 15 M=M+1
- NFAC(M)=4
- K=K/16
- 20 IF(K-(K/16)*16 .EQ. 0) GO TO 15
- J=3
- JJ=9
- GO TO 30
- 25 M=M+1
- NFAC(M)=J
- K=K/JJ
- 30 IF(MOD(K,JJ) .EQ. 0) GO TO 25
- J=J+2
- JJ=J**2
- IF(JJ .LE. K) GO TO 30
- IF(K .GT. 4) GO TO 40
- KT=M
- NFAC(M+1)=K
- IF(K .NE. 1) M=M+1
- GO TO 80
- 40 IF(K-(K/4)*4 .NE. 0) GO TO 50
- M=M+1
- NFAC(M)=2
- K=K/4
- 50 KT=M
- J=2
- 60 IF(MOD(K,J) .NE. 0) GO TO 70
- M=M+1
- NFAC(M)=J
- K=K/J
- 70 J=((J+1)/2)*2+1
- IF(J .LE. K) GO TO 60
- 80 IF(KT .EQ. 0) GO TO 100
- J=KT
- 90 M=M+1
- NFAC(M)=NFAC(J)
- J=J-1
- IF(J .NE. 0) GO TO 90
-C COMPUTE FOURIER TRANSFORM
- 100 SD=RADF/KSPAN
- CD=2.0*SIN(SD)**2
- SD=SIN(SD+SD)
- KK=1
- I=I+1
- IF(NFAC(I) .NE. 2) GO TO 400
-C TRANSFORM FOR FACTOR OF 2 (INCLUDING ROTATION FACTOR)
- KSPAN=KSPAN/2
- K1=KSPAN+2
- 210 K2=KK+KSPAN
- AK=A(K2)
- BK=B(K2)
- A(K2)=A(KK)-AK
- B(K2)=B(KK)-BK
- A(KK)=A(KK)+AK
- B(KK)=B(KK)+BK
- KK=K2+KSPAN
- IF(KK .LE. NN) GO TO 210
- KK=KK-NN
- IF(KK .LE. JC) GO TO 210
- IF(KK .GT. KSPAN) GO TO 800
- 220 C1=1.0-CD
- S1=SD
- 230 K2=KK+KSPAN
- AK=A(KK)-A(K2)
- BK=B(KK)-B(K2)
- A(KK)=A(KK)+A(K2)
- B(KK)=B(KK)+B(K2)
- A(K2)=C1*AK-S1*BK
- B(K2)=S1*AK+C1*BK
- KK=K2+KSPAN
- IF(KK .LT. NT) GO TO 230
- K2=KK-NT
- C1=-C1
- KK=K1-K2
- IF(KK .GT. K2) GO TO 230
- AK=C1-(CD*C1+SD*S1)
- S1=(SD*C1-CD*S1)+S1
-C THE FOLLOWING THREE STATEMENTS COMPENSATE FOR TRUNCATION
-C ERROR. IF ROUNDED ARITHMETIC IS USED, THEY MAY BE DELETED.
-C C1=0.5/(AK**2+S1**2)+0.5
-C S1=C1*S1
-C C1=C1*AK
-C NEXT STATEMENT SHOULD BE DELETED IF NON-ROUNDED ARITHMETIC IS USED
- C1=AK
- KK=KK+JC
- IF(KK .LT. K2) GO TO 230
- K1=K1+INC+INC
- KK=(K1-KSPAN)/2+JC
- IF(KK .LE. JC+JC) GO TO 220
- GO TO 100
-C TRANSFORM FOR FACTOR OF 3 (OPTIONAL CODE)
- 320 K1=KK+KSPAN
- K2=K1+KSPAN
- AK=A(KK)
- BK=B(KK)
- AJ=A(K1)+A(K2)
- BJ=B(K1)+B(K2)
- A(KK)=AK+AJ
- B(KK)=BK+BJ
- AK=-0.5*AJ+AK
- BK=-0.5*BJ+BK
- AJ=(A(K1)-A(K2))*S120
- BJ=(B(K1)-B(K2))*S120
- A(K1)=AK-BJ
- B(K1)=BK+AJ
- A(K2)=AK+BJ
- B(K2)=BK-AJ
- KK=K2+KSPAN
- IF(KK .LT. NN) GO TO 320
- KK=KK-NN
- IF(KK .LE. KSPAN) GO TO 320
- GO TO 700
-C TRANSFORM FOR FACTOR OF 4
- 400 IF(NFAC(I) .NE. 4) GO TO 600
- KSPNN=KSPAN
- KSPAN=KSPAN/4
- 410 C1=1.0
- S1=0
- 420 K1=KK+KSPAN
- K2=K1+KSPAN
- K3=K2+KSPAN
- AKP=A(KK)+A(K2)
- AKM=A(KK)-A(K2)
- AJP=A(K1)+A(K3)
- AJM=A(K1)-A(K3)
- A(KK)=AKP+AJP
- AJP=AKP-AJP
- BKP=B(KK)+B(K2)
- BKM=B(KK)-B(K2)
- BJP=B(K1)+B(K3)
- BJM=B(K1)-B(K3)
- B(KK)=BKP+BJP
- BJP=BKP-BJP
- IF(ISN .LT. 0) GO TO 450
- AKP=AKM-BJM
- AKM=AKM+BJM
- BKP=BKM+AJM
- BKM=BKM-AJM
- IF(S1 .EQ. 0.0) GO TO 460
- 430 A(K1)=AKP*C1-BKP*S1
- B(K1)=AKP*S1+BKP*C1
- A(K2)=AJP*C2-BJP*S2
- B(K2)=AJP*S2+BJP*C2
- A(K3)=AKM*C3-BKM*S3
- B(K3)=AKM*S3+BKM*C3
- KK=K3+KSPAN
- IF(KK .LE. NT) GO TO 420
- 440 C2=C1-(CD*C1+SD*S1)
- S1=(SD*C1-CD*S1)+S1
-C THE FOLLOWING THREE STATEMENTS COMPENSATE FOR TRUNCATION
-C ERROR. IF ROUNDED ARITHMETIC IS USED, THEY MAY BE DELETED.
-C C1=0.5/(C2**2+S1**2)+0.5
-C S1=C1*S1
-C C1=C1*C2
-C NEXT STATEMENT SHOULD BE DELETED IF NON-ROUNDED ARITHMETIC IS USED
- C1=C2
- C2=C1**2-S1**2
- S2=2.0*C1*S1
- C3=C2*C1-S2*S1
- S3=C2*S1+S2*C1
- KK=KK-NT+JC
- IF(KK .LE. KSPAN) GO TO 420
- KK=KK-KSPAN+INC
- IF(KK .LE. JC) GO TO 410
- IF(KSPAN .EQ. JC) GO TO 800
- GO TO 100
- 450 AKP=AKM+BJM
- AKM=AKM-BJM
- BKP=BKM-AJM
- BKM=BKM+AJM
- IF(S1 .NE. 0.0) GO TO 430
- 460 A(K1)=AKP
- B(K1)=BKP
- A(K2)=AJP
- B(K2)=BJP
- A(K3)=AKM
- B(K3)=BKM
- KK=K3+KSPAN
- IF(KK .LE. NT) GO TO 420
- GO TO 440
-C TRANSFORM FOR FACTOR OF 5 (OPTIONAL CODE)
- 510 C2=C72**2-S72**2
- S2=2.0*C72*S72
- 520 K1=KK+KSPAN
- K2=K1+KSPAN
- K3=K2+KSPAN
- K4=K3+KSPAN
- AKP=A(K1)+A(K4)
- AKM=A(K1)-A(K4)
- BKP=B(K1)+B(K4)
- BKM=B(K1)-B(K4)
- AJP=A(K2)+A(K3)
- AJM=A(K2)-A(K3)
- BJP=B(K2)+B(K3)
- BJM=B(K2)-B(K3)
- AA=A(KK)
- BB=B(KK)
- A(KK)=AA+AKP+AJP
- B(KK)=BB+BKP+BJP
- AK=AKP*C72+AJP*C2+AA
- BK=BKP*C72+BJP*C2+BB
- AJ=AKM*S72+AJM*S2
- BJ=BKM*S72+BJM*S2
- A(K1)=AK-BJ
- A(K4)=AK+BJ
- B(K1)=BK+AJ
- B(K4)=BK-AJ
- AK=AKP*C2+AJP*C72+AA
- BK=BKP*C2+BJP*C72+BB
- AJ=AKM*S2-AJM*S72
- BJ=BKM*S2-BJM*S72
- A(K2)=AK-BJ
- A(K3)=AK+BJ
- B(K2)=BK+AJ
- B(K3)=BK-AJ
- KK=K4+KSPAN
- IF(KK .LT. NN) GO TO 520
- KK=KK-NN
- IF(KK .LE. KSPAN) GO TO 520
- GO TO 700
-C TRANSFORM FOR ODD FACTORS
- 600 K=NFAC(I)
- KSPNN=KSPAN
- KSPAN=KSPAN/K
- IF(K .EQ. 3) GO TO 320
- IF(K .EQ. 5) GO TO 510
- IF(K .EQ. JF) GO TO 640
- JF=K
- S1=RAD/K
- C1=COS(S1)
- S1=SIN(S1)
- IF(JF .GT. MAXF) GO TO 998
- CK(JF)=1.0
- SK(JF)=0.0
- J=1
- 630 CK(J)=CK(K)*C1+SK(K)*S1
- SK(J)=CK(K)*S1-SK(K)*C1
- K=K-1
- CK(K)=CK(J)
- SK(K)=-SK(J)
- J=J+1
- IF(J .LT. K) GO TO 630
- 640 K1=KK
- K2=KK+KSPNN
- AA=A(KK)
- BB=B(KK)
- AK=AA
- BK=BB
- J=1
- K1=K1+KSPAN
- 650 K2=K2-KSPAN
- J=J+1
- AT(J)=A(K1)+A(K2)
- AK=AT(J)+AK
- BT(J)=B(K1)+B(K2)
- BK=BT(J)+BK
- J=J+1
- AT(J)=A(K1)-A(K2)
- BT(J)=B(K1)-B(K2)
- K1=K1+KSPAN
- IF(K1 .LT. K2) GO TO 650
- A(KK)=AK
- B(KK)=BK
- K1=KK
- K2=KK+KSPNN
- J=1
- 660 K1=K1+KSPAN
- K2=K2-KSPAN
- JJ=J
- AK=AA
- BK=BB
- AJ=0.0
- BJ=0.0
- K=1
- 670 K=K+1
- AK=AT(K)*CK(JJ)+AK
- BK=BT(K)*CK(JJ)+BK
- K=K+1
- AJ=AT(K)*SK(JJ)+AJ
- BJ=BT(K)*SK(JJ)+BJ
- JJ=JJ+J
- IF(JJ .GT. JF) JJ=JJ-JF
- IF(K .LT. JF) GO TO 670
- K=JF-J
- A(K1)=AK-BJ
- B(K1)=BK+AJ
- A(K2)=AK+BJ
- B(K2)=BK-AJ
- J=J+1
- IF(J .LT. K) GO TO 660
- KK=KK+KSPNN
- IF(KK .LE. NN) GO TO 640
- KK=KK-NN
- IF(KK .LE. KSPAN) GO TO 640
-C MULTIPLY BY ROTATION FACTOR (EXCEPT FOR FACTORS OF 2 AND 4)
- 700 IF(I .EQ. M) GO TO 800
- KK=JC+1
- 710 C2=1.0-CD
- S1=SD
- 720 C1=C2
- S2=S1
- KK=KK+KSPAN
- 730 AK=A(KK)
- A(KK)=C2*AK-S2*B(KK)
- B(KK)=S2*AK+C2*B(KK)
- KK=KK+KSPNN
- IF(KK .LE. NT) GO TO 730
- AK=S1*S2
- S2=S1*C2+C1*S2
- C2=C1*C2-AK
- KK=KK-NT+KSPAN
- IF(KK .LE. KSPNN) GO TO 730
- C2=C1-(CD*C1+SD*S1)
- S1=S1+(SD*C1-CD*S1)
-C THE FOLLOWING THREE STATEMENTS COMPENSATE FOR TRUNCATION
-C ERROR. IF ROUNDED ARITHMETIC IS USED, THEY MAY
-C BE DELETED.
-C C1=0.5/(C2**2+S1**2)+0.5
-C S1=C1*S1
-C C2=C1*C2
- KK=KK-KSPNN+JC
- IF(KK .LE. KSPAN) GO TO 720
- KK=KK-KSPAN+JC+INC
- IF(KK .LE. JC+JC) GO TO 710
- GO TO 100
-C PERMUTE THE RESULTS TO NORMAL ORDER---DONE IN TWO STAGES
-C PERMUTATION FOR SQUARE FACTORS OF N
- 800 NP(1)=KS
- IF(KT .EQ. 0) GO TO 890
- K=KT+KT+1
- IF(M .LT. K) K=K-1
- J=1
- NP(K+1)=JC
- 810 NP(J+1)=NP(J)/NFAC(J)
- NP(K)=NP(K+1)*NFAC(J)
- J=J+1
- K=K-1
- IF(J .LT. K) GO TO 810
- K3=NP(K+1)
- KSPAN=NP(2)
- KK=JC+1
- K2=KSPAN+1
- J=1
- IF(N .NE. NTOT) GO TO 850
-C PERMUTATION FOR SINGLE-VARIATE TRANSFORM (OPTIONAL CODE)
- 820 AK=A(KK)
- A(KK)=A(K2)
- A(K2)=AK
- BK=B(KK)
- B(KK)=B(K2)
- B(K2)=BK
- KK=KK+INC
- K2=KSPAN+K2
- IF(K2 .LT. KS) GO TO 820
- 830 K2=K2-NP(J)
- J=J+1
- K2=NP(J+1)+K2
- IF(K2 .GT. NP(J)) GO TO 830
- J=1
- 840 IF(KK .LT. K2) GO TO 820
- KK=KK+INC
- K2=KSPAN+K2
- IF(K2 .LT. KS) GO TO 840
- IF(KK .LT. KS) GO TO 830
- JC=K3
- GO TO 890
-C PERMUTATION FOR MULTIVARIATE TRANSFORM
- 850 K=KK+JC
- 860 AK=A(KK)
- A(KK)=A(K2)
- A(K2)=AK
- BK=B(KK)
- B(KK)=B(K2)
- B(K2)=BK
- KK=KK+INC
- K2=K2+INC
- IF(KK .LT. K) GO TO 860
- KK=KK+KS-JC
- K2=K2+KS-JC
- IF(KK .LT. NT) GO TO 850
- K2=K2-NT+KSPAN
- KK=KK-NT+JC
- IF(K2 .LT. KS) GO TO 850
- 870 K2=K2-NP(J)
- J=J+1
- K2=NP(J+1)+K2
- IF(K2 .GT. NP(J)) GO TO 870
- J=1
- 880 IF(KK .LT. K2) GO TO 850
- KK=KK+JC
- K2=KSPAN+K2
- IF(K2 .LT. KS) GO TO 880
- IF(KK .LT. KS) GO TO 870
- JC=K3
- 890 IF(2*KT+1 .GE. M) RETURN
- KSPNN=NP(KT+1)
-C PERMUTATION FOR SQUARE-FREE FACTORS OF N
- J=M-KT
- NFAC(J+1)=1
- 900 NFAC(J)=NFAC(J)*NFAC(J+1)
- J=J-1
- IF(J .NE. KT) GO TO 900
- KT=KT+1
- NN=NFAC(KT)-1
- IF(NN .GT. MAXP) GO TO 998
- JJ=0
- J=0
- GO TO 906
- 902 JJ=JJ-K2
- K2=KK
- K=K+1
- KK=NFAC(K)
- 904 JJ=KK+JJ
- IF(JJ .GE. K2) GO TO 902
- NP(J)=JJ
- 906 K2=NFAC(KT)
- K=KT+1
- KK=NFAC(K)
- J=J+1
- IF(J .LE. NN) GO TO 904
-C DETERMINE THE PERMUTATION CYCLES OF LENGTH GREATER THAN 1
- J=0
- GO TO 914
- 910 K=KK
- KK=NP(K)
- NP(K)=-KK
- IF(KK .NE. J) GO TO 910
- K3=KK
- 914 J=J+1
- KK=NP(J)
- IF(KK .LT. 0) GO TO 914
- IF(KK .NE. J) GO TO 910
- NP(J)=-J
- IF(J .NE. NN) GO TO 914
- MAXF=INC*MAXF
-C REORDER A AND B, FOLLOWING THE PERMUTATION CYCLES
- GO TO 950
- 924 J=J-1
- IF(NP(J) .LT. 0) GO TO 924
- JJ=JC
- 926 KSPAN=JJ
- IF(JJ .GT. MAXF) KSPAN=MAXF
- JJ=JJ-KSPAN
- K=NP(J)
- KK=JC*K+II+JJ
- K1=KK+KSPAN
- K2=0
- 928 K2=K2+1
- AT(K2)=A(K1)
- BT(K2)=B(K1)
- K1=K1-INC
- IF(K1 .NE. KK) GO TO 928
- 932 K1=KK+KSPAN
- K2=K1-JC*(K+NP(K))
- K=-NP(K)
- 936 A(K1)=A(K2)
- B(K1)=B(K2)
- K1=K1-INC
- K2=K2-INC
- IF(K1 .NE. KK) GO TO 936
- KK=K2
- IF(K .NE. J) GO TO 932
- K1=KK+KSPAN
- K2=0
- 940 K2=K2+1
- A(K1)=AT(K2)
- B(K1)=BT(K2)
- K1=K1-INC
- IF(K1 .NE. KK) GO TO 940
- IF(JJ .NE. 0) GO TO 926
- IF(J .NE. 1) GO TO 924
- 950 J=K3+1
- NT=NT-KSPNN
- II=NT-INC+1
- IF(NT .GE. 0) GO TO 924
- RETURN
-C ERROR FINISH, INSUFFICIENT ARRAY STORAGE
- 998 ISN=0
- WRITE(6,999)
- STOP
- 999 FORMAT('0ARRAY BOUNDS EXCEEDED WITHIN SUBROUTINE CFT')
- END
diff --git a/src/mathlib/gen/d/cgauss.F b/src/mathlib/gen/d/cgauss.F
deleted file mode 100644
index cf81b51..0000000
--- a/src/mathlib/gen/d/cgauss.F
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: cgauss.F,v 1.1.1.1 1996/04/01 15:02:15 mclareni Exp $
-*
-* $Log: cgauss.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:15 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-C This will be CGAUSS,IF=DOUBLE and CGAUSS64,IF=-DOUBLE.
- FUNCTION CGAUSS(F,A,B,EPS)
- COMPLEX CGAUSS,F,A,B,AA,BB,U,C1,C2,S8,S16,H
- CHARACTER NAME*(*)
- PARAMETER (NAME = 'CGAUSS')
-#include "cgausscod.inc"
- 99 CGAUSS=H
- RETURN
- END
diff --git a/src/mathlib/gen/d/cgauss128.F b/src/mathlib/gen/d/cgauss128.F
deleted file mode 100644
index 858c7ef..0000000
--- a/src/mathlib/gen/d/cgauss128.F
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: cgauss128.F,v 1.1.1.1 1996/04/01 15:02:16 mclareni Exp $
-*
-* $Log: cgauss128.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:16 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION WGAUSS(F,A,B,EPS)
-#include "gen/imp128.inc"
- COMPLEX*16 WGAUSS
- CHARACTER*(*) NAME
- PARAMETER( NAME='WGAUSS')
- WGAUSS=0
- CALL MTLPRT(NAME,'D113.0','Not available on this machine')
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/d/cgauss64.F b/src/mathlib/gen/d/cgauss64.F
deleted file mode 100644
index dcc72cc..0000000
--- a/src/mathlib/gen/d/cgauss64.F
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: cgauss64.F,v 1.1.1.1 1996/04/01 15:02:16 mclareni Exp $
-*
-* $Log: cgauss64.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:16 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- FUNCTION WGAUSS(F,A,B,EPS)
-#include "gen/imp64.inc"
-#include "gen/defc64.inc"
- + WGAUSS,F,A,B,AA,BB,U,C1,C2,S8,S16,H
- CHARACTER NAME*(*)
- PARAMETER (NAME = 'WGAUSS')
-#include "cgausscod.inc"
-
- 99 WGAUSS=H
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/d/cgausscod.inc b/src/mathlib/gen/d/cgausscod.inc
deleted file mode 100644
index c439de9..0000000
--- a/src/mathlib/gen/d/cgausscod.inc
+++ /dev/null
@@ -1,55 +0,0 @@
-*
-* $Id: cgausscod.inc,v 1.1.1.1 1996/04/01 15:02:16 mclareni Exp $
-*
-* $Log: cgausscod.inc,v $
-* Revision 1.1.1.1 1996/04/01 15:02:16 mclareni
-* Mathlib gen
-*
-*
-*
-* cgausscod.inc
-*
- DIMENSION W(12),X(12)
-
- PARAMETER (Z1 = 1, HF = Z1/2, CST = 5*Z1/1000)
-
- DATA X( 1) /9.6028985649753623D-1/, W( 1) /1.0122853629037626D-1/
- DATA X( 2) /7.9666647741362674D-1/, W( 2) /2.2238103445337447D-1/
- DATA X( 3) /5.2553240991632899D-1/, W( 3) /3.1370664587788729D-1/
- DATA X( 4) /1.8343464249564980D-1/, W( 4) /3.6268378337836198D-1/
- DATA X( 5) /9.8940093499164993D-1/, W( 5) /2.7152459411754095D-2/
- DATA X( 6) /9.4457502307323258D-1/, W( 6) /6.2253523938647893D-2/
- DATA X( 7) /8.6563120238783174D-1/, W( 7) /9.5158511682492785D-2/
- DATA X( 8) /7.5540440835500303D-1/, W( 8) /1.2462897125553387D-1/
- DATA X( 9) /6.1787624440264375D-1/, W( 9) /1.4959598881657673D-1/
- DATA X(10) /4.5801677765722739D-1/, W(10) /1.6915651939500254D-1/
- DATA X(11) /2.8160355077925891D-1/, W(11) /1.8260341504492359D-1/
- DATA X(12) /9.5012509837637440D-2/, W(12) /1.8945061045506850D-1/
-
- H=0
- IF(B .EQ. A) GO TO 99
- CONST=CST/ABS(B-A)
- BB=A
- 1 AA=BB
- BB=B
- 2 C1=HF*(BB+AA)
- C2=HF*(BB-AA)
- S8=0
- DO 3 I = 1,4
- U=C2*X(I)
- 3 S8=S8+W(I)*(F(C1+U)+F(C1-U))
- S16=0
- DO 4 I = 5,12
- U=C2*X(I)
- 4 S16=S16+W(I)*(F(C1+U)+F(C1-U))
- S16=C2*S16
- IF(ABS(S16-C2*S8) .LE. EPS*(1+ABS(S16))) THEN
- H=H+S16
- IF(BB .NE. B) GO TO 1
- ELSE
- BB=C1
- IF(1+CONST*ABS(C2) .NE. 1) GO TO 2
- H=0
- CALL MTLPRT(NAME,'D113.1','TOO HIGH ACCURACY REQUIRED')
- GO TO 99
- END IF
diff --git a/src/mathlib/gen/d/d107d1.F b/src/mathlib/gen/d/d107d1.F
deleted file mode 100644
index a07b02f..0000000
--- a/src/mathlib/gen/d/d107d1.F
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: d107d1.F,v 1.1.1.1 1996/04/01 15:02:14 mclareni Exp $
-*
-* $Log: d107d1.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:14 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- SUBROUTINE D107D1(MODE,F,A,B,N,X,W)
-#include "gen/imp64.inc"
- CHARACTER*6 NAME(2)
- DATA NAME /'DGQUAD','DGSET'/
-#include "d107rd.inc"
-
-#endif
diff --git a/src/mathlib/gen/d/d107r1.F b/src/mathlib/gen/d/d107r1.F
deleted file mode 100644
index f6606c6..0000000
--- a/src/mathlib/gen/d/d107r1.F
+++ /dev/null
@@ -1,15 +0,0 @@
-*
-* $Id: d107r1.F,v 1.1.1.1 1996/04/01 15:02:14 mclareni Exp $
-*
-* $Log: d107r1.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:14 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE D107R1(MODE,F,A,B,N,X,W)
-
- CHARACTER*6 NAME(2)
- DATA NAME /'RGQUAD','RGSET'/
-#include "d107rd.inc"
-
diff --git a/src/mathlib/gen/d/d107rd.inc b/src/mathlib/gen/d/d107rd.inc
deleted file mode 100644
index 525c1c9..0000000
--- a/src/mathlib/gen/d/d107rd.inc
+++ /dev/null
@@ -1,351 +0,0 @@
-*
-* $Id: d107rd.inc,v 1.1.1.1 1996/04/01 15:02:14 mclareni Exp $
-*
-* $Log: d107rd.inc,v $
-* Revision 1.1.1.1 1996/04/01 15:02:14 mclareni
-* Mathlib gen
-*
-*
-*
-* d107rd.inc
-*
- DIMENSION X(*),W(*),KTBA(97),U(273),V(273)
- PARAMETER (Z1 = 1, HF = Z1/2)
-
- CHARACTER*80 ERRTXT
-
- DATA KTBA
- 1/0,1,2,4,6,9,12,16,20,25,30,36,42,49,56,64,3*0,72,3*0,82,7*0,94,
- 2 7*0,110,7*0,130,15*0,154,15*0,186,15*0,226,0/
-
-C N=2.
- DATA U(1) /5.7735026918962576D-1/, V(1) /1/
-C N=3.
- DATA U(2) /7.7459666924148338D-1/, V(2) /5.5555555555555556D-1/
- DATA U(3) /0/ , V(3) /8.8888888888888889D-1/
-C N=4.
- DATA U(4) /8.6113631159405258D-1/, V(4) /3.4785484513745386D-1/
- DATA U(5) /3.3998104358485626D-1/, V(5) /6.5214515486254614D-1/
-C N=5.
- DATA U(6) /9.0617984593866399D-1/, V(6) /2.3692688505618909D-1/
- DATA U(7) /5.3846931010568309D-1/, V(7) /4.7862867049936647D-1/
- DATA U(8) /0/, V(8) /5.6888888888888889D-1/
-C N=6.
- DATA U(9) /9.3246951420315203D-1/, V(9) /1.7132449237917035D-1/
- DATA U(10) /6.6120938646626451D-1/, V(10) /3.6076157304813861D-1/
- DATA U(11) /2.3861918608319691D-1/, V(11) /4.6791393457269105D-1/
-C N=7.
- DATA U(12) /9.4910791234275852D-1/, V(12) /1.2948496616886969D-1/
- DATA U(13) /7.4153118559939444D-1/, V(13) /2.7970539148927667D-1/
- DATA U(14) /4.0584515137739717D-1/, V(14) /3.8183005050511894D-1/
- DATA U(15) /0/ , V(15) /4.1795918367346939D-1/
-C N=8.
- DATA U(16) /9.6028985649753623D-1/, V(16) /1.0122853629037626D-1/
- DATA U(17) /7.9666647741362674D-1/, V(17) /2.2238103445337447D-1/
- DATA U(18) /5.2553240991632899D-1/, V(18) /3.1370664587788729D-1/
- DATA U(19) /1.8343464249564980D-1/, V(19) /3.6268378337836198D-1/
-C N=9.
- DATA U(20) /9.6816023950762609D-1/, V(20) /8.1274388361574412D-2/
- DATA U(21) /8.3603110732663579D-1/, V(21) /1.8064816069485740D-1/
- DATA U(22) /6.1337143270059040D-1/, V(22) /2.6061069640293546D-1/
- DATA U(23) /3.2425342340380893D-1/, V(23) /3.1234707704000284D-1/
- DATA U(24) /0/ , V(24) /3.3023935500125976D-1/
-C N=10.
- DATA U(25) /9.7390652851717172D-1/, V(25) /6.6671344308688138D-2/
- DATA U(26) /8.6506336668898451D-1/, V(26) /1.4945134915058059D-1/
- DATA U(27) /6.7940956829902441D-1/, V(27) /2.1908636251598204D-1/
- DATA U(28) /4.3339539412924719D-1/, V(28) /2.6926671930999636D-1/
- DATA U(29) /1.4887433898163121D-1/, V(29) /2.9552422471475287D-1/
-C N=11.
- DATA U(30) /9.7822865814605699D-1/, V(30) /5.5668567116173666D-2/
- DATA U(31) /8.8706259976809530D-1/, V(31) /1.2558036946490462D-1/
- DATA U(32) /7.3015200557404932D-1/, V(32) /1.8629021092773425D-1/
- DATA U(33) /5.1909612920681182D-1/, V(33) /2.3319376459199048D-1/
- DATA U(34) /2.6954315595234497D-1/, V(34) /2.6280454451024666D-1/
- DATA U(35) /0/ , V(35) /2.7292508677790063D-1/
-C N=12.
- DATA U(36) /9.8156063424671925D-1/, V(36) /4.7175336386511827D-2/
- DATA U(37) /9.0411725637047486D-1/, V(37) /1.0693932599531843D-1/
- DATA U(38) /7.6990267419430469D-1/, V(38) /1.6007832854334623D-1/
- DATA U(39) /5.8731795428661745D-1/, V(39) /2.0316742672306592D-1/
- DATA U(40) /3.6783149899818019D-1/, V(40) /2.3349253653835481D-1/
- DATA U(41) /1.2523340851146892D-1/, V(41) /2.4914704581340279D-1/
-C N=13.
- DATA U(42) /9.8418305471858815D-1/, V(42) /4.0484004765315880D-2/
- DATA U(43) /9.1759839922297797D-1/, V(43) /9.2121499837728448D-2/
- DATA U(44) /8.0157809073330991D-1/, V(44) /1.3887351021978724D-1/
- DATA U(45) /6.4234933944034022D-1/, V(45) /1.7814598076194574D-1/
- DATA U(46) /4.4849275103644685D-1/, V(46) /2.0781604753688850D-1/
- DATA U(47) /2.3045831595513479D-1/, V(47) /2.2628318026289724D-1/
- DATA U(48) /0/ , V(48) /2.3255155323087391D-1/
-C N=14.
- DATA U(49) /9.8628380869681234D-1/, V(49) /3.5119460331751863D-2/
- DATA U(50) /9.2843488366357352D-1/, V(50) /8.0158087159760210D-2/
- DATA U(51) /8.2720131506976499D-1/, V(51) /1.2151857068790318D-1/
- DATA U(52) /6.8729290481168547D-1/, V(52) /1.5720316715819353D-1/
- DATA U(53) /5.1524863635815409D-1/, V(53) /1.8553839747793781D-1/
- DATA U(54) /3.1911236892788976D-1/, V(54) /2.0519846372129560D-1/
- DATA U(55) /1.0805494870734366D-1/, V(55) /2.1526385346315779D-1/
-C N=15.
- DATA U(56) /9.8799251802048543D-1/, V(56) /3.0753241996117268D-2/
- DATA U(57) /9.3727339240070590D-1/, V(57) /7.0366047488108125D-2/
- DATA U(58) /8.4820658341042722D-1/, V(58) /1.0715922046717194D-1/
- DATA U(59) /7.2441773136017005D-1/, V(59) /1.3957067792615431D-1/
- DATA U(60) /5.7097217260853885D-1/, V(60) /1.6626920581699393D-1/
- DATA U(61) /3.9415134707756337D-1/, V(61) /1.8616100001556221D-1/
- DATA U(62) /2.0119409399743452D-1/, V(62) /1.9843148532711158D-1/
- DATA U(63) /0/ , V(63) /2.0257824192556127D-1/
-C N=16.
- DATA U(64) /9.8940093499164993D-1/, V(64) /2.7152459411754095D-2/
- DATA U(65) /9.4457502307323258D-1/, V(65) /6.2253523938647893D-2/
- DATA U(66) /8.6563120238783174D-1/, V(66) /9.5158511682492785D-2/
- DATA U(67) /7.5540440835500303D-1/, V(67) /1.2462897125553387D-1/
- DATA U(68) /6.1787624440264375D-1/, V(68) /1.4959598881657673D-1/
- DATA U(69) /4.5801677765722739D-1/, V(69) /1.6915651939500254D-1/
- DATA U(70) /2.8160355077925891D-1/, V(70) /1.8260341504492359D-1/
- DATA U(71) /9.5012509837637440D-2/, V(71) /1.8945061045506850D-1/
-C N=20.
- DATA U(72) /9.9312859918509492D-1/, V(72) /1.7614007139152118D-2/
- DATA U(73) /9.6397192727791379D-1/, V(73) /4.0601429800386941D-2/
- DATA U(74) /9.1223442825132591D-1/, V(74) /6.2672048334109064D-2/
- DATA U(75) /8.3911697182221882D-1/, V(75) /8.3276741576704749D-2/
- DATA U(76) /7.4633190646015079D-1/, V(76) /1.0193011981724044D-1/
- DATA U(77) /6.3605368072651503D-1/, V(77) /1.1819453196151842D-1/
- DATA U(78) /5.1086700195082710D-1/, V(78) /1.3168863844917663D-1/
- DATA U(79) /3.7370608871541956D-1/, V(79) /1.4209610931838205D-1/
- DATA U(80) /2.2778585114164508D-1/, V(80) /1.4917298647260374D-1/
- DATA U(81) /7.6526521133497334D-2/, V(81) /1.5275338713072585D-1/
-C N=24.
- DATA U(82) /9.9518721999702136D-1/, V(82) /1.2341229799987200D-2/
- DATA U(83) /9.7472855597130950D-1/, V(83) /2.8531388628933663D-2/
- DATA U(84) /9.3827455200273276D-1/, V(84) /4.4277438817419806D-2/
- DATA U(85) /8.8641552700440103D-1/, V(85) /5.9298584915436781D-2/
- DATA U(86) /8.2000198597390292D-1/, V(86) /7.3346481411080306D-2/
- DATA U(87) /7.4012419157855436D-1/, V(87) /8.6190161531953276D-2/
- DATA U(88) /6.4809365193697557D-1/, V(88) /9.7618652104113888D-2/
- DATA U(89) /5.4542147138883954D-1/, V(89) /1.0744427011596563D-1/
- DATA U(90) /4.3379350762604514D-1/, V(90) /1.1550566805372560D-1/
- DATA U(91) /3.1504267969616337D-1/, V(91) /1.2167047292780339D-1/
- DATA U(92) /1.9111886747361631D-1/, V(92) /1.2583745634682830D-1/
- DATA U(93) /6.4056892862605626D-2/, V(93) /1.2793819534675216D-1/
-C N=32.
- DATA U(94) /9.9726386184948156D-1/, V(94) /7.0186100094700966D-3/
- DATA U(95) /9.8561151154526834D-1/, V(95) /1.6274394730905671D-2/
- DATA U(96) /9.6476225558750643D-1/, V(96) /2.5392065309262059D-2/
- DATA U(97) /9.3490607593773969D-1/, V(97) /3.4273862913021433D-2/
- DATA U(98) /8.9632115576605212D-1/, V(98) /4.2835898022226681D-2/
- DATA U(99) /8.4936761373256997D-1/, V(99) /5.0998059262376176D-2/
- DATA U(100)/7.9448379596794241D-1/, V(100)/5.8684093478535547D-2/
- DATA U(101)/7.3218211874028968D-1/, V(101)/6.5822222776361847D-2/
- DATA U(102)/6.6304426693021520D-1/, V(102)/7.2345794108848506D-2/
- DATA U(103)/5.8771575724076233D-1/, V(103)/7.8193895787070306D-2/
- DATA U(104)/5.0689990893222939D-1/, V(104)/8.3311924226946755D-2/
- DATA U(105)/4.2135127613063535D-1/, V(105)/8.7652093004403811D-2/
- DATA U(106)/3.3186860228212765D-1/, V(106)/9.1173878695763885D-2/
- DATA U(107)/2.3928736225213707D-1/, V(107)/9.3844399080804566D-2/
- DATA U(108)/1.4447196158279649D-1/, V(108)/9.5638720079274859D-2/
- DATA U(109)/4.8307665687738316D-2/, V(109)/9.6540088514727801D-2/
-C N=40.
- DATA U(110)/9.9823770971055920D-1/, V(110)/4.5212770985331913D-3/
- DATA U(111)/9.9072623869945701D-1/, V(111)/1.0498284531152814D-2/
- DATA U(112)/9.7725994998377426D-1/, V(112)/1.6421058381907889D-2/
- DATA U(113)/9.5791681921379166D-1/, V(113)/2.2245849194166957D-2/
- DATA U(114)/9.3281280827867653D-1/, V(114)/2.7937006980023401D-2/
- DATA U(115)/9.0209880696887430D-1/, V(115)/3.3460195282547847D-2/
- DATA U(116)/8.6595950321225950D-1/, V(116)/3.8782167974472018D-2/
- DATA U(117)/8.2461223083331166D-1/, V(117)/4.3870908185673272D-2/
- DATA U(118)/7.7830565142651939D-1/, V(118)/4.8695807635072232D-2/
- DATA U(119)/7.2731825518992710D-1/, V(119)/5.3227846983936824D-2/
- DATA U(120)/6.7195668461417955D-1/, V(120)/5.7439769099391551D-2/
- DATA U(121)/6.1255388966798024D-1/, V(121)/6.1306242492928939D-2/
- DATA U(122)/5.4946712509512820D-1/, V(122)/6.4804013456601038D-2/
- DATA U(123)/4.8307580168617871D-1/, V(123)/6.7912045815233904D-2/
- DATA U(124)/4.1377920437160500D-1/, V(124)/7.0611647391286780D-2/
- DATA U(125)/3.4199409082575847D-1/, V(125)/7.2886582395804059D-2/
- DATA U(126)/2.6815218500725368D-1/, V(126)/7.4723169057968264D-2/
- DATA U(127)/1.9269758070137110D-1/, V(127)/7.6110361900626242D-2/
- DATA U(128)/1.1608407067525521D-1/, V(128)/7.7039818164247966D-2/
- DATA U(129)/3.8772417506050822D-2/, V(129)/7.7505947978424811D-2/
-C N=48.
- DATA U(130)/9.9877100725242612D-1/, V(130)/3.1533460523058386D-3/
- DATA U(131)/9.9353017226635076D-1/, V(131)/7.3275539012762621D-3/
- DATA U(132)/9.8412458372282686D-1/, V(132)/1.1477234579234539D-2/
- DATA U(133)/9.7059159254624725D-1/, V(133)/1.5579315722943849D-2/
- DATA U(134)/9.5298770316043086D-1/, V(134)/1.9616160457355528D-2/
- DATA U(135)/9.3138669070655433D-1/, V(135)/2.3570760839324379D-2/
- DATA U(136)/9.0587913671556967D-1/, V(136)/2.7426509708356948D-2/
- DATA U(137)/8.7657202027424789D-1/, V(137)/3.1167227832798089D-2/
- DATA U(138)/8.4358826162439353D-1/, V(138)/3.4777222564770439D-2/
- DATA U(139)/8.0706620402944263D-1/, V(139)/3.8241351065830706D-2/
- DATA U(140)/7.6715903251574034D-1/, V(140)/4.1545082943464749D-2/
- DATA U(141)/7.2403413092381465D-1/, V(141)/4.4674560856694280D-2/
- DATA U(142)/6.7787237963266391D-1/, V(142)/4.7616658492490475D-2/
- DATA U(143)/6.2886739677651362D-1/, V(143)/5.0359035553854475D-2/
- DATA U(144)/5.7722472608397270D-1/, V(144)/5.2890189485193667D-2/
- DATA U(145)/5.2316097472223303D-1/, V(145)/5.5199503699984163D-2/
- DATA U(146)/4.6690290475095840D-1/, V(146)/5.7277292100403216D-2/
- DATA U(147)/4.0868648199071673D-1/, V(147)/5.9114839698395636D-2/
- DATA U(148)/3.4875588629216074D-1/, V(148)/6.0704439165893880D-2/
- DATA U(149)/2.8736248735545558D-1/, V(149)/6.2039423159892664D-2/
- DATA U(150)/2.2476379039468906D-1/, V(150)/6.3114192286254026D-2/
- DATA U(151)/1.6122235606889172D-1/, V(151)/6.3924238584648187D-2/
- DATA U(152)/9.7004699209462699D-2/, V(152)/6.4466164435950082D-2/
- DATA U(153)/3.2380170962869362D-2/, V(153)/6.4737696812683923D-2/
-C N=64.
- DATA U(154)/9.9930504173577214D-1/, V(154)/1.7832807216964329D-3/
- DATA U(155)/9.9634011677195528D-1/, V(155)/4.1470332605624676D-3/
- DATA U(156)/9.9101337147674432D-1/, V(156)/6.5044579689783629D-3/
- DATA U(157)/9.8333625388462596D-1/, V(157)/8.8467598263639477D-3/
- DATA U(158)/9.7332682778991096D-1/, V(158)/1.1168139460131129D-2/
- DATA U(159)/9.6100879965205372D-1/, V(159)/1.3463047896718643D-2/
- DATA U(160)/9.4641137485840282D-1/, V(160)/1.5726030476024719D-2/
- DATA U(161)/9.2956917213193958D-1/, V(161)/1.7951715775697343D-2/
- DATA U(162)/9.1052213707850281D-1/, V(162)/2.0134823153530209D-2/
- DATA U(163)/8.8931544599511412D-1/, V(163)/2.2270173808383254D-2/
- DATA U(164)/8.6599939815409282D-1/, V(164)/2.4352702568710873D-2/
- DATA U(165)/8.4062929625258036D-1/, V(165)/2.6377469715054659D-2/
- DATA U(166)/8.1326531512279756D-1/, V(166)/2.8339672614259483D-2/
- DATA U(167)/7.8397235894334141D-1/, V(167)/3.0234657072402479D-2/
- DATA U(168)/7.5281990726053190D-1/, V(168)/3.2057928354851554D-2/
- DATA U(169)/7.1988185017161083D-1/, V(169)/3.3805161837141609D-2/
- DATA U(170)/6.8523631305423324D-1/, V(170)/3.5472213256882384D-2/
- DATA U(171)/6.4896547125465734D-1/, V(171)/3.7055128540240046D-2/
- DATA U(172)/6.1115535517239325D-1/, V(172)/3.8550153178615629D-2/
- DATA U(173)/5.7189564620263403D-1/, V(173)/3.9953741132720341D-2/
- DATA U(174)/5.3127946401989455D-1/, V(174)/4.1262563242623529D-2/
- DATA U(175)/4.8940314570705296D-1/, V(175)/4.2473515123653589D-2/
- DATA U(176)/4.4636601725346409D-1/, V(176)/4.3583724529323453D-2/
- DATA U(177)/4.0227015796399160D-1/, V(177)/4.4590558163756563D-2/
- DATA U(178)/3.5722015833766812D-1/, V(178)/4.5491627927418144D-2/
- DATA U(179)/3.1132287199021096D-1/, V(179)/4.6284796581314417D-2/
- DATA U(180)/2.6468716220876742D-1/, V(180)/4.6968182816210017D-2/
- DATA U(181)/2.1742364374000708D-1/, V(181)/4.7540165714830309D-2/
- DATA U(182)/1.6964442042399282D-1/, V(182)/4.7999388596458308D-2/
- DATA U(183)/1.2146281929612055D-1/, V(183)/4.8344762234802957D-2/
- DATA U(184)/7.2993121787799039D-2/, V(184)/4.8575467441503427D-2/
- DATA U(185)/2.4350292663424433D-2/, V(185)/4.8690957009139720D-2/
-C N=80.
- DATA U(186)/9.9955382265163063D-1/, V(186)/1.1449500031869415D-3/
- DATA U(187)/9.9764986439823769D-1/, V(187)/2.6635335895126817D-3/
- DATA U(188)/9.9422754096568828D-1/, V(188)/4.1803131246948952D-3/
- DATA U(189)/9.8929130249975553D-1/, V(189)/5.6909224514031986D-3/
- DATA U(190)/9.8284857273862907D-1/, V(190)/7.1929047681173128D-3/
- DATA U(191)/9.7490914058572779D-1/, V(191)/8.6839452692608584D-3/
- DATA U(192)/9.6548508904379925D-1/, V(192)/1.0161766041103065D-2/
- DATA U(193)/9.5459076634363491D-1/, V(193)/1.1624114120797827D-2/
- DATA U(194)/9.4224276130987267D-1/, V(194)/1.3068761592401339D-2/
- DATA U(195)/9.2845987717244580D-1/, V(195)/1.4493508040509076D-2/
- DATA U(196)/9.1326310257175765D-1/, V(196)/1.5896183583725688D-2/
- DATA U(197)/8.9667557943877068D-1/, V(197)/1.7274652056269306D-2/
- DATA U(198)/8.7872256767821383D-1/, V(198)/1.8626814208299031D-2/
- DATA U(199)/8.5943140666311110D-1/, V(199)/1.9950610878141999D-2/
- DATA U(200)/8.3883147358025528D-1/, V(200)/2.1244026115782006D-2/
- DATA U(201)/8.1695413868146347D-1/, V(201)/2.2505090246332462D-2/
- DATA U(202)/7.9383271750460545D-1/, V(202)/2.3731882865930101D-2/
- DATA U(203)/7.6950242013504137D-1/, V(203)/2.4922535764115491D-2/
- DATA U(204)/7.4400029758359727D-1/, V(204)/2.6075235767565118D-2/
- DATA U(205)/7.1736518536209988D-1/, V(205)/2.7188227500486381D-2/
- DATA U(206)/6.8963764434202760D-1/, V(206)/2.8259816057276862D-2/
- DATA U(207)/6.6085989898611980D-1/, V(207)/2.9288369583267848D-2/
- DATA U(208)/6.3107577304687197D-1/, V(208)/3.0272321759557981D-2/
- DATA U(209)/6.0033062282975174D-1/, V(209)/3.1210174188114702D-2/
- DATA U(210)/5.6867126812270978D-1/, V(210)/3.2100498673487773D-2/
- DATA U(211)/5.3614592089713193D-1/, V(211)/3.2941939397645401D-2/
- DATA U(212)/5.0280411188878499D-1/, V(212)/3.3733214984611523D-2/
- DATA U(213)/4.6869661517054448D-1/, V(213)/3.4473120451753929D-2/
- DATA U(214)/4.3387537083175609D-1/, V(214)/3.5160529044747593D-2/
- DATA U(215)/3.9839340588196923D-1/, V(215)/3.5794393953416055D-2/
- DATA U(216)/3.6230475349948732D-1/, V(216)/3.6373749905835978D-2/
- DATA U(217)/3.2566437074770191D-1/, V(217)/3.6897714638276009D-2/
- DATA U(218)/2.8852805488451185D-1/, V(218)/3.7365490238730490D-2/
- DATA U(219)/2.5095235839227212D-1/, V(219)/3.7776364362001397D-2/
- DATA U(220)/2.1299450285766613D-1/, V(220)/3.8129711314477638D-2/
- DATA U(221)/1.7471229183264681D-1/, V(221)/3.8424993006959423D-2/
- DATA U(222)/1.3616402280914389D-1/, V(222)/3.8661759774076463D-2/
- DATA U(223)/9.7408398441584599D-2/, V(223)/3.8839651059051969D-2/
- DATA U(224)/5.8504437152420669D-2/, V(224)/3.8958395962769531D-2/
- DATA U(225)/1.9511383256793998D-2/, V(225)/3.9017813656306655D-2/
-C N=96.
- DATA U(226)/9.9968950388323077D-1/, V(226)/7.9679206555201243D-4/
- DATA U(227)/9.9836437586318168D-1/, V(227)/1.8539607889469217D-3/
- DATA U(228)/9.9598184298720929D-1/, V(228)/2.9107318179349464D-3/
- DATA U(229)/9.9254390032376262D-1/, V(229)/3.9645543384446867D-3/
- DATA U(230)/9.8805412632962380D-1/, V(230)/5.0142027429275177D-3/
- DATA U(231)/9.8251726356301468D-1/, V(231)/6.0585455042359617D-3/
- DATA U(232)/9.7593917458513647D-1/, V(232)/7.0964707911538653D-3/
- DATA U(233)/9.6832682846326421D-1/, V(233)/8.1268769256987592D-3/
- DATA U(234)/9.5968829144874254D-1/, V(234)/9.1486712307833866D-3/
- DATA U(235)/9.5003271778443764D-1/, V(235)/1.0160770535008416D-2/
- DATA U(236)/9.3937033975275522D-1/, V(236)/1.1162102099838499D-2/
- DATA U(237)/9.2771245672230869D-1/, V(237)/1.2151604671088320D-2/
- DATA U(238)/9.1507142312089807D-1/, V(238)/1.3128229566961573D-2/
- DATA U(239)/9.0146063531585234D-1/, V(239)/1.4090941772314861D-2/
- DATA U(240)/8.8689451740242042D-1/, V(240)/1.5038721026994938D-2/
- DATA U(241)/8.7138850590929650D-1/, V(241)/1.5970562902562291D-2/
- DATA U(242)/8.5495903343460146D-1/, V(242)/1.6885479864245172D-2/
- DATA U(243)/8.3762351122818712D-1/, V(243)/1.7782502316045261D-2/
- DATA U(244)/8.1940031073793168D-1/, V(244)/1.8660679627411467D-2/
- DATA U(245)/8.0030874413914082D-1/, V(245)/1.9519081140145022D-2/
- DATA U(246)/7.8036904386743322D-1/, V(246)/2.0356797154333325D-2/
- DATA U(247)/7.5960234117664750D-1/, V(247)/2.1172939892191299D-2/
- DATA U(248)/7.3803064374440013D-1/, V(248)/2.1966644438744349D-2/
- DATA U(249)/7.1567681234896763D-1/, V(249)/2.2737069658329374D-2/
- DATA U(250)/6.9256453664217156D-1/, V(250)/2.3483399085926220D-2/
- DATA U(251)/6.6871831004391615D-1/, V(251)/2.4204841792364691D-2/
- DATA U(252)/6.4416340378496712D-1/, V(252)/2.4900633222483610D-2/
- DATA U(253)/6.1892584012546857D-1/, V(253)/2.5570036005349361D-2/
- DATA U(254)/5.9303236477757208D-1/, V(254)/2.6212340735672414D-2/
- DATA U(255)/5.6651041856139717D-1/, V(255)/2.6826866725591762D-2/
- DATA U(256)/5.3938810832435744D-1/, V(256)/2.7412962726029243D-2/
- DATA U(257)/5.1169417715466767D-1/, V(257)/2.7970007616848334D-2/
- DATA U(258)/4.8345797392059636D-1/, V(258)/2.8497411065085386D-2/
- DATA U(259)/4.5470942216774301D-1/, V(259)/2.8994614150555237D-2/
- DATA U(260)/4.2547898840730055D-1/, V(260)/2.9461089958167906D-2/
- DATA U(261)/3.9579764982890860D-1/, V(261)/2.9896344136328386D-2/
- DATA U(262)/3.6569686147231364D-1/, V(262)/3.0299915420827594D-2/
- DATA U(263)/3.3520852289262542D-1/, V(263)/3.0671376123669149D-2/
- DATA U(264)/3.0436494435449635D-1/, V(264)/3.1010332586313837D-2/
- DATA U(265)/2.7319881259104914D-1/, V(265)/3.1316425596861356D-2/
- DATA U(266)/2.4174315616384001D-1/, V(266)/3.1589330770727167D-2/
- DATA U(267)/2.1003131046056720D-1/, V(267)/3.1828758894411006D-2/
- DATA U(268)/1.7809688236761860D-1/, V(268)/3.2034456231992663D-2/
- DATA U(269)/1.4597371465489694D-1/, V(269)/3.2206204794030251D-2/
- DATA U(270)/1.1369585011066592D-1/, V(270)/3.2343822568575928D-2/
- DATA U(271)/8.1297495464425559D-2/, V(271)/3.2447163714064269D-2/
- DATA U(272)/4.8812985136049731D-2/, V(272)/3.2516118713868836D-2/
- DATA U(273)/1.6276744849602970D-2/, V(273)/3.2550614492363166D-2/
-
- IF(KTBA(MIN(MAX(1,N),97)) .EQ. 0) THEN
- X(1)=0
- WRITE(ERRTXT,101) N
- CALL MTLPRT(NAME(MODE),'D107.1',ERRTXT)
- RETURN
- ENDIF
- ALFA=HF*(B+A)
- BETA=HF*(B-A)
- IF(MODE .EQ. 1) THEN
- SUM=0
- J1=MOD(N,2)
- J2=KTBA(N)+(N-1)/2
- DO 1 J = KTBA(N),J2-J1
- DELTA=BETA*U(J)
- SUM=SUM+V(J)*(F(ALFA+DELTA)+F(ALFA-DELTA))
- 1 CONTINUE
- IF(J1 .EQ. 1) SUM=SUM+V(J2)*F(ALFA)
- X(1)=BETA*SUM
- ELSE
- J1=KTBA(N)-1
- J2=N+1
- DO 2 J=1,J2/2
- WTEMP=BETA*V(J1+J)
- DELTA=BETA*U(J1+J)
- X(J)=ALFA-DELTA
- W(J)=WTEMP
- X(J2-J)=ALFA+DELTA
- W(J2-J)=WTEMP
- 2 CONTINUE
- ENDIF
- RETURN
- 101 FORMAT('N = ',I5,' IS NON-PERMISSIBLE')
- END
-
diff --git a/src/mathlib/gen/d/d501l1.F b/src/mathlib/gen/d/d501l1.F
deleted file mode 100644
index d16f244..0000000
--- a/src/mathlib/gen/d/d501l1.F
+++ /dev/null
@@ -1,626 +0,0 @@
-*
-* $Id: d501l1.F,v 1.2 2003/09/02 12:41:10 mclareni Exp $
-*
-* $Log: d501l1.F,v $
-* Revision 1.2 2003/09/02 12:41:10 mclareni
-* Version corrected by D.A. and C.H. (Aug 2003).
-* After column pivoting the components of the covariance matrix were not
-* restored in the correct order by using the JPVT vector. This resulted in a
-* quasi-random reshuffling of the errors in output.
-*
-* Revision 1.1.1.1 1996/04/01 15:02:19 mclareni
-* Mathlib gen
-*
-* Version corrected by D.A. and C.H. (Aug 2003)
-* After coloumn pivoting the components of the covariance
-* matrix were not restored in the correct order by using the
-* JPVT vector. This resulted in a quasi-random reshuffling of
-* the errors in output
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE D501L1(VERS,SUB,K,N,X,NX,Y,SY,MODE,EPS,MAXIT,
- 1 IPRT,M,A,AL,AU,PHI1,DPHI,IAFR,MFR,
- 2 COV,NC,STD,P,LAMU,DSCAL,W1,W2,W3,TAU,
- 3 COPYF,COPYDF,R2,R1,F,DF,JPVT,NERROR)
-
-#include "gen/imp64.inc"
-#include "gen/def64.inc"
- + JP2,LAMBDA,LAMU,LK,MY
- CHARACTER VERS*6
- LOGICAL LFN,LID,LRP,LPR
- DIMENSION X(*),Y(*),SY(*),A(*),AL(*),AU(*),DPHI(*),F(*),DF(N,*)
- DIMENSION STD(*),P(*),LAMU(*),DSCAL(*),W1(*),W2(*),W3(*),COV(NC,*)
- DIMENSION IAFR(*),TAU(*),JPVT(*),COPYF(*),COPYDF(N+M,*)
- DIMENSION R1(M,*),R2(M,*)
- DIMENSION W64(64)
-
- PARAMETER (Z0 = 0, Z1 = 1, HALF = Z1/2, R3 = Z1/3, R10 = Z1/10)
- PARAMETER (SIG1 = R10, SIG2 = 11*R10, COEF = R10**3, STEP = Z1)
- PARAMETER (RHO1 = R10**4, RHO2 = Z1/4, RHO3 = 3*Z1/4)
-
- EXTERNAL SUB
-
-************************************************************************
-* LEAMAX, VERSION: 15.03.1993
-************************************************************************
-*
-* THIS ROUTINE IS ONE OF THE MAIN ROUTINE OF THE LEAMAX PACKAGE.
-* IT SOLVES TWO DIFFERENT PROBLEMS DEPENDING ON THE VALUE
-* OF THE PARAMETER VERS.
-* ( VERS = DSUMSQ : GENERAL NONLINEAR LEAST SQUARES PROBLEM
-* VERS = DFUNFT : LEAST SQUARES DATA FITTING PROBLEM )
-*
-* IN ALL CASES BOUNDS ON THE VARIABLES MAY BE SET.
-*
-************************************************************************
-
-************************************************************************
-* COMPUTE AN APPROXIMATION EPS0 TO THE RELATIVE MACHINE PRECISION
-************************************************************************
-
- EPS0=Z1
- 5 EPS0=EPS0/10
- IF (Z1+EPS0 .NE. Z1) GO TO 5
- EPS0=10*EPS0
-
-************************************************************************
-* CHECK THE VAUES OF INPUT PARAMETERS
-************************************************************************
-
- NERROR=0
-
- CALL D501P1(K,N,NC,X,NX,Y,SY,MODE,EPS0,EPS,MAXIT,IPRT,M,A,AL,AU,
- + NERROR,VERS)
-
- IF (NERROR .NE. 0) RETURN
-
-************************************************************************
-* SET INITIAL VALUES
-************************************************************************
-
- EPS1=10*EPS0
-
- LFN=.FALSE.
- LID=.FALSE.
- LRP=.FALSE.
- LPR=IPRT .NE. 0
-
- ITER=0
-
- CALL DVSET(M,Z1,DSCAL(1),DSCAL(2))
- CALL DVSET(M,Z0,LAMU(1),LAMU(2))
- CALL DVSET(M,Z0,STD(1),STD(2))
-
-************************************************************************
-* COMPUTE INITIAL VALUE PHI1 OF OBJECTIVE FUNCTION
-************************************************************************
-
- CALL D501SF(VERS,SUB,0,M,A,N,F,DF,K,NX,X,Y,SY,W2,NERROR)
- IF (NERROR .NE. 0) RETURN
- PHI1=HALF*DVMPY(N,F(1),F(2),F(1),F(2))
-
-************************************************************************
-* COMPUTE F, DF, DPHI, DSCAL, LAMU, MFR, IAFR
-************************************************************************
-
- CALL D501N1(K,N,M,A,AL,AU,X,NX,Y,SY,W2,DPHI,DSCAL,LAMU,F,DF,IAFR,
- + MFR,SUB,EPS0,EPS1,MODE,VERS,NERROR)
- IF(NERROR .NE. 0) RETURN
-
-************************************************************************
-* IF MFR = 0 MINIMUM IN A CORNER; STOP ITERATION
-************************************************************************
-
- IF(MFR .EQ. 0) GO TO 230
-
-************************************************************************
-* ITERATION BEGINS
-************************************************************************
-
- DELTA=0
- LAMBDA=0
-
-************************************************************************
-* COMPUTE THE L2-NORM OF THE PROJECTED GRADIENT
-************************************************************************
-
- DPHINO=0
- DO 10 I=1,MFR
- 10 DPHINO=DPHINO+DPHI(IAFR(I))**2
- DPHINO=SQRT(DPHINO)
-
- IF(LPR) CALL D501P2(LRP,M,A,DPHI,STD,LAMU,PHI1,DPHINO,ITER,LFN,
- + MODE,VERS)
-
- DA=0
- DO 20 I=1,MFR
- 20 DA=DA+(DSCAL(I)*A(IAFR(I)))**2
- DA=SQRT(DA)
-
-************************************************************************
-* ITERATION WITH GAUSS-NEWTON STEP
-************************************************************************
-
- 30 LAMBDA=0
-
-************************************************************************
-* COPY F AND DF
-* COMPUTE THE QR FACTORIZATION WITH COLUMN PIVOTING OF DF
-* AND SOLVE THE LINEAR LEAST SQUARES PROBLEM USING
-* LAPACK ROUTINES DGEQPF , DORMQR , DTRTRS
-************************************************************************
-
- CALL DVSCL(N,-Z1,F(1),F(2),COPYF(1),COPYF(2))
- CALL DMCPY(N,MFR,DF(1,1),DF(1,2),DF(2,1),COPYDF(1,1),
- 1 COPYDF(1,2),COPYDF(2,1))
-C**** KSK 25.07.95
- DO 31 NN = 1,MFR
- 31 JPVT(NN)=0
-C CALL DVSET(MFR,Z0,JPVT(1),JPVT(2))
-C**** KSK 25.07.95
-
- CALL DGEQPF(N,MFR,COPYDF,N+M,JPVT,TAU,W3,INFO)
- IF (INFO .NE. 0) THEN
- NERROR=4
- RETURN
- ENDIF
-
- CALL DORMQR('L','T',N,1,MFR,COPYDF,N+M,TAU,COPYF,N,W64,64,INFO)
- IF (INFO .NE. 0) THEN
- NERROR=4
- RETURN
- ENDIF
-
- CALL DTRTRS('U','N','N',MFR,1,COPYDF,N+M,COPYF,N,INFO)
- IF (INFO .NE. 0) THEN
- NERROR=4
- RETURN
- ENDIF
-
- DO 40 I=1,MFR
- 40 P(JPVT(I))=COPYF(I)
-
-************************************************************************
-* COMPUTE THE MATRIX R2
-************************************************************************
-
- DO 50 I=1,MFR
- DO 50 J=1,MFR
- IF (I .GT. J) THEN
- R1(I,J)=0
- ELSE
- R1(I,J)=COPYDF(I,J)
- ENDIF
- 50 CONTINUE
-
- DO 60 I=1,MFR
- DO 60 J=1,MFR
-C 60 R2(I,J)=R1(I,JPVT(J))
-C D.A. & C.H. Aug 2003
- 60 R2(I,JPVT(J))=R1(I,J)
-
- CALL DMMLT(MFR,MFR,MFR,R2(1,1),R2(2,1),R2(1,2),R2(1,1),R2(1,2),
- + R2(2,1),COV(1,1),COV(1,2),COV(2,1),W2)
-
-************************************************************************
-* COMPUTE THE L2-NORM OF THE SCALED VECTOR P
-************************************************************************
-
- DP=0
- DO 70 I=1,MFR
- 70 DP=DP+(DSCAL(I)*P(I))**2
- DP=SQRT(DP)
-
-************************************************************************
-* COMPUTE THE STEP SIZE ALFA
-************************************************************************
-
- ALFA=1
- DO 80 I=1,MFR
- IF(P(I) .NE. 0) THEN
- IF(P(I) .GT. 0) THEN
- ALFA1=AU(IAFR(I))
- ELSE
- ALFA1=AL(IAFR(I))
- ENDIF
- ALFA1=(ALFA1-A(IAFR(I)))/P(I)
- IF(ALFA1 .EQ. 0) THEN
- P(I)=0
- ELSE
- ALFA=MIN(ALFA,ALFA1)
- ENDIF
- ENDIF
- 80 CONTINUE
-
-************************************************************************
-* COMPUTE INITIAL DELTA IF NECESSARY
-************************************************************************
-
- IF(.NOT.LID) THEN
- DELTA=STEP*MAX(DA,DP/SIG2)
- LID=.TRUE.
- ENDIF
- IF(DELTA .LE. EPS*DA) GO TO 230
-
-************************************************************************
-* CONTINUATION WITH GAUSS-NEWTON OR SWITCHING TO LEVENBERG-MARQUARDT?
-************************************************************************
-
- IF(DP .GT. SIG2*DELTA) THEN
-
-***********************************************************************
-* DO THE LEVENBERG - MARQUARDT STEP, (HEBDEN'S METHOD).
-* - COMPUTE THE LM - PARAMETER LAMBDA
-* - COMPUTE THE CORRESPONDING STEP P, ITS DP AND ALFA.
-***********************************************************************
-
- DO 90 I=1,MFR
- 90 STD(I)=-DPHI(IAFR(I))
-
- UK=0
- DO 100 I=1,MFR
- 100 UK=UK+(DPHI(IAFR(I))/DSCAL(I))**2
- UK=SQRT(UK)/DELTA
-
-************************************************************************
-* COMPUTE INITIAL LAMBDA
-************************************************************************
-
- LAMBDA=COEF*UK
-
- LK=0
- ITERA=0
-
- 110 ITERA=ITERA+1
- IF(ITERA .GE. 50) GO TO 230
-
-************************************************************************
-* RESET LAMBDA IF NECESSARY
-************************************************************************
-
- IF(LK .GE. LAMBDA .OR. LAMBDA .GE. UK)
- + LAMBDA=MAX(COEF*UK,SQRT(LK*UK))
-
-************************************************************************
-* COMPUTE NEW P FOR NEW LAMBDA
-************************************************************************
-
-************************************************************************
-* COPY F AND DF, AND EXTEND DF BY SQRT(LAMBDA) * DIAG(DSCAL(I))
-* COMPUTE THE QR FACTORIZATION WITH COLUMN PIVOTING OF EXTENDED DF
-* AND SOLVE THE LINEAR LEAST SQUARES PROBLEM USING LAPACK ROUTINES
-* DGEQPF , DORMQR , DTRTRS
-************************************************************************
-
- CALL DVSET(N+MFR,Z0,COPYF(1),COPYF(2))
- CALL DVSCL(N,-Z1,F(1),F(2),COPYF(1),COPYF(2))
- CALL DMSET(N+MFR,MFR,Z0,COPYDF(1,1),COPYDF(1,2),COPYDF(2,1))
- CALL DMCPY(N,MFR,DF(1,1),DF(1,2),DF(2,1),
- + COPYDF(1,1),COPYDF(1,2),COPYDF(2,1))
- DO 120 I=1,MFR
- 120 COPYDF(N+I,I)=SQRT(LAMBDA)*DSCAL(I)
-C**** KSK 25.07.95
- DO 121 NN = 1,MFR
- 121 JPVT(NN)=0
-C CALL DVSET(MFR,Z0,JPVT(1),JPVT(2))
-C**** KSK 25.07.95
-
- CALL DGEQPF(N+MFR,MFR,COPYDF,N+M,JPVT,TAU,W3,INFO)
- IF (INFO .NE. 0) THEN
- NERROR=4
- RETURN
- ENDIF
-
- CALL DORMQR('L','T',N+MFR,1,MFR,COPYDF,N+M,TAU,COPYF,
- + N+MFR,W64,64,INFO)
- IF (INFO .NE. 0) THEN
- NERROR=4
- RETURN
- ENDIF
-
- CALL DTRTRS('U','N','N',MFR,1,COPYDF,N+M,COPYF,N+MFR,INFO)
- IF (INFO .NE. 0) THEN
- NERROR=4
- RETURN
- ENDIF
-
- DO 130 I=1,MFR
- 130 P(JPVT(I))=COPYF(I)
-
-
-************************************************************************
-* STOP ITERATION?
-************************************************************************
-
- DP=0
- DO 140 I=1,MFR
- 140 DP=DP+(DSCAL(I)*P(I))**2
- DP=SQRT(DP)
-
- IF(SIG1*DELTA .GT. DP .OR. DP .GT. SIG2*DELTA) THEN
-
-************************************************************************
-* CONTINUE ITERATION FOR LAMBDA
-************************************************************************
-
- IF(DP .LE. 0) GO TO 230
- P1=DP-DELTA
- DO 150 I=1,MFR
- 150 W1(I)=DSCAL(I)**2*P(I)
-
-************************************************************************
-* COMPUTE THE MATRIX R1
-************************************************************************
-
- DO 160 I=1,MFR
- DO 160 J=1,MFR
- IF (I .GT. J) THEN
- R1(I,J)=0
- ELSE
- R1(I,J)=COPYDF(I,J)
- ENDIF
- 160 CONTINUE
-
- DO 170 I=1,MFR
- DO 170 J=1,MFR
-C 170 R2(I,J)=R1(I,JPVT(J))
-C D.A. & C.H. Aug 2003
- 170 R2(I,JPVT(J))=R1(I,J)
-
- CALL DMMLT(MFR,MFR,MFR,R2(1,1),R2(2,1),R2(1,2),R2(1,1),R2(1,2),
- + R2(2,1),R1(1,1),R1(1,2),R1(2,1),W2)
-
- CALL DSINV(MFR,R1,M,NERROR)
- IF (NERROR .NE. 0) THEN
- NERROR=4
- RETURN
- ENDIF
-
- P1P=-DMBIL(MFR,W1(1),W1(2),R1(1,1),R1(1,2),R1(2,1),
- + W1(1),W1(2))/DP
-
-************************************************************************
-* UPDATE LK, UK, LAMBDA
-************************************************************************
-
- IF(P1 .LT. 0) UK=LAMBDA
- LK=MAX(LK,LAMBDA-P1/P1P)
- IF(LK .GE. UK) UK=2*LK
- LAMBDA=LAMBDA-(DP/DELTA)*(P1/P1P)
- GO TO 110
- ENDIF
- ENDIF
-
-************************************************************************
-* END OF LEVENBERG - MARQUARDT STEP
-************************************************************************
-
- ALFA=1
- DO 180 I=1,MFR
- IF(P(I) .NE. 0) THEN
- IF(P(I) .GT. 0) THEN
- ALFA1=AU(IAFR(I))
- ELSE
- ALFA1=AL(IAFR(I))
- ENDIF
- ALFA1=(ALFA1-A(IAFR(I)))/P(I)
- IF(ALFA1 .EQ. 0) THEN
- P(I)=0
- ELSE
- ALFA=MIN(ALFA,ALFA1)
- ENDIF
- ENDIF
- 180 CONTINUE
-
-************************************************************************
-* COMPUTE A + ALPHA * P
-************************************************************************
-
- CALL DVCPY(M,A(1),A(2),W1(1),W1(2))
- DO 190 I=1,MFR
- 190 W1(IAFR(I))=A(IAFR(I))+ALFA*P(I)
-
-************************************************************************
-* COMPUTE VALUE PHI2 OF THE OBJECTIVE FUNCTION
-************************************************************************
-
- CALL D501SF(VERS,SUB,0,M,W1,N,F,DF,K,NX,X,Y,SY,W2,NERROR)
- IF (NERROR .NE. 0) RETURN
-
- PHI2=HALF*DVMPY(N,F(1),F(2),F(1),F(2))
-
- PHMAXI=1
- IF(PHI1 .GT. 0) PHMAXI=1/SQRT(PHI1)
- CALL DVSCL(MFR,PHMAXI,P(1),P(2),W2(1),W2(2))
- JP2=DMBIL(MFR,W2(1),W2(2),COV(1,1),COV(1,2),COV(2,1),W2(1),W2(2))
-
-************************************************************************
-* COMPUTE THE APPROXIMATION MEASURE RHO AND THE UPDATING FACTOR MY
-* FOR DELTA
-************************************************************************
-
- IF(PHI1 .LE. 0) THEN
- RHO=1
- MY=HALF
- ELSE
- S2=LAMBDA*DP**2/PHI1
- S3=1-PHI2/PHI1
- S4=HALF*JP2+S2
- IF(S4 .EQ. 0) THEN
- RHO=1
- MY=R10
- ELSE
- RHO=0
- IF(S3 .GT. 0) RHO=S3/S4
- MY=-HALF*(JP2+S2)
- S2=2*MY+S3
- IF(S2 .EQ. 0) THEN
- MY=R10
- ELSEIF(S3 .EQ. 0) THEN
- MY=HALF
- ELSE
- MY=MIN(MAX(MY/S2,R10),HALF)
- ENDIF
- ENDIF
- ENDIF
-
-************************************************************************
-* END OF COMPUTATTION OF RHO AND MY
-************************************************************************
-
-************************************************************************
-* IF RHO .LE. RHO1, REDUCE DELTA BY FACTOR MY AND MAKE NEW LEVENBERG-
-* MARQUARDT STEP, OTHERWISE ACCEPT P
-************************************************************************
-
- IF(RHO .LE. RHO1) THEN
- DELTA=MY*DELTA
- DA=0
- DO 200 I=1,MFR
- 200 DA=DA+(DSCAL(I)*A(IAFR(I)))**2
- DA=SQRT(DA)
- GO TO 30
- ENDIF
- CALL DVCPY(M,W1(1),W1(2),A(1),A(2))
- DA=0
- DO 210 I=1,MFR
- 210 DA=DA+(DSCAL(I)*A(IAFR(I)))**2
- DA=SQRT(DA)
- MFROLD=MFR
-
-************************************************************************
-* COMPUTE F, DF, DPHI, DSCAL, LAMU, MFR, IAFR
-************************************************************************
-
- CALL D501N1(K,N,M,A,AL,AU,X,NX,Y,SY,W2,DPHI,DSCAL,LAMU,F,DF,IAFR,
- + MFR,SUB,EPS0,EPS1,MODE,VERS,NERROR)
- IF(NERROR .NE. 0) RETURN
-
-************************************************************************
-* IF MFR = 0 MINIMUM IN A CORNER; STOP ITERATION
-************************************************************************
-
- IF(MFR .EQ. 0) THEN
- ITER=ITER+1
- GO TO 230
- ENDIF
-
-************************************************************************
-* COMPUTE THE L2-NORM OF THE PROJECTED GRADIENT
-************************************************************************
-
- DPHINO=0
- DO 220 I=1,MFR
- 220 DPHINO=DPHINO+DPHI(IAFR(I))**2
- DPHINO=SQRT(DPHINO)
-
-************************************************************************
-* TERMINATION CRITERION
-************************************************************************
-
- IF ( PHI2 .LE. PHI1
- 1 .AND. PHI1-PHI2 .LE. EPS*(1+ABS(PHI2))
- 2 .AND. DP .LE. SQRT(EPS)*(1+DA)
- 3 .AND. DPHINO .LE. EPS**R3*(1+ABS(PHI2))) LFN=.TRUE.
-
- ITER=ITER+1
- PHI1=PHI2
-
- IF(.NOT.LFN) THEN
- CALL D501SF(VERS,SUB,0,M,A,N,F,DF,K,NX,X,Y,SY,W2,NERROR)
- IF (NERROR .NE. 0) RETURN
- PHI1=HALF*DVMPY(N,F(1),F(2),F(1),F(2))
-
- IF(LPR) THEN
- IF((MOD(ITER,IPRT) .EQ. 0 .OR. ITER .GE. MAXIT))
- 1 CALL D501P2(LRP,M,A,DPHI,STD,LAMU,PHI1,DPHINO,ITER,LFN,
- 2 MODE,VERS)
- ENDIF
-
- IF(ITER .GE. MAXIT) THEN
- NERROR=2
- GO TO 230
- ENDIF
-
-************************************************************************
-* UPDATE DELTA AND GO BACK TO GAUSS-NEWTON STEP
-************************************************************************
-
- IF(MFROLD .NE. MFR) LID=.FALSE.
- IF(RHO .LE. RHO2) THEN
- DELTA=MY*DELTA
- ELSE IF(RHO .GE. RHO3 .OR. LAMBDA .EQ. 0) THEN
- DELTA=2*DP
- ENDIF
- GO TO 30
- ENDIF
-
-************************************************************************
-* END OF ITERATION
-************************************************************************
-
- 230 LFN=.TRUE.
-
-************************************************************************
-* COMPUTE F, DF, DPHI, DSCAL, LAMU, MFR, IAFR
-************************************************************************
-
- CALL D501N1(K,N,M,A,AL,AU,X,NX,Y,SY,W2,DPHI,DSCAL,LAMU,F,DF,IAFR,
- + MFR,SUB,EPS0,EPS1,MODE,VERS,MERROR)
- IF(MERROR .NE. 0) THEN
- NERROR=MERROR
- RETURN
- ENDIF
-
-************************************************************************
-* COMPUTE THE L2-NORM OF THE PROJECTED GRADIENT
-************************************************************************
-
- DPHINO=0
- DO 240 I=1,MFR
- 240 DPHINO=DPHINO+DPHI(IAFR(I))**2
- DPHINO=SQRT(DPHINO)
-
-************************************************************************
-* COMPUTE THE VALUE PHI1 OF THE OBJECTIVE FUNCTION
-************************************************************************
-
- PHI1=HALF*DVMPY(N,F(1),F(2),F(1),F(2))
-
-************************************************************************
-* COMPUTE THE COVARIANCE MATRIX COV AND THE STANDARD DEVIATION STD
-* FOR THE FREE VARIABLES
-************************************************************************
-
- CALL DVSET(M,Z0,STD(1),STD(2))
-
- IF(MFR .GT. 0) THEN
-
- CALL DSINV(MFR,COV,NC,MERROR)
- IF(MERROR .NE. 0) THEN
- NERROR=4
- RETURN
- ENDIF
-
- S=2*PHI1
- IF(N .NE. MFR) S=S/(N-MFR)
- CALL DMSCL(MFR,MFR,S,COV(1,1),COV(1,2),COV(2,1),
- + COV(1,1),COV(1,2),COV(2,1))
- DO 250 I=1,MFR
- 250 STD(IAFR(I))=SQRT(COV(I,I))
- ENDIF
-
-************************************************************************
-* PRINT LAST ITERATION RESULTS
-************************************************************************
-
- IF(LPR) CALL D501P2(LRP,M,A,DPHI,STD,LAMU,PHI1,DPHINO,ITER,LFN,
- + MODE,VERS)
-
- RETURN
-
- END
-
-
-
diff --git a/src/mathlib/gen/d/d501l2.F b/src/mathlib/gen/d/d501l2.F
deleted file mode 100644
index 1db2b2b..0000000
--- a/src/mathlib/gen/d/d501l2.F
+++ /dev/null
@@ -1,489 +0,0 @@
-*
-* $Id: d501l2.F,v 1.1.1.1 1996/04/01 15:02:19 mclareni Exp $
-*
-* $Log: d501l2.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:19 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE D501L2(K,N,X,NX,MODE,EPS,MAXIT,IPRT,M,A,AL,AU,
- 1 PHI1,DPHI,IAFR,MFR,STD,P,LAMU,DSCAL,B,W1,W2,
- 2 AM,COV,SUB,NERROR)
-
-#include "gen/imp64.inc"
-#include "gen/def64.inc"
- + JP2,LAMBDA,LAMU,LK,MY
- LOGICAL LFN,LID,LRP,LPR
- DIMENSION X(*),A(*),AL(*),AU(*),DPHI(*),STD(*),P(*),LAMU(*)
- DIMENSION DSCAL(*),B(*),W1(*),W2(*),AM(M,*),COV(M,*),IAFR(*)
- PARAMETER (Z0 = 0, Z1 = 1, HALF = Z1/2, R3 = Z1/3, R10 = Z1/10)
- PARAMETER (SIG1 = R10, SIG2 = 11*R10, COEF = R10**3, STEP = Z1)
- PARAMETER (RHO1 = R10**4, RHO2 = Z1/4, RHO3 = 3*Z1/4)
- EXTERNAL SUB
-
-************************************************************************
-* LEAMAX, VERSION: 15.03.1993
-************************************************************************
-*
-* THIS ROUTINE IS ONE OF THE MAIN ROUTINES OF THE LEAMAX PACKAGE
-* FOR SOLVING THE PROBLEM OF MAXIMUM LIKELIHOOD ESTIMATION.
-* BOUNDS ON THE VARIABLES MAY BE SET.
-*
-************************************************************************
-
-************************************************************************
-* COMPUTE AN APPROXIMATION EPS0 TO THE RELATIVE MACHINE PRECISION
-************************************************************************
-
- EPS0=Z1
- 10 EPS0=EPS0/10
- IF (Z1+EPS0 .NE. Z1) GO TO 10
- EPS0=10*EPS0
-
-************************************************************************
-* CHECK THE VALUES OF INPUT PARAMETERS
-************************************************************************
-
- NERROR=0
-
- CALL D501P1(K,N,M,X,NX,Y,SY,MODE,EPS0,EPS,MAXIT,IPRT,M,A,AL,AU,
- + NERROR,'DMAXLK')
-
- IF(NERROR .NE. 0) RETURN
-
-************************************************************************
-* SET INITIAL VALUES
-************************************************************************
-
- EPS1=10*EPS0
-
- LFN=.FALSE.
- LID=.FALSE.
- LRP=.FALSE.
- LPR=IPRT .NE. 0
-
- ITER=0
-
- CALL DVSET(M,Z1,DSCAL(1),DSCAL(2))
- CALL DVSET(M,Z0,LAMU(1),LAMU(2))
- CALL DVSET(M,Z0,STD(1),STD(2))
-
-************************************************************************
-* COMPUTE INITIAL VALUE PHI1 OF OBJECTIVE FUNCTION
-************************************************************************
-
- PHI1=0
- IX=1
- DO 20 I=1,N
- CALL SUB(K,X(IX),M,A,F0,ZZ,0,NERROR)
- IF(F0 .LE. 0 .OR. NERROR .NE. 0) THEN
- NERROR=3
- RETURN
- ENDIF
- PHI1=PHI1-LOG(F0)
- 20 IX=IX+NX
-
-************************************************************************
-* COMPUTE J(TRANS) X J, B, DPHI, DSCAL, LAMU, MFR, IAFR
-************************************************************************
-
- CALL D501N2(K,N,M,A,AL,AU,X,NX,W1,B,DPHI,DSCAL,LAMU,AM,COV,
- + IAFR,MFR,SUB,EPS0,EPS1,MODE,NERROR)
- IF(NERROR .NE. 0) RETURN
-
-************************************************************************
-* IF MFR = 0 MINIMUM IN A CORNER; STOP ITERATION
-************************************************************************
-
- IF(MFR .EQ. 0) GO TO 190
-
-************************************************************************
-* ITERATION BEGINS
-************************************************************************
-
- DELTA=0
- LAMBDA=0
-
-************************************************************************
-* COMPUTE THE L2-NORM OF THE PROJECTED GRADIENT
-************************************************************************
-
- DPHINO=SQRT(DVMPY(MFR,B(1),B(2),B(1),B(2)))
-
- IF(LPR) CALL D501P2(LRP,M,A,DPHI,STD,LAMU,PHI1,DPHINO,ITER,LFN,
- + MODE,'DMAXLK')
-
- DA=0
- DO 40 I=1,MFR
- 40 DA=DA+(DSCAL(I)*A(IAFR(I)))**2
- DA=SQRT(DA)
-
-************************************************************************
-* ITERATION WITH GAUSS-NEWTON STEP
-************************************************************************
-
- 50 LAMBDA=0
-
-************************************************************************
-* SOLVE NORMAL EQUATIONS
-************************************************************************
-
- CALL DVSCL(MFR,-Z1,B(1),B(2),W1(1),W1(2))
- CALL DSINV(MFR,AM,M,NERROR)
-
- IF(NERROR .NE. 0) THEN
- NERROR=4
- RETURN
- ENDIF
- CALL DMMPY(MFR,MFR,AM(1,1),AM(1,2),AM(2,1),W1(1),W1(2),P(1),P(2))
-
-
-************************************************************************
-* COMPUTE THE L2-NORM OF THE SCALED VECTOR P
-************************************************************************
-
- DP=0
- DO 60 I=1,MFR
- 60 DP=DP+(DSCAL(I)*P(I))**2
- DP=SQRT(DP)
-
-************************************************************************
-* COMPUTE THE STEP SIZE ALFA
-************************************************************************
-
- ALFA=1
- DO 70 I=1,MFR
- IF(P(I) .NE. 0) THEN
- IF(P(I) .GT. 0) THEN
- ALFA1=AU(IAFR(I))
- ELSE
- ALFA1=AL(IAFR(I))
- ENDIF
- ALFA1=(ALFA1-A(IAFR(I)))/P(I)
- IF(ALFA1 .EQ. 0) THEN
- P(I)=0
- ELSE
- ALFA=MIN(ALFA,ALFA1)
- ENDIF
- ENDIF
- 70 CONTINUE
-
-************************************************************************
-* COMPUTE INITIAL DELTA IF NECESSARY
-************************************************************************
-
- IF(.NOT.LID) THEN
- DELTA=STEP*MAX(DA,DP/SIG2)
- LID=.TRUE.
- ENDIF
- IF(DELTA .LE. EPS*DA) GO TO 190
-
-************************************************************************
-* CONTINUATION WITH GAUSS-NEWTON OR SWITCHING TO LEVENBERG-MARQUARDT?
-************************************************************************
-
- IF(DP .GT. SIG2*DELTA) THEN
-
-************************************************************************
-* DO THE LEVENBERG - MARQUARDT STEP, (HEBDEN'S METHOD).
-* - COMPUTE THE LM - PARAMETER LAMBDA
-* - COMPUTE THE CORRESPONDING STEP P, ITS DP AND ALFA.
-************************************************************************
-
- CALL DVSCL(MFR,-Z1,B(1),B(2),STD(1),STD(2))
- UK=0
- DO 80 I=1,MFR
- 80 UK=UK+(DPHI(IAFR(I))/DSCAL(I))**2
- UK=SQRT(UK)/DELTA
-
-************************************************************************
-* COMPUTE INITIAL LAMBDA
-************************************************************************
-
- LAMBDA=COEF*UK
-
- LK=0
- ITERA=0
-
- 90 ITERA=ITERA+1
- IF(ITERA .GE. 50) GO TO 190
-
-************************************************************************
-* RESET LAMBDA IF NECESSARY
-************************************************************************
-
- IF(LK .GE. LAMBDA .OR. LAMBDA .GE. UK)
- + LAMBDA=MAX(COEF*UK,SQRT(LK*UK))
-
-************************************************************************
-* COMPUTE NEW P FOR NEW LAMBDA
-************************************************************************
-
- CALL DMCPY(MFR,MFR,COV(1,1),COV(1,2),COV(2,1),
- + AM(1,1),AM(1,2),AM(2,1))
- DO 100 I=1,MFR
- 100 AM(I,I)=AM(I,I)+LAMBDA*DSCAL(I)**2
-
-************************************************************************
-* SOLVE NORMAL EQUATIONS
-************************************************************************
-
- CALL DSINV(MFR,AM,M,NERROR)
- IF(NERROR .NE. 0) THEN
- NERROR=4
- RETURN
- ENDIF
- CALL DMMPY(MFR,MFR,AM(1,1),AM(1,2),AM(2,1),STD(1),STD(2),
- + P(1),P(2))
-
-************************************************************************
-* COMPUTE THE L2-NORM OF THE SCALED VECTOR P
-************************************************************************
-
- DP=0
- DO 110 I=1,MFR
- 110 DP=DP+(DSCAL(I)*P(I))**2
- DP=SQRT(DP)
-
-************************************************************************
-* STOP ITERATION IN THE CASE OF NORM EQUAL TO ZERO
-************************************************************************
-
- IF (DP .LE. 0) GO TO 190
-
- IF(SIG1*DELTA .GT. DP .OR. DP .GT. SIG2*DELTA) THEN
-
-************************************************************************
-* CONTINUE ITERATION FOR LAMBDA
-************************************************************************
-
- P1=DP-DELTA
- DO 120 I=1,MFR
- 120 W1(I)=DSCAL(I)**2*P(I)
- P1P=-DMBIL(MFR,W1(1),W1(2),AM(1,1),AM(1,2),AM(2,1),
- + W1(1),W1(2))/DP
-
-************************************************************************
-* UPDATE LK, UK, LAMBDA
-************************************************************************
-
- IF(P1 .LT. 0) UK=LAMBDA
- LK=MAX(LK,LAMBDA-P1/P1P)
- IF(LK .GE. UK) UK=2*LK
- LAMBDA=LAMBDA-(DP/DELTA)*(P1/P1P)
- GO TO 90
- ENDIF
- ENDIF
-
-************************************************************************
-* END OF LEVENBERG - MARQUARDT STEP
-************************************************************************
-
- ALFA=1
- DO 130 I=1,MFR
- IF(P(I) .NE. 0) THEN
- IF(P(I) .GT. 0) THEN
- ALFA1=AU(IAFR(I))
- ELSE
- ALFA1=AL(IAFR(I))
- ENDIF
- ALFA1=(ALFA1-A(IAFR(I)))/P(I)
- IF(ALFA1 .EQ. 0) THEN
- P(I)=0
- ELSE
- ALFA=MIN(ALFA,ALFA1)
- ENDIF
- ENDIF
- 130 CONTINUE
-
-************************************************************************
-* COMPUTE A + ALPHA * P
-************************************************************************
- CALL DVCPY(M,A(1),A(2),W1(1),W1(2))
- DO 140 I=1,MFR
- 140 W1(IAFR(I))=A(IAFR(I))+ALFA*P(I)
-
-************************************************************************
-* COMPUTE VALUE PHI2 OF OBJECTIVE FUNCTION
-************************************************************************
-
- PHI2=0
- IX=1
- DO 150 I=1,N
- CALL SUB(K,X(IX),M,W1,F0,ZZ,0,NERROR)
- IF(F0 .LE. 0 .OR. NERROR .NE. 0) THEN
- NERROR=3
- RETURN
- ENDIF
- PHI2=PHI2-LOG(F0)
- 150 IX=IX+NX
-
- PHMAXI=1
- AAU=MAX(ABS(PHI1),ABS(PHI2))
- IF(AAU .GT. 0) PHMAXI=1/AAU
-
- CALL DVSCL(MFR,PHMAXI,P(1),P(2),W2(1),W2(2))
- JP2=DMBIL(MFR,W2(1),W2(2),COV(1,1),COV(1,2),COV(2,1),W2(1),W2(2))
-
-************************************************************************
-* COMPUTE THE APPROXIMATION MEASURE RHO AND THE UPDATING FACTOR MY
-* FOR DELTA
-************************************************************************
-
- IF(PHI1 .LE. PHI2) THEN
- RHO=0
- MY=R10
- ELSE
- S2=2*(PHI1-PHI2)*PHMAXI**2
- S3=LAMBDA*(DP*PHMAXI)**2
- RHO=S2/(JP2+2*S3)
- MY=-JP2-S3
- S2=S2+2*MY
- IF(S2 .EQ. 0) THEN
- MY=R10
- ELSE
- MY=MIN(MAX(MY/S2,R10),HALF)
- ENDIF
- ENDIF
-
-************************************************************************
-* END OF COMPUTATTION OF RHO AND MY
-************************************************************************
-
-************************************************************************
-* IF RHO .LE. RHO1, REDUCE DELTA BY FACTOR MY AND MAKE NEW LEVENBERG-
-* MARQUARDT STEP, OTHERWISE ACCEPT P
-************************************************************************
-
- IF(RHO .LE. RHO1) THEN
- DELTA=MY*DELTA
- DA=0
- DO 160 I=1,MFR
- 160 DA=DA+(DSCAL(I)*A(IAFR(I)))**2
- DA=SQRT(DA)
- GO TO 50
- ENDIF
- CALL DVCPY(M,W1(1),W1(2),A(1),A(2))
- DA=0
- DO 170 I=1,MFR
- 170 DA=DA+(DSCAL(I)*A(IAFR(I)))**2
- DA=SQRT(DA)
- MFROLD=MFR
-
-************************************************************************
-* COMPUTE J(TRANS) X J, B, DPHI, DSCAL, LAMU, MFR, IAFR
-************************************************************************
-
- CALL D501N2(K,N,M,A,AL,AU,X,NX,W1,B,DPHI,DSCAL,LAMU,AM,COV,
- + IAFR,MFR,SUB,EPS0,EPS1,MODE,NERROR)
- IF(NERROR .NE. 0) RETURN
-
-************************************************************************
-* IF MFR = 0 MINIMUM IN A CORNER; STOP ITERATION
-************************************************************************
-
- IF(MFR .EQ. 0) THEN
- ITER=ITER+1
- GO TO 190
- ENDIF
-
-************************************************************************
-* COMPUTE THE L2-NORM OF THE PROJECTED GRADIENT
-************************************************************************
-
- DPHINO=SQRT(DVMPY(MFR,B(1),B(2),B(1),B(2)))
-
-************************************************************************
-* TERMINATION CRITERION
-************************************************************************
-
- IF ( PHI2 .LE. PHI1
- 1 .AND. PHI1-PHI2 .LE. EPS*(1+ABS(PHI2))
- 2 .AND. DP .LE. SQRT(EPS)*(1+DA)
- 3 .AND. DPHINO .LE. EPS**R3*(1+ABS(PHI2))) LFN=.TRUE.
-
- ITER=ITER+1
- PHI1=PHI2
-
- IF(.NOT.LFN) THEN
- IF(ITER .GE. MAXIT) THEN
- IF(LPR) CALL D501P2(LRP,M,A,DPHI,STD,LAMU,PHI1,DPHINO,ITER,LFN,
- + MODE,'DMAXLK')
- NERROR=2
- GO TO 190
- ENDIF
-
- IF(LPR) THEN
- IF(MOD(ITER,IPRT) .EQ. 0)
- 1 CALL D501P2(LRP,M,A,DPHI,STD,LAMU,PHI1,DPHINO,ITER,LFN,
- 2 MODE,'DMAXLK')
- ENDIF
-
-************************************************************************
-* UPDATE DELTA AND GO BACK TO GAUSS-NEWTON STEP
-************************************************************************
-
- IF(MFROLD .NE. MFR) LID=.FALSE.
- IF(RHO .LE. RHO2) THEN
- DELTA=MY*DELTA
- ELSE IF(RHO .GE. RHO3 .OR. LAMBDA .EQ. 0) THEN
- DELTA=2*DP
- ENDIF
-
- GO TO 50
-
- ENDIF
-
-************************************************************************
-* END OF ITERATION
-************************************************************************
-
- 190 LFN=.TRUE.
-
-************************************************************************
-* COMPUTE J(TRANS) X J, B, DPHI, DSCAL, LAMU, MFR, IAFR
-************************************************************************
-
- CALL D501N2(K,N,M,A,AL,AU,X,NX,W1,B,DPHI,DSCAL,LAMU,AM,COV,
- + IAFR,MFR,SUB,EPS0,EPS1,MODE,MERROR)
- IF(MERROR .NE. 0) THEN
- NERROR=MERROR
- RETURN
- ENDIF
-
-************************************************************************
-* COMPUTE THE L2-NORM OF THE PROJECTED GRADIENT
-************************************************************************
-
- DPHINO=SQRT(DVMPY(MFR,B(1),B(2),B(1),B(2)))
-
-************************************************************************
-* COMPUTE THE VALUE PHI1 OF THE OBJECTIVE FUNCTION
-************************************************************************
-
- PHI1=0
- IX=1
- DO 200 I=1,N
- CALL SUB(K,X(IX),M,A,F0,ZZ,0,MERROR)
- IF(F0 .LE. 0 .OR. MERROR .NE. 0) THEN
- NERROR=3
- RETURN
- ENDIF
- PHI1=PHI1-LOG(F0)
- 200 IX=IX+NX
-
-
-************************************************************************
-* PRINT LAST ITERATION RESULTS
-************************************************************************
-
- IF(LPR) CALL D501P2(LRP,M,A,DPHI,STD,LAMU,PHI1,DPHINO,ITER,LFN,
- + MODE,'DMAXLK')
-
- RETURN
-
- END
-
-
-
diff --git a/src/mathlib/gen/d/d501n1.F b/src/mathlib/gen/d/d501n1.F
deleted file mode 100644
index 28427de..0000000
--- a/src/mathlib/gen/d/d501n1.F
+++ /dev/null
@@ -1,141 +0,0 @@
-*
-* $Id: d501n1.F,v 1.1.1.1 1996/04/01 15:02:19 mclareni Exp $
-*
-* $Log: d501n1.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:19 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE D501N1(K,N,M,A,AL,AU,X,NX,Y,SY,WORK,DPHI,DSCAL,LAMU,
- + F,DF,IAFR,MFR,SUB,EPS0,EPS,MODE,VERS,NERROR)
-
-*************************************************************************
-* LEAMAX, VERSION: 15.03.1993
-*************************************************************************
-*
-* THIS ROUTINE COMPUTES FUNCTION VALUES, DERIVATIVES, THE GRADIENT,
-* AND THE SCALING PARAMETERS. IT ALSO DETERMINES THE ACTIVE SET OF
-* CONSTRAINTS AND THE LAGRANGE MULTIPLIER.
-*
-************************************************************************
-
-#include "gen/imp64.inc"
-#include "gen/def64.inc"
- + LAMU
- CHARACTER VERS*6
- DIMENSION A(*),AL(*),AU(*),X(*),Y(*),SY(*),WORK(*),DPHI(*)
- DIMENSION DSCAL(*),LAMU(*),F(*),DF(N,*),IAFR(*)
- EXTERNAL SUB
-
- PARAMETER (Z0 = 0)
-
-************************************************************************
-* COMPUTE INITIAL VALUES
-************************************************************************
-
- HREL=SQRT(EPS0)
- HABS=10*EPS0
-
- NERROR=0
-
-************************************************************************
-* COMPUTE FUNCTION VALUES AND DERIVATIVES (IF MODE NOTEQUAL ZERO)
-************************************************************************
-
- CALL D501SF(VERS,SUB,MODE,M,A,N,F,DF,K,NX,X,Y,SY,WORK(N+1),NERROR)
- IF(NERROR .NE. 0) RETURN
-
- IF(MODE .EQ. 0) THEN
-
-************************************************************************
-* APPROXIMATE DERIVATIVES
-************************************************************************
-
- DO 10 J=1,M
- H =ABS(A(J))*HREL+HABS
- IF (A(J)+H .GT. AU(J)) H=-H
- A(J)=A(J)+H
- CALL D501SF
- + (VERS,SUB,MODE,M,A,N,WORK,DF,K,NX,X,Y,SY,WORK(N+1),NERROR)
- IF(NERROR .NE. 0) RETURN
- A(J)=A(J)-H
- CALL DVSUB(N,WORK(1),WORK(2),F(1),F(2),DF(1,J),DF(2,J))
- 10 CALL DVSCL(N,1/H,DF(1,J),DF(2,J),DF(1,J),DF(2,J))
- ENDIF
-
-************************************************************************
-* COMPUTE THE GRADIENT OF THE OBJECTIVE FUNCTION
-************************************************************************
-
- CALL DMMPY(M,N,DF(1,1),DF(2,1),DF(1,2),F(1),F(2),DPHI(1),DPHI(2))
-
-************************************************************************
-* DETERMINE THE DIAGONAL MATRIX DSCAL FOR SCALING THE PROBLEM
-************************************************************************
-
- DO 30 I=1,M
- AI=0
- DO 20 J=1,N
- 20 AI=AI+DF(J,I)**2
- 30 DSCAL(I)=MAX(DSCAL(I),SQRT(AI))
-
-************************************************************************
-* DETERMINE FREE VARIABLES AND STORE THEIR INDECES IN IAFR
-* DETERMINE LAGRANGE-MULTIPLIER LAMU
-************************************************************************
-
- GR=0
- DO 40 I=1,MFR
- 40 GR=GR+(DSCAL(I)*A(IAFR(I)))**2
- GR=HREL*SQRT(GR)
-
- CALL DVSET(M,Z0,LAMU(1),LAMU(2))
-
- MFR=0
-
- DO 50 I=1,M
- IF(AU(I)-AL(I) .LT. EPS*(ABS(AU(I))+ABS(AL(I)))+2*HABS) THEN
- A(I)=AU(I)
- LAMU(I)=DPHI(I)
- ELSE
- IF(A(I) .GE. AU(I)-(EPS * ABS(AU(I)) + HABS )) THEN
- A(I)=AU(I)
- IF(DPHI(I) .GT. -GR) THEN
- MFR=MFR+1
- IAFR(MFR)=I
- ELSE
- LAMU(I)=DPHI(I)
- ENDIF
- ELSE IF(A(I) .LE. AL(I)+(EPS * ABS(AL(I)) + HABS )) THEN
- A(I)=AL(I)
- IF(DPHI(I) .LT. GR) THEN
- MFR=MFR+1
- IAFR(MFR)=I
- ELSE
- LAMU(I)=DPHI(I)
- ENDIF
- ELSE
- MFR=MFR+1
- IAFR(MFR)=I
- ENDIF
- ENDIF
-
- 50 CONTINUE
-
-************************************************************************
-* DELETE ROWS OF DSCAL AND COLUMNS OF DF
-* WHICH BELONG TO NON-FREE VARIABLES
-************************************************************************
-
- DO 60 I=1,MFR
- DSCAL(I)=DSCAL(IAFR(I))
- DO 60 L=1,N
- 60 DF(L,I)=DF(L,IAFR(I))
-
- RETURN
- END
-
-
-
-
diff --git a/src/mathlib/gen/d/d501n2.F b/src/mathlib/gen/d/d501n2.F
deleted file mode 100644
index d83f846..0000000
--- a/src/mathlib/gen/d/d501n2.F
+++ /dev/null
@@ -1,167 +0,0 @@
-*
-* $Id: d501n2.F,v 1.1.1.1 1996/04/01 15:02:19 mclareni Exp $
-*
-* $Log: d501n2.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:19 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE D501N2(K,N,M,A,AL,AU,X,NX,WORK,B,DPHI,DSCAL,LAMU,
- 1 AM,COV,IAFR,MFR,SUB,EPS0,EPS,MODE,NERROR)
-
-#include "gen/imp64.inc"
-#include "gen/def64.inc"
- + LAMU
- DIMENSION A(*),AL(*),AU(*),X(*),WORK(*),B(*),DPHI(*),DSCAL(*)
- DIMENSION LAMU(*),AM(M,*),COV(M,*),IAFR(*)
- PARAMETER (Z0 = 0)
-
-*************************************************************************
-* LEAMAX, VERSION: 15.03.1993
-*************************************************************************
-*
-* THIS ROUTINE COMPUTES THE GRADIENT, THE JACOBIAN, AND IT SETS UP
-* THE MATRIX FOR THE NORMAL EQUATIONS. IT ALSO DETERMINES THE ACTIVE
-* SET OF CONSTRAINTS AND THE LAGRANGE-MULTIPLIER.
-*
-************************************************************************
-
-************************************************************************
-* SET INITIAL VALUES
-************************************************************************
-
- HREL=SQRT(EPS0)
- HABS=10*EPS0
-
-************************************************************************
-* COMPUTE THE GRADIENT B OF THE OBJECTIVE FUNCTION
-* COMPUTE AN APPROXIMATION AM OF THE SECOND DERIVATIVE (THE HESSIAN)
-* OF THE OBJECTIVE FUNCTION
-************************************************************************
-
- NERROR=0
- CALL DVSET(M,Z0,B(1),B(2))
- CALL DMSET(M,M,Z0,AM(1,1),AM(1,2),AM(2,1))
- IX=1
-
- DO 30 I=1,N
-
- CALL SUB(K,X(IX),M,A,F0,WORK,MODE,NERROR)
- IF(NERROR .NE. 0 .OR. F0 .LE. 0) THEN
- NERROR=3
- RETURN
- ENDIF
-
- IF(MODE .EQ. 0) THEN
-
-************************************************************************
-* APPROXIMATE DERIVATIVES
-************************************************************************
-
- DO 10 J=1,M
- H =ABS(A(J))*HREL+HABS
- IF (A(J)+H .GT. AU(J)) H =-H
- A(J)=A(J)+H
- CALL SUB(K,X(IX),M,A,FH,WORK,MODE,NERROR)
- IF(NERROR .NE. 0) THEN
- NERROR=3
- RETURN
- ENDIF
- A(J)=A(J)-H
- 10 WORK(J)=(FH-F0)/H
- ENDIF
-
- CALL DVSCL(M,1/F0,WORK(1),WORK(2),WORK(1),WORK(2))
- CALL DVSUB(M,B(1),B(2),WORK(1),WORK(2),B(1),B(2))
-
- DO 20 L=1,M
- DO 20 J=L,M
- 20 AM(L,J)=AM(L,J)+WORK(L)*WORK(J)
-
- 30 IX=IX+NX
-
- CALL DMUTL(M,AM(1,1),AM(1,2),AM(2,1))
-
-************************************************************************
-* COPY THE GRADIENT OF THE OBJECTIVE FUNCTION TO DPHI
-************************************************************************
-
- CALL DVCPY(M,B(1),B(2),DPHI(1),DPHI(2))
-
-************************************************************************
-* DETERMINE THE DIAGONAL MATRIX DSCAL FOR SCALING THE PROBLEM
-************************************************************************
-
- DO 40 I=1,M
- 40 DSCAL(I)=MAX(DSCAL(I),SQRT(AM(I,I)))
-
-************************************************************************
-* DETERMINE FREE VARIABLES AND STORE THEIR INDICES IN IAFR
-* DETERMINE LAGRANGE MULTIPLIER LAMU
-************************************************************************
-
- GR=0
- DO 50 I=1,MFR
- 50 GR=GR+(DSCAL(I)*A(IAFR(I)))**2
- GR=HREL*SQRT(GR)
- CALL DVSET(M,Z0,LAMU(1),LAMU(2))
-
- MFR=0
-
- DO 60 I=1,M
- IF(AU(I)-AL(I) .LT. EPS*(ABS(AU(I))+ABS(AL(I)))+2*HABS) THEN
- A(I)=AU(I)
- LAMU(I)=DPHI(I)
- ELSE
- IF(A(I) .GE. AU(I)-(EPS * ABS(AU(I)) + HABS)) THEN
- A(I)=AU(I)
- IF(DPHI(I) .GT. -GR) THEN
- MFR=MFR+1
- IAFR(MFR)=I
- ELSE
- LAMU(I)=DPHI(I)
- ENDIF
- ELSE IF(A(I) .LE. AL(I)+(EPS * ABS(AL(I)) + HABS)) THEN
- A(I)=AL(I)
- IF(DPHI(I) .LT. GR) THEN
- MFR=MFR+1
- IAFR(MFR)=I
- ELSE
- LAMU(I)=DPHI(I)
- ENDIF
- ELSE
- MFR=MFR+1
- IAFR(MFR)=I
- ENDIF
- ENDIF
-
- 60 CONTINUE
-
-***********************************************************************
-* DELETE ROWS AND COLUMNS OF AM AND B WHICH BELONG TO NON-FREE
-* VARIABLES
-************************************************************************
-
- IF(MFR .EQ. 0 .OR. MFR .EQ. M) THEN
- MFC=M
- ELSE
- MFC=MFR
- DO 70 I =1,MFR
- B(I)=B(IAFR(I))
- DSCAL(I)=DSCAL(IAFR(I))
- DO 70 L = 1,M
- 70 AM(L,I)=AM(L,IAFR(I))
- DO 80 I=1,MFR
- DO 80 L=1,M
- 80 AM(I,L)=AM(IAFR(I),L)
- ENDIF
-
- CALL DMCPY(MFC,MFC,AM(1,1),AM(1,2),AM(2,1),
- + COV(1,1),COV(1,2),COV(2,1))
- RETURN
-
- END
-
-
-
diff --git a/src/mathlib/gen/d/d501p1.F b/src/mathlib/gen/d/d501p1.F
deleted file mode 100644
index 01b6890..0000000
--- a/src/mathlib/gen/d/d501p1.F
+++ /dev/null
@@ -1,132 +0,0 @@
-*
-* $Id: d501p1.F,v 1.1.1.1 1996/04/01 15:02:19 mclareni Exp $
-*
-* $Log: d501p1.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:19 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE D501P1(K,M,NC,X,NX,Y,SY,MODE,EPS0,EPS,MAXIT,IPRT,
- + N,A,AL,AU,NERROR,VERS)
-
-************************************************************************
-* LEAMAX, VERSION: 15.03.1993
-************************************************************************
-*
-* THIS ROUTINE CHECKS THE VALUES OF INPUT PARAMETERS OF THE
-* SUBROUTINES DSUMSQ, DFUNFT, DMAXLK DEPENDING ON THE VALUE OF
-* THE PARAMETER VERS.
-* IF IPRT < 0 ALL VALUES OF THE INPUT PARAMETERS ARE PRINTED.
-*
-*************************************************************************
-
-#include "gen/imp64.inc"
- CHARACTER VERS*6,TIT1(3)*35,TIT2(0:1)*35
- DIMENSION X(*),Y(*),SY(*),A(*),AL(*),AU(*)
- PARAMETER (Z1 = 1, R10 = Z1/10)
-
- DATA TIT1(1) /'MINIMIZATION OF A SUM OF SQUARES'/
- DATA TIT1(2) /'LEAST-SQUARES DATA FITTING'/
- DATA TIT1(3) /'MAXIMUM LIKELIHOOD ESTIMATION'/
-
- DATA TIT2(0) /'APPROXIMATE DERIVATIVES (MODE = 0)'/
- DATA TIT2(1) /'ANALYTICAL DERIVATIVES (MODE = 1)'/
-
- IF(IPRT .NE. 0) THEN
- IF(VERS .EQ. 'DSUMSQ') IV=1
- IF(VERS .EQ. 'DFUNFT') IV=2
- IF(VERS .EQ. 'DMAXLK') IV=3
-
- WRITE(6,1000) VERS,TIT1(IV),TIT2(MODE)
- ENDIF
-
-************************************************************************
-* PRINT INPUT PARAMETERS (IF IPRT .LT. 0)
-************************************************************************
-
- IF(IPRT .LT. 0) THEN
- WRITE(6,1010) VERS,M,N
- IF(VERS .NE. 'DMAXLK') WRITE(6,1020) NC
- IF(VERS .NE. 'DSUMSQ') WRITE(6,1030) K,NX
- WRITE(6,1040) MAXIT,MODE,IPRT,EPS
- ENDIF
-
-************************************************************************
-* CHECK VALUES OF INPUT PARAMETERS, AND PRINT THEM (IF IPRT .LT. 0)
-************************************************************************
-
- NERROR=0
-
- IF( MAXIT .LT. 1
- 1 .OR. K .LT. 1
- 2 .OR. N .LT. 1
- 3 .OR. M .LT. N
- 4 .OR. NC .LT. N
- 5 .OR. NX .LT. K ) THEN
- NERROR=1
- RETURN
- ENDIF
-
- IF(IPRT .LT. 0) THEN
- WRITE(6,1050) (AL(I), I=1,N)
- WRITE(6,1060) (AU(I), I=1,N)
- WRITE(6,1070) (A(I), I=1,N)
- IF(VERS .NE. 'DSUMSQ')WRITE(6,1080)((X(I),I=L,M*NX,NX),L=1,K)
- IF(VERS .EQ. 'DFUNFT') THEN
- WRITE(6,1090) (Y(I), I=1,M)
- WRITE(6,1100) (SY(I),I=1,M)
- ENDIF
- ENDIF
-
- DO 10 I=1,N
- IF(AL(I) .GT. AU(I)) THEN
- NERROR=1
- RETURN
- ENDIF
- 10 CONTINUE
-
-************************************************************************
-* IF VALUES OF THE PARAMETERS A, SY, MODE OR EPS ARE NOT PRACTICABLE
-* SET RECOMMENDED VALUES FOR THIS PARAMETERS
-************************************************************************
-
- DO 20 I=1,N
- IF(A(I) .GT. AU(I)) A(I)=AU(I)
- IF(A(I) .LT. AL(I)) A(I)=AL(I)
- 20 CONTINUE
-
- IF (VERS .EQ. 'DFUNFT') THEN
- DO 30 I = 1,M
- IF(SY(I) .LE. 0) THEN
- NERROR=1
- RETURN
- ENDIF
- 30 CONTINUE
- ENDIF
-
-CC IF(STEP .LE. 0) STEP=1
- IF(MODE .NE. 1) MODE=0
- IF (EPS .LT. EPS0 .OR. EPS .GT. R10) EPS=10*EPS0
-
- RETURN
-
- 1000 FORMAT(7(/),30X,'MATHLIB PACKAGE D501 VERSION 15.03.93'//
- 1 30X,'PACKAGE LEAMAX **** ROUTINE ',A6,' ****'///
- 2 15X,A35,A35//)
- 1010 FORMAT(' INPUT OF ',A6,' :'//' M :',I5,6X,'N :',I5)
- 1020 FORMAT(' NC:',I5)
- 1030 FORMAT(' K :',I5,6X,'NX:',I5)
- 1040 FORMAT(' MAXIT :',I5,8X,'MODE :',I5,8X,'IPRT :',I5/
- + ' EPS :',1PD11.1/)
- 1050 FORMAT(/' AL :',/(5(1PD15.5)))
- 1060 FORMAT( ' AU :',/(5(1PD15.5)))
- 1070 FORMAT( ' A :', /(5(1PD15.5)))
- 1080 FORMAT( ' X :', /(5(1PD15.5)))
- 1090 FORMAT( ' Y :', /(5(1PD15.5)))
- 1100 FORMAT( ' SY :',/(5(1PD15.5)))
-
- END
-
-
-
diff --git a/src/mathlib/gen/d/d501p2.F b/src/mathlib/gen/d/d501p2.F
deleted file mode 100644
index 0f7c8c7..0000000
--- a/src/mathlib/gen/d/d501p2.F
+++ /dev/null
@@ -1,66 +0,0 @@
-*
-* $Id: d501p2.F,v 1.1.1.1 1996/04/01 15:02:20 mclareni Exp $
-*
-* $Log: d501p2.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:20 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE D501P2(LRP,N,A,B,C,LAMU,PHI,DPHINO,ITER,LFN,MODE,VERS)
-
-************************************************************************
-* LEAMAX, VERSION: 15.03.1993
-************************************************************************
-*
-* THIS ROUTINE CONTROLS THE PRINTING OF THE PACKAGE LEAMAX.
-*
-************************************************************************
-
-#include "gen/imp64.inc"
-#include "gen/def64.inc"
- + LAMBDA,LAMU
- LOGICAL LFN,LRP
- CHARACTER VERS*6,TIT(2)*18
- DIMENSION A(*),B(*),C(*),LAMU(*)
-
-
- DATA TIT(1),TIT(2) /' ','STANDARD DEVIATION'/
-
- IF(.NOT.LRP) THEN
-
- WRITE(6,1030)
- LRP=.TRUE.
- ENDIF
-
- IF(LFN) THEN
- WRITE(6,1010) 'END:',ITER,PHI,DPHINO
- IF(VERS .EQ. 'DFUNFT') THEN
- WRITE(6,1020) TIT(2)(1:8),TIT(2)(10:18)
- ELSE
- WRITE(6,1020) TIT(1)(1:8),TIT(1)(10:18)
- ENDIF
- ELSE
- WRITE(6,1010) ' ',ITER,PHI,DPHINO
- WRITE(6,1020) TIT(1)(1:8),TIT(1)(10:18)
- ENDIF
-
- IF(LFN .AND. VERS .EQ. 'DFUNFT') THEN
- WRITE(6,1040) (I,A(I),B(I),LAMU(I),C(I), I=1,N)
- ELSE
- WRITE(6,1050) (I,A(I),B(I),LAMU(I), I=1,N)
- ENDIF
-
- RETURN
-
- 1010 FORMAT(/6X,A4,' ITERATION',I5,3X,'PHI = ',1PD12.5,6X,
- 1 'GNO = ',1PD12.5/)
- 1020 FORMAT(12X,'PARAMETER',7X,'PARAMETER',9X,'GRADIENT',
- 1 10X,'LAGRANGE',8X,A8/
- 2 14X,'NUMBER',10X,'VALUE',28X,'MULTIPLIER',7X,A9/)
- 1030 FORMAT(//' ITERATION'//11X,'PHI = VALUE OF OBJECTIVE FUNCTION',
- 1 10X,'GNO = NORM OF GRADIENT')
- 1040 FORMAT (15X,I3,4X,1PD17.5,1PD17.5,1PD17.5,1PD17.5)
- 1050 FORMAT (15X,I3,4X,1PD17.5,1PD17.5,1PD17.5)
-
- END
diff --git a/src/mathlib/gen/d/d501sf.F b/src/mathlib/gen/d/d501sf.F
deleted file mode 100644
index 002e6f3..0000000
--- a/src/mathlib/gen/d/d501sf.F
+++ /dev/null
@@ -1,53 +0,0 @@
-*
-* $Id: d501sf.F,v 1.1.1.1 1996/04/01 15:02:20 mclareni Exp $
-*
-* $Log: d501sf.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:20 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE D501SF (VERS,SUB,MODE,M,A,N,F,DF,K,NX,X,Y,SY,W,NERROR)
-
-************************************************************************
-* LEAMAX, VERSION: 15.03.1993
-************************************************************************
-*
-* THIS ROUTINE COMPUTES FUNCTION VALUES AND DERIVATIVES DEPENDING ON
-* THE VALUE OF THE PARAMETER VERS.
-*
-*************************************************************************
-
-#include "gen/imp64.inc"
- DIMENSION A(*),F(*),DF(N,*),X(*),Y(*),SY(*),W(*)
- CHARACTER VERS*6
-
- NERROR=0
-
- IF (VERS .EQ. 'DSUMSQ') THEN
- CALL SUB (M,A,N,F,DF,MODE,NERROR)
- IF (NERROR .NE. 0) NERROR=3
- RETURN
- ENDIF
-
- IF (VERS .EQ. 'DFUNFT') THEN
- IX=1
- DO 20 I=1,N
- CALL SUB (K,X(IX),M,A,SF,W,MODE,NERROR)
- IF (NERROR .NE. 0) THEN
- NERROR=3
- RETURN
- ENDIF
- F(I)=(Y(I)-SF)/SY(I)
- IX=IX+NX
- IF (MODE .EQ. 0) GOTO 20
- DO 10 J=1,M
- 10 DF(I,J)=-W(J)/SY(I)
- 20 CONTINUE
- RETURN
- ENDIF
-
- END
-
-
-
diff --git a/src/mathlib/gen/d/d510pl.inc b/src/mathlib/gen/d/d510pl.inc
deleted file mode 100644
index 89419cc..0000000
--- a/src/mathlib/gen/d/d510pl.inc
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: d510pl.inc,v 1.1.1.1 1996/04/01 15:02:21 mclareni Exp $
-*
-* $Log: d510pl.inc,v $
-* Revision 1.1.1.1 1996/04/01 15:02:21 mclareni
-* Mathlib gen
-*
-*
-*
-* d510pl.inc
-*
- COMMON/D510PL/PL(100)
diff --git a/src/mathlib/gen/d/d510si.inc b/src/mathlib/gen/d/d510si.inc
deleted file mode 100644
index ec1bb77..0000000
--- a/src/mathlib/gen/d/d510si.inc
+++ /dev/null
@@ -1,13 +0,0 @@
-*
-* $Id: d510si.inc,v 1.1.1.1 1996/04/01 15:02:21 mclareni Exp $
-*
-* $Log: d510si.inc,v $
-* Revision 1.1.1.1 1996/04/01 15:02:21 mclareni
-* Mathlib gen
-*
-*
-*
-* d510si.inc
-*
- COMMON/D510SI/Z(2485),G(100),DA(100),ENDFLG,NA,INDFLG(5)
- COMMON/DF/DF(100),/X/X(10)
diff --git a/src/mathlib/gen/d/d510ui.inc b/src/mathlib/gen/d/d510ui.inc
deleted file mode 100644
index 29ede10..0000000
--- a/src/mathlib/gen/d/d510ui.inc
+++ /dev/null
@@ -1,13 +0,0 @@
-*
-* $Id: d510ui.inc,v 1.1.1.1 1996/04/01 15:02:21 mclareni Exp $
-*
-* $Log: d510ui.inc,v $
-* Revision 1.1.1.1 1996/04/01 15:02:21 mclareni
-* Mathlib gen
-*
-*
-*
-* d510ui.inc
-*
- COMMON /A/A(100)/PL/PL0(100)/AU/AMX(100)/AL/AMN(100)/NED/NED(2)
- COMMON/SIGMA/SIGMA(100)/EXDA/EXDA(1500)
diff --git a/src/mathlib/gen/d/d510uo.inc b/src/mathlib/gen/d/d510uo.inc
deleted file mode 100644
index 206400d..0000000
--- a/src/mathlib/gen/d/d510uo.inc
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: d510uo.inc,v 1.1.1.1 1996/04/01 15:02:21 mclareni Exp $
-*
-* $Log: d510uo.inc,v $
-* Revision 1.1.1.1 1996/04/01 15:02:21 mclareni
-* Mathlib gen
-*
-*
-*
-* d510uo.inc
-*
- COMMON/R/R(100)/ERROR/ERROR(500)/Z0/Z0(2485)
diff --git a/src/mathlib/gen/d/d700su.F b/src/mathlib/gen/d/d700su.F
deleted file mode 100644
index f7de7f3..0000000
--- a/src/mathlib/gen/d/d700su.F
+++ /dev/null
@@ -1,36 +0,0 @@
-*
-* $Id: d700su.F,v 1.1.1.1 1996/04/01 15:02:22 mclareni Exp $
-*
-* $Log: d700su.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:22 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE D700SU
-C PREPARE FIXED DATA FOR FAST FOURIER TRANSFORM.
-C
- COMMON /D700DT/ N, N2, N4, M, F, RTTWO
- COMMON /FWORK/ W(321)
-C
- IF(M .LT. 2) GO TO 90
- N4 = 2 ** (M-2)
- N2 = N4 + N4
- N = N2 + N2
- F = 1.0 / SQRT(REAL(N))
- DA = 4.0 * ATAN(1.0) / N2
- RTTWO = SQRT(2.0)
-C
- NC = N4 - 1
- IF(NC .LE. 0) RETURN
- DO 10 MC = 1, NC
- W(MC) = COS(DA*MC)
- 10 CONTINUE
-C
- RETURN
-C M MUST BE AT LEAST 2, I.E. THE PERIOD HAS AT LEAST 4 POINTS.
- 90 WRITE(6,100) M
- STOP
-C
- 100 FORMAT('1* ERROR IN RFT ... M =',I5,', SHOULD BE .GE. 2 *')
- END
diff --git a/src/mathlib/gen/d/d701bd.F b/src/mathlib/gen/d/d701bd.F
deleted file mode 100644
index 079d779..0000000
--- a/src/mathlib/gen/d/d701bd.F
+++ /dev/null
@@ -1,115 +0,0 @@
-*
-* $Id: d701bd.F,v 1.1.1.1 1996/04/01 15:02:23 mclareni Exp $
-*
-* $Log: d701bd.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:23 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE D701BD
- COMMON /TAB/U(126),V(127)
- DIMENSION U01(42),U43(42),U85(42)
- DIMENSION V01(42),V43(42),V85(43)
- DATA U01/
- * .024541228522912288, .999698818696204220, .049067674327418014,
- * .998795456205172393, .073564563599667424, .997290456678690216,
- * .098017140329560602, .995184726672196886, .122410675199216198,
- * .992479534598709998, .146730474455361752, .989176509964780973,
- * .170961888760301226, .985277642388941245, .195090322016128268,
- * .980785280403230449, .219101240156869797, .975702130038528544,
- * .242980179903263890, .970031253194543993, .266712757474898386,
- * .963776065795439867, .290284677254462368, .956940335732208865,
- * .313681740398891477, .949528180593036667, .336889853392220051,
- * .941544065183020778, .359895036534988149, .932992798834738888,
- * .382683432365089772, .923879532511286756, .405241314004989871,
- * .914209755703530655, .427555093430282094, .903989293123443332,
- * .449611329654606600, .893224301195515320, .471396736825997649,
- * .881921264348355030, .492898192229784037, .870086991108711419/
- DATA U43/
- * .514102744193221727, .857728610000272070, .534997619887097211,
- * .844853565249707073, .555570233019602225, .831469612302545237,
- * .575808191417845301, .817584813151583697, .595699304492433343,
- * .803207531480644910, .615231590580626845, .788346427626606262,
- * .634393284163645498, .773010453362736961, .653172842953776764,
- * .757208846506484548, .671558954847018401, .740951125354959091,
- * .689540544737066925, .724247082951466921, .707106781186547524,
- * .707106781186547524, .724247082951466921, .689540544737066925,
- * .740951125354959091, .671558954847018401, .757208846506484548,
- * .653172842953776764, .773010453362736961, .634393284163645498,
- * .788346427626606262, .615231590580626845, .803207531480644910,
- * .595699304492433343, .817584813151583697, .575808191417845301,
- * .831469612302545237, .555570233019602225, .844853565249707073,
- * .534997619887097211, .857728610000272070, .514102744193221727/
- DATA U85/
- * .870086991108711419, .492898192229784037, .881921264348355030,
- * .471396736825997649, .893224301195515320, .449611329654606600,
- * .903989293123443332, .427555093430282094, .914209755703530655,
- * .405241314004989871, .923879532511286756, .382683432365089772,
- * .932992798834738888, .359895036534988149, .941544065183020778,
- * .336889853392220051, .949528180593036667, .313681740398891477,
- * .956940335732208865, .290284677254462368, .963776065795439867,
- * .266712757474898386, .970031253194543993, .242980179903263890,
- * .975702130038528544, .219101240156869797, .980785280403230449,
- * .195090322016128268, .985277642388941245, .170961888760301226,
- * .989176509964780973, .146730474455361752, .992479534598709998,
- * .122410675199216198, .995184726672196886, .098017140329560602,
- * .997290456678690216, .073564563599667424, .998795456205172393,
- * .049067674327418014, .999698818696204220, .024541228522912288/
- DATA V01/
- *20.372344051675948320,10.186939083615717019, 6.792145128642259194,
- * 5.095004061774028406, 4.076924301233411569, 3.398375355836817874,
- * 2.913844188922326923, 2.550574309344581929, 2.268145468484680877,
- * 2.042305539064625322, 1.857621369163487826, 1.703804209234359393,
- * 1.573731095890953903, 1.462314214079109314, 1.365822514386970608,
- * 1.281457723870753089, 1.207080000125038197, 1.141025034002580881,
- * 1.081978909375990251, 1.028890504976705775, .980908924285583182,
- * .937337990004204040, .897602609538944760, .861223549119166964,
- * .827798262132060057, .796986141692815849, .768497050426247854,
- * .742082308157083139, .717527544220716945, .694646979316414074,
- * .673278814103143206, .653281482438188264, .634530585849559569,
- * .616916368988285501, .600341627864708583, .584719966716442478,
- * .569974337550752206, .556035810289858797, .542842532129007265,
- * .530338842995173736, .518474520455194562, .507204132498527377/
- DATA V43/
- * .496486480633773341, .486284118930980347, .476562937196059577,
- * .467291798518203777, .458442223092326185, .449988111568207852,
- * .441905502279811730, .434172357611674059, .426768375503303231,
- * .419674822707763519, .412874386931392637, .406351045407245220,
- * .400089947810847103, .394077311725625112, .388300329116981475,
- * .382747082486544543, .377406469558265608, .372268135501149225,
- * .367322411823931352, .362560261188599264, .357973227485287329,
- * .353553390593273762, .349293325323614557, .345186064100106210,
- * .341225062988209739, .337404170727502873, .333717600463170676,
- * .330159903906853078, .326725947687564127, .323410891679995065,
- * .320210169120831946, .317119468344201623, .314134715985385547,
- * .311252061517832408, .308467863002535298, .305778673941254995,
- * .303181231136072966, .300672443467522640, .298249381512228152,
- * .295909267928708288, .293649468546894677, .291467484103066937/
- DATA V85/
- * .289360942567410413, .287327592016330020, .285365294006072688,
- * .283472017408178852, .281645832670851110, .279884906473540080,
- * .278187496744942806, .276551948017222264, .274976687091617982,
- * .273460218992754407, .272001123190889132, .270598050073098492,
- * .269249717645991982, .267954908453996038, .266712466698566642,
- * .265521295544892087, .264380354603743829, .263288657577134964,
- * .262245270057362001, .261249307469844440, .260299933150945870,
- * .259396356552666409, .258537831566745571, .257723654961312273,
- * .256953164923769797, .256225739704112356, .255540796353340615,
- * .254897789552079584, .254296210524907102, .253735586036277646,
- * .253215477464277089, .252735479948771830, .252295221610822686,
- * .251894362840522137, .251532595650684871, .251209643094077853,
- * .250925258742118964, .250679226223204187, .250471358819043657,
- * .250301499117598151, .250169518721410816, .250075318010325494,
- * .250018825957773861/
- DATA IBD/0/
- IF(IBD.NE.0) RETURN
- IBD=1
- CALL UCOPY(U01,U ,42)
- CALL UCOPY(U43,U(43),42)
- CALL UCOPY(U85,U(85),42)
- CALL UCOPY(V01,V ,42)
- CALL UCOPY(V43,V(43),42)
- CALL UCOPY(V85,V(85),43)
- RETURN
- END
diff --git a/src/mathlib/gen/d/dadapt.F b/src/mathlib/gen/d/dadapt.F
deleted file mode 100644
index e9ea8aa..0000000
--- a/src/mathlib/gen/d/dadapt.F
+++ /dev/null
@@ -1,106 +0,0 @@
-*
-* $Id: dadapt.F,v 1.1.1.1 1996/04/01 15:02:13 mclareni Exp $
-*
-* $Log: dadapt.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:13 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE DADAPT(F,A,B,NSEG,RELTOL,ABSTOL,RES,ERR)
-#if !defined(CERNLIB_DOUBLE)
-#include "gen/imp128.inc"
- CHARACTER*6 NAME
- NAME = 'DADAPT'
- CALL MTLPRT(NAME,'D102',
- +'not available on this machine - see documentation')
- RETURN
- END
-#endif
-#if defined(CERNLIB_DOUBLE)
- IMPLICIT DOUBLE PRECISION (A-H,O-Z)
-
-C RES = Estimated Integral of F from A to B,
-C ERR = Estimated absolute error on RES.
-C NSEG specifies how the adaptation is to be done:
-C =0 means use previous binning,
-C =1 means fully automatic, adapt until tolerance attained.
-C =n>1 means first split interval into n equal segments,
-C then adapt as necessary to attain tolerance.
-C The specified tolerances are:
-C relative: RELTOL ; absolute: ABSTOL.
-C It stops when one OR the other is satisfied, or number of
-C segments exceeds NDIM. Either TOLA or TOLR (but not both!)
-C can be set to zero, in which case only the other is used.
-
- EXTERNAL F
-
- PARAMETER (NDIM=100)
- PARAMETER (R1 = 1, HF = R1/2)
-
- DIMENSION XLO(NDIM),XHI(NDIM),TVAL(NDIM),TERS(NDIM)
- SAVE XLO,XHI,TVAL,TERS,NTER
- DATA NTER /0/
-
- IF(NSEG .LE. 0) THEN
- IF(NTER .EQ. 0) THEN
- NSEGD=1
- GO TO 2
- ENDIF
- TVALS=0
- TERSS=0
- DO 1 I = 1,NTER
- CALL DGS56P(F,XLO(I),XHI(I),TVAL(I),TE)
- TERS(I)=TE**2
- TVALS=TVALS+TVAL(I)
- TERSS=TERSS+TERS(I)
- 1 CONTINUE
- ROOT= SQRT(2*TERSS)
- GO TO 9
- ENDIF
- NSEGD=MIN(NSEG,NDIM)
- 2 XHIB=A
- BIN=(B-A)/NSEGD
- DO 3 I = 1,NSEGD
- XLO(I)=XHIB
- XLOB=XLO(I)
- XHI(I)=XHIB+BIN
- IF(I .EQ. NSEGD) XHI(I)=B
- XHIB=XHI(I)
- CALL DGS56P(F,XLOB,XHIB,TVAL(I),TE)
- TERS(I)=TE**2
- 3 CONTINUE
- NTER=NSEGD
- DO 4 ITER = 1,NDIM
- TVALS=TVAL(1)
- TERSS=TERS(1)
- DO 5 I = 2,NTER
- TVALS=TVALS+TVAL(I)
- TERSS=TERSS+TERS(I)
- 5 CONTINUE
- ROOT= SQRT(2*TERSS)
- IF(ROOT .LE. ABSTOL .OR. ROOT .LE. RELTOL*ABS(TVALS)) GO TO 9
- IF(NTER .EQ. NDIM) GO TO 9
- BIGE=TERS(1)
- IBIG=1
- DO 6 I = 2,NTER
- IF(TERS(I) .GT. BIGE) THEN
- BIGE=TERS(I)
- IBIG=I
- ENDIF
- 6 CONTINUE
- NTER=NTER+1
- XHI(NTER)=XHI(IBIG)
- XNEW=HF*(XLO(IBIG)+XHI(IBIG))
- XHI(IBIG)=XNEW
- XLO(NTER)=XNEW
- CALL DGS56P(F,XLO(IBIG),XHI(IBIG),TVAL(IBIG),TE)
- TERS(IBIG)=TE**2
- CALL DGS56P(F,XLO(NTER),XHI(NTER),TVAL(NTER),TE)
- TERS(NTER)=TE**2
- 4 CONTINUE
- 9 RES=TVALS
- ERR=ROOT
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/d/deqbs128.F b/src/mathlib/gen/d/deqbs128.F
deleted file mode 100644
index 66f2ae2..0000000
--- a/src/mathlib/gen/d/deqbs128.F
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: deqbs128.F,v 1.1.1.1 1996/04/01 15:02:17 mclareni Exp $
-*
-* $Log: deqbs128.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:17 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if !defined(CERNLIB_DOUBLE)
- SUBROUTINE DDEQBS(N,XA,XZ,Y,H0,EPS,SUB,W)
-#include "gen/imp128.inc"
- CHARACTER*(*) NAME
- PARAMETER( NAME='DDEQBS')
- CALL MTLPRT(NAME,'D201.0','Not available on this machine')
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/d/deqbs64.F b/src/mathlib/gen/d/deqbs64.F
deleted file mode 100644
index 8cc43ca..0000000
--- a/src/mathlib/gen/d/deqbs64.F
+++ /dev/null
@@ -1,170 +0,0 @@
-*
-* $Id: deqbs64.F,v 1.1.1.1 1996/04/01 15:02:17 mclareni Exp $
-*
-* $Log: deqbs64.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:17 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if !defined(CERNLIB_DOUBLE)
- SUBROUTINE RDEQBS(N,XA,XZ,Y,H0,EPS,SUB,W)
-#endif
-#if defined(CERNLIB_DOUBLE)
- SUBROUTINE DDEQBS(N,XA,XZ,Y,H0,EPS,SUB,W)
-#include "gen/imp64.inc"
-#endif
-
-C This subroutine is based on the Algol procedure diffsys as
-C presented in R. Bulirsch and J. Stoer, Numerical Treatment of
-C Ordinary Differential Equations by Extrapolation Methods,
-C Numer. Math. 8 (1966) 1-13. The adaption for integration over
-C a given interval (not only over one step) is due to G. Janin.
-
- CHARACTER NAME*(*)
- CHARACTER*80 ERRTXT
-#if !defined(CERNLIB_DOUBLE)
- PARAMETER (NAME = 'RDEQBS')
-#endif
-#if defined(CERNLIB_DOUBLE)
- PARAMETER (NAME = 'DDEQBS')
-#endif
- LOGICAL LCV,LBO,LBH,LFN
-
- DIMENSION Y(*),W(N,*)
-
- PARAMETER (DELTA = 1D-14)
- PARAMETER (Z1 = 1, HF = Z1/2, C1 = 3*Z1/2)
- PARAMETER (C9 = 9, C6 = C9/15)
- PARAMETER (C2 = 16/C9, C3 = 64/C9, C4 = 256/C9, C5 = C9/4)
-
-#if !defined(CERNLIB_DOUBLE)
- ENTRY DEQBS(N,XA,XZ,Y,H0,EPS,SUB,W)
-#endif
-
- IF(N .LT. 1 .OR. XA .EQ. XZ .OR. H0 .EQ. 0) RETURN
- DELTAX=DELTA*ABS(XZ-XA)
- X=XA
- H1=SIGN(ABS(H0),XZ-XA)
- SGH=SIGN(Z1,H1)
-
- 12 DO 1 I = 1,N
- W(I,28)=0
- W(I,36)=0
- W(I,23)=Y(I)
- DO 1 K = 1,6
- 1 W(I,K)=0
- IF(SGH*(X+H1-XZ) .LT. 0) THEN
- HH=H1
- LFN=.FALSE.
- ELSE
- HH=XZ-X
- IF(ABS(HH) .LT. DELTAX) RETURN
- LFN=.TRUE.
- END IF
- CALL SUB(X,Y,W(1,27))
- LBH=.FALSE.
-
- 2 IF(ABS(HH) .LT. DELTAX) THEN
- WRITE(ERRTXT,101) X
- CALL MTLPRT(NAME,'D201.1',ERRTXT)
- RETURN
- END IF
- A=X+HH
- FC=C1
- LBO=.FALSE.
- M=1
- IR=2
- IS=3
- JJ=6
-
- DO 3 J = 0,9
- IF(LBO) THEN
- W(1,30)=C2
- W(1,32)=C3
- W(1,34)=C4
- ELSE
- W(1,30)=C5
- W(1,32)=C9
- W(1,34)=36
- END IF
- LCV=J .GT. 2
- IF(J .GT. 6) THEN
- L=6
- W(1,35)=64
- FC=C6*FC
- ELSE
- L=J
- W(1,L+29)=M*M
- END IF
- M=M+M
- G=HH/M
- B=G+G
- IF(LBH .AND. J .LT. 8) THEN
- DO 4 I = 1,N
- W(I,25)=W(I,J+15)
- 4 W(I,24)=W(I,J+7)
- ELSE
- KK=(M-2)/2
- M=M-1
- DO 5 I = 1,N
- W(I,24)=W(I,23)
- 5 W(I,25)=W(I,23)+G*W(I,27)
- DO 6 K = 1,M
- CALL SUB(X+K*G,W(1,25),W(1,26))
- DO 7 I = 1,N
- U=W(I,24)+B*W(I,26)
- W(I,24)=W(I,25)
- W(I,25)=U
- 7 W(I,28)=MAX(W(I,28),ABS(U))
- IF(K .EQ. KK .AND. K .NE. 2) THEN
- JJ=JJ+1
- DO 8 I = 1,N
- W(I,JJ+8)=W(I,25)
- 8 W(I,JJ)=W(I,24)
- END IF
- 6 CONTINUE
- END IF
-
- CALL SUB(A,W(1,25),W(1,26))
- DO 9 I = 1,N
- V=W(I,36)
- W(I,36)=HF*(W(I,25)+W(I,24)+G*W(I,26))
- C=W(I,36)
- TA=C
- DO 10 K = 1,L
- B1=W(1,K+29)*V
- B=B1-C
- U=V
- IF(B .NE. 0) THEN
- B=(C-V)/B
- U=C*B
- C=B1*B
- END IF
- V=W(I,K)
- W(I,K)=U
- 10 TA=U+TA
- IF(ABS(Y(I)-TA) .GT. EPS*W(I,28)) LCV=.FALSE.
- 9 Y(I)=TA
- IF(LCV) THEN
- X=A
- H0=H1
- IF(LFN .OR. ABS(X-XZ) .LT. DELTAX) RETURN
- H1=FC*H1
- GOTO 12
- END IF
- W(1,31)=4
- W(1,33)=16
- LBO=.NOT.LBO
- M=IR
- IR=IS
- IS=M+M
- 3 CONTINUE
-
- LBH=.NOT.LBH
- HH=HF*HH
- H1=HH
- LFN=.FALSE.
- GO TO 2
- 101 FORMAT('TOO HIGH ACCURACY REQUIRED NEAR X = ',D15.8)
- END
diff --git a/src/mathlib/gen/d/deqmr64.F b/src/mathlib/gen/d/deqmr64.F
deleted file mode 100644
index 7de9683..0000000
--- a/src/mathlib/gen/d/deqmr64.F
+++ /dev/null
@@ -1,122 +0,0 @@
-*
-* $Id: deqmr64.F,v 1.1.1.1 1996/04/01 15:02:17 mclareni Exp $
-*
-* $Log: deqmr64.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:17 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if !defined(CERNLIB_DOUBLE)
- SUBROUTINE RDEQMR(N,XA,XZ,Y,H0,EPS,SUB,W)
-#endif
-#if defined(CERNLIB_DOUBLE)
- SUBROUTINE DDEQMR(N,XA,XZ,Y,H0,EPS,SUB,W)
-#include "gen/imp64.inc"
-#endif
-C Based on a modification of the Runge-Kutta method suggested
-C by Merson. See G.N. Lance, Numerical Methods for High speed
-C Computers, Iliffe & Sons, London 1960, pp. 56-57
-
- CHARACTER NAME*(*)
- CHARACTER*80 ERRTXT
-#if !defined(CERNLIB_DOUBLE)
- PARAMETER (NAME = 'RDEQMR')
-#endif
-#if defined(CERNLIB_DOUBLE)
- PARAMETER (NAME = 'DDEQMR')
-#endif
- LOGICAL LER,LFN
-
- DIMENSION Y(*),W(N,*)
-
- PARAMETER (DELTA = 1D-14)
- PARAMETER (Z1 = 1, R2 = Z1/2, R3 = Z1/3)
- PARAMETER (R4 = 3*Z1/8, R5 = 3*Z1/2, R6 = 9*Z1/2)
- PARAMETER (R7 = 4*Z1/3, R0 = Z1/32)
-
-#if !defined(CERNLIB_DOUBLE)
- ENTRY DEQMR(N,XA,XZ,Y,H0,EPS,SUB,W)
-#endif
-
- IF(N .LT. 1 .OR. XA .EQ. XZ .OR. H0 .EQ. 0) RETURN
- DELTAX=DELTA*ABS(XZ-XA)
- EPS5=5*ABS(EPS)
- EPS0=R0*EPS5
- X=XA
- H1=SIGN(ABS(H0),XZ-XA)
- SGH=SIGN(Z1,H1)
-
- 12 IF(SGH*(X+H1-XZ) .LT. 0) THEN
- HH=H1
- H0=H1
- LFN=.FALSE.
- ELSE
- HH=XZ-X
- IF(ABS(HH) .LT. DELTAX) THEN
- DO 10 I = 1,N
- 10 Y(I)=W(I,6)
- RETURN
- END IF
- LFN=.TRUE.
- END IF
- S2=R2*HH
- S3=R3*HH
- S7=R7*HH
- X1=X+HH
- X2=X+S2
- X3=X+S3
-
- CALL SUB(X,Y,W(1,1))
- DO 1 I = 1,N
- W(I,1)=S3*W(I,1)
- 1 W(I,6)=Y(I)+W(I,1)
-
- CALL SUB(X3,W(1,6),W(1,2))
- DO 2 I = 1,N
- W(I,2)=S3*W(I,2)
- 2 W(I,6)=Y(I)+R2*(W(I,1)+W(I,2))
-
- CALL SUB(X3,W(1,6),W(1,3))
- DO 3 I = 1,N
- W(I,3)=S3*W(I,3)
- W(I,2)=3*W(I,3)
- 3 W(I,6)=Y(I)+R4*(W(I,1)+W(I,2))
-
- CALL SUB(X2,W(1,6),W(1,4))
- DO 4 I = 1,N
- W(I,4)=S7*W(I,4)
- 4 W(I,6)=Y(I)+R5*(W(I,1)-W(I,2)+W(I,4))
-
- CALL SUB(X1,W(1,6),W(1,5))
- DO 5 I = 1,N
- W(I,5)=S3*W(I,5)
- 5 W(I,6)=Y(I)+R2*(W(I,1)+W(I,4)+W(I,5))
-
- DO 8 I = 1,N
- W(I,2)=ABS(W(I,1)-R6*W(I,3)+W(I,4)-R2*W(I,5))
- W(I,1)=ABS(W(I,6))
- IF(W(I,2) .GT. EPS5*W(I,1)) THEN
- H1=R2*HH
- IF(ABS(H1) .LT. DELTAX) THEN
- WRITE(ERRTXT,101) X
- CALL MTLPRT(NAME,'D202.1',ERRTXT)
- RETURN
- END IF
- GO TO 12
- END IF
- 8 CONTINUE
- LER=.TRUE.
- DO 7 I = 1,N
- 7 LER=LER .AND. W(I,2) .LT. EPS0*W(I,1)
- DO 9 I = 1,N
- 9 Y(I)=W(I,6)
- IF(LER) THEN
- H0=H1+H1
- H1=HH+HH
- END IF
- IF(LFN) RETURN
- X=X1
- GO TO 12
- 101 FORMAT('TOO HIGH ACCURACY REQUIRED NEAR X = ',1P,D15.8)
- END
diff --git a/src/mathlib/gen/d/deriv128.F b/src/mathlib/gen/d/deriv128.F
deleted file mode 100644
index 8fc9735..0000000
--- a/src/mathlib/gen/d/deriv128.F
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: deriv128.F,v 1.1.1.1 1996/04/01 15:02:24 mclareni Exp $
-*
-* $Log: deriv128.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:24 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if !defined(CERNLIB_DOUBLE)
- SUBROUTINE DDERIV(F,X,DELTA,DFDX,RERR)
-#include "gen/imp128.inc"
- CHARACTER*(*) NAME
- PARAMETER( NAME='DDERIV')
- CALL MTLPRT(NAME,'D401.0','Not available on this machine')
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/d/deriv64.F b/src/mathlib/gen/d/deriv64.F
deleted file mode 100644
index 4b0edd9..0000000
--- a/src/mathlib/gen/d/deriv64.F
+++ /dev/null
@@ -1,126 +0,0 @@
-*
-* $Id: deriv64.F,v 1.1.1.1 1996/04/01 15:02:19 mclareni Exp $
-*
-* $Log: deriv64.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:19 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if !defined(CERNLIB_DOUBLE)
- SUBROUTINE RDERIV(F,X,DELTA,DFDX,RERR)
-#endif
-#if defined(CERNLIB_DOUBLE)
- SUBROUTINE DDERIV(F,X,DELTA,DFDX,RERR)
-#include "gen/imp64.inc"
-#endif
-C Computes the derivative f'(x) of f(x) at x = X. Based on
-C H. Rutishauser, Ausdehnung des Rombergschen Prinzips
-C (Extension of Romberg's Principle), Numer. Math. 5 (1963) 48-54
-
-
- DIMENSION DX(0:9),W(0:9,3),T(0:9,0:9),A(0:9)
- LOGICAL LEV(0:9),LMT
-
- CHARACTER NAME*(*)
- CHARACTER*80 ERRTXT
-#if !defined(CERNLIB_DOUBLE)
- PARAMETER (NAME = 'RDERIV')
- PARAMETER (EPS = 5D-12)
-#endif
-#if defined(CERNLIB_DOUBLE)
- PARAMETER (NAME = 'DDERIV')
- PARAMETER (EPS = 5D-14)
-#endif
- PARAMETER (Z1 = 1, S = Z1/10)
-
- DATA DX /0.0256D0, 0.0192D0, 0.0128D0, 0.0096D0, 0.0064D0,
- 1 0.0048D0, 0.0032D0, 0.0024D0, 0.0016D0, 0.0012D0/
-
- DATA (LEV(K),K=0,8,2) /5*.TRUE./
- DATA (LEV(K),K=1,9,2) /5*.FALSE./
-
- DATA W(1,1) /1.33333 33333 333333D+00/
- DATA W(3,1) /1.06666 66666 666667D+00/
- DATA W(5,1) /1.01587 30158 730159D+00/
- DATA W(7,1) /1.00392 15686 274510D+00/
-
- DATA W(2,1) /3.33333 33333 333333D-01/
- DATA W(4,1) /6.66666 66666 666667D-02/
- DATA W(6,1) /1.58730 15873 015873D-02/
- DATA W(8,1) /3.92156 86274 509804D-03/
-
- DATA W(0,2) /2.28571 42857 142857D+00/
- DATA W(2,2) /1.16363 63636 363636D+00/
- DATA W(4,2) /1.03643 72469 635628D+00/
- DATA W(6,2) /1.00886 69950 738916D+00/
- DATA W(8,2) /1.00220 21042 329337D+00/
-
- DATA W(1,2) /1.28571 42857 142857D+00/
- DATA W(3,2) /1.63636 36363 636364D-01/
- DATA W(5,2) /3.64372 46963 562753D-02/
- DATA W(7,2) /8.86699 50738 916256D-03/
- DATA W(9,2) /2.20210 42329 336922D-03/
-
- DATA W(0,3) /1.80000 00000 000000D+00/
- DATA W(2,3) /1.12500 00000 000000D+00/
- DATA W(4,3) /1.02857 14285 714286D+00/
- DATA W(6,3) /1.00699 30069 930070D+00/
- DATA W(8,3) /1.00173 91304 347826D+00/
-
- DATA W(1,3) /8.00000 00000 000000D-01/
- DATA W(3,3) /1.25000 00000 000000D-01/
- DATA W(5,3) /2.85714 28571 428571D-02/
- DATA W(7,3) /6.99300 69930 069930D-03/
- DATA W(9,3) /1.73913 04347 826087D-03/
-
-#if !defined(CERNLIB_DOUBLE)
- ENTRY DERIV(F,X,DELTA,DFDX,RERR)
-#endif
-
- DEL=10*ABS(DELTA)
- IS=10
-
- 4 IS=IS-1
- DEL=S*DEL
- IF(IS .EQ. 0 .OR. X+DEL*DX(9) .EQ. X) THEN
- DELTA=DEL
- DFDX=0
- RERR=1
- WRITE(ERRTXT,101) X
- CALL MTLPRT(NAME,'D401.1',ERRTXT)
- RETURN
- ENDIF
- DO 1 K = 0,9
- H=DEL*DX(K)
- T(K,0)=(F(X+H)-F(X-H))/(H+H)
- 1 A(K)=T(K,0)
-
- IF(A(0) .GE. A(9)) THEN
- DO 5 K = 0,9
- 5 A(K)=-A(K)
- ENDIF
-
- LMT=.TRUE.
- DO 3 K = 1,9
- H=A(K-1)-A(K)
- 3 LMT=LMT .AND. (H .LE. 0 .OR. ABS(H) .LE. EPS*ABS(A(K)))
- IF(.NOT.LMT) GO TO 4
-
- DO 2 M = 1,9
- DO 2 K = 0,9-M
- IF(LEV(M)) THEN
- T(K,M)=W(M-1,1)*T(K+1,M-1)-W(M,1)*T(K,M-1)
- ELSEIF(LEV(K)) THEN
- T(K,M)=W(M-1,2)*T(K+1,M-1)-W(M,2)*T(K,M-1)
- ELSE
- T(K,M)=W(M-1,3)*T(K+1,M-1)-W(M,3)*T(K,M-1)
- ENDIF
- 2 CONTINUE
- DFDX=T(0,9)
- RERR=0
- IF(DFDX .NE. 0) RERR=(DFDX-T(0,8))/DFDX
- DELTA=DEL
- RETURN
- 101 FORMAT('FAILURE FOR X = ',1P,D15.8)
- END
diff --git a/src/mathlib/gen/d/dfunft.F b/src/mathlib/gen/d/dfunft.F
deleted file mode 100644
index 250834b..0000000
--- a/src/mathlib/gen/d/dfunft.F
+++ /dev/null
@@ -1,159 +0,0 @@
-*
-* $Id: dfunft.F,v 1.1.1.1 1996/04/01 15:02:20 mclareni Exp $
-*
-* $Log: dfunft.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:20 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE DFUNFT(SUB,K,M,N,NX,NC,X,Y,SY,A,AL,AU,MODE,EPS,MAXIT,
- + IPRT,MFR,IAFR,PHI,DPHI,COV,STD,W,NERROR)
-
-#include "gen/imp64.inc"
-
- DIMENSION X(*),Y(*),SY(*)
- DIMENSION A(*),AL(*),AU(*),DPHI(*),IAFR(*)
- DIMENSION COV(NC,*),STD(*)
- DIMENSION W(*)
-
- EXTERNAL SUB
-
-***********************************************************************
-* LEAMAX, VERSION: 15.03.1993
-***********************************************************************
-*
-* DFUNFT IS THE STEERING ROUTINE FOR NONLINEAR LEAST-SQUARES FITTING.
-*
-* SUBROUTINE CALLED: D501L1
-*
-*
-* THE CONSTANTS, VARIABLES AND ARRAYS HAVE THE FOLLOWING MEANING.
-*
-* SUB NAME OF USER-SUPPLIED SUBROUTINE SUBPROGRAM, DECLARED
-* EXTERNAL IN THE CALLING PROGRAM. THIS SUBPROGRAM MUST PROVIDE
-* THE VALUES OF THE FUNCTION AND, IF MODE=1, THE VALUES OF THE
-* DERIVATIVES (SEE EXAMPLE) .
-* K (INTEGER) DIMENSION OF A SINGLE DATA POINT (OBSERVATION) X .
-* M (INTEGER) NUMBER OF DATA POINTS (OBSERVATIONS) .
-* N (INTEGER) NUMBER OF UNKNOWN PARAMETERS A.
-* NX (INTEGER) DECLARED FIRST DIMENSION OF ARRAY X IN THE
-* CALLING PROGRAM, WITH NX .GE. K .
-* NC (INTEGER) DECLARED FIRST DIMENSION OF ARRAY COV IN THE
-* CALLING PROGRAM, WITH NC .GE. N .
-* X (DOUBLE PRECISION) TWO-DIMENSIONAL ARRAY OF DIMENSION (NX,M).
-* ON ENTRY, X MUST CONTAIN THE DATA SET (X(I)) (THE I-TH
-* COLUMN OF X BELONGS TO THE DATA POINT X(I), I=1,...,M).
-* Y (DOUBLE PRECISION) ONE-DIMENSIONAL ARRAY OF LENGTH M ,
-* CONTAINS THE DATA SET (Y(I)) ON ENTRY.
-* SY (DOUBLE PRECISION) ONE-DIMENSIONAL ARRAY OF LENGTH M ,
-* CONTAINS THE WEIGTHS (SIGMA(I)) OF THE DATA POINTS ON ENTRY.
-* A (DOUBLE PRECISION) ONE-DIMENSIONAL ARRAY OF LENGTH N .
-* ON ENTRY, A MUST CONTAIN THE STARTING VALUES OF THE UNKNOWN
-* PARAMETERS FOR THE LEVENBERG-MARQUARDT ALGORITHM.
-* ON EXIT, A CONTAINS AN APPROXIMATION OF THE MINIMUM POINT.
-* AL (DOUBLE PRECISION) ONE-DIMENSIONAL ARRAY OF LENGTH N .
-* ON ENTRY, AL MUST CONTAIN THE LOWER BOUNDS OF A .
-* AU (DOUBLE PRECISION) ONE-DIMENSIONAL ARRAY OF LENGTH N .
-* ON ENTRY, AU MUST CONTAIN THE UPPER BOUNDS OF A .
-* MODE (INTEGER)
-* = 0: THE DERIVATIVE IS COMPUTED NUMERICALLY.
-* = 1: THE DERIVATIVE HAS TO BE EVALUATED IN SUBPROGRAM SUB .
-* EPS (DOUBLE PRECISION) USER-SUPPLIED TOLERANCE USED TO CONTROL
-* THE TERMINATION CRITERION. EPS SHOULD BE CHOSEN ACCORDING
-* TO THE ACCURACY REQUIRED BY THE UNDERLYING PROBLEM AND TO
-* THE MACHINE ACCURACY ALSO (RECOMMENDED VALUE ON ENTRY:
-* 1D-6 ... 1D-12 ).
-* MAXIT (INTEGER) MAXIMUM PERMITTED NUMBER OF ITERATIONS.
-* IPRT (INTEGER) PRINTING CONTROL. G
-* = 0 : NO PRINTING OF INTERMEDIATE RESULTS
-* = +/- L : PRINTING OF INTERMEDIATE RESULTS AT EVERY ABS(L)-TH
-* ITERATION; IF IPRT < 0, PRINTING OF ALL INPUT
-* PARAMETERS OF DSUMSQ IN ADDITION.
-* MFR (INTEGER) ON EXIT, MFR CONTAINS THE NUMBER OF FREE VARIABLES
-* AT THE SOLUTION POINT.
-* IAFR (INTEGER) ONE-DIMENSIONAL ARRAY OF LENGTH 2 * N , USED AS
-* WORKING SPACE. ON EXIT, THE FIRST MFR ELEMENTS OF IAFR
-* CONTAIN THE INDICES OF THE FREE VARIABLES AT THE SOLUTION
-* POINT.
-* PHI (DOUBLE PRECISION) ON EXIT, PHI CONTAINS THE VALUE OF THE
-* OBJECTIVE FUNCTION AT THE MINIMUM POINT.
-* DPHI (DOUBLE PRECISION) ONE-DIMENSIONAL ARRAY OF LENGTH N .
-* ON EXIT, DPHI CONTAINS THE DERIVATIVES OF THE OBJECTIVE
-* FUNCTION WITH RESPECT TO A (THE GRADIENT) AT THE LAST
-* ITERATION POINT.
-* COV (DOUBLE PRECISION) TWO-DIMENSIONAL ARRAY OF DIMENSION (NC,N).
-* ON EXIT, COV CONTAINS AN APPROXIMATION TO THE COVARIANCE
-* MATRIX.
-* STD (DOUBLE PRECISION) ONE-DIMENSIONAL ARRAY OF LENGTH N .
-* ON EXIT, STD CONTAINS APPROXIMATIONS TO THE STANDARD
-* DEVIATIONS OF THE MODEL PARAMETER ESTIMATORS.
-* W (DOUBLE PRECISION) ONE-DIMENSIONAL ARRAY OF LENGTH
-* 9*N+4*M+2*M*N+3*N*N , USED AS WORKING SPACE.
-* NERROR (INTEGER) ERROR INDICATOR. ON EXIT:
-* = 0: NO ERROR OR WARNING DETECTED.
-* = 1: AT LEAST ONE OF THE CONSTANTS K, M, N, NX, NC, MAXIT IS
-* ILLEGAL OR AT LEAST FOR ONE J THE RELATION
-* AL(J) .LE. AU(J) IS NOT TRUE.
-* = 2: THE MAXIMUM NUMBER MAXIT OF ITERATIONS HAS BEEN
-* REACHED.
-* = 3: THE OBJECTIVE FUNCTION PHI OR ITS DERIVATIVE IS NOT
-* DEFINED FOR THE CURRENT VALUES OF THE UNKNOWN
-* PARAMETER VECTOR A.
-* = 4: THE ROUTINES DGEQPF , DORMQR , DTRTRS OF THE LINEAR
-* ALGEBRA PACKAGE LAPACK (F001) WERE UNABLE TO SOLVE
-* THE LINEAR LEAST SQUARES PROBLEMS
-* OR THE ROUTINE DSINV (F012) WAS UNABLE TO COMPUTE THE
-* COVARIANCE MATRIX .
-*
-*************************************************************************
-*
-* THE FOLLOWING SUBROUTINE IS A SIMPLE EXAMPLE FOR SUB.
-*
-* SUBROUTINE SUB (K,X,N,A,F,DF,MODE,NERROR)
-* IMPLICIT DOUBLE PRECISION (A-H,O-Z)
-* DIMENSION A(*),X(*),DF(*)
-*
-* NERROR=0
-* T=X(2)*A(2)+X(3)*A(3)
-* IF (T .EQ. 0) THEN
-* NERROR=1
-* RETURN
-* ENDIF
-*
-* F=A(1)+X(1)/T
-*
-* IF(MODE .EQ. 0) RETURN
-* DF(1)=1
-* DF(2)=-X(1)*X(2)/T**2
-* DF(3)=-X(1)*X(3)/T**2
-* RETURN
-* END
-*
-*************************************************************************
-
- M1=1
- M2=M1+N
- M3=M2+N
- M4=M3+N
- M5=M4+N
- M6=M5+2*M
- M7=M6+3*N
- M8=M7+N
- M9=M8+M+N
- MA=M9+(N+M)*N
- MB=MA+N*N
- MC=MB+N*N
- MD=MC+M
-
- CALL D501L1('DFUNFT',SUB,K,M,X,NX,Y,SY,MODE,EPS,MAXIT,
- 1 IPRT,N,A,AL,AU,PHI,DPHI,IAFR,MFR,COV,NC,STD,
- 2 W(M1),W(M2),W(M3),W(M4),W(M5),W(M6),W(M7),W(M8),
- 3 W(M9),W(MA),W(MB),W(MC),W(MD),IAFR(N+1),NERROR)
-
- RETURN
-
- END
-
-
-
diff --git a/src/mathlib/gen/d/dgquad.F b/src/mathlib/gen/d/dgquad.F
deleted file mode 100644
index 7fa3da4..0000000
--- a/src/mathlib/gen/d/dgquad.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: dgquad.F,v 1.1.1.1 1996/04/01 15:02:15 mclareni Exp $
-*
-* $Log: dgquad.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:15 mclareni
-* Mathlib gen
-*
-*
-* Double Prec. version only on 32 bit machines.
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- FUNCTION DGQUAD(F,A,B,N)
-#include "gen/imp64.inc"
- DIMENSION X(1),W(1)
- EXTERNAL F
-
- CALL D107D1(1,F,A,B,N,X,W)
- DGQUAD=X(1)
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/d/dgs56p.F b/src/mathlib/gen/d/dgs56p.F
deleted file mode 100644
index 0e8c448..0000000
--- a/src/mathlib/gen/d/dgs56p.F
+++ /dev/null
@@ -1,53 +0,0 @@
-*
-* $Id: dgs56p.F,v 1.1.1.1 1996/04/01 15:02:14 mclareni Exp $
-*
-* $Log: dgs56p.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:14 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE DGS56P(F,A,B,RES,ERR)
-#if !defined(CERNLIB_DOUBLE)
-#include "gen/imp128.inc"
- CHARACTER*6 NAME
- NAME = 'DGS56P'
- CALL MTLPRT(NAME,'D106',
- +'not available on this machine - see documentation')
- RETURN
- END
-#endif
-#if defined(CERNLIB_DOUBLE)
- IMPLICIT DOUBLE PRECISION (A-H,O-Z)
-
- PARAMETER (R1 = 1, HF = R1/2)
- DIMENSION X5(5),W5(5),X6(6),W6(6)
-
- DATA (X5(I),W5(I),I=1,5)
- 1/4.6910077030668004D-02, 1.1846344252809454D-01,
- 2 2.3076534494715846D-01, 2.3931433524968324D-01,
- 3 5.0000000000000000D-01, 2.8444444444444444D-01,
- 4 7.6923465505284154D-01, 2.3931433524968324D-01,
- 5 9.5308992296933200D-01, 1.1846344252809454D-01/
-
- DATA (X6(I),W6(I),I=1,6)
- 1/3.3765242898423989D-02, 8.5662246189585178D-02,
- 2 1.6939530676686775D-01, 1.8038078652406930D-01,
- 3 3.8069040695840155D-01, 2.3395696728634552D-01,
- 4 6.1930959304159845D-01, 2.3395696728634552D-01,
- 5 8.3060469323313225D-01, 1.8038078652406930D-01,
- 6 9.6623475710157601D-01, 8.5662246189585178D-02/
-
- RANG=B-A
- E5=0
- E6=0
- DO 1 I = 1,5
- E5=E5+W5(I)*F(A+RANG*X5(I))
- E6=E6+W6(I)*F(A+RANG*X6(I))
- 1 CONTINUE
- E6=E6+W6(6)*F(A+RANG*X6(6))
- RES=HF*(E6+E5)*RANG
- ERR=ABS((E6-E5)*RANG)
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/d/dgset.F b/src/mathlib/gen/d/dgset.F
deleted file mode 100644
index 49600a1..0000000
--- a/src/mathlib/gen/d/dgset.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: dgset.F,v 1.1.1.1 1996/04/01 15:02:15 mclareni Exp $
-*
-* $Log: dgset.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:15 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- SUBROUTINE DGSET(A,B,N,X,W)
-C
-#include "gen/imp64.inc"
-C
- EXTERNAL DGQUAD
- DIMENSION X(*),W(*)
-
- CALL D107D1(2,DGQUAD,A,B,N,X,W)
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/d/dmaxlk.F b/src/mathlib/gen/d/dmaxlk.F
deleted file mode 100644
index 97b07c6..0000000
--- a/src/mathlib/gen/d/dmaxlk.F
+++ /dev/null
@@ -1,121 +0,0 @@
-*
-* $Id: dmaxlk.F,v 1.1.1.1 1996/04/01 15:02:20 mclareni Exp $
-*
-* $Log: dmaxlk.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:20 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE DMAXLK(SUB,K,M,N,NX,X,A,AL,AU,MODE,EPS,MAXIT,IPRT,
- + MFR,IAFR,PHI,DPHI,W,NERROR)
-
-#include "gen/imp64.inc"
- DIMENSION AL(*),AU(*),A(*),DPHI(*),IAFR(*),X(*),W(*)
- EXTERNAL SUB
-
-***********************************************************************
-* LEAMAX, VERSION: 15.03.1993
-***********************************************************************
-*
-* DMAXLK IS THE STEERING ROUTINE FOR MAXIMUM LIKELIHOOD ESTIMATION.
-*
-* SUBROUTINE CALLED: D501L2
-*
-*
-* THE CONSTANTS, VARIABLES AND ARRAYS HAVE THE FOLLOWING MEANING.
-*
-* SUB NAME OF USER-SUPPLIED SUBROUTINE SUBPROGRAM, DECLARED
-* EXTERNAL IN THE CALLING PROGRAM. THIS SUBPROGRAM MUST PROVIDE
-* THE VALUES OF THE FUNCTION AND, IF MODE=1, THE VALUES OF THE
-* DERIVATIVES (SEE EXAMPLE) .
-* K (INTEGER) DIMENSION OF A SINGLE DATA POINT (OBSERVATION) X .
-* M (INTEGER) NUMBER OF DATA POINTS (OBSERVATIONS).
-* N (INTEGER) NUMBER OF UNKNOWN PARAMETERS A.
-* NX (INTEGER) DECLARED FIRST DIMENSION OF ARRAY X IN THE
-* CALLING PROGRAM, WITH NX .GE. K .
-* X (DOUBLE PRECISION) TWO-DIMENSIONAL ARRAY OF DIMENSION (NX,M).
-* ON ENTRY, X MUST CONTAIN THE DATA SET (X(I)) (THE I-TH
-* COLUMN OF X BELONGS TO THE DATA POINT X(I), I=1,...,M).
-* A (DOUBLE PRECISION) ONE-DIMENSIONAL ARRAY OF LENGTH N .
-* ON ENTRY, A MUST CONTAIN THE STARTING VALUES OF THE UNKNOWN
-* PARAMETERS FOR THE LEVENBERG-MARQUARDT ALGORITHM.
-* ON EXIT, A CONTAINS AN APPROXIMATION OF THE MINIMUM POINT.
-* AL (DOUBLE PRECISION) ONE-DIMENSIONAL ARRAY OF LENGTH N .
-* ON ENTRY, AL MUST CONTAIN THE LOWER BOUNDS OF A .
-* AU (DOUBLE PRECISION) ONE-DIMENSIONAL ARRAY OF LENGTH N .
-* ON ENTRY, AU MUST CONTAIN THE UPPER BOUNDS OF A .
-* MODE (INTEGER)
-* = 0: THE DERIVATIVE IS COMPUTED NUMERICALLY.
-* = 1: THE DERIVATIVE HAS TO BE EVALUATED IN SUBPROGRAM SUB .
-* EPS (DOUBLE PRECISION) USER-SUPPLIED TOLERANCE USED TO CONTROL
-* THE TERMINATION CRITERION. EPS SHOULD BE CHOSEN ACCORDING
-* TO THE ACCURACY REQUIRED BY THE UNDERLYING PROBLEM AND TO
-* THE MACHINE ACCURACY ALSO (RECOMMENDED VALUE ON ENTRY:
-* 1D-6 ... 1D-12 ).
-* MAXIT (INTEGER) MAXIMUM PERMITTED NUMBER OF ITERATIONS.
-* IPRT (INTEGER) PRINTING CONTROL. G
-* = 0 : NO PRINTING OF INTERMEDIATE RESULTS
-* = +/- L : PRINTING OF INTERMEDIATE RESULTS AT EVERY ABS(L)-TH
-* ITERATION; IF IPRT < 0, PRINTING OF ALL INPUT
-* PARAMETERS OF DSUMSQ IN ADDITION.
-* MFR (INTEGER) ON EXIT, MFR CONTAINS THE NUMBER OF FREE VARIABLES
-* AT THE SOLUTION POINT.
-* IAFR (INTEGER) ONE-DIMENSIONAL ARRAY OF LENGTH >= N , USED AS
-* WORKING SPACE. ON EXIT, THE FIRST MFR ELEMENTS OF IAFR
-* CONTAIN THE INDICES OF THE FREE VARIABLES AT THE SOLUTION
-* POINT.
-* PHI (DOUBLE PRECISION) ON EXIT, PHI CONTAINS THE VALUE OF THE
-* OBJECTIVE FUNCTION AT THE MINIMUM POINT.
-* DPHI (DOUBLE PRECISION) ONE-DIMENSIONAL ARRAY OF LENGTH N .
-* ON EXIT, DPHI CONTAINS THE DERIVATIVES OF THE OBJECTIVE
-* FUNCTION WITH RESPECT TO A (THE GRADIENT) AT THE LAST
-* ITERATION POINT.
-* W (DOUBLE PRECISION) ONE-DIMENSIONAL ARRAY OF LENGTH
-* 7*N+2*N*N , USED AS WORKING SPACE.
-* NERROR (INTEGER) ERROR INDICATOR. ON EXIT:
-* = 0: NO ERROR OR WARNING DETECTED.
-* = 1: AT LEAST ONE OF THE CONSTANTS K, M, N, NX, MAXIT IS
-* ILLEGAL OR AT LEAST FOR ONE J THE RELATION
-* AL(J) .LE. AU(J) IS NOT TRUE.
-* = 2: THE MAXIMUM NUMBER MAXIT OF ITERATIONS HAS BEEN
-* REACHED.
-* = 3: THE OBJECTIVE FUNCTION PHI OR ITS DERIVATIVE IS NOT
-* DEFINED FOR THE CURRENT VALUES OF THE UNKNOWN
-* PARAMETER VECTOR A.
-* = 4: THE ROUTINE DSINV (F012) WAS UNABLE TO SOLVE THE
-* NORMAL EQUATIONS.
-*
-*************************************************************************
-*
-* THE FOLLOWING SUBROUTINE IS A SIMPLE EXAMPLE FOR SUB.
-*
-* SUBROUTINE SUB(K,X,N,A,F,DF,MODE,NERROR)
-*
-* IMPLICIT DOUBLE PRECISION (A-H,O-Z)
-* DIMENSION A(*),X(*),DF(*)
-* PARAMETER (PIR = 0.56418 95835 47756 287D0)
-* NERROR=1
-* IF(A(1) .EQ. 0) RETURN
-* T=0.5D0*((X(1)-1)/A(1))**2)
-* F=PIR*EXP(-T)/A(1)
-* IF(F .EQ. 0) RETURN
-* NERROR=0
-* IF(MODE .NE. 0) DF(1)=-F*(1-2*T)/A(1)**2
-* RETURN
-* END
-*
-*************************************************************************
-
- CALL D501L2(K,M,X,NX,MODE,EPS,MAXIT,IPRT,N,A,AL,AU,
- 1 PHI,DPHI,IAFR,MFR,W(1),W(N+1),W(2*N+1),W(3*N+1),
- 2 W(4*N+1),W(5*N+1),W(6*N+1),W(7*N+1),W(7*N+N*N+1),
- 3 SUB,NERROR)
-
- RETURN
-
- END
-
-
-
-
diff --git a/src/mathlib/gen/d/dsumsq.F b/src/mathlib/gen/d/dsumsq.F
deleted file mode 100644
index c0edafa..0000000
--- a/src/mathlib/gen/d/dsumsq.F
+++ /dev/null
@@ -1,146 +0,0 @@
-*
-* $Id: dsumsq.F,v 1.1.1.1 1996/04/01 15:02:20 mclareni Exp $
-*
-* $Log: dsumsq.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:20 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE DSUMSQ(SUB,M,N,NC,A,AL,AU,MODE,EPS,MAXIT,IPRT,
- + MFR,IAFR,PHI,DPHI,COV,STD,W,NERROR)
-
-#include "gen/imp64.inc"
-
- DIMENSION A(*),AL(*),AU(*),DPHI(*),IAFR(*)
- DIMENSION COV(NC,*),STD(*)
- DIMENSION W(*)
-
- EXTERNAL SUB
-
-
-***********************************************************************
-* LEAMAX, VERSION: 15.03.1993
-************************************************************************
-*
-* DSUMSQ IS THE STEERING ROUTINE FOR MINIMIZING A SUM OF SQUARES
-*
-* SUBROUTINE CALLED: D501L1
-*
-*
-* THE CONSTANTS, VARIABLES AND ARRAYS HAVE THE FOLLOWING MEANING.
-*
-* SUB NAME OF USER-SUPPLIED SUBROUTINE SUBPROGRAM, DECLARED
-* EXTERNAL IN THE CALLING PROGRAM. THIS SUBPROGRAM MUST PROVIDE
-* THE VALUES OF THE FUNCTION AND, IF MODE=1, THE VALUES OF THE
-* DERIVATIVES (SEE EXAMPLE) .
-* M (INTEGER) NUMBER OF NONLINEAR FUNCTIONS.
-* N (INTEGER) NUMBER OF UNKNOWN PARAMETERS A.
-* NC (INTEGER) DECLARED FIRST DIMENSION OF ARRAY COV IN THE
-* CALLING PROGRAM, WITH NC .GE. N .
-* A (DOUBLE PRECISION) ONE-DIMENSIONAL ARRAY OF LENGTH N .
-* ON ENTRY, A MUST CONTAIN THE STARTING VALUES OF THE UNKNOWN
-* PARAMETERS FOR THE LEVENBERG-MARQUARDT ALGORITHM.
-* ON EXIT, A CONTAINS AN APPROXIMATION OF THE MINIMUM POINT.
-* AL (DOUBLE PRECISION) ONE-DIMENSIONAL ARRAY OF LENGTH N .
-* ON ENTRY, AL MUST CONTAIN THE LOWER BOUNDS OF A .
-* AU (DOUBLE PRECISION) ONE-DIMENSIONAL ARRAY OF LENGTH N .
-* ON ENTRY, AU MUST CONTAIN THE UPPER BOUNDS OF A .
-* MODE (INTEGER)
-* = 0: THE JACOBIAN IS COMPUTED NUMERICALLY
-* = 1: THE JACOBIAN HAS TO BE EVALUATED IN SUBPROGRAM SUB .
-* EPS (DOUBLE PRECISION) USER-SUPPLIED TOLERANCE USED TO CONTROL
-* THE TERMINATION CRITERION. EPS SHOULD BE CHOSEN ACCORDING
-* TO THE ACCURACY REQUIRED BY THE UNDERLYING PROBLEM AND TO
-* THE MACHINE ACCURACY ALSO (RECOMMENDED VALUE ON ENTRY:
-* 1D-6 ... 1D-12 ).
-* MAXIT (INTEGER) MAXIMUM PERMITTED NUMBER OF ITERATIONS.
-* IPRT (INTEGER) PRINTING CONTROL.
-* = 0 : NO PRINTING OF INTERMEDIATE RESULTS
-* = +/- L : PRINTING OF INTERMEDIATE RESULTS AT EVERY ABS(L)-TH
-* ITERATION; IF IPRT < 0, PRINTING OF ALL INPUT
-* PARAMETERS OF DSUMSQ IN ADDITION.
-* MFR (INTEGER) ON EXIT, MFR CONTAINS THE NUMBER OF FREE VARIABLES
-* AT THE SOLUTION POINT.
-* IAFR (INTEGER) ONE-DIMENSIONAL ARRAY OF LENGTH 2 * N , USED AS
-* WORKING SPACE. ON EXIT, THE FIRST MFR ELEMENTS OF IAFR
-* CONTAIN THE INDICES OF THE FREE VARIABLES AT THE SOLUTION
-* POINT.
-* PHI (DOUBLE PRECISION) ON EXIT, PHI CONTAINS THE VALUE OF THE
-* OBJECTIVE FUNCTION AT THE MINIMUM POINT.
-* DPHI (DOUBLE PRECISION) ONE-DIMENSIONAL ARRAY OF LENGTH N .
-* ON EXIT, DPHI CONTAINS THE DERIVATIVES OF THE OBJECTIVE
-* FUNCTION WITH RESPECT TO A (THE GRADIENT) AT THE LAST
-* ITERATION POINT.
-* COV (DOUBLE PRECISION) TWO-DIMENSIONAL ARRAY OF DIMENSION (NC,N).
-* ON EXIT, COV CONTAINS AN APPROXIMATION TO THE COVARIANCE
-* MATRIX.
-* STD (DOUBLE PRECISION) ONE-DIMENSIONAL ARRAY OF LENGTH N .
-* ON EXIT, STD CONTAINS APPROXIMATIONS TO THE STANDARD
-* DEVIATIONS OF THE MODEL PARAMETER ESTIMATORS.
-* W (DOUBLE PRECISION) ONE-DIMENSIONAL ARRAY OF LENGTH
-* 9*N+4*M+2*M*N+3*N*N , USED AS WORKING SPACE.
-* NERROR (INTEGER) ERROR INDICATOR. ON EXIT:
-* = 0: NO ERROR OR WARNING DETECTED.
-* = 1: AT LEAST ONE OF THE CONSTANTS M, N, NC, MAXIT IS
-* ILLEGAL OR AT LEAST FOR ONE J THE RELATION
-* AL(J) .LE. AU(J) IS NOT TRUE.
-* = 2: THE MAXIMUM NUMBER MAXIT OF ITERATIONS HAS BEEN
-* REACHED.
-* = 3: THE OBJECTIVE FUNCTION PHI OR ITS DERIVATIVE IS NOT
-* DEFINED FOR THE CURRENT VALUES OF THE UNKNOWN
-* PARAMETER VECTOR A.
-* = 4: THE ROUTINES DGEQPF , DORMQR , DTRTRS OF THE LINEAR
-* ALGEBRA PACKAGE LAPACK (F001) WERE UNABLE TO SOLVE
-* THE LINEAR LEAST SQUARES PROBLEMS
-* OR THE ROUTINE DSINV (F012) WAS UNABLE TO COMPUTE THE
-* COVARIANCE MATRIX .
-*
-*************************************************************************
-*
-* THE FOLLOWING SUBROUTINE IS A SIMPLE EXAMPLE FOR SUB.
-*
-* SUBROUTINE SUB(N,A,M,F,DF,MODE,NERROR)
-* IMPLICIT DOUBLE PRECISION (A-H,O-Z)
-* PARAMETER (Z0 = 0)
-* DIMENSION A(*),F(*),DF(M,*)
-* NERROR=0
-* F(1)=A(1)-1D6
-* F(2)=A(2)-2D-6
-* F(3)=A(1)*A(2)-2
-* IF(MODE .EQ. 0) RETURN
-* CALL DMSET(M,N,Z0,DF(1,1),DF(1,2),DF(2,1))
-* DF(1,1)=1
-* DF(2,2)=1
-* DF(3,1)=A(2)
-* DF(3,2)=A(1)
-* RETURN
-* END
-*
-*************************************************************************
-
- M1=1
- M2=M1+N
- M3=M2+N
- M4=M3+N
- M5=M4+N
- M6=M5+2*M
- M7=M6+3*N
- M8=M7+N
- M9=M8+M+N
- MA=M9+(N+M)*N
- MB=MA+N*N
- MC=MB+N*N
- MD=MC+M
-
- CALL D501L1('DSUMSQ',SUB,1,M,X,1,Y,SY,MODE,EPS,MAXIT,
- 1 IPRT,N,A,AL,AU,PHI,DPHI,IAFR,MFR,COV,NC,STD,
- 2 W(M1),W(M2),W(M3),W(M4),W(M5),W(M6),W(M7),W(M8),
- 3 W(M9),W(MA),W(MB),W(MC),W(MD),IAFR(N+1),NERROR)
-
- RETURN
-
- END
-
-
-
diff --git a/src/mathlib/gen/d/elanal.F b/src/mathlib/gen/d/elanal.F
deleted file mode 100644
index f9e6998..0000000
--- a/src/mathlib/gen/d/elanal.F
+++ /dev/null
@@ -1,49 +0,0 @@
-*
-* $Id: elanal.F,v 1.1.1.1 1996/04/01 15:02:18 mclareni Exp $
-*
-* $Log: elanal.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:18 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE ELANAL (MP,N,IBCX,POT,POTW,POTE,POTS,POTN)
- COMMON/FW1/W1(774)/FW2/W2(100)
- DIMENSION POT(MP,N)
- DIMENSION POTW(N),POTE(N),POTS(MP),POTN(MP)
- M=MP-1
- MD=MP+M
- AX=(1./LOG10(2.))+.01
- XM=M
- AM=AX*LOG10(XM)
- IM=INT(AM)
- IF(IBCX.EQ.4) GO TO 400
-C THE RFT ROUTINE IS A MODIFIED
-C VERSION OF HOCKNEY FAST FOURIER
-C TRANSFORM PACKAGE AND CORRESPONDS TO
-C ISELIN LIBRARY PROGRAM D 700
-C
- CALL RFT(IM,POTS,1,W1(2*MP+1),1,IBCX)
- CALL RFT(IM,POTN,1,W1(3*MP+1),1,IBCX)
- DO 1 J=1,N
- 1 CALL RFT(IM,POT(1,J),1,POT(1,J),1,IBCX)
- RETURN
-C
-C THE MFT ROUTINE IS USED FOR
-C THE FOURTH TYPE OF BOUNDARY
-C CONDITION ALONG X
-C
- 400 CALL MFT(MP,MD,POTS,W1(2*MP+1),W1(4*MP+1),1)
- CALL MFT(MP,MD,POTN,W1(3*MP+1),W1(4*MP+1),1)
-C
- DO 2 J=1,N
- DO 3 I=1,MP
- 3 W1(I)=POT(I,J)
-C
- CALL MFT(MP,MD,W1,W1(MP+1),W1(4*MP+1),1)
-C
- DO 4 I=1,MP
- 4 POT(I,J)=W1(I+MP)
- 2 CONTINUE
- RETURN
- END
diff --git a/src/mathlib/gen/d/elpahy.F b/src/mathlib/gen/d/elpahy.F
deleted file mode 100644
index 41d3b92..0000000
--- a/src/mathlib/gen/d/elpahy.F
+++ /dev/null
@@ -1,125 +0,0 @@
-*
-* $Id: elpahy.F,v 1.1.1.1 1996/04/01 15:02:18 mclareni Exp $
-*
-* $Log: elpahy.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:18 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE ELPAHY(F,IDIM1,IDIM2,DX,DY,COEFS,IBX,BWEST,BEAST,
- 1JBY,BSOUTH,BNORTH)
- DIMENSION COEFS(3)
- DIMENSION F(IDIM1,IDIM2)
- DIMENSION BWEST(IDIM2),BEAST(IDIM2),BNORTH(IDIM1),BSOUTH(IDIM1)
-C------------------------------------------
-C KIND OF EQUATION AND COEFFICIENTS I
-C------------------------------------------
-C IKIND=1-ELLIPTIC ,=2-PARABOLIC ,=3-HYPERBOLIC
-C
-C DX2+AD*DY2+BD*DY+CD*Y=SOURCE
-C
- AD=COEFS(1)
- BD=COEFS(2)
- CD=COEFS(3)
- IF(AD) 510,511,512
- 510 IKIND=3
- GO TO 513
- 511 IKIND=2
- GO TO 513
- 512 IKIND=1
- 513 CONTINUE
-C------------------------------------------
-C MESH DIVISION AND CELL SIZE I
-C------------------------------------------
-C IDIM1 DIVISIONS ALONG THE X-DIRECTION
-C IDIM2 DIVISIONS ALONG THE Y-DIRECTION
-C DX = CELL SIZE ALOND X
-C DY = CELL SIZE ALONG Y
-C
- RAT=DX/DY
- RAT2=RAT*RAT
- DX2=DX*DX
- AT=RAT2*AD
- BT=RAT*DX*BD
- CT=DX2*CD
- DO 1 I=1,IDIM1
- DO 1 J=1,IDIM2
- 1 F(I,J)=DX2*F(I,J)
-C------------------------------------------
-C BOUNDARY CONDITIONS I
-C------------------------------------------
-C ALONG THE WEST AND EAST BOUNDARIES
-C IBX=1-PERIODIC ,=2-DERIVATIVE ,=3-VALUE ,=4-VALUE+DERIVATIVE
-C
-C ALONG THE SOUTH AND NORTH BOUNDARIES
-C JBY=1 VALUE=BSOUTH(I) ,VALUE=BNORTH(I)
-C JBY=2 DERIVATIVE=BSOUTH(I) ,DERIVATIVE=BNORTH(I)
-C JBY=3 VALUE=BSOUTH(I) ,DERIVATIVE=BNORTH(I)
-C JBY=4 DERIVATIVE=BSOUTH(I) ,VALUE=BNORTH(I)
-C
- GO TO (520,521,522,523) ,JBY
- 520 ALFAS=1.
- BETAS=0.
- ALFAN=1.
- BETAN=0.
- GO TO 524
- 521 ALFAS=0.
- BETAS=1.
- ALFAN=0.
- BETAN=1.
- GO TO 524
- 522 ALFAS=1.
- BETAS=0.
- ALFAN=0.
- BETAN=1.
- GO TO 524
- 523 ALFAS=0.
- BETAS=1.
- ALFAN=1.
- BETAN=0.
- 524 CONTINUE
-C
-C THIS SUBROUTINE MODIFIES THE SOURCE TERM
-C AT EACH END OF THE X-RANGE ACCORDING
-C TO THE TYPE OF BOUNDARY CONDITIONS
-C CHOSEN ALONG THAT DIRECTION
-C
- CALL NEWRO(IDIM1,IDIM2,IBX,DX,F,BWEST,BEAST,BSOUTH,BNORTH)
-C
-C THIS SUBROUTINE PERFORMS THE APPROPRIATE
-C FOURIER ANALYSIS OF THE SOURCE TERM
-C ALONG THE X-DIRECTION USING FAST FOURIER
-C TRANSFORM TECHNIQUES
-C
- CALL ELANAL(IDIM1,IDIM2,IBX,F,BWEST,BEAST,BSOUTH,BNORTH)
-C
-C THIS SUBROUTINE SOLVES THE TWO-POINTS
-C OR THREE-POINTS RECURRENCE FORMULA ALONG
-C THE SECOND DIMENSION FOR EITHER ONE OF
-C THE ELLIPTIC,PARABOLIC OR HYPERBOLIC TYPE
-C OF EQUATIONS
-C
- CALL ESOLVE(IDIM1,IDIM2,AT,BT,CT,DY,IBX,ALFAS,BETAS,ALFAN,BETAN,
- 1F,IKIND)
-C
-C THIS SUBROUTINE PERFORMS THE APPROPRIATE
-C FOURIER SYNTHESIS OF THE UNKNOWWN FUNCTION
-C ALONG THE X-DIRECTION USING FAST FOURIER
-C TRANSFORM TECHNIQUES
-C
- CALL SYNT(IDIM1,IDIM2,IBX,F)
-C
-C
- GO TO (100,110,120,130),IBX
- 100 DO 101 J=1,IDIM2
- 101 F(IDIM1,J)=F(1,J)
- GO TO 110
- 120 DO 121 J=1,IDIM2
- F(1,J)=BWEST(J)
- 121 F(IDIM1,J)=BEAST(J)
- GO TO 110
- 130 DO 131 J=1,IDIM2
- 131 F(1,J)=BWEST(J)
- 110 RETURN
- END
diff --git a/src/mathlib/gen/d/epdbps.F b/src/mathlib/gen/d/epdbps.F
deleted file mode 100644
index 8695c7e..0000000
--- a/src/mathlib/gen/d/epdbps.F
+++ /dev/null
@@ -1,35 +0,0 @@
-*
-* $Id: epdbps.F,v 1.1.1.1 1996/04/01 15:02:17 mclareni Exp $
-*
-* $Log: epdbps.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:17 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE EPDBPS(Y1,Y2,X1,X2,U1,U2,NC1,NC2,DY,NBPR,XB,PHI,KODE)
-C
-C TO SET UP TABLE OF MESH BOUNDARY POINTS
-C
- DIMENSION NBPR(200),XB(200,20),PHI(200,20),KODE(200,20)
- IF(Y1-Y2)8,7,8
- 7 RETURN
- 8 YU=MAX(Y1,Y2)
- YL=MIN(Y1,Y2)
- MRNL=INT(YL/DY)+2
- MRNU=INT(YU/DY)+1
- IF(MRNU-MRNL)7,9,9
- 9 SLOP1=(X2-X1)/(Y2-Y1)
- SLOP2=(U2-U1)/(Y2-Y1)
- DO 13 J=MRNL,MRNU
- L=NBPR(J)+1
- DIFF=(J-1)*DY-Y1
- XB(J,L)=X1+DIFF*SLOP1
- IF(NC1-NC2)12,10,12
- 10 IF(NC1)11,12,11
- 11 KODE(J,L)=-NC1
- GO TO 13
- 12 PHI(J,L)=U1+DIFF*SLOP2
- 13 NBPR(J)=L
- RETURN
- END
diff --git a/src/mathlib/gen/d/epdchk.F b/src/mathlib/gen/d/epdchk.F
deleted file mode 100644
index 9ad8c4c..0000000
--- a/src/mathlib/gen/d/epdchk.F
+++ /dev/null
@@ -1,85 +0,0 @@
-*
-* $Id: epdchk.F,v 1.1.1.1 1996/04/01 15:02:17 mclareni Exp $
-*
-* $Log: epdchk.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:17 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE EPDCHK(XDATA,YDATA,UDATA,NPTS)
-C
- DIMENSION XDATA(500),YDATA(500),UDATA(500),NT3(780),UT3(780),
- 1NT4(780),HT4(780,4),KT4(780),NT5(390,2)
- COMMON C5 , C95 , NT3 , UT3 , NT4 , HT4
- COMMON KT4 , NT5 , NE3 , NE4 , NE5 , NC
- COMMON NR , KODBAS , DX , DY
- DO 30 IN=1,NE4
- DO 20 INN=1,4
- IF(HT4(IN,INN))5,20,5
- 5 GO TO (6,7,8,9),INN
- 6 N=NT4(IN)+1
- GO TO 10
- 7 N=NT4(IN)+NC
- GO TO 10
- 8 N=NT4(IN)-1
- GO TO 10
- 9 N=NT4(IN)-NC
- 10 DO 11 J1=1,NE3
- IF(NT3(J1)-N)11,20,11
- 11 CONTINUE
- DO 12 J2=1,NE4
- IF(NT4(J2)-N)12,20,12
- 12 CONTINUE
- DO 14 J3=1,NE5
- IF(N-NT5(J3,1))14,20,13
- 13 IF(NT5(J3,2)-N)14,20,20
- 14 CONTINUE
- DO 15 K=1,4
- IF(HT4(IN,K))15,16,15
- 15 CONTINUE
- 17 WRITE(6,100)NT4(IN),N
- STOP
-C---------
- 16 M=NT4(IN)
- YM=((M-1)/NC)*DY
- Q=MOD(M-1,NC)
- XM=Q*DX
- GO TO (21,40,21,40),INN
- 21 DO 26 IP=1,NPTS
- IF(ABS(YDATA(IP)-YM)-.003*DY)22,26,26
- 22 RHO=(XDATA(IP)-XM)/DX
- IF(INN-1)23,24,23
- 23 RHO=-RHO
- 24 IF(RHO)26,25,25
- 25 IF(1.0-RHO)26,27,27
- 26 CONTINUE
- GO TO 17
- 40 DO 46 IP=1,NPTS
- IF(ABS(XDATA(IP)-XM)-.003*DX)42,46,46
- 42 RHO=(YDATA(IP)-YM)/DY
- IF(INN-2)43,44,43
- 43 RHO=-RHO
- 44 IF(RHO)46,45,45
- 45 IF(1.0-RHO)46,27,27
- 46 CONTINUE
- GO TO 17
- 27 IF(C5-RHO)52,52,50
- 50 NE3=NE3+1
- NT3(NE3)=M
- UT3(NE3)=UDATA(IP)
- NT4(IN)=0
- GO TO 30
- 52 NE3=NE3+1
- NT3(NE3)=N
- UT3(NE3)=UDATA(IP)
- IF(RHO-C95)54,54,53
- 53 RHO=1.0
- 54 HT4(IN,INN)=RHO
- 20 CONTINUE
- 30 CONTINUE
- RETURN
- 100 FORMAT('0 POINT NUMBER',I5,' HAS NEIGHBOUR-POINT NUMBER',I5,
- 1'FOR WHICH'/' NO BOUNDARY VALUE OR FINITE DIFFERENCE EQUATION',
- 2' IS AVAILABLE')
- END
diff --git a/src/mathlib/gen/d/epdchn.F b/src/mathlib/gen/d/epdchn.F
deleted file mode 100644
index ec48bcd..0000000
--- a/src/mathlib/gen/d/epdchn.F
+++ /dev/null
@@ -1,124 +0,0 @@
-*
-* $Id: epdchn.F,v 1.1.1.1 1996/04/01 15:02:17 mclareni Exp $
-*
-* $Log: epdchn.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:17 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE EPDCHN(DUM1,DUM2)
-C-----SUBROUTINE NAME CHANGED FROM **CHAIN**. LIBRARY, APRIL 72.
-C
- DIMENSION DUM(9)
- DIMENSION NT3(780),UT3(780),NT4(780),HT4(780,4),KT4(780),
- 1NT5(390,2),UMAT(3250),NUMPT(2900),DIFCO(2900,5),P(12)
- COMMON C5,C95,NT3,UT3,NT4,HT4,KT4,NT5,NE3,NE4,NE5,NC,NR,KODBAS,
- 1DX,DY,JOBNUM,UMAT,NEQU,NPIA,EWANT,BFINAL,NLITS,NBFREF,DUM,
- 2OPM,BETA,BEEPR,EIGEN,NIT,NITP,NUMPT,DIFCO
- GNORML=1.0
- MTAPE=4
- IF(C5-0.0002)21,72,21
- 72 NLITS=0
- OPM=1.0
- C5=0.0002001
-C*UL 71 NPIA=NC*NR
- NPIA=NC*NR
- READ 100,BFINAL,EWANT,INPTMK
- EWANT=EWANT/100.0
- MKCON=0
-C*UL 10 NTAPE=5
- NTAPE=5
- IF(INPTMK-1)1,6,6
- 1 MKCON=0
- EIGEN=0.95
- NIT=0
- BETA=1.0
- IF(BFINAL-1.0)3,3,2
- 2 EIGEN=BFINAL-1.0
- 3 DO 4 I=1,NPIA
- 4 UMAT(I)=0.0
- GO TO 9
- 6 READ (NTAPE,101)JUNK,WOT,WOT,NRO,NCO
- IF(NR+NC-NRO-NCO)7,8,7
- 7 REWIND NTAPE
- GO TO 1
- 8 READ (NTAPE,108)BFINAL,EIGEN,BETA,BEEPR,NIT,JUNK, (UMAT(I),I=1,NPI
- 1A)
- REWIND NTAPE
- 9 NITSUB=0
- IF(MKCON)16,11,16
- 11 NITSUB=NIT
- 16 DO 18 I3=1,NE3
- JK=NT3(I3)
- 18 UMAT(JK)=UT3(I3)
-C*UL 20 CALL USER1
- CALL USER1
- 21 CALL EPDECC
-C BEGIN ITERATION
- 22 NC12=0
- 23 CALL EPDITR(BETA,DMAX,UCORR,ICORR,GNORM)
- NIT=NIT+1
- EMAX=EIGEN*DMAX/(ABS(UCORR)*(1.0-EIGEN))
- NC12=NC12+1
- NITA=NIT-NITSUB
- WRITE(6,103)NITA,BETA,GNORM,NUMPT(ICORR),DMAX,UCORR,EIGEN,EMAX
- IF(EMAX-EWANT)75,75,35
- 75 IF(OPM)30,76,30
- 30 WRITE (MTAPE,101)JOBNUM,DX,DY,NR,NC
- WRITE (MTAPE,102)BFINAL,EIGEN,BETA,BEEPR,NITA,(UMAT(I),I=1,NPIA)
- WRITE (MTAPE,105)NE3,NE4,NE5,(NT3(I),UT3(I),I=1,NE3)
- WRITE (MTAPE,106)(NT4(I),(HT4(I,J),J=1,4),KT4(I),I=1,NE4)
- WRITE (MTAPE,107)(NT5(I,1),NT5(I,2),I=1,NE5)
-C THE NEXT TWO COMMENTED INSTRUCTIONS ARE REQUIRED IF MTAPE REFERS TO
-C A TAPE TO BE PRINTED OFF LINE.
-C 555 END FILE MTAPE
-C REWIND MTAPE
- 76 IF(EMAX-EWANT)31,31,42
- 31 CALL USER2
- GO TO 21
- 35 IF(NIT-1)36,36,40
- 36 BETA=1.375
- IF(BFINAL)22,22,38
- 38 BETA=BFINAL
- GO TO 22
- 40 IF(BFINAL)45,45,22
- 42 GOTO 777
-C---------
- 45 P(NC12)=GNORM/GNORML
- IF(NC12-12)47,49,49
- 47 GNORML=GNORM
- GO TO 23
- 49 IF(NIT-13)50,51,50
- 50 EIGEN=P(12)
- GO TO 58
- 51 D10=P(10)-P(11)
- D11=P(11)-P(12)
- IF(D11)56,56,55
- 55 IF(D10-D11)50,50,57
- 56 IF(D11-D10)50,50,57
- 57 EIGEN=P(10)-D10**2/(D10-D11)
- IF(EIGEN-1.0)58,50,50
- 58 IF(EIGEN-1.0)59,60,60
- 59 BEENW=2.0/(1.0+SQRT(1.0-(EIGEN+BETA-1.0)**2/(EIGEN*BETA**2)))
- IF(ABS(BEENW-BEEPR)/(2.0-BEENW)-.05)60,65,65
- 60 BFINAL=BEENW
- BETA=BFINAL
- EIGEN=BETA-1.0
- GO TO 70
- 65 BEEPR=BEENW
- BETA=BEENW-(2.0-BEENW)/4.0
- 70 WRITE(6,104)P(10),P(11),P(12),EIGEN,BEENW
- GO TO 22
-C-------------
- 777 STOP
- 100 FORMAT(2E15.7,15X,I5)
- 101 FORMAT(I15,2E15.7,2I15)
- 102 FORMAT(4E15.7,I15//(1P,7E15.7))
- 104 FORMAT(//5F15.7//)
- 103 FORMAT(I5,1P,2E15.7,I5,4E15.7)
- 105 FORMAT(///3I15///(I6,1P,E15.7))
- 106 FORMAT(///(I6,4F10.6,I6))
- 107 FORMAT(///(2I6))
- 108 FORMAT(4E15.7,I15/I10/(7E15.7))
- END
diff --git a/src/mathlib/gen/d/epdcj.F b/src/mathlib/gen/d/epdcj.F
deleted file mode 100644
index bece0f4..0000000
--- a/src/mathlib/gen/d/epdcj.F
+++ /dev/null
@@ -1,62 +0,0 @@
-*
-* $Id: epdcj.F,v 1.1.1.1 1996/04/01 15:02:17 mclareni Exp $
-*
-* $Log: epdcj.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:17 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE EPDCJ(HL,UL,MKR,UWANT)
-C
-C TREATMENT OF POINT JUST EXTERIOR/COMPLETELY EXTERIOR
-C
- DIMENSION HL(4),UL(4)
- COMMON C5 , C95
- MARK=0
- NHNOT1=0
- NFIXU=0
- DO 10 J=1,4
- IF(HL(J)-1.0)5,10,5
- 5 NHNOT1=NHNOT1+1
- CALL EPDFIX(UL(J),NS)
- IF(NS)10,10,7
- 7 L=J
- NFIXU=NFIXU+1
- 10 CONTINUE
- IF(NFIXU-1)15,30,11
- 11 MKR=6
- RETURN
- 15 L=5
- 14 HMIN=1.0
- DO 18 J=1,4
- IF(J-L)16,18,16
- 16 IF(HL(J)-HMIN)17,18,18
- 17 HMIN=HL(J)
- I=J
- 18 CONTINUE
- IF(MARK)22,20,22
- 20 UWANT=UL(I)
- MKR=2
- RETURN
- 22 IF(HMIN-C95)25,25,24
- 24 UWANT=UL(L)
- J=MOD(L+1,4)+1
- HL(L)=HL(J)
- HL(J)=0.0
- MKR=3
- RETURN
- 25 MKR=7
- RETURN
- 30 IF(NHNOT1-1)35,31,35
- 31 IF(HL(L)-C95)33,33,32
- 32 MKR=4
- RETURN
- 33 IF(HL(L)-C5)24,34,34
- 34 MKR=5
- RETURN
- 35 IF(HL(L)-C95)36,36,14
- 36 IF(HL(L)-C5)37,34,34
- 37 MARK=1
- GO TO 14
- END
diff --git a/src/mathlib/gen/d/epde1.F b/src/mathlib/gen/d/epde1.F
deleted file mode 100644
index b8efe1a..0000000
--- a/src/mathlib/gen/d/epde1.F
+++ /dev/null
@@ -1,134 +0,0 @@
-*
-* $Id: epde1.F,v 1.1.1.1 1996/04/01 15:02:18 mclareni Exp $
-*
-* $Log: epde1.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:18 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE EPDE1
-C-----SEGMENT CHANGED FROM PROGRAM TO SUBROUTINE. LIBRARY. APRIL 72.
-C
- COMMON C5 , C95 , NT3 , UT3 , NT4 , HT4
- COMMON KT4 , NT5 , NE3 , NE4 , NE5 , NC
- COMMON NR , KODBAS , DX , DY , JOBNUM
- DIMENSION NT3(780),UT3(780),NT4(780),HT4(780,4),KT4(780),
- 1NT5(390,2)
- COMMON XDATA(500),YDATA(500) , UDATA(500), NCDATA(500),NBPR(200)
- 1 , NBPC(200) ,XB(200,20) , YB(200,20)
- COMMON UBPR , UBPC
- DIMENSION KODBPR(200,20) , KODBPC(200,20)
- DIMENSION UBPR(200,20) , UBPC(200,20)
- EQUIVALENCE (UBPR(1,1),KODBPR(1,1)) , (UBPC(1,1),KODBPC(1,1))
-C THE FOLLOWING STATEMENT IS REQUIRED TO MAKE THE COMMON OF THE MAIN
-C PROGRAM AT LEAST AS LONG AS IN A SUBROUTINE AS PER CERN FORTRAN
- COMMON EXTRA(2271)
- DIMENSION HL(4) , UL(4)
- EQUIVALENCE (UWANT,NUWANT)
- DIMENSION KSCCP(4,4)
-C
- C5=0.0002
- C95=0.9998
- DO 1 I=1,200
- NBPR(I)=0
- NBPC(I)=0
- DO 1 J=1,20
- XB(I,J)=0
- YB(I,J)=0
- UBPR(I,J)=0
- 1 UBPC(I,J)=0
- READ 100,DX,DY,NSCC,JOBNUM,KODBAS,NSCCP
- WRITE(6,101)JOBNUM
- IF(NSCCP)3,3,2
- 2 READ 104,((KSCCP(I,J),J=1,4),I=1,NSCCP)
- 3 KB=0
- DO 11 NCURVE=1,NSCC
- READ 102,NPTS
- KA=KB+1
- KB=KB+NPTS
- READ 107,(XDATA(I),YDATA(I),UDATA(I),NCDATA(I),I=KA,KB)
- DO 23 I=KA,KB
- NEARST=XDATA(I)/DX+0.5
- IF(ABS(XDATA(I)/DX-NEARST)-.00005)20,21,21
- 20 XDATA(I)=XDATA(I)+.0001*DX
- 21 NEARST=YDATA(I)/DY+0.5
- IF(ABS(YDATA(I)/DY-NEARST)-.00005)22,23,23
- 22 YDATA(I)=YDATA(I)+.0001*DY
- 23 CONTINUE
- XDATA(KB+1)=XDATA(KA)
- YDATA(KB+1)=YDATA(KA)
- UDATA(KB+1)=UDATA(KA)
- NCDATA(KB+1)=NCDATA(KA)
- DO 10 MP=KA,KB
- LP=MP+1
- CALL EPDBPS(YDATA(MP),YDATA(LP),XDATA(MP),XDATA(LP),UDATA(MP),
- 1UDATA(LP),NCDATA(MP),NCDATA(LP),DY,NBPR,XB,UBPR,KODBPR)
- CALL EPDBPS(XDATA(MP),XDATA(LP),YDATA(MP),YDATA(LP),UDATA(MP),
- 1UDATA(LP),NCDATA(MP),NCDATA(LP),DX,NBPC,YB,UBPC,KODBPC)
- 10 CONTINUE
- 11 CONTINUE
- NPTS=KB
- XMAX=XDATA(1)
- DO 6 J=2,NPTS
- IF(XDATA(J)-XMAX)6,6,5
- 5 XMAX=XDATA(J)
- 6 CONTINUE
- NC=INT(XMAX/DX)+2
- YMAX=YDATA(1)
- DO 8 J=2,NPTS
- IF(YDATA(J)-YMAX)8,8,7
- 7 YMAX=YDATA(J)
- 8 CONTINUE
- NR=INT(YMAX/DY)+2
- CALL EPDSRT(NR,NBPR,XB,UBPR)
- CALL EPDSRT(NC,NBPC,YB,UBPC)
- NE3=0
- NE4=0
- NE5=0
- DO 30 IR=1,NR
- YM=(IR-1)*DY
- DO 30 IC=1,NC
- NOFPT=(IR-1)*NC+IC
- XM=(IC-1)*DX
- CALL EPDLOC(IR,XM,XB,NBPR,UBPR,HL(3),HL(1),UL(3),UL(1),LX,DX)
- CALL EPDLOC(IC,YM,YB,NBPC,UBPC,HL(4),HL(2),UL(4),UL(2),LY,DY)
- MU=3*LX+LY+1
- GO TO (50,31,33,31,32,33,33,33,34),MU
- 50 IF(NSCCP)30,30,51
- 51 DO 52 I=1,NSCCP
- IF(KSCCP(I,1)-NOFPT)52,53,52
- 52 CONTINUE
- GO TO 30
- 53 DO 54 J=1,4
- 54 HL(J)=0.0
- J=KSCCP(I,2)
- HL(J)=1.0
- J=KSCCP(I,4)
- HL(J)=1.0
- MKR=3
- NUWANT=KSCCP(I,3)
- GO TO 35
- 31 CALL EPDCJ(HL,UL,MKR,UWANT)
- GO TO 35
- 32 CALL EPDJE(HL,UL,MKR,UWANT)
- GO TO 35
- 33 WRITE(6,103)NOFPT
- RETURN
- 34 CALL EPDIN(HL,UL,MKR,UWANT)
- 35 CALL EPDTAB(NOFPT,HL,UWANT,MKR,UWANT)
- 30 CONTINUE
-C*UL 41 IF(NE4)37,37,36
- IF(NE4)37,37,36
- 36 CALL EPDCHK(XDATA,YDATA,UDATA,NPTS)
- 37 CALL EPDCHN(I,A4)
-C WILL STOP IN EPDCHN, BUT IBM FORTRAN REQUIRES
- RETURN
- 101 FORMAT('1 SOLVE ELLIPTIC PARTIAL DIFF. EQUN....JOB NUMBER',I6///)
- 102 FORMAT(45X,I5)
- 107 FORMAT(3E15.7,I5)
- 103 FORMAT('0 COMPUTER CANNOT DECIDE WHETHER POINT NUMBER',I5,
- 1 'IS INSIDE OR OUTSIDE THE REGION')
- 100 FORMAT(2E15.7,15X,2I5/45X,2I5)
- 104 FORMAT(45X,2I5)
- END
diff --git a/src/mathlib/gen/d/epdecc.F b/src/mathlib/gen/d/epdecc.F
deleted file mode 100644
index cb0fafb..0000000
--- a/src/mathlib/gen/d/epdecc.F
+++ /dev/null
@@ -1,58 +0,0 @@
-*
-* $Id: epdecc.F,v 1.1.1.1 1996/04/01 15:02:18 mclareni Exp $
-*
-* $Log: epdecc.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:18 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE EPDECC
-C
-C CALCULATE COEFFICIENTS OF DIFFERENCE EQUATIONS
- DIMENSION NT3(780),UT3(780),NT4(780),HT4(780,4),KT4(780),
- 1NT5(390,2),UMAT(3250),NUMPT(2900),DIFCO(2900,5),
- 2HL(4),COFFT(5),DUM(20)
- COMMON C5 , C95 , NT3 , UT3 , NT4 , HT4
- COMMON KT4 , NT5 , NE3 , NE4 , NE5 , NC
- COMMON NR , KODBAS , DX , DY , JOBNUM , UMAT
- COMMON NEQU , DUM , NUMPT , DIFCO
- NEQU=0
- J4=1
- K5=1
- 4 IF(K5-NE5)6,6,5
- 5 IF(J4-NE4)8,8,35
- 6 IF(J4-NE4)7,7,20
- 7 IF(NT5(K5,1)-NT4(J4))20,20,8
- 8 IF(NT4(J4))16,16,9
- 9 M=NT4(J4)
- Y=((M-1)/NC)*DY
- Q=MOD(M-1,NC)
- X=Q*DX
- DO 12 I=1,4
- 12 HL(I)=HT4(J4,I)
- NEQU=NEQU+1
- CALL GETCO(X,Y,HL,M,KT4(J4),COFFT,NEQU)
- NUMPT(NEQU)=M
- DO 15 I=1,5
- 15 DIFCO(NEQU,I)=COFFT(I)
- 16 J4=J4+1
- GO TO 4
- 20 NPL=NT5(K5,1)
- NPU=NT5(K5,2)
- DO 23 I=1,4
- 23 HL(I)=1.0
- DO 31 M=NPL,NPU
- Y=((M-1)/NC)*DY
- Q=MOD(M-1,NC)
- X=Q*DX
- NEQU=NEQU+1
- CALL GETCO(X,Y,HL,M,KODBAS,COFFT,NEQU)
- NUMPT(NEQU)=M
- DO 30 I=1,5
- 30 DIFCO(NEQU,I)=COFFT(I)
- 31 CONTINUE
- K5=K5+1
- GO TO 4
- 35 RETURN
- END
diff --git a/src/mathlib/gen/d/epdfix.F b/src/mathlib/gen/d/epdfix.F
deleted file mode 100644
index 1cd7b5a..0000000
--- a/src/mathlib/gen/d/epdfix.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: epdfix.F,v 1.1.1.1 1996/04/01 15:02:18 mclareni Exp $
-*
-* $Log: epdfix.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:18 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE EPDFIX(N,NS)
-C
-C SETS NS = 0 IF N=0
-C 1 IF N IS FIXED POINT NUMBER
-C -1 IF N IS FLOATING POINT NUMBER
-C N.B. THIS VERSION ASSUMES FIXED POINT NUMBER IS KNOWN TO BE LESS
-C THAN 256
-C
- IF(N)3,4,3
- 4 NS=0
- RETURN
- 3 IF(ABS(N)-255)5,5,6
- 5 NS=1
- RETURN
- 6 NS=-1
- RETURN
- END
diff --git a/src/mathlib/gen/d/epdin.F b/src/mathlib/gen/d/epdin.F
deleted file mode 100644
index 87d4f15..0000000
--- a/src/mathlib/gen/d/epdin.F
+++ /dev/null
@@ -1,56 +0,0 @@
-*
-* $Id: epdin.F,v 1.1.1.1 1996/04/01 15:02:18 mclareni Exp $
-*
-* $Log: epdin.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:18 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE EPDIN(HL,UL,MKR,UWANT)
-C
-C TREATMENT OF INTERNAL POINTS
-C
- DIMENSION HL(4),UL(4)
- COMMON C5 , C95
- NHNOT1=0
- NFIXU=0
- DO 10 J=1,4
- IF(HL(J)-1.0)5,10,5
- 5 NHNOT1=NHNOT1+1
- CALL EPDFIX(UL(J),NS)
- IF(NS)10,10,7
- 7 L=J
- NFIXU=NFIXU+1
- 10 CONTINUE
- IF(NHNOT1)14,12,14
- 12 MKR=1
- RETURN
- 14 IF(NFIXU-1)16,25,12
- 16 I=1
- HMIN=HL(1)
- DO 20 J=2,4
- IF(HL(J)-HMIN)18,20,20
- 18 HMIN=HL(J)
- I=J
- 20 CONTINUE
- IF(HMIN-C5)22,12,12
- 22 MKR=2
- UWANT=UL(I)
- RETURN
- 25 IF(HL(L)-C95)26,26,16
- 26 IF(HL(L)-C5)27,27,35
- 27 HMIN=1.0
- DO 30 J=1,4
- IF(J-L)28,30,28
- 28 IF(HL(J)-HMIN)29,29,30
- 29 HMIN=HL(J)
- I=J
- 30 CONTINUE
- IF(HMIN-C5)22,31,31
- 31 MKR=3
- UWANT=UL(L)
- RETURN
- 35 MKR=5
- RETURN
- END
diff --git a/src/mathlib/gen/d/epditr.F b/src/mathlib/gen/d/epditr.F
deleted file mode 100644
index 25696fc..0000000
--- a/src/mathlib/gen/d/epditr.F
+++ /dev/null
@@ -1,42 +0,0 @@
-*
-* $Id: epditr.F,v 1.1.1.1 1996/04/01 15:02:18 mclareni Exp $
-*
-* $Log: epditr.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:18 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE EPDITR(BETA,DMAX,UCORR,ICORR,GNORM)
-C
-C THE EXTRAPOLATED-LIEBMANN ITERATION
-C
- DIMENSION DUM1(7025),UMAT(3250),DUM2(20),NUMPT(2900),DIFCO(2900,5)
- COMMON DUM1 , NC , NR , KODBAS , DX , DY
- COMMON JOBNUM , UMAT , NEQU , DUM2 , NUMPT , DIFCO
- DMAX=0
- GNORM=0
- DO 2 I=1,NEQU
- J=NUMPT(I)
- K=J+NC
- L=J-NC
- RES=DIFCO(I,5)-UMAT(J)
- IF(DIFCO(I,1))22,21,22
- 22 RES=RES+DIFCO(I,1)*UMAT(J+1)
- 21 IF(DIFCO(I,2))24,23,24
- 24 RES=RES+DIFCO(I,2)*UMAT(K)
- 23 IF(DIFCO(I,3))26,25,26
- 26 RES=RES+DIFCO(I,3)*UMAT(J-1)
- 25 IF(DIFCO(I,4))28,27,28
- 28 RES=RES+DIFCO(I,4)*UMAT(L)
- 27 CONTINUE
- DELTA=BETA*RES
- UMAT(J)=UMAT(J)+DELTA
- GNORM=GNORM+ABS(DELTA)
- IF(ABS(DELTA)-DMAX)2,2,1
- 1 DMAX=ABS(DELTA)
- UCORR=UMAT(J)
- ICORR=I
- 2 CONTINUE
- RETURN
- END
diff --git a/src/mathlib/gen/d/epdje.F b/src/mathlib/gen/d/epdje.F
deleted file mode 100644
index 2ec3599..0000000
--- a/src/mathlib/gen/d/epdje.F
+++ /dev/null
@@ -1,59 +0,0 @@
-*
-* $Id: epdje.F,v 1.1.1.1 1996/04/01 15:02:18 mclareni Exp $
-*
-* $Log: epdje.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:18 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE EPDJE(HL,UL,MKR,UWANT)
-C
-C TREATMENT OF POINT JUST EXTERIOR IN BOTH DIRECTIONS
-C
- DIMENSION HL(4),UL(4)
- COMMON C5 , C95
- NFIXU=0
- DO 10 J=1,4
- IF(HL(J)-1.0)5,10,5
- 5 CALL EPDFIX(UL(J),NS)
- IF(NS)10,10,7
- 7 L=J
- NFIXU=NFIXU+1
- 10 CONTINUE
- IF(NFIXU-1)12,13,11
- 11 MKR=1
- DO 31 I=1,4
- 31 HL(I)=1.0
- RETURN
- 12 L=5
- GO TO 14
- 13 IF(HL(L)-C95)20,20,14
- 14 HMIN=1.0
- DO 17 J=1,4
- IF(J-L)15,17,15
- 15 IF(HL(J)-HMIN)16,17,17
- 16 HMIN=HL(J)
- I=J
- 17 CONTINUE
- 18 UWANT=UL(I)
- MKR=2
- RETURN
- 20 IF(HL(L)-C5)25,21,21
- 21 MKR=5
- RETURN
- 25 HMIN=1.0
- DO 28 J=1,4
- IF(J-L)26,28,26
- 26 IF(HL(J)-HMIN)27,28,28
- 27 HMIN=HL(J)
- I=J
- 28 CONTINUE
- IF(HMIN-C95)18,30,30
- 30 UWANT=UL(L)
- J=MOD(L+1,4)+1
- HL(L)=HL(J)
- HL(J)=0.0
- MKR=3
- RETURN
- END
diff --git a/src/mathlib/gen/d/epdloc.F b/src/mathlib/gen/d/epdloc.F
deleted file mode 100644
index dd09ad2..0000000
--- a/src/mathlib/gen/d/epdloc.F
+++ /dev/null
@@ -1,46 +0,0 @@
-*
-* $Id: epdloc.F,v 1.1.1.1 1996/04/01 15:02:18 mclareni Exp $
-*
-* $Log: epdloc.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:18 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE EPDLOC(IR,XM,XBPR,NBPR,UBPR,HL,HR,UL,UR,LAMDA,DX)
-C
-C LOCATION OF MESH-POINT ROW-WISE OR COLUMN-WISE.
-C
- DIMENSION XBPR(200,20),UBPR(200,20),NBPR(200)
- HL=1.0
- HR=1.0
- UL=0.0
- UR=0.0
- LAMDA=0
- N=NBPR(IR)
- IF(N)30,30,3
- 3 J=1
- 4 IF(XM-XBPR(IR,J)) 10,10,5
- 5 IF(J-N)6,8,8
- 6 J=J+1
- GO TO 4
- 8 HR=1.0
- J=J+1
- GO TO 16
- 10 HR=MIN((XBPR(IR,J)-XM)/DX,1.0)
- IF(HR-1.0)12,13,12
- 12 UR=UBPR(IR,J)
- 13 IF(J-1)16,15,16
- 15 HL=1.0
- GO TO 20
- 16 HL=MIN((XM-XBPR(IR,J-1))/DX,1.0)
- IF(HL-1.0)18,20,18
- 18 UL=UBPR(IR,J-1)
- 20 IF((J/2)*2-J)24,22,24
- 22 LAMDA=2
- RETURN
- 24 IF(HL-1.0)28,26,28
- 26 IF(HR-1.0)28,30,28
- 28 LAMDA=1
- 30 RETURN
- END
diff --git a/src/mathlib/gen/d/epdsrt.F b/src/mathlib/gen/d/epdsrt.F
deleted file mode 100644
index 67ac1eb..0000000
--- a/src/mathlib/gen/d/epdsrt.F
+++ /dev/null
@@ -1,54 +0,0 @@
-*
-* $Id: epdsrt.F,v 1.1.1.1 1996/04/01 15:02:18 mclareni Exp $
-*
-* $Log: epdsrt.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:18 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE EPDSRT(NR,NBPR,XBPR,UBPR)
-C
-C SORT AND REARRANGE BOUNDARY POINTS AND VALUE
-C
- DIMENSION NBPR(200),XBPR(200,20),UBPR(200,20),F(20),G(20)
- DO 25 IR=1,NR
- J=NBPR(IR)
- IF(2*(J/2)-J)1,2,1
- 1 WRITE(6,100)NR,J,(XBPR(IR,K),K=1,J)
- STOP
-C---------
- 2 K=0
- 3 N=J
- IF(N-1)25,5,15
- 5 K=K+1
- F(K)=XBPR(IR,1)
- G(K)=UBPR(IR,1)
- DO 10 L=1,K
- XBPR(IR,L)=F(L)
- 10 UBPR(IR,L)=G(L)
- GO TO 25
- 15 XMIN=XBPR(IR,1)
- PHI=UBPR(IR,1)
- DO 22 L=2,N
- J=L-1
- IF(XBPR(IR,L)-XMIN)21,20,20
- 20 UBPR(IR,J)=UBPR(IR,L)
- XBPR(IR,J)=XBPR(IR,L)
- GO TO 22
- 21 UBPR(IR,J)=PHI
- XBPR(IR,J)=XMIN
- PHI=UBPR(IR,L)
- XMIN=XBPR(IR,L)
- 22 CONTINUE
- K=K+1
- F(K)=XMIN
- G(K)=PHI
- GO TO 3
- 25 CONTINUE
- RETURN
- 100 FORMAT('0 MESH ROW OR COLUMN NUMBER',I5,
- 1 ' APPEARS TO INTERSECT BOUNDARY AT',I5,' POINTS,',
- 2 ' THE NUMBER'/'0 OF POINTS BEING ODD AND SO, IMPOSSIBLE',
- 3 '. CO-ORDINATES OF ALLEGED INTERSECTIONS ARE',//(F15.6))
- END
diff --git a/src/mathlib/gen/d/epdtab.F b/src/mathlib/gen/d/epdtab.F
deleted file mode 100644
index df73211..0000000
--- a/src/mathlib/gen/d/epdtab.F
+++ /dev/null
@@ -1,70 +0,0 @@
-*
-* $Id: epdtab.F,v 1.1.1.1 1996/04/01 15:02:18 mclareni Exp $
-*
-* $Log: epdtab.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:18 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE EPDTAB(M,HL,UWANT,MKR,KODE)
-C
-C WRITE DETAILS OF POINT INTO APPROPRIATE TABLE OR SIGNAL ERROR.
- DIMENSION NT3(780),UT3(780),NT4(780),HT4(780,4),KT4(780),
- 1NT5(390,2),HL(4)
- COMMON C5 , C95 , NT3 , UT3 , NT4 , HT4
- COMMON KT4 , NT5 , NE3 , NE4 , NE5 , NC
- COMMON NR , KODBAS
- DO 11 J=1,4
- IF(C5-HL(J))7,7,5
- 5 HL(J)=0.0
- GO TO 11
- 7 IF(HL(J)-C95)11,11,10
- 10 HL(J)=1.0
- 11 CONTINUE
- GO TO (15,37,31,26,40,42,44),MKR
- 15 DO 17 J=1,4
- IF(HL(J)-1.0)30,17,30
- 17 CONTINUE
- IF(NE5)20,21,20
- 20 IF(M-NT5(NE5,2)-1)21,25,21
- 21 NE5=NE5+1
- IF(NE5-390)23,23,22
- 22 WRITE(6,103)
- STOP
-C---------
- 23 NT5(NE5,1)=M
- 25 NT5(NE5,2)=M
- 26 RETURN
- 30 KODE=KODBAS
- 31 NE4=NE4+1
- IF(NE4-780)32,32,22
- 32 NT4(NE4)=M
- KT4(NE4)=ABS(KODE)
- DO 35 J=1,4
- 35 HT4(NE4,J)=HL(J)
- RETURN
- 37 NE3=NE3+1
- IF(NE3-780)38,38,22
- 38 NT3(NE3)=M
- UT3(NE3)=UWANT
- RETURN
- 40 WRITE(6,100)M
- STOP
-C---------
- 42 WRITE(6,101)M
- STOP
-C---------
- 44 WRITE(6,102)M
- STOP
-C---------
- 100 FORMAT('0 POINT',I5,' NEAR BOUNDARY WITH DERIVATIVE-TYPE',
- 1 ' BOUNDARY CONDITIONS IS SUSPECT'/
- 2 ' BOUNDARY SHOULD BE COINCIDENT WITH MESH LINE')
- 101 FORMAT('0 THERE APPEAR TO BE TWO BOUNDARIES NEAR POINT',I5,'WITH'
- 1 ,' DERIVATIVE-TYPE BOUNDARY CONDITIONS'/' THIS IS INADMISSIBLE')
- 102 FORMAT('0 POINT',I5,' NEAR BOUNDARY WITH DERIVATIVE-TYPE BOUNDAR'
- 1 ,'Y CONDITIONS',/' IS TOO CLOSE TO ANOTHER BOUNDARY')
- 103 FORMAT('0 THE TABLE OF BOUNDARY, IRREGULAR OR REGULAR POINTS IS'
- 1 ,'FULL. RERUN WITH COARSER MESH')
- END
diff --git a/src/mathlib/gen/d/errorf.F b/src/mathlib/gen/d/errorf.F
deleted file mode 100644
index 5006f77..0000000
--- a/src/mathlib/gen/d/errorf.F
+++ /dev/null
@@ -1,44 +0,0 @@
-*
-* $Id: errorf.F,v 1.1.1.1 1996/04/01 15:02:21 mclareni Exp $
-*
-* $Log: errorf.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:21 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE ERRORF (M)
-C-----FINAL ERROR ANALYSIS FOR CHISQ.
-#include "d510si.inc"
-#include "d510ui.inc"
-#include "d510uo.inc"
- EQUIVALENCE(NED(1),NS),(NED(2),NP)
- WRITE(6,3)
- IF (NP.GT.7) WRITE(6,4)
- DO 2 J=1,NS
- K1=NP*(J-1)+1
- FUN=EXDA(K1)
- SIG=EXDA(K1+1)
- NX=NP-2
- DO 1 K=1,NX
- K2=K1+1+K
- X(K)=EXDA(K2)
- 1 CONTINUE
-C-----CALCULATE DY/DA"S FOR SCAL
- CALL ARITHM (Y)
- CALL SCAL (M,ER)
- XI=(FUN-Y)/SIG
- XI=0.5*XI*XI
- ER=SQRT(ER)
- ERROR(J)=ER
- WRITE(6,5) J,Y,ER,XI,(X(I),I=1,NX)
- 2 CONTINUE
- RETURN
-C
- 3 FORMAT('1','ERROR ANALYSIS FOR EACH DATA POINT USING FINAL PARA',
- +'METER VALUES (CHISQ ONLY)'////11X,'POINT',8X,'FITTED',9X,
- +'Y STANDARD',6X,'CONTRIBUTION',4X,'X CO-ORDINATES'/12X,'NO.',8X,
- +'Y VALUE',8X,'DEVIATION',7X,'TO CHISQ/2',6X,'OF DATA POINT'//)
- 4 FORMAT('+',86X,'(PRINTED IN ROW ORDER)')
- 5 FORMAT(11X,I3,2X,7(5X,E12.5),(/67X,4(5X,E12.5)))
- END
diff --git a/src/mathlib/gen/d/esolve.F b/src/mathlib/gen/d/esolve.F
deleted file mode 100644
index c7a45f7..0000000
--- a/src/mathlib/gen/d/esolve.F
+++ /dev/null
@@ -1,231 +0,0 @@
-*
-* $Id: esolve.F,v 1.1.1.1 1996/04/01 15:02:18 mclareni Exp $
-*
-* $Log: esolve.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:18 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE ESOLVE(M1,N,AD,BD,CD,DELTAY,IBCX,ALFAS,BETAS,ALFAN,
- +BETAN,POT,IKIND)
- COMMON/FW1/W1(774)/FW2/W2(100)
- DIMENSION POT(M1,N)
- DATA PI/3.141592653589793/
- M=M1-1
- COEFY=2.*DELTAY
- IF(BETAS.EQ.0.) GOTO 50
- IBCYS=2
- COEF1S=COEFY/BETAS
- COEF2S=ALFAS*COEF1S
- GOTO 53
- 50 IBCYS=1
- DIV=1./ALFAS
- DO 51 I=1,M1
- 51 W1(2*M1+I)=DIV*W1(2*M1+I)
- 53 IF(BETAN.EQ.0.) GOTO 54
- IBCYN=2
- COEF1N=COEFY/BETAN
- COEF2N=ALFAN*COEF1N
- GOTO 56
- 54 IBCYN=1
- DIV=1./ALFAN
- DO 55 I=1,M1
- 55 W1(3*M1+I)=DIV*W1(3*M1+I)
- 56 CONTINUE
- XM=M
- NA=N-1
- NAA=N-2
- JUMP=1
- PIOVM=PI/XM
- IF(IBCX.EQ.1) PIOVM=2.*PIOVM
- IF(IBCX.EQ.4) PIOVM=.5*PIOVM
- DUM1=.5*BD
- XNORTH=AD+DUM1
- XSOUTH=AD-DUM1
- CENT=2.*(1.+AD)-CD
- GOTO(100,200,300),IKIND
-C
-C THIS PART OF THE SUBROUTINE IS USED
-C WHEN IKIND=1 THAT IS IN THE ELLIPTIC CASE
-C AND SOLVES THE THREE-POINT RECURRENCE
-C FORMULA THROUGH GAUSS ELIMINATION
-C
- 100 GOTO(110,120,130,135),IBCX
- 110 IMIN=1
- IMAX=M/2+1
- GOTO 140
- 120 IMIN=1
- IMAX=M1
- GOTO 140
- 130 IMIN=2
- IMAX=M
- GOTO 140
- 135 IMIN=2
- IMAX=M1
- JUMP=2
- 140 AA=1.
- IOUT=0
- ISUB=0
- 141 DO 1 I=IMIN,IMAX,JUMP
- XI=I-1-ISUB
- H=2.*COS(PIOVM*XI)
- FCENT=CENT-AA*H
- DEN=1./FCENT
- GOTO(111,112),IBCYS
- 111 W2(2)=DEN*XNORTH
- W2(N+2)=DEN*(XSOUTH*W1(2*M1+I)-POT(I,2))
- JMIN=3
- JMAX=NAA
- GOTO 113
- 112 DEN=1./(FCENT-XSOUTH*COEF2S)
- W2(1)=DEN*(XSOUTH+XNORTH)
- W2(N+1)=-DEN*(POT(I,1)+XSOUTH*COEF1S*W1(2*M1+I))
- JMIN=2
- JMAX=NA
- 113 DO 2 J=JMIN,NA
- DEN=1./(FCENT-XSOUTH*W2(J-1))
- W2(J)=DEN*XNORTH
- 2 W2(N+J)=DEN*(XSOUTH*W2(NA+J)-POT(I,J))
- GOTO(121,122),IBCYN
- 121 POT(I,N)=W1(3*M1+I)
- GOTO 123
- 122 IF(IBCX.EQ.4) GOTO 126
- IF(IBCYS.EQ.2.AND.IBCX.NE.3) GOTO 124
- GOTO 126
- 124 IF(I.EQ.1) GOTO 125
- 126 DEN=1./(FCENT-W2(NA)*(XSOUTH+XNORTH)+XNORTH*COEF2N)
- POT(I,N)=DEN*(-POT(I,N)+XNORTH*COEF1N*W1(3*M1+I)
- ++W2(N+NA)*(XSOUTH+XNORTH))
- GOTO 123
- 125 POT(1,N)=0.
- 123 POT(I,1)=W1(2*M1+I)
- DO 3 J=1,JMAX
- K=N-J
- 3 POT(I,K)=W2(K)*POT(I,K+1)+W2(N+K)
- 1 CONTINUE
- IOUT=IOUT+1
- IF(IOUT.EQ.2) RETURN
- IF(IBCX.NE.1) GOTO 143
- IMIN=IMAX+1
- IMAX=M
- AA=-1.
- GOTO 141
- 143 IF(IBCX.NE.4) RETURN
- ISUB=ISUB+1
- IMIN=3
- AA=-1.
- GOTO 141
-C
-C
-C THIS PART OF THE SUBROUTINE IS USED
-C WHEN IKIND=2 THAT IS IN THE PARABOLIC CASE
-C AND SOLVES THE TWO-POINT RECURRENCE
-C FORMULA STEP BY STEP
-C
-C
- 200 GOTO(210,220,230,235),IBCX
- 210 IMIN=1
- IMAX=M/2+1
- GOTO 240
- 220 IMIN=1
- IMAX=M1
- GOTO 240
- 230 IMIN=2
- IMAX=M
- GOTO 240
- 235 IMIN=2
- IMAX=M1
- JUMP=2
- 240 AA=1.
- IOUT=0
- ISUB=0
- DUM2=2.*BD
- DUMUP=-2.+DUM2+CD
- DUMLO=-2.-DUM2+CD
- 241 DO 11 I=IMIN,IMAX,JUMP
- XI=I-1-ISUB
- H=2.*COS(PIOVM*XI)
- XNORTH=DUMUP+AA*H
- XSOUTH=DUMLO+AA*H
- DEN2=1./XNORTH
- DO 12 J=2,N
- 12 W2(J)=POT(I,J-1)+POT(I,J)
- GOTO(201,202),IBCYS
- 201 POT(I,1)=W1(2*M1+I)
- GOTO 203
- 202 IF(IBCX.EQ.3.OR.IBCX.EQ.4) GOTO 226
-C*UL 224 IF(I.EQ.1) GOTO 225
- IF(I.EQ.1) GOTO 225
- 226 DEN1=1./(XNORTH+XSOUTH*(1.+.5*COEF2S))
- POT(I,1)=DEN1*(POT(I,1)+.5*XSOUTH*COEF1S*W1(2*M1+I))
- GOTO 203
- 225 POT(1,1)=0.
- 203 DO 13 J=2,N
- 13 POT(I,J)=DEN2*(W2(J)-XSOUTH*POT(I,J-1))
- 11 CONTINUE
- IOUT=IOUT+1
- IF(IOUT.EQ.2) GOTO 242
- IF(IBCX.NE.1) GOTO 243
- IMIN=IMAX+1
- IMAX=M
- AA=-1.
- GOTO 241
- 243 IF(IBCX.NE.4) GOTO 242
- ISUB=ISUB+1
- IMIN=3
- AA=-1.
- GOTO 241
- 242 RETURN
-C
-C
-C THIS PART OF THE SUBROUTINE IS USED
-C WHEN IKIND=3 THAT IS IN THE HYPERBOLIC CASE
-C AND SOLVES THE THREE-POINT RECURRENCE
-C FORMULA STEP BY STEP
-C
-C
- 300 GOTO(310,320,330,335),IBCX
- 310 IMIN=1
- IMAX=M/2+1
- GOTO 340
- 320 IMIN=1
- IMAX=M1
- GOTO 340
- 330 IMIN=2
- IMAX=M
- GOTO 340
- 335 IMIN=2
- IMAX=M1
- JUMP=2
- 340 AA=1.
- IOUT=0
- ISUB=0
- DEN1=1./(XSOUTH+XNORTH)
- DEN2=1./XNORTH
- 341 DO 7 I=IMIN,IMAX,JUMP
- XI=I-1-ISUB
- H=2.*COS(PIOVM*XI)
- FCENT=CENT-AA*H
- DO 8 J=1,N
- 8 W2(J)=POT(I,J)
- POT(I,1)=W1(2*M1+I)
- POT(I,2)=DEN1*(W2(1)+XSOUTH*COEFY*W1(3*M1+I)+FCENT*W1(2*M1+I))
- DO 9 J=3,N
- 9 POT(I,J)=DEN2*(W2(J-1)-XSOUTH*POT(I,J-2)+FCENT*POT(I,J-1))
- 7 CONTINUE
- IOUT=IOUT+1
- IF(IOUT.EQ.2) GOTO 342
- IF(IBCX.NE.1) GOTO 343
- IMIN=IMAX+1
- IMAX=M
- AA=-1.
- GOTO 341
- 343 IF(IBCX.NE.4) GOTO 342
- ISUB=ISUB+1
- IMIN=3
- AA=-1.
- GOTO 341
- 342 CONTINUE
- RETURN
- END
diff --git a/src/mathlib/gen/d/fcn1.F b/src/mathlib/gen/d/fcn1.F
deleted file mode 100644
index b69b4a9..0000000
--- a/src/mathlib/gen/d/fcn1.F
+++ /dev/null
@@ -1,15 +0,0 @@
-*
-* $Id: fcn1.F,v 1.1.1.1 1996/04/01 15:02:20 mclareni Exp $
-*
-* $Log: fcn1.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:20 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE FCN1(M,N,F,X,IFLAG,NW,W,KEND,KEND2N)
-C THIS SUBROUTINE WILL BE MODIFIED AND USED FOR CONDITIONED MINIMIZ.
- DIMENSION F(M),X(N),W(NW)
- CALL FCN(M,N,F,X,IFLAG)
- RETURN
- END
diff --git a/src/mathlib/gen/d/fftrc.F b/src/mathlib/gen/d/fftrc.F
deleted file mode 100644
index 659e68f..0000000
--- a/src/mathlib/gen/d/fftrc.F
+++ /dev/null
@@ -1,154 +0,0 @@
-*
-* $Id: fftrc.F,v 1.1.1.1 1996/04/01 15:02:23 mclareni Exp $
-*
-* $Log: fftrc.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:23 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE FFTRC(C,D,IX,F,G,IZ)
-C
-C D701 FFTRC FAST FOURIER TRANSFORM, REAL OR COMPLEX
-C B. FORNBERG NOVEMBER 1973
-C
- COMPLEX A(16),T
- DIMENSION E(32),C(1),D(1),F(1),G(1),S(2),NC(7)
- COMMON /TAB/U(126),V(127)
- EQUIVALENCE (A(1),E(1)),(S(1),T),(S(1),S1),(S(2),S2),(U(31),C3),(U
- *(63),C7),(U(32),C9)
- DATA NC/17,9,25,5,21,13,29/
-C
-#if (defined(CERNLIB_CDC))&&(defined(CERNLIB_F4))
- ENTRY I16
-#endif
-#if !defined(CERNLIB_CDC)||!defined(CERNLIB_F4)
- ENTRY I16(C,D,IX,F,G,IZ)
-#endif
- IS = IX
- I = 1
- GOTO 40
-C
-#if (defined(CERNLIB_CDC))&&(defined(CERNLIB_F4))
- ENTRY D16
-#endif
-#if !defined(CERNLIB_CDC)||!defined(CERNLIB_F4)
- ENTRY D16(C,D,IX,F,G,IZ)
-#endif
- IS = -IX
- I = 1+16*IX
- 40 J = 1+8*IX
- CALL D701BD
- E(3) = C(1)-C(J)
- E(1) = C(1)+C(J)
- E(4) = D(1)-D(J)
- E(2) = D(1)+D(J)
- DO 10 L=1,7
- I = I+IS
- J = J+IS
- N = NC(L)
- E(N+2) = C(I)-C(J)
- E(N) = C(I)+C(J)
- E(N+3) = D(I)-D(J)
- 10 E(N+1) = D(I)+D(J)
- DO 20 L=1,13,4
- T = A(L+2)
- A(L+2) = A(L)-T
- 20 A(L) = A(L)+T
- DO 30 L=2,14,4
- S1 = E(2*L+4)
- S2 = -E(2*L+3)
- A(L+2) = A(L)-T
- 30 A(L) = A(L)+T
- T = A(5)
- A(5) = A(1)-T
- A(1) = A(1)+T
- T = A(13)
- A(13) = A(9)-T
- A(9) = A(9)+T
- S2 = -C7*(E(11)-E(12))
- S1 = C7*(E(11)+E(12))
- A(6) = A(2)-T
- A(2) = A(2)+T
- S2 = -C7*(E(27)-E(28))
- S1 = C7*(E(27)+E(28))
- A(14) = A(10)-T
- A(10) = A(10)+T
- S1 = E(14)
- S2 = -E(13)
- A(7) = A(3)-T
- A(3) = A(3)+T
- S1 = E(30)
- S2 = -E(29)
- A(15) = A(11)-T
- A(11) = A(11)+T
- S2 = -C7*(E(15)+E(16))
- S1 = -C7*(E(15)-E(16))
- A(8) = A(4)-T
- A(4) = A(4)+T
- S1 = -C7*(E(31)-E(32))
- S2 = -C7*(E(31)+E(32))
- A(16) = A(12)-T
- A(12) = A(12)+T
- I = 1
- J = 1+8*IZ
- F(J) = E(1)-E(17)
- G(J) = E(2)-E(18)
- F(I) = E(1)+E(17)
- G(I) = E(2)+E(18)
- I = I+IZ
- J = J+IZ
- S1 = C9*E(19)+C3*E(20)
- S2 = C9*E(20)-C3*E(19)
- F(J) = E( 3)-S1
- G(J) = E( 4)-S2
- F(I) = E( 3)+S1
- G(I) = E( 4)+S2
- I = I+IZ
- J = J+IZ
- S1 = C7*(E(21)+E(22))
- S2 = -C7*(E(21)-E(22))
- F(J) = E( 5)-S1
- G(J) = E( 6)-S2
- F(I) = E( 5)+S1
- G(I) = E( 6)+S2
- I = I+IZ
- J = J+IZ
- S1 = C3*E(23)+C9*E(24)
- S2 = C3*E(24)-C9*E(23)
- F(J) = E( 7)-S1
- G(J) = E( 8)-S2
- F(I) = E( 7)+S1
- G(I) = E( 8)+S2
- I = I+IZ
- J = J+IZ
- F(J) = E(9)-E(26)
- G(J) = E(10)+E(25)
- F(I) = E(9)+E(26)
- G(I) = E(10)-E(25)
- I = I+IZ
- J = J+IZ
- S1 = -C3*E(27)+C9*E(28)
- S2 = -C3*E(28)-C9*E(27)
- F(J) = E(11)-S1
- G(J) = E(12)-S2
- F(I) = E(11)+S1
- G(I) = E(12)+S2
- I = I+IZ
- J = J+IZ
- S1 = -C7*(E(29)-E(30))
- S2 = -C7*(E(29)+E(30))
- F(J) = E(13)-S1
- G(J) = E(14)-S2
- F(I) = E(13)+S1
- G(I) = E(14)+S2
- I = I+IZ
- J = J+IZ
- S1 = -C9*E(31)+C3*E(32)
- S2 = -C9*E(32)-C3*E(31)
- F(J) = E(15)-S1
- G(J) = E(16)-S2
- F(I) = E(15)+S1
- G(I) = E(16)+S2
- RETURN
- END
diff --git a/src/mathlib/gen/d/fumili.F b/src/mathlib/gen/d/fumili.F
deleted file mode 100644
index 7c284db..0000000
--- a/src/mathlib/gen/d/fumili.F
+++ /dev/null
@@ -1,269 +0,0 @@
-*
-* $Id: fumili.F,v 1.1.1.1 1996/04/01 15:02:21 mclareni Exp $
-*
-* $Log: fumili.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:21 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE FUMILI (S,M,N1,N2,N3,EPS,AKAPPA,ALAMBD,IT,MC)
-C-----ENTRY FOR CHISQ MINIMISATION
-#include "d510pl.inc"
-#include "d510si.inc"
-#include "d510ui.inc"
-#include "d510uo.inc"
-C-----10.*MAXIMUM RELATIVE PRECISION ON CDC 6000
- DATA RP/1.E-14/
- INDFLG(3)=0
- 1 IF (IT.GE.0) WRITE(6,84)
-#if defined(CERNLIB_IBM)||defined(CERNLIB_CDC)
- CALL VFILL(AMX,100,1.0E75)
-#endif
-#if (!defined(CERNLIB_CDC))&&(!defined(CERNLIB_IBM))
- CALL VFILL(AMX,100,1.0E37)
-#endif
- CALL VCOPYN(AMX,AMN,100)
- NN2=0
- N=M
- FIXFLG=0.
- ENDFLG=0.
- INDFLG(2)=0
- IFIX1=0.
- FI=0.
- NN3=0
- DO 2 I=1,N
- R(I)=0.
- IF (EPS.GT.0.) SIGMA(I)=0.
- 2 PL(I)=PL0(I)
-C-----START NEW ITERATION
- 3 NN1=1
- T1=1.
-C-----REPEAT ITERATION WITH SMALLER STEP
- 4 S=0.
- N0=0
- DO 7 I=1,N
- G(I)=0.
- IF (PL0(I)) 7,7,5
- 5 N0=N0+1
- IF (PL(I)) 7,7,6
- 6 PL0(I)=PL(I)
- 7 CONTINUE
- NN0=N0*(N0+1)/2
- IF (NN0.LT.1) GO TO 9
- DO 8 I=1,NN0
- Z(I)=0.
- 8 CONTINUE
- 9 NA=M
- INDFLG(1)=0
-C-----CALCULATE OBJECTIVE FUNCTION
- CALL SGZ (M,S)
- SP=RP*ABS(S)
- IF (NN0.LT.1) GO TO 11
- DO 10 I=1,NN0
- Z0(I)=Z(I)
- 10 CONTINUE
- 11 IF (NN3) 19,19,12
- 12 IF (NN1-N1) 13,13,19
- 13 T=2.*(S-OLDS-GT)
- IF (INDFLG(1)) 16,14,16
- 14 IF (ABS(S-OLDS).LE.SP.AND.-GT.LE.SP) GO TO 19
- IF (0.59*T+GT) 19,15,15
- 15 T=-GT/T
- IF (T-0.25) 16,17,17
- 16 T=0.25
- 17 GT=GT*T
- T1=T1*T
- NN2=0
- DO 18 I=1,N
- IF (PL(I).LE.0.) GO TO 18
- A(I)=A(I)-DA(I)
- PL(I)=PL(I)*T
- DA(I)=DA(I)*T
- A(I)=A(I)+DA(I)
- 18 CONTINUE
- NN1=NN1+1
- GO TO 4
-C-----REMOVE CONTRIBUTION OF FIXED PARAMETERS FROM Z
- 19 IF(INDFLG(1).EQ.0) GO TO 20
- ENDFLG=-4.
- GO TO 85
- 20 K1=1
- K2=1
- I1=1
- DO 30 I=1,N
- IF (PL0(I)) 30,30,21
- 21 IF (PL(I).EQ.0.) PL(I)=PL0(I)
- IF (PL(I)) 23,23,24
- 22 PL(I)=0.
- 23 K1=K1+I1
- GO TO 29
- 24 IF (A(I).GE.AMX(I).AND.G(I).LT.0.) GO TO 22
- IF (A(I).LE.AMN(I).AND.G(I).GT.0.) GO TO 22
- DO 28 J=1,I
- IF (PL0(J)) 28,28,25
- 25 IF (PL(J)) 27,27,26
- 26 Z(K2)=Z0(K1)
- K2=K2+1
- 27 K1=K1+1
- 28 CONTINUE
- 29 I1=I1+1
- 30 CONTINUE
-C-----INVERT Z
- I1=1
- L=I1
- DO 32 I=1,N
- IF (PL(I)) 32,32,31
- 31 R(I)=Z(L)
- I1=I1+1
- L=L+I1
- 32 CONTINUE
- N0=I1-1
- CALL MCONV (N0)
- IF (INDFLG(1)) 33,34,33
- 33 INDFLG(1)=0
- INDFLG(2)=1
- GO TO 49
- 34 CONTINUE
-C-----CALCULATE THEORETICAL STEP TO MINIMUM
- I1=1
- DO 41 I=1,N
- DA(I)=0.
- IF (PL(I)) 41,41,35
- 35 L1=1
- DO 40 L=1,N
- IF (PL(L)) 40,40,36
- 36 IF (I1-L1) 37,37,38
- 37 K=L1*(L1-1)/2+I1
- GO TO 39
- 38 K=I1*(I1-1)/2+L1
- 39 DA(I)=DA(I)-G(L)*Z(K)
- L1=L1+1
- 40 CONTINUE
- I1=I1+1
- 41 CONTINUE
-C-----CHECK FOR PARAMETERS ON BOUNDARY
- AFIX=0.
- IFIX=0
- I1=1
- L=I1
- DO 47 I=1,N
- IF (PL(I)) 47,47,42
- 42 SIGI=SQRT(ABS(Z(L)))
- R(I)=R(I)*Z(L)
- IF (EPS) 44,44,43
- 43 SIGMA(I)=SIGI
- 44 IF ((A(I).LT.AMX(I).OR.DA(I).LE.0.).AND.(A(I).GT.AMN(I).OR.DA(I).G
- 1E.0.)) GO TO 46
- AKAP=ABS(DA(I)/SIGI)
- IF (AKAP-AFIX) 46,46,45
- 45 AFIX=AKAP
- IFIX=I
- IFIX1=I
- 46 I1=I1+1
- L=L+I1
- 47 CONTINUE
- IF (IFIX) 48,50,48
- 48 PL(IFIX)=-1.
- 49 FIXFLG=FIXFLG+1.
- FI=0.
-C-----REPEAT CALCULATION OF THEORETICAL STEP AFTER FIXING EACH PARAMETER
- GO TO 19
-C-----CALCULATE STEP CORRECTION FACTOR
- 50 ALAMBD=1.
- AKAPPA=0.
- IMAX=0
- DO 60 I=1,N
- IF (PL(I)) 60,60,51
- 51 BM=AMX(I)-A(I)
- ABI=A(I)+PL(I)
- ABM=AMX(I)
- IF (DA(I)) 52,52,53
- 52 BM=A(I)-AMN(I)
- ABI=A(I)-PL(I)
- ABM=AMN(I)
- 53 BI=PL(I)
- IF (BI-BM) 55,55,54
- 54 BI=BM
- ABI=ABM
- 55 IF (ABS(DA(I))-BI) 58,58,56
- 56 AL=ABS(BI/DA(I))
- IF (ALAMBD-AL) 58,58,57
- 57 IMAX=I
- AIMAX=ABI
- ALAMBD=AL
- 58 AKAP=ABS(DA(I)/SIGMA(I))
- IF (AKAP-AKAPPA) 60,60,59
- 59 AKAPPA=AKAP
- 60 CONTINUE
-C-----CALCULATE NEW CORRECTED STEP
- GT=0.
- AMB=1.E18
- IF (ALAMBD) 62,62,61
- 61 AMB=0.25/ALAMBD
- 62 CONTINUE
- DO 67 I=1,N
- IF (PL(I)) 67,67,63
- 63 IF (NN2-N2) 66,66,64
- 64 IF (ABS(DA(I)/PL(I))-AMB) 66,65,65
- 65 PL(I)=4.*PL(I)
- T1=4.
- 66 DA(I)=DA(I)*ALAMBD
- GT=GT+DA(I)*G(I)
- 67 CONTINUE
-C-----CHECK IF MINIMUM ATTAINED AND SET EXIT MODE
- IF (-GT.GT.SP.OR.T1.GE.1..OR.ALAMBD.GE.1.) GO TO 68
- ENDFLG=-1.
- 68 IF (ENDFLG) 85,69,69
- 69 IF (AKAPPA-ABS(EPS)) 70,75,75
- 70 IF (FIXFLG) 72,71,72
- 71 ENDFLG=1.
- GO TO 85
- 72 IF (ENDFLG) 85,77,73
- 73 IF (IFIX1) 85,85,76
- 74 IF (FI-FIXFLG) 76,76,77
- 75 IF (FIXFLG) 74,76,74
- 76 FI=FI+1.
- ENDFLG=0.
- 85 IF(ENDFLG.EQ.0..AND.NN3.GE.N3) ENDFLG=-3.
- IF(ENDFLG.GT.0..AND.INDFLG(2).GT.0) ENDFLG=-2.
- CALL MONITO (S,M,NN3,IT,EPS,GT,AKAPPA,ALAMBD)
- IF (ENDFLG) 83,79,83
-C-----CHECK IF FIXING ON BOUND IS CORRECT
- 77 ENDFLG=1.
- FIXFLG=0.
- IFIX1=0
- DO 78 I=1,M
- 78 PL(I)=PL0(I)
- INDFLG(2)=0
- GO TO 19
-C-----NEXT ITERATION
- 79 ENDFLG=0.
- DO 80 I=1,N
- A(I)=A(I)+DA(I)
- 80 CONTINUE
- IF (IMAX) 82,82,81
- 81 A(IMAX)=AIMAX
- 82 OLDS=S
- NN2=NN2+1
- NN3=NN3+1
- GO TO 3
- 83 MC=ENDFLG
- RETURN
-C-----ENTRY FOR MAXIMUM LIKLEHOOD
-#if (defined(CERNLIB_CDC))&&(defined(CERNLIB_F4))
- ENTRY LIKELM
-#endif
-#if !defined(CERNLIB_CDC)||!defined(CERNLIB_F4)
- ENTRY LIKELM(S,M,N1,N2,N3,EPS,AKAPPA,ALAMBD,IT,MC)
-#endif
- INDFLG(3)=1
- GO TO 1
-C
- 84 FORMAT('1',43X,'FUNCTION MINIMISATION BY SUBROUTINE FUMILI/LIKE',
- +'LM'/'0',55X,'IN THE FOLLOWING PRINT-OUT'/
- + '0',27X,'S = VALUE OF OBJECTIVE FUNCTION,',
- + 'EC = EXPECTED CHANGE IN S DURING NEXT ITERATION'/
- + '0',34X,'KAPPA = ESTIMATED DISTANCE TO MINIMUM, LAMBDA =',
- + 'STEP LENGTH MODIFIER'///)
- END
diff --git a/src/mathlib/gen/d/gauss.F b/src/mathlib/gen/d/gauss.F
deleted file mode 100644
index 495bb9c..0000000
--- a/src/mathlib/gen/d/gauss.F
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: gauss.F,v 1.1.1.1 1996/04/01 15:02:13 mclareni Exp $
-*
-* $Log: gauss.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:13 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-C This will be GAUSS,IF=DOUBLE and GAUSS64,IF=-DOUBLE.
- FUNCTION GAUSS(F,A,B,EPS)
-
- CHARACTER NAME*(*)
- PARAMETER (NAME = 'GAUSS')
-#include "gausscod.inc"
- 99 GAUSS=H
- RETURN
- END
diff --git a/src/mathlib/gen/d/gauss128.F b/src/mathlib/gen/d/gauss128.F
deleted file mode 100644
index 264eb77..0000000
--- a/src/mathlib/gen/d/gauss128.F
+++ /dev/null
@@ -1,126 +0,0 @@
-*
-* $Id: gauss128.F,v 1.1.1.1 1996/04/01 15:02:13 mclareni Exp $
-*
-* $Log: gauss128.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:13 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_QUAD)
-#if defined(CERNLIB_DOUBLE)
- FUNCTION QGAUSS(F,A,B,EPS)
-
-C QGAUSS FOR IBM AND ALIKE
-#endif
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION DGAUSS(F,A,B,EPS)
-
-C DGAUSS FOR CRAY AND ALIKE
-#endif
-#include "gen/imp128.inc"
- CHARACTER NAME*(*)
-#if defined(CERNLIB_DOUBLE)
- PARAMETER (NAME = 'QGAUSS')
-#endif
-#if !defined(CERNLIB_DOUBLE)
- PARAMETER (NAME = 'DGAUSS')
-#endif
- DIMENSION W(12),X(12)
-
- PARAMETER (Z1 = 1, HF = Z1/2, CST = 5*Z1/1000)
-
- DATA X
-#if defined(CERNLIB_DOUBLE)
- 1 /0.96028 98564 97536 23168 35608 68569 47Q0,
- 2 0.79666 64774 13626 73959 15539 36475 83Q0,
- 3 0.52553 24099 16328 98581 77390 49189 25Q0,
- 4 0.18343 46424 95649 80493 94761 42360 18Q0,
- 5 0.98940 09349 91649 93259 61541 73450 33Q0,
- 6 0.94457 50230 73232 57607 79884 15534 61Q0,
- 7 0.86563 12023 87831 74388 04678 97712 39Q0,
- 8 0.75540 44083 55003 03389 51011 94847 44Q0,
- 9 0.61787 62444 02643 74844 66717 64048 79Q0,
- A 0.45801 67776 57227 38634 24194 42983 58Q0,
- B 0.28160 35507 79258 91323 04605 01460 50Q0,
- C 0.95012 50983 76374 40185 31933 54249 58Q-1/
-
- DATA W
- 1 /0.10122 85362 90376 25915 25313 54309 96Q0,
- 2 0.22238 10344 53374 47054 43559 94426 24Q0,
- 3 0.31370 66458 77887 28733 79622 01986 60Q0,
- 4 0.36268 37833 78361 98296 51504 49277 20Q0,
- 5 0.27152 45941 17540 94851 78057 24560 18Q-1,
- 6 0.62253 52393 86478 92862 84383 69943 78Q-1,
- 7 0.95158 51168 24927 84809 92510 76022 46Q-1,
- 8 0.12462 89712 55533 87205 24762 82192 02Q0,
- 9 0.14959 59888 16576 73208 15017 30547 48Q0,
- A 0.16915 65193 95002 53818 93120 79030 36Q0,
- B 0.18260 34150 44923 58886 67636 67969 22Q0,
- C 0.18945 06104 55068 49628 53967 23208 28Q0/
-#endif
-#if !defined(CERNLIB_DOUBLE)
- 1 /0.96028 98564 97536 23168 35608 68569 47D0,
- 2 0.79666 64774 13626 73959 15539 36475 83D0,
- 3 0.52553 24099 16328 98581 77390 49189 25D0,
- 4 0.18343 46424 95649 80493 94761 42360 18D0,
- 5 0.98940 09349 91649 93259 61541 73450 33D0,
- 6 0.94457 50230 73232 57607 79884 15534 61D0,
- 7 0.86563 12023 87831 74388 04678 97712 39D0,
- 8 0.75540 44083 55003 03389 51011 94847 44D0,
- 9 0.61787 62444 02643 74844 66717 64048 79D0,
- A 0.45801 67776 57227 38634 24194 42983 58D0,
- B 0.28160 35507 79258 91323 04605 01460 50D0,
- C 0.95012 50983 76374 40185 31933 54249 58D-1/
-
- DATA W
- 1 /0.10122 85362 90376 25915 25313 54309 96D0,
- 2 0.22238 10344 53374 47054 43559 94426 24D0,
- 3 0.31370 66458 77887 28733 79622 01986 60D0,
- 4 0.36268 37833 78361 98296 51504 49277 20D0,
- 5 0.27152 45941 17540 94851 78057 24560 18D-1,
- 6 0.62253 52393 86478 92862 84383 69943 78D-1,
- 7 0.95158 51168 24927 84809 92510 76022 46D-1,
- 8 0.12462 89712 55533 87205 24762 82192 02D0,
- 9 0.14959 59888 16576 73208 15017 30547 48D0,
- A 0.16915 65193 95002 53818 93120 79030 36D0,
- B 0.18260 34150 44923 58886 67636 67969 22D0,
- C 0.18945 06104 55068 49628 53967 23208 28D0/
-#endif
-
- H=0
- IF(B .EQ. A) GO TO 99
- CONST=CST/ABS(B-A)
- BB=A
- 1 AA=BB
- BB=B
- 2 C1=HF*(BB+AA)
- C2=HF*(BB-AA)
- S8=0
- DO 3 I = 1,4
- U=C2*X(I)
- 3 S8=S8+W(I)*(F(C1+U)+F(C1-U))
- S16=0
- DO 4 I = 5,12
- U=C2*X(I)
- 4 S16=S16+W(I)*(F(C1+U)+F(C1-U))
- S16=C2*S16
- IF(ABS(S16-C2*S8) .LE. EPS*(1+ABS(S16))) THEN
- H=H+S16
- IF(BB .NE. B) GO TO 1
- ELSE
- BB=C1
- IF(1+CONST*ABS(C2) .NE. 1) GO TO 2
- H=0
- CALL MTLPRT(NAME,'D103.1','TOO HIGH ACCURACY REQUIRED')
- GO TO 99
- END IF
-#if !defined(CERNLIB_DOUBLE)
- 99 DGAUSS=H
-#endif
-#if defined(CERNLIB_DOUBLE)
- 99 QGAUSS=H
-#endif
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/d/gauss64.F b/src/mathlib/gen/d/gauss64.F
deleted file mode 100644
index 945ad77..0000000
--- a/src/mathlib/gen/d/gauss64.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: gauss64.F,v 1.1.1.1 1996/04/01 15:02:13 mclareni Exp $
-*
-* $Log: gauss64.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:13 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- FUNCTION DGAUSS(F,A,B,EPS)
-#include "gen/imp64.inc"
-
- CHARACTER NAME*(*)
- PARAMETER (NAME = 'DGAUSS')
-#include "gausscod.inc"
-
- 99 DGAUSS=H
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/d/gausscod.inc b/src/mathlib/gen/d/gausscod.inc
deleted file mode 100644
index 81b0977..0000000
--- a/src/mathlib/gen/d/gausscod.inc
+++ /dev/null
@@ -1,55 +0,0 @@
-*
-* $Id: gausscod.inc,v 1.1.1.1 1996/04/01 15:02:13 mclareni Exp $
-*
-* $Log: gausscod.inc,v $
-* Revision 1.1.1.1 1996/04/01 15:02:13 mclareni
-* Mathlib gen
-*
-*
-*
-* gausscod.inc
-*
- DIMENSION W(12),X(12)
-
- PARAMETER (Z1 = 1, HF = Z1/2, CST = 5*Z1/1000)
-
- DATA X( 1) /9.6028985649753623D-1/, W( 1) /1.0122853629037626D-1/
- DATA X( 2) /7.9666647741362674D-1/, W( 2) /2.2238103445337447D-1/
- DATA X( 3) /5.2553240991632899D-1/, W( 3) /3.1370664587788729D-1/
- DATA X( 4) /1.8343464249564980D-1/, W( 4) /3.6268378337836198D-1/
- DATA X( 5) /9.8940093499164993D-1/, W( 5) /2.7152459411754095D-2/
- DATA X( 6) /9.4457502307323258D-1/, W( 6) /6.2253523938647893D-2/
- DATA X( 7) /8.6563120238783174D-1/, W( 7) /9.5158511682492785D-2/
- DATA X( 8) /7.5540440835500303D-1/, W( 8) /1.2462897125553387D-1/
- DATA X( 9) /6.1787624440264375D-1/, W( 9) /1.4959598881657673D-1/
- DATA X(10) /4.5801677765722739D-1/, W(10) /1.6915651939500254D-1/
- DATA X(11) /2.8160355077925891D-1/, W(11) /1.8260341504492359D-1/
- DATA X(12) /9.5012509837637440D-2/, W(12) /1.8945061045506850D-1/
-
- H=0
- IF(B .EQ. A) GO TO 99
- CONST=CST/ABS(B-A)
- BB=A
- 1 AA=BB
- BB=B
- 2 C1=HF*(BB+AA)
- C2=HF*(BB-AA)
- S8=0
- DO 3 I = 1,4
- U=C2*X(I)
- 3 S8=S8+W(I)*(F(C1+U)+F(C1-U))
- S16=0
- DO 4 I = 5,12
- U=C2*X(I)
- 4 S16=S16+W(I)*(F(C1+U)+F(C1-U))
- S16=C2*S16
- IF(ABS(S16-C2*S8) .LE. EPS*(1+ABS(S16))) THEN
- H=H+S16
- IF(BB .NE. B) GO TO 1
- ELSE
- BB=C1
- IF(1+CONST*ABS(C2) .NE. 1) GO TO 2
- H=0
- CALL MTLPRT(NAME,'D103.1','TOO HIGH ACCURACY REQUIRED')
- GO TO 99
- END IF
diff --git a/src/mathlib/gen/d/i128.F b/src/mathlib/gen/d/i128.F
deleted file mode 100644
index 9d40520..0000000
--- a/src/mathlib/gen/d/i128.F
+++ /dev/null
@@ -1,69 +0,0 @@
-*
-* $Id: i128.F,v 1.1.1.1 1996/04/01 15:02:23 mclareni Exp $
-*
-* $Log: i128.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:23 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE I128(C,D,IX,F,G,IZ)
- REAL C(1),D(1),F(1),G(1),A(128),B(128)
- COMMON /TAB/E(253)
- IND = 0
- GOTO 20
-#if (defined(CERNLIB_CDC))&&(defined(CERNLIB_F4))
- ENTRY D128
-#endif
-#if !defined(CERNLIB_CDC)||!defined(CERNLIB_F4)
- ENTRY D128(C,D,IX,F,G,IZ)
-#endif
- IND = 1
- 20 IT = 1+IX
- JT = IX+IX
- CALL I64(C,D,JT,A,A(2),2)
- CALL I64(C(IT),D(IT),JT,B,B(2),2)
- IF(IND.EQ.1) GOTO 30
- IS = IZ
- MZ = 1
- LZ = 32*IZ
- KZ = 1+LZ
- JZ = KZ+LZ
- LZ = JZ+LZ
- GOTO 40
- 30 IS = -IZ
- MZ = 32*IZ
- LZ = 1+MZ
- JZ = MZ+LZ
- KZ = JZ+MZ
- MZ = KZ+MZ
- 40 F(1) = A(1)+B(1)
- G(1) = A(2)+B(2)
- F(JZ) = A(1)-B(1)
- G(JZ) = A(2)-B(2)
- F(KZ) = A(65)+B(66)
- G(KZ) = A(66)-B(65)
- F(LZ) = A(65)-B(66)
- G(LZ) = A(66)+B(65)
- DO 10 I=1,61,2
- K = I+66
- MZ = MZ+IS
- JZ = JZ+IS
- KZ = KZ+IS
- LZ = LZ+IS
- E1 = E(2*I+2)
- E2 = E(2*I+1)
- B1R = B(I+2)*E1+B(I+3)*E2
- B1I = B(I+3)*E1-B(I+2)*E2
- B2R = B(K+1)*E1-B(K)*E2
- B2I = -B(K)*E1-B(K+1)*E2
- F(MZ) = A(I+2)+B1R
- G(MZ) = A(I+3)+B1I
- F(JZ) = A(I+2)-B1R
- G(JZ) = A(I+3)-B1I
- F(KZ) = A(K)+B2R
- G(KZ) = A(K+1)+B2I
- F(LZ) = A(K)-B2R
- 10 G(LZ) = A(K+1)-B2I
- RETURN
- END
diff --git a/src/mathlib/gen/d/i32.F b/src/mathlib/gen/d/i32.F
deleted file mode 100644
index d7566f0..0000000
--- a/src/mathlib/gen/d/i32.F
+++ /dev/null
@@ -1,69 +0,0 @@
-*
-* $Id: i32.F,v 1.1.1.1 1996/04/01 15:02:23 mclareni Exp $
-*
-* $Log: i32.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:23 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE I32(C,D,IX,F,G,IZ)
- REAL C(1),D(1),F(1),G(1),A(32),B(32)
- COMMON /TAB/E(253)
- IND = 0
- GOTO 20
-#if (defined(CERNLIB_CDC))&&(defined(CERNLIB_F4))
- ENTRY D32
-#endif
-#if !defined(CERNLIB_CDC)||!defined(CERNLIB_F4)
- ENTRY D32(C,D,IX,F,G,IZ)
-#endif
- IND = 1
- 20 IT = 1+IX
- JT = IX+IX
- CALL I16(C,D,JT,A,A(2),2)
- CALL I16(C(IT),D(IT),JT,B,B(2),2)
- IF(IND.EQ.1) GOTO 30
- IS = IZ
- MZ = 1
- LZ = 8*IZ
- KZ = 1+LZ
- JZ = KZ+LZ
- LZ = JZ+LZ
- GOTO 40
- 30 IS = -IZ
- MZ = 8*IZ
- LZ = 1+MZ
- JZ = MZ+LZ
- KZ = JZ+MZ
- MZ = KZ+MZ
- 40 F(1) = A(1)+B(1)
- G(1) = A(2)+B(2)
- F(JZ) = A(1)-B(1)
- G(JZ) = A(2)-B(2)
- F(KZ) = A(17)+B(18)
- G(KZ) = A(18)-B(17)
- F(LZ) = A(17)-B(18)
- G(LZ) = A(18)+B(17)
- DO 10 I=1,13,2
- K = I+18
- MZ = MZ+IS
- JZ = JZ+IS
- KZ = KZ+IS
- LZ = LZ+IS
- E1 = E(8*I+8)
- E2 = E(8*I+7)
- B1R = B(I+2)*E1+B(I+3)*E2
- B1I = B(I+3)*E1-B(I+2)*E2
- B2R = B(K+1)*E1-B(K)*E2
- B2I = -B(K)*E1-B(K+1)*E2
- F(MZ) = A(I+2)+B1R
- G(MZ) = A(I+3)+B1I
- F(JZ) = A(I+2)-B1R
- G(JZ) = A(I+3)-B1I
- F(KZ) = A(K)+B2R
- G(KZ) = A(K+1)+B2I
- F(LZ) = A(K)-B2R
- 10 G(LZ) = A(K+1)-B2I
- RETURN
- END
diff --git a/src/mathlib/gen/d/i64.F b/src/mathlib/gen/d/i64.F
deleted file mode 100644
index 9060726..0000000
--- a/src/mathlib/gen/d/i64.F
+++ /dev/null
@@ -1,69 +0,0 @@
-*
-* $Id: i64.F,v 1.1.1.1 1996/04/01 15:02:23 mclareni Exp $
-*
-* $Log: i64.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:23 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE I64(C,D,IX,F,G,IZ)
- REAL C(1),D(1),F(1),G(1),A(64),B(64)
- COMMON /TAB/E(253)
- IND = 0
- GOTO 20
-#if (defined(CERNLIB_CDC))&&(defined(CERNLIB_F4))
- ENTRY D64
-#endif
-#if (!defined(CERNLIB_CDC))&&(!defined(CERNLIB_F4))
- ENTRY D64(C,D,IX,F,G,IZ)
-#endif
- IND = 1
- 20 IT = 1+IX
- JT = IX+IX
- CALL I32(C,D,JT,A,A(2),2)
- CALL I32(C(IT),D(IT),JT,B,B(2),2)
- IF(IND.EQ.1) GOTO 30
- IS = IZ
- MZ = 1
- LZ = 16*IZ
- KZ = 1+LZ
- JZ = KZ+LZ
- LZ = JZ+LZ
- GOTO 40
- 30 IS = -IZ
- MZ = 16*IZ
- LZ = 1+MZ
- JZ = MZ+LZ
- KZ = JZ+MZ
- MZ = KZ+MZ
- 40 F(1) = A(1)+B(1)
- G(1) = A(2)+B(2)
- F(JZ) = A(1)-B(1)
- G(JZ) = A(2)-B(2)
- F(KZ) = A(33)+B(34)
- G(KZ) = A(34)-B(33)
- F(LZ) = A(33)-B(34)
- G(LZ) = A(34)+B(33)
- DO 10 I=1,29,2
- K = I+34
- MZ = MZ+IS
- JZ = JZ+IS
- KZ = KZ+IS
- LZ = LZ+IS
- E1 = E(4*I+4)
- E2 = E(4*I+3)
- B1R = B(I+2)*E1+B(I+3)*E2
- B1I = B(I+3)*E1-B(I+2)*E2
- B2R = B(K+1)*E1-B(K)*E2
- B2I = -B(K)*E1-B(K+1)*E2
- F(MZ) = A(I+2)+B1R
- G(MZ) = A(I+3)+B1I
- F(JZ) = A(I+2)-B1R
- G(JZ) = A(I+3)-B1I
- F(KZ) = A(K)+B2R
- G(KZ) = A(K+1)+B2I
- F(LZ) = A(K)-B2R
- 10 G(LZ) = A(K+1)-B2I
- RETURN
- END
diff --git a/src/mathlib/gen/d/linsq.F b/src/mathlib/gen/d/linsq.F
deleted file mode 100644
index 8062c0a..0000000
--- a/src/mathlib/gen/d/linsq.F
+++ /dev/null
@@ -1,287 +0,0 @@
-*
-* $Id: linsq.F,v 1.1.1.1 1996/04/01 15:02:21 mclareni Exp $
-*
-* $Log: linsq.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:21 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE LINSQ(K,N,M,F,X,Y,W,DA,H,COV,QPRINT,QMIN)
- DIMENSION X(M,N),F(K),Y(N),W(N),H(K,K),DA(K)
- DIMENSION INDEX(100)
- DOUBLE PRECISION H,DETERM
- DOUBLE PRECISION DWI,DYI,DFK1
- KPLUS=K+1
- APRINT=QPRINT
- DO 11 I=1,K
- DO 11 J=1,KPLUS
- 11 H(I,J) = 0.D0
- IFLAG=1
- DO 2 I=1,N
- CALL FCN(K,M,F,X(1,I),IFLAG)
- IFLAG=4
- DWI = DBLE(W(I))
- DYI = DBLE(Y(I))
- DO 2 K1=1,K
- DFK1 = DBLE(F(K1))
- H(K1,K+1) = H(K1,K+1) + DWI*DFK1*DYI
- DO 2 L=1,K1
- 2 H(K1,L) = H(K1,L) + DWI*DFK1*DBLE(F(L))
- DO 3 J=1,K
- DO 3 I=1,J
- 3 H(I,J)=H(J,I)
- IF(COV)5,4,5
- 4 CALL D508R2(H,K,K,K+1,1,INDEX,NERROR,DETERM)
- MM=1
- QMIN = QLINSQ(K,N,M,F,X,Y,W,DA,H,MM)
- DO 7 I=1,K
- 7 F(I)=H(I,1)
- IF(APRINT.NE.0.) GO TO 10
- RETURN
- 5 CALL D508R1(H,K,K,K+1,1,INDEX,NERROR,DETERM)
- MM=K+1
- QMIN = QLINSQ(K,N,M,F,X,Y,W,DA,H,MM)
- DO 6 I=1,K
- 6 F(I)=H(I,K+1)
- DO 8 I=1,K
- HDA=H(I,I)
- 8 DA(I)=SQRT(HDA)
- IF(APRINT.EQ.0.) RETURN
-C
-C PRINTS ERRORS IN THE COEFFICIENTS
-C
- WRITE(6,100)
- 100 FORMAT(45X,'ERRORS IN THE COEFFICIENTS')
- WRITE(6,101)(DA(I),I=1,K)
- 101 FORMAT(5X,5G16.6)
-C
-C PRINTS LOWER DIAGONAL COVARIANCE MATRIX
-C
- WRITE(6,102)
- 102 FORMAT(///40X,'VARIANCE-COVARIANCE MATRIX'///)
- DO 9 I=1,K
- DO 12 J=1,K
- 12 F(J)=H(I,J)
- 9 WRITE(6,103)(F(JJ),JJ=1,I)
- 103 FORMAT(10X,5G20.6//)
- DO 13 I=1,K
- 13 F(I)=H(I,K+1)
- 10 CONTINUE
-C
-C PRINTS COEFFICIENTS AND SUM OF SQUARES
-C
- WRITE(6,104)QMIN
- 104 FORMAT(///30X,'SUM OF SQUARES=',G20.6///)
- WRITE(6,105)
- 105 FORMAT(45X,'COEFFICIENTS'///)
- WRITE(6,103)(F(I),I=1,K)
- RETURN
- END
- FUNCTION QLINSQ(K,N,M,F,X,Y,W,DA,H,MM)
-C COMPUTES THE SUM OF SQUARES
- DIMENSION F(K),X(M,N),DA(K),H(K,K),Y(N),W(N)
- DOUBLE PRECISION H
- IFLAG = 4
- Q=0.
- DO 3 I=1,N
- CALL FCN(K,M,F,X(1,I),IFLAG)
- HSUM=0.
- DO 2 I1=1,K
- 2 HSUM=H(I1,MM)*F(I1)+HSUM
- 3 Q=(HSUM-Y(I))*(HSUM-Y(I))*W(I)+Q
- QLINSQ = Q
- RETURN
- END
- SUBROUTINE D508R1 (A,IDIM1,N1,IDIM2,N2,INDEX,NERROR,DETERM)
-C
-C MATRIX INVERSION WITH ACCOMPANYING SOLUTION OF LINEAR EQUATIONS
- DOUBLE PRECISION A,DETERM,DETER,PIVOT,SWAP
- DIMENSION A(IDIM1),INDEX(IDIM1)
- DETER=1.0D0
- N=N1
- IEMAT=N+N2
- IDIM=IDIM1
- NMIN1=N-1
-C THE ROUTINE DOES ITS OWN EVALUATION FOR DOUBLE SUBSCRIPTING OF
-C ARRAY A.
- IPIVC=1-IDIM
-C MAIN LOOP TO INVERT THE MATRIX
- DO 11 MAIN=1,N
- PIVOT=0.0D0
- IPIVC=IPIVC+IDIM
-C SEARCH FOR NEXT PIVOT IN COLUMN MAIN.
- IPIVC1=IPIVC+MAIN-1
- IPIVC2=IPIVC +NMIN1
- DO 2 I1=IPIVC1,IPIVC2
- IF(ABS(A(I1))-ABS(PIVOT)) 2,2,1
- 1 PIVOT=A(I1)
- LPIV=I1
- 2 CONTINUE
-C IS PIVOT DIFFERENT FROM ZERO
- IF(PIVOT) 3,15,3
-C GET THE PIVOT-LINE INDICATOR AND SWAP LINES IF NECESSARY
- 3 ICOL=LPIV-IPIVC+1
- INDEX(MAIN)=ICOL
- IF(ICOL-MAIN) 6,6,4
-C COMPLEMENT THE DETERMINANT
- 4 DETER=-DETER
-C POINTER TO LINE PIVOT FOUND
- ICOL=ICOL-IDIM
-C POINTER TO EXACT PIVOT LINE
- I3=MAIN-IDIM
- DO 5 I=1,IEMAT
- ICOL=ICOL+IDIM
- I3=I3+IDIM
- SWAP=A(I3)
- A(I3)=A(ICOL)
- 5 A(ICOL)=SWAP
-C COMPUTE DETERMINANT
- 6 DETER=DETER*PIVOT
- PIVOT=1./PIVOT
-C TRANSFORM PIVOT COLUMN
- I3=IPIVC+NMIN1
- DO 7 I=IPIVC,I3
- 7 A(I)=-A(I)*PIVOT
- A(IPIVC1)=PIVOT
-C PIVOT ELEMENT TRANSFORMED
-C
-C NOW CONVERT REST OF THE MATRIX
- I1=MAIN-IDIM
-C POINTER TO PIVOT LINE ELEMENTS
- ICOL=1-IDIM
-C GENERAL COLUMN POINTER
- DO 10 I=1,IEMAT
- ICOL=ICOL+IDIM
- I1=I1+IDIM
-C POINTERS MOVED
- IF(I-MAIN) 8,10,8
-C PIVOT COLUMN EXCLUDED
- 8 JCOL=ICOL+NMIN1
- SWAP=A(I1)
- I3=IPIVC-1
- DO 9 I2=ICOL,JCOL
- I3=I3+1
- 9 A(I2)=A(I2)+SWAP*A(I3)
- A(I1)=SWAP*PIVOT
- 10 CONTINUE
- 11 CONTINUE
-C NOW REARRANGE THE MATRIX TO GET RIGHT INVERS
- DO 14 I1=1,N
- MAIN=N+1-I1
- LPIV=INDEX(MAIN)
- IF(LPIV-MAIN) 12,14,12
- 12 ICOL=(LPIV-1)*IDIM+1
- JCOL=ICOL+NMIN1
- IPIVC=(MAIN-1)*IDIM+1-ICOL
- DO 13 I2=ICOL,JCOL
- I3=I2+IPIVC
- SWAP=A(I2)
- A(I2)=A(I3)
- 13 A(I3)=SWAP
- 14 CONTINUE
- DETERM=DETER
- NERROR=0
- RETURN
- 15 NERROR=MAIN
- DETERM=DETER
- RETURN
- END
- SUBROUTINE D508R2 (A,DIM1,N1,DIM2,N2,INDEX,NERROR,DETERM)
- INTEGER DIM1,DIM,PIVCOL,PIVCO1,TOPX,ENDX,TOPCOL,ENDCOL,EMAT
- DIMENSION A(DIM1),INDEX(DIM1)
- DOUBLE PRECISION A,DETERM,DETER,PIVOT,SWAP
- DIM=DIM1
- DETER=1.0D0
- N=N1
- EMAT=N+N2
- NMIN1=N-1
- PIVCOL=-DIM
-C MAIN LOOP TO CREATE TRIANGULAR
- DO 10 MAIN=1,N
- PIVOT=0.0D0
- PIVCOL=PIVCOL+DIM+1
- PIVCO1=PIVCOL+N-MAIN
-C SEARCH PIVOT
- DO 2 I1=PIVCOL,PIVCO1
- IF(ABS(A(I1))-ABS(PIVOT)) 2,2,1
- 1 PIVOT=A(I1)
- LPIV=I1
- 2 CONTINUE
-C IS PIVOT DIFFERENT FROM ZERO
- IF(PIVOT) 3,15,3
-C IS IT NECESSARY TO BRING PIVOT TO DIAGONAL
- 3 IF(LPIV-PIVCOL) 4,6,4
- 4 DETER=-DETER
- LPIV=LPIV-DIM
- I1=PIVCOL-DIM
- DO 5 I2=MAIN,EMAT
- LPIV=LPIV+DIM
- I1=I1+DIM
- SWAP=A(I1)
- A(I1)=A(LPIV)
- 5 A(LPIV)=SWAP
- 6 DETER=DETER*PIVOT
- IF (MAIN .EQ. N) GO TO 10
- PIVOT=1./PIVOT
-C MODIFY PIVOT COLUMN
- I1=PIVCOL+1
- DO 7 I2=I1,PIVCO1
- 7 A(I2)=A(I2)*PIVOT
-C CONVERT THE SUBMATRIX AND RIGHT SIDES
- I3=PIVCOL
- IROW=MAIN+1
- DO 9 I1=IROW,N
- I3=I3+1
- I4=PIVCOL
- I5=I3
- DO 8 I2=IROW,EMAT
- I4=I4+DIM
- I5=I5+DIM
- 8 A(I5)=A(I5)-A(I4)*A(I3)
- 9 CONTINUE
- 10 CONTINUE
- DETERM=DETER
- NERROR=0
-C COMPUTE THE SOLUTIONS
- NO=N+1
- TOPX=NMIN1*DIM+1
- DO 13 I=NO,EMAT
- TOPX=TOPX+DIM
- ENDX=TOPX+N
- TOPCOL=N*DIM+1
- ENDCOL=TOPCOL+NMIN1
- DO 12 I1=1,NMIN1
- ENDX=ENDX-1
- TOPCOL=TOPCOL-DIM
- ENDCOL=ENDCOL-DIM-1
- A(ENDX)=A(ENDX)/A(ENDCOL+1)
- SWAP=A(ENDX)
- I3=TOPX-1
- DO 11 I2=TOPCOL,ENDCOL
- I3=I3+1
- 11 A(I3)=A(I3)-A(I2)*SWAP
- 12 CONTINUE
- A(TOPX)=A(TOPX)/A(1)
- 13 CONTINUE
-C LEFTADJUST THE SOLUTIONS
- I=-DIM
- TOPX=NMIN1*DIM+1
- ENDX=TOPX+NMIN1
- DO 14 I1=NO,EMAT
- TOPX=TOPX+DIM
- ENDX=ENDX+DIM
- I=I+DIM
- I3=I
- DO 14 I2=TOPX,ENDX
- I3=I3+1
- 14 A(I3)=A(I2)
- RETURN
-C ERROR EXIT
- 15 NERROR=-1
- DETERM=DETER
- WRITE(6,100)MAIN,MAIN
- RETURN
- 100 FORMAT(' LINEQ1 ..... THE ',I10,'. COLUMN OF THE MATRIX CONTAINS'
- 1 ,' ONLY ZEROS AT THE',I10,'. ELIMINATIONSTEP')
- END
diff --git a/src/mathlib/gen/d/mconv.F b/src/mathlib/gen/d/mconv.F
deleted file mode 100644
index ca16576..0000000
--- a/src/mathlib/gen/d/mconv.F
+++ /dev/null
@@ -1,91 +0,0 @@
-*
-* $Id: mconv.F,v 1.1.1.1 1996/04/01 15:02:21 mclareni Exp $
-*
-* $Log: mconv.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:21 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE MCONV (N)
-C-----MCONV INVERTS THE POSITIVE DEFINITE PACKED SYMMETRIC MATRIX Z
-C-----BY THE SQUARE-ROOT METHOD
-#include "d510pl.inc"
-#include "d510si.inc"
-#include "d510uo.inc"
-C-----MAXIMUM REAL NUMBER AND 10.*MAXIMUM RELATIVE PRECISION ON CDC6000
-#if defined(CERNLIB_CDC)
- DATA AM,RP/1.E300,1.E-14/
-#endif
-#if defined(CERNLIB_IBM)
- DATA AM,RP/1.E75,1.E-14/
-#endif
-#if (!defined(CERNLIB_CDC))&&(!defined(CERNLIB_IBM))
- DATA AM,RP / 1.0E37, 1.0E-14/
-#endif
- IF (N.LT.1) RETURN
- APS=SQRT(AM/N)
- AP=1./(APS*APS)
- IR=0
- DO 11 I=1,N
- 1 IR=IR+1
- IF (PL(IR)) 1,1,2
- 2 NI=I*(I-1)/2
- II=NI+I
- K=N+1
- IF (Z(II).LE.RP*ABS(R(IR)).OR.Z(II).LE.AP) GO TO 19
- Z(II)=1./SQRT(Z(II))
- NL=II-1
- 3 IF (NL-NI) 5,5,4
- 4 Z(NL)=Z(NL)*Z(II)
- IF (ABS(Z(NL)).GE.APS) GO TO 16
- NL=NL-1
- GO TO 3
- 5 IF (I-N) 6,12,12
- 6 K=K-1
- NK=K*(K-1)/2
- NL=NK
- KK=NK+I
- D=Z(KK)*Z(II)
- C=D*Z(II)
- L=K
- 7 LL=NK+L
- LI=NL+I
- Z(LL)=Z(LL)-Z(LI)*C
- L=L-1
- NL=NL-L
- IF (L-I) 9,9,7
- 8 LL=NK+L
- LI=NI+L
- Z(LL)=Z(LL)-Z(LI)*D
- 9 L=L-1
- IF (L) 10,10,8
- 10 Z(KK)=-C
- IF (K-I-1) 11,11,6
- 11 CONTINUE
- 12 DO 14 I=1,N
- DO 14 K=I,N
- NL=K*(K-1)/2
- KI=NL+I
- D=0.
- DO 13 L=K,N
- LI=NL+I
- LK=NL+K
- D=D+Z(LI)*Z(LK)
- NL=NL+L
- 13 CONTINUE
- KI=K*(K-1)/2+I
- Z(KI)=D
- 14 CONTINUE
- 15 RETURN
- 16 K=I+NL-II
- IR=0
- DO 18 I=1,K
- 17 IR=IR+1
- IF (PL(IR)) 17,17,18
- 18 CONTINUE
- 19 PL(IR)=-2.
- R(IR)=0.
- INDFLG(1)=IR
- GO TO 15
- END
diff --git a/src/mathlib/gen/d/mft.F b/src/mathlib/gen/d/mft.F
deleted file mode 100644
index b2a300f..0000000
--- a/src/mathlib/gen/d/mft.F
+++ /dev/null
@@ -1,70 +0,0 @@
-*
-* $Id: mft.F,v 1.1.1.1 1996/04/01 15:02:19 mclareni Exp $
-*
-* $Log: mft.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:19 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE MFT(M1,MD1,VIN,VOU,U,IAS)
- DIMENSION VIN(M1),VOU(M1),U(MD1)
- M=M1-1
- MH=M/2
- MHA=MH-1
- XMH=MH
- MD=2*M
- AX=(1./LOG10(2.))+.01
- XM=MD
- AM=AX*LOG10(XM)
- IM=INT(AM)
- DO 1 I=1,MD1
- 1 U(I)=0.
- VOU(1)=VIN(1)
- IF(IAS.EQ.2) GO TO 100
- DO 2 I=1,MH
- IN=2*I
- 2 U(IN)=VIN(IN)
- CALL RFT(IM,U,1,U,1,3)
- DO 3 I=1,MH
- IN=2*I
- 3 VOU(IN)=U(IN)
- DO 4 I=1,MD1
- 4 U(I)=0.
- DO 5 I=1,MHA
- IN=2*I+1
- 5 U(IN)=VIN(IN)
- U(M1)=.5*VIN(M1)
- CALL RFT(IM,U,1,U,1,3)
- DO 6 I=1,MH
- IN=2*I
- 6 VOU(IN+1)=U(IN)
- DO 16 I=1,MH
- IN=2*I
- VIN(IN)=VOU(IN)
- VOU(IN)=VOU(IN)+VOU(IN+1)
- 16 VOU(IN+1)=VIN(IN)-VOU(IN+1)
- RETURN
- 100 DO 17 I=1,MH
- IN=2*I
- VOU(IN)=VIN(IN)
- VIN(IN)=2.*(VIN(IN)+VIN(IN+1))
- 17 VIN(IN+1)=2.*(VOU(IN)-VIN(IN+1))
- DO 7 I=1,MH
- IN=2*I
- 7 U(IN)=VIN(IN)
- CALL RFT(IM,U,1,U,1,6)
- DO 8 I=1,MH
- IN=2*I
- 8 VOU(IN)=U(IN)
- DO 9 I=1,MD1
- 9 U(I)=0.
- DO 10 I=1,MH
- IN=2*I+1
- 10 U(IN-1)=VIN(IN)
- CALL RFT(IM,U,1,U,1,6)
- DO 11 I=1,MH
- IN=2*I+1
- 11 VOU(IN)=U(IN)
- RETURN
- END
diff --git a/src/mathlib/gen/d/minfc.F b/src/mathlib/gen/d/minfc.F
deleted file mode 100644
index f5e40a7..0000000
--- a/src/mathlib/gen/d/minfc.F
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: minfc.F,v 1.1.1.1 1996/04/01 15:02:20 mclareni Exp $
-*
-* $Log: minfc.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:20 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-C This will be RMINFC,IF=DOUBLE and MINFC64 (RMINFC), IF=-DOUBLE
- SUBROUTINE RMINFC(F,A,B,EPS,DELTA,X,Y,LLM)
- LOGICAL LLM,LLT,LGE
- CHARACTER NAME*(*)
- CHARACTER*80 ERRTXT
-
- PARAMETER (NAME = 'RMINFC')
-#include "minfccod.inc"
diff --git a/src/mathlib/gen/d/minfc128.F b/src/mathlib/gen/d/minfc128.F
deleted file mode 100644
index e136488..0000000
--- a/src/mathlib/gen/d/minfc128.F
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: minfc128.F,v 1.1.1.1 1996/04/01 15:02:20 mclareni Exp $
-*
-* $Log: minfc128.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:20 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if !defined(CERNLIB_DOUBLE)
- SUBROUTINE DMINFC(F,A,B,EPS,DELTA,X,Y,LLM)
-#include "gen/imp128.inc"
- CHARACTER*(*) NAME
- PARAMETER( NAME='DMINFC')
- CALL MTLPRT(NAME,'D503.0','Not available on this machine')
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/d/minfc64.F b/src/mathlib/gen/d/minfc64.F
deleted file mode 100644
index b2ab46b..0000000
--- a/src/mathlib/gen/d/minfc64.F
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: minfc64.F,v 1.1.1.1 1996/04/01 15:02:20 mclareni Exp $
-*
-* $Log: minfc64.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:20 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- SUBROUTINE DMINFC(F,A,B,EPS,DELTA,X,Y,LLM)
-#include "gen/imp64.inc"
- LOGICAL LLM,LLT,LGE
- CHARACTER NAME*(*)
- CHARACTER*80 ERRTXT
-
- PARAMETER (NAME = 'DMINFC')
-#include "minfccod.inc"
-#endif
diff --git a/src/mathlib/gen/d/minfccod.inc b/src/mathlib/gen/d/minfccod.inc
deleted file mode 100644
index 868a4fb..0000000
--- a/src/mathlib/gen/d/minfccod.inc
+++ /dev/null
@@ -1,56 +0,0 @@
-*
-* $Id: minfccod.inc,v 1.1.1.1 1996/04/01 15:02:20 mclareni Exp $
-*
-* $Log: minfccod.inc,v $
-* Revision 1.1.1.1 1996/04/01 15:02:20 mclareni
-* Mathlib gen
-*
-*
-*
-* minfccod.inc
-*
- PARAMETER (W5 = 2.23606 79774 99790D0)
- PARAMETER (HV = (3-W5)/2, HW = (W5-1)/2, R1 = 1, HF = R1/2)
-
- N=-1
- IF(A .NE. B) N=NINT(2.08*LOG(ABS((A-B)/EPS)))
- C=A
- D=B
- IF(A .GT. B) THEN
- C=B
- D=A
- ENDIF
- LLT=.TRUE.
- LGE=.TRUE.
-
- 1 H=D-C
- IF(N .LT. 0) THEN
- X=HF*(C+D)
- Y=F(X)
- LLM=ABS(X-A) .GT. DELTA .AND. ABS(X-B) .GT. DELTA
- RETURN
- ENDIF
- IF(LLT) THEN
- V=C+HV*H
- FV=F(V)
- ENDIF
- IF(LGE) THEN
- W=C+HW*H
- FW=F(W)
- ENDIF
- IF(FV .LT. FW) THEN
- LLT=.TRUE.
- LGE=.FALSE.
- D=W
- W=V
- FW=FV
- ELSE
- LLT=.FALSE.
- LGE=.TRUE.
- C=V
- V=W
- FV=FW
- ENDIF
- N=N-1
- GO TO 1
- END
diff --git a/src/mathlib/gen/d/minsq.F b/src/mathlib/gen/d/minsq.F
deleted file mode 100644
index 12994b2..0000000
--- a/src/mathlib/gen/d/minsq.F
+++ /dev/null
@@ -1,347 +0,0 @@
-*
-* $Id: minsq.F,v 1.1.1.1 1996/04/01 15:02:20 mclareni Exp $
-*
-* $Log: minsq.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:20 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE MINSQ (M,N,F,X,E,IPRINT,NFUN ,NW,W,COV,XSTEP)
- DIMENSION F(M),X(N),E(N),W(NW)
- IFLAG=1
- ESCALE=1.
- MAXFUN=NFUN
- MPLUSN=M+N
- KST=N+MPLUSN
- NPLUS=N+1
- KINV=NPLUS*(MPLUSN+1)
- KSTORE=KINV-MPLUSN-1
- CALL FCN1(M,N,F,X,IFLAG,NW,W,KEND,KEND2N)
- IFLAG=4
- NN=N+N
- K=NN
- DO 1 I=1,M
- K=K+1
- W(K)=F(I)
- 1 CONTINUE
- IINV=2
- K=KST
- I=1
- 2 X(I)=X(I)+E(I)
- CALL FCN1(M,N,F,X,IFLAG,NW,W,KEND,KEND2N)
- X(I)=X(I)-E(I)
- DO 3 J=1,N
- K=K+1
- W(K)=0.
- W(J)=0.
- 3 CONTINUE
- SUM=0.
- KK=NN
- DO 4 J=1,M
- KK=KK+1
- F(J)=F(J)-W(KK)
- SUM=SUM+F(J)*F(J)
- 4 CONTINUE
- IF (SUM) 5,5,6
- 5 WRITE(6,7)I
- 7 FORMAT(5X,'E(',I3,') UNREASONABLY SMALL')
- RETURN
- 6 SUM=1./SQRT (SUM)
- J=K-N+I
- W(J)=E(I)*SUM
- DO 9 J=1,M
- K=K+1
- W(K)=F(J)*SUM
- KK=NN+J
- DO 11 II=1,I
- KK=KK+MPLUSN
- W(II)=W(II)+W(KK)*W(K)
- 11 CONTINUE
- 9 CONTINUE
- ILESS=I-1
- IGAMAX=N+I-1
- INCINV=N-ILESS
- INCINP=INCINV+1
- IF (ILESS) 13,13,14
- 13 W(KINV)=1.
- GO TO 15
- 14 B=1.
- DO 16 J=NPLUS,IGAMAX
- W(J)=0.
- 16 CONTINUE
- KK=KINV
- DO 17 II=1,ILESS
- IIP=II+N
- W(IIP)=W(IIP)+W(KK)*W(II)
- JL=II+1
- IF (JL-ILESS) 18,18,19
- 18 DO 20 JJ=JL,ILESS
- KK=KK+1
- JJP=JJ+N
- W(IIP)=W(IIP)+W(KK)*W(JJ)
- W(JJP)=W(JJP)+W(KK)*W(II)
- 20 CONTINUE
- 19 B=B-W(II)*W(IIP)
- KK=KK+INCINP
- 17 CONTINUE
- B=1./B
- KK=KINV
- DO 21 II=NPLUS,IGAMAX
- BB=-B*W(II)
- DO 22 JJ=II,IGAMAX
- W(KK)=W(KK)-BB*W(JJ)
- KK=KK+1
- 22 CONTINUE
- W(KK)=BB
- KK=KK+INCINV
- 21 CONTINUE
- W(KK)=B
- 15 GO TO (27,24),IINV
- 24 I=I+1
- IF (I-N) 2,2,25
- 25 IINV=1
- FF=0.
- KL=NN
- DO 26 I=1,M
- KL=KL+1
- F(I)=W(KL)
- FF=FF+F(I)*F(I)
- 26 CONTINUE
- ICONT = 1
- ISS=1
- MC=N+1
- IPP=IPRINT*(IPRINT-1)
- ITC=0
- IPS=1
- IPC=0
- 27 IPC=IPC-IPRINT
- IF (IPC) 28,29,29
- 28 WRITE(6,30)ITC,MC,FF
- 30 FORMAT(//5X,'ITERATION',I4,I9,' CALLS OF FCN ',5X,'F=',E24.14)
- WRITE(6,31)(X(I),I=1,N)
- 31 FORMAT(5X,'VARIABLES',/(5E24.14))
- WRITE(6,32)(F(I),I=1,M)
- 32 FORMAT(5X,'FUNCTIONS',/(5E24.14))
- IPC=IPP
- GO TO (29,33),IPS
- 29 GO TO (34,35),ICONT
- 35 IF (CHANGE-1.) 10,10,36
- 10 CONTINUE
-C*UL 37 WRITE(6,38)
- WRITE(6,38)
- 38 FORMAT(//5X,' FINAL VALUES OF FUNCTIONS AND VARIABLES')
- IPS=2
- GO TO 28
- 33 IFLAG=3
- CALL FCN1(M,N,F,X,IFLAG,NW,W,KEND,KEND2N)
- IF(COV.EQ.0.) RETURN
- IWC1 = 2*N+N*(N+M)
- IWC=IWC1
- DO 91 I=1,N
- DO 91 J=1,I
- IWC=IWC+1
- W(IWC)=0.
- DO 90 MR=1,N
- JCOV=N+J+MR*(N+M)
- ICOV=N+I+MR*(N+M)
- 90 W(IWC)=W(IWC)+W(ICOV)*W(JCOV)
- 91 CONTINUE
- WRITE(6,1000)
- 1000 FORMAT(///40X,'VARIANCE-COVARIANCE MATRIX'///)
- IB=IWC1
- DO 92 I=1,N
- IA=IB+1
- IB=IB+I
- 92 WRITE(6,1001)(W(J),J=IA,IB)
- 1001 FORMAT(10X,5G20.6//)
- RETURN
- 36 ICONT=1
- 34 ITC=ITC+1
- K=N
- KK=KST
- DO 39 I=1,N
- K=K+1
- W(K)=0.
- KK=KK+N
- W(I)=0.
- DO 40 J=1,M
- KK=KK+1
- W(I)=W(I)+W(KK)*F(J)
- 40 CONTINUE
- 39 CONTINUE
- DM=0.
- K=KINV
- DO 41 II=1,N
- IIP=II+N
- W(IIP)=W(IIP)+W(K)*W(II)
- JL=II+1
- IF (JL-N) 42,42,43
- 42 DO 44 JJ=JL,N
- JJP=JJ+N
- K=K+1
- W(IIP)=W(IIP)+W(K)*W(JJ)
- W(JJP)=W(JJP)+W(K)*W(II)
- 44 CONTINUE
- K=K+1
- 43 IF (DM-ABS (W(II)*W(IIP))) 45,41,41
- 45 DM=ABS (W(II)*W(IIP))
- KL=II
- 41 CONTINUE
- II=N+MPLUSN*KL
- CHANGE=0.
- DO 46 I=1,N
- JL=N+I
- W(I)=0.
- DO 47 J=NPLUS,NN
- JL=JL+MPLUSN
- W(I)=W(I)+W(J)*W(JL)
- 47 CONTINUE
- II=II+1
- W(II)=W(JL)
- W(JL)=X(I)
- IF (ABS (E(I)*CHANGE)-ABS (W(I))) 48,48,46
- 48 CHANGE=ABS (W(I)/E(I))
- 46 CONTINUE
- DO 49 I=1,M
- II=II+1
- JL=JL+1
- W(II)=W(JL)
- W(JL)=F(I)
- 49 CONTINUE
- FC=FF
- ACC=0.1/CHANGE
- IT=3
- XC=0.
- XL=0.
- IS=3
- IF (CHANGE-1.) 50,50,51
- 50 ICONT=2
- 51 CALL VD01A (IT,XC,FC,20,ACC,0.1,XSTEP)
- GO TO (52,53,53,53),IT
- 52 MC=MC+1
- IF (MC-MAXFUN) 54,54,55
- 55 WRITE(6,56)MAXFUN
- 56 FORMAT(5X,I6,' CALLS OF FCN')
- ISS=2
- GO TO 53
- 54 XL=XC-XL
- DO 57 J=1,N
- X(J)=X(J)+XL*W(J)
- 57 CONTINUE
- XL=XC
- CALL FCN1(M,N,F,X,IFLAG,NW,W,KEND,KEND2N)
- FC=0.
- DO 58 J=1,M
- FC=FC+F(J)*F(J)
- 58 CONTINUE
- GO TO (59,59,60),IS
- 60 K=N
- IF (FC-FF) 61,51,62
- 61 IS=2
- FMIN=FC
- FSEC=FF
- GO TO 63
- 62 IS=1
- FMIN=FF
- FSEC=FC
- GO TO 63
- 59 IF (FC-FSEC) 64,51,51
- 64 K=KSTORE
- GO TO (75,74),IS
- 75 K=N
- 74 IF (FC-FMIN) 65,51,66
- 66 FSEC=FC
- GO TO 63
- 65 IS=3-IS
- FSEC=FMIN
- FMIN=FC
- 63 DO 67 J=1,N
- K=K+1
- W(K)=X(J)
- 67 CONTINUE
- DO 68 J=1,M
- K=K+1
- W(K)=F(J)
- 68 CONTINUE
- GO TO 51
- 53 K=KSTORE
- KK=N
- GO TO (69,70,69),IS
- 70 K=N
- KK=KSTORE
- 69 SUM=0.
- DM=0.
- JJ=KSTORE
- DO 71 J=1,N
- K=K+1
- KK=KK+1
- JJ=JJ+1
- X(J)=W(K)
- W(JJ)=W(K)-W(KK)
- 71 CONTINUE
- DO 72 J=1,M
- K=K+1
- KK=KK+1
- JJ=JJ+1
- F(J)=W(K)
- W(JJ)=W(K)-W(KK)
- SUM=SUM+W(JJ)*W(JJ)
- DM=DM+F(J)*W(JJ)
- 72 CONTINUE
- GO TO (73,10),ISS
- 73 J=KINV
- KK=NPLUS-KL
- DO 76 I=1,KL
- K=J+KL-I
- J=K+KK
- W(I)=W(K)
- W(K)=W(J-1)
- 76 CONTINUE
- IF (KL-N) 77,78,78
- 77 KL=KL+1
- JJ=K
- DO 79 I=KL,N
- K=K+1
- J=J+NPLUS-I
- W(I)=W(K)
- W(K)=W(J-1)
- 79 CONTINUE
- W(JJ)=W(K)
- B=1./W(KL-1)
- W(KL-1)=W(N)
- GO TO 88
- 78 B=1./W(N)
- 88 K=KINV
- DO 80 I=1,ILESS
- BB=B*W(I)
- DO 81 J=I,ILESS
- W(K)=W(K)-BB*W(J)
- K=K+1
- 81 CONTINUE
- K=K+1
- 80 CONTINUE
- IF (FMIN-FF) 82,83,83
- 83 CHANGE=0.
- GO TO 84
- 82 FF=FMIN
- CHANGE=ABS (XC)*CHANGE
- 84 XL=-DM/FMIN
- SUM=1./SQRT (SUM+DM*XL)
- K=KSTORE
- DO 85 I=1,N
- K=K+1
- W(K)=SUM*W(K)
- W(I)=0.
- 85 CONTINUE
- DO 86 I=1,M
- K=K+1
- W(K)=SUM*(W(K)+XL*F(I))
- KK=NN+I
- DO 87 J=1,N
- KK=KK+MPLUSN
- W(J)=W(J)+W(KK)*W(K)
- 87 CONTINUE
- 86 CONTINUE
- GO TO 14
- END
diff --git a/src/mathlib/gen/d/monito.F b/src/mathlib/gen/d/monito.F
deleted file mode 100644
index 47296a1..0000000
--- a/src/mathlib/gen/d/monito.F
+++ /dev/null
@@ -1,72 +0,0 @@
-*
-* $Id: monito.F,v 1.1.1.1 1996/04/01 15:02:21 mclareni Exp $
-*
-* $Log: monito.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:21 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE MONITO (S,M,NN3,IT,EPS,GT,AKAPPA,ALAMBD)
-C-----ITERATION PROGRESS OUTPUT
-#include "d510pl.inc"
-#include "d510si.inc"
-#include "d510ui.inc"
-#include "d510uo.inc"
- IF (IT) 11,3,1
- 1 IF (NN3) 4,4,2
- 2 IF (NM) 3,4,4
- 3 IF (ENDFLG) 4,12,4
-C-----PRINTER CARRIAGE CONTROL
- 4 I1=6
- IF (M.GT.6) I1=5
- IF (M.GT.12) I1=4
- IF (M.GT.23) I1=1
-#if !defined(CERNLIB_CDC)
-C NON-ANSI CARRIAGE CONTROL SUPPRESSED ON IBM
- IF(I1.GT.1) I1=0
-#endif
- WRITE(6,19) I1,NN3,S,GT,AKAPPA,ALAMBD
- DO 10 I=1,M
- IF (PL0(I)) 9,9,5
- 5 IF (PL (I)) 8,7,6
- 6 CONTINUE
- WRITE(6,20) I,A(I),SIGMA(I),R(I)
- GO TO 10
- 7 WRITE(6,21) I,A(I),SIGMA(I),R(I)
- GO TO 10
- 8 IF (PL(I).GE.-1.) GO TO 7
- WRITE(6,22) I,A(I)
- GO TO 10
- 9 WRITE(6,23) I,A(I)
- 10 CONTINUE
- 11 NM=-IT
- 12 NM=NM+1
- IF (ENDFLG) 13,14,14
- 13 I=-ENDFLG
- GO TO (15,16,17,18), I
- 14 RETURN
- 15 IF(IT.GE.0) WRITE(6,24)
- GO TO 14
- 16 IF(IT.GE.0) WRITE(6,25)
- GO TO 14
- 17 IF(IT.GE.0) WRITE(6,26)
- GO TO 14
- 18 IF(IT.GE.0) WRITE(6,27)
- GO TO 14
-C
- 19 FORMAT(I1,'ITERATION NO.',I3,', S= ',E12.5,', EC = ',E12.5,
- +', KAPPA= ',E12.5,', LAMBDA= ',E12.5//1X,2(6X,'PARAMETER'),
- +9X,'STANDARD',8X,'CORRELATION'/9X,'NUMBER',9X,'VALUE',11X,
- +'DEVIATION',9X,'FACTOR'/)
- 20 FORMAT(9X,I3,4X,3(5X,E12.5))
- 21 FORMAT(9X,I3,4X,3(5X,E12.5),' PARAMETER ON BOUNDARY')
- 22 FORMAT(9X,I3,9X,E12.5,5X,'INFINITE ERROR ESTIMATED')
- 23 FORMAT(9X,I3,9X,E12.5,5X,'THIS PARAMETER FIXED')
- 24 FORMAT('0MINIMISATION TERMINATED: NO FURTHER DECREASE IN S',
- + ' IS OBTAINABLE'/'1')
- 25 FORMAT('0MINIMISATION TERMINATED: INFINITE ERRORS ESTIMATED'/'1')
- 26 FORMAT('0MINIMISATION TERMINATED: ITERATION LIMIT REACHED'/'1')
- 27 FORMAT('0MINIMISATION TERMINATED: NEGATIVE OR ZERO Y ENCOUNTERED',
- + ' AS LOGARITHMIC ARGUMENT',/'1')
- END
diff --git a/src/mathlib/gen/d/newro.F b/src/mathlib/gen/d/newro.F
deleted file mode 100644
index ff7b647..0000000
--- a/src/mathlib/gen/d/newro.F
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: newro.F,v 1.1.1.1 1996/04/01 15:02:19 mclareni Exp $
-*
-* $Log: newro.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:19 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE NEWRO(M1,N,IBCX,DELTAX,POT,POTW,POTE,POTS,POTN)
- DIMENSION POT(M1,N)
- DIMENSION POTW(N),POTE(N),POTS(M1),POTN(M1)
- M=M1-1
- COEFX=2.*DELTAX
- GO TO (100,200,300,400),IBCX
- 100 RETURN
- 200 DO 1 J=1,N
- POT(1,J)=POT(1,J)+COEFX*POTW(J)
- 1 POT(M1,J)=POT(M1,J)-COEFX*POTE(J)
- RETURN
- 300 DO 2 J=1,N
- POT(1,J)=POTW(J)
- POT(M1,J)=POTE(J)
- POT(2,J)=POT(2,J)-POTW(J)
- 2 POT(M,J)=POT(M,J)-POTE(J)
- RETURN
- 400 DO 3 J=1,N
- POT(1,J)=POTW(J)
- POT(2,J)=POT(2,J)-POTW(J)
- 3 POT(M1,J)=POT(M1,J)-COEFX*POTE(J)
- RETURN
- END
diff --git a/src/mathlib/gen/d/old506.F b/src/mathlib/gen/d/old506.F
deleted file mode 100644
index 310c717..0000000
--- a/src/mathlib/gen/d/old506.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: old506.F,v 1.1.1.1 1996/04/01 15:02:20 mclareni Exp $
-*
-* $Log: old506.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:20 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE MINNEW
-C
- ENTRY MINTS
- ENTRY MINTL
- ENTRY MINTSD
- ENTRY MINTLD
-C
- EXTERNAL FCN
-C
- CALL MINUIT(FCN,0)
- RETURN
- END
diff --git a/src/mathlib/gen/d/radapt.F b/src/mathlib/gen/d/radapt.F
deleted file mode 100644
index a8a7e3a..0000000
--- a/src/mathlib/gen/d/radapt.F
+++ /dev/null
@@ -1,95 +0,0 @@
-*
-* $Id: radapt.F,v 1.1.1.1 1996/04/01 15:02:13 mclareni Exp $
-*
-* $Log: radapt.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:13 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE RADAPT(F,A,B,NSEG,RELTOL,ABSTOL,RES,ERR)
-
-C RES = Estimated Integral of F from A to B,
-C ERR = Estimated absolute error on RES.
-C NSEG specifies how the adaptation is to be done:
-C =0 means use previous binning,
-C =1 means fully automatic, adapt until tolerance attained.
-C =n>1 means first split interval into n equal segments,
-C then adapt as necessary to attain tolerance.
-C The specified tolerances are:
-C relative: RELTOL ; absolute: ABSTOL.
-C It stops when one OR the other is satisfied, or number of
-C segments exceeds NDIM. Either TOLA or TOLR (but not both!)
-C can be set to zero, in which case only the other is used.
-
- DOUBLE PRECISION TVALS,TERSS
- EXTERNAL F
-
- PARAMETER (NDIM=100)
- PARAMETER (R1 = 1, HF = R1/2)
-
- DIMENSION XLO(NDIM),XHI(NDIM),TVAL(NDIM),TERS(NDIM)
- SAVE XLO,XHI,TVAL,TERS,NTER
- DATA NTER /0/
-
- IF(NSEG .LE. 0) THEN
- IF(NTER .EQ. 0) THEN
- NSEGD=1
- GO TO 2
- ENDIF
- TVALS=0
- TERSS=0
- DO 1 I = 1,NTER
- CALL RGS56P(F,XLO(I),XHI(I),TVAL(I),TE)
- TERS(I)=TE**2
- TVALS=TVALS+TVAL(I)
- TERSS=TERSS+TERS(I)
- 1 CONTINUE
- ROOT= SQRT(2*TERSS)
- GO TO 9
- ENDIF
- NSEGD=MIN(NSEG,NDIM)
- 2 XHIB=A
- BIN=(B-A)/NSEGD
- DO 3 I = 1,NSEGD
- XLO(I)=XHIB
- XLOB=XLO(I)
- XHI(I)=XHIB+BIN
- IF(I .EQ. NSEGD) XHI(I)=B
- XHIB=XHI(I)
- CALL RGS56P(F,XLOB,XHIB,TVAL(I),TE)
- TERS(I)=TE**2
- 3 CONTINUE
- NTER=NSEGD
- DO 4 ITER = 1,NDIM
- TVALS=TVAL(1)
- TERSS=TERS(1)
- DO 5 I = 2,NTER
- TVALS=TVALS+TVAL(I)
- TERSS=TERSS+TERS(I)
- 5 CONTINUE
- ROOT= SQRT(2*TERSS)
- IF(ROOT .LE. ABSTOL .OR. ROOT .LE. RELTOL*ABS(TVALS)) GO TO 9
- IF(NTER .EQ. NDIM) GO TO 9
- BIGE=TERS(1)
- IBIG=1
- DO 6 I = 2,NTER
- IF(TERS(I) .GT. BIGE) THEN
- BIGE=TERS(I)
- IBIG=I
- ENDIF
- 6 CONTINUE
- NTER=NTER+1
- XHI(NTER)=XHI(IBIG)
- XNEW=HF*(XLO(IBIG)+XHI(IBIG))
- XHI(IBIG)=XNEW
- XLO(NTER)=XNEW
- CALL RGS56P(F,XLO(IBIG),XHI(IBIG),TVAL(IBIG),TE)
- TERS(IBIG)=TE**2
- CALL RGS56P(F,XLO(NTER),XHI(NTER),TVAL(NTER),TE)
- TERS(NTER)=TE**2
- 4 CONTINUE
- 9 RES=TVALS
- ERR=ROOT
- RETURN
- END
diff --git a/src/mathlib/gen/d/radmul.F b/src/mathlib/gen/d/radmul.F
deleted file mode 100644
index bb43778..0000000
--- a/src/mathlib/gen/d/radmul.F
+++ /dev/null
@@ -1,224 +0,0 @@
-*
-* $Id
-*
-* $Log
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- SUBROUTINE RADMUL
- 1 (F,N,A,B,MINPTS,MAXPTS,EPS,WK,IWK,RESULT,RELERR,NFNEVL,IFAIL)
- CHARACTER NAME*(*)
- PARAMETER (NAME = 'RADMUL')
- CALL MTLPRT(NAME,'D120',
- +'not available on this machine - see documentation')
- RETURN
- END
-
- SUBROUTINE DADMUL
- 1 (F,N,A,B,MINPTS,MAXPTS,EPS,WK,IWK,RESULT,RELERR,NFNEVL,IFAIL)
-#include "gen/imp64.inc"
-
-#else
- SUBROUTINE DADMUL
- 1 (F,N,A,B,MINPTS,MAXPTS,EPS,WK,IWK,RESULT,RELERR,NFNEVL,IFAIL)
-#include "gen/imp128.inc"
- CHARACTER NAME*(*)
- PARAMETER (NAME = 'DADMUL')
- CALL MTLPRT(NAME,'D120',
- +'not available on this machine - see documentation')
- RETURN
- END
-
- SUBROUTINE RADMUL
- 1 (F,N,A,B,MINPTS,MAXPTS,EPS,WK,IWK,RESULT,RELERR,NFNEVL,IFAIL)
-#endif
-
- LOGICAL LDV
-
- DIMENSION A(*),B(*),WK(*)
- DIMENSION CTR(15),WTH(15),WTHL(15),Z(15)
- DIMENSION W(2:15,5),WP(2:15,3)
-
- PARAMETER (R1 = 1, HF = R1/2)
-
- PARAMETER (XL2 = 0.35856 85828 00318 073D0)
- PARAMETER (XL4 = 0.94868 32980 50513 796D0)
- PARAMETER (XL5 = 0.68824 72016 11685 289D0)
-
- PARAMETER (W2 = 980*R1/6561, W4 = 200*R1/19683)
- PARAMETER (WP2 = 245*R1/486, WP4 = 25*R1/729)
-
- DATA (W(N,1),W(N,3),N=2,15)
- 1/-0.193872885230909911D+00, 0.518213686937966768D-01,
- 2 -0.555606360818980835D+00, 0.314992633236803330D-01,
- 3 -0.876695625666819078D+00, 0.111771579535639891D-01,
- 4 -0.115714067977442459D+01, -0.914494741655235473D-02,
- 5 -0.139694152314179743D+01, -0.294670527866686986D-01,
- 6 -0.159609815576893754D+01, -0.497891581567850424D-01,
- 7 -0.175461057765584494D+01, -0.701112635269013768D-01,
- 8 -0.187247878880251983D+01, -0.904333688970177241D-01,
- 9 -0.194970278920896201D+01, -0.110755474267134071D+00,
- A -0.198628257887517146D+01, -0.131077579637250419D+00,
- B -0.198221815780114818D+01, -0.151399685007366752D+00,
- C -0.193750952598689219D+01, -0.171721790377483099D+00,
- D -0.185215668343240347D+01, -0.192043895747599447D+00,
- E -0.172615963013768225D+01, -0.212366001117715794D+00/
-
- DATA (W(N,5),W(N+1,5),N=2,14,2)
- 1/ 0.871183254585174982D-01, 0.435591627292587508D-01,
- 2 0.217795813646293754D-01, 0.108897906823146873D-01,
- 3 0.544489534115734364D-02, 0.272244767057867193D-02,
- 4 0.136122383528933596D-02, 0.680611917644667955D-03,
- 5 0.340305958822333977D-03, 0.170152979411166995D-03,
- 6 0.850764897055834977D-04, 0.425382448527917472D-04,
- 7 0.212691224263958736D-04, 0.106345612131979372D-04/
-
- DATA (WP(N,1),WP(N,3),N=2,15)
- 1/-0.133196159122085045D+01, 0.445816186556927292D-01,
- 2 -0.229218106995884763D+01, -0.240054869684499309D-01,
- 3 -0.311522633744855959D+01, -0.925925925925925875D-01,
- 4 -0.380109739368998611D+01, -0.161179698216735251D+00,
- 5 -0.434979423868312742D+01, -0.229766803840877915D+00,
- 6 -0.476131687242798352D+01, -0.298353909465020564D+00,
- 7 -0.503566529492455417D+01, -0.366941015089163228D+00,
- 8 -0.517283950617283939D+01, -0.435528120713305891D+00,
- 9 -0.517283950617283939D+01, -0.504115226337448555D+00,
- A -0.503566529492455417D+01, -0.572702331961591218D+00,
- B -0.476131687242798352D+01, -0.641289437585733882D+00,
- C -0.434979423868312742D+01, -0.709876543209876532D+00,
- D -0.380109739368998611D+01, -0.778463648834019195D+00,
- E -0.311522633744855959D+01, -0.847050754458161859D+00/
-
- RESULT=0
- ABSERR=0
- IFAIL=3
- IF(N .LT. 2 .OR. N .GT. 15) RETURN
- IF(MINPTS .GT. MAXPTS) RETURN
-
- IFNCLS=0
- LDV=.FALSE.
- TWONDM=2**N
- IRGNST=2*N+3
- IRLCLS=2**N+2*N*(N+1)+1
- ISBRGN=IRGNST
- ISBRGS=IRGNST
- IF(MAXPTS .LT. IRLCLS) RETURN
- DO 10 J = 1,N
- CTR(J)=(B(J)+A(J))*HF
- 10 WTH(J)=(B(J)-A(J))*HF
-
- 20 RGNVOL=TWONDM
- DO 30 J = 1,N
- RGNVOL=RGNVOL*WTH(J)
- 30 Z(J)=CTR(J)
- SUM1=F(N,Z)
-
- DIFMAX=0
- SUM2=0
- SUM3=0
- DO 40 J = 1,N
- Z(J)=CTR(J)-XL2*WTH(J)
- F2=F(N,Z)
- Z(J)=CTR(J)+XL2*WTH(J)
- F2=F2+F(N,Z)
- WTHL(J)=XL4*WTH(J)
- Z(J)=CTR(J)-WTHL(J)
- F3=F(N,Z)
- Z(J)=CTR(J)+WTHL(J)
- F3=F3+F(N,Z)
- SUM2=SUM2+F2
- SUM3=SUM3+F3
- DIF=ABS(7*F2-F3-12*SUM1)
- DIFMAX=MAX(DIF,DIFMAX)
- IF(DIFMAX .EQ. DIF) IDVAXN=J
- 40 Z(J)=CTR(J)
-
- SUM4=0
- DO 70 J = 2,N
- J1=J-1
- DO 60 K = J,N
- DO 50 L = 1,2
- WTHL(J1)=-WTHL(J1)
- Z(J1)=CTR(J1)+WTHL(J1)
- DO 50 M = 1,2
- WTHL(K)=-WTHL(K)
- Z(K)=CTR(K)+WTHL(K)
- 50 SUM4=SUM4+F(N,Z)
- 60 Z(K)=CTR(K)
- 70 Z(J1)=CTR(J1)
-
- SUM5=0
- DO 80 J = 1,N
- WTHL(J)=-XL5*WTH(J)
- 80 Z(J)=CTR(J)+WTHL(J)
- 90 SUM5=SUM5+F(N,Z)
- DO 100 J = 1,N
- WTHL(J)=-WTHL(J)
- Z(J)=CTR(J)+WTHL(J)
- IF(WTHL(J) .GT. 0) GO TO 90
- 100 CONTINUE
-
- RGNCMP=RGNVOL*(WP(N,1)*SUM1+WP2*SUM2+WP(N,3)*SUM3+WP4*SUM4)
- RGNVAL=W(N,1)*SUM1+W2*SUM2+W(N,3)*SUM3+W4*SUM4+W(N,5)*SUM5
- RGNVAL=RGNVOL*RGNVAL
- RGNERR=ABS(RGNVAL-RGNCMP)
- RESULT=RESULT+RGNVAL
- ABSERR=ABSERR+RGNERR
- IFNCLS=IFNCLS+IRLCLS
-
- IF(LDV) THEN
- 110 ISBTMP=2*ISBRGN
- IF(ISBTMP .GT. ISBRGS) GO TO 160
- IF(ISBTMP .LT. ISBRGS) THEN
- ISBTPP=ISBTMP+IRGNST
- IF(WK(ISBTMP) .LT. WK(ISBTPP)) ISBTMP=ISBTPP
- ENDIF
- IF(RGNERR .GE. WK(ISBTMP)) GO TO 160
- DO 130 K = 0,IRGNST-1
- 130 WK(ISBRGN-K)=WK(ISBTMP-K)
- ISBRGN=ISBTMP
- GO TO 110
- ENDIF
- 140 ISBTMP=(ISBRGN/(2*IRGNST))*IRGNST
- IF(ISBTMP .GE. IRGNST .AND. RGNERR .GT. WK(ISBTMP)) THEN
- DO 150 K = 0,IRGNST-1
- 150 WK(ISBRGN-K)=WK(ISBTMP-K)
- ISBRGN=ISBTMP
- GO TO 140
- ENDIF
-
- 160 WK(ISBRGN)=RGNERR
- WK(ISBRGN-1)=RGNVAL
- WK(ISBRGN-2)=IDVAXN
- DO 170 J = 1,N
- ISBTMP=ISBRGN-2*J-2
- WK(ISBTMP+1)=CTR(J)
- 170 WK(ISBTMP)=WTH(J)
- IF(LDV) THEN
- LDV=.FALSE.
- CTR(IDVAX0)=CTR(IDVAX0)+2*WTH(IDVAX0)
- ISBRGS=ISBRGS+IRGNST
- ISBRGN=ISBRGS
- GO TO 20
- ENDIF
- RELERR=ABSERR/ABS(RESULT)
- IF(ISBRGS+IRGNST .GT. IWK) IFAIL=2
- IF(IFNCLS+2*IRLCLS .GT. MAXPTS) IFAIL=1
- IF(RELERR .LT. EPS .AND. IFNCLS .GE. MINPTS) IFAIL=0
- IF(IFAIL .EQ. 3) THEN
- LDV=.TRUE.
- ISBRGN=IRGNST
- ABSERR=ABSERR-WK(ISBRGN)
- RESULT=RESULT-WK(ISBRGN-1)
- IDVAX0=WK(ISBRGN-2)
- DO 190 J = 1,N
- ISBTMP=ISBRGN-2*J-2
- CTR(J)=WK(ISBTMP+1)
- 190 WTH(J)=WK(ISBTMP)
- WTH(IDVAX0)=HF*WTH(IDVAX0)
- CTR(IDVAX0)=CTR(IDVAX0)-WTH(IDVAX0)
- GO TO 20
- ENDIF
- NFNEVL=IFNCLS
- RETURN
- END
diff --git a/src/mathlib/gen/d/rca.F b/src/mathlib/gen/d/rca.F
deleted file mode 100644
index 27a60eb..0000000
--- a/src/mathlib/gen/d/rca.F
+++ /dev/null
@@ -1,143 +0,0 @@
-*
-* $Id: rca.F,v 1.1.1.1 1996/04/01 15:02:22 mclareni Exp $
-*
-* $Log: rca.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:22 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE RCA (MM, X, IX, Y, IY)
-C ANALYSIS OR SYNTHESIS OF A REAL EVEN FUNCTION.
-C
- REAL X(128), Y(128)
- COMMON /D700DT/ N, N2, N4, M, F, RTTWO
- COMMON /FWORK/ W(321)
- DATA MLOC / - 1 /
-C
- M = MM + 1
- IF(M .NE. MLOC) CALL D700SU
- MLOC = M
-C
- NI = N4
- NO = N4 + N2 + 1
-C
- KX = 1
- NFWA = NI
- NLWA = NI + N2
- DO 10 I = NFWA, NLWA
- W(I) = X(KX)
- 10 KX = KX + IX
-C
- NQ = N2
- DO 170 L = 1, M
- NQ2 = NQ / 2
- NQ2M1 = NQ2 - 1
-C
- NO1 = NO
- NO2 = NO + N2
- NI1 = NI
- NI2 = NI + NQ
- W(NO1) = W(NI1) + W(NI2)
- W(NO2) = W(NI1) - W(NI2)
-C
- IF(NQ2M1) 50, 40, 20
-C
- 20 DO 30 IT = 1, NQ2M1
- NOR1 = NO1 + IT
- NOR2 = NO1 + NQ2 + IT
- NIR1 = NI1 + IT
- NIR2 = NI2 - IT
- W(NOR1) = W(NIR1) + W(NIR2)
- W(NOR2) = W(NIR1) - W(NIR2)
- 30 CONTINUE
-C
- 40 NOR1 = NO1 + NQ2
- NIR1 = NI1 + NQ2
- W(NOR1) = W(NIR1) + W(NIR1)
-C
- 50 NO1 = NO1 + NQ
- NO2 = NO2 - NQ
- NI1 = NI2 + NQ
- NI2 = NI1 + NQ
- IF(NO1 - NO2) 60, 120, 160
-C
- 60 NC = 0
- NS = N4
- KC = 0
- KS = N4
-C
- 70 CONTINUE
- W(NO1) = W(NI1) + W(NI2)
- W(NO2) = W(NI1) - W(NI2)
-C
- IF(NQ2M1) 110, 100, 80
-C
- 80 NC = NC + NQ
- NS = NS - NQ
- CC = W(NC)
- SS = W(NS)
- DO 90 IT = 1, NQ2M1
- NOR1 = NO1 + IT
- NOR2 = NO2 + IT
- NIR1 = NI1 + IT
- NIR2 = NI2 - IT
- NOI1 = NOR1 + NQ2
- NOI2 = NOR2 + NQ2
- NII1 = NIR1 + NQ
- NII2 = NIR2 + NQ
- RE = CC * W(NIR2) - SS * W(NII2)
- AI = SS * W(NIR2) + CC * W(NII2)
- W(NOR1) = W(NIR1) + RE
- W(NOR2) = W(NIR1) - RE
- W(NOI1) = + W(NII1) - AI
- W(NOI2) = - W(NII1) - AI
- 90 CONTINUE
-C
- 100 KC = KC + NQ2
- KS = KS - NQ2
- NOR1 = NO1 + NQ2
- NOR2 = NO2 + NQ2
- NIR1 = NI1 + NQ2
- NIR2 = NI2 + NQ2
- W(NOR1) = 2.0 * (W(KC) * W(NIR1) - W(KS) * W(NIR2))
- W(NOR2) = 2.0 * (W(KS) * W(NIR1) + W(KC) * W(NIR2))
-C
- 110 NO1 = NO1 + NQ
- NO2 = NO2 - NQ
- NI1 = NI2 + NQ
- NI2 = NI1 + NQ
- IF(NO1 - NO2) 70, 120, 160
-C
- 120 W(NO1) = W(NI1)
-C
- IF(NQ2M1) 160, 150, 130
-C
- 130 DO 140 IT = 1, NQ2M1
- NOR1 = NO1 + IT
- NOI1 = NOR1 + NQ2
- NIR1 = NI + NQ + IT
- NIR2 = NI + NQ + NQ - IT
- W(NOR1) = + W(NIR1)
- W(NOI1) = - W(NIR2)
- 140 CONTINUE
-C
- 150 NOR1 = NO1 + NQ2
- NIR1 = NI + NQ + NQ2
- W(NOR1) = RTTWO * W(NIR1)
-C
- 160 NT = NI
- NI = NO
- NO = NT
- NQ = NQ2
- 170 CONTINUE
-C
- KY = 1
- NFWA = NI
- NLWA = NI + N2
- DO 180 I = NFWA, NLWA
- Y(KY) = W(I) * F
- 180 KY = KY + IY
-C
- RETURN
- END
diff --git a/src/mathlib/gen/d/rcauch.F b/src/mathlib/gen/d/rcauch.F
deleted file mode 100644
index 52dc5b5..0000000
--- a/src/mathlib/gen/d/rcauch.F
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: rcauch.F,v 1.1.1.1 1996/04/01 15:02:14 mclareni Exp $
-*
-* $Log: rcauch.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:14 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- FUNCTION RCAUCH(F,A,B,S,EPS)
-C
- CHARACTER NAME*6
- NAME = 'RCAUCH'
- CALL MTLPRT(NAME,'D104.0','Not available on this machine')
- RCAUCH=0
- RETURN
-
- ENTRY CAUCHY(F,A,B,S,EPS)
- NAME = 'CAUCHY'
- CALL MTLPRT(NAME,'D104.0','Not available on this machine')
- CAUCHY=0
- END
-#endif
diff --git a/src/mathlib/gen/d/rdeqbs.F b/src/mathlib/gen/d/rdeqbs.F
deleted file mode 100644
index 8aa1fd6..0000000
--- a/src/mathlib/gen/d/rdeqbs.F
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: rdeqbs.F,v 1.1.1.1 1996/04/01 15:02:17 mclareni Exp $
-*
-* $Log: rdeqbs.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:17 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- SUBROUTINE RDEQBS(N,XA,XZ,Y,H0,EPS,SUB,W)
-C
- CHARACTER NAME*6
- NAME = 'RDEQBS'
- CALL MTLPRT(NAME,'C201.0','Not available on this machine')
- RETURN
-
- ENTRY DEQBS(N,XA,XZ,Y,H0,EPS,SUB,W)
- NAME = 'DEQBS'
- CALL MTLPRT(NAME,'C201.0','Not available on this machine')
- END
-#endif
diff --git a/src/mathlib/gen/d/rdeqmr.F b/src/mathlib/gen/d/rdeqmr.F
deleted file mode 100644
index 0d72cde..0000000
--- a/src/mathlib/gen/d/rdeqmr.F
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: rdeqmr.F,v 1.1.1.1 1996/04/01 15:02:17 mclareni Exp $
-*
-* $Log: rdeqmr.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:17 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- SUBROUTINE RDEQMR(N,XA,XZ,Y,H0,EPS,SUB,W)
-C
- CHARACTER NAME*6
- NAME = 'RDEQMR'
- CALL MTLPRT(NAME,'C202.0','Not available on this machine')
- RETURN
-
- ENTRY DEQMR(N,XA,XZ,Y,H0,EPS,SUB,W)
- NAME = 'DEQMR'
- CALL MTLPRT(NAME,'C202.0','Not available on this machine')
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/d/rderiv.F b/src/mathlib/gen/d/rderiv.F
deleted file mode 100644
index 74a5a72..0000000
--- a/src/mathlib/gen/d/rderiv.F
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: rderiv.F,v 1.1.1.1 1996/04/01 15:02:19 mclareni Exp $
-*
-* $Log: rderiv.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:19 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- SUBROUTINE RDERIV(F,X,DELTA,DFDX,RERR)
-C
- CHARACTER NAME*(*)
- PARAMETER (NAME = 'RDERIV')
- ENTRY DERIV(F,X,DELTA,DFDX,RERR)
- CALL MTLPRT(NAME,'C401.0','Not available on this machine')
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/d/rfrdh1.F b/src/mathlib/gen/d/rfrdh1.F
deleted file mode 100644
index 0c32d24..0000000
--- a/src/mathlib/gen/d/rfrdh1.F
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: rfrdh1.F,v 1.1.1.1 1996/04/01 15:02:22 mclareni Exp $
-*
-* $Log: rfrdh1.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:22 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- SUBROUTINE RFRDH1(F,G,M,TV,NGTV,WS,IDIM,N)
-C
- CALL MTLPRT('RFRDH1','D601.0','Not available on this machine')
- RETURN
-C
- ENTRY RFRDH2(F,G,X,WS,IDIM,N)
- CALL MTLPRT('RFRDH2','D601.0','Not available on this machine')
- RETURN
-C
- ENTRY RFRDH3(H,WS,IDIM,N)
- CALL MTLPRT('RFRDH3','D601.0','Not available on this machine')
- RETURN
-C
- END
-#endif
diff --git a/src/mathlib/gen/d/rfrdh128.F b/src/mathlib/gen/d/rfrdh128.F
deleted file mode 100644
index ba53cd7..0000000
--- a/src/mathlib/gen/d/rfrdh128.F
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: rfrdh128.F,v 1.1.1.1 1996/04/01 15:02:22 mclareni Exp $
-*
-* $Log: rfrdh128.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:22 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if !defined(CERNLIB_DOUBLE)
- SUBROUTINE DFRDH1(F,G,M,TV,NGTV,WS,IDIM,N)
-C
-#include "gen/imp128.inc"
-C
- CALL MTLPRT('DFRDH1','D601.0','Not available on this machine')
- RETURN
-C
- ENTRY DFRDH2(F,G,X,WS,IDIM,N)
- CALL MTLPRT('DFRDH2','D601.0','Not available on this machine')
- RETURN
-C
- ENTRY DFRDH3(H,WS,IDIM,N)
- CALL MTLPRT('DFRDH3','D601.0','Not available on this machine')
- RETURN
-C
- END
-#endif
diff --git a/src/mathlib/gen/d/rfrdh164.F b/src/mathlib/gen/d/rfrdh164.F
deleted file mode 100644
index 71563ce..0000000
--- a/src/mathlib/gen/d/rfrdh164.F
+++ /dev/null
@@ -1,57 +0,0 @@
-*
-* $Id: rfrdh164.F,v 1.1.1.1 1996/04/01 15:02:22 mclareni Exp $
-*
-* $Log: rfrdh164.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:22 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- SUBROUTINE DFRDH1(F,G,M,TV,NGTV,WS,IDIM,N)
-C
-#include "gen/imp64.inc"
-C
- CHARACTER*(*) NAME
- PARAMETER(NAME='DFRDH1')
-#endif
-#if !defined(CERNLIB_DOUBLE)
- SUBROUTINE RFRDH1(F,G,M,TV,NGTV,WS,IDIM,N)
-C
- CHARACTER*(*) NAME
- PARAMETER(NAME='RFRDH1')
-#endif
-C
- DIMENSION TV(0:*),NGTV(*),WS(IDIM,*)
- CHARACTER*80 ERRTXT
-
- N0=0
- DO 1 K = 1,M
- 1 N0=N0+NGTV(K)
- N1=1
- DO 2 K = 1,M
-#if defined(CERNLIB_DOUBLE)
- CALL DGSET(TV(K-1),TV(K),NGTV(K),WS(N1,N0+3),WS(N1,N0+4))
-#endif
-#if !defined(CERNLIB_DOUBLE)
- CALL RGSET(TV(K-1),TV(K),NGTV(K),WS(N1,N0+3),WS(N1,N0+4))
-#endif
- 2 N1=N1+NGTV(K)
-
- DO 3 I = 1,N0
- DO 4 J = 1,N0
- 4 WS(I,J)=-WS(J,N0+4)*G(WS(I,N0+3),WS(J,N0+3))
- WS(I,I)=1+WS(I,I)
- 3 WS(I,N0+1)=F(WS(I,N0+3))
-#if defined(CERNLIB_DOUBLE)
- CALL DEQN(N0,WS,IDIM,WS(1,N0+2),IFAIL,1,WS(1,N0+1))
-#endif
-#if !defined(CERNLIB_DOUBLE)
- CALL REQN(N0,WS,IDIM,WS(1,N0+2),IFAIL,1,WS(1,N0+1))
-#endif
- IF(IFAIL .EQ. -1) THEN
- CALL MTLPRT(NAME,'D601.1','MATRIX SINGULAR')
- ENDIF
- N=N0
- RETURN
- END
diff --git a/src/mathlib/gen/d/rfrdh264.F b/src/mathlib/gen/d/rfrdh264.F
deleted file mode 100644
index a45795f..0000000
--- a/src/mathlib/gen/d/rfrdh264.F
+++ /dev/null
@@ -1,49 +0,0 @@
-*
-* $Id: rfrdh264.F,v 1.1.1.1 1996/04/01 15:02:22 mclareni Exp $
-*
-* $Log: rfrdh264.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:22 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- FUNCTION DFRDH2(F,G,X,WS,IDIM,N)
-C
-#include "gen/imp64.inc"
-C
- CHARACTER*(*) NAME
- PARAMETER(NAME='DFRDH2')
-#endif
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION RFRDH2(F,G,X,WS,IDIM,N)
-C
- CHARACTER*(*) NAME
- PARAMETER(NAME='RFRDH2')
-#endif
-C
- DIMENSION WS(IDIM,*)
-
- SUM=F(X)
- DO 2 J = 1,N
- 2 SUM=SUM+WS(J,N+4)*G(X,WS(J,N+3))*WS(J,N+1)
- GO TO 9
-
-#if defined(CERNLIB_DOUBLE)
- ENTRY DFRDH3(H,WS,IDIM,N)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- ENTRY RFRDH3(H,WS,IDIM,N)
-#endif
-
- SUM=0
- DO 3 J = 1,N
- 3 SUM=SUM+WS(J,N+4)*H(WS(J,N+3))*WS(J,N+1)
-#if defined(CERNLIB_DOUBLE)
- 9 DFRDH2=SUM
-#endif
-#if !defined(CERNLIB_DOUBLE)
- 9 RFRDH2=SUM
-#endif
- RETURN
- END
diff --git a/src/mathlib/gen/d/rfstft.F b/src/mathlib/gen/d/rfstft.F
deleted file mode 100644
index 6bc55a7..0000000
--- a/src/mathlib/gen/d/rfstft.F
+++ /dev/null
@@ -1,43 +0,0 @@
-*
-* $Id: rfstft.F,v 1.1 1996/04/17 12:32:04 mclareni Exp $
-*
-* $Log: rfstft.F,v $
-* Revision 1.1 1996/04/17 12:32:04 mclareni
-* Add d/rfstft.F (D705) and to Imakefile. cfstft.F becomes D706.
-* In tests, add d705m.F for rfstft and d706m.F for cfstft and the corresponding
-* additions to main.F and Imakefile.
-*
-*
- SUBROUTINE RFSTFT(MS,A)
-
- COMPLEX A(0:*),T,T1,T2,U,W
-
- PARAMETER (PI = 3.14159 26535 89793D0)
-
- IF(MS .EQ. 0) THEN
- A(0)=REAL(A(0))
- RETURN
- ENDIF
- M=ABS(MS)-1
- N=2**M
- U=(0.,1.)
- IF(MS .LT. 0) THEN
- CALL CFSTFT(-M,A)
- F=0.25/N
- DO 1 I = 0,N-1
- 1 A(I)=F*A(I)
- A(N)=A(0)
- U=CONJG(U)
- ENDIF
- 2 PHI=PI/SIGN(N,MS)
- W=CMPLX(COS(PHI),SIN(PHI))
- DO 3 J = 0,N/2
- T=CONJG(A(N-J))
- T1=A(J)+T
- T2=(A(J)-T)*U
- A(J)=T1+T2
- A(N-J)=CONJG(T1-T2)
- 3 U=U*W
- IF(MS .GT. 0) CALL CFSTFT(M,A)
- RETURN
- END
diff --git a/src/mathlib/gen/d/rft.F b/src/mathlib/gen/d/rft.F
deleted file mode 100644
index fa3d22a..0000000
--- a/src/mathlib/gen/d/rft.F
+++ /dev/null
@@ -1,44 +0,0 @@
-*
-* $Id: rft.F,v 1.1.1.1 1996/04/01 15:02:22 mclareni Exp $
-*
-* $Log: rft.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:22 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE RFT (MM, X, IX, Y, IY, MODE)
-C EXECUTE REAL FAST FOURIER TRANSFORM.
-C
-C INPUT ... (X(I*IX+1), I = 0, N)
-C OUTPUT ... (Y(I*IY+1), I = 0, N)
-C MM ... INTEGER, SUCH THAT N = 2 ** MM.
-C MODE = 1 ... ANALYSIS OF A REAL PERIODIC FUNCTION.
-C MODE = 2 ... ANALYSIS OF A REAL EVEN FUNCTION.
-C MODE = 3 ... ANALYSIS OF A REAL ODD FUNCTION.
-C MODE = 4 ... SYNTHESIS OF A REAL PERIODIC FUNCTION.
-C MODE = 5 ... SYNTHESIS OF A REAL EVEN FUNCTION.
-C MODE = 6 ... SYNTHESIS OF A REAL ODD FUNCTION.
-C
- REAL X(128), Y(128)
- COMMON /D700DT/ N, N2, N4, M, F, RTTWO
- COMMON /FWORK/ W(321)
-C
- GO TO (10, 20, 30, 40, 20, 30), MODE
-C
-C ANALYSIS OF A REAL PERIODIC FUNCTION.
- 10 CALL RPA (MM, X, IX, Y, IY)
- RETURN
-C
-C ANALYSIS OR SYNTHESIS OF A REAL EVEN FUNCTION.
- 20 CALL RCA (MM, X, IX, Y, IY)
- RETURN
-C
-C ANALYSIS OR SYNTHESIS OF A REAL ODD FUNCTION.
- 30 CALL RSA (MM, X, IX, Y, IY)
- RETURN
-C
-C SYNTHESIS OF A REAL PERIODIC FUNCTION.
- 40 CALL RPS (MM, X, IX, Y, IY)
- RETURN
- END
diff --git a/src/mathlib/gen/d/rgmlt.F b/src/mathlib/gen/d/rgmlt.F
deleted file mode 100644
index e240fac..0000000
--- a/src/mathlib/gen/d/rgmlt.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: rgmlt.F,v 1.1.1.1 1996/04/01 15:02:15 mclareni Exp $
-*
-* $Log: rgmlt.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:15 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- FUNCTION RGMLT1(FSUB1,A,B,NI,NG,X)
-
- ENTRY RGMLT2(FSUB2,A,B,NI,NG,X)
- ENTRY RGMLT3(FSUB3,A,B,NI,NG,X)
- ENTRY RGMLT4(FSUB4,A,B,NI,NG,X)
- ENTRY RGMLT5(FSUB5,A,B,NI,NG,X)
- ENTRY RGMLT6(FSUB6,A,B,NI,NG,X)
-
-C
- CHARACTER NAME*(*)
- PARAMETER (NAME = 'RGMLT')
- CALL MTLPRT(NAME,'D110.0','Not available on this machine')
- RGMLT1=0
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/d/rgmlt128.F b/src/mathlib/gen/d/rgmlt128.F
deleted file mode 100644
index 45a32ad..0000000
--- a/src/mathlib/gen/d/rgmlt128.F
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: rgmlt128.F,v 1.1.1.1 1996/04/01 15:02:15 mclareni Exp $
-*
-* $Log: rgmlt128.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:15 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION DGMLT1(FSUB1,A,B,NI,NG,X)
-C
-#include "gen/imp128.inc"
-C
- CHARACTER NAME*(*)
- PARAMETER (NAME = 'DGMLT')
- DGMLT1=0
- ENTRY DGMLT2(FSUB2,A,B,NI,NG,X)
- DGMLT2=0
- ENTRY DGMLT3(FSUB3,A,B,NI,NG,X)
- DGMLT3=0
- ENTRY DGMLT4(FSUB4,A,B,NI,NG,X)
- DGMLT4=0
- ENTRY DGMLT5(FSUB5,A,B,NI,NG,X)
- DGMLT5=0
- ENTRY DGMLT6(FSUB6,A,B,NI,NG,X)
- DGMLT6=0
- CALL MTLPRT(NAME,'D110.0','Not available on this machine')
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/d/rgmlt64.F b/src/mathlib/gen/d/rgmlt64.F
deleted file mode 100644
index d8b0b16..0000000
--- a/src/mathlib/gen/d/rgmlt64.F
+++ /dev/null
@@ -1,454 +0,0 @@
-*
-* $Id: rgmlt64.F,v 1.1.1.1 1996/04/01 15:02:15 mclareni Exp $
-*
-* $Log: rgmlt64.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:15 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION RGMLT1(FSUB1,A,B,NI,NG,X)
-#endif
-#if defined(CERNLIB_DOUBLE)
- FUNCTION DGMLT1(FSUB1,A,B,NI,NG,X)
-#include "gen/imp64.inc"
-#endif
-
- CHARACTER NAME*(*)
- CHARACTER*80 ERRTXT
-#if !defined(CERNLIB_DOUBLE)
- PARAMETER (NAME = 'RGMLT1')
-#endif
-#if defined(CERNLIB_DOUBLE)
- PARAMETER (NAME = 'DGMLT1')
-#endif
- PARAMETER (Z1 = 1, HALF = Z1/2)
-
- DIMENSION X(6),W(14),T(14),V(64),U(64),F(64)
-
- DATA (T(I),W(I),I=1,14)
- 1/-0.93246 95142 03152 028D0, 0.17132 44923 79170 345D0,
- 2 -0.66120 93864 66264 514D0, 0.36076 15730 48138 608D0,
- 3 -0.23861 91860 83196 909D0, 0.46791 39345 72691 047D0,
- 4 0.23861 91860 83196 909D0, 0.46791 39345 72691 047D0,
- 5 0.66120 93864 66264 514D0, 0.36076 15730 48138 608D0,
- 6 0.93246 95142 03152 028D0, 0.17132 44923 79170 345D0,
- 7 -0.96028 98564 97536 232D0, 0.10122 85362 90376 259D0,
- 8 -0.79666 64774 13626 740D0, 0.22238 10344 53374 471D0,
- 9 -0.52553 24099 16328 986D0, 0.31370 66458 77887 287D0,
- A -0.18343 46424 95649 805D0, 0.36268 37833 78361 983D0,
- B 0.18343 46424 95649 805D0, 0.36268 37833 78361 983D0,
- C 0.52553 24099 16328 986D0, 0.31370 66458 77887 287D0,
- D 0.79666 64774 13626 740D0, 0.22238 10344 53374 471D0,
- E 0.96028 98564 97536 232D0, 0.10122 85362 90376 259D0/
-
- IF(NI .LE. 0) THEN
- WRITE(ERRTXT,101) NI
- CALL MTLPRT(NAME,'D110.1',ERRTXT)
- STOP
- END IF
- M0=NG
- IF(M0 .NE. 8) M0=6
- I0=0
- IF(M0 .EQ. 8) I0=6
- D=(B-A)/NI
- R=HALF*D
- RA=R+A
- MV=MOD(M0*NI-1,64)+1
- S=0
- J=0
- DO 1 I = 1+I0,M0+I0
- RTA=R*T(I)+RA
- DO 2 K = 1,NI
- J=J+1
- V(J)=W(I)
- U(J)=RTA+(K-1)*D
- IF(J .EQ. MV) THEN
- CALL FSUB1(MV,U,F,X)
- DO 3 J = 1,MV
- 3 S=S+V(J)*F(J)
- MV=64
- J=0
- END IF
- 2 CONTINUE
- 1 CONTINUE
-#if !defined(CERNLIB_DOUBLE)
- RGMLT1=R*S
-#endif
-#if defined(CERNLIB_DOUBLE)
- DGMLT1=R*S
-#endif
- RETURN
- 101 FORMAT('N1 = ',I4,' <= 0')
- END
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION RGMLT2(FSUB2,A,B,NI,NG,X)
-#endif
-#if defined(CERNLIB_DOUBLE)
- FUNCTION DGMLT2(FSUB2,A,B,NI,NG,X)
-#include "gen/imp64.inc"
-#endif
-
- CHARACTER NAME*(*)
- CHARACTER*80 ERRTXT
-#if !defined(CERNLIB_DOUBLE)
- PARAMETER (NAME = 'RGMLT2')
-#endif
-#if defined(CERNLIB_DOUBLE)
- PARAMETER (NAME = 'DGMLT2')
-#endif
- PARAMETER (Z1 = 1, HALF = Z1/2)
-
- DIMENSION X(6),W(14),T(14),V(64),U(64),F(64)
-
- DATA (T(I),W(I),I=1,14)
- 1/-0.93246 95142 03152 028D0, 0.17132 44923 79170 345D0,
- 2 -0.66120 93864 66264 514D0, 0.36076 15730 48138 608D0,
- 3 -0.23861 91860 83196 909D0, 0.46791 39345 72691 047D0,
- 4 0.23861 91860 83196 909D0, 0.46791 39345 72691 047D0,
- 5 0.66120 93864 66264 514D0, 0.36076 15730 48138 608D0,
- 6 0.93246 95142 03152 028D0, 0.17132 44923 79170 345D0,
- 7 -0.96028 98564 97536 232D0, 0.10122 85362 90376 259D0,
- 8 -0.79666 64774 13626 740D0, 0.22238 10344 53374 471D0,
- 9 -0.52553 24099 16328 986D0, 0.31370 66458 77887 287D0,
- A -0.18343 46424 95649 805D0, 0.36268 37833 78361 983D0,
- B 0.18343 46424 95649 805D0, 0.36268 37833 78361 983D0,
- C 0.52553 24099 16328 986D0, 0.31370 66458 77887 287D0,
- D 0.79666 64774 13626 740D0, 0.22238 10344 53374 471D0,
- E 0.96028 98564 97536 232D0, 0.10122 85362 90376 259D0/
-
- IF(NI .LE. 0) THEN
- WRITE(ERRTXT,101) NI
- CALL MTLPRT(NAME,'D110.1',ERRTXT)
- END IF
- M0=NG
- IF(M0 .NE. 8) M0=6
- I0=0
- IF(M0 .EQ. 8) I0=6
- D=(B-A)/NI
- R=HALF*D
- RA=R+A
- MV=MOD(M0*NI-1,64)+1
- S=0
- J=0
- DO 1 I = 1+I0,M0+I0
- RTA=R*T(I)+RA
- DO 2 K = 1,NI
- J=J+1
- V(J)=W(I)
- U(J)=RTA+(K-1)*D
- IF(J .EQ. MV) THEN
- CALL FSUB2(MV,U,F,X)
- DO 3 J = 1,MV
- 3 S=S+V(J)*F(J)
- MV=64
- J=0
- END IF
- 2 CONTINUE
- 1 CONTINUE
-#if !defined(CERNLIB_DOUBLE)
- RGMLT2=R*S
-#endif
-#if defined(CERNLIB_DOUBLE)
- DGMLT2=R*S
-#endif
- RETURN
- 101 FORMAT('N2 = ',I4,' <= 0')
- END
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION RGMLT3(FSUB3,A,B,NI,NG,X)
-#endif
-#if defined(CERNLIB_DOUBLE)
- FUNCTION DGMLT3(FSUB3,A,B,NI,NG,X)
-#include "gen/imp64.inc"
-#endif
- CHARACTER NAME*(*)
- CHARACTER*80 ERRTXT
-#if !defined(CERNLIB_DOUBLE)
- PARAMETER (NAME = 'RGMLT3')
-#endif
-#if defined(CERNLIB_DOUBLE)
- PARAMETER (NAME = 'DGMLT3')
-#endif
- PARAMETER (Z1 = 1, HALF = Z1/2)
-
- DIMENSION X(6),W(14),T(14),V(64),U(64),F(64)
-
- DATA (T(I),W(I),I=1,14)
- 1/-0.93246 95142 03152 028D0, 0.17132 44923 79170 345D0,
- 2 -0.66120 93864 66264 514D0, 0.36076 15730 48138 608D0,
- 3 -0.23861 91860 83196 909D0, 0.46791 39345 72691 047D0,
- 4 0.23861 91860 83196 909D0, 0.46791 39345 72691 047D0,
- 5 0.66120 93864 66264 514D0, 0.36076 15730 48138 608D0,
- 6 0.93246 95142 03152 028D0, 0.17132 44923 79170 345D0,
- 7 -0.96028 98564 97536 232D0, 0.10122 85362 90376 259D0,
- 8 -0.79666 64774 13626 740D0, 0.22238 10344 53374 471D0,
- 9 -0.52553 24099 16328 986D0, 0.31370 66458 77887 287D0,
- A -0.18343 46424 95649 805D0, 0.36268 37833 78361 983D0,
- B 0.18343 46424 95649 805D0, 0.36268 37833 78361 983D0,
- C 0.52553 24099 16328 986D0, 0.31370 66458 77887 287D0,
- D 0.79666 64774 13626 740D0, 0.22238 10344 53374 471D0,
- E 0.96028 98564 97536 232D0, 0.10122 85362 90376 259D0/
-
- IF(NI .LE. 0) THEN
- WRITE(ERRTXT,101) NI
- CALL MTLPRT(NAME,'D110.1',ERRTXT)
- STOP
- END IF
- M0=NG
- IF(M0 .NE. 8) M0=6
- I0=0
- IF(M0 .EQ. 8) I0=6
- D=(B-A)/NI
- R=HALF*D
- RA=R+A
- MV=MOD(M0*NI-1,64)+1
- S=0
- J=0
- DO 1 I = 1+I0,M0+I0
- RTA=R*T(I)+RA
- DO 2 K = 1,NI
- J=J+1
- V(J)=W(I)
- U(J)=RTA+(K-1)*D
- IF(J .EQ. MV) THEN
- CALL FSUB3(MV,U,F,X)
- DO 3 J = 1,MV
- 3 S=S+V(J)*F(J)
- MV=64
- J=0
- END IF
- 2 CONTINUE
- 1 CONTINUE
-#if !defined(CERNLIB_DOUBLE)
- RGMLT3=R*S
-#endif
-#if defined(CERNLIB_DOUBLE)
- DGMLT3=R*S
-#endif
- RETURN
- 101 FORMAT('N3 = ',I4,' <= 0')
- END
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION RGMLT4(FSUB4,A,B,NI,NG,X)
-#endif
-#if defined(CERNLIB_DOUBLE)
- FUNCTION DGMLT4(FSUB4,A,B,NI,NG,X)
-#include "gen/imp64.inc"
-#endif
- CHARACTER NAME*(*)
- CHARACTER*80 ERRTXT
-#if !defined(CERNLIB_DOUBLE)
- PARAMETER (NAME = 'RGMLT4')
-#endif
-#if defined(CERNLIB_DOUBLE)
- PARAMETER (NAME = 'DGMLT4')
-#endif
- PARAMETER (Z1 = 1, HALF = Z1/2)
-
- DIMENSION X(6),W(14),T(14),V(64),U(64),F(64)
-
- DATA (T(I),W(I),I=1,14)
- 1/-0.93246 95142 03152 028D0, 0.17132 44923 79170 345D0,
- 2 -0.66120 93864 66264 514D0, 0.36076 15730 48138 608D0,
- 3 -0.23861 91860 83196 909D0, 0.46791 39345 72691 047D0,
- 4 0.23861 91860 83196 909D0, 0.46791 39345 72691 047D0,
- 5 0.66120 93864 66264 514D0, 0.36076 15730 48138 608D0,
- 6 0.93246 95142 03152 028D0, 0.17132 44923 79170 345D0,
- 7 -0.96028 98564 97536 232D0, 0.10122 85362 90376 259D0,
- 8 -0.79666 64774 13626 740D0, 0.22238 10344 53374 471D0,
- 9 -0.52553 24099 16328 986D0, 0.31370 66458 77887 287D0,
- A -0.18343 46424 95649 805D0, 0.36268 37833 78361 983D0,
- B 0.18343 46424 95649 805D0, 0.36268 37833 78361 983D0,
- C 0.52553 24099 16328 986D0, 0.31370 66458 77887 287D0,
- D 0.79666 64774 13626 740D0, 0.22238 10344 53374 471D0,
- E 0.96028 98564 97536 232D0, 0.10122 85362 90376 259D0/
-
- IF(NI .LE. 0) THEN
- WRITE(ERRTXT,101) NI
- CALL MTLPRT(NAME,'D110.1',ERRTXT)
- STOP
- END IF
- M0=NG
- IF(M0 .NE. 8) M0=6
- I0=0
- IF(M0 .EQ. 8) I0=6
- D=(B-A)/NI
- R=HALF*D
- RA=R+A
- MV=MOD(M0*NI-1,64)+1
- S=0
- J=0
- DO 1 I = 1+I0,M0+I0
- RTA=R*T(I)+RA
- DO 2 K = 1,NI
- J=J+1
- V(J)=W(I)
- U(J)=RTA+(K-1)*D
- IF(J .EQ. MV) THEN
- CALL FSUB4(MV,U,F,X)
- DO 3 J = 1,MV
- 3 S=S+V(J)*F(J)
- MV=64
- J=0
- END IF
- 2 CONTINUE
- 1 CONTINUE
-#if !defined(CERNLIB_DOUBLE)
- RGMLT4=R*S
-#endif
-#if defined(CERNLIB_DOUBLE)
- DGMLT4=R*S
-#endif
- RETURN
- 101 FORMAT('N4 = ',I4,' <= 0')
- END
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION RGMLT5(FSUB5,A,B,NI,NG,X)
-#endif
-#if defined(CERNLIB_DOUBLE)
- FUNCTION DGMLT5(FSUB5,A,B,NI,NG,X)
-#include "gen/imp64.inc"
-#endif
- CHARACTER NAME*(*)
- CHARACTER*80 ERRTXT
-#if !defined(CERNLIB_DOUBLE)
- PARAMETER (NAME = 'RGMLT5')
-#endif
-#if defined(CERNLIB_DOUBLE)
- PARAMETER (NAME = 'DGMLT5')
-#endif
- PARAMETER (Z1 = 1, HALF = Z1/2)
-
- DIMENSION X(6),W(14),T(14),V(64),U(64),F(64)
-
- DATA (T(I),W(I),I=1,14)
- 1/-0.93246 95142 03152 028D0, 0.17132 44923 79170 345D0,
- 2 -0.66120 93864 66264 514D0, 0.36076 15730 48138 608D0,
- 3 -0.23861 91860 83196 909D0, 0.46791 39345 72691 047D0,
- 4 0.23861 91860 83196 909D0, 0.46791 39345 72691 047D0,
- 5 0.66120 93864 66264 514D0, 0.36076 15730 48138 608D0,
- 6 0.93246 95142 03152 028D0, 0.17132 44923 79170 345D0,
- 7 -0.96028 98564 97536 232D0, 0.10122 85362 90376 259D0,
- 8 -0.79666 64774 13626 740D0, 0.22238 10344 53374 471D0,
- 9 -0.52553 24099 16328 986D0, 0.31370 66458 77887 287D0,
- A -0.18343 46424 95649 805D0, 0.36268 37833 78361 983D0,
- B 0.18343 46424 95649 805D0, 0.36268 37833 78361 983D0,
- C 0.52553 24099 16328 986D0, 0.31370 66458 77887 287D0,
- D 0.79666 64774 13626 740D0, 0.22238 10344 53374 471D0,
- E 0.96028 98564 97536 232D0, 0.10122 85362 90376 259D0/
-
- IF(NI .LE. 0) THEN
- WRITE(ERRTXT,101) NI
- CALL MTLPRT(NAME,'D110.1',ERRTXT)
- STOP
- END IF
- M0=NG
- IF(M0 .NE. 8) M0=6
- I0=0
- IF(M0 .EQ. 8) I0=6
- D=(B-A)/NI
- R=HALF*D
- RA=R+A
- MV=MOD(M0*NI-1,64)+1
- S=0
- J=0
- DO 1 I = 1+I0,M0+I0
- RTA=R*T(I)+RA
- DO 2 K = 1,NI
- J=J+1
- V(J)=W(I)
- U(J)=RTA+(K-1)*D
- IF(J .EQ. MV) THEN
- CALL FSUB5(MV,U,F,X)
- DO 3 J = 1,MV
- 3 S=S+V(J)*F(J)
- MV=64
- J=0
- END IF
- 2 CONTINUE
- 1 CONTINUE
-#if !defined(CERNLIB_DOUBLE)
- RGMLT5=R*S
-#endif
-#if defined(CERNLIB_DOUBLE)
- DGMLT5=R*S
-#endif
- RETURN
- 101 FORMAT('N5 = ',I4,' <= 0')
- END
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION RGMLT6(FSUB6,A,B,NI,NG,X)
-#endif
-#if defined(CERNLIB_DOUBLE)
- FUNCTION DGMLT6(FSUB6,A,B,NI,NG,X)
-#include "gen/imp64.inc"
-#endif
- CHARACTER NAME*(*)
- CHARACTER*80 ERRTXT
-#if !defined(CERNLIB_DOUBLE)
- PARAMETER (NAME = 'RGMLT6')
-#endif
-#if defined(CERNLIB_DOUBLE)
- PARAMETER (NAME = 'DGMLT6')
-#endif
- PARAMETER (Z1 = 1, HALF = Z1/2)
-
- DIMENSION X(6),W(14),T(14),V(64),U(64),F(64)
-
- DATA (T(I),W(I),I=1,14)
- 1/-0.93246 95142 03152 028D0, 0.17132 44923 79170 345D0,
- 2 -0.66120 93864 66264 514D0, 0.36076 15730 48138 608D0,
- 3 -0.23861 91860 83196 909D0, 0.46791 39345 72691 047D0,
- 4 0.23861 91860 83196 909D0, 0.46791 39345 72691 047D0,
- 5 0.66120 93864 66264 514D0, 0.36076 15730 48138 608D0,
- 6 0.93246 95142 03152 028D0, 0.17132 44923 79170 345D0,
- 7 -0.96028 98564 97536 232D0, 0.10122 85362 90376 259D0,
- 8 -0.79666 64774 13626 740D0, 0.22238 10344 53374 471D0,
- 9 -0.52553 24099 16328 986D0, 0.31370 66458 77887 287D0,
- A -0.18343 46424 95649 805D0, 0.36268 37833 78361 983D0,
- B 0.18343 46424 95649 805D0, 0.36268 37833 78361 983D0,
- C 0.52553 24099 16328 986D0, 0.31370 66458 77887 287D0,
- D 0.79666 64774 13626 740D0, 0.22238 10344 53374 471D0,
- E 0.96028 98564 97536 232D0, 0.10122 85362 90376 259D0/
-
- IF(NI .LE. 0) THEN
- WRITE(ERRTXT,101) NI
- CALL MTLPRT(NAME,'D110.1',ERRTXT)
- STOP
- END IF
- M0=NG
- IF(M0 .NE. 8) M0=6
- I0=0
- IF(M0 .EQ. 8) I0=6
- D=(B-A)/NI
- R=HALF*D
- RA=R+A
- MV=MOD(M0*NI-1,64)+1
- S=0
- J=0
- DO 1 I = 1+I0,M0+I0
- RTA=R*T(I)+RA
- DO 2 K = 1,NI
- J=J+1
- V(J)=W(I)
- U(J)=RTA+(K-1)*D
- IF(J .EQ. MV) THEN
- CALL FSUB6(MV,U,F,X)
- DO 3 J = 1,MV
- 3 S=S+V(J)*F(J)
- MV=64
- J=0
- END IF
- 2 CONTINUE
- 1 CONTINUE
-#if !defined(CERNLIB_DOUBLE)
- RGMLT6=R*S
-#endif
-#if defined(CERNLIB_DOUBLE)
- DGMLT6=R*S
-#endif
- RETURN
- 101 FORMAT('N6 = ',I4,' <= 0')
- END
diff --git a/src/mathlib/gen/d/rgquad.F b/src/mathlib/gen/d/rgquad.F
deleted file mode 100644
index 00b4c09..0000000
--- a/src/mathlib/gen/d/rgquad.F
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: rgquad.F,v 1.1.1.1 1996/04/01 15:02:15 mclareni Exp $
-*
-* $Log: rgquad.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:15 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- FUNCTION RGQUAD(F,A,B,N)
-
- DIMENSION X(1),W(1)
- EXTERNAL F
-
- CALL D107R1(1,F,A,B,N,X,W)
- RGQUAD=X(1)
- RETURN
- END
diff --git a/src/mathlib/gen/d/rgs56p.F b/src/mathlib/gen/d/rgs56p.F
deleted file mode 100644
index 3532b77..0000000
--- a/src/mathlib/gen/d/rgs56p.F
+++ /dev/null
@@ -1,42 +0,0 @@
-*
-* $Id: rgs56p.F,v 1.1.1.1 1996/04/01 15:02:14 mclareni Exp $
-*
-* $Log: rgs56p.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:14 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE RGS56P(F,A,B,RES,ERR)
- DOUBLE PRECISION E5,E6
-
- PARAMETER (R1 = 1, HF = R1/2)
- DIMENSION X5(5),W5(5),X6(6),W6(6)
-
- DATA (X5(I),W5(I),I=1,5)
- 1/4.6910077030668004D-02, 1.1846344252809454D-01,
- 2 2.3076534494715846D-01, 2.3931433524968324D-01,
- 3 5.0000000000000000D-01, 2.8444444444444444D-01,
- 4 7.6923465505284154D-01, 2.3931433524968324D-01,
- 5 9.5308992296933200D-01, 1.1846344252809454D-01/
-
- DATA (X6(I),W6(I),I=1,6)
- 1/3.3765242898423989D-02, 8.5662246189585178D-02,
- 2 1.6939530676686775D-01, 1.8038078652406930D-01,
- 3 3.8069040695840155D-01, 2.3395696728634552D-01,
- 4 6.1930959304159845D-01, 2.3395696728634552D-01,
- 5 8.3060469323313225D-01, 1.8038078652406930D-01,
- 6 9.6623475710157601D-01, 8.5662246189585178D-02/
-
- RANG=B-A
- E5=0
- E6=0
- DO 1 I = 1,5
- E5=E5+W5(I)*F(A+RANG*X5(I))
- E6=E6+W6(I)*F(A+RANG*X6(I))
- 1 CONTINUE
- E6=E6+W6(6)*F(A+RANG*X6(6))
- RES=HF*(E6+E5)*RANG
- ERR=ABS((E6-E5)*RANG)
- RETURN
- END
diff --git a/src/mathlib/gen/d/rgset.F b/src/mathlib/gen/d/rgset.F
deleted file mode 100644
index ed08e34..0000000
--- a/src/mathlib/gen/d/rgset.F
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: rgset.F,v 1.1.1.1 1996/04/01 15:02:15 mclareni Exp $
-*
-* $Log: rgset.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:15 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE RGSET(A,B,N,X,W)
- EXTERNAL RGQUAD
- DIMENSION X(*),W(*)
-
- CALL D107R1(2,RGQUAD,A,B,N,X,W)
- RETURN
- END
diff --git a/src/mathlib/gen/d/riwiad.F b/src/mathlib/gen/d/riwiad.F
deleted file mode 100644
index 2ab10a4..0000000
--- a/src/mathlib/gen/d/riwiad.F
+++ /dev/null
@@ -1,374 +0,0 @@
-*
-* $Id: riwiad.F,v 1.1.1.1 1996/04/01 15:02:16 mclareni Exp $
-*
-* $Log: riwiad.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:16 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE RIWIAD(F)
-#include "gen/imp64.inc"
-C
-C********** COMMUNICATION TO CALLING PROGRAM
-C
- COMMON/PARAMS/ACC,NDIM,NSUB,ITER
- COMMON/ANSWER/VALUE,ERROR
- COMMON/STORE/XA(11),XB(11),XC(11),XD(11),MA(11),MB(11),MC(11)
- COMMON/STORE1/R(10000),LR
- COMMON/OPTION/IPRINT,ICONV,IRESET
- COMMON/RANDOM/NSHOTS
- COMMON/INTERN/FACTOR,ALFA,BETA,GAMMA,DELTA,LEVEL,NMIN
-C*NS INTEGER XLOC, FNAME
- EXTERNAL F
-C
-#if defined(CERNLIB_DOUBLE)
- REAL Q
-C MODIFICATIONS FOR DOUBLE PRECISION
- REAL(N)=DBLE(N)
-C............
-#endif
- CALL RIWIBD
-C***************CONSTANTS AND COUNTERS
- ZERO=1.0E-12
- ONE=1.0-ZERO
- ITC=0
- NCALL=0
- SWI=0.0
- SRV=0.0
- SWISQ=0.0
- ANMIN=NMIN
- ANDIM=NDIM
- ANSUB=NSUB
- RNDIM=1.0/ANDIM
- ANSHT1=NSHOTS-1
- RNSHTS=1.0/NSHOTS
- RNSHT1=1.0/(NSHOTS-1)
-C
-C********** INITIALISE INTERVALS
-C
- IF(MA(1).EQ.0) GOTO 201
- IF(IRESET.EQ.0) GOTO 202
- 201 K=INT(ANSUB**RNDIM+ZERO)
- IF(K.LT.NMIN) GOTO 207
- A=1.0/K
- L=NDIM*K
- DO 204 I=1,L
- 204 R(I)=A
- DO 203 I=1,NDIM
- 203 MA(I)=K
- 202 CONTINUE
-C
-C********** PRINT OUT INITIAL VALUES
-C
- IF(IPRINT.EQ.0) GOTO 1
- WRITE(6,2)
- 2 FORMAT('1........ RIEMANN INTEGRATION WITH INTERVAL ADJUSTMENT',
- *'........')
- WRITE(6,3) ACC,NDIM,NSUB,ITER
-3 FORMAT('0******** INPUT PARAM ********'//
- +,' NAME OF INTEGRAND...',13X,'F '/
- +,' RELATIVE ACCURACY... ',12X,F7.5/
- +,' DIMENSION OF INTEGRAL... ',I15/
- +,' MAXIMUM NUMBER OF SUBVOLUMES... ',I8/
- +,' MAXIMUM NUMBER OF ITERATIONS... ',I8)
- IF(IPRINT.EQ.2) GOTO 1
- WRITE(6,4)NSHOTS,LEVEL,FACTOR,IPRINT,
- 1ICONV,IRESET,ALFA,BETA,GAMMA,DELTA,NMIN
- 4 FORMAT('0'/'0******** INTERNAL PARAMETERS ********'//
- +,' NUMBER OF CALLS PER SUBVOLUME... ',I7/
- +,' LEVEL OF CONFIDENCE (PER CENT)...',I7/
- +,' CORRESPONDING FACTOR...',F17.2/
- +,' PRINT OPTION...',I25/
- +,' CONVERGENCE CRITERION...',I16/
- +,' RESET OPTION...',I25/
- +,' RATE OF CONVERGENCE...',2X,4F4.2/
- +,' MINIMUM NUMBER OF INTERVALS...',I10)
-C
-C********** ENTRY AND REENTRY FOR ITERATIONS
-C
- 1 ITC=ITC+1
- J=1
- NID114=0
- DO 6 I=1,NDIM
- MB(I)=NID114
- K=MA(I)
- J=J*K
- 6 NID114=NID114+K
- NCALL=NCALL+NSHOTS*J
- LA=0
- LB=NID114
- LC=2*NID114
- LD=3*NID114
- LE=4*NID114
- IF(LE.GT.LR) GOTO 107
-C
-C********** INITIALISE INTEGRATION LOOP
-C
-C*UL7 L=0
- L=0
- V=1.0
- DO 110 I=1,NDIM
- MC(I)=1
- K=L+1
- L=L+MA(I)
- A=R(LA+K)
- XA(I)=A
- XB(I)=0.0
- XC(I)=V
- V=V*A
- X=0.0
- DO 8 J=K,L
- R(LB+J)=X
- X=X+R(LA+J)
- R(LC+J)=0.0
- 8 R(LD+J)=0.0
- R(LA+L)=R(LA+L)+1.0-X
- 110 CONTINUE
-C
-C********** INTEGRATION LOOP
-C
- 15 SF1=0.0
- SF2=0.0
- DO 9 N=1,NSHOTS
- DO 10 I=1,NDIM
- 10 XD(I)=XB(I)+XA(I)*RNDM(I)
- Y=F(XD)
- SF1=SF1+Y
- 9 SF2=SF2+Y**2
- SF1=SF1*RNSHTS
- SF2=SF2*RNSHTS
- C=V*SF1
- D=V**2*(SF2-SF1**2)*RNSHT1
- DO 11 I=1,NDIM
- J=MB(I)+MC(I)
- R(LC+J)=R(LC+J)+C
- 11 R(LD+J)=R(LD+J)+D
-C
-C********** LOOP THE LOOP
-C
- I=NDIM
- 13 J=MC(I)
- K=MB(I)+1
- IF(J.NE.MA(I)) GOTO 12
- MC(I)=1
- XA(I)=R(LA+K)
- XB(I)=0.0
- I=I-1
- IF(I) 14,14,13
- 12 MC(I)=J+1
- V=XC(I)
- K=K+J
- A=R(LA+K)
- XA(I)=A
- XB(I)=R(LB+K)
- V=V*A
- 16 IF(I.EQ.NDIM) GOTO 15
- I=I+1
- XC(I)=V
- V=V*XA(I)
- GOTO 16
-C
-C********** CALCULATE INTEGRAL AND ERROR
-C
- 14 J=MA(1)
- SI=0.0
- SV=0.0
- DO 17 I=1,J
- SI=SI+R(LC+I)
- 17 SV=SV+R(LD+I)
- IF(SV.EQ.0.0) GOTO 400
- RV=1.0/SV
- WI=SI*RV
- SRV=SRV+RV
- SWI=SWI+WI
- VALUE=SWI/SRV
- FSV=FACTOR*SQRT(SV)
- ERROR=FACTOR/SQRT(SRV)
- SWISQ=SWISQ+RV*SI**2
- CHISQ=SWISQ-VALUE**2*SRV
-C
-C********** REDUCE TO RELATIVE QUANTITIES
-C
- RI=1.0/SI
- DO 18 J=1,NID114
- R(LC+J)=R(LC+J)*RI
- 18 R(LD+J)=R(LD+J)*RV
-C
-C********** PRINT OUT THE RESULTS OF THIS ITERATION
-C
- IF(IPRINT.EQ.0) GOTO 25
- WRITE(6,20)ITC,SI,FSV,VALUE,ERROR,CHISQ
- 1,NCALL,(MA(I),I=1,NDIM)
- 20 FORMAT('0'//////' ******** ITERATION NUMBER',I3,' ********'//
- +,' VALUE OF INTEGRAL...',E13.5/
- +,' ESTIMATED ERROR.....',E13.5//
- +,' ACCUMULATED VALUE...',E13.5/
- +,' ACCUMULATED ERROR...',E13.5//
- +,' CHI SQUARE..........',F13.2//
- +,' NUMBER OF CALLS TO F',I13/
- +,' INTERVAL STRUCTURE..',5X,(25I4)//)
- IF(IPRINT.EQ.2) GOTO 25
- DO 19 I=1,NDIM
- WRITE(6,21)I
- 21 FORMAT('0'/'0........ AXIS NUMBER',I3)
- K=MB(I)
- L=MA(I)+K
- K=K+1
- WRITE(6,22)(R(LA+J),J=K,L)
- 22 FORMAT('0INTERVAL CHOICE'/(10E13.2))
- WRITE(6,23)(R(LC+J),J=K,L)
- 23 FORMAT('0RELATIVE CONTRIBUTION TO INTEGRAL'/(10E13.2))
- WRITE(6,24)(R(LD+J),J=K,L)
- 24 FORMAT('0RELATIVE CONTRIBUTION TO ERROR'/(10E13.2))
- 19 CONTINUE
-C
-C********** CHECK IF ACCURACY REACHED OR END OF ITERATIONS
-C
- 25 ACC1=ERROR/ABS(VALUE)
- IF(ACC1.GT.ACC) GOTO 26
- 28 IF(IPRINT.NE.0) WRITE(6,27) 'WAS',ITC,VALUE,ERROR
- RETURN
- 26 IF(ITC.EQ.ITER) THEN
- IF(IPRINT.NE.0) WRITE(6,27)'NOT',ITC,VALUE,ERROR
- RETURN
- ENDIF
-C
-C********** RECOMPUTE INTERVAL SIZES
-C
- L=0
- V=1.0
- DO 29 I=1,NDIM
- K=L+1
- M=MA(I)
- L=L+M
- X=0.0
- Y=0.0
- Z=0.0
- DO 30 J=K,L
- A=R(LA+J)
- C=R(LC+J)
- D=R(LD+J)
- GOTO (301,302,303,304),ICONV
- 301 CONTINUE
- P=(1.0-A+ZERO)**ALFA
- Q=(-LOG(D+ZERO)+ZERO)**BETA
- GOTO 399
- 302 CONTINUE
- P=A**ALFA
- Q=(D+ZERO)**(-BETA)
- GOTO 399
- 303 CONTINUE
- P=((-LOG(D+ZERO)+ZERO)/(1.0-D+ZERO))**ALFA
- Q=((-LOG(A+ZERO)+ZERO)/(1.0-A+ZERO))**(-BETA)
- GOTO 399
- 304 CONTINUE
- P=(1.0-LOG(D+ZERO))**ALFA
- Q=(1.0-LOG(A+ZERO))**(-BETA)
- GOTO 399
- 399 CONTINUE
- B=A*P*Q
- R(LB+J)=B
- X=X+B
- Y=Y+D/A
- 30 Z=Z+C**2/A
- B=ANSHT1 *Y*SV+(Z-1.0)*SI**2
- Y=B**GAMMA*M**DELTA
- V=V*Y
- XA(I)=Y
- X=1.0/X
- MC(I)=0
- DO 31 J=K,L
- 31 R(LB+J)=R(LB+J)*X
- 29 CONTINUE
-C
-C********** RECOMPUTE INTERVAL NUMBERS
-C
- L=0
- 34 Q=(ANSUB/(ANMIN**L*V))**(1.0/(NDIM-L))
- V=1.0
- K=0
- DO 32 I=1,NDIM
- M=MC(I)
- IF(M.EQ.NMIN) GOTO 32
- A=XA(I)*Q
- M=INT(A+0.5)
- IF(M.LE.NMIN) GOTO 33
- XA(I)=A
- V=V*A
- MC(I)=M
- GOTO 32
- 33 MC(I)=NMIN
- K=K+1
- 32 CONTINUE
- L=L+K
- IF(K.NE.0) GOTO 34
-C
-C********** COMBINE SIZES AND NUMBERS INTO NEW INTERVALS
-C
- NID114=0
- DO 35 I=1,NDIM
- 35 NID114=NID114+MC(I)
- IF(5*NID114.GT.LR) GOTO 107
- L=0
- L1=0
- DO 36 I=1,NDIM
- K=L+1
- K1=L1+1
- M=MC(I)
- M1=MA(I)
- L=L+M
- L1=L1+M1
- A=REAL(M1)/REAL(M)
- A=A*ONE
- C=0.0
- DO 38 J=K,L
- B=C
- C=C+A
- I1=INT(B)
- I2=INT(C)
- X=0.0
- DO 39 I3=I1,I2
- 39 X=X+R(LB+K1+I3)
- 38 R(LE+J)=X-(I2+1-C)*R(LB+K1+I2)-(B-I1)*R(LB+K1+I1)
- 36 CONTINUE
- DO 40 L=1,NID114
- 40 R(LA+L)=R(LE+L)
- DO 41 I=1,NDIM
- 41 MA(I)=MC(I)
- GOTO 1
-C
-C********** NOT STORAGE ENOUGH
-C
- 107 X1=ANDIM*ANSUB**RNDIM
- X2=ANMIN*(ANDIM-1.0)+ANSUB/ANMIN**(ANDIM-1.0)
- X1=5.0*X1
- X2=5.0*X2
- X3=SQRT(X1*X2)
- I1=INT(X1)
- I2=INT(X2)
- I3=INT(X3)
- WRITE(6,108)LR,I1,I2,I3
- 108 FORMAT('0'/' STORAGE LENGTH =',I5,' IS TOO SMALL'/
- +,' MINIMUM NECESSARY -',I7/' MAXIMUM POSSIBLE - ',I7/
- +,' PROBABLE VALUE - ',I9)
- STOP 1
-C
-C********** TOO SMALL NUMBER OF SUBVOLUMES
-C
- 207 L=NMIN**NDIM
- WRITE(6,206)NSUB,L
- 206 FORMAT('0 NSUB TOO SMALL...',I7/
- +,' MINIMUM NECESSARY...',I7)
- STOP 2
-C
-C ********** ZERO VARIANCE ABORT
-C
- 400 WRITE(6,401)
- 401 FORMAT('0FUNCTION HAS ZERO VARIANCE')
- STOP 3
- 27 FORMAT('0'/'0********'/
- +,' THE DESIRED ACCURACY ',A,' OBTAINED AFTER',I4,' ITERATIONS'//
- + ' FINAL VALUE...',E13.5/
- + ' FINAL ERROR...',E13.5/'0........')
- END
diff --git a/src/mathlib/gen/d/riwibd.F b/src/mathlib/gen/d/riwibd.F
deleted file mode 100644
index c2e4cab..0000000
--- a/src/mathlib/gen/d/riwibd.F
+++ /dev/null
@@ -1,35 +0,0 @@
-*
-* $Id: riwibd.F,v 1.1.1.1 1996/04/01 15:02:16 mclareni Exp $
-*
-* $Log: riwibd.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:16 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE RIWIBD
-C BLOCK DATA SUBSTITUTE
-#include "gen/imp64.inc"
- COMMON/STORE/XA(11),XB(11),XC(11),XD(11),MA(11),MB(11),MC(11)
- COMMON/STORE1/R(10000),LR
- COMMON/OPTION/IPRINT,ICONV,IRESET
- COMMON/RANDOM/NSHOTS
- COMMON/INTERN/FACTOR,ALFA,BETA,GAMMA,DELTA,LEVEL,NMIN
- DATA INIT/0/
- IF(INIT.EQ.1) RETURN
- INIT=1
- MA(1)=0
- LR=10000
- IPRINT=1
- ICONV=1
- IRESET=0
- NSHOTS=2
- FACTOR=1.65
- LEVEL=90
- ALFA=0.3
- BETA=0.3
- GAMMA=0.3
- DELTA=.7
- NMIN=2
- RETURN
- END
diff --git a/src/mathlib/gen/d/rknys64.F b/src/mathlib/gen/d/rknys64.F
deleted file mode 100644
index c605c3b..0000000
--- a/src/mathlib/gen/d/rknys64.F
+++ /dev/null
@@ -1,63 +0,0 @@
-*
-* $Id: rknys64.F,v 1.1.1.1 1996/04/01 15:02:17 mclareni Exp $
-*
-* $Log: rknys64.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:17 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- SUBROUTINE DRKNYS(N,H,X,Y,YP,SUB,W)
-C
-#include "gen/imp64.inc"
-C
- CHARACTER*(*) NAME
- PARAMETER(NAME='DRKNYS')
-#endif
-#if !defined(CERNLIB_DOUBLE)
- SUBROUTINE RRKNYS(N,H,X,Y,YP,SUB,W)
-C
- CHARACTER*(*) NAME
- PARAMETER(NAME='RRKNYS')
-#endif
- DIMENSION Y(*),YP(*),W(N,*)
-
- PARAMETER (Z1 = 1, R2 = Z1/2, R6 = Z1/6, R8 = Z1/8)
-
-#if !defined(CERNLIB_DOUBLE)
- ENTRY RKNYS(N,H,X,Y,YP,SUB,W)
-#endif
-
- IF(N .LE. 0 .OR. H .EQ. 0) RETURN
- H2=R2*H
- H6=R6*H
- HH2=H*H2
- HH6=H*H6
- HH8=R8*H*H
- XH=X+H
- XH2=X+H2
- CALL SUB(X,Y,YP,W(1,1))
- DO 1 J = 1,N
- W(J,4)=Y(J)+H2*YP(J)
- W(J,5)=W(J,4)+HH8*W(J,1)
- 1 W(J,6)=YP(J)+H2*W(J,1)
- CALL SUB(XH2,W(1,5),W(1,6),W(1,2))
- DO 2 J = 1,N
- W(J,6)=YP(J)+H2*W(J,2)
- W(J,1)=W(J,1)+W(J,2)
- 2 W(J,2)=W(J,1)+W(J,2)
- CALL SUB(XH2,W(1,5),W(1,6),W(1,3))
- DO 3 J = 1,N
- W(J,4)=W(J,4)+H2*YP(J)
- W(J,5)=W(J,4)+HH2*W(J,3)
- W(J,6)=YP(J)+H*W(J,3)
- W(J,1)=W(J,1)+W(J,3)
- 3 W(J,2)=W(J,2)+2*W(J,3)
- CALL SUB(XH,W(1,5),W(1,6),W(1,3))
- DO 4 J = 1,N
- Y(J)=W(J,4)+HH6*W(J,1)
- 4 YP(J)=YP(J)+H6*(W(J,2)+W(J,3))
- X=XH
- RETURN
- END
diff --git a/src/mathlib/gen/d/rknysd.F b/src/mathlib/gen/d/rknysd.F
deleted file mode 100644
index 454fadb..0000000
--- a/src/mathlib/gen/d/rknysd.F
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: rknysd.F,v 1.1.1.1 1996/04/01 15:02:17 mclareni Exp $
-*
-* $Log: rknysd.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:17 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- SUBROUTINE RRKNYS(N,H,X,Y,YP,SUB,W)
-C
- CHARACTER NAME*(*)
- PARAMETER (NAME = 'RRKNYS')
- ENTRY RKNYS(N,H,X,Y,YP,SUB,W)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- SUBROUTINE DRKNYS(N,H,X,Y,YP,SUB,W)
-C
- CHARACTER NAME*(*)
- PARAMETER (NAME = 'DRKNYS')
-#endif
- CALL MTLPRT(NAME,'D203.0','Not available on this machine')
- RETURN
- END
diff --git a/src/mathlib/gen/d/rkstp.F b/src/mathlib/gen/d/rkstp.F
deleted file mode 100644
index f566eda..0000000
--- a/src/mathlib/gen/d/rkstp.F
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: rkstp.F,v 1.1.1.1 1996/04/01 15:02:16 mclareni Exp $
-*
-* $Log: rkstp.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:16 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-C This will be RKSTP,IF=DOUBLE and RKSTP64,IF=-DOUBLE.
- SUBROUTINE RKSTP(N,H,X,Y,SUB,W)
-#include "rkstpcod.inc"
diff --git a/src/mathlib/gen/d/rkstp128.F b/src/mathlib/gen/d/rkstp128.F
deleted file mode 100644
index 66bb64a..0000000
--- a/src/mathlib/gen/d/rkstp128.F
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: rkstp128.F,v 1.1.1.1 1996/04/01 15:02:16 mclareni Exp $
-*
-* $Log: rkstp128.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:16 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if !defined(CERNLIB_DOUBLE)
- SUBROUTINE DRKSTP(N,H,X,Y,SUB,W)
-#include "gen/imp128.inc"
- CHARACTER*(*) NAME
- PARAMETER( NAME='DRKSTP')
- CALL MTLPRT(NAME,'D200.0','Not available on this machine')
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/d/rkstp64.F b/src/mathlib/gen/d/rkstp64.F
deleted file mode 100644
index 342497d..0000000
--- a/src/mathlib/gen/d/rkstp64.F
+++ /dev/null
@@ -1,14 +0,0 @@
-*
-* $Id: rkstp64.F,v 1.1.1.1 1996/04/01 15:02:16 mclareni Exp $
-*
-* $Log: rkstp64.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:16 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- SUBROUTINE DRKSTP(N,H,X,Y,SUB,W)
-#include "gen/imp64.inc"
-#include "rkstpcod.inc"
-#endif
diff --git a/src/mathlib/gen/d/rkstpcod.inc b/src/mathlib/gen/d/rkstpcod.inc
deleted file mode 100644
index 856f652..0000000
--- a/src/mathlib/gen/d/rkstpcod.inc
+++ /dev/null
@@ -1,37 +0,0 @@
-*
-* $Id: rkstpcod.inc,v 1.1.1.1 1996/04/01 15:02:16 mclareni Exp $
-*
-* $Log: rkstpcod.inc,v $
-* Revision 1.1.1.1 1996/04/01 15:02:16 mclareni
-* Mathlib gen
-*
-*
-*
-* rkstpcod.inc
-*
- DIMENSION Y(*),W(N,*)
-
- PARAMETER (Z1 = 1, HF = Z1/2, HS = Z1/6)
-
- IF(N .LE. 0) RETURN
- H2=HF*H
- H6=HS*H
- XH=X+H
- XH2=X+H2
- CALL SUB(X,Y,W(1,1))
- DO 1 J=1,N
- 1 W(J,2)=Y(J)+H2*W(J,1)
- CALL SUB(XH2,W(1,2),W(1,3))
- DO 2 J=1,N
- W(J,1)=W(J,1)+2*W(J,3)
- 2 W(J,2)=Y(J)+H2*W(J,3)
- CALL SUB(XH2,W(1,2),W(1,3))
- DO 3 J=1,N
- W(J,1)=W(J,1)+2*W(J,3)
- 3 W(J,2)=Y(J)+H*W(J,3)
- CALL SUB(XH,W(1,2),W(1,3))
- DO 4 J=1,N
- 4 Y(J)=Y(J)+H6*(W(J,1)+W(J,3))
- X=XH
- RETURN
- END
diff --git a/src/mathlib/gen/d/rpa.F b/src/mathlib/gen/d/rpa.F
deleted file mode 100644
index 111e07a..0000000
--- a/src/mathlib/gen/d/rpa.F
+++ /dev/null
@@ -1,110 +0,0 @@
-*
-* $Id: rpa.F,v 1.1.1.1 1996/04/01 15:02:22 mclareni Exp $
-*
-* $Log: rpa.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:22 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE RPA (MM, X, IX, Y, IY)
-C ANALYSIS OF A REAL PERIODIC FUNCTION.
-C
- REAL X(128), Y(128)
- COMMON /D700DT/ N, N2, N4, M, F, RTTWO
- COMMON /FWORK/ W(321)
- DATA MLOC / - 1 /
-C
- M = MM
- IF(M .NE. MLOC) CALL D700SU
- MLOC = M
-C
- NI = N4 - 1
- NO = NI + N
-C
- KX = 1
- NFWA = NI + 1
- NLWA = NI + N
- DO 10 I = NFWA, NLWA
- W(I) = X(KX)
- 10 KX = KX + IX
-C
- NQ = N2
- DO 80 L = 1, M
-C
- NO1 = NO
- NO2 = NO + N2
- NI1 = NI
- NI2 = NI + NQ
-C
- DO 20 IT = 1, NQ
- NOR1 = NO1 + IT
- NOR2 = NO2 + IT
- NIR1 = NI1 + IT
- NIR2 = NI2 + IT
- W(NOR1) = W(NIR1) + W(NIR2)
- W(NOR2) = W(NIR1) - W(NIR2)
- 20 CONTINUE
-C
- NC = 0
- NS = N4
- NO1 = NO1 + NQ
- NO2 = NO2 - NQ
- NI1 = NI2 + NQ
- NI2 = NI1 + NQ
- IF(NO1 - NO2) 30, 50, 70
-C
- 30 NC = NC + NQ
- NS = NS - NQ
- CC = W(NC)
- SS = W(NS)
-C
- DO 40 IT = 1, NQ
- NOR1 = NO1 + IT
- NOI1 = NOR1 + N2
- NOR2 = NO2 + IT
- NOI2 = NOR2 + N2
- NIR1 = NI1 + IT
- NII1 = NIR1 + N2
- NIR2 = NI2 + IT
- NII2 = NIR2 + N2
- RE = CC * W(NIR2) - SS * W(NII2)
- AI = SS * W(NIR2) + CC * W(NII2)
- W(NOR1) = W(NIR1) + RE
- W(NOR2) = W(NIR1) - RE
- W(NOI1) = + W(NII1) + AI
- W(NOI2) = - W(NII1) + AI
- 40 CONTINUE
-C
- NO1 = NO1 + NQ
- NO2 = NO2 - NQ
- NI1 = NI2 + NQ
- NI2 = NI1 + NQ
- IF(NO1 - NO2) 30, 50, 70
-C
- 50 DO 60 IT = 1, NQ
- NOR1 = NO1 + IT
- NOI1 = NOR1 + N2
- NIR1 = NI1 + IT
- NIR2 = NI2 + IT
- W(NOR1) = W(NIR1)
- W(NOI1) = W(NIR2)
- 60 CONTINUE
-C
- 70 NT = NI
- NI = NO
- NO = NT
- NQ = NQ / 2
-C
- 80 CONTINUE
-C
- KY = 1
- NFWA = NI + 1
- NLWA = NI + N
- DO 90 I = NFWA, NLWA
- Y(KY) = W(I) * F
- 90 KY = KY + IY
- Y(KY) = 0.0
-C
- RETURN
- END
diff --git a/src/mathlib/gen/d/rps.F b/src/mathlib/gen/d/rps.F
deleted file mode 100644
index a6ee3e2..0000000
--- a/src/mathlib/gen/d/rps.F
+++ /dev/null
@@ -1,110 +0,0 @@
-*
-* $Id: rps.F,v 1.1.1.1 1996/04/01 15:02:22 mclareni Exp $
-*
-* $Log: rps.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:22 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE RPS (MM, X, IX, Y, IY)
-C SYNTHESIS OF A REAL PERIODIC FUNCTION.
-C
- REAL X(128), Y(128)
- COMMON /D700DT/ N, N2, N4, M, F, RTTWO
- COMMON /FWORK/ W(321)
- DATA MLOC / - 1 /
-C
- M = MM
- IF(M .NE. MLOC) CALL D700SU
- MLOC = M
-C
- NI = N4 - 1
- NO = NI + N
-C
- KX = 1
- NFWA = NI + 1
- NLWA = NI + N
- DO 10 I = NFWA, NLWA
- W(I) = X(KX)
- 10 KX = KX + IX
-C
- NQ = 1
- DO 80 L = 1, M
-C
- NO1 = NO
- NO2 = NO + NQ
- NI1 = NI
- NI2 = NI + N2
-C
- DO 20 IT = 1, NQ
- NOR1 = NO1 + IT
- NOR2 = NO2 + IT
- NIR1 = NI1 + IT
- NIR2 = NI2 + IT
- W(NOR1) = W(NIR1) + W(NIR2)
- W(NOR2) = W(NIR1) - W(NIR2)
- 20 CONTINUE
-C
- NC = 0
- NS = N4
- NO1 = NO2 + NQ
- NO2 = NO1 + NQ
- NI1 = NI1 + NQ
- NI2 = NI2 - NQ
- IF(NI1 - NI2) 30, 50, 70
-C
- 30 NC = NC + NQ
- NS = NS - NQ
- CC = W(NC)
- SS = W(NS)
-C
- DO 40 IT = 1, NQ
- NOR1 = NO1 + IT
- NOI1 = NOR1 + N2
- NOR2 = NO2 + IT
- NOI2 = NOR2 + N2
- NIR1 = NI1 + IT
- NII1 = NIR1 + N2
- NIR2 = NI2 + IT
- NII2 = NIR2 + N2
- W(NOR1) = W(NIR1) + W(NIR2)
- RE = W(NIR1) - W(NIR2)
- W(NOI1) = W(NII1) - W(NII2)
- AI = W(NII1) + W(NII2)
- W(NOR2) = CC * RE + SS * AI
- W(NOI2) = CC * AI - SS * RE
- 40 CONTINUE
-C
- NO1 = NO2 + NQ
- NO2 = NO1 + NQ
- NI1 = NI1 + NQ
- NI2 = NI2 - NQ
- IF(NI1 - NI2) 30, 50, 70
-C
- 50 DO 60 IT = 1, NQ
- NOR1 = NO1 + IT
- NOR2 = NO2 + IT
- NIR1 = NI1 + IT
- NII1 = NIR1 + N2
- W(NOR1) = W(NIR1) + W(NIR1)
- W(NOR2) = W(NII1) + W(NII1)
- 60 CONTINUE
-C
- 70 NT = NI
- NI = NO
- NO = NT
- NQ = NQ + NQ
-C
- 80 CONTINUE
-C
- KY = 1
- NFWA = NI + 1
- NLWA = NI + N
- DO 90 I = NFWA, NLWA
- Y(KY) = W(I) * F
- 90 KY = KY + IY
- Y(KY) = Y(1)
-C
- RETURN
- END
diff --git a/src/mathlib/gen/d/rrkstp.F b/src/mathlib/gen/d/rrkstp.F
deleted file mode 100644
index af18ce6..0000000
--- a/src/mathlib/gen/d/rrkstp.F
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: rrkstp.F,v 1.1.1.1 1996/04/01 15:02:16 mclareni Exp $
-*
-* $Log: rrkstp.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:16 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-C This will be RKSTP,IF=DOUBLE and RKSTP64,IF=-DOUBLE.
- SUBROUTINE RRKSTP(N,H,X,Y,SUB,W)
-#include "rkstpcod.inc"
diff --git a/src/mathlib/gen/d/rsa.F b/src/mathlib/gen/d/rsa.F
deleted file mode 100644
index cc60896..0000000
--- a/src/mathlib/gen/d/rsa.F
+++ /dev/null
@@ -1,144 +0,0 @@
-*
-* $Id: rsa.F,v 1.1.1.1 1996/04/01 15:02:22 mclareni Exp $
-*
-* $Log: rsa.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:22 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE RSA (MM, X, IX, Y, IY)
-C ANALYSIS OR SYNTHESIS OF A REAL ODD FUNCTION.
-C
- REAL X(128), Y(128)
- COMMON /D700DT/ N, N2, N4, M, F, RTTWO
- COMMON /FWORK/ W(321)
- DATA MLOC / - 1 /
-C
- M = MM + 1
- IF(M .NE. MLOC) CALL D700SU
- MLOC = M
-C
- NI = N4
- NO = N4 + N2 + 1
-C
- KX = IX + 1
- NFWA = NI + 1
- NLWA = NI + N2 - 1
- DO 10 I = NFWA, NLWA
- W(I) = X(KX)
- 10 KX = KX + IX
-C
- NQ = N2
- DO 170 L = 1, M
- NQ2 = NQ / 2
- NQ2M1 = NQ2 - 1
-C
- NO1 = NO
- NO2 = NO + N2
- NI1 = NI
- NI2 = NI + NQ
-C
- IF(NQ2M1) 50, 40, 20
-C
- 20 DO 30 IT = 1, NQ2M1
- NOR1 = NO1 + IT
- NOR2 = NO1 + NQ2 + IT
- NIR1 = NI1 + IT
- NIR2 = NI2 - IT
- W(NOR1) = W(NIR1) - W(NIR2)
- W(NOR2) = W(NIR1) + W(NIR2)
- 30 CONTINUE
-C
- 40 NOR1 = NO1 + NQ2
- NIR1 = NI1 + NQ2
- W(NOR1) = W(NIR1) + W(NIR1)
-C
- 50 NO1 = NO1 + NQ
- NO2 = NO2 - NQ
- NI1 = NI2 + NQ
- NI2 = NI1 + NQ
- IF(NO1 - NO2) 60, 120, 160
-C
- 60 NC = 0
- NS = N4
- KC = 0
- KS = N4
-C
- 70 CONTINUE
- W(NO1) = + W(NI1) + W(NI2)
- W(NO2) = - W(NI1) + W(NI2)
-C
- IF(NQ2M1) 110, 100, 80
-C
- 80 NC = NC + NQ
- NS = NS - NQ
- CC = W(NC)
- SS = W(NS)
- DO 90 IT = 1, NQ2M1
- NOI1 = NO1 + IT
- NOI2 = NO2 + IT
- NII1 = NI1 + IT
- NII2 = NI2 - IT
- NOR1 = NOI1 + NQ2
- NOR2 = NOI2 + NQ2
- NIR1 = NII1 + NQ
- NIR2 = NII2 + NQ
- RE = CC * W(NIR2) - SS * W(NII2)
- AI = SS * W(NIR2) + CC * W(NII2)
- W(NOR1) = W(NIR1) - RE
- W(NOR2) = W(NIR1) + RE
- W(NOI1) = + W(NII1) + AI
- W(NOI2) = - W(NII1) + AI
- 90 CONTINUE
-C
- 100 KC = KC + NQ2
- KS = KS - NQ2
- NOR1 = NO1 + NQ2
- NOR2 = NO2 + NQ2
- NIR1 = NI1 + NQ2
- NIR2 = NI2 + NQ2
- W(NOR1) = 2.0 * (+ W(KC) * W(NIR1) + W(KS) * W(NIR2))
- W(NOR2) = 2.0 * (- W(KS) * W(NIR1) + W(KC) * W(NIR2))
-C
- 110 NO1 = NO1 + NQ
- NO2 = NO2 - NQ
- NI1 = NI2 + NQ
- NI2 = NI1 + NQ
- IF(NO1 - NO2) 70, 120, 160
-C
- 120 NIR1 = NI + NQ
- W(NO1) = W(NIR1)
-C
- IF(NQ2M1) 160, 150, 130
-C
- 130 DO 140 IT = 1, NQ2M1
- NOI1 = NO1 + IT
- NOR1 = NOI1 + NQ2
- NIR1 = NI + NQ + IT
- NIR2 = NI + NQ + NQ - IT
- W(NOR1) = W(NIR1)
- W(NOI1) = W(NIR2)
- 140 CONTINUE
-C
- 150 NOR1 = NO1 + NQ2
- NIR1 = NI + NQ + NQ2
- W(NOR1) = RTTWO * W(NIR1)
-C
- 160 NT = NI
- NI = NO
- NO = NT
- NQ = NQ2
- 170 CONTINUE
-C
- Y(1) = X(1)
- KY = IY + 1
- NFWA = NI + 1
- NLWA = NI + N2 - 1
- DO 180 I = NFWA, NLWA
- Y(KY) = W(I) * F
- 180 KY = KY + IY
- Y(KY) = X(KX)
-C
- RETURN
- END
diff --git a/src/mathlib/gen/d/rtriint.F b/src/mathlib/gen/d/rtriint.F
deleted file mode 100644
index 9767e5f..0000000
--- a/src/mathlib/gen/d/rtriint.F
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: rtriint.F,v 1.1.1.1 1996/04/01 15:02:14 mclareni Exp $
-*
-* $Log: rtriint.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:14 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-C This will be TRIINT,IF=DOUBLE and TRIINT64,IF=-DOUBLE
- FUNCTION RTRINT(F,NSD,NPT,EPS,X1,Y1,X2,Y2,X3,Y3)
-C
-C INTEGRATION OVER A TRIANGLE USING A 7-, 25- OR 64-POINT FORMULA,
-C WITH OR WITHOUT SUBDIVISION OF THE TRIANGLE.
-C
- CHARACTER NAME*(*)
- CHARACTER*80 ERRTXT
- PARAMETER (NAME = 'RTRINT')
-#include "triintcod.inc"
-
- 99 RTRINT=H
- RETURN
- 101 FORMAT('INCORRECT NUMBER OF POINTS =',I5)
- END
diff --git a/src/mathlib/gen/d/s128.F b/src/mathlib/gen/d/s128.F
deleted file mode 100644
index 212548b..0000000
--- a/src/mathlib/gen/d/s128.F
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: s128.F,v 1.1.1.1 1996/04/01 15:02:23 mclareni Exp $
-*
-* $Log: s128.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:23 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE S128(A,B)
- REAL A(64),B(64),C(64)
- COMMON /TAB/D(126),E(127)
- CALL D701BD
- DO 10 I=3,31,2
- A1 = A(I-1)-A(I+1)
- A2 = A(65-I)-A(67-I)
- C1R = A1+A2
- C2R = A1-A2
- C1I = A(I)-A(66-I)
- C2I = A(I)+A(66-I)
- C1 = D(4*I-5)
- C2 = D(4*I-4)
- C3R = C1*C2R-C2*C2I
- C3I = C1*C2I+C2*C2R
- C(I) = C1R+C3R
- C(I+1) = C1I+C3I
- C(66-I) = C1R-C3R
- 10 C(67-I) = C3I-C1I
- C(1) = 2.*(A(64)-A(2))
- C(2) = -2.*(A(64)+A(2))
- C(33) = 2.*(A(32)-A(34))
- C(34) = 2.*A(33)
- CALL I32(C,C(2),2,C,C(2),2)
- B(33) = 0.5*C(33)
- DO 20 I=2,32
- E1 = 0.5*(C(I)-C(66-I))
- E2 = E(4*I-4)*(C(I)+C(66-I))
- B(I) = E2-E1
- 20 B(66-I) = E2+E1
- RETURN
- END
diff --git a/src/mathlib/gen/d/s256.F b/src/mathlib/gen/d/s256.F
deleted file mode 100644
index 28ffdb7..0000000
--- a/src/mathlib/gen/d/s256.F
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: s256.F,v 1.1.1.1 1996/04/01 15:02:23 mclareni Exp $
-*
-* $Log: s256.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:23 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE S256(A,B)
- REAL A(128),B(128),C(128)
- COMMON /TAB/D(126),E(127)
- CALL D701BD
- DO 10 I=3,63,2
- A1 = A(I-1)-A(I+1)
- A2 = A(129-I)-A(131-I)
- C1R = A1+A2
- C2R = A1-A2
- C1I = A(I)-A(130-I)
- C2I = A(I)+A(130-I)
- C1 = D(2*I-3)
- C2 = D(2*I-2)
- C3R = C1*C2R-C2*C2I
- C3I = C1*C2I+C2*C2R
- C(I) = C1R+C3R
- C(I+1) = C1I+C3I
- C(130-I) = C1R-C3R
- 10 C(131-I) = C3I-C1I
- C(1) = 2.*(A(128)-A(2))
- C(2) = -2.*(A(128)+A(2))
- C(65) = 2.*(A(64)-A(66))
- C(66) = 2.*A(65)
- CALL I64(C,C(2),2,C,C(2),2)
- B(65) = 0.5*C(65)
- DO 20 I=2,64
- E1 = 0.5*(C(I)-C(130-I))
- E2 = E(2*I-2)*(C(I)+C(130-I))
- B(I) = E2-E1
- 20 B(130-I) = E2+E1
- RETURN
- END
diff --git a/src/mathlib/gen/d/s512.F b/src/mathlib/gen/d/s512.F
deleted file mode 100644
index b1e2891..0000000
--- a/src/mathlib/gen/d/s512.F
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: s512.F,v 1.1.1.1 1996/04/01 15:02:23 mclareni Exp $
-*
-* $Log: s512.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:23 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE S512(A,B)
- REAL A(256),B(256),C(256)
- COMMON /TAB/D(126),E(127)
- CALL D701BD
- DO 10 I=3,127,2
- A1 = A(I-1)-A(I+1)
- A2 = A(257-I)-A(259-I)
- C1R = A1+A2
- C2R = A1-A2
- C1I = A(I)-A(258-I)
- C2I = A(I)+A(258-I)
- C1 = D(I-2)
- C2 = D(I-1)
- C3R = C1*C2R-C2*C2I
- C3I = C1*C2I+C2*C2R
- C(I) = C1R+C3R
- C(I+1) = C1I+C3I
- C(258-I) = C1R-C3R
- 10 C(259-I) = C3I-C1I
- C(1) = 2.*(A(256)-A(2))
- C(2) = -2.*(A(256)+A(2))
- C(129) = 2.*(A(128)-A(130))
- C(130) = 2.*A(129)
- CALL I128(C,C(2),2,C,C(2),2)
- B(129) = 0.5*C(129)
- DO 20 I=2,128
- E1 = 0.5*(C(I)-C(258-I))
- E2 = E(I-1)*(C(I)+C(258-I))
- B(I) = E2-E1
- 20 B(258-I) = E2+E1
- RETURN
- END
diff --git a/src/mathlib/gen/d/s64.F b/src/mathlib/gen/d/s64.F
deleted file mode 100644
index 62f9c34..0000000
--- a/src/mathlib/gen/d/s64.F
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: s64.F,v 1.1.1.1 1996/04/01 15:02:23 mclareni Exp $
-*
-* $Log: s64.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:23 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE S64(A,B)
- REAL A(32),B(32),C(32)
- COMMON /TAB/D(126),E(127)
- CALL D701BD
- DO 10 I=3,15,2
- A1 = A(I-1)-A(I+1)
- A2 = A(33-I)-A(35-I)
- C1R = A1+A2
- C2R = A1-A2
- C1I = A(I)-A(34-I)
- C2I = A(I)+A(34-I)
- C1 = D(8*I-9)
- C2 = D(8*I-8)
- C3R = C1*C2R-C2*C2I
- C3I = C1*C2I+C2*C2R
- C(I) = C1R+C3R
- C(I+1) = C1I+C3I
- C(34-I) = C1R-C3R
- 10 C(35-I) = C3I-C1I
- C(1) = 2.*(A(32)-A(2))
- C(2) = -2.*(A(32)+A(2))
- C(17) = 2.*(A(16)-A(18))
- C(18) = 2.*A(17)
- CALL I16(C,C(2),2,C,C(2),2)
- B(17) = 0.5*C(17)
- DO 20 I=2,16
- E1 = 0.5*(C(I)-C(34-I))
- E2 = E(8*I-8)*(C(I)+C(34-I))
- B(I) = E2-E1
- 20 B(34-I) = E2+E1
- RETURN
- END
diff --git a/src/mathlib/gen/d/scal.F b/src/mathlib/gen/d/scal.F
deleted file mode 100644
index e624921..0000000
--- a/src/mathlib/gen/d/scal.F
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: scal.F,v 1.1.1.1 1996/04/01 15:02:21 mclareni Exp $
-*
-* $Log: scal.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:21 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE SCAL (M,ER)
-C-----SUBROUTINE SCAL CALCULATES ER=VARIANCE OF THEORETICAL FUNCTION Y
-#include "d510pl.inc"
-#include "d510si.inc"
- ER=0.
- N=0
- DO 2 J=1,M
- IF (PL(J)) 2,2,1
- 1 N=N+1
- DF(N)=DF(J)
- 2 CONTINUE
- IF (N.EQ.0) RETURN
- DO 6 I=1,N
- DO 6 L=1,N
- IF (I-L) 3,3,4
- 3 K=L*(L-1)/2+I
- GO TO 5
- 4 K=I*(I-1)/2+L
- 5 ER=ER+Z(K)*DF(I)*DF(L)
- 6 CONTINUE
- RETURN
- END
diff --git a/src/mathlib/gen/d/sgz.F b/src/mathlib/gen/d/sgz.F
deleted file mode 100644
index caf05b3..0000000
--- a/src/mathlib/gen/d/sgz.F
+++ /dev/null
@@ -1,62 +0,0 @@
-*
-* $Id: sgz.F,v 1.1.1.1 1996/04/01 15:02:22 mclareni Exp $
-*
-* $Log: sgz.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:22 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE SGZ (M,S)
-C-----SUBROUTINE SGZ SETS UP S(OBJECTIVE FUNCTION),G(GRADIENT OF S) AND
-C-----Z(APPROXIMATE COVARIANCE MATRIX)
-#include "d510si.inc"
-#include "d510ui.inc"
- K=NED(1)
- K2=1
- DO 12 L1=1,K
- K1=K2
- NX=NED(2)-2
- IF (INDFLG(3)) 1,2,1
- 1 NX=NED(2)
- K1=K1-2
- 2 CONTINUE
- DO 3 I=1,NX
- KI=K1+1+I
- X(I)=EXDA(KI)
- 3 CONTINUE
- CALL ARITHM (Y)
- IF (INDFLG(3)) 4,6,4
- 4 IF (Y) 13,13,5
-C-----MAXIMUM LIKLEHOOD
- 5 S=S-LOG(Y)
- Y=-Y
- SIG=Y
- GO TO 7
-C-----CHI SQUARED
- 6 SIG=EXDA(K2+1)
- Y=Y-EXDA(K1)
- S=S+((Y/SIG)**2)/2.
- 7 CONTINUE
- N=0
- DO 9 J=1,M
- IF (PL0(J)) 9,9,8
- 8 N=N+1
- DF(N)=DF(J)/SIG
- G(J)=G(J)+DF(N)*(Y/SIG)
- 9 CONTINUE
- L=1
- IF (N.LT.1) GO TO 11
- DO 10 I=1,N
- DO 10 J=1,I
- Z(L)=Z(L)+DF(I)*DF(J)
- L=L+1
- 10 CONTINUE
- 11 K2=K2+NED(2)
- 12 CONTINUE
- RETURN
-C----- -VE OR ZERO Y IN MAXIMUM LIKLEHOOD
- 13 INDFLG(1)=1
- S=1.E10
- RETURN
- END
diff --git a/src/mathlib/gen/d/simps.F b/src/mathlib/gen/d/simps.F
deleted file mode 100644
index ad7d038..0000000
--- a/src/mathlib/gen/d/simps.F
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: simps.F,v 1.1.1.1 1996/04/01 15:02:13 mclareni Exp $
-*
-* $Log: simps.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:13 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-C This will be SIMPS,IF=DOUBLE and SIMPS64,IF=-DOUBLE
- FUNCTION SIMPS(F,A,B,N2)
-
- CHARACTER NAME*(*)
- CHARACTER*80 ERRTXT
- PARAMETER (NAME = 'SIMPS')
-#include "simpscod.inc"
- SIMPS=H
- RETURN
- 101 FORMAT('NON-POSITIVE OR EVEN NUMBER OF FUNCTION VALUES =',I6)
- END
diff --git a/src/mathlib/gen/d/simps128.F b/src/mathlib/gen/d/simps128.F
deleted file mode 100644
index 3d6255c..0000000
--- a/src/mathlib/gen/d/simps128.F
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: simps128.F,v 1.1.1.1 1996/04/01 15:02:13 mclareni Exp $
-*
-* $Log: simps128.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:13 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION DSIMPS(F,A,B,N2)
-#include "gen/imp128.inc"
- CHARACTER*(*) NAME
- PARAMETER( NAME='DSIMPS')
- DSIMPS=0
- CALL MTLPRT(NAME,'D101.0','Not available on this machine')
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/d/simps64.F b/src/mathlib/gen/d/simps64.F
deleted file mode 100644
index 0bcc6b6..0000000
--- a/src/mathlib/gen/d/simps64.F
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: simps64.F,v 1.1.1.1 1996/04/01 15:02:13 mclareni Exp $
-*
-* $Log: simps64.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:13 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- FUNCTION DSIMPS(F,A,B,N2)
-#include "gen/imp64.inc"
-
- CHARACTER NAME*(*)
- CHARACTER*80 ERRTXT
- PARAMETER (NAME = 'DSIMPS')
-#include "simpscod.inc"
-
- DSIMPS=H
- RETURN
- 101 FORMAT('NON-POSITIVE OR EVEN NUMBER OF FUNCTION VALUES =',I6)
- END
-#endif
diff --git a/src/mathlib/gen/d/simpscod.inc b/src/mathlib/gen/d/simpscod.inc
deleted file mode 100644
index abc5076..0000000
--- a/src/mathlib/gen/d/simpscod.inc
+++ /dev/null
@@ -1,35 +0,0 @@
-*
-* $Id: simpscod.inc,v 1.1.1.1 1996/04/01 15:02:13 mclareni Exp $
-*
-* $Log: simpscod.inc,v $
-* Revision 1.1.1.1 1996/04/01 15:02:13 mclareni
-* Mathlib gen
-*
-*
-*
-* simpscod.inc
-*
- DIMENSION F(0:*)
-
- IF(N2 .LE. 0 .OR. 2*(N2/2) .NE. N2) THEN
- H=0
- WRITE(ERRTXT,101) N2+1
- CALL MTLPRT(NAME,'D101.1',ERRTXT)
- ELSE
-* S1=0
- S1=F(N2-1)
- S2=0
-* DO 1 N = 1,N2-1,2
-* 1 S1=S1+F(N)
-* DO 2 N = 2,N2-2,2
-* 2 S2=S2+F(N)
-
- DO 1 N = 1,N2-3,2
- S1=S1+F(N)
- S2=S2+F(N+1)
- 1 CONTINUE
-* S1=S1+F(N2-1)
-
- S1=S1+S1+S2
- H=(F(0)+F(N2)+S1+S1)*(B-A)/(3*N2)
- ENDIF
diff --git a/src/mathlib/gen/d/synt.F b/src/mathlib/gen/d/synt.F
deleted file mode 100644
index 7d3763b..0000000
--- a/src/mathlib/gen/d/synt.F
+++ /dev/null
@@ -1,47 +0,0 @@
-*
-* $Id: synt.F,v 1.1.1.1 1996/04/01 15:02:19 mclareni Exp $
-*
-* $Log: synt.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:19 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE SYNT (MP,N,IBCX,POT)
- COMMON/FW1/W1(774)/FW2/W2(100)
- DIMENSION POT(MP,N)
- M=MP-1
- MD=MP+M
- AX=(1./LOG10(2.))+.01
- XM=M
- AM=AX*LOG10(XM)
- IM=INT(AM)
- IBC=IBCX+3
- IF(IBCX.EQ.4) GO TO 400
-C
-C THE RFT ROUTINE IS A MODIFIED
-C VERSION OF HOCKNEY FAST FOURIER
-C TRANSFORM PACKAGE AND CORRESPONDS TO
-C ISELIN LIBRARY PROGRAM D 700
-C
- DO 1 J=1,N
- 1 CALL RFT(IM,POT(1,J),1,POT(1,J),1,IBC)
- RETURN
-C
-C THE MFT ROUTINE IS USED FOR
-C THE FOURTH TYPE OF BOUNDARY
-C CONDITION ALONG X
-C
- 400 DO 2 J=1,N
- DO 3 I=1,MP
- 3 W1(I)=POT(I,J)
-C
- CALL MFT(MP,MD,W1,W1(MP+1),W1(4*MP+1),2)
-C
- DO 4 I=1,MP
- 4 POT(I,J)=W1(I+MP)
- 2 CONTINUE
- WRITE(6,1008)(POT(I,1),I=1,MP)
- 1008 FORMAT(7E11.4)
- RETURN
- END
diff --git a/src/mathlib/gen/d/traper.F b/src/mathlib/gen/d/traper.F
deleted file mode 100644
index b340515..0000000
--- a/src/mathlib/gen/d/traper.F
+++ /dev/null
@@ -1,56 +0,0 @@
-*
-* $Id: traper.F,v 1.1.1.1 1996/04/01 15:02:15 mclareni Exp $
-*
-* $Log: traper.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:15 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE TRAPER (X,Y,E,N,AA,BB,RE,SD)
- DIMENSION X(N),Y(N),E(N)
- RE=0.
- SD=0.
- IF(AA .EQ. BB .OR. N .LT. 2) RETURN
- A=AA
- B=BB
- IF(AA .LT. BB) GO TO 1
- A=BB
- B=AA
- 1 DO 40 I1 = 2,N
- I=I1
- IF(X(I) .GE. A) GO TO 41
- 40 CONTINUE
- 41 DO 42 J1 = 2,N
- J=J1
- IF(X(J) .GE. B) GO TO 43
- 42 CONTINUE
- 43 WI1=(X(I)-A)**2/(X(I)-X(I-1))
- WI=(1.0+(A-X(I-1))/(X(I)-X(I-1)))*(X(I)-A)
- WJ1=(1.0+(X(J)-B)/(X(J)-X(J-1)))*(B-X(J-1))
- WJ=(B-X(J-1))**2/(X(J)-X(J-1))
- IF(I .NE. J) GO TO 2
- WI1=WI1+WJ1+X(I-1)-X(I)
- WI=WI+WJ+X(I-1)-X(I)
- WJ1=0.
- WJ=0.
- GO TO 10
- 2 IF(I .NE. J-1) GO TO 3
- WI=WI+WJ1
- WJ1=0.
- GO TO 10
- 3 WI=WI+X(I+1)-X(I)
- WJ1=WJ1+X(J-1)-X(J-2)
- IF(I .EQ. J-2) GO TO 10
- LI=I+1
- LJ=J-2
- DO 4 L = LI,LJ
- RE=RE+(X(L+1)-X(L-1))*Y(L)
- 4 SD=SD+((X(L+1)-X(L-1))*E(L))**2
- 10 RE=RE+WI1*Y(I-1)+WI*Y(I)+WJ1*Y(J-1)+WJ*Y(J)
- SD=SD+(WI1*E(I-1))**2+(WI*E(I))**2+(WJ1*E(J-1))**2+(WJ*E(J))**2
- RE=0.5*RE
- SD=0.5*SQRT(SD)
- IF(AA .GT. BB) RE=-RE
- RETURN
- END
diff --git a/src/mathlib/gen/d/triint.F b/src/mathlib/gen/d/triint.F
deleted file mode 100644
index f05692c..0000000
--- a/src/mathlib/gen/d/triint.F
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: triint.F,v 1.1.1.1 1996/04/01 15:02:14 mclareni Exp $
-*
-* $Log: triint.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:14 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-C This will be TRIINT,IF=DOUBLE and TRIINT64,IF=-DOUBLE
- FUNCTION TRIINT(F,NSD,NPT,EPS,X1,Y1,X2,Y2,X3,Y3)
-C
-C INTEGRATION OVER A TRIANGLE USING A 7-, 25- OR 64-POINT FORMULA,
-C WITH OR WITHOUT SUBDIVISION OF THE TRIANGLE.
-C
- CHARACTER NAME*(*)
- CHARACTER*80 ERRTXT
- PARAMETER (NAME = 'TRIINT')
-#include "triintcod.inc"
-
- 99 TRIINT=H
- RETURN
- 101 FORMAT('INCORRECT NUMBER OF POINTS =',I5)
- END
diff --git a/src/mathlib/gen/d/triint128.F b/src/mathlib/gen/d/triint128.F
deleted file mode 100644
index cdbaea1..0000000
--- a/src/mathlib/gen/d/triint128.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: triint128.F,v 1.1.1.1 1996/04/01 15:02:14 mclareni Exp $
-*
-* $Log: triint128.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:14 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION DTRINT(F,NSD,NPT,EPS,X1,Y1,X2,Y2,X3,Y3)
-C
-#include "gen/imp128.inc"
-C
- CHARACTER NAME*(*)
- PARAMETER (NAME = 'DTRINT')
- DTRINT=0
- CALL MTLPRT(NAME,'D105.0','Not available on this machine')
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/d/triint64.F b/src/mathlib/gen/d/triint64.F
deleted file mode 100644
index 20d2f1f..0000000
--- a/src/mathlib/gen/d/triint64.F
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: triint64.F,v 1.1.1.1 1996/04/01 15:02:14 mclareni Exp $
-*
-* $Log: triint64.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:14 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- FUNCTION DTRINT(F,NSD,NPT,EPS,X1,Y1,X2,Y2,X3,Y3)
-C INTEGRATION OVER A TRIANGLE USING A 7-, 25- OR 64-POINT FORMULA,
-C WITH OR WITHOUT SUBDIVISION OF THE TRIANGLE.
-
-#include "gen/imp64.inc"
- CHARACTER NAME*(*)
- CHARACTER*80 ERRTXT
- PARAMETER (NAME = 'DTRINT')
-#include "triintcod.inc"
-
- 99 DTRINT=H
- RETURN
- 101 FORMAT('INCORRECT NUMBER OF POINTS =',I5)
- END
-#endif
diff --git a/src/mathlib/gen/d/triintcod.inc b/src/mathlib/gen/d/triintcod.inc
deleted file mode 100644
index 6fea767..0000000
--- a/src/mathlib/gen/d/triintcod.inc
+++ /dev/null
@@ -1,228 +0,0 @@
-*
-* $Id: triintcod.inc,v 1.1.1.1 1996/04/01 15:02:14 mclareni Exp $
-*
-* $Log: triintcod.inc,v $
-* Revision 1.1.1.1 1996/04/01 15:02:14 mclareni
-* Mathlib gen
-*
-*
-*
-* triintcod.inc
-*
- PARAMETER (Z1 = 1, HALF = Z1/2, KMX = 35)
-
- DIMENSION R(KMX),XP1(KMX),XP2(KMX),XP3(KMX),YP1(KMX),YP2(KMX)
- DIMENSION YP3(KMX)
- DIMENSION U(8,3),V(32,3),W(32,3),UU(5,2),WW(5,2)
- DIMENSION G1(32),G2(32)
- DIMENSION JZ(3),JZ0(3),JZ1(3),IZ(3,3)
-
- DATA JZ /2,5,8/, JZ0 /2,10,32/, JZ1 /3,5,0/
- DATA ((IZ(I,M),I=1,3),M=1,3) /1,0,1, 5,5,1, 8,24,8/
-
- DATA (U(J,1),J=1,2)
- 1/0.89871 34926 76543 661D0, 0.52985 79358 94884 910D0/
-
- DATA (UU(J,1),J=1,3)
- 1/0.20257 30146 46912 678D0, 0.94028 41282 10230 180D0,
- 2 0.66666 66666 66666 667D0/
-
- DATA (V(J,1),J=1,2)
- 1/0.69614 04780 29630 984D0,-0.41042 61923 15345 269D0/
-
- DATA (W(J,1),J=1,2)
- 1/0.12593 91805 44827 153D0, 0.13239 41527 88506 181D0/
-
- DATA (WW(J,1),J=1,3)
- 1/0.12593 91805 44827 153D0, 0.13239 41527 88506 181D0,
- 2 0.22500 00000 00000 000D0/
-
- DATA (U(J,2),J=1,5)
- 1/0.09853 50857 98826 426D0, 0.30453 57266 46363 905D0,
- 2 0.56202 51897 52613 856D0, 0.80198 65821 26391 827D0,
- 3 0.96019 01429 48531 258D0/
-
- DATA (UU(J,2),J=1,5)
- 1/0.09853 50857 98826 426D0, 0.30453 57266 46363 905D0,
- 2 0.56202 51897 52613 856D0, 0.80198 65821 26391 827D0,
- 3 0.96019 01429 48531 258D0/
-
- DATA (V(J,2),J=1,10)
- 1/0.08929 05088 68733 569D0, 0.27596 41378 55221 135D0,
- 2 0.50929 58998 63672 021D0, 0.72674 40774 36169 444D0,
- 3 0.87010 49558 08923 811D0, 0.05305 81196 71298 357D0,
- 4 0.16398 31426 29800 463D0, 0.30263 33161 88105 613D0,
- 5 0.43184 51615 91612 961D0, 0.51703 29238 43772 854D0/
-
- DATA (W(J,2),J=1,10)
- 1/0.00373 11043 33755 67687D0, 0.01751 09983 64327 66347D0,
- 2 0.03468 30128 62731 40026D0, 0.03960 81662 64094 70756D0,
- 3 0.02293 01607 03185 09559D0, 0.00753 74033 90655 24076D0,
- 4 0.03537 49042 20966 93175D0, 0.07006 50090 06743 44063D0,
- 5 0.08001 45747 72320 84819D0, 0.04632 24438 58996 77269D0/
-
- DATA (WW(J,2),J=1,5)
- 1/0.00895 88135 94562 71712D0, 0.04204 59349 74644 15024D0,
- 2 0.08327 79304 30389 93562D0, 0.09510 37941 15908 01948D0,
- 3 0.05505 79713 28939 62198D0/
-
- DATA (U(J,3),J=1,8)
- 1/0.04463 39552 89969 851D0, 0.14436 62570 42145 571D0,
- 2 0.28682 47571 44430 519D0, 0.45481 33151 96573 351D0,
- 3 0.62806 78354 16727 698D0, 0.78569 15206 04369 242D0,
- 4 0.90867 63921 00206 044D0, 0.98222 00848 52636 548D0/
-
- DATA (V(J,3),J=1,32)
- 1/0.04286 15345 20322 596D0, 0.13863 34522 58088 400D0,
- 2 0.27543 49048 78165 863D0, 0.43675 26131 83286 138D0,
- 3 0.60312 71715 43047 645D0, 0.75449 15975 72500 770D0,
- 4 0.87259 27221 72605 828D0, 0.94321 59843 32136 212D0,
- 5 0.03555 83759 33897 592D0, 0.11501 17574 55156 297D0,
- 6 0.22850 36689 09272 431D0, 0.36233 45216 98467 603D0,
- 7 0.50036 05900 18245 933D0, 0.62593 40960 53638 777D0,
- 8 0.72391 20204 03394 633D0, 0.78250 18150 44463 514D0,
- 9 0.02345 65900 87635 536D0, 0.07586 91469 73958 963D0,
- A 0.15073 57058 45778 370D0, 0.23901 91375 97290 126D0,
- B 0.33007 00031 37485 188D0, 0.41290 63582 74039 218D0,
- C 0.47753 88941 74496 369D0, 0.51618 84882 60827 229D0,
- D 0.00818 74136 31782 437D0, 0.02648 17727 48961 059D0,
- E 0.05261 35967 85690 189D0, 0.08342 85178 75344 723D0,
- F 0.11520 93988 52684 066D0, 0.14412 30431 93925 944D0,
- G 0.16668 27291 29138 200D0, 0.18017 31901 16990 201D0/
-
- DATA (W(J,3),J=1,32)
- 1/0.00033 35674 06495 41982D0, 0.00180 62109 19037 15084D0,
- 2 0.00459 97558 03491 41419D0, 0.00801 72595 31391 49525D0,
- 3 0.01073 50189 73158 61631D0, 0.01138 87974 04616 51588D0,
- 4 0.00922 38453 90918 29977D0, 0.00450 98127 16079 21752D0,
- 5 0.00073 27880 81649 19485D0, 0.00396 79231 50289 07586D0,
- 6 0.01010 48428 76312 33624D0, 0.01761 24888 63394 88637D0,
- 7 0.02358 29214 92410 93797D0, 0.02501 91560 68339 84265D0,
- 8 0.02026 31427 34638 24614D0, 0.00990 72539 59652 71520D0,
- 9 0.00103 37234 54873 38862D0, 0.00559 74371 44935 08001D0,
- A 0.01425 46165 12792 75399D0, 0.02484 54407 11607 46855D0,
- B 0.03326 77614 32852 32482D0, 0.03529 38169 93822 26192D0,
- C 0.02858 46432 80634 70277D0, 0.01397 58834 07425 66299D0,
- D 0.00119 51124 99230 79556D0, 0.00647 13314 41724 90169D0,
- E 0.01648 01043 12102 39366D0, 0.02872 44103 85925 30995D0,
- F 0.03846 16575 37508 13161D0, 0.04080 40290 04108 74571D0,
- G 0.03304 73922 30182 37768D0, 0.01615 78542 78398 33562D0/
-
- IF(NPT .EQ. 7) THEN
- M=1
- ELSE IF(NPT .EQ. 25) THEN
- M=2
- ELSE IF(NPT .EQ. 64) THEN
- M=3
- ELSE
- H=0
- WRITE(ERRTXT,101) NPT
- CALL MTLPRT(NAME,'D105.1',ERRTXT)
- GO TO 99
- END IF
- K=0
- C1=X1
- D1=Y1
- C2=X2
- D2=Y2
- C3=X3
- D3=Y3
- A11=HALF*(C2+C3)-C1
- A12=HALF*(C3-C2)
- A21=HALF*(D2+D3)-D1
- A22=HALF*(D3-D2)
- DO 1 J = 1,JZ(M)
- G1(J)=A11*U(J,M)+C1
- G2(J)=A21*U(J,M)+D1
- DO 1 I = IZ(1,M),IZ(2,M),IZ(3,M)
- G1(J+I)=G1(J)
- 1 G2(J+I)=G2(J)
- S=0
- DO 2 J = 1,JZ0(M)
- H1=A12*V(J,M)
- H2=A22*V(J,M)
- 2 S=S+W(J,M)*(F(G1(J)+H1,G2(J)+H2)+F(G1(J)-H1,G2(J)-H2))
- DO 3 J = 1,JZ1(M)
- 3 S=S+WW(J,M)*F(A11*UU(J,M)+C1,A21*UU(J,M)+D1)
- S=HALF*ABS(C1*(D2-D3)+C2*(D3-D1)+C3*(D1-D2))*S
- H=S
- IF(NSD .EQ. 0) GO TO 99
- H=0
-
- 10 K=K+1
- SUM0=S
- U1=C1
- V1=D1
- U2=C2
- V2=D2
- U3=C3
- V3=D3
- 11 C1=HALF*(U2+U3)
- D1=HALF*(V2+V3)
- C2=U1
- D2=V1
- C3=U2
- D3=V2
- XP1(K)=C1
- YP1(K)=D1
- XP2(K)=C2
- YP2(K)=D2
- XP3(K)=U3
- YP3(K)=V3
- A11=HALF*(C2+U3)-C1
- A12=HALF*(U3-C2)
- A21=HALF*(D2+V3)-D1
- A22=HALF*(V3-D2)
- DO 4 J = 1,JZ(M)
- G1(J)=A11*U(J,M)+C1
- G2(J)=A21*U(J,M)+D1
- DO 4 I = IZ(1,M),IZ(2,M),IZ(3,M)
- G1(J+I)=G1(J)
- 4 G2(J+I)=G2(J)
- S=0
- DO 5 J = 1,JZ0(M)
- H1=A12*V(J,M)
- H2=A22*V(J,M)
- 5 S=S+W(J,M)*(F(G1(J)+H1,G2(J)+H2)+F(G1(J)-H1,G2(J)-H2))
- DO 6 J = 1,JZ1(M)
- 6 S=S+WW(J,M)*F(A11*UU(J,M)+C1,A21*UU(J,M)+D1)
- S=HALF*ABS(C1*(D2-V3)+C2*(V3-D1)+U3*(D1-D2))*S
- R(K)=S
- A11=HALF*(C2+C3)-C1
- A12=HALF*(C3-C2)
- A21=HALF*(D2+D3)-D1
- A22=HALF*(D3-D2)
- DO 7 J = 1,JZ(M)
- G1(J)=A11*U(J,M)+C1
- G2(J)=A21*U(J,M)+D1
- DO 7 I = IZ(1,M),IZ(2,M),IZ(3,M)
- G1(J+I)=G1(J)
- 7 G2(J+I)=G2(J)
- S=0
- DO 8 J = 1,JZ0(M)
- H1=A12*V(J,M)
- H2=A22*V(J,M)
- 8 S=S+W(J,M)*(F(G1(J)+H1,G2(J)+H2)+F(G1(J)-H1,G2(J)-H2))
- DO 9 J = 1,JZ1(M)
- 9 S=S+WW(J,M)*F(A11*UU(J,M)+C1,A21*UU(J,M)+D1)
- S=HALF*ABS(C1*(D2-D3)+C2*(D3-D1)+C3*(D1-D2))*S
- SUM=S+R(K)
- IF(ABS(SUM0-SUM) .GT. EPS*(1+ABS(SUM))) THEN
- IF(K .LT. KMX) GO TO 10
- H=0
- CALL MTLPRT(NAME,'D105.2','TOO HIGH ACCURACY REQUIRED')
- GO TO 99
- ELSE
- H=H+SUM
- K=K-1
- IF(K .LE. 0) GO TO 99
- U1=XP1(K)
- V1=YP1(K)
- U2=XP2(K)
- V2=YP2(K)
- U3=XP3(K)
- V3=YP3(K)
- SUM0=R(K)
- GO TO 11
- END IF
-
diff --git a/src/mathlib/gen/d/vd01a.F b/src/mathlib/gen/d/vd01a.F
deleted file mode 100644
index 5089069..0000000
--- a/src/mathlib/gen/d/vd01a.F
+++ /dev/null
@@ -1,105 +0,0 @@
-*
-* $Id: vd01a.F,v 1.1.1.1 1996/04/01 15:02:20 mclareni Exp $
-*
-* $Log: vd01a.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:20 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE VD01A (ITEST,X,F,MAXFUN,ABSACC,RELACC,XSTEP)
- GO TO (1,2,2),ITEST
- 2 IS=6-ITEST
- ITEST=1
- IINC=1
- XINC=XSTEP+XSTEP
- MC=IS-3
- IF (MC) 4,4,15
- 3 MC=MC+1
- IF (MAXFUN-MC) 12,15,15
- 12 ITEST=4
- 43 X=DB
- F=FB
- IF (FB-FC) 15,15,44
- 44 X=DC
- F=FC
- 15 RETURN
- 1 GO TO (5,6,7,8),IS
- 8 IS=3
- 4 DC=X
- FC=F
- X=X+XSTEP
- GO TO 3
- 7 IF (FC-F) 9,10,11
- 10 X=X+XINC
- XINC=XINC+XINC
- GO TO 3
- 9 DB=X
- FB=F
- XINC=-XINC
- GO TO 13
- 11 DB=DC
- FB=FC
- DC=X
- FC=F
- 13 X=DC+DC-DB
- IS=2
- GO TO 3
- 6 DA=DB
- DB=DC
- FA=FB
- FB=FC
- 32 DC=X
- FC=F
- GO TO 14
- 5 IF (FB-FC) 16,17,17
- 17 IF (F-FB) 18,32,32
- 18 FA=FB
- DA=DB
- 19 FB=F
- DB=X
- GO TO 14
- 16 IF (FA-FC) 21,21,20
- 20 XINC=FA
- FA=FC
- FC=XINC
- XINC=DA
- DA=DC
- DC=XINC
- 21 XINC=DC
- IF ((D-DB)*(D-DC)) 32,22,22
- 22 IF (F-FA) 23,24,24
- 23 FC=FB
- DC=DB
- GO TO 19
- 24 FA=F
- DA=X
- 14 IF (FB-FC) 25,25,29
- 25 IINC=2
- XINC=DC
- IF (FB-FC) 29,45,29
- 29 D=(FA-FB)/(DA-DB)-(FA-FC)/(DA-DC)
- IF (D*(DB-DC)) 33,33,37
- 37 D=0.5*(DB+DC-(FB-FC)/D)
- IF (ABS (D-X)-ABS (ABSACC)) 34,34,35
- 35 IF (ABS (D-X)-ABS (D*RELACC)) 34,34,36
- 34 ITEST=2
- GO TO 43
- 36 IS=1
- X=D
- IF ((DA-DC)*(DC-D)) 3,26,38
- 38 IS=2
- GO TO (39,40),IINC
- 39 IF (ABS (XINC)-ABS (DC-D)) 41,3,3
- 33 IS=2
- GO TO (41,42),IINC
- 41 X=DC
- GO TO 10
- 40 IF (ABS (XINC-X)-ABS (X-DC)) 42,42,3
- 42 X=0.5*(XINC+DC)
- IF ((XINC-X)*(X-DC)) 26,26,3
- 45 X=0.5*(DB+DC)
- IF ((DB-X)*(X-DC)) 26,26,3
- 26 ITEST=3
- GO TO 43
- END
diff --git a/src/mathlib/gen/divon/Imakefile b/src/mathlib/gen/divon/Imakefile
deleted file mode 100644
index e3070e4..0000000
--- a/src/mathlib/gen/divon/Imakefile
+++ /dev/null
@@ -1,15 +0,0 @@
-SRCS_F= addbnd.F bfgs.F bndopt.F bndtst.F bounds.F bucmve.F \ @@\
- bufopt.F delbnd.F delete.F delslv.F divon.F dvcopy.F dvdot.F \ @@\
- dvnbkd.F dvnopt.F exmbuc.F feasmv.F feqn.F fun.F genpnt.F \ @@\
- grdcmp.F intgrl.F ldlsol.F locsch.F modchl.F mulchk.F mxstep.F \ @@\
- newptq.F nmdchl.F nocut.F nodaud.F orthvc.F partn.F quad.F \ @@\
- quasi.F ranums.F recpar.F rlen.F settol.F shrnk.F split.F \ @@\
- treaud.F tredmp.F tstext.F usrint.F usrtrm.F
-
-FORTRANSAVEOPTION = FortranSaveFlags
-
-#if defined(CERNLIB_SGI)
-IMAKE_DEFINES=-DFortranDoesCpp=NO
-#endif
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/mathlib/gen/divon/addbnd.F b/src/mathlib/gen/divon/addbnd.F
deleted file mode 100644
index 079c3e1..0000000
--- a/src/mathlib/gen/divon/addbnd.F
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: addbnd.F,v 1.1.1.1 1996/04/01 15:03:27 mclareni Exp $
-*
-* $Log: addbnd.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:27 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE ADDBND (N,NFREE,IFREE,NACTV,IACTV,INEW,IDNEW,NADIM,AHES
- 1S,XTEMP,GFREE,GNORM)
- INTEGER N, NFREE, NACTV, INEW, IDNEW, NADIM
- INTEGER IFREE(N), IACTV(N)
- DOUBLE PRECISION GNORM
- DOUBLE PRECISION AHESS(NADIM, N), XTEMP(N), GFREE(N)
- INTEGER I, INPOS, NFRM1
- DOUBLE PRECISION RNEW
- CALL DELETE(NFREE,IFREE,INEW,INPOS)
- IF(INPOS.EQ.0) RETURN
- NACTV=NACTV+1
- IACTV(NACTV)=IDNEW*INEW
- RNEW=GNORM*GNORM-GFREE(INPOS)**2
- IF(RNEW.LT.0.0D+0) RNEW=0.0D+0
- GNORM=SQRT(RNEW)
- CALL SHRNK(NFREE,NADIM,AHESS,INPOS,XTEMP)
- IF(INPOS.EQ.NFREE) GOTO 20
- NFRM1=NFREE-1
- DO 10 I=INPOS,NFRM1
- GFREE(I)=GFREE(I+1)
- 10 CONTINUE
- 20 NFREE=NFREE-1
- RETURN
- END
diff --git a/src/mathlib/gen/divon/bfgs.F b/src/mathlib/gen/divon/bfgs.F
deleted file mode 100644
index 5cd219e..0000000
--- a/src/mathlib/gen/divon/bfgs.F
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: bfgs.F,v 1.1.1.1 1996/04/01 15:03:26 mclareni Exp $
-*
-* $Log: bfgs.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:26 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE BFGS (N,NADIM,AHESS,EPSMCH,G,GNEW,P,ALPHA,Y)
- INTEGER N, NADIM
- DOUBLE PRECISION EPSMCH, ALPHA
- DOUBLE PRECISION AHESS(NADIM, N), G(N), GNEW(N), P(N), Y(N)
- INTEGER I, IFAIL, IP1, J, NM1
- DOUBLE PRECISION CONST, DVDOT, GTP, YTP
- DO 10 I=1,N
- Y(I)=GNEW(I)-G(I)
- 10 CONTINUE
- YTP=DVDOT(N,Y,P)
- IF(YTP.LE.0.0D+0) RETURN
- GTP=DVDOT(N,G,P)
- CONST=ALPHA*YTP
- IF(CONST.LT.1.0D-10) RETURN
- CONST=1.0D+0/CONST
- CALL MODCHL(N,NADIM,AHESS,CONST,Y,IFAIL)
- IF(GTP.GE.0.0D+0) RETURN
- CONST=1.0D+0/SQRT(-GTP)
- DO 20 I=1,N
- Y(I)=G(I)*CONST
- 20 CONTINUE
- CALL NMDCHL(N,NADIM,AHESS,EPSMCH,Y,P)
- NM1=N-1
- IF(NM1.EQ.0) RETURN
- DO 40 I=1,NM1
- IP1=I+1
- DO 30 J=IP1,N
- AHESS(I,J)=AHESS(J,I)
- 30 CONTINUE
- 40 CONTINUE
- RETURN
- END
diff --git a/src/mathlib/gen/divon/bndopt.F b/src/mathlib/gen/divon/bndopt.F
deleted file mode 100644
index 55d7051..0000000
--- a/src/mathlib/gen/divon/bndopt.F
+++ /dev/null
@@ -1,235 +0,0 @@
-*
-* $Id: bndopt.F,v 1.1.1.1 1996/04/01 15:03:26 mclareni Exp $
-*
-* $Log: bndopt.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:26 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE BNDOPT (N,XMIN,XMAX,XLOW,XHI,FMIN,FMAX,FLOBD,FUPBD,X,XT
- 1EMP,GFREE,PFREE,GACTV,GNEW,AHESS,DELTA,FTOL,GTOL,ETA,ALFMAX,MAXFUN
- 2,NFCNT,IFREE,IACTV,IPRINT,IRESLT)
- INTEGER N, MAXFUN, NFCNT, IPRINT, IRESLT
- INTEGER IFREE(N), IACTV(N)
- DOUBLE PRECISION FMIN, FMAX, FLOBD, FUPBD, DELTA, FTOL, GTOL,
- 1 ETA, ALFMAX
- DOUBLE PRECISION XMIN(N), XMAX(N), XLOW(N), XHI(N), X(N),
- 1 XTEMP(N), GFREE(N), PFREE(N), GACTV(N), GNEW(N),
- 2 AHESS(N,N)
- INTEGER I, IBDEL, IBTRUE, IDNEW, II, IIMIN, ILOC, INEW, IPCNT,
- 1 ITER, ITEST, J, NACTV, NADIM, NFREE
- LOGICAL LOCAL, NEGMUL, XALTER
- DOUBLE PRECISION A, ALPHA, ALRAT, B, BTOL, B1, D, DEL, DFUN,
- 1 DVDOT, DXNORM, E, EPSMCH, FA, FBD, FBEST, FDIFF,
- 2 FOLD, FRAT, FTEST, FTRUE, FU, FV, FW, FY, FZ,
- 3 GNORM, GTEST1, GTEST2, GTP, GU, OLDF, PE,
- 4 PNORM, QEPS, R, RR, RTEPS, SCXBD, SFTBND, SS,
- 5 STEPMX, T, TOL, U, XBEST, XLAMDA, XNORM, XRAT,
- 6 XV, XW, ZTOL1, ZTOL2
- DATA EPSMCH/2.22D-16/
- RTEPS=SQRT(EPSMCH)
- QEPS=SQRT(RTEPS)
- ZTOL1=ABS(FTOL)
- NADIM=N
- NFCNT=0
- DO 10 I=1,N
- IFREE(I)=0
- IACTV(I)=0
- 10 CONTINUE
- IF(IPRINT.LT.0) GOTO 20
- WRITE(6,310)
- WRITE(6,320) (XLOW(I),I=1,N)
- WRITE(6,330) (XHI(I),I=1,N)
- 20 DO 300 IIMIN=1,2
- IF(IIMIN.EQ.2) GOTO 30
- CALL DVCOPY(N,XMIN,X)
- FTRUE=FMIN
- FBEST=FTRUE
- FBD=FLOBD
- GOTO 40
- 30 CALL DVCOPY(N,XMAX,X)
- FTRUE=FMAX
- FBEST=-FTRUE
- FBD=FUPBD
- 40 ITER=0
- GNORM=0.0D+0
- IPCNT=0
- FOLD=FBEST
- LOCAL=.FALSE.
- DO 60 J=1,N
- DO 50 I=1,N
- AHESS(I,J)=0.0D+0
- 50 CONTINUE
- AHESS(J,J)=1.0D+0
- 60 CONTINUE
- BTOL=QEPS
- 70 CALL BNDTST(N,X,XLOW,XHI,BTOL,NFREE,IFREE,NACTV,IACTV,XALTER)
- IF(.NOT.XALTER) GOTO 80
- FTRUE=DFUN(N,X)
- FBEST=FTRUE
- IF(IIMIN.EQ.2) FBEST=-FTRUE
- FOLD=FBEST
- 80 IF(IPRINT.LT.0) GOTO 90
- IF(IIMIN.EQ.1) WRITE(6,340) FTRUE
- IF(IIMIN.EQ.2) WRITE(6,350) FTRUE
- IF(LOCAL) WRITE(6,450) NFCNT
- WRITE(6,360) (X(I),I=1,N)
- WRITE(6,370) NFREE,NACTV
- IF(NFREE.GT.0.AND.NFREE.LT.N) WRITE(6,380) (IFREE(I),I=1,NFREE)
- IF(NACTV.GT.0.AND.NACTV.LT.N) WRITE(6,390) (IACTV(I),I=1,NACTV)
- 90 FTEST=RTEPS*(1.0D+0+ABS(FBD))
- IF(ABS(FBD-FBEST).LT.FTEST) GOTO 250
- IF(NFREE.EQ.0) GOTO 250
- CALL GRDCMP(N,NFREE,IFREE,X,FTRUE,DELTA,XHI,XTEMP,GFREE)
- NFCNT=NFCNT+NFREE
- IF(IIMIN.EQ.1) GOTO 110
- DO 100 I=1,NFREE
- GFREE(I)=-GFREE(I)
- 100 CONTINUE
- 110 CALL RLEN(NFREE,GFREE,GNORM)
- IF(GNORM.GT.GTOL.OR.LOCAL) GOTO 120
- IF(IPRINT.GT.0) WRITE(6,440)
- DEL=DELTA
- IF(DELTA.LT.1.0D+0) DEL=SQRT(DELTA)
- ZTOL2=10.0D+0*SQRT(RTEPS*DEL)
- IF(ZTOL2.LT.RTEPS) ZTOL2=RTEPS
- LOCAL=.TRUE.
- CALL LOCSCH(IIMIN,N,NFREE,IFREE,X,FBEST,XLOW,XHI,DEL,ZTOL2,NFCNT,
- 1GNEW,FY,XTEMP,FZ,PFREE)
- FTEST=RTEPS*(1.0D+0+ABS(FBEST))
- IF(FZ.GE.FBEST.OR.ABS(FZ-FBEST).LT.FTEST) GOTO 250
- CALL DVCOPY(N,XTEMP,X)
- FBEST=FZ
- FTRUE=FZ
- IF(IIMIN.EQ.2) FTRUE=-FZ
- GOTO 70
- 120 ITER=ITER+1
- IF(NFCNT.GT.MAXFUN) GOTO 270
- IF(IPCNT.GE.IPRINT) IPCNT=0
- IPCNT=IPCNT+1
- IF(NFREE.EQ.0) GOTO 250
- CALL LDLSOL(NFREE,NADIM,AHESS,GFREE,PFREE)
- DO 130 I=1,NFREE
- PFREE(I)=-PFREE(I)
- 130 CONTINUE
- CALL RLEN(NFREE,PFREE,PNORM)
- PE=PNORM+RTEPS
- CALL FEASMV(N,NFREE,IFREE,X,PFREE,XLOW,XHI,EPSMCH,STEPMX,INEW,IDN
- 1EW)
- IF((STEPMX*PE).GT.DELTA) GOTO 140
- CALL ADDBND(N,NFREE,IFREE,NACTV,IACTV,INEW,IDNEW,NADIM,AHESS,XTEM
- 1P,GFREE,GNORM)
- ITER=ITER-1
- GOTO 120
- 140 GTP=DVDOT(NFREE,GFREE,PFREE)
- XLAMDA=MIN(STEPMX,ALFMAX)
- U=MIN(1.0D+0,XLAMDA)
- FU=FBEST
- GU=GTP
- ILOC=1
- SFTBND=DELTA/PE
- T=RTEPS/PE
- DO 150 I=1,N
- XTEMP(I)=X(I)
- 150 CONTINUE
- 160 CALL NEWPTQ(RTEPS,T,ETA,SFTBND,XLAMDA,U,FU,GU,XBEST,FBEST,XW,FW,X
- 1V,FV,A,FA,B,OLDF,B1,SCXBD,E,D,RR,SS,GTEST1,GTEST2,TOL,ILOC,ITEST)
- IF(ITEST.NE.1) GOTO 180
- R=XBEST+U
- DO 170 I=1,NFREE
- II=IFREE(I)
- XTEMP(II)=X(II)+R*PFREE(I)
- 170 CONTINUE
- FU=DFUN(N,XTEMP)
- NFCNT=NFCNT+1
- IF(IIMIN.EQ.2) FU=-FU
- GOTO 160
- 180 IF(ITEST.NE.0) GOTO 250
- ALPHA=XBEST
- DO 190 I=1,NFREE
- II=IFREE(I)
- X(II)=X(II)+XBEST*PFREE(I)
- 190 CONTINUE
- FTRUE=FBEST
- IF(IIMIN.EQ.2) FTRUE=-FBEST
- IF(IPRINT.LE.0.OR.IPCNT.LT.IPRINT) GOTO 200
- WRITE(6,400) ITER,NFCNT,FBEST
- WRITE(6,360) (X(I),I=1,N)
- WRITE(6,370) NFREE,NACTV
- IF(NFREE.GT.0.AND.NFREE.LT.N) WRITE(6,380) (IFREE(I),I=1,NFREE)
- IF(NACTV.GT.0.AND.NACTV.LT.N) WRITE(6,390) (IACTV(I),I=1,NACTV)
- 200 CALL GRDCMP(N,NFREE,IFREE,X,FTRUE,DELTA,XHI,XTEMP,GNEW)
- CALL RLEN(NFREE,GNEW,GNORM)
- IF(IPRINT.GT.0.AND.IPCNT.EQ.IPRINT) WRITE(6,460) GNORM
- IF(IIMIN.EQ.1) GOTO 220
- DO 210 I=1,NFREE
- GNEW(I)=-GNEW(I)
- 210 CONTINUE
- 220 NFCNT=NFCNT+NFREE
- CALL BFGS(NFREE,NADIM,AHESS,EPSMCH,GFREE,GNEW,PFREE,ALPHA,XTEMP)
- DO 230 I=1,NFREE
- GFREE(I)=GNEW(I)
- 230 CONTINUE
- ALRAT=ABS(ALPHA-STEPMX)/STEPMX
- IF(ALRAT.GE.QEPS) GOTO 240
- CALL ADDBND(N,NFREE,IFREE,NACTV,IACTV,INEW,IDNEW,NADIM,AHESS,XTEM
- 1P,GFREE,GNORM)
- GOTO 120
- 240 FDIFF=FOLD-FBEST
- FRAT=FDIFF/(1.0D+0+ABS(FBEST))
- IF(FTOL.LT.0.0D+0) FRAT=FDIFF/MAX(ABS(FBEST),EPSMCH)
- CALL RLEN(N,X,XNORM)
- DXNORM=ALPHA*PNORM
- XRAT=DXNORM/(1.0D+0+XNORM)
- IF(FTOL.LT.0.0D+0) XRAT=DXNORM/MAX(XNORM,EPSMCH)
- FOLD=FBEST
- IF(FRAT.GT.ZTOL1.OR.XRAT.GT.ZTOL1) GOTO 120
- 250 IF(NACTV.EQ.0) GOTO 270
- CALL MULCHK(N,NACTV,IACTV,IIMIN,RTEPS,X,XHI,FTRUE,DELTA,XTEMP,GAC
- 1TV,NEGMUL,IBDEL,IBTRUE)
- NFCNT=NFCNT+NACTV
- IF(IPRINT.LE.0.OR.IPCNT.LT.IPRINT) GOTO 260
- WRITE(6,420) ITER,NACTV
- WRITE(6,390) (IACTV(I),I=1,NACTV)
- WRITE(6,430) (GACTV(I),I=1,NACTV)
- 260 IF(.NOT.NEGMUL) GOTO 270
- CALL DELBND(N,NACTV,IACTV,NFREE,IFREE,IBDEL,IBTRUE,GACTV,NADIM,AH
- 1ESS,GFREE,GNORM)
- GOTO 120
- 270 IF(IPRINT.LT.0) GOTO 280
- WRITE(6,410) ITER,NFCNT,FTRUE
- WRITE(6,360) (X(I),I=1,N)
- WRITE(6,370) NFREE,NACTV
- IF(NFREE.GT.0.AND.NFREE.LT.N) WRITE(6,380) (IFREE(I),I=1,NFREE)
- IF(NACTV.GT.0.AND.NACTV.LT.N) WRITE(6,390) (IACTV(I),I=1,NACTV)
- 280 IF(IIMIN.EQ.2) GOTO 290
- FMIN=FBEST
- CALL DVCOPY(N,X,XMIN)
- GOTO 300
- 290 FMAX=-FBEST
- CALL DVCOPY(N,X,XMAX)
- 300 CONTINUE
- RETURN
- 310 FORMAT('-START OF OPTIMIZATION')
- 320 FORMAT(' LOWER BOUNDS', 6(1PD16.6))
- 330 FORMAT(' UPPER BOUNDS', 6(1PD16.6))
- 340 FORMAT(' MINIMIZATION STEP -- INITIAL FMIN =', 1PD16.6)
- 350 FORMAT('0MAXIMIZATION STEP -- INITIAL FMAX =', 1PD16.6)
- 360 FORMAT(' X ARRAY'/6(1PD16.6))
- 370 FORMAT(1X,I5,' FREE VARIABLES',I5,' FIXED VARIABLES')
- 380 FORMAT(' INDICES OF FREE VARIABLES'/10I8)
- 390 FORMAT(' INDICES OF FIXED VARIABLES'/10I8)
- 400 FORMAT('0 AFTER ITERATION',I5,' AND',I5,
- 1 ' FUNCTION EVALUATIONS, THE FUNCTION VALUE IS',1PD16.6)
- 410 FORMAT('0*** FINAL RESULT ***'/' AFTER',I5,
- 1 ' ITERATIONS AND', I6,' FUNCTION EVALUATIONS',
- 2 ' THE BEST FUNCTION VALUE IS', 1PD17.7)
- 420 FORMAT('0 AT ITERATION',I6,' CHECK MULTIPLIERS',
- 1 ' FOR THE',I5,' FIXED VARIABLES')
- 430 FORMAT(' GRADIENT WITH RESPECT TO FIXED VARIABLES'/
- 1 1X,6(1PD16.6))
- 440 FORMAT(' EXECUTE LOCAL SEARCH')
- 450 FORMAT(1X,I5,' FUNCTION EVALUATIONS AFTER LOCAL SEARCH')
- 460 FORMAT(' NORM OF PROJECTED GRADIENT =', 1PD16.6)
- END
diff --git a/src/mathlib/gen/divon/bndtst.F b/src/mathlib/gen/divon/bndtst.F
deleted file mode 100644
index b019a4a..0000000
--- a/src/mathlib/gen/divon/bndtst.F
+++ /dev/null
@@ -1,42 +0,0 @@
-*
-* $Id: bndtst.F,v 1.1.1.1 1996/04/01 15:03:26 mclareni Exp $
-*
-* $Log: bndtst.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:26 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE BNDTST (N,X,XLOW,XHI,BNDTOL,NFREE,IFREE,NACTV,IACTV,XAL
- 1TER)
- INTEGER N, NFREE, NACTV
- INTEGER IFREE(N), IACTV(N)
- LOGICAL XALTER
- DOUBLE PRECISION BNDTOL
- DOUBLE PRECISION X(N), XLOW(N), XHI(N)
- INTEGER I
-CMM DOUBLE PRECISION DABS, XDENOM
- DOUBLE PRECISION XDENOM
- XALTER=.FALSE.
- NFREE=0
- NACTV=0
- DO 30 I=1,N
- XDENOM=1.0D+0+ABS(XHI(I))
- IF((X(I)-XHI(I))/XDENOM.GE.(-BNDTOL)) GOTO 10
- XDENOM=1.0D+0+ABS(XLOW(I))
- IF((X(I)-XLOW(I))/XDENOM.LE.BNDTOL) GOTO 20
- NFREE=NFREE+1
- IFREE(NFREE)=I
- GOTO 30
- 10 X(I)=XHI(I)
- XALTER=.TRUE.
- NACTV=NACTV+1
- IACTV(NACTV)=-I
- GOTO 30
- 20 X(I)=XLOW(I)
- XALTER=.TRUE.
- NACTV=NACTV+1
- IACTV(NACTV)=I
- 30 CONTINUE
- RETURN
- END
diff --git a/src/mathlib/gen/divon/bounds.F b/src/mathlib/gen/divon/bounds.F
deleted file mode 100644
index 2061683..0000000
--- a/src/mathlib/gen/divon/bounds.F
+++ /dev/null
@@ -1,35 +0,0 @@
-*
-* $Id: bounds.F,v 1.1.1.1 1996/04/01 15:03:24 mclareni Exp $
-*
-* $Log: bounds.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:24 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE BOUNDS (BUCKET,PARENT,TREE,PARTN,UMINUS,UPLUS)
- INTEGER BUCKET,PARENT,TREE(4,1000),JTREE
- REAL PARTN(18001),UMINUS(10),UPLUS(10)
- 10 JTREE=TREE(4,PARENT)
- IF((BUCKET.GT.TREE(1,PARENT).OR.JTREE.GE.0).AND.(BUCKET.LE.TREE(1
- 1,PARENT).OR.JTREE.LE.0)) GOTO 30
- UPLUS(ABS(JTREE))=PARTN(PARENT)
- IF(TREE(2,PARENT).GE.0) GOTO 20
- IF(BUCKET.NE.-TREE(2,PARENT)) GOTO 60
- GOTO 50
- 20 PARENT=TREE(2,PARENT)
- GOTO 10
- 30 UMINUS(ABS(JTREE))=PARTN(PARENT)
- IF(TREE(3,PARENT).GE.0) GOTO 40
- IF(BUCKET.NE.-TREE(3,PARENT)) GOTO 80
- GOTO 50
- 40 PARENT=TREE(3,PARENT)
- GOTO 10
- 50 RETURN
- 60 WRITE(6,70) BUCKET,TREE(2,PARENT)
- 70 FORMAT(' LOOKING FOR LEFT BUCKET ',I5,' BUT FOUND ',I6)
- STOP
- 80 WRITE(6,90) BUCKET,TREE(3,PARENT)
- 90 FORMAT(' LOOKING FOR RIGHT BUCKET ',I5,' BUT FOUND ',I6)
- STOP
- END
diff --git a/src/mathlib/gen/divon/bucmve.F b/src/mathlib/gen/divon/bucmve.F
deleted file mode 100644
index 319c287..0000000
--- a/src/mathlib/gen/divon/bucmve.F
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: bucmve.F,v 1.1.1.1 1996/04/01 15:03:25 mclareni Exp $
-*
-* $Log: bucmve.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:25 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE BUCMVE (NEWSTR,NEWEND,OLDSTR,SCR,BUCKTS,ISCR,IBUC)
- INTEGER NEWSTR,NEWEND,OLDSTR
- REAL SCR(ISCR),BUCKTS(IBUC)
- COMMON /BUKSZE/ MAXWRD
- INTEGER MAXWRD
- DO 70 I=1,MAXWRD
- DO 10 J=NEWSTR,NEWEND
- SCR(J)=BUCKTS(I+MAXWRD*(OLDSTR+J-NEWSTR-1))
- 10 CONTINUE
- J=NEWEND+1
- GOTO 30
- 20 J=J+1
- 30 IF((J).GT.(OLDSTR+NEWEND-NEWSTR-1)) GOTO 40
- SCR(J)=BUCKTS(I+MAXWRD*(NEWSTR+J-NEWEND-1))
- GOTO 20
- 40 J=NEWSTR
- GOTO 60
- 50 J=J+1
- 60 IF((J).GT.(OLDSTR+NEWEND-NEWSTR-1)) GOTO 70
- BUCKTS(I+MAXWRD*(J-1))=SCR(J)
- GOTO 50
- 70 CONTINUE
- RETURN
- END
diff --git a/src/mathlib/gen/divon/bufopt.F b/src/mathlib/gen/divon/bufopt.F
deleted file mode 100644
index 3aa6160..0000000
--- a/src/mathlib/gen/divon/bufopt.F
+++ /dev/null
@@ -1,76 +0,0 @@
-*
-* $Id: bufopt.F,v 1.1.1.1 1996/04/01 15:03:25 mclareni Exp $
-*
-* $Log: bufopt.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:25 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE BUFOPT (N,RXMIN,RXMAX,RXLOW,RXHI,RFMIN,RFMAX,RFLOBD,RFU
- 1PBD,W,LENW,IW,LENIW,NFCNT,IRESLT)
- INTEGER N, LENW, LENIW, NFCNT, IRESLT
- INTEGER IW(LENIW)
- REAL RXMIN(N), RXMAX(N), RXLOW(N), RXHI(N), RFMIN, RFMAX,
- 1 RFLOBD, RFUPBD
- DOUBLE PRECISION W(LENW)
- INTEGER I, IPRINT, IXHI, IXLOW, IXMAX, JAHESS, JGACTV, JGFREE,
- 1 JGNEW, JIACTV, JIFREE, JPFREE, JX, JXHI, JXLOW, JXMAX,
- 2 JXMIN, JXTEMP, MAXFUN
- REAL RFDIF, SNGL
- DOUBLE PRECISION ALFMAX, DELTA, ETA, FLOBD, FMAX, FMIN,
- 1 FTOL, FUPBD, GTOL
- JXMIN=1
- JXMAX=JXMIN+N
- JXLOW=JXMAX+N
- JXHI=JXLOW+N
- DO 10 I=1,N
- W(I)=DBLE(RXMIN(I))
- IXMAX=JXMAX-1+I
- W(IXMAX)=DBLE(RXMAX(I))
- IXLOW=JXLOW-1+I
- W(IXLOW)=DBLE(RXLOW(I))
- IXHI=JXHI-1+I
- W(IXHI)=DBLE(RXHI(I))
- 10 CONTINUE
- FMAX=DBLE(RFMAX)
- FMIN=DBLE(RFMIN)
- FLOBD=DBLE(RFLOBD)
- FUPBD=DBLE(RFUPBD)
- CALL SETTOL(N,FTOL,GTOL,DELTA,ETA,ALFMAX,MAXFUN,IPRINT)
- IF(IPRINT.LT.0) GOTO 20
- WRITE(6,70) (RXLOW(I),I=1,N)
- WRITE(6,80) (RXHI(I),I=1,N)
- 20 JX=JXHI+N
- JXTEMP=JX+N
- JGFREE=JXTEMP+N
- JPFREE=JGFREE+N
- JGACTV=JPFREE+N
- JGNEW=JGACTV+N
- JAHESS=JGNEW+N
- JIFREE=1
- JIACTV=JIFREE+N
- CALL BNDOPT(N,W(JXMIN),W(JXMAX),W(JXLOW),W(JXHI),FMIN,FMAX,FLOBD,
- 1FUPBD,W(JX),W(JXTEMP),W(JGFREE),W(JPFREE),W(JGACTV),W(JGNEW),W(JAH
- 2ESS),DELTA,FTOL,GTOL,ETA,ALFMAX,MAXFUN,NFCNT,IW(JIFREE),IW(JIACTV)
- 3,IPRINT,IRESLT)
- DO 30 I=1,N
- RXMIN(I)=SNGL(W(I))
- IXMAX=N+I
- RXMAX(I)=SNGL(W(IXMAX))
- 30 CONTINUE
- RFMIN=SNGL(FMIN)
- RFMAX=SNGL(FMAX)
- RFDIF=RFMAX-RFMIN
- IF(IPRINT.LT.0) RETURN
- WRITE(6,40) RFDIF,RFMAX,RFMIN,NFCNT
- WRITE(6,50) (RXMIN(I),I=1,N)
- WRITE(6,60) (RXMAX(I),I=1,N)
- RETURN
- 40 FORMAT('0 END OF OPTIMIZATION -- FDIF =', 1PE15.5, 4X,
- 1 'FMAX =',1PE15.5,4X,'FMIN =',1PE15.5,4X,'NFCNT =',I7)
- 50 FORMAT(' XMIN',5(1PE15.5))
- 60 FORMAT(' XMAX',5(1PE15.5))
- 70 FORMAT(' LOWER BOUNDS',5(1PE15.5))
- 80 FORMAT(' UPPER BOUNDS',5(1PE15.5))
- END
diff --git a/src/mathlib/gen/divon/d151dt.inc b/src/mathlib/gen/divon/d151dt.inc
deleted file mode 100644
index 183b9e1..0000000
--- a/src/mathlib/gen/divon/d151dt.inc
+++ /dev/null
@@ -1,13 +0,0 @@
-*
-* $Id: d151dt.inc,v 1.1.1.1 1996/04/01 15:03:23 mclareni Exp $
-*
-* $Log: d151dt.inc,v $
-* Revision 1.1.1.1 1996/04/01 15:03:23 mclareni
-* Mathlib gen
-*
-*
-*
-* d151dt.inc
-*
- COMMON /D151DT/ IDATE
- CHARACTER*8 IDATE
diff --git a/src/mathlib/gen/divon/delbnd.F b/src/mathlib/gen/divon/delbnd.F
deleted file mode 100644
index 31bcdee..0000000
--- a/src/mathlib/gen/divon/delbnd.F
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: delbnd.F,v 1.1.1.1 1996/04/01 15:03:27 mclareni Exp $
-*
-* $Log: delbnd.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:27 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE DELBND (N,NACTV,IACTV,NFREE,IFREE,IBDEL,IBTRUE,GACTV,NA
- 1DIM,AHESS,GFREE,GNORM)
- INTEGER N, NACTV, NFREE, IBDEL, IBTRUE, NADIM
- INTEGER IACTV(N), IFREE(N)
- DOUBLE PRECISION GNORM
- DOUBLE PRECISION AHESS(NADIM, N), GFREE(N), GACTV(N)
- INTEGER IPOS, J
- DOUBLE PRECISION RVAL
- CALL DELETE(NACTV,IACTV,IBTRUE,IPOS)
- NACTV=NACTV-1
- IBTRUE=ABS(IBTRUE)
- IFREE(NFREE+1)=IBTRUE
- IF(NFREE.EQ.0) GOTO 20
- DO 10 J=1,NFREE
- AHESS(NFREE+1,J)=0.0D+0
- 10 CONTINUE
- 20 NFREE=NFREE+1
- AHESS(NFREE,NFREE)=1.0D+0
- GFREE(NFREE)=GACTV(IBDEL)
- RVAL=GNORM*GNORM+GFREE(NFREE)**2
- GNORM=SQRT(RVAL)
- RETURN
- END
diff --git a/src/mathlib/gen/divon/delete.F b/src/mathlib/gen/divon/delete.F
deleted file mode 100644
index 5e78236..0000000
--- a/src/mathlib/gen/divon/delete.F
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: delete.F,v 1.1.1.1 1996/04/01 15:03:26 mclareni Exp $
-*
-* $Log: delete.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:26 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE DELETE (NLEN,IARRAY,IVALUE,IPOS)
- INTEGER NLEN, IVALUE, IPOS
- INTEGER IARRAY(NLEN)
- INTEGER I, NLENM1
- IPOS=0
- DO 10 I=1,NLEN
- IF(IVALUE.NE.IARRAY(I)) GOTO 10
- IPOS=I
- GOTO 20
- 10 CONTINUE
- RETURN
- 20 IF(IPOS.EQ.NLEN) RETURN
- NLENM1=NLEN-1
- DO 30 I=IPOS,NLENM1
- IARRAY(I)=IARRAY(I+1)
- 30 CONTINUE
- RETURN
- END
diff --git a/src/mathlib/gen/divon/delslv.F b/src/mathlib/gen/divon/delslv.F
deleted file mode 100644
index e370fc0..0000000
--- a/src/mathlib/gen/divon/delslv.F
+++ /dev/null
@@ -1,219 +0,0 @@
-*
-* $Id: delslv.F,v 1.1.1.1 1996/04/01 15:03:25 mclareni Exp $
-*
-* $Log: delslv.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:25 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE DELSLV(N,FMAJOR,FMINOR,LMAX,FRACT,X,XLOW,XUP,VOL,NCUT,N
- 1CDIM,ICUT,DELPLS,DELNEG,REGTOL,FTOL,FORIG,DFORIG,FNEW,FNLIN,FNLROW
- 2,DIAGJ,SPDIAG,SOL,Z,NFCNT)
- INTEGER N, NCUT, NCDIM, NFCNT
- INTEGER ICUT(NCDIM)
- DOUBLE PRECISION FMAJOR, FMINOR, FRACT, REGTOL, FTOL
- DOUBLE PRECISION X(N), XUP(N), XLOW(N), DELPLS(N), DELNEG(N)
- DOUBLE PRECISION FORIG(NCDIM), FNLIN(NCDIM)
- DOUBLE PRECISION DFORIG(NCDIM), FNEW(NCDIM), FNLROW(NCDIM)
- DOUBLE PRECISION DIAGJ(NCDIM), SPDIAG(NCDIM), SOL(NCDIM), Z(N)
- LOGICAL LMAX
- INTEGER I, IAB, IBACK, II, ISAVE, ITRY,
- 1 NCUTM1, NNEAR
- DOUBLE PRECISION BIG, DEL, DELMAX, DELMIN, DFNEW, DFUN,
- 1 FDIF, FGAM, FNORM, FNRMNW, FOMX, FRAT, FZ, GAMMA,
- 2 GAMNEW, PROD, RATGAM, REGINV, SINGTL, TSTVAL,
- 3 VAL, VOL, XMULT, YDI, YDMIN
-CMM INTEGER IABS
- DATA SINGTL/ 1.0D-4/
- DATA BIG/ 1.0D+10/
- NFCNT=0
- FDIF=FMAJOR-FMINOR
- PROD=1.0D+0
- DO 10 I=1,N
- PROD=PROD*(DELPLS(I)+DELNEG(I))
- 10 CONTINUE
- GAMMA=PROD/VOL
- FGAM=GAMMA*FMAJOR+(1.0D+0-GAMMA)*FMINOR
- DO 20 I=1,N
- Z(I)=X(I)
- 20 CONTINUE
- DO 50 I=1,NCUT
- II=ICUT(I)
- IAB=ABS(II)
- IF(II.LT.0) GOTO 30
- Z(IAB)=X(IAB)+DELPLS(IAB)
- GOTO 40
- 30 Z(IAB)=X(IAB)-DELNEG(IAB)
- 40 FNEW(I)=DFUN(N,Z)
- Z(IAB)=X(IAB)
- NFCNT=NFCNT+1
- 50 CONTINUE
-#if defined(CERNLIB_IBM)||defined(CERNLIB_SINGLE)
- 60 YDMIN=1.0D+40
-#endif
-#if (!defined(CERNLIB_IBM))&&(defined(CERNLIB_DOUBLE))
- 60 YDMIN= 1.0D+30
-#endif
- NNEAR=0
- DO 70 I=1,NCUT
- YDI=ABS(FMAJOR-FNEW(I))
- IF(YDI.GT.YDMIN) GOTO 70
- YDMIN=YDI
- NNEAR=I
- 70 CONTINUE
- IF(NNEAR.EQ.0) RETURN
- IF((LMAX.AND.FNEW(NNEAR).LT.FGAM).OR.
- 1(.NOT.LMAX.AND.FNEW(NNEAR).GT.FGAM)) GOTO 130
- ISAVE=ICUT(NNEAR)
- IF(NNEAR.EQ.NCUT.OR.NCUT.EQ.1) GOTO 90
- NCUTM1=NCUT-1
- DO 80 I=NNEAR,NCUTM1
- ICUT(I)=ICUT(I+1)
- FNEW(I)=FNEW(I+1)
- 80 CONTINUE
- 90 NCUT=NCUT-1
- IF(ISAVE.LT.0) GOTO 100
- DELPLS(ISAVE)=XUP(ISAVE)-X(ISAVE)
- GOTO 110
- 100 IAB=ABS(ISAVE)
- DELNEG(IAB)=X(IAB)-XLOW(IAB)
- 110 PROD=1.0D+0
- DO 120 I=1,N
- PROD=PROD*(DELPLS(I)+DELNEG(I))
- 120 CONTINUE
- GAMMA=PROD/VOL
- FGAM=GAMMA*FMAJOR+(1.0D+0-GAMMA)*FMINOR
- IF(NCUT.EQ.0) RETURN
- GOTO 60
- 130 DO 160 I=1,NCUT
- II=ICUT(I)
- IAB=ABS(II)
- IF(II.LT.0) GOTO 140
- DEL=DELPLS(IAB)
- GOTO 150
- 140 DEL=DELNEG(IAB)
- 150 FORIG(I)=FNEW(I)
- DFORIG(I)=(FNEW(I)-FMAJOR)/DEL
- 160 CONTINUE
- CALL FEQN(NCUT,FORIG,FGAM,FNLIN)
- CALL RLEN(NCUT,FNLIN,FNORM)
- 170 DO 180 I=1,NCUT
- FNLIN(I)=-FNLIN(I)
- 180 CONTINUE
- IF(NCUT.EQ.1) GOTO 200
- DIAGJ(1)=DFORIG(1)
- SPDIAG(1)=-DFORIG(2)
- NCUTM1=NCUT-1
- DO 190 I=1,NCUTM1
- DIAGJ(I)=DFORIG(I)
- SPDIAG(I)=-DFORIG(I+1)
- 190 CONTINUE
- 200 DO 210 I=1,NCUT
- II=ICUT(I)
- II=ABS(II)
- FNLROW(I)=-GAMMA*FDIF/(DELPLS(II)+DELNEG(II))
- 210 CONTINUE
- FNLROW(1)=DFORIG(1)+FNLROW(1)
- IF(NCUT.EQ.1) GOTO 230
- DO 220 I=1,NCUTM1
- XMULT=0.0D+0
- IF(ABS(FNLROW(I)).LT.BIG*ABS(DIAGJ(I))) XMULT=FNLROW(I)/DIAGJ(I
- 1)
- FNLROW(I+1)=FNLROW(I+1)-XMULT*SPDIAG(I)
- FNLIN(NCUT)=FNLIN(NCUT)-XMULT*FNLIN(I)
- 220 CONTINUE
- 230 SOL(NCUT)=FNLIN(NCUT)
- IF(ABS(FNLROW(NCUT)).LT.BIG*ABS(FNLIN(NCUT))) SOL(NCUT)=FNLIN(N
- 1CUT)/FNLROW(NCUT)
- IF(NCUT.EQ.1) GOTO 250
- DO 240 I=2,NCUT
- IBACK=NCUT-I+1
- VAL=FNLIN(IBACK)-SOL(IBACK+1)*SPDIAG(IBACK)
- SOL(IBACK)=VAL
- IF(ABS(DIAGJ(IBACK)).LT.BIG*ABS(VAL)) SOL(IBACK)=VAL/DIAGJ(IBAC
- 1K)
- 240 CONTINUE
- 250 ITRY=0
- DO 280 I=1,NCUT
- II=ICUT(I)
- IAB=ABS(II)
- IF(II.LT.0) GOTO 260
- DELMAX=FRACT*(XUP(IAB)-X(IAB)-DELPLS(IAB))
- DELMIN=-DELPLS(IAB)
- GOTO 270
- 260 DELMAX=FRACT*(X(IAB)-XLOW(IAB)-DELNEG(IAB))
- DELMIN=-DELNEG(IAB)
- 270 IF(SOL(I).GT.DELMAX) SOL(I)=0.75D+0*DELMAX
- IF(SOL(I).LT.DELMIN) SOL(I)=0.75D+0*DELMIN
- 280 CONTINUE
- 290 DO 310 I=1,NCUT
- II=ICUT(I)
- IAB=ABS(II)
- IF(II.LT.0) GOTO 300
- DELPLS(IAB)=DELPLS(IAB)+SOL(I)
- GOTO 310
- 300 DELNEG(IAB)=DELNEG(IAB)+SOL(I)
- 310 CONTINUE
- DO 340 I=1,NCUT
- II=ICUT(I)
- IAB=ABS(II)
- IF(II.LT.0) GOTO 320
- Z(IAB)=X(IAB)+DELPLS(IAB)
- GOTO 330
- 320 Z(IAB)=X(IAB)-DELNEG(IAB)
- 330 FZ=DFUN(N,Z)
- NFCNT=NFCNT+1
- FNEW(I)=FZ
- Z(IAB)=X(IAB)
- 340 CONTINUE
- PROD=1.0D+0
- DO 350 I=1,N
- PROD=PROD*(DELPLS(I)+DELNEG(I))
- 350 CONTINUE
- GAMNEW=PROD/VOL
- FGAM=GAMNEW*FMAJOR+(1.0D+0-GAMNEW)*FMINOR
- CALL FEQN(NCUT,FNEW,FGAM,FNLIN)
- CALL RLEN(NCUT,FNLIN,FNRMNW)
- IF(FNRMNW.GT.FNORM) GOTO 380
- FOMX=0.0D+0
- DO 360 I=1,NCUT
- IF(ABS(FNEW(I)).GT.FOMX) FOMX=ABS(FNEW(I))
- DFNEW=FNEW(I)-FORIG(I)
- TSTVAL=1.0D+0
- IF(ABS(SOL(I)).LT.BIG*ABS(DFNEW)) TSTVAL=DFNEW/SOL(I)
- IF(ABS(TSTVAL).LT.SINGTL*ABS(DFORIG(I))) TSTVAL=SINGTL*DFORIG(I
- 1)
- DFORIG(I)=TSTVAL
- FORIG(I)=FNEW(I)
- 360 CONTINUE
- FNORM=FNRMNW
- FOMX=MAX(FOMX,ABS(FGAM))
- FRAT=FNORM/(1.0D+0+FOMX)
- REGINV=1.0D+0/REGTOL
- RATGAM=GAMNEW/GAMMA
- GAMMA=GAMNEW
-C--- Activate to do debugging
-C WRITE(6,420) FNORM,FOMX,FRAT
-C WRITE(6,430) FGAM,RATGAM
- FGAM=GAMMA*FMAJOR+(1.0D+0-GAMMA)*FMINOR
- IF(RATGAM.GT.REGTOL.AND.RATGAM.LT.REGINV) GOTO 370
- IF(FRAT.LT.FTOL) GOTO 370
- GOTO 170
- 370 RETURN
- 380 ITRY=ITRY+1
- IF(ITRY.GT.2) RETURN
- DO 410 I=1,NCUT
- II=ICUT(I)
- IAB=ABS(II)
- IF(II.GE.0) THEN
- DELPLS(IAB)=DELPLS(IAB)-SOL(I)
- ELSE
- DELNEG(IAB)=DELNEG(IAB)-SOL(I)
- ENDIF
- SOL(I)=SOL(I)*0.25D+0
- 410 CONTINUE
- GOTO 290
- 420 FORMAT(' FNORM, FOMX, FRAT', 3(1PD15.5))
- 430 FORMAT(' FGAM, RATGAM', 2(1PD15.5))
- END
diff --git a/src/mathlib/gen/divon/divon.F b/src/mathlib/gen/divon/divon.F
deleted file mode 100644
index b3cd9cc..0000000
--- a/src/mathlib/gen/divon/divon.F
+++ /dev/null
@@ -1,59 +0,0 @@
-*
-* $Id: divon.F,v 1.1.1.1 1996/04/01 15:03:23 mclareni Exp $
-*
-* $Log: divon.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:23 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE DIVON (D,UMINUS,UPLUS,ERROR,NMAX,FUN1,ERRINT)
- INTEGER D,NMAX
- REAL UMINUS(D),UPLUS(D),ERROR
- COMMON /ANSWER/ FINTGL,SPRD,DUMMY(5),NRGN,MAXRGN /FUNN/ NFUN,MO(2)
- COMMON /Z0001/ ERR,NMIN,MCOUNT /SAMPLE/ NPT /PRSTOP/ NSTOP
- COMMON /PRINT/ IPRINT /ZEETRM/ ITRMF
-#include "d151dt.inc"
- DATA FAC /1.0/
-C INITIALISATION OF CONSTANTS
- CALL DVNBKD
-C
- ITRMF=0
- IF(NMAX.GT.0) GOTO 30
- IF(IPRINT.LE.0) GOTO 20
- WRITE(6,10) NMAX
- 10 FORMAT('0--- DIVON --- ',I5,' FUNCTION EVALUATIONS SPECIFIED.')
- 20 RETURN
- 30 IF(IPRINT.LE.0) GOTO 80
- WRITE(6,40) IDATE,D,ERROR,NMAX
- 40 FORMAT('1--- DIVON --- DIVONNE4 (',A8,') MULTIPLE INTEGRATION'/
- 11X,I2,' DIMENSIONS, ERROR =',G13.5,', NMAX = ',I8)
- WRITE(6,50)
- 50 FORMAT('0INTEGRATION LIMITS :')
- DO 70 I=1,D
- WRITE(6,60) I,UMINUS(I),UPLUS(I)
- 60 FORMAT(' X(',I2,') :',G13.5,' TO',G14.5)
- 70 CONTINUE
- 80 NMIN=9999999
- MCOUNT=NSTOP
- ERR=ERROR
- ITRMF=1
- CALL PARTN(D,UMINUS,UPLUS,0.0,NMAX)
- IF(NFUN+2*NPT*NRGN.LE.NMAX) GOTO 110
- IF(IPRINT.LE.0) GOTO 100
- WRITE(6,90)
- 90 FORMAT('0--- DIVON --- NOT ENOUGH FUNCTION EVALUATIONS LEFT'
- 1/' FOR MORE PRECISE INTEGRAL ESTIMATE.')
- 100 FUN1=FINTGL
- ERRINT=SPRD/NPT
- RETURN
- 110 ERRR=ABS(ERR)
- IF(ERR.GT.0.0) ERRR=ERRR*FINTGL
- NINT=MIN(MAX(2.0*NPT,SPRD*FAC/ERRR),REAL(NMAX-NFUN)/NRGN)+.5
- IF(IPRINT.LE.0) GOTO 130
- WRITE(6,120) NINT
- 120 FORMAT('0--- DIVON --- INTEGRAL AND ERROR ESTIMATE WITH',I6,
- 1 ' POINTS / REGION :')
- 130 CALL INTGRL(D,0,NINT,FUN1,ERRINT)
- RETURN
- END
diff --git a/src/mathlib/gen/divon/dvcopy.F b/src/mathlib/gen/divon/dvcopy.F
deleted file mode 100644
index 85675cb..0000000
--- a/src/mathlib/gen/divon/dvcopy.F
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: dvcopy.F,v 1.1.1.1 1996/04/01 15:03:26 mclareni Exp $
-*
-* $Log: dvcopy.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:26 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE DVCOPY(N,A,B)
- INTEGER N
- DOUBLE PRECISION A(N), B(N)
- INTEGER I
- DO 10 I=1,N
- B(I)=A(I)
- 10 CONTINUE
- RETURN
- END
diff --git a/src/mathlib/gen/divon/dvdot.F b/src/mathlib/gen/divon/dvdot.F
deleted file mode 100644
index f614be7..0000000
--- a/src/mathlib/gen/divon/dvdot.F
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: dvdot.F,v 1.1.1.1 1996/04/01 15:03:26 mclareni Exp $
-*
-* $Log: dvdot.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:26 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- DOUBLE PRECISION FUNCTION DVDOT(N, A, B)
- INTEGER N
- DOUBLE PRECISION A(N), B(N)
- INTEGER I
- DOUBLE PRECISION SUM
- DVDOT=0.0D+0
- IF(N.LE.0) RETURN
- SUM=0.0D+0
- DO 10 I=1,N
- SUM=SUM+A(I)*B(I)
- 10 CONTINUE
- DVDOT=SUM
- RETURN
- END
diff --git a/src/mathlib/gen/divon/dvnbkd.F b/src/mathlib/gen/divon/dvnbkd.F
deleted file mode 100644
index 7effae5..0000000
--- a/src/mathlib/gen/divon/dvnbkd.F
+++ /dev/null
@@ -1,82 +0,0 @@
-*
-* $Id: dvnbkd.F,v 1.1.1.1 1996/04/01 15:03:23 mclareni Exp $
-*
-* $Log: dvnbkd.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:23 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE DVNBKD
-C *******************************************************************
-C * *
-C * *
-C * - D I V O N N E 4 - PROGRAM FOR MULTIPLE INTEGRATION *
-C * AND *
-C * ADAPTIVE IMPORTANCE SAMPLING *
-C * BY *
-C * NESTED PARTITIONING. *
-C * *
-C * *
-C * *
-C * *
-C * CODED BY: J. H. FRIEDMAN, SLAC/CERN. *
-C * AND *
-C * M. H. WRIGHT, STANFORD UNIVERSITY *
-C * MODIFIED FOR CERN BY T.LINDELOF, JULY 1981 *
-C * FORTRAN 77 UPDATE BY T.LINDELOF, MAY 1982 *
-C *******************************************************************
-C
-C INITIALIZATION ROUTINE TO 'SIMULATE' BLOCK DATA
-C BLOCK DATA
-#include "d151dt.inc"
- COMMON /PRINT/ IPRINT
- COMMON /ISTRGE/ MXRGNS , ISTOR(12000)
- COMMON /RSTRGE/ RSTSZE,RSTOR(18001)
- INTEGER RSTSZE
- COMMON /QUADRE/ IDEG
- COMMON /START/ ISTART
- COMMON /EXFILE/ NFILE
- COMMON /DISPOS/ IDISP
- COMMON /DEPTHS/ ISTDPH , INCDPH
- COMMON /SAMPLE/ NPOINT
- COMMON /CUTOLS/ BNDTOL, FRACT, REGNTL, FNLTOL
- COMMON /BNDLMT/ FLOBD,FUPBD
- COMMON /PRSTOP/ NSTOP
- COMMON /ZEETRM/ ITRMF
-C
- DATA INITL/0/
- SAVE INITL
- IF(INITL.NE.0) RETURN
- INITL=1
-C
- IDATE='17/12/80'
- IPRINT=1
- MXRGNS=3000
- RSTSZE=18001
- IDEG=0
- ISTART=1
- NFILE=1
- IDISP=0
- ISTDPH=3
- INCDPH=5
- NPOINT=50
- BNDTOL=.05
- FRACT=.5
- REGNTL=.9
- FNLTOL=.1
-#if defined(CERNLIB_IBM)||defined(CERNLIB_SINGLE)
- FLOBD=-9.9E71
- FUPBD=9.9E71
-#endif
-#if (defined(CERNLIB_DOUBLE))&&(!defined(CERNLIB_IBM))
- FLOBD=-9.9E37
- FUPBD= 9.9E37
-#endif
- NSTOP=5
- ITRMF=0
-C
- CALL DVNOPT
-C
- RETURN
- END
diff --git a/src/mathlib/gen/divon/dvnopt.F b/src/mathlib/gen/divon/dvnopt.F
deleted file mode 100644
index a89fe3b..0000000
--- a/src/mathlib/gen/divon/dvnopt.F
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: dvnopt.F,v 1.1.1.1 1996/04/01 15:03:23 mclareni Exp $
-*
-* $Log: dvnopt.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:23 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE DVNOPT
-C DUMMY ROUTINE TO BE REPLACED BY USER VERSION IF
-C DEFAULT OPTIONS ARE TO BE CHANGED.
- WRITE(6,1234)
- 1234 FORMAT('0DIVON4 DEFAULT OPTIONS NOT ALTERED BY USER.')
- RETURN
- END
diff --git a/src/mathlib/gen/divon/exmbuc.F b/src/mathlib/gen/divon/exmbuc.F
deleted file mode 100644
index 6328093..0000000
--- a/src/mathlib/gen/divon/exmbuc.F
+++ /dev/null
@@ -1,152 +0,0 @@
-*
-* $Id: exmbuc.F,v 1.1.1.1 1996/04/01 15:03:24 mclareni Exp $
-*
-* $Log: exmbuc.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:24 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- INTEGER FUNCTION EXMBUC(NUMBER, NDIM, BUCKTS, GOOD, MAXFUN, MAXDPH
- 1, IRM)
- INTEGER NUMBER, NDIM, MAXFUN, MAXDPH
- REAL GOOD, BUCKTS(IRM)
- COMMON /PRINT/ IPRINT
- INTEGER IPRINT
- COMMON /ANSWER/ INTGRL,ERROR,ERRMAX,GEFF,Q2,Q3,Q5,NUMBR,MBUC
- COMMON /DEPTHS/ FSTDPH,INCDPH
- INTEGER FSTDPH,INCDPH,NTREES
- REAL INTGRL,VAR,ERROR,ERRMAX,VARMAX,VARMX2,PRCNT
- REAL Q2,Q3,Q5,GEFF,SEFF,FMAX,FMIN,TOTVOL
- COMMON /QUADRE/ DEGREE
- INTEGER DEGREE
- COMMON /MAXERR/ ERRPCT,ERRABS
- REAL ERRPCT,ERRABS
- COMMON /FUNN/ NFUN, NFOPT, NFCUT
- INTEGER NFUN, NFOPT, NFCUT
- COMMON /SIGSPL/ COORD,PLACE,FSTENT,DOSPLT
- COMMON /BUKSZE/ MAXWRD
- INTEGER MAXWRD
- COMMON /LIMITS/ GMINUS(10),GPLUS(10)
- LOGICAL FSTENT,DOSPLT,UTERM,USRTRM
- REAL COORD,PLACE
- INTEGER NUMBR,PTR
- NUMBR=NUMBER
- IF(NUMBER.NE.1) GOTO 40
- NTREES=0
- ERRPCT=GOOD
- ERRABS=0
- MAXDPH=FSTDPH
- FSTENT=.TRUE.
- NFUN=0
- NFOPT=0
- NFCUT=0
- DOSPLT=.FALSE.
- GUUD=ABS(GOOD)
- IF(GOOD.GE.0) GOTO 10
- ERRABS=GUUD
- ERRPCT=0
- 10 IF(DEGREE.NE.1.AND.DEGREE.NE.2.AND.DEGREE.NE.3.AND.DEGREE.NE.5)
- 1 DEGREE=0
- IF(DEGREE.NE.1) GOTO 30
- TOTVOL=1.0E+0
- DO 20 I=1,NDIM
- TOTVOL=TOTVOL*(GPLUS(I)-GMINUS(I))
- 20 CONTINUE
- 30 EXMBUC=0
- RETURN
- 40 NTREES=NTREES+1
- MBUC=0
- PTR=MBUC
- INTGRL=0.0E+0
- VAR=INTGRL
- VARMAX=VAR
- VARMX2=VARMAX
- Q2=VARMX2
- Q3=Q2
- Q5=Q3
- GEFF=Q5
- FMAX=GEFF
- FMIN=FMAX
- DO 80 IBUC=1,NUMBER
- INTGRL=INTGRL+BUCKTS(PTR+1)
- VAR=VAR+BUCKTS(PTR+2)
- IF(BUCKTS(PTR+2).LE.VARMAX) GOTO 50
- VARMX2=VARMAX
- VARMAX=BUCKTS(PTR+2)
- MBUC=IBUC
- GOTO 60
- 50 IF(BUCKTS(PTR+2).LE.VARMX2) GOTO 60
- VARMX2=BUCKTS(PTR+2)
- 60 IF(DEGREE.NE.1) GOTO 70
- GEFF=GEFF+(BUCKTS(PTR+5)-BUCKTS(PTR+6))*BUCKTS(PTR+7)
- FMAX=MAX(FMAX,BUCKTS(PTR+5))
- FMIN=MIN(FMIN,BUCKTS(PTR+6))
- 70 IF(DEGREE.GE.2) Q2=Q2+BUCKTS(PTR+5)
- IF(DEGREE.GE.3) Q3=Q3+BUCKTS(PTR+6)
- IF(DEGREE.EQ.5) Q5=Q5+BUCKTS(PTR+7)
- PTR=PTR+MAXWRD
- 80 CONTINUE
- ERROR=SQRT(VAR)
- ERRMAX=SQRT(VARMAX)
- IF(DEGREE.EQ.1) GEFF=INTGRL/GEFF
- IF(GOOD.LE.0) GOTO 100
- IF(INTGRL.EQ.0.0E+0) GOTO 90
- PRCNT=ERROR/ABS(INTGRL)
- GOTO 110
- 90 PRCNT=0.0E+0
- GOTO 110
- 100 PRCNT=ERROR
- 110 UTERM=USRTRM(NTREES)
- IF(IPRINT.LE.0) GOTO 220
- IF(MOD(NTREES,IPRINT).NE.0 .AND. NFUN.LT.MAXFUN .AND. PRCNT.GT
- 1.GUUD .AND. .NOT.UTERM) GOTO 220
- WRITE(6,120) NTREES,NUMBER,INTGRL,ERROR,ERRMAX,MBUC
- 120 FORMAT(///' ITERATION ',I5,'.',I10,' REGIONS'/
- 1 ' APPROXIMATE INTEGRAL = ',G13.5,' WITH TOTAL RSS SPREAD ',
- 2 G13.5/' THE LARGEST SINGLE SPREAD IS ',G13.5,
- 3 ' IN REGION ',I5)
- IF(DEGREE.NE.1) GOTO 140
- SEFF=INTGRL/((FMAX-FMIN)*TOTVOL)
- WRITE(6,130) GEFF,SEFF
- 130 FORMAT(' ESTIMATED RANGEN EFFICIENCY =',G13.5/
- *' SIMPLE ACCEPT/REJECT =',G13.5)
- 140 IF(DEGREE.LT.2) GOTO 160
- WRITE(6,150) Q2
- 150 FORMAT(' 2ND DEGREE QUADRATURE = ',G13.5)
- 160 IF(DEGREE.LT.3) GOTO 180
- WRITE(6,170) Q3
- 170 FORMAT(' 3RD DEGREE QUADRATURE = ',G13.5)
- 180 IF(DEGREE.NE.5) GOTO 200
- WRITE(6,190) Q5
- 190 FORMAT(' 5TH DEGREE QUADRATURE = ',G13.5)
- 200 WRITE(6,210) NFUN,NFOPT,NFCUT
- 210 FORMAT(1X,I10,' INTEGRAND EVALUATIONS SO FAR'/1X,I10,
- 1 ' IN OPTIMIZATION, ',I10,' IN FINDING CUTS')
- 220 IF(NFUN.LT.MAXFUN) GOTO 250
- IF(IPRINT.LE.0) GOTO 240
- WRITE(6,230) MAXFUN
- 230 FORMAT(' THIS EXCEEDES SPECIFIED LIMIT OF',I10)
- 240 EXMBUC=0
- RETURN
- 250 IF(PRCNT.GT.GUUD) GOTO 280
- IF(IPRINT.LE.0) GOTO 270
- WRITE(6,260) ERROR
- 260 FORMAT(' TOTAL RSS SPREAD ',G13.5,' IS BELOW SPECIFIED MAXIMUM')
- 270 EXMBUC=0
- RETURN
- 280 IF(.NOT.(UTERM)) GOTO 310
- IF(IPRINT.LE.0) GOTO 300
- WRITE(6,290)
- 290 FORMAT(' USER REQUESTED TERMINATION')
- 300 EXMBUC=0
- RETURN
- 310 EXMBUC=MBUC
- MAXDPH=INCDPH
- ERRABS=SQRT(VARMX2)
- DOSPLT=.TRUE.
- PTR=MAXWRD*(MBUC-1)
- COORD=BUCKTS(PTR+3)
- PLACE=BUCKTS(PTR+4)
- RETURN
- END
diff --git a/src/mathlib/gen/divon/feasmv.F b/src/mathlib/gen/divon/feasmv.F
deleted file mode 100644
index 91f6dbe..0000000
--- a/src/mathlib/gen/divon/feasmv.F
+++ /dev/null
@@ -1,35 +0,0 @@
-*
-* $Id: feasmv.F,v 1.1.1.1 1996/04/01 15:03:27 mclareni Exp $
-*
-* $Log: feasmv.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:27 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE FEASMV (N,NFREE,IFREE,X,PFREE,XLOW,XHI,TOL,STEPMX,INEW,
- 1IDNEW)
- INTEGER N, NFREE, INEW, IDNEW
- INTEGER IFREE(NFREE)
- DOUBLE PRECISION TOL, STEPMX
- DOUBLE PRECISION X(N), PFREE(NFREE), XLOW(N), XHI(N)
- INTEGER I, IDIR, II
- DOUBLE PRECISION STEP
-C*NS DOUBLE PRECISION DABS
- STEPMX=1.0D+30
- DO 30 I=1,NFREE
- II=IFREE(I)
- IF(ABS(PFREE(I)).LT.TOL) GOTO 30
- IF(PFREE(I).GT.0.0D+0) GOTO 10
- STEP=(XLOW(II)-X(II))/PFREE(I)
- IDIR=1
- GOTO 20
- 10 STEP=(XHI(II)-X(II))/PFREE(I)
- IDIR=-1
- 20 IF(STEP.GE.STEPMX) GOTO 30
- STEPMX=STEP
- INEW=II
- IDNEW=IDIR
- 30 CONTINUE
- RETURN
- END
diff --git a/src/mathlib/gen/divon/feqn.F b/src/mathlib/gen/divon/feqn.F
deleted file mode 100644
index 7faf707..0000000
--- a/src/mathlib/gen/divon/feqn.F
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: feqn.F,v 1.1.1.1 1996/04/01 15:03:25 mclareni Exp $
-*
-* $Log: feqn.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:25 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE FEQN (NCUT,F,FGAM,FNLIN)
- INTEGER NCUT
- DOUBLE PRECISION FGAM
- DOUBLE PRECISION F(NCUT), FNLIN(NCUT)
- INTEGER I, NCUTM1
- IF(NCUT.EQ.1) GOTO 20
- NCUTM1=NCUT-1
- DO 10 I=1,NCUTM1
- FNLIN(I)=F(I)-F(I+1)
- 10 CONTINUE
- 20 FNLIN(NCUT)=F(1)-FGAM
- RETURN
- END
diff --git a/src/mathlib/gen/divon/fun.F b/src/mathlib/gen/divon/fun.F
deleted file mode 100644
index 941730d..0000000
--- a/src/mathlib/gen/divon/fun.F
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: fun.F,v 1.1.1.1 1996/04/01 15:03:25 mclareni Exp $
-*
-* $Log: fun.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:25 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- REAL FUNCTION FUN(N,RX)
- DOUBLE PRECISION XDB(15), DFUN, FUNX
- REAL RX(N),SNGL
- EXTERNAL DFUN
- DO 10 I=1,N
- XDB(I)=DBLE(RX(I))
- 10 CONTINUE
- FUNX=DFUN(N,XDB)
- FUN=SNGL(FUNX)
- RETURN
- END
diff --git a/src/mathlib/gen/divon/genpnt.F b/src/mathlib/gen/divon/genpnt.F
deleted file mode 100644
index 0b297c2..0000000
--- a/src/mathlib/gen/divon/genpnt.F
+++ /dev/null
@@ -1,107 +0,0 @@
-*
-* $Id: genpnt.F,v 1.1.1.1 1996/04/01 15:03:24 mclareni Exp $
-*
-* $Log: genpnt.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:24 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE GENPNT (NDIM,X,WT)
- REAL X(10),WWT,WT,FUN
- COMMON /ISTRGE/ MXRGNS,ISTOR(12000)
- COMMON /RSTRGE/ RSTSZE,RSTOR(18001)
- INTEGER RSTSZE
- COMMON /BUKSZE/ MAXWRD
- INTEGER MAXWRD
- COMMON /TRESZE/ ENTREE,ENTBUC
- INTEGER ENTREE,ENTBUC
- COMMON /LIMITS/ GMINUS(10),GPLUS(10)
- COMMON /FUNN/ NFUN, NFOPT, NFCUT /GENINL/ JNLGEN
- COMMON /QUADRE/ IDEG
- INTEGER IDEG
- INTEGER NFUN,JNLGEN,INLGEN
- INTEGER PARENT,PNTR,NTIMES,MODE
- REAL UPLUS(10),UMINUS(10),XSAVE(10),WWTSVE
- MODE=1
-#if defined(CERNLIB_DOUBLE)||!defined(CERNLIB_F4)
- ENTRY RANGEN(NDIM,X)
-#endif
-#if (defined(CERNLIB_SINGLE))&&(defined(CERNLIB_F4))
- ENTRY RANGEN
-#endif
-C*UL 10 INLGEN=JNLGEN
- INLGEN=JNLGEN
- IF(INLGEN.EQ.0) GOTO 90
- INLGEN=0
- NTIMES=0
- IF(ENTBUC.GT.1) GOTO 30
- WRITE(6,20)
- 20 FORMAT(' GENPNT/RANGEN CALLED BEFORE PARTN')
- STOP
- 30 IF(IDEG.EQ.1) GOTO 50
- WRITE(6,40)
- 40 FORMAT(' GENPNT/RANGEN CALLED WITH IDEG NE 1')
- STOP
- 50 IF(MAXWRD.EQ.7) GOTO 70
- WRITE(6,60)
- 60 FORMAT(' GENPNT/RANGEN CALLED WITH IMPROPER BUCKET STORAGE')
- STOP
- 70 ISCR=MXRGNS*(MAXWRD+1)
- RSTOR(ISCR+1)=0.0E+0
- PNTR=MXRGNS+1
- DO 80 J=1,ENTBUC
- RSTOR(ISCR+J+1)=RSTOR(ISCR+J)+RSTOR(PNTR+4)*RSTOR(PNTR+6)
- PNTR=PNTR+MAXWRD
- 80 CONTINUE
- 90 IF(MODE.EQ.1) GOTO 100
- IF(NTIMES.GT.0) GOTO 180
- 100 CALL RANUMS(R,1)
- R=R*RSTOR(ISCR+ENTBUC+1)
- NL=1
- NH=ENTBUC+1
- 110 IF(NH.LE.NL+1) GOTO 130
- NX=(NH+NL)/2
- IF(R.GT.RSTOR(ISCR+NX)) GOTO 120
- NH=NX
- GOTO 110
- 120 NL=NX
- GOTO 110
- 130 PARENT=1
- DO 140 J=1,NDIM
- UMINUS(J)=GMINUS(J)
- UPLUS(J)=GPLUS(J)
- 140 CONTINUE
- CALL BOUNDS(NL,PARENT,ISTOR,RSTOR,UMINUS,UPLUS)
- PNTR=MXRGNS+1+MAXWRD*(NL-1)
- CALL RANUMS (X(1), NDIM)
- DO 150 J=1,NDIM
- X(J)=(UPLUS(J)-UMINUS(J))*X(J)+UMINUS(J)
- 150 CONTINUE
- IF(MODE.NE.1) GOTO 160
- WT=FUN(NDIM,X)/RSTOR(PNTR+4)
- NFUN=NFUN+1
- RETURN
- 160 CALL RANUMS(R,1)
- IF(R.LE.RSTOR(PNTR+5)/RSTOR(PNTR+4)) RETURN
- WWT=FUN(NDIM,X)/RSTOR(PNTR+4)
- NFUN=NFUN+1
- IF(R.GT.WWT) GOTO 100
- IF(WWT.LE.1.0E+0) RETURN
- NTIMES=INT(WWT)
- WWTSVE=WWT
- DO 170 I=1,NDIM
- XSAVE(I)=X(I)
- 170 CONTINUE
- RETURN
- 180 IF(NTIMES.LE.1) GOTO 200
- NTIMES=NTIMES-1
- DO 190 I=1,NDIM
- X(I)=XSAVE(I)
- 190 CONTINUE
- RETURN
- 200 NTIMES=0
- WWT=WWTSVE-INT(WWTSVE)
- IF(R.LT.WWT) RETURN
- GOTO 100
- END
diff --git a/src/mathlib/gen/divon/grdcmp.F b/src/mathlib/gen/divon/grdcmp.F
deleted file mode 100644
index 6d13d8d..0000000
--- a/src/mathlib/gen/divon/grdcmp.F
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: grdcmp.F,v 1.1.1.1 1996/04/01 15:03:26 mclareni Exp $
-*
-* $Log: grdcmp.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:26 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE GRDCMP (N,NCOMP,INDEX,X,FVAL,DELTA,XHI,XTEMP,GRAD)
- INTEGER N, NCOMP
- INTEGER INDEX(NCOMP)
- DOUBLE PRECISION FVAL, DELTA
- DOUBLE PRECISION X(N), XHI(N), XTEMP(N), GRAD(NCOMP)
- INTEGER I, II
- DOUBLE PRECISION DELX, DFUN, FDIF, FTEMP
-CMM INTEGER IABS
- IF(NCOMP.LE.0) RETURN
- DO 10 I=1,N
- XTEMP(I)=X(I)
- 10 CONTINUE
- DO 20 I=1,NCOMP
- DELX=DELTA
- II=ABS(INDEX(I))
- IF((X(II)+DELTA).GT.XHI(II)) DELX=-DELTA
- XTEMP(II)=X(II)+DELX
- FTEMP=DFUN(N,XTEMP)
- XTEMP(II)=X(II)
- FDIF=(FTEMP-FVAL)/DELX
- GRAD(I)=FDIF
- 20 CONTINUE
- RETURN
- END
diff --git a/src/mathlib/gen/divon/intgrl.F b/src/mathlib/gen/divon/intgrl.F
deleted file mode 100644
index 441afd6..0000000
--- a/src/mathlib/gen/divon/intgrl.F
+++ /dev/null
@@ -1,118 +0,0 @@
-*
-* $Id: intgrl.F,v 1.1.1.1 1996/04/01 15:03:24 mclareni Exp $
-*
-* $Log: intgrl.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:24 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE INTGRL (NDIM,INTDEG,NPOINT,FUNINT,ERROR)
-C*NS INTEGER NDIM, INTDEG, INTPNT
- INTEGER NDIM, INTDEG
- REAL ERROR
- COMMON /ISTRGE/ MXRGNS,ISTOR(12000)
- COMMON /RSTRGE/ RSTSZE,RSTOR(18001)
- INTEGER RSTSZE
- COMMON /BUKSZE/ MAXWRD
- INTEGER MAXWRD
- COMMON /TRESZE/ ENTREE,ENTBUC
- INTEGER ENTREE,ENTBUC
- COMMON /LIMITS/ GMINUS(10),GPLUS(10)
- COMMON /PRINT/ IPRINT
- COMMON /FUNN/ NFUN, NFOPT, NFCUT
- INTEGER NFUN, NFOPT, NFCUT
- COMMON /QUADRE/ DEGREE
- INTEGER DEGREE
- REAL UMINUS(10),UPLUS(10)
- INTEGER PARENT,PTR,NTOT,NIBUC,BUCPTR
- DOUBLE PRECISION FINT,ERRSQ
- EXTERNAL FUN
- IF(ENTBUC.GT.1) GOTO 20
- WRITE(6,10)
- 10 FORMAT(' FUNINT CALLED BEFORE PARTN.')
- STOP
- 20 IF(INTDEG.LE.1) GOTO 30
- IF(INTDEG.EQ.2) NFUN=NFUN+ENTBUC*(NDIM+1)
- IF(INTDEG.EQ.3) NFUN=NFUN+ENTBUC*2*NDIM
- IF(INTDEG.EQ.5) NFUN=NFUN+ENTBUC*(2*NDIM**2+1)
- 30 ISCR=MXRGNS*(MAXWRD+1)
- FUNINT=0.0E+0
- ERROR=FUNINT
- BUCPTR=MXRGNS+1
- IF(INTDEG.NE.1) GOTO 50
- NTOT=NPOINT*ENTBUC
- J=BUCPTR+1
- ERRTOT=0.0E+0
- DO 40 I=1,ENTBUC
- ERRTOT=ERRTOT+SQRT(RSTOR(J))
- J=J+MAXWRD
- 40 CONTINUE
- 50 DO 180 IBUC=1,ENTBUC
- PARENT=1
- DO 60 J=1,NDIM
- UMINUS(J)=GMINUS(J)
- UPLUS(J)=GPLUS(J)
- 60 CONTINUE
- CALL BOUNDS(IBUC,PARENT,ISTOR,RSTOR,UMINUS,UPLUS)
- IF(INTDEG.GE.0) GOTO 70
- CALL USRINT(UMINUS,UPLUS,RSTOR(BUCPTR),RSTOR(BUCPTR+1),RFINT,RERR
- 1SQ)
- FUNINT=FUNINT+RFINT
- ERROR=ERROR+RERRSQ
- BUCPTR=BUCPTR+MAXWRD
- GOTO 180
- 70 IF(DEGREE.NE.1) GOTO 80
- CELVOL=RSTOR(BUCPTR+6)
- GOTO 100
- 80 CELVOL=1.0E+0
- DO 90 J=1,NDIM
- CELVOL=CELVOL*(UPLUS(J)-UMINUS(J))
- 90 CONTINUE
- 100 IF(INTDEG.LE.1) GOTO 110
- FUNINT=FUNINT+QUAD(NDIM,INTDEG,UMINUS,UPLUS,FUN)*CELVOL
- GOTO 180
- 110 IF(INTDEG.NE.1) GOTO 120
- NIBUC=INT(SQRT(RSTOR(BUCPTR+1))*NTOT/ERRTOT+0.5)
- IF(NIBUC.GE.5) GOTO 130
- FUNINT=FUNINT+RSTOR(BUCPTR)
- ERROR=ERROR+RSTOR(BUCPTR+1)
- BUCPTR=BUCPTR+MAXWRD
- GOTO 180
- 120 NIBUC=NPOINT
- CALL QUASI(XX,NDIM,NIBUC,-NPOINT)
- 130 PTR=ISCR
- FINT=0.0E+0
- ERRSQ=FINT
- DO 170 J=1,NIBUC
- IF(INTDEG.NE.1) GOTO 140
- CALL RANUMS(RSTOR(PTR+1),NDIM)
- GOTO 150
- 140 CALL QUASI(RSTOR(PTR+1),NDIM,1,NIBUC)
- 150 DO 160 I=1,NDIM
- RSTOR(I+PTR)=(UPLUS(I)-UMINUS(I))*RSTOR(I+PTR)+UMINUS(I)
- 160 CONTINUE
- F=FUN(NDIM,RSTOR(PTR+1))
- FINT=FINT+F
- IF(ABS(F).GT.1.0E-37) ERRSQ=ERRSQ+F**2
- 170 CONTINUE
- FINT=FINT/NIBUC
- ERRSQ=ERRSQ/NIBUC
- ERRSQ=ERRSQ-FINT**2
- FINT=FINT*CELVOL
- ERRSQ=ERRSQ*CELVOL**2
- IF(INTDEG.EQ.0) ERRSQ=RSTOR(BUCPTR+1)/NIBUC
- ERRSQ=ERRSQ/NIBUC
- FUNINT=FUNINT+FINT
- ERROR=ERROR+ERRSQ
- NFUN=NFUN+NIBUC
- RSTOR(BUCPTR)=FINT
- BUCPTR=BUCPTR+MAXWRD
- 180 CONTINUE
- IF(ERROR.GT.0) ERROR=SQRT(ERROR)
- IF(IPRINT.LE.0) GOTO 200
- WRITE(6,190) FUNINT,ERROR,NFUN
- 190 FORMAT(' INTEGRAL ESTIMATE = ',G13.5,' +/-',G13.5/1X,
- 1 I10,' TOTAL INTEGRAND EVALUATIONS')
- 200 RETURN
- END
diff --git a/src/mathlib/gen/divon/ldlsol.F b/src/mathlib/gen/divon/ldlsol.F
deleted file mode 100644
index cbd9757..0000000
--- a/src/mathlib/gen/divon/ldlsol.F
+++ /dev/null
@@ -1,40 +0,0 @@
-*
-* $Id: ldlsol.F,v 1.1.1.1 1996/04/01 15:03:27 mclareni Exp $
-*
-* $Log: ldlsol.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:27 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE LDLSOL (N,NADIM,CHOL,B,X)
- INTEGER N, NADIM
- DOUBLE PRECISION CHOL(NADIM, N)
- DOUBLE PRECISION B(N), X(N)
- INTEGER I, IM1, J, JJ, JP1
- DOUBLE PRECISION SUM
- X(1)=B(1)
- IF(N.EQ.1) GOTO 30
- DO 20 I=2,N
- SUM=B(I)
- IM1=I-1
- DO 10 J=1,IM1
- SUM=SUM-CHOL(I,J)*X(J)
- 10 CONTINUE
- X(I)=SUM
- 20 CONTINUE
- 30 IF(CHOL(N,N).LE.0.0D+0) RETURN
- X(N)=X(N)/CHOL(N,N)
- IF(N.EQ.1) RETURN
- DO 50 JJ=2,N
- J=N-JJ+1
- IF(CHOL(J,J).LE.0.0D+0) RETURN
- SUM=X(J)/CHOL(J,J)
- JP1=J+1
- DO 40 I=JP1,N
- SUM=SUM-CHOL(I,J)*X(I)
- 40 CONTINUE
- X(J)=SUM
- 50 CONTINUE
- RETURN
- END
diff --git a/src/mathlib/gen/divon/locsch.F b/src/mathlib/gen/divon/locsch.F
deleted file mode 100644
index 4cd7df7..0000000
--- a/src/mathlib/gen/divon/locsch.F
+++ /dev/null
@@ -1,190 +0,0 @@
-*
-* $Id: locsch.F,v 1.1.1.1 1996/04/01 15:03:27 mclareni Exp $
-*
-* $Log: locsch.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:27 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE LOCSCH (IIMIN,N,NFREE,IFREE,X,FX,XLOW,XHI,DELTA,SUFTOL,
- 1NFCNT,Y,FY,Z,FZ,P)
- INTEGER IIMIN, N, NFREE, NFCNT
- INTEGER IFREE(N)
- DOUBLE PRECISION FX, DELTA, SUFTOL, FY, FZ
- DOUBLE PRECISION X(N), XLOW(N), XHI(N), Y(N), Z(N), P(N)
- INTEGER I, II, ILOC, ITEST
- DOUBLE PRECISION A, B, B1, D, DELX, DFUN, E, EPSMCH, ETA, FA,
- 1 FBEST, FSAV, FTEST, FU, FV, FW, GTEST1, GTEST2,
- 2 GTP, GU, OLDF, PE, PNORM, R, RR, RTEPS,
- 3 SCXBD, SFTBND, SMAX, SNMAX, SOPP, SPMAX, SS,
- 4 SSAV, STP, STPDN, STPNEG, STPPOS, STPUP, T,
- 5 TOL, U, XBEST, XLAMDA, XV, XW, YSAV
- DATA EPSMCH/2.22D-16/
- RTEPS=SQRT(EPSMCH)
- DELX=DELTA
- DO 10 I=1,N
- Y(I)=X(I)
- Z(I)=X(I)
- 10 CONTINUE
- FZ=FX
- FY=FX
- SMAX=1.0D+30
- DO 40 I=1,NFREE
- II=IFREE(I)
- STPUP=XHI(II)-X(II)
- STPDN=X(II)-XLOW(II)
- IF(STPUP.LT.STPDN) GOTO 20
- P(I)=1.0D+0
- STP=STPUP
- GOTO 30
- 20 P(I)=-1.0D+0
- STP=STPDN
- 30 IF(STP.LT.SMAX) SMAX=STP
- 40 CONTINUE
- SMAX=0.9D+0*SMAX
- 50 IF(DELX.GT.SMAX) DELX=SMAX
- DO 60 I=1,NFREE
- II=IFREE(I)
- Y(II)=X(II)+DELX*P(I)
- 60 CONTINUE
- FY=DFUN(N,Y)
- IF(IIMIN.EQ.2) FY=-FY
- NFCNT=NFCNT+1
- FTEST=SUFTOL*(1.0D+0+ABS(FX))
- IF(ABS(FX-FY).GT.FTEST.OR.DELX.EQ.SMAX) GOTO 70
- DELX=5.0D+0*DELX
- GOTO 50
- 70 DELX=DELTA
- CALL ORTHVC(N,NFREE,IFREE,X,FX,XLOW,XHI,Y,FY,P,SPMAX,SNMAX)
- SMAX=0.9D+0*SPMAX
- SOPP=0.9D+0*SNMAX
- IF(SMAX.GE.SNMAX.OR.NFREE.EQ.1) GOTO 90
- DO 80 I=1,NFREE
- P(I)=-P(I)
- 80 CONTINUE
- SSAV=SMAX
- SMAX=SOPP
- SOPP=SSAV
- 90 IF(DELX.GT.SMAX) DELX=SMAX
- 100 DO 110 I=1,NFREE
- II=IFREE(I)
- Z(II)=Y(II)+DELX*P(I)
- 110 CONTINUE
- FZ=DFUN(N,Z)
- IF(IIMIN.EQ.2) FZ=-FZ
- NFCNT=NFCNT+1
- FTEST=SUFTOL*(1.0D+0+ABS(FY))
- IF(ABS(FY-FZ).GT.FTEST.OR.(5.0D+0*DELX).GT.SMAX) GOTO 120
- DELX=5.0D+0*DELX
- GOTO 100
- 120 IF(FY.EQ.FZ) GOTO 210
- IF(FY.LT.FZ) GOTO 130
- GTP=(FZ-FY)/DELX
- XLAMDA=SMAX/0.9D+0
- U=MIN(2.0D+0*DELX,SMAX)
- GOTO 160
- 130 DO 140 I=1,NFREE
- P(I)=-P(I)
- 140 CONTINUE
- U=MIN(2.0D+0*DELX,SOPP)
- XLAMDA=SOPP/0.9D+0+DELX
- GTP=(FY-FZ)/DELX
- DO 150 I=1,N
- YSAV=Y(I)
- Y(I)=Z(I)
- Z(I)=YSAV
- 150 CONTINUE
- FSAV=FY
- FY=FZ
- FZ=FSAV
- 160 CALL RLEN(NFREE,P,PNORM)
- PE=PNORM+RTEPS
- ILOC=1
- FU=FY
- GU=GTP
- SFTBND=0.0D+0
- ETA=RTEPS
- T=RTEPS/PE
- 170 CALL NEWPTQ(RTEPS,T,ETA,SFTBND,XLAMDA,U,FU,GU,XBEST,FBEST,XW,FW,X
- 1V,FV,A,FA,B,OLDF,B1,SCXBD,E,D,RR,SS,GTEST1,GTEST2,TOL,ILOC,ITEST)
- IF(ITEST.NE.1) GOTO 190
- R=XBEST+U
- DO 180 I=1,NFREE
- II=IFREE(I)
- Z(II)=Y(II)+R*P(I)
- 180 CONTINUE
- FU=DFUN(N,Z)
- IF(IIMIN.EQ.2) FU=-FU
- NFCNT=NFCNT+1
- FZ=FU
- GOTO 170
- 190 IF(ITEST.NE.0) GOTO 210
- DO 200 I=1,NFREE
- II=IFREE(I)
- Z(II)=Y(II)+XBEST*P(I)
- 200 CONTINUE
- FZ=FBEST
- 210 IF(FZ.EQ.FX) RETURN
- DO 220 I=1,NFREE
- II=IFREE(I)
- P(I)=Z(II)-X(II)
- 220 CONTINUE
- SPMAX=1.0D+30
- SNMAX=1.0D+30
- DO 230 I=1,NFREE
- II=IFREE(I)
- CALL MXSTEP(X(II),XLOW(II),XHI(II),P(I),STPPOS,STPNEG)
- IF(STPPOS.LT.SPMAX) SPMAX=STPPOS
- IF(STPNEG.LT.SNMAX) SNMAX=STPNEG
- 230 CONTINUE
- CALL RLEN(NFREE,P,PNORM)
- GTP=FZ-FX
- U=MIN(2.0D+0,0.9D+0*SPMAX)
- XLAMDA=SPMAX
- IF(FZ.LT.FX) GOTO 270
- DELX=DELTA/(PNORM+RTEPS)
- IF(DELX.GT.0.9D+0*SNMAX) DELX=0.9D+0*SNMAX
- DO 240 I=1,NFREE
- II=IFREE(I)
- Y(II)=X(II)-DELX*P(I)
- 240 CONTINUE
- FY=DFUN(N,Y)
- IF(IIMIN.EQ.2) FY=-FY
- NFCNT=NFCNT+1
- IF(FY.LT.FX) GOTO 250
- IF(DELX.LT.1.0D+0) GTP=(FX-FY)/DELX
- GOTO 270
- 250 GTP=(FY-FX)/DELX
- DO 260 I=1,NFREE
- P(I)=-P(I)
- 260 CONTINUE
- U=MIN(2.0D+0*DELX,0.9D+0*SNMAX)
- XLAMDA=SNMAX
- 270 ILOC=1
- PE=PNORM+RTEPS
- FU=FX
- GU=GTP
- SFTBND=0.0D+0
- ETA=RTEPS
- T=RTEPS/PE
- 280 CALL NEWPTQ(RTEPS,T,ETA,SFTBND,XLAMDA,U,FU,GU,XBEST,FBEST,XW,FW,X
- 1V,FV,A,FA,B,OLDF,B1,SCXBD,E,D,RR,SS,GTEST1,GTEST2,TOL,ILOC,ITEST)
- IF(ITEST.NE.1) GOTO 300
- R=XBEST+U
- DO 290 I=1,NFREE
- II=IFREE(I)
- Y(II)=X(II)+R*P(I)
- 290 CONTINUE
- FU=DFUN(N,Y)
- IF(IIMIN.EQ.2) FU=-FU
- NFCNT=NFCNT+1
- GOTO 280
- 300 IF(ITEST.NE.0) RETURN
- DO 310 I=1,NFREE
- II=IFREE(I)
- Z(II)=X(II)+XBEST*P(I)
- 310 CONTINUE
- FZ=FBEST
- RETURN
- END
diff --git a/src/mathlib/gen/divon/modchl.F b/src/mathlib/gen/divon/modchl.F
deleted file mode 100644
index 6e15501..0000000
--- a/src/mathlib/gen/divon/modchl.F
+++ /dev/null
@@ -1,57 +0,0 @@
-*
-* $Id: modchl.F,v 1.1.1.1 1996/04/01 15:03:26 mclareni Exp $
-*
-* $Log: modchl.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:26 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE MODCHL (N,NADIM,AHESS,ALPHA,Z,IFAIL)
- INTEGER N, NADIM, IFAIL
- DOUBLE PRECISION ALPHA
- DOUBLE PRECISION AHESS(NADIM,N), Z(N)
- INTEGER I, IB, IP1, J, K
- DOUBLE PRECISION A, BETA, DB, DI, GAMMA, P1, RMAX, T, W
-#if defined(CERNLIB_IBM)||defined(CERNLIB_SINGLE)
- RMAX=7.2D+75
-#endif
-#if (!defined(CERNLIB_IBM))&&(defined(CERNLIB_DOUBLE))
- RMAX= 1.0D+37
-#endif
- IFAIL=0
- A=ALPHA
- K=0
- DO 50 I=1,N
- P1=Z(I)
- DI=AHESS(I,I)
- T=A*P1
- DB=DI+T*P1
- AHESS(I,I)=DB
- IF(DB.GE.1.0D+0) GOTO 10
- IF(DB.GT.0.0D+0.AND.DI.LE.RMAX*DB) GOTO 10
- IFAIL=1
- RETURN
- 10 GAMMA=DI/DB
- BETA=T/DB
- A=A*GAMMA
- K=K+I
- J=K
- IF(I.EQ.N) GOTO 50
- IP1=I+1
- IF(GAMMA.GE.2.5D-1) GOTO 30
- DO 20 IB=IP1,N
- T=AHESS(IB,I)
- AHESS(IB,I)=T*GAMMA+BETA*Z(IB)
- Z(IB)=Z(IB)-P1*T
- 20 CONTINUE
- GOTO 50
- 30 DO 40 IB=IP1,N
- T=AHESS(IB,I)
- W=Z(IB)-P1*T
- Z(IB)=W
- AHESS(IB,I)=BETA*W+T
- 40 CONTINUE
- 50 CONTINUE
- RETURN
- END
diff --git a/src/mathlib/gen/divon/mulchk.F b/src/mathlib/gen/divon/mulchk.F
deleted file mode 100644
index bb4e977..0000000
--- a/src/mathlib/gen/divon/mulchk.F
+++ /dev/null
@@ -1,40 +0,0 @@
-*
-* $Id: mulchk.F,v 1.1.1.1 1996/04/01 15:03:27 mclareni Exp $
-*
-* $Log: mulchk.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:27 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE MULCHK (N,NACTV,IACTV,IIMIN,TOL,X,XHI,FTRUE,DELTA,XTEMP
- 1,GACTV,NEGMUL,IBDEL,IBTRUE)
- INTEGER N, NACTV, IIMIN, IBDEL, IBTRUE
- INTEGER IACTV(NACTV)
- LOGICAL NEGMUL
- DOUBLE PRECISION FTRUE, DELTA, TOL
- DOUBLE PRECISION X(N), XHI(N), XTEMP(N), GACTV(NACTV)
- INTEGER I
- DOUBLE PRECISION SIG, XLTEST, XMULOW
- CALL GRDCMP(N,NACTV,IACTV,X,FTRUE,DELTA,XHI,XTEMP,GACTV)
- IF(IIMIN.EQ.1) GOTO 20
- DO 10 I=1,NACTV
- GACTV(I)=-GACTV(I)
- 10 CONTINUE
- 20 NEGMUL=.FALSE.
- IBDEL=0
- IBTRUE=0
- XMULOW=0.0D+0
- DO 30 I=1,NACTV
- SIG=1.0D+0
- IF(IACTV(I).LT.0) SIG=-1.0D+0
- XLTEST=GACTV(I)*SIG
- IF(XLTEST.GE.(-TOL)) GOTO 30
- NEGMUL=.TRUE.
- IF(XLTEST.GE.XMULOW) GOTO 30
- XMULOW=XLTEST
- IBDEL=I
- IBTRUE=IACTV(I)
- 30 CONTINUE
- RETURN
- END
diff --git a/src/mathlib/gen/divon/mxstep.F b/src/mathlib/gen/divon/mxstep.F
deleted file mode 100644
index a864efc..0000000
--- a/src/mathlib/gen/divon/mxstep.F
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: mxstep.F,v 1.1.1.1 1996/04/01 15:03:28 mclareni Exp $
-*
-* $Log: mxstep.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:28 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE MXSTEP (X,XLOW,XHI,P,STPPOS,STPNEG)
- DOUBLE PRECISION X, XLOW, XHI, P, STPPOS, STPNEG
- IF(P.EQ.0.0D+0) RETURN
- IF(P.GT.0.0D+0) GOTO 10
- STPPOS=-(X-XLOW)/P
- STPNEG=-(XHI-X)/P
- RETURN
- 10 STPPOS=(XHI-X)/P
- STPNEG=(X-XLOW)/P
- RETURN
- END
diff --git a/src/mathlib/gen/divon/newptq.F b/src/mathlib/gen/divon/newptq.F
deleted file mode 100644
index 6260829..0000000
--- a/src/mathlib/gen/divon/newptq.F
+++ /dev/null
@@ -1,163 +0,0 @@
-*
-* $Id: newptq.F,v 1.1.1.1 1996/04/01 15:03:28 mclareni Exp $
-*
-* $Log: newptq.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:28 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE NEWPTQ (EPS,T,ETA,SFTBND,XLAMDA,U,FU,GU,XMIN,FMIN,XW,FW
- 1,XV,FV,A,FA,B,OLDF,B1,SCXBD,E,D,RR,SS,GTEST1,GTEST2,TOL,ILOC,ITEST
- 2)
- INTEGER ILOC, ITEST
- DOUBLE PRECISION EPS, T, ETA, SFTBND, XLAMDA, U, FU, GU,
- 1 XMIN, FMIN, XW, FW, XV, FV, A, FA, B, OLDF,
- 2 B1, SCXBD, E, D, RR, SS, GTEST1, GTEST2, TOL
- DOUBLE PRECISION A1, D1, D2, Q, R, S, T2, XM
- GOTO (10,20,20,230,220),ILOC
- 10 ITEST=2
- TOL=T
- T2=TOL+TOL
- IF(U.LE.0.0D+0.OR.XLAMDA.LE.T2.OR.GU.GT.0.0D+0) RETURN
- ITEST=1
- XMIN=0.0D+0
- XW=0.0D+0
- XV=0.0D+0
- A=0.0D+0
- OLDF=FU
- FMIN=FU
- FW=FU
- FV=FU
- FA=FU
- D=U
- SCXBD=EPS*ABS(XLAMDA)+T
- B=XLAMDA+SCXBD
- E=B
- B1=B
- SCXBD=XLAMDA-SCXBD/(1.0D+0+EPS)
- GTEST1=-1.0D-4*GU
- GTEST2=-ETA*GU
- ILOC=2
- GOTO 190
- 20 IF(FU.GT.FMIN) GOTO 50
- IF(U.LT.0.0D+0) GOTO 30
- A=0.0D+0
- FA=FMIN
- GOTO 40
- 30 B=0.0D+0
- 40 XV=XW
- FV=FW
- FW=FMIN
- FMIN=FU
- XMIN=XMIN+U
- A=A-U
- B=B-U
- XV=XV-U
- XW=0.0D+0-U
- SCXBD=SCXBD-U
- TOL=EPS*ABS(XMIN)+T
- T2=TOL+TOL
- GOTO 90
- 50 IF(U.GE.0.0D+0) GOTO 60
- A=U
- FA=FU
- GOTO 70
- 60 B=U
- 70 IF(FU.GT.FW.AND.XW.NE.0.0D+0) GOTO 80
- XV=XW
- FV=FW
- XW=U
- FW=FU
- GOTO 90
- 80 IF(FU.GT.FV.AND.XV.NE.0.0D+0.AND.XV.NE.XW) GOTO 90
- XV=U
- FV=FU
- 90 XM=5.0D-1*(A+B)
- IF(ABS(XM).LE.T2-5.0D-1*(B-A).OR.XMIN+B.LE.SFTBND.OR.FA-FMIN.LE.
- 1ABS(A)*GTEST2.AND.FMIN.LT.OLDF.AND.(ABS(XMIN-XLAMDA).GT.TOL.OR.S
- 2CXBD.LT.B)) GOTO 210
- R=0.0D+0
- Q=0.0D+0
- S=0.0D+0
- IF(ABS(E).LE.TOL) GOTO 120
- IF(ILOC.NE.2) GOTO 100
- Q=2.0D+0*(FW-FMIN-XW*GU)
- S=GU*XW*XW
- IF(XMIN.NE.0.0D+0) S=(2.0D+0*(FMIN-FW)+XW*GU)*XW
- GOTO 110
- 100 R=XW*(FV-FMIN)
- Q=XV*(FW-FMIN)
- S=R*XW-Q*XV
- Q=2.0D+0*(Q-R)
- 110 IF(Q.GT.0.0D+0) S=-S
- IF(Q.LE.0.0D+0) Q=-Q
- R=E
- IF(D.NE.B1.OR.B.LE.SCXBD) E=D
- 120 A1=A
- B1=B
- IF(XMIN.NE.A) GOTO 130
- D=XM
- GOTO 160
- 130 IF(B.LE.SCXBD) GOTO 140
- D=-4.0D+0*A
- IF(D.GE.B) D=SCXBD
- GOTO 160
- 140 D1=A
- D2=B
- IF(ABS(D2).GT.TOL.AND.(XW.LE.0.0D+0.OR.ABS(D1).LE.TOL)) GOTO 1
- 150
- U=D1
- D1=D2
- D2=U
- 150 U=-D1/D2
- D=5.0D+0*D2*(1.0D-1+1.0D+0/U)/1.1D+1
- IF(U.LT.1.0D+0) D=5.0D-1*D2*SQRT(U)
- 160 IF(D.LE.0.0D+0) A1=D
- IF(D.GT.0.0D+0) B1=D
- IF(ABS(S).GE.ABS(5.0D-1*Q*R).OR.S.LE.Q*A1.OR.S.GE.Q*B1) GOTO 1
- 170
- D=S/Q
- IF(D-A.GE.T2.AND.B-D.GE.T2) GOTO 180
- D=TOL
- IF(XM.LE.0.0D+0) D=-TOL
- GOTO 180
- 170 E=B
- IF(XM.LE.0.0D+0) E=A
- 180 ILOC=3
- 190 IF(D.LT.SCXBD) GOTO 200
- D=SCXBD
- SCXBD=SCXBD*(1.0D+0+7.5D-1*EPS)+7.5D-1*TOL
- 200 U=D
- IF(ABS(D).LT.TOL.AND.D.LE.0.0D+0) U=-TOL
- IF(ABS(D).LT.TOL.AND.D.GT.0.0D+0) U=TOL
- ITEST=1
- RETURN
- 210 RR=XMIN
- SS=5.0D-1
- FU=FMIN
- 220 IF(ABS(XMIN-XLAMDA).GE.TOL.OR.XMIN.EQ.T) GOTO 230
- XMIN=XLAMDA
- IF(SCXBD.LE.B) GOTO 230
- U=0.0D+0
- ILOC=4
- ITEST=1
- RETURN
- 230 IF(XMIN+B.GT.SFTBND) GOTO 240
- ITEST=4
- RETURN
- 240 IF(OLDF-FU.LE.GTEST1*XMIN) GOTO 250
- FMIN=FU
- ITEST=0
- RETURN
- 250 IF(XMIN.NE.T) GOTO 260
- ITEST=3
- RETURN
- 260 XMIN=RR*SS
- SS=SS*SS
- IF(XMIN.LT.T) XMIN=T
- ITEST=1
- U=0.0D+0
- ILOC=5
- RETURN
- END
diff --git a/src/mathlib/gen/divon/nmdchl.F b/src/mathlib/gen/divon/nmdchl.F
deleted file mode 100644
index b79bda5..0000000
--- a/src/mathlib/gen/divon/nmdchl.F
+++ /dev/null
@@ -1,53 +0,0 @@
-*
-* $Id: nmdchl.F,v 1.1.1.1 1996/04/01 15:03:26 mclareni Exp $
-*
-* $Log: nmdchl.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:26 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE NMDCHL (N,NADIM,AHESS,EPSMCH,Z,P)
- INTEGER N, NADIM
- DOUBLE PRECISION EPSMCH
- DOUBLE PRECISION Z(N), AHESS(NADIM,N), P(N)
-C*NS INTEGER I, IB, IQ, J, JN1, JP1, K
-C*NS INTEGER I, IB, J, JN1, JP1, K
- DOUBLE PRECISION BETA, DJ, G, GAMMA, GAMMA1, PJ, T
- GAMMA=0.0D+0
- J=1
- DO 30 I=1,N
- T=Z(I)
- IF(I.EQ.1) GOTO 20
- K=I-1
- DO 10 IB=1,K
- T=T-P(IB)*AHESS(I,IB)
- 10 CONTINUE
- 20 P(I)=T
- GAMMA=GAMMA+T*T/AHESS(I,I)
- 30 CONTINUE
- GAMMA1=1.0D+0-GAMMA
- GAMMA=EPSMCH
- IF(GAMMA1.GT.EPSMCH) GAMMA=GAMMA1
- IF(-GAMMA1.GT.EPSMCH) GAMMA=-GAMMA1
- JN1=N+1
- DO 50 I=1,N
- J=JN1-I
- PJ=P(J)
- DJ=AHESS(J,J)
- T=PJ/DJ
- Z(J)=PJ
- BETA=-T/GAMMA
- G=GAMMA+PJ*T
- AHESS(J,J)=DJ*GAMMA/G
- GAMMA=G
- IF(J.EQ.N) GOTO 50
- JP1=J+1
- DO 40 IB=JP1,N
- T=AHESS(IB,J)
- AHESS(IB,J)=T+BETA*Z(IB)
- Z(IB)=Z(IB)+PJ*T
- 40 CONTINUE
- 50 CONTINUE
- RETURN
- END
diff --git a/src/mathlib/gen/divon/nocut.F b/src/mathlib/gen/divon/nocut.F
deleted file mode 100644
index 2c6ca4f..0000000
--- a/src/mathlib/gen/divon/nocut.F
+++ /dev/null
@@ -1,43 +0,0 @@
-*
-* $Id: nocut.F,v 1.1.1.1 1996/04/01 15:03:25 mclareni Exp $
-*
-* $Log: nocut.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:25 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE NOCUT (N,XLOW,XUP,Z,IDSCNT,IDSCRM,PARTN,NFCNT)
- INTEGER N, IDSCNT, IDSCRM, NFCNT
- DOUBLE PRECISION PARTN
- DOUBLE PRECISION XLOW(N), XUP(N), Z(N)
- INTEGER I, MOD
-CMM DOUBLE PRECISION DABS, DEVMAX, DFUN, XSAVE, YMID, YLOW, YUP, YDIF
- DOUBLE PRECISION DEVMAX, DFUN, XSAVE, YMID, YLOW, YUP, YDIF
- DEVMAX=0.0D+0
- DO 10 I=1,N
- Z(I)=0.5D+0*(XLOW(I)+XUP(I))
- 10 CONTINUE
- YMID=DFUN(N,Z)
- DO 30 I=1,N
- XSAVE=Z(I)
- Z(I)=XLOW(I)
- YLOW=DFUN(N,Z)
- Z(I)=XUP(I)
- YUP=DFUN(N,Z)
- YDIF=ABS(YMID-0.5D+0*(YLOW+YUP))
- IF(YDIF.LT.DEVMAX) GOTO 20
- DEVMAX=YDIF
- PARTN=XSAVE
- IDSCRM=I
- 20 Z(I)=XSAVE
- 30 CONTINUE
- NFCNT=NFCNT+2*N+1
- IF(DEVMAX.NE.0.0D+0) GOTO 40
- IDSCRM=MOD(IDSCNT,N)+1
- PARTN=Z(IDSCRM)
- IDSCNT=IDSCNT+1
- RETURN
- 40 IDSCNT=0
- RETURN
- END
diff --git a/src/mathlib/gen/divon/nodaud.F b/src/mathlib/gen/divon/nodaud.F
deleted file mode 100644
index 7badff7..0000000
--- a/src/mathlib/gen/divon/nodaud.F
+++ /dev/null
@@ -1,80 +0,0 @@
-*
-* $Id: nodaud.F,v 1.1.1.1 1996/04/01 15:03:25 mclareni Exp $
-*
-* $Log: nodaud.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:25 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE NODAUD (PARENT,TNODE,NEWNOD,NEWLFT,TREE)
- INTEGER PARENT,TNODE,NEWNOD,TREE(4,1000),SON,NEWLFT
- INTEGER SNODES(100)
- INTEGER PNODES,MNODES
- IF(100.GT.100) GOTO 200
- PNODES=0
- MNODES=100
- PNODES=PNODES+1
- IF(PNODES.GT.MNODES) GOTO 160
- SNODES(PNODES)=PARENT
- 10 IF(TNODE.GT.TREE(1,PARENT)) GOTO 40
- IF(PNODES.LE.0) GOTO 150
- PARENT=SNODES(PNODES)
- IF(TREE(4,PARENT).GE.0) GOTO 20
- SON=TREE(2,PARENT)
- GOTO 30
- 20 SON=TREE(3,PARENT)
- 30 IF(SON.LE.0) GOTO 70
- PARENT=SON
- PNODES=PNODES+1
- IF(PNODES.GT.MNODES) GOTO 160
- SNODES(PNODES)=PARENT
- GOTO 70
- 40 IF(PNODES.LE.0) GOTO 150
- PARENT=SNODES(PNODES)
- IF(TREE(4,PARENT).LE.0) GOTO 50
- SON=TREE(2,PARENT)
- GOTO 60
- 50 SON=TREE(3,PARENT)
- 60 IF(SON.LE.0) GOTO 70
- PARENT=SON
- PNODES=PNODES+1
- IF(PNODES.GT.MNODES) GOTO 160
- SNODES(PNODES)=PARENT
- 70 IF(SON.GE.0) GOTO 10
- IF(TNODE.NE.-SON) GOTO 220
- GOTO 80
- 80 IF(TREE(4,PARENT).GE.0) GOTO 100
- IF(SON.NE.TREE(3,PARENT)) GOTO 90
- TREE(3,PARENT)=NEWNOD
- GOTO 120
- 90 TREE(2,PARENT)=NEWNOD
- GOTO 120
- 100 IF(SON.NE.TREE(2,PARENT)) GOTO 110
- TREE(2,PARENT)=NEWNOD
- GOTO 120
- 110 TREE(3,PARENT)=NEWNOD
- 120 SON=NEWNOD
- 130 IF(TREE(2,PARENT).EQ.SON.AND.TREE(4,PARENT).LT.0.OR.TREE(3,PARENT
- 1).EQ.SON.AND.TREE(4,PARENT).GT.0) GOTO 140
- SON=PARENT
- PNODES=PNODES-1
- IF(PNODES.LT.0) GOTO 180
- IF(PNODES.LE.0) GOTO 150
- PARENT=SNODES(PNODES)
- GOTO 130
- 140 TREE(1,PARENT)=NEWLFT
- 150 RETURN
- 160 WRITE(6,170)
- 170 FORMAT(' NODAUD STACK OVERFLOW')
- STOP
- 180 WRITE(6,190)
- 190 FORMAT(' NODAUD STACK UNDERFLOW')
- STOP
- 200 WRITE(6,210)
- 210 FORMAT(' NODAUD IMPOSSIBLE')
- STOP
- 220 WRITE(6,230) TNODE,TREE(SON,PARENT)
- 230 FORMAT(' LOOKING FOR BUCKET ',I10,' BUT FOUND ',I10)
- STOP
- END
diff --git a/src/mathlib/gen/divon/orthvc.F b/src/mathlib/gen/divon/orthvc.F
deleted file mode 100644
index 8af8f4e..0000000
--- a/src/mathlib/gen/divon/orthvc.F
+++ /dev/null
@@ -1,50 +0,0 @@
-*
-* $Id: orthvc.F,v 1.1.1.1 1996/04/01 15:03:28 mclareni Exp $
-*
-* $Log: orthvc.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:28 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE ORTHVC (N,NFREE,IFREE,X,FX,XLOW,XHI,Y,FY,P,SPMAX,SNMAX)
- INTEGER N, NFREE
- INTEGER IFREE(NFREE)
- DOUBLE PRECISION FX, FY, SPMAX, SNMAX
- DOUBLE PRECISION X(N), XLOW(N), XHI(N), Y(N), P(N)
- INTEGER I, II, KTEST, NFRM1, NTEMP
- LOGICAL EVEN
- DOUBLE PRECISION STPNEG, STPPOS
- KTEST=2*(NFREE/2)
- EVEN=.FALSE.
- IF(KTEST.EQ.NFREE) EVEN=.TRUE.
- NTEMP=NFREE
- IF(.NOT.EVEN) NTEMP=NFREE-1
- IF(NTEMP.GT.0) GOTO 10
- IF(FY.GT.FX) P(1)=-P(1)
- II=IFREE(1)
- CALL MXSTEP(Y(II),XLOW(II),XHI(II),P(1),SPMAX,SNMAX)
- RETURN
- 10 SPMAX=1.0D+30
- SNMAX=1.0D+30
- DO 20 I=1,NTEMP,2
- II=IFREE(I)
- CALL MXSTEP(Y(II),XLOW(II),XHI(II),P(I),STPPOS,STPNEG)
- IF(STPPOS.LT.SPMAX) SPMAX=STPPOS
- IF(STPNEG.LT.SNMAX) SNMAX=STPNEG
- II=IFREE(I+1)
- P(I+1)=-P(I+1)
- CALL MXSTEP(Y(II),XLOW(II),XHI(II),P(I+1),STPPOS,STPNEG)
- IF(STPPOS.LT.SPMAX) SPMAX=STPPOS
- IF(STPNEG.LT.SNMAX) SNMAX=STPNEG
- 20 CONTINUE
- IF(EVEN) RETURN
- NFRM1=NFREE-1
- P(NFRM1)=P(NFRM1)/2.0D+0
- P(NFREE)=-P(NFREE)/2.0D+0
- II=IFREE(NFREE)
- CALL MXSTEP(Y(II),XLOW(II),XHI(II),P(NFREE),STPPOS,STPNEG)
- IF(STPPOS.LT.SPMAX) SPMAX=STPPOS
- IF(STPNEG.LT.SNMAX) SNMAX=STPNEG
- RETURN
- END
diff --git a/src/mathlib/gen/divon/partn.F b/src/mathlib/gen/divon/partn.F
deleted file mode 100644
index 9c71700..0000000
--- a/src/mathlib/gen/divon/partn.F
+++ /dev/null
@@ -1,192 +0,0 @@
-*
-* $Id: partn.F,v 1.1.1.1 1996/04/01 15:03:24 mclareni Exp $
-*
-* $Log: partn.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:24 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE PARTN (NDIM,GMINUS,GPLUS,GOOD,MAXFUN)
- INTEGER NDIM, NPOINT, MAXFUN
- REAL FLOBD, FUPBD, GOOD
- REAL GMINUS(10), GPLUS(10)
- COMMON /PRINT/ IPRINT
-#include "d151dt.inc"
- COMMON /ISTRGE/ MXRGNS,TREE(4,1),DUMMY1(11996)
- INTEGER MXRGNS, TREE
- COMMON /RSTRGE/ RSTSZE,PRTNS(18001)
- INTEGER RSTSZE
- COMMON /MLIMIT/ MFLAG
- LOGICAL MFLAG
- COMMON /TRESZE/ ENTREE,ENTBUC
- INTEGER ENTREE, ENTBUC
- COMMON /START/ ISTART
- INTEGER ISTART
- COMMON /EXFILE/ NFILE
- INTEGER NFILE
- COMMON /DISPOS/ IDISP
- INTEGER IDISP
- COMMON /QUADRE/ IDEG
- INTEGER IDEG
- COMMON /BUKSZE/ MAXWRD
- INTEGER MAXWRD
- COMMON /GENINL/ INLGEN
- INTEGER INLGEN
- COMMON /LIMITS/ QMINUS(10),QPLUS(10)
- COMMON /SAMPLE/ NPOINT
- COMMON /BNDLMT/ FLOBD,FUPBD
- REAL UMINUS(10),UPLUS(10)
- INTEGER MAXDPH,PARENT
- INTEGER TARGET,MAXBUC,NEWENT,OLDSTR,NEWBUC,NEWEND,EXMBUC
- INTEGER NXRGNS,NEEDST,NMOVE
-C INITIALISATION OF CONSTANTS
- CALL DVNBKD
-C
- IF(NDIM.LE.10) GOTO 20
- WRITE(6,10) NDIM
- 10 FORMAT('0DIMENSION = ',I5,' IS LARGER THAN UPPER LIMIT SET AT',
- 1' COMPILE TIME.')
- STOP
- 20 DO 30 I=1,NDIM
- QMINUS(I)=GMINUS(I)
- QPLUS(I)=GPLUS(I)
- 30 CONTINUE
- MAXWRD=4
- IF(IDEG.EQ.1) MAXWRD=7
- IF(IDEG.GE.2) MAXWRD=MAXWRD+1
- IF(IDEG.GE.3) MAXWRD=MAXWRD+1
- IF(IDEG.EQ.5) MAXWRD=MAXWRD+1
- NEEDST=MXRGNS*(MAXWRD+1)+MAX((NDIM+1)*(NPOINT+5),MXRGNS)+1
- IF(NEEDST.LE.RSTSZE) GOTO 40
- NEEDST=RSTSZE-1
- MXRGNS=NEEDST/(MAXWRD+2)
- IF(MXRGNS.LT.(NDIM+1)*(NPOINT+5)) MXRGNS=(NEEDST-(NDIM+1)*(NPOINT
- 1+5))/(MAXWRD+1)
- 40 IF(ISTART.NE.2.AND.ISTART.NE.3) ISTART=1
- INLGEN=NPOINT
- IF(IPRINT.EQ.0) GOTO 120
- WRITE(6,50) IDATE
- 50 FORMAT('1PARTN VERSION OF ',A8)
- WRITE(6,60) NDIM,GOOD,MAXFUN
- 60 FORMAT(1X,I2,' DIMENSIONS. MAXIMUM RSS SPREAD OF',G13.5/
- 1 ' WITH A MAXIMUM OF ',I6,' INTEGRAND EVALUATIONS.')
- IF(ISTART.NE.1) GOTO 80
- WRITE(6,70)
- 70 FORMAT(' BEGIN PARTITIONING.')
- GOTO 120
- 80 IF(ISTART.NE.3) GOTO 100
- WRITE(6,90) NFILE
- 90 FORMAT(' CONTINUE PARTITIONING READ FROM TAPE',I2)
- GOTO 120
- 100 IF(ISTART.NE.2) GOTO 120
- WRITE(6,110)
- 110 FORMAT(' PARTITIONING CONTINUES.')
- 120 MFLAG=.FALSE.
- IRM=18001-MXRGNS
- I=EXMBUC(1,NDIM,PRTNS(MXRGNS+1),GOOD,MAXFUN,MAXDPH,IRM)
- IF(ISTART.NE.1) GOTO 140
- ENTREE=1
- ENTBUC=ENTREE
- MXWDSV=MAXWRD
- NXRGNS=MXRGNS
- DO 130 I=1,NDIM
- UPLUS(I)=GPLUS(I)
- UMINUS(I)=GMINUS(I)
- 130 CONTINUE
- IMR=18001-MXRGNS
- CALL RECPAR(NDIM,UMINUS,UPLUS,FLOBD,FUPBD,MAXDPH,ENTREE,TREE,PRTN
- 1S,ENTBUC,PRTNS(MXRGNS+1),IMR)
- GOTO 160
- 140 IF(ISTART.NE.3) GOTO 160
- READ (NFILE) ENTREE,INFO,NXRGNS,MXWDSV,((TREE(I,J),I=1,4),J=1,ENTR
- 1EE),(PRTNS(J),J=1,INFO)
- ENTBUC=(INFO-NXRGNS)/MXWDSV
- IF(ENTREE.EQ.ENTBUC-1) GOTO 160
- WRITE(6,150) NFILE
- 150 FORMAT(' INCONSISTENT INFORMATION ON TAPE',I2)
- STOP
- 160 IF(NXRGNS.EQ.MXRGNS) GOTO 230
- NMOVE=MXWDSV*NXRGNS
- IF(NXRGNS.LE.MXRGNS) GOTO 200
- IF(ENTBUC.LT.MXRGNS) GOTO 180
- WRITE(6,170) MXRGNS,ENTBUC
- 170 FORMAT(' MAXIMUM NUMBER OF REGIONS ',I5,' IS TOO SMALL.'/
- 1 ' RESET TO GREATER THAN ',I5,'.')
- STOP
- 180 DO 190 I=1,NMOVE
- PRTNS(I+MXRGNS)=PRTNS(I+NXRGNS)
- 190 CONTINUE
- GOTO 230
- 200 I=NMOVE
- GOTO 220
- 210 I=I+(-1)
- 220 IF((-1)*((I)-(1)).GT.0) GOTO 230
- PRTNS(I+MXRGNS)=PRTNS(I+NXRGNS)
- GOTO 210
- 230 IF(MXWDSV.EQ.MAXWRD) GOTO 300
- IF(MXWDSV.GE.MAXWRD) GOTO 270
- I=ENTBUC
- GOTO 250
- 240 I=I+(-1)
- 250 IF((-1)*((I)-(1)).GT.0) GOTO 300
- DO 260 J=1,MXWDSV
- PRTNS(MAXWRD*(I-1)+J+MXRGNS)=PRTNS(MXWDSV*(I-1)+J+MXRGNS)
- 260 CONTINUE
- GOTO 240
- 270 DO 290 I=1,ENTBUC
- DO 280 J=1,MAXWRD
- PRTNS(MAXWRD*(I-1)+J+MXRGNS)=PRTNS(MXWDSV*(I-1)+J+MXRGNS)
- 280 CONTINUE
- 290 CONTINUE
- 300 TARGET=EXMBUC(ENTBUC,NDIM,PRTNS(MXRGNS+1),GOOD,MAXFUN,MAXDPH,IRM)
- IF(TARGET.EQ.0) GOTO 350
- PARENT=1
- DO 310 I=1,NDIM
- UPLUS(I)=GPLUS(I)
- UMINUS(I)=GMINUS(I)
- 310 CONTINUE
- CALL BOUNDS(TARGET,PARENT,TREE,PRTNS,UMINUS,UPLUS)
- NEWENT=ENTREE+1
- NEWBUC=ENTBUC+1
- IMR=18001-MXRGNS
- CALL RECPAR(NDIM,UMINUS,UPLUS,FLOBD,FUPBD,MAXDPH,NEWENT,TREE,PRTN
- 1S,NEWBUC,PRTNS(MXRGNS+1),IMR)
- IF(.NOT.(MFLAG)) GOTO 330
- WRITE(6,320) MXRGNS
- 320 FORMAT(' STORAGE LIMIT ',I6,' REACHED.')
- GOTO 350
- 330 IF(NEWBUC.EQ.ENTBUC+1) GOTO 350
- MAXBUC=NEWBUC
- PARENT=ENTREE+1
- OLDSTR=ENTBUC+1
- NEWBUC=TARGET
- CALL TREAUD(PARENT,OLDSTR,NEWBUC,MAXBUC-ENTBUC+NEWBUC-1,TREE)
- NEWEND=NEWBUC
- IF(TARGET.GE.ENTBUC) GOTO 340
- PARENT=1
- OLDSTR=TARGET+1
- NEWBUC=NEWBUC+1
- CALL TREAUD(PARENT,OLDSTR,NEWBUC,MAXBUC-1,TREE)
- 340 PARENT=1
- CALL NODAUD(PARENT,TARGET,ENTREE+1,NEWEND,TREE)
- I11=18001-MAXWRD*MXRGNS-MXRGNS
- I12=18001-MXRGNS
- CALL BUCMVE(TARGET,NEWEND,ENTBUC+1,PRTNS(MAXWRD*MXRGNS+MXRGNS+1),
- 1PRTNS(MXRGNS+1),I11,I12)
- ENTBUC=MAXBUC-1
- ENTREE=NEWENT
- GOTO 300
- 350 MXWDSV=MAXWRD
- NXRGNS=MXRGNS
- IF(IDISP.EQ.0) RETURN
- INFO=MXRGNS+MAXWRD*ENTBUC
- REWIND NFILE
- WRITE(NFILE) ENTREE,INFO,MXRGNS,MAXWRD,((TREE(I,J),I=1,4),J=1,ENT
- 1REE),(PRTNS(J),J=1,INFO)
- END FILE NFILE
- IF(IPRINT.EQ.0) GOTO 370
- WRITE(6,360) NFILE
- 360 FORMAT(' INFORMATION FOR RESTART WRITTEN ON TAPE',I2)
- 370 RETURN
- END
diff --git a/src/mathlib/gen/divon/quad.F b/src/mathlib/gen/divon/quad.F
deleted file mode 100644
index 58254cf..0000000
--- a/src/mathlib/gen/divon/quad.F
+++ /dev/null
@@ -1,116 +0,0 @@
-*
-* $Id: quad.F,v 1.1.1.1 1996/04/01 15:03:25 mclareni Exp $
-*
-* $Log: quad.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:25 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- REAL FUNCTION QUAD(D,DEG,LOWER,UPPER,FUN)
- INTEGER D,DEG
- REAL LOWER(D),UPPER(D),FUN
- EXTERNAL FUN
- INTEGER D0,DP1,TWOD,PT,NPTS,TIMES,KMAX
- REAL X(10,202),Y(10),Z(10),R
- DOUBLE PRECISION SUM0,SUM1,SUM2,B0,B1,B2
- REAL PI,TWOPI
- DATA PI,TWOPI /3.14159E+0,6.28319E+0/
- DATA D0 /0/
- IF(D.EQ.D0) GOTO 130
- D0=D
- SQ23=SQRT(2.0E+0/3.0E+0)
- SQ13I=1.0E+0/SQRT(3.0E+0)
- DP1=D+1
- TWOD=2*D
- KMAX=D/2
- DO 20 K=1,KMAX
- DO 10 J=1,DP1
- I=J-1
- X(2*K-1,J)=SQ23*COS(TWOPI*I*K/DP1)
- X(2*K,J)=SQ23*SIN(TWOPI*I*K/DP1)
- 10 CONTINUE
- 20 CONTINUE
- IF(MOD(D,2).NE.1) GOTO 40
- DO 30 I=1,DP1
- X(D,I)=-SQ13I*(-1)**I
- 30 CONTINUE
- 40 DO 60 K=1,KMAX
- DO 50 I=1,TWOD
- X(2*K-1,I+DP1)=SQ23*COS((2*K-1)*I*PI/D)
- X(2*K,I+DP1)=SQ23*SIN((2*K-1)*I*PI/D)
- 50 CONTINUE
- 60 CONTINUE
- IF(MOD(D,2).NE.1) GOTO 80
- DO 70 I=1,TWOD
- X(D,I+DP1)=SQ13I*(-1)**I
- 70 CONTINUE
- 80 I=1
- GOTO 100
- 90 I=I+1
- 100 IF((I).GT.(DP1+TWOD)) GOTO 120
- DO 110 J=1,D
- X(J,I)=0.5E+0*(X(J,I)+1.0E+0)
- 110 CONTINUE
- GOTO 90
- 120 R=0.5E+0*SQRT(3.0E+0/5.0E+0)
- B0=(25.0E+0*D**2-115.0E+0*D+162.0E+0)/162.0E+0
- B1=(70.0E+0-25.0E+0*D)/162.0E+0
- B2=25.0E+0/324.0E+0
- 130 IF(DEG.NE.2) GOTO 140
- PT=0
- NPTS=DP1
- GOTO 180
- 140 IF(DEG.NE.3) GOTO 150
- PT=DP1
- NPTS=TWOD
- GOTO 180
- 150 IF(DEG.NE.5) GOTO 160
- GOTO 210
- 160 WRITE(6,170) DEG
- 170 FORMAT(' ILLEGAL DEGREE =',G13.5)
- STOP
- 180 QUAD=0.0E+0
- DO 200 I=1,NPTS
- DO 190 J=1,D
- Y(J)=(UPPER(J)-LOWER(J))*X(J,I+PT)+LOWER(J)
- 190 CONTINUE
- QUAD=QUAD+FUN(D,Y)
- 200 CONTINUE
- QUAD=QUAD/NPTS
- RETURN
- 210 SUM0=0.0E+0
- SUM1=SUM0
- SUM2=SUM1
- DO 220 J=1,D
- Y(J)=0.5E+0*(UPPER(J)+LOWER(J))
- 220 CONTINUE
- SUM0=FUN(D,Y)
- DO 230 J=1,D
- Z(J)=(UPPER(J)-LOWER(J))*R
- 230 CONTINUE
- DO 240 I=1,D
- Y(I)=Y(I)+Z(I)
- SUM1=SUM1+FUN(D,Y)
- Y(I)=Y(I)-2.0E+0*Z(I)
- SUM1=SUM1+FUN(D,Y)
- Y(I)=Y(I)+Z(I)
- 240 CONTINUE
- DO 270 I=2,D
- Y(I)=Y(I)+Z(I)
- JMAX=I-1
- DO 260 TIMES=1,2
- DO 250 J=1,JMAX
- Y(J)=Y(J)+Z(J)
- SUM2=SUM2+FUN(D,Y)
- Y(J)=Y(J)-2.0E+0*Z(J)
- SUM2=SUM2+FUN(D,Y)
- Y(J)=Y(J)+Z(J)
- 250 CONTINUE
- Y(I)=Y(I)-2.0E+0*Z(I)
- 260 CONTINUE
- Y(I)=Y(I)+3.0E+0*Z(I)
- 270 CONTINUE
- QUAD=B0*SUM0+B1*SUM1+B2*SUM2
- RETURN
- END
diff --git a/src/mathlib/gen/divon/quasi.F b/src/mathlib/gen/divon/quasi.F
deleted file mode 100644
index cc43ac7..0000000
--- a/src/mathlib/gen/divon/quasi.F
+++ /dev/null
@@ -1,66 +0,0 @@
-*
-* $Id: quasi.F,v 1.1.1.1 1996/04/01 15:03:24 mclareni Exp $
-*
-* $Log: quasi.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:24 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE QUASI (X,NDIM,NGIVE,NF)
-C-- CORRECTED 830401 CERN GEN PAM 1.05
-C-- INITIAL VALUE OF I CHANGED FROM 1 TO 2 FOR CASE OF NPT LT 7
-C-- CORRECTED 850503 CERN GEN PAM 1.16
-C-- 17'TH IN LIST OF PRIME NUMBERS CORRECTED FROM 1197 TO 1187
- INTEGER NDIM,N,NGIVE
- REAL X(10,NGIVE)
- INTEGER PRIME(21),AA(20,9)
- REAL THETA(10)
- INTEGER D0,N0,A,P,IPT
- DATA D0,N0 /2*0/
- DATA PRIME / 7,19,29,37,47,97,149,199,293,397,499,599,691,797,887,
- 1997,1187, 1499,1789,1999,9999999 /
- DATA AA / 2,7,12,27,29,61,44,76,81,163,209,165,390,346,192,705, 65
- 16,629,1037,878, 2,3,20,13,30,78,67,73,103,274,405,248,585,305,674,
- 2650, 358,526,1540,1082, 2,9,21,16,37,64,29,114,211,157,241,472,371
- 3,477,113,252, 736,1205,853,1486, 2,2,27,35,44,8,110,42,258,104,445
- 4,21,640,665,678,535, 1003,56,1634,1781, 2,17,15,29,38,76,85,183,28
- 5,356,452,522,655,787,841,697, 1073,1025,1025,962, 2,17,2,2,2,67,12
- 68,94,257,393,395,395,355,341,397,361, 383,367,383,398, 2,17,2,19,2
- 7,79,139,149,170,165,169,161,157,171,149,167, 157,171,133,151, 2,17
- 8,2,19,45,2,139,67,170,87,169,85,157,89,81,167,157,75,89,83, 2,17,2
- 97,35,45,47,51,45,170,87,53,51,157,89,81,167,157,53,53,53 /
- N=ABS(NF)
- IF(NGIVE.LT.1.OR.NGIVE.GT.N) NGIVE=N
- IF(N.EQ.N0 .AND. NDIM.EQ.D0) GOTO 60
- N0=N
- D0=NDIM
- IPT=0
-C-- INITIAL VALUE CHANGED FROM 1 TO 2, PAM 1.05
- I=2
- GOTO 20
- 10 I=I+1
- 20 IF((I).GT.(21)) GOTO 30
- IF(PRIME(I).LE.N) GOTO 10
- 30 P=PRIME(I-1)
- A=AA(I-1,NDIM-1)
- THETA(1)=1.0E+0
- THETA(2)=A
- DO 40 I=3,NDIM
- THETA(I)=MOD(THETA(2)*THETA(I-1),REAL(P))
- 40 CONTINUE
- DO 50 I=1,NDIM
- THETA(I)=THETA(I)/P
- 50 CONTINUE
- 60 IF(IPT+NGIVE.GT.P) NGIVE=P-IPT
- IF(NF.LT.0) RETURN
- DO 80 K=1,NGIVE
- IPT=IPT+1
- DO 70 I=1,NDIM
- TERM=IPT*THETA(I)
- X(I,K)=ABS(2.0E+0*MOD(TERM,1.0E+0)-1.0E+0)
- 70 CONTINUE
- 80 CONTINUE
- IF(IPT.EQ.P) IPT=0
- RETURN
- END
diff --git a/src/mathlib/gen/divon/ranums.F b/src/mathlib/gen/divon/ranums.F
deleted file mode 100644
index b5bc9d1..0000000
--- a/src/mathlib/gen/divon/ranums.F
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: ranums.F,v 1.1.1.1 1996/04/01 15:03:28 mclareni Exp $
-*
-* $Log: ranums.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:28 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_VAX)
- OPTIONS/CHECK=NOOVERFLOW
-#endif
- SUBROUTINE RANUMS (X,N)
- REAL X(N)
- INTEGER IA, IC, ITWO, IY, M2, M
- DOUBLE PRECISION HALFM
- DATA M2 / 0 /, ITWO / 2 /, IY /123456789/
- IF(M2.NE.0) GOTO 20
- M=1
- 10 M2=M
- M=ITWO*M2
- IF(M.GT.M2) GOTO 10
- HALFM=M2
- IA=8*INT(HALFM*ATAN(1.0D0)/8.0D0)+5
- IC=2*INT(HALFM*(0.5D0-SQRT(3.0D0)/6.0D0))+1
- S=0.5/HALFM
- 20 DO 30 I=1,N
- IY=IY*IA+IC
- IF(IY/2.GT.M2) IY=(IY-M2)-M2
- IF(IY.LT.0) IY=(IY+M2)+M2
- 30 X(I)=IY*S
- RETURN
- END
diff --git a/src/mathlib/gen/divon/recpar.F b/src/mathlib/gen/divon/recpar.F
deleted file mode 100644
index 260ce9a..0000000
--- a/src/mathlib/gen/divon/recpar.F
+++ /dev/null
@@ -1,225 +0,0 @@
-*
-* $Id: recpar.F,v 1.1.1.1 1996/04/01 15:03:24 mclareni Exp $
-*
-* $Log: recpar.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:24 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE RECPAR (NDIM,UMINUS,UPLUS,FLOBD,FUPBD,MAXDPH,ENTREE,TRE
- 1E,PARTN,ENTBUC,BUCKTS,IBUC)
- INTEGER NDIM,ENTREE,ENTBUC,TREE(4,1000),MAXDPH
- REAL UMINUS(NDIM),UPLUS(NDIM),PARTN(18001),BUCKTS(IBUC)
- COMMON /MLIMIT/ MFLAG
- LOGICAL MFLAG
- COMMON /ISTRGE/ BUKMAX, DUMMY1(12000)
- COMMON /BUKSZE/ MAXWRD
-C*NS INTEGER MAXWRD,TREMAX,BUKMAX,PARENT,COORD
- INTEGER MAXWRD,TREMAX,BUKMAX,PARENT
- LOGICAL TERMNL
- INTEGER SNODES(100)
- INTEGER PNODES,MNODES
- REAL SPRTNS(100)
- INTEGER PPRTNS,MPRTNS
- INTEGER SAXES(100)
- INTEGER PAXES,MAXES
- IF(100.GT.100) GOTO 420
- PNODES=0
- MNODES=100
- IF(100.GT.100) GOTO 440
- PPRTNS=0
- MPRTNS=100
- IF(100.GT.100) GOTO 460
- PAXES=0
- MAXES=100
- TREMAX=BUKMAX-1
- TERMNL=.FALSE.
- IRBUC=IBUC-(MAXWRD*(ENTBUC-1))
- IRBUC=IBUC-(MAXWRD*(ENTBUC-1))
- CALL SPLIT(NDIM,UMINUS,UPLUS,FLOBD,FUPBD,TERMNL,ITREE,PARTN(ENTRE
- 1E),BUCKTS(MAXWRD*(ENTBUC-1)+1),IRBUC)
- TREE(4,ENTREE)=-ITREE
- IF(TERMNL) RETURN
- PNODES=PNODES+1
- IF(PNODES.GT.MNODES) GOTO 320
- SNODES(PNODES)=ENTREE
- TREE(1,ENTREE)=0
- 10 ENTREE=ENTREE+1
- IF(ENTREE.GT.TREMAX) GOTO 380
- TERMNL=PNODES.GE.MAXDPH
- IF(PNODES.LE.0) GOTO 210
- PARENT=SNODES(PNODES)
- JTREE=TREE(4,PARENT)
- PAXES=PAXES+1
- IF(PAXES.GT.MAXES) GOTO 360
- SAXES(PAXES)=JTREE
- IF(TREE(1,PARENT).NE.0) GOTO 90
- IF(JTREE.GE.0) GOTO 20
- PPRTNS=PPRTNS+1
- IF(PPRTNS.GT.MPRTNS) GOTO 340
- SPRTNS(PPRTNS)=UPLUS(-JTREE)
- UPLUS(-JTREE)=PARTN(PARENT)
- GOTO 30
- 20 PPRTNS=PPRTNS+1
- IF(PPRTNS.GT.MPRTNS) GOTO 340
- SPRTNS(PPRTNS)=UMINUS(JTREE)
- UMINUS(JTREE)=PARTN(PARENT)
- 30 IRBUC=IBUC-(MAXWRD*(ENTBUC-1))
- IRBUC=IBUC-(MAXWRD*(ENTBUC-1))
- CALL SPLIT(NDIM,UMINUS,UPLUS,FLOBD,FUPBD,TERMNL,ITREE,PARTN(ENTRE
- 1E),BUCKTS(MAXWRD*(ENTBUC-1)+1),IRBUC)
- TREE(4,ENTREE)=-ITREE
- IF(.NOT.(.NOT.TERMNL)) GOTO 50
- IF(JTREE.GE.0) GOTO 40
- TREE(2,PARENT)=ENTREE
- TREE(1,ENTREE)=0
- PNODES=PNODES+1
- IF(PNODES.GT.MNODES) GOTO 320
- SNODES(PNODES)=ENTREE
- GOTO 10
- 40 TREE(3,PARENT)=ENTREE
- TREE(1,ENTREE)=0
- PNODES=PNODES+1
- IF(PNODES.GT.MNODES) GOTO 320
- SNODES(PNODES)=ENTREE
- GOTO 10
- 50 ENTREE=ENTREE-1
- IF(ENTREE.LT.1) GOTO 400
- IF(JTREE.GE.0) GOTO 60
- TREE(2,PARENT)=-ENTBUC
- GOTO 70
- 60 TREE(3,PARENT)=-ENTBUC
- 70 TREE(1,PARENT)=ENTBUC
- ENTBUC=ENTBUC+1
- IF(ENTBUC.GT.BUKMAX) GOTO 390
- IF(PAXES.LE.0) GOTO 220
- JTREE=SAXES(PAXES)
- PAXES=PAXES-1
- IF(PAXES.LT.0) GOTO 280
- IF(JTREE.GE.0) GOTO 80
- IF(PPRTNS.LE.0) GOTO 240
- UPLUS(-JTREE)=SPRTNS(PPRTNS)
- PPRTNS=PPRTNS-1
- IF(PPRTNS.LT.0) GOTO 300
- GOTO 10
- 80 IF(PPRTNS.LE.0) GOTO 240
- UMINUS(JTREE)=SPRTNS(PPRTNS)
- PPRTNS=PPRTNS-1
- IF(PPRTNS.LT.0) GOTO 300
- GOTO 10
- 90 IF(JTREE.LE.0) GOTO 100
- PPRTNS=PPRTNS+1
- IF(PPRTNS.GT.MPRTNS) GOTO 340
- SPRTNS(PPRTNS)=UPLUS(JTREE)
- UPLUS(JTREE)=PARTN(PARENT)
- GOTO 110
- 100 PPRTNS=PPRTNS+1
- IF(PPRTNS.GT.MPRTNS) GOTO 340
- SPRTNS(PPRTNS)=UMINUS(-JTREE)
- UMINUS(-JTREE)=PARTN(PARENT)
- 110 IRBUC=IBUC-(MAXWRD*(ENTBUC-1))
- IRBUC=IBUC-(MAXWRD*(ENTBUC-1))
- CALL SPLIT(NDIM,UMINUS,UPLUS,FLOBD,FUPBD,TERMNL,ITREE,PARTN(ENTRE
- 1E),BUCKTS(MAXWRD*(ENTBUC-1)+1),IRBUC)
- TREE(4,ENTREE)=-ITREE
- IF(.NOT.(.NOT.TERMNL)) GOTO 130
- IF(JTREE.LE.0) GOTO 120
- TREE(2,PARENT)=ENTREE
- TREE(1,ENTREE)=0
- PNODES=PNODES+1
- IF(PNODES.GT.MNODES) GOTO 320
- SNODES(PNODES)=ENTREE
- GOTO 10
- 120 TREE(3,PARENT)=ENTREE
- TREE(1,ENTREE)=0
- PNODES=PNODES+1
- IF(PNODES.GT.MNODES) GOTO 320
- SNODES(PNODES)=ENTREE
- GOTO 10
- 130 ENTREE=ENTREE-1
- IF(ENTREE.LT.1) GOTO 400
- IF(JTREE.LE.0) GOTO 140
- TREE(2,PARENT)=-ENTBUC
- GOTO 150
- 140 TREE(3,PARENT)=-ENTBUC
- 150 IF(TREE(1,PARENT).EQ.0) GOTO 180
- IF(PAXES.LE.0) GOTO 220
- JTREE=SAXES(PAXES)
- PAXES=PAXES-1
- IF(PAXES.LT.0) GOTO 280
- IF(JTREE.LE.0) GOTO 160
- IF(PPRTNS.LE.0) GOTO 240
- UPLUS(JTREE)=SPRTNS(PPRTNS)
- PPRTNS=PPRTNS-1
- IF(PPRTNS.LT.0) GOTO 300
- GOTO 170
- 160 IF(PPRTNS.LE.0) GOTO 240
- UMINUS(-JTREE)=SPRTNS(PPRTNS)
- PPRTNS=PPRTNS-1
- IF(PPRTNS.LT.0) GOTO 300
- 170 PNODES=PNODES-1
- IF(PNODES.LT.0) GOTO 260
- IF(PNODES.LE.0) GOTO 210
- PARENT=SNODES(PNODES)
- GOTO 150
- 180 IF(PAXES.LE.0) GOTO 220
- JTREE=SAXES(PAXES)
- PAXES=PAXES-1
- IF(PAXES.LT.0) GOTO 280
- IF(JTREE.GE.0) GOTO 190
- IF(PPRTNS.LE.0) GOTO 240
- UPLUS(-JTREE)=SPRTNS(PPRTNS)
- PPRTNS=PPRTNS-1
- IF(PPRTNS.LT.0) GOTO 300
- GOTO 200
- 190 IF(PPRTNS.LE.0) GOTO 240
- UMINUS(JTREE)=SPRTNS(PPRTNS)
- PPRTNS=PPRTNS-1
- IF(PPRTNS.LT.0) GOTO 300
- 200 TREE(1,PARENT)=ENTBUC
- ENTBUC=ENTBUC+1
- IF(ENTBUC.GT.BUKMAX) GOTO 390
- GOTO 10
- 210 RETURN
- 220 WRITE(6,230)
- 230 FORMAT(' STACK AXES EMPTY')
- STOP
- 240 WRITE(6,250)
- 250 FORMAT(' STACK PRTNS EMPTY')
- STOP
- 260 WRITE(6,270)
- 270 FORMAT(' STACK NODES UNDERFLOW')
- STOP
- 280 WRITE(6,290)
- 290 FORMAT(' STACK AXES UNDERFLOW')
- STOP
- 300 WRITE(6,310)
- 310 FORMAT(' STACK PRTNS UNDERFLOW')
- STOP
- 320 WRITE(6,330)
- 330 FORMAT(' STACK NODES OVERFLOW')
- STOP
- 340 WRITE(6,350)
- 350 FORMAT(' STACK PRTNS OVERFLOW')
- STOP
- 360 WRITE(6,370)
- 370 FORMAT(' STACK AXES OVERFLOW')
- STOP
- 380 MFLAG=.TRUE.
- RETURN
- 390 MFLAG=.TRUE.
- RETURN
- 400 WRITE(6,410)
- 410 FORMAT(' ENTREE DECREMENTED PAST ONE')
- STOP
- 420 WRITE(6,430) MAXDPH
- 430 FORMAT(' MAXDPH = ',I10,' TOO LARGE')
- STOP
- 440 WRITE(6,450) MAXDPH
- 450 FORMAT(' MAXDPH = ',I10,' TOO LARGE')
- STOP
- 460 WRITE(6,470) MAXDPH
- 470 FORMAT(' MAXDPH = ',I10,' TOO LARGE')
- STOP
- END
diff --git a/src/mathlib/gen/divon/rlen.F b/src/mathlib/gen/divon/rlen.F
deleted file mode 100644
index c8b249d..0000000
--- a/src/mathlib/gen/divon/rlen.F
+++ /dev/null
@@ -1,38 +0,0 @@
-*
-* $Id: rlen.F,v 1.1.1.1 1996/04/01 15:03:28 mclareni Exp $
-*
-* $Log: rlen.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:28 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE RLEN (LEN,VEC,VLEN)
- INTEGER LEN
- DOUBLE PRECISION VEC(LEN), VLEN
- INTEGER I
- DOUBLE PRECISION ABSV, RATIO, RMIN, TOL, TVMX, VMAX
- DATA TOL / 1.0D-20 /
-#if defined(CERNLIB_IBM)||defined(CERNLIB_SINGLE)
- DATA RMIN / 1.0D-58 /
-#endif
-#if (!defined(CERNLIB_IBM))&&(defined(CERNLIB_DOUBLE))
- DATA RMIN / 1.0D-34/
-#endif
- VMAX=0.0D+0
- DO 10 I=1,LEN
- ABSV=ABS(VEC(I))
- IF(ABSV.GT.VMAX) VMAX=ABSV
- 10 CONTINUE
- VLEN=0.0D+0
- IF(VMAX.EQ.0.0D+0) RETURN
- TVMX=0.0D+0
- IF(VMAX.GT.RMIN) TVMX=TOL*VMAX
- DO 20 I=1,LEN
- IF(ABS(VEC(I)).LE.TVMX) GOTO 20
- RATIO=VEC(I)/VMAX
- VLEN=VLEN+RATIO*RATIO
- 20 CONTINUE
- VLEN=VMAX*SQRT(VLEN)
- RETURN
- END
diff --git a/src/mathlib/gen/divon/settol.F b/src/mathlib/gen/divon/settol.F
deleted file mode 100644
index b828861..0000000
--- a/src/mathlib/gen/divon/settol.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: settol.F,v 1.1.1.1 1996/04/01 15:03:26 mclareni Exp $
-*
-* $Log: settol.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:26 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE SETTOL (N,FTOL,GTOL,DELTA,ETA,ALFMAX,MAXFUN,IPRINT)
- INTEGER N, MAXFUN, IPRINT
- DOUBLE PRECISION FTOL, GTOL, DELTA, ETA, ALFMAX
- FTOL=5.0D-2
- GTOL=1.0D-2
- DELTA=1.0D-5
- ETA=0.2D+0
- ALFMAX=1.0D+2
- MAXFUN=50*N
- IPRINT=-1
- RETURN
- END
diff --git a/src/mathlib/gen/divon/shrnk.F b/src/mathlib/gen/divon/shrnk.F
deleted file mode 100644
index fb66fda..0000000
--- a/src/mathlib/gen/divon/shrnk.F
+++ /dev/null
@@ -1,40 +0,0 @@
-*
-* $Id: shrnk.F,v 1.1.1.1 1996/04/01 15:03:27 mclareni Exp $
-*
-* $Log: shrnk.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:27 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE SHRNK (N,NADIM,AHESS,IOUT,VEC)
- INTEGER N, NADIM, IOUT
- DOUBLE PRECISION AHESS(NADIM, N), VEC(N)
- INTEGER I, IFAIL, IM1, IOM1, J, NM1
- DOUBLE PRECISION GAMMA
- IF(N.EQ.IOUT.OR.N.EQ.1) RETURN
- IF(IOUT.EQ.1) GOTO 20
- IOM1=IOUT-1
- DO 10 I=1,IOM1
- VEC(I)=0.0D+0
- 10 CONTINUE
- 20 NM1=N-1
- GAMMA=AHESS(IOUT,IOUT)
- DO 30 I=IOUT,NM1
- VEC(I)=AHESS(I+1,IOUT)
- AHESS(I,I)=AHESS(I+1,I+1)
- 30 CONTINUE
- DO 50 I=IOUT,NM1
- IM1=I-1
- IF(IM1.EQ.0) GOTO 50
- DO 40 J=1,IM1
- AHESS(I,J)=AHESS(I+1,J)
- 40 CONTINUE
- 50 CONTINUE
- CALL MODCHL(NM1,NADIM,AHESS,GAMMA,VEC,IFAIL)
- AHESS(N,N)=0.0D+0
- DO 60 J=1,NM1
- AHESS(N,J)=0.0D+0
- 60 CONTINUE
- RETURN
- END
diff --git a/src/mathlib/gen/divon/split.F b/src/mathlib/gen/divon/split.F
deleted file mode 100644
index 5787ba8..0000000
--- a/src/mathlib/gen/divon/split.F
+++ /dev/null
@@ -1,225 +0,0 @@
-*
-* $Id: split.F,v 1.1.1.1 1996/04/01 15:03:24 mclareni Exp $
-*
-* $Log: split.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:24 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE SPLIT (NDIM,UMINUS,UPLUS,FLOBD,FUPBD,TERMNL,DISCRM,PART
- 1N,BUCKTS,IRBUC)
- INTEGER NDIM, DISCRM, IRBUC
- LOGICAL TERMNL
- REAL FLOBD, FUPBD, PARTN
- REAL UMINUS(NDIM), UPLUS(NDIM), BUCKTS(IRBUC)
- INTEGER MPOINT
- COMMON /SAMPLE/ MPOINT
- INTEGER MAXWRD
- COMMON /BUKSZE/ MAXWRD
- REAL ERRPCT, ERRABS
- COMMON /MAXERR/ ERRPCT, ERRABS
- INTEGER NFUN, NFOPT, NFCUT
- COMMON /FUNN/ NFUN, NFOPT, NFCUT
- LOGICAL FSTENT, DOSPLT
- REAL COORD, PLACE
- COMMON /SIGSPL/ COORD, PLACE, FSTENT, DOSPLT
- INTEGER DEGREE
- COMMON /QUADRE/ DEGREE
- INTEGER MXRGNS, ISTOR
- COMMON /ISTRGE/ MXRGNS, ISTOR(12000)
- INTEGER RSTSZE
- REAL RSTOR
- COMMON /RSTRGE/ RSTSZE,RSTOR(18001)
- REAL BNDTOL, FRACT, REGNTL, FNLTOL
- COMMON /CUTOLS/ BNDTOL, FRACT, REGNTL, FNLTOL
- INTEGER MAJOR, MINOR
- INTEGER ICUT(20), IWORK(20)
- INTEGER DCMSVE(20)
- INTEGER MAXJ, MINJ, NPOINT, NFCNT
- INTEGER DISCNT
- INTEGER NCUT
- EXTERNAL FUN
- LOGICAL LMAX
- REAL DIFEXT
- REAL X(10, 202), Y(202)
- REAL PARSVE(20)
-C*NS REAL DEVMAX, DEVMIN, YMAX, YMIN, SUM, CELVOL, YBAR, ERROR, ERRSQ
-C*NS DOUBLE PRECISION DPARTN, DFLOAT, DBNDTL, DFRACT, DREGTL, DFNLTL
- REAL DEVMIN, YMAX, YMIN, CELVOL, YBAR, ERROR, ERRSQ
- DOUBLE PRECISION DPARTN, DBNDTL, DFRACT, DREGTL, DFNLTL
- DOUBLE PRECISION FMAJOR, FMINOR, VOL
- DOUBLE PRECISION DELPLS(10), DELNEG(10)
- DOUBLE PRECISION XLOW(10), XUP(10)
- DOUBLE PRECISION Z(10), WORK(200)
- DATA DISCNT /0/
- DATA NCUT /0/
- IF(.NOT.(DOSPLT)) GOTO 10
- DOSPLT=.FALSE.
- FSTENT=DOSPLT
- DISCRM=COORD
- PARTN=PLACE
- RETURN
- 10 IF(NCUT.EQ.0) GOTO 20
- DISCRM=DCMSVE(NCUT)
- PARTN=PARSVE(NCUT)
- NCUT=NCUT-1
- DOSPLT=.FALSE.
- FSTENT=DOSPLT
- TERMNL=FSTENT
- RETURN
- 20 ISCR=MXRGNS*(MAXWRD+1)+1
- NPOINT=MPOINT
- CALL QUASI(X,NDIM,NPOINT,MPOINT)
- DO 40 J=1,NPOINT
- DO 30 I=1,NDIM
- X(I,J)=(UPLUS(I)-UMINUS(I))*X(I,J)+UMINUS(I)
- 30 CONTINUE
- Y(J)=FUN(NDIM,X(1,J))
- 40 CONTINUE
- NFUN=NFUN+NPOINT
- CELVOL=1.0E+0
- DO 50 I=1,NDIM
- CELVOL=CELVOL*(UPLUS(I)-UMINUS(I))
- 50 CONTINUE
-#if defined(CERNLIB_IBM)||defined(CERNLIB_SINGLE)
- YMAX=-9.9E+60
- YMIN=9.9E+60
-#endif
-#if (!defined(CERNLIB_IBM))&&(defined(CERNLIB_DOUBLE))
- YMAX= -9.9E34
- YMIN= 9.9E34
-#endif
- DO 70 J=1,NPOINT
- IF(Y(J).GE.YMIN) GOTO 60
- YMIN=Y(J)
- MINJ=J
- 60 IF(Y(J).LE.YMAX) GOTO 70
- YMAX=Y(J)
- MAXJ=J
- 70 CONTINUE
- DO 80 I=1,NDIM
- X(I,NPOINT+1)=X(I,MAXJ)
- X(I,NPOINT+2)=X(I,MINJ)
- 80 CONTINUE
- Y(NPOINT+1)=YMAX
- Y(NPOINT+2)=YMIN
- CALL BUFOPT(NDIM,X(1,NPOINT+2),X(1,NPOINT+1),UMINUS,UPLUS,Y(NPOIN
- 1T+2),Y(NPOINT+1),FLOBD,FUPBD,WORK,200,IWORK,20,NFCNT,IRESLT)
- NFUN=NFUN+NFCNT
- NFOPT=NFOPT+NFCNT
- DIFEXT=Y(NPOINT+1)-Y(NPOINT+2)
- ERROR=DIFEXT*CELVOL*0.5E+0
- YBAR=0.0E+0
- DO 90 I=1,NPOINT
- YBAR=YBAR+Y(I)
- 90 CONTINUE
- YBAR=YBAR/NPOINT
- FBAR=YBAR*CELVOL
- IF(ABS(Y(NPOINT+2)-YBAR).LE.ABS(Y(NPOINT+1)-YBAR)) GOTO 100
- MAJOR=NPOINT+2
- MINOR=NPOINT+1
- GOTO 110
- 100 MAJOR=NPOINT+1
- MINOR=NPOINT+2
- 110 FMAJOR=Y(MAJOR)
- FMINOR=Y(MINOR)
- I=1
- GOTO 130
- 120 I=I+1
- 130 IF((I).GT.(NDIM)) GOTO 140
- Z(I)=X(I,MAJOR)
- GOTO 120
- 140 I=1
- GOTO 160
- 150 I=I+1
- 160 IF((I).GT.(NDIM)) GOTO 170
- XLOW(I)=UMINUS(I)
- XUP(I)=UPLUS(I)
- GOTO 150
- 170 NCDIM=2*NDIM
- DFRACT=FRACT
- DBNDTL=BNDTOL
- CALL TSTEXT(NDIM,Z,XLOW,XUP,DBNDTL,DFRACT,NCUT,NCDIM,ICUT,DELPLS,
- 1DELNEG)
- IF(NCUT.NE.0) GOTO 180
- CALL NOCUT(NDIM,XLOW,XUP,WORK(1),DISCNT,DISCRM,DPARTN,NFUN)
- PARTN=DPARTN
- GOTO 240
- 180 LMAX=.TRUE.
- IF(FMAJOR.GE.FMINOR) GOTO 190
- LMAX=.FALSE.
- 190 VOL=CELVOL
- DREGTL=REGNTL
- DFNLTL=FNLTOL
- CALL DELSLV(NDIM,FMAJOR,FMINOR,LMAX,DFRACT,Z,XLOW,XUP,VOL,NCUT,NCD
- 1IM,ICUT,DELPLS,DELNEG,DREGTL,DFNLTL,WORK(1),WORK(NCDIM+1),WORK(2*N
- 2CDIM+1),WORK(3*NCDIM+1),WORK(4*NCDIM+1),WORK(5*NCDIM+1),WORK(6*NCD
- 3IM+1),WORK(7*NCDIM+1),WORK(8*NCDIM+1),NFCNT)
- NFUN=NFUN+NFCNT
- NFCUT=NFCUT+NFCNT
- IF(NCUT.NE.0) GOTO 200
- CALL NOCUT(NDIM,XLOW,XUP,WORK(1),DISCNT,DISCRM,DPARTN,NFUN)
- PARTN=DPARTN
- GOTO 240
- 200 I=1
- GOTO 220
- 210 I=I+1
- 220 IF((I).GT.(NCUT)) GOTO 240
- DCMSVE(I)=ICUT(I)
- II=ABS(ICUT(I))
- IF(ICUT(I).LE.0) GOTO 230
- PARSVE(I)=X(II,MAJOR)+DELPLS(II)
- GOTO 210
- 230 PARSVE(I)=X(II,MAJOR)-DELNEG(II)
- GOTO 210
- 240 NCUTSV=NCUT
- IF(NCUT.LE.0) GOTO 250
- DISCRM=ICUT(NCUT)
- PARTN=PARSVE(NCUT)
- NCUT=NCUT-1
- 250 IF(.NOT.(FSTENT)) GOTO 260
- FSTENT=.FALSE.
- TERMNL=FSTENT
- RETURN
- 260 IF(ERROR.EQ.0.0E+0) GOTO 270
- TERMNL=TERMNL.OR.ERROR.LT.ERRABS
- IF(FBAR.NE.0.0E+0) TERMNL=TERMNL.OR.ERROR/ABS(FBAR).LE.ERRPCT
- 270 IF(.NOT.(TERMNL)) GOTO 330
- NCUT=0
- IF(NCUTSV.LE.0) GOTO 290
-#if defined(CERNLIB_IBM)||defined(CERNLIB_SINGLE)
- DEVMIN=9.9E60
-#endif
-#if (!defined(CERNLIB_IBM))&&(defined(CERNLIB_DOUBLE))
- DEVMIN= 9.9E34
-#endif
- DO 280 I=1,NCUTSV
- J=ABS(ICUT(I))
- XX=ABS(X(J,MAJOR)-PARSVE(I))
- IF(XX.GE.DEVMIN) GOTO 280
- DEVMIN=XX
- PARTN=PARSVE(I)
- DISCRM=ICUT(I)
- 280 CONTINUE
- 290 ERRSQ=ERROR**2
- ERRABS=MAX(ERRABS,ERROR)
- BUCKTS(1)=FBAR
- BUCKTS(2)=ERRSQ
- BUCKTS(3)=DISCRM
- BUCKTS(4)=PARTN
- IF(DEGREE.NE.1) GOTO 300
- BUCKTS(5)=Y(NPOINT+1)
- BUCKTS(6)=Y(NPOINT+2)
- BUCKTS(7)=CELVOL
- 300 IF(DEGREE.LT.2) GOTO 310
- NFUN=NFUN+NDIM+1
- BUCKTS(5)=QUAD(NDIM,2,UMINUS,UPLUS,FUN)*CELVOL
- 310 IF(DEGREE.LT.3) GOTO 320
- NFUN=NFUN+NDIM+NDIM
- BUCKTS(6)=QUAD(NDIM,3,UMINUS,UPLUS,FUN)*CELVOL
- 320 IF(DEGREE.NE.5) GOTO 330
- NFUN=NFUN+2*NDIM**2+1
- BUCKTS(7)=QUAD(NDIM,5,UMINUS,UPLUS,FUN)*CELVOL
- 330 RETURN
- END
diff --git a/src/mathlib/gen/divon/treaud.F b/src/mathlib/gen/divon/treaud.F
deleted file mode 100644
index d864cbb..0000000
--- a/src/mathlib/gen/divon/treaud.F
+++ /dev/null
@@ -1,110 +0,0 @@
-*
-* $Id: treaud.F,v 1.1.1.1 1996/04/01 15:03:25 mclareni Exp $
-*
-* $Log: treaud.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:25 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE TREAUD (PARENT,OLDSTR,NEWBUC,NEWMAX,TREE)
- INTEGER PARENT,OLDSTR,NEWBUC,NEWMAX,TREE(4,1000),SON
- INTEGER SNODES(100)
- INTEGER PNODES,MNODES
- IF(100.GT.100) GOTO 250
- PNODES=0
- MNODES=100
- PNODES=PNODES+1
- IF(PNODES.GT.MNODES) GOTO 210
- SNODES(PNODES)=PARENT
- 10 IF(OLDSTR.GT.TREE(1,PARENT)) GOTO 40
- IF(PNODES.LE.0) GOTO 200
- PARENT=SNODES(PNODES)
- IF(TREE(4,PARENT).GE.0) GOTO 20
- SON=TREE(2,PARENT)
- GOTO 30
- 20 SON=TREE(3,PARENT)
- 30 IF(SON.LE.0) GOTO 70
- PARENT=SON
- PNODES=PNODES+1
- IF(PNODES.GT.MNODES) GOTO 210
- SNODES(PNODES)=PARENT
- GOTO 70
- 40 IF(PNODES.LE.0) GOTO 200
- PARENT=SNODES(PNODES)
- IF(TREE(4,PARENT).LE.0) GOTO 50
- SON=TREE(2,PARENT)
- GOTO 60
- 50 SON=TREE(3,PARENT)
- 60 IF(SON.LE.0) GOTO 70
- PARENT=SON
- PNODES=PNODES+1
- IF(PNODES.GT.MNODES) GOTO 210
- SNODES(PNODES)=PARENT
- 70 IF(SON.GE.0) GOTO 10
- IF(OLDSTR.NE.-SON) GOTO 290
- GOTO 80
- 80 IF(SON.LT.0) GOTO 110
- IF(PNODES.LE.0) GOTO 200
- PARENT=SNODES(PNODES)
- IF(TREE(4,PARENT).GE.0) GOTO 90
- SON=TREE(2,PARENT)
- GOTO 100
- 90 SON=TREE(3,PARENT)
- 100 IF(SON.LE.0) GOTO 80
- PARENT=SON
- PNODES=PNODES+1
- IF(PNODES.GT.MNODES) GOTO 210
- SNODES(PNODES)=PARENT
- GOTO 80
- 110 IF(TREE(4,PARENT).GE.0) GOTO 130
- IF(SON.NE.TREE(3,PARENT)) GOTO 120
- TREE(3,PARENT)=-NEWBUC
- GOTO 150
- 120 TREE(2,PARENT)=-NEWBUC
- GOTO 150
- 130 IF(SON.NE.TREE(2,PARENT)) GOTO 140
- TREE(2,PARENT)=-NEWBUC
- GOTO 150
- 140 TREE(3,PARENT)=-NEWBUC
- 150 SON=-NEWBUC
- 160 IF(TREE(2,PARENT).EQ.SON.AND.TREE(4,PARENT).LT.0.OR.TREE(3,PARENT
- 1).EQ.SON.AND.TREE(4,PARENT).GT.0) GOTO 170
- SON=PARENT
- PNODES=PNODES-1
- IF(PNODES.LT.0) GOTO 230
- IF(PNODES.LE.0) GOTO 200
- PARENT=SNODES(PNODES)
- GOTO 160
- 170 TREE(1,PARENT)=NEWBUC
- NEWBUC=NEWBUC+1
- IF(NEWBUC.GT.NEWMAX) GOTO 270
- IF(PNODES.LE.0) GOTO 200
- PARENT=SNODES(PNODES)
- IF(TREE(4,PARENT).LE.0) GOTO 180
- SON=TREE(2,PARENT)
- GOTO 190
- 180 SON=TREE(3,PARENT)
- 190 IF(SON.LE.0) GOTO 80
- PARENT=SON
- PNODES=PNODES+1
- IF(PNODES.GT.MNODES) GOTO 210
- SNODES(PNODES)=PARENT
- GOTO 80
- 200 RETURN
- 210 WRITE(6,220)
- 220 FORMAT(' STACKSIZE TOO SMALL')
- STOP
- 230 WRITE(6,240)
- 240 FORMAT(' STACK NODES UNDERFLOW')
- STOP
- 250 WRITE(6,260)
- 260 FORMAT(' IMPOSSIBLE')
- STOP
- 270 WRITE(6,280) NEWBUC,NEWMAX
- 280 FORMAT(' NEWBUC =',I10,' EXCEEDES',I10)
- STOP
- 290 WRITE(6,300) OLDSTR,TREE(SON,PARENT)
- 300 FORMAT(' LOOKING FOR BUCKET',I10,' BUT FOUND',I10)
- STOP
- END
diff --git a/src/mathlib/gen/divon/tredmp.F b/src/mathlib/gen/divon/tredmp.F
deleted file mode 100644
index f30f129..0000000
--- a/src/mathlib/gen/divon/tredmp.F
+++ /dev/null
@@ -1,58 +0,0 @@
-*
-* $Id: tredmp.F,v 1.1.1.1 1996/04/01 15:03:24 mclareni Exp $
-*
-* $Log: tredmp.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:24 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE TREDMP(NDIM)
- COMMON /ISTRGE/ MXRGNS,TREE(4,1),DUMMY1(11996)
- COMMON /RSTRGE/ RSTSZE,PARTN(18001)
- INTEGER RSTSZE
- INTEGER TREE
- REAL PARTN
- COMMON /TRESZE/ ENTREE,ENTBUC
- INTEGER ENTREE,ENTBUC
- COMMON /LIMITS/ GMINUS(10),GPLUS(10)
- COMMON /BUKSZE/ MAXWRD
- INTEGER MAXWRD
- REAL UMINUS(10),UPLUS(10)
- INTEGER PARENT
- WRITE(6,10) ENTREE
- 10 FORMAT('1TREE HAS ',I5,' NONTERMINAL NODES')
- DO 30 I=1,ENTREE
- WRITE(6,20) I,(TREE(J,I),J=1,4),PARTN(I)
- 20 FORMAT(' NONTERMINAL NODE(',I5,') = ',4I5,G13.5)
- 30 CONTINUE
- RETURN
-#if defined(CERNLIB_DOUBLE)||!defined(CERNLIB_F4)
- ENTRY BUKDMP(NDIM)
-#endif
-#if (defined(CERNLIB_SINGLE))&&(defined(CERNLIB_F4))
- ENTRY BUKDMP
-#endif
- WRITE(6,40) ENTBUC
- 40 FORMAT('1PARTITIONING HAS ',I5,' TOTAL REGIONS')
- K=MXRGNS
- DO 100 I=1,ENTBUC
- WRITE(6,50) I
- 50 FORMAT(' REGION',I6)
- PARENT=1
- DO 60 J=1,NDIM
- UMINUS(J)=GMINUS(J)
- UPLUS(J)=GPLUS(J)
- 60 CONTINUE
- CALL BOUNDS(I,PARENT,TREE,PARTN,UMINUS,UPLUS)
- DO 80 J=1,NDIM
- WRITE(6,70) UMINUS(J),J,UPLUS(J)
- 70 FORMAT(1X,G13.5,' .LT. X(',I2,') .LE. ',G13.5)
- 80 CONTINUE
- WRITE(6,90) (PARTN(K+J),J=1,MAXWRD)
- 90 FORMAT(' REGION INFORMATION = ',8G13.5/1X,9G13.5/1X,
- 1 9G13.5/1X,9G13.5)
- K=K+MAXWRD
- 100 CONTINUE
- RETURN
- END
diff --git a/src/mathlib/gen/divon/tstext.F b/src/mathlib/gen/divon/tstext.F
deleted file mode 100644
index 8ca3403..0000000
--- a/src/mathlib/gen/divon/tstext.F
+++ /dev/null
@@ -1,36 +0,0 @@
-*
-* $Id: tstext.F,v 1.1.1.1 1996/04/01 15:03:25 mclareni Exp $
-*
-* $Log: tstext.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:25 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE TSTEXT (N,XEXTR,XLOW,XUP,EDGFAC,FRACT,NCUT,NCDIM,ICUT,D
- 1ELPLS,DELNEG)
- INTEGER N, NCDIM, NCUT
- INTEGER ICUT(NCDIM)
- DOUBLE PRECISION EDGFAC, FRACT
- DOUBLE PRECISION XEXTR(N), XLOW(N), XUP(N), DELPLS(N), DELNEG(N)
- INTEGER I
- DOUBLE PRECISION DIFX
- NCUT=0
- DO 10 I=1,N
- DIFX=XUP(I)-XEXTR(I)
- DELPLS(I)=DIFX
- IF(DIFX.LT.EDGFAC*(XUP(I)-XLOW(I))) GOTO 10
- DELPLS(I)=FRACT*DIFX
- NCUT=NCUT+1
- ICUT(NCUT)=I
- 10 CONTINUE
- DO 20 I=1,N
- DIFX=XEXTR(I)-XLOW(I)
- DELNEG(I)=DIFX
- IF(DIFX.LT.EDGFAC*(XUP(I)-XLOW(I))) GOTO 20
- DELNEG(I)=FRACT*DIFX
- NCUT=NCUT+1
- ICUT(NCUT)=-I
- 20 CONTINUE
- RETURN
- END
diff --git a/src/mathlib/gen/divon/usrint.F b/src/mathlib/gen/divon/usrint.F
deleted file mode 100644
index 53ac5df..0000000
--- a/src/mathlib/gen/divon/usrint.F
+++ /dev/null
@@ -1,15 +0,0 @@
-*
-* $Id: usrint.F,v 1.1.1.1 1996/04/01 15:03:23 mclareni Exp $
-*
-* $Log: usrint.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:23 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE USRINT (UMINUS,UPLUS,INTIN,SPRDIN,INTOUT,ERROUT)
- WRITE(6,10)
- 10 FORMAT(' DUMMY USER INTEGRATION SUBROUTINE CALLED.',
- 1' INCONSISTENT INPUT.')
- STOP
- END
diff --git a/src/mathlib/gen/divon/usrtrm.F b/src/mathlib/gen/divon/usrtrm.F
deleted file mode 100644
index c4aa67b..0000000
--- a/src/mathlib/gen/divon/usrtrm.F
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: usrtrm.F,v 1.1.1.1 1996/04/01 15:03:23 mclareni Exp $
-*
-* $Log: usrtrm.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:23 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- LOGICAL FUNCTION USRTRM(ITER)
- COMMON /ANSWER/ FINTGL,SPRD,DUMMY(5),NRGN,MAXRGN /FUNN/ NFUN,MO(2)
- COMMON /Z0001/ ERR,NMIN,MCOUNT /PRINT/ IPR /ZEETRM/ ITRMF
- INTEGER COUNT
- SAVE COUNT
- DATA FAC /1.0/
- DATA COUNT /0/
- USRTRM=.FALSE.
- IF(ITRMF.EQ.0) RETURN
- ERROR=ABS(ERR)
- IF(ERR.GT.0.0) ERROR=ERROR*FINTGL
- NPR=SPRD*FAC/ERROR+0.5
- IF(NPR.GT.1999) RETURN
- N=NFUN+NPR*NRGN
- IF(N.GE.NMIN) GOTO 10
- NMIN=N
- COUNT=0
- RETURN
- 10 COUNT=COUNT+1
- IF(COUNT.GT.MCOUNT) USRTRM=.TRUE.
- IF(.NOT.(USRTRM).OR.IPR.LE.0) GOTO 30
- WRITE(6,20)
- 20 FORMAT('0--- DIVON --- PARTITIONING TERMINATION.')
- 30 RETURN
- END
diff --git a/src/mathlib/gen/e/Imakefile b/src/mathlib/gen/e/Imakefile
deleted file mode 100644
index 3233c31..0000000
--- a/src/mathlib/gen/e/Imakefile
+++ /dev/null
@@ -1,29 +0,0 @@
-DoIncludePackage(gen)
-#include "pilot.h"
-
-SRCS_F= cheb.F checf64.F chsum64.F dchpws.F decomp.F dlsqp1.F dlsqp2.F \ @@\
- dlsqpm.F dspap1.F dspap2.F dspcd1.F dspcd2.F dspin1.F dspin2.F \ @@\
- dspkn1.F dspkn2.F dspnb1.F dspnb2.F dspps1.F dspps2.F dspvd1.F \ @@\
- dspvd2.F dtrgsm.F dummy.F lfit.F lfitw.F lkkspl.F lsqqr.F \ @@\
- maxdze.F maxize.F ndigit.F parlsq.F proc1.F prod1.F prod2.F \ @@\
- rchpws.F rcspln64.F rlsqp1.F rlsqp2.F \ @@\
- rlsqpm.F rtrgsm.F slv.F splan0.F splan1.F splan2.F splan3.F \ @@\
- splas1.F splas2.F trisum.F
-
-#if defined(CERNLIB_DOUBLE)
-SRCS_F:= $(SRCS_F) chsum.F dchebn.F rchecf.F rcspln.F
-#else
-SRCS_F:= $(SRCS_F) chsum128.F rchebn.F rcspln128.F
-#endif
-
-#if defined(CERNLIB_QUAD)
-SRCS_F:= $(SRCS_F) checf128.F
-#endif
-
-FORTRANSAVEOPTION = FortranSaveFlags
-
-#if defined(CERNLIB_SGI)
-IMAKE_DEFINES=-DFortranDoesCpp=NO
-#endif
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/mathlib/gen/e/cheb.F b/src/mathlib/gen/e/cheb.F
deleted file mode 100644
index 66bbb27..0000000
--- a/src/mathlib/gen/e/cheb.F
+++ /dev/null
@@ -1,239 +0,0 @@
-*
-* $Id: cheb.F,v 1.1.1.1 1996/04/01 15:02:27 mclareni Exp $
-*
-* $Log: cheb.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:27 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE CHEB(M,N,MDIM,NDIM,A,B,TOL,RELERR,X,RANK,RESMAX,
- + ITER,OCODE)
-C LINEAR CHEBYSHEV FIT ROUTINE FROM ACM TOMS 1, 266(1975)
-C BY BARRODALE AND PHILLIPS
- DIMENSION A(NDIM,MDIM), B(MDIM), X(NDIM)
- INTEGER PROW,PCOL,RANK,RANKP1,OCODE
-#include "e221prec.inc"
- MP1 = M + 1
- NP1 = N + 1
- NP2 = N + 2
- NP3 = N + 3
- NP1MR = 1
- RANK = N
- RELTMP = RELERR
- RELERR = 0.
- DO 10 J= 1,M
- A(NP1,J) = 1.
- A(NP2,J) = -B(J)
- A(NP3,J) = N+J
- 10 CONTINUE
- A(NP1,MP1) = 0.
- ITER = 0
- OCODE = 1
- DO 20 I= 1, N
- X(I)=0.
- A(I,MP1)=I
- 20 CONTINUE
-C LEVEL 1.
- LEV = 1
- K = 0
- 30 K = K + 1
- KP1 = K + 1
- NP1MK = NP1 - K
- MODE = 0
- CALL VFILL(B(K),M-K+1,1.)
-C DETERMINE THE VECTOR TO ENTER THE BASIS.
- 50 D = -BIG
- DO 60 J= K, M
- IF (B(J) .EQ. 0.) GOTO 60
- DD = ABS(A(NP2,J))
- IF (DD .LE. D) GOTO 60
- PCOL = J
- D = DD
- 60 CONTINUE
- IF (K .GT. 1) GOTO 70
-C TEST FOR ZERO RIGHT-HAND SIDE
- IF (D .GT. TOL) GOTO 70
- RESMAX = 0.
- MODE = 2
- GOTO 380
-C DETERMINE THE VECTOR TO LEAVE THE BASIS.
- 70 D = TOL
- DO 80 I= 1, NP1MK
- DD = ABS(A(I,PCOL))
- IF (DD .LE. D) GOTO 80
- PROW = I
- D = DD
- 80 CONTINUE
- IF (D .GT. TOL) GOTO 330
-C CHECK FOR LINEAR DEPENDENCE IN LEVEL 1.
- B(PCOL) = 0.
- IF (MODE .EQ. 1) GOTO 50
- DO 100 J= K, M
- IF (B(J) .EQ. 0.) GOTO 100
- DO 90 I= 1, NP1MK
- IF (ABS(A(I,J)) .LE. TOL) GOTO 90
- MODE = 1
- GOTO 50
- 90 CONTINUE
- 100 CONTINUE
- RANK = K - 1
- NP1MR = NP1 - RANK
- OCODE = 0
- GOTO 160
- 110 IF (PCOL .EQ. K) GOTO 130
-C INTERCHANGE COLUMNS IN LEVEL 1.
- DO 120 I= 1, NP3
- D = A(I,PCOL)
- A(I,PCOL) = A(I,K)
- A(I,K) = D
- 120 CONTINUE
- 130 IF (PROW .EQ. NP1MK) GOTO 150
-C INTERCHANGE ROWS IN LEVEL 1
- DO 140 J= 1, MP1
- D = A(PROW,J)
- A(PROW,J) = A(NP1MK,J)
- A(NP1MK,J) = D
- 140 CONTINUE
- 150 IF (K.LT.N) GOTO 30
- 160 IF (RANK.EQ.M) GOTO 380
- RANKP1 = RANK + 1
-C LEVEL 2.
- LEV = 2
-C DETERMINE THE VECTOR TO ENTER THE BASIS.
- D = TOL
- DO 170 J= RANKP1, M
- DD = ABS(A(NP2,J))
- IF (DD .LE. D) GOTO 170
- PCOL = J
- D = DD
- 170 CONTINUE
-C COMPARE CHEBYSHEV ERROR WITH TOL.
- IF (D.GT.TOL) GOTO 180
- RESMAX = 0.
- MODE = 3
- GOTO 380
-C
- 180 IF (A(NP2,PCOL) .LT. -TOL) GOTO 200
- A(NP1,PCOL) = 2. - A(NP1,PCOL)
- DO 190 I= NP1MR, NP3
- IF (I.EQ.NP1) GOTO 190
- A(I,PCOL) = -A(I,PCOL)
- 190 CONTINUE
-C ARRANGE FOR ALL ENTRIES IN PIVOT COL (EXC. PIVOT) TO BE NEGATIVE
- 200 DO 220 I= NP1MR, N
- IF (A(I,PCOL) .LT. TOL) GOTO 220
- DO 210 J= 1, M
- A(NP1,J) = A(NP1,J) + 2.*A(I,J)
- A(I,J) = -A(I,J)
- 210 CONTINUE
- A(I,MP1) = -A(I,MP1)
- 220 CONTINUE
- PROW = NP1
- GOTO 330
-C
- 230 IF (RANKP1 .EQ. M) GOTO 380
- IF (PCOL .EQ. M) GOTO 250
-C INTERCHANGE COLUMNS IN LEVEL 2.
- DO 240 I= NP1MR,NP3
- D = A(I,PCOL)
- A(I,PCOL) =A(I,M)
- A(I,M) = D
- 240 CONTINUE
- 250 MM1 = M-1
-C LEVEL 3.
- LEV = 3
-C DETERMINE THE VECTOR TO ENTER THE BASIS.
- 260 D= -TOL
- VAL = 2. * A(NP2,M)
- DO 280 J= RANKP1,MM1
- IF (A(NP2,J) .GE. D) GOTO 270
- PCOL = J
- D = A(NP2,J)
- MODE = 0
- GOTO 280
- 270 DD = VAL - A(NP2,J)
- IF (DD .GE. D) GOTO 280
- MODE = 1
- PCOL = J
- D = DD
- 280 CONTINUE
- IF (D .GE. -TOL) GOTO 380
- DD = -D/A(NP2,M)
- IF (DD .GE. RELTMP) GOTO 290
- RELERR = DD
- MODE = 4
- GOTO 380
-C
- 290 IF (MODE .EQ. 0) GOTO 310
- DO 300 I= NP1MR,NP1
- A(I,PCOL) = 2.*A(I,M) - A(I,PCOL)
- 300 CONTINUE
- A(NP2,PCOL) = D
- A(NP3,PCOL) = -A(NP3,PCOL)
-C DETERMINE THE VECTOR TO LEAVE THE BASIS.
- 310 D = BIG
- DO 320 I= NP1MR,NP1
- IF (A(I,PCOL) .LE. TOL) GOTO 320
- DD = A(I,M)/A(I,PCOL)
- IF (DD .GE. D) GOTO 320
- PROW = I
- D = DD
- 320 CONTINUE
- IF (D .LT. BIG) GOTO 330
- OCODE = 2
- GOTO 380
-C PIVOT ON A(PROW,PCOL)
- 330 PIVOT = A(PROW,PCOL)
- DO 340 J= 1, M
- A(PROW,J) = A(PROW,J)/PIVOT
- 340 CONTINUE
- DO 360 J= 1, M
- IF (J.EQ.PCOL) GOTO 360
- D = A(PROW,J)
- DO 350 I= NP1MR,NP2
- IF (I.EQ.PROW) GOTO 350
- A(I,J) = A(I,J) - D*A(I,PCOL)
- 350 CONTINUE
- 360 CONTINUE
- TPIVOT = -PIVOT
- DO 370 I= NP1MR, NP2
- A(I,PCOL) = A(I,PCOL)/TPIVOT
- 370 CONTINUE
- A(PROW,PCOL) = 1./PIVOT
- D = A(PROW,MP1)
- A(PROW,MP1) = A(NP3,PCOL)
- A(NP3,PCOL) = D
- ITER = ITER + 1
- GOTO (110, 230, 260), LEV
-C
-C PREPARE OUTPUT
- 380 DO 390 J= 1, M
- B(J) = 0.
- 390 CONTINUE
- IF (MODE .EQ. 2) GOTO 450
- DO 400 J= 1, RANK
- K= A(NP3,J)
- X(K) = A(NP2,J)
- 400 CONTINUE
- IF (MODE.EQ.3 .OR. RANK.EQ.M) GOTO 450
- DO 410 I= NP1MR,NP1
- K = ABS(A(I,MP1)) - N
- B(K) = A(NP2,M) * SIGN(1., A(I,MP1))
- 410 CONTINUE
- IF (RANKP1 .EQ. M) GOTO 430
- DO 420 J= RANKP1, MM1
- K = ABS(A(NP3,J)) - N
- B(K) = (A(NP2,M)-A(NP2,J)) * SIGN(1., A(NP3,J))
- 420 CONTINUE
-C TEST FOR NON-UNIQUE SOLUTION
- 430 DO 440 I= NP1MR, NP1
- IF (ABS(A(I,M)) .GT. TOL) GOTO 440
- OCODE = 0
- GOTO 450
- 440 CONTINUE
- 450 IF (MODE.NE.2 .AND. MODE.NE.3) RESMAX = A(NP2,M)
- IF (RANK.EQ.M) RESMAX=0.
- IF (MODE.EQ.4) RESMAX = RESMAX-D
- RETURN
- END
diff --git a/src/mathlib/gen/e/checf128.F b/src/mathlib/gen/e/checf128.F
deleted file mode 100644
index 613605a..0000000
--- a/src/mathlib/gen/e/checf128.F
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: checf128.F,v 1.1.1.1 1996/04/01 15:02:28 mclareni Exp $
-*
-* $Log: checf128.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:28 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_QUAD)
-#if !defined(CERNLIB_DOUBLE)
- SUBROUTINE DCHECF(F,A,B,EPS,C,NC,DELTA)
-#endif
-#if defined(CERNLIB_DOUBLE)
- SUBROUTINE QCHECF(F,A,B,EPS,C,NC,DELTA)
-#endif
-C TO COMPUTE THE COEFFICIENTS IN A CHEBYSHEV EXPANSION
-C F(X)=C(0)+C(1)*T1(X)+ ... +C(M)*TM(X) (A <= X <= B)
-C WHERE TK(X) IS THE CHEBYSHEV POLYNOMIAL OF ORDER K
-C
-C F = FUNCTION ROUTINE FOR THE FUNCTION F(X).
-C A = LOWER BOUNDARY
-C B = UPPER BOUNDARY
-C EPS = ACCURACY REQUIRED
-C C = ARRAY FOR THE COMPUTED CHEBYSHEV COEFFICIENTS
-C NC = NUMBER OF CHEBYSHEV COEFFICIENTS COMPUTED
-C DELTA = ACCURACY OBTAINED FOR THE APPROXIMATION
-
-#include "gen/imp128.inc"
-C
- CHARACTER NAME*(*)
-#if defined(CERNLIB_DOUBLE)
- PARAMETER (NAME = 'QCHECF')
- PARAMETER (PI = 3.14159 26535 89793 23846 26433 832795Q0)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- PARAMETER (NAME = 'DCHECF')
- PARAMETER (PI = 3.14159 26535 89793 23846 26433 83D0)
-#endif
-#include "e406cod.inc"
-#endif
diff --git a/src/mathlib/gen/e/checf64.F b/src/mathlib/gen/e/checf64.F
deleted file mode 100644
index 3620176..0000000
--- a/src/mathlib/gen/e/checf64.F
+++ /dev/null
@@ -1,40 +0,0 @@
-*
-* $Id: checf64.F,v 1.1.1.1 1996/04/01 15:02:28 mclareni Exp $
-*
-* $Log: checf64.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:28 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- SUBROUTINE DCHECF(F,A,B,EPS,C,NC,DELTA)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- SUBROUTINE RCHECF(F,A,B,EPS,C,NC,DELTA)
-#endif
-C TO COMPUTE THE COEFFICIENTS IN A CHEBYSHEV EXPANSION
-C F(X)=C(0)+C(1)*T1(X)+ ... +C(M)*TM(X) (A <= X <= B)
-C WHERE TK(X) IS THE CHEBYSHEV POLYNOMIAL OF ORDER K
-C
-C F = FUNCTION ROUTINE FOR THE FUNCTION F(X).
-C A = LOWER BOUNDARY
-C B = UPPER BOUNDARY
-C EPS = ACCURACY REQUIRED
-C C = ARRAY FOR THE COMPUTED CHEBYSHEV COEFFICIENTS
-C NC = NUMBER OF CHEBYSHEV COEFFICIENTS COMPUTED
-C DELTA = ACCURACY OBTAINED FOR THE APPROXIMATION
-
-#include "gen/imp64.inc"
- CHARACTER NAME*(*)
-#if defined(CERNLIB_DOUBLE)
- PARAMETER (NAME = 'DCHECF')
-#endif
-#if !defined(CERNLIB_DOUBLE)
- PARAMETER (NAME = 'RCHECF')
-#endif
- PARAMETER (PI = 3.14159 26535 89793 23846 26433 83D0)
-#if !defined(CERNLIB_DOUBLE)
- ENTRY CHECF(F,A,B,EPS,C,NC,DELTA)
-#endif
-#include "e406cod.inc"
diff --git a/src/mathlib/gen/e/chsum.F b/src/mathlib/gen/e/chsum.F
deleted file mode 100644
index a2ee263..0000000
--- a/src/mathlib/gen/e/chsum.F
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: chsum.F,v 1.1.1.1 1996/04/01 15:02:29 mclareni Exp $
-*
-* $Log: chsum.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:29 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- FUNCTION CHSUM(MODE,C,N,X)
- DIMENSION C(0:N)
-C
- CHARACTER NAME*(*)
- PARAMETER (NAME = 'CHSUM')
- CALL MTLPRT(NAME,'E407.0','Not available on this machine')
- CHSUM=0
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/e/chsum128.F b/src/mathlib/gen/e/chsum128.F
deleted file mode 100644
index 2af78c5..0000000
--- a/src/mathlib/gen/e/chsum128.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: chsum128.F,v 1.1.1.1 1996/04/01 15:02:29 mclareni Exp $
-*
-* $Log: chsum128.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:29 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION DCHSUM(MODE,C,N,X)
-#include "gen/imp128.inc"
- DIMENSION C(0:N)
-C
- CHARACTER NAME*(*)
- PARAMETER (NAME = 'DCHSUM')
- CALL MTLPRT(NAME,'E407.0','Not available on this machine')
- DCHSUM=0
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/e/chsum64.F b/src/mathlib/gen/e/chsum64.F
deleted file mode 100644
index d35da86..0000000
--- a/src/mathlib/gen/e/chsum64.F
+++ /dev/null
@@ -1,51 +0,0 @@
-*
-* $Id: chsum64.F,v 1.1.1.1 1996/04/01 15:02:29 mclareni Exp $
-*
-* $Log: chsum64.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:29 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION CHSUM(MODE,C,N,X)
-#endif
-#if defined(CERNLIB_DOUBLE)
- FUNCTION DCHSUM(MODE,C,N,X)
-#endif
-#include "gen/imp64.inc"
- DIMENSION C(0:N)
-
- IF(MODE .EQ. 1) THEN
- H=X
- F=H
- V=1
- ELSE IF(MODE .EQ. 2) THEN
- H=2*X**2-1
- F=H
- V=1
- ELSE IF(MODE .EQ. 3) THEN
- H=2*X**2-1
- F=1
- V=X
- ELSE IF(MODE .EQ. 4) THEN
- H=2*X-1
- F=H
- V=1
- END IF
-
- ALFA=H+H
- B1=0
- B2=0
- DO 1 I = N,0,-1
- B0=C(I)+ALFA*B1-B2
- B2=B1
- 1 B1=B0
-#if !defined(CERNLIB_DOUBLE)
- CHSUM=V*(B0-F*B2)
-#endif
-#if defined(CERNLIB_DOUBLE)
- DCHSUM=V*(B0-F*B2)
-#endif
- RETURN
- END
diff --git a/src/mathlib/gen/e/dchebn.F b/src/mathlib/gen/e/dchebn.F
deleted file mode 100644
index b02851f..0000000
--- a/src/mathlib/gen/e/dchebn.F
+++ /dev/null
@@ -1,216 +0,0 @@
-*
-* $Id: dchebn.F,v 1.1.1.1 1996/04/01 15:02:28 mclareni Exp $
-*
-* $Log: dchebn.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:28 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- SUBROUTINE DCHEBN(M,N,A,MDIM,B,TOL,RELERR,X,RESMAX,IRK,ITER,IOCD)
-
- IMPLICIT DOUBLE PRECISION (A-H,O-Z)
-
- DIMENSION A(MDIM,*),B(*),X(*)
-
- PARAMETER (R0 = 0, R1 = 1, R2 = 2)
-
- DATA BIG /1E+37/
-
- IRK=N
- NR=1
- RELTMP=RELERR
- RELERR=0
-
- CALL DVSET(M,R1,A(1,N+1),A(2,N+1))
- CALL DVSCL(M,-R1,B(1),B(2),A(1,N+2),A(2,N+2))
- DO 10 I = 1,M
- A(I,N+3)=N+I
- 10 CONTINUE
- DO 20 J = 1,N
- A(M+1,J)=J
- 20 CONTINUE
- A(M+1,N+1)=0
- ITER=0
- IOCD=1
- CALL DVSET(N,R0,X(1),X(2))
-
- LEV=1
-
- K=0
- NK=N+1
- 30 K=K+1
- NK=NK-1
- MODE=0
- CALL DVSET(M-K+1,R1,B(1),B(2))
-
- 50 D=-BIG
- DO 60 I = K,M
- IF(B(I) .NE. 0) THEN
- DD=ABS(A(I,N+2))
- IF(DD .GT. D) THEN
- IQ=I
- D=DD
- ENDIF
- ENDIF
- 60 CONTINUE
- IF(K .LE. 1 .AND. D .LE. TOL) THEN
- RESMAX=0
- MODE=2
- GOTO 380
- ENDIF
- D=TOL
- DO 80 J = 1,NK
- DD=ABS(A(IQ,J))
- IF(DD .GT. D) THEN
- IP=J
- D=DD
- ENDIF
- 80 CONTINUE
- IF(D .GT. TOL) GOTO 330
-
- B(IQ)=0
- IF(MODE .EQ. 1) GOTO 50
- DO 100 I = K,M
- IF(B(I) .NE. 0) THEN
- DO 90 J = 1,NK
- IF(ABS(A(I,J)) .GT. TOL) THEN
- MODE=1
- GOTO 50
- ENDIF
- 90 CONTINUE
- ENDIF
- 100 CONTINUE
- IRK=K-1
- NR=N+1-IRK
- IOCD=0
- GOTO 160
-
- 110 CALL DVXCH(N+3,A(IQ,1),A(IQ,2),A(K,1),A(K,2))
- CALL DVXCH(M+1,A(1,IP),A(2,IP),A(1,NK),A(2,NK))
- IF(K .LT. N) GOTO 30
- 160 IF(IRK .EQ. M) GOTO 380
-
- LEV=2
-
- D=TOL
- DO 170 I = IRK+1,M
- DD=ABS(A(I,N+2))
- IF(DD .GT. D) THEN
- IQ=I
- D=DD
- ENDIF
- 170 CONTINUE
-
- IF(D .LE. TOL) THEN
- RESMAX=0
- MODE=3
- GOTO 380
- ENDIF
- IF(A(IQ,N+2) .GE. -TOL) THEN
- A(IQ,N+1)=2-A(IQ,N+1)
- CALL DVSCL(N+4-NR,-R1,A(IQ,1),A(IQ,2),A(IQ,1),A(IQ,2))
- A(IQ,N+1)=-A(IQ,N+1)
- ENDIF
- DO 220 J = NR,N
- IF(A(IQ,J) .GE. TOL) THEN
- CALL DVSCA(M,R2,
- 1 A(1,J),A(2,J),A(1,N+1),A(2,N+1),A(1,N+1),A(2,N+1))
- CALL DVSCL(M,-R1,A(1,J),A(2,J),A(1,J),A(2,J))
- A(M+1,J)=-A(M+1,J)
- ENDIF
- 220 CONTINUE
- IP=N+1
- GOTO 330
-
- 230 IF(IRK+1 .EQ. M) GO TO 380
- CALL DVXCH(IRK+3,A(IQ,1),A(IQ,2),A(M,1),A(M,2))
-
- LEV=3
-
- 260 D=-TOL
- H=2*A(M,N+2)
- DO 280 I = IRK+1,M-1
- IF(A(I,N+2) .LT. D) THEN
- IQ=I
- D=A(I,N+2)
- MODE=0
- ELSE
- DD=H-A(I,N+2)
- IF(DD .LT. D) THEN
- IQ=I
- D=DD
- MODE=1
- ENDIF
- ENDIF
- 280 CONTINUE
- IF(D .GE. -TOL) GOTO 380
- DD=-D/A(M,N+2)
- IF(DD .LT. RELTMP) THEN
- RELERR=DD
- MODE=4
- GOTO 380
- ENDIF
- IF(MODE .NE. 0) THEN
- CALL DVSCS(IRK+1,R2,
- 1 A(M,1),A(M,2),A(IQ,1),A(IQ,2),A(IQ,1),A(IQ,2))
- A(IQ,N+2)=D
- A(IQ,N+3)=-A(IQ,N+3)
- ENDIF
- D=BIG
- DO 320 J = NR,N+1
- IF(A(IQ,J) .GT. TOL) THEN
- DD=A(M,J)/A(IQ,J)
- IF(DD .LT. D) THEN
- IP=J
- D=DD
- ENDIF
- ENDIF
- 320 CONTINUE
- IF(D .LT. BIG) GO TO 330
- IOCD=2
- GOTO 380
-
- 330 RPVT=1/A(IQ,IP)
- CALL DVSCL(M,RPVT,A(1,IP),A(2,IP),A(1,IP),A(2,IP))
- DO 360 I = 1,M
- IF(I .NE. IQ) THEN
- D=A(I,IP)
- CALL DVSCA(N+3-NR,-D,
- 1 A(IQ,NR),A(IQ,NR+1),A(I,NR),A(I,NR+1),A(I,NR),A(I,NR+1))
- A(I,IP)=D
- ENDIF
- 360 CONTINUE
- CALL DVSCL(IRK+2,-RPVT,A(IQ,NR),A(IQ,NR+1),A(IQ,NR),A(IQ,NR+1))
- A(IQ,IP)=RPVT
- D=A(M+1,IP)
- A(M+1,IP)=A(IQ,N+3)
- A(IQ,N+3)=D
- ITER=ITER+1
- GOTO (110,230,260), LEV
-
- 380 CALL DVSET(M,R0,B(1),B(2))
- IF(MODE .EQ. 2) GOTO 450
- DO 400 I = 1,IRK
- X(INT(A(I,N+3)))=A(I,N+2)
- 400 CONTINUE
- IF(MODE .EQ. 3 .OR. IRK .EQ. M) GOTO 450
- DO 410 J = NR,N+1
- B(INT(ABS(A(M+1,J)))-N)=A(M,N+2)*SIGN(R1,A(M+1,J))
- 410 CONTINUE
- DO 420 I = IRK+1,M-1
- B(INT(ABS(A(I,N+3)))-N)=(A(M,N+2)-A(I,N+2))*SIGN(R1,A(I,N+3))
- 420 CONTINUE
- 430 DO 440 J = NR,N+1
- IF(ABS(A(M,J)) .LE. TOL) THEN
- IOCD=0
- GOTO 450
- ENDIF
- 440 CONTINUE
- 450 IF(MODE .NE. 2 .AND. MODE .NE. 3) RESMAX=A(M,N+2)
- IF(IRK .EQ. M) RESMAX=0
- IF(MODE .EQ. 4) RESMAX=RESMAX-D
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/e/dchpws.F b/src/mathlib/gen/e/dchpws.F
deleted file mode 100644
index 57a0e3e..0000000
--- a/src/mathlib/gen/e/dchpws.F
+++ /dev/null
@@ -1,91 +0,0 @@
-*
-* $Id: dchpws.F,v 1.1.1.1 1996/04/01 15:02:29 mclareni Exp $
-*
-* $Log: dchpws.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:29 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- SUBROUTINE DCHPWS(N,C,A)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- SUBROUTINE RCHPWS(N,C,A)
-#endif
-#include "gen/imp64.inc"
- CHARACTER NAMECP*(*),NAMEPC*(*)
- CHARACTER*80 ERRTXT
-#if defined(CERNLIB_DOUBLE)
- PARAMETER (NAMECP = 'DCHPWS', NAMEPC = 'DPWCHS')
-#endif
-#if !defined(CERNLIB_DOUBLE)
- PARAMETER (NAMECP = 'RCHPWS', NAMEPC = 'RPWCHS')
-#endif
-
- DIMENSION C(0:*),A(0:*),QU(0:101),QV(0:101)
-
- PARAMETER (R1 = 1, HF = R1/2)
-
- IF(N .LT. 0 .OR. N .GT. 100) THEN
- WRITE(ERRTXT,101) N
- CALL MTLPRT(NAMECP,'E408.1',ERRTXT)
- ELSEIF(N .EQ. 0) THEN
- A(0)=C(0)
- ELSE
- QU(0)=C(N)
- QU(1)=0
- QV(0)=C(N-1)
- QV(1)=2*QU(0)
- DO 2 K = 2,N
- TT=C(N-K)-QU(0)
- QU(K)=0
- DO 1 J = 0,K-1
- T=2*QV(J)-QU(J+1)
- QU(J)=QV(J)
- QV(J)=TT
- TT=T
- 1 CONTINUE
- QV(K)=TT
- 2 CONTINUE
- ENDIF
- A(0)=QV(0)
- DO 3 J = 1,N
- A(J)=QV(J)-QU(J-1)
- 3 CONTINUE
- RETURN
-
-#if defined(CERNLIB_DOUBLE)
- ENTRY DPWCHS(N,A,C)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- ENTRY RPWCHS(N,A,C)
-#endif
-
- IF(N .LT. 0 .OR. N .GT. 100) THEN
- WRITE(ERRTXT,101) N
- CALL MTLPRT(NAMEPC,'E408.1',ERRTXT)
- ELSEIF(N .EQ. 0) THEN
- QU(0)=A(0)
- ELSE
- QU(0)=A(N-1)
- QU(1)=A(N)
- IF(N .GE. 2) QU(2)=0
- DO 4 K = 2,N
- TT=QU(0)+HF*QU(2)
- QU(0)=A(N-K)+HF*QU(1)
- DO 5 J = 2,K
- T=HF*QU(J-1)
- IF(J .LE. K-2) T=T+HF*QU(J+1)
- QU(J-1)=TT
- TT=T
- 5 CONTINUE
- QU(K)=T
- 4 CONTINUE
- ENDIF
- DO 6 J = 0,N
- C(J)=QU(J)
- 6 CONTINUE
- RETURN
- 101 FORMAT('NUMBER OF TERMS N = ',I5,' < 0 OR > 100')
- END
diff --git a/src/mathlib/gen/e/decomp.F b/src/mathlib/gen/e/decomp.F
deleted file mode 100644
index 0f7b72b..0000000
--- a/src/mathlib/gen/e/decomp.F
+++ /dev/null
@@ -1,78 +0,0 @@
-*
-* $Id: decomp.F,v 1.1.1.1 1996/04/01 15:02:27 mclareni Exp $
-*
-* $Log: decomp.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:27 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE DECOMP(M,N,QR,ALPHA,IPIVOT,ERR,YA,SUM)
- DIMENSION QR(M,N),ALPHA(N),IPIVOT(N),YA(N),SUM(N)
- LOGICAL ERR
-C
-C THIS ROUTINE REDUCES THE MATRIX GIVEN IN THE ARRAY
-C QR(M,N), WHERE M \ N, TO UPPER RIGHT TRIANGULAR FORM
-C BY MEANS OF N ELEMENTARY ORTHOGONAL TRANSFORMATIONS
-C ( I - BETA UT , WHERE T IS THE TRANSPOSE OF U).
-C THE DIAGONAL ELEMENTS OF THE REDUCED MATRIX ARE STORED
-C IN THE ARRAY ALPHA(N), THE OFF-DIAGONAL ELEMENTS IN THE
-C UPPER RIGHT TRIANGULAR PART OF QR. THE NON-ZERO
-C COMPONENTS OF THE VECTORS U ARE STORED ON AND BELOW
-C THE LEADING DIAGONAL OF QR. PIVOTING IS DONE BY
-C CHOOSING AT EACH STEP, THE COLUMN WITH THE LARGEST SUM
-C OF SQUARES TO BE REDUCED NEXT. THESE INTERCHANGES ARE
-C RECORDED IN THE ARRAY IPIVOT(N). IF AT ANY STAGE, THE
-C SUM OF SQUARES OF THE COLUMN TO BE REDUCED IS EXACTLY
-C EQUAL TO ZERO, THEN THE LOGICAL VARIABLE ERR IS SET TO
-C .FALSE. AND CONTROL IS RETURNED TO THE MAIN PROGRAM.
-C
- DO 5 J=1,N
-C *** J TH. COLUMN SUM ***
- SUM(J)=PROD1(QR(1,J),QR(1,J),1,M)
- 5 IPIVOT(J)=J
-C
- DO 40 K=1,N
-C *** K TH. HOUSEHOLDER TRANSFORMATION ***
- SIGMA=SUM(K)
- JBAR=K
- L=K+1
- IF(L.GT.N) GO TO 11
- DO 10 J=L,N
- IF(SIGMA .GE. SUM(J)) GO TO 10
- SIGMA=SUM(J)
- JBAR=J
- 10 CONTINUE
- 11 CONTINUE
- IF(JBAR .EQ. K) GO TO 20
-C *** COLUMN INTERCHANGE ***
- I=IPIVOT(K)
- IPIVOT(K)=IPIVOT(JBAR)
- IPIVOT(JBAR)=I
- SUM(JBAR)=SUM(K)
- SUM(K)=SIGMA
- DO 15 I=1,M
- SIGMA=QR(I,K)
- QR(I,K)=QR(I,JBAR)
- 15 QR(I,JBAR)=SIGMA
- 20 CONTINUE
- SIGMA=PROD1(QR(1,K),QR(1,K),K,M)
- IF(SIGMA .NE. 0.0) GO TO 22
- ERR=.FALSE.
- RETURN
- 22 QRKK=QR(K,K)
- ALPHA(K)=SQRT(SIGMA)
- IF(QRKK .GE. 0.0) ALPHA(K)=-ALPHA(K)
- ALPHAK=ALPHA(K)
- BETA=1.0/(SIGMA-QRKK*ALPHAK)
- QR(K,K)=QRKK-ALPHAK
- IF (L.GT.N) GO TO 40
- DO 25 J=L,N
- 25 YA(J)=BETA*PROD1(QR(1,K),QR(1,J),K,M)
- DO 35 J=L,N
- DO 30 I=K,M
- 30 QR(I,J)=QR(I,J)-QR(I,K)*YA(J)
- 35 SUM(J)=SUM(J)-QR(K,J)**2
- 40 CONTINUE
- RETURN
- END
diff --git a/src/mathlib/gen/e/dlsqp1.F b/src/mathlib/gen/e/dlsqp1.F
deleted file mode 100644
index 480c321..0000000
--- a/src/mathlib/gen/e/dlsqp1.F
+++ /dev/null
@@ -1,66 +0,0 @@
-*
-* $Id: dlsqp1.F,v 1.1.1.1 1996/04/01 15:02:24 mclareni Exp $
-*
-* $Log: dlsqp1.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:24 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE DLSQP1(N,X,Y,A0,A1,SD,IFAIL)
-#if !defined(CERNLIB_DOUBLE)
- CHARACTER*6 NAME
- NAME = 'DLSQP1'
- CALL MTLPRT(NAME,'E201',
- +'not available on this machine - see documentation')
- RETURN
- END
-#endif
-#if defined(CERNLIB_DOUBLE)
- IMPLICIT DOUBLE PRECISION (A-H,O-Z)
-
- DIMENSION X(*),Y(*)
-
- PARAMETER (R0 = 0)
-
- A0=0
- A1=0
- SD=0
- IF(N .LE. 1) THEN
- IFAIL=1
- ELSE
- FN=N
- XM=0
- DO 1 K = 1,N
- XM=XM+X(K)
- 1 CONTINUE
- XM=XM/FN
- SX=0
- SY=0
- SXX=0
- SYY=0
- SXY=0
- DO 2 K = 1,N
- XK=X(K)-XM
- YK=Y(K)
- SX=SX+XK
- SY=SY+YK
- SXX=SXX+XK**2
- SYY=SYY+YK**2
- SXY=SXY+XK*YK
- 2 CONTINUE
- DET=FN*SXX-SX**2
- IF(DET .GT. 0) THEN
- A0=(SY*SXX-SXY*SX)/DET
- A1=(FN*SXY-SX*SY)/DET
- IFAIL=0
- ELSE
- IFAIL=-1
- ENDIF
- ENDIF
- IF(IFAIL .EQ. 0 .AND. N .GT. 2)
- 1 SD=SQRT(MAX(R0,SYY-A0*SY-A1*SXY)/(N-2))
- A0=A0-A1*XM
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/e/dlsqp2.F b/src/mathlib/gen/e/dlsqp2.F
deleted file mode 100644
index 2a5ffec..0000000
--- a/src/mathlib/gen/e/dlsqp2.F
+++ /dev/null
@@ -1,76 +0,0 @@
-*
-* $Id: dlsqp2.F,v 1.1.1.1 1996/04/01 15:02:24 mclareni Exp $
-*
-* $Log: dlsqp2.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:24 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE DLSQP2(N,X,Y,A0,A1,A2,SD,IFAIL)
-#if !defined(CERNLIB_DOUBLE)
- CHARACTER*6 NAME
- NAME = 'DLSQP2'
- CALL MTLPRT(NAME,'E201',
- +'not available on this machine - see documentation')
- RETURN
- END
-#endif
-#if defined(CERNLIB_DOUBLE)
- IMPLICIT DOUBLE PRECISION (A-H,O-Z)
-
- DIMENSION X(*),Y(*)
-
- PARAMETER (R0 = 0)
-
- A0=0
- A1=0
- A2=0
- SD=0
- IF(N .LE. 2) THEN
- IFAIL=1
- ELSE
- FN=N
- XM=0
- DO 1 K = 1,N
- XM=XM+X(K)
- 1 CONTINUE
- XM=XM/FN
- SX=0
- SXX=0
- SXXX=0
- SXXXX=0
- SY=0
- SYY=0
- SXY=0
- SXXY=0
- DO 2 K = 1,N
- XK=X(K)-XM
- YK=Y(K)
- XK2=XK**2
- SX=SX+XK
- SXX=SXX+XK2
- SXXX=SXXX+XK2*XK
- SXXXX=SXXXX+XK2**2
- SY=SY+YK
- SYY=SYY+YK**2
- SXY=SXY+XK*YK
- SXXY=SXXY+XK2*YK
- 2 CONTINUE
- DET=(FN*SXXXX-SXX**2)*SXX-FN*SXXX**2
- IF(DET .GT. 0) THEN
- A2=(SXX*(FN*SXXY-SXX*SY)-FN*SXXX*SXY)/DET
- A1=(SXY-SXXX*A2)/SXX
- A0=(SY-SXX*A2)/FN
- IFAIL=0
- ELSE
- IFAIL=-1
- ENDIF
- ENDIF
- IF(IFAIL .EQ. 0 .AND. N .GT. 3)
- 1 SD=SQRT(MAX(R0,SYY-A0*SY-A1*SXY-A2*SXXY)/(N-3))
- A0=A0+XM*(XM*A2-A1)
- A1=A1-2*XM*A2
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/e/dlsqpm.F b/src/mathlib/gen/e/dlsqpm.F
deleted file mode 100644
index 4d97a8c..0000000
--- a/src/mathlib/gen/e/dlsqpm.F
+++ /dev/null
@@ -1,82 +0,0 @@
-*
-* $Id: dlsqpm.F,v 1.1.1.1 1996/04/01 15:02:24 mclareni Exp $
-*
-* $Log: dlsqpm.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:24 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE DLSQPM(N,X,Y,M,A,SD,IFAIL)
-#if !defined(CERNLIB_DOUBLE)
- CHARACTER*6 NAME
- NAME = 'DLSQPM'
- CALL MTLPRT(NAME,'E201',
- +'not available on this machine - see documentation')
- RETURN
- END
-#endif
-#if defined(CERNLIB_DOUBLE)
- IMPLICIT DOUBLE PRECISION (A-H,O-Z)
-
- PARAMETER (IDIM = 21, R0 = 0)
-
- DIMENSION X(*),Y(*),A(0:*),B(IDIM,IDIM),XY(0:IDIM)
-
- M1=M+1
- IFAIL=0
- IF(N .LE. 1 .OR. M .LT. 0 .OR. M1 .GT. IDIM .OR. M1 .GT. N) THEN
- IFAIL=1
- ELSEIF(M .EQ. 0) THEN
- XY(0)=DVSUM(N,Y(1),Y(2))
- A(0)=XY(0)/N
- SYY=DVMPY(N,Y(1),Y(2),Y(1),Y(2))
- ELSE
- DO 11 J = 1,M1
- A(J-1)=0
- B(J,1)=0
- B(M1,J)=0
- 11 CONTINUE
- B(1,1)=N
- SYY=0
- DO 4 K = 1,N
- XK=X(K)
- YK=Y(K)
- SYY=SYY+Y(K)**2
- P=1
- A(0)=A(0)+YK
- DO 2 J = 2,M1
- P=P*XK
- B(J,1)=B(J,1)+P
- A(J-1)=A(J-1)+P*YK
- 2 CONTINUE
- DO 3 J = 2,M1
- P=P*XK
- B(M1,J)=B(M1,J)+P
- 3 CONTINUE
- 4 CONTINUE
- DO 5 I = 2,M
- DO 5 K = I,M1
- B(K-1,I)=B(K,I-1)
- 5 CONTINUE
- DO 6 J = 0,M
- XY(J)=A(J)
- 6 CONTINUE
- CALL DSEQN(M1,B,IDIM,IFAIL,1,A)
- ENDIF
- SD=0
- IF(IFAIL .EQ. 0) THEN
- IF(N .GT. M1) THEN
- SD=SYY
- DO 7 J = 0,M
- SD=SD-A(J)*XY(J)
- 7 CONTINUE
- SD=SQRT(MAX(R0,SD)/(N-M1))
- ENDIF
- ELSE
- CALL DVSET(M1,R0,A(0),A(1))
- M=0
- ENDIF
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/e/dspap1.F b/src/mathlib/gen/e/dspap1.F
deleted file mode 100644
index e47965f..0000000
--- a/src/mathlib/gen/e/dspap1.F
+++ /dev/null
@@ -1,123 +0,0 @@
-*
-* $Id: dspap1.F,v 1.1.1.1 1996/04/01 15:02:25 mclareni Exp $
-*
-* $Log: dspap1.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:25 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE DSPAP1(K,M,N,XI,YI,KNOT,T,C,W,NW,NERR)
-
-#include "gen/imp64.inc"
- DIMENSION XI(*),YI(*),T(*),W(*),C(*)
- CHARACTER NAME*(*)
- CHARACTER*80 ERRTXT
- PARAMETER (NAME = 'DSPAP1')
-
-************************************************************************
-* NORBAS, VERSION: 15.03.1993
-************************************************************************
-*
-* DSPAP1 COMPUTES THE COEFFICIENTS C(1),...,C(NC) OF A POLYNOMIAL
-* APPROXIMATION SPLINE S(X) IN B-SPLINE REPRESENTATION
-*
-* S(X) = SUMME(I=1,...,NC) C(I) * B(I,K)(X) , NC=M-K-1
-*
-* TO A USER SUPPLIED DATA SET
-*
-* (XI(J),YI(J)) , J = 1,2,...,N , N >= M-K-1 >= K+1
-*
-* OF A FUNCTION Y=F(X) , I.E.
-*
-* S(XI(J)) = YI(J) , J = 1,2,...,N .
-*
-* THE FUNCTIONS B(I,K)(X) ARE NORMALIZED B-SPLINES OF DEGREE K
-* (0<= K <= 25) WITH INDEX I (1 <= I <= N) OVER A SET OF SPLINE-KNOTS
-* T(1),T(2), ... ,T(M) ( M <= N+K+1 )
-* (KNOTS IN ASCENDING ORDER, WITH MULTIPLICITIES NOT GREATER
-* THAN K+1).
-* FOR FURTHER DETAILS TO THE ONE-DIMENSIONAL NORMALIZED B-SPLINES SEE
-* THE COMMENTS TO DSPNB1.
-*
-* PARAMETERS:
-*
-* N (INTEGER) NUMBER OF APPROXIMATION POINTS .
-* M (INTEGER) NUMBER OF KNOTS.
-* K (INTEGER) DEGREE OF B-SPLINES.
-* XI (DOUBLE PRECISION) ARRAY OF AT LEAST ORDER N .
-* XI MUST CONTAIN THE APPROXIMATION POINTS IN ASCENDING ORDER,
-* ON ENTRY.
-* YI (DOUBLE PRECISION) ARRAY OF AT LEAST ORDER N CONTAINING
-* THE FUNCTION VALUES YI(J), J=1,...,N, ON ENTRY.
-* KNOT (INTEGER) PARAMETER FOR STEERING THE CHOICE OF KNOTS.
-* ON ENTRY:
-* = 1 : KNOTS ARE COMPUTED BY DSPAP1 IN THE FOLLOWING WAY:
-* T(J) = XI(1) , J = 1,...,K+1
-* T(J) = XI(1)+(J-K-1)*(XI(N)-XI(1))/(NC-K) ,
-* J = K+2,...,NC
-* T(NC+J) = XI(N) , J = 1,...,K+1
-* = 2 : KNOTS ARE COMPUTED BY DSPAP1 IN THE FOLLOWING WAY:
-* T(J) = XI(1) , J = 1,...,K+1
-* T(J) = (XI(J-K-1)+XI(J))/2 , J = K+2,...,N
-* T(N+J) = XI(N) , J = 1,...,K+1
-* OTHERWISE KNOTS ARE USER SUPPLIED. RECOMMENDED CHOICE :
-* T(1) <= ... <= T(K+1) <= XI(1)
-* XI(1) < T(K+2) < ... < T(NC) < XI(N)
-* XI(N) <= T(NC+1) <= ... <= T(NC+K+1)
-* T (DOUBLE PRECISION) ARRAY OF AT LEAST ORDER M .
-* IF THE INPUT VALUE OF THE PARAMETER KNOT IS 1 OR 2 THE
-* KNOTS ARE COMPUTED BY DSPAP1 AND THEY ARE GIVEN IN THE
-* ARRAY T, ON EXIT.
-* IN THE OTHER CASES THE ARRAY T MUST CONTAIN THE USER
-* SUPPLIED KNOTS, ON ENTRY.
-* W (DOUBLE PECISION) WORKING ARRAY OF AT LEAST ORDER NW.
-* NW (INTEGER) ORDER OF WORKING ARRAY W .
-* NW >= N*(NC+5)+NC*(NC+1) , WITH NC=M-K-1 .
-* FOR GOOD PERFORMANCE, NW SHOULD GENERALLY BE LARGER.
-* C (DOUBLE PRECISION) ARRAY OF AT LEAST ORDER N . ON EXIT
-* C(1),...,C(NC) CONTAIN THE COEFFICIENTS OF THE B-SPLINE
-* REPRESENTATION OF S(X).
-* NERR (INTEGER) ERROR INDICATOR. ON EXIT:
-* = 0: NO ERROR DETECTED
-* = 1: AT LEAST ONE OF THE CONSTANTS K , M , N IS ILLEGAL
-*
-* ERROR MESSAGES:
-*
-* IF ONE OF THE FOLLOWING RELATION IS SATISFIED BY THE CHOSEN INPUT-
-* PARAMETERS THE PROGRAM RETURNS, AND AN ERROR MESSAGE IS PRINTED:
-* K < 0 OR K > 25 OR
-* M < 2*K+2 OR
-* N < M-K-1 .
-*
-************************************************************************
-
- NERR=1
- IF(K .LT. 0 .OR. K .GT. 25) THEN
- WRITE(ERRTXT,101) 'K',K
- CALL MTLPRT(NAME,'E210.1',ERRTXT)
- ELSEIF(M .LT. 2*K+2) THEN
- WRITE(ERRTXT,101) 'M',M
- CALL MTLPRT(NAME,'E210.2',ERRTXT)
- ELSEIF(N .LT. M-K-1) THEN
- WRITE(ERRTXT,101) 'N',N
- CALL MTLPRT(NAME,'E210.4',ERRTXT)
- ELSE
-
- NC=M-K-1
- M1=1
- M2=M1+N*NC
- M3=M2+NC
- M4=M3+NC*NC
- LW=NW-M4+1
-
- CALL SPLAS1(N,NC,M,K,XI,YI,KNOT,T,W,W(M2),W(M3),W(M4),LW,C,NERR)
-
- ENDIF
- RETURN
-
- 101 FORMAT(1X,A5,' =',I6,' NOT IN RANGE')
- END
-
-
-
diff --git a/src/mathlib/gen/e/dspap2.F b/src/mathlib/gen/e/dspap2.F
deleted file mode 100644
index 1181be4..0000000
--- a/src/mathlib/gen/e/dspap2.F
+++ /dev/null
@@ -1,173 +0,0 @@
-*
-* $Id: dspap2.F,v 1.1.1.1 1996/04/01 15:02:25 mclareni Exp $
-*
-* $Log: dspap2.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:25 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE DSPAP2(KX,KY,MX,MY,NX,NY,XI,YI,ZI,NDIMZ,
- + KNOT,TX,TY,C,NDIMC,W,NW,NERR)
-
-#include "gen/imp64.inc"
- DIMENSION XI(*),YI(*),ZI(NDIMZ,*),TX(*),TY(*),W(*),C(NDIMC,*)
- CHARACTER NAME*(*)
- CHARACTER*80 ERRTXT
- PARAMETER (NAME = 'DSPAP2')
-
-************************************************************************
-* NORBAS, VERSION: 15.03.1993
-************************************************************************
-*
-* DSPAP2 COMPUTES THE COEFFICIENTS
-* C(I,J) (I=1,...,NCX , J=1,...,NCY)
-* OF A TWO-DIMENSIONAL POLYNOMIAL APPROXIMATION SPLINE Z = S(X,Y) IN
-* REPRESENTATION OF NORMALIZED TWO-DIMENSIONAL B-SPLINES B(I,J)(X,Y)
-*
-* S(X,Y) = SUMME(I=1,...,NCX)
-* SUMME(J=1,...,NCY) C(I,J) * B(I,J)(X,Y)
-*
-* TO A USER SUPPLIED DATA SET
-*
-* (XI(I),YI(J),ZI(I,J)) (I=1,...,NX , J=1,...,NY)
-*
-* OF A FUNCTION Z = F(X,Y) , I.E.
-*
-* S(XI(I),YI(J)) = Z(I,J) (I=1,...,NX , J=1,...,NY) .
-*
-* THE TWO-DIMENSIONAL B-SPLINES B(I,J)(X,Y) ARE THE PRODUCT OF TWO
-* ONE-DIMENSIONAL B-SPLINES BX , BY
-* B(I,J)(X,Y) = BX(I,KX)(X) * BY(J,KY)(Y)
-* OF DEGREE KX AND KY ( 0 <= KX , KY <= 25 ) WITH INDICES I , J
-* ( 1 <= I <= NX , 1 <= J <= NY ) OVER TWO SETS OF SPLINE-KNOTS
-* TX(1),TX(2),...,TX(MX) ( MX = NCX+KX+1 )
-* TY(1),TY(2),...,TY(MY) ( MY = NCY+KY+1 ) ,
-* RESPECTIVELY.
-* FOR FURTHER DETAILS TO THE ONE- AND TWO-DIMENSIONAL NORMALIZED
-* B-SPLINES SEE THE COMMENTS TO DSPNB1 AND DSPNB2.
-*
-* PARAMETERS:
-*
-* NX (INTEGER) NUMBER OF APPROXIMATION POINTS IN X-DIRECTION :
-* XI(I) , I=1,...,NX .
-* NY (INTEGER) NUMBER OF APPROXIMATION POINTS IN Y-DIRECTION :
-* YI(J) , J=1,...,NY .
-* MX (INTEGER) NUMBER OF KNOTS IN X-DIRECTION .
-* MY (INTEGER) NUMBER OF KNOTS IN Y-DIRECTION .
-* KX (INTEGER) DEGREE OF ONE-DIMENSIONAL B-SPLINES IN X-DIRECTION
-* OVER THE SET OF KNOTS TX.
-* KY (INTEGER) DEGREE OF ONE-DIMENSIONAL B-SPLINES IN Y-DIRECTION
-* OVER THE SET OF KNOTS TY.
-* NDIMC (INTEGER) DECLARED FIRST DIMENSION OF ARRAY C IN THE
-* CALLING PROGRAM, WITH NDIMC >= (MX-KX-1) .
-* NDIMZ (INTEGER) DECLARED FIRST DIMENSION OF ARRAY ZI IN THE
-* CALLING PROGRAM, WITH NDIMZ >= NX.
-* XI (DOUBLE PRECISION) ARRAY OF AT LEAST ORDER NX .
-* XI MUST CONTAIN THE APPROXIMATION POINTS IN X-DIRECTION IN
-* ASCENDING ORDER, ON ENTRY.
-* YI (DOUBLE PRECISION) ARRAY OF AT LEAST ORDER NY .
-* YI MUST CONTAIN THE APPROXIMATION POINTS IN Y-DIRECTION IN
-* ASCENDING ORDER, ON ENTRY.
-* ZI (DOUBLE PRECISION) ARRAY OF ORDER (NDIMZ , >= NY) .
-* ON ENTRY ZI MUST CONTAIN THE GIVEN FUNCTION VALUES
-* Z(I,J) AT THE APPROXIMATION POINTS (X(I),Y(J))
-* ( I=1,...,NX , J=1,...,NY ).
-* KNOT (INTEGER) PARAMETER FOR STEERING THE CHOICE OF KNOTS.
-* ON ENTRY:
-* = 1 : KNOTS ARE COMPUTED BY DSPAP2 IN THE FOLLOWING WAY:
-* TX(J) = XI(1) , J = 1,...,KX+1
-* TX(J) = XI(1)+(J-KX-1)*(XI(NX)-XI(1))/(NCX-KX) ,
-* J = KX+2,...,NCX
-* TX(NCX+J) = XI(NX) , J = 1,...,KX+1
-* = 2 : KNOTS ARE COMPUTED BY DSPAP2 IN THE FOLLOWING WAY:
-* TX(J) = XI(1) , J = 1,...,KX+1
-* TX(J) = (XI(NX*(J-KX-2)/NCX+1)+XI(NX*J/NCX))/2 ,
-* J = KX+2,...,NCX
-* TX(NCX+J) = XI(NX) , J = 1,...,KX+1
-* OTHERWISE KNOTS ARE USER SUPPLIED. RECOMMENDED CHOICE :
-* TX(1) <= ... <= TX(KX+1) <= XI(1)
-* XI(1) < TX(KX+2) < ... < TX(NX) < XI(NX)
-* XI(NX) <= TX(NX+1) <= ... <= TX(NX+KX+1)
-* IN ALL CASES THE SAME CHOICE IS USED FOR KNOTS TY IN
-* Y-DIRECTION .
-* TX (DOUBLE PRECISION) ARRAY OF AT LEAST ORDER MX.
-* IF THE INPUT VALUE OF THE PARAMETER KNOT IS 1 OR 2 THE
-* KNOTS ARE COMPUTED BY DSPAP2 AND THEY ARE GIVEN IN THE
-* ARRAY TX, ON EXIT.
-* IN THE OTHER CASES THE ARRAY TX MUST CONTAIN THE USER
-* SUPPLIED KNOTS IN X-DIRECTION, ON ENTRY.
-* TY (DOUBLE PRECISION) ARRAY OF AT LEAST ORDER MY.
-* IF THE INPUT VALUE OF THE PARAMETER KNOT IS 1 OR 2 THE
-* KNOTS ARE COMPUTED BY DSPAP2 AND THEY ARE GIVEN IN THE
-* ARRAY TY, ON EXIT.
-* IN THE OTHER CASES THE ARRAY TY MUST CONTAIN THE USER
-* SUPPLIED KNOTS IN Y-DIRECTION, ON ENTRY.
-* W (DOUBLE PRECISION) WORKING ARRAY OF AT LEAST ORDER NW .
-* NW (INTEGER) ORDER OF WORKING ARRAY W .
-* NW >= N*(NC+6)+NC*(NC+1),
-* WITH N=NX*NY , NC=NCX*NCY=(MX-KX-1)*(MY-KY-1)
-* FOR GOOD PERFORMANCE, NW SHOULD GENERALLY BE LARGER.
-* C (DOUBLE PRECISION) ARRAY OF ORDER (NDIMC, >= MY-KY-1).
-* ON EXIT C(I,J) CONTAINS THE (I,J)-TH COEFFICIENT OF THE
-* TWO-DIMENSIONAL B-SPLINE REPRESENTATION OF S(X,Y) .
-* NERR (INTEGER) ERROR INDICATOR. ON EXIT:
-* = 0: NO ERROR DETECTED
-* = 1: AT LEAST ONE OF THE CONSTANTS KX , KY , NX , NY , MX ,MY
-* IS ILLEGAL
-*
-* ERROR MESSAGES:
-*
-* IF ONE OF THE FOLLOWING RELATION IS SATISFIED BY THE CHOSEN INPUT-
-* PARAMETERS THE PROGRAM RETURNS, AND AN ERROR MESSAGE IS PRINTED:
-* KX < 0 OR KX > 25 OR
-* KY < 0 OR KY > 25 OR
-* MX < 2*KX+2 OR MY < 2*KY+2 OR
-* NX < MX-KX-1 OR NY < MY-KY-1 .
-*
-************************************************************************
-
- NERR=1
- IF(KX .LT. 0 .OR. KX .GT. 25) THEN
- WRITE(ERRTXT,101) 'KX',KX
- CALL MTLPRT(NAME,'E210.1',ERRTXT)
- ELSEIF(KY .LT. 0 .OR. KY .GT. 25) THEN
- WRITE(ERRTXT,101) 'KY',KY
- CALL MTLPRT(NAME,'E210.1',ERRTXT)
- ELSEIF(MX .LT. 2*KX+2) THEN
- WRITE(ERRTXT,101) 'MX',MX
- CALL MTLPRT(NAME,'E210.2',ERRTXT)
- ELSEIF(MY .LT. 2*KY+2) THEN
- WRITE(ERRTXT,101) 'MY',MY
- CALL MTLPRT(NAME,'E210.2',ERRTXT)
- ELSEIF(NX .LT. MX-KX-1) THEN
- WRITE(ERRTXT,101) 'NX',NX
- CALL MTLPRT(NAME,'E210.4',ERRTXT)
- ELSEIF(NY .LT. MY-KY-1) THEN
- WRITE(ERRTXT,101) 'NY',NY
- CALL MTLPRT(NAME,'E210.4',ERRTXT)
- ELSE
-
- NCX=MX-KX-1
- NCY=MY-KY-1
- NC=NCX*NCY
- N=NX*NY
- M1=1
- M2=M1+N*NC
- M3=M2+NC
- M4=M3+NC*NC
- M5=M4+N
- LW=NW-M5+1
-
- CALL SPLAS2(N,NC,NCX,NCY,NX,NY,MX,MY,KX,KY,NDIMC,NDIMZ,XI,YI,ZI,
- + KNOT,TX,TY,W(M1),W(M2),W(M3),W(M4),W(M5),LW,C,NERR)
-
- ENDIF
-
- RETURN
-
- 101 FORMAT(1X,A5,' =',I6,' NOT IN RANGE')
- END
-
-
-
diff --git a/src/mathlib/gen/e/dspcd1.F b/src/mathlib/gen/e/dspcd1.F
deleted file mode 100644
index 612d815..0000000
--- a/src/mathlib/gen/e/dspcd1.F
+++ /dev/null
@@ -1,101 +0,0 @@
-*
-* $Id: dspcd1.F,v 1.1.1.1 1996/04/01 15:02:25 mclareni Exp $
-*
-* $Log: dspcd1.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:25 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE DSPCD1(K,M,NDER,T,C,D,NERR)
-
-#include "gen/imp64.inc"
- DIMENSION T(*),C(*),D(*)
- CHARACTER NAME*(*)
- CHARACTER*80 ERRTXT
- PARAMETER (NAME = 'DSPCD1')
-
-************************************************************************
-* NORBAS, VERSION: 15.03.1993
-************************************************************************
-*
-* DSPCD1 COMPUTES FROM GIVEN COEFFICIENTS C(1),...,C(M-K-1) OF A
-* POLYNOMIAL SPLINE S(X) IN B-SPLINE REPRESENTATION
-*
-* S(X) = SUMME(I=1,...,M-K-1) C(I) * B(I,K)(X)
-*
-* THE CORRESPONDING COEFFICIENTS D(1),...,D(M-K-NDER-1) OF THE
-* NDER-TH DERIVATIVE OF S(X).
-*
-* THE FUNCTIONS B(I,K)(X) ARE NORMALIZED B-SPLINES OF DEGREE K
-* (0<= K <= 25) WITH INDEX I (1 <= I <= M-K-1) OVER A SET OF
-* SPLINE-KNOTS
-* T(1),T(2), ... ,T(M) ( M >= 2*K+2 )
-* (KNOTS IN ASCENDING ORDER, WITH MULTIPLICITIES NOT GREATER
-* THAN K+1).
-* THE FUNCTION VALUE OF THE NORMALIZED B-SPLINE B(I,K)(X) IS
-* IDENTICALLY ZERO OUTSIDE THE INTERVAL T(I) <= X < T(I+K+1).
-* THE NORMALIZATION OF N(X) = B(I,K)(X) IS SUCH THAT THE INTGRAL OF
-* N(X) OVER THE WHOLE X-RANGE EQUALS
-* ( T(I+K+1) - T(I) ) / (K+1) .
-*
-* PARAMETERS:
-*
-* K (INTEGER) DEGREE (= ORDER - 1) OF B-SPLINES.
-* M (INTEGER) NUMBER OF KNOTS FOR THE B-SPLINES.
-* NDER (INTEGER) ORDER OF DERIVATIVE
-* T (DOUBLE PRECISION) ARRAY OF AT LEAST ORDER M CONTAINING THE
-* KNOTS, ON ENTRY.
-* C (DOUBLE PRECISION) ARRAY OF AT LEAST ORDER M-K-1. ON ENTRY
-* C(1),...,C(M-K-1) MUST CONTAIN THE COEFFICIENTS OF THE
-* POLYNOMIAL SPLINE S(X) IN B-SPLINE REPRESENTATION.
-* D (DOUBLE PRECISION) ARRAY OF AT LEAST ORDER M-K-1.
-* ON EXIT D(1),...,D(M-K-NDER-1) CONTAIN THE COEFFICIENTS
-* OF THE NDER-TH DERIVATIVE OF S(X) IN B-SPLINE REPRESENTATION.
-* (THE REMAINING ARRAY ELEMENTS D(M-K-NDER),...,D(M-K-1) ARE
-* USED AS WORKING SPACE).
-* NERR (INTEGER) ERROR INDICATOR. ON EXIT:
-* = 0: NO ERROR DETECTED
-* = 1: AT LEAST ONE OF THE CONSTANTS K , M , NDER IS ILLEGAL
-*
-* ERROR MESSAGES:
-*
-* IF ONE OF THE FOLLOWING RELATION IS SATISFIED BY THE CHOSEN INPUT-
-* PARAMETERS THE PROGRAM RETURNS, AND AN ERROR MESSAGE IS PRINTED:
-* K < 0 OR K > 25 OR
-* M < 2*K+2 OR
-* NDER < 1 OR NDER > K .
-*
-************************************************************************
-
- PARAMETER (Z0 = 0)
-
- NERR=1
- IF(K .LT. 0 .OR. K .GT. 25) THEN
- WRITE(ERRTXT,101) 'K',K
- CALL MTLPRT(NAME,'E210.1',ERRTXT)
- ELSEIF(M .LT. 2*K+2) THEN
- WRITE(ERRTXT,101) 'M',M
- CALL MTLPRT(NAME,'E210.2',ERRTXT)
- ELSEIF(NDER .LT. 1 .OR. NDER .GT. K) THEN
- WRITE(ERRTXT,101) 'NDER',NDER
- CALL MTLPRT(NAME,'E210.5',ERRTXT)
- ELSE
- NERR=0
- CALL DVCPY(M-K-1,C(1),C(2),D(1),D(2))
- DO 10 J = 1,NDER
- A=K-J+1
- DO 10 I = 1,M-K-1-J
- DIF=T(I+K+1)-T(I+J)
- D0=Z0
- IF(DIF .NE. 0) D0=A*(D(I+1)-D(I))/DIF
- 10 D(I)=D0
- ENDIF
-
- RETURN
-
- 101 FORMAT(1X,A5,' =',I6,' NOT IN RANGE')
- END
-
-
-
diff --git a/src/mathlib/gen/e/dspcd2.F b/src/mathlib/gen/e/dspcd2.F
deleted file mode 100644
index 094c125..0000000
--- a/src/mathlib/gen/e/dspcd2.F
+++ /dev/null
@@ -1,144 +0,0 @@
-*
-* $Id: dspcd2.F,v 1.1.1.1 1996/04/01 15:02:25 mclareni Exp $
-*
-* $Log: dspcd2.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:25 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE DSPCD2(KX,KY,MX,MY,NDERX,NDERY,TX,TY,C,NDIMC,D,NERR)
-
-#include "gen/imp64.inc"
- DIMENSION TX(*),TY(*),C(NDIMC,*),D(NDIMC,*)
- CHARACTER NAME*(*)
- CHARACTER*80 ERRTXT
- PARAMETER (NAME = 'DSPCD2')
-
-************************************************************************
-* NORBAS, VERSION: 15.03.1993
-************************************************************************
-*
-* DSPCD2 COMPUTES FROM GIVEN COEFFICIENTS
-* C(I,J) (I=1,...,MX-KX-1 , J=1,...,MY-KY-1)
-* OF A TWO-DIMENSIONAL POLYNOMIAL SPLINE S(X,Y) IN REPRESENTATION OF
-* NORMALIZED TWO-DIMENSIONAL B-SPLINES B(I,J)(X,Y)
-*
-* S(X,Y) = SUMME(I=1,...,MX-KX-1)
-* SUMME(J=1,...,MY-KY-1) C(I,J) * B(I,J)(X,Y)
-*
-* THE CORRESPONDING COEFFICIENTS
-* D(I,J) (I=1,...,MX-KX-NDERX-1 , J=1,...,MY-KY-NDERY-1)
-* OF THE NDERX-TH , NDERY-TH PARTIAL DERIVATIVE OF S(X,Y).
-*
-* THE TWO-DIMENSIONAL B-SPLINES B(I,J)(X,Y) ARE THE PRODUCT OF TWO
-* ONE-DIMENSIONAL B-SPLINES BX , BY
-* B(I,J)(X,Y) = BX(I,KX)(X) * BY(J,KY)(Y)
-* OF DEGREE KX AND KY ( 0 <= KX , KY <= 25 ) WITH INDICES I , J
-* ( 1 <= I <= MX-KX-1 , 1 <= J <= MY-KY-1 ) OVER TWO SETS OF SPLINE-
-* KNOTS
-* TX(1),TX(2),...,TX(MX) ( MX >= 2*KX+2 )
-* TY(1),TY(2),...,TY(MY) ( MY >= 2*KY+2 ) ,
-* RESPECTIVELY.
-* FOR FURTHER DETAILS TO THE ONE-DIMENSIONAL NORMALIZED B-SPLINES SEE
-* THE COMMENTS TO DSPNB1.
-*
-* PARAMETERS:
-*
-* KX (INTEGER) DEGREE OF ONE-DIMENSIONAL B-SPLINES IN X-DIRECTION
-* OVER THE SET OF KNOTS TX.
-* KY (INTEGER) DEGREE OF ONE-DIMENSIONAL B-SPLINES IN Y-DIRECTION
-* OVER THE SET OF KNOTS TY.
-* MX (INTEGER) NUMBER OF KNOTS FOR THE B-SPLINES IN X-DIRECTION.
-* MY (INTEGER) NUMBER OF KNOTS FOR THE B-SPLINES IN Y-DIRECTION.
-* NDERX (INTEGER) ORDER OF PARTIAL DERIVATIVE IN X-DIRECTION.
-* NDERY (INTEGER) ORDER OF PARTIAL DERIVATIVE IN Y-DIRECTION.
-* NDIMC (INTEGER) DECLARED FIRST DIMENSION OF ARRAYS C AND D IN THE
-* CALLING PROGRAM, WITH NDIMC >= MX-KX-1 .
-* TX (DOUBLE PRECISION) ARRAY OF AT LEAST ORDER MX CONTAINING THE
-* KNOTS IN X-DIRECTION, ON ENTRY.
-* TY (DOUBLE PRECISION) ARRAY OF AT LEAST ORDER MY CONTAINING THE
-* KNOTS IN Y-DIRECTION, ON ENTRY.
-* C (DOUBLE PRECISION) ARRAY OF ORDER (NDIMC, >= MY-KY-1).
-* ON ENTRY C(I,J) MUST CONTAIN THE (I,J)-TH COEFFICIENT OF THE
-* TWO-DIMENSIONAL B-SPLINE REPRESENTATION OF S(X,Y) .
-* D (DOUBLE PRECISION) ARRAY OF ORDER (NDIMD, >= MY-KY-1).
-* ON EXIT D(I,J) CONTAINS THE (I,J)-TH COEFFICIENT OF THE
-* TWO-DIMENSIONAL B-SPLINE REPRESENTATION OF THE NDERX-TH,
-* NDERY-TH PARTIAL DERIVATIVE OF S(X,Y).
-* NERR (INTEGER) ERROR INDICATOR. ON EXIT:
-* = 0: NO ERROR DETECTED
-* = 1: AT LEAST ONE OF THE CONSTANTS KX , KY , MX , MY , NDERX ,
-* NDERY IS ILLEGAL
-*
-* ERROR MESSAGES:
-*
-* IF ONE OF THE FOLLOWING RELATION IS SATISFIED BY THE CHOSEN INPUT-
-* PARAMETERS THE PROGRAM RETURNS, AND AN ERROR MESSAGE IS PRINTED:
-* KX < 0 OR KX > 25 OR KY < 0 OR KY > 25 OR
-* MX < 2*KX+2 OR MY < 2*KY+2 OR
-* NDERX < 0 OR NDERY < 0 OR
-* NDERX < 1 AND NDERY < 1 OR
-* NDERX > KX OR NDERY > KY .
-*
-************************************************************************
-
- PARAMETER (Z0 = 0)
-
- NERR=1
- IF(KX .LT. 0 .OR. KX .GT. 25) THEN
- WRITE(ERRTXT,101) 'KX',KX
- CALL MTLPRT(NAME,'E210.1',ERRTXT)
- ELSEIF(KY .LT. 0 .OR. KY .GT. 25) THEN
- WRITE(ERRTXT,101) 'KY',KY
- CALL MTLPRT(NAME,'E210.1',ERRTXT)
- ELSEIF(MX .LT. 2*KX+2) THEN
- WRITE(ERRTXT,101) 'MX',MX
- CALL MTLPRT(NAME,'E210.2',ERRTXT)
- ELSEIF(MY .LT. 2*KY+2) THEN
- WRITE(ERRTXT,101) 'MY',MY
- CALL MTLPRT(NAME,'E210.2',ERRTXT)
- ELSEIF(NDERX .LT. 0 .OR. NDERX .GT. KX) THEN
- WRITE(ERRTXT,101) 'NDERX',NDERX
- CALL MTLPRT(NAME,'E210.5',ERRTXT)
- ELSEIF(NDERY .LT. 0 .OR. NDERY .GT. KY) THEN
- WRITE(ERRTXT,101) 'NDERY',NDERY
- CALL MTLPRT(NAME,'E210.5',ERRTXT)
- ELSEIF(NDERX .LT. 1 .AND. NDERY .LT. 1)THEN
- WRITE(ERRTXT,102) 'NDERX',NDERX,'NDERY',NDERY
- CALL MTLPRT(NAME,'E210.6',ERRTXT)
- ELSE
-
- NERR=0
- CALL DMCPY(MX-KX-1,MY-KY-1,C(1,1),C(1,2),C(2,1),
- + D(1,1),D(1,2),D(2,1))
- IF(NDERX .GT. 0) THEN
- DO 10 J = 1,MY-KY-1
- DO 10 L = 1,NDERX
- A=KX-L+1
- DO 10 I = 1,MX-KX-1-L
- DIF=TX(I+KX+1)-TX(I+L)
- D0=Z0
- IF(DIF .NE. Z0) D0=A*(D(I+1,J)-D(I,J))/DIF
- 10 D(I,J)=D0
- ENDIF
-
- IF(NDERY .GT. 0) THEN
- DO 20 I = 1,MX-KX-1
- DO 20 L = 1,NDERY
- A=KY-L+1
- DO 20 J = 1,MY-KY-1-L
- DIF=TY(J+KY+1)-TY(J+L)
- D0=Z0
- IF(DIF .NE. Z0) D0=A*(D(I,J+1)-D(I,J))/DIF
- 20 D(I,J)=D0
- ENDIF
- ENDIF
-
- RETURN
-
- 101 FORMAT(1X,A5,' =',I6,' NOT IN RANGE')
- 102 FORMAT(1X,A5,' =',I6,A7,' =',I6,' INCONSISTENT')
- END
-
-
diff --git a/src/mathlib/gen/e/dspin1.F b/src/mathlib/gen/e/dspin1.F
deleted file mode 100644
index 4610fa6..0000000
--- a/src/mathlib/gen/e/dspin1.F
+++ /dev/null
@@ -1,152 +0,0 @@
-*
-* $Id: dspin1.F,v 1.1.1.1 1996/04/01 15:02:25 mclareni Exp $
-*
-* $Log: dspin1.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:25 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE DSPIN1(K,N,XI,YI,KNOT,T,C,W,IW,NERR)
-
-#include "gen/imp64.inc"
- DIMENSION XI(*),YI(*),T(*),W(*),IW(*),C(*)
- CHARACTER NAME*(*)
- CHARACTER*80 ERRTXT
- PARAMETER (NAME = 'DSPIN1')
-
-************************************************************************
-* NORBAS, VERSION: 10.02.1993
-************************************************************************
-*
-* DSPIN1 COMPUTES THE COEFFICIENTS C(1),...,C(N) OF A POLYNOMIAL
-* INTERPOLATION SPLINE S(X) IN B-SPLINE REPRESENTATION
-*
-* S(X) = SUMME(I=1,...,N) C(I) * B(I,K)(X)
-*
-* TO A USER SUPPLIED DATA SET
-*
-* (XI(J),YI(J)) , J = 1,2,...,N , N >= K+1
-*
-* OF A FUNCTION Y=F(X) , I.E.
-*
-* S(XI(J)) = YI(J) , J = 1,2,...,N .
-*
-* THE FUNCTIONS B(I,K)(X) ARE NORMALIZED B-SPLINES OF DEGREE K
-* ( K <= N-1 AND 0<= K <= 25) WITH INDEX I (1 <= I <= N) OVER A
-* SET OF SPLINE-KNOTS
-* T(1),T(2), ... ,T(M) ( M = N+K+1 )
-* (KNOTS IN ASCENDING ORDER, WITH MULTIPLICITIES NOT GREATER
-* THAN K+1).
-* FOR FURTHER DETAILS TO THE ONE-DIMENSIONAL NORMALIZED B-SPLINES SEE
-* THE COMMENTS TO DSPNB1.
-*
-* PARAMETERS:
-*
-* N (INTEGER) NUMBER OF INTERPOLATION POINTS .
-* K (INTEGER) DEGREE (= ORDER - 1) OF B-SPLINES.
-* XI (DOUBLE PRECISION) ARRAY OF AT LEAST ORDER N .
-* XI MUST CONTAIN THE INTERPOLATION POINTS IN ASCENDING ORDER,
-* ON ENTRY.
-* YI (DOUBLE PRECISION) ARRAY OF AT LEAST ORDER N CONTAINING
-* THE FUNCTION VALUES YI(J), J=1,...,N, ON ENTRY.
-* KNOT (INTEGER) PARAMETER FOR STEERING THE CHOICE OF KNOTS.
-* ON ENTRY:
-* = 1 : KNOTS ARE COMPUTED BY DSPIN1 IN THE FOLLOWING WAY:
-* T(J) = XI(1) , J = 1,...,K+1
-* T(J) = XI(1)+(J-K-1)*(XI(N)-XI(1)) ,
-* J = K+2,...,N
-* T(N+J) = XI(N) , J = 1,...,K+1
-* = 2 : KNOTS ARE COMPUTED BY DSPIN1 IN THE FOLLOWING WAY:
-* T(J) = XI(1) , J = 1,...,K+1
-* T(J) = (XI(J-K-1)+XI(J))/2 , J = K+2,...,N
-* T(N+J) = XI(N) , J = 1,...,K+1
-* OTHERWISE KNOTS ARE USER SUPPLIED. RECOMMENDED CHOICE :
-* T(1) <= ... <= T(K+1) <= XI(1)
-* XI(1) < T(K+2) < ... < T(N) < XI(N)
-* XI(N) <= T(N+1) <= ... <= T(N+K+1)
-* T (DOUBLE PRECISION) ARRAY OF AT LEAST ORDER M .
-* IF THE INPUT VALUE OF THE PARAMETER KNOT IS 1 OR 2 THE
-* KNOTS ARE COMPUTED BY DSPIN1 AND THEY ARE GIVEN IN THE
-* ARRAY T, ON EXIT.
-* IN THE OTHER CASES THE ARRAY T MUST CONTAIN THE USER
-* SUPPLIED KNOTS, ON ENTRY.
-* W (DOUBLE PECISION) WORKING ARRAY OF AT LEAST ORDER
-* (3*K+1)*N .
-* IW (INTEGER) WORKING ARRAY OF AT LEAST ORDER N .
-* C (DOUBLE PRECISION) ARRAY OF AT LEAST ORDER N . ON EXIT
-* C(1),...,C(N) CONTAIN THE COEFFICIENTS OF THE B-SPLINE
-* REPRESENTATION OF S(X).
-* NERR (INTEGER) ERROR INDICATOR. ON EXIT:
-* = 0: NO ERROR DETECTED
-* = 1: AT LEAST ONE OF THE CONSTANTS K , N IS ILLEGAL
-* = 2: THE LAPACK ROUTINES DGBTRF , DGBTRS COULD NOT SOLVE
-* THE LINEAR SYSTEM OF EQUATIONS WITH BAND-MATRIX FOR
-* COMPUTING C(1),...,C(N) . IT INDICATES THAT A SOLUTION
-* OF THE INTERPOLATION PROBLEM DOES NOT EXIST.
-* (ESPECIALLY, THE EXISTENCE OF A SOLUTION DEPENDS ON THE
-* SET OF KNOTS!)
-*
-* ERROR MESSAGES:
-*
-* IF ONE OF THE FOLLOWING RELATION IS SATISFIED BY THE CHOSEN INPUT-
-* PARAMETERS THE PROGRAM RETURNS, AND AN ERROR MESSAGE IS PRINTED:
-* K < 0 OR K > 25 OR
-* N < K+1 .
-*
-************************************************************************
-
- PARAMETER (Z1 = 1 , Z2 = 2 , HALF = Z1/Z2)
-
- NERR=1
- IF(K .LT. 0 .OR. K .GT. 25) THEN
- WRITE(ERRTXT,101) 'K',K
- CALL MTLPRT(NAME,'E210.1',ERRTXT)
- ELSEIF(N .LT. K+1) THEN
- WRITE(ERRTXT,101) 'N',N
- CALL MTLPRT(NAME,'E210.4',ERRTXT)
- ELSE
-
- M=N+K+1
- L=3*K+1
-*
-* COMPUTE KNOTS FROM INTERPOLATION POINTS (IF KNOT = 1 OR 2)
-*
- IF (KNOT .EQ. 1) THEN
- CALL DSPKN1(K,M,XI(1),XI(N),T,NERR)
- ELSEIF (KNOT .EQ. 2) THEN
- DO 10 I=1,K+1
- T(I)=XI(1)
- 10 T(N+I)=XI(N)
- DO 20 I=K+2,N
- 20 T(I)=HALF*(XI(I-K-1)+XI(I))
- ENDIF
-*
-* COMPUTE BAND-MATRIX W
-*
- DO 50 I=K+1,3*K+1
- DO 50 J=1,N
- IJ=I+J-2*K-1
- IF (1 .LE. IJ .AND. IJ .LE. N)
- + W((J-1)*L+I)=DSPNB1(K,M,J,0,XI(IJ),T,NERR)
- 50 CONTINUE
-*
-* SOLVE SYSTEM OF EQUATIONS FOR COMPUTING C
-*
- DO 60 J=1,N
- 60 IW(J)=J
- NERR=2
- CALL DGBTRF(N,N,K,K,W,L,IW,INFO)
- IF(INFO .NE. 0) RETURN
- CALL DVCPY(N,YI(1),YI(2),C(1),C(2))
- CALL DGBTRS('N',N,K,K,1,W,L,IW,C,N,INFO)
- IF(INFO .NE. 0) RETURN
- NERR=0
- ENDIF
- RETURN
-
- 101 FORMAT(1X,A5,' =',I6,' NOT IN RANGE')
- END
-
-
-
diff --git a/src/mathlib/gen/e/dspin2.F b/src/mathlib/gen/e/dspin2.F
deleted file mode 100644
index c671dd6..0000000
--- a/src/mathlib/gen/e/dspin2.F
+++ /dev/null
@@ -1,221 +0,0 @@
-*
-* $Id: dspin2.F,v 1.1.1.1 1996/04/01 15:02:25 mclareni Exp $
-*
-* $Log: dspin2.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:25 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE DSPIN2(KX,KY,NX,NY,XI,YI,ZI,NDIMZ,KNOT,TX,TY,C,NDIMC,
- + W,IW,NERR)
-
-#include "gen/imp64.inc"
- DIMENSION XI(*),YI(*),ZI(NDIMZ,*),TX(*),TY(*)
- DIMENSION W(*),IW(*),C(NDIMC,*)
- CHARACTER NAME*(*)
- CHARACTER*80 ERRTXT
- PARAMETER (NAME = 'DSPIN2')
-
-
-************************************************************************
-* NORBAS, VERSION: 10.02.1993
-************************************************************************
-*
-* DSPIN2 COMPUTES THE COEFFICIENTS
-* C(I,J) (I=1,...,NX , J=1,...,NY)
-* OF A TWO-DIMENSIONAL POLYNOMIAL INTERPOLATION SPLINE Z = S(X,Y) IN
-* REPRESENTATION OF NORMALIZED TWO-DIMENSIONAL B-SPLINES B(I,J)(X,Y)
-*
-* S(X,Y) = SUMME(I=1,...,NX)
-* SUMME(J=1,...,NY) C(I,J) * B(I,J)(X,Y)
-*
-* TO A USER SUPPLIED DATA SET
-*
-* (XI(I),YI(J),ZI(I,J)) (I=1,...,NX , J=1,...,NY)
-*
-* OF A FUNCTION Z = F(X,Y) , I.E.
-*
-* S(XI(I),YI(J)) = Z(I,J) (I=1,...,NX , J=1,...,NY) .
-*
-* THE TWO-DIMENSIONAL B-SPLINES B(I,J)(X,Y) ARE THE PRODUCT OF TWO
-* ONE-DIMENSIONAL B-SPLINES BX , BY
-* B(I,J)(X,Y) = BX(I,KX)(X) * BY(J,KY)(Y)
-* OF DEGREE KX AND KY ( 0 <= KX , KY <= 25 ) WITH INDICES I , J
-* ( 1 <= I <= NX , 1 <= J <= NY ) OVER TWO SETS OF SPLINE-KNOTS
-* TX(1),TX(2),...,TX(MX) ( MX = NX+KX+1 )
-* TY(1),TY(2),...,TY(MY) ( MY = NY+KY+1 ) ,
-* RESPECTIVELY.
-* FOR FURTHER DETAILS TO THE ONE- AND TWO-DIMENSIONAL NORMALIZED
-* B-SPLINES SEE THE COMMENTS TO DSPNB1 AND DSPNB2.
-*
-* PARAMETERS:
-*
-* NX (INTEGER) NUMBER OF INTERPOLATION POINTS IN X-DIRECTION :
-* XI(I) , I=1,...,NX .
-* NY (INTEGER) NUMBER OF INTERPOLATION POINTS IN Y-DIRECTION :
-* YI(J) , J=1,...,NY .
-* KX (INTEGER) DEGREE OF ONE-DIMENSIONAL B-SPLINES IN X-DIRECTION
-* OVER THE SET OF KNOTS TX,
-* WITH KX <= NX-1 AND 0 <= KX <= 25 .
-* KY (INTEGER) DEGREE OF ONE-DIMENSIONAL B-SPLINES IN Y-DIRECTION
-* OVER THE SET OF KNOTS TY,
-* WITH KY <= NY-1 AND 0 <= KY <= 25 .
-* NDIMC (INTEGER) DECLARED FIRST DIMENSION OF ARRAY C IN THE
-* CALLING PROGRAM, WITH NDIMC >= NX .
-* NDIMZ (INTEGER) DECLARED FIRST DIMENSION OF ARRAY ZI IN THE
-* CALLING PROGRAM, WITH NDIMZ >= NX .
-* XI (DOUBLE PRECISION) ARRAY OF AT LEAST ORDER NX .
-* XI MUST CONTAIN THE INTERPOLATION POINTS IN X-DIRECTION IN
-* ASCENDING ORDER, ON ENTRY.
-* YI (DOUBLE PRECISION) ARRAY OF AT LEAST ORDER NY .
-* YI MUST CONTAIN THE INTERPOLATION POINTS IN Y-DIRECTION IN
-* ASCENDING ORDER, ON ENTRY.
-* ZI (DOUBLE PRECISION) ARRAY OF ORDER (NDIMZ , >= NY) .
-* ON ENTRY ZI MUST CONTAIN THE GIVEN FUNCTION VALUES
-* Z(I,J) AT THE INTERPOLATION POINTS (X(I),Y(J))
-* ( I=1,...,NX , J=1,...,NY ).
-* KNOT (INTEGER) PARAMETER FOR STEERING THE CHOICE OF KNOTS.
-* ON ENTRY:
-* = 1 : KNOTS ARE COMPUTED BY DSPIN2 IN THE FOLLOWING WAY:
-* TX(J) = XI(1) , J = 1,...,KX+1
-* TX(J) = XI(1)+(J-KX-1)*(XI(NX)-XI(1)) ,
-* J = KX+2,...,NX
-* TX(N+J) = XI(NX) , J = 1,...,KX+1
-* = 2 : KNOTS ARE COMPUTED BY DSPIN2 IN THE FOLLOWING WAY:
-* TX(J) = XI(1) , J = 1,...,KX+1
-* TX(J) = (XI(J-KX-1)+XI(J))/2 , J = KX+2,...,NX
-* TX(N+J) = XI(NX) , J = 1,...,KX+1
-* OTHERWISE KNOTS ARE USER SUPPLIED. RECOMMENDED CHOICE :
-* T(1) <= ... <= T(K+1) <= XI(1)
-* XI(1) < T(K+2) < ... < T(N) < XI(N)
-* XI(N) <= T(N+1) <= ... <= T(N+K+1)
-* OTHERWISE KNOTS ARE USER SUPPLIED. RECOMMENDED CHOICE :
-* TX(1) <= ... <= TX(KX+1) <= XI(1)
-* XI(1) < TX(KX+2) < ... < TX(NX) < XI(NX)
-* XI(NX) <= TX(NX+1) <= ... <= TX(NX+KX+1)
-* IN ALL CASES THE SAME CHOICE IS USED FOR KNOTS TY IN
-* Y-DIRECTION .
-* TX (DOUBLE PRECISION) ARRAY OF AT LEAST ORDER MX.
-* IF THE INPUT VALUE OF THE PARAMETER KNOT IS 1 OR 2 THE
-* KNOTS ARE COMPUTED BY DSPIN2 AND THEY ARE GIVEN IN THE
-* ARRAY TX, ON EXIT.
-* IN THE OTHER CASES THE ARRAY TX MUST CONTAIN THE USER
-* SUPPLIED KNOTS IN X-DIRECTION, ON ENTRY.
-* TY (DOUBLE PRECISION) ARRAY OF AT LEAST ORDER MY.
-* IF THE INPUT VALUE OF THE PARAMETER KNOT IS 1 OR 2 THE
-* KNOTS ARE COMPUTED BY DSPIN2 AND THEY ARE GIVEN IN THE
-* ARRAY TY, ON EXIT.
-* IN THE OTHER CASES THE ARRAY TY MUST CONTAIN THE USER
-* SUPPLIED KNOTS IN Y-DIRECTION, ON ENTRY.
-* W (DOUBLE PRECISION) WORKING ARRAY OF AT LEAST ORDER (L+1)*NINT,
-* WITH NINT=NX*NY , K=KX*NY , L=3*K+1 .
-* IW (INTEGER) WORKING ARRAY OF AT LEAST ORDER NX*NY.
-* C (DOUBLE PRECISION) ARRAY OF ORDER (NDIMC, >= NY).
-* ON EXIT C(I,J) CONTAINS THE (I,J)-TH COEFFICIENT OF THE
-* TWO-DIMENSIONAL B-SPLINE REPRESENTATION OF S(X,Y) .
-* NERR (INTEGER) ERROR INDICATOR. ON EXIT:
-* = 0: NO ERROR DETECTED
-* = 1: AT LEAST ONE OF THE CONSTANTS KX , KY , NX , NY
-* IS ILLEGAL
-* = 2: THE LAPACK ROUTINES DGBTRF , DGBTRS COULD NOT SOLVE
-* THE LINEAR SYSTEM OF EQUATIONS WITH BAND-MATRIX FOR
-* COMPUTING C(1,1),...,C(NX,NY) . IT INDICATES THAT
-* A SOLUTION OF THE INTERPOLATION PROBLEM DOES NOT EXIST.
-* (ESPECIALLY, THE EXISTENCE OF A SOLUTION DEPENDS ON THE
-* SET OF KNOTS!)
-*
-* ERROR MESSAGES:
-*
-* IF ONE OF THE FOLLOWING RELATION IS SATISFIED BY THE CHOSEN INPUT-
-* PARAMETERS THE PROGRAM RETURNS, AND AN ERROR MESSAGE IS PRINTED:
-* KX < 0 OR KX > 25 OR
-* KY < 0 OR KY > 25 OR
-* NX < KX+1 OR NY < KY+1 .
-*
-************************************************************************
-
-
- PARAMETER (Z1 = 1 , Z2 = 2 , HALF = Z1/Z2)
-
- NERR=1
- IF(KX .LT. 0 .OR. KX .GT. 25) THEN
- WRITE(ERRTXT,101) 'KX',KX
- CALL MTLPRT(NAME,'E210.1',ERRTXT)
- ELSEIF(KY .LT. 0 .OR. KY .GT. 25) THEN
- WRITE(ERRTXT,101) 'KY',KY
- CALL MTLPRT(NAME,'E210.1',ERRTXT)
- ELSEIF(NX .LT. KX+1) THEN
- WRITE(ERRTXT,101) 'NX',NX
- CALL MTLPRT(NAME,'E210.4',ERRTXT)
- ELSEIF(NY .LT. KY+1) THEN
- WRITE(ERRTXT,101) 'NY',NY
- CALL MTLPRT(NAME,'E210.4',ERRTXT)
- ELSE
-
- K=KX*NY
- L=3*K+1
- NINT=NX*NY
- MX=NX+KX+1
- MY=NY+KY+1
-*
-* COMPUTE KNOTS FROM INTERPOLATION POINTS ( IF KNOT=1 OR 2 )
-*
- IF (KNOT .EQ. 1) THEN
- CALL DSPKN2(KX,KY,MX,MY,XI(1),XI(NX),YI(1),YI(NY),TX,TY,NERR)
- ELSEIF (KNOT .EQ. 2) THEN
- DO 10 I=1,KX+1
- TX(I)=XI(1)
- 10 TX(NX+I)=XI(NX)
- DO 20 I=KX+2,NX
- 20 TX(I)=HALF*(XI(I-KX-1)+XI(I))
- DO 30 J=1,KY+1
- TY(J)=YI(1)
- 30 TY(NY+J)=YI(NY)
- DO 40 J=KY+2,NY
- 40 TY(J)=HALF*(YI(J-KY-1)+YI(J))
- ENDIF
-*
-* COMPUTE BAND-MATRIX W
-*
-* NUMBER OF SUB-, SUPER-DIAGONALS: KL=KU=(KX-1)*NY+KY-1<=KX*NY
-*
- DO 90 IC=1,NX
- X=XI(IC)
- DO 90 JC=1,NY
- Y=YI(JC)
- IJ=(IC-1)*NX+JC
- DO 90 I=1,NX
- DO 90 J=1,NY
- JZ=(I-1)*NX+J
- IZ=IJ+2*K+1-JZ
- IF (K+1 .LE. IZ .AND. IZ .LE. 3*K+1)
- + W((JZ-1)*L+IZ)=DSPNB2(KX,KY,MX,MY,I,J,0,0,X,Y,TX,TY,NERR)
- 90 CONTINUE
-*
-* SOLVE SYSTEM OF EQUATIONS FOR COMPUTING C
-*
- DO 110 J=1,NINT
- 110 IW(J)=J
- NERR=2
- CALL DGBTRF(NINT,NINT,K,K,W,L,IW,INFO)
- IF(INFO .NE. 0) RETURN
- LW=L*NINT
- DO 120 I=1,NX
- DO 120 J=1,NY
- 120 W(LW+(I-1)*NY+J)=ZI(I,J)
- CALL DGBTRS('N',NINT,K,K,1,W,L,IW,W(LW+1),NINT,INFO)
- IF(INFO .NE. 0) RETURN
- DO 130 I=1,NX
- DO 130 J=1,NY
- 130 C(I,J)=W(LW+(I-1)*NY+J)
- NERR=0
- ENDIF
-
- RETURN
-
- 101 FORMAT(1X,A5,' =',I6,' NOT IN RANGE')
- END
-
-
-
diff --git a/src/mathlib/gen/e/dspkn1.F b/src/mathlib/gen/e/dspkn1.F
deleted file mode 100644
index 9681e21..0000000
--- a/src/mathlib/gen/e/dspkn1.F
+++ /dev/null
@@ -1,79 +0,0 @@
-*
-* $Id: dspkn1.F,v 1.1.1.1 1996/04/01 15:02:25 mclareni Exp $
-*
-* $Log: dspkn1.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:25 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE DSPKN1(K,M,A,B,T,NERR)
-
-#include "gen/imp64.inc"
- DIMENSION T(*)
- CHARACTER NAME*(*)
- CHARACTER*80 ERRTXT
- PARAMETER (NAME = 'DSPKN1')
-
-************************************************************************
-* NORBAS, VERSION: 15.03.1993
-************************************************************************
-*
-* DSPKN1 COMPUTES M ( M >= 2*K+2 ) KNOTS IN THE INTERVAL A <= X <= B
-* AS KNOTS FOR NORMALIZED B-SPLINES OF DEGREE K ( 0 <= K <= 25 ).
-* THE FIRST (K+1) KNOTS ARE EQUAL TO A, THE LAST (K+1) KNOTS ARE EQUAL
-* TO B, AND THE OTHER KNOTS ARE EQUIDISTANT.
-*
-* PARAMETERS:
-*
-* K (INTEGER) DEGREE OF B-SPLINES
-* M (INTEGER) NUMBER OF KNOTS IN THE INTERVAL A <= X <= B
-* A (DOUBLE PRECISION) LEFT ENDPOINT OF INTERVAL
-* B (DOUBLE PRECISION) RIGHT ENDPOINT OF INTERVAL
-* T (DOUBLE RECISION) ARRAY OF AT LEAST ORDER M CONTAINING THE
-* KNOTS, ON EXIT.
-* NERR (INTEGER) ERROR INDICATOR. ON EXIT:
-* = 0: NO ERROR DETECTED
-* = 1: AT LEAST ONE OF THE CONSTANTS K , M IS ILLEGAL
-*
-* USAGE:
-*
-* THE USER HAS TO PROVIDE K, M, A, AND B.
-* ON RETURN THE ARRAY T CONTAINS THE DESIRED KNOTS IN ASCENDING
-* ORDER.
-*
-* ERROR MESSAGES:
-*
-* IF ONE OF THE FOLLOWING RELATION IS SATISFIED BY THE CHOSEN INPUT-
-* PARAMETERS THE PROGRAM RETURNS, AND AN ERROR MESSAGE IS PRINTED:
-* K < 0 OR K > 25 OR
-* M < 2*K+2 OR
-* B <= A .
-*
-* ********************************************************************
-
- NERR=1
- IF(K .LT. 0 .OR. K .GT. 25) THEN
- WRITE(ERRTXT,101) 'K',K
- CALL MTLPRT(NAME,'E210.1',ERRTXT)
- ELSEIF(M .LT. 2*K+2) THEN
- WRITE(ERRTXT,101) 'M',M
- CALL MTLPRT(NAME,'E210.2',ERRTXT)
- ELSEIF(B .LE. A) THEN
- WRITE(ERRTXT,103) 'A',A,'B',B
- CALL MTLPRT(NAME,'E210.7',ERRTXT)
- ELSE
- NERR=0
- CALL DVSET(K+1,A,T(1),T(2))
- CALL DVSET(K+1,B,T(M-K),T(M-K+1))
- D=(B-A)/(M-2*K-1)
- DO 10 I = K+2,M-K-1
- 10 T(I)=A+D*(I-K-1)
- ENDIF
- RETURN
-
- 101 FORMAT(1X,A5,' =',I6,' NOT IN RANGE')
- 103 FORMAT(1X,A5,' =',1PD15.8,A7,' =',1PD15.8,' INCONSISTENT')
- END
-
-
diff --git a/src/mathlib/gen/e/dspkn2.F b/src/mathlib/gen/e/dspkn2.F
deleted file mode 100644
index a4beed3..0000000
--- a/src/mathlib/gen/e/dspkn2.F
+++ /dev/null
@@ -1,106 +0,0 @@
-*
-* $Id: dspkn2.F,v 1.1.1.1 1996/04/01 15:02:25 mclareni Exp $
-*
-* $Log: dspkn2.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:25 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE DSPKN2(KX,KY,MX,MY,AX,BX,AY,BY,TX,TY,NERR)
-
-#include "gen/imp64.inc"
- DIMENSION TX(*),TY(*)
- CHARACTER NAME*(*)
- CHARACTER*80 ERRTXT
- PARAMETER (NAME = 'DSPKN2')
-
-************************************************************************
-* NORBAS, VERSION: 15.03.1993
-************************************************************************
-*
-* DSPKN2 COMPUTES TWO SETS OF MX (MX >= 2*KX+2) AND MY (MY >= 2*KY+2)
-* SPLINE-KNOTS IN THE INTERVAL AX <= X <= BX AND AY <= Y <= BY
-* AS KNOTS FOR NORMALIZED B-SPLINES OF DEGREE KX (0 <= KX <= 25) AND
-* KY (0 <= KY <= 25), RESPECTIVELY.
-* THE FIRST (KX+1) KNOTS OF TX ARE EQUAL TO AX, THE LAST (KX+1) KNOTS
-* OF TX ARE EQUAL TO BX, AND THE OTHER KNOTS OF TX ARE EQUIDISTANT.
-* A CORRESPONDING CHARACTERISTIC HOLDS FOR SET OF KNOTS TY IN
-* Y-DIRECTION.
-*
-* PARAMETERS:
-*
-* KX (INTEGER) DEGREE OF B-SPLINES IN X-DIRECTION.
-* KY (INTEGER) DEGREE OF B-SPLINES IN Y-DIRECTION.
-* MX (INTEGER) NUMBER OF KNOTS IN THE INTERVAL AX <= X <= BX.
-* MY (INTEGER) NUMBER OF KNOTS IN THE INTERVAL AY <= Y <= BY.
-* AX (DOUBLE PRECISION) LEFT ENDPOINT OF X-INTERVAL
-* BX (DOUBLE PRECISION) RIGHT ENDPOINT OF X-INTERVAL
-* AY (DOUBLE PRECISION) LEFT ENDPOINT OF Y-INTERVAL
-* BY (DOUBLE PRECISION) RIGHT ENDPOINT OF Y-INTERVAL
-* TX (DOUBLE RECISION) ARRAY OF AT LEAST ORDER MX CONTAINING THE
-* KNOTS OVER THE X-INTERVAL, ON EXIT.
-* TY (DOUBLE RECISION) ARRAY OF AT LEAST ORDER MY CONTAINING THE
-* KNOTS OVER THE Y-INTERVAL, ON EXIT.
-* NERR (INTEGER) ERROR INDICATOR. ON EXIT:
-* = 0: NO ERROR DETECTED
-* = 1: AT LEAST ONE OF THE CONSTANTS KX, KY, MX, MY IS ILLEGAL
-*
-* USAGE:
-*
-* THE USER HAS TO PROVIDE KX, KY, MX, MY, AX, BX, AY, BY.
-* ON RETURN THE ARRAYS TX AND TY CONTAIN THE DESIRED KNOTS IN
-* ASCENDING ORDER.
-*
-* ERROR MESSAGES:
-*
-* IF ONE OF THE FOLLOWING RELATION IS SATISFIED BY THE CHOSEN INPUT-
-* PARAMETERS THE PROGRAM RETURNS, AND AN ERROR MESSAGE IS PRINTED:
-* KX < 0 OR KX > 25 OR KY < 0 OR KY > 25 OR
-* MX < 2*KX+2 OR MY < 2*KY+2 OR
-* BX <= AX OR BY <= AY .
-*
-* ********************************************************************
-
- NERR=1
- IF(KX .LT. 0 .OR. KX .GT. 25) THEN
- WRITE(ERRTXT,101) 'KX',KX
- CALL MTLPRT(NAME,'E210.1',ERRTXT)
- ELSEIF(KY .LT. 0 .OR. KY .GT. 25) THEN
- WRITE(ERRTXT,101) 'KY',KY
- CALL MTLPRT(NAME,'E210.1',ERRTXT)
- ELSEIF(MX .LT. 2*KX+2) THEN
- WRITE(ERRTXT,101) 'MX',MX
- CALL MTLPRT(NAME,'E210.2',ERRTXT)
- ELSEIF(MY .LT. 2*KY+2) THEN
- WRITE(ERRTXT,101) 'MY',MY
- CALL MTLPRT(NAME,'E210.2',ERRTXT)
- ELSEIF(BX .LE. AX) THEN
- WRITE(ERRTXT,103) 'AX',AX,'BX',BX
- CALL MTLPRT(NAME,'E210.7',ERRTXT)
- ELSEIF(BY .LE. AY) THEN
- WRITE(ERRTXT,103) 'AY',AY,'BY',BY
- CALL MTLPRT(NAME,'E210.7',ERRTXT)
- ELSE
- NERR=0
- DX=(BX-AX)/(MX-2*KX-1)
- DY=(BY-AY)/(MY-2*KY-1)
-
- CALL DVSET(KX+1,AX,TX(1),TX(2))
- CALL DVSET(KX+1,BX,TX(MX-KX),TX(MX-KX+1))
- DO 10 I = KX+2,MX-KX-1
- 10 TX(I)=AX+DX*(I-KX-1)
-
- CALL DVSET(KY+1,AY,TY(1),TY(2))
- CALL DVSET(KY+1,BY,TY(MY-KY),TY(MY-KY+1))
- DO 20 I = KY+2,MY-KY-1
- 20 TY(I)=AY+DY*(I-KY-1)
- ENDIF
-
- RETURN
-
- 101 FORMAT(1X,A5,' =',I6,' NOT IN RANGE')
- 103 FORMAT(1X,A5,' =',1PD15.8,A7,' =',1PD15.8,' INCONSISTENT')
- END
-
-
diff --git a/src/mathlib/gen/e/dspnb1.F b/src/mathlib/gen/e/dspnb1.F
deleted file mode 100644
index 0596bf7..0000000
--- a/src/mathlib/gen/e/dspnb1.F
+++ /dev/null
@@ -1,173 +0,0 @@
-*
-* $Id: dspnb1.F,v 1.1.1.1 1996/04/01 15:02:26 mclareni Exp $
-*
-* $Log: dspnb1.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:26 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- FUNCTION DSPNB1(K,M,I,NDER,X,T,NERR)
-
-#include "gen/imp64.inc"
- DIMENSION T(*),B(27),D(27)
- CHARACTER NAME*(*)
- CHARACTER*80 ERRTXT
- PARAMETER (NAME = 'DSPNB1')
-
-************************************************************************
-* NORBAS, VERSION: 15.03.1993
-************************************************************************
-*
-* DSPNB1 COMPUTES FUNCTION VALUES, VALUES OF DERIVATIVES, AND THE
-* VALUE OF INTEGRAL, RESPECTIVELY, OF NORMALIZED B-SPLINES
-* B(I,K)(X)
-* OF DEGREE K ( 0<= K <= 25 ) WITH INDEX I ( 1 <= I <= M-K-1 )
-* OVER A SET OF SPLINE-KNOTS
-* T(1),T(2), ... ,T(M) ( M >= 2*K+2 )
-* (KNOTS IN ASCENDING ORDER, WITH MULTIPLICITIES NOT GREATER
-* THAN K+1).
-*
-* THE FUNCTION VALUE OF THE NORMALIZED B-SPLINE B(I,K)(X) IS
-* IDENTICALLY ZERO OUTSIDE THE INTERVAL T(I) <= X < T(I+K+1).
-*
-* THE NORMALIZATION OF N(X) = B(I,K)(X) IS SUCH THAT THE INTGRAL OF
-* N(X) OVER THE WHOLE X-RANGE EQUALS
-* ( T(I+K+1) - T(I) ) / (K+1) .
-*
-* PARAMETERS:
-*
-* K (INTEGER) DEGREE (= ORDER - 1) OF B-SPLINES.
-* M (INTEGER) NUMBER OF KNOTS FOR THE B-SPLINES.
-* NDER (INTEGER) ON ENTRY, NDER MUST CONTAIN AN INTEGER VALUE .GE. -1
-* = -1: DSPNB1 COMPUTES THE INTEGRAL OF B(I,K)(TAU) OVER THE
-* RANGE TAU <= X.
-* = 0: DSPNB1 COMPUTES THE FUNCTION VALUE B(I,K)(X) FOR
-* FOR THE SPECIFIED VALUES OF I, K, AND X.
-* >= 1: DSPNB1 COMPUTES THE VALUE OF THE NDER-TH DERIVATIVE OF
-* B(I,K)(X) FOR THE SPECIFIED VALUES OF I, K, AND X
-* (IF NDER > K ZERO RETURNS).
-* X (DOUBLE PRECISION) ON ENTRY, X MUST CONTAIN THE VALUE OF THE
-* INDEPENDENT VARIABLE X OF B(I,K)(X)
-* T (DOUBLE PRECISION) ARRAY OF AT LEAST ORDER M CONTAINING THE
-* KNOTS, ON ENTRY.
-* I (INTEGER) INDEX OF THE B-SPLINE B(I,K)(X)
-* NERR (INTEGER) ERROR INDICATOR. ON EXIT:
-* = 0: NO ERROR DETECTED
-* = 1: AT LEAST ONE OF THE CONSTANTS K , M , I , NDER IS ILLEGAL
-*
-* USAGE:
-*
-* THE FUNCTION-CALL
-* A = DSPNB1(K,M,I,NDER,X,T,NERR)
-* RETURNS
-* - THE VALUE OF THE INTEGRAL (NDER = -1) OR
-* - THE FUNCTION VALUE (NDER = 0 ) OR
-* - THE VALUE OF THE NDER-TH DERIVATIVE (NDER > 0 )
-* OF THE NORMALIZED B-SPLINE B(I,K)(X) OF DEGREE K WITH INDEX I AT X.
-*
-* ERROR MESSAGES:
-*
-* IF ONE OF THE FOLLOWING RELATION IS SATISFIED BY THE CHOSEN INPUT-
-* PARAMETERS THE PROGRAM RETURNS, AND AN ERROR MESSAGE IS PRINTED:
-* K < 0 OR K > 25 OR
-* M < 2*K+2 OR
-* NDER < -1 OR
-* I < 1 OR I > M-K-1
-*
-************************************************************************
-
- PARAMETER (Z0 = 0 , Z1 = 1)
-
- NERR=1
- IF(K .LT. 0 .OR. K .GT. 25) THEN
- WRITE(ERRTXT,101) 'K',K
- CALL MTLPRT(NAME,'E210.1',ERRTXT)
- ELSEIF(M .LT. 2*K+2) THEN
- WRITE(ERRTXT,101) 'M',M
- CALL MTLPRT(NAME,'E210.2',ERRTXT)
- ELSEIF(I . LT. 1 .OR. I .GT. M-K-1) THEN
- WRITE(ERRTXT,101) 'I',I
- CALL MTLPRT(NAME,'E210.3',ERRTXT)
- ELSEIF(NDER .LT. -1) THEN
- WRITE(ERRTXT,101) 'NDER',NDER
- CALL MTLPRT(NAME,'E210.5',ERRTXT)
- ELSE
-
- NERR=0
- DSPNB1=Z0
- IF( X .LT. T(I)
- + .OR. X .GT. T(I+K+1) .AND. NDER .GE. 0
- + .OR. K .LT. NDER ) RETURN
-
- IF(NDER .EQ. -1) THEN
- IF(X .GE. T(I+K+1)) THEN
- R=(T(I+K+1)-T(I))/(K+1)
- ELSE
- KK=LKKSPL(X,T(I),MIN(2*(K+1),M-K-I))+I-1
- IF(K .EQ. 0) THEN
- R=X-T(KK-1)
- ELSE
- CALL DVSET(K+1,Z0,B(1),B(2))
- B(KK-I)=1/(T(KK)-T(KK-1))
- DO 10 L=1,K
- DO 10 J=MAX(1,KK-I-L),MIN(K+1-L,KK-I)
- DIF=T(I+J+L)-T(I+J-1)
- B0=Z0
- IF(DIF .NE. 0) B0=((X-T(I+J-1))*B(J)+(T(I+J+L)-X)*B(J+1))/DIF
- 10 B(J)=B0
- S=Z0
- DO 20 L=1,KK-I
- 20 S=S+(X-T(I+L-1))*B(L)
- R=S*(T(I+K+1)-T(I))/(K+1)
- ENDIF
- ENDIF
- DSPNB1=R
- RETURN
- ENDIF
-
- IF(K .EQ. 0) THEN
- R=Z1
- ELSE
- KK=LKKSPL(X,T(I),MIN(2*(K+1),M-K-I))+I-1
- I0=I+K+2-KK
- IF(I0 .EQ. 0) THEN
- R=Z0
- ELSE
- E1=X-T(KK-1)
- B(1)=Z1
- DO 30 J=2,K-NDER+1
- 30 B(J)=E1*B(J-1)/(T(KK-2+J)-T(KK-1))
- IF(KK .NE. I+1 .OR. NDER .NE. 0) THEN
- E2=T(KK)-X
- DO 40 J=1,K-NDER
- E3=X-T(KK-1-J)
- B(1)=E2*B(1)/(T(KK)-T(KK-J))
- DO 40 L=2,K-NDER+1-J
- 40 B(L)=E3*B(L-1)/(T(KK-2+L)-T(KK-1-J))+
- + (T(KK-1+L)-X)*B(L)/(T(KK-1+L)-T(KK-J))
- ENDIF
- IF(NDER .EQ. 0) THEN
- R=B(I0)
- ELSE
- CALL DVSET(K+2,Z0,D(1),D(2))
- D(I+K+2-KK)=1
- DO 50 J=1,NDER
- A=K-J+1
- DO 50 L=1,K-J+2
- DIF=T(L+KK-1)-T(L+KK-K-2+J)
- D0=Z0
- IF(DIF .NE. 0) D0=A*(D(L+1)-D(L))/DIF
- 50 D(L)=D0
- R=DVMPY(K-NDER+1,B(1),B(2),D(1),D(2))
- ENDIF
- ENDIF
- ENDIF
- DSPNB1=R
- ENDIF
- RETURN
-
- 101 FORMAT(1X,A5,' =',I6,' NOT IN RANGE')
- END
-
-
diff --git a/src/mathlib/gen/e/dspnb2.F b/src/mathlib/gen/e/dspnb2.F
deleted file mode 100644
index 5783801..0000000
--- a/src/mathlib/gen/e/dspnb2.F
+++ /dev/null
@@ -1,276 +0,0 @@
-*
-* $Id: dspnb2.F,v 1.1.1.1 1996/04/01 15:02:26 mclareni Exp $
-*
-* $Log: dspnb2.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:26 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- FUNCTION DSPNB2(KX,KY,MX,MY,I,J,NDERX,NDERY,X,Y,TX,TY,NERR)
-
-#include "gen/imp64.inc"
- DIMENSION TX(*),TY(*),B(27),D(27)
- CHARACTER NAME*(*)
- CHARACTER*80 ERRTXT
- PARAMETER (NAME = 'DSPNB2')
-
-************************************************************************
-* NORBAS, VERSION: 15.03.1993
-************************************************************************
-*
-* DSPNB2 COMPUTES FUNCTION VALUES, VALUES OF DERIVATIVES, AND THE
-* VALUE OF INTEGRAL, RESPECTIVELY, OF NORMALIZED TWO-DIMENSIONAL
-* B-SPLINES IN THE FORM OF A PRODUCT OF TWO ONE-DIMENSIONAL NORMALIZED
-* B-SPLINES
-* B(I,J)(X,Y) = BX(I,KX)(X) * BY(J,KY)(Y)
-* OF DEGREE KX AND KY ( 0 <= KX , KY <= 25 ) WITH INDICES I , J
-* ( 1 <= I <= MX-KX-1 , 1 <= J <= MY-KY-1 ) OVER TWO SETS OF SPLINE-
-* KNOTS
-* TX(1),TX(2),...,TX(MX) ( MX >= 2*KX+2 )
-* TY(1),TY(2),...,TY(MY) ( MY >= 2*KY+2 ) ,
-* RESPECTIVELY.
-* FOR FURTHER DETAILS TO THE ONE-DIMENSIONAL NORMALIZED B-SPLINES SEE
-* THE COMMENTS TO DSPNB1.
-*
-* PARAMETERS:
-*
-* KX (INTEGER) DEGREE OF ONE-DIMENSIONAL B-SPLINES IN X-DIRECTION
-* OVER THE SET OF KNOTS TX.
-* KY (INTEGER) DEGREE OF ONE-DIMENSIONAL B-SPLINES IN Y-DIRECTION
-* OVER THE SET OF KNOTS TY.
-* MX (INTEGER) NUMBER OF KNOTS FOR THE B-SPLINES IN X-DIRECTION.
-* MY (INTEGER) NUMBER OF KNOTS FOR THE B-SPLINES IN Y-DIRECTION.
-* NDERX (INTEGER) ON ENTRY, NDERX MUST CONTAIN AN INTEGER VALUE >= -1.
-* = -1: DSPNB2 COMPUTES THE INTEGRAL OF B(I,J)(TAU,Y) OVER THE
-* RANGE TAU <= X.
-* = 0: DSPNB2 COMPUTES THE FUNCTION VALUE B(I,J)(X,Y) FOR
-* FOR THE SPECIFIED VALUES OF I, J, X, AND Y.
-* >= 1: DSPNB2 COMPUTES THE VALUE OF THE NDERX-TH PARTIAL
-* DERIVATIVE OF B(I,J)(X,Y) WITH RESPECT TO X
-* FOR THE SPECIFIED VALUES OF I, J, X, AND Y.
-* (IF NDERX > KX ZERO RETURNS).
-* NDERY (INTEGER) ON ENTRY, NDERY MUST CONTAIN AN INTEGER VALUE >= -1.
-* THE MEANING OF NDERY IS THE SAME AS THAT OF THE PARAMETER
-* NDERX WITH RESPECT TO Y-DIRECTION INSTEAD OF X-DIRECTION.
-* X (DOUBLE PRECISION) ON ENTRY, X MUST CONTAIN THE VALUE OF THE
-* INDEPENDENT VARIABLE X OF B(I,J)(X,Y)
-* Y (DOUBLE PRECISION) ON ENTRY, Y MUST CONTAIN THE VALUE OF THE
-* INDEPENDENT VARIABLE Y OF B(I,J)(X,Y)
-* TX (DOUBLE PRECISION) ARRAY OF AT LEAST ORDER MX CONTAINING THE
-* KNOTS IN X-DIRECTION, ON ENTRY.
-* TY (DOUBLE PRECISION) ARRAY OF AT LEAST ORDER MY CONTAINING THE
-* KNOTS IN Y-DIRECTION, ON ENTRY.
-* I (INTEGER) INDEX OF THE B-SPLINE B(I,J)(X,Y)
-* J (INTEGER) INDEX OF THE B-SPLINE B(I,J)(X,Y)
-* NERR (INTEGER) ERROR INDICATOR. ON EXIT:
-* = 0: NO ERROR DETECTED
-* = 1: AT LEAST ONE OF THE CONSTANTS KX , KY , MX , MY , I , J ,
-* NDERX , NDERY IS ILLEGAL
-*
-* USAGE:
-*
-* THE FUNCTION-CALL
-* A = DSPNB2(KX,KY,MX,MY,I,J,NDERX,NDERY,X,Y,TX,TY,NERR)
-* RETURNS
-* - THE VALUE OF THE INTEGRAL OR
-* - THE FUNCTION VALUE OR
-* - THE VALUE OF THE NDERX-TH AND NDERY-TH PARTIAL DERIVATIVE
-* OF THE NORMALIZED B-SPLINE B(I,J)(X,Y) WITH INDICES I,J AT (X,Y).
-*
-* ERROR MESSAGES:
-*
-* IF ONE OF THE FOLLOWING RELATION IS SATISFIED BY THE CHOSEN INPUT-
-* PARAMETERS THE PROGRAM RETURNS, AND AN ERROR MESSAGE IS PRINTED:
-* KX < 0 OR KX > 25 OR KY < 0 OR KY > 25 OR
-* MX < 2*KX+2 OR MY < 2*KY+2 OR
-* NDERX < -1 OR NDERY < -1 OR
-* I < 1 OR I > MX-KX-1 OR J < 1 OR J > MY-KY-1 .
-*
-************************************************************************
-
- PARAMETER (Z0 = 0 , Z1 = 1)
-
- NERR=1
- IF(KX .LT. 0 .OR. KX .GT. 25) THEN
- WRITE(ERRTXT,101) 'KX',KX
- CALL MTLPRT(NAME,'E210.1',ERRTXT)
- ELSEIF(KY .LT. 0 .OR. KY .GT. 25) THEN
- WRITE(ERRTXT,101) 'KY',KY
- CALL MTLPRT(NAME,'E210.1',ERRTXT)
- ELSEIF(MX .LT. 2*KX+2) THEN
- WRITE(ERRTXT,101) 'MX',MX
- CALL MTLPRT(NAME,'E210.2',ERRTXT)
- ELSEIF(MY .LT. 2*KY+2) THEN
- WRITE(ERRTXT,101) 'MY',MY
- CALL MTLPRT(NAME,'E210.2',ERRTXT)
- ELSEIF(I .LT. 1 .OR. I .GT. MX-KX-1) THEN
- WRITE(ERRTXT,101) 'I',I
- CALL MTLPRT(NAME,'E210.3',ERRTXT)
- ELSEIF(J .LT. 1 .OR. J .GT. MY-KY-1) THEN
- WRITE(ERRTXT,101) 'J',J
- CALL MTLPRT(NAME,'E210.3',ERRTXT)
- ELSEIF(NDERX .LT. -1) THEN
- WRITE(ERRTXT,101) 'NDERX',NDERX
- CALL MTLPRT(NAME,'E210.5',ERRTXT)
- ELSEIF(NDERY .LT. -1) THEN
- WRITE(ERRTXT,101) 'NDERY',NDERY
- CALL MTLPRT(NAME,'E210.5',ERRTXT)
- ELSEIF(NDERX .LT. 0 .AND. NDERY .GT. 0 .OR.
- + NDERY .LT. 0 .AND. NDERX .GT. 0 ) THEN
- WRITE(ERRTXT,102) 'NDERX',NDERX,'NDERY',NDERY
- CALL MTLPRT(NAME,'E210.6',ERRTXT)
- ELSE
-
- NERR=0
- DSPNB2=Z0
-
- IF( X .LT. TX(I) .OR. Y .LT. TY(J)
- + .OR. X .GT. TX(I+KX+1) .AND. NDERX .GE. 0
- + .OR. Y .GT. TY(J+KY+1) .AND. NDERY .GE. 0
- + .OR. KX .LT. NDERX .OR. KY .LT. NDERY ) RETURN
-*
-* COMPUTING SPLNBX
-*
- IF(NDERX .EQ. -1) THEN
- IF(X .GE. TX(I+KX+1)) THEN
- SPLNBX=(TX(I+KX+1)-TX(I))/(KX+1)
- ELSE
- KK=LKKSPL(X,TX(I),MIN(2*(KX+1),MX-KX-I))+I-1
- IF(KX .EQ. 0) THEN
- SPLNBX=X-TX(KK-1)
- ELSE
- CALL DVSET(KX+1,Z0,B(1),B(2))
- B(KK-I)=1/(TX(KK)-TX(KK-1))
- DO 10 L=1,KX
- DO 10 K=MAX(1,KK-I-L),MIN(KX+1-L,KK-I)
- DIF=TX(I+K+L)-TX(I+K-1)
- B0=Z0
- IF(DIF .NE. 0)
- + B0=((X-TX(I+K-1))*B(K)+(TX(I+K+L)-X)*B(K+1))/DIF
- 10 B(K)=B0
- S=Z0
- DO 20 L=1,KK-I
- 20 S=S+(X-TX(I+L-1))*B(L)
- SPLNBX=S*(TX(I+KX+1)-TX(I))/(KX+1)
- ENDIF
- ENDIF
- GO TO 60
- ENDIF
-
- IF(KX .EQ. 0) THEN
- SPLNBX=Z1
- ELSE
- KK=LKKSPL(X,TX(I),MIN(2*(KX+1),MX-KX-I))+I-1
- I0=I+KX+2-KK
- IF(I0 .EQ. 0) THEN
- DSPNB2=Z0
- RETURN
- ELSE
- E1=X-TX(KK-1)
- B(1)=Z1
- DO 30 K=2,KX-NDERX+1
- 30 B(K)=E1*B(K-1)/(TX(KK-2+K)-TX(KK-1))
- IF(KK .NE. I+1 .OR. NDERX .NE. 0) THEN
- E2=TX(KK)-X
- DO 40 K=1,KX-NDERX
- E3=X-TX(KK-1-K)
- B(1)=E2*B(1)/(TX(KK)-TX(KK-K))
- DO 40 L=2,KX-NDERX+1-K
- 40 B(L)=E3*B(L-1)/(TX(KK-2+L)-TX(KK-1-K))+
- + (TX(KK-1+L)-X)*B(L)/(TX(KK-1+L)-TX(KK-K))
- ENDIF
- IF(NDERX .EQ. 0) THEN
- SPLNBX=B(I0)
- ELSE
- CALL DVSET(KX+2,Z0,D(1),D(2))
- D(I+KX+2-KK)=1
- DO 50 K=1,NDERX
- A=KX-K+1
- DO 50 L=1,KX-K+2
- DIF=TX(L+KK-1)-TX(L+KK-KX-2+K)
- D0=Z0
- IF(DIF .NE. 0) D0=A*(D(L+1)-D(L))/DIF
- 50 D(L)=D0
- SPLNBX=DVMPY(KX-NDERX+1,B(1),B(2),D(1),D(2))
- ENDIF
- ENDIF
- ENDIF
-*
-* COMPUTING SPLNBY
-*
- 60 IF(NDERY .EQ. -1) THEN
- IF(Y .GE. TY(J+KY+1)) THEN
- SPLNBY=(TY(J+KY+1)-TY(J))/(KY+1)
- ELSE
- KK=LKKSPL(Y,TY(J),MIN(2*(KY+1),MY-KY-J))+J-1
- IF(KY .EQ. 0) THEN
- SPLNBY=Y-TY(KK-1)
- ELSE
- CALL DVSET(KY+1,Z0,B(1),B(2))
- B(KK-J)=1/(TY(KK)-TY(KK-1))
- DO 70 L=1,KY
- DO 70 K=MAX(1,KK-J-L),MIN(KY+1-L,KK-J)
- DIF=TY(J+K+L)-TY(J+K-1)
- B0=Z0
- IF(DIF .NE. 0)
- + B0=((Y-TY(J+K-1))*B(K)+(TY(J+K+L)-Y)*B(K+1))/DIF
- 70 B(K)=B0
- S=Z0
- DO 80 L=1,KK-J
- 80 S=S+(Y-TY(J+L-1))*B(L)
- SPLNBY=S*(TY(J+KY+1)-TY(J))/(KY+1)
- ENDIF
- ENDIF
- GO TO 120
- ENDIF
-
- IF(KY .EQ. 0) THEN
- SPLNBY=Z1
- ELSE
- KK=LKKSPL(Y,TY(J),MIN(2*(KY+1),MY-KY-J))+J-1
- I0=J+KY+2-KK
- IF(I0 .EQ. 0) THEN
- DSPNB2=Z0
- RETURN
- ELSE
- E1=Y-TY(KK-1)
- B(1)=Z1
- DO 90 K=2,KY-NDERY+1
- 90 B(K)=E1*B(K-1)/(TY(KK-2+K)-TY(KK-1))
- IF(KK .NE. J+1 .OR. NDERY .NE. 0) THEN
- E2=TY(KK)-Y
- DO 100 K=1,KY-NDERY
- E3=Y-TY(KK-1-K)
- B(1)=E2*B(1)/(TY(KK)-TY(KK-K))
- DO 100 L=2,KY-NDERY+1-K
- 100 B(L)=E3*B(L-1)/(TY(KK-2+L)-TY(KK-1-K))+
- + (TY(KK-1+L)-Y)*B(L)/(TY(KK-1+L)-TY(KK-K))
- ENDIF
- IF(NDERY .EQ. 0) THEN
- SPLNBY=B(I0)
- ELSE
- CALL DVSET(KY+2,Z0,D(1),D(2))
- D(J+KY+2-KK)=1
- DO 110 K=1,NDERY
- A=KY-K+1
- DO 110 L=1,KY-K+2
- DIF=TY(L+KK-1)-TY(L+KK-KY-2+K)
- D0=Z0
- IF(DIF .NE. 0) D0=A*(D(L+1)-D(L))/DIF
- 110 D(L)=D0
- SPLNBY=DVMPY(KY-NDERY+1,B(1),B(2),D(1),D(2))
- ENDIF
- ENDIF
- ENDIF
-
- 120 DSPNB2=SPLNBX*SPLNBY
-
- ENDIF
- RETURN
-
- 101 FORMAT(1X,A5,' =',I6,' NOT IN RANGE')
- 102 FORMAT(1X,A5,' =',I6,A7,' =',I6,' INCONSISTENT')
- END
-
-
diff --git a/src/mathlib/gen/e/dspps1.F b/src/mathlib/gen/e/dspps1.F
deleted file mode 100644
index ff47a18..0000000
--- a/src/mathlib/gen/e/dspps1.F
+++ /dev/null
@@ -1,177 +0,0 @@
-*
-* $Id: dspps1.F,v 1.1.1.1 1996/04/01 15:02:26 mclareni Exp $
-*
-* $Log: dspps1.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:26 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- FUNCTION DSPPS1(K,M,NDER,X,T,C,NERR)
-
-#include "gen/imp64.inc"
- DIMENSION T(*),C(*),B(27)
- CHARACTER NAME*(*)
- CHARACTER*80 ERRTXT
- PARAMETER (NAME = 'DSPPS1')
-
-************************************************************************
-* NORBAS, VERSION: 15.03.1993
-************************************************************************
-*
-* DSPPS1 COMPUTES FUNCTION VALUES, VALUES OF DERIVATIVES, AND THE
-* VALUE OF INTEGRAL, RESPECTIVELY, OF A POLYNOMIAL SPLINE S(X) IN
-* B-SPLINE REPRESENTATION
-*
-* S(X) = SUMME(I=1,...,M-K-1) C(I) * B(I,K)(X) .
-*
-* THE FUNCTIONS B(I,K)(X) ARE NORMALIZED B-SPLINES OF DEGREE K
-* (0<= K <= 25) WITH INDEX I (1 <= I <= M-K-1) OVER A SET OF
-* SPLINE-KNOTS
-* T(1),T(2), ... ,T(M) ( M >= 2*K+2 )
-* (KNOTS IN ASCENDING ORDER, WITH MULTIPLICITIES NOT GREATER
-* THAN K+1).
-*
-* THE FUNCTION VALUE OF THE NORMALIZED B-SPLINE B(I,K)(X) IS
-* IDENTICALLY ZERO OUTSIDE THE INTERVAL T(I) <= X < T(I+K+1).
-*
-* THE NORMALIZATION OF N(X) = B(I,K)(X) IS SUCH THAT THE INTGRAL OF
-* N(X) OVER THE WHOLE X-RANGE EQUALS
-* ( T(I+K+1) - T(I) ) / (K+1) .
-*
-* C(1),...,C(M-K-NDER-1) MUST CONTAIN THE COEFFICIENTS OF THE
-* POLYNOMIAL SPLINE S(X) OR ITS DERIVATIVE, REPRESENTED BY
-* NORMALIZED B-SPLINES OF DEGREE K-NDER .
-*
-* FOR TRANSFORMATION THE COEFFICIENTS OF THE POLYNOMIAL SPLINE S(X)
-* TO THE CORRESPONDING COEFFICIENTS OF THE NDER-TH DERIVATIVE OF
-* S(X) THE ROUTINE DSPCD1 MAY BE USED.
-*
-* ESPECIALLY FOR COMPUTING THE COEFFICIENTS C(1),...,C(M-K-1) OF
-* THE POLYNOMIAL VARIATION DIMINISHING SPLINE APPROXIMATION OF A USER
-* SUPPLIED FUNCTION F(X) THE ROUTINE DSPVD1 MAY BE USED.
-*
-* PARAMETERS:
-*
-* K (INTEGER) DEGREE (= ORDER - 1) OF B-SPLINES.
-* M (INTEGER) NUMBER OF KNOTS FOR THE B-SPLINES.
-* NDER (INTEGER) ON ENTRY, NDER MUST CONTAIN AN INTEGER VALUE .GE. -1
-* = -1: DSPPS1 COMPUTES THE INTEGRAL OF S(TAU) OVER THE
-* RANGE TAU <= X.
-* = 0: DSPPS1 COMPUTES THE FUNCTION VALUE OF THE POLYNOMIAL
-* SPLINE S(X) AT X.
-* >= 1: DSPPS1 COMPUTES THE VALUE OF THE NDER-TH DERIVATIVE OF
-* S(X) AT X (IF NDER > K ZERO RETURNS).
-* X (DOUBLE PRECISION) ON ENTRY, X MUST CONTAIN THE VALUE OF THE
-* INDEPENDENT VARIABLE X OF S(X).
-* T (DOUBLE PRECISION) ARRAY OF AT LEAST ORDER M CONTAINING THE
-* KNOTS, ON ENTRY.
-* C (DOUBLE PRECISION) ARRAY OF AT LEAST ORDER M-K-NDER-1,
-* ON ENTRY C(J) CONTAINS THE J-TH COEFFICIENT OF THE B-SPLINE
-* REPRESENTATION OF S(X) OR OF ITS DERIVATIVE.
-* NERR (INTEGER) ERROR INDICATOR. ON EXIT:
-* = 0: NO ERROR DETECTED
-* = 1: AT LEAST ONE OF THE CONSTANTS K , M , NDER IS ILLEGAL
-*
-* USAGE:
-*
-* THE FUNCTION-CALL
-* Y = DSPPS1(K,M,NDER,X,T,C,NERR)
-* RETURNS
-* - THE VALUE OF THE INTEGRAL (NDER = -1) OR
-* - THE FUNCTION VALUE (NDER = 0 ) OR
-* - THE VALUE OF THE NDER-TH DERIVATIVE (NDER > 0 )
-* OF THE POLYNOMIAL SPLINE (IN B-SPLINE REPRESENTATION)
-* S(X) = SUMME(I=1,...,M-K-1) C(I)*B(I,K)(X)
-* OF DEGREE K WITH THE SET OF KNOTS T(1),...,T(M) AT X.
-*
-* ERROR MESSAGES:
-*
-* IF ONE OF THE FOLLOWING RELATION IS SATISFIED BY THE CHOSEN INPUT-
-* PARAMETERS THE PROGRAM RETURNS, AND AN ERROR MESSAGE IS PRINTED:
-* K < 0 OR K > 25 OR
-* M < 2*K+2 OR
-* NDER < -1 .
-*
-************************************************************************
-
- PARAMETER (Z0 = 0 , Z1 = 1)
-
- NERR=1
- IF(K .LT. 0 .OR. K .GT. 25) THEN
- WRITE(ERRTXT,101) 'K',K
- CALL MTLPRT(NAME,'E210.1',ERRTXT)
- ELSEIF(M .LT. 2*K+2) THEN
- WRITE(ERRTXT,101) 'M',M
- CALL MTLPRT(NAME,'E210.2',ERRTXT)
- ELSEIF(NDER .LT. -1) THEN
- WRITE(ERRTXT,101) 'NDER',NDER
- CALL MTLPRT(NAME,'E210.5',ERRTXT)
- ELSE
-
- NERR=0
- DSPPS1=Z0
- IF( X .LT. T(K+1)
- + .OR. X .GT. T(M-K) .AND. NDER .GE. 0
- + .OR. K .LT. NDER ) RETURN
-
- IF(NDER .EQ. -1) THEN
- IF(X .GE. T(M-K)) THEN
- R=0
- DO 10 I=1,M-K-1
- 10 R=R+C(I)*(T(I+K+1)-T(I))
- R=R/(K+1)
- ELSE
- KK=LKKSPL(X,T(K+1),M-2*K-1)+K
- R=0
- DO 20 I=1,KK-K-2
- 20 R=R+C(I)*(T(I+K+1)-T(I))
- R=R/(K+1)
- IF(K .EQ. 0) THEN
- K1=MAX(1,KK-1)
- R=R+(X-T(K1))*C(K1)
- ELSE
- DO 50 I=MAX(1,KK-K-1),KK-1
- CALL DVSET(K+1,Z0,B(1),B(2))
- B(KK-I)=1/(T(KK)-T(KK-1))
-
- DO 30 L=1,K
- DO 30 J=MAX(1,KK-I-L),MIN(K+1-L,KK-I)
- DIF=T(I+J+L)-T(I+J-1)
- B0=Z0
- IF(DIF .NE. 0) B0=((X-T(I+J-1))*B(J)+(T(I+J+L)-X)*B(J+1))/DIF
- 30 B(J)=B0
- S=Z0
- DO 40 L=1,KK-I
- 40 S=S+(X-T(I+L-1))*B(L)
- S=S*(T(I+K+1)-T(I))/(K+1)
- 50 R=R+C(I)*S
- ENDIF
- ENDIF
- ELSE
-
- KK=LKKSPL(X,T(K+1),M-2*K-1)+K
- E1=X-T(KK-1)
- B(1)=Z1
- DO 60 J=2,K-NDER+1
- 60 B(J)=E1*B(J-1)/(T(KK-2+J)-T(KK-1))
- IF(KK .NE. 0 .OR. NDER .NE. 0) THEN
- E2=T(KK)-X
- DO 70 J=1,K-NDER
- E3=X-T(KK-1-J)
- B(1)=E2*B(1)/(T(KK)-T(KK-J))
- DO 70 L=2,K-NDER+1-J
- 70 B(L)=E3*B(L-1)/(T(KK-2+L)-T(KK-1-J))+
- + (T(KK-1+L)-X)*B(L)/(T(KK-1+L)-T(KK-J))
- ENDIF
- R=DVMPY(K-NDER+1,C(KK-1-K),C(KK-K),B(1),B(2))
- ENDIF
- DSPPS1=R
- ENDIF
- RETURN
-
- 101 FORMAT(1X,A5,' =',I6,' NOT IN RANGE')
- END
-
-
-
diff --git a/src/mathlib/gen/e/dspps2.F b/src/mathlib/gen/e/dspps2.F
deleted file mode 100644
index 84ccde2..0000000
--- a/src/mathlib/gen/e/dspps2.F
+++ /dev/null
@@ -1,258 +0,0 @@
-*
-* $Id: dspps2.F,v 1.1.1.1 1996/04/01 15:02:26 mclareni Exp $
-*
-* $Log: dspps2.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:26 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- FUNCTION DSPPS2(KX,KY,MX,MY,NDERX,NDERY,X,Y,TX,TY,C,NDIMC,W,NERR)
-
-#include "gen/imp64.inc"
- DIMENSION TX(*),TY(*),C(NDIMC,*),W(*),BX(27),BY(27)
- CHARACTER NAME*(*)
- CHARACTER*80 ERRTXT
- PARAMETER (NAME = 'DSPPS2')
-
-************************************************************************
-* NORBAS, VERSION: 15.03.1993
-************************************************************************
-*
-* DSPPS2 COMPUTES FUNCTION VALUES, VALUES OF DERIVATIVES, AND THE
-* VALUE OF INTEGRAL, RESPECTIVELY, OF A TWO-DIMENSIONAL POLYNOMIAL
-* SPLINE S(X,Y) IN REPRESENTATION OF NORMALIZED TWO-DIMENSIONAL
-* B-SPLINES B(I,J)(X,Y)
-*
-* S(X,Y) = SUMME(I=1,...,MX-KX-1)
-* SUMME(J=1,...,MY-KY-1) C(I,J) * B(I,J)(X,Y) .
-*
-* THE TWO-DIMENSIONAL B-SPLINES B(I,J)(X,Y) ARE THE PRODUCT OF TWO
-* ONE-DIMENSIONAL B-SPLINES BX , BY
-* B(I,J)(X,Y) = BX(I,KX)(X) * BY(J,KY)(Y)
-* OF DEGREE KX AND KY ( 0 <= KX , KY <= 25 ) WITH INDICES I , J
-* ( 1 <= I <= MX-KX-1 , 1 <= J <= MY-KY-1 ) OVER TWO SETS OF SPLINE-
-* KNOTS
-* TX(1),TX(2),...,TX(MX) ( MX >= 2*KX+2 )
-* TY(1),TY(2),...,TY(MY) ( MY >= 2*KY+2 ) ,
-* RESPECTIVELY.
-* FOR FURTHER DETAILS TO THE ONE-DIMENSIONAL NORMALIZED B-SPLINES SEE
-* THE COMMENTS TO DSPNB1.
-*
-* C(I,J) (I=1,...,MX-KX-NDERX-1 , J=1,...,MY-KY-NDERY-1) MUST CONTAIN
-* THE (I,J)-TH C COEFFICIENT OF THE POLYNOMIAL SPLINE S(X,Y) OR
-* OF ONE OF ITS PARTIAL DERIVATIVE, REPRESENTED BY NORMALIZED
-* TWO-DIMENSIONAL B-SPLINES OF DEGREE (KX-NDERX) AND (KY-NDERY),
-* RESPECTIVELY.
-*
-* FOR TRANSFORMATION THE COEFFICIENTS OF THE POLYNOMIAL SPLINE S(X,Y)
-* TO THE CORRESPONDING COEFFICIENTS OF THE NDERX-TH AND NDERY-TH
-* PARTIAL DERIVATIVE OF S(X,Y) THE ROUTINE DSPCD2 MAY BE USED.
-*
-* ESPECIALLY FOR COMPUTING THE COEFFICIENTS C(I,J) OF THE TWO-
-* DIMENSIONAL POLYNOMIAL VARIATION DIMINISHING SPLINE APPREOXIMATION
-* OF A USER SUPPLIED FUNCTION Z = F(X,Y) THE ROUTINE DSPVD2 MAY BE
-* USED.
-*
-* PARAMETERS:
-*
-* KX (INTEGER) DEGREE OF ONE-DIMENSIONAL B-SPLINES IN X-DIRECTION
-* OVER THE SET OF KNOTS TX.
-* KY (INTEGER) DEGREE OF ONE-DIMENSIONAL B-SPLINES IN Y-DIRECTION
-* OVER THE SET OF KNOTS TY.
-* MX (INTEGER) NUMBER OF KNOTS FOR THE B-SPLINES IN X-DIRECTION.
-* MY (INTEGER) NUMBER OF KNOTS FOR THE B-SPLINES IN Y-DIRECTION.
-* NDERX (INTEGER) ON ENTRY, NDERX MUST CONTAIN AN INTEGER VALUE >= -1.
-* = -1: DSPPS2 COMPUTES THE INTEGRAL OF S(TAU,Y) OVER THE
-* RANGE TAU <= X.
-* = 0: DSPPS2 COMPUTES THE FUNCTION VALUE S(X,Y) FOR
-* FOR THE SPECIFIED VALUES OF X,Y.
-* >= 1: DSPNB2 COMPUTES THE VALUE OF THE NDERX-TH PARTIAL
-* DERIVATIVE OF S(X,Y) WITH RESPECT TO X
-* FOR THE SPECIFIED VALUES OF X,Y.
-* (IF NDERX > KX ZERO RETURNS).
-* NDERY (INTEGER) ON ENTRY, NDERY MUST CONTAIN AN INTEGER VALUE >= -1.
-* THE MEANING OF NDERY IS THE SAME AS THAT OF THE PARAMETER
-* NDERX WITH RESPECT TO Y-DIRECTION INSTEAD OF X-DIRECTION.
-* NDIMC (INTEGER) DECLARED FIRST DIMENSION OF ARRAY C IN THE
-* CALLING PROGRAM, WITH NDIMC >= MX-KX-NDERX-1 .
-* X (DOUBLE PRECISION) ON ENTRY, X MUST CONTAIN THE VALUE OF THE
-* INDEPENDENT VARIABLE X OF S(X,Y)
-* Y (DOUBLE PRECISION) ON ENTRY, Y MUST CONTAIN THE VALUE OF THE
-* INDEPENDENT VARIABLE Y OF S(X,Y)
-* TX (DOUBLE PRECISION) ARRAY OF AT LEAST ORDER MX CONTAINING THE
-* KNOTS IN X-DIRECTION, ON ENTRY.
-* TY (DOUBLE PRECISION) ARRAY OF AT LEAST ORDER MY CONTAINING THE
-* KNOTS IN Y-DIRECTION, ON ENTRY.
-* C (DOUBLE PRECISION) ARRAY OF ORDER (NDIMC, >= MY-KY-NDERY-1),
-* CONTAINING THE COEFFICIENTS OF THE TWO-DIMENSIONAL B-SPLINE
-* REPRESENTATION OF S(X,Y) , ON ENTRY.
-* W (DOUBLE PRECISION) WORKING ARRAY OF AT LEAST ORDER MY-KY-1.
-* NERR (INTEGER) ERROR INDICATOR. ON EXIT:
-* = 0: NO ERROR DETECTED
-* = 1: AT LEAST ONE OF THE CONSTANTS KX , KY , MX , MY ,
-* NDERX , NDERY IS ILLEGAL
-*
-* USAGE:
-*
-* THE FUNCTION-CALL
-* Z = DSPPS2(KX,KY,MX,MY,NDERX,NDERY,X,Y,TX,TY,C,NDIMC,W,NERR)
-* RETURNS
-* - THE VALUE OF THE INTEGRAL (NDERX =-1 .AND. NDERY =-1) OR
-* - THE FUNCTION VALUE (NDERX = 0 .AND. NDERY = 0) OR
-* - THE VALUE OF THE NDERX-TH AND NDERY-TH PARTIAL DERIVATIVE
-* (NDERX >= 0 .AND. NDERY >= 0 .AND. NDERX + NDERY > 0)
-* OF THE POLYNOMIAL SPLINE S(X,Y) AT (X,Y).
-*
-* ERROR MESSAGES:
-*
-* IF ONE OF THE FOLLOWING RELATION IS SATISFIED BY THE CHOSEN INPUT-
-* PARAMETERS THE PROGRAM RETURNS, AND AN ERROR MESSAGE IS PRINTED:
-* KX < 0 OR KX > 25 OR KY < 0 OR KY > 25 OR
-* MX < 2*KX+2 OR MY < 2*KY+2 OR
-* NDERX < -1 OR NDERY < -1 .
-*
-************************************************************************
-
- PARAMETER (Z0 = 0 , Z1 = 1)
-
- NERR=1
- IF(KX .LT. 0 .OR. KX .GT. 25) THEN
- WRITE(ERRTXT,101) 'KX',KX
- CALL MTLPRT(NAME,'E210.1',ERRTXT)
- ELSEIF(KY .LT. 0 .OR. KY .GT. 25) THEN
- WRITE(ERRTXT,101) 'KY',KY
- CALL MTLPRT(NAME,'E210.1',ERRTXT)
- ELSEIF(MX .LT. 2*KX+2) THEN
- WRITE(ERRTXT,101) 'MX',MX
- CALL MTLPRT(NAME,'E210.2',ERRTXT)
- ELSEIF(MY .LT. 2*KY+2) THEN
- WRITE(ERRTXT,101) 'MY',MY
- CALL MTLPRT(NAME,'E210.2',ERRTXT)
- ELSEIF(NDERX .LT. -1) THEN
- WRITE(ERRTXT,101) 'NDERX',NDERX
- CALL MTLPRT(NAME,'E210.5',ERRTXT)
- ELSEIF(NDERY .LT. -1) THEN
- WRITE(ERRTXT,101) 'NDERY',NDERY
- CALL MTLPRT(NAME,'E210.5',ERRTXT)
- ELSEIF(NDERX .EQ. -1 .AND. NDERY .NE. -1 .OR.
- + NDERX .NE. -1 .AND. NDERY .EQ. -1 ) THEN
- WRITE(ERRTXT,102) 'NDERX',NDERX,'NDERY',NDERY
- CALL MTLPRT(NAME,'E210.6',ERRTXT)
- ELSE
-
- NERR=0
- IF(NDERX .EQ. -1 .AND. NDERY .EQ. -1) THEN
- DO 60 JJ=1,MY-KY-1
- IF(X .GE. TX(MX-KX)) THEN
- R=Z0
- DO 10 I=1,MX-KX-1
- 10 R=R+C(I,JJ)*(TX(I+KX+1)-TX(I))
- R=R/(KX+1)
- ELSE
- KK=LKKSPL(X,TX(KX+1),MX-2*KX-1)+KX
- R=Z0
- DO 20 I=1,KK-KX-2
- 20 R=R+C(I,JJ)*(TX(I+KX+1)-TX(I))
- R=R/(KX+1)
- IF(KX .EQ. 0) THEN
- K1=MAX(1,KK-1)
- R=R+(X-TX(K1))*C(K1,JJ)
- ELSE
- DO 50 I=MAX(1,KK-KX-1),KK-1
- CALL DVSET(KX+1,Z0,BX(1),BX(2))
- BX(KK-I)=1/(TX(KK)-TX(KK-1))
- DO 30 L=1,KX
- DO 30 J=MAX(1,KK-I-L),MIN(KX+1-L,KK-I)
- DIF=TX(I+J+L)-TX(I+J-1)
- B0=Z0
- IF(DIF .NE. 0)
- + B0=((X-TX(I+J-1))*BX(J)+(TX(I+J+L)-X)*BX(J+1))/DIF
- 30 BX(J)=B0
- S=Z0
- DO 40 L=1,KK-I
- 40 S=S+(X-TX(I+L-1))*BX(L)
- S=S*(TX(I+KX+1)-TX(I))/(KX+1)
- 50 R=R+C(I,JJ)*S
- ENDIF
- ENDIF
- 60 W(JJ)=R
- IF(Y .GE. TY(MY-KY)) THEN
- R=Z0
- DO 70 I=1,MY-KY-1
- 70 R=R+W(I)*(TY(I+KY+1)-TY(I))
- R=R/(KY+1)
- ELSE
- KK=LKKSPL(Y,TY(KY+1),MY-2*KY-1)+KY
- R=Z0
- DO 80 I=1,KK-KY-2
- 80 R=R+W(I)*(TY(I+KY+1)-TY(I))
- R=R/(KY+1)
- IF(KY .EQ. 0) THEN
- K1=MAX(1,KK-1)
- R=R+(Y-TY(K1))*W(K1)
- ELSE
- DO 110 I=MAX(1,KK-KY-1),KK-1
- CALL DVSET(KY+1,Z0,BY(1),BY(2))
- BY(KK-I)=1/(TY(KK)-TY(KK-1))
- DO 90 L=1,KY
- DO 90 J=MAX(1,KK-I-L),MIN(KY+1-L,KK-I)
- DIF=TY(I+J+L)-TY(I+J-1)
- B0=Z0
- IF(DIF .NE. 0)
- + B0=((Y-TY(I+J-1))*BY(J)+(TY(I+J+L)-Y)*BY(J+1))/DIF
- 90 BY(J)=B0
- S=Z0
- DO 100 L=1,KK-I
- 100 S=S+(Y-TY(I+L-1))*BY(L)
- S=S*(TY(I+KY+1)-TY(I))/(KY+1)
- 110 R=R+W(I)*S
- ENDIF
- ENDIF
- DSPPS2=R
- RETURN
- ENDIF
-
- DSPPS2=Z0
- IF(X .LT. TX(KX+1) .OR. X .GT. TX(MX-KX) .OR.
- + Y .LT. TY(KY+1) .OR. Y .GT. TY(MY-KY) .OR.
- + KX .LT. NDERX .OR. KY .LT. NDERY ) RETURN
-
- KKX=LKKSPL(X,TX(KX+1),MX-2*KX-1)+KX
- KKY=LKKSPL(Y,TY(KY+1),MY-2*KY-1)+KY
- E1=X-TX(KKX-1)
- BX(1)=Z1
- DO 120 J=2,KX-NDERX+1
- 120 BX(J)=E1*BX(J-1)/(TX(KKX-2+J)-TX(KKX-1))
- E2=TX(KKX)-X
- DO 130 J=1,KX-NDERX
- E3=X-TX(KKX-1-J)
- BX(1)=E2*BX(1)/(TX(KKX)-TX(KKX-J))
- DO 130 L=2,KX-NDERX+1-J
- 130 BX(L)=E3*BX(L-1)/(TX(KKX-2+L)-TX(KKX-1-J))+
- + (TX(KKX-1+L)-X)*BX(L)/(TX(KKX-1+L)-TX(KKX-J))
- E1=Y-TY(KKY-1)
- BY(1)=Z1
- DO 140 J=2,KY-NDERY+1
- 140 BY(J)=E1*BY(J-1)/(TY(KKY-2+J)-TY(KKY-1))
- E2=TY(KKY)-Y
- DO 150 J=1,KY-NDERY
- E3=Y-TY(KKY-1-J)
- BY(1)=E2*BY(1)/(TY(KKY)-TY(KKY-J))
- DO 150 L=2,KY-NDERY+1-J
- 150 BY(L)=E3*BY(L-1)/(TY(KKY-2+L)-TY(KKY-1-J))+
- + (TY(KKY-1+L)-Y)*BY(L)/(TY(KKY-1+L)-TY(KKY-J))
- R=Z0
- DO 160 I=1,KX-NDERX+1
- DO 160 J=1,KY-NDERY+1
- 160 R=R+C(KKX-2-KX+I,KKY-2-KY+J)*BX(I)*BY(J)
- DSPPS2=R
- ENDIF
- RETURN
-
- 101 FORMAT(1X,A5,' =',I6,' NOT IN RANGE')
- 102 FORMAT(1X,A5,' =',I6,A7,' =',I6,' INCONSISTENT')
- END
-
-
-
diff --git a/src/mathlib/gen/e/dspvd1.F b/src/mathlib/gen/e/dspvd1.F
deleted file mode 100644
index 3f858f1..0000000
--- a/src/mathlib/gen/e/dspvd1.F
+++ /dev/null
@@ -1,88 +0,0 @@
-*
-* $Id: dspvd1.F,v 1.1.1.1 1996/04/01 15:02:26 mclareni Exp $
-*
-* $Log: dspvd1.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:26 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE DSPVD1(F,K,M,T,C,NERR)
-
-#include "gen/imp64.inc"
- DIMENSION T(*),C(*)
- CHARACTER NAME*(*)
- CHARACTER*80 ERRTXT
- PARAMETER (NAME = 'DSPVD1')
-
-************************************************************************
-* NORBAS, VERSION: 15.03.1993
-************************************************************************
-*
-* DSPVD1 COMPUTES THE COEFFICIENTS C(1),...,C(M-K-1) OF A POLYNOMIAL
-* VARIATION DIMINISHING SPLINE APPROXIMATION S(X) IN B-SPLINE
-* REPRESENTATION
-*
-* S(X) = SUMME(I=1,...,M-K-1) C(I) * B(I,K)(X)
-*
-* TO A USER SUPPLIED FUNCTION Y=F(X).
-*
-* THE FUNCTIONS B(I,K)(X) ARE NORMALIZED B-SPLINES OF DEGREE K
-* (0<= K <= 25) WITH INDEX I (1 <= I <= M-K-1) OVER A SET OF
-* SPLINE-KNOTS
-* T(1),T(2), ... ,T(M) ( M >= 2*K+2 )
-* (KNOTS IN ASCENDING ORDER, WITH MULTIPLICITIES NOT GREATER
-* THAN K+1).
-* THE FUNCTION VALUE OF THE NORMALIZED B-SPLINE B(I,K)(X) IS
-* IDENTICALLY ZERO OUTSIDE THE INTERVAL T(I) <= X < T(I+K+1).
-* THE NORMALIZATION OF N(X) = B(I,K)(X) IS SUCH THAT THE INTGRAL OF
-* N(X) OVER THE WHOLE X-RANGE EQUALS
-* ( T(I+K+1) - T(I) ) / (K+1) .
-*
-* PARAMETERS:
-*
-* F (DOUBLE PRECISION) USER SUPPLIED FUNCTION F(X) FOR WHICH
-* THE CORRESPONDING SPLINE APPROXIMATION HAS TO BE COMPUTED.
-* K (INTEGER) DEGREE (= ORDER - 1) OF B-SPLINES.
-* M (INTEGER) NUMBER OF KNOTS FOR THE B-SPLINES.
-* T (DOUBLE PRECISION) ARRAY OF AT LEAST ORDER M CONTAINING THE
-* KNOTS, ON ENTRY.
-* C (DOUBLE PRECISION) ARRAY OF AT LEAST ORDER M-K-1. ON EXIT
-* C(1),...,C(M-K-1) CONTAIN THE COEFFICIENTS OF THE B-SPLINE
-* REPRESENTATION OF S(X).
-* NERR (INTEGER) ERROR INDICATOR. ON EXIT:
-* = 0: NO ERROR DETECTED
-* = 1: AT LEAST ONE OF THE CONSTANTS K , M IS ILLEGAL
-*
-* ERROR MESSAGES:
-*
-* IF ONE OF THE FOLLOWING RELATION IS SATISFIED BY THE CHOSEN INPUT-
-* PARAMETERS THE PROGRAM RETURNS, AND AN ERROR MESSAGE IS PRINTED:
-* K < 1 OR K > 25 OR
-* M < 2*K+2 .
-*
-************************************************************************
-
- PARAMETER (Z1 = 1)
-
- NERR=1
- IF(K .LT. 1 .OR. K .GT. 25) THEN
- WRITE(ERRTXT,101) 'K',K
- CALL MTLPRT(NAME,'E210.1',ERRTXT)
- ELSEIF(M .LT. 2*K+2) THEN
- WRITE(ERRTXT,101) 'M',M
- CALL MTLPRT(NAME,'E210.2',ERRTXT)
- ELSE
- NERR=0
- R=Z1/K
- DO 10 I = 1,M-K-1
- 10 C(I)=F(R*DVSUM(K,T(I+1),T(I+2)))
- ENDIF
-
- RETURN
-
- 101 FORMAT(1X,A5,' =',I6,' NOT IN RANGE')
- END
-
-
-
diff --git a/src/mathlib/gen/e/dspvd2.F b/src/mathlib/gen/e/dspvd2.F
deleted file mode 100644
index 377a800..0000000
--- a/src/mathlib/gen/e/dspvd2.F
+++ /dev/null
@@ -1,107 +0,0 @@
-*
-* $Id: dspvd2.F,v 1.1.1.1 1996/04/01 15:02:26 mclareni Exp $
-*
-* $Log: dspvd2.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:26 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE DSPVD2(F,KX,KY,MX,MY,TX,TY,C,NDIMC,NERR)
-
-#include "gen/imp64.inc"
- DIMENSION TX(*),TY(*),C(NDIMC,*)
- CHARACTER NAME*(*)
- CHARACTER*80 ERRTXT
- PARAMETER (NAME = 'DSPVD2')
-
-************************************************************************
-* NORBAS, VERSION: 15.03.1993
-************************************************************************
-*
-* DSPVD2 COMPUTES THE COEFFICIENTS
-* C(I,J) (I=1,...,MX-KX-1 , J=1,...,MY-KY-1)
-* OF A TWO-DIMENSIONAL POLYNOMIAL VARIATION DIMINISHING SPLINE
-* APPROXIMATION S(X,Y) IN REPRESENTATION OF NORMALIZED TWO-DIMENSIONAL
-* B-SPLINES B(I,J)(X,Y)
-*
-* S(X,Y) = SUMME(I=1,...,MX-KX-1)
-* SUMME(J=1,...,MY-KY-1) C(I,J) * B(I,J)(X,Y) .
-*
-* THE TWO-DIMENSIONAL B-SPLINES B(I,J)(X,Y) ARE THE PRODUCT OF TWO
-* ONE-DIMENSIONAL B-SPLINES BX , BY
-* B(I,J)(X,Y) = BX(I,KX)(X) * BY(J,KY)(Y)
-* OF DEGREE KX AND KY ( 0 <= KX , KY <= 25 ) WITH INDICES I , J
-* ( 1 <= I <= MX-KX-1 , 1 <= J <= MY-KY-1 ) OVER TWO SETS OF SPLINE-
-* KNOTS
-* TX(1),TX(2),...,TX(MX) ( MX >= 2*KX+2 )
-* TY(1),TY(2),...,TY(MY) ( MY >= 2*KY+2 ) ,
-* RESPECTIVELY.
-* FOR FURTHER DETAILS TO THE ONE-DIMENSIONAL NORMALIZED B-SPLINES SEE
-* THE COMMENTS TO DSPNB1.
-*
-* PARAMETERS:
-*
-* F (DOUBLE PRECISION) USER SUPPLIED FUNCTION Z=F(X,Y) FOR WHICH
-* THE CORRESPONDING SPLINE APPROXIMATION HAS TO BE COMPUTED.
-* KX (INTEGER) DEGREE OF ONE-DIMENSIONAL B-SPLINES IN X-DIRECTION
-* OVER THE SET OF KNOTS TX.
-* KY (INTEGER) DEGREE OF ONE-DIMENSIONAL B-SPLINES IN Y-DIRECTION
-* OVER THE SET OF KNOTS TY.
-* MX (INTEGER) NUMBER OF KNOTS FOR THE B-SPLINES IN X-DIRECTION.
-* MY (INTEGER) NUMBER OF KNOTS FOR THE B-SPLINES IN Y-DIRECTION.
-* NDIMC (INTEGER) DECLARED FIRST DIMENSION OF ARRAY C IN THE
-* CALLING PROGRAM, WITH NDIMC >= MX-KX-1 .
-* TX (DOUBLE PRECISION) ARRAY OF AT LEAST ORDER MX CONTAINING THE
-* KNOTS IN X-DIRECTION, ON ENTRY.
-* TY (DOUBLE PRECISION) ARRAY OF AT LEAST ORDER MY CONTAINING THE
-* KNOTS IN Y-DIRECTION, ON ENTRY.
-* C (DOUBLE PRECISION) ARRAY OF ORDER (NDIMC, >= MY-KY-1).
-* ON EXIT C(I,J) CONTAINS THE (I,J)-TH COEFFICIENT OF THE
-* TWO-DIMENSIONAL B-SPLINE REPRESENTATION OF S(X,Y) .
-* NERR (INTEGER) ERROR INDICATOR. ON EXIT:
-* = 0: NO ERROR DETECTED
-* = 1: AT LEAST ONE OF THE CONSTANTS KX, KY, MX, MY IS ILLEGAL
-*
-* ERROR MESSAGES:
-*
-* IF ONE OF THE FOLLOWING RELATION IS SATISFIED BY THE CHOSEN INPUT-
-* PARAMETERS THE PROGRAM RETURNS, AND AN ERROR MESSAGE IS PRINTED:
-* KX < 1 OR KX > 25 OR KY < 1 OR KY > 25 OR
-* MX < 2*KX+2 OR MY < 2*KY+2 .
-*
-************************************************************************
-
- PARAMETER (Z1 = 1)
-
- NERR=1
- IF(KX .LT. 1 .OR. KX .GT. 25) THEN
- WRITE(ERRTXT,101) 'KX',KX
- CALL MTLPRT(NAME,'E210.1',ERRTXT)
- ELSEIF(KY .LT. 1 .OR. KY .GT. 25) THEN
- WRITE(ERRTXT,101) 'KY',KY
- CALL MTLPRT(NAME,'E210.1',ERRTXT)
- ELSEIF(MX .LT. 2*KX+2) THEN
- WRITE(ERRTXT,101) 'MX',MX
- CALL MTLPRT(NAME,'E210.2',ERRTXT)
- ELSEIF(MY .LT. 2*KY+2) THEN
- WRITE(ERRTXT,101) 'MY',MY
- CALL MTLPRT(NAME,'E210.2',ERRTXT)
- ELSE
-
- NERR=0
- RX=Z1/KX
- RY=Z1/KY
- DO 10 I = 1,MX-KX-1
- XI=RX*DVSUM(KX,TX(I+1),TX(I+2))
- DO 10 J = 1,MY-KY-1
- 10 C(I,J)=F(XI,RY*DVSUM(KY,TY(J+1),TY(J+2)))
- ENDIF
-
- RETURN
-
- 101 FORMAT(1X,A5,' =',I6,' NOT IN RANGE')
- END
-
-
-
diff --git a/src/mathlib/gen/e/dtrgsm.F b/src/mathlib/gen/e/dtrgsm.F
deleted file mode 100644
index 1396195..0000000
--- a/src/mathlib/gen/e/dtrgsm.F
+++ /dev/null
@@ -1,55 +0,0 @@
-*
-* $Id: dtrgsm.F,v 1.1.1.1 1996/04/01 15:02:29 mclareni Exp $
-*
-* $Log: dtrgsm.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:29 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- FUNCTION DTRGSM(X,A,N,B,M,IOP)
-#if !defined(CERNLIB_DOUBLE)
-#include "gen/imp128.inc"
- CHARACTER*6 NAME
- NAME ='DTRGSM'
- CALL MTLPRT(NAME,'E409',
- +'not available on this machine - see documentation')
- DTRGSM=0.0
- RETURN
- END
-#endif
-#if defined(CERNLIB_DOUBLE)
- IMPLICIT DOUBLE PRECISION (A-H,O-Z)
-
- DIMENSION A(0:*),B(*)
-
- PARAMETER (R1 = 1, HF = R1/2)
-
- C=2*COS(X)
- H=0
- IF(IOP .NE. 3) THEN
- A2=0
- A1=0
- A0=A(N)
- DO 1 K = N-1,0,-1
- A2=A1
- A1=A0
- A0=A(K)+C*A1-A2
- 1 CONTINUE
- H=HF*(A(0)+A0-A2)
- ENDIF
- IF(IOP .NE. 2) THEN
- A2=0
- A1=0
- A0=B(M)
- DO 2 K = M-1,1,-1
- A2=A1
- A1=A0
- A0=B(K)+C*A1-A2
- 2 CONTINUE
- H=H+A0*SIN(X)
- ENDIF
- DTRGSM=H
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/e/dummy.F b/src/mathlib/gen/e/dummy.F
deleted file mode 100644
index d4048a3..0000000
--- a/src/mathlib/gen/e/dummy.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: dummy.F,v 1.1.1.1 1996/04/01 15:02:28 mclareni Exp $
-*
-* $Log: dummy.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:28 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- SUBROUTINE RCHEBN(M,N,A,MDIM,B,TOL,RELERR,X,RESMAX,IRK,ITER,IOCD)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- SUBROUTINE DCHEBN(M,N,A,MDIM,B,TOL,RELERR,X,RESMAX,IRK,ITER,IOCD)
-#endif
- CHARACTER*6 NAME
-#if defined(CERNLIB_DOUBLE)
- NAME = 'RCHEBN'
-#endif
-#if !defined(CERNLIB_DOUBLE)
- NAME = 'DCHEBN'
-#endif
- CALL MTLPRT(NAME,'E222',
- +'not available on this machine - see documentation')
- RETURN
- END
diff --git a/src/mathlib/gen/e/e221prec.inc b/src/mathlib/gen/e/e221prec.inc
deleted file mode 100644
index 72abeb3..0000000
--- a/src/mathlib/gen/e/e221prec.inc
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: e221prec.inc,v 1.1.1.1 1996/04/01 15:02:28 mclareni Exp $
-*
-* $Log: e221prec.inc,v $
-* Revision 1.1.1.1 1996/04/01 15:02:28 mclareni
-* Mathlib gen
-*
-*
-*
-* e221prec.inc
-*
-#if defined(CERNLIB_IBM)
- DATA BIG /1.E+75/
-
-#elif (defined(CERNLIB_SINGLE))&&(defined(CERNLIB_CONVEX))
- DATA BIG /1.E+307/
-
-#elif 1
- DATA BIG /1.E+37/
-
-#endif
diff --git a/src/mathlib/gen/e/e406cod.inc b/src/mathlib/gen/e/e406cod.inc
deleted file mode 100644
index 3984f00..0000000
--- a/src/mathlib/gen/e/e406cod.inc
+++ /dev/null
@@ -1,115 +0,0 @@
-*
-* $Id: e406cod.inc,v 1.1.1.1 1996/04/01 15:02:28 mclareni Exp $
-*
-* $Log: e406cod.inc,v $
-* Revision 1.1.1.1 1996/04/01 15:02:28 mclareni
-* Mathlib gen
-*
-*
-*
-* e406cod.inc
-*
- DIMENSION C(0:128),CC(0:128),AC(0:64),BC(0:64)
-
- PARAMETER (Z1 = 1, Z2 = 2, HF = Z1/2)
-
- ALFA=HF*(B-A)
- BETA=HF*(B+A)
- C1=F(A)
- C2=F(B)
- AC(0)=C2+C1
- AC(1)=C2-C1
-
- DO 1 I = 1,7
- I1=2**(I-1)
- I2=I1-1
- I3=2*I1
- C1=Z2/I1
- C2=PI/I1
-
- DO 2 J = 0,I2
- 2 C(J)=F(ALFA*COS((J+HF)*C2)+BETA)
-
-C COMPUTE B-COEFFICIENTS
-
- DO 3 J = 0,I2
- F1=J*C2
- F2=-HF*F1
-
- C3=2*COS(F1)
- A2=0
- A1=0
- A0=C(I2)
- DO 4 K = I2-1,0,-1
- A2=A1
- A1=A0
- 4 A0=C(K)+C3*A1-A2
- 3 BC(J)=C1*(A0*COS(F1+F2)-A1*COS(F2))
- BC(I1)=0
-
-C COMPUTE NEW C-COEFFICIENTS
-
- DO 5 J = 0,I1
- C(J)=HF*(AC(J)+BC(J))
- 5 C(I1+J)=HF*(AC(I1-J)-BC(I1-J))
-
-C CHECK IF CALCULATION IS FINISHED
-
- CMX=0
- DO 6 J = 0,I3
- CC(J)=ABS(C(J))
- 6 CMX=MAX(CMX,CC(J))
-
- IF(CMX .GT. 0) THEN
- CMX=1/CMX
- CC(I3)=HF*CC(I3)
- A0=CC(I2)*CMX
- A1=CC(I1)*CMX
- DO 10 J = I1+2,I3
- A2=CC(J)*CMX
- IF(A0 .LE. EPS .AND. A1. LE. EPS .AND. A2 .LE. EPS) GO TO 9
-
- A0=A1
- 10 A1=A2
- ENDIF
-
-C DOUBLE THE NUMBER OF COEFFICIENTS.
-
- IF(I .EQ. 7) GO TO 1
-
- DO 12 J = 0,I3
- 12 AC(J)=C(J)
-
- 1 CONTINUE
-
-C REQUIRED ACCURACY NOT OBTAINED
-
- NC=64
- DELTA=0
- DO 13 J = 60,NC
- 13 DELTA=DELTA+ABS(C(J))
- C(0)=HF*C(0)
- CALL MTLPRT(NAME,'E406.1','REQUIRED ACCURACY NOT OBTAINED')
- RETURN
-
-C REQUIRED ACCURACY OBTAINED
-C SUM NEGLECTED TERMS IN EXPANSION
-
- 9 DELTA=0
- DO 7 K = J,I3
- 7 DELTA=DELTA+CC(K)
-
-C CHECK IF FURTHER REDUCTION OF COEFFICIENTS IS POSSIBLE.
-
- NC=J-1
- REST=EPS-DELTA
- IF(REST .GT. 0) THEN
- 8 IF(CC(NC) .GE. REST) GO TO 14
- DELTA=DELTA+CC(NC)
- REST=REST-CC(NC)
- NC=NC-1
- GO TO 8
- ENDIF
- 14 C(0)=HF*C(0)
- RETURN
- END
diff --git a/src/mathlib/gen/e/lfit.F b/src/mathlib/gen/e/lfit.F
deleted file mode 100644
index 1fd5a87..0000000
--- a/src/mathlib/gen/e/lfit.F
+++ /dev/null
@@ -1,60 +0,0 @@
-*
-* $Id: lfit.F,v 1.1.1.1 1996/04/01 15:02:28 mclareni Exp $
-*
-* $Log: lfit.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:28 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_FORTRAN)||!defined(CERNLIB_CDC)
- SUBROUTINE LFIT(X,Y,L,KEY,A,B,E)
-C
-C TO FIT A STRAIGHT LINE Y=A*X+B TO L POINTS WITH ERROR E
-C SEE MENZEL , FORMULAS OF PHYSICS P.116
-C POINTS WITH Y=0 ARE IGNOERD IF KEY=0
-C L IS NO. OF POINTS
-C
- DIMENSION X(1),Y(1)
-C
-C CALCULATE SUMS
- IF(L-2) 25,1,1
- 1 COUNT=0.0
- SUMX=0.0
- SUMY=0.0
- SUMXY=0.0
- SUMXX=0.0
- SUMYY=0.0
- DO 10 J=1,L
- IF(Y(J).EQ.0..AND.KEY.EQ.0) GO TO 10
- SUMX=SUMX+X(J)
- SUMY=SUMY+Y(J)
- COUNT=COUNT+1.0
- 10 CONTINUE
- IF(COUNT.LE.1.) GO TO 25
- YMED=SUMY/COUNT
- XMED=SUMX/COUNT
- DO 20 J=1,L
- IF(Y(J).EQ.0..AND.KEY.EQ.0) GO TO 20
- SCARTX=X(J)-XMED
- SCARTY=Y(J)-YMED
- SUMXY=SUMXY+SCARTX *SCARTY
- SUMXX=SUMXX+SCARTX *SCARTX
- SUMYY=SUMYY+SCARTY *SCARTY
- 20 CONTINUE
-C
-C FIT PARAMETERS
- IF(SUMXX.EQ.0.) GO TO 25
- A=SUMXY/SUMXX
- B=YMED-A*XMED
- IF(COUNT.LT.3.) GO TO 101
- E=(SUMYY-SUMXY*A )/(COUNT-2.0)
- GO TO 100
-C
-C ISUFFICIENT POINTS
- 25 A=0.0
- B=0.0
- 101 E=0.0
- 100 RETURN
- END
-#endif
diff --git a/src/mathlib/gen/e/lfitw.F b/src/mathlib/gen/e/lfitw.F
deleted file mode 100644
index 92cf583..0000000
--- a/src/mathlib/gen/e/lfitw.F
+++ /dev/null
@@ -1,57 +0,0 @@
-*
-* $Id: lfitw.F,v 1.1.1.1 1996/04/01 15:02:28 mclareni Exp $
-*
-* $Log: lfitw.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:28 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE LFITW(X,Y,W,L,KEY,A,B,E)
-C
-C TO PERFORM A WEIGHTED STRAIGHT LINE FIT
-C
-C FOR FORMULAE USED SEE MENZEL, FORMULAS OF PHYSICS P.116
-C
-C FIT IS OF Y=AX+B , WITH S**2 ESTIMATOR E. WEIGHTS ARE IN W.
-C IF KEY=0, POINTS WITH Y=0 ARE IGNORED
-C L IS NO. OF POINTS
-C
- DIMENSION X(1),Y(1),W(1)
-C
-C CALCULTE SUMS
- IF(L.LE.1) GO TO 1
- W2=0.
- W2X=0.
- W2Y=0.
- W2XY=0.
- W2X2=0.
- W2Y2=0.
- ICNT=0
- DO 2 J=1,L
- IF(Y(J).EQ.0..AND.KEY.EQ.0) GO TO 2
- WW=W(J)*W(J)
- W2=WW+W2
- WWF=WW*X(J)
- W2X=WWF+W2X
- W2X2=WWF*X(J)+W2X2
- W2XY=WWF*Y(J)+W2XY
- WWFI=WW*Y(J)
- W2Y=WWFI+W2Y
- W2Y2=WWFI*Y(J)+W2Y2
- ICNT=ICNT+1
- 2 CONTINUE
-C
-C FIT PARAMETERS
- A=(W2XY-W2X*W2Y/W2)/(W2X2-W2X**2/W2)
- B=(W2Y-A*W2X)/W2
- IF(ICNT.LE.2) GO TO 3
- E=(W2Y2-W2Y**2/W2-(W2XY-W2X*W2Y/W2)**2/(W2X2-W2X**2/W2))/(ICNT-2)
- GO TO 4
-C
-C ISUFFICIENT POINTS
- 1 A=0.
- B=0.
- 3 E=0.
- 4 RETURN
- END
diff --git a/src/mathlib/gen/e/lkkspl.F b/src/mathlib/gen/e/lkkspl.F
deleted file mode 100644
index 79de220..0000000
--- a/src/mathlib/gen/e/lkkspl.F
+++ /dev/null
@@ -1,66 +0,0 @@
-*
-* $Id: lkkspl.F,v 1.1.1.1 1996/04/01 15:02:26 mclareni Exp $
-*
-* $Log: lkkspl.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:26 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- FUNCTION LKKSPL(X,T,M)
-
-#include "gen/imp64.inc"
- DIMENSION T(*)
-
-************************************************************************
-* NORBAS, VERSION: 15.03.1993
-************************************************************************
-*
-* FOR GIVEN X AND A NON-DECREASING SEQUENCE T(1) , T(2) ,..., T(M)
-* THE FUNCTION LKKSPL COMPUTES AND RETURNS THE UNIQUELY DETERMINED
-* INDEX KK SUCH THAT THE RELATION
-* T(KK-1) <= X < T(KK)
-* HOLDS.
-* IT RETURNS KK = 1 , IF X < T(1) , AND
-* KK = M+1 , IF X >= T(M) .
-*
-* (THE SEARCH ALGORITHM IS OF REGULA FALSI - TYPE).
-*
-************************************************************************
-
- IF(X .GE. T(M)) THEN
- LKKSPL=M+1
- ELSEIF(X .LT. T(1)) THEN
- LKKSPL=1
- ELSE
- M1=1
- M2=M
- T1=T(M1)
- T2=T(M2)
- 10 M3=M1+(M2-M1)*(X-T1)/(T2-T1)
- M4=M3+1
- T3=T(M3)
- T4=T(M4)
- IF((T3 .GT. X .OR. X .GE. T4) .AND.
- + (T3 .NE. X .OR. X .NE. T4)) THEN
- IF(X .GE. T3) THEN
- M1=M4
- T1=T4
- ELSE
- M2=M3
- T2=T3
- ENDIF
- GO TO 10
- ENDIF
- 20 LKKSPL=M4
- IF(X .GE. T(M4)) THEN
- M4=M4+1
- GO TO 20
- ENDIF
- ENDIF
-
- RETURN
- END
-
-
-
diff --git a/src/mathlib/gen/e/lsqqr.F b/src/mathlib/gen/e/lsqqr.F
deleted file mode 100644
index cc9133a..0000000
--- a/src/mathlib/gen/e/lsqqr.F
+++ /dev/null
@@ -1,114 +0,0 @@
-*
-* $Id: lsqqr.F,v 1.1.1.1 1996/04/01 15:02:27 mclareni Exp $
-*
-* $Log: lsqqr.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:27 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE LSQQR (A,X,B,M,N,IP,IM,IN,ERR,WORK)
- DIMENSION A(IM,N),X(IN,IP),B(IM,IP),WORK(1)
- LOGICAL ERR
-#if defined(CERNLIB_CDC)
- DATA ETAE/1.0E-14/
-#endif
-#if !defined(CERNLIB_CDC)
- DATA ETAE/1.E-6/
-#endif
-C
-C THE ARRAY A(M,N) CONTAINS THE GIVEN MATRIX OF AN
-C OVERDETERMINED SYSTEM OF M LINEAR EQUATIONS IN N
-C UNKNOWNS (M \ N). FOR THE IP RIGHT HAND SIDES GIVEN
-C AS THE COLUMNS OF THE ARRAY B(M,IP), THE LEAST SQUARES
-C SOLUTIONS ARE COMPUTED AND STORED AS THE COLUMNS OF THE
-C ARRAY X(N,IP). IF RANK(A) < N, THEN THE PROBLEM IS LEFT
-C UNSOLVED AND THE LOGICAL VARIABLE ERR IS SET TO .FALSE.
-C AND CONTROL IS RETURNED TO THE MAIN PROGRAM.
-C IN EITHER CASE, A AND B ARE LEFT INTACT. ETA IS THE
-C RELATIVE MACHINE PRECISION.
-C
-C THE ARRAY WORK (LENGTH 7*N+M*N+M) IS USED TO HOLD THE
-C FOLLOWING ARRAYS, WHICH ARE USED IN THIS AND THE CALLED
-C SUBROUTINES :-
-C
-C REAL ALPHA(N) WHERE WORK(1) = ALPHA(1).
-C REAL E(N) WHERE WORK(N+1) = E(1).
-C REAL Y(N) WHERE WORK(2*N+1) = Y(1).
-C REAL SUM(N) WHERE WORK(3*N+1) = SUM(1).
-C REAL Z(N) WHERE WORK(4*N+1) = Z(1).
-C REAL YA(N) WHERE WORK(5*N+1) = YA(1).
-C REAL R(M) WHERE WORK(6*N+1) = R(1).
-C REAL QR(M,N) WHERE WORK(6*N+M+1) = QR(1,1).
-C INTEGER IPIVOT(N) WHERE WORK(6*N+M*N+M+1) = IPIVOT(1).
-C
-C THUS, IN THIS SUBROUTINE, THESE ARRAYS ARE REFERENCED
-C BY THE ONE ARRAY NAME, WORK.
-C
- IMP1=M*N+6*N+M+1
- IMP2=6*N+M+1
- IMP3=6*N+1
- IMP4=4*N+1
- JO=IMP3-1
- JO1=2*N
-C
- CALL PROC1(A,WORK(IMP2),M,N,IM)
- CALL DECOMP(M,N,WORK(IMP2),WORK(1),WORK(IMP1),ERR,WORK(5*N+1),
- 1 WORK(3*N+1))
- IF(.NOT. ERR) RETURN
-C
- ETA=ETAE**2
- DO 55 K=1,IP
- DO 10 I=1,M
- JU=JO+I
- 10 WORK(JU)=B(I,K)
- CALL SLV (M,N,WORK(IMP2),WORK(1),WORK(IMP1),WORK(IMP3),
- 1 WORK(2*N+1),WORK(IMP4))
- DO 15 I=1,M
- JU=JO+I
- 15 WORK(JU)=-PROD2(A,WORK(2*N+1),IM,1,N,I,-B(I,K))
- CALL SLV (M,N,WORK(IMP2),WORK(1),WORK(IMP1),WORK(IMP3),
- 1 WORK(N+1),WORK(IMP4))
- YNORM0=0
- ENORM1=0
- DO 20 I=1,N
- JU=JO1+I
- YNORM0=YNORM0+WORK(JU)**2
- JU=N+I
- 20 ENORM1=ENORM1+WORK(JU)**2
-C
-C NO ATTEMPT AT OBTAINING THE SOLUTION IS MADE, UNLESS
-C THE NORM OF THE FIRST CORRECTION IS SIGNIFICANTLY SMALLER
-C THAN THE NORM OF THE INITIAL SOLUTION.
- IF(ENORM1.LE. 0.0625*YNORM0) GO TO 25
- ERR=.FALSE.
- RETURN
- 25 DO 30 I=1,N
- JU=JO1+I
- JU1=N+I
- 30 WORK(JU)=WORK(JU)+WORK(JU1)
-C
-C TERMINATE THE ITERATION IF THE CORRECTION WAS OF LITTLE
-C SIGNIFICANCE.
- IF(ENORM1 .LT. ETA*YNORM0) GO TO 45
- DO 35 I=1,M
- JU=JO+I
- 35 WORK(JU)=-PROD2(A,WORK(2*N+1),IM,1,N,I,-B(I,K))
- CALL SLV (M,N,WORK(IMP2),WORK(1),WORK(IMP1),WORK(IMP3),
- 1 WORK(N+1),WORK(IMP4))
- ENORM0=ENORM1
- ENORM1=0
- DO 40 I=1,N
- JU=N+I
- 40 ENORM1=ENORM1+WORK(JU)**2
-C
-C TERMINATE THE ITERATION ALSO IF THE NORM OF THE
-C CORRECTION FAILED TO DECREASE SUFFICIENTLY, AS COMPARED
-C WITH THE NORM OF THE PREVIOUS CORRECTION.
- IF(ENORM1 .LE. 0.0625*ENORM0) GO TO 25
- 45 DO 50 I=1,N
- JU=JO1+I
- 50 X(I,K)=WORK(JU)
- 55 CONTINUE
- RETURN
- END
diff --git a/src/mathlib/gen/e/maxdze.F b/src/mathlib/gen/e/maxdze.F
deleted file mode 100644
index da86fa7..0000000
--- a/src/mathlib/gen/e/maxdze.F
+++ /dev/null
@@ -1,55 +0,0 @@
-*
-* $Id: maxdze.F,v 1.1.1.1 1996/04/01 15:02:24 mclareni Exp $
-*
-* $Log: maxdze.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:24 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- FUNCTION MAXDZE(DA,N)
-#if !defined(CERNLIB_DOUBLE)
- CHARACTER*6 NAME
- NAME = 'MAXDZE'
- CALL MTLPRT(NAME,'E102',
- +'not available on this machine - see documentation')
- MAXDZE = 0
- RETURN
-
- FUNCTION MAXDZE(DA,N)
- NAME = 'MINDZE'
- CALL MTLPRT(NAME,'E102',
- +'not available on this machine - see documentation')
- MINDZE = 0
- RETURN
- END
-
-#endif
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION DA,D
-
- DIMENSION DA(*)
-
- J=1
- D=DA(1)
- DO 5 K = 2, N
- IF(DA(K) .LE. D) GO TO 5
- J=K
- D=DA(K)
- 5 CONTINUE
- MAXDZE=J
- RETURN
-
- ENTRY MINDZE(DA,N)
-
- J=1
- D=DA(1)
- DO 6 K = 2,N
- IF(DA(K) .GE. D) GO TO 6
- J=K
- D=DA(K)
- 6 CONTINUE
- MINDZE=J
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/e/maxize.F b/src/mathlib/gen/e/maxize.F
deleted file mode 100644
index 093413b..0000000
--- a/src/mathlib/gen/e/maxize.F
+++ /dev/null
@@ -1,61 +0,0 @@
-*
-* $Id: maxize.F,v 1.1.1.1 1996/04/01 15:02:24 mclareni Exp $
-*
-* $Log: maxize.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:24 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- FUNCTION MAXIZE(IA,N)
-
- DIMENSION IA(*),RA(*)
-
- J=1
- I=IA(1)
- DO 1 K = 2,N
- IF(IA(K) .LE. I) GO TO 1
- J=K
- I=IA(K)
- 1 CONTINUE
- MAXIZE=J
- RETURN
-
- ENTRY MINIZE(IA,N)
-
- J=1
- I=IA(1)
- DO 2 K = 2,N
- IF(IA(K) .GE. I) GO TO 2
- J=K
- I=IA(K)
- 2 CONTINUE
- MINIZE=J
- RETURN
-
- ENTRY MAXRZE(RA,N)
- ENTRY MAXFZE(RA,N)
-
- J=1
- F=RA(1)
- DO 3 K = 2, N
- IF(RA(K) .LE. F) GO TO 3
- J=K
- F=RA(K)
- 3 CONTINUE
- MAXFZE=J
- RETURN
-
- ENTRY MINRZE(RA,N)
- ENTRY MINFZE(RA,N)
-
- J=1
- F=RA(1)
- DO 4 K = 2,N
- IF(RA(K) .GE. F) GO TO 4
- J=K
- F=RA(K)
- 4 CONTINUE
- MINFZE=J
- RETURN
- END
diff --git a/src/mathlib/gen/e/ndigit.F b/src/mathlib/gen/e/ndigit.F
deleted file mode 100644
index b540acf..0000000
--- a/src/mathlib/gen/e/ndigit.F
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: ndigit.F,v 1.1.1.1 1996/04/01 15:02:26 mclareni Exp $
-*
-* $Log: ndigit.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:26 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- FUNCTION NDIGIT(U,V)
-
-#include "gen/imp64.inc"
-
-************************************************************************
-* NORBAS, VERSION: 15.03.1993
-************************************************************************
-*
-* NDIGIT COMPUTES THE NUMBER OF DECIMAL DIGITS AT THE BEGINNING OF U
-* WHICH ARE AGREE WITH CORRESPONDING DIGITS OF V
-*
-************************************************************************
-
- PARAMETER (SMALL = 1D-30 , TWO = 2)
- IF(ABS(U) .LE. SMALL .AND. ABS(V) .LE. SMALL) THEN
- NDIGIT=16
- ELSE IF(U*V .LT. 0) THEN
- NDIGIT=0
- ELSE
- NDIGIT=MIN(16,ABS(INT(LOG10(MAX(SMALL,ABS((U+V))))) -
- 1 INT(LOG10(MAX(SMALL,TWO*ABS(U-V))))))
- ENDIF
- RETURN
- END
-
diff --git a/src/mathlib/gen/e/parlsq.F b/src/mathlib/gen/e/parlsq.F
deleted file mode 100644
index c17285e..0000000
--- a/src/mathlib/gen/e/parlsq.F
+++ /dev/null
@@ -1,132 +0,0 @@
-*
-* $Id: parlsq.F,v 1.1.1.1 1996/04/01 15:02:28 mclareni Exp $
-*
-* $Log: parlsq.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:28 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_CDC)
- SUBROUTINE PARLSQ
- 1 (PARX2P,PARY2P,NPAR2P,COEF2P,SDEV2P)
-C
-C TO FIT A PARABOLA TO NPAR2P POINTS
-C
-C NPAR2P NO. OF POINTS
-C PARX2P(I) X VALUE OF POINT I
-C PARY2P(I) Y VALUE OF POINT I
-C
-C COEF2P(1...3) COEFFICIENTS OF THE FITTED PARABOLA
-C Y=COEF2P(1) + COEF2P(2)*X + COEF2P(3)*X**2
-C SDEV2P= VARIANCE
-C METHOD : CHI**2 = MIN EQUATION SOLVED EXPLICITLY
- DIMENSION PARX2P(NPAR2P),PARY2P(NPAR2P),COEF2P(NPAR2P)
-C
- DO 3 I=1,3
- 3 COEF2P(I)=0.
- SDEV2P=0.
- IF(NPAR2P.LT.3) GO TO 10
- F=NPAR2P
-C--- CENTER X VALUES FOR REASONS OF MACHINE PRECISION
- XM=0.
- DO 2 I=1,NPAR2P
- 2 XM=XM+PARX2P(I)
- XM=XM/F
- X2=0.
- X3=0.
- X4=0.
- Y=0.
- Y2=0.
- XY=0.
- X2Y=0.
- DO 1 I=1,NPAR2P
- S=PARX2P(I)-XM
- T=PARY2P(I)
- S2=S*S
- X2=X2+S2
- X3=X3+S*S2
- X4=X4+S2*S2
- Y=Y+T
- Y2=Y2+T*T
- XY=XY+S*T
- X2Y=X2Y+S2*T
- 1 CONTINUE
- A=(F*X4-X2**2)*X2-F*X3**2
- IF(A.EQ.0.) GOTO 10
- COEF2P(3)=(X2*(F*X2Y-X2*Y)-F*X3*XY)/A
- COEF2P(2)=(XY-X3*COEF2P(3))/X2
- COEF2P(1)=(Y-X2*COEF2P(3))/F
- IF(NPAR2P.EQ.3) GOTO 6
- SDEV2P=Y2-(COEF2P(1)*Y+COEF2P(2)*XY+COEF2P(3)*X2Y)
- IF(SDEV2P.LT.0.) SDEV2P=0.
- SDEV2P=SDEV2P/(F-3)
- 6 COEF2P(1)=COEF2P(1)+XM*(XM*COEF2P(3)-COEF2P(2))
- COEF2P(2)=COEF2P(2)-2.*XM*COEF2P(3)
- 10 CONTINUE
- RETURN
- END
-#endif
-#if !defined(CERNLIB_CDC)
- SUBROUTINE PARLSQ
- 1 (PARX2P,PARY2P,NPAR2P,COEF2P,SDEV2P)
-C
-C TO FIT A PARABOLA TO NPAR2P POINTS
-C
-C NPAR2P NO. OF POINTS
-C PARX2P(I) X VALUE OF POINT I
-C PARY2P(I) Y VALUE OF POINT I
-C
-C COEF2P(1...3) COEFFICIENTS OF THE FITTED PARABOLA
-C Y=COEF2P(1) + COEF2P(2)*X + COEF2P(3)*X**2
-C SDEV2P= VARIANCE
-C METHOD : CHI**2 = MIN EQUATION SOLVED EXPLICITLY
- DIMENSION PARX2P(NPAR2P),PARY2P(NPAR2P),COEF2P(NPAR2P)
- DOUBLE PRECISION A,CZ(3),F,S,S2,T,XM,XY,X2,X2Y,X3,X4,Y,Y2
-C
- DO 3 I=1,3
- 3 CZ(I)=0.D0
- SDEV2P=0.
- IF(NPAR2P.LT.3) GO TO 10
- F=NPAR2P
-C--- CENTER X VALUES FOR REASONS OF MACHINE PRECISION
- XM=0.D0
- DO 2 I=1,NPAR2P
- 2 XM=XM+PARX2P(I)
- XM=XM/F
- X2=0.D0
- X3=0.D0
- X4=0.D0
- Y=0.D0
- Y2=0.D0
- XY=0.D0
- X2Y=0.D0
- DO 1 I=1,NPAR2P
- S=PARX2P(I)-XM
- T=PARY2P(I)
- S2=S*S
- X2=X2+S2
- X3=X3+S*S2
- X4=X4+S2*S2
- Y=Y+T
- Y2=Y2+T*T
- XY=XY+S*T
- X2Y=X2Y+S2*T
- 1 CONTINUE
- A=(F*X4-X2**2)*X2-F*X3**2
- IF(A.EQ.0.D0) GOTO 10
- CZ(3)=(X2*(F*X2Y-X2*Y)-F*X3*XY)/A
- CZ(2)=(XY-X3*CZ(3))/X2
- CZ(1)=(Y-X2*CZ(3))/F
- IF(NPAR2P.EQ.3) GOTO 6
- SDEV2P=Y2-(CZ(1)*Y+CZ(2)*XY+CZ(3)*X2Y)
- IF(SDEV2P.LT.0.) SDEV2P=0.
- SDEV2P=SDEV2P/(F-3.D0)
- 6 CZ(1)=CZ(1)+XM*(XM*CZ(3)-CZ(2))
- CZ(2)=CZ(2)-2.*XM*CZ(3)
- 10 CONTINUE
- DO 11 I=1,3
- 11 COEF2P(I)=CZ(I)
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/e/proc1.F b/src/mathlib/gen/e/proc1.F
deleted file mode 100644
index 9a9ccf0..0000000
--- a/src/mathlib/gen/e/proc1.F
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: proc1.F,v 1.1.1.1 1996/04/01 15:02:27 mclareni Exp $
-*
-* $Log: proc1.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:27 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE PROC1(A,QR,M,N,IM)
- DIMENSION A(IM,N),QR(M,N)
-C
- DO 5 I=1,M
- DO 5 J=1,N
- 5 QR(I,J)=A(I,J)
- RETURN
- END
diff --git a/src/mathlib/gen/e/prod1.F b/src/mathlib/gen/e/prod1.F
deleted file mode 100644
index 1d71fdd..0000000
--- a/src/mathlib/gen/e/prod1.F
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: prod1.F,v 1.1.1.1 1996/04/01 15:02:27 mclareni Exp $
-*
-* $Log: prod1.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:27 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- FUNCTION PROD1(A,B,M,N)
- DIMENSION A(1),B(1)
- DOUBLE PRECISION SUM
-C
- SUM=0.
- DO 5 I=M,N
- 5 SUM=SUM+DBLE(A(I))*DBLE(B(I))
- PROD1=SUM
- RETURN
- END
diff --git a/src/mathlib/gen/e/prod2.F b/src/mathlib/gen/e/prod2.F
deleted file mode 100644
index 5cca994..0000000
--- a/src/mathlib/gen/e/prod2.F
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: prod2.F,v 1.1.1.1 1996/04/01 15:02:27 mclareni Exp $
-*
-* $Log: prod2.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:27 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- FUNCTION PROD2(A,B,MD,M,N,I,VAL)
- DIMENSION A(MD,1),B(1)
- DOUBLE PRECISION SUM
-C
- SUM=VAL
- DO 5 J=M,N
- 5 SUM=SUM+DBLE(A(I,J))*DBLE(B(J))
- PROD2=SUM
- RETURN
- END
diff --git a/src/mathlib/gen/e/rchebn.F b/src/mathlib/gen/e/rchebn.F
deleted file mode 100644
index 1272493..0000000
--- a/src/mathlib/gen/e/rchebn.F
+++ /dev/null
@@ -1,214 +0,0 @@
-*
-* $Id: rchebn.F,v 1.1.1.1 1996/04/01 15:02:28 mclareni Exp $
-*
-* $Log: rchebn.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:28 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if !defined(CERNLIB_DOUBLE)
- SUBROUTINE RCHEBN(M,N,A,MDIM,B,TOL,RELERR,X,RESMAX,IRK,ITER,IOCD)
-
- DIMENSION A(MDIM,*),B(*),X(*)
-
- PARAMETER (R0 = 0, R1 = 1, R2 = 2)
-
- DATA BIG /1E+37/
-
- IRK=N
- NR=1
- RELTMP=RELERR
- RELERR=0
-
- CALL RVSET(M,R1,A(1,N+1),A(2,N+1))
- CALL RVSCL(M,-R1,B(1),B(2),A(1,N+2),A(2,N+2))
- DO 10 I = 1,M
- A(I,N+3)=N+I
- 10 CONTINUE
- DO 20 J = 1,N
- A(M+1,J)=J
- 20 CONTINUE
- A(M+1,N+1)=0
- ITER=0
- IOCD=1
- CALL RVSET(N,R0,X(1),X(2))
-
- LEV=1
-
- K=0
- NK=N+1
- 30 K=K+1
- NK=NK-1
- MODE=0
- CALL RVSET(M-K+1,R1,B(1),B(2))
-
- 50 D=-BIG
- DO 60 I = K,M
- IF(B(I) .NE. 0) THEN
- DD=ABS(A(I,N+2))
- IF(DD .GT. D) THEN
- IQ=I
- D=DD
- ENDIF
- ENDIF
- 60 CONTINUE
- IF(K .LE. 1 .AND. D .LE. TOL) THEN
- RESMAX=0
- MODE=2
- GOTO 380
- ENDIF
- D=TOL
- DO 80 J = 1,NK
- DD=ABS(A(IQ,J))
- IF(DD .GT. D) THEN
- IP=J
- D=DD
- ENDIF
- 80 CONTINUE
- IF(D .GT. TOL) GOTO 330
-
- B(IQ)=0
- IF(MODE .EQ. 1) GOTO 50
- DO 100 I = K,M
- IF(B(I) .NE. 0) THEN
- DO 90 J = 1,NK
- IF(ABS(A(I,J)) .GT. TOL) THEN
- MODE=1
- GOTO 50
- ENDIF
- 90 CONTINUE
- ENDIF
- 100 CONTINUE
- IRK=K-1
- NR=N+1-IRK
- IOCD=0
- GOTO 160
-
- 110 CALL RVXCH(N+3,A(IQ,1),A(IQ,2),A(K,1),A(K,2))
- CALL RVXCH(M+1,A(1,IP),A(2,IP),A(1,NK),A(2,NK))
- IF(K .LT. N) GOTO 30
- 160 IF(IRK .EQ. M) GOTO 380
-
- LEV=2
-
- D=TOL
- DO 170 I = IRK+1,M
- DD=ABS(A(I,N+2))
- IF(DD .GT. D) THEN
- IQ=I
- D=DD
- ENDIF
- 170 CONTINUE
-
- IF(D .LE. TOL) THEN
- RESMAX=0
- MODE=3
- GOTO 380
- ENDIF
- IF(A(IQ,N+2) .GE. -TOL) THEN
- A(IQ,N+1)=2-A(IQ,N+1)
- CALL RVSCL(N+4-NR,-R1,A(IQ,1),A(IQ,2),A(IQ,1),A(IQ,2))
- A(IQ,N+1)=-A(IQ,N+1)
- ENDIF
- DO 220 J = NR,N
- IF(A(IQ,J) .GE. TOL) THEN
- CALL RVSCA(M,R2,
- 1 A(1,J),A(2,J),A(1,N+1),A(2,N+1),A(1,N+1),A(2,N+1))
- CALL RVSCL(M,-R1,A(1,J),A(2,J),A(1,J),A(2,J))
- A(M+1,J)=-A(M+1,J)
- ENDIF
- 220 CONTINUE
- IP=N+1
- GOTO 330
-
- 230 IF(IRK+1 .EQ. M) GO TO 380
- CALL RVXCH(IRK+3,A(IQ,1),A(IQ,2),A(M,1),A(M,2))
-
- LEV=3
-
- 260 D=-TOL
- H=2*A(M,N+2)
- DO 280 I = IRK+1,M-1
- IF(A(I,N+2) .LT. D) THEN
- IQ=I
- D=A(I,N+2)
- MODE=0
- ELSE
- DD=H-A(I,N+2)
- IF(DD .LT. D) THEN
- IQ=I
- D=DD
- MODE=1
- ENDIF
- ENDIF
- 280 CONTINUE
- IF(D .GE. -TOL) GOTO 380
- DD=-D/A(M,N+2)
- IF(DD .LT. RELTMP) THEN
- RELERR=DD
- MODE=4
- GOTO 380
- ENDIF
- IF(MODE .NE. 0) THEN
- CALL RVSCS(IRK+1,R2,
- 1 A(M,1),A(M,2),A(IQ,1),A(IQ,2),A(IQ,1),A(IQ,2))
- A(IQ,N+2)=D
- A(IQ,N+3)=-A(IQ,N+3)
- ENDIF
- D=BIG
- DO 320 J = NR,N+1
- IF(A(IQ,J) .GT. TOL) THEN
- DD=A(M,J)/A(IQ,J)
- IF(DD .LT. D) THEN
- IP=J
- D=DD
- ENDIF
- ENDIF
- 320 CONTINUE
- IF(D .LT. BIG) GO TO 330
- IOCD=2
- GOTO 380
-
- 330 RPVT=1/A(IQ,IP)
- CALL RVSCL(M,RPVT,A(1,IP),A(2,IP),A(1,IP),A(2,IP))
- DO 360 I = 1,M
- IF(I .NE. IQ) THEN
- D=A(I,IP)
- CALL RVSCA(N+3-NR,-D,
- 1 A(IQ,NR),A(IQ,NR+1),A(I,NR),A(I,NR+1),A(I,NR),A(I,NR+1))
- A(I,IP)=D
- ENDIF
- 360 CONTINUE
- CALL RVSCL(IRK+2,-RPVT,A(IQ,NR),A(IQ,NR+1),A(IQ,NR),A(IQ,NR+1))
- A(IQ,IP)=RPVT
- D=A(M+1,IP)
- A(M+1,IP)=A(IQ,N+3)
- A(IQ,N+3)=D
- ITER=ITER+1
- GOTO (110,230,260), LEV
-
- 380 CALL RVSET(M,R0,B(1),B(2))
- IF(MODE .EQ. 2) GOTO 450
- DO 400 I = 1,IRK
- X(INT(A(I,N+3)))=A(I,N+2)
- 400 CONTINUE
- IF(MODE .EQ. 3 .OR. IRK .EQ. M) GOTO 450
- DO 410 J = NR,N+1
- B(INT(ABS(A(M+1,J)))-N)=A(M,N+2)*SIGN(R1,A(M+1,J))
- 410 CONTINUE
- DO 420 I = IRK+1,M-1
- B(INT(ABS(A(I,N+3)))-N)=(A(M,N+2)-A(I,N+2))*SIGN(R1,A(I,N+3))
- 420 CONTINUE
- 430 DO 440 J = NR,N+1
- IF(ABS(A(M,J)) .LE. TOL) THEN
- IOCD=0
- GOTO 450
- ENDIF
- 440 CONTINUE
- 450 IF(MODE .NE. 2 .AND. MODE .NE. 3) RESMAX=A(M,N+2)
- IF(IRK .EQ. M) RESMAX=0
- IF(MODE .EQ. 4) RESMAX=RESMAX-D
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/e/rchecf.F b/src/mathlib/gen/e/rchecf.F
deleted file mode 100644
index 5316319..0000000
--- a/src/mathlib/gen/e/rchecf.F
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: rchecf.F,v 1.1.1.1 1996/04/01 15:02:28 mclareni Exp $
-*
-* $Log: rchecf.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:28 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- SUBROUTINE RCHECF(F,A,B,EPS,C,NC,DELTA)
-C
- CHARACTER NAME*(*)
- PARAMETER (NAME = 'RCHECF')
- ENTRY CHECF(F,A,B,EPS,C,NC,DELTA)
- CALL MTLPRT(NAME,'E406.0','Not available on this machine')
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/e/rchpws.F b/src/mathlib/gen/e/rchpws.F
deleted file mode 100644
index bf12d67..0000000
--- a/src/mathlib/gen/e/rchpws.F
+++ /dev/null
@@ -1,37 +0,0 @@
-*
-* $Id: rchpws.F,v 1.1.1.1 1996/04/01 15:02:29 mclareni Exp $
-*
-* $Log: rchpws.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:29 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- SUBROUTINE RCHPWS(N,C,A)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- SUBROUTINE DCHPWS(N,C,A)
-#endif
- CHARACTER NAMECP*(*),NAMEPC*(*)
- CHARACTER*80 ERRTXT
-#if defined(CERNLIB_DOUBLE)
- PARAMETER (NAMECP = 'RCHPWS', NAMEPC = 'RPWCHS')
-#endif
-#if !defined(CERNLIB_DOUBLE)
- PARAMETER (NAMECP = 'DCHPWS', NAMEPC = 'DPWCHS')
-#endif
-
- CALL MTLPRT(NAMECP,'E408.0','NOT AVAILABLE IN THIS MACHINE')
- RETURN
-
-#if defined(CERNLIB_DOUBLE)
- ENTRY RPWCHS(N,A,C)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- ENTRY DPWCHS(N,A,C)
-#endif
-
- CALL MTLPRT(NAMEPC,'E408.0','NOT AVAILABLE IN THIS MACHINE')
- RETURN
- END
diff --git a/src/mathlib/gen/e/rcspln.F b/src/mathlib/gen/e/rcspln.F
deleted file mode 100644
index a9dc22d..0000000
--- a/src/mathlib/gen/e/rcspln.F
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: rcspln.F,v 1.1.1.1 1996/04/01 15:02:27 mclareni Exp $
-*
-* $Log: rcspln.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:27 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- SUBROUTINE RCSPLN(N,X,M,Y,NDIM,MODE,A,B,C,D)
-C
- CHARACTER NAME*(*)
- PARAMETER (NAME = 'RCSPLN/RCSPNT')
-
- ENTRY RCSPNT(N,X,M,Y,NDIM,MODE,A,B,C,D)
- CALL MTLPRT(NAME,'E211.0','Not available on this machine')
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/e/rcspln128.F b/src/mathlib/gen/e/rcspln128.F
deleted file mode 100644
index 34a8597..0000000
--- a/src/mathlib/gen/e/rcspln128.F
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: rcspln128.F,v 1.1.1.1 1996/04/01 15:02:27 mclareni Exp $
-*
-* $Log: rcspln128.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:27 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if !defined(CERNLIB_DOUBLE)
- SUBROUTINE DCSPLN(N,X,M,Y,NDIM,MODE,A,B,C,D)
-#include "gen/imp128.inc"
- CHARACTER NAME*(*)
- PARAMETER (NAME = 'DCSPLN/DCSPNT')
-
- ENTRY DCSPNT(N,X,M,Y,NDIM,MODE,A,B,C,D)
- CALL MTLPRT(NAME,'E211.0','Not available on this machine')
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/e/rcspln64.F b/src/mathlib/gen/e/rcspln64.F
deleted file mode 100644
index 0e134ee..0000000
--- a/src/mathlib/gen/e/rcspln64.F
+++ /dev/null
@@ -1,193 +0,0 @@
-*
-* $Id: rcspln64.F,v 1.1.1.1 1996/04/01 15:02:27 mclareni Exp $
-*
-* $Log: rcspln64.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:27 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if !defined(CERNLIB_DOUBLE)
- SUBROUTINE RCSPLN(N,X,M,Y,NDIM,MODE,A,B,C,D)
-#endif
-#if defined(CERNLIB_DOUBLE)
- SUBROUTINE DCSPLN(N,X,M,Y,NDIM,MODE,A,B,C,D)
-#include "gen/imp64.inc"
-#endif
- CHARACTER NAMEN*(*),NAMET*(*)
- CHARACTER*80 ERRTXT
-#if !defined(CERNLIB_DOUBLE)
- PARAMETER (NAMEN = 'RCSPLN', NAMET = 'RCSPLT')
-#endif
-#if defined(CERNLIB_DOUBLE)
- PARAMETER (NAMEN = 'DCSPLN', NAMET = 'DCSPLT')
-#endif
- LOGICAL LNT
-
- DIMENSION X(0:*),Y(0:NDIM,*)
- DIMENSION A(NDIM,*),B(NDIM,*),C(NDIM,*),D(NDIM,*)
-
- PARAMETER (Z1 = 1, C1 = 3*Z1/2, C2 = Z1/3, C3 = 2*Z1/3)
- PARAMETER (C4 = Z1/2, C5 = Z1/6, C6 = 2*Z1/15, C7 = 7*Z1/60)
-
- LNT=.FALSE.
- GO TO 50
-
-#if !defined(CERNLIB_DOUBLE)
- ENTRY RCSPNT(N,X,M,Y,NDIM,MODE,A,B,C,D)
-#endif
-#if defined(CERNLIB_DOUBLE)
- ENTRY DCSPNT(N,X,M,Y,NDIM,MODE,A,B,C,D)
-#endif
-
- LNT=.TRUE.
- 50 IF(N .LT. 2 .OR. M .LT. 1 .OR. NDIM .LT. N .OR.
- 1 MODE .NE. 0. AND. MODE .NE. 1) THEN
- IF(N .LT. 2) THEN
- WRITE(ERRTXT,101) N
- IF(.NOT.LNT) CALL MTLPRT(NAMEN,'E211.1',ERRTXT)
- IF( LNT) CALL MTLPRT(NAMET,'E211.1',ERRTXT)
- ENDIF
- IF(M .LT. 1) THEN
- WRITE(ERRTXT,102) M
- IF(.NOT.LNT) CALL MTLPRT(NAMEN,'E211.2',ERRTXT)
- IF( LNT) CALL MTLPRT(NAMET,'E211.2',ERRTXT)
- ENDIF
- IF(NDIM .LT. N) THEN
- WRITE(ERRTXT,103) NDIM,N
- IF(.NOT.LNT) CALL MTLPRT(NAMEN,'E211.3',ERRTXT)
- IF( LNT) CALL MTLPRT(NAMET,'E211.3',ERRTXT)
- ENDIF
- IF(MODE .NE. 0 .AND. MODE .NE. 1) THEN
- WRITE(ERRTXT,104) MODE
- IF(.NOT.LNT) CALL MTLPRT(NAMEN,'E211.4',ERRTXT)
- IF( LNT) CALL MTLPRT(NAMET,'E211.4',ERRTXT)
- ENDIF
- RETURN
- ENDIF
- DO 1 I = 1,N
- 1 D(I,1)=X(I)-X(I-1)
- DO 2 K = 1,M
- DO 2 I = 1,N
- 2 A(I,K)=(Y(I,K)-Y(I-1,K))/D(I,1)
- IF(MODE .EQ. 1) THEN
- IF(N .EQ. 2) THEN
- T1=1/(D(1,1)+D(2,1))
- DO 3 K = 1,M
- 3 C(2,K)=T1*(A(2,K)-A(1,K))
- ELSE
- DO 4 I = 2,N
- 4 B(I,1)=1/(D(I,1)+D(I-1,1))
- DO 5 K = 1,M
- 5 C(1,K)=0
- B(1,1)=1
-
- DO 6 I = 2,N-1
- T1=3*B(I,1)
- T2=B(I,1)*D(I-1,1)
- T3=1/(2+T2*B(I-1,1))
- B(I,1)=(T2-1)*T3
- DO 6 K = 1,M
- 6 C(I,K)=(T1*(A(I,K)-A(I-1,K))-T2*C(I-1,K))*T3
-
- T1=3*B(N,1)
- T2=B(N,1)*D(N-1,1)
- T3=1/(3-T2*(1-B(N-1,1)))
- DO 7 K = 1,M
- 7 C(N,K)=(T1*(A(N,K)-A(N-1,K))-T2*C(N-1,K))*T3
- END IF
-
- DO 8 I = N-1,2,-1
- T1=B(I,1)
- DO 8 K = 1,M
- 8 C(I,K)=T1*C(I+1,K)+C(I,K)
- DO 9 K = 1,M
- 9 C(1,K)=C(2,K)
- IF(.NOT.LNT) THEN
- DO 10 K = M,1,-1
- B(1,K)=A(1,K)-C(2,K)*D(1,1)
- D(1,K)=0
- DO 11 I = 2,N-1
- B(I,K)=A(I,K)-C2*(C(I+1,K)+2*C(I,K))*D(I,1)
- 11 D(I,K)=(C(I+1,K)-C(I,K))/(3*D(I,1))
- B(N,K)=A(N,K)-C(N,K)*D(N,1)
- 10 D(N,K)=0
- DO 12 K = 1,M
- DO 12 I = 1,N
- 12 A(I,K)=Y(I-1,K)
- ENDIF
- ELSE
- IF(N .EQ. 2) THEN
- T1=C1/(D(1,1)+D(2,1))
- DO 23 K = 1,M
- 23 C(2,K)=T1*(A(2,K)-A(1,K))
- ELSE
- DO 24 I = 2,N
- 24 B(I,1)=1/(D(I,1)+D(I-1,1))
- DO 25 K = 1,M
- 25 C(1,K)=0
- B(1,1)=0
-
- DO 26 I = 2,N-1
- T1=3*B(I,1)
- T2=B(I,1)*D(I-1,1)
- T3=1/(2+T2*B(I-1,1))
- B(I,1)=(T2-1)*T3
- DO 26 K = 1,M
- 26 C(I,K)=(T1*(A(I,K)-A(I-1,K))-T2*C(I-1,K))*T3
-
- T1=3*B(N,1)
- T2=B(N,1)*D(N-1,1)
- T3=1/(2+T2*B(N-1,1))
- DO 27 K = 1,M
- 27 C(N,K)=(T1*(A(N,K)-A(N-1,K))-T2*C(N-1,K))*T3
- END IF
-
- DO 28 I = N-1,2,-1
- T1=B(I,1)
- DO 28 K = 1,M
- 28 C(I,K)=T1*C(I+1,K)+C(I,K)
- DO 29 K = 1,M
- 29 C(1,K)=0
- IF(.NOT.LNT) THEN
- T1=C2*D(1,1)
- T2=C2/D(1,1)
- T3=C3*D(N,1)
- T4=C2/D(N,1)
- DO 30 K = M,1,-1
- B(1,K)=A(1,K)-T1*C(2,K)
- D(1,K)=T2*C(2,K)
- DO 31 I = 2,N-1
- B(I,K)=A(I,K)-C2*(C(I+1,K)+2*C(I,K))*D(I,1)
- 31 D(I,K)=(C(I+1,K)-C(I,K))/(3*D(I,1))
- B(N,K)=A(N,K)-T3*C(N,K)
- 30 D(N,K)=-T4*C(N,K)
- DO 32 K = 1,M
- DO 32 I = 1,N
- 32 A(I,K)=Y(I-1,K)
- ENDIF
- ENDIF
-
- IF(LNT) THEN
- DO 41 K = 1,M
- T1=D(1,1)**2
- A(1,K)=C4*(Y(0,K)+Y(1,K)-C5*(C(1,K)+C(2,K))*T1)*D(1,1)
- B(1,K)=C2*(Y(0,K)+C4*Y(1,K)-(C6*C(1,K)+C7*C(2,K))*T1)*T1
- DO 42 I = 2,N-1
- T1=D(I,1)**2
- A(I,K)=A(I-1,K)+
- 1 C4*(Y(I-1,K)+Y(I,K)-C5*(C(I,K)+C(I+1,K))*T1)*D(I,1)
- 42 B(I,K)=B(I-1,K)+C2*(Y(I-1,K)+C4*Y(I,K)-
- 1 (C6*C(I,K)+C7*C(I+1,K))*T1)*T1+A(I-1,K)*D(I,1)
- T1=D(N,1)**2
- A(N,K)=A(N-1,K)+
- 1 C4*(Y(N-1,K)+Y(N,K)-C(N,K)*C5*(1+MODE)*T1)*D(N,1)
- 41 B(N,K)=B(N-1,K)+C2*(Y(N-1,K)+C4*Y(N,K)-
- 1 C(N,K)*(C6+MODE*C7)*T1)*T1+A(N-1,K)*D(N,1)
- ENDIF
- RETURN
- 101 FORMAT('ILLEGAL N = ',I5,' < 2')
- 102 FORMAT('ILLEGAL M = ',I5,' < 1')
- 103 FORMAT('ILLEGAL NDIM = ',I5,' < ',I5,' = N')
- 104 FORMAT('ILLEGAL MODE = ',I5)
- END
diff --git a/src/mathlib/gen/e/rlsqp1.F b/src/mathlib/gen/e/rlsqp1.F
deleted file mode 100644
index 87357f7..0000000
--- a/src/mathlib/gen/e/rlsqp1.F
+++ /dev/null
@@ -1,59 +0,0 @@
-*
-* $Id: rlsqp1.F,v 1.1.1.1 1996/04/01 15:02:24 mclareni Exp $
-*
-* $Log: rlsqp1.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:24 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE RLSQP1(N,X,Y,A0,A1,SD,IFAIL)
- IMPLICIT DOUBLE PRECISION (A-H,O-Z)
- REAL X,Y,A0,A1,SD
-
- DIMENSION X(*),Y(*)
-
- PARAMETER (R0 = 0)
-
- A0=0
- A1=0
- SD=0
- IF(N .LE. 1) THEN
- IFAIL=1
- ELSE
- FN=N
- XM=0
- DO 1 K = 1,N
- XM=XM+X(K)
- 1 CONTINUE
- XM=XM/FN
- SX=0
- SY=0
- SXX=0
- SYY=0
- SXY=0
- DO 2 K = 1,N
- XK=X(K)-XM
- YK=Y(K)
- SX=SX+XK
- SY=SY+YK
- SXX=SXX+XK**2
- SYY=SYY+YK**2
- SXY=SXY+XK*YK
- 2 CONTINUE
- DET=FN*SXX-SX**2
- IF(DET .GT. 0) THEN
- D0=(SY*SXX-SXY*SX)/DET
- D1=(FN*SXY-SX*SY)/DET
- IFAIL=0
- ELSE
- IFAIL=-1
- ENDIF
- ENDIF
- IF(IFAIL .EQ. 0) THEN
- IF(N .GT. 2) SD=SQRT(MAX(R0,SYY-D0*SY-D1*SXY)/(N-2))
- A0=D0-D1*XM
- A1=D1
- ENDIF
- RETURN
- END
diff --git a/src/mathlib/gen/e/rlsqp2.F b/src/mathlib/gen/e/rlsqp2.F
deleted file mode 100644
index d4d066f..0000000
--- a/src/mathlib/gen/e/rlsqp2.F
+++ /dev/null
@@ -1,68 +0,0 @@
-*
-* $Id: rlsqp2.F,v 1.1.1.1 1996/04/01 15:02:24 mclareni Exp $
-*
-* $Log: rlsqp2.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:24 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE RLSQP2(N,X,Y,A0,A1,A2,SD,IFAIL)
- IMPLICIT DOUBLE PRECISION (A-H,O-Z)
- REAL X,Y,A0,A1,A2,SD
-
- DIMENSION X(*),Y(*)
-
- PARAMETER (R0 = 0)
-
- A0=0
- A1=0
- A2=0
- SD=0
- IF(N .LE. 2) THEN
- IFAIL=1
- ELSE
- FN=N
- XM=0
- DO 1 K = 1,N
- XM=XM+X(K)
- 1 CONTINUE
- XM=XM/FN
- SX=0
- SXX=0
- SXXX=0
- SXXXX=0
- SY=0
- SYY=0
- SXY=0
- SXXY=0
- DO 2 K = 1,N
- XK=X(K)-XM
- YK=Y(K)
- XK2=XK**2
- SX=SX+XK
- SXX=SXX+XK2
- SXXX=SXXX+XK2*XK
- SXXXX=SXXXX+XK2**2
- SY=SY+YK
- SYY=SYY+YK**2
- SXY=SXY+XK*YK
- SXXY=SXXY+XK2*YK
- 2 CONTINUE
- DET=(FN*SXXXX-SXX**2)*SXX-FN*SXXX**2
- IF(DET .GT. 0) THEN
- D2=(SXX*(FN*SXXY-SXX*SY)-FN*SXXX*SXY)/DET
- D1=(SXY-SXXX*D2)/SXX
- D0=(SY-SXX*D2)/FN
- IFAIL=0
- ELSE
- IFAIL=-1
- ENDIF
- ENDIF
- IF(IFAIL .EQ. 0 .AND. N .GT. 3)
- 1 SD=SQRT(MAX(R0,SYY-D0*SY-D1*SXY-D2*SXXY)/(N-3))
- A0=D0+XM*(XM*D2-D1)
- A1=D1-2*XM*D2
- A2=D2
- RETURN
- END
diff --git a/src/mathlib/gen/e/rlsqpm.F b/src/mathlib/gen/e/rlsqpm.F
deleted file mode 100644
index d262820..0000000
--- a/src/mathlib/gen/e/rlsqpm.F
+++ /dev/null
@@ -1,76 +0,0 @@
-*
-* $Id: rlsqpm.F,v 1.1.1.1 1996/04/01 15:02:24 mclareni Exp $
-*
-* $Log: rlsqpm.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:24 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE RLSQPM(N,X,Y,M,A,SD,IFAIL)
- IMPLICIT DOUBLE PRECISION (A-H,O-Z)
- REAL X,Y,A,R0
-
- PARAMETER (IDIM = 21, R0 = 0, D0 = 0)
-
- DIMENSION X(*),Y(*),A(0:*),B(IDIM,IDIM),D(0:IDIM),XY(0:IDIM)
-
- M1=M+1
- IFAIL=0
- IF(N .LE. 1 .OR. M .LT. 0 .OR. M1 .GT. IDIM .OR. M1 .GT. N) THEN
- IFAIL=1
- ELSEIF(M .EQ. 0) THEN
- XY(0)=DVSUM(N,Y(1),Y(2))
- D(0)=XY(0)/N
- SYY=DVMPY(N,Y(1),Y(2),Y(1),Y(2))
- ELSE
- DO 11 J = 1,M1
- D(J-1)=0
- B(J,1)=0
- B(M1,J)=0
- 11 CONTINUE
- B(1,1)=N
- SYY=0
- DO 4 K = 1,N
- XK=X(K)
- YK=Y(K)
- SYY=SYY+YK**2
- P=1
- D(0)=D(0)+YK
- DO 2 J = 2,M1
- P=P*XK
- B(J,1)=B(J,1)+P
- D(J-1)=D(J-1)+P*YK
- 2 CONTINUE
- DO 3 J = 2,M1
- P=P*XK
- B(M1,J)=B(M1,J)+P
- 3 CONTINUE
- 4 CONTINUE
- DO 5 I = 2,M
- DO 5 K = I,M1
- B(K-1,I)=B(K,I-1)
- 5 CONTINUE
- DO 6 J = 0,M
- XY(J)=D(J)
- 6 CONTINUE
- CALL DSEQN(M1,B,IDIM,IFAIL,1,D)
- ENDIF
- SD=0
- IF(IFAIL .EQ. 0) THEN
- IF(N .GT. M1) THEN
- SD=SYY
- DO 7 J = 0,M
- SD=SD-D(J)*XY(J)
- 7 CONTINUE
- SD=SQRT(MAX(D0,SD)/(N-M1))
- ENDIF
- DO 8 J = 0,M
- A(J)=D(J)
- 8 CONTINUE
- ELSE
- CALL RVSET(M1,R0,A(0),A(1))
- M=0
- ENDIF
- RETURN
- END
diff --git a/src/mathlib/gen/e/rtrgsm.F b/src/mathlib/gen/e/rtrgsm.F
deleted file mode 100644
index 3e9ed88..0000000
--- a/src/mathlib/gen/e/rtrgsm.F
+++ /dev/null
@@ -1,42 +0,0 @@
-*
-* $Id: rtrgsm.F,v 1.1.1.1 1996/04/01 15:02:29 mclareni Exp $
-*
-* $Log: rtrgsm.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:29 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- FUNCTION RTRGSM(X,A,N,B,M,IOP)
-
- DIMENSION A(0:*),B(*)
-
- PARAMETER (R1 = 1, HF = R1/2)
-
- C=2*COS(X)
- H=0
- IF(IOP .NE. 3) THEN
- A2=0
- A1=0
- A0=A(N)
- DO 1 K = N-1,0,-1
- A2=A1
- A1=A0
- A0=A(K)+C*A1-A2
- 1 CONTINUE
- H=HF*(A(0)+A0-A2)
- ENDIF
- IF(IOP .NE. 2) THEN
- A2=0
- A1=0
- A0=B(M)
- DO 2 K = M-1,1,-1
- A2=A1
- A1=A0
- A0=B(K)+C*A1-A2
- 2 CONTINUE
- H=H+A0*SIN(X)
- ENDIF
- RTRGSM=H
- RETURN
- END
diff --git a/src/mathlib/gen/e/slv.F b/src/mathlib/gen/e/slv.F
deleted file mode 100644
index 6d808b5..0000000
--- a/src/mathlib/gen/e/slv.F
+++ /dev/null
@@ -1,38 +0,0 @@
-*
-* $Id: slv.F,v 1.1.1.1 1996/04/01 15:02:27 mclareni Exp $
-*
-* $Log: slv.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:27 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE SLV (M,N,QR,ALPHA,IPIVOT,R,Y,Z)
- DIMENSION QR(M,N),ALPHA(N),R(M),Y(N),IPIVOT(N),Z(N)
-C
-C USING THE VECTORS U, WHOSE NON-ZERO COMPONENTS ARE
-C STORED ON AND BELOW THE MAIN DIAGONAL OF QR(M,N), SLV
-C APPLIES THE N TRANSFORMATIONS (I - BETA UT) TO THE
-C RIGHT HAND SIDE R(M). FROM THE REDUCED MATRIX GIVEN IN
-C ALPHA(N) AND THE UPPER RIGHT TRIANGULAR PART OF QR,
-C SLV THEN COMPUTES BY BACK-SUBSTITUTION, AN APPROXIMATE
-C SOLUTION TO THE LINEAR SYSTEM. THE COMPONENTS OF THE
-C SOLUTION VECTOR ARE STORED IN Y(N) IN THE ORDER PRESCRIBED
-C BY IPIVOT(N).
-C
- DO 10 J=1,N
- GAMMA=PROD1(QR(1,J),R,J,M)/(ALPHA(J)*QR(J,J))
- DO 5 I=J,M
- 5 R(I)=R(I)+GAMMA*QR(I,J)
- 10 CONTINUE
- Z(N)=R(N)/ALPHA(N)
- NIT=N-1
- DO 15 I=1,NIT
- L=N-I
- LA=L+1
- 15 Z(L)=-PROD2(QR,Z,M,LA,N,L,-R(L))/ALPHA(L)
- DO 20 I=1,N
- JU=IPIVOT(I)
- 20 Y(JU)=Z(I)
- RETURN
- END
diff --git a/src/mathlib/gen/e/splan0.F b/src/mathlib/gen/e/splan0.F
deleted file mode 100644
index 6f8cb6b..0000000
--- a/src/mathlib/gen/e/splan0.F
+++ /dev/null
@@ -1,35 +0,0 @@
-*
-* $Id: splan0.F,v 1.1.1.1 1996/04/01 15:02:26 mclareni Exp $
-*
-* $Log: splan0.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:26 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE SPLAN0(B0,X,X1,X2,ND)
-#include "gen/imp64.inc"
- DIMENSION B0(1)
-
-************************************************************************
-* NORBAS, VERSION: 15.03.1993
-************************************************************************
-*
-* TEST-ROUTINE SPLAN0
-* FOR COMPUTING 1-DIMENSIONAL B-SPLINES OF DEGREE K = 0
-* BY MEANS OF ANALYTIC FORMULAE
-*
-************************************************************************
-
- B0(1)=0
- IF(ND .GT. 0) RETURN
- IF(ND .EQ. 0) THEN
- IF(X1 .LE. X .AND. X .LE. X2) B0(1)=1
- RETURN
- ENDIF
- IF(X1 .LT. X) B0(1)=MIN(1D0,X-X1)
- RETURN
- END
-
-
-
diff --git a/src/mathlib/gen/e/splan1.F b/src/mathlib/gen/e/splan1.F
deleted file mode 100644
index fdc15a8..0000000
--- a/src/mathlib/gen/e/splan1.F
+++ /dev/null
@@ -1,63 +0,0 @@
-*
-* $Id: splan1.F,v 1.1.1.1 1996/04/01 15:02:26 mclareni Exp $
-*
-* $Log: splan1.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:26 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE SPLAN1(B1,X,X2,X3,X4,ND)
-#include "gen/imp64.inc"
- DIMENSION B1(3)
-
-************************************************************************
-* NORBAS, VERSION: 15.03.1993
-************************************************************************
-*
-* TEST-ROUTINE SPLAN1
-* FOR COMPUTING 1-DIMENSIONAL B-SPLINES OF DEGREE K = 1
-* BY MEANS OF ANALYTIC FORMULAE
-*
-************************************************************************
-
- DO 1 I = 1,3
- 1 B1(I)=0
- IF(IABS(ND) .GT. 1) RETURN
- IF(X .LT. X2 .OR. X .GT. X4) RETURN
- IF(ND .EQ. 0) THEN
- IF(X .LT. X3) THEN
- B1(1)=(-X+X3)/X3
- B1(2)=X/X3
- B1(3)=0
- ELSE
- B1(1)=0
- B1(2)=(X-1)/(X3-1)
- B1(3)=(-X+X3)/(X3-1)
- END IF
- ELSE IF(ND .EQ. 1) THEN
- IF(X .LT. X3) THEN
- B1(1)=-1/X3
- B1(2)=1/X3
- B1(3)=0
- ELSE
- B1(1)=0
- B1(2)=1/(X3-1)
- B1(3)=-1/(X3-1)
- END IF
- ELSE IF(ND .EQ. -1) THEN
- IF(X .LT. X3) THEN
- B1(1)=-(X/2-X3)*X/X3
- B1(2)=X**2/(2*X3)
- B1(3)=0
- ELSE
- B1(1)=X3/2
- B1(2)=(X**2-2*X+X3)/(2*(X3-1))
- B1(3)=-(X-X3)**2/(2*(X3-1))
- END IF
- END IF
- RETURN
- END
-
-
-
diff --git a/src/mathlib/gen/e/splan2.F b/src/mathlib/gen/e/splan2.F
deleted file mode 100644
index 6aa0a6e..0000000
--- a/src/mathlib/gen/e/splan2.F
+++ /dev/null
@@ -1,180 +0,0 @@
-*
-* $Id: splan2.F,v 1.1.1.1 1996/04/01 15:02:26 mclareni Exp $
-*
-* $Log: splan2.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:26 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE SPLAN2(B2,X,X3,X4,X5,X6,ND)
-#include "gen/imp64.inc"
- DIMENSION B2(5)
-
-************************************************************************
-* NORBAS, VERSION: 15.03.1993
-************************************************************************
-*
-* TEST-ROUTINE SPLAN2
-* FOR COMPUTING 1-DIMENSIONAL B-SPLINES OF DEGREE K = 2
-* BY MEANS OF ANALYTIC FORMULAE
-*
-************************************************************************
-
- DO 1 I = 1,5
- 1 B2(I)=0
- IF(ND .LT. -1 .OR. ND .GT. 2) RETURN
- IF(X .LT. X3 .OR. X .GT. X6) RETURN
- IF(ND .EQ. 0) THEN
- IF(X3 .LT. X4 .AND. X4 .LT. X5 .AND. X5 .LT. X6) THEN
- IF(X .LT. X4) THEN
- B2(1)=((X-X4)/X4)**2
- B2(2)=X*(-X*(X4+X5)+2*X4*X5)/(X4**2*X5)
- B2(3)=X**2/(X4*X5)
- B2(4)=0
- B2(5)=0
- ELSE IF(X4 .LE. X .AND. X .LT. X5) THEN
- B2(1)=0
- B2(2)=-(X-X5)**2/(X5*(X4-X5))
- B2(3)=(X**2*(X4-X5-1)+2*X*X5-X4*X5)/(X5*(X4-1)*(X4-X5))
- B2(4)=(X-X4)**2/((X4-1)*(X4-X5))
- B2(5)=0
- ELSE
- B2(1)=0
- B2(2)=0
- B2(3)=(X-1)**2/((X4-1)*(X5-1))
- B2(4)=(X-1)*(X*(2-X4-X5)+2*X4*X5-X4-X5)/((X4-1)*(X5-1)**2)
- B2(5)=((X-X5)/(X5-1))**2
- END IF
- ELSE IF(X3 .LT. X4 .AND. X4 .EQ. X5 .AND. X5 .LT. X6) THEN
- IF(X .LT. X4) THEN
- B2(1)=((X-X4)/X4)**2
- B2(2)=-2*(X-X4)*X/X4**2
- B2(3)=(X/X4)**2
- B2(4)=0
- B2(5)=0
- ELSE
- B2(1)=0
- B2(2)=0
- B2(3)=((X-1)/(X4-1))**2
- B2(4)=-2*(X-X4)*(X-1)/(X4-1)**2
- B2(5)=((X-X4)/(X4-1))**2
- END IF
- END IF
- ELSE IF(ND .EQ. 1) THEN
- IF(X3 .LT. X4 .AND. X4 .LT. X5 .AND. X5 .LT. X6) THEN
- IF(X .LT. X4) THEN
- B2(1)=2*(X-X4)/X4**2
- B2(2)=-2*(X*(X4+X5)-X4*X5)/(X4**2*X5)
- B2(3)=2*X/(X4*X5)
- B2(4)=0
- B2(5)=0
- ELSE IF(X4 .LE. X .AND. X .LT. X5) THEN
- B2(1)=0
- B2(2)=-2*(X-X5)/((X4-X5)*X5)
- B2(3)=2*(X*(X4-X5-1)+X5)/((X4-X5)*(X4-1)*X5)
- B2(4)=2*(X-X4)/((X4-X5)*(X4-1))
- B2(5)=0
- ELSE
- B2(1)=0
- B2(2)=0
- B2(3)=2*(X-1)/((X4-1)*(X5-1))
- B2(4)=-2*(X*(X4+X5-2)-X4*X5+1)/((X4-1)*(X5-1)**2)
- B2(5)=2*(X-X5)/(X5-1)**2
- END IF
- ELSE IF(X3 .LT. X4 .AND. X4 .EQ. X5 .AND. X5 .LT. X6) THEN
- IF(X .LT. X4) THEN
- B2(1)=2*(X-X4)/X4**2
- B2(2)=-2*(2*X-X4)/X4**2
- B2(3)=2*X/X4**2
- B2(4)=0
- B2(5)=0
- ELSE
- B2(1)=0
- B2(2)=0
- B2(3)=2*(X-1)/(X4-1)**2
- B2(4)=-2*((X-X4)+(X-1))/(X4-1)**2
- B2(5)=2*(X-X4)/(X4-1)**2
- END IF
- END IF
- ELSE IF(ND .EQ. 2) THEN
- IF(X3 .LT. X4 .AND. X4 .LT. X5 .AND. X5 .LT. X6) THEN
- IF(X .LT. X4) THEN
- B2(1)=2/X4**2
- B2(2)=-2*(X4+X5)/(X4**2*X5)
- B2(3)=2/(X4*X5)
- B2(4)=0
- B2(5)=0
- ELSE IF(X4 .LE. X .AND. X .LT. X5) THEN
- B2(1)=0
- B2(2)=-2/((X4-X5)*X5)
- B2(3)=2*(X4-X5-1)/((X4-X5)*(X4-1)*X5)
- B2(4)=2/((X4-X5)*(X4-1))
- B2(5)=0
- ELSE
- B2(1)=0
- B2(2)=0
- B2(3)=2/((X4-1)*(X5-1))
- B2(4)=-2*(X4+X5-2)/((X4-1)*(X5-1)**2)
- B2(5)=2/(X5-1)**2
- END IF
- ELSE IF(X3 .LT. X4 .AND. X4 .EQ. X5 .AND. X5 .LT. X6) THEN
- IF(X .LT. X4) THEN
- B2(1)=2/X4**2
- B2(2)=-4/X4**2
- B2(3)=2/X4**2
- B2(4)=0
- B2(5)=0
- ELSE
- B2(1)=0
- B2(2)=0
- B2(3)=2/(X4-1)**2
- B2(4)=-4/(X4-1)**2
- B2(5)=2/(X4-1)**2
- END IF
- END IF
- ELSE IF(ND .EQ. -1) THEN
- IF(X3 .LT. X4 .AND. X4 .LT. X5 .AND. X5 .LT. X6) THEN
- IF(X .LT. X4) THEN
- B2(1)=(X**2/3-X*X4+X4**2)*X/X4**2
- B2(2)=-((X4+X5)*X-3*X4*X5)*X**2/(3*X4**2*X5)
- B2(3)=X**3/(3*X4*X5)
- B2(4)=0
- B2(5)=0
- ELSE IF(X4 .LE. X .AND. X .LT. X5) THEN
- B2(1)=X4/3
- B2(2)=-(X**3-3*X**2*X5+3*X*X5**2-X4*X5**2)/(3*(X4-X5)*X5)
- B2(3)=(X**3*(X4-X5-1)+3*X**2*X5-3*X*X4*X5+X4**2*X5)/
- 1 (3*(X4-X5)*(X4-1)*X5)
- B2(4)=(X-X4)**3/(3*(X4-X5)*(X4-1))
- B2(5)=0
- ELSE
- B2(1)=X4/3
- B2(2)=X5/3
- B2(3)=(X**3-3*X**2+3*X+X4*X5-X4-X5)/(3*(X4-1)*(X5-1))
- B2(4)=(X**3*(-X4-X5+2)+3*X**2*(X4*X5-1)+3*X*(-2*X4*
- 1 X5+X4+X5)-X4**2*X5**2+2*X4**2*X5-X4**2+2*X4*X5**2-
- 2 X4*X5-X5**2)/(3*(X4-1)*(X5-1)**2)
- B2(5)=(X-X5)**3/(3*(X5-1)**2)
- END IF
- ELSE IF(X3 .LT. X4 .AND. X4 .EQ. X5 .AND. X5 .LT. X6) THEN
- IF(X .LT. X4) THEN
- B2(1)=(X**2/3-X*X4+X4**2)*X/X4**2
- B2(2)=-(2*X-3*X4)*X**2/(3*X4**2)
- B2(3)=X**3/(3*X4**2)
- B2(4)=0
- B2(5)=0
- ELSE
- B2(1)=X4/3
- B2(2)=X4/3
- B2(3)=(X**3-3*X**2+3*X+X4**2-2*X4)/(3*(X4-1)**2)
- B2(4)=-(2*X+X4-3)*(X-X4)**2/(3*(X4-1)**2)
- B2(5)=(X-X4)**3/(3*(X4-1)**2)
- END IF
- END IF
- END IF
- RETURN
- END
-
-
-
diff --git a/src/mathlib/gen/e/splan3.F b/src/mathlib/gen/e/splan3.F
deleted file mode 100644
index 891a45e..0000000
--- a/src/mathlib/gen/e/splan3.F
+++ /dev/null
@@ -1,706 +0,0 @@
-*
-* $Id: splan3.F,v 1.1.1.1 1996/04/01 15:02:26 mclareni Exp $
-*
-* $Log: splan3.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:26 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE SPLAN3(B3,X,X4,X5,X6,X7,X8,ND)
-#include "gen/imp64.inc"
- DIMENSION B3(7)
-
-************************************************************************
-* NORBAS, VERSION: 15.03.1993
-************************************************************************
-*
-* TEST-ROUTINE SPLAN3
-* FOR COMPUTING 1-DIMENSIONAL B-SPLINES OF DEGREE K = 3
-* BY MEANS OF ANALYTIC FORMULAE
-*
-************************************************************************
-
- DO 1 I = 1,7
- 1 B3(I)=0
- IF(ND .LT. -1 .OR. ND .GT. 3) RETURN
- IF(X .LT. X4 .OR. X .GT. X8) RETURN
- IF(ND .EQ. 0) THEN
- IF(X4 .LT. X5 .AND. X5 .LT. X6 .AND. X6 .LT. X7
- 1 .AND. X7 .LT. X8) THEN
- IF(X .LT. X5) THEN
- B3(1)=((X5-X)/X5)**3
- B3(2)=(X*(((X-X6)*X5+(X-X5)*X6)*(X-X6)*X5+(X-X5)**2*X6**2))/
- 1 (X6**2*X5**3)
- B3(3)=(-X**2*(X*X7*X6+X*X7*X5+X*X6*X5-3*X7*X6*X5))/
- 1 (X7*(X6*X5)**2)
- B3(4)=X**3/(X7*X6*X5)
- B3(5)=0
- B3(6)=0
- B3(7)=0
- ELSE IF(X5 .LE. X .AND. X .LT. X6) THEN
- B3(1)=0
- B3(2)=(X6-X)**3/(X6**2*(X6-X5))
- B3(3)=(X*(X-X6)**2*(X7-X5)*X7+((X-X7)*(X-X5)*X6+(X-X6)*
- 1 (X7-X5)*X)*(X-X7)*X6)/((X7-X5)*(X6-X5)*X7*X6**2)
- B3(4)=(-(((X-X7)*(X5-1)*X-(X-X5)*(X-1)*X7)*(X-X5)*X6+
- 1 (X-X6)*(X7-X5)*(X5-1)*X**2))/((X7-X5)*(X6-X5)*(X5-1)*X7*X6)
- B3(5)=(X5-X)**3/((X7-X5)*(X6-X5)*(X5-1))
- B3(6)=0
- B3(7)=0
- ELSE IF(X6 .LE. X .AND. X .LT. X7) THEN
- B3(1)=0
- B3(2)=0
- B3(3)=(X7-X)**3/(X7*(X7-X6)*(X7-X5))
- B3(4)=(((X-X7)*(X5-1)*X-(X-X5)*(X-1)*X7)*(X-X7)*(X6-1)+
- 1 (X-X6)*(X-1)**2*(X7-X5)*X7)/
- 2 ((X7-X6)*(X7-X5)*(X6-1)*(X5-1)*X7)
- B3(5)=(((X-X7)*(X-X5)*(X6-1)-(X-X6)*(X-1)*(X7-X5))*(X-X5)
- 1 *(X6-1)-(X-X6)**2*(X-1)*(X7-X5)*(X5-1))/
- 2 ((X7-X6)*(X7-X5)*(X6-1)**2*(X5-1))
- B3(6)=(X-X6)**3/((X7-X6)*(X6-1)**2)
- B3(7)=0
- ELSE
- B3(1)=0
- B3(2)=0
- B3(3)=0
- B3(4)=(X-1)**3/((X7-1)*(X6-1)*(X5-1))
- B3(5)=(-(((X-X6)*(X5-1)+(X-X5)*(X6-1))*(X7-1)+(X-X7)*
- 1 (X6-1)*(X5-1))*(X-1)**2)/((X7-1)**2*(X6-1)**2*(X5-1))
- B3(6)=((((X-X7)*(X6-1)+(X-X6)*(X7-1))*(X-X6)*(X7-1)+
- 1 (X-X7)**2*(X6-1)**2)*(X-1))/((X7-1)**3*(X6-1)**2)
- B3(7)=((X7-X)/(X7-1))**3
- END IF
- ELSE IF(X4 .LT. X5 .AND. X5 .EQ. X6 .AND. X6 .LT. X7
- 1 .AND. X7 .LT. X8) THEN
- IF(X .LT. X5) THEN
- B3(1)=((X5-X)/X5)**3
- B3(2)=(3*X*(X-X5)**2)/X5**3
- B3(3)=(-X**2*((X-X7)*X5+2*(X-X5)*X7))/(X7*X5**3)
- B3(4)=X**3/(X7*X5**2)
- B3(5)=0
- B3(6)=0
- B3(7)=0
- ELSE IF(X5 .LE. X .AND. X .LT. X7) THEN
- B3(1)=0
- B3(2)=0
- B3(3)=(X7-X)**3/(X7*(X7-X5)**2)
- B3(4)=(((X-X7)*(X5-1)*X-(X-X5)*(X-1)*X7)*(X-X7)*(X5-1)+
- 1 (X-X5)*(X-1)**2*(X7-X5)*X7)/((X7-X5)**2*(X5-1)**2*X7)
- B3(5)=(((X-X7)*(X5-1)-2*(X-1)*(X7-X5))*(X-X5)**2)/
- 1 ((X7-X5)*(X5-1))**2
- B3(6)=(X-X5)**3/((X7-X5)*(X5-1)**2)
- B3(7)=0
- ELSE
- B3(1)=0
- B3(2)=0
- B3(3)=0
- B3(4)=(X-1)**3/((X7-1)*(X5-1)**2)
- B3(5)=(-((X-X7)*(X5-1)+2*(X-X5)*(X7-1))*(X-1)**2)/
- 1 ((X7-1)*(X5-1))**2
- B3(6)=((((X-X7)*(X5-1)+(X-X5)*(X7-1))*(X-X5)*(X7-1)+
- 1 (X-X7)**2*(X5-1)**2)*(X-1))/((X7-1)**3*(X5-1)**2)
- B3(7)=((X7-X)/(X7-1))**3
- END IF
- ELSE IF(X4 .LT. X5 .AND. X5 .LT. X6 .AND. X6 .EQ. X7
- 1 .AND. X7 .LT. X8) THEN
- IF(X .LT. X5) THEN
- B3(1)=((X5-X)/X5)**3
- B3(2)=(X*(((X-X6)*X5+(X-X5)*X6)*(X-X6)*X5+(X-X5)**2*X6**2))/
- 1 (X6**2*X5**3)
- B3(3)=(-X**2*(2*(X-X6)*X5+(X-X5)*X6))/(X6*X5)**2
- B3(4)=X**3/(X6**2*X5)
- B3(5)=0
- B3(6)=0
- B3(7)=0
- ELSE IF(X5 .LE. X .AND. X .LT. X6) THEN
- B3(1)=0
- B3(2)=(X6-X)**3/(X6**2*(X6-X5))
- B3(3)=(((X-X5)*X6+2*(X6-X5)*X)*(X-X6)**2)/((X6-X5)*X6)**2
- B3(4)=(-(((X-X6)*(X5-1)*X-(X-X5)*(X-1)*X6)*(X-X5)*X6+
- 1 (X-X6)*(X6-X5)*(X5-1)*X**2))/((X6-X5)**2*(X5-1)*X6**2)
- B3(5)=(X5-X)**3/((X6-X5)**2*(X5-1))
- B3(6)=0
- B3(7)=0
- ELSE
- B3(1)=0
- B3(2)=0
- B3(3)=0
- B3(4)=(X-1)**3/((X6-1)**2*(X5-1))
- B3(5)=(-(2*(X-X6)*(X5-1)+(X-X5)*(X6-1))*(X-1)**2)/
- 1 ((X6-1)**3*(X5-1))
- B3(6)=3*(X-1)*(X6-X)**2/(X6-1)**3
- B3(7)=((X6-X)/(X6-1))**3
- END IF
- ELSE IF(X4 .LT. X5 .AND. X5 .EQ. X6 .AND. X6 .EQ. X7
- 1 .AND. X7 .LT. X8) THEN
- IF(X .LT. X5) THEN
- B3(1)=((X5-X)/X5)**3
- B3(2)=3*X*(X5-X)**2/X5**3
- B3(3)=3*X**2*(X5-X)/X5**3
- B3(4)=(X/X5)**3
- B3(5)=0
- B3(6)=0
- B3(7)=0
- ELSE
- B3(1)=0
- B3(2)=0
- B3(3)=0
- B3(4)=((X-1)/(X5-1))**3
- B3(5)=3*(X-1)**2*(X5-X)/(X5-1)**3
- B3(6)=3*(X-1)*(X5-X)**2/(X5-1)**3
- B3(7)=((X5-X)/(X5-1))**3
- END IF
- END IF
- ELSE IF(ND .EQ. 1) THEN
- IF(X4 .LT. X5 .AND. X5 .LT. X6 .AND. X6 .LT. X7
- 1 .AND. X7 .LT. X8) THEN
- IF(X .LT. X5) THEN
- B3(1)=-3*(X-X5)**2/X5**3
- B3(2)=3*(X**2*(X6**2+X6*X5+X5**2)-2*X*(X6**2*X5+X6*X5**2)
- . +X6**2*X5**2)/(X6**2*X5**3)
- B3(3)=-3*(X*(X7*X6+X7*X5+X6*X5)-2*X7*X6*X5)*X/(X7*X6**2*X5**2)
- B3(4)=3*X**2/(X7*X6*X5)
- B3(5)=0
- B3(6)=0
- B3(7)=0
- ELSE IF(X5 .LE. X .AND. X .LT. X6) THEN
- B3(1)=0
- B3(2)=-3*(X-X6)**2/((X6-X5)*X6**2)
- B3(3)=3*(X**2*(X7**2+X7*X6-X7*X5+X6**2-X6*X5)+
- . 2*X*(-X7**2*X6-X7*X6**2+X7*X6*X5)+X7**2*X6**2)/
- . ((X7-X5)*(X6-X5)*X7*X6**2)
- B3(4)=3*(X**2*(X7*X6-X7*X5+X7-X6*X5+X6+X5**2-X5)
- . -2*X*X7*X6+X7*X6*X5)/((X7-X5)*(X6-X5)*(X5-1)*X7*X6)
- B3(5)=-3*(X-X5)**2/((X7-X5)*(X6-X5)*(X5-1))
- B3(6)=0
- B3(7)=0
- ELSE IF(X6 .LE. X .AND. X .LT. X7) THEN
- B3(1)=0
- B3(2)=0
- B3(3)=-3*(X-X7)**2/((X7-X6)*(X7-X5)*X7)
- B3(4)=3*(X**2*(X7**2-X7*X6-X7*X5+X7+X6*X5-X6-X5+1)+
- . 2*X*(-X7**2+X7*X6+X7*X5-X7)+X7**2-X7*X6*X5)/
- . ((X7-X6)*(X7-X5)*(X6-1)*(X5-1)*X7)
- B3(5)=(((X-X7)*(X-X5)*(X6-1)-(X-X6)*(X-1)*(X7-X5))*
- . (X6-1)-2*(X*X7-X*X6-X*X5+X-X7+X6*X5)*(X-X5)*(X6-1)-
- . (X-X6)**2*(X7-X5)*(X5-1)-2*(X-X6)*(X-1)*(X7-X5)*(X5-1))/
- . ((X7-X6)*(X7-X5)*(X6-1)**2*(X5-1))
- B3(6)=3*(X-X6)**2/((X7-X6)*(X6-1)**2)
- B3(7)=0
- ELSE
- B3(1)=0
- B3(2)=0
- B3(3)=0
- B3(4)=3*(X-1)**2/((X7-1)*(X6-1)*(X5-1))
- B3(5)=-3*(X*(X7*X6+X7*X5-2*X7+X6*X5-2*X6-2*X5+3)
- . -2*X7*X6*X5+X7*X6+X7*X5+X6*X5-1)*(X-1)/
- . ((X7-1)**2*(X6-1)**2*(X5-1))
- B3(6)=3*(X**2*(X7**2+X7*X6-3*X7+X6**2-3*X6+3)+
- . X*(-2*X7**2*X6-2*X7*X6**2+6*X7*X6-2)
- . +X7**2*X6**2-3*X7*X6+X7+X6)/((X7-1)**3*(X6-1)**2)
- B3(7)=-3*(X-X7)**2/(X7-1)**3
- END IF
- ELSE IF(X4 .LT. X5 .AND. X5 .EQ. X6 .AND. X6 .LT. X7
- 1 .AND. X7 .LT. X8) THEN
- IF(X .LT. X5) THEN
- B3(1)=-3*(X-X5)**2/X5**3
- B3(2)=3*(3*X-X5)*(X-X5)/X5**3
- B3(3)=(3*X**2*(-2*X7-X5)+6*X*X7*X5)/(X7*X5**3)
- B3(4)=3*X**2/(X7*X5**2)
- B3(5)=0
- B3(6)=0
- B3(7)=0
- ELSE IF(X5 .LE. X .AND. X .LT. X7) THEN
- B3(1)=0
- B3(2)=0
- B3(3)=-3*(X-X7)**2/((X7-X5)**2*X7)
- B3(4)=3*(X**2*(X7**2-2*X7*X5+X7+X5**2-2*X5+1)+
- . X*(-2*X7**2+4*X7*X5-2*X7)+X7**2-X7*X5**2)/
- . ((X7-X5)**2*(X5-1)**2*X7)
- B3(5)=-3*(X*(2*X7-3*X5+1)-2*X7+X5**2+X5)*(X-X5)/
- . ((X7-X5)**2*(X5-1)**2)
- B3(6)=3*(X-X5)**2/((X7-X5)*(X5-1)**2)
- B3(7)=0
- ELSE
- B3(1)=0
- B3(2)=0
- B3(3)=0
- B3(4)=3*(X-1)**2/((X7-1)*(X5-1)**2)
- B3(5)=-3*(X*(2*X7+X5-3)-2*X7*X5+X5+1)*(X-1)/
- . ((X7-1)**2*(X5-1)**2)
- B3(6)=3*(X**2*(X7**2+X7*X5-3*X7+X5**2-3*X5+3)+
- . X*(-2*X7**2*X5-2*X7*X5**2+6*X7*X5-2)
- . +X7**2*X5**2-3*X7*X5+X7+X5)/((X7-1)**3*(X5-1)**2)
- B3(7)=-3*(X-X7)**2/(X7-1)**3
- END IF
- ELSE IF(X4 .LT. X5 .AND. X5 .LT. X6 .AND. X6 .EQ. X7
- 1 .AND. X7 .LT. X8) THEN
- IF(X .LT. X5) THEN
- B3(1)=-3*(X-X5)**2/X5**3
- B3(2)=(3*X**2*(X6**2+X6*X5+X5**2)-(6*X*X6*X5)*(X6+X5)+3
- . *X6**2*X5**2)/(X6**2*X5**3)
- B3(3)=(3*X**2*(-X6-2*X5)+6*X*X6*X5)/(X6**2*X5**2)
- B3(4)=3*X**2/(X6**2*X5)
- B3(5)=0
- B3(6)=0
- B3(7)=0
- ELSE IF(X5 .LE. X .AND. X .LT. X6) THEN
- B3(1)=0
- B3(2)=-3*(X-X6)**2/((X6-X5)*X6**2)
- B3(3)=3*(X*(3*X6-2*X5)-X6**2)*(X-X6)/((X6-X5)**2*X6**2)
- B3(4)=3*(X**2*(X6**2-2*X6*X5+2*X6+X5**2-X5)
- . -2*X*X6**2+X6**2*X5)/((X6-X5)**2*(X5-1)*X6**2)
- B3(5)=-3*(X-X5)**2/((X6-X5)**2*(X5-1))
- B3(6)=0
- B3(7)=0
- ELSE
- B3(1)=0
- B3(2)=0
- B3(3)=0
- B3(4)=3*(X-1)**2/((X6-1)**2*(X5-1))
- B3(5)=-3*(X*(X6+2*X5-3)-2*X6*X5+X6+1)*(X-1)/
- . ((X6-1)**3*(X5-1))
- B3(6)=3*(3*X-X6-2)*(X-X6)/(X6-1)**3
- B3(7)=-3*(X-X6)**2/(X6-1)**3
- END IF
- ELSE IF(X4 .LT. X5 .AND. X5 .EQ. X6 .AND. X6 .EQ. X7
- 1 .AND. X7 .LT. X8) THEN
- IF(X .LT. X5) THEN
- B3(1)=-3*(X-X5)**2/X5**3
- B3(2)=3*(3*X-X5)*(X-X5)/X5**3
- B3(3)=-3*(2*(X-X5)+X)*X/X5**3
- B3(4)=3*X**2/X5**3
- B3(5)=0
- B3(6)=0
- B3(7)=0
- ELSE
- B3(1)=0
- B3(2)=0
- B3(3)=0
- B3(4)=3*(X-1)**2/(X5-1)**3
- B3(5)=-3*(2*(X-X5)+(X-1))*(X-1)/(X5-1)**3
- B3(6)=3*(3*X-X5-2)*(X-X5)/(X5-1)**3
- B3(7)=-3*(X-X5)**2/(X5-1)**3
- END IF
- END IF
- ELSE IF(ND .EQ. 2) THEN
- IF(X4 .LT. X5 .AND. X5 .LT. X6 .AND. X6 .LT. X7
- 1 .AND. X7 .LT. X8) THEN
- IF(X .LT. X5) THEN
- B3(1)=6*(-X+X5)/X5**3
- B3(2)=(6*X*(X6**2+X6*X5+X5**2)-(6*X6*X5)*(X6+X5))/(X6**2*X5**3)
- B3(3)=(-6*X*(X7*X6+X7*X5+X6*X5)+6*X7*X6*X5)/(X7*X6**2*X5**2)
- B3(4)=6*X/(X7*X6*X5)
- B3(5)=0
- B3(6)=0
- B3(7)=0
- ELSE IF(X5 .LE. X .AND. X .LT. X6) THEN
- B3(1)=0
- B3(2)=-6*(X-X6)/((X6-X5)*X6**2)
- B3(3)=6*(((X6-X5)*X7+X7**2+X6**2-X6*X5)*X-(X6-X5)*X7*
- . X6-X7**2*X6)/((X7-X5)*(X6-X5)*X7*X6**2)
- B3(4)=6*(((X6-X5+1)*X7-(X5-1)*X6+X5**2-X5)*X-X7*X6)/
- . ((X7-X5)*(X6-X5)*(X5-1)*X7*X6)
- B3(5)=-6*(X-X5)/((X7-X5)*(X6-X5)*(X5-1))
- B3(6)=0
- B3(7)=0
- ELSE IF(X6 .LE. X .AND. X .LT. X7) THEN
- B3(1)=0
- B3(2)=0
- B3(3)=-6*(X-X7)/((X7-X6)*(X7-X5)*X7)
- B3(4)=-6*(((X6+X5-1)*X7-(X5-1)*X6-X7**2+X5-1)*X-
- . (X6+X5-1)*X7+X7**2)/((X7-X6)*(X7-X5)*(X6-1)*(X5-1)*X7)
- B3(5)=-6*(X*(X7*X6+X7*X5-2*X7-X6**2-X6*X5+2*X6-X5**2+2*X5-1)
- . -X7*X6*X5+X7+X6**2*X5+X6*X5**2-2*X6*X5)/
- . ((X7-X6)*(X7-X5)*(X6-1)**2*(X5-1))
- B3(6)=6*(X-X6)/((X7-X6)*(X6-1)**2)
- B3(7)=0
- ELSE
- B3(1)=0
- B3(2)=0
- B3(3)=0
- B3(4)=6*(X-1)/((X7-1)*(X6-1)*(X5-1))
- B3(5)=-6*(X*(X7*X6+X7*X5-2*X7+X6*X5-2*X6-2*X5+3)
- . -X7*X6*X5+X7+X6+X5-2)/((X7-1)**2*(X6-1)**2*(X5-1))
- B3(6)=6*(((X6-3)*X7+X7**2+X6**2-3*X6+3)*X-(X6-3)*
- . X7*X6-X7**2*X6-1)/((X7-1)**3*(X6-1)**2)
- B3(7)=-6*(X-X7)/(X7-1)**3
- END IF
- ELSE IF(X4 .LT. X5 .AND. X5 .EQ. X6 .AND. X6 .LT. X7
- 1 .AND. X7 .LT. X8) THEN
- IF(X .LT. X5) THEN
- B3(1)=6*(-X+X5)/X5**3
- B3(2)=(18*X-12*X5)/X5**3
- B3(3)=(6*X*(-2*X7-X5)+6*X7*X5)/(X7*X5**3)
- B3(4)=6*X/(X7*X5**2)
- B3(5)=0
- B3(6)=0
- B3(7)=0
- ELSE IF(X5 .LE. X .AND. X .LT. X7) THEN
- B3(1)=0
- B3(2)=0
- B3(3)=-6*(X-X7)/((X7-X5)**2*X7)
- B3(4)=-6*(((2*X5-1)*X7-X7**2-X5**2+2*X5-1)*X-
- . (2*X5-1)*X7+X7**2)/((X7-X5)**2*(X5-1)**2*X7)
- B3(5)=-6*(X*(2*X7-3*X5+1)-X7*X5-X7+2*X5**2)/
- . ((X7-X5)**2*(X5-1)**2)
- B3(6)=6*(X-X5)/((X7-X5)*(X5-1)**2)
- B3(7)=0
- ELSE
- B3(1)=0
- B3(2)=0
- B3(3)=0
- B3(4)=6*(X-1)/((X7-1)*(X5-1)**2)
- B3(5)=-6*(X*(2*X7+X5-3)-X7*X5-X7+2)/((X7-1)**2*(X5-1)**2)
- B3(6)=6*(((X5-3)*X7+X7**2+X5**2-3*X5+3)*X-(X5-3)*
- . X7*X5-X7**2*X5-1)/((X7-1)**3*(X5-1)**2)
- B3(7)=-6*(X-X7)/(X7-1)**3
- END IF
- ELSE IF(X4 .LT. X5 .AND. X5 .LT. X6 .AND. X6 .EQ. X7
- 1 .AND. X7 .LT. X8) THEN
- IF(X .LT. X5) THEN
- B3(1)=6*(-X+X5)/X5**3
- B3(2)=(6*X*(X6**2+X6*X5+X5**2)-(6*X6*X5)*(X6+X5))/(X6**2*X5**3)
- B3(3)=(6*X*(-X6-2*X5)+6*X6*X5)/(X6**2*X5**2)
- B3(4)=6*X/(X6**2*X5)
- B3(5)=0
- B3(6)=0
- B3(7)=0
- ELSE IF(X5 .LE. X .AND. X .LT. X6) THEN
- B3(1)=0
- B3(2)=-6*(X-X6)/((X6-X5)*X6**2)
- B3(3)=6*(3*X*X6-2*X*X5-2*X6**2+X6*X5)/((X6-X5)**2*X6**2)
- B3(4)=-6*((2*(X5-1)*X6-X6**2-X5**2+X5)*X+X6**2)/
- . ((X6-X5)**2*(X5-1)*X6**2)
- B3(5)=-6*(X-X5)/((X6-X5)**2*(X5-1))
- B3(6)=0
- B3(7)=0
- ELSE
- B3(1)=0
- B3(2)=0
- B3(3)=0
- B3(4)=6*(X-1)/((X6-1)**2*(X5-1))
- B3(5)=-6*(X*(X6+2*X5-3)-X6*X5-X5+2)/((X6-1)**3*(X5-1))
- B3(6)=6*(3*X-2*X6-1)/(X6-1)**3
- B3(7)=-6*(X-X6)/(X6-1)**3
- END IF
- ELSE IF(X4 .LT. X5 .AND. X5 .EQ. X6 .AND. X6 .EQ. X7
- 1 .AND. X7 .LT. X8) THEN
- IF(X .LT. X5) THEN
- B3(1)=6*(-X+X5)/X5**3
- B3(2)=(18*X-12*X5)/X5**3
- B3(3)=(-18*X+6*X5)/X5**3
- B3(4)=6*X/X5**3
- B3(5)=0
- B3(6)=0
- B3(7)=0
- ELSE
- B3(1)=0
- B3(2)=0
- B3(3)=0
- B3(4)=6*(X-1)/(X5-1)**3
- B3(5)=-6*(3*X-X5-2)/(X5-1)**3
- B3(6)=6*(3*X-2*X5-1)/(X5-1)**3
- B3(7)=-6*(X-X5)/(X5-1)**3
- END IF
- END IF
- ELSE IF(ND .EQ. 3) THEN
- IF(X4 .LT. X5 .AND. X5 .LT. X6 .AND. X6 .LT. X7
- 1 .AND. X7 .LT. X8) THEN
- IF(X .LT. X5) THEN
- B3(1)=-6/X5**3
- B3(2)=6*(X6**2+X6*X5+X5**2)/(X6**2*X5**3)
- B3(3)=-6*(X7*X6+X7*X5+X6*X5)/(X7*X6**2*X5**2)
- B3(4)=6/(X7*X6*X5)
- B3(5)=0
- B3(6)=0
- B3(7)=0
- ELSE IF(X5 .LE. X .AND. X .LT. X6) THEN
- B3(1)=0
- B3(2)=-6/(X6**2*(X6-X5))
- B3(3)=6*((X6-X5)*X7+X7**2+X6**2-X6*X5)/
- . ((X7-X5)*(X6-X5)*X7*X6**2)
- B3(4)=6*((X6-X5+1)*X7-(X5-1)*X6+X5**2-X5)/
- . ((X7-X5)*(X6-X5)*(X5-1)*X7*X6)
- B3(5)=-6/((X7-X5)*(X6-X5)*(X5-1))
- B3(6)=0
- B3(7)=0
- ELSE IF(X6 .LE. X .AND. X .LT. X7) THEN
- B3(1)=0
- B3(2)=0
- B3(3)=-6/((X7-X6)*(X7-X5)*X7)
- B3(4)=-6*((X6+X5-1)*X7-(X5-1)*X6-X7**2+X5-1)/
- . ((X7-X6)*(X7-X5)*(X6-1)*(X5-1)*X7)
- B3(5)=-6*((X6+X5-2)*X7-(X5-2)*X6-X6**2-X5**2+2*X5-1)/
- . ((X7-X6)*(X7-X5)*(X6-1)**2*(X5-1))
- B3(6)=6/((X7-X6)*(X6-1)**2)
- B3(7)=0
- ELSE
- B3(1)=0
- B3(2)=0
- B3(3)=0
- B3(4)=6/((X7-1)*(X6-1)*(X5-1))
- B3(5)=-6*((X6+X5-2)*X7+(X5-2)*X6-2*X5+3)/
- . ((X7-1)**2*(X6-1)**2*(X5-1))
- B3(6)=6*((X6-3)*X7+X7**2+X6**2-3*X6+3)/((X7-1)**3*(X6-1)**2)
- B3(7)=-6/(X7-1)**3
- END IF
- ELSE IF(X4 .LT. X5 .AND. X5 .EQ. X6 .AND. X6 .LT. X7
- 1 .AND. X7 .LT. X8) THEN
- IF(X .LT. X5) THEN
- B3(1)=-6/X5**3
- B3(2)=18/X5**3
- B3(3)=6*(-2*X7-X5)/(X7*X5**3)
- B3(4)=6/(X7*X5**2)
- B3(5)=0
- B3(6)=0
- B3(7)=0
- ELSE IF(X5 .LE. X .AND. X .LT. X7) THEN
- B3(1)=0
- B3(2)=0
- B3(3)=-6/((X7-X5)**2*X7)
- B3(4)=-6*((2*X5-1)*X7-X7**2-X5**2+2*X5-1)/
- . ((X7-X5)**2*(X5-1)**2*X7)
- B3(5)=-6*(2*X7-3*X5+1)/((X7-X5)**2*(X5-1)**2)
- B3(6)=6/((X7-X5)*(X5-1)**2)
- B3(7)=0
- ELSE
- B3(1)=0
- B3(2)=0
- B3(3)=0
- B3(4)=6/((X7-1)*(X5-1)**2)
- B3(5)=-6*(2*X7+X5-3)/((X7-1)**2*(X5-1)**2)
- B3(6)=6*((X5-3)*X7+X7**2+X5**2-3*X5+3)/((X7-1)**3*(X5-1)**2)
- B3(7)=-6/(X7-1)**3
- END IF
- ELSE IF(X4 .LT. X5 .AND. X5 .LT. X6 .AND. X6 .EQ. X7
- 1 .AND. X7 .LT. X8) THEN
- IF(X .LT. X5) THEN
- B3(1)=-6/X5**3
- B3(2)=6*(X6**2+X6*X5+X5**2)/(X6**2*X5**3)
- B3(3)=6*(-X6-2*X5)/(X6**2*X5**2)
- B3(4)=6/(X6**2*X5)
- B3(5)=0
- B3(6)=0
- B3(7)=0
- ELSE IF(X5 .LE. X .AND. X .LT. X6) THEN
- B3(1)=0
- B3(2)=-6/(X6**2*(X6-X5))
- B3(3)=6*(3*X6-2*X5)/((X6-X5)**2*X6**2)
- B3(4)=-6*(2*(X5-1)*X6-X6**2-X5**2+X5)/((X6-X5)**2*(X5-1)*X6**2)
- B3(5)=-6/((X6-X5)**2*(X5-1))
- B3(6)=0
- B3(7)=0
- ELSE
- B3(1)=0
- B3(2)=0
- B3(3)=0
- B3(4)=6/((X6-1)**2*(X5-1))
- B3(5)=-6*(X6+2*X5-3)/((X6-1)**3*(X5-1))
- B3(6)=18/(X6-1)**3
- B3(7)=-6/(X6-1)**3
- END IF
- ELSE IF(X4 .LT. X5 .AND. X5 .EQ. X6 .AND. X6 .EQ. X7
- 1 .AND. X7 .LT. X8) THEN
- IF(X .LT. X5) THEN
- B3(1)=-6/X5**3
- B3(2)=18/X5**3
- B3(3)=-18/X5**3
- B3(4)=6/X5**3
- B3(5)=0
- B3(6)=0
- B3(7)=0
- ELSE
- B3(1)=0
- B3(2)=0
- B3(3)=0
- B3(4)=6/(X5-1)**3
- B3(5)=-18/(X5-1)**3
- B3(6)=18/(X5-1)**3
- B3(7)=-6/(X5-1)**3
- END IF
- END IF
- ELSE IF(ND .EQ. -1) THEN
- IF(X4 .LT. X5 .AND. X5 .LT. X6 .AND. X6 .LT. X7
- 1 .AND. X7 .LT. X8) THEN
- IF(X .LT. X5) THEN
- B3(1)=-(X**2-2*X*X5+2*X5**2)*(X-2*X5)*X/(4*X5**3)
- B3(2)=((X6**2+X6*X5+X5**2)*X**2-4*(X6+X5)*X*X6*X5+
- . 6*X6**2*X5**2)*X**2/(4*X6**2*X5**3)
- B3(3)=-(((X6+X5)*X7+X6*X5)*X-4*X7*X6*X5)*X**3/
- . (4*X7*X6**2*X5**2)
- B3(4)=X**4/(4*X7*X6*X5)
- B3(5)=0
- B3(6)=0
- B3(7)=0
- ELSE IF(X5 .LE. X .AND. X .LT. X6) THEN
- B3(1)=X5/4
- B3(2)=-(X**4-4*X**3*X6+6*X**2*X6**2-4*X*X6**3+X6**3*X5)/
- . (4*(X6-X5)*X6**2)
- B3(3)=(X**4*(X7**2+X7*X6-X7*X5+X6**2-X6*X5)+
- . X**3*(-4*X7**2*X6-4*X7*X6**2+4*X7*X6*X5)+
- . 6*X**2**X7**2*X6**2-4*X*X7**2*X6**2*X5+X7**2*X6**2*X5**2)/
- . (4*(X7-X5)*(X6-X5)*X7*X6**2)
- B3(4)=(X**4*(X7*X6-X7*X5+X7-X6*X5+X6+X5**2-X5)
- . -4*X**3*X7*X6+6*X**2*X7*X6*X5-4*X*X7*X6*X5**2+X7*X6*X5**3)/
- . (4*(X7-X5)*(X6-X5)*(X5-1)*X7*X6)
- B3(5)=-(X-X5)**4/(4*(X7-X5)*(X6-X5)*(X5-1))
- B3(6)=0
- B3(7)=0
- ELSE IF(X6 .LE. X .AND. X .LT. X7) THEN
- B3(1)=X5/4
- B3(2)=X6/4
- B3(3)=-(X**4-4*X**3*X7+6*X**2*X7**2-4*X*X7**3+X7**3*X6
- . +X7**3*X5-X7**2*X6*X5)/(4*(X7-X6)*(X7-X5)*X7)
- B3(4)=(X**4*(X7**2-X7*X6-X7*X5+X7+X6*X5-X6-X5+1)+
- . X**3*(-4*X7**2+4*X7*X6+4*X7*X5-4*X7)+
- . X**2*(6*X7**2-6*X7*X6*X5)+
- . X*(4*X7**2*X6*X5-4*X7**2*X6-4*X7**2*X5+4*X7*X6*X5)+
- . X7**2*(-X6**2*X5+X6**2-X6*X5**2+X6*X5+X5**2)+
- . X7*(X6**2*X5**2-X6**2*X5-X6*X5**2))/
- . (4*(X7-X6)*(X7-X5)*(X6-1)*(X5-1)*X7)
- B3(5)=(-(X**4*(X7*X6+X7*X5-2*X7-X6**2-X6*X5
- . +2*X6-X5**2+2*X5-1)+
- . X**3*(-4*X7*X6*X5+4*X7+4*X6**2*X5+4*X6*X5**2-8*X6*X5)+
- . X**2*(12*X7*X6*X5-6*X7*X6-6*X7*X5-6*X6**2*X5**2+6*X6*X5)+
- . X*(4*X7*X6**2*X5**2-
- . 8*X7*X6**2*X5+4*X7*X6**2-8*X7*X6*X5**2+4*X7*X6*X5+
- . 4*X7*X5**2+8*X6**2*X5**2-4*X6**2*X5-4*X6*X5**2)+
- . X7*(-X6**3*X5**2+2*X6**3*X5-X6**3-X6**2*X5**3
- . +2*X6**2*X5**2-X6**2*X5+2*X6*X5**3-X6*X5**2-X5**3)+
- . X6**3*(X5**3-2*X5**2+X5)+X6**2*(-2*X5**3+X5**2)+X6*X5**3))/
- . (4*(X7-X6)*(X7-X5)*(X6-1)**2*(X5-1))
- B3(6)=(X-X6)**4/(4*(X7-X6)*(X6-1)**2)
- B3(7)=0
- ELSE
- B3(1)=X5/4
- B3(2)=X6/4
- B3(3)=X7/4
- B3(4)=(X**4-4*X**3+6*X**2-4*X+X7*X6*X5-X7*X6-X7*X5+X7-
- . X6*X5+X6+X5)/(4*(X7-1)*(X6-1)*(X5-1))
- B3(5)=(-(X**4*(X7*X6+X7*X5-2*X7+X6*X5-2*X6-2*X5+3)+
- . X**3*(-4*X7*X6*X5+4*X7+4*X6+4*X5-8)+
- . X**2*(12*X7*X6*X5-6*X7*X6-6*X7*X5-6*X6*X5+6)+
- . X*(-12*X7*X6*X5+8*X7*X6+8*X7*X5-4*X7+8*X6*X5-4*X6-4*X5)+
- . X7**2*(X6**2*X5**2-2*X6**2*X5+X6**2-
- . 2*X6*X5**2+4*X6*X5-2*X6+X5**2-2*X5+1)+
- . X7*(-2*X6**2*X5**2+4*X6**2*X5-2*X6**2+
- . 4*X6*X5**2-4*X6*X5+X6-2*X5**2+X5)+X6**2*X5**2
- . -2*X6**2*X5+X6**2-2*X6*X5**2+X6*X5+X5**2))/
- . (4*(X7-1)**2*(X6-1)**2*(X5-1))
- B3(6)=(X**4*(X7**2+X7*X6-3*X7+X6**2-3*X6+3)+
- . X**3*(-4*X7**2*X6-4*X7*X6**2+12*X7*X6-4)+
- . X**2*(6*X7**2*X6**2-18*X7*X6+6*X7+6*X6)+
- . X*(-12*X7**2*X6**2+12*X7**2*X6-4*X7**2
- . +12*X7*X6**2-4*X7*X6-4*X6**2)+
- . X7**3*(-X6**3+3*X6**2-3*X6+1)+X7**2*(3*X6**3-3*X6**2+X6)+
- . X7*(-3*X6**3+X6**2)+X6**3)/(4*(X7-1)**3*(X6-1)**2)
- B3(7)=-(X-X7)**4/(4*(X7-1)**3)
- END IF
- ELSE IF(X4 .LT. X5 .AND. X5 .EQ. X6 .AND. X6 .LT. X7
- 1 .AND. X7 .LT. X8) THEN
- IF(X .LT. X5) THEN
- B3(1)=-(X**2-2*X*X5+2*X5**2)*(X-2*X5)*X/(4*X5**3)
- B3(2)=(3*X**2-8*X*X5+6*X5**2)*X**2/(4*X5**3)
- B3(3)=-((2*X7+X5)*X-4*X7*X5)*X**3/(4*X7*X5**3)
- B3(4)=X**4/(4*X7*X5**2)
- B3(5)=0
- B3(6)=0
- B3(7)=0
- ELSE IF(X5 .LE. X .AND. X .LT. X7) THEN
- B3(1)=X5/4
- B3(2)=X5/4
- B3(3)=-(X**2-2*X*X7+2*X7**2-X7*X5)*(X**2-2*X*X7+X7*X5)/
- . (4*(X7-X5)**2*X7)
- B3(4)=(X**4*(X7**2-2*X7*X5+X7+X5**2-2*X5+1)+
- . X**3*(-4*X7**2+8*X7*X5-4*X7)+X**2*(6*X7**2-6*X7*X5**2)+
- . X*(4*X7**2*X5**2-8*X7**2*X5+4*X7*X5**2)+
- . X7**2*(-2*X5**3+3*X5**2)+X7*(X5**4-2*X5**3))/
- . (4*(X7-X5)**2*(X5-1)**2*X7)
- B3(5)=-(2*X*X7-3*X*X5+X+2*X7*X5-4*X7-X5**2+3*X5)*(X-X5)**3/
- . (4*(X7-X5)**2*(X5-1)**2)
- B3(6)=(X-X5)**4/(4*(X7-X5)*(X5-1)**2)
- B3(7)=0
- ELSE
- B3(1)=X5/4
- B3(2)=X5/4
- B3(3)=X7/4
- B3(4)=(X**4-4*X**3+6*X**2-4*X+X7*(X5**2-2*X5+1)-X5**2+2*X5)/
- . (4*(X7-1)*(X5-1)**2)
- B3(5)=-(X**4*(2*X7+X5-3)+X**3*(-4*X7*X5-4*X7+8)+
- . X**2*(12*X7*X5-6*X5-6)+X*(-12*X7*X5+4*X7+8*X5)+
- . X7**2*(X5**3-3*X5**2+3*X5-1)+
- . X7*(-2*X5**3+6*X5**2-2*X5)+X5**3-3*X5**2)/
- . (4*(X7-1)**2*(X5-1)**2)
- B3(6)=(X**4*(X7**2+X7*X5-3*X7+X5**2-3*X5+3)+
- . X**3*(-4*X7**2*X5-4*X7*X5**2+12*X7*X5-4)+
- . X**2*(6*X7**2*X5**2-18*X7*X5+6*X7+6*X5)+
- . X*(-12*X7**2*X5**2+12*X7**2*X5-4*X7**2
- . +12*X7*X5**2-4*X7*X5-4*X5**2)+
- . X7**3*(-X5**3+3*X5**2-3*X5+1)+X7**2*(3*X5**3-3*X5**2+X5)+
- . X7*(-3**X5**3+X5**2)+X5**3)/(4*(X7-1)**3*(X5-1)**2)
- B3(7)=-(X-X7)**4/(4*(X7-1)**3)
- END IF
- ELSE IF(X4 .LT. X5 .AND. X5 .LT. X6 .AND. X6 .EQ. X7
- 1 .AND. X7 .LT. X8) THEN
- IF(X .LT. X5) THEN
- B3(1)=-(X**2-2*X*X5+2*X5**2)*(X-2*X5)*X/(4*X5**3)
- B3(2)=(((X6**2+X6*X5+X5**2)*X**2-4*(X6+X5)*X*X6*X5
- . +6*X6**2*X5**2)*X**2)/(4*X6**2*X5**3)
- B3(3)=-((X6+2*X5)*X-4*X6*X5)*X**3/(4*X6**2*X5**2)
- B3(4)=X**4/(4*X6**2*X5)
- B3(5)=0
- B3(6)=0
- B3(7)=0
- ELSE IF(X5 .LE. X .AND. X .LT. X6) THEN
- B3(1)=X5/4
- B3(2)=-(X**4-4*X**3*X6+6*X**2*X6**2-4*X*X6**3+X6**3*X5)/
- . (4*(X6-X5)*X6**2)
- B3(3)=(X**4*(3*X6-2*X5)+X**3*(-8*X6**2+4*X6*X5)+
- . 6*X**2*X6**3-4*X*X6**3*X5+X6**3*X5**2)/(4*(X6-X5)**2*X6**2)
- B3(4)=(X**4*(X6**2-2*X6*X5+2*X6+X5**2-X5)
- . -4*X**3*X6**2+6*X**2*X6**2*X5-4*X*X6**2*X5**2+X6**2*X5**3)/
- . (4*(X6-X5)**2*(X5-1)*X6**2)
- B3(5)=-(X-X5)**4/(4*(X6-X5)**2*(X5-1))
- B3(6)=0
- B3(7)=0
- ELSE
- B3(1)=X5/4
- B3(2)=X6/4
- B3(3)=X6/4
- B3(4)=(X**4-4*X**3+6*X**2-4*X+X6**2*X5-X6**2-2*X6*X5+2*X6+X5)/
- . (4*(X6-1)**2*(X5-1))
- B3(5)=-(X**4*(X6+2*X5-3)+X**3*(-4*X6*X5-4*X5+8)+
- . X**2*(12*X6*X5-6*X6-6)+X*(-12*X6*X5+8*X6+4*X5)+
- . X6**3*(X5**2-2*X5+1)+
- . X6**2*(-3*X5**2+6*X5-3)+3*X6*X5**2-2*X6*X5-X5**2)/
- . (4*(X6-1)**3*(X5-1))
- B3(6)=(3*X+X6-4)*(X-X6)**3/(4*(X6-1)**3)
- B3(7)=-(X-X6)**4/(4*(X6-1)**3)
- END IF
- ELSE IF(X4 .LT. X5 .AND. X5 .EQ. X6 .AND. X6 .EQ. X7
- 1 .AND. X7 .LT. X8) THEN
- IF(X .LT. X5) THEN
- B3(1)=-(X**2-2*X*X5+2*X5**2)*(X-2*X5)*X/(4*X5**3)
- B3(2)=(3*X**2-8*X*X5+6*X5**2)*X**2/(4*X5**3)
- B3(3)=-(3*X-4*X5)*X**3/(4*X5**3)
- B3(4)=X**4/(4*X5**3)
- B3(5)=0
- B3(6)=0
- B3(7)=0
- ELSE
- B3(1)=X5/4
- B3(2)=X5/4
- B3(3)=X5/4
- B3(4)=(X**4-4*X**3+6*X**2-4*X+X5**3-3*X5**2+3*X5)/(4*(X5-1)**3)
- B3(5)=-(3*X**2+X*(2*X5-8)+X5**2-4*X5+6)*(X-X5)**2/(4*(X5-1)**3)
- B3(6)=(3*X+X5-4)*(X-X5)**3/(4*(X5-1)**3)
- B3(7)=-(X-X5)**4/(4*(X5-1)**3)
- END IF
- END IF
- END IF
- RETURN
- END
-
-
diff --git a/src/mathlib/gen/e/splas1.F b/src/mathlib/gen/e/splas1.F
deleted file mode 100644
index 48ffdcc..0000000
--- a/src/mathlib/gen/e/splas1.F
+++ /dev/null
@@ -1,67 +0,0 @@
-*
-* $Id: splas1.F,v 1.1.1.1 1996/04/01 15:02:26 mclareni Exp $
-*
-* $Log: splas1.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:26 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE SPLAS1(N,NC,M,K,XI,YI,KNOT,T,A,S,VT,W,LW,C,NERR)
-
-#include "gen/imp64.inc"
- DIMENSION XI(*),YI(*),T(*),A(N,*),S(*),VT(NC,*),W(*),C(*)
-
-************************************************************************
-* NORBAS, VERSION: 15.03.1993
-************************************************************************
-*
-* THE SUBROUTINE SPLAS1 IS USED BY DSPAP1 FOR COMPUTING THE
-* COEFFICIENTS C(1),...,C(NC) OF A POLYNOMIAL APPROXIMATION SPLINE
-* S(X) IN B-SPLINE REPRESENTATION
-*
-************************************************************************
-
- PARAMETER (Z0 = 0 , Z1 = 1 , Z2 = 2 , Z10 = 10 , HALF = Z1/Z2)
-*
-* COMPUTE AN APPROXIMATION EPS0 TO THE RELATIVE MACHINE PRECISION
-*
- EPS0=Z1
- 10 EPS0=EPS0/Z10
- IF (Z1+EPS0 .NE. Z1) GO TO 10
- EPS0=Z10*EPS0
-*
-* COMPUTE KNOTS BY MEANS OF GIVEN DATA POINTS (IF KNOT = 1 OR 2)
-*
- IF (KNOT .EQ. 1) THEN
- CALL DSPKN1(K,M,XI(1),XI(N),T,NERR)
- ELSEIF (KNOT .EQ. 2) THEN
- DO 20 I=1,K+1
- T(I)=XI(1)
- 20 T(NC+I)=XI(N)
- DO 30 I=K+2,NC
- 30 T(I)=HALF*(XI(N*(I-K-2)/NC+1)+XI(N*I/NC))
- ENDIF
-*
-* COMPUTE MATRIX A AND SOLVE LINEAR LEAST SQUARES PROBLEM USING SVD
-*
- DO 40 I=1,N
- DO 40 J=1,NC
- 40 A(I,J)=DSPNB1(K,M,J,0,XI(I),T,NERR)
- CALL DGESVD('O','A',N,NC,A,N,S,W,1,VT,NC,W,LW,INFO)
- CALL DMMPY(NC,N,A(1,1),A(2,1),A(1,2),YI(1),YI(2),W(1),W(2))
- DO 50 J=1,NC
- IF (S(J) .GT. EPS0*S(1)) THEN
- W(J)=W(J)/S(J)
- ELSE
- W(J)=Z0
- ENDIF
- 50 CONTINUE
- CALL DMMPY(NC,NC,VT(1,1),VT(2,1),VT(1,2),W(1),W(2),C(1),C(2))
- NERR=0
-
- RETURN
- END
-
-
-
diff --git a/src/mathlib/gen/e/splas2.F b/src/mathlib/gen/e/splas2.F
deleted file mode 100644
index 578b9e2..0000000
--- a/src/mathlib/gen/e/splas2.F
+++ /dev/null
@@ -1,88 +0,0 @@
-*
-* $Id: splas2.F,v 1.1.1.1 1996/04/01 15:02:27 mclareni Exp $
-*
-* $Log: splas2.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:27 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE SPLAS2(N,NC,NCX,NCY,NX,NY,MX,MY,KX,KY,NDIMC,NDIMZ,
- + XI,YI,ZI,KNOT,TX,TY,A,S,VT,W1,W2,LW,C,NERR)
-
-#include "gen/imp64.inc"
- DIMENSION XI(*),YI(*),ZI(NDIMZ,*),TX(*),TY(*)
- DIMENSION A(N,*),S(*),VT(NC,*),W1(*),W2(*),C(NDIMC,*)
-
-************************************************************************
-* NORBAS, VERSION: 15.03.1993
-************************************************************************
-*
-* THE SUBROUTINE SPLAS2 IS USED BY DSPAP2 FOR COMPUTING THE
-* COEFFICIENTS
-* C(I,J) (I=1,...,NCX , J=1,...,NCY)
-* OF A TWO-DIMENSIONAL POLYNOMIAL APPROXIMATION SPLINE Z = S(X,Y) IN
-* REPRESENTATION OF NORMALIZED TWO-DIMENSIONAL B-SPLINES B(I,J)(X,Y).
-*
-************************************************************************
-
- PARAMETER (Z0 = 0 , Z1 = 1 , Z2 = 2 , Z10 = 10 , HALF = Z1/Z2)
-*
-* COMPUTE AN APPROXIMATION EPS0 TO THE RELATIVE MACHINE PRECISION
-*
- EPS0=Z1
- 10 EPS0=EPS0/Z10
- IF(Z1+EPS0 .NE. Z1) GO TO 10
- EPS0=Z10*EPS0
-*
-* COMPUTE KNOTS BY MEANS OF GIVEN DATA POINTS (IF KNOT = 1 OR 2)
-*
- IF (KNOT .EQ. 1) THEN
- CALL DSPKN2(KX,KY,MX,MY,XI(1),XI(NX),YI(1),YI(NY),TX,TY,NERR)
- ELSEIF(KNOT .EQ. 2) THEN
- DO 20 I=1,KX+1
- TX(I)=XI(1)
- 20 TX(NCX+I)=XI(NX)
- DO 30 I=KX+2,NCX
- 30 TX(I)=HALF*(XI(NX*(I-KX-2)/NCX+1)+XI(NX*I/NCX))
- DO 40 J=1,KY+1
- TY(J)=YI(1)
- 40 TY(NCY+J)=YI(NY)
- DO 50 J=KY+2,NCY
- 50 TY(J)=HALF*(YI(NY*(J-KY-2)/NCY+1)+YI(NY*J/NCY))
- ENDIF
-*
-* COMPUTE MATRIX A AND SOLVE LINEAR LEAST SQUARES PROBLEM USING SVD
-*
- DO 60 I=1,NX
- X=XI(I)
- DO 60 J=1,NY
- Y=YI(J)
- DO 60 IC=1,NCX
- DO 60 JC=1,NCY
- A((I-1)*NY+J,(IC-1)*NCY+JC)=
- + DSPNB2(KX,KY,MX,MY,IC,JC,0,0,X,Y,TX,TY,NERR)
- 60 CONTINUE
- CALL DGESVD('O','A',N,NC,A,N,S,W1,1,VT,NC,W2,LW,INFO)
- DO 70 I=1,NX
- DO 70 J=1,NY
- 70 W1((I-1)*NY+J)=ZI(I,J)
- CALL DMMPY(NC,N,A(1,1),A(2,1),A(1,2),W1(1),W1(2),W2(1),W2(2))
- DO 80 J=1,NC
- IF(S(J) .GT. EPS0*S(1)) THEN
- W1(J)=W2(J)/S(J)
- ELSE
- W1(J)=Z0
- ENDIF
- 80 CONTINUE
- CALL DMMPY(NC,NC,VT(1,1),VT(2,1),VT(1,2),W1(1),W1(2),W2(1),W2(2))
- DO 90 I=1,NCX
- DO 90 J=1,NCY
- 90 C(I,J)=W2((I-1)*NCY+J)
- NERR=0
-
- RETURN
- END
-
-
-
diff --git a/src/mathlib/gen/e/trisum.F b/src/mathlib/gen/e/trisum.F
deleted file mode 100644
index 16599b6..0000000
--- a/src/mathlib/gen/e/trisum.F
+++ /dev/null
@@ -1,78 +0,0 @@
-*
-* $Id: trisum.F,v 1.1.1.1 1996/04/01 15:02:25 mclareni Exp $
-*
-* $Log: trisum.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:25 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- FUNCTION TRISUM(X,A,N,B,M,IOP)
-C
-C PURPOSE = TO COMPUTE THE SUM OF THE TRIGONOMETRIC SERIES
-C
-C TRISUM = A(1)/2+A(2)*COS(X)+....................A(N)*COS((N-1)*X)
-C +B(1)*SIN(X)+....................B(M)*SIN(M*X)
-C
-C PARAMETERS
-C
-C X = FUNCTION ARGUMENT
-C A = ARRAY DIMENSIONED A(N),KEEPING THE COEFFICIENTS FOR THE
-C COSINE TERMS
-C N = THE NUMBER OF COEFFICIENTS IN THE COSINE SERIE
-C B = ARRAY DIMENSIONED B(M),KEEPING THE COEFFICIENTS FOR THE
-C SINE TERMS
-C M = THE NUMBER OF COEFFICIENTS IN THE SINE SERIE
-C IOP = OPTION NUMBER , IOP = 1 , THE GENERAL CASE
-C IOP = 2 , THE EVEN CASE
-C IOP = 3 , THE ODD CASE
-C
- DIMENSION A(N) , B(M)
-C
-C*UL 1000 COF=2.*COS(X)
- COF=2.*COS(X)
- TRISUM=0.
-C
- IF (IOP.EQ.3) GO TO 1030
-C
-C COMPUTE SUM OF COSINE TERMS
-C
- A2 =0.
- A1 =A2
- A0 =A(N)
-C
- IF (N.EQ.1) GO TO 1020
-C
- NN=N-1
- DO 1010 K=1,NN
- A2=A1
- A1=A0
- INDEX=NN+1-K
- A0=A(INDEX)+COF*A1-A2
- 1010 CONTINUE
-C
- 1020 TRISUM=.5*(A0-A2)
-C
- 1030 IF (IOP.EQ.2) RETURN
-C
-C COMPUTE SUM OF SINUS TERMS
-C
- A2 =0.
- A1 =A2
- A0 =B(M)
-C
- IF (M.EQ.1) GO TO 1050
-C
- NN=M-1
- DO 1040 K=1,NN
- A2=A1
- A1=A0
- INDEX=NN+1-K
- A0=B(INDEX)+COF*A1-A2
- 1040 CONTINUE
-C
- 1050 TRISUM=TRISUM+A0*SIN(X)
-C
- RETURN
-C
- END
diff --git a/src/mathlib/gen/f/Imakefile b/src/mathlib/gen/f/Imakefile
deleted file mode 100644
index 9babc05..0000000
--- a/src/mathlib/gen/f/Imakefile
+++ /dev/null
@@ -1,34 +0,0 @@
-DoIncludePackage(gen)
-#include "pilot.h"
-
-SRCS_F= bakvec.F balanc.F balbak.F bisect.F cbabk2.F cbal.F cinvit.F \ @@\
- combak.F comhes.F comlr.F comlr2.F dircos.F eiscg1.F eiscg2.F \ @@\
- eisch1.F eisch2.F eisch3.F eisch4.F eisrg1.F eisrg2.F eisrs1.F \ @@\
- eisrs2.F eisrs3.F eisrs4.F eisst1.F eisst2.F eisst3.F eisst4.F \ @@\
- elmbak.F elmhes.F eltran.F figi.F figi2.F gather.F hqr.F hqr2.F \ @@\
- htribk.F htridi.F imtql1.F imtql2.F invit.F mxdipr.F ortbak.F \ @@\
- orthes.F ortran.F polrot.F ratqr.F rlhoin.F tinvit.F tql1.F \ @@\
- tql2.F trbak1.F tred1.F tred2.F tsturm.F \ @@\
-
-
-
-#if defined(CERNLIB_DOUBLE)
-SRCS_F:= $(SRCS_F) ilsum.F lihoin64.F scatter.F \ @@\
- wheneq.F whenfge.F whenfgt.F whenfle.F whenflt.F whenige.F \ @@\
- whenigt.F whenile.F whenilt.F whenne.F
-#else
-SRCS_F:= $(SRCS_F) lihoin128.F
-#endif
-
-#if defined(CERNLIB_UNIX) || defined(CERNLIB_VAX)
-SRCS_F:= $(SRCS_F) iilz.F
-#endif
-
-
-FORTRANSAVEOPTION = FortranSaveFlags
-
-#if defined(CERNLIB_SGI)
-IMAKE_DEFINES=-DFortranDoesCpp=NO
-#endif
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/mathlib/gen/f/bakvec.F b/src/mathlib/gen/f/bakvec.F
deleted file mode 100644
index cd05a6d..0000000
--- a/src/mathlib/gen/f/bakvec.F
+++ /dev/null
@@ -1,30 +0,0 @@
-*
-* $Id: bakvec.F,v 1.1.1.1 1996/04/01 15:02:32 mclareni Exp $
-*
-* $Log: bakvec.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:32 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE BAKVEC(NM,N,T,E,M,Z,IERR)
- INTEGER I,J,M,N,NM,IERR
- REAL T(NM,3),E(N),Z(NM,M)
- IERR = 0
- E(1) = 1.0
- IF (N .EQ. 1) GO TO 1001
- DO 100 I = 2, N
- IF (E(I) .NE. 0.0) GO TO 80
- IF (T(I,1) .NE. 0.0 .OR. T(I-1,3) .NE. 0.0) GO TO 1000
- E(I) = 1.0
- GO TO 100
- 80 E(I) = E(I-1) * E(I) / T(I-1,3)
- 100 CONTINUE
- DO 120 J = 1, M
- DO 120 I = 2, N
- Z(I,J) = Z(I,J) * E(I)
- 120 CONTINUE
- GO TO 1001
- 1000 IERR = 2 * N + I
- 1001 RETURN
- END
diff --git a/src/mathlib/gen/f/balanc.F b/src/mathlib/gen/f/balanc.F
deleted file mode 100644
index fa8f2a9..0000000
--- a/src/mathlib/gen/f/balanc.F
+++ /dev/null
@@ -1,92 +0,0 @@
-*
-* $Id: balanc.F,v 1.1.1.1 1996/04/01 15:02:32 mclareni Exp $
-*
-* $Log: balanc.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:32 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE BALANC(NM,N,A,LOW,IGH,SCALE)
- INTEGER I,J,K,L,M,N,JJ,NM,IGH,LOW,IEXC
- REAL A(NM,N),SCALE(N)
- REAL C,F,G,R,S,B2,RADIX
- LOGICAL NOCONV
- RADIX = 2.
- B2 = RADIX * RADIX
- K = 1
- L = N
- GO TO 100
- 20 SCALE(M) = J
- IF (J .EQ. M) GO TO 50
- DO 30 I = 1, L
- F = A(I,J)
- A(I,J) = A(I,M)
- A(I,M) = F
- 30 CONTINUE
- DO 40 I = K, N
- F = A(J,I)
- A(J,I) = A(M,I)
- A(M,I) = F
- 40 CONTINUE
- 50 GO TO (80,130), IEXC
- 80 IF (L .EQ. 1) GO TO 280
- L = L - 1
- 100 DO 120 JJ = 1, L
- J = L + 1 - JJ
- DO 110 I = 1, L
- IF (I .EQ. J) GO TO 110
- IF (A(J,I) .NE. 0.0) GO TO 120
- 110 CONTINUE
- M = L
- IEXC = 1
- GO TO 20
- 120 CONTINUE
- GO TO 140
- 130 K = K + 1
- 140 DO 170 J = K, L
- DO 150 I = K, L
- IF (I .EQ. J) GO TO 150
- IF (A(I,J) .NE. 0.0) GO TO 170
- 150 CONTINUE
- M = K
- IEXC = 2
- GO TO 20
- 170 CONTINUE
- DO 180 I = K, L
- 180 SCALE(I) = 1.0
- 190 NOCONV = .FALSE.
- DO 270 I = K, L
- C = 0.0
- R = 0.0
- DO 200 J = K, L
- IF (J .EQ. I) GO TO 200
- C = C + ABS(A(J,I))
- R = R + ABS(A(I,J))
- 200 CONTINUE
- G = R / RADIX
- F = 1.0
- S = C + R
- 210 IF (C .GE. G) GO TO 220
- F = F * RADIX
- C = C * B2
- GO TO 210
- 220 G = R * RADIX
- 230 IF (C .LT. G) GO TO 240
- F = F / RADIX
- C = C / B2
- GO TO 230
- 240 IF ((C + R) / F .GE. 0.95 * S) GO TO 270
- G = 1.0 / F
- SCALE(I) = SCALE(I) * F
- NOCONV = .TRUE.
- DO 250 J = K, N
- 250 A(I,J) = A(I,J) * G
- DO 260 J = 1, L
- 260 A(J,I) = A(J,I) * F
- 270 CONTINUE
- IF (NOCONV) GO TO 190
- 280 LOW = K
- IGH = L
- RETURN
- END
diff --git a/src/mathlib/gen/f/balbak.F b/src/mathlib/gen/f/balbak.F
deleted file mode 100644
index 7050834..0000000
--- a/src/mathlib/gen/f/balbak.F
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: balbak.F,v 1.1.1.1 1996/04/01 15:02:32 mclareni Exp $
-*
-* $Log: balbak.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:32 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE BALBAK(NM,N,LOW,IGH,SCALE,M,Z)
- INTEGER I,J,K,M,N,II,NM,IGH,LOW
- REAL SCALE(N),Z(NM,M)
- REAL S
- IF (IGH .EQ. LOW) GO TO 120
- DO 110 I = LOW, IGH
- S = SCALE(I)
- DO 100 J = 1, M
- 100 Z(I,J) = Z(I,J) * S
- 110 CONTINUE
- 120 DO 140 II = 1, N
- I = II
- IF (I .GE. LOW .AND. I .LE. IGH) GO TO 140
- IF (I .LT. LOW) I = LOW - II
- K = SCALE(I)
- IF (K .EQ. I) GO TO 140
- DO 130 J = 1, M
- S = Z(I,J)
- Z(I,J) = Z(K,J)
- Z(K,J) = S
- 130 CONTINUE
- 140 CONTINUE
- RETURN
- END
diff --git a/src/mathlib/gen/f/bisect.F b/src/mathlib/gen/f/bisect.F
deleted file mode 100644
index 5723357..0000000
--- a/src/mathlib/gen/f/bisect.F
+++ /dev/null
@@ -1,148 +0,0 @@
-*
-* $Id: bisect.F,v 1.1.1.1 1996/04/01 15:02:33 mclareni Exp $
-*
-* $Log: bisect.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:33 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE BISECT(N,EPS1,D,E,E2,LB,UB,MM,M,W,IND,IERR,RV4,RV5)
- INTEGER I,J,K,L,M,N,P,Q,R,S,II,MM,M1,M2,TAG,IERR,ISTURM
- REAL D(N),E(N),E2(N),W(MM),RV4(N),RV5(N)
- REAL U,V,LB,T1,T2,UB,XU,X0,X1,EPS1,MACHEP
- INTEGER IND(MM)
-#if defined(CERNLIB_CDC)
- MACHEP=2.**(-47)
-#endif
-#if !defined(CERNLIB_CDC)
- MACHEP=2.**(-23)
-#endif
- IERR = 0
- TAG = 0
- T1 = LB
- T2 = UB
- DO 40 I = 1, N
- IF (I .EQ. 1) GO TO 20
- IF (ABS(E(I)) .GT. MACHEP * (ABS(D(I)) + ABS(D(I-1))))
- X GO TO 40
- 20 E2(I) = 0.0
- 40 CONTINUE
- P = 1
- Q = N
- X1 = UB
- ISTURM = 1
- GO TO 320
- 60 M = S
- X1 = LB
- ISTURM = 2
- GO TO 320
- 80 M = M - S
- IF (M .GT. MM) GO TO 980
- Q = 0
- R = 0
- 100 IF (R .EQ. M) GO TO 1001
- TAG = TAG + 1
- P = Q + 1
- XU = D(P)
- X0 = D(P)
- U = 0.0
- DO 120 Q = P, N
- X1 = U
- U = 0.0
- V = 0.0
- IF (Q .EQ. N) GO TO 110
- U = ABS(E(Q+1))
- V = E2(Q+1)
- 110 XU = MIN(D(Q)-(X1+U),XU)
- X0 = MAX(D(Q)+(X1+U),X0)
- IF (V .EQ. 0.0) GO TO 140
- 120 CONTINUE
- 140 X1 = MAX(ABS(XU),ABS(X0)) * MACHEP
- IF (EPS1 .LE. 0.0) EPS1 = -X1
- IF (P .NE. Q) GO TO 180
- IF (T1 .GT. D(P) .OR. D(P) .GE. T2) GO TO 940
- M1 = P
- M2 = P
- RV5(P) = D(P)
- GO TO 900
- 180 X1 = X1 * (Q-P+1)
- LB = MAX(T1,XU-X1)
- UB = MIN(T2,X0+X1)
- X1 = LB
- ISTURM = 3
- GO TO 320
- 200 M1 = S + 1
- X1 = UB
- ISTURM = 4
- GO TO 320
- 220 M2 = S
- IF (M1 .GT. M2) GO TO 940
- X0 = UB
- ISTURM = 5
- DO 240 I = M1, M2
- RV5(I) = UB
- RV4(I) = LB
- 240 CONTINUE
- K = M2
- 250 XU = LB
- DO 260 II = M1, K
- I = M1 + K - II
- IF (XU .GE. RV4(I)) GO TO 260
- XU = RV4(I)
- GO TO 280
- 260 CONTINUE
- 280 IF (X0 .GT. RV5(K)) X0 = RV5(K)
- 300 X1 = (XU + X0) * 0.5
- IF ((X0 - XU) .LE. (2.0 * MACHEP *
- X (ABS(XU) + ABS(X0)) + ABS(EPS1))) GO TO 420
- 320 S = P - 1
- U = 1.0
- DO 340 I = P, Q
- IF (U .NE. 0.0) GO TO 325
- V = ABS(E(I)) / MACHEP
- GO TO 330
- 325 V = E2(I) / U
- 330 U = D(I) - X1 - V
- IF (U .LT. 0.0) S = S + 1
- 340 CONTINUE
- GO TO (60,80,200,220,360), ISTURM
- 360 IF (S .GE. K) GO TO 400
- XU = X1
- IF (S .GE. M1) GO TO 380
- RV4(M1) = X1
- GO TO 300
- 380 RV4(S+1) = X1
- IF (RV5(S) .GT. X1) RV5(S) = X1
- GO TO 300
- 400 X0 = X1
- GO TO 300
- 420 RV5(K) = X1
- K = K - 1
- IF (K .GE. M1) GO TO 250
- 900 S = R
- R = R + M2 - M1 + 1
- J = 1
- K = M1
- DO 920 L = 1, R
- IF (J .GT. S) GO TO 910
- IF (K .GT. M2) GO TO 940
- IF (RV5(K) .GE. W(L)) GO TO 915
- DO 905 II = J, S
- I = L + S - II
- W(I+1) = W(I)
- IND(I+1) = IND(I)
- 905 CONTINUE
- 910 W(L) = RV5(K)
- IND(L) = TAG
- K = K + 1
- GO TO 920
- 915 J = J + 1
- 920 CONTINUE
- 940 IF (Q .LT. N) GO TO 100
- GO TO 1001
- 980 IERR = 3 * N + 1
- 1001 LB = T1
- UB = T2
- RETURN
- END
diff --git a/src/mathlib/gen/f/cbabk2.F b/src/mathlib/gen/f/cbabk2.F
deleted file mode 100644
index e5cc96d..0000000
--- a/src/mathlib/gen/f/cbabk2.F
+++ /dev/null
@@ -1,38 +0,0 @@
-*
-* $Id: cbabk2.F,v 1.1.1.1 1996/04/01 15:02:33 mclareni Exp $
-*
-* $Log: cbabk2.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:33 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE CBABK2(NM,N,LOW,IGH,SCALE,M,ZR,ZI)
- INTEGER I,J,K,M,N,II,NM,IGH,LOW
- REAL SCALE(N),ZR(NM,M),ZI(NM,M)
- REAL S
- IF (IGH .EQ. LOW) GO TO 120
- DO 110 I = LOW, IGH
- S = SCALE(I)
- DO 100 J = 1, M
- ZR(I,J) = ZR(I,J) * S
- ZI(I,J) = ZI(I,J) * S
- 100 CONTINUE
- 110 CONTINUE
- 120 DO 140 II = 1, N
- I = II
- IF (I .GE. LOW .AND. I .LE. IGH) GO TO 140
- IF (I .LT. LOW) I = LOW - II
- K = SCALE(I)
- IF (K .EQ. I) GO TO 140
- DO 130 J = 1, M
- S = ZR(I,J)
- ZR(I,J) = ZR(K,J)
- ZR(K,J) = S
- S = ZI(I,J)
- ZI(I,J) = ZI(K,J)
- ZI(K,J) = S
- 130 CONTINUE
- 140 CONTINUE
- RETURN
- END
diff --git a/src/mathlib/gen/f/cbal.F b/src/mathlib/gen/f/cbal.F
deleted file mode 100644
index d634a11..0000000
--- a/src/mathlib/gen/f/cbal.F
+++ /dev/null
@@ -1,102 +0,0 @@
-*
-* $Id: cbal.F,v 1.1.1.1 1996/04/01 15:02:33 mclareni Exp $
-*
-* $Log: cbal.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:33 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE CBAL(NM,N,AR,AI,LOW,IGH,SCALE)
- INTEGER I,J,K,L,M,N,JJ,NM,IGH,LOW,IEXC
- REAL AR(NM,N),AI(NM,N),SCALE(N)
- REAL C,F,G,R,S,B2,RADIX
- LOGICAL NOCONV
- RADIX = 2.
- B2 = RADIX * RADIX
- K = 1
- L = N
- GO TO 100
- 20 SCALE(M) = J
- IF (J .EQ. M) GO TO 50
- DO 30 I = 1, L
- F = AR(I,J)
- AR(I,J) = AR(I,M)
- AR(I,M) = F
- F = AI(I,J)
- AI(I,J) = AI(I,M)
- AI(I,M) = F
- 30 CONTINUE
- DO 40 I = K, N
- F = AR(J,I)
- AR(J,I) = AR(M,I)
- AR(M,I) = F
- F = AI(J,I)
- AI(J,I) = AI(M,I)
- AI(M,I) = F
- 40 CONTINUE
- 50 GO TO (80,130), IEXC
- 80 IF (L .EQ. 1) GO TO 280
- L = L - 1
- 100 DO 120 JJ = 1, L
- J = L + 1 - JJ
- DO 110 I = 1, L
- IF (I .EQ. J) GO TO 110
- IF (AR(J,I) .NE. 0.0 .OR. AI(J,I) .NE. 0.0) GO TO 120
- 110 CONTINUE
- M = L
- IEXC = 1
- GO TO 20
- 120 CONTINUE
- GO TO 140
- 130 K = K + 1
- 140 DO 170 J = K, L
- DO 150 I = K, L
- IF (I .EQ. J) GO TO 150
- IF (AR(I,J) .NE. 0.0 .OR. AI(I,J) .NE. 0.0) GO TO 170
- 150 CONTINUE
- M = K
- IEXC = 2
- GO TO 20
- 170 CONTINUE
- DO 180 I = K, L
- 180 SCALE(I) = 1.0
- 190 NOCONV = .FALSE.
- DO 270 I = K, L
- C = 0.0
- R = 0.0
- DO 200 J = K, L
- IF (J .EQ. I) GO TO 200
- C = C + ABS(AR(J,I)) + ABS(AI(J,I))
- R = R + ABS(AR(I,J)) + ABS(AI(I,J))
- 200 CONTINUE
- G = R / RADIX
- F = 1.0
- S = C + R
- 210 IF (C .GE. G) GO TO 220
- F = F * RADIX
- C = C * B2
- GO TO 210
- 220 G = R * RADIX
- 230 IF (C .LT. G) GO TO 240
- F = F / RADIX
- C = C / B2
- GO TO 230
- 240 IF ((C + R) / F .GE. 0.95 * S) GO TO 270
- G = 1.0 / F
- SCALE(I) = SCALE(I) * F
- NOCONV = .TRUE.
- DO 250 J = K, N
- AR(I,J) = AR(I,J) * G
- AI(I,J) = AI(I,J) * G
- 250 CONTINUE
- DO 260 J = 1, L
- AR(J,I) = AR(J,I) * F
- AI(J,I) = AI(J,I) * F
- 260 CONTINUE
- 270 CONTINUE
- IF (NOCONV) GO TO 190
- 280 LOW = K
- IGH = L
- RETURN
- END
diff --git a/src/mathlib/gen/f/cinvit.F b/src/mathlib/gen/f/cinvit.F
deleted file mode 100644
index 8627285..0000000
--- a/src/mathlib/gen/f/cinvit.F
+++ /dev/null
@@ -1,159 +0,0 @@
-*
-* $Id: cinvit.F,v 1.1.1.1 1996/04/01 15:02:33 mclareni Exp $
-*
-* $Log: cinvit.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:33 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE CINVIT(NM,N,AR,AI,WR,WI,SELECT,MM,M,ZR,ZI,
- X IERR,RM1,RM2,RV1,RV2)
- INTEGER I,J,K,M,N,S,II,MM,MP,NM,UK,IP1,ITS,KM1,IERR
- REAL AR(NM,N),AI(NM,N),WR(N),WI(N),ZR(NM,MM),ZI(NM,MM),
- X RM1(N,N),RM2(N,N),RV1(N),RV2(N)
- REAL X,Y,EPS3,NORM,NORMV,GROWTO,ILAMBD,MACHEP,RLAMBD,UKROOT
- LOGICAL SELECT(N)
- COMPLEX Z3
- REAL T3(2)
- EQUIVALENCE (Z3,T3(1))
-#if defined(CERNLIB_CDC)
- MACHEP=2.**(-47)
-#endif
-#if !defined(CERNLIB_CDC)
- MACHEP=2.**(-23)
-#endif
- IERR = 0
- UK = 0
- S = 1
- DO 980 K = 1, N
- IF (.NOT. SELECT(K)) GO TO 980
- IF (S .GT. MM) GO TO 1000
- IF (UK .GE. K) GO TO 200
- DO 120 UK = K, N
- IF (UK .EQ. N) GO TO 140
- IF (AR(UK+1,UK) .EQ. 0.0 .AND. AI(UK+1,UK) .EQ. 0.0)
- X GO TO 140
- 120 CONTINUE
- 140 NORM = 0.0
- MP = 1
- DO 180 I = 1, UK
- X = 0.0
- DO 160 J = MP, UK
- 160 X = X + ABS(CMPLX(AR(I,J),AI(I,J)))
- IF (X .GT. NORM) NORM = X
- MP = I
- 180 CONTINUE
- IF (NORM .EQ. 0.0) NORM = 1.0
- EPS3 = MACHEP * NORM
- UKROOT = SQRT(REAL(UK))
- GROWTO = 1.0E-1 / UKROOT
- 200 RLAMBD = WR(K)
- ILAMBD = WI(K)
- IF (K .EQ. 1) GO TO 280
- KM1 = K - 1
- GO TO 240
- 220 RLAMBD = RLAMBD + EPS3
- 240 DO 260 II = 1, KM1
- I = K - II
- IF (SELECT(I) .AND. ABS(WR(I)-RLAMBD) .LT. EPS3 .AND.
- X ABS(WI(I)-ILAMBD) .LT. EPS3) GO TO 220
- 260 CONTINUE
- WR(K) = RLAMBD
- 280 MP = 1
- DO 320 I = 1, UK
- DO 300 J = MP, UK
- RM1(I,J) = AR(I,J)
- RM2(I,J) = AI(I,J)
- 300 CONTINUE
- RM1(I,I) = RM1(I,I) - RLAMBD
- RM2(I,I) = RM2(I,I) - ILAMBD
- MP = I
- RV1(I) = EPS3
- 320 CONTINUE
- IF (UK .EQ. 1) GO TO 420
- DO 400 I = 2, UK
- MP = I - 1
- IF (ABS(CMPLX(RM1(I,MP),RM2(I,MP))) .LE.
- X ABS(CMPLX(RM1(MP,MP),RM2(MP,MP)))) GO TO 360
- DO 340 J = MP, UK
- Y = RM1(I,J)
- RM1(I,J) = RM1(MP,J)
- RM1(MP,J) = Y
- Y = RM2(I,J)
- RM2(I,J) = RM2(MP,J)
- RM2(MP,J) = Y
- 340 CONTINUE
- 360 IF (RM1(MP,MP) .EQ. 0.0 .AND. RM2(MP,MP) .EQ. 0.0)
- X RM1(MP,MP) = EPS3
- Z3 = CMPLX(RM1(I,MP),RM2(I,MP)) /
- X CMPLX(RM1(MP,MP),RM2(MP,MP))
- X = T3(1)
- Y = T3(2)
- IF (X .EQ. 0.0 .AND. Y .EQ. 0.0) GO TO 400
- DO 380 J = I, UK
- RM1(I,J) = RM1(I,J) - X * RM1(MP,J) + Y * RM2(MP,J)
- RM2(I,J) = RM2(I,J) - X * RM2(MP,J) - Y * RM1(MP,J)
- 380 CONTINUE
- 400 CONTINUE
- 420 IF (RM1(UK,UK) .EQ. 0.0 .AND. RM2(UK,UK) .EQ. 0.0)
- X RM1(UK,UK) = EPS3
- ITS = 0
- 660 DO 720 II = 1, UK
- I = UK + 1 - II
- X = RV1(I)
- Y = 0.0
- IF (I .EQ. UK) GO TO 700
- IP1 = I + 1
- DO 680 J = IP1, UK
- X = X - RM1(I,J) * RV1(J) + RM2(I,J) * RV2(J)
- Y = Y - RM1(I,J) * RV2(J) - RM2(I,J) * RV1(J)
- 680 CONTINUE
- 700 Z3 = CMPLX(X,Y) / CMPLX(RM1(I,I),RM2(I,I))
- RV1(I) = T3(1)
- RV2(I) = T3(2)
- 720 CONTINUE
- ITS = ITS + 1
- NORM = 0.0
- NORMV = 0.0
- DO 780 I = 1, UK
- X = ABS(CMPLX(RV1(I),RV2(I)))
- IF (NORMV .GE. X) GO TO 760
- NORMV = X
- J = I
- 760 NORM = NORM + X
- 780 CONTINUE
- IF (NORM .LT. GROWTO) GO TO 840
- X = RV1(J)
- Y = RV2(J)
- DO 820 I = 1, UK
- Z3 = CMPLX(RV1(I),RV2(I)) / CMPLX(X,Y)
- ZR(I,S) = T3(1)
- ZI(I,S) = T3(2)
- 820 CONTINUE
- IF (UK .EQ. N) GO TO 940
- J = UK + 1
- GO TO 900
- 840 IF (ITS .GE. UK) GO TO 880
- X = UKROOT
- Y = EPS3 / (X + 1.0)
- RV1(1) = EPS3
- DO 860 I = 2, UK
- 860 RV1(I) = Y
- J = UK - ITS + 1
- RV1(J) = RV1(J) - EPS3 * X
- GO TO 660
- 880 J = 1
- IERR = -K
- 900 DO 920 I = J, N
- ZR(I,S) = 0.0
- ZI(I,S) = 0.0
- 920 CONTINUE
- 940 S = S + 1
- 980 CONTINUE
- GO TO 1001
- 1000 IF (IERR .NE. 0) IERR = IERR - N
- IF (IERR .EQ. 0) IERR = -(2 * N + 1)
- 1001 M = S - 1
- RETURN
- END
diff --git a/src/mathlib/gen/f/combak.F b/src/mathlib/gen/f/combak.F
deleted file mode 100644
index 42dc059..0000000
--- a/src/mathlib/gen/f/combak.F
+++ /dev/null
@@ -1,42 +0,0 @@
-*
-* $Id: combak.F,v 1.1.1.1 1996/04/01 15:02:33 mclareni Exp $
-*
-* $Log: combak.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:33 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE COMBAK(NM,LOW,IGH,AR,AI,INT,M,ZR,ZI)
- INTEGER I,J,M,LA,MM,MP,NM,IGH,KP1,LOW,MP1
- REAL AR(NM,IGH),AI(NM,IGH),ZR(NM,M),ZI(NM,M)
- REAL XR,XI
- INTEGER INT(IGH)
- LA = IGH - 1
- KP1 = LOW + 1
- IF (LA .LT. KP1) GO TO 200
- DO 140 MM = KP1, LA
- MP = LOW + IGH - MM
- MP1 = MP + 1
- DO 110 I = MP1, IGH
- XR = AR(I,MP-1)
- XI = AI(I,MP-1)
- IF (XR .EQ. 0.0 .AND. XI .EQ. 0.0) GO TO 110
- DO 100 J = 1, M
- ZR(I,J) = ZR(I,J) + XR * ZR(MP,J) - XI * ZI(MP,J)
- ZI(I,J) = ZI(I,J) + XR * ZI(MP,J) + XI * ZR(MP,J)
- 100 CONTINUE
- 110 CONTINUE
- I = INT(MP)
- IF (I .EQ. MP) GO TO 140
- DO 130 J = 1, M
- XR = ZR(I,J)
- ZR(I,J) = ZR(MP,J)
- ZR(MP,J) = XR
- XI = ZI(I,J)
- ZI(I,J) = ZI(MP,J)
- ZI(MP,J) = XI
- 130 CONTINUE
- 140 CONTINUE
- 200 RETURN
- END
diff --git a/src/mathlib/gen/f/comhes.F b/src/mathlib/gen/f/comhes.F
deleted file mode 100644
index 4ebff6a..0000000
--- a/src/mathlib/gen/f/comhes.F
+++ /dev/null
@@ -1,71 +0,0 @@
-*
-* $Id: comhes.F,v 1.1.1.1 1996/04/01 15:02:33 mclareni Exp $
-*
-* $Log: comhes.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:33 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE COMHES(NM,N,LOW,IGH,AR,AI,INT)
- INTEGER I,J,M,N,LA,NM,IGH,KP1,LOW,MM1,MP1
- REAL AR(NM,N),AI(NM,N)
- REAL XR,XI,YR,YI
- INTEGER INT(IGH)
- COMPLEX X,Y
- REAL T1(2),T2(2)
- EQUIVALENCE (X,T1(1),XR),(T1(2),XI),(Y,T2(1),YR),(T2(2),YI)
- LA = IGH - 1
- KP1 = LOW + 1
- IF (LA .LT. KP1) GO TO 200
- DO 180 M = KP1, LA
- MM1 = M - 1
- XR = 0.0
- XI = 0.0
- I = M
- DO 100 J = M, IGH
- IF (ABS(AR(J,MM1)) + ABS(AI(J,MM1))
- X .LE. ABS(XR) + ABS(XI)) GO TO 100
- XR = AR(J,MM1)
- XI = AI(J,MM1)
- I = J
- 100 CONTINUE
- INT(M) = I
- IF (I .EQ. M) GO TO 130
- DO 110 J = MM1, N
- YR = AR(I,J)
- AR(I,J) = AR(M,J)
- AR(M,J) = YR
- YI = AI(I,J)
- AI(I,J) = AI(M,J)
- AI(M,J) = YI
- 110 CONTINUE
- DO 120 J = 1, IGH
- YR = AR(J,I)
- AR(J,I) = AR(J,M)
- AR(J,M) = YR
- YI = AI(J,I)
- AI(J,I) = AI(J,M)
- AI(J,M) = YI
- 120 CONTINUE
- 130 IF (XR .EQ. 0.0 .AND. XI .EQ. 0.0) GO TO 180
- MP1 = M + 1
- DO 160 I = MP1, IGH
- YR = AR(I,MM1)
- YI = AI(I,MM1)
- IF (YR .EQ. 0.0 .AND. YI .EQ. 0.0) GO TO 160
- Y = Y / X
- AR(I,MM1) = YR
- AI(I,MM1) = YI
- DO 140 J = M, N
- AR(I,J) = AR(I,J) - YR * AR(M,J) + YI * AI(M,J)
- AI(I,J) = AI(I,J) - YR * AI(M,J) - YI * AR(M,J)
- 140 CONTINUE
- DO 150 J = 1, IGH
- AR(J,M) = AR(J,M) + YR * AR(J,I) - YI * AI(J,I)
- AI(J,M) = AI(J,M) + YR * AI(J,I) + YI * AR(J,I)
- 150 CONTINUE
- 160 CONTINUE
- 180 CONTINUE
- 200 RETURN
- END
diff --git a/src/mathlib/gen/f/comlr.F b/src/mathlib/gen/f/comlr.F
deleted file mode 100644
index eb1f7b8..0000000
--- a/src/mathlib/gen/f/comlr.F
+++ /dev/null
@@ -1,136 +0,0 @@
-*
-* $Id: comlr.F,v 1.1.1.1 1996/04/01 15:02:33 mclareni Exp $
-*
-* $Log: comlr.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:33 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE COMLR(NM,N,LOW,IGH,HR,HI,WR,WI,IERR)
- INTEGER I,J,L,M,N,EN,LL,MM,NM,IGH,IM1,ITS,LOW,MP1,ENM1,IERR
- REAL HR(NM,N),HI(NM,N),WR(N),WI(N)
- REAL SI,SR,TI,TR,XI,XR,YI,YR,ZZI,ZZR,MACHEP
- COMPLEX X,Y,Z
- REAL T1(2),T2(2),T3(2)
- EQUIVALENCE (X,T1(1),XR),(T1(2),XI),(Y,T2(1),YR),(T2(2),YI),
- X (Z,T3(1),ZZR),(T3(2),ZZI)
-#if defined(CERNLIB_CDC)
- MACHEP=2.**(-47)
-#endif
-#if !defined(CERNLIB_CDC)
- MACHEP=2.**(-23)
-#endif
- IERR = 0
-C*UL 180 DO 200 I = 1, N
- DO 200 I = 1, N
- IF (I .GE. LOW .AND. I .LE. IGH) GO TO 200
- WR(I) = HR(I,I)
- WI(I) = HI(I,I)
- 200 CONTINUE
- EN = IGH
- TR = 0.0
- TI = 0.0
- 220 IF (EN .LT. LOW) GO TO 1001
- ITS = 0
- ENM1 = EN - 1
- 240 DO 260 LL = LOW, EN
- L = EN + LOW - LL
- IF (L .EQ. LOW) GO TO 300
- IF (ABS(HR(L,L-1)) + ABS(HI(L,L-1)) .LE.
- X MACHEP * (ABS(HR(L-1,L-1)) + ABS(HI(L-1,L-1))
- X + ABS(HR(L,L)) +ABS(HI(L,L)))) GO TO 300
- 260 CONTINUE
- 300 IF (L .EQ. EN) GO TO 660
- IF (ITS .EQ. 30) GO TO 1000
- IF (ITS .EQ. 10 .OR. ITS .EQ. 20) GO TO 320
- SR = HR(EN,EN)
- SI = HI(EN,EN)
- XR = HR(ENM1,EN) * HR(EN,ENM1) - HI(ENM1,EN) * HI(EN,ENM1)
- XI = HR(ENM1,EN) * HI(EN,ENM1) + HI(ENM1,EN) * HR(EN,ENM1)
- IF (XR .EQ. 0.0 .AND. XI .EQ. 0.0) GO TO 340
- YR = (HR(ENM1,ENM1) - SR) / 2.0
- YI = (HI(ENM1,ENM1) - SI) / 2.0
- Z = SQRT(CMPLX(YR**2-YI**2+XR,2.0*YR*YI+XI))
- IF (YR * ZZR + YI * ZZI .LT. 0.0) Z = -Z
- X = X / (Y + Z)
- SR = SR - XR
- SI = SI - XI
- GO TO 340
- 320 SR = ABS(HR(EN,ENM1)) + ABS(HR(ENM1,EN-2))
- SI = ABS(HI(EN,ENM1)) + ABS(HI(ENM1,EN-2))
- 340 DO 360 I = LOW, EN
- HR(I,I) = HR(I,I) - SR
- HI(I,I) = HI(I,I) - SI
- 360 CONTINUE
- TR = TR + SR
- TI = TI + SI
- ITS = ITS + 1
- XR = ABS(HR(ENM1,ENM1)) + ABS(HI(ENM1,ENM1))
- YR = ABS(HR(EN,ENM1)) + ABS(HI(EN,ENM1))
- ZZR = ABS(HR(EN,EN)) + ABS(HI(EN,EN))
- DO 380 MM = L, ENM1
- M = ENM1 + L - MM
- IF (M .EQ. L) GO TO 420
- YI = YR
- YR = ABS(HR(M,M-1)) + ABS(HI(M,M-1))
- XI = ZZR
- ZZR = XR
- XR = ABS(HR(M-1,M-1)) + ABS(HI(M-1,M-1))
- IF (YR .LE. MACHEP * ZZR / YI * (ZZR + XR + XI)) GO TO 420
- 380 CONTINUE
- 420 MP1 = M + 1
- DO 520 I = MP1, EN
- IM1 = I - 1
- XR = HR(IM1,IM1)
- XI = HI(IM1,IM1)
- YR = HR(I,IM1)
- YI = HI(I,IM1)
- IF (ABS(XR) + ABS(XI) .GE. ABS(YR) + ABS(YI)) GO TO 460
- DO 440 J = IM1, N
- ZZR = HR(IM1,J)
- HR(IM1,J) = HR(I,J)
- HR(I,J) = ZZR
- ZZI = HI(IM1,J)
- HI(IM1,J) = HI(I,J)
- HI(I,J) = ZZI
- 440 CONTINUE
- Z = X / Y
- WR(I) = 1.0
- GO TO 480
- 460 Z = Y / X
- WR(I) = -1.0
- 480 HR(I,IM1) = ZZR
- HI(I,IM1) = ZZI
- DO 500 J = I, EN
- HR(I,J) = HR(I,J) - ZZR * HR(IM1,J) + ZZI * HI(IM1,J)
- HI(I,J) = HI(I,J) - ZZR * HI(IM1,J) - ZZI * HR(IM1,J)
- 500 CONTINUE
- 520 CONTINUE
- DO 640 J = MP1, EN
- XR = HR(J,J-1)
- XI = HI(J,J-1)
- HR(J,J-1) = 0.0
- HI(J,J-1) = 0.0
- IF (WR(J) .LE. 0.0) GO TO 580
- DO 540 I = L, J
- ZZR = HR(I,J-1)
- HR(I,J-1) = HR(I,J)
- HR(I,J) = ZZR
- ZZI = HI(I,J-1)
- HI(I,J-1) = HI(I,J)
- HI(I,J) = ZZI
- 540 CONTINUE
- 580 DO 600 I = L, J
- HR(I,J-1) = HR(I,J-1) + XR * HR(I,J) - XI * HI(I,J)
- HI(I,J-1) = HI(I,J-1) + XR * HI(I,J) + XI * HR(I,J)
- 600 CONTINUE
- 640 CONTINUE
- GO TO 240
- 660 WR(EN) = HR(EN,EN) + TR
- WI(EN) = HI(EN,EN) + TI
- EN = ENM1
- GO TO 220
- 1000 IERR = EN
- 1001 RETURN
- END
diff --git a/src/mathlib/gen/f/comlr2.F b/src/mathlib/gen/f/comlr2.F
deleted file mode 100644
index 6f7aedb..0000000
--- a/src/mathlib/gen/f/comlr2.F
+++ /dev/null
@@ -1,228 +0,0 @@
-*
-* $Id: comlr2.F,v 1.1.1.1 1996/04/01 15:02:33 mclareni Exp $
-*
-* $Log: comlr2.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:33 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE COMLR2(NM,N,LOW,IGH,INT,HR,HI,WR,WI,ZR,ZI,IERR)
- INTEGER I,J,K,L,M,N,EN,II,JJ,LL,MM,NM,NN,IGH,IM1,IP1,
- X ITS,LOW,MP1,ENM1,IEND,IERR
- REAL HR(NM,N),HI(NM,N),WR(N),WI(N),ZR(NM,N),ZI(NM,N)
- REAL SI,SR,TI,TR,XI,XR,YI,YR,ZZI,ZZR,NORM,MACHEP
- INTEGER INT(IGH)
- COMPLEX X,Y,Z
- REAL T1(2),T2(2),T3(2)
- EQUIVALENCE (X,T1(1),XR),(T1(2),XI),(Y,T2(1),YR),(T2(2),YI),
- X (Z,T3(1),ZZR),(T3(2),ZZI)
-#if defined(CERNLIB_CDC)
- MACHEP=2.**(-47)
-#endif
-#if !defined(CERNLIB_CDC)
- MACHEP=2.**(-23)
-#endif
- IERR = 0
- DO 100 I = 1,N
- DO 100 J = 1, N
- ZR(I,J) = 0.0
- ZI(I,J) = 0.0
- IF (I .EQ. J) ZR(I,J) = 1.0
- 100 CONTINUE
- IEND = IGH - LOW - 1
- IF (IEND .LE. 0) GO TO 180
- DO 160 II = 1, IEND
- I = IGH - II
- IP1 = I + 1
- DO 120 K = IP1, IGH
- ZR(K,I) = HR(K,I-1)
- ZI(K,I) = HI(K,I-1)
- 120 CONTINUE
- J = INT(I)
- IF (I .EQ. J) GO TO 160
- DO 140 K = I, IGH
- ZR(I,K) = ZR(J,K)
- ZI(I,K) = ZI(J,K)
- ZR(J,K) = 0.0
- ZI(J,K) = 0.0
- 140 CONTINUE
- ZR(J,I) = 1.0
- 160 CONTINUE
- 180 DO 200 I = 1, N
- IF (I .GE. LOW .AND. I .LE. IGH) GO TO 200
- WR(I) = HR(I,I)
- WI(I) = HI(I,I)
- 200 CONTINUE
- EN = IGH
- TR = 0.0
- TI = 0.0
- 220 IF (EN .LT. LOW) GO TO 680
- ITS = 0
- ENM1 = EN - 1
- 240 DO 260 LL = LOW, EN
- L = EN + LOW - LL
- IF (L .EQ. LOW) GO TO 300
- IF (ABS(HR(L,L-1)) + ABS(HI(L,L-1)) .LE.
- X MACHEP * (ABS(HR(L-1,L-1)) + ABS(HI(L-1,L-1))
- X + ABS(HR(L,L)) +ABS(HI(L,L)))) GO TO 300
- 260 CONTINUE
- 300 IF (L .EQ. EN) GO TO 660
- IF (ITS .EQ. 30) GO TO 1000
- IF (ITS .EQ. 10 .OR. ITS .EQ. 20) GO TO 320
- SR = HR(EN,EN)
- SI = HI(EN,EN)
- XR = HR(ENM1,EN) * HR(EN,ENM1) - HI(ENM1,EN) * HI(EN,ENM1)
- XI = HR(ENM1,EN) * HI(EN,ENM1) + HI(ENM1,EN) * HR(EN,ENM1)
- IF (XR .EQ. 0.0 .AND. XI .EQ. 0.0) GO TO 340
- YR = (HR(ENM1,ENM1) - SR) / 2.0
- YI = (HI(ENM1,ENM1) - SI) / 2.0
- Z = SQRT(CMPLX(YR**2-YI**2+XR,2.0*YR*YI+XI))
- IF (YR * ZZR + YI * ZZI .LT. 0.0) Z = -Z
- X = X / (Y + Z)
- SR = SR - XR
- SI = SI - XI
- GO TO 340
- 320 SR = ABS(HR(EN,ENM1)) + ABS(HR(ENM1,EN-2))
- SI = ABS(HI(EN,ENM1)) + ABS(HI(ENM1,EN-2))
- 340 DO 360 I = LOW, EN
- HR(I,I) = HR(I,I) - SR
- HI(I,I) = HI(I,I) - SI
- 360 CONTINUE
- TR = TR + SR
- TI = TI + SI
- ITS = ITS + 1
- XR = ABS(HR(ENM1,ENM1)) + ABS(HI(ENM1,ENM1))
- YR = ABS(HR(EN,ENM1)) + ABS(HI(EN,ENM1))
- ZZR = ABS(HR(EN,EN)) + ABS(HI(EN,EN))
- DO 380 MM = L, ENM1
- M = ENM1 + L - MM
- IF (M .EQ. L) GO TO 420
- YI = YR
- YR = ABS(HR(M,M-1)) + ABS(HI(M,M-1))
- XI = ZZR
- ZZR = XR
- XR = ABS(HR(M-1,M-1)) + ABS(HI(M-1,M-1))
- IF (YR .LE. MACHEP * ZZR / YI * (ZZR + XR + XI)) GO TO 420
- 380 CONTINUE
- 420 MP1 = M + 1
- DO 520 I = MP1, EN
- IM1 = I - 1
- XR = HR(IM1,IM1)
- XI = HI(IM1,IM1)
- YR = HR(I,IM1)
- YI = HI(I,IM1)
- IF (ABS(XR) + ABS(XI) .GE. ABS(YR) + ABS(YI)) GO TO 460
- DO 440 J = IM1, N
- ZZR = HR(IM1,J)
- HR(IM1,J) = HR(I,J)
- HR(I,J) = ZZR
- ZZI = HI(IM1,J)
- HI(IM1,J) = HI(I,J)
- HI(I,J) = ZZI
- 440 CONTINUE
- Z = X / Y
- WR(I) = 1.0
- GO TO 480
- 460 Z = Y / X
- WR(I) = -1.0
- 480 HR(I,IM1) = ZZR
- HI(I,IM1) = ZZI
- DO 500 J = I, N
- HR(I,J) = HR(I,J) - ZZR * HR(IM1,J) + ZZI * HI(IM1,J)
- HI(I,J) = HI(I,J) - ZZR * HI(IM1,J) - ZZI * HR(IM1,J)
- 500 CONTINUE
- 520 CONTINUE
- DO 640 J = MP1, EN
- XR = HR(J,J-1)
- XI = HI(J,J-1)
- HR(J,J-1) = 0.0
- HI(J,J-1) = 0.0
- IF (WR(J) .LE. 0.0) GO TO 580
- DO 540 I = 1, J
- ZZR = HR(I,J-1)
- HR(I,J-1) = HR(I,J)
- HR(I,J) = ZZR
- ZZI = HI(I,J-1)
- HI(I,J-1) = HI(I,J)
- HI(I,J) = ZZI
- 540 CONTINUE
- DO 560 I = LOW, IGH
- ZZR = ZR(I,J-1)
- ZR(I,J-1) = ZR(I,J)
- ZR(I,J) = ZZR
- ZZI = ZI(I,J-1)
- ZI(I,J-1) = ZI(I,J)
- ZI(I,J) = ZZI
- 560 CONTINUE
- 580 DO 600 I = 1, J
- HR(I,J-1) = HR(I,J-1) + XR * HR(I,J) - XI * HI(I,J)
- HI(I,J-1) = HI(I,J-1) + XR * HI(I,J) + XI * HR(I,J)
- 600 CONTINUE
- DO 620 I = LOW, IGH
- ZR(I,J-1) = ZR(I,J-1) + XR * ZR(I,J) - XI * ZI(I,J)
- ZI(I,J-1) = ZI(I,J-1) + XR * ZI(I,J) + XI * ZR(I,J)
- 620 CONTINUE
- 640 CONTINUE
- GO TO 240
- 660 HR(EN,EN) = HR(EN,EN) + TR
- WR(EN) = HR(EN,EN)
- HI(EN,EN) = HI(EN,EN) + TI
- WI(EN) = HI(EN,EN)
- EN = ENM1
- GO TO 220
- 680 IF (N .EQ. 1) GO TO 1001
- NORM = 0.0
- DO 720 I = 1, N
- DO 720 J = I, N
- NORM = NORM + ABS(HR(I,J)) + ABS(HI(I,J))
- 720 CONTINUE
- DO 800 NN = 2, N
- EN = N + 2 - NN
- XR = WR(EN)
- XI = WI(EN)
- ENM1 = EN - 1
- DO 780 II = 1, ENM1
- I = EN - II
- ZZR = HR(I,EN)
- ZZI = HI(I,EN)
- IF (I .EQ. ENM1) GO TO 760
- IP1 = I + 1
- DO 740 J = IP1, ENM1
- ZZR = ZZR + HR(I,J) * HR(J,EN) - HI(I,J) * HI(J,EN)
- ZZI = ZZI + HR(I,J) * HI(J,EN) + HI(I,J) * HR(J,EN)
- 740 CONTINUE
- 760 YR = XR - WR(I)
- YI = XI - WI(I)
- IF (YR .EQ. 0.0 .AND. YI .EQ. 0.0) YR = MACHEP * NORM
- Z = Z / Y
- HR(I,EN) = T3(1)
- HI(I,EN) = T3(2)
- 780 CONTINUE
- 800 CONTINUE
- ENM1 = N - 1
- DO 840 I = 1, ENM1
- IF (I .GE. LOW .AND. I .LE. IGH) GO TO 840
- IP1 = I + 1
- DO 820 J = IP1, N
- ZR(I,J) = HR(I,J)
- ZI(I,J) = HI(I,J)
- 820 CONTINUE
- 840 CONTINUE
- DO 880 JJ = LOW, ENM1
- J = N + LOW - JJ
- M = MIN(J-1,IGH)
- DO 880 I = LOW, IGH
- ZZR = ZR(I,J)
- ZZI = ZI(I,J)
- DO 860 K = LOW, M
- ZZR = ZZR + ZR(I,K) * HR(K,J) - ZI(I,K) * HI(K,J)
- ZZI = ZZI + ZR(I,K) * HI(K,J) + ZI(I,K) * HR(K,J)
- 860 CONTINUE
- ZR(I,J) = ZZR
- ZI(I,J) = ZZI
- 880 CONTINUE
- GO TO 1001
- 1000 IERR = EN
- 1001 RETURN
- END
diff --git a/src/mathlib/gen/f/dircos.F b/src/mathlib/gen/f/dircos.F
deleted file mode 100644
index 2fae251..0000000
--- a/src/mathlib/gen/f/dircos.F
+++ /dev/null
@@ -1,48 +0,0 @@
-*
-* $Id: dircos.F,v 1.1.1.1 1996/04/01 15:02:30 mclareni Exp $
-*
-* $Log: dircos.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:30 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE DIRCOS(A,B)
- COMMON /SLATE/G(9),F(9),ALAM,APHI,COSL,SINL,COSP,SINP,OUT(3),
- + XQX(13)
- DIMENSION A(2),B(3)
-C VARIABLE TRANSFORMATION
-C COS X = COS L * COS PHI
-C COS Y = COS L * SIN PHI
-C COS Z = SIN L
- ALAM= A(1)
- APHI= A(2)
- COSL= COS(ALAM)
- SINL= SIN(ALAM)
- COSP= COS(APHI)
- SINP= SIN(APHI)
- OUT(1)= COSL*COSP
- OUT(2)= COSL*SINP
- OUT(3)= SINL
- CALL UCOPY (OUT,B,3)
- RETURN
-C JACOBIAN
-C 0 -SIN L * COS PHI -COS L * SIN PHI
-C 0 -SIN L * SIN PHI COS L * COS PHI
-C 0 COS L 0
-#if (defined(CERNLIB_CDC))&&(defined(CERNLIB_F4))
- ENTRY ERDIRC
-#endif
-#if !defined(CERNLIB_CDC)||!defined(CERNLIB_F4)
- ENTRY ERDIRC(A,B)
-#endif
- CALL UZERO (F,1,9)
- F(2)= -SINL*COSP
- F(3)= -OUT(2)
- F(5)= -SINL*SINP
- F(6)= OUT(1)
- F(8)= COSL
- CALL MXMPY (F,A,G,3,3,3)
- CALL MXMPY1 (G,F,B,3,3,3)
- RETURN
- END
diff --git a/src/mathlib/gen/f/eiscg1.F b/src/mathlib/gen/f/eiscg1.F
deleted file mode 100644
index 8894298..0000000
--- a/src/mathlib/gen/f/eiscg1.F
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: eiscg1.F,v 1.1.1.1 1996/04/01 15:02:38 mclareni Exp $
-*
-* $Log: eiscg1.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:38 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE EISCG1(NM,N,AR,AI,WR,WI,ZR,ZI,IERR,WORK)
-C ALL EIGENVALUES AND CORRESPONDING EIGENVECTORS OF A COMPLEX
-C GENERAL MATRIX
-C
- DIMENSION AR(NM,NM),AI(NM,NM),ZR(NM,NM),ZI(NM,NM),WR(N),WI(N),
- 1 WORK(1)
- CALL CBAL(NM,N,AR,AI,LOW,IGH,WORK)
- CALL COMHES(NM,N,LOW,IGH,AR,AI,WORK(N+1))
- CALL COMLR2(NM,N,LOW,IGH,WORK(N+1),AR,AI,WR,WI,ZR,ZI,IERR)
- IF(IERR.NE.0) RETURN
- CALL CBABK2(NM,N,LOW,IGH,WORK,N,ZR,ZI)
- RETURN
- END
diff --git a/src/mathlib/gen/f/eiscg2.F b/src/mathlib/gen/f/eiscg2.F
deleted file mode 100644
index cf66959..0000000
--- a/src/mathlib/gen/f/eiscg2.F
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: eiscg2.F,v 1.1.1.1 1996/04/01 15:02:38 mclareni Exp $
-*
-* $Log: eiscg2.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:38 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE EISCG2(NM,N,AR,AI,WR,WI,IERR)
-C ALL EIGENVALUES OF A COMPLEX GENERAL MATRIX
-C
- DIMENSION AR(NM,NM),AI(NM,NM),WR(N),WI(N)
- CALL CBAL(NM,N,AR,AI,LOW,IGH,WR)
- CALL COMHES(NM,N,LOW,IGH,AR,AI,WR)
- CALL COMLR(NM,N,LOW,IGH,AR,AI,WR,WI,IERR)
- RETURN
- END
diff --git a/src/mathlib/gen/f/eisch1.F b/src/mathlib/gen/f/eisch1.F
deleted file mode 100644
index 87ef9da..0000000
--- a/src/mathlib/gen/f/eisch1.F
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: eisch1.F,v 1.1.1.1 1996/04/01 15:02:38 mclareni Exp $
-*
-* $Log: eisch1.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:38 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE EISCH1(NM,N,AR,AI,WR,ZR,ZI,IERR,WORK)
-C ALL EIGENVALUES AND CORRESPONDING EIGENVECTORS OF A COMPLEX
-C HERMITIAN MATRIX
-C
- DIMENSION AR(NM,NM),AI(NM,NM),WR(N),ZR(NM,NM),ZI(NM,NM),WORK(1)
- CALL HTRIDI(NM,N,AR,AI,WR,ZI,ZI,WORK)
- DO 100 I=1,N
- DO 50 J=1,N
- 50 ZR(I,J)=0.0
- 100 ZR(I,I)=1.0
- CALL TQL2(NM,N,WR,ZI,ZR,IERR)
- IF(IERR.NE.0) RETURN
- CALL HTRIBK(NM,N,AR,AI,WORK,N,ZR,ZI)
- RETURN
- END
diff --git a/src/mathlib/gen/f/eisch2.F b/src/mathlib/gen/f/eisch2.F
deleted file mode 100644
index cb64fc2..0000000
--- a/src/mathlib/gen/f/eisch2.F
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: eisch2.F,v 1.1.1.1 1996/04/01 15:02:39 mclareni Exp $
-*
-* $Log: eisch2.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:39 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE EISCH2(NM,N,AR,AI,WR,IERR,WORK)
-C ALL EIGENVALUES OF A COMPLEX HERMITIAN MATRIX
-C
- DIMENSION AR(NM,NM),AI(NM,NM),WR(N),WORK(1)
- CALL HTRIDI(NM,N,AR,AI,WR,WORK,WORK,WORK(N+1))
- CALL TQL1(N,WR,WORK,IERR)
- RETURN
- END
diff --git a/src/mathlib/gen/f/eisch3.F b/src/mathlib/gen/f/eisch3.F
deleted file mode 100644
index ec464e8..0000000
--- a/src/mathlib/gen/f/eisch3.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: eisch3.F,v 1.1.1.1 1996/04/01 15:02:39 mclareni Exp $
-*
-* $Log: eisch3.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:39 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE EISCH3(NM,N,AR,AI,RLB,RUB,MM,M,WR,ZR,ZI,IERR,WORK)
-C SOME EIGENVALUES AND CORRESPONDING EIGENVECTORS OF A COMPLEX
-C HERMITIAN MATRIX
-C
- DIMENSION AR(NM,NM),AI(NM,NM),WR(MM),ZR(NM,NM),ZI(NM,NM),WORK(1)
- CALL HTRIDI(NM,N,AR,AI,ZI,WORK,WORK(N+1),WORK(2*N+1))
- EPS1=0.0
- CALL BISECT(N,EPS1,ZI,WORK,WORK(N+1),RLB,RUB,MM,M,WR,WORK(9*N+1),
- X IERR,WORK(4*N+1),WORK(5*N+1))
- IF(IERR.NE.0) RETURN
- IF(M.EQ.0) RETURN
- CALL TINVIT(NM,N,ZI,WORK,WORK(N+1),M,WR,WORK(9*N+1),ZR,IERR,
- X WORK(4*N+1),WORK(5*N+1),WORK(6*N+1),WORK(7*N+1),WORK(8*N+1))
- IF(IERR.NE.0) RETURN
- CALL HTRIBK(NM,N,AR,AI,WORK(2*N+1),M,ZR,ZI)
- RETURN
- END
diff --git a/src/mathlib/gen/f/eisch4.F b/src/mathlib/gen/f/eisch4.F
deleted file mode 100644
index 44191b3..0000000
--- a/src/mathlib/gen/f/eisch4.F
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: eisch4.F,v 1.1.1.1 1996/04/01 15:02:39 mclareni Exp $
-*
-* $Log: eisch4.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:39 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE EISCH4(NM,N,AR,AI,RLB,RUB,MM,M,WR,IERR,WORK)
-C SOME EIGENVALUES OF A COMPLEX HERMITIAN MATRIX
-C
- DIMENSION AR(NM,NM),AI(NM,NM),WR(MM),WORK(1)
- CALL HTRIDI(NM,N,AR,AI,WORK,WORK(N+1),WORK(2*N+1),WORK(3*N+1))
- EPS1=0.0
- CALL BISECT(N,EPS1,WORK,WORK(N+1),WORK(2*N+1),RLB,RUB,MM,M,WR,
- X WORK(5*N+1),IERR,WORK(3*N+1),WORK(4*N+1))
- RETURN
- END
diff --git a/src/mathlib/gen/f/eisrg1.F b/src/mathlib/gen/f/eisrg1.F
deleted file mode 100644
index b9e280f..0000000
--- a/src/mathlib/gen/f/eisrg1.F
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: eisrg1.F,v 1.1.1.1 1996/04/01 15:02:39 mclareni Exp $
-*
-* $Log: eisrg1.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:39 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE EISRG1(NM,N,AR,WR,WI,ZR,IERR,WORK)
-C ALL EIGENVALUES AND CORRESPONDING EIGENVECTORS OF A REAL GENERAL
-C MATRIX
-C
- DIMENSION AR(NM,NM),WR(N),WI(N),ZR(NM,NM),WORK(1)
- CALL BALANC(NM,N,AR,LOW,IGH,WORK)
- CALL ELMHES(NM,N,LOW,IGH,AR,WORK(N+1))
- CALL ELTRAN(NM,N,LOW,IGH,AR,WORK(N+1),ZR)
- CALL HQR2(NM,N,LOW,IGH,AR,WR,WI,ZR,IERR)
- IF(IERR.NE.0) RETURN
- CALL BALBAK(NM,N,LOW,IGH,WORK,N,ZR)
- RETURN
- END
diff --git a/src/mathlib/gen/f/eisrg2.F b/src/mathlib/gen/f/eisrg2.F
deleted file mode 100644
index 42f5b79..0000000
--- a/src/mathlib/gen/f/eisrg2.F
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: eisrg2.F,v 1.1.1.1 1996/04/01 15:02:39 mclareni Exp $
-*
-* $Log: eisrg2.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:39 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE EISRG2(NM,N,AR,WR,WI,IERR)
-C ALL EIGENVALUES OF A REAL GENERAL MATRIX
-C
- DIMENSION AR(NM,NM),WR(N),WI(N)
- CALL BALANC(NM,N,AR,LOW,IGH,WR)
- CALL ELMHES(NM,N,LOW,IGH,AR,WR)
- CALL HQR(NM,N,LOW,IGH,AR,WR,WI,IERR)
- RETURN
- END
diff --git a/src/mathlib/gen/f/eisrs1.F b/src/mathlib/gen/f/eisrs1.F
deleted file mode 100644
index 66e4f55..0000000
--- a/src/mathlib/gen/f/eisrs1.F
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: eisrs1.F,v 1.1.1.1 1996/04/01 15:02:39 mclareni Exp $
-*
-* $Log: eisrs1.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:39 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE EISRS1(NM,N,AR,WR,ZR,IERR,WORK)
-C ALL EIGENVALUES AND CORRESPONDING EIGENVECTORS OF A REAL
-C SYMMETRIC MATRIX
-C
- DIMENSION AR(NM,NM),WR(N),ZR(NM,NM),WORK(1)
- CALL TRED2(NM,N,AR,WR,WORK,ZR)
- CALL TQL2(NM,N,WR,WORK,ZR,IERR)
- RETURN
- END
diff --git a/src/mathlib/gen/f/eisrs2.F b/src/mathlib/gen/f/eisrs2.F
deleted file mode 100644
index ad4c6ce..0000000
--- a/src/mathlib/gen/f/eisrs2.F
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: eisrs2.F,v 1.1.1.1 1996/04/01 15:02:39 mclareni Exp $
-*
-* $Log: eisrs2.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:39 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE EISRS2(NM,N,AR,WR,IERR,WORK)
-C ALL EIGENVALUES OF A REAL SYMMETRIC MATRIX
-C
- DIMENSION AR(NM,NM),WR(N),WORK(1)
- CALL TRED1(NM,N,AR,WR,WORK,WORK)
- CALL TQL1(N,WR,WORK,IERR)
- RETURN
- END
diff --git a/src/mathlib/gen/f/eisrs3.F b/src/mathlib/gen/f/eisrs3.F
deleted file mode 100644
index e0d94de..0000000
--- a/src/mathlib/gen/f/eisrs3.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: eisrs3.F,v 1.1.1.1 1996/04/01 15:02:39 mclareni Exp $
-*
-* $Log: eisrs3.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:39 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE EISRS3(NM,N,AR,RLB,RUB,MM,M,WR,ZR,IERR,WORK)
-C SOME EIGENVALUES AND CORRESPONDING EIGENVECTORS OF A REAL
-C SYMMETRIC MATRIX
-C
- DIMENSION AR(NM,NM),WR(N),ZR(NM,NM),WORK(1)
- CALL TRED1(NM,N,AR,WORK,WORK(N+1),WORK(2*N+1))
- EPS1=0.0
- CALL BISECT(N,EPS1,WORK,WORK(N+1),WORK(2*N+1),RLB,RUB,MM,M,WR,
- X WORK(8*N+1),IERR,WORK(3*N+1),WORK(4*N+1))
- IF(IERR.NE.0) RETURN
- IF(M.EQ.0) RETURN
- CALL TINVIT(NM,N,WORK,WORK(N+1),WORK(2*N+1),M,WR,WORK(8*N+1),ZR,
- X IERR,WORK(3*N+1),WORK(4*N+1),WORK(5*N+1),WORK(6*N+1),WORK(7*N+1))
- IF(IERR.NE.0) RETURN
- CALL TRBAK1(NM,N,AR,WORK(N+1),M,ZR)
- RETURN
- END
diff --git a/src/mathlib/gen/f/eisrs4.F b/src/mathlib/gen/f/eisrs4.F
deleted file mode 100644
index e8bd278..0000000
--- a/src/mathlib/gen/f/eisrs4.F
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: eisrs4.F,v 1.1.1.1 1996/04/01 15:02:39 mclareni Exp $
-*
-* $Log: eisrs4.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:39 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE EISRS4(NM,N,AR,RLB,RUB,MM,M,WR,IERR,WORK)
-C SOME EIGENVALUES OF A REAL SYMMETRIC MATRIX
-C
- DIMENSION AR(NM,NM),WR(MM),WORK(1)
- CALL TRED1(NM,N,AR,WORK,WORK(N+1),WORK(2*N+1))
- EPS1=0.
- CALL BISECT(N,EPS1,WORK,WORK(N+1),WORK(2*N+1),RLB,RUB,MM,M,WR,
- X WORK(5*N+1),IERR,WORK(3*N+1),WORK(4*N+1))
- RETURN
- END
diff --git a/src/mathlib/gen/f/eisst1.F b/src/mathlib/gen/f/eisst1.F
deleted file mode 100644
index c40b619..0000000
--- a/src/mathlib/gen/f/eisst1.F
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: eisst1.F,v 1.1.1.1 1996/04/01 15:02:39 mclareni Exp $
-*
-* $Log: eisst1.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:39 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE EISST1(NM,N,AR,WR,ZR,IERR,WORK)
-C ALL EIGENVALUES AND CORRESPONDING EIGENVECTORS OF A REAL
-C SYMMETRIC TRIDIAGONAL MATRIX
-C
- DIMENSION AR(NM,2),WR(N),ZR(NM,NM),WORK(N)
- DO 100 I=1,N
- DO 50 J=1,N
- 50 ZR(I,J)=0.0
- ZR(I,I)=1.0
- WR(I)=AR(I,2)
- 100 WORK(I)=AR(I,1)
- CALL IMTQL2(NM,N,WR,WORK,ZR,IERR)
- RETURN
- END
diff --git a/src/mathlib/gen/f/eisst2.F b/src/mathlib/gen/f/eisst2.F
deleted file mode 100644
index 26357e5..0000000
--- a/src/mathlib/gen/f/eisst2.F
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: eisst2.F,v 1.1.1.1 1996/04/01 15:02:40 mclareni Exp $
-*
-* $Log: eisst2.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:40 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE EISST2(NM,N,AR,WR,IERR,WORK)
-C ALL EIGENVALUES OF A REAL SYMMETRIC TRIDIAGONAL MATRIX
-C
- DIMENSION AR(NM,2),WR(N),WORK(N)
- DO 100 I=1,N
- WR(I)=AR(I,2)
- 100 WORK(I)=AR(I,1)
- CALL IMTQL1(N,WR,WORK,IERR)
- RETURN
- END
diff --git a/src/mathlib/gen/f/eisst3.F b/src/mathlib/gen/f/eisst3.F
deleted file mode 100644
index f31a3d0..0000000
--- a/src/mathlib/gen/f/eisst3.F
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: eisst3.F,v 1.1.1.1 1996/04/01 15:02:40 mclareni Exp $
-*
-* $Log: eisst3.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:40 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE EISST3(NM,N,AR,RLB,RUB,MM,M,WR,ZR,IERR,WORK)
-C SOME EIGENVALUES AND CORRESPONDING EIGENVECTORS OF A REAL
-C SYMMETRIC TRIDIAGONAL MATRIX
-C
- DIMENSION AR(NM,2),WR(MM),ZR(NM,NM),WORK(1)
- WORK(1)=AR(1,2)
- IF(N.LT.2) GO TO 150
- DO 100 I=2,N
- WORK(I)=AR(I,2)
- WORK(N+I)=AR(I,1)
- 100 WORK(2*N+I)=AR(I,1)**2
- 150 EPS1=0.0
- CALL BISECT(N,EPS1,WORK,WORK(N+1),WORK(2*N+1),RLB,RUB,MM,M,WR,
- X WORK(8*N+1),IERR,WORK(3*N+1),WORK(4*N+1))
- IF(IERR.NE.0) RETURN
- IF(M.EQ.0) RETURN
- CALL TINVIT(NM,N,WORK,WORK(N+1),WORK(2*N+1),M,WR,WORK(8*N+1),ZR,
- X IERR,WORK(3*N+1),WORK(4*N+1),WORK(5*N+1),WORK(6*N+1),WORK(7*N+1))
- RETURN
- END
diff --git a/src/mathlib/gen/f/eisst4.F b/src/mathlib/gen/f/eisst4.F
deleted file mode 100644
index b1a19cb..0000000
--- a/src/mathlib/gen/f/eisst4.F
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: eisst4.F,v 1.1.1.1 1996/04/01 15:02:40 mclareni Exp $
-*
-* $Log: eisst4.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:40 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE EISST4(NM,N,AR,RLB,RUB,MM,M,WR,IERR,WORK)
-C SOME EIGENVALUES OF A REAL SYMMETRIC TRIDIAGONAL MATRIX
-C
- DIMENSION AR(NM,2),WR(MM),WORK(1)
- WORK(1)=AR(1,2)
- IF(N.LT.2) GO TO 150
- DO 100 I=2,N
- WORK(I)=AR(I,2)
- WORK(N+I)=AR(I,1)
- 100 WORK(2*N+I)=AR(I,1)**2
- 150 EPS1=0.0
- CALL BISECT(N,EPS1,WORK,WORK(N+1),WORK(2*N+1),RLB,RUB,MM,M,WR,
- X WORK(5*N+1),IERR,WORK(3*N+1),WORK(4*N+1))
- RETURN
- END
diff --git a/src/mathlib/gen/f/elmbak.F b/src/mathlib/gen/f/elmbak.F
deleted file mode 100644
index 6770385..0000000
--- a/src/mathlib/gen/f/elmbak.F
+++ /dev/null
@@ -1,36 +0,0 @@
-*
-* $Id: elmbak.F,v 1.1.1.1 1996/04/01 15:02:34 mclareni Exp $
-*
-* $Log: elmbak.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:34 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE ELMBAK(NM,LOW,IGH,A,INT,M,Z)
- INTEGER I,J,M,LA,MM,MP,NM,IGH,KP1,LOW,MP1
- REAL A(NM,IGH),Z(NM,M)
- REAL X
- INTEGER INT(IGH)
- LA = IGH - 1
- KP1 = LOW + 1
- IF (LA .LT. KP1) GO TO 200
- DO 140 MM = KP1, LA
- MP = LOW + IGH - MM
- MP1 = MP + 1
- DO 110 I = MP1, IGH
- X = A(I,MP-1)
- IF (X .EQ. 0.0) GO TO 110
- DO 100 J = 1, M
- 100 Z(I,J) = Z(I,J) + X * Z(MP,J)
- 110 CONTINUE
- I = INT(MP)
- IF (I .EQ. MP) GO TO 140
- DO 130 J = 1, M
- X = Z(I,J)
- Z(I,J) = Z(MP,J)
- Z(MP,J) = X
- 130 CONTINUE
- 140 CONTINUE
- 200 RETURN
- END
diff --git a/src/mathlib/gen/f/elmhes.F b/src/mathlib/gen/f/elmhes.F
deleted file mode 100644
index 9e52f9f..0000000
--- a/src/mathlib/gen/f/elmhes.F
+++ /dev/null
@@ -1,53 +0,0 @@
-*
-* $Id: elmhes.F,v 1.1.1.1 1996/04/01 15:02:34 mclareni Exp $
-*
-* $Log: elmhes.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:34 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE ELMHES(NM,N,LOW,IGH,A,INT)
- INTEGER I,J,M,N,LA,NM,IGH,KP1,LOW,MM1,MP1
- REAL A(NM,N)
- REAL X,Y
- INTEGER INT(IGH)
- LA = IGH - 1
- KP1 = LOW + 1
- IF (LA .LT. KP1) GO TO 200
- DO 180 M = KP1, LA
- MM1 = M - 1
- X = 0.0
- I = M
- DO 100 J = M, IGH
- IF (ABS(A(J,MM1)) .LE. ABS(X)) GO TO 100
- X = A(J,MM1)
- I = J
- 100 CONTINUE
- INT(M) = I
- IF (I .EQ. M) GO TO 130
- DO 110 J = MM1, N
- Y = A(I,J)
- A(I,J) = A(M,J)
- A(M,J) = Y
- 110 CONTINUE
- DO 120 J = 1, IGH
- Y = A(J,I)
- A(J,I) = A(J,M)
- A(J,M) = Y
- 120 CONTINUE
- 130 IF (X .EQ. 0.0) GO TO 180
- MP1 = M + 1
- DO 160 I = MP1, IGH
- Y = A(I,MM1)
- IF (Y .EQ. 0.0) GO TO 160
- Y = Y / X
- A(I,MM1) = Y
- DO 140 J = M, N
- 140 A(I,J) = A(I,J) - Y * A(M,J)
- DO 150 J = 1, IGH
- 150 A(J,M) = A(J,M) + Y * A(J,I)
- 160 CONTINUE
- 180 CONTINUE
- 200 RETURN
- END
diff --git a/src/mathlib/gen/f/eltran.F b/src/mathlib/gen/f/eltran.F
deleted file mode 100644
index d0aa6cc..0000000
--- a/src/mathlib/gen/f/eltran.F
+++ /dev/null
@@ -1,35 +0,0 @@
-*
-* $Id: eltran.F,v 1.1.1.1 1996/04/01 15:02:34 mclareni Exp $
-*
-* $Log: eltran.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:34 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE ELTRAN(NM,N,LOW,IGH,A,INT,Z)
- INTEGER I,J,N,KL,MM,MP,NM,IGH,LOW,MP1
- REAL A(NM,IGH),Z(NM,N)
- INTEGER INT(IGH)
- DO 80 I = 1, N
- DO 60 J = 1, N
- 60 Z(I,J) = 0.0
- Z(I,I) = 1.0
- 80 CONTINUE
- KL = IGH - LOW - 1
- IF (KL .LT. 1) GO TO 200
- DO 140 MM = 1, KL
- MP = IGH - MM
- MP1 = MP + 1
- DO 100 I = MP1, IGH
- 100 Z(I,MP) = A(I,MP-1)
- I = INT(MP)
- IF (I .EQ. MP) GO TO 140
- DO 130 J = MP, IGH
- Z(MP,J) = Z(I,J)
- Z(I,J) = 0.0
- 130 CONTINUE
- Z(I,MP) = 1.0
- 140 CONTINUE
- 200 RETURN
- END
diff --git a/src/mathlib/gen/f/figi.F b/src/mathlib/gen/f/figi.F
deleted file mode 100644
index 974ed78..0000000
--- a/src/mathlib/gen/f/figi.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: figi.F,v 1.1.1.1 1996/04/01 15:02:34 mclareni Exp $
-*
-* $Log: figi.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:34 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE FIGI(NM,N,T,D,E,E2,IERR)
- INTEGER I,N,NM,IERR
- REAL T(NM,3),D(N),E(N),E2(N)
- IERR = 0
- DO 100 I = 1, N
- IF (I .EQ. 1) GO TO 90
- E2(I) = T(I,1) * T(I-1,3)
- IF (E2(I)) 1000, 60, 80
- 60 IF (T(I,1) .EQ. 0.0 .AND. T(I-1,3) .EQ. 0.0) GO TO 80
- IERR = -(3 * N + I)
- 80 E(I) = SQRT(E2(I))
- 90 D(I) = T(I,2)
- 100 CONTINUE
- GO TO 1001
- 1000 IERR = N + I
- 1001 RETURN
- END
diff --git a/src/mathlib/gen/f/figi2.F b/src/mathlib/gen/f/figi2.F
deleted file mode 100644
index 335ac11..0000000
--- a/src/mathlib/gen/f/figi2.F
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: figi2.F,v 1.1.1.1 1996/04/01 15:02:35 mclareni Exp $
-*
-* $Log: figi2.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:35 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE FIGI2(NM,N,T,D,E,Z,IERR)
- INTEGER I,J,N,NM,IERR
- REAL T(NM,3),D(N),E(N),Z(NM,N)
- REAL H
- IERR = 0
- DO 100 I = 1, N
- DO 50 J = 1, N
- 50 Z(I,J) = 0.0
- IF (I .EQ. 1) GO TO 70
- H = T(I,1) * T(I-1,3)
- IF (H) 900, 60, 80
- 60 IF (T(I,1) .NE. 0.0 .OR. T(I-1,3) .NE. 0.0) GO TO 1000
- E(I) = 0.0
- 70 Z(I,I) = 1.0
- GO TO 90
- 80 E(I) = SQRT(H)
- Z(I,I) = Z(I-1,I-1) * E(I) / T(I-1,3)
- 90 D(I) = T(I,2)
- 100 CONTINUE
- GO TO 1001
- 900 IERR = N + I
- GO TO 1001
- 1000 IERR = 2 * N + I
- 1001 RETURN
- END
diff --git a/src/mathlib/gen/f/gather.F b/src/mathlib/gen/f/gather.F
deleted file mode 100644
index 973f73a..0000000
--- a/src/mathlib/gen/f/gather.F
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: gather.F,v 1.1.1.1 1996/04/01 15:02:30 mclareni Exp $
-*
-* $Log: gather.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:30 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if (defined(CERNLIB_DOUBLE))&&(!defined(CERNLIB_QMIBMVF))
- SUBROUTINE GATHER(NW,OUT,HIN,INDX)
-C
-C CERN PROGLIB# F122 GATHER .VERSION GEN 2.30 890530
-C ORIG. 30/05/89 F. Antonelli IBM, FCA
-C
- DIMENSION OUT(*), HIN(*), INDX(*)
-C
- DO 10 J=1, NW
- OUT(J) = HIN(INDX(J))
- 10 CONTINUE
-C
- END
-#endif
diff --git a/src/mathlib/gen/f/hqr.F b/src/mathlib/gen/f/hqr.F
deleted file mode 100644
index b1013df..0000000
--- a/src/mathlib/gen/f/hqr.F
+++ /dev/null
@@ -1,142 +0,0 @@
-*
-* $Id: hqr.F,v 1.1.1.1 1996/04/01 15:02:35 mclareni Exp $
-*
-* $Log: hqr.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:35 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE HQR(NM,N,LOW,IGH,H,WR,WI,IERR)
- INTEGER I,J,K,L,M,N,EN,LL,MM,NA,NM,IGH,ITS,LOW,MP2,ENM2,IERR
- REAL H(NM,N),WR(N),WI(N)
- REAL P,Q,R,S,T,W,X,Y,ZZ,MACHEP
- LOGICAL NOTLAS
-#if defined(CERNLIB_CDC)
- MACHEP=2.**(-47)
-#endif
-#if !defined(CERNLIB_CDC)
- MACHEP=2.**(-23)
-#endif
- IERR = 0
- DO 50 I = 1, N
- IF (I .GE. LOW .AND. I .LE. IGH) GO TO 50
- WR(I) = H(I,I)
- WI(I) = 0.0
- 50 CONTINUE
- EN = IGH
- T = 0.0
- 60 IF (EN .LT. LOW) GO TO 1001
- ITS = 0
- NA = EN - 1
- ENM2 = NA - 1
- 70 DO 80 LL = LOW, EN
- L = EN + LOW - LL
- IF (L .EQ. LOW) GO TO 100
- IF (ABS(H(L,L-1)) .LE. MACHEP * (ABS(H(L-1,L-1))
- X + ABS(H(L,L)))) GO TO 100
- 80 CONTINUE
- 100 X = H(EN,EN)
- IF (L .EQ. EN) GO TO 270
- Y = H(NA,NA)
- W = H(EN,NA) * H(NA,EN)
- IF (L .EQ. NA) GO TO 280
- IF (ITS .EQ. 30) GO TO 1000
- IF (ITS .NE. 10 .AND. ITS .NE. 20) GO TO 130
- T = T + X
- DO 120 I = LOW, EN
- 120 H(I,I) = H(I,I) - X
- S = ABS(H(EN,NA)) + ABS(H(NA,ENM2))
- X = 0.75 * S
- Y = X
- W = -0.4375 * S * S
- 130 ITS = ITS + 1
- DO 140 MM = L, ENM2
- M = ENM2 + L - MM
- ZZ = H(M,M)
- R = X - ZZ
- S = Y - ZZ
- P = (R * S - W) / H(M+1,M) + H(M,M+1)
- Q = H(M+1,M+1) - ZZ - R - S
- R = H(M+2,M+1)
- S = ABS(P) + ABS(Q) + ABS(R)
- P = P / S
- Q = Q / S
- R = R / S
- IF (M .EQ. L) GO TO 150
- IF (ABS(H(M,M-1)) * (ABS(Q) + ABS(R)) .LE. MACHEP * ABS(P)
- X * (ABS(H(M-1,M-1)) + ABS(ZZ) + ABS(H(M+1,M+1)))) GO TO 150
- 140 CONTINUE
- 150 MP2 = M + 2
- DO 160 I = MP2, EN
- H(I,I-2) = 0.0
- IF (I .EQ. MP2) GO TO 160
- H(I,I-3) = 0.0
- 160 CONTINUE
- DO 260 K = M, NA
- NOTLAS = K .NE. NA
- IF (K .EQ. M) GO TO 170
- P = H(K,K-1)
- Q = H(K+1,K-1)
- R = 0.0
- IF (NOTLAS) R = H(K+2,K-1)
- X = ABS(P) + ABS(Q) + ABS(R)
- IF (X .EQ. 0.0) GO TO 260
- P = P / X
- Q = Q / X
- R = R / X
- 170 S = SIGN(SQRT(P*P+Q*Q+R*R),P)
- IF (K .EQ. M) GO TO 180
- H(K,K-1) = -S * X
- GO TO 190
- 180 IF (L .NE. M) H(K,K-1) = -H(K,K-1)
- 190 P = P + S
- X = P / S
- Y = Q / S
- ZZ = R / S
- Q = Q / P
- R = R / P
- DO 210 J = K, EN
- P = H(K,J) + Q * H(K+1,J)
- IF (.NOT. NOTLAS) GO TO 200
- P = P + R * H(K+2,J)
- H(K+2,J) = H(K+2,J) - P * ZZ
- 200 H(K+1,J) = H(K+1,J) - P * Y
- H(K,J) = H(K,J) - P * X
- 210 CONTINUE
- J = MIN(EN,K+3)
- DO 230 I = L, J
- P = X * H(I,K) + Y * H(I,K+1)
- IF (.NOT. NOTLAS) GO TO 220
- P = P + ZZ * H(I,K+2)
- H(I,K+2) = H(I,K+2) - P * R
- 220 H(I,K+1) = H(I,K+1) - P * Q
- H(I,K) = H(I,K) - P
- 230 CONTINUE
- 260 CONTINUE
- GO TO 70
- 270 WR(EN) = X + T
- WI(EN) = 0.0
- EN = NA
- GO TO 60
- 280 P = (Y - X) / 2.0
- Q = P * P + W
- ZZ = SQRT(ABS(Q))
- X = X + T
- IF (Q .LT. 0.0) GO TO 320
- ZZ = P + SIGN(ZZ,P)
- WR(NA) = X + ZZ
- WR(EN) = WR(NA)
- IF (ZZ .NE. 0.0) WR(EN) = X - W / ZZ
- WI(NA) = 0.0
- WI(EN) = 0.0
- GO TO 330
- 320 WR(NA) = X + P
- WR(EN) = X + P
- WI(NA) = ZZ
- WI(EN) = -ZZ
- 330 EN = ENM2
- GO TO 60
- 1000 IERR = EN
- 1001 RETURN
- END
diff --git a/src/mathlib/gen/f/hqr2.F b/src/mathlib/gen/f/hqr2.F
deleted file mode 100644
index 24b04a8..0000000
--- a/src/mathlib/gen/f/hqr2.F
+++ /dev/null
@@ -1,286 +0,0 @@
-*
-* $Id: hqr2.F,v 1.1.1.1 1996/04/01 15:02:35 mclareni Exp $
-*
-* $Log: hqr2.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:35 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE HQR2(NM,N,LOW,IGH,H,WR,WI,Z,IERR)
- INTEGER I,J,K,L,M,N,EN,II,JJ,LL,MM,NA,NM,NN,
- X IGH,ITS,LOW,MP2,ENM2,IERR
- REAL H(NM,N),WR(N),WI(N),Z(NM,N)
- REAL P,Q,R,S,T,W,X,Y,RA,SA,VI,VR,ZZ,NORM,MACHEP
- LOGICAL NOTLAS
- COMPLEX Z3
- REAL T3(2)
- EQUIVALENCE (Z3,T3(1))
-#if defined(CERNLIB_CDC)
- MACHEP=2.**(-47)
-#endif
-#if !defined(CERNLIB_CDC)
- MACHEP=2.**(-23)
-#endif
- IERR = 0
- DO 50 I = 1, N
- IF (I .GE. LOW .AND. I .LE. IGH) GO TO 50
- WR(I) = H(I,I)
- WI(I) = 0.0
- 50 CONTINUE
- EN = IGH
- T = 0.0
- 60 IF (EN .LT. LOW) GO TO 340
- ITS = 0
- NA = EN - 1
- ENM2 = NA - 1
- 70 DO 80 LL = LOW, EN
- L = EN + LOW - LL
- IF (L .EQ. LOW) GO TO 100
- IF (ABS(H(L,L-1)) .LE. MACHEP * (ABS(H(L-1,L-1))
- X + ABS(H(L,L)))) GO TO 100
- 80 CONTINUE
- 100 X = H(EN,EN)
- IF (L .EQ. EN) GO TO 270
- Y = H(NA,NA)
- W = H(EN,NA) * H(NA,EN)
- IF (L .EQ. NA) GO TO 280
- IF (ITS .EQ. 30) GO TO 1000
- IF (ITS .NE. 10 .AND. ITS .NE. 20) GO TO 130
- T = T + X
- DO 120 I = LOW, EN
- 120 H(I,I) = H(I,I) - X
- S = ABS(H(EN,NA)) + ABS(H(NA,ENM2))
- X = 0.75 * S
- Y = X
- W = -0.4375 * S * S
- 130 ITS = ITS + 1
- DO 140 MM = L, ENM2
- M = ENM2 + L - MM
- ZZ = H(M,M)
- R = X - ZZ
- S = Y - ZZ
- P = (R * S - W) / H(M+1,M) + H(M,M+1)
- Q = H(M+1,M+1) - ZZ - R - S
- R = H(M+2,M+1)
- S = ABS(P) + ABS(Q) + ABS(R)
- P = P / S
- Q = Q / S
- R = R / S
- IF (M .EQ. L) GO TO 150
- IF (ABS(H(M,M-1)) * (ABS(Q) + ABS(R)) .LE. MACHEP * ABS(P)
- X * (ABS(H(M-1,M-1)) + ABS(ZZ) + ABS(H(M+1,M+1)))) GO TO 150
- 140 CONTINUE
- 150 MP2 = M + 2
- DO 160 I = MP2, EN
- H(I,I-2) = 0.0
- IF (I .EQ. MP2) GO TO 160
- H(I,I-3) = 0.0
- 160 CONTINUE
- DO 260 K = M, NA
- NOTLAS = K .NE. NA
- IF (K .EQ. M) GO TO 170
- P = H(K,K-1)
- Q = H(K+1,K-1)
- R = 0.0
- IF (NOTLAS) R = H(K+2,K-1)
- X = ABS(P) + ABS(Q) + ABS(R)
- IF (X .EQ. 0.0) GO TO 260
- P = P / X
- Q = Q / X
- R = R / X
- 170 S = SIGN(SQRT(P*P+Q*Q+R*R),P)
- IF (K .EQ. M) GO TO 180
- H(K,K-1) = -S * X
- GO TO 190
- 180 IF (L .NE. M) H(K,K-1) = -H(K,K-1)
- 190 P = P + S
- X = P / S
- Y = Q / S
- ZZ = R / S
- Q = Q / P
- R = R / P
- DO 210 J = K, N
- P = H(K,J) + Q * H(K+1,J)
- IF (.NOT. NOTLAS) GO TO 200
- P = P + R * H(K+2,J)
- H(K+2,J) = H(K+2,J) - P * ZZ
- 200 H(K+1,J) = H(K+1,J) - P * Y
- H(K,J) = H(K,J) - P * X
- 210 CONTINUE
- J = MIN(EN,K+3)
- DO 230 I = 1, J
- P = X * H(I,K) + Y * H(I,K+1)
- IF (.NOT. NOTLAS) GO TO 220
- P = P + ZZ * H(I,K+2)
- H(I,K+2) = H(I,K+2) - P * R
- 220 H(I,K+1) = H(I,K+1) - P * Q
- H(I,K) = H(I,K) - P
- 230 CONTINUE
- DO 250 I = LOW, IGH
- P = X * Z(I,K) + Y * Z(I,K+1)
- IF (.NOT. NOTLAS) GO TO 240
- P = P + ZZ * Z(I,K+2)
- Z(I,K+2) = Z(I,K+2) - P * R
- 240 Z(I,K+1) = Z(I,K+1) - P * Q
- Z(I,K) = Z(I,K) - P
- 250 CONTINUE
- 260 CONTINUE
- GO TO 70
- 270 H(EN,EN) = X + T
- WR(EN) = H(EN,EN)
- WI(EN) = 0.0
- EN = NA
- GO TO 60
- 280 P = (Y - X) / 2.0
- Q = P * P + W
- ZZ = SQRT(ABS(Q))
- H(EN,EN) = X + T
- X = H(EN,EN)
- H(NA,NA) = Y + T
- IF (Q .LT. 0.0) GO TO 320
- ZZ = P + SIGN(ZZ,P)
- WR(NA) = X + ZZ
- WR(EN) = WR(NA)
- IF (ZZ .NE. 0.0) WR(EN) = X - W / ZZ
- WI(NA) = 0.0
- WI(EN) = 0.0
- X = H(EN,NA)
- R = SQRT(X*X+ZZ*ZZ)
- P = X / R
- Q = ZZ / R
- DO 290 J = NA, N
- ZZ = H(NA,J)
- H(NA,J) = Q * ZZ + P * H(EN,J)
- H(EN,J) = Q * H(EN,J) - P * ZZ
- 290 CONTINUE
- DO 300 I = 1, EN
- ZZ = H(I,NA)
- H(I,NA) = Q * ZZ + P * H(I,EN)
- H(I,EN) = Q * H(I,EN) - P * ZZ
- 300 CONTINUE
- DO 310 I = LOW, IGH
- ZZ = Z(I,NA)
- Z(I,NA) = Q * ZZ + P * Z(I,EN)
- Z(I,EN) = Q * Z(I,EN) - P * ZZ
- 310 CONTINUE
- GO TO 330
- 320 WR(NA) = X + P
- WR(EN) = X + P
- WI(NA) = ZZ
- WI(EN) = -ZZ
- 330 EN = ENM2
- GO TO 60
- 340 NORM = 0.0
- K = 1
- DO 360 I = 1, N
- DO 350 J = K, N
- 350 NORM = NORM + ABS(H(I,J))
- K = I
- 360 CONTINUE
- IF (NORM .EQ. 0.0) GO TO 1001
- DO 800 NN = 1, N
- EN = N + 1 - NN
- P = WR(EN)
- Q = WI(EN)
- NA = EN - 1
- IF (Q) 710, 600, 800
- 600 M = EN
- H(EN,EN) = 1.0
- IF (NA .EQ. 0) GO TO 800
- DO 700 II = 1, NA
- I = EN - II
- W = H(I,I) - P
- R = H(I,EN)
- IF (M .GT. NA) GO TO 620
- DO 610 J = M, NA
- 610 R = R + H(I,J) * H(J,EN)
- 620 IF (WI(I) .GE. 0.0) GO TO 630
- ZZ = W
- S = R
- GO TO 700
- 630 M = I
- IF (WI(I) .NE. 0.0) GO TO 640
- T = W
- IF (W .EQ. 0.0) T = MACHEP * NORM
- H(I,EN) = -R / T
- GO TO 700
- 640 X = H(I,I+1)
- Y = H(I+1,I)
- Q = (WR(I) - P) * (WR(I) - P) + WI(I) * WI(I)
- T = (X * S - ZZ * R) / Q
- H(I,EN) = T
- IF (ABS(X) .LE. ABS(ZZ)) GO TO 650
- H(I+1,EN) = (-R - W * T) / X
- GO TO 700
- 650 H(I+1,EN) = (-S - Y * T) / ZZ
- 700 CONTINUE
- GO TO 800
- 710 M = NA
- IF (ABS(H(EN,NA)) .LE. ABS(H(NA,EN))) GO TO 720
- H(NA,NA) = Q / H(EN,NA)
- H(NA,EN) = -(H(EN,EN) - P) / H(EN,NA)
- GO TO 730
- 720 Z3 = CMPLX(0.0,-H(NA,EN)) / CMPLX(H(NA,NA)-P,Q)
- H(NA,NA) = T3(1)
- H(NA,EN) = T3(2)
- 730 H(EN,NA) = 0.0
- H(EN,EN) = 1.0
- ENM2 = NA - 1
- IF (ENM2 .EQ. 0) GO TO 800
- DO 790 II = 1, ENM2
- I = NA - II
- W = H(I,I) - P
- RA = 0.0
- SA = H(I,EN)
- DO 760 J = M, NA
- RA = RA + H(I,J) * H(J,NA)
- SA = SA + H(I,J) * H(J,EN)
- 760 CONTINUE
- IF (WI(I) .GE. 0.0) GO TO 770
- ZZ = W
- R = RA
- S = SA
- GO TO 790
- 770 M = I
- IF (WI(I) .NE. 0.0) GO TO 780
- Z3 = CMPLX(-RA,-SA) / CMPLX(W,Q)
- H(I,NA) = T3(1)
- H(I,EN) = T3(2)
- GO TO 790
- 780 X = H(I,I+1)
- Y = H(I+1,I)
- VR = (WR(I) - P) * (WR(I) - P) + WI(I) * WI(I) - Q * Q
- VI = (WR(I) - P) * 2.0 * Q
- IF (VR .EQ. 0.0 .AND. VI .EQ. 0.0) VR = MACHEP * NORM
- X * (ABS(W) + ABS(Q) + ABS(X) + ABS(Y) + ABS(ZZ))
- Z3 = CMPLX(X*R-ZZ*RA+Q*SA,X*S-ZZ*SA-Q*RA) / CMPLX(VR,VI)
- H(I,NA) = T3(1)
- H(I,EN) = T3(2)
- IF (ABS(X) .LE. ABS(ZZ) + ABS(Q)) GO TO 785
- H(I+1,NA) = (-RA - W * H(I,NA) + Q * H(I,EN)) / X
- H(I+1,EN) = (-SA - W * H(I,EN) - Q * H(I,NA)) / X
- GO TO 790
- 785 Z3 = CMPLX(-R-Y*H(I,NA),-S-Y*H(I,EN)) / CMPLX(ZZ,Q)
- H(I+1,NA) = T3(1)
- H(I+1,EN) = T3(2)
- 790 CONTINUE
- 800 CONTINUE
- DO 840 I = 1, N
- IF (I .GE. LOW .AND. I .LE. IGH) GO TO 840
- DO 820 J = I, N
- 820 Z(I,J) = H(I,J)
- 840 CONTINUE
- DO 880 JJ = LOW, N
- J = N + LOW - JJ
- M = MIN(J,IGH)
- DO 880 I = LOW, IGH
- ZZ = 0.0
- DO 860 K = LOW, M
- 860 ZZ = ZZ + Z(I,K) * H(K,J)
- Z(I,J) = ZZ
- 880 CONTINUE
- GO TO 1001
- 1000 IERR = EN
- 1001 RETURN
- END
diff --git a/src/mathlib/gen/f/htribk.F b/src/mathlib/gen/f/htribk.F
deleted file mode 100644
index c1a9d38..0000000
--- a/src/mathlib/gen/f/htribk.F
+++ /dev/null
@@ -1,40 +0,0 @@
-*
-* $Id: htribk.F,v 1.1.1.1 1996/04/01 15:02:36 mclareni Exp $
-*
-* $Log: htribk.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:36 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE HTRIBK(NM,N,AR,AI,TAU,M,ZR,ZI)
- INTEGER I,J,K,L,M,N,NM
- REAL AR(NM,N),AI(NM,N),TAU(2,N),ZR(NM,M),ZI(NM,M)
- REAL H,S,SI
- DO 50 K = 1, N
- DO 50 J = 1, M
- ZI(K,J) = - ZR(K,J) * TAU(2,K)
- ZR(K,J) = ZR(K,J) * TAU(1,K)
- 50 CONTINUE
- IF (N .EQ. 1) GO TO 200
- DO 140 I = 2, N
- L = I - 1
- H = AI(I,I)
- IF (H .EQ. 0.0) GO TO 140
- DO 130 J = 1, M
- S = 0.0
- SI = 0.0
- DO 110 K = 1, L
- S = S + AR(I,K) * ZR(K,J) - AI(I,K) * ZI(K,J)
- SI = SI + AR(I,K) * ZI(K,J) + AI(I,K) * ZR(K,J)
- 110 CONTINUE
- S = S / H
- SI = SI / H
- DO 120 K = 1, L
- ZR(K,J) = ZR(K,J) - S * AR(I,K) - SI * AI(I,K)
- ZI(K,J) = ZI(K,J) - SI * AR(I,K) + S * AI(I,K)
- 120 CONTINUE
- 130 CONTINUE
- 140 CONTINUE
- 200 RETURN
- END
diff --git a/src/mathlib/gen/f/htridi.F b/src/mathlib/gen/f/htridi.F
deleted file mode 100644
index 96c06fc..0000000
--- a/src/mathlib/gen/f/htridi.F
+++ /dev/null
@@ -1,96 +0,0 @@
-*
-* $Id: htridi.F,v 1.1.1.1 1996/04/01 15:02:36 mclareni Exp $
-*
-* $Log: htridi.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:36 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE HTRIDI(NM,N,AR,AI,D,E,E2,TAU)
- INTEGER I,J,K,L,N,II,NM,JP1
- REAL AR(NM,N),AI(NM,N),D(N),E(N),E2(N),TAU(2,N)
- REAL F,FI,G,GI,H,HH,SI,SCALE
- TAU(1,N) = 1.0
- TAU(2,N) = 0.0
- DO 100 I = 1, N
- 100 D(I) = AR(I,I)
- DO 300 II = 1, N
- I = N + 1 - II
- L = I - 1
- H = 0.0
- SCALE = 0.0
- IF (L .LT. 1) GO TO 130
- DO 120 K = 1, L
- 120 SCALE = SCALE + ABS(AR(I,K)) + ABS(AI(I,K))
- IF (SCALE .NE. 0.0) GO TO 140
- TAU(1,L) = 1.0
- TAU(2,L) = 0.0
- 130 E(I) = 0.0
- E2(I) = 0.0
- GO TO 290
- 140 DO 150 K = 1, L
- AR(I,K) = AR(I,K) / SCALE
- AI(I,K) = AI(I,K) / SCALE
- H = H + AR(I,K) * AR(I,K) + AI(I,K) * AI(I,K)
- 150 CONTINUE
- E2(I) = SCALE * SCALE * H
- G = SQRT(H)
- E(I) = SCALE * G
- F = ABS(CMPLX(AR(I,L),AI(I,L)))
- IF (F .EQ. 0.0) GO TO 160
- TAU(1,L) = (AI(I,L) * TAU(2,I) - AR(I,L) * TAU(1,I)) / F
- SI = (AR(I,L) * TAU(2,I) + AI(I,L) * TAU(1,I)) / F
- H = H + F * G
- G = 1.0 + G / F
- AR(I,L) = G * AR(I,L)
- AI(I,L) = G * AI(I,L)
- IF (L .EQ. 1) GO TO 270
- GO TO 170
- 160 TAU(1,L) = -TAU(1,I)
- SI = TAU(2,I)
- AR(I,L) = G
- 170 F = 0.0
- DO 240 J = 1, L
- G = 0.0
- GI = 0.0
- DO 180 K = 1, J
- G = G + AR(J,K) * AR(I,K) + AI(J,K) * AI(I,K)
- GI = GI - AR(J,K) * AI(I,K) + AI(J,K) * AR(I,K)
- 180 CONTINUE
- JP1 = J + 1
- IF (L .LT. JP1) GO TO 220
- DO 200 K = JP1, L
- G = G + AR(K,J) * AR(I,K) - AI(K,J) * AI(I,K)
- GI = GI - AR(K,J) * AI(I,K) - AI(K,J) * AR(I,K)
- 200 CONTINUE
- 220 E(J) = G / H
- TAU(2,J) = GI / H
- F = F + E(J) * AR(I,J) - TAU(2,J) * AI(I,J)
- 240 CONTINUE
- HH = F / (H + H)
- DO 260 J = 1, L
- F = AR(I,J)
- G = E(J) - HH * F
- E(J) = G
- FI = -AI(I,J)
- GI = TAU(2,J) - HH * FI
- TAU(2,J) = -GI
- DO 260 K = 1, J
- AR(J,K) = AR(J,K) - F * E(K) - G * AR(I,K)
- X + FI * TAU(2,K) + GI * AI(I,K)
- AI(J,K) = AI(J,K) - F * TAU(2,K) - G * AI(I,K)
- X - FI * E(K) - GI * AR(I,K)
- 260 CONTINUE
- 270 DO 280 K = 1, L
- AR(I,K) = SCALE * AR(I,K)
- AI(I,K) = SCALE * AI(I,K)
- 280 CONTINUE
- TAU(2,L) = -SI
- 290 HH = D(I)
- D(I) = AR(I,I)
- AR(I,I) = HH
- AI(I,I) = SCALE * SCALE * H
- 300 CONTINUE
- RETURN
- END
diff --git a/src/mathlib/gen/f/iilz.F b/src/mathlib/gen/f/iilz.F
deleted file mode 100644
index 0d0fe9d..0000000
--- a/src/mathlib/gen/f/iilz.F
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: iilz.F,v 1.1.1.1 1996/04/01 15:02:30 mclareni Exp $
-*
-* $Log: iilz.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:30 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_VAX)||defined(CERNLIB_NORD)||defined(CERNLIB_UNIX)
- FUNCTION IILZ(NW,IA,INC)
-C
-C CERN PROGLIB# F122 IILZ .VERSION GEN 2.30 890530
-C ORIG. 30/05/89 F. Antonelli IBM, FCA
-C
- DIMENSION IA(*)
-C
- IRES = 0
- IF(INC.GT.0) THEN
- IBEG = 1
- IEND = (NW-1)*INC+1
- ELSE
- IBEG = (1-NW)*INC+1
- IEND = 1
- END IF
- DO 10 J=IBEG, IEND, INC
- IF(IA(J).NE.0) GO TO 777
- IRES = IRES + 1
- 10 CONTINUE
-C
- 777 IILZ = IRES
-C
- END
-#endif
diff --git a/src/mathlib/gen/f/ilsum.F b/src/mathlib/gen/f/ilsum.F
deleted file mode 100644
index 4c44ec1..0000000
--- a/src/mathlib/gen/f/ilsum.F
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: ilsum.F,v 1.1.1.1 1996/04/01 15:02:30 mclareni Exp $
-*
-* $Log: ilsum.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:30 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if (defined(CERNLIB_DOUBLE))&&(!defined(CERNLIB_QMIBMVF))
- FUNCTION ILSUM(NW,LA,INC)
-C
-C CERN PROGLIB# F122 ILSUM .VERSION GEN 2.30 890530
-C ORIG. 30/05/89 F. Antonelli IBM, FCA
-C
- LOGICAL LA(*)
-C
- ILLSUM = 0
- IF(INC.GT.0) THEN
- IBEG = 1
- IEND = (NW-1)*INC+1
- ELSE
- IBEG = (1-NW)*INC+1
- IEND = 1
- END IF
- DO 10 J=IBEG, IEND, INC
- IF(LA(J)) ILLSUM = ILLSUM + 1
- 10 CONTINUE
-C
- ILSUM = ILLSUM
-C
- END
-#endif
diff --git a/src/mathlib/gen/f/imtql1.F b/src/mathlib/gen/f/imtql1.F
deleted file mode 100644
index c125380..0000000
--- a/src/mathlib/gen/f/imtql1.F
+++ /dev/null
@@ -1,81 +0,0 @@
-*
-* $Id: imtql1.F,v 1.1.1.1 1996/04/01 15:02:36 mclareni Exp $
-*
-* $Log: imtql1.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:36 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE IMTQL1(N,D,E,IERR)
- INTEGER I,J,L,M,N,II,MML,IERR
- REAL D(N),E(N)
- REAL B,C,F,G,P,R,S,MACHEP
-#if defined(CERNLIB_CDC)
- MACHEP=2.**(-47)
-#endif
-#if !defined(CERNLIB_CDC)
- MACHEP=2.**(-23)
-#endif
- IERR = 0
- IF (N .EQ. 1) GO TO 1001
- DO 100 I = 2, N
- 100 E(I-1) = E(I)
- E(N) = 0.0
- DO 290 L = 1, N
- J = 0
- 105 DO 110 M = L, N
- IF (M .EQ. N) GO TO 120
- IF (ABS(E(M)) .LE. MACHEP * (ABS(D(M)) + ABS(D(M+1))))
- X GO TO 120
- 110 CONTINUE
- 120 P = D(L)
- IF (M .EQ. L) GO TO 215
- IF (J .EQ. 30) GO TO 1000
- J = J + 1
- G = (D(L+1) - P) / (2.0 * E(L))
- R = SQRT(G*G+1.0)
- G = D(M) - P + E(L) / (G + SIGN(R,G))
- S = 1.0
- C = 1.0
- P = 0.0
- MML = M - L
- DO 200 II = 1, MML
- I = M - II
- F = S * E(I)
- B = C * E(I)
- IF (ABS(F) .LT. ABS(G)) GO TO 150
- C = G / F
- R = SQRT(C*C+1.0)
- E(I+1) = F * R
- S = 1.0 / R
- C = C * S
- GO TO 160
- 150 S = F / G
- R = SQRT(S*S+1.0)
- E(I+1) = G * R
- C = 1.0 / R
- S = S * C
- 160 G = D(I+1) - P
- R = (D(I) - G) * S + 2.0 * C * B
- P = S * R
- D(I+1) = G + P
- G = C * R - B
- 200 CONTINUE
- D(L) = D(L) - P
- E(L) = G
- E(M) = 0.0
- GO TO 105
- 215 IF (L .EQ. 1) GO TO 250
- DO 230 II = 2, L
- I = L + 2 - II
- IF (P .GE. D(I-1)) GO TO 270
- D(I) = D(I-1)
- 230 CONTINUE
- 250 I = 1
- 270 D(I) = P
- 290 CONTINUE
- GO TO 1001
- 1000 IERR = L
- 1001 RETURN
- END
diff --git a/src/mathlib/gen/f/imtql2.F b/src/mathlib/gen/f/imtql2.F
deleted file mode 100644
index 0923825..0000000
--- a/src/mathlib/gen/f/imtql2.F
+++ /dev/null
@@ -1,96 +0,0 @@
-*
-* $Id: imtql2.F,v 1.1.1.1 1996/04/01 15:02:37 mclareni Exp $
-*
-* $Log: imtql2.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:37 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE IMTQL2(NM,N,D,E,Z,IERR)
- INTEGER I,J,K,L,M,N,II,NM,MML,IERR
- REAL D(N),E(N),Z(NM,N)
- REAL B,C,F,G,P,R,S,MACHEP
-#if defined(CERNLIB_CDC)
- MACHEP=2.**(-47)
-#endif
-#if !defined(CERNLIB_CDC)
- MACHEP=2.**(-23)
-#endif
- IERR = 0
- IF (N .EQ. 1) GO TO 1001
- DO 100 I = 2, N
- 100 E(I-1) = E(I)
- E(N) = 0.0
- DO 240 L = 1, N
- J = 0
- 105 DO 110 M = L, N
- IF (M .EQ. N) GO TO 120
- IF (ABS(E(M)) .LE. MACHEP * (ABS(D(M)) + ABS(D(M+1))))
- X GO TO 120
- 110 CONTINUE
- 120 P = D(L)
- IF (M .EQ. L) GO TO 240
- IF (J .EQ. 30) GO TO 1000
- J = J + 1
- G = (D(L+1) - P) / (2.0 * E(L))
- R = SQRT(G*G+1.0)
- G = D(M) - P + E(L) / (G + SIGN(R,G))
- S = 1.0
- C = 1.0
- P = 0.0
- MML = M - L
- DO 200 II = 1, MML
- I = M - II
- F = S * E(I)
- B = C * E(I)
- IF (ABS(F) .LT. ABS(G)) GO TO 150
- C = G / F
- R = SQRT(C*C+1.0)
- E(I+1) = F * R
- S = 1.0 / R
- C = C * S
- GO TO 160
- 150 S = F / G
- R = SQRT(S*S+1.0)
- E(I+1) = G * R
- C = 1.0 / R
- S = S * C
- 160 G = D(I+1) - P
- R = (D(I) - G) * S + 2.0 * C * B
- P = S * R
- D(I+1) = G + P
- G = C * R - B
- DO 180 K = 1, N
- F = Z(K,I+1)
- Z(K,I+1) = S * Z(K,I) + C * F
- Z(K,I) = C * Z(K,I) - S * F
- 180 CONTINUE
- 200 CONTINUE
- D(L) = D(L) - P
- E(L) = G
- E(M) = 0.0
- GO TO 105
- 240 CONTINUE
- DO 300 II = 2, N
- I = II - 1
- K = I
- P = D(I)
- DO 260 J = II, N
- IF (D(J) .GE. P) GO TO 260
- K = J
- P = D(J)
- 260 CONTINUE
- IF (K .EQ. I) GO TO 300
- D(K) = D(I)
- D(I) = P
- DO 280 J = 1, N
- P = Z(J,I)
- Z(J,I) = Z(J,K)
- Z(J,K) = P
- 280 CONTINUE
- 300 CONTINUE
- GO TO 1001
- 1000 IERR = L
- 1001 RETURN
- END
diff --git a/src/mathlib/gen/f/invit.F b/src/mathlib/gen/f/invit.F
deleted file mode 100644
index 90d48d5..0000000
--- a/src/mathlib/gen/f/invit.F
+++ /dev/null
@@ -1,206 +0,0 @@
-*
-* $Id: invit.F,v 1.1.1.1 1996/04/01 15:02:37 mclareni Exp $
-*
-* $Log: invit.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:37 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE INVIT(NM,N,A,WR,WI,SELECT,MM,M,Z,IERR,RM3,RV1,RV2)
- INTEGER I,J,K,M,N,S,II,IP,MM,MP,NM,UK,IP1,ITS,KM1,IERR
- REAL A(NM,N),WR(N),WI(N),Z(NM,MM),RM3(N,*),RV1(N),RV2(N)
- REAL W,X,Y,EPS3,NORM,NORMV,GROWTO,ILAMBD,MACHEP,RLAMBD,UKROOT
- LOGICAL SELECT(N)
- COMPLEX Z3
- REAL T3(2)
- EQUIVALENCE (Z3,T3(1))
-#if defined(CERNLIB_CDC)
- MACHEP=2.**(-47)
-#endif
-#if !defined(CERNLIB_CDC)
- MACHEP=2.**(-23)
-#endif
- IERR = 0
- UK = 0
- S = 1
- IP = 0
- DO 980 K = 1, N
- IF (WI(K) .EQ. 0.0 .OR. IP .LT. 0) GO TO 100
- IP = 1
- IF (SELECT(K) .AND. SELECT(K+1)) SELECT(K+1) = .FALSE.
- 100 IF (.NOT. SELECT(K)) GO TO 960
- IF (WI(K) .NE. 0.0) S = S + 1
- IF (S .GT. MM) GO TO 1000
- IF (UK .GE. K) GO TO 200
- DO 120 UK = K, N
- IF (UK .EQ. N) GO TO 140
- IF (A(UK+1,UK) .EQ. 0.0) GO TO 140
- 120 CONTINUE
- 140 NORM = 0.0
- MP = 1
- DO 180 I = 1, UK
- X = 0.0
- DO 160 J = MP, UK
- 160 X = X + ABS(A(I,J))
- IF (X .GT. NORM) NORM = X
- MP = I
- 180 CONTINUE
- IF (NORM .EQ. 0.0) NORM = 1.0
- EPS3 = MACHEP * NORM
- UKROOT = SQRT(REAL(UK))
- GROWTO = 1.0E-1 / UKROOT
- 200 RLAMBD = WR(K)
- ILAMBD = WI(K)
- IF (K .EQ. 1) GO TO 280
- KM1 = K - 1
- GO TO 240
- 220 RLAMBD = RLAMBD + EPS3
- 240 DO 260 II = 1, KM1
- I = K - II
- IF (SELECT(I) .AND. ABS(WR(I)-RLAMBD) .LT. EPS3 .AND.
- X ABS(WI(I)-ILAMBD) .LT. EPS3) GO TO 220
- 260 CONTINUE
- WR(K) = RLAMBD
- IP1 = K + IP
- WR(IP1) = RLAMBD
- 280 MP = 1
- DO 320 I = 1, UK
- DO 300 J = MP, UK
- 300 RM3(J,I) = A(I,J)
- RM3(I,I) = RM3(I,I) - RLAMBD
- MP = I
- RV1(I) = EPS3
- 320 CONTINUE
- ITS = 0
- IF (ILAMBD .NE. 0.0) GO TO 520
- IF (UK .EQ. 1) GO TO 420
- DO 400 I = 2, UK
- MP = I - 1
- IF (ABS(RM3(MP,I)) .LE. ABS(RM3(MP,MP))) GO TO 360
- DO 340 J = MP, UK
- Y = RM3(J,I)
- RM3(J,I) = RM3(J,MP)
- RM3(J,MP) = Y
- 340 CONTINUE
- 360 IF (RM3(MP,MP) .EQ. 0.0) RM3(MP,MP) = EPS3
- X = RM3(MP,I) / RM3(MP,MP)
- IF (X .EQ. 0.0) GO TO 400
- DO 380 J = I, UK
- 380 RM3(J,I) = RM3(J,I) - X * RM3(J,MP)
- 400 CONTINUE
- 420 IF (RM3(UK,UK) .EQ. 0.0) RM3(UK,UK) = EPS3
- 440 DO 500 II = 1, UK
- I = UK + 1 - II
- Y = RV1(I)
- IF (I .EQ. UK) GO TO 480
- IP1 = I + 1
- DO 460 J = IP1, UK
- 460 Y = Y - RM3(J,I) * RV1(J)
- 480 RV1(I) = Y / RM3(I,I)
- 500 CONTINUE
- GO TO 740
- 520 RM3(1,3) = -ILAMBD
- DO 540 I = 2, UK
- 540 RM3(1,I+2) = 0.0
- DO 640 I = 2, UK
- MP = I - 1
- W = RM3(MP,I)
- X = RM3(MP,MP) * RM3(MP,MP) + RM3(MP,I+1) * RM3(MP,I+1)
- IF (W * W .LE. X) GO TO 580
- X = RM3(MP,MP) / W
- Y = RM3(MP,I+1) / W
- RM3(MP,MP) = W
- RM3(MP,I+1) = 0.0
- DO 560 J = I, UK
- W = RM3(J,I)
- RM3(J,I) = RM3(J,MP) - X * W
- RM3(J,MP) = W
- RM3(I,J+2) = RM3(MP,J+2) - Y * W
- RM3(MP,J+2) = 0.0
- 560 CONTINUE
- RM3(MP,I+2) = -ILAMBD
- RM3(I,I) = RM3(I,I) - Y * ILAMBD
- RM3(I,I+2) = RM3(I,I+2) + X * ILAMBD
- GO TO 640
- 580 IF (X .NE. 0.0) GO TO 600
- RM3(MP,MP) = EPS3
- RM3(MP,I+1) = 0.0
- X = EPS3 * EPS3
- 600 W = W / X
- X = RM3(MP,MP) * W
- Y = -RM3(MP,I+1) * W
- DO 620 J = I, UK
- RM3(J,I) = RM3(J,I) - X * RM3(J,MP) + Y * RM3(MP,J+2)
- RM3(I,J+2) = -X * RM3(MP,J+2) - Y * RM3(J,MP)
- 620 CONTINUE
- RM3(I,I+2) = RM3(I,I+2) - ILAMBD
- 640 CONTINUE
- IF (RM3(UK,UK) .EQ. 0.0 .AND.
- X RM3(UK,UK+2) .EQ. 0.0) RM3(UK,UK) = EPS3
- 660 DO 720 II = 1, UK
- I = UK + 1 - II
- X = RV1(I)
- Y = 0.0
- IF (I .EQ. UK) GO TO 700
- IP1 = I + 1
- DO 680 J = IP1, UK
- X = X - RM3(J,I) * RV1(J) + RM3(I,J+2) * RV2(J)
- Y = Y - RM3(J,I) * RV2(J) - RM3(I,J+2) * RV1(J)
- 680 CONTINUE
- 700 Z3 = CMPLX(X,Y) / CMPLX(RM3(I,I),RM3(I,I+2))
- RV1(I) = T3(1)
- RV2(I) = T3(2)
- 720 CONTINUE
- 740 ITS = ITS + 1
- NORM = 0.0
- NORMV = 0.0
- DO 780 I = 1, UK
- IF (ILAMBD .EQ. 0.0) X = ABS(RV1(I))
- IF (ILAMBD .NE. 0.0) X = ABS(CMPLX(RV1(I),RV2(I)))
- IF (NORMV .GE. X) GO TO 760
- NORMV = X
- J = I
- 760 NORM = NORM + X
- 780 CONTINUE
- IF (NORM .LT. GROWTO) GO TO 840
- X = RV1(J)
- IF (ILAMBD .EQ. 0.0) X = 1.0 / X
- IF (ILAMBD .NE. 0.0) Y = RV2(J)
- DO 820 I = 1, UK
- IF (ILAMBD .NE. 0.0) GO TO 800
- Z(I,S) = RV1(I) * X
- GO TO 820
- 800 Z3 = CMPLX(RV1(I),RV2(I)) / CMPLX(X,Y)
- Z(I,S-1) = T3(1)
- Z(I,S) = T3(2)
- 820 CONTINUE
- IF (UK .EQ. N) GO TO 940
- J = UK + 1
- GO TO 900
- 840 IF (ITS .GE. UK) GO TO 880
- X = UKROOT
- Y = EPS3 / (X + 1.0)
- RV1(1) = EPS3
- DO 860 I = 2, UK
- 860 RV1(I) = Y
- J = UK - ITS + 1
- RV1(J) = RV1(J) - EPS3 * X
- IF (ILAMBD .EQ. 0.0) GO TO 440
- GO TO 660
- 880 J = 1
- IERR = -K
- 900 DO 920 I = J, N
- Z(I,S) = 0.0
- IF (ILAMBD .NE. 0.0) Z(I,S-1) = 0.0
- 920 CONTINUE
- 940 S = S + 1
- 960 IF (IP .EQ. (-1)) IP = 0
- IF (IP .EQ. 1) IP = -1
- 980 CONTINUE
- GO TO 1001
- 1000 IF (IERR .NE. 0) IERR = IERR - N
- IF (IERR .EQ. 0) IERR = -(2 * N + 1)
- 1001 M = S - 1 - ABS(IP)
- RETURN
- END
diff --git a/src/mathlib/gen/f/lihoin128.F b/src/mathlib/gen/f/lihoin128.F
deleted file mode 100644
index 205080d..0000000
--- a/src/mathlib/gen/f/lihoin128.F
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: lihoin128.F,v 1.1.1.1 1996/04/01 15:02:40 mclareni Exp $
-*
-* $Log: lihoin128.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:40 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if !defined(CERNLIB_DOUBLE)
- SUBROUTINE DLHOIN(A,MA,M,N,MAXV,V,NV,NVEC,EPS,IOUT,W,IW)
-#include "gen/imp128.inc"
-C
- CHARACTER NAME*(*)
- PARAMETER (NAME = 'DLHOIN')
- CALL MTLPRT(NAME,'F500.0','Not available on this machine')
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/f/lihoin64.F b/src/mathlib/gen/f/lihoin64.F
deleted file mode 100644
index 7acfe28..0000000
--- a/src/mathlib/gen/f/lihoin64.F
+++ /dev/null
@@ -1,195 +0,0 @@
-*
-* $Id: lihoin64.F,v 1.1.1.1 1996/04/01 15:02:40 mclareni Exp $
-*
-* $Log: lihoin64.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:40 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- SUBROUTINE DLHOIN(A,MA,M,N,MAXV,V,NV,NVEC,EPS,IOUT,W,IW)
-
-C Solving Systems of Homogeneous Linear Inequalities.
-C Based on K.S. Koelbig and F. Schwarz, A Programm for Solving
-C Systems of Homogeneous Linear Inequalities,
-C Computer Phys. Comm. 17 (1979) 375-382
-
-#include "gen/imp64.inc"
- CHARACTER TEXT*(*)
- CHARACTER NAME*(*)
- CHARACTER*80 ERRTXT
- PARAMETER (NAME = 'DLHOIN')
- PARAMETER (TEXT = '+++++ CERN F500 DLHOIN ... ')
-
- DIMENSION A(MA,*),V(NV,*),IW(MA,*),W(MAXV,*)
-
- IF(MAXV .LT. N) THEN
- CALL MTLPRT(NAME,'F500.1','MAXV TOO SMALL')
- RETURN
- END IF
-C
-C*****SETS INITIAL VALUES FOR BOOKKEEPING
-C
- DO 3 I = 1,M
- IW(I,1)=0
- 3 IW(I,2)=I
- DO 8 I = 1,N
- IW(I,2)=0
- 8 IW(I,5)=I
- NINC=N
- NVEC=N
-C
-C*****DETERMINES N BASIS VECTORS OF THE INITIAL POLYHEDRAL CONE
-C
- CALL DMCPY(N,N,A(1,1),A(1,2),A(2,1),V(1,1),V(1,2),V(2,1))
- CALL DINV(N,V,NV,W,IFAIL)
- IF(IFAIL .EQ. -1) THEN
- CALL MTLPRT(NAME,'F500.2','MATRIX A(N,N) SINGULAR')
- RETURN
- END IF
- DO 1 I = 1,NVEC
- S=DVMPY(N,V(1,I),V(2,I),V(1,I),V(2,I))
- 1 CALL DVSCL(N,1/SQRT(S),V(1,I),V(2,I),V(1,I),V(2,I))
-
- IF(IOUT .EQ. 1) THEN
- WRITE(6,111) TEXT
- DO 80 I = 1,NVEC,7
- DO 81 J = 1,N
- 81 WRITE(6,'(1X,I9,7E15.6)') J,(V(J,I1),I1=I,MIN(NVEC,I+6))
- 80 WRITE(6,'(1X)')
- END IF
-C
-C*****COMPUTES MATRIX OF SCALAR PRODUCTS
-C
- 17 DO 20 I = 1,NINC
- DO 20 K = 1,NVEC
- 20 W(K,I)=DVMPY(N,A(IW(I,5),1),A(IW(I,5),2),V(1,K),V(2,K))
-
- IF(IOUT .EQ. 1) THEN
- WRITE(6,112) TEXT
- DO 82 J = 1,NVEC,7
- DO 83 I = 1,NINC
- 83 WRITE(6,'(1X,I9,7E15.6)') I,(W(J2,I),J2=J,MIN(NVEC,J+6))
- 82 WRITE(6,'(1X)')
- END IF
-
-C*****DETERMINES REDUNDANT INEQUALITIES AND CHOOSES NEW ONE
-
- DO 40 K = 1,M
- IW(K,3)=0
- IF(IW(K,2) .EQ. 0) GO TO 40
- DO 45 I = 1,NVEC
- IF(DVMPY(N,A(K,1),A(K,2),V(1,I),V(2,I)) .GT. 0) IW(K,3)=IW(K,3)+1
- 45 CONTINUE
- 40 CONTINUE
- NNEG=NVEC
- DO 48 K = 1,M
- IF(IW(K,2) .EQ. 0) GO TO 48
- IF(IW(K,3) .EQ. 0) THEN
- WRITE(ERRTXT,103) K
- CALL MTLPRT(NAME,'F500.3',ERRTXT)
- RETURN
- END IF
- IF(IW(K,3) .EQ. NVEC) THEN
- IW(K,1)=K
- IW(K,2)=0
- END IF
- IF(IW(K,3) .LT. NNEG) THEN
- NNEG=IW(K,3)
- KNEW=K
- END IF
- 48 CONTINUE
- IF(NNEG .EQ. NVEC) THEN
- DO 74 I = 1,M
- IW(I,1)=I
- DO 75 J = 1,NVEC
- IF(DVMPY(N,A(I,1),A(I,2),V(1,J),V(2,J)) .GE. EPS) GO TO 75
- IW(I,1)=0
- GO TO 74
- 75 CONTINUE
- 74 CONTINUE
- RETURN
- END IF
-
- IF(IOUT .EQ. 1) WRITE(6,113) TEXT,KNEW
- IW(KNEW,2)=0
-C
-C*****COMPUTES VECTOR OF SCALAR PRODUCTS
-C
- DO 50 I = 1,NVEC
- 50 W(I,M+1)=DVMPY(N,A(KNEW,1),A(KNEW,2),V(1,I),V(2,I))
-
- IF(IOUT .EQ. 1) THEN
- WRITE(6,114) TEXT
- DO 84 J = 1,NVEC,7
- 84 WRITE(6,'(1X,I9,7E15.6)') J,(W(J2,M+1),J2=J,MIN(NVEC,J+6))
- WRITE(6,'(1X)')
- END IF
-C
-C*****DETERMINES BASIS VECTORS FOR NEW CONE
-C
- NTVE=NVEC
- DO 60 I = 1,NVEC-1
- DO 60 J = I+1,NVEC
- IF(W(I,M+1)*W(J,M+1) .GT. 0) GO TO 60
- NT=0
- DO 62 L = 1,NINC
- IW(L,4)=1
- IF(ABS(W(I,L)) .GT. EPS .OR. ABS(W(J,L)) .GT. EPS) GO TO 62
- NT=NT+1
- IW(L,4)=0
- 62 CONTINUE
- IF(NT .LT. N-2) GO TO 60
- DO 63 K = 1,NVEC
- IF(K .EQ. I .OR. K .EQ. J) GO TO 63
- MT=0
- DO 64 L = 1,NINC
- IF(IW(L,4) .EQ. 0 .AND. ABS(W(K,L)) .LT. EPS) MT=MT+1
- 64 CONTINUE
- IF(MT .EQ. N-2) GO TO 60
- 63 CONTINUE
- NTVE=NTVE+1
- IF(NTVE .GT. MAXV) THEN
- CALL MTLPRT(NAME,'F500.1','MAXV TOO SMALL')
- RETURN
- END IF
- DO 65 L = 1,N
- 65 V(L,NTVE)=ABS(W(J,M+1))*V(L,I)+ABS(W(I,M+1))*V(L,J)
- 60 CONTINUE
- DO 66 I = 1,NTVE
- S=DVMPY(N,V(1,I),V(2,I),V(1,I),V(2,I))
- 66 CALL DVSCL(N,1/SQRT(S),V(1,I),V(2,I),V(1,I),V(2,I))
-C
-C*****ELIMINATES VECTORS WITH NEGATIVE SCALAR PRODUCT
-C
- NNEW=0
- DO 70 I = 1,NVEC
- IF(W(I,M+1) .LT. 0) GO TO 70
- NNEW=NNEW+1
- CALL DVCPY(N,V(1,I),V(2,I),V(1,NNEW),V(2,NNEW))
- 70 CONTINUE
- DO 71 I = NVEC+1,NTVE
- NNEW=NNEW+1
- 71 CALL DVCPY(N,V(1,I),V(2,I),V(1,NNEW),V(2,NNEW))
- CALL DMSET(N,NTVE-NNEW,0D0,V(1,NNEW+1),V(1,NNEW+2),V(2,NNEW+1))
- NVEC=NNEW
- NINC=NINC+1
- IW(NINC,5)=KNEW
-
- IF(IOUT .EQ. 1) THEN
- WRITE(6,115) TEXT
- DO 86 I = 1,NVEC,7
- DO 87 J = 1,N
- 87 WRITE(6,'(1X,I9,7E15.6)') J,(V(J,I2),I2=I,MIN(NVEC,I+6))
- 86 WRITE(6,'(1X)')
- END IF
- GO TO 17
- 103 FORMAT('INEQUALITY ',I5,' IS INCONSISTENT')
- 111 FORMAT(7X,A27,'THE N BASIS VECTORS OF THE FIRST CONE'/)
- 112 FORMAT(7X,A27,'THE MATRIX OF SCALAR PRODUCTS'/)
- 113 FORMAT(7X,A27,'THE NEW INEQUALITY HAS INDEX',I5/)
- 114 FORMAT(7X,A27,'THE VECTOR OF SCALAR PRODUCTS'/)
- 115 FORMAT(7X,A27,'THE MATRIX OF BASIS VECTORS'/)
- END
-#endif
diff --git a/src/mathlib/gen/f/mxdipr.F b/src/mathlib/gen/f/mxdipr.F
deleted file mode 100644
index b0b3574..0000000
--- a/src/mathlib/gen/f/mxdipr.F
+++ /dev/null
@@ -1,30 +0,0 @@
-*
-* $Id: mxdipr.F,v 1.1.1.1 1996/04/01 15:02:32 mclareni Exp $
-*
-* $Log: mxdipr.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:32 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE MXDIPR(A,B,C,IAD,JBD,IJD,IA,KA,JB,LB)
-C
-C THIS ROUTINE COMPUTES THE DIRECT, OR TENSOR, OR KRONECKER, PRODUCT
-C OF TWO MATRICES A AND B, AND STORES THE RESULT IN C.
-C
- DIMENSION A(IAD,1),B(JBD,1),C(IJD,1)
-C
- IAJB=IA*JB
- KALB=KA*LB
- IF(IAJB*KALB .EQ. 0) RETURN
- JB1=JB-1
- LB1=LB-1
- DO 1 I = 1,IAJB
- IIA=(I+JB1)/JB
- IIB=MOD(I-1,JB)+1
- DO 1 K = 1,KALB
- KKA=(K+LB1)/LB
- KKB=MOD(K-1,LB)+1
- 1 C(I,K)=A(IIA,KKA)*B(IIB,KKB)
- RETURN
- END
diff --git a/src/mathlib/gen/f/ortbak.F b/src/mathlib/gen/f/ortbak.F
deleted file mode 100644
index 74dc5ef..0000000
--- a/src/mathlib/gen/f/ortbak.F
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: ortbak.F,v 1.1.1.1 1996/04/01 15:02:37 mclareni Exp $
-*
-* $Log: ortbak.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:37 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE ORTBAK(NM,LOW,IGH,A,ORT,M,Z)
- INTEGER I,J,M,LA,MM,MP,NM,IGH,KP1,LOW,MP1
- REAL A(NM,IGH),ORT(IGH),Z(NM,M)
- REAL G,H
- LA = IGH - 1
- KP1 = LOW + 1
- IF (LA .LT. KP1) GO TO 200
- DO 140 MM = KP1, LA
- MP = LOW + IGH - MM
- H = A(MP,MP-1) * ORT(MP)
- IF (H .EQ. 0.0) GO TO 140
- MP1 = MP + 1
- DO 100 I = MP1, IGH
- 100 ORT(I) = A(I,MP-1)
- DO 130 J = 1, M
- G = 0.0
- DO 110 I = MP, IGH
- 110 G = G + ORT(I) * Z(I,J)
- G = G / H
- DO 120 I = MP, IGH
- 120 Z(I,J) = Z(I,J) + G * ORT(I)
- 130 CONTINUE
- 140 CONTINUE
- 200 RETURN
- END
diff --git a/src/mathlib/gen/f/orthes.F b/src/mathlib/gen/f/orthes.F
deleted file mode 100644
index f33f77d..0000000
--- a/src/mathlib/gen/f/orthes.F
+++ /dev/null
@@ -1,57 +0,0 @@
-*
-* $Id: orthes.F,v 1.1.1.1 1996/04/01 15:02:37 mclareni Exp $
-*
-* $Log: orthes.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:37 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE ORTHES(NM,N,LOW,IGH,A,ORT)
- INTEGER I,J,M,N,II,JJ,LA,MP,NM,IGH,KP1,LOW
- REAL A(NM,N),ORT(IGH)
- REAL F,G,H,SCALE
- LA = IGH - 1
- KP1 = LOW + 1
- IF (LA .LT. KP1) GO TO 200
- DO 180 M = KP1, LA
- H = 0.0
- ORT(M) = 0.0
- SCALE = 0.0
- DO 90 I = M, IGH
- 90 SCALE = SCALE + ABS(A(I,M-1))
- IF (SCALE .EQ. 0.0) GO TO 180
- MP = M + IGH
- DO 100 II = M, IGH
- I = MP - II
- ORT(I) = A(I,M-1) / SCALE
- H = H + ORT(I) * ORT(I)
- 100 CONTINUE
- G = -SIGN(SQRT(H),ORT(M))
- H = H - ORT(M) * G
- ORT(M) = ORT(M) - G
- DO 130 J = M, N
- F = 0.0
- DO 110 II = M, IGH
- I = MP - II
- F = F + ORT(I) * A(I,J)
- 110 CONTINUE
- F = F / H
- DO 120 I = M, IGH
- 120 A(I,J) = A(I,J) - F * ORT(I)
- 130 CONTINUE
- DO 160 I = 1, IGH
- F = 0.0
- DO 140 JJ = M, IGH
- J = MP - JJ
- F = F + ORT(J) * A(I,J)
- 140 CONTINUE
- F = F / H
- DO 150 J = M, IGH
- 150 A(I,J) = A(I,J) - F * ORT(J)
- 160 CONTINUE
- ORT(M) = SCALE * ORT(M)
- A(M,M-1) = SCALE * G
- 180 CONTINUE
- 200 RETURN
- END
diff --git a/src/mathlib/gen/f/ortran.F b/src/mathlib/gen/f/ortran.F
deleted file mode 100644
index dadce57..0000000
--- a/src/mathlib/gen/f/ortran.F
+++ /dev/null
@@ -1,38 +0,0 @@
-*
-* $Id: ortran.F,v 1.1.1.1 1996/04/01 15:02:37 mclareni Exp $
-*
-* $Log: ortran.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:37 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE ORTRAN(NM,N,LOW,IGH,A,ORT,Z)
- INTEGER I,J,N,KL,MM,MP,NM,IGH,LOW,MP1
- REAL A(NM,IGH),ORT(IGH),Z(NM,N)
- REAL G,H
- DO 80 I = 1, N
- DO 60 J = 1, N
- 60 Z(I,J) = 0.0
- Z(I,I) = 1.0
- 80 CONTINUE
- KL = IGH - LOW - 1
- IF (KL .LT. 1) GO TO 200
- DO 140 MM = 1, KL
- MP = IGH - MM
- H = A(MP,MP-1) * ORT(MP)
- IF (H .EQ. 0.0) GO TO 140
- MP1 = MP + 1
- DO 100 I = MP1, IGH
- 100 ORT(I) = A(I,MP-1)
- DO 130 J = MP, IGH
- G = 0.0
- DO 110 I = MP, IGH
- 110 G = G + ORT(I) * Z(I,J)
- G = G / H
- DO 120 I = MP, IGH
- 120 Z(I,J) = Z(I,J) + G * ORT(I)
- 130 CONTINUE
- 140 CONTINUE
- 200 RETURN
- END
diff --git a/src/mathlib/gen/f/polrot.F b/src/mathlib/gen/f/polrot.F
deleted file mode 100644
index 6f26dae..0000000
--- a/src/mathlib/gen/f/polrot.F
+++ /dev/null
@@ -1,72 +0,0 @@
-*
-* $Id: polrot.F,v 1.1.1.1 1996/04/01 15:02:29 mclareni Exp $
-*
-* $Log: polrot.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:29 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE POLROT(THETA,PHI,THPRIM,PHPRIM,THAXE,PHAXE,ROTANG)
-C
-C SUBROUTINE POUR CALCULER UNE ROTATION EN COORDONNEES POLAIRES
-C
-C THAXE,PHAXE=DIRECTION DE L#AXE,ROTANG=ANGLE DE ROTATION
-C
-C PI=3.14159265
-C
-C SI THPRIM = 0.0,PHPRIM A N#IMPORTE QUELLE VALEUR
-C
- DIMENSION X(3),TENSO1(3),TENSO2(3),TENSO3(3)
- DATA PI/3.14159265/,PIHALF/1.57079633/
- A=COS(ROTANG)
- B=1.0-A
- C=SIN(ROTANG)
- AX=SIN(THAXE)
- E1=AX*COS(PHAXE)
- E2=AX*SIN(PHAXE)
- E3=COS(THAXE)
- ET=SIN(THETA)
- X(1)=ET*COS(PHI)
- X(2)=ET*SIN(PHI)
- X(3)=COS(THETA)
- B12=B*E1*E2
- B13=B*E1*E3
- B23=B*E2*E3
- C1=C*E1
- C2=C*E2
- C3=C*E3
- TENSO1(1)=A+B*E1**2
- TENSO1(2)=B12+C3
- TENSO1(3)=B13-C2
- TENSO2(1)=B12-C3
- TENSO2(2)=A+B*E2**2
- TENSO2(3)=B23+C1
- TENSO3(1)=B13+C2
- TENSO3(2)=B23-C1
- TENSO3(3)=A+B*E3**2
- Y1=0.0
- Y2=0.0
- Y3=0.0
- DO 3 K=1,3
- Y1=Y1+TENSO1(K)*X(K)
- Y2=Y2+TENSO2(K)*X(K)
- 3 Y3=Y3+TENSO3(K)*X(K)
- IF(Y1.NE.0.OR.Y2.NE.0.)GO TO 12
- PHPRIM=0.0
- THPRIM=PIHALF-SIGN(PIHALF,Y3)
- GO TO 13
- 12 PHPRIM=ATAN2(Y2,Y1)
- IF(PHPRIM)1,2,2
- 1 PHPRIM=PHPRIM+2.0*PI
- 2 CONTINUE
- IF(Y1.NE.0.OR.Y3.NE.0.)GO TO 15
- THPRIM=PIHALF
- GO TO 13
- 15 COPHPR=COS(PHPRIM)
- IF(ABS(COPHPR).LT.0.7)GO TO 5
- THPRIM=ATAN2(Y1/COS(PHPRIM),Y3)
- GO TO 13
- 5 THPRIM=ATAN2(Y2/SIN(PHPRIM),Y3)
- 13 RETURN
- END
diff --git a/src/mathlib/gen/f/ratqr.F b/src/mathlib/gen/f/ratqr.F
deleted file mode 100644
index ddf024b..0000000
--- a/src/mathlib/gen/f/ratqr.F
+++ /dev/null
@@ -1,122 +0,0 @@
-*
-* $Id: ratqr.F,v 1.1.1.1 1996/04/01 15:02:37 mclareni Exp $
-*
-* $Log: ratqr.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:37 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE RATQR(N,EPS1,D,E,E2,M,W,IND,BD,TYPE,IDEF,IERR)
- INTEGER I,J,K,M,N,II,JJ,K1,IDEF,IERR,JDEF
- REAL D(N),E(N),E2(N),W(N),BD(N)
- REAL F,P,Q,R,S,EP,QP,ERR,TOT,EPS1,DELTA,MACHEP
- INTEGER IND(M)
- LOGICAL TYPE
-#if defined(CERNLIB_CDC)
- MACHEP=2.**(-47)
-#endif
-#if !defined(CERNLIB_CDC)
- MACHEP=2.**(-23)
-#endif
- IERR = 0
- JDEF = IDEF
- DO 20 I = 1, N
- 20 W(I) = D(I)
- IF (TYPE) GO TO 40
- J = 1
- GO TO 400
- 40 ERR = 0.0
- S = 0.0
- TOT = W(1)
- Q = 0.0
- J = 0
- DO 100 I = 1, N
- P = Q
- IF (I .EQ. 1) GO TO 60
- IF (P .GT. MACHEP * (ABS(D(I)) + ABS(D(I-1)))) GO TO 80
- 60 E2(I) = 0.0
- J = J + 1
- 80 BD(I) = E2(I)
- IND(I) = J
- Q = 0.0
- IF (I .NE. N) Q = ABS(E(I+1))
- TOT = MIN(W(I)-P-Q,TOT)
- 100 CONTINUE
- IF (JDEF .EQ. 1 .AND. TOT .LT. 0.0) GO TO 140
- DO 110 I = 1, N
- 110 W(I) = W(I) - TOT
- GO TO 160
- 140 TOT = 0.0
- 160 DO 360 K = 1, M
- 180 TOT = TOT + S
- DELTA = W(N) - S
- I = N
- F = ABS(MACHEP*TOT)
- IF (EPS1 .LT. F) EPS1 = F
- IF (DELTA .GT. EPS1) GO TO 190
- IF (DELTA .LT. (-EPS1)) GO TO 1000
- GO TO 300
- 190 IF (K .EQ. N) GO TO 210
- K1 = K + 1
- DO 200 J = K1, N
- IF (BD(J) .LE. (MACHEP*(W(J)+W(J-1))) ** 2) BD(J) = 0.0
- 200 CONTINUE
- 210 F = BD(N) / DELTA
- QP = DELTA + F
- P = 1.0
- IF (K .EQ. N) GO TO 260
- K1 = N - K
- DO 240 II = 1, K1
- I = N - II
- Q = W(I) - S - F
- R = Q / QP
- P = P * R + 1.0
- EP = F * R
- W(I+1) = QP + EP
- DELTA = Q - EP
- IF (DELTA .GT. EPS1) GO TO 220
- IF (DELTA .LT. (-EPS1)) GO TO 1000
- GO TO 300
- 220 F = BD(I) / Q
- QP = DELTA + F
- BD(I+1) = QP * EP
- 240 CONTINUE
- 260 W(K) = QP
- S = QP / P
- IF (TOT + S .GT. TOT) GO TO 180
- IERR = 5 * N + K
- S = 0.0
- DELTA = QP
- DO 280 J = K, N
- IF (W(J) .GT. DELTA) GO TO 280
- I = J
- DELTA = W(J)
- 280 CONTINUE
- 300 IF (I .LT. N) BD(I+1) = BD(I) * F / QP
- II = IND(I)
- IF (I .EQ. K) GO TO 340
- K1 = I - K
- DO 320 JJ = 1, K1
- J = I - JJ
- W(J+1) = W(J) - S
- BD(J+1) = BD(J)
- IND(J+1) = IND(J)
- 320 CONTINUE
- 340 W(K) = TOT
- ERR = ERR + ABS(DELTA)
- BD(K) = ERR
- IND(K) = II
- 360 CONTINUE
- IF (TYPE) GO TO 1001
- F = BD(1)
- E2(1) = 2.0
- BD(1) = F
- J = 2
- 400 DO 500 I = 1, N
- 500 W(I) = -W(I)
- JDEF = -JDEF
- GO TO (40,1001), J
- 1000 IERR = 6 * N + 1
- 1001 RETURN
- END
diff --git a/src/mathlib/gen/f/rlhoin.F b/src/mathlib/gen/f/rlhoin.F
deleted file mode 100644
index f9a8dcf..0000000
--- a/src/mathlib/gen/f/rlhoin.F
+++ /dev/null
@@ -1,195 +0,0 @@
-*
-* $Id: rlhoin.F,v 1.1.1.1 1996/04/01 15:02:41 mclareni Exp $
-*
-* $Log: rlhoin.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:41 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-C This corresponds to LIHOIN,IF=DOUBLE and LIHOIN64,IF=-DOUBLE.
- SUBROUTINE RLHOIN(A,MA,M,N,MAXV,V,NV,NVEC,EPS,IOUT,W,IW)
-
-C Solving Systems of Homogeneous Linear Inequalities.
-C Based on K.S. Koelbig and F. Schwarz, A Programm for Solving
-C Systems of Homogeneous Linear Inequalities,
-C Computer Phys. Comm. 17 (1979) 375-382
-
- CHARACTER TEXT*(*)
- CHARACTER NAME*(*)
- CHARACTER*80 ERRTXT
- PARAMETER (NAME = 'LIHOIN')
- PARAMETER (TEXT = '+++++ CERN F500 LIHOIN ... ')
-
- DIMENSION A(MA,*),V(NV,*),IW(MA,*),W(MAXV,*)
-
- ENTRY LIHOIN(A,MA,M,N,MAXV,V,NV,NVEC,EPS,IOUT,W,IW)
-
- IF(MAXV .LT. N) THEN
- CALL MTLPRT(NAME,'F500.1','MAXV TOO SMALL')
- RETURN
- END IF
-C
-C*****SETS INITIAL VALUES FOR BOOKKEEPING
-C
- DO 3 I = 1,M
- IW(I,1)=0
- 3 IW(I,2)=I
- DO 8 I = 1,N
- IW(I,2)=0
- 8 IW(I,5)=I
- NINC=N
- NVEC=N
-C
-C*****DETERMINES N BASIS VECTORS OF THE INITIAL POLYHEDRAL CONE
-C
- CALL RMCPY(N,N,A(1,1),A(1,2),A(2,1),V(1,1),V(1,2),V(2,1))
- CALL RINV(N,V,NV,W,IFAIL)
- IF(IFAIL .EQ. -1) THEN
- CALL MTLPRT(NAME,'F500.2','MATRIX A(N,N) SINGULAR')
- RETURN
- END IF
- DO 1 I = 1,NVEC
- S=RVMPY(N,V(1,I),V(2,I),V(1,I),V(2,I))
- 1 CALL RVSCL(N,1/SQRT(S),V(1,I),V(2,I),V(1,I),V(2,I))
-
- IF(IOUT .EQ. 1) THEN
- WRITE(6,111) TEXT
- DO 80 I = 1,NVEC,7
- DO 81 J = 1,N
- 81 WRITE(6,'(1X,I9,7E15.6)') J,(V(J,I1),I1=I,MIN(NVEC,I+6))
- 80 WRITE(6,'(1X)')
- END IF
-C
-C*****COMPUTES MATRIX OF SCALAR PRODUCTS
-C
- 17 DO 20 I = 1,NINC
- DO 20 K = 1,NVEC
- 20 W(K,I)=RVMPY(N,A(IW(I,5),1),A(IW(I,5),2),V(1,K),V(2,K))
-
- IF(IOUT .EQ. 1) THEN
- WRITE(6,112) TEXT
- DO 82 J = 1,NVEC,7
- DO 83 I = 1,NINC
- 83 WRITE(6,'(1X,I9,7E15.6)') I,(W(J2,I),J2=J,MIN(NVEC,J+6))
- 82 WRITE(6,'(1X)')
- END IF
-
-C*****DETERMINES REDUNDANT INEQUALITIES AND CHOOSES NEW ONE
-
- DO 40 K = 1,M
- IW(K,3)=0
- IF(IW(K,2) .EQ. 0) GO TO 40
- DO 45 I = 1,NVEC
- IF(RVMPY(N,A(K,1),A(K,2),V(1,I),V(2,I)) .GT. 0) IW(K,3)=IW(K,3)+1
- 45 CONTINUE
- 40 CONTINUE
- NNEG=NVEC
- DO 48 K = 1,M
- IF(IW(K,2) .EQ. 0) GO TO 48
- IF(IW(K,3) .EQ. 0) THEN
- WRITE(ERRTXT,103) K
- CALL MTLPRT(NAME,'F500.3',ERRTXT)
- RETURN
- END IF
- IF(IW(K,3) .EQ. NVEC) THEN
- IW(K,1)=K
- IW(K,2)=0
- END IF
- IF(IW(K,3) .LT. NNEG) THEN
- NNEG=IW(K,3)
- KNEW=K
- END IF
- 48 CONTINUE
- IF(NNEG .EQ. NVEC) THEN
- DO 74 I = 1,M
- IW(I,1)=I
- DO 75 J = 1,NVEC
- IF(RVMPY(N,A(I,1),A(I,2),V(1,J),V(2,J)) .GE. EPS) GO TO 75
- IW(I,1)=0
- GO TO 74
- 75 CONTINUE
- 74 CONTINUE
- RETURN
- END IF
-
- IF(IOUT .EQ. 1) WRITE(6,113) TEXT,KNEW
- IW(KNEW,2)=0
-C
-C*****COMPUTES VECTOR OF SCALAR PRODUCTS
-C
- DO 50 I = 1,NVEC
- 50 W(I,M+1)=RVMPY(N,A(KNEW,1),A(KNEW,2),V(1,I),V(2,I))
-
- IF(IOUT .EQ. 1) THEN
- WRITE(6,114) TEXT
- DO 84 J = 1,NVEC,7
- 84 WRITE(6,'(1X,I9,7E15.6)') J,(W(J2,M+1),J2=J,MIN(NVEC,J+6))
- WRITE(6,'(1X)')
- END IF
-C
-C*****DETERMINES BASIS VECTORS FOR NEW CONE
-C
- NTVE=NVEC
- DO 60 I = 1,NVEC-1
- DO 60 J = I+1,NVEC
- IF(W(I,M+1)*W(J,M+1) .GT. 0) GO TO 60
- NT=0
- DO 62 L = 1,NINC
- IW(L,4)=1
- IF(ABS(W(I,L)) .GT. EPS .OR. ABS(W(J,L)) .GT. EPS) GO TO 62
- NT=NT+1
- IW(L,4)=0
- 62 CONTINUE
- IF(NT .LT. N-2) GO TO 60
- DO 63 K = 1,NVEC
- IF(K .EQ. I .OR. K .EQ. J) GO TO 63
- MT=0
- DO 64 L = 1,NINC
- IF(IW(L,4) .EQ. 0 .AND. ABS(W(K,L)) .LT. EPS) MT=MT+1
- 64 CONTINUE
- IF(MT .EQ. N-2) GO TO 60
- 63 CONTINUE
- NTVE=NTVE+1
- IF(NTVE .GT. MAXV) THEN
- CALL MTLPRT(NAME,'F500.1','MAXV TOO SMALL')
- RETURN
- END IF
- DO 65 L = 1,N
- 65 V(L,NTVE)=ABS(W(J,M+1))*V(L,I)+ABS(W(I,M+1))*V(L,J)
- 60 CONTINUE
- DO 66 I = 1,NTVE
- S=RVMPY(N,V(1,I),V(2,I),V(1,I),V(2,I))
- 66 CALL RVSCL(N,1/SQRT(S),V(1,I),V(2,I),V(1,I),V(2,I))
-C
-C*****ELIMINATES VECTORS WITH NEGATIVE SCALAR PRODUCT
-C
- NNEW=0
- DO 70 I = 1,NVEC
- IF(W(I,M+1) .LT. 0) GO TO 70
- NNEW=NNEW+1
- CALL RVCPY(N,V(1,I),V(2,I),V(1,NNEW),V(2,NNEW))
- 70 CONTINUE
- DO 71 I = NVEC+1,NTVE
- NNEW=NNEW+1
- 71 CALL RVCPY(N,V(1,I),V(2,I),V(1,NNEW),V(2,NNEW))
- CALL RMSET(N,NTVE-NNEW,0D0,V(1,NNEW+1),V(1,NNEW+2),V(2,NNEW+1))
- NVEC=NNEW
- NINC=NINC+1
- IW(NINC,5)=KNEW
-
- IF(IOUT .EQ. 1) THEN
- WRITE(6,115) TEXT
- DO 86 I = 1,NVEC,7
- DO 87 J = 1,N
- 87 WRITE(6,'(1X,I9,7E15.6)') J,(V(J,I2),I2=I,MIN(NVEC,I+6))
- 86 WRITE(6,'(1X)')
- END IF
- GO TO 17
- 103 FORMAT('INEQUALITY ',I5,' IS INCONSISTENT')
- 111 FORMAT(7X,A27,'THE N BASIS VECTORS OF THE FIRST CONE'/)
- 112 FORMAT(7X,A27,'THE MATRIX OF SCALAR PRODUCTS'/)
- 113 FORMAT(7X,A27,'THE NEW INEQUALITY HAS INDEX',I5/)
- 114 FORMAT(7X,A27,'THE VECTOR OF SCALAR PRODUCTS'/)
- 115 FORMAT(7X,A27,'THE MATRIX OF BASIS VECTORS'/)
- END
diff --git a/src/mathlib/gen/f/scatter.F b/src/mathlib/gen/f/scatter.F
deleted file mode 100644
index 920df69..0000000
--- a/src/mathlib/gen/f/scatter.F
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: scatter.F,v 1.1.1.1 1996/04/01 15:02:30 mclareni Exp $
-*
-* $Log: scatter.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:30 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if (defined(CERNLIB_DOUBLE))&&(!defined(CERNLIB_QMIBMVF))
- SUBROUTINE SCATTER(NW,OUT,INDX,HIN)
-C
-C CERN PROGLIB# F122 SCATTER .VERSION GEN 2.30 890530
-C ORIG. 30/05/89 F. Antonelli IBM, FCA
-C
- DIMENSION OUT(*), INDX(*), HIN(*)
-C
- DO 10 J=1, NW
- OUT(INDX(J)) = HIN(J)
- 10 CONTINUE
-C
- END
-#endif
diff --git a/src/mathlib/gen/f/tinvit.F b/src/mathlib/gen/f/tinvit.F
deleted file mode 100644
index 79260cb..0000000
--- a/src/mathlib/gen/f/tinvit.F
+++ /dev/null
@@ -1,138 +0,0 @@
-*
-* $Id: tinvit.F,v 1.1.1.1 1996/04/01 15:02:37 mclareni Exp $
-*
-* $Log: tinvit.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:37 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE TINVIT(NM,N,D,E,E2,M,W,IND,Z,
- X IERR,RV1,RV2,RV3,RV4,RV6)
- INTEGER I,J,M,N,P,Q,R,S,II,IP,JJ,NM,ITS,TAG,IERR,GROUP
- REAL D(N),E(N),E2(N),W(M),Z(NM,M),
- X RV1(N),RV2(N),RV3(N),RV4(N),RV6(N)
- REAL U,V,UK,XU,X0,X1,EPS2,EPS3,EPS4,NORM,ORDER,MACHEP
- INTEGER IND(M)
-#if defined(CERNLIB_CDC)
- MACHEP=2.**(-47)
-#endif
-#if !defined(CERNLIB_CDC)
- MACHEP=2.**(-23)
-#endif
- IERR = 0
- TAG = 0
- ORDER = 1.0 - E2(1)
- Q = 0
- 100 P = Q + 1
- DO 120 Q = P, N
- IF (Q .EQ. N) GO TO 140
- IF (E2(Q+1) .EQ. 0.0) GO TO 140
- 120 CONTINUE
- 140 TAG = TAG + 1
- S = 0
- DO 920 R = 1, M
- IF (IND(R) .NE. TAG) GO TO 920
- ITS = 1
- X1 = W(R)
- IF (S .NE. 0) GO TO 510
- XU = 1.0
- IF (P .NE. Q) GO TO 490
- RV6(P) = 1.0
- GO TO 870
- 490 NORM = ABS(D(P))
- IP = P + 1
- DO 500 I = IP, Q
- 500 NORM = NORM + ABS(D(I)) + ABS(E(I))
- EPS2 = 1.0E-3 * NORM
- EPS3 = MACHEP * NORM
- UK = Q-P+1
- EPS4 = UK * EPS3
- UK = EPS4 / SQRT(UK)
- S = P
- 505 GROUP = 0
- GO TO 520
- 510 IF (ABS(X1-X0) .GE. EPS2) GO TO 505
- GROUP = GROUP + 1
- IF (ORDER * (X1 - X0) .LE. 0.0) X1 = X0 + ORDER * EPS3
- 520 V = 0.0
- DO 580 I = P, Q
- RV6(I) = UK
- IF (I .EQ. P) GO TO 560
- IF (ABS(E(I)) .LT. ABS(U)) GO TO 540
- XU = U / E(I)
- RV4(I) = XU
- RV1(I-1) = E(I)
- RV2(I-1) = D(I) - X1
- RV3(I-1) = 0.0
- IF (I .NE. Q) RV3(I-1) = E(I+1)
- U = V - XU * RV2(I-1)
- V = -XU * RV3(I-1)
- GO TO 580
- 540 XU = E(I) / U
- RV4(I) = XU
- RV1(I-1) = U
- RV2(I-1) = V
- RV3(I-1) = 0.0
- 560 U = D(I) - X1 - XU * V
- IF (I .NE. Q) V = E(I+1)
- 580 CONTINUE
- IF (U .EQ. 0.0) U = EPS3
- RV1(Q) = U
- RV2(Q) = 0.0
- RV3(Q) = 0.0
- 600 DO 620 II = P, Q
- I = P + Q - II
- RV6(I) = (RV6(I) - U * RV2(I) - V * RV3(I)) / RV1(I)
- V = U
- U = RV6(I)
- 620 CONTINUE
- IF (GROUP .EQ. 0) GO TO 700
- J = R
- DO 680 JJ = 1, GROUP
- 630 J = J - 1
- IF (IND(J) .NE. TAG) GO TO 630
- XU = 0.0
- DO 640 I = P, Q
- 640 XU = XU + RV6(I) * Z(I,J)
- DO 660 I = P, Q
- 660 RV6(I) = RV6(I) - XU * Z(I,J)
- 680 CONTINUE
- 700 NORM = 0.0
- DO 720 I = P, Q
- 720 NORM = NORM + ABS(RV6(I))
- IF (NORM .GE. 1.0) GO TO 840
- IF (ITS .EQ. 5) GO TO 830
- IF (NORM .NE. 0.0) GO TO 740
- RV6(S) = EPS4
- S = S + 1
- IF (S .GT. Q) S = P
- GO TO 780
- 740 XU = EPS4 / NORM
- DO 760 I = P, Q
- 760 RV6(I) = RV6(I) * XU
- 780 DO 820 I = IP, Q
- U = RV6(I)
- IF (RV1(I-1) .NE. E(I)) GO TO 800
- U = RV6(I-1)
- RV6(I-1) = RV6(I)
- 800 RV6(I) = U - RV4(I) * RV6(I-1)
- 820 CONTINUE
- ITS = ITS + 1
- GO TO 600
- 830 IERR = -R
- XU = 0.0
- GO TO 870
- 840 U = 0.0
- DO 860 I = P, Q
- 860 U = U + RV6(I)**2
- XU = 1.0 / SQRT(U)
- 870 DO 880 I = 1, N
- 880 Z(I,R) = 0.0
- DO 900 I = P, Q
- 900 Z(I,R) = RV6(I) * XU
- X0 = X1
- 920 CONTINUE
- IF (Q .LT. N) GO TO 100
- RETURN
- END
diff --git a/src/mathlib/gen/f/tql1.F b/src/mathlib/gen/f/tql1.F
deleted file mode 100644
index 3c9fc21..0000000
--- a/src/mathlib/gen/f/tql1.F
+++ /dev/null
@@ -1,82 +0,0 @@
-*
-* $Id: tql1.F,v 1.1.1.1 1996/04/01 15:02:37 mclareni Exp $
-*
-* $Log: tql1.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:37 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE TQL1(N,D,E,IERR)
- INTEGER I,J,L,M,N,II,MML,IERR
- REAL D(N),E(N)
- REAL B,C,F,G,H,P,R,S,MACHEP
-#if defined(CERNLIB_CDC)
- MACHEP=2.**(-47)
-#endif
-#if !defined(CERNLIB_CDC)
- MACHEP=2.**(-23)
-#endif
- IERR = 0
- IF (N .EQ. 1) GO TO 1001
- DO 100 I = 2, N
- 100 E(I-1) = E(I)
- F = 0.0
- B = 0.0
- E(N) = 0.0
- DO 290 L = 1, N
- J = 0
- H = MACHEP * (ABS(D(L)) + ABS(E(L)))
- IF (B .LT. H) B = H
- DO 110 M = L, N
- IF (ABS(E(M)) .LE. B) GO TO 120
- 110 CONTINUE
- 120 IF (M .EQ. L) GO TO 210
- 130 IF (J .EQ. 30) GO TO 1000
- J = J + 1
- P = (D(L+1) - D(L)) / (2.0 * E(L))
- R = SQRT(P*P+1.0)
- H = D(L) - E(L) / (P + SIGN(R,P))
- DO 140 I = L, N
- 140 D(I) = D(I) - H
- F = F + H
- P = D(M)
- C = 1.0
- S = 0.0
- MML = M - L
- DO 200 II = 1, MML
- I = M - II
- G = C * E(I)
- H = C * P
- IF (ABS(P) .LT. ABS(E(I))) GO TO 150
- C = E(I) / P
- R = SQRT(C*C+1.0)
- E(I+1) = S * P * R
- S = C / R
- C = 1.0 / R
- GO TO 160
- 150 C = P / E(I)
- R = SQRT(C*C+1.0)
- E(I+1) = S * E(I) * R
- S = 1.0 / R
- C = C * S
- 160 P = C * D(I) - S * G
- D(I+1) = H + S * (C * G + S * D(I))
- 200 CONTINUE
- E(L) = S * P
- D(L) = C * P
- IF (ABS(E(L)) .GT. B) GO TO 130
- 210 P = D(L) + F
- IF (L .EQ. 1) GO TO 250
- DO 230 II = 2, L
- I = L + 2 - II
- IF (P .GE. D(I-1)) GO TO 270
- D(I) = D(I-1)
- 230 CONTINUE
- 250 I = 1
- 270 D(I) = P
- 290 CONTINUE
- GO TO 1001
- 1000 IERR = L
- 1001 RETURN
- END
diff --git a/src/mathlib/gen/f/tql2.F b/src/mathlib/gen/f/tql2.F
deleted file mode 100644
index 130ed30..0000000
--- a/src/mathlib/gen/f/tql2.F
+++ /dev/null
@@ -1,97 +0,0 @@
-*
-* $Id: tql2.F,v 1.1.1.1 1996/04/01 15:02:37 mclareni Exp $
-*
-* $Log: tql2.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:37 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE TQL2(NM,N,D,E,Z,IERR)
- INTEGER I,J,K,L,M,N,II,NM,MML,IERR
- REAL D(N),E(N),Z(NM,N)
- REAL B,C,F,G,H,P,R,S,MACHEP
-#if defined(CERNLIB_CDC)
- MACHEP=2.**(-47)
-#endif
-#if !defined(CERNLIB_CDC)
- MACHEP=2.**(-23)
-#endif
- IERR = 0
- IF (N .EQ. 1) GO TO 1001
- DO 100 I = 2, N
- 100 E(I-1) = E(I)
- F = 0.0
- B = 0.0
- E(N) = 0.0
- DO 240 L = 1, N
- J = 0
- H = MACHEP * (ABS(D(L)) + ABS(E(L)))
- IF (B .LT. H) B = H
- DO 110 M = L, N
- IF (ABS(E(M)) .LE. B) GO TO 120
- 110 CONTINUE
- 120 IF (M .EQ. L) GO TO 220
- 130 IF (J .EQ. 30) GO TO 1000
- J = J + 1
- P = (D(L+1) - D(L)) / (2.0 * E(L))
- R = SQRT(P*P+1.0)
- H = D(L) - E(L) / (P + SIGN(R,P))
- DO 140 I = L, N
- 140 D(I) = D(I) - H
- F = F + H
- P = D(M)
- C = 1.0
- S = 0.0
- MML = M - L
- DO 200 II = 1, MML
- I = M - II
- G = C * E(I)
- H = C * P
- IF (ABS(P) .LT. ABS(E(I))) GO TO 150
- C = E(I) / P
- R = SQRT(C*C+1.0)
- E(I+1) = S * P * R
- S = C / R
- C = 1.0 / R
- GO TO 160
- 150 C = P / E(I)
- R = SQRT(C*C+1.0)
- E(I+1) = S * E(I) * R
- S = 1.0 / R
- C = C * S
- 160 P = C * D(I) - S * G
- D(I+1) = H + S * (C * G + S * D(I))
- DO 180 K = 1, N
- H = Z(K,I+1)
- Z(K,I+1) = S * Z(K,I) + C * H
- Z(K,I) = C * Z(K,I) - S * H
- 180 CONTINUE
- 200 CONTINUE
- E(L) = S * P
- D(L) = C * P
- IF (ABS(E(L)) .GT. B) GO TO 130
- 220 D(L) = D(L) + F
- 240 CONTINUE
- DO 300 II = 2, N
- I = II - 1
- K = I
- P = D(I)
- DO 260 J = II, N
- IF (D(J) .GE. P) GO TO 260
- K = J
- P = D(J)
- 260 CONTINUE
- IF (K .EQ. I) GO TO 300
- D(K) = D(I)
- D(I) = P
- DO 280 J = 1, N
- P = Z(J,I)
- Z(J,I) = Z(J,K)
- Z(J,K) = P
- 280 CONTINUE
- 300 CONTINUE
- GO TO 1001
- 1000 IERR = L
- 1001 RETURN
- END
diff --git a/src/mathlib/gen/f/trbak1.F b/src/mathlib/gen/f/trbak1.F
deleted file mode 100644
index ec50df8..0000000
--- a/src/mathlib/gen/f/trbak1.F
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: trbak1.F,v 1.1.1.1 1996/04/01 15:02:38 mclareni Exp $
-*
-* $Log: trbak1.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:38 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE TRBAK1(NM,N,A,E,M,Z)
- INTEGER I,J,K,L,M,N,NM
- REAL A(NM,N),E(N),Z(NM,M)
- REAL H,S
- IF (N .EQ. 1) GO TO 200
- DO 140 I = 2, N
- L = I - 1
- H = E(I) * A(I,L)
- IF (H .EQ. 0.0) GO TO 140
- DO 130 J = 1, M
- S = 0.0
- DO 110 K = 1, L
- 110 S = S + A(I,K) * Z(K,J)
- S = S / H
- DO 120 K = 1, L
- 120 Z(K,J) = Z(K,J) + S * A(I,K)
- 130 CONTINUE
- 140 CONTINUE
- 200 RETURN
- END
diff --git a/src/mathlib/gen/f/tred1.F b/src/mathlib/gen/f/tred1.F
deleted file mode 100644
index 0d39ffc..0000000
--- a/src/mathlib/gen/f/tred1.F
+++ /dev/null
@@ -1,66 +0,0 @@
-*
-* $Id: tred1.F,v 1.1.1.1 1996/04/01 15:02:38 mclareni Exp $
-*
-* $Log: tred1.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:38 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE TRED1(NM,N,A,D,E,E2)
- INTEGER I,J,K,L,N,II,NM,JP1
- REAL A(NM,N),D(N),E(N),E2(N)
- REAL F,G,H,SCALE
- DO 100 I = 1, N
- 100 D(I) = A(I,I)
- DO 300 II = 1, N
- I = N + 1 - II
- L = I - 1
- H = 0.0
- SCALE = 0.0
- IF (L .LT. 1) GO TO 130
- DO 120 K = 1, L
- 120 SCALE = SCALE + ABS(A(I,K))
- IF (SCALE .NE. 0.0) GO TO 140
- 130 E(I) = 0.0
- E2(I) = 0.0
- GO TO 290
- 140 DO 150 K = 1, L
- A(I,K) = A(I,K) / SCALE
- H = H + A(I,K) * A(I,K)
- 150 CONTINUE
- E2(I) = SCALE * SCALE * H
- F = A(I,L)
- G = -SIGN(SQRT(H),F)
- E(I) = SCALE * G
- H = H - F * G
- A(I,L) = F - G
- IF (L .EQ. 1) GO TO 270
- F = 0.0
- DO 240 J = 1, L
- G = 0.0
- DO 180 K = 1, J
- 180 G = G + A(J,K) * A(I,K)
- JP1 = J + 1
- IF (L .LT. JP1) GO TO 220
- DO 200 K = JP1, L
- 200 G = G + A(K,J) * A(I,K)
- 220 E(J) = G / H
- F = F + E(J) * A(I,J)
- 240 CONTINUE
- H = F / (H + H)
- DO 260 J = 1, L
- F = A(I,J)
- G = E(J) - H * F
- E(J) = G
- DO 260 K = 1, J
- A(J,K) = A(J,K) - F * E(K) - G * A(I,K)
- 260 CONTINUE
- 270 DO 280 K = 1, L
- 280 A(I,K) = SCALE * A(I,K)
- 290 H = D(I)
- D(I) = A(I,I)
- A(I,I) = H
- 300 CONTINUE
- RETURN
- END
diff --git a/src/mathlib/gen/f/tred2.F b/src/mathlib/gen/f/tred2.F
deleted file mode 100644
index 6f84cea..0000000
--- a/src/mathlib/gen/f/tred2.F
+++ /dev/null
@@ -1,85 +0,0 @@
-*
-* $Id: tred2.F,v 1.1.1.1 1996/04/01 15:02:38 mclareni Exp $
-*
-* $Log: tred2.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:38 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE TRED2(NM,N,A,D,E,Z)
- INTEGER I,J,K,L,N,II,NM,JP1
- REAL A(NM,N),D(N),E(N),Z(NM,N)
- REAL F,G,H,HH,SCALE
- DO 100 I = 1, N
- DO 100 J = 1, I
- Z(I,J) = A(I,J)
- 100 CONTINUE
- IF (N .EQ. 1) GO TO 320
- DO 300 II = 2, N
- I = N + 2 - II
- L = I - 1
- H = 0.0
- SCALE = 0.0
- IF (L .LT. 2) GO TO 130
- DO 120 K = 1, L
- 120 SCALE = SCALE + ABS(Z(I,K))
- IF (SCALE .NE. 0.0) GO TO 140
- 130 E(I) = Z(I,L)
- GO TO 290
- 140 DO 150 K = 1, L
- Z(I,K) = Z(I,K) / SCALE
- H = H + Z(I,K) * Z(I,K)
- 150 CONTINUE
- F = Z(I,L)
- G = -SIGN(SQRT(H),F)
- E(I) = SCALE * G
- H = H - F * G
- Z(I,L) = F - G
- F = 0.0
- DO 240 J = 1, L
- Z(J,I) = Z(I,J) / (SCALE * H)
- G = 0.0
- DO 180 K = 1, J
- 180 G = G + Z(J,K) * Z(I,K)
- JP1 = J + 1
- IF (L .LT. JP1) GO TO 220
- DO 200 K = JP1, L
- 200 G = G + Z(K,J) * Z(I,K)
- 220 E(J) = G / H
- F = F + E(J) * Z(I,J)
- 240 CONTINUE
- HH = F / (H + H)
- DO 260 J = 1, L
- F = Z(I,J)
- G = E(J) - HH * F
- E(J) = G
- DO 260 K = 1, J
- Z(J,K) = Z(J,K) - F * E(K) - G * Z(I,K)
- 260 CONTINUE
- DO 280 K = 1, L
- 280 Z(I,K) = SCALE * Z(I,K)
- 290 D(I) = H
- 300 CONTINUE
- 320 D(1) = 0.0
- E(1) = 0.0
- DO 500 I = 1, N
- L = I - 1
- IF (D(I) .EQ. 0.0) GO TO 380
- DO 360 J = 1, L
- G = 0.0
- DO 340 K = 1, L
- 340 G = G + Z(I,K) * Z(K,J)
- DO 360 K = 1, L
- Z(K,J) = Z(K,J) - G * Z(K,I)
- 360 CONTINUE
- 380 D(I) = Z(I,I)
- Z(I,I) = 1.0
- IF (L .LT. 1) GO TO 500
- DO 400 J = 1, L
- Z(I,J) = 0.0
- Z(J,I) = 0.0
- 400 CONTINUE
- 500 CONTINUE
- RETURN
- END
diff --git a/src/mathlib/gen/f/tsturm.F b/src/mathlib/gen/f/tsturm.F
deleted file mode 100644
index 5b1ccc9..0000000
--- a/src/mathlib/gen/f/tsturm.F
+++ /dev/null
@@ -1,227 +0,0 @@
-*
-* $Id: tsturm.F,v 1.1.1.1 1996/04/01 15:02:38 mclareni Exp $
-*
-* $Log: tsturm.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:38 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE TSTURM(NM,N,EPS1,D,E,E2,LB,UB,MM,M,W,Z,
- X IERR,RV1,RV2,RV3,RV4,RV5,RV6)
- INTEGER I,J,K,M,N,P,Q,R,S,II,IP,JJ,MM,M1,M2,NM,ITS,
- X IERR,GROUP,ISTURM
- REAL D(N),E(N),E2(N),W(MM),Z(NM,MM),
- X RV1(N),RV2(N),RV3(N),RV4(N),RV5(N),RV6(N)
- REAL U,V,LB,T1,T2,UB,UK,XU,X0,X1,EPS1,EPS2,EPS3,EPS4,
- X NORM,MACHEP
-#if defined(CERNLIB_CDC)
- MACHEP=2.**(-47)
-#endif
-#if !defined(CERNLIB_CDC)
- MACHEP=2.**(-23)
-#endif
- IERR = 0
- T1 = LB
- T2 = UB
- DO 40 I = 1, N
- IF (I .EQ. 1) GO TO 20
- IF (ABS(E(I)) .GT. MACHEP * (ABS(D(I)) + ABS(D(I-1))))
- X GO TO 40
- 20 E2(I) = 0.0
- 40 CONTINUE
- P = 1
- Q = N
- X1 = UB
- ISTURM = 1
- GO TO 320
- 60 M = S
- X1 = LB
- ISTURM = 2
- GO TO 320
- 80 M = M - S
- IF (M .GT. MM) GO TO 980
- Q = 0
- R = 0
- 100 IF (R .EQ. M) GO TO 1001
- P = Q + 1
- XU = D(P)
- X0 = D(P)
- U = 0.0
- DO 120 Q = P, N
- X1 = U
- U = 0.0
- V = 0.0
- IF (Q .EQ. N) GO TO 110
- U = ABS(E(Q+1))
- V = E2(Q+1)
- 110 XU = MIN(D(Q)-(X1+U),XU)
- X0 = MAX(D(Q)+(X1+U),X0)
- IF (V .EQ. 0.0) GO TO 140
- 120 CONTINUE
- 140 X1 = MAX(ABS(XU),ABS(X0)) * MACHEP
- IF (EPS1 .LE. 0.0) EPS1 = -X1
- IF (P .NE. Q) GO TO 180
- IF (T1 .GT. D(P) .OR. D(P) .GE. T2) GO TO 940
- R = R + 1
- DO 160 I = 1, N
- 160 Z(I,R) = 0.0
- W(R) = D(P)
- Z(P,R) = 1.0
- GO TO 940
- 180 X1 = X1 * (Q-P+1)
- LB = MAX(T1,XU-X1)
- UB = MIN(T2,X0+X1)
- X1 = LB
- ISTURM = 3
- GO TO 320
- 200 M1 = S + 1
- X1 = UB
- ISTURM = 4
- GO TO 320
- 220 M2 = S
- IF (M1 .GT. M2) GO TO 940
- X0 = UB
- ISTURM = 5
- DO 240 I = M1, M2
- RV5(I) = UB
- RV4(I) = LB
- 240 CONTINUE
- K = M2
- 250 XU = LB
- DO 260 II = M1, K
- I = M1 + K - II
- IF (XU .GE. RV4(I)) GO TO 260
- XU = RV4(I)
- GO TO 280
- 260 CONTINUE
- 280 IF (X0 .GT. RV5(K)) X0 = RV5(K)
- 300 X1 = (XU + X0) * 0.5
- IF ((X0 - XU) .LE. (2.0 * MACHEP *
- X (ABS(XU) + ABS(X0)) + ABS(EPS1))) GO TO 420
- 320 S = P - 1
- U = 1.0
- DO 340 I = P, Q
- IF (U .NE. 0.0) GO TO 325
- V = ABS(E(I)) / MACHEP
- GO TO 330
- 325 V = E2(I) / U
- 330 U = D(I) - X1 - V
- IF (U .LT. 0.0) S = S + 1
- 340 CONTINUE
- GO TO (60,80,200,220,360), ISTURM
- 360 IF (S .GE. K) GO TO 400
- XU = X1
- IF (S .GE. M1) GO TO 380
- RV4(M1) = X1
- GO TO 300
- 380 RV4(S+1) = X1
- IF (RV5(S) .GT. X1) RV5(S) = X1
- GO TO 300
- 400 X0 = X1
- GO TO 300
- 420 RV5(K) = X1
- K = K - 1
- IF (K .GE. M1) GO TO 250
- NORM = ABS(D(P))
- IP = P + 1
- DO 500 I = IP, Q
- 500 NORM = NORM + ABS(D(I)) + ABS(E(I))
- EPS2 = 1.0E-3 * NORM
- EPS3 = MACHEP * NORM
- UK = Q-P+1
- EPS4 = UK * EPS3
- UK = EPS4 / SQRT(UK)
- GROUP = 0
- S = P
- DO 920 K = M1, M2
- R = R + 1
- ITS = 1
- W(R) = RV5(K)
- X1 = RV5(K)
- IF (K .EQ. M1) GO TO 520
- IF (X1 - X0 .GE. EPS2) GROUP = -1
- GROUP = GROUP + 1
- IF (X1 .LE. X0) X1 = X0 + EPS3
- 520 V = 0.0
- DO 580 I = P, Q
- RV6(I) = UK
- IF (I .EQ. P) GO TO 560
- IF (ABS(E(I)) .LT. ABS(U)) GO TO 540
- XU = U / E(I)
- RV4(I) = XU
- RV1(I-1) = E(I)
- RV2(I-1) = D(I) - X1
- RV3(I-1) = 0.0
- IF (I .NE. Q) RV3(I-1) = E(I+1)
- U = V - XU * RV2(I-1)
- V = -XU * RV3(I-1)
- GO TO 580
- 540 XU = E(I) / U
- RV4(I) = XU
- RV1(I-1) = U
- RV2(I-1) = V
- RV3(I-1) = 0.0
- 560 U = D(I) - X1 - XU * V
- IF (I .NE. Q) V = E(I+1)
- 580 CONTINUE
- IF (U .EQ. 0.0) U = EPS3
- RV1(Q) = U
- RV2(Q) = 0.0
- RV3(Q) = 0.0
- 600 DO 620 II = P, Q
- I = P + Q - II
- RV6(I) = (RV6(I) - U * RV2(I) - V * RV3(I)) / RV1(I)
- V = U
- U = RV6(I)
- 620 CONTINUE
- IF (GROUP .EQ. 0) GO TO 700
- DO 680 JJ = 1, GROUP
- J = R - GROUP - 1 + JJ
- XU = 0.0
- DO 640 I = P, Q
- 640 XU = XU + RV6(I) * Z(I,J)
- DO 660 I = P, Q
- 660 RV6(I) = RV6(I) - XU * Z(I,J)
- 680 CONTINUE
- 700 NORM = 0.0
- DO 720 I = P, Q
- 720 NORM = NORM + ABS(RV6(I))
- IF (NORM .GE. 1.0) GO TO 840
- IF (ITS .EQ. 5) GO TO 960
- IF (NORM .NE. 0.0) GO TO 740
- RV6(S) = EPS4
- S = S + 1
- IF (S .GT. Q) S = P
- GO TO 780
- 740 XU = EPS4 / NORM
- DO 760 I = P, Q
- 760 RV6(I) = RV6(I) * XU
- 780 DO 820 I = IP, Q
- U = RV6(I)
- IF (RV1(I-1) .NE. E(I)) GO TO 800
- U = RV6(I-1)
- RV6(I-1) = RV6(I)
- 800 RV6(I) = U - RV4(I) * RV6(I-1)
- 820 CONTINUE
- ITS = ITS + 1
- GO TO 600
- 840 U = 0.0
- DO 860 I = P, Q
- 860 U = U + RV6(I)**2
- XU = 1.0 / SQRT(U)
- DO 880 I = 1, N
- 880 Z(I,R) = 0.0
- DO 900 I = P, Q
- 900 Z(I,R) = RV6(I) * XU
- X0 = X1
- 920 CONTINUE
- 940 IF (Q .LT. N) GO TO 100
- GO TO 1001
- 960 IERR = 4 * N + R
- GO TO 1001
- 980 IERR = 3 * N + 1
- 1001 LB = T1
- UB = T2
- RETURN
- END
diff --git a/src/mathlib/gen/f/wheneq.F b/src/mathlib/gen/f/wheneq.F
deleted file mode 100644
index 90cb037..0000000
--- a/src/mathlib/gen/f/wheneq.F
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: wheneq.F,v 1.1.1.1 1996/04/01 15:02:30 mclareni Exp $
-*
-* $Log: wheneq.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:30 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if (defined(CERNLIB_DOUBLE))&&(!defined(CERNLIB_QMIBMVF))
- SUBROUTINE WHENEQ(NW,IN,INC,ITARGT,INDX,NFOUND)
-C
-C CERN PROGLIB# F122 WHENEQ .VERSION GEN 2.30 890530
-C ORIG. 30/05/89 F. Antonelli IBM, FCA
-C
- DIMENSION IN(*), INDX(*)
-C
- NFOUND = 0
- IF(INC.GT.0) THEN
- IBEG = 1
- IEND = (NW-1)*INC+1
- ELSE
- IBEG = (1-NW)*INC+1
- IEND = 1
- END IF
- DO 10 J=IBEG, IEND, INC
- IF(IN(J).EQ.ITARGT) THEN
- NFOUND = NFOUND+1
- INDX(NFOUND) = J
- END IF
- 10 CONTINUE
-C
- END
-#endif
diff --git a/src/mathlib/gen/f/whenfge.F b/src/mathlib/gen/f/whenfge.F
deleted file mode 100644
index 934103e..0000000
--- a/src/mathlib/gen/f/whenfge.F
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: whenfge.F,v 1.1.1.1 1996/04/01 15:02:30 mclareni Exp $
-*
-* $Log: whenfge.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:30 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if (defined(CERNLIB_DOUBLE))&&(!defined(CERNLIB_QMIBMVF))
- SUBROUTINE WHENFGE(NW,HIN,INC,TARGET,INDX,NFOUND)
-C
-C CERN PROGLIB# F122 WHENFGE .VERSION GEN 2.30 890530
-C ORIG. 30/05/89 F. Antonelli IBM, FCA
-C
- DIMENSION HIN(*), INDX(*)
-C
- NFOUND = 0
- IF(INC.GT.0) THEN
- IBEG = 1
- IEND = (NW-1)*INC+1
- ELSE
- IBEG = (1-NW)*INC+1
- IEND = 1
- END IF
- DO 10 J=IBEG, IEND, INC
- IF(HIN(J).GE.TARGET) THEN
- NFOUND = NFOUND+1
- INDX(NFOUND) = J
- END IF
- 10 CONTINUE
-C
- END
-#endif
diff --git a/src/mathlib/gen/f/whenfgt.F b/src/mathlib/gen/f/whenfgt.F
deleted file mode 100644
index 59ce13f..0000000
--- a/src/mathlib/gen/f/whenfgt.F
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: whenfgt.F,v 1.1.1.1 1996/04/01 15:02:30 mclareni Exp $
-*
-* $Log: whenfgt.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:30 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if (defined(CERNLIB_DOUBLE))&&(!defined(CERNLIB_QMIBMVF))
- SUBROUTINE WHENFGT(NW,HIN,INC,TARGET,INDX,NFOUND)
-C
-C CERN PROGLIB# F122 WHENFGT .VERSION GEN 2.30 890530
-C ORIG. 30/05/89 F. Antonelli IBM, FCA
-C
- DIMENSION HIN(*), INDX(*)
-C
- NFOUND = 0
- IF(INC.GT.0) THEN
- IBEG = 1
- IEND = (NW-1)*INC+1
- ELSE
- IBEG = (1-NW)*INC+1
- IEND = 1
- END IF
- DO 10 J=IBEG, IEND, INC
- IF(HIN(J).GT.TARGET) THEN
- NFOUND = NFOUND+1
- INDX(NFOUND) = J
- END IF
- 10 CONTINUE
-C
- END
-#endif
diff --git a/src/mathlib/gen/f/whenfle.F b/src/mathlib/gen/f/whenfle.F
deleted file mode 100644
index 117495a..0000000
--- a/src/mathlib/gen/f/whenfle.F
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: whenfle.F,v 1.1.1.1 1996/04/01 15:02:31 mclareni Exp $
-*
-* $Log: whenfle.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:31 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if (defined(CERNLIB_DOUBLE))&&(!defined(CERNLIB_QMIBMVF))
- SUBROUTINE WHENFLE(NW,HIN,INC,TARGET,INDX,NFOUND)
-C
-C CERN PROGLIB# F122 WHENFLE .VERSION GEN 2.30 890530
-C ORIG. 30/05/89 F. Antonelli IBM, FCA
-C
- DIMENSION HIN(*), INDX(*)
-C
- NFOUND = 0
- IF(INC.GT.0) THEN
- IBEG = 1
- IEND = (NW-1)*INC+1
- ELSE
- IBEG = (1-NW)*INC+1
- IEND = 1
- END IF
- DO 10 J=IBEG, IEND, INC
- IF(HIN(J).LE.TARGET) THEN
- NFOUND = NFOUND+1
- INDX(NFOUND) = J
- END IF
- 10 CONTINUE
-C
- END
-#endif
diff --git a/src/mathlib/gen/f/whenflt.F b/src/mathlib/gen/f/whenflt.F
deleted file mode 100644
index 1469617..0000000
--- a/src/mathlib/gen/f/whenflt.F
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: whenflt.F,v 1.1.1.1 1996/04/01 15:02:31 mclareni Exp $
-*
-* $Log: whenflt.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:31 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if (defined(CERNLIB_DOUBLE))&&(!defined(CERNLIB_QMIBMVF))
- SUBROUTINE WHENFLT(NW,HIN,INC,TARGET,INDX,NFOUND)
-C
-C CERN PROGLIB# F122 WHENFLT .VERSION GEN 2.30 890530
-C ORIG. 30/05/89 F. Antonelli IBM, FCA
-C
- DIMENSION HIN(*), INDX(*)
-C
- NFOUND = 0
- IF(INC.GT.0) THEN
- IBEG = 1
- IEND = (NW-1)*INC+1
- ELSE
- IBEG = (1-NW)*INC+1
- IEND = 1
- END IF
- DO 10 J=IBEG, IEND, INC
- IF(HIN(J).LT.TARGET) THEN
- NFOUND = NFOUND+1
- INDX(NFOUND) = J
- END IF
- 10 CONTINUE
-C
- END
-#endif
diff --git a/src/mathlib/gen/f/whenige.F b/src/mathlib/gen/f/whenige.F
deleted file mode 100644
index 4bb9f4b..0000000
--- a/src/mathlib/gen/f/whenige.F
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: whenige.F,v 1.1.1.1 1996/04/01 15:02:31 mclareni Exp $
-*
-* $Log: whenige.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:31 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if (defined(CERNLIB_DOUBLE))&&(!defined(CERNLIB_QMIBMVF))
- SUBROUTINE WHENIGE(NW,IN,INC,ITARGT,INDX,NFOUND)
-C
-C CERN PROGLIB# F122 WHENIGE .VERSION GEN 2.30 890530
-C ORIG. 30/05/89 F. Antonelli IBM, FCA
-C
- DIMENSION IN(*), INDX(*)
-C
- NFOUND = 0
- IF(INC.GT.0) THEN
- IBEG = 1
- IEND = (NW-1)*INC+1
- ELSE
- IBEG = (1-NW)*INC+1
- IEND = 1
- END IF
- DO 10 J=IBEG, IEND, INC
- IF(IN(J).GE.ITARGT) THEN
- NFOUND = NFOUND+1
- INDX(NFOUND) = J
- END IF
- 10 CONTINUE
-C
- END
-#endif
diff --git a/src/mathlib/gen/f/whenigt.F b/src/mathlib/gen/f/whenigt.F
deleted file mode 100644
index 56afdd1..0000000
--- a/src/mathlib/gen/f/whenigt.F
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: whenigt.F,v 1.1.1.1 1996/04/01 15:02:31 mclareni Exp $
-*
-* $Log: whenigt.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:31 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if (defined(CERNLIB_DOUBLE))&&(!defined(CERNLIB_QMIBMVF))
- SUBROUTINE WHENIGT(NW,IN,INC,ITARGT,INDX,NFOUND)
-C
-C CERN PROGLIB# F122 WHENIGT .VERSION GEN 2.30 890530
-C ORIG. 30/05/89 F. Antonelli IBM, FCA
-C
- DIMENSION IN(*), INDX(*)
-C
- NFOUND = 0
- IF(INC.GT.0) THEN
- IBEG = 1
- IEND = (NW-1)*INC+1
- ELSE
- IBEG = (1-NW)*INC+1
- IEND = 1
- END IF
- DO 10 J=IBEG, IEND, INC
- IF(IN(J).GT.ITARGT) THEN
- NFOUND = NFOUND+1
- INDX(NFOUND) = J
- END IF
- 10 CONTINUE
-C
- END
-#endif
diff --git a/src/mathlib/gen/f/whenile.F b/src/mathlib/gen/f/whenile.F
deleted file mode 100644
index ef679ac..0000000
--- a/src/mathlib/gen/f/whenile.F
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: whenile.F,v 1.1.1.1 1996/04/01 15:02:31 mclareni Exp $
-*
-* $Log: whenile.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:31 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if (defined(CERNLIB_DOUBLE))&&(!defined(CERNLIB_QMIBMVF))
- SUBROUTINE WHENILE(NW,IN,INC,ITARGT,INDX,NFOUND)
-C
-C CERN PROGLIB# F122 WHENILE .VERSION GEN 2.30 890530
-C ORIG. 30/05/89 F. Antonelli IBM, FCA
-C
- DIMENSION IN(*), INDX(*)
-C
- NFOUND = 0
- IF(INC.GT.0) THEN
- IBEG = 1
- IEND = (NW-1)*INC+1
- ELSE
- IBEG = (1-NW)*INC+1
- IEND = 1
- END IF
- DO 10 J=IBEG, IEND, INC
- IF(IN(J).LE.ITARGT) THEN
- NFOUND = NFOUND+1
- INDX(NFOUND) = J
- END IF
- 10 CONTINUE
-C
- END
-#endif
diff --git a/src/mathlib/gen/f/whenilt.F b/src/mathlib/gen/f/whenilt.F
deleted file mode 100644
index d51925c..0000000
--- a/src/mathlib/gen/f/whenilt.F
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: whenilt.F,v 1.1.1.1 1996/04/01 15:02:31 mclareni Exp $
-*
-* $Log: whenilt.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:31 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if (defined(CERNLIB_DOUBLE))&&(!defined(CERNLIB_QMIBMVF))
- SUBROUTINE WHENILT(NW,IN,INC,ITARGT,INDX,NFOUND)
-C
-C CERN PROGLIB# F122 WHENILT .VERSION GEN 2.30 890530
-C ORIG. 30/05/89 F. Antonelli IBM, FCA
-C
- DIMENSION IN(*), INDX(*)
-C
- NFOUND = 0
- IF(INC.GT.0) THEN
- IBEG = 1
- IEND = (NW-1)*INC+1
- ELSE
- IBEG = (1-NW)*INC+1
- IEND = 1
- END IF
- DO 10 J=IBEG, IEND, INC
- IF(IN(J).LT.ITARGT) THEN
- NFOUND = NFOUND+1
- INDX(NFOUND) = J
- END IF
- 10 CONTINUE
-C
- END
-#endif
diff --git a/src/mathlib/gen/f/whenne.F b/src/mathlib/gen/f/whenne.F
deleted file mode 100644
index 13b77d8..0000000
--- a/src/mathlib/gen/f/whenne.F
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: whenne.F,v 1.1.1.1 1996/04/01 15:02:32 mclareni Exp $
-*
-* $Log: whenne.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:32 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if (defined(CERNLIB_DOUBLE))&&(!defined(CERNLIB_QMIBMVF))
- SUBROUTINE WHENNE(NW,IN,INC,ITARGT,INDX,NFOUND)
-C
-C CERN PROGLIB# F122 WHENNE .VERSION GEN 2.30 890530
-C ORIG. 30/05/89 F. Antonelli IBM, FCA
-C
- DIMENSION IN(*), INDX(*)
-C
- NFOUND = 0
- IF(INC.GT.0) THEN
- IBEG = 1
- IEND = (NW-1)*INC+1
- ELSE
- IBEG = (1-NW)*INC+1
- IEND = 1
- END IF
- DO 10 J=IBEG, IEND, INC
- IF(IN(J).NE.ITARGT) THEN
- NFOUND = NFOUND+1
- INDX(NFOUND) = J
- END IF
- 10 CONTINUE
-C
- END
-#endif
diff --git a/src/mathlib/gen/g/Imakefile b/src/mathlib/gen/g/Imakefile
deleted file mode 100644
index 576065a..0000000
--- a/src/mathlib/gen/g/Imakefile
+++ /dev/null
@@ -1,22 +0,0 @@
-DoIncludePackage(gen)
-#include "pilot.h"
-
-SRCS_F= chisin.F coedin.F coedis.F denlan.F diflan.F dinvav.F \ @@\
- dislan.F disvav.F g116f1.F gamdis.F gausin64.F prob.F \ @@\
- probkl.F ranlan.F studin.F studis.F tkolmo.F vavden.F \ @@\
- vavfcn.F vavran.F vavset.F vavzro.F vviden.F vviset.F \ @@\
- xm1lan.F xm2lan.F
-
-#if defined(CERNLIB_DOUBLE)
-SRCS_F:= $(SRCS_F) gausin.F
-#else
-SRCS_F:= $(SRCS_F) gausin128.F
-#endif
-
-FORTRANSAVEOPTION = FortranSaveFlags
-
-#if defined(CERNLIB_SGI)
-IMAKE_DEFINES=-DFortranDoesCpp=NO
-#endif
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/mathlib/gen/g/chisin.F b/src/mathlib/gen/g/chisin.F
deleted file mode 100644
index 4bb2201..0000000
--- a/src/mathlib/gen/g/chisin.F
+++ /dev/null
@@ -1,81 +0,0 @@
-*
-* $Id: chisin.F,v 1.1.1.1 1996/04/01 15:02:42 mclareni Exp $
-*
-* $Log: chisin.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:42 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-C This corresponds to CHISIN,IF=DOUBLE and CHISIN64,IF=-DOUBLE
- FUNCTION CHISIN(Q,N)
-
-C Computes the inverse of the
-C chi**2 distribution with n degrees of freedom.
-C Based on R.B. Goldstein, ALGORITHM 451 Chi-Square Quantiles,
-C Collected Algorithms from CACM
-C Note the complementary definition of the integral!
-
- CHARACTER NAME*(*)
- CHARACTER*80 ERRTXT
- PARAMETER (NAME = 'CHISIN')
- DIMENSION C1(7),C2(7),C3(7),A(19)
- PARAMETER (Z1 = 1, HF = Z1/2)
-
- DATA C1
-
- 1/ 1.565326E-3, 1.060438E-3,-6.950356E-3,-1.323293E-2, 2.277679E-2,
- 2 -8.986007E-3,-1.513904E-2/
- DATA C2
- 1/-1.450117E-3, 2.530010E-3, 5.169654E-3,-1.153761E-2, 1.128186E-2,
- 2 2.607083E-2,-2.237368E-1/
- DATA C3
- 1/ 9.780499E-5,-8.426812E-4, 3.125580E-3,-8.553069E-3, 1.348028E-4,
- 2 4.713941E-1, 1.0000886/
-
- DATA A
- 1/ 1.264616E-2,-1.425296E-2, 1.400483E-2,-5.886090E-3,-1.091214E-2,
- 2 -2.304527E-2, 3.135411E-3,-2.728484E-4,-9.699681E-3, 1.316872E-2,
- 3 2.618914E-2,-2.222222E-1, 5.406674E-5, 3.483789E-5,-7.274761E-4,
- 4 3.292181E-3,-8.729713E-3, 4.714045E-1, 1/
-
- IF(Q .LT. 0 .OR. Q .GE. 1) THEN
- H=0
- WRITE(ERRTXT,101) Q
- CALL MTLPRT(NAME,'G101.1',ERRTXT)
- ELSEIF(N .LE. 0) THEN
- H=0
- WRITE(ERRTXT,102) N
- CALL MTLPRT(NAME,'G101.2',ERRTXT)
- ELSEIF(Q .EQ. 0) THEN
- H=0
- ELSEIF(N .EQ. 1) THEN
- H=GAUSIN(HF*(1-Q))**2
- ELSEIF(N .EQ. 2) THEN
- H=-2*LOG(1-Q)
- ELSE
- F1=Z1/N
- T=GAUSIN(Q)
- F2=SQRT(F1)*T
- IF(N .LT. 2+INT(4*ABS(T))) THEN
- S1=C1(1)
- S2=C2(1)
- S3=C3(1)
- DO 1 I = 2,7
- S1=C1(I)+S1*F2
- S2=C2(I)+S2*F2
- 1 S3=C3(I)+S3*F2
- H=(S1*F1+S2)*F1+S3
- ELSE
- H=(((A(1)+A(2)*F2)*F1+(((A(3)+A(4)*F2)*F2+A(5))*F2+A(6)))*F1
- 1 +(((((A(7)+A(8)*F2)*F2+A(9))*F2+A(10))*F2+A(11))*F2+A(12)))*F1
- 2 +(((((A(13)*F2+A(14))*F2+A(15))*F2+A(16))*F2+A(17))*F2*F2
- 3 +A(18))*F2+A(19)
- ENDIF
- H=N*H**3
- ENDIF
- CHISIN=H
- RETURN
- 101 FORMAT('ILLEGAL ARGUMENT Q = ',1P,E15.5)
- 102 FORMAT('ILLEGAL DEGREE OF FREEDOM N = ',I5)
- END
diff --git a/src/mathlib/gen/g/coedin.F b/src/mathlib/gen/g/coedin.F
deleted file mode 100644
index daf43fe..0000000
--- a/src/mathlib/gen/g/coedin.F
+++ /dev/null
@@ -1,50 +0,0 @@
-*
-* $Id: coedin.F,v 1.1.1.1 1996/04/01 15:02:47 mclareni Exp $
-*
-* $Log: coedin.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:47 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE COEDIN(RKA,BE2,J)
-C
-C COEDIN COMPUTES THE FOURIER COEFFICIENTS FOR THE INVERSE OF
-C THE CONDITIONAL CUMULATIVE DISTRIBUTION FUNCTION OF THE
-C VAVILOV DISTRIBUTION
-C
- DIMENSION C(1001)
- COMMON /ONE/ TR
- COMMON /VAVILA/ B(200),S,TT
- COMMON /VAVILI/ T0,T1,T,OMEGA
- COMMON /FORFCN/ SS,LFCN
- DATA PI/3.1415926535898/
-C
- LU=ABS(J)
- CALL COEDIS(RKA,BE2,1,J)
-C
- SS=0.99
- IF(RKA .GE. 0.04) SS=0.995
- LFCN=2
- CALL VAVZRO(T0,T1,TR,RKA,BE2,LU)
- IF(J .GT. 0) WRITE(J,4) TR
- S=DISVAV(TR,1)
- TT=TR-T0
- STEP=TT/1000.
- STEP2=2.0*STEP
-C
- DO 1 I = 1,1001
- 1 C(I)=DISVAV(T0+STEP*(I-1),1)
-C
- DO 2 K = 1,200
- K1=201-K
- Z1=PI*K
- Z=Z1/S
- BK=0.5*(COS(Z*C(1))+COS(Z*C(1001)))
- DO 3 I = 2,1000
- 3 BK=BK+COS(Z*C(I))
- 2 B(K1)=STEP2*BK/Z1
- 4 FORMAT(10X,'T PRIME =',F10.4)
- RETURN
-C
- END
diff --git a/src/mathlib/gen/g/coedis.F b/src/mathlib/gen/g/coedis.F
deleted file mode 100644
index 2709c5b..0000000
--- a/src/mathlib/gen/g/coedis.F
+++ /dev/null
@@ -1,92 +0,0 @@
-*
-* $Id: coedis.F,v 1.1.1.1 1996/04/01 15:02:47 mclareni Exp $
-*
-* $Log: coedis.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:47 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE COEDIS(RKA,BE2,I,J)
-C
-C COEDIS COMPUTES THE ENDPOINTS T- AND T+ OF THE SUPPORT OF
-C DISVAV(X,0).IT ALSO COMPUTES THE FOURIER COEFFICIENTS OF DISVAV(X,
-C
- COMMON /VAVILI/ T0,T1,T,OMEGA
- COMMON /VAVILO/ A(155),B(155),N
- COMMON /FORFCN/ SS,LFCN
- DIMENSION XP(8),XQ(6)
- DATA E,PI,RG /5E-4, 3.1415926535898, 0.5772156649015/
- DATA XP
- + /9.29, 2.47, 0.89, 0.36, 0.15, 0.07, 0.03, 0.02/
- DATA XQ
- + /0.012, 0.03, 0.08, 0.26, 0.87, 3.83/
-C
- LU=ABS(J)
- IF (RKA .LT. 0.01 .OR. RKA .GT. 10.0) GOTO 6
- IF (BE2 .LT. 0.0 .OR. BE2 .GT. 1.0) GOTO 8
-C
- Z=1.-BE2*(1.-RG)-LOG(E)/RKA
- T0=(LOG(E)/RKA-(1.+BE2*RG)-Z*LOG(RKA)-(Z+BE2)*(LOG(Z)
- 1 +EXPINT(Z))+EXP(-Z))/Z
- DO 1 L = 1,8
- IF(RKA .GE. XP(L)) GO TO 11
- 1 CONTINUE
- L=9
- 11 P=-L-0.5
- DO 2 L = 1,6
- IF(RKA .LE. XQ(L)) GO TO 22
- 2 CONTINUE
- L=7
- 22 Q=L-7.5
- LFCN=3
- CALL VAVZRO(P,Q,X,RKA,BE2,LU)
- T1=(LOG(E)/RKA-(1.+BE2*RG))/X-LOG(RKA)-(1.+BE2/X)*(LOG(ABS(X))
- 1 +EXPINT(X))+EXP(-X)/X
-C
- IF(J .GT. 0) WRITE(J,10) T0,T1
- T=T1-T0
- OMEGA=2.0*PI/T
- LFCN=1
- CALL VAVZRO(5.,155.,X,RKA,BE2,LU)
- N=X+1.
-C
- D=EXP(RKA*(1.+BE2*(RG-LOG(RKA))))
- A(N)=0.
- IF(I .EQ. 0) A(N)=OMEGA/PI
- N1=N-1
- Q=-1.
-C
- DO 3 K = 1,N1
- L=N-K
- X=OMEGA*K
- X1=X/RKA
- C1=LOG(X)-COSINT(X1)
- C2=SININT(X1)
- C3=SIN(X1)
- C4=COS(X1)
- F1=RKA*(BE2*C1-C4)-X*C2
- F2=X*C1+RKA*(C3+BE2*C2)+T0*X
- D1=Q*D*EXP(F1)/PI
- HS=D1*SIN(F2)
- HC=D1*COS(F2)
- IF(I .EQ. 0) GO TO 4
- A(L)=HS/K
- B(L)=HC/K
- A(N)=A(N)-2.0*Q*A(L)
- GO TO 3
- 4 A(L)=HC*OMEGA
- B(L)=-HS*OMEGA
- 3 Q=-Q
- RETURN
-C
- 6 WRITE(LU,7) RKA
- RETURN
-C
- 8 WRITE(LU,9) BE2
- 7 FORMAT(/10X,'KAPPA =' ,E10.3,' - OUT OF RANGE')
- 9 FORMAT(/10X,'BETA**2 =',E10.3,' - OUT OF RANGE')
- 10 FORMAT(10X,'T- =',F8.3,10X,'T+ =',F8.3)
- RETURN
-C
- END
diff --git a/src/mathlib/gen/g/denlan.F b/src/mathlib/gen/g/denlan.F
deleted file mode 100644
index 44bed5a..0000000
--- a/src/mathlib/gen/g/denlan.F
+++ /dev/null
@@ -1,92 +0,0 @@
-*
-* $Id: denlan.F,v 1.1.1.1 1996/04/01 15:02:43 mclareni Exp $
-*
-* $Log: denlan.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:43 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-C This will be DENLAN,IF=DOUBLE and DENLAN64,IF=-DOUBLE
- FUNCTION DENLAN(X)
-
- DIMENSION P1(0:4),P2(0:4),P3(0:4),P4(0:4),P5(0:4),P6(0:4)
- DIMENSION Q1(0:4),Q2(0:4),Q3(0:4),Q4(0:4),Q5(0:4),Q6(0:4)
- DIMENSION A1(1:3),A2(1:2)
-
- DATA (P1(I),I=0,4),(Q1(I),I=0,4)
- 1/ 0.42598 94875E+0,-0.12497 62550E+0, 0.39842 43700E-1,
- 2 -0.62982 87635E-2, 0.15111 62253E-2,
- 3 1.0 ,-0.33882 60629E+0, 0.95943 93323E-1,
- 4 -0.16080 42283E-1, 0.37789 42063E-2/
-
- DATA (P2(I),I=0,4),(Q2(I),I=0,4)
- 1/ 0.17885 41609E+0, 0.11739 57403E+0, 0.14888 50518E-1,
- 2 -0.13949 89411E-2, 0.12836 17211E-3,
- 3 1.0 , 0.74287 95082E+0, 0.31539 32961E+0,
- 4 0.66942 19548E-1, 0.87906 09714E-2/
-
- DATA (P3(I),I=0,4),(Q3(I),I=0,4)
- 1/ 0.17885 44503E+0, 0.93591 61662E-1, 0.63253 87654E-2,
- 2 0.66116 67319E-4,-0.20310 49101E-5,
- 3 1.0 , 0.60978 09921E+0, 0.25606 16665E+0,
- 4 0.47467 22384E-1, 0.69573 01675E-2/
-
- DATA (P4(I),I=0,4),(Q4(I),I=0,4)
- 1/ 0.98740 54407E+0, 0.11867 23273E+3, 0.84927 94360E+3,
- 2 -0.74377 92444E+3, 0.42702 62186E+3,
- 3 1.0 , 0.10686 15961E+3, 0.33764 96214E+3,
- 4 0.20167 12389E+4, 0.15970 63511E+4/
-
- DATA (P5(I),I=0,4),(Q5(I),I=0,4)
- 1/ 0.10036 75074E+1, 0.16757 02434E+3, 0.47897 11289E+4,
- 2 0.21217 86767E+5,-0.22324 94910E+5,
- 3 1.0 , 0.15694 24537E+3, 0.37453 10488E+4,
- 4 0.98346 98876E+4, 0.66924 28357E+5/
-
- DATA (P6(I),I=0,4),(Q6(I),I=0,4)
- 1/ 0.10008 27619E+1, 0.66491 43136E+3, 0.62972 92665E+5,
- 2 0.47555 46998E+6,-0.57436 09109E+7,
- 3 1.0 , 0.65141 01098E+3, 0.56974 73333E+5,
- 4 0.16591 74725E+6,-0.28157 59939E+7/
-
- DATA (A1(I),I=1,3)
- 1/ 0.41666 66667E-1,-0.19965 27778E-1, 0.27095 38966E-1/
-
- DATA (A2(I),I=1,2)
- 1/-0.18455 68670E+1,-0.42846 40743E+1/
-
- V=X
- IF(V .LT. -5.5) THEN
- U=EXP(V+1.0)
- DENLAN=0.3989422803*(EXP(-1/U)/SQRT(U))*
- 1 (1+(A1(1)+(A1(2)+A1(3)*U)*U)*U)
- ELSEIF(V .LT. -1) THEN
- U=EXP(-V-1)
- DENLAN=EXP(-U)*SQRT(U)*
- 1 (P1(0)+(P1(1)+(P1(2)+(P1(3)+P1(4)*V)*V)*V)*V)/
- 2 (Q1(0)+(Q1(1)+(Q1(2)+(Q1(3)+Q1(4)*V)*V)*V)*V)
- ELSEIF(V .LT. 1) THEN
- DENLAN=(P2(0)+(P2(1)+(P2(2)+(P2(3)+P2(4)*V)*V)*V)*V)/
- 1 (Q2(0)+(Q2(1)+(Q2(2)+(Q2(3)+Q2(4)*V)*V)*V)*V)
- ELSEIF(V .LT. 5) THEN
- DENLAN=(P3(0)+(P3(1)+(P3(2)+(P3(3)+P3(4)*V)*V)*V)*V)/
- 1 (Q3(0)+(Q3(1)+(Q3(2)+(Q3(3)+Q3(4)*V)*V)*V)*V)
- ELSEIF(V .LT. 12) THEN
- U=1/V
- DENLAN=U**2*(P4(0)+(P4(1)+(P4(2)+(P4(3)+P4(4)*U)*U)*U)*U)/
- 1 (Q4(0)+(Q4(1)+(Q4(2)+(Q4(3)+Q4(4)*U)*U)*U)*U)
- ELSEIF(V .LT. 50) THEN
- U=1/V
- DENLAN=U**2*(P5(0)+(P5(1)+(P5(2)+(P5(3)+P5(4)*U)*U)*U)*U)/
- 1 (Q5(0)+(Q5(1)+(Q5(2)+(Q5(3)+Q5(4)*U)*U)*U)*U)
- ELSEIF(V .LT. 300) THEN
- U=1/V
- DENLAN=U**2*(P6(0)+(P6(1)+(P6(2)+(P6(3)+P6(4)*U)*U)*U)*U)/
- 1 (Q6(0)+(Q6(1)+(Q6(2)+(Q6(3)+Q6(4)*U)*U)*U)*U)
- ELSE
- U=1/(V-V*LOG(V)/(V+1))
- DENLAN=U**2*(1+(A2(1)+A2(2)*U)*U)
- ENDIF
- RETURN
- END
diff --git a/src/mathlib/gen/g/diflan.F b/src/mathlib/gen/g/diflan.F
deleted file mode 100644
index 29a6cec..0000000
--- a/src/mathlib/gen/g/diflan.F
+++ /dev/null
@@ -1,102 +0,0 @@
-*
-* $Id: diflan.F,v 1.1.1.1 1996/04/01 15:02:43 mclareni Exp $
-*
-* $Log: diflan.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:43 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-C This will be DIFLAN,IF=DOUBLE and DIFLAN64,IF=-DOUBLE
- FUNCTION DIFLAN(X)
-
- DIMENSION P1(0:4),P2(0:4),P3(0:4),P4(0:4),P5(0:4),P6(0:4),P7(0:5)
- DIMENSION Q1(0:4),Q2(0:4),Q3(0:4),Q4(0:4),Q5(0:4),Q6(0:4),Q7(0:5)
- DIMENSION A1(1:6),A2(1:3)
-
- DATA (P1(I),I=0,4),(Q1(I),I=0,4)
- 1/-0.30620 16156E-1,-0.12514 24734E+0,-0.95514 20540E-1,
- 2 -0.26943 56206E-1,-0.26175 52485E-2,
- 3 1.0 , 0.11777 46655E+1, 0.61309 93990E+0,
- 4 0.15727 03422E+0, 0.17262 95027E-1/
-
- DATA (P2(I),I=0,4),(Q2(I),I=0,4)
- 1/-0.15491 26548E-1,-0.75512 22105E-1,-0.25986 23886E-1,
- 2 0.54712 70049E-2, 0.21522 70275E-2,
- 3 1.0 , 0.99974 60723E+0, 0.49882 64176E+0,
- 4 0.12891 04987E+0, 0.16396 32530E-1/
-
- DATA (P3(I),I=0,4),(Q3(I),I=0,4)
- 1/-0.15471 35743E-1,-0.73041 84799E-1,-0.15341 51353E-1,
- 2 0.35687 80079E-2,-0.92961 96751E-4,
- 3 1.0 , 0.83941 07748E+0, 0.41280 36830E+0,
- 4 0.10502 22892E+0, 0.17008 94650E-1/
-
- DATA (P4(I),I=0,4),(Q4(I),I=0,4)
- 1/-0.15462 73317E-1,-0.68561 27408E-1, 0.46112 67324E-2,
- 2 -0.25499 45537E-3, 0.58761 90635E-5,
- 3 1.0 , 0.54532 66037E+0, 0.28025 11577E+0,
- 4 0.47491 21515E-1, 0.10962 78827E-1/
-
- DATA (P5(I),I=0,4),(Q5(I),I=0,4)
- 1/ 0.86420 27131E-5,-0.74742 91951E-3, 0.29356 78494E-1,
- 2 -0.27696 95199E+1,-0.77695 42153E+1,
- 3 1.0 , 0.90003 29289E+0, 0.34619 66768E+2,
- 4 0.46668 93094E+1, 0.19264 64264E+3/
-
- DATA (P6(I),I=0,4),(Q6(I),I=0,4)
- 1/-0.20124 96309E+1,-0.27484 32206E+3,-0.57590 40086E+4,
- 2 -0.16000 68673E+5, 0.53346 52087E+5,
- 3 1.0 , 0.12295 70501E+3, 0.18746 82285E+4,
- 4 0.56780 25130E+4, 0.52823 54475E5/
-
- DATA (P7(I),I=0,5),(Q7(I),I=0,5)
- 1/-0.20015 84932E+1,-0.24074 20185E+4,-0.54566 69704E+6,
- 2 -0.28170 17048E+8,-0.20643 92982E+9, 0.90496 05994E+9,
- 3 1.0 , 0.11829 29609E+4, 0.25522 99337E+6,
- 4 0.11392 05796E+8, 0.39347 02081E+8, 0.21080 69087E+9/
-
- DATA (A1(I),I=1,6)
- 1/-0.45833 33333E+0, 0.86805 55556E-3,-0.28525 27006E-2,
- 2 0.53868 92562E-2,-0.14312 07031E-1, 0.50629 96176E-1/
-
- DATA (A2(I),I=1,3)
- 1/-0.75367 06011E+1,-0.96018 56962E+1, 0.17146 15239E+3/
-
- V=X
- IF(V .LT. -2.6) THEN
- U=EXP(V+1)
- DIFLAN=0.3989422803*(EXP(-1/U)/U**1.5)*
- 1 (1+(A1(1)+(A1(2)+(A1(3)+(A1(4)+(A1(5)+A1(6)*U)*U)*U)*U)*U)*U)
- ELSEIF(V .LT. -1.75) THEN
- DIFLAN=(P1(0)+(P1(1)+(P1(2)+(P1(3)+P1(4)*V)*V)*V)*V)/
- 1 (Q1(0)+(Q1(1)+(Q1(2)+(Q1(3)+Q1(4)*V)*V)*V)*V)
- ELSEIF(V .LT. -1.25) THEN
- DIFLAN=(P2(0)+(P2(1)+(P2(2)+(P2(3)+P2(4)*V)*V)*V)*V)/
- 1 (Q2(0)+(Q2(1)+(Q2(2)+(Q2(3)+Q2(4)*V)*V)*V)*V)
- ELSEIF(V .LT. 0.5) THEN
- DIFLAN=(P3(0)+(P3(1)+(P3(2)+(P3(3)+P3(4)*V)*V)*V)*V)/
- 1 (Q3(0)+(Q3(1)+(Q3(2)+(Q3(3)+Q3(4)*V)*V)*V)*V)
- ELSEIF(V .LT. 5) THEN
- DIFLAN=(P4(0)+(P4(1)+(P4(2)+(P4(3)+P4(4)*V)*V)*V)*V)/
- 1 (Q4(0)+(Q4(1)+(Q4(2)+(Q4(3)+Q4(4)*V)*V)*V)*V)
- ELSEIF(V .LT. 15) THEN
- U=1/V
- DIFLAN=(P5(0)+(P5(1)+(P5(2)+(P5(3)+P5(4)*U)*U)*U)*U)/
- 1 (Q5(0)+(Q5(1)+(Q5(2)+(Q5(3)+Q5(4)*U)*U)*U)*U)
- ELSEIF(V .LT. 50) THEN
- U=1/V
- DIFLAN=U**3*(P6(0)+(P6(1)+(P6(2)+(P6(3)+P6(4)*U)*U)*U)*U)/
- 1 (Q6(0)+(Q6(1)+(Q6(2)+(Q6(3)+Q6(4)*U)*U)*U)*U)
- ELSEIF(V .LT. 300) THEN
- U=1/V
- DIFLAN=U**3*
- 1 (P7(0)+(P7(1)+(P7(2)+(P7(3)+(P7(4)+P7(5)*U)*U)*U)*U)*U)/
- 2 (Q7(0)+(Q7(1)+(Q7(2)+(Q7(3)+(Q7(4)+Q7(5)*U)*U)*U)*U)*U)
- ELSE
- U=V-V*LOG(V)/(V+1)
- U=1/(U-U*(U+LOG(U)-V)/(U+1))
- DIFLAN=-U**3*(2.0+(A2(1)+(A2(2)+A2(3)*U)*U)*U)
- ENDIF
- RETURN
- END
diff --git a/src/mathlib/gen/g/dinvav.F b/src/mathlib/gen/g/dinvav.F
deleted file mode 100644
index a3def2e..0000000
--- a/src/mathlib/gen/g/dinvav.F
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: dinvav.F,v 1.1.1.1 1996/04/01 15:02:47 mclareni Exp $
-*
-* $Log: dinvav.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:47 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- FUNCTION DINVAV(X)
-C
-C DINVAV(X) COMPUTES THE VALUE OF THE INVERSE OF THE CONDITIONAL
-C CUMULATIVE DISTRIBUTION FUNCTION OF THE VAVILOV DISTRIBUTION
-C AT THE POINT X
-C
- COMMON /VAVILA/ B(200),S,TT
- COMMON /VAVILI/ T0,T1,T,OMEGA
-C
- Z=3.1415926535898*X
- COF=2.*COS(Z)
- C1=0.
- C0=B(1)
-C
- DO 1 K = 2,200
- C2=C1
- C1=C0
- 1 C0=B(K)+COF*C1-C2
-C
- DINVAV=T0+TT*X+C0*SIN(Z)
- RETURN
-C
- END
diff --git a/src/mathlib/gen/g/dislan.F b/src/mathlib/gen/g/dislan.F
deleted file mode 100644
index 960388f..0000000
--- a/src/mathlib/gen/g/dislan.F
+++ /dev/null
@@ -1,94 +0,0 @@
-*
-* $Id: dislan.F,v 1.1.1.1 1996/04/01 15:02:43 mclareni Exp $
-*
-* $Log: dislan.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:43 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-C This will be DISLAN,IF=DOUBLE and DISLAN64,IF=-DOUBLE
- FUNCTION DISLAN(X)
-
- DIMENSION P1(0:4),P2(0:3),P3(0:3),P4(0:3),P5(0:3),P6(0:3)
- DIMENSION Q1(0:4),Q2(0:3),Q3(0:3),Q4(0:3),Q5(0:3),Q6(0:3)
- DIMENSION A1(1:3),A2(1:3)
-
- DATA (P1(I),I=0,4),(Q1(I),I=0,4)
- 1/ 0.25140 91491E+0,-0.62505 80444E-1, 0.14583 81230E-1,
- 2 -0.21088 17737E-2, 0.74112 47290E-3,
- 3 1.0 ,-0.55711 75625E-2, 0.62253 10236E-1,
- 4 -0.31373 78427E-2, 0.19314 96439E-2/
-
- DATA (P2(I),I=0,3),(Q2(I),I=0,3)
- 1/ 0.28683 28584E+0, 0.35643 63231E+0, 0.15235 18695E+0,
- 2 0.22513 04883E-1,
- 3 1.0 , 0.61911 36137E+0, 0.17207 21448E+0,
- 4 0.22785 94771E-1/
-
- DATA (P3(I),I=0,3),(Q3(I),I=0,3)
- 1/ 0.28683 29066E+0, 0.30038 28436E+0, 0.99509 51941E-1,
- 2 0.87338 27185E-2,
- 3 1.0 , 0.42371 90502E+0, 0.10956 31512E+0,
- 4 0.86938 51567E-2/
-
- DATA (P4(I),I=0,3),(Q4(I),I=0,3)
- 1/ 0.10003 51630E+1, 0.45035 92498E+1, 0.10858 83880E+2,
- 2 0.75360 52269E+1,
- 3 1.0 , 0.55399 69678E+1, 0.19335 81111E+2,
- 4 0.27213 21508E+2/
-
- DATA (P5(I),I=0,3),(Q5(I),I=0,3)
- 1/ 0.10000 06517E+1, 0.49094 14111E+2, 0.85055 44753E+2,
- 2 0.15321 53455E+3,
- 3 1.0 , 0.50099 28881E+2, 0.13998 19104E+3,
- 4 0.42000 02909E+3/
-
- DATA (P6(I),I=0,3),(Q6(I),I=0,3)
- 1/ 0.10000 00983E+1, 0.13298 68456E+3, 0.91621 49244E+3,
- 2 -0.96050 54274E+3,
- 3 1.0 , 0.13398 87843E+3, 0.10559 90413E+4,
- 4 0.55322 24619E+3/
-
- DATA (A1(I),I=1,3)
- 1/-0.45833 33333E+0, 0.66753 47222E+0,-0.16417 41416E+1/
-
- DATA (A2(I),I=1,3)
- 1/ 1.0 ,-0.42278 43351E+0,-0.20434 03138E+1/
-
- ENTRY DSTLAN(X)
-
- V=X
- IF(V .LT. -5.5) THEN
- U=EXP(V+1)
- DISLAN=0.3989422803*EXP(-1/U)*SQRT(U)*
- 1 (1+(A1(1)+(A1(2)+A1(3)*U)*U)*U)
- ELSEIF(V .LT. -1) THEN
- U=EXP(-V-1)
- DISLAN=(EXP(-U)/SQRT(U))*
- 1 (P1(0)+(P1(1)+(P1(2)+(P1(3)+P1(4)*V)*V)*V)*V)/
- 2 (Q1(0)+(Q1(1)+(Q1(2)+(Q1(3)+Q1(4)*V)*V)*V)*V)
- ELSEIF(V .LT. 1) THEN
- DISLAN=(P2(0)+(P2(1)+(P2(2)+P2(3)*V)*V)*V)/
- 1 (Q2(0)+(Q2(1)+(Q2(2)+Q2(3)*V)*V)*V)
- ELSEIF(V .LT. 4) THEN
- DISLAN=(P3(0)+(P3(1)+(P3(2)+P3(3)*V)*V)*V)/
- 1 (Q3(0)+(Q3(1)+(Q3(2)+Q3(3)*V)*V)*V)
- ELSEIF(V .LT. 12) THEN
- U=1/V
- DISLAN=(P4(0)+(P4(1)+(P4(2)+P4(3)*U)*U)*U)/
- 1 (Q4(0)+(Q4(1)+(Q4(2)+Q4(3)*U)*U)*U)
- ELSEIF(V .LT. 50) THEN
- U=1/V
- DISLAN=(P5(0)+(P5(1)+(P5(2)+P5(3)*U)*U)*U)/
- 1 (Q5(0)+(Q5(1)+(Q5(2)+Q5(3)*U)*U)*U)
- ELSEIF(V .LT. 300) THEN
- U=1/V
- DISLAN=(P6(0)+(P6(1)+(P6(2)+P6(3)*U)*U)*U)/
- 1 (Q6(0)+(Q6(1)+(Q6(2)+Q6(3)*U)*U)*U)
- ELSE
- U=1/(V-V*LOG(V)/(V+1))
- DISLAN=1-(A2(1)+(A2(2)+A2(3)*U)*U)*U
- ENDIF
- RETURN
- END
diff --git a/src/mathlib/gen/g/disvav.F b/src/mathlib/gen/g/disvav.F
deleted file mode 100644
index 32f14da..0000000
--- a/src/mathlib/gen/g/disvav.F
+++ /dev/null
@@ -1,54 +0,0 @@
-*
-* $Id: disvav.F,v 1.1.1.1 1996/04/01 15:02:47 mclareni Exp $
-*
-* $Log: disvav.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:47 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- FUNCTION DISVAV(X,I)
-C
-C DISVAV(X,I) COMPUTES FOR I=0 THE VALUE OF THE DENSITY, FOR I=1
-C THE VALUE OF THE CUMULATIVE DISTRIBUTION FUNCTION OF THE
-C VAVILOV DISTRIBUTION AT THE POINT X
-C
- COMMON /VAVILI/ T0,T1,T,OMEGA
- COMMON /VAVILO/ A(155),B(155),N
-C
- IF(X .LT. T0) GO TO 3
- IF(X .GT. T1) GO TO 4
-C
- Y=X-T0
-C
- TRR=0.
- IF(I .EQ. 1) TRR=Y/T
-C
- Z=OMEGA*Y-3.1415926535898
- COF=2.0*COS(Z)
- A1=0.
- A0=A(1)
- NN=N-1
- DO 1 K = 2,N
- A2=A1
- A1=A0
- 1 A0=A(K)+COF*A1-A2
-C
- TRR=TRR+0.5*(A0-A2)
- A1=0.
- A0=B(1)
- DO 2 K = 2,NN
- A2=A1
- A1=A0
- 2 A0=B(K)+COF*A1-A2
-C
- DISVAV=TRR+A0*SIN(Z)
- RETURN
-C
- 3 DISVAV=0.0
- RETURN
-C
- 4 DISVAV=I
- RETURN
-C
- END
diff --git a/src/mathlib/gen/g/g116f1.F b/src/mathlib/gen/g/g116f1.F
deleted file mode 100644
index afb7a8c..0000000
--- a/src/mathlib/gen/g/g116f1.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: g116f1.F,v 1.1.1.1 1996/04/01 15:02:48 mclareni Exp $
-*
-* $Log: g116f1.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:48 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- FUNCTION G116F1(X)
-
- COMMON /G116C1/ H(7),T0,T1,T,OMEGA,A(155),B(155),X0
-
- G116F1=H(1)+H(2)*LOG(H(3)*X)-H(4)*X
- RETURN
-
- ENTRY G116F2(X)
-
- G116F2=H(5)-X+H(6)*(LOG(ABS(X))+REXPIN(X))-H(7)*EXP(-X)
- RETURN
- END
diff --git a/src/mathlib/gen/g/gamdis.F b/src/mathlib/gen/g/gamdis.F
deleted file mode 100644
index 40115cb..0000000
--- a/src/mathlib/gen/g/gamdis.F
+++ /dev/null
@@ -1,128 +0,0 @@
-*
-* $Id: gamdis.F,v 1.1.1.1 1996/04/01 15:02:43 mclareni Exp $
-*
-* $Log: gamdis.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:43 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-C This will be GAMDIS,IF=DOUBLE and GAMDIS64,IF=-DOUBLE
- FUNCTION GAMDIS(X,A)
-
-C Calculates the gamma distribution function
-C
-C G(x,a) = (1/gamma(a)) * int(0,x)[exp(-t) * t**(a-1)] dt.
-C
-C Based on
-C W. Gautschi, ALGORITHM 542 Incomplete Gamma Functions,
-C ACM Trans. Math. Software 5 (1979) 482-489.
-
- CHARACTER NAME*(*)
- CHARACTER*80 ERRTXT
- PARAMETER (NAME = 'GAMDIS')
- DIMENSION C(14)
-
- PARAMETER (EPS = 1E-5, EPS1 = 5E-7)
- PARAMETER (ALH = -0.69314 72)
- PARAMETER (Z1 = 1, HALF = Z1/2, QUAR = Z1/4)
- PARAMETER (C1 = 3*Z1/2, KMAX = 300)
-
- DATA C
- 1/ 0.5772157,-0.6558781,-0.0420026, 0.1665386,-0.0421977,
- 2 -0.0096220, 0.0072189,-0.0011652,-0.0002152, 0.0001281,
- 3 -0.0000201,-0.0000013, 0.0000011,-0.0000002/
-
- HST=0
- IF(X .EQ. 0) GO TO 99
- IF(X .LT. 0 .OR. A .LE. 0) THEN
- WRITE(ERRTXT,101) X,A
- CALL MTLPRT(NAME,'G106.1',ERRTXT)
- GO TO 99
- ELSE
- ALX=LOG(X)
- ENDIF
- IF(X .LT. QUAR) THEN
- ALFA=ALH/ALX
- ELSE
- ALFA=X+QUAR
- ENDIF
- IF(A .GT. ALFA) THEN
- TERM=1
- SUM=1
- DO 1 K = 1,KMAX
- TERM=X*TERM/(A+K)
- SUM=SUM+TERM
- IF(ABS(TERM) .LE. EPS*SUM) GO TO 2
- 1 CONTINUE
- GO TO 98
- 2 HST=SUM*EXP(A*ALX-X-ALOGAM(1+A))
- ELSEIF(X .GT. C1) THEN
- P=0
- S=1-A
- Q=(X+S)*(X-1-A)
- R=4*(X+S)
- TERM=1
- SUM=1
- RHO=0
- DO 3 K = 2,KMAX
- P=P+S
- Q=Q+R
- R=R+8
- S=S+2
- T=P*(1+RHO)
- RHO=T/(Q-T)
- TERM=RHO*TERM
- SUM=SUM+TERM
- IF(ABS(TERM) .LE. EPS*SUM) GO TO 4
- 3 CONTINUE
- GO TO 98
- 4 HST=1-(A*SUM/(X+1-A))*EXP(A*ALX-X-ALOGAM(1+A))
- ELSE
- IF(A .LT. HALF) THEN
- SUM=C(14)
- DO 12 K = 13,1,-1
- 12 SUM=A*SUM+C(K)
- GA=-SUM/(1+A*SUM)
- Y=A*ALX
- IF(ABS(Y) .GE. 1) THEN
- U=GA-(EXP(Y)-1)/A
- ELSE
- SUM=1
- TERM=1
- DO 7 K = 2,KMAX
- TERM=Y*TERM/K
- SUM=SUM+TERM
- IF(ABS(TERM) .LE. EPS1*SUM) GO TO 8
- 7 CONTINUE
- GO TO 98
- 8 U=GA-SUM*ALX
- ENDIF
- ELSE
- U=GAMMA(A)-EXP(A*ALX)/A
- ENDIF
- P=A*X
- Q=A+1
- R=A+3
- TERM=1
- SUM=1
- DO 9 K = 2,KMAX
- P=P+X
- Q=Q+R
- R=R+2
- TERM=-P*TERM/Q
- SUM=SUM+TERM
- IF(ABS(TERM) .LE. EPS1*SUM) GO TO 10
- 9 CONTINUE
- GO TO 98
- 10 HST=1-A*(U+SUM*EXP((1+A)*ALX)/(1+A))/GAMMA(1+A)
- ENDIF
- 99 GAMDIS=HST
- RETURN
-
- 98 WRITE(ERRTXT,102) X,A
- CALL MTLPRT(NAME,'G106.2',ERRTXT)
- GO TO 99
- 101 FORMAT('ILLEGAL ARGUMENT(S) X = ',E15.8,' A = ',E15.8)
- 102 FORMAT('PROBLEMS WITH CONVERGENCE, X = ',E15.8,' A = ',E15.8)
- END
diff --git a/src/mathlib/gen/g/gausin.F b/src/mathlib/gen/g/gausin.F
deleted file mode 100644
index b27a232..0000000
--- a/src/mathlib/gen/g/gausin.F
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: gausin.F,v 1.1.1.1 1996/04/01 15:02:42 mclareni Exp $
-*
-* $Log: gausin.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:42 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- FUNCTION GAUSIN(P)
-
-C Computes a "Normal Deviate"
-C Based on G.W. Hill & A.W. Davis, Algorithm 442 Normal Deviate
-C Collected Algorithms from CACM
-
- CHARACTER NAME*(*)
- CHARACTER*80 ERRTXT
- PARAMETER (NAME = 'GAUSIN')
- PARAMETER (C = 2.50662 827)
-
- IF(P .LE. 0 .OR. P .GE. 1) THEN
- H=0
- WRITE(ERRTXT,101) P
- CALL MTLPRT(NAME,'G105.1',ERRTXT)
- ELSEIF(P .EQ. 0.5) THEN
- H=0
- ELSE
- X=P
- IF(P .GT. 0.5) X=1-P
- X=SQRT(-2*LOG(X))
- X=X-((7.45551*X+450.636)*X+1271.059)/
- 1 (((X+110.4212)*X+750.365)*X+500.756)
- IF(P .LT. 0.5) X=-X
- H=C*(P-FREQ(X))*EXP(0.5*X**2)+X
- ENDIF
- GAUSIN=H
- RETURN
- 101 FORMAT('ARGUMENT P =',1P,E15.5,' NOT IN RANGE')
- END
-#endif
diff --git a/src/mathlib/gen/g/gausin128.F b/src/mathlib/gen/g/gausin128.F
deleted file mode 100644
index 12ee8cd..0000000
--- a/src/mathlib/gen/g/gausin128.F
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: gausin128.F,v 1.1.1.1 1996/04/01 15:02:42 mclareni Exp $
-*
-* $Log: gausin128.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:42 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION DGAUSN(P)
-#include "gen/imp128.inc"
- CHARACTER NAME*(*)
- PARAMETER (NAME = 'DGAUSN')
- DGAUSN=0
- CALL MTLPRT(NAME,'G105.0','Not available on this machine')
- DGAUSN=0
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/g/gausin64.F b/src/mathlib/gen/g/gausin64.F
deleted file mode 100644
index 3a8dd37..0000000
--- a/src/mathlib/gen/g/gausin64.F
+++ /dev/null
@@ -1,64 +0,0 @@
-*
-* $Id: gausin64.F,v 1.1.1.1 1996/04/01 15:02:43 mclareni Exp $
-*
-* $Log: gausin64.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:43 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION GAUSIN(P)
-#endif
-#if defined(CERNLIB_DOUBLE)
- FUNCTION DGAUSN(P)
-#include "gen/imp64.inc"
-#endif
-C Computes a "Normal Deviate"
-C Based on G.W. Hill & A.W. Davis, Algorithm 442 Normal Deviate
-C Collected Algorithms from CACM
-
- CHARACTER NAME*(*)
- CHARACTER*80 ERRTXT
-#if !defined(CERNLIB_DOUBLE)
- PARAMETER (NAME = 'GAUSIN')
-#endif
-#if defined(CERNLIB_DOUBLE)
- PARAMETER (NAME = 'DGAUSN')
-#endif
-
- PARAMETER (C = 2.50662 82746 31000 50D0)
- PARAMETER (Z1 = 1, HF = Z1/2, C1 = 3*Z1/4, C2 = 7*Z1/8, C3 = Z1/3)
-
- IF(P .LE. 0 .OR. P .GE. 1) THEN
- H=0
- WRITE(ERRTXT,101) P
- CALL MTLPRT(NAME,'G105.1',ERRTXT)
- ELSEIF(P .EQ. HF) THEN
- H=0
- ELSE
- X=P
- IF(P .GT. HF) X=1-P
- X=SQRT(-2*LOG(X))
- X=X-((7.47395*X+494.877)*X+1637.720)/
- 1 (((X+117.9407)*X+908.401)*X+659.935)
- IF(P .LT. HF) X=-X
- S=X**2
-#if !defined(CERNLIB_DOUBLE)
- Z=C*(P-FREQ(X))*EXP(HF*S)
-#endif
-#if defined(CERNLIB_DOUBLE)
- Z=C*(P-DFREQ(X))*EXP(HF*S)
-#endif
- H=(((((C1*S+C2)*Z+X)*X+HF)*C3*Z+HF*X)*Z+1)*Z+X
- ENDIF
-#if !defined(CERNLIB_DOUBLE)
- GAUSIN=H
-#endif
-#if defined(CERNLIB_DOUBLE)
- DGAUSN=H
-#endif
- RETURN
- 101 FORMAT('ARGUMENT P =',1P,D15.8,' NOT IN RANGE')
- END
-
diff --git a/src/mathlib/gen/g/prob.F b/src/mathlib/gen/g/prob.F
deleted file mode 100644
index ee24ad6..0000000
--- a/src/mathlib/gen/g/prob.F
+++ /dev/null
@@ -1,108 +0,0 @@
-*
-* $Id: prob.F,v 1.1.1.1 1996/04/01 15:02:41 mclareni Exp $
-*
-* $Log: prob.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:41 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- FUNCTION PROB(X,N)
-
-#include "gen/imp64.inc"
- REAL PROB,X
- CHARACTER NAME*(*)
- CHARACTER*80 ERRTXT
- PARAMETER (NAME = 'PROB')
- PARAMETER (R1 = 1, HF = R1/2, TH = R1/3, F1 = 2*R1/9)
- PARAMETER (C1 = 1.12837 91670 95513D0)
- PARAMETER (NMAX = 300)
-* maximum chi2 per df for df >= 2., if chi2/df > chipdf prob=0.
- PARAMETER (CHIPDF = 100.)
- PARAMETER (XMAX = 174.673, XMAX2 = 2*XMAX)
-#if defined(CERNLIB_IBM)
-*
-* 13.3 is limit of DERFC intrinsic (Wojciech Wojcik/IN2P3)
-*
- PARAMETER (XLIM = 13.3)
-#endif
-#if !defined(CERNLIB_IBM)
- PARAMETER (XLIM = 24.)
-#endif
- PARAMETER (EPS = 1D-30)
-#if defined(CERNLIB_DOUBLE)
- GERFC(V)=DERFC(V)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- GERFC(V)= ERFC(V)
-#endif
-
- Y=X
- U=HF*Y
- IF(N .LE. 0) THEN
- H=0
- WRITE(ERRTXT,101) N
- CALL MTLPRT(NAME,'G100.1',ERRTXT)
- ELSEIF(Y .LT. 0) THEN
- H=0
- WRITE(ERRTXT,102) X
- CALL MTLPRT(NAME,'G100.2',ERRTXT)
- ELSEIF(Y .EQ. 0 .OR. N/20 .GT. Y) THEN
- H=1
- ELSEIF(N .EQ. 1) THEN
- W=SQRT(U)
- IF(W .LT. XLIM) THEN
- H=GERFC(W)
- ELSE
- H=0
- ENDIF
- ELSEIF(N .GT. NMAX) THEN
- S=R1/N
- T=F1*S
- W=((Y*S)**TH-(1-T))/SQRT(2*T)
- IF(W .LT. -XLIM) THEN
- H=1
- ELSEIF(W .LT. XLIM) THEN
- H=HF*GERFC(W)
- ELSE
- H=0
- ENDIF
- ELSE
- M=N/2
- IF(U .LT. XMAX2 .AND. (Y/N).LE.CHIPDF ) THEN
- S=EXP(-HF*U)
- T=S
- E=S
- IF(2*M .EQ. N) THEN
- FI=0
- DO 1 I = 1,M-1
- FI=FI+1
- T=U*T/FI
- 1 S=S+T
- H=S*E
- ELSE
- FI=1
- DO 2 I=1,M-1
- FI=FI+2
- T=T*Y/FI
- 2 S=S+T
- W=SQRT(U)
- IF(W.LT.XLIM) THEN
- H=C1*W*S*E+GERFC(W)
- ELSE
- H=0.
- ENDIF
- ENDIF
- ELSE
- H=0
- ENDIF
- ENDIF
- IF ( H.GT. EPS ) THEN
- PROB=H
- ELSE
- PROB=0.
- ENDIF
- RETURN
- 101 FORMAT('N = ',I6,' < 1')
- 102 FORMAT('X = ',1P,E20.10,' < 0')
- END
diff --git a/src/mathlib/gen/g/probkl.F b/src/mathlib/gen/g/probkl.F
deleted file mode 100644
index 48caecf..0000000
--- a/src/mathlib/gen/g/probkl.F
+++ /dev/null
@@ -1,51 +0,0 @@
-
-*
-* $Id: probkl.F,v 1.2 1997/04/08 14:39:00 mclareni Exp $
-*
-* $Log: probkl.F,v $
-* Revision 1.2 1997/04/08 14:39:00 mclareni
-* A fourth term is needed for part of the range of X, Fred James
-*
-* Revision 1.1.1.1 1996/04/01 15:02:42 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-C This corresponds to PROBKL,IF=DOUBLE and PROBKL64,IF=-DOUBLE
- FUNCTION PROBKL(X)
-
- DIMENSION FJ(4),R(4)
-
- PARAMETER (PI = 3.14159 265D0)
- PARAMETER (W = 2.50662 827D0)
- PARAMETER (C1 = -PI**2/8, C2 = 9*C1, C3 = 25*C1)
-
- DATA FJ /-2,-8,-18,-32/
-
- U=ABS(X)
- IF(U .LT. 0.2) THEN
- P=1.
- ELSEIF(U .LT. 0.755) THEN
- V=1/U**2
- P=1-W*(EXP(C1*V)+EXP(C2*V)+EXP(C3*V))/U
- ELSEIF(U .LT. 6.8116) THEN
- R(2)=0.
- R(3)=0.
- R(4)=0.
- V=U**2
- DO 1 J = 1,MAX(1,NINT(3/U))
- 1 R(J)=EXP(FJ(J)*V)
- P=2*(R(1)-R(2)+R(3)-R(4))
-CCC PRINT '(35x,4e10.2)', (R(JJ),JJ=1,4)
- ELSE
- P=0
- ENDIF
- PROBKL=P
- RETURN
- END
-
-
-
-
-
-
diff --git a/src/mathlib/gen/g/probold.F b/src/mathlib/gen/g/probold.F
deleted file mode 100644
index 26f0951..0000000
--- a/src/mathlib/gen/g/probold.F
+++ /dev/null
@@ -1,61 +0,0 @@
-*
-* $Id: probold.F,v 1.1.1.1 1996/04/01 15:02:42 mclareni Exp $
-*
-* $Log: probold.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:42 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_OBSOLETE)
-C This corresponds to PROB,IF=DOUBLE and PROB64,IF=-DOUBLE
- FUNCTION PROB(CHI2,N)
-
- CHARACTER NAME*(*)
- CHARACTER*80 ERRTXT
- PARAMETER (NAME = 'PROB')
- PARAMETER (R1 = 1, HF = R1/2, TH = R1/3, F1 = 2*R1/9)
- PARAMETER (C1 = 1.12837 91670 95513D0)
-C PARAMETER (UP = 340)
- PARAMETER (UP = 170)
-
- X=HF*CHI2
- IF(N .LE. 0) THEN
- H=0
- WRITE(ERRTXT,101) N
- CALL MTLPRT(NAME,'G100.1',ERRTXT)
- ELSEIF(CHI2 .LT. 0) THEN
- H=0
- WRITE(ERRTXT,102) CHI2
- CALL MTLPRT(NAME,'G100.2',ERRTXT)
- ELSEIF(CHI2 .GT. UP) THEN
- H=0
- ELSEIF(N .GT. 100) THEN
- S=R1/N
- T=F1*S
- H=HF*ERFC(((CHI2*S)**TH-(1-T))/SQRT(2*T))
- ELSEIF(N .EQ. 1) THEN
- H=ERFC(SQRT(X))
- ELSE
- S=1
- T=1
- M=N/2
- IF(2*M .EQ. N) THEN
- DO 1 I = 1,M-1
- T=X*T/I
- 1 S=S+T
- H=S*EXP(-X)
- ELSE
- DO 2 I=1,M-1
- T=T*CHI2/(2*I+1)
- 2 S=S+T
- W=SQRT(X)
- H=C1*W*S*EXP(-X)+ERFC(W)
- ENDIF
- ENDIF
- PROB=H
- RETURN
- 101 FORMAT('N = ',I6,' < 1')
- 102 FORMAT('X = ',1P,E20.10,' < 0')
- END
-#endif
diff --git a/src/mathlib/gen/g/ranlan.F b/src/mathlib/gen/g/ranlan.F
deleted file mode 100644
index 9b8b09d..0000000
--- a/src/mathlib/gen/g/ranlan.F
+++ /dev/null
@@ -1,228 +0,0 @@
-*
-* $Id: ranlan.F,v 1.1.1.1 1996/04/01 15:02:43 mclareni Exp $
-*
-* $Log: ranlan.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:43 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-C This will be RANLAN,IF=DOUBLE and RANLAN64,IF=-DOUBLE
- FUNCTION RANLAN(X)
-
- DIMENSION F(6:982)
-
- DATA (F(I),I= 6,100)
- A/ -2.244733,
- B -2.204365,-2.168163,-2.135219,-2.104898,-2.076740,-2.050397,
- C -2.025605,-2.002150,-1.979866,-1.958612,-1.938275,-1.918760,
- D -1.899984,-1.881879,-1.864385,-1.847451,-1.831030,-1.815083,
- E -1.799574,-1.784473,-1.769751,-1.755383,-1.741346,-1.727620,
- F -1.714187,-1.701029,-1.688130,-1.675477,-1.663057,-1.650858,
- G -1.638868,-1.627078,-1.615477,-1.604058,-1.592811,-1.581729,
- H -1.570806,-1.560034,-1.549407,-1.538919,-1.528565,-1.518339,
- I -1.508237,-1.498254,-1.488386,-1.478628,-1.468976,-1.459428,
- J -1.449979,-1.440626,-1.431365,-1.422195,-1.413111,-1.404112,
- K -1.395194,-1.386356,-1.377594,-1.368906,-1.360291,-1.351746,
- L -1.343269,-1.334859,-1.326512,-1.318229,-1.310006,-1.301843,
- M -1.293737,-1.285688,-1.277693,-1.269752,-1.261863,-1.254024,
- N -1.246235,-1.238494,-1.230800,-1.223153,-1.215550,-1.207990,
- O -1.200474,-1.192999,-1.185566,-1.178172,-1.170817,-1.163500,
- P -1.156220,-1.148977,-1.141770,-1.134598,-1.127459,-1.120354,
- Q -1.113282,-1.106242,-1.099233,-1.092255/
-
- DATA (F(I),I=101,200)
- A/-1.085306,-1.078388,-1.071498,-1.064636,-1.057802,-1.050996,
- B -1.044215,-1.037461,-1.030733,-1.024029,-1.017350,-1.010695,
- C -1.004064, -.997456, -.990871, -.984308, -.977767, -.971247,
- D -.964749, -.958271, -.951813, -.945375, -.938957, -.932558,
- E -.926178, -.919816, -.913472, -.907146, -.900838, -.894547,
- F -.888272, -.882014, -.875773, -.869547, -.863337, -.857142,
- G -.850963, -.844798, -.838648, -.832512, -.826390, -.820282,
- H -.814187, -.808106, -.802038, -.795982, -.789940, -.783909,
- I -.777891, -.771884, -.765889, -.759906, -.753934, -.747973,
- J -.742023, -.736084, -.730155, -.724237, -.718328, -.712429,
- K -.706541, -.700661, -.694791, -.688931, -.683079, -.677236,
- L -.671402, -.665576, -.659759, -.653950, -.648149, -.642356,
- M -.636570, -.630793, -.625022, -.619259, -.613503, -.607754,
- N -.602012, -.596276, -.590548, -.584825, -.579109, -.573399,
- O -.567695, -.561997, -.556305, -.550618, -.544937, -.539262,
- P -.533592, -.527926, -.522266, -.516611, -.510961, -.505315,
- Q -.499674, -.494037, -.488405, -.482777/
-
- DATA (F(I),I=201,300)
- A/ -.477153, -.471533, -.465917, -.460305, -.454697, -.449092,
- B -.443491, -.437893, -.432299, -.426707, -.421119, -.415534,
- C -.409951, -.404372, -.398795, -.393221, -.387649, -.382080,
- D -.376513, -.370949, -.365387, -.359826, -.354268, -.348712,
- E -.343157, -.337604, -.332053, -.326503, -.320955, -.315408,
- F -.309863, -.304318, -.298775, -.293233, -.287692, -.282152,
- G -.276613, -.271074, -.265536, -.259999, -.254462, -.248926,
- H -.243389, -.237854, -.232318, -.226783, -.221247, -.215712,
- I -.210176, -.204641, -.199105, -.193568, -.188032, -.182495,
- J -.176957, -.171419, -.165880, -.160341, -.154800, -.149259,
- K -.143717, -.138173, -.132629, -.127083, -.121537, -.115989,
- L -.110439, -.104889, -.099336, -.093782, -.088227, -.082670,
- M -.077111, -.071550, -.065987, -.060423, -.054856, -.049288,
- N -.043717, -.038144, -.032569, -.026991, -.021411, -.015828,
- O -.010243, -.004656, .000934, .006527, .012123, .017722,
- P .023323, .028928, .034535, .040146, .045759, .051376,
- Q .056997, .062620, .068247, .073877/
-
- DATA (F(I),I=301,400)
- A/ .079511, .085149, .090790, .096435, .102083, .107736,
- B .113392, .119052, .124716, .130385, .136057, .141734,
- C .147414, .153100, .158789, .164483, .170181, .175884,
- D .181592, .187304, .193021, .198743, .204469, .210201,
- E .215937, .221678, .227425, .233177, .238933, .244696,
- F .250463, .256236, .262014, .267798, .273587, .279382,
- G .285183, .290989, .296801, .302619, .308443, .314273,
- H .320109, .325951, .331799, .337654, .343515, .349382,
- I .355255, .361135, .367022, .372915, .378815, .384721,
- J .390634, .396554, .402481, .408415, .414356, .420304,
- K .426260, .432222, .438192, .444169, .450153, .456145,
- L .462144, .468151, .474166, .480188, .486218, .492256,
- M .498302, .504356, .510418, .516488, .522566, .528653,
- N .534747, .540850, .546962, .553082, .559210, .565347,
- O .571493, .577648, .583811, .589983, .596164, .602355,
- P .608554, .614762, .620980, .627207, .633444, .639689,
- Q .645945, .652210, .658484, .664768/
-
- DATA (F(I),I=401,500)
- A/ .671062, .677366, .683680, .690004, .696338, .702682,
- B .709036, .715400, .721775, .728160, .734556, .740963,
- C .747379, .753807, .760246, .766695, .773155, .779627,
- D .786109, .792603, .799107, .805624, .812151, .818690,
- E .825241, .831803, .838377, .844962, .851560, .858170,
- F .864791, .871425, .878071, .884729, .891399, .898082,
- G .904778, .911486, .918206, .924940, .931686, .938446,
- H .945218, .952003, .958802, .965614, .972439, .979278,
- I .986130, .992996, .999875, 1.006769, 1.013676, 1.020597,
- J 1.027533, 1.034482, 1.041446, 1.048424, 1.055417, 1.062424,
- K 1.069446, 1.076482, 1.083534, 1.090600, 1.097681, 1.104778,
- L 1.111889, 1.119016, 1.126159, 1.133316, 1.140490, 1.147679,
- M 1.154884, 1.162105, 1.169342, 1.176595, 1.183864, 1.191149,
- N 1.198451, 1.205770, 1.213105, 1.220457, 1.227826, 1.235211,
- O 1.242614, 1.250034, 1.257471, 1.264926, 1.272398, 1.279888,
- P 1.287395, 1.294921, 1.302464, 1.310026, 1.317605, 1.325203,
- Q 1.332819, 1.340454, 1.348108, 1.355780/
-
- DATA (F(I),I=501,600)
- A/ 1.363472, 1.371182, 1.378912, 1.386660, 1.394429, 1.402216,
- B 1.410024, 1.417851, 1.425698, 1.433565, 1.441453, 1.449360,
- C 1.457288, 1.465237, 1.473206, 1.481196, 1.489208, 1.497240,
- D 1.505293, 1.513368, 1.521465, 1.529583, 1.537723, 1.545885,
- E 1.554068, 1.562275, 1.570503, 1.578754, 1.587028, 1.595325,
- F 1.603644, 1.611987, 1.620353, 1.628743, 1.637156, 1.645593,
- G 1.654053, 1.662538, 1.671047, 1.679581, 1.688139, 1.696721,
- H 1.705329, 1.713961, 1.722619, 1.731303, 1.740011, 1.748746,
- I 1.757506, 1.766293, 1.775106, 1.783945, 1.792810, 1.801703,
- J 1.810623, 1.819569, 1.828543, 1.837545, 1.846574, 1.855631,
- K 1.864717, 1.873830, 1.882972, 1.892143, 1.901343, 1.910572,
- L 1.919830, 1.929117, 1.938434, 1.947781, 1.957158, 1.966566,
- M 1.976004, 1.985473, 1.994972, 2.004503, 2.014065, 2.023659,
- N 2.033285, 2.042943, 2.052633, 2.062355, 2.072110, 2.081899,
- O 2.091720, 2.101575, 2.111464, 2.121386, 2.131343, 2.141334,
- P 2.151360, 2.161421, 2.171517, 2.181648, 2.191815, 2.202018,
- Q 2.212257, 2.222533, 2.232845, 2.243195/
-
- DATA (F(I),I=601,700)
- A/ 2.253582, 2.264006, 2.274468, 2.284968, 2.295507, 2.306084,
- B 2.316701, 2.327356, 2.338051, 2.348786, 2.359562, 2.370377,
- C 2.381234, 2.392131, 2.403070, 2.414051, 2.425073, 2.436138,
- D 2.447246, 2.458397, 2.469591, 2.480828, 2.492110, 2.503436,
- E 2.514807, 2.526222, 2.537684, 2.549190, 2.560743, 2.572343,
- F 2.583989, 2.595682, 2.607423, 2.619212, 2.631050, 2.642936,
- G 2.654871, 2.666855, 2.678890, 2.690975, 2.703110, 2.715297,
- H 2.727535, 2.739825, 2.752168, 2.764563, 2.777012, 2.789514,
- I 2.802070, 2.814681, 2.827347, 2.840069, 2.852846, 2.865680,
- J 2.878570, 2.891518, 2.904524, 2.917588, 2.930712, 2.943894,
- K 2.957136, 2.970439, 2.983802, 2.997227, 3.010714, 3.024263,
- L 3.037875, 3.051551, 3.065290, 3.079095, 3.092965, 3.106900,
- M 3.120902, 3.134971, 3.149107, 3.163312, 3.177585, 3.191928,
- N 3.206340, 3.220824, 3.235378, 3.250005, 3.264704, 3.279477,
- O 3.294323, 3.309244, 3.324240, 3.339312, 3.354461, 3.369687,
- P 3.384992, 3.400375, 3.415838, 3.431381, 3.447005, 3.462711,
- Q 3.478500, 3.494372, 3.510328, 3.526370/
-
- DATA (F(I),I=701,800)
- A/ 3.542497, 3.558711, 3.575012, 3.591402, 3.607881, 3.624450,
- B 3.641111, 3.657863, 3.674708, 3.691646, 3.708680, 3.725809,
- C 3.743034, 3.760357, 3.777779, 3.795300, 3.812921, 3.830645,
- D 3.848470, 3.866400, 3.884434, 3.902574, 3.920821, 3.939176,
- E 3.957640, 3.976215, 3.994901, 4.013699, 4.032612, 4.051639,
- F 4.070783, 4.090045, 4.109425, 4.128925, 4.148547, 4.168292,
- G 4.188160, 4.208154, 4.228275, 4.248524, 4.268903, 4.289413,
- H 4.310056, 4.330832, 4.351745, 4.372794, 4.393982, 4.415310,
- I 4.436781, 4.458395, 4.480154, 4.502060, 4.524114, 4.546319,
- J 4.568676, 4.591187, 4.613854, 4.636678, 4.659662, 4.682807,
- K 4.706116, 4.729590, 4.753231, 4.777041, 4.801024, 4.825179,
- L 4.849511, 4.874020, 4.898710, 4.923582, 4.948639, 4.973883,
- M 4.999316, 5.024942, 5.050761, 5.076778, 5.102993, 5.129411,
- N 5.156034, 5.182864, 5.209903, 5.237156, 5.264625, 5.292312,
- O 5.320220, 5.348354, 5.376714, 5.405306, 5.434131, 5.463193,
- P 5.492496, 5.522042, 5.551836, 5.581880, 5.612178, 5.642734,
- Q 5.673552, 5.704634, 5.735986, 5.767610/
-
- DATA (F(I),I=801,900)
- A/ 5.799512, 5.831694, 5.864161, 5.896918, 5.929968, 5.963316,
- B 5.996967, 6.030925, 6.065194, 6.099780, 6.134687, 6.169921,
- C 6.205486, 6.241387, 6.277630, 6.314220, 6.351163, 6.388465,
- D 6.426130, 6.464166, 6.502578, 6.541371, 6.580553, 6.620130,
- E 6.660109, 6.700495, 6.741297, 6.782520, 6.824173, 6.866262,
- F 6.908795, 6.951780, 6.995225, 7.039137, 7.083525, 7.128398,
- G 7.173764, 7.219632, 7.266011, 7.312910, 7.360339, 7.408308,
- H 7.456827, 7.505905, 7.555554, 7.605785, 7.656608, 7.708035,
- I 7.760077, 7.812747, 7.866057, 7.920019, 7.974647, 8.029953,
- J 8.085952, 8.142657, 8.200083, 8.258245, 8.317158, 8.376837,
- K 8.437300, 8.498562, 8.560641, 8.623554, 8.687319, 8.751955,
- L 8.817481, 8.883916, 8.951282, 9.019600, 9.088889, 9.159174,
- M 9.230477, 9.302822, 9.376233, 9.450735, 9.526355, 9.603118,
- N 9.681054, 9.760191, 9.840558, 9.922186,10.005107,10.089353,
- O 10.174959,10.261958,10.350389,10.440287,10.531693,10.624646,
- P 10.719188,10.815362,10.913214,11.012789,11.114137,11.217307,
- Q 11.322352,11.429325,11.538283,11.649285/
-
- DATA (F(I),I=901,982)
- A/11.762390,11.877664,11.995170,12.114979,12.237161,12.361791,
- B 12.488946,12.618708,12.751161,12.886394,13.024498,13.165570,
- C 13.309711,13.457026,13.607625,13.761625,13.919145,14.080314,
- D 14.245263,14.414134,14.587072,14.764233,14.945778,15.131877,
- E 15.322712,15.518470,15.719353,15.925570,16.137345,16.354912,
- F 16.578520,16.808433,17.044929,17.288305,17.538873,17.796967,
- G 18.062943,18.337176,18.620068,18.912049,19.213574,19.525133,
- H 19.847249,20.180480,20.525429,20.882738,21.253102,21.637266,
- I 22.036036,22.450278,22.880933,23.329017,23.795634,24.281981,
- J 24.789364,25.319207,25.873062,26.452634,27.059789,27.696581,
- K 28.365274,29.068370,29.808638,30.589157,31.413354,32.285060,
- L 33.208568,34.188705,35.230920,36.341388,37.527131,38.796172,
- M 40.157721,41.622399,43.202525,44.912465,46.769077,48.792279,
- N 51.005773,53.437996,56.123356,59.103894/
-
- U=1000*X
- I=U
- U=U-I
- IF(I .GE. 70 .AND. I .LE. 800) THEN
- RANLAN=F(I)+U*(F(I+1)-F(I))
- ELSEIF(I .GE. 7 .AND. I .LE. 980) THEN
- RANLAN=
- 1 F(I)+U*(F(I+1)-F(I)-0.25*(1-U)*(F(I+2)-F(I+1)-F(I)+F(I-1)))
- ELSEIF(I. LT. 7) THEN
- V=LOG(X)
- U=1/V
- RANLAN=((0.99858950+(3.45213058E1+1.70854528E1*U)*U)/
- 1 (1 +(3.41760202E1+4.01244582 *U)*U))*
- 2 (-LOG(-0.91893853-V)-1)
- ELSE
- U=1-X
- V=U**2
- IF(X .LE. 0.999) THEN
- RANLAN=(1.00060006+2.63991156E2*U+4.37320068E3*V)/
- 1 ((1 +2.57368075E2*U+3.41448018E3*V)*U)
- ELSE
- RANLAN=(1.00001538+6.07514119E3*U+7.34266409E5*V)/
- 1 ((1 +6.06511919E3*U+6.94021044E5*V)*U)
- ENDIF
- ENDIF
- RETURN
- END
diff --git a/src/mathlib/gen/g/studin.F b/src/mathlib/gen/g/studin.F
deleted file mode 100644
index d104ae7..0000000
--- a/src/mathlib/gen/g/studin.F
+++ /dev/null
@@ -1,61 +0,0 @@
-*
-* $Id: studin.F,v 1.1.1.1 1996/04/01 15:02:42 mclareni Exp $
-*
-* $Log: studin.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:42 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- FUNCTION STUDIN(Q,N)
-C THIS ROUTINE COMPUTES THE INVERSE OF THE DISTRIBUTION
-C FUNCTION OF THE STUDENT DISTRIBUTION WITH N DEGREES OF FREEDOM.
-C Q=PROBABILITY AT WHICH THE FUNCTION IS INVERTED,
-C N=INTEGER GREATER THAN ZERO.
-C THE ROUTINE WAS WRITTEN BY G.W.HILL IN ALGOL
-C C.A.C.M. ALGORITHM 396
-C AT LEAST 6 SIGNIFICANT FIGURES ARE CORRECT.
- DATA HP/1.5707963268/
- IF(N. LT. 1) GO TO 10
- RL=1.
- IF(Q .GE. 0.5) GO TO 1
- RL=-1.
- P=2.*Q
- GO TO 2
- 1 P=2.*(1.-Q)
- 2 IF(P .LE. 0. .OR. P .GT. 1.) GO TO 20
- IF(N .GT. 1) GO TO 3
- PP=COS(HP*P)
- STUDIN=PP/SQRT(1.-PP*PP)*RL
- RETURN
- 3 IF(N .GT. 2) GO TO 4
- STUDIN=SQRT(2./(P*(2.-P))-2.)*RL
- RETURN
- 4 RN=N
- A=1./(RN-0.5)
- B=48./(A*A)
- C=((20700.*A/B-98.)*A-16.)*A+96.36
- D=((94.5/(B+C)-3.)/B+1.)*SQRT(A*HP)*RN
- X=D*P
- Y=X**(2./RN)
- IF(Y .LE. 0.05+A) GO TO 5
- PP=0.5*P
- X=GAUSIN(PP)
- Y=X*X
- IF(N .GE. 5) C=C+0.3*(RN-4.5)*(X+0.6)
- C=(((0.05*D*X-5.)*X-7.)*X-2.)*X+B+C
- Y=(((((0.4*Y+6.3)*Y+36.)*Y+94.5)/C-Y-3.)/B+1.)*X
- Y=A*Y*Y
- IF(Y .LE. 0.002) Y=0.5*Y*Y+Y
- IF(Y .GT. 0.002) Y=EXP(Y)-1.
- GO TO 6
- 5 Y=((1./(((RN+6.)/(RN*Y)-0.089*D-0.822)*(RN+2.)*3.)+0.5/(RN+4.))*Y-
- 11.)*(RN+1.)/(RN+2.)+1./Y
- 6 STUDIN=SQRT(RN*Y)*RL
- RETURN
- 10 WRITE(6,7) N
- 20 WRITE(6,8) Q
- STOP
- 7 FORMAT(/10X,'DEGREE OF FREEDOM N=',I5,' IN STUDIN ILLEGAL'/)
- 8 FORMAT(/10X,'ARGUMENT Q=',E15.5,' IN STUDIN ILLEGAL'/)
- END
diff --git a/src/mathlib/gen/g/studis.F b/src/mathlib/gen/g/studis.F
deleted file mode 100644
index d278faa..0000000
--- a/src/mathlib/gen/g/studis.F
+++ /dev/null
@@ -1,46 +0,0 @@
-*
-* $Id: studis.F,v 1.1.1.1 1996/04/01 15:02:42 mclareni Exp $
-*
-* $Log: studis.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:42 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- FUNCTION STUDIS(T,N)
-C THIS ROUTINE COMPUTES THE DISTRIBUTION FUNCTION OF THE
-C STUDENT DISTRIBUTION WITH N DEGREES OF FREEDOM.
-C T=VALUE OF THE INDEPENDENT VARIABLE,
-C N=INTEGER GREATER THAN ZERO.
-C THE ROUTINE WAS WRITTEN BY B.E. COOPER,APPLIED STATISTICS,
-C 17(1968)189-190
-C ALGORITHM AS3. THE METHOD WHICH IS THEORETICALLY EXACT WAS GIVEN BY
-C D.B. OWEN,BIOMETRIKA,52(1965),437-446.
-C AT LEAST 9 DECIMAL PLACES ARE CORRECT.
- DATA G1/0.31830988618379/
- IF(N-1) 1,2,3
- 2 STUDIS=0.5+G1*ATAN(T)
- RETURN
- 3 FN=N
- A=T/SQRT(FN)
- B=FN/(FN+T*T)
- S=1.
- N2=N-2
- N3=MOD(N,2)
- IF(N2 .LT. 2) GO TO 4
- C=1.
- K=2+N3
- FK=K
- DO 5 I=K,N2,2
- C=C*B*(FK-1.)/FK
- S=S+C
- 5 FK=FK+2.
- 4 IF(N3 .NE. 0) GO TO 6
- STUDIS=0.5+0.5*A*SQRT(B)*S
- RETURN
- 6 STUDIS=0.5+(A*B*S+ATAN(A))*G1
- RETURN
- 1 WRITE(6,7) N
- STOP
- 7 FORMAT(/10X,'DEGREE OF FREEDOM N=',I5,' IN STUDIS ILLEGAL'/)
- END
diff --git a/src/mathlib/gen/g/tkolmo.F b/src/mathlib/gen/g/tkolmo.F
deleted file mode 100644
index e904466..0000000
--- a/src/mathlib/gen/g/tkolmo.F
+++ /dev/null
@@ -1,66 +0,0 @@
-*
-* $Id: tkolmo.F,v 1.1.1.1 1996/04/01 15:02:42 mclareni Exp $
-*
-* $Log: tkolmo.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:42 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE TKOLMO(A,NA,B,NB,PROB)
-*==========>
-* Tests whether two one-dimensional sets of points
-* are compatible with coming from the same parent
-* distribution, using the Kolmogorov test
-* A is the vector of NA points in set one.
-* B is the vector of NB points in set two.
-* PROB is the probability of compatibility returned to
-* the calling program.
-*
-* F. James, April, 1987
-*==========>
-*
- DIMENSION A(NA),B(NB)
-* In case of an error, PROB is returned as -1.
- PROB = -1.0
-* Require at least two points in each set
- IF (NA.LE.2 .OR. NB.LE.2) GO TO 99
-* Constants needed
- RNA = REAL(NA)
- RNB = REAL(NB)
- SA = 1.0/RNA
- SB = 1.0/RNB
-* Starting values for main loop
- IF (A(1) .LT. B(1)) THEN
- RDIFF = -SA
- IA = 2
- IB = 1
- ELSE
- RDIFF = SB
- IB = 2
- IA = 1
- ENDIF
- RDMAX = ABS(RDIFF)
-*
-* Main loop over point sets to find max distance
-* RDIFF is the running difference, and RDMAX the max.
- DO 10 I= 1, NA+NB
- IF (A(IA) .LT. B(IB)) THEN
- RDIFF = RDIFF - SA
- IA = IA + 1
- IF (IA .GT. NA) GO TO 20
- ELSE
- RDIFF = RDIFF + SB
- IB = IB + 1
- IF (IB .GT. NB) GO TO 20
- ENDIF
- RDMAX = MAX(RDMAX,ABS(RDIFF))
- 10 CONTINUE
-* Should never terminate this loop!
- GO TO 99
- 20 RDMAX = MAX(RDMAX,ABS(RDIFF))
- Z = RDMAX * SQRT(RNA*RNB/(RNA+RNB))
- PROB = PROBKL(Z)
-*
- 99 CONTINUE
- END
diff --git a/src/mathlib/gen/g/vavden.F b/src/mathlib/gen/g/vavden.F
deleted file mode 100644
index 73e22d5..0000000
--- a/src/mathlib/gen/g/vavden.F
+++ /dev/null
@@ -1,72 +0,0 @@
-*
-* $Id: vavden.F,v 1.1.1.1 1996/04/01 15:02:48 mclareni Exp $
-*
-* $Log: vavden.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:48 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- FUNCTION VAVDEN(RLAM)
-
- COMMON /GXXXC1/ WCM(0:200),AC(0:13),HC(0:8),ITYPE,NPT
-
- DIMENSION H(9)
-
- V=0
- IF(RLAM .LT. AC(0) .OR. RLAM .GT. AC(8)) GO TO 9
-
- IF(ITYPE .EQ. 1) THEN
- FN=1
- X=(RLAM+HC(0))*HC(1)
- H(1)=X
- H(2)=X**2-1
- DO 1 K = 2,8
- FN=FN+1
- 1 H(K+1)=X*H(K)-FN*H(K-1)
- S=1+HC(7)*H(9)
- DO 2 K = 2,6
- 2 S=S+HC(K)*H(K+1)
- V=HC(8)*EXP(-0.5*X**2)*MAX(S,0.)
- ELSEIF(ITYPE .EQ. 2) THEN
- X=RLAM**2
- V=AC(1)*EXP(-AC(2)*(RLAM+AC(5)*X)-
- 1 AC(3)*EXP(-AC(4)*(RLAM+AC(6)*X)))
- ELSEIF(ITYPE .EQ. 3) THEN
- IF(RLAM .LT. AC(7)) THEN
- X=RLAM**2
- V=AC(1)*EXP(-AC(2)*(RLAM+AC(5)*X)-
- 1 AC(3)*EXP(-AC(4)*(RLAM+AC(6)*X)))
- ELSE
- X=1/RLAM
- V=(AC(11)*X+AC(12))*X
- ENDIF
- ELSEIF(ITYPE .EQ. 4) THEN
- V=AC(13)*DENLAN(RLAM)
- ENDIF
- 9 VAVDEN=V
- RETURN
-
- ENTRY VAVDIS(RLAM)
-
- IF(RLAM .LE. AC(0)) THEN
- V=0
- ELSEIF(RLAM .GE. AC(8)) THEN
- V=1
- ELSE
- X=RLAM-AC(0)
- K=X*AC(10)
- V=MIN(WCM(K)+(X-K*AC(9))*(WCM(K+1)-WCM(K))*AC(10),1.)
- ENDIF
- VAVDIS=V
- RETURN
-
- ENTRY VAVRND(RAN)
-
- K=MAX(MIN(ABS(LOCATF(WCM(0),NPT+1,RAN)),NPT)-1,0)
- X=WCM(K+1)-WCM(K)
- V=AC(0)+K*AC(9)
- IF(X .GT. 0) V=V+(RAN-WCM(K))*AC(9)/X
- VAVRND=V
- RETURN
- END
diff --git a/src/mathlib/gen/g/vavfcn.F b/src/mathlib/gen/g/vavfcn.F
deleted file mode 100644
index ddc2ac5..0000000
--- a/src/mathlib/gen/g/vavfcn.F
+++ /dev/null
@@ -1,40 +0,0 @@
-*
-* $Id: vavfcn.F,v 1.1.1.1 1996/04/01 15:02:47 mclareni Exp $
-*
-* $Log: vavfcn.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:47 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- FUNCTION VAVFCN(X,RKA,BE2)
-C
- COMMON /VAVILI/ T0,T1,T,OMEGA
- COMMON /FORFCN/ SS,LFCN
- DATA E,PI,RG /5E-4, 3.1415926535898, 0.5772156649015/
-C
- GO TO (1,2,3), LFCN
-C
-C FOR LFCN=1 FCN IS USED TO DETERMINE THE NUMBER N OF FOURIER
-C COEFFICIENTS IN DISVAV(X,I)
-C
- 1 RN=5.
- IF(RKA .GE. 0.07) RN=8.
- VAVFCN=RKA*(2.+BE2*RG)-1.596312592
- 1 +BE2*RKA*LOG(OMEGA*X/RKA)-0.5*OMEGA*PI*X+2.302585093*RN
- RETURN
-C
-C FOR LFCN=2 FCN IS USED TO DETERMINE THE SS-QUANTILE OF THE
-C VAVILOV DISTRIBUTION
-C
- 2 VAVFCN=DISVAV(X,1)-SS
- RETURN
-C
-C FOR LFCN=3 FCN IS USED TO DETERMINE THE RIGHT-HAND ENDPOINT T+
-C OF THE SUPPORT OF DISVAV(X,0)
-C
- 3 VAVFCN=1.-BE2*(1.-RG)-LOG(E)/RKA-X+BE2*(LOG(ABS(X))+EXPINT(X))
- 1 -(1.-BE2)*EXP(-X)
- RETURN
-C
- END
diff --git a/src/mathlib/gen/g/vavran.F b/src/mathlib/gen/g/vavran.F
deleted file mode 100644
index c5f04f6..0000000
--- a/src/mathlib/gen/g/vavran.F
+++ /dev/null
@@ -1,355 +0,0 @@
-*
-* $Id: vavran.F,v 1.1.1.1 1996/04/01 15:02:48 mclareni Exp $
-*
-* $Log: vavran.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:48 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- FUNCTION VAVRAN(RKAPPA,BETA2,RAN)
-
- DIMENSION AC(0:13),HC(0:8),H(9)
-
- PARAMETER
- 1(BKMNX1 = 0.02, BKMNY1 = 0.05, BKMNX2 = 0.12, BKMNY2 = 0.05,
- 2 BKMNX3 = 0.22, BKMNY3 = 0.05, BKMXX1 = 0.1 , BKMXY1 = 1 ,
- 3 BKMXX2 = 0.2 , BKMXY2 = 1 , BKMXX3 = 0.3 , BKMXY3 = 1 )
- PARAMETER
- 1(FBKX1 = 2/(BKMXX1-BKMNX1), FBKX2 = 2/(BKMXX2-BKMNX2),
- 2 FBKX3 = 2/(BKMXX3-BKMNX3), FBKY1 = 2/(BKMXY1-BKMNY1),
- 3 FBKY2 = 2/(BKMXY2-BKMNY2), FBKY3 = 2/(BKMXY3-BKMNY3))
-
- DIMENSION EDGEC(2:7),FNINV(5),DRK(5),DSIGM(5),ALFA(2:5)
- DIMENSION U1(13),U2(13),U3(13),U4(12),U5(13),U6(13),U7( 8),U8(13)
- DIMENSION V1(12),V2(12),V3(13),V4(12),V5(13),V6(13),V7(11),V8(11)
- DIMENSION W1(13),W2(11),W3(13),W4(13),W5(13),W6(13), W8( 8)
-
- DATA FNINV /1, 0.5, 0.33333333, 0.25, 0.2/
-
- DATA (EDGEC(J),J=2,7)
- 1/ 0.16666667E+0, 0.41666667E-1, 0.83333333E-2,
- 2 0.13888889E-1, 0.69444444E-2, 0.77160493E-3/
-
- DATA (U1(K),K=1,13)
- 1/ 0.25850868E+0, 0.32477982E-1, -0.59020496E-2,
- 2 0. , 0.24880692E-1, 0.47404356E-2,
- 3 -0.74445130E-3, 0.73225731E-2, 0. ,
- 4 0.11668284E-2, 0. , -0.15727318E-2,-0.11210142E-2/
-
- DATA (U2(K),K=1,13)
- 1/ 0.43142611E+0, 0.40797543E-1, -0.91490215E-2,
- 2 0. , 0.42127077E-1, 0.73167928E-2,
- 3 -0.14026047E-2, 0.16195241E-1, 0.24714789E-2,
- 4 0.20751278E-2, 0. , -0.25141668E-2,-0.14064022E-2/
-
- DATA (U3(K),K=1,13)
- 1/ 0.25225955E+0, 0.64820468E-1, -0.23615759E-1,
- 2 0. , 0.23834176E-1, 0.21624675E-2,
- 3 -0.26865597E-2, -0.54891384E-2, 0.39800522E-2,
- 4 0.48447456E-2, -0.89439554E-2, -0.62756944E-2,-0.24655436E-2/
-
- DATA (U4(K),K=1,12)
- 1/ 0.12593231E+1, -0.20374501E+0, 0.95055662E-1,
- 2 -0.20771531E-1, -0.46865180E-1, -0.77222986E-2,
- 3 0.32241039E-2, 0.89882920E-2, -0.67167236E-2,
- 4 -0.13049241E-1, 0.18786468E-1, 0.14484097E-1/
-
- DATA (U5(K),K=1,13)
- 1/-0.24864376E-1, -0.10368495E-2, 0.14330117E-2,
- 2 0.20052730E-3, 0.18751903E-2, 0.12668869E-2,
- 3 0.48736023E-3, 0.34850854E-2, 0. ,
- 4 -0.36597173E-3, 0.19372124E-2, 0.70761825E-3, 0.46898375E-3/
-
- DATA (U6(K),K=1,13)
- 1/ 0.35855696E-1, -0.27542114E-1, 0.12631023E-1,
- 2 -0.30188807E-2, -0.84479939E-3, 0. ,
- 3 0.45675843E-3, -0.69836141E-2, 0.39876546E-2,
- 4 -0.36055679E-2, 0. , 0.15298434E-2, 0.19247256E-2/
-
- DATA (U7(K),K=1,8)
- 1/ 0.10234691E+2, -0.35619655E+1, 0.69387764E+0,
- 2 -0.14047599E+0, -0.19952390E+1, -0.45679694E+0,
- 3 0. , 0.50505298E+0/
-
- DATA (U8(K),K=1,13)
- 1/ 0.21487518E+2, -0.11825253E+2, 0.43133087E+1,
- 2 -0.14500543E+1, -0.34343169E+1, -0.11063164E+1,
- 3 -0.21000819E+0, 0.17891643E+1, -0.89601916E+0,
- 4 0.39120793E+0, 0.73410606E+0, 0. ,-0.32454506E+0/
-
- DATA (V1(K),K=1,12)
- 1/ 0.27827257E+0, -0.14227603E-2, 0.24848327E-2,
- 2 0. , 0.45091424E-1, 0.80559636E-2,
- 3 -0.38974523E-2, 0. , -0.30634124E-2,
- 4 0.75633702E-3, 0.54730726E-2, 0.19792507E-2/
-
- DATA (V2(K),K=1,12)
- 1/ 0.41421789E+0, -0.30061649E-1, 0.52249697E-2,
- 2 0. , 0.12693873E+0, 0.22999801E-1,
- 3 -0.86792801E-2, 0.31875584E-1, -0.61757928E-2,
- 4 0. , 0.19716857E-1, 0.32596742E-2/
-
- DATA (V3(K),K=1,13)
- 1/ 0.20191056E+0, -0.46831422E-1, 0.96777473E-2,
- 2 -0.17995317E-2, 0.53921588E-1, 0.35068740E-2,
- 3 -0.12621494E-1, -0.54996531E-2, -0.90029985E-2,
- 4 0.34958743E-2, 0.18513506E-1, 0.68332334E-2,-0.12940502E-2/
-
- DATA (V4(K),K=1,12)
- 1/ 0.13206081E+1, 0.10036618E+0, -0.22015201E-1,
- 2 0.61667091E-2, -0.14986093E+0, -0.12720568E-1,
- 3 0.24972042E-1, -0.97751962E-2, 0.26087455E-1,
- 4 -0.11399062E-1, -0.48282515E-1, -0.98552378E-2/
-
- DATA (V5(K),K=1,13)
- 1/ 0.16435243E-1, 0.36051400E-1, 0.23036520E-2,
- 2 -0.61666343E-3, -0.10775802E-1, 0.51476061E-2,
- 3 0.56856517E-2, -0.13438433E-1, 0. ,
- 4 0. , -0.25421507E-2, 0.20169108E-2,-0.15144931E-2/
-
- DATA (V6(K),K=1,13)
- 1/ 0.33432405E-1, 0.60583916E-2, -0.23381379E-2,
- 2 0.83846081E-3, -0.13346861E-1, -0.17402116E-2,
- 3 0.21052496E-2, 0.15528195E-2, 0.21900670E-2,
- 4 -0.13202847E-2, -0.45124157E-2, -0.15629454E-2, 0.22499176E-3/
-
- DATA (V7(K),K=1,11)
- 1/ 0.54529572E+1, -0.90906096E+0, 0.86122438E-1,
- 2 0. , -0.12218009E+1, -0.32324120E+0,
- 3 -0.27373591E-1, 0.12173464E+0, 0. ,
- 4 0. , 0.40917471E-1/
-
- DATA (V8(K),K=1,11)
- 1/ 0.93841352E+1, -0.16276904E+1, 0.16571423E+0,
- 2 0. , -0.18160479E+1, -0.50919193E+0,
- 3 -0.51384654E-1, 0.21413992E+0, 0. ,
- 4 0. , 0.66596366E-1/
-
- DATA (W1(K),K=1,13)
- 1/ 0.29712951E+0, 0.97572934E-2, 0. ,
- 2 -0.15291686E-2, 0.35707399E-1, 0.96221631E-2,
- 3 -0.18402821E-2, -0.49821585E-2, 0.18831112E-2,
- 4 0.43541673E-2, 0.20301312E-2, -0.18723311E-2,-0.73403108E-3/
-
- DATA (W2(K),K=1,11)
- 1/ 0.40882635E+0, 0.14474912E-1, 0.25023704E-2,
- 2 -0.37707379E-2, 0.18719727E+0, 0.56954987E-1,
- 3 0. , 0.23020158E-1, 0.50574313E-2,
- 4 0.94550140E-2, 0.19300232E-1/
-
- DATA (W3(K),K=1,13)
- 1/ 0.16861629E+0, 0. , 0.36317285E-2,
- 2 -0.43657818E-2, 0.30144338E-1, 0.13891826E-1,
- 3 -0.58030495E-2, -0.38717547E-2, 0.85359607E-2,
- 4 0.14507659E-1, 0.82387775E-2, -0.10116105E-1,-0.55135670E-2/
-
- DATA (W4(K),K=1,13)
- 1/ 0.13493891E+1, -0.26863185E-2, -0.35216040E-2,
- 2 0.24434909E-1, -0.83447911E-1, -0.48061360E-1,
- 3 0.76473951E-2, 0.24494430E-1, -0.16209200E-1,
- 4 -0.37768479E-1, -0.47890063E-1, 0.17778596E-1, 0.13179324E-1/
-
- DATA (W5(K),K=1,13)
- 1/ 0.10264945E+0, 0.32738857E-1, 0. ,
- 2 0.43608779E-2, -0.43097757E-1, -0.22647176E-2,
- 3 0.94531290E-2, -0.12442571E-1, -0.32283517E-2,
- 4 -0.75640352E-2, -0.88293329E-2, 0.52537299E-2, 0.13340546E-2/
-
- DATA (W6(K),K=1,13)
- 1/ 0.29568177E-1, -0.16300060E-2, -0.21119745E-3,
- 2 0.23599053E-2, -0.48515387E-2, -0.40797531E-2,
- 3 0.40403265E-3, 0.18200105E-2, -0.14346306E-2,
- 4 -0.39165276E-2, -0.37432073E-2, 0.19950380E-2, 0.12222675E-2/
-
- DATA (W8(K),K=1,8)
- 1/ 0.66184645E+1, -0.73866379E+0, 0.44693973E-1,
- 2 0. , -0.14540925E+1, -0.39529833E+0,
- 3 -0.44293243E-1, 0.88741049E-1/
-
- V=0
- IF(RKAPPA .LT. 0.01 .OR. RKAPPA .GT. 12) GO TO 9
- IF(RKAPPA .GE. 0.29) THEN
- ITYPE=1
- NPT=100
- WK=1/SQRT(RKAPPA)
- AC(0)=(-0.032227*BETA2-0.074275)*RKAPPA+
- 1 (0.24533*BETA2+0.070152)*WK+(-0.55610*BETA2-3.1579)
- AC(8)=(-0.013483*BETA2-0.048801)*RKAPPA+
- 1 (-1.6921*BETA2+8.3656)*WK+(-0.73275*BETA2-3.5226)
- DRK(1)=WK**2
- DSIGM(1)=SQRT(RKAPPA/(1-0.5*BETA2))
- DO 1 J = 1,4
- DRK(J+1)=DRK(1)*DRK(J)
- DSIGM(J+1)=DSIGM(1)*DSIGM(J)
- 1 ALFA(J+1)=(FNINV(J)-BETA2*FNINV(J+1))*DRK(J)
-
- HC(0)=LOG(RKAPPA)+BETA2+0.42278434
- HC(1)=DSIGM(1)
- HC(2)=ALFA(3)*DSIGM(3)
- HC(3)=(3*ALFA(2)**2+ALFA(4))*DSIGM(4)-3
- HC(4)=(10*ALFA(2)*ALFA(3)+ALFA(5))*DSIGM(5)-10*HC(2)
- HC(5)=HC(2)**2
- HC(6)=HC(2)*HC(3)
- HC(7)=HC(2)*HC(5)
- DO 2 J = 2,7
- 2 HC(J)=EDGEC(J)*HC(J)
- HC(8)=0.39894228*HC(1)
- ELSEIF(RKAPPA .GE. 0.22) THEN
- ITYPE=2
- NPT=150
- X=1+(RKAPPA-BKMXX3)*FBKX3
- Y=1+(SQRT(BETA2)-BKMXY3)*FBKY3
- XX=2*X
- YY=2*Y
- X2=XX*X-1
- X3=XX*X2-X
- Y2=YY*Y-1
- Y3=YY*Y2-Y
- XY=X*Y
- P2=X2*Y
- P3=X3*Y
- Q2=Y2*X
- Q3=Y3*X
- PQ=X2*Y2
- AC(1)=W1(1)+W1(2)*X+W1(4)*X3+W1(5)*Y+W1(6)*Y2+W1(7)*Y3+
- 1 W1(8)*XY+W1(9)*P2+W1(10)*P3+W1(11)*Q2+W1(12)*Q3+W1(13)*PQ
- AC(2)=W2(1)+W2(2)*X+W2(3)*X2+W2(4)*X3+W2(5)*Y+W2(6)*Y2+
- 1 W2(8)*XY+W2(9)*P2+W2(10)*P3+W2(11)*Q2
- AC(3)=W3(1)+W3(3)*X2+W3(4)*X3+W3(5)*Y+W3(6)*Y2+W3(7)*Y3+
- 1 W3(8)*XY+W3(9)*P2+W3(10)*P3+W3(11)*Q2+W3(12)*Q3+W3(13)*PQ
- AC(4)=W4(1)+W4(2)*X+W4(3)*X2+W4(4)*X3+W4(5)*Y+W4(6)*Y2+W4(7)*Y3+
- 1 W4(8)*XY+W4(9)*P2+W4(10)*P3+W4(11)*Q2+W4(12)*Q3+W4(13)*PQ
- AC(5)=W5(1)+W5(2)*X+W5(4)*X3+W5(5)*Y+W5(6)*Y2+W5(7)*Y3+
- 1 W5(8)*XY+W5(9)*P2+W5(10)*P3+W5(11)*Q2+W5(12)*Q3+W5(13)*PQ
- AC(6)=W6(1)+W6(2)*X+W6(3)*X2+W6(4)*X3+W6(5)*Y+W6(6)*Y2+W6(7)*Y3+
- 1 W6(8)*XY+W6(9)*P2+W6(10)*P3+W6(11)*Q2+W6(12)*Q3+W6(13)*PQ
- AC(8)=W8(1)+W8(2)*X+W8(3)*X2+W8(5)*Y+W8(6)*Y2+W8(7)*Y3+W8(8)*XY
- AC(0)=-3.05
- ELSEIF(RKAPPA .GE. 0.12) THEN
- ITYPE=3
- NPT=200
- X=1+(RKAPPA-BKMXX2)*FBKX2
- Y=1+(SQRT(BETA2)-BKMXY2)*FBKY2
- XX=2*X
- YY=2*Y
- X2=XX*X-1
- X3=XX*X2-X
- Y2=YY*Y-1
- Y3=YY*Y2-Y
- XY=X*Y
- P2=X2*Y
- P3=X3*Y
- Q2=Y2*X
- Q3=Y3*X
- PQ=X2*Y2
- AC(1)=V1(1)+V1(2)*X+V1(3)*X2+V1(5)*Y+V1(6)*Y2+V1(7)*Y3+
- 1 V1(9)*P2+V1(10)*P3+V1(11)*Q2+V1(12)*Q3
- AC(2)=V2(1)+V2(2)*X+V2(3)*X2+V2(5)*Y+V2(6)*Y2+V2(7)*Y3+
- 1 V2(8)*XY+V2(9)*P2+V2(11)*Q2+V2(12)*Q3
- AC(3)=V3(1)+V3(2)*X+V3(3)*X2+V3(4)*X3+V3(5)*Y+V3(6)*Y2+V3(7)*Y3+
- 1 V3(8)*XY+V3(9)*P2+V3(10)*P3+V3(11)*Q2+V3(12)*Q3+V3(13)*PQ
- AC(4)=V4(1)+V4(2)*X+V4(3)*X2+V4(4)*X3+V4(5)*Y+V4(6)*Y2+V4(7)*Y3+
- 1 V4(8)*XY+V4(9)*P2+V4(10)*P3+V4(11)*Q2+V4(12)*Q3
- AC(5)=V5(1)+V5(2)*X+V5(3)*X2+V5(4)*X3+V5(5)*Y+V5(6)*Y2+V5(7)*Y3+
- 1 V5(8)*XY+V5(11)*Q2+V5(12)*Q3+V5(13)*PQ
- AC(6)=V6(1)+V6(2)*X+V6(3)*X2+V6(4)*X3+V6(5)*Y+V6(6)*Y2+V6(7)*Y3+
- 1 V6(8)*XY+V6(9)*P2+V6(10)*P3+V6(11)*Q2+V6(12)*Q3+V6(13)*PQ
- AC(7)=V7(1)+V7(2)*X+V7(3)*X2+V7(5)*Y+V7(6)*Y2+V7(7)*Y3+
- 1 V7(8)*XY+V7(11)*Q2
- AC(8)=V8(1)+V8(2)*X+V8(3)*X2+V8(5)*Y+V8(6)*Y2+V8(7)*Y3+
- 1 V8(8)*XY+V8(11)*Q2
- AC(0)=-3.04
- ELSE
- ITYPE=4
- IF(RKAPPA .GE. 0.02) ITYPE=3
- NPT=200
- X=1+(RKAPPA-BKMXX1)*FBKX1
- Y=1+(SQRT(BETA2)-BKMXY1)*FBKY1
- XX=2*X
- YY=2*Y
- X2=XX*X-1
- X3=XX*X2-X
- Y2=YY*Y-1
- Y3=YY*Y2-Y
- XY=X*Y
- P2=X2*Y
- P3=X3*Y
- Q2=Y2*X
- Q3=Y3*X
- PQ=X2*Y2
- IF(ITYPE .EQ. 3) THEN
- AC(1)=U1(1)+U1(2)*X+U1(3)*X2+U1(5)*Y+U1(6)*Y2+U1(7)*Y3+
- 1 U1(8)*XY+U1(10)*P3+U1(12)*Q3+U1(13)*PQ
- AC(2)=U2(1)+U2(2)*X+U2(3)*X2+U2(5)*Y+U2(6)*Y2+U2(7)*Y3+
- 1 U2(8)*XY+U2(9)*P2+U2(10)*P3+U2(12)*Q3+U2(13)*PQ
- AC(3)=U3(1)+U3(2)*X+U3(3)*X2+U3(5)*Y+U3(6)*Y2+U3(7)*Y3+
- 1 U3(8)*XY+U3(9)*P2+U3(10)*P3+U3(11)*Q2+U3(12)*Q3+U3(13)*PQ
- AC(4)=U4(1)+U4(2)*X+U4(3)*X2+U4(4)*X3+U4(5)*Y+U4(6)*Y2+U4(7)*Y3+
- 1 U4(8)*XY+U4(9)*P2+U4(10)*P3+U4(11)*Q2+U4(12)*Q3
- AC(5)=U5(1)+U5(2)*X+U5(3)*X2+U5(4)*X3+U5(5)*Y+U5(6)*Y2+U5(7)*Y3+
- 1 U5(8)*XY+U5(10)*P3+U5(11)*Q2+U5(12)*Q3+U5(13)*PQ
- AC(6)=U6(1)+U6(2)*X+U6(3)*X2+U6(4)*X3+U6(5)*Y+U6(7)*Y3+
- 1 U6(8)*XY+U6(9)*P2+U6(10)*P3+U6(12)*Q3+U6(13)*PQ
- AC(7)=U7(1)+U7(2)*X+U7(3)*X2+U7(4)*X3+U7(5)*Y+U7(6)*Y2+U7(8)*XY
- ENDIF
- AC(8)=U8(1)+U8(2)*X+U8(3)*X2+U8(4)*X3+U8(5)*Y+U8(6)*Y2+U8(7)*Y3+
- 1 U8(8)*XY+U8(9)*P2+U8(10)*P3+U8(11)*Q2+U8(13)*PQ
- AC(0)=-3.03
- ENDIF
- AC(9)=(AC(8)-AC(0))/NPT
- IF(ITYPE .EQ. 3) THEN
- X=(AC(7)-AC(8))/(AC(7)*AC(8))
- Y=1/LOG(AC(8)/AC(7))
- P2=AC(7)**2
- AC(11)=P2*(AC(1)*EXP(-AC(2)*(AC(7)+AC(5)*P2)-
- 1 AC(3)*EXP(-AC(4)*(AC(7)+AC(6)*P2)))-0.045*Y/AC(7))/
- 2 (1+X*Y*AC(7))
- AC(12)=(0.045+X*AC(11))*Y
- ENDIF
- IF(ITYPE .EQ. 4) AC(10)=0.995/DISLAN(AC(8))
-
- T=2*RAN/AC(9)
- RLAM=AC(0)
- FL=0
- S=0
- DO 21 N = 1,NPT
- RLAM=RLAM+AC(9)
- IF(ITYPE .EQ. 1) THEN
- FN=1
- X=(RLAM+HC(0))*HC(1)
- H(1)=X
- H(2)=X**2-1
- DO 31 K = 2,8
- FN=FN+1
- 31 H(K+1)=X*H(K)-FN*H(K-1)
- Y=1+HC(7)*H(9)
- DO 32 K = 2,6
- 32 Y=Y+HC(K)*H(K+1)
- FU=HC(8)*EXP(-0.5*X**2)*MAX(Y,0.)
- ELSEIF(ITYPE .EQ. 2) THEN
- X=RLAM**2
- FU=AC(1)*EXP(-AC(2)*(RLAM+AC(5)*X)-
- 1 AC(3)*EXP(-AC(4)*(RLAM+AC(6)*X)))
- ELSEIF(ITYPE .EQ. 3) THEN
- IF(RLAM .LT. AC(7)) THEN
- X=RLAM**2
- FU=AC(1)*EXP(-AC(2)*(RLAM+AC(5)*X)-
- 1 AC(3)*EXP(-AC(4)*(RLAM+AC(6)*X)))
- ELSE
- X=1/RLAM
- FU=(AC(11)*X+AC(12))*X
- ENDIF
- ELSE
- FU=AC(10)*DENLAN(RLAM)
- ENDIF
- S=S+FL+FU
- IF(S .GT. T) GO TO 22
- 21 FL=FU
-
- 22 S0=S-FL-FU
- V=RLAM-AC(9)
- IF(S .GT. S0) V=V+AC(9)*(T-S0)/(S-S0)
- 9 VAVRAN=V
- RETURN
- END
diff --git a/src/mathlib/gen/g/vavset.F b/src/mathlib/gen/g/vavset.F
deleted file mode 100644
index 97ea544..0000000
--- a/src/mathlib/gen/g/vavset.F
+++ /dev/null
@@ -1,326 +0,0 @@
-*
-* $Id: vavset.F,v 1.1.1.1 1996/04/01 15:02:48 mclareni Exp $
-*
-* $Log: vavset.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:48 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE VAVSET(RKAPPA,BETA2,MODE)
-
- COMMON /GXXXC1/ WCM(0:200),AC(0:13),HC(0:8),ITYPE,NPT
-
- PARAMETER
- 1(BKMNX1 = 0.02, BKMNY1 = 0.05, BKMNX2 = 0.12, BKMNY2 = 0.05,
- 2 BKMNX3 = 0.22, BKMNY3 = 0.05, BKMXX1 = 0.1 , BKMXY1 = 1 ,
- 3 BKMXX2 = 0.2 , BKMXY2 = 1 , BKMXX3 = 0.3 , BKMXY3 = 1 )
- PARAMETER
- 1(FBKX1 = 2/(BKMXX1-BKMNX1), FBKX2 = 2/(BKMXX2-BKMNX2),
- 2 FBKX3 = 2/(BKMXX3-BKMNX3), FBKY1 = 2/(BKMXY1-BKMNY1),
- 3 FBKY2 = 2/(BKMXY2-BKMNY2), FBKY3 = 2/(BKMXY3-BKMNY3))
-
- DIMENSION EDGEC(2:7),FNINV(5),DRK(5),DSIGM(5),ALFA(2:5)
- DIMENSION U1(13),U2(13),U3(13),U4(12),U5(13),U6(13),U7( 8),U8(13)
- DIMENSION V1(12),V2(12),V3(13),V4(12),V5(13),V6(13),V7(11),V8(11)
- DIMENSION W1(13),W2(11),W3(13),W4(13),W5(13),W6(13), W8( 8)
-
- DATA FNINV /1, 0.5, 0.33333333, 0.25, 0.2/
-
- DATA (EDGEC(J),J=2,7)
- 1/ 0.16666667E+0, 0.41666667E-1, 0.83333333E-2,
- 2 0.13888889E-1, 0.69444444E-2, 0.77160493E-3/
-
- DATA (U1(K),K=1,13)
- 1/ 0.25850868E+0, 0.32477982E-1, -0.59020496E-2,
- 2 0. , 0.24880692E-1, 0.47404356E-2,
- 3 -0.74445130E-3, 0.73225731E-2, 0. ,
- 4 0.11668284E-2, 0. , -0.15727318E-2,-0.11210142E-2/
-
- DATA (U2(K),K=1,13)
- 1/ 0.43142611E+0, 0.40797543E-1, -0.91490215E-2,
- 2 0. , 0.42127077E-1, 0.73167928E-2,
- 3 -0.14026047E-2, 0.16195241E-1, 0.24714789E-2,
- 4 0.20751278E-2, 0. , -0.25141668E-2,-0.14064022E-2/
-
- DATA (U3(K),K=1,13)
- 1/ 0.25225955E+0, 0.64820468E-1, -0.23615759E-1,
- 2 0. , 0.23834176E-1, 0.21624675E-2,
- 3 -0.26865597E-2, -0.54891384E-2, 0.39800522E-2,
- 4 0.48447456E-2, -0.89439554E-2, -0.62756944E-2,-0.24655436E-2/
-
- DATA (U4(K),K=1,12)
- 1/ 0.12593231E+1, -0.20374501E+0, 0.95055662E-1,
- 2 -0.20771531E-1, -0.46865180E-1, -0.77222986E-2,
- 3 0.32241039E-2, 0.89882920E-2, -0.67167236E-2,
- 4 -0.13049241E-1, 0.18786468E-1, 0.14484097E-1/
-
- DATA (U5(K),K=1,13)
- 1/-0.24864376E-1, -0.10368495E-2, 0.14330117E-2,
- 2 0.20052730E-3, 0.18751903E-2, 0.12668869E-2,
- 3 0.48736023E-3, 0.34850854E-2, 0. ,
- 4 -0.36597173E-3, 0.19372124E-2, 0.70761825E-3, 0.46898375E-3/
-
- DATA (U6(K),K=1,13)
- 1/ 0.35855696E-1, -0.27542114E-1, 0.12631023E-1,
- 2 -0.30188807E-2, -0.84479939E-3, 0. ,
- 3 0.45675843E-3, -0.69836141E-2, 0.39876546E-2,
- 4 -0.36055679E-2, 0. , 0.15298434E-2, 0.19247256E-2/
-
- DATA (U7(K),K=1,8)
- 1/ 0.10234691E+2, -0.35619655E+1, 0.69387764E+0,
- 2 -0.14047599E+0, -0.19952390E+1, -0.45679694E+0,
- 3 0. , 0.50505298E+0/
-
- DATA (U8(K),K=1,13)
- 1/ 0.21487518E+2, -0.11825253E+2, 0.43133087E+1,
- 2 -0.14500543E+1, -0.34343169E+1, -0.11063164E+1,
- 3 -0.21000819E+0, 0.17891643E+1, -0.89601916E+0,
- 4 0.39120793E+0, 0.73410606E+0, 0. ,-0.32454506E+0/
-
- DATA (V1(K),K=1,12)
- 1/ 0.27827257E+0, -0.14227603E-2, 0.24848327E-2,
- 2 0. , 0.45091424E-1, 0.80559636E-2,
- 3 -0.38974523E-2, 0. , -0.30634124E-2,
- 4 0.75633702E-3, 0.54730726E-2, 0.19792507E-2/
-
- DATA (V2(K),K=1,12)
- 1/ 0.41421789E+0, -0.30061649E-1, 0.52249697E-2,
- 2 0. , 0.12693873E+0, 0.22999801E-1,
- 3 -0.86792801E-2, 0.31875584E-1, -0.61757928E-2,
- 4 0. , 0.19716857E-1, 0.32596742E-2/
-
- DATA (V3(K),K=1,13)
- 1/ 0.20191056E+0, -0.46831422E-1, 0.96777473E-2,
- 2 -0.17995317E-2, 0.53921588E-1, 0.35068740E-2,
- 3 -0.12621494E-1, -0.54996531E-2, -0.90029985E-2,
- 4 0.34958743E-2, 0.18513506E-1, 0.68332334E-2,-0.12940502E-2/
-
- DATA (V4(K),K=1,12)
- 1/ 0.13206081E+1, 0.10036618E+0, -0.22015201E-1,
- 2 0.61667091E-2, -0.14986093E+0, -0.12720568E-1,
- 3 0.24972042E-1, -0.97751962E-2, 0.26087455E-1,
- 4 -0.11399062E-1, -0.48282515E-1, -0.98552378E-2/
-
- DATA (V5(K),K=1,13)
- 1/ 0.16435243E-1, 0.36051400E-1, 0.23036520E-2,
- 2 -0.61666343E-3, -0.10775802E-1, 0.51476061E-2,
- 3 0.56856517E-2, -0.13438433E-1, 0. ,
- 4 0. , -0.25421507E-2, 0.20169108E-2,-0.15144931E-2/
-
- DATA (V6(K),K=1,13)
- 1/ 0.33432405E-1, 0.60583916E-2, -0.23381379E-2,
- 2 0.83846081E-3, -0.13346861E-1, -0.17402116E-2,
- 3 0.21052496E-2, 0.15528195E-2, 0.21900670E-2,
- 4 -0.13202847E-2, -0.45124157E-2, -0.15629454E-2, 0.22499176E-3/
-
- DATA (V7(K),K=1,11)
- 1/ 0.54529572E+1, -0.90906096E+0, 0.86122438E-1,
- 2 0. , -0.12218009E+1, -0.32324120E+0,
- 3 -0.27373591E-1, 0.12173464E+0, 0. ,
- 4 0. , 0.40917471E-1/
-
- DATA (V8(K),K=1,11)
- 1/ 0.93841352E+1, -0.16276904E+1, 0.16571423E+0,
- 2 0. , -0.18160479E+1, -0.50919193E+0,
- 3 -0.51384654E-1, 0.21413992E+0, 0. ,
- 4 0. , 0.66596366E-1/
-
- DATA (W1(K),K=1,13)
- 1/ 0.29712951E+0, 0.97572934E-2, 0. ,
- 2 -0.15291686E-2, 0.35707399E-1, 0.96221631E-2,
- 3 -0.18402821E-2, -0.49821585E-2, 0.18831112E-2,
- 4 0.43541673E-2, 0.20301312E-2, -0.18723311E-2,-0.73403108E-3/
-
- DATA (W2(K),K=1,11)
- 1/ 0.40882635E+0, 0.14474912E-1, 0.25023704E-2,
- 2 -0.37707379E-2, 0.18719727E+0, 0.56954987E-1,
- 3 0. , 0.23020158E-1, 0.50574313E-2,
- 4 0.94550140E-2, 0.19300232E-1/
-
- DATA (W3(K),K=1,13)
- 1/ 0.16861629E+0, 0. , 0.36317285E-2,
- 2 -0.43657818E-2, 0.30144338E-1, 0.13891826E-1,
- 3 -0.58030495E-2, -0.38717547E-2, 0.85359607E-2,
- 4 0.14507659E-1, 0.82387775E-2, -0.10116105E-1,-0.55135670E-2/
-
- DATA (W4(K),K=1,13)
- 1/ 0.13493891E+1, -0.26863185E-2, -0.35216040E-2,
- 2 0.24434909E-1, -0.83447911E-1, -0.48061360E-1,
- 3 0.76473951E-2, 0.24494430E-1, -0.16209200E-1,
- 4 -0.37768479E-1, -0.47890063E-1, 0.17778596E-1, 0.13179324E-1/
-
- DATA (W5(K),K=1,13)
- 1/ 0.10264945E+0, 0.32738857E-1, 0. ,
- 2 0.43608779E-2, -0.43097757E-1, -0.22647176E-2,
- 3 0.94531290E-2, -0.12442571E-1, -0.32283517E-2,
- 4 -0.75640352E-2, -0.88293329E-2, 0.52537299E-2, 0.13340546E-2/
-
- DATA (W6(K),K=1,13)
- 1/ 0.29568177E-1, -0.16300060E-2, -0.21119745E-3,
- 2 0.23599053E-2, -0.48515387E-2, -0.40797531E-2,
- 3 0.40403265E-3, 0.18200105E-2, -0.14346306E-2,
- 4 -0.39165276E-2, -0.37432073E-2, 0.19950380E-2, 0.12222675E-2/
-
- DATA (W8(K),K=1,8)
- 1/ 0.66184645E+1, -0.73866379E+0, 0.44693973E-1,
- 2 0. , -0.14540925E+1, -0.39529833E+0,
- 3 -0.44293243E-1, 0.88741049E-1/
-
- ITYPE=0
- IF(RKAPPA .LT. 0.01 .OR. RKAPPA .GT. 12) RETURN
- IF(RKAPPA .GE. 0.29) THEN
- ITYPE=1
- NPT=100
- WK=1/SQRT(RKAPPA)
- AC(0)=(-0.032227*BETA2-0.074275)*RKAPPA+
- 1 (0.24533*BETA2+0.070152)*WK+(-0.55610*BETA2-3.1579)
- AC(8)=(-0.013483*BETA2-0.048801)*RKAPPA+
- 1 (-1.6921*BETA2+8.3656)*WK+(-0.73275*BETA2-3.5226)
- DRK(1)=WK**2
- DSIGM(1)=SQRT(RKAPPA/(1-0.5*BETA2))
- DO 1 J = 1,4
- DRK(J+1)=DRK(1)*DRK(J)
- DSIGM(J+1)=DSIGM(1)*DSIGM(J)
- 1 ALFA(J+1)=(FNINV(J)-BETA2*FNINV(J+1))*DRK(J)
-
- HC(0)=LOG(RKAPPA)+BETA2+0.42278434
- HC(1)=DSIGM(1)
- HC(2)=ALFA(3)*DSIGM(3)
- HC(3)=(3*ALFA(2)**2+ALFA(4))*DSIGM(4)-3
- HC(4)=(10*ALFA(2)*ALFA(3)+ALFA(5))*DSIGM(5)-10*HC(2)
- HC(5)=HC(2)**2
- HC(6)=HC(2)*HC(3)
- HC(7)=HC(2)*HC(5)
- DO 2 J = 2,7
- 2 HC(J)=EDGEC(J)*HC(J)
- HC(8)=0.39894228*HC(1)
- ELSEIF(RKAPPA .GE. 0.22) THEN
- ITYPE=2
- NPT=150
- X=1+(RKAPPA-BKMXX3)*FBKX3
- Y=1+(SQRT(BETA2)-BKMXY3)*FBKY3
- XX=2*X
- YY=2*Y
- X2=XX*X-1
- X3=XX*X2-X
- Y2=YY*Y-1
- Y3=YY*Y2-Y
- XY=X*Y
- P2=X2*Y
- P3=X3*Y
- Q2=Y2*X
- Q3=Y3*X
- PQ=X2*Y2
- AC(1)=W1(1)+W1(2)*X+W1(4)*X3+W1(5)*Y+W1(6)*Y2+W1(7)*Y3+
- 1 W1(8)*XY+W1(9)*P2+W1(10)*P3+W1(11)*Q2+W1(12)*Q3+W1(13)*PQ
- AC(2)=W2(1)+W2(2)*X+W2(3)*X2+W2(4)*X3+W2(5)*Y+W2(6)*Y2+
- 1 W2(8)*XY+W2(9)*P2+W2(10)*P3+W2(11)*Q2
- AC(3)=W3(1)+W3(3)*X2+W3(4)*X3+W3(5)*Y+W3(6)*Y2+W3(7)*Y3+
- 1 W3(8)*XY+W3(9)*P2+W3(10)*P3+W3(11)*Q2+W3(12)*Q3+W3(13)*PQ
- AC(4)=W4(1)+W4(2)*X+W4(3)*X2+W4(4)*X3+W4(5)*Y+W4(6)*Y2+W4(7)*Y3+
- 1 W4(8)*XY+W4(9)*P2+W4(10)*P3+W4(11)*Q2+W4(12)*Q3+W4(13)*PQ
- AC(5)=W5(1)+W5(2)*X+W5(4)*X3+W5(5)*Y+W5(6)*Y2+W5(7)*Y3+
- 1 W5(8)*XY+W5(9)*P2+W5(10)*P3+W5(11)*Q2+W5(12)*Q3+W5(13)*PQ
- AC(6)=W6(1)+W6(2)*X+W6(3)*X2+W6(4)*X3+W6(5)*Y+W6(6)*Y2+W6(7)*Y3+
- 1 W6(8)*XY+W6(9)*P2+W6(10)*P3+W6(11)*Q2+W6(12)*Q3+W6(13)*PQ
- AC(8)=W8(1)+W8(2)*X+W8(3)*X2+W8(5)*Y+W8(6)*Y2+W8(7)*Y3+W8(8)*XY
- AC(0)=-3.05
- ELSEIF(RKAPPA .GE. 0.12) THEN
- ITYPE=3
- NPT=200
- X=1+(RKAPPA-BKMXX2)*FBKX2
- Y=1+(SQRT(BETA2)-BKMXY2)*FBKY2
- XX=2*X
- YY=2*Y
- X2=XX*X-1
- X3=XX*X2-X
- Y2=YY*Y-1
- Y3=YY*Y2-Y
- XY=X*Y
- P2=X2*Y
- P3=X3*Y
- Q2=Y2*X
- Q3=Y3*X
- PQ=X2*Y2
- AC(1)=V1(1)+V1(2)*X+V1(3)*X2+V1(5)*Y+V1(6)*Y2+V1(7)*Y3+
- 1 V1(9)*P2+V1(10)*P3+V1(11)*Q2+V1(12)*Q3
- AC(2)=V2(1)+V2(2)*X+V2(3)*X2+V2(5)*Y+V2(6)*Y2+V2(7)*Y3+
- 1 V2(8)*XY+V2(9)*P2+V2(11)*Q2+V2(12)*Q3
- AC(3)=V3(1)+V3(2)*X+V3(3)*X2+V3(4)*X3+V3(5)*Y+V3(6)*Y2+V3(7)*Y3+
- 1 V3(8)*XY+V3(9)*P2+V3(10)*P3+V3(11)*Q2+V3(12)*Q3+V3(13)*PQ
- AC(4)=V4(1)+V4(2)*X+V4(3)*X2+V4(4)*X3+V4(5)*Y+V4(6)*Y2+V4(7)*Y3+
- 1 V4(8)*XY+V4(9)*P2+V4(10)*P3+V4(11)*Q2+V4(12)*Q3
- AC(5)=V5(1)+V5(2)*X+V5(3)*X2+V5(4)*X3+V5(5)*Y+V5(6)*Y2+V5(7)*Y3+
- 1 V5(8)*XY+V5(11)*Q2+V5(12)*Q3+V5(13)*PQ
- AC(6)=V6(1)+V6(2)*X+V6(3)*X2+V6(4)*X3+V6(5)*Y+V6(6)*Y2+V6(7)*Y3+
- 1 V6(8)*XY+V6(9)*P2+V6(10)*P3+V6(11)*Q2+V6(12)*Q3+V6(13)*PQ
- AC(7)=V7(1)+V7(2)*X+V7(3)*X2+V7(5)*Y+V7(6)*Y2+V7(7)*Y3+
- 1 V7(8)*XY+V7(11)*Q2
- AC(8)=V8(1)+V8(2)*X+V8(3)*X2+V8(5)*Y+V8(6)*Y2+V8(7)*Y3+
- 1 V8(8)*XY+V8(11)*Q2
- AC(0)=-3.04
- ELSE
- ITYPE=4
- IF(RKAPPA .GE. 0.02) ITYPE=3
- NPT=200
- X=1+(RKAPPA-BKMXX1)*FBKX1
- Y=1+(SQRT(BETA2)-BKMXY1)*FBKY1
- XX=2*X
- YY=2*Y
- X2=XX*X-1
- X3=XX*X2-X
- Y2=YY*Y-1
- Y3=YY*Y2-Y
- XY=X*Y
- P2=X2*Y
- P3=X3*Y
- Q2=Y2*X
- Q3=Y3*X
- PQ=X2*Y2
- IF(ITYPE .EQ. 3) THEN
- AC(1)=U1(1)+U1(2)*X+U1(3)*X2+U1(5)*Y+U1(6)*Y2+U1(7)*Y3+
- 1 U1(8)*XY+U1(10)*P3+U1(12)*Q3+U1(13)*PQ
- AC(2)=U2(1)+U2(2)*X+U2(3)*X2+U2(5)*Y+U2(6)*Y2+U2(7)*Y3+
- 1 U2(8)*XY+U2(9)*P2+U2(10)*P3+U2(12)*Q3+U2(13)*PQ
- AC(3)=U3(1)+U3(2)*X+U3(3)*X2+U3(5)*Y+U3(6)*Y2+U3(7)*Y3+
- 1 U3(8)*XY+U3(9)*P2+U3(10)*P3+U3(11)*Q2+U3(12)*Q3+U3(13)*PQ
- AC(4)=U4(1)+U4(2)*X+U4(3)*X2+U4(4)*X3+U4(5)*Y+U4(6)*Y2+U4(7)*Y3+
- 1 U4(8)*XY+U4(9)*P2+U4(10)*P3+U4(11)*Q2+U4(12)*Q3
- AC(5)=U5(1)+U5(2)*X+U5(3)*X2+U5(4)*X3+U5(5)*Y+U5(6)*Y2+U5(7)*Y3+
- 1 U5(8)*XY+U5(10)*P3+U5(11)*Q2+U5(12)*Q3+U5(13)*PQ
- AC(6)=U6(1)+U6(2)*X+U6(3)*X2+U6(4)*X3+U6(5)*Y+U6(7)*Y3+
- 1 U6(8)*XY+U6(9)*P2+U6(10)*P3+U6(12)*Q3+U6(13)*PQ
- AC(7)=U7(1)+U7(2)*X+U7(3)*X2+U7(4)*X3+U7(5)*Y+U7(6)*Y2+U7(8)*XY
- ENDIF
- AC(8)=U8(1)+U8(2)*X+U8(3)*X2+U8(4)*X3+U8(5)*Y+U8(6)*Y2+U8(7)*Y3+
- 1 U8(8)*XY+U8(9)*P2+U8(10)*P3+U8(11)*Q2+U8(13)*PQ
- AC(0)=-3.03
- ENDIF
- AC(9)=(AC(8)-AC(0))/NPT
- AC(10)=1/AC(9)
- IF(ITYPE .EQ. 3) THEN
- X=(AC(7)-AC(8))/(AC(7)*AC(8))
- Y=1/LOG(AC(8)/AC(7))
- P2=AC(7)**2
- AC(11)=P2*(AC(1)*EXP(-AC(2)*(AC(7)+AC(5)*P2)-
- 1 AC(3)*EXP(-AC(4)*(AC(7)+AC(6)*P2)))-0.045*Y/AC(7))/
- 2 (1+X*Y*AC(7))
- AC(12)=(0.045+X*AC(11))*Y
- ENDIF
- IF(ITYPE .EQ. 4) AC(13)=0.995/DISLAN(AC(8))
-
- IF(MODE .EQ. 0) RETURN
- X=AC(0)
- WCM(0)=0
- FL=VAVDEN(X)
- DO 11 K = 1,NPT
- X=X+AC(9)
- FU=VAVDEN(X)
- WCM(K)=WCM(K-1)+FL+FU
- 11 FL=FU
- X=0.5*AC(9)
- DO 12 K = 1,NPT
- 12 WCM(K)=X*WCM(K)
- RETURN
- END
diff --git a/src/mathlib/gen/g/vavzro.F b/src/mathlib/gen/g/vavzro.F
deleted file mode 100644
index afd2176..0000000
--- a/src/mathlib/gen/g/vavzro.F
+++ /dev/null
@@ -1,127 +0,0 @@
-*
-* $Id: vavzro.F,v 1.1.1.1 1996/04/01 15:02:48 mclareni Exp $
-*
-* $Log: vavzro.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:48 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE VAVZRO(A,B,X,RKA,BE2,LU)
-C
-C RZERO SEARCHES FOR THE ROOT OF THE EQUATION FCN=0 IN THE INTERVAL
-C
- COMMON /FORFCN/ SS,LFCN
- DATA E,EPSI,MAXFUN/1E-9,1E-5,100/
- MC=0
-C
- XA=MIN(A,B)
- XB=MAX(A,B)
- FA=VAVFCN(A,RKA,BE2)
- MC=MC+1
- FB=VAVFCN(B,RKA,BE2)
- IF(FA*FB .GT. 0.0) GO TO 16
- MC=MC+1
-C
- 4 X=0.5*(XA+XB)
- R=X-XA
- EE=ABS(X)+E
- IF(R .LE. EE*EPSI) GO TO 18
- F1=FA
- X1=XA
- F2=FB
- X2=XB
- 1 MC=MC+1
- G=VAVFCN(X,RKA,BE2)
- IF(MC .GT. MAXFUN) GO TO 17
- FX=G
-C
- IF(FX*FA .GT. 0.0) GO TO 2
- FB=FX
- XB=X
- GO TO 3
- 2 XA=X
- FA=FX
-C
-C PARABOLA ITERATION
-C
- 3 IF((X1-X2)*(X2-X)*(X1-X) .EQ. 0.0) GO TO 4
- F3=FX
- X3=X
- U1=(F1-F2)/(X1-X2)
- U2=(F2-FX)/(X2-X)
- CA=U1-U2
- CB=(X1+X2)*U2-(X2+X)*U1
- CC=(X1-X)*F1-X1*(CA*X1+CB)
- IF(CA .EQ. 0.0) GO TO 8
- U3=0.5*CB/CA
- U4=U3**2-CC/CA
- IF(U4 .LT. 0.0) GO TO 4
- U5=SQRT(U4)
- IF(X .GE. -U3) GO TO 10
- X=-U3-U5
- GO TO 9
- 10 X=-U3+U5
- GO TO 9
- 8 X=-CC/CB
- 9 IF(X .LT. XA) GO TO 4
- IF(X .GT. XB) GO TO 4
-C
-C TEST FOR OUTPUT
-C
- R=ABS(X-X3)
- R1=ABS(X-X2)
- IF(R .GT. R1) R=R1
- EE=ABS(X)+E
- IF(R/EE .GT. EPSI) GO TO 5
- MC=MC+1
- G=VAVFCN(X,RKA,BE2)
- IF(MC .GT. MAXFUN) GO TO 17
- FX=G
- IF(FX .EQ. 0.0) GO TO 18
- IF(FX*FA .LT. 0.0) GO TO 7
- XX=X+EPSI*EE
- IF(XX .GE. XB) GO TO 18
- MC=MC+1
- G=VAVFCN(X,RKA,BE2)
- IF(MC .GT. MAXFUN) GO TO 17
- FF=VAVFCN(XX,RKA,BE2)
- FA=FF
- XA=XX
- GO TO 6
- 7 XX=X-EPSI*EE
- IF(XX .LE. XA) GO TO 18
- MC=MC+1
- FX=G
- IF(MC .GT. MAXFUN) GO TO 17
- FF=VAVFCN(XX,RKA,BE2)
- FB=FF
- XB=XX
- 6 IF(FX*FF .GT. 0.0) GO TO 14
- 18 R=EPSI*EE
- FF=VAVFCN(X,RKA,BE2)
- RETURN
- 14 F1=F2
- X1=X2
- F2=FX
- X2=X
- X=XX
- FX=FF
- GO TO 3
-C
- 5 F1=F2
- X1=X2
- F2=F3
- X2=X3
- GO TO 1
-C
- 16 WRITE(LU,301)
- RETURN
-C
- 17 WRITE(LU,300) X,G,LFCN
- 301 FORMAT(/10X,' RZERO FCN(A) AND FCN(B) HAVE SAME SIGN'/)
- 300 FORMAT(/10X,' RZERO NUMBER OF ITERATIONS EXCEEDED'/
- 1 10X,' X=',E15.5,2X,' FCN(X)=',E15.5,2X,' LFCN=',I2/)
- RETURN
-C
- END
diff --git a/src/mathlib/gen/g/vviden.F b/src/mathlib/gen/g/vviden.F
deleted file mode 100644
index 7bbf70c..0000000
--- a/src/mathlib/gen/g/vviden.F
+++ /dev/null
@@ -1,51 +0,0 @@
-*
-* $Id: vviden.F,v 1.1.1.1 1996/04/01 15:02:48 mclareni Exp $
-*
-* $Log: vviden.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:48 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- FUNCTION VVIDEN(X)
-
- LOGICAL LST
-
- COMMON /G116C1/ H(7),T0,T1,T,OMEGA,A(155),B(155),X0
-
- PARAMETER (PI = 3.14159 265, Z1 = 1, HF = Z1/2)
-
- LST=.FALSE.
- GO TO 9
-
- ENTRY VVIDIS(X)
-
- LST=.TRUE.
- 9 N=X0
- IF(X .LT. T0) THEN
- F=0
- ELSEIF(X .LE. T1) THEN
- Y=X-T0
- U=OMEGA*Y-PI
- COF=2*COS(U)
- A1=0
- A0=A(1)
- DO 1 K = 2,N+1
- A2=A1
- A1=A0
- 1 A0=A(K)+COF*A1-A2
- B1=0
- B0=B(1)
- DO 2 K = 2,N
- B2=B1
- B1=B0
- 2 B0=B(K)+COF*B1-B2
- F=HF*(A0-A2)+B0*SIN(U)
- IF(LST) F=F+Y/T
- ELSE
- F=0
- IF(LST) F=1
- ENDIF
- VVIDEN=F
- RETURN
- END
diff --git a/src/mathlib/gen/g/vviset.F b/src/mathlib/gen/g/vviset.F
deleted file mode 100644
index 538696f..0000000
--- a/src/mathlib/gen/g/vviset.F
+++ /dev/null
@@ -1,99 +0,0 @@
-*
-* $Id: vviset.F,v 1.1.1.1 1996/04/01 15:02:48 mclareni Exp $
-*
-* $Log: vviset.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:48 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE VVISET(RKA,BE2,MODE,XL,XU)
-
- COMMON /G116C1/ H(7),T0,T1,T,OMEGA,A(155),B(155),X0
- EXTERNAL G116F1,G116F2
- CHARACTER NAME*(*)
- CHARACTER*80 ERRTXT
- PARAMETER (NAME = 'VVISET')
- DIMENSION XP(8),XQ(6)
-
-C H1 = 5 ln 10 - ln(2/PI**2), h2 = 3 ln 10, h0 = Ln 0.0005...
-
- PARAMETER (PI = 3.14159 265, EU = 0.57721 566)
- PARAMETER (PI2 = 2*PI, RPI = 1/PI)
- PARAMETER (H1 = 5*2.30258 509-1.59631 259, H2 = 3*2.30258 509)
- PARAMETER (H0 =-7.6, PIH = PI/2, EPS = 1E-5)
-
- DATA XP /9.29, 2.47, 0.89, 0.36, 0.15, 0.07, 0.03, 0.02/
- DATA XQ /0.012, 0.03, 0.08, 0.26, 0.87, 3.83/
-
- IF(RKA .LT. 0.01 .OR. RKA .GT. 10) THEN
- WRITE(ERRTXT,101) RKA
- CALL MTLPRT(NAME,'G116.1',ERRTXT)
- ELSEIF(BE2 .LT. 0 .OR. BE2 .GT. 1) THEN
- WRITE(ERRTXT,102) BE2
- CALL MTLPRT(NAME,'G116.2',ERRTXT)
- ELSE
- H(5)=1-BE2*(1-EU)-H0/RKA
- H(6)=BE2
- H(7)=1-BE2
- H4=H0/RKA-(1+BE2*EU)
- H5=LOG(RKA)
- H6=1/RKA
- T0=(H4-H(5)*H5-(H(5)+BE2)*(LOG(H(5))+REXPIN(H(5)))+EXP(-H(5)))/
- 1 H(5)
- DO 1 LP = 1,8
- IF(RKA .GE. XP(LP)) GO TO 11
- 1 CONTINUE
- LP=9
- 11 DO 2 LQ = 1,6
- IF(RKA .LE. XQ(LQ)) GO TO 22
- 2 CONTINUE
- LQ=7
- 22 CALL RZERO(-LP-0.5,LQ-7.5,U,XX,EPS,1000,G116F2)
- Q=1/U
- T1=H4*Q-H5-(1+BE2*Q)*(LOG(ABS(U))+REXPIN(U))+EXP(-U)*Q
-
- T=T1-T0
- OMEGA=PI2/T
- H(1)=RKA*(2+BE2*EU)+H1
- IF(RKA .GE. 0.07) H(1)=H(1)+H2
- H(2)=BE2*RKA
- H(3)=H6*OMEGA
- H(4)=PIH*OMEGA
- CALL RZERO(5.,155.,X0,XX,EPS,1000,G116F1)
- N=X0+1
-
- D=RPI*EXP(RKA*(1+BE2*(EU-H5)))
- A(N)=0
- IF(MODE .EQ. 0) A(N)=RPI*OMEGA
- Q=-1
- Q2=2
- DO 3 K = 1,N-1
- L=N-K
- X=OMEGA*K
- X1=H6*X
- C1=LOG(X)-COSINT(X1)
- C2=SININT(X1)
- C3=SIN(X1)
- C4=COS(X1)
- XF1=RKA*(BE2*C1-C4)-X*C2
- XF2=X*C1+RKA*(C3+BE2*C2)+T0*X
- IF(MODE .EQ. 0) THEN
- D1=Q*D*OMEGA*EXP(XF1)
- A(L)=D1*COS(XF2)
- B(L)=-D1*SIN(XF2)
- ELSE
- D1=Q*D*EXP(XF1)/K
- A(L)=D1*SIN(XF2)
- B(L)=D1*COS(XF2)
- A(N)=A(N)+Q2*A(L)
- ENDIF
- Q=-Q
- 3 Q2=-Q2
- ENDIF
- XL=T0
- XU=T1
- RETURN
- 101 FORMAT('KAPPA = ',E10.3,' - OUT OF RANGE')
- 102 FORMAT('BETA**2 = ',E10.3,' - OUT OF RANGE')
- END
diff --git a/src/mathlib/gen/g/xm1lan.F b/src/mathlib/gen/g/xm1lan.F
deleted file mode 100644
index 9fe4454..0000000
--- a/src/mathlib/gen/g/xm1lan.F
+++ /dev/null
@@ -1,88 +0,0 @@
-*
-* $Id: xm1lan.F,v 1.1.1.1 1996/04/01 15:02:44 mclareni Exp $
-*
-* $Log: xm1lan.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:44 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-C This will be XM1LAN,IF=DOUBLE and XM1LAN64,IF=-DOUBLE
- FUNCTION XM1LAN(X)
-
- DIMENSION P1(0:4),P2(0:4),P3(0:4),P4(0:3),P5(0:3)
- DIMENSION Q1(0:4),Q2(0:4),Q3(0:4),Q4(0:3),Q5(0:3)
- DIMENSION A0(0:5),A1(1:3),A2(1:4)
-
- DATA (P1(I),I=0,4),(Q1(I),I=0,4)
- 1/-0.89493 74280E+0, 0.46317 83434E+0,-0.40533 32915E-1,
- 2 0.15800 75560E-1,-0.34238 74194E-2,
- 3 1.0 , 0.10029 30749E+0, 0.35752 71633E-1,
- 4 -0.19158 82099E-2, 0.48110 72364E-4/
-
- DATA (P2(I),I=0,4),(Q2(I),I=0,4)
- 1/-0.89333 84046E+0, 0.11612 96496E+0, 0.12000 82940E+0,
- 2 0.21856 99725E-1, 0.21288 92058E-2,
- 3 1.0 , 0.49355 31886E+0, 0.10663 47067E+0,
- 4 0.12501 61833E-1, 0.54942 43254E-3/
-
- DATA (P3(I),I=0,4),(Q3(I),I=0,4)
- 1/-0.89333 22067E+0, 0.23395 44896E+0, 0.82576 53222E-1,
- 2 0.14112 26998E-1, 0.28922 40953E-3,
- 3 1.0 , 0.36165 38408E+0, 0.66280 26743E-1,
- 4 0.48392 98984E-2, 0.52483 10361E-4/
-
- DATA (P4(I),I=0,3),(Q4(I),I=0,3)
- 1/ 0.93584 19425E+0, 0.67168 31438E+2,-0.67650 69077E+3,
- 2 0.90266 61865E+3,
- 3 1.0 , 0.77525 62854E+2,-0.56378 11998E+3,
- 4 -0.55131 56752E+3/
-
- DATA (P5(I),I=0,3),(Q5(I),I=0,3)
- 1/ 0.94893 35583E+0, 0.55612 46706E+3, 0.32082 74617E+5,
- 2 -0.48899 26524E+5,
- 3 1.0 , 0.60282 75940E+3, 0.37169 62017E+5,
- 4 0.36862 72898E+5/
-
- DATA (A0(I),I=0,5)
- 1/-0.42278 43351E+0,-0.15443 13298E+0, 0.42278 43351E+0,
- 2 0.32764 96874E+1, 0.20434 03138E+1,-0.86812 96500E+1/
-
- DATA (A1(I),I=1,3)
- 1/-0.45833 33333E+0, 0.66753 47222E+0,-0.16417 41416E+1/
-
- DATA (A2(I),I=1,4)
- 1/-0.19583 33333E+1, 0.55633 68056E+1,-0.21113 52961E+2,
- 2 0.10069 46266E+3/
-
- V=X
- IF(V .LT. -4.5) THEN
- U=EXP(V+1)
- XM1LAN=V-U*(1+(A2(1)+(A2(2)+(A2(3)+A2(4)*U)*U)*U)*U)/
- 1 (1+(A1(1)+(A1(2)+A1(3)*U)*U)*U)
- ELSEIF(V .LT. -2) THEN
- XM1LAN=(P1(0)+(P1(1)+(P1(2)+(P1(3)+P1(4)*V)*V)*V)*V)/
- 1 (Q1(0)+(Q1(1)+(Q1(2)+(Q1(3)+Q1(4)*V)*V)*V)*V)
- ELSEIF(V .LT. 2) THEN
- XM1LAN=(P2(0)+(P2(1)+(P2(2)+(P2(3)+P2(4)*V)*V)*V)*V)/
- 1 (Q2(0)+(Q2(1)+(Q2(2)+(Q2(3)+Q2(4)*V)*V)*V)*V)
- ELSEIF(V .LT. 10) THEN
- XM1LAN=(P3(0)+(P3(1)+(P3(2)+(P3(3)+P3(4)*V)*V)*V)*V)/
- 1 (Q3(0)+(Q3(1)+(Q3(2)+(Q3(3)+Q3(4)*V)*V)*V)*V)
- ELSEIF(V .LT. 40) THEN
- U=1/V
- XM1LAN=LOG(V)*(P4(0)+(P4(1)+(P4(2)+P4(3)*U)*U)*U)/
- 1 (Q4(0)+(Q4(1)+(Q4(2)+Q4(3)*U)*U)*U)
- ELSEIF(V .LT. 200) THEN
- U=1/V
- XM1LAN=LOG(V)*(P5(0)+(P5(1)+(P5(2)+P5(3)*U)*U)*U)/
- 1 (Q5(0)+(Q5(1)+(Q5(2)+Q5(3)*U)*U)*U)
- ELSE
- U=V-V*LOG(V)/(V+1)
- V=1/(U-U*(U+LOG(U)-V)/(U+1))
- U=-LOG(V)
- XM1LAN=(U+A0(0)+(-U+A0(1)+(A0(2)*U+A0(3)+(A0(4)*U+A0(5))*V)*V)*V)
- 1 /(1-(1-(A0(2)+A0(4)*V)*V)*V)
- ENDIF
- RETURN
- END
diff --git a/src/mathlib/gen/g/xm2lan.F b/src/mathlib/gen/g/xm2lan.F
deleted file mode 100644
index af91e16..0000000
--- a/src/mathlib/gen/g/xm2lan.F
+++ /dev/null
@@ -1,96 +0,0 @@
-*
-* $Id: xm2lan.F,v 1.1.1.1 1996/04/01 15:02:45 mclareni Exp $
-*
-* $Log: xm2lan.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:45 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-C This will be XM2LAN,IF=DOUBLE and XM2LAN64,IF=-DOUBLE
- FUNCTION XM2LAN(X)
-
- DIMENSION P1(0:4),P2(0:4),P3(0:3),P4(0:4),P5(0:3)
- DIMENSION Q1(0:4),Q2(0:4),Q3(0:3),Q4(0:4),Q5(0:3)
- DIMENSION A0(0:6),A1(1:3),A2(0:3),A3(0:3)
-
- DATA (P1(I),I=0,4),(Q1(I),I=0,4)
- 1/ 0.11698 37582E+1,-0.48348 74539E+0, 0.43837 74644E+0,
- 2 0.32871 75228E-2, 0.18791 29206E-1,
- 3 1.0 , 0.17951 54326E+0, 0.46127 95899E-1,
- 4 0.21834 59337E-2, 0.72266 23623E-4/
-
- DATA (P2(I),I=0,4),(Q2(I),I=0,4)
- 1/ 0.11579 39823E+1,-0.38428 09495E+0, 0.33175 32899E+0,
- 2 0.35476 06781E-1, 0.67256 45279E-2,
- 3 1.0 , 0.29168 24021E+0, 0.52598 53480E-1,
- 4 0.38400 11061E-2, 0.99503 24173E-4/
-
- DATA (P3(I),I=0,3),(Q3(I),I=0,3)
- 1/ 0.11781 91282E+1, 0.10116 23342E+2,-0.12855 85291E+2,
- 2 0.36413 61437E+2,
- 3 1.0 , 0.86141 60194E+1, 0.31189 29630E+2,
- 4 0.15143 51300E+0/
-
- DATA (P4(I),I=0,4),(Q4(I),I=0,4)
- 1/ 0.10307 63698E+1, 0.12167 58660E+3, 0.16374 31386E+4,
- 2 -0.21714 66507E+4, 0.70101 68358E+4,
- 3 1.0 , 0.10224 87911E+3, 0.13776 46350E+4,
- 4 0.36991 84961E+4, 0.42513 15610E+4/
-
- DATA (P5(I),I=0,3),(Q5(I),I=0,3)
- 1/ 0.10100 84827E+1, 0.39442 24824E+3, 0.17730 25353E+5,
- 2 -0.70759 63938E+5,
- 3 1.0 , 0.36059 50254E+3, 0.13927 84158E+5,
- 4 -0.18816 80027E+5/
-
- DATA (A0(I),I=0,6)
- 1/-0.20434 03138E+1,-0.84556 86702E+0,-0.30886 26596E+0,
- 2 0.58213 46754E+1, 0.42278 43351E+0, 0.65529 93748E+1,
- 3 -0.10767 14945E+2/
-
- DATA (A1(I),I=1,3)
- 1/-0.45833 33333E+0, 0.66753 47222E+0,-0.16417 41416E+1/
-
- DATA (A2(I),I=0,3)
- 1/-0.19583 33333E+1, 0.55633 68056E+1,-0.21113 52961E+2,
- 2 0.10069 46266E+3/
-
- DATA (A3(I),I=0,3)
- 1/-1.0 , 0.44583 33333E+1,-0.21167 53472E+2,
- 2 0.11636 74359E+3/
-
- V=X
- IF(V .LT. -4.5) THEN
- U=EXP(V+1)
- XM2LAN=V**2-2*U**2*
- 1 (V/U+A2(0)*V+A3(0)+(A2(1)*V+A3(1)+(A2(2)*V+A3(2)+
- 2 (A2(3)*V+A3(3))*U)*U)*U)/
- 3 (1+(A1(1)+(A1(2)+A1(3)*U)*U)*U)
- ELSEIF(V .LT. -2) THEN
- XM2LAN=(P1(0)+(P1(1)+(P1(2)+(P1(3)+P1(4)*V)*V)*V)*V)/
- 1 (Q1(0)+(Q1(1)+(Q1(2)+(Q1(3)+Q1(4)*V)*V)*V)*V)
- ELSEIF(V .LT. 2) THEN
- XM2LAN=(P2(0)+(P2(1)+(P2(2)+(P2(3)+P2(4)*V)*V)*V)*V)/
- 1 (Q2(0)+(Q2(1)+(Q2(2)+(Q2(3)+Q2(4)*V)*V)*V)*V)
- ELSEIF(V .LT. 5) THEN
- U=1/V
- XM2LAN=V*(P3(0)+(P3(1)+(P3(2)+P3(3)*U)*U)*U)/
- 1 (Q3(0)+(Q3(1)+(Q3(2)+Q3(3)*U)*U)*U)
- ELSEIF(V .LT. 50) THEN
- U=1/V
- XM2LAN=V*(P4(0)+(P4(1)+(P4(2)+(P4(3)+P4(4)*U)*U)*U)*U)/
- 1 (Q4(0)+(Q4(1)+(Q4(2)+(Q4(3)+Q4(4)*U)*U)*U)*U)
- ELSEIF(V .LT. 200) THEN
- U=1/V
- XM2LAN=V*(P5(0)+(P5(1)+(P5(2)+P5(3)*U)*U)*U)/
- 1 (Q5(0)+(Q5(1)+(Q5(2)+Q5(3)*U)*U)*U)
- ELSE
- U=V-V*LOG(V)/(V+1)
- V=1/(U-U*(U+LOG(U)-V)/(U+1))
- U=-LOG(V)
- XM2LAN=(1/V+U**2+A0(0)+A0(1)*U+(-U**2+A0(2)*U+A0(3)+
- 1 (A0(4)*U**2+A0(5)*U+A0(6))*V)*V)/(1-(1-A0(4)*V)*V)
- ENDIF
- RETURN
- END
diff --git a/src/mathlib/gen/gen/Imakefile b/src/mathlib/gen/gen/Imakefile
deleted file mode 100644
index 118d0f8..0000000
--- a/src/mathlib/gen/gen/Imakefile
+++ /dev/null
@@ -1,4 +0,0 @@
-INCLUDES= def128.inc def64.inc defc64.inc gcmpfun.inc \ @@\
- imp128.inc imp64.inc impc64.inc pilot.h
-
-InstallIncludes($(INCLUDES),$(CERN_INCLUDEDIR),gen)
diff --git a/src/mathlib/gen/gen/def128.inc b/src/mathlib/gen/gen/def128.inc
deleted file mode 100644
index ebca51e..0000000
--- a/src/mathlib/gen/gen/def128.inc
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: def128.inc,v 1.1.1.1 1996/04/01 15:02:59 mclareni Exp $
-*
-* $Log: def128.inc,v $
-* Revision 1.1.1.1 1996/04/01 15:02:59 mclareni
-* Mathlib gen
-*
-*
-*
-* def128.inc
-*
-#if (defined(CERNLIB_DOUBLE))&&(defined(CERNLIB_F90))
- REAL(4)
-
-#elif (!defined(CERNLIB_DOUBLE))&&(defined(CERNLIB_F90))
- REAL(2)
-
-#elif (!defined(CERNLIB_F90))&&(defined(CERNLIB_NOQUAD)||!defined(CERNLIB_DOUBLE))
- DOUBLE PRECISION
-
-#elif 1
- REAL*16
-
-#endif
diff --git a/src/mathlib/gen/gen/def64.inc b/src/mathlib/gen/gen/def64.inc
deleted file mode 100644
index f5dc7f3..0000000
--- a/src/mathlib/gen/gen/def64.inc
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: def64.inc,v 1.1.1.1 1996/04/01 15:02:59 mclareni Exp $
-*
-* $Log: def64.inc,v $
-* Revision 1.1.1.1 1996/04/01 15:02:59 mclareni
-* Mathlib gen
-*
-*
-*
-* def64.inc
-*
-#if !defined(CERNLIB_DOUBLE)
- REAL
-#endif
-#if (defined(CERNLIB_DOUBLE))&&(defined(CERNLIB_F90))
- REAL(2)
-#endif
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION
-#endif
diff --git a/src/mathlib/gen/gen/defc64.inc b/src/mathlib/gen/gen/defc64.inc
deleted file mode 100644
index 022986f..0000000
--- a/src/mathlib/gen/gen/defc64.inc
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: defc64.inc,v 1.1.1.1 1996/04/01 15:02:59 mclareni Exp $
-*
-* $Log: defc64.inc,v $
-* Revision 1.1.1.1 1996/04/01 15:02:59 mclareni
-* Mathlib gen
-*
-*
-* defc64.inc
-*
-#if (defined(CERNLIB_DOUBLE))&&(defined(CERNLIB_F90))
- COMPLEX(2)
-
-#elif !defined(CERNLIB_DOUBLE)
- COMPLEX
-
-#elif 1
- COMPLEX*16
-
-#endif
diff --git a/src/mathlib/gen/gen/gcmpfun.inc b/src/mathlib/gen/gen/gcmpfun.inc
deleted file mode 100644
index f966395..0000000
--- a/src/mathlib/gen/gen/gcmpfun.inc
+++ /dev/null
@@ -1,47 +0,0 @@
-*
-* $Id: gcmpfun.inc,v 1.1.1.1 1996/04/01 15:02:59 mclareni Exp $
-*
-* $Log: gcmpfun.inc,v $
-* Revision 1.1.1.1 1996/04/01 15:02:59 mclareni
-* Mathlib gen
-*
-*
-*
-* gcmpfun.inc
-*
-#if (defined(CERNLIB_DOUBLE))&&(!defined(CERNLIB_F90))&&(defined(CERNLIB_LINUX)||!defined(CERNLIB_QF2C))
-#include "gen/def64.inc"
- + GREAL,GIMAG,XARG,YARG
-#include "gen/defc64.inc"
- + ZARG,GCONJG,GCMPLX
- GREAL( ZARG)=DREAL( ZARG)
- GIMAG( ZARG)=DIMAG( ZARG)
- GCONJG(ZARG)=DCONJG(ZARG)
- GCMPLX(XARG,YARG)=DCMPLX(XARG,YARG)
-
-#elif (defined(CERNLIB_DOUBLE))&&(defined(CERNLIB_QF2C))&&(!defined(CERNLIB_LINUX))
-#include "gen/def64.inc"
- + GREAL,GIMAG,XARG,YARG
-#include "gen/defc64.inc"
- + ZARG,GCONJG,GCMPLX
-
-#elif (defined(CERNLIB_DOUBLE))&&(defined(CERNLIB_F90))
-#include "gen/def64.inc"
- + GREAL,GIMAG,XARG,YARG
-#include "gen/defc64.inc"
- + ZARG,GCONJG,GCMPLX
- GREAL( ZARG)= REAL( ZARG,2)
- GIMAG( ZARG)=AIMAG( ZARG)
- GCONJG(ZARG)= CONJG(ZARG)
- GCMPLX(XARG,YARG)= CMPLX(XARG,YARG,2)
-
-#elif 1
-#include "gen/def64.inc"
- + GREAL,GIMAG,XARG,YARG
-#include "gen/defc64.inc"
- + ZARG,GCONJG,GCMPLX
- GREAL( ZARG)=REAL( ZARG)
- GIMAG( ZARG)=AIMAG(ZARG)
- GCONJG(ZARG)=CONJG(ZARG)
- GCMPLX(XARG,YARG)= CMPLX(XARG,YARG)
-#endif
diff --git a/src/mathlib/gen/gen/imp128.inc b/src/mathlib/gen/gen/imp128.inc
deleted file mode 100644
index b81cb4f..0000000
--- a/src/mathlib/gen/gen/imp128.inc
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: imp128.inc,v 1.1.1.1 1996/04/01 15:02:59 mclareni Exp $
-*
-* $Log: imp128.inc,v $
-* Revision 1.1.1.1 1996/04/01 15:02:59 mclareni
-* Mathlib gen
-*
-*
-* imp128.inc
-*
-#if (!defined(CERNLIB_F90))&&(defined(CERNLIB_NOQUAD)||!defined(CERNLIB_DOUBLE))
- IMPLICIT DOUBLE PRECISION (A-H,O-Z)
-
-#elif (defined(CERNLIB_F90))&&(!defined(CERNLIB_DOUBLE))
- IMPLICIT REAL(2) (A-H,O-Z)
-
-#elif (defined(CERNLIB_F90))&&(defined(CERNLIB_DOUBLE))
- IMPLICIT REAL(4) (A-H,O-Z)
-
-#elif 1
- IMPLICIT REAL*16 (A-H,O-Z)
-
-#endif
diff --git a/src/mathlib/gen/gen/imp64.inc b/src/mathlib/gen/gen/imp64.inc
deleted file mode 100644
index c28621f..0000000
--- a/src/mathlib/gen/gen/imp64.inc
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: imp64.inc,v 1.1.1.1 1996/04/01 15:02:59 mclareni Exp $
-*
-* $Log: imp64.inc,v $
-* Revision 1.1.1.1 1996/04/01 15:02:59 mclareni
-* Mathlib gen
-*
-*
-* imp64.inc
-*
-#if !defined(CERNLIB_DOUBLE)
- IMPLICIT REAL (A-H,O-Z)
-
-#elif (defined(CERNLIB_F90))&&(defined(CERNLIB_DOUBLE))
- IMPLICIT REAL(2) (A-H,O-Z)
-
-#elif 1
- IMPLICIT DOUBLE PRECISION (A-H,O-Z)
-
-#endif
diff --git a/src/mathlib/gen/gen/impc64.inc b/src/mathlib/gen/gen/impc64.inc
deleted file mode 100644
index d72f91c..0000000
--- a/src/mathlib/gen/gen/impc64.inc
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: impc64.inc,v 1.1.1.1 1996/04/01 15:02:59 mclareni Exp $
-*
-* $Log: impc64.inc,v $
-* Revision 1.1.1.1 1996/04/01 15:02:59 mclareni
-* Mathlib gen
-*
-*
-*
-* impc64.inc
-*
-#if (defined(CERNLIB_DOUBLE))&&(defined(CERNLIB_F90))
- IMPLICIT COMPLEX(2) (A-H,I,O-Z)
-
-#elif !defined(CERNLIB_DOUBLE)
- IMPLICIT COMPLEX (A-H,I,O-Z)
-
-#elif 1
- IMPLICIT COMPLEX*16 (A-H,I,O-Z)
-
-#endif
diff --git a/src/mathlib/gen/gen/pilot.h b/src/mathlib/gen/gen/pilot.h
deleted file mode 100644
index 401aa2d..0000000
--- a/src/mathlib/gen/gen/pilot.h
+++ /dev/null
@@ -1,120 +0,0 @@
-#if (defined(CERNLIB_UNIX))&&(!defined(CERNLIB_SINGLE))
-#ifndef CERNLIB_DOUBLE
-#define CERNLIB_DOUBLE
-#endif
-#endif
-
-#if defined(CERNLIB_DECS)||defined(CERNLIB_QMALPH)||defined(CERNLIB_APOLLO)||defined(CERNLIB_SGI)||defined(CERNLIB_NEXT)||defined(CERNLIB_LINUX)||defined(CERNLIB_MSDOS)||defined(CERNLIB_CONVEX32)||defined(CERNLIB_QFAPOGEE)||defined(CERNLIB_QFEPC)||defined(CERNLIB_QFMSOFT)||defined(CERNLIB_QFDEC)||defined(CERNLIB_WINNT)
-#ifndef CERNLIB_NOQUAD
-#define CERNLIB_NOQUAD
-#endif
-#endif
-
-#if !defined(CERNLIB_NOQUAD)
-#ifndef CERNLIB_QUAD
-#define CERNLIB_QUAD
-#endif
-#endif
-
-#if defined(CERNLIB_QMALPH)
-#ifndef CERNLIB_FORTRAN
-#define CERNLIB_FORTRAN
-#endif
-#endif
-
-#if (defined(CERNLIB_CONVEX))&&(defined(CERNLIB_SINGLE))
-#ifndef CERNLIB_CONVEX64
-#define CERNLIB_CONVEX64
-#endif
-#endif
-#if (defined(CERNLIB_CONVEX))&&(!defined(CERNLIB_CONVEX64))
-#ifndef CERNLIB_CONVEX32
-#define CERNLIB_CONVEX32
-#endif
-#endif
-#if defined(CERNLIB_CONVEX32)||defined(CERNLIB_CONVEX64)
-#ifndef CERNLIB_CONVEX
-#define CERNLIB_CONVEX
-#endif
-#endif
-
-#if 0
-* DEC Fortran 1.0 is used for Windows/NT
-#endif
-#if defined(CERNLIB_WINNT) && !defined(CERNLIB_QFMSOFT)
-#ifndef CERNLIB_DECS
-#define CERNLIB_DECS
-#endif
-
-#ifndef CERNLIB_QMALPH
-#define CERNLIB_QMALPH
-#endif
-
-#ifndef CERNLIB_FORTRAN
-#define CERNLIB_FORTRAN
-#endif
-#endif
-
-#if (defined(CERNLIB_MSDOS))&&(!defined(CERNLIB_NDP))&&(!defined(CERNLIB_WINNT))
-#ifndef CERNLIB_QF2C
-#define CERNLIB_QF2C
-#endif
-#endif
-
-#if defined(CERNLIB_LINUX)
-#ifndef CERNLIB_QF2C
-#define CERNLIB_QF2C
-#endif
-#endif
-
-#if defined(CERNLIB_IBMMVS)||defined(CERNLIB_IBMVM)
-#ifndef CERNLIB_IBM
-#define CERNLIB_IBM
-#endif
-#endif
-
-#if defined(CERNLIB_CDC)||defined(CERNLIB_CRAY)
-#ifndef CERNLIB_SINGLE
-#define CERNLIB_SINGLE
-#endif
-#endif
-
-#if defined(CERNLIB_IBM)||defined(CERNLIB_VAX)||defined(CERNLIB_NORD)
-#ifndef CERNLIB_DOUBLE
-#define CERNLIB_DOUBLE
-#endif
-#endif
-
-#if defined(CERNLIB_IBM)
-#ifndef CERNLIB_QMIBMXA
-#define CERNLIB_QMIBMXA
-#endif
-#endif
-
-#if 0
-* Defines for the tests not used to build lib
-#endif
-
-#if defined(CERNLIB_DOUBLE)
-#ifndef CERNLIB_CMPXDOUB
-#define CERNLIB_CMPXDOUB
-#endif
-#endif
-
-#if defined(CERNLIB_CRAY)
-#ifndef CERNLIB_CMPXDOUB
-#define CERNLIB_CMPXDOUB
-#endif
-#endif
-
-#if (defined(CERNLIB_UNIX))&&(!defined(CERNLIB_SINGLE))
-#ifndef CERNLIB_QIEEE
-#define CERNLIB_QIEEE
-#endif
-#endif
-
-#if defined(CERNLIB_IBMRT)
-#ifndef CERNLIB_IBMRS
-#define CERNLIB_IBMRS
-#endif
-#endif
diff --git a/src/mathlib/gen/h/Imakefile b/src/mathlib/gen/h/Imakefile
deleted file mode 100644
index 0d608d6..0000000
--- a/src/mathlib/gen/h/Imakefile
+++ /dev/null
@@ -1,14 +0,0 @@
-SRCS_F= assndx.F dsmplx.F h101s1.F h101s2.F rsmplx.F
-
-FORTRANSAVEOPTION = FortranSaveFlags
-
-/* turn off optimsation, this is needed at least in h101s2, as this depends
- * critically on equality of floating numbers. GF.
- */
-FDEBUGFLAGS = NoOpFortranDebugFlags
-
-#if defined(CERNLIB_SGI)
-IMAKE_DEFINES=-DFortranDoesCpp=NO
-#endif
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/mathlib/gen/h/assndx.F b/src/mathlib/gen/h/assndx.F
deleted file mode 100644
index ce4a485..0000000
--- a/src/mathlib/gen/h/assndx.F
+++ /dev/null
@@ -1,168 +0,0 @@
-*
-* $Id: assndx.F,v 1.1.1.1 1996/04/01 15:02:49 mclareni Exp $
-*
-* $Log: assndx.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:49 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE ASSNDX(MODE,A,N,M,IDA,K,SUM,IW,IDW)
- LOGICAL LSW
- CHARACTER NAME*(*)
- CHARACTER*80 ERRTXT
- PARAMETER (NAME = 'ASSNDX')
-
- DIMENSION A(IDA,*),K(*),IW(IDW,*)
-
- IF(N .LT. 1 .OR. M .LT. 1) THEN
- WRITE(ERRTXT,101) N,M
- CALL MTLPRT(NAME,'H301.1',ERRTXT)
- RETURN
- ENDIF
- IMAX=MAX(N,M)
- IMIN=MIN(N,M)
- SUM=0
- IF(N .LE. M) THEN
- DO 1 I = 1,N
- RMIN=A(I,1)
- DO 2 J = 1,M
- 2 RMIN=MIN(RMIN,A(I,J))
- SUM=SUM+RMIN
- DO 3 J = 1,M
- 3 A(I,J)=A(I,J)-RMIN
- 1 CONTINUE
- ENDIF
- IF(N .GE. M) THEN
- DO 4 J = 1,M
- RMIN=A(1,J)
- DO 5 I = 1,N
- 5 RMIN=MIN(RMIN,A(I,J))
- SUM=SUM+RMIN
- DO 7 I = 1,N
- 7 A(I,J)=A(I,J)-RMIN
- 4 CONTINUE
- ENDIF
- DO 8 I = 1,IMAX
- K(I)=0
- 8 IW(I,1)=0
-
- DO 12 I = 1,N
- DO 13 J = 1,M
- IF(A(I,J)+IW(J,1) .EQ. 0) THEN
- K(I)=J
- IW(J,1)=I
- GO TO 12
- ENDIF
- 13 CONTINUE
- 12 CONTINUE
-
- 10 IFLAG=N
- IRL=0
- ICL=0
- IRS=1
-
- DO 11 I = 1,N
- IW(I,5)=0
- IF(K(I) .EQ. 0) THEN
- IRL=IRL+1
- IW(IRL,6)=I
- IW(I,5)=-1
- IFLAG=IFLAG-1
- ENDIF
- 11 CONTINUE
- IF(IFLAG .EQ. IMIN) THEN
- IF(MODE .EQ. 2) THEN
- DO 70 I = 1,IMAX
- 70 K(I)=IW(I,1)
- ENDIF
- RETURN
- ENDIF
-
- DO 14 J = 1,M
- 14 IW(J,4)=0
-
- 30 I=IW(IRS,6)
- IRS=IRS+1
- DO 31 J = 1,M
- IF(A(I,J)+IW(J,4) .EQ. 0) THEN
- IW(J,4)=I
- ICL=ICL+1
- IW(ICL,2)=J
- NEW=IW(J,1)
- IF(NEW .EQ. 0) THEN
- J1=J
- 61 IW(J1,1)=IW(J1,4)
- I=IW(J1,4)
- IF(K(I) .EQ. 0) THEN
- K(I)=J1
- GO TO 10
- ENDIF
- JSV=J1
- J1=K(I)
- K(I)=JSV
- GO TO 61
- ENDIF
- IRL=IRL+1
- IW(IRL,6)=NEW
- IW(NEW,5)=I
- ENDIF
- 31 CONTINUE
- IF(IRS .LE. IRL) GO TO 30
-
- LSW=.TRUE.
- ICL0=ICL
- ICBL=0
- DO 41 J = 1,M
- IF(IW(J,4) .EQ. 0) THEN
- ICBL=ICBL+1
- IW(ICBL,3)=J
- ENDIF
- 41 CONTINUE
- RMIN=A(IW(1,6),IW(1,3))
- DO 42 I = 1,IRL
- DO 42 J = 1,ICBL
- 42 RMIN=MIN(RMIN,A(IW(I,6),IW(J,3)))
- SUM=SUM+RMIN*(IRL+ICBL-IMAX)
-
- DO 44 I = 1,N
- IF(IW(I,5) .EQ. 0) THEN
- DO 49 IPP = 1,ICL0
- 49 A(I,IW(IPP,2))=A(I,IW(IPP,2))+RMIN
- GO TO 44
- ENDIF
- DO 45 IPP = 1,ICBL
- NEW=IW(IPP,3)
- A(I,NEW)=A(I,NEW)-RMIN
- IF(LSW .AND. A(I,NEW)+IW(NEW,4) .EQ. 0) THEN
- IW(NEW,4)=I
- IF(IW(NEW,1) .EQ. 0) THEN
- J1=NEW
- LSW=.FALSE.
- ELSE
- ICL=ICL+1
- IW(ICL,2)=NEW
- IRL=IRL+1
- IW(IRL,6)=IW(NEW,1)
- END IF
- END IF
- 45 CONTINUE
- 44 CONTINUE
- IF(LSW) THEN
- DO 51 I = ICL0+1,ICL
- 51 IW(IW(IW(I,2),1),5)=IW(I,2)
- GO TO 30
- ELSE
- 62 IW(J1,1)=IW(J1,4)
- I=IW(J1,4)
- IF(K(I) .EQ. 0) THEN
- K(I)=J1
- GO TO 10
- ENDIF
- JSV=J1
- J1=K(I)
- K(I)=JSV
- GO TO 62
- ENDIF
- 101 FORMAT('N = ',I5,' < 1 OR M = ',I5,' < 1')
- END
diff --git a/src/mathlib/gen/h/dsmplx.F b/src/mathlib/gen/h/dsmplx.F
deleted file mode 100644
index 4823c7d..0000000
--- a/src/mathlib/gen/h/dsmplx.F
+++ /dev/null
@@ -1,479 +0,0 @@
-*
-* $Id: dsmplx.F,v 1.1.1.1 1996/04/01 15:02:49 mclareni Exp $
-*
-* $Log: dsmplx.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:49 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- SUBROUTINE DSMPLX(A,B,C,Z0,IDA,M,M1,N,N1,LW,IDW,W,X,Z,ITYPE)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- SUBROUTINE RSMPLX(A,B,C,Z0,IDA,M,M1,N,N1,LW,IDW,W,X,Z,ITYPE)
-#endif
-#include "gen/imp64.inc"
-
- LOGICAL L1,L2,L3
- CHARACTER NAME*(*)
- CHARACTER*80 ERRTXT
-#if defined(CERNLIB_DOUBLE)
- PARAMETER (NAME = 'DSMPLX')
-#endif
-#if !defined(CERNLIB_DOUBLE)
- PARAMETER (NAME = 'RSMPLX')
-#endif
- PARAMETER (R10 = 10, IE0 = 15)
-
- DIMENSION A(IDA,*),B(*),C(*),W(*),X(*),LW(IDW,*)
-
- IF(M .LE. 0 .OR. N .LE. 0) THEN
- WRITE(ERRTXT,101) M,N
- CALL MTLPRT(NAME,'H101.1',ERRTXT)
- RETURN
- ENDIF
- IF(.NOT.(0 .LE. M1 .AND. M1 .LE. M .AND.
- 1 0 .LE. N1 .AND. N1 .LE. N)) THEN
- WRITE(ERRTXT,102) M,N,M1,N1
- CALL MTLPRT(NAME,'H101.2',ERRTXT)
- RETURN
- ENDIF
-
- EPS=0
- DO 5 I = 1,M
- DO 5 K = 1,N
- 5 EPS=EPS+ABS(A(I,K))
- EPSL=LOG10(2*EPS/(M*N))
- IEXP=INT(EPSL)-IE0
- IF(EPSL .LT. 0) IEXP=IEXP-1
- EPS=R10**IEXP
-
- Z=Z0
- DO 10 I = 1,M
- LW(I,1)=0
- IF(I .GT. M1) LW(I,1)=1
- 10 LW(I,4)=I
- DO 11 K = 1,N
- LW(K,2)=0
- IF(K .GT. N1) LW(K,2)=-1
- LW(K,5)=M+K
- 11 LW(K,3)=0
-
-C LW(I,1), LW(K,2) = 0 x >= 0
-C LW(I,1), LW(K,2) = -1 x = 0
-C LW(I,1), LW(K,2) = 1 x unrestricted
-C LW(I,1), LW(K,2) = 2 x linearly independent, no influence
-C LW(I,1) = -2 x unrestricted, cannot be eliminated
-
-C Elimination of the equality constraints from the basis
-
- IF(N1 .NE. N) THEN
- 55 KP=0
- DO 60 K = 1,N
- IF(LW(K,2) .EQ. -1) KP=K
- 60 CONTINUE
-
-C If KP = 0, no more equality constraints in the basis
-
- IF(KP .NE. 0) THEN
- DMAX=0
- DO 61 I = 1, M
- IF(LW(I,1) .NE. -1) THEN
- DMAX=MAX(ABS(A(I,KP)),DMAX)
- IF(ABS(A(I,KP)) .EQ. DMAX) IP=I
- ENDIF
- 61 CONTINUE
- IF(DMAX .LT. EPS) DMAX=0
- IF(DMAX .EQ. 0) THEN
- IF(ABS(C(KP)) .LT. EPS) C(KP)=0
- IF(C(KP) .EQ. 0) THEN
- LW(KP,2)=1
- GO TO 55
- ENDIF
- ITYPE=4
- GO TO 9
- ELSE
-
-C Homogeneous part of at least 2 equ. is linearly dependent
-C Inhomogeneous part is contradictory.
-
- CALL H101S1(A,B,C,Z,M,N,IDA,IP,KP,LW,IDW,EPS)
- LW(KP,2)=LW(IP,1)
- LW(IP,1)=-1
- GO TO 55
- ENDIF
- ENDIF
-
-C Non-basic variables only equation variables?
-
- IND=0
- DO 81 I = 1,M
- IF(LW(I,1) .NE. -1) IND=IND+1
- 81 CONTINUE
-
-C If non-basic variables only equation variables,
-C is constraint violated?
-
- IF(IND .EQ. 0) THEN
- DMIN=0
- DO 85 K = 1, N
- IF(LW(K,2) .NE. 1) THEN
- IF(ABS(C(K)) .LT. EPS) C(K)=0
- DMIN=MIN(C(K),DMIN)
- ENDIF
- 85 CONTINUE
- ITYPE=1
- IF(DMIN .LT. 0) ITYPE=4
- GO TO 9
- ENDIF
- ENDIF
-
-C Eliminate unrestricted variables
-
- IF(M1 .EQ. M) GO TO 200
- 111 IP=0
- DO 105 I = 1,M
- IF(LW(I,1) .EQ. 1) IP=I
- 105 CONTINUE
- IF(IP .EQ. 0) GO TO 200
-
-C If there are no free variables, or if they have been
-C exchanged with equations, go to 200.
-C Present tableau represents feasable initial solution?
-
- DMAX=0
- DMIN=0
- DO 110 K = 1, N
- IF(LW(K,2) .NE. 1) THEN
- IF(ABS(C(K)) .LT. EPS) C(K)=0
- DMIN=MIN(C(K),DMIN)
- DMAX=MAX(C(K),DMAX)
- ENDIF
- 110 CONTINUE
- IND=0
- IF(DMIN .GE. 0) IND=1
- Q=DMAX
-
-C If tableau represents an initial solution (IND = 1),
-C elimination of remaining unrestricted variables.
-
- DMAX=0
- DMIN=0
- DO 112 K = 1, N
- IF(LW(K,2) .NE. 1) THEN
- IF(ABS(A(IP,K)) .LT. EPS) A(IP,K)=0
- DMAX=MAX(A(IP,K),DMAX)
- IF(DMAX .EQ. A(IP,K)) KPMAX=K
- DMIN=MIN(A(IP,K),DMIN)
- IF(DMIN .EQ. A(IP,K)) KPMIN=K
- ENDIF
- 112 CONTINUE
- IF(DMAX .NE. 0 .OR. DMIN .NE. 0) THEN
- IF(IND .NE. 0) THEN
- IF(ABS(B(IP)) .LT. EPS) B(IP)=0
- IF(B(IP) .LT. 0 .AND. DMAX .GT. 0) THEN
- Q=Q/DMAX
- DO 150 K = 1,N
- IF(LW(K,2) .NE. 1 .AND. A(IP,K) .GT. 0) THEN
- QQ=C(K)/A(IP,K)
- Q=MIN(QQ,Q)
- IF(Q .EQ. QQ) KP=K
- ENDIF
- 150 CONTINUE
- ELSEIF(B(IP) .GT. 0 .AND. DMIN .LT. 0) THEN
- Q=Q/DMIN
- DO 170 K = 1,N
- IF(LW(K,2) .NE. 1 .AND. A(IP,K) .LT. 0) THEN
- QQ=C(K)/A(IP,K)
- Q=MAX(QQ,Q)
- IF(Q .EQ. QQ) KP=K
- ENDIF
- 170 CONTINUE
- ELSEIF(B(IP) .EQ. 0) THEN
- Q=Q/MAX(DMAX,ABS(DMIN))
- DO 190 K = 1,N
- IF(LW(K,2) .NE. 1 .AND. A(IP,K) .NE. 0) THEN
- QQ=ABS(C(K)/A(IP,K))
- Q=MIN(QQ,Q)
- IF(Q .EQ. QQ) KP=K
- ENDIF
- 190 CONTINUE
- ENDIF
- ELSE
- KP=KPMAX
- IF(DMAX .LT. ABS(DMIN)) KP=KPMIN
- ENDIF
- CALL H101S1(A,B,C,Z,M,N,IDA,IP,KP,LW,IDW,EPS)
- LW(KP,2)=1
- LW(IP,1)=0
- ELSE
-
-C If all pivot elements for free variable = 0, it has to
-C remain out of the basis (LW(.,1) = -2).
-
- LW(IP,1)=-2
- ENDIF
- GO TO 111
-
-C Feasable initial solution by mutiphase method.
-
- 200 IF(M1 .EQ. M .AND. N1 .EQ. N) GO TO 250
- KP=0
- DO 201 K = 1,N
- IF(LW(K,2) .EQ. 0) KP=KP+1
- 201 CONTINUE
- IF(KP .EQ. 0) THEN
- IP=0
- DO 202 I = 1,M
- IF(LW(I,1) .NE. -1) IP=IP+1
- 202 CONTINUE
- IF(IP .EQ. 0) THEN
- ITYPE=1
- GO TO 9
- ENDIF
-
- L1=.FALSE.
- L2=.FALSE.
- L3=.FALSE.
- DO 206 I = 1,M
- IF(LW(I,1) .NE. -1) THEN
- IF(ABS(B(I)) .LT. EPS) B(I)=0
- L1=LW(I,1) .EQ. 0 .AND. B(I) .GT. 0
- L2=LW(I,1) .EQ. 0 .AND. B(I) .EQ. 0
- L3=LW(I,1) .EQ. 0 .AND. B(I) .LT. 0
- L2=LW(I,1) .EQ. -2 .AND. B(I) .EQ. 0
- L3=LW(I,1) .EQ. -2 .AND. B(I) .NE. 0
- ENDIF
- 206 CONTINUE
- IF(L1) ITYPE=1
- IF(L2) ITYPE=2
- IF(L3) ITYPE=3
- GO TO 9
- ENDIF
-
-C Only unrestricted variables in the basis,
-C hence final tableau obtained.
-
- IP=0
- DO 211 I = 1,M
- IF(LW(I,1) .EQ. 0) IP=IP+1
- 211 CONTINUE
- IF(IP .NE. 0) GO TO 250
- DMIN=0
- DO 212 K = 1,N
- IF(LW(K,2) .NE. 1) THEN
- IF(ABS(C(K)) .LT. EPS) C(K)=0
- DMIN=MIN(C(K),DMIN)
- ENDIF
- 212 CONTINUE
- IF(DMIN .LT. 0) THEN
- ITYPE=4
- GO TO 9
- ENDIF
-
- IP=0
- DO 216 I = 1,M
- IF(LW(I,1) .EQ. -2) IP=IP+1
- 216 CONTINUE
- IF(IP .EQ. 0) THEN
- ITYPE=1
- GO TO 9
- ENDIF
-
- L2=.FALSE.
- L3=.FALSE.
- DO 225 I = 1,M
- IF(LW(I,1) .NE. -1) THEN
- IF(ABS(B(I)) .LT. EPS) B(I)=0
- L2=B(I) .EQ. 0
- L3=.NOT.L2
- ENDIF
- 225 CONTINUE
- IF(L2) ITYPE=2
- IF(L3) ITYPE=3
- GO TO 9
-
-C Variables out of the basis either unrestricted or 0,
-C they cannot be exchanged, hence final tableau obtained.
-C
-C Tableau representing initial solution?
-
- 250 DMIN=0
- DO 255 K = 1,N
- IF(LW(K,2) .NE. 1) THEN
- IF(ABS(C(K)) .LT. EPS) C(K)=0
- DMIN=MIN(C(K),DMIN)
- IF(C(K) .EQ. DMIN) KK=K
- ENDIF
- 255 CONTINUE
-
-C All C(K) for constraints X >= 0, hence initial solution found.
-C Otherwise column with index KK new objective function.
-
- IF(DMIN .LT. 0) THEN
- 270 DMIN=0
- DO 300 I = 1,M
- IF(LW(I,1) .EQ. 0) THEN
- IF(ABS(A(I,KK)) .LT. EPS) A(I,KK)=0
- DMIN=MIN(A(I,KK),DMIN)
- IF(A(I,KK) .EQ. DMIN) IP=I
- ENDIF
- 300 CONTINUE
- IF(DMIN .GE. 0) THEN
- ITYPE=4
- GO TO 9
- ENDIF
-
- CALL H101S2(A,B,C,M,N,IDA,IP,KP,KK,LW,IDW,W,X,EPS,0)
- IF(KP .EQ. 0) KP=KK
- CALL H101S1(A,B,C,Z,M,N,IDA,IP,KP,LW,IDW,EPS)
-
- IF(ABS(C(KK)) .LT. EPS) C(KK)=0
- IF(C(KK) .LT. 0) GO TO 270
- GO TO 250
- ENDIF
-
-C Initial solution found, hence algorithm may stop.
-C Maximum obtained?
-
- 500 KASE=0
- DO 510 I = 1,M
- IF(LW(I,1) .EQ. -2) THEN
- IF(ABS(B(I)) .LT. EPS) B(I)=0
- IF(B(I) .NE. 0) THEN
- ITYPE=3
- GO TO 9
- ENDIF
- KASE=1
- ENDIF
- 510 CONTINUE
-
-C KASE = 1: There is a free variable out of the basis
-C which does not influence the maximum (ITYPE = 2).
-C Take out negative B(I).
-
- IP=0
- DO 555 I = 1,M
- IF(LW(I,1) .EQ. 0) THEN
- IF(ABS(B(I)) .LT. EPS) B(I)=0
- IF(B(I) .LT. 0) IP=I
- ENDIF
- 555 CONTINUE
-
-C All B(I) non-negative, hence final tableau obtained
-C Solution unique?
-
- IF(IP .NE. 0) THEN
- CALL H101S2(A,B,C,M,N,IDA,IP,KP,0,LW,IDW,W,X,EPS,0)
- IF(KP .EQ. 0) THEN
- ITYPE=3
- GO TO 9
- ENDIF
- CALL H101S1(A,B,C,Z,M,N,IDA,IP,KP,LW,IDW,EPS)
- GO TO 500
- ENDIF
-
- IF(KASE .NE. 0) THEN
- ITYPE=2
- GO TO 9
- ENDIF
- IND=0
- DO 562 K = 1,N
- IF(LW(K,2) .EQ. 0) THEN
- IF(ABS(C(K)) .LT. EPS) C(K)=0
- IF(C(K) .EQ. 0) THEN
- IND=IND+1
- LW(K,2)=2
- ENDIF
- ENDIF
- 562 CONTINUE
- KASE=IND
- IND=0
- DO 565 I = 1,M
- IF(LW(I,1) .EQ. 0) THEN
- IF(ABS(B(I)) .LT. EPS) B(I)=0
- IF(B(I) .EQ. 0) THEN
- IND=IND+1
- LW(I,1)=2
- ENDIF
- ENDIF
- 565 CONTINUE
- IF(IND .EQ. 0) THEN
- ITYPE=1
- GO TO 9
- ELSEIF(KASE .EQ. 0) THEN
- ITYPE=2
- GO TO 9
- ENDIF
-
-C Some C(K) = 0 and some B(I) = 0 in the final tableau.
-C Solution unique?
-
- 575 DO 577 I = 1,M
- IF(LW(I,1) .EQ. 2) THEN
- DMAX=0
- DO 576 K = 1, N
- IF(LW(K,2) .EQ. 2) THEN
- IF(ABS(A(I,K)) .LT. EPS) A(I,K)=0
- DMAX=MAX(A(I,K),DMAX)
- ENDIF
- 576 CONTINUE
- IF(DMAX .LE. 0) THEN
- ITYPE=2
- GO TO 9
- ENDIF
- ENDIF
- 577 CONTINUE
- DO 581 K = 1,N
- IF(LW(K,2) .EQ. 2) THEN
- DMIN=1
- DO 578 I = 1,M
- IF(LW(I,1) .EQ. 2) DMIN=MIN(A(I,K),DMIN)
- 578 CONTINUE
- IF(DMIN .GT. 0) THEN
- ITYPE=1
- GO TO 9
- ELSEIF(DMIN .EQ. 0) THEN
- DO 580 I = 1, M
- IF(LW(I,1) .EQ. 2 .AND. A(I,K) .GT. 0) LW(I,1)=-2
- 580 CONTINUE
- LW(K,2)=1
- ENDIF
- ENDIF
- 581 CONTINUE
- NC=0
- DO 582 K = 1,N
- IF(LW(K,2) .EQ. 2) NC=NC+1
- 582 CONTINUE
- NR=0
- DO 583 I = 1,M
- IF(LW(I,1) .EQ. 2) THEN
- NR=NR+1
- IP=I
- ENDIF
- 583 CONTINUE
- IF(NR .EQ. 0 .OR. NC .EQ. 0) THEN
- ITYPE=1
- GO TO 9
- ENDIF
-
- CALL H101S2(A,B,C,M,N,IDA,IP,KP,0,LW,IDW,W,X,EPS,2)
-
- IF(KP .EQ. 0) THEN
- ITYPE=2
- GO TO 9
- ENDIF
-
- CALL H101S1(A,B,C,Z,M,N,IDA,IP,KP,LW,IDW,EPS)
- GO TO 575
-
- 9 DO 1 I = 1,M
- 1 X(LW(I,4))=0
- DO 2 K = 1,N
- 2 X(LW(K,5))=C(K)
- RETURN
- 101 FORMAT('M = ',I4,' OR N = ',I4,' ILLEGAL')
- 102 FORMAT('M = ',I4,', N = ',I4,': M1 = ',I4,' OR N1 = ',I4,
- 1 ' ILLEGAL')
- END
diff --git a/src/mathlib/gen/h/h101s1.F b/src/mathlib/gen/h/h101s1.F
deleted file mode 100644
index 2312ebc..0000000
--- a/src/mathlib/gen/h/h101s1.F
+++ /dev/null
@@ -1,65 +0,0 @@
-*
-* $Id: h101s1.F,v 1.1.1.1 1996/04/01 15:02:49 mclareni Exp $
-*
-* $Log: h101s1.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:49 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE H101S1(A,B,C,Z,M,N,IDA,IP,KP,LW,IDW,EPS)
-
-#include "gen/imp64.inc"
-
- DIMENSION A(IDA,*),B(*),C(*),LW(IDW,*)
-
- PARAMETER (R10 = 10, IE0 = 15)
-
-C Exchanges a basic with a non-basic variable and transforms
-C the whole tableau
-
- A(IP,KP)=1/A(IP,KP)
- DO 1 I = 1,M
- IF(I .NE. IP) A(I,KP)=A(I,KP)*A(IP,KP)
- 1 CONTINUE
- C(KP)=C(KP)*A(IP,KP)
- DO 3 I = 1,M
- IF(I .NE. IP) THEN
- DO 2 K = 1,N
- IF(K .NE. KP) A(I,K)=A(I,K)-A(IP,K)*A(I,KP)
- 2 CONTINUE
- B(I)=B(I)-B(IP)*A(I,KP)
- ENDIF
- 3 CONTINUE
- DO 4 K = 1,N
- IF(K .NE. KP) THEN
- C(K)=C(K)-A(IP,K)*C(KP)
- A(IP,K)=-A(IP,K)*A(IP,KP)
- ENDIF
- 4 CONTINUE
- Z=Z-B(IP)*C(KP)
- B(IP)=-B(IP)*A(IP,KP)
-
- EPS=0
- DO 5 I = 1,M
- DO 5 K = 1,N
- 5 EPS=EPS+ABS(A(I,K))
- EPSL=LOG10(2*EPS/(M*N))
- IEXP=INT(EPSL)-IE0
- IF(EPSL .LT. 0) IEXP=IEXP-1
- EPS=R10**IEXP
-
- DO 10 I = 1,M
- IF(ABS(B(I)) .LT. EPS) B(I)=0
- DO 10 K = 1,N
- IF(ABS(A(I,K)) .LT. EPS) A(I,K)=0
- 10 CONTINUE
- DO 25 K = 1,N
- IF(ABS(C(K)) .LT. EPS) C(K)=0
- 25 CONTINUE
- IF(ABS(Z) .LT. EPS) Z=0
- IR=LW(IP,4)
- LW(IP,4)=LW(KP,5)
- LW(KP,5)=IR
- RETURN
- END
diff --git a/src/mathlib/gen/h/h101s2.F b/src/mathlib/gen/h/h101s2.F
deleted file mode 100644
index 9a4b5c1..0000000
--- a/src/mathlib/gen/h/h101s2.F
+++ /dev/null
@@ -1,104 +0,0 @@
-*
-* $Id: h101s2.F,v 1.1.1.1 1996/04/01 15:02:49 mclareni Exp $
-*
-* $Log: h101s2.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:49 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE H101S2(A,B,C,M,N,IDA,IP,KP,KK,LW,IDW,W,X,EPS,IRC)
-
-#include "gen/imp64.inc"
-
- DIMENSION A(IDA,*),B(*),C(*),X(*),W(*),LW(IDW,*)
-
-C Finds the pivot-column, by taking degeneracy into account.
-C Columns with C(K) >= 0 and A(IP,K) > 0: LW(.,3) = 1
-
- DO 1 K = 1,N
- 1 LW(K,3)=0
- DO 5 K = 1,N
- IF(LW(K,2) .EQ. IRC .AND. K .NE. KK) THEN
- IF(ABS(A(IP,K)) .LT. EPS) A(IP,K)=0
- IF(ABS(C(K)) .LT. EPS) C(K)=0
- IF(A(IP,K) .GT. 0 .AND. C(K) .GE. 0) THEN
- LW(K,3)=1
- Q=C(K)/A(IP,K)
- ENDIF
- ENDIF
- 5 CONTINUE
- KP=0
- DO 6 K = 1,N
- 6 KP=KP+LW(K,3)
- IF(KP .EQ. 0) RETURN
-
-C KP = 0 : No column found.
-C Only columns with minimum quotient: LW(.,3) = 1.
-
- DMIN=Q
- DO 11 J = 1,2
- DO 11 K = 1,N
- IF(LW(K,3) .NE. 0) THEN
- Q=C(K)/A(IP,K)
- IF(Q .LE. DMIN) THEN
- DMIN=Q
- KP=K
- GO TO 11
- ENDIF
- LW(K,3)=0
- ENDIF
- 11 CONTINUE
-
- 12 IND=0
- DO 15 K = 1,N
- 15 IND=IND+LW(K,3)
- IF(IND .EQ. 1) RETURN
-
-C Two possible columns are picked out
-
- KP1=0
- DO 20 K = 1,N
- IF(LW(K,3) .NE. 0) THEN
- IF(KP1 .EQ. 0) KP1=K
- KP2=K
- ENDIF
- 20 CONTINUE
-
-C Choose pivot column from two columns with equal quotient.
-
- DO 25 J = 1,M+N
- X(J)=0
- 25 W(J)=0
- X(LW(KP1,5))=1
- W(LW(KP2,5))=1
- DO 30 I = 1,M
- IF(LW(I,1) .EQ. IRC) THEN
- IF(ABS(A(I,KP1)) .LT. EPS) A(I,KP1)=0
- IF(ABS(A(I,KP2)) .LT. EPS) A(I,KP2)=0
- X(LW(I,4))=A(I,KP1)
- W(LW(I,4))=A(I,KP2)
- ENDIF
- 30 CONTINUE
- DO 35 J = 1,M+N
- IF(J .EQ. LW(IP,4)) THEN
- X(J)=1
- W(J)=1
- ELSE
- X(J)=X(J)/A(IP,KP1)
- W(J)=W(J)/A(IP,KP2)
- ENDIF
- 35 CONTINUE
- DO 50 J = 1,M+N
- IF(X(J) .LT. W(J)) THEN
- LW(KP2,3)=0
- KP=KP1
- GO TO 12
- ELSEIF(X(J) .GT. W(J)) THEN
- LW(KP1,3)=0
- KP=KP2
- GO TO 12
- ENDIF
- 50 CONTINUE
- RETURN
- END
diff --git a/src/mathlib/gen/h/rsmplx.F b/src/mathlib/gen/h/rsmplx.F
deleted file mode 100644
index 75cfbfa..0000000
--- a/src/mathlib/gen/h/rsmplx.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: rsmplx.F,v 1.1.1.1 1996/04/01 15:02:49 mclareni Exp $
-*
-* $Log: rsmplx.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:49 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- SUBROUTINE RSMPLX(A,B,C,Z0,IDA,M,M1,N,N1,LW,IDW,W,X,Z,ITYPE)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- SUBROUTINE DSMPLX(A,B,C,Z0,IDA,M,M1,N,N1,LW,IDW,W,X,Z,ITYPE)
-#endif
-
- CHARACTER NAME*(*)
-#if defined(CERNLIB_DOUBLE)
- PARAMETER (NAME = 'RSMPLX')
-#endif
-#if !defined(CERNLIB_DOUBLE)
- PARAMETER (NAME = 'DSMPLX')
-#endif
- CALL MTLPRT(NAME,'H101.0','NOT AVAILABLE IN THIS MACHINE')
- RETURN
- END
diff --git a/src/mathlib/gen/history/gent/iguide.dat b/src/mathlib/gen/history/gent/iguide.dat
deleted file mode 100644
index b679e82..0000000
--- a/src/mathlib/gen/history/gent/iguide.dat
+++ /dev/null
@@ -1,102 +0,0 @@
-*
-* $Id: iguide.dat,v 1.1.1.1 1996/04/01 15:01:43 mclareni Exp $
-*
-* $Log: iguide.dat,v $
-* Revision 1.1.1.1 1996/04/01 15:01:43 mclareni
-* Mathlib gen
-*
-*
- -------------------------------------------------------------------
- Please refer to the corresponding Installation Guide in INSTALL PAM
- -------------------------------------------------------------------
-
- GENLIB TEST SUITE HELP SHEET T Hepworth 90.08.23
-
-This sheet is intended to aid in the addition of further test programs to
-the Genlib test suite.
-It is assumed that a fortran test program has been written and is then
-converted into patchy form following the following programming
-conventions:
-
- CONVENTIONS USED INSIDE A TEST PROGRAM
-
- Patchy flag DOUBLE is set when a 32-bit machine is being used.
- Patchy flag -DOUBLE is set when a 64-bit machine is being used.
- Patchy flag -CMPXDOUB is used to avoid compiler errors caused by
- source code of the type: COMPLEX Z { see code for }
- DATA Z / (1D0,2D0)/ {further examples}
-
- Usually in a test, many individual function values are calculated by
- the routines under test, and these values are compared with analytical
- values which are stored inside data statements, inside the test
- program. Individual errors are calculated (either absolute errors or
- absolute relative errors), and the error of largest magnitude is
- found using the following code sequence:
-
- ERRMAX=0
- DO 100 I=1,NT
- .
- .
- SOL(I)= Approximate function value for Ith set of parameters
- { ERROR(I)= ABS( SOL(I)-EXACT(I) ) {for absolute errors}
- { ERROR(I)= ABS( (SOL(I)-EXACT(I))/SOL(I) ) {for relative errors}
- ERRMAX= MAX( ERRMAX,ERROR(I) )
-100 CONTINUE
-
- Since the calculated errors are always positive, ERRMAX will contain
- the modulus of the largest error, which will, hopefully, be small.
- The success of the test can then be assessed by using just one
- comparison, viz, (ERRMAX .LE. TSTERR), where TSTERR is an
- accuracy parameter. If this logical value is .TRUE. then the test was
- successful, else the test failed.
-
-
- CONVERTING A FORTRAN FILE TO THE REQUIRED CARD FORMAT
-
- For a Program/Subroutine which tests the routine "code", the following
- format is used:
-
- +PATCH,code.
- +DECK,codeM.
- SUBROUTINE codeM
- +SELF
- : :
- : :
- [ +SEQ,IMP64,IF=DOUBLE. ] {optional replacement of source}
- {line "IMPLICIT DOUBLE PRECISION (A-H,O-Z)"}
- : :
- Variable declarations
- : :
- +CDE,IORC {stores common variable LOUT, the output channel number}
- : :
- End of non-executables
- CALL HEADER('code',modep) {print a page heading}
- : :
- : :
- Test source
- : :
- : :
- IRC= ITEST('code',ERRMAX .LE. TSTERR) {test success of test}
- CALL PAGEND('code') { print page ending }
- RETURN
- END
-
- References to the terminal output channel 6 should also be changed
- to channel LOUT ...eg WRITE(6,*) X becomes WRITE(LOUT,*) X
-
-
- INTRODUCING A NEW TEST PROGRAM TO THE SUITE
-
- With a test program in the above patchy form:
-
- 1) Insert "+USE,code." in the patch SGENT.
- 2) Insert the lines "+SELF,IF=code. "
- " CALL codeM" in the patch A000.
- 3) Insert the cards file for the test, after the end of DECK,PAGEND.
- preferably in the correct alphabetical order.
-
-
-** Note that code refers to the four letter routine name eg B100,C343
-
-A line commented with C*NS means a variable was declared but not supplied
-A line commented with C*RC means this line contains redundant code
diff --git a/src/mathlib/gen/history/gent/v000.dat b/src/mathlib/gen/history/gent/v000.dat
deleted file mode 100644
index c52c9aa..0000000
--- a/src/mathlib/gen/history/gent/v000.dat
+++ /dev/null
@@ -1,13 +0,0 @@
-*
-* $Id: v000.dat,v 1.1.1.1 1996/04/01 15:01:43 mclareni Exp $
-*
-* $Log: v000.dat,v $
-* Revision 1.1.1.1 1996/04/01 15:01:43 mclareni
-* Mathlib gen
-*
-*
-
-Modifications log: history sorted upwards (*=current version)
-________________________________________________________________________
- Version Mods Date PL-code Comments
-________________________________________________________________________
diff --git a/src/mathlib/gen/history/gent/v100.dat b/src/mathlib/gen/history/gent/v100.dat
deleted file mode 100644
index 32baa2f..0000000
--- a/src/mathlib/gen/history/gent/v100.dat
+++ /dev/null
@@ -1,9 +0,0 @@
-*
-* $Id: v100.dat,v 1.1.1.1 1996/04/01 15:01:43 mclareni Exp $
-*
-* $Log: v100.dat,v $
-* Revision 1.1.1.1 1996/04/01 15:01:43 mclareni
-* Mathlib gen
-*
-*
- 1.00 T.Hepworth 91/02/11 First release of the code
diff --git a/src/mathlib/gen/history/gent/v101.dat b/src/mathlib/gen/history/gent/v101.dat
deleted file mode 100644
index b587984..0000000
--- a/src/mathlib/gen/history/gent/v101.dat
+++ /dev/null
@@ -1,9 +0,0 @@
-*
-* $Id: v101.dat,v 1.1.1.1 1996/04/01 15:01:43 mclareni Exp $
-*
-* $Log: v101.dat,v $
-* Revision 1.1.1.1 1996/04/01 15:01:43 mclareni
-* Mathlib gen
-*
-*
-* 1.01 M.Marquina 91/06/29 G110 LANDAU Protect against sol=0.
diff --git a/src/mathlib/gen/history/gent/v102.dat b/src/mathlib/gen/history/gent/v102.dat
deleted file mode 100644
index 1c13f6c..0000000
--- a/src/mathlib/gen/history/gent/v102.dat
+++ /dev/null
@@ -1,15 +0,0 @@
-*
-* $Id: v102.dat,v 1.1.1.1 1996/04/01 15:01:44 mclareni Exp $
-*
-* $Log: v102.dat,v $
-* Revision 1.1.1.1 1996/04/01 15:01:44 mclareni
-* Mathlib gen
-*
-*
- 1.02 L.Roberts 92/03/16 C327 BSIR4 Relax accuracy check
- M.Marquina 92/03/18 Set VERBOSE the default
- mode for individual tests
- V100 RANNOR Add tests for RN generators
- V101 NORRAN Add tests for RN generators
- V106 RN32 using the VECDRAW routine
- V110 POISSN
diff --git a/src/mathlib/gen/history/gent/v103.dat b/src/mathlib/gen/history/gent/v103.dat
deleted file mode 100644
index 5e92dc6..0000000
--- a/src/mathlib/gen/history/gent/v103.dat
+++ /dev/null
@@ -1,10 +0,0 @@
-*
-* $Id: v103.dat,v 1.1.1.1 1996/04/01 15:01:44 mclareni Exp $
-*
-* $Log: v103.dat,v $
-* Revision 1.1.1.1 1996/04/01 15:01:44 mclareni
-* Mathlib gen
-*
-*
- 1.03 B.Damgaard 92/07/14 Add new tests
- M.Marquina 92/07/19 Add IPSC, MSDOS flags
diff --git a/src/mathlib/gen/history/gent/v104.dat b/src/mathlib/gen/history/gent/v104.dat
deleted file mode 100644
index 5e5b8c2..0000000
--- a/src/mathlib/gen/history/gent/v104.dat
+++ /dev/null
@@ -1,43 +0,0 @@
-*
-* $Id: v104.dat,v 1.1.1.1 1996/04/01 15:01:44 mclareni Exp $
-*
-* $Log: v104.dat,v $
-* Revision 1.1.1.1 1996/04/01 15:01:44 mclareni
-* Mathlib gen
-*
-*
-* G.Folger 93/09/08 Changes for LINUX
-* 1.04 G.Folger 93/06/03 Changes for LINUX/MSDOS
-C B.Damgaard 93/05/24 Add D503 test
-C B.Damgaard 93/03/08 Add -VAX flags in C331
-C B.Damgaard 93/02/20 Revise D104
-C B.Damgaard 93/01/26 Introduce NOQUAD/QUAD flags
-C B.Damgaard 92/12/14 Revise C344
-C B.Damgaard 92/12/11 Revise C343
-C B.Damgaard 92/12/09 Revise tests and introduce
-C test for B300.
-C B.Damgaard 92/12/07 Revise tests
-C B.Damgaard 92/11/27 Revise tests
-C B.Damgaard 92/11/13 Introduce C302Q (rev C302M)
-C B.Damgaard 92/11/04 Revise test C321M
-C B.Damgaard Corrections at C313M
-C B.Damgaard 92/11/03 Corrections for -DOUBLE
-C B.Damgaard 92/10/28 Disable D103Q on IBMRS
-C until solved the problem.
-C B.Damgaard 92/10/27 Introduce IMP128 sequence
-C introduce test for GAUSS128 (QGAUSS or DGAUSS for CRAY and alike)
-C and introduce G2S in this test like G1S in the previous to avoid
-C problems on the IBM6000.
- B.Damgaard 92/10/25 Introduce QIEEE flags
- B.Damgaard 92/10/19 Improve DEF128, DEFC64
-C and IMPC64 sequence definitions
- B.Damgaard 92/10/09 Avoid underflows in C333M
- B.Damgaard 92/10/07 Revise tests
- B.Damgaard 92/08/20 Correct GTOPEN for IBM-6000
- B.Damgaard 92/08/24 Revise tests
- B.Damgaard 92/08/24
-C Introduce F90 flag to mark f90-specific code
-C Introduce GCMPFUN sequence to represent generic complex functions.
-C Introduce IMPC64, DEF64, DEF128, and DEFC64 sequences
- B.Damgaard 92/08/24 Correct DATA EXACT(5) in
-C C330M.
diff --git a/src/mathlib/gen/history/gent/v105.dat b/src/mathlib/gen/history/gent/v105.dat
deleted file mode 100644
index 1135b21..0000000
--- a/src/mathlib/gen/history/gent/v105.dat
+++ /dev/null
@@ -1,14 +0,0 @@
-*
-* $Id: v105.dat,v 1.1.1.1 1996/04/01 15:01:44 mclareni Exp $
-*
-* $Log: v105.dat,v $
-* Revision 1.1.1.1 1996/04/01 15:01:44 mclareni
-* Mathlib gen
-*
-*
-* 1.05 G.Folger 93/12/17 G115 Patch G115 introduced
-* G116 Patch G116 introduced
-* 94/02/01 E408 New
-* G.Folger 94/03/09 C206 de-activate
-* G.Folger 94/03/09 C317 de-activate
-* G.Folger 94/03/09 C333 de-activate
diff --git a/src/mathlib/gen/history/gent/v106.dat b/src/mathlib/gen/history/gent/v106.dat
deleted file mode 100644
index 648fc24..0000000
--- a/src/mathlib/gen/history/gent/v106.dat
+++ /dev/null
@@ -1,10 +0,0 @@
-*
-* $Id: v106.dat,v 1.1.1.1 1996/04/01 15:01:44 mclareni Exp $
-*
-* $Log: v106.dat,v $
-* Revision 1.1.1.1 1996/04/01 15:01:44 mclareni
-* Mathlib gen
-*
-*
-* 1.06 G.Folger 94/08/31 Many Decks corrected;
-* Corrections given by Lynn Garren
diff --git a/src/mathlib/gen/history/gent/v107.dat b/src/mathlib/gen/history/gent/v107.dat
deleted file mode 100644
index 4840c51..0000000
--- a/src/mathlib/gen/history/gent/v107.dat
+++ /dev/null
@@ -1,9 +0,0 @@
-*
-* $Id: v107.dat,v 1.1.1.1 1996/04/01 15:01:44 mclareni Exp $
-*
-* $Log: v107.dat,v $
-* Revision 1.1.1.1 1996/04/01 15:01:44 mclareni
-* Mathlib gen
-*
-*
-* 1.07 J.Shiers 94/09/30 V135-V138 added
diff --git a/src/mathlib/gen/history/gent/v108.dat b/src/mathlib/gen/history/gent/v108.dat
deleted file mode 100644
index 09b6d51..0000000
--- a/src/mathlib/gen/history/gent/v108.dat
+++ /dev/null
@@ -1,13 +0,0 @@
-*
-* $Id: v108.dat,v 1.1.1.1 1996/04/01 15:01:43 mclareni Exp $
-*
-* $Log: v108.dat,v $
-* Revision 1.1.1.1 1996/04/01 15:01:43 mclareni
-* Mathlib gen
-*
-*
-C Deletions:
-C ----------
-C
-C D115 deactivated corresponding to deletion of routine from MATHLIB
-C
diff --git a/src/mathlib/gen/history/gent/v109.dat b/src/mathlib/gen/history/gent/v109.dat
deleted file mode 100644
index 5890bb7..0000000
--- a/src/mathlib/gen/history/gent/v109.dat
+++ /dev/null
@@ -1,13 +0,0 @@
-*
-* $Id: v109.dat,v 1.1.1.1 1996/04/01 15:01:43 mclareni Exp $
-*
-* $Log: v109.dat,v $
-* Revision 1.1.1.1 1996/04/01 15:01:43 mclareni
-* Mathlib gen
-*
-*
-C
-C 95/05/04 - Modified test for V136 RNPSSN (S. Kolbig)
-C 95/02/18 - relax tolerance for VAXVMS E408M (L. Garren)
-C 95/02/18 - relax tolerance for V135M (L. Garren)
-C
diff --git a/src/mathlib/gen/history/v100129.dat b/src/mathlib/gen/history/v100129.dat
deleted file mode 100644
index 3dc3b68..0000000
--- a/src/mathlib/gen/history/v100129.dat
+++ /dev/null
@@ -1,429 +0,0 @@
-*
-* $Id: v100129.dat,v 1.1.1.1 1996/04/01 15:01:42 mclareni Exp $
-*
-* $Log: v100129.dat,v $
-* Revision 1.1.1.1 1996/04/01 15:01:42 mclareni
-* Mathlib gen
-*
-*
-* Previous versions
-C CHANGES FROM 1.28 :
-C IBMVF PATCH ADDED TO EXTRACT VECTOR VERSION OF THE LIBRARY
-C FOR IBM VECTOR FACILITIES
-C
-C B100 BINOM NEW ROUTINES INTRODUCED
-C C206 POLY2 MINOR CLEAN-UP OF THE CODE
-C C328 CWHITM MONIR MODIFICATION OF FORMAT STATEMENT
-C C331 FCONC NEW ROUTINE INTRODUCED
-C C333 CLOGAM MINOR MODIFICATION OF FORMAT STATEMENT
-C C335 CWERF MINOR MODIFICATION OF THE CODE FOR NORD
-C C344 CBSJA NORD FLAG INTRODUCED
-C D101 SIMPS NORD FLAG INTRODUCED
-C D105 TRIINT NORD FLAG INTRODUCED
-C D110 RGMLT NORD FLAG INTRODUCED
-C D113 CGAUSS MINOR MODIFICATION OF THE CODE FOR NORD
-C D151 DIVON4 SMALL CORRECTION FOR THE VAX
-C D201 DEQBS NEW ROUTINE INTRODUCED
-C D202 DEQMR NEW ROUTINE INTRODUCED
-C D207 BULSTO OBSOLETED USE D201 DEQBS
-C D208 MERSON OBSOLETED (USE D201 DEQBS D202 DEQMR)
-C D400 NUMDI1 OBSOLETED (USE D401 DERIV)
-C D401 DERIV NEW ROUTINE INTRODUCED
-C F101 MATIN2 OBSOLETED (USE F010 RINV, F011 RFACT)
-C F103 MATRIX OBSOLETED (USE F003, F004, F010, F011)
-C F220 EISPAK INHIBITED FOR CRAY - CRAY SCILIB ROUTINES
-C F301 DET OBSOLETE ROUTINE DELETED FROM SOURCE AND BINARY
-C F401 LINEQ1 OBSOLETE ROUTINE DELETED FROM SOURCE AND BINARY
-C F402 LINEQ2 OBSOLETE ROUTINE DELETED FROM SOURCE AND BINARY
-C F404 TRIDIA OBSOLETE ROUTINE DELETED FROM SOURCE AND BINARY
-C F405 LINSYS OBSOLETE ROUTINE DELETED FROM SOURCE AND BINARY
-C F413 CMLIN OBSOLETE ROUTINE DELETED FROM SOURCE AND BINARY
-C F500 LIHOIN DOUBLE PRECISION VERSION DLHOIN ADDED
-C G105 GAUSIN NORD FLAG INTRODUCED
-C H100 SIMPLE MINOR CLEAN-UP OF THE CODE
-C I303 RDWORD SMALL BUGS CORRECTED
-C J500 WHISTO OBSOLETE ROUTINE DELETED FROM SOURCE AND BINARY
-C J501 PLOTXY OBSOLETE ROUTINE DELETED FROM SOURCE AND BINARY
-C J503 STAP OBSOLETE ROUTINE DELETED FROM SOURCE AND BINARY
-C M108 SORTMQ OBSOLETED (USE M109 SORTRQ)
-C M109 SORTRQ NEW ROUTINES INTRODUCED
-C M216 GETWI MINOR BUG FIX FOR CDC$A4
-C U500 DSMALL OBSOLETED (USE U501 DJMNB)
-C U501 DJMNB NEW ROUTINES INTRODUCED
-C V101 NORRAN CODE CHANGES FOR XA COMPATIBILITY
-C V106 RN32 BUG CORRECTED IN CRAY VERSION
-C V108 RG32 BUG CORRECTED IN CRAY VERSION + MOD FOR VAX
-C V110 POISSN USE RANNOR ON ALL MACHINES + CHANGES FOR CRAY
-C V200 KBINOM OBSOLETED (USE B100 BINOM)
-C X203 PAROFI OBSOLETED
-C Z210 EXCPRD OBSOLETED (USE FORTRAN I/O OR IOPACK)
-C
-C CHANGES FROM 1.27 :
-C A401 IDENZB OBSOLETED (USE FORTRAN BITS MANIPULATION FUNCTIONS)
-C C301 GAUSIN RE-WRITTEN AND RE-ISSUED AS G105
-C D102 GAUSS1 OBSOLETED (USE D103 GAUSS OR D110 RGMLT)
-C D110 RGMLT NEW PACKAGE INTRODUCED
-C D112 RGAUSS OBSOLETED (USE D110 RGMLT)
-C F104 SYMINV OBSOLETE PACKAGE DELETED FROM SOURCE AND BINARY
-C F108 MUXMAC OBSOLETE PACKAGE DELETED FROM SOURCE AND BINARY
-C F119 DIST OBSOLETE PACKAGE DELETED FROM SOURCE AND BINARY
-C F122 MATRED OBSOLETE PACKAGE DELETED FROM SOURCE AND BINARY
-C F123 CMXPAK OBSOLETE PACKAGE DELETED FROM SOURCE AND BINARY
-C F124 CXJOIN OBSOLETE PACKAGE DELETED FROM SOURCE AND BINARY
-C G105 GAUSIN RE-ISSUE OF C301 GAUSIN
-C J511 MAP VAX VERSION ADDED
-C
-C CHANGES FROM 1.26 :
-C C306 CGAMMA CRAY AND CDC VERSIONS INTRODUCED
-C C307 CDIGAM MINOR CORRECTION TO FORMAT STATEMENT
-C V101 NORRAN CRAY AND ALLIANT VERSIONS INTRODUCED
-C V107 RNDM2 APOLLO AND ALLIANT VERSIONS INTRODUCED
-C
-C CHANGES FROM 1.25 :
-C C201 DDVETA REMOVED
-C C303 COMBES REMOVED
-C C316 COUL1 REMOVED
-C C325 WHIT REMOVED
-C C326 COUL2 REMOVED
-C D100 ARSIMP REMOVED
-C
-C THE FOLLOWING ARE NOW CONSIDERED OBSOLETE
-C AND WILL EVENTUALLY BE DELETED:
-C C311 LEGFN BETTER VERSION WILL BE PROVIDED IN FUTURE
-C F104 SYMINV TO BE REPLACED BY F010 RINV
-C F108 MUXMAC TO BE REPLACED BY F004 RMMLT
-C F119 DIST TO BE REPLACED BY IN LINE CODE
-C F122 MATRED TO BE REPLACED BY INLINE CODE
-C F123 CMXPAK TO BE REPLACED BY F004 RMMLT
-C F124 CXJOIN USED BY F123
-C F301 DET TO BE REPLACED BY F011 RFACT
-C F401 LINEQ1 TO BE REPLACED BY F011 RFACT
-C F402 LINEQ2 TO BE REPLACED BY F011 RFACT
-C F404 TRIDIA TO BE REPLACED BY F406 RBEQN
-C F405 LINSYS TO BE REPLACED BY F011 RFACT
-C F413 CMLIN TO BE REPLACED BY F011 RFACT
-C J500 WHISTO TO BE REPLACED BY Y250 HBOOK
-C J501 PLOTXY TO BE REPLACED BY Y250 HBOOK
-C J503 STAP TO BE REPLACED BY Y250 HBOOK
-C J504 HIST TO BE REPLACED BY Y250 HBOOK
-C J507 HISTO TO BE REPLACED BY Y250 HBOOK
-C M412 AFROMI TO BE REPLACED BY M431 IFROMC
-C M413 BCDWD REFERENCES M412
-C M414 IDIGIT REFERENCES M412
-C
-C MINOR CORRECTION TO THE USES PATCH
-C
-C CHANGES FROM 1.24 :
-C C100 POLY REMOVED
-C C302 BESSEL REMOVED
-C C309 FRECS REMOVED
-C C310 CRAGAM REMOVED
-C C315 ALEGF REMOVED
-C C338 FERDIR REMOVED
-C D110 GPINSP REMOVED
-C E400 ECTRAN REMOVED
-C G112 FUNLAN REMOVED
-C G903 GENLAN REMOVED
-C C333 WLOGAM MINOR FORMAT BUG FIXED
-C
-C NEW PACKAGES INTRODUCED:
-C
-C C309 CCLBES COULOMB WAVE FUNCTIONS AND BESSEL FUNCTIONS FOR
-C COMPLEX ARGUMENTS AND ORDER (ADAPTED FROM I.J.THOMPSON
-C AND A.R.BARNET (NO APOLLO VERSION)
-C C328 CWHITM WHITTAKER FUNCTION FOR COMPLEX ARGUMENT AND INDICES
-C (NO APOLLO VERSION)
-C C207 RTEQ3 SOLUTION FOR AN EQUATION OF 3RD DEGREE
-C (NO APOLLO VERSION)
-C C208 RTEQ4 SOLUTION FOR AN EQUATION OF 4RD DEGREE
-C (NO APOLLO VERSION)
-C D107 TRIINT INTEGRATION OVER A TRIANGLE
-C D101 SIMPS INTEGRAL ACCORDING TO SIMPSON'S RULE
-C
-C THE FOLLOWING ARE NOW CONSIDERED OBSOLETE
-C AND WILL EVENTUALLY BE DELETED:
-C C201 DDVETA TO BE REPLACED BY RTEQ3
-C C303 COMBES TO BE REPLACED BY CCLBES
-C C316 COUL1 TO BE REPLACED BY CCLBES
-C C325 WHIT TO BE REPLACED BY CWHITM
-C C326 COUL2 TO BE REPLACED BY CCLBES
-C D100 ARSIMP TO BE REPLACED BY SIMPS
-C
-C CHANGES FROM 1.23 :
-C C306 CGAMMA MINOR RESTRUCTURING FOR STANDARD CONFORMANCE
-C C307 CDIGAM MINOR RESTRUCTURING FOR STANDARD CONFORMANCE
-C C333 CLOGAM MINOR RESTRUCTURING FOR STANDARD CONFORMANCE
-C Z009 CALDAT BUG FIXED IN JULIAN DATE CALCULATION
-C
-C CHANGES FROM 1.22 :
-C C306 CGAMMA REWRITTEN IN F77 WITH HIGHER PRECISION ENTRIES
-C C307 CDIGAM REWRITTEN IN F77 WITH HIGHER PRECISION ENTRIES
-C C317 ADIGAM REWRITTEN IN F77 WITH HIGHER PRECISION ENTRIES
-C C322 FRSIN NEW FRESNEL INTEGRAL PACKAGE (F77 ONLY)
-C C323 FERDR NEW FERMI-DIRAC FUNCTIONS (F77 ONLY)
-C C324 ATANI NEW ARCTANGENT INTEGRAL PACKAGE (F77 ONLY)
-C C327 BESIN OBSOLETE PACKAGE DELETED FROM SOURCE
-C C327 BSIR4 NEW BESSEL FUNCTION PACKAGE (F77 ONLY)
-C C328 BESJN OBSOLETE PACKAGE DELETED FROM SOURCE
-C C329 DBESIN OBSOLETE PACKAGE DELETED FROM SOURCE
-C C330 DBESJN OBSOLETE PACKAGE DELETED FROM SOURCE
-C C330 ASLGF NEW LEGENDRE FUNCTION PACKAGE (F77 ONLY)
-C C331 BESCJ OBSOLETE PACKAGE DELETED FROM SOURCE
-C C332 DBESCJ OBSOLETE PACKAGE DELETED FROM SOURCE
-C C333 CLOGAM REWRITTEN IN F77 WITH HIGHER PRECISION ENTRIES
-C C335 CWERF REWRITTEN IN F77 WITH HIGHER PRECISION ENTRIES
-C C339 DAWSON REWRITTEN IN F77 WITH HIGHER PRECISION ENTRIES
-C C340 BSIR3 REWRITTEN IN F77 WITH HIGHER PRECISION ENTRIES
-C C342 STRH0 REWRITTEN IN F77 WITH HIGHER PRECISION ENTRIES
-C D113 CGAUSS REWRITTEN IN F77 WITH HIGHER PRECISION ENTRIES
-C E402 CHSUM1 OBSOLETE PACKAGE DELETED FROM SOURCE
-C E403 CHSUM2 OBSOLETE PACKAGE DELETED FROM SOURCE
-C E404 CHCOF1 OBSOLETE PACKAGE DELETED FROM SOURCE
-C E405 CHECOF OBSOLETE PACKAGE DELETED FROM SOURCE
-C I301 RDNUM OBSOLETE PACKAGE DELETED FROM SOURCE
-C M107 KEYSOR OBSOLETE PACKAGE DELETED FROM SOURCE
-C
-C CHANGES FROM 1.21 :
-C M214 CVTVAX NEW PACKAGE. CONVERT VAX NUMBERS TO IBM
-C M218 CVTCDC FIX BUGS IN DCDDX AND DCDSX
-C V110 POISSN CORRECT EXPONENT UPPER LIMIT FOR VAX
-C
-C CHANGES FROM 1.20 :
-C I303 RDWORD NEW PACKAGE. READ A FORMAT-FREE NUMBER
-C M216 GETWI NEW PACKAGE. READ/CONVERT CDC W/I FILE
-C M218 CVTCDC NEW PACKAGE. CONVERT CDC NUMBERS TO IBM
-C
-C CHANGES FROM 1.19 :
-C U110 CLEBSG MINOR BUG FIXED IN SUBROUTINE CLEBSG
-C
-C CHANGES FROM 1.18 : VERSION 1.19 OF 860129
-C C322 DGAMMA DELETED (NOW IN KERNLIB C305, GAMMA)
-C C343 BSJA NEW PACKAGE (BESSEL FUNCTIONS)
-C C344 CBSJA NEW PACKAGE (BESSEL FUNCTIONS OF COMPLEX ARGUMENT)
-C D104 CAUCHY RESTRICTION OF EXTERNAL FUNCTION NAME=F REMOVED
-C D109 DGAUSS DELETED (NOW IN KERNLIB D103, GAUSS)
-C E406 DCHECF NEW PACKAGE (CHEBYCHEV SERIES COEFFICIENTS)
-C E407 CHSUM NEW PACKAGE SUMMATION OF CHEBYCHEV SERIES
-C Z034 WHICH MODIFIED FOR IBM 3090 MACHINE UNDER MVS
-C
-C CHANGES FROM 1.17 :
-C C321 CGPLG APOLLO VERSION ADDED
-C C323 GPLOG DELETED (COPIED TO OBSOLETE 1.04)
-C C324 CGPLOG DELETED (COPIED TO OBSOLETE 1.04)
-C D104 CAUCHY NEW VERSION INCLUDING ENTRY DCAUCH FOR 32-BIT MACHINES
-C D114 RIWIAD CALLS TO DFLOAT REPLACED BY CALLS TO GENERIC DBLE
-C M504 GETSST NEW ENTRY GETSCH FOR CHARACTER TYPE ADDED
-C U110 CLEBSG ERROR WHEN USED AFTER WIGN3J CORRECTED
-C V151 FUNRAN RARE ERROR CONDITION IN FUNZER CORRECTED
-C
-C CHANGES FROM 1.16 :
-C C304 DILOG NEW VERSION (INCLUDING DOUBLE PRECISION ENTRY)
-C C321 CGPLG NEW POLYLOGARITHM PACKAGE REPLACING C323 AND C324
-C C323 GPLOG OBSOLETED (SOURCE PATCH NO LONGER USED AUTOMATICALLY)
-C C324 CGPLOG OBSOLETED (SOURCE PATCH NO LONGER USED AUTOMATICALLY)
-C
-C CHANGES FROM 1.15 :
-C D151 DIVON4 MINOR BUG FIXED IN QUASI (17'TH PRIME NUMBER)
-C M429 NUMBIT CRAY VERSION SPEEDED UP (NOW CALLS POPCNT)
-C V106 RN32 WRONG INITIAL SEED CORRECTED IN CERN IBM VERSION
-C V108 RG32 WRONG INITIAL SEED CORRECTED IN CERN IBM VERSION
-C V401 GRAPH BUG FIXED IN CDC AND APOLLO VERSIONS
-C
-C CHANGES FROM 1.14 :
-C D151 DIVON4 FULL COMMON BLOCK LENGTH SPECIFIED IN ALL ROUTINES
-C G110 LANDAU MODIFIED FOR COMPATIBILITY WITH VS-FORTRAN
-C M231 CVTIB NEW ENTRIES SXSIB, DXDIB AND DIBDX ADDED
-C V106 RN32 CODE TIDIED UP FOR ENHANCED PORTABILITY.
-C V108 RNG32 PORTABLE GAUSSIAN RANDOM NUMBER GENERATOR ADDED.
-C Z044 INTRAC DELETED FROM GEN (MOVED INTO KERN).
-C
-C CHANGES FROM 1.13 :
-C E221 CHEB APOLLO VERSION ADDED.
-C W601 MLR MINOR BUG FIXED. DOUBLE PRECISION VERSION IN
-C FORTRAN-77 FOR 32-BIT MACHINES.
-C Z044 INTRAC MOVED OUT OF INCORRECT PATCH Z040.
-C
-C CHANGES FROM 1.12 : VERSION 1.13 OF 840828
-C D151 (DIVON4) BUG FIXED IN RANGEN ENTRY POINT OF GENPNT
-C Z009 (CALDAT) NEW PACKAGE (CALENDAR DATE CONVERSION)
-C Z022 (PF7000) DELETED CDC 7600 PACKAGE (COPIED INTO OBSOLETE PAM)
-C Z023 (STAGEF) DELETED CDC 7600 PACKAGE (COPIED INTO OBSOLETE PAM)
-C Z024 (REQPF) DELETED CDC 7600 PACKAGE (COPIED INTO OBSOLETE PAM)
-C Z025 (USTAGE) DELETED CDC 7600 PACKAGE (COPIED INTO OBSOLETE PAM)
-C Z026 (INCLCM) DELETED CDC 7600 PACKAGE (COPIED INTO OBSOLETE PAM)
-C Z037 (REPRIV) DELETED CDC 7600 PACKAGE (COPIED INTO OBSOLETE PAM)
-C
-C CHANGES FROM 1.11 : VERSION 1.12 OF 840528
-C M231 (CVTIB) NEW PACKAGE. IBM TO VAX CONVERSION (VAX ONLY)
-C M429 (NUMBIT) VAX MACHINE LANGUAGE VERSION ADDED
-C Z021 (PFNOSBE) ENTRY NAMES CHANGED AND FTN5 VERSION ADDED
-C
-C CHANGES FROM 1.10 :
-C I410 INBCD NOS/BE VERSION ADDED (FORTRAN 4 ONLY)
-C V101 (NORRAN) VAX VERSION ADDED
-C W505 (FOWL) MINOR BUGS FIXED IN VAX AND CDC VERSIONS
-C Z021 (PFNOSBE) NEW PACKAGE (CDC NOS/BE FORTRAN 4 ONLY)
-C
-C CHANGES FROM 1.09 :
-C A200 DPCMPLX OBSOLETE CDC ONLY PACKAGE REINSERTED IN FORTRAN 77
-C M201 CNVTZF DELETED (COPIED INTO OBSOLETE PAM)
-C M207 INVTZS DELETED (COPIED INTO OBSOLETE PAM)
-C M211 CMMMZC DELETED (COPIED INTO OBSOLETE PAM)
-C M225 CVTCII DELETED (COPIED INTO OBSOLETE PAM)
-C M432 FPAC66 DELETED (COPIED INTO OBSOLETE PAM)
-C U110 CLEBSG CORRECTED FOR REDUCED ARGUMENT LIST (IBM FTN 4 ONLY)
-C
-C CHANGES FROM 1.08 :
-C F413 CMLIN MISSING ROUTINE CDOT ADDED TO PACKAGE
-C J402 NAMEZB SQUARE BRACKETS ADDEDD TO CDC VERSION
-C G110 LANDAU PACKAGE ENTRIES DISLAN, DINLAN FLAGGED NOT F77
-C L800 SUPRLAY CDC NOSBE VERSION ADDED
-C M439 GETBYT FORTRAN VERSION ADDED FOR NON-IBM,CDC MACHINES
-C
-C CHANGES FROM 1.07 :
-C G110 (LANDAU) PACKAGE REPLACED BY FORTRAN 77 PACKAGE
-C M233 (TRA0E0 + TRE0A0) VAX VERSION ADDED
-C V106 (RN32) NORD-500 VERSION ADDED
-C Z044 (INTRAC) IBM VM/CMS AND NORD-500 VERSIONS ADDED
-C THE PATCHES CONTAINING COMPLETE PROGRAMS HAVE BEEN REMOVED
-C TO A NEW PAM 'PGM'. THE PATCHES WERE:
-C E201, E202, E204, J401, K425, L300, L410, L710, L720, M227, M230
-C Q600, Q800, Q900, Q901, W300, W303, W304, W305, W307, W500, W501
-C W600
-C PATCHES CONTAINING OBSOLETE MATERIAL HAVE BEEN REMOVED TO
-C A NEW PAM 'OBSOLETE'. THE PATCHES WERE:
-C A403, D203, E205, F133, F136, F204, F205, I403, I901, M200, M202
-C M401, M402, M403, M404, M406, M407, M408, M411, M417, M419, M424
-C N101, T308, T601, T602, T603, V306, W101, W104, W126, W127, W132
-C W502, W503, Z002, Z005, Z006
-C THE FOLLOWING HAVE BEEN MODIFIED TO COMPILE ON APOLLO
-C COMPUTERS (MAINLY ONLY BY TRIVIAL SOURCE CODE MOVEMENT):
-C D115, D302, J402, J507, M435, V105, V106, V150, V200, V401, W505
-C
-C CHANGES FROM 1.06 :
-C IDENZB (A401) MULTI-MACHINE FORTRAN VERSION ADDED.
-C FLPSOR/INTSOR (M103) REMOVED. LEFT IN BY ERROR - IN KERNLIB.
-C NUMBIT (M429) FAST CRAY FORTRAN VERSION ADDED.
-C INDENT (Q901) ADDED (FORTRAN 77 COMPLETE PROGRAM).
-C NRAN (V105) BUG FIXED IN CERN VAX MACRO VERSION.
-C
-C CHANGES FROM 1.05 :
-C LSQ (E208) REMOVED. LEFT IN BY ERROR - IN KERNLIB.
-C CMLIN (F413) FLAGGED AS CDC ONLY
-C SXCARD (I403) NO-LONGER USED (OBSOLETE)
-C HIST (J504) TITLE PRINTING CORRECTED IN NON-CDC VERSIONS
-C THE FOLLOWING OBSOLETE CDC-ONLY PACKAGES NO-LONGER USED:
-C BITSZA (M401), HOLN (M402), IMBDZA (M404)
-C STOCAR (M406), STORE (M407), IPACK (M408)
-C GETBIT,SETBIT (M437) SLOW FORTRAN AND VAX MACRO VERSIONS ADDED
-C TIDY (Q900) PUNCH TO DUMMY ON CDC PROGRAM CARD, RESULTS NOW ON TAPE8
-C TDPAS1 (Q900) BUG FIXED FOR FORMATS WHEN NOCOLL AND EXEMPT BOTH USED
-C TDBLDA (Q900) PAGE NUMBER NOW INITIALISED IN NON-CDC VERSIONS
-C POISSN (V110) NORRAN CALL CHANGED TO RANNOR IN NON-IBM,CDC VERSIONS
-C RANGAM (V109) NORRAN CALL CHANGED TO RANNOR IN NON-IBM,CDC VERSIONS
-C PRIPAR (X602) CALL TO OBSLOLETE MXMTR CHANGED TO CALL VSCALE
-C WHICH (Z034) VAX AND 'UNKNOWN' VERSIONS ADDED
-C
-C CHANGES FROM 1.04 :
-C NUMBIT (M429) IBM ASSEMBLER VERSION SPEEDED UP, FORTRAN
-C VERSION SPEEDED UP AND EXTENDED TO OTHER MACHINES.
-C DIVON4 (D151) SUBROUTINE QUASI CORRECTED FOR NPT LT 7
-C
-C-- CHANGES FROM 1.03 :
-C-- C324 CGPLOG RECORRECTED FOR 1.LT.X.LT.2
-C-- E221 CHEB CORRECTED FOR WRONG ERROR CODE RETURNED
-C-- K403 WIND FLAGGED AS CDC AND -F77
-C-- K404 BACKZF FLAGGED AS CDC AND -F77
-C-- K405 FRWDZF FLAGGED AS CDC AND -F77
-C-- L800 SUPRLAY BUG FIXED IN CDC FORTRAN 77
-C-- X510 MOMENTM DELETED. DUPLICATES POOL ENTRY X1015
-C-- MFRAME (Z034) CHANGED TO RETURN 3081 ON IBMS
-C-- REPRIV (Z037) FORMATS CORRECTED FOR CDC FORTRAN 77
-C--
-C-- CHANGES FROM 1.02
-C-- VAX VERSION ADDED
-C-- CORRECTIONS TO:
-C-- WHICH (Z034, CERN IBM ONLY), MFRAME (Z034, NOSBE F77)
-C-- GAMMA (C305) AND ALOGAM (C341) MOVED TO KERNNUM PAM.
-C-- D203 INTSTP OBSOLETED (MOVED FROM P=USES).
-C--
-C-- CHANGES FROM 1.01
-C-- C303 COMBES MODIFIED FOR FORTRAN 77.
-C-- L800 SUPRLAY MODIFIED FOR FORTRAN 77.
-C-- M219 CVT360 MOVED TO KERNCDC PAM.
-C-- M411 IFORMT OBSOLETED UNDER FORTRAN 77.
-C-- M412 AFROMI OBSOLETED UNDER FORTRAN 77.
-C-- M413 BCDWD OBSOLETED UNDER FORTRAN 77.
-C-- M430 FTO460 MOVED TO KERNCDC PAM.
-C-- Z002 TIMEZB OBSOLETED UNDER FORTRAN 77.
-C-- Z005 DATEZB OBSOLETED UNDER FORTRAN 77.
-C--
-C-- CHANGES FROM 1.00
-C-- C303, C306, C307, C309, C310, C311, C314, C340, D111, D151, D510
-C-- D701, E103, E104, F120, F123, F124, H100, I301, I901, J300, J402
-C-- J501, J509, J520, K404, K405, L800, M412, M414, M425, M432, M439
-C-- T601, U110, V103, V106, V110, V150, V200, X202, X203, Z002, Z022
-C--
-C-- TO EXTRACT A SINGLE SOURCE PATCH
-C-- +USE,P=FLAG1,...FLAGN.
-C-- +USE,P=CODE.
-C-- +EXE.
-C-- +PAM.
-C-- +QUIT.
-C-- WHERE 'CODE' IS THE REQUIRED PROGRAM LIBRARY CLASSIFICATION CODE
-C-- WILL WRITE ALL DECKS OF PATCH CODE OBEYING THE FLAGS
-C-- FLAG1,...FLAGN TO THE ASM FILE.
-C--
-C-- TO EXTRACT ALL SOURCE
-C-- +USE,P=FLAG1,...FLAGN.
-C-- +USE,P=USES. (FOR ALL THE ROUTINES IN THE CERN BINARY LIBRARIES)
-C-- +USE,P=NONUSES. (FOR ROUTINES NOT IN CERN BINARY LIBRARIES)
-C-- +EXE.
-C-- +PAM.
-C-- +QUIT.
-C--
-C-- TO EXTRACT A VERSION WHICH TAKES ADVANTAGE FROM THE IBM VECTOR
-C-- FACILITIES
-C-- +USE,P= IBM, QMIBMVF.
-C-- +EXE.
-C-- +PAM.
-C-- +QUIT.
-C--
-C-- TO MAKE THE CERN GENLIB BINARY LIBRARY USE P=USES ONLY.
-C-- THE PATCH NONUSES REFERENCES ROUTINES NOT IN THE BINARY LIBRARY.
-C--
-C-- IF IS REQUIRED TO SEPARATE THE ASSEMBLER LANGUAGE DECKS FROM THE
-C-- FORTRAN DECKS THE PATCHY CONTROL CARD
-C-- +ASM,22.
-C-- IS ALSO REQUIRED (BEFORE THE +PAM CARD).
-C--
-C-- FLAGS AVAILABLE ARE
-C-- IBM, CDC, VAX, UNIVAC, FOR DIFFERENT MACHINES.
-C-- CRAY, PDP, NORD, CONVEX
-C-- F4. FOR FORTRAN 4 INSTEAD OF FORTRAN 77.
-C-- F90. FOR FORTRAN 90 INSTEAD OF FORTRAN 77.
-C-- NOSBE. USE WITH FLAG CDC FOR OPERATING
-C-- SYSTEM NOSBE. DEFAULT IS SCOPE2.
-C-- IBMMVS. USE WITH FLAG IBM FOR OPERATING
-C-- SYSTEM OS. DEFAULT IS VM/CMS
-C-- FORTRAN. TO SELECT FORTRAN NOT ASSEMBLER IN
-C-- THE CASES WHERE BOTH EXIST.
-C--
-C-- THE COMBINATION
-C-- +USE,CDC,FORTRAN.
-C-- WILL GIVE FOR EXAMPLE A CDC VERSION WHICH IS FORTRAN 77 IF BOTH
-C-- FORTRAN AND ASSEMBLER EXIST FOR THE SAME ROUTINE AND ASSEMBLER
-C-- IF ONLY AN ASSEMBLER VERSION EXISTS, WHEREAS
-C-- +USE,CDC.
-C-- WILL GIVE THE OPTIMUM CDC VERSION OF COMPASS ROUTINES AND FORTRAN 77.
-C-- FOR MACHINES OTHER THAN IBM,CDC,VAX,UNIVAC,PDP,NORD OR CRAY GIVE
-C-- +USE,FORTRAN. FOR FORTRAN 77
-C-- +USE,FORTRAN,F4. FOR FORTRAN 66
-C-- IN SOME ROUTINES THIS GIVES THE ASSUMPTION OF A 32-BIT MACHINE.
-C--
-C-- NOTE THAT THE IBM FORTRAN 77 VERSION IS COMPATIBLE WITH THE SIEMENS
-C-- (FACOM) COMPILER AND WITH THE IBM VS-FORTRAN COMPILER RELEASE 3.
-C-- THE VAX AND APOLLO VERSIONS HAVE ONLY BEEN TESTED AS FORTRAN
-C-- 77 CODE.
-C-- FOR APOLLO THE COMBINATION +USE,P=APOLLO,FORTRAN IS NEEDED.
-C--
diff --git a/src/mathlib/gen/history/v130.dat b/src/mathlib/gen/history/v130.dat
deleted file mode 100644
index af50663..0000000
--- a/src/mathlib/gen/history/v130.dat
+++ /dev/null
@@ -1,36 +0,0 @@
-*
-* $Id: v130.dat,v 1.1.1.1 1996/04/01 15:01:42 mclareni Exp $
-*
-* $Log: v130.dat,v $
-* Revision 1.1.1.1 1996/04/01 15:01:42 mclareni
-* Mathlib gen
-*
-*
-* Version 1.30
-C GLOBAL CHANGES:
-C- PRINT x statements changed to WRITE(6,x)
-C- replacement of Hollerith specifications by quoted strings in
-C FORMAT statements
-C- replacement of intrinsic functions by the generic equivalent
-C- AMODE/RMODE qualifiers added to IBM assembler routines.
-C Selected by PATCHY flag QMIBMXA.
-C
-C ROUTINE CHANGES FROM 1.29 :
-C
-C A401 IDENZB OBSOLETE ROUTINE DELETED FROM SOURCE AND BINARY
-C C201 DSNLEQ New
-C C208 DRTEQ4 Bug corrected
-C D102 GAUSS1 OBSOLETE ROUTINE DELETED FROM SOURCE AND BINARY
-C D112 RGAUSS OBSOLETE ROUTINE DELETED FROM SOURCE AND BINARY
-C F122 SCATTER New, not for Cray
-C J504 HIST OBSOLETE ROUTINE DELETED FROM SOURCE AND BINARY
-C J507 HISTO OBSOLETE ROUTINE DELETED FROM SOURCE AND BINARY
-C M412 AFROMI OBSOLETE ROUTINE DELETED FROM SOURCE AND BINARY
-C M413 BCDWD OBSOLETE ROUTINE DELETED FROM SOURCE AND BINARY
-C M414 IDIGIT OBSOLETE ROUTINE DELETED FROM SOURCE AND BINARY
-C M439 GETBYT Add Apollo flag in SETBYT, GETBYT
-C W601 MLR Obsoleted due to lack of user feedback
-C X203 PAROFI OBSOLETE ROUTINE DELETED FROM SOURCE AND BINARY
-C Z034 WHICH Cray machine added
-C Z210 EXCPRD OBSOLETE ROUTINE DELETED FROM SOURCE AND BINARY
-C
diff --git a/src/mathlib/gen/history/v131.dat b/src/mathlib/gen/history/v131.dat
deleted file mode 100644
index 621d906..0000000
--- a/src/mathlib/gen/history/v131.dat
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: v131.dat,v 1.1.1.1 1996/04/01 15:01:41 mclareni Exp $
-*
-* $Log: v131.dat,v $
-* Revision 1.1.1.1 1996/04/01 15:01:41 mclareni
-* Mathlib gen
-*
-*
-* Version 1.31
-C GLOBAL CHANGES FROM 1.30 :
-C - invert history records in P=INFORM. The most recent at the
-C top
-C
-C ROUTINE CHANGES FROM 1.30 :
-C
-C C309 CCLBES Minor correction to FORMAT statements
-C C327 BSIR4 Fix bug about unreachable code at label=23
-C C345 BZEJY New
-C D207 BULSTO OBSOLETE ROUTINE DELETED FROM SOURCE AND BINARY
-C D208 MERSON OBSOLETE ROUTINE DELETED FROM SOURCE AND BINARY
-C D300 EPDE1 Minor correction to FORMAT statements
-C D400 NUMDI1 OBSOLETE ROUTINE DELETED FROM SOURCE AND BINARY
-C D506 MINNEW STOP removed
-C F101 MATIN2 OBSOLETE ROUTINE DELETED FROM SOURCE AND BINARY
-C F103 MATRIX OBSOLETE ROUTINE DELETED FROM SOURCE AND BINARY
-C M108 SORTMQ OBSOLETE ROUTINE DELETED FROM SOURCE AND BINARY
-C U500 DSMALL OBSOLETE ROUTINE DELETED FROM SOURCE AND BINARY
-C V200 KBINOM OBSOLETE ROUTINE DELETED FROM SOURCE AND BINARY
-C
diff --git a/src/mathlib/gen/history/v132.dat b/src/mathlib/gen/history/v132.dat
deleted file mode 100644
index 266a93c..0000000
--- a/src/mathlib/gen/history/v132.dat
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: v132.dat,v 1.1.1.1 1996/04/01 15:01:40 mclareni Exp $
-*
-* $Log: v132.dat,v $
-* Revision 1.1.1.1 1996/04/01 15:01:40 mclareni
-* Mathlib gen
-*
-*
-* Version 1.32
-C GLOBAL CHANGES FROM 1.31 :
-C - introduce UNIX flag, *GEN patch
-C - change VMCMS flag to -IBMMVS.
-C - change IBMVF flag to QMIBMVF.
-C
-C ROUTINE CHANGES FROM 1.31 :
-C
-C C311 LEGFN Add dummy variable to align COMMON/LEGBL/
-C D510 FUMILI rearrange common blocks in sequences
-C M233 TRTCH CHanged for the new CERN character set
-C M505 LOCHAR Add CONVEX flag, change DATA statement for Cray
-C V107 RNDM2 UNIX version introduced
-C
diff --git a/src/mathlib/gen/history/v133.dat b/src/mathlib/gen/history/v133.dat
deleted file mode 100644
index f1bf0f0..0000000
--- a/src/mathlib/gen/history/v133.dat
+++ /dev/null
@@ -1,74 +0,0 @@
-*
-* $Id: v133.dat,v 1.1.1.1 1996/04/01 15:01:40 mclareni Exp $
-*
-* $Log: v133.dat,v $
-* Revision 1.1.1.1 1996/04/01 15:01:40 mclareni
-* Mathlib gen
-*
-*
-* Version 1.33
-C Global changes:
-C ----------------
-C- introduce GEFLAGS patch, SINGLE, DOUBLE flags
-C- Remove variables which are not used (flagged by C*NS)
-C
-C- Routine changes:
-C ----------------
-C B100 BINOM Add deck name
-C C200 ZEROX New
-C C201 SNLEQ Declare EXTERNAL SUB,FCN
-C C203 NZEROS NZEROS: remove S (not used)
-C C207 RTEQ3 Do not use REAL*16 on UNIX
-C C208 RTEQ4 Do not use REAL*16 on UNIX
-C C306 GAMMA WGAMMA: remove W,D (not used)
-C C307 DIGAM WDIGAM: remove W,D (not used)
-C C311 LEGFN TRDZ : remove CLOGOK (not used)
-C C320 CELFUN CELFUN: remove K (not used)
-C C321 CGPLG Define WGPLG as COMPLEX*16 for non-IBM machines
-C C331 FCONC Add deck name
-C C333 CLOGAM WLOGAM: remove W,D (not used)
-C C334 GAPNC New
-C C338 CEXPIN New
-C C340 BSIR3 Code revised+ bug fixed
-C C400 NEWTON Obsolete routine deleted from source and binary
-C D104 CAUCHY D104F1: declare EXTERNAL F
-C D105 TRINT declare EXTERNAL F
-C D110 RGMLT Add deck name, declare EXTERNAL FSUBn
-C Correct bug in xGMLT2-6 getting "FSUB1" instead
- of FSUBn as external routine name.
-C D111 GPINDP Remove THREE,RANDER,ERROR (not used)
- declare EXTERNAL FUNC
-C D113 CGAUSS CGAUSS, WGAUSS: declare EXTERNAL F
-C D114 RIWIAD RIWIAD: remove XLOC (not used)
-C D115 CHEBQU declare external FUNC
-C D151 DIVON4 INTGRL: remove INTPNT (not used)
-C SPLIT : remove SUM,DEVMAX,DFLOAT (not used)
-C RECPAR: remove COORD (not used)
-C NMDCHL: remove IQ (not used)
-C FEASMV: remove DABS (not used)
-C D201 DEQBS Add deck name, declare EXTERNAL SUB
-C D202 DEQMR Add deck name, declare EXTERNAL SUB
-C D401 DERIV Add deck name, declare EXTERNAL F
-C D508 LINSQ Add deck name
-C D510 FUMILI Put back COMMON/DF/
-C D600 FRED1 declare EXTERNAL F,G,H in FREDn
-C E211 RCSPLN New
-C E221 CHEB Set BIG=10**37 for SUN
-C E406 DCHECF declare EXTERNAL F
-C E410 CPSC declare EXTERNAL F
-C F220 INVIT Set trailing DIMENSION of RM3 to *
-C F500 LIHOIN Set trailing DIMENSIONs to *
-C G106 GAMDIS Revised
-C H100 SIMPLE FINDPC: remove QQ,MAXD(not used)
-C I303 RDWORD RDWORD: remove RDENDB (not used)
-C RDIGI : remove CHAR (not used)
-C RALPH : remove CHAR (not used)
-C RDINT : remove XXXXXX,RALPH (not used)
-C RDMANT: remove RDIGI ,RALPH (not used)
-C M214 CVTVAX Optimized version introduced
-C U100 CLEBS CLEBS : remove L1,L2,IL,LR1 (not used)
-C U501 DJMNB Add deck name
-C V107 RNDM2 Provide general UNIX version (original from ALLIANT)
-C V401 GRAPH Initialize IFILWD as -1 for UNIX
-C W601 MLR Obsolete routine deleted from source and binary
-C
diff --git a/src/mathlib/gen/history/v134.dat b/src/mathlib/gen/history/v134.dat
deleted file mode 100644
index 930b04c..0000000
--- a/src/mathlib/gen/history/v134.dat
+++ /dev/null
@@ -1,43 +0,0 @@
-*
-* $Id: v134.dat,v 1.1.1.1 1996/04/01 15:01:40 mclareni Exp $
-*
-* $Log: v134.dat,v $
-* Revision 1.1.1.1 1996/04/01 15:01:40 mclareni
-* Mathlib gen
-*
-*
-* Version 1.34 901107 15.10
-C Global changes:
-C ----------------
-C- rename GEFLAGS to FGEN, USES to SGEN, INFORM to DGEN
-C- initialize variables which are used as internal arguments to implicit
-C functions, to prevent compiler warning (flagged as C*IA)
-C
-C Routine changes:
-C ----------------
-C B100 BINOM Fix bug in logics
-C C200 ZEROX Declare EXTERNAL F
-C C208 RTEQ4 Fix bug in logics
-C C306 GAMMA CGAMMA: C*IA D
-C C307 DIGAM CDIGAM: C*IA D
-C C309 CCLBES Enable code for UNIX, change PAR CIH=CI/TWO to HALF*CI
- to help xlf (IBMRT), Do not use REAL*16 in UNIX
-C C328 CWHITM Enable code for UNIX, change PAR IH=I/2 to I=HALF*I
-C C331 FCONC CFCONC: C*IA CRG
-C C333 CLOGAM CLOGAM: C*IA D
-C C335 CWERF CWERF : C*IA D
-C C338 CEXPIN CEXPIN: C*IA T, use same DATA cards for CEXPIN+WEXPIN
- Exit properly on error condition (high accuracy)
-C C342 STRH0 Introduce new SINGLE PRECISION version, recode routine
-C D110 RGMLT Use FSUB3 in call of DGMLT3
-C D300 EPDE1 Recode STOP at the end of EPDCHN
-C D600 FRED1 Replace call to MATRIX by equivalent code
-C E410 CPSC CPSC : C*IA CO,RE
-C G101 CHISIN Do not stop after error conditions
-C J509 CONPRT FREARG: C*IA X1,Y1,X2,Y2,XIN
-C M429 NUMBIT Add FORTRAN version for UNIX
-C U110 CLEBSG CLEBSG: C*IA Q
-C V101 NORRAN Enable UNIX version (from Alliant)
-C W100 TRAMP1 Obsolete routine deleted from source and binary
-C W505 FOWL GENEV : C*IA Y,Z
-C
diff --git a/src/mathlib/gen/history/v135.dat b/src/mathlib/gen/history/v135.dat
deleted file mode 100644
index 713e7b9..0000000
--- a/src/mathlib/gen/history/v135.dat
+++ /dev/null
@@ -1,52 +0,0 @@
-*
-* $Id: v135.dat,v 1.1.1.1 1996/04/01 15:01:40 mclareni Exp $
-*
-* $Log: v135.dat,v $
-* Revision 1.1.1.1 1996/04/01 15:01:40 mclareni
-* Mathlib gen
-*
-*
-* Version 1.35 910304 21.10
-C
-C Global changes:
-C ----------------
-C- remove unused labels (flagged as C*UL)
-C- split IBM flag into IBMVM, IBMMVS.
-C- add HPUX,MIPS,VAXVMS,VAXULX.
-C
-C Routine changes:
-C ----------------
-C C306 GAMMA WGAMMA: C*UL 9
-C C307 DIGAM WDIGAM: C*UL 9
-C C309 CCLBES Enable IBMAIX,CONVEX versions
-C C311 LEGFN LEGFN : C*UL 30 , LEGV : C*UL 6 , CLOGOK: C*UL 80
-C C328 CWHITM Bug fixed (results were scaled by a factor 4)
-C C333 CLOGAM WLOGAM: C*UL 9 , CLOGAM: C*UL 9
-C D111 GPINDP GPINDP: C*UL 290,300
-C D114 RIWIAD RIWIAD: C*UL 7
-C D115 CHEBQU CHEBQU: C*UL 1000,1020,1125,1126,1128
-C D151 DIVON4 GENPNT: C*UL 10
-C D300 EPDE1 EPDE1 : C*UL 41 , EPDCHN: C*UL 71,10,20
-C D302 ELPAHY ESOLVE: C*UL 224
-C D507 MINSQ MINSQ : C*UL 37
-C E206 TRICOF TRICOF: C*UL 1000,1080,1105,1120
-C E207 TRISUM TRISUM: C*UL 1000
-C E209 SPLIN3 SPLIN3: C*UL 1000,1050,1120,1130
-C E221 CHEB Set BIG=10**37 / 10**307 for CONVEX-DOUBLE, SINGLE
- BIG=10**37 for SGI,DECS,IBMRT
-C F106 SPXINV SPXINV: C*UL 40
-C F220 EISPAC COMLR : C*UL 180
-C G103 TKOLMO New
-C H100 SIMPLE SPLX : C*UL 50,550
-C H300 ASSIGN ASSIGN: C*UL 40
-C M429 NUMBIT Split machine versions, rearrange code
-C M439 GETBYT GETBYT: C*UL 21,22,24,42 , SETBYT: C*UL 21,22,24,42
-C U100 CLEBS Rename internal entries DIVIDE,PRIME ,PRMTOD,FCTRAL
- to U100DV,U100PR,U100PM,U100FC
-C U110 CLEBSG CLEBSG: C*UL 510,910,550
-C V101 NORRAN Split machine versions
-C V401 GRAPH GRAPH : C*UL 112
-C W505 FOWL Inhibit routine START in UNIX (this produces a clash
- with COMMON/START/ of D151 DIVON4 in shareable libraries
- FMASS : C*UL 400 , HISTEY:155,FOWLPR:1000,REDAT2:320
-C
diff --git a/src/mathlib/gen/history/v136.dat b/src/mathlib/gen/history/v136.dat
deleted file mode 100644
index 0126636..0000000
--- a/src/mathlib/gen/history/v136.dat
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: v136.dat,v 1.1.1.1 1996/04/01 15:01:40 mclareni Exp $
-*
-* $Log: v136.dat,v $
-* Revision 1.1.1.1 1996/04/01 15:01:40 mclareni
-* Mathlib gen
-*
-*
-* Version 1.36 910725 13.30
-C
-C Routine changes:
-C ----------------
-C C207 RTEQ3 Enable Apollo version. It compiles with -opt 2
-C C208 RTEQ4 Enable Apollo version. It compiles with -opt 2
-C C309 WCLBES Enable Apollo version. It compiles with -opt 0
-C Enable NECSX version
-C C321 CGPLG Enable Apollo version. It compiles with -opt 2
-C C328 CWHITM Enable Apollo version. It compiles with -opt 2
-C C331 FCONC Enable Apollo version. It compiles with -opt 2
-C C345 BZEJY Enable Apollo version. It compiles with -opt 2
-C V110 POISSN Save EXPMA on DECstations
-C V107 RNDM2 Enable HPUX version.
-C V151 FUNRAN Save RBUF,IBUF,GAP,GAPINV on DECStations
-C
diff --git a/src/mathlib/gen/history/v137.dat b/src/mathlib/gen/history/v137.dat
deleted file mode 100644
index c6022d4..0000000
--- a/src/mathlib/gen/history/v137.dat
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: v137.dat,v 1.1.1.1 1996/04/01 15:01:40 mclareni Exp $
-*
-* $Log: v137.dat,v $
-* Revision 1.1.1.1 1996/04/01 15:01:40 mclareni
-* Mathlib gen
-*
-*
-* Version 1.37 920317 23.00
-C
-C Routine changes:
-C ----------------
-C C343 BSJA Restore usage of DGAMMA. Only IBM supports GAMMA as a
-C C344 CBSJA generic function - L.Roberts/SSC
-C Bug in 32-bit version of WBSJA: DGAMMA was not declared
-C as DOUBLE PRECISION
-C E221 CHEB Set BIG=10**37 as default for all machines - L.Roberts
-C V110 POISSN Save EXPMA,AMUOL,AMAX for all machines
-C V150 HISRAN Declare Y as a vector with implicit length. The previous
-C declaration Y(2) interferes with the Cray vector comp.
-C Z034 WHICH Add IBM 9000
-C
diff --git a/src/mathlib/gen/history/v138.dat b/src/mathlib/gen/history/v138.dat
deleted file mode 100644
index 1388ee2..0000000
--- a/src/mathlib/gen/history/v138.dat
+++ /dev/null
@@ -1,83 +0,0 @@
-*
-* $Id: v138.dat,v 1.1.1.1 1996/04/01 15:01:40 mclareni Exp $
-*
-* $Log: v138.dat,v $
-* Revision 1.1.1.1 1996/04/01 15:01:40 mclareni
-* Mathlib gen
-*
-*
-* Version 1.38 920726 7.30
-C
-C Global changes:
-C ----------------
-C- replace IBMPC flag by MSDOS.
-C add flag IPSC
-C add patch CGEN for COMMON block definitions
-C warning: COMMON clash between RIWIAD & DIVON4 (ANSWER)
-C Possible problem when generating shareable libraries
-C Add dummies to all new entries when a given routine is not available
-C on a computer; this typically happens for:
-C - 32-bit versions in 32-bit machines
-C - 128-bit versions on 64-bit machines
-C
-C Routine changes:
-C ----------------
-C B102 ASINH New
-C C202 RMULLZ New
-C C209 CPOLYZ New
-C C210 NZERFZ New
-C C300 ERF Reissued
-C C301 FREQ Reissued
-C C302 GAMMA Reissued
-C C303 GAMMF New
-C C309 CCLBES Correct passing of arguments to C309R4
-C C310 ALGAMA Reissued
-C C311 LEGFN Pass a REAL argument to NIC311
-C C315 RRIZET New
-C C316 RPSIPG New
-C C318 ELFUN Reissued
-C C320 CELFUN Reissued
-C C321 CGPLG Use N002, add dummies when not available
-C C328 CWHITM Use N002, add dummies when not available
-C C335 CWERF Simplify definition of function type
-C C346 RELI1 New
-C C347 RELI1C New
-C C348 CELINT New
-C C349 RTHETA New
-C D107 RGQUAD New
-C D111 GPINDP Transform DO-loop 350 into a GOTO
-C D113 CGAUSS Simplify definition of function type
-C D115 CHEBQU Transform DO-loop 1150 into a GOTO
-C D151 DIVON4 DVNBKD: save local variable INITL
-C D203 RKNYS New
-C D601 RFRDH1 New
-C E209 SPLIN3 Transform DO-loop 1160 into a GOTO
-C E401 ECTRAD Rename internal entry name BIND to E401BD
-C I303 RDWORD Moved to KERNLIB
-C J530 BINSIZ Moved to KERNLIB
-C M214 CVTVAX Moved to KERNLIB
-C M216 GETWI Moved to KERNLIB
-C M218 CVTCDC Moved to KERNLIB
-C M231 CVTIB Moved to KERNLIB
-C M232 CVTND Moved to KERNLIB
-C M233 TRTCH Moved to KERNLIB
-C M416 UBLOW1 Moved to KERNLIB
-C M429 NUMBIT Moved to KERNLIB
-C M437 GETBIT Moved to KERNLIB
-C M438 BTMOVE Moved to KERNLIB
-C M439 GETBYT Moved to KERNLIB
-C N002 MTLSET New
-C V105 NRAN Terminate Vax MACRO with .END
-C V106 RN32 Terminate Vax MACRO with .END
-C V130 RAN3D Save IBUF,RBUF - R.Jones/CERN
-C V202 PERMU merging of V201+V202+V203
-C V301 UCOPY merging of V301+V303
-C V304 IUCOMP merging of V304+V305
-C V700 RVNSPC New
-C W505 FOWL Moved out of GENLIB as MC source
-C W515 GENBOD Moved out of GENLIB as MC source
-C Y201 IUCHAN merging of Y201+Y202+Y203
-C Z009 CALDAT Moved to KERNLIB
-C Z034 WHICH Moved to KERNLIB
-C
-C
diff --git a/src/mathlib/gen/history/v139.dat b/src/mathlib/gen/history/v139.dat
deleted file mode 100644
index 9651b9b..0000000
--- a/src/mathlib/gen/history/v139.dat
+++ /dev/null
@@ -1,112 +0,0 @@
-*
-* $Id: v139.dat,v 1.1.1.1 1996/04/01 15:01:40 mclareni Exp $
-*
-* $Log: v139.dat,v $
-* Revision 1.1.1.1 1996/04/01 15:01:40 mclareni
-* Mathlib gen
-*
-*
-* Version 1.39 930220 14.30
-C
-C Global changes:
-C
-C Introduce NOQUAD and QUAD flags
-C
-C Assign 128 bits Functions value 0 when 'not available', to avoid warn.
-C
-C Introduce IMP128 sequence and GAUSS128 into D103
-C
-C Correct IMP64R sequence definition for the CRAY.
-C
-C Replace FGEN patch by the new MACHINETYPE.
-C
-C Define error code CODE.0 for non-available entries
-C Introduce F90 flag to mark f90-specific code
-C Change all instances of REAL*8 to DOUBLE PRECISION or REAL(2)
-C Introduce GCMPFUN sequence to represent generic functions of COMPLEX
-C argument in FORTRAN 77
-C Introduce DEF128 sequence to represent quadruple precision for the
-C systems where it is accepted.
-C Include GCMPLX definition to represent generic function for CMPLX or
-C DCPLX in GCMPFUN.
-C Make SAVE statements valid to all machines (V106, V108, V151)
-C Substitute definitions of GIMAG and GCMPLX in DECK,CELFUN64 (C320)
-C by a call to GCMPFUN and remove correspondingly GCMPLX and Z from
-C SEQ,DEFC64 inside the deck.
-C
-C
-C Routine changes:
-C ----------------
-C B100 BINOM Reissued
-C B101 ATG New. Must be removed from KERNLIB
-C B102 ASINH Use DEF64 sequence
-C B300 RSRTNT New.
-C C200 ZEROX Reissued
-C C201 SNLEQ Reissued
-C C202 RMULLZ Use GCMPFUN sequence, change to new 32/64/128 style
-C C207 RTEQ3 Reissued
-C C208 RTEQ4 Reissued
-C C302 GAMMA Introduce GAMMA128
-C C304 DILOG Reissued
-C C306 CGAMMA Reissued
-C C307 CDIGAM Reissued
-C C309 WCLBES Move declaration of KAS(2) before use in EQUIVALENCE
- Disable REAL*16 for ALPHA
-C C310 ALGAMA Introduce ALGAMA128
-C C312 BESJ0 New. Must be removed from KERNLIB
-C C313 BESI0 New. Must be removed from KERNLIB
-C C321 CGPLG Reissued
-C C322 FRSIN Reissued
-C C323 FERDR Reissued
-C C324 ATANI Reissued
-C C327 BSIR4 Reissued
-C C328 CWHITM Reissued
-C C330 ASLGF Reissued
-C C331 FCONC Reissued
-C C333 CLOGAM Reissued
-C C334 GAPNC Reissued
-C C335 CWERF Reissued
-C C336 SININT New. Must be removed from KERNLIB
-C C337 EXPINT New. Must be removed from KERNLIB
-C C338 CEXPIN Reissued
-C C339 DAWSON Reissued
-C C340 BSIR3 Reissued
-C C342 STRH0 Reissued
-C C343 BSJA Reissued. Add QUAD flag for BSJA128
-C C344 CBSJA Reissued
-C C345 BZEJY Reissued
-C C349 RTHETA Add RTHETA128, correct 3rd error message
-C D101 SIMPS Reissued
-C D103 GAUSS New. Must be removed from KERNLIB
-C D104 CAUCHY Reissued
-C D105 TRIINT Reissued
-C D110 RGMLT Reissued
-C D113 CGAUSS Reissued
-C D114 RIWIAD Supress superfluous variables FNAME,WWAS,NNOT
-C D151 DIVON4 Change REAL*8 to DOUBLE PRECISION or REAL(2)
-C Make IDATE a CHARACTER variable
-C GENPNT - uniform argument types in RANUMS calls
-C D200 RKSTP New. To replace D209, which must be removed from KERNLIB
-C D201 DEQBS Reissued
-C D202 DEQMR Reissued
-C D401 DERIV Reissued
-C E211 RCSPLN Reissued
-C E406 CHECF Reissued / Introduce CHECF128 code.
-C E407 CHSUM Reissued
-C F500 LIHOIN Reissued
-C G100 PROB New. Must be removed from KERNLIB
-C G101 CHISIN Reissued
-C G102 PROBKL Reissued
-C G105 GAUSIN Reissued
-C G106 GAMDIS Reissued
-C G110 LANDAU Reissued No F66 version available / DISLAN->ENTRY DSTLAN
-C J509 J509BD - remove superfluous vector NAMEXY
-C M504 GETSST GETSST - uniform argument types in CHMOVE calls
-C N002 MTLSET Reissued (to add DATA)
-C N002 MTLSET MTLPRT - remove trailing blanks from error message
-C U501 DJMNB Reissued
-C V107 RNDM2 Add Hex data for Macintosh/MPW
- Correct misplacement of DATA stat. in VAX/FORTRAN version
-C V109 RANGAM Uniform argument types in RNDM calls (INTEGER)
-C V401 GRAPH Simplify definition of IFILWD for all machines
-C
diff --git a/src/mathlib/gen/history/v140.dat b/src/mathlib/gen/history/v140.dat
deleted file mode 100644
index f15a440..0000000
--- a/src/mathlib/gen/history/v140.dat
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: v140.dat,v 1.1.1.1 1996/04/01 15:01:36 mclareni Exp $
-*
-* $Log: v140.dat,v $
-* Revision 1.1.1.1 1996/04/01 15:01:36 mclareni
-* Mathlib gen
-*
-*
-* Version 1.40 930603 12.30
-C
-C Routine changes:
-C ----------------
-C G100 PROB G.Folger 930708 : change UP from 340 to 170, fixes underflow
-C
-C Global changes:
-C-- G.Folger Introduce changes for LINUX/MSDOS
-C--
-C
-C Routine changes:
-C ----------------
-C D501 LEAMAX New
-C D503 DMINFC New. D509 must be removed from KERNLIB
-C E210 NORBAS New
-C N002 MTLSET updated
-C--
diff --git a/src/mathlib/gen/history/v141.dat b/src/mathlib/gen/history/v141.dat
deleted file mode 100644
index 7cd49c8..0000000
--- a/src/mathlib/gen/history/v141.dat
+++ /dev/null
@@ -1,67 +0,0 @@
-*
-* $Id: v141.dat,v 1.1.1.1 1996/04/01 15:01:36 mclareni Exp $
-*
-* $Log: v141.dat,v $
-* Revision 1.1.1.1 1996/04/01 15:01:36 mclareni
-* Mathlib gen
-*
-*
-C C Additions:
-C ----------
-C
-C V115 RANLUX
-C V116 RM48
-C V120 RNORML
-C V121 RNORMX
-C V122 CORSET
-C
-C Routine changes: ( edited by GF, except where indicated )
-C ---------------
-C
-C G116 VVISET correct statement order (Valeri Fine)
-C C203 NZEROS deleted, use C210 NZERFZ
-C C206 POLY2 deleted, CPOLYZ
-C C304 ALGAMA reissued from C310. Jacket routines to intrinsics for IBM
-C C305 CGAMMA Reissued from C306
-C C306 CLGAMA Reissued from C333, CLOGAM(WLOGAM) renamed to CLGAMA(WLGAMA)
-C keep old names as entry points
-C C309 CCLBES Fix compilation warnings (JDS)
-C C314 THETA1 deleted, use C349 RTHETA
-C C317 ADIGAM deleted, use C316 RPSIPG
-C C319 ELIN1 deleted, use C346 RELI1
-C C327 BSIR4 Bug fix (JDS)
-C C332 DILOG Reissued from C304
-C C333 CLOGAM deleted, use C306 CLGAMA
-C C338 CEXPIN Fix compilation warnings (JDS)
-C D151 DVDOT Fix compilation warnings (JDS)
-C D600 FRED1 deleted, use D601 RFRDH1
-C E206 TRICOF deleted, use D700 RFT
-C E209 SPLIN3 deleted, use E211 RCSPLN
-C E408 RCHPWS New
-C F120 DIRCOS deleted, obsolete, reactivate ( used in geane )
-C G115 VAVLOV New
-C G116 VVILOV New
-C G100 PROB Modified
-C H101 RSMPLX New
-C H301 ASSNDX New
-C M435 CHMOVE deleted, obsolete
-C M504 GETSST deleted, use M432 CHPACK
-C M505 LOCHAR deleted, use M432 CHPACK
-C V101 NORRAN Fix compilation warnings (JDS)
-C V106 RN32 Fix compilation warnings (JDS)
-C V107 RNDM2 Macro & old versions of RNDM2 for VAX,IF=OLD. (JDS)
-C Add new Fortran version for VAX & AXP from
-C Christian Walck, Fysikum, Stockholm University, Sweden
-C V108 RG32 Fix compilation warnings (JDS)
-C X602 PRIPAR deleted, obsolete
-C
-C Global Changes:
-C --------------
-C G.Folger put changes for Convex from DESY.
-C G.Folger, clean up for LINUX; changes from A.Lomov.
-C-- V.Fine, E.Potrebenikova
-C
-C NOQUAD flad have been set for MSDOS.
-C Delete string +PATCH, C307 located before line +PATCH, 307.
-C +KEEP, DEFDR have been introduced for QF2C.
-
diff --git a/src/mathlib/gen/history/v142.dat b/src/mathlib/gen/history/v142.dat
deleted file mode 100644
index 3e5fb4f..0000000
--- a/src/mathlib/gen/history/v142.dat
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: v142.dat,v 1.1.1.1 1996/04/01 15:01:35 mclareni Exp $
-*
-* $Log: v142.dat,v $
-* Revision 1.1.1.1 1996/04/01 15:01:35 mclareni
-* Mathlib gen
-*
-*
-C C Additions:
-C ----------
-C
-C Routine changes:
-C ---------------
-C
-C SIMPS - speedup (Michel Roethlisberger/IBM)
-C PROB - change old version to PROBOLD
-C - protection from WW/in2p3
-C - set XLIM to 13.3 on IBM (WW/IN2P3)
-C - Protect prob=h against underflow.
-C
diff --git a/src/mathlib/gen/history/v143.dat b/src/mathlib/gen/history/v143.dat
deleted file mode 100644
index 963f7b6..0000000
--- a/src/mathlib/gen/history/v143.dat
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: v143.dat,v 1.1.1.1 1996/04/01 15:01:35 mclareni Exp $
-*
-* $Log: v143.dat,v $
-* Revision 1.1.1.1 1996/04/01 15:01:35 mclareni
-* Mathlib gen
-*
-*
-C C Additions:
-C ----------
-C
-C C341 BSKA
-C V135 RNGAMA Gama or Chi-square random numbers
-C V136 RNPSSN Poisson random numbers
-C V137 RNBNML Binomial random numbers
-C V138 RNMNML Multinomial random numbers
-C U111 RWIG3J
-C U112 RTCLGN
-C
diff --git a/src/mathlib/gen/history/v144.dat b/src/mathlib/gen/history/v144.dat
deleted file mode 100644
index 4d39c6b..0000000
--- a/src/mathlib/gen/history/v144.dat
+++ /dev/null
@@ -1,80 +0,0 @@
-*
-* $Id: v144.dat,v 1.1.1.1 1996/04/01 15:01:34 uid1605 Exp $
-*
-* $Log: v144.dat,v $
-* Revision 1.1.1.1 1996/04/01 15:01:34 uid1605
-* Mathlib gen
-*
-*
-C Additions:
-C ----------
-C
-C B105 RPLNML - value of a polynomial
-C C326 RCLAUS - Clausen function
-C D102 RADAPT - Adaptive Gaussian quadrature
-C D106 RGS56P - Gaussian quadrature with five and six point rules
-C E102 MAXIZE - maximum and minimum elements of arrays
-C E201 RLSQPM - least squares polynomial fit
-C E222 RCHEBN - solution of overdetermined linear systems in the Chebyshev norm
-C E409 RTRGSM - summation of trigonometric series
-C
-C Deletions:
-C ----------
-C
-C D111 GPINDP MATHLIB CNL 214 Use D103 GAUSS, D107 RGQUAD
-C D115 CHEBQU MATHLIB CNL 214 Use D103 GAUSS, D107 RGQUAD
-C E401 ECTRAD MATHLIB CNL 215 Use E408 RCHPWS
-C E410 CPSC MATHLIB CNL 215 Obsolete
-C F106 SPXINV MATHLIB CNL 211 Use F001 LAPACK
-C F202 LRCH MATHLIB CNL 211 Use F001 LAPACK
-C F230 DEFLS MATHLIB (*) Obsolete
-C F600 SVD MATHLIB CNL 211 Use F001 LAPACK
-C H100 SIMPLE MATHLIB CNL 215 Use H101 RSMPLX
-C H300 ASSIGN MATHLIB CNL 215 Use H301 ASSNDX
-C
-C (*) already deleted, but not announced
-C
-C Routine changes:
-C ---------------
-C
-C E406 QCHECF Increase precision of PI
-C
-C Name changes:
-C -------------
-C
-C Code Old New
-C ---- --- ---
-C
-C C200 ZEROX RZEROX Available on CDC and Cray only
-C C201 SNLEQ RSNLEQ Available on CDC and Cray only
-C C207 RTEQ3 RRTEQ3 Available on CDC and Cray only
-C C208 RTEQ4 RRTEQ4 Available on CDC and Cray only
-C C318 ELFUN RELFUN
-C C322 FRSIN RFRSIN
-C FRCOS RFRCOS
-C C323 FERDR RFERDR
-C C324 ATANI RATANI
-C C330 ASLGF RASLGF
-C C331 FCONC RFCONC
-C C332 DILOG RDILOG
-C C334 GAPNC RGAPNC
-C GAGNC RGAGNC
-C C336 SININT RSININ
-C COSINT RCOSIN
-C C339 DAWSON RDAWSN
-C C342 STRH0 RSTRH0
-C STRH1 RSTRH1
-C C345 BZEJY RBZEJY
-C D104 CAUCHY RCAUCH Available on CDC or Cray only
-C D105 TRIINT RTRINT Available on CDC or Cray only
-C D200 RKSTP RRKSTP
-C D201 DEQBS RDEQBS Available on CDC or Cray only
-C D202 DEQMR RDEQMR Available on CDC or Cray only
-C D203 RKNYS RRKNYS Available on CDC or Cray only
-C D401 DERIV RDERIV Available on CDC or Cray only
-C E102 MAXFZE MAXRZE
-C MINFZE MINRZE
-C E406 CHECF RCHECF Available on CDC or Cray only
-C F500 LIHOIN RLHOIN
-C U501 DJMNB RDJMNB Available on CDC or Cray only
-C
diff --git a/src/mathlib/gen/history/v145.dat b/src/mathlib/gen/history/v145.dat
deleted file mode 100644
index 2c0c05f..0000000
--- a/src/mathlib/gen/history/v145.dat
+++ /dev/null
@@ -1,15 +0,0 @@
-*
-* $Id: v145.dat,v 1.1.1.1 1996/04/01 15:01:32 mclareni Exp $
-*
-* $Log: v145.dat,v $
-* Revision 1.1.1.1 1996/04/01 15:01:32 mclareni
-* Mathlib gen
-*
-*
-C
-C Routine changes:
-C ---------------
-C
-C D501. Correct IF statements to protect against compiler
-C evaluating expressions out of order (from Igor Mandrichenko/FNAL)
-C
diff --git a/src/mathlib/gen/history/v146.dat b/src/mathlib/gen/history/v146.dat
deleted file mode 100644
index 0d56f03..0000000
--- a/src/mathlib/gen/history/v146.dat
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: v146.dat,v 1.1.1.1 1996/04/01 15:01:32 mclareni Exp $
-*
-* $Log: v146.dat,v $
-* Revision 1.1.1.1 1996/04/01 15:01:32 mclareni
-* Mathlib gen
-*
-*
-* 1.46/01 950315
-C
-C Routine changes:
-C ---------------
-C
-C USRTRM. L. Garren - initilize COUNT variable
-C PROB G.Folger one more protection against underflow:
-C chi2/ndf > 100 ( ndf >=2 ) -->> prob=0.
-C D107 G.Folger add RGQUAD for 32 bit machines ( ie. +DOUBLE)
-C
-C D501 KSK, remove false calls to dvset
-C
diff --git a/src/mathlib/gen/history/v147.dat b/src/mathlib/gen/history/v147.dat
deleted file mode 100644
index c10adee..0000000
--- a/src/mathlib/gen/history/v147.dat
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: v147.dat,v 1.1.1.1 1996/04/01 15:01:32 mclareni Exp $
-*
-* $Log: v147.dat,v $
-* Revision 1.1.1.1 1996/04/01 15:01:32 mclareni
-* Mathlib gen
-*
-*
-* 1.47/00 950504
-C
-C Routine changes:
-C ---------------
-C
-C RNPSSN. S. Kolbig - Reduce the exp limit to work on all platforms
-C and allow user to decrease it.
-C V107, G.Folger/F.Streit(Zeuthen), add Convex flags
-C
diff --git a/src/mathlib/gen/history/v148.dat b/src/mathlib/gen/history/v148.dat
deleted file mode 100644
index 9af4515..0000000
--- a/src/mathlib/gen/history/v148.dat
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: v148.dat,v 1.1.1.1 1996/04/01 15:01:32 mclareni Exp $
-*
-* $Log: v148.dat,v $
-* Revision 1.1.1.1 1996/04/01 15:01:32 mclareni
-* Mathlib gen
-*
-*
-* 1.48/00 951031
-C
-C Additions:
-C ----------
-C
-C B002 PRHFCT - Prime Numbers and Prime Factor Decomposition
-C C317 CPSIPG - Psi (Digamma) and Polygamma Functions for Complex Argument
-C D120 RADMUL - Adaptive Quatrature for Multiple Integrals of N-Dimemsional
-C Rectangular Regions
-C E106 LOCATR - Binary Search for Element in Ordered Array
-C
diff --git a/src/mathlib/gen/j/Imakefile b/src/mathlib/gen/j/Imakefile
deleted file mode 100644
index 24f0267..0000000
--- a/src/mathlib/gen/j/Imakefile
+++ /dev/null
@@ -1,10 +0,0 @@
-SRCS_F= conprt.F cont.F finarg.F findem.F frame.F frearg.F \ @@\
- j509bd.F map.F names.F namezb.F ordre2.F paper.F setup.F
-
-FORTRANSAVEOPTION = FortranSaveFlags
-
-#if defined(CERNLIB_SGI)
-IMAKE_DEFINES=-DFortranDoesCpp=NO
-#endif
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/mathlib/gen/j/conprt.F b/src/mathlib/gen/j/conprt.F
deleted file mode 100644
index b3de60e..0000000
--- a/src/mathlib/gen/j/conprt.F
+++ /dev/null
@@ -1,56 +0,0 @@
-*
-* $Id: conprt.F,v 1.1.1.1 1996/04/01 15:02:49 mclareni Exp $
-*
-* $Log: conprt.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:49 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE CONPRT(F,IDM1,IDM2,M,N,NC,FMIN,FMAX)
-C THIS IS ONLY A DRIVING ROUTINE FOR CONT
-C TO MAKE THE CALLING SEQUENCE THE SAME AS THE OLD CONPRT
- EXTERNAL FREARG
- DIMENSION F(IDM1,IDM2)
- DIMENSION CONTUR(10)
- COMMON G(121,121)
- IF(NC.GT.10) GO TO 4
- GO TO 7
- 4 WRITE(6,100)
- 100 FORMAT(' SORRY - ONLY 10 CONTOURS MAY BE USED')
- RETURN
- 7 IF(IDM1.GT.121.OR.IDM2.GT.121) GO TO 8
- GO TO 5
- 8 WRITE(6,200)
- 200 FORMAT(' INTERNAL RESTRICTIONS LIMIT DIMENSIONS TO 121,121')
- RETURN
- 5 XBLCOR = 1.
- YBLCOR = 1.
- XURCOR=M
- YURCOR=N
- A=XBLCOR
- B=XURCOR
- C=YBLCOR
- D=YURCOR
- IA=1
- IB=M
- IC=1
- ID=N
- DO 6 I=1,M
- DO 6 J=1,N
- 6 G(I,J)=F(I,J)
- CALL SETUP(A,IA,B,IB,C,IC,D,ID)
- CALL FRAME(XBLCOR,YBLCOR,XURCOR,YURCOR)
- IF(FMIN.EQ.FMAX.AND.FMAX.EQ.0.) GO TO 1
- RANGE=FMAX-FMIN
- STEP=RANGE/(NC-1)
- CINT=FMIN-STEP
- DO 2 I=1,NC
- CONTUR(I)=CINT+STEP
- CINT=CONTUR(I)
- 2 CONTINUE
- GO TO 3
- 1 CALL FINDEM(FREARG,NC,CONTUR)
- 3 CALL CONT(FREARG,NC,CONTUR)
- RETURN
- END
diff --git a/src/mathlib/gen/j/cont.F b/src/mathlib/gen/j/cont.F
deleted file mode 100644
index 2d5e114..0000000
--- a/src/mathlib/gen/j/cont.F
+++ /dev/null
@@ -1,229 +0,0 @@
-*
-* $Id: cont.F,v 1.1.1.1 1996/04/01 15:02:50 mclareni Exp $
-*
-* $Log: cont.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:50 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE CONT(F,NUMBCS,CONTUR)
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-C PURPOSE C
-C TO PRODUCE A CONTOUR PLOT BY MEANS OF THE PRINTER C
-C USAGE C
-C THIS DEPENDS ON WHETHER THE FUNCTION TO BE PLOTTED HAS REAL C
-C ARGUMENTS OR INTEGER ARGUMENTS. C
-C THE FUNCTION HAS REAL ARGUMENTS, SUPPOSE THE FUNCTION HAS C
-C THE NAME Z. C
-C EXTERNAL Z C
-C DIMENSION CONTUR(10) C
-C CALL PAPER.... C
-C CALL NAMES.... C
-C CALL FRAME.... C
-C CONTUR(1)=.... C
-C CONTUR(2)=.... C
-C . C
-C . C
-C . C
-C CALL CONT(Z,NUMBCS,CONTUR) C
-C IF YOU DO NOT KNOW WHAT SORT OF VALUES TO ASSIGN TO THE ARRAY C
-C CONTUR, YOU CAN CALL THE SUBROUTINE FINDEM WHICH WILL HELP YOU. C
-C CALL FINDEM(Z,NUMBCS,CONTUR) C
-C C
-C F HAS INTEGER ARGUMENTS--- C
-C EXTERNAL FREARG C
-C DIMENSION CONTUR(10) C
-C CALL PAPER.... C
-C CALL NAMES.... C
-C CALL FRAME.... C
-C CONTUR(1)=.... C
-C CONTUR(2)=.... C
-C . C
-C . C
-C . C
-C CALL SETUP.... C
-C CALL CONT(FREARG,NUMBCS,CONTUR) C
-C AGAIN, YOU MAY USE FINDEM TO ASSIGN VALUES TO THE ARRAY CONTUR. C
-C CALL FINDEM(FREARG,NUMBCS,CONTUR) C
-C NOTE THAT THE FIRST PARAMETER OF CONT AND FINDEM MUST HAVE C
-C THE NAME FREARG. C
-C THE FUNCTION TO BE PLOTTED MUST HAVE THE NAME FINARG. C
-C PARAMETERS C
-C F - THE FUNCTION TO BE PLOTTED. F MUST BE A REAL FUNCTION C
-C WITH TWO REAL PARAMETERS. IF THE FUNCTION YOU WANT TO C
-C PLOT HAS INTEGER ARGUMENTS, THIS FUNCTION SHOULD BE C
-C NAMED FINARG AND THE FIRST ACTUAL PARAMETER IN THE C
-C CALL TO CONT SHOULD BE FREARG. C
-C (FREARG IS A FUNCTION WHICH CALLS FINARG FOUR TIMES C
-C AND PERFORMS A TWO-WAY LINEAR INTERPOLATION ON THESE C
-C FOUR VALUES.) C
-C NUMBCS - THE NUMBER OF CONTOURS TO BE PLOTTED. NUMBS MUST BE C
-C AT LEAST 1 AND AT MOST 10. C
-C CONTUR - AN ARRAY CONTAINING THE FUNCTION VALUES ON THE VARIOUS C
-C CONTOURS. THESE FUNCTION VALUES DO NOT HAVE TO BE C
-C EQUIDISTANT AND NOT EVEN MONOTONOUS. C
-C THE NUMBER 0 IS PRINTED WHERE F=CONTUR(1), C
-C THE NUMBER 1 IS PRINTED WHERE F=CONTUR(2), C
-C ETC. C
-C REMARKS C
-C THE CHOSEN NAME FOR F MUST APPEAR IN AN EXTERNAL STATEMENT IN C
-C THE PROGRAM CALLING CONT. C
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
- EXTERNAL F
- DIMENSION CONTUR(10),SAVEC(10),SAVES(10)
- DIMENSION XVALUS(12)
- COMMON /J509C1/XBL,YBL,XUR,YUR,NX(6),NY(6),LETT1,LETT2,LINE1,LINE2
- REAL FU(133),FB(133)
- INTEGER LETTRI,MINUS,STAR,BLANK,SYMBOL(10),LINEIM(132)
- DATA LETTRI,MINUS,STAR,BLANK/1HI,1H-,1H*,1H /
-#if !defined(CERNLIB_F90)
- DATA SYMBOL(1),SYMBOL(2),SYMBOL(3),SYMBOL(4)/1H0,1H1,1H2,1H3/
- DATA SYMBOL(5),SYMBOL(6),SYMBOL(7),SYMBOL(8)/1H4,1H5,1H6,1H7/
- DATA SYMBOL(9),SYMBOL(10)/1H8,1H9/
- DATA LSLASH,LDOT/1H/ , 1H. /
-C=======================================================================
-#endif
-#if defined(CERNLIB_F90)
- INTEGER, DIMENSION(10) :: SYMBOL = (/ transfer('0 ', 0), &
- transfer('1 ', 0), transfer('2 ', 0), transfer('3 ', 0), &
- transfer('4 ', 0), transfer('5 ', 0), transfer('6 ', 0), &
- transfer('7 ', 0), transfer('8 ', 0), transfer('9 ', 0) /)
- INTEGER :: LSLASH = transfer('/ ', 0), LDOT = transfer('. ',0)
-!=======================================================================
-#endif
- IF (1.LE.NUMBCS.AND.NUMBCS.LE.10) GOTO 10
- WRITE (6, 1010) NUMBCS
- IF(1.LE.NUMBCS .AND. NUMBCS.LE.10)GO TO 10
- WRITE(6,1010)NUMBCS
- RETURN
- 10 CONTINUE
-C
-C INITIALIZE COMMON BLOCK IF NOT ALREADY DONE
- CALL J509BD
- LETT0 = LETT1 - 1
- LINE0 = LINE1 - 1
- LETT3 = LETT2 + 1
- LINE3 = LINE2 + 1
-C SAVE CONTOUR VALUES AND ORDER THEM ASCENDING
- CALL UCOPY(CONTUR,SAVEC,NUMBCS)
- CALL UCOPY(SYMBOL,SAVES,NUMBCS)
- CALL ORDRE2(CONTUR,SYMBOL,NUMBCS)
-C
-C THE ARRAY LINEIM IS A BUFFER FOR A LINE IMAGE. C
-C PRINT LINE ALONG TOP OF FRAME
- WRITE(6,1030)NY
- LINEIM(LETT0)=STAR
- DO 30 LETT=LETT1,LETT2
- 30 LINEIM(LETT)=MINUS
- LINEIM(LETT3)=STAR
- WRITE(6,1060)YUR,(LINEIM(LETT),LETT=LETT0,LETT3)
- MIDDLE=(LINE1+LINE2)/2
- DLINE = LINE2-LINE1+1
- DLETT = LETT2-LETT1+1
- DXVAL = (XUR-XBL) / DLETT
- DYVAL = (YUR-YBL) / DLINE
- YVAL = YUR
- XVAL = XBL
- DO 40 LETT=LETT1,LETT3
- FU(LETT) = F(XVAL,YVAL)
- 40 XVAL = XVAL + DXVAL
-CCC
- MAXCON = 1
- MINCON = 10
- YVAL = YUR
-CCC LOOP OVER LINES STARTS HERE
-C
- DO 90 LINE=LINE1,LINE2
- YVAL = YVAL - DYVAL
- XVAL = XBL-DXVAL
- DO 50 LETT=LETT1,LETT3
- XVAL = XVAL + DXVAL
- 50 FB(LETT) = F(XVAL,YVAL)
- DO 70 LETT=LETT1,LETT2
- FUL=FU(LETT)
- FUR=FU(LETT+1)
- FBL=FB(LETT)
- FBR=FB(LETT+1)
-C FUL IS THE FUNCTION VALUE AT THE POINT (LETT-1/2,LINE-1/2) C
-C FUR IS THE FUNCTION VALUE AT THE POINT (LETT+1/2,LINE-1/2) C
-C FBL IS THE FUNCTION VALUE AT THE POINT (LETT-1/2,LINE+1/2) C
-C FBR IS THE FUNCTION VALUE AT THE POINT (LETT+1/2,LINE+1/2) C
-C C
-C FIND OUT IF THERE IS A CONTOUR VALUE WHICH FALLS BETWEEN THE C
-C BIGGEST AND THE SMALLEST OF THE FUNCTION VALUES AT THE FOUR C
-C CORNERS OF THE PRESENT PRINT POSITION (LETT,LINE). C
-C IF SO, PRINT THE CORRESPONDING SYMBOL. C
-C IF NOT, PRINT A BLANK AT THE POINT (LETT,LINE). C
- BIG =MAX(FUL,FUR,FBL,FBR)
- SMALL=MIN(FUL,FUR,FBL,FBR)
- LINEIM(LETT)=BLANK
- DO 60 NUMBC=1,NUMBCS
- IF (BIG .LT. CONTUR(NUMBC)) GO TO 70
- IF (SMALL .GT. CONTUR(NUMBC)) GO TO 60
- LINEIM(LETT) = SYMBOL(NUMBC)
- IF (NUMBC .GT. MAXCON) MAXCON = NUMBC
- IF (NUMBC .LT. MINCON) MINCON = NUMBC
- 60 CONTINUE
- 70 CONTINUE
- IF (MOD(LINE,10) .EQ. LINE0) GO TO 73
-C PRINT LINE (NORMAL LINE)
- LINEIM(LETT0) = LETTRI
- LINEIM(LETT3) = LETTRI
- WRITE(6,1050) (LINEIM(LETT),LETT=LETT0,LETT3)
- GO TO 76
-C PRINT LINE (EVEN TENTH LINE)
- 73 LINEIM(LETT0) = LDOT
- LINEIM(LETT3) = LDOT
- WRITE(6,1040) YVAL,(LINEIM(LETT),LETT=LETT0,LETT3)
- 76 CONTINUE
- DO 80 LETT=LETT1,LETT3
- 80 FU(LETT)=FB(LETT)
- 90 CONTINUE
-C PRINT LINE ALONG BOTTOM OF FRAME
- LINEIM(LETT0)=STAR
- DO 100 LETT=LETT1,LETT2
- 100 LINEIM(LETT)=MINUS
- LINEIM(LETT3)=STAR
- WRITE(6,1060)YBL,(LINEIM(LETT),LETT=LETT0,LETT3)
-C PRINT LABELS ON X-AXIS EVERY 10 COLIMNS
- LETT2P = LETT2 + 10
- DO 119 LETT= 2, LETT2P
- 119 LINEIM(LETT) = BLANK
- X10COL = 10.*DXVAL
- ITENMX = 11
- LETT = LETT0
- DO 129 ITEN= 1, ITENMX
- XVALUS(ITEN) = XBL + X10COL*(ITEN-1)
- LINEIM(LETT) = LSLASH
- LETT = LETT + 10
- IF (XVALUS(ITEN) .GT. (XUR-5.*DXVAL)) GO TO 139
- 129 CONTINUE
- ITEN = ITENMX
- 139 CONTINUE
- WRITE(6,1090) (LINEIM(LETT),LETT=2,LETT2P)
- WRITE(6,1100) (XVALUS(II),II=1,ITEN)
-C PRINT VARIABLE NAME FOR X-AXIS
- WRITE(6,1110)NX,DXVAL
- IF (MAXCON .LT. MINCON) GO TO 125
- WRITE(6,1120) (SYMBOL(NN),CONTUR(NN),NN=MINCON,MAXCON)
- GO TO 135
- 125 CONTINUE
- WRITE(6,1130)
- 135 CONTINUE
-C RESTORE INITIAL CONTOUR ORDERING
- CALL UCOPY(SAVES,SYMBOL,NUMBCS)
- CALL UCOPY(SAVEC,CONTUR,NUMBCS)
- RETURN
- 1010 FORMAT(' HOW MANY CONTOURS DID YOU WANT---',I10,'---(CONT)')
- 1030 FORMAT('1',120A1)
- 1040 FORMAT(1X,F8.3,1X,122A1)
- 1050 FORMAT(10X,122A1)
- 1060 FORMAT(1X,F8.3,'-',122A1)
- 1090 FORMAT(1X,131A1)
- 1100 FORMAT(4X,12(1X,F9.3))
- 1110 FORMAT(20X,6A1,20X,'ONE COLUMN =',E10.3,10X,
- * 2('CONTOUR FCN VALUE '))
- 1120 FORMAT(80X,A1,F14.5,7X,A1,F14.5)
- 1130 FORMAT(80X,'NO CONTOURS FOUND'/)
- END
diff --git a/src/mathlib/gen/j/finarg.F b/src/mathlib/gen/j/finarg.F
deleted file mode 100644
index 4940609..0000000
--- a/src/mathlib/gen/j/finarg.F
+++ /dev/null
@@ -1,14 +0,0 @@
-*
-* $Id: finarg.F,v 1.1.1.1 1996/04/01 15:02:50 mclareni Exp $
-*
-* $Log: finarg.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:50 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- FUNCTION FINARG(I,J)
- COMMON G(121,121)
- FINARG=G(I,J)
- RETURN
- END
diff --git a/src/mathlib/gen/j/findem.F b/src/mathlib/gen/j/findem.F
deleted file mode 100644
index 0c2e6f2..0000000
--- a/src/mathlib/gen/j/findem.F
+++ /dev/null
@@ -1,57 +0,0 @@
-*
-* $Id: findem.F,v 1.1.1.1 1996/04/01 15:02:50 mclareni Exp $
-*
-* $Log: findem.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:50 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE FINDEM(F,NUMBCS,CONTUR)
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-C PURPOSE C
-C TO FIND REASONABLE CONTOUR VALUES FOR A USER WHO HAS NOT C
-C ALREADY MADE UP HIS MIND. (AUXILIARY TO CONT.) C
-C USAGE C
-C CALL FINDEM(F,NUMBCS,CONTUR) C
-C PARAMETERS C
-C F - THE FUNCTION TO BE PLOTTED BY CONT C
-C NUMBCS - THE DESIRED NUMBER OF CONTOURS C
-C CONTUR - AN ARRAY INTO WHICH THE CONTOUR VALUES WILL BE RETURNED.C
-C THE CHOSEN NAME FOR F MUST APPEAR IN AN EXTERNAL STATEMENT IN C
-C THE PROGRAM CALLING FINDEM. C
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
- EXTERNAL F
- DIMENSION CONTUR(10)
- COMMON /J509C1/XBL,YBL,XUR,YUR,NX(6),NY(6),LETT1,LETT2,LINE1,LINE2
-C=======================================================================
- IF(1.LE.NUMBCS .AND. NUMBCS.LE.10)GO TO 10
- WRITE(6,1010)NUMBCS
- RETURN
- 10 CONTINUE
- CALL J509BD
- FMIN = F(XBL,YBL)
- FMAX=FMIN
- XVAL = XBL
- DXVAL = 2.*(XUR-XBL)/(LETT2-LETT1)
- YVAL = YBL
- DYVAL = 2.*(YUR-YBL)/(LINE2-LINE1)
- DO 30 LETT= LETT1,LETT2,2
- XVAL = XVAL + DXVAL
- YVAL = YBL
- DO 20 LINE= LINE1,LINE2,2
- YVAL = YVAL + DYVAL
- FNOW = F(XVAL,YVAL)
- IF(FNOW .LT. FMIN)FMIN=FNOW
- IF(FNOW .GT. FMAX)FMAX=FNOW
- 20 CONTINUE
- 30 CONTINUE
- SPAN=FMAX-FMIN
- CFIRST=FMIN+0.05*SPAN
- CLAST=FMAX-0.05*SPAN
- STEP=(CLAST-CFIRST)/(NUMBCS-1)
- DO 40 NUMBC=1,NUMBCS
- 40 CONTUR(NUMBC)=CFIRST+(NUMBC-1)*STEP
- RETURN
- 1010 FORMAT(' HOW MANY CONTOURS DID YOU WANT---',I10,'---(FINDEM)')
- END
diff --git a/src/mathlib/gen/j/frame.F b/src/mathlib/gen/j/frame.F
deleted file mode 100644
index 22fe5b4..0000000
--- a/src/mathlib/gen/j/frame.F
+++ /dev/null
@@ -1,40 +0,0 @@
-*
-* $Id: frame.F,v 1.1.1.1 1996/04/01 15:02:50 mclareni Exp $
-*
-* $Log: frame.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:50 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE FRAME(XBLCOR,YBLCOR,XURCOR,YURCOR)
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-C PURPOSE C
-C TO SET UP THE PLOT FRAME FOR THE CONTOUR PLOTTING PROGRAM CONT. C
-C USAGE C
-C CALL FRAME(XBLCOR,YBLCOR,XURCOR,YURCOR) C
-C THIS STATEMENT SHOULD BE EXECUTED BEFORE CONT IS CALLED. C
-C PARAMETERS C
-C XBLCOR - THE X-COORDINATE OF THE BOTTOM LEFT CORNER OF THE C
-C PLOT FRAME C
-C YBLCOR - THE Y-COORDINATE OF THE BOTTOM LEFT CORNER OF THE C
-C PLOT FRAME C
-C XURCOR - THE X-COORDINATE OF THE UPPER RIGHT CORNER OF THE C
-C PLOT FRAME C
-C YURCOR - THE Y-COORDINATE OF THE UPPER RIGHT CORNER OF THE C
-C PLOT FRAME C
-C
- COMMON /J509C1/XBL,YBL,XUR,YUR,NX(6),NY(6),LETT1,LETT2,LINE1,LINE2
- CALL J509BD
-C
- XBL = XBLCOR
- YBL=YBLCOR
- XUR=XURCOR
- YUR=YURCOR
- IF(XUR.LE.XBL.OR.YUR.LE.YBL) GOTO 1
- RETURN
- 1 WRITE(6,100)XBL,YBL,XUR,YUR
- 100 FORMAT(' ERROR IN FRAME - EXIT CALLED'/' XBLCOR = ',F8.3,5X
- + ,'YBLCOR = ',F8.3,5X,'XURCOR = ',F8.3,5X,'YURCOR = ',F8.3)
- STOP
- END
diff --git a/src/mathlib/gen/j/frearg.F b/src/mathlib/gen/j/frearg.F
deleted file mode 100644
index c2a4f2d..0000000
--- a/src/mathlib/gen/j/frearg.F
+++ /dev/null
@@ -1,98 +0,0 @@
-*
-* $Id: frearg.F,v 1.1.1.1 1996/04/01 15:02:50 mclareni Exp $
-*
-* $Log: frearg.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:50 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- FUNCTION FREARG(X,Y)
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-C PURPOSE C
-C TO PERFORM A LINEAR INTERPOLATION ON A REAL FUNCTION OF TWO C
-C INTEGER ARGUMENTS. THIS FUNCTION MUST HAVE THE NAME FINARG. C
-C FREARG IS PLANNED FOR USE WITH THE CONTOUR PROGRAM CONT. C
-C LET US DENOTE THE ARGUMENTS OF FINARG BY I AND J. C
-C X AND I SHALL BE LINEARLY RELATED TO EACH OTHER. C
-C Y AND J SHALL BE LINEARLY RELATED TO EACH OTHER. C
-C THESE RELATIONSHIPS ARE COMPLETELY DEFINED BY REQUIRING THAT C
-C X=X1 CORRESPONDS TO I=I1, C
-C X=X2 CORRESPONDS TO I=I2, C
-C Y=Y1 CORRESPONDS TO J=J1, C
-C Y=Y2 CORRESPONDS TO J=J2. C
-C USAGE C
-C AFTER THE STATEMENT C
-C CALL SETUP(X1,I1,X2,I2,Y1,J1,Y2,J2) C
-C HAS BEEN EXECUTED, THE EXPRESSION C
-C FREARG(X,Y) C
-C WILL HAVE THE VALUE FOUND BY LINEAR INTERPOLATION FROM THE FOUR C
-C NEAREST VALUES OF THE CORRESPONDING FUNCTION FINARG(I,J). C
-C PARAMETERS C
-C X -LINEARLY RELATED TO I, C
-C Y -LINEARLY RELATED TO J. C
-C EXTERNAL SUBPROGRAMS USED C
-C FINARG C
-C INTER C
-C REMARKS C
-C FINARG IS TO BE WRITTEN BY THE USER. C
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
- COMMON /J509C2/CX1,CI1,CX2,CI2,CY1,CJ1,CY2,CJ2
-C=======================================================================
-C STATEMENT FUNCTION YINTER DOES A LINEAR INTERPOLATION
- YINTER(X1,Y1,X2,Y2,XIN)=((X2-XIN)*Y1+(XIN-X1)*Y2)/(X2-X1)
-C
- REALI = YINTER(CX1,CI1,CX2,CI2,X)
- REALJ = YINTER(CY1,CJ1,CY2,CJ2,Y)
-#if !defined(CERNLIB_HPUX)
-C*IA X1,Y1,X2,Y2,XIN
- DATA X1,Y1,X2,Y2,XIN/5*0/
-#endif
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-C FIND NEAREST INTEGER LEFT -HAND NEIGHBOUR OF REALI, CALL IT IL, C
-C FIND NEAREST INTEGER RIGHT-HAND NEIGHBOUR OF REALI, CALL IT IR, C
-C FIND NEAREST INTEGER LEFT -HAND NEIGHBOUR OF REALJ, CALL IT JL, C
-C FIND NEAREST INTEGER RIGHT-HAND NEIGHBOUR OF REALJ, CALL IT JR. C
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
- IL=REALI
- JL=REALJ
-C MAKE SURE THE TABLE VALUES EXIST
- IF (REALI .LT. 1.0) IL=1
- IF (REALJ .LT. 1.0) JL=1
- IF (REALI .GE. CI2) IL= CI2-1.0
- IF (REALJ .GE. CJ2) JL= CJ2-1.0
- IR=IL+1
- JR=JL+1
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-C CONVERT THEM ALL TO REAL NUMBERS,AS ITER WANTS REAL ARGUMENTS. C
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
- REALIL=IL
- REALIR=IR
- REALJL=JL
- REALJR=JR
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-C FIND THE FOUR NEAREST FUNCTION VALUES OF FINARG AROUND C
-C FINARG(REALI,RELAJ), WHICH IS NOT DEFINED. C
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
- FLL=FINARG(IL,JL)
- FLR=FINARG(IL,JR)
- FRL=FINARG(IR,JL)
- FRR=FINARG(IR,JR)
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-C INTERPOLATED BETWEEN IL AND IR, WITH J=JL. C
- F0L = YINTER(REALIL,FLL,REALIR,FRL,REALI)
-C
-C INTERPOLATE BETWEEN IL AND IR, WITH J=JR. C
- F0R = YINTER(REALIL,FLR,REALIR,FRR,REALI)
-C
-C FINALLY, INTERPOLATE BETWEEN JL AND JR, WITH I=REALI C
- F00 = YINTER(REALJL,F0L,REALJR,F0R,REALJ)
-C
- FREARG=F00
- RETURN
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-C IT IS LEFT AS AN EXERCISE TO THE READER TO PROVE THAT TWO INTER- C
-C POLATIONS IN THE J-DIRECTION AND FINALLY ONE IN THE I-DIRECTION C
-C WOULD GIVE THE SAME RESULT. C
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
- END
diff --git a/src/mathlib/gen/j/j509bd.F b/src/mathlib/gen/j/j509bd.F
deleted file mode 100644
index c2c972b..0000000
--- a/src/mathlib/gen/j/j509bd.F
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: j509bd.F,v 1.1.1.1 1996/04/01 15:02:50 mclareni Exp $
-*
-* $Log: j509bd.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:50 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE J509BD
-C SETS DEFAULT VALUES FOR PACKAGE J509, BY COPYING THEM FROM
-C A DATA AREA TO COMMON BLOCKS. USER MAY OVERRIDE THESE VALUES
-C BY CALLING THE APPROPRIATE SUBROUTINES (NAMES,PAPER,SETUP)
- COMMON /J509C1/XBL,YBL,XUR,YUR,NX(6),NY(6),LETT1,LETT2,LINE1,LINE2
- COMMON /J509C2/CX1,CI1,CX2,CI2,CY1,CJ1,CY2,CJ2
- DATA KLETT1,KLETT2,KLINE1,KLINE2/ 12,111,2,51/
- DATA INIT/0/
- IF (INIT .GT. 0) RETURN
- INIT = 1
- LETT1 = KLETT1
- LETT2 = KLETT2
- LINE1 = KLINE1
- LINE2 = KLINE2
-
- CALL VBLANK(NX,6)
- CALL VBLANK(NY,6)
-
- RETURN
- END
diff --git a/src/mathlib/gen/j/map.F b/src/mathlib/gen/j/map.F
deleted file mode 100644
index 05b9b58..0000000
--- a/src/mathlib/gen/j/map.F
+++ /dev/null
@@ -1,100 +0,0 @@
-*
-* $Id: map.F,v 1.1.1.1 1996/04/01 15:02:51 mclareni Exp $
-*
-* $Log: map.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:51 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE MAP(F,XL,XU,XD)
-C WRITE(6,)A TABLE AND PLOT OF THE FUNCTION F
- DIMENSION Y(512),LINE(103)
- EXTERNAL F
- WRITE(6,500)
- 500 FORMAT('Q')
-#if defined(CERNLIB_IBM)||defined(CERNLIB_CDC)
- I=LOCF(F)-LOCF(LINE)
-#endif
-#if defined(CERNLIB_CDC)
- WRITE(6,1)LINE(I-2)
- 1 FORMAT('1',40('.'),' TABLE AND PLOT OF THE FUNCTION ',A7)
-#endif
-#if defined(CERNLIB_IBM)
- I=LINE(I+1)/4-LOCF(LINE)
- WRITE(6,1)LINE(I+2),LINE(I+3)
- 1 FORMAT('1',40('.'),' TABLE AND PLOT OF THE FUNCTION ',A4,A3)
-#endif
-#if defined(CERNLIB_VAX)
- WRITE(6,1)
- 1 FORMAT('1',40('.'),' TABLE AND PLOT OF THE USER FUNCTION')
-#endif
- IF (XU .LE. XL) GO TO 20
- IF (XD .LE. 0.) GO TO 30
- IF ( (XU-XL)/XD .LT. 2.) GO TO 40
- DO 2 I=1,512
- X=XL+(I-1)*XD
- IF(X.GT.XU)GO TO 3
- 2 Y(I)=F(X)
- I=513
- 3 NX=I-1
- YXU=F(XU)
- YL=Y(1)
- YU=YL
- DO 4 I=2,NX
- Y1=Y(I)
- YL=MIN(Y1,YL)
- 4 YU=MAX(Y1,YU)
- NY=100
- YD=(YU-YL)/NY
- WRITE(6,5)XL,YL,XU,YU,XD,YD,NX,NY
- 5 FORMAT('0',14X,'ABSCISSA PARAMETERS=',48X,'ORDINATE PARAMETERS='/
- + 15X,'LOWER LIMIT...',E12.3,42X,'LOWER LIMIT...',E12.3/
- + 15X,'UPPER LIMIT...',E12.3,42X,'UPPER LIMIT...',E12.3/
- + 15X,'STEP SIZE.....',E12.3,42X,'BIN SIZE......',E12.3/
- + 15X,'POINT NUMBER..', I12,42X,'BIN NUMBER....',I12/)
- WRITE(6,6)(I,I=10,100,10)
- 6 FORMAT('0POINT ABSCISSA ORDINATE 0',9I10,I11)
- YP=YL*YU
- IF(YP.GE.0)GO TO 101
- K=INT(-YL/YD)+2
- 101 CONTINUE
- WRITE(6,9)
- 9 FORMAT(29X,'O',10('+',9('-')),'+O')
- YS=0.0
- CALL VBLANK(LINE,103)
- DO 11 I=1,NX
- N=I-1
- X=XL+N*XD
- Y1=Y(I)
- YS=YS+Y1
- J=INT((Y1-YL)/YD)+2
- IF(YP.LT.0.) CALL VFILL(LINE(K),1,1H.)
- CALL VFILL(LINE(1),1,1HI)
- LINE(103)=LINE(1)
- IF(MOD(N,10).NE.0)GO TO 12
- CALL VFILL(LINE(1),1,1H+)
- LINE(103)=LINE(1)
- 12 CALL VFILL(LINE(J),1,1H*)
- WRITE(6,13)N,X,Y1,LINE
- 13 FORMAT(I6,1X,2E10.3,2X,103A1)
- 11 CALL VBLANK(LINE(J),1)
- WRITE(6,9)
- V=2.0*YS-Y(1)-Y(NX)
- V=0.5*XD*V
- V=V+0.5*(XU-X)*(Y(NX)+YXU)
- WRITE(6,16)V
- 16 FORMAT('0','ESTIMATE OF INTEGRAL...',E10.3)
- WRITE(6,17)
- 17 FORMAT('0',130('='))
- RETURN
- 20 WRITE(6,200)
- STOP 1
- 30 WRITE(6,300)
- STOP 1
- 40 WRITE(6,400)
- STOP 1
- 200 FORMAT('0UPPER LIMIT <= LOWER LIMIT - MAP STOPS')
- 300 FORMAT('0DISTANCE BETWEEN POINTS <= 0 - MAP STOPS')
- 400 FORMAT('0DISTANCE BETWEEN POINTS > INTERVAL/2 - MAP STOPS')
- END
diff --git a/src/mathlib/gen/j/names.F b/src/mathlib/gen/j/names.F
deleted file mode 100644
index 57e1134..0000000
--- a/src/mathlib/gen/j/names.F
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: names.F,v 1.1.1.1 1996/04/01 15:02:51 mclareni Exp $
-*
-* $Log: names.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:51 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE NAMES(NXARG,NYARG)
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-C PURPOSE C
-C TO DEFINE WHICH LABELS SHALL BE PRINTED AT THE AXES BY C
-C SUBSEQUENT CALLS TO THE SUBROUTINE CONT. C
-C USAGE C
-C IF YOU FOR EXAMPLE WANT THE WORD KSI TO BE PRINTED AT THE C
-C HORIZONTAL AXIS AND THE WORD ETA TO BE PRINTED AT THE VERTICAL C
-C AXIS, EXECUTE THE STATEMENT C
-C CALL NAMES(NXARG,NYARG) C
-C BEFORE THE CALL TO CONT.WHERE - C
-C DATA NXARG,NYARG/6HKSI ,6HETA /
-C PARAMETERS C
-C NXARG - THE NAME TO BE PRINTED AT THE HORIZONTAL AXIS. C
-C NYARG - THE NAME TO BE PRINTED AT THE VERTICAL AXIS. C
-C REMARKS C
-C THE DEFAULT OPTION OF BLANK NAMES IS AUTOMATICALLY PROVIDED. C
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
- COMMON /J509C1/XBL,YBL,XUR,YUR,NX(6),NY(6),LETT1,LETT2,LINE1,LINE2
-C
- CALL J509BD
- CALL UBLOW(NXARG,NX,6)
- CALL UBLOW(NYARG,NY,6)
- RETURN
- END
diff --git a/src/mathlib/gen/j/namezb.F b/src/mathlib/gen/j/namezb.F
deleted file mode 100644
index 1aad20e..0000000
--- a/src/mathlib/gen/j/namezb.F
+++ /dev/null
@@ -1,220 +0,0 @@
-*
-* $Id: namezb.F,v 1.1.1.1 1996/04/01 15:02:49 mclareni Exp $
-*
-* $Log: namezb.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:49 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_CDC)
- SUBROUTINE NAMEZB(CHSTR,NN,LFN)
- DIMENSION A(13),C(120),H(6)
- DIMENSION CHSTR(2)
- DATA H/10HABCDEFGHIJ,10HKLMNOPQRST,10HUVWXYZ1234
- + ,10H567890 '-+,10H="[!.,/#*<,10H>_()]:;?&$/
- DATA HC/1H#/,NL/9/,NC/13/
-#endif
-#if (defined(CERNLIB_CDC))&&(defined(CERNLIB_F4))
- DATA (C(I),I=1,20)
- + /00000007717731061061B, 03101770770000000000B,
- + 00000077777744144144B, 14417773360000000000B,
- + 00000037677740140140B, 14016032020000000000B,
- + 00000077777740140140B, 14017773760000000000B,
- + 00000077777744144144B, 14014014010000000000B,
- + 00000077777744044044B, 04004004000000000000B,
- + 00000037677740140141B, 14116172160000000000B,
- + 00000077777704004004B, 00407777770000000000B,
- + 00000040140140177777B, 74014014010000000000B,
- + 00000040240340177777B, 64004004000000000000B/
- DATA (C(I),I=21,40)
- + /00000077777706017031B, 46064030010000000000B,
- + 00000077777700100100B, 10010010010000000000B,
- + 00000077737714006006B, 01403777770000000000B,
- + 00000077737714006003B, 00147777770000000000B,
- + 00000037577640543146B, 15013775760000000000B,
- + 00000077777741041041B, 04107703600000000000B,
- + 00000037677740140140B, 54037763750000000000B,
- + 00000077777741041041B, 44167733610000000000B,
- + 00000030274344144144B, 14416772360000000000B,
- + 00000040040040077777B, 74004004000000000000B/
- DATA (C(I),I=41,60)
- + /00000077677700100100B, 10017777760000000000B,
- + 00000077077400600300B, 30067747700000000000B,
- + 00000077777601403003B, 00147767770000000000B,
- + 00000040761733016016B, 03306174070000000000B,
- + 00000040060030017717B, 73006004000000000000B,
- + 00000040340741543146B, 15417016010000000000B,
- + 00000000100120177777B, 70010010010000000000B,
- + 00000020761743146144B, 14417413010000000000B,
- + 00000020260340144144B, 14417773360000000000B,
- + 00000001003007015031B, 07777770100000000000B/
- DATA (C(I),I=61,80)
- + /00000074274344144144B, 14414774360000000000B,
- + 00000037677744144144B, 14416772360000000000B,
- + 00000040040040047757B, 77006004000000000000B,
- + 00000033677744144144B, 14417773360000000000B,
- + 00000036277341141141B, 14117773760000000000B,
- + 00000037677740140140B, 14017773760000000000B,
- + 00000000000000000000B, 00000000000000000000B,
- + 00000000000000070070B, 00000000000000000000B,
- + 00000002002002002002B, 00200200200000000000B,
- + 00000002002002017417B, 40200200200000000000B/
- DATA (C(I),I=81,100)
- + /00000005005005005005B, 00500500500000000000B,
- + 00000000060060000000B, 06006000000000000000B,
- + 00000000000077777740B, 14010000000000000000B,
- + 00000000000040140177B, 77770000000000000000B,
- + 00000000000000000300B, 30000000000000000000B,
- + 00000000000000000500B, 60000000000000000000B,
- + 00000000300601403006B, 01403006000000000000B,
- + 00000005005407015005B, 40701500500000000000B,
- + 00000002012407002007B, 01240200000000000000B,
- + 00000002007005010410B, 42022020000000000000B/
- DATA (C(I),I=101,120)
- + /00000020220210410405B, 00700200000000000000B,
- + 00000000100100100100B, 10010010010000000000B,
- + 00000000000007017420B, 24010000000000000000B,
- + 00000000000040120217B, 40700000000000000000B,
- + 00000000000000077377B, 30000000000000000000B,
- + 00000000000000003303B, 30000000000000000000B,
- + 00000000000000002502B, 60000000000000000000B,
- + 00000020040040043347B, 35407002000000000000B,
- + 00000034646743143142B, 54433060110000000000B,
- + 00000014422222277777B, 72122161040000000000B/
-#endif
-#if (defined(CERNLIB_CDC))&&(!defined(CERNLIB_F4))
- DATA (C(I),I=1,20)
- + /O"00000007717731061061", O"03101770770000000000",
- + O"00000077777744144144", O"14417773360000000000",
- + O"00000037677740140140", O"14016032020000000000",
- + O"00000077777740140140", O"14017773760000000000",
- + O"00000077777744144144", O"14014014010000000000",
- + O"00000077777744044044", O"04004004000000000000",
- + O"00000037677740140141", O"14116172160000000000",
- + O"00000077777704004004", O"00407777770000000000",
- + O"00000040140140177777", O"74014014010000000000",
- + O"00000040240340177777", O"64004004000000000000"/
- DATA (C(I),I=21,40)
- + /O"00000077777706017031", O"46064030010000000000",
- + O"00000077777700100100", O"10010010010000000000",
- + O"00000077737714006006", O"01403777770000000000",
- + O"00000077737714006003", O"00147777770000000000",
- + O"00000037577640543146", O"15013775760000000000",
- + O"00000077777741041041", O"04107703600000000000",
- + O"00000037677740140140", O"54037763750000000000",
- + O"00000077777741041041", O"44167733610000000000",
- + O"00000030274344144144", O"14416772360000000000",
- + O"00000040040040077777", O"74004004000000000000"/
- DATA (C(I),I=41,60)
- + /O"00000077677700100100", O"10017777760000000000",
- + O"00000077077400600300", O"30067747700000000000",
- + O"00000077777601403003", O"00147767770000000000",
- + O"00000040761733016016", O"03306174070000000000",
- + O"00000040060030017717", O"73006004000000000000",
- + O"00000040340741543146", O"15417016010000000000",
- + O"00000000100120177777", O"70010010010000000000",
- + O"00000020761743146144", O"14417413010000000000",
- + O"00000020260340144144", O"14417773360000000000",
- + O"00000001003007015031", O"07777770100000000000"/
- DATA (C(I),I=61,80)
- + /O"00000074274344144144", O"14414774360000000000",
- + O"00000037677744144144", O"14416772360000000000",
- + O"00000040040040047757", O"77006004000000000000",
- + O"00000033677744144144", O"14417773360000000000",
- + O"00000036277341141141", O"14117773760000000000",
- + O"00000037677740140140", O"14017773760000000000",
- + O"00000000000000000000", O"00000000000000000000",
- + O"00000000000000070070", O"00000000000000000000",
- + O"00000002002002002002", O"00200200200000000000",
- + O"00000002002002017417", O"40200200200000000000"/
- DATA (C(I),I=81,100)
- + /O"00000005005005005005", O"00500500500000000000",
- + O"00000000060060000000", O"06006000000000000000",
- + O"00000000000077777740", O"14010000000000000000",
- + O"00000000000040140177", O"77770000000000000000",
- + O"00000000000000000300", O"30000000000000000000",
- + O"00000000000000000500", O"60000000000000000000",
- + O"00000000300601403006", O"01403006000000000000",
- + O"00000005005407015005", O"40701500500000000000",
- + O"00000002012407002007", O"01240200000000000000",
- + O"00000002007005010410", O"42022020000000000000"/
- DATA (C(I),I=101,120)
- + /O"00000020220210410405", O"00700200000000000000",
- + O"00000000100100100100", O"10010010010000000000",
- + O"00000000000007017420", O"24010000000000000000",
- + O"00000000000040120217", O"40700000000000000000",
- + O"00000000000000077377", O"30000000000000000000",
- + O"00000000000000003303", O"30000000000000000000",
- + O"00000000000000002502", O"60000000000000000000",
- + O"00000020040040043347", O"35407002000000000000",
- + O"00000034646743143142", O"54433060110000000000",
- + O"00000014422222277777", O"72122161040000000000"/
-#endif
-#if defined(CERNLIB_CDC)
-C
- DATA NCPW/10/,NBPW/60/
- CALL NOARG(NA)
- IF(NA.EQ.1) NN=(IUCOMP(0,CHSTR,100)-1)*NCPW
- IF(NN.LE.0) RETURN
- N=MIN(NN,NC)
- DO 3 LINE=1,NL
- CALL VBLANK(A,N)
- DO 1 K = 1,N
- CALL CHMOVE(CHSTR,K,Z,1,1)
- I0=2*(LOCHAR(Z,1,H,60)-1)+1
- IF(I0.EQ.-1) I0=73
- DO 2 I=2,9
- IB=LINE+9*I-1
- IW=IB/NBPW+I0
- IF(JBIT(C(IW),NBPW-MOD(IB,NBPW)).EQ.1) CALL CHMOVE(HC,1,A(K),I,1)
- 2 CONTINUE
- 1 CONTINUE
- IF(NA.LT.3) WRITE(6,100)(A(I),I=1,N)
- IF(NA.EQ.3) WRITE(LFN,100) (A(I),I=1,N)
- 100 FORMAT(13A10)
- 3 CONTINUE
- RETURN
- END
-#endif
-#if defined(CERNLIB_IBM)
- SUBROUTINE NAMEZB(TEXT,NCHARS,LUN)
-C
-C CERN PROGLIB# J402 NAMEZB .VERSION GEN X X
-C
-C.....PRINT THE NCHARS CHARACTERS OF TEXT USING BLOCK CHARACTERS
-C IF NCHARS > MAXCH ONLY THE FIRST MAXCH ARE PRINTED
-C
- DIMENSION LINE(32)
-C
- LOGICAL*1 TEXT(NCHARS)
-C
- DATA MAXCH/9/
-C
-C
-C-- GET NUMBER OF ARGUMENTS
-C
- LUNWTR=6
- NARG=3
- CALL NOARG(NARG)
- IF(NARG.GE.3) LUNWTR=LUN
- N = NCHARS
- IF(NCHARS.GT.MAXCH) N = MAXCH
-C
- DO 1 I=1,12
- CALL UBLANK(LINE,1,32)
- CALL NAME12 (TEXT,I,LINE,N)
- WRITE(LUNWTR,100) LINE
- 1 CONTINUE
-C
- RETURN
-C
- 100 FORMAT(1X,32A4)
-C
- END
-#endif
-#if (!defined(CERNLIB_CDC))&&(!defined(CERNLIB_IBM))
- SUBROUTINE NAMEZB(CHSTR,NN,LFN)
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/j/ordre2.F b/src/mathlib/gen/j/ordre2.F
deleted file mode 100644
index ebc379a..0000000
--- a/src/mathlib/gen/j/ordre2.F
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: ordre2.F,v 1.1.1.1 1996/04/01 15:02:51 mclareni Exp $
-*
-* $Log: ordre2.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:51 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE ORDRE2(A,B,N)
-C IT ORDERS N PAIRS OF NUMBERS (X(I),Y(I)) IN ASCENDING
-C ORDER OF X(I)
-C
- DIMENSION A(1000), B(1000)
- IF (N .LE. 1) RETURN
- NM1 = N-1
- DO 200 IV= 1, NM1
- IQUIT = 0
- NH = N - IV
- DO 100 IH = 1, NH
- IF (A(IH) - A(IH+1)) 100, 100, 50
- 50 SAV = A(IH)
- A(IH) = A(IH+1)
- A(IH+1) = SAV
- SAV = B(IH)
- B(IH) = B(IH+1)
- B(IH+1) = SAV
- IQUIT = 1
- 100 CONTINUE
- IF (IQUIT) 250, 250, 200
- 200 CONTINUE
- 250 CONTINUE
- RETURN
- END
diff --git a/src/mathlib/gen/j/paper.F b/src/mathlib/gen/j/paper.F
deleted file mode 100644
index 21f6b92..0000000
--- a/src/mathlib/gen/j/paper.F
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: paper.F,v 1.1.1.1 1996/04/01 15:02:51 mclareni Exp $
-*
-* $Log: paper.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:51 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE PAPER(IMAGEW,IMAGEH)
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-C PURPOSE C
-C TO DEFINE HOW LARGE PICTURES SHALL BE PRODUCED BY SUBSEQUENT C
-C CALLS TO THE SUBROUTINE CONT. C
-C USAGE C
-C CALL PAPER(IMAGEW,IMAGEH) C
-C PARAMETERS C
-C IMAGEW - THE IMAGE WIDTH IN NUMBER OF LETTERS ON A LINE C
-C IMAGEH - THE IMAGE HEIGT IN NUMBER OF LINES C
-C REMARKS C
-C IMAGEW AND IMAGEH SHOULD NOT EXEED CERTAIN MACHINE-DEPENDANT C
-C LIMITS, USUALLY 120 AND 62, RESPECTIVELY.
-C
- COMMON /J509C1/XBL,YBL,XUR,YUR,NX(6),NY(6),LETT1,LETT2,LINE1,LINE2
-C
- CALL J509BD
- LETT2 = IMAGEW - 1
- LINE2 = IMAGEH - 3
- IF (LETT2 .GT. 119) LETT2 = 119
- RETURN
- END
diff --git a/src/mathlib/gen/j/setup.F b/src/mathlib/gen/j/setup.F
deleted file mode 100644
index a6542dd..0000000
--- a/src/mathlib/gen/j/setup.F
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: setup.F,v 1.1.1.1 1996/04/01 15:02:51 mclareni Exp $
-*
-* $Log: setup.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:51 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE SETUP(X1,I1,X2,I2,Y1,J1,Y2,J2)
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-C PURPOSE C
-C TO SET UP THE MAPPING CONSTANTS BETWEEN TWO LINEARLY DEPENDANT C
-C COORDINATE SYSTEMS. SETUP IS PLANNED TO BE USED IN CONJUNCTION C
-C WITH THE FUNCTION FREARG. C
-C USAGE C
-C CALL SETUP(X1,I1,X2,I2,Y1,J1,Y2,J2) C
-C THIS STATEMENT SHOULD BE EXECUTED BEFORE FREARG IS CALLED. C
-C PARAMETERS C
-C WE HAVE TWO DIFFERENT COORDINATE SYSTEMS, THE (X,Y)-SYSTEM AND C
-C THE (I,J)-SYSTEM. C
-C X AND I ARE LINEARLY RELATED TO EACH OTHER. C
-C Y AND J ARE LINEARLY RELATED TO EACH OTHER. C
-C THE MAPPING CONSTANTS ARE DEFINED BY REQUIRING THAT C
-C X=X1 CORRESPONDS TO I=I1, C
-C X=X2 CORRESPONDS TO I=I2, C
-C Y=Y1 CORRESPONDS TO J=J1, C
-C Y=Y2 CORRESPONDS TO J=J2. C
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
- COMMON /J509C2/CX1,CI1,CX2,CI2,CY1,CJ1,CY2,CJ2
-C=======================================================================
- CX1=X1
- CI1=I1
- CX2=X2
- CI2=I2
- CY1=Y1
- CJ1=J1
- CY2=Y2
- CJ2=J2
- RETURN
- END
diff --git a/src/mathlib/gen/m/Imakefile b/src/mathlib/gen/m/Imakefile
deleted file mode 100644
index 2c1761b..0000000
--- a/src/mathlib/gen/m/Imakefile
+++ /dev/null
@@ -1,9 +0,0 @@
-SRCS_F= sortdq.F sortiq.F sortrq.F
-
-FORTRANSAVEOPTION = FortranSaveFlags
-
-#if defined(CERNLIB_SGI)
-IMAKE_DEFINES=-DFortranDoesCpp=NO
-#endif
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/mathlib/gen/m/sortdq.F b/src/mathlib/gen/m/sortdq.F
deleted file mode 100644
index 00de790..0000000
--- a/src/mathlib/gen/m/sortdq.F
+++ /dev/null
@@ -1,86 +0,0 @@
-*
-* $Id: sortdq.F,v 1.1.1.1 1996/04/01 15:02:51 mclareni Exp $
-*
-* $Log: sortdq.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:51 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_QMIBMVF)
- at PROCESS DIRECTIVE('*VDIR:') VECTOR
-#endif
- SUBROUTINE SORTDQ(A,NC,NR,NS)
- DOUBLE PRECISION A(NC,NR),X
-#if defined(CERNLIB_CRAY)
- DOUBLE PRECISION TEMP
-#endif
- INTEGER LT(20),RT(20),R
-C
- NCS = ABS(NS)
- LEVEL=1
- LT(1)=1
- RT(1)=NR
- 10 L=LT(LEVEL)
- R=RT(LEVEL)
- LEVEL=LEVEL-1
- 20 IF(R.LE.L) IF(LEVEL) 90,90,10
-C
-C SUBDIVIDE THE INTERVAL L,R
-C L : LOWER LIMIT OF THE INTERVAL (INPUT)
-C R : UPPER LIMIT OF THE INTERVAL (INPUT)
-C J : UPPER LIMIT OF LOWER SUB-INTERVAL (OUTPUT)
-C I : LOWER LIMIT OF UPPER SUB-INTERVAL (OUTPUT)
-C
- I=L
- J=R
- M=(L+R)/2
- X=A(NCS,M)
- 30 IF(A(NCS,I).GE.X) GO TO 40
- I=I+1
- GO TO 30
- 40 IF(A(NCS,J).LE.X) GO TO 50
- J=J-1
- GO TO 40
-C
- 50 IF(I.GT.J) GO TO 70
-#if defined(CERNLIB_DOUBLE)||defined(CERNLIB_CDC)
- CALL USWOP(A(1,I),A(1,J),2*NC)
-#endif
-#if defined(CERNLIB_CRAY)
- DO 60 K=1, NC
- TEMP = A(K,I)
- A(K,I) = A(K,J)
- A(K,J) = TEMP
- 60 CONTINUE
-#endif
- I=I+1
- J=J-1
- IF(I.LE.J) GO TO 30
-C
- 70 LEVEL=LEVEL+1
- IF((R-I).GE.(J-L)) GO TO 80
- LT(LEVEL)=L
- RT(LEVEL)=J
- L=I
- GO TO 20
- 80 LT(LEVEL)=I
- RT(LEVEL)=R
- R=J
- GO TO 20
- 90 IF(NS.GT.0) RETURN
-C REVERSE THE ORDER OF THE ROWS IF NS NEGATIVE
- NRH=NR/2
- DO 110 I=1,NRH
-#if (defined(CERNLIB_DOUBLE)||defined(CERNLIB_CDC))&&(!defined(CERNLIB_QMIBMVF))
- CALL USWOP(A(1,I),A(1,NR+1-I),2*NC)
-#endif
-#if defined(CERNLIB_CRAY)||defined(CERNLIB_QMIBMVF)
- DO 100 K=1, NC
- TEMP = A(K,I)
- A(K,I) = A(K,NR+1-I)
- A(K,NR+1-I) = TEMP
- 100 CONTINUE
-#endif
- 110 CONTINUE
- END
diff --git a/src/mathlib/gen/m/sortiq.F b/src/mathlib/gen/m/sortiq.F
deleted file mode 100644
index 69b58ca..0000000
--- a/src/mathlib/gen/m/sortiq.F
+++ /dev/null
@@ -1,85 +0,0 @@
-*
-* $Id: sortiq.F,v 1.1.1.1 1996/04/01 15:02:51 mclareni Exp $
-*
-* $Log: sortiq.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:51 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_QMIBMVF)
- at PROCESS DIRECTIVE('*VDIR:') VECTOR
-#endif
- SUBROUTINE SORTIQ(A,NC,NR,NS)
- INTEGER A(NC,NR),X,LT(20),RT(20),R
-#if defined(CERNLIB_CRAY)
- INTEGER TEMP
-#endif
-C
- NCS = ABS(NS)
- LEVEL=1
- LT(1)=1
- RT(1)=NR
- 10 L=LT(LEVEL)
- R=RT(LEVEL)
- LEVEL=LEVEL-1
- 20 IF(R.LE.L) IF(LEVEL) 90,90,10
-C
-C SUBDIVIDE THE INTERVAL L,R
-C L : LOWER LIMIT OF THE INTERVAL (INPUT)
-C R : UPPER LIMIT OF THE INTERVAL (INPUT)
-C J : UPPER LIMIT OF LOWER SUB-INTERVAL (OUTPUT)
-C I : LOWER LIMIT OF UPPER SUB-INTERVAL (OUTPUT)
-C
- I=L
- J=R
- M=(L+R)/2
- X=A(NCS,M)
- 30 IF(A(NCS,I).GE.X) GO TO 40
- I=I+1
- GO TO 30
- 40 IF(A(NCS,J).LE.X) GO TO 50
- J=J-1
- GO TO 40
-C
- 50 IF(I.GT.J) GO TO 70
-#if defined(CERNLIB_DOUBLE)||defined(CERNLIB_CDC)
- CALL USWOP(A(1,I),A(1,J),NC)
-#endif
-#if defined(CERNLIB_CRAY)
- DO 60 K=1, NC
- TEMP = A(K,I)
- A(K,I) = A(K,J)
- A(K,J) = TEMP
- 60 CONTINUE
-#endif
- I=I+1
- J=J-1
- IF(I.LE.J) GO TO 30
-C
- 70 LEVEL=LEVEL+1
- IF((R-I).GE.(J-L)) GO TO 80
- LT(LEVEL)=L
- RT(LEVEL)=J
- L=I
- GO TO 20
- 80 LT(LEVEL)=I
- RT(LEVEL)=R
- R=J
- GO TO 20
- 90 IF(NS.GT.0) RETURN
-C REVERSE THE ORDER OF THE ROWS IF NS NEGATIVE
- NRH=NR/2
- DO 110 I=1,NRH
-#if (defined(CERNLIB_DOUBLE)||defined(CERNLIB_CDC))&&(!defined(CERNLIB_QMIBMVF))
- CALL USWOP(A(1,I),A(1,NR+1-I),NC)
-#endif
-#if defined(CERNLIB_CRAY)||defined(CERNLIB_QMIBMVF)
- DO 100 K=1, NC
- TEMP = A(K,I)
- A(K,I) = A(K,NR+1-I)
- A(K,NR+1-I) = TEMP
- 100 CONTINUE
-#endif
- 110 CONTINUE
- END
diff --git a/src/mathlib/gen/m/sortrq.F b/src/mathlib/gen/m/sortrq.F
deleted file mode 100644
index dd11b14..0000000
--- a/src/mathlib/gen/m/sortrq.F
+++ /dev/null
@@ -1,83 +0,0 @@
-*
-* $Id: sortrq.F,v 1.1.1.1 1996/04/01 15:02:52 mclareni Exp $
-*
-* $Log: sortrq.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:52 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_QMIBMVF)
- at PROCESS DIRECTIVE('*VDIR:') VECTOR
-#endif
- SUBROUTINE SORTRQ(A,NC,NR,NS)
- DIMENSION A(NC,NR)
- INTEGER LT(20),RT(20),R
-C
- NCS = ABS(NS)
- LEVEL=1
- LT(1)=1
- RT(1)=NR
- 10 L=LT(LEVEL)
- R=RT(LEVEL)
- LEVEL=LEVEL-1
- 20 IF(R.LE.L) IF(LEVEL) 90,90,10
-C
-C SUBDIVIDE THE INTERVAL L,R
-C L : LOWER LIMIT OF THE INTERVAL (INPUT)
-C R : UPPER LIMIT OF THE INTERVAL (INPUT)
-C J : UPPER LIMIT OF LOWER SUB-INTERVAL (OUTPUT)
-C I : LOWER LIMIT OF UPPER SUB-INTERVAL (OUTPUT)
-C
- I=L
- J=R
- M=(L+R)/2
- X=A(NCS,M)
- 30 IF(A(NCS,I).GE.X) GO TO 40
- I=I+1
- GO TO 30
- 40 IF(A(NCS,J).LE.X) GO TO 50
- J=J-1
- GO TO 40
-C
- 50 IF(I.GT.J) GO TO 70
-#if defined(CERNLIB_DOUBLE)||defined(CERNLIB_CDC)
- CALL USWOP(A(1,I),A(1,J),NC)
-#endif
-#if defined(CERNLIB_CRAY)
- DO 60 K=1, NC
- TEMP = A(K,I)
- A(K,I) = A(K,J)
- A(K,J) = TEMP
- 60 CONTINUE
-#endif
- I=I+1
- J=J-1
- IF(I.LE.J) GO TO 30
-C
- 70 LEVEL=LEVEL+1
- IF((R-I).GE.(J-L)) GO TO 80
- LT(LEVEL)=L
- RT(LEVEL)=J
- L=I
- GO TO 20
- 80 LT(LEVEL)=I
- RT(LEVEL)=R
- R=J
- GO TO 20
- 90 IF(NS.GT.0) RETURN
-C REVERSE THE ORDER OF THE ROWS IF NS NEGATIVE
- NRH=NR/2
- DO 110 I=1,NRH
-#if (defined(CERNLIB_DOUBLE)||defined(CERNLIB_CDC))&&(!defined(CERNLIB_QMIBMVF))
- CALL USWOP(A(1,I),A(1,NR+1-I),NC)
-#endif
-#if defined(CERNLIB_CRAY)||defined(CERNLIB_QMIBMVF)
- DO 100 K=1, NC
- TEMP = A(K,I)
- A(K,I) = A(K,NR+1-I)
- A(K,NR+1-I) = TEMP
- 100 CONTINUE
-#endif
- 110 CONTINUE
- END
diff --git a/src/mathlib/gen/n/Imakefile b/src/mathlib/gen/n/Imakefile
deleted file mode 100644
index b7ecc9a..0000000
--- a/src/mathlib/gen/n/Imakefile
+++ /dev/null
@@ -1,9 +0,0 @@
-SRCS_F= mtlprt.F mtlset.F
-
-FORTRANSAVEOPTION = FortranSaveFlags
-
-#if defined(CERNLIB_SGI)
-IMAKE_DEFINES=-DFortranDoesCpp=NO
-#endif
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/mathlib/gen/n/mtlprt.F b/src/mathlib/gen/n/mtlprt.F
deleted file mode 100644
index fdc98c4..0000000
--- a/src/mathlib/gen/n/mtlprt.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: mtlprt.F,v 1.1.1.1 1996/04/01 15:02:52 mclareni Exp $
-*
-* $Log: mtlprt.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:52 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE MTLPRT(NAME,ERC,TEXT)
- CHARACTER*(*) NAME,ERC,TEXT
- LOGICAL LMF,LRF
-
- IF(ERC(5:6).NE.'.0') THEN
- CALL MTLMTR(ERC,MLG,LMF,LRF)
- ELSE
- LMF=.TRUE.
- LRF=.FALSE.
- ENDIF
- IF(LMF) THEN
- LT=LENOCC(TEXT)
- IF(MLG .LT. 1) WRITE( *,100) ERC(1:4),NAME,ERC,TEXT(1:LT)
- IF(MLG .GE. 1) WRITE(MLG,100) ERC(1:4),NAME,ERC,TEXT(1:LT)
- ENDIF
- IF(.NOT.LRF) CALL ABEND
- RETURN
-100 FORMAT(7X,'***** CERN ',A,1X,A,' ERROR ',A,': ',A)
- END
diff --git a/src/mathlib/gen/n/mtlset.F b/src/mathlib/gen/n/mtlset.F
deleted file mode 100644
index 52a84bb..0000000
--- a/src/mathlib/gen/n/mtlset.F
+++ /dev/null
@@ -1,215 +0,0 @@
-*
-* $Id: mtlset.F,v 1.1.1.1 1996/04/01 15:02:53 mclareni Exp $
-*
-* $Log: mtlset.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:53 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE MTLSET(ERC,NLG,MXM,MXR)
-
- PARAMETER (KTE = 132)
- CHARACTER*6 ERC,CODE(KTE)
- LOGICAL LMF,LRF
- DIMENSION KNTM(KTE),KNTR(KTE)
-
- DATA ILG /0/
-
-C renumber the data statements after putting new codes in Unix with:
-C awk -F'[()]' '{ printf"%s(%s)%s(%s)%s(%s)%s\n",$1,NR,$3,NR,$5,NR,$7 }'
-C and modify KTE to the number of lines below
-
- DATA CODE(1),KNTM(1),KNTR(1) / 'B100.1', 255, 255 /
- DATA CODE(2),KNTM(2),KNTR(2) / 'B300.1', 255, 255 /
- DATA CODE(3),KNTM(3),KNTR(3) / 'B300.2', 255, 255 /
- DATA CODE(4),KNTM(4),KNTR(4) / 'C200.0', 255, 255 /
- DATA CODE(5),KNTM(5),KNTR(5) / 'C200.1', 255, 255 /
- DATA CODE(6),KNTM(6),KNTR(6) / 'C200.2', 255, 255 /
- DATA CODE(7),KNTM(7),KNTR(7) / 'C200.3', 255, 255 /
- DATA CODE(8),KNTM(8),KNTR(8) / 'C201.0', 255, 255 /
- DATA CODE(9),KNTM(9),KNTR(9) / 'C202.0', 255, 255 /
- DATA CODE(10),KNTM(10),KNTR(10) / 'C202.1', 255, 255 /
- DATA CODE(11),KNTM(11),KNTR(11) / 'C202.2', 255, 255 /
- DATA CODE(12),KNTM(12),KNTR(12) / 'C205.1', 255, 255 /
- DATA CODE(13),KNTM(13),KNTR(13) / 'C205.2', 255, 255 /
- DATA CODE(14),KNTM(14),KNTR(14) / 'C207.0', 255, 255 /
- DATA CODE(15),KNTM(15),KNTR(15) / 'C208.0', 255, 255 /
- DATA CODE(16),KNTM(16),KNTR(16) / 'C209.0', 255, 255 /
- DATA CODE(17),KNTM(17),KNTR(17) / 'C209.1', 255, 255 /
- DATA CODE(18),KNTM(18),KNTR(18) / 'C209.2', 255, 255 /
- DATA CODE(19),KNTM(19),KNTR(19) / 'C209.3', 255, 255 /
- DATA CODE(20),KNTM(20),KNTR(20) / 'C210.1', 255, 255 /
- DATA CODE(21),KNTM(21),KNTR(21) / 'C302.1', 255, 255 /
- DATA CODE(22),KNTM(22),KNTR(22) / 'C303.1', 255, 255 /
- DATA CODE(23),KNTM(23),KNTR(23) / 'C304.1', 255, 255 /
- DATA CODE(24),KNTM(24),KNTR(24) / 'C305.1', 255, 255 /
- DATA CODE(25),KNTM(25),KNTR(25) / 'C306.1', 255, 255 /
- DATA CODE(26),KNTM(26),KNTR(26) / 'C307.1', 255, 255 /
- DATA CODE(27),KNTM(27),KNTR(27) / 'C312.1', 255, 255 /
- DATA CODE(28),KNTM(28),KNTR(28) / 'C313.1', 255, 255 /
- DATA CODE(29),KNTM(29),KNTR(29) / 'C315.1', 255, 255 /
- DATA CODE(30),KNTM(30),KNTR(30) / 'C316.1', 255, 255 /
- DATA CODE(31),KNTM(31),KNTR(31) / 'C316.2', 255, 255 /
- DATA CODE(32),KNTM(32),KNTR(32) / 'C320.1', 255, 255 /
- DATA CODE(33),KNTM(33),KNTR(33) / 'C321.1', 255, 255 /
- DATA CODE(34),KNTM(34),KNTR(34) / 'C323.1', 255, 255 /
- DATA CODE(35),KNTM(35),KNTR(35) / 'C327.1', 255, 255 /
- DATA CODE(36),KNTM(36),KNTR(36) / 'C328.1', 255, 255 /
- DATA CODE(37),KNTM(37),KNTR(37) / 'C328.2', 255, 255 /
- DATA CODE(38),KNTM(38),KNTR(38) / 'C328.3', 255, 255 /
- DATA CODE(39),KNTM(39),KNTR(39) / 'C330.1', 255, 255 /
- DATA CODE(40),KNTM(40),KNTR(40) / 'C330.2', 255, 255 /
- DATA CODE(41),KNTM(41),KNTR(41) / 'C330.3', 255, 255 /
- DATA CODE(42),KNTM(42),KNTR(42) / 'C331.1', 255, 255 /
- DATA CODE(43),KNTM(43),KNTR(43) / 'C331.2', 255, 255 /
- DATA CODE(44),KNTM(44),KNTR(44) / 'C334.1', 255, 255 /
- DATA CODE(45),KNTM(45),KNTR(45) / 'C334.2', 255, 255 /
- DATA CODE(46),KNTM(46),KNTR(46) / 'C334.3', 255, 255 /
- DATA CODE(47),KNTM(47),KNTR(47) / 'C334.4', 255, 255 /
- DATA CODE(48),KNTM(48),KNTR(48) / 'C334.5', 255, 255 /
- DATA CODE(49),KNTM(49),KNTR(49) / 'C334.6', 255, 255 /
- DATA CODE(50),KNTM(50),KNTR(50) / 'C336.1', 255, 255 /
- DATA CODE(51),KNTM(51),KNTR(51) / 'C337.1', 255, 255 /
- DATA CODE(52),KNTM(52),KNTR(52) / 'C338.1', 255, 255 /
- DATA CODE(53),KNTM(53),KNTR(53) / 'C340.1', 255, 255 /
- DATA CODE(54),KNTM(54),KNTR(54) / 'C343.1', 255, 255 /
- DATA CODE(55),KNTM(55),KNTR(55) / 'C343.2', 255, 255 /
- DATA CODE(56),KNTM(56),KNTR(56) / 'C343.3', 255, 255 /
- DATA CODE(57),KNTM(57),KNTR(57) / 'C343.4', 255, 255 /
- DATA CODE(58),KNTM(58),KNTR(58) / 'C344.1', 255, 255 /
- DATA CODE(59),KNTM(59),KNTR(59) / 'C344.2', 255, 255 /
- DATA CODE(60),KNTM(60),KNTR(60) / 'C344.3', 255, 255 /
- DATA CODE(61),KNTM(61),KNTR(61) / 'C344.4', 255, 255 /
- DATA CODE(62),KNTM(62),KNTR(62) / 'C345.1', 255, 255 /
- DATA CODE(63),KNTM(63),KNTR(63) / 'C346.1', 255, 255 /
- DATA CODE(64),KNTM(64),KNTR(64) / 'C346.2', 255, 255 /
- DATA CODE(65),KNTM(65),KNTR(65) / 'C346.3', 255, 255 /
- DATA CODE(66),KNTM(66),KNTR(66) / 'C347.1', 255, 255 /
- DATA CODE(67),KNTM(67),KNTR(67) / 'C347.2', 255, 255 /
- DATA CODE(68),KNTM(68),KNTR(68) / 'C347.3', 255, 255 /
- DATA CODE(69),KNTM(69),KNTR(69) / 'C347.4', 255, 255 /
- DATA CODE(70),KNTM(70),KNTR(70) / 'C347.5', 255, 255 /
- DATA CODE(71),KNTM(71),KNTR(71) / 'C347.6', 255, 255 /
- DATA CODE(72),KNTM(72),KNTR(72) / 'C348.1', 255, 255 /
- DATA CODE(73),KNTM(73),KNTR(73) / 'C349.1', 255, 255 /
- DATA CODE(74),KNTM(74),KNTR(74) / 'C349.2', 255, 255 /
- DATA CODE(75),KNTM(75),KNTR(75) / 'C349.3', 255, 255 /
- DATA CODE(76),KNTM(76),KNTR(76) / 'D101.1', 255, 255 /
- DATA CODE(77),KNTM(77),KNTR(77) / 'D103.1', 255, 255 /
- DATA CODE(78),KNTM(78),KNTR(78) / 'D104.1', 255, 255 /
- DATA CODE(79),KNTM(79),KNTR(79) / 'D104.2', 255, 255 /
- DATA CODE(80),KNTM(80),KNTR(80) / 'D105.1', 255, 255 /
- DATA CODE(81),KNTM(81),KNTR(81) / 'D105.2', 255, 255 /
- DATA CODE(82),KNTM(82),KNTR(82) / 'D107.1', 255, 255 /
- DATA CODE(83),KNTM(83),KNTR(83) / 'D110.0', 255, 255 /
- DATA CODE(84),KNTM(84),KNTR(84) / 'D110.1', 255, 255 /
- DATA CODE(85),KNTM(85),KNTR(85) / 'D110.2', 255, 255 /
- DATA CODE(86),KNTM(86),KNTR(86) / 'D110.3', 255, 255 /
- DATA CODE(87),KNTM(87),KNTR(87) / 'D110.4', 255, 255 /
- DATA CODE(88),KNTM(88),KNTR(88) / 'D110.5', 255, 255 /
- DATA CODE(89),KNTM(89),KNTR(89) / 'D110.6', 255, 255 /
- DATA CODE(90),KNTM(90),KNTR(90) / 'D113.1', 255, 255 /
- DATA CODE(91),KNTM(91),KNTR(91) / 'D201.1', 255, 255 /
- DATA CODE(92),KNTM(92),KNTR(92) / 'D202.1', 255, 255 /
- DATA CODE(93),KNTM(93),KNTR(93) / 'D401.1', 255, 255 /
- DATA CODE(94),KNTM(94),KNTR(94) / 'D601.1', 255, 255 /
- DATA CODE(95),KNTM(95),KNTR(95) / 'E210.1', 255, 255 /
- DATA CODE(96),KNTM(96),KNTR(96) / 'E210.2', 255, 255 /
- DATA CODE(97),KNTM(97),KNTR(97) / 'E210.3', 255, 255 /
- DATA CODE(98),KNTM(98),KNTR(98) / 'E210.4', 255, 255 /
- DATA CODE(99),KNTM(99),KNTR(99) / 'E210.5', 255, 255 /
- DATA CODE(100),KNTM(100),KNTR(100) / 'E210.6', 255, 255 /
- DATA CODE(101),KNTM(101),KNTR(101) / 'E210.7', 255, 255 /
- DATA CODE(102),KNTM(102),KNTR(102) / 'E211.0', 255, 255 /
- DATA CODE(103),KNTM(103),KNTR(103) / 'E211.1', 255, 255 /
- DATA CODE(104),KNTM(104),KNTR(104) / 'E211.2', 255, 255 /
- DATA CODE(105),KNTM(105),KNTR(105) / 'E211.3', 255, 255 /
- DATA CODE(106),KNTM(106),KNTR(106) / 'E211.4', 255, 255 /
- DATA CODE(107),KNTM(107),KNTR(107) / 'E406.0', 255, 255 /
- DATA CODE(108),KNTM(108),KNTR(108) / 'E406.1', 255, 255 /
- DATA CODE(109),KNTM(109),KNTR(109) / 'E407.0', 255, 255 /
- DATA CODE(110),KNTM(110),KNTR(110) / 'E408.0', 255, 255 /
- DATA CODE(111),KNTM(111),KNTR(111) / 'E408.1', 255, 255 /
- DATA CODE(112),KNTM(112),KNTR(112) / 'F500.0', 255, 255 /
- DATA CODE(113),KNTM(113),KNTR(113) / 'F500.1', 255, 255 /
- DATA CODE(114),KNTM(114),KNTR(114) / 'F500.2', 255, 255 /
- DATA CODE(115),KNTM(115),KNTR(115) / 'F500.3', 255, 255 /
- DATA CODE(116),KNTM(116),KNTR(116) / 'G100.1', 255, 255 /
- DATA CODE(117),KNTM(117),KNTR(117) / 'G100.2', 255, 255 /
- DATA CODE(118),KNTM(118),KNTR(118) / 'G101.1', 255, 255 /
- DATA CODE(119),KNTM(119),KNTR(119) / 'G101.2', 255, 255 /
- DATA CODE(120),KNTM(120),KNTR(120) / 'G105.1', 255, 255 /
- DATA CODE(121),KNTM(121),KNTR(121) / 'G106.1', 255, 255 /
- DATA CODE(122),KNTM(122),KNTR(122) / 'G106.2', 255, 255 /
- DATA CODE(123),KNTM(123),KNTR(123) / 'G116.1', 255, 255 /
- DATA CODE(124),KNTM(124),KNTR(124) / 'G116.2', 255, 255 /
- DATA CODE(125),KNTM(125),KNTR(125) / 'H101.0', 255, 255 /
- DATA CODE(126),KNTM(126),KNTR(126) / 'H101.1', 255, 255 /
- DATA CODE(127),KNTM(127),KNTR(127) / 'H101.2', 255, 255 /
- DATA CODE(128),KNTM(128),KNTR(128) / 'H301.1', 255, 255 /
- DATA CODE(129),KNTM(129),KNTR(129) / 'U501.1', 255, 255 /
- DATA CODE(130),KNTM(130),KNTR(130) / 'V202.1', 255, 255 /
- DATA CODE(131),KNTM(131),KNTR(131) / 'V202.2', 255, 255 /
- DATA CODE(132),KNTM(132),KNTR(132) / 'V202.3', 255, 255 /
-
-#if defined(CERNLIB_IBMVM)||defined(CERNLIB_IBMMVS)
- EXTERNAL C302ERR,C304ERR
-
- LOGICAL LERSET
- DATA LERSET/.FALSE./
- SAVE LERSET
-
- IF(.NOT.LERSET) THEN
- LERSET=.TRUE.
-C--- AFB290I: Argument for GAMMA is out of range
- CALL ERRSET(290,256,-1,1,C302ERR)
-C--- AFB291I: Argument for ALGAMA is out of range
- CALL ERRSET(291,256,-1,1,C304ERR)
-C--- AFB300I: Argument for DGAMMA is out of range
- CALL ERRSET(300,256,-1,1,C302ERR)
-C--- AFB301I: Argument for DLGAMA is out of range
- CALL ERRSET(301,256,-1,1,C304ERR)
- ENDIF
-#endif
-
- ILG=NLG
- L=0
- IF(ERC .NE. ' ') THEN
- DO 10 L = 1,6
- IF(ERC(1:L) .EQ. ERC) GOTO 12
- 10 CONTINUE
- 12 CONTINUE
- ENDIF
- DO 14 I = 1,KTE
- IF(L .EQ. 0 .OR. CODE(I)(1:L) .EQ. ERC(1:L)) THEN
- IF(MXM .GE. 0) KNTM(I)=MXM
- IF(MXR .GE. 0) KNTR(I)=MXR
- ENDIF
- 14 CONTINUE
- RETURN
-
- ENTRY MTLMTR(ERC,MLG,LMF,LRF)
-
- MLG=ILG
- DO 20 I = 1,KTE
- IF(ERC .EQ. CODE(I)) GOTO 21
- 20 CONTINUE
- WRITE(*,100) ERC
- CALL ABEND
- RETURN
-
- 21 LMF=KNTM(I) .GE. 1
- LRF=KNTR(I) .GE. 1
- IF(LMF .AND. KNTM(I) .LT. 255) KNTM(I)=KNTM(I)-1
- IF(LRF .AND. KNTR(I) .LT. 255) KNTR(I)=KNTR(I)-1
- IF(.NOT.LRF) THEN
- IF(ILG .LT. 1) WRITE( *,101) CODE(I)
- IF(ILG .GE. 1) WRITE(ILG,101) CODE(I)
- ENDIF
- RETURN
- 100 FORMAT(7X,'***** CERN N002 MTLSET ... ERROR N002: ',
- 1'ERROR CODE ',A6,' NOT RECOGNIZED BY ERROR MONITOR. RUN ABORTED.')
- 101 FORMAT(7X,'***** CERN N002 MTLSET ... ERROR NOO2.1: ',
- 1'RUN TERMINATED BY LIBRARY ERROR CONDITION ',A6)
- END
diff --git a/src/mathlib/gen/obsolete/a200/dcabs.F b/src/mathlib/gen/obsolete/a200/dcabs.F
deleted file mode 100644
index ed3f141..0000000
--- a/src/mathlib/gen/obsolete/a200/dcabs.F
+++ /dev/null
@@ -1,15 +0,0 @@
-*
-* $Id: dcabs.F,v 1.1.1.1 1996/04/01 15:03:08 mclareni Exp $
-*
-* $Log: dcabs.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:08 mclareni
-* Mathlib gen
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_gen/pilot.h"
- DOUBLE PRECISION FUNCTION DCABS(Z)
- DOUBLE PRECISION Z(2)
- DCABS=SQRT(Z(1)**2+Z(2)**2)
- RETURN
- END
diff --git a/src/mathlib/gen/obsolete/a200/dcadd.F b/src/mathlib/gen/obsolete/a200/dcadd.F
deleted file mode 100644
index aec0406..0000000
--- a/src/mathlib/gen/obsolete/a200/dcadd.F
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: dcadd.F,v 1.1.1.1 1996/04/01 15:03:09 mclareni Exp $
-*
-* $Log: dcadd.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:09 mclareni
-* Mathlib gen
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_gen/pilot.h"
- SUBROUTINE DCADD(Z1,Z2,Z)
- DOUBLE PRECISION Z1(2),Z2(2),Z(2)
- Z(1)=Z1(1)+Z2(1)
- Z(2)=Z1(2)+Z2(2)
- RETURN
- END
diff --git a/src/mathlib/gen/obsolete/a200/dccopy.F b/src/mathlib/gen/obsolete/a200/dccopy.F
deleted file mode 100644
index 7160723..0000000
--- a/src/mathlib/gen/obsolete/a200/dccopy.F
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: dccopy.F,v 1.1.1.1 1996/04/01 15:03:09 mclareni Exp $
-*
-* $Log: dccopy.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:09 mclareni
-* Mathlib gen
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_gen/pilot.h"
- SUBROUTINE DCCOPY(Z1,Z)
- DOUBLE PRECISION Z1(2),Z(2)
- Z(1)=Z1(1)
- Z(2)=Z1(2)
- RETURN
- END
diff --git a/src/mathlib/gen/obsolete/a200/dccos.F b/src/mathlib/gen/obsolete/a200/dccos.F
deleted file mode 100644
index 5366dbd..0000000
--- a/src/mathlib/gen/obsolete/a200/dccos.F
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: dccos.F,v 1.1.1.1 1996/04/01 15:03:11 mclareni Exp $
-*
-* $Log: dccos.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:11 mclareni
-* Mathlib gen
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_gen/pilot.h"
- SUBROUTINE DCCOS(Z,F)
- DOUBLE PRECISION Z(2),F(2),A
- A=-SIN(Z(1))*SINH(Z(2))
- F(1)=COS(Z(1))*COSH(Z(2))
- F(2)=A
- RETURN
- END
diff --git a/src/mathlib/gen/obsolete/a200/dccpow.F b/src/mathlib/gen/obsolete/a200/dccpow.F
deleted file mode 100644
index 84bb449..0000000
--- a/src/mathlib/gen/obsolete/a200/dccpow.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: dccpow.F,v 1.1.1.1 1996/04/01 15:03:10 mclareni Exp $
-*
-* $Log: dccpow.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:10 mclareni
-* Mathlib gen
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_gen/pilot.h"
- SUBROUTINE DCCPOW(Z1,Z2,Z)
- DOUBLE PRECISION Z1(2),Z2(2),Z(2),A,Z0(2)
- IF(Z1(1) .EQ. 0.0D0 .AND. Z1(2) .EQ. 0.0D0) THEN
- Z(1)=0.0D0
- Z(2)=0.0D0
- ELSE
- A=ATAN2(Z1(2),Z1(1))
- Z0(1)=0.5D0*LOG(Z1(1)**2+Z1(2)**2)
- Z0(2)=A
- A=Z0(1)*Z2(1)-Z0(2)*Z2(2)
- Z(2)=Z0(2)*Z2(1)+Z0(1)*Z2(2)
- Z(1)=A
- A=EXP(Z(1))
- Z(1)=A*COS(Z(2))
- Z(2)=A*SIN(Z(2))
- END IF
- RETURN
- END
diff --git a/src/mathlib/gen/obsolete/a200/dcdiv.F b/src/mathlib/gen/obsolete/a200/dcdiv.F
deleted file mode 100644
index 1cda6e9..0000000
--- a/src/mathlib/gen/obsolete/a200/dcdiv.F
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: dcdiv.F,v 1.1.1.1 1996/04/01 15:03:09 mclareni Exp $
-*
-* $Log: dcdiv.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:09 mclareni
-* Mathlib gen
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_gen/pilot.h"
- SUBROUTINE DCDIV(Z1,Z2,Z)
- DOUBLE PRECISION Z1(2),Z2(2),Z(2),A,B
- A=1.0D0/(Z2(1)**2+Z2(2)**2)
- B=(Z1(1)*Z2(1)+Z1(2)*Z2(2))*A
- Z(2)=(Z1(2)*Z2(1)-Z1(1)*Z2(2))*A
- Z(1)=B
- RETURN
- END
diff --git a/src/mathlib/gen/obsolete/a200/dcexp.F b/src/mathlib/gen/obsolete/a200/dcexp.F
deleted file mode 100644
index e23edfb..0000000
--- a/src/mathlib/gen/obsolete/a200/dcexp.F
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: dcexp.F,v 1.1.1.1 1996/04/01 15:03:10 mclareni Exp $
-*
-* $Log: dcexp.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:10 mclareni
-* Mathlib gen
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_gen/pilot.h"
- SUBROUTINE DEXP(Z,F)
- DOUBLE PRECISION Z(2),F(2),A
- A=EXP(Z(1))
- F(1)=A*COS(Z(2))
- F(2)=A*SIN(Z(2))
- RETURN
- END
diff --git a/src/mathlib/gen/obsolete/a200/dciadd.F b/src/mathlib/gen/obsolete/a200/dciadd.F
deleted file mode 100644
index 0d6ddfa..0000000
--- a/src/mathlib/gen/obsolete/a200/dciadd.F
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: dciadd.F,v 1.1.1.1 1996/04/01 15:03:09 mclareni Exp $
-*
-* $Log: dciadd.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:09 mclareni
-* Mathlib gen
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_gen/pilot.h"
- SUBROUTINE DCIADD(D,Z1,Z)
- DOUBLE PRECISION D,Z1(2),Z(2)
- Z(1)=Z1(1)
- Z(2)=D+Z1(2)
- RETURN
- END
diff --git a/src/mathlib/gen/obsolete/a200/dcimpy.F b/src/mathlib/gen/obsolete/a200/dcimpy.F
deleted file mode 100644
index 97fc260..0000000
--- a/src/mathlib/gen/obsolete/a200/dcimpy.F
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: dcimpy.F,v 1.1.1.1 1996/04/01 15:03:09 mclareni Exp $
-*
-* $Log: dcimpy.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:09 mclareni
-* Mathlib gen
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_gen/pilot.h"
- SUBROUTINE DCIMPY(D,Z1,Z)
- DOUBLE PRECISION D,Z1(2),Z(2),A
- A=-D*Z1(2)
- Z(2)=D*Z1(1)
- Z(1)=A
- RETURN
- END
diff --git a/src/mathlib/gen/obsolete/a200/dclog.F b/src/mathlib/gen/obsolete/a200/dclog.F
deleted file mode 100644
index 18c0906..0000000
--- a/src/mathlib/gen/obsolete/a200/dclog.F
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: dclog.F,v 1.1.1.1 1996/04/01 15:03:10 mclareni Exp $
-*
-* $Log: dclog.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:10 mclareni
-* Mathlib gen
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_gen/pilot.h"
- SUBROUTINE DCLOG(Z,F)
- DOUBLE PRECISION Z(2),F(2),A
- A=ATAN2(Z(2),Z(1))
- F(1)=0.5D0*LOG(Z(1)**2+Z(2)**2)
- F(2)=A
- RETURN
- END
diff --git a/src/mathlib/gen/obsolete/a200/dcmplx.F b/src/mathlib/gen/obsolete/a200/dcmplx.F
deleted file mode 100644
index 5b31a80..0000000
--- a/src/mathlib/gen/obsolete/a200/dcmplx.F
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: dcmplx.F,v 1.1.1.1 1996/04/01 15:03:08 mclareni Exp $
-*
-* $Log: dcmplx.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:08 mclareni
-* Mathlib gen
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_gen/pilot.h"
- SUBROUTINE DCMPLX(X,Y,Z)
- DOUBLE PRECISION X,Y,Z(2)
- Z(1)=X
- Z(2)=Y
- RETURN
- END
diff --git a/src/mathlib/gen/obsolete/a200/dcmpy.F b/src/mathlib/gen/obsolete/a200/dcmpy.F
deleted file mode 100644
index 4c9f204..0000000
--- a/src/mathlib/gen/obsolete/a200/dcmpy.F
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: dcmpy.F,v 1.1.1.1 1996/04/01 15:03:09 mclareni Exp $
-*
-* $Log: dcmpy.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:09 mclareni
-* Mathlib gen
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_gen/pilot.h"
- SUBROUTINE DCMPY(Z1,Z2,Z)
- DOUBLE PRECISION Z1(2),Z2(2),Z(2),A
- A=Z1(1)*Z2(1)-Z1(2)*Z2(2)
- Z(2)=Z1(2)*Z2(1)+Z1(1)*Z2(2)
- Z(1)=A
- RETURN
- END
diff --git a/src/mathlib/gen/obsolete/a200/dcnpow.F b/src/mathlib/gen/obsolete/a200/dcnpow.F
deleted file mode 100644
index e4edaca..0000000
--- a/src/mathlib/gen/obsolete/a200/dcnpow.F
+++ /dev/null
@@ -1,42 +0,0 @@
-*
-* $Id: dcnpow.F,v 1.1.1.1 1996/04/01 15:03:09 mclareni Exp $
-*
-* $Log: dcnpow.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:09 mclareni
-* Mathlib gen
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_gen/pilot.h"
- SUBROUTINE DCNPOW(Z1,N,Z)
- DOUBLE PRECISION Z1(2),Z(2),A,P(2),C(2)
- C(1)=1.0D0
- C(2)=0.0D0
- IF(Z1(1) .EQ. 0.0D0 .AND. Z1(2) .EQ. 0.0D0) THEN
- C(1)=0.0D0
- ELSE
- NS=ABS(N)
- P(1)=Z1(1)
- P(2)=Z1(2)
- GO TO 2
- 1 A=P(1)*P(2)
- P(1)=(P(1)+P(2))*(P(1)-P(2))
- P(2)=A+A
- 2 NP=NS
- NS=NS/2
- IF(2*NS .NE. NP) THEN
- A=P(1)*C(1)-P(2)*C(2)
- C(2)=P(2)*C(1)+P(1)*C(2)
- C(1)=A
- END IF
- IF(NS. NE. 0) GO TO 1
- IF(N .LT. 0) THEN
- A=1.0D0/(C(1)**2+C(2)**2)
- C(1)=C(1)*A
- C(2)=-C(2)*A
- END IF
- END IF
- Z(1)=C(1)
- Z(2)=C(2)
- RETURN
- END
diff --git a/src/mathlib/gen/obsolete/a200/dconjg.F b/src/mathlib/gen/obsolete/a200/dconjg.F
deleted file mode 100644
index e5e4a96..0000000
--- a/src/mathlib/gen/obsolete/a200/dconjg.F
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: dconjg.F,v 1.1.1.1 1996/04/01 15:03:09 mclareni Exp $
-*
-* $Log: dconjg.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:09 mclareni
-* Mathlib gen
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_gen/pilot.h"
- SUBROUTINE DCONJG(Z1,Z)
- DOUBLE PRECISION Z1(2),Z(2)
- Z(1)=Z1(1)
- Z(2)=-Z1(2)
- RETURN
- END
diff --git a/src/mathlib/gen/obsolete/a200/dcradd.F b/src/mathlib/gen/obsolete/a200/dcradd.F
deleted file mode 100644
index 18b8ae4..0000000
--- a/src/mathlib/gen/obsolete/a200/dcradd.F
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: dcradd.F,v 1.1.1.1 1996/04/01 15:03:08 mclareni Exp $
-*
-* $Log: dcradd.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:08 mclareni
-* Mathlib gen
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_gen/pilot.h"
- SUBROUTINE DCRADD(D,Z1,Z)
- DOUBLE PRECISION D,Z1(2),Z(2)
- Z(1)=D+Z1(1)
- Z(2)=Z1(2)
- RETURN
- END
diff --git a/src/mathlib/gen/obsolete/a200/dcrcpr.F b/src/mathlib/gen/obsolete/a200/dcrcpr.F
deleted file mode 100644
index 17c74f6..0000000
--- a/src/mathlib/gen/obsolete/a200/dcrcpr.F
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: dcrcpr.F,v 1.1.1.1 1996/04/01 15:03:09 mclareni Exp $
-*
-* $Log: dcrcpr.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:09 mclareni
-* Mathlib gen
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_gen/pilot.h"
- SUBROUTINE DCRCPR(Z1,Z)
- DOUBLE PRECISION Z1(2),Z(2),A
- A=1.0D0/(Z1(1)**2+Z1(2)**2)
- Z(1)=Z1(1)*A
- Z(2)=-Z1(2)*A
- RETURN
- END
diff --git a/src/mathlib/gen/obsolete/a200/dcrmpy.F b/src/mathlib/gen/obsolete/a200/dcrmpy.F
deleted file mode 100644
index e7e2c58..0000000
--- a/src/mathlib/gen/obsolete/a200/dcrmpy.F
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: dcrmpy.F,v 1.1.1.1 1996/04/01 15:03:08 mclareni Exp $
-*
-* $Log: dcrmpy.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:08 mclareni
-* Mathlib gen
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_gen/pilot.h"
- SUBROUTINE DCRMPY(D,Z1,Z)
- DOUBLE PRECISION D,Z1(2),Z(2)
- Z(1)=D*Z1(1)
- Z(2)=D*Z1(2)
- RETURN
- END
diff --git a/src/mathlib/gen/obsolete/a200/dcrpow.F b/src/mathlib/gen/obsolete/a200/dcrpow.F
deleted file mode 100644
index 4f9d5ee..0000000
--- a/src/mathlib/gen/obsolete/a200/dcrpow.F
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: dcrpow.F,v 1.1.1.1 1996/04/01 15:03:10 mclareni Exp $
-*
-* $Log: dcrpow.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:10 mclareni
-* Mathlib gen
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_gen/pilot.h"
- SUBROUTINE DCRPOW(Z1,D,Z)
- DOUBLE PRECISION D,Z1(2),Z(2),A
- IF(Z1(1) .EQ. 0.0D0 .AND. Z1(2) .EQ. 0.0D0) THEN
- Z(1)=0.0D0
- Z(2)=0.0D0
- ELSE
- A=ATAN2(Z1(2),Z1(1))
- Z(1)=0.5D0*D*LOG(Z1(1)**2+Z1(2)**2)
- Z(2)=D*A
- A=EXP(Z(1))
- Z(1)=A*COS(Z(2))
- Z(2)=A*SIN(Z(2))
- END IF
- RETURN
- END
diff --git a/src/mathlib/gen/obsolete/a200/dcsin.F b/src/mathlib/gen/obsolete/a200/dcsin.F
deleted file mode 100644
index d63236b..0000000
--- a/src/mathlib/gen/obsolete/a200/dcsin.F
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: dcsin.F,v 1.1.1.1 1996/04/01 15:03:11 mclareni Exp $
-*
-* $Log: dcsin.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:11 mclareni
-* Mathlib gen
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_gen/pilot.h"
- SUBROUTINE DCSIN(Z,F)
- DOUBLE PRECISION Z(2),F(2),A
- A=COS(Z(1))*SINH(Z(2))
- F(1)=SIN(Z(1))*COSH(Z(2))
- F(2)=A
- RETURN
- END
diff --git a/src/mathlib/gen/obsolete/a200/dcsqrt.F b/src/mathlib/gen/obsolete/a200/dcsqrt.F
deleted file mode 100644
index 86349ab..0000000
--- a/src/mathlib/gen/obsolete/a200/dcsqrt.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: dcsqrt.F,v 1.1.1.1 1996/04/01 15:03:10 mclareni Exp $
-*
-* $Log: dcsqrt.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:10 mclareni
-* Mathlib gen
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_gen/pilot.h"
- SUBROUTINE DCSQRT(Z,F)
- DOUBLE PRECISION Z(2),F(2),A,B
- IF(Z(2) .EQ. 0.0D0) THEN
- IF(Z(1) .GE. 0.0D0) THEN
- F(1)=SQRT(Z(1))
- F(2)=0.0D0
- ELSE
- F(2)=SQRT(-Z(1))
- F(1)=0.0D0
- END IF
- ELSE
- A=SQRT(Z(1)**2+Z(2)**2)
- B=SQRT(0.5D0*(A+Z(1)))
- F(2)=SIGN(SQRT(0.5D0*(A-Z(1))),Z(2))
- F(1)=B
- END IF
- RETURN
- END
diff --git a/src/mathlib/gen/obsolete/a200/dcsub.F b/src/mathlib/gen/obsolete/a200/dcsub.F
deleted file mode 100644
index 8bc9538..0000000
--- a/src/mathlib/gen/obsolete/a200/dcsub.F
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: dcsub.F,v 1.1.1.1 1996/04/01 15:03:09 mclareni Exp $
-*
-* $Log: dcsub.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:09 mclareni
-* Mathlib gen
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_gen/pilot.h"
- SUBROUTINE DCSUB(Z1,Z2,Z)
- DOUBLE PRECISION Z1(2),Z2(2),Z(2)
- Z(1)=Z1(1)-Z2(1)
- Z(2)=Z1(2)-Z2(2)
- RETURN
- END
diff --git a/src/mathlib/gen/obsolete/a200/dimag.F b/src/mathlib/gen/obsolete/a200/dimag.F
deleted file mode 100644
index 0b280ea..0000000
--- a/src/mathlib/gen/obsolete/a200/dimag.F
+++ /dev/null
@@ -1,15 +0,0 @@
-*
-* $Id: dimag.F,v 1.1.1.1 1996/04/01 15:03:08 mclareni Exp $
-*
-* $Log: dimag.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:08 mclareni
-* Mathlib gen
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_gen/pilot.h"
- DOUBLE PRECISION FUNCTION DIMAG(Z)
- DOUBLE PRECISION Z(2)
- DIMAG=Z(2)
- RETURN
- END
diff --git a/src/mathlib/gen/obsolete/a200/dreal.F b/src/mathlib/gen/obsolete/a200/dreal.F
deleted file mode 100644
index bc59242..0000000
--- a/src/mathlib/gen/obsolete/a200/dreal.F
+++ /dev/null
@@ -1,15 +0,0 @@
-*
-* $Id: dreal.F,v 1.1.1.1 1996/04/01 15:03:08 mclareni Exp $
-*
-* $Log: dreal.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:08 mclareni
-* Mathlib gen
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_gen/pilot.h"
- DOUBLE PRECISION FUNCTION DREAL(Z)
- DOUBLE PRECISION Z(2)
- DREAL=Z(1)
- RETURN
- END
diff --git a/src/mathlib/gen/obsolete/c203/near1.F b/src/mathlib/gen/obsolete/c203/near1.F
deleted file mode 100644
index 3e9045b..0000000
--- a/src/mathlib/gen/obsolete/c203/near1.F
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: near1.F,v 1.1.1.1 1996/04/01 15:03:12 mclareni Exp $
-*
-* $Log: near1.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:12 mclareni
-* Mathlib gen
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_gen/pilot.h"
- FUNCTION NEAR1(X)
- I=X
- XI=I
- XX=X-XI
- IF(XX.GE.0.5) GO TO 1
- NEAR1=I
- RETURN
- 1 NEAR1=I+1
- RETURN
- END
diff --git a/src/mathlib/gen/obsolete/c203/nzeros.F b/src/mathlib/gen/obsolete/c203/nzeros.F
deleted file mode 100644
index 08baba9..0000000
--- a/src/mathlib/gen/obsolete/c203/nzeros.F
+++ /dev/null
@@ -1,94 +0,0 @@
-*
-* $Id: nzeros.F,v 1.1.1.1 1996/04/01 15:03:11 mclareni Exp $
-*
-* $Log: nzeros.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:11 mclareni
-* Mathlib gen
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_gen/pilot.h"
- SUBROUTINE NZEROS(NZ,Z,RR,FCN)
-C
-C SEE PAPER OF LYNESS AND DELVES, MATH.OF COMP.21(1967),543-560.
-C RR IS THE RADIUS AND Z THE CENTRE OF THE REGION.
-C
- DIMENSION F(512),A(512),RF(512)
-C*NS COMPLEX PP,Z0,Z,F,FCN,A,RF,T,U,S
- COMPLEX PP,Z0,Z,F,FCN,A,RF,T,U
- COMPLEX C2,C3
- EXTERNAL FCN
-C
- NDIM=512
- P=6.28318530717958
- EPSI1=0.1
- AK=1.E07
- R=RR/1.2
- I=0
-C
- 20 CONTINUE
- ERROR3=1.E30
- N=16
- R=R*1.2
- NMIN=N-1
- PP=P*(0.,1.)/N
- DO 10 J=1,N
- Z0=Z+R*EXP(PP*J)
- F(J)=FCN(Z0,I)
- C1=ABS(F(J))
- IF(C1.LE.1.E-20) GO TO 20
- 10 I=1
-C
-C COMPUTES A(S) THE FIRST TIME
-C
- DO 12 JS=1,NMIN
- 12 A(JS)=0.
- DO 15 JS=1,NMIN
- DO 11 J=1,N
- 11 A(JS)=EXP(-PP*JS*J)*F(J)+A(JS)
- 15 A(JS)=A(JS)/N
- A(N)=0.
- DO 16 J=1,N
- 16 A(N)=F(J)+A(N)
- A(N)=A(N)/N
-C
-C DERIVATIVE RF THE FIRST TIME
-C
- DO 13 J=1,N
- 13 RF(J)=0.
- DO 14 J=1,N
- DO 14 JS=1,NMIN
- 14 RF(J)=JS*A(JS)*EXP(PP*J*(JS-1))+RF(J)
-C
-C INTEGRAL FOR THE NUMBER OF ROOTS
-C
- 1 T=0.
- U=0.
- PP=CMPLX(0.,P)/N
- N1=N/2
- DO 2 J=1,N1
- C2=RF(2*J)/F(2*J)
- C3=RF(2*J-1)/F(2*J-1)
- IF(ABS(C2).GT.AK.OR.ABS(C3).GT.AK) GO TO 20
- T=EXP(PP*2*J)*C2+T
- U=EXP(PP*(2*J-1))*C3+U
- 2 CONTINUE
- T=T/N1
- U=U/N1
- ERROR1=ABS(T-U)*0.5
- IF(ERROR1.LE.EPSI1) GO TO 3
- IF(ERROR1.GT.ERROR3) GO TO 20
- ERROR3=ERROR1
- IF(N.LT.NDIM) GO TO 64
- WRITE(6,410)
- 410 FORMAT( 5X,'CONVERGENCE IS TOO SLOW, CHANGE R'//)
- RETURN
- 64 CONTINUE
- CALL PREP(RF,F,A,N,Z,R,IP,FCN)
- IF(IP.EQ.1) GO TO 20
- N=2*N
- GO TO 1
- 3 AB=ABS(REAL(0.5*T+0.5*U))
- NZ=NEAR1(AB)
- RETURN
- END
diff --git a/src/mathlib/gen/obsolete/c203/prep.F b/src/mathlib/gen/obsolete/c203/prep.F
deleted file mode 100644
index b286411..0000000
--- a/src/mathlib/gen/obsolete/c203/prep.F
+++ /dev/null
@@ -1,58 +0,0 @@
-*
-* $Id: prep.F,v 1.1.1.1 1996/04/01 15:03:11 mclareni Exp $
-*
-* $Log: prep.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:11 mclareni
-* Mathlib gen
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_gen/pilot.h"
- SUBROUTINE PREP(RF,F,A,N,Z,R,IP,FCN)
-C SEE PAPER OF LYNESS AND DELVES. RF,F,A ARE THE 2*N VALUES OF
-C R*DERIVATIVE, OF THE FUNCTION F, AND OF AS. N VALUES
-C ARE KNOWN AND 2*N VALUES ARE OBTAINED. Z IS THE CENTRE AND R THE
-C RADIUS OF THE CIRCULAR REGION.
-C
- DIMENSION F(512),B(512),A(512),DUM(512),RF(512)
- COMPLEX P,F,Z,Z0,B,A,DUM,RF
- EXTERNAL FCN
- COMPLEX FCN
-C
- M=2*N
- P=6.28318530717958*(0.,1.)/M
- DO 1 J=1,N
- 1 DUM(J)=F(J)
- DO 8 J=1,N
- 8 F(2*J)=DUM(J)
- DO 2 J=1,N
- Z0=Z+R*EXP(P*(2*J-1))
- F(2*J-1)=FCN(Z0,I)
- C1=ABS(F(2*J-1))
- IF(C1.GT.1.E-20) GO TO 2
- IP=1
- RETURN
- 2 CONTINUE
- DO 4 J=1,N
- B(J)=F(1)*EXP(-P*J)
- DO 3 K=2,N
- 3 B(J)=F(2*K-1)*EXP(-P*J*(2*K-1))+B(J)
- B(J)=B(J)/N
- A(J+N)=0.5*(A(J)-B(J))
- 4 A(J)=0.5*(A(J)+B(J))
-C
-C COMPUTES THE VALUES OF THE DERIVATIVE
-C
- DO 5 J=1,N
- 5 DUM(J)=RF(J)
- DO 6 J=1,N
- RF(2*J)=A(N)*EXP(-P*2*J)
- RF(2*J-1)=-N*A(N)*EXP(-P*(2*J-1))
- DO 7 K=2,N
- RF(2*J)=A(K-1+N)*EXP(P*2*J*(K-2))+RF(2*J)
- RF(2*J-1)=((K-1)*B(K-1)-N*A(K-1+N))*EXP(P*
- 1(2*J-1)*(K-2))+RF(2*J-1)
- 7 CONTINUE
- 6 RF(2*J)=RF(2*J)*N+DUM(J)
- RETURN
- END
diff --git a/src/mathlib/gen/obsolete/c206/circle.F b/src/mathlib/gen/obsolete/c206/circle.F
deleted file mode 100644
index 750fd34..0000000
--- a/src/mathlib/gen/obsolete/c206/circle.F
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: circle.F,v 1.1.1.1 1996/04/01 15:03:12 mclareni Exp $
-*
-* $Log: circle.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:12 mclareni
-* Mathlib gen
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_gen/pilot.h"
- SUBROUTINE CIRCLE(Z,E,F,B,N,M,MAXFUN)
-C
-C THE SUB COMPUTES THE NEW POINT Z ON THE BOUNDARY OF THE SINGULAR
-C CIRCLE R(V,E). WHEN ENTERING Z=V. IN OUTPUT F(N+1) IS THE STARTING
-C FUNCTION AT Z FOR THE NEW HOMOTOPY.
-C
- COMPLEX Z,F(1),B(1),V,ZV,Z1
- P=6.28318530717958
- V=Z
- K=2
- M1=1
-C
- 1 DT=P/K
- DO 2 J=1,K,M1
- TE=J*DT
- ZV=E*CMPLX(COS(TE),SIN(TE))
- Z=V+ZV
- IF(M.GE.MAXFUN) RETURN
- CALL VP(F,Z,B,1,JJ,N)
- M=M+1
- C=ABS(F(N))
- IF(C.EQ.0.) GO TO 2
- Z1=(C*F(N+1))/F(N)
- SCAL=REAL(Z1)*REAL(ZV)+AIMAG(Z1)*AIMAG(ZV)
- IF(SCAL.LT.0.) RETURN
- 2 CONTINUE
- M1=2
- K=2*K
- IF(K.GT. 8) RETURN
- GO TO 1
- END
diff --git a/src/mathlib/gen/obsolete/c206/deflat.F b/src/mathlib/gen/obsolete/c206/deflat.F
deleted file mode 100644
index 7c1b2b4..0000000
--- a/src/mathlib/gen/obsolete/c206/deflat.F
+++ /dev/null
@@ -1,53 +0,0 @@
-*
-* $Id: deflat.F,v 1.1.1.1 1996/04/01 15:03:12 mclareni Exp $
-*
-* $Log: deflat.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:12 mclareni
-* Mathlib gen
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_gen/pilot.h"
- SUBROUTINE DEFLAT(A,N,Z)
-C
-C N MUST BE NOT LESS THEN 2
-C GIVEN THE APPROXIMATE ZERO Z OF THE POLYNOMIAL F(A,N) IT
-C COMPUTES THE DEFLATED POL. F(A,N-1) USING BACKWARD AND FOR
-C WARD DIVISION ACCORDING PETERS AND WILKINSON. J. INST. MATHS.
-C APPLICS. (1971) 8,16-35. N-1 IS PUT IN N.
-C
- COMPLEX Z,A(1)
-C
- JR=0
- IF(ABS(Z).EQ.0.) GO TO 3
-C
-C COMPUTES THE MATCHING INDEX R
-C
- X=ABS(A(N+1))
- DO 1 J=2,N
- Y=ABS(Z**(J-1)*A(N-J+2))
- IF(Y.LE.X) GO TO 1
- X=Y
- JR=J-1
- 1 CONTINUE
-C
-C BACKWARD DIVISION
-C
- IF(JR.EQ.0) GO TO 3
- A(N+1)=-A(N+1)/Z
- IF(JR.EQ.1) GO TO 6
- N2=JR-1
- DO 2 J=1,N2
- 2 A(N-J+1)=(A(N-J+2)-A(N-J+1))/Z
- 6 DO 5 J=1,JR
- 5 A(N-JR+J)=A(N-JR+J+1)
-C
-C FORWARD DIVISION
-C
- 3 N1=N-JR
- N=N-1
- IF(N1.LT.2) RETURN
- DO 4 J=2,N1
- 4 A(J)=A(J)+Z*A(J-1)
- RETURN
- END
diff --git a/src/mathlib/gen/obsolete/c206/poly2.F b/src/mathlib/gen/obsolete/c206/poly2.F
deleted file mode 100644
index 85ebd21..0000000
--- a/src/mathlib/gen/obsolete/c206/poly2.F
+++ /dev/null
@@ -1,154 +0,0 @@
-*
-* $Id: poly2.F,v 1.1.1.1 1996/04/01 15:03:12 mclareni Exp $
-*
-* $Log: poly2.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:12 mclareni
-* Mathlib gen
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_gen/pilot.h"
- SUBROUTINE POLY2(A,N,ROOT,H,MAXFUN,MODE)
- COMPLEX A(*),ROOT(*)
- COMPLEX F(30),Z,CNUM,CDEN,FZ,FF,F1,F2,V,C,B(30)
- DIMENSION H(1)
- COMMON /C206ER/ ERROR
-C
- IF(N.EQ.0) RETURN
- IF(ABS(A(1)).EQ.0.) GO TO 50
- E=10.
- BE=1.E7
- GUP=0.5
- N2=N-2
-C*NS NM=N-1
- NP=N+1
- M=0
- SN=SQRT(REAL(N))
- Z=CMPLX(1.,1.)
- N1=N
-C N1 IS THE DEGREE OF THE SUCCESSIVE DEFLATED POLYNOMIAL
-C
-C POLYNOMIAL OF DEGREE 1
-C
- IF(N.NE.1) GO TO 5
- ROOT(1)=-A(2)/A(1)
- H(1)=0.
- RETURN
- 5 DO 3 K=1,NP
- H(K)=1.
- 3 B(K)=A(K)
- IF(N.NE.2) GO TO 6
-C
-C POLYNOMIALS OF DEGREE 2
-C
- H(N)=0.
- H(N-1)=0.
- 4 C=B(2)*B(2)-4.*B(1)*B(3)
- ROOT(N)=0.5*(-B(2)+SQRT(C))/B(1)
- ROOT(N-1)=-ROOT(N)-B(2)/B(1)
- IF(N.EQ.2) RETURN
- IF(REAL(B(3)).NE.0.. OR.AIMAG(B(3)).NE.0.) GO TO 12
- H(N)=0.
- IF(REAL(B(2)).EQ.0..AND.AIMAG(B(2)).EQ.0.) H(N-1)=0.
- GO TO 12
-C
-C POLYNOMIALS OF DEGREE MORE THEN 2
-C
- 6 DO 10 K=1,N2
- IF(REAL(B(N1+1)).EQ.0..AND.AIMAG(B(N1+1)).EQ.0.) GO TO 18
- IF(MODE.NE.0) Z=ROOT(K)
- S=BE
- IF(M.GE.MAXFUN) GO TO 51
- CALL VP(F,Z,B,2,J,N1)
- M=M+1
- IF(J.EQ.2) GO TO 13
- 7 D1=S
- 8 CONTINUE
- NI=0.
-C
-C NI IS THE NUMBER OF STEPS IN (0,1)
-C
- V=Z
- FZ=F(N1+1)
- FF=FZ
- F1=F(N1)
- F2=F(N1-1)
-C
- 9 NI=NI+1
- IH=0
-C
-C IH IS THE INDEX OF THE STEP =1,2...NI
-C
- Z=V
- F(N1+1)=FF
- F(N1)=F1
- F(N1-1)=F2
- 11 IH=IH+1
- IF(IH.GT.NI) GO TO 9
- T=REAL(NI-IH)/REAL(NI)
- CNUM=F(N1+1)-T*FZ
- CDEN=F(N1)*F(N1)-F(N1-1)*CNUM*2.
- CNUM=CNUM*F(N1)
- IF(ABS(CNUM).GT.E*ABS(CDEN)) GO TO 9
- Z=Z-CNUM/CDEN
- IF(M.GE.MAXFUN) GO TO 51
- CALL VP(F,Z,B,2,J,N1)
- M=M+1
- IF(J.EQ.2) GO TO 13
- S=ABS(F(N1+1))
- IF(S.LE.0.9*D1) GO TO 7
- IF(S.LT.1.E 6*ERROR) GO TO 13
- S1=ABS(F(N1))
- S2=ABS(F(N1-1))
- CZ=ABS(Z)+1.
- IF( S1.GT.GUP*CZ*S2) GO TO 11
- IF(S.LT.0.1*CZ*S1) GO TO 11
- EPS=S1/S2
- CALL CIRCLE(Z,EPS,F,B,N1,M,MAXFUN)
- SS=1.
- S=ABS(F(N1+1))
- S1=ABS(F(N1))
- CZ=1.+ABS(Z)
- IF(S.GT.S1*CZ) SS=0.5*S1/S
- Z=Z-SS*F(N1+1)/F(N1)
- IF(M.GE.MAXFUN) GO TO 51
- CALL VP(F,Z,B,2,J,N1)
- M=M+1
- GO TO 8
- 18 Z=0.
- H(K)=0.
- 13 CALL DEFLAT(B,N1,Z)
- ROOT(K)=Z
- 10 CONTINUE
- GO TO 4
- 12 CONTINUE
-C
-C ERROR BOUND
-C
- DO 14 K=1,N
- IF(H(K).EQ.0.) GO TO 14
- H(K)=0.
- CALL VP(F,ROOT(K),A,2,J,N)
- S=ABS(F(N+1))
- IF(S.EQ.0..AND.ABS(F(N)).EQ.0.)GO TO 14
- CZ=ABS(ROOT(K))
- IF(J.EQ.2) GO TO 15
- S=SN*S
- GO TO 16
- 15 S=SN*ERROR
- 16 S1=ABS(F(N)*F(N)-F(N-1)*F(N+1)*2.)
- S1=SQRT(S1)
- IF(S.LE.10.*S1*CZ) GO TO 17
- WRITE(6,402)K
- 402 FORMAT(3X,'THE BOUND FOR THE ROOT',I3,'CANNOT BE FOUND')
- GO TO 14
- 17 H(K)=S/S1
- 14 CONTINUE
- RETURN
- 50 WRITE(6,400)
- 400 FORMAT(5X,'THE FIRST COEFFICIENT A(1) IS ZERO'///)
- RETURN
- 51 WRITE(6,401)M
- 401 FORMAT(3X,'NUMBER OF FUNCTION EVALUATIONS =',I6///)
- RETURN
- END
diff --git a/src/mathlib/gen/obsolete/c206/vp.F b/src/mathlib/gen/obsolete/c206/vp.F
deleted file mode 100644
index 8606e1a..0000000
--- a/src/mathlib/gen/obsolete/c206/vp.F
+++ /dev/null
@@ -1,51 +0,0 @@
-*
-* $Id: vp.F,v 1.1.1.1 1996/04/01 15:03:12 mclareni Exp $
-*
-* $Log: vp.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:12 mclareni
-* Mathlib gen
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_gen/pilot.h"
- SUBROUTINE VP(F,Z,A,K,J,N)
-C
-C N IS THE DEGREE AND A ARE THE COEFFICIENTS OF THE POLYNOMIAL.
-C THE SUBROUTINE COMPUTES F WITH THE FIRST K DERIVATIVES DIVIDED
-C RESPECTIVELY BY K FACTORIAL. THEY ARE PUT
-C RESP. IN F(N+1), F(N),... IN THE OUTPUT J=2 IF F CAN HAVE NO
-C SIGNIFICANT FIGURES, OTHERWISE J=1
-C
- COMPLEX F(1),Z,A(1)
- COMMON /C206ER/ E
-C
- C1=2.0000000000009
- C=ABS(Z)
- H=0.5*ABS(A(1))
- NPLUS=N+1
- M=NPLUS
- J=1
- DO 1 I=1,NPLUS
- 1 F(I)=A(I)
-C
-C F, BOUND E FOR THE ERROR (PETERS AND WILKINSON) AND EXIT
-C
- DO 4 I=2,NPLUS
- F(I)=Z*F(I-1)+F(I)
- D=ABS(F(I))
- 4 H=C*H+D
- E=1.E-14*(C1*H-D)
- IF(D.LE.E) J=2
- IF (K.EQ.0) RETURN
- IF(N.EQ.1) RETURN
-C
-C DERIVATIVES
-C
- IF(K.EQ.N) K=N-1
- DO 2 L=1,K
- M=M-1
- DO 3 I=2,M
- 3 F(I)=Z*F(I-1)+F(I)
- 2 CONTINUE
- RETURN
- END
diff --git a/src/mathlib/gen/obsolete/c319/elin1.F b/src/mathlib/gen/obsolete/c319/elin1.F
deleted file mode 100644
index 36084be..0000000
--- a/src/mathlib/gen/obsolete/c319/elin1.F
+++ /dev/null
@@ -1,61 +0,0 @@
-*
-* $Id: elin1.F,v 1.1.1.1 1996/04/01 15:03:12 mclareni Exp $
-*
-* $Log: elin1.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:12 mclareni
-* Mathlib gen
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_gen/pilot.h"
- FUNCTION ELIN1(X,M)
-C
-C-----COMPUTES ELLIPTIC INTEGRAL 1ST KIND F(X,M) BY LANDEN TRANSFORM.
-C BASED ON R.BULIRSCH"S PROGRAM EL1 (NUM. MATH.VOL.7,P.78, (1965))
-C BUT PARAMETER M=K**2 (K=MODULUS) IS USED INSTEAD OF KC=SQRT(1-M).
-C IMPROVEMENTS:
-C 1. CASE F(X,1) IS ALSO ADMITTED (= ATANH(X) )
-C 2. PRINTED ERROR MESSAGE AT SINGULARITIES F(1,1), F(-1,1)
-C 3. IF K IS UNCHANGED IN SUCCESSIVE SUBROUTINE CALLS MODULUS TANSFOR-
-C MATIONS ARE NOT REPEATED, F(X,M) COMPUTED IN ABOUT HALF THE TIME.
- REAL M
- DIMENSION E(50)
-C THE FOLLOWING CONSTANTS ARE MACHINE-DEPENDANT. EPSI=2**-(M/2) AND
-C EPSI2=2**-(M+3) WHERE M=NUMBER OF MANTISSA BITS.
-#if defined(CERNLIB_CDC)
- DATA CLAST/2./,EPSI/4.2E-8/,EPSI2/4E-16/
-#endif
-#if !defined(CERNLIB_CDC)
- DATA CLAST/2./,EPSI/1.5E-5/,EPSI2/3E-11/
-#endif
- ELIN1= 0.
- IF(X.EQ.0.) RETURN
- C=1.-ABS(M)
- IF(C.EQ.0.) GO TO 6
- IF(C.EQ.CLAST) GO TO 2
- CLAST=C
-C-----ARITHMETICO-GEOMETRIC SCALE.(SKIPPED IF M IS UNCHANGED)
- A=1.
- B=SQRT(C)
- DO 1 I=1,50
- E(I)=A*B
- D=(A-B)/A
- A=A+B
- IF(D.LE.EPSI) GO TO 2
- 1 B=SQRT(E(I))*2.
-C-----COMPUTATION OF ELIN1= F(X,M) BY LANDEN TRANSFORMATION.
- 2 Y=SQRT(1.-X**2)/ABS(X)
- DO 4 J=1,I
- ELIN1=2.*ELIN1
- IF(Y.LT.0.) ELIN1=ELIN1+3.141592653589793
- IF(Y.EQ.0.) Y=EPSI2
- 4 Y=Y-E(J)/Y
- ELIN1= SIGN((ATAN2(A,Y)+ELIN1)/A,X)
- RETURN
-C-----SPECIAL CASE M=1,YIELDS F(X,M)= ATANH(X)
- 6 IF(ABS(X).GE.1.) WRITE(6,1000)X,M
- ELIN1=0.5*LOG((1.+X)/(1.-X))
- RETURN
- 1000 FORMAT('0*****ILLEGAL ARGUMENT IN ELLIPTIC INTEGRAL ELIN1(X,M).',
- * 'X=',F5.2,',M=',F5.2)
- END
diff --git a/src/mathlib/gen/obsolete/cdc/ccrack.s b/src/mathlib/gen/obsolete/cdc/ccrack.s
deleted file mode 100644
index acb15f5..0000000
--- a/src/mathlib/gen/obsolete/cdc/ccrack.s
+++ /dev/null
@@ -1,87 +0,0 @@
-*
-* $Id: ccrack.s,v 1.1.1.1 1996/04/01 15:03:02 mclareni Exp $
-*
-* $Log: ccrack.s,v $
-* Revision 1.1.1.1 1996/04/01 15:03:02 mclareni
-* Mathlib gen
-*
-*
-#if defined(CERNLIB_CDC)
- IDENT CCRACK
- ENTRY CCRACK
- SPACE 1
-************************************************************
-*
-* CCRACK - FORTRAN-CALLABLE COMPASS SUBROUTINE TO MOVE YHE
-* CRACKED CONTROL CARD FROM RAS+2 INTO COMMON/CCARD/
-* INPUT - RAS+2, RAS+3, ...
-*
-* OUTPUT - CRACKED CONTROL CARD IN COMMON /CCARD/
-* IF NO PARAMETERS, WORD 1 OF /CCARD/ WILL BE ZERO
-* (NOT SPACE-FILLED)
-*
-* THE COMMON BLOCK HAS A LENGTH OF 100B,AND IT HAS TO
-* BE DECLARED IN THE FORTRAN PROGRAM CALLING THIS
-* ROUTINE
-*
-* SOME EXTRA CHECKS HAVE BEEN ADDED (JULY 1979) TO PREVENT
-* INFINITE LOOPS FROM OCCURRING WHEN NUMBER OF FILES IN THE
-* FTN PROGRAM CARD IS GREATER THAN THE NUMBER OF PARAMETERS
-* IN THE CALLING SEQUENCE.
-***************************************************************
- SPACE 2
-TRACE DATA 10H CCRACK
- SPACE 3
- USE /CCARD/ COMMON BLOCK FOR RESULT OF CRACKING
-CCARD1 BSSZ 100B
- USE *
- SPACE 3
-CCRACK DATA 0 MAIN ENTRY
- SB7 1
- SA5 64B
- MX6 0
- MX0 42
- SA6 CCARD1 STORE ZERO WORD IN CCARD
- BX3 -X0*X5
- ZR X3,CCRACK RETURN IF NO PARAMETERS
- SB3 X3-1 SAVE NUMBER OF PARAMETERS
- SA5 2 INITIALIZE SCANNING
- NEXT BSS 0
- BX1 X0*X5
- RJ BLANKF
- BX6 -X0*X5 SEPARATOR CODE
- BX1 X0*X1
- SX3 X6-17B
- BX6 X6+X1 SYMBOL + SEPARATOR CODE
- SA6 A6
- SA5 A5+B7 PICK NEXT
- MX6 0
- SA6 A6+B7 NEW ZERO WORD AT END
- NZ B3,CCRACK1 STILL MORE PARAMETERS
- ZR X5,CCRACK STOP ON ZERO WORD
- ZR X3,CCRACK RETURN WHEN SEP. CODE = 17B
- EQ NEXT
-CCRACK1 SB3 B3-1
- ZR X3,CCRACK
- EQ NEXT
- SPACE 3
-***************************************
-*
-* BLANKF - BLANK FILLS SYMBOL IN X1
-* INPUT - X1
-* OUTPUT - X1
-*
- SPACE 1
-BLANKF DATA 0
- MX3 6
- SX4 1R
-BLANKF1 BSS 0
- LX3 6
- BX2 X1*X3
- NZ X2,BLANKF NONZERO CHAR DETECTED,RETURN
- BX1 X1+X4 OR IN BLANK
- LX4 6
- EQ BLANKF1
- SPACE 2
- END
-#endif
diff --git a/src/mathlib/gen/obsolete/cdc/entftn.inc b/src/mathlib/gen/obsolete/cdc/entftn.inc
deleted file mode 100644
index a08b02f..0000000
--- a/src/mathlib/gen/obsolete/cdc/entftn.inc
+++ /dev/null
@@ -1,63 +0,0 @@
-*
-* $Id: entftn.inc,v 1.1.1.1 1996/04/01 15:03:01 mclareni Exp $
-*
-* $Log: entftn.inc,v $
-* Revision 1.1.1.1 1996/04/01 15:03:01 mclareni
-* Mathlib gen
-*
-*
-* CDC MACRO CONVERTING PARAMETER LISTS FROM CERN TO CDC SCOPE.
-*
-* entftn.inc
-*
-#if (defined(CERNLIB_QF2C))&&(!defined(CERNLIB_LINUX))
- ENTFTN MACRO (NM,NOPAR,REG)
- LOCAL Z
- NM BSSZ 1
- Z1Z1Z IFNE *F,1
- EQ *+3
- BSSZ 2
- SA2 NM
- SA3 =O5302046000
- BX6 X2+X3
- LX6 30
- SA6 NM+2
- SA3 =O51200000000400000000
- SX4 NM+2
- IX3 X3+X4
- SX4 X4+1
- LX4 30
- BX6 X3+X4
- SA6 A2
- SX6 A0
- SB7 A1
- SA6 NM+3
- Z1Z1 SET 1 DIGITSELECTOR
- DUP NOPAR
- ZR X1,Z
- Z1Z1Z1 IFLT Z1Z1,7 IF FIRST SIX
- SB.Z1Z1 X1
- Z1Z1Z1 ELSE 2
- LX6 X1
- SA6 NM-NOPAR-2+Z1Z1
- Z1Z1Z1 ENDIF
- Z1Z1 SET Z1Z1+1
- Z1Z IFGE NOPAR,Z1Z1
- SA1 A1+1 LOAD NEXT
- Z1Z ENDIF
- ENDD
- Z BSS 0
-Z1Z1Z11 IFC NE,/REG//
-Z1Z1 SET 1
-Z1Z1Z1Z IFC EQ,/REG/X1/
-Z1Z1 SET 2
- BX2 X1
-Z1Z1Z1Z ENDIF
- S_REG A1-B7
- IFNE NOPAR,0
- ZR X.Z1Z1,*+2-$/46
- S_REG REG+1
- BSS 0
- ENDIF
- ENDM
-#endif
diff --git a/src/mathlib/gen/obsolete/cdc/intp.s b/src/mathlib/gen/obsolete/cdc/intp.s
deleted file mode 100644
index 1d3ac52..0000000
--- a/src/mathlib/gen/obsolete/cdc/intp.s
+++ /dev/null
@@ -1,51 +0,0 @@
-*
-* $Id: intp.s,v 1.1.1.1 1996/04/01 15:03:01 mclareni Exp $
-*
-* $Log: intp.s,v $
-* Revision 1.1.1.1 1996/04/01 15:03:01 mclareni
-* Mathlib gen
-*
-*
-#if defined(CERNLIB_CDC)
- IDENT INTP
- ENTRY INTP
-* FUNCTION INTP(I1,I2)
- NAME VFD 24/4HINTP,36/2
- INTP BSS 1
- SB1 X1
- SA1 A1+1
- SB2 X1
- SX3 0
- SA1 B2 .J1=J
- ZR X1,FINISH
- BX6 X1
- SA1 B1 .I1=I
- BX7 X1
- PL X6,CONT
- BX6 -X6
- BX7 -X7
- CONT SA6 J1
- SA7 I1
- CC LX6 59 .INCREASE X3 WITH I1 IF J1 IS ODD
- PL X6,AA
- SA2 I1
- IX3 X2+X3
- AA SA2 J1 .IS J1 EQ 1
- SX4 1
- IX7 X2-X4
- NZ X7,BB
- FINISH BX6 X3 .STORE RESULT AND RETURN
- EQ INTP
- BB SA1 I1 .I1=2*I1
- LX1 1
- BX6 X1
- SA6 I1
- SA1 J1 .J1=J1/2
- AX1 1
- BX6 X1
- SA6 J1
- JP CC
- I1 BSS 1
- J1 BSS 1
- END
-#endif
diff --git a/src/mathlib/gen/obsolete/cdc/intq.F b/src/mathlib/gen/obsolete/cdc/intq.F
deleted file mode 100644
index cd7b439..0000000
--- a/src/mathlib/gen/obsolete/cdc/intq.F
+++ /dev/null
@@ -1,50 +0,0 @@
-*
-* $Id: intq.F,v 1.1.1.1 1996/04/01 15:03:02 mclareni Exp $
-*
-* $Log: intq.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:02 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_CDC)
- FUNCTION INTQ(IN,ID,IR)
-C INTQ=[IN/ID] WITH REMAINDER IR
-C COMPUTED WITHOUT USING DIVISION OR MULTIPLICATION IN ORDER
-C TO PRESERVE MAXIMUM INTEGER CAPACITY, I.E. 2**59-1
-C CDC ONLY
-C T LINDELOF DECEMBER 1977
- IF(ID.EQ.0) GO TO 10
- INTQ=0
- IR=0
- IF(IN.EQ.0) RETURN
- ISIG=1
- IF(IN.LT.0) ISIG=-ISIG
- IF(ID.LT.0) ISIG=-ISIG
- M=0
- K=ABS(IN)
- KN=ABS(ID)
- 1 IF(KN.GT.K) GO TO 2
- KN=SHIFT(KN,1)
- M=M+1
- IF(KN.GT.0) GO TO 1
- 2 IF(M.EQ.0) GO TO 4
- DO 3 J=1,M
- N=0
- KN=SHIFT(KN,-1)
- IF(J.EQ.1) CALL SBIT0(KN,60)
- 6 IF(K.LT.KN) GO TO 5
- K=K-KN
- N=N+1
- GO TO 6
- 5 N=SHIFT(N,M-J)
- INTQ=INTQ+N
- 3 CONTINUE
- 4 IR=SIGN(K,IN)
- INTQ=INTP(ISIG,INTQ)
- RETURN
- 10 WRITE(6,100)
- 100 FORMAT('0*** ERROR IN INTQ (A105) *** ZERO DENOMINATOR')
- STOP
- END
-#endif
diff --git a/src/mathlib/gen/obsolete/cdc/irnd01ml.s b/src/mathlib/gen/obsolete/cdc/irnd01ml.s
deleted file mode 100644
index c60ce91..0000000
--- a/src/mathlib/gen/obsolete/cdc/irnd01ml.s
+++ /dev/null
@@ -1,46 +0,0 @@
-*
-* $Id: irnd01ml.s,v 1.1.1.1 1996/04/01 15:03:02 mclareni Exp $
-*
-* $Log: irnd01ml.s,v $
-* Revision 1.1.1.1 1996/04/01 15:03:02 mclareni
-* Mathlib gen
-*
-*
-#if defined(CERNLIB_CDC)
- IDENT IRND01
- ENTRY IRND01 .I=IRND01(DUMMY)
- ENTRY IR01IN .CALL IR01IN(SEED)
- ENTRY IR01UT .CALL IR01UT(SEED)
-* FUNCTION IRND01(DUMMY)
-* REVISED BY T LINDELOF, JAN 1980 (ENTRIES IR01IN AND IR01UT ADDED)
- NAME VFD 36/6HIRND01,24/1
- IRND01 DATA 0
- SA1 SEED
- SB2 7
- MX3 25
- SA2 C
- LX0 B2,X1
- SB3 34
- IX1 X1+X0
- IX1 X1+X2
- BX7 -X3*X1
- AX6 B3,X7
- SA7 SEED
- EQ IRND01
- NAME1 VFD 36/0HIR01UT,24/1
- IR01UT DATA 0
- SA1 X1
- SA2 SEED
- BX6 X2
- SA6 A1
- EQ IR01UT
- NAME2 VFD 36/0HIR01IN,24/1
- IR01IN DATA 0
- SA1 X1
- BX6 X1
- SA6 SEED
- EQ IR01IN
- SEED DATA 200000000000B
- C DATA 311715164025B
- END
-#endif
diff --git a/src/mathlib/gen/obsolete/cdc/iton.F b/src/mathlib/gen/obsolete/cdc/iton.F
deleted file mode 100644
index ee59d46..0000000
--- a/src/mathlib/gen/obsolete/cdc/iton.F
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: iton.F,v 1.1.1.1 1996/04/01 15:03:02 mclareni Exp $
-*
-* $Log: iton.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:02 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_CDC)
- FUNCTION ITON(IB,N)
-C COMPUTE ITON=IB**N WITHOUT USING EXPONENTIATION OR MULTIPLICATION
-C THUS PRESERVING 60-BIT INTEGERS ON CDC
- ITON=0
- IF(IB.EQ.0) RETURN
- IF(N) 1,2,3
- 1 IF(ABS(IB).GT.1) RETURN
- ITON=IB**N
- RETURN
- 2 ITON=1
- RETURN
- 3 ITON=1
- DO 4 I=1,N
- 4 ITON=INTP(ITON,IB)
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/obsolete/cdc/lfitml.s b/src/mathlib/gen/obsolete/cdc/lfitml.s
deleted file mode 100644
index eea6511..0000000
--- a/src/mathlib/gen/obsolete/cdc/lfitml.s
+++ /dev/null
@@ -1,113 +0,0 @@
-*
-* $Id: lfitml.s,v 1.1.1.1 1996/04/01 15:03:02 mclareni Exp $
-*
-* $Log: lfitml.s,v $
-* Revision 1.1.1.1 1996/04/01 15:03:02 mclareni
-* Mathlib gen
-*
-*
-#if (defined(CERNLIB_CDC))&&(!defined(CERNLIB_FORTRAN))
- IDENT LFIT
-ONE DATA 1.0
-COUNT BSS 1
-AZERO BSS 1
- ENTRY LFIT .SEE FORTRAN VERSION OF MBM OR
-* SUBROUTINE LFIT(X,Y,L,KEY,A,B,E)
-+VFD36/4HLFIT,24/6
-LFIT DATA 0 .MENZEL ,FORMULAS OF PHYSICS, P. 116
- SB2 X1
- SA2 A1+1
- SB1 X2
- SA3 A2+1
- SB3 X3
- SX7 A0
- SA7 AZERO
- SA3 A3+1
- SA3 X3
- SA0 X3
- SA4 A2+3
- SB4 X4
- SA5 A4+1
- SB5 X5
- SA5 A5+1
- SB6 X5
- SB7 2
- SA3 B3
- SB3 X3
- LT B3,B7,L25 .IF(L-2)25,1,1
- SA5 ONE
- SB7 B0 .J=0
- SX6 B0 .COUNT=0.0
- SX3 B0 .SUMY=0
- SX4 B0 .SUMX=0
-LOOP1 SA1 B7+B1
- SX2 A0
- NZ X2,L1
- ZR X1,L10 .IF(IY(J)) 5,10,5
-L1 SA2 B2+B7
- FX3 X3+X1 .SUMY=SUMY+FIPS(J)
- FX6 X6+X5 .COUNT=COUNT+1
- NX3 B0,X3
- FX4 X4+X2 .SUMX=SUMX+FICS(J)
- NX6 B0,X6
- NX4 B0,X4
-L10 SB7 B7+1
- LT B7,B3,LOOP1
- ZR X6,L25 .IF(COUNT.EQ.0) GO TO 25
- RX3 X3/X6 .YMED=SUMY/COUNT
- SB7 B0
- SX0 B0 .SUMXY=0
- SX7 B0 .SUMYY=0
- RX4 X4/X6 .XMD=SUMX /COUNT
- FX6 X6-X5
- NX6 B0,X6
- FX6 X6-X5 .COUNT=COUNT-2.0
- NX6 B0,X6
- SX5 B0 .SUMXX=0
- SA6 COUNT
-LOOP2 SA1 B1+B7
- SX2 A0
- NZ X2,L2
- ZR X1,L20 .IF(IY(J)) 15,20,15
-L2 SA2 B2+B7
- FX1 X1-X3 .SCARTY=FIPS(J)-YMED
- NX1 B0,X1
- FX2 X2-X4 .SCARTX=FICS(J)-XMED
- NX2 B0,X2
- FX6 X1*X2
- FX0 X6+X0 .SUMXY=SUMXY+SCARTX*SCARTY
- NX0 B0,X0
- FX2 X2*X2
- FX1 X1*X1
- FX5 X5+X2 .SUMXX=SUMXX+SCARTX*SCARTX
- NX5 B0,X5
- FX7 X7+X1 .SUMYY=SUMYY+SCARTY*SCARTY
- NX7 B0,X7
-L20 SB7 B7+1
- LT B7,B3,LOOP2
- ZR X5,L25 .IF(SUMXX.EQ.0.) GO TO 25
- RX6 X0/X5
- SA6 B4 .A=SUMXY/SUMXX
- BX1 X6
- FX6 X6*X4
- FX6 X3-X6
- NX6 B0,X6
- SA6 B5 .B=YMED-A*XMED
- FX6 X0*X1
- SA5 COUNT
- FX6 X7-X6
- NX6 B0,X6
- SX7 B0
- ZR X5,L101 .IF(COUNT.LE.2)GO TO 101
- RX6 X6/X5
- SA6 B6 .E=(SUMYY-SUMXY*A)/(COUNT-2.)
- JP REST
-L25 SX7 B0
- SA7 B4 .A=0.0
- SA7 B5 .B=0.0
-L101 SA7 B6 .E=0.0
-REST SA5 AZERO
- SA0 X5
- JP LFIT
- END
-#endif
diff --git a/src/mathlib/gen/obsolete/cdc/norrancd.s b/src/mathlib/gen/obsolete/cdc/norrancd.s
deleted file mode 100644
index 8fe3d3c..0000000
--- a/src/mathlib/gen/obsolete/cdc/norrancd.s
+++ /dev/null
@@ -1,166 +0,0 @@
-*
-* $Id: norrancd.s,v 1.1.1.1 1996/04/01 15:03:02 mclareni Exp $
-*
-* $Log: norrancd.s,v $
-* Revision 1.1.1.1 1996/04/01 15:03:02 mclareni
-* Mathlib gen
-*
-*
-#if defined(CERNLIB_CDC)
- IDENT NORRAN
- ENTRY NORRAN,NORRUT,NORRIN
-* SUBROUTINE NORRAN(RNORM)
-* GENERATE A NORMALLY-DISTRIBUTED RANDOM NUMBER
-* T. LINDELOF, MAY 1976 (NORRUT AND NORRIN ADDED JAN 1980)
-* CORRECTION RECEIVED FROM J.AHRENS IN NOVEMBER 1980
-* CORRECTIONS FROM H.LIPPS 26.11.81 TO AVOID OCCASIONAL UNNORMALIZED RESULTS
-NAME VFD 36/6HNORRAN,24/1
-NORRAN DATA 0
- SA2 FACTOR
- SA3 LAST
- DX7 X2*X3
- UX6 B6,X7
- BX0 X6
- LX0 30
- SB7 X0+777777B .LIPPS
- LX6 18
- MX0 55
- BX0 -X0*X6
- ZR X0,TAIL
- SB3 X0
- LX6 48
- PX6 B6,X6
- NX6 X6 .LIPPS
- SA4 A2+B3
- SA5 A4+32
- SHORT FX0 X6-X5
- NG X0,LONG
- NX0 X0
- SA3 A5+31
- FX3 X0*X3
- EXIT FX6 X4+X3
- SA7 LAST
- PL B7,OUT
- BX6 -X6
- OUT SA2 A1
- SA6 X2
- EQ NORRAN
- LONG DX7 X7*X2
- SA3 A4+1
- FX3 X3-X4
- NX0 X7 .LIPPS
- NX3 X3 .LIPPS
- FX3 X7*X3
- UX0 B2,X3
- SB2 B2-1
- PX0 B2,X0
- FX0 X0+X4
- NX3 X3
- FX1 X0*X3
- TEST FX0 X6-X1
- PL X0,EXIT
- DX7 X7*X2
- FX0 X6-X7
- NG X0,NEWUS
- BX1 X7
- DX7 X7*X2
- BX6 X7
- EQ TEST
- NEWUS DX7 X7*X2
- NX6 X7 .LIPPS
- EQ SHORT
- TAIL SA5 D
- SA4 A2+32
- MX3 54 .JA
- BX6 X3*X6 .JA
- NG X6,SHEND .JA
- INCR FX4 X4+X5 .JA
- LX6 1 .JA
- SA5 A5+1 .JA
- PL X6,INCR
- SHEND LX6 49
- PX6 B6,X6
- SB1 1
- TLOOP NX6 X6
- FX3 X6*X5
- UX0 B2,X3
- SB2 B2-B1
- PX0 B2,X0
- FX0 X0+X4
- FX1 X3*X0
- DX7 X7*X2
- TUSTAR BX6 X7
- FX0 X6-X1
- PL X0,EXIT
- DX7 X7*X2
- FX0 X6-X7
- PL X0,TNEWT
- DX7 X7*X2
- BX6 X7
- EQ TLOOP
- TNEWT BX1 X7
- DX7 X7*X2
- EQ TUSTAR
-NAME1 VFD 36/6HNORRUT,24/1
-NORRUT DATA 0
- SA2 LAST
- BX6 X2
- SA6 X1
- EQ NORRUT
-NAME2 VFD 36/6HNORRIN,24/1
-NORRIN DATA 0
- SA1 X1
- BX6 X1
- SA6 LAST
- EQ NORRIN
- LAST DATA 17170000000000000001B
- FACTOR DATA B20001170673633457725
- A DATA 0.00000000000000,0.03917608550309,0.07841241273311
- DATA 0.11776987457909,0.15731068461017,0.19709908429430
- DATA 0.23720210932878,0.27769043982157,0.31863936396437
- DATA 0.36012989178957,0.40225006532172,0.44509652498551
- DATA 0.48877641111466,0.53340970624127,0.57913216225555
- DATA 0.62609901234641,0.67448975019607,0.72451438349236
- DATA 0.77642176114792,0.83051087820539,0.88714655901887
- DATA 0.94678175630104,1.00999016924958,1.07751556704027
- DATA 1.15034938037600,1.22985875921658,1.31801089730353
- DATA 1.41779713799625,1.53412054435253,1.67593972277344
- DATA 1.86273186742164,2.15387469406144
- T DATA 0.00076738283767,0.00230687039764,0.00386061844387
- DATA 0.00543845406707,0.00705069876857,0.00870839582019
- DATA 0.01042356984914,0.01220953194966,0.01408124734637
- DATA 0.01605578804548,0.01815290075142,0.02039573175398
- DATA 0.02281176732513,0.02543407332319,0.02830295595118
- DATA 0.03146822492920,0.03499233438388,0.03895482964836
- DATA 0.04345878381672,0.04864034918076,0.05468333844273
- DATA 0.06184222395816,0.07047982761667,0.08113194985866
- DATA 0.09462443534514,0.11230007889456,0.13649799954975
- DATA 0.17168856004707,0.22762405488269,0.33049802776911
- DATA 0.58470309390507
- H DATA 0.03920617164634,0.03932704963665,0.03950999486086
- DATA 0.03975702679515,0.04007092772490,0.04045532602655
- DATA 0.04091480886081,0.04145507115859,0.04208311051344
- DATA 0.04280748137995,0.04363862733472,0.04458931789605
- DATA 0.04567522779560,0.04691571371696,0.04833486978119
- DATA 0.04996298427702,0.05183858644724,0.05401138183398
- DATA 0.05654656186515,0.05953130423884,0.06308488965373
- DATA 0.06737503494905,0.07264543556657,0.07926471414968
- DATA 0.08781922325338,0.09930398323927,0.11555994154118
- DATA 0.14043438342816,0.18361418337460,0.27900163464163
- DATA 0.70104742502766
- D DATA 0.26368432217502,0.24250845238097,0.22556744380930
- DATA 0.21163416577204,0.19992426749317,0.18991075842246
- DATA 0.18122518100691,0.17360140038056,0.16684190866667
- DATA 0.16079672918053,0.15534971747692,0.15040938382813
- DATA 0.14590257684509,0.14177003276856,0.13796317369537
- DATA 0.13444176150074,0.13117215026483,0.12812596512583
- DATA 0.12527909006226,0.12261088288608,0.12010355965651
- DATA 0.11774170701949,0.11551189226063,0.11340234879117
- DATA 0.11140272044119,0.10950385201710,0.10769761656476
- DATA 0.10597677198479,0.10433484129317,0.10276601206127
- DATA 0.10126505151402,0.09982723448906,0.09844828202068
- DATA 0.09712430874765,0.09585177768776,0.09462746119186
- DATA 0.09344840710526,0.09231190933664,0.09121548217294
- DATA 0.09015683778986,0.08913386650005,0.08814461935364
- END
-#endif
diff --git a/src/mathlib/gen/obsolete/cdc/nrancd.s b/src/mathlib/gen/obsolete/cdc/nrancd.s
deleted file mode 100644
index ce8541c..0000000
--- a/src/mathlib/gen/obsolete/cdc/nrancd.s
+++ /dev/null
@@ -1,54 +0,0 @@
-*
-* $Id: nrancd.s,v 1.1.1.1 1996/04/01 15:03:02 mclareni Exp $
-*
-* $Log: nrancd.s,v $
-* Revision 1.1.1.1 1996/04/01 15:03:02 mclareni
-* Mathlib gen
-*
-*
-#if (defined(CERNLIB_CDC))&&(!defined(CERNLIB_FORTRAN))
- IDENT NRAN
- ENTRY NRAN
- ENTRY NRANIN
- ENTRY NRANUT
-NAME1 VFD 24/0HNRAN,36/1
-* SUBROUTINE NRAN(VECTOR,LENGTH)
-* GENERATE N UNIFORMLY-DISTRIBUTED RANDOM NUMBERS
-* T. LINDELOF MAY,1976
-NRAN DATA 0
- SA3 A1+1
- SA2 X3
- SB1 X2
- LE B1,B0,NRAN
- SA5 A1
- MX4 59
- SA2 LAST
- SA3 MULT
-NEXT DX6 X2*X3
- BX2 X6
- NX6 X6
- SA6 X5
- SB1 B1-1
- LE B1,B0,END
- IX5 X5-X4
- EQ NEXT
-END BX6 X2
- SA6 LAST
- EQ NRAN
-* SUBROUTINE NRANIN(OCTAL)
-NRANIN DATA 0
- SA5 X1
- BX6 X5
- SA6 LAST
- EQ NRANIN
-* SUBROUTINE NRANUT(OCTAL)
-NRANUT DATA 0
- SA5 A1
- SA2 LAST
- BX6 X2
- SA6 X5
- EQ NRANUT
-LAST DATA 17170000000000000001B
-MULT DATA 20001170673633457725B
- END
-#endif
diff --git a/src/mathlib/gen/obsolete/cdc/nrancdf.F b/src/mathlib/gen/obsolete/cdc/nrancdf.F
deleted file mode 100644
index 9522aff..0000000
--- a/src/mathlib/gen/obsolete/cdc/nrancdf.F
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: nrancdf.F,v 1.1.1.1 1996/04/01 15:03:02 mclareni Exp $
-*
-* $Log: nrancdf.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:02 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if (defined(CERNLIB_CDC))&&(defined(CERNLIB_FORTRAN))
- SUBROUTINE NRAN(VECTOR,N)
- DIMENSION VECTOR(N)
- DO 100 I= 1, N
- VECTOR(I) = RNDM(I)
- 100 CONTINUE
- RETURN
- ENTRY NRANIN
- CALL RDMIN(VECTOR)
- RETURN
- ENTRY NRANUT
- CALL RDMOUT(VECTOR)
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/obsolete/cdc/rcv103.s b/src/mathlib/gen/obsolete/cdc/rcv103.s
deleted file mode 100644
index 39f0509..0000000
--- a/src/mathlib/gen/obsolete/cdc/rcv103.s
+++ /dev/null
@@ -1,158 +0,0 @@
-*
-* $Id: rcv103.s,v 1.1.1.1 1996/04/01 15:03:02 mclareni Exp $
-*
-* $Log: rcv103.s,v $
-* Revision 1.1.1.1 1996/04/01 15:03:02 mclareni
-* Mathlib gen
-*
-*
-#if defined(CERNLIB_CDC)
- IDENT RCV103
- ENTRY RCV103
-* SUBROUTINE RCV103
- ENTRY IXZ103
-* FUNCTION IXZ103(LUN)
- ENTRY UXZ103
-* ,SUBROUTINE UXZ103(LOCUSR)
- SST
-*
- MSG1 DATA H*RCV103 - RM ERROR =*
- RMNR DATA H* ON *
- LFN DATA 0
- MSG2 DATA L* PRECEDING ERROR UNCLEARED*
- FIES DATA 0
- PARAM VFD 60/PLIST
- PEND DATA 0
- PLIST BSS 0
- LASTES DATA 0
- INTLFN DATA 0
- FITADR DATA 0
- OUTLFN DATA 0
- ENTRY1 DATA H* RCV103 -*
- ENTRY2 DATA H* IXZ103 -*
- TRACE VFD 60/TRACE3
- UFLAG DATA 0
-*
-* TO BE ENTERED WHEN A FTN ERROR 103 IS ENCOUNTERED
- TRACE1 VFD 42/0HRCV103,18/RCV103
-RCV103 EQ *+1BS17
- SX6 A1 X6=FIT ADDRESS
- BX1 X6
- SA6 FITADR
- FETCH X1,IRS,X6
- SA6 FIES SAVE CURRENT RM ERROR
-*
-* SEND MSG1 TO DAYFILE
-* TRANSFORM INTEGER IN DISPLAY CODE
- BX3 X6
- MX6 0
- MX0 60-3
- SB5 3 ONLY 3 DIGITS IN RM ERROR
- LX3 51
- SB1 1
- SB4 1R0
- COD1 BSS 0
- LX3 3
- BX4 -X0*X3
- SX5 X4+B4
- LX6 6
- IX6 X6+X5
- SB5 B5-B1
- NZ B5,COD1
- LX6 42
- MX0 18
- SA5 RMNR
- BX4 -X0*X5
- BX6 X0*X6
- IX6 X4+X6
- SA6 A5 STORE RMNR
- SA2 X1
- BX6 X2
- SA6 LFN SAVE LFN NAME
- MESSAGE MSG1
-*
- SA5 LASTES
- SA2 ENTRY1
- NZ X5,UNCLEAR JUMP IF PREVIOUS ERROR UNCLEARED
- SA4 FIES
- BX6 X4
- SA6 A5 SAVE FIES
- SA5 UFLAG
- ZR X5,RETURN JUMP, NO USER SUBROUTINE
-*
-* A USER SUBROUTINE HAS TO BE CALLED.
-* FIND THE INTERNAL NAME OF THE FILE IN ERROR.
- SA1 FITADR
- MX0 42
- SB7 1
- SA2 B7+B7
- LOOP BSS 0
- ZR X2,NOMORE
- BX3 -X0*X2 GET FIT ADDRESS
- IX4 X3-X1
- ZR X4,FOUND JUMP, INTERNAL LFN FOUND
- SA2 A2+B7
- EQ LOOP
-*
-* PREPARE ARGUMENTS TO BE PASSED TO THE USER SUBROUTINE.
- NOMORE BSS 0
- FOUND BSS 0
- BX6 X0*X2
- SA6 INTLFN
- SA3 LFN
- BX7 X3
- SA7 OUTLFN
- SA1 PARAM
- RJUSER DATA 0 CALLS THE USER SUBROUTINE
- RETURN BSS 0
- EQ RCV103
-*
-* PRECEEDING ERROR UNCLEARED, SEND MSG2 TO DAYFILE AND ABORT
- UNCLEAR BSS 0
- BX6 X2
- SA6 MSG2 STORE CURRENT ENTRY IN MSG2
- MESSAGE MSG2
- MX6 0
- RJ =XSYSEND.
- ABORT
-*
-* J=IXZ103 (LUN) CHECKS IF AN ERROR HAS OCCURED ON LUN.
-* J RETURNS THE RM ERROR WHICH IS RESPONSIBLE FOR FTN ERROR 103.
- TRACE2 VFD 42/0HIXZ103,18/IXZ103
- IXZ103 EQ *+1BS17
- SA5 LASTES
- MX6 0
- ZR X5,IXZ103 NO ERROR, RETURN
- MX6 1
- BX1 X1+X6
- + RJ =XGETFIT. GET FIT ADDRESS IN X1
- - VFD 30/TRACE2
- SA4 FITADR
- SA2 ENTRY2
- IX3 X4-X1 COMPARE FITADR WITH CURRENT FIT ADDRESS
- NZ X3,UNCLEAR JUMP, UNCLEARED ERROR FOR ANOTHER FILE
- STORE X1,ES=0 CLEAR FIES
- SA5 LASTES
- BX6 X5
- MX7 0
- SA7 A5 CLEAR LASTES
- EQ IXZ103
-*
-* PREPARE LINK TO USER RECOVERY SUBROUTINE
- TRACE3 VFD 42/0HUXZ103,18/UXZ103
- UXZ103 EQ *+1BS17
- SA2 X1 X2=RECOVERY SUBROUTINE ADDRESS.
- MX6 0
- ZR X2,NORJ X2=0, RJUSER WILL NOT BE USED
- LX2 30
- MX6 1
- SA3 TRACE
- LX6 55 CODE FOR RJ INSTRUCTION
- BX2 X6+X2
- BX6 X2+X3
- SA6 RJUSER
- NORJ BSS 0
- SA6 UFLAG
- EQ UXZ103
- END
-#endif
diff --git a/src/mathlib/gen/obsolete/cray/gxxxrfcr.F b/src/mathlib/gen/obsolete/cray/gxxxrfcr.F
deleted file mode 100644
index 7b2bcc5..0000000
--- a/src/mathlib/gen/obsolete/cray/gxxxrfcr.F
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: gxxxrfcr.F,v 1.1.1.1 1996/04/01 15:03:23 mclareni Exp $
-*
-* $Log: gxxxrfcr.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:23 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_CRAY)
- REAL FUNCTION GXXXRF()
- REAL GXXXGT,GXXXST,DS(2),DM(2),SEED,DX24,DX48,DL,DC,DU
- DATA DS /1665 1885D0, 286 8876D0/
- DATA DM /1518 4245D0, 265 1554D0/
- DATA DX24 /1677 7216D0/
- DATA DX48 /281 4749 7671 0656D0/
- DL=DS(1)*DM(1)
- DC=AINT(DL/DX24)
- DL=DL-DC*DX24
- DU=DS(1)*DM(2)+DS(2)*DM(1)+DC
- DS(2)=DU-AINT(DU/DX24)*DX24
- DS(1)=DL
- GXXXRF=(DS(2)*DX24+DS(1))/DX48
- RETURN
- ENTRY GXXXGT()
- GXXXGT=DS(2)*DX24+DS(1)
- RETURN
- ENTRY GXXXST(SEED)
- DS(2)=AINT(SEED/DX24)
- DS(1)=SEED-DS(2)*DX24
- GXXXST=DS(1)
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/obsolete/cray/norrancr.F b/src/mathlib/gen/obsolete/cray/norrancr.F
deleted file mode 100644
index 2a3fb2f..0000000
--- a/src/mathlib/gen/obsolete/cray/norrancr.F
+++ /dev/null
@@ -1,67 +0,0 @@
-*
-* $Id: norrancr.F,v 1.1.1.1 1996/04/01 15:03:22 mclareni Exp $
-*
-* $Log: norrancr.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:22 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_CRAY)
- SUBROUTINE NORRAN(XRANNR)
-
- REAL XRANNR,GXXXRF,GXXXGT,GXXXST,SEED1,SEED2,SEED3
- REAL C(18),S(0:1),HALF,U,U0,Y
-
- DATA C( 1) /0.91954 44057 06926D0/
- DATA C( 2) /2.40375 76569 3742 D0/
- DATA C( 3) /0.82533 92825 36923D0/
- DATA C( 4) /2.11402 80833 3742 D0/
- DATA C( 5) /0.96548 71312 13858D0/
- DATA C( 6) /4.46911 47371 3927 D0/
- DATA C( 7) /0.94999 07087 33028D0/
- DATA C( 8) /1.84039 87473 9771 D0/
- DATA C( 9) /0.27362 93359 39706D0/
- DATA C(10) /0.11118 61229 00168D0/
- DATA C(11) /0.52562 50527 88295D0/
- DATA C(12) /0.10703 94984 15224D0/
- DATA C(13) /0.92585 23337 07704D0/
- DATA C(14) /0.28972 95736 00000D0/
- DATA C(15) /1.55066 91737 9771 D0/
- DATA C(16) /0.04004 21901 61353D0/
- DATA C(17) /0.95889 70004 32338D0/
- DATA C(18) /0.04110 29995 17662D0/
-
- DATA S /1,-1/
- PARAMETER(HALF = 0.5D0)
-
- U=GXXXRF()
- U0=GXXXRF()
- IF(U .LT. C(1)) THEN
- XRANNR=C(2)*(U0+U*C(3))-C(4)
- ELSE
- IF(U .GE. C(5)) THEN
- 1 Y=SQRT(C(6)-2*LOG(GXXXRF()))
- IF(Y*GXXXRF() .GT. C(4)) GO TO 1
- ELSE IF(U .GE. C(7)) THEN
- 2 Y=C(8)+GXXXRF()*C(9)
- IF(EXP(-HALF*Y*Y)-C(10)+Y*C(11) .LT. GXXXRF()*C(12)) GO TO 2
- ELSE IF(U .GE. C(13)) THEN
- 3 Y=C(14)+GXXXRF()*C(15)
- IF(EXP(-HALF*Y*Y)-C(10)+Y*C(11) .LT. GXXXRF()*C(16)) GO TO 3
- ELSE
- 4 Y=GXXXRF()*C(14)
- IF(EXP(-HALF*Y*Y)-C(17) .LT. GXXXRF()*C(18)) GO TO 4
- END IF
- XRANNR=S(INT(U0+U0))*Y
- END IF
- RETURN
- ENTRY NORRUT(SEED1,SEED2)
- SEED1=GXXXGT()
- SEED2=SEED2
- RETURN
- ENTRY NORRIN(SEED1,SEED2)
- SEED3=GXXXST(SEED1)
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/obsolete/d107obs/d107s164.F b/src/mathlib/gen/obsolete/d107obs/d107s164.F
deleted file mode 100644
index 919306d..0000000
--- a/src/mathlib/gen/obsolete/d107obs/d107s164.F
+++ /dev/null
@@ -1,360 +0,0 @@
-*
-* $Id: d107s164.F,v 1.1.1.1 1996/04/01 15:03:08 mclareni Exp $
-*
-* $Log: d107s164.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:08 mclareni
-* Mathlib gen
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_gen/pilot.h"
- SUBROUTINE D107S1(MODE,F,A,B,N,X,W)
-#include "imp64.inc"
- CHARACTER*6 NAME(2)
-
- DIMENSION X(*),W(*),KTBA(97),U(273),V(273)
- PARAMETER (Z1 = 1, HF = Z1/2)
-
- CHARACTER*80 ERRTXT
-
-#if defined(CERNLIB_DOUBLE)
- DATA NAME /'DGQUAD','DGSET'/
-#endif
-#if !defined(CERNLIB_DOUBLE)
- DATA NAME /'RGQUAD','RGSET'/
-#endif
-
- DATA KTBA
- 1/0,1,2,4,6,9,12,16,20,25,30,36,42,49,56,64,3*0,72,3*0,82,7*0,94,
- 2 7*0,110,7*0,130,15*0,154,15*0,186,15*0,226,0/
-
-C N=2.
- DATA U(1) /5.7735026918962576D-1/, V(1) /1/
-C N=3.
- DATA U(2) /7.7459666924148338D-1/, V(2) /5.5555555555555556D-1/
- DATA U(3) /0/ , V(3) /8.8888888888888889D-1/
-C N=4.
- DATA U(4) /8.6113631159405258D-1/, V(4) /3.4785484513745386D-1/
- DATA U(5) /3.3998104358485626D-1/, V(5) /6.5214515486254614D-1/
-C N=5.
- DATA U(6) /9.0617984593866399D-1/, V(6) /2.3692688505618909D-1/
- DATA U(7) /5.3846931010568309D-1/, V(7) /4.7862867049936647D-1/
- DATA U(8) /0/, V(8) /5.6888888888888889D-1/
-C N=6.
- DATA U(9) /9.3246951420315203D-1/, V(9) /1.7132449237917035D-1/
- DATA U(10) /6.6120938646626451D-1/, V(10) /3.6076157304813861D-1/
- DATA U(11) /2.3861918608319691D-1/, V(11) /4.6791393457269105D-1/
-C N=7.
- DATA U(12) /9.4910791234275852D-1/, V(12) /1.2948496616886969D-1/
- DATA U(13) /7.4153118559939444D-1/, V(13) /2.7970539148927667D-1/
- DATA U(14) /4.0584515137739717D-1/, V(14) /3.8183005050511894D-1/
- DATA U(15) /0/ , V(15) /4.1795918367346939D-1/
-C N=8.
- DATA U(16) /9.6028985649753623D-1/, V(16) /1.0122853629037626D-1/
- DATA U(17) /7.9666647741362674D-1/, V(17) /2.2238103445337447D-1/
- DATA U(18) /5.2553240991632899D-1/, V(18) /3.1370664587788729D-1/
- DATA U(19) /1.8343464249564980D-1/, V(19) /3.6268378337836198D-1/
-C N=9.
- DATA U(20) /9.6816023950762609D-1/, V(20) /8.1274388361574412D-2/
- DATA U(21) /8.3603110732663579D-1/, V(21) /1.8064816069485740D-1/
- DATA U(22) /6.1337143270059040D-1/, V(22) /2.6061069640293546D-1/
- DATA U(23) /3.2425342340380893D-1/, V(23) /3.1234707704000284D-1/
- DATA U(24) /0/ , V(24) /3.3023935500125976D-1/
-C N=10.
- DATA U(25) /9.7390652851717172D-1/, V(25) /6.6671344308688138D-2/
- DATA U(26) /8.6506336668898451D-1/, V(26) /1.4945134915058059D-1/
- DATA U(27) /6.7940956829902441D-1/, V(27) /2.1908636251598204D-1/
- DATA U(28) /4.3339539412924719D-1/, V(28) /2.6926671930999636D-1/
- DATA U(29) /1.4887433898163121D-1/, V(29) /2.9552422471475287D-1/
-C N=11.
- DATA U(30) /9.7822865814605699D-1/, V(30) /5.5668567116173666D-2/
- DATA U(31) /8.8706259976809530D-1/, V(31) /1.2558036946490462D-1/
- DATA U(32) /7.3015200557404932D-1/, V(32) /1.8629021092773425D-1/
- DATA U(33) /5.1909612920681182D-1/, V(33) /2.3319376459199048D-1/
- DATA U(34) /2.6954315595234497D-1/, V(34) /2.6280454451024666D-1/
- DATA U(35) /0/ , V(35) /2.7292508677790063D-1/
-C N=12.
- DATA U(36) /9.8156063424671925D-1/, V(36) /4.7175336386511827D-2/
- DATA U(37) /9.0411725637047486D-1/, V(37) /1.0693932599531843D-1/
- DATA U(38) /7.6990267419430469D-1/, V(38) /1.6007832854334623D-1/
- DATA U(39) /5.8731795428661745D-1/, V(39) /2.0316742672306592D-1/
- DATA U(40) /3.6783149899818019D-1/, V(40) /2.3349253653835481D-1/
- DATA U(41) /1.2523340851146892D-1/, V(41) /2.4914704581340279D-1/
-C N=13.
- DATA U(42) /9.8418305471858815D-1/, V(42) /4.0484004765315880D-2/
- DATA U(43) /9.1759839922297797D-1/, V(43) /9.2121499837728448D-2/
- DATA U(44) /8.0157809073330991D-1/, V(44) /1.3887351021978724D-1/
- DATA U(45) /6.4234933944034022D-1/, V(45) /1.7814598076194574D-1/
- DATA U(46) /4.4849275103644685D-1/, V(46) /2.0781604753688850D-1/
- DATA U(47) /2.3045831595513479D-1/, V(47) /2.2628318026289724D-1/
- DATA U(48) /0/ , V(48) /2.3255155323087391D-1/
-C N=14.
- DATA U(49) /9.8628380869681234D-1/, V(49) /3.5119460331751863D-2/
- DATA U(50) /9.2843488366357352D-1/, V(50) /8.0158087159760210D-2/
- DATA U(51) /8.2720131506976499D-1/, V(51) /1.2151857068790318D-1/
- DATA U(52) /6.8729290481168547D-1/, V(52) /1.5720316715819353D-1/
- DATA U(53) /5.1524863635815409D-1/, V(53) /1.8553839747793781D-1/
- DATA U(54) /3.1911236892788976D-1/, V(54) /2.0519846372129560D-1/
- DATA U(55) /1.0805494870734366D-1/, V(55) /2.1526385346315779D-1/
-C N=15.
- DATA U(56) /9.8799251802048543D-1/, V(56) /3.0753241996117268D-2/
- DATA U(57) /9.3727339240070590D-1/, V(57) /7.0366047488108125D-2/
- DATA U(58) /8.4820658341042722D-1/, V(58) /1.0715922046717194D-1/
- DATA U(59) /7.2441773136017005D-1/, V(59) /1.3957067792615431D-1/
- DATA U(60) /5.7097217260853885D-1/, V(60) /1.6626920581699393D-1/
- DATA U(61) /3.9415134707756337D-1/, V(61) /1.8616100001556221D-1/
- DATA U(62) /2.0119409399743452D-1/, V(62) /1.9843148532711158D-1/
- DATA U(63) /0/ , V(63) /2.0257824192556127D-1/
-C N=16.
- DATA U(64) /9.8940093499164993D-1/, V(64) /2.7152459411754095D-2/
- DATA U(65) /9.4457502307323258D-1/, V(65) /6.2253523938647893D-2/
- DATA U(66) /8.6563120238783174D-1/, V(66) /9.5158511682492785D-2/
- DATA U(67) /7.5540440835500303D-1/, V(67) /1.2462897125553387D-1/
- DATA U(68) /6.1787624440264375D-1/, V(68) /1.4959598881657673D-1/
- DATA U(69) /4.5801677765722739D-1/, V(69) /1.6915651939500254D-1/
- DATA U(70) /2.8160355077925891D-1/, V(70) /1.8260341504492359D-1/
- DATA U(71) /9.5012509837637440D-2/, V(71) /1.8945061045506850D-1/
-C N=20.
- DATA U(72) /9.9312859918509492D-1/, V(72) /1.7614007139152118D-2/
- DATA U(73) /9.6397192727791379D-1/, V(73) /4.0601429800386941D-2/
- DATA U(74) /9.1223442825132591D-1/, V(74) /6.2672048334109064D-2/
- DATA U(75) /8.3911697182221882D-1/, V(75) /8.3276741576704749D-2/
- DATA U(76) /7.4633190646015079D-1/, V(76) /1.0193011981724044D-1/
- DATA U(77) /6.3605368072651503D-1/, V(77) /1.1819453196151842D-1/
- DATA U(78) /5.1086700195082710D-1/, V(78) /1.3168863844917663D-1/
- DATA U(79) /3.7370608871541956D-1/, V(79) /1.4209610931838205D-1/
- DATA U(80) /2.2778585114164508D-1/, V(80) /1.4917298647260374D-1/
- DATA U(81) /7.6526521133497334D-2/, V(81) /1.5275338713072585D-1/
-C N=24.
- DATA U(82) /9.9518721999702136D-1/, V(82) /1.2341229799987200D-2/
- DATA U(83) /9.7472855597130950D-1/, V(83) /2.8531388628933663D-2/
- DATA U(84) /9.3827455200273276D-1/, V(84) /4.4277438817419806D-2/
- DATA U(85) /8.8641552700440103D-1/, V(85) /5.9298584915436781D-2/
- DATA U(86) /8.2000198597390292D-1/, V(86) /7.3346481411080306D-2/
- DATA U(87) /7.4012419157855436D-1/, V(87) /8.6190161531953276D-2/
- DATA U(88) /6.4809365193697557D-1/, V(88) /9.7618652104113888D-2/
- DATA U(89) /5.4542147138883954D-1/, V(89) /1.0744427011596563D-1/
- DATA U(90) /4.3379350762604514D-1/, V(90) /1.1550566805372560D-1/
- DATA U(91) /3.1504267969616337D-1/, V(91) /1.2167047292780339D-1/
- DATA U(92) /1.9111886747361631D-1/, V(92) /1.2583745634682830D-1/
- DATA U(93) /6.4056892862605626D-2/, V(93) /1.2793819534675216D-1/
-C N=32.
- DATA U(94) /9.9726386184948156D-1/, V(94) /7.0186100094700966D-3/
- DATA U(95) /9.8561151154526834D-1/, V(95) /1.6274394730905671D-2/
- DATA U(96) /9.6476225558750643D-1/, V(96) /2.5392065309262059D-2/
- DATA U(97) /9.3490607593773969D-1/, V(97) /3.4273862913021433D-2/
- DATA U(98) /8.9632115576605212D-1/, V(98) /4.2835898022226681D-2/
- DATA U(99) /8.4936761373256997D-1/, V(99) /5.0998059262376176D-2/
- DATA U(100)/7.9448379596794241D-1/, V(100)/5.8684093478535547D-2/
- DATA U(101)/7.3218211874028968D-1/, V(101)/6.5822222776361847D-2/
- DATA U(102)/6.6304426693021520D-1/, V(102)/7.2345794108848506D-2/
- DATA U(103)/5.8771575724076233D-1/, V(103)/7.8193895787070306D-2/
- DATA U(104)/5.0689990893222939D-1/, V(104)/8.3311924226946755D-2/
- DATA U(105)/4.2135127613063535D-1/, V(105)/8.7652093004403811D-2/
- DATA U(106)/3.3186860228212765D-1/, V(106)/9.1173878695763885D-2/
- DATA U(107)/2.3928736225213707D-1/, V(107)/9.3844399080804566D-2/
- DATA U(108)/1.4447196158279649D-1/, V(108)/9.5638720079274859D-2/
- DATA U(109)/4.8307665687738316D-2/, V(109)/9.6540088514727801D-2/
-C N=40.
- DATA U(110)/9.9823770971055920D-1/, V(110)/4.5212770985331913D-3/
- DATA U(111)/9.9072623869945701D-1/, V(111)/1.0498284531152814D-2/
- DATA U(112)/9.7725994998377426D-1/, V(112)/1.6421058381907889D-2/
- DATA U(113)/9.5791681921379166D-1/, V(113)/2.2245849194166957D-2/
- DATA U(114)/9.3281280827867653D-1/, V(114)/2.7937006980023401D-2/
- DATA U(115)/9.0209880696887430D-1/, V(115)/3.3460195282547847D-2/
- DATA U(116)/8.6595950321225950D-1/, V(116)/3.8782167974472018D-2/
- DATA U(117)/8.2461223083331166D-1/, V(117)/4.3870908185673272D-2/
- DATA U(118)/7.7830565142651939D-1/, V(118)/4.8695807635072232D-2/
- DATA U(119)/7.2731825518992710D-1/, V(119)/5.3227846983936824D-2/
- DATA U(120)/6.7195668461417955D-1/, V(120)/5.7439769099391551D-2/
- DATA U(121)/6.1255388966798024D-1/, V(121)/6.1306242492928939D-2/
- DATA U(122)/5.4946712509512820D-1/, V(122)/6.4804013456601038D-2/
- DATA U(123)/4.8307580168617871D-1/, V(123)/6.7912045815233904D-2/
- DATA U(124)/4.1377920437160500D-1/, V(124)/7.0611647391286780D-2/
- DATA U(125)/3.4199409082575847D-1/, V(125)/7.2886582395804059D-2/
- DATA U(126)/2.6815218500725368D-1/, V(126)/7.4723169057968264D-2/
- DATA U(127)/1.9269758070137110D-1/, V(127)/7.6110361900626242D-2/
- DATA U(128)/1.1608407067525521D-1/, V(128)/7.7039818164247966D-2/
- DATA U(129)/3.8772417506050822D-2/, V(129)/7.7505947978424811D-2/
-C N=48.
- DATA U(130)/9.9877100725242612D-1/, V(130)/3.1533460523058386D-3/
- DATA U(131)/9.9353017226635076D-1/, V(131)/7.3275539012762621D-3/
- DATA U(132)/9.8412458372282686D-1/, V(132)/1.1477234579234539D-2/
- DATA U(133)/9.7059159254624725D-1/, V(133)/1.5579315722943849D-2/
- DATA U(134)/9.5298770316043086D-1/, V(134)/1.9616160457355528D-2/
- DATA U(135)/9.3138669070655433D-1/, V(135)/2.3570760839324379D-2/
- DATA U(136)/9.0587913671556967D-1/, V(136)/2.7426509708356948D-2/
- DATA U(137)/8.7657202027424789D-1/, V(137)/3.1167227832798089D-2/
- DATA U(138)/8.4358826162439353D-1/, V(138)/3.4777222564770439D-2/
- DATA U(139)/8.0706620402944263D-1/, V(139)/3.8241351065830706D-2/
- DATA U(140)/7.6715903251574034D-1/, V(140)/4.1545082943464749D-2/
- DATA U(141)/7.2403413092381465D-1/, V(141)/4.4674560856694280D-2/
- DATA U(142)/6.7787237963266391D-1/, V(142)/4.7616658492490475D-2/
- DATA U(143)/6.2886739677651362D-1/, V(143)/5.0359035553854475D-2/
- DATA U(144)/5.7722472608397270D-1/, V(144)/5.2890189485193667D-2/
- DATA U(145)/5.2316097472223303D-1/, V(145)/5.5199503699984163D-2/
- DATA U(146)/4.6690290475095840D-1/, V(146)/5.7277292100403216D-2/
- DATA U(147)/4.0868648199071673D-1/, V(147)/5.9114839698395636D-2/
- DATA U(148)/3.4875588629216074D-1/, V(148)/6.0704439165893880D-2/
- DATA U(149)/2.8736248735545558D-1/, V(149)/6.2039423159892664D-2/
- DATA U(150)/2.2476379039468906D-1/, V(150)/6.3114192286254026D-2/
- DATA U(151)/1.6122235606889172D-1/, V(151)/6.3924238584648187D-2/
- DATA U(152)/9.7004699209462699D-2/, V(152)/6.4466164435950082D-2/
- DATA U(153)/3.2380170962869362D-2/, V(153)/6.4737696812683923D-2/
-C N=64.
- DATA U(154)/9.9930504173577214D-1/, V(154)/1.7832807216964329D-3/
- DATA U(155)/9.9634011677195528D-1/, V(155)/4.1470332605624676D-3/
- DATA U(156)/9.9101337147674432D-1/, V(156)/6.5044579689783629D-3/
- DATA U(157)/9.8333625388462596D-1/, V(157)/8.8467598263639477D-3/
- DATA U(158)/9.7332682778991096D-1/, V(158)/1.1168139460131129D-2/
- DATA U(159)/9.6100879965205372D-1/, V(159)/1.3463047896718643D-2/
- DATA U(160)/9.4641137485840282D-1/, V(160)/1.5726030476024719D-2/
- DATA U(161)/9.2956917213193958D-1/, V(161)/1.7951715775697343D-2/
- DATA U(162)/9.1052213707850281D-1/, V(162)/2.0134823153530209D-2/
- DATA U(163)/8.8931544599511412D-1/, V(163)/2.2270173808383254D-2/
- DATA U(164)/8.6599939815409282D-1/, V(164)/2.4352702568710873D-2/
- DATA U(165)/8.4062929625258036D-1/, V(165)/2.6377469715054659D-2/
- DATA U(166)/8.1326531512279756D-1/, V(166)/2.8339672614259483D-2/
- DATA U(167)/7.8397235894334141D-1/, V(167)/3.0234657072402479D-2/
- DATA U(168)/7.5281990726053190D-1/, V(168)/3.2057928354851554D-2/
- DATA U(169)/7.1988185017161083D-1/, V(169)/3.3805161837141609D-2/
- DATA U(170)/6.8523631305423324D-1/, V(170)/3.5472213256882384D-2/
- DATA U(171)/6.4896547125465734D-1/, V(171)/3.7055128540240046D-2/
- DATA U(172)/6.1115535517239325D-1/, V(172)/3.8550153178615629D-2/
- DATA U(173)/5.7189564620263403D-1/, V(173)/3.9953741132720341D-2/
- DATA U(174)/5.3127946401989455D-1/, V(174)/4.1262563242623529D-2/
- DATA U(175)/4.8940314570705296D-1/, V(175)/4.2473515123653589D-2/
- DATA U(176)/4.4636601725346409D-1/, V(176)/4.3583724529323453D-2/
- DATA U(177)/4.0227015796399160D-1/, V(177)/4.4590558163756563D-2/
- DATA U(178)/3.5722015833766812D-1/, V(178)/4.5491627927418144D-2/
- DATA U(179)/3.1132287199021096D-1/, V(179)/4.6284796581314417D-2/
- DATA U(180)/2.6468716220876742D-1/, V(180)/4.6968182816210017D-2/
- DATA U(181)/2.1742364374000708D-1/, V(181)/4.7540165714830309D-2/
- DATA U(182)/1.6964442042399282D-1/, V(182)/4.7999388596458308D-2/
- DATA U(183)/1.2146281929612055D-1/, V(183)/4.8344762234802957D-2/
- DATA U(184)/7.2993121787799039D-2/, V(184)/4.8575467441503427D-2/
- DATA U(185)/2.4350292663424433D-2/, V(185)/4.8690957009139720D-2/
-C N=80.
- DATA U(186)/9.9955382265163063D-1/, V(186)/1.1449500031869415D-3/
- DATA U(187)/9.9764986439823769D-1/, V(187)/2.6635335895126817D-3/
- DATA U(188)/9.9422754096568828D-1/, V(188)/4.1803131246948952D-3/
- DATA U(189)/9.8929130249975553D-1/, V(189)/5.6909224514031986D-3/
- DATA U(190)/9.8284857273862907D-1/, V(190)/7.1929047681173128D-3/
- DATA U(191)/9.7490914058572779D-1/, V(191)/8.6839452692608584D-3/
- DATA U(192)/9.6548508904379925D-1/, V(192)/1.0161766041103065D-2/
- DATA U(193)/9.5459076634363491D-1/, V(193)/1.1624114120797827D-2/
- DATA U(194)/9.4224276130987267D-1/, V(194)/1.3068761592401339D-2/
- DATA U(195)/9.2845987717244580D-1/, V(195)/1.4493508040509076D-2/
- DATA U(196)/9.1326310257175765D-1/, V(196)/1.5896183583725688D-2/
- DATA U(197)/8.9667557943877068D-1/, V(197)/1.7274652056269306D-2/
- DATA U(198)/8.7872256767821383D-1/, V(198)/1.8626814208299031D-2/
- DATA U(199)/8.5943140666311110D-1/, V(199)/1.9950610878141999D-2/
- DATA U(200)/8.3883147358025528D-1/, V(200)/2.1244026115782006D-2/
- DATA U(201)/8.1695413868146347D-1/, V(201)/2.2505090246332462D-2/
- DATA U(202)/7.9383271750460545D-1/, V(202)/2.3731882865930101D-2/
- DATA U(203)/7.6950242013504137D-1/, V(203)/2.4922535764115491D-2/
- DATA U(204)/7.4400029758359727D-1/, V(204)/2.6075235767565118D-2/
- DATA U(205)/7.1736518536209988D-1/, V(205)/2.7188227500486381D-2/
- DATA U(206)/6.8963764434202760D-1/, V(206)/2.8259816057276862D-2/
- DATA U(207)/6.6085989898611980D-1/, V(207)/2.9288369583267848D-2/
- DATA U(208)/6.3107577304687197D-1/, V(208)/3.0272321759557981D-2/
- DATA U(209)/6.0033062282975174D-1/, V(209)/3.1210174188114702D-2/
- DATA U(210)/5.6867126812270978D-1/, V(210)/3.2100498673487773D-2/
- DATA U(211)/5.3614592089713193D-1/, V(211)/3.2941939397645401D-2/
- DATA U(212)/5.0280411188878499D-1/, V(212)/3.3733214984611523D-2/
- DATA U(213)/4.6869661517054448D-1/, V(213)/3.4473120451753929D-2/
- DATA U(214)/4.3387537083175609D-1/, V(214)/3.5160529044747593D-2/
- DATA U(215)/3.9839340588196923D-1/, V(215)/3.5794393953416055D-2/
- DATA U(216)/3.6230475349948732D-1/, V(216)/3.6373749905835978D-2/
- DATA U(217)/3.2566437074770191D-1/, V(217)/3.6897714638276009D-2/
- DATA U(218)/2.8852805488451185D-1/, V(218)/3.7365490238730490D-2/
- DATA U(219)/2.5095235839227212D-1/, V(219)/3.7776364362001397D-2/
- DATA U(220)/2.1299450285766613D-1/, V(220)/3.8129711314477638D-2/
- DATA U(221)/1.7471229183264681D-1/, V(221)/3.8424993006959423D-2/
- DATA U(222)/1.3616402280914389D-1/, V(222)/3.8661759774076463D-2/
- DATA U(223)/9.7408398441584599D-2/, V(223)/3.8839651059051969D-2/
- DATA U(224)/5.8504437152420669D-2/, V(224)/3.8958395962769531D-2/
- DATA U(225)/1.9511383256793998D-2/, V(225)/3.9017813656306655D-2/
-C N=96.
- DATA U(226)/9.9968950388323077D-1/, V(226)/7.9679206555201243D-4/
- DATA U(227)/9.9836437586318168D-1/, V(227)/1.8539607889469217D-3/
- DATA U(228)/9.9598184298720929D-1/, V(228)/2.9107318179349464D-3/
- DATA U(229)/9.9254390032376262D-1/, V(229)/3.9645543384446867D-3/
- DATA U(230)/9.8805412632962380D-1/, V(230)/5.0142027429275177D-3/
- DATA U(231)/9.8251726356301468D-1/, V(231)/6.0585455042359617D-3/
- DATA U(232)/9.7593917458513647D-1/, V(232)/7.0964707911538653D-3/
- DATA U(233)/9.6832682846326421D-1/, V(233)/8.1268769256987592D-3/
- DATA U(234)/9.5968829144874254D-1/, V(234)/9.1486712307833866D-3/
- DATA U(235)/9.5003271778443764D-1/, V(235)/1.0160770535008416D-2/
- DATA U(236)/9.3937033975275522D-1/, V(236)/1.1162102099838499D-2/
- DATA U(237)/9.2771245672230869D-1/, V(237)/1.2151604671088320D-2/
- DATA U(238)/9.1507142312089807D-1/, V(238)/1.3128229566961573D-2/
- DATA U(239)/9.0146063531585234D-1/, V(239)/1.4090941772314861D-2/
- DATA U(240)/8.8689451740242042D-1/, V(240)/1.5038721026994938D-2/
- DATA U(241)/8.7138850590929650D-1/, V(241)/1.5970562902562291D-2/
- DATA U(242)/8.5495903343460146D-1/, V(242)/1.6885479864245172D-2/
- DATA U(243)/8.3762351122818712D-1/, V(243)/1.7782502316045261D-2/
- DATA U(244)/8.1940031073793168D-1/, V(244)/1.8660679627411467D-2/
- DATA U(245)/8.0030874413914082D-1/, V(245)/1.9519081140145022D-2/
- DATA U(246)/7.8036904386743322D-1/, V(246)/2.0356797154333325D-2/
- DATA U(247)/7.5960234117664750D-1/, V(247)/2.1172939892191299D-2/
- DATA U(248)/7.3803064374440013D-1/, V(248)/2.1966644438744349D-2/
- DATA U(249)/7.1567681234896763D-1/, V(249)/2.2737069658329374D-2/
- DATA U(250)/6.9256453664217156D-1/, V(250)/2.3483399085926220D-2/
- DATA U(251)/6.6871831004391615D-1/, V(251)/2.4204841792364691D-2/
- DATA U(252)/6.4416340378496712D-1/, V(252)/2.4900633222483610D-2/
- DATA U(253)/6.1892584012546857D-1/, V(253)/2.5570036005349361D-2/
- DATA U(254)/5.9303236477757208D-1/, V(254)/2.6212340735672414D-2/
- DATA U(255)/5.6651041856139717D-1/, V(255)/2.6826866725591762D-2/
- DATA U(256)/5.3938810832435744D-1/, V(256)/2.7412962726029243D-2/
- DATA U(257)/5.1169417715466767D-1/, V(257)/2.7970007616848334D-2/
- DATA U(258)/4.8345797392059636D-1/, V(258)/2.8497411065085386D-2/
- DATA U(259)/4.5470942216774301D-1/, V(259)/2.8994614150555237D-2/
- DATA U(260)/4.2547898840730055D-1/, V(260)/2.9461089958167906D-2/
- DATA U(261)/3.9579764982890860D-1/, V(261)/2.9896344136328386D-2/
- DATA U(262)/3.6569686147231364D-1/, V(262)/3.0299915420827594D-2/
- DATA U(263)/3.3520852289262542D-1/, V(263)/3.0671376123669149D-2/
- DATA U(264)/3.0436494435449635D-1/, V(264)/3.1010332586313837D-2/
- DATA U(265)/2.7319881259104914D-1/, V(265)/3.1316425596861356D-2/
- DATA U(266)/2.4174315616384001D-1/, V(266)/3.1589330770727167D-2/
- DATA U(267)/2.1003131046056720D-1/, V(267)/3.1828758894411006D-2/
- DATA U(268)/1.7809688236761860D-1/, V(268)/3.2034456231992663D-2/
- DATA U(269)/1.4597371465489694D-1/, V(269)/3.2206204794030251D-2/
- DATA U(270)/1.1369585011066592D-1/, V(270)/3.2343822568575928D-2/
- DATA U(271)/8.1297495464425559D-2/, V(271)/3.2447163714064269D-2/
- DATA U(272)/4.8812985136049731D-2/, V(272)/3.2516118713868836D-2/
- DATA U(273)/1.6276744849602970D-2/, V(273)/3.2550614492363166D-2/
-
- IF(KTBA(MIN(MAX(1,N),97)) .EQ. 0) THEN
- X(1)=0
- WRITE(ERRTXT,101) N
- CALL MTLPRT(NAME(MODE),'D107.1',ERRTXT)
- RETURN
- ENDIF
- ALFA=HF*(B+A)
- BETA=HF*(B-A)
- IF(MODE .EQ. 1) THEN
- SUM=0
- J1=MOD(N,2)
- J2=KTBA(N)+(N-1)/2
- DO 1 J = KTBA(N),J2-J1
- DELTA=BETA*U(J)
- SUM=SUM+V(J)*(F(ALFA+DELTA)+F(ALFA-DELTA))
- 1 CONTINUE
- IF(J1 .EQ. 1) SUM=SUM+V(J2)*F(ALFA)
- X(1)=BETA*SUM
- ELSE
- J1=KTBA(N)-1
- J2=N+1
- DO 2 J=1,J2/2
- WTEMP=BETA*V(J1+J)
- DELTA=BETA*U(J1+J)
- X(J)=ALFA-DELTA
- W(J)=WTEMP
- X(J2-J)=ALFA+DELTA
- W(J2-J)=WTEMP
- 2 CONTINUE
- ENDIF
- RETURN
- 101 FORMAT('N = ',I5,' IS NON-PERMISSIBLE')
- END
diff --git a/src/mathlib/gen/obsolete/d107obs/rgquad64.F b/src/mathlib/gen/obsolete/d107obs/rgquad64.F
deleted file mode 100644
index b99480e..0000000
--- a/src/mathlib/gen/obsolete/d107obs/rgquad64.F
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: rgquad64.F,v 1.1.1.1 1996/04/01 15:03:06 mclareni Exp $
-*
-* $Log: rgquad64.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:06 mclareni
-* Mathlib gen
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- FUNCTION DGQUAD(F,A,B,N)
-C
-#include "imp64.inc"
-C
-#endif
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION RGQUAD(F,A,B,N)
-#endif
- DIMENSION X(1),W(1)
- EXTERNAL F
-
- CALL D107S1(1,F,A,B,N,X,W)
-#if defined(CERNLIB_DOUBLE)
- DGQUAD=X(1)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- RGQUAD=X(1)
-#endif
- RETURN
- END
diff --git a/src/mathlib/gen/obsolete/d107obs/rgset64.F b/src/mathlib/gen/obsolete/d107obs/rgset64.F
deleted file mode 100644
index 014fd5c..0000000
--- a/src/mathlib/gen/obsolete/d107obs/rgset64.F
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: rgset64.F,v 1.1.1.1 1996/04/01 15:03:06 mclareni Exp $
-*
-* $Log: rgset64.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:06 mclareni
-* Mathlib gen
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- SUBROUTINE DGSET(A,B,N,X,W)
-C
-#include "imp64.inc"
-C
- EXTERNAL DGQUAD
- DIMENSION X(*),W(*)
-
- CALL D107S1(2,DGQUAD,A,B,N,X,W)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- SUBROUTINE RGSET(A,B,N,X,W)
- EXTERNAL RGQUAD
- DIMENSION X(*),W(*)
-
- CALL D107S1(2,RGQUAD,A,B,N,X,W)
-#endif
- RETURN
- END
diff --git a/src/mathlib/gen/obsolete/d111/gpindp.F b/src/mathlib/gen/obsolete/d111/gpindp.F
deleted file mode 100644
index 98f1508..0000000
--- a/src/mathlib/gen/obsolete/d111/gpindp.F
+++ /dev/null
@@ -1,477 +0,0 @@
-*
-* $Id: gpindp.F,v 1.1.1.1 1996/04/01 15:03:12 mclareni Exp $
-*
-* $Log: gpindp.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:12 mclareni
-* Mathlib gen
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_gen/pilot.h"
- DOUBLE PRECISION FUNCTION GPINDP(A,B,EPSIN,EPSOUT,FUNC,IOP)
-C
-C PARAMETERS
-C
-C A = LOWER BOUNDARY
-C B = UPPER BOUNDARY
-C EPSIN = ACCURACY REQUIRED FOR THE APPROXINATION
-C EPSOUT = IMPROVED ERROR ESTIMATE FOR THE APPROXIMATION
-C FUNC = FUNCTION ROUTINE FOR THE FUNCTION FUNC(X).TO BE DE-
-C CLARED EXTERNAL IN THE CALLING ROUTINE
-C IOP = OPTION PARAMETER , IOP=1 , MODIFIED ROMBERG ALGORITHM,
-C ORDINARY CASE
-C IOP=2 , MODIFIED ROMBERG ALGORITHM,
-C COSINE TRANSFORMED CASE
-C IOP=3 , MODIFIED CLENSHAW-CURTIS AL
-C GORITHM
-C
-C PARAMETERS IN COMMON BLOCK / GPINT /
-C
-C TEND = UPPER BOUND FOR VALUE OF INTEGRAL
-C UMID = LOWER BOUND FOR VALUE OF INTEGRALC
-C N = THE NUMBER OF INTEGRAND VALUES USED IN THE CALCULATION
-C LINE = LINE NO IN ROMBERG TABLE (RELATED TO N THROUGH
-C N-1=2**(LINE-1) , APPLICABLE ONLY FOR IOP=1 OR 2)
-C IOUT = ELEMENT NO IN LINE (APPLICABLE ONLY FOR IOP=1 OR 2)
-C JOP = OPTION PARAMETER , JOP=0 , NO PRINTING OF INTERMEDIATE
-C CALCULATIONS
-C JOP=1 , PRINT INTERMEDIATE CALCULA-
-C TIONS
-C KOP = OPTION PARAMETER , KOP=0 , NO TIME ESTIMATE
-C KOP=1 , ESTIMATE TIME
-C T = TIME USED FOR CALCULATION IN MSEC.
-C
-C INTEGRATION PARAMETERS
-C
-C NUPPER = 9 , CORRESPONDS TO 1024 SUB-INTERVALS FOR THE UNFOLDED
-C INTEGRAL.THE MAX.NO OF FUNCTION EVALUATIONS THUS BEEING
-C 1025.THE HIGHEST END-POINT APPROXIMATION IS THUS USING
-C 1024 INTERVALS WHILE THE HIGHEST MID-POINT APPROXIMA-
-C TION IS USING 512 INTERVALS.
-C
-C INPUT/OUTPUT PARAMETERS
-C
- EXTERNAL FUNC
- DOUBLE PRECISION A,B,EPSIN,EPSOUT,BOUND,FUNC
-C
-C INTERNAL ARRAYS
-C
- DOUBLE PRECISION ACOF(513),BCOF(513),CCOF(1025)
-C
-C CONSTANTS IN DATA STATEMENTS
-C
-C*NS DOUBLE PRECISION ZERO,FOURTH,HALF,ONE,TWO,THREE,FOUR,FAC1,FAC2,PI,
-C*NS 1RANDER
- DOUBLE PRECISION ZERO,FOURTH,HALF,ONE,TWO, FOUR,FAC1,FAC2,PI
-C
-C VARIABLES DEPENDING ON STEPSIZE
-C
- DOUBLE PRECISION ALF,BET,RN,HNSTEP,TEND,UMID,WMEAN,DELN,TNEW,AR
-C
-C CONSTANTS RELATED TO CALCULATION OF TRIGONOMETRIC FUNCTIONS
-C
- DOUBLE PRECISION TRIARG,ALFN0,BETN0,GAMMAN,DELTAN,ALFNJ,BETNJ,ETAN
- 1K,KSINK
-C
-C OTHER VARIABLES USED
-C
-C*NS DOUBLE PRECISION CONST1,CONST2,XPLUS,XMIN,ERROR,RK,A0,A1,A2,COF,FA
-C*NS 1CTOR,ENDPTS
- DOUBLE PRECISION CONST1,CONST2,XPLUS,XMIN, RK,A0,A1,A2,COF,FA
- 1CTOR,ENDPTS
-C
- COMMON /GPINT/ TEND, UMID, N, LINE, IOUT, JOP, KOP, T
- DATA ZERO,FOURTH,HALF,ONE,TWO,FOUR/0.D0,.25D0,.5D0,1.D0,2.D0,4.D0/
- DATA PI,FAC1,FAC2/3.141592653589793238462643383279D0,.411233516712
- 1056609118103791649D0,.822467033424113218236207583298D0/
-C
- DATA NUPPER/9/
-C
-C TIMEX(T) IS A LIBRARY SUBROUTINE GIVING THE ELAPSED CP TIME
-C
- IF(KOP .NE. 0) CALL TIMEX ( T1)
-C
-C INITIAL CALCULATIONS
-C
- ALF=HALF*(B-A)
- BET=HALF*(B+A)
- CONST1=FUNC(A)+FUNC(B)
- CONST2=FUNC(BET)
- HNSTEP=TWO
- IF(IOP.EQ.2) HNSTEP=PI
-C
- IF(IOP.GT.1) GOTO 10
-C
-C MODIFIED ROMBERG ALGORITHM,ORDINARY CASE
-C
- BCOF(1)=HNSTEP*CONST2
- ACOF(1)=HALF*(CONST1+BCOF(1))
- FACTOR=ONE
- ACOF(2)=ACOF(1)-(ACOF(1)-BCOF(1))/(FOUR*FACTOR-ONE)
- GOTO 30
-C
-10 IF(IOP.GT.2) GOTO 20
-C
-C MODIFIED ROMBERG ALGORITHM,COSINE TRANSFORMED CASE
-C
- AR=FAC1
- ENDPTS=CONST1
- ACOF(1)=FAC2*CONST1
- BCOF(1)=HNSTEP*CONST2-AR*CONST1
- FACTOR=FOUR
- ACOF(1)=HALF*(ACOF(1)+BCOF(1))
- ACOF(2)=ACOF(1)-(ACOF(1)-BCOF(1))/(FOUR*FACTOR-ONE)
- AR=FOURTH*AR
- GOTO 30
-C
-20 CONST1=HALF*CONST1
- ACOF(1)=HALF*(CONST1+CONST2)
- ACOF(2)=HALF*(CONST1-CONST2)
- BCOF(2)=ACOF(2)
- TEND=TWO*(ACOF(1)-ACOF(2)/(ONE+TWO))
-C
-C MODIFIED CLENSHAW-CURTIS ALGORITHM
-C
-30 HNSTEP=HALF*HNSTEP
- NHALF=1
- N=2
- RN=TWO
-C
- IF(IOP.NE.1) THEN
-C
-C INITIAL PARAMETERS SPECIAL FOR THE MODIFIED ROMBERG ALGORITHM,
-C COSINE TRANSFORMED CASE AND THE MODIFIED CLENSHAW-CURTIS ALGORITHM
-C
- TRIARG=FOURTH*PI
- ALFN0=-ONE
- ENDIF
-C
-C END OF INITIAL CALCULATIONS
-C
-C START ACTUAL CALCULATION
-C
-C--- Transform this DO-loop into a GOTO to avoid illegal jumps into it
-C
-C DO 350 I=1,NUPPER
- I=0
-41 I=I+1
- IF(I.GT.NUPPER) GOTO 350
- LINE=I+2
-C
- IF(IOP.GT.1) GOTO 60
-C
-C MODIFIED ROMBERG ALGORITHM,ORDINARY CASE
-C
-C COMPUTE FIRST ELEMENT IN MID-POINT FORMULA FOR ORDINARY CASE
-C
- UMID=ZERO
- ALFNJ=HALF*HNSTEP
- DO 50 J=1,NHALF
- XPLUS=ALF*ALFNJ+BET
- XMIN=-ALF*ALFNJ+BET
- UMID=UMID+FUNC(XPLUS)+FUNC(XMIN)
- ALFNJ=ALFNJ+HNSTEP
-50 CONTINUE
- UMID=HNSTEP*UMID
- GOTO 100
-C
-C COMPUTE FUNCTION VALUES FOR MODIFIED ROMBERG ALGORITHM,COSINE
-C TRANSFORMED CASE AND MODIFIED CLENSHAW-CURTIS ALGORITHM
-C
-60 CONST1=-SIN(TRIARG)
- CONST2=HALF*ALFN0/CONST1
- IF(IOP.EQ.2) ETANK=CONST2
- ALFN0=CONST1
- BETN0=CONST2
- GAMMAN=ONE-TWO*ALFN0**2
- DELTAN=-TWO*ALFN0*BETN0
-C
- DO 70 J=1,NHALF
- ALFNJ=GAMMAN*CONST1+DELTAN*CONST2
- BETNJ=GAMMAN*CONST2-DELTAN*CONST1
- XPLUS=ALF*ALFNJ+BET
- XMIN=-ALF*ALFNJ+BET
- CCOF(J)=FUNC(XPLUS)+FUNC(XMIN)
- CONST1=ALFNJ
- CONST2=BETNJ
-70 CONTINUE
-C
- IF(IOP.EQ.3) GOTO 190
-C
-C COMPUTE FIRST ELEMENT IN MID-POINT FORMULA FOR COSINE TRANSFORMED
-C ROMBERG ALGORITHM
-C
- NCOF=NHALF-1
- COF=TWO*(TWO*ETANK**2-ONE)
- A2=ZERO
- A1=ZERO
- A0=CCOF(NHALF)
- IF(NCOF.EQ.0) GOTO 90
- DO 80 J=1,NCOF
- A2=A1
- A1=A0
- INDEX=NHALF-J
- A0=CCOF(INDEX)+COF*A1-A2
-80 CONTINUE
-90 UMID=HNSTEP*(A0-A1)*ETANK-AR*ENDPTS
- AR=FOURTH*AR
-C
-C MODIFIED ROMBERG ALGORITHM,CALCULATE (I+1)-TH ROW IN U-TABLE
-C
-100 CONST1=FOUR*FACTOR
- INDEX=I+1
- DO 110 J=2,INDEX
- TEND=UMID+(UMID-BCOF(J-1))/(CONST1-ONE)
- BCOF(J-1)=UMID
- UMID=TEND
- CONST1=FOUR*CONST1
-110 CONTINUE
- BCOF(INDEX)=TEND
- XPLUS=CONST1
-C
-C CALCULATION OF (I+1)-TH ROW IN U-TABLE FINISHED
-C
-C PRINT INTERMEDIATE RESULTS IF WANTED
-C
- IF(JOP.EQ.0) GOTO 120
-C
- ICHECK=0
- ASSIGN 120 TO JUMP
- GOTO 360
-C
-C TEST IF REQUIRED ACCURACY IS OBTAINED
-C
-120 EPSOUT=ONE
- IOUT=1
- DO 140 J=1,INDEX
- CONST1=HALF*(ACOF(J)+BCOF(J))
- CONST2=HALF*ABS((ACOF(J)-BCOF(J))/CONST1)
- IF(CONST2.GT.EPSOUT) GOTO 130
- EPSOUT=CONST2
- IOUT=J
-130 ACOF(J)=CONST1
-140 CONTINUE
-C
-C TESTING ON ACCURACY FINISHED
-C
- IF(IOUT.EQ.INDEX) IOUT=IOUT+1
- ACOF(INDEX+1)=ACOF(INDEX)-(ACOF(INDEX)-BCOF(INDEX))/(XPLUS-ONE)
-C
- IF(EPSOUT.GT.EPSIN) GOTO 340
-C
-C CALCULATION FOR MODIFIED ROMBERG ALGORITHM FINISHED
-C
-150 N=2*N
-C
-C PRINT INTERMEDIATE RESULTS IF WANTED
-C
- IF(JOP.EQ.0) GOTO 170
-C
- ICHECK=1
- INDEX=INDEX+1
- ASSIGN 160 TO JUMP
- GOTO 360
-C
-160 INDEX=INDEX-1
-C
-170 N=N+1
- J=IOUT
- IF((J-1).LT.INDEX) GOTO 180
- J=INDEX
-180 TEND=ALF*(TWO*ACOF(J)-BCOF(J))
- UMID=ALF*BCOF(J)
- GPINDP=ALF*ACOF(IOUT)
-C
- GOTO 310
-C
-C START CALCULATION FOR MODIFIED CLENSHAW-CURTIS ALGORITHM
-C
-190 BCOF(1)=ZERO
- DO 200 J=1,NHALF
- BCOF(1)=BCOF(1)+CCOF(J)
-200 CONTINUE
- BCOF(1)=HALF*HNSTEP*BCOF(1)
-C
-C CALCULATION OF FIRST B-COEFFICIENT FINISHED.COMPUTE THE HIGHER
-C COEFFICIENTS IF NHALF GREATER THAN ONE
-C
- IF(NHALF.EQ.1) GOTO 230
-C
- CONST1=ONE
- CONST2=ZERO
- NCOF=NHALF-1
- KSIGN=-1
- DO 220 K=1,NCOF
-C
-C COMPUTE TRIGONOMETRIC SUM FOR B-COEFFICIENT
-C
- ETANK=GAMMAN*CONST1-DELTAN*CONST2
- KSINK=GAMMAN*CONST2+DELTAN*CONST1
- COF=TWO*(TWO*ETANK**2-ONE)
- A2=ZERO
- A1=ZERO
- A0=CCOF(NHALF)
- DO 210 J=1,NCOF
- A2=A1
- A1=A0
- INDEX=NHALF-J
- A0=CCOF(INDEX)+COF*A1-A2
-210 CONTINUE
-C
- BCOF(K+1)=HNSTEP*(A0-A1)*ETANK
- IF(KSIGN.EQ.-1) BCOF(K+1)=-BCOF(K+1)
- KSIGN=-KSIGN
-C
- CONST1=ETANK
- CONST2=KSINK
-C
-220 CONTINUE
-C
-C CALCULATION OF B-COEFFICIENTS FINISHED
-C
-C COMPUTE NEW MODIFIED MID-POINT APPROXIMATION WHEN THE INTERVAL
-C OF INTEGRATION IS DIVIDED IN N EQUAL SUB INTERVALS
-C
-230 UMID=ZERO
- RK=RN
- NN=NHALF+1
- DO 240 K=1,NN
- INDEX=NN+1-K
- UMID=UMID+BCOF(INDEX)/(RK**2-ONE)
- RK=RK-TWO
-240 CONTINUE
- UMID=-TWO*UMID
-C
-C COMPUTE NEW C-COEFFICIENTS FOR END-POINT APPROXIMATION
-C
- NN=N+2
- DO 250 J=1,NHALF
- INDEX=NN-J
- CCOF(J)=HALF*(ACOF(J)+BCOF(J))
- CCOF(INDEX)=HALF*(ACOF(J)-BCOF(J))
-250 CONTINUE
- INDEX=NHALF+1
- CCOF(INDEX)=ACOF(INDEX)
-C
-C CALCULATION OF NEW COEFFICIENTS FINISHED
-C
-C COMPUTE NEW END-POINT APPROXIMATION WHEN THE INTERVAL OF INTEGRA-
-C TION IS DIVIDED IN 2N EQUAL SUB INTERVALS
-C
- WMEAN=HALF*(TEND+UMID)
- BOUND=HALF*(TEND-UMID)
-C
- DELN=ZERO
- RK=TWO*RN
- DO 260 J=1,NHALF
- INDEX=N+2-J
- DELN=DELN+CCOF(INDEX)/(RK**2-ONE)
- RK=RK-TWO
-260 CONTINUE
- DELN=-TWO*DELN
-C
-C PRINT INTERMEDIATE RESULTS IF WANTED
-C
- IF(JOP.EQ.0) GOTO 270
-C
- GOTO 400
-C
-C PRINTING OF INTERMEDIATE RESULTS FINISHED
-C
-270 TNEW=WMEAN+DELN
- EPSOUT=ABS(BOUND/TNEW)
-C
- IF(EPSOUT.GT.EPSIN) GOTO 320
-C
-C REQUIRED ACCURACY OBTAINED
-C
-280 N=2*N+1
-C
-C*UL 290 TEND=ALF*(TEND+DELN)
- TEND=ALF*(TEND+DELN)
- UMID=ALF*(UMID+DELN)
-C
-C*UL 300 GPINDP=ALF*TNEW
- GPINDP=ALF*TNEW
-C
-310 IF(KOP.EQ.0) GOTO 315
- CALL TIMEX ( T)
- T=1000.*(T - T1)
-C
- 315 RETURN
-C
-320 DO 330 J=1,N
- ACOF(J)=CCOF(J)
-330 CONTINUE
- ACOF(N+1)=CCOF(N+1)
- BCOF(N+1)=CCOF(N+1)
- TEND=TNEW
-C
-340 NHALF=N
- N=2*N
- RN=TWO*RN
- HNSTEP=HALF*HNSTEP
- IF(IOP.GT.1) TRIARG=HALF*TRIARG
-C
- GOTO 41
-350 CONTINUE
-C
-C REQUIRED ACCURACY OF INTEGRAL NOT OBTAINED
-C
- N=NHALF
- RN=HALF*RN
-C
- IF(IOP.LT.3) GOTO 150
-C
- TEND=TWO*(TNEW-DELN)-UMID
-C
- GOTO 280
-C PRINT INTERMEDIATE RESULTS FOR THE MODIFIED ROMBERG ALGORITHM
-C
-360 IF((N.NE.2).AND.(N.NE.256)) GOTO 370
- IF(N.EQ.256) WRITE(6,460)
- WRITE(6,420)
-370 DO 390 J=1,INDEX
- CONST1=ALF*ACOF(J)
- IF(ICHECK.EQ.1) GOTO 380
- CONST2=ALF*BCOF(J)
- IF(J.EQ.1) WRITE(6,430) N,J,CONST1,CONST2
- IF(J.GT.1) WRITE(6,440) J,CONST1,CONST2
- GOTO 390
-C
-380 IF(J.EQ.1) WRITE(6,430) N,J,CONST1
- IF(J.GT.1) WRITE(6,440) J,CONST1
-390 CONTINUE
- GOTO JUMP,(120,160)
-C
-C PRINTING FINISHED FOR THE MODIFIED ROMBERG ALGORITHM
-C
-C PRINT INTERMEDIATE RESULTS FOR THE MODIFIED CLENSHAW-CURTIS AL-
-C GORITHM
-C
-400 A0=ALF*TEND
- A1=ALF*WMEAN
- A2=ALF*UMID
- CONST1=ALF*BOUND
- CONST2=ALF*DELN
-C
- IF(N.GT.2) GOTO 410
-C
- WRITE(6,470)
-410 WRITE(6,480) N,A0
- WRITE(6,490) A1,CONST2,CONST1
- WRITE(6,490) A2
- GOTO 270
-C
-C PRINTING FINISHED FOR THE MODIFIED CLENSHAW-CURTIS ALGORITHM
-C
-420 FORMAT(/,8X,'N',3X,'J',19X,'TEND(J)',34X,'UMID(J)',/)
-430 FORMAT(5X,I4,2X,I2,4X,D36.29,5X,D36.29)
-440 FORMAT(11X,I2,4X,D36.29,5X,D36.29)
-450 FORMAT(/)
-460 FORMAT('1'////)
-470 FORMAT(6X,'N',17X,'TEND ',/,20X,'(TEND+UMID)/2',28X,'DELN',34X,
- 1 '(TEND-UMID)/2'/24X,'UMID')
-480 FORMAT(/,4X,I3,2X,D36.29)
-490 FORMAT(9X,D36.29,3X,D36.29,3X,D36.29)
- END
diff --git a/src/mathlib/gen/obsolete/d115/chebqu.F b/src/mathlib/gen/obsolete/d115/chebqu.F
deleted file mode 100644
index 623fb33..0000000
--- a/src/mathlib/gen/obsolete/d115/chebqu.F
+++ /dev/null
@@ -1,221 +0,0 @@
-*
-* $Id: chebqu.F,v 1.1.1.1 1996/04/01 15:03:13 mclareni Exp $
-*
-* $Log: chebqu.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:13 mclareni
-* Mathlib gen
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_gen/pilot.h"
- DOUBLE PRECISION FUNCTION CHEBQU(A,B,EPSIN,EPSOUT,JOP,FUNC)
-C
-C BASIC VERSION AUGUST 1971.
-C PURPOSE = TO OBTAIN THE VALUE OF A REAL AND DEFINITE INTEGRAL AP-
-C PROXIMATING THE INTEGRAND F(X) BY
-C F(X)=.5*C(1)+C(2)*T(X,1)+............+C(M)*T(X,M-1)
-C WHERE T(X,K) IS THE CHEBYSHEV POLYNOMIAL OF ORDER K.
-C MODIFIED CLENSHAW/CURTIS METHOD REWRITTEN AS AN ORDINARY
-C QUADRATURE FORMULA.
-C THE BASIC THEORY FOR THE MODIFIED CLENSHAW-CURTIS ALGORITHM IS GI-
-C VEN IN T.HAAVIE , ON A MODIFICATION OF THE C355081W 3URT90 QUA-
-C DRATURE FORMULA , BIT 9(1969),338-350.
-C THE FORMULAS RELATED TO REWRITING THE ALGORITHM AS AN ORDINARY
-C QUADRATURE FORMULA IS GIVEN IN , T.HAAVIE , SOME METHODS FOR AUTO-
-C MATIC INTEGRATION AND THEIR IMPLEMENTATION ON THE CERN 65/6600
-C COMPUTERS , (YELLOW REPORT) CERN 71- , GENEVA 1971.
-C PARAMETERS
-C A = LOWER BOUNDARY
-C B = UPPER BOUNDARY
-C EPSIN = ACCURACY REQUIRED FOR THE APPROXINATION
-C EPSOUT = IMPROVED ERROR ESTIMATE FOR THE APPROXIMATION
-C JOP = OPTION PARAMETER , JOP=0 , NO PRINTING OF INTERMEDIATE
-C CALCULATIONS
-C JOP=1 , PRINT INTERMEDIATE CALCULA-
-C TIONS
-C FUNC = FUNCTION ROUTINE FOR THE FUNCTION FUNC(X).TO BE DE-
-C CLARED EXTERNAL IN THE CALLING ROUTINE
-C PARAMETERS IN COMMON BLOCK / CHEINT /
-C TEND = UPPER BOUND FOR VALUE OF INTEGRAL,I.E. TEND=TN*=TN+DN.
-C UMID = LOWER BOUND FOR VALUE OF INTEGRAL,I.E. UMID=UN*=UN+DN.
-C DELN = DN , DEFINITION FOLLOWS FROM DESCRIPTION OF TEND,UMID.
-C N = THE NUMBER OF INTEGRAND VALUES USED IN THE CALCULATION
- EXTERNAL FUNC
- DOUBLE PRECISION A,B,EPSIN,EPSOUT,FUNC
-C VARIABLES DEPENDING ON STEPSIZE
- DOUBLE PRECISION ALF,BET,RN,HNSTEP,TEND,UMID,WMEAN,DELN,TNEW,TSUM
- 1 , ACOFO , ACOFN , BCOFO , VALUE
-C OTHER VARIABLES USED
- DOUBLE PRECISION CONST1,CONST2,XPLUS,XMIN,BOUNDS , A0 , A1 , A2 ,
- 1 A3 , A4
- COMMON /CHEINT/ TEND , UMID , DELN , N
-C PARAMETERS IN THE COMMON BLOCK / DPCHEB /
-C (THESE PARAMETERS ARE PRESET IN COMMON BY MEANS OF A BLOCK DATA
-C SUBPROGRAM AND CONTAIN THE WEIGHTS AND ABSCISSAE FOR QUADRATURE
-C FORMULAS OF INCREASING ORDER.)
-C NUPPER = N CORRESPONDS TO 2**(N+1) SUB-INTERVALS FOR THE UNFOLDED
-C INTEGRAL.THE MAX NO OF FUNCTION EVALUATIONS THUS BEING
-C 1+2**(N+1).THE HIGHEST END-POINT APPROXIMATION IS THUS
-C USING 2**(N+1) INTERVALS WHILE THE HIGHEST MID-POINT AP-
-C PROXIMATION IS USING 2**N INTERVALS.
-C BETQJ = AN ARRAY CONTAINING THE WEIGHTS OF THE MID-POINT FORMU-
-C LAS 1 THROUGH NUPPER.
-C DIMENSION BETQJ(2**N-1)
-C KSIQJ = AN ARRAY CONTAINING THE ABSCISSAE OF THE MID-POINT FOR-
-C MULAS OF ORDER 1 THROUGH NUPPER.
-C DIMENSION KSIQJ(2**N-1)
-C ALFQJ = AN ARRAY CONTAINING THE WEIGHTS OF THE END-POINT FORMU-
-C LAS OF ORDER 2 THROUGH NUPPER+1.
-C DIMENSION ALFQJ(2**(N+1)+N-2)
- DOUBLE PRECISION BETQJ , KSIQJ , ALFQJ , FVAL
-C IN THIS VERSION OF CHEBQU NUPPER=9 , THE DIMENSIONS OF THE ARRAYS
-C IN THE COMMON BLOCK / DPCHEB / THUS BEING
- COMMON /DPCHEB/ BETQJ(511),KSIQJ(511),ALFQJ(1031),NUPPER
-C SOME INTERNAL PARAMETERS.
-C FVAL = AN INTERNAL ARRAY USED FOR STORING THE INTEGRAND VALU-
-C ES.
-C DIMENSION FVAL(2**N+1)
-C RNDERR = 1.D-28 , THE RELATIVE MACHINE ACCURACY IN DOUBLE PRECI-
-C SION (CDC-6000 SERIE).
-C IN THIS VERSION OF CHEBQU NUPPER=9 , THE DIMENSION OF FVAL THUS
-C BEING.
- DIMENSION FVAL(513)
- DOUBLE PRECISION ZERO,HALF,ONE,TWO,TWTHIR
- DATA ZERO , HALF , ONE , TWO / 0.D0 , .5D0 , 1.D0 , 2.D0 /
- DATA TWTHIR/.666666666666666666666666666667D0/
-C SET INITIAL VALUES OF CONSTANTS
- DATA IBD/0/
- IF(IBD.EQ.0) CALL D115BD(IBD)
-C THIS IS A CALL TO A SUBROUTINE WHICH ONLY GIVES VALUES TO THE
-C ARRAYS IN THE COMMON BLOCK DPCHEB BY DATA STATEMENTS
-C INTEGRATION INTERVAL PARAMETERS
-C*UL 1000 ALF=HALF*(B-A)
- ALF=HALF*(B-A)
- BET=HALF*(B+A)
- JNCR=2**(NUPPER-1)
- INCR=2*JNCR
-C
-C PARAMETERS FOR INTEGRATION STEPSIZE AND LOOPS
- RN =TWO
- N =2
- NHALF =1
- HNSTEP=ONE
-C
-C INITIAL CALCULATION FOR THE END-POINT APPROXIMATION
- CONST1=HALF*(FUNC(A)+FUNC(B))
- CONST2=FUNC(BET)
- ACOFO=HALF*(CONST1+CONST2)
- ACOFN=HALF*(CONST1-CONST2)
- TEND =TWTHIR*(CONST1+TWO*CONST2)
- FVAL(1)=CONST2+CONST2
- FVAL(INCR+1)=CONST1+CONST1
-C
-C START ACTUAL CALCULATION
-C
-C--- Transform this DO-loop into a GOTO to avoid illegal jumps into it
-C
-C DO 1150 I=1,NUPPER
- I=0
-1021 I=I+1
- IF(I.GT.NUPPER) GOTO 1150
-C
-C COMPUTE FUNCTION VALUES,CORRECTION TO MID-POINT APPROXIMATION AND
-C MID-POINT APPROXIMATION.
- BCOFO =ZERO
- UMID =ZERO
- DO 1030 J=1,NHALF
- INDEX= NHALF+J-1
- XPLUS= ALF*KSIQJ(INDEX)+BET
- XMIN =-ALF*KSIQJ(INDEX)+BET
- VALUE= FUNC(XPLUS)+FUNC(XMIN)
- BCOFO= BCOFO+VALUE
- UMID = UMID+BETQJ(INDEX)*VALUE
- INDEX= (2*J-1)*JNCR+1
- FVAL(INDEX)=VALUE
- 1030 CONTINUE
-C
- UMID = UMID-TWO*ACOFN/(RN**2-ONE)
- BCOFO= HALF*HNSTEP*BCOFO
-C
-C COMPUTE NEW END-POINT APPROXIMATION WHEN THE INTERVAL OF INTEGRA-
-C TION IS DIVIDED IN 2N EQUAL SUB INTERVALS
- WMEAN =HALF*(TEND+UMID)
- BOUNDS=HALF*(TEND-UMID)
- IPOINT=I+N-2
- TSUM =ALFQJ(IPOINT)*FVAL(1)
- DO 1110 J=1,N
- INDEX=1+J*JNCR
- TSUM =TSUM+ALFQJ(IPOINT+J)*FVAL(INDEX)
- 1110 CONTINUE
- DELN =TSUM-WMEAN
- ACOFN =HALF*(ACOFO-BCOFO)
- ACOFO =ACOFO-ACOFN
-C ******************************************************************
-C * *
-C PRINT INTERMEDIATE RESULTS IF WANTED
- IF (JOP.EQ.0) GO TO 1120
- GO TO 2000
-C * *
-C ******************************************************************
- 1120 TNEW =TSUM
- EPSOUT=ABS(BOUNDS/TNEW)
- IF (EPSOUT.GT.EPSIN) GO TO 1130
-C
-C REQUIRED ACCURACY OBTAINED OR THE MAXIMUM NUMBER OF FUNTION VAL-
-C UES USED WITHOUT OBTAINING THE REQUIRED ACCURACY.
- 1124 N=2*N+1
-C*UL 1125 TEND=ALF*(TEND+DELN)
- TEND=ALF*(TEND+DELN)
- UMID=ALF*(UMID+DELN)
- DELN=ALF*DELN
-C*UL 1126 CHEBQU=ALF*TNEW
-C*UL 1128 RETURN
- CHEBQU=ALF*TNEW
- RETURN
-C
-C CALCULATION FINISHED.
-C
- 1130 IF (I.EQ.NUPPER) GO TO 1124
-C
-C IF I=NUPPER THEN THE REQUIRED ACCURACY IS NOT OBTAINED.
-C PREPARE PARAMETERS FOR NEXT INTERVAL HALVING.
- TEND=TNEW
- NHALF =N
- N =2*N
- RN =TWO*RN
- INCR=JNCR
- JNCR=JNCR/2
- HNSTEP=HALF*HNSTEP
- GOTO 1021
- 1150 CONTINUE
-C ******************************************************************
-C * *
-C PRINT INTERMEDIATE RESULTS
- 2000 A0 = ALF*TEND
- A1 = ALF*WMEAN
- A2 = ALF*UMID
- CONST1 = ALF*BOUNDS
- CONST2 = ALF*DELN
- A3 = A0+CONST2
- A4 = A2+CONST2
-C
- IF (I.GT.1) GO TO 2010
- WRITE(6,10)
- 2010 WRITE(6,20) N , A0
- WRITE(6,30) A3
- WRITE(6,30) A1 , CONST2 , CONST1
- WRITE(6,30) A4
- WRITE(6,30) A2
-C
- GO TO 1120
-C
- 10 FORMAT(6X,'N',17X,'TEND ',
- 1 /,24X,'TEND* ',
- 2 /,20X,'(TEND+UMID)/2',28X,'DELTAN',34X,'(TEND-UMID)/2'
- 3 , /,24X,'UMID* ',
- 4 /,24X,'UMID ')
- 20 FORMAT(/,4X,I3,2X,D36.29)
- 30 FORMAT(9X,D36.29,3X,D36.29,3X,D36.29)
-C * *
-C ******************************************************************
- END
diff --git a/src/mathlib/gen/obsolete/d115/d115bd.F b/src/mathlib/gen/obsolete/d115/d115bd.F
deleted file mode 100644
index ac771fd..0000000
--- a/src/mathlib/gen/obsolete/d115/d115bd.F
+++ /dev/null
@@ -1,2099 +0,0 @@
-*
-* $Id: d115bd.F,v 1.1.1.1 1996/04/01 15:03:13 mclareni Exp $
-*
-* $Log: d115bd.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:13 mclareni
-* Mathlib gen
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_gen/pilot.h"
- SUBROUTINE D115BD(IX)
-C
-C PURPOSE = TO PRESET IN COMMON THE WEIGHTS AND ABSCISSAE TO BE USED
-C IN THE VERSION OF CHINDP REWRITTEN AS A PURE QUADRATURE
-C FORMULA.
-C PARAMETERS IN COMMON BLOCK / DPCHEB /
-C NUPPER = N CORRESPONDS TO 2**(N+1) SUB-INTERVALS FOR THE UNFOLDED
-C INTEGRAL.THE MAX NO OF FUNCTION EVALUATIONS THUS BEING
-C 1+2**(N+1).THE HIGHEST END-POINT APPROXIMATION IS THUS
-C USING 2**(N+1) INTERVALS WHILE THE HIGHEST MID-POINT AP-
-C PROXIMATION IS USING 2**N INTERVALS.
-C BETQJ = AN ARRAY CONTAINING THE WEIGHTS OF THE MID-POINT FORMU-
-C LAS 1 THROUGH NUPPER.
-C DIMENSION BETQJ(2**N-1)
-C KISQJ = AN ARRAY CONTAINING THE ABSCISSAE OF THE MID-POINT FOR-
-C MULAS OF ORDER 1 THROUGH NUPPER.
-C DIMENSION KISQJ(2**N-1)
-C ALFQJ = AN ARRAY CONTAINING THE WEIGHTS OF THE END-POINT FORMU-
-C LAS OF ORDER 2 THROUGH NUPPER+1.
-C DIMENSION ALFQJ(2**(N+1)+N-2)
- DOUBLE PRECISION BETQJ(511),KISQJ(511),ALFQJ(1031)
- COMMON /DPCHEB/ DB(1022),DK(1022),DA(2062),NUPPER
-C WEIGHTS FOR MID-POINT FORMULAS OF INCREASING ORDER.
- DATA BETQJ( 1) / 1.00000000000000000000000000000D+00 /
- DATA BETQJ( 2) / 7.35702260395515841466948120704D-01 /
- DATA BETQJ( 3) / 2.64297739604484158533051879334D-01 /
- DATA BETQJ( 4) / 3.85876602222307014804123243059D-01 /
- DATA BETQJ( 5) / 3.24152519064524354347226001928D-01 /
- DATA BETQJ( 6) / 2.22987933014578813946163622217D-01 /
- DATA BETQJ( 7) / 6.69829456985898169024871328027D-02 /
- DATA BETQJ( 8) / 1.95451247812314056328043989390D-01 /
- DATA BETQJ( 9) / 1.87749728115074003271038262398D-01 /
- DATA BETQJ( 10) / 1.73419411771946314043685032788D-01 /
- DATA BETQJ( 11) / 1.51392461637132121514160672387D-01 /
- DATA BETQJ( 12) / 1.25129618158383650789100458635D-01 /
- DATA BETQJ( 13) / 9.17183132052952303704207652611D-02 /
- DATA BETQJ( 14) / 5.83364640693756828609010881667D-02 /
- DATA BETQJ( 15) / 1.68027552304789408226497309943D-02 /
- DATA BETQJ( 16) / 9.80594985676589033777447197877D-02 /
- DATA BETQJ( 17) / 9.71031678911530281316213864061D-02 /
- DATA BETQJ( 18) / 9.52478048614739935356359731542D-02 /
- DATA BETQJ( 19) / 9.24141549899298361190497083983D-02 /
- DATA BETQJ( 20) / 8.87776328671887213053249411531D-02 /
- DATA BETQJ( 21) / 8.41709772000224234271393383696D-02 /
- DATA BETQJ( 22) / 7.88996229454584311507403545426D-02 /
- DATA BETQJ( 23) / 7.26879094967195191512691495117D-02 /
- DATA BETQJ( 24) / 6.59967064068230252212299001856D-02 /
- DATA BETQJ( 25) / 5.84015683263386573195965723726D-02 /
- DATA BETQJ( 26) / 5.05717199950937712305283256871D-02 /
- DATA BETQJ( 27) / 4.18497477492846903804802558455D-02 /
- DATA BETQJ( 28) / 3.32371259531269165399233450800D-02 /
- DATA BETQJ( 29) / 2.36297784196933961644769427257D-02 /
- DATA BETQJ( 30) / 1.47483281301253089398722611085D-02 /
- DATA BETQJ( 31) / 4.20425619990937800536682570484D-03 /
- DATA BETQJ( 32) / 4.90727880726718415980891084878D-02 /
- DATA BETQJ( 33) / 4.89538187270302219918765874451D-02 /
- DATA BETQJ( 34) / 4.87191650601860733395885887677D-02 /
- DATA BETQJ( 35) / 4.83633810166851452253452027978D-02 /
- DATA BETQJ( 36) / 4.78963773367738420754453364812D-02 /
- DATA BETQJ( 37) / 4.73071384670531355840942295809D-02 /
- DATA BETQJ( 38) / 4.66123725148979115812073230394D-02 /
- DATA BETQJ( 39) / 4.57952381527398410514181445397D-02 /
- DATA BETQJ( 40) / 4.48795432396496555252983595043D-02 /
- DATA BETQJ( 41) / 4.38422111265821629991762767533D-02 /
- DATA BETQJ( 42) / 4.27146100252825789561513762887D-02 /
- DATA BETQJ( 43) / 4.14668298365662040962622000776D-02 /
- DATA BETQJ( 44) / 4.01384634865749515116678397898D-02 /
- DATA BETQJ( 45) / 3.86919232402970344042509788914D-02 /
- DATA BETQJ( 46) / 3.71759683898331706728240407611D-02 /
- DATA BETQJ( 47) / 3.55441501365980202602256533756D-02 /
- DATA BETQJ( 48) / 3.38557332013510651872721261491D-02 /
- DATA BETQJ( 49) / 3.20537303036380378017250707345D-02 /
- DATA BETQJ( 50) / 3.02098511873512716792275523172D-02 /
- DATA BETQJ( 51) / 2.82541302354714105189132709025D-02 /
- DATA BETQJ( 52) / 2.62736245410712519298389925720D-02 /
- DATA BETQJ( 53) / 2.41816922001156436442902565645D-02 /
- DATA BETQJ( 54) / 2.20852976877565292657597542806D-02 /
- DATA BETQJ( 55) / 1.98751702056907213872576852565D-02 /
- DATA BETQJ( 56) / 1.76858732581656407894181269584D-02 /
- DATA BETQJ( 57) / 1.53750452761919178513758604735D-02 /
- DATA BETQJ( 58) / 1.31192732300491901026532450411D-02 /
- DATA BETQJ( 59) / 1.07220736325979534387703172229D-02 /
- DATA BETQJ( 60) / 8.43412760249206854482470589810D-03 /
- DATA BETQJ( 61) / 5.95172900008703870671692732424D-03 /
- DATA BETQJ( 62) / 3.69738253841499004508471217168D-03 /
- DATA BETQJ( 63) / 1.05128707013347823395014961900D-03 /
- DATA BETQJ( 64) / 2.45418562116188387260496297048D-02 /
- DATA BETQJ( 65) / 2.45270263066254975653888819810D-02 /
- DATA BETQJ( 66) / 2.44975627199956819509230286254D-02 /
- DATA BETQJ( 67) / 2.44531083928094832204446638185D-02 /
- DATA BETQJ( 68) / 2.43942528786309582683403706714D-02 /
- DATA BETQJ( 69) / 2.43202802024583602699031877766D-02 /
- DATA BETQJ( 70) / 2.42321759161535277724885329314D-02 /
- DATA BETQJ( 71) / 2.41288613791139859955658040957D-02 /
- DATA BETQJ( 72) / 2.40117226477459638231191403000D-02 /
- DATA BETQJ( 73) / 2.38793127021104312496194784775D-02 /
- DATA BETQJ( 74) / 2.37334245393051077344356764003D-02 /
- DATA BETQJ( 75) / 2.35722349705309097517753380724D-02 /
- DATA BETQJ( 76) / 2.33979524334629573169817392702D-02 /
- DATA BETQJ( 77) / 2.32083675490039832781754285618D-02 /
- DATA BETQJ( 78) / 2.30061149408342046388124349443D-02 /
- DATA BETQJ( 79) / 2.27885865785100255109001585576D-02 /
- DATA BETQJ( 80) / 2.25588565007408867258106568488D-02 /
- DATA BETQJ( 81) / 2.23139028560822119251310184687D-02 /
- DATA BETQJ( 82) / 2.20572551165736475607493507979D-02 /
- DATA BETQJ( 83) / 2.17854593879484783573351057469D-02 /
- DATA BETQJ( 84) / 2.15025197718956944300528502841D-02 /
- DATA BETQJ( 85) / 2.12045286212519038436175884656D-02 /
- DATA BETQJ( 86) / 2.08959875344003629348674036808D-02 /
- DATA BETQJ( 87) / 2.05725093599767214208305659520D-02 /
- DATA BETQJ( 88) / 2.02391203559297770861763430568D-02 /
- DATA BETQJ( 89) / 1.98909233710493123302837828800D-02 /
- DATA BETQJ( 90) / 1.95335015780047717574608291067D-02 /
- DATA BETQJ( 91) / 1.91614116867049485550054844476D-02 /
- DATA BETQJ( 92) / 1.87808321537942523948140885756D-02 /
- DATA BETQJ( 93) / 1.83857306089932152398660548980D-02 /
- DATA BETQJ( 94) / 1.79829265993143434853119160656D-02 /
- DATA BETQJ( 95) / 1.75657474215408115431316290959D-02 /
- DATA BETQJ( 96) / 1.71417086891475921707885165603D-02 /
- DATA BETQJ( 97) / 1.67034358120624662587196566345D-02 /
- DATA BETQJ( 98) / 1.62592069155530264319955837727D-02 /
- DATA BETQJ( 99) / 1.58008710060142752108674759612D-02 /
- DATA BETQJ( 100) / 1.53375497352951392179826230910D-02 /
- DATA BETQJ( 101) / 1.48602246061354140544297955044D-02 /
- DATA BETQJ( 102) / 1.43789606373328322342683902291D-02 /
- DATA BETQJ( 103) / 1.38837591223772700634002336840D-02 /
- DATA BETQJ( 104) / 1.33857530795303093301102240257D-02 /
- DATA BETQJ( 105) / 1.28738221578470520315100542030D-02 /
- DATA BETQJ( 106) / 1.23603253695221996627273106373D-02 /
- DATA BETQJ( 107) / 1.18328401805997896171788486260D-02 /
- DATA BETQJ( 108) / 1.13051556159236831676615897553D-02 /
- DATA BETQJ( 109) / 1.07633117403738030438797798891D-02 /
- DATA BETQJ( 110) / 1.02227969783941265822929513070D-02 /
- DATA BETQJ( 111) / 9.66779984202341078813853814677D-03 /
- DATA BETQJ( 112) / 9.11587366366965094979480129643D-03 /
- DATA BETQJ( 113) / 8.54892285989311756700837566727D-03 /
- DATA BETQJ( 114) / 7.98707861815326916431578890919D-03 /
- DATA BETQJ( 115) / 7.40934258857931367234827562389D-03 /
- DATA BETQJ( 116) / 6.83917513755595560486290704049D-03 /
- DATA BETQJ( 117) / 6.25174592528465975464235182898D-03 /
- DATA BETQJ( 118) / 5.67500820317006154854468711772D-03 /
- DATA BETQJ( 119) / 5.07881031921673156694704764211D-03 /
- DATA BETQJ( 120) / 4.49754311560217795885716046663D-03 /
- DATA BETQJ( 121) / 3.89312026107933744698493472524D-03 /
- DATA BETQJ( 122) / 3.30999617943895642410302805178D-03 /
- DATA BETQJ( 123) / 2.69689733321337524158314197871D-03 /
- DATA BETQJ( 124) / 2.11637708445345563059866723008D-03 /
- DATA BETQJ( 125) / 1.49070822312711073978794789435D-03 /
- DATA BETQJ( 126) / 9.24989999117407064617002648219D-04 /
- DATA BETQJ( 127) / 2.62835707201773135684147352078D-04 /
- DATA BETQJ( 128) / 1.22716160204589327903536263085D-02 /
- DATA BETQJ( 129) / 1.22697650344649992341129544348D-02 /
- DATA BETQJ( 130) / 1.22660750451493360705842030748D-02 /
- DATA BETQJ( 131) / 1.22605231968434275809371838537D-02 /
- DATA BETQJ( 132) / 1.22531454515061851332111962847D-02 /
- DATA BETQJ( 133) / 1.22438960692284105390479589010D-02 /
- DATA BETQJ( 134) / 1.22328350331508308002753373489D-02 /
- DATA BETQJ( 135) / 1.22198936618430416468903615998D-02 /
- DATA BETQJ( 136) / 1.22051560296808311793956568499D-02 /
- DATA BETQJ( 137) / 1.21885304274499258166219270833D-02 /
- DATA BETQJ( 138) / 1.21701251193171161048341866302D-02 /
- DATA BETQJ( 139) / 1.21498252526252510306170876419D-02 /
- DATA BETQJ( 140) / 1.21277634088781096744397876227D-02 /
- DATA BETQJ( 141) / 1.21038014463613752946509551373D-02 /
- DATA BETQJ( 142) / 1.20780964210870580423097856925D-02 /
- DATA BETQJ( 143) / 1.20504867260045794489567138555D-02 /
- DATA BETQJ( 144) / 1.20211540792204306587041949555D-02 /
- DATA BETQJ( 145) / 1.19899132005362249303208410566D-02 /
- DATA BETQJ( 146) / 1.19569706891068836573615107866D-02 /
- DATA BETQJ( 147) / 1.19221173512071346427964968591D-02 /
- DATA BETQJ( 148) / 1.18855849184878936299459357025D-02 /
- DATA BETQJ( 149) / 1.18471400095365831797427026343D-02 /
- DATA BETQJ( 150) / 1.18070397737527882994251118717D-02 /
- DATA BETQJ( 151) / 1.17650263326888380406172666903D-02 /
- DATA BETQJ( 152) / 1.17213825740625174859455543098D-02 /
- DATA BETQJ( 153) / 1.16758257762417343128997723127D-02 /
- DATA BETQJ( 154) / 1.16286649228781233394149142187D-02 /
- DATA BETQJ( 155) / 1.15795920643632894291869824858D-02 /
- DATA BETQJ( 156) / 1.15289426769114834400764156691D-02 /
- DATA BETQJ( 157) / 1.14763831574138696728965166265D-02 /
- DATA BETQJ( 158) / 1.14222759125175147071469434333D-02 /
- DATA BETQJ( 159) / 1.13662612169929033627154929451D-02 /
- DATA BETQJ( 160) / 1.13087288895486411649732647516D-02 /
- DATA BETQJ( 161) / 1.12492925684505939393104519204D-02 /
- DATA BETQJ( 162) / 1.11883700126939460459557917421D-02 /
- DATA BETQJ( 163) / 1.11255476608865158158300628266D-02 /
- DATA BETQJ( 164) / 1.10612717903270506256401433749D-02 /
- DATA BETQJ( 165) / 1.09951010246583724678203145860D-02 /
- DATA BETQJ( 166) / 1.09275107908883915316850731383D-02 /
- DATA BETQJ( 167) / 1.08580312264255546002333428334D-02 /
- DATA BETQJ( 168) / 1.07871675968292089764135669342D-02 /
- DATA BETQJ( 169) / 1.07144208217534500131815827113D-02 /
- DATA BETQJ( 170) / 1.06403267561462156253236150852D-02 /
- DATA BETQJ( 171) / 1.05643563053057182578115865165D-02 /
- DATA BETQJ( 172) / 1.04870767315375964446126462946D-02 /
- DATA BETQJ( 173) / 1.04079280586529427721235735542D-02 /
- DATA BETQJ( 174) / 1.03275098472127027764366256901D-02 /
- DATA BETQJ( 175) / 1.02452302957271989922020024697D-02 /
- DATA BETQJ( 176) / 1.01617222333895606997912990885D-02 /
- DATA BETQJ( 177) / 1.00763610059531139372513791342D-02 /
- DATA BETQJ( 178) / 9.98981376851612963583766302792D-03 /
- DATA BETQJ( 179) / 9.90142189508692189893717041747D-03 /
- DATA BETQJ( 180) / 9.81188801925314202368520817062D-03 /
- DATA BETQJ( 181) / 9.72051832379581769229323381848D-03 /
- DATA BETQJ( 182) / 9.62805217825835481112417136729D-03 /
- DATA BETQJ( 183) / 9.53375924401054186896424033979D-03 /
- DATA BETQJ( 184) / 9.43841699981418284786814608800D-03 /
- DATA BETQJ( 185) / 9.34125713308456020085316541582D-03 /
- DATA BETQJ( 186) / 9.24309673334300855186033962799D-03 /
- DATA BETQJ( 187) / 9.14312792579336853187661251515D-03 /
- DATA BETQJ( 188) / 9.04220905485703205057297586554D-03 /
- DATA BETQJ( 189) / 8.93949094420729209477172533856D-03 /
- DATA BETQJ( 190) / 8.83587499639242259732537682991D-03 /
- DATA BETQJ( 191) / 8.73046882547055979542071467777D-03 /
- DATA BETQJ( 192) / 8.62421887348086502710249127013D-03 /
- DATA BETQJ( 193) / 8.51618744751828959000090585810D-03 /
- DATA BETQJ( 194) / 8.40736821071551337873003383829D-03 /
- DATA BETQJ( 195) / 8.29677585276114512084646996510D-03 /
- DATA BETQJ( 196) / 8.18545366547307190371997693030D-03 /
- DATA BETQJ( 197) / 8.07236616976457473405602817956D-03 /
- DATA BETQJ( 198) / 7.95860894985950417160624862287D-03 /
- DATA BETQJ( 199) / 7.84309353294538681560609525723D-03 /
- DATA BETQJ( 200) / 7.72697075095411865849211159092D-03 /
- DATA BETQJ( 201) / 7.60909600030248031803498492001D-03 /
- DATA BETQJ( 202) / 7.49067864943605116585574874141D-03 /
- DATA BETQJ( 203) / 7.37051446919017056875444470277D-03 /
- DATA BETQJ( 204) / 7.24987503668925550645270020586D-03 /
- DATA BETQJ( 205) / 7.12749259013077304330353211236D-03 /
- DATA BETQJ( 206) / 7.00470503049817167237648541483D-03 /
- DATA BETQJ( 207) / 6.88017667864654510378398794562D-03 /
- DATA BETQJ( 208) / 6.75531638946794314032795107256D-03 /
- DATA BETQJ( 209) / 6.62871562506769716963452338998D-03 /
- DATA BETQJ( 210) / 6.50185942633288937523391094228D-03 /
- DATA BETQJ( 211) / 6.37326080223992433502694557539D-03 /
- DATA BETQJ( 212) / 6.24448692035864764189464503922D-03 /
- DATA BETQJ( 213) / 6.11396597100715964841910314492D-03 /
- DATA BETQJ( 214) / 5.98335402910269877272627325066D-03 /
- DATA BETQJ( 215) / 5.85098718327589465830992553693D-03 /
- DATA BETQJ( 216) / 5.71861819988377717209078854689D-03 /
- DATA BETQJ( 217) / 5.58448268236528445205730026958D-03 /
- DATA BETQJ( 218) / 5.45043908143702485942253735998D-03 /
- DATA BETQJ( 219) / 5.31461280019448453449517451871D-03 /
- DATA BETQJ( 220) / 5.17897843642146396423186747433D-03 /
- DATA BETQJ( 221) / 5.04153985062604616153526344757D-03 /
- DATA BETQJ( 222) / 4.90440005573709999815025946587D-03 /
- DATA BETQJ( 223) / 4.76542801792284706172412082706D-03 /
- DATA BETQJ( 224) / 4.62686967606456064638918302381D-03 /
- DATA BETQJ( 225) / 4.48644323870202790947375720059D-03 /
- DATA BETQJ( 226) / 4.34655490277176119595568825569D-03 /
- DATA BETQJ( 227) / 4.20475307483445391253956481387D-03 /
- DATA BETQJ( 228) / 4.06362514153909660475660623090D-03 /
- DATA BETQJ( 229) / 3.92052657317185122280787867864D-03 /
- DATA BETQJ( 230) / 3.77825154410720308723866808020D-03 /
- DATA BETQJ( 231) / 3.63393410527470779791406065293D-03 /
- DATA BETQJ( 232) / 3.49060697716282624656083700490D-03 /
- DATA BETQJ( 233) / 3.34514717545604009508558319206D-03 /
- DATA BETQJ( 234) / 3.20086602998440680536482556581D-03 /
- DATA BETQJ( 235) / 3.05433817637560690281708826928D-03 /
- DATA BETQJ( 236) / 2.90920508910457652111345464436D-03 /
- DATA BETQJ( 237) / 2.76168005361046734913885462838D-03 /
- DATA BETQJ( 238) / 2.61580253370465045242460142188D-03 /
- DATA BETQJ( 239) / 2.46734580367743848413671820381D-03 /
- DATA BETQJ( 240) / 2.32083915999355584685690530747D-03 /
- DATA BETQJ( 241) / 2.17150764800084068063855591316D-03 /
- DATA BETQJ( 242) / 2.02449906858343515122470734070D-03 /
- DATA BETQJ( 243) / 1.87433552802763030180554029245D-03 /
- DATA BETQJ( 244) / 1.72697156624368088050880204633D-03 /
- DATA BETQJ( 245) / 1.57599404156065367142593095984D-03 /
- DATA BETQJ( 246) / 1.42845553056979628512663196291D-03 /
- DATA BETQJ( 247) / 1.27663535041507678716834923192D-03 /
- DATA BETQJ( 248) / 1.12917062624416689881785535696D-03 /
- DATA BETQJ( 249) / 9.76379874000982290248157478018D-04 /
- DATA BETQJ( 250) / 8.29391556842895829911373435502D-04 /
- DATA BETQJ( 251) / 6.75250395854360382935814434997D-04 /
- DATA BETQJ( 252) / 5.29585257987185081794473169061D-04 /
- DATA BETQJ( 253) / 3.72850682372956284262450410198D-04 /
- DATA BETQJ( 254) / 2.31287781672659184602399864521D-04 /
- DATA BETQJ( 255) / 6.57097980439170205292065577044D-05 /
- DATA BETQJ( 256) / 6.13589432043524925308532696322D-03 /
- DATA BETQJ( 257) / 6.13566312461853941837442986040D-03 /
- DATA BETQJ( 258) / 6.13520147315754910583320529320D-03 /
- DATA BETQJ( 259) / 6.13450792044203660550953429444D-03 /
- DATA BETQJ( 260) / 6.13358468720833176074123257758D-03 /
- DATA BETQJ( 261) / 6.13242888179256201976987303709D-03 /
- DATA BETQJ( 262) / 6.13104420615234881221935346822D-03 /
- DATA BETQJ( 263) / 6.12942632168287953626850816296D-03 /
- DATA BETQJ( 264) / 6.12758041265960566045333765771D-03 /
- DATA BETQJ( 265) / 6.12550069220448199738239527763D-03 /
- DATA BETQJ( 266) / 6.12319382844780817383788425434D-03 /
- DATA BETQJ( 267) / 6.12065258445943226745164024011D-03 /
- DATA BETQJ( 268) / 6.11788511420386986865513068774D-03 /
- DATA BETQJ( 269) / 6.11488272847126912508258332966D-03 /
- DATA BETQJ( 270) / 6.11165506948449161225196864292D-03 /
- DATA BETQJ( 271) / 6.10819199307499122320222988104D-03 /
- DATA BETQJ( 272) / 6.10450463259582901092363908280D-03 /
- DATA BETQJ( 273) / 6.10058138578613549401136577155D-03 /
- DATA BETQJ( 274) / 6.09643488045226579721451624882D-03 /
- DATA BETQJ( 275) / 6.09205205264896951967122440808D-03 /
- DATA BETQJ( 276) / 6.08744702841431468295307330448D-03 /
- DATA BETQJ( 277) / 6.08260527806382052942924771751D-03 /
- DATA BETQJ( 278) / 6.07754243010567029360628928988D-03 /
- DATA BETQJ( 279) / 6.07224248459356681943318609791D-03 /
- DATA BETQJ( 280) / 6.06672257720944194603540690679D-03 /
- DATA BETQJ( 281) / 6.06096523274932052218354555962D-03 /
- DATA BETQJ( 282) / 6.05498909924359717503330167263D-03 /
- DATA BETQJ( 283) / 6.04877522075533377791005280305D-03 /
- DATA BETQJ( 284) / 6.04234376331565005370474095216D-03 /
- DATA BETQJ( 285) / 6.03567428429316347959959154403D-03 /
- DATA BETQJ( 286) / 6.02878847385663148840371198738D-03 /
- DATA BETQJ( 287) / 6.02166439622513287641506934022D-03 /
- DATA BETQJ( 288) / 6.01432527233438180016493018451D-03 /
- DATA BETQJ( 289) / 6.00674766629713142628330403332D-03 /
- DATA BETQJ( 290) / 5.99895633694620903096745807849D-03 /
- DATA BETQJ( 291) / 5.99092634082079738694329058565D-03 /
- DATA BETQJ( 292) / 5.98268398229095953436550621224D-03 /
- DATA BETQJ( 293) / 5.97420280233513072517297254492D-03 /
- DATA BETQJ( 294) / 5.96551065902055052564494659613D-03 /
- DATA BETQJ( 295) / 5.95657956924758700568167783230D-03 /
- DATA BETQJ( 296) / 5.94743895347101737635651380543D-03 /
- DATA BETQJ( 297) / 5.93805929545470599368436280247D-03 /
- DATA BETQJ( 298) / 5.92847158727313154149467896103D-03 /
- DATA BETQJ( 299) / 5.91864476994233176786813480849D-03 /
- DATA BETQJ( 300) / 5.90861141694264810440665445148D-03 /
- DATA BETQJ( 301) / 5.89833891636548419271295528434D-03 /
- DATA BETQJ( 302) / 5.88786143345024501441771097868D-03 /
- DATA BETQJ( 303) / 5.87714479260794464031356380098D-03 /
- DATA BETQJ( 304) / 5.86622476177121917485441892510D-03 /
- DATA BETQJ( 305) / 5.85506559032162188132820338647D-03 /
- DATA BETQJ( 306) / 5.84370466041500761436468431693D-03 /
- DATA BETQJ( 307) / 5.83210463444576708179247413299D-03 /
- DATA BETQJ( 308) / 5.82030452093460504192357594932D-03 /
- DATA BETQJ( 309) / 5.80826538270610984660325725354D-03 /
- DATA BETQJ( 310) / 5.79602786741595214545343569400D-03 /
- DATA BETQJ( 311) / 5.78355142509399024079408987843D-03 /
- DATA BETQJ( 312) / 5.77087835594737204538046190928D-03 /
- DATA BETQJ( 313) / 5.75796648332556469555896483568D-03 /
- DATA BETQJ( 314) / 5.74485977406913535753426731964D-03 /
- DATA BETQJ( 315) / 5.73151441028116666657567509364D-03 /
- DATA BETQJ( 316) / 5.71797604020323735444350063429D-03 /
- DATA BETQJ( 317) / 5.70419918942490585673820408979D-03 /
- DATA BETQJ( 318) / 5.69023120306347374020056338150D-03 /
- DATA BETQJ( 319) / 5.67602493420459274309795669933D-03 /
- DATA BETQJ( 320) / 5.66162944104590457161696656306D-03 /
- DATA BETQJ( 321) / 5.64699588743207805776059941786D-03 /
- DATA BETQJ( 322) / 5.63217506159979886737267783839D-03 /
- DATA BETQJ( 323) / 5.61711642064409976376520517217D-03 /
- DATA BETQJ( 324) / 5.60187250057915544733824170716D-03 /
- DATA BETQJ( 325) / 5.58639103344373293860667433335D-03 /
- DATA BETQJ( 326) / 5.57072632157489853634041086043D-03 /
- DATA BETQJ( 327) / 5.55482435282254082901025567077D-03 /
- DATA BETQJ( 328) / 5.53874121522784965054390409817D-03 /
- DATA BETQJ( 329) / 5.52242113246352816971713087999D-03 /
- DATA BETQJ( 330) / 5.50592199852258026060666557601D-03 /
- DATA BETQJ( 331) / 5.48918625202500066520109055592D-03 /
- DATA BETQJ( 332) / 5.47227361406225269419653435781D-03 /
- DATA BETQJ( 333) / 5.45512471640543731512591416480D-03 /
- DATA BETQJ( 334) / 5.43780112932455970179824762323D-03 /
- DATA BETQJ( 335) / 5.42024165498948502058513437556D-03 /
- DATA BETQJ( 336) / 5.40250973589887606457134608469D-03 /
- DATA BETQJ( 337) / 5.38454232087518763723626475981D-03 /
- DATA BETQJ( 338) / 5.36640474870473857205308942903D-03 /
- DATA BETQJ( 339) / 5.34803209008256434171135597904D-03 /
- DATA BETQJ( 340) / 5.32949160519177364159633292887D-03 /
- DATA BETQJ( 341) / 5.31071646074365484736195377397D-03 /
- DATA BETQJ( 342) / 5.29177586452119479162081162279D-03 /
- DATA BETQJ( 343) / 5.27260105227415164250996514518D-03 /
- DATA BETQJ( 344) / 5.25326320672899511826172099324D-03 /
- DATA BETQJ( 345) / 5.23369160452674202675547869605D-03 /
- DATA BETQJ( 346) / 5.21395943187096286126788692592D-03 /
- DATA BETQJ( 347) / 5.19399397692628528613543103336D-03 /
- DATA BETQJ( 348) / 5.17387045914965108173309359416D-03 /
- DATA BETQJ( 349) / 5.15351414758695287336414823413D-03 /
- DATA BETQJ( 350) / 5.13300232602343541342944044013D-03 /
- DATA BETQJ( 351) / 5.11225821241146194204285190246D-03 /
- DATA BETQJ( 352) / 5.09136118729779679347675149150D-03 /
- DATA BETQJ( 353) / 5.07023238417253502027175096588D-03 /
- DATA BETQJ( 354) / 5.04895331419896902953813458505D-03 /
- DATA BETQJ( 355) / 5.02744299157672099579930119768D-03 /
- DATA BETQJ( 356) / 5.00578509343009402283413308522D-03 /
- DATA BETQJ( 357) / 4.98389647831071491749128634950D-03 /
- DATA BETQJ( 358) / 4.96186302621003044268516428491D-03 /
- DATA BETQJ( 359) / 4.93959940207031639174441048898D-03 /
- DATA BETQJ( 360) / 4.91719372729496464328686089652D-03 /
- DATA BETQJ( 361) / 4.89455843357216856211867412258D-03 /
- DATA BETQJ( 362) / 4.87178392398297563194730274741D-03 /
- DATA BETQJ( 363) / 4.84878035554842179979749505709D-03 /
- DATA BETQJ( 364) / 4.82564045510170894582133154114D-03 /
- DATA BETQJ( 365) / 4.80227206172446829452486361301D-03 /
- DATA BETQJ( 366) / 4.77877026997931737794969634818D-03 /
- DATA BETQJ( 367) / 4.75504055577989571243552912290D-03 /
- DATA BETQJ( 368) / 4.73118042739882962092165149570D-03 /
- DATA BETQJ( 369) / 4.70709295029280996953941767068D-03 /
- DATA BETQJ( 370) / 4.68287809453611107677209595620D-03 /
- DATA BETQJ( 371) / 4.65843646566767894702860899472D-03 /
- DATA BETQJ( 372) / 4.63387054588158432533107172163D-03 /
- DATA BETQJ( 373) / 4.60907842904685063492137435534D-03 /
- DATA BETQJ( 374) / 4.58416516214588006244578935964D-03 /
- DATA BETQJ( 375) / 4.55902627320590071983093432114D-03 /
- DATA BETQJ( 376) / 4.53376942914959272863240042801D-03 /
- DATA BETQJ( 377) / 4.50828753543296601460794437184D-03 /
- DATA BETQJ( 378) / 4.48269093669731856455245527690D-03 /
- DATA BETQJ( 379) / 4.45686985639222134338597212818D-03 /
- DATA BETQJ( 380) / 4.43093737743615747188234451414D-03 /
- DATA BETQJ( 381) / 4.40478097897165852317443222055D-03 /
- DATA BETQJ( 382) / 4.37851654569886384968783561016D-03 /
- DATA BETQJ( 383) / 4.35202874711532689691284039393D-03 /
- DATA BETQJ( 384) / 4.32543633633183554440375202308D-03 /
- DATA BETQJ( 385) / 4.29862110464019544274457730542D-03 /
- DATA BETQJ( 386) / 4.27170474350813422783475370720D-03 /
- DATA BETQJ( 387) / 4.24456609403779677486165015926D-03 /
- DATA BETQJ( 388) / 4.21732985952573493986472050144D-03 /
- DATA BETQJ( 389) / 4.18987185526081332101339542189D-03 /
- DATA BETQJ( 390) / 4.16231987359120724529416071039D-03 /
- DATA BETQJ( 391) / 4.13454662449476556153614295934D-03 /
- DATA BETQJ( 392) / 4.10668307058903551017892381108D-03 /
- DATA BETQJ( 393) / 4.07859873291496138637332734254D-03 /
- DATA BETQJ( 394) / 4.05042782983679126492249274297D-03 /
- DATA BETQJ( 395) / 4.02203660542886430092954533582D-03 /
- DATA BETQJ( 396) / 3.99356262382637656388699570722D-03 /
- DATA BETQJ( 397) / 3.96486875940403630645125296383D-03 /
- DATA BETQJ( 398) / 3.93609601695156376368542851963D-03 /
- DATA BETQJ( 399) / 3.90710380338180869765013292859D-03 /
- DATA BETQJ( 400) / 3.87803666422206433151935702113D-03 /
- DATA BETQJ( 401) / 3.84875043577683064168980339117D-03 /
- DATA BETQJ( 402) / 3.81939330996436728939137063975D-03 /
- DATA BETQJ( 403) / 3.78981744356264108684800677481D-03 /
- DATA BETQJ( 404) / 3.76017478650959685455222567394D-03 /
- DATA BETQJ( 405) / 3.73031370094340412538729485080D-03 /
- DATA BETQJ( 406) / 3.70039001286864893827313038633D-03 /
- DATA BETQJ( 407) / 3.67024816801194119680284920721D-03 /
- DATA BETQJ( 408) / 3.64004799339487764092116916059D-03 /
- DATA BETQJ( 409) / 3.60962988939418521380336993953D-03 /
- DATA BETQJ( 410) / 3.57915781643461600754942271600D-03 /
- DATA BETQJ( 411) / 3.54846799288017151844804851783D-03 /
- DATA BETQJ( 412) / 3.51772865296583042207917891569D-03 /
- DATA BETQJ( 413) / 3.48677168804166815598306377905D-03 /
- DATA BETQJ( 414) / 3.45576975522522553306037972296D-03 /
- DATA BETQJ( 415) / 3.42455026483653283017516890527D-03 /
- DATA BETQJ( 416) / 3.39329045532413702859797557422D-03 /
- DATA BETQJ( 417) / 3.36181309219986551071988105294D-03 /
- DATA BETQJ( 418) / 3.33030016385357354064088852568D-03 /
- DATA BETQJ( 419) / 3.29856961662200330065165594608D-03 /
- DATA BETQJ( 420) / 3.26680836847879723878646749459D-03 /
- DATA BETQJ( 421) / 3.23482936071337696970039127162D-03 /
- DATA BETQJ( 422) / 3.20282463252386624188295455688D-03 /
- DATA BETQJ( 423) / 3.17060192175621543232540354246D-03 /
- DATA BETQJ( 424) / 3.13835859354660204680148476865D-03 /
- DATA BETQJ( 425) / 3.10589697024304403494839882007D-03 /
- DATA BETQJ( 426) / 3.07341996190449327495648473866D-03 /
- DATA BETQJ( 427) / 3.04072424840187309978717501115D-03 /
- DATA BETQJ( 428) / 3.00801851931210509770427417756D-03 /
- DATA BETQJ( 429) / 2.97509356870791257967936896776D-03 /
- DATA BETQJ( 430) / 2.94216411739063417121100132412D-03 /
- DATA BETQJ( 431) / 2.90901481238157414320406409222D-03 /
- DATA BETQJ( 432) / 2.87586667621033491657256431814D-03 /
- DATA BETQJ( 433) / 2.84249792787242999173052899003D-03 /
- DATA BETQJ( 434) / 2.80913618282664853545226761692D-03 /
- DATA BETQJ( 435) / 2.77555292932868365221763822302D-03 /
- DATA BETQJ( 436) / 2.74198268981099643711755237185D-03 /
- DATA BETQJ( 437) / 2.70818989505156598989941476332D-03 /
- DATA BETQJ( 438) / 2.67441631377736150062127605463D-03 /
- DATA BETQJ( 439) / 2.64041896593389205303142020234D-03 /
- DATA BETQJ( 440) / 2.60644723390598260572012060636D-03 /
- DATA BETQJ( 441) / 2.57225034388179101054669471246D-03 /
- DATA BETQJ( 442) / 2.53808569046574171964544493300D-03 /
- DATA BETQJ( 443) / 2.50369429021833905047042778640D-03 /
- DATA BETQJ( 444) / 2.46934198333714387536607527607D-03 /
- DATA BETQJ( 445) / 2.43476112406746594892417827583D-03 /
- DATA BETQJ( 446) / 2.40022647053819912054315775020D-03 /
- DATA BETQJ( 447) / 2.36546122071604633717066905284D-03 /
- DATA BETQJ( 448) / 2.33074956675603954645983322894D-03 /
- DATA BETQJ( 449) / 2.29580500995149437820059510239D-03 /
- DATA BETQJ( 450) / 2.26092174188778126827591446107D-03 /
- DATA BETQJ( 451) / 2.22580297437141184942774124090D-03 /
- DATA BETQJ( 452) / 2.19075351959502198873213924547D-03 /
- DATA BETQJ( 453) / 2.15546564766083431970044394057D-03 /
- DATA BETQJ( 454) / 2.12025547587752038227995072416D-03 /
- DATA BETQJ( 455) / 2.08480361283129461924092743195D-03 /
- DATA BETQJ( 456) / 2.04943823767313285801506660404D-03 /
- DATA BETQJ( 457) / 2.01382750041415987004685567570D-03 /
- DATA BETQJ( 458) / 1.97831248149312574166543177124D-03 /
- DATA BETQJ( 459) / 1.94254798659833168214618372645D-03 /
- DATA BETQJ( 460) / 1.90688893210473543562226251916D-03 /
- DATA BETQJ( 461) / 1.87097579129919016669498836376D-03 /
- DATA BETQJ( 462) / 1.83517836127660272079580625493D-03 /
- DATA BETQJ( 463) / 1.79912167614126467132591970248D-03 /
- DATA BETQJ( 464) / 1.76319158660787970169070817043D-03 /
- DATA BETQJ( 465) / 1.72699644233101762327148509177D-03 /
- DATA BETQJ( 466) / 1.69093947046902093917329872949D-03 /
- DATA BETQJ( 467) / 1.65461092838757121288839596718D-03 /
- DATA BETQJ( 468) / 1.61843291909245962141530643224D-03 /
- DATA BETQJ( 469) / 1.58197600768703566614624143305D-03 /
- DATA BETQJ( 470) / 1.54568288186596503244509629882D-03 /
- DATA BETQJ( 471) / 1.50910258575853358313894484482D-03 /
- DATA BETQJ( 472) / 1.47270035090270235524853470173D-03 /
- DATA BETQJ( 473) / 1.43600159724426568912198831711D-03 /
- DATA BETQJ( 474) / 1.39949636099339228671019350218D-03 /
- DATA BETQJ( 475) / 1.36268400239756235055077667042D-03 /
- DATA BETQJ( 476) / 1.32608199009319141168860104925D-03 /
- DATA BETQJ( 477) / 1.28916078293451021949576730720D-03 /
- DATA BETQJ( 478) / 1.25246836056840185777456172285D-03 /
- DATA BETQJ( 479) / 1.21544293696421511412253839165D-03 /
- DATA BETQJ( 480) / 1.17866664154182817803487311823D-03 /
- DATA BETQJ( 481) / 1.14154147257907907828468475739D-03 /
- DATA BETQJ( 482) / 1.10468805285831536455947706100D-03 /
- DATA BETQJ( 483) / 1.06746739945256011053424592795D-03 /
- DATA BETQJ( 484) / 1.03054387149358109619171604922D-03 /
- DATA BETQJ( 485) / 9.93231717400129579564378808932D-04 /
- DATA BETQJ( 486) / 9.56245441742424763033543272989D-04 /
- DATA BETQJ( 487) / 9.18845400181728348267996217355D-04 /
- DATA BETQJ( 488) / 8.81804191425108046227640768662D-04 /
- DATA BETQJ( 489) / 8.44319371609391384723334022394D-04 /
- DATA BETQJ( 490) / 8.07231658002060400653588850445D-04 /
- DATA BETQJ( 491) / 7.69664468753466623216743661831D-04 /
- DATA BETQJ( 492) / 7.32539531645791989827158731916D-04 /
- DATA BETQJ( 493) / 6.94891382588600362345280991863D-04 /
- DATA BETQJ( 494) / 6.57739728683180794925385129672D-04 /
- DATA BETQJ( 495) / 6.20010557183050880239058699174D-04 /
- DATA BETQJ( 496) / 5.82844522455387643200895460808D-04 /
- DATA BETQJ( 497) / 5.45032008039443821701947774286D-04 /
- DATA BETQJ( 498) / 5.07866790082190195247934680745D-04 /
- DATA BETQJ( 499) / 4.69964970872633509884207734607D-04 /
- DATA BETQJ( 500) / 4.32820512959067500763792254954D-04 /
- DATA BETQJ( 501) / 3.94817160828601002815028194294D-04 /
- DATA BETQJ( 502) / 3.57721893101959330645176639449D-04 /
- DATA BETQJ( 503) / 3.19593024660184942122151484779D-04 /
- DATA BETQJ( 504) / 2.82592182483826071044102319589D-04 /
- DATA BETQJ( 505) / 2.44288939510509021781348081807D-04 /
- DATA BETQJ( 506) / 2.07466271306486322231192735046D-04 /
- DATA BETQJ( 507) / 1.68876765097486823160729924876D-04 /
- DATA BETQJ( 508) / 1.32427011541491924912059287646D-04 /
- DATA BETQJ( 509) / 9.32235242601114215273332910150D-05 /
- DATA BETQJ( 510) / 5.78244631788725686474357215168D-05 /
- DATA BETQJ( 511) / 1.64275039639182190749970377266D-05 /
-C
-C ABSCISSAE FOR MID-POINT FORMULAS OF INCREASING ORDER.
-C
- DATA KISQJ( 1) / 7.07106781186547524400844362086D-01 /
- DATA KISQJ( 2) / 3.82683432365089771728459984008D-01 /
- DATA KISQJ( 3) / 9.23879532511286756128183189376D-01 /
- DATA KISQJ( 4) / 1.95090322016128267848284868470D-01 /
- DATA KISQJ( 5) / 5.55570233019602224742830813914D-01 /
- DATA KISQJ( 6) / 8.31469612302545237078788377607D-01 /
- DATA KISQJ( 7) / 9.80785280403230449126182236122D-01 /
- DATA KISQJ( 8) / 9.80171403295606019941955638834D-02 /
- DATA KISQJ( 9) / 2.90284677254462367636192375793D-01 /
- DATA KISQJ( 10) / 4.71396736825997648556387625885D-01 /
- DATA KISQJ( 11) / 6.34393284163645498215171613172D-01 /
- DATA KISQJ( 12) / 7.73010453362736960810906609739D-01 /
- DATA KISQJ( 13) / 8.81921264348355029712756863645D-01 /
- DATA KISQJ( 14) / 9.56940335732208864935797886967D-01 /
- DATA KISQJ( 15) / 9.95184726672196886244836953087D-01 /
- DATA KISQJ( 16) / 4.90676743274180142549549769402D-02 /
- DATA KISQJ( 17) / 1.46730474455361751658850129631D-01 /
- DATA KISQJ( 18) / 2.42980179903263889948274162066D-01 /
- DATA KISQJ( 19) / 3.36889853392220050689253212597D-01 /
- DATA KISQJ( 20) / 4.27555093430282094320966856838D-01 /
- DATA KISQJ( 21) / 5.14102744193221726593693838944D-01 /
- DATA KISQJ( 22) / 5.95699304492433343467036528809D-01 /
- DATA KISQJ( 23) / 6.71558954847018400625376850395D-01 /
- DATA KISQJ( 24) / 7.40951125354959091175616897478D-01 /
- DATA KISQJ( 25) / 8.03207531480644909806676512920D-01 /
- DATA KISQJ( 26) / 8.57728610000272069902269984268D-01 /
- DATA KISQJ( 27) / 9.03989293123443331586200297210D-01 /
- DATA KISQJ( 28) / 9.41544065183020778412509402582D-01 /
- DATA KISQJ( 29) / 9.70031253194543992603984207266D-01 /
- DATA KISQJ( 30) / 9.89176509964780973451673738002D-01 /
- DATA KISQJ( 31) / 9.98795456205172392714771604750D-01 /
- DATA KISQJ( 32) / 2.45412285229122880317345294569D-02 /
- DATA KISQJ( 33) / 7.35645635996674235294656215700D-02 /
- DATA KISQJ( 34) / 1.22410675199216198498704474141D-01 /
- DATA KISQJ( 35) / 1.70961888760301226363642357198D-01 /
- DATA KISQJ( 36) / 2.19101240156869797227737547479D-01 /
- DATA KISQJ( 37) / 2.66712757474898386325286515102D-01 /
- DATA KISQJ( 38) / 3.13681740398891476656478845977D-01 /
- DATA KISQJ( 39) / 3.59895036534988148775104572305D-01 /
- DATA KISQJ( 40) / 4.05241314004989870908481305482D-01 /
- DATA KISQJ( 41) / 4.49611329654606600046294579393D-01 /
- DATA KISQJ( 42) / 4.92898192229784036873026688727D-01 /
- DATA KISQJ( 43) / 5.34997619887097210663076904594D-01 /
- DATA KISQJ( 44) / 5.75808191417845300745972453789D-01 /
- DATA KISQJ( 45) / 6.15231590580626845484913563381D-01 /
- DATA KISQJ( 46) / 6.53172842953776764084203013586D-01 /
- DATA KISQJ( 47) / 6.89540544737066924616730629915D-01 /
- DATA KISQJ( 48) / 7.24247082951466920941069243301D-01 /
- DATA KISQJ( 49) / 7.57208846506484547575464053597D-01 /
- DATA KISQJ( 50) / 7.88346427626606262009164705349D-01 /
- DATA KISQJ( 51) / 8.17584813151583696504920884119D-01 /
- DATA KISQJ( 52) / 8.44853565249707073259571205087D-01 /
- DATA KISQJ( 53) / 8.70086991108711418652292404459D-01 /
- DATA KISQJ( 54) / 8.93224301195515320342416447476D-01 /
- DATA KISQJ( 55) / 9.14209755703530654635014829373D-01 /
- DATA KISQJ( 56) / 9.32992798834738887711660255522D-01 /
- DATA KISQJ( 57) / 9.49528180593036667195936074161D-01 /
- DATA KISQJ( 58) / 9.63776065795439866686464355485D-01 /
- DATA KISQJ( 59) / 9.75702130038528544460395766384D-01 /
- DATA KISQJ( 60) / 9.85277642388941244774018433156D-01 /
- DATA KISQJ( 61) / 9.92479534598709998156767251641D-01 /
- DATA KISQJ( 62) / 9.97290456678690216135597140171D-01 /
- DATA KISQJ( 63) / 9.99698818696204220115765649648D-01 /
- DATA KISQJ( 64) / 1.22715382857199260794082619499D-02 /
- DATA KISQJ( 65) / 3.68072229413588323243326909249D-02 /
- DATA KISQJ( 66) / 6.13207363022085777826145929125D-02 /
- DATA KISQJ( 67) / 8.57973123444398904615563321418D-02 /
- DATA KISQJ( 68) / 1.10222207293883058807899140209D-01 /
- DATA KISQJ( 69) / 1.34580708507126186316358409246D-01 /
- DATA KISQJ( 70) / 1.58858143333861441684385359645D-01 /
- DATA KISQJ( 71) / 1.83039887955140958516532578466D-01 /
- DATA KISQJ( 72) / 2.07111376192218549708116019770D-01 /
- DATA KISQJ( 73) / 2.31058108280671119643236018457D-01 /
- DATA KISQJ( 74) / 2.54865659604514571553980778808D-01 /
- DATA KISQJ( 75) / 2.78519689385053105207848525932D-01 /
- DATA KISQJ( 76) / 3.02005949319228067003463231707D-01 /
- DATA KISQJ( 77) / 3.25310292162262934135954707998D-01 /
- DATA KISQJ( 78) / 3.48418680249434568419308587682D-01 /
- DATA KISQJ( 79) / 3.71317193951837543411934966997D-01 /
- DATA KISQJ( 80) / 3.93992040061048108596188660875D-01 /
- DATA KISQJ( 81) / 4.16429560097637182562598910749D-01 /
- DATA KISQJ( 82) / 4.38616238538527637647025737510D-01 /
- DATA KISQJ( 83) / 4.60538710958240023633181486712D-01 /
- DATA KISQJ( 84) / 4.82183772079122748517344480771D-01 /
- DATA KISQJ( 85) / 5.03538383725717558691867071228D-01 /
- DATA KISQJ( 86) / 5.24589682678468906215098463898D-01 /
- DATA KISQJ( 87) / 5.45324988422046422313987347132D-01 /
- DATA KISQJ( 88) / 5.65731810783613197389765011331D-01 /
- DATA KISQJ( 89) / 5.85797857456438860328080838065D-01 /
- DATA KISQJ( 90) / 6.05511041404325513920626941292D-01 /
- DATA KISQJ( 91) / 6.24859488142386377084072816255D-01 /
- DATA KISQJ( 92) / 6.43831542889791465068086063145D-01 /
- DATA KISQJ( 93) / 6.62415777590171761113069816908D-01 /
- DATA KISQJ( 94) / 6.80600997795453050594430464426D-01 /
- DATA KISQJ( 95) / 6.98376249408972853554813503014D-01 /
- DATA KISQJ( 96) / 7.15730825283818654125532623434D-01 /
- DATA KISQJ( 97) / 7.32654271672412834615546648894D-01 /
- DATA KISQJ( 98) / 7.49136394523459325469203256756D-01 /
- DATA KISQJ( 99) / 7.65167265622458925888815999047D-01 /
- DATA KISQJ( 100) / 7.80737228572094478301588483774D-01 /
- DATA KISQJ( 101) / 7.95836904608883536262791915466D-01 /
- DATA KISQJ( 102) / 8.10457198252594791726703434240D-01 /
- DATA KISQJ( 103) / 8.24589302785025264474803737070D-01 /
- DATA KISQJ( 104) / 8.38224705554838043186996855800D-01 /
- DATA KISQJ( 105) / 8.51355193105265142261290311708D-01 /
- DATA KISQJ( 106) / 8.63972856121586737918147054340D-01 /
- DATA KISQJ( 107) / 8.76070094195406607095844268235D-01 /
- DATA KISQJ( 108) / 8.87639620402853947760181617196D-01 /
- DATA KISQJ( 109) / 8.98674465693953843041976743716D-01 /
- DATA KISQJ( 110) / 9.09167983090522376563884787686D-01 /
- DATA KISQJ( 111) / 9.19113851690057743908477789331D-01 /
- DATA KISQJ( 112) / 9.28506080473215565937167395694D-01 /
- DATA KISQJ( 113) / 9.37339011912574923201899593356D-01 /
- DATA KISQJ( 114) / 9.45607325380521325730945386510D-01 /
- DATA KISQJ( 115) / 9.53306040354193836916740382713D-01 /
- DATA KISQJ( 116) / 9.60430519415565811199035137641D-01 /
- DATA KISQJ( 117) / 9.66976471044852109087220225900D-01 /
- DATA KISQJ( 118) / 9.72939952205560145467720113873D-01 /
- DATA KISQJ( 119) / 9.78317370719627633106240096880D-01 /
- DATA KISQJ( 120) / 9.83105487431216327180301154647D-01 /
- DATA KISQJ( 121) / 9.87301418157858382399815801830D-01 /
- DATA KISQJ( 122) / 9.90902635427780025108237010518D-01 /
- DATA KISQJ( 123) / 9.93906970002356041546922813232D-01 /
- DATA KISQJ( 124) / 9.96312612182778012627226189641D-01 /
- DATA KISQJ( 125) / 9.98118112900149207125155860665D-01 /
- DATA KISQJ( 126) / 9.99322384588349500896221011129D-01 /
- DATA KISQJ( 127) / 9.99924701839144540921646491188D-01 /
- DATA KISQJ( 128) / 6.13588464915447535964023458999D-03 /
- DATA KISQJ( 129) / 1.84067299058048209273663130125D-02 /
- DATA KISQJ( 130) / 3.06748031766366259340210275626D-02 /
- DATA KISQJ( 131) / 4.29382569349408230771245402793D-02 /
- DATA KISQJ( 132) / 5.51952443496899398094475256932D-02 /
- DATA KISQJ( 133) / 6.74439195636640578979724218695D-02 /
- DATA KISQJ( 134) / 7.96824379714301211471206559920D-02 /
- DATA KISQJ( 135) / 9.19089564971327286249909790707D-02 /
- DATA KISQJ( 136) / 1.04121633872054579120943880056D-01 /
- DATA KISQJ( 137) / 1.16318630911904767252544319460D-01 /
- DATA KISQJ( 138) / 1.28498110793793172624415589162D-01 /
- DATA KISQJ( 139) / 1.40658239332849230714788846396D-01 /
- DATA KISQJ( 140) / 1.52797185258443427720336612528D-01 /
- DATA KISQJ( 141) / 1.64913120489969921418189113274D-01 /
- DATA KISQJ( 142) / 1.77004220412148756196839843918D-01 /
- DATA KISQJ( 143) / 1.89068664149806212754997837074D-01 /
- DATA KISQJ( 144) / 2.01104634842091911558443545873D-01 /
- DATA KISQJ( 145) / 2.13110319916091373967757517834D-01 /
- DATA KISQJ( 146) / 2.25083911359792835991642119848D-01 /
- DATA KISQJ( 147) / 2.37023605994367206867735914508D-01 /
- DATA KISQJ( 148) / 2.48927605745720168110682816257D-01 /
- DATA KISQJ( 149) / 2.60794117915275518280186509066D-01 /
- DATA KISQJ( 150) / 2.72621355449948984493347477264D-01 /
- DATA KISQJ( 151) / 2.84407537211271843618310614919D-01 /
- DATA KISQJ( 152) / 2.96150888243623824121786127753D-01 /
- DATA KISQJ( 153) / 3.07849640041534893682063645519D-01 /
- DATA KISQJ( 154) / 3.19502030816015677901518271526D-01 /
- DATA KISQJ( 155) / 3.31106305759876401737190737251D-01 /
- DATA KISQJ( 156) / 3.42660717311994397592781982541D-01 /
- DATA KISQJ( 157) / 3.54163525420490382357395796107D-01 /
- DATA KISQJ( 158) / 3.65612997804773870011745908586D-01 /
- DATA KISQJ( 159) / 3.77007410216418256726567823156D-01 /
- DATA KISQJ( 160) / 3.88345046698826291624993540646D-01 /
- DATA KISQJ( 161) / 3.99624199845646828544117030720D-01 /
- DATA KISQJ( 162) / 4.10843171057903942183466674906D-01 /
- DATA KISQJ( 163) / 4.22000270799799685941287941303D-01 /
- DATA KISQJ( 164) / 4.33093818853151968484222638448D-01 /
- DATA KISQJ( 165) / 4.44122144570429231642069417957D-01 /
- DATA KISQJ( 166) / 4.55083587126343823535869267878D-01 /
- DATA KISQJ( 167) / 4.65976495767966177902756064865D-01 /
- DATA KISQJ( 168) / 4.76799230063322133342158117393D-01 /
- DATA KISQJ( 169) / 4.87550160148435954641485027280D-01 /
- DATA KISQJ( 170) / 4.98227666972781852410983869328D-01 /
- DATA KISQJ( 171) / 5.08830142543107036931749324302D-01 /
- DATA KISQJ( 172) / 5.19355990165589587361829932035D-01 /
- DATA KISQJ( 173) / 5.29803624686294668216054671211D-01 /
- DATA KISQJ( 174) / 5.40171472729892881297845479710D-01 /
- DATA KISQJ( 175) / 5.50457972936604802977289892490D-01 /
- DATA KISQJ( 176) / 5.60661576197336023839710223091D-01 /
- DATA KISQJ( 177) / 5.70780745886967280232652863864D-01 /
- DATA KISQJ( 178) / 5.80813958095764545075595271643D-01 /
- DATA KISQJ( 179) / 5.90759701858874228423887908223D-01 /
- DATA KISQJ( 180) / 6.00616479383868926653875895506D-01 /
- DATA KISQJ( 181) / 6.10382806276309452716352151670D-01 /
- DATA KISQJ( 182) / 6.20057211763289178646268191276D-01 /
- DATA KISQJ( 183) / 6.29638238914927025372981340663D-01 /
- DATA KISQJ( 184) / 6.39124444863775743801488192727D-01 /
- DATA KISQJ( 185) / 6.48514401022112445084560550789D-01 /
- DATA KISQJ( 186) / 6.57806693297078656931182263719D-01 /
- DATA KISQJ( 187) / 6.66999922303637506650154221769D-01 /
- DATA KISQJ( 188) / 6.76092703575315960360419227639D-01 /
- DATA KISQJ( 189) / 6.85083667772700381362052544835D-01 /
- DATA KISQJ( 190) / 6.93971460889654009003734388959D-01 /
- DATA KISQJ( 191) / 7.02754744457225302452914420859D-01 /
- DATA KISQJ( 192) / 7.11432195745216441522130289774D-01 /
- DATA KISQJ( 193) / 7.20002507961381629076682998801D-01 /
- DATA KISQJ( 194) / 7.28464390448225196492035437495D-01 /
- DATA KISQJ( 195) / 7.36816568877369875090132520158D-01 /
- DATA KISQJ( 196) / 7.45057785441465962407907310253D-01 /
- DATA KISQJ( 197) / 7.53186799043612482483430485608D-01 /
- DATA KISQJ( 198) / 7.61202385484261814029709835526D-01 /
- DATA KISQJ( 199) / 7.69103337645579639346626068846D-01 /
- DATA KISQJ( 200) / 7.76888465673232450040827982993D-01 /
- DATA KISQJ( 201) / 7.84556597155575233023892574631D-01 /
- DATA KISQJ( 202) / 7.92106577300212351782342878604D-01 /
- DATA KISQJ( 203) / 7.99537269107905033500246232253D-01 /
- DATA KISQJ( 204) / 8.06847553543799272206514312516D-01 /
- DATA KISQJ( 205) / 8.14036329705948361654516689669D-01 /
- DATA KISQJ( 206) / 8.21102514991104679060430820303D-01 /
- DATA KISQJ( 207) / 8.28045045257755752067527591901D-01 /
- DATA KISQJ( 208) / 8.34862874986380056304401383012D-01 /
- DATA KISQJ( 209) / 8.41554977436898409603499519818D-01 /
- DATA KISQJ( 210) / 8.48120344803297251279133562939D-01 /
- DATA KISQJ( 211) / 8.54557988365400520767862275693D-01 /
- DATA KISQJ( 212) / 8.60866938637767279344583876764D-01 /
- DATA KISQJ( 213) / 8.67046245515692651480195629471D-01 /
- DATA KISQJ( 214) / 8.73094978418290098636085973083D-01 /
- DATA KISQJ( 215) / 8.79012226428633477831323710867D-01 /
- DATA KISQJ( 216) / 8.84797098430937780104007040552D-01 /
- DATA KISQJ( 217) / 8.90448723244757889952150559897D-01 /
- DATA KISQJ( 218) / 8.95966249756185155914560281940D-01 /
- DATA KISQJ( 219) / 9.01348847046022014570746093313D-01 /
- DATA KISQJ( 220) / 9.06595704514915365332960588402D-01 /
- DATA KISQJ( 221) / 9.11706032005429851404397325055D-01 /
- DATA KISQJ( 222) / 9.16679059921042663116457013390D-01 /
- DATA KISQJ( 223) / 9.21514039342041943465396331527D-01 /
- DATA KISQJ( 224) / 9.26210242138311341974793388408D-01 /
- DATA KISQJ( 225) / 9.30766961078983731944872339794D-01 /
- DATA KISQJ( 226) / 9.35183509938947577642207479732D-01 /
- DATA KISQJ( 227) / 9.39459223602189911962669245842D-01 /
- DATA KISQJ( 228) / 9.43593458161960361495301445371D-01 /
- DATA KISQJ( 229) / 9.47585591017741134653387321212D-01 /
- DATA KISQJ( 230) / 9.51435020969008369549175568940D-01 /
- DATA KISQJ( 231) / 9.55141168305770721498157712317D-01 /
- DATA KISQJ( 232) / 9.58703474895871555374645791752D-01 /
- DATA KISQJ( 233) / 9.62121404269041595429604316206D-01 /
- DATA KISQJ( 234) / 9.65394441697689374550843857504D-01 /
- DATA KISQJ( 235) / 9.68522094274417316221088328957D-01 /
- DATA KISQJ( 236) / 9.71503890986251775537099621818D-01 /
- DATA KISQJ( 237) / 9.74339382785575860518721668182D-01 /
- DATA KISQJ( 238) / 9.77028142657754351485866211067D-01 /
- DATA KISQJ( 239) / 9.79569765685440534439326109862D-01 /
- DATA KISQJ( 240) / 9.81963869109555264072848153807D-01 /
- DATA KISQJ( 241) / 9.84210092386929073193874387216D-01 /
- DATA KISQJ( 242) / 9.86308097244598647863297524314D-01 /
- DATA KISQJ( 243) / 9.88257567730749491404792538331D-01 /
- DATA KISQJ( 244) / 9.90058210262297105505906464450D-01 /
- DATA KISQJ( 245) / 9.91709753669099522860049931082D-01 /
- DATA KISQJ( 246) / 9.93211949234794533104601012074D-01 /
- DATA KISQJ( 247) / 9.94564570734255452119106243377D-01 /
- DATA KISQJ( 248) / 9.95767414467659793982495642497D-01 /
- DATA KISQJ( 249) / 9.96820299291165714972629398320D-01 /
- DATA KISQJ( 250) / 9.97723066644191609848546728409D-01 /
- DATA KISQJ( 251) / 9.98475580573294752208559038418D-01 /
- DATA KISQJ( 252) / 9.99077727752645382888781996856D-01 /
- DATA KISQJ( 253) / 9.99529417501093163079703322146D-01 /
- DATA KISQJ( 254) / 9.99830581795823422015722274892D-01 /
- DATA KISQJ( 255) / 9.99981175282601142656990437721D-01 /
- DATA KISQJ( 256) / 3.06795676296597627014536549079D-03 /
- DATA KISQJ( 257) / 9.20375478205981931510237841468D-03 /
- DATA KISQJ( 258) / 1.53392062849881010441518676013D-02 /
- DATA KISQJ( 259) / 2.14740802754695074183748977950D-02 /
- DATA KISQJ( 260) / 2.76081457789657416123548717418D-02 /
- DATA KISQJ( 261) / 3.37411718513775848337161124042D-02 /
- DATA KISQJ( 262) / 3.98729275877398111285787376780D-02 /
- DATA KISQJ( 263) / 4.60031821309146288143017879072D-02 /
- DATA KISQJ( 264) / 5.21317046802833212363582164206D-02 /
- DATA KISQJ( 265) / 5.82582645004357596139797819299D-02 /
- DATA KISQJ( 266) / 6.43826309298574608193245368214D-02 /
- DATA KISQJ( 267) / 7.05045733896138630273514705453D-02 /
- DATA KISQJ( 268) / 7.66238613920314922783324628178D-02 /
- DATA KISQJ( 269) / 8.27402645493756931119870831803D-02 /
- DATA KISQJ( 270) / 8.88535525825245965615865349980D-02 /
- DATA KISQJ( 271) / 9.49634953296389989380343123525D-02 /
- DATA KISQJ( 272) / 1.01069862754827824987887584545D-01 /
- DATA KISQJ( 273) / 1.07172424956808849175529148216D-01 /
- DATA KISQJ( 274) / 1.13270952177564349018228732900D-01 /
- DATA KISQJ( 275) / 1.19365214810991364593637789794D-01 /
- DATA KISQJ( 276) / 1.25454983411546238542336453258D-01 /
- DATA KISQJ( 277) / 1.31540028702883111103387492680D-01 /
- DATA KISQJ( 278) / 1.37620121586486044948441663422D-01 /
- DATA KISQJ( 279) / 1.43695033150294454819773349313D-01 /
- DATA KISQJ( 280) / 1.49764534677321517229695737330D-01 /
- DATA KISQJ( 281) / 1.55828397654265235743101486226D-01 /
- DATA KISQJ( 282) / 1.61886393780111837641387995320D-01 /
- DATA KISQJ( 283) / 1.67938294974731178054745535990D-01 /
- DATA KISQJ( 284) / 1.73983873387463827950700807455D-01 /
- DATA KISQJ( 285) / 1.80022901405699522679906589834D-01 /
- DATA KISQJ( 286) / 1.86055151663446648105438304154D-01 /
- DATA KISQJ( 287) / 1.92080397049892441679288204608D-01 /
- DATA KISQJ( 288) / 1.98098410717953586179324918141D-01 /
- DATA KISQJ( 289) / 2.04108966092816874181696949938D-01 /
- DATA KISQJ( 290) / 2.10111836880469621717489972069D-01 /
- DATA KISQJ( 291) / 2.16106797076219509948385131273D-01 /
- DATA KISQJ( 292) / 2.22093620973203534094094721299D-01 /
- DATA KISQJ( 293) / 2.28072083170885739254457379435D-01 /
- DATA KISQJ( 294) / 2.34041958583543423191242044903D-01 /
- DATA KISQJ( 295) / 2.40003022448741486568922365344D-01 /
- DATA KISQJ( 296) / 2.45955050335794611599924708527D-01 /
- DATA KISQJ( 297) / 2.51897818154216950498106628356D-01 /
- DATA KISQJ( 298) / 2.57831102162159005614471294743D-01 /
- DATA KISQJ( 299) / 2.63754678974831383611349321962D-01 /
- DATA KISQJ( 300) / 2.69668325572915106525464462401D-01 /
- DATA KISQJ( 301) / 2.75571819310958163076425168372D-01 /
- DATA KISQJ( 302) / 2.81464937925757984095231007325D-01 /
- DATA KISQJ( 303) / 2.87347459544729526477331841405D-01 /
- DATA KISQJ( 304) / 2.93219162694258650606608598941D-01 /
- DATA KISQJ( 305) / 2.99079826308040476750336972763D-01 /
- DATA KISQJ( 306) / 3.04929229735402406490728633409D-01 /
- DATA KISQJ( 307) / 3.10767152749611495835997250184D-01 /
- DATA KISQJ( 308) / 3.16593375556165867243047034657D-01 /
- DATA KISQJ( 309) / 3.22407678801069848384807477630D-01 /
- DATA KISQJ( 310) / 3.28209843579092526107916816603D-01 /
- DATA KISQJ( 311) / 3.33999651442009404650865480506D-01 /
- DATA KISQJ( 312) / 3.39776884406826857828825802789D-01 /
- DATA KISQJ( 313) / 3.45541324963989065539191723049D-01 /
- DATA KISQJ( 314) / 3.51292756085567125601307623029D-01 /
- DATA KISQJ( 315) / 3.57030961233430032614954035777D-01 /
- DATA KISQJ( 316) / 3.62755724367397216204854462101D-01 /
- DATA KISQJ( 317) / 3.68466829953372331712746221657D-01 /
- DATA KISQJ( 318) / 3.74164062971457997104393019516D-01 /
- DATA KISQJ( 319) / 3.79847208924051170576281146767D-01 /
- DATA KISQJ( 320) / 3.85516053843918864075607949316D-01 /
- DATA KISQJ( 321) / 3.91170384302253888687512948618D-01 /
- DATA KISQJ( 322) / 3.96809987416710328595290911328D-01 /
- DATA KISQJ( 323) / 4.02434650859418441082533933489D-01 /
- DATA KISQJ( 324) / 4.08044162864978680820747498903D-01 /
- DATA KISQJ( 325) / 4.13638312238434547471944323511D-01 /
- DATA KISQJ( 326) / 4.19216888363223956433010019919D-01 /
- DATA KISQJ( 327) / 4.24779681209108833357226189223D-01 /
- DATA KISQJ( 328) / 4.30326481340082633908199030557D-01 /
- DATA KISQJ( 329) / 4.35857079922255491032544080337D-01 /
- DATA KISQJ( 330) / 4.41371268731716692879988968221D-01 /
- DATA KISQJ( 331) / 4.46868840162374195353044388684D-01 /
- DATA KISQJ( 332) / 4.52349587233770874133026702910D-01 /
- DATA KISQJ( 333) / 4.57813303598877221904961155317D-01 /
- DATA KISQJ( 334) / 4.63259783551860197390719637078D-01 /
- DATA KISQJ( 335) / 4.68688822035827933697617870189D-01 /
- DATA KISQJ( 336) / 4.74100214650550014398580014631D-01 /
- DATA KISQJ( 337) / 4.79493757660153026679839797633D-01 /
- DATA KISQJ( 338) / 4.84869248000791101822951698636D-01 /
- DATA KISQJ( 339) / 4.90226483288291154229598449007D-01 /
- DATA KISQJ( 340) / 4.95565261825772531150266669506D-01 /
- DATA KISQJ( 341) / 5.00885382611240786241285003729D-01 /
- DATA KISQJ( 342) / 5.06186645345155291048942343572D-01 /
- DATA KISQJ( 343) / 5.11468850437970399504391000948D-01 /
- DATA KISQJ( 344) / 5.16731799017649881508753876009D-01 /
- DATA KISQJ( 345) / 5.21975292937154342694258317490D-01 /
- DATA KISQJ( 346) / 5.27199134781901348464274575453D-01 /
- DATA KISQJ( 347) / 5.32403127877197971442805218184D-01 /
- DATA KISQJ( 348) / 5.37587076295645482502214932310D-01 /
- DATA KISQJ( 349) / 5.42750784864515906586768661171D-01 /
- DATA KISQJ( 350) / 5.47894059173100165608820570587D-01 /
- DATA KISQJ( 351) / 5.53016705580027531764226988426D-01 /
- DATA KISQJ( 352) / 5.58118531220556115693702963791D-01 /
- DATA KISQJ( 353) / 5.63199344013834115007363771826D-01 /
- DATA KISQJ( 354) / 5.68258952670131549790548489116D-01 /
- DATA KISQJ( 355) / 5.73297166698042212820171238904D-01 /
- DATA KISQJ( 356) / 5.78313796411655563342245019258D-01 /
- DATA KISQJ( 357) / 5.83308652937698294392830961196D-01 /
- DATA KISQJ( 358) / 5.88281548222645304786439813207D-01 /
- DATA KISQJ( 359) / 5.93232295039799808047809426259D-01 /
- DATA KISQJ( 360) / 5.98160706996342311724958652118D-01 /
- DATA KISQJ( 361) / 6.03066598540348201693430616952D-01 /
- DATA KISQJ( 362) / 6.07949784967773667243642670989D-01 /
- DATA KISQJ( 363) / 6.12810082429409703935211935694D-01 /
- DATA KISQJ( 364) / 6.17647307937803932403979401674D-01 /
- DATA KISQJ( 365) / 6.22461279374149972519166720805D-01 /
- DATA KISQJ( 366) / 6.27251815495144113509622565119D-01 /
- DATA KISQJ( 367) / 6.32018735939809021909403705693D-01 /
- DATA KISQJ( 368) / 6.36761861236284230413943434850D-01 /
- DATA KISQJ( 369) / 6.41481012808583151988739897667D-01 /
- DATA KISQJ( 370) / 6.46176012983316364832802219513D-01 /
- DATA KISQJ( 371) / 6.50846684996380915068975572875D-01 /
- DATA KISQJ( 372) / 6.55492852999615385312679701200D-01 /
- DATA KISQJ( 373) / 6.60114342067420478559490746854D-01 /
- DATA KISQJ( 374) / 6.64710978203344868130324985251D-01 /
- DATA KISQJ( 375) / 6.69282588346636065720696365889D-01 /
- DATA KISQJ( 376) / 6.73829000378756060917568371746D-01 /
- DATA KISQJ( 377) / 6.78350043129861486873655041666D-01 /
- DATA KISQJ( 378) / 6.82845546385248068164596123030D-01 /
- DATA KISQJ( 379) / 6.87315340891759108199186948194D-01 /
- DATA KISQJ( 380) / 6.91759258364157774906734132053D-01 /
- DATA KISQJ( 381) / 6.96177131491462944788582591367D-01 /
- DATA KISQJ( 382) / 7.00568793943248366792866380211D-01 /
- DATA KISQJ( 383) / 7.04934080375904908852523758069D-01 /
- DATA KISQJ( 384) / 7.09272826438865651316533771592D-01 /
- DATA KISQJ( 385) / 7.13584868780793592903125099452D-01 /
- DATA KISQJ( 386) / 7.17870045055731736211325329334D-01 /
- DATA KISQJ( 387) / 7.22128193929215321243607197661D-01 /
- DATA KISQJ( 388) / 7.26359155084345976817494314532D-01 /
- DATA KISQJ( 389) / 7.30562769227827561177758849974D-01 /
- DATA KISQJ( 390) / 7.34738878095963464563223603807D-01 /
- DATA KISQJ( 391) / 7.38887324460615147933116507921D-01 /
- DATA KISQJ( 392) / 7.43007952135121693517362293305D-01 /
- DATA KISQJ( 393) / 7.47100605980180144323078847206D-01 /
- DATA KISQJ( 394) / 7.51165131909686411205819421773D-01 /
- DATA KISQJ( 395) / 7.55201376896536527598710756244D-01 /
- DATA KISQJ( 396) / 7.59209188978388033485525442686D-01 /
- DATA KISQJ( 397) / 7.63188417263381271704838297060D-01 /
- DATA KISQJ( 398) / 7.67138911935820381181694573246D-01 /
- DATA KISQJ( 399) / 7.71060524261813773200605758607D-01 /
- DATA KISQJ( 400) / 7.74953106594873878359129282458D-01 /
- DATA KISQJ( 401) / 7.78816512381475953374724325253D-01 /
- DATA KISQJ( 402) / 7.82650596166575738458949300573D-01 /
- DATA KISQJ( 403) / 7.86455213599085757522319463850D-01 /
- DATA KISQJ( 404) / 7.90230221437310055030217152301D-01 /
- DATA KISQJ( 405) / 7.93975477554337164895083757178D-01 /
- DATA KISQJ( 406) / 7.97690840943391108362662754966D-01 /
- DATA KISQJ( 407) / 8.01376171723140219430247777160D-01 /
- DATA KISQJ( 408) / 8.05031331142963597922659281889D-01 /
- DATA KISQJ( 409) / 8.08656181588174991946968127860D-01 /
- DATA KISQJ( 410) / 8.12250586585203913049744180752D-01 /
- DATA KISQJ( 411) / 8.15814410806733789010772659848D-01 /
- DATA KISQJ( 412) / 8.19347520076796960824689637221D-01 /
- DATA KISQJ( 413) / 8.22849781375826332046780034426D-01 /
- DATA KISQJ( 414) / 8.26321062845663480311195451756D-01 /
- DATA KISQJ( 415) / 8.29761233794523042469023764686D-01 /
- DATA KISQJ( 416) / 8.33170164701913186439915921546D-01 /
- DATA KISQJ( 417) / 8.36547727223511984524285790174D-01 /
- DATA KISQJ( 418) / 8.39893794195999504583383986534D-01 /
- DATA KISQJ( 419) / 8.43208239641845437161743865163D-01 /
- DATA KISQJ( 420) / 8.46490938774052078300544488117D-01 /
- DATA KISQJ( 421) / 8.49741768000852489471268394937D-01 /
- DATA KISQJ( 422) / 8.52960604930363657746588081732D-01 /
- DATA KISQJ( 423) / 8.56147328375194481019630732175D-01 /
- DATA KISQJ( 424) / 8.59301818357008404783582139215D-01 /
- DATA KISQJ( 425) / 8.62423956111040538690933877772D-01 /
- DATA KISQJ( 426) / 8.65513624090569082825488357583D-01 /
- DATA KISQJ( 427) / 8.68570705971340895340449875745D-01 /
- DATA KISQJ( 428) / 8.71595086655951034842481435162D-01 /
- DATA KISQJ( 429) / 8.74586652278176112634431897290D-01 /
- DATA KISQJ( 430) / 8.77545290207261291668470750274D-01 /
- DATA KISQJ( 431) / 8.80470889052160770806542929443D-01 /
- DATA KISQJ( 432) / 8.83363338665731594736308014685D-01 /
- DATA KISQJ( 433) / 8.86222530148880631647990820904D-01 /
- DATA KISQJ( 434) / 8.89048355854664562540777729324D-01 /
- DATA KISQJ( 435) / 8.91840709392342727796478697206D-01 /
- DATA KISQJ( 436) / 8.94599485631382678433072125618D-01 /
- DATA KISQJ( 437) / 8.97324580705418281231391836130D-01 /
- DATA KISQJ( 438) / 9.00015892016160228714535266562D-01 /
- DATA KISQJ( 439) / 9.02673318237258806751502390666D-01 /
- DATA KISQJ( 440) / 9.05296759318118774354048329122D-01 /
- DATA KISQJ( 441) / 9.07886116487666212038681479855D-01 /
- DATA KISQJ( 442) / 9.10441292258067196934095369262D-01 /
- DATA KISQJ( 443) / 9.12962190428398164628018233381D-01 /
- DATA KISQJ( 444) / 9.15448716088267819566431291934D-01 /
- DATA KISQJ( 445) / 9.17900775621390457642276296990D-01 /
- DATA KISQJ( 446) / 9.20318276709110566440076540986D-01 /
- DATA KISQJ( 447) / 9.22701128333878570437264226788D-01 /
- DATA KISQJ( 448) / 9.25049240782677590302371868590D-01 /
- DATA KISQJ( 449) / 9.27362525650401087274536959012D-01 /
- DATA KISQJ( 450) / 9.29640895843181265457918066455D-01 /
- DATA KISQJ( 451) / 9.31884265581668106718557198563D-01 /
- DATA KISQJ( 452) / 9.34092550404258914729877882510D-01 /
- DATA KISQJ( 453) / 9.36265667170278246576310995662D-01 /
- DATA KISQJ( 454) / 9.38403534063108112192420773588D-01 /
- DATA KISQJ( 455) / 9.40506070593268323787291309238D-01 /
- DATA KISQJ( 456) / 9.42573197601446879280758735003D-01 /
- DATA KISQJ( 457) / 9.44604837261480265659265493443D-01 /
- DATA KISQJ( 458) / 9.46600913083283570044599822951D-01 /
- DATA KISQJ( 459) / 9.48561349915730288158494825745D-01 /
- DATA KISQJ( 460) / 9.50486073949481721759926100598D-01 /
- DATA KISQJ( 461) / 9.52375012719765858529893607552D-01 /
- DATA KISQJ( 462) / 9.54228095109105629780430732160D-01 /
- DATA KISQJ( 463) / 9.56045251349996443270479822527D-01 /
- DATA KISQJ( 464) / 9.57826413027532890321037028776D-01 /
- DATA KISQJ( 465) / 9.59571513081984528335528181200D-01 /
- DATA KISQJ( 466) / 9.61280485811320641748659652503D-01 /
- DATA KISQJ( 467) / 9.62953266873683886347921480831D-01 /
- DATA KISQJ( 468) / 9.64589793289812723836432158606D-01 /
- DATA KISQJ( 469) / 9.66190003445412555433832961191D-01 /
- DATA KISQJ( 470) / 9.67753837093475465243391912229D-01 /
- DATA KISQJ( 471) / 9.69281235356548486048290738083D-01 /
- DATA KISQJ( 472) / 9.70772140728950302138169610669D-01 /
- DATA KISQJ( 473) / 9.72226497078936305708321144193D-01 /
- DATA KISQJ( 474) / 9.73644249650811925318383911503D-01 /
- DATA KISQJ( 475) / 9.75025345066994146844913467816D-01 /
- DATA KISQJ( 476) / 9.76369731330021149312732194451D-01 /
- DATA KISQJ( 477) / 9.77677357824509979943404762454D-01 /
- DATA KISQJ( 478) / 9.78948175319062194715480123643D-01 /
- DATA KISQJ( 479) / 9.80182135968117392690210008629D-01 /
- DATA KISQJ( 480) / 9.81379193313754574318224189860D-01 /
- DATA KISQJ( 481) / 9.82539302287441255907040395566D-01 /
- DATA KISQJ( 482) / 9.83662419211730274396237776118D-01 /
- DATA KISQJ( 483) / 9.84748501801904218556553175770D-01 /
- DATA KISQJ( 484) / 9.85797509167567424700994999589D-01 /
- DATA KISQJ( 485) / 9.86809401814185476970235952203D-01 /
- DATA KISQJ( 486) / 9.87784141644572154230969032360D-01 /
- DATA KISQJ( 487) / 9.88721691960323767604516485470D-01 /
- DATA KISQJ( 488) / 9.89622017463200834623694453770D-01 /
- DATA KISQJ( 489) / 9.90485084256457037998682242511D-01 /
- DATA KISQJ( 490) / 9.91310859846115418957349798653D-01 /
- DATA KISQJ( 491) / 9.92099313142191757112085445348D-01 /
- DATA KISQJ( 492) / 9.92850414459865090793563343958D-01 /
- DATA KISQJ( 493) / 9.93564135520595333782021697326D-01 /
- DATA KISQJ( 494) / 9.94240449453187946358413441893D-01 /
- DATA KISQJ( 495) / 9.94879330794805620591166106747D-01 /
- DATA KISQJ( 496) / 9.95480755491926941769171600327D-01 /
- DATA KISQJ( 497) / 9.96044700901251989887944810258D-01 /
- DATA KISQJ( 498) / 9.96571145790554847093566910310D-01 /
- DATA KISQJ( 499) / 9.97060070339482978987989949361D-01 /
- DATA KISQJ( 500) / 9.97511456140303459699448389777D-01 /
- DATA KISQJ( 501) / 9.97925286198596012623025462298D-01 /
- DATA KISQJ( 502) / 9.98301544933892840738782163012D-01 /
- DATA KISQJ( 503) / 9.98640218180265222418199049169D-01 /
- DATA KISQJ( 504) / 9.98941293186856850633930265717D-01 /
- DATA KISQJ( 505) / 9.99204758618363895492950000490D-01 /
- DATA KISQJ( 506) / 9.99430604555461772019008327257D-01 /
- DATA KISQJ( 507) / 9.99618822495178597116830637345D-01 /
- DATA KISQJ( 508) / 9.99769405351215321657617036317D-01 /
- DATA KISQJ( 509) / 9.99882347454212525633049626495D-01 /
- DATA KISQJ( 510) / 9.99957644551963866333120919506D-01 /
- DATA KISQJ( 511) / 9.99995293809576171511580125681D-01 /
-C
-C WEIGHTS FOR END-POINT FORMULAS OF INCREASING ORDER.
-C
- DATA ALFQJ( 1) / 4.00000000000000000000000000000D-01 /
- DATA ALFQJ( 2) / 5.33333333333333333333333333333D-01 /
- DATA ALFQJ( 3) / 6.66666666666666666666666666667D-02 /
- DATA ALFQJ( 4) / 1.96825396825396825396825396817D-01 /
- DATA ALFQJ( 5) / 3.61717858720489781496001680560D-01 /
- DATA ALFQJ( 6) / 2.79365079365079365079365079362D-01 /
- DATA ALFQJ( 7) / 1.46218649216018155011934827383D-01 /
- DATA ALFQJ( 8) / 1.58730158730158730158730158910D-02 /
- DATA ALFQJ( 9) / 9.82050629109452638864403570222D-02 /
- DATA ALFQJ( 10) / 1.92513864612925646869630493245D-01 /
- DATA ALFQJ( 11) / 1.81473784236493356996484900232D-01 /
- DATA ALFQJ( 12) / 1.63172664281703302561919894414D-01 /
- DATA ALFQJ( 13) / 1.38956468368233074115427056601D-01 /
- DATA ALFQJ( 14) / 1.08905552581890930443650341868D-01 /
- DATA ALFQJ( 15) / 7.54823315431518344134123920211D-02 /
- DATA ALFQJ( 16) / 3.73687028372056103208777018531D-02 /
- DATA ALFQJ( 17) / 3.92156862745098039215686276556D-03 /
- DATA ALFQJ( 18) / 4.90892888908841483837317589249D-02 /
- DATA ALFQJ( 19) / 9.76981882080555818199887181721D-02 /
- DATA ALFQJ( 20) / 9.62923259454881791931222171945D-02 /
- DATA ALFQJ( 21) / 9.39432444387687357292598119157D-02 /
- DATA ALFQJ( 22) / 9.07061128677209987369213635670D-02 /
- DATA ALFQJ( 23) / 8.65775384418274354386410715783D-02 /
- DATA ALFQJ( 24) / 8.16348176549385102288108684610D-02 /
- DATA ALFQJ( 25) / 7.58838004413884704797301542765D-02 /
- DATA ALFQJ( 26) / 6.94275756304354508997318921625D-02 /
- DATA ALFQJ( 27) / 6.22721095452940045529609023427D-02 /
- DATA ALFQJ( 28) / 5.45550163039803104377448839810D-02 /
- DATA ALFQJ( 29) / 4.62627628377517494915733878782D-02 /
- DATA ALFQJ( 30) / 3.75943419140472060161856253328D-02 /
- DATA ALFQJ( 31) / 2.84579166772336900936264500857D-02 /
- DATA ALFQJ( 32) / 1.92342451326811491829302760063D-02 /
- DATA ALFQJ( 33) / 9.39319796295501470115987522420D-03 /
- DATA ALFQJ( 34) / 9.77517106549364613880742931933D-04 /
- DATA ALFQJ( 35) / 2.45438117574712279238905445863D-02 /
- DATA ALFQJ( 36) / 4.90280184310255529406044869546D-02 /
- DATA ALFQJ( 37) / 4.88512566430660937099107851548D-02 /
- DATA ALFQJ( 38) / 4.85558448571410527371339699338D-02 /
- DATA ALFQJ( 39) / 4.81444325725122034100248388245D-02 /
- DATA ALFQJ( 40) / 4.76160445852501929604020076484D-02 /
- DATA ALFQJ( 41) / 4.69739590466141487048533746596D-02 /
- DATA ALFQJ( 42) / 4.62176675109255768403023240524D-02 /
- DATA ALFQJ( 43) / 4.53511095516606722103297444394D-02 /
- DATA ALFQJ( 44) / 4.43741792392573157959860411354D-02 /
- DATA ALFQJ( 45) / 4.32915149616908293478506982631D-02 /
- DATA ALFQJ( 46) / 4.21033311114181020282015236939D-02 /
- DATA ALFQJ( 47) / 4.08150134003578338355409028613D-02 /
- DATA ALFQJ( 48) / 3.94269887129560997565087036611D-02 /
- DATA ALFQJ( 49) / 3.79454599212848171139433315200D-02 /
- DATA ALFQJ( 50) / 3.63709202866391830917537015223D-02 /
- DATA ALFQJ( 51) / 3.47104981809251142704743134011D-02 /
- DATA ALFQJ( 52) / 3.29645465699763299723064892228D-02 /
- DATA ALFQJ( 53) / 3.11412971040676244748418795798D-02 /
- DATA ALFQJ( 54) / 2.92406531974683376955186877006D-02 /
- DATA ALFQJ( 55) / 2.72722571414683868638177295712D-02 /
- DATA ALFQJ( 56) / 2.52350649817547659011368211297D-02 /
- DATA ALFQJ( 57) / 2.31406949343581984772920808617D-02 /
- DATA ALFQJ( 58) / 2.09862744297374337812543582559D-02 /
- DATA ALFQJ( 59) / 1.87865297417957835416649964575D-02 /
- DATA ALFQJ( 60) / 1.65349876572895896488648107457D-02 /
- DATA ALFQJ( 61) / 1.42520604323519967855308389094D-02 /
- DATA ALFQJ( 62) / 1.19233947142127716028404685798D-02 /
- DATA ALFQJ( 63) / 9.58233879528379038701130809732D-03 /
- DATA ALFQJ( 64) / 7.19269316173611402494145654177D-03 /
- DATA ALFQJ( 65) / 4.83146544879091264265633245726D-03 /
- DATA ALFQJ( 66) / 2.35149067531170332236624936762D-03 /
- DATA ALFQJ( 67) / 2.44200244200244200244200264708D-04 /
- DATA ALFQJ( 68) / 1.22718537527570913129538189054D-02 /
- DATA ALFQJ( 69) / 2.45362855965149547279520737537D-02 /
- DATA ALFQJ( 70) / 2.45141435888156829230358645493D-02 /
- DATA ALFQJ( 71) / 2.44771754274344428396539225048D-02 /
- DATA ALFQJ( 72) / 2.44255230615670868966806603993D-02 /
- DATA ALFQJ( 73) / 2.43590974892764318436781843955D-02 /
- DATA ALFQJ( 74) / 2.42780594207574592347768855464D-02 /
- DATA ALFQJ( 75) / 2.41823362389314756676436971552D-02 /
- DATA ALFQJ( 76) / 2.40721079232784999965897389967D-02 /
- DATA ALFQJ( 77) / 2.39473175047690150209538888276D-02 /
- DATA ALFQJ( 78) / 2.38081647302425897458759691724D-02 /
- DATA ALFQJ( 79) / 2.36546074605776652264367730839D-02 /
- DATA ALFQJ( 80) / 2.34868657119316350534971270904D-02 /
- DATA ALFQJ( 81) / 2.33049112613114327309412378741D-02 /
- DATA ALFQJ( 82) / 2.31089849162740716752945873491D-02 /
- DATA ALFQJ( 83) / 2.28990713439060588211790789507D-02 /
- DATA ALFQJ( 84) / 2.26754327045667171760111412125D-02 /
- DATA ALFQJ( 85) / 2.24380653972263018398406215722D-02 /
- DATA ALFQJ( 86) / 2.21872535589719508774528660849D-02 /
- DATA ALFQJ( 87) / 2.19230040059875689202547600306D-02 /
- DATA ALFQJ( 88) / 2.16456235671288244043093192266D-02 /
- DATA ALFQJ( 89) / 2.13551279742597072526381730488D-02 /
- DATA ALFQJ( 90) / 2.10518475900201113125603857018D-02 /
- DATA ALFQJ( 91) / 2.07358053349014781567278717695D-02 /
- DATA ALFQJ( 92) / 2.04073561200386786276601579354D-02 /
- DATA ALFQJ( 93) / 2.00665280519835760397635707548D-02 /
- DATA ALFQJ( 94) / 1.97137018370015572460427626662D-02 /
- DATA ALFQJ( 95) / 1.93489084239245184413105322573D-02 /
- DATA ALFQJ( 96) / 1.89725558706794842591168595711D-02 /
- DATA ALFQJ( 97) / 1.85846751956690866138437810563D-02 /
- DATA ALFQJ( 98) / 1.81857037792633948059242195271D-02 /
- DATA ALFQJ( 99) / 1.77756693887527999747702922971D-02 /
- DATA ALFQJ( 100) / 1.73550412541139495796798665621D-02 /
- DATA ALFQJ( 101) / 1.69238398584649936753755450335D-02 /
- DATA ALFQJ( 102) / 1.64825695622037790873424159209D-02 /
- DATA ALFQJ( 103) / 1.60312385874505791578669761314D-02 /
- DATA ALFQJ( 104) / 1.55703907389942596025456958053D-02 /
- DATA ALFQJ( 105) / 1.51000157247926678262272643125D-02 /
- DATA ALFQJ( 106) / 1.46207025463435020528446061842D-02 /
- DATA ALFQJ( 107) / 1.41324143785309413340308104267D-02 /
- DATA ALFQJ( 108) / 1.36357932129377204666109715543D-02 /
- DATA ALFQJ( 109) / 1.31307651669397462984248954107D-02 /
- DATA ALFQJ( 110) / 1.26180359797774327131349322249D-02 /
- DATA ALFQJ( 111) / 1.20974805280716411270563731076D-02 /
- DATA ALFQJ( 112) / 1.15698834829084996745597844435D-02 /
- DATA ALFQJ( 113) / 1.10350487742725418353968914131D-02 /
- DATA ALFQJ( 114) / 1.04938620257689212459046899782D-02 /
- DATA ALFQJ( 115) / 9.94602784923457905407038051576D-03 /
- DATA ALFQJ( 116) / 9.39256583934814870595392739432D-03 /
- DATA ALFQJ( 117) / 8.83303867470133580636144150295D-03 /
- DATA ALFQJ( 118) / 8.26865154203087108287793817451D-03 /
- DATA ALFQJ( 119) / 7.69875778896082810694415095118D-03 /
- DATA ALFQJ( 120) / 7.12483332325489784996115379522D-03 /
- DATA ALFQJ( 121) / 6.54590843862298928430832774978D-03 /
- DATA ALFQJ( 122) / 5.96388034730799521185379257526D-03 /
- DATA ALFQJ( 123) / 5.37724746840184621439120082915D-03 /
- DATA ALFQJ( 124) / 4.78862143341336762639286342422D-03 /
- DATA ALFQJ( 125) / 4.19553798718534675050584434299D-03 /
- DATA ALFQJ( 126) / 3.60197835812614147238175742601D-03 /
- DATA ALFQJ( 127) / 3.00345869904497127939883254566D-03 /
- DATA ALFQJ( 128) / 2.40715327877140914736457978817D-03 /
- DATA ALFQJ( 129) / 1.80308126695362359559014504087D-03 /
- DATA ALFQJ( 130) / 1.20930061875273990882038029438D-03 /
- DATA ALFQJ( 131) / 5.88072153828697544458554905444D-04 /
- DATA ALFQJ( 132) / 6.10388817676860159921870440384D-05 /
- DATA ALFQJ( 133) / 6.13592361718964473177896006113D-03 /
- DATA ALFQJ( 134) / 1.22709213241938073979543720158D-02 /
- DATA ALFQJ( 135) / 1.22681511842708723864423778983D-02 /
- DATA ALFQJ( 136) / 1.22635297783434225372679163611D-02 /
- DATA ALFQJ( 137) / 1.22570652603110471952403084940D-02 /
- DATA ALFQJ( 138) / 1.22487511390273881503023789349D-02 /
- DATA ALFQJ( 139) / 1.22385961402550421427190859338D-02 /
- DATA ALFQJ( 140) / 1.22265943083331658685049588255D-02 /
- DATA ALFQJ( 141) / 1.22127549492255463966510678536D-02 /
- DATA ALFQJ( 142) / 1.21970726326885400700342655700D-02 /
- DATA ALFQJ( 143) / 1.21795572530115017550422997995D-02 /
- DATA ALFQJ( 144) / 1.21602038948220478655306907858D-02 /
- DATA ALFQJ( 145) / 1.21390230486920665351899917172D-02 /
- DATA ALFQJ( 146) / 1.21160103030510821937516247550D-02 /
- DATA ALFQJ( 147) / 1.20911767525914031530482503076D-02 /
- DATA ALFQJ( 148) / 1.20645184779041161244726121146D-02 /
- DATA ALFQJ( 149) / 1.20360471855715499628832919057D-02 /
- DATA ALFQJ( 150) / 1.20057594360851009859586629143D-02 /
- DATA ALFQJ( 151) / 1.19736675556722427453946487134D-02 /
- DATA ALFQJ( 152) / 1.19397685717896904455053135549D-02 /
- DATA ALFQJ( 153) / 1.19040754381081508901165198798D-02 /
- DATA ALFQJ( 154) / 1.18665856353845361657133366787D-02 /
- DATA ALFQJ( 155) / 1.18273127526355869001582265675D-02 /
- DATA ALFQJ( 156) / 1.17862547094624871232439298576D-02 /
- DATA ALFQJ( 157) / 1.17434257383023344525313040507D-02 /
- DATA ALFQJ( 158) / 1.16988241822881030911792615533D-02 /
- DATA ALFQJ( 159) / 1.16524649255958189902413881851D-02 /
- DATA ALFQJ( 160) / 1.16043467186494621221227887759D-02 /
- DATA ALFQJ( 161) / 1.15544851060064148382546873320D-02 /
- DATA ALFQJ( 162) / 1.15028792281338010858224057648D-02 /
- DATA ALFQJ( 163) / 1.14495452990242432850392246866D-02 /
- DATA ALFQJ( 164) / 1.13944828308460763546902940914D-02 /
- DATA ALFQJ( 165) / 1.13377087165893661468694086637D-02 /
- DATA ALFQJ( 166) / 1.12792228205910675129081014208D-02 /
- DATA ALFQJ( 167) / 1.12190427250168182651255540503D-02 /
- DATA ALFQJ( 168) / 1.11571686255411693793727654935D-02 /
- DATA ALFQJ( 169) / 1.10936188044194494585323981848D-02 /
- DATA ALFQJ( 170) / 1.10283937664135255305406472382D-02 /
- DATA ALFQJ( 171) / 1.09615125056530610062278702727D-02 /
- DATA ALFQJ( 172) / 1.08929758121816486809825026852D-02 /
- DATA ALFQJ( 173) / 1.08228034048098231967186206263D-02 /
- DATA ALFQJ( 174) / 1.07509963333481484492664397210D-02 /
- DATA ALFQJ( 175) / 1.06775750552874483669097419339D-02 /
- DATA ALFQJ( 176) / 1.06025408528066438294821505885D-02 /
- DATA ALFQJ( 177) / 1.05259149374630678306767431873D-02 /
- DATA ALFQJ( 178) / 1.04476987943223745986785934531D-02 /
- DATA ALFQJ( 179) / 1.03679144060022209852088979486D-02 /
- DATA ALFQJ( 180) / 1.02865634286624412366025510011D-02 /
- DATA ALFQJ( 181) / 1.02036686348348107376303771807D-02 /
- DATA ALFQJ( 182) / 1.01192318174079947984864905108D-02 /
- DATA ALFQJ( 183) / 1.00332765598313115637363201438D-02 /
- DATA ALFQJ( 184) / 9.94580475448206432544928132694D-03 /
- DATA ALFQJ( 185) / 9.85684081921393574182349342280D-03 /
- DATA ALFQJ( 186) / 9.76638670542804712463794380772D-03 /
- DATA ALFQJ( 187) / 9.67446769173887087921921876937D-03 /
- DATA ALFQJ( 188) / 9.58108574447519332865952019151D-03 /
- DATA ALFQJ( 189) / 9.48626703268709977547668138652D-03 /
- DATA ALFQJ( 190) / 9.39001348942868645317916239211D-03 /
- DATA ALFQJ( 191) / 9.29235220770270494825061254421D-03 /
- DATA ALFQJ( 192) / 9.19328503442315097189013829806D-03 /
- DATA ALFQJ( 193) / 9.09284002451894916631904314641D-03 /
- DATA ALFQJ( 194) / 8.99101888057959938142398330879D-03 /
- DATA ALFQJ( 195) / 8.88785066261381639127308136065D-03 /
- DATA ALFQJ( 196) / 8.78333686460695574756796997355D-03 /
- DATA ALFQJ( 197) / 8.67750760083810363472727229053D-03 /
- DATA ALFQJ( 198) / 8.57036408539034802437993715757D-03 /
- DATA ALFQJ( 199) / 8.46193754306058625432627374975D-03 /
- DATA ALFQJ( 200) / 8.35222882860933065126889117099D-03 /
- DATA ALFQJ( 201) / 8.24127034187625554305909245308D-03 /
- DATA ALFQJ( 202) / 8.12906248943005855139505415508D-03 /
- DATA ALFQJ( 203) / 8.01563892042517457137131201085D-03 /
- DATA ALFQJ( 204) / 7.90099949331615044761003328379D-03 /
- DATA ALFQJ( 205) / 7.78517919237115442475986783301D-03 /
- DATA ALFQJ( 206) / 7.66817721500350575290875185838D-03 /
- DATA ALFQJ( 207) / 7.55002998009127417719696302646D-03 /
- DATA ALFQJ( 208) / 7.43073589568460597392484240923D-03 /
- DATA ALFQJ( 209) / 7.31033293112933667296995296286D-03 /
- DATA ALFQJ( 210) / 7.18881855844773660780138524279D-03 /
- DATA ALFQJ( 211) / 7.06623243296879160913035949868D-03 /
- DATA ALFQJ( 212) / 6.94257092201595646253529204329D-03 /
- DATA ALFQJ( 213) / 6.81787552618365368869408834179D-03 /
- DATA ALFQJ( 214) / 6.69214131282928683691546328128D-03 /
- DATA ALFQJ( 215) / 6.56541181602978219565501987747D-03 /
- DATA ALFQJ( 216) / 6.43768057551113636807835870278D-03 /
- DATA ALFQJ( 217) / 6.30899338254401370090108651102D-03 /
- DATA ALFQJ( 218) / 6.17934198175585931150715224064D-03 /
- DATA ALFQJ( 219) / 6.04877468922575560917461000990D-03 /
- DATA ALFQJ( 220) / 5.91728113766767263962628852517D-03 /
- DATA ALFQJ( 221) / 5.78491249038589018627104260621D-03 /
- DATA ALFQJ( 222) / 5.65165588957047700637748379070D-03 /
- DATA ALFQJ( 223) / 5.51756573726307470480230675798D-03 /
- DATA ALFQJ( 224) / 5.38262622829102142428119021872D-03 /
- DATA ALFQJ( 225) / 5.24689548303089542936215866440D-03 /
- DATA ALFQJ( 226) / 5.11035419189020942875444472285D-03 /
- DATA ALFQJ( 227) / 4.97306478685625395256646989922D-03 /
- DATA ALFQJ( 228) / 4.83500376677199114213311154240D-03 /
- DATA ALFQJ( 229) / 4.69623861722940691292125260899D-03 /
- DATA ALFQJ( 230) / 4.55674078702335155739826696987D-03 /
- DATA ALFQJ( 231) / 4.41658375488667576981565087025D-03 /
- DATA ALFQJ( 232) / 4.27573283170858600391165973824D-03 /
- DATA ALFQJ( 233) / 4.13426869582077584192298953642D-03 /
- DATA ALFQJ( 234) / 3.99214911961078728318078405510D-03 /
- DATA ALFQJ( 235) / 3.84946355518490975879564908081D-03 /
- DATA ALFQJ( 236) / 3.70616040049264393911083019499D-03 /
- DATA ALFQJ( 237) / 3.56233997347505808718477724805D-03 /
- DATA ALFQJ( 238) / 3.41793884114908965385939222216D-03 /
- DATA ALFQJ( 239) / 3.27307102749640179785957297785D-03 /
- DATA ALFQJ( 240) / 3.12765790293549498023677476502D-03 /
- DATA ALFQJ( 241) / 2.98183115090367421874405783280D-03 /
- DATA ALFQJ( 242) / 2.83549220412886478090098047493D-03 /
- DATA ALFQJ( 243) / 2.68879607402742586450810075795D-03 /
- DATA ALFQJ( 244) / 2.54161735307662263948435963469D-03 /
- DATA ALFQJ( 245) / 2.39414280403931246744310752690D-03 /
- DATA ALFQJ( 246) / 2.24620972036610004803571795298D-03 /
- DATA ALFQJ( 247) / 2.09804969482008800046410497020D-03 /
- DATA ALFQJ( 248) / 1.94944607190546714594236012730D-03 /
- DATA ALFQJ( 249) / 1.80069673385486406916650585772D-03 /
- DATA ALFQJ( 250) / 1.65150284956579013457977083575D-03 /
- DATA ALFQJ( 251) / 1.50226641642124470238341899636D-03 /
- DATA ALFQJ( 252) / 1.35255443179264085994664635082D-03 /
- DATA ALFQJ( 253) / 1.20294646714375787656773147856D-03 /
- DATA ALFQJ( 254) / 1.05276786505253903339394461320D-03 /
- DATA ALFQJ( 255) / 9.02939741087453963180228538297D-04 /
- DATA ALFQJ( 256) / 7.52281785192075261928655452238D-04 /
- DATA ALFQJ( 257) / 6.02512672975876653416819120146D-04 /
- DATA ALFQJ( 258) / 4.51077372229244745573669909813D-04 /
- DATA ALFQJ( 259) / 3.02414838661812207289412081700D-04 /
- DATA ALFQJ( 260) / 1.47030506832164582715135039357D-04 /
- DATA ALFQJ( 261) / 1.52590218966964217593652459881D-05 /
- DATA ALFQJ( 262) / 3.06796160487489088469284661263D-03 /
- DATA ALFQJ( 263) / 6.13580758631384774307331535235D-03 /
- DATA ALFQJ( 264) / 6.13546118603008656351109175160D-03 /
- DATA ALFQJ( 265) / 6.13488355623432140401697485161D-03 /
- DATA ALFQJ( 266) / 6.13407518445008555969911360861D-03 /
- DATA ALFQJ( 267) / 6.13303563523077607662172848718D-03 /
- DATA ALFQJ( 268) / 6.13176541373655427382748296527D-03 /
- DATA ALFQJ( 269) / 6.13026410159327009743265081401D-03 /
- DATA ALFQJ( 270) / 6.12853222173252572528695070922D-03 /
- DATA ALFQJ( 271) / 6.12656937270450321474791899551D-03 /
- DATA ALFQJ( 272) / 6.12437609534490669955764440302D-03 /
- DATA ALFQJ( 273) / 6.12195200497696011629276095762D-03 /
- DATA ALFQJ( 274) / 6.11929766047115156133244291922D-03 /
- DATA ALFQJ( 275) / 6.11641269376911652384959689114D-03 /
- DATA ALFQJ( 276) / 6.11329768190500466171465849137D-03 /
- DATA ALFQJ( 277) / 6.10995227328072047289615812278D-03 /
- DATA ALFQJ( 278) / 6.10637706322132553546951122697D-03 /
- DATA ALFQJ( 279) / 6.10257171642716454624050022234D-03 /
- DATA ALFQJ( 280) / 6.09853684664001423463082167142D-03 /
- DATA ALFQJ( 281) / 6.09427213469296797919570018818D-03 /
- DATA ALFQJ( 282) / 6.08977821286905729248343456083D-03 /
- DATA ALFQJ( 283) / 6.08505477796439069953160118073D-03 /
- DATA ALFQJ( 284) / 6.08010248092671795658601319999D-03 /
- DATA ALFQJ( 285) / 6.07492103434120450780053329494D-03 /
- DATA ALFQJ( 286) / 6.06951110794289747059647390314D-03 /
- DATA ALFQJ( 287) / 6.06387242992764974218316787159D-03 /
- DATA ALFQJ( 288) / 6.05800568893969732174259369282D-03 /
- DATA ALFQJ( 289) / 6.05191062860260890626466031780D-03 /
- DATA ALFQJ( 290) / 6.04558795659121550337311040450D-03 /
- DATA ALFQJ( 291) / 6.03903743176903186765558681765D-03 /
- DATA ALFQJ( 292) / 6.03225978096261296966068454543D-03 /
- DATA ALFQJ( 293) / 6.02525477808265035964299385745D-03 /
- DATA ALFQJ( 294) / 6.01802316922848958173910015914D-03 /
- DATA ALFQJ( 295) / 6.01056474316002263662083525930D-03 /
- DATA ALFQJ( 296) / 6.00288026537061196087579243631D-03 /
- DATA ALFQJ( 297) / 5.99496953926595224643345734173D-03 /
- DATA ALFQJ( 298) / 5.98683334985503877424110261084D-03 /
- DATA ALFQJ( 299) / 5.97847151498032798849854214830D-03 /
- DATA ALFQJ( 300) / 5.96988483928869208197273729284D-03 /
- DATA ALFQJ( 301) / 5.96107315484443522518564223977D-03 /
- DATA ALFQJ( 302) / 5.95203728605542647008428402683D-03 /
- DATA ALFQJ( 303) / 5.94277707898679180494245432671D-03 /
- DATA ALFQJ( 304) / 5.93329337793165078186833031267D-03 /
- DATA ALFQJ( 305) / 5.92358604272856493861332634302D-03 /
- DATA ALFQJ( 306) / 5.91365593768156034033738220476D-03 /
- DATA ALFQJ( 307) / 5.90350293616862844481395986754D-03 /
- DATA ALFQJ( 308) / 5.89312792263204062547075098772D-03 /
- DATA ALFQJ( 309) / 5.88253078374832284564439549484D-03 /
- DATA ALFQJ( 310) / 5.87171242422730643213611477464D-03 /
- DATA ALFQJ( 311) / 5.86067274379598384997144359156D-03 /
- DATA ALFQJ( 312) / 5.84941266756334358707582435414D-03 /
- DATA ALFQJ( 313) / 5.83793210805130780752478106801D-03 /
- DATA ALFQJ( 314) / 5.82623201090222334583763617012D-03 /
- DATA ALFQJ( 315) / 5.81431230116962575266173427424D-03 /
- DATA ALFQJ( 316) / 5.80217394516636262253717984601D-03 /
- DATA ALFQJ( 317) / 5.78981688020616068139875812999D-03 /
- DATA ALFQJ( 318) / 5.77724209341280622641737327378D-03 /
- DATA ALFQJ( 319) / 5.76444953408034571871789621875D-03 /
- DATA ALFQJ( 320) / 5.75144021028761028887315727758D-03 /
- DATA ALFQJ( 321) / 5.73821408302028383476974140321D-03 /
- DATA ALFQJ( 322) / 5.72477218146040906249621824371D-03 /
- DATA ALFQJ( 323) / 5.71111447798743275794678646576D-03 /
- DATA ALFQJ( 324) / 5.69724202303925025932482588276D-03 /
- DATA ALFQJ( 325) / 5.68315480008160170942912912587D-03 /
- DATA ALFQJ( 326) / 5.66885388096578706842295320504D-03 /
- DATA ALFQJ( 327) / 5.65433925992634954724511030427D-03 /
- DATA ALFQJ( 328) / 5.63961203039091795272855864304D-03 /
- DATA ALFQJ( 329) / 5.62467219703487685767955892003D-03 /
- DATA ALFQJ( 330) / 5.60952087503096827137537208516D-03 /
- DATA ALFQJ( 331) / 5.59415807915650746753874263392D-03 /
- DATA ALFQJ( 332) / 5.57858494650451070598214448081D-03 /
- DATA ALFQJ( 333) / 5.56280150160385777188041138778D-03 /
- DATA ALFQJ( 334) / 5.54680890364992438729922293993D-03 /
- DATA ALFQJ( 335) / 5.53060718656079517787539650810D-03 /
- DATA ALFQJ( 336) / 5.51419753182379552169078819681D-03 /
- DATA ALFQJ( 337) / 5.49757998237128985601908279695D-03 /
- DATA ALFQJ( 338) / 5.48075574218026520480408468845D-03 /
- DATA ALFQJ( 339) / 5.46372486280926686449036008275D-03 /
- DATA ALFQJ( 340) / 5.44648857093143298203265305733D-03 /
- DATA ALFQJ( 341) / 5.42904692632956857059423358029D-03 /
- DATA ALFQJ( 342) / 5.41140117858892757162397477260D-03 /
- DATA ALFQJ( 343) / 5.39355139530014013445161370846D-03 /
- DATA ALFQJ( 344) / 5.37549884918675900612569660817D-03 /
- DATA ALFQJ( 345) / 5.35724361521555364394237551996D-03 /
- DATA ALFQJ( 346) / 5.33878698948556927092980755218D-03 /
- DATA ALFQJ( 347) / 5.32012905389198929588823042206D-03 /
- DATA ALFQJ( 348) / 5.30127112815840132459130795595D-03 /
- DATA ALFQJ( 349) / 5.28221330064379480609821750045D-03 /
- DATA ALFQJ( 350) / 5.26295691495810917400811142515D-03 /
- DATA ALFQJ( 351) / 5.24350206544174699970381436518D-03 /
- DATA ALFQJ( 352) / 5.22385011986653444810508951601D-03 /
- DATA ALFQJ( 353) / 5.20400117805314228268780650341D-03 /
- DATA ALFQJ( 354) / 5.18395663222557766603362923399D-03 /
- DATA ALFQJ( 355) / 5.16371658716384542515754347690D-03 /
- DATA ALFQJ( 356) / 5.14328245985029512976030686267D-03 /
- DATA ALFQJ( 357) / 5.12265435948242879621504468852D-03 /
- DATA ALFQJ( 358) / 5.10183372812415508597300956158D-03 /
- DATA ALFQJ( 359) / 5.08082067882653687870705932605D-03 /
- DATA ALFQJ( 360) / 5.05961667907658949819845185790D-03 /
- DATA ALFQJ( 361) / 5.03822184519161355915604838077D-03 /
- DATA ALFQJ( 362) / 5.01663767044298044664246621556D-03 /
- DATA ALFQJ( 363) / 4.99486427380213233321852200863D-03 /
- DATA ALFQJ( 364) / 4.97290317470722283030053385958D-03 /
- DATA ALFQJ( 365) / 4.95075449414547218950903400279D-03 /
- DATA ALFQJ( 366) / 4.92841977812700768313750104372D-03 /
- DATA ALFQJ( 367) / 4.90589914898858453395940882935D-03 /
- DATA ALFQJ( 368) / 4.88319417974197303343365801978D-03 /
- DATA ALFQJ( 369) / 4.86030499337759909241562895821D-03 /
- DATA ALFQJ( 370) / 4.83723319036487183261094196748D-03 /
- DATA ALFQJ( 371) / 4.81397889362051928023458068496D-03 /
- DATA ALFQJ( 372) / 4.79054373155590905690648249228D-03 /
- DATA ALFQJ( 373) / 4.76692782625316005351086638880D-03 /
- DATA ALFQJ( 374) / 4.74313283458040264212446424960D-03 /
- DATA ALFQJ( 375) / 4.71915887698848375646883035099D-03 /
- DATA ALFQJ( 376) / 4.69500763934992544840921814105D-03 /
- DATA ALFQJ( 377) / 4.67067923964949195266252667361D-03 /
- DATA ALFQJ( 378) / 4.64617539334708796865637399450D-03 /
- DATA ALFQJ( 379) / 4.62149621508583367302686029617D-03 /
- DATA ALFQJ( 380) / 4.59664345053412399101833255975D-03 /
- DATA ALFQJ( 381) / 4.57161721007429293051636827113D-03 /
- DATA ALFQJ( 382) / 4.54641927024544390327511805340D-03 /
- DATA ALFQJ( 383) / 4.52104973620332073794524090797D-03 /
- DATA ALFQJ( 384) / 4.49551041606432278506821522357D-03 /
- DATA ALFQJ( 385) / 4.46980140874177922146367248534D-03 /
- DATA ALFQJ( 386) / 4.44392455468389287372054117008D-03 /
- DATA ALFQJ( 387) / 4.41787994549206774547442853816D-03 /
- DATA ALFQJ( 388) / 4.39166945475261241135812078939D-03 /
- DATA ALFQJ( 389) / 4.36529316562780325412237494393D-03 /
- DATA ALFQJ( 390) / 4.33875298570438528629303237280D-03 /
- DATA ALFQJ( 391) / 4.31204898851622928796123530273D-03 /
- DATA ALFQJ( 392) / 4.28518311657350827136864252333D-03 /
- DATA ALFQJ( 393) / 4.25815543252553034991949366959D-03 /
- DATA ALFQJ( 394) / 4.23096791479462503776850593905D-03 /
- DATA ALFQJ( 395) / 4.20362061381723046981523736890D-03 /
- DATA ALFQJ( 396) / 4.17611554498786848659355907955D-03 /
- DATA ALFQJ( 397) / 4.14845274512385694855827943419D-03 /
- DATA ALFQJ( 398) / 4.12063426772937529472763056134D-03 /
- DATA ALFQJ( 399) / 4.09266013451205234847197620811D-03 /
- DATA ALFQJ( 400) / 4.06453243830735891911578968727D-03 /
- DATA ALFQJ( 401) / 4.03625118413131983089194896807D-03 /
- DATA ALFQJ( 402) / 4.00781850546392964824573189079D-03 /
- DATA ALFQJ( 403) / 3.97923438894858892161781874551D-03 /
- DATA ALFQJ( 404) / 3.95050101012285263587535639094D-03 /
- DATA ALFQJ( 405) / 3.92161833546879070323103024573D-03 /
- DATA ALFQJ( 406) / 3.89258858410343720546901177087D-03 /
- DATA ALFQJ( 407) / 3.86341170044163328390857719626D-03 /
- DATA ALFQJ( 408) / 3.83408994882075308127264985615D-03 /
- DATA ALFQJ( 409) / 3.80462324955477016687783449226D-03 /
- DATA ALFQJ( 410) / 3.77501391397237159197477823373D-03 /
- DATA ALFQJ( 411) / 3.74526183611355583299320327998D-03 /
- DATA ALFQJ( 412) / 3.71536937621183231598381298815D-03 /
- DATA ALFQJ( 413) / 3.68533639970758443874487819407D-03 /
- DATA ALFQJ( 414) / 3.65516531780903810654694533535D-03 /
- DATA ALFQJ( 415) / 3.62485596486420900818683565010D-03 /
- DATA ALFQJ( 416) / 3.59441080529778396645871627918D-03 /
- DATA ALFQJ( 417) / 3.56382963968923984109341443137D-03 /
- DATA ALFQJ( 418) / 3.53311498811062785618261054808D-03 /
- DATA ALFQJ( 419) / 3.50226661449502204792176369174D-03 /
- DATA ALFQJ( 420) / 3.47128709720131424113678601570D-03 /
- DATA ALFQJ( 421) / 3.44017616041609312595474062661D-03 /
- DATA ALFQJ( 422) / 3.40893644365496404544031622939D-03 /
- DATA ALFQJ( 423) / 3.37756762801262227411222132609D-03 /
- DATA ALFQJ( 424) / 3.34607241728624772061195405804D-03 /
- DATA ALFQJ( 425) / 3.31445044586183366077653388526D-03 /
- DATA ALFQJ( 426) / 3.28270448522576140921893271000D-03 /
- DATA ALFQJ( 427) / 3.25083411913761605194792239628D-03 /
- DATA ALFQJ( 428) / 3.21884219049482974967433543953D-03 /
- DATA ALFQJ( 429) / 3.18672822817852100287605305001D-03 /
- DATA ALFQJ( 430) / 3.15449515056896281148563344049D-03 /
- DATA ALFQJ( 431) / 3.12214242704435112141221763136D-03 /
- DATA ALFQJ( 432) / 3.08967305593019907573678088766D-03 /
- DATA ALFQJ( 433) / 3.05708644206153860547511812368D-03 /
- DATA ALFQJ( 434) / 3.02438566860857141945647523119D-03 /
- DATA ALFQJ( 435) / 2.99157007035751218494121780629D-03 /
- DATA ALFQJ( 436) / 2.95864282071293890113133759830D-03 /
- DATA ALFQJ( 437) / 2.92560317838424755823773793087D-03 /
- DATA ALFQJ( 438) / 2.89245441295143400789404612574D-03 /
- DATA ALFQJ( 439) / 2.85919570043119214231103181178D-03 /
- DATA ALFQJ( 440) / 2.82583041314178321443027364330D-03 /
- DATA ALFQJ( 441) / 2.79235763712774910479759411755D-03 /
- DATA ALFQJ( 442) / 2.75878085471176861742758792117D-03 /
- DATA ALFQJ( 443) / 2.72509905393549776029229047231D-03 /
- DATA ALFQJ( 444) / 2.69131583519011057619472705417D-03 /
- DATA ALFQJ( 445) / 2.65743007963031687711970877254D-03 /
- DATA ALFQJ( 446) / 2.62344551468806641719946966901D-03 /
- DATA ALFQJ( 447) / 2.58936090477456343629057090366D-03 /
- DATA ALFQJ( 448) / 2.55518011437205930067068876771D-03 /
- DATA ALFQJ( 449) / 2.52090178017944080063269295047D-03 /
- DATA ALFQJ( 450) / 2.48652991492767559487236917513D-03 /
- DATA ALFQJ( 451) / 2.45206301535766557699277221793D-03 /
- DATA ALFQJ( 452) / 2.41750525501540032884454066572D-03 /
- DATA ALFQJ( 453) / 2.38285497696650960952592593979D-03 /
- DATA ALFQJ( 454) / 2.34811652971850094122727342093D-03 /
- DATA ALFQJ( 455) / 2.31328808724124964627835708019D-03 /
- DATA ALFQJ( 456) / 2.27837418898352301469347413408D-03 /
- DATA ALFQJ( 457) / 2.24337282241899824357737872228D-03 /
- DATA ALFQJ( 458) / 2.20828873605393276732862125433D-03 /
- DATA ALFQJ( 459) / 2.17311971115280971829271238459D-03 /
- DATA ALFQJ( 460) / 2.13787072589753655863693591415D-03 /
- DATA ALFQJ( 461) / 2.10253933291584629754590016663D-03 /
- DATA ALFQJ( 462) / 2.06713076362843731061325098537D-03 /
- DATA ALFQJ( 463) / 2.03164231639524031649078177118D-03 /
- DATA ALFQJ( 464) / 1.99607950292446569907198930681D-03 /
- DATA ALFQJ( 465) / 1.96043933787508124574471403705D-03 /
- DATA ALFQJ( 466) / 1.92472764444127103429214534777D-03 /
- DATA ALFQJ( 467) / 1.88894111960766616178430089264D-03 /
- DATA ALFQJ( 468) / 1.85308593422460387371656367344D-03 /
- DATA ALFQJ( 469) / 1.81715842817174105493434553438D-03 /
- DATA ALFQJ( 470) / 1.78116516212281629335857909628D-03 /
- DATA ALFQJ( 471) / 1.74510207281587042034463788698D-03 /
- DATA ALFQJ( 472) / 1.70897616020231790243602802219D-03 /
- DATA ALFQJ( 473) / 1.67278290378421487886260034960D-03 /
- DATA ALFQJ( 474) / 1.63652980116976738311763023406D-03 /
- DATA ALFQJ( 475) / 1.60021181062073145704840840179D-03 /
- DATA ALFQJ( 476) / 1.56383699680632668142199037317D-03 /
- DATA ALFQJ( 477) / 1.52739972044591553604959740599D-03 /
- DATA ALFQJ( 478) / 1.49090869642164192106352383243D-03 /
- DATA ALFQJ( 479) / 1.45435759619731409715948179821D-03 /
- DATA ALFQJ( 480) / 1.41775588533880881946593139171D-03 /
- DATA ALFQJ( 481) / 1.38109643482055266819648168061D-03 /
- DATA ALFQJ( 482) / 1.34438958342721647004024269786D-03 /
- DATA ALFQJ( 483) / 1.30762726539050545764975488862D-03 /
- DATA ALFQJ( 484) / 1.27082084370919506808529357021D-03 /
- DATA ALFQJ( 485) / 1.23396114713070611027060496335D-03 /
- DATA ALFQJ( 486) / 1.19706075108121382101740609626D-03 /
- DATA ALFQJ( 487) / 1.16010916727992815727204126002D-03 /
- DATA ALFQJ( 488) / 1.12312042121534276394022258266D-03 /
- DATA ALFQJ( 489) / 1.08608243872210867652744207754D-03 /
- DATA ALFQJ( 490) / 1.04901099975000236730471313273D-03 /
- DATA ALFQJ( 491) / 1.01189209723805581828578204509D-03 /
- DATA ALFQJ( 492) / 9.74743661956659058027496465143D-04 /
- DATA ALFQJ( 493) / 9.37549298132018430656502046587D-04 /
- DATA ALFQJ( 494) / 9.00329613213539530148903204709D-04 /
- DATA ALFQJ( 495) / 8.63065211786161184992669306771D-04 /
- DATA ALFQJ( 496) / 8.25780090897661241458056363561D-04 /
- DATA ALFQJ( 497) / 7.88451017298644958033740128129D-04 /
- DATA ALFQJ( 498) / 7.51106368877294215271806978495D-04 /
- DATA ALFQJ( 499) / 7.13717892529342523724747026799D-04 /
- DATA ALFQJ( 500) / 6.76319767017362791490652947063D-04 /
- DATA ALFQJ( 501) / 6.38876997026417579702757877127D-04 /
- DATA ALFQJ( 502) / 6.01431670945399971736510148555D-04 /
- DATA ALFQJ( 503) / 5.63939439876611882322972033693D-04 /
- DATA ALFQJ( 504) / 5.26453574403052399475469475409D-04 /
- DATA ALFQJ( 505) / 4.88916212936631283471238716007D-04 /
- DATA ALFQJ( 506) / 4.51397175997849943104299990850D-04 /
- DATA ALFQJ( 507) / 4.13818036093362206792200372187D-04 /
- DATA ALFQJ( 508) / 3.76274622903893498806221643824D-04 /
- DATA ALFQJ( 509) / 3.38654947642520485380279353381D-04 /
- DATA ALFQJ( 510) / 3.01099216507638394218726192286D-04 /
- DATA ALFQJ( 511) / 2.63435012498239401965886983857D-04 /
- DATA ALFQJ( 512) / 2.25887913001035078900872058708D-04 /
- DATA ALFQJ( 513) / 1.88159078041982174118016937437D-04 /
- DATA ALFQJ( 514) / 1.50673460920759583550637429215D-04 /
- DATA ALFQJ( 515) / 1.12788538824360132673403086937D-04 /
- DATA ALFQJ( 516) / 7.56093155848410262809258669024D-05 /
- DATA ALFQJ( 517) / 3.67584059902680993475820744901D-05 /
- DATA ALFQJ( 518) / 3.81471181759573972984213017682D-06 /
- DATA ALFQJ( 519) / 1.53398078970462716386827621787D-03 /
- DATA ALFQJ( 520) / 3.06794713372188778074021401754D-03 /
- DATA ALFQJ( 521) / 3.06790382589973685016973309790D-03 /
- DATA ALFQJ( 522) / 3.06783162724590296391001057372D-03 /
- DATA ALFQJ( 523) / 3.06773056754557145480107672249D-03 /
- DATA ALFQJ( 524) / 3.06760061864268677371810084923D-03 /
- DATA ALFQJ( 525) / 3.06744181086983738921096489615D-03 /
- DATA ALFQJ( 526) / 3.06725411660958236893632308177D-03 /
- DATA ALFQJ( 527) / 3.06703756674406052106546813397D-03 /
- DATA ALFQJ( 528) / 3.06679213419219517347375724778D-03 /
- DATA ALFQJ( 529) / 3.06651785038780403145200808779D-03 /
- DATA ALFQJ( 530) / 3.06621468878390171653787597742D-03 /
- DATA ALFQJ( 531) / 3.06588268136809540712388786130D-03 /
- DATA ALFQJ( 532) / 3.06552180212519478161465553952D-03 /
- DATA ALFQJ( 533) / 3.06513208359868975322731935502D-03 /
- DATA ALFQJ( 534) / 3.06471350030286488892217651321D-03 /
- DATA ALFQJ( 535) / 3.06426608533916945424707870294D-03 /
- DATA ALFQJ( 536) / 3.06378981374901814215413495475D-03 /
- DATA ALFQJ( 537) / 3.06328471919388021706837921807D-03 /
- DATA ALFQJ( 538) / 3.06275077723993047649041531446D-03 /
- DATA ALFQJ( 539) / 3.06218802211070353621273393932D-03 /
- DATA ALFQJ( 540) / 3.06159642989473835101121404613D-03 /
- DATA ALFQJ( 541) / 3.06097603537966562746425505984D-03 /
- DATA ALFQJ( 542) / 3.06032681517396593480891575116D-03 /
- DATA ALFQJ( 543) / 3.05964880463138288225977344133D-03 /
- DATA ALFQJ( 544) / 3.05894198087788884224777989479D-03 /
- DATA ALFQJ( 545) / 3.05820637983534390137112638900D-03 /
- DATA ALFQJ( 546) / 3.05744197914473447897526372233D-03 /
- DATA ALFQJ( 547) / 3.05664881529802817256072425077D-03 /
- DATA ALFQJ( 548) / 3.05582686644871906644025423240D-03 /
- DATA ALFQJ( 549) / 3.05497616966086146304183467931D-03 /
- DATA ALFQJ( 550) / 3.05409670359792141882237716501D-03 /
- DATA ALFQJ( 551) / 3.05318850589800800372268611800D-03 /
- DATA ALFQJ( 552) / 3.05225155573199355242266238102D-03 /
- DATA ALFQJ( 553) / 3.05128589131399954835825788810D-03 /
- DATA ALFQJ( 554) / 3.05029149231970821370894116847D-03 /
- DATA ALFQJ( 555) / 3.04926839754120139687526196011D-03 /
- DATA ALFQJ( 556) / 3.04821658715634341834920055071D-03 /
- DATA ALFQJ( 557) / 3.04713610053711547827409996425D-03 /
- DATA ALFQJ( 558) / 3.04602691836090409970249127884D-03 /
- DATA ALFQJ( 559) / 3.04488908058152059464626726416D-03 /
- DATA ALFQJ( 560) / 3.04372256837318097136964870906D-03 /
- DATA ALFQJ( 561) / 3.04252742227344993397654315375D-03 /
- DATA ALFQJ( 562) / 3.04130362395064671453480817831D-03 /
- DATA ALFQJ( 563) / 3.04005121452800596552612174206D-03 /
- DATA ALFQJ( 564) / 3.03877017616518960695324790546D-03 /
- DATA ALFQJ( 565) / 3.03746055057301283771537134581D-03 /
- DATA ALFQJ( 566) / 3.03612232039968471656124214174D-03 /
- DATA ALFQJ( 567) / 3.03475552794550640454293084399D-03 /
- DATA ALFQJ( 568) / 3.03336015634440278879912468889D-03 /
- DATA ALFQJ( 569) / 3.03193624848806201269112927298D-03 /
- DATA ALFQJ( 570) / 3.03048378799325696284941761623D-03 /
- DATA ALFQJ( 571) / 3.02900281834496018757601996416D-03 /
- DATA ALFQJ( 572) / 3.02749332363988745809744179410D-03 /
- DATA ALFQJ( 573) / 3.02595534795819036270342291900D-03 /
- DATA ALFQJ( 574) / 3.02438887587358437822206469625D-03 /
- DATA ALFQJ( 575) / 3.02279395206329280279003929462D-03 /
- DATA ALFQJ( 576) / 3.02117056157504878641892695285D-03 /
- DATA ALFQJ( 577) / 3.01951874968503887720071041716D-03 /
- DATA ALFQJ( 578) / 3.01783850191199221134739272591D-03 /
- DATA ALFQJ( 579) / 3.01612986413294984633901150146D-03 /
- DATA ALFQJ( 580) / 3.01439282233457474947536067882D-03 /
- DATA ALFQJ( 581) / 3.01262742299665432970836826594D-03 /
- DATA ALFQJ( 582) / 3.01083365257068193557272292270D-03 /
- DATA ALFQJ( 583) / 3.00901155814108463043453420948D-03 /
- DATA ALFQJ( 584) / 3.00716112662104055917443984092D-03 /
- DATA ALFQJ( 585) / 3.00528240570151209710733898397D-03 /
- DATA ALFQJ( 586) / 3.00337538275417361089768036464D-03 /
- DATA ALFQJ( 587) / 3.00144010607842170985988587496D-03 /
- DATA ALFQJ( 588) / 2.99947656350119454855403158487D-03 /
- DATA ALFQJ( 589) / 2.99748480393222608365661094648D-03 /
- DATA ALFQJ( 590) / 2.99546481565044107904718026944D-03 /
- DATA ALFQJ( 591) / 2.99341664817781908780759026811D-03 /
- DATA ALFQJ( 592) / 2.99134029024194865808848390058D-03 /
- DATA ALFQJ( 593) / 2.98923579197896928676496745167D-03 /
- DATA ALFQJ( 594) / 2.98710314256176391579725251613D-03 /
- DATA ALFQJ( 595) / 2.98494239274255341328814440721D-03 /
- DATA ALFQJ( 596) / 2.98275353213609822227912745633D-03 /
- DATA ALFQJ( 597) / 2.98053661211263009108720701217D-03 /
- DATA ALFQJ( 598) / 2.97829162272532161329444189530D-03 /
- DATA ALFQJ( 599) / 2.97601861596435403006871781886D-03 /
- DATA ALFQJ( 600) / 2.97371758231779730213865387765D-03 /
- DATA ALFQJ( 601) / 2.97138857439773092331427387270D-03 /
- DATA ALFQJ( 602) / 2.96903158312355700985862887579D-03 /
- DATA ALFQJ( 603) / 2.96664666173121328091987337208D-03 /
- DATA ALFQJ( 604) / 2.96423380156781735192148933008D-03 /
- DATA ALFQJ( 605) / 2.96179305649513744181293481642D-03 /
- DATA ALFQJ( 606) / 2.95932441828433752543671725056D-03 /
- DATA ALFQJ( 607) / 2.95682794142500201064354135728D-03 /
- DATA ALFQJ( 608) / 2.95430361810861854700696706130D-03 /
- DATA ALFQJ( 609) / 2.95175150345458797281691653670D-03 /
- DATA ALFQJ( 610) / 2.94917159007094429724839412161D-03 /
- DATA ALFQJ( 611) / 2.94656393370892074669505110391D-03 /
- DATA ALFQJ( 612) / 2.94392852738926463397700473759D-03 /
- DATA ALFQJ( 613) / 2.94126542749707443794657014999D-03 /
- DATA ALFQJ( 614) / 2.93857462746192084200336132239D-03 /
- DATA ALFQJ( 615) / 2.93585618430481856696513178200D-03 /
- DATA ALFQJ( 616) / 2.93311009186021369341370732710D-03 /
- DATA ALFQJ( 617) / 2.93033640778710754620765979453D-03 /
- DATA ALFQJ( 618) / 2.92753512632081439814098670336D-03 /
- DATA ALFQJ( 619) / 2.92470630576041319022431047146D-03 /
- DATA ALFQJ( 620) / 2.92184994073801873054409831483D-03 /
- DATA ALFQJ( 621) / 2.91896609019490054706203542059D-03 /
- DATA ALFQJ( 622) / 2.91605474915584462361782369759D-03 /
- DATA ALFQJ( 623) / 2.91311597720644734562270625860D-03 /
- DATA ALFQJ( 624) / 2.91014976975997352834897395216D-03 /
- DATA ALFQJ( 625) / 2.90715618704850735944479153623D-03 /
- DATA ALFQJ( 626) / 2.90413522486953584161619587492D-03 /
- DATA ALFQJ( 627) / 2.90108694410381799325430047937D-03 /
- DATA ALFQJ( 628) / 2.89801134092874071190133658173D-03 /
- DATA ALFQJ( 629) / 2.89490847687595240449591134196D-03 /
- DATA ALFQJ( 630) / 2.89177834849835053793906812911D-03 /
- DATA ALFQJ( 631) / 2.88862101798071647790866432237D-03 /
- DATA ALFQJ( 632) / 2.88543648224700048127839767162D-03 /
- DATA ALFQJ( 633) / 2.88222480413739097705210045292D-03 /
- DATA ALFQJ( 634) / 2.87898598094236331956451361466D-03 /
- DATA ALFQJ( 635) / 2.87572007615981920251804953090D-03 /
- DATA ALFQJ( 636) / 2.87242708744215997317192349139D-03 /
- DATA ALFQJ( 637) / 2.86910707894734049238019336959D-03 /
- DATA ALFQJ( 638) / 2.86576004868501604362980484709D-03 /
- DATA ALFQJ( 639) / 2.86238606147556990623783734781D-03 /
- DATA ALFQJ( 640) / 2.85898511568116470807769656194D-03 /
- DATA ALFQJ( 641) / 2.85555727678702444000179582625D-03 /
- DATA ALFQJ( 642) / 2.85210254350299631977388553710D-03 /
- DATA ALFQJ( 643) / 2.84862098198159612434871847060D-03 /
- DATA ALFQJ( 644) / 2.84511259127545507044987369225D-03 /
- DATA ALFQJ( 645) / 2.84157743820687236553533840135D-03 /
- DATA ALFQJ( 646) / 2.83801552216628307606192436929D-03 /
- DATA ALFQJ( 647) / 2.83442691064830389301579345969D-03 /
- DATA ALFQJ( 648) / 2.83081160337611225323466756782D-03 /
- DATA ALFQJ( 649) / 2.82716966851922068404314343808D-03 /
- DATA ALFQJ( 650) / 2.82350110612840435942187242559D-03 /
- DATA ALFQJ( 651) / 2.81980598505069624116026411245D-03 /
- DATA ALFQJ( 652) / 2.81608430565923957552555592021D-03 /
- DATA ALFQJ( 653) / 2.81233613748126060419522921704D-03 /
- DATA ALFQJ( 654) / 2.80856148120695401541637230919D-03 /
- DATA ALFQJ( 655) / 2.80476040704646248407188062594D-03 /
- DATA ALFQJ( 656) / 2.80093291600162655248550210157D-03 /
- DATA ALFQJ( 657) / 2.79707907896828091142732204432D-03 /
- DATA ALFQJ( 658) / 2.79319889725441535903081670482D-03 /
- DATA ALFQJ( 659) / 2.78929244244438679869434027285D-03 /
- DATA ALFQJ( 660) / 2.78535971614674455993771996783D-03 /
- DATA ALFQJ( 661) / 2.78140079063725481995804901210D-03 /
- DATA ALFQJ( 662) / 2.77741566781934140775754584775D-03 /
- DATA ALFQJ( 663) / 2.77340442066312601853215233812D-03 /
- DATA ALFQJ( 664) / 2.76936705136112439191350797546D-03 /
- DATA ALFQJ( 665) / 2.76530363358082155782092822719D-03 /
- DATA ALFQJ( 666) / 2.76121416979794270037573803733D-03 /
- DATA ALFQJ( 667) / 2.75709873438040803663812735209D-03 /
- DATA ALFQJ( 668) / 2.75295733008116745774270217410D-03 /
- DATA ALFQJ( 669) / 2.74879003197171479574326007217D-03 /
- DATA ALFQJ( 670) / 2.74459684307613516924603495071D-03 /
- DATA ALFQJ( 671) / 2.74037783917270364792899710415D-03 /
- DATA ALFQJ( 672) / 2.73613302355044380575936632375D-03 /
- DATA ALFQJ( 673) / 2.73186247269769146955042953436D-03 /
- DATA ALFQJ( 674) / 2.72756619016210197043882624349D-03 /
- DATA ALFQJ( 675) / 2.72324425314542609692751520782D-03 /
- DATA ALFQJ( 676) / 2.71889666544753159315338239289D-03 /
- DATA ALFQJ( 677) / 2.71452350498701597657597542495D-03 /
- DATA ALFQJ( 678) / 2.71012477580942460437678777991D-03 /
- DATA ALFQJ( 679) / 2.70570055655371402372899351382D-03 /
- DATA ALFQJ( 680) / 2.70125085150445404570947564088D-03 /
- DATA ALFQJ( 681) / 2.69677574002455614910210125116D-03 /
- DATA ALFQJ( 682) / 2.69227522663084007967802890958D-03 /
- DATA ALFQJ( 683) / 2.68774939141385491932641719035D-03 /
- DATA ALFQJ( 684) / 2.68319823911577136692166036672D-03 /
- DATA ALFQJ( 685) / 2.67862185055854882193072055060D-03 /
- DATA ALFQJ( 686) / 2.67402023070268228431925784140D-03 /
- DATA ALFQJ( 687) / 2.66939346110540761119050415952D-03 /
- DATA ALFQJ( 688) / 2.66474154693838646303676729250D-03 /
- DATA ALFQJ( 689) / 2.66006457049809421658194970829D-03 /
- DATA ALFQJ( 690) / 2.65536253716006713088279633251D-03 /
- DATA ALFQJ( 691) / 2.65063552996408370098050900108D-03 /
- DATA ALFQJ( 692) / 2.64588355448212474875011330099D-03 /
- DATA ALFQJ( 693) / 2.64110669450143976112725758869D-03 /
- DATA ALFQJ( 694) / 2.63630495578288243629198415133D-03 /
- DATA ALFQJ( 695) / 2.63147842286544926825121498712D-03 /
- DATA ALFQJ( 696) / 2.62662710169114968733482334416D-03 /
- DATA ALFQJ( 697) / 2.62175107755511535208220238145D-03 /
- DATA ALFQJ( 698) / 2.61685035657264488086222808636D-03 /
- DATA ALFQJ( 699) / 2.61192502479950953681633928913D-03 /
- DATA ALFQJ( 700) / 2.60697508851627709871991034514D-03 /
- DATA ALFQJ( 701) / 2.60200063454398344290477120626D-03 /
- DATA ALFQJ( 702) / 2.59700166932028776648613107676D-03 /
- DATA ALFQJ( 703) / 2.59197828043624057382547813598D-03 /
- DATA ALFQJ( 704) / 2.58693047447825263922776921623D-03 /
- DATA ALFQJ( 705) / 2.58185833981226871226784766560D-03 /
- DATA ALFQJ( 706) / 2.57676188316494465911791758452D-03 /
- DATA ALFQJ( 707) / 2.57164119368213345540991581215D-03 /
- DATA ALFQJ( 708) / 2.56649627822205821712668247565D-03 /
- DATA ALFQJ( 709) / 2.56132722671563342419859544725D-03 /
- DATA ALFQJ( 710) / 2.55613404614379535621246694862D-03 /
- DATA ALFQJ( 711) / 2.55091682722781768675363838404D-03 /
- DATA ALFQJ( 712) / 2.54567557706231445863623345538D-03 /
- DATA ALFQJ( 713) / 2.54041038716436594120632731590D-03 /
- DATA ALFQJ( 714) / 2.53512126473304196519586310320D-03 /
- DATA ALFQJ( 715) / 2.52980830208683200845378340616D-03 /
- DATA ALFQJ( 716) / 2.52447150651984767933155024272D-03 /
- DATA ALFQJ( 717) / 2.51911097115775119045912173352D-03 /
- DATA ALFQJ( 718) / 2.51372670338008421418598578639D-03 /
- DATA ALFQJ( 719) / 2.50831879712561205485630900587D-03 /
- DATA ALFQJ( 720) / 2.50288725984949114581468406217D-03 /
- DATA ALFQJ( 721) / 2.49743218630969321172629670679D-03 /
- DATA ALFQJ( 722) / 2.49195358402696444083198931027D-03 /
- DATA ALFQJ( 723) / 2.48645154858476565349764077438D-03 /
- DATA ALFQJ( 724) / 2.48092608755919173184685194268D-03 /
- DATA ALFQJ( 725) / 2.47537729736566123399020065829D-03 /
- DATA ALFQJ( 726) / 2.46980518562515401908918385838D-03 /
- DATA ALFQJ( 727) / 2.46420984959170786766446277836D-03 /
- DATA ALFQJ( 728) / 2.45859129692049438165227838798D-03 /
- DATA ALFQJ( 729) / 2.45294962571103203516138494377D-03 /
- DATA ALFQJ( 730) / 2.44728484364175428677920512461D-03 /
- DATA ALFQJ( 731) / 2.44159704966472918621824032018D-03 /
- DATA ALFQJ( 732) / 2.43588625147047809060105359250D-03 /
- DATA ALFQJ( 733) / 2.43015254887090263602458571695D-03 /
- DATA ALFQJ( 734) / 2.42439594955718632869219213675D-03 /
- DATA ALFQJ( 735) / 2.41861655420857155603902554055D-03 /
- DATA ALFQJ( 736) / 2.41281437050521839974211830113D-03 /
- DATA ALFQJ( 737) / 2.40698950000144866522172874424D-03 /
- DATA ALFQJ( 738) / 2.40114195035444525055479188082D-03 /
- DATA ALFQJ( 739) / 2.39527182400158823254952344373D-03 /
- DATA ALFQJ( 740) / 2.38937912856485267547434801402D-03 /
- DATA ALFQJ( 741) / 2.38346396737290500656968768571D-03 /
- DATA ALFQJ( 742) / 2.37752634799999584820056982176D-03 /
- DATA ALFQJ( 743) / 2.37156637467456469261512360283D-03 /
- DATA ALFQJ( 744) / 2.36558405491032570879824119841D-03 /
- DATA ALFQJ( 745) / 2.35957949384424660314729791497D-03 /
- DATA ALFQJ( 746) / 2.35355269891638783352128140009D-03 /
- DATA ALFQJ( 747) / 2.34750377618127911151401036203D-03 /
- DATA ALFQJ( 748) / 2.34143273299189441986516287566D-03 /
- DATA ALFQJ( 749) / 2.33533967632964854420657318514D-03 /
- DATA ALFQJ( 750) / 2.32922461344667002402930861493D-03 /
- DATA ALFQJ( 751) / 2.32308765226088215147521371058D-03 /
- DATA ALFQJ( 752) / 2.31692879990947169271472862114D-03 /
- DATA ALFQJ( 753) / 2.31074816525680580091231766546D-03 /
- DATA ALFQJ( 754) / 2.30454575531068413590085730172D-03 /
- DATA ALFQJ( 755) / 2.29832167989217704334038747087D-03 /
- DATA ALFQJ( 756) / 2.29207594586489059193916136631D-03 /
- DATA ALFQJ( 757) / 2.28580866401719420504517739773D-03 /
- DATA ALFQJ( 758) / 2.27951984105332004096936408756D-03 /
- DATA ALFQJ( 759) / 2.27320958873988216507427209985D-03 /
- DATA ALFQJ( 760) / 2.26687791360617142730683494143D-03 /
- DATA ALFQJ( 761) / 2.26052492840835548097728915309D-03 /
- DATA ALFQJ( 762) / 2.25415063948481555606657719782D-03 /
- DATA ALFQJ( 763) / 2.24775516059295953099580941675D-03 /
- DATA ALFQJ( 764) / 2.24133849786387533388005800310D-03 /
- DATA ALFQJ( 765) / 2.23490076606829034531897849519D-03 /
- DATA ALFQJ( 766) / 2.22844197111318502812560777051D-03 /
- DATA ALFQJ( 767) / 2.22196222879509380360439392720D-03 /
- DATA ALFQJ( 768) / 2.21546154477962922363100338274D-03 /
- DATA ALFQJ( 769) / 2.20894003590204488052332062798D-03 /
- DATA ALFQJ( 770) / 2.20239770756886216031787030958D-03 /
- DATA ALFQJ( 771) / 2.19583467766740762562439612984D-03 /
- DATA ALFQJ( 772) / 2.18925095132690813974141134331D-03 /
- DATA ALFQJ( 773) / 2.18264664750057656832074275722D-03 /
- DATA ALFQJ( 774) / 2.17602177102164369293540394661D-03 /
- DATA ALFQJ( 775) / 2.16937644192350024329175323136D-03 /
- DATA ALFQJ( 776) / 2.16271066472416220640110349290D-03 /
- DATA ALFQJ( 777) / 2.15602456055198753605272956942D-03 /
- DATA ALFQJ( 778) / 2.14931813359002170747933357744D-03 /
- DATA ALFQJ( 779) / 2.14259150607689755288301692847D-03 /
- DATA ALFQJ( 780) / 2.13584468184037651471731189673D-03 /
- DATA ALFQJ( 781) / 2.12907778424521372371628423936D-03 /
- DATA ALFQJ( 782) / 2.12229081674299346318531132132D-03 /
- DATA ALFQJ( 783) / 2.11548390384100285098517923077D-03 /
- DATA ALFQJ( 784) / 2.10865704859315341901273517139D-03 /
- DATA ALFQJ( 785) / 2.10181037666625982177676275626D-03 /
- DATA ALFQJ( 786) / 2.09494389069443880169821999082D-03 /
- DATA ALFQJ( 787) / 2.08805771752163870499496296398D-03 /
- DATA ALFQJ( 788) / 2.08115185933940783700357522955D-03 /
- DATA ALFQJ( 789) / 2.07422644418707095954186347037D-03 /
- DATA ALFQJ( 790) / 2.06728147379015626746631198943D-03 /
- DATA ALFQJ( 791) / 2.06031707740227148382105628073D-03 /
- DATA ALFQJ( 792) / 2.05333325625876725175976271738D-03 /
- DATA ALFQJ( 793) / 2.04633014084713324113368267267D-03 /
- DATA ALFQJ( 794) / 2.03930773188765018829288338200D-03 /
- DATA ALFQJ( 795) / 2.03226616112201119978131750218D-03 /
- DATA ALFQJ( 796) / 2.02520542872976920257326171416D-03 /
- DATA ALFQJ( 797) / 2.01812566772789633090972258485D-03 /
- DATA ALFQJ( 798) / 2.01102687772876204195609796505D-03 /
- DATA ALFQJ( 799) / 2.00390919304648041132393914802D-03 /
- DATA ALFQJ( 800) / 1.99677261269895012546840879263D-03 /
- DATA ALFQJ( 801) / 1.98961727232011238267848631359D-03 /
- DATA ALFQJ( 802) / 1.98244317030524050043081835001D-03 /
- DATA ALFQJ( 803) / 1.97525044363164702259690758064D-03 /
- DATA ALFQJ( 804) / 1.96803909004292046159838401670D-03 /
- DATA ALFQJ( 805) / 1.96080924788418668740293802204D-03 /
- DATA ALFQJ( 806) / 1.95356091421734559250624506025D-03 /
- DATA ALFQJ( 807) / 1.94629422878071689025158738205D-03 /
- DATA ALFQJ( 808) / 1.93900918792352199263470898737D-03 /
- DATA ALFQJ( 809) / 1.93170593280363648253294937752D-03 /
- DATA ALFQJ( 810) / 1.92438445902558345790086416186D-03 /
- DATA ALFQJ( 811) / 1.91704490919418321048512880146D-03 /
- DATA ALFQJ( 812) / 1.90968727813616438583901548164D-03 /
- DATA ALFQJ( 813) / 1.90231170993175542299598019565D-03 /
- DATA ALFQJ( 814) / 1.89491819859566918064918600848D-03 /
- DATA ALFQJ( 815) / 1.88750688971313071059712036778D-03 /
- DATA ALFQJ( 816) / 1.88007777645143893707052089073D-03 /
- DATA ALFQJ( 817) / 1.87263100593158225965875922426D-03 /
- DATA ALFQJ( 818) / 1.86516657043681618577347460834D-03 /
- DATA ALFQJ( 819) / 1.85768461865589370978125074253D-03 /
- DATA ALFQJ( 820) / 1.85018514195010848665984358587D-03 /
- DATA ALFQJ( 821) / 1.84266829060927330634998820622D-03 /
- DATA ALFQJ( 822) / 1.83513405503345166011157486064D-03 /
- DATA ALFQJ( 823) / 1.82758258714816814417558909989D-03 /
- DATA ALFQJ( 824) / 1.82001387635157344983623825454D-03 /
- DATA ALFQJ( 825) / 1.81242807624097930208263174327D-03 /
- DATA ALFQJ( 826) / 1.80482517517045841451732472902D-03 /
- DATA ALFQJ( 827) / 1.79720532844667867223909731285D-03 /
- DATA ALFQJ( 828) / 1.78956852333591484898916546800D-03 /
- DATA ALFQJ( 829) / 1.78191491689332829193692345572D-03 /
- DATA ALFQJ( 830) / 1.77424449525204453911707556963D-03 /
- DATA ALFQJ( 831) / 1.76655741725650298944370877135D-03 /
- DATA ALFQJ( 832) / 1.75885366785961615797088792862D-03 /
- DATA ALFQJ( 833) / 1.75113340773761715944890462358D-03 /
- DATA ALFQJ( 834) / 1.74339662061434311423165306356D-03 /
- DATA ALFQJ( 835) / 1.73564346904215648752737484960D-03 /
- DATA ALFQJ( 836) / 1.72787393546506666706391920015D-03 /
- DATA ALFQJ( 837) / 1.72008818435781544694191698997D-03 /
- DATA ALFQJ( 838) / 1.71228619683184512491629451310D-03 /
- DATA ALFQJ( 839) / 1.70446813933254139500752808120D-03 /
- DATA ALFQJ( 840) / 1.69663399158394994887714225985D-03 /
- DATA ALFQJ( 841) / 1.68878392205248610014760934778D-03 /
- DATA ALFQJ( 842) / 1.68091790901776958430601664896D-03 /
- DATA ALFQJ( 843) / 1.67303612301986553469018173188D-03 /
- DATA ALFQJ( 844) / 1.66513854083462184748002943294D-03 /
- DATA ALFQJ( 845) / 1.65722533513072877238534139842D-03 /
- DATA ALFQJ( 846) / 1.64929648111847569693235577591D-03 /
- DATA ALFQJ( 847) / 1.64135215365263683357908386992D-03 /
- DATA ALFQJ( 848) / 1.63339232631358322201146236147D-03 /
- DATA ALFQJ( 849) / 1.62541717620225232495947258582D-03 /
- DATA ALFQJ( 850) / 1.61742667520202268394749829084D-03 /
- DATA ALFQJ( 851) / 1.60942100272284072480597801921D-03 /
- DATA ALFQJ( 852) / 1.60140012888115344736884951710D-03 /
- DATA ALFQJ( 853) / 1.59336423546168416872969744508D-03 /
- DATA ALFQJ( 854) / 1.58531329074098364275829768951D-03 /
- DATA ALFQJ( 855) / 1.57724747894740859500023306483D-03 /
- DATA ALFQJ( 856) / 1.56916676644145140276452360004D-03 /
- DATA ALFQJ( 857) / 1.56107133996722511272469503757D-03 /
- DATA ALFQJ( 858) / 1.55296116388962051757945405311D-03 /
- DATA ALFQJ( 859) / 1.54483642754408646038752668851D-03 /
- DATA ALFQJ( 860) / 1.53669709321679135674217874531D-03 /
- DATA ALFQJ( 861) / 1.52854335291375942659025350954D-03 /
- DATA ALFQJ( 862) / 1.52037516675552790672103400763D-03 /
- DATA ALFQJ( 863) / 1.51219272950181410926344428404D-03 /
- DATA ALFQJ( 864) / 1.50399599901660177544001225064D-03 /
- DATA ALFQJ( 865) / 1.49578517290053089417703897347D-03 /
- DATA ALFQJ( 866) / 1.48756020666585401653449779784D-03 /
- DATA ALFQJ( 867) / 1.47932130084572603827029414944D-03 /
- DATA ALFQJ( 868) / 1.47106840850097562752218365655D-03 /
- DATA ALFQJ( 869) / 1.46280173319349674818255412595D-03 /
- DATA ALFQJ( 870) / 1.45452122542820757723230161026D-03 /
- DATA ALFQJ( 871) / 1.44622709189688664941809056557D-03 /
- DATA ALFQJ( 872) / 1.43791928043896121872054529247D-03 /
- DATA ALFQJ( 873) / 1.42959800098247254685375904968D-03 /
- DATA ALFQJ( 874) / 1.42126319858635994447431715036D-03 /
- DATA ALFQJ( 875) / 1.41291508652687338283346983918D-03 /
- DATA ALFQJ( 876) / 1.40455360696170294094394770375D-03 /
- DATA ALFQJ( 877) / 1.39617897663318230493044030057D-03 /
- DATA ALFQJ( 878) / 1.38779113467085189927490735781D-03 /
- DATA ALFQJ( 879) / 1.37939030140732276164555525532D-03 /
- DATA ALFQJ( 880) / 1.37097641281054153851110148683D-03 /
- DATA ALFQJ( 881) / 1.36254969293432955090443068454D-03 /
- DATA ALFQJ( 882) / 1.35411007444461479642893653000D-03 /
- DATA ALFQJ( 883) / 1.34565778525455575328272111077D-03 /
- DATA ALFQJ( 884) / 1.33719275458018354147476405310D-03 /
- DATA ALFQJ( 885) / 1.32871521433980648950549669528D-03 /
- DATA ALFQJ( 886) / 1.32022509014371565693150363075D-03 /
- DATA ALFQJ( 887) / 1.31172261806940045002168827374D-03 /
- DATA ALFQJ( 888) / 1.30320771995704934533665564769D-03 /
- DATA ALFQJ( 889) / 1.29468063620616015345345708030D-03 /
- DATA ALFQJ( 890) / 1.28614128471333549719987158820D-03 /
- DATA ALFQJ( 891) / 1.27758991037233190058579663703D-03 /
- DATA ALFQJ( 892) / 1.26902642695290896309034169933D-03 /
- DATA ALFQJ( 893) / 1.26045108402543640143816313526D-03 /
- DATA ALFQJ( 894) / 1.25186379103908956202556533093D-03 /
- DATA ALFQJ( 895) / 1.24326480243405106501758986141D-03 /
- DATA ALFQJ( 896) / 1.23465402313391365160859255421D-03 /
- DATA ALFQJ( 897) / 1.22603171265352495479240759320D-03 /
- DATA ALFQJ( 898) / 1.21739777117379707631197272663D-03 /
- DATA ALFQJ( 899) / 1.20875246350162742798499845493D-03 /
- DATA ALFQJ( 900) / 1.20009568484513029943450685333D-03 /
- DATA ALFQJ( 901) / 1.19142770553413149374279413783D-03 /
- DATA ALFQJ( 902) / 1.18274841555980651125406643911D-03 /
- DATA ALFQJ( 903) / 1.17405809102033294444408080091D-03 /
- DATA ALFQJ( 904) / 1.16535661643068349040030017034D-03 /
- DATA ALFQJ( 905) / 1.15664427391850633622850330287D-03 /
- DATA ALFQJ( 906) / 1.14792094224697997703832778335D-03 /
- DATA ALFQJ( 907) / 1.13918690985129891978878995724D-03 /
- DATA ALFQJ( 908) / 1.13044204944960729456601161256D-03 /
- DATA ALFQJ( 909) / 1.12168665608106365109210309615D-03 /
- DATA ALFQJ( 910) / 1.11292059610643693055617616468D-03 /
- DATA ALFQJ( 911) / 1.10414417148513244470381907449D-03 /
- DATA ALFQJ( 912) / 1.09535724188750475686687988034D-03 /
- DATA ALFQJ( 913) / 1.08656011653103087059161881631D-03 /
- DATA ALFQJ( 914) / 1.07775264804015253228724783674D-03 /
- DATA ALFQJ( 915) / 1.06893515325163553969443192666D-03 /
- DATA ALFQJ( 916) / 1.06010747736410728768167588345D-03 /
- DATA ALFQJ( 917) / 1.05126994522027547536238603105D-03 /
- DATA ALFQJ( 918) / 1.04242239418649914200373092725D-03 /
- DATA ALFQJ( 919) / 1.03356515752577882848601439349D-03 /
- DATA ALFQJ( 920) / 1.02469806433681803614348472019D-03 /
- DATA ALFQJ( 921) / 1.01582145674746636553578916563D-03 /
- DATA ALFQJ( 922) / 1.00693515512180979835723424141D-03 /
- DATA ALFQJ( 923) / 9.98039510930093243030297794182D-04 /
- DATA ALFQJ( 924) / 9.89134335300311867565037918147D-04 /
- DATA ALFQJ( 925) / 9.80219989558740681850123219988D-04 /
- DATA ALFQJ( 926) / 9.71296275058028896084726922132D-04 /
- DATA ALFQJ( 927) / 9.62363563533659273652060302750D-04 /
- DATA ALFQJ( 928) / 9.53421645982248327690190152503D-04 /
- DATA ALFQJ( 929) / 9.44470905145065793544419609336D-04 /
- DATA ALFQJ( 930) / 9.35511121036495895636117895374D-04 /
- DATA ALFQJ( 931) / 9.26542688047895563288841561894D-04 /
- DATA ALFQJ( 932) / 9.17565374535130802754692650922D-04 /
- DATA ALFQJ( 933) / 9.08579587236512613995421176059D-04 /
- DATA ALFQJ( 934) / 8.99585082117880124745371984480D-04 /
- DATA ALFQJ( 935) / 8.90582279019380144589044924480D-04 /
- DATA ALFQJ( 936) / 8.81570920724311709364929310594D-04 /
- DATA ALFQJ( 937) / 8.72551440993694072324545174454D-04 /
- DATA ALFQJ( 938) / 8.63523568568244517058564312777D-04 /
- DATA ALFQJ( 939) / 8.54487752019982837050921547309D-04 /
- DATA ALFQJ( 940) / 8.45443705112094948315211883737D-04 /
- DATA ALFQJ( 941) / 8.36391892196677067935124741177D-04 /
- DATA ALFQJ( 942) / 8.27332011041157211435884998614D-04 /
- DATA ALFQJ( 943) / 8.18264542834653270572667242155D-04 /
- DATA ALFQJ( 944) / 8.09189168237815178141825888483D-04 /
- DATA ALFQJ( 945) / 8.00106386431756370269578733769D-04 /
- DATA ALFQJ( 946) / 7.91015859755682423530182352934D-04 /
- DATA ALFQJ( 947) / 7.81918106647306787846174356258D-04 /
- DATA ALFQJ( 948) / 7.72812769793666212553283523933D-04 /
- DATA ALFQJ( 949) / 7.63700388276598771737378135697D-04 /
- DATA ALFQJ( 950) / 7.54580583669950027086316215304D-04 /
- DATA ALFQJ( 951) / 7.45453917225398021991183744481D-04 /
- DATA ALFQJ( 952) / 7.36319987795887759913963569631D-04 /
- DATA ALFQJ( 953) / 7.27179380484448293451187119799D-04 /
- DATA ALFQJ( 954) / 7.18031669649800848003331723713D-04 /
- DATA ALFQJ( 955) / 7.08877466103998756515931010702D-04 /
- DATA ALFQJ( 956) / 6.99716317750667262586281744693D-04 /
- DATA ALFQJ( 957) / 6.90548863168366556644930308585D-04 /
- DATA ALFQJ( 958) / 6.81374621631688265040641338340D-04 /
- DATA ALFQJ( 959) / 6.72194261770552425107080616445D-04 /
- DATA ALFQJ( 960) / 6.63007271813714970224638788017D-04 /
- DATA ALFQJ( 961) / 6.53814352986931591637044758090D-04 /
- DATA ALFQJ( 962) / 6.44614959778511755405865338169D-04 /
- DATA ALFQJ( 963) / 6.35409828852047958178807343389D-04 /
- DATA ALFQJ( 964) / 6.26198377941827035183229141854D-04 /
- DATA ALFQJ( 965) / 6.16981382333546954468782679047D-04 /
- DATA ALFQJ( 966) / 6.07758219626233371287033651098D-04 /
- DATA ALFQJ( 967) / 5.98529707307292321869514855722D-04 /
- DATA ALFQJ( 968) / 5.89295179033687580627476347486D-04 /
- DATA ALFQJ( 969) / 5.80055498532725112518641569840D-04 /
- DATA ALFQJ( 970) / 5.70809951217746437764474202988D-04 /
- DATA ALFQJ( 971) / 5.61559451628540642752660468482D-04 /
- DATA ALFQJ( 972) / 5.52303232055353315428718279479D-04 /
- DATA ALFQJ( 973) / 5.43042263048782701596159142176D-04 /
- DATA ALFQJ( 974) / 5.33775718218083636574785954478D-04 /
- DATA ALFQJ( 975) / 5.24504630059486424879880168323D-04 /
- DATA ALFQJ( 976) / 5.15228107142699390647172220687D-04 /
- DATA ALFQJ( 977) / 5.05947250716045442184196720386D-04 /
- DATA ALFQJ( 978) / 4.96661097000810912452561219409D-04 /
- DATA ALFQJ( 979) / 4.87370823841540386593706618831D-04 /
- DATA ALFQJ( 980) / 4.78075386667371302052398183340D-04 /
- DATA ALFQJ( 981) / 4.68776049006352363866893684786D-04 /
- DATA ALFQJ( 982) / 4.59471675687625790715293588306D-04 /
- DATA ALFQJ( 983) / 4.50163626509508183153525387396D-04 /
- DATA ALFQJ( 984) / 4.40850664241990611288487569690D-04 /
- DATA ALFQJ( 985) / 4.31534257362381934200112162255D-04 /
- DATA ALFQJ( 986) / 4.22213053108121256850281496397D-04 /
- DATA ALFQJ( 987) / 4.12888643275637672338890415769D-04 /
- DATA ALFQJ( 988) / 4.03559543619113491944722676136D-04 /
- DATA ALFQJ( 989) / 3.94227486650684569071263603547D-04 /
- DATA ALFQJ( 990) / 3.84890837616306345752309483253D-04 /
- DATA ALFQJ( 991) / 3.75551490577499891072070182779D-04 /
- DATA ALFQJ( 992) / 3.66207637394433751636696236494D-04 /
- DATA ALFQJ( 993) / 3.56861358841573373355008390874D-04 /
- DATA ALFQJ( 994) / 3.47510645635749483648430905919D-04 /
- DATA ALFQJ( 995) / 3.38157795944135356031434260379D-04 /
- DATA ALFQJ( 996) / 3.28800565327971616302696794039D-04 /
- DATA ALFQJ( 997) / 3.19441507142088769442485709131D-04 /
- DATA ALFQJ( 998) / 3.10078099658009541165515310262D-04 /
- DATA ALFQJ( 999) / 3.00713198517770006574932064583D-04 /
- DATA ALFQJ(1000) / 2.91343951868644324186116860207D-04 /
- DATA ALFQJ(1001) / 2.81973577094905375285935352132D-04 /
- DATA ALFQJ(1002) / 2.72598825057144167069083464283D-04 /
- DATA ALFQJ(1003) / 2.63223351027957131781157136428D-04 /
- DATA ALFQJ(1004) / 2.53843421880363433813802178634D-04 /
- DATA ALFQJ(1005) / 2.44463229911461384905656663798D-04 /
- DATA ALFQJ(1006) / 2.35078444104533086167148902985D-04 /
- DATA ALFQJ(1007) / 2.25693925292063496496875545755D-04 /
- DATA ALFQJ(1008) / 2.16304591887941790536508737814D-04 /
- DATA ALFQJ(1009) / 2.06916151536012203752065929462D-04 /
- DATA ALFQJ(1010) / 1.97522562585371454076030474173D-04 /
- DATA ALFQJ(1011) / 1.88130627347577205342737140357D-04 /
- DATA ALFQJ(1012) / 1.78733048655234525208012355543D-04 /
- DATA ALFQJ(1013) / 1.69338078541451539821986648661D-04 /
- DATA ALFQJ(1014) / 1.59936733787662266614299087517D-04 /
- DATA ALFQJ(1015) / 1.50539243380972160577226799687D-04 /
- DATA ALFQJ(1016) / 1.41134285264203201917671225251D-04 /
- DATA ALFQJ(1017) / 1.31734883563328969548092321369D-04 /
- DATA ALFQJ(1018) / 1.22326337663442579148747834118D-04 /
- DATA ALFQJ(1019) / 1.12925808805336069599926400828D-04 /
- DATA ALFQJ(1020) / 1.03513454574482326456960494131D-04 /
- DATA ALFQJ(1021) / 9.41129381667466902198435049592D-05 /
- DATA ALFQJ(1022) / 8.46960265908302758763593031107D-05 /
- DATA ALFQJ(1023) / 7.52974768597021834664015432495D-05 /
- DATA ALFQJ(1024) / 6.58739487635213803810533339812D-05 /
- DATA ALFQJ(1025) / 5.64815417932571939114174550080D-05 /
- DATA ALFQJ(1026) / 4.70453099689381721140038480342D-05 /
- DATA ALFQJ(1027) / 3.76711963443812110423685651342D-05 /
- DATA ALFQJ(1028) / 2.81983345165233015712726121174D-05 /
- DATA ALFQJ(1029) / 1.89026792766573974132348561932D-05 /
- DATA ALFQJ(1030) / 9.18965020284356169090826344936D-06 /
- DATA ALFQJ(1031) / 9.53675225901819135493429265764D-07 /
- NUPPER=9
- IX=1
- CALL UCOPY(BETQJ,DB,1022)
- CALL UCOPY(KISQJ,DK,1022)
- CALL UCOPY(ALFQJ,DA,2062)
- RETURN
- END
diff --git a/src/mathlib/gen/obsolete/d600/fred1.F b/src/mathlib/gen/obsolete/d600/fred1.F
deleted file mode 100644
index 5f6c4de..0000000
--- a/src/mathlib/gen/obsolete/d600/fred1.F
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: fred1.F,v 1.1.1.1 1996/04/01 15:03:13 mclareni Exp $
-*
-* $Log: fred1.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:13 mclareni
-* Mathlib gen
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_gen/pilot.h"
- SUBROUTINE FRED1(F,G,A,B,N,Q,NQDIM)
- EXTERNAL F,G
- DIMENSION Q(NQDIM,2),Z(96),W(96),V(96),R(96)
- COMMON /FREDCM/NCOM,NFLAG,Z,W,V
-C
-C ******************************************************************
-C PRELIMINARY CALCULATIONS FOR SOLVING THE INTEGRAL EQUATION
-C
-C Y(X) = F(X) + ( G(X,T), Y(T) )
-C
-C WHERE THE LAST TERM (G,Y) DENOTES AN INTEGRAL OVER T FROM A TO B.
-C
-C WITHIN THE PROGRAM Z HOLDS THE GAUSS ZEROS, W HOLDS THE GAUSS
-C WEIGHTS, AND V HOLDS THE VALUES OF Y CALCULATED AT Z.
-C ******************************************************************
-C
-C-----START
- NCOM=N
- NFLAG=-4444
- CALL GSET(A,B,NCOM,Z,W)
-C
- DO 1 I=1,NCOM
- DO 2 J=1,NCOM
- Q(I,J)=-W(J)*G( Z(I), Z(J) )
- 2 CONTINUE
- Q(I,I)=1.0+Q(I,I)
- V(I)=F(Z(I))
- 1 CONTINUE
- CALL REQN(NCOM,Q,NQDIM,R,IFAIL,1,V)
- RETURN
- END
diff --git a/src/mathlib/gen/obsolete/d600/fred2.F b/src/mathlib/gen/obsolete/d600/fred2.F
deleted file mode 100644
index b174d39..0000000
--- a/src/mathlib/gen/obsolete/d600/fred2.F
+++ /dev/null
@@ -1,35 +0,0 @@
-*
-* $Id: fred2.F,v 1.1.1.1 1996/04/01 15:03:14 mclareni Exp $
-*
-* $Log: fred2.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:14 mclareni
-* Mathlib gen
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_gen/pilot.h"
- FUNCTION FRED2(F,G,X)
- EXTERNAL F,G
- DIMENSION Z(96),W(96),V(96)
- COMMON /FREDCM/N,NFLAG,Z,W,V
-C
-C ******************************************************************
-C FRED2 IS SET EQUAL TO Y(X), WHERE Y IS THE SOLUTION OF THE INTEG-
-C RAL EQUATION DEFINED BY A CALL TO FRED1.
-C ******************************************************************
-C
-C-----START
- IF(NFLAG.EQ.-4444) GO TO 1
- FRED2=0.0
- WRITE(6,200)
- 200 FORMAT(' FRED2 ... HAS BEEN REFERENCED BEFORE FRED1 HAS'
- + ,' BEEN CALLED')
- RETURN
-C
- 1 SUM=0.0
- DO 2 J=1,N
- SUM=SUM+W(J)*G( X, Z(J) )*V(J)
- 2 CONTINUE
- FRED2=F(X)+SUM
- RETURN
- END
diff --git a/src/mathlib/gen/obsolete/d600/fred3.F b/src/mathlib/gen/obsolete/d600/fred3.F
deleted file mode 100644
index bed1acd..0000000
--- a/src/mathlib/gen/obsolete/d600/fred3.F
+++ /dev/null
@@ -1,35 +0,0 @@
-*
-* $Id: fred3.F,v 1.1.1.1 1996/04/01 15:03:14 mclareni Exp $
-*
-* $Log: fred3.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:14 mclareni
-* Mathlib gen
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_gen/pilot.h"
- FUNCTION FRED3(H)
- EXTERNAL H
- DIMENSION Z(96),W(96),V(96)
- COMMON /FREDCM/N,NFLAG,Z,W,V
-C
-C ******************************************************************
-C FRED3 = (H,Y) = INTEGRAL FROM A TO B OF H*Y WHERE Y IS THE SOLUT-
-C ION OF THE INTEGRAL EQUATION DEFINED BY A CALL TO FRED1.
-C ******************************************************************
-C
-C-----START
- IF(NFLAG.EQ.-4444) GO TO 1
- FRED3=0.0
- WRITE(6,200)
- 200 FORMAT(' FRED3 ... HAS BEEN REFERENCED BEFORE FRED1 HAS'
- + ,' BEEN CALLED')
- RETURN
-C
- 1 SUM=0.0
- DO 2 J=1,N
- SUM=SUM+W(J)*H(Z(J))*V(J)
- 2 CONTINUE
- FRED3=SUM
- RETURN
- END
diff --git a/src/mathlib/gen/obsolete/e102old/maxfze.F b/src/mathlib/gen/obsolete/e102old/maxfze.F
deleted file mode 100644
index 2c5155b..0000000
--- a/src/mathlib/gen/obsolete/e102old/maxfze.F
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: maxfze.F,v 1.1.1.1 1996/04/01 15:03:06 mclareni Exp $
-*
-* $Log: maxfze.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:06 mclareni
-* Mathlib gen
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_gen/pilot.h"
-#if defined(CERNLIB_FORTRAN)||!defined(CERNLIB_CDC)
- FUNCTION MAXFZE(FA, N)
- DIMENSION FA(1)
- MAXFZE = 1
- F = FA(1)
- IF(N .LE. 1) RETURN
- DO 10 K = 2, N
- IF(FA(K) .LE. F) GO TO 10
- MAXFZE = K
- F = FA(K)
- 10 CONTINUE
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/obsolete/e102old/maxfzeml.s b/src/mathlib/gen/obsolete/e102old/maxfzeml.s
deleted file mode 100644
index ccdd1e5..0000000
--- a/src/mathlib/gen/obsolete/e102old/maxfzeml.s
+++ /dev/null
@@ -1,45 +0,0 @@
-*
-* $Id: maxfzeml.s,v 1.1.1.1 1996/04/01 15:03:06 mclareni Exp $
-*
-* $Log: maxfzeml.s,v $
-* Revision 1.1.1.1 1996/04/01 15:03:06 mclareni
-* Mathlib gen
-*
-*
-#if (defined(CERNLIB_CDC))&&(!defined(CERNLIB_FORTRAN))
- IDENT MAXFZE
- ENTRY MAXFZE
-* FUNCTION MAXFZE(A,N)
- SAVEA0 MACRO
- SX7 A0
- SA0 A1
- SA7 TEMPA0
- ENDM
- RESETA0 MACRO
- SA1 TEMPA0
- SA0 X1
- ENDM
- NAME VFD 36/0HMAXFZE,24/2
- MAXFZE DATA 0
- SAVEA0
- SA2 A1+1
- SA2 X2
- SB5 1 .SET B5 FOR TEST
- SB3 X2 .N IN B3
- SX6 B5 .INITIALISE FUNCTION VALUE
- GE B5,B3,MAXFZER
- SB4 B0 .INITIALISE COUNT B4
- SA1 X1
- LOOP SB4 B4+B5 .INCREMENT COUNT
- SA2 A1+B4
- EQ B3,B4,MAXFZER
- FX3 X1-X2 .FLOATING DIFF
- PL X3,LOOP .IF POS GO BACK FOR NEXT ELEMENT
- BX1 X2 .REPLACE X1 BY X2
- SX6 B4+B5 .RESET FUNCTION VALUE
- EQ B0,B0,LOOP .GO BACK FOR NEXT ELEMENT
- MAXFZER RESETA0
- EQ B0,B0,MAXFZE
- TEMPA0 DATA 0
- END
-#endif
diff --git a/src/mathlib/gen/obsolete/e102old/maxize.F b/src/mathlib/gen/obsolete/e102old/maxize.F
deleted file mode 100644
index ba91b93..0000000
--- a/src/mathlib/gen/obsolete/e102old/maxize.F
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: maxize.F,v 1.1.1.1 1996/04/01 15:03:06 mclareni Exp $
-*
-* $Log: maxize.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:06 mclareni
-* Mathlib gen
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_gen/pilot.h"
-#if defined(CERNLIB_FORTRAN)||!defined(CERNLIB_CDC)
- FUNCTION MAXIZE(IA, N)
- DIMENSION IA(1)
- MAXIZE = 1
- I = IA(1)
- IF(N .LE. 1) RETURN
- DO 10 K = 2, N
- IF(IA(K) .LE. I) GO TO 10
- MAXIZE = K
- I = IA(K)
- 10 CONTINUE
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/obsolete/e102old/maxizeml.s b/src/mathlib/gen/obsolete/e102old/maxizeml.s
deleted file mode 100644
index a6b6dce..0000000
--- a/src/mathlib/gen/obsolete/e102old/maxizeml.s
+++ /dev/null
@@ -1,45 +0,0 @@
-*
-* $Id: maxizeml.s,v 1.1.1.1 1996/04/01 15:03:06 mclareni Exp $
-*
-* $Log: maxizeml.s,v $
-* Revision 1.1.1.1 1996/04/01 15:03:06 mclareni
-* Mathlib gen
-*
-*
-#if (defined(CERNLIB_CDC))&&(!defined(CERNLIB_FORTRAN))
- IDENT MAXIZE
- ENTRY MAXIZE
-* FUNCTION MAXIZE(I,N)
- SAVEA0 MACRO
- SX7 A0
- SA0 A1
- SA7 TEMPA0
- ENDM
- RESETA0 MACRO
- SA1 TEMPA0
- SA0 X1
- ENDM
- NAME VFD 36/0HMAXIZE,24/2
- MAXIZE DATA 0
- SAVEA0
- SA2 A1+1
- SA2 X2
- SB5 1 .SET B5 FOR TEST
- SB3 X2 .N IN B3
- SX6 B5 .INITIALISE FUNCTION VALUE
- GE B5,B3,MAXIZER
- SB4 B0 .INITIALISE COUNT B4
- SA1 X1
- LOOP SB4 B4+B5 .INCREMENT COUNT
- SA2 A1+B4
- EQ B3,B4,MAXIZER
- IX3 X1-X2 .INT DIFF
- PL X3,LOOP .IF POS GO BACK FOR NEXT ELEMENT
- BX1 X2 .REPLACE X1 BY X2
- SX6 B4+B5 .RESET FUNCTION VALUE
- EQ B0,B0,LOOP .GO BACK FOR NEXT ELEMENT
- MAXIZER RESETA0
- EQ B0,B0,MAXIZE
- TEMPA0 DATA 0
- END
-#endif
diff --git a/src/mathlib/gen/obsolete/e102old/minfze.F b/src/mathlib/gen/obsolete/e102old/minfze.F
deleted file mode 100644
index de8ce7a..0000000
--- a/src/mathlib/gen/obsolete/e102old/minfze.F
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: minfze.F,v 1.1.1.1 1996/04/01 15:03:06 mclareni Exp $
-*
-* $Log: minfze.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:06 mclareni
-* Mathlib gen
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_gen/pilot.h"
-#if defined(CERNLIB_FORTRAN)||!defined(CERNLIB_CDC)
- FUNCTION MINFZE(FA, N)
- DIMENSION FA(1)
- MINFZE = 1
- F = FA(1)
- IF(N .LE. 1) RETURN
- DO 10 K = 2, N
- IF(FA(K) .GE. F) GO TO 10
- MINFZE = K
- F = FA(K)
- 10 CONTINUE
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/obsolete/e102old/minfzeml.s b/src/mathlib/gen/obsolete/e102old/minfzeml.s
deleted file mode 100644
index 56c0691..0000000
--- a/src/mathlib/gen/obsolete/e102old/minfzeml.s
+++ /dev/null
@@ -1,45 +0,0 @@
-*
-* $Id: minfzeml.s,v 1.1.1.1 1996/04/01 15:03:06 mclareni Exp $
-*
-* $Log: minfzeml.s,v $
-* Revision 1.1.1.1 1996/04/01 15:03:06 mclareni
-* Mathlib gen
-*
-*
-#if (defined(CERNLIB_CDC))&&(!defined(CERNLIB_FORTRAN))
- IDENT MINFZE
- ENTRY MINFZE
-* FUNCTION MINFZE(A,N)
- SAVEA0 MACRO
- SX7 A0
- SA0 A1
- SA7 TEMPA0
- ENDM
- RESETA0 MACRO
- SA1 TEMPA0
- SA0 X1
- ENDM
- NAME VFD 36/0HMINFZE,24/2
- MINFZE DATA 0
- SAVEA0
- SA2 A1+1
- SA2 X2
- SB5 1 .SET B5 FOR TEST
- SB3 X2 .N IN B3
- SX6 B5 .INITIALISE FUNCTION VALUE
- GE B5,B3,MINFZER
- SB4 B0 .INITIALISE COUNT B4
- SA1 X1
- LOOP SB4 B4+B5 .INCREMENT COUNT
- SA2 A1+B4
- EQ B3,B4,MINFZER
- FX3 X2-X1 .FLOATING DIFF
- PL X3,LOOP .IF POS GO BACK FOR NEXT ELEMENT
- BX1 X2 .REPLACE X1 BY X2
- SX6 B4+B5 .RESET FUNCTION VALUE
- EQ B0,B0,LOOP .GO BACK FOR NEXT ELEMENT
- MINFZER RESETA0
- EQ B0,B0,MINFZE
- TEMPA0 DATA 0
- END
-#endif
diff --git a/src/mathlib/gen/obsolete/e102old/minize.F b/src/mathlib/gen/obsolete/e102old/minize.F
deleted file mode 100644
index fbe15e6..0000000
--- a/src/mathlib/gen/obsolete/e102old/minize.F
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: minize.F,v 1.1.1.1 1996/04/01 15:03:06 mclareni Exp $
-*
-* $Log: minize.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:06 mclareni
-* Mathlib gen
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_gen/pilot.h"
-#if defined(CERNLIB_FORTRAN)||!defined(CERNLIB_CDC)
- FUNCTION MINIZE(IA, N)
- DIMENSION IA(1)
- MINIZE = 1
- I = IA(1)
- IF(N .LE. 1) RETURN
- DO 10 K = 2, N
- IF(IA(K) .GE. I) GO TO 10
- MINIZE = K
- I = IA(K)
- 10 CONTINUE
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/obsolete/e102old/minizeml.s b/src/mathlib/gen/obsolete/e102old/minizeml.s
deleted file mode 100644
index f077c4f..0000000
--- a/src/mathlib/gen/obsolete/e102old/minizeml.s
+++ /dev/null
@@ -1,45 +0,0 @@
-*
-* $Id: minizeml.s,v 1.1.1.1 1996/04/01 15:03:06 mclareni Exp $
-*
-* $Log: minizeml.s,v $
-* Revision 1.1.1.1 1996/04/01 15:03:06 mclareni
-* Mathlib gen
-*
-*
-#if (defined(CERNLIB_CDC))&&(!defined(CERNLIB_FORTRAN))
- IDENT MINIZE
- ENTRY MINIZE
-* FUNCTION MINIZE(I,N)
- SAVEA0 MACRO
- SX7 A0
- SA0 A1
- SA7 TEMPA0
- ENDM
- RESETA0 MACRO
- SA1 TEMPA0
- SA0 X1
- ENDM
- NAME VFD 36/0HMINIZE,24/2
- MINIZE DATA 0
- SAVEA0
- SA2 A1+1
- SA2 X2
- SB5 1 .SET B5 FOR TEST
- SB3 X2 .N IN B3
- SX6 B5 .INITIALISE FUNCTION VALUE
- GE B5,B3,MINIZER
- SB4 B0 .INITIALISE COUNT B4
- SA1 X1
- LOOP SB4 B4+B5 .INCREMENT COUNT
- SA2 A1+B4
- EQ B3,B4,MINIZER
- IX3 X2-X1 .INT DIFF
- PL X3,LOOP .IF POS GO BACK FOR NEXT ELEMENT
- BX1 X2 .REPLACE X1 BY X2
- SX6 B4+B5 .RESET FUNCTION VALUE
- EQ B0,B0,LOOP .GO BACK FOR NEXT ELEMENT
- MINIZER RESETA0
- EQ B0,B0,MINIZE
- TEMPA0 DATA 0
- END
-#endif
diff --git a/src/mathlib/gen/obsolete/e206/tricof.F b/src/mathlib/gen/obsolete/e206/tricof.F
deleted file mode 100644
index 97dc7bf..0000000
--- a/src/mathlib/gen/obsolete/e206/tricof.F
+++ /dev/null
@@ -1,378 +0,0 @@
-*
-* $Id: tricof.F,v 1.1.1.1 1996/04/01 15:03:14 mclareni Exp $
-*
-* $Log: tricof.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:14 mclareni
-* Mathlib gen
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_gen/pilot.h"
- SUBROUTINE TRICOF(F,NF,A,NE,B,NO,IOP)
-C
-C CERN LIBRARY NO E 206
-C
-C REVISED VERSION JUNE 1971.
-C
-C PURPOSE = TO COMPUTE THE COEFFICIENTS IN A TRIGONOMETRIC EXPANSION
-C FOR A FUNCTION GIVEN IN EQUIDISTANT POINTS
-C
-C PARAMETERS
-C
-C F = AN ARRAY USED FOR STORING THE FUNCTION VALUES F(X)
-C NF = THE NUMBER OF FUNCTION VALUES IN THE ARRAY F.NF MUST
-C HAVE THE STRUCTURE , NF = 2*N+1 , THE GENERAL CASE
-C NF = N+1 , THE EVEN CASE
-C NF = N-1 , THE ODD CASE
-C A = AN ARRAY USED FOR RETURNING THE COEFFICIENTS OF THE COS-
-C INE TERMS
-C NE = THE NUMBER OF COEFFICIENTS IN THE ARRAY A , NE.LE.(N+1)
-C B = AN ARRAY USED FOR RETURNING THE COEFFICIENTS OF THE SINE
-C TERMS
-C NO = THE NUMBER OF COEFFICIENTS IN THE ARRAY B , NO.LE.(N-1)
-C IOP = OPTION NUMBER , IOP = 1 , THE GENERAL CASE
-C IOP = 2 , THE EVEN CASE
-C IOP = 3 , THE ODD CASE
-C
- DIMENSION F(NF) , A(NE) , B(NO)
-C
- REAL KSI0 , KSI1 , KSIK
- DATA ZERO,HALF,ONE,TWO,PI/0.,.5,1.,2.,3.1415926535898/
-C
-C COMPUTE THE NUMBER N (SEE EXPLANATION OF PARAMETERS)
-C
-C*UL 1000 N=0
- N=0
- IF (IOP.EQ.1) N=(NF-1)/2
- IF (IOP.EQ.2) N=NF-1
- IF (IOP.EQ.3) N=NF+1
- MESSAG=1
- IF (N.EQ.0) GO TO 1280
-C
-C STOP IF IOP DOES NOT HAVE A CORRECT VALUE
-C
- IF (IOP.GT.1) GO TO 1030
- MESSAG=2
- IF ((2*N-NF+1).NE.0) GO TO 1280
-C
-C STOP IF NF DOES NOT HAVE THE CORRECT STRUCTURE IN THE GENERAL CASE
-C
-C SPLIT THE FUNCTION F(X) IN AN EVEN AND ODD PART
-C
- M=N+1
- DO 1020 J=1,N
- COF1=HALF*(F(M+J)+F(M-J))
- COF2=HALF*(F(M+J)-F(M-J))
- F(M+J)=COF2
- F(M-J)=COF1
- 1020 CONTINUE
-C
-C REWRITE N IN POWERS OF 2 I.E. N=NBASE*2**NEXP
-C
- 1030 NBASE=N
- NEXP =0
- 1040 NINR =NBASE/2
- IF ((NBASE-2*NINR).NE.0) GO TO 1050
- NBASE=NINR
- NEXP =NEXP+1
- GO TO 1040
-C
-C DO SOME INITIAL CALCULATIONS
-C
- 1050 REALN=NBASE
- ARG =HALF*PI/REALN
- KSI0 =COS(ARG)
- ETA0 =SIN(ARG)
-C
-C START CALCULATION OF COEFFICIENTS
-C
- IF (IOP.EQ.3) GO TO 1160
-C
-C ********** EVEN COEFFICIENT CALCULATION **********
-C
-C CHECK IF NE IS IN THE CORRECT RANGE
-C
- MESSAG=3
- IF ((NE.LE.2).OR.(NE.GT.(N+1))) GO TO 1280
-C
-C COMPUTE THE BASIC COEFFICIENTS A(K) , K=1(1)(NBASE+1)
-C
-C START CALCULATION OF A(1)
-C
- NN =NBASE-1
- NPOINT=1
- NINCRE=2**NEXP
- NLOCAL=NINCRE+1
- BASEIN=ONE/REALN
- A(1) =HALF*(F(1)+F(N+1))
- IF (NN.EQ.0) GO TO 1065
- DO 1060 J=1,NN
- A(1) =A(1)+F(NLOCAL)
- NLOCAL=NLOCAL+NINCRE
- 1060 CONTINUE
- 1065 A(1) =TWO*BASEIN*A(1)
-C
-C START CALCULATION OF A(K) , K=2(1)(NBASE+1)
-C
- KSI1=KSI0
- KSIK=KSI1
- ETA1=ETA0
- ETAK=ETA1
- CONST=HALF*F(N+1)
-C
- NUPPER=NBASE
- IF (NBASE.GT.(NE-1)) NUPPER=NE-1
-C
- DO 1090 K=1,NUPPER
- COF1=TWO*(TWO*KSIK**2-ONE)
- A2 =ZERO
- A1 =A2
- A0 =CONST
- NLOCAL=N+1-NINCRE
- DO 1070 J=1,NBASE
- A2=A1
- A1=A0
- A0=F(NLOCAL)+COF1*A1-A2
- NLOCAL=NLOCAL-NINCRE
- 1070 CONTINUE
-C
-C*UL 1080 A(K+1)=BASEIN*(A0-A2)
- A(K+1)=BASEIN*(A0-A2)
- COF1 =KSIK
- COF2 =ETAK
- KSIK =KSI1*COF1-ETA1*COF2
- ETAK =ETA1*COF1+KSI1*COF2
- 1090 CONTINUE
-C
-C CALCULATION OF THE BASIC EVEN COEFFICIENTS FINISHED
-C
- IF (NEXP.EQ.0) GO TO 1145
-C
-C CONTINUE CALCULATION OF EVEN COEFFICIENTS
-C
- NUMCOF=NBASE
- DO 1140 NSTEP=1,NEXP
- NINCRE=2**(NEXP-NSTEP)
- NPOINT=NINCRE+1
- NINCRE=2*NINCRE
- NLOCAL=NPOINT
- NUMBER=2*NUMCOF+1
-C
-C COMPUTE CONSTANT TERM IN MID-POINT APPROXIMATION I.E. K=1
-C
- SUM=ZERO
- DO 1100 J=1,NUMCOF
- SUM=SUM+F(NLOCAL)
- NLOCAL=NLOCAL+NINCRE
- 1100 CONTINUE
-C
- SUM =TWO*BASEIN*SUM
- COF1=A(1)
- A(1)=HALF*(COF1+SUM)
- IF(NUMBER.LE.NE) A(NUMBER)=HALF*(COF1-SUM)
-C
- IF (NUMCOF.EQ.1) GO TO 1134
-C
-C COMPUTE MID-POINT APPROXIMATION FOR K=2(1)NUMCOF
-C
-C*UL 1105 NN =NUMCOF-1
- NN =NUMCOF-1
- NUPPER=NN
- IF (NUPPER.GT.(NE-1)) NUPPER=NE-1
- KSIK=KSI1
- ETAK=ETA1
- DO 1130 K=1,NUPPER
- COF1=TWO*(TWO*KSIK**2-ONE)
- A2=ZERO
- A1=A2
- NLOCAL=N+2-NPOINT
- A0=F(NLOCAL)
- DO 1110 J=1,NN
- A2=A1
- A1=A0
- NLOCAL=NLOCAL-NINCRE
- A0=F(NLOCAL)+COF1*A1-A2
- 1110 CONTINUE
-C
-C*UL 1120 SUM=TWO*BASEIN*(A0-A1)*KSIK
- SUM=TWO*BASEIN*(A0-A1)*KSIK
- COF1=A(K+1)
- A(K+1)=HALF*(COF1+SUM)
- INDEX=NUMBER-K
- IF (INDEX.GT.NE) GO TO 1025
- A(INDEX)=HALF*(COF1-SUM)
-C
- 1025 COF1=KSIK
- COF2=ETAK
- KSIK=KSI1*COF1-ETA1*COF2
- ETAK=ETA1*COF1+KSI1*COF2
-C
- 1130 CONTINUE
- 1134 INDEX=NUMCOF+1
- IF (INDEX.GT.NE) GO TO 1136
- A(INDEX)=HALF*A(INDEX)
-C
-C CALCULATIONS OF MID-POINT APPROXIMATIONS FINISHED
-C
-C DO CHANGES RELATED TO HALVING OF THE INTERVAL
-C
- 1136 ARG =HALF*ARG
- COF1=ETA1
- ETA1=SIN(ARG)
- KSI1=HALF*COF1/ETA1
- BASEIN=HALF*BASEIN
- NUMCOF=2*NUMCOF
-C
- 1140 CONTINUE
- 1145 IF (NEXP.EQ.0) NUMBER=NBASE+1
- IF (NUMBER.GT.NE) GO TO 1150
- A(NUMBER)=HALF*A(NUMBER)
-C
-C CALULATION OF EVEN COEFFICIENTS FINISHED
-C
- 1150 IF (IOP.EQ.2) RETURN
-C
-C RETURN TO CALLING PROGRAM IF F(X) WAS AN EVEN FUNCTION
-C IF IOP=1 CHANGE SIGN OF EACH SECOND COEFFICIENTS
-C
- NINR=NE/2
- IF (NINR.EQ.0) GO TO 1166
- DO 1164 K=1,NINR
- A(2*K)=-A(2*K)
- 1164 CONTINUE
-C
-C ********** ODD COEFFICIENT CALCULATION **********
-C
-C CHECK IF NO IS IN THE CORRECT RANGE
-C
- MESSAG=4
- IF ((NO.LE.1).OR.(NO.GT.(N-1))) GO TO 1280
-C
-C COMPUTE THE BASIC COEFFICIENTS B(K) , K=1(1)NBASE
-C
- 1166 ARG=HALF*PI/REALN
- 1160 IF (IOP.EQ.1) NMAX=2*N+1
- IF (IOP.EQ.3) NMAX=N
- NINCRE=2**NEXP
- NPOINT=NMAX-NINCRE
- NLOCAL=NPOINT
- BASEIN=ONE/REALN
- B(1)=ZERO
- IF (NBASE.EQ.1) GO TO 1200
- KSI1=TWO*KSI0**2-ONE
- KSIK=KSI1
- ETA1=TWO*KSI0*ETA0
- ETAK=ETA1
- NN =NBASE-1
- NNN=NN-1
- IF (NN.GT.NO) NN=NO
- DO 1190 K=1,NN
- COF1=TWO*KSIK
- A2 =ZERO
- A1 =A2
- A0 =F(NPOINT)
- NLOCAL=NPOINT-NINCRE
- IF (NNN.EQ.0) GO TO 1180
- DO 1170 J=1,NNN
- A2=A1
- A1=A0
- A0=F(NLOCAL)+COF1*A1-A2
- NLOCAL=NLOCAL-NINCRE
- 1170 CONTINUE
-C
- 1180 B(K)=TWO*BASEIN*A0*ETAK
- COF1=KSIK
- COF2=ETAK
- KSIK=KSI1*COF1-ETA1*COF2
- ETAK=ETA1*COF1+KSI1*COF2
- 1190 CONTINUE
-C
-C CALCULATION OF THE BASIC ODD COEFFICIENTS FINISHED
-C
- 1200 IF (NEXP.EQ.0) GO TO 1260
-C
-C CONTINUE CALCULATION OF ODD COEFFICIENTS
-C
- KSI1=KSI0
- ETA1=ETA0
-C
- NUMCOF=NBASE
- DO 1250 NSTEP=1,NEXP
- KSIK=KSI1
- ETAK=ETA1
- NINCRE=2**(NEXP-NSTEP)
- NPOINT=NMAX-NINCRE
- NINCRE=2*NINCRE
- NUMBER=2*NUMCOF
- IF (NUMCOF .LE. NO) B(NUMCOF) = ZERO
-C
-C COMPUTE MID-POINT APPROXIMATIONS FOR K=1(1)NUMCOF
-C
- NN =NUMCOF-1
- NUPPER=NUMCOF
- IF (NUPPER.GT.NO) NUPPER=NO
- DO 1240 K=1,NUPPER
- COF1=TWO*(TWO*KSIK**2-ONE)
- A2 =ZERO
- A1 =A2
- NLOCAL=NPOINT
- A0 =F(NLOCAL)
- IF (NN.EQ.0) GO TO 1220
- DO 1210 J=1,NN
- A2=A1
- A1=A0
- NLOCAL=NLOCAL-NINCRE
- A0=F(NLOCAL)+COF1*A1-A2
- 1210 CONTINUE
-C
- 1220 SUM=TWO*BASEIN*(A0+A1)*ETAK
- COF1=B(K)
- B(K)=HALF*(COF1+SUM)
- IF (K.EQ.NUMCOF) GO TO 1230
- INDEX=NUMBER-K
- IF (INDEX.GT.NO) GO TO 1230
- B(INDEX)=-HALF*(COF1-SUM)
-C
- 1230 COF1=KSIK
- COF2=ETAK
- KSIK=KSI1*COF1-ETA1*COF2
- ETAK=ETA1*COF1+KSI1*COF2
-C
- 1240 CONTINUE
-C
-C CALCULATION OF MID-POINT APPROXIMATION FINISHED
-C
-C DO CHANGES RELATED TO HALVING OF INTERVAL
-C
- ARG =HALF*ARG
- COF1=ETA1
- ETA1=SIN(ARG)
- KSI1=HALF*COF1/ETA1
- BASEIN=HALF*BASEIN
- NUMCOF=2*NUMCOF
-C
- 1250 CONTINUE
-C
-C CALCULATION OF ODD COEFFICIENTS FINISHED
-C
- 1260 IF (IOP.EQ.3) RETURN
-C
-C IF IOP=1 RECOMPUTE FUNCTION VALUES
-C
- DO 1270 J=1,N
- COF2=F(M+J)
- COF1=F(M-J)
- F(M+J)=COF1+COF2
- F(M-J)=COF1-COF2
- 1270 CONTINUE
-C
- RETURN
-C
-C PRINT ERROR MESSAGE.
-C
- 1280 WRITE(6,1290) MESSAG
- STOP
-C
- 1290 FORMAT(5X,'SUBROUTINE TRICOF ERROR NO.',I2)
-C
- END
diff --git a/src/mathlib/gen/obsolete/e209/splin3.F b/src/mathlib/gen/obsolete/e209/splin3.F
deleted file mode 100644
index cabfd4d..0000000
--- a/src/mathlib/gen/obsolete/e209/splin3.F
+++ /dev/null
@@ -1,322 +0,0 @@
-*
-* $Id: splin3.F,v 1.1.1.1 1996/04/01 15:03:14 mclareni Exp $
-*
-* $Log: splin3.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:14 mclareni
-* Mathlib gen
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_gen/pilot.h"
- SUBROUTINE SPLIN3(X,Y,DERIV,N,NC,Z,FVALUE,FDERIV,M,MC,IOP)
-C
-C CERN LIBRARY PROGRAM NO E-209.
-C
-C REVISED VERSION JULY 1973.
-C
-C PURPOSE = TO COMPUTE A NATURAL SPLINE APPROXIMATION OF THIRD ORDER
-C FOR A FUNCTION Y(X) GIVEN IN THE N POINTS (X(I),Y(I)) ,
-C I=1(1)N.
-C
-C PARAMETERS (IN LIST).
-C
-C X = AN ARRAY STORING THE INPUT ARGUMENTS.DIMENSION X(N).
-C Y = AN ARRAY STORING THE INPUT FUNCTION VALUES.THE ELEMENT
-C Y(I) REPRESENT THE FUNCTION VALUE Y(X) FOR X=X(I).
-C DERIV = AN ARRAY USED FOR STORING THE COMPUTED DERIVATIVES OF
-C THE FUNCTION Y(X).IN DERIV(I,1) AND DERIV(I,2) ARE STOR-
-C ED THE FIRST-AND SECOND ORDER DERIVATIVES OF Y(X) FOR
-C X=X(I) RESPECTIVELY.
-C N = NUMBER OF INPUT FUNCTION VALUES.
-C NC = ARRAY DERIV IS DIMENSIONED DERIV(NC,2) IN CALLING
-C PROGRAM.
-C Z = AN ARRAY STORING THE ARGUMENTS FOR THE INTERPOLATED
-C VALUES TO BE COMPUTED.
-C FVALUE = AN ARRAY STORING THE COMPUTED INTERPOLATED VALUES.
-C FVALUE(J) REPRESENT THE FUNCTION VALUE FVALUE(Z) FOR
-C Z=Z(J).
-C FDERIV = AN ARRAY USED FOR STORING THE DERIVATIVES OF THE COM-
-C PUTED INTERPOLATED VALUES.EXPLANATION AS FOR DERIV.
-C M = NUMBER OF INTERPOLATED VALUES TO BE COMPUTED.
-C MC = ARRAY FDERIV IS DIMENSIONED FDERIV(MC,2) IN CALLING
-C PROGRAM.
-C IOP = OPTION PARAMETER.FOR IOP.LE.0 THE DERIVATIVES FOR EACH
-C SUB-INTERVAL IN THE SPLINE APPROXIMATION ARE COMPUTED.
-C IOP=-1, THE SECOND ORDER END-POINT
-C DERIVATIVES ARE COMPUTED BY
-C LINEAR EXTRAPOLATION.
-C IOP=0 , THE SECOND ORDER END-POINT
-C DERIVATIVES ASSUMED TO BE GI-
-C VEN (SEE COMMON /SPAPPR/).
-C IOP=1 , COMPUTE SPLINE APPROXIMATIONS
-C FOR THE ARGUMENTS GIVEN IN
-C THE ARRAY Z,THE DERIVATIVES
-C BEEING ASSUMED TO HAVE BEEN
-C CALCULATED IN A PREVIOUS CALL
-C ON THE ROUTINE.
-C
-C PARAMETERS (IN COMMON BLOCK / SPAPPR /).
-C
-C SECD1 = VALUE OF THE SECOND DERIVATIVE D2Y(X)/DX2 FOR THE INPUT
-C ARGUMENT X=X(1).
-C SECDN = VALUE OF THE SECOND DERIVATIVE D2Y(X)/DX2 FOR THE INPUT
-C ARGUMENT X=X(N).
-C NB. VALUES HAVE TO BE ASSIGNED TO SECD1 AND SECDN IN THE
-C CALLING PROGRAM.IF A NATURAL SPLINE FIT IS WANTED PUT
-C SECD1=SECDN=0.
-C VOFINT = COMPUTED APPROXIMATION FOR THE INTEGRAL OF Y(X) TAKEN
-C FROM X(1) TO X(N).
-C IERR = ERROR PARAMETER.IERR=0,NO ERRORS OCCURED.
-C IERR=1,THE NUMBER OF POINTS TOO SMALL
-C I.E.N LESS THAN 4.
-C IERR=2,THE ARGUMENTS X(I) NOT IN INCREA-
-C SING ORDER.
-C IERR=3,ARGUMENT TO BE USED IN INTERPOLA-
-C TION ABOVE RANGE.
-C IERR=4,ARGUMENT TO BE USED IN INTERPOLA-
-C TION BELOW RANGE.
-C NXY = N (SEE ABOVE),HAS TO BE STORED FOR ENTRIES CORRESPONDING
-C TO IOP=1.
-C
- DIMENSION X(NC) , Y(NC) , DERIV(NC,2) , Z(MC) , FVALUE(MC) ,
- 1 FDERIV(MC,2)
-C
- COMMON / SPAPPR / SECD1 , SECDN , VOFINT , IERR , NXY
- DATA ZERO,HALF,ONE,THREE/0.,.5,1.,3./
- DATA THIRD , SIXTH / .333333333333333 , .166666666666667 /
-C
-C*UL 1000 IF (IOP.GT.0) GO TO 1110
- IF (IOP.GT.0) GO TO 1110
-C
- IERR=0
-C
-C CHECK IF ENOUGH DATA-POINTS ARE AVAILABLEI.E. IF N LESS THAN 4 NO
-C THIRD ORDER SPLINE APPROXIMATION IS POSSIBLE.
-C
- IF (N.GE.4) GO TO 1010
-C
- IERR=1
- GO TO 2000
-C
-C START CALCULATION OF COEFFICIENTS TO BE USED IN THE SYSTEM OF EQU-
-C ATIONS FOR THE SECOND ORDER DERIVATIVES OF Y(X).
-C
- 1010 IF (IOP.NE.-1) GO TO 1015
- SECD1=ZERO
- SECDN = ZERO
- BET1=ONE/(ONE+HALF*(X(2)-X(1))/(X(3)-X(2)))
- ALF1=BET1*(ONE- ((X(2)-X(1))/(X(3)-X(2)))**2)
- BETN=ONE/(ONE+HALF*(X(N)-X(N-1))/(X(N-1)-X(N-2)))
- ALFN=BETN*(ONE- ((X(N)-X(N-1))/(X(N-1)-X(N-2)))**2)
-C
- 1015 DERIV(1,2)=SECD1
- DERIV(N,2)=SECDN
- DERIV(1,1)=ZERO
- DXPLUS=X(2)-X(1)
-C
-C CHECK IF ARGUMENTS ARE IN INCREASING ORDER.IF NOT PRINT ERROR
-C MESSAGE AND STOP.
-C
- IF ( DXPLUS.GT.ZERO) GO TO 1020
- IN=1
- IERR=2
- GO TO 2000
-C
- 1020 DYPLUS=(Y(2)-Y(1))/DXPLUS
- IU=N-1
- DO 1040 I=2,IU
- DXMIN =DXPLUS
- DYMIN =DYPLUS
- DXPLUS=X(I+1)-X(I)
-C
-C CHECK IF ARGUMENTS ARE IN INCREASING ORDER.IF NOT PRINT ERROR
-C MESSAGE AND STOP.
-C
- IF (DXPLUS.GT.ZERO) GO TO 1030
-C
- IN=I
- IERR=2
- GO TO 2000
-C
- 1030 DXINV =ONE/(DXPLUS+DXMIN)
- DYPLUS=(Y(I+1)-Y(I))/DXPLUS
- DIVDIF=DXINV*(DYPLUS-DYMIN)
- ALF =HALF*DXINV*DXMIN
- BET =HALF-ALF
-C
- IF (I.EQ.2) DIVDIF=DIVDIF-THIRD*ALF*DERIV(1,2)
- IF (I.EQ.IU) DIVDIF=DIVDIF-THIRD*BET*DERIV(N,2)
- IF (I.EQ.2) ALF=ZERO
-C
- IF (IOP.NE.-1) GO TO 1035
- IF (I.NE.2) GO TO 1032
- BET=BET*ALF1
- DIVDIF=DIVDIF*BET1
- GO TO 1035
- 1032 IF (I.NE.IU) GO TO 1035
- ALF=ALF*ALFN
- DIVDIF=DIVDIF*BETN
-C
- 1035 DXINV =ONE/(ONE+ALF*DERIV(I-1,1))
- DERIV(I,1)=-DXINV*BET
- DERIV(I,2)= DXINV*(THREE*DIVDIF-ALF*DERIV(I-1,2))
- 1040 CONTINUE
-C
-C COMPUTE THE SECOND DERIVATIVES BY BACKWARDS RECURRENCE RELATION.
-C THE SECOND ORDER DERIVATIVES FOR X=X(N-1) ALREADY COMPUTED.
-C
-C*UL 1050 DO 1060 I=2,IU
- DO 1060 I=2,IU
- J=N-I
- DERIV(J,2)=DERIV(J,1)*DERIV(J+1,2)+DERIV(J,2)
- 1060 CONTINUE
-C
- IF (IOP.NE.-1) GO TO 1070
- DERIV(1,2)=((X(3)-X(1))/(X(3)-X(2)))*DERIV(2,2)-((X(2)-X(1))/(X(3)
- 1-X(2)))*DERIV(3,2)
- DERIV(N,2)=-((X(N)-X(N-1))/(X(N-1)-X(N-2)))*DERIV(N-2,2)+((X(N)-X(
- 1N-2))/(X(N-1)-X(N-2)))*DERIV(N-1,2)
-C
-C CALCULATION OF THE SECOND ORDER DERIVATIVES FINISHED.START CAL-
-C CULATION OF THE FIRST ORDER DERIVATIVES AND OF THE INTEGRAL.
-C
- 1070 VOFINT=ZERO
- DO 1080 I=1,IU
- DXPLUS=X(I+1)-X(I)
- DYPLUS=Y(I+1)-Y(I)
- DIVDIF=DYPLUS/DXPLUS
- DERIV(I,1)=DIVDIF-DXPLUS*(THIRD*DERIV(I,2)+SIXTH*DERIV(I+1,2))
- DXPLUS=HALF*DXPLUS
- VOFINT=VOFINT+DXPLUS*(Y(I+1)+Y(I)-THIRD*(DERIV(I+1,2)+DERIV(I,2))*
- 1DXPLUS**2)
- 1080 CONTINUE
-C
-C COMPUTE THE LAST FIRST ORDER DERIVATIVE.
-C
- DXPLUS=X(N)-X(N-1)
- DYPLUS=Y(N)-Y(N-1)
- DIVDIF=DYPLUS/DXPLUS
- DERIV(N,1)=DIVDIF+DXPLUS*(SIXTH*DERIV(N-1,2)+THIRD*DERIV(N,2))
-C
-C CALCULATION OF FIRST ORDER DERIVATIVES AND INTEGRAL FINISHED.
-C
-C SET VALUE OF N IN COMMON BLOCK / SPAPPR /.
-C
- NXY=N
-C
-C COMPUTE INTERPOLATED VALUES IF ANY.
-C
- 1110 IF (M.LT.1) RETURN
-C
- XL=X(1)
- XU=X(2)
- IP=3
- IL=0
-C
-C--- Transform this DO-loop into a GOTO to avoid illegal jumps into it
-C
-C DO 1160 J=1,M
- J=0
-1121 J=J+1
- IF(J.GT.M) GOTO 1160
- ARG=Z(J)
- IF (ARG.GT.XU) GO TO 1170
- IF (ARG.LT.XL) GO TO 1190
-C
-C ARGUMENT IN CORRECT RANGE.CHECK IF POLYNOMIAL COEFFICIENTS HAVE
-C TO BE CALCULATED.
-C
-C*UL 1130 IF (IL.GT.0) GO TO 1150
- IF (IL.GT.0) GO TO 1150
-C
-C COMPUTE POLYNOMIAL COEFFICIENTS.
-C
- 1140 II=IP-2
- A0=Y(II)
- A1=DERIV(II,1)
- A4=DERIV(II,2)
- A6=(DERIV(II+1,2)-A4)/(XU-XL)
- A2=HALF*A4
- A3=SIXTH*A6
- A5=HALF*A6
- IL=1
-C
-C CALCULATION OF POLYNOMIAL COEFFICIENTS FINISHED.COMPUTE VALUES.
-C
- 1150 ARG=ARG-XL
- FVALUE(J)=((A3*ARG+A2)*ARG+A1)*ARG+A0
- FDERIV(J,1)=(A5*ARG+A4)*ARG+A1
- FDERIV(J,2)=A6*ARG+A4
-C
- 1155 CONTINUE
-C
- GOTO 1121
- 1160 CONTINUE
-C
-C CALCULATION OF INTERPOLATED VALUES FINISHED.
-C
- RETURN
-C
-C ARGUMENT ABOVE PRESENT RANGE.SHIFT RANGE UPWARDS.
-C
- 1170 IF(IP.GT.NXY) GO TO 1185
- IPP=IP
- DO 1180 I=IPP,NXY
- IF (ARG.GT.X(I)) GO TO 1180
- XL=X(I-1)
- XU=X(I)
- IP=I+1
- IL=0
- GO TO 1140
-C
- 1180 CONTINUE
-C
-C ARGUMENT OUT OF RANGE,I.E. ARG GREATER THAN X(N).
-C
- 1185 IERR=3
- IP=NXY+1
- GO TO 2010
-C
-C ARGUMENT BELOW PRESENT RANGE.SHIFT DOWNWARDS.
-C
- 1190 IPP=IP
- DO 1200 I=1,IPP
- II=IP-I-2
- IF (II.EQ.0) GO TO 1210
- IF (ARG.LT.X(II)) GO TO 1200
- XL=X(II)
- XU=X(II+1)
- IP=II+2
- IL=0
- GO TO 1140
-C
- 1200 CONTINUE
-C
-C ARGUMENT OUT OF RANGE,I.E. ARG LESS THAN X(1).
-C
- 1210 IERR=4
- IP=3
- GO TO 2010
-C
-C PRINT ERROR MESSAGES.
-C
- 2000 IF (IERR.EQ.1) WRITE(6,3000) IERR
- IF (IERR.EQ.2) WRITE(6,3000) IERR , X(IN) , X(IN+1)
- RETURN
-C
- 2010 WRITE(6,3000) IERR , ARG
-C
- FVALUE(J)=ZERO
- FDERIV(J,1)=ZERO
- FDERIV(J,2)=ZERO
-C
- II=IP-2
- XL=X(II)
- XU=X(II+1)
- IL=0
- GO TO 1155
-C
- 3000 FORMAT(//5X,'*** SUBROUTINE SPLIN3 ERROR NO ',I2,' ***',
- 1 2(4X,E21.14))
-C
- END
diff --git a/src/mathlib/gen/obsolete/e401/cheb02.F b/src/mathlib/gen/obsolete/e401/cheb02.F
deleted file mode 100644
index f367992..0000000
--- a/src/mathlib/gen/obsolete/e401/cheb02.F
+++ /dev/null
@@ -1,53 +0,0 @@
-*
-* $Id: cheb02.F,v 1.1.1.1 1996/04/01 15:03:15 mclareni Exp $
-*
-* $Log: cheb02.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:15 mclareni
-* Mathlib gen
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_gen/pilot.h"
- SUBROUTINE CHEB02(CK,K,IDIM)
-C
-C CERN PROGRAM LIBRARY NO. E401
-C
-C BASIC VERSION OF AUGUST 1970.
-C
-C PURPOSE = GENERATION OF CHEBYSHEV POLYNOMIALS OF ORDER K.
-C DISTINCTION IS MADE BETWEEN EVEN AND ODD TERMS.CALCULAT-
-C ION PROCEEDS BY BUILDING UP EACH TERM FROM THE TERM BUT
-C ONE PREVIOUSLY.
-C
-C PARAMETERS
-C
-C INPUT
-C
-C K = ORDER OF POLYNOMIAL REQUIRED.
-C IDIM = MAXIMUM ORDER OF K.
-C
-C OUTPUT
-C
-C CK = ARRAY HOLDING THE REQUIRED COEFFICIENTS.
-C
- DOUBLE PRECISION CK(IDIM),AK,AM
-C
- DO 4 NN=1,IDIM
- 4 CK(NN)=0.D0
- AK=DBLE(K)
- IF((K/2)*2.EQ.K)GOTO2
- CK(2)=AK*(-1.0)**((K-1)/2)
- IF(K.EQ.1)GOTO3
- DO 5 M=3,K,2
- AM=DBLE(M)
- 5 CK(M+1)=CK(M-1)*(AK**2-AM**2+4.D0*AM-4.D0)/(AM*(1.D0-AM))
- GOTO3
- 2 CK(1)=(-1.D0)**(K/2)
- CK(3)=(-1.D0)*CK(1)*(AK**2)/2.D0
- IF(K.EQ.2)GOTO3
- DO 6 M=4,K,2
- AM=DBLE(M)
- 6 CK(M+1)=CK(M-1)*(AK**2-AM**2+4.D0*AM-4.D0)/(AM*(1.D0-AM))
- 3 RETURN
-C
- END
diff --git a/src/mathlib/gen/obsolete/e401/e401bd.F b/src/mathlib/gen/obsolete/e401/e401bd.F
deleted file mode 100644
index acfeb78..0000000
--- a/src/mathlib/gen/obsolete/e401/e401bd.F
+++ /dev/null
@@ -1,45 +0,0 @@
-*
-* $Id: e401bd.F,v 1.1.1.1 1996/04/01 15:03:15 mclareni Exp $
-*
-* $Log: e401bd.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:15 mclareni
-* Mathlib gen
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_gen/pilot.h"
- DOUBLE PRECISION FUNCTION E401BD(A,B)
-C
-C CERN PROGRAM LIBRARY NO. E401
-C
-C BASIC VERSION OF AUGUST 1970.
-C
-C PURPOSE = COMPUTATION OF BINOMIAL COEFFICIENTS
-C
-C PARAMETERS
-C ( A )
-C A , B = USED TO FORM THE BINOMIAL COEFFICIENTS ( ).
-C ( B )
-C
- DOUBLE PRECISION A,B
-C
- IA=INT(SNGL(A))
- IB=INT(SNGL(B))
- IF((IB.NE.0).AND.(IB.NE.1).AND.(IB.NE.IA).AND.(IB.NE.(IA-1)))
- 1GOTO1
- E401BD=A
- IF((IB.EQ.0).OR.(IB.EQ.IA))E401BD=1.D0
- RETURN
-C
- 1 I1=1
- I2=1
- IBA=IA-IB
- LIM=IB
- IF(IBA.LT.IB)LIM=IBA
- DO 2 N=1,LIM
- I1=I1*(IA-(N-1))
- 2 I2=I2*(LIM-(N-1))
- E401BD=DBLE(I1)/DBLE(I2)
- RETURN
-C
- END
diff --git a/src/mathlib/gen/obsolete/e401/econde.F b/src/mathlib/gen/obsolete/e401/econde.F
deleted file mode 100644
index 7b8ba45..0000000
--- a/src/mathlib/gen/obsolete/e401/econde.F
+++ /dev/null
@@ -1,69 +0,0 @@
-*
-* $Id: econde.F,v 1.1.1.1 1996/04/01 15:03:14 mclareni Exp $
-*
-* $Log: econde.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:14 mclareni
-* Mathlib gen
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_gen/pilot.h"
- SUBROUTINE ECONDE(COEF,ECOEF,N,NTE,ACC,A,B,IOPT,STORE,DROP,BST)
-C
-C CERN PROGRAM LIBRARY NO. E401
-C
-C BASIC VERSION OF AUGUST 1970.
-C
-C PURPOSE = ECONOMIZATION OF POWER SERIES IN DOUBLE PRECISION.
-C
-C PARAMETERS
-C
-C INPUT
-C
-C COEF = COEFFICIENTS OF ORIGINAL SERIE.
-C N = NUMBER OF TERMS IN ORIGINAL SERIE.
-C ACC = ACCURACY REQUIRED.
-C A = LOWER BOUNDARY.
-C B = UPPER BOUNDARY.
-C IOPT = OPTION PARAMETER.
-C IOP=-1 , THE ODD CASE.
-C IOP= 0 , THE GENERAL CASE.
-C IOP= 1 , THE EVEN CASE.
-C
-C OUTPUT
-C
-C ECOEF = COEFFICIENTS OF ECONOMIZED SERIE.
-C NTE = NUMBER OF TERMS IN ECONOMIZED SERIE.
-C
-C DUMMY
-C
-C STORE = ARRAY USED FOR INTERMEDIATE CALCULATION.
-C DROP = ARRAY USED FOR INTERMEDIATE CALCULATION.RETURNS TAYLOR
-C COEFFICIENTS OF ORIGINAL SERIE IN THE NORMALIZED RANGE
-C (-1,1).
-C BST = ARRAY USED FOR INTERMEDIATE CALCULATION.
-C
- DOUBLE PRECISION COEF(N),ECOEF(N),STORE(N),ACC,A,B,SUM
-C
- DOUBLE PRECISION DROP(N),BST(N)
-C
- SUM=0.D0
- CALL TAYCHD(A,B,COEF,STORE,N,IOPT,DROP)
- DO 1 M=1,N
- MM=N+1-M
- SUM=SUM+ABS(STORE(MM))
- IF(SUM.GE.ACC)GOTO2
- 1 CONTINUE
- 2 NTE=MM
- IF(NTE.EQ.N)GOTO3
- CALL TRANSD(STORE,ECOEF,NTE,BST)
- RETURN
-C
- 3 WRITE(6,4)
- DO 5 J=1,N
- 5 ECOEF(J)=DROP(J)
- RETURN
-C
- 4 FORMAT(' ECONOMIZATION NOT POSSIBLE-ACCURACY REQUIRED TOO GREAT')
-C
- END
diff --git a/src/mathlib/gen/obsolete/e401/ectrad.F b/src/mathlib/gen/obsolete/e401/ectrad.F
deleted file mode 100644
index 2ef0aa9..0000000
--- a/src/mathlib/gen/obsolete/e401/ectrad.F
+++ /dev/null
@@ -1,145 +0,0 @@
-*
-* $Id: ectrad.F,v 1.1.1.1 1996/04/01 15:03:14 mclareni Exp $
-*
-* $Log: ectrad.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:14 mclareni
-* Mathlib gen
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_gen/pilot.h"
- SUBROUTINE ECTRAD(COEF,N,ECOEF,NTE,A,B,ACC,IOP)
-C
-C CERN PROGRAM LIBRARY NO. E401
-C
-C BASIC VERSION OF AUGUST 1970.
-C
-C PURPOSE = TO PROVIDE THE FOLLOWING THREE FACILITIES DEPENDING ON
-C THE VALUE OF THE PARAMETER I AS DESCRIBED BELOW.
-C
- DOUBLE PRECISION COEF(N) , ECOEF(N) , A , B , ACC
-C
- DOUBLE PRECISION CZ , DUMMY , D
-C
- COMMON /COFD/ CZ(100) , DUMMY(100) , D(100)
-C
- 10 FORMAT(//5X,'ECTRAD OPTION PARAMETER IOP OUTSIDE RANGE'//)
- 20 FORMAT(//5X,'ECTRAD COMMON BLOCK /COFD/ TOO SMALL'//)
-C
- IF (N.LE.100) GO TO 1000
-C
-C COMMON BLOCK /COFD/ TOO SMALL.PRINT ERROR MESSAGE.
-C
- WRITE(6,20)
- STOP
-C
-C COMPUTE OPTION NUMBERS I AND IOPT
-C
- 1000 IF (IOP.LT.1) GO TO 1020
- IF (IOP.LT.10) IOP=10*IOP
- DO 1010 II=1,3
- I =II
- IOPT=IOP-10*I
- IF (IOPT.LT.3) GO TO 1030
- 1010 CONTINUE
-C
-C OPTION NUMBER IOP OUTSIDE RANGE.PRINT ERROR MESSAGE.
-C
- 1020 WRITE(6,10)
- STOP
-C
- 1030 IF (I.EQ.1) IOPT=0
- IF (IOPT.EQ.2) IOPT=-1
-C
-C ******************************************************************
-C * *
-C
-C I = 1 , REARRANGEMENT OF A CHEBYSHEV SERIE TO A TAYLOR SERIE
-C VALID IN THE SAME RANGE.
-C
-C PARAMETERS
-C
-C COEF = INPUTTED ARRAY OF CHEBYSHEV COEFFICIENTS.
-C N = INPUTTED NUMBER OF TERMS IN THE CHEBYSHEV SERIE.
-C ECOEF = OUTPUTTED ARRAY OF THE TAYLOR COEFFICIENTS.
-C
-C COMMON BLOCK /COFD/
-C
-C CZ = USED FOR INTERMEDIATE STORAGE.
-C
- IF (I.NE.1) GO TO 1040
- CALL TRANSD(COEF,ECOEF,N,CZ)
- NTE=N
- RETURN
-C
-C * *
-C ******************************************************************
-C * *
-C
-C I = 2 , REARRANGEMENT OF A TAYLOR SERIE IN X VALID IN THE
-C RANGE (A,B) TO A CHEBYSHEV SERIE IN Z VALID IN THE RANGE
-C (-1,1) WHERE Z=(2*X-B-A)/(B-A).
-C
-C PARAMETERS
-C
-C COEF = INPUTTED ARRAY OF THE TAYLOR COEFFICIENTS.
-C N = INPUTTED NUMBER OF TE940 95 THE TAYLOR SERIE.
-C A = INPUTTED LOWER BOUNDARY.
-C B = INPUTTED UPPER BOUNDARY.
-C ECOEF = OUTPUTTED ARRAY OF THE CHEBYSHEV COEFFICIENTS
-C
-C COMMON BLOCK /COFD/
-C
-C CZ = OUTPUTTED ARRAY OF THE TAYLOR COEFFICIENTS FOR THE SERIE
-C TRANSFORMED TO THE VARIABLE Z.
-C
-C IOPT = OPTION PARAMETER.
-C IOPT=-1 , THE ODD CASE.
-C IOPT= 0 , THE GENERAL CASE.
-C IOPT= 1 , THE EVEN CASE.
-C
- 1040 IF (I.NE.2) GO TO 1050
- CALL TAYCHD(A,B,COEF,ECOEF,N,IOPT,CZ)
- NTE=N
- RETURN
-C
-C * *
-C ******************************************************************
-C * *
-C
-C I = 3 , ECONOMIZATION OF A POWER SERIE IN X VALID IN THE
-C RANGE (A,B) TO A SERIE OF LOWER DEGREE TO A GIVEN MAX-
-C IMUM ABSOLUTE ERROR WITHIN THE RANGE .IN THIS CASE THE
-C OUTPUT COEFFICIENTS ARE IN TERMS OF Z=(2*X-B-A)/(B-A) SO
-C THE OUTPUTTED SERIE IS VALID IN THE RANGE (-1,1).
-C
-C PARAMETERS
-C
-C COEF = INPUTTED ARRAY OF THE TAYLOR COEFFICIENTS.
-C N = INPUTTED NUMBER OF TERMS IN THE ORIGINAL TAYLOR SERIE.
-C A = INPUTTED LOWER BOUNDARY.
-C B = INPUTTED UPPER BOUNDARY.
-C ACC = INPUTTED REQUIRED MAXIMUM COMMITTED ABSOLUTE ERROR IN
-C ECONOMIZATION WITHIN (A,B).
-C ECOEF = OUTPUTTED ARRAY OF ECONOMIZED TAYLOR COEFFICIENTS.
-C NTE = OUTPUTTED NUMBER OF TERMS IN ECONOMIZED TAYLOR SERIE.
-C
-C COMMON BLOCK /COFD/
-C
-C CZ = OUTPUTTED ARRAY OF TAYLOR COEFFICIENTS IN Z AS DEFINED
-C ABOVE,BEFORE ECONOMIZATION.
-C DUMMY = USED FOR INTERMEDIATE STORAGE.
-C D = USED FOR INTERMEDIATE STORAGE.
-C
-C IOPT = OPTION PARAMETER.
-C IOPT=-1 , THE ODD CASE.
-C IOPT= 0 , THE GENERAL CASE.
-C IOPT= 1 , THE EVEN CASE.
-C
- 1050 CALL ECONDE(COEF,ECOEF,N,NTE,ACC,A,B,IOPT,DUMMY,CZ,D)
- RETURN
-C
-C * *
-C ******************************************************************
-C
- END
diff --git a/src/mathlib/gen/obsolete/e401/taychd.F b/src/mathlib/gen/obsolete/e401/taychd.F
deleted file mode 100644
index 2c32c64..0000000
--- a/src/mathlib/gen/obsolete/e401/taychd.F
+++ /dev/null
@@ -1,105 +0,0 @@
-*
-* $Id: taychd.F,v 1.1.1.1 1996/04/01 15:03:15 mclareni Exp $
-*
-* $Log: taychd.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:15 mclareni
-* Mathlib gen
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_gen/pilot.h"
- SUBROUTINE TAYCHD(A,B,CX,CH,I,IOPT,CZ)
-C
-C CERN PROGRAM LIBRARY NO. E401
-C
-C BASIC VERSION OF AUGUST 1970.
-C
-C PURPOSE = CONVERSION OF TAYLOR SERIES TO CHEBYSHEV SERIES NORMA-
-C LIZED TO THE RANGE (-1,1).
-C
-C PARAMETERS
-C
-C INPUT
-C
-C A = LOWER BOUNDARY.
-C B = UPPER BOUNDARY.
-C CX = COEFFICIENTS OF ORIGINAL TAYLOR SERIE.
-C I = NUMBER OF TERMS IN ORIGINAL SERIE.
-C IOPT = OPTION PARAMETER.
-C IOP=-1 , THE ODD CASE.
-C IOP= 0 , THE GENERAL CASE.
-C IOP= 1 , THE EVEN CASE.
-C
-C OUTPUT
-C
-C CH = CHEBYSHEV COEFFICIENTS IN NEW RANGE.
-C
-C DUMMY
-C
-C CZ = ARRAY USED FOR INTERMEDIATE STORAGE.
-C
- DOUBLE PRECISION CX(I),CZ(I),CH(I),A,B,TERM,E401BD,BP,AK,R,Q
- 1,ALPHA,ZETA, HELP1,HELP2,HELP3,HELP4
-C
-C *********** HELP1, HELP2,HELP3,HELP4 ARE TO HELP THE COMPILER
-C
-C THE FIRST PART OF THE PROGRAM TRANSFORMS THE RANGE.DISTINCTION
-C IS MADE BETWEEN ORIGINAL RANGES SYMMETRIC ABOUT THE ORIGIN AND
-C THOSE NOT.
-C
- IF((B+A).NE.0.D0) GO TO 1
- TERM=1.D0
- DO 2J=1,I
- CZ(J)=CX(J)*TERM
- 2 TERM=TERM*B
- GOTO 3
- 1 BP=B+A
- DO 7 J=1,I
- TERM=CX(J)*((B-A)**(J-1))/(2.D0**(J-1))
- CZ(J)=TERM
- IF(J.EQ.I)GOTO3
- JJ=J+1
- DO 4N=JJ,I
- AK=DBLE(N-1)
- R=DBLE(J-1)
- IF(CX(N-1).EQ.0.D0) GO TO 8
- TERM=TERM*BP*CX(N)*AK/(2.D0*CX(N-1)*(AK-R))
- GOTO 4
- 8 TERM=CX(N)*((B-A)**(J-1))*(BP**(N-J))/(2.D0**(N-1))
- TERM=TERM*E401BD(AK,R)
- 4 CZ(J)=CZ(J)+TERM
- 7 CONTINUE
-C
-C AT THIS POINT IN THE PROGRAM THE RANGE HAS BEEN TRANSFORMED AND
-C THE CALCULATION OF THE CHEBYSHEV COEFFICIENTS BEGINS
-C
- 3 DO 6 M=1,I
- IF((IOPT.EQ.0).OR.((IOPT.EQ.1).AND.((M/2)*2.NE.M)).OR.
- 1 ((IOPT.EQ.-1).AND.((M/2)*2.EQ.M))) GO TO 13
- CH(M)=0.D0
- GOTO 6
- 13 Q=DBLE(M-1)
- LIM=(I-M)/2+1
- TERM=CZ(M)/(2.D0**(M-2))
- CH(M)=TERM
- IF(LIM.EQ.1)GOTO 6
- DO 5 MM=2,LIM
- ALPHA=DBLE(MM-1)
- MUM=INT(Q+2.D0*ALPHA)+1
- IF(CZ(MUM-2).EQ.0.D0) GO TO 10
-C
- HELP1=Q+ALPHA
- HELP2=HELP1+ALPHA
- HELP3=HELP2-1.D0
- HELP4=ALPHA*HELP1
- TERM=TERM*CZ(MUM)*HELP2*HELP3/4.D0*(CZ(MUM-2)*HELP4)
-C
- GOTO5
- 10 TERM=CZ(MUM)/(2.D0**(MUM-2))
- ZETA=Q+2.D0*ALPHA
- TERM=TERM*E401BD(ZETA,ALPHA)
- 5 CH(M)=CH(M)+TERM
- 6 CONTINUE
- RETURN
-C
- END
diff --git a/src/mathlib/gen/obsolete/e401/transd.F b/src/mathlib/gen/obsolete/e401/transd.F
deleted file mode 100644
index c98ba00..0000000
--- a/src/mathlib/gen/obsolete/e401/transd.F
+++ /dev/null
@@ -1,50 +0,0 @@
-*
-* $Id: transd.F,v 1.1.1.1 1996/04/01 15:03:15 mclareni Exp $
-*
-* $Log: transd.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:15 mclareni
-* Mathlib gen
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_gen/pilot.h"
- SUBROUTINE TRANSD(DCHEB,DTAYL,IMAX,STORE)
-C
-C CERN PROGRAM LIBRARY NO. E401
-C
-C BASIC VERSION OF AUGUST 1970.
-C
-C PURPOSE = CONVERSION OF CHEBYSHEV SERIES TO TAYLOR SERIES BY RE-
-C ARRANGING.
-C
-C PARAMETERS
-C
-C INPUT
-C
-C DCHEB = COEFFICIENTS OF THE CHEBYSHEV SERIE.
-C IMAX = NUMBER OF TERMS IN THE CHEBYSHEV SERIE (AND ALSO IN THE
-C TAYLOR SERIE).
-C
-C OUTPUT
-C
-C DTAYL = COEFFICIENTS OF THE RESULTING TAYLOR SERIE.
-C
-C DUMMY
-C
-C STORE = ARRAY USED FOR INTERMEDIATE STORAGE.
-C
- DOUBLE PRECISION DCHEB(IMAX),DTAYL(IMAX),STORE(IMAX)
-C
- DO 1 I=1,IMAX
- 1 DTAYL(I)=0.D0
- DTAYL(1)=0.5D0*DCHEB(1)
- IMA=IMAX-1
- DO 5 I=1,IMA
- CALL CHEB02(STORE,I,IMAX)
- IU=I+1
- DO 4 J=1,IU
- 4 DTAYL(J)=DCHEB(I+1)*STORE(J)+DTAYL(J)
- 5 CONTINUE
- RETURN
-C
- END
diff --git a/src/mathlib/gen/obsolete/e410/cpsc.F b/src/mathlib/gen/obsolete/e410/cpsc.F
deleted file mode 100644
index d26d3f6..0000000
--- a/src/mathlib/gen/obsolete/e410/cpsc.F
+++ /dev/null
@@ -1,198 +0,0 @@
-*
-* $Id: cpsc.F,v 1.1.1.1 1996/04/01 15:03:15 mclareni Exp $
-*
-* $Log: cpsc.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:15 mclareni
-* Mathlib gen
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_gen/pilot.h"
- SUBROUTINE CPSC(F,Z,N,RS,ER)
-C
-C EVALUATION OF COMPLEX POWER SERIES COEFFICIENTS
-C
-C *** INPUT PARAMETERS ***
-C F COMPLEX FUNCTION, OF WHICH THE COEFFICIENTS ARE
-C SOUGHT.
-C Z COMPLEX POINT AROUND WHICH F SHALL BE EXPANDED.
-C N INTEGER, NUMBER OF COEFFICIENTS WANTED.
-C N MUST BE GE 1 AND LE 51.
-C *** OUTPUT PARAMETERS ***
-C RS COMPLEX ARRAY RS(N) CONTAINING THE N FIRST
-C COEFFICIENTS (CORRESPONDING TO THE POWERS 0 TO N-1).
-C ER REAL ARRAY ER(N) CONTAINING ERROR ESTIMATES FOR THE
-C COEFFICIENTS RS(N).
-C
- EXTERNAL F
- DIMENSION IP(32),A(64),RS(N),ER(N),RT(51,3),FV(6),
- * IW(7),SC(4),RV(4),C(4),FC(3)
- COMPLEX F,A,V,RS,RT,FV,U,W,T,Z,RV,RQ,S,XK,MULT,CO
- DATA L2/1/,IW /1,2,4,8,16,32,64/,IP /64,32,48,1
- +6,56,24,40,8,60,28,44,12, 52,20,36,4,62,30,46,14,
- +54,22,38,6,58,26,42,10,50, 18,34,2/,SC /.
- +125,.0625,.03125,.015625/,C /.31622776601684,.56234132519
- +035, .74989420933246,.86596432336007/,FV
- + /(-1.,0.),(0.,-1.), (.707
- +10678118655,-.70710678118655), (.923
- +87953251129,-.38268343236509), (.980
- +78528040323,-.19509032201613), (.995
- +18472667220,-.098017140329561)/,RV /(-.4,.3),(0.,0.),(.7,
- +.2),(.02,-.06)/
-C
-C STATEMENT FUNCTION FOR MULTIPLICATION OF A COMPLEX NUMBER
-C BY A REAL NUMBER.
-C
- MULT(RE,CO) = CMPLX(RE*REAL(CO),RE*AIMAG(CO))
-C*IA CO,RE
- DATA CO,RE/2*0/
-C
-C START EXECUTION.
-C
- IF(N.GT.51.OR.N.LT.1) GOTO 230
- LF = 0
- NP = 0
- M = 0
- NR = -1
-C
-C FIND IF A FFT OVER 8, 16, 32, OR 64 POINTS SHOULD BE
-C USED.
-C
- KL = 1
- IF(N.GT.6) KL=2
- IF(N.GT.12) KL=3
- IF(N.GT.25) KL=4
- KM = KL+2
- KN = 7-KM
- IX = IW(KM+1)
- IS = IW(KN)
-C
-C FIRST RADIUS USED R = .658... .
-C
- R = .65809246578231
- 10 V = CMPLX(R,0.)
-C
-C FUNCTION VALUES OF F ARE STORED READY PERMUTATED FOR
-C THE FFT.
-C
- DO 20 I=IS,32,IS
- IQ = IP(I)
- V = V*FV(KM)
- A(IQ) = F(Z+V)
- 20 A(IQ-1) = F(Z-V)
- LN = 2
- JN = 1
-C
-C THE LOOP DO 50 ... CONSTITUTES THE FFT.
-C
- DO 50 L=1,KM
- U = (1.,0.)
- W = FV(L)
- DO 40 J=1,JN
- DO 30 I=J,IX,LN
- IT = I+JN
- T = A(IT)*U
- A(IT) = A(I)-T
- 30 A(I) = A(I)+T
- 40 U = U*W
- LN = LN+LN
- 50 JN = JN+JN
- CX = 0.
- B = 1.
-C
-C TEST ON HOW FAST THE COEFFICIENTS OBTAINED DECREASE.
-C
- DO 60 I=1,IX
- CT = ABS(A(I))/B
- IF(CT.LT.CX) GOTO 60
- CX = CT
- INR = I
- 60 B = B*C(KL)
- IF(M.LE.1) GOTO 80
-C
-C ESTIMATE OF THE ROUNDING ERROR LEVEL FOR THE LAST RADIUS.
-C
- ER(1) = CX*1.E-14
- DO 70 I=2,N
- 70 ER(I) = ER(I-1)/R
- 80 SF = SC(KL)
- DO 90 I=1,IX
- A(I) = MULT(SF,A(I))
- 90 SF = SF/R
- L1 = L2
- L2 = 1
- IF(INR.GT.IW(KM)) GOTO 130
- IF(LF.EQ.1) GOTO 120
-C
-C TEST IF THE SERIES IS A TAYLOR OR A LAURENT SERIES.
-C
- SR = 0.
- SP = 0.
- DO 110 J=1,4
- RQ = MULT(R,RV(J))
- S = A(IX)
- DO 100 I=2,IX
- IA = IX+1-I
- 100 S = S*RQ+A(IA)
- CP = ABS(S)
- IF(CP.GT.SP) SP=CP
- CM = ABS(S-F(Z+RQ))
- 110 IF(CM.GT.SR) SR=CM
- IF(SR.GT.1.E-3*SP) GOTO 130
- LF = 1
- 120 L2 = -1
-C
-C DETERMINATION OF THE NEXT RADIUS TO BE USED.
-C
- 130 IF(NR.GE.0) GOTO 140
- FACT = 2.
- IF(L2.EQ.1) FACT=.5
- L1 = L2
- NR = 0
- 140 IF(L1.NE.L2) GOTO 160
- IF(NR.GT.0) GOTO 150
- NP = NP+1
- IF(NP-15) 170,170,230
- 150 FACT = 1./FACT
- 160 FACT = 1./SQRT(FACT)
- NR = NR+1
- 170 R = R*FACT
- M = NR-KL-1
- IF(M.LE.0) GOTO 10
-C
-C THE RESULTS FOR THE LAST THREE RADII ARE STORED.
-C
- DO 180 I=1,N
- 180 RT(I,M) = A(I)
- IF(M.EQ.1) GOTO 200
-C
-C EXTRAPOLATION.
-C
- DO 190 I=1,N
- XK = RT(I,M-1)-RT(I,M)
- 190 RT(I,M-1) = RT(I,M)-MULT(FC(M-1),XK)
- IF(M.EQ.3) GOTO 210
-C
-C CALCULATION OF THE EXTRAPOLATION CONSTANTS.
-C
- 200 FC(M) = 1.5+SIGN(.5,FACT-1.)
- IF(M.EQ.2) FC(M)=FC(M)+1.4142135623731
- IF(FACT.GT.1.) FC(M)=-FC(M)
- GOTO 10
- 210 FC(3) = FC(1)*FC(2)/(FC(1)+FC(2)+1.)
-C
-C FINAL EXTRAPOLATION AND ERROR ESTIMATION.
-C
- DO 220 I=1,N
- XK = RT(I,1)-RT(I,2)
- ER(I) = ER(I)+1.E-3*ABS(XK)
- 220 RS(I) = RT(I,2)-MULT(FC(3),XK)
- RETURN
-C
-C ERROR RETURN.
-C
- 230 DO 240 I=1,N
- RS(I) = (0.,0.)
- 240 ER(I) = 1.E10
- RETURN
- END
diff --git a/src/mathlib/gen/obsolete/f106/spxinv.F b/src/mathlib/gen/obsolete/f106/spxinv.F
deleted file mode 100644
index b90e2e6..0000000
--- a/src/mathlib/gen/obsolete/f106/spxinv.F
+++ /dev/null
@@ -1,86 +0,0 @@
-*
-* $Id: spxinv.F,v 1.1.1.1 1996/04/01 15:03:15 mclareni Exp $
-*
-* $Log: spxinv.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:15 mclareni
-* Mathlib gen
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_gen/pilot.h"
- SUBROUTINE SPXINV (A,NDIM,IFAIL)
-C
- DIMENSION A(2),INDEX(100),RI(100)
-C
- DATA TOL / 1.E-12/
-C
- IFAIL=0
- N=NDIM
- NM1=N-1
- DO 10 I=1,N
- 10 INDEX(I)=1
-C
- DO 80 I=1,N
-C
-C-- FIND PIVOT
- NPD=N
- PIVOT=0.
- JJ=1
- DO 20 J=1,N
- IF (INDEX(J).EQ.0) GO TO 19
- ELM=ABS (A(JJ))
- IF (ELM.LE.PIVOT) GO TO 19
- PIVOT=ELM
- K=J
- KK=JJ
- 19 JJ=JJ+NPD
- NPD=NPD-1
- 20 CONTINUE
- IF (PIVOT/ABS(A(1)).LT.TOL) GO TO 100
- INDEX(K)=0
- PIVOT=-A(KK)
-C
-C-- ELIMINATION
- NP=NM1
- KJ=K
- NM=1
-C
- DO 70 J=1,N
- IF (J-K) 34,30,34
-C
- 30 A(KJ)=1./PIVOT
- RI(J)=0.
- NM=0
- NP=1
- GO TO 65
-C
- 34 ELM=-A(KJ)
-C*UL 40 RI(J)=ELM/PIVOT
- RI(J)=ELM/PIVOT
- IF (ELM.EQ.0.) GO TO 50
-C
- NPC=NM1
- JL=J
- DO 45 L=1,J
- A(JL)=A(JL)+ELM*RI(L)
- JL=JL+NPC
- NPC=NPC-1
- 45 CONTINUE
-C
- 50 A(KJ)=RI(J)
-C
- 65 KJ=KJ+NP
- 70 NP=NP-NM
-C
- 80 CONTINUE
-C
-C-- CHANGE THE SIGN
- N=(N*N+N)/2
- DO 90 IJ=1,N
- 90 A(IJ)=-A(IJ)
- RETURN
-C
-C-- FAILURE RETURN
- 100 IFAIL=1
- RETURN
- END
diff --git a/src/mathlib/gen/obsolete/f202/lrch.F b/src/mathlib/gen/obsolete/f202/lrch.F
deleted file mode 100644
index 1fdee1b..0000000
--- a/src/mathlib/gen/obsolete/f202/lrch.F
+++ /dev/null
@@ -1,179 +0,0 @@
-*
-* $Id: lrch.F,v 1.1.1.1 1996/04/01 15:03:15 mclareni Exp $
-*
-* $Log: lrch.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:15 mclareni
-* Mathlib gen
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_gen/pilot.h"
- SUBROUTINE LRCH (NN,M,A,EPS,LOWER,FLAMB,KA,KAA,R)
- DIMENSION A(KA,KA), FLAMB(KA)
- DIMENSION R(KAA,KA)
- N = NN
- Z=0.0
- Y=0.
- IS=0
- L=0
- OMEGA=.5
- PHI=.5
- XN=N
- NT=INT(1.5*SQRT(XN))
- IPA=1
- IF (LOWER) 52,2,4
-2 DO 3 K=1,N
- DO 3 J=1,M
- A(K,J)=-A(K,J)
-3 CONTINUE
-4 G=0
- ISTOP=0
- ICF=0
- IF (N) 52,48,5
-5 IF (ISTOP) 52,6,48
-6 IF (N-1) 7,32,7
-7 IEN=1
- ASSIGN 8 TO INDEF
- ASSIGN 59 TO NOST1
- GO TO 53
-8 ICF=ICF+1
- IF (Y) 10,9,11
-9 Y=-EPS*1000000.
- GO TO 7
-10 Y=10.*Y
- GO TO 7
-11 IF (ICF-3) 13,12,13
-12 Y=0.
- GO TO 7
-13 IF (K-N+2) 14,14,15
-14 OMEGA=(OMEGA+1.)*(OMEGA+1.)
- Y=Y/OMEGA-EPS
- IF (Y) 12,7,7
-15 IF (K-N+1) 17,16,17
-16 U=A(N,1)-R(N,1)-Y
- V=A(N-1,2)-R(N-1,2)
- W=X
- GO TO 21
-17 IF (K-N) 21,18,21
-18 IF (EPS+X) 20,20,19
-19 R(N,1)=0
- GO TO 59
-20 U=X+R(N-1,2)*R(N-1,2)
- V=R(N-1,1)*R(N-1,2)
- W=R(N-1,1)*R(N-1,1)
-21 FH=(U+W)/2.-SQRT((U-W)*(U-W)/4.+V*V)
- IF (W-U) 23,23,22
-22 FH=U-V*V/(W-FH)
-23 IF (G) 52,25,24
-24 FH=.99999*Y-EPS+FH
- GO TO 26
-25 FH=Y+FH
-26 G=1
- IF (FH) 14,27,27
-27 Y=FH
- IF (ICF-1) 7,28,7
-28 OMEGA=OMEGA/(OMEGA+1.)
- GO TO 7
-29 Z=Z+Y
- IF (ICF) 31,30,31
-30 OMEGA=(OMEGA/(OMEGA+1.5))*(OMEGA/(OMEGA+1.5))
-31 OMEGA=2.*OMEGA*FH*FH/(FHA*FHA+FHB*FHB)
- PHI=.998*PHI/(.998*PHI*(1.-OMEGA)+OMEGA)
- IF (ABS(A(N,1))-EPS) 32,39,39
-32 L=L+1
- FLAMB(L)=Z+A(N,1)
- IF (LOWER) 52,33,34
-33 FLAMB(L)=-FLAMB(L)
-34 DO 36 J=1,M
- IF (J-1-N) 35,36,36
-35 KK=N-J+1
- A(KK,J)=0.
-36 CONTINUE
- N=N-1
- XN=N
- NT=INT(1.5*SQRT(XN))
- PHI=.5
- OMEGA=.5
- IP=IPA
- IF (IP-N+1) 38,37,37
-37 PHI=1
-38 IF (N-2) 47,39,39
-39 IF (IP-N) 41,40,41
-40 U=A(N,1)
- V=A(N-1,2)
- W=A(N-1,1)
- FHA=U*W-V*V
- GO TO 42
-41 U=R(IP+1,1)*R(IP+1,1)
- V=R(IP,2)*R(IP+1,1)
- W=R(IP,1)*R(IP,1)+R(IP,2)*R(IP,2)
- FHA=(R(IP,1)*R(IP+1,1))*(R(IP,1)*R(IP+1,1))
-42 FH=FHA/((U+W)/2.+SQRT((U-W)*(U-W)/4.+V*V))
- Y=FH*PHI
- IEN=N-NT+1
- ASSIGN 43 TO INDEF
- ASSIGN 47 TO NOST1
- GO TO 53
-43 IF (K-N+1) 46,44,44
-44 IF (X+Y/2.) 46,46,45
-45 Y=Y+X
- GO TO 47
-46 OMEGA=OMEGA+1.
- Y=.8*Y
-47 IS=IS+1
- GO TO 4
-48 DO 51 K=1,N
- A(K,1)=Z+A(K,1)
- IF (LOWER) 52,49,51
-49 DO 50 J=1,M
- A(K,J)=-A(K,J)
-50 CONTINUE
-51 CONTINUE
- RETURN
-52 WRITE(6,66)
- RETURN
-53 KK=N+M-1
- DO 54 K=IEN,KK
- DO 54 J=1,M
- R(K,J)=0.
-54 CONTINUE
- DO 58 K=IEN,N
- X=A(K,1)-R(K,1)-Y
- IF (X) 55,55,56
-55 GO TO INDEF, (8,43)
-56 R(K,1)=SQRT(X)
- DO 57 J=2,M
- R(K,J) = (A(K,J) - R(K,J))/ R(K,1)
-57 CONTINUE
- DO 58 J=2,M
- DO 58 I=J,M
- KK=K+J-1
- II=I-J+1
-58 R(KK,II)=R(KK,II)+R(K,J)*R(K,I)
- GO TO NOST1, (59,47)
-59 FH=R(1,1)
- FHA=FH
- FHB=FH
- IP=1
- IPA=1
- DO 65 K=1,N
- FHB=FHA
- FHA=FH
- IPA=IP
- IF (R(K,1)-FH) 60,61,61
-60 FH=R(K,1)
- IP=K
-61 DO 65 J=1,M
- A(K,J)=0.
- DO 62 I=J,M
- KK=K+J-1
- II=I-J+1
-62 A(K,J)=A(K,J)+R(K,I)*R(KK,II)
- IF (A(K,J)) 65,63,65
-63 IF (K+J-N-1) 64,64,65
-64 A(K,J)=.001*EPS
-65 CONTINUE
- GO TO 29
-C
-66 FORMAT(' ERROR IN VALUE OF BOOLEAN VARIABLE')
- END
diff --git a/src/mathlib/gen/obsolete/f600/rotate.F b/src/mathlib/gen/obsolete/f600/rotate.F
deleted file mode 100644
index 09c83b1..0000000
--- a/src/mathlib/gen/obsolete/f600/rotate.F
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: rotate.F,v 1.1.1.1 1996/04/01 15:03:16 mclareni Exp $
-*
-* $Log: rotate.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:16 mclareni
-* Mathlib gen
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_gen/pilot.h"
- SUBROUTINE ROTATE (X, Y, CS, SN, N)
- REAL X(N), Y (N), CS, SN
-C
- DO 10 J = 1,N
- XX = X(J)
- X(J) = XX*CS + Y(J)*SN
- 10 Y(J) = Y(J)*CS - XX*SN
- RETURN
-C -------------------- END OF SVD ---------------------------------
- END
diff --git a/src/mathlib/gen/obsolete/f600/svd.F b/src/mathlib/gen/obsolete/f600/svd.F
deleted file mode 100644
index a52f687..0000000
--- a/src/mathlib/gen/obsolete/f600/svd.F
+++ /dev/null
@@ -1,309 +0,0 @@
-*
-* $Id: svd.F,v 1.1.1.1 1996/04/01 15:03:15 mclareni Exp $
-*
-* $Log: svd.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:15 mclareni
-* Mathlib gen
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_gen/pilot.h"
- SUBROUTINE SVD (A, S, V, MMAX, NMAX, M, N, P, WITHU, WITHV)
-C --------------------- START OF SVD -----------------------------
-C
- REAL A(MMAX,1), S(NMAX), V(NMAX,NMAX)
- INTEGER M, N, P
- LOGICAL WITHU, WITHV
-C
-C ADDITIONAL SUBROUTINE NEEDED: ROTATE
-C
-C THIS SUBROUTINE COMPUTES THE SINGULAR VALUE DECOMPOSITION
-C OF A REAL M*N MATRIX A, I.E. IT COMPUTES MATRICES U, S, AND V
-C SUCH THAT
-C A = U * S * VT ,
-C WHERE
-C U IS AN M*N MATRIX AND UT*U = I, (UT=TRANSPOSE
-C OF U),
-C V IS AN N*N MATRIX AND VT*V = I, (VT=TRANSPOSE
-C OF V),
-C AND S IS AN N*N DIAGONAL MATRIX.
-C
-C DESCRIPTION OF PARAMETERS:
-C A = REAL ARRAY. A CONTAINS THE MATRIX TO BE DECOMPOSED.
-C THE ORIGINAL DATA ARE LOST. IF WITHU=.TRUE., THEN
-C THE MATRIX U IS COMPUTED AND STORED IN THE ARRAY A.
-C MMAX = INTEGER VARIABLE. THE NUMBER OF ROWS IN THE
-C ARRAY A.
-C NMAX = INTEGER VARIABLE. THE NUMBER OF ROWS IN THE
-C ARRAY V.
-C M,N = INTEGER VARIABLES. THE NUMBER OF ROWS AND COLUMNS
-C IN THE MATRIX STORED IN A. (N<=M<=100. IF IT IS
-C NECESSARY TO SOLVE A LARGER PROBLEM, THEN THE
-C AMOUNT OF STORAGE ALLOCATED TO THE ARRAY T MUST
-C BE INCREASED ACCORDINGLY.) IF M<N, THEN EITHER
-C TRANSPOSE THE MATRIX A OR ADD ROWS OF ZEROS TO
-C INCREASE M TO N.
-C P = INTEGER VARIABLE. IF P>0, THEN COLUMNS N+1, . . . ,
-C N+P OF A ARE ASSUMED TO CONTAIN THE COLUMNS OF AN M*P
-C MATRIX B. THIS MATRIX IS MULTIPLIED BY UT, AND UPON
-C EXIT, A CONTAINS IN THESE SAME COLUMNS THE N*P MATRIX
-C UT*B. (P-=0)
-C WITHU, WITHV = LOGICAL VARIABLES. IF WITHU=.TRUE., THEN
-C THE MATRIX U IS COMPUTED AND STORED IN THE ARRAY A.
-C IF WITHV=.TRUE., THEN THE MATRIX V IS COMPUTED AND
-C STORED IN THE ARRAY V.
-C S = REAL ARRAY. S(1), . . . , S(N) CONTAIN THE DIAGONAL
-C ELEMENTS OF THE MATRIX S ORDERED SO THAN S(I)>=S(I+1),
-C I=1, . . . , N-1.
-C V = REAL ARRAY. V CONTAINS THE MATRIX V. IF WITHU
-C AND WITHV ARE NOT BOTH =.TRUE., THEN THE ACTUAL
-C PARAMETER CORRESPONDING TO A AND V MAY BE THE SAME.
-C
-C THIS SUBROUTINE IS A REAL VERSION OF A FORTRAN SUBROUTINE
-C BY BUSINGER AND GOLUB, ALGORITHM 358: SINGULAR VALUE
-C DECOMPOSITION OF A COMPLEX MATRIX, COMM. ACM, V. 12,
-C NO. 10, PP. 564-565 (OCT. 1969).
-C WITH REVISIONS BY RC SINGLETON, MAY 1972.
-C ------------------------------------------------------------------
- DIMENSION T(100)
-C
-#if defined(CERNLIB_CDC)
- DATA ETA,TOL/1.E-14,1.E-279/
-#endif
-#if defined(CERNLIB_IBM)
- DATA ETA,TOL/1.E-6,1.E-72/
-#endif
-#if (!defined(CERNLIB_CDC))&&(!defined(CERNLIB_IBM))
- DATA ETA,TOL / 1.E-6,1.E-37/
-#endif
-C ETA AND TOL ARE MACHINE DEPENDENT CONSTANTS
-C ETA IS THE MACHINE EPSILON (RELATIVE ACCURACY);
-C TOL IS THE SMALLEST REPRESENTABLE REAL DIVIDED BY ETA.
-C
- NP = N + P
- N1 = N + 1
-C
-C HOUSEHOLDER REDUCTION TO BIDIAGONAL FORM
- G = 0.0
- EPS = 0.0
- L = 1
- 10 T(L) = G
- K = L
- L = L + 1
-C
-C ELIMINATION OF A(I,K), I=K+1, . . . , M
- S(K) = 0.0
- Z = 0.0
- DO 20 I = K,M
- 20 Z = Z + A(I,K)**2
- IF (Z.LT.TOL) GOTO 50
- G = SQRT(Z)
- F = A(K,K)
- IF (F.GE.0.0) G = - G
- S(K) = G
- H = G * (F - G)
- A(K,K) = F - G
- IF (K.EQ.NP) GOTO 50
- DO 40 J = L,NP
- F = 0
- DO 30 I = K,M
- 30 F= F + A(I,K)*A(I,J)
- F = F/H
- DO 40 I = K,M
- 40 A(I,J) = A(I,J) + F*A(I,K)
-C
-C ELIMINATION OF A(K,J), J=K+2, . . . , N
- 50 EPS = MAX(EPS,ABS(S(K)) + ABS(T(K)))
- IF (K.EQ.N) GOTO 100
- G = 0.0
- Z = 0.0
- DO 60 J = L,N
- 60 Z = Z + A(K,J)**2
- IF (Z.LT.TOL) GOTO 10
- G = SQRT(Z)
- F = A (K,L)
- IF (F.GE.0.0) G = - G
- H = G * (F - G)
- A(K,L) = F - G
- DO 70 J = L,N
- 70 T(J) = A(K,J)/H
- DO 90 I = L,M
- F = 0
- DO 80 J = L,N
- 80 F = F + A(K,J)*A(I,J)
- DO 90 J = L,N
- 90 A(I,J) = A(I,J) + F*T(J)
-C
- GOTO 10
-C
-C TOLERANCE FOR NEGLIGIBLE ELEMENTS
- 100 EPS = EPS*ETA
-C
-C ACCUMULATION OF TRANSFORMATIONS
- IF (.NOT.WITHV) GOTO 160
- K = N
- GOTO 140
- 110 IF (T(L).EQ.0.0) GOTO 140
- H = A(K,L)*T(L)
- DO 130 J = L,N
- Q = 0
- DO 120 I = L,N
- 120 Q = Q + A(K,I)*V(I,J)
- Q = Q/H
- DO 130 I = L,N
- 130 V(I,J) = V(I,J) + Q*A(K,I)
- 140 DO 150 J = 1,N
- 150 V(K,J) = 0
- V(K,K) = 1.0
- L=K
- K = K - 1
- IF (K.NE.0) GOTO 110
-C
- 160 K = N
- IF (.NOT. WITHU) GO TO 230
- G = S (N)
- IF (G.NE.0.0) G = 1.0/G
- GO TO 210
- 170 DO 180 J = L,N
- 180 A(K,J) = 0
- G = S(K)
- IF (G.EQ.0.0) GOTO 210
- H = A(K,K)*G
- DO 200 J = L,N
- Q =0
- DO 190 I = L,M
- 190 Q= Q + A(I,K)*A(I,J)
- Q = Q/H
- DO 200 I = K,M
- 200 A(I,J) = A(I,J) + Q*A(I,K)
- G = 1.0/G
- 210 DO 220 J = K,M
- 220 A(J,K) = A(J,K)*G
- A(K,K) = A(K,K) + 1.0
- L = K
- K = K - 1
- IF (K.NE.0) GOTO 170
-C
-C QR DIAGONALIZATION
- K = N
-C
-C TEST FOR SPLIT
- 230 L = K
- 240 IF (ABS(T(L)).LE.EPS) GOTO 290
- L = L - 1
- IF (ABS(S(L)).GT.EPS) GOTO 240
-C
-C CANCELLATION
- CS = 0.0
- SN = 1.0
- L1 = L
- L = L + 1
- DO 280 I = L,K
- F = SN*T(I)
- T(I) = CS*T(I)
- IF (ABS(F).LE.EPS) GOTO 290
- H = S(I)
- W = SQRT(F*F + H*H)
- S(I) = W
- CS = H/W
- SN = - F/W
- IF (WITHU) CALL ROTATE(A(1,L1),A(1,I), CS, SN, M)
- IF(NP.EQ.N) GO TO 280
- DO 270 J = N1,NP
- Q = A(L1,J)
- R = A(I,J)
- A(L1,J) = Q*CS + R*SN
- 270 A(I,J) = R*CS - Q*SN
- 280 CONTINUE
-C
-C TEST FOR CONVERGENCE
- 290 W = S(K)
- IF (L.EQ.K) GO TO 360
-C
-C ORIGIN SHIFT
- X = S(L)
- Y = S(K-1)
- G = T(K-1)
- H = T(K)
- F = ((Y-W) * (Y+W) + (G-H) * (G+H)) / (2.0*H*Y)
- G=SQRT(F*F+1.0)
- IF (F.LT.0.0) G = - G
- F = ((X - W) * (X+W)+ (Y/(F+G) - H) *H)/X
-C
-C QR STEP
- CS = 1.0
- SN = 1.0
- L1 = L + 1
- DO 350 I = L1,K
- G = T(I)
- Y = S(I)
- H = SN*G
- G = CS*G
- W = SQRT(H*H + F*F)
- T(I-1) = W
- CS = F/W
- SN = H/W
- F = X*CS + G*SN
- G = G*CS - X*SN
- H = Y*SN
- Y = Y*CS
- IF (WITHV) CALL ROTATE(V(1,I-1), V(1,I), CS, SN, N)
- W = SQRT(H*H + F*F)
- S(I-1) = W
- CS = F/W
- SN = H/W
- F = CS*G + SN*Y
- X = CS*Y - SN*G
- IF (WITHU) CALL ROTATE(A(1,I-1), A(1,I), CS, SN, M)
- IF (N.EQ.NP) GO TO 350
- DO 340 J = N1,NP
- Q = A(I-1,J)
- R = A(I,J)
- A(I-1,J) = Q*CS + R*SN
- 340 A(I,J) = R*CS - Q*SN
- 350 CONTINUE
-C
- T(L) = 0.0
- T(K) = F
- S(K) = X
- GO TO 230
-C
-C CONVERGENCE
- 360 IF (W.GE.0.0) GO TO 380
- S(K) = - W
- IF (.NOT.WITHV) GO TO 380
- DO 370 J = 1,N
- 370 V(J,K) = - V(J,K)
- 380 K = K-1
- IF (K.NE.0) GO TO 230
-C
-C SORT SINGULAR VALUES
- DO 450 K = 1,N
- G = -1.0
- DO 390 I = K,N
- IF (S(I).LT.G) GO TO 390
- G = S(I)
- J = I
- 390 CONTINUE
- IF (J.EQ.K) GO TO 450
- S(J) = S(K)
- S(K) = G
- IF (.NOT.WITHV) GO TO 410
- DO 400 I = 1,N
- Q = V(I,J)
- V(I,J) = V(I,K)
- 400 V(I,K) = Q
- 410 IF (.NOT.WITHU) GO TO 430
- DO 420 I = 1,M
- Q = A(I,J)
- A(I,J) = A(I,K)
- 420 A(I,K) = Q
- 430 IF (N.EQ.NP) GO TO 450
- DO 440 I = N1,NP
- Q = A(J,I)
- A(J,I) = A(K,I)
- 440 A(K,I) = Q
- 450 CONTINUE
-C
- RETURN
- END
diff --git a/src/mathlib/gen/obsolete/h100/epsilo.F b/src/mathlib/gen/obsolete/h100/epsilo.F
deleted file mode 100644
index d107649..0000000
--- a/src/mathlib/gen/obsolete/h100/epsilo.F
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: epsilo.F,v 1.1.1.1 1996/04/01 15:03:16 mclareni Exp $
-*
-* $Log: epsilo.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:16 mclareni
-* Mathlib gen
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_gen/pilot.h"
- SUBROUTINE EPSILO(A,M,N,MD,EPS)
-C COMPUTATION OF AN EPSILON-VALUE
-C =====================================================================
- DOUBLE PRECISION A(MD,1)
- EPS = 0.
- DO 2 I = 1, M
- DO 1 K = 1, N
- 1 EPS = EPS + ABS(SNGL(A(I,K)))
- 2 CONTINUE
- EPS = 2.*EPS/(M*N)
- ELOG = LOG10(EPS)
-#if defined(CERNLIB_CDC)
- IEXP=INT(ELOG)-25
-#endif
-#if !defined(CERNLIB_CDC)
- IEXP=INT(ELOG)-14
-#endif
- IF(ELOG.LT.0.) IEXP=IEXP-1
- EPS = 10.**IEXP
- RETURN
- END
diff --git a/src/mathlib/gen/obsolete/h100/findpc.F b/src/mathlib/gen/obsolete/h100/findpc.F
deleted file mode 100644
index 0445208..0000000
--- a/src/mathlib/gen/obsolete/h100/findpc.F
+++ /dev/null
@@ -1,100 +0,0 @@
-*
-* $Id: findpc.F,v 1.1.1.1 1996/04/01 15:03:16 mclareni Exp $
-*
-* $Log: findpc.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:16 mclareni
-* Mathlib gen
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_gen/pilot.h"
- SUBROUTINE FINDPC (A, B, C, Z0, M, N, MD, LR, LC, LCQ, IROW,
- 1 ICOL, IP, KP, KK, Q1, Q2, EPS, IRC)
-C FINDPC FINDS THE PIVOTCOLUMN WHEREBY DEGENERACY IS TAKEN INTO ACCOUNT
-C =====================================================================
-C*NS DOUBLE PRECISION A, B, C, Z0, MAXD, MIND, Q, QQ, Q1, Q2
- DOUBLE PRECISION A, B, C, Z0, MIND, Q, Q1, Q2
- DIMENSION A(MD,1), B(1), C(1), Q1(1), Q2(1)
- INTEGER LR(1), LC(1), LCQ(1), IROW(1), ICOL(1)
-C THE COLUMNS WITH NONNEGATIVE C(K) AND POSITIVE A(IP,K) ARE ASSIGNE
-C WITH LCQ = 1
- MN = M + N
- DO 1 K = 1, N
- 1 LCQ(K) = 0
- DO 5 K = 1, N
- IF(LC(K) .NE. IRC) GOTO 5
- IF(K .EQ. KK) GOTO 5
- IF(ABS(SNGL(A(IP,K))) .LT. EPS) A(IP,K) = 0.
- IF(ABS(SNGL(C(K))) .LT. EPS) C(K) = 0.
- IF(A(IP,K) .LE. 0. .OR. C(K) .LT. 0.) GOTO 5
- LCQ(K) = 1
- Q = C(K)/A(IP,K)
- IF(C(K) .EQ. 0.) Q = 0.
- 5 CONTINUE
- KP = 0
- DO 6 K = 1, N
- 6 KP = KP + LCQ(K)
- IF(KP .EQ. 0) RETURN
-C KP = 0 MEANS THAT NO COLUMN COULD BE FOUND
-C IN THE NEXT SECTION ONLY THE COLUMNS WITH MINIMUM QUOTIENT ARE
-C ASSIGNED WITH LCQ = 1
- MIND = Q
- DO 11 J = 1, 2
- DO 11 K = 1, N
- IF(LCQ(K) .EQ. 0) GOTO 11
- Q = C(K)/A(IP,K)
- IF(C(K) .EQ. 0.) Q = 0.
- IF(Q .GT. MIND) GOTO 10
- MIND = Q
- KP = K
- GOTO 11
- 10 LCQ(K) = 0
- 11 CONTINUE
- 12 IND = 0
- DO 15 K = 1, N
- 15 IND = IND + LCQ(K)
- IF(IND .EQ. 1) RETURN
-C IN THE NEXT SECTION TWO OF THE POSSIBLE COLUMNS ARE PICKED OUT
- KP1 = 0
- DO 20 K = 1, N
- IF(LCQ(K) .EQ. 0) GOTO 20
- IF(KP1 .EQ. 0) KP1 = K
- KP2 = K
- 20 CONTINUE
-C HERE IT IS DETERMINED WHICH OF TWO COLUMNS WITH EQUAL QUOTIENT
-C QUALIFIES AS PIVOTCOLUMN
- DO 25 J = 1, MN
- Q1(J) = 0.
- 25 Q2(J) = 0.
- J = ICOL(KP1)
- Q1(J) = 1.
- J = ICOL(KP2)
- Q2(J) = 1.
- DO 30 I = 1, M
- IF(LR(I) .NE. IRC) GOTO 30
- J = IROW(I)
- IF(ABS(SNGL(A(I,KP1))) .LT. EPS) A(I,KP1) = 0.
- IF(ABS(SNGL(A(I,KP2))) .LT. EPS) A(I,KP2) = 0.
- Q1(J) = A(I,KP1)
- Q2(J) = A(I,KP2)
- 30 CONTINUE
- DO 35 J = 1, MN
- IF(J .NE. IROW(IP)) GOTO 31
- Q1(J) = 1.
- Q2(J) = 1.
- GOTO 35
- 31 IF(Q1(J) .NE. 0.) Q1(J) = Q1(J)/A(IP,KP1)
- IF(Q2(J) .NE. 0.) Q2(J) = Q2(J)/A(IP,KP2)
- 35 CONTINUE
- DO 50 J = 1, MN
- IF(Q1(J) .EQ. Q2(J)) GOTO 50
- IF(Q1(J) .GT. Q2(J)) GOTO 40
- LCQ(KP2) = 0
- KP = KP1
- GOTO 12
- 40 LCQ(KP1) = 0
- KP = KP2
- GOTO 12
- 50 CONTINUE
- RETURN
- END
diff --git a/src/mathlib/gen/obsolete/h100/pivot.F b/src/mathlib/gen/obsolete/h100/pivot.F
deleted file mode 100644
index 9a0a7f2..0000000
--- a/src/mathlib/gen/obsolete/h100/pivot.F
+++ /dev/null
@@ -1,62 +0,0 @@
-*
-* $Id: pivot.F,v 1.1.1.1 1996/04/01 15:03:16 mclareni Exp $
-*
-* $Log: pivot.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:16 mclareni
-* Mathlib gen
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_gen/pilot.h"
- SUBROUTINE PIVOT (A, B, C, Z0, M, N, MD, IP, KP, IROW, ICOL, EPS)
-C PIVOT EXCHANGES A BASIC AND A NONBASIC VARIABLE AND TRANSFORMS THE
-C WHOLE TABLEAU
-C =====================================================================
- DOUBLE PRECISION A, B, C, Z0
- DIMENSION A(MD,1), B(1), C(1), IROW(1), ICOL(1)
- A(IP,KP) = DBLE(1.)/A(IP,KP)
- DO 1 I = 1, M
- IF(I .EQ. IP) GOTO 1
- IF(A(I,KP) .NE. 0.) A(I,KP) = A(I,KP)*A(IP,KP)
- 1 CONTINUE
- IF(C(KP) .NE. 0.) C(KP) = C(KP)*A(IP,KP)
- DO 3 I = 1, M
- IF(I .EQ. IP) GOTO 3
- DO 2 K = 1, N
- IF(K .EQ. KP) GOTO 2
- IF(A(IP,K) .EQ. 0. .OR. A(I,KP) .EQ. 0.) GOTO 2
- A(I,K) = A(I,K) - A(IP,K)*A(I,KP)
- 2 CONTINUE
- IF(B(IP) .EQ. 0. .OR. A(I,KP) .EQ. 0.) GOTO 3
- B(I) = B(I) - B(IP)*A(I,KP)
- 3 CONTINUE
- DO 4 K = 1, N
- IF(K .EQ. KP) GOTO 4
- IF(A(IP,K) .EQ. 0. .OR. C(KP) .EQ. 0.) GOTO 4
- C(K) = C(K) - A(IP,K)*C(KP)
- 4 CONTINUE
- IF(B(IP) .EQ. 0. .OR. C(KP) .EQ. 0.) GOTO 5
- Z0 = Z0 - B(IP)*C(KP)
- 5 DO 6 K = 1, N
- IF(K .EQ. KP) GOTO 6
- IF(A(IP,K) .NE. 0.) A(IP,K) = -A(IP,K)*A(IP,KP)
- 6 CONTINUE
- IF(B(IP) .NE. 0.) B(IP) = -B(IP)*A(IP,KP)
-C CALCULATION OF THE NEW EPSILON-VALUE
- CALL EPSILO(A,M,N,MD,EPS)
-C IF THE ABSOLUTE VALUE OF AN ELEMENT IS LESS THAN EPSILON, THEN
-C ITS VALUE IS ZERO
- DO 15 I = 1, M
- DO 10 K = 1, N
- 10 IF(ABS(SNGL(A(I,K))) .LT. EPS) A(I,K) = 0.
- 15 CONTINUE
- DO 20 I = 1, M
- 20 IF(ABS(SNGL(B(I))) .LT. EPS) B(I) = 0.
- DO 25 K = 1, N
- 25 IF(ABS(SNGL(C(K))) .LT. EPS) C(K) = 0.
- IF(ABS(SNGL(Z0)) .LT. EPS) Z0 = 0.
- IR = IROW(IP)
- IROW(IP) = ICOL(KP)
- ICOL(KP) = IR
- RETURN
- END
diff --git a/src/mathlib/gen/obsolete/h100/simple.F b/src/mathlib/gen/obsolete/h100/simple.F
deleted file mode 100644
index 8072443..0000000
--- a/src/mathlib/gen/obsolete/h100/simple.F
+++ /dev/null
@@ -1,79 +0,0 @@
-*
-* $Id: simple.F,v 1.1.1.1 1996/04/01 15:03:16 mclareni Exp $
-*
-* $Log: simple.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:16 mclareni
-* Mathlib gen
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_gen/pilot.h"
- SUBROUTINE SIMPLE(A,B,C,Z0,MN,MD,IROW,ICOL,LCV,Q,MODE,IOPT)
-C =====================================================================
-C INTERFACE ROUTINE ARRANGING THE OUTPUT
-C THE VALUES OF THE VARIABLES AND SLACK-VARIABLES ARE STORED IN THE FIR
-C M+N LOCATIONS OF VECTOR Q
-C =====================================================================
-C IOPT = 0 NO PRINTED OUTPUT
-C IOPT = 1 OUTPUT OF THE RESULTS ON A NEW PAGE
-C IOPT = 2 OUTPUT OF THE RESULTS ON THE NEXT NEW HALF OF A PAGE
-C IOPT = 3 OUTPUT OF THE RESULTS ON THE NEXT NEW THIRD OF A PAGE
-C IOPT = 4 OUTPUT OF THE RESULTS ON THE NEXT NEW QUARTER OF A PAGE
- DOUBLE PRECISION A, B, C, Z0, Q
- DIMENSION A(MD,*), B(*), C(*), Q(*), IROW(*), ICOL(*),
- 1 LCV(*), MN(*), F(4)
- DATA F/1H1,1H4,1H5,1H6/
- M1 = MN(1)
- M = MN(2)
- N1 = MN(3)
- N = MN(4)
- LC = M+1
- LCQ = LC+N
- IQ = M+N+1
- CALL SPLX (A,B,C,Z0,M1,M,N1,N,MD,IROW,ICOL,LCV,LCV(LC),LCV(LCQ),
- 1 Q,Q(IQ),MODE)
- IF(IOPT.LE.0 .OR. IOPT.GT.4) GO TO 5
- WRITE(6,100)F(IOPT)
- IF(MODE .EQ. 0) WRITE(6,110)
- IF(MODE .EQ. 1) WRITE(6,111)
- IF(MODE .EQ. 2) WRITE(6,112)
- IF(MODE .EQ. 3) WRITE(6,113)
- IF(MODE .EQ. 1 .OR. MODE .EQ. 2) RETURN
- 5 DO 10 I = 1, M
- II = IROW(I)
- 10 Q(II) = 0.
- DO 20 K = 1, N
- II = ICOL(K)
- 20 Q(II) = C(K)
- IF(IOPT .EQ. 0) RETURN
- WRITE(6,120)
- IF(M-N) 30, 30, 40
- 30 DO 35 I = 1, M
- II = I+M
- 35 WRITE(6,125) I, Q(I), II, Q(II)
- IF(M .EQ. N) GOTO 50
- M1 = M+1
- DO 37 I = M1, N
- II = I+M
- 37 WRITE(6,126) II, Q(II)
- GOTO 50
- 40 DO 45 I = 1, N
- II = I+M
- 45 WRITE(6,125) I, Q(I), II, Q(II)
- N1 = N+1
- DO 47 I = N1, M
- 47 WRITE(6,127) I, Q(I)
- 50 WRITE(6,130) Z0
- RETURN
- 100 FORMAT(A1/' SOLUTION OF THE MAXIMIZATION PROBLEM'/'0',120('-')//)
- 110 FORMAT(' THE PROBLEM HAS EXACTLY ONE FINITE MAXIMUM SOLUTION'//)
- 111 FORMAT(' THE PROBLEM HAS NO FINITE SOLUTION (MAX = INFINITE)')
- 112 FORMAT(' NO FEASIBLE INITIAL SOLUTION FOR THE PROBLEM EXISTS')
- 113 FORMAT(' MORE THAN ONE MAXIMUM SOLUTION EXISTS'//)
- 120 FORMAT('0VARIABLES',41X,'SLACK-VARIABLES'//1X,2('INDEX',10X,
- + 'VALUE',30X)/)
- 125 FORMAT(1X,2(I4,D26.15,20X))
- 126 FORMAT(51X,I4,D26.15)
- 127 FORMAT(1X,I4,D26.15)
- 130 FORMAT('0MAXIMUM VALUE OF THE OBJECTIVE FUNCTION = ',D22.15)
- END
diff --git a/src/mathlib/gen/obsolete/h100/splx.F b/src/mathlib/gen/obsolete/h100/splx.F
deleted file mode 100644
index 5c21668..0000000
--- a/src/mathlib/gen/obsolete/h100/splx.F
+++ /dev/null
@@ -1,402 +0,0 @@
-*
-* $Id: splx.F,v 1.1.1.1 1996/04/01 15:03:16 mclareni Exp $
-*
-* $Log: splx.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:16 mclareni
-* Mathlib gen
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_gen/pilot.h"
- SUBROUTINE SPLX (A,B,C,Z0,M1,M,N1,N,MD,IROW,ICOL,LR,LC,LCQ,
- 1 Q1,Q2,MODE)
-C =====================================================================
-C ROUTINE FOR THE OPTIMALIZATION OF A LINEAR PROGRAM USING THE SIMPLEX
-C DEGENERACIES ARE TAKEN INTO ACCOUNT.
-C CONSTRAINTS MAY BE EITHER INEQUALITIES OR EQUALITIES.
-C THE VARIABLES MAY BE RESTRICTED OR UNRESTRICTED.
-C =====================================================================
-C MODE = 0 EXACTLY ONE FINITE MAXIMUM SOLUTION
-C MODE = 1 THE PROBLEM HAS NO FINITE SOLUTION (MAX = INFINITE)
-C MODE = 2 NO FEASIBLE INITIAL SOLUTION EXISTS
-C MODE = 3 THERE IS MORE THAN ONE FINITE MAXIMUM SOLUTION
- DOUBLE PRECISION A, B, C, Z0, MAXD, MIND, Q, QQ, Q1, Q2
- DIMENSION A(MD,1), B(1), C(1), Q1(1), Q2(1)
- INTEGER IROW(1), ICOL(1), LR(1), LC(1), LCQ(1)
-C COMPUTATION OF THE EPSILON-VALUE
-C =====================================================================
- CALL EPSILO(A,M,N,MD,EPS)
-C INITIALIZATION OF THE INDEX LIST
-C =====================================================================
- M2 = M - M1
- N2 = N - N1
- IF(M1 .EQ. 0) GOTO 12
- DO 10 I = 1, M1
- IROW(I) = I
- 10 LR(I) = 0
- IF(M1 .EQ. M) GOTO 15
- 12 MM1 = M1 + 1
- DO 11 I = MM1, M
- IROW(I) = I
- 11 LR(I) = 1
- 15 IF(N1 .EQ. 0) GOTO 20
- DO 16 K = 1, N1
- ICOL(K) = M + K
- 16 LC(K) = 0
- IF(N1 .EQ. N) GOTO 18
- 20 NN1 = N1 + 1
- DO 17 K = NN1, N
- ICOL(K) = M + K
- 17 LC(K) = -1
- 18 DO 19 K = 1, N
- 19 LCQ(K) = 0
-C LR (RESP. LC) = 0 X .GE. 0.
-C LR (RESP. LC) = -1 X .EQ. 0.
-C LR (RESP. LC) = 1 X IS UNRESTRICTED
-C LR (RESP. LC) = 2 X IS LINEAR DEPENDENT WITHOUT INFLUENCE ON
-C THE OBJECTIVE FUNCTION
-C LR = -2 X IS UNRESTRICTED AND CANNOT BE ELIMINATED
-C ELIMINATION OF THE EQUALITY-CONSTRAINTS OUT OF THE BASIS
-C =====================================================================
-C*UL 50 IF(N1 .EQ. N) GOTO 100
- IF(N1 .EQ. N) GOTO 100
-C IF THERE ARE NO EQUALITY-CONSTRAINTS, THE SECTION UP TO 100 CAN
-C BE BYPASSED.
- 55 KP = 0
- DO 60 K = 1, N
- 60 IF(LC(K) .EQ. -1) KP = K
- IF(KP .EQ. 0) GOTO 80
-C IF KP = 0, NO MORE EQUALITY-CONSTRAINTS IN THE BASIS
- MAXD = 0.
- DO 61 I = 1, M
- IF(LR(I) .EQ. -1) GOTO 61
- IF(ABS(A(I,KP)) .LT. MAXD) GOTO 61
- MAXD = ABS(A(I,KP))
- IP = I
- 61 CONTINUE
- IF(SNGL(MAXD) .LT. EPS) MAXD = 0.
- IF(MAXD .NE. 0.) GOTO 70
- IF(ABS(SNGL(C(KP))) .LT. EPS) C(KP) = 0.
- IF(C(KP) .NE. 0.) GOTO 65
- LC(KP) = 1
- GOTO 55
- 65 MODE = 2
- RETURN
-C THE HOMOGENEOUS PART OF AT LEAST TWO EQUATIONS IS LINEAR DEPENDENT
-C WHEREAS THE INHOMOGENEOUS PART IS CONTRADICTORY.
- 70 CALL PIVOT (A, B, C, Z0, M, N, MD, IP, KP, IROW, ICOL, EPS)
- LC(KP) = LR(IP)
- LR(IP) = -1
- GOTO 55
-C CHECK WHETHER THE NONBASIC VARIABLES CONSIST ONLY OF EQUATION-VARI
- 80 IND = 0
- DO 81 I = 1, M
- 81 IF(LR(I) .NE. -1) IND = IND + 1
- IF(IND .NE. 0) GOTO 100
-C IF THE NONBASIC VARIABLES ARE ONLY EQUATION-VARIABLES, THERE IS NO
-C CHECKED, WHETHER NO CONSTRAINT IS VIOLATED
- MIND = 0.
- DO 85 K = 1, N
- IF(LC(K) .EQ. 1) GOTO 85
- IF(ABS(SNGL(C(K))) .LT. EPS) C(K) = 0.
- IF(C(K) .GE. 0.) GOTO 85
- IF(C(K) .LT. MIND) MIND = C(K)
- 85 CONTINUE
- IF(MIND .LT. 0.) GOTO 90
- MODE = 0
- RETURN
- 90 MODE = 2
- RETURN
-C ELIMINATION OF THE UNRESTRICTED VARIABLES
-C =====================================================================
- 100 IF(M1 .EQ. M) GOTO 200
- 101 IP = 0
- DO 105 I = 1, M
- 105 IF(LR(I) .EQ. 1) IP = I
- IF(IP .EQ. 0) GOTO 200
-C IF THE PROBLEM CONTAINS NO FREE VARIABLES OR IF THEY HAVE ALREADY
-C BEEN EXCHANGED WITH EQUATIONS, THE FOLLOWING SECTION UP TO 200
-C CAN BE BYPASSED
-C CHECK IS NOW MADE WHETHER THE PRESENT TABLEAU REPRESENTS A
-C FEASIBLE INITIAL SOLUTION
- MAXD = 0.
- MIND = 0.
- DO 110 K = 1, N
- IF(LC(K) .EQ. 1) GOTO 110
- IF(ABS(SNGL(C(K))) .LT. EPS) C(K) = 0.
- IF(C(K) .LT. MIND) MIND = C(K)
- IF(C(K) .GT. MAXD) MAXD = C(K)
- 110 CONTINUE
- IND = 0
- IF(MIND .GE. 0.) IND = 1
- Q = MAXD
-C IF THE TABLEAU ALREADY REPRESENTS AN INITIAL SOLUTION (IND = 1),
-C THE ELIMINATION OF THE REMAINING UNRESTRICTED VARIABLES IS DONE
-C BY A SPECIAL ALGORITHM.
- MAXD = 0.
- MIND = 0.
- DO 112 K = 1, N
- IF(LC(K) .EQ. 1) GOTO 112
- IF(ABS(SNGL(A(IP,K))) .LT. EPS) A(IP,K) = 0.
- IF(A(IP,K) .LT. MAXD) GOTO 111
- MAXD = A(IP,K)
- KPMAX = K
- 111 IF(A(IP,K) .GT. MIND) GOTO 112
- MIND = A(IP,K)
- KPMIN = K
- 112 CONTINUE
- IF(MAXD .EQ. 0. .AND. MIND .EQ. 0.) GOTO 130
- IF(IND .EQ. 0) GOTO 120
- IF(ABS(SNGL(B(IP))) .LT. EPS) B(IP) = 0.
- IF(B(IP) .LT. 0. .AND. MAXD .GT. 0.) GOTO 140
- IF(B(IP) .GT. 0. .AND. MIND . LT. 0.) GOTO 160
- IF(B(IP) .EQ. 0.) GOTO 180
- 120 IF(MAXD .GE. ABS(MIND)) KP = KPMAX
- IF(MAXD .LT. ABS(MIND)) KP = KPMIN
- 125 CALL PIVOT (A, B, C, Z0, M, N, MD, IP, KP, IROW, ICOL, EPS)
- LC(KP) = 1
- LR(IP) = 0
- GOTO 101
-C IF ALL THE PIVOTELEMENTS FOR THE FREE VARIABLE ARE ZERO, THIS
-C VARIABLE HAS TO REMAIN OUT OF THE BASIS. IT IS ASSIGNED WITH LR =
- 130 LR(IP) = -2
- GOTO 101
- 140 Q = Q/MAXD
- DO 150 K = 1, N
- IF(LC(K) .EQ. 1) GOTO 150
- IF(A(IP,K) .LE. 0.) GOTO 150
- QQ = C(K)/A(IP,K)
- IF(QQ .GT. Q) GOTO 150
- Q = QQ
- KP = K
- 150 CONTINUE
- GOTO 125
- 160 Q = Q/MIND
- DO 170 K = 1, N
- IF(LC(K) .EQ. 1) GOTO 170
- IF(A(IP,K) .GE. 0.) GOTO 170
- QQ = C(K)/A(IP,K)
- IF(QQ .LT. Q) GOTO 170
- Q = QQ
- KP = K
- 170 CONTINUE
- GOTO 125
- 180 Q = Q/MAX(MAXD,ABS(MIND))
- DO 190 K = 1, N
- IF(LC(K) .EQ. 1) GOTO 190
- IF(A(IP,K) .EQ. 0.) GOTO 190
- QQ = ABS(C(K)/A(IP,K))
- IF(QQ .GT. Q) GOTO 190
- Q = QQ
- KP = K
- 190 CONTINUE
- GOTO 125
-C COMPUTATION OF A FEASIBLE INITIAL SOLUTION USING THE MULTIPHASE-METHO
-C =====================================================================
- 200 IF(M1 .EQ. M .AND. N1 .EQ. N) GOTO 250
- KP = 0
- DO 201 K = 1, N
- 201 IF(LC(K) .EQ. 0) KP = KP + 1
- IF(KP .NE. 0) GOTO 210
- IP = 0
- DO 202 I = 1, M
- 202 IF(LR(I) .NE. -1) IP = IP + 1
- IF(IP .NE. 0) GOTO 205
- MODE = 0
- RETURN
- 205 L1 = 0
- L2 = 0
- L3 = 0
- DO 206 I = 1, M
- IF(LR(I) .EQ. -1) GOTO 206
- IF(ABS(SNGL(B(I))) .LT. EPS) B(I) = 0.
- IF(LR(I) .EQ. 0 .AND. B(I) .LT. 0.) L3 = 1
- IF(LR(I) .EQ. 0 .AND. B(I) .EQ. 0.) L2 = 1
- IF(LR(I) .EQ. 0 .AND. B(I) .GT. 0.) L1 = 1
- IF(LR(I) .EQ. -2 .AND. B(I) .NE. 0.) L3 = 1
- IF(LR(I) .EQ. -2 .AND. B(I) .EQ. 0.) L2 = 1
- 206 CONTINUE
- IF(L1 .EQ. 1) MODE = 0
- IF(L2 .EQ. 1) MODE = 3
- IF(L3 .EQ. 1) MODE = 1
- RETURN
-C SINCE THERE ARE ONLY UNRESTRICTED VARIABLES IN THE BASIS, THE
-C FINAL TABLEAU HAS BEEN OBTAINED
- 210 IP = 0
- DO 211 I = 1, M
- 211 IF(LR(I) .EQ. 0) IP = IP + 1
- IF(IP .NE. 0) GOTO 250
- MIND = 0.
- DO 212 K = 1, N
- IF(LC(K) .EQ. 1) GOTO 212
- IF(ABS(SNGL(C(K))) .LT. EPS) C(K) = 0.
- IF(C(K) .LT. MIND) MIND = C(K)
- 212 CONTINUE
- IF(MIND .GE. 0.) GOTO 215
- MODE = 2
- RETURN
- 215 IP = 0
- DO 216 I = 1, M
- 216 IF(LR(I) .EQ. -2) IP = IP + 1
- IF(IP .NE. 0) GOTO 220
- MODE = 0
- RETURN
- 220 L1 = 0
- L2 = 0
- DO 225 I = 1, M
- IF(LR(I) .EQ. -1) GOTO 225
- IF(ABS(SNGL(B(I))) .LT. EPS) B(I) = 0.
- IF(B(I) .NE. 0.) L1 = 1
- IF(B(I) .EQ. 0.) L2 = 1
- 225 CONTINUE
- IF(L2 .EQ. 1) MODE = 3
- IF(L1 .EQ. 1) MODE = 1
- RETURN
-C SINCE THE VARIABLES OUT OF THE BASIS ARE EITHER UNRESTRICTED OR
-C EQUAL TO ZERO, THEY CANNOT BE EXCHANGED. THE FINAL TABLEAU WAS
-C THEREFORE OBTAINED.
-C IN THE FOLLOWING SECTION THERE IS CHECKED WHETHER THE TABLEAU
-C ALREADY REPRESENTS AN INITIAL SOLUTION
- 250 MIND = 0.
- DO 255 K = 1, N
- IF(LC(K) .EQ. 1) GOTO 255
- IF(ABS(SNGL(C(K))) .LT. EPS) C(K) = 0.
- IF(C(K) .GT. MIND) GOTO 255
- MIND = C(K)
- KK = K
- 255 CONTINUE
- IF(MIND .GE. 0.) GOTO 500
-C IF ALL THE C(K) BELONGING TO CONSTRAINTS X .GE. 0. ARE NONNEGATI
-C AN INITIAL SOLUTION HAS BEEN FOUND.
-C ATHERWISE THE COLUMN WITH INDEX KK BECOMES NEW OBJECTIVE FUNCTION
-C WHICH HAS TO BE MAXIMIZED.
- 270 MIND=0.
- DO 300 I = 1, M
- IF(LR(I) .NE. 0) GOTO 300
- IF(ABS(SNGL(A(I,KK))) .LT. EPS) A(I,KK) = 0.
- IF(A(I,KK) .GT. MIND) GOTO 300
- MIND = A(I,KK)
- IP = I
- 300 CONTINUE
- IF(MIND .LT. 0.) GOTO 310
- MODE = 2
- RETURN
- 310 CALL FINDPC (A, B, C, Z0, M, N, MD, LR, LC, LCQ, IROW, ICOL,
- 1 IP, KP, KK, Q1, Q2, EPS, 0)
- IF(KP .EQ. 0) KP = KK
- CALL PIVOT (A, B, C, Z0, M, N, MD, IP, KP, IROW, ICOL, EPS)
- IF(ABS(SNGL(C(KK))).LT.EPS) C(KK)=0.
- IF(C(KK).LT.0.) GO TO 270
- GOTO 250
-C SINCE AN INITIAL SOLUTION HAS BEEN FOUND, SIMPLEX ALGORITHM MAY NOW S
-C =====================================================================
-C IT IS CHECKED WHETHER THE MAXIMUM IS ALREADY OBTAINED
- 500 IFALL = 0
- DO 510 I = 1, M
- IF(LR(I) .NE. -2) GOTO 510
- IF(ABS(SNGL(B(I))) .LT. EPS) B(I) = 0.
- IF(B(I) .EQ. 0.) GOTO 505
- MODE = 1
- RETURN
- 505 IFALL = 1
- 510 CONTINUE
-C IFALL = 1 MEANS THAT THERE IS A FREE VARIABLE OUT OF THE BASIS
-C WHICH DOES NOT INFLUENCE THE MAXIMUM PROBLEM (MODE = 3)
-C THE NEGATIVE B(I) ARE NOW PICKED OUT
-C*UL 550 IP = 0
- IP = 0
- DO 555 I = 1, M
- IF(LR(I) .NE. 0) GOTO 555
- IF(ABS(SNGL(B(I))) .LT. EPS) B(I) = 0.
- IF(B(I) .LT. 0.) IP = I
- 555 CONTINUE
- IF(IP .NE. 0) GOTO 600
-C SINCE ALL THE COEFFICIENTS B(I) ARE NONNEGATIVE, THE FINAL TABLEAU
-C HAS BEEN OBTAINED
-C THERE IS NOW CHECKED, WHETHER THE SOLUTION IS UNIQUE OR NOT.
- IF(IFALL .EQ. 0) GOTO 560
- MODE = 3
- RETURN
- 560 IND = 0
- DO 562 K = 1, N
- IF(LC(K) .NE. 0) GOTO 562
- IF(ABS(SNGL(C(K))) .LT. EPS) C(K) = 0.
- IF(C(K) .NE. 0.) GOTO 562
- IND = IND + 1
- LC(K) = 2
- 562 CONTINUE
- IFALL = IND
- IND = 0
- DO 565 I = 1, M
- IF(LR(I) .NE. 0) GOTO 565
- IF(ABS(SNGL(B(I))) .LT. EPS) B(I) = 0.
- IF(B(I) .NE. 0.) GOTO 565
- IND = IND + 1
- LR(I) = 2
- 565 CONTINUE
- IF(IND .NE. 0) GOTO 570
- MODE = 0
- RETURN
- 570 IF(IFALL .NE. 0) GOTO 575
- MODE = 3
- RETURN
-C SINCE IN THE FINAL TABLEAU THERE ARE SOME C(K) = 0. AND SOME B(I)
-C IT MUST BE CHECKED, WHETHER THE SOLUTION IS UNIQUE OR NOT.
- 575 DO 577 I = 1, M
- IF(LR(I) .NE. 2) GOTO 577
- MAXD = 0.
- DO 576 K = 1, N
- IF(LC(K) .NE. 2) GOTO 576
- IF(ABS(SNGL(A(I,K))) .LT. EPS) A(I,K) = 0.
- IF(A(I,K) .GT. MAXD) MAXD = A(I,K)
- 576 CONTINUE
- IF(MAXD .GT. 0.) GOTO 577
- MODE = 3
- RETURN
- 577 CONTINUE
- DO 581 K = 1, N
- IF(LC(K) .NE. 2) GOTO 581
- MIND = 1.
- DO 578 I = 1, M
- IF(LR(I) .NE. 2) GOTO 578
- IF(A(I,K) .LT. MIND) MIND = A(I,K)
- 578 CONTINUE
- IF(MIND .LT. 0.) GOTO 581
- IF(MIND .EQ. 0.) GOTO 579
- MODE = 0
- RETURN
- 579 DO 580 I = 1, M
- IF(LR(I) .NE. 2) GOTO 580
- IF(A(I,K) .GT. 0.) LR(I) = -2
- 580 CONTINUE
- LC(K) = 1
- 581 CONTINUE
- NC = 0
- DO 582 K = 1, N
- IF(LC(K) .NE. 2) GOTO 582
- NC = NC + 1
- 582 CONTINUE
- NR = 0
- DO 583 I = 1, M
- IF(LR(I) .NE. 2) GOTO 583
- NR = NR + 1
- IP = I
- 583 CONTINUE
- IF(NR .NE. 0 .AND. NC .NE. 0) GOTO 585
- MODE = 0
- RETURN
- 585 CALL FINDPC (A, B, C, Z0, M, N, MD, LR, LC, LCQ, IROW, ICOL,
- 1 IP, KP, 0, Q1, Q2, EPS, 2)
- IF(KP .NE. 0) GOTO 590
- MODE = 3
- RETURN
- 590 CALL PIVOT (A, B, C, Z0, M, N, MD, IP, KP, IROW, ICOL, EPS)
- GOTO 575
- 600 CALL FINDPC (A, B, C, Z0, M, N, MD, LR, LC, LCQ, IROW, ICOL,
- 1 IP, KP, 0, Q1, Q2, EPS, 0)
- IF(KP .NE. 0) GOTO 650
- MODE = 1
- RETURN
- 650 CALL PIVOT (A, B, C, Z0, M, N, MD, IP, KP, IROW, ICOL, EPS)
- GOTO 500
- END
diff --git a/src/mathlib/gen/obsolete/h300/assign.F b/src/mathlib/gen/obsolete/h300/assign.F
deleted file mode 100644
index bd7a017..0000000
--- a/src/mathlib/gen/obsolete/h300/assign.F
+++ /dev/null
@@ -1,267 +0,0 @@
-*
-* $Id: assign.F,v 1.1.1.1 1996/04/01 15:03:17 mclareni Exp $
-*
-* $Log: assign.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:17 mclareni
-* Mathlib gen
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_gen/pilot.h"
- SUBROUTINE ASSIGN(A,N,M,IDIM1,K,TOTAL,MODE)
-C
- DIMENSION A(IDIM1,1),K(N)
- DIMENSION L(100)
- INTEGER CBL, CL, CL0, RL, RS, SW, P
- INTEGER C(100), CB(100), LAMBDA(100), MU(100), R(100)
- EQUIVALENCE (R(1),NEWK),(CB(1),NEWL)
-C
-C ******************************************************************
-C
-C A IS A TWO-DIMENSIONAL REAL ARRAY CONTAINING A RECTAN-
-C GULAR MATRIX. THIS MATRIX IS DESTROYED BY THE PROGRAM
-C N (INTEGER) IS THE NUMBER OF ROWS IN THE MATRIX.
-C M (INTEGER) IS THE NUMBER OF COLUMNS IN THE MATRIX.
-C IDIM1 (INT.) IS THE FIRST DIMENSION PARAMETER OF A AS DECLARED
-C IN THE CALLING PROGRAM.
-C K (INTEGER) IS A ONE-DIMENSIONAL ARRAY.
-C TOTAL IS A REAL VARIABLE.
-C MODE (INT.) MUST HAVE THE VALUE 1 OR 2
-C
-C MODE = 1
-C --------
-C
-C K(1),K(2),...,K(N) ARE ASSIGNED INTEGER VALUES WHICH
-C MINIMIZE
-C A(1,K(1))+A(2,K(2))+...+A(I,K(I))+...+A(N,K(N)) (1)
-C
-C AND TOTAL IS SET EQUAL TO THE MINIMUM VALUE.
-C
-C IF M .GT. N , THE K(I) ARE DISTINCT AND ARE A SUBSET
-C OF THE INTEGERS 1,2,...,M.
-C
-C IF M = N , THE K(I) ARE A PERMUTATION OF THE INTEGERS
-C 1,2,...,N.
-C
-C IF M .LT. N , THE SET OF K(I) CONSISTS OF SOME
-C PERMUTATION OF THE INTEGERS 1,2,...,M , INTERSPERCED WITH N-M
-C ZEROS. THE PERMUTATION AND THE POSITIONS OF ZEROS ARE CHOOSEN IN
-C SUCH A WAY AS TO MINIMIZE THE SUM (1) WITH THE CONVENTION THAT
-C A(I,0) IS TO BE TAKEN EQUAL TO ZERO.
-C
-C MODE = 2
-C --------
-C
-C K(1),K(2),...,K(M) ARE ASSIGNED INTEGER VALUES WHICH
-C MINIMIZE
-C A(K(1),1)+A(K(2),2)+...+A(K(J),J)+...+A(K(M),M) (2)
-C
-C AND TOTAL IS SET EQUAL TO THE MINIMUM VALUE. IF M .GT. N , M-N
-C OF THE K(J) ARE SET EQUAL TO ZERO , WITH THE CONVENTION THAT
-C A(0,J) IS TO BE TAKEN EQUAL TO ZERO.
-C
-C METHOD
-C ------
-C
-C THE PROGRAM IS BASED ON THE ALGOL PROCEDURE OF
-C SILVER (1960) WHICH USES THE ASSIGNMENT ALGORITHM OF
-C MUNKRES (1957). SILVER"S PROCEDURE HAS BEEN EXTENDED TO HANDLE THE
-C CASE M .NE. N.
-C
-C TIMING
-C ------
-C
-C APPROXIMATE TIMES ARE GIVEN BY THE FOLLOWING FORMULAS
-C
-C CDC 6600 0.02*MAX*MIN**2 MILLISECONDS
-C
-C CDC 6500 0.05*MAX*MIN**2 MILLISECONDS
-C
-C WHERE MAX = MAX(N,M) AND MIN = MIN(N,M) .
-C
-C ******************************************************************
-C
-C-----INITIALIZE
-C
- IMAX=MAX(N,M)
- IMIN=MIN(N,M)
- TOTAL=0.0
- IF(N.GT.M) GO TO 100
-C
- DO 1 I=1,N
- RMIN=A(I,1)
-C
- DO 2 J=1,M
- RMIN=MIN(RMIN,A(I,J))
- 2 CONTINUE
-C
- TOTAL=TOTAL+RMIN
-C
- DO 3 J=1,M
- A(I,J)=A(I,J)-RMIN
- 3 CONTINUE
-C
- 1 CONTINUE
-C
- IF(N.LT.M) GO TO 110
- 100 DO 4 J=1,M
- RMIN=A(1,J)
-C
- DO 5 I=1,N
- RMIN=MIN(RMIN,A(I,J))
- 5 CONTINUE
-C
- TOTAL=TOTAL+RMIN
-C
- DO 7 I=1,N
- A(I,J)=A(I,J)-RMIN
- 7 CONTINUE
-C
- 4 CONTINUE
-C
- 110 DO 8 I=1,IMAX
- K(I)=0
- L(I)=0
- 8 CONTINUE
-C
- DO 12 I=1,N
-C
- DO 13 J=1,M
- IF(A(I,J)+L(J).NE.0.) GO TO 13
- K(I)=J
- L(J)=I
- GO TO 12
- 13 CONTINUE
-C
- 12 CONTINUE
-C
-C-----(START) START LABELLING
- 10 IFLAG=N
- RL=0
- CL=0
- RS=1
-C
- DO 11 I=1,N
- MU(I)=0
- IF(K(I).NE.0) GO TO 11
- RL=RL+1
- R(RL)=I
- MU(I)=-1
- IFLAG=IFLAG-1
- 11 CONTINUE
-C
- IF(IFLAG.EQ.IMIN) GO TO 70
-C
- DO 14 J=1,M
- LAMBDA(J)=0
- 14 CONTINUE
-C
-C-----(LABEL) LABEL AND SCAN
- 30 I=R(RS)
- RS=RS+1
-C
- DO 31 J=1,M
- IF(A(I,J)+LAMBDA(J).NE.0.) GO TO 31
- LAMBDA(J)=I
- CL=CL+1
- C(CL)=J
- NEWSUB=L(J)
- IF(NEWSUB.EQ.0) GO TO 60
- RL=RL+1
- R(RL)=NEWSUB
- MU(NEWSUB)=I
- 31 CONTINUE
-C
- IF(RS.LE.RL) GO TO 30
-C
-C-----RENORMALIZE
-C*UL 40 SW=1
- SW=1
- CL0=CL
- CBL=0
-C
- DO 41 J=1,M
- IF(LAMBDA(J).NE.0) GO TO 41
- CBL=CBL+1
- CB(CBL)=J
- 41 CONTINUE
-C
- RMIN=A(NEWK,NEWL)
-C
- DO 42 I=1,RL
-C
- DO 43 J=1,CBL
- NEW1=R(I)
- NEW2=CB(J)
- RMIN=MIN(RMIN,A(NEW1,NEW2))
- 43 CONTINUE
-C
- 42 CONTINUE
-C
- TOTAL=TOTAL+RMIN*(RL+CBL-IMAX)
-C
- DO 44 I=1,N
- IF(MU(I).NE.0) GO TO 46
-C
- IF(CL0.LT.1) GO TO 44
- DO 49 P=1,CL0
- NEWSUB=C(P)
- A(I,NEWSUB)=A(I,NEWSUB)+RMIN
- 49 CONTINUE
-C
- GO TO 44
-C
- 46 DO 45 P=1,CBL
- NEWSUB=CB(P)
- A(I,NEWSUB)=A(I,NEWSUB)-RMIN
- GO TO (47,45),SW
-C
-C-----(NEXT)
- 47 IF(A(I,NEWSUB)+LAMBDA(NEWSUB).NE.0.) GO TO 45
- LAMBDA(NEWSUB)=I
- IF(L(NEWSUB).NE.0) GO TO 48
- J=NEWSUB
- SW=2
- GO TO 45
- 48 CL=CL+1
- C(CL)=NEWSUB
- RL=RL+1
- R(RL)=L(NEWSUB)
- 45 CONTINUE
-C
- 44 CONTINUE
- GO TO (50,60),SW
-C
-C-----(NEXT1)
- 50 IF(CL0.EQ.CL) GO TO 30
- ITEMP=CL0+1
-C
- DO 51 I=ITEMP,CL
- NEWSUB=C(I)
- NEWSUB=L(NEWSUB)
- MU(NEWSUB)=C(I)
- 51 CONTINUE
-C
- GO TO 30
-C
-C-----(MARK) MARK NEW COLUMN AND PERMUTE
- 60 L(J)=LAMBDA(J)
- I=LAMBDA(J)
- IF(K(I).NE.0) GO TO 61
- K(I)=J
- GO TO 10
-C
- 61 JSV=J
- J=K(I)
- K(I)=JSV
- GO TO 60
-C
- 70 IF(MODE.EQ.1) RETURN
-C
- DO 71 I=1,IMAX
- K(I)=L(I)
- 71 CONTINUE
-C
- RETURN
-C
- END
diff --git a/src/mathlib/gen/obsolete/i410/inbcd.s b/src/mathlib/gen/obsolete/i410/inbcd.s
deleted file mode 100644
index 1824b23..0000000
--- a/src/mathlib/gen/obsolete/i410/inbcd.s
+++ /dev/null
@@ -1,367 +0,0 @@
-*
-* $Id: inbcd.s,v 1.1.1.1 1996/04/01 15:03:17 mclareni Exp $
-*
-* $Log: inbcd.s,v $
-* Revision 1.1.1.1 1996/04/01 15:03:17 mclareni
-* Mathlib gen
-*
-*
-#if (!defined(CERNLIB_NOSBE))&&(defined(CERNLIB_F4))
- IDENT INBCD
- SST
- ENTRY INBCD
- EXT GETFIT. NEW SYSTEM
-* EXT GETFIT$ OLD SYSTEM
-*
-* FUNCTION INBCD (LUN,VECT,NCHMAX,NWR)
-* NCH = INBCD (LUN,VECT,NCHMAX,NWR)
-*
- TRACE VFD 30/5HINBCD,30/INBCD
- INBCD DATA 0
- SA2 LUNH X2= PREVIOUS LFN
- SA5 X1 X5= LUN
- SX6 A1
- SB1 A1 B1= ADR (PAR. LIST) SAVED
- SA6 SVA1 SAVE START ADR OF PARAMETER LIST
-*
-* CHECK IF THIS PARTICULAR FILE WAS THE LAST USED
-* IF FILE IS NOT OPEN, OPEN IT
-*
- IX2 X2-X5
- SA4 STOFIT FIT ADR
- NZ X2,NOFIT
- BX1 X4 X1= FIT ADR
- FETCH X1,OC,X3 GET OPEN/CLOSE FLAG
- SX3 X3-1
- NZ X3,OPEN JUMP IF FILE NOT OPEN
-*
-* GET RECORD , RETURN NCH IN X3
-*
- NJUMP SX4 DEXIT X4= END-OF-DATA EXIT
- SA2 B1+1 X2= ADR OF VECT
- SA3 A2+1 ADR OF MAXCHR
- SA3 X3 X3= MAXCHR
- GETP X1,X2,X3,X4,,SKIP
- SA1 SVA1 ADR OF PARAMETER LIST
- SB7 1 B7= 1
- SA1 X1+B7
- SB1 B7+B7
- SA4 A1+B1
- SB6 B0-B7 B6= -1
- SB5 X1 B5= ADR (VECT)
- SB4 X4 B4= ADR (NWR)
- SA5 BLANK X5= ALL BLANKS
- SA4 TENTH X4= 1/10 WITH SPECIAL NORMALISATION
- ZR X3,ZEROCH
-*
-* CALCULATE B1=(NW-1), B2= NU, B3=6*NU - 1
-* NW = NUMBER OF WORDS READ
-* NU = NUMBER OF CHARACTERS USED IN LAST WORD
- SX7 X3+B6 X7= NCH-1
- PX7 B0,X7 X7= NCH-1 FLOAT
- SX2 10
- FX4 X4*X7 X4= (NCH-1)/10 = NW-1
- PX2 B0,X2 X2= 10 FLOAT
- SB1 X4 B1= NW-1
- DX2 X2*X4 X2= 10*(NW-1) FLOAT
- UX2 B0,X2 X2= 10*(NW-1)
- IX2 X3-X2 X2= NCH - 10*(NW-1) = NU
- SB2 X2 B2= NU
- LX2 1 2*NU
- SB3 X2+B2 3*NU
- SB3 B3+B3 6*NU
- SB3 B3-B7 B3= 6*NU - 1
-*
-* BLANK-FILL LAST WORD FOR UNUSED CHARACTERS
- SA1 B5+B1 A1= ADR (LAST WORD OF VECT USED)
- MX0 1
- AX0 B3,X0 X0= MASK OF 6*NU BITS
- BX6 -X0*X5
- BX1 X0*X1
- BX1 X1+X6 X1= LAST WORD WITH BLANK-FILL
- BX7 X1
- SA7 A1 STORED BACK
-*
-* DISCARD TRAILING BLANKS
- MX0 54 X0= MASK LAST CHARACTER
- BX6 -X0*X5 X6= 55B
- IX7 X1-X5 TEST LAST WORD ALL BLANKS
- ZR X7,ALLBL
- SB3 B3+B7 B3= 6*NU
- LX1 B3,X1 ALIGN LAST CHAR. USED
-*
- LOOPBL BX7 -X0*X1 ISOLATE LAST CHAR
- IX7 X7-X6
- NZ X7,NOTBL CHECK BLANK
- SB2 B2-B7 NU = NU-1
- LX1 54 POSITION PREVIOUS CHAR
- NE B2,B0,LOOPBL
- ALLBL EQ B1,B0,ZEROCH
- SB1 B1-B7 (NW-1) = (NW-1) - 1
- SA1 A1-B7 FETCH PREVIOUS WORD
- IX7 X1-X5
- ZR X7,ALLBL CHECK ALL BLANKS
- SB2 10 NU = 10
- EQ LOOPBL
-*
-* EXIT FOR NCH .NE. 0
- NOTBL SX2 B1 X2= NW-1
- SX7 10
- PX2 B0,X2
- PX7 B0,X7
- DX7 X2*X7 10*(NW-1)
- SX6 X7+B2 NCH = 10*(NW-1) + NU
- SX7 B1+B7 NWR = (NW-1) + 1
- SA7 B4
- EQ INBCD
-*
-* EXIT FOR NCH = 0
- ZEROCH BX7 X5
- SA7 B5 VECT(1)= BLANK
- SX7 B7
- MX6 0 NCH = 0
- SA7 B4 NWR= 1
- EQ INBCD
-*
-*------- END-OF-DATA EXIT. RESET NCH DEPENDING ON FP
-*
- DEXIT DATA 0
- SA4 SVA1
- SA1 STOFIT
- SA5 X4+3 X5=ADR NWR
- MX7 0
- SA7 X5 RETURN NWR=0
- FETCH X1,FP,X6
- AX6 5
- ZR X6,EOS
- AX6 1
- ZR X6,EOP
- SX6 -3
- EQ INBCD END-OF-INFORMATION RETURN
- EOP SX6 -2
- EQ INBCD END-OF-PARTITION RETURN
- EOS SX6 -1
- EQ INBCD END-OF-SECTION RETURN
-*
-*---- FIND THE FIT ADDRESS AND STORE IT IN STOFIT
-*
- NOFIT BX6 X5
- SA6 LUNH STORE LUN
-+RJGETFIT
-- VFD 30/TRACE
- BX6 X1
- SA2 SVA1
- SA6 STOFIT STORE FIT ADDRESS
- FETCH X1,OC,X3
- SX3 X3-1
- SB1 X2 B1 RESTORED
- ZR X3,NJUMP
-*
-* OPEN THE FILE
-*
- OPEN OPENM X1,I-O
- SA4 SVA1
- SB1 X4 B1= ADR (PAR.LIST) RESTORED
- EQ B0,B0,NJUMP
-*
- SVA1 DATA 0
- STOFIT DATA 1L1
- LUNH DATA 1L2
- TENTH DATA O17170631463146314632
- BLANK DATA 10H
- END
-#endif
-#if defined(CERNLIB_NOSBE)
- IDENT INBCD
-*
-* CERN PROGLIB# I410 INBCD .VERSION KERNCDC 2.11 840706
-*
- SST
- ENTRY INBCD
- EXT GETFIT.
-*
-* NCH = INBCD (LUN,VECT,NCHMAX,NWR)
-*
- TRACE VFD 30/5HINBCD,30/INBCD
- INBCD DATA 0
- SA2 LUNH X2= PREVIOUS LFN
- SA5 X1 X5= LUN
- SX6 A1
- SA6 SVA1 SAVE START ADR OF PARAMETER LIST
-*
-* CHECK IF THIS PARTICULAR FILE WAS THE LAST USED
-* IF FILE IS NOT OPEN, OPEN IT
-*
- IX2 X2-X5
- SA4 STOFIT FIT ADR
- NZ X2,NOFIT
- BX1 X4 X1= FIT ADR
- FETCH X1,OC,X3 GET OPEN/CLOSE FLAG
- SX3 X3-1
- NZ X3,OPEN JUMP IF FILE NOT OPEN
-*
-* GET RECORD , RETURN NCH IN X3
-*
- NJUMP SX2 WSA X2= ADR OF INPUT BUFFER WSA
- GET X1,X2
- SA1 STOFIT
- FETCH X1,RL,X3 X3= NO. OF CHARACTERS READ INTO WSA
- SA1 SVA1 ADR OF PARAMETER LIST
- SB7 1 B7= 1
- SA1 X1+B7 X1= ADR (VECT)
- SA2 A1+B7 X2= ADR (NCHMAX)
- SA4 A2+B7 X4= ADR (NWR)
- SB6 B0-B7 B6= -1
- SB5 X1 B5= ADR (VECT)
- SB4 X4 B4= ADR (NWR)
- SA5 BLANK X5= ALL BLANKS
- SA4 TENTH X4= 1/10 WITH SPECIAL NORMALISATION
- ZR X3,ZEROCH
-*
-* NCH = MIN (NCHR,NCHMAX)
-*
- SA2 X2 X2= NCHMAX
- IX6 X2-X3
- AX6 59
- BX2 X6*X2 X2= ZERO OR NCHMAX
- BX3 -X6*X3 X3= ZERO OR NCHR
- BX3 X2+X3 X3= NCH
-*
-* CALCULATE B1=(NW-1), B2= NU, B3=6*NU - 1
-* NW = NUMBER OF WORDS READ
-* NU = NUMBER OF CHARACTERS USED IN LAST WORD
- SX7 X3+B6 X7= NCH-1
- PX7 B0,X7 X7= NCH-1 FLOAT
- SX2 10
- FX4 X4*X7 X4= (NCH-1)/10 = NW-1
- PX2 B0,X2 X2= 10 FLOAT
- SB1 X4 B1= NW-1
- DX2 X2*X4 X2= 10*(NW-1) FLOAT
- UX2 B0,X2 X2= 10*(NW-1)
- IX2 X3-X2 X2= NCH - 10*(NW-1) = NU
- SB2 X2 B2= NU
- LX2 1 2*NU
- SB3 X2+B2 3*NU
- SB3 B3+B3 6*NU
- SB3 B3-B7 B3= 6*NU - 1
-*
-* COPY WORDS FROM WSA TO VECT
-*
- SB6 -B7
- COPY SB6 B6+B7
- SA1 B6+WSA
- BX6 X1
- SA6 B5+B6
- NE B6,B1,COPY
-*
-* BLANK-FILL LAST WORD FOR UNUSED CHARACTERS
- SA1 B5+B1 A1= ADR (LAST WORD OF VECT USED)
- MX0 1
- AX0 B3,X0 X0= MASK OF 6*NU BITS
- BX6 -X0*X5
- BX1 X0*X1
- BX1 X1+X6 X1= LAST WORD WITH BLANK-FILL
- BX7 X1
- SA7 A1 STORED BACK
-*
-* DISCARD TRAILING BLANKS
- MX0 54 X0= MASK LAST CHARACTER
- BX6 -X0*X5 X6= 55B
- IX7 X1-X5 TEST LAST WORD ALL BLANKS
- ZR X7,ALLBL
- SB3 B3+B7 B3= 6*NU
- LX1 B3,X1 ALIGN LAST CHAR. USED
-*
- LOOPBL BX7 -X0*X1 ISOLATE LAST CHAR
- IX7 X7-X6
- NZ X7,NOTBL CHECK BLANK
- SB2 B2-B7 NU = NU-1
- LX1 54 POSITION PREVIOUS CHAR
- NE B2,B0,LOOPBL
- ALLBL EQ B1,B0,ZEROCH
- SB1 B1-B7 (NW-1) = (NW-1) - 1
- SA1 A1-B7 FETCH PREVIOUS WORD
- IX7 X1-X5
- ZR X7,ALLBL CHECK ALL BLANKS
- SB2 10 NU = 10
- EQ LOOPBL
-*
-* EXIT FOR NCH .NE. 0
- NOTBL SX2 B1 X2= NW-1
- SX7 10
- PX2 B0,X2
- PX7 B0,X7
- DX7 X2*X7 10*(NW-1)
- SX6 X7+B2 NCH = 10*(NW-1) + NU
- SX7 B1+B7 NWR = (NW-1) + 1
- SA7 B4
- EQ INBCD
-*
-* EXIT FOR NCH = 0
- ZEROCH BX7 X5
- SA7 B5 VECT(1)= BLANK
- SX7 B7
- MX6 0 NCH = 0
- SA7 B4 NWR= 1
- EQ INBCD
-*
-*------- END-OF-DATA EXIT. RESET NCH DEPENDING ON FP
-*
- DEXIT DATA 0
- SA4 SVA1
- SA1 STOFIT
- SA5 X4+3 X5=ADR NWR
- MX7 0
- SA7 X5 RETURN NWR=0
- FETCH X1,FP,X6
- AX6 5
- ZR X6,EOS
- AX6 1
- ZR X6,EOP
- SX6 -3
- EQ INBCD END-OF-INFORMATION RETURN
- EOP SX6 -2
- EQ INBCD END-OF-PARTITION RETURN
- EOS SX6 -1
- EQ INBCD END-OF-SECTION RETURN
-*
-*---- FIND THE FIT ADDRESS AND STORE IT IN STOFIT
-*
- NOFIT BX6 X5
- SA6 LUNH STORE LUN
-#endif
-#if (defined(CERNLIB_NOSBE))&&(!defined(CERNLIB_F4))
- MX6 1
- BX1 X1+X6
-#endif
-#if defined(CERNLIB_NOSBE)
-+RJGETFIT
-- VFD 30/TRACE
- BX6 X1
- SA2 SVA1
- SA6 STOFIT STORE FIT ADDRESS
- SX4 DEXIT
- STORE X1,DX=X4
- FETCH X1,OC,X3
- SX3 X3-1
- ZR X3,NJUMP
-*
-* OPEN THE FILE
-*
- OPEN BSS 0
- STORE X1,RT=Z
- STORE X1,BT=C
- STORE X1,FL=120
- STORE X1,MRL=120
- OPENM X1,I-O,N
- SA1 STOFIT
- EQ B0,B0,NJUMP
-*
- WSA BSS 15 INTERMEDIATE INPUT BUFFER
- SVA1 DATA 0
- STOFIT DATA 1L1
- LUNH DATA 1L2
- TENTH DATA O17170631463146314632
- BLANK DATA 10H
- END
-#endif
diff --git a/src/mathlib/gen/obsolete/ibm/c302err.F b/src/mathlib/gen/obsolete/ibm/c302err.F
deleted file mode 100644
index 1a745dd..0000000
--- a/src/mathlib/gen/obsolete/ibm/c302err.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: c302err.F,v 1.1.1.1 1996/04/01 15:03:05 mclareni Exp $
-*
-* $Log: c302err.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:05 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_IBMVM)||defined(CERNLIB_IBMMVS)
- SUBROUTINE C302ERR(IRC,IERN,X)
-C
- CHARACTER*80 ERRTXT
-C--- Set standard corrective action
- IRC=0
- IF(IERN.EQ.290) THEN
- WRITE(ERRTXT,101) X
- CALL MTLPRT('GAMMA' ,'C302.1',ERRTXT)
- ELSEIF(IERN.EQ.300) THEN
- WRITE(ERRTXT,101) X
- CALL MTLPRT('DGAMMA','C302.1',ERRTXT)
- ENDIF
- RETURN
- 101 FORMAT('ARGUMENT IS NEGATIVE = ',1P,E15.1)
- END
-#endif
diff --git a/src/mathlib/gen/obsolete/ibm/c304err.F b/src/mathlib/gen/obsolete/ibm/c304err.F
deleted file mode 100644
index dafbcde..0000000
--- a/src/mathlib/gen/obsolete/ibm/c304err.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: c304err.F,v 1.1.1.1 1996/04/01 15:03:05 mclareni Exp $
-*
-* $Log: c304err.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:05 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_IBMVM)||defined(CERNLIB_IBMMVS)
- SUBROUTINE C304ERR(IRC,IERN,X)
-C
- CHARACTER*80 ERRTXT
-C--- Set standard corrective action
- IRC=0
- IF(IERN.EQ.291) THEN
- WRITE(ERRTXT,101) X
- CALL MTLPRT('ALGAMA','C304.1',ERRTXT)
- ELSEIF(IERN.EQ.301) THEN
- WRITE(ERRTXT,101) X
- CALL MTLPRT('DLGAMA','C304.1',ERRTXT)
- ENDIF
- RETURN
- 101 FORMAT('NON-POSITIVE ARGUMENT X = ',1P,E15.6)
- END
-#endif
diff --git a/src/mathlib/gen/obsolete/ibm/gathera.s b/src/mathlib/gen/obsolete/ibm/gathera.s
deleted file mode 100644
index 17457c6..0000000
--- a/src/mathlib/gen/obsolete/ibm/gathera.s
+++ /dev/null
@@ -1,71 +0,0 @@
-*
-* $Id: gathera.s,v 1.1.1.1 1996/04/01 15:03:02 mclareni Exp $
-*
-* $Log: gathera.s,v $
-* Revision 1.1.1.1 1996/04/01 15:03:02 mclareni
-* Mathlib gen
-*
-*
-#if defined(CERNLIB_QMIBMVF)
-*********************************************************************
-*
-* CERN PROGLIB# F122 GATHER .VERSION GEN 2.30 890530
-* ORIG. 05/30/89 F. Antonelli/IBM
-*
-*********************************************************************
-*********************************************************************
-* SUBROUTINE GATHER(NW,OUT,HIN,INDEX)
-* DIMENSION OUT(*),HIN(*),INDEX(*)
-* DO J=1,NW
-* OUT(J)=HIN(INDEX(J))
-* ENDDO
-*********************************************************************
-GATHER START 0
-#if defined(CERNLIB_QMIBMXA)
-GATHER AMODE ANY
-GATHER RMODE ANY
-#endif
- USING *,15
- STM 1,5,24(13)
-*GET ADDRESS OF PARM LIST
- LM 1,4,0(1)
-*
-*IN R1 NW
- L 1,0(0,1)
-* TEST ON VECTOR SIZE IF VS LT 128 NOSECTIONING
- LA 5,128
- SR 5,1
- BC 2,NOSECT
-*
- LA 5,4
- SR 3,5
-*
-*IN R2 R3 R4 ADDRESSES OF OUT HIN INDEX
-* ADDRESSES OF SUBSEQUENT INDEX SECTION
-LOOPV VLVCU 1
- VLE 2,4
- VLIE 1,2,0(3)
- VSTE 1,2
- BC 2,LOOPV
-* CONCLUSION VECTOR
-*
- LM 1,5,24(13)
- BR 14
-*
-* NO SECTIONING
-*
-NOSECT LA 5,4
- SR 3,5
-*
- VLVCA 0(1)
- VLE 2,4
- VLIE 1,2,0(3)
- VSTE 1,2
-* CONCLUSION NO SECTIONING
-*
- LM 1,5,24(13)
- BR 14
-*
-*
- END
-#endif
diff --git a/src/mathlib/gen/obsolete/ibm/iilza.s b/src/mathlib/gen/obsolete/ibm/iilza.s
deleted file mode 100644
index 7f2a62c..0000000
--- a/src/mathlib/gen/obsolete/ibm/iilza.s
+++ /dev/null
@@ -1,67 +0,0 @@
-*
-* $Id: iilza.s,v 1.1.1.1 1996/04/01 15:03:02 mclareni Exp $
-*
-* $Log: iilza.s,v $
-* Revision 1.1.1.1 1996/04/01 15:03:02 mclareni
-* Mathlib gen
-*
-*
-#if defined(CERNLIB_IBM)
-*********************************************************************
-*
-* CERN PROGLIB# F122 IILZ .VERSION KERNIBM 2.27 89053
-* ORIG. 05/30/89 F. Antonelli/IBM
-*
-*********************************************************************
-*********************************************************************
-* FUNCTION IILZF(NW,INTE,ISTR)
-* DIMENSION INTE(*)
-* IILZF=0
-* INDE=1
-* DO J=1,NW
-* IF(INTE(INDE).EQ.0)THEN
-* IILZF=IILZF+1
-* INDE=INDE+ISTR
-* ELSE
-* GO TO 10
-* ENDIF
-* ENDDO
-*10 CONTINUE
-*********************************************************************
-IILZ START 0
-#if defined(CERNLIB_QMIBMXA)
-IILZ AMODE ANY
-IILZ RMODE ANY
-#endif
- USING *,15
- STM 1,9,24(13)
-* R2 INTE, R3 ISRT
- LM 1,3,0(1)
-*
-*IN R1 NW - IN R3 ISTR -
- L 3,0(0,3)
-* SCALAR RUN
- LA 5,4
- MR 4,3
- L 7,0(0,1)
- SLL 7,2
- MR 6,3
- LR 6,5
- LA 5,4
- SR 2,5
- SR 9,9
-LOOPS L 8,0(5,2)
- CR 8,9
- BC 6,OUT
- BXLE 5,6,LOOPS
-OUT LA 6,4
- SR 5,6
- SRL 5,2
- DR 4,3
- LR 0,5
-*
-* CONCLUSION SCALAR
- LM 1,9,24(13)
- BR 14
- END
-#endif
diff --git a/src/mathlib/gen/obsolete/ibm/ilsuma.s b/src/mathlib/gen/obsolete/ibm/ilsuma.s
deleted file mode 100644
index b5839ab..0000000
--- a/src/mathlib/gen/obsolete/ibm/ilsuma.s
+++ /dev/null
@@ -1,66 +0,0 @@
-*
-* $Id: ilsuma.s,v 1.1.1.1 1996/04/01 15:03:02 mclareni Exp $
-*
-* $Log: ilsuma.s,v $
-* Revision 1.1.1.1 1996/04/01 15:03:02 mclareni
-* Mathlib gen
-*
-*
-#if defined(CERNLIB_QMIBMVF)
-**********************************************************************
-* CERN PROGLIB# F122 ILSUM .VERSION KERNIBM 2.27 890530
-* ORIG. 05/30/89 F. Antonelli/IBM
-*
-*********************************************************************
-* FUNCTION ILSUM(NW,INTE,ISTR)
-* LOGICAL INTE(*)
-* IILZF=0
-* INDE=1
-* DO J=1,NW
-* IF(INTE(INDE))THEN
-* IILZF=IILZF+1
-* ENDIF
-* INDE=INDE+ISTR
-* ENDDO
-*10 CONTINUE
-*
-* RETURN
-* END
-*********************************************************************
-ILSUM START 0
-#if defined(CERNLIB_QMIBMXA)
-ILSUM AMODE ANY
-ILSUM RMODE ANY
-#endif
- USING *,15
- STM 1,5,24(13)
-* R2 INTE, R3 ISRT
- LM 1,3,0(1)
-*
-*IN R1 NW - IN R3 ISTR -
- L 1,0(0,1)
- L 3,0(0,3)
-* TEST ON VECTOR SIZE IF VS LT 128 NOSECTIONING
- LA 5,128
- SR 5,1
- BC 2,NOSECT
-*
-* IN R4 0
- LA 5,1
- SR 0,0
-LOOP VLVCU 1
- VCS 8,5,2(3)
- VCOVM 0
- LTR 1,1
- BC 2,LOOP
- LM 1,5,24(13)
- BR 14
-NOSECT LA 5,1
- SR 0,0
- VLVCA 0(1)
- VCS 8,5,2(3)
- VCOVM 0
- LM 1,5,24(13)
- BR 14
- END
-#endif
diff --git a/src/mathlib/gen/obsolete/ibm/irnd01.F b/src/mathlib/gen/obsolete/ibm/irnd01.F
deleted file mode 100644
index 7c806fe..0000000
--- a/src/mathlib/gen/obsolete/ibm/irnd01.F
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: irnd01.F,v 1.1.1.1 1996/04/01 15:03:05 mclareni Exp $
-*
-* $Log: irnd01.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:05 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_IBM)
- FUNCTION IRND01(DUMMY)
-C GENERATES ONE RANDOM BIT WITH P(0)=P, P(1)=1-P
- DATA P/0.50/
- IRND01=0
- IF(RNDM2(DUMMY).GT.P) IRND01=1
- RETURN
- ENTRY IR01IN(SEED)
- CALL RD2IN(SEED,0)
- RETURN
- ENTRY IR01UT(SEED)
- CALL RD2OUT(SEED,JS)
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/obsolete/ibm/name12.s b/src/mathlib/gen/obsolete/ibm/name12.s
deleted file mode 100644
index 25f9e4b..0000000
--- a/src/mathlib/gen/obsolete/ibm/name12.s
+++ /dev/null
@@ -1,333 +0,0 @@
-*
-* $Id: name12.s,v 1.1.1.1 1996/04/01 15:03:04 mclareni Exp $
-*
-* $Log: name12.s,v $
-* Revision 1.1.1.1 1996/04/01 15:03:04 mclareni
-* Mathlib gen
-*
-*
-#if defined(CERNLIB_IBM)
-NAME12 CSECT
-#if defined(CERNLIB_QMIBMXA)
-NAME12 AMODE ANY
-NAME12 RMODE ANY
-#endif
-*
-* CERN PROGLIB# J402 NAME12 .VERSION KERNIBM X X
-*
-*********************************************************************
-*
-* FUNCTION: BUILD IN A SPECIFIED OUTPUT AREA ONE LINE OF A
-* STRING OF 12*12 BLOCK CHARACTERS.
-*
-* CALLING SEQUENCE: CALL NAME12 (STRING,LINE,OUTPUT,NCHARS)
-*
-* ARGUMENTS: STRING - THE STRING OF EBCDIC CHARACTERS TO BE
-* BLOCKED.
-*
-* LINE - THE LINE NUMBER AS A 4-BYTE INTEGER IN THE
-* RANGE 1-12. (TO CONSTRUCT COMPLETE BLOCK
-* CHARACTERS THE ROUTINE MUST BE ENTERED 12
-* TIMES).
-*
-* OUTPUT - THE AREA IN WHICH A LINE OF THE BLOCK
-* CHARACTER STRING IS TO BE CONSTRUCTED.
-* THE ROUTINE SPACES 2 COLUMNS BETWEEN
-* BLOCK CHARACTERS, THE REQUIRED LENGTH IN
-* BYTES OF THIS AREA IS THEREFORE 14N-2,
-* WHERE N REPRESENTS THE NUMBER OF CHARACTERS
-* IN THE STRING. THE ROUTINE DOES NOT ENTER
-* BLANKS BETWEEN OR WITHIN THE BLOCK
-* CHARACTERS, THE CALLING PROGRAM MUST
-* THEREFORE PREFILL THIS AREA WITH BLANKS OR
-* ANY OTHER DESIRED BACKGROUND.
-*
-* NCHARS - THE NUMBER OF CHARACTERS IN THE STRING AS
-* A 4-BYTE INTEGER.
-*
-*********************************************************************
-*
-*********************************************************************
-*
-* M O D I F I C A T I O N L O G
-* ===============================
-*
-*********************************************************************
-*
-* 2 . 0 1
-* =======
-*
-* NAME CHANGED FROM BLK12 TO NAME12
-*
-* H. RENSHALL, CERN/DD, JANUARY 1982.
-*
-*********************************************************************
-*
-* 2 . 0 0
-* =======
-*
-* NEW VERSION.
-*
-* R. MATTHEWS, CERN/DD, DECEMBER 1980.
-*
-*********************************************************************
-*
-R0 EQU 0
-R1 EQU 1
-R2 EQU 2
-R3 EQU 3
-R4 EQU 4
-R5 EQU 5
-R6 EQU 6
-R7 EQU 7
-R8 EQU 8
-R9 EQU 9
-R10 EQU 10
-R11 EQU 11
-R12 EQU 12
-R13 EQU 13
-R14 EQU 14
-R15 EQU 15
-*
- PRINT NOGEN
-*
-* P R O L O G U E
-*
- USING NAME12,R15
- B SAVEREGS
- DC AL1(7),CL7'NAME12' IDENTIFIER
- DC C'2.01' VERSION.MODIFICATION LEVEL
-SAVEREGS STM R14,R12,12(R13)
- LR R4,R13
- CNOP 0,4
- BAL R13,AROUNDSA
-SAVEAREA DC A(EPILOGUE),17F'0'
- DROP R15
- USING SAVEAREA,R13
-AROUNDSA ST R13,8(0,R4)
- ST R4,4(0,R13)
- XC 8(4,R13),8(R13)
-*
- LM R2,R5,0(R1) R2 -> STRING, R3 -> LINE
-* R4 -> OUTPUT, R5 -> NCHARS
- BCTR R2,0 R2 -> STRING - 1
- L R3,0(0,R3) R3 := LINE
- BCTR R3,0 R3 := LINE - 1
- L R5,0(0,R5) R5 := NCHARS
- LR R6,R5 R6 := NCHARS
- MH R6,=H'14' R6 := 14*NCHARS
- LA R6,11(0,R6) R6 := 14*NCHARS + 11
- SR R7,R7 R7 := 0
- SR R8,R8 R8 := 0
-*
-NEXTCHAR SH R6,=H'14' STEP BACK 14 BYTES FOR THE NEXT CHARACTE
- IC R7,0(R5,R2) R7 := CURRENT CHARACTER
- LR R9,R7 R9 := CURRENT CHARACTER
- SH R9,=H'64' ALLOW FOR TABLE STARTING WITH BLANK CHAR
- BM BCTCHAR BRANCH IF THE CHARACTER IS OUT OF RANGE
- MH R9,=H'12' R9 := OFFSET IN CHARDEFS FOR CURRENT CHA
- AR R9,R3 R9 := OFFSET FOR CURRENT LINE OF CHAR
- IC R8,CHARDEFS(R9) R8 := CHARDEFS ENTRY
- LH R9,LINEBITS(R8) R9 := BIT PATTERN
- SLL R9,19 SHIFT IT TO BITS 1-12
- O R9,=F'1' TURN ON BIT 31
- LA R8,12 R8 := 12 FOR LOOP CONTROL
- SR R6,R8 SUBTRACT 12 ADDED BY PREVIOUS LOOP
-*
-NEXTBYTE LA R6,1(0,R6) R6 -> CURRENT OUTPUT BYTE
- BXH R9,R9,BCTBYTE TEST THE TOP BIT AND SHIFT THE OTHERS
- STC R7,0(R6,R4) STORE THE CHARACTER IF THE BIT WAS ON
-BCTBYTE BCT R8,NEXTBYTE GO AND REPEAT FOR THE NEXT OUTPUT BYTE
-*
-BCTCHAR BCT R5,NEXTCHAR GO AND REPEAT FOR THE NEXT CHAR
-*
-* E P I L O G U E
-*
-EPILOGUE EQU *
- L R13,4(0,R13)
- LM R14,R12,12(R13)
-** MVI 12(R13),X'FF'
- BR R14
-*
-*********************************************************************
-*
-* THE FOLLOWING IS THE CHARACTER DEFINITION TABLE CONTAINING ONE
-* TWELVE-BYTE ENTRY FOR EACH CHARACTER. EACH BYTE IS THE ADDRESS IN
-* THE LINEBITS TABLE OF THE BIT PATTERN WHICH DEFINES ONE LINE OF THE
-* BLOCK CHARACTER. FOR EXAMPLE, 'A' IS COMPOSED OF THE LINES
-* L2, L1, L5, L5, L5, L1, L1, L5, L5, L5, L5, L5.
-*
-*********************************************************************
-*
-CHARDEFS DC 192X'4C4C4C4C4C4C4C4C4C4C4C4C'
- ORG CHARDEFS
-BLANK DC X'4C4C4C4C4C4C4C4C4C4C4C4C'
- ORG CHARDEFS+12*X'0B'
-PERIOD DC X'4C4C4C4C4C4C4C4C60606060'
-LESSTHAN DC X'120A14721674741672140A12'
-OPENBRAC DC X'061472721616161672721406'
-PLUS DC X'4C141414140202141414144C'
-VERTLINE DC X'141414141414141414141414'
-AMPERSND DC X'0E989A9A980E9C9EA09200A2'
- ORG CHARDEFS+12*X'1A'
-SHRIEK DC X'14141414141414144C4C1414'
-CURRENCY DC X'4C4C4C4C4C4C4C4C4C4C4C4C' UNDEFINED
-ASTERISK DC X'14888A048C00008C048A8814'
-CLOSBRAC DC X'84140A0A121212120A0A1484'
- ORG CHARDEFS+12*X'20'
-MINUS DC X'4C4C4C4C4C02024C4C4C4C4C'
-SLASH DC X'4C1070120A1472167418264C'
- ORG CHARDEFS+12*X'2C'
-PERCENT DC X'4C787A7C0A1472167E80824C'
-UNDERSCR DC X'4C4C4C4C4C4C4C4C4C4C0000'
-GREATHAN DC X'1672140A127070120A147216'
-QUESTION DC X'020008645EA48614144C1414'
- ORG CHARDEFS+12*X'3B'
-HASH DC X'202020000020200000202020'
-AT DC X'020008448E4242A690929496'
- ORG CHARDEFS+12*X'3E'
-EQUALS DC X'4C4C4C02024C4C02024C4C4C'
- ORG CHARDEFS+12*X'81'
-A DC X'020008080800000808080808'
-B DC X'2C000808322A2A320808002C'
-C DC X'020008262626262626080002'
-D DC X'282A32080808080808322A28'
-E DC X'000026262668682626260000'
-F DC X'000026262668682626262626'
-G DC X'020008262626343408080002'
-H DC X'080808080800000808080808'
-I DC X'020214141414141414140202'
- ORG CHARDEFS+12*X'91'
-J DC X'66660A0A0A0A0A0A3A3A686A'
-K DC X'08322E3C3A36363A3C2E3208'
-L DC X'262626262626262626260000'
-M DC X'083E40424446080808080808'
-N DC X'086C6E484A464E5052540876'
-O DC X'000008080808080808080000'
-P DC X'2C00080808002C2626262626'
-Q DC X'020008080808084E50522C56'
-R DC X'2C00080808002C3A3C2E3208'
- ORG CHARDEFS+12*X'A2'
-S DC X'02000826585A5C5E64080002'
-T DC X'000014141414141414141414'
-U DC X'080808080808080808080002'
-V DC X'080808080808083062206014'
-W DC X'080808080808464442403E08'
-X DC X'080830622060602062300808'
-Y DC X'080830622060141414141414'
-Z DC X'00001070120A147216742400'
- ORG CHARDEFS+12*X'B0'
-ZERO DC X'040208080808080808080204'
-ONE DC X'140C0E141414141414140202'
-TWO DC X'020008646410121416180000'
-THREE DC X'02000864641A1A6464080002'
-FOUR DC X'061C1E202224001212121212'
-FIVE DC X'0000262626282A106464002C'
-SIX DC X'02000826262C000808080002'
-SEVEN DC X'002C2E120A14141414141414'
-EIGHT DC X'020008083004043008080002'
-NINE DC X'020008080800006464080002'
- DC 6X'4C4C4C4C4C4C4C4C4C4C4C4C'
- ORG
-*
-*********************************************************************
-*
-* THE FOLLOWING IS THE TABLE OF BIT PATTERNS WHICH ARE USED TO
-* CONSTRUCT THE BLOCK CHARACTERS. EACH BLOCK CHARACTER IS COMPOSED
-* OF 12 BIT PATTERNS, ONE FOR EACH LINE OF THE CHARACTER, AS DEFINED
-* IN THE CHARACTER DEFINITION TABLE. IF A BIT IS ON THE CHARACTER IS
-* PRINTED AND IF THE BIT IS OFF THE PRINTING OF THE CHARACTER IS
-* SUPPRESSED.
-*
-*********************************************************************
-*
-LINEBITS DS 0H
-L1 DC BL2'111111111111'
-L2 DC BL2'011111111110'
-L3 DC BL2'001111111100'
-L4 DC BL2'000000111000'
-L5 DC BL2'110000000011'
-L6 DC BL2'000000110000'
-L7 DC BL2'000011100000'
-L8 DC BL2'000111100000'
-L9 DC BL2'000000000110'
-L10 DC BL2'000000011000'
-L11 DC BL2'000001100000'
-L12 DC BL2'000110000000'
-L13 DC BL2'011000000000'
-L14 DC BL2'000000011110'
-L15 DC BL2'000001111000'
-L16 DC BL2'000011011000'
-L17 DC BL2'000110011000'
-L18 DC BL2'001100011000'
-L19 DC BL2'011111111111'
-L20 DC BL2'110000000000'
-L21 DC BL2'111111111000'
-L22 DC BL2'111111111100'
-L23 DC BL2'111111111110'
-L24 DC BL2'110000001100'
-L25 DC BL2'011000000110'
-L26 DC BL2'110000000110'
-L27 DC BL2'110000011111'
-L28 DC BL2'111111100000'
-L29 DC BL2'110001100000'
-L30 DC BL2'110000110000'
-L31 DC BL2'110000011000'
-L32 DC BL2'111000000111'
-L33 DC BL2'111100001111'
-L34 DC BL2'110110011011'
-L35 DC BL2'110011110011'
-L36 DC BL2'110001100011'
-L37 DC BL2'110110000011'
-L38 DC BL2'110011000011'
-L39 DC BL2'000000000000'
-L40 DC BL2'110000110011'
-L41 DC BL2'110000011011'
-L42 DC BL2'110000001111'
-L43 DC BL2'110000000111'
-L44 DC BL2'011111111011'
-L45 DC BL2'111000000000'
-L46 DC BL2'011111111100'
-L47 DC BL2'001111111110'
-L48 DC BL2'000000000111'
-L49 DC BL2'000011110000'
-L50 DC BL2'001100001100'
-L51 DC BL2'000000000011'
-L52 DC BL2'001111111111'
-L53 DC BL2'111111110000'
-L54 DC BL2'011111100000'
-L55 DC BL2'111000000011'
-L56 DC BL2'111100000011'
-L57 DC BL2'000000001100'
-L58 DC BL2'000011000000'
-L59 DC BL2'001100000000'
-L60 DC BL2'110000000001'
-L61 DC BL2'001110000110'
-L62 DC BL2'001010001100'
-L63 DC BL2'001110011000'
-L64 DC BL2'001100111000'
-L65 DC BL2'011000101000'
-L66 DC BL2'110000111000'
-L67 DC BL2'000111000000'
-L68 DC BL2'000001111100'
-L69 DC BL2'011001100110'
-L70 DC BL2'011101101110'
-L71 DC BL2'000111111000'
-L72 DC BL2'110111111011'
-L73 DC BL2'110011111111'
-L74 DC BL2'110000001110'
-L75 DC BL2'111111000000'
-L76 DC BL2'011111000000'
-L77 DC BL2'001111110000'
-L78 DC BL2'001100110000'
-L79 DC BL2'001111110011'
-L80 DC BL2'011000111011'
-L81 DC BL2'110000011110'
-L82 DC BL2'011111110011'
-L83 DC BL2'000001111110'
-L84 DC BL2'110011111011'
-*
- LTORG
-*
- END
-#endif
diff --git a/src/mathlib/gen/obsolete/ibm/norranib.s b/src/mathlib/gen/obsolete/ibm/norranib.s
deleted file mode 100644
index e09c399..0000000
--- a/src/mathlib/gen/obsolete/ibm/norranib.s
+++ /dev/null
@@ -1,316 +0,0 @@
-*
-* $Id: norranib.s,v 1.1.1.1 1996/04/01 15:03:05 mclareni Exp $
-*
-* $Log: norranib.s,v $
-* Revision 1.1.1.1 1996/04/01 15:03:05 mclareni
-* Mathlib gen
-*
-*
-#if defined(CERNLIB_IBM)
-* NORMAL RANDOM NUMBER GENERATOR FOR IBM 370
-* G.MARSAGLIA, K.ANANTHANARAYANAN, N.PAUL. MCGILL UNIV., MONTREAL
-* ADAPTED AT CERN BY T.LINDELOF, SEPT 1977
-* MODIFIED BY A BERGLUND JAN 1980 (INTRODUCE NORRUT AND NORRIN)
-NORRAN START 0 CALL NORRAN(X)
-#if defined(CERNLIB_QMIBMXA)
-NORRAN AMODE ANY
-NORRAN RMODE ANY
-#endif
-*
-* REGISTER USAGE
-* -------- -----
-* GPR 1 - (REGB) CALCULATION OF RESULTS
-* GPR 2 - (REGC) CALCULATION OF RESULTS
-* GPR 3 - (REGD) CALCULATION OF RESULTS
-* GPR13 - ADDRESS OF SAVE AREA OF CALLING PROGRAM,OR OF THIS
-* PROGRAMS'S SAVE AREA ON CALL TO RNORTH OR REXPTH
-* GPR14 - CONTAINS RETURN ADDRESS.
-* GPR15 - USED AS BASE REGISTER.
-* FPR 0 - RESULT OF UNI,VNI,REXP,RNOR.
- ENTRY NORRUT .CALL NORRUT(SEED1,SEED2)
- ENTRY NORRIN .CALL NORRIN(SEED1,SEED2)
- ENTRY UNI .U=UNI(0)
- ENTRY VNI .V=VNI(0)
- EXTRN RNORTH FORTRAN FUNCTION REQUIRED-RNORTH(I)
-REGB EQU 1
-REGC EQU 2
-REGD EQU 3
-*
-* CALL NORRAN(X) RESULT IS STANDARD NORMAL VARIATE.
-*
-* METHOD
-* ------
-* 1. GENERATE H1H2H3H4H5H6H7H8,8 RANDOM HEXADECIMAL DIGITS.
-*
-* 2. IF H1H2.LT.68, SET 'X' TO
-* (NTBL(H1H2)+.H3H4H5H6H7H8)/16, AND QUIT.
-* 3. IF H1H2.LT.D0, SET 'X' TO
-* (-NTBL(H1H2-68)-.H3H4H5H6H7H8)/16, AND QUIT.
-* 4. IF H1H2H3.LT.E2F, SET 'X' TO
-* (NTBL(H1H2H3-CE8)+.H4H5H6H7H8)/16, AND QUIT.
-* 5. IF H1H2H3.LT.F5E, SET 'X' TO
-* (-NTBL(H1H2H3-E17)-.H4H5H6H7H8)/16, AND QUIT.
-* 6. ELSE,GENERATE 'X' FROM THE NORMAL TOOTH-TAIL SUBPROGRAM.
-*
- USING *,15
- STM REGB,REGD,24(13) SAVE REGISTERS 1,2,3
-RDIGT3 L REGB,SRGN LOAD SRGN INTO REGB
- LR REGC,REGB AND INTO REGC
- SRL REGC,15 SHIFT REGC RIGHT 15 BITS
- XR REGB,REGC AND XOR INTO REGB
- LR REGC,REGB COPY REGB INTO REGC
- SLL REGC,17 SHIFT IT LEFT 17 BITS,
- XR REGB,REGC AND XOR INTO REGB
- ST REGB,SRGN SAVE THE NEW 'SRGN'
- L REGD,MCGN LOAD MCGN INTO REGD
- M REGC,MULT AND MULTIPLY BY 69069
- ST REGD,MCGN STORE RESULT,MODULO 2**32, AS NEW 'MCGN'
- XR REGD,REGB XOR NEW 'MCGN' AND 'SRGN' IN REGD
-NRCT SLR REGC,REGC ZERO OUT REGC
- CL REGD,X68 IF REGD GE 68000000,BRANCH TO 'ND2'
- BC 11,ND2
-ND1 SLDL REGC,8 SHIFT FIRST 2 HEX DIGITS INTO REGC
- IC REGC,NTBL(REGC) FETCH CORRESPONDING BYTE FROM NTBL
- STC REGC,PSTWRD+1 STORE AS 2ND BYTE OF PSTWRD
- SRL REGD,8 TAKE REMAINING 24 BITS OF REGD
- AL REGD,PCHAR FORM FLOATING POINT FRACTION,CHAR X'3F'
- ST REGD,FRAC AND STORE AT 'FRAC'
- LE 0,PSTWRD ADD 'PSTWRD' AND 'FRAC'
- AE 0,FRAC LEAVING RESULT IN FPR 0
- L REGB,24(0,13)
- L REGB,0(0,REGB)
- STE 0,0(REGB)
- LM REGB,REGD,24(13)
- BCR 15,14 RETURN
-ND2 CL REGD,XD0 IF REGD GE D0000000,BRANCH TO 'ND3'
- BC 11,ND3
- SLDL REGC,8 SHIFT FIRST 2 HEX DIGITS INTO REGC
- SL REGC,X68R AND SUBTRACT 00000068
- IC REGC,NTBL(REGC) FETCH CORRESPONDING BYTE FROM NTBL
- STC REGC,NSTWRD+1 STORE AS 2ND BYTE OF NSTWRD
- SRL REGD,8 TAKE REMAINING 24 BITS OF REGD
- AL REGD,PCHAR FORM FLOATING POINT FRACTION,CHAR X'3F'
- ST REGD,FRAC AND STORE AT 'FRAC'
- LE 0,NSTWRD SUBTRACT 'FRAC' FROM 'NSTWRD'
- SE 0,FRAC LEAVING RESULT IN FPR 0
- L REGB,24(0,13)
- L REGB,0(0,REGB)
- STE 0,0(REGB)
- LM REGB,REGD,24(13)
- BCR 15,14 RETURN
-ND3 CL REGD,XE2F IF REGD GE E2F00000,BRANCH TO 'ND4'
- BC 11,ND4
- SLDL REGC,12 SHIFT FIRST 3 HEX DIGITS INTO REGC
- SL REGC,XCE8 AND SUBTRACT 00000CE8
- IC REGC,NTBL(REGC) FETCH CORRESPONDING BYTE FROM NTBL
- STC REGC,PSTWRD+1 STORE AS 2ND BYTE OF PSTWRD
- SRL REGD,8 TAKE REMAINING 20 BITS OF REGD
- AL REGD,PCHAR FORM FLOATING POINT FRACTION,CHAR X'3F'
- ST REGD,FRAC AND STORE AT 'FRAC'
- LE 0,PSTWRD ADD 'PSTWRD' AND 'FRAC'
- AE 0,FRAC LEAVING RESULT IN FPR 0
- L REGB,24(0,13)
- L REGB,0(0,REGB)
- STE 0,0(REGB)
- LM REGB,REGD,24(13)
- BCR 15,14 RETURN
-ND4 CL REGD,XF5E IF REGD GE XF5E00000,BRANCH TO 'NTTHTL'
- BC 11,NTTHTL
- SLDL REGC,12 SHIFT FIRST 3 HEX DIGITS INTO REGC
- SL REGC,XE17 AND SUBTRACT 00000E17
- IC REGC,NTBL(REGC) FETCH CORRESPONDING BYTE FROM NTBL
- STC REGC,NSTWRD+1 STORE AS 2ND BYTE OF NSTWRD
- SRL REGD,8 TAKE REMAINING 20 BITS OF REGD
- AL REGD,PCHAR FORM FLOATING POINT FRACTION,CHAR X'3F'
- ST REGD,FRAC AND STORE AT 'FRAC'
- LE 0,NSTWRD SUBTRACT 'FRAC' FROM 'NSTWRD'
- SE 0,FRAC LEAVING RESULT IN FPR 0
- L REGB,24(0,13)
- L REGB,0(0,REGB)
- STE 0,0(REGB)
- LM REGB,REGD,24(13)
- BCR 15,14 RETURN
-NTTHTL ST REGD,ARG STORE REGD AS ARGUMENT FOR RNORTH ROUTINE
- STM 14,0,12(13) SAVE ALL REGISTERS FROM 14 TO 3.
- LR 3,13 COPY PREVIOUS SAVE AREA ADDRESS TO GPR3
- LA 13,SVAREA LOAD ADDRESS OF SVAREA INTO GPR13
- ST 13,8(0,3) STORE ADDRESS OF SVAREA IN SAVE AREA
- ST 3,4(0,13) STORE ADDRESS OF PREVIOUS SAVE AREA
- LA 1,ARGLST PLACE ADDRESS OF ARGUMENT LIST IN GPR 1
- L 15,ADNTH
- BALR 14,15 BRANCH TO SUBPROGRAM
- LR 13,3 RESTORE ADDRESS OF SAVE AREA IN GPR13
-*** MVI 12(13),X'FF' SET RETURN INDICATOR
- L REGB,24(0,13)
- L REGB,0(0,REGB)
- STE 0,0(REGB)
-RETRN3 LM 14,REGD,12(13) RESTORE ALL REGISTERS
- BCR 15,14 RETURN
-*
-* CALL NORRUT(SEED1,SEED2) SETS SEED1=MCGN AND SEED2=SRGN
-*
- USING NORRUT,15
-NORRUT STM REGB,REGD,24(13)
- L REGC,0(REGB)
- MVC 0(4,REGC),MCGN
- L REGD,4(REGB)
- MVC 0(4,REGD),SRGN
- LM REGB,REGD,24(13)
- BR 14
-*
-* CALL NORRIN(SEED1,SEED2) SETS MCGN=SEED1 AND SRGN=SEED2
-*
- USING NORRIN,15
-NORRIN STM REGB,REGD,24(13)
- L REGC,0(REGB)
- MVC MCGN(4),0(REGC)
- L REGD,4(REGB)
- MVC SRGN(4),0(REGD)
- LM REGB,REGD,24(13)
- BR 14
-*
-* U=UNI(0) RESULT IS NORMALIZED FLOATING POINT VALUE
-* UNIFORMLY DISTRIBUTED ON (0.0,1.0).
- USING UNI,15
-UNI STM REGB,REGD,24(13) SAVE REGISTERS 1,2,3
-RDIGT1 L REGB,SRGN LOAD SRGN INTO REGB
- LR REGC,REGB AND INTO REGC
- SRL REGC,15 SHIFT REGC RIGHT 15 BITS
- XR REGB,REGC AND XOR INTO REGB
- LR REGC,REGB COPY REGB INTO REGC
- SLL REGC,17 SHIFT IT LEFT 17 BITS,
- XR REGB,REGC AND XOR INTO REGB
- ST REGB,SRGN SAVE THE NEW 'SRGN'
- L REGD,MCGN LOAD MCGN INTO REGD
- M REGC,MULT AND MULTIPLY BY 69069
- ST REGD,MCGN STORE RESULT,MODULO 2**32, AS NEW 'MCGN'
- XR REGD,REGB XOR NEW 'MCGN' AND 'SRGN' IN REGD
- SRL REGD,8 SHIFT REGD RIGHT 8 BITS FOR F.P. FRACTION
- AL REGD,CHAR ADD CHARACTERISTIC X'40' INTO FIRST BYTE
- ST REGD,FWD STORE AT FWD, LOAD INTO FPR 0,
- LE 0,FWD AND ADD NORMALIZED TO ZERO
- AE 0,Z LEAVING RESULT 'UNI' IN FPR 0.
-RETRN1 LM REGB,REGD,24(13)
- BCR 15,14 RETURN
-*
-* V=VNI(0) RESULT IS NORMALIZED FLOATING POINT VALUE
-* UNIFORM ON (-1.0,1.0)
- USING VNI,15
-VNI STM REGB,REGD,24(13) SAVE REGISTERS 1,2,3
-RDIGT2 L REGB,SRGN LOAD SRGN INTO REGB
- LR REGC,REGB AND INTO REGC
- SRL REGC,15 SHIFT REGC RIGHT 15 BITS
- XR REGB,REGC AND XOR INTO REGB
- LR REGC,REGB COPY REGB INTO REGC
- SLL REGC,17 SHIFT IT LEFT 17 BITS,
- XR REGB,REGC AND XOR INTO REGB
- ST REGB,SRGN SAVE THE NEW 'SRGN'
- L REGD,MCGN LOAD MCGN INTO REGD
- M REGC,MULT AND MULTIPLY BY 69069
- ST REGD,MCGN STORE RESULT,MODULO 2**32, AS NEW 'MCGN'
- XR REGD,REGB XOR NEW 'MCGN' AND 'SRGN' IN REGD
- SRA REGD,7 SHIFT RIGHT 7 BITS PRESERVING SIGN BIT
- N REGD,SIGN ZERO OUT LAST 7 BITS OF FIRST BYTE
- AL REGD,CHAR ADD CHARACTERISTIC X'40' TO FIRST BYTE
- ST REGD,FWD STORE AT FWD, LOAD INTO FPR 0
- LE 0,FWD AND ADD NORMALIZED TO ZERO
- AE 0,Z LEAVING RESULT 'VNI' IN FPR 0.
-RETRN2 LM REGB,REGD,24(13)
- BCR 15,14 RETURN
-* CONSTANTS AND STORAGE RESERVATION
-SRGN DC F'01073'
-MCGN DC F'12345'
-Z DC E'0.0'
-FWD DC F'0'
-CHAR DC X'40000000'
-SIGN DC X'80FFFFFF'
-MULT DC F'69069'
-X68 DC X'68000000'
-PSTWRD DC X'41AA0000'
-NSTWRD DC X'C1AA0000'
-PCHAR DC X'3F000000'
-FRAC DC F'0'
-XD0 DC X'D0000000'
-X68R DC X'00000068'
-XE2F DC X'E2F00000'
-XCE8 DC X'00000CE8'
-XF5E DC X'F5E00000'
-XE17 DC X'00000E17'
-ARG DS F
-SVAREA DS 18F
-ARGLST DC AL4(ARG+X'80000000')
-ADNTH DC A(RNORTH)
-NTBL DC 1X'00' TABLE USED FOR NORMAL LOOK-UP
- DC 1X'01' FIRST PART HAS 104 ELEMENTS
- DC 2X'02'
- DC 4X'03'
- DC 5X'04'
- DC 1X'09'
- DC 5X'0A'
- DC 3X'0E'
- DC 1X'12'
- DC 1X'17'
- DC 5X'00' START OF SECOND PART OF NORMAL TABLE
- DC 5X'01' 223 ELEMENTS
- DC 4X'02'
- DC 2X'03'
- DC 1X'04'
- DC 5X'05'
- DC 5X'06'
- DC 5X'07'
- DC 5X'08'
- DC 4X'09'
- DC 4X'0B'
- DC 4X'0C'
- DC 4X'0D'
- DC 1X'0E'
- DC 3X'0F'
- DC 3X'10'
- DC 3X'11'
- DC 2X'12'
- DC 2X'13'
- DC 2X'14'
- DC 2X'15'
- DC 2X'16'
- DC 1X'17'
- DC 1X'18'
- DC 1X'19'
- DC 1X'1A'
- DC 1X'1B'
- DC 1X'1C'
- DC 1X'1D'
- DC 10X'05'
- DC 7X'06'
- DC 5X'07'
- DC 2X'08'
- DC 9X'0B'
- DC 5X'0C'
- DC 1X'0D'
- DC 10X'0F'
- DC 7X'10'
- DC 3X'11'
- DC 12X'13'
- DC 9X'14'
- DC 5X'15'
- DC 2X'16'
- DC 13X'18'
- DC 10X'19'
- DC 7X'1A'
- DC 5X'1B'
- DC 2X'1C'
- DC 15X'1E'
- DC 13X'1F'
- DC 12X'20'
- DC 10X'21'
- DC 9X'22'
- DC 8X'23'
- DC 7X'24'
- DC 6X'25'
- DC 5X'26'
- DC 4X'27'
- DC 3X'28'
- DC 3X'29'
- DC 2X'2A'
- DC 2X'2B'
- END
-#endif
diff --git a/src/mathlib/gen/obsolete/ibm/rnorthib.F b/src/mathlib/gen/obsolete/ibm/rnorthib.F
deleted file mode 100644
index fe3ad3f..0000000
--- a/src/mathlib/gen/obsolete/ibm/rnorthib.F
+++ /dev/null
@@ -1,47 +0,0 @@
-*
-* $Id: rnorthib.F,v 1.1.1.1 1996/04/01 15:03:05 mclareni Exp $
-*
-* $Log: rnorthib.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:05 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_IBM)
- FUNCTION RNORTH(K)
-C RNOR TOOTH FUNCTION
- DIMENSION C(45)
- DATA C/Z40FD2B5F,Z40FD2B5F,Z40FAA9AD,Z40F5A648,Z40F32496,
- $ Z40EE2131,Z40E69C1A,Z40E198B5,Z40DA139E,Z40D28E87,Z40C887BE,
- $ Z40C102A6,Z40B6FBDD,Z40ACF513,Z40A2EE4A,Z4098E780,Z40916269,
- $ Z40875BA0,Z407D54D6,Z40734E0D,Z406BC8F6,Z4061C22C,Z405A3D15,
- $ Z4052B7FE,Z404B32E7,Z4043ADD0,Z403C28B9,Z40372554,Z402FA03D,
- $ Z402A9CD8,Z40259973,Z4020960E,Z401E145C,Z401910F7,Z40168F45,
- $ Z40140D93,Z40118BE0,Z3FF0A2E4,Z3FC887BE,Z3FA06C98,Z3F785172,
- $ Z3F785172,Z3F50364C,Z3F50364C,Z3F50364C/
- DATA I1/ZFBC35400/,I2/ZFE79702E/
- IF(K.GT.I1)GOTO 3
- S=UNI(0)
- T=UNI(0)
- B=AINT(7.*(S+T)+37.*ABS(S-T))
- X=UNI(0)-UNI(0)
- RNORTH=.0625*(X+SIGN(B,X))
- RETURN
-3 IF(K.GT.I2)GOTO 5
-4 RNORTH=2.75*VNI(0)
- J=16.*ABS(RNORTH)+1.
- IF(J-14) 6,6,7
- 6 P=(J+J-1)*.1497466E-2
- GOTO 8
- 7 P=(89-J-J)*.698817E-3
-8 IF(UNI(0).GT.79.78846*(EXP(-.5*RNORTH*RNORTH)
- $ -C(J)-P*(J-16.*ABS(RNORTH)))) GOTO4
- RETURN
-5 V=VNI(0)
- IF(V.EQ.0) GOTO 5
- X=SQRT(7.5625-2.*LOG(ABS(V)))
- IF(UNI(0)*X.GT.2.75)GOTO 5
- RNORTH=SIGN(X,V)
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/obsolete/ibm/scattera.s b/src/mathlib/gen/obsolete/ibm/scattera.s
deleted file mode 100644
index e20d735..0000000
--- a/src/mathlib/gen/obsolete/ibm/scattera.s
+++ /dev/null
@@ -1,69 +0,0 @@
-*
-* $Id: scattera.s,v 1.1.1.1 1996/04/01 15:03:02 mclareni Exp $
-*
-* $Log: scattera.s,v $
-* Revision 1.1.1.1 1996/04/01 15:03:02 mclareni
-* Mathlib gen
-*
-*
-#if defined(CERNLIB_QMIBMVF)
-*********************************************************************
-*
-* CERN PROGLIB# F122 SCATTER .VERSION GEN 2.30 890530
-* ORIG. 05/30/89 F. Antonelli/IBM
-*
-*********************************************************************
-*********************************************************************
-* SUBROUTINE SCATTER(NW,OUT,INDEX,HIN)
-* DIMENSION OUT(*),HIN(*),INDEX(*)
-* DO J=1,NW
-* OUT(INDEX(J))=HIN(J)
-* ENDDO
-*********************************************************************
-SCATTER START 0
-#if defined(CERNLIB_QMIBMXA)
-SCATTER AMODE ANY
-SCATTER RMODE ANY
-#endif
- USING *,15
-*GET ADDRESS OF PARM LIST
- STM 1,6,24(13)
- LM 1,4,0(1)
-*
-*IN R1 NW
- L 1,0(0,1)
-* TEST ON VECTOR SIZE
- LA 6,128
- SR 6,1
- BC 2,NOSECT
- LA 6,4
- SR 2,6
-*
-*
-*IN R2 R3 R4 ADDRESSES OF OUT INDEX HIN
-* ADDRESSES OF SUBSEQUENT INDEX SECTION
-LOOPV VLVCU 1
- VLE 0,3
- VLE 1,4
- VSTIE 1,0,0(2)
- BC 2,LOOPV
-* CONCLUSION VECTOR
-*
- LM 1,6,24(13)
- BR 14
-* NO SECTIONING
-*
-NOSECT LA 5,4
- SR 2,5
-*
- VLVCA 0(1)
- VLE 0,3
- VLE 1,4
- VSTIE 1,0,0(2)
-* CONCLUSION NO SECTIONING
-*
- LM 1,6,24(13)
- BR 14
-*
- END
-#endif
diff --git a/src/mathlib/gen/obsolete/ibm/wheneqa.s b/src/mathlib/gen/obsolete/ibm/wheneqa.s
deleted file mode 100644
index ebd21ca..0000000
--- a/src/mathlib/gen/obsolete/ibm/wheneqa.s
+++ /dev/null
@@ -1,118 +0,0 @@
-*
-* $Id: wheneqa.s,v 1.1.1.1 1996/04/01 15:03:03 mclareni Exp $
-*
-* $Log: wheneqa.s,v $
-* Revision 1.1.1.1 1996/04/01 15:03:03 mclareni
-* Mathlib gen
-*
-*
-#if defined(CERNLIB_QMIBMVF)
-*********************************************************************
-*
-* CERN PROGLIB# F122 WHENEQ .VERSION GEN 2.30 890530
-* ORIG. 05/30/89 F. Antonelli/IBM
-*
-*********************************************************************
-*********************************************************************
-* SUBROUTINE WHENEQ(NW,IN,ISTR,ITEST,INDEX,IFOUND)
-* DIMENSION IN(*),INDEX(*)
-* IFOUND=0
-* INDICE=1
-* IF(INDICE.LT.0)INDICE=-ISTR*(NW-1)+1
-* DO J=1,NW
-* IF(IN(INDICE).EQ.ITEST) THEN
-* IFOUND=IFOUND+1
-* INDEX(IFOUND)=INDICE
-* ENDIF
-* INDICE=INDICE+ISTR
-* ENDDO
-*********************************************************************
-WHENEQ START 0
-#if defined(CERNLIB_QMIBMXA)
-WHENEQ AMODE ANY
-WHENEQ RMODE ANY
-#endif
- USING *,15
- STM 0,9,20(13)
-* R2 IN, R3 ISRT, R4 ITEST, R5 INDEX, R6 IFOUND
- LM 1,6,0(1)
-*
-*IN R1 NW - IN R3 ISTR - IN R4 ITEST
- L 8,0(0,1)
- L 4,0(0,4)
- L 3,0(0,3)
- SR 1,1
-* CHECK THE STRIDE IF < 0 BACKWARD
- SR 1,3
- BC 2,BACK
-* TEST ON VECTOR SIZE IF VS LE 128 NO SECTIONING
- LA 1,128
- SR 1,8
- BC 2,NOSECT
-*
- LA 7,1
- SR 9,9
-LOOP VLVCU 8
- VCS 8,4,2(3)
- VCOVM 9
- VLINT 0,7(3)
- VSTKE 0,5
- LTR 8,8
- BC 2,LOOP
- ST 9,0(6)
- LM 0,9,20(13)
- BR 14
-*
-NOSECT VLVCA 0(8)
- LA 7,1
- SR 9,9
-*
- VCS 8,4,2(3)
- VCOVM 9
- VLINT 0,7(3)
- VSTKE 0,5
- ST 9,0(6)
- LM 0,9,20(13)
- BR 14
-* BACKWARD SECTION ISTR < 0
-BACK EQU *
- LA 7,1
-* SET THE STARTING POINT TO -ISTR*NW+ISTR+1
- LPR 1,3
- MR 0,8
- AR 1,3
- LR 9,1
- AR 9,7
- LA 7,4
- MR 0,7
- AR 1,2
-*
-* TEST ON VECTOR SIZE IF VS LE 128 NO SECTIONING
- LA 7,128
- SR 7,8
- BC 2,NOSEC1
- SR 7,7
-*
-LOOP1 VLVCU 8
- VCS 8,4,1(3)
- VCOVM 7
- VLINT 0,9(3)
- VSTKE 0,5
- LTR 8,8
- BC 2,LOOP1
- ST 7,0(6)
- LM 0,9,20(13)
- BR 14
-*
-NOSEC1 SR 7,7
-*
- VLVCA 0(8)
- VCS 8,4,1(3)
- VCOVM 7
- VLINT 0,9(3)
- VSTKE 0,5
- ST 7,0(6)
- LM 0,9,20(13)
- BR 14
- END
-#endif
diff --git a/src/mathlib/gen/obsolete/ibm/whenfgea.s b/src/mathlib/gen/obsolete/ibm/whenfgea.s
deleted file mode 100644
index 3983531..0000000
--- a/src/mathlib/gen/obsolete/ibm/whenfgea.s
+++ /dev/null
@@ -1,118 +0,0 @@
-*
-* $Id: whenfgea.s,v 1.1.1.1 1996/04/01 15:03:03 mclareni Exp $
-*
-* $Log: whenfgea.s,v $
-* Revision 1.1.1.1 1996/04/01 15:03:03 mclareni
-* Mathlib gen
-*
-*
-#if defined(CERNLIB_QMIBMVF)
-*********************************************************************
-*
-* CERN PROGLIB# F122 WHENFGE .VERSION GEN 2.30 890530
-* ORIG. 05/30/89 F. Antonelli/IBM
-*
-*********************************************************************
-*********************************************************************
-* SUBROUTINE WHENFGE(NW,AN,ISTR,ATEST,INDEX,IFOUND)
-* DIMENSION AN(*),INDEX(*)
-* IFOUND=0
-* INDICE=1
-* IF(INDICE.LT.0)INDICE=-ISTR*(NW-1)+1
-* DO J=1,NW
-* IF(AN(INDICE).GE.ATEST) THEN
-* IFOUND=IFOUND+1
-* INDEX(IFOUND)=INDICE
-* ENDIF
-* INDICE=INDICE+ISTR
-* ENDDO
-*********************************************************************
-WHENFGE START 0
-#if defined(CERNLIB_QMIBMXA)
-WHENFGE AMODE ANY
-WHENFGE RMODE ANY
-#endif
- USING *,15
- STM 0,9,20(13)
-* R2 IN, R3 ISRT, R4 ITEST, R5 INDEX, R6 IFOUND
- LM 1,6,0(1)
-*
-*IN R1 NW - IN R3 ISTR - IN R4 ITEST
- L 8,0(0,1)
- LE 0,0(0,4)
- L 3,0(0,3)
- SR 1,1
-* CHECK THE STRIDE IF < 0 BACKWARD
- SR 1,3
- BC 2,BACK
-* TEST ON VECTOR SIZE IF VS LE 128 NO SECTIONING
- LA 1,128
- SR 1,8
- BC 2,NOSECT
-*
- LA 7,1
- SR 9,9
-LOOP VLVCU 8
- VCES 12,0,2(3)
- VCOVM 9
- VLINT 0,7(3)
- VSTKE 0,5
- LTR 8,8
- BC 2,LOOP
- ST 9,0(6)
- LM 0,9,20(13)
- BR 14
-*
-NOSECT VLVCA 0(8)
- LA 7,1
- SR 9,9
-*
- VCES 12,0,2(3)
- VCOVM 9
- VLINT 0,7(3)
- VSTKE 0,5
- ST 9,0(6)
- LM 0,9,20(13)
- BR 14
-* BACKWARD SECTION ISTR < 0
-BACK EQU *
- LA 7,1
-* SET THE STARTING POINT TO -ISTR*NW+ISTR+1
- LPR 1,3
- MR 0,8
- AR 1,3
- LR 9,1
- AR 9,7
- LA 7,4
- MR 0,7
- AR 1,2
-*
-* TEST ON VECTOR SIZE IF VS LE 128 NO SECTIONING
- LA 7,128
- SR 7,8
- BC 2,NOSEC1
- SR 7,7
-*
-LOOP1 VLVCU 8
- VCES 12,0,1(3)
- VCOVM 7
- VLINT 0,9(3)
- VSTKE 0,5
- LTR 8,8
- BC 2,LOOP1
- ST 7,0(6)
- LM 0,9,20(13)
- BR 14
-*
-NOSEC1 SR 7,7
-*
- VLVCA 0(8)
- VCES 12,0,1(3)
- VCOVM 7
- VLINT 0,9(3)
- VSTKE 0,5
- ST 7,0(6)
- LM 0,9,20(13)
- BR 14
- END
-#endif
diff --git a/src/mathlib/gen/obsolete/ibm/whenfgta.s b/src/mathlib/gen/obsolete/ibm/whenfgta.s
deleted file mode 100644
index 6439707..0000000
--- a/src/mathlib/gen/obsolete/ibm/whenfgta.s
+++ /dev/null
@@ -1,118 +0,0 @@
-*
-* $Id: whenfgta.s,v 1.1.1.1 1996/04/01 15:03:03 mclareni Exp $
-*
-* $Log: whenfgta.s,v $
-* Revision 1.1.1.1 1996/04/01 15:03:03 mclareni
-* Mathlib gen
-*
-*
-#if defined(CERNLIB_QMIBMVF)
-*********************************************************************
-*
-* CERN PROGLIB# F122 WHENFGT .VERSION GEN 2.30 890530
-* ORIG. 05/30/89 F. Antonelli/IBM
-*
-*********************************************************************
-*********************************************************************
-* SUBROUTINE WHENFGT(NW,AN,ISTR,ATEST,INDEX,IFOUND)
-* DIMENSION AN(*),INDEX(*)
-* IFOUND=0
-* INDICE=1
-* IF(INDICE.LT.0)INDICE=-ISTR*(NW-1)+1
-* DO J=1,NW
-* IF(AN(INDICE).GT.ATEST) THEN
-* IFOUND=IFOUND+1
-* INDEX(IFOUND)=INDICE
-* ENDIF
-* INDICE=INDICE+ISTR
-* ENDDO
-*********************************************************************
-WHENFGT START 0
-#if defined(CERNLIB_QMIBMXA)
-WHENFGT AMODE ANY
-WHENFGT RMODE ANY
-#endif
- USING *,15
- STM 0,9,20(13)
-* R2 IN, R3 ISRT, R4 ITEST, R5 INDEX, R6 IFOUND
- LM 1,6,0(1)
-*
-*IN R1 NW - IN R3 ISTR - IN R4 ITEST
- L 8,0(0,1)
- LE 0,0(0,4)
- L 3,0(0,3)
- SR 1,1
-* CHECK THE STRIDE IF < 0 BACKWARD
- SR 1,3
- BC 2,BACK
-* TEST ON VECTOR SIZE IF VS LE 128 NO SECTIONING
- LA 1,128
- SR 1,8
- BC 2,NOSECT
-*
- LA 7,1
- SR 9,9
-LOOP VLVCU 8
- VCES 4,0,2(3)
- VCOVM 9
- VLINT 0,7(3)
- VSTKE 0,5
- LTR 8,8
- BC 2,LOOP
- ST 9,0(6)
- LM 0,9,20(13)
- BR 14
-*
-NOSECT VLVCA 0(8)
- LA 7,1
- SR 9,9
-*
- VCES 4,0,2(3)
- VCOVM 9
- VLINT 0,7(3)
- VSTKE 0,5
- ST 9,0(6)
- LM 0,9,20(13)
- BR 14
-* BACKWARD SECTION ISTR < 0
-BACK EQU *
- LA 7,1
-* SET THE STARTING POINT TO -ISTR*NW+ISTR+1
- LPR 1,3
- MR 0,8
- AR 1,3
- LR 9,1
- AR 9,7
- LA 7,4
- MR 0,7
- AR 1,2
-*
-* TEST ON VECTOR SIZE IF VS LE 128 NO SECTIONING
- LA 7,128
- SR 7,8
- BC 2,NOSEC1
- SR 7,7
-*
-LOOP1 VLVCU 8
- VCES 4,0,1(3)
- VCOVM 7
- VLINT 0,9(3)
- VSTKE 0,5
- LTR 8,8
- BC 2,LOOP1
- ST 7,0(6)
- LM 0,9,20(13)
- BR 14
-*
-NOSEC1 SR 7,7
-*
- VLVCA 0(8)
- VCES 4,0,1(3)
- VCOVM 7
- VLINT 0,9(3)
- VSTKE 0,5
- ST 7,0(6)
- LM 0,9,20(13)
- BR 14
- END
-#endif
diff --git a/src/mathlib/gen/obsolete/ibm/whenflea.s b/src/mathlib/gen/obsolete/ibm/whenflea.s
deleted file mode 100644
index 365c7c1..0000000
--- a/src/mathlib/gen/obsolete/ibm/whenflea.s
+++ /dev/null
@@ -1,118 +0,0 @@
-*
-* $Id: whenflea.s,v 1.1.1.1 1996/04/01 15:03:04 mclareni Exp $
-*
-* $Log: whenflea.s,v $
-* Revision 1.1.1.1 1996/04/01 15:03:04 mclareni
-* Mathlib gen
-*
-*
-#if defined(CERNLIB_QMIBMVF)
-*********************************************************************
-*
-* CERN PROGLIB# F122 WHENFLE .VERSION GEN 2.30 890530
-* ORIG. 05/30/89 F. Antonelli/IBM
-*
-*********************************************************************
-*********************************************************************
-* SUBROUTINE WHENFLE(NW,AN,ISTR,ATEST,INDEX,IFOUND)
-* DIMENSION AN(*),INDEX(*)
-* IFOUND=0
-* INDICE=1
-* IF(INDICE.LT.0)INDICE=-ISTR*(NW-1)+1
-* DO J=1,NW
-* IF(AN(INDICE).LE.ATEST) THEN
-* IFOUND=IFOUND+1
-* INDEX(IFOUND)=INDICE
-* ENDIF
-* INDICE=INDICE+ISTR
-* ENDDO
-*********************************************************************
-WHENFLE START 0
-#if defined(CERNLIB_QMIBMXA)
-WHENFLE AMODE ANY
-WHENFLE RMODE ANY
-#endif
- USING *,15
- STM 0,9,20(13)
-* R2 IN, R3 ISRT, R4 ITEST, R5 INDEX, R6 IFOUND
- LM 1,6,0(1)
-*
-*IN R1 NW - IN R3 ISTR - IN R4 ITEST
- L 8,0(0,1)
- LE 0,0(0,4)
- L 3,0(0,3)
- SR 1,1
-* CHECK THE STRIDE IF < 0 BACKWARD
- SR 1,3
- BC 2,BACK
-* TEST ON VECTOR SIZE IF VS LE 128 NO SECTIONING
- LA 1,128
- SR 1,8
- BC 2,NOSECT
-*
- LA 7,1
- SR 9,9
-LOOP VLVCU 8
- VCES 10,0,2(3)
- VCOVM 9
- VLINT 0,7(3)
- VSTKE 0,5
- LTR 8,8
- BC 2,LOOP
- ST 9,0(6)
- LM 0,9,20(13)
- BR 14
-*
-NOSECT VLVCA 0(8)
- LA 7,1
- SR 9,9
-*
- VCES 10,0,2(3)
- VCOVM 9
- VLINT 0,7(3)
- VSTKE 0,5
- ST 9,0(6)
- LM 0,9,20(13)
- BR 14
-* BACKWARD SECTION ISTR < 0
-BACK EQU *
- LA 7,1
-* SET THE STARTING POINT TO -ISTR*NW+ISTR+1
- LPR 1,3
- MR 0,8
- AR 1,3
- LR 9,1
- AR 9,7
- LA 7,4
- MR 0,7
- AR 1,2
-*
-* TEST ON VECTOR SIZE IF VS LE 128 NO SECTIONING
- LA 7,128
- SR 7,8
- BC 2,NOSEC1
- SR 7,7
-*
-LOOP1 VLVCU 8
- VCES 10,0,1(3)
- VCOVM 7
- VLINT 0,9(3)
- VSTKE 0,5
- LTR 8,8
- BC 2,LOOP1
- ST 7,0(6)
- LM 0,9,20(13)
- BR 14
-*
-NOSEC1 SR 7,7
-*
- VLVCA 0(8)
- VCES 10,0,1(3)
- VCOVM 7
- VLINT 0,9(3)
- VSTKE 0,5
- ST 7,0(6)
- LM 0,9,20(13)
- BR 14
- END
-#endif
diff --git a/src/mathlib/gen/obsolete/ibm/whenflta.s b/src/mathlib/gen/obsolete/ibm/whenflta.s
deleted file mode 100644
index 7d57ac6..0000000
--- a/src/mathlib/gen/obsolete/ibm/whenflta.s
+++ /dev/null
@@ -1,118 +0,0 @@
-*
-* $Id: whenflta.s,v 1.1.1.1 1996/04/01 15:03:04 mclareni Exp $
-*
-* $Log: whenflta.s,v $
-* Revision 1.1.1.1 1996/04/01 15:03:04 mclareni
-* Mathlib gen
-*
-*
-#if defined(CERNLIB_QMIBMVF)
-*********************************************************************
-*
-* CERN PROGLIB# F122 WHENFLT .VERSION GEN 2.30 890530
-* ORIG. 05/30/89 F. Antonelli/IBM
-*
-*********************************************************************
-*********************************************************************
-* SUBROUTINE WHENFLT(NW,AN,ISTR,ATEST,INDEX,IFOUND)
-* DIMENSION AN(*),INDEX(*)
-* IFOUND=0
-* INDICE=1
-* IF(INDICE.LT.0)INDICE=-ISTR*(NW-1)+1
-* DO J=1,NW
-* IF(AN(INDICE).EQ.ATEST) THEN
-* IFOUND=IFOUND+1
-* INDEX(IFOUND)=INDICE
-* ENDIF
-* INDICE=INDICE+ISTR
-* ENDDO
-*********************************************************************
-WHENFLT START 0
-#if defined(CERNLIB_QMIBMXA)
-WHENFLT AMODE ANY
-WHENFLT RMODE ANY
-#endif
- USING *,15
- STM 0,9,20(13)
-* R2 IN, R3 ISRT, R4 ITEST, R5 INDEX, R6 IFOUND
- LM 1,6,0(1)
-*
-*IN R1 NW - IN R3 ISTR - IN R4 ITEST
- L 8,0(0,1)
- LE 0,0(0,4)
- L 3,0(0,3)
- SR 1,1
-* CHECK THE STRIDE IF < 0 BACKWARD
- SR 1,3
- BC 2,BACK
-* TEST ON VECTOR SIZE IF VS LE 128 NO SECTIONING
- LA 1,128
- SR 1,8
- BC 2,NOSECT
-*
- LA 7,1
- SR 9,9
-LOOP VLVCU 8
- VCES 2,0,2(3)
- VCOVM 9
- VLINT 0,7(3)
- VSTKE 0,5
- LTR 8,8
- BC 2,LOOP
- ST 9,0(6)
- LM 0,9,20(13)
- BR 14
-*
-NOSECT VLVCA 0(8)
- LA 7,1
- SR 9,9
-*
- VCES 2,0,2(3)
- VCOVM 9
- VLINT 0,7(3)
- VSTKE 0,5
- ST 9,0(6)
- LM 0,9,20(13)
- BR 14
-* BACKWARD SECTION ISTR < 0
-BACK EQU *
- LA 7,1
-* SET THE STARTING POINT TO -ISTR*NW+ISTR+1
- LPR 1,3
- MR 0,8
- AR 1,3
- LR 9,1
- AR 9,7
- LA 7,4
- MR 0,7
- AR 1,2
-*
-* TEST ON VECTOR SIZE IF VS LE 128 NO SECTIONING
- LA 7,128
- SR 7,8
- BC 2,NOSEC1
- SR 7,7
-*
-LOOP1 VLVCU 8
- VCES 2,0,1(3)
- VCOVM 7
- VLINT 0,9(3)
- VSTKE 0,5
- LTR 8,8
- BC 2,LOOP1
- ST 7,0(6)
- LM 0,9,20(13)
- BR 14
-*
-NOSEC1 SR 7,7
-*
- VLVCA 0(8)
- VCES 2,0,1(3)
- VCOVM 7
- VLINT 0,9(3)
- VSTKE 0,5
- ST 7,0(6)
- LM 0,9,20(13)
- BR 14
- END
-#endif
diff --git a/src/mathlib/gen/obsolete/ibm/whenigea.s b/src/mathlib/gen/obsolete/ibm/whenigea.s
deleted file mode 100644
index d163c0c..0000000
--- a/src/mathlib/gen/obsolete/ibm/whenigea.s
+++ /dev/null
@@ -1,118 +0,0 @@
-*
-* $Id: whenigea.s,v 1.1.1.1 1996/04/01 15:03:04 mclareni Exp $
-*
-* $Log: whenigea.s,v $
-* Revision 1.1.1.1 1996/04/01 15:03:04 mclareni
-* Mathlib gen
-*
-*
-#if defined(CERNLIB_QMIBMVF)
-*********************************************************************
-*
-* CERN PROGLIB# F122 WHENIGE .VERSION GEN 2.30 890530
-* ORIG. 05/30/89 F. Antonelli/IBM
-*
-*********************************************************************
-*********************************************************************
-* SUBROUTINE WHENIGE(NW,IN,ISTR,ITEST,INDEX,IFOUND)
-* DIMENSION IN(*),INDEX(*)
-* IFOUND=0
-* INDICE=1
-* IF(INDICE.GE.0)INDICE=-ISTR*(NW-1)+1
-* DO J=1,NW
-* IF(IN(INDICE).GE.ITEST) THEN
-* IFOUND=IFOUND+1
-* INDEX(IFOUND)=INDICE
-* ENDIF
-* INDICE=INDICE+ISTR
-* ENDDO
-*********************************************************************
-WHENIGE START 0
-#if defined(CERNLIB_QMIBMXA)
-WHENIGE AMODE ANY
-WHENIGE RMODE ANY
-#endif
- USING *,15
- STM 0,9,20(13)
-* R2 IN, R3 ISRT, R4 ITEST, R5 INDEX, R6 IFOUND
- LM 1,6,0(1)
-*
-*IN R1 NW - IN R3 ISTR - IN R4 ITEST
- L 8,0(0,1)
- L 4,0(0,4)
- L 3,0(0,3)
- SR 1,1
-* CHECK THE STRIDE IF < 0 BACKWARD
- SR 1,3
- BC 2,BACK
-* TEST ON VECTOR SIZE IF VS LE 128 NO SECTIONING
- LA 1,128
- SR 1,8
- BC 2,NOSECT
-*
- LA 7,1
- SR 9,9
-LOOP VLVCU 8
- VCS 12,4,2(3)
- VCOVM 9
- VLINT 0,7(3)
- VSTKE 0,5
- LTR 8,8
- BC 2,LOOP
- ST 9,0(6)
- LM 0,9,20(13)
- BR 14
-*
-NOSECT VLVCA 0(8)
- LA 7,1
- SR 9,9
-*
- VCS 12,4,2(3)
- VCOVM 9
- VLINT 0,7(3)
- VSTKE 0,5
- ST 9,0(6)
- LM 0,9,20(13)
- BR 14
-* BACKWARD SECTION ISTR < 0
-BACK EQU *
- LA 7,1
-* SET THE STARTING POINT TO -ISTR*NW+ISTR+1
- LPR 1,3
- MR 0,8
- AR 1,3
- LR 9,1
- AR 9,7
- LA 7,4
- MR 0,7
- AR 1,2
-*
-* TEST ON VECTOR SIZE IF VS LE 128 NO SECTIONING
- LA 7,128
- SR 7,8
- BC 2,NOSEC1
- SR 7,7
-*
-LOOP1 VLVCU 8
- VCS 12,4,1(3)
- VCOVM 7
- VLINT 0,9(3)
- VSTKE 0,5
- LTR 8,8
- BC 2,LOOP1
- ST 7,0(6)
- LM 0,9,20(13)
- BR 14
-*
-NOSEC1 SR 7,7
-*
- VLVCA 0(8)
- VCS 12,4,1(3)
- VCOVM 7
- VLINT 0,9(3)
- VSTKE 0,5
- ST 7,0(6)
- LM 0,9,20(13)
- BR 14
- END
-#endif
diff --git a/src/mathlib/gen/obsolete/ibm/whenigta.s b/src/mathlib/gen/obsolete/ibm/whenigta.s
deleted file mode 100644
index 73551a2..0000000
--- a/src/mathlib/gen/obsolete/ibm/whenigta.s
+++ /dev/null
@@ -1,118 +0,0 @@
-*
-* $Id: whenigta.s,v 1.1.1.1 1996/04/01 15:03:04 mclareni Exp $
-*
-* $Log: whenigta.s,v $
-* Revision 1.1.1.1 1996/04/01 15:03:04 mclareni
-* Mathlib gen
-*
-*
-#if defined(CERNLIB_QMIBMVF)
-*********************************************************************
-*
-* CERN PROGLIB# F122 WHENIGT .VERSION GEN 2.30 890530
-* ORIG. 05/30/89 F. Antonelli/IBM
-*
-*********************************************************************
-*********************************************************************
-* SUBROUTINE WHENIGT(NW,IN,ISTR,ITEST,INDEX,IFOUND)
-* DIMENSION IN(*),INDEX(*)
-* IFOUND=0
-* INDICE=1
-* IF(INDICE.LT.0)INDICE=-ISTR*(NW-1)+1
-* DO J=1,NW
-* IF(IN(INDICE).GT.ITEST) THEN
-* IFOUND=IFOUND+1
-* INDEX(IFOUND)=INDICE
-* ENDIF
-* INDICE=INDICE+ISTR
-* ENDDO
-*********************************************************************
-WHENIGT START 0
-#if defined(CERNLIB_QMIBMXA)
-WHENIGT AMODE ANY
-WHENIGT RMODE ANY
-#endif
- USING *,15
- STM 0,9,20(13)
-* R2 IN, R3 ISRT, R4 ITEST, R5 INDEX, R6 IFOUND
- LM 1,6,0(1)
-*
-*IN R1 NW - IN R3 ISTR - IN R4 ITEST
- L 8,0(0,1)
- L 4,0(0,4)
- L 3,0(0,3)
- SR 1,1
-* CHECK THE STRIDE IF < 0 BACKWARD
- SR 1,3
- BC 2,BACK
-* TEST ON VECTOR SIZE IF VS LE 128 NO SECTIONING
- LA 1,128
- SR 1,8
- BC 2,NOSECT
-*
- LA 7,1
- SR 9,9
-LOOP VLVCU 8
- VCS 4,4,2(3)
- VCOVM 9
- VLINT 0,7(3)
- VSTKE 0,5
- LTR 8,8
- BC 2,LOOP
- ST 9,0(6)
- LM 0,9,20(13)
- BR 14
-*
-NOSECT VLVCA 0(8)
- LA 7,1
- SR 9,9
-*
- VCS 4,4,2(3)
- VCOVM 9
- VLINT 0,7(3)
- VSTKE 0,5
- ST 9,0(6)
- LM 0,9,20(13)
- BR 14
-* BACKWARD SECTION ISTR < 0
-BACK EQU *
- LA 7,1
-* SET THE STARTING POINT TO -ISTR*NW+ISTR+1
- LPR 1,3
- MR 0,8
- AR 1,3
- LR 9,1
- AR 9,7
- LA 7,4
- MR 0,7
- AR 1,2
-*
-* TEST ON VECTOR SIZE IF VS LE 128 NO SECTIONING
- LA 7,128
- SR 7,8
- BC 2,NOSEC1
- SR 7,7
-*
-LOOP1 VLVCU 8
- VCS 4,4,1(3)
- VCOVM 7
- VLINT 0,9(3)
- VSTKE 0,5
- LTR 8,8
- BC 2,LOOP1
- ST 7,0(6)
- LM 0,9,20(13)
- BR 14
-*
-NOSEC1 SR 7,7
-*
- VLVCA 0(8)
- VCS 4,4,1(3)
- VCOVM 7
- VLINT 0,9(3)
- VSTKE 0,5
- ST 7,0(6)
- LM 0,9,20(13)
- BR 14
- END
-#endif
diff --git a/src/mathlib/gen/obsolete/ibm/whenilea.s b/src/mathlib/gen/obsolete/ibm/whenilea.s
deleted file mode 100644
index fb0b6d7..0000000
--- a/src/mathlib/gen/obsolete/ibm/whenilea.s
+++ /dev/null
@@ -1,118 +0,0 @@
-*
-* $Id: whenilea.s,v 1.1.1.1 1996/04/01 15:03:04 mclareni Exp $
-*
-* $Log: whenilea.s,v $
-* Revision 1.1.1.1 1996/04/01 15:03:04 mclareni
-* Mathlib gen
-*
-*
-#if defined(CERNLIB_QMIBMVF)
-*********************************************************************
-*
-* CERN PROGLIB# F122 WHENILE .VERSION GEN 2.30 890530
-* ORIG. 05/30/89 F. Antonelli/IBM
-*
-*********************************************************************
-*********************************************************************
-* SUBROUTINE WHENILE(NW,IN,ISTR,ITEST,INDEX,IFOUND)
-* DIMENSION IN(*),INDEX(*)
-* IFOUND=0
-* INDICE=1
-* IF(INDICE.LT.0)INDICE=-ISTR*(NW-1)+1
-* DO J=1,NW
-* IF(IN(INDICE).LE.ITEST) THEN
-* IFOUND=IFOUND+1
-* INDEX(IFOUND)=INDICE
-* ENDIF
-* INDICE=INDICE+ISTR
-* ENDDO
-*********************************************************************
-WHENILE START 0
-#if defined(CERNLIB_QMIBMXA)
-WHENILE AMODE ANY
-WHENILE RMODE ANY
-#endif
- USING *,15
- STM 0,9,20(13)
-* R2 IN, R3 ISRT, R4 ITEST, R5 INDEX, R6 IFOUND
- LM 1,6,0(1)
-*
-*IN R1 NW - IN R3 ISTR - IN R4 ITEST
- L 8,0(0,1)
- L 4,0(0,4)
- L 3,0(0,3)
- SR 1,1
-* CHECK THE STRIDE IF < 0 BACKWARD
- SR 1,3
- BC 2,BACK
-* TEST ON VECTOR SIZE IF VS LE 128 NO SECTIONING
- LA 1,128
- SR 1,8
- BC 2,NOSECT
-*
- LA 7,1
- SR 9,9
-LOOP VLVCU 8
- VCS 10,4,2(3)
- VCOVM 9
- VLINT 0,7(3)
- VSTKE 0,5
- LTR 8,8
- BC 2,LOOP
- ST 9,0(6)
- LM 0,9,20(13)
- BR 14
-*
-NOSECT VLVCA 0(8)
- LA 7,1
- SR 9,9
-*
- VCS 10,4,2(3)
- VCOVM 9
- VLINT 0,7(3)
- VSTKE 0,5
- ST 9,0(6)
- LM 0,9,20(13)
- BR 14
-* BACKWARD SECTION ISTR < 0
-BACK EQU *
- LA 7,1
-* SET THE STARTING POINT TO -ISTR*NW+ISTR+1
- LPR 1,3
- MR 0,8
- AR 1,3
- LR 9,1
- AR 9,7
- LA 7,4
- MR 0,7
- AR 1,2
-*
-* TEST ON VECTOR SIZE IF VS LE 128 NO SECTIONING
- LA 7,128
- SR 7,8
- BC 2,NOSEC1
- SR 7,7
-*
-LOOP1 VLVCU 8
- VCS 10,4,1(3)
- VCOVM 7
- VLINT 0,9(3)
- VSTKE 0,5
- LTR 8,8
- BC 2,LOOP1
- ST 7,0(6)
- LM 0,9,20(13)
- BR 14
-*
-NOSEC1 SR 7,7
-*
- VLVCA 0(8)
- VCS 10,4,1(3)
- VCOVM 7
- VLINT 0,9(3)
- VSTKE 0,5
- ST 7,0(6)
- LM 0,9,20(13)
- BR 14
- END
-#endif
diff --git a/src/mathlib/gen/obsolete/ibm/whenilta.s b/src/mathlib/gen/obsolete/ibm/whenilta.s
deleted file mode 100644
index 1988334..0000000
--- a/src/mathlib/gen/obsolete/ibm/whenilta.s
+++ /dev/null
@@ -1,118 +0,0 @@
-*
-* $Id: whenilta.s,v 1.1.1.1 1996/04/01 15:03:04 mclareni Exp $
-*
-* $Log: whenilta.s,v $
-* Revision 1.1.1.1 1996/04/01 15:03:04 mclareni
-* Mathlib gen
-*
-*
-#if defined(CERNLIB_QMIBMVF)
-*********************************************************************
-*
-* CERN PROGLIB# F122 WHENILT .VERSION GEN 2.30 890530
-* ORIG. 05/30/89 F. Antonelli/IBM
-*
-*********************************************************************
-*********************************************************************
-* SUBROUTINE WHENILT(NW,IN,ISTR,ITEST,INDEX,IFOUND)
-* DIMENSION IN(*),INDEX(*)
-* IFOUND=0
-* INDICE=1
-* IF(INDICE.LT.0)INDICE=-ISTR*(NW-1)+1
-* DO J=1,NW
-* IF(IN(INDICE).LT.ITEST) THEN
-* IFOUND=IFOUND+1
-* INDEX(IFOUND)=INDICE
-* ENDIF
-* INDICE=INDICE+ISTR
-* ENDDO
-*********************************************************************
-WHENILT START 0
-#if defined(CERNLIB_QMIBMXA)
-WHENILT AMODE ANY
-WHENILT RMODE ANY
-#endif
- USING *,15
- STM 0,9,20(13)
-* R2 IN, R3 ISRT, R4 ITEST, R5 INDEX, R6 IFOUND
- LM 1,6,0(1)
-*
-*IN R1 NW - IN R3 ISTR - IN R4 ITEST
- L 8,0(0,1)
- L 4,0(0,4)
- L 3,0(0,3)
- SR 1,1
-* CHECK THE STRIDE IF < 0 BACKWARD
- SR 1,3
- BC 2,BACK
-* TEST ON VECTOR SIZE IF VS LE 128 NO SECTIONING
- LA 1,128
- SR 1,8
- BC 2,NOSECT
-*
- LA 7,1
- SR 9,9
-LOOP VLVCU 8
- VCS 2,4,2(3)
- VCOVM 9
- VLINT 0,7(3)
- VSTKE 0,5
- LTR 8,8
- BC 2,LOOP
- ST 9,0(6)
- LM 0,9,20(13)
- BR 14
-*
-NOSECT VLVCA 0(8)
- LA 7,1
- SR 9,9
-*
- VCS 2,4,2(3)
- VCOVM 9
- VLINT 0,7(3)
- VSTKE 0,5
- ST 9,0(6)
- LM 0,9,20(13)
- BR 14
-* BACKWARD SECTION ISTR < 0
-BACK EQU *
- LA 7,1
-* SET THE STARTING POINT TO -ISTR*NW+ISTR+1
- LPR 1,3
- MR 0,8
- AR 1,3
- LR 9,1
- AR 9,7
- LA 7,4
- MR 0,7
- AR 1,2
-*
-* TEST ON VECTOR SIZE IF VS LE 128 NO SECTIONING
- LA 7,128
- SR 7,8
- BC 2,NOSEC1
- SR 7,7
-*
-LOOP1 VLVCU 8
- VCS 2,4,1(3)
- VCOVM 7
- VLINT 0,9(3)
- VSTKE 0,5
- LTR 8,8
- BC 2,LOOP1
- ST 7,0(6)
- LM 0,9,20(13)
- BR 14
-*
-NOSEC1 SR 7,7
-*
- VLVCA 0(8)
- VCS 2,4,1(3)
- VCOVM 7
- VLINT 0,9(3)
- VSTKE 0,5
- ST 7,0(6)
- LM 0,9,20(13)
- BR 14
- END
-#endif
diff --git a/src/mathlib/gen/obsolete/ibm/whennea.s b/src/mathlib/gen/obsolete/ibm/whennea.s
deleted file mode 100644
index 2f90805..0000000
--- a/src/mathlib/gen/obsolete/ibm/whennea.s
+++ /dev/null
@@ -1,118 +0,0 @@
-*
-* $Id: whennea.s,v 1.1.1.1 1996/04/01 15:03:04 mclareni Exp $
-*
-* $Log: whennea.s,v $
-* Revision 1.1.1.1 1996/04/01 15:03:04 mclareni
-* Mathlib gen
-*
-*
-#if defined(CERNLIB_QMIBMVF)
-*********************************************************************
-*
-* CERN PROGLIB# F122 WHENNE .VERSION GEN 2.30 890530
-* ORIG. 05/30/89 F. Antonelli/IBM
-*
-*********************************************************************
-*********************************************************************
-* SUBROUTINE WHENNE(NW,IN,ISTR,ITEST,INDEX,IFOUND)
-* DIMENSION IN(*),INDEX(*)
-* IFOUND=0
-* INDICE=1
-* IF(INDICE.LT.0)INDICE=-ISTR*(NW-1)+1
-* DO J=1,NW
-* IF(IN(INDICE).NE.ITEST) THEN
-* IFOUND=IFOUND+1
-* INDEX(IFOUND)=INDICE
-* ENDIF
-* INDICE=INDICE+ISTR
-* ENDDO
-*********************************************************************
-WHENNE START 0
-#if defined(CERNLIB_QMIBMXA)
-WHENNE AMODE ANY
-WHENNE RMODE ANY
-#endif
- USING *,15
- STM 0,9,20(13)
-* R2 IN, R3 ISRT, R4 ITEST, R5 INDEX, R6 IFOUND
- LM 1,6,0(1)
-*
-*IN R1 NW - IN R3 ISTR - IN R4 ITEST
- L 8,0(0,1)
- L 4,0(0,4)
- L 3,0(0,3)
- SR 1,1
-* CHECK THE STRIDE IF < 0 BACKWARD
- SR 1,3
- BC 2,BACK
-* TEST ON VECTOR SIZE IF VS LE 128 NO SECTIONING
- LA 1,128
- SR 1,8
- BC 2,NOSECT
-*
- LA 7,1
- SR 9,9
-LOOP VLVCU 8
- VCS 6,4,2(3)
- VCOVM 9
- VLINT 0,7(3)
- VSTKE 0,5
- LTR 8,8
- BC 2,LOOP
- ST 9,0(6)
- LM 0,9,20(13)
- BR 14
-*
-NOSECT VLVCA 0(8)
- LA 7,1
- SR 9,9
-*
- VCS 6,4,2(3)
- VCOVM 9
- VLINT 0,7(3)
- VSTKE 0,5
- ST 9,0(6)
- LM 0,9,20(13)
- BR 14
-* BACKWARD SECTION ISTR < 0
-BACK EQU *
- LA 7,1
-* SET THE STARTING POINT TO -ISTR*NW+ISTR+1
- LPR 1,3
- MR 0,8
- AR 1,3
- LR 9,1
- AR 9,7
- LA 7,4
- MR 0,7
- AR 1,2
-*
-* TEST ON VECTOR SIZE IF VS LE 128 NO SECTIONING
- LA 7,128
- SR 7,8
- BC 2,NOSEC1
- SR 7,7
-*
-LOOP1 VLVCU 8
- VCS 6,4,1(3)
- VCOVM 7
- VLINT 0,9(3)
- VSTKE 0,5
- LTR 8,8
- BC 2,LOOP1
- ST 7,0(6)
- LM 0,9,20(13)
- BR 14
-*
-NOSEC1 SR 7,7
-*
- VLVCA 0(8)
- VCS 6,4,1(3)
- VCOVM 7
- VLINT 0,9(3)
- VSTKE 0,5
- ST 7,0(6)
- LM 0,9,20(13)
- BR 14
- END
-#endif
diff --git a/src/mathlib/gen/obsolete/imp64r.inc b/src/mathlib/gen/obsolete/imp64r.inc
deleted file mode 100644
index 67897fd..0000000
--- a/src/mathlib/gen/obsolete/imp64r.inc
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: imp64r.inc,v 1.1.1.1 1996/04/01 15:02:59 mclareni Exp $
-*
-* $Log: imp64r.inc,v $
-* Revision 1.1.1.1 1996/04/01 15:02:59 mclareni
-* Mathlib gen
-*
-*
-*
-* imp64r.inc
-*
-#if !defined(CERNLIB_DOUBLE)
-C
-#endif
-#if (defined(CERNLIB_F90))&&(defined(CERNLIB_DOUBLE))
- IMPLICIT REAL(2) (A-H,O-Q,S-Z)
- IMPLICIT REAL (R)
-#endif
- IMPLICIT DOUBLE PRECISION (A-H,O-Q,S-Z)
- IMPLICIT REAL (R)
diff --git a/src/mathlib/gen/obsolete/j300/mxprnt.F b/src/mathlib/gen/obsolete/j300/mxprnt.F
deleted file mode 100644
index 337c416..0000000
--- a/src/mathlib/gen/obsolete/j300/mxprnt.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: mxprnt.F,v 1.1.1.1 1996/04/01 15:03:17 mclareni Exp $
-*
-* $Log: mxprnt.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:17 mclareni
-* Mathlib gen
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_gen/pilot.h"
- SUBROUTINE MXPRNT(A,IDIM1,IDIM2,IROW,ICOL,NCOL,FORMAT)
- DIMENSION A(IDIM1,IDIM2),FRMT(7)
- DATA FRMT/8H(1H0,I5,,1H0,1H0,8H/(1X,I5,,1H0,1H0,2H))/
- FRMT(3)=FORMAT
- FRMT(6)=FRMT(3)
- DO 4 K=1,ICOL,NCOL
- L=K+NCOL-1
- IF(L-ICOL)3,3,2
- 2 L=ICOL
- 3 IT=L+1-K
- ENCODE(8,100,FRMT(2))IT
- FRMT(5)=FRMT(2)
- 4 WRITE(6,FRMT(1))(I,(A(I,J),J=K,L),I=1,IROW)
- RETURN
- 100 FORMAT(I8)
- END
diff --git a/src/mathlib/gen/obsolete/j408/dispza.s b/src/mathlib/gen/obsolete/j408/dispza.s
deleted file mode 100644
index 305379a..0000000
--- a/src/mathlib/gen/obsolete/j408/dispza.s
+++ /dev/null
@@ -1,119 +0,0 @@
-*
-* $Id: dispza.s,v 1.1.1.1 1996/04/01 15:03:18 mclareni Exp $
-*
-* $Log: dispza.s,v $
-* Revision 1.1.1.1 1996/04/01 15:03:18 mclareni
-* Mathlib gen
-*
-*
- IDENT DISPZA
- ENTRY DISPZA
-* SUBROUTINE DISPZA(FILENAME,DISPOSITION,STATION)
-* MODIFIED BY T LINDELOF, AUGUST 1978
- DISPZA BSS 1
- SA2 X1
- MX6 6
- BX3 X6*X2
- ZR X3,ARGOK
- BX3 X2
- SX5 55B
- LX5 54
- MX6 6
- SB5 47
- SB1 -1
- REC BX4 X3*X6
- BX4 X4-X5
- ZR X4,TERM
- SB1 B1+6
- LX3 6
- EQ B1,B5,ERR2
- EQ REC
- TERM MX3 1
- AX3 B1,X3
- BX2 X2*X3
- ARGOK BX7 X2
- SA7 ARG
- USE BBB
- ARG BSS 1
- SAVEA0 BSS 1
- SAVEA1 BSS 1
- USE *
- SX7 A0
- SX6 A1
- SA7 SAVEA0
- SA6 SAVEA1
- SX1 ARG
- MX6 1
- BX1 X1+X6
- + RJ =XGETFIT. GET FIT ADDRESS IN X1
- BX3 X1
- SA4 SAVEA0
- SA0 X4
- SA4 SAVEA1
- SA1 X4
- USE AAA
- FICH VFD 60/0
- FICH1 VFD 60/0
- VFD 60/0
- USE *
- SA4 X3
- MX0 42
- BX7 X0*X4
- SA7 FICH
- SA4 A1+1
- SA2 X4
- AX2 48
- MX6 48
- BX2 -X6*X2
- SB1 X2
- SX2 40B PRINT?
- SB2 2022B PR
- EQ B1,B2,ARG3
- SX2 10B PUNCH?
- SB2 2025B PU
- EQ B1,B2,ARG3
- SB2 2044B P9
- EQ B1,B2,ARG3
-#if !defined(CERNLIB_NOSBE)
- SX2 67B DROP?
- SB2 2303B SC
- EQ B1,B2,ARG3
-#endif
- EQ ERR1
- ARG3 SA5 A1+2
- ZR X5,PARG
- SA4 X5
- SX7 55B
- LX7 36
- SX6 77B
- LX6 36
- BX6 X6*X4
- BX7 X7-X6
- ZR X7,ARGP
- MX7 36
- EQ CHAR
- ARGP MX7 18
- CHAR BX4 X7*X4
- CHAR1 BX2 X4+X2
- SX4 300B
- BX7 X4+X2
- SA7 FICH1
-+MJ105B
-- VFD 30/FICH
- OPENM X3,OUTPUT,N
- EQ DISPZA
- ERR1 MESSAGE MESS1,,
- EQ DISPZA
- ERR2 MESSAGE MESS2,,
- EQ DISPZA
- PARG SA4 DEF
- EQ CHAR1
- DEF VFD 18/030320B,42/0
-#if defined(CERNLIB_NOSBE)
- MESS1 DIS ,*DISPZA-DISPOSITION IS NOT PR OR PU*
-#endif
-#if !defined(CERNLIB_NOSBE)
- MESS1 DIS ,*DISPZA-DISPOSITION IS NOT PR,PU OR SC*
-#endif
- MESS2 DIS ,*DISPZA-FILENAME TOO LONG*
- END
diff --git a/src/mathlib/gen/obsolete/j410/outbcd.s b/src/mathlib/gen/obsolete/j410/outbcd.s
deleted file mode 100644
index 4b25920..0000000
--- a/src/mathlib/gen/obsolete/j410/outbcd.s
+++ /dev/null
@@ -1,223 +0,0 @@
-*
-* $Id: outbcd.s,v 1.1.1.1 1996/04/01 15:03:18 mclareni Exp $
-*
-* $Log: outbcd.s,v $
-* Revision 1.1.1.1 1996/04/01 15:03:18 mclareni
-* Mathlib gen
-*
-*
-#if !defined(CERNLIB_NOSBE)
- IDENT OUTBCD
- SST
- ENTRY OUTBCD
-* SUBROUTINE OUTBCD (LUN,VECT,NCHAR,NW)
- EXT GETFIT. NEW SYSTEM
-* EXT GETFIT$ OLD SYSTEM
-*
- TRACE VFD 36/6HOUTBCD,24/OUTBCD
- OUTBCD DATA 0
- SA2 LUNH X2= PREVIOUS LFN
- SA5 X1 X5= LUN
- SB1 A1 B1= ADR (PAR. LIST) SAVED
-*
-* CHECK IF THIS PARTICULAR FILE WAS THE LAST USED
-* IF FILE IS NOT OPEN, OPEN IT
-*
- IX2 X2-X5
- SA4 STOFIT FIT ADR
- NZ X2,NOFIT
- BX1 X4 X1= FIT ADR
- FETCH X1,OC,X3 GET OPEN/CLOSE FLAG
- SX3 X3-1
- NZ X3,OPEN JUMP IF FILE NOT OPEN
-*
-*---- READY PUTTING
-*
- NJUMP SB7 1
- SA2 B1+B7 X2= ADR OF VECT
- SA3 A2+B7
- SA4 A3+B7
- SA3 X3 X3=NCHAR
- SA4 X4 X4= NW
- NZ X3,CHARS
-*
-* ACTION FOR NCHAR = 0
-* IF NW=0 BLANK CARD: SET NCH = 1
- NZ X4,WORDS
- SX2 BLANKX X2= ADR OF BLANKX
- SX3 B7 X3= 1
- EQ PUT
-*
-* CONVERT WORDS TO CHARACTERS
- WORDS SX7 10 X7= 10
- PX4 B0,X4
- PX7 B0,X7
- DX7 X4*X7 NCH = 10*NW
- SX3 X7+B0 X3= NCH
-*
- CHARS NG X3,EODATA IF NCHAR.LT.0, WRITE END-OF-DATA
- PUT PUT X1,X2,X3
- EQ OUTBCD
-*
-* WRITE APPROPRIATE END-OF-DATA MARKS
-*
- EODATA SX3 X3+B7
- ZR X3,EOS
- ENDFILE X1 WRITE END-OF-INFORMATION MARK
- EQ OUTBCD
- EOS WEOR X1,0 WRITE END-OF-SECTION MARK
- EQ OUTBCD
-*
-*---- FIND THE FIT ADDRESS AND STORE IT IN STOFIT
-*
- NOFIT BX6 X5
- SX7 B1
- SA6 LUNH STORE LUN
- SA7 SVA1 B1 SAVED
-+RJGETFIT
-- VFD 30/TRACE
- BX6 X1
- SA2 SVA1
- SA6 STOFIT STORE FIT ADDRESS
- FETCH X1,OC,X3
- SX3 X3-1
- SB1 X2 B1 RESTORED
- ZR X3,NJUMP
-*
-* OPEN THE FILE
-*
- OPEN SX7 B1
- SA7 SVA1 B1 SAVED
- OPENM X1,I-O,N
- SA4 SVA1
- SB1 X4 B1= ADR (PAR.LIST) RESTORED
- EQ B0,B0,NJUMP
-*
- SVA1 DATA 0
- STOFIT DATA 1L1
- LUNH DATA 1L2
- BLANKX DATA 10H X
- END
-#endif
-#if defined(CERNLIB_NOSBE)
- IDENT OUTBCD
- RTZ EQU 3
- RTS EQU 8
- RTW EQU 0
- BTC EQU 2
- BTI EQU 1
- BT0 EQU 0 UNBLOCKED
-***
-*** CHOOSE YOUR OPTIONS...
-***
- RECTYP EQU RTZ
- BLTYP EQU BTC
- FLENGTH EQU 136
-***
- ENTRY OUTBCD
- EXT GETFIT. NEW SYSTEM
-* SUBROUTINE OUTBCD (LUN,VECT,NCHAR,NW)
-*
- TRACE VFD 36/6HOUTBCD,24/OUTBCD
- OUTBCD DATA 0
- SA2 LUNH X2= PREVIOUS LFN
- SA5 X1 X5= LUN
- SB1 A1 B1= ADR (PAR. LIST) SAVED
-*
-* CHECK IF THIS PARTICULAR FILE WAS THE LAST USED
-* IF FILE IS NOT OPEN, OPEN IT
-*
- IX2 X2-X5
- SA4 STOFIT FIT ADR
- NZ X2,NOFIT
- BX1 X4 X1= FIT ADR
- FETCH X1,OC,X3 GET OPEN/CLOSE FLAG
- SX3 X3-1
- NZ X3,OPEN JUMP IF FILE NOT OPEN
-*
-*---- READY PUTTING
-*
- NJUMP SB7 1
- SA2 B1+B7 X2= ADR OF VECT
- SA3 A2+B7
- SA4 A3+B7
- SA3 X3 X3=NCHAR
- SA4 X4 X4= NW
- NZ X3,CHARS
-*
-* ACTION FOR NCHAR = 0
-* IF NW=0 BLANK CARD: SET NCH = 1
- NZ X4,WORDS
- SX2 BLANKX X2= ADR OF BLANKX
- SX3 B7 X3= 1
- EQ PUT
-*
-* CONVERT WORDS TO CHARACTERS
- WORDS SX7 10 X7= 10
- PX4 B0,X4
- PX7 B0,X7
- DX7 X4*X7 NCH = 10*NW
- SX3 X7+B0 X3= NCH
-*
- CHARS NG X3,EODATA IF NCHAR.LT.0, WRITE END-OF-DATA
- PUT PUT X1,X2,X3
- EQ OUTBCD
-*
-* WRITE APPROPRIATE END-OF-DATA MARKS
-*
- EODATA SX3 X3+B7
- ZR X3,EOS
- ENDFILE X1 WRITE END-OF-INFORMATION MARK
- EQ OUTBCD
- EOS WEOR X1,0 WRITE END-OF-SECTION MARK
- EQ OUTBCD
-*
-*---- FIND THE FIT ADDRESS AND STORE IT IN STOFIT
-*
- NOFIT BX6 X5
- SX7 B1
- SA6 LUNH STORE LUN
- SA7 SVA1 B1 SAVED
-+RJGETFIT
-- VFD 30/TRACE
- BX6 X1
- SA2 SVA1
- SA6 STOFIT STORE FIT ADDRESS
- FETCH X1,OC,X3
- SX3 X3-1
- SB1 X2 B1 RESTORED
- ZR X3,NJUMP
-*
-* OPEN THE FILE
-*
- OPEN SX7 B1
- SA7 SVA1 B1 SAVED
-*** SET REQUESTED RT , BT , FL IN FIT.
- SA5 X1+1
- MX0 4
- SX6 RECTYP
- LX0 26
- LX6 22
- BX5 -X0*X5
- BX5 X5+X6
- MX0 3
- SX6 BLTYP
- LX0 31
- LX6 28
- BX5 -X0*X5
- BX6 X5+X6
- SA6 A5
- STORE X1,FL=FLENGTH
- STORE X1,ERL=128 ERROR LIMIT
- OPENM X1,I-O,N
- SA1 STOFIT
- SA4 SVA1
- SB1 X4 B1= ADR (PAR.LIST) RESTORED
- EQ B0,B0,NJUMP
-*
- SVA1 DATA 0
- STOFIT DATA 1L1
- LUNH DATA 1L2
- BLANKX DATA 10H X
- END
-#endif
diff --git a/src/mathlib/gen/obsolete/k403/wind.F b/src/mathlib/gen/obsolete/k403/wind.F
deleted file mode 100644
index 7045f2d..0000000
--- a/src/mathlib/gen/obsolete/k403/wind.F
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: wind.F,v 1.1.1.1 1996/04/01 15:03:18 mclareni Exp $
-*
-* $Log: wind.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:18 mclareni
-* Mathlib gen
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_gen/pilot.h"
- SUBROUTINE WIND(I,N)
-C WIND SEARCHES FORWARD FOR A FILE MARK ON TAPE I. IF N=0
-C THE SEARCH IS CARRIED OUT IN BCD MODE - IF N=1, IN BINARY
-C MODE (THE DEFAULT MODE IF N IS NOT PRESENT). FOR EITHER MODE
-C WIND ASSUMES NON-BUFFERED I/O.
-C
-C CERN LIBRARY PROGRAM K403
-C L. POPE - DECEMBER 1971
-C
- CALL NOARG(M)
- IF (M.LT.2) GO TO 100
- IF (N.EQ.0) GO TO 200
-C BINARY WIND
-100 J=IOCHEC(I)
- READ (I)
- IF (EOF(I).NE.0.) RETURN
- GO TO 100
-C BCD WIND
-200 J=IOCHEC(I)
- READ (I,1) A
-1 FORMAT(A10)
- IF (EOF(I).NE.0.) RETURN
- GO TO 200
- END
diff --git a/src/mathlib/gen/obsolete/k404/backzf.F b/src/mathlib/gen/obsolete/k404/backzf.F
deleted file mode 100644
index 7e9ddd2..0000000
--- a/src/mathlib/gen/obsolete/k404/backzf.F
+++ /dev/null
@@ -1,51 +0,0 @@
-*
-* $Id: backzf.F,v 1.1.1.1 1996/04/01 15:03:18 mclareni Exp $
-*
-* $Log: backzf.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:18 mclareni
-* Mathlib gen
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_gen/pilot.h"
- SUBROUTINE BACKZF(I,N)
-C BACKZF SEARCHES BACKWARD FOR A FILE MARK ON TAPE I EITHER IN
-C BINARY (DEFAULT) MODE (N=1) OR IN BCD MODE (N=0).
-C BACKZF IS PROVIDED FOR COMPATIBILITY PURPOSES ONLY. ITS USE IS
-C STRONGLY DISCOURAGED. USERS ARE INSTEAD INVITED TO CONSIDER
-C THE USE OF THE FORTRAN RANDOM ACCESS FACILITIES
-C (READMS,WRITMS) - SEE THE FORTRAN EXTENDED REFERENCE MANUAL.
-C
-C CERN LIBRARY PROGRAM K404
-C L. POPE - DECEMBER 1971
-C
- CALL REMARK(44HBACKZF - CALL MADE TO SUBROUTINE BACKZF(I,N))
- L=1
- CALL NOARG(M)
- IF (M.LT.2) GO TO 101
- IF (N.EQ.0) GO TO 201
- GO TO 101
-C BINARY BACKZF
-100 L=L+1
- BACKSPACE I
-101 BACKSPACE I
- READ (I)
- J=IOCHEC(I)
- IF (EOF(I).EQ.0.) GO TO 100
- BACKSPACE I
- IF (L.LE.20) RETURN
- CALL REMARK(50HBACKZF - MORE THAN 20 BACKSPACES EXECUTED (BINARY))
- RETURN
-C BCD BACKZF
-200 L=L+1
- BACKSPACE I
-201 BACKSPACE I
- READ (I,1) A
-1 FORMAT(A10)
- J=IOCHEC(I)
- IF (EOF(I).EQ.0.) GO TO 200
- BACKSPACE I
- IF (L.LE.20) RETURN
- CALL REMARK(47HBACKZF - MORE THAN 20 BACKSPACES EXECUTED (BCD))
- RETURN
- END
diff --git a/src/mathlib/gen/obsolete/k405/frwdzf.F b/src/mathlib/gen/obsolete/k405/frwdzf.F
deleted file mode 100644
index e01b5bd..0000000
--- a/src/mathlib/gen/obsolete/k405/frwdzf.F
+++ /dev/null
@@ -1,44 +0,0 @@
-*
-* $Id: frwdzf.F,v 1.1.1.1 1996/04/01 15:03:18 mclareni Exp $
-*
-* $Log: frwdzf.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:18 mclareni
-* Mathlib gen
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_gen/pilot.h"
- SUBROUTINE FRWDZF(N,I,K)
-C FRWDZF MOVES FORWARD A GIVEN NUMBER (N) OF LOGICAL RECORDS ON
-C LOGICAL TAPE I IN BINARY MODE. THE ARGUMENT K IS A STATUS FLAG
-C TO INDICATE -
-C K=0 N RECORDS WERE SKIPPED
-C K=1 N WAS INVALID (ZERO OR NEGATIVE)
-C K=2 EOF READ BEFORE N RECORDS SKIPPED
-C
-C CERN LIBRARY PROGRAM K405
-C L. POPE - DECEMBER 1971
-C
- CALL NOARG(M)
- IF (M.LT.3) GO TO 200
-C STATUS FLAG(K) EQUAL TO ONE IF N ZERO OR NEGATIVE
- K=1
- IF (N.LE.0) RETURN
-C STATUS FLAG(K) EQUAL TO - ZERO IF ALL N RECORDS SKIPPED
-C - TWO IF EOF BEFORE N RECORDS SKIPPED
- K=2
- DO 100 L=1,N
- READ (I)
- IF (EOF(I).NE.0.) RETURN
- J=IOCHEC(I)
-100 CONTINUE
- K=0
- RETURN
-C FOLLOWING VERSION DOES NOT REFERENCE K
-200 IF (N.LE.0) RETURN
- DO 300 L=1,N
- READ (I)
- IF (EOF(I).NE.0.) RETURN
-300 J=IOCHEC(I)
- RETURN
- END
diff --git a/src/mathlib/gen/obsolete/l800/getbst.F b/src/mathlib/gen/obsolete/l800/getbst.F
deleted file mode 100644
index 60ade10..0000000
--- a/src/mathlib/gen/obsolete/l800/getbst.F
+++ /dev/null
@@ -1,58 +0,0 @@
-*
-* $Id: getbst.F,v 1.1.1.1 1996/04/01 15:03:19 mclareni Exp $
-*
-* $Log: getbst.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:19 mclareni
-* Mathlib gen
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_gen/pilot.h"
- SUBROUTINE GETBST(N,K,A,L)
-C--- GETS AN ARRAY BACK FROM LCM
-C--- INPUT
-C N = REFERENCE ADDRESS (DELIVERED BY PUTBST)
-C K=-1 FREES SPACE AND RETURNS LENGTH, BUT DOES NOT RESTORE.
-C K = 0 ALLOWS TO FREE THE SPACE AFTER RESTORING.
-C = 1 MEANS THE ARRAY SHALL STAY IN STORE.
-C---INPUT/OUTPUT
-C A = FIRST WORD OF ARRAY WHERE THE INFORMATION GOES.
-C--- OUTPUT
-C L = LENGTH (NO. OF WORDS TRANSFERRED TO A)
-C IN CASE OF AN ERROR (INVALID N) L=0.
- COMMON/AUXBST/LSTBST,LBLBST,LB2BST,MAXBST,NLMBST,LFRBST,LOWBST
-#if !defined(CERNLIB_NOSBE)
- COMMON/LCMBST/LCMBST(8)
-#endif
-#if defined(CERNLIB_NOSBE)
- COMMON/LCMBST/LCMBST(8)
-#endif
-#if defined(CERNLIB_F4)
- LEVEL 2,LCMBST
-#endif
-#if !defined(CERNLIB_F4)
- LEVEL 2,/LCMBST/
-#endif
- DIMENSION A(2)
- L=0
- LADD=1
- LST=N
- IF(LST.LE.0) GOTO 50
- 1 CONTINUE
- LW=LCMBST(LST)
- IN=LCMBST(LST+1)
- IF(LW.EQ.0) GOTO 50
- IF(K.GE.0)
- 1CALL MOVLEV(LCMBST(LST+2),A(LADD),LW)
- L=L+LW
- IF(K.GT.0) GOTO 2
- LCMBST(LST)=0
- LFRBST=LFRBST+1
- IF(LST.EQ.N) LOWBST=LST
- 2 CONTINUE
- IF(IN.EQ.0) GOTO 50
- LADD=LADD+LW
- LST=IN
- GOTO 1
- 50 RETURN
- END
diff --git a/src/mathlib/gen/obsolete/l800/intbst.F b/src/mathlib/gen/obsolete/l800/intbst.F
deleted file mode 100644
index 0c9c123..0000000
--- a/src/mathlib/gen/obsolete/l800/intbst.F
+++ /dev/null
@@ -1,59 +0,0 @@
-*
-* $Id: intbst.F,v 1.1.1.1 1996/04/01 15:03:19 mclareni Exp $
-*
-* $Log: intbst.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:19 mclareni
-* Mathlib gen
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_gen/pilot.h"
- SUBROUTINE INTBST(LDIM,IERR)
-C--- INCREASES AVAILABLE LCM DYNAMICALLY.
-C--- INPUT
-C LDIM = LENGTH OF BLOCK TO BE STORED BY PUTBST
-C--- OUTPUT
-C IERR = 0 IF REQUEST FULFILLED, OR NO. OF WORDS OVER USER LCM SPACE
- COMMON/AUXBST/LSTBST,LBLBST,LB2BST,MAXBST,NLMBST,LFRBST,LOWBST
-C--- LENGTH OF ONE BLOCK IN LCM (+2 WORDS FOR CONTROL)
-#if defined(CERNLIB_NOSBE)
- DIMENSION MESSGY(6)
- DATA MESSGY / 10HSUPRLAY FA, 10HTAL ERROR,, 10HSUPINIT(RO,
- + 10HOT) NOT CA, 10HLLED FIRST, 0/
-#endif
-#if !defined(CERNLIB_NOSBE)
- DATA LSTBST / 0/
-#endif
- DATA LBLBST,LOWBST,MAXBST,NLMBST,LFRBST/510,1,3*0/
- LB2BST=LBLBST+2
-C--- GET INITIAL LCM LENGTH
- IF(LSTBST.NE.0) GO TO 5
-#if defined(CERNLIB_NOSBE)
- CALL REMARK(MESSGY)
- STOP
-#endif
-#if !defined(CERNLIB_NOSBE)
- CALL INCLCM(0,LSTBST,IERR)
-#endif
- 5 CONTINUE
-C--- INCREASE BY AT LEAST 10*LB2BST WORDS
- L=MAX(10,(LDIM-1)/LBLBST-LFRBST+1)
- LAST=LSTBST
- MLAST=MAXBST
-#if !defined(CERNLIB_NOSBE)
- CALL INCLCM(L*LB2BST,LSTBST,IERR)
-#endif
-#if defined(CERNLIB_NOSBE)
- CALL SUPLCM(L*LB2BST,LSTBST,IERR)
-#endif
- IF(IERR.NE.0) GOTO 10
- INC=LSTBST-LAST
-C--- NEW MAX. LENGTH
- MAXBST=MAXBST+(INC/LB2BST)*LB2BST
-C--- NEW NO. OF FREE BLOCKS
- LFRBST=LFRBST+(MAXBST-MLAST)/LB2BST
-C--- FIRST WORD OF FIRST NEW BLOCK IN EXTENDED REGION
- NLMBST=MLAST+1
- 10 CONTINUE
- RETURN
- END
diff --git a/src/mathlib/gen/obsolete/l800/iposup.F b/src/mathlib/gen/obsolete/l800/iposup.F
deleted file mode 100644
index 5df17eb..0000000
--- a/src/mathlib/gen/obsolete/l800/iposup.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: iposup.F,v 1.1.1.1 1996/04/01 15:03:18 mclareni Exp $
-*
-* $Log: iposup.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:18 mclareni
-* Mathlib gen
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_gen/pilot.h"
- FUNCTION IPOSUP(IBUF,ICODE)
-C-- RETURN A BIT STRING RIGHT ADJ., ZERO FILLED
-C-- INPUT
-C IBUF ARRAY TO BE DECODED
-C ICODE 10000*NW+100*IBUP+IBLOW , WHERE
-C NW=WORD IN IBUF TO BE DECODED,
-C IBUP = UPPER BIT POSITION,
-C IBLOW = LOWER BIT POSITION
- DIMENSION IBUF(2)
- NW=ICODE/10000
- IBUP=(ICODE-10000*NW)/100
- IBLOW=MOD(ICODE,100)
- NBIT=IBUP-IBLOW+1
- IPOSUP=SHIFT(AND(SHIFT(IBUF(NW),59-IBUP),MASK(NBIT)),NBIT)
- RETURN
- END
diff --git a/src/mathlib/gen/obsolete/l800/memorc.F b/src/mathlib/gen/obsolete/l800/memorc.F
deleted file mode 100644
index 26c331d..0000000
--- a/src/mathlib/gen/obsolete/l800/memorc.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: memorc.F,v 1.1.1.1 1996/04/01 15:03:19 mclareni Exp $
-*
-* $Log: memorc.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:19 mclareni
-* Mathlib gen
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_gen/pilot.h"
-#if defined(CERNLIB_NOSBE)||!defined(CERNLIB_F4)
- SUBROUTINE MEMORC (N,NTOT,IERR)
- DATA NDABA/0/
-C
- IF (NDABA.EQ.0) NDABA=NXDABA (DUM)
- NTOT=NDABA
- IERR=0
- IF (NDABA.LT.0) IERR=-1
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/obsolete/l800/memory.F b/src/mathlib/gen/obsolete/l800/memory.F
deleted file mode 100644
index 7411549..0000000
--- a/src/mathlib/gen/obsolete/l800/memory.F
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: memory.F,v 1.1.1.1 1996/04/01 15:03:18 mclareni Exp $
-*
-* $Log: memory.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:18 mclareni
-* Mathlib gen
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_gen/pilot.h"
-#if (defined(CERNLIB_F4))&&(!defined(CERNLIB_NOSBE))
- SUBROUTINE MEMORY(N,NTOT,IERR)
- N2 = N
- NTOT = INCMEM(N2)
- IERR = N2-N
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/obsolete/l800/msprep.F b/src/mathlib/gen/obsolete/l800/msprep.F
deleted file mode 100644
index 0273564..0000000
--- a/src/mathlib/gen/obsolete/l800/msprep.F
+++ /dev/null
@@ -1,149 +0,0 @@
-*
-* $Id: msprep.F,v 1.1.1.1 1996/04/01 15:03:19 mclareni Exp $
-*
-* $Log: msprep.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:19 mclareni
-* Mathlib gen
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_gen/pilot.h"
- SUBROUTINE MSPREP(M,JJ,ID,NN,LL)
-C--- PREPARES DAYFILE MESSAGES FOR SUPRLAY
- DIMENSION MM(6),MESS(6,9),NUM(11)
- DIMENSION M(7),NIV(4)
- DATA NUM/1,1,2,3,4,5,6,6,7,8,9/
-#if defined(CERNLIB_F4)
- DATA L33/333333333333B/,M33,M55/33B,55B/
- DATA MESS/
- 1 5L ,10H STORED ON,4RSCM=,4R ,4LLCM=,0,
- 2 10HSUPRLAY OV,10HERFLOW AT ,10HOVERLAY ,5H ,2*0,
- + 10HSUPRLAY-UN,10HKNOWN OVER,3LLAY ,3*0,
- 3 10HSUPRLAY-BA,10HD STRUCTUR,1LE,3*0,
- 4 10HSUPRLAY-SE,10HRIOUS PROB,10HLEM-NEED H,3LELP,2*0,
- 5 8LSUPRLAY-,10HM OVERFLOW,5L AT ,4L BY ,7LB WORDS,0,
- 6 10HSUPRLAY-ER,10HROR IN LCM,10H MEMORY AL,10HLOCATION ,5LAT ,
- 7 0,
- 8 10HSUPRLAY-PO,10HSSIBLY OVE,10HRWRITING C,10HURRENT OVE,
- 9 10HRLAY LOADI,5LNG ,
-#endif
-#if !defined(CERNLIB_F4)
- DATA L33/O"333333333333"/,M33,M55/O"33",O"55"/
- DATA MESS/
- 1 L" "," STORED ON",R"SCM=",R" ",L"LCM=",0,
- 2 "SUPRLAY OV","ERFLOW AT ","OVERLAY ",L" ",2*0,
- + "SUPRLAY-UN","KNOWN OVER",L"LAY ",3*0,
- 3 "SUPRLAY-BA","D STRUCTUR",L"E",3*0,
- 4 "SUPRLAY-SE","RIOUS PROB","LEM-NEED H",L"ELP",2*0,
- 5 L"SUPRLAY-","M OVERFLOW",L" AT ",L" BY ",L"B WORDS",0,
- 6 "SUPRLAY-ER","ROR IN LCM"," MEMORY AL","LOCATION ",L"AT ",
- 7 0,
- 8 "SUPRLAY-PO","SSIBLY OVE","RWRITING C","URRENT OVE",
- 9 "RLAY LOADI",L"NG ",
-#endif
- * 10HSUPRLAY-IL,10HLEGAL LCM ,10H DECLARATI,10HON IN SECO,
- * 10HNDARY OVER,10HLAY - EXIT/
- JUMP=JJ+1
- MM(1)=0
- K=NUM(JUMP)
- DO 1 I=1,6
- 1 MM(I)=MESS(I,K)
- J=SHIFT(ID,48)
- DO 2 I=1,4
- J=SHIFT(J,3)
- 2 NIV(I)=AND(J,7)+M33
- DO 3 I=1,3,2
- IF(NIV(I).EQ.M33) NIV(I)=M55
- 3 CONTINUE
- IDM=0
- DO 4 I=1,4
- IDM=OR(SHIFT(IDM,6),NIV(I))
-#if defined(CERNLIB_F4)
- IF(I.EQ.2) IDM=OR(SHIFT(IDM,6),1R,)
-#endif
-#if !defined(CERNLIB_F4)
- IF(I.EQ.2) IDM=OR(SHIFT(IDM,6),R",")
-#endif
- 4 CONTINUE
- GOTO(10,20,30,35,40,50,60,70,80,90,100),JUMP
- 10 CONTINUE
-C--- OVERLAY STORED ON DISK
-#if defined(CERNLIB_F4)
- MM(3)=OR(6L DISK ,MM(3))
-#endif
-#if !defined(CERNLIB_F4)
- MM(3)=OR(L" DISK ",MM(3))
-#endif
- GOTO 21
- 20 CONTINUE
-C--- OVERLAY STORED IN LCM
-#if defined(CERNLIB_F4)
- MM(3)=OR(6L LCM ,MM(3))
-#endif
-#if !defined(CERNLIB_F4)
- MM(3)=OR(L" LCM ",MM(3))
-#endif
- 21 MM(1)=OR(MM(1),IDM)
- N=0
- L=0
- DO 22 I=45,60,3
- N=OR(SHIFT(N,6),AND(SHIFT(NN,I),7))
- L=OR(SHIFT(L,6),AND(SHIFT(LL,I),7))
- 22 CONTINUE
- MM(4)=OR(MM(4),SHIFT(N+L33,24))
- MM(5)=OR(MM(5),L+L33)
- GOTO 500
- 30 CONTINUE
-C--- SUPRLAY OVERFLOW
- MM(4)=OR(MM(4),IDM)
- GOTO 500
- 35 CONTINUE
-C--- UNKNOWN OVERLAY REFERENCED
- MM(3)=OR(MM(3),IDM)
- GOTO 500
- 40 CONTINUE
-C--- BAD STRUCTURE
- GOTO 500
- 50 CONTINUE
-C--- E.O.F. WHILE READING ABSOLUTE BINARY FROM DISK
- GOTO 500
- 60 CONTINUE
-C--- SCM OVERFLOW
-#if defined(CERNLIB_F4)
- MM(1)=OR(MM(1),2RSC)
-#endif
-#if !defined(CERNLIB_F4)
- MM(1)=OR(MM(1),R"SC")
-#endif
- GOTO 71
- 70 CONTINUE
-C--- LCM OVERFLOW
-#if defined(CERNLIB_F4)
- MM(1)=OR(MM(1),2RLC)
-#endif
-#if !defined(CERNLIB_F4)
- MM(1)=OR(MM(1),R"LC")
-#endif
- 71 MM(3)=OR(MM(3),IDM)
- N=0
- DO 72 I=45,60,3
- N=OR(SHIFT(N,6),AND(SHIFT(NN,I),7))
- 72 CONTINUE
- MM(4)=OR(MM(4),N+L33)
- GOTO 500
- 80 CONTINUE
-C--- ERROR IN LCM DYN. MEM. MAMAGEMENT
- MM(5)=OR(MM(5),IDM)
- GOTO 500
- 90 CONTINUE
-C--- ATTEMPT TO OVERWRITE CURRENT OVERLAY
- MM(6)=OR(MM(6),IDM)
- GOTO 500
- 100 CONTINUE
-C--- USER DEFINES LCM IN SECONDAR OVERLAY
- 500 CONTINUE
- DO 501 I=1,6
- 501 M(I)=MM(I)
- M(7)=0
- RETURN
- END
diff --git a/src/mathlib/gen/obsolete/l800/nxdaba.s b/src/mathlib/gen/obsolete/l800/nxdaba.s
deleted file mode 100644
index 93a3049..0000000
--- a/src/mathlib/gen/obsolete/l800/nxdaba.s
+++ /dev/null
@@ -1,76 +0,0 @@
-*
-* $Id: nxdaba.s,v 1.1.1.1 1996/04/01 15:03:19 mclareni Exp $
-*
-* $Log: nxdaba.s,v $
-* Revision 1.1.1.1 1996/04/01 15:03:19 mclareni
-* Mathlib gen
-*
-*
-#if defined(CERNLIB_NOSBE)||!defined(CERNLIB_F4)
- IDENT NXDABA
-*
-* NDABA = NXDABA (DUM)
-*
-* NXDABA EXPECTS THAT CMM IS ACTIVE
-* IF CMM IS NOT ACTIVE OR IF THE CMM STRUCTURE IS INVALID IT RETURNS -1
-* OTHERWISE IT RETURNS THE LAST SCM LOC THAT MAY BE USED BY THE PROGRAM
-*
- ENTRY NXDABA
- IFL BSSZ 1
- IDABA1 BSSZ 1
- IDABA2 BSSZ 1
- FNAME VFD 42/0LNXDABA,18/NXDABA
- NXDABA DATA 0
- SA5 65B
- MX0 18
- LX0 18 X0=MASK
- BX5 X5*X0
- SB7 X5
- PL B7,ERROR JUMP, CMM NOT ACTIVE
- SB7 -B7 DABA VALUE
- SX7 B7
- SA7 IDABA1 CURRENT DABA VALUE
- SA5 B7
- BX6 X5*X0
- SA7 IDABA2 NEXT DABA VALUE
- SA6 IFL FL
- BX7 -X0*X5
- LX7 3
- SX5 6
- IX5 X7-X5
- NZ X5,ERROR JUMP, INVALID CMM STRUCTURE
- SB1 1 B1=1
- SB6 B7+B1
-*
-* FIND THE FIRST CMM BLOCK IN USE
-*
- LOOP BSS 0
- SA5 B6
- BX6 X0*X5 ADDRESS OF NEXT CMM BLOCK
- BX5 -X0*X5
- LX5 60-18
- BX7 X0*X5 ADDRESS OF PREVIOUS BLOCK
- SB5 X7
- NE B5,B7,ERROR JUMP,INVALID CMM BLOCK
- SB7 B6 PREVIOUS CMM BLOCK
- SB6 X6 NEXT CMM BLOCK
- AX5 18
- ZR X5,LOOP JUMP, THIS CMM BLOCK IS FREE
- MX5 59
- SX6 B7 ADDRESS OF LAST FREE CMM BLOCK
- IX6 X6+X5
- SA6 IDABA2 ADDRESS OF FIRST CMM FREE BLOCK
- BX1 X6
- RJ =XCMM.SDA
- RETURN SA1 IDABA2 RESTORE NEW DABA VALUE
- MX5 59
- IX6 X5+X1
- EQ NXDABA
-*
-* ERROR PROCESSING
- ERROR BSS 0
- MX6 59 RETURN ERROR CODE
- EQ NXDABA RETURN
-*
- END
-#endif
diff --git a/src/mathlib/gen/obsolete/l800/ovlatak.s b/src/mathlib/gen/obsolete/l800/ovlatak.s
deleted file mode 100644
index 3de12d4..0000000
--- a/src/mathlib/gen/obsolete/l800/ovlatak.s
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: ovlatak.s,v 1.1.1.1 1996/04/01 15:03:19 mclareni Exp $
-*
-* $Log: ovlatak.s,v $
-* Revision 1.1.1.1 1996/04/01 15:03:19 mclareni
-* Mathlib gen
-*
-*
- IDENT OVLATAK
-ID VFD 42/0HOVLATAK,18/1
-*
-* SUBROUTINE OVLATAK (LENTRY) JUMPS TO OVERLAY MAIN PROGRAM AT
- ENTRY OVLATAK
-OVLATAK JP *
- SB1 X1
- SA5 B1
- SB1 X5
- SA1 OVLATAK
- MX6 6
- BX7 -X6*X1
- SA2 VFD
- BX6 X7+X2
- SA6 B1
- SB7 B1+1
- JP B7
-*
-VFD VFD 3/0,3/2,54/0
- END
diff --git a/src/mathlib/gen/obsolete/l800/putbst.F b/src/mathlib/gen/obsolete/l800/putbst.F
deleted file mode 100644
index 3ce06d3..0000000
--- a/src/mathlib/gen/obsolete/l800/putbst.F
+++ /dev/null
@@ -1,74 +0,0 @@
-*
-* $Id: putbst.F,v 1.1.1.1 1996/04/01 15:03:19 mclareni Exp $
-*
-* $Log: putbst.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:19 mclareni
-* Mathlib gen
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_gen/pilot.h"
- SUBROUTINE PUTBST(A,L,N)
-C--- STORES AN ARRAY IN LCM
-C--- INPUT
-C A = FIRST WORD OF ARRAY TO BE STORED
-C L = NO. OF WORDS TO BE STORED
-C--- OUTPUT
-C N = -1 ROUTINE WAS CALLED WITH ZERO OR NEGATIVE LENGTH
-C N = 0 NOT ENOUGH SPACE AVAILABLE IN LCM
-C N GT 0 = ADDRESS OF FIRST WORD OF FIRST BLOCK IN LCM
-C (THIS ADDRESS HAS TO BE GIVEN TO GETBST FOR RETURNING A).
- COMMON/AUXBST/LSTBST,LBLBST,LB2BST,MAXBST,NLMBST,LFRBST,LOWBST
-#if !defined(CERNLIB_NOSBE)
- COMMON/LCMBST/LCMBST(8)
-#endif
-#if defined(CERNLIB_NOSBE)
- COMMON/LCMBST/LCMBST(8)
-#endif
-#if defined(CERNLIB_F4)
- LEVEL 2,LCMBST
-#endif
-#if !defined(CERNLIB_F4)
- LEVEL 2,/LCMBST/
-#endif
- DIMENSION A(2)
-C--- NO. OF BLOCKS NEEDED
- IF(L.LE.0) GOTO 48
- LBL=(L-1)/LBLBST+1
- IF(LBL.LE.LFRBST) GOTO 2
-C--- REQUEST MORE LCM
- CALL INTBST(L,IERR)
- IF(IERR.NE.0) GOTO 49
-C--- ZERO NEW CONTROL WORDS
- DO 4 I=NLMBST,MAXBST,LB2BST
- 4 LCMBST(I)=0
- 2 CONTINUE
-C--- STORE
- LADD=1
- LEFT=L
- DO 1 I=LOWBST,MAXBST,LB2BST
- IF(LCMBST(I).NE.0) GOTO 1
- IF(LEFT.EQ.L) N=I
- IF(LEFT.NE.L) LCMBST(IL+1)=I
- IL=I
- LFRBST=LFRBST-1
- LL=MIN(LEFT,LBLBST)
- CALL MOVLEV(A(LADD),LCMBST(I+2),LL)
- LEFT=LEFT-LL
- LCMBST(I)=LL
- LCMBST(I+1)=0
- IF(LEFT.EQ.0) GOTO 3
- LADD=LADD+LL
- 1 CONTINUE
- 3 CONTINUE
- LOWBST=IL+LB2BST
- 50 RETURN
- 48 CONTINUE
-C--- NEGATIVE OR ZERO LENGTH IN CALL
- N=-1
- GOTO 50
- 49 CONTINUE
-C--- NOT ENOUGH SPACE
- N=-IERR
- GOTO 50
- END
diff --git a/src/mathlib/gen/obsolete/l800/suopen.s b/src/mathlib/gen/obsolete/l800/suopen.s
deleted file mode 100644
index eb5371f..0000000
--- a/src/mathlib/gen/obsolete/l800/suopen.s
+++ /dev/null
@@ -1,88 +0,0 @@
-*
-* $Id: suopen.s,v 1.1.1.1 1996/04/01 15:03:19 mclareni Exp $
-*
-* $Log: suopen.s,v $
-* Revision 1.1.1.1 1996/04/01 15:03:19 mclareni
-* Mathlib gen
-*
-*
-#if (defined(CERNLIB_NOSBE))&&(defined(CERNLIB_F4))
- IDENT SUOPEN
- SST
- ENTRY SUOPEN
- EXT GETFIT.
-*
-* CALL SUOPEN (LUN,JREW,JOUT) OPEN FILE, JREW=0 REWIND,
-* JOUT=0 INPUT FILE
-*
- TRACE VFD 36/6HSUOPEN,24/SUOPEN
- HOME SA5 SVA0
- SA0 X5
- SUOPEN DATA 0
- SB7 1
- SA2 A1+B7
- SA3 A2+B7
- SA2 X2
- SA3 X3
- BX6 X2
- BX7 X3
- SA6 SVMODE SAVE JREW
- SA7 A6+B7 SAVE JOUT
- SX6 A0
- SA6 A7+B7 SAVE A0
-+RJGETFIT
-- VFD 30/TRACE
- BX6 X1
- SA6 SVFIT SAVE FIT-ADR
- FETCH X1,OC,X3 CHECK FILE IS OPEN
- SX3 X3-1
- ZR X3,RUNNING
-*
- OPEN SA2 SVMODE X2= JREW = 0 IF REWIND
- SA3 SVMODE+1 X3= JOUT .NE. 0 IF OUTPUT
- STORE X1,BT=C
- STORE X1,CM=NO
-* STORE X1,MRL=5120
- SX6 B7 1 = FILE OF BINARY TYPE
- LX6 18
- SA6 X1+35 STORE TYPE IN FIT EXTENSION
- NZ X3,OUTF
- STORE X1,RT=S
- NZ X2,RESIN
- OPENM X1,INPUT,R,SQ
- EQ CHECK
- RESIN OPENM X1,INPUT,N,SQ
- EQ CHECK
-*
- OUTF STORE X1,RT=U
- NZ X2,RESOUT
- OPENM X1,OUTPUT,R,SQ
- EQ CHECK
- RESOUT OPENM X1,OUTPUT,N,SQ
-*
-* CHECK RECORD-TYPE NOT OVERWRITTEN BY FILE-CARD
-*
- CHECK EQ HOME
- SVMODE DATA 0
- DATA 0
- SVA0 DATA 0
- SVFIT DATA 0
- MSG VFD 60/10HFILE-CARD *BL
- VFD 60/10HNOT ALLOWE *BL
- VFD 60/10HD FOR - *BL
- FN DATA 0
-*
-* FILE IS ALREADY OPEN, CHECK RT-CHANGE, CHECK REWIND
-*
- RUNNING FETCH X1,RT,X5
- SA3 SVMODE+1
- ZR X3,WANTW
- SX5 X5-7
- WANTW NZ X5,CLS
- SA3 SVMODE
- NZ X3,HOME
- CLS CLOSEM X1,N,FILE,SQ
- SA1 SVFIT
- EQ OPEN
- END
-#endif
diff --git a/src/mathlib/gen/obsolete/l800/supinit.F b/src/mathlib/gen/obsolete/l800/supinit.F
deleted file mode 100644
index 01005f0..0000000
--- a/src/mathlib/gen/obsolete/l800/supinit.F
+++ /dev/null
@@ -1,68 +0,0 @@
-*
-* $Id: supinit.F,v 1.1.1.1 1996/04/01 15:03:19 mclareni Exp $
-*
-* $Log: supinit.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:19 mclareni
-* Mathlib gen
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_gen/pilot.h"
- SUBROUTINE SUPINIT(NFIC)
-#if defined(CERNLIB_NOSBE)
-C--
-C-- INITIALISING CALL FOR SUPRLAY FOR NOSBE
-C-- MUST BE CALLED FIRST WITH THE FILE NAME OF THE ROOT OVERLAY
-C-- THIS IS TO FIND THE LHHA FIELD OF THE EACP LOADER TABLE (TABLE ID=54)
-C-- THIS FIELD IN THE ROOT OVERLAY IS THE MAXIMUM USER LCM ADDRESS USED
-C-- NOTE THE MEMORY MACRO RETURNS ONLY THE JCL REQUESTED ECS VALUE
-C--
- COMMON/AUXBST/LSTBST,LBLBST,LB2BST,MAXBST,NLMBST,LFRBST,LOWBST
- DIMENSION MESSGY(9), UDUMMY(20), MESSGX(6)
- DATA MESSGY / 10HSUPINIT CA, 10HLLED WITH , 10H ,
- + 10H,USER LCM=, 10H , 10H OCTAL = ,
- + 10H ,10H DECIMAL , 0/
- DATA MESSGX / 10HSUPINIT, E, 10HCS FREE FO, 10HR SUPRLAY ,
- + 10H , 10H OCTAL , 0/
- DATA LSTBST / 0/
-#endif
-#if (defined(CERNLIB_F4))&&(defined(CERNLIB_NOSBE))
- DATA KBL/1R /
-#endif
-#if (!defined(CERNLIB_F4))&&(defined(CERNLIB_NOSBE))
- DATA KBL/R" "/
-#endif
-#if defined(CERNLIB_NOSBE)
-C-- CHANGE FILE NAME TO L FORMAT. NFIC MUST BE THE ROOT OVERLAY NAME.
- NFICC=AND(NFIC,MASK(42))
- DO 21 I=1,10
- NFICC=SHIFT(NFICC,6)
- IF(JBYT(NFICC,1,6).NE.KBL) GOTO 21
- NFICC=AND(NFICC,MASK(54))
- 21 CONTINUE
-#endif
-#if (defined(CERNLIB_F4))&&(defined(CERNLIB_NOSBE))
-C-- SET RT=S,BT=C IN THE FIT
- CALL SUOPEN (NFICC,0,0)
-#endif
-#if defined(CERNLIB_NOSBE)
- REWIND NFICC
- READ (NFICC) UDUMMY,LSTBST
- ENCODE (10,1000,MESSGY(3)) NFIC
- ENCODE (10,1001,MESSGY(5)) LSTBST
- ENCODE (10,1002,MESSGY(7)) LSTBST
- CALL REMARK (MESSGY)
-C-- FIND THE MAXIMUM ECS FROM JOB OR RFL JCL CARDS
- CALL SUPLCM (0,MAXECS,IERR)
- MAXADD= MAXECS - LSTBST
-C-- REDUCE TO USER VALUE TO ALLOW FOR LATER DYNAMIC INCREASES
- CALL SUPLCM(-MAXADD,LSTBST,IERR)
- ENCODE (10,1003,MESSGX(4)) MAXADD
- CALL REMARK (MESSGX)
- 1000 FORMAT(A10)
- 1001 FORMAT(O10)
- 1002 FORMAT(I10)
- 1003 FORMAT(O10)
-#endif
- RETURN
- END
diff --git a/src/mathlib/gen/obsolete/l800/suplcm.s b/src/mathlib/gen/obsolete/l800/suplcm.s
deleted file mode 100644
index c322c5f..0000000
--- a/src/mathlib/gen/obsolete/l800/suplcm.s
+++ /dev/null
@@ -1,137 +0,0 @@
-*
-* $Id: suplcm.s,v 1.1.1.1 1996/04/01 15:03:19 mclareni Exp $
-*
-* $Log: suplcm.s,v $
-* Revision 1.1.1.1 1996/04/01 15:03:19 mclareni
-* Mathlib gen
-*
-*
-#if defined(CERNLIB_NOSBE)
- IDENT SUPLCM
- ENTRY SUPLCM
-* SUBROUTINE SUPLCM(N,NTOT,IERR)
-************************************************************************
-* *
-** FTN CALLABLE ROUTINE TO REQUEST USER LCM *
-* *
-** CALLING SEQUENCE *
-* CALL SUPLCM(N,NTOT,IERR) *
-* *
-** PARAMETERS *
-* N - IS REQUESTED AMOUNT OF LCM *
-* IF N - IS INTEGER ZERO THEN THE CURRENT FLL IS RETURNED *
-* IN NTOT BY RETURN TO CALLER *
-* IF N - IS POSITIVE INTEGER THE FLL IS INCREASED BY THE *
-* REQUESTED AMOUNT UNLESS GT MAXLCM (DYNAMIC),AND *
-* NEW FLL IS RETURNED IN NTOT BY RETURN. SHOULD THE *
-* REQUESTED AMOUNT EXCEED MAXFLL THEN IERR BY RETURN *
-* CONTAINS THE DIFFERENS. I.E. WHAT WAS NOT ALLOCATED. *
-* IF N - IS A NEGATIVE INTEGER THEN FLL IS DECREASED BY N *
-* AND THE REMAINING FLL IS RETURNED IN NTOT. SHOULD *
-* FLL REQUESTED IS L.T. ZERO, THEN FLL IS DEALLOCATED *
-* TO ZERO AND NTOT IS ZERO BY RETURN. *
-* NTOT - CONTAINS BY RETURN FROM SUPLCM THE CURRENT FLL. *
-* IERR - CONTAINS BY RETURN FROM SUPLCM THE DIFFERENS BETWEEN *
-* REQUESTED ALLOCATION OF LCM AND ACHIEVED FLL. *
-* IF IERR IS ZERO THEN ALL REQUESTED WAS ALLOCATED *
-* AND IF POSITIVE THE ACTUAL POSITIVE VALUE WAS NOT *
-* ALLOCATED. IERR SHOULD ALWAYS BE POSITIVE INTEGER. *
-* *
-** RESTRICTIONS *
-* ALL PARAMETERS MUST RECIDE IN SCM , ELSE SUPLCM WILL *
-* ABORT JOB WITH DAYFILE MESSAGE . *
-* *
-* MAX FLL IS AN INSTALLATION PARAMETER BUT SUPLCM FINDS *
-* OUT THE ACTUAL RUNNING VALUE. *
-* *
-* IF N IS FLOATING SUPLCM ABORTS JOB WITH DAYFILE MESSAGE. *
-* *
-* ALL THREE PARAMETERS MUST BE PRESENT IN A CALL TO SUPLCM, *
-* IF NOT SUPLCM ABORTS JOB WITH DAYFILE MESSAGE. *
-* *
-** DAYFILE MESSAGES *
-* SUPLCM - PARAMETER ERROR , GIVEN FOR BAD CALL *
-* *
-************************************************************************
-TRACE. VFD 42/0HSUPLCM,18/SUPLCM
-*
-REQFLL BSS 1
-LCMFLL BSS 1
-IERR BSS 1
-MESS DIS ,* SUPLCM - PARAMETER ERROR*
-MAXLCM VFD 30/7777777776B,30/0
-*
-SUPLCM DATA 0
- ZR X1,ERROR NO PARAMETERS AT ALL IN CALL
- NG X1,ERROR NO LCM RESIDENT PARAMETERS ALLOWED
- SA2 X1 GET VALUE OF N
- SA3 A1+1 GET ADDRESS OF NTOT
- SA4 A1+2 GET ADDRESS OF IERR
- MX6 0
- MX7 0
- SA6 REQFLL
- SA7 IERR
- SA6 LCMFLL
- ZR X3,ERROR NO SECOND PARAMETER
- NG X3,ERROR NO LCM RESIDENT PARAMETERS ALLOWED
- ZR X4,ERROR NO THIRD PARAMETER
- NG X4,ERROR NO LCM RESIDENT PARAMETERS ALLOWED
- SB2 X3 SAVE ADDRESS OF NTOT
- SB3 X4 SAVE ADDRESS OF IERR
- BX0 X2 SAVE X2 MEMORY DESTROYS X1 X2 X6 A6
- SA1 MAXLCM
- PL X1,SETUP AREADY DONE
- MEMORY LCM,MAXLCM,RECALL
- SA1 MAXLCM GET MAX LCM AVAILABLE
- MX6 30D
- BX6 X6*X1
- LX6 30D
- SA6 A1 SET MAXIMUM LCM FIELD LENGTH
- SETUP BSS 0
- MEMORY LCM,LCMFLL,RECALL GET CURRENT FLL
- BX2 X0 RESTORE X2 DESTROYED BY MEMORY MACRO
- SA1 LCMFLL
- MX6 30D
- BX1 X1*X6
- LX1 30D
- ZR X2,FINI
- SA3 MAXLCM
- MX5 12D
- BX4 X5*X2
- PL X2,POS SKIP IF N IS POSITIVE
- BX4 X5-X4 ONLY SIGN BITS ALLOWED
-POS BSS 0
- NZ X4,ERROR N IS FLOATING
- IX6 X2+X1 X6= NEEDED FLL
- ZR X6,NONE DEALLOCATE ALL LCM
- PL X6,SOME LCM IS NEEDED
-NONE BSS 0
- MX6 30D
- SA6 REQFLL
- MX1 0 NTOT RESULT IS ZERO
- EQ MEM GO DEALLOCATE ALL LCM
-SOME BSS 0
- IX7 X6-X3 CHECK IF TOO MUCH
- NG X7,SKIP
- SA7 IERR SAVE DIFFERENCE
- BX6 X3 REQUEST MAXIMUM
-SKIP BSS 0
- BX1 X6
- LX6 30D
- SA6 REQFLL
-MEM BSS 0
- BX0 X1
- MEMORY LCM,REQFLL,RECALL
- BX1 X0
-FINI BSS 0
- SA2 IERR
- BX6 X1
- SA6 B2 WRITE NTOT RESULT
- BX7 X2
- SA7 B3 WRITE IERR RESULT
- EQ SUPLCM
-ERROR BSS 0
- MESSAGE MESS
- ABORT
- END
-#endif
diff --git a/src/mathlib/gen/obsolete/l800/suprlay.F b/src/mathlib/gen/obsolete/l800/suprlay.F
deleted file mode 100644
index eb74e0d..0000000
--- a/src/mathlib/gen/obsolete/l800/suprlay.F
+++ /dev/null
@@ -1,418 +0,0 @@
-*
-* $Id: suprlay.F,v 1.1.1.1 1996/04/01 15:03:18 mclareni Exp $
-*
-* $Log: suprlay.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:18 mclareni
-* Mathlib gen
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_gen/pilot.h"
- SUBROUTINE SUPRLAY(NFIC,NIV1,NIV2,NRECL,KEEP)
-C-- SUPRLAY VERSION WITH AUTOMATIC SCM AND LCM ALLOCATION.
-C-- AUTHOR H.GROTE / CERN - DD 2ND MODIFIED VERSION 1.10.80
-C-- THIS VERSION ALLOWS FOR LOADER TABLES TYPE 53B (43) AND 54B (44).
-C-- INPUT VARIABLES
-C NFIC = LOGICAL FILE NAME OF FILE CONTAINING ABSOLUTE BINARY.
-C NIV1 = OVERLAY LEVEL
-C NIV2 = NUMBER INSIDE OVERLAY LEVEL
-C NREC(OPTIONAL)= RECALL PARAMETER
-C KEEP(OPTIONAL)= KEEP PARAMETER(RESTORED ON LCM OR DISK AFTER EX.)
-C-- ACTION.
-C A CALL TO SUPRLAY LOADS THE CORRESPONDING OVERLAY (NIV1,NIV2) FROM
-C LCM OR DISK AND EXECUTES IT. THE BINARY( WHICH MAY HAVE CHANGED
-C DURING EXECUTION) IS KEPT IN CASE OF THE KEEP PARAMETER AND WILL
-C THEREFORE BE RESTORED AT THE NEXT CALL TO THIS OVERLAY.
-C-- THE COMMON /DEBUT/ IS PLACED AT THE START OF THE ROUTINE TO HAVE
-C ACCESS TO THE RETURN ADDRESS, WHICH UNDER THE CURRENT LOADER AND
-C COMPILER VERSION IS STORED AT NENTRY(IEEL=4).
-C THIS IS NECESSARY BECAUSE SUPRLAY MAY BE CALLED FROM INSIDE THE
-C OVERLAY IT HAS STARTED.
- COMMON/AUXBST/LSTBST,LBLBST,LB2BST,MAXBST,NLMBST,LFRBST,LOWBST
- COMMON/DEBUT/NENTRY(1)
- EQUIVALENCE(NENTRY,NENT)
- DIMENSION ID(30),LENTRY(30),LADR(30),NWD(30),NADB(30)
- 1 ,INDEX(31),IBUF(5),KIPLST(2),IRET(2),NOVLST(3)
- 2 ,MESSG1(5),MESSG2(7),MESSG3(4),MESSG4(4),MESSG5(4),NARG(2)
- DIMENSION NFORM(10,2)
-#if defined(CERNLIB_NOSBE)
- DIMENSION UDUMMY(20)
- EQUIVALENCE (UDUMMY(16),ICODE),(UDUMMY(16),IBUF(1))
-#endif
-#if !defined(CERNLIB_F4)
- DIMENSION MESSG6(5),MESSG7(5)
-#endif
-C-- NFORM CONTAINS FORMAT CONTROL INFORMATION, FOR 1 (53B) AND 2 (54B)
-C "POSITION" HERE MEANS 10000*WORD+100*UPPERBIT+LOWERBIT,
-C WORDS COUNTED FROM 1 IN IBUF, BITS RIGHT TO LEFT, 0 TO 59 .
-C WORD NO. MEANING
-C 1 NO. OF HEADER RECORDS (EXCEPT FIRST = DUMMY )
-C 2 WORDS / HEADER RECORD 1
-C 3 WORDS / HEADER RECORD 2
-C 4 POSITION OF OVERLAY IDENTIFIER
-C 5 POSITION OF SCM IMAGE START
-C 6 SHIFT OF SCM IMAFGE START (FORMAT 2, LOAD HEADER)
-C 7 POSITION OF ENTRY POINT
-C 8 LENGTH OF LCM IMAGE (MUST BE ZERO FOR SUPRLAY)
-C 9 LENGTH OF SCM IMAGE
-C 10 SCM MINIMUM LENGTH FOR THIS OVERLAY
- DATA MESSG1/10HSUPRLAY VE,10HRS. 2.1 IN,10HIT FILE - ,2*0/
- DATA MESSG4/10HSUPRLAY-PL,10HEASE REMOV,10HE RFL CARD,0/
-#if defined(CERNLIB_F4)
- DATA MESSG3/3*10H++++++++++,5L+++++/
- DATA MESSG5/10HSUPRLAY-UN,10HKNOWN LOAD,10HER FORMAT,,5L EXIT/
- DATA MDISK/4LDISK/
-#endif
-#if !defined(CERNLIB_F4)
- DATA MESSG3/3*"++++++++++",L"+++++"/
- DATA MESSG5/"SUPRLAY-UN","KNOWN LOAD","ER FORMAT,"," EXIT"/
- DATA MESSG6/10HFILE IS EM,10HPTY-PROBAB,10HLY NOT DEC,5HLARED,0/
- DATA MESSG7/10HSUPRLAY-SE,10HRIOUS ERRO,10HR (SEE OUT,
- 1 10HPUT), STOP,0/
-C-- FLAG FOR FIRST ENTRY, AND NO. OF NAME SEARCH LOCATIONS
- DATA IFIRST/0/, NLOOK/50/
- DATA MASK18/O"177777"/, NAMSUPR/L"SUPRLAY"/
- DATA MDISK/L"DISK"/
-#endif
- DATA NFORM/
- 1 2, 2, 1, 14736, 13518, 1, 11600, 22300, 31700, 33518,
- 2 1, 5, 0, 14736, 13518, 5, 51700, 32300, 25942, 21700/
-#if defined(CERNLIB_F4)
- DATA KBL/1R /
- DATA IEEL/5/
-#endif
-#if !defined(CERNLIB_F4)
- DATA KBL/R" "/
-#endif
-C-- FLAGS AND COUNTERS
- DATA NENTRY,IFDISK,NOVLST,NOVL/6*0/
- DATA NSCM/0/, IFORM/0/
-C-- PLACE OF RETURN ADDRESS
-C-- CODES
- DATA KKEEP,KREC/4HKEEP,6HRECALL/
-C-- FLAG FOR SCM INCREASE REQUEST
- DATA IRSCM/0/
-C--- MAX. NO. OF OVERLAYS ALLOWED = DIMENSION OF ID, LENTRY,
-C LADR,NWD,NADB, AND INDEX (+1)
- DATA MAXOV/30/
-C---
-C-- SUBROUTINE SUPRLAY(NFIC,NIV1,NIV2,NRECL,KEEP)
-C--
-#if !defined(CERNLIB_F4)
-C--- LOOK FOR PLACE OF RETURN ADDRESS IF FIRST ENTRY
- IF(IFIRST.NE.0) GOTO 10
- IFIRST=1
- DO 1 I=1,NLOOK
- IF(AND(MASK(42),NENTRY(I)).EQ.NAMSUPR) GOTO 5
- 1 CONTINUE
- CALL REMARK(MESSG3)
- CALL REMARK(MESSG4)
- CALL REMARK(MESSG3)
- WRITE(6,2001)NLOOK
-2001 FORMAT(//,' +++++++++++++++++++++++++++++++++++++++++++++++++',//
- 1 ,' SUPRLAY FATAL ERROR - ENTRY NOT FOUND IN NENTRY(1..',I3,'),',
- 2 ' STOP',//)
- GOTO 201
- 5 CONTINUE
-C--- ABSOLUTE ENTRY ADDRESS
- IEEL=AND(MASK18,NENTRY(I))
-C--- RELATIVE TO NENTRY
- IEEL=IEEL-LOCF(NENTRY)+1
- 10 CONTINUE
-#endif
-C-- IDENTIFICATION OF REQUESTED OVERLAY
- IDENT=OR(SHIFT(NIV1,6),NIV2)
- DO 11 NOV=1,NOVL
- IF(IDENT.EQ.ID(NOV)) GOTO 12
- 11 CONTINUE
- GOTO 111
- 12 CONTINUE
-#if defined(CERNLIB_F4)
- IF(IRSCM.GT.0) GOTO 17
- IRSCM=1
-C-- SCM NOT INCREASED BY SUPRLAY - PRINT MESSAGE
- CALL REMARK(MESSG3)
- CALL REMARK(MESSG3)
- CALL REMARK(MESSG4)
- CALL REMARK(MESSG3)
- CALL REMARK(MESSG3)
- 17 CONTINUE
-#endif
- NENT=NENT+1
- IF(NENT.GT.2) GOTO 112
- KIPLST(NENT)=0
- CALL NOARG(NARG(NENT))
- IF(NARG(NENT).GT.4) KIPLST(NENT)=KEEP
- IRET(NENT)=NENTRY(IEEL)
-C-- CHECK WHETHER RECALL PAR., AND OVERLAY IN MEMORY
- KRECL=0
- IF(NARG(NENT).GE.4) KRECL=NRECL
- IF(KRECL.NE.KREC) GOTO 13
- IF(NOV.EQ.NOVLST(NENT)) GOTO 14
- IF(NOV.EQ.NOVLST(NENT+1)) GOTO 14
- 13 CONTINUE
-C-- OVERLAY HAS TO BE RELOADED - THEREFORE THE RECALL
-C-- PARAMETER FOR THE NEXT HIGHER OVERLAY HAS TO BE DISABLED.
- NOVLST(NENT+1)=0
-C-- READ FROM LCM (LEC.GE.0) OR DISK(LEC.LT.0)
- ISTART=LADR(NOV)
- LEC=NADB(NOV)
- IF(LEC.GE.0) CALL GETBST(LEC,1,LADR(ISTART),LDUM)
- IF(LEC.LT.0) CALL READMS(MDISK,LADR(ISTART),NWD(NOV),NOV)
-C-- EXECUTE OVERLAY JUST LOADED
- 14 CONTINUE
- NOVLST(NENT)=NOV
- CALL OVLATAK(LENTRY(NOV))
-C-- RESTORE ARGUMENTS AND RETURN ADDRESS
- NOV=NOVLST(NENT)
- NENTRY(IEEL)=IRET(NENT)
-C-- CHECK FOR KEEP PARAMETER
- IF(KIPLST(NENT).NE.KKEEP) GOTO 16
-C-- YES - RESTORE ON LCM OR DISK
- ISTART=LADR(NOV)
- IF(NADB(NOV).LT.0) GOTO 15
-C-- LCM - FREE SPACE OF OLD COPY FIRST
- CALL GETBST(NADB(NOV),-1,LDUM,LDUM)
- CALL PUTBST(LADR(ISTART),NWD(NOV),NADB(NOV))
- GOTO 16
- 15 CALL WRITMS(MDISK,LADR(ISTART),NWD(NOV),NOV)
- 16 NENT=NENT-1
- RETURN
-C-- SUBROUTINES PUTLCM(NFIC) AND PUTDISK(NFIC)
-#if defined(CERNLIB_F4)
- ENTRY PUTDISK
-#endif
-#if !defined(CERNLIB_F4)
- ENTRY PUTDISK (NFIC)
-#endif
-C-- FLAG FOR DISK STORAGE
- MED=0
- IF(IFDISK.EQ.0) CALL OPENMS(MDISK,INDEX,MAXOV+1,0)
- IFDISK=1
- GOTO 20
-#if defined(CERNLIB_F4)
- ENTRY PUTLCM
- ENTRY PUTECS
-#endif
-#if !defined(CERNLIB_F4)
- ENTRY PUTLCM (NFIC)
- ENTRY PUTECS (NFIC)
-#endif
- MED=1
- 20 CONTINUE
-C-- CHANGE FILE NAME TO L FORMAT
- NFICC=AND(NFIC,MASK(42))
- DO 21 I=1,10
- NFICC=SHIFT(NFICC,6)
- IF(JBYT(NFICC,1,6).NE.KBL) GOTO 21
- NFICC=AND(NFICC,MASK(54))
- 21 CONTINUE
-#if (defined(CERNLIB_NOSBE))&&(defined(CERNLIB_F4))
- CALL SUOPEN (NFICC,0,0)
-#endif
-#if (defined(CERNLIB_NOSBE))&&(!defined(CERNLIB_F4))
- OPEN(UNIT=NFICC,IOSTAT=IOERR,STATUS='OLD',FORM='UNFORMATTED'
- +, BUFL=513)
-#endif
- REWIND NFICC
- MESSG1(4)=NFICC
- IFAC=0
- CALL REMARK(MESSG1)
-C-- DETECT LOADER TABLE FORMAT, CHECK VALIDITY
-C-- SKIP 16 WORDS
-#if !defined(CERNLIB_F4)
- READ(NFICC,IOSTAT=IOERR) UDUMMY
-#endif
-#if defined(CERNLIB_F4)
- READ(NFICC) UDUMMY
-#endif
- IF(EOF(NFICC).NE.0.) GOTO 100
-#if (!defined(CERNLIB_F4))&&(!defined(CERNLIB_NOSBE))
- READ(NFICC,IOSTAT=IOERR) ICODE
-#endif
-#if (defined(CERNLIB_F4))&&(!defined(CERNLIB_NOSBE))
- READ(NFICC) ICODE
-#endif
-#if !defined(CERNLIB_NOSBE)
- IF(EOF(NFICC).NE.0.) GOTO 113
-#endif
- ITABLE=JBYT(ICODE,55,6)
- IF(ITABLE.EQ.43) IFORM=1
- IF(ITABLE.EQ.44) IFORM=2
- REWIND NFICC
- IF(IFORM.NE.0) GOTO 30
-C-- WRONG LOADER TABLE FORMAT - PRINT DAYFILE MESSAGE AND EXIT
- CALL REMARK(MESSG5)
- GOTO 201
-C-- MAIN LOOP
- 30 CONTINUE
-C-- SKIP 16 WORDS WITHOUT RELEVANT INF.
-#if !defined(CERNLIB_F4)
- READ(NFICC,IOSTAT=IOERR) UDUMMY
-#endif
-#if defined(CERNLIB_F4)
- READ(NFICC) UDUMMY
-#endif
- IF(EOF(NFICC).NE.0.) GOTO 100
- IFAC=1
-#if !defined(CERNLIB_NOSBE)
-C-- READ HEADER
- IUP=NFORM(1,IFORM)
- IU=0
- DO 301 I=1,IUP
- IL=IU+1
- IU=IU+NFORM(I+1,IFORM)
-#endif
-#if (!defined(CERNLIB_F4))&&(!defined(CERNLIB_NOSBE))
- READ(NFICC,IOSTAT=IOERR) (IBUF(J),J=IL,IU)
-#endif
-#if (defined(CERNLIB_F4))&&(!defined(CERNLIB_NOSBE))
- READ(NFICC) (IBUF(J),J=IL,IU)
-#endif
-#if !defined(CERNLIB_NOSBE)
- 301 CONTINUE
-#endif
-C-- CHECK FOR (ILLEGAL FOR SUPRLAY) LCM DECLARATION THIS OVERLAY
- IF(IPOSUP(IBUF,NFORM(8,IFORM)).NE.0) GOTO 117
-C-- COUNT NO. OF OVERLAYS READ
- NOVL=NOVL+1
- IDENT=IPOSUP(IBUF,NFORM(4,IFORM))
- IF(NOVL.GT.MAXOV) GOTO 110
- ID(NOVL)=IDENT
- LADR(NOVL)=IPOSUP(IBUF,NFORM(5,IFORM))
-C-- LENGTH OF SCM IMAGE + SHIFT OF START POSITION
- NWD(NOVL)=IPOSUP(IBUF,NFORM(9,IFORM))+NFORM(6,IFORM)
-C-- LENGTH OF SCM NECESSARY FOR THIS OVERLAY
- IABL=IPOSUP(IBUF,NFORM(10,IFORM))
-C-- REQUEST 10 WORDS MORE THAN NEEDED FOR SAFETY.
- IABL=IABL+10
-C--- ENTRY POINT OF THIS OVERLAY
- LENTRY(NOVL)=IPOSUP(IBUF,NFORM(7,IFORM))
-#if !defined(CERNLIB_F4)||defined(CERNLIB_NOSBE)
- IF(NSCM.EQ.0) CALL MEMORC(0,NSCM,IERR)
-#endif
-#if (defined(CERNLIB_F4))&&(!defined(CERNLIB_NOSBE))
- IF(NSCM.EQ.0) CALL MEMORY(0,NSCM,IERR)
-#endif
-C-- CHECK FOR OVERWRITING CURRENT OVERLAY
-C-- LOADER TAKES MEMORY IN CHUNKS OF 100 OCTAL.
- IF(LADR(NOVL)+64.GE.NSCM) GOTO 32
- IF(NOVL.GT.1) GOTO 32
- CALL MSPREP(MESSG2,9,IDENT,IERR,IERR)
- CALL REMARK(MESSG2)
- 32 CONTINUE
- IF(IABL.LE.NSCM) GOTO 31
-C-- INCREASE SCM BY NECESSARY AMOUNT
- IRSCM=IRSCM+1
-#if !defined(CERNLIB_F4)||defined(CERNLIB_NOSBE)
- CALL MEMORC(IABL-NSCM,NSCM,IERR)
-#endif
-#if (defined(CERNLIB_F4))&&(!defined(CERNLIB_NOSBE))
- CALL MEMORY(IABL-NSCM,NSCM,IERR)
-#endif
- IERR=ABS(IERR)
- IF(IERR.GT.0) GOTO 114
- 31 CONTINUE
-C-- SET THE(ABSOLUTE) STARTING ADDRESS RELATIVE TO START OF LADR
- LADR(NOVL)=LADR(NOVL)-LOCF(LADR(1))+1
-C-- READ IN THE OVERLAY AND STORE IT AWAY
- ISTART=LADR(NOVL)
- IEND=ISTART+NWD(NOVL)-1
-C-- COPY HEADER IF FORMAT 2 (54B)
- IF(IFORM.EQ.2) CALL UCOPY(IBUF,LADR(ISTART),5)
- ISTS1=ISTART+NFORM(6,IFORM)
-#if (!defined(CERNLIB_F4))&&(!defined(CERNLIB_NOSBE))
- READ(NFICC,IOSTAT=IOERR) (LADR(IIII),IIII=ISTS1,IEND)
-#endif
-#if (defined(CERNLIB_F4))&&(!defined(CERNLIB_NOSBE))
- READ(NFICC) (LADR(IIII),IIII=ISTS1,IEND)
-#endif
-#if (!defined(CERNLIB_F4))&&(defined(CERNLIB_NOSBE))
- BACKSPACE NFICC
- READ(NFICC,IOSTAT=IOERR) UDUMMY,(LADR(IIII),IIII=ISTS1,IEND)
-#endif
-#if (defined(CERNLIB_F4))&&(defined(CERNLIB_NOSBE))
- BACKSPACE NFICC
- READ(NFICC) UDUMMY,(LADR(IIII),IIII=ISTS1,IEND)
-#endif
- IF(EOF(NFICC).NE.0.) GOTO 113
- IF(MED.EQ.0) GOTO 40
-C-- STORE IN LCM
- CALL PUTBST(LADR(ISTART),NWD(NOVL),NADB(NOVL))
- IF(NADB(NOVL).EQ.0) GOTO 116
- IERR=ABS(NADB(NOVL))
- IF(NADB(NOVL).LT.0) GOTO 115
- GOTO 50
- 40 CONTINUE
-C-- STORE ON DISK
- NADB(NOVL)=-1
- CALL WRITMS(MDISK,LADR(ISTART),NWD(NOVL),NOVL)
- 50 CONTINUE
-C-- PREPARE DAYFILE MESSAGE AND PUT IT INTO DAYFILE
- CALL MSPREP(MESSG2,MED,IDENT,NSCM,LSTBST)
- CALL REMARK(MESSG2)
-#if (!defined(CERNLIB_F4))&&(!defined(CERNLIB_NOSBE))
-C--- SKIP EOS/EOP ON ABS. LGO FILE
- READ(NFICC,IOSTAT=IOERR) UDUMMY
- IF(EOF(NFICC).NE.0) GOTO 100
-#endif
-C-- LOOP UNTIL E.O.F.
- GOTO 30
- 100 CONTINUE
- IF(IFAC.EQ.0)
-#if defined(CERNLIB_F4)
- 1 CALL REMARK(35HFILE IS EMPTY-PROBABLY NOT DECLARED)
-#endif
-#if !defined(CERNLIB_F4)
- 1 CALL REMARK(MESSG6)
-#endif
-#if (defined(CERNLIB_NOSBE))&&(!defined(CERNLIB_F4))
- CLOSE (UNIT=NFICC,IOSTAT=IOERR)
-#endif
- RETURN
-C-- TO RESTART FROM A HIGHER LEVEL OVERLAY (RECOVERY)
-#if defined(CERNLIB_F4)
- ENTRY SUPKLIR
-#endif
-#if !defined(CERNLIB_F4)
- ENTRY SUPKLIR (NFIC)
-#endif
- NENT=NFIC
- RETURN
-C-- ERRORS - EXIT CALLED IN ALL CASES
- 110 CONTINUE
-C-- MORE THAN 20 OVERLAYS - OVERFLOW
- MED=2
- GOTO 200
- 111 CONTINUE
-C-- UNKNOWN OVERLAY REFERENCED FOR LOADING
- MED=3
- GOTO 200
- 112 CONTINUE
-C-- BAD STRUCTURE (MORE THAN 2 OVERLAY LEVELS)
- MED=4
- GOTO 200
- 113 CONTINUE
-C-- E.O.F. WHILE READING ABSOLUTE BINARY
- MED=5
- GOTO 200
- 114 CONTINUE
-C-- SCM OVERFLOW
- MED=6
- GOTO 200
- 115 CONTINUE
-C-- LCM OVERFLOW
- MED=7
- GOTO 200
- 116 CONTINUE
-C-- ERROR IN LCM DYNAMIC MEMORY MANAGEMENT
- MED=8
- GOTO 200
- 117 CONTINUE
-C-- USER DEFINES LCM IN THIS OVERLAY - ILLEGAL
- MED=10
- 200 CONTINUE
- CALL MSPREP(MESSG2,MED,IDENT,IERR,IERR)
- CALL REMARK(MESSG2)
- 201 STOP
- END
diff --git a/src/mathlib/gen/obsolete/m217/pak3.s b/src/mathlib/gen/obsolete/m217/pak3.s
deleted file mode 100644
index 3e9ffc0..0000000
--- a/src/mathlib/gen/obsolete/m217/pak3.s
+++ /dev/null
@@ -1,77 +0,0 @@
-*
-* $Id: pak3.s,v 1.1.1.1 1996/04/01 15:03:20 mclareni Exp $
-*
-* $Log: pak3.s,v $
-* Revision 1.1.1.1 1996/04/01 15:03:20 mclareni
-* Mathlib gen
-*
-*
- IDENT PAK3
-#include "entftn.inc"
- ENTRY PAK3
-* SUBROUTINE PAK3(A,X,N)
- + VFD 24/0HPAK3,36/3
- ENTFTN PAK3,3
- SB7 1
- SA1 B1
- MX0 47
- SA3 B3
- MX2 1
- BX0 -X0
- SB3 X3
- LX2 20
- BX0 X2+X0
- SB6 B0+48
- MX2 54
- NLOOP SB5 3
- SX6 B0
- HUP ZR X1,ZERO
- BX3 X1
- SA4 PU
- NG X1,NEG
- IX7 X1-X4
- PL X7,REPLP
- ZTEST SA4 PL
- IX7 X1-X4
- NG X7,ZERO
- OKAY UX3 B4,X3
- SX4 B4+B6
- AX3 35
- BX4 -X2*X4
- LX6 20
- BX3 X0*X3
- LX4 13
- SB5 B5-B7
- SA1 A1+B7
- BX4 X3+X4
- SB3 B3-B7
- BX6 X6+X4
- ENDT ZR B3,STORE
- LT B0,B5,HUP
- SA6 B2
- SB2 B2+B7
- EQ B0,B0,NLOOP
- STORE EQ B0,B5,SA6
- LX6 20
- SB5 B5-B7
- EQ B0,B0,STORE
- SA6 SA6 B2
- EQ B0,B0,PAK3
- NEG BX1 -X1
- IX7 X1-X4
- PL X7,REPLN
- EQ B0,B0,ZTEST
- ZERO MX3 0
- SA1 A1+B7
- SB5 B5-B7
- LX6 20
- SB3 B3-B7
- EQ B0,B0,ENDT
- REPLP SA3 PU
- EQ B0,B0,OKAY
- REPLN SA3 NU
- EQ B0,B0,OKAY
- NU DATA 60213777777777777777B
- PU DATA 17567777777777777777B
- PL DATA 16604000000000000000B
- END
diff --git a/src/mathlib/gen/obsolete/m217/upak3.s b/src/mathlib/gen/obsolete/m217/upak3.s
deleted file mode 100644
index 04c5c44..0000000
--- a/src/mathlib/gen/obsolete/m217/upak3.s
+++ /dev/null
@@ -1,47 +0,0 @@
-*
-* $Id: upak3.s,v 1.1.1.1 1996/04/01 15:03:20 mclareni Exp $
-*
-* $Log: upak3.s,v $
-* Revision 1.1.1.1 1996/04/01 15:03:20 mclareni
-* Mathlib gen
-*
-*
- IDENT UPAK3
-#include "entftn.inc"
- ENTRY UPAK3
-* SUBROUTINE UPAK3(A,X,N)
- + VFD 30/0HUPAK3,30/3
- ENTFTN UPAK3,3
- SA3 B3
- SB7 1
- MX0 20
- MX2 6
- SB3 X3
- SA1 B2-B7
- LX2 59
- NLOOP SA1 A1+B7
- SB5 3
- HUP BX3 X0*X1
- BX4 X2*X1
- ZR X3,ZERO
- BX3 -X2*X3
- LX4 1
- BX6 X3
- AX6 6
- BX6 X2*X6
- BX3 X3+X6
- AX4 54
- SB6 X4-48
- AX3 5
- PX7 B6,X3
- STORE SA7 B1
- SB3 B3-B7
- ZR B3,UPAK3
- LX1 20
- SB5 B5-B7
- SB1 B1+B7
- LT B0,B5,HUP
- EQ B0,B0,NLOOP
- ZERO MX7 0
- EQ B0,B0,STORE
- END
diff --git a/src/mathlib/gen/obsolete/m221/cnvthp.s b/src/mathlib/gen/obsolete/m221/cnvthp.s
deleted file mode 100644
index 5508f05..0000000
--- a/src/mathlib/gen/obsolete/m221/cnvthp.s
+++ /dev/null
@@ -1,98 +0,0 @@
-*
-* $Id: cnvthp.s,v 1.1.1.1 1996/04/01 15:03:20 mclareni Exp $
-*
-* $Log: cnvthp.s,v $
-* Revision 1.1.1.1 1996/04/01 15:03:20 mclareni
-* Mathlib gen
-*
-*
- IDENT CNVTHP
-#include "entftn.inc"
- ENTRY CNVTHP
-* SUBROUTINE CNVTHP(AI,AJ,MODE)
-* USAGE:
-* CALL CNVTHP(A(I),A(J),MODE)
-* CONVERTS HEWLETT-PACKARD 16-BIT NUMBERS IN WORDS A(I) THROUGH A(J) (J.GE.I)
-* TO CDC FORMAT 60-BIT QUANTITIES.
-* MODE=0 (OR OMITTED): FLOATING POINT MODE=1: INTEGER
-* FLOATING POINT CONVERSION MAKES 1 CDC TYPE 'REAL' WORD FROM 2 CONSECUTIVE
-* HP 16-BIT WORDS.
-* CORRECTED JANUARY 1982; J.STRACHOTA, EP /J.S./
- NAME VFD 36/6HCNVTHP,24/3
- ENTFTN CNVTHP,3,B7
- SA0 B1 A(I) SET UP INITIAL CONDITIONS
- SB2 B2-B1
- SB1 B0 LOOP INDEX
- SB2 B2+1 I-J+1
- SX2 B7-2 NO. ARGUMENTS-2
- ZR X2,FLOAT IF 2 ARGS. ASSUME FLOATING
- NG X2,CNVTHP LT 2 ARGS. RETURN
- SA1 B3 3 ARGS.
- ZR X1,FLOAT
-*
- MX0 1 INTEGERS
- LX0 16
- LOOPI SA1 A0+B1
- BX2 X0*X1 EXTRACT SIGN BIT
- LX2 44
- BX6 X2
- LX2 1
- AX6 43 SIGN EXTENSION
- BX6 X6+X1
- IX6 X6-X2 SUBTRACT SIGN BIT
- SA6 A1
- SB1 B1+1
- LT B1,B2,LOOPI
-V EQ CNVTHP RETURN
-*
- FLOAT SB3 B0 FLOATING POINT
- LOOP SA1 A0+B1 A(I)
- SA4 A1+1 SECOND HALF OF FL. PT. NUMBER
- LX1 16
- BX1 X1+X4
- ZR X1,L IF ZERO GO TO END OF LOOP
- MX0 1
- LX0 32
- BX2 X0*X1 SIGN BIT OF FRACTIONAL PART, S1
- LX2 28
- BX6 X2
- AX6 24
- LX2 1 S1 RIGHT-ADJUSTED
- LX6 25
- MX0 23
- LX0 31 EXTRACT FRACTIONAL PART OF A(I)
- BX4 X0*X1
- AX4 8
- IX4 X4-X2
- LX4 25
- BX6 X6+X4 PUT FRACTIONAL PART IN NEW
- MX0 59
- BX4 -X0*X1
- BX3 X4 SIGN BIT OF EXPONENT, S2
- LX4 59
- AX4 52
- MX0 7
- LX0 8
- BX5 X0*X1 EXTRACT EXPONENT OF A(I)
- AX5 1
- BX4 X4+X5
- IX4 X4-X3
- SX7 60D .J.S.
- IX7 X4-X7 .J.S.
- NG X7,L005 .J.S.
- SX4 X4+1 .J.S.
- L005 BSS 0 .J.S.
- SX4 X4+1717B ADD BIAS TO EXPON5NT
- ZR X2,JUMP
- BX4 -X4 S1=1, COMPLEMENT
- JUMP MX0 48
- BX5 -X0*X4
- LX5 48
- BX6 X6+X5 NEW COMPLETE
- NX6 X6
- SA6 A0+B3
- L SB1 B1+2
- SB3 B3+1
- LT B1,B2,LOOP
- EQ CNVTHP
- END
diff --git a/src/mathlib/gen/obsolete/m222/cbyte.s b/src/mathlib/gen/obsolete/m222/cbyte.s
deleted file mode 100644
index 8c82e26..0000000
--- a/src/mathlib/gen/obsolete/m222/cbyte.s
+++ /dev/null
@@ -1,301 +0,0 @@
-*
-* $Id: cbyte.s,v 1.1.1.1 1996/04/01 15:03:20 mclareni Exp $
-*
-* $Log: cbyte.s,v $
-* Revision 1.1.1.1 1996/04/01 15:03:20 mclareni
-* Mathlib gen
-*
-*
- IDENT CBYTE
-**** M222 VERSION 26/10/71 CBYTE 288
-*
-* THIS ROUTINE CONVERTS 8-BIT BYTES INTO 6-BIT DISPLAY CODE.
-* THE FORTRAN CALLING STATEMENT IS
-* CALL CBYTE (ARRAY, NCHAR, CODE)
-* ARRAY CONTAINS ON INPUT 8-BIT-BYTES, ON OUTPUT DISPL
-* CHARACTERS
-* NCHAR IS THE NUMBER OF 8-BIT-BYTES TO BE CONVERTED
-* CODE IS EITHER 6HEBCDIC OR 7HUSASCII OR 5HASCII
-* OR 5HTELEX OR 7HIBM1401
-* THE FOLLOWING REGISTERS KEEP THEIR DESTINATION THROUGHOUT THE SUBROUTI
-* A0 = STORE WORD ADDRESS
-* B1 = GET WORD ADDRESS
-* B2 = NUMBER OF CHARACTERS TO BE CONVERTED
-* B3 = 0 EBCDIC
-* B3 = 1 USASCII
-* B3 = 2 ASCII
-* B3 = 3 TELEX FS
-* B3 = 4 TELEX LS
-* B4 = GET CHARACTER COUNT GC
-* B7 = 1
-* X0 = 8-BIT MASK LEFT-ADJUSTED
-* X1 = WORD TO BE CONVERTED
-* X6 = STORE CHARACTER COUNT SC
-* X7 = WORD TO BE STORED
-*
-MACRO XTEXT
- ENTRY CBYTE
-* SUBROUTINE CBYTE(ARRAY,NCHAR,MODE)
-*
- NCH BSS 1
- SW BSS 1 STORE WORD COUNT
- FLAG BSS 1 .FLAG=+1 FOR BYTES 1-7.5, FLAG=-1 FOR BYTES 7.
- TABLE BSSZ 1
- FIRST BSSZ 1
- ASC DATA 5HASCII
- EB DATA 6HEBCDIC
- IBM DATA 7HIBM1401
- TEL DATA 5HTELEX
- USA DATA 7HUSASCII
-*
-* USASCII TABLE. THE NINTH COLUMN OF THE FIRST TEN WORDS CONTAINS A SHIF
-* COLUMN COUNT IS 9.8.7.6.5.4.3.2.1.0.
-* CODE CONVERSION TABLE CORRECTIONS TO CONVERT ALL NON PRINTABLE
-* LOWER CASE CHARACTERS TO 00 INSTEAD OF THEIR UPPER CASE EQUIVALENT
- USASCII DATA 74550000000000000000B CHARS 007B TO 000B
- DATA 66550000000000000000B CHARS 017B TO 010B
- DATA 60550000000000000000B CHARS 027B TO 020B
- DATA 52550000000000000000B CHARS 037B TO 030B
- DATA 44557067635360646655B CHARS 047B TO 040B
- DATA 36555057465645475251B CHARS 057B TO 050B
- DATA 30554241403736353433B CHARS 067B TO 060B
- DATA 22557173547277004443B CHARS 077B TO 070B
- DATA 14550706050403020174B CHARS 107B TO 100B
- DATA 06551716151413121110B CHARS 117B TO 110B
- DATA 55552726252423222120B CHARS 127B TO 120B
- DATA 55556576627561323130B CHARS 137B TO 130B
- DATA 55550706050403020174B CHARS 147B TO 140B
- DATA 55551716151413121110B CHARS 157B TO 150B
- DATA 55552726252423222120B CHARS 167B TO 160B
- DATA 55550076667572323130B CHARS 177B TO 170B
-* COLUMN COUNT IS 9.8.7.6.5.4.3.2.1.0.
- EBCDIC DATA 55555555555555555555B CHARS 107B TO 100B
- DATA 55556645517257615555B CHARS 117B TO 110B
- DATA 55555555555555555567B CHARS 127B TO 120B
- DATA 55557677524753625555B CHARS 137B TO 130B
- DATA 55555555555555555046B CHARS 147B TO 140B
- DATA 55557173656356755555B CHARS 157B TO 150B
- DATA 55555555555555555555B CHARS 167B TO 160B
- DATA 55556454707460007455B CHARS 177B TO 170B
- DATA 55550706050403020155B CHARS 207B TO 200B
- DATA 55555555555555551110B CHARS 217B TO 210B
- DATA 55552017161514131255B CHARS 227B TO 220B
- DATA 55555555555555552221B CHARS 237B TO 230B
- DATA 55553027262524237655B CHARS 247B TO 240B
- DATA 55555555555555553231B CHARS 257B TO 250B
- DATA 55555555555555555555B CHARS 267B TO 260B
- DATA 55555555555555555555B CHARS 277B TO 270B
- DATA 55550706050403020172B CHARS 307B TO 300B
- DATA 55555555555555551110B CHARS 317B TO 310B
- DATA 55552017161514131266B CHARS 327B TO 320B
- DATA 55555555555555552221B CHARS 337B TO 330B
- DATA 55553027262524235575B CHARS 347B TO 340B
- DATA 55555555555555553231B CHARS 357B TO 350B
- DATA 55554241403736353433B CHARS 367B TO 360B
- DATA 55555555555555554443B CHARS 377B TO 370B
-*
- TELEX DATA 00005756535544004055B
- DATA 00005455334365375200B
- DATA 00005070416447554536B
- DATA 00000051344200773546B
- DATA 00001516105517002455B
- DATA 00002603201107221400B
- DATA 00003006312302043205B
- DATA 00000013212500122701B
-*
- IBM1401 DATA 00007755553755433300B
- DATA 00000055415245547535B
- DATA 00005500405144647334B
- DATA 00005556504200463647B
- DATA 00005714240430102000B
- DATA 00005516260632122202B
- DATA 00005515250531112101B
- DATA 00005517270700132303B
- VFD 42/5CCBYTE,18/CBYTE
-#include "entftn.inc"
- ENTFTN CBYTE,3
- SA2 B2 LOAD N
- SX6 B0
- SA3 B3 LOAD FLAG FOR EBCDIC OR USASCII
- SX7 B2
- SA5 FIRST
- SA4 EB
- SB7 1
- SA6 SW
- IX4 X3-X4
- SX6 EBCDIC
- SA7 NCH SAVE ADDRESS OF THIRD CALL PARM.
- MX0 8 SET UP GET MASK
- NZ X5,GETLFS
- SB3 B0
- ZR X4,GO
- SA4 USA
- SX6 USASCII
- SB3 B7
- IX4 X3-X4
- ZR X4,GO USASCII
- SA4 ASC
- SB3 B3+B7 FLAG FOR ASCII PAPER TAPE CODE
- IX4 X3-X4
- ZR X4,GO
- SA4 TEL
- SX6 TELEX
- SB3 B3+B7
- IX4 X4-X3
- ZR X4,GO
- SA4 IBM
- SX6 IBM1401
- IX4 X4-X3
- ZR X4,GO
- EQ B0,B0,CBYTE
-*
- GETLFS SB3 X5
- EQ B0,B0,START
- GO SA6 TABLE
- START SA0 B1 SAVE ADDRESS OF A(1)
- SX5 B0 ZERO THE STORE CHAR COUNT
- BX4 X6 LOAD SW
- SX7 B7
- SB2 X2 B2.= N
- SB4 B0 B4.= GET CHAR COUNT
- SA7 FLAG
- SX7 B0
-*
-* LOOP ENTERED FOR LOADING NEXT WORD TO BE CONVERTED
- LOOP SA1 B1 LOAD A(1)
-*
-* LOOP ENTERED FOR LOADING NEXT CHARACTER TO BE CONVERTED
- LOOP1 SA4 SW LOAD STORE WORD COUNT
- LX2 B7,X4 2*SW
- BX3 X4
- LX3 3 8*SW
- IX6 X2+X3 10*SW
- IX6 X5+X6 10*SW + SC
- SB6 X6
- GE B6,B2,FINIS ALL CHARS CONVERTED
- SB6 10
- SB5 X5
- LT B5,B6,SKIP SC .LT. 10
- SX5 B0 RESET STORE CHAR COUNT
- SA7 A0 STORE FULL WORD
- SA0 A0+B7
- SX7 B0 ZERO THE BUFFER WORD
- SX6 X4+B7 AUGMENT STORE WORD COUNT
- SA6 SW UPDATE STORE WORD COUNT
- SKIP SB6 7
- LT B4,B6,NEXT GC .LT. 7
- SA2 FLAG
- SB4 B0-B7 RESET GET CHAR COUNT
- SB1 B1+B7 AUGMENT GET WORD COUNT
- NG X2,SECOND
- MX4 4
- LX4 4
- BX3 X1*X4 FIRST 4 BITS OF ROW POINTER
- SA1 B1 LOAD NEXT WORD
- LX4 56
- BX4 X1*X4 LAST 4 BITS OF CHAR
- LX1 4 ADJUST WORD FOR DECODING
- LX4 4
- LX3 4
- BX3 X3+X4 CHAR RIGHT ADJUSTED
- LX3 52 CHAR LEFT ADJUSTED
- SX6 B0-B7 SWITCH FLAG
- SA6 A2
- EQ B0,B0,CHECKIN
- SECOND SX6 B7 SWITCH FLAG
- SB4 B0
- SA4 SW
- SA6 A2
- EQ B0,B0,LOOP
- NEXT SB5 3
- SX4 B4
- LX4 B5,X4 8*GC
- SB6 X4
- LX3 B6,X1 CHAR LEFT ADJUSTED IN X3
- BX3 X0*X3 X3.= CHAR ONLY
- CHECKIN NE B3,B0,CHECK
- MX2 1
- LX2 59
- BX3 X2+X3 CONVERT SMALL INTO BIG LETTERS
- CHECK SB6 B3-3
- LT B6,B0,NOFHC NO 5-HOLE CODE
- SA2 TABLE
- SX4 TELEX
- IX4 X2-X4
- ZR X4,NOFHC TELEX CODE
- NZ X3,JUMP1
- SX3 33B REPLACE IBM1401 LS BY TELEX FS
- EQ B0,B0,SHIFT
- JUMP1 LX3 8
- SX4 X3-33B
- NZ X4,SHIFT
- SX3 37B REPLACE IBM1401 LS BY TELEX LS
- SHIFT LX3 52
- NOFHC SB5 3
- LX3 5 SPLIT CHAR INTO ROW AND COL PTER
- BX4 X0*X3 X4.= COL PTER LEFT ADJUSTED
- BX3 X3-X4 GET ROW POINTER
- LX4 3 X4.= COLUMN POINTER
- SB6 B3-3
- LT B6,B0,CODE
- SB5 X3-3
- NZ B5,CODE
- SB5 X4-7
- ZR B5,LETSH LETTER SHIFT CHAR FOUND
- SB5 X4-3
- ZR B5,FIGSH FIGURE SHIFT CHAR FOUND
- CODE NZ B3,ASCII EBCDIC OR USASCII
- SB5 X3-8 SUBTRACT 8
- LT B5,B0,BLANK
- EQ B0,B0,GET
- ASCII SB5 X3
- EQ B3,B7,GET
- SB6 3
- EQ B3,B6,GET
- SB6 B6+B7
- SB5 B5+B6
- EQ B3,B6,GET
- SX2 B5-B6
- MX3 4
- LX3 4
- BX3 X2*X3
- SB5 X3
- EQ B0,B0,GET
- BLANK SA2 USASCII LOAD BLANK WORD
- EQ B0,B0,NOW
- GET SA2 TABLE LOAD ADDRESS OF TABLE WORD
- SA2 X2+B5 LOAD TABLE WORD
- NOW SB6 X4+B7 B6.= COLUMN POINTER
- SA4 B6+USASCII LOAD SHIFT COUNT
- MX3 6
- BX4 X3*X4 GET SHIFT COUNT
- LX4 6
- SB6 X4
- LX2 B6,X2
- SB6 X5 B6.= STORE CHAR COUNT
- BX2 X2*X3 X2.= DISPLAY CHAR
- SA4 B6+USASCII LOAD SHIFT COUNT
- SB4 B4+B7 AUGMENT GET CHAR COUNT
- BX4 X3*X4 GET SHIFT COUNT
- SX5 X5+B7 AUGMENT STORE CHAR COUNT
- LX4 6
- SB6 X4
- LX2 B6,X2 SHIFT DISPLAY CHAR
- BX7 X2+X7 ADD NEW DISPLAY CHAR
- EQ B0,B0,LOOP1
- LETSH SB3 4 LETTER SHIFT FLAG
- SB4 B4+B7 AUGMENT GET CHAR COUNT
- SB2 B2-B7 DECREASE TOTAL CHR COUNT
- EQ B0,B0,LOOP1
- FIGSH SB3 3 FIGURE SHIFT FLAG
- SB4 B4+B7
- SB2 B2-B7
- EQ B0,B0,LOOP1
- FINIS SA3 NCH
- SA7 A0 STORE LAST WORD
- SX6 B2 NUMBER OF CHARS TO BE RETURNED
- SA6 X3
- SX6 B3 SAVE FS OR LS LEVEL
- SA6 FIRST
- EQ B0,B0,CBYTE
- END
diff --git a/src/mathlib/gen/obsolete/m223/pak2.s b/src/mathlib/gen/obsolete/m223/pak2.s
deleted file mode 100644
index 9905c54..0000000
--- a/src/mathlib/gen/obsolete/m223/pak2.s
+++ /dev/null
@@ -1,120 +0,0 @@
-*
-* $Id: pak2.s,v 1.1.1.1 1996/04/01 15:03:20 mclareni Exp $
-*
-* $Log: pak2.s,v $
-* Revision 1.1.1.1 1996/04/01 15:03:20 mclareni
-* Mathlib gen
-*
-*
- IDENT PAK2
-#include "entftn.inc"
-*
-* REGISTERS WITH FIXED DEFINITON INSIDE THE LOOP ARE
-* B1 = EXPONENT SHIFT COUNT
-* B2 = STORE ADDRESS
-* B3 = GET COUNT
-* B5 = MANTISSA SHIFT COUNT
-* B7 = 1
-* A0 = BIAS
-* A1 = GET WORD ADDRESS
-* A7 = STORE WORD ADDRESS
-* X2 = UPPER LIMIT OF FLOATING NUMBER
-* X4 = MANTISSA MASK
-* X5 = EXPONENT MASK
-* X6 = LOWER LIMIT OF FLOATING NUMBER
-* X7 = WORD TO BE STORED
-*
- ENTRY PAK2
-* SUBROUTINE PAK2(A,B,N,M)
- ZERO DATA 00004000000000000000B
- DATA 10004000000000000000B
- DATA 13204000000000000000B
- DATA 15204000000000000000B
- DATA 16204000000000000000B
- DATA 16604000000000000000B
- DATA 17004000000000000000B
- MAXMIN DATA 37207777777777777777B
- DATA 27207777777777777777B
- DATA 23207777777777777777B
- DATA 21207777777777777777B
- DATA 20207777777777777777B
- DATA 17577777777777777777B
- DATA 17377777777777777777B
-*
- ENTFTN PAK2,4
- SA4 B4 LOAD MANTISSA BITS
- SA3 B3 LOAD GET COUNT
- SX5 X4-25
- PL X5,PAK2 TOO MANY MANTISSA BITS ASKED FOR
- SX5 17
- IX5 X5-X4
- PL X5,PAK2 TOO FEW MANTISSA BITS ASKED FOR
- MX2 1
- SX5 29
- SB6 X4-18
- SB7 1
- IX5 X5-X4
- SX7 B0
- SB5 X5 EXPONENT BITS
- SB3 X3+B1 GET COUNT
- SB4 X4-1 MANTISSA BITS
- LX0 B5,X2 BIAS
- SA1 B1-B7 LOAD DUMMY A(0)
- AX5 B5,X2 EXPONENT MASK LEFT ADJUSTED
- SB1 60
- SB5 B5+B7
- AX4 B4,X2 MANTISSA MASK
- SA2 MAXMIN+B6 LOAD UPPER LIMIT
- LX5 B5,X5 EXPONENT MASK RIGHT ADJUSTED
- LX4 48 MANTISSA MASK
- SA0 X0+47
- SB1 B1-B5 EXPONENT SHIFT COUNT
- BX6 X2
- SB5 B4-17 SHIFT COUNT
- SB4 B6
- SA2 ZERO+B6 LOAD $ZERO$ LIMIT
-*
- LOOP SB6 A1+B7 AUGMENT LOAD COUNT
- GE B6,B3,FINIS
- SA1 B6 LOAD NEXT WORD
-*
- FX0 X6-X1
- PL X0,LTEST
- BX1 X6 NUMBER REPLACED BY UPPER LIMIT
- EQ B0,B0,INRANGE
- LTEST FX0 X1+X6
- PL X0,ZTEST
- BX1 -X6 NUMBER REPLACED BY LOWER LIMIT
- EQ B0,B0,INRANGE
- ZTEST PL X1,PZTEST
- FX0 X1+X2
- NG X0,INRANGE
- BX1 -X2 NUMBER REPLACED BY $NEG. ZERO$
- EQ B0,B0,INRANGE
- PZTEST FX0 X1-X2
- PL X0,INRANGE
- BX1 X2 NUMBER REPLACED BY $POS. ZERO$
- INRANGE MX3 1
- BX0 X7 SAVE FIRST PACKED WORD
- BX7 X1*X3 GET SIGN
- ZR X7,NOCOMP
- BX1 -X1
- NOCOMP UX3 B6,X1
- SX1 A0+B6 ADD BIAS TO EXPONENT
- BX1 X5*X1 MASK NEW EXPONENT
- LX1 B1,X1 SHIFT NEW EXPONENT
- BX7 X1+X7 ADD NEW EXPONENT
- BX1 X3*X4 GET MANTISSA
- LX1 B5,X1 SHIFT MANTISSA
- BX7 X1+X7 ADD MANTISSA
- ZR X0,LOOP
- LX7 30
- BX7 X0+X7 ADD THE TWO PACKED WORDS
- SA7 B2 STORE PACKED WORD
- SX7 B0
- SB2 B2+B7
- EQ B0,B0,LOOP
- FINIS ZR X7,PAK2
- SA7 B2 STORE LAST WORD
- EQ B0,B0,PAK2
- END
diff --git a/src/mathlib/gen/obsolete/m223/upak2.s b/src/mathlib/gen/obsolete/m223/upak2.s
deleted file mode 100644
index 7a998ed..0000000
--- a/src/mathlib/gen/obsolete/m223/upak2.s
+++ /dev/null
@@ -1,63 +0,0 @@
-*
-* $Id: upak2.s,v 1.1.1.1 1996/04/01 15:03:20 mclareni Exp $
-*
-* $Log: upak2.s,v $
-* Revision 1.1.1.1 1996/04/01 15:03:20 mclareni
-* Mathlib gen
-*
-*
- IDENT UPAK2
-#include "entftn.inc"
- ENTRY UPAK2
-* SUBROUTINE UPAK2(B,C,N,M)
- ENTFTN UPAK2,4
- SA4 B4 LOAD NB OF MANTISSA BITS
- SB7 1
- SX5 X4-25
- PL X5,UPAK2 TOO MANY MANTISSA BITS
- SX5 17
- IX5 X5-X4
- PL X5,UPAK2 TOO FEW MANTISSA BITS
- SA3 B3 LOAD STORE COUNT
- MX2 1 SIGN MASK
- SB5 29
- SB4 X4-1 NUMBER OF MANTISSA BITS
- SB5 B5-B4 NB OF EXPONENT BITS
- AX4 B4,X2
- SB4 B4+31 MANTISSA SHIFT COUNT
- SX7 B0
- LX4 B4,X4 MANTISSA MASK
- SB6 108
- SB4 B6-B4
- SB5 B5-2
- AX5 B5,X2
- LX5 59 EXPONENT MASK
- SB3 X3+B2 HIGHEST STORE ADDRESS
- SA1 B1-B7 LOAD DUMMY A(-1)
- SB5 B5+B7
- LX3 B5,X2 BIAS RIGHT ADJUSTED
- SB5 B5+B7
- SX3 X3+47
- SA0 X3
-*
- LOOP SA1 A1+B7 LOAD NEXT WORD TO BE UNPACKED
- SB1 B7+B7
- SEC BX3 X5*X1 GET EXPONENT
- LX3 B5,X3
- SX6 A0
- IX3 X3-X6 SUBTRACT BIAS
- BX6 X1*X4 GET MANTISSA
- SB6 X3
- LX6 B4,X6
- BX3 X2*X1 GET SIGN
- PX6 B6,X6
- ZR X3,NOCOMP
- IX6 X7-X6 COMPLEMENT
- NOCOMP SA6 B2 STORE UNPACKED WORD
- SB1 B1-B7
- SB2 B2+B7 AUGMENT STORE COUNT
- GE B2,B3,UPAK2
- EQ B1,B0,LOOP
- LX1 30
- EQ B0,B0,SEC
- END
diff --git a/src/mathlib/gen/obsolete/m226/ccbyte.s b/src/mathlib/gen/obsolete/m226/ccbyte.s
deleted file mode 100644
index 18c536c..0000000
--- a/src/mathlib/gen/obsolete/m226/ccbyte.s
+++ /dev/null
@@ -1,226 +0,0 @@
-*
-* $Id: ccbyte.s,v 1.1.1.1 1996/04/01 15:03:20 mclareni Exp $
-*
-* $Log: ccbyte.s,v $
-* Revision 1.1.1.1 1996/04/01 15:03:20 mclareni
-* Mathlib gen
-*
-*
- IDENT CCBYTE
- ENTRY CCBYTE
-* SUBROUTINE CCBYTE(ARRAY,NCHAR,MODE)
-#include "entftn.inc"
-* B2 = NCH
-* B3 = 4 IF USASCII, 0 IF EBCDIC
-* B4 = NP POSITION INSIDE 2-WORD STORE COUNT
-* B6 = STORE COUNT
-* B7 = 1
-* B1 = ADDRESS OF A(1)
-* X0 = 6-BIT MASK
-* X1 = WORD TO CONVERT
-* X2 = PHASE SHIFT CONSTANTS
-* X6 = CONVERTED CHARACTER
-* X7 = CONVERTED CHARACTERS
- EBCDIC DATA 00003335154134401600B
- DATA 00007237125513530076B
- DATA 00005614747357325475B
- DATA 00000000000036771720B
- DATA 40404040404040404040B USASCII
- DATA 40404040404040404040B
- DATA 40404040404040404040B
- DATA 40406463626160404040B
- DATA 40405255537170676665B
- DATA 40405642407544515057B
- DATA 40407740454772404043B
- DATA 40407340404676744041B
- EBC DATA 6HEBCDIC
-*
- ENTFTN CCBYTE,3
- SA3 B3
- SA4 EBC
- IX4 X4-X3
- SB3 B0
- ZR X4,HOPP
- SB3 4
-* N2F=NCH/15
- HOPP SA1 B2
- SX2 15
- SB7 1
- PX0 B0,X2
- SB2 X1
- NX0 B0,X0
- BX4 X1
- PX1 B0,X1
- NX1 B0,X1
- FX0 X1/X0
- UX7 B4,X0
- LX5 B4,X7
-* M=MOD(NCH,10)
- SX3 10
- PX6 B0,X3
- NX7 B0,X6
- FX7 X1/X7
- UX7 B4,X7
- LX7 B4,X7
- PX7 B0,X7
- DX7 X7*X6
- UX6 B0,X7
- IX4 X4-X6
- SB5 X4-1
- PL B5,JUMP3
- SB5 9
-* L=MIN(M,1)
- JUMP3 ZR X4,JUMP1
- SX4 B7
-* NG=NCH/10
- JUMP1 SX3 10
- PX0 B0,X3
- NX0 B0,X0
- FX0 X1/X0
- UX7 B4,X0
- LX6 B4,X7
-* NG=NG+L
- IX7 X6+X4
- SB6 X7-1
-* NST=(2* NG-1)/15
- FX2 X1+X1
- SA3 =1.
- FX2 X2-X3
- SX3 15
- PX0 B0,X3
- NX0 B0,X0
- FX0 X2/X0
- UX7 B4,X0
- LX0 B4,X7
-* NP=NCH-15*N2F-1
- BX7 X5
- LX7 4
- SX3 B7
- IX6 X7-X5
- BX6 -X6
- SX6 X6+B2
- IX6 X6-X3
- PL X6,JUMP5
- SX6 14
-*
- JUMP5 SX7 B0
- SX1 B5
- SB2 X1
- LX1 1
- SX1 X1+B5
- LX1 1
- SB5 X1
- SA1 B1+B6
- LX1 B5,X1
- SB6 X0
- SB5 X6-7
- SB4 X6
- MX0 6
- SA2 =30030731732510000000B
- EQ B5,JUMP2
- SX4 B4
- SX5 52
- NG B5,SHIFT
- SX4 B5
- SX5 56
- SHIFT LX4 3
- IX4 X5-X4
- SB4 X4 SHIFT COUNT
- EQ B0,B0,MASK
- JUMP2 SB4 56
-*
- MASK BX6 X0*X1 MASK 6-BIT-BYTE
- LX6 6
- NZ B3,ASCI
- SB5 B0
- SA0 EBCDIC
- SX5 X6-12B
- NG X5,CHAR
- SB5 B5+9
- SX5 X6-23B
- NG X5,CHAR
- SB5 B5+9
- SX5 X6-33B
- NG X5,CHAR
- SB5 B5+9
- SX5 X6-45B
- NG X5,CHAR
- SX6 X6-44B
- DCH MX3 3
- LX3 6
- BX5 X3*X6 MASK ROW POINTER
- AX5 3
- SB5 X5
- AX3 3
- SA4 A0+B5 LOAD TABLE WORD
- BX3 X3*X6 MASK COLUMN POINTER
- LX5 B7,X3 2*COL PTER
- IX5 X5+X3 3*COL PTER
- LX5 1 6*COL PTER
- MX3 6
- SB5 X5
- LX3 6
- AX4 B5,X4 SHIFT TABLE WORD
- BX6 X4*X3 MASK LAST 6 BITS OF 8-BIT-BYTE
- NZ B3,JUMP4
- SX6 X6+100B
- JUMP4 SB5 B4-56
- EQ B5,B0,SPLIT
- ADD LX6 B4,X6
- SB5 52
- LX1 54
- BX7 X6+X7
- SB5 B5-B4
- ZR B5,STORE
- SB2 B2-B7
- SB4 B4+8
- PL B2,MASK
-*
- GET SB2 9
- SB5 A1-B1
- NG B5,CCBYTE
- SA1 A1-B7
- LX1 54
- EQ B0,B0,MASK
-*
- CHAR LX2 B5,X2
- SB5 B0-B5
- MX5 9
- SB5 B5+60
- BX5 X2*X5
- LX2 B5,X2
- LX5 9
- SB5 B4-56
- IX6 X5+X6
- EQ B5,B0,SPLIT CHECK ON SPLIT-THE CHAR.-CONDITIO
- EQ B0,B0,ADD
-*
- ASCI SB5 36
- SX3 X6-33B
- SA0 EBCDIC+B3
- NG X3,CHAR
- EQ B0,B0,DCH
-*
- SPLIT LX6 B4,X6
- MX5 4
- BX3 X5*X6 MASK THE LAST 4 BITS OF 8 BIT BYT
- BX7 X3+X7 ADD THE LAST 4 BITS OF 8 BIT BYTE
- LX5 4
- BX3 X5*X6 GET FIRST 4BITS OF 8BIT BYTE
- SA7 B6+B1 STORE
- SB6 B6-B7 REDUCE STORE COUNT
- SB4 4
- BX7 X3 TRANSFER FIRST 4 BITS AFTER SPLIT
- SB2 B2-B7
- LX1 54
- EQ B0,B0,MASK
-*
- STORE SA7 B6+B1 STORE
- SB6 B6-B7 REDUCE STORE COUNT
- NG B6,CCBYTE LAST WORD STORED
- SB4 B0 RESET SHIFT COUNT
- SB2 B2-B7
- SX7 B0
- LT B2,B0,GET
- EQ B0,B0,MASK
- END
diff --git a/src/mathlib/gen/obsolete/m405/invert.s b/src/mathlib/gen/obsolete/m405/invert.s
deleted file mode 100644
index 174a168..0000000
--- a/src/mathlib/gen/obsolete/m405/invert.s
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: invert.s,v 1.1.1.1 1996/04/01 15:03:20 mclareni Exp $
-*
-* $Log: invert.s,v $
-* Revision 1.1.1.1 1996/04/01 15:03:20 mclareni
-* Mathlib gen
-*
-*
- IDENT INVERT
- ENTRY INVERT
-* FUNCTION INVERT(I,K)
-#include "entftn.inc"
- NAME VFD 36/6HINVERT,24/2
- ENTFTN INVERT,2
- SA3 B2 .LOAD BIT COUNT IN X3
- SA1 B1 .LOAD WORD TO BE REVERSED IN X1
- NO
- SX6 B0 .CLEAR X6
- SB7 1 .SET DECREMENT
- SB2 X3 .SET BIT COUNT
- SX0 B7 .SET UP MASK
- LOOP LX6 1 .MAKE ROOM IN X6
- BX2 X0*X1 .EXTRACT ONE BIT
- SB2 B2-B7 .DECREMENT BIT COUNT
- AX1 1 .RIGHT ADJUST NEXT BIT
- BX6 X2+X6 .MERGE IN NEW BIT
- NZ B2,LOOP
- JP INVERT
- END
diff --git a/src/mathlib/gen/obsolete/m418/packch.s b/src/mathlib/gen/obsolete/m418/packch.s
deleted file mode 100644
index bf26d35..0000000
--- a/src/mathlib/gen/obsolete/m418/packch.s
+++ /dev/null
@@ -1,222 +0,0 @@
-*
-* $Id: packch.s,v 1.1.1.1 1996/04/01 15:03:20 mclareni Exp $
-*
-* $Log: packch.s,v $
-* Revision 1.1.1.1 1996/04/01 15:03:20 mclareni
-* Mathlib gen
-*
-*
- IDENT PACKCH
-#include "entftn.inc"
- PACKWD DATA 37777600B .ADDRESS/SHIFT FOR PACKING
- PACKN DATA 0 .CURRENT INPUT CHARACTER ADDRESS
- UPWORD DATA 37777600B .ADDRESS/SHIFT FOR UNPACKING
- UPN DATA 0 .CURRENT OUPPUT CHARACTER ADDRES
-,S
- PACKMX DATA 377777B .MAX CHAR ADDRESS I/P 131 071
- UPMX DATA 377777B .MAX CHAR ADDRESS O/P 131071
- SPACE 2
-* MACRO TO DIVIDE X1 BY TEN AND CALCULATE 6*(6-(N-10*K)) = L
-* N IS IN X1
-* K IS IN X5 = N/10
-* L IS IN X4 AND B4
- SPACE 2
- TENTH MACRO WORDN
- SA2 =0.1 .FACTOR FOR MULTIPLACTION
- SA5 =0.01 .TERM FOR ROUNDING
- BX6 X1 .MOVE N TO CURRENT ADDRESS
- PX3 B0,X1 .FLOAT N
- SA6 WORDN .STORE CURRENT CHARACTER ADDRESS
- FX4 X3*X2 .X4 = 0.1*N
- FX5 X5+X4 .ADD ROUNDING FACTOR
- UX3 B4,X5
- SB5 1
- SB6 3
- LX5 B4,X3 .X5 = FIX (N/10) = K
- LX2 X5,B5 .2*K
- LX3 X5,B6 .8*K
- SX4 9
- IX2 X2+X3 .10*K
- IX3 X1-X2 .N-10*K
- SB4 2
- SB5 1
- IX4 X4-X3 .9-(N-10*K) = CHAR IN WORD
- LX2 X4,B4 .2*SH
- LX3 X4,B5 .4*SHIFT
- IX4 X2+X3 .6*CHAR = L
- SB4 X4
- ENDM
- SPACE 2
-* PICK UP WORD AND OAND OUT THE OLD CHARACTER AND OR IN THE NEW.
-* TO TAKE CHARACTER IN X3 (ZZZZZZZZZX) AND PLACE IN
-* THE WORD X2 (ABCDEFGHIJ).
-* X4 = B4 = 6*(9-(11-10)) = 48
-* NOTE 0 = 6 BITS OF ZERO AND + IS 6 BITS OF ONES (63)
-* AT END OF MACRO STORE CURRENT SHIFT AND ADDRESS IN PACKWD
- SPACE 2
- PACK MACRO
- MX0 54 .X0 = +++++++++0
- SX5 A2 .CURRENT ADDRESS IS 0000000AAA
- LX6 X0,B4 .X6 = +0++++++++
- BX3 -X0*X3 .X3 = 000000000X
- BX2 X2*X6 .X2 = A0CDEFGHIJ
- LX7 X3,B4 .X7 = 0X00000000
- LX5 6 .SHIFT 000000AAA0
- BX6 X2+X7 .X6 = AXCDEFGHIJ
- IX7 X5+X4 .ADD SHIFT 000000AAAS
- SA6 A2 .STORE RESULT
- SA7 PACKWD
- ENDM
- SPACE 2
-* MASK OUT CHARACTER IN X2
-* STROE CURRENT ADDRESS AND SHIFT IN UPWORD
- SPACE 2
- UNPACK MACRO
- SX5 A2
- MX0 54 .MASK
- LX5 6
- IX7 X5+X4
- AX3 X2,B4 .SHIFT CHARACTER TO BITS 0-5
- SA7 UPWORD
- BX6 -X0*X3 .AND OUT BITS /-5
- ENDM
- SPACE 2
-* TO LOOK AT WORD AND SET X2 TO ADDRESS FOR NEXT CHARACTER
-* AND B4 (X4) TO CURRENT SHIFT
- SPACE 2
- TEST MACRO WORD,SAME,WORDN,MAX,OK,OV,START
- SA3 WORDN .ADD ONE TO CURRENT CHARACTER ADD
- SA2 MAX .X2 = MAXCH COUNT FOR ARRAY
- SA1 WORD .GET LAST CONDITIONX
- MX0 54
- IX2 X3-X2 .TEST FOR MAC CHA COUNT
- NG X2,OK .JUMP IF NOT EXCEEDED
- SA1 B7
- OV RJ =XEXIT .ELSE GO TO EXIT OR USER ROUTINE
- - LT B0,B1,START-1
- EQ B0,B0,START .RETURN ASSUME USER S/R HAS FUN
- OK SX6 X3+1
- BX2 -X0*X1 .ISLOLATE SHIFT
- AX1 6 .SET X1 TO LAST ADDRESS
- SA6 A3
- SX4 X2-6 .REDUCE SHIFT BY ONE CHAR
- PL X4,SAME .JUMP IF SAME WORD
- SX4 54 .ELSE RESET X4 TO 54
- SX1 X1+1 .AND ADD ONE TO ADDRESS
- SAME SA2 X1 .BRING CURRENT WORD TO X2
- SB4 X4 .PUT SHIFT IN B4
- ENDM
- SPACE 2
-* TO INSERT BUFFER SIZE INTO TABLE AND ENTRY POINT OF
-* USERS OVERFLOW ROUTINE INPLACE OF RJ EXIT
- SPACE 2
- SIZE MACRO MAX,OV
- SA1 B1 .MAXIMUM BUFFER SIZE
- SA4 OV .0100AAAAAA0700BBBBBB (A = EXIT)
- MX0 43 . MASK FOR SIZE OF BUFFER
- SX3 B2 .ADDRESS OF USER S/R 0..0UUUUUU
- BX6 -X0*X1 .REDUCE MAX SIZE TO 2**17-1
- MX0 18 .++++++000000000000
- SA6 MAX .STORE MAXIMUM CHARACTER IN MAX
- LX0 48 .0000++++++0000000000
- LX3 30 .ADDRESS 0000UUUUUU0000000000
- BX6 -X0*X4 .01000000000700BBBBBB
- BX7 X6+X3 .0100UUUUUU0700BBBBBB
- SA7 A4 .STORE NEW RJ INSTRUCTION
- ENDM
- EJECT
- SPACE 2
-* ENTRY TO PACK CHARACTER INTO CHARTER POSITION N OF ARRAY A.
- SPACE 2
- ENTRY PACKCH
-* SUBROUTINE PACKCH(I,ICH,N)
- + VFD 42/0HPACKCH,18/3
- ENTFTN PACKCH,3
- SA1 B3
- TENTH PACKN
- SA2 B1+X5 .X2 = A(2) = ABCDEFGHIJ
- SA3 B2 .X3 = Q = ZZZZZZZZZX
- PACK
- EQ B0,B0,PACKCH .RETURN
- EJECT
- SPACE 2
-* PICK UP WORD AND OBTAIN CHARACTER. STORE IN X6
- SPACE 2
- ENTRY ICHAR
-* FUNCTION ICHAR(Y,N)
- + VFD 42/0HICHAR,18/2
- ENTFTN ICHAR,2
- SA1 B2
- TENTH UPN
- SA2 B1+X5 .PICK UP WORD IN ARRAY
- UNPACK
- EQ B0,B0,ICHAR RETURN
- EJECT
- SPACE 2
-* ENTRY TO PACK NEXT CHARACTER 2NTO ARRAY. LAST ADDRESS IS USED
- SPACE 2
- ENTRY PKNXCH
-* SUBROUTINE PKNXCH(ICH)
- + VFD 42/0HPKNXCH,18/01
- ENTFTN PKNXCH,1
- TEST PACKWD,SAMEA,PACKN,PACKMX,OKA,PACKOV,PKNXCH
- SA3 B1 .PICK UP WORD TO BE PACKED
- PACK
- EQ B0,B0,PKNXCH .RETURN
- EJECT
- SPACE 2
-* ENTRY TO OBTIAN NEXT CHARACTER FROM INPUT ARRAY.
- SPACE 2
- ENTRY INXCH
-* FUNCTION INXCH(DUMMY)
- + VFD 42/0HINXCH,18/01
- ENTFTN INXCH,0
- TEST UPWORD,SAMEB,UPN,UPMX,OKB,UPOV,INXCH
- UNPACK
- EQ B0,B0,INXCH .RETURN
- EJECT
- SPACE 2
-* ENTRY TO PROVIDE CURRENT CHARACTER ADDRESS IN THE BUFFER
-* BEING UNPACKED.
- SPACE 2
- ENTRY IINN
-* FUNCTION IINN(DUMMY)
- + VFD 42/0HIINN,18/01
- ENTFTN IINN,0
- SA1 UPN
- BX6 X1
- EQ B0,B0,IINN .RETURN
- SPACE 5
-* ENTRY TO PROVIDE CURRENT CHARACTER ADDRESS IN THE BUFFER
-* BEING PACKED
- SPACE 2
- ENTRY IOUTN
-* FUNCTION IOUTN(DUMMY)
- + VFD 42/0HIOUTN,18/01
- ENTFTN IOUTN,0
- SA1 PACKN
- BX6 X1
- EQ B0,B0,IOUTN
- EJECT
- SPACE 2
-* ENTRY TO SET SIZE OC OUTPUT BUFFER AND EXTERNAL TO BE
-* CALLED WHEN THE BYFFER IS FULL
- SPACE 2
- ENTRY OUTSZE
-* SUBROUTINE OUTSZE(NEWMAX,USER)
- + VFD 42/0HOUTSZE,18/02
- ENTFTN OUTSZE,2
- SIZE PACKMX,PACKOV
- EQ B0,B0,OUTSZE
- SPACE 2
-* ENTRY TO SET SIZE OF INPUT BUFFER AND EXTERNAL TO BE
-* CALLED WHEN THE BUFFER IS EXHAUSTED
- SPACE 2
- ENTRY INSZE
-* SUBROUTINE INSZE(NEW,USERI)
- + VFD 42/0HINSZE,18/02
- ENTFTN INSZE,2
- SIZE UPMX,UPOV
- EQ B0,B0,INSZE
- SPACE 2
- END
diff --git a/src/mathlib/gen/obsolete/m420/ubyte.s b/src/mathlib/gen/obsolete/m420/ubyte.s
deleted file mode 100644
index 3666d64..0000000
--- a/src/mathlib/gen/obsolete/m420/ubyte.s
+++ /dev/null
@@ -1,283 +0,0 @@
-*
-* $Id: ubyte.s,v 1.1.1.1 1996/04/01 15:03:21 mclareni Exp $
-*
-* $Log: ubyte.s,v $
-* Revision 1.1.1.1 1996/04/01 15:03:21 mclareni
-* Mathlib gen
-*
-*
- IDENT UBYTE (19/4/71)
-* *************************************
-#include "entftn.inc"
-* *************************************
- SPACE 2
-* THIS ROUTINE UNPACKS BINARY INFORMATION CONTAINED IN AN INPUT RECORD
-* BY EXPANDING THE RECORD SO THAT ONLY BTSPW (THIRD INPUT PARAMETER)
-* BITS PERWORD, RIGHT ADJUSTED AND ZERO FILL, ARE PLACED IN THE OUTPUT
-* RECORD. THE OUTPUT RECORD IS PLACED IN THE INPUT RECORD BUFFER AND IT
-* IT IS ASSUMED THAT THE INPUT RECORD RECORD BUFFER IS LARGE ENOUGH TO
-* CONTAIN THE OUTPUT RECORD. IT IS ALSO ASSUMED THAT ANY BITS AT THE
-* END OF THE INPUT RECORD WHICH DO NOT COMPRISE A WHOLE CM WORD ARE
-* LEFT ADJUSTED IN THE LAST WORD OF THE RECORD, THE REMAINING FILL BITS
-* ARE NOT EXAMINED. ON OUTPUT ANY REMAINING BITS LESS THAN BTSPW ARE
-* EXPANDED TO BTSPW BY ZERO FILL AT THE RIGHT AND PLACED IN THE LAST
-* WORD OF THE OUTPUT RECORD.
-* FORTRAN CALLING SEQUENCE IS EXPECTED BY THIS ROUTINE. THIS ROUTINE
-* MAY BE CALLED BY A REGULAR FORTRAN CALL STATEMENT.-
-* CALL UBYTE (NBYTES,REC,BTSPW)
-* THE EXPANSION TAKES PLACE BEGINNING AT THE LAST WORD OF THE INPUT
-* RECORD, WORKING BACKWARDS AND TERMINATING WITH THE FIRST WORD OF THE
-* INPUT RECORD.
-*
-* PARAMETERS SET UP BY THE CALLING ROUTINE (IN REGS B1-B3)
-* ADNBYTS ADDRESS OF NBYTS, THE LENGTH OF THE INPUT RECORD
-* IN 8-,16 OR 32-BIT BYTES. THIS VALUE MUST LIE
-* BETWEEN 1 AND 3840 INCLUSIVE.
-* ADREC ADDRESS OF THE INPUT RECORD REC.
-* ADBTSPW ADDRESS OF BTSPW, THE NUMBER OF BITS PER WORD IN
-* THE OUTPUT RECORD. THE VALUE OF THIS PARAMETER
-* MUST BE-
-* 0 NO EXPANSION IS PERFORMED
-* 8,16,OR 32 THE NUMBER OF BITS PLACED IN EACH
-* WORD OF THE OUTPUT RECORD AS SHOWN
-* ABOVE
-*
-* REGISTERS USED BY THIS ROUTINE
-* ALL
- SPACE 5
- ENTRY UBYTE
-* SUBROUTINE UBYTE(N,A,IBITS)
- + VFD 30/0HUBYTE,30/3
- ENTFTN UBYTE,3,X1
- SPACE 2
-* CHECK THAT THE NUMBER OF UNPUT PARAMETERS IS EXACTLY THREE
- SA3 B1 .NBYTS
- BX6 X3 .NBYTS
- SX2 X1-3 .CHECK NUM OF PARMS
- NZ X2,UBYTE .ERROR IF NOT THREE
- SPACE 2
-* CHECK THAT NBYTS IS .GT. 0
- BX4 X6 .NBYTS
- ZR X3,UBYTE .ERROR IF ZERO
- LX4 3 .MULTIPLY BYTES BY 8 FOR TOTAL BITS
- NG X6,UBYTE .ERROR IF NEGATIVE
- SA2 FSIXTY .FLT PT VALUE OF SIXTY
- SA3 B3 .X3=IBITS
- SB4 X3-8
- EQ B0,B4,UB
- LX4 1
- SB4 X3-16
- EQ B0,B4,UB
- LX4 1
- SPACE 2
-* CALCULATE TOTAL NUMBER OF BITS IN THE INPUT RECORD. ALSO THE NUMBER
-* OF WHOLE WORDS AND REMAINING BITS
- UB PX7 B0,X4
- NX7 B4,X7 .CONVERT NUM OF BITS TO FLT PT
- FX5 X7/X2 .DIVIDE BY SIXTY FOR NUMBER OF WHOLE WORDS
- UX5 B4,X5 .CONVERT TO INTEGER
- LX5 B4,X5 .X5 HAS NUM OF WHOLE WORDS IN INPUT REC
- PX6 B0,X5 .GET FLT PT VALUE OF NUM OF WHOLE WORDS
- NX6 B4,X6
- FX3 X6*X2 .MULTIPLY BY SIXTY
- FX3 X7-X3 .REMAINING BITS AFTER DIVISION BY 60
- SX2 60 .SET UP X2 FOR LOOP
- UX3 B4,X3 .CONVERT TO INTEGER
- SB7 X2 . SET UP B7 FOR LOOP
- LX7 B4,X3 .X7=0, OR LEFTOVER VALID BITS IN LAST WORD
- ZR X7,REB4 .NO ODD BITS IN LAST WORD
- SA1 B2+X5 .SET UP X1 FOR LOOP
- SB7 X7
- LX1 B7,X1 .SET UP X1 FOR LOOP
- EQ B0,B0,REB5
- REB4 SX5 X5-1 .NO ODD BITS IN LAST WORD
- SA1 B2+X5
-* REGISTERS SET UP IN THE PRECEEDING CODE ARE-
-* X4= TOTAL BITS IN INPUT RECORD
-* X2= INTEGER VALUE 60
-* X7= NUMBER OF VALID DATA BITS IN LAST WORD OF RECORD OR 0
-* B7= NUMBER OF VALID DATA BITS IN LAST WORD OF RECORD OR 60
-* X5= NUMBER OF TOTAL WORDS IN THE INPUT RECORD -1
-* A1= ADDRESS OF LAST WORD OF THE INPUT RECORD
-* X1= CONTENTS OF LAST WORD OF THE INPUT RECORD
- SPACE 2
-* CHECK THAT BTSPW IS 0, 8, 16,OR 32 AND SET UP MASKS ACCORDINGLY
- REB5 SA3 B3 .GET THIRD INPUT PARAMETER
- ZR X3,UBYTE .NO UNPACKING
- SX7 X3-8
- ZR X7,REB1 .BTSPW=8
- SX7 X3-16
- ZR X7,REB2 .BTSPW=16
- SX7 X3-32
- NZ X7,UBYTE .BTSPW NOT EQUAL TO 0,8,16, OR 32
- SB1 5
- SX5 37B
- EQ B0,B0,REB3
- REB2 SB1 4 .BTSPW=16
- SX5 17B
- EQ B0,B0,REB3
- REB1 SB1 3 .BTSPW=8
- SX5 7
-* REGISTERS SET UP IN THE PRECEEDING CODE ARE-
-* X3= BTSPW, THIRD INPUT PARAMETER
-* B1= MASK FROM BTSPW
-* X5= MASK FROM BTSPW
-* X4= TOTAL BITS IN INPUT RECORD
-* X2= INTEGER VALUE 60
-* B7= NUMBER OF VALID DATA BITS IN THE LAST WORD OF THE INPUT RECORD
-* A1= ADDRESS OF LAST WORD OF THE INPUT RECORD
-* X1= CONTENTS OF LAST WORD OF THE INPUT RECORD
- SPACE 2
-* GET NUMBER OF WHOLE NEW WORDS IN OUTPUT RECORD AND NUMBER OF
-* VALID DATA BITS IN THE LAST WORD OF THE OUTPUT RECORD
- REB3 SB5 1
- BX7 X4*X5 .X7= NUM OF VALID BITS IN LAST WORD
- AX4 B1,X4 .X4= TOTAL NUM OF WORDS -1
- NZ X7,REB6
- SX4 X4-1 .X4=NUM OF WORDS IN OUTPUT REC -1
- BX7 X3 .NUM OF DATA BITS IN THE LAST WORD OUTPUT
- REB6 IX5 X3-X7 .NUM OF BITS OF ZERO FILL IN LAST WORD
- SB3 X5 .NUMBER OF BITS ZERO FILL
- SB4 X7 .NUM OF VALID BITS IN LAST WORD OUTPUT
- SB6 B2+X4 .ADDRESS OF FIRST WORD OF OUTPUT RECORD
- SX6 B0
- SA3 X3
- SB1 A3-1 .A3 HAS VALUE 8, 16, OR 32
- MX5 1 .SET UP MASK IN X5
- AX5 B1,X5
- SB1 B1+B5
- LX5 B1,X5 .X5 HAS 8, 16, 32, ONE BITS IN RHS
- BX3 X1
- SA1 A1-B5 .GET NEXT WORD OF INPUT RECORD
- GE B7,B4,REB21
- SPACE 2
-* THERE ARE NOT ENOUGH BITS IN THE LAST INPUT WORD FOR THE FIRST OUTPUT
-* WORD, SO MOVE THE BITS TO THE OUTPUT REGISTER AND FETCH THE NEXT
-* INPUT WORD
- REB20 SX6 B0
- MX6 1
- SB7 B7-B5
- AX6 B7,X6
- SB7 B7+B5
- LX6 B7,X6
- BX6 X6*X3
- BX3 X1 .X3 CONTAINS CURRENT INPUT WRD
- SA1 A1-B5 .GET NEXT WORD OF INPUT RECORD
- LX6 B3,X6
- SB3 B3+B7
- SB4 B4-B7
- SB7 X2
- EQ B0,B0,REB21
-* LOOP TO CONVERT THE INPUT RECORD TO THE OUTPUT RECORD. CONVERSION
-* TAKES PLACE BEGINNING AT THE LAST WORD OF THE INPUT RECORD AND
-* CONTINUING UNTIL THE BEGINNING OF THE RECORD IS REACHED. THE NEW
-* OUTPUT RECORD IS STORED ALTERNATIVELY FROM REGISTERS 6 AND 7 SO
-* THE CODE IS HELD ESSENTIALLY IN TWO LOOPS TO ENABLE THIS TO BE
-* DONE MOST EFFICIENTLY. THE REGISTERS USED IN THE LOOPS ARE LISTED
-* BELOW
- SPACE 2
-* ..............................................................
-* ..............................................................
-* .. ..
-* .. REGISTER ALLOCATION ..
-* .. ******************* ..
-* .. ..
-* .. B5 +1 ..
-* .. B3 NUMBER OF BITS ALREADY IN X6 OR X7 ..
-* .. B4 NUM OF BITS YET TO BE MOVED TO THE OUTPUT REGISTER ..
-* .. B7 NUMBER OF BITS IN INPUT REGISTER YET TO BE MOVES ..
-* .. A1 ADDRESS OF WORD IN INPUT REGISTER ..
-* .. X1 CONTAINS NEXT INPUT WORD ..
-* .. X3 CONTAINS CURRENT INPUT WORD ..
-* .. A3 8, 16, OR 32. THE THIRD INPUT PARAMETER ..
-* .. X6 OUTPUT REGISTER ..
-* .. X7 OUTPUT REGISTER ..
-* .. B6 ADDRESS OF CURRENT OUTPUT WORD ..
-* .. X4 WORKING REGISTER ..
-* .. X0 WORKING REGISTER .=
-* .. X2 +60 ..
-* .. B2 ADDRESS OF THE INPUT RECORD ..
-* .. X5 HAS MASK OF 8, 16, OR 32 ONE BITS IN RHS ..
-* .. ..
-* ..............................................................
-* ..............................................................
- SPACE 2
- REB10 SB7 X2 .X2=60
- BX3 X1 .GET NEW INPUT WORD
- SA1 A1-B5
- REB9 BX6 X5*X3 .MASK OUT BITS NEEDED FOR OUTPUT
- SB7 B7-B4 .NUM OF VALID BITS LEFT IN INPUT WORD
- SA6 B6 .SAVE OUTPUT WORD
- AX3 B4,X3 .DISCARD BITS ALREADY USED
- SB6 B6-B5 .ADDRESS OF NEXT WORD TO BE STORED
- LT B7,B4,REB8 .ARE THERE ENOUGH BITS FOR NEXT OUTPUT WORD
- REB90 BX7 X5*X3 .MASK BITS NEEDED FOR OUTPUT
- SB7 B7-B4 .NUMBER OF VALID BITS LEFT IN INPUT WORD
- SA7 B6 .SAVE OUTPUT WORD
- AX3 B4,X3 .DISCARD BITS ALREADY USED
- SB6 B6-B5 .ADDRESS OF NEXT WORD TO BE STORED
- GE B7,B4,REB9 .ARE THERE ENOUGH BITS FOR NEXT WORD
- REB80 LT B6,B2,UBYTE IS THIS THE END OF INPUT
- NZ B7,REB110 .ARE THERE ANY BITS LEFT IN INPUT WORD
- EQ B0,B0,REB10
- REB110 SB4 B7 .NUMBER OF BITS LEFT IN INPUT WORD
- MX0 1
- SB4 B4-B5
- AX4 B4,X0
- SB4 B4+B5
- LX0 B4,X4 .SET UP MASK IN X0
- BX6 X0*X3 .MASK REMAINING BITS INTO X6
- SB3 B4 .NUM OF BITS ALREADY IN OUTPUT WORD
- BX3 X1 .GET NEW INPUT WORD
- SB4 A3-B4 .NUMBER OF BITS STILL TO BE MOVED
- SB7 X2 .X2=60
- SA1 A1-B5 .GET NEXT INPUT WORD
- REB21 MX0 1
- SB4 B4-B5
- AX4 B4,X0
- SB4 B4+B5
- LX0 B4,X4 .PUT MASK INTO X0
- BX4 X0*X3 .GET THE REMAINING BITS INTO X4
- LX0 B3,X4 .PUT BITS INTO RIGHT POSITION OF REGISTER
- BX6 X0+X6 .ADD REMAINING BITS TO X6
- SB7 B7-B4 .NUM OF VALID BITS LEFT IN INPUT WORD
- AX3 B4,X3 .DISCARD BITS ALREADY USED
- SA6 B6 .SAVE OUTPUT WORD
- SB4 A3 .A3=8, 16, OR 32
- SB6 B6-B5 .ADDRESS OF NEXT OUTPUT WORD
- GE B7,B4,REB90 .ARE THERE ENOUGH BITS FOR WHOLE NEW WORD
- REB8 LT B6,B2,UBYTE IS THIS THE END OF INPUT
- ZR B7,REB100 .GET NEXT NEW WORD
- SB4 B7 .NUMBER OF BITS LEFT TO BE MOVED
- MX0 1
- SB4 B4-B5
- AX4 B4,X0
- SB4 B4+B5
- LX0 B4,X4 .GET MASK INTO X0
- BX7 X0*X3 .GET REMAINING BITS FROM INPTU WORD
- SB3 B4 .NUM OF BITS ALREADY IN X7
- BX3 X1 .GET NEW INPUT WORD
- SB4 A3-B4 .NUMBER OF BITS STILL TO BE MOVED
- SB7 X2 .X2=60
- SA1 A1-B5 .GET NEXT INPUT WORD
- MX0 1
- SB4 B4-B5
- AX4 B4,X0
- SB4 B4+B5
- LX0 B4,X4 .GET MASK INTO X0
- BX4 X0*X3 .GET THE REMAINING BITS INTO X4
- LX0 B3,X4 .PTU BITS INTO CORRECT POSITION IN REGISTER
- BX7 X0+X7 .ADD THESE BITS TO OTHERS
- SB7 B7-B4 .NUM OF VALID BITS LEFT IN INPUT WORD
- AX3 B4,X3 .DISCARD BITS ALREADY USED
- SA7 B6 .SAVE OUTPUT WORD
- SB4 A3 .A3= 8, 16, OR 32
- SB6 B6-B5 .ADDRESS OF NEXT OUTPUT WORD
- GE B7,B4,REB9 .ARE THERE ENOUGH BITS FOR NEXT NEW WORD
- EQ B0,B0,REB80
- REB100 SB7 X2 .X2=60
- BX3 X1 .GET NEW INPUT WORD
- SA1 A1-B5 .GET NEXT INPUT WORD
- EQ B0,B0,REB90
- FSIXTY DATA 60.0
- END
diff --git a/src/mathlib/gen/obsolete/m435/chmove.F b/src/mathlib/gen/obsolete/m435/chmove.F
deleted file mode 100644
index d5d1a75..0000000
--- a/src/mathlib/gen/obsolete/m435/chmove.F
+++ /dev/null
@@ -1,30 +0,0 @@
-*
-* $Id: chmove.F,v 1.1.1.1 1996/04/01 15:03:21 mclareni Exp $
-*
-* $Log: chmove.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:21 mclareni
-* Mathlib gen
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_gen/pilot.h"
-#if !defined(CERNLIB_CDC)
- SUBROUTINE CHMOVE(SOURCE,IS,TARGET,IT,NCHAR)
-C Moves NCHAR characters from position IS in SOURCE
-C to position IT in TARGET
-#if (!defined(CERNLIB_CRAY))&&(!defined(CERNLIB_UNIX))
-C FORTRAN 4 version Nov. 1976, F.James/CERN
- LOGICAL*1 SOURCE(10),TARGET(10)
- IF(NCHAR.LE.0) RETURN
- DO 100 I= 1, NCHAR
- 100 TARGET(IT+I-1) = SOURCE(IS+I-1)
-#endif
-#if defined(CERNLIB_CRAY)||defined(CERNLIB_UNIX)
-C FORTRAN 77 version, May 1983, T.Lindelof/CERN
- CHARACTER*(*) SOURCE,TARGET
- DO 100,I=0,NCHAR-1
- 100 TARGET(IT+I:IT+I) = SOURCE(IS+I:IS+1)
-#endif
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/obsolete/m435/chmoveml.s b/src/mathlib/gen/obsolete/m435/chmoveml.s
deleted file mode 100644
index 95561eb..0000000
--- a/src/mathlib/gen/obsolete/m435/chmoveml.s
+++ /dev/null
@@ -1,134 +0,0 @@
-*
-* $Id: chmoveml.s,v 1.1.1.1 1996/04/01 15:03:21 mclareni Exp $
-*
-* $Log: chmoveml.s,v $
-* Revision 1.1.1.1 1996/04/01 15:03:21 mclareni
-* Mathlib gen
-*
-*
-#if defined(CERNLIB_CDC)
- IDENT CHMOVE
-MOVE TITLE CHARACTER MOVE SUBROUTINE
-*** CALL CHMOVE(X,I,Y,J,N)
-*
-* MOVE N CHARACTERS
-* FROM PACKED BUFFER X STARTING IN COLUMN I
-* TO PACKED BUFFER Y STARTING IN COLUMN J
-* (WHERE THE FIRST CHARACTER OF A BUFFER IS NUMBERED 1.)
-*
-* UNDEFINED RESULTS PRODUCED IF THE CHARACTER FIELDS OVERLAP.
-*
-* SCM DIRECT RANGE ERROR IF N<0 OR N>20000
-*
-M1 VFD 42/0LCHMOVE,18/5
- ENTRY CHMOVE
-* SUBROUTINE CHMOVE(IBUF,IPOS,KBUF,KPOS,NCHAR)
-CHMOVE DATA 0
- SB7 1 CONVERT FROM RUN TO FTN CALL. SEQ
- SA2 A1
- SB1 X2
- SA2 A2+B7
- SB2 X2
- SA2 A2+B7
- SB3 X2
- SA2 A2+B7
- SB4 X2
- SA2 A2+B7
- SB5 X2 END OF CALL SEQ. CONVERSION
- SA1 =20000000000000000006B GET 6
- SA2 B2 GET COUNT PARAMETERS
- SA4 B4
- PX2 X2
- SB7 -6
- DX2 X1*X2
- SA5 B5
- PX4 X4
- ZR X5,CHMOVE IF 0 CHARACTER MOVE
- DX4 X1*X4
- PX5 X5
- SB2 X2+B7
- DX5 X1*X5
- SB4 X4+B7
- SB5 X5
- SB6 60
- SB7 1
- SX5 X5-120001
- NG B5,MOVE6 IF N<0
- PL X5,MOVE6 IF N>20000
-+SB4B4-B6ADJUSTTOFIRSTSIGNIFICANTWORD
- SB3 B3+B7
- PL B4,*
-+SB2B2-B6
- SB1 B1+B7
- PL B2,*
- SB2 B2+B6
- SA1 B1-B7 GET FIRST WORD OF X
- SB4 B4+B6
- SA3 B3-B7 GET FIRST WORD OF Y
- MX0 1 FORM INITIAL MASKS
- SB1 B2-B7
- AX2 B1,X0
- SB3 B4-B7
- AX4 B3,X0
- MX7 59
- BX2 X7*X2
- BX4 X7*X4
- SB3 B2-B4 GET OFFSET SHIFT
- BX1 -X2*X1 GET INITIAL X
- SA5 A3-B7 PRESET STORE ADDRESS
- BX6 X5
- SA6 A5
- BX6 X4*X3 GET INITIAL Y
- SB5 B5-B6 COUNT INITIAL WORD FILL
- SB5 B5+B4
- NZ B3,MOVE2 IF NONZERO OFFSET
- BX6 X1+X6 FILL FIRST WORD
- GE B0,B5,MOVE5 IF MOVE COMPLETE
-MOVE1 SA6 A6+B7 STORE OLD WORD
- SA1 A1+B7 GET NEW WORD
- SB5 B5-B6
- BX6 X1
- LT B0,B5,MOVE1 IF MORE TO GO
- EQ MOVE5
-MOVE2 NG B3,MOVE3 IF INITIAL X AND Y HAVE > 10 CHARS
- SB1 B6-B3
- LX1 B3,X1 POSITION INITIAL WORD
- SB1 B1-B7 FORM OFFSET MASK
- BX6 X1+X6
- SA1 A1+B7
- AX7 B1,X0
- LX1 B3,X1
- BX2 -X7*X1
- BX6 X2+X6
- GE B0,B5,MOVE5 IF FIRST WORD IS LAST ONE
- EQ MOVE4 GO DO BODY
-MOVE3 SB1 B0-B3
- SB3 B3+B6 ADJUST OFFSET
- LX1 B3,X1 POSITION INITIAL WORD
- SB1 B1-B7 FORM OFFSET MASK
- BX2 -X4*X1
- AX7 B1,X0
- BX6 X2+X6
- GE B0,B5,MOVE5 IF FIRST WORD IS THE LAST
-MOVE4 SA6 A6+B7 STORE OLD WORD
- BX6 X7*X1 GET FIRST HALF OF NEW
- SA1 A1+B7
- SB5 B5-B6
- LX1 B3,X1
- BX2 -X7*X1
- BX6 X2+X6 COMPLETE NEW WORD
- LT B0,B5,MOVE4 IF MORE TO GO
-MOVE5 SB2 B5+B6 GET NUMBER OF REMAINING BITS
- SA3 A6+B7 GERT LAST WORD OF Y
- SB1 B2-B7
- AX2 B1,X0
- BX3 -X2*X3 COMBINE TAIL WORD
- BX6 X2*X6
- BX6 X3+X6
- SA6 A3
- EQ CHMOVE
-MOVE6 SX1 69 FATAL ERROR 69
- SX2 =C* CHARACTER COUNT <0 OR >20000.*
- SA1 377777B MODE1 FOR USER ERROR
- END
-#endif
diff --git a/src/mathlib/gen/obsolete/m504/getsch.F b/src/mathlib/gen/obsolete/m504/getsch.F
deleted file mode 100644
index f03ee74..0000000
--- a/src/mathlib/gen/obsolete/m504/getsch.F
+++ /dev/null
@@ -1,40 +0,0 @@
-*
-* $Id: getsch.F,v 1.1.1.1 1996/04/01 15:03:21 mclareni Exp $
-*
-* $Log: getsch.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:21 mclareni
-* Mathlib gen
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_gen/pilot.h"
- SUBROUTINE GETSCH(STR,DEL,TRM,NTH,SST,NCH)
-* Return in SST the character string found between the NTH-1 and NTH
-* occurence of the delimiter 'DEL' but before the terminator 'TRM' in
-* the input string 'STR'. If TRM=DEL then STR is considered unlimited.
-* NCH=Length of the string returned in SST or =-1 if NTH is <1 or if
-* NTH is greater than the number of delimiters in STR.
- IMPLICIT INTEGER (A-Z)
- CHARACTER STR*(*),DEL*1,TRM*1,SST*(*)
- NCH=-1
- SST=' '
- IF(NTH.GT.0) THEN
- IF(TRM.EQ.DEL) THEN
- LENGTH=LEN(STR)
- ELSE
- LENGTH=INDEX(STR,TRM)-1
- IF(LENGTH.LT.0) LENGTH=LEN(STR)
- ENDIF
-* Find beginning and end of the NTH DEL-limited substring in STR
- END=-1
- DO 1,N=1,NTH
- IF(END.EQ.LENGTH) RETURN
- BEG=END+2
- END=BEG+INDEX(STR(BEG:LENGTH),DEL)-2
- IF(END.EQ.BEG-2) END=LENGTH
-* PRINT *,'NTH,LENGTH,N,BEG,END=',NTH,LENGTH,N,BEG,END
- 1 CONTINUE
- NCH=END-BEG+1
- IF(NCH.GT.0) SST=STR(BEG:END)
- ENDIF
- END
diff --git a/src/mathlib/gen/obsolete/m504/getsst.F b/src/mathlib/gen/obsolete/m504/getsst.F
deleted file mode 100644
index 1ec5250..0000000
--- a/src/mathlib/gen/obsolete/m504/getsst.F
+++ /dev/null
@@ -1,48 +0,0 @@
-*
-* $Id: getsst.F,v 1.1.1.1 1996/04/01 15:03:21 mclareni Exp $
-*
-* $Log: getsst.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:21 mclareni
-* Mathlib gen
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_gen/pilot.h"
- SUBROUTINE GETSST(STR,DEL,TRM,NTH,SST,NCH)
-C RETURN IN SST THE CHARACTER STRING FOUND BETWEEN THE NTH-1 AND NTH
-C OCCURENCE OF THE DELIMITER 'DEL' BUT BEFORE THE TERMINATOR 'TRM' IN
-C THE INPUT STRING 'STR'. IF TRM=DEL THEN STR IS CONSIDERED UNLIMITED.
-C NCH=LENGTH OF THE STRING RETURNED IN SST OR =-1 IF NTH IS <1 OR IF
-C NTH IS GREATER THAN THE NUMBER OF DELIMITERS IN STR.
- INTEGER STR(2),DEL,TRM,SST(2)
-#if defined(CERNLIB_CDC)
- DATA NCPW/10/
-#endif
-#if !defined(CERNLIB_CDC)
- DATA NCPW/4/
-#endif
- NCH=-1
- IF(NTH.LE.0) RETURN
- IEND=132000
- IF(TRM.NE.DEL) IEND=LOCHAR(TRM,1,STR,132000)-1
- IF(IEND.LE.0) IEND=132000
- IW=0
- IF(NTH.EQ.1) IBEG=1
- KTH=0
- 1 IF(NCPW*IW.LE.IEND) GO TO 2
- KTH=KTH+1
- IF(KTH.LT.NTH) RETURN
- 3 IF(IEND.GE.IBEG-1) NCH=IEND-IBEG+1
- IF (NCH.GT.0) CALL CHMOVE (STR(1), IBEG, SST, 1, NCH)
- RETURN
- 2 IW=IW+1
- KWD=STR(IW)
- 4 NEXT=LOCHAR(DEL,1,KWD,NCPW)
- IF(NEXT.EQ.0) GO TO 1
- KTH=KTH+1
- IF(KTH.EQ.NTH) IEND=MIN(IEND,(IW-1)*NCPW+NEXT-1)
- IF(KTH.LT.NTH) IBEG=(IW-1)*NCPW+NEXT+1
- IF(KTH.EQ.NTH) GO TO 3
- CALL CHMOVE(-DEL,1,KWD,NEXT,1)
- GO TO 4
- END
diff --git a/src/mathlib/gen/obsolete/m505/lochar.F b/src/mathlib/gen/obsolete/m505/lochar.F
deleted file mode 100644
index d561c8c..0000000
--- a/src/mathlib/gen/obsolete/m505/lochar.F
+++ /dev/null
@@ -1,50 +0,0 @@
-*
-* $Id: lochar.F,v 1.1.1.1 1996/04/01 15:03:21 mclareni Exp $
-*
-* $Log: lochar.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:21 mclareni
-* Mathlib gen
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_gen/pilot.h"
- FUNCTION LOCHAR(IST,L,LINE,N)
- DIMENSION LINE(2),IST(2)
-C LOCATE A CHARACTER STRING IST OF LENGTH L IN TARGET ARRAY LINE OF LEN
-C T LINDELOF 15/9 1977
-#if defined(CERNLIB_CDC)
- DATA NCPW/10/,IBL/1H /
-#endif
-#if defined(CERNLIB_CONVEX64)
- DATA NCPW/ 8/,IBL/8H /
-#endif
-#if defined(CERNLIB_CRAY)
- DATA NCPW/ 8/,IBL/1H /
-#endif
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION JST,IBL,LOOK
-#endif
-#if (defined(CERNLIB_DOUBLE))&&(!defined(CERNLIB_F90))
- DATA NCPW/ 8/,IBL/8H /
-#endif
-#if (defined(CERNLIB_DOUBLE))&&(defined(CERNLIB_F90))
- INTEGER :: NCPW = 8
- IBL = transfer(' ', 0D0)
-#endif
- LOCHAR=0
- IF(L.EQ.0) RETURN
- LL=MIN(ABS(L),NCPW)
- IF(LL.GT.N) RETURN
- JST=IBL
- CALL CHMOVE(IST,1,JST,1,LL)
- LOOK=IBL
- NN=N-LL+1
- DO 1 I=1,NN
- CALL CHMOVE(LINE,I,LOOK,1,LL)
- IF(JST.EQ.LOOK) IF(L) 1,1,2
- IF(L) 2,2,1
- 1 CONTINUE
- RETURN
- 2 LOCHAR=I
- RETURN
- END
diff --git a/src/mathlib/gen/obsolete/many/rndm2ml.s b/src/mathlib/gen/obsolete/many/rndm2ml.s
deleted file mode 100644
index fd962c7..0000000
--- a/src/mathlib/gen/obsolete/many/rndm2ml.s
+++ /dev/null
@@ -1,186 +0,0 @@
-*
-* $Id: rndm2ml.s,v 1.1.1.1 1996/04/01 15:03:05 mclareni Exp $
-*
-* $Log: rndm2ml.s,v $
-* Revision 1.1.1.1 1996/04/01 15:03:05 mclareni
-* Mathlib gen
-*
-*
-#if defined(CERNLIB_OLD)
-#if (defined(CERNLIB_VAX))&&(!defined(CERNLIB_FORTRAN))
- .TITLE RNDM2
-;
-; UNIFORM RANDOM NUMBER GENERATOR FOR VAX 11-780
-; REWRITTEN FROM CERN IBM 370 VERSION
-; WITH THE IBM-RANDOMNUMBERSEQUENCE
-; TWO PARAMETER VERSION (MCGN,SRGN)
-; ADAPTED AT WUPPERTAL BY H.FORSBACH, MARCH 82
-; LAST MODIFICATION : JUNE 82
-;
-MCGN: .LONG ^D12345
-SRGN: .LONG ^D01073
-RNDM2:: .WORD ^M<R2> ;SAVE REG R2
- MOVL SRGN,R0 ;MOVE SRGN -> R0
- MOVL R0,R1 ;MOVE R0 -> R1
- EXTZV #15,#17,R1,R2 ;\
- MOVL R2,R1 ;_SHIFT RIGHT R1 -> R1 (15 BITS)
- XORL2 R1,R0 ;EXCLUSIVE OR OF R1,R0 -> R0
- MOVL R0,R1 ;MOVE R0 -> R1
- EXTZV #0,#15,R1,R2 ;\
- ROTL #17,R2,R1 ;_SHIFT LEFT R1 -> R1 (17 BITS)
- XORL2 R1,R0 ;EXCLUSIVE OR OF R1,R0 -> R0
- MOVL R0,SRGN ;SAVE THE NEW SRGN
- MOVL MCGN,R2 ;GET MCGN -> R2
- MULL2 #^D69069,R2 ;69069*R2 -> R2
- MOVL R2,MCGN ;SAVE NEW MCGN
- XORL2 R0,R2 ;EXCLUSIVE OR OF R0 [SRGN], R1 [MCGN] -> R2
- EXTZV #8,#24,R2,R1 ;MANTISSA INTO R1
- CVTLF R1,R2 ;MANTISSA TO VAX-FLOATING
- EXTZV #7,#5,R2,R1 ;GET NORMALIZATION SHIFT
- ADDL2 #^X68,R1 ;ADD 128-EXCESS AND AJUST
- INSV R1,#7,#8,R2 ;PACK EXPONENT INTO R2
- MOVL R2,R0 ;COPY ONTO R0 (RNDM2)
- RET
-IRNDM2::
-;
-; UNIFORM DISTRIBUTED POSITIVE INTEGERS
-; WITH THE SAME SEQUENCE AS ON IBM 370 !
-;
- .WORD ^M<R2> ;\
- MOVL SRGN,R0 ; \
- MOVL R0,R1 ; \
- EXTZV #15,#17,R1,R2 ; \
- MOVL R2,R1 ; \
- XORL2 R1,R0 ; \
- MOVL R0,R1 ; \
- EXTZV #0,#15,R1,R2 ; SEE COMMENTS
- ROTL #17,R2,R2 ; OF RNDM2
- MOVL R2,R1 ; /
- XORL2 R1,R0 ; /
- MOVL R0,SRGN ; /
- MOVL MCGN,R2 ; /
- MULL2 #^D69069,R2 ; /
- MOVL R2,MCGN ; /
- XORL2 R0,R2 ;/
- EXTZV #1,#31,R2,R0 ;CLEAR SIGN BIT AND STORE RESULT
- RET
-RD2IN::
- .WORD ^M<>
-;
-; SUBROUTINE RD2IN (MCGN,SRGN)
-; MCGN, SRGN ARE THE STARTING INTEGERS OF RNDM2
-;
- MOVL @4(AP),MCGN
- MOVL @8(AP),SRGN
- RET
-RD2OUT::
- .WORD ^M<>
-;
-; SUBROUTINE RD2OUT (MCGN,SRGN)
-; MCGN, SRGN ARE THE LAST USED INTERGES OF RNDM2
-;
- MOVL MCGN, at 4(AP)
- MOVL SRGN, at 8(AP)
- RET
-#endif
-#if defined(CERNLIB_IBM)
-* UNIFORM RANDOM NUMBER GENERATOR FOR IBM 370
-* TWO-PARAMETER VERSION (ORIGINAL)
-* G.MARSAGLIA, K.ANANTHANARAYANAN, N.PAUL. MCGILL UNIV., MONTREAL
-* ADAPTED AT CERN BY T.LINDELOF, SEPT 1977
-* MODIFIED BY T LINDELOF AUG 1978
-RNDM2 START 0 R=RNDM2(DUMMY)
-#endif
-#if defined(CERNLIB_QMIBMXA)
-RNDM2 AMODE ANY
-RNDM2 RMODE ANY
-#endif
-#if defined(CERNLIB_IBM)
- ENTRY RD2IN .CALL RD2IN(I1,I2)
- ENTRY RD2OUT .CALL RD2OUT(I1,I2)
- ENTRY IRNDM2 .K=IRNDM2(DUMMY)
-REGB EQU 1
-REGC EQU 2
-REGD EQU 3
-*
-* R=RNDM2(DUMMY) RESULT IS NORMALIZED FLOATING POINT VALUE
-* UNIFORMLY DISTRIBUTED ON (0.0,1.0).
- USING *,15
- STM REGB,REGD,24(13) SAVE REGISTERS 1,2,3
-RDIGT1 L REGB,SRGN LOAD SRGN INTO REGB
- LR REGC,REGB AND INTO REGC
- SRL REGC,15 SHIFT REGC RIGHT 15 BITS
- XR REGB,REGC AND XOR INTO REGB
- LR REGC,REGB COPY REGB INTO REGC
- SLL REGC,17 SHIFT IT LEFT 17 BITS,
- XR REGB,REGC AND XOR INTO REGB
- ST REGB,SRGN SAVE THE NEW 'SRGN'
- L REGD,MCGN LOAD MCGN INTO REGD
- M REGC,MULT AND MULTIPLY BY 69069
- ST REGD,MCGN STORE RESULT,MODULO 2**32, AS NEW 'MCGN'
- XR REGD,REGB XOR NEW 'MCGN' AND 'SRGN' IN REGD
- SRL REGD,8 SHIFT REGD RIGHT 8 BITS FOR F.P. FRACTION
- AL REGD,CHAR ADD CHARACTERISTIC X'40' INTO FIRST BYTE
- ST REGD,FWD STORE AT FWD, LOAD INTO FPR 0,
- LE 0,FWD AND ADD NORMALIZED TO ZERO
- AE 0,Z LEAVING RESULT IN FPR 0
-RETRN1 LM REGB,REGD,24(13)
- BCR 15,14 RETURN
-*
-* K=IRNDM2(DUMMY) UNIFORMLY DISTRIBUTED POSITIVE INTEGER.
-*
- USING IRNDM2,15
-IRNDM2 STM REGB,REGD,24(13) SAVE REGISTERS 1,2,3
-RDIGT5 L REGB,SRGN LOAD SRGN INTO REGB
- LR REGC,REGB AND INTO REGC
- SRL REGC,15 SHIFT REGC RIGHT 15 BITS
- XR REGB,REGC AND XOR INTO REGB
- LR REGC,REGB COPY REGB INTO REGC
- SLL REGC,17 SHIFT IT LEFT 17 BITS,
- XR REGB,REGC AND XOR INTO REGB
- ST REGB,SRGN SAVE THE NEW 'SRGN'
- L REGD,MCGN LOAD MCGN INTO REGD
- M REGC,MULT AND MULTIPLY BY 69069
- ST REGD,MCGN STORE RESULT,MODULO 2**32, AS NEW 'MCGN'
- XR REGD,REGB XOR NEW 'MCGN' AND 'SRGN' IN REGD
- SRL REGD,1 SHIFT LEFT 1 BIT,LEAVING SIGN BIT ZERO
- LR 0,REGD AND MOVE RESULT TO GPR 0
-RETRN5 LM REGB,REGD,24(13)
- BCR 15,14 RETURN
-*
-* CALL RD2IN(I1,I2) I1,I2 ARE USED FOR STARTING THE TWO
-* SEQUENCES 'MCGN' AND 'SRGN'.
- USING RD2IN,15
-RD2IN STM REGB,REGD,24(13) SAVE REGISTERS 1,2,3
- LM REGC,REGD,0(1) LOAD ADDRESSES OF I1,I2 INTO REGC,REGD
- L REGC,0(REGC) LOAD VALUE OF I1 INTO REGC
- LTR REGC,REGC
-ST1 ST REGC,MCGN STORE AT 'MCGN'
- L REGD,0(REGD) LOAD I2 INTO REGD
- LTR REGD,REGD
-ST2 ST REGD,SRGN AND STORE AT 'SRGN'.
-RETRN0 LM REGB,REGD,24(13) RESTORE REGISTERS 1,2,3
- BCR 15,14 AND RETURN
-*
-* CALL RD2OUT(I1,I2)
-*
- USING RD2OUT,15
-RD2OUT STM REGB,REGD,24(13) SAVE REGISTERS 1,2,3
- LM REGC,REGD,0(1) LOAD ADDR. OF I1,I2 INTO REGC,REGD
- MVC 0(4,REGC),MCGN MOVE MCGN TO I1
- MVC 0(4,REGD),SRGN MOVE SRGN TO I2
- LM REGB,REGD,24(13) RESTORE REGISTERS 1,2,3
- BCR 15,14 AND RETURN
-*
-* CONSTANTS AND STORAGE RESERVATION
-*
-MCGN DC F'12345'
-X7FF DC X'000007FF'
-SRGN DC F'01073'
-MULT DC F'69069'
-CHAR DC X'40000000'
-FWD DC F'0'
-Z DC E'0.0'
- END
-#endif
-#endif
diff --git a/src/mathlib/gen/obsolete/n205/gdump.F b/src/mathlib/gen/obsolete/n205/gdump.F
deleted file mode 100644
index 61f6612..0000000
--- a/src/mathlib/gen/obsolete/n205/gdump.F
+++ /dev/null
@@ -1,105 +0,0 @@
-*
-* $Id: gdump.F,v 1.1.1.1 1996/04/01 15:03:21 mclareni Exp $
-*
-* $Log: gdump.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:21 mclareni
-* Mathlib gen
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_gen/pilot.h"
-#if defined(CERNLIB_CDC)
- SUBROUTINE GDUMP (IBUF,N,MESSAG)
- DIMENSION IBUF(N),MESSAG(3)
-C
-C INTERPRETED DUMP OF AN ARRAY.
-C
-C IBUF ARRAY TO BE DUMPED
-C N ARRAY LENGTH
-C MESSAG THREE WORDS FOR DUMP HEADING
-C
-C A BIG INTEGER MAY BE MIS-INTERPRETED AS A FLOATING POINT NUMBER
-C A FLOATING POINT NUMBER MAY BE MIS-INTERPRETED AS ALPHABETIC
-C NOT ALL SPECIAL CHARACTERS ARE RECOGNIZED AS ALPHABETIC.
-C
- DIMENSION IFMT(23),IFLOAT(2)
- LOGICAL ISI,ISA,EQ
-C
-C-----------------------------------------------------------------------
-C M A C H I N E D E P E N D E N T V A R I A B L E S
-C -----------------------------------------------------
-C LOGICAL UNIT FOR PRINTER
- DATA NTBCD /2/
-C MAXIMUM POSSIBLE INTEGER, MACHINE DEPENDENT
- DATA MAXINT / 00077777777777777777B /
-C NWF=2 IF ONLY 4 CHARACTERS IN A WORD, OTHERWISE CAN BE SE
-C SET TO 1
- DATA NWF /1/
-C DATA NWF /2/
- DATA IFLOAT(2) /1H /
- DATA IFLOAT /8HG12.5 /
-C IF FORMAT G DOES NOT WORK PROPERLY, USE THE FOLL. FORMAT
-C DATA IFLOAT /8HE12.6 /
-C
-C NOTE
-C ----
-C SEE ALSO ROUTINE ISA
-C-----------------------------------------------------------------------
-C FUNCTION ISI CHECKS IF ITEM IS INTEGER
- ISI(IARG)=ABS(IARG).LE.MAXINT
-C
- DATA IFMT /8H(I5,2H * , 20*1H , 1H)/
- DATA IALPHA /4H,A12/
- DATA INTEGR /4H,I12/
- DATA ICLOSE /1H) /
-C
- WRITE (NTBCD,1) MESSAG
- NEQP=1
-C
- DO 200 N1=1,N,10
- N2=MIN(N1+9,N)
- IPOINT = 3
- EQ=N1.NE.1
-C
- DO 160 JP=N1,N2
- IW=IBUF(JP)
- IF (ISI(IW)) GO TO 110
- IF (ISA(IW)) GO TO 120
-C FLOAT
- IFMT(IPOINT)=IFLOAT(1)
- IFMT(IPOINT+1)=IFLOAT(2)
- IPOINT=IPOINT+NWF
- GO TO 150
-C INTEGER
- 110 IFMT(IPOINT)=INTEGR
- GO TO 140
-C ALPHABETIC
- 120 IFMT(IPOINT)=IALPHA
-C
- 140 IPOINT=IPOINT+1
-C
- 150 IF (EQ) EQ= IBUF(JP-10).EQ.IBUF(JP)
- 160 CONTINUE
-C
- IFMT(IPOINT)=ICLOSE
-C
- IF (EQ) GO TO 200
- IF (NEQP.EQ.N1) GO TO 170
- NEQL=N1-1
- WRITE (NTBCD,2) NEQP,NEQL
-C
- 170 NEQP=N1+10
- WRITE (NTBCD,IFMT) N1,(IBUF(J),J=N1,N2)
-C
- 200 CONTINUE
- IF (EQ) WRITE (NTBCD,2) NEQP,N
- RETURN
-C IBM 360, SDS
-C1 FORMAT('0',40X,3A4)
-C UNIVAC
-C1 FORMAT('0',30X,3I6)
-C CDC
- 1 FORMAT('0',30('-'),1X,3A10)
- 2 FORMAT(61X,I5,' -',I5,3X,'THE SAME')
- END
-#endif
diff --git a/src/mathlib/gen/obsolete/n205/isa.F b/src/mathlib/gen/obsolete/n205/isa.F
deleted file mode 100644
index 139ebc8..0000000
--- a/src/mathlib/gen/obsolete/n205/isa.F
+++ /dev/null
@@ -1,47 +0,0 @@
-*
-* $Id: isa.F,v 1.1.1.1 1996/04/01 15:03:21 mclareni Exp $
-*
-* $Log: isa.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:21 mclareni
-* Mathlib gen
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_gen/pilot.h"
-#if defined(CERNLIB_CDC)
- LOGICAL FUNCTION ISA(IW)
-C TRUE IF WORD ALPHANUMERIC
- DIMENSION IPOSTT (63)
- DIMENSION IA(10)
-C
-C-----------------------------------------------------------------------
-C M A C H I N E D E P E N D E N T V A R I A B L E S
-C -----------------------------------------------------
-C NCARW IS THE NUMBER OF CHARACTERS PER WORD
-C NCARW=10 CDC 6600, NCARW = 4 IBM 360, NCARW = 6 UNIVAC
- DATA NCARW /10/
-C-----------------------------------------------------------------------
-C
- DATA IPOSTT/1H ,1H.,1H+,1H-,1H0,1H1,1H2,1H3,1H4,1H5,
- 1 1H6,1H7,1H8,1H9,1HA,1HB,1HC,1HD,1HE,1HF,
- 2 1HG,1HH,1HI,1HJ,1HK,1HL,1HM,1HN,1HO,1HP,
- 3 1HQ,1HR,1HS,1HT,1HU,1HV,1HW,1HX,1HY,1HZ,
- 4 1H*,1H/,1H(,1H),1H$,1H[,1H,,1H[,1H-,1H ,
- 5 1H ,1H ,1H ,1H ,1H ,1H ,1H ,1H ,1H ,1H ,1H ,1H ,1H /
-C
- CALL UBLOW (IW,IA,NCARW)
-C
- DO 120 J1=1,NCARW
- IAJ1=IA(J1)
- DO 110 J2=1,63
- IF (IPOSTT(J2).EQ.IAJ1) GO TO 120
- 110 CONTINUE
- ISA=.FALSE.
- GO TO 999
-C
- 120 CONTINUE
-C
- ISA=.TRUE.
- 999 RETURN
- END
-#endif
diff --git a/src/mathlib/gen/obsolete/z021/closcom.s b/src/mathlib/gen/obsolete/z021/closcom.s
deleted file mode 100644
index 633e55d..0000000
--- a/src/mathlib/gen/obsolete/z021/closcom.s
+++ /dev/null
@@ -1,162 +0,0 @@
-*
-* $Id: closcom.s,v 1.1.1.1 1996/04/01 15:03:22 mclareni Exp $
-*
-* $Log: closcom.s,v $
-* Revision 1.1.1.1 1996/04/01 15:03:22 mclareni
-* Mathlib gen
-*
-*
- IDENT CLOSCOM
- ENTRY CLOSUN,CLOSNR
-#70C# EQU 0
- SPACE 2
-* FORTRAN CALLABLE ROUTINE TO DO CLOSE,NR OR CLOSE,UNLOAD ON FILE
-* PARAMETER IS LOGICAL FILE NAME OR FORTRAN NUMBER
-* MAY CLOSE SEQUENTIAL OR FORTRAN RANDOM FILES
-CLOSUN. VFD 42/7LCLOSCOM,18/CLOSUN
-SAVE BSS 1
-SAVFIT BSS 1
-MWB BSS 1
-DUMFET BSS 1 DUMMY FET FOR CLOSE CPC
- VFD 60/CLOSUN DUMMY FIRST
- VFD 60/CLOSUN DUMMY IN
- VFD 60/CLOSUN DUMMY OUT
- VFD 60/CLOSUN+65 DUMMY LIMIT
- SPACE 2
-EXIT BSS 0
- SA1 SAVE
- SA0 X1
-CLOSUN EQ $+400000B
- RJ GETLFN SAVE A0 AND GET FIT ADRESS,OC FLAG AND WA
- B1=1
- NZ X2,CLOSCPC IF CLOSED OR NEVER OPENED UNLOAD CPC
- NZ X3,CLOS4 JUMP IF NOT WA
- RJ CLOSN CLOSE RANDOM FILE TO WRITE INDEXS
- SA1 SAVFIT
-* ON MET BT=C POUR EVITER RM354 SUR OPENM SUIVANT
- STORE X1,BT=C
- OPENM X1,I-O,N
-CLOS4 SA1 SAVFIT
- FETCH X1,BAL,X6
- AX6 59
- SA6 MWB MASK A 7777.. SI BAL=1
- SA2 SAVE
- AX2 30 SEULEMENT ADR 2IEME ARG.
- SX7 #U#
- ZR X2,NORET
- SX7 #RET#
-NORET STORE X1,CF=X7
- CLOSEM X1
-* CLEANUP FIT AND FET TO SIMULE NEVER OPENED
- SA1 SAVFIT RESTORE FIT ADRESS
- FETCH X1,BFS,X3 SAVE BUFFER ADRESS
- FETCH X1,FWB,X0
- SX7 B0
- SB2 X1+1 FI
- SB3 X1+35
-LOPUN SA7 B2
- SB2 B2+B1
- LT B2,B3,LOPUN
- SA2 MWB X2=MASK POUR BUFFER
- BX0 -X2*X0 SI BAL=1 PAS DE BUFFER
- BX3 -X2*X3
- STORE X1,FWB=X0
- STORE X1,BFS=X3 STORE BUFFER LENGTH
- STORE X1,LT=ANY
- STORE X1,OF=N
- STORE X1,EO=AD
- STORE X1,CF=N
- SX2 3
- STORE X1,DFC=X2
- MX2 0
- STORE X1,EFC=X2
- EQ EXIT
- SPACE 2
-*
-* FORTRAN CALLABLE ROUTINE TO DO CLOSE NR
-*
-CLOSNR EQ *+400000B
- SA2 CLOSNR
- BX6 X2
- SA6 CLOSUN SAVE RETURN ADRESS
- RJ GETLFN SAVE A0,GET FIT ADRESS,OC FLAG,WA FLAG
- NZ,X2 EXIT IF FILE NOT OPENED RETURN
- RJ CLOSN CLOSE,NR
- SA1 SAVFIT
-* ON MET OC=0 POUR FORCER TRAITEMENT CARTE FILE SUR OPEN SUIVANT
- SA5 X1+17 OC= BIT 57-58 MOT 17
- MX7 2
- LX7 59
- BX7 -X7*X5
- SA7 A5
- SA2 X1+18 ON MET RC=0
- MX0 30
- BX6 X0*X2 POUR EVITER DES BACKSPACES
- SA6 A2 LORS DE L OPEN FORTRAN SUIVANT
- EQ EXIT RETURN
- SPACE 2
-CLOSCPC BSS 0
-* ENTRY WITH X1 = ADD OF FIT
- MX0 42
- SA1 X1 GET FIRST WORD OF FIT FOR LFN
- SX2 1
- BX3 X0*X1 ISOLATE LFN
- BX6 X3+X2 SET COMPLETE BIT
- SA6 DUMFET STORE LFN AND COMPLETE BIT
- CLOSE DUMFET,UNLOAD,RECALL
- EQ EXIT
- SPACE 2
-* ON ENTRY X1 ADRESSWORD WITH LFN OR FORTRAN NUMBER
-* EXIT FIT ADRESS IN X1 AND SAVFIT,A0 IN SAVE
-* OC FLAGS IN X2 AND X3=0 IF WA
-GETLFN BSSZ 1
- SX6 A0
- SB1 1
- B1=1
- SA2 A1+B1 X2= ADR 2IEME ARG.
- SX2 X2 SEULEMENT 18 BITS
- LX2 30
- BX6 X6+X2 ADR + A0
- SA6 SAVE SAVE A0
-#if !defined(CERNLIB_F4)
- MX7 1
- BX1 X7+X1
-#endif
-+RJ=XGETFIT
-- VFD 30/CLOSUN.
- BX6 X1 NEVER OPENED SAVE FIT
- SA6 SAVFIT
- FETCH X1,OC,X2
- SX2 X2-1 X2=0 IF OPENED
- MX4 0
- NZ,X2 GETLFN IF FILE NOT OPENED RETURN
- STORE X1,EX=ERRCL
- STORE X1,DX=X4
- FETCH X1,FO,X3
- SX3 X3-#WA# SET X3 TO 0 IF WA
- EQ GETLFN
- SPACE 2
-* CLOSE,NR FILE IF WA FETCH IF RJ STORED IN CLSLNK. IF SO GO
-* EXECUTE ROUTINE
-CLOSN BSSZ 1
- NZ X2,CLOSN FILE NOT OPENED RETURN
- ZR X3,CLOSN2 JUMP IF RANDOM
-CLOSN1 SA2 SAVE
- AX2 30 SEULEMENT ADR 2IEME ARG.
- SX7 #N#
- ZR X2,NODET
- SX7 #DET#
-NODET STORE X1,CF=X7
- CLOSEM X1
- EQ CLOSN
-CLOSN2 SA2 CLOSN3
- LX2 12
- NG X2,CLOSN1
-CLOSN3 RJ =YCLOS.RI
-- VFD 30/CLOSUN.
- EQ CLOSN
- SPACE 2
-ERRCL BSSZ 1
- RJ =XIOERR.
-- VFD 30/CLOSUN.
- END
diff --git a/src/mathlib/gen/obsolete/z021/fileman.s b/src/mathlib/gen/obsolete/z021/fileman.s
deleted file mode 100644
index 730307b..0000000
--- a/src/mathlib/gen/obsolete/z021/fileman.s
+++ /dev/null
@@ -1,367 +0,0 @@
-*
-* $Id: fileman.s,v 1.1.1.1 1996/04/01 15:03:22 mclareni Exp $
-*
-* $Log: fileman.s,v $
-* Revision 1.1.1.1 1996/04/01 15:03:22 mclareni
-* Mathlib gen
-*
-*
- IDENT FILEMAN
- SYSCOM
- IPARAMS
- SST
- TITLE P.F. / FORTRAN FTN FUNCTIONS....
- ENTFUNC MACRO NAM
- SPACE 3
- ENTRY NAM
- X_NAM VFD 42/0L_NAM,18/NAM
- NAM JP *+400000B
- SA2 X_NAM
- BX6 X2
- SX7 A0
- SA6 NAME
- SA7 TEMPA0
- ENDM
-* PF PARAMETER IN PFUNC : PP USED BY THE ACTION : NAM TO DO EFFECTIVE
-* THE REQUEST POSTED IN RA +1 (ONLY THIRD CHARACTER USED IN PF ;
-* SEE ARGPF LOCATION )
- PFUNC MACRO P1,NAM,COD,PF
- PP MICRO 3,1,*_PF*
- ENTFUNC NAM
- RJ PAKARG
- RJ P1
- SX2 1R"PP"
- SX3 COD
- RJ POST REQUEST IN RA+1
- RJ RAZTAB
- SA1 TEMPA0
- SA0 X1
- EQ NAM
- ENDM
- ENTKEY MACRO KEY,CODKEY
- KY MICRO 1,2,*_KEY*
- ENTRY KEY
- KEY DATA 0
- SX2 CODKEY
- SB6 "KY"AD
- SB7 KEY
- EQ LOAD
- ENDM
- PFUNC STORLFN,PURGEF,40B,PFP
- PFUNC CLONR,CATLGF,20B,PFC
- PFUNC STORLFN,ATTACHF,10B,PFA
- PFUNC CLONR,EXTENDF,30B,PFE
- PFUNC CLONR,ALTERF,34B,PFE
- PFUNC STORLFN,RENAMEF,50B,PFR
- ENTFUNC RETURNF
- SA0 A1
- RJ STORLFN
- SA1 A0
-+RJ=XCLOSUN
-- VFD 30/NAME
- SA1 RETAD
- ZR X1,RET2
- SX7 B0
- SA7 X1
- EQ RET3
- RET2 SX1 ADMSRT
- RJ MESG
- RET3 RJ RAZTAB
- SA1 TEMPA0
- SA0 X1
- EQ RETURNF
-CLONR BSSZ 1
- SA0 A1
- RJ STORLFN
- SA1 A0
-+RJ=XCLOSNR
-- VFD 30/NAME
- SA1 TEMPA0
- SA0 X1
- EQ CLONR
- ENTFUNC DEVICE
-#if !defined(CERNLIB_F4)
- MX7 1
- BX1 X7+X1
-#endif
- RJ =XGETFIT.
- LT B0,B0,NAME
- SA2 X1
- MX0 42
- BX6 X0*X2
- SX7 A2
- SA6 REQPR
- SA7 LFNAD
- SPACE 1
-*---- LA ROUTINE XXREQF SE TROUVE DANS LE DECK REQQ
- RJ =XXXREQF
- SPACE 1
- SX6 B0
- SB1 REQPR
- SA6 SNAD REMISE A ZERO DE SN DANS FDB
- SB2 REQPR+8
-RAZREQ SA6 B1 REMISE A ZERO DE LA TABLE DE REQUEST
- SB1 B1+1
- GE,B2,B1 RAZREQ
- SA2 RETCOD RETURN CODE
- BX6 X2
- SA1 RETAD
- ZR X1,DEVC2
- SA6 X1
- EQ DEVICE
-DEVC2 ZR,X6 DEVICE
- MESSAGE REQABT,,RECALL
- ABORT
- REQABT DIS ,*INVALID REQ.PARAMS(DEVICE)*
- ENTRY DEVTYP
- DEVTYP DATA 0
- SA4 STAR
- SA1 X1
- LX1 48
- SX3 X1-1R*
- ZR X3,DEV1
- SX4 B0
- DEV1 MX0 12
- BX2 X1*X0
- SB2 DEVTAB
- NXTYP SA1 B2
- ZR X1,DEVTYP
- BX5 X1*X0
- IX3 X2-X5
- ZR X3,DEV2
- SB2 B2+1
- EQ NXTYP
- DEV2 BX4 X1+X4
- BX6 -X0*X4
- SA5 REQPR+1
- BX6 X6+X5
- SA6 A5
- EQ DEVTYP
-DEVTAB VFD 12/2CPF,24/600B OV BIT + PF BIT
- VFD 6/4,18/0 RC BIT
- VFD 12/2CA*,48/0
- VFD 60/0
- STAR VFD 12/0,24/20B,24/0
- ENTRY SN
-SN EQ *+1S17
- SA4 REQPR+1
- MX6 1 SET SN BIT :
- LX6 18 - BIT 17 (FIRST BIT=0) OF REQPR+1
- BX6 X6+X4
- SA6 A4
- SA1 X1
- MX0 42
- BX6 X1*X0
- SX5 40B
- BX7 X6+X5
- SA6 REQPR+3 SETNAME LEFT JUSTIFIED IN REQPR+3
- SA7 SNAD SETNAME IN SNAD (FDB)
- EQ SN
- ENTRY PW
- PW DATA 0
- SB1 B0
- SB2 4
- SX2 20B
- MX0 54
- TURN SA3 A1+B1
- ZR X3,PW END OF ARGUMENT LIST
- SA3 X3 X3=PW ARGUMT.
- ZR X3,TURN
- SX4 X2+B1
- LX3 6
- BX6 X0*X3 CLEAR ARGUMT. LOWER
- IX7 X6+X4 SET PW CODE
- SA7 B1+PWAD STORE
- SB1 B1+1
- LE B1,B2,TURN
- EQ PW
- ENTRY RC
- RC DATA 0
- SX7 X1
- SA7 RETAD
- EQ RC
-*
-* TRAITEMENT DE REAL TIME REQUEST RT(IRET)
-*
- ENTRY RT
- RT DATA 0
- SX6 1
- SA6 RTMAD
- RJ RC
- EQ RT
- ENTKEY RP,02B
- ENTKEY CY,03B
- ENTKEY TK,04B
- ENTKEY CN,05B
- ENTKEY MD,06B
- ENTKEY EX,07B
- ENTKEY RD,10B
- ENTKEY MR,11B
- ENTKEY XR,13B
- ENTKEY ID,14B
- ENTKEY LC,31B
- ENTKEY ST,32B
- ENTKEY RW,33B
- ENTKEY RB,43B
- ENTKEY UV,53B
- LOAD BSS 0
- SA1 X1
- MX0 54
- LX1 6
- BX6 X1*X0
- BX6 X6+X2
- SA6 B6
- LDEXIT JP B7
- STORLFN DATA 0
-#if !defined(CERNLIB_F4)
- MX7 1
- BX1 X7+X1
-#endif
- + RJ =XGETFIT.
- - LT B0,B0,NAME
- SA2 X1
- MX0 42
- BX6 X0*X2
- SX7 A2
- SA6 LFNFDB
- SA7 LFNAD
- EQ STORLFN
- ARGPF VFD 18/2LPF,2/1,40/0
- POST DATA 0
- SA1 ARGPF
- LX2 42
- BX2 X2+X1
- MX0 52
- SA1 LFNFDB
- BX6 X0*X1
- SX5 A1
- SA4 RTMAD
- ZR X4,POST1
- SX1 200B
- EQ POST2
- POST1 SA4 RETAD
- NZ X4,WRC
- SX1 100B
- POST2 IX3 X3+X1
- WRC IX7 X3+X6
- BX6 X5+X2
- SA7 A1
- RJ =XSYS=
- SA2 RETAD
- ZR X2,POST
- SA3 LFNFDB
- MX0 51
- AX3 9
- BX6 -X0*X3
- SA6 X2
- EQ POST
- RAZTAB DATA 0
- SX7 B0
- SA7 REQPR+3 CLEAR SETNAME IN REQUEST TABLE
- SA7 A7-2 CLEAR SN BIT IN REQPR+1
- SB1 PFNAD
- SB2 ADZERO
- SA7 RCY
-RAZ SA1 B1
- MX0 54
- BX6 -X0*X1
- SB3 X6-03
- NE B3,B0,NOCYW
- BX6 X1
- SA6 RCY
-NOCYW SA7 B1
- SB1 B1+1
- LE B1,B2,RAZ
- SA7 RTMAD
- SA7 A7+1
- EQ RAZTAB
- PAKARG DATA 0
- SB6 1
- SA2 A1+B6
- SB5 B0
- MX7 0
- ZR X2,PACK
- SB2 X2
- SB5 B0
- SB4 3
- SX5 77B
- STORPFN SA2 B2+B5
- SB3 B0
- SX7 B0
- SX0 77B
- NXTCHAR LX0 54
- SB3 B3+6
- BX6 X0*X2
- ZR X6,PACK
- BX7 X7+X6
- IX4 X0-X5
- NZ X4,NXTCHAR
- NXTWRD SA7 B5+PFNAD
- SB5 B5+B6
- LE B5,B4,STORPFN
- EQ PACK2
- PACK SA7 B5+PFNAD
- PACK2 SB4 ADZERO
- MX0 54
- SB3 NULAD
- SB2 PPAD
- SX7 B0
- BCLPAC SA4 B2
- ZR X4,SUIT
- BX6 X4
- SA6 B3
- SA7 A4
- SB3 B3+B6
- SUIT SB2 B2+B6
- LT B2,B4,BCLPAC
- EQ PAKARG
- MESG DATA 0
- SA2 LFNAD
- MX0 42
- SA2 X2 X2 = LFN
- BX6 X0*X2 CLEAR LFN LOWER 18 BITS
- SA6 X1+2 STORE LFN IN MESSAGE
- MX6 1
- LX6 23D
- + RJ =XMSG=
- - LT B0,B0,NAME
- EQ MESG
- ADMSRT DIS 2,FILE RETURNED,LFN =
- FILERT DIS 1,
- USE /REQPR/
-REQPR BSSZ 9 REQUEST TABLE
-RETCOD BSSZ 1
- USE *
- PFNAD BSSZ 4
- LFNFDB BSSZ 1 FDB
- NULAD BSSZ 1
- PPAD BSSZ 1
- RPAD BSSZ 1
- CYAD BSSZ 1
- TKAD BSSZ 1
- CNAD BSSZ 1
- MDAD BSSZ 1
- EXAD BSSZ 1
- SDAD BSSZ 1
- IDAD BSSZ 1
- RDAD BSSZ 1
- MRAD DATA 0
- RNAD DATA 0
-XRAD BSSZ 1
-LCAD BSSZ 1
-STAD BSSZ 1
-RWAD BSSZ 1
- PWAD BSSZ 5
-RBAD BSSZ 1
-UVAD BSSZ 1
-SNAD BSSZ 1
- ADZERO DATA 0
- RTMAD BSSZ 1
- RETAD DATA 0
- LFNAD DATA 0
- TEMPA0 BSS 1
- NAME DATA 0
- USE /FILEM./
-RCY BSSZ 1
- USE *
- END
diff --git a/src/mathlib/gen/obsolete/z021/getfnb.s b/src/mathlib/gen/obsolete/z021/getfnb.s
deleted file mode 100644
index 3e23f44..0000000
--- a/src/mathlib/gen/obsolete/z021/getfnb.s
+++ /dev/null
@@ -1,37 +0,0 @@
-*
-* $Id: getfnb.s,v 1.1.1.1 1996/04/01 15:03:22 mclareni Exp $
-*
-* $Log: getfnb.s,v $
-* Revision 1.1.1.1 1996/04/01 15:03:22 mclareni
-* Mathlib gen
-*
-*
- IDENT GETFNB
-* FORTRAN CALLABLE SUBROUTINE TO GET FIT ADRESS
-* THIS IS ROUTINE GETFIT FROM CNESLIB WITH NAME CHANGE FOR SAFETY
-* SUBROUTINE GETFNB(LFN,ARRAY,INDEX)
-* LFN FILE NAME OR FORTRAN NUMBER
-* ARRAY AN ARRAY DECLARED IN CALLING ROUTINE
-* INDEX IS SET BY GETFIT SO THAT ARRAY(INDEX) IS FIT FIRST WORD
-* FORTRAN ERROR IF FIT NOT FOUND
- ENTRY GETFNB
-GETFITX VFD 42/6LGETFNB,18/GETFNB
-TEMPA0 BSS 1
-GETFNB EQ *+400000B
- SX6 A0
- SB2 A1 SAVE PARZMETER LIST ADRESS
- SB1 1 GETFNB. DOES NOT USE B REGISTERS
- SA6 TEMPA0
-#if !defined(CERNLIB_F4)
- MX7 1
- BX1 X7+X1
-#endif
-+RJ=XGETFIT
-- VFD 30/GETFITX TRACE
- SA2 B2+B1 X2 ARRAY(1) ADRESS
- SX1 X1+B1 ADD 1 TO FIT ADRESS
- SA3 A2+B1 X3 INDEX ADRESS
- IX6 X1-X2
- SA6 X3 WRITE INDEX
- EQ GETFNB
- END
diff --git a/src/mathlib/gen/obsolete/z021/pfnbb.F b/src/mathlib/gen/obsolete/z021/pfnbb.F
deleted file mode 100644
index 92f5468..0000000
--- a/src/mathlib/gen/obsolete/z021/pfnbb.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: pfnbb.F,v 1.1.1.1 1996/04/01 15:03:22 mclareni Exp $
-*
-* $Log: pfnbb.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:22 mclareni
-* Mathlib gen
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_gen/pilot.h"
- SUBROUTINE PFNBB(IPAR,LPAR)
-C
-C THIS IS ROUTINE BLANK FROM CNESLIB WITH NAME CHANGE FOR SAFETY
-C REMPLACE ZEROS BINAIRES PAR BLANCS
-C
- LPAR=IPAR
- DO 100 I=1,10
-#if !defined(CERNLIB_F4)
- IF ((LPAR.AND.O"77").EQ.0) LPAR=LPAR.OR.R" "
-#endif
-#if defined(CERNLIB_F4)
- IF ((LPAR.AND.77B).EQ.0) LPAR=LPAR.OR.1R
-#endif
- 100 LPAR=SHIFT(LPAR,6)
- RETURN
- END
diff --git a/src/mathlib/gen/obsolete/z021/reqq.F b/src/mathlib/gen/obsolete/z021/reqq.F
deleted file mode 100644
index 2a82bce..0000000
--- a/src/mathlib/gen/obsolete/z021/reqq.F
+++ /dev/null
@@ -1,65 +0,0 @@
-*
-* $Id: reqq.F,v 1.1.1.1 1996/04/01 15:03:22 mclareni Exp $
-*
-* $Log: reqq.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:22 mclareni
-* Mathlib gen
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_gen/pilot.h"
- SUBROUTINE REQQ(ILFN,RC)
-*
-***** CETTE ROUTINE PERMET D AFFECTER LE FICHIER LFN (N OU TAPEN)
-* SUR LE DEVICE Q. ELLE CONSTRUIT LA TABLE DE REQUETE CONTENUE DANS
-* LE COMMUN REQPR DONT LE DERNIER MOT ER REPRESENTE LE CODE DE
-* RETOUR DE LA MACRO REQUEST ET FAIT APPEL A LA ROUTINE XXREQF.
-* SI AU RETOUR DE XXREQF ,ER N EST PAS NUL ET SI L APPEL DE REQQ NE
-* COMPORTE PAS DE CODE DE RETOUR (ADRRC = 0) , UN MESSAGE D ERREUR
-* EST IMPRIME DANS LA DAYFILE PAR L INTERMEDIAIRE DE XDISMES ET LE
-* JOB EST AVORTE.
-*
- IMPLICIT INTEGER (A-Z)
-*
- DIMENSION FIT(1)
- COMMON /REQPR/ REQPR(9),ER
-*
-***** QWORD : QBIT + OV BIT + RC BIT
-*
-#if !defined(CERNLIB_F4)
- DATA QWORD /O"02000000040004000000"/
-#endif
-#if defined(CERNLIB_F4)
- DATA QWORD /02000000040004000000B/
-#endif
-*
-*.
- LFN=ILFN
- CALL GETFNB(LFN,FIT,IFIT)
- LFN=FIT(IFIT).AND.MASK(42)
- REQPR(1)=LFN
- REQPR(2)=QWORD
-*
- CALL XXREQF
-*
- ADRRC=LOCF(RC)
- IF(ADRRC.EQ.0) GO TO 1
- RC=ER
-*....
-*... REMISE A ZERO DU COMMUN REQPR ET RETURN
-*...
-2 CONTINUE
- DO 100 I=1,9
- REQPR(I)=0
-100 CONTINUE
- ER=0
- RETURN
-*....
-1 IF(ER.EQ.0) GO TO 2
-#if !defined(CERNLIB_F4)
- CALL XDISMES(LFN,ER,L"REQQ")
-#endif
-#if defined(CERNLIB_F4)
- CALL XDISMES(LFN,ER,4LREQQ)
-#endif
- END
diff --git a/src/mathlib/gen/obsolete/z021/wait.s b/src/mathlib/gen/obsolete/z021/wait.s
deleted file mode 100644
index 04d2b31..0000000
--- a/src/mathlib/gen/obsolete/z021/wait.s
+++ /dev/null
@@ -1,68 +0,0 @@
-*
-* $Id: wait.s,v 1.1.1.1 1996/04/01 15:03:22 mclareni Exp $
-*
-* $Log: wait.s,v $
-* Revision 1.1.1.1 1996/04/01 15:03:22 mclareni
-* Mathlib gen
-*
-*
- IDENT WAIT
- ENTRY WAIT
-*...
-*... CE SOUS PROGRAMME PERMET D ATTENDRE
-*... "N" SECONDES.
-*...
-*... "N" EST LIMITE A 15 SECONDES
-*...
-*... SI N=0 IL N Y A PAS D ATTENTE ..............
-*...
-*...
-*... CALL WAIT(N)
-*... OU
-*... SX1 ADDRESSE DU TEMPS "N"
-*... RJ =XWAIT
-*...
-TRACE VFD 42/4LWAIT,18/WAIT
-SAVA0 BSS 1
-WAIT EQ *+1S17
- SX6 A0
- SA1 X1
- SA6 SAVA0
- ZR,X1 WAIT RETURN SI TEMPS NUL
-*... B2=TEMPS A ATTENDRE
- SB2 X1
-*...
-*... ON LIMITE LE TEMPS D ATTENTE A 15 SECONDES
-*...
- SB4 15 TEMPS MAXIMUN D ATTENTE
- LE B2,B4,NOLIMIT SI TEMP SUP A 15,ALORS TEMP=15
- SB2 B4
-NOLIMIT BSS 0
-*...
- RJ TEMP
-*... ON CALCUL LE TEMPS DE FIN D ATTENTE
- SB2 B3+B2
-LOOPP BSS 0
-*... ON ATTEND ENVIRON 1 DEMI SECONDE
- SB3 20
-LOOP BSS 0
- RECALL ATTENTE DE 25MS
- SB3 B3-1
- GT B3,B0,LOOP
- RJ TEMP
- SB3 B2-B3
- GT B3,B0,LOOPP TEMPS D ATTENTE PAS ENCORE ECOULE
- SA1 SAVA0
- SA0 X1
- EQ WAIT
- SPACE 2
-TABTIM BSS 1
-TEMP EQ *+1S17
- RTIME TABTIM
- SA2 TABTIM
- MX0 36
- AX2 12
- BX1 -X0*X2
- SB3 X1
- EQ TEMP
- END
diff --git a/src/mathlib/gen/obsolete/z021/xdismes.F b/src/mathlib/gen/obsolete/z021/xdismes.F
deleted file mode 100644
index be2c163..0000000
--- a/src/mathlib/gen/obsolete/z021/xdismes.F
+++ /dev/null
@@ -1,71 +0,0 @@
-*
-* $Id: xdismes.F,v 1.1.1.1 1996/04/01 15:03:22 mclareni Exp $
-*
-* $Log: xdismes.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:22 mclareni
-* Mathlib gen
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_gen/pilot.h"
- SUBROUTINE XDISMES(LFN,RC,ROUTINE)
-*
-***** ROUTINE APPELEE PAR XROUTE OU REQQ LORSQUE IL Y A ERREUR
-* ET QUE L APPEL DE CES ROUTINES S EST FAIT SANS ARGUMENT
-* DE CODE DE RETOUR
-*
-***** SOUS-PROGRAMME UTILISE PAR ' ROUTINE ' LORS D UNE ERREUR D ACTION
-* SUR LE FICHIER LFN ET LORSQUE AUCUN ARGUMENT DE CODE DE RETOUR
-* NE FIGURE DANS L APPEL DE ' ROUTINE '
-* LE MESSAGE * ERROR ROUTINE NO XXB ON LFN LFN * EST ENVOYE
-* SUR LA DAYFILE ET LE JOB EST AVORTE
-*
- IMPLICIT INTEGER(A-Z)
- DIMENSION MESSAGE(8)
-#if !defined(CERNLIB_F4)
- DATA MESSAGE(1) /O"55554747474747474755"/
- DATA MESSAGE(2) /O"05222217225500000000"/
- DATA MESSAGE(3) /O"00000055161755545500"/
- DATA MESSAGE(4) /O"00025547474747474747"/
- DATA MESSAGE(5) /O"55555555474747474755"/
- DATA MESSAGE(6) /O"55555517165514061655"/
- DATA MESSAGE(7) /O"54550000000000000055"/
- DATA MESSAGE(8) /O"55555547474747475555"/
- IMASK=.NOT.MASK(57)
- ZON1=SHIFT(((RC.AND.IMASK)+O"33"),54)
-#endif
-#if defined(CERNLIB_F4)
- DATA MESSAGE(1) /55554747474747474755B/
- DATA MESSAGE(2) /05222217225500000000B/
- DATA MESSAGE(3) /00000055161755545500B/
- DATA MESSAGE(4) /00025547474747474747B/
- DATA MESSAGE(5) /55555555474747474755B/
- DATA MESSAGE(6) /55555517165514061655B/
- DATA MESSAGE(7) /54550000000000000055B/
- DATA MESSAGE(8) /55555547474747475555B/
- IMASK=.NOT.MASK(57)
- ZON1=SHIFT(((RC.AND.IMASK)+33B),54)
-#endif
- IMASK=SHIFT(IMASK,3)
- ZON2=SHIFT((RC.AND.IMASK),57)
- IF(ZON2.NE.0) GO TO 5
-#if !defined(CERNLIB_F4)
- ZON2=O"55"
- GO TO 6
-5 ZON2=ZON2+O"33"
-#endif
-#if defined(CERNLIB_F4)
- ZON2=55B
- GO TO 6
-5 ZON2=ZON2+33B
-#endif
-6 CALL PFNBB(LFN,LFN)
- CALL PFNBB(ROUTINE,ROUTINE)
- MESSAGE(2)=MESSAGE(2).OR.SHIFT((ROUTINE.AND.MASK(24)),24)
- MESSAGE(3)=MESSAGE(3).OR.(SHIFT(ROUTINE,24).AND.MASK(18)).OR.ZON2
- MESSAGE(4)=MESSAGE(4).OR.ZON1
- MESSAGE(7)=MESSAGE(7).OR.SHIFT((LFN.AND.MASK(42)),48)
- CALL REMARK(MESSAGE)
- CALL SYSTEM(52," ABORT ")
- RETURN
- END
diff --git a/src/mathlib/gen/obsolete/z021/xgetcy.s b/src/mathlib/gen/obsolete/z021/xgetcy.s
deleted file mode 100644
index 34faf7a..0000000
--- a/src/mathlib/gen/obsolete/z021/xgetcy.s
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: xgetcy.s,v 1.1.1.1 1996/04/01 15:03:22 mclareni Exp $
-*
-* $Log: xgetcy.s,v $
-* Revision 1.1.1.1 1996/04/01 15:03:22 mclareni
-* Mathlib gen
-*
-*
- IDENT XGETCY
- ENTRY XGETCY
- SYSCOM
- IPARAMS
- SST
-* S-P PERMETTANT DE RECUPERER LE NUMERO DE CYCLE REEL
-* IL DOIT ETRE APPELE AUSSITOT APRES UN
-* ATTACH OU CATALOG AVEC L OPTION CY
-* CALL XGETCY(ICY)
-* ICY= NUMERO DU CYCLE EN SORTIE (ENTIER)
-*
- USE /FILEM./
-RCY BSS 1
- USE *
-*
-FINISH SA6 X1
-XGETCY BSS 1
- MX6 0
- SA2 RCY
- MX0 42
- BX3 X0*X2 ON NE PREND QUE PARTIE GAUCHE
- NZ X3,FINISH SI PARTIE GAUCHE "0 C EST PAS CY
- AX2 6
- BX6 -X0*X2
- EQ FINISH
- END
diff --git a/src/mathlib/gen/obsolete/z021/xxreqc.s b/src/mathlib/gen/obsolete/z021/xxreqc.s
deleted file mode 100644
index 3719e5c..0000000
--- a/src/mathlib/gen/obsolete/z021/xxreqc.s
+++ /dev/null
@@ -1,37 +0,0 @@
-*
-* $Id: xxreqc.s,v 1.1.1.1 1996/04/01 15:03:22 mclareni Exp $
-*
-* $Log: xxreqc.s,v $
-* Revision 1.1.1.1 1996/04/01 15:03:22 mclareni
-* Mathlib gen
-*
-*
- IDENT XXREQC
- SPACE 1
- ENTRY XXREQC
- SPACE 4
-TRACE VFD 42/6LXXREQC,18/XXREQC
-SAVEA0 BSSZ 1
- SPACE 1
- USE /XREQTAG/
-XREQTAG BSSZ 10
- USE *
- SPACE 1
-EXIT SA1 SAVEA0
- SA0 X1
- SPACE 1
-XXREQC EQ *+1S17
- SPACE 1
- SX6 A0 SAVE A0
- SA6 SAVEA0
- SPACE 1
- REQUEST XREQTAG
- SPACE 1
- SA2 XREQTAG
- MX0 55
- AX2 9
- BX6 -X0*X2
- SA6 XREQTAG+9
- SPACE 1
- EQ EXIT
- END
diff --git a/src/mathlib/gen/obsolete/z021/xxreqf.F b/src/mathlib/gen/obsolete/z021/xxreqf.F
deleted file mode 100644
index 56328c1..0000000
--- a/src/mathlib/gen/obsolete/z021/xxreqf.F
+++ /dev/null
@@ -1,42 +0,0 @@
-*
-* $Id: xxreqf.F,v 1.1.1.1 1996/04/01 15:03:22 mclareni Exp $
-*
-* $Log: xxreqf.F,v $
-* Revision 1.1.1.1 1996/04/01 15:03:22 mclareni
-* Mathlib gen
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_gen/pilot.h"
- SUBROUTINE XXREQF
-*
-***** SOUS-PROGRAMME APPELE PAR REQQ ,FILLEMAN ET REQTAPE
-*
-***** CETTE ROUTINE COPIE LA TABLE TAB CONTENUE DANS LE COMMUN
-* REQPR SUR LA TABLE TAG UTILISEE DANS XXREQC.
-* SI LE CODE DE RETOUR IER VAUT 24B ( FNT SPACE CRITICAL ) ,
-* XXREQF SWAPPE LE JOB PENDANT 10 SEC ET RECOMMENCE LA SEQUENCE
-* PRECEDENTE JUSQU A CE QUE IER SOIT DIFFERENT DE 24B SINON
-* ELLE RECOPIE TAG SUR TAB ET IER SUR RC
-*
- IMPLICIT INTEGER(A-Z)
- COMMON /REQPR/ TAB(9),RC
- COMMON /XREQTAG/ TAG(9),IER
-1 DO 3 I=1,9
- TAG(I)=TAB(I)
-3 CONTINUE
- CALL XXREQC
-#if !defined(CERNLIB_F4)
- IF (IER.NE.O"24") GO TO 2
-#endif
-#if defined(CERNLIB_F4)
- IF (IER.NE.24B) GO TO 2
-#endif
- CALL WAIT(10)
- GO TO 1
-2 RC=IER
- DO 4 I=1,9
- TAB(I)=TAG(I)
-4 CONTINUE
- RETURN
- END
diff --git a/src/mathlib/gen/s/Imakefile b/src/mathlib/gen/s/Imakefile
deleted file mode 100644
index 46b093e..0000000
--- a/src/mathlib/gen/s/Imakefile
+++ /dev/null
@@ -1,9 +0,0 @@
-SRCS_F= gent.F
-
-FORTRANSAVEOPTION = FortranSaveFlags
-
-#if defined(CERNLIB_SGI)
-IMAKE_DEFINES=-DFortranDoesCpp=NO
-#endif
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/mathlib/gen/s/gent.F b/src/mathlib/gen/s/gent.F
deleted file mode 100644
index c88347a..0000000
--- a/src/mathlib/gen/s/gent.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: gent.F,v 1.2 1996/04/15 10:02:56 mclareni Exp $
-*
-* $Log: gent.F,v $
-* Revision 1.2 1996/04/15 10:02:56 mclareni
-* Change format statement to compile also on OSF, and add a date
-*
-* Revision 1.1.1.1 1996/04/01 15:02:53 mclareni
-* Mathlib gen
-*
-*
- SUBROUTINE GENT ( LUN)
-C.
-C.
-C. ******************************************************************
-C. * *
-C. * *
-C. * PRINT PAM TITLE ON LUN *
-C. * *
-C. * *
-C. ******************************************************************
-C.
- WRITE (LUN,1000)
- RETURN
- 1000 FORMAT(' GENT COMPILED FROM PAM FILE= ',
- + ' GEN 1.48/00 150496' ,
- +/)
- END
diff --git a/src/mathlib/gen/tests/Imakefile b/src/mathlib/gen/tests/Imakefile
deleted file mode 100644
index 424741a..0000000
--- a/src/mathlib/gen/tests/Imakefile
+++ /dev/null
@@ -1,69 +0,0 @@
-DoIncludePackage(gen)
-#include "pilot.h"
-
-SRCS_F= b100m.F b101m.F b102m.F b300m.F blkdt.F c200m.F \ @@\
- c201m.F c201s.F c202m.F c206m.F c206s1.F c207m.F c208m.F \ @@\
- c209m.F c209s.F c210m.F c300m.F c301m.F c302m.F \ @@\
- c303m.F c304m.F c306m.F c307m.F c310m.F c312m.F \ @@\
- c313m.F c315m.F c316m.F c318m.F c320m.F c321m.F \ @@\
- c322m.F c323m.F c324m.F c326m.F c327m.F c328m.F c330m.F c331m.F \ @@\
- c333m.F c334m.F c335m.F c336m.F c337m.F c338m.F c339m.F \ @@\
- c340m.F c342m.F c343d.F c343m.F c343s.F \ @@\
- c345m.F c346m.F c347m.F c348m.F c349m.F d101m.F \ @@\
- d103m.F d104m.F d105m.F d105s1.F d105s2.F d105s3.F \ @@\
- d107m.F d108m.F d110m.F d110s1.F d110s2.F d110s3.F d110s4.F \ @@\
- d110s5.F d110s6.F d110s7.F d110s8.F d113m.F d115f1.F d115f2.F \ @@\
- d115f3.F d115m.F d200m.F d201m.F d202m.F d203m.F d401m.F \ @@\
- d503m.F d510m.F d601m.F d705m.F d706m.F \ @@\
- e211m.F e406f1.F e406f2.F e406f3.F \ @@\
- e406f4.F e406m.F e407m.F e408m.F f106m.F f106s1.F f106s2.F \ @@\
- f500m.F fc346.F funct.F g100m.F g101m.F g102m.F g104m.F \ @@\
- g105m.F g106m.F g110m.F g115m.F g116m.F gtopen.F h101m.F \ @@\
- h301m.F header.F itest.F pagend.F rc346.F u501m.F \ @@\
- v100m.F v101m.F v106m.F v110m.F v135m.F v136m.F v137m.F \ @@\
- v138m.F v152m.F v202m.F v700m.F vecdraw.F
-
-#if !defined(CERNLIB_DOUBLE)
-SRCS_F:= $(SRCS_F) c344m.F c344q.F
-#endif
-
-#if defined(CERNLIB_QUAD) && !defined(CERNLIB_IBMRT)
-SRCS_F:= $(SRCS_F) d103q.F
-#endif
-
-#if defined(CERNLIB_QUAD) && defined(CERNLIB_DOUBLE)
-SRCS_F:= $(SRCS_F) c343q.F
-#endif
-
-#if defined(CERNLIB_QUAD)
-SRCS_F:= $(SRCS_F) c302q.F c310q.F
-#endif
-
-EXTRA_DEFINES=-DCERNLIB_TESTALL
-
-#ifdef CERNLIB_HPUX
-FORTRANOPTIONS += -WF,-P
-#endif
-
-#if defined(CERNLIB_LNX)
-SpecialFortranLibObjectRule(v700m,v700m,-O0,NullParameter)
-#endif
-
-#if defined(CERNLIB_IBMRT)
-SpecialFortranLibObjectRule(d601m,d601m,NullParameter,NullParameter)
-#endif
-
-#if defined(CERNLIB_SGI)
-IMAKE_DEFINES=-DFortranDoesCpp=NO
-#endif
-
-FORTRANSAVEOPTION = FortranSaveFlags
-
-SubdirLibraryTarget(gentest,NullParameter)
-
-DefinePackageLibrary(gentest)
-
-CernlibFortranProgramTarget(gent,main.o,$(PACKAGE_LIB),$(PACKAGE_LIB),kernlib)
-
-
-TestTarget(gent,NullParameter,NullParameter)
diff --git a/src/mathlib/gen/tests/b100m.F b/src/mathlib/gen/tests/b100m.F
deleted file mode 100644
index f2e5d43..0000000
--- a/src/mathlib/gen/tests/b100m.F
+++ /dev/null
@@ -1,192 +0,0 @@
-*
-* $Id: b100m.F,v 1.1.1.1 1996/04/01 15:01:12 mclareni Exp $
-*
-* $Log: b100m.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:12 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE B100M
-C Routine to test MATHLIB routines KBINOM, BINOM and DBINOM (B100)
-C Note KBINOM is only called for integer values of the parameter
-#include "imp64r.inc"
- REAL BINOM
-C Set the total number of tests
- PARAMETER ( NT=54 )
-C Specify the largest error allowed for a successful test
- PARAMETER ( TSTERR=1D-15 )
- PARAMETER (RTSTERR=1D-6 )
- INTEGER KBINOM
- DIMENSION KEX1(NT),EX2(NT),REX3(NT),EX4(NT),REX5(NT)
- PARAMETER (Z1 = 1, Z2 = 2, HALF = Z1/2)
-
-#include "iorc.inc"
-C Analytical values expected to be obtained
- DATA (KEX1(J),EX2(J),REX3(J),EX4(J),REX5(J),J=1,10)
- 1 / 0, 0.0, 0.0, 0.000000000000000000D+00, 0.000000000E+00,
- 2 1, 1.0, 1.0, 0.100000000000000000D+01, 0.100000000E+01,
- 3 -8, -8.0, -8.0,-0.750000000000000000D+01,-0.750000000E+01,
- 4 36, 36.0, 36.0, 0.318750000000000000D+02, 0.318750000E+02,
- 5 -120,-120.0,-120.0,-0.100937499999999993D+03,-0.100937500E+03,
- 6 330, 330.0, 330.0, 0.264960937499999943D+03, 0.264960937E+03,
- 7 0, 0.0, 0.0, 0.000000000000000000D+00, 0.000000000E+00,
- 8 1, 1.0, 1.0, 0.100000000000000000D+01, 0.100000000E+01,
- 9 -6, -6.0, -6.0,-0.550000000000000000D+01,-0.550000000E+01,
- + 21, 21.0, 21.0, 0.178750000000000000D+02, 0.178750000E+02/
- DATA (KEX1(J),EX2(J),REX3(J),EX4(J),REX5(J),J=11,20)
- + /-56, -56.0, -56.0,-0.446875000000000000D+02,-0.446875000E+02,
- + 126, 126.0, 126.0, 0.949609375000000000D+02, 0.949609375E+02,
- + 0, 0.0, 0.0, 0.000000000000000000D+00, 0.000000000E+00,
- + 1, 1.0, 1.0, 0.100000000000000000D+01, 0.100000000E+01,
- + -4, -4.0, -4.0,-0.350000000000000000D+01,-0.350000000E+01,
- + 10, 10.0, 10.0, 0.787500000000000000D+01, 0.787500000E+01,
- + -20, -20.0, -20.0,-0.144374999999999993D+02,-0.144375000E+02,
- + 35, 35.0, 35.0, 0.234609374999999964D+02, 0.234609375E+02,
- + 0, 0.0, 0.0, 0.000000000000000000D+00, 0.000000000E+00,
- + 1, 1.0, 1.0, 0.100000000000000000D+01, 0.100000000E+01/
- DATA (KEX1(J),EX2(J),REX3(J),EX4(J),REX5(J),J=21,30)
- 1 /-2, -2.0, -2.0,-0.150000000000000000D+01,-0.150000000E+01,
- 2 3, 3.0, 3.0, 0.187500000000000000D+01, 0.187500000E+01,
- 3 -4, -4.0, -4.0,-0.218749999999999956D+01,-0.218750000E+01,
- 4 5, 5.0, 5.0, 0.246093749999999933D+01, 0.246093750E+01,
- 5 0, 0.0, 0.0, 0.000000000000000000D+00, 0.000000000E+00,
- 6 1, 1.0, 1.0, 0.100000000000000000D+01, 0.100000000E+01,
- 7 0, 0.0, 0.0, 0.500000000000000000D+00, 0.500000000E+00,
- 8 0, 0.0, 0.0,-0.125000000000000000D+00,-0.125000000E+00,
- 9 0, 0.0, 0.0, 0.625000000000000000D-01, 0.625000000E-01,
- + 0, 0.0, 0.0,-0.390625000000000000D-01,-0.390625000E-01/
- DATA (KEX1(J),EX2(J),REX3(J),EX4(J),REX5(J),J=31,40)
- 1 / 0, 0.0, 0.0, 0.000000000000000000D+00, 0.000000000E+00,
- 2 1, 1.0, 1.0, 0.100000000000000000D+01, 0.100000000E+01,
- 3 2, 2.0, 2.0, 0.250000000000000000D+01, 0.250000000E+01,
- 4 1, 1.0, 1.0, 0.187500000000000000D+01, 0.187500000E+01,
- 5 0, 0.0, 0.0, 0.312499999999999972D+00, 0.312500000E+00,
- 6 0, 0.0, 0.0,-0.390624999999999965D-01,-0.390625000E-01,
- 7 0, 0.0, 0.0, 0.000000000000000000D+00, 0.000000000E+00,
- 8 1, 1.0, 1.0, 0.100000000000000000D+01, 0.100000000E+01,
- 9 4, 4.0, 4.0, 0.450000000000000000D+01, 0.450000000E+01,
- + 6, 6.0, 6.0, 0.787500000000000000D+01, 0.787500000E+01/
- DATA (KEX1(J),EX2(J),REX3(J),EX4(J),REX5(J),J=41,54)
- + / 4, 4.0, 4.0, 0.656249999999999978D+01, 0.656250000E+01,
- + 1, 1.0, 1.0, 0.246093749999999978D+01, 0.246093750E+01,
- + 0, 0.0, 0.0, 0.000000000000000000D+00, 0.000000000E+00,
- + 1, 1.0, 1.0, 0.100000000000000000D+01, 0.100000000E+01,
- + 6, 6.0, 6.0, 0.650000000000000000D+01, 0.650000000E+01,
- + 15, 15.0, 15.0, 0.178750000000000000D+02, 0.178750000E+02,
- + 20, 20.0, 20.0, 0.268125000000000000D+02, 0.268125000E+02,
- + 15, 15.0, 15.0, 0.234609375000000000D+02, 0.234609375E+02,
- + 0, 0.0, 0.0, 0.000000000000000000D+00, 0.000000000E+00,
- + 1, 1.0, 1.0, 0.100000000000000000D+01, 0.100000000E+01,
- + 8, 8.0, 8.0, 0.850000000000000000D+01, 0.850000000E+01,
- + 28, 28.0, 28.0, 0.318750000000000000D+02, 0.318750000E+02,
- + 56, 56.0, 56.0, 0.690624999999999929D+02, 0.690625000E+02,
- + 70, 70.0, 70.0, 0.949609374999999893D+02, 0.949609375E+02/
-
- CALL HEADER('B100',0)
- KERMAX=0
- ERMAX=0D0
- RERMAX=0E0
-
- WRITE(LOUT,'(/15X,''ERRORS OBTAINED WHEN TESTING:'')')
- WRITE(LOUT,'(/7X,''KBINOM (X,K) = KB'')')
- WRITE(LOUT,'(/7X,''BINOM (X,K) = B BINOM (X+1/2,K) = BH'')')
-#if defined(CERNLIB_DOUBLE)
- WRITE(LOUT,'(/7X,''DBINOM (X,K) = DB DBINOM (X+1/2,K)= DBH'')')
-#endif
- WRITE(LOUT,'(//7X,'' for X = -8,-6,-4,-2,0,2,4,6,8'',
- + '' each with K from -1 to 4'')')
-
- WRITE(LOUT,'(/7X,
-#if defined(CERNLIB_DOUBLE)
- + ''KB'',6X,''DB'',8X,''B'',23X,''DBH'',13X,''BH'')')
-#endif
-#if !defined(CERNLIB_DOUBLE)
- + ''KB'',6X,''B'',13X,''BH'')')
-#endif
-
- J= 1
- DO 1 N = -8,8,2
- DO 1 K = -1,4
- KB=KBINOM(N,K)
- IF (KEX1(J) .NE. 0) THEN
- KER1=ABS((KB-KEX1(J))/KEX1(J))
- ELSE
- KER1=ABS(KB-KEX1(J))
- ENDIF
- KERMAX=MAX(KERMAX,KER1)
- DX=N
-#if defined(CERNLIB_DOUBLE)
- D1=DBINOM(DX,K)
- IF (EX2(J) .NE. 0) THEN
- ER2=ABS((D1-EX2(J))/EX2(J))
- ELSE
- ER2=ABS(D1-EX2(J))
- ENDIF
- ERMAX=MAX(ERMAX,ER2)
-#endif
- RDX=DX
- RD1=BINOM(RDX,K)
- IF (REX3(J) .NE. 0) THEN
- RER3=ABS((RD1-REX3(J))/REX3(J))
- ELSE
- RER3=ABS(RD1-REX3(J))
- ENDIF
- RERMAX=MAX(RERMAX,RER3)
- DX=N+HALF
-#if defined(CERNLIB_DOUBLE)
- D2=DBINOM(DX,K)
- IF (EX2(J) .NE. 0) THEN
- ER4=ABS((D2-EX4(J))/EX4(J))
- ELSE
- ER4=ABS(D2-EX4(J))
- ENDIF
- ERMAX=MAX(ERMAX,ER4)
-#endif
- RDX=DX
- RD2=BINOM(RDX,K)
- IF (REX5(J) .NE. 0) THEN
- RER3=ABS((RD2-REX5(J))/REX5(J))
- ELSE
- RER5=ABS(RD2-REX5(J))
- ENDIF
- RERMAX=MAX(RERMAX,RER5)
- J=J+1
-#if !defined(CERNLIB_DOUBLE)
- 1 WRITE(LOUT,'(5X,I4,D10.1,E16.1)') KER1,RER3,RER5
-#endif
-#if defined(CERNLIB_DOUBLE)
- 1 WRITE(LOUT,'(5X,I4,D10.1,E10.1,D25.1,E16.1)')
- + KER1,ER2,RER3,ER4,RER5
-#endif
- DX=Z2**32
- RDX=DX
- RZ2=Z2
- RD1=BINOM(RZ2**32,2)
- RTEST=RDX*(RDX-1)/2
- IF (RTEST .NE. 0E0)RER7=ABS((RD1-RTEST)/RTEST)
- RERMAX=MAX(RERMAX,RER7)
-#if defined(CERNLIB_DOUBLE)
- D1=DBINOM(Z2**32,2)
- TEST=DX*(DX-1)/2
- IF (TEST .NE. 0D0) ER6=ABS((D1-TEST)/TEST)
- ERMAX=MAX(ERMAX,ER6)
- WRITE(LOUT,'(/7X,''DBINOM(2**32,2)'',10X,''EXACT VALUE'')')
- WRITE(LOUT,'(3X,D25.15,D25.15)') D1,TEST
-#endif
- WRITE(LOUT,'(/7X,''BINOM(2**32,2)'',6X,''EXACT VALUE'')')
- WRITE(LOUT,'(4X,E18.9,E18.9)') RD1,RTEST
- WRITE(LOUT,'(/7X,''Largest Error for KBINOM was'',I4)')KERMAX
- WRITE(LOUT,'(/7X,''Largest Error for BINOM was'',E10.1)')RERMAX
- RKERMAX=KERMAX
- RERMAX= MAX(RERMAX,RKERMAX)
-#if defined(CERNLIB_DOUBLE)
- WRITE(LOUT,'(/7X,''Largest Error for DBINOM was'',D10.1)')ERMAX
- RERMAX= MAX(RERMAX,SNGL(ERMAX))
-#endif
- WRITE(LOUT,'(/7X,''TESTING ERROR MESSAGES:''/)')
- N=KBINOM(2**30,4)
- IRC=ITEST('B100',RERMAX .LE. RTSTERR)
- CALL PAGEND('B100')
- RETURN
- END
diff --git a/src/mathlib/gen/tests/b101m.F b/src/mathlib/gen/tests/b101m.F
deleted file mode 100644
index a5cdddb..0000000
--- a/src/mathlib/gen/tests/b101m.F
+++ /dev/null
@@ -1,37 +0,0 @@
-*
-* $Id: b101m.F,v 1.1.1.1 1996/04/01 15:01:12 mclareni Exp $
-*
-* $Log: b101m.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:12 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE B101M
-C Routine to test MATHLIB routine ATG (B101)
-
-C Specify the largest error allowed for a successful test
- PARAMETER ( TSTERR=1D-6 )
-#include "iorc.inc"
- CALL HEADER('B101',0)
-
- WRITE(LOUT,'(/8X,''For A=I*PI/180:'')')
- WRITE(LOUT,'(/5X,''I'',3X,''X=SIN(A)'',4X,''Y=COS(A)'',8X,
- + ''ATG(X,Y)'',4X,''Error'')')
- ER=0E0
- ERMAX=0E0
- PI = 3.14159 26535 89793D0
- DO 1 I = 0,350,10
- A=I*PI/180
- X1=SIN(A)
- X2=COS(A)
- R1=ATG(X1,X2)
- IF (A .NE. 0.)ER=ABS((R1-A)/A)
- ERMAX=MAX(ERMAX,ER)
- WRITE(LOUT,'(1X,I5,2F12.7,F15.7,E10.1)') I,X1,X2,R1,ER
- 1 CONTINUE
- WRITE(LOUT,'(/7X,''Largest Error for ATG was'',E10.1)')ERMAX
- IRC=ITEST('B101',ERMAX .LE. TSTERR)
- CALL PAGEND('B101')
- RETURN
- END
diff --git a/src/mathlib/gen/tests/b102m.F b/src/mathlib/gen/tests/b102m.F
deleted file mode 100644
index 10c488b..0000000
--- a/src/mathlib/gen/tests/b102m.F
+++ /dev/null
@@ -1,86 +0,0 @@
-*
-* $Id: b102m.F,v 1.1.1.1 1996/04/01 15:01:12 mclareni Exp $
-*
-* $Log: b102m.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:12 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE B102M
-C Routine to test MATHLIB routines ASINH and DASINH (B102)
-#include "gen/imp64.inc"
-C Set the total number of tests
- PARAMETER (NT=4)
-C
- CHARACTER*6 TFUNC(2)
-C
-C Set numerical tolerance for testing the S/D versions
- DIMENSION TOL(2)
-C
- DIMENSION X(NT),EXACT(NT)
- REAL ASINH
- LOGICAL LTEST
-#include "iorc.inc"
-C Input parameters for individual tests
-C Index of ERROR, 1=Real test error
-
- DATA X( 1 )/ -1.000D0/, EXACT( 1 ) /-8.813735870195429920D-01/
- DATA X( 2 )/ 0.000D0/, EXACT( 2 ) /0.000000000000000000D+00 /
- DATA X( 3 )/ 1.000D0/, EXACT( 3 ) /8.813735870195429920D-01 /
- DATA X( 4 )/ -0.014D0/, EXACT( 4 ) /-1.399954270699875840D-02/
-
- DATA TFUNC/'ASINH','DASINH'/
- DATA TOL / 1D-6,1D-14 /
-
- CALL HEADER('B102',0)
- LTEST=.TRUE.
-C
-C--- Number of functions to test
-#if !defined(CERNLIB_DOUBLE)
- NF=1
-#endif
-#if defined(CERNLIB_DOUBLE)
- NF=2
-#endif
-C
- DO 200 JF=1,NF
- WRITE(LOUT,'(/8X,''X'',14X,'' '',A,''(X)'',7X,''Rel Error'')')
- + TFUNC(JF)
- ERRMAX=0D0
-c ERROR =1D3
- DO 100 I=1,NT
-#if !defined(CERNLIB_DOUBLE)
- SOL = ASINH( X(I) )
- IF(SOL.NE.0) ERROR= ABS( (EXACT(I)-SOL)/SOL )
- WRITE(LOUT,'(1X,F10.3,1P,D27.18,D10.1)') X(I),SOL,ERROR
-#endif
-#if defined(CERNLIB_DOUBLE)
- IF(JF.EQ.1) THEN
- SOL = ASINH(SNGL( X(I)) )
- IF(SOL.NE.0) ERROR= ABS( SNGL(EXACT(I)-SOL)/SNGL(SOL) )
- WRITE(LOUT,'(1X,F10.3,1P,E27.9,E10.1)')
- + SNGL(X(I)),SNGL(SOL),SNGL(ERROR)
- ENDIF
- IF(JF.EQ.2) THEN
- SOL =DASINH( X(I) )
- IF(SOL.NE.0) ERROR= ABS( (EXACT(I)-SOL)/SOL )
- WRITE(LOUT,'(1X,F10.3,1P,D27.18,D10.1)') X(I),SOL,ERROR
- ENDIF
-#endif
- ERRMAX= MAX( ERRMAX,ERROR )
-100 CONTINUE
- WRITE(LOUT,'(/''Largest Relative Error was'',1P,D10.1)')ERRMAX
-#if !defined(CERNLIB_DOUBLE)
- ETOL=TOL(JF+1)
-#endif
-#if defined(CERNLIB_DOUBLE)
- ETOL=TOL(JF )
-#endif
- LTEST=LTEST.AND.(ERRMAX.LE.ETOL)
-200 CONTINUE
-
- IRC=ITEST('B102',LTEST)
- CALL PAGEND('B102')
- RETURN
- END
diff --git a/src/mathlib/gen/tests/b300m.F b/src/mathlib/gen/tests/b300m.F
deleted file mode 100644
index 551b552..0000000
--- a/src/mathlib/gen/tests/b300m.F
+++ /dev/null
@@ -1,113 +0,0 @@
-*
-* $Id: b300m.F,v 1.2 2006/09/15 09:34:55 mclareni Exp $
-*
-* $Log: b300m.F,v $
-* Revision 1.2 2006/09/15 09:34:55 mclareni
-* Submitted mods for gcc4/gfortran and MacOSX, corrected to work also on slc4 with gcc3.4 and 4.1
-*
-* Revision 1.1.1.1 1996/04/01 15:01:13 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE B300M
-C Routine to test MATHLIB routines RSRTNT and DSRTNT (B300)
-
-#include "gen/imp64.inc"
- LOGICAL LRL
- LOGICAL LTEST
- EXTERNAL FB300
- COMMON /FOB300/ A,B,C
- COMMON /F1B300/ K,N
- PARAMETER (R0 = 0, R1 = 1, NR = 5)
- DIMENSION RU(NR),RV(NR)
-
-#include "iorc.inc"
- P(X)=A+B*X+C*X**2
-
- CALL HEADER('B300',0)
- LTEST= .TRUE.
-#if defined(CERNLIB_DOUBLE)
- CALL DVRAN(NR,-3D0,3D0,RU(1),RU(2))
- CALL DVRAN(NR,-3D0,3D0,RV(1),RV(2))
-#endif
-#if !defined(CERNLIB_DOUBLE)
- CALL RVRAN(NR,-3D0,3D0,RU(1),RU(2))
- CALL RVRAN(NR,-3D0,3D0,RV(1),RV(2))
-#endif
- DO 1 K = -3,3
- DO 1 N = 1,3,2
- DO 1 IA = -2,2
- A=IA
- DO 1 IB = -2,2
- B=IB
- DO 1 IC = -2,2
- C=IC
- IF(ABS(A)+ABS(B)+ABS(C) .GT. 0) THEN
- DELTA=4*A*C-B**2
- DO 2 IU = 1,NR
- U=RU(IU)
- DO 2 IV = 1,NR
- V=RV(IV)
-#if defined(CERNLIB_DOUBLE)
- CALL DSRTNT(K,N,A,B,C,U,V,RES,LRL)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- CALL RSRTNT(K,N,A,B,C,U,V,RES,LRL)
-#endif
- IF(LRL) THEN
- U1=MIN(U,V)
- V1=MAX(U,V)
- SGN=SIGN(R1,V-U)
-#if defined(CERNLIB_DOUBLE)
- IF(K .NE. -1) TST=SGN*DGAUSS(FB300,U1,V1,1D-8)
- IF(K .EQ. -1) TST=SGN*DCAUCH(FB300,U1,V1,R0,1D-8)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- IF(K .NE. -1) TST=SGN*GAUSS(FB300,U1,V1,1D-8)
- IF(K .EQ. -1) TST=SGN*CAUCHY(FB300,U1,V1,R0,1D-8)
-#endif
- D=RES-TST
- LTEST = LTEST .AND. ABS(D) .LE.1D-7
-*
-* gfortran hates logical in format statement:-(
-*
-#if defined(CERNLIB_GFORTRAN)
- IF(ABS(D) .GT. 1D-7)
- 1 WRITE(LOUT,'(1X,2I5,F10.1,3F7.1,2F8.4,3F15.8,'' LB'',L2)')
- 2 K,N,DELTA,A,B,C,U,V,RES,TST,D,LRL
-#else
- IF(ABS(D) .GT. 1D-7)
- 1 WRITE(LOUT,'(1X,2I5,F10.1,3F7.1,2F8.4,3F15.8,'' LB'',I2,L2)')
- 2 K,N,DELTA,A,B,C,U,V,RES,TST,D,LRL
-#endif
- ENDIF
- 2 CONTINUE
- ENDIF
- 1 CONTINUE
- WRITE(LOUT,'(/1X,''If the test is successful, the results will not
- 1 be printed.''/)')
- WRITE(LOUT,'(/7X,''TESTING ERROR MESSAGES:''/)')
-#if defined(CERNLIB_DOUBLE)
- CALL DSRTNT(K,N,R0,R0,R0,U,V,RES,LRL)
- CALL DSRTNT(5,1,R1,R1,R1,U,V,RES,LRL)
- CALL DSRTNT(0,2,R1,R1,R1,U,V,RES,LRL)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- CALL RSRTNT(K,N,R0,R0,R0,U,V,RES,LRL)
- CALL RSRTNT(5,1,R1,R1,R1,U,V,RES,LRL)
- CALL RSRTNT(0,2,R1,R1,R1,U,V,RES,LRL)
-#endif
- WRITE(LOUT,'(1X)')
- IRC=ITEST('B300',LTEST)
- CALL PAGEND('B300')
- RETURN
- END
- FUNCTION FB300(T)
-#include "gen/imp64.inc"
- COMMON /FOB300/ A,B,C
- COMMON /F1B300/ K,N
-
- FB300=T**K/SQRT(A+B*T+C*T**2)**N
- RETURN
- END
diff --git a/src/mathlib/gen/tests/blkdt.F b/src/mathlib/gen/tests/blkdt.F
deleted file mode 100644
index 4edda56..0000000
--- a/src/mathlib/gen/tests/blkdt.F
+++ /dev/null
@@ -1,14 +0,0 @@
-*
-* $Id: blkdt.F,v 1.1.1.1 1996/04/01 15:01:12 mclareni Exp $
-*
-* $Log: blkdt.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:12 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- BLOCK DATA
-#include "iorc.inc"
- DATA LIN/5/,LOUT/6/
- DATA NTEST/0/,NFAIL/0/,IRC/0/
- END
diff --git a/src/mathlib/gen/tests/c200m.F b/src/mathlib/gen/tests/c200m.F
deleted file mode 100644
index 02143d7..0000000
--- a/src/mathlib/gen/tests/c200m.F
+++ /dev/null
@@ -1,173 +0,0 @@
-*
-* $Id: c200m.F,v 1.1.1.1 1996/04/01 15:01:13 mclareni Exp $
-*
-* $Log: c200m.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:13 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE C200M
-C Test of MATHLIB routines ZEROX and DZEROX (C200)
-#include "gen/imp64.inc"
-C Specify the largest absolute error allowed for a successful test
- PARAMETER ( TSTERR=5D-11 )
- EXTERNAL C200F1,C200F2,C200F3,C200F4
- CHARACTER CMR(2)*1
- COMMON /ICOMMN/ KASE,N
- COMMON /RCOMMN/ A,B
-#include "iorc.inc"
-
- DIMENSION A2(3),B2(3)
- DIMENSION N1(4,6),N2(4),N3(6)
-
- DATA CMR /'M','R'/
- DATA (N1(N,1),N=1,4) / 1, 0, 0, 0/
- DATA (N1(N,2),N=1,4) / 1, 2, 3, 4/
- DATA (N1(N,3),N=1,4) / 1, 5,10, 0/
- DATA (N1(N,4),N=1,4) / 1, 5,10, 0/
- DATA (N1(N,5),N=1,4) / 1, 4, 8, 0/
- DATA (N1(N,6),N=1,4) / 1, 5,10, 0/
- DATA N2 / 3, 5, 9,19/, N3 / 3, 5, 7, 9,19,25/
- DATA A2 / 1, 0, 1/, B2 / 0, 1D-4,1D-4/
-
- CALL HEADER('C200',0)
-#if !defined(CERNLIB_DOUBLE)
- TOL=1D-14
-#endif
-#if defined(CERNLIB_DOUBLE)
- TOL=1D-15
-#endif
- MXF=500
- ERMAX=0D0
- DO 20 MODE = 1,2
- WRITE(LOUT,100) MODE,CMR(MODE)
- WRITE(LOUT,'(/3X,''F'',2X,''N'',10X,''X0'',17X,''F(X0)'')')
- DO 1 KASE = 1,6
- WRITE(LOUT,'(1X)')
- XL=0
- XU=1
- IF(KASE .EQ. 1) XU=1.5D0
- DO 11 I1 = 1,4
- N=N1(I1,KASE)
- IF(N .EQ. 0) GO TO 11
-#if defined(CERNLIB_DOUBLE)
- X0=DZEROX(XL,XU,TOL,MXF,C200F1,MODE)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- X0= ZEROX(XL,XU,TOL,MXF,C200F1,MODE)
-#endif
- ER=ABS(C200F1(X0))
- WRITE(LOUT,'(1X,2I3,2F20.14)') KASE,N,X0,C200F1(X0)
- ERMAX=MAX(ERMAX,ER)
- 11 CONTINUE
- 1 CONTINUE
-
- WRITE(LOUT,'(/6X,''N'',6X,''A'',8X,''B'',18X,''X0'',27X,
- +''F(X0)'')')
- XL=-1
- XU=1
- DO 2 I2 = 1,2
-C DO 2 I2 = 1,4
- IF ( MODE .EQ. 1 .AND. I2 .GE. 3) GO TO 2
- N=N2(I2)
- DO 12 J2 = 1,3
- A=A2(J2)
- B=B2(J2)
-#if defined(CERNLIB_DOUBLE)
- X0=DZEROX(XL,XU,TOL,MXF,C200F2,MODE)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- X0= ZEROX(XL,XU,TOL,MXF,C200F2,MODE)
-#endif
- ER=ABS(C200F2(X0))
- WRITE(LOUT,'(1X,I6,2F10.4,2F25.15)') N,A,B,X0,C200F2(X0)
- ERMAX=MAX(ERMAX,ER)
- 12 CONTINUE
- 2 CONTINUE
-
-C WRITE(LOUT,'(/6X,''N'',14X,''X0'',22X,''F(X0)'')')
-C XL=-1
-C XU=10
-C DO 3 I3 = 1,6
-C N=N3(I3)
-CSELF,IF= DOUBLE
-C X0=DZEROX(XL,XU,TOL,MXF,C200F3,MODE)
-CSELF,IF=-DOUBLE
-C X0= ZEROX(XL,XU,TOL,MXF,C200F3,MODE)
-CSELF.
-C ER=ABS(C200F3(X0))
-C WRITE(LOUT,'(1X,I6,2F25.15)') N,X0,C200F3(X0)
-C ERMAX=MAX(ERMAX,ER)
-C 3 CONTINUE
-
- WRITE(LOUT,'(/19X,''X0'',22X,''F(X0)'')')
- XL=-1
- XU=4
-#if defined(CERNLIB_DOUBLE)
- X0=DZEROX(XL,XU,TOL,MXF,C200F4,MODE)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- X0= ZEROX(XL,XU,TOL,MXF,C200F4,MODE)
-#endif
- ER=ABS(C200F4(X0))
- WRITE(LOUT,'(1X,6X,2F25.15)') X0,C200F4(X0)
- ERMAX=MAX(ERMAX,ER)
- 20 CONTINUE
- WRITE(LOUT,'(/7X,''TESTING ERROR MESSAGES:''/)')
-#if defined(CERNLIB_DOUBLE)
- X0=DZEROX(XL,XU,TOL,MXF,C200F4,0)
- X0=DZEROX(XL,XL,TOL,MXF,C200F4,1)
- X0=DZEROX(XL,XU,TOL,2,C200F4,1)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- X0= ZEROX(XL,XU,TOL,MXF,C200F4,0)
- X0= ZEROX(XL,XL,TOL,MXF,C200F4,1)
- X0= ZEROX(XL,XU,TOL,2,C200F4,1)
-#endif
- 100 FORMAT('1'/1X,'MODE = ',I1,5X,'Algorithm ',A1,
- 1 5X,'(Examples on page 340 of Bus and Dekker'/)
- WRITE(LOUT,'(/''Largest Relative Error was'',1P,D10.1)')ERMAX
- IRC=ITEST('C200',ERMAX .LE. TSTERR)
- CALL PAGEND('C200')
- RETURN
- END
-C Test functions follow, equation to be solved: F(x)=0 for a<=x<=b
- FUNCTION C200F(X)
-#include "gen/imp64.inc"
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION C200F1,C200F2,C200F3,C200F4,X
-#endif
- COMMON /ICOMMN/ KASE,N
- COMMON /RCOMMN/ A,B
-
- PARAMETER (Z1 = 1, HALF = Z1/2)
-
- ENTRY C200F1(X)
- GO TO (1,2,3,4,5,6), KASE
- 1 C200F=SIN(X)-HALF
- RETURN
- 2 C200F=2*X*EXP(-N*Z1)+1-2*EXP(-N*X)
- RETURN
- 3 C200F=(1+(1-N)**2)*X-(1-N*X)**2
- RETURN
- 4 C200F=X**2-(1-X)**N
- RETURN
- 5 C200F=(1+(1-N)**4)*X-(1-N*X)**4
- RETURN
- 6 C200F=(X-1)*EXP(-N*X)+X**N
- RETURN
-
- ENTRY C200F2(X)
- C200F=X**N+A*X+B
- RETURN
-
- ENTRY C200F3(X)
- C200F=X**N
- RETURN
-
- ENTRY C200F4(X)
- C200F=(3*X-1)*(3*X/2-1)**4*EXP(-5*X)
- RETURN
- END
-
diff --git a/src/mathlib/gen/tests/c201m.F b/src/mathlib/gen/tests/c201m.F
deleted file mode 100644
index bb9bdcf..0000000
--- a/src/mathlib/gen/tests/c201m.F
+++ /dev/null
@@ -1,102 +0,0 @@
-*
-* $Id: c201m.F,v 1.1.1.1 1996/04/01 15:01:13 mclareni Exp $
-*
-* $Log: c201m.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:13 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE C201M
-C Test of MATHLIB routines SNLEQ and DSNLEQ (C201)
-#include "gen/imp64.inc"
-#include "iorc.inc"
- LOGICAL RETOK,ERROK
- EXTERNAL C201S
- COMMON /FLABEL/ L
- DIMENSION X(10),F(10),W(130)
- INTEGER MESS(4)
-C Set maximum error for test still to be considered successful
- PARAMETER ( TSTERR=1D-11,Z1=1D0 )
-
- CALL HEADER('C201',0)
- L=0
- CALL C201S(1,X,F,1)
-
- TOL=1D-12
-C Initialse maximum error for all tests
- RESMAX=0D0
-C Set intermediate stage printing on/off
- IF (LOUT .EQ. 6) THEN
- IPRNT=1
- ELSE
- IPRNT=0
- ENDIF
- DO 1 L = 1,4
- WRITE(LOUT,'(//'' Test number'',I3)') L
- IF (L .EQ. 1) THEN
- N=10
- H=Z1/(N+1)
- DO 10 I = 1,N
- 10 X(I)=I*H*(I*H-1)
- ELSEIF(L .EQ. 2) THEN
- N=2
- X(1)=-0.9
- X(2)=1.7
- ELSEIF(L .EQ. 3) THEN
- N=2
- X(1)=1
- X(2)=4
- ELSE
- N=2
- X(1)=45
- X(2)=600
- ENDIF
- MAXF=50*(N+3)
-
-C*RC FNORM1=0
- DO 11 I = 1,N
- CALL C201S(N,X,F,I)
-C*RC11 FNORM1=MAX(FNORM1,ABS(F(I)))
-11 CONTINUE
-
-#if defined(CERNLIB_DOUBLE)
- CALL DSNLEQ(N,X,F,TOL,TOL,MAXF,IPRNT,INFO,C201S,W)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- CALL SNLEQ(N,X,F,TOL,TOL,MAXF,IPRNT,INFO,C201S,W)
-#endif
- FNORM2=0
- DO 12 I = 1,N
- CALL C201S(N,X,F,I)
- 12 FNORM2=MAX(FNORM2,ABS(F(I)))
- WRITE(LOUT,100) FNORM2,INFO,(X(I),I=1,N)
-C Calculate the maximum of the max-norms of residuals
- RESMAX=MAX( RESMAX,FNORM2 )
- MESS(L)=INFO
- 1 CONTINUE
-
-C Check return codes
- IF (MESS(1) .GE. 1 .AND. MESS(1) .LE. 3 .AND.
- + MESS(2) .GE. 1 .AND. MESS(2) .LE. 3 .AND.
- + MESS(3) .GE. 1 .AND. MESS(3) .LE. 3 .AND.
- + MESS(4) .GE. 1 .AND. MESS(4) .LE. 3) THEN
- RETOK=.TRUE.
- ELSE
- RETOK= .FALSE.
- ENDIF
-C Check if the desired accuracy was acheieved
- IF (RESMAX .LE. TSTERR) THEN
- ERROK=.TRUE.
- ELSE
- ERROK=.FALSE.
- ENDIF
- IRC=ITEST('C201',RETOK .AND. ERROK)
- CALL PAGEND('C201')
-
- 100 FORMAT(//' FINAL MAX-NORM OF THE RESIDUALS',D15.7/
- + ' EXIT PARAMETER (INFO) ',I10/
- + ' FINAL APPROXIMATE SOLUTION:'//34(4X,3F25.15/))
- RETURN
- END
-
diff --git a/src/mathlib/gen/tests/c201s.F b/src/mathlib/gen/tests/c201s.F
deleted file mode 100644
index 250e892..0000000
--- a/src/mathlib/gen/tests/c201s.F
+++ /dev/null
@@ -1,59 +0,0 @@
-*
-* $Id: c201s.F,v 1.1.1.1 1996/04/01 15:01:13 mclareni Exp $
-*
-* $Log: c201s.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:13 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE C201S(N,X,F,K)
-#include "gen/imp64.inc"
-#include "iorc.inc"
- COMMON /FLABEL/ L
- DIMENSION X(N),F(N)
- PARAMETER (Z1 = 1)
- DATA C21,C22,C23 / 4.49D0,1.18D0,0.7D0/
- DATA C41,C42,C43,C44 /50,2.5D0,0.0078D0,19000/
-
- IF(L .EQ. 0) THEN
-C*RC W5=SQRT(5*Z1)
-C*RC W10=SQRT(10*Z1)
-C*RC E=EXP(Z1)
-C*RC PI=4*ATAN(Z1)
-C*RC PI1=1-1/(4*PI)
- GOTO 999
- ENDIF
-
- GO TO (1,2,3,4), L
-
- 1 H=Z1/(N+1)
- TEMP=(X(K)+K*H+1)**3/2
- TEMP1=0
- IF(K .NE. 1) TEMP1=X(K-1)
- TEMP2=0
- IF(K .NE. N) TEMP2=X(K+1)
- F(K)=2*X(K)-TEMP1-TEMP2+TEMP*H**2
- GOTO 999
-
- 2 GO TO (21,22), K
- 21 F(1)=X(1)**4-6*(X(1)*X(2))**2+X(2)**4+2*X(1)**3-6*X(1)*X(2)**2+
- 1 C21*(X(1)**2-X(2)**2)+C22*X(1)+C23
- GOTO 999
- 22 F(2)=X(2)*(4*X(1)**3-4*X(1)*X(2)**2+6*X(1)**2-2*X(2)**2+
- 1 2*C21*X(1)+C22)
- GOTO 999
-
-
- 3 GO TO (31,32), K
- 31 F(1)=X(1)-(4/TAN(X(2))-X(2))
- GOTO 999
- 32 F(2)=X(1)-X(2)/(4-SIN(X(2)))
- GOTO 999
-
- 4 GO TO (41,42), K
- 41 F(1)=C41-X(2)*(LOG(X(1)/X(2)+SQRT(1+(X(1)/X(2))**2))+C43*X(1)/C44)
- GOTO 999
- 42 F(2)=C42-(X(2)*(SQRT(1+(X(1)/X(2))**2)-1)+C43*X(1)**2/(2*C44))
- 999 RETURN
- END
diff --git a/src/mathlib/gen/tests/c202m.F b/src/mathlib/gen/tests/c202m.F
deleted file mode 100644
index 0900a94..0000000
--- a/src/mathlib/gen/tests/c202m.F
+++ /dev/null
@@ -1,107 +0,0 @@
-*
-* $Id: c202m.F,v 1.1.1.1 1996/04/01 15:01:13 mclareni Exp $
-*
-* $Log: c202m.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:13 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE C202M
-C ROUTINE TO TEST MATHLIB ROUTINES RMULLZ AND DMULLZ (C202)
-#include "gen/imp64.inc"
-C Set the total number of tests and the maximum degree of the
-C polynomials to be tested
- PARAMETER ( NT=6)
- PARAMETER ( NA=5)
- CHARACTER*6 TFUNC(2)
-C
-C Set numerical tolerance for testing the S/D versions
- DIMENSION TOL(1)
-C
-#include "gen/defc64.inc"
- + Z0(NA),SOL(1:NT,1:NA),EXACT(1:NT,1:NA)
- DIMENSION A(0:NA,0:NT),ND(0:NT),ERROR(1:NT,1:NA),AA(0:4,1)
- LOGICAL LTEST
-#include "iorc.inc"
- DATA TFUNC/'RMULLZ','DMULLZ'/
- DATA TOL / 1D-11 /
-C Input parameters for individual tests
- DATA ND /2,1,2,3,4,2,3/
- DATA (A(J,1),J=0,1)/1,-1/
- DATA (A(J,2),J=0,2)/1,-3,2/
- DATA (A(J,3),J=0,3)/1,-6,11,-6/
- DATA (A(J,4),J=0,4)/1,9,-79,159,-90/
- DATA (A(J,5),J=0,2)/1,-20,500/
- DATA (A(J,6),J=0,3)/1,-453.00000000,68402.00000000,
- + -3442800.00000000/
-C Analytical values expected to be obtained
- DATA EXACT(1,1) / (1,0)/
- DATA (EXACT(2,J),J=1,2) / (1,0),(2,0)/
- DATA (EXACT(3,J),J=1,3) / (1,0),(3,0),(2,0)/
- DATA (EXACT(4,J),J=1,4) / (-15,0),(3,0),(1,0),(2,0)/
- DATA (EXACT(5,J),J=1,2) / (10,-20),(10,20)/
- DATA (EXACT(6,J),J=1,3) / (150,0),(152,0),(151,0)/
- DATA (AA(J,1),J=0,4)/1,-5,6,4,-8/
-
- CALL HEADER('C202',0)
- ERRMAX=0D0
- MAXITR=100000
- LTEST=.TRUE.
-C
- ERRMAX=0D0
-#if defined(CERNLIB_DOUBLE)
- DO 100 I=1,NT
-#endif
-#if !defined(CERNLIB_DOUBLE)
- DO 100 I=1,5
- WRITE(LOUT,'(/8X,'' '',A,''(X)'',23X,''Exact Value'',10X,
- + ''Rel Error'')') TFUNC(1)
- CALL RMULLZ(A(0,I),ND(I),MAXITR,Z0)
- DO 22 J=1,ND(I)
- SOL(I,J)=Z0(J)
- IF (Z0(J) .NE. 0)
- + ERROR(I,J)= ABS( ABS(EXACT(I,J))- ABS(Z0(J)))/ ABS(Z0(J))
- ERRMAX= MAX( ERRMAX,ERROR(I,J) )
- 22 WRITE(LOUT,444) SOL(I,J),EXACT(I,J),ERROR(I,J)
-#endif
-#if defined(CERNLIB_DOUBLE)
- WRITE(LOUT,'(/13X,'' '',A,''(X)'',23X,''Exact Value'',10X,
- + ''Rel Error'')') TFUNC(2)
- CALL DMULLZ(A(0,I),ND(I),MAXITR,Z0)
- DO 44 J=1,ND(I)
- SOL(I,J)=Z0(J)
- IF (Z0(J) .NE. 0)
- + ERROR(I,J)= ABS( ABS(EXACT(I,J))- ABS(Z0(J)))/ ABS(Z0(J))
- ERRMAX= MAX( ERRMAX,ERROR(I,J) )
- 44 WRITE(LOUT,444) SOL(I,J),EXACT(I,J),ERROR(I,J)
-#endif
- 444 FORMAT (1X,'(',F14.10,F14.10,')',5X,'(',F14.10,F14.10,')',D10.1)
-100 CONTINUE
- WRITE(LOUT,'(/''Largest Relative Error was'',D10.1)')ERRMAX
- LTEST=LTEST.AND.(ERRMAX.LE. TOL(1))
-
- WRITE(LOUT,'(/''TESTING ERROR MESSAGES:''/)')
- MAXITR=10
-#if defined(CERNLIB_DOUBLE)
- CALL DMULLZ(AA(0,1),ND(4),MAXITR,Z0)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- CALL RMULLZ(AA(0,1),ND(4),MAXITR,Z0)
-#endif
- DO 3 J = 1,ND(4)
- 3 WRITE(LOUT,555) Z0(J)
- 555 FORMAT (1X,'(',D10.1,D10.1,')')
- A(0,0)=0
-#if defined(CERNLIB_DOUBLE)
- CALL DMULLZ(A(0,0),ND(0),MAXITR,Z0)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- CALL RMULLZ(A(0,0),ND(0),MAXITR,Z0)
-#endif
-
-1000 CONTINUE
- IRC=ITEST('C202',LTEST)
- CALL PAGEND('C202')
- RETURN
- END
diff --git a/src/mathlib/gen/tests/c206m.F b/src/mathlib/gen/tests/c206m.F
deleted file mode 100644
index 2cbfa49..0000000
--- a/src/mathlib/gen/tests/c206m.F
+++ /dev/null
@@ -1,92 +0,0 @@
-*
-* $Id: c206m.F,v 1.1.1.1 1996/04/01 15:01:13 mclareni Exp $
-*
-* $Log: c206m.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:13 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE C206M
-#include "iorc.inc"
- PARAMETER (NT=4)
-C This program tests the GENLIB routine POLY2 by calculating the
-C roots of specially constructed complex polynomials.
- COMPLEX TEST(NT,NT),A(NT+1),ROOT(NT),SUM
-C R is the radius vector H in library manual
- REAL R(NT),RES(NT)
- LOGICAL INRING(NT),ALLIN
- PARAMETER (MAXFUN=50000)
-C Set different precisions as no double precision routine on IBM
-#if defined(CERNLIB_DOUBLE)
- PARAMETER (TSTERR=1E-3)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- PARAMETER (TSTERR=1E-6)
-#endif
-C The roots of the test equations, second index=test number
- DATA (TEST(J,1),J=1,4) / ( 1, 0),(-1, 1),( 3,-2),( 5, 2) /
- DATA (TEST(J,2),J=1,4) / ( 3, 0),( 0, 0),( 0,-3),( 0,-3) /
- DATA (TEST(J,3),J=1,4) / ( 2, 1),( 2, 1),( 2, 1),( 6, 3) /
- DATA (TEST(J,4),J=1,4) / (-1,-3),( 1, 3),(-1, 3),( 3, 1) /
-
- CALL HEADER('C206',0)
-C Initialise maximum residues as zero
- RESMAX=0.0
-C N denotes the test number
- DO 100 N=1,NT
- WRITE(LOUT,'(/'' Test Number'',I3)') N
-C Get data for test number N in A vector
- CALL C206S1(TEST(1,N),NT,A)
- WRITE(LOUT,'('' After call to C206S1'')')
- WRITE(LOUT,'('' A:'',2X,4(F7.1,'','',F7.1))') A
- MODE=0
- CALL POLY2(A,NT,ROOT,R,MAXFUN,MODE)
- WRITE(LOUT,'('' Calculated Roots'',2(/1X,2F16.10,6X,2F16.10))')
- + (ROOT(J),J=1,NT)
- WRITE(LOUT,'('' Error Radii'',2X,4F16.10)') (R(J),J=1,NT)
- WRITE(LOUT,'('' Exact Roots'',2(/1X,2F16.10,6X,2F16.10))')
- + (TEST(J,N),J=1,NT)
-C Calculate the residues for the calculated root
- DO 40 I=1,NT
- SUM= A(NT+1)
- DO 30 K=1,NT
- SUM=SUM+( A(K)*(ROOT(I)**(5-K)) )
-30 CONTINUE
- RES(I)=MIN(999.0,ABS(SUM))
-C Calculate the maximum (absolute) residue
- IF(RES(I).GT.RESMAX) RESMAX=RES(I)
-40 CONTINUE
- WRITE(LOUT,'('' Residues'',3X,4F17.10)') (RES(I),I=1,NT)
-C Check if the disc centred on the calculated root encloses an
-C exact root when radius R is used
- ALLIN = .TRUE.
- DO 75 I=1,NT
- INRING(I)= .FALSE.
- DO 50 J=1,NT
- INRING(I)=INRING(I).OR.(ABS(ROOT(I)-TEST(J,N)).LE.R(I))
-50 CONTINUE
-C Check if Root I is contained in a disc
- IF (INRING(I)) THEN
- WRITE(LOUT,'('' Root'',I3,'' is contained in a disc'')')I
- ELSE
- WRITE(LOUT,'('' Root'',I3,'' is not in a disc'')') I
- ENDIF
- ALLIN = ALLIN.AND.INRING(I)
-75 CONTINUE
-C Check if all of roots for test N were inside a disc
-C
- IF (ALLIN) THEN
- WRITE(LOUT,'('' For test'',I3,'' all roots were in discs'')')N
- ELSE
- WRITE(LOUT,'('' For test'',I3,'' at least one root was'',
- + '' not contained in a disc'')') N
- ENDIF
-100 CONTINUE
- WRITE(LOUT,'('' Largest Residue was'',F17.9)') RESMAX
-C Check if all the residues for all the tests were OK
- IRC=ITEST('C206',RESMAX .LE. TSTERR)
- CALL PAGEND('C206')
- RETURN
- END
-
diff --git a/src/mathlib/gen/tests/c206s1.F b/src/mathlib/gen/tests/c206s1.F
deleted file mode 100644
index 41a429b..0000000
--- a/src/mathlib/gen/tests/c206s1.F
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: c206s1.F,v 1.1.1.1 1996/04/01 15:01:13 mclareni Exp $
-*
-* $Log: c206s1.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:13 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE C206S1(Z,NT,A)
-#include "iorc.inc"
-C This subroutine stores the data for test N in A
- COMPLEX Z(*),A(*)
-C Construct the polynomial coefficients
- A(1)=1.0
- A(2)= -( Z(1)+Z(2)+Z(3)+Z(4) )
- A(3)= (Z(1)*Z(2))+(Z(1)*Z(3))+(Z(1)*Z(4))+
- + (Z(2)*Z(3))+(Z(2)*Z(4))+(Z(3)*Z(4))
- A(4)= -( (Z(1)*Z(2)*Z(3))+(Z(1)*Z(2)*Z(4))+(Z(1)*Z(3)*Z(4))+
- + (Z(2)*Z(3)*Z(4)) )
- A(5)= Z(1)*Z(2)*Z(3)*Z(4)
- RETURN
- END
diff --git a/src/mathlib/gen/tests/c207m.F b/src/mathlib/gen/tests/c207m.F
deleted file mode 100644
index e388379..0000000
--- a/src/mathlib/gen/tests/c207m.F
+++ /dev/null
@@ -1,81 +0,0 @@
-*
-* $Id: c207m.F,v 1.1.1.1 1996/04/01 15:01:13 mclareni Exp $
-*
-* $Log: c207m.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:13 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE C207M
-#include "iorc.inc"
-C This program tests the MATHLIB routines RTEQ3 and DRTEQ3 (C207)
-C by prespecifying the roots of a cubic polynomial, and then
-C constructing the polynomial from these roots. The polynomial is
-C then solved using the library routine and the computed solutions
-C are compared with the analytic solutions.
-#include "gen/defc64.inc"
- + X(9,3),CALC(9,3),J
-#include "gen/def64.inc"
- + RES,RESMAX,TSTERR,R,S,T,SOL(3),D
-C Set maximum residue permitted for the test to still be successful
- PARAMETER ( TSTERR=1D-9,J=(0,1) )
-C Three real roots
- DATA X(1,1),X(1,2),X(1,3) /( 0, 0),( 0, 0),( 0, 0)/
- DATA X(2,1),X(2,2),X(2,3) /( 1, 0),( 1, 0),( 0, 0)/
- DATA X(3,1),X(3,2),X(3,3) /(-1, 0),(-2, 0),( 2, 0)/
- DATA X(4,1),X(4,2),X(4,3) /(10, 0),(30, 0),( 6, 0)/
- DATA X(5,1),X(5,2),X(5,3) /( 7, 0),( 7, 0),( 0, 0)/
-C One real,and a complex conjugate pair of roots
- DATA X(6,1),X(6,2),X(6,3) /( 1, 0),( 0, 1),( 0,-1)/
- DATA X(7,1),X(7,2),X(7,3) /( 0, 0),( 2, 3),( 2,-3)/
- DATA X(8,1),X(8,2),X(8,3) /(-4, 0),( 1, 6),( 1,-6)/
- DATA X(9,1),X(9,2),X(9,3) /(-9, 0),(-9, 5),(-9,-5)/
-
- CALL HEADER('C207',0)
-C Initialise maximum error term
- RESMAX=0
-
- DO 100 I=1,9
-C Construct the polynomial to be solved
-C R= -sum of roots
- R= -( X(I,1)+X(I,2)+X(I,3) )
-C S= sum of products of pairs of roots
- S= (( X(I,1)*X(I,2) ) + ( X(I,1)*X(I,3) ) + ( X(I,2)*X(I,3) ))
-C T= -product of roots
- T= -( X(I,1)*X(I,2)*X(I,3) )
-
-C Solve the polynomial
-#if defined(CERNLIB_DOUBLE)
- CALL DRTEQ3(R,S,T,SOL,D)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- CALL RTEQ3(R,S,T,SOL,D)
-#endif
-C Construct calculated solution in same form as original roots
- IF (D .LE. 0) THEN
-C Three real roots
- CALC(I,1)=SOL(1)
- CALC(I,2)=SOL(2)
- CALC(I,3)=SOL(3)
- ELSE
-C One real and a complex conjugate pair of roots
- CALC(I,1)=SOL(1)
- CALC(I,2)=SOL(2)+(J*SOL(3))
- CALC(I,3)=SOL(2)-(J*SOL(3))
- ENDIF
- WRITE(LOUT,'(/'' Test Number'',I4)') I
- WRITE(LOUT,'('' Descriminant'',F25.16)') D
- DO 50 K=1,3
-C Calculate the residue for the calculated root
- RES=ABS( (CALC(I,K)**3)+(R*CALC(I,K)**2)+(S*CALC(I,K))+T )
- WRITE(LOUT,'('' X('',I2,'' )'',2F20.16,3X,''Residue'',
- + F20.16)') K,CALC(I,K),RES
- RESMAX=MAX(RESMAX,RES)
-50 CONTINUE
-100 CONTINUE
- WRITE(LOUT,'('' Largest Residue was'',F20.16)') RESMAX
- IRC=ITEST('C207',RESMAX .LE. TSTERR)
- CALL PAGEND('C207')
- RETURN
- END
diff --git a/src/mathlib/gen/tests/c208m.F b/src/mathlib/gen/tests/c208m.F
deleted file mode 100644
index 9509443..0000000
--- a/src/mathlib/gen/tests/c208m.F
+++ /dev/null
@@ -1,96 +0,0 @@
-*
-* $Id: c208m.F,v 1.1.1.1 1996/04/01 15:01:13 mclareni Exp $
-*
-* $Log: c208m.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:13 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE C208M
-#include "iorc.inc"
-C This program tests the MATHLIB routines RTEQ4, DRETQ4 (C208)
-C by solving specially constructed polynomials.
-C Specify the total number of tests
- PARAMETER ( NT=6 )
-#include "gen/def64.inc"
- + A,B,C,D,DC,RESMAX,ERROR(4),ERRMAX,RESTOL,TSTERR,RESABS
-#include "gen/defc64.inc"
- + ROOT(NT,4),SOL(NT,4),Z1,Z2,Z3,Z4,Z(4),RES
-C Set maximum residue and maximum absolute error allowed for the
-C test to still be considered successful
- PARAMETER ( RESTOL=1D-10,TSTERR=1D-12 )
-
-C The test roots, the root order matches with order of calculation
- DATA (ROOT(1,J),J=1,4) /(3,0),(2,0),(0,1),(0,-1)/
- DATA (ROOT(2,J),J=1,4) /(8,0),(6,0),(1,1),(1,-1)/
- DATA (ROOT(3,J),J=1,4) /(1,0),(0, 0),(0,0),(0,0)/
- DATA (ROOT(4,J),J=1,4) /(1,1),(-1,-1),(-1,1),(1,-1)/
- DATA (ROOT(5,J),J=1,4) /(2,0),(-2,0),(0,2),(0,-2)/
-#if defined(CERNLIB_CMPXDOUB)
- DATA ROOT(6,1),ROOT(6,2)/ (1.54368901269207637D0,0D0),(-1D0,0D0)/
- DATA ROOT(6,3) /(0.228155493653961816D0, 1.11514250803993731D0)/
- DATA ROOT(6,4) /(0.228155493653961816D0,-1.11514250803993731D0)/
-#endif
-#if !defined(CERNLIB_CMPXDOUB)
- DATA ROOT(6,1),ROOT(6,2)/ (1.54368901269207637,0),(-1,0)/
- DATA ROOT(6,3) /(0.228155493653961816, 1.11514250803993731)/
- DATA ROOT(6,4) /(0.228155493653961816,-1.11514250803993731)/
-#endif
-C Declare residue calculating function
- RES(Z1)= (Z1**4)+(A*Z1**3)+(B*Z1**2)+(C*Z1)+D
-
- CALL HEADER('C208',0)
-C Initialise maximum residue and maximum absolute error
- RESMAX=0D0
- ERRMAX=0D0
- DO 100 I=1,NT
- WRITE(LOUT,'(/'' Test Number'',I3)') I
-C Use shorter names for roots (easier typing)
- Z1=ROOT(I,1)
- Z2=ROOT(I,2)
- Z3=ROOT(I,3)
- Z4=ROOT(I,4)
-C Calculate polynomial coefficients
- A= -(Z1+Z2+Z3+Z4)
- B= (Z1*Z2)+(Z1*Z3)+(Z1*Z4)+(Z2*Z3)+(Z2*Z4)+(Z3*Z4)
- C= -( (Z1*Z2*Z3)+(Z1*Z2*Z4)+(Z1*Z3*Z4)+(Z2*Z3*Z4) )
- D= Z1*Z2*Z3*Z4
-C Special case for test 6 we force values for A,B,C,D
-C Solution still contained in ROOT(6,J) but we require B=0,C=0
- IF (I .EQ. 6) THEN
- A=-1D0
- B=0D0
- C=0D0
- D=-2D0
- ENDIF
- WRITE(LOUT,'('' Roots '',8F8.1)') Z1,Z2,Z3,Z4
- WRITE(LOUT,'('' Coeffs'',4F8.1)') A,B,C,D
-C Solve the polynomials numerically
-#if defined(CERNLIB_DOUBLE)
- CALL DRTEQ4(A,B,C,D,Z,DC,MT)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- CALL RTEQ4(A,B,C,D,Z,DC,MT)
-#endif
-C Write the results
- DO 90 J=1,4
- SOL(I,J)=Z(J)
- WRITE(LOUT,'(/'' Calculated root'',2F25.16)') SOL(I,J)
-C Calculate absolute error
- ERROR(J)= ABS( SOL(I,J)-ROOT(I,J) )
- RESABS = ABS( RES(SOL(I,J)) )
- WRITE(LOUT,1000) ERROR(J),RESABS
- RESMAX=MAX( RESMAX,RESABS )
-90 CONTINUE
- ERRMAX=MAX( ERRMAX,ERROR(1),ERROR(2),ERROR(3),ERROR(4) )
-100 CONTINUE
- WRITE(LOUT,1001) ERRMAX,RESMAX
-C Check if the whole test of the routine was successful
- IRC=ITEST('C208',ERRMAX .LE. TSTERR .AND. RESMAX .LE. RESTOL)
- CALL PAGEND('C208')
- RETURN
-1000 FORMAT(' Absolute Error ',F25.16/' Residue',F33.16)
-1001 FORMAT(/' Largest Absolute Error was',F25.16/
- + ' Largest Residue was ',F25.16)
- END
diff --git a/src/mathlib/gen/tests/c209m.F b/src/mathlib/gen/tests/c209m.F
deleted file mode 100644
index c9d01a5..0000000
--- a/src/mathlib/gen/tests/c209m.F
+++ /dev/null
@@ -1,104 +0,0 @@
-*
-* $Id: c209m.F,v 1.1.1.1 1996/04/01 15:01:13 mclareni Exp $
-*
-* $Log: c209m.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:13 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE C209M
-C This program tests the MATHLIB routines CPOLYZ and WPOLYZ (C209)
-C by calculating the roots of specially constructed complex
-C polynomials.
- PARAMETER (NT=4)
-#include "gen/imp64.inc"
-#include "gen/defc64.inc"
- + TEST(NT,NT),A(0:NT),ROOT(NT),SUM
-C R is the estimated radius of a circle centered at a root
- DIMENSION R(NT),RES(NT)
- LOGICAL INR2(NT,NT)
- PARAMETER (MAXFUN=50000)
- PARAMETER (TSTERR=5D-8)
-#include "iorc.inc"
-
-C The roots of the test equations; second index=test number
- DATA (TEST(J,1),J=1,4) / ( 1 , 0 ),(-1 , 1 ),
- + ( 3 ,-2 ),( 5 , 2 ) /
- DATA (TEST(J,2),J=1,4) / ( 3 , 0 ),( 0 , 0 ),
- + ( 0 ,-3 ),( 0 ,-3 ) /
- DATA (TEST(J,3),J=1,4) / ( 2 , 1 ),( 2 , 1 ),
- + ( 2 , 1 ),( 6 , 3 ) /
- DATA (TEST(J,4),J=1,4) / (-1 ,-3 ),( 1 , 3 ),
- + (-1 , 3 ),( 3 , 1 ) /
-
- CALL HEADER('C209',0)
-C Initialise maximum residues as zero
- RESMAX=0.0E0
-C N denotes the test number
- DO 100 N=1,NT
- WRITE(LOUT,'(/'' Test Number'',I3)') N
-C Get data for test number N in A vector
-#if defined(CERNLIB_DOUBLE)
- CALL C209S (TEST(1,N),NT,A)
- WRITE(LOUT,'('' After call to C209S '')')
-#endif
-#if !defined(CERNLIB_DOUBLE)
- CALL C209S (TEST(1,N),NT,A)
- WRITE(LOUT,'('' After call to C209S '')')
-#endif
- WRITE(LOUT,'('' A:'',2X,4(F7.1,'','',F7.1))') A
- DO 10 I=1,NT
- ROOT(I)=(0 ,0 )
-10 CONTINUE
-#if defined(CERNLIB_DOUBLE)
- CALL WPOLYZ(A,NT,MAXFUN,ROOT,R)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- CALL CPOLYZ(A,NT,MAXFUN,ROOT,R)
-#endif
- WRITE(LOUT,'('' Calculated Roots'',2(/1X,2F16.10,6X,2F16.10))')
- + (ROOT(J),J=1,NT)
- WRITE(LOUT,'('' Error Radii'',2X,4F16.10)') (R(J),J=1,NT)
- WRITE(LOUT,'('' Exact Roots'',2(/1X,2F16.10,6X,2F16.10))')
- + (TEST(J,N),J=1,NT)
-C Calculate the residues for the calculated root
- DO 40 I=1,NT
- SUM= A(NT)
- DO 30 K=1,NT
- SUM=SUM+( A(K-1)*(ROOT(I)**(NT+1-K)) )
-30 CONTINUE
-#if defined(CERNLIB_CMPXDOUB)
- RES(I)=MIN(999.0D0,ABS(SUM))
-#endif
-#if !defined(CERNLIB_CMPXDOUB)
- RES(I)=MIN(999.0E0,ABS(SUM))
-#endif
-C Calculate the maximum (absolute) residue
- IF(RES(I).GT.RESMAX) RESMAX=RES(I)
-40 CONTINUE
- WRITE(LOUT,'('' Residues'',3X,4(D10.2))') (RES(I),I=1,NT)
-C Check if the disc centred on the calculated root encloses an
-C exact root when radius R is used
- DO 75 I=1,NT
- INR2(I,I)= .FALSE.
- DO 50 J=1,NT
- INR2(I,J)=INR2(I,J).OR.(ABS(ROOT(I)-TEST(J,N)).LE.R(I))
-C Check if Root I is contained in a disc
- IF (INR2(I,J)) THEN
- WRITE(LOUT,'('' Exact Root'',I3,'' is contained'',
- + '' in a disc of calculated root'',I3)')J,I
- ELSE
- WRITE(LOUT,'('' Exact Root'',I3,'' is not'',
- + '' in a disc of calculated root'',I3)') J,I
- ENDIF
-50 CONTINUE
-75 CONTINUE
-100 CONTINUE
- WRITE(LOUT,'(//'' Largest Residue was'',D10.2)') RESMAX
-C Check if all the residues for all the tests were OK
- IRC=ITEST('C209',RESMAX .LE. TSTERR)
- CALL PAGEND('C209')
- RETURN
- END
-
diff --git a/src/mathlib/gen/tests/c209s.F b/src/mathlib/gen/tests/c209s.F
deleted file mode 100644
index 1df6c3b..0000000
--- a/src/mathlib/gen/tests/c209s.F
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: c209s.F,v 1.1.1.1 1996/04/01 15:01:13 mclareni Exp $
-*
-* $Log: c209s.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:13 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE C209S(Z,NT,A)
-#include "iorc.inc"
-C This subroutine stores the data for test N in A
-#include "gen/defc64.inc"
- + Z(*),A(0:*)
-C Construct the polynomial coefficients
-#if defined(CERNLIB_DOUBLE)
- A(0)=1.0D0
-#endif
-#if !defined(CERNLIB_DOUBLE)
- A(0)=1.0E0
-#endif
- A(1)= -( Z(1)+Z(2)+Z(3)+Z(4) )
- A(2)= (Z(1)*Z(2))+(Z(1)*Z(3))+(Z(1)*Z(4))+
- + (Z(2)*Z(3))+(Z(2)*Z(4))+(Z(3)*Z(4))
- A(3)= -( (Z(1)*Z(2)*Z(3))+(Z(1)*Z(2)*Z(4))+(Z(1)*Z(3)*Z(4))+
- + (Z(2)*Z(3)*Z(4)) )
- A(4)= Z(1)*Z(2)*Z(3)*Z(4)
- RETURN
- END
diff --git a/src/mathlib/gen/tests/c210m.F b/src/mathlib/gen/tests/c210m.F
deleted file mode 100644
index 624484c..0000000
--- a/src/mathlib/gen/tests/c210m.F
+++ /dev/null
@@ -1,152 +0,0 @@
-*
-* $Id: c210m.F,v 1.1.1.1 1996/04/01 15:01:13 mclareni Exp $
-*
-* $Log: c210m.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:13 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE C210M
-#include "gen/imp64.inc"
-C This program tests the MATHLIB routine NZERFZ by calculating the
-C number of zeros of complex functions.
-
-#include "gen/defc64.inc"
- + I,Z0,Z(4),F1,F2,F3,F4
- DIMENSION NK(50),NEX(4,50),NERROR(4,50)
-C Specify the largest absolute error allowed for a successful test
- PARAMETER (NTSTERR=1D-13 )
- EXTERNAL F1,F2,F3,F4
-#include "iorc.inc"
- COMMON /NDNDND/ N
-
- DATA NEX(1,1)/6/
- DATA NEX(2,1)/2/
- DATA NEX(3,1)/16/
- DATA (NEX(4,J),J=1,10)/
- + 1 , 2 , 3 , 4 , 5 , 6 , 7 , 8 , 9 , 10/
- DATA (NEX(4,J),J=11,20)/
- + 11 , 12 , 13 , 14 , 15 , 16 , 17 , 18 , 19 , 20/
- DATA (NEX(4,J),J=21,30)/
- + 21 , 22 , 23 , 24 , 25 , 26 , 27 , 28 , 29 , 30/
- DATA (NEX(4,J),J=31,40)/
- + 31 , 32 , 33 , 34 , 35 , 36 , 37 , 38 , 39 , 40/
- DATA (NEX(4,J),J=41,50)/
- + 41 , 42 , 43 , 44 , 45 , 46 , 47 , 48 , 49 , 50/
- NERRMAX= 0
- CALL HEADER('C210',0)
-C N denotes the test number
- Numb=1
- WRITE(LOUT,'(/'' Test Number'',I3)') Numb
- I=(0 ,1 )
- Z(1)=-6-6*I
- Z(2)=+6-6*I
- Z(3)=+6+6*I
- Z(4)=-6+6*I
- NZS=NZERFZ(F1,Z,4)
- NERROR(1,1)=ABS( NEX(1,1)-NZS )
- NERRMAX= MAX( NERRMAX,NERROR(1,1) )
- WRITE(LOUT,101) NZS
-
- Numb=2
- WRITE(LOUT,'(/'' Test Number'',I3)') Numb
- Z(1)=0-1*I
- Z(2)=3-1*I
- Z(3)=3-2.6*I
- NZS=NZERFZ(F2,Z,3)
- NERROR(2,1)=ABS( NEX(2,1)-NZS )
- NERRMAX= MAX( NERRMAX,NERROR(2,1) )
- WRITE(LOUT,102) NZS
-
- Numb=3
- WRITE(LOUT,'(/'' Test Number'',I3)') Numb
- Z(1)=-15.1D0+0.1D0*I
- Z(2)=-15.1D0-0.1D0*I
- Z(3)=+1-0.1D0*I
- Z(4)=+1+0.1D0*I
- NZS=NZERFZ(F3,Z,4)
- NERROR(3,1)=ABS( NEX(3,1)-NZS )
- NERRMAX= MAX( NERRMAX,NERROR(3,1) )
- WRITE(LOUT,103) NZS
-
- Numb=4
- WRITE(LOUT,'(/'' Test Number'',I3)') Numb
- WRITE(LOUT,104)
- Z0=1.01D0
- Z(1)=-Z0-Z0*I
- Z(2)=+Z0-Z0*I
- Z(3)=+Z0+Z0*I
- Z(4)=-Z0+Z0*I
- DO 1 N = 1,50
- NK(N)=NZERFZ(F4,Z,4)
- NERROR(4,N)=ABS( NEX(4,N)-NK(N) )
- 1 NERRMAX= MAX( NERRMAX,NERROR(4,N) )
- WRITE(LOUT,'(1X,5X,10I5)') (NK(N),N=1,50)
-
- Numb=5
- WRITE(LOUT,'(/'' Test Number'',I3)') Numb
- WRITE(LOUT,'(1X)')
- WRITE(LOUT,'(/'' TESTING ERROR MESSAGES:''/)')
- Z(1)=+0.1D0*I
- Z(2)=-0.2D0*I
- Z(3)=+1-0.1D0*I
- Z(4)=+1+0.1D0*I
- NZS=NZERFZ(F3,Z,4)
- WRITE(LOUT,'(1X,I5)') NZS
-
- 101 FORMAT(1X,I5,5X,'Zeros of J1(z)**2-J0(z)*J2(z) in '
- 1/7X,'(-6,6),(+6,-6),(+6,+6),(-6,+6)'//)
- 102 FORMAT(1X,I5,5X,'Zeros of the complex error function w(z) in '
- 1/7X,'(0,-1),(3,-1),(3,-2.6)'//)
- 103 FORMAT(1X,I5,5X,'Zeros of the reciprocal gamma function in '
- 1/7X,'(-15.1,+0.1),(-15.1,-0.1),(1,-0.1),(1,+0.1)'//)
- 104 FORMAT(1X,5X,5X,'Zeros of z**n - 1 in '
- 1/7X,'(-Z0,-Z0),(+Z0,-Z0),(+Z0,+Z10),(-Z0,+Z0)',
- 2 ' Z0 = 1.01'/)
- WRITE(LOUT,'(/'' Largest Absolute Error was'',I5)') NERRMAX
- IRC=ITEST('C210',NERRMAX .LE. NTSTERR)
- CALL PAGEND('C210')
- RETURN
- END
- FUNCTION F(Z)
-#include "gen/impc64.inc"
-#include "gen/def64.inc"
- + R0
- COMMON /NDNDND/ N
- DIMENSION CB(0:2)
-
- PARAMETER (R0 = 0)
-
- ENTRY F1(Z)
-#if defined(CERNLIB_DOUBLE)
- CALL WBSJA(Z,R0,2,10,CB)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- CALL CBSJA(Z,R0,2,10,CB)
-#endif
- F1=CB(1)**2-CB(0)*CB(2)
- RETURN
-
- ENTRY F2(Z)
-#if defined(CERNLIB_DOUBLE)
- F2=WWERF(Z)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- F2=CWERF(Z)
-#endif
- RETURN
-
- ENTRY F3(Z)
-#if defined(CERNLIB_DOUBLE)
- F3=1/WGAMMA(Z)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- F3=1/CGAMMA(Z)
-#endif
- RETURN
-
- ENTRY F4(Z)
- F4=Z**N-1
- RETURN
- END
diff --git a/src/mathlib/gen/tests/c300m.F b/src/mathlib/gen/tests/c300m.F
deleted file mode 100644
index de86dc7..0000000
--- a/src/mathlib/gen/tests/c300m.F
+++ /dev/null
@@ -1,131 +0,0 @@
-*
-* $Id: c300m.F,v 1.2 1999/09/24 14:55:52 mclareni Exp $
-*
-* $Log: c300m.F,v $
-* Revision 1.2 1999/09/24 14:55:52 mclareni
-* Add external erf,erfc,derf,derfc to test Cernlib versions, but it may not be enough on all systems
-*
-* Revision 1.1.1.1 1996/04/01 15:01:13 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE C300M
-
-C Routine to test MATHLIB routines ERF, ERFC, DERF, and DERFC (C300)
-
-#include "imp64r.inc"
- REAL ERF,ERFC,SFERF,GAUSS
-C Set maximum error allowed for test to be considered successful
- DIMENSION TOL(2),TOLIBM(2)
-
-#include "gen/def64.inc"
- + X,Z0,Z1
-
- LOGICAL LTEST
- EXTERNAL FERF,SFERF,GAUSS
- EXTERNAL ERF, ERFC, DERF, DERFC
- PARAMETER (Z0 = 0, Z1 = 1)
-#include "iorc.inc"
- DATA LTEST/.TRUE./
- DATA TOLIBM/5D-6, 1D-13/
- DATA TOL/5D-6, 5D-14/
-
-C PI=4*ATAN(Z1)
- PI = 3.14159 26535 89793D0
- EPS=1D-15
- REPS=1D-7
-
- CALL HEADER('C300',0)
-
-#if defined(CERNLIB_DOUBLE)
- NF=2
-#endif
-#if !defined(CERNLIB_DOUBLE)
- NF=1
-#endif
- DO 1000 JF=1,NF
- ERRMAX= 0.0D0
-#if !defined(CERNLIB_DOUBLE)
- WRITE(LOUT,'(/10X,''TEST FOR ERF and ERFC'')')
- WRITE(LOUT,'(/9X,''X'',14x,''ERF'',22X,''ERFC'',19X,
- +''ERF+ERFC'',9X,''Error'')')
-#endif
-#if defined(CERNLIB_DOUBLE)
- IF(JF.EQ.1)WRITE(LOUT,'(/10X,''TEST FOR ERF and ERFC'')')
- IF(JF.EQ.1)
- +WRITE(LOUT,'(/9X,''X'',14x,''ERF'',22X,''ERFC'',19X,
- +''ERF+ERFC'',9X,''Error'')')
- IF(JF.EQ.2)WRITE(LOUT,'(/10X,''TEST FOR DERF and DERFC'')')
- IF(JF.EQ.2)
- +WRITE(LOUT,'(/9X,''X'',13x,''DERF'',21X,''DERFC'',19X,
- +''DERF+DERFC'',9X,''Error'')')
-#endif
-
- DO 1 I = -80,80
- X=I/10D0
-#if !defined(CERNLIB_DOUBLE)
- F=ERF(X)
- FC=ERFC(X)
- T=(2/SQRT(PI))*GAUSS(SFERF,Z0,X,EPS*ABS(F))
- DR=0
- IF(F .NE. 0) DR=ABS((F-T)/F)
- ERRMAX= MAX( ERRMAX,DR )
-#endif
-#if defined(CERNLIB_DOUBLE)
- IF(JF.EQ.1)THEN
- RX=X
- RZ0=Z0
- RF=ERF(RX)
- RFC=ERFC(RX)
- RT=(2/SQRT(PI))*GAUSS(SFERF,RZ0,RX,REPS*ABS(RF))
- RDR=0
- IF(RF .NE. 0) RDR=ABS((RF-RT)/RT)
- RERRMAX= ERRMAX
- ERRMAX= MAX(RERRMAX,RDR )
- RX=X
- F=RF
- FC=RFC
- DR=RDR
- ENDIF
- IF(JF.EQ.2)THEN
- F=DERF(X)
- FC=DERFC(X)
- T=(2/SQRT(PI))*DGAUSS(FERF,Z0,X,EPS*ABS(F))
- DR=0
- IF(F .NE. 0) DR=DABS((F-T)/F)
- ERRMAX= MAX( ERRMAX,DR )
- ENDIF
-#endif
-
- 1 WRITE(LOUT,'(1X,F10.1,2D25.15,F25.15,1P,D10.1)') X,F,FC,F+FC,DR
-
-#if !defined(CERNLIB_DOUBLE)
- ETOL=TOL(JF+1)
-#endif
-#if defined(CERNLIB_DOUBLE)||defined(CERNLIB_IBM)||defined(CERNLIB_IBMRT)||defined(CERNLIB_IBMAIX)
- ETOL=TOLIBM(JF)
-#endif
-#if (defined(CERNLIB_DOUBLE))&&(!defined(CERNLIB_IBM))&&(!defined(CERNLIB_IBMRT))&&(!defined(CERNLIB_IBMAIX))
- ETOL=TOL(JF)
-#endif
- WRITE(LOUT,'(/'': Largest Absolute Error was'',
- + 1P,D10.1)')ERRMAX
- LTEST=LTEST.AND.(ERRMAX.LE.ETOL)
- ERRMAX= 0D0
-
-1000 CONTINUE
- IRC=ITEST('C300',LTEST)
- CALL PAGEND('C300')
- END
- FUNCTION FERF(T)
-#include "gen/imp64.inc"
-
- FERF=EXP(-T**2)
- RETURN
- END
- FUNCTION SFERF(T)
-
- SFERF=EXP(-T**2)
- RETURN
- END
diff --git a/src/mathlib/gen/tests/c301m.F b/src/mathlib/gen/tests/c301m.F
deleted file mode 100644
index e6993c3..0000000
--- a/src/mathlib/gen/tests/c301m.F
+++ /dev/null
@@ -1,129 +0,0 @@
-*
-* $Id: c301m.F,v 1.1.1.1 1996/04/01 15:01:13 mclareni Exp $
-*
-* $Log: c301m.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:13 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE C301M
-
-C Routine to test MATHLIB routines FREQ and DFREQ (C301)
-
-#include "imp64r.inc"
- REAL FREQ,SFFREQ,GAUSS
-C Set maximum error allowed for test to be considered successful
- DIMENSION TOL(2)
-
- LOGICAL LTEST
- EXTERNAL FFREQ,SFFREQ,GAUSS
-
-#include "gen/def64.inc"
- + X,Z0,Z1
- PARAMETER (Z0 = 0, Z1 = 1)
- CHARACTER*(*) PNAME
- PARAMETER(PNAME='C301')
-#include "iorc.inc"
- DATA LTEST/.TRUE./
- DATA TOL/1D-4, 5D-13/
-
-
-C PI=4*ATAN(Z1)
- PI = 3.14159 26535 89793D0
- EPS=1D-15
- REPS=1E-7
-
- CALL HEADER(PNAME,0)
-#if defined(CERNLIB_DOUBLE)
- NF=2
-#endif
-#if !defined(CERNLIB_DOUBLE)
- NF=1
-#endif
- DO 1000 JF=1,NF
- ERRMAX= 0.0D0
-#if !defined(CERNLIB_DOUBLE)
- WRITE(LOUT,'(/10X,''TEST FOR FREQ'')')
-#endif
-#if defined(CERNLIB_DOUBLE)
- IF(JF.EQ.1)THEN
- WRITE(LOUT,'(/10X,''TEST FOR FREQ'')')
- WRITE(LOUT,'(/9X,''X'',13x,''FREQ'',21X,''TEST'',
- +13X,''Error'')')
- ENDIF
- IF(JF.EQ.2)THEN
- WRITE(LOUT,'(/10X,''TEST FOR DFREQ'')')
- WRITE(LOUT,'(/9X,''X'',13x,''DFREQ'',21X,''TEST'',
- +13X,''Error'')')
- ENDIF
-#endif
- ERRMAX =0D0
- DO 1 I = -80,80
- X=I/10D0
-#if !defined(CERNLIB_DOUBLE)
- FQ=FREQ(X)
- U=10
- IF(X .LT. -5) U=15
- TQ=(1/SQRT(2*PI))*GAUSS(SFFREQ,-U,X,EPS*ABS(FQ))
- DRQ=0
- IF (FQ .NE. 0D0) DRQ=ABS((FQ-TQ)/FQ)
- ERRMAX= MAX( ERRMAX,DRQ)
- WRITE(LOUT,'(1X,F10.1,2D25.7,1P,E10.1)') X,FQ,TQ,DRQ
-#endif
-#if defined(CERNLIB_DOUBLE)
- IF(JF.EQ.1)THEN
- RX=X
- RZ1=Z1
- RFQ=FREQ(RX)
- RU=10*RZ1
- RTQ=(1/SQRT(2*PI))*GAUSS(SFFREQ,-RU,RX,REPS*ABS(RFQ))
- RDRQ=0
- IF (RFQ .NE. 0E0) RDRQ=ABS((RFQ-RTQ)/RFQ)
- X=RX
- FQ=RFQ
- TQ=RTQ
- DRQ=RDRQ
- RERRMAX= ERRMAX
- ERRMAX= MAX(RERRMAX,RDRQ)
- WRITE(LOUT,'(1X,F10.1,2E25.7,1P,E10.1)') X,FQ,TQ,DRQ
- ENDIF
- IF(JF.EQ.2)THEN
- FQ=DFREQ(X)
- U=10
- IF(X .LT. -5) U=15
- TQ=(1/SQRT(2*PI))*DGAUSS(FFREQ,-U,X,EPS*ABS(FQ))
- DRQ=0
- IF (FQ .NE. 0D0) DRQ=ABS((FQ-TQ)/FQ)
- ERRMAX= MAX( ERRMAX,DRQ)
- WRITE(LOUT,'(1X,F10.1,2D25.7,1P,E10.1)') X,FQ,TQ,DRQ
- ENDIF
-#endif
- 1 CONTINUE
-
-#if !defined(CERNLIB_DOUBLE)
- ETOL=TOL(JF+1)
-#endif
-#if defined(CERNLIB_DOUBLE)
- ETOL=TOL(JF)
-#endif
- WRITE(LOUT,'(/''Largest Relative Error was'',
- +1P,D10.1)') ERRMAX
- LTEST=LTEST.AND.(ERRMAX.LE.ETOL)
- ERRMAX= 0D0
-1000 CONTINUE
-C Check if the test was successful
- IRC=ITEST('C301',LTEST)
- CALL PAGEND(PNAME)
- END
- FUNCTION FFREQ(T)
-#include "gen/imp64.inc"
-
- FFREQ=EXP(-T**2/2)
- RETURN
- END
- FUNCTION SFFREQ(T)
-
- SFFREQ=EXP(-T**2/2)
- RETURN
- END
diff --git a/src/mathlib/gen/tests/c302m.F b/src/mathlib/gen/tests/c302m.F
deleted file mode 100644
index 0b30b1b..0000000
--- a/src/mathlib/gen/tests/c302m.F
+++ /dev/null
@@ -1,121 +0,0 @@
-*
-* $Id: c302m.F,v 1.1.1.1 1996/04/01 15:01:13 mclareni Exp $
-*
-* $Log: c302m.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:13 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE C302M
-C Program to test the MATHLIB routines GAMMA, DGAMMA and
-C QGAMMA (C302)
-
- LOGICAL LTEST, LTEST1,LTEST2
- COMMON /C302LT1/LTEST1
-#if defined(CERNLIB_QUAD)
- COMMON /C302LT2/LTEST2
-#endif
-#include "iorc.inc"
- CALL HEADER('C302',0)
- LTEST=.TRUE.
- LTEST1=.TRUE.
- LTEST2=.TRUE.
- CALL C302D
- LTEST=LTEST .AND. LTEST1
-#if defined(CERNLIB_QUAD)
- CALL C302Q
- LTEST=LTEST .AND. LTEST2
-#endif
- IRC=ITEST('C302',LTEST)
- CALL PAGEND('C302')
- RETURN
- END
- SUBROUTINE C302D
-
-#include "gen/imp64.inc"
-
- REAL GAMMA
- CHARACTER*6 TFUNC(2)
-#include "iorc.inc"
-C
- PARAMETER (HALF = 5D-1, PI=3.14159 26535 89793 24D0)
- DIMENSION C(0:20)
- LOGICAL LTEST1
- DIMENSION TOL(2)
- COMMON /C302LT1/LTEST1
-C
-C Set maximum error allowed for test to be considered successful
-C
-#if (!defined(CERNLIB_IBMVM))&&(!defined(CERNLIB_IBMRT))
- DATA TOL/1D-6, 5D-14/
-#endif
-#if defined(CERNLIB_IBMVM)||defined(CERNLIB_IBMRT)
- DATA TOL/1D-4, 1D-14/
-#endif
-
- DATA TFUNC/'GAMMA','DGAMMA'/
- LTEST1=.TRUE.
-
- C(0)=1
- DO 2 N = 1,20
- 2 C(N)=(2*N-1)*C(N-1)/2
-
-#if defined(CERNLIB_DOUBLE)
- NF=2
-#endif
-#if !defined(CERNLIB_DOUBLE)
- NF=1
-#endif
- DO 1000 JF=1,NF
- ERRMAX= 0.0D0
- RERRMAX= 0.0E0
- WRITE(LOUT,'(/10X,''Test of C302 '',A)') TFUNC(JF)
- WRITE(LOUT,'(/9X,''X '',7X,''Exact'',25X,''Calculated'',
- + 14X,''Rel. Error'')')
-
- DO 1 N = 1,20
- X=N+HALF
- T=C(ABS(N))*SQRT(PI)
-#if !defined(CERNLIB_DOUBLE)
- DR=GAMMA(X)
- IF(DR .NE. 0) ER=ABS((DR-T)/DR)
- WRITE(LOUT,'(1X,F10.1,2E27.18,5X,E10.1)') X,T,DR,ER
-#endif
-#if defined(CERNLIB_DOUBLE)
- IF(JF.EQ.1) THEN
- DR=GAMMA( SNGL(X) )
- IF(DR .NE. 0) ER=ABS(SNGL(DR-T)/SNGL(DR) )
- WRITE(LOUT,'(1X,F10.1,2E27.9,5X,E10.1)')
- + SNGL(X),SNGL(T),SNGL(DR),SNGL(ER)
-
- ENDIF
- IF(JF.EQ.2) THEN
- DR=DGAMMA(X)
- IF(DR .NE. 0) ER=ABS((DR-T)/DR)
- WRITE(LOUT,'(1X,F10.1,2E27.18,5X,E10.1)') X,T,DR,ER
- ENDIF
-#endif
- ERRMAX= MAX( ERRMAX,ER )
- 1 CONTINUE
-#if !defined(CERNLIB_DOUBLE)
- ETOL=TOL(JF+1)
-#endif
-#if defined(CERNLIB_DOUBLE)
- ETOL=TOL(JF)
-#endif
- WRITE(LOUT,'(/''Largest relative error was'',E10.1)') ERRMAX
- LTEST1=LTEST1.AND.(ERRMAX.LE.ETOL)
-
- WRITE(LOUT,'(/''Testing error messages:'')')
-#if !defined(CERNLIB_DOUBLE)
- DR=GAMMA(-HALF)
-#endif
-#if defined(CERNLIB_DOUBLE)
- IF(JF.EQ.1) DR=GAMMA(-SNGL(HALF))
- IF(JF.EQ.2) DR=DGAMMA(-HALF)
-#endif
-1000 CONTINUE
- RETURN
- END
-
diff --git a/src/mathlib/gen/tests/c302q.F b/src/mathlib/gen/tests/c302q.F
deleted file mode 100644
index 66cf525..0000000
--- a/src/mathlib/gen/tests/c302q.F
+++ /dev/null
@@ -1,70 +0,0 @@
-*
-* $Id: c302q.F,v 1.1.1.1 1996/04/01 15:01:13 mclareni Exp $
-*
-* $Log: c302q.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:13 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_QUAD)
- SUBROUTINE C302Q
-#include "gen/imp128.inc"
- LOGICAL LTEST2
-
- DIMENSION C(0:20)
- CHARACTER*6 TFUNC
-
- PARAMETER (Z1 = 1)
- COMMON /C302LT2/LTEST2
-#include "iorc.inc"
-
-#if defined(CERNLIB_DOUBLE)
- DATA TFUNC/'QGAMMA'/
-#endif
-#if !defined(CERNLIB_DOUBLE)
- DATA TFUNC/'DGAMMA'/
-#endif
- LTEST2=.TRUE.
-#if defined(CERNLIB_DOUBLE)
- ETOL=1Q-31
- PI = 3.14159 26535 89793 23846 26433 83279 50Q0
- ERMAX= 0.0Q0
- WRITE(LOUT,'(/10X,''Test of C302 '',A)') TFUNC
-#endif
-#if !defined(CERNLIB_DOUBLE)
- ETOL=1D-28
- PI = 3.14159 26535 89793 23846 26433 83279 50D0
- ERMAX= 0.0D0
- WRITE(LOUT,'(/10X,''Test of C302 '',A)') TFUNC
-#endif
- WRITE(LOUT,'(/9X,''X '',7X,''Exact'',28X,''Calculated'',
- + 18X,''Rel. Error'')')
- C(0)=1
- DO 2 N = 1,20
- 2 C(N)=(2*N-1)*C(N-1)/2
- DO 1 N = 0,20
- X=N+Z1/2
- T=C(ABS(N))*SQRT(PI)
-#if defined(CERNLIB_DOUBLE)
- R=QGAMMA(X)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- R=DGAMMA(X)
-#endif
- IF(R .NE. 0) ER=ABS((R-T)/R)
- ERMAX= MAX( ERMAX,ER )
- WRITE(LOUT,'(1X,F10.1,2E40.32,5X,1P,E10.1)') X,T,R,ER
- 1 CONTINUE
- WRITE(LOUT,'(/''Largest relative error was'',E10.1)') ERMAX
- LTEST2=LTEST2.AND.(ERMAX.LE.ETOL)
- WRITE(LOUT,'(/''Testing error messages:'')')
-#if defined(CERNLIB_DOUBLE)
- R=QGAMMA(-Z1/2)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- R=DGAMMA(-Z1/2)
-#endif
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/tests/c303m.F b/src/mathlib/gen/tests/c303m.F
deleted file mode 100644
index 8d10b8d..0000000
--- a/src/mathlib/gen/tests/c303m.F
+++ /dev/null
@@ -1,102 +0,0 @@
-*
-* $Id: c303m.F,v 1.1.1.1 1996/04/01 15:01:14 mclareni Exp $
-*
-* $Log: c303m.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:14 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE C303M
-C Program to test the MATHLIB routines GAMMF and DGAMMF (C303)
-
-#include "imp64r.inc"
- REAL GAMMF
-C Set maximum error allowed for test to be considered successful
- DIMENSION TOL(2)
-
-#include "gen/def64.inc"
- + Z1,X,C
- LOGICAL LTEST
- PARAMETER (Z1 = 1)
- DIMENSION C(0:20)
-#include "iorc.inc"
- DATA TOL/1D-6, 5D-14/
- DATA LTEST/.TRUE./
- CALL HEADER('C303',0)
-
- PI = 3.14159 26535 89793D0
- C(0)=1
- DO 2 N = 1,20
- 2 C(N)=(2*N-1)*C(N-1)/2
-#if defined(CERNLIB_DOUBLE)
- NF=2
-#endif
-#if !defined(CERNLIB_DOUBLE)
- NF=1
-#endif
- DO 1000 JF=1,NF
- ERRMAX= 0.0D0
-#if !defined(CERNLIB_DOUBLE)
- WRITE(LOUT,'(/10X,''TEST FOR GAMMF'')')
- WRITE(LOUT,'(/9X,''X '',7X,''EXACT'',20X,''GAMMF'',
- + 13X,''Rel. Error'')')
-#endif
-#if defined(CERNLIB_DOUBLE)
- IF(JF.EQ.1)WRITE(LOUT,'(/10X,''TEST FOR GAMMF'')')
- IF(JF.EQ.2)WRITE(LOUT,'(/10X,''TEST FOR DGAMMF'')')
- WRITE(LOUT,'(/9X,''X '',7X,''EXACT'',17X,''CALCULATED'',
- + 13X,''Rel. Error'')')
-#endif
- DO 1 N = -3,20
- IF(N .EQ. 0) GO TO 1
- X=N+Z1/2
- T=C(ABS(N))*SQRT(PI)
- IF(X .LT. 0) T=PI/(SIN(PI*X)*T)
-#if !defined(CERNLIB_DOUBLE)
- DR=GAMMF(X)
- IF(DR .NE. 0) ER=ABS((DR-T)/DR)
-#endif
-#if defined(CERNLIB_DOUBLE)
- IF(JF.EQ.1)THEN
- RT=T
- RX=X
- DR=GAMMF(RX)
- IF(DR .NE. 0) ER=ABS((DR-RT)/DR)
- X=RX
- T=RT
- ENDIF
- IF(JF.EQ.2)THEN
- DR=DGAMMF(X)
- IF(DR .NE. 0) ER=ABS((DR-T)/DR)
- ENDIF
-#endif
- ERRMAX= MAX( ERRMAX,ER )
- WRITE(LOUT,'(1X,F10.1,2D25.15,D10.1)') X,T,DR,ER
- 1 CONTINUE
-#if !defined(CERNLIB_DOUBLE)
- ETOL=TOL(JF+1)
-#endif
-#if defined(CERNLIB_DOUBLE)
- ETOL=TOL(JF)
-#endif
- WRITE(LOUT,'(/''LARGEST RELATIVE ERROR WAS'',1P,D10.1)')
- +ERRMAX
- LTEST=LTEST.AND.(ERRMAX.LE.ETOL)
- ERRMAX= 0D0
- WRITE(LOUT,'(/''TESTING ERROR MESSAGES:'')')
-#if !defined(CERNLIB_DOUBLE)
- DR=GAMMF(-Z1)
-#endif
-#if defined(CERNLIB_DOUBLE)
- IF(JF.EQ.1)THEN
- RZ1=Z1
- DR=GAMMF(-RZ1)
- ENDIF
- IF(JF.EQ.2)DR=DGAMMF(-Z1)
-#endif
-1000 CONTINUE
-C Check if the test was successful
- IRC=ITEST('C303',LTEST)
- CALL PAGEND('C303')
- END
diff --git a/src/mathlib/gen/tests/c304m.F b/src/mathlib/gen/tests/c304m.F
deleted file mode 100644
index 16663b7..0000000
--- a/src/mathlib/gen/tests/c304m.F
+++ /dev/null
@@ -1,79 +0,0 @@
-*
-* $Id: c304m.F,v 1.1.1.1 1996/04/01 15:01:14 mclareni Exp $
-*
-* $Log: c304m.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:14 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE C304M
-#include "iorc.inc"
-C Program to test the MATHLIB routines DILOG and DDILOG (C304)
-
- REAL DILOG
-#include "gen/def64.inc"
- + DDILOG
-#include "gen/def64.inc"
- + DX(8),DTST(8),DD,ERR
- LOGICAL LER,LET
-C Error tolerances for successful tests
- DATA D,DD /1.0E-5,2.0D-15/
-
- DATA DX /-5.0D0,-1.9D0,-1.0D0,-0.8D0,-0.4D0,0.9D0,1.0D0,10.0D0/
-
- DATA DTST(1) /-0.27492 79126 06080 8D+1/
- DATA DTST(2) /-0.13812 66904 63337 9D+1/
- DATA DTST(3) /-0.82246 70334 24113 2D+0/
- DATA DTST(4) /-0.67978 15878 34681 1D+0/
- DATA DTST(5) /-0.36583 25775 12449 6D+0/
- DATA DTST(6) / 0.12997 14723 00495 9D+1/
- DATA DTST(7) / 0.16449 34066 84822 6D+1/
- DATA DTST(8) / 0.53630 12873 57862 7D+0/
-
- CALL HEADER('C304',0)
- LET=.FALSE.
- WRITE(LOUT,99)
- DO 1 IX = 1,7
-#if defined(CERNLIB_DOUBLE)
- ERR=ABS( DILOG(SNGL(DX(IX)))-SNGL(DTST(IX)) )
- LER= ERR .GT. D
- WRITE(LOUT,200) DX(IX),DILOG(SNGL(DX(IX))),SNGL(DTST(IX)),ERR
-#endif
-#if !defined(CERNLIB_DOUBLE)
- ERR=ABS( DILOG(DX(IX))-DTST(IX) )
- LER=ERR .GT. D
- WRITE(LOUT,200) DX(IX),DILOG(DX(IX)),DTST(IX),ERR
-#endif
- LET=LET .OR. LER
- IF (LER) WRITE(LOUT,100) DX(IX)
- 1 CONTINUE
-
- IF(.NOT.LET) WRITE(LOUT,101)
-
-C Don't test DDILOG if double precision isn't being used
-#if defined(CERNLIB_DOUBLE)
- WRITE(LOUT,*) 'TESTING DDILOG'
- WRITE(LOUT,99)
- LET=.FALSE.
- DO 2 IX = 1,7
- ERR=ABS ( DDILOG(DX(IX))-DTST(IX) )
- LER=ERR .GT. DD
- LET=LET .OR. LER
- WRITE(LOUT,200) DX(IX),DDILOG(DX(IX)),DTST(IX),ERR
- IF (LER) WRITE (6,102) DX(IX)
- 2 CONTINUE
- IF(.NOT.LET) WRITE(LOUT,103)
-#endif
-C Check if the test was successful
- IRC=ITEST('C304',.NOT. LET)
- CALL PAGEND('C304')
-
- 99 FORMAT(8X,'X',15X,'Calculated',18X,'Exact',9X,'Absolute Error')
- 100 FORMAT(1X,'C304 DILOG TEST FAILED FOR X = ',F6.1)
- 101 FORMAT(1X,'C304 DILOG TEST SUCCESSFUL')
- 102 FORMAT(1X,'C304 DDILOG TEST FAILED FOR X = ',F6.1)
- 103 FORMAT(1X,'C304 DDILOG TEST SUCCESSFUL')
- 200 FORMAT(1X,F8.2,2X,3F23.16)
-
- END
diff --git a/src/mathlib/gen/tests/c306m.F b/src/mathlib/gen/tests/c306m.F
deleted file mode 100644
index 7dcb89e..0000000
--- a/src/mathlib/gen/tests/c306m.F
+++ /dev/null
@@ -1,79 +0,0 @@
-*
-* $Id: c306m.F,v 1.1.1.1 1996/04/01 15:01:14 mclareni Exp $
-*
-* $Log: c306m.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:14 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE C306M
-#include "iorc.inc"
-C This program tests the operation of MATHLIB routines
-C CGAMMA and WGAMA(C306)
-C Set the number of tests
- PARAMETER ( NT=6)
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION ERROR(NT),ERRMAX
- COMPLEX*16 Z(NT),WGAMMA,EXACT(NT),SOL(NT)
- COMPLEX CGAMMA
-#endif
-#if !defined(CERNLIB_DOUBLE)
- REAL ERROR(NT),ERRMAX
- COMPLEX Z(NT),CGAMMA,EXACT(NT),SOL(NT)
-#endif
-C Set maximum error allowed for test to be considered successful
- PARAMETER ( TSTERR=1D-13)
-C Set up the test parameters EXACT holds analytical solution
- DATA (Z(J),J=1,3) / (1,-2.5),(1,2),(0,6.5) /
- DATA (Z(J),J=4,6) / (0.25,-4),(-0.25,-4),(-3.25,0) /
-#if defined(CERNLIB_CMPXDOUB)
- DATA EXACT(1) /( 0.6687277236487296D-01,-0.4032263511948419D-01)/
- DATA EXACT(2) /( 0.1519040026700361D+00, 0.1980488016185498D-01)/
- DATA EXACT(3) /( 0.5623900528200945D-05,-0.3573530195500522D-04)/
- DATA EXACT(4) /( 0.1337354916562139D-02,-0.3029538475189193D-02)/
- DATA EXACT(5) /( 0.1573616266497059D-02,-0.4993363531906417D-03)/
- DATA EXACT(6) /( 0.5362507279163853D+00, 0.0000000000000000D+00)/
-#endif
-#if !defined(CERNLIB_CMPXDOUB)
- DATA EXACT(1) /( 0.6687277236487296E-01,-0.4032263511948419E-01)/
- DATA EXACT(2) /( 0.1519040026700361, 0.1980488016185498E-01)/
- DATA EXACT(3) /( 0.5623900528200945E-05,-0.3573530195500522E-04)/
- DATA EXACT(4) /( 0.1337354916562139E-02,-0.3029538475189193E-02)/
- DATA EXACT(5) /( 0.1573616266497059E-02,-0.4993363531906417E-03)/
- DATA EXACT(6) /( 0.5362507279163853, 0)/
-#endif
-
- CALL HEADER('C306',0)
-
-C Compare the computed results with exact results for a selection
-C of values
- ERRMAX=0D0
- DO 100 I=1,NT
- WRITE(LOUT,'('' Test number'',I3)') I
-#if defined(CERNLIB_DOUBLE)
- SOL(I)=WGAMMA(Z(I))
-#endif
-#if !defined(CERNLIB_DOUBLE)
- SOL(I)=CGAMMA(Z(I))
-#endif
- ERROR(I)=ABS( SOL(I)-EXACT(I) )
- WRITE(LOUT,'('' Calculated '',2F25.16)') SOL(I)
- WRITE(LOUT,'('' Exact '',2F25.16)') EXACT(I)
- WRITE(LOUT,'('' Abs error '',F25.16)') ERROR(I)
- ERRMAX=MAX( ERRMAX,ERROR(I) )
- 100 CONTINUE
- WRITE(LOUT,'(/'' Largest Error'',F25.16)') ERRMAX
-
- WRITE(LOUT,'(/7X,''TESTING ERROR MESSAGES:''/)')
-#if defined(CERNLIB_DOUBLE)
- R=WGAMMA((0D0,0D0))
- R=WGAMMA((-3D0,0D0))
-#endif
- R=CGAMMA((0.,0.))
- R=CGAMMA((-3.,0.))
-C Check if the test was successful
- IRC=ITEST('C306',ERRMAX .LE. TSTERR)
- CALL PAGEND('C306')
- RETURN
- END
diff --git a/src/mathlib/gen/tests/c307m.F b/src/mathlib/gen/tests/c307m.F
deleted file mode 100644
index bacda28..0000000
--- a/src/mathlib/gen/tests/c307m.F
+++ /dev/null
@@ -1,71 +0,0 @@
-*
-* $Id: c307m.F,v 1.1.1.1 1996/04/01 15:01:14 mclareni Exp $
-*
-* $Log: c307m.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:14 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE C307M
-#include "iorc.inc"
-C This program tests the operation of MATHLIB routines
-C CDIGAM and WDIGAM(C307)
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION ERROR(7),ERRMAX
- COMPLEX*16 Z(7),WDIGAM,EXACT(7),SOL(7)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- REAL ERROR(7),ERRMAX
- COMPLEX Z(7),CDIGAM,EXACT(7),SOL(7)
-#endif
-C Set maximum error allowed for test to be considered successful
- PARAMETER ( TSTERR=1D-13 )
-C Set up the test parameters EXACT holds analytical solution
- DATA (Z(J),J=1,3) /(-20.5,1),(-15,-2.5),(-7.5,4)/
- DATA (Z(J),J=4,7)/(0,-1),(7.5,0),(15,2),(20.5,0)/
-#if defined(CERNLIB_CMPXDOUB)
- DATA EXACT(1) / (0.3045748746354412D+01, 0.3082306882944267D+01)/
- DATA EXACT(2) / (0.2753841362080107D+01,-0.2981733550186298D+01)/
- DATA EXACT(3) / (0.2191326129404467D+01, 0.2678360620124173D+01)/
- DATA EXACT(4) / (0.9465032062247780D-01,-0.2076674047468579D+01)/
- DATA EXACT(5) / (0.1946757484246086D+01, 0.0000000000000000D+00)/
- DATA EXACT(6) / (0.2683758858614923D+01, 0.1370136096416038D+00)/
- DATA EXACT(7) / (0.2995836394707646D+01, 0.0000000000000000D+00)/
-#endif
-#if !defined(CERNLIB_CMPXDOUB)
- DATA EXACT(1) / (0.3045748746354412E+01, 0.3082306882944267E+01)/
- DATA EXACT(2) / (0.2753841362080107E+01,-0.2981733550186298E+01)/
- DATA EXACT(3) / (0.2191326129404467E+01, 0.2678360620124173E+01)/
- DATA EXACT(4) / (0.9465032062247780E-01,-0.2076674047468579E+01)/
- DATA EXACT(5) / (0.1946757484246086E+01, 0)/
- DATA EXACT(6) / (0.2683758858614923E+01, 0.1370136096416038)/
- DATA EXACT(7) / (0.2995836394707646E+01, 0)/
-#endif
- CALL HEADER('C307',0)
-
-C Compare the computed results with exact results for a selection
-C of values
- ERRMAX=0D0
- DO 100 I=1,7
- WRITE(LOUT,'('' Test number'',I3)') I
-#if defined(CERNLIB_DOUBLE)
- SOL(I)=WDIGAM(Z(I))
-#endif
-#if !defined(CERNLIB_DOUBLE)
- SOL(I)=CDIGAM(Z(I))
-#endif
-
- ERROR(I)=ABS( SOL(I)-EXACT(I) )
- WRITE(LOUT,'('' Calculated '',2F25.16)') SOL(I)
- WRITE(LOUT,'('' Exact '',2F25.16)') EXACT(I)
- WRITE(LOUT,'('' Abs error '',F25.16)') ERROR(I)
- ERRMAX=MAX( ERRMAX,ERROR(I) )
- 100 CONTINUE
- WRITE(LOUT,'('' Largest Error'',F25.16)') ERRMAX
-
-C Check if the test was successful
- IRC=ITEST('C307',ERRMAX .LE. TSTERR)
- CALL PAGEND('C307')
- RETURN
- END
diff --git a/src/mathlib/gen/tests/c310m.F b/src/mathlib/gen/tests/c310m.F
deleted file mode 100644
index 1491060..0000000
--- a/src/mathlib/gen/tests/c310m.F
+++ /dev/null
@@ -1,154 +0,0 @@
-*
-* $Id: c310m.F,v 1.1.1.1 1996/04/01 15:01:14 mclareni Exp $
-*
-* $Log: c310m.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:14 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE C310M
-C This program tests the operation of MATHLIB subprograms
-C ALGAMA, DLGAMA and QLGAMA(C310)
-
- LOGICAL LTEST, LTEST1,LTEST2
- COMMON /C310LT1/LTEST1
-#if defined(CERNLIB_QUAD)
- COMMON /C310LT2/LTEST2
-#endif
-#include "iorc.inc"
- CALL HEADER('C310',0)
- LTEST=.TRUE.
- LTEST1=.TRUE.
- LTEST2=.TRUE.
- CALL C310D
- LTEST=LTEST .AND. LTEST1
-#if defined(CERNLIB_QUAD)
- CALL C310Q
- LTEST=LTEST .AND. LTEST2
-#endif
- IRC=ITEST('C310',LTEST)
- CALL PAGEND('C310')
- RETURN
- END
-
- SUBROUTINE C310D
-
-#include "imp64r.inc"
- REAL ALGAMA
-C Set maximum error allowed for test to be considered successful
- DIMENSION TOL(2),TOLIBM(2)
-
-#include "gen/def64.inc"
- + Z0, Z1, HF, X
- PARAMETER (Z0 = 0, Z1 = 1, HF = Z1/2)
- LOGICAL LTEST1
-C
- CHARACTER*6 TFUNC(2)
-C
-#include "iorc.inc"
-#if defined(CERNLIB_DOUBLE)
- DIMENSION Y(7),T(7)
- REAL RT(7)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- REAL Y(7),T(7)
-#endif
- DATA LTEST1/.TRUE./
-
- DATA TOL/1D-8, 5D-11/
- DATA TOLIBM/1D-6, 1D-11/
- DATA TFUNC/'ALGAMA','DLGAMA'/
- DATA (Y(I), I=1,7)
- + / 0.10D-02,0.35D0, 1.00D0, 2.50D0, 8.00D0, 100.00D0,
- + 0.99990000000000D0/
-
- DATA (T(I), I=1,7)
- + /6.90717888538385361D0,0.934581227146233540D0,
- + 0.000000000000000000D0,0.284682870472918514D0,
- + 8.52516136106527989D0,359.134205369575341D0,
- + 0.577297915612021598D-4 /
-
- ERRMAX=0D0
- RERRMAX=0E0
-#if defined(CERNLIB_DOUBLE)
- NF=2
-#endif
-#if !defined(CERNLIB_DOUBLE)
- NF=1
-#endif
- DO 1000 JF=1,NF
- ERRMAX= 0.0D0
-#if !defined(CERNLIB_DOUBLE)
- WRITE(LOUT,'(/10X,''TEST FOR ALGAMA'')')
-#endif
-#if defined(CERNLIB_DOUBLE)
- IF(JF.EQ.1)WRITE(LOUT,'(/10X,''TEST FOR ALGAMA'')')
- IF(JF.EQ.2)WRITE(LOUT,'(/10X,''TEST FOR DLGAMA'')')
-#endif
- WRITE(LOUT,'(/8X,''X'',14X,'' '',A,''(X)'',7X,''Rel Error'')')
- + TFUNC(JF)
- DO 1 I = 1,7
- X=Y(I)
-#if !defined(CERNLIB_DOUBLE)
- DR=ALGAMA(X)
- IF(ABS(DR) .GT. 1D-14) ER=ABS((DR-T(I))/DR)
- ERRMAX =MAX(ERRMAX,ER)
- WRITE(LOUT,'(1X,F10.3,1P,D27.18,D10.1)') X,DR,ER
-#endif
-#if defined(CERNLIB_DOUBLE)
- IF(JF.EQ.1)THEN
- RX=X
- RT(I)=T(I)
- RDR=ALGAMA(RX)
- IF(ABS(RDR) .GT. 1E-4)RER=ABS((RDR-RT(I))/RDR)
- IF(ABS(RDR) .LE. 1E-4)RER=ABS((RDR-RT(I)))
- X=RX
- ERRMAX =MAX(RERRMAX,RER)
- WRITE(LOUT,'(1X,F10.3,1P,E27.9,E10.1)')
- + RX ,RDR,RER
- ENDIF
- IF(JF.EQ.2)THEN
- DR=DLGAMA(X)
- IF(ABS(DR) .GT. 1D-14) ER=ABS((DR-T(I))/DR)
- ERRMAX =MAX(ERRMAX,ER)
- WRITE(LOUT,'(1X,F10.3,1P,E27.18,E10.1)') X,DR,ER
- ENDIF
-#endif
- 1 CONTINUE
-
-#if !defined(CERNLIB_DOUBLE)
- ETOL=TOL(JF+1)
-#endif
-#if defined(CERNLIB_DOUBLE)||defined(CERNLIB_IBM)||defined(CERNLIB_IBMRT)||defined(CERNLIB_IBMAIX)
- ETOL=TOLIBM(JF)
-#endif
-#if (defined(CERNLIB_DOUBLE))&&(!defined(CERNLIB_IBM))&&(!defined(CERNLIB_IBMRT))&&(!defined(CERNLIB_IBMAIX))
- ETOL=TOL(JF)
-#endif
- WRITE(LOUT,'(/''LARGEST RELATIVE ERROR WAS'',1P,E10.1)')
- +ERRMAX
- LTEST1=LTEST1.AND.(ERRMAX.LE.ETOL)
- ERRMAX= 0D0
- WRITE(LOUT,'(/''TESTING ERROR MESSAGES:'')')
-#if !defined(CERNLIB_DOUBLE)
- DR=ALGAMA(Z0)
- DR=ALGAMA(-Z1)
-#endif
-#if defined(CERNLIB_DOUBLE)
- IF(JF.EQ.1)THEN
- RZ0=Z0
- RZ1=Z1
- DR=ALGAMA(RZ0)
- DR=ALGAMA(-RZ1)
- ENDIF
- IF(JF.EQ.2)THEN
- DR=DLGAMA(Z0)
- DR=DLGAMA(-Z1)
- ENDIF
-#endif
-1000 CONTINUE
-
- RETURN
- END
-
diff --git a/src/mathlib/gen/tests/c310q.F b/src/mathlib/gen/tests/c310q.F
deleted file mode 100644
index 1339335..0000000
--- a/src/mathlib/gen/tests/c310q.F
+++ /dev/null
@@ -1,102 +0,0 @@
-*
-* $Id: c310q.F,v 1.1.1.1 1996/04/01 15:01:14 mclareni Exp $
-*
-* $Log: c310q.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:14 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_QUAD)
- SUBROUTINE C310Q
-#include "gen/imp128.inc"
-
-
-#include "gen/def128.inc"
- + Z0, Z1, HF, X
- PARAMETER (Z0 = 0, Z1 = 1, HF = Z1/2)
- LOGICAL LTEST2
-C
- CHARACTER*6 TFUNC
-C
-#include "iorc.inc"
- DATA LTEST2/.TRUE./
- DIMENSION Y(7),T(7)
-C Set maximum error allowed for test to be considered successful
-#if defined(CERNLIB_DOUBLE)
- DATA TOL/1Q-31/
- DATA TFUNC/'QLGAMA'/
- DATA (Y(I), I=1,7)
- + / 0.10Q-02,0.35Q0, 1.00Q0, 2.50Q0, 8.00Q0, 100.00Q0,
- + 0.99990000000000Q0/
-
-
- DATA (T(I), I=1,7)
- +/ 6.90717888538385368251234466807698Q+00,
- + 9.34581227146232556570346655611102Q-01,
- + -1.29037306273944802154750522153190Q-32,
- + 2.84682870472919159632494669682699Q-01,
- + 8.52516136106541430016553103634711Q+00,
- + 3.59134205369575398776044010460285Q+02,
- + 5.77297915612002217342328598585586Q-05 /
-
-#endif
-#if !defined(CERNLIB_DOUBLE)
- DATA TOL/1D-31/
- DATA TFUNC/'DLGAMA'/
- DATA (Y(I), I=1,7)
- + / 0.10D-02,0.35D0, 1.00D0, 2.50D0, 8.00D0, 100.00D0,
- + 0.99990000000000D0/
-
- DATA (T(I), I=1,7)
- +/ 6.90717888538385368251234466807698D+00,
- + 9.34581227146232556570346655611102D-01,
- + -1.29037306273944802154750522153190D-32,
- + 2.84682870472919159632494669682699D-01,
- + 8.52516136106541430016553103634711D+00,
- + 3.59134205369575398776044010460285D+02,
- + 5.77297915612002217342328598585586D-05 /
-#endif
-
-c CALL HEADER('C310',0)
-
-#if defined(CERNLIB_DOUBLE)
- ERRMAX=0Q0
- WRITE(LOUT,'(/10X,''TEST FOR QLGAMA'')')
-#endif
-#if !defined(CERNLIB_DOUBLE)
- ERRMAX=0D0
- WRITE(LOUT,'(/10X,''TEST FOR DLGAMA'')')
-#endif
- WRITE(LOUT,'(/8X,''X'',14X,'' '',A,''(X)'',7X,''Rel Error'')')
- + TFUNC
- DO 1 I = 1,7
- X=Y(I)
-#if !defined(CERNLIB_DOUBLE)
- DR=DLGAMA(X)
- IF(ABS(DR) .GT. 1D-31) ER=ABS((DR-T(I))/DR)
-#endif
-#if defined(CERNLIB_DOUBLE)
- DR=QLGAMA(X)
- IF(ABS(DR) .GT. 1Q-31) ER=ABS((DR-T(I))/DR)
-#endif
- ERRMAX =MAX(ERRMAX,ER)
- WRITE(LOUT,'(1X,F10.3,1P,E40.32,E10.1)') X,DR,ER
- 1 CONTINUE
-
- WRITE(LOUT,'(/''LARGEST RELATIVE ERROR WAS'',1P,E10.1)')
- +ERRMAX
- LTEST2=LTEST2.AND.(ERRMAX.LE.TOL)
- WRITE(LOUT,'(/''TESTING ERROR MESSAGES:'')')
-#if !defined(CERNLIB_DOUBLE)
- DR=DLGAMA(Z0)
- DR=DLGAMA(-Z1)
-#endif
-#if defined(CERNLIB_DOUBLE)
- DR=QLGAMA(Z0)
- DR=QLGAMA(-Z1)
-#endif
-
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/tests/c312m.F b/src/mathlib/gen/tests/c312m.F
deleted file mode 100644
index 285e85a..0000000
--- a/src/mathlib/gen/tests/c312m.F
+++ /dev/null
@@ -1,182 +0,0 @@
-*
-* $Id: c312m.F,v 1.1.1.1 1996/04/01 15:01:14 mclareni Exp $
-*
-* $Log: c312m.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:14 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE C312M
-C This program tests the operation of KERNLIB subprograms
-C BESJ0, BESJ1, BESY0, BESY1 and
-C DBESJ0, DBESJ1, DBESY0, DBESY1 (C312)
-
-#include "imp64r.inc"
- REAL BESJ0, BESJ1, BESY0, BESY1
-C Set maximum error allowed for test to be considered successful
- DIMENSION TOL(2)
-
-
- LOGICAL LTEST
-C Set the total number of tests for BEJ0 and BESJ1
- PARAMETER ( NT=5)
-#if defined(CERNLIB_DOUBLE)
- DIMENSION X(NT),EX(NT,4),ER(NT,4)
- REAL RX(NT),REX(NT,4),RER(NT,4)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- REAL X(NT),EX(NT,4),ER(NT,4)
-#endif
-#include "iorc.inc"
- DATA TOL/1D-6, 1D-13/
-C Input parameters for individual tests
- DATA X( 1 )/ -10.0D0/
- DATA X( 2 )/ -2.0D0/
- DATA X( 3 )/ 0.0D0/
- DATA X( 4 )/ 1.0D0/
- DATA X( 5 )/ 9.0D0/
-C Analytical values expected to be obtained
- DATA (EX( 1,J ),J=1,4)
- + /-0.245935764451348D0,-0.043472746168861D0,
- + 0.000000000000000D0, 0.000000000000000D0 /
- DATA (EX( 2,J ),J=1,4)
- + / 0.223890779141235D0,-0.576724807756873D0,
- + 0.000000000000000D0, 0.000000000000000D0 /
- DATA (EX( 3,J ),J=1,4)
- + /0.999999999999999D0, 0.000000000000000D0,
- + 0.000000000000000D0, 0.000000000000000D0 /
- DATA (EX( 4,J ),J=1,4)
- + / 0.765197686557966D0, 0.440050585744933D0,
- + 0.088256964215678D0,-0.781212821300289D0/
- DATA (EX( 5,J ),J=1,4)
- + /-0.090333611182876D0, 0.245311786573325D0,
- + 0.249936698285025D0, 0.104314575196716D0/
-
- DATA LTEST/.TRUE./
- CALL HEADER('C312',0)
-#if defined(CERNLIB_DOUBLE)
- NF=2
-#endif
-#if !defined(CERNLIB_DOUBLE)
- NF=1
-#endif
- DO 1000 JF=1,NF
- ERRMAX= 0.0D0
-#if !defined(CERNLIB_DOUBLE)
- WRITE(LOUT,'(/10X,''TEST FOR BESJ0, BESJ1,'',
- +'' BESY0, BESY1'')')
-#endif
-#if defined(CERNLIB_DOUBLE)
- IF(JF.EQ.1)WRITE(LOUT,'(/10X,''TEST FOR BESJ0, BESJ1,'',
- +'' BESY0, BESY1'')')
- IF(JF.EQ.2)WRITE(LOUT,'(/10X,''TEST FOR DBESJ0,'',
- +'' DBESJ1, DBESY0, DBESY1'')')
-#endif
- WRITE(LOUT,'(/9X,''X'',15X,''BJ0'',21X,''BJ1'')')
- DO 1 I = 1,5
-#if !defined(CERNLIB_DOUBLE)
- BJ0=BESJ0(X(I))
- BJ1=BESJ1(X(I))
- ER(I,1)= ABS(EX(I,1)-BJ0 )
- ER(I,2)= ABS(EX(I,2)-BJ1 )
- DO 7 J = 1,2
- ERRMAX = MAX( ERRMAX ,ER(I,J) )
- 7 CONTINUE
-#endif
-#if defined(CERNLIB_DOUBLE)
- IF(JF.EQ.1)THEN
- RX(I)=X(I)
- BJ0= BESJ0(RX(I))
- BJ1= BESJ1(RX(I))
- DO 222 J = 1,4
- REX(I,J)=EX(I,J)
- 222 CONTINUE
- RER(I,1)= ABS(REX(I,1)-BJ0 )
- RER(I,2)= ABS(REX(I,2)-BJ1 )
- DO 666 J = 1,2
- ER(I,J)=RER(I,J)
- 666 CONTINUE
- ENDIF
- IF(JF.EQ.2)THEN
- BJ0=DBESJ0(X(I))
- BJ1=DBESJ1(X(I))
- ER(I,1)= ABS(EX(I,1)-BJ0 )
- ER(I,2)= ABS(EX(I,2)-BJ1 )
- ENDIF
- DO 8 J = 1,2
- ERRMAX = MAX( ERRMAX ,ER(I,J) )
- 8 CONTINUE
-#endif
- WRITE(LOUT,'(1X,F10.1,2F25.15)') X(I),BJ0,BJ1
- 1 CONTINUE
- WRITE(LOUT,'(/9X,''X'',15X,''BY0'',21X,''BY1'')')
- DO 11 I =4,5
- BY0=0
- BY1=0
-#if !defined(CERNLIB_DOUBLE)
- BY0= BESY0(X(I))
- BY1= BESY1(X(I))
- ER(I,3)= ABS(EX(I,3)-BY0 )
- ER(I,4)= ABS(EX(I,4)-BY1 )
- DO 9 J = 3,4
- ERRMAX = MAX( ERRMAX ,ER(I,J) )
- 9 CONTINUE
-#endif
-#if defined(CERNLIB_DOUBLE)
- IF(JF.EQ.1)THEN
- RX(I)=X(I)
- BY0= BESY0(RX(I))
- BY1= BESY1(RX(I))
- RER(I,3)= ABS(REX(I,3)-BY0 )
- RER(I,4)= ABS(REX(I,4)-BY1 )
- DO 333 J = 3,4
- ER(I,J)=RER(I,J)
- 333 CONTINUE
- ENDIF
- IF(JF.EQ.2)THEN
- BY0=DBESY0(X(I))
- BY1=DBESY1(X(I))
- ER(I,3)= ABS(EX(I,3)-BY0 )
- ER(I,4)= ABS(EX(I,4)-BY1 )
- ENDIF
- DO 2 J = 3,4
- ERRMAX = MAX( ERRMAX ,ER(I,J) )
- 2 CONTINUE
- WRITE(LOUT,'(1X,F10.1,2F25.15)') X(I),BY0,BY1
-#endif
- 11 CONTINUE
- WRITE(LOUT,'(/''LARGEST RELATIVE ERROR WAS'',1P,D10.1)')
- +ERRMAX
-#if !defined(CERNLIB_DOUBLE)
- ETOL=TOL(JF+1)
-#endif
-#if defined(CERNLIB_DOUBLE)
- ETOL=TOL(JF)
-#endif
- LTEST=LTEST.AND.(ERRMAX.LE.ETOL)
- ERRMAX= 0D0
- WRITE(LOUT,'(/''TESTING ERROR MESSAGES:'')')
- DO 444 I=2,3
-#if !defined(CERNLIB_DOUBLE)
- BY0= BESY0(X(I))
- BY1= BESY1(X(I))
-#endif
-#if defined(CERNLIB_DOUBLE)
- IF(JF.EQ.1)THEN
- RX(I)=X(I)
- BY0= BESY0(RX(I))
- BY1= BESY1(RX(I))
- ENDIF
- IF(JF.EQ.2)THEN
- BY0=DBESY0(X(I))
- BY1=DBESY1(X(I))
- ENDIF
-#endif
- 444 CONTINUE
-1000 CONTINUE
-C Check if the test was successful
- IRC=ITEST('C312',LTEST)
-
- CALL PAGEND('C312')
- END
diff --git a/src/mathlib/gen/tests/c313m.F b/src/mathlib/gen/tests/c313m.F
deleted file mode 100644
index 1fe17e9..0000000
--- a/src/mathlib/gen/tests/c313m.F
+++ /dev/null
@@ -1,301 +0,0 @@
-*
-* $Id: c313m.F,v 1.1.1.1 1996/04/01 15:01:14 mclareni Exp $
-*
-* $Log: c313m.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:14 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE C313M
-C This program tests the operation of KERNLIB subprograms
-C BESI0, BESI1, BESK0, BESK1 and
-C DBESI0, DBESI1, DBESK0, DBESK1 (C313)
-
-#include "imp64r.inc"
- REAL BESI0, BESI1, BESK0, BESK1
- REAL EBESI0, EBESI1, EBESK0, EBESK1
-C Set maximum error allowed for test to be considered successful
- DIMENSION TOL(2)
-
-
- LOGICAL LTEST
-C Set the total number of tests for BESI0 and BESI1
- PARAMETER ( NT=20)
-#if defined(CERNLIB_DOUBLE)
- DIMENSION X(NT),EX(NT,4),ER(NT,4)
- REAL RX(NT),REX(NT,4),RER(NT,4)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- REAL X(NT),EX(NT,4),ER(NT,4)
-#endif
-#include "iorc.inc"
- DATA TOL/1D-6, 1D-13/
-C Input parameters for individual tests
- DATA X( 1 )/ -10.00D0/
- DATA X( 2 )/ -6.00D0/
- DATA X( 3 )/ -4.00D0/
- DATA X( 4 )/ -1.00D0/
- DATA X( 5 )/ -0.50D0/
- DATA X( 6 )/ 0.00D0/
- DATA X( 7 )/ 0.70D0/
- DATA X( 8 )/ 2.50D0/
- DATA X( 9 )/ 7.00D0/
- DATA X(10 )/ 9.00D0/
-C Analytical values expected to be obtained
-
- DATA (EX(1,J),J=1,4)
- + /0.127833337163428D0,-0.121262681384455D0,
- + 0.000000000000000D0,0.000000000000000D0/
- DATA (EX(2,J),J=1,4)
- + /0.166657432639816D0,-0.152051459308506D0,
- + 0.000000000000000D0,0.000000000000000D0/
- DATA (EX(3,J),J=1,4)
- + /0.207001921223987D0,-0.178750839502435D0,
- + 0.000000000000000D0, 0.000000000000000D0/
- DATA (EX(4,J),J=1,4)
- + / 0.465759607593640D0,-0.207910415349708D0,
- + 0.000000000000000D0, 0.000000000000000D0/
- DATA (EX(5,J),J=1,4)
- + / 0.645035270449149D0,-0.156420803184872D0,
- + 0.000000000000000D0, 0.000000000000000D0/
- DATA (EX(6,J),J=1,4)
- + / 1.000000000000000D0, 0.000000000000000D0,
- + 0.000000000000000D0, 0.000000000000000D0/
- DATA (EX(7,J),J=1,4)
- + / 0.559305526507068D0, 0.184669982762747D0,
- + 1.330123656242055D0, 2.115011312848052D0/
- DATA (EX(8,J),J=1,4)
- + / 0.270046441612203D0, 0.206584649531266D0,
- + 0.759548690328100D0, 0.900174423907878D0/
- DATA (EX(9,J),J=1,4)
- + / 0.153737744672881D0, 0.142289234709599D0,
- + 0.465845096093016D0, 0.498071575095476D0/
- DATA (EX(10,J),J=1,4)
- + / 0.134959524581723D0, 0.127224983935891D0,
- + 0.412295549231418D0, 0.434625245347434D0/
- DATA (EX(11,J),J=1,4)
- + / 0.127833337163429D0,-0.121262681384455D0,
- + 0.000000000000000D0, 0.000000000000000D0/
- DATA (EX(12,J),J=1,4)
- + / 0.166657432639816D0,-0.152051459308506D0,
- + 0.000000000000000D0, 0.000000000000000D0/
- DATA (EX(13,J),J=1,4)
- + / 0.207001921223987D0, -0.178750839502435D0,
- + 0.000000000000000D0, 0.000000000000000D0/
- DATA (EX(14,J),J=1,4)
- + / 0.465759607593640D0, -0.207910415349708D0,
- + 0.000000000000000D0, 0.000000000000000D0/
- DATA (EX(15,J),J=1,4)
- + / 0.645035270449149D0, -0.156420803184872D0,
- + 0.000000000000000D0, 0.000000000000000D0/
- DATA (EX(16,J),J=1,4)
- + / 1.000000000000000D0, 0.000000000000000D0,
- + 0.000000000000000D0, 0.000000000000000D0/
- DATA (EX(17,J),J=1,4)
- + / 0.559305526507068D0, 0.184669982762747D0,
- + 1.330123656242055D0, 2.115011312848052D0/
- DATA (EX(18,J),J=1,4)
- + / 0.270046441612203D0, 0.206584649531266D0,
- + 0.759548690328100D0, 0.900174423907878D0/
- DATA (EX(19,J),J=1,4)
- + / 0.153737744672881D0, 0.142289234709599D0,
- + 0.465845096093016D0, 0.498071575095476D0/
- DATA (EX(20,J),J=1,4)
- + / 0.134959524581723D0, 0.127224983935891D0,
- + 0.412295549231418D0, 0.434625245347434D0/
- DATA LTEST/.TRUE./
- CALL HEADER('C313',0)
-#if defined(CERNLIB_DOUBLE)
- NF=2
-#endif
-#if !defined(CERNLIB_DOUBLE)
- NF=1
-#endif
- DO 1000 JF=1,NF
- ERRMAX= 0.0D0
-#if !defined(CERNLIB_DOUBLE)
- WRITE(LOUT,'(/10X,''TEST FOR BESI0, BESI1,'',
- +'' BESK0, BESK1'')')
-#endif
-#if defined(CERNLIB_DOUBLE)
- IF(JF.EQ.1)WRITE(LOUT,'(/10X,''TEST FOR BESI0, BESI1,'',
- +'' BESK0, BESK1'')')
- IF(JF.EQ.2)WRITE(LOUT,'(/10X,''TEST FOR DBESI0,'',
- +'' DBESI1, DBESK0, DBESK1'')')
-
-#endif
-#if !defined(CERNLIB_DOUBLE)
- WRITE(LOUT,'(/9X,''X'',9X,
- +''(e**(-|X|))* BESI0'',7X,''(e**(-|X|))* BESI1'',7X,
- +''EBESI0'',7X,''EBESI1''/)')
-#endif
-#if defined(CERNLIB_DOUBLE)
- IF(JF.EQ.1)
- +WRITE(LOUT,'(/9X,''X'',9X,
- +''(e**(-|X|))* BESI0'',7X,''(e**(-|X|))* BESI1'',7X,
- +''EBESI0'',7X,''EBESI1''/)')
- IF(JF.EQ.2)
- +WRITE(LOUT,'(/9X,''X'',9X,
- +''(e**(-|X|))*DBESI0'',7X,''(e**(-|X|))*DBESI1'',7X,
- +''DEBSI0'',7X,''DEBSI1''/)')
-#endif
-c DO 55 I = 1,10
- DO 55 I = 1,4
-#if !defined(CERNLIB_DOUBLE)
- BI0=EXP(-ABS(X(I)))* BESI0(X(I))
- BI1=EXP(-ABS(X(I)))* BESI1(X(I))
- EBI0= EBESI0(X(I))
- EBI1= EBESI1(X(I))
- ER(I,1)= ABS(EX(I,1)-BI0 )
- ER(I,2)= ABS(EX(I,2)-BI1 )
- ER(I+10,1)= ABS(EX(I+10,1)-EBI0 )
- ER(I+10,2)= ABS(EX(I+10,2)-EBI1 )
-#endif
-#if defined(CERNLIB_DOUBLE)
- IF(JF.EQ.1)THEN
- RX(I)=X(I)
- REX(I,1)=EX(I,1)
- REX(I,2)=EX(I,2)
- REX(I+10,1)=EX(I+10,1)
- REX(I+10,2)=EX(I+10,2)
- RBI0=EXP(-ABS(RX(I)))*BESI0(RX(I))
- RBI1=EXP(-ABS(RX(I)))*BESI1(RX(I))
- REBI0= EBESI0(RX(I))
- REBI1= EBESI1(RX(I))
- ER(I,1)= ABS(REX(I,1)-RBI0 )
- ER(I,2)= ABS(REX(I,2)-RBI1 )
- ER(I+10,1)= ABS(REX(I+10,1)-RBI0 )
- ER(I+10,2)= ABS(REX(I+10,2)-RBI1 )
- BI0=RBI0
- BI1=RBI1
- EBI0=REBI0
- EBI1=REBI1
- ENDIF
- IF(JF.EQ.2)THEN
- BI0=EXP(-ABS(X(I)))*DBESI0(X(I))
- BI1=EXP(-ABS(X(I)))*DBESI1(X(I))
- EBI0=DEBSI0(X(I))
- EBI1=DEBSI1(X(I))
- ER(I,1)= ABS(EX(I,1)-BI0 )
- ER(I,2)= ABS(EX(I,2)-BI1 )
- ER(I+10,1)= ABS(EX(I+10,1)-EBI0 )
- ER(I+10,2)= ABS(EX(I+10,2)-EBI1 )
- ENDIF
-#endif
- WRITE(LOUT,'(1X,F10.1,4F25.15)') X(I),BI0,BI1,EBI0,EBI1
- DO 88 J = 1,2
- ERRMAX = MAX( ERRMAX ,ER(I,J) )
- ERRMAX = MAX( ERRMAX ,ER(I+10,J) )
- 88 CONTINUE
- 55 CONTINUE
-
-#if !defined(CERNLIB_DOUBLE)
- WRITE(LOUT,'(/9X,''X'',9X,
- +''(e**( |X|))* BESK0'',7X,''(e**( |X|))* BESK1'',7X,
- +'' EBESK0'',7X,'' EBESK1''/)')
-#endif
-#if defined(CERNLIB_DOUBLE)
- IF(JF.EQ.1)
- +WRITE(LOUT,'(/9X,''X'',9X,
- +''(e**( |X|))* BESK0'',7X,''(e**( |X|))* BESK1'',7X,
- +'' EBESK0'',7X,'' EBESK1''/)')
- IF(JF.EQ.2)
- +WRITE(LOUT,'(/9X,''X'',9X,
- +''(e**( |X|))*DBESK0'',7X,''(e**( |X|))*DBESK1'',7X,
- +''DEBSK0'',7X,''DEBSK1''/)')
-#endif
- DO 66 I = 7,10
- BK0=0
- BK1=0
-#if !defined(CERNLIB_DOUBLE)
- BK0=EXP(X(I))* BESK0(X(I))
- BK1=EXP(X(I))* BESK1(X(I))
- EBK0= EBESK0(X(I))
- EBK1= EBESK1(X(I))
- ER(I,3)= ABS(EX(I,3)-BK0 )
- ER(I,4)= ABS(EX(I,4)-BK1 )
- ER(I+10,3)= ABS(EX(I+10,3)-EBK0 )
- ER(I+10,4)= ABS(EX(I+10,4)-EBK1 )
-#endif
-#if defined(CERNLIB_DOUBLE)
- IF(JF.EQ.1)THEN
- RX(I)=X(I)
- REX(I,3)=EX(I,3)
- REX(I,4)=EX(I,4)
- REX(I+10,3)=EX(I+10,3)
- REX(I+10,4)=EX(I+10,4)
- RBK0=EXP(RX(I))*BESK0(RX(I))
- RBK1=EXP(RX(I))*BESK1(RX(I))
- REBK0= EBESK0(RX(I))
- REBK1= EBESK1(RX(I))
- ER(I,3)= ABS(REX(I,3)-RBK0 )
- ER(I,4)= ABS(REX(I,4)-RBK1 )
- ER(I+10,3)= ABS(REX(I+10,3)-REBK0 )
- ER(I+10,4)= ABS(REX(I+10,4)-REBK1 )
- BK0=RBK0
- BK1=RBK1
- EBK0=REBK0
- EBK1=REBK1
- ENDIF
- IF(JF.EQ.2)THEN
- BK0=EXP(X(I))*DBESK0(X(I))
- BK1=EXP(X(I))*DBESK1(X(I))
- EBK0=DEBSK0(X(I))
- EBK1=DEBSK1(X(I))
- ER(I,3)= ABS(EX(I,3)-BK0 )
- ER(I,4)= ABS(EX(I,4)-BK1 )
- ER(I+10,3)= ABS(EX(I+10,3)-EBK0 )
- ER(I+10,4)= ABS(EX(I+10,4)-EBK1 )
- ENDIF
-#endif
- WRITE(LOUT,'(1X,F10.1,4F25.15)') X(I),BK0,BK1,EBK0,EBK1
- DO 8 J = 3,4
- ERRMAX = MAX( ERRMAX ,ER(I,J) )
- ERRMAX = MAX( ERRMAX ,ER(I+10,J) )
- 8 CONTINUE
- 66 CONTINUE
-
- WRITE(LOUT,'(/''LARGEST RELATIVE ERROR WAS'',1P,D10.1)')
- +ERRMAX
-#if !defined(CERNLIB_DOUBLE)
- ETOL=TOL(JF+1)
-#endif
-#if defined(CERNLIB_DOUBLE)
- ETOL=TOL(JF)
-#endif
- LTEST=LTEST.AND.(ERRMAX.LE.ETOL)
- ERRMAX= 0D0
-
- WRITE(LOUT,'(/''TESTING ERROR MESSAGES:'')')
-
- DO 77 I = 5,6
- BK0=0
- BK1=0
-#if !defined(CERNLIB_DOUBLE)
- BK0=EXP(X(I))* BESK0(X(I))
- BK1=EXP(X(I))* BESK1(X(I))
- EBK0= EBESK0(X(I))
- EBK1= EBESK1(X(I))
-#endif
-#if defined(CERNLIB_DOUBLE)
- IF(JF.EQ.1)THEN
- RX(I)=X(I)
- RBK0=EXP(RX(I))*BESK0(RX(I))
- RBK1=EXP(RX(I))*BESK1(RX(I))
- REBK0=EBESK0(RX(I))
- REBK1=EBESK1(RX(I))
- ENDIF
- IF(JF.EQ.2)THEN
- BK0=EXP(X(I))*DBESK0(X(I))
- BK1=EXP(X(I))*DBESK1(X(I))
- EBK0= DEBSK0(X(I))
- EBK1= DEBSK1(X(I))
- ENDIF
-#endif
- 77 CONTINUE
-1000 CONTINUE
-
- IRC=ITEST('C313',LTEST)
- CALL PAGEND('C313')
- END
diff --git a/src/mathlib/gen/tests/c315m.F b/src/mathlib/gen/tests/c315m.F
deleted file mode 100644
index e283377..0000000
--- a/src/mathlib/gen/tests/c315m.F
+++ /dev/null
@@ -1,151 +0,0 @@
-*
-* $Id: c315m.F,v 1.1.1.1 1996/04/01 15:01:15 mclareni Exp $
-*
-* $Log: c315m.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:15 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE C315M
-C This program tests the operation of MATHLIB subprograms
-C RRIZET and DRIZET (C315)
-
-#include "imp64r.inc"
- REAL RRIZET
-C Set maximum error allowed for test to be considered successful
- DIMENSION TOL(2)
-
- LOGICAL LTEST
-C Set the total number of tests
- PARAMETER ( NT=11)
-#if defined(CERNLIB_DOUBLE)
- DIMENSION X(NT),EX(NT,2),ER(NT,2)
- REAL RX(NT),REX(NT,2)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- REAL X(NT),EX(NT,2),ER(NT,2)
-#endif
-#include "iorc.inc"
- DATA TOL/1D-6, 1D-12/
- DATA LTEST/.TRUE./
-C Input parameters for individual tests
- DATA X( 1 )/ 0.5D0/
-c DATA X( 2 )/ 1.0D0/
- DATA X( 2 )/ 3.0D0/
- DATA X( 3 )/ 10.0D0/
- DATA X( 4 )/ 20.0D0/
- DATA X( 5 )/ 50.0D0/
- DATA X( 6 )/ 60.0D0/
- DATA X( 7 )/ 92.0D0/
- DATA X( 8 )/ -10.0D0/
- DATA X( 9 )/ -3.0D0/
- DATA X(10 )/ -0.5D0/
- DATA X(11 )/ 1.0D0/
-
-C Analytical values expected to be obtained
-
- DATA (EX(1,J),J=1,2)
- + / -0.146035450880959D+01 , -0.146035450880959D+01/
- DATA (EX(11,J),J=1,2)
- + / 0.000000000000000D+00 , 0.000000000000000D+00/
- DATA (EX(2,J),J=1,2)
- + / 0.120205690315959D+01 , 0.202056903159594D+00/
- DATA (EX(3,J),J=1,2)
- + / 0.100099457512782D+01 , 0.994575127818086D-03/
- DATA (EX(4,J),J=1,2)
- + / 0.100000095396203D+01 , 0.953962033872798D-06/
- DATA (EX(5,J),J=1,2)
- + / 0.100000000000000D+01 , 0.888178421093083D-15/
- DATA (EX(6,J),J=1,2)
- + / 0.100000000000000D+01 , 0.867361738011993D-18/
- DATA (EX(7,J),J=1,2)
- + / 0.100000000000000D+01 , 0.201948391736579D-27/
- DATA EX(8,2)
- + / 0.000000000000000D+00/
- DATA EX( 9,2)
- + / 0.833333333333333D-02/
- DATA EX(10,2)
- + /-0.207886224977354D+00/
- DATA (ER(I,1),I=1,10)/0,0,0,0,0,0,0,0,0,0/
- DATA (ER(I,2),I=1,10)/0,0,0,0,0,0,0,0,0,0/
- CALL HEADER('C315',0)
- ERRMAX= 0.0D0
-
-
-
- WRITE(LOUT,'(/9X,''RRIZET/DRIZET has the value of the Riemann Zeta
- + Function of X if X<1'')')
- WRITE(LOUT,'(9X,''and of the Zeta Function minus 1 if X>1'')')
-#if defined(CERNLIB_DOUBLE)
- NF=2
-#endif
-#if !defined(CERNLIB_DOUBLE)
- NF=1
-#endif
- DO 1000 JF=1,NF
- ERRMAX= 0.0D0
-#if !defined(CERNLIB_DOUBLE)
- WRITE(LOUT,'(/10X,''TEST FOR RRIZET'')')
-#endif
-#if defined(CERNLIB_DOUBLE)
- IF(JF.EQ.1)WRITE(LOUT,'(/10X,''TEST FOR RRIZET'')')
- IF(JF.EQ.2)WRITE(LOUT,'(/10X,''TEST FOR DRIZET'')')
-#endif
- WRITE(LOUT,'(/9X,''X'',9X,
- +''FUNCTION'',15X,
- +''FUNCTION+1 if X>1'')')
- DO 1 I = 1,11
- IF(X(I) .EQ. 1)
- +WRITE(LOUT,'(/''TESTING ERROR MESSAGES:'')')
-
-#if !defined(CERNLIB_DOUBLE)
- DR=RRIZET(X(I))
- DR1=DR
- IF(X(I) .GT. 1) DR1=1+DR
- IF(DR .NE. 0) ER(I,2)=ABS(( EX(I,2)-DR )/DR)
- IF(DR1.NE. 0 .AND. X(I) .GT. 1) ER(I,1)=ABS((EX(I,1)-DR1)/DR1)
-#endif
-#if defined(CERNLIB_DOUBLE)
- IF(JF.EQ.1)THEN
- RX(I)=X(I)
- REX(I,1)=EX(I,1)
- REX(I,2)=EX(I,2)
- DR=RRIZET(RX(I))
- DR1=DR
- IF(RX(I) .GT. 1) DR1=1+DR
- IF(DR .NE. 0) ER(I,2)=ABS((REX(I,2)-DR )/DR)
- IF(DR1.NE. 0 .AND. X(I) .GT. 1) ER(I,1)=ABS((REX(I,1)-DR1)/DR1)
- ENDIF
- IF(JF.EQ.2)THEN
- DR=DRIZET(X(I))
- DR1=DR
- IF(X(I) .GT. 1) DR1=1+DR
- IF(DR .NE. 0) ER(I,2)=ABS(( EX(I,2)-DR )/DR)
- IF(DR1.NE. 0 .AND. X(I) .GT. 1) ER(I,1)=ABS((EX(I,1)-DR1)/DR1)
- ENDIF
-#endif
- DO 2 J = 1,2
- ERRMAX= MAX( ERRMAX,ER(I,J) )
- 2 CONTINUE
-
- IF(X(I) .GE. 0)WRITE(LOUT,'(1X,F10.1,1P,2D25.15)')
- + X(I),DR,DR1
- IF(X(I) .LT. 0) WRITE(LOUT,'(1X,F10.1,1P,D25.15)')
- +X(I),DR
- 1 CONTINUE
-#if !defined(CERNLIB_DOUBLE)
- ETOL=TOL(JF+1)
-#endif
-#if defined(CERNLIB_DOUBLE)
- ETOL=TOL(JF)
-#endif
- WRITE(LOUT,'(/''Largest Relative Error was'',
- +D10.1)') ERRMAX
- LTEST=LTEST.AND.(ERRMAX.LE.ETOL)
- ERRMAX= 0D0
-1000 CONTINUE
-C Check if the test was successful
- IRC=ITEST('C315',LTEST)
- CALL PAGEND('C315')
- END
diff --git a/src/mathlib/gen/tests/c316m.F b/src/mathlib/gen/tests/c316m.F
deleted file mode 100644
index 27cc77a..0000000
--- a/src/mathlib/gen/tests/c316m.F
+++ /dev/null
@@ -1,161 +0,0 @@
-*
-* $Id: c316m.F,v 1.1.1.1 1996/04/01 15:01:15 mclareni Exp $
-*
-* $Log: c316m.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:15 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE C316M
-C This program tests the operation of MATHLIB subprograms
-C RPSIPG and DPSIPG (C316)
-
-#include "imp64r.inc"
- REAL RPSIPG
-C
- CHARACTER*6 TFUNC(2)
-C
-C Set maximum error allowed for test to be considered successful
- DIMENSION TOL(2)
-
- LOGICAL LTEST
- PARAMETER (Z0 = 0, Z1 = 1)
- DIMENSION X(9),TEST(0:6,8)
-#include "iorc.inc"
- DATA TFUNC/'RPSIPG','DPSIPG'/
- DATA TOL/1D-6, 8D-9 /
- DATA LTEST/.TRUE./
-
-C Input parameters for individual tests
- DATA X( 1 )/ 0.4D0/
- DATA X( 2 )/ 2.5D0/
- DATA X( 3 )/ 3.0D0/
- DATA X( 4 )/ 8.0D0/
- DATA X( 5 )/ 12.0D0/
- DATA X( 6 )/ 15.0D0/
- DATA X( 7 )/ -2.5D0/
- DATA X( 8 )/ -0.4D0/
-C Analytical values expected to be obtained
-
- DATA (TEST(0,J),J=1,8)
- + /-2.56138454458511600 D0, 0.703156640645243275 D0,
- + 0.922784335098467037 D0, 2.01564147795560977 D0,
- + 2.44266167997581185 D0, 2.67434666166079360 D0,
- + 1.10315664064524266 D0, 0.959380786106809769 D0/
- DATA (TEST(1,J),J=1,8)
- + / 7.27535659052959738 D0, 0.490357756100234854 D0,
- + 0.394934066848226420 D0, 0.133137014694031428 D0,
- + 0.869018728717683708D-01 , 0.689382278476837890D-01 ,
- + 9.53924664498912400 D0, 9.88620967090235880 D0/
- DATA (TEST(2,J),J=1,8)
- + /-32.2391286235783596 D0, -0.236204051641727378 D0,
- + -0.154113806319188543 D0, -0.176995691957677753D-01 ,
- + -0.754720536899890996D-02 , -0.475060271655155294D-02 ,
- + -0.108204051641735938 D0, 21.2871684628565419 D0/
- DATA (TEST(3,J),J=1,8)
- + / 236.195259033947110 D0, 0.223905848817252034 D0,
- + 0.118939402266829114 D0, 0.469923979594508157D-02 ,
- + 0.131009323107082591D-02 , 0.654479778282737376D-03 ,
- + 194.747876219187631 D0, 281.782041045345863 D0/
- DATA (TEST(4,J),J=1,8)
- + /-2348.59127348799035 D0, -0.313755999506731345 D0,
- + -0.136266123440878212 D0, -0.186879515063761992D-02 ,
- + -0.340910050701089473D-03 , -0.135196191875192876D-03 ,
- + -0.679959995074066875D-01 , 2032.55726807073870 D0/
- DATA (TEST(5,J),J=1,8)
- + / 29313.5424692587758 D0, 0.578569178567183456 D0,
- + 0.206167438133896735 D0, 0.989510004771321228D-03 ,
- + 0.118208290510815061D-03 , 0.372221509496196595D-04 ,
- + 15382.1400480263037 D0, 31876.5069077684757 D0/
- DATA (TEST(6,J),J=1,8)
- + /-439523.164998806766 D0, -1.31800610755003489 D0,
- + -0.386479714984435299 D0, -0.654007738835768460D-03 ,
- + -0.512034865641779365D-04 , -0.128049887546262730D-04 ,
- + -0.138358107663345109 D0, 413705.127071637107 D0/
-
- CALL HEADER('C316',0)
- ERRMAX= 0.0D0
- WRITE(LOUT,'(1X)')
-#if defined(CERNLIB_DOUBLE)
- NF=2
-#endif
-#if !defined(CERNLIB_DOUBLE)
- NF=1
-#endif
- DO 1000 JF=1,NF
- ERRMAX= 0.0D0
-#if !defined(CERNLIB_DOUBLE)
- WRITE(LOUT,'(/10X,''TEST FOR RPSIPG'')')
-#endif
-#if defined(CERNLIB_DOUBLE)
- IF(JF.EQ.1)WRITE(LOUT,'(/10X,''TEST FOR RPSIPG'')')
- IF(JF.EQ.2)WRITE(LOUT,'(/10X,''TEST FOR DPSIPG'')')
-#endif
- WRITE(LOUT,'(/5X,''K'',8X,''X'',
- + 14X,'' '',A,''(X)'',18X,''Exact'',11X,''Rel Error'')')
- + TFUNC(JF)
- DO 9 N = 0,6
- DO 1 I = 1,8
-#if !defined(CERNLIB_DOUBLE)
- IF ( .NOT. (N .EQ. 6 .AND. I .EQ. 7))THEN
- DAT=RPSIPG(X(I),N)
- IF(DAT .NE. 0) EDAT=ABS((DAT-TEST(N,I))/DAT)
- ERRMAX= MAX( ERRMAX,EDAT)
- WRITE(LOUT,'(1X,I5,F10.1,1P,2D27.18,D10.1)') N,X(I),DAT,
- + TEST(N,I),EDAT
- ENDIF
-#endif
-#if defined(CERNLIB_DOUBLE)
- IF(JF.EQ.1) THEN
- RAT=RPSIPG(SNGL(X(I)),N)
- IF(RAT .NE. 0) RDAT=ABS((RAT-SNGL(TEST(N,I)))/RAT)
- ERRMAX= MAX( SNGL(ERRMAX),RDAT)
- WRITE(LOUT,'(1X,I5,F10.1,1P,2E27.9,E10.1)') N,X(I),RAT,
- + SNGL(TEST(N,I)),RDAT
- ENDIF
- IF(JF.EQ.2) THEN
- DAT=DPSIPG(X(I),N)
- IF(DAT .NE. 0) EDAT=ABS((DAT-TEST(N,I))/DAT)
- ERRMAX= MAX( ERRMAX,EDAT)
- WRITE(LOUT,'(1X,I5,F10.1,1P,2D27.18,D10.1)') N,X(I),DAT,
- + TEST(N,I),EDAT
- ENDIF
-#endif
- 1 CONTINUE
- 9 CONTINUE
-#if !defined(CERNLIB_DOUBLE)
- ETOL=TOL(JF+1)
-#endif
-#if defined(CERNLIB_DOUBLE)
- ETOL=TOL(JF)
-#endif
- WRITE(LOUT,'(/''Largest Relative Error was''
- +,1P,D10.1)') ERRMAX
- LTEST=LTEST.AND.(ERRMAX.LE.ETOL)
- ERRMAX= 0D0
- WRITE(LOUT,'(/''TESTING ERROR MESSAGES:'')')
- WRITE(LOUT,'(1X)')
-#if !defined(CERNLIB_DOUBLE)
- DR=RPSIPG(Z1,8)
- WRITE(LOUT,'(1X)')
- DR=RPSIPG(-Z1,3)
-#endif
-#if defined(CERNLIB_DOUBLE)
- IF(JF.EQ.1)THEN
- RZ1=Z1
- DR=RPSIPG(RZ1,8)
- WRITE(LOUT,'(1X)')
- DR=RPSIPG(-RZ1,3)
- ENDIF
- IF(JF.EQ.2)THEN
- DR=DPSIPG(Z1,8)
- WRITE(LOUT,'(1X)')
- DR=DPSIPG(-Z1,3)
- ENDIF
-#endif
- 1000 CONTINUE
-C Check if the test was successful
- IRC=ITEST('C316',LTEST)
- CALL PAGEND('C316')
- END
diff --git a/src/mathlib/gen/tests/c317m.F b/src/mathlib/gen/tests/c317m.F
deleted file mode 100644
index 1aba728..0000000
--- a/src/mathlib/gen/tests/c317m.F
+++ /dev/null
@@ -1,59 +0,0 @@
-*
-* $Id: c317m.F,v 1.1.1.1 1996/04/01 15:01:15 mclareni Exp $
-*
-* $Log: c317m.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:15 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE C317M
-#include "iorc.inc"
-C This program tests the GENLIB routines ADIGAM and DDIGAM (C317)
-C by comparing computed results against some known theoretical
-C results.
-C Written by T Hepworth, Brunel University, England, 20.4.90
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION DDIGAM,X(7),EXACT(7),RESULT(7),ERROR(7),ERRMAX
- DOUBLE PRECISION TSTERR
-#endif
-#if !defined(CERNLIB_DOUBLE)
- REAL ADIGAM,X(7),EXACT(7),RESULT(7),ERROR(7),ERRMAX,TSTERR
-#endif
-C Set the maximum error allowed for the test to still be considered
-C successful
- PARAMETER ( TSTERR=1D-13)
-
-C Set up test data and theoretical solutions
- DATA X(1),EXACT(1) / 0.4D0, -0.2561384544585116D+01 /
- DATA X(2),EXACT(2) / 3.6D0, 0.1135662837388860D+01 /
- DATA X(3),EXACT(3) / 6.0D0, 0.1706117668431800D+01 /
- DATA X(4),EXACT(4) / 13.6D0, 0.2572854781961887D+01 /
- DATA X(5),EXACT(5) / 14.0D0, 0.2602918090232222D+01 /
- DATA X(6),EXACT(6) / 14.4D0, 0.2632104300151583D+01 /
- DATA X(7),EXACT(7) / 20.0D0, 0.2970523992242149D+01 /
-
- CALL HEADER('C317',0)
-C Initialise maximum error
- ERRMAX=0D0
- WRITE(LOUT,'(5X,''X'',8X,''Calculated Value'',13X,
- + ''Exact Value'',10x,''Absolute Error'')')
- DO 100 I=1,7
-#if defined(CERNLIB_DOUBLE)
- RESULT(I)=DDIGAM(X(I))
-#endif
-#if !defined(CERNLIB_DOUBLE)
- RESULT(I)=ADIGAM(X(I))
-#endif
-C Calculate absolute errors
- ERROR(I)= ABS ( RESULT(I)-EXACT(I) )
- ERRMAX=MAX ( ERRMAX,ERROR(I) )
- WRITE(LOUT,'(F6.1,3F24.16)') X(I),RESULT(I),EXACT(I),ERROR(I)
-100 CONTINUE
- WRITE(LOUT,'('' Largest Error'',F24.16)') ERRMAX
-
-C Check if the test was successful
- IRC=ITEST('C317',ERRMAX .LE. TSTERR)
- CALL PAGEND('C317')
- RETURN
- END
diff --git a/src/mathlib/gen/tests/c318m.F b/src/mathlib/gen/tests/c318m.F
deleted file mode 100644
index 68c1644..0000000
--- a/src/mathlib/gen/tests/c318m.F
+++ /dev/null
@@ -1,427 +0,0 @@
-*
-* $Id: c318m.F,v 1.1.1.1 1996/04/01 15:01:15 mclareni Exp $
-*
-* $Log: c318m.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:15 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE C318M
-C This program tests the operation of MATHLIB subprograms
-C ELFUN and DELFUN
-
-#include "imp64r.inc"
-c REAL RELI1C, RELIKC
- REAL RELIKC
-C Set maximum error allowed for test to be considered successful
- DIMENSION TOL(2)
-
-#include "gen/def64.inc"
- + Z0, Z1, Z2, X, K, XK, SN,CN,DN,SN0,CN0,DN0,SN1,CN1,DN1,
- + SNC,CNC,DNC, SNR, CNR,DNR
- PARAMETER (Z0 = 0, Z1 = 1, Z2 = 2)
- LOGICAL LTEST
-#include "iorc.inc"
- DATA LTEST/.TRUE./
- DATA TOL/1D-6, 5D-14/
-
- CALL HEADER('C318',0)
-
-#if defined(CERNLIB_DOUBLE)
- NF=2
-#endif
-#if !defined(CERNLIB_DOUBLE)
- NF=1
-#endif
- DO 1000 JF=1,NF
- IF(JF.EQ.1)WRITE(LOUT,'(/10X,''TEST FOR ELFUN'')')
- IF(JF.EQ.2)WRITE(LOUT,'(/10X,''TEST FOR DELFUN'')')
- ERRMAX= 0.0D0
-C--- Test 1 -----------
- WRITE(LOUT,'(/10X,''--- Test 1 ---'')')
- WRITE(LOUT,'(/4X,''X'',5X,''K'',13X,''SN'',18X,''CN'',22X,
- 1 ''DN'',14X,''SC'',6X,''SD'',15X,''Error'')')
- DO 1 IX = -4,4
- DO 2 IK = -4,4,4
-
- CALL C318S1(IX,IK,JF,ERRMAX)
- 2 CONTINUE
- 1 CONTINUE
-#if !defined(CERNLIB_DOUBLE)
- ETOL=TOL(JF+1)
-#endif
-#if defined(CERNLIB_DOUBLE)
- ETOL=TOL(JF)
-#endif
- WRITE(LOUT,'(/'' Largest Relative Error was'',1P,D9.1)') ERRMAX
- LTEST=LTEST.AND.(ERRMAX.LE.ETOL)
- ERRMAX=0D0
-
-C--- Test 2 -----------
- WRITE(LOUT,'(/10X,''--- Test 2 ---'')')
- WRITE(LOUT,'(/4X,''X'',5X,''K'',13X,''SN'',18X,''CN'',22X,
- 1''DN'',14X,''SC'',6X,''SD'',15X,''Error'')')
- DO 3 IK = -4,4
- DO 4 IX = -4,4,4
-
- CALL C318S1(IX,IK,JF,ERRMAX)
-
- 4 CONTINUE
- 3 CONTINUE
-#if !defined(CERNLIB_DOUBLE)
- ETOL=TOL(JF+1)
-#endif
-#if defined(CERNLIB_DOUBLE)
- ETOL=TOL(JF)
-#endif
- WRITE(LOUT,'(/'' Largest Relative Error was'',1P,D9.1)') ERRMAX
- LTEST=LTEST.AND.(ERRMAX.LE.ETOL)
-C1000 CONTINUE
- ERRMAX=0D0
-
-C--- Test 3 -----------
- WRITE(LOUT,'(/10X,''--- Test 3 ---'')')
-
- K=0.9D0
-#if !defined(CERNLIB_DOUBLE)
- P=RELIKC(K)
-#endif
-#if defined(CERNLIB_DOUBLE)
- IF(JF.EQ.1) THEN
- RK=0.9E0
- P=RELIKC(RK)
- ENDIF
- IF(JF.EQ.2) P=DELIKC(K)
-#endif
- WRITE(LOUT,'(/5X,''X'',20X,''SN'',24X,''CN'',26X,
- 1''DN'',13X,''Error'')')
-
- CALL C318S2(P,K,JF,ERRMAX)
-
- WRITE(LOUT,'(/'' Largest Relative Error was'',1P,D9.1)') ERRMAX
-
- ERRMAX=0D0
-
-C--- Test 4 -----------
- WRITE(LOUT,'(/10X,''--- Test 4 ---'')')
- K=1/0.9D0
-#if !defined(CERNLIB_DOUBLE)
- P=RELIKC(1/K)/K
-#endif
-#if defined(CERNLIB_DOUBLE)
- IF(JF.EQ.1) THEN
- RK=1/0.9E0
- P=RELIKC(1/RK)/RK
- ENDIF
- IF(JF.EQ.2) P=DELIKC(1/K)/K
-#endif
- WRITE(LOUT,'(/5X,''X'',20X,''SN'',24X,''CN'',26X,
- 1''DN'',13X,''Error'')')
-
- CALL C318S2(P,K,JF,ERRMAX)
-
- WRITE(LOUT,'(/'' Largest Relative Error was'',1P,D9.1)') ERRMAX
-
-C--- Test 5 -----------
- WRITE(LOUT,'(/10X,''--- Test 5 ---'')')
- K=0
-#if !defined(CERNLIB_DOUBLE)
- P=RELIKC(K)
-#endif
-#if defined(CERNLIB_DOUBLE)
- IF(JF.EQ.1) THEN
- RK=0E0
- P=RELIKC(RK)
- ENDIF
- IF(JF.EQ.2) P=DELIKC(K)
- WRITE(LOUT,'(/4X,''X'',14X,''Error'')')
- DO 7 IX=-205,195,100
- X=P*IX/50
-
-
-#endif
-#if !defined(CERNLIB_DOUBLE)
- CALL ELFUN(X,Z0,SN0,CN0,DN0)
-#endif
-#if defined(CERNLIB_DOUBLE)
- IF(JF.EQ.1) THEN
- RX=X
- RZ0=Z0
- CALL ELFUN(RX,RZ0,RSN0,RCN0,RDN0)
- SN0=RSN0
- CN0=RCN0
- DN0=RDN0
- ENDIF
- IF(JF.EQ.2) CALL DELFUN(X,Z0,SN0,CN0,DN0)
-
- ES=SN0-SIN(X)
- EC=CN0-COS(X)
- ED=DN0-1D0
- ERRMAX=MAX(ABS(ES),ABS(EC),ABS(ED),ERRMAX)
- WRITE(LOUT,'(1X,F6.2,3(1P,D9.1))') X,ABS(ES),ABS(EC),ABS(ED)
- 7 CONTINUE
- WRITE(LOUT,'(/'' Largest Relative Error was'',1P,D9.1)') ERRMAX
-
-C--- Test 6 -----------
- WRITE(LOUT,'(/10X,''--- Test 6 ---'')')
- K=0
-#endif
-#if !defined(CERNLIB_DOUBLE)
- P=RELIKC(K)
-#endif
-#if defined(CERNLIB_DOUBLE)
- IF(JF.EQ.1) THEN
- RK=0E0
- P=RELIKC(RK)
- ENDIF
- IF(JF.EQ.2) P=DELIKC(K)
- WRITE(LOUT,'(/4X,''X'',14X,''Error'')')
- DO 8 IX=-205,195,100
- X=P*IX/50
-
-#endif
-#if !defined(CERNLIB_DOUBLE)
- CALL ELFUN(X,Z1,SN1,CN1,DN1)
-#endif
-#if defined(CERNLIB_DOUBLE)
- IF(JF.EQ.1) THEN
- RX=X
- RZ1=Z1
- CALL ELFUN(RX,RZ1,RSN1,RCN1,RDN1)
- SN1=RSN1
- CN1=RCN1
- DN1=RDN1
- ENDIF
- IF(JF.EQ.2) CALL DELFUN(X,Z1,SN1,CN1,DN1)
-#endif
- ES=SN1-TANH(X)
- EC=CN1-(1D0/COSH(X))
- ED=DN1-(1D0/COSH(X))
- ERRMAX=MAX(ABS(ES),ABS(EC),ABS(ED),ERRMAX)
- WRITE(LOUT,'(1X,F6.2,3(1P,D9.1))') X,ABS(ES),ABS(EC),ABS(ED)
- 8 CONTINUE
- WRITE(LOUT,'(/'' Largest Relative Error was'',1P,D9.1)') ERRMAX
-
-1000 CONTINUE
-
-
-C Check if the test was successful
- IRC=ITEST('C318',LTEST)
- CALL PAGEND('C318')
-
- END
-
- SUBROUTINE C318S1(IX,IK,JF,ERRMAX)
-
-#include "imp64r.inc"
-c REAL RELI1C, RELIKC
-C Set maximum error allowed for test to be considered successful
- DIMENSION TOL(2)
-
-cSEQ,DEF64.
-c + Z0, Z1, Z2, X, K, XK, SN,CN,DN,SN0,CN0,DN0,SN1,CN1,DN1,
-c + SNC,CNC,DNC, SNR, CNR,DNR
- PARAMETER (Z0 = 0, Z1 = 1, Z2 = 2)
- LOGICAL LTEST
-#include "iorc.inc"
- DATA LTEST/.TRUE./
-C Set maximum error allowed for test to be considered successful
- DATA TOL/1D-6, 1D-15/
-
- X=IX/Z2
- K=IK/Z2
- XK=K
-#if !defined(CERNLIB_DOUBLE)
- CALL ELFUN(X,XK**2,SN,CN,DN)
-#endif
-#if defined(CERNLIB_DOUBLE)
- IF(JF.EQ.1) THEN
- RX=X
- RXK=XK
- CALL ELFUN(RX,RXK**2,RSN,RCN,RDN)
- SN=RSN
- CN=RCN
- DN=RDN
- XK=RXK
- ENDIF
- IF(JF.EQ.2) CALL DELFUN(X,XK**2,SN,CN,DN)
-#endif
- SC=SN**2+CN**2-1
- SD=(XK*SN)**2+DN**2-1
- ERRMAX=MAX(ABS(SC),ABS(SD),ERRMAX)
- DXX=1-XK**2
- IF(DXX.GE.0) THEN
- DA1=X
- RA1=RX
- DA2=1-XK**2
- RA2=1-RXK**2
- ELSE
- DA1=XK*X
- RA1=RXK*RX
- DA2=1-1/XK**2
- RA2=1-1/RXK**2
- ENDIF
-#if !defined(CERNLIB_DOUBLE)
- CALL DSCDN(DA1,DA2,SNC,CNC,DNC)
-#endif
-#if defined(CERNLIB_DOUBLE)
- IF(JF.EQ.1) THEN
- CALL RSCDN(RA1,RA2,RSNC,RCNC,RDNC)
- SNC=RSNC
- CNC=RCNC
- DNC=RDNC
- ENDIF
- IF(JF.EQ.2) CALL DSCDN(DA1,DA2,SNC,CNC,DNC)
-#endif
- IF(DXX.LT.0) THEN
- SNC=SNC/XK
- CNT=DNC
- DNC=CNC
- CNC=CNT
- ENDIF
- ES=SN-SNC
- EC=CN-CNC
- ED=DN-DNC
- ERRMAX=MAX(ABS(ES),ABS(EC),ABS(ED),ERRMAX)
- WRITE(LOUT,'(1X,2F6.2,3F22.16,5(1P,D9.1))')
- + X,XK,SN,CN,DN,ABS(SC),ABS(SD),ABS(ES),ABS(EC),ABS(ED)
- RETURN
- END
-
-
-
- SUBROUTINE C318S2(P,K,JF,ERRMAX)
-
-#include "imp64r.inc"
-c REAL RELI1C, RELIKC
-C Set maximum error allowed for test to be considered successful
- DIMENSION TOL(2)
-
-#include "gen/def64.inc"
- + Z0, Z1, Z2, X, K, XK, SN,CN,DN,SN0,CN0,DN0,SN1,CN1,DN1,
- + SNC,CNC,DNC, SNR, CNR,DNR
- PARAMETER (Z0 = 0, Z1 = 1, Z2 = 2)
- LOGICAL LTEST
-#include "iorc.inc"
- DATA TOL/1D-6, 1D-15/
- DATA LTEST/.TRUE./
-
- DO 55 IX=-205,195,100
- X=P*IX/50
-#if !defined(CERNLIB_DOUBLE)
- CALL ELFUN(X,K**2,SN,CN,DN)
-#endif
-#if defined(CERNLIB_DOUBLE)
- IF(JF.EQ.1) THEN
- RX=X
- RK=K
- CALL ELFUN(RX,RK**2,RSN,RCN,RDN)
- SN=RSN
- CN=RCN
- DN=RDN
- ENDIF
- IF(JF.EQ.2) CALL DELFUN(X,K**2,SN,CN,DN)
-#endif
- SC=SN**2+CN**2-1
- SD=(K*SN)**2+DN**2-1
- ERRMAX=MAX(ABS(SC),ABS(SD),ERRMAX)
- WRITE(LOUT,'(1X,F12.8,3F25.16,2(1P,D9.1))') X,SN,CN,DN,
- + ABS(SC),ABS(SD)
- 55 CONTINUE
- RETURN
- END
-
- SUBROUTINE DSCDN(X,AKP2,SN,CN,DN)
-
-C BASED ON ALGOL PROCEDURE SNCNDN(X,MC,SN,CN,DN) IN
-C R. BULIRSCH, Numerical Calculation of Elliptic Integrals and
-C Elliptic Functions, Numer. Math. 7 (1965) 78-90
-
-#include "gen/imp64.inc"
- LOGICAL LBO
-
- DIMENSION XM(0:12),XN(0:12)
-
- PARAMETER (ID = 16)
- PARAMETER (Z1 = 1, Z10 = 10, HF = Z1/2)
- PARAMETER (CA = Z10**(-ID/2))
-
-#if defined(CERNLIB_VAXVMS)
- DATA AMC0 /-1D20/
-#endif
-#if !defined(CERNLIB_VAXVMS)
- DATA AMC0 /-1D74/
-#endif
-
- SAVE AMC0,XM,XN,C,L
-
- IF(AKP2 .EQ. 0) THEN
- SN=TANH(X)
- CN=1/COSH(X)
- DN=CN
- ELSEIF(AKP2 .EQ. 1) THEN
- SN=SIN(X)
- CN=COS(X)
- DN=1
- ELSE
- XX=X
- YMC=AKP2
- LBO=YMC .LT. 0
- IF(LBO) THEN
- D=1-YMC
- YMC=-YMC/D
- D=SQRT(D)
- XX=D*XX
- ENDIF
- IF(AKP2 .EQ. AMC0) GO TO 2
- AMC0=AKP2
- A=1
- DO 1 I = 0,12
- L=I
- XM(I)=A
- YMC=SQRT(YMC)
- XN(I)=YMC
- C=HF*(A+YMC)
- IF(ABS(A-YMC) .LE. CA*A) GO TO 2
- YMC=A*YMC
- A=C
- 1 CONTINUE
- 2 XX=C*XX
- SN=SIN(XX)
- CN=COS(XX)
- DN=1
- IF(SN .NE. 0) THEN
- A=CN/SN
- C1=A*C
- DO 3 I = L,0,-1
- A=C1*A
- C1=DN*C1
- DN=(XN(I)+A)/(XM(I)+A)
- A=C1/XM(I)
- 3 CONTINUE
- SN=SIGN(1/SQRT(C1**2+1),SN)
- CN=C1*SN
- ENDIF
- IF(LBO) THEN
- A=DN
- DN=CN
- CN=A
- SN=SN/D
- ENDIF
- ENDIF
- RETURN
- END
-#if defined(CERNLIB_DOUBLE)
- SUBROUTINE RSCDN(X,AKP2,SN,CN,DN)
-#include "gen/def64.inc"
- + DSN,DCN,DDN,D
-
- SROUND(D)=D+(D-DBLE(SNGL(D)))
- CALL DSCDN(DBLE(X),DBLE(AKP2),DSN,DCN,DDN)
- SN=SROUND(DSN)
- CN=SROUND(DCN)
- DN=SROUND(DDN)
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/tests/c320m.F b/src/mathlib/gen/tests/c320m.F
deleted file mode 100644
index d99ebb2..0000000
--- a/src/mathlib/gen/tests/c320m.F
+++ /dev/null
@@ -1,222 +0,0 @@
-*
-* $Id: c320m.F,v 1.1.1.1 1996/04/01 15:01:15 mclareni Exp $
-*
-* $Log: c320m.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:15 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE C320M
-C This program tests the operation of MATHLIB subprograms
-C CELFUN and WELFUN
-
-#include "imp64r.inc"
-c REAL RRIZET
-C Set maximum error allowed for test to be considered successful
- DIMENSION TOL(2)
-
-#include "gen/def64.inc"
- + Z0, Z1, Z2, HF, XK2, U, V, SUK, CUK, DUK, SVK, CVK, DVK,
- + XKP2, SUKP, CUKP, DUKP, SVKP, CVKP, DVKP
-
- LOGICAL LTEST
-#include "gen/defc64.inc"
- + I,Z,SN,CN,DN,SNT,CNT,DNT
- COMPLEX IS,ZS,SNS,CNS,DNS,SNTS,CNTS,DNTS
- PARAMETER ( Z0 = 0, Z1 = 1, Z2 = 2, HF = Z1/2)
-#if defined(CERNLIB_CMPXDOUB)
- PARAMETER (I = (0D0,1D0))
-#endif
-#if !defined(CERNLIB_CMPXDOUB)
- PARAMETER (I = (0E0,1E0))
-#endif
- PARAMETER (IS= (0E0,1E0))
-#include "iorc.inc"
- DATA LTEST/.TRUE./
- DATA TOL/2D-5, 1D-12/
-
-
- CALL HEADER('C320',0)
-
- ERRMAX= 0.0E0
- JF=1
- WRITE(LOUT,'(/10X,''TEST FOR CELFUN'')')
- WRITE(LOUT,'(/9X,''Z'',12X,''XK'',7X,''SNerror'',3X,''CNerror''
- 1,3X,''DNerror'')')
- DO 11 IX = -4,4
- DO 11 IY = -4,4,4
- Z=HF*(IX+I*IY)
- U=Z
- V=-I*Z
- DO 11 IK = 0,4
- XK=IK/(2*Z2)
- XK2=XK**2
- XKP2=1-XK2
-
- ZS=Z
- RU=U
- RV=V
- RXK=XK
- RXK2=XK2
- RXKP2=XKP2
-
- CALL CELFUN(ZS,RXK2,SNS,CNS,DNS)
- CALL ELFUN(RU,RXK2,RSUK,RCUK,RDUK)
- CALL ELFUN(RV,RXK2,RSVK,RCVK,RDVK)
- CALL ELFUN(RU,RXKP2,RSUKP,RCUKP,RDUKP)
- CALL ELFUN(RV,RXKP2,RSVKP,RCVKP,RDVKP)
- RD=1/(1-(RSVKP*RDUK)**2)
- SNTS=(RSUK*RDVKP+IS*RCUK*RDUK*RSVKP*RCVKP)*RD
- CNTS=(RCUK*RCVKP-IS*RSUK*RDUK*RSVKP*RDVKP)*RD
- DNTS=(RDUK*RCVKP*RDVKP-IS*RXK2*RSUK*RCUK*RSVKP)*RD
- RSNE=0
- IF(SNS .NE. 0) RSNE=ABS((SNS-SNTS)/SNS)
- RCNE=ABS((CNS-CNTS)/CNS)
- RDNE=ABS((DNS-DNTS)/DNS)
- RERRMAX=ERRMAX
- ERRMAX=MAX(RDNE,RCNE,RSNE,RERRMAX)
- WRITE(LOUT,'(1X,''('',F6.2,'' ,'',F6.2,'' )'',F10.6,3(1P,D10.1))')
- 1 ZS,RXK,RSNE,RCNE,RDNE
- 11 CONTINUE
-
-#if !defined(CERNLIB_DOUBLE)
- ETOL=TOL(JF+1)
-#endif
-#if defined(CERNLIB_DOUBLE)
- ETOL=TOL(JF)
-#endif
- WRITE(LOUT,'(/'' Largest Relative Error was'',1P,D9.1)') ERRMAX
- LTEST=LTEST.AND.(ERRMAX.LE.ETOL)
- ERRMAX= 0E0
-
- WRITE(LOUT,'(/9X,''Z'',12X,''XK'',7X,''SNerror'',3X,''CNerror''
- 1,3X,''DNerror'')')
- DO 12 IK = 0,4
- XK=IK/(2*Z2)
- XK2=XK**2
- XKP2=1-XK2
- DO 12 IX = -4,4
- DO 12 IY = -4,4,4
- Z=HF*(IX+I*IY)
- U=Z
- V=-I*Z
-
- ZS=Z
- RU=U
- RV=V
- RXK=XK
- RXK2=XK2
- RXKP2=XKP2
-
- CALL CELFUN(ZS,RXK2,SNS,CNS,DNS)
- CALL ELFUN(RU,RXK2,RSUK,RCUK,RDUK)
- CALL ELFUN(RV,RXK2,RSVK,RCVK,RDVK)
- CALL ELFUN(RU,RXKP2,RSUKP,RCUKP,RDUKP)
- CALL ELFUN(RV,RXKP2,RSVKP,RCVKP,RDVKP)
- RD=1/(1-(RSVKP*RDUK)**2)
- SNTS=(RSUK*RDVKP+IS*RCUK*RDUK*RSVKP*RCVKP)*RD
- CNTS=(RCUK*RCVKP-IS*RSUK*RDUK*RSVKP*RDVKP)*RD
- DNTS=(RDUK*RCVKP*RDVKP-IS*RXK2*RSUK*RCUK*RSVKP)*RD
- RSNE=0
- IF(SNS .NE. 0) RSNE=ABS((SNS-SNTS)/SNS)
- RCNE=ABS((CNS-CNTS)/CNS)
- RDNE=ABS((DNS-DNTS)/DNS)
- RERRMAX=ERRMAX
- ERRMAX=MAX(RDNE,RCNE,RSNE,RERRMAX)
- WRITE(LOUT,'(1X,''('',F6.2,'' ,'',F6.2,'' )'',F10.6,3(1P,D10.1))')
- 1 ZS,RXK,RSNE,RCNE,RDNE
- 12 CONTINUE
-#if !defined(CERNLIB_DOUBLE)
- ETOL=TOL(JF+1)
-#endif
-#if defined(CERNLIB_DOUBLE)
- ETOL=TOL(JF)
-#endif
- WRITE(LOUT,'(/'' Largest Relative Error was'',1P,D9.1)') ERRMAX
- LTEST=LTEST.AND.(ERRMAX.LE.ETOL)
- ERRMAX= 0E0
-
- WRITE(LOUT,'(/''TESTING ERROR MESSAGES:''/)')
- RZ2=Z2
- CALL CELFUN(IS,RZ2,SNS,CNS,DNS)
-#if defined(CERNLIB_DOUBLE)
- ERRMAX= 0D0
- JF=2
- WRITE(LOUT,'(/10X,''TEST FOR WELFUN'')')
- WRITE(LOUT,'(/9X,''Z'',12X,''XK'',7X,''SNerror'',3X,''CNerror''
- 1,3X,''DNerror'')')
- DO 1 IX = -4,4
- DO 1 IY = -4,4,4
- Z=HF*(IX+I*IY)
- U=Z
- V=-I*Z
- DO 1 IK = 0,4
- XK=IK/(2*Z2)
- XK2=XK**2
- XKP2=1-XK2
- CALL WELFUN(Z,XK2,SN,CN,DN)
- CALL DELFUN(U,XK2,SUK,CUK,DUK)
- CALL DELFUN(V,XK2,SVK,CVK,DVK)
- CALL DELFUN(U,XKP2,SUKP,CUKP,DUKP)
- CALL DELFUN(V,XKP2,SVKP,CVKP,DVKP)
- D=1/(1-(SVKP*DUK)**2)
- SNT=(SUK*DVKP+I*CUK*DUK*SVKP*CVKP)*D
- CNT=(CUK*CVKP-I*SUK*DUK*SVKP*DVKP)*D
- DNT=(DUK*CVKP*DVKP-I*XK2*SUK*CUK*SVKP)*D
- SNE=0
- IF(SN .NE. 0) SNE=ABS((SN-SNT)/SN)
- CNE=ABS((CN-CNT)/CN)
- DNE=ABS((DN-DNT)/DN)
- ERRMAX=MAX(ABS(DNE),ABS(CNE),ABS(SNE),ERRMAX)
- WRITE(LOUT,'(1X,''('',F6.2,'' ,'',F6.2,'' )'',F10.6,3(1P,D10.1))')
- 1 Z,XK,SNE,CNE,DNE
- 1 CONTINUE
- ETOL=TOL(2)
-
- WRITE(LOUT,'(/'' Largest Relative Error was'',1P,D9.1)') ERRMAX
- LTEST=LTEST.AND.(ERRMAX.LE.ETOL)
- ERRMAX= 0D0
-
- WRITE(LOUT,'(/9X,''Z'',12X,''XK'',7X,''SNerror'',3X,''CNerror''
- 1,3X,''DNerror'')')
- DO 2 IK = 0,4
- XK=IK/(2*Z2)
- XK2=XK**2
- XKP2=1-XK2
- DO 2 IX = -4,4
- DO 2 IY = -4,4,4
- Z=HF*(IX+I*IY)
- U=Z
- V=-I*Z
- CALL WELFUN(Z,XK2,SN,CN,DN)
- CALL DELFUN(U,XK2,SUK,CUK,DUK)
- CALL DELFUN(V,XK2,SVK,CVK,DVK)
- CALL DELFUN(U,XKP2,SUKP,CUKP,DUKP)
- CALL DELFUN(V,XKP2,SVKP,CVKP,DVKP)
- D=1/(1-(SVKP*DUK)**2)
- SNT=(SUK*DVKP+I*CUK*DUK*SVKP*CVKP)*D
- CNT=(CUK*CVKP-I*SUK*DUK*SVKP*DVKP)*D
- DNT=(DUK*CVKP*DVKP-I*XK2*SUK*CUK*SVKP)*D
- SNE=0
- IF(SN .NE. 0) SNE=ABS((SN-SNT)/SN)
- CNE=ABS((CN-CNT)/CN)
- DNE=ABS((DN-DNT)/DN)
- ERRMAX=MAX(ABS(DNE),ABS(CNE),ABS(SNE),ERRMAX)
- WRITE(LOUT,'(1X,''('',F6.2,'' ,'',F6.2,'' )'',F10.6,3(1P,D10.1))')
- 1 Z,XK,SNE,CNE,DNE
- 2 CONTINUE
- ETOL=TOL(2)
- WRITE(LOUT,'(/'' Largest Relative Error was'',1P,D9.1)') ERRMAX
- LTEST=LTEST.AND.(ERRMAX.LE.ETOL)
- ERRMAX= 0D0
-
- WRITE(LOUT,'(/''TESTING ERROR MESSAGES:''/)')
- CALL WELFUN(I,Z2,SN,CN,DN)
-
-#endif
-
-C Check if the test was successful
- IRC=ITEST('C320',LTEST)
- CALL PAGEND('C320')
- END
diff --git a/src/mathlib/gen/tests/c321m.F b/src/mathlib/gen/tests/c321m.F
deleted file mode 100644
index 9e4fd07..0000000
--- a/src/mathlib/gen/tests/c321m.F
+++ /dev/null
@@ -1,256 +0,0 @@
-*
-* $Id: c321m.F,v 1.1.1.1 1996/04/01 15:01:15 mclareni Exp $
-*
-* $Log: c321m.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:15 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE C321M
- COMPLEX CGPLG,T
-#include "gen/defc64.inc"
- + WGPLG,DTST(4,4,7),DT
-#include "gen/def64.inc"
- + DX(7),DD
- LOGICAL LER,LET
-
-#include "iorc.inc"
-#include "gen/gcmpfun.inc"
- DATA D,DD /1.0E-6,8.0D-14/
-
- DATA DX /-2.0D0,-0.5D0,0.25D0,0.75D0,1.0D0,1.5D0,5.0D0/
-
-#if defined(CERNLIB_CMPXDOUB)
- DATA DTST(1,1,1) /(-.14367463668836D+01, .00000000000000D+00)/
- DATA DTST(1,1,2) /(-.44841420692365D+00, .00000000000000D+00)/
- DATA DTST(1,1,3) /( .26765263908274D+00, .00000000000000D+00)/
- DATA DTST(1,1,4) /( .97846939293027D+00, .00000000000000D+00)/
- DATA DTST(1,1,5) /( .16449340668482D+01, .00000000000000D+00)/
- DATA DTST(1,1,6) /( .23743952702724D+01,-.12738062049196D+01)/
- DATA DTST(1,1,7) /( .17837191612667D+01,-.50561983221119D+01)/
-
- DATA DTST(1,2,1) /( .42720966853130D+00, .00000000000000D+00)/
- DATA DTST(1,2,2) /( .46936455382062D-01, .00000000000000D+00)/
- DATA DTST(1,2,3) /( .18777455158514D-01, .00000000000000D+00)/
- DATA DTST(1,2,4) /( .29611472554438D+00, .00000000000000D+00)/
- DATA DTST(1,2,5) /( .12020569031596D+01, .00000000000000D+00)/
- DATA DTST(1,2,6) /( .81985149949006D-01,-.22916699577564D+01)/
- DATA DTST(1,2,7) /(-.55120087401031D+01,-.43600623305262D+00)/
-
- DATA DTST(1,3,1) /(-.10839640607013D+00, .00000000000000D+00)/
- DATA DTST(1,3,2) /(-.42967574086140D-02, .00000000000000D+00)/
- DATA DTST(1,3,3) /( .11854864944918D-02, .00000000000000D+00)/
- DATA DTST(1,3,4) /( .84974137061581D-01, .00000000000000D+00)/
- DATA DTST(1,3,5) /( .10823232337111D+01, .00000000000000D+00)/
- DATA DTST(1,3,6) /(-.15739031587440D+01,-.67184525068998D+00)/
- DATA DTST(1,3,7) /( .12291176779042D+01, .44586335630285D+01)/
-
- DATA DTST(1,4,1) /( .22844930902103D-01, .00000000000000D+00)/
- DATA DTST(1,4,2) /( .32977000196983D-03, .00000000000000D+00)/
- DATA DTST(1,4,3) /( .63465221918669D-04, .00000000000000D+00)/
- DATA DTST(1,4,4) /( .21151229130701D-01, .00000000000000D+00)/
- DATA DTST(1,4,5) /( .10369277551434D+01, .00000000000000D+00)/
- DATA DTST(1,4,6) /(-.69243037945201D+00, .80548935383572D+00)/
- DATA DTST(1,4,7) /( .25127799048950D+01,-.18955713596774D+01)/
-
- DATA DTST(2,1,1) /(-.16682833639666D+01, .00000000000000D+00)/
- DATA DTST(2,1,2) /(-.47259784465890D+00, .00000000000000D+00)/
- DATA DTST(2,1,3) /( .25846139579657D+00, .00000000000000D+00)/
- DATA DTST(2,1,4) /( .84442580886221D+00, .00000000000000D+00)/
- DATA DTST(2,1,5) /( .12020569031596D+01, .00000000000000D+00)/
- DATA DTST(2,1,6) /( .20608775073203D+01,-.25824198529329D+00)/
- DATA DTST(2,1,7) /( .48053441029656D+01,-.40688186361962D+01)/
-
- DATA DTST(2,2,1) /( .27346271026774D+00, .00000000000000D+00)/
- DATA DTST(2,2,2) /( .25698947631681D-01, .00000000000000D+00)/
- DATA DTST(2,2,3) /( .88118410049710D-02, .00000000000000D+00)/
- DATA DTST(2,2,4) /( .11078822950993D+00, .00000000000000D+00)/
- DATA DTST(2,2,5) /( .27058080842778D+00, .00000000000000D+00)/
- DATA DTST(2,2,6) /( .63148881513230D+00,-.60273727974786D+00)/
- DATA DTST(2,2,7) /(-.27426074173557D+01,-.30029477269020D+01)/
-
- DATA DTST(2,3,1) /(-.48899618400242D-01, .00000000000000D+00)/
- DATA DTST(2,3,2) /(-.16043036975596D-02, .00000000000000D+00)/
- DATA DTST(2,3,3) /( .36439773702569D-03, .00000000000000D+00)/
- DATA DTST(2,3,4) /( .19244816743277D-01, .00000000000000D+00)/
- DATA DTST(2,3,5) /( .96551159989444D-01, .00000000000000D+00)/
- DATA DTST(2,3,6) /(-.76143513871523D-01,-.45222047877242D+00)/
- DATA DTST(2,3,7) /(-.14264256992301D+01, .21581713178311D+01)/
-
- DATA DTST(3,1,1) /(-.18131260153285D+01, .00000000000000D+00)/
- DATA DTST(3,1,2) /(-.48571453783061D+00, .00000000000000D+00)/
- DATA DTST(3,1,3) /( .25411619074634D+00, .00000000000000D+00)/
- DATA DTST(3,1,4) /( .79222102797278D+00, .00000000000000D+00)/
- DATA DTST(3,1,5) /( .10823232337111D+01, .00000000000000D+00)/
- DATA DTST(3,1,6) /( .17347570807760D+01,-.34902704828337D-01)/
- DATA DTST(3,1,7) /( .59433309497680D+01,-.21828369906374D+01)/
-
- DATA DTST(3,2,1) /( .16317073401120D+00, .00000000000000D+00)/
- DATA DTST(3,2,2) /( .13675034531232D-01, .00000000000000D+00)/
- DATA DTST(3,2,3) /( .42273354896927D-02, .00000000000000D+00)/
- DATA DTST(3,2,4) /( .46605158823529D-01, .00000000000000D+00)/
- DATA DTST(3,2,5) /( .96551159989444D-01, .00000000000000D+00)/
- DATA DTST(3,2,6) /( .29828501641114D+00,-.93702799881914D-01)/
- DATA DTST(3,2,7) /(-.28850776666256D+00,-.25005296464634D+01)/
-
- DATA DTST(4,1,1) /(-.18981494563160D+01, .00000000000000D+00)/
- DATA DTST(4,1,2) /(-.49264922998110D+00, .00000000000000D+00)/
- DATA DTST(4,1,3) /( .25202158817858D+00, .00000000000000D+00)/
- DATA DTST(4,1,4) /( .76973541059980D+00, .00000000000000D+00)/
- DATA DTST(4,1,5) /( .10369277551434D+01, .00000000000000D+00)/
- DATA DTST(4,1,6) /( .15961739456814D+01,-.35379572466222D-02)/
- DATA DTST(4,1,7) /( .58810211422474D+01,-.87828515234895D+00)/
-
-#endif
-#if !defined(CERNLIB_CMPXDOUB)
- DATA DTST(1,1,1) /(-.14367463668836E+01, .00000000000000E+00)/
- DATA DTST(1,1,2) /(-.44841420692365E+00, .00000000000000E+00)/
- DATA DTST(1,1,3) /( .26765263908274E+00, .00000000000000E+00)/
- DATA DTST(1,1,4) /( .97846939293027E+00, .00000000000000E+00)/
- DATA DTST(1,1,5) /( .16449340668482E+01, .00000000000000E+00)/
- DATA DTST(1,1,6) /( .23743952702724E+01,-.12738062049196E+01)/
- DATA DTST(1,1,7) /( .17837191612667E+01,-.50561983221119E+01)/
-
- DATA DTST(1,2,1) /( .42720966853130E+00, .00000000000000E+00)/
- DATA DTST(1,2,2) /( .46936455382062E-01, .00000000000000E+00)/
- DATA DTST(1,2,3) /( .18777455158514E-01, .00000000000000E+00)/
- DATA DTST(1,2,4) /( .29611472554438E+00, .00000000000000E+00)/
- DATA DTST(1,2,5) /( .12020569031596E+01, .00000000000000E+00)/
- DATA DTST(1,2,6) /( .81985149949006E-01,-.22916699577564E+01)/
- DATA DTST(1,2,7) /(-.55120087401031E+01,-.43600623305262E+00)/
-
- DATA DTST(1,3,1) /(-.10839640607013E+00, .00000000000000E+00)/
- DATA DTST(1,3,2) /(-.42967574086140E-02, .00000000000000E+00)/
- DATA DTST(1,3,3) /( .11854864944918E-02, .00000000000000E+00)/
- DATA DTST(1,3,4) /( .84974137061581E-01, .00000000000000E+00)/
- DATA DTST(1,3,5) /( .10823232337111E+01, .00000000000000E+00)/
- DATA DTST(1,3,6) /(-.15739031587440E+01,-.67184525068998E+00)/
- DATA DTST(1,3,7) /( .12291176779042E+01, .44586335630285E+01)/
-
- DATA DTST(1,4,1) /( .22844930902103E-01, .00000000000000E+00)/
- DATA DTST(1,4,2) /( .32977000196983E-03, .00000000000000E+00)/
- DATA DTST(1,4,3) /( .63465221918669E-04, .00000000000000E+00)/
- DATA DTST(1,4,4) /( .21151229130701E-01, .00000000000000E+00)/
- DATA DTST(1,4,5) /( .10369277551434E+01, .00000000000000E+00)/
- DATA DTST(1,4,6) /(-.69243037945201E+00, .80548935383572E+00)/
- DATA DTST(1,4,7) /( .25127799048950E+01,-.18955713596774E+01)/
-
- DATA DTST(2,1,1) /(-.16682833639666E+01, .00000000000000E+00)/
- DATA DTST(2,1,2) /(-.47259784465890E+00, .00000000000000E+00)/
- DATA DTST(2,1,3) /( .25846139579657E+00, .00000000000000E+00)/
- DATA DTST(2,1,4) /( .84442580886221E+00, .00000000000000E+00)/
- DATA DTST(2,1,5) /( .12020569031596E+01, .00000000000000E+00)/
- DATA DTST(2,1,6) /( .20608775073203E+01,-.25824198529329E+00)/
- DATA DTST(2,1,7) /( .48053441029656E+01,-.40688186361962E+01)/
-
- DATA DTST(2,2,1) /( .27346271026774E+00, .00000000000000E+00)/
- DATA DTST(2,2,2) /( .25698947631681E-01, .00000000000000E+00)/
- DATA DTST(2,2,3) /( .88118410049710E-02, .00000000000000E+00)/
- DATA DTST(2,2,4) /( .11078822950993E+00, .00000000000000E+00)/
- DATA DTST(2,2,5) /( .27058080842778E+00, .00000000000000E+00)/
- DATA DTST(2,2,6) /( .63148881513230E+00,-.60273727974786E+00)/
- DATA DTST(2,2,7) /(-.27426074173557E+01,-.30029477269020E+01)/
-
- DATA DTST(2,3,1) /(-.48899618400242E-01, .00000000000000E+00)/
- DATA DTST(2,3,2) /(-.16043036975596E-02, .00000000000000E+00)/
- DATA DTST(2,3,3) /( .36439773702569E-03, .00000000000000E+00)/
- DATA DTST(2,3,4) /( .19244816743277E-01, .00000000000000E+00)/
- DATA DTST(2,3,5) /( .96551159989444E-01, .00000000000000E+00)/
- DATA DTST(2,3,6) /(-.76143513871523E-01,-.45222047877242E+00)/
- DATA DTST(2,3,7) /(-.14264256992301E+01, .21581713178311E+01)/
-
- DATA DTST(3,1,1) /(-.18131260153285E+01, .00000000000000E+00)/
- DATA DTST(3,1,2) /(-.48571453783061E+00, .00000000000000E+00)/
- DATA DTST(3,1,3) /( .25411619074634E+00, .00000000000000E+00)/
- DATA DTST(3,1,4) /( .79222102797278E+00, .00000000000000E+00)/
- DATA DTST(3,1,5) /( .10823232337111E+01, .00000000000000E+00)/
- DATA DTST(3,1,6) /( .17347570807760E+01,-.34902704828337E-01)/
- DATA DTST(3,1,7) /( .59433309497680E+01,-.21828369906374E+01)/
-
- DATA DTST(3,2,1) /( .16317073401120E+00, .00000000000000E+00)/
- DATA DTST(3,2,2) /( .13675034531232E-01, .00000000000000E+00)/
- DATA DTST(3,2,3) /( .42273354896927E-02, .00000000000000E+00)/
- DATA DTST(3,2,4) /( .46605158823529E-01, .00000000000000E+00)/
- DATA DTST(3,2,5) /( .96551159989444E-01, .00000000000000E+00)/
- DATA DTST(3,2,6) /( .29828501641114E+00,-.93702799881914E-01)/
- DATA DTST(3,2,7) /(-.28850776666256E+00,-.25005296464634E+01)/
-
- DATA DTST(4,1,1) /(-.18981494563160E+01, .00000000000000E+00)/
- DATA DTST(4,1,2) /(-.49264922998110E+00, .00000000000000E+00)/
- DATA DTST(4,1,3) /( .25202158817858E+00, .00000000000000E+00)/
- DATA DTST(4,1,4) /( .76973541059980E+00, .00000000000000E+00)/
- DATA DTST(4,1,5) /( .10369277551434E+01, .00000000000000E+00)/
- DATA DTST(4,1,6) /( .15961739456814E+01,-.35379572466222E-02)/
- DATA DTST(4,1,7) /( .58810211422474E+01,-.87828515234895E+00)/
-#endif
-
- CALL HEADER('C321',0)
-
- LET=.FALSE.
- DO 1 N = 1,4
- DO 2 M = 1,4
- IF(N+M .GT. 5) GO TO 2
-
- DO 3 IX = 1,7
-#if defined(CERNLIB_DOUBLE)
- T=CGPLG(N,M,SNGL(DX(IX)))
- LER=ABS(REAL(T)-SNGL(GREAL(DTST(N,M,IX)))) .GT. D .OR.
- 1 ABS(AIMAG(T)-SNGL(GIMAG(DTST(N,M,IX)))) .GT. D
-#endif
-#if !defined(CERNLIB_DOUBLE)
- T=CGPLG(N,M,DX(IX))
- LER=ABS(REAL(T)-(GREAL(DTST(N,M,IX)))) .GT. D .OR.
- 1 ABS(AIMAG(T)-(GIMAG(DTST(N,M,IX)))) .GT. D
-#endif
- LET=LET .OR. LER
-#if defined(CERNLIB_DOUBLE)
- IF(LER) WRITE(LOUT,100) N,M,SNGL(DX(IX))
-#endif
-#if !defined(CERNLIB_DOUBLE)
- IF(LER) WRITE(LOUT,100) N,M, DX(IX)
-#endif
- 3 CONTINUE
- 2 CONTINUE
- 1 CONTINUE
-
- IF(.NOT.LET) WRITE(LOUT,101)
-
-#if defined(CERNLIB_DOUBLE)
- LET=.FALSE.
- DO 11 N = 1,4
- DO 12 M = 1,4
- IF(N+M .GT. 5) GO TO 12
-
- DO 13 IX = 1,7
- DT=WGPLG(N,M,DX(IX))
- LER=ABS(REAL(DT)-REAL(DTST(N,M,IX))) .GT. DD .OR.
- 1 ABS(GIMAG(DT)-GIMAG(DTST(N,M,IX))) .GT. DD
- LET=LET .OR. LER
- IF(LER) WRITE(LOUT,102) N,M,SNGL(DX(IX))
- 13 CONTINUE
- 12 CONTINUE
- 11 CONTINUE
-
- IF(.NOT.LET) WRITE(LOUT,103)
-#endif
- WRITE(LOUT,'(/''TESTING ERROR MESSAGES:''/)')
- T=CGPLG(8,8,1.0)
-#if defined(CERNLIB_DOUBLE)
- T=WGPLG(8,8,1D0)
-#endif
-
- 100 FORMAT(1X,'***** C321 CGPLG TEST FAILED FOR N = ',I1,
- 1 ', M = ',I1,', X = ',F6.2)
- 101 FORMAT(1X,'***** C321 CGPLG TEST SUCCESSFUL')
-#if defined(CERNLIB_DOUBLE)
- 102 FORMAT(1X,'***** C321 WGPLG TEST FAILED FOR N = ',I1,
- 1 ', M = ',I1,', X = ',F6.2)
- 103 FORMAT(1X,'***** C321 WGPLG TEST SUCCESSFUL')
-#endif
-
-C Check if the test was successful
- IRC=ITEST('C321', .NOT. LET)
- CALL PAGEND('C321')
- RETURN
- END
diff --git a/src/mathlib/gen/tests/c322m.F b/src/mathlib/gen/tests/c322m.F
deleted file mode 100644
index eb90ceb..0000000
--- a/src/mathlib/gen/tests/c322m.F
+++ /dev/null
@@ -1,119 +0,0 @@
-*
-* $Id: c322m.F,v 1.1.1.1 1996/04/01 15:01:16 mclareni Exp $
-*
-* $Log: c322m.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:16 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE C322M
-C This program tests the GENLIB routines DFRSIN,DFRCOS,FRSIN,FRCOS,
-C (C322) by comparing computed results against those obtained from
-C another source of numerical integration.
-C Written by T Hepworth, Brunel University, England, 23.4.90
-C Revised by B. Damgaard Sept. 1992
-#include "gen/imp64.inc"
- REAL FRCOS, FRSIN,SX(7),SEXACT(7,0:1),SRESULT(7,0:1)
- REAL STSTERR,SERRMAX,SERROR(7,0:1)
-#include "gen/def64.inc"
- + DFRCOS,DFRSIN
-#include "gen/def64.inc"
- + TSTERR,ERRMAX
- DIMENSION X(7),EXACT(7,0:1),RESULT(7,0:1),ERROR(7,0:1)
-C Set the maximum error allowed for the test to still be considered
-C successful
- PARAMETER ( TSTERR=1D-13 )
-#if defined(CERNLIB_DOUBLE)
- PARAMETER (STSTERR=1D-6 )
-#endif
- LOGICAL LTEST
-#include "iorc.inc"
-
-C Set up test data and theoretical solutions
-C DFRSIN (or FRSIN) test data
- DATA X(1),EXACT(1,0) / 0.0D0, 0D0 /
- DATA X(2),EXACT(2,0) / -0.4D0, -0.1667371102944582D0 /
- DATA X(3),EXACT(3,0) / 0.4D0, 0.1667371102944582D0 /
- DATA X(4),EXACT(4,0) / 2.0D0, 1.4108529827013918D0 /
- DATA X(5),EXACT(5,0) / 7.6D0, 1.1413499262090459D0 /
- DATA X(6),EXACT(6,0) / 8.0D0, 1.2834177865335759D0 /
- DATA X(7),EXACT(7,0) / 12.4D0, 0.9764064367978704D0 /
-C DFRCOS (or FRCOS) test data
- DATA EXACT(1,1) / 0D0 /
- DATA EXACT(2,1) / -1.2448218501015764D0 /
- DATA EXACT(3,1) / 1.2448218501015764D0 /
- DATA EXACT(4,1) / 1.8882490336945132D0 /
- DATA EXACT(5,1) / 1.5946919390901555D0 /
- DATA EXACT(6,1) / 1.6024905840697365D0 /
- DATA EXACT(7,1) / 1.1954629800381893D0 /
-
- CALL HEADER('C322',0)
- LTEST= .TRUE.
-C Initialise maximum error
- ERRMAX=0D0
- SERRMAX=0E0
-#if defined(CERNLIB_DOUBLE)
- WRITE(LOUT,'(/5X,''X'',7X,''DFRSIN/DFRCOS'',11X,
- + ''Exact Value'',10X,''FRSIN/FRCOS'',5X,
- + ''Exact '',7X,''DError'',4X,''SError'')')
-#endif
-#if !defined(CERNLIB_DOUBLE)
- WRITE(LOUT,'(/5X,''X'',9X,''FRSIN/FRCOS'',13X,
- + ''Exact Value'',9X,''Error'')')
-#endif
- DO 100 I=1,7
- SX(I)=X(I)
- SEXACT(I,0)=EXACT(I,0)
- SEXACT(I,1)=EXACT(I,1)
-#if defined(CERNLIB_DOUBLE)
- RESULT(I,0)=DFRSIN(X(I))
- RESULT(I,1)=DFRCOS(X(I))
- SRESULT(I,0)= FRSIN(SX(I))
- SRESULT(I,1)= FRCOS(SX(I))
-#endif
-#if !defined(CERNLIB_DOUBLE)
- RESULT(I,0)=FRSIN(X(I))
- RESULT(I,1)=FRCOS(X(I))
-#endif
-C Calculate absolute errors
- ERROR(I,0)= ABS ( RESULT(I,0)-EXACT(I,0) )
- ERROR(I,1)= ABS ( RESULT(I,1)-EXACT(I,1) )
-#if defined(CERNLIB_DOUBLE)
- SERROR(I,0)= ABS (SRESULT(I,0)-SEXACT(I,0) )
- SERROR(I,1)= ABS (SRESULT(I,1)-SEXACT(I,1) )
- SERRMAX=MAX (SERRMAX,SERROR(I,0),SERROR(I,1) )
- ERRMAX=MAX ( ERRMAX,ERROR(I,0),ERROR(I,1) )
- WRITE(LOUT,'(F6.1,2F24.18,2F15.9,1P,2D10.1)')X(I),RESULT(I,0),
- + EXACT(I,0),SRESULT(I,0),SEXACT(I,0),
- + ERROR(I,0),SERROR(I,0)
- WRITE(LOUT,'(6X,2F24.18,2F15.9,1P,2D10.1)') RESULT(I,1),
- + EXACT(I,1),
- + SRESULT(I,1),SEXACT(I,1),ERROR(I,1),SERROR(I,1)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- ERRMAX=MAX ( ERRMAX,ERROR(I,0),ERROR(I,1) )
- WRITE(LOUT,'(F6.1,3F24.16)') X(I),RESULT(I,0),EXACT(I,0),
- + ERROR(I,0)
- WRITE(LOUT,'(6X,3F24.16)') RESULT(I,1),EXACT(I,1),ERROR(I,1)
-#endif
-
-100 CONTINUE
-#if !defined(CERNLIB_DOUBLE)
- WRITE(LOUT,'(/'' Largest Error'',1P,D10.1)') ERRMAX
-#endif
-#if defined(CERNLIB_DOUBLE)
- WRITE(LOUT,'(/''Double Precision largest Error'',1P,D10.1)')ERRMAX
- WRITE(LOUT,'(''Single Precision largest Error'',1P,D10.1)')SERRMAX
-#endif
-
- LTEST=LTEST .AND. (ERRMAX .LE. TSTERR)
-#if defined(CERNLIB_DOUBLE)
- LTEST=LTEST .AND. (SERRMAX .LE. STSTERR)
-#endif
- WRITE(LOUT,'(1X)')
-C Check if the test was successful
- IRC=ITEST('C322',LTEST)
- CALL PAGEND('C322')
- RETURN
- END
diff --git a/src/mathlib/gen/tests/c323m.F b/src/mathlib/gen/tests/c323m.F
deleted file mode 100644
index aeae568..0000000
--- a/src/mathlib/gen/tests/c323m.F
+++ /dev/null
@@ -1,124 +0,0 @@
-*
-* $Id: c323m.F,v 1.1.1.1 1996/04/01 15:01:16 mclareni Exp $
-*
-* $Log: c323m.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:16 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE C323M
-C This program tests the MATHLIB routines FERDR,DFERDR (C323)
-#include "gen/def64.inc"
- + DFERDR
-#include "gen/def64.inc"
- + X(4),EXACT(4,0:2),RESULT(4,0:2),
- + TSTERR,ERRMAX,ERROR(4,0:2)
-c REAL FERDR, FRCOS, FRSIN,SX(4),SEXACT(4,0:2),SRESULT(4,0:2),
- REAL FERDR, SX(4),SEXACT(4,0:2),SRESULT(4,0:2),
- + STSTERR,SERRMAX,SERROR(4,0:2)
- INTEGER K(0:2)
-C Set the maximum error allowed for the test to still be considered
-C successful
- PARAMETER ( TSTERR=1D-12)
- PARAMETER (STSTERR=5D-6 )
- LOGICAL LTEST
-#include "iorc.inc"
-C Set up test data and theoretical solutions
- DATA K(0),K(1),K(2) / -1, 1, 3 /
- DATA X / 0.0D0,2.0D0,4.0D0,10.0D0/
-
- DATA (EXACT(I,0),EXACT(I,1),EXACT(I,2),I=1,4)/
- + 1.07215492998544293D0,0.678093895181781731D0,
- + 1.15280383710969403D0,
- + 2.59539458607676621D0,2.50245782805757155D0,
- + 5.53725368941236828D0,
- + 3.87435314445380663D0,5.77072652243627493D0,
- + 17.6277024547494925D0,
- + 6.29713709574403624D0,21.3444715741730811D0,
- + 134.270159991638756D0/
- CALL HEADER('C323',0)
-C Initialise maximum error
- ERRMAX=0D0
- SERRMAX=0E0
- LTEST=.TRUE.
-#if defined(CERNLIB_DOUBLE)
- WRITE(LOUT,'(/5X,''X'',12X,''DFERDR'',14X,
- + ''Exact Value'',13X,''FERDR'',8X,
- + ''Exact '',7X,''DError'',4X,''SError'')')
-#endif
-#if !defined(CERNLIB_DOUBLE)
- WRITE(LOUT,'(/5X,''X'',9X,''FERDR'',13X,
- + ''Exact Value'',9X,''Error'')')
-#endif
- DO 100 I=1,4
- SX(I)=X(I)
- SEXACT(I,0)=EXACT(I,0)
- SEXACT(I,1)=EXACT(I,1)
- SEXACT(I,2)=EXACT(I,2)
-#if defined(CERNLIB_DOUBLE)
- RESULT(I,0)=DFERDR( X(I),K(0) )
- RESULT(I,1)=DFERDR( X(I),K(1) )
- RESULT(I,2)=DFERDR( X(I),K(2) )
- SRESULT(I,0)=FERDR(SX(I),K(0) )
- SRESULT(I,1)=FERDR(SX(I),K(1) )
- SRESULT(I,2)=FERDR(SX(I),K(2) )
-#endif
-#if !defined(CERNLIB_DOUBLE)
- RESULT(I,0)=FERDR( X(I),K(0) )
- RESULT(I,1)=FERDR( X(I),K(1) )
- RESULT(I,2)=FERDR( X(I),K(2) )
-#endif
-C Calculate absolute errors
- ERROR(I,0)= ABS ( RESULT(I,0)-EXACT(I,0) )
- ERROR(I,1)= ABS ( RESULT(I,1)-EXACT(I,1) )
- ERROR(I,2)= ABS ( RESULT(I,2)-EXACT(I,2) )
- ERRMAX=MAX ( ERRMAX,ERROR(I,0),ERROR(I,1),ERROR(I,2) )
- LTEST=LTEST .AND. ERRMAX .LE. TSTERR
-#if defined(CERNLIB_DOUBLE)
- SERROR(I,0)= ABS (SRESULT(I,0)-SEXACT(I,0) )
- SERROR(I,1)= ABS (SRESULT(I,1)-SEXACT(I,1) )
- SERROR(I,2)= ABS (SRESULT(I,2)-SEXACT(I,2) )
- SERRMAX=MAX ( SERRMAX,SERROR(I,0),SERROR(I,1),SERROR(I,2) )
- LTEST=LTEST .AND. SERRMAX .LE. STSTERR
-#endif
-#if !defined(CERNLIB_DOUBLE)
- WRITE(LOUT,'(F6.1,2F24.16,1P,D10.1)') X(I),RESULT(I,0),
- + EXACT(I,0), ERROR(I,0)
- WRITE(LOUT,'(6X,2F24.16,1P,D10.1)') RESULT(I,1),EXACT(I,1),
- + ERROR(I,1)
- WRITE(LOUT,'(6X,2F24.16,1P,D10.1)') RESULT(I,2),EXACT(I,2),
- + ERROR(I,2)
-#endif
-#if defined(CERNLIB_DOUBLE)
- WRITE(LOUT,'(F6.1,2F24.16,2F15.8,1P,2D10.1)') X(I),
- + RESULT(I,0),EXACT(I,0),
- + SRESULT(I,0),SEXACT(I,0),ERROR(I,0),SERROR(I,0)
- WRITE(LOUT,'(6X,2F24.16,2F15.8,1P,2D10.1)') RESULT(I,1),
- + EXACT(I,1),
- + SRESULT(I,1),SEXACT(I,1),ERROR(I,1),SERROR(I,1)
- WRITE(LOUT,'(6X,2F24.16,2F15.8,1P,2D10.1)') RESULT(I,2),
- + EXACT(I,2),
- + SRESULT(I,2),SEXACT(I,2),ERROR(I,2),SERROR(I,2)
-#endif
-C WRITE(LOUT,*) RESULT(I,0), RESULT(I,1), RESULT(I,2)
-100 CONTINUE
-#if !defined(CERNLIB_DOUBLE)
- WRITE(LOUT,'(/'' Largest Error'',1P,D10.1)') ERRMAX
-#endif
-#if defined(CERNLIB_DOUBLE)
- WRITE(LOUT,'(/''Double Precision largest Error'',1P,D10.1)')ERRMAX
- WRITE(LOUT,'(''Single Precision largest Error'',1P,D10.1)')SERRMAX
-#endif
-
- WRITE(LOUT,'(/''TESTING ERROR MESSAGES:''/)')
-#if defined(CERNLIB_DOUBLE)
- R=DFERDR(1D0,0)
-#endif
- R= FERDR(1E0,0)
- WRITE(LOUT,'(1X)')
-C Check if the test was successful
- IRC=ITEST('C323',LTEST)
- CALL PAGEND('C323')
- RETURN
- END
diff --git a/src/mathlib/gen/tests/c324m.F b/src/mathlib/gen/tests/c324m.F
deleted file mode 100644
index 9ea4e54..0000000
--- a/src/mathlib/gen/tests/c324m.F
+++ /dev/null
@@ -1,81 +0,0 @@
-*
-* $Id: c324m.F,v 1.1.1.1 1996/04/01 15:01:16 mclareni Exp $
-*
-* $Log: c324m.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:16 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE C324M
-C This program tests the MATHLIB routines ATANI and DATANI (C324)
-#include "gen/def64.inc"
- + DATANI
-#include "gen/def64.inc"
- + X(7),EXACT(7),RESULT(7),ERROR(7),ERRMAX,TSTERR
- REAL ATANI,SX(7),SEXACT(7),SRESULT(7),SERROR(7),SERRMAX,STSTERR
-C Set the maximum error allowed for the test to still be considered
-C successful
- PARAMETER ( TSTERR=1D-13 )
- PARAMETER (STSTERR=1E-6 )
- LOGICAL LTEST
-#include "iorc.inc"
-C Set up test data and theoretical solutions
- DATA X(1),EXACT(1) / -6.8D0, -3.1578031718126307D+00 /
- DATA X(2),EXACT(2) / -2.0D0, -1.5760154034463227D+00 /
- DATA X(3),EXACT(3) / -0.8D0, -0.7531060909241987D+00 /
- DATA X(4),EXACT(4) / 0.0D0, -0.0D+00 /
- DATA X(5),EXACT(5) / 0.8D0, 0.7531060909241987D+00 /
- DATA X(6),EXACT(6) / 2.0D0, 1.5760154034463227D+00 /
- DATA X(7),EXACT(7) / 6.8D0, 3.1578031718126307D+00 /
-
- CALL HEADER('C324',0)
-C Initialise maximum error
- ERRMAX=0D0
- SERRMAX=0E0
- LTEST=.TRUE.
-#if defined(CERNLIB_DOUBLE)
- WRITE(LOUT,'(/5X,''X'',8X,''DATANI/ATANI'',13X,
- + ''Exact Value'',10x,''Error'')')
-#endif
-#if !defined(CERNLIB_DOUBLE)
- WRITE(LOUT,'(/5X,''X'',8X,''ATANI'',13X,
- + ''Exact Value'',10x,''Error'')')
-#endif
- DO 100 I=1,7
- SX(I)=X(I)
- SEXACT(I)=EXACT(I)
-#if defined(CERNLIB_DOUBLE)
- RESULT(I)=DATANI(X(I))
- SRESULT(I)= ATANI(SX(I))
-#endif
-#if !defined(CERNLIB_DOUBLE)
- RESULT(I)=ATANI(X(I))
-#endif
-C Calculate absolute errors
- ERROR(I)= ABS ( RESULT(I)-EXACT(I) )
- ERRMAX=MAX ( ERRMAX,ERROR(I) )
- LTEST=LTEST .AND. ERRMAX .LE. TSTERR
- WRITE(LOUT,'(F6.1,2F24.16,1P,D10.1)') X(I),RESULT(I),EXACT(I),
- + ERROR(I)
-#if defined(CERNLIB_DOUBLE)
- SERROR(I)= ABS (SRESULT(I)-SEXACT(I) )
- SERRMAX=MAX ( SERRMAX,SERROR(I) )
- LTEST=LTEST .AND. SERRMAX .LE. STSTERR
- WRITE(LOUT,'(6X,2F24.8,1P,D10.1)') SRESULT(I),SEXACT(I),SERROR(I)
-#endif
-100 CONTINUE
-#if !defined(CERNLIB_DOUBLE)
- WRITE(LOUT,'(/'' Largest Error'',1P,D10.1)') ERRMAX
-#endif
-#if defined(CERNLIB_DOUBLE)
- WRITE(LOUT,'(/''Double Precision largest Error'',1P,D10.1)')ERRMAX
- WRITE(LOUT,'(''Single Precision largest Error'',1P,D10.1)')SERRMAX
-#endif
- WRITE(LOUT,'(1X)')
-
-C Check if the test was successful
- IRC=ITEST('C324',LTEST)
- CALL PAGEND('C324')
- RETURN
- END
diff --git a/src/mathlib/gen/tests/c326m.F b/src/mathlib/gen/tests/c326m.F
deleted file mode 100644
index 7d45ea1..0000000
--- a/src/mathlib/gen/tests/c326m.F
+++ /dev/null
@@ -1,43 +0,0 @@
-*
-* $Id: c326m.F,v 1.1 1996/04/02 16:23:49 mclareni Exp $
-*
-* $Log: c326m.F,v $
-* Revision 1.1 1996/04/02 16:23:49 mclareni
-* More precise dclaus64 (C326), test added and C344 removed from TESTALL
-*
-*
- SUBROUTINE C326M
-
-C C326 RCLAUS, DCLAUS
-
- IMPLICIT DOUBLE PRECISION (A-H,O-Z)
- LOGICAL LOK
-
- DIMENSION X(12),TST(12)
-
- PARAMETER (R1 = 1)
-
- DATA EPS /1D-15/
-
- DATA X( 1),TST( 1) /-2.45D0, -0.963900225025517D0/
- DATA X( 2),TST( 2) / 0.02D0, 0.236709452977620D0/
- DATA X( 3),TST( 3) / 0.30D0, 1.009992452806288D0/
- DATA X( 4),TST( 4) / 0.50D0, 0.915965594177219D0/
- DATA X( 5),TST( 5) / 0.67D0, 0.670859652431799D0/
- DATA X( 6),TST( 6) / 0.94D0, 0.130375860631878D0/
- DATA X( 7),TST( 7) / 1.11D0, -0.237809750272603D0/
- DATA X( 8),TST( 8) / 1.29D0, -0.599310111126993D0/
- DATA X( 9),TST( 9) / 1.53D0, -0.946337252128296D0/
- DATA X(10),TST(10) / 1.80D0, -0.923755168100536D0/
- DATA X(11),TST(11) / 1.99D0, -0.140129295431774D0/
- DATA X(12),TST(12) / 2.25D0, 0.981872151050203D0/
-
- LOK=.TRUE.
- PI=4*ATAN(R1)
- DO 1 I = 1,12
- RES=DCLAUS(PI*X(I))
- 1 LOK=LOK .AND. ABS(RES-TST(I))/RES .LE. EPS
- WRITE(6,'(1X)')
- IF(LOK) WRITE(6,'(7X,''C326 DCLAUS ** TEST SUCCESSFUL **'')')
- IF(.NOT.LOK) WRITE(6,'(7X,''C326 DCLAUS ** TEST FAILED **'')')
- END
diff --git a/src/mathlib/gen/tests/c327m.F b/src/mathlib/gen/tests/c327m.F
deleted file mode 100644
index 100093f..0000000
--- a/src/mathlib/gen/tests/c327m.F
+++ /dev/null
@@ -1,251 +0,0 @@
-*
-* $Id: c327m.F,v 1.2 2006/09/15 09:34:55 mclareni Exp $
-*
-* $Log: c327m.F,v $
-* Revision 1.2 2006/09/15 09:34:55 mclareni
-* Submitted mods for gcc4/gfortran and MacOSX, corrected to work also on slc4 with gcc3.4 and 4.1
-*
-* Revision 1.1.1.1 1996/04/01 15:01:17 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE C327M
-C This program tests MATHLIB routines
-C DEBIR4 , DBSIR4, DEBKR4, DBSKR4,
-C EBSIR4 , BSIR4, EBSKR4, and BSKR4 (C327)
-#include "gen/imp64.inc"
- REAL BSIR4,BSKR4,EBSIR4,EBSKR4,R,SX
- LOGICAL LTEST
- EXTERNAL DF1,DF2,DF4N
-C Set maximum error allowed for test to be considered successful
- PARAMETER ( TSTERR=1D-11)
- PARAMETER (STSTERR=1D-6 )
- COMMON /FORINTC327/ X,P
-#include "iorc.inc"
-
- DIMENSION XX(20),N(9)
- CHARACTER Z*52
-
-#if defined(CERNLIB_DOUBLE)
- DTEIR4(TM)=(DGAUSS(DF1,0D0,PI,DEPS*H)-SIN(PI*P)*
- 1 DGAUSS(DF2,0D0,TM,DEPS*H))/PI
-#endif
-#if !defined(CERNLIB_DOUBLE)
- DTEIR4(TM)=( GAUSS(DF1,0E0,PI,DEPS*H)-SIN(PI*P)*
- 1 GAUSS(DF2,0E0,TM,DEPS*H))/PI
-#endif
- DATA XX /0.00001D0,0.0001D0,0.001D0,0.01D0,0.1D0,0.5D0,1D0,2D0,
- 1 3D0,4D0,4.99D0,5D0,6D0,7D0,8D0,9D0,10D0,20D0,50D0,100D0/
-
- DATA N /1,2,3,-1,-2,-3,1,2,3/
- DATA DEPS /1D-13/
-
- CALL HEADER('C327',0)
- ERRMAX=0D0
- SERRMAX=0E0
- LTEST= .TRUE.
- PI = 3.14159 26535 89793D0
-C--- Number of functions to test
-#if defined(CERNLIB_DOUBLE)
- KP=1
-#endif
-#if !defined(CERNLIB_DOUBLE)
- KP=2
-#endif
- DO 9 IDS = KP,2
- DO 1 J = 1,9
- NU=N(J)
- P=NU/4D0
- IF(MOD(ABS(NU),2) .EQ. 1 .AND. J .LE. 6) WRITE(LOUT,100)
- IF(MOD(NU,2) .EQ. 1 .AND. J .GE. 7) WRITE(LOUT,101)
- IF(ABS(NU) .EQ. 2) WRITE(LOUT,'(///)')
-#if !defined(CERNLIB_APOLLO)
- DO 2 I = 1,19
-#endif
-#if defined(CERNLIB_APOLLO)
- DO 2 I =11,18
- IF (I .NE. 13 .AND. I .NE. 14)THEN
-#endif
- X=XX(I)
- SX=X
- IF(J .LE. 6) THEN
- IF(IDS .EQ. 1) THEN
- H=DEBIR4(X,NU)
- F=DBSIR4(X,NU)
- ELSE
- H=EBSIR4(SX,NU)
- F=BSIR4(SX,NU)
- ENDIF
- IF(X .LT. 1D0) T=EXP(-X)*DSERIE(X,P)
- IF(X .GE. 1D0) T=DTEIR4(DTMAX(X,P))
- ELSE
- IF(IDS .EQ. 1) THEN
- H=DEBKR4(X,NU)
- F=DBSKR4(X,NU)
- ELSE
- H=EBSKR4(SX,NU)
- F=BSKR4(SX,NU)
- ENDIF
-#if defined(CERNLIB_DOUBLE)
- T =DGAUSS(DF4N,0D0,1D0,DEPS*H)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- T = GAUSS(DF4N,0E0,1E0,DEPS*H)
-#endif
- ENDIF
- WRITE(Z,'(2D26.16)') H,T
-#if defined(CERNLIB_MACOSX)
- READ(Z,'(2(4X,D22.16))') H1,T1
-#else
- READ(Z,'(2(D22.16,4X))') H1,T1
-#endif
- IF(IDS .EQ. 1) THEN
- ERRMAX=MAX(ERRMAX,ABS(H1-T1))
- LTEST= LTEST .AND. ERRMAX .LE. TSTERR
- ELSE
-#if defined(CERNLIB_DOUBLE)
- SERRMAX=MAX(SERRMAX,ABS(H1-T1))
- LTEST= LTEST .AND. SERRMAX .LE. STSTERR
-#endif
-#if !defined(CERNLIB_DOUBLE)
- SERRMAX=MAX(SERRMAX,ABS(H1-T1))
- LTEST= LTEST .AND. SERRMAX .LE. TSTERR
-#endif
- ENDIF
- IF(IDS .EQ. 1) THEN
- WRITE(LOUT,'(1X,I4,D10.3,3D25.16,1P,D10.1)') NU,X,H,F,T,
- + ABS(H1-T1)
- ELSE
-#if defined(CERNLIB_DOUBLE)
- WRITE(LOUT,'(1X,I4,D10.3,3D25.7,1P,D10.1)') NU,X,H,F,T,ABS(H1-T1)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- WRITE(LOUT,'(1X,I4,D10.3,3D25.16,1P,D10.1)') NU,X,H,F,T,
- + ABS(H1-T1)
-#endif
- ENDIF
-#if defined(CERNLIB_APOLLO)
- ENDIF
-#endif
- 2 CONTINUE
- 1 CONTINUE
-
- WRITE(LOUT,'(/7X,''TESTING ERROR MESSAGES:''/)')
- IF(IDS .EQ. 1) THEN
- R=DBSIR4(1D0,+5)
- R=DBSIR4(1D0,-5)
- R=DBSIR4(0D0,+1)
- R=DBSIR4(0D0,-1)
- R=DBSIR4(0D0,-5)
- R=DBSKR4(1D0,+5)
- R=DBSKR4(1D0,-5)
- R=DBSKR4(0D0,+1)
- R=DBSKR4(0D0,-1)
- R=DEBIR4(1D0,+5)
- R=DEBIR4(1D0,-5)
- R=DEBIR4(0D0,+1)
- R=DEBIR4(0D0,-1)
- R=DEBIR4(0D0,-5)
- R=DEBKR4(1D0,+5)
- R=DEBKR4(1D0,-5)
- R=DEBKR4(0D0,+1)
- R=DEBKR4(0D0,-1)
- ELSE
- R=BSIR4(1.0,+5)
- R=BSIR4(1.0,-5)
- R=BSIR4(0.0,+1)
- R=BSIR4(0.0,-1)
- R=BSIR4(0.0,-5)
- R=BSKR4(1.0,+5)
- R=BSKR4(1.0,-5)
- R=BSKR4(0.0,+1)
- R=BSKR4(0.0,-1)
- R=EBSIR4(1.0,+5)
- R=EBSIR4(1.0,-5)
- R=EBSIR4(0.0,+1)
- R=EBSIR4(0.0,-1)
- R=EBSIR4(0.0,-5)
- R=EBSKR4(1.0,+5)
- R=EBSKR4(1.0,-5)
- R=EBSKR4(0.0,+1)
- R=EBSKR4(0.0,-1)
- ENDIF
- 9 CONTINUE
-#if !defined(CERNLIB_DOUBLE)
- WRITE(LOUT,'(/'' Largest Error'',1P,D10.1)')SERRMAX
-#endif
-#if defined(CERNLIB_DOUBLE)
- WRITE(LOUT,'(/''Double Precision largest Error'',1P,D10.1)')ERRMAX
- WRITE(LOUT,'(''Single Precision largest Error'',1P,D10.1)')SERRMAX
-#endif
- 100 FORMAT('1',5X,'I NU/4 (X)'//
- 1 1X,2X,'NU',9X,'X',13X,'EXP(-X)*I(X)',21X,'I(X)',21X,'TEST',
- 2 5X,'Error'/)
- 101 FORMAT('1',5X,'K NU/4 (X)'//
- 1 1X,2X,'NU',9X,'X',14X,'EXP(X)*K(X)',21X,'K(X)',21X,'TEST',
- 2 5X,'Error'/)
- WRITE(LOUT,'(1X)')
-
-C Check if the test was successful
- IRC=ITEST('C327',LTEST)
- CALL PAGEND('C327')
- RETURN
- END
- FUNCTION DTMAX(X,P)
-#include "gen/imp64.inc"
- DIMENSION I1(3),I2(3),I3(3)
-
- DATA DEPS /1D-22/
- DATA I1 /1,30,200/, I2 /20,100,3000/, I3 /1,10,100/
-
- DO 1 K = 1,3
- DO 1 I = I1(K),I2(K),I3(K)
- TM=I/10D0
- DTMAX=TM
- IF(EXP(-X*(1+COSH(TM))-P*TM) .LE. DEPS*EXP(-2*X)) RETURN
- 1 CONTINUE
- RETURN
- END
- FUNCTION DF(T)
-#include "gen/imp64.inc"
- COMMON /FORINTC327/X,P
-
- ENTRY DF1(T)
- DF=EXP(X*(COS(T)-1))*COS(P*T)
- RETURN
-
- ENTRY DF2(T)
- DF=EXP(-X*(COSH(T)+1)-P*T)
- RETURN
-
- ENTRY DF4N(T)
- IF( (P*T/(1-T)) .LT. 30D0 .AND. (T/(1-T)) .LT. 30D0
- + .AND. ABS(X*(1-COSH(T/(1-T)))) .LE. 50) THEN
- DF=(1/(1-T)**2)*EXP( X*(1-COSH(T/(1-T))))
- +*COSH(P*T/(1-T))
- ELSE
- DF=0
- ENDIF
- RETURN
-
- END
- FUNCTION DSERIE(X,P)
-#include "gen/imp64.inc"
-
- Y=(X/2)**2
-#if defined(CERNLIB_DOUBLE)
- A=1/DGAMMA(P+1)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- A=1/ GAMMA(P+1)
-#endif
- S=A
- K=0
- 1 K=K+1
- A=(1/(K*(P+K)))*A*Y
- S=S+A
- IF(ABS(A) .GT. 1D-20) GO TO 1
- DSERIE=(X/2)**P*S
- RETURN
- END
diff --git a/src/mathlib/gen/tests/c328m.F b/src/mathlib/gen/tests/c328m.F
deleted file mode 100644
index a150858..0000000
--- a/src/mathlib/gen/tests/c328m.F
+++ /dev/null
@@ -1,122 +0,0 @@
-*
-* $Id: c328m.F,v 1.1.1.1 1996/04/01 15:01:17 mclareni Exp $
-*
-* $Log: c328m.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:17 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE C328M
-C Test the MATHLIB routines CWHITM and WWHITM (C328)
-C Set the number of tests
- PARAMETER ( NT=4 )
-#include "gen/def64.inc"
- + ERROR(NT),ERRMAX
-#if defined(CERNLIB_DOUBLE)
-#include "gen/defc64.inc"
- + WWHITM
- REAL SERROR(NT),SERRMAX
- COMPLEX SZ(NT),SKA(NT),SMU(NT),SEXACT(NT),SSOL(NT)
-#endif
-#include "gen/defc64.inc"
- + Z(NT),KA(NT),MU(NT),EXACT(NT),SOL(NT)
- COMPLEX CWHITM
-C Set maximum error allowed for test to be considered successful
- PARAMETER ( TSTERR=1D-12)
-#if defined(CERNLIB_DOUBLE)
- PARAMETER (STSTERR=1D-6 )
-#endif
- LOGICAL LTEST
-#include "iorc.inc"
-C Set up the test parameters EXACT holds analytical solution
- DATA KA(1),MU(1),Z(1) / (1,0), (2,0), (5,-3) /
-#if !defined(CERNLIB_CMPXDOUB)
- DATA KA(2),MU(2),Z(2)/(-2.25E0,0E0),(-0.25E0,0E0), (0E0,2E0) /
-#endif
-#if defined(CERNLIB_CMPXDOUB)
- DATA KA(2),MU(2),Z(2) / (-2.25D0,0D0), (-0.25D0,0D0), (0D0,2D0) /
- DATA SKA(2),SMU(2),SZ(2)/(-2.25E0,0E0),(-0.25E0,0E0), (0E0,2E0) /
-#endif
- DATA KA(3),MU(3),Z(3) / (3,5), (1,1), (-2,6) /
- DATA KA(4),MU(4),Z(4) / (3,5), (1,1), (-2,4) /
-#if defined(CERNLIB_CMPXDOUB)
- DATA EXACT(1) /( 0.768837780746D+01, -0.402275799430D+02) /
- DATA EXACT(2) /(-0.102761073680D+02, -0.338630674302D+01) /
- DATA EXACT(3) /( 0.133052729239D+03, 0.713294437705D+03) /
- DATA EXACT(4) /(-0.896279277944D+02, 0.848021596620D+02) /
-#endif
-#if !defined(CERNLIB_CMPXDOUB)
- DATA EXACT(1) /( 0.768837780746E+01, -0.402275799430E+02) /
- DATA EXACT(2) /(-0.102761073680E+02, -0.338630674302E+01) /
- DATA EXACT(3) /( 0.133052729239E+03, 0.713294437705E+03) /
- DATA EXACT(4) /(-0.896279277944E+02, 0.848021596620E+02) /
-#endif
-
- CALL HEADER('C328',0)
-
-C Compare the computed results with exact results for a selection
-C of values
- ERRMAX=0D0
-#if defined(CERNLIB_DOUBLE)
- SERRMAX=0E0
-#endif
- LTEST=.TRUE.
- DO 100 I=1,NT
-#if defined(CERNLIB_DOUBLE)
- SEXACT(I)=EXACT(I)
- IF (I .NE.2) THEN
- SZ(I)=Z(I)
- SKA(I)=KA(I)
- SMU(I)=MU(I)
- ENDIF
-#endif
- WRITE(LOUT,'(/'' Test number'',I3/)') I
-#if defined(CERNLIB_DOUBLE)
- SOL(I)=WWHITM(Z(I),KA(I),MU(I))
-#endif
-#if !defined(CERNLIB_DOUBLE)
- SOL(I)=CWHITM(Z(I),KA(I),MU(I))
-#endif
- ERROR(I)=ABS( (SOL(I)-EXACT(I))/SOL(I) )
- WRITE(LOUT,'('' Calculated '',2F25.16)') SOL(I)
- WRITE(LOUT,'('' Exact '',2F25.16)') EXACT(I)
- WRITE(LOUT,'('' Rel error '',4X,1P,D10.1)') ERROR(I)
- ERRMAX=MAX( ERRMAX,ERROR(I) )
- LTEST= LTEST .AND. ERRMAX .LE. TSTERR
-#if defined(CERNLIB_DOUBLE)
- WRITE(LOUT,'(/'' Test of Single Precision Routine''/)')
- SSOL(I)=CWHITM(SZ(I),SKA(I),SMU(I))
- SERROR(I)=ABS( (SSOL(I)-SEXACT(I))/SSOL(I) )
- WRITE(LOUT,'('' Calculated '',2X,2F15.8)') SSOL(I)
- WRITE(LOUT,'('' Exact '',2X,2F15.8)') SEXACT(I)
- WRITE(LOUT,'('' Rel error '',4X,1P,D10.1)') SERROR(I)
- SERRMAX=MAX( SERRMAX,SERROR(I) )
- LTEST= LTEST .AND. SERRMAX .LE. STSTERR
-#endif
- 100 CONTINUE
-#if !defined(CERNLIB_DOUBLE)
- WRITE(LOUT,'(/'' Largest Error'',1P,D10.1)') ERRMAX
-#endif
-#if defined(CERNLIB_DOUBLE)
- WRITE(LOUT,'(/''Double Precision largest Error'',1P,D10.1)')ERRMAX
- WRITE(LOUT,'(''Single Precision largest Error'',1P,D10.1)')SERRMAX
-#endif
- WRITE(LOUT,'(/''TESTING ERROR MESSAGES:''/)')
-#if !defined(CERNLIB_DOUBLE)
- SOL(NT)=CWHITM((-.5E0,0E0),(.5E0,.5E0),(.5E0,.5E0))
- SOL(NT)=CWHITM((.5E0,.5E0),(.5E0,.5E0),(-.5E0,0E0))
-#endif
-#if defined(CERNLIB_DOUBLE)
- SSOL(NT)=CWHITM((-.5E0,0E0),(.5E0,.5E0),(.5E0,.5E0))
- SSOL(NT)=CWHITM((.5E0,.5E0),(.5E0,.5E0),(-.5E0,0E0))
- SOL(NT)=WWHITM((-.5D0,0D0),(.5D0,.5D0),(.5D0,.5D0))
- SOL(NT)=WWHITM((.5D0,.5D0),(.5D0,.5D0),(-.5D0,0D0))
-#endif
- WRITE(LOUT,'(1X)')
-
-C Check if the test was successful
- IRC=ITEST('C328',LTEST)
- CALL PAGEND('C328')
- RETURN
- END
diff --git a/src/mathlib/gen/tests/c330m.F b/src/mathlib/gen/tests/c330m.F
deleted file mode 100644
index fb89fb0..0000000
--- a/src/mathlib/gen/tests/c330m.F
+++ /dev/null
@@ -1,92 +0,0 @@
-*
-* $Id: c330m.F,v 1.1.1.1 1996/04/01 15:01:17 mclareni Exp $
-*
-* $Log: c330m.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:17 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE C330M
-C Routine to test the MATHLIB routines ASLGF and DASLGF (C330)
-C Specify the total number of tests
- PARAMETER ( NT=5 )
-#include "gen/def64.inc"
- + X(NT),P(0:30),SOL(NT),
- + EXACT(NT),ERROR(NT),ERRMAX,TSTERR
- REAL SX(NT),SP(0:30),SSOL(NT)
- REAL SEXACT(NT),SERROR(NT),SERRMAX,STSTERR
- INTEGER M(NT),N(NT),MODE(NT)
-C Set largest error permitted for a valid test
- PARAMETER ( TSTERR=1D-14 )
- PARAMETER (STSTERR=1D-6 )
- LOGICAL LTEST
-#include "iorc.inc"
-C The test parameter values
- DATA X(1),M(1),N(1),MODE(1) / 0.5D0, 0, 6, 1 /
- DATA X(2),M(2),N(2),MODE(2) / 0D0, 6, 8, 2 /
- DATA X(3),M(3),N(3),MODE(3) /-0.2D0, -2, 3, 1 /
- DATA X(4),M(4),N(4),MODE(4) /-0.8D0, 0, 0, 2 /
- DATA X(5),M(5),N(5),MODE(5) / 0.8D0, -6, 5, 2/
-
-C The exact values to be compared with
- DATA EXACT(1) / 0.3232421875000000D+00 /
- DATA EXACT(2) / -0.9435352611654214D+00 /
- DATA EXACT(3) / -0.2400000000000000D-01 /
- DATA EXACT(4) / 0.7071067811865475D+00 /
- DATA EXACT(5) / 0.0000000000000000D+00 /
-
- ERRMAX=0D0
- SERRMAX=0E0
- LTEST=.TRUE.
- CALL HEADER('C330',0)
-#if !defined(CERNLIB_DOUBLE)
- WRITE(LOUT,'(/'' M N'',6X,''X'',9X,''Calculated'',14X,
- + ''Exact'',10X,''Error'')')
-#endif
-#if defined(CERNLIB_DOUBLE)
- WRITE(LOUT,'(/'' M N'',5X,''X'',9X,''DASLGF'',14X,
- + ''Exact'',16X,''ASLGF'',13X,''Error'')')
-#endif
- DO 100 I=1,NT
-C Calculate the numerical legendre function evaluations
-#if defined(CERNLIB_DOUBLE)
- SX(I)=X(I)
- SEXACT(I)=EXACT(I)
- CALL DASLGF(MODE(I),X(I),M(I),N(I),P)
- CALL ASLGF(MODE(I),SX(I),M(I),N(I),SP)
- SOL(I)=P(N(I))
- ERROR(I)= ABS( SOL(I)-EXACT(I) )
- SSOL(I)=SP(N(I))
- SERROR(I)= ABS( SSOL(I)-SEXACT(I) )
- WRITE(LOUT,'(1X,I2,I3,F7.2,2F21.16,F16.8,1P,2D10.1)')
- + M(I),N(I),X(I),SOL(I),
- + EXACT(I),SSOL(I),ERROR(I),SERROR(I)
- SERRMAX=MAX( SERRMAX,SERROR(I) )
- ERRMAX=MAX( ERRMAX,ERROR(I) )
- LTEST=LTEST .AND. ERRMAX .LE. TSTERR .AND. SERRMAX .LE.
- + STSTERR
-#endif
-#if !defined(CERNLIB_DOUBLE)
- CALL ASLGF(MODE(I),X(I),M(I),N(I),P)
- SOL(I)=P(N(I))
- ERROR(I)= ABS( SOL(I)-EXACT(I) )
- WRITE(LOUT,'(1X,I2,I3,F7.2,2F21.16,1P,D10.1)')
- + M(I),N(I),X(I),SOL(I),
- + EXACT(I),ERROR(I)
- ERRMAX=MAX( ERRMAX,ERROR(I) )
- LTEST=LTEST .AND. ERRMAX .LE. TSTERR
-#endif
-100 CONTINUE
-
-#if !defined(CERNLIB_DOUBLE)
- WRITE(LOUT,'(/'' Largest Error was'',1P,D10.1)') ERRMAX
-#endif
-#if defined(CERNLIB_DOUBLE)
- WRITE(LOUT,'(/''DASLGF Largest Error was'',1P,D10.1)')ERRMAX
- WRITE(LOUT,'('' ASLGF Largest Error was'',1P,D10.1/)')SERRMAX
-#endif
- IRC=ITEST('C330',LTEST)
- CALL PAGEND('C330')
- RETURN
- END
diff --git a/src/mathlib/gen/tests/c331m.F b/src/mathlib/gen/tests/c331m.F
deleted file mode 100644
index d15917b..0000000
--- a/src/mathlib/gen/tests/c331m.F
+++ /dev/null
@@ -1,187 +0,0 @@
-*
-* $Id: c331m.F,v 1.1.1.1 1996/04/01 15:01:17 mclareni Exp $
-*
-* $Log: c331m.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:17 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE C331M
-C Routine to test the MATHLIB routines FCONC and DFCONC (C331)
-#include "gen/imp64.inc"
-#if defined(CERNLIB_DOUBLE)
- REAL FCONC, RP0,RP1
-#endif
- DIMENSION X(9,7),TAU(9,7),TP0(9,7),TP1(9,7)
-C Set numerical tolerance for testing the S/D versions
- DIMENSION TOL(2)
-C
- LOGICAL LTEST
-
-#include "iorc.inc"
-
- DATA TOL / 5D-6,9D-12 /
-#if !defined(CERNLIB_VAX)
- DATA ((X(K,J),TAU(K,J),TP0(K,J),TP1(K,J),J=1,7),K=1,2)
-#endif
-#if defined(CERNLIB_VAX)
- DATA ((X(K,J),TAU(K,J),TP0(K,J),TP1(K,J),J=1,5),K=1,2)
-#endif
- +/-0.85D0, 0.0D0, 0.172792365589726D+01, 0.106348504438122D+01,
- + -0.85D0, 0.1D0, 0.176055579795247D+01, 0.111428492723234D+01,
- + -0.85D0, 3.0D0, 0.708076720354774D+03, 0.262015377817868D+04,
- + -0.85D0, 15.0D0, 0.995351051386203D+16, 0.157061271647300D+18,
- + -0.85D0, 18.0D0, 0.213559166310321D+20, 0.401143223315723D+21,
-#if !defined(CERNLIB_VAX)
- + -0.85D0, 30.0D0, 0.502882282799443D+33, 0.154850067002561D+35,
- + -0.85D0, 50.0D0, 0.114853555724960D+56, 0.583433672092147D+57,
-#endif
- + 0.05D0, 0.0D0, 0.116721346104925D+01, 0.255324173328592D+00,
- + 0.05D0, 0.1D0, 0.117416110457565D+01, 0.266284488007617D+00,
- + 0.05D0, 3.0D0, 0.223002372256560D+02, 0.653083675516493D+02,
- + 0.05D0, 15.0D0, 0.832539896514758D+09, 0.124602625334050D+11,
- + 0.05D0, 18.0D0, 0.728014608715714D+11, 0.130809483546260D+13
-#if !defined(CERNLIB_VAX)
- + ,0.05D0, 30.0D0, 0.474978510888165D+19, 0.142354773848121D+21,
- + 0.05D0, 50.0D0, 0.595637227483640D+32, 0.297654571351601D+34
-#endif
- + /
- DATA ((X(K,J),TAU(K,J),TP0(K,J),TP1(K,J),J=1,7),K=3,4)
- +/ 0.15D0, 0.0D0, 0.114290227541689D+01, 0.228721183160561D+00,
- + 0.15D0, 0.1D0, 0.114881070198791D+01, 0.238456190469288D+00,
- + 0.15D0, 3.0D0, 0.166570294809630D+02, 0.478811235368669D+02,
- + 0.15D0, 15.0D0, 0.185339345854915D+09, 0.276443022458954D+10,
- + 0.15D0, 18.0D0, 0.119850157932402D+11, 0.214735095475346D+12,
- + 0.15D0, 30.0D0, 0.233906368434292D+18, 0.699844455934608D+19,
- + 0.15D0, 50.0D0, 0.392583542498121D+30, 0.195983890802043D+32,
- + 0.50D0, 0.0D0, 0.107318200714937D+01, 0.149336210855378D+00,
- + 0.50D0, 0.1D0, 0.107616218472410D+01, 0.155520072675137D+00,
- + 0.50D0, 3.0D0, 0.594747030548720D+01, 0.156513798367978D+02,
- + 0.50D0, 15.0D0, 0.738310469096391D+06, 0.108529607763471D+08,
- + 0.50D0, 18.0D0, 0.155820278247129D+08, 0.275828912884288D+09,
- + 0.50D0, 30.0D0, 0.345488450377325D+13, 0.102629608073766D+15,
- + 0.50D0, 50.0D0, 0.333355145696150D+22, 0.165704014290283D+24/
-
- DATA ((X(K,J),TAU(K,J),TP0(K,J),TP1(K,J),J=1,7),K=5,6)
- +/ 1.25D0, 0.0D0, 0.970773111746025D+00,-0.820885921881589D-01,
- + 1.25D0, 0.1D0, 0.969613109761301D+00,-0.853206241123639D-01,
- + 1.25D0, 3.0D0, 0.176601420188522D+00,-0.166005261400180D+01,
- + 1.25D0, 15.0D0,-0.234210486318489D+00, 0.810019610436777D+00,
- + 1.25D0, 18.0D0, 0.137196910943607D+00, 0.291605592654195D+01,
- + 1.25D0, 30.0D0, 0.683151098249044D-01,-0.466870444518395D+01,
- + 1.25D0, 50.0D0,-0.100507196976784D+00,-0.406190239059643D+01,
- + 2.00D0, 0.0D0, 0.901286299360454D+00,-0.136668749688719D+00,
- + 2.00D0, 0.1D0, 0.897446734802733D+00,-0.141822463184673D+00,
- + 2.00D0, 3.0D0,-0.349226063814295D+00, 0.175152750423642D+00,
- + 2.00D0, 15.0D0, 0.155579039937278D+00,-0.347105321195284D+00,
- + 2.00D0, 18.0D0,-0.864871081507048D-01, 0.209751593671441D+01,
- + 2.00D0, 30.0D0, 0.579838395893315D-01,-0.286205918205584D+01,
- + 2.00D0, 50.0D0,-0.523610425906931D-01,-0.336440002503789D+01/
-
- DATA ((X(K,J),TAU(K,J),TP0(K,J),TP1(K,J),J=1,7),K=7,8)
- +/ 50.0D0, 0.0D0, 0.381449133325901D+00,-0.127073707441687D+00,
- + 50.0D0, 0.1D0, 0.363601410956604D+00,-0.128301173299577D+00,
- + 50.0D0, 3.0D0, 0.594490895999762D-01,-0.109711149219891D+00,
- + 50.0D0, 15.0D0, 0.196056487310569D-01, 0.313519074062231D+00,
- + 50.0D0, 18.0D0, 0.243140192068021D-01,-0.206296938327517D+00,
- + 50.0D0, 30.0D0, 0.133243263206639D-01, 0.464785737940045D+00,
- + 50.0D0, 50.0D0,-0.158259704464400D-01, 0.110840613233526D+00,
- + 100.0D0, 0.0D0, 0.300917485881994D+00,-0.105445282031567D+00,
- + 100.0D0, 0.1D0, 0.282683425153849D+00,-0.105377693918764D+00,
- + 100.0D0, 3.0D0,-0.369404429618043D-01,-0.641011401326534D-01,
- + 100.0D0, 15.0D0,-0.203978275371718D-01, 0.535777344182317D-01,
- + 100.0D0, 18.0D0, 0.177972587583743D-01,-0.118319097830749D+00,
- + 100.0D0, 30.0D0, 0.687164390187623D-02,-0.388790301110631D+00,
- + 100.0D0, 50.0D0, 0.109793204340196D-01,-0.135728594318267D+00/
-
- DATA ((X(K,J),TAU(K,J),TP0(K,J),TP1(K,J),J=1,7),K=9,9)
- +/500.0D0, 0.0D0, 0.166973293482238D+00,-0.633550202215359D-01,
- + 500.0D0, 0.1D0, 0.150559960772726D+00,-0.614291013330736D-01,
- + 500.0D0, 3.0D0, 0.103141322981132D-01,-0.586574917691987D-01,
- + 500.0D0, 15.0D0,-0.608071088154388D-02,-0.100782787587720D+00,
- + 500.0D0, 18.0D0,-0.436499253685024D-02, 0.131585490808197D+00,
- + 500.0D0, 30.0D0, 0.403912746341894D-02, 0.151323730560296D+00,
- + 500.0D0, 50.0D0, 0.283023423292637D-02, 0.207478489416956D+00/
-
- CALL HEADER('C331',0)
- LTEST=.TRUE.
-C
-C--- Number of functions to test
-#if defined(CERNLIB_DOUBLE)
- NF=1
-#endif
-#if !defined(CERNLIB_DOUBLE)
- NF=2
-#endif
-C
- DO 200 JF=NF,2
- ERRMAX=0D0
- DO 1 IX = 1,9
- IF(IX .EQ. 1 .OR. IX .EQ. 7) WRITE(LOUT,100)
- DO 1 IT = 1,7
-C****** because of FCONC and IEEE ranges for single precision
-#if defined(CERNLIB_QIEEE)
- IF ( JF.EQ.1 .AND. IX.LE.2 .AND. IT.GE.6 ) GOTO 1
-#endif
-#if defined(CERNLIB_VAX)
- IF ( IX.LE.2 .AND. IT.GE.6 ) GOTO 1
-#endif
-#if defined(CERNLIB_DOUBLE)
- IF(JF.EQ.1) THEN
- RP0= FCONC(SNGL(X(IX,IT)),SNGL(TAU(IX,IT)),0)
- RP1= FCONC(SNGL(X(IX,IT)),SNGL(TAU(IX,IT)),1)
- ERRMAX= MAX (SNGL(ERRMAX),ABS((RP0-SNGL(TP0(IX,IT)))/RP0),
- + ABS((RP1-SNGL(TP1(IX,IT)))/RP1))
- WRITE(LOUT,'(1X,F10.2,F10.1,2D26.15,1P,2D10.1)')
- 1 X(IX,IT),TAU(IX,IT),RP0,RP1,ABS((RP0-TP0(IX,IT))/RP0),
- 2 ABS((RP1-TP1(IX,IT))/RP1)
- ENDIF
- IF(JF.EQ.2) THEN
- P0=DFCONC(X(IX,IT),TAU(IX,IT),0)
- P1=DFCONC(X(IX,IT),TAU(IX,IT),1)
- ERRMAX= MAX (ERRMAX,ABS((P0-TP0(IX,IT))/P0),
- + ABS((P1-TP1(IX,IT))/P1))
- WRITE(LOUT,'(1X,F10.2,F10.1,2D26.15,1P,2D10.1)')
- 1 X(IX,IT),TAU(IX,IT),P0,P1,ABS((P0-TP0(IX,IT))/P0),
- 2 ABS((P1-TP1(IX,IT))/P1)
- ENDIF
-#endif
-#if !defined(CERNLIB_DOUBLE)
- P0= FCONC(X(IX,IT),TAU(IX,IT),0)
- P1= FCONC(X(IX,IT),TAU(IX,IT),1)
- ERRMAX= MAX (ERRMAX,ABS(( P0-TP0(IX,IT))/ P0),
- + ABS(( P1-TP1(IX,IT))/ P1))
- WRITE(LOUT,'(1X,F10.2,F10.1,2D26.15,1P,2D10.1)')
- 1 X(IX,IT),TAU(IX,IT),P0,P1,ABS((P0-TP0(IX,IT))/P0),
- 2 ABS((P1-TP1(IX,IT))/P1)
-#endif
- 1 CONTINUE
-#if !defined(CERNLIB_DOUBLE)
- WRITE(LOUT,'(/'' Largest Error was'',1P,D10.1)') ERRMAX
-#endif
-#if defined(CERNLIB_DOUBLE)
- IF(JF.EQ.1)
- +WRITE(LOUT,'(/'' FCONC Largest Error was'',1P,D10.1)') ERRMAX
- IF(JF.EQ.2)
- +WRITE(LOUT,'(''DFCONC Largest Error was'',1P,D10.1/)') ERRMAX
-#endif
- LTEST=LTEST.AND.(ERRMAX.LE.TOL(JF))
-200 CONTINUE
- WRITE(LOUT,'(/''TESTING ERROR MESSAGES:''/)')
-#if defined(CERNLIB_DOUBLE)
- P0=DFCONC(X(1,1),TAU(1,1),-1)
- RP0= FCONC(SNGL(X(1,1)),SNGL(TAU(1,1)),-1)
- P0=DFCONC(-1+1D-6,TAU(1,5),1)
- RP0= FCONC(-1+1E-6,SNGL(TAU(1,5)),1)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- P0= FCONC(X(1,1),TAU(1,1),-1)
- P0= FCONC(-1+1E-6,TAU(1,5),1)
-#endif
- 100 FORMAT(/1X,8X,'X',7X,'TAU',14X,'P',28X,'P1',15X,'Error'/)
- WRITE(LOUT,'(1X)')
- IRC=ITEST('C331',LTEST)
- CALL PAGEND('C331')
- RETURN
- END
diff --git a/src/mathlib/gen/tests/c333m.F b/src/mathlib/gen/tests/c333m.F
deleted file mode 100644
index eceb35c..0000000
--- a/src/mathlib/gen/tests/c333m.F
+++ /dev/null
@@ -1,117 +0,0 @@
-*
-* $Id: c333m.F,v 1.1.1.1 1996/04/01 15:01:17 mclareni Exp $
-*
-* $Log: c333m.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:17 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE C333M
-C This program tests the operation of MATHLIB subprograms
-C CLOGAM and WLOGAM (C333)
-
-#include "gen/defc64.inc"
- + WLOGAM
-#include "gen/defc64.inc"
- + Z,I,R,T
- COMPLEX CLOGAM,ZS
-#include "gen/def64.inc"
- + X,Y,HALF,PI,ERRMAX
- CHARACTER NAME*6
- DIMENSION MU(3)
- DIMENSION X(3),Y(3)
-
-C Set maximum error allowed for test to be considered successful
- DIMENSION TOL(2)
- LOGICAL LTEST
-#include "iorc.inc"
- DATA LTEST/.TRUE./
- DATA TOL/5D-14, 5D-6/
-
- DATA I /(0 ,1 )/, HALF /0.5D0/
- DATA MU /1,30,100/
- DATA X /0.1D0,0.1D0,1D0/, Y /1D0,1D0,0.2D0/
-
- CALL HEADER('C333',0)
- ERRMAX=0D0
- PI = 3.14159 26535 89793D0
-C--- Number of functions to test
-#if !defined(CERNLIB_DOUBLE)
- NF=2
-#endif
-#if defined(CERNLIB_DOUBLE)
- NF=1
-#endif
-C
- DO 9 IDS = NF,2
- IF(IDS .EQ. 1) NAME='WLOGAM'
- IF(IDS .EQ. 2) NAME='CLOGAM'
-c DO 1 M = 1,3 ********* M=2 and M=3 ====>underflow on VM
- DO 1 M = 1,1
- WRITE(LOUT,100) NAME
- DO 1 J = 1,50
-c The following condition isjust to avoid underflows on VM
- if (m .eq. 2 .and. ids .eq. 2 .and. j .ge. 16)go to 1
- Z=MU(M)*((RANF()-HALF)+I*(RANF()-HALF))
- ZS=Z
- IF(NAME .EQ. 'WLOGAM') THEN
- R=WLOGAM(2*Z)
- T=WLOGAM(Z)+WLOGAM(Z+HALF)+(2*Z-1)*LOG(2D0)-LOG(PI)/2
- WRITE(LOUT,'(1X,2F10.4,2D25.16,1P,2D12.1)') ZS,R,ABS((T-R)/T)
- ELSE
- R=CLOGAM(2*ZS)
- T=CLOGAM(ZS)+CLOGAM(ZS+0.5)+(2*ZS-1)*LOG(2D0)-LOG(PI)/2
- WRITE(LOUT,'(1X,2F10.4,2D25.7,1P,2D12.1)') ZS,R,ABS((T-R)/T)
- ENDIF
- ERRMAX=MAX( ERRMAX, ABS((T-R)/T) )
- 1 CONTINUE
-
- WRITE(LOUT,100) NAME
- DO 2 M = 1,2
- DO 2 L = 0,1
- DO 2 J = 0,1
- DO 2 K = 1,3
-c The following 3 conditions are just to avoid underflows on VM
- if(m .eq. 2 .and. l .eq. 0 .and. j .eq.1 )go to 2
- if(m .eq. 2 .and. l .eq. 1 .and. j .eq.0 )go to 2
- if(m .eq. 2 .and. l .eq. 1 .and. j .eq.1 )go to 2
- Z=((-1)**J*X(K)+I*(-1)**L*Y(K))*10**M/2
- ZS=Z
- IF(NAME .EQ. 'WLOGAM') THEN
- R=WLOGAM(2*Z)
- T=WLOGAM(Z)+WLOGAM(Z+HALF)+(2*Z-1)*LOG(2D0)-LOG(PI)/2
- WRITE(LOUT,'(1X,2F10.2,2D25.16,1P,2D12.1)')
- 1 ZS,R,ABS((T-R)/T)
-c WRITE(LOUT,'(1X,2F10.2,2D25.16,1P,2D12.1,2X,4I1)')
-c 1 ZS,R,ABS((T-R)/T),M,L,J,K
- ELSE
- R=CLOGAM(2*ZS)
- T=CLOGAM(ZS)+CLOGAM(ZS+0.5)+(2*ZS-1)*LOG(2D0)-LOG(PI)/2
- WRITE(LOUT,'(1X,2F10.2,2D25.7,1P,2D12.1)')
- 1 ZS,R,ABS((T-R)/T)
-c WRITE(LOUT,'(1X,2F10.2,2D25.7,1P,2D12.1,2X,4I1)')
-c 1 ZS,R,ABS((T-R)/T),M,L,J,K
- ENDIF
- 2 CONTINUE
-
- WRITE(LOUT,'(/'' Largest Relative Error was'',1P,D9.1)') ERRMAX
- LTEST=LTEST.AND.(ERRMAX.LE. TOL(IDS))
-C WRITE(LOUT,'(1X)')
- WRITE(LOUT,'(/''TESTING ERROR MESSAGES:''/)')
- IF(NAME .EQ. 'WLOGAM') THEN
- R=WLOGAM(0D0+0*I)
- R=WLOGAM(-3D0+0*I)
- ELSE
- R=CLOGAM((0.,0.))
- R=CLOGAM((-3.,0.))
- ENDIF
- 9 CONTINUE
- 100 FORMAT('1'/1X,10X,'Z',9X,20X,A6,'(2*Z)'/)
-
- WRITE(LOUT,'(1X)')
-C Check if the test was successful
- IRC=ITEST('C333',LTEST)
- CALL PAGEND('C333')
- RETURN
- END
diff --git a/src/mathlib/gen/tests/c334m.F b/src/mathlib/gen/tests/c334m.F
deleted file mode 100644
index ccc666c..0000000
--- a/src/mathlib/gen/tests/c334m.F
+++ /dev/null
@@ -1,195 +0,0 @@
-*
-* $Id: c334m.F,v 1.1.1.1 1996/04/01 15:01:17 mclareni Exp $
-*
-* $Log: c334m.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:17 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE C334M
-C Subroutine to test the operation of the MATHLIB routines GAPNC,
-C DGAPNC,GAGNC,DGAGNC (C334)
- PARAMETER ( NUMBA=9,NUMBX=3 )
-#include "gen/def64.inc"
- + DGAPNC,DGAGNC
-#include "gen/def64.inc"
- + A(NUMBA),X(NUMBX), EXACT(NUMBA,NUMBX,2),SOL(NUMBA,NUMBX,2),
-c + ERROR(NUMBA,NUMBX,2),ERRMAX(2)
- + ERRMAX(2)
- REAL GAPNC, GAGNC, SSOL(NUMBA,NUMBX,2),SERRMAX(2)
-
-C Set numerical tolerance for testing the S/D versions
- DIMENSION TOL(2)
-C
- LOGICAL LTEST
-
-#include "iorc.inc"
-
- DATA TOL / 5D-5,5D-13 /
-C Set up the test parameters
- DATA (A(J),J=1,NUMBA) / -2.5D0, -1D0, -0.5D0, -0.25D0, 0D0,
- + 0.25D0,0.5D0, 1D0, 5D0 /
- DATA (X(J),J=1,NUMBX) / 0.2D0, 1D0, 3D0 /
-C Set up the exact values of GAPNC,GAGNC, first index points to A
-C variable, second to X, and third to which routine being tested
-C ******Exact values of functions for X=0.25
- DATA (EXACT(1,1,J),J=1,2) / 0.1829014413075560D+2,
- + 0.3571134138333013D+0 /
- DATA (EXACT(2,1,J),J=1,2) / 0.1000000000000000D+1,
- + 0.7013302506135521D+0 /
- DATA (EXACT(3,1,J),J=1,2) / 0.1505793838069019D+1,
- + 0.9793825468719957D+0 /
- DATA (EXACT(4,1,J),J=1,2) / 0.1298285786634679D+1,
- + 0.1194243102830858D+1 /
- DATA (EXACT(5,1,J),J=1,2) / 0.1000000000000000D+1,
- + 0.1493348746932240D+1 /
- DATA (EXACT(6,1,J),J=1,2) / 0.7098510317369823D+0,
- + 0.2901489682630177D+0 /
- DATA (EXACT(7,1,J),J=1,2) / 0.4729107431344624D+0,
- + 0.5270892568655376D+0 /
- DATA (EXACT(8,1,J),J=1,2) / 0.1812692469220180D+0,
- + 0.8187307530779820D+0 /
- DATA (EXACT(9,1,J),J=1,2) / 0.2258190552957787D-5,
- + 0.9999977418094470D+0 /
-C ******Exact values of functions for X=1
- DATA (EXACT(1,2,J),J=1,2) / 0.1102142978837587D+1,
- + 0.2624681833913003D+0 /
- DATA (EXACT(2,2,J),J=1,2) / 0.1000000000000000D+1,
- + 0.4036526376768062D+0 /
- DATA (EXACT(3,2,J),J=1,2) / 0.1050254541660012D+1,
- + 0.4842556877173750D+0 /
- DATA (EXACT(4,2,J),J=1,2) / 0.1040187658214276D+1,
- + 0.5354648517668633D+0 /
- DATA (EXACT(5,2,J),J=1,2) / 0.1000000000000000D+1,
- + 0.5963473623231938D+0 /
- DATA (EXACT(6,2,J),J=1,2) / 0.9320788679898912D+0,
- + 0.6792113201010884D-1 /
- DATA (EXACT(7,2,J),J=1,2) / 0.8427007929497167D+0,
- + 0.1572992070502833D+0 /
- DATA (EXACT(8,2,J),J=1,2) / 0.6321205588285577D+0,
- + 0.3678794411714423D+0 /
- DATA (EXACT(9,2,J),J=1,2) / 0.3659846827343659D-2,
- + 0.9963401531726564D+0 /
-C ******Exact values of functions for X=3
- DATA (EXACT(1,3,J),J=1,2) / 0.1000560063415294D+1,
- + 0.1657667608308393D+0 /
- DATA (EXACT(2,3,J),J=1,2) / 0.1000000000000000D+1,
- + 0.2137487792340328D+0 /
- DATA (EXACT(3,3,J),J=1,2) / 0.1001911512674451D+1,
- + 0.2357361503461776D+0 /
- DATA (EXACT(4,3,J),J=1,2) / 0.1001916291254332D+1,
- + 0.2482956229704183D+0 /
- DATA (EXACT(5,3,J),J=1,2) / 0.1000000000000000D+1,
- + 0.2620837402553086D+0 /
- DATA (EXACT(6,3,J),J=1,2) / 0.9949891040512919D+0,
- + 0.5010895948708086D-2 /
- DATA (EXACT(7,3,J),J=1,2) / 0.9856941215645710D+0,
- + 0.1430587843542899D-1 /
- DATA (EXACT(8,3,J),J=1,2) / 0.9502129316321361D+0,
- + 0.4978706836786394D-1 /
- DATA (EXACT(9,3,J),J=1,2) / 0.1847367554762251D+0,
- + 0.8152632445237749D+0 /
-
- CALL HEADER('C334',0)
- LTEST=.TRUE.
-C
-C--- Number of functions to test
-#if !defined(CERNLIB_DOUBLE)
- NF=1
-#endif
-#if defined(CERNLIB_DOUBLE)
- NF=2
-#endif
-C
-C Initialise largest errors, preset to zero
- ERRMAX(1)=0D0
- ERRMAX(2)=0D0
- SERRMAX(1)=0E0
- SERRMAX(2)=0E0
- DO 500 JF=1,NF
- DO 300 K=1,2
-#if defined(CERNLIB_DOUBLE)
- IF(JF.EQ.1) THEN
- IF (K .EQ. 1) WRITE(LOUT,'(/5X,''a'',6X,''x'',12X,
- + '' GAPNC(a,x)'',16X,''P(a,x)'',6X,'' Error'')')
- IF (K .EQ. 2) WRITE(LOUT,'(/5X,''a'',6X,''x'',12X,
- + '' GAGNC(a,x)'',16X,''G(a,x)'',6X,'' Error'')')
- ENDIF
- IF(JF.EQ.2) THEN
- IF (K .EQ. 1) WRITE(LOUT,'(/5X,''a'',6X,''x'',12X,
- + ''DGAPNC(a,x)'',16X,''P(a,x)'',6X,'' Error'')')
- IF (K .EQ. 2) WRITE(LOUT,'(/5X,''a'',6X,''x'',12X,
- + ''DGAGNC(a,x)'',16X,''G(a,x)'',6X,'' Error'')')
- ENDIF
-#endif
-#if !defined(CERNLIB_DOUBLE)
- IF (K .EQ. 1) WRITE(LOUT,'(/5X,''a'',6X,''x'',12X,
- + '' GAPNC(a,x)'',16X,''P(a,x)'',6X,'' Error'')')
- IF (K .EQ. 2) WRITE(LOUT,'(/5X,''a'',6X,''x'',12X,
- + '' GAGNC(a,x)'',16X,''G(a,x)'',6X,'' Error'')')
-#endif
- DO 200 J=1,NUMBX
- DO 100 I=1,NUMBA
-#if defined(CERNLIB_DOUBLE)
- IF(JF.EQ.1) THEN
- IF (K .EQ. 1)SSOL(I,J,K)= GAPNC(SNGL(A(I)),SNGL(X(J)) )
- IF (K .EQ. 2)SSOL(I,J,K)= GAGNC(SNGL(A(I)),SNGL(X(J)) )
- SERRMAX(K)=MAX(SERRMAX(K),ABS(SSOL(I,J,K)-SNGL(EXACT(I,J,K))))
- WRITE(LOUT,'(1X,F5.2,F7.2,1X,2F22.8,3X,1P,D10.1)') A(I),X(J),
- +SSOL(I,J,K),SNGL(EXACT(I,J,K)),ABS(SSOL(I,J,K)-SNGL(EXACT(I,J,K)))
- ENDIF
- IF(JF.EQ.2) THEN
- IF (K .EQ. 1) SOL(I,J,K)=DGAPNC( A(I),X(J) )
- IF (K .EQ. 2) SOL(I,J,K)=DGAGNC( A(I),X(J) )
- ERRMAX(K)=MAX(ERRMAX(K),ABS(SOL(I,J,K)-EXACT(I,J,K)))
- WRITE(LOUT,'(1X,F5.2,F7.2,1X,2F22.16,3X,1P,D10.1)') A(I),X(J),
- + SOL(I,J,K),EXACT(I,J,K), ABS( SOL(I,J,K)-EXACT(I,J,K))
- ENDIF
-#endif
-#if !defined(CERNLIB_DOUBLE)
- IF (K .EQ. 1) SOL(I,J,K)=GAPNC( A(I),X(J) )
- IF (K .EQ. 2) SOL(I,J,K)=GAGNC( A(I),X(J) )
- ERRMAX(K)=MAX(ERRMAX(K),ABS(SOL(I,J,K)-EXACT(I,J,K)))
- WRITE(LOUT,'(1X,F5.2,F7.2,1X,2F22.16,3X,1P,D10.1)') A(I),X(J),
- + SOL(I,J,K),EXACT(I,J,K), ABS( SOL(I,J,K)-EXACT(I,J,K))
-#endif
-100 CONTINUE
-200 CONTINUE
-#if !defined(CERNLIB_DOUBLE)
- ETOL=TOL(JF+1)
- LTEST=LTEST.AND.(ERRMAX(K).LE.ETOL)
-#endif
-#if defined(CERNLIB_DOUBLE)
- ETOL=TOL(JF )
- IF(JF.EQ.1)
- + LTEST=LTEST.AND.(SERRMAX(K).LE.ETOL)
- IF(JF.EQ.2)
- + LTEST=LTEST.AND.(ERRMAX(K).LE.ETOL)
-#endif
-300 CONTINUE
-500 CONTINUE
- WRITE(LOUT,
- + '(/'' ******************* TEST SUMMARY ******************''/)')
-#if defined(CERNLIB_DOUBLE)
- WRITE(LOUT,'(''Largest Error from DGAPNC was'',1P,D10.1)')
- +ERRMAX(1)
- WRITE(LOUT,'(''Largest Error from DGAGNC was'',1P,D10.1)')
- +ERRMAX(2)
- WRITE(LOUT,'(''Largest Error from GAPNC was'',1P,D10.1)')
- +SERRMAX(1)
- WRITE(LOUT,'(''Largest Error from GAGNC was'',1P,D10.1)')
- +SERRMAX(2)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- WRITE(LOUT,'(''Largest Error from GAPNC was'',1P,D10.1)')
- +ERRMAX(1)
- WRITE(LOUT,'(''Largest Error from GAGNC was'',1P,D10.1)')
- +ERRMAX(2)
-#endif
-
- WRITE(LOUT,'(1X)')
- IRC=ITEST('C334',LTEST)
- CALL PAGEND('C334')
- RETURN
- END
diff --git a/src/mathlib/gen/tests/c335m.F b/src/mathlib/gen/tests/c335m.F
deleted file mode 100644
index 0105a26..0000000
--- a/src/mathlib/gen/tests/c335m.F
+++ /dev/null
@@ -1,256 +0,0 @@
-*
-* $Id: c335m.F,v 1.1.1.1 1996/04/01 15:01:17 mclareni Exp $
-*
-* $Log: c335m.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:17 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE C335M
-C This program tests the operation of MATHLIB routines
-c CWERF and WWERF (C335)
-#include "gen/defc64.inc"
- + I,Z,ZT(5)
- CHARACTER NAME*6
- LOGICAL LTEST
- COMMON /C335T/ LTEST,ERRMAX,SERRMAX
-
-#include "iorc.inc"
- DATA I /(0 ,1 )/
-
- CALL HEADER('C335',0)
- ERRMAX=0D0
- SERRMAX=0E0
- LTEST= .TRUE.
- ZT(1)=0.44D0+0.67D0*I
- ZT(2)=0.44D0+0.61D0*I
- ZT(3)=0.39D0+0.61D0*I
- ZT(4)=0.4D0-1.3D0*I
- ZT(5)=7D0+2D0*I
-
-C--- Number of functions to test
-#if defined(CERNLIB_DOUBLE)
- KP=1
-#endif
-#if !defined(CERNLIB_DOUBLE)
- KP=2
-#endif
- DO 9 IDS = KP,2
- IF(IDS .EQ. 1) NAME='WWERF '
- IF(IDS .EQ. 2) NAME='CWERF '
- WRITE(LOUT,101)
- DO 1 N = 1,5
- Z=ZT(N)
- CALL C335TEST(NAME,Z,1)
- 1 CONTINUE
-
- WRITE(LOUT,102)
- DO 2 J = 1,2
- DO 2 K = -1,1
- IF(NAME .EQ. 'WWERF ') THEN
- IF(J .EQ. 1) Z=0.01D0+(7.4D0+0.01D0*K)*I
- IF(J .EQ. 2) Z=8.3D0+0.01D0*K+0.01D0*I
- ELSE
- IF(J .EQ. 1) Z=0.01D0+(3.2D0+0.01D0*K)*I
- IF(J .EQ. 2) Z=4.5D0+0.01D0*K+0.01D0*I
- END IF
- CALL C335TEST(NAME,Z,1)
- 2 CONTINUE
-
- WRITE(LOUT,103)
- DO 3 J = -1,1,2
- DO 3 K = -1,1,2
- Z=J*1.9D0+I*K*1.4D0
- CALL C335TEST(NAME,Z,1)
- 3 CONTINUE
-
- WRITE(LOUT,104)
- DO 4 N = -16,92,2
- IF(N .EQ. 0) GO TO 4
- Z=N*(1+I)
- CALL C335TEST(NAME,Z,1)
- 4 CONTINUE
-
- WRITE(LOUT,105)
-#if defined(CERNLIB_QIEEE)||defined(CERNLIB_VAX)
- DO 5 N = -8,92,2
-#endif
-#if (!defined(CERNLIB_QIEEE))&&(!defined(CERNLIB_VAX))
- DO 5 N = -12,92,2
-#endif
- IF(N .EQ. 0) GO TO 5
- Z=I*N
- CALL C335TEST(NAME,Z,1)
- 5 CONTINUE
-
- WRITE(LOUT,106)
-c DO 6 N = -12,54,2 ******* underflow on VM
-#if defined(CERNLIB_QIEEE)||defined(CERNLIB_VAX)
- DO 6 N = -8,8,2
-#endif
-#if (!defined(CERNLIB_QIEEE))&&(!defined(CERNLIB_VAX))
- DO 6 N = -12,12,2
-#endif
- Z=N
- CALL C335TEST(NAME,Z,2)
- 6 CONTINUE
-
- WRITE(LOUT,107)
- DO 7 IX = 1,10
- DO 7 IY = 1,10
- Z=IX+I*IY
- CALL C335TEST(NAME,Z,1)
- 7 CONTINUE
- 9 CONTINUE
-
- 101 FORMAT('1'/1X,9X,'EXAMPLES 13 - 16 IN ABRAMOWITZ - STEGUN'/)
- 102 FORMAT(///1X,9X,'TEST NEAR SEPARATION LINE IN ALGORITHM'/)
- 103 FORMAT(///1X,9X,'TEST IN THE FOUR QUADRANTS'/)
- 104 FORMAT('1'/1X,9X,'TEST ALONG THE DIAGONAL X = Y'/)
- 105 FORMAT('1'/1X,9X,'TEST ALONG THE IMAGINARY AXIS X = 0'/)
- 106 FORMAT('1'/1X,9X,'TEST ALONG THE REAL AXIS Y = 0'/)
- 107 FORMAT('1'/1X,9X,'X',9X,'Y',10X,'W(Z)'/)
-#if !defined(CERNLIB_DOUBLE)
- WRITE(LOUT,'(/'' Largest Error'',1P,D10.1)')SERRMAX
-#endif
-#if defined(CERNLIB_DOUBLE)
- WRITE(LOUT,'(/''Double Precision largest Error'',1P,D10.1)')ERRMAX
- WRITE(LOUT,'(''Single Precision largest Error'',1P,D10.1)')SERRMAX
-#endif
- WRITE(LOUT,'(1X)')
-C Check if the test was successful
- IRC=ITEST('C335',LTEST)
- CALL PAGEND('C335')
- RETURN
- END
-
- SUBROUTINE C335TEST(NAME,Z,K)
-#include "gen/defc64.inc"
- + WWERF
-#include "gen/defc64.inc"
- + Z,I,R,T,TSTERF
- LOGICAL LTEST
- COMMON /C335T/ LTEST,ERRMAX,SERRMAX
- COMPLEX CWERF,ZS
- CHARACTER NAME*6
-C Set maximum error allowed for test to be considered successful
- PARAMETER ( TSTERR=7D-13)
- PARAMETER (STSTERR=7D-6 )
-
-#include "iorc.inc"
- DATA I /(0,1)/
-
- ZS=Z
- IF(NAME .EQ. 'WWERF ') THEN
- R=WWERF(Z)
- T=TSTERF(Z,R)
- IF(K .EQ. 2) THEN
-c IF(ABS(-Z**2) .LT. 170D0)THEN
- R=R-EXP(-Z**2)
-c ELSE
-c R=R
-c ENDIF
- T=I*T
- END IF
- ERR=0
- IF(R .NE. 0 .AND. ABS(R) .GE. 5D-14)THEN
- ERR=ABS((T-R)/R)
- ELSE
- ERR=ABS(T-R)
- ENDIF
- ERRMAX=MAX(ERRMAX,ERR)
- LTEST= LTEST .AND. ERRMAX .LE. TSTERR
- WRITE(LOUT,'(2F10.2,2D25.16,1P,D10.1)') ZS,R,ERR
- ELSE
- R=CWERF(ZS)
- T=TSTERF(Z,R)
- IF(K .EQ. 2) THEN
-c IF(ABS(-ZS**2) .LT. 170D0)THEN
- R=R-EXP(-ZS**2)
-c ELSE
-c R=R
-c ENDIF
- T=I*T
- END IF
- ERR=0
- IF(R .NE. 0) ERR=ABS((T-R)/R)
- SERRMAX=MAX(SERRMAX,ERR)
-#if defined(CERNLIB_DOUBLE)
- LTEST= LTEST .AND. SERRMAX .LE. STSTERR
- WRITE(LOUT,'(2F10.2,2D25.8,1P,D10.1)') ZS,R,ERR
-#endif
-#if !defined(CERNLIB_DOUBLE)
- LTEST= LTEST .AND. SERRMAX .LE. TSTERR
- WRITE(LOUT,'(2F10.2,2D25.16,1P,D10.1)') ZS,R,ERR
-#endif
- END IF
- RETURN
- END
- FUNCTION TSTERF(Z,R)
-C COMPLEX FUNCTION TSTERF*16(Z,R)
- EXTERNAL FR,FI,FRX
- COMMON /C335FORINT/ XS,XSYS,XY2,XY2S
-#include "gen/defc64.inc"
- + TSTERF,Z,R,U,I
-#include "gen/def64.inc"
- + XS,XSYS,XY2,XY2S,
- + X,Y,T,PI,EPS,FR,FI,FRX
-#include "gen/def64.inc"
- + DGAUSS
-#include "gen/gcmpfun.inc"
- DATA I /(0,1)/, EPS /1D-14/
- DATA PI /3.14159 26535 89793 24D0/
-
- U=Z
- T=GIMAG(U)
- IF(T .LT. 0D0) U=-U
- X=GREAL(U)
- Y=GIMAG(U)
- IF(Y .NE. 0D0) THEN
- XSYS=X**2-Y**2
- XY2=2*X*Y
- XY2S=XY2**2
-#if defined(CERNLIB_DOUBLE)
- TSTERF=(2*I*U/PI)*(DGAUSS(FR,0D0,8D0,EPS*ABS(R))
- 1 +I*DGAUSS(FI,0D0,8D0,EPS*ABS(R)))
-#endif
-#if !defined(CERNLIB_DOUBLE)
- TSTERF=(2*I*U/PI)*( GAUSS(FR,0E0,8E0,EPS*ABS(R))
- 1 +I* GAUSS(FI,0E0,8E0,EPS*ABS(R)))
-#endif
- IF(T .LT. 0D0) TSTERF=2*EXP(-U**2)-TSTERF
- ELSE
- XS=X**2
-#if defined(CERNLIB_DOUBLE)
- TSTERF=(2/SQRT(PI))*DGAUSS(FRX,0D0,X,EPS*ABS(R))
-#endif
-#if !defined(CERNLIB_DOUBLE)
- TSTERF=(2/SQRT(PI))* GAUSS(FRX,0D0,X,EPS*ABS(R))
-#endif
- END IF
- RETURN
- END
- FUNCTION FRI(T)
-#include "gen/imp64.inc"
- COMMON /C335FORINT/ XS,XSYS,XY2,XY2S
-
- ENTRY FR(T)
- TS=T**2
- FRI=EXP(-TS)*(XSYS-TS)/((XSYS-TS)**2+XY2S)
- RETURN
-
- ENTRY FI(T)
- TS=T**2
- FRI=-EXP(-TS)*XY2/((XSYS-TS)**2+XY2S)
- RETURN
-
- ENTRY FRX(T)
- TS=T**2
-c IF(ABS(TS-XS) .LT. 170D0)THEN
- FRI=EXP(TS-XS)
-c ELSE
-c FRI=0
-c ENDIF
- RETURN
- END
diff --git a/src/mathlib/gen/tests/c336m.F b/src/mathlib/gen/tests/c336m.F
deleted file mode 100644
index e921cf3..0000000
--- a/src/mathlib/gen/tests/c336m.F
+++ /dev/null
@@ -1,132 +0,0 @@
-*
-* $Id: c336m.F,v 1.1.1.1 1996/04/01 15:01:18 mclareni Exp $
-*
-* $Log: c336m.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:18 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE C336M
-C This program tests the operation of MATHLIB subprograms
-C SININT, COSINT and DSININ, DCOSIN (C336)
-#include "imp64r.inc"
- REAL SININT,COSINT
-C Set maximum error allowed for test to be considered successful
- DIMENSION TOL(2)
-#include "iorc.inc"
-
- PARAMETER (Z0 = 0)
- LOGICAL LTEST
- DIMENSION Y(6),SIEX(6),CIEX(6)
- REAL RY(6),RSIEX(6),RCIEX(6)
- DATA TOL/1D-6, 1D-13/
- DATA C1 /0.57721 56649 01532 86D0/
-
- DATA (Y(I),I=1,6)/
- + -10.00D0 , -5.00D0 ,-0.10D-09 ,0.10D-11 , 1.00D0 ,300.00D0 /
-
-
- DATA (SIEX(I),CIEX(I),I=1,6)/
- + -1.65834759421887390D0 , -0.454564330044553728D-01,
- + -1.54993124494467405D0 , -0.190029749656643931D0 ,
- + -0.999999999999999778D-10, -22.4486352650389200D0 ,
- + 0.999999999999999778D-12, -27.0538054510270101D0 ,
- + 0.946083070367182893D0 , 0.337403922900967324D0 ,
- + 1.57088108821374939D0 , -0.333219991859211068D-02/
-
-
-
- DATA LTEST/.TRUE./
- CALL HEADER('C336',0)
-
-#if defined(CERNLIB_DOUBLE)
- NF=2
-#endif
-#if !defined(CERNLIB_DOUBLE)
- NF=1
-#endif
- DO 1000 JF=1,NF
- ERRMAX= 0.0D0
-#if !defined(CERNLIB_DOUBLE)
- WRITE(LOUT,'(/10X,''TEST FOR SININT and COSINT'')')
-#endif
-#if defined(CERNLIB_DOUBLE)
- IF(JF.EQ.1)
- +WRITE(LOUT,'(/10X,''TEST FOR SININT and COSINT'')')
- IF(JF.EQ.2)
- +WRITE(LOUT,'(/10X,''TEST FOR DSININT and DCOSINT'')')
-#endif
-
- DEPS=1D-14
- REPS=1D-7
- WRITE(LOUT,100)
- DO 1 I = 1, 6
- X=Y(I)
-#if !defined(CERNLIB_DOUBLE)
- S= SININT(X)
- C= COSINT(X)
- ERS= ABS((S-SIEX(I))/SIEX(I))
- ERC= ABS((C-CIEX(I))/CIEX(I))
-#endif
-#if defined(CERNLIB_DOUBLE)
- IF(JF.EQ.1)THEN
- RX=X
- RZ0=Z0
- RC1=C1
- RSIEX(I)=SIEX(I)
- RCIEX(I)=CIEX(I)
- RS= SININT(RX)
- RC= COSINT(RX)
- IF(ABS(RSIEX(I)).GE. 1E-8)ERS= ABS((RS-RSIEX(I))/RSIEX(I))
- IF(ABS(RCIEX(I)).GE. 1E-8)ERC= ABS((RC-RCIEX(I))/RCIEX(I))
- IF(ABS(RSIEX(I)).LT. 1E-8)ERS= ABS (RS-RSIEX(I))
- IF(ABS(RCIEX(I)).LT. 1E-8)ERC= ABS (RC-RCIEX(I))
- S=RS
- C=RC
- ENDIF
- IF(JF.EQ.2)THEN
- S=DSININ(X)
- C=DCOSIN(X)
- ERS= ABS(( S-SIEX(I))/SIEX(I))
- ERC= ABS(( C-CIEX(I))/CIEX(I))
- ENDIF
-#endif
- ERRMAX=MAX( ERRMAX,ERC,ERS )
- IF(I.LT.4)
- +WRITE(LOUT,'(1X,F10.2,2(F10.2,D10.1))') X,S,ERS,C,ERC
- IF(I.GE.4 .AND. I .LT. 6)
- +WRITE(LOUT,'(1X,D10.2,2(D10.2,D10.1))') X,S,ERS,C,ERC
- IF(I.GE.6)
- +WRITE(LOUT,'(1X,F10.2,2(F10.2,D10.1))') X,S,ERS,C,ERC
- 1 CONTINUE
-#if !defined(CERNLIB_DOUBLE)
- ETOL=TOL(JF+1)
-#endif
-#if defined(CERNLIB_DOUBLE)
- ETOL=TOL(JF)
-#endif
- WRITE(LOUT,'(/''LARGEST RELATIVE ERROR WAS'',D10.1)')
- +ERRMAX
- LTEST=LTEST.AND.(ERRMAX.LE.ETOL)
- ERRMAX= 0D0
- WRITE(LOUT,'(/''TESTING ERROR MESSAGES:''/)')
-#if !defined(CERNLIB_DOUBLE)
- C= COSINT(Z0)
-#endif
-#if defined(CERNLIB_DOUBLE)
- IF(JF.EQ.1)THEN
- RZ0=Z0
- RC= COSINT(RZ0)
- ENDIF
- IF(JF.EQ.2)C=DCOSIN(Z0)
-#endif
-
-1000 CONTINUE
- 100 FORMAT('1'/1X,6X,'X',8X,'SI(X)',2X,'SI ERROR',5X,'CI(X)',
- 1 2X,'CI ERROR'/)
-C Check if the test was successful
- IRC=ITEST('C336',LTEST)
- CALL PAGEND('C336')
- RETURN
- END
diff --git a/src/mathlib/gen/tests/c337m.F b/src/mathlib/gen/tests/c337m.F
deleted file mode 100644
index df962c8..0000000
--- a/src/mathlib/gen/tests/c337m.F
+++ /dev/null
@@ -1,128 +0,0 @@
-*
-* $Id: c337m.F,v 1.1.1.1 1996/04/01 15:01:18 mclareni Exp $
-*
-* $Log: c337m.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:18 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE C337M
-C This program tests the operation of MATHLIB subprograms
-C REXPIN and DEXPIN (C337)
-#include "imp64r.inc"
-c REAL EXPINT
- REAL REXPIN
-C Set maximum error allowed for test to be considered successful
- DIMENSION TOL(2)
-#include "iorc.inc"
-
- DIMENSION Y(9),YEX(9)
-c REAL RY(9),RYEX(9)
- REAL RYEX(9)
- PARAMETER (Z0 = 0)
- LOGICAL LTEST
- DATA TOL/1D-5, 1D-13/
- DATA DEPS /1D-12/, EPS /1E-8/,EPSS /1E-5/,DEL /1D-10/, XE /100/
- DATA (Y(I), I=1,9)/
- + 0.10D-12,0.70D0,2.80D0,15.00D0,-0.10D-05,-2.00D0,
- + -10.00D0,-20.00D0,-50.00D0/
- DATA (YEX(I), I=1,9)/
- + 0.2935639054402169D+02,
- + 0.3737688432335093D+00,
- + 0.1685529244521608D-01,
- + 0.1918627892147866D-07,
- + 0.1323829389306249D+02,
- + -0.4954234356001892D+01,
- + -0.2492228976241876D+04,
- + -0.2561565266405658D+08,
- + -0.1058563689713169D+21/
-
- DATA LTEST/.TRUE./
- CALL HEADER('C337',0)
-
-#if defined(CERNLIB_DOUBLE)
- NF=2
-#endif
-#if !defined(CERNLIB_DOUBLE)
- NF=1
-#endif
- DO 1000 JF=1,NF
- ERRMAX= 0.0D0
-#if !defined(CERNLIB_DOUBLE)
- WRITE(LOUT,'(/10X,''TEST FOR REXPIN'')')
- WRITE(LOUT,100)
-#endif
-#if defined(CERNLIB_DOUBLE)
- IF(JF.EQ.1)
- +WRITE(LOUT,'(/10X,''TEST FOR REXPIN'')')
- IF(JF.EQ.1)WRITE(LOUT,101)
- IF(JF.EQ.2)
- +WRITE(LOUT,'(/10X,''TEST FOR DEXPINT'')')
- IF(JF.EQ.2)WRITE(LOUT,100)
-#endif
-
- DO 1 I = 1,9
- X=Y(I)
-#if !defined(CERNLIB_DOUBLE)
-C DRA= EXPINT(X)
- DRA= REXPIN(X)
- DRT=YEX(I)
- IF (DRT .NE. 0D0) ER= ABS((DRA-DRT)/DRT)
- WRITE(LOUT,'(1X,D12.2,D25.16,D12.1)') X,DRA,ER
-#endif
-#if defined(CERNLIB_DOUBLE)
- IF (JF.EQ.1) THEN
- RX=X
- RYEX(I)=YEX(I)
-C RDRA= EXPINT(RX)
- RDRA= REXPIN(RX)
- RDRT=RYEX(I)
- IF (RDRT .NE. 0D0) ER= ABS((RDRA-RDRT)/RDRT)
- X=RX
- DRA=RDRA
- WRITE(LOUT,'(1X,D12.2,D25.9,D12.1)') X,RDRA,ER
- ENDIF
- IF (JF.EQ.2) THEN
- DRA=DEXPIN(X)
- DRT=YEX(I)
- IF (DRT .NE. 0D0) ER= ABS((DRA-DRT)/DRT)
- WRITE(LOUT,'(1X,D12.2,D25.16,D12.1)') X,DRA,ER
- ENDIF
-#endif
- ERRMAX = MAX (ERRMAX,ER)
- 1 CONTINUE
-#if !defined(CERNLIB_DOUBLE)
- ETOL=TOL(JF+1)
-#endif
-#if defined(CERNLIB_DOUBLE)
- ETOL=TOL(JF)
-#endif
- WRITE(LOUT,'(/''LARGEST RELATIVE ERROR WAS'',D10.1)')
- +ERRMAX
- LTEST=LTEST.AND.(ERRMAX.LE.ETOL)
- ERRMAX= 0D0
- WRITE(LOUT,'(/''TESTING ERROR MESSAGES:''/)')
-#if !defined(CERNLIB_DOUBLE)
-C RDRA=EXPINT(Z0)
- RDRA=REXPIN(Z0)
-#endif
-#if defined(CERNLIB_DOUBLE)
- IF (JF.EQ.1) THEN
- RZ0=Z0
-C RDRA=EXPINT(RZ0)
- RDRA=REXPIN(RZ0)
- ENDIF
- IF (JF.EQ.2)DRA=DEXPIN(Z0)
-#endif
-
-1000 CONTINUE
-
- 100 FORMAT('1'/1X,11X,'X',15X,'DEXPIN',8X,'REL.ERR.'/)
-c 101 FORMAT('1'/1X,11X,'X',15X,'EXPINT',8X,'REL.ERR.'/)
- 101 FORMAT('1'/1X,11X,'X',15X,'REXPIN',8X,'REL.ERR.'/)
-C Check if the test was successful
- IRC=ITEST('C337',LTEST)
- CALL PAGEND('C337')
- RETURN
- END
diff --git a/src/mathlib/gen/tests/c338m.F b/src/mathlib/gen/tests/c338m.F
deleted file mode 100644
index d0aba2c..0000000
--- a/src/mathlib/gen/tests/c338m.F
+++ /dev/null
@@ -1,108 +0,0 @@
-*
-* $Id: c338m.F,v 1.1.1.1 1996/04/01 15:01:19 mclareni Exp $
-*
-* $Log: c338m.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:19 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE C338M
-C This program tests the operation of MATHLIB routines
-c CEXPIN and WEXPIN (C338)
-
-#include "gen/impc64.inc"
- INTEGER IRC, ITEST
- COMPLEX SI,SZ,SR,CEXPIN,SST
-C Set maximum error allowed for test to be considered successful
-C PARAMETER (NZ = 1000)
- PARAMETER (NZ = 10)
-#include "gen/def64.inc"
- + ZR(NZ),ZI(NZ),ERRMAX,TOL(2)
- REAL SZR(NZ),SZI(NZ),SERRMAX
- EXTERNAL FC338
-
-#if defined(CERNLIB_DOUBLE)
- PARAMETER (I = (0D0,1D0))
-#endif
- PARAMETER (SI= (0E0,1E0))
- LOGICAL LTEST
-#include "iorc.inc"
-
- DATA TOL/1D-6, 5D-11/
- DATA LTEST/.TRUE./
- CALL HEADER('C338',0)
-
-#if defined(CERNLIB_DOUBLE)
- WRITE(LOUT,'(/9X,''Z'',27X,''WEXPIN/EXPIN'',22X,''Error'')')
-#endif
-#if !defined(CERNLIB_DOUBLE)
- WRITE(LOUT,'(/9X,''Z'',30X,''EXPIN'',25X,''Error'')')
-#endif
- ERRMAX=0D0
- SERRMAX=0E0
- EPS=1D-13
- Z0=0
-#if defined(CERNLIB_DOUBLE)
- CALL DVRAN(NZ,-50D0,50D0,ZR(1),ZR(2))
- CALL DVRAN(NZ,0D0,50D0,ZI(1),ZI(2))
-#endif
- CALL RVRAN(NZ,-50E0,50E0,SZR(1),SZR(2))
- CALL RVRAN(NZ,0E0,50E0,SZI(1),SZI(2))
- DO 1 J = 1,NZ
-#if defined(CERNLIB_DOUBLE)
- Z=ZR(J)+I*ZI(J)
-#endif
- SZ=SZR(J)+SI*SZI(J)
- SSZ=SZ
-#if defined(CERNLIB_DOUBLE)
- R=WEXPIN(Z)
-#endif
- SR=CEXPIN(SZ)
-#if defined(CERNLIB_DOUBLE)
- T=WGAUSS(FC338,Z0,Z,EPS)
- IF(ABS(R) .NE. 0)ERRMAX=MAX(ERRMAX,ABS((T-R)/R))
- IF(ABS(R) .EQ. 0)ERRMAX=MAX(ERRMAX,ABS(T-R))
- LTEST=LTEST .AND. ERRMAX .LE. TOL(2)
- ST=WGAUSS(FC338,Z0,SSZ,EPS)
- SST=ST
- IF(ABS(SR) .EQ. 0)SERRMAX=MAX(SERRMAX,ABS(SST-SR))
- LTEST=LTEST .AND. SERRMAX .LE. TOL(1)
- WRITE(LOUT,'(1X,''('',F7.3,'','',F7.3,'')'',2X,
- +''('',E22.15,'','',E22.15,'')'',1P,D10.1)')
- + Z,R,ERRMAX
- WRITE(LOUT,'(1X,''('',F7.3,'','',F7.3,'')'',8X,
- +''('',E16.8,'','',E16.8,'')'',6X,1P,D10.1)')
- + SZ,SR,SERRMAX
-#endif
-#if !defined(CERNLIB_DOUBLE)
- ST=CGAUSS(FC338,Z0,SZ,EPS)
- IF(ABS(SR) .NE. 0)SERRMAX=MAX(SERRMAX,ABS((ST-SR)/SR))
- IF(ABS(SR) .EQ. 0)SERRMAX=MAX(SERRMAX,ABS(ST-SR))
- LTEST=LTEST .AND. SERRMAX .LE. TOL(2)
- WRITE(LOUT,'(1X,''('',F7.3,'','',F7.3,'')'',2X,
- +''('',E22.15,'','',E22.15,'')'',1P,D10.1)')
- + SZ,SR,SERRMAX
-#endif
- 1 CONTINUE
-#if !defined(CERNLIB_DOUBLE)
- WRITE(LOUT,'(/''Largest Error was'',1P,D10.1/)')
- +SERRMAX
-#endif
-#if defined(CERNLIB_DOUBLE)
- WRITE(LOUT,'(/''SINGLE PREC. Largest Error'',1P,D10.1)')
- +SERRMAX
- WRITE(LOUT,'(/''DOUBLE PREC. Largest Error'',1P,D10.1/)')
- +ERRMAX
-#endif
-C Check if the test was successful
- IRC=ITEST('C338',LTEST)
- CALL PAGEND('C338')
- RETURN
- END
- FUNCTION FC338(T)
-#include "gen/impc64.inc"
-
- FC338=(1-EXP(-T))/T
- RETURN
- END
diff --git a/src/mathlib/gen/tests/c339m.F b/src/mathlib/gen/tests/c339m.F
deleted file mode 100644
index 4c2824b..0000000
--- a/src/mathlib/gen/tests/c339m.F
+++ /dev/null
@@ -1,94 +0,0 @@
-*
-* $Id: c339m.F,v 1.1.1.1 1996/04/01 15:01:19 mclareni Exp $
-*
-* $Log: c339m.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:19 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE C339M
-C This program tests the MATHLIB routines DAWSON and DDAWSN (C339)
-#include "gen/imp64.inc"
- REAL DAWSON,SX
- EXTERNAL FC339
- COMMON /FORINTC339/ X,X1
-
- CHARACTER NAME*6
-
-C Set numerical tolerance for testing the S/D versions
- DIMENSION TOL(2)
-C
- LOGICAL LTEST
-#include "iorc.inc"
- DATA TOL / 1D-6,1D-12 /
- CALL HEADER('C339',0)
- ERMAX=0D0
- LTEST=.TRUE.
-C
-C--- Number of functions to test
-#if !defined(CERNLIB_DOUBLE)
- NF=2
-#endif
-#if defined(CERNLIB_DOUBLE)
- NF=1
-#endif
-C
- DEPS=1D-16
- DO 9 IDS = NF,2
- IF(IDS .EQ. 1) NAME='DDAWSN'
- IF(IDS .EQ. 2) NAME='DAWSON'
- WRITE(LOUT,100) NAME,NAME
- DO 1 IX = -11,100
- X=IX/10D0
- SX=X
-#if defined(CERNLIB_DOUBLE)
- X1=MAX(1D0,ABS(X))
-#endif
-#if !defined(CERNLIB_DOUBLE)
- X1=MAX(1E0,ABS(X))
-#endif
- IF(NAME .EQ. 'DDAWSN') R=DDAWSN(X)
- IF(NAME .EQ. 'DAWSON') R=DAWSON(SX)
- H=X1*R
-#if defined(CERNLIB_DOUBLE)
- T=DGAUSS(FC339,0D0,X,DEPS)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- T= GAUSS(FC339,0D0,X,DEPS)
-#endif
- E=0
- IF(H .NE. 0) E=ABS((H-T)/H)
- ERMAX=MAX(ERMAX,E)
- IF(NAME .EQ. 'DDAWSN') THEN
- LTEST= LTEST .AND. ERMAX .LE. TOL(2)
- WRITE(LOUT,'(1X,F10.1,3D25.16,1P,D10.1)') SX,R,H,T,E
- ELSE
- WRITE(LOUT,'(1X,F10.1,3D25.7,1P,D10.1)') SX,R,H,T,E
-#if defined(CERNLIB_DOUBLE)
- LTEST= LTEST .AND. ERMAX .LE. TOL(1)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- LTEST= LTEST .AND. ERMAX .LE. TOL(2)
-#endif
- END IF
- 1 CONTINUE
- WRITE(LOUT,'('' Largest Error'',1P,D10.1)') ERMAX
- 9 CONTINUE
- 100 FORMAT('1'/1X,9X,'X',16X,A6,'(X)',2X,'MAX(1,ABS(X))*',A6,
- 1 '(X)',21X,'TEST'/)
-
-C Check if the test was successful
- IRC=ITEST('C339',LTEST)
- CALL PAGEND('C339')
- RETURN
- END
- FUNCTION FC339(T)
-#include "gen/def64.inc"
- + FC339
- COMMON /FORINTC339/ X,X1
-#include "gen/def64.inc"
- + X,X1,T
- FC339=X1*EXP((T-X)*(T+X))
- RETURN
- END
diff --git a/src/mathlib/gen/tests/c340m.F b/src/mathlib/gen/tests/c340m.F
deleted file mode 100644
index 780600f..0000000
--- a/src/mathlib/gen/tests/c340m.F
+++ /dev/null
@@ -1,81 +0,0 @@
-*
-* $Id: c340m.F,v 1.1.1.1 1996/04/01 15:01:19 mclareni Exp $
-*
-* $Log: c340m.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:19 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE C340M
-#include "iorc.inc"
-C This program tests GENLIB routines EBSIR3 and EBSKR3 (C340) and
-C their equivalent double precision routines DEBIR3 and DEBKR3.
-C Numerical values calculated by the routines are compared with
-C values obtained by numerical integration, the integration is not
-C done here.
-C Written by T Hepworth, CN division, Cern, Meyrin, 19.6.90
-C Since values of K3 are even with respect to NU,
-C then BSKR3(X,-NU)=BSKR3(X,NU) and DBSKR3(X,-NU)=DBSKR3(X,NU)
- INTEGER NU(7)
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION X(7),I3(7),K3(7),IRES(7),KRES(7),DEBIR3,DEBKR3
- DOUBLE PRECISION IERROR(7),KERROR(7),IMXERR,KMXERR,TSTERR
-#endif
-#if !defined(CERNLIB_DOUBLE)
- REAL X(7),I3(7),K3(7),IRES(7),KRES(7),EBSIR3,EBSKR3
- REAL IERROR(7),KERROR(7),IMXERR,KMXERR,TSTERR
-#endif
-C Specify the maximum allowed errors for the tests still to be
-C considered successful
- PARAMETER ( TSTERR=1D-10 )
-
-C Set up the test parameters
- DATA NU(1),X(1) / 1, 0.10 D00 /
- DATA NU(2),X(2) / -2, 2.00 D00 /
- DATA NU(3),X(3) / -1, 4.99 D00 /
- DATA NU(4),X(4) / 2, 5.00 D00 /
- DATA NU(5),X(5) / 1, 6.00 D00 /
- DATA NU(6),X(6) / -2, 8.00 D00 /
- DATA NU(7),X(7) / -1, 20.00 D00 /
-C Set up the values to test against (for the parameter values above)
-C Note these values are EXP(-X)*I(X) and EXP(X)*K(X)
- DATA I3(1),K3(1) /0.3739954918335082D+00, 0.3204805551950917D+01/
- DATA I3(2),K3(2) /0.2676629569922359D+00, 0.9224418385401156D+00/
- DATA I3(3),K3(3) /0.1814364652801527D+00, 0.5539553608988779D+00/
- DATA I3(4),K3(4) /0.1745283958635541D+00, 0.5705632049374417D+00/
- DATA I3(5),K3(5) /0.1649603834689937D+00, 0.5061963869675941D+00/
- DATA I3(6),K3(6) /0.1392218947048501D+00, 0.4482259428155665D+00/
- DATA I3(7),K3(7) /0.8952469043302264D-01, 0.2793012496549469D+00/
-
- CALL HEADER('C340',0)
- WRITE(LOUT,'(/6X,''X'',2X,''NU'',9X,''Calculated'',19X,
- + ''Exact'',10x,''Absolute Error'')')
-
- IMXERR=0D0
- KMXERR=0D0
- DO 100 I=1,7
-#if defined(CERNLIB_DOUBLE)
- IRES(I)=DEBIR3( X(I),NU(I) )
- KRES(I)=DEBKR3( X(I),NU(I) )
-#endif
-#if !defined(CERNLIB_DOUBLE)
- IRES(I)=EBSIR3( X(I),NU(I) )
- KRES(I)=EBSKR3( X(I),NU(I) )
-#endif
- IERROR(I)=ABS ( IRES(I)-I3(I) )
- KERROR(I)=ABS ( KRES(I)-K3(I) )
- WRITE(LOUT,'(1X,F6.2,I4,2(/6X,2D24.16,F24.16))')
- + X(I),NU(I),IRES(I),I3(I),IERROR(I),KRES(I),K3(I),KERROR(I)
-C Calculate maximum errors
- IMXERR=MAX ( IMXERR,IERROR(I) )
- KMXERR=MAX ( KMXERR,KERROR(I) )
-100 CONTINUE
-
- WRITE(LOUT,'('' IMXERR='',F24.16,'' KMXERR='',F24.16)')IMXERR,
- + KMXERR
-C Check if the test was successful
- IRC=ITEST('C340',IMXERR .LE. TSTERR .AND. KMXERR .LE. TSTERR)
- CALL PAGEND('C340')
- RETURN
- END
diff --git a/src/mathlib/gen/tests/c342m.F b/src/mathlib/gen/tests/c342m.F
deleted file mode 100644
index 8e45d0c..0000000
--- a/src/mathlib/gen/tests/c342m.F
+++ /dev/null
@@ -1,113 +0,0 @@
-*
-* $Id: c342m.F,v 1.2 2006/09/15 09:34:55 mclareni Exp $
-*
-* $Log: c342m.F,v $
-* Revision 1.2 2006/09/15 09:34:55 mclareni
-* Submitted mods for gcc4/gfortran and MacOSX, corrected to work also on slc4 with gcc3.4 and 4.1
-*
-* Revision 1.1.1.1 1996/04/01 15:01:19 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE C342M
-C This program tests the MATHLIB routines STRH0,DSTRH0,STRH1,DSTRH1,
-C (C342)
-
-#include "gen/imp64.inc"
-#if defined(CERNLIB_DOUBLE)
- REAL STRH0,STRH1,SX
-#endif
-#if !defined(CERNLIB_DOUBLE)
- REAL SX
-#endif
- EXTERNAL C342F0,C342F1
- COMMON /FORINTC342/ X
- CHARACTER NAME*6,Z*52
- DIMENSION TOL(2)
-
- LOGICAL LTEST
-
-#include "iorc.inc"
- DATA TOL/5D-5, 8D-13/
- DATA LTEST/.TRUE./
- CALL HEADER('C342',0)
-
-#if defined(CERNLIB_DOUBLE)
- NF=4
-#endif
-#if !defined(CERNLIB_DOUBLE)
- NF=2
-#endif
- DEPS=1.0D-16
-
- PI = 3.14159 26535 89793D0
- DO 9 IIX = 1,2
- DO 9 IDS = 1,NF
- ERMAX=0
- IF(IDS .EQ. 1) NAME='STRH0 '
- IF(IDS .EQ. 2) NAME='STRH1 '
- IF(IDS .EQ. 3) NAME='DSTRH0'
- IF(IDS .EQ. 4) NAME='DSTRH1'
- WRITE(LOUT,100) NAME
- DO 1 IX = -20,140,2
- X=IX/10D0**IIX
- SX=X
- IF(IDS .EQ. 1) R=STRH0(SX)
- IF(IDS .EQ. 2) R=STRH1(SX)
- IF(IDS .EQ. 3) R=DSTRH0(X)
- IF(IDS .EQ. 4) R=DSTRH1(X)
- IF(IDS .EQ. 3 .OR. IDS .EQ. 1) THEN
-#if defined(CERNLIB_DOUBLE)
- T=(2/PI)*DGAUSS(C342F0,0D0,PI/2,DEPS*ABS(R))
-#endif
-#if !defined(CERNLIB_DOUBLE)
- T=(2/PI)*GAUSS(C342F0,0D0,PI/2,DEPS*ABS(R))
-#endif
- ELSE
-#if defined(CERNLIB_DOUBLE)
- T=(2/PI)*X*DGAUSS(C342F1,0D0,PI/2,DEPS*ABS(R))
-#endif
-#if !defined(CERNLIB_DOUBLE)
- T=(2/PI)*X* GAUSS(C342F1,0D0,PI/2,DEPS*ABS(R))
-#endif
- END IF
- WRITE(Z,'(2D26.16)') R,T
-#if defined(CERNLIB_MACOSX)
- READ(Z,'(2(4X,D22.16))') R1,T1
-#else
- READ(Z,'(2(D22.16,4X))') R1,T1
-#endif
- ERMAX= MAX(ERMAX,ABS(R1-T1))
- IF(IDS .EQ. 3 .OR. IDS .EQ. 4) THEN
- WRITE(LOUT,'(1X,F10.3,2F25.16,1P,D10.1)') SX,R,T,ABS(R1-T1)
- ELSE
- WRITE(LOUT,'(1X,F10.3,2F25.7,1P,D10.1)') SX,R,T,ABS(R1-T1)
- END IF
-#if defined(CERNLIB_DOUBLE)
- LTEST= LTEST .AND. ERMAX .LE. TOL(1)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- LTEST= LTEST .AND. ERMAX .LE. TOL(2)
-#endif
- 1 CONTINUE
- WRITE(LOUT,'(/'' Largest Error'',1P,D10.1)') ERMAX
- 9 CONTINUE
- 100 FORMAT(/1X,9X,'X',16X,A6,'(X)',18X,'TEST',6X,'ERROR'/)
-C Check if the test was successful
- IRC=ITEST('C342',LTEST)
- CALL PAGEND('C342')
- RETURN
- END
- FUNCTION C342F(T)
-#include "gen/imp64.inc"
- COMMON /FORINTC342/ X
-
- ENTRY C342F0(T)
- C342F=SIN(X*COS(T))
- RETURN
-
- ENTRY C342F1(T)
- C342F=SIN(X*COS(T))*SIN(T)**2
- RETURN
- END
diff --git a/src/mathlib/gen/tests/c343cod1.inc b/src/mathlib/gen/tests/c343cod1.inc
deleted file mode 100644
index 7afc4ea..0000000
--- a/src/mathlib/gen/tests/c343cod1.inc
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: c343cod1.inc,v 1.1.1.1 1996/04/01 15:01:31 mclareni Exp $
-*
-* $Log: c343cod1.inc,v $
-* Revision 1.1.1.1 1996/04/01 15:01:31 mclareni
-* Mathlib gen
-*
-*
-*
-* c343cod1.inc
-*
-
- IC=0
- DO 1 IX = 1,2
- IF(IX .EQ. 1) X=HF
- IF(IX .EQ. 2) X=10
- DO 2 IA = 1,3
- IF(IA .EQ. 1) A=0
- IF(IA .EQ. 2) A=HF
- IF(IA .EQ. 3) A=9*R1/10
- DO 3 IN = 1,4
- IF(IN .EQ. 1) N=0
- IF(IN .EQ. 2) N=1
- IF(IN .EQ. 3) N=5
- IF(IN .EQ. 4) N=-5
- IC=IC+1
diff --git a/src/mathlib/gen/tests/c343cod2.inc b/src/mathlib/gen/tests/c343cod2.inc
deleted file mode 100644
index 206a2e0..0000000
--- a/src/mathlib/gen/tests/c343cod2.inc
+++ /dev/null
@@ -1,30 +0,0 @@
-*
-* $Id: c343cod2.inc,v 1.1.1.1 1996/04/01 15:01:31 mclareni Exp $
-*
-* $Log: c343cod2.inc,v $
-* Revision 1.1.1.1 1996/04/01 15:01:31 mclareni
-* Mathlib gen
-*
-*
-*
-* c343cod2.inc
-*
- 3 CONTINUE
- 2 CONTINUE
- 1 CONTINUE
-
- WRITE(LOUT,'(1X)')
- IC=0
- DO 11 IX = 1,2
- IF(IX .EQ. 1) X=HF
- IF(IX .EQ. 2) X=10
- DO 12 IA = 1,3
- IF(IA .EQ. 1) A=0
- IF(IA .EQ. 2) A=HF
- IF(IA .EQ. 3) A=9*R1/10
- DO 13 IN = 1,4
- IF(IN .EQ. 1) N=0
- IF(IN .EQ. 2) N=1
- IF(IN .EQ. 3) N=5
- IF(IN .EQ. 4) N=-5
- IC=IC+1
diff --git a/src/mathlib/gen/tests/c343codd.inc b/src/mathlib/gen/tests/c343codd.inc
deleted file mode 100644
index 17b74e5..0000000
--- a/src/mathlib/gen/tests/c343codd.inc
+++ /dev/null
@@ -1,115 +0,0 @@
-*
-* $Id: c343codd.inc,v 1.1.1.1 1996/04/01 15:01:31 mclareni Exp $
-*
-* $Log: c343codd.inc,v $
-* Revision 1.1.1.1 1996/04/01 15:01:31 mclareni
-* Mathlib gen
-*
-*
-*
-* c343codd.inc
-*
-#if (defined(CERNLIB_IBMVM))&&(defined(CERNLIB_IBMRS))&&(defined(CERNLIB_HPX))&&(defined(CERNLIB_SUN))
- PARAMETER (TSTERS=5E-5,TSTERD=5D-7,TSTERQ=5Q-16)
- PARAMETER (R0 = 0, R1 = 1, HF = R1/2)
- DATA TBJ( 1) / 0.93846 98072 40812 90422 84046 73599 713Q 0/
- DATA TBJ( 2) / 0.24226 84576 74873 88638 39545 76141 532Q 0/
- DATA TBJ( 3) / 0.80536 27241 35747 40859 78185 33030 906Q-5/
- DATA TBJ( 4) /-0.80536 27241 35747 40859 78185 33030 906Q-5/
- DATA TBJ( 5) / 0.54097 37899 34528 09133 09131 34664 116Q 0/
- DATA TBJ( 6) / 0.91701 69962 56513 02638 47431 39047 452Q-1/
- DATA TBJ( 7) / 1.67985 57964 91575 35713 06821 03304 577Q-6/
- DATA TBJ( 8) / 1.92995 75739 91663 75980 64000 55515 230Q 3/
- DATA TBJ( 9) / 0.28887 41723 76483 40570 52223 69442 935Q 0/
- DATA TBJ(10) / 0.38448 31063 85329 46873 85081 07390 601Q-1/
- DATA TBJ(11) / 4.65132 11291 10893 59386 47793 46323 693Q-7/
- DATA TBJ(12) / 2.01090 77025 51331 25559 73426 83002 089Q 2/
- DATA TBJ(13) /-0.24593 57644 51348 33519 77608 62485 329Q 0/
- DATA TBJ(14) / 0.43472 74616 88614 36669 74876 80258 593Q-1/
- DATA TBJ(15) /-0.23406 15281 86793 64044 36949 41645 778Q 0/
- DATA TBJ(16) / 0.23406 15281 86793 64044 36949 41645 778Q 0/
- DATA TBJ(17) /-0.13726 37357 55050 48121 29587 95066 182Q 0/
- DATA TBJ(18) / 0.19798 24927 55893 10479 77023 99921 117Q 0/
- DATA TBJ(19) /-0.14012 09323 66592 52895 25625 35850 317Q 0/
- DATA TBJ(20) / 0.41882 23922 02151 59744 99585 96498 680Q-2/
- DATA TBJ(21) / 0.63715 98063 57097 98226 19963 07536 597Q-2/
- DATA TBJ(22) / 0.25277 80325 33659 22519 12503 46003 116Q 0/
- DATA TBJ(23) /-0.40591 01540 01847 71534 68902 21716 859Q-1/
- DATA TBJ(24) /-0.18715 44266 84960 06628 67197 64241 377Q 0/
-
- DATA TBI( 1) / 1.06348 33707 41323 51926 31844 15445 357Q 0/
- DATA TBI( 2) / 0.25789 43053 90896 31636 24796 59523 210Q 0/
- DATA TBI( 3) / 8.22317 13131 09263 96161 80513 90975 696Q-6/
- DATA TBI( 4) / 8.22317 13131 09263 96161 80513 90975 696Q-6/
- DATA TBI( 5) / 0.58799 30867 90416 32548 88734 40163 234Q 0/
- DATA TBI( 6) / 0.96403 47383 40167 40869 62892 67769 596Q-1/
- DATA TBI( 7) / 1.71247 33725 09253 62550 48079 18736 577Q-6/
- DATA TBI( 8) / 1.86224 30791 99276 67830 75352 18479 099Q 3/
- DATA TBI( 9) / 0.30851 94456 62583 80642 18932 39851 826Q 0/
- DATA TBI(10) / 0.40141 82889 17749 02402 26085 56679 562Q-1/
- DATA TBI(11) / 4.73635 21421 48118 88530 67997 73030 464Q-7/
- DATA TBI(12) / 1.93142 67177 02500 40506 12345 63443 818Q 2/
- DATA TBI(13) / 2.81571 66284 66254 47146 98111 53426 590Q 3/
- DATA TBI(14) / 2.67098 83037 01254 65434 10319 66772 153Q 3/
- DATA TBI(15) / 7.77188 28640 32599 59907 29348 48023 396Q 2/
- DATA TBI(16) / 7.77188 28640 32599 59907 29348 48023 396Q 2/
- DATA TBI(17) / 2.77878 46038 74571 02399 76003 23151 740Q 3/
- DATA TBI(18) / 2.50090 61549 42117 84971 34932 12458 715Q 3/
- DATA TBI(19) / 5.97577 65362 84824 22554 70163 99124 796Q 2/
- DATA TBI(20) / 9.87857 94340 74432 36044 05800 69095 917Q 2/
- DATA TBI(21) / 2.69787 77237 17751 65693 84650 71704 995Q 3/
- DATA TBI(22) / 2.32861 15761 09211 67811 09213 70284 465Q 3/
- DATA TBI(23) / 4.76514 42144 58736 12259 33259 60203 718Q 2/
- DATA TBI(24) / 1.17678 51268 87221 16503 30267 49094 496Q 3/
-#endif
- PARAMETER (TSTERS=5E-6,TSTERD=5D-8,TSTERQ=5E-16)
- PARAMETER (R0 = 0, R1 = 1, HF = R1/2)
- DATA TBJ( 1) / 0.93846 98072 40812 90422 84046 73599 713D 0/
- DATA TBJ( 2) / 0.24226 84576 74873 88638 39545 76141 532D 0/
- DATA TBJ( 3) / 0.80536 27241 35747 40859 78185 33030 906D-5/
- DATA TBJ( 4) /-0.80536 27241 35747 40859 78185 33030 906D-5/
- DATA TBJ( 5) / 0.54097 37899 34528 09133 09131 34664 116D 0/
- DATA TBJ( 6) / 0.91701 69962 56513 02638 47431 39047 452D-1/
- DATA TBJ( 7) / 1.67985 57964 91575 35713 06821 03304 577D-6/
- DATA TBJ( 8) / 1.92995 75739 91663 75980 64000 55515 230D 3/
- DATA TBJ( 9) / 0.28887 41723 76483 40570 52223 69442 935D 0/
- DATA TBJ(10) / 0.38448 31063 85329 46873 85081 07390 601D-1/
- DATA TBJ(11) / 4.65132 11291 10893 59386 47793 46323 693D-7/
- DATA TBJ(12) / 2.01090 77025 51331 25559 73426 83002 089D 2/
- DATA TBJ(13) /-0.24593 57644 51348 33519 77608 62485 329D 0/
- DATA TBJ(14) / 0.43472 74616 88614 36669 74876 80258 593D-1/
- DATA TBJ(15) /-0.23406 15281 86793 64044 36949 41645 778D 0/
- DATA TBJ(16) / 0.23406 15281 86793 64044 36949 41645 778D 0/
- DATA TBJ(17) /-0.13726 37357 55050 48121 29587 95066 182D 0/
- DATA TBJ(18) / 0.19798 24927 55893 10479 77023 99921 117D 0/
- DATA TBJ(19) /-0.14012 09323 66592 52895 25625 35850 317D 0/
- DATA TBJ(20) / 0.41882 23922 02151 59744 99585 96498 680D-2/
- DATA TBJ(21) / 0.63715 98063 57097 98226 19963 07536 597D-2/
- DATA TBJ(22) / 0.25277 80325 33659 22519 12503 46003 116D 0/
- DATA TBJ(23) /-0.40591 01540 01847 71534 68902 21716 859D-1/
- DATA TBJ(24) /-0.18715 44266 84960 06628 67197 64241 377D 0/
-
- DATA TBI( 1) / 1.06348 33707 41323 51926 31844 15445 357D 0/
- DATA TBI( 2) / 0.25789 43053 90896 31636 24796 59523 210D 0/
- DATA TBI( 3) / 8.22317 13131 09263 96161 80513 90975 696D-6/
- DATA TBI( 4) / 8.22317 13131 09263 96161 80513 90975 696D-6/
- DATA TBI( 5) / 0.58799 30867 90416 32548 88734 40163 234D 0/
- DATA TBI( 6) / 0.96403 47383 40167 40869 62892 67769 596D-1/
- DATA TBI( 7) / 1.71247 33725 09253 62550 48079 18736 577D-6/
- DATA TBI( 8) / 1.86224 30791 99276 67830 75352 18479 099D 3/
- DATA TBI( 9) / 0.30851 94456 62583 80642 18932 39851 826D 0/
- DATA TBI(10) / 0.40141 82889 17749 02402 26085 56679 562D-1/
- DATA TBI(11) / 4.73635 21421 48118 88530 67997 73030 464D-7/
- DATA TBI(12) / 1.93142 67177 02500 40506 12345 63443 818D 2/
- DATA TBI(13) / 2.81571 66284 66254 47146 98111 53426 590D 3/
- DATA TBI(14) / 2.67098 83037 01254 65434 10319 66772 153D 3/
- DATA TBI(15) / 7.77188 28640 32599 59907 29348 48023 396D 2/
- DATA TBI(16) / 7.77188 28640 32599 59907 29348 48023 396D 2/
- DATA TBI(17) / 2.77878 46038 74571 02399 76003 23151 740D 3/
- DATA TBI(18) / 2.50090 61549 42117 84971 34932 12458 715D 3/
- DATA TBI(19) / 5.97577 65362 84824 22554 70163 99124 796D 2/
- DATA TBI(20) / 9.87857 94340 74432 36044 05800 69095 917D 2/
- DATA TBI(21) / 2.69787 77237 17751 65693 84650 71704 995D 3/
- DATA TBI(22) / 2.32861 15761 09211 67811 09213 70284 465D 3/
- DATA TBI(23) / 4.76514 42144 58736 12259 33259 60203 718D 2/
- DATA TBI(24) / 1.17678 51268 87221 16503 30267 49094 496D 3/
diff --git a/src/mathlib/gen/tests/c343d.F b/src/mathlib/gen/tests/c343d.F
deleted file mode 100644
index 5054165..0000000
--- a/src/mathlib/gen/tests/c343d.F
+++ /dev/null
@@ -1,67 +0,0 @@
-*
-* $Id: c343d.F,v 1.1.1.1 1996/04/01 15:01:19 mclareni Exp $
-*
-* $Log: c343d.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:19 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE C343D
-C Test DBSJA/DBSIA
-
-#if defined(CERNLIB_DOUBLE)
-#include "gen/imp64.inc"
-#endif
-#if !defined(CERNLIB_DOUBLE)
-#include "gen/imp128.inc"
-#endif
- DIMENSION TBJ(24),TBI(24)
- DIMENSION BJ(0:101),BI(0:101)
- LOGICAL LTEST2
- COMMON /C343LT2/LTEST2
-#include "iorc.inc"
-#include "c343codd.inc"
- WRITE(LOUT,'(/5X,''A'',4X,''N'',5X,''X'',14X,''BJ/BI'',
- + 13X,''ERR'')')
-#include "c343cod1.inc"
- ERMAXD=0
-
-#if defined(CERNLIB_DOUBLE)
- ND=15
-#endif
-#if !defined(CERNLIB_DOUBLE)
- ND=26
-#endif
- CALL DBSJA(X,A,N,ND,BJ)
- ERR=ABS((TBJ(IC)-BJ(ABS(N)))/TBJ(IC))
- ERMAXD=MAX(ERMAXD,ERR)
- WRITE(LOUT,'(1X,F6.1,I4,F8.1,1P,D28.16,D10.1/)') A,N,X,
- +BJ(ABS(N)),ERR
- LTEST2=LTEST2 .AND. (ERMAXD .LE. TSTERD)
-#include "c343cod2.inc"
-#if defined(CERNLIB_DOUBLE)
- ND=15
-#endif
-#if !defined(CERNLIB_DOUBLE)
- ND=26
-#endif
- CALL DBSIA(X,A,N,ND,BI)
- ERR=ABS((TBI(IC)-BI(ABS(N)))/TBI(IC))
- ERMAXD=MAX(ERMAXD,ERR)
- WRITE(LOUT,'(1X,F6.1,I4,F8.1,1P,D28.16,D10.1/)') A,N,X,
- +BI(ABS(N)),ERR
- LTEST2=LTEST2 .AND. (ERMAXD .LE. TSTERD)
- 13 CONTINUE
- 12 CONTINUE
- 11 CONTINUE
- WRITE(LOUT,'(/''DBSJA/DBSIA: Largest Error'',1P,D10.1)') ERMAXD
- WRITE(LOUT,'(1X)')
- CALL DBSJA(-R1,R0,1,ND,BJ)
- CALL DBSJA(R1,2*R1,1,ND,BJ)
- CALL DBSJA(R1,HF,101,ND,BJ)
- WRITE(LOUT,'(1X)')
- CALL DBSIA(-R1,R0,1,ND,BI)
- CALL DBSIA(R1,2*R1,1,ND,BI)
- CALL DBSIA(R1,HF,-101,ND,BI)
- END
diff --git a/src/mathlib/gen/tests/c343m.F b/src/mathlib/gen/tests/c343m.F
deleted file mode 100644
index 2e17ae0..0000000
--- a/src/mathlib/gen/tests/c343m.F
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: c343m.F,v 1.1.1.1 1996/04/01 15:01:19 mclareni Exp $
-*
-* $Log: c343m.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:19 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE C343M
- LOGICAL LTEST, LTEST1,LTEST2,LTEST3
- COMMON /C343LT1/LTEST1
- COMMON /C343LT2/LTEST2
-#if (defined(CERNLIB_QUAD))&&(defined(CERNLIB_DOUBLE))
- COMMON /C343LT3/LTEST3
-#endif
-#include "iorc.inc"
- CALL HEADER('C343',0)
- LTEST=.TRUE.
- LTEST1=.TRUE.
- LTEST2=.TRUE.
- LTEST3=.TRUE.
- CALL C343S
- LTEST=LTEST .AND. LTEST1
- CALL C343D
- LTEST=LTEST .AND. LTEST2
-#if (defined(CERNLIB_QUAD))&&(defined(CERNLIB_DOUBLE))
- CALL C343Q
- LTEST=LTEST .AND. LTEST3
-#endif
- IRC=ITEST('C343',LTEST)
- CALL PAGEND('C343')
- RETURN
- END
diff --git a/src/mathlib/gen/tests/c343q.F b/src/mathlib/gen/tests/c343q.F
deleted file mode 100644
index 9aee45d..0000000
--- a/src/mathlib/gen/tests/c343q.F
+++ /dev/null
@@ -1,55 +0,0 @@
-*
-* $Id: c343q.F,v 1.1.1.1 1996/04/01 15:01:19 mclareni Exp $
-*
-* $Log: c343q.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:19 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if (defined(CERNLIB_QUAD))&&(defined(CERNLIB_DOUBLE))
- SUBROUTINE C343Q
-C Test QBSJA/QBSIA
-#include "gen/imp128.inc"
-
- DIMENSION TBJ(24),TBI(24)
- DIMENSION BJ(0:101),BI(0:101)
- LOGICAL LTEST3
- COMMON /C343LT3/LTEST3
-#include "iorc.inc"
-#include "c343codd.inc"
- WRITE(LOUT,'(/5X,''A'',4X,''N'',5X,''X'',20X,''BJ/BI'',
- + 22X,''ERR'')')
-#include "c343cod1.inc"
- ERMAXQ=0
-
- ND=31
- CALL QBSJA(X,A,N,ND,BJ)
- ERR=ABS((TBJ(IC)-BJ(ABS(N)))/TBJ(IC))
- ERMAXQ=MAX(ERMAXQ,ERR)
- WRITE(LOUT,'(1X,F6.1,I4,F8.1,1P,E42.32,E10.1/)') A,N,X,
- +BJ(ABS(N)),ERR
- LTEST3=LTEST3 .AND. (ERMAXQ .LE. TSTERQ)
-#include "c343cod2.inc"
-
- ND=31
- CALL QBSIA(X,A,N,ND,BI)
- ERR=ABS((TBI(IC)-BI(ABS(N)))/TBI(IC))
- ERMAXQ=MAX(ERMAXQ,ERR)
- WRITE(LOUT,'(1X,F6.1,I4,F8.1,1P,E42.32,E10.1/)') A,N,X,
- +BI(ABS(N)),ERR
- LTEST3=LTEST3 .AND. (ERMAXQ .LE. TSTERQ)
- 13 CONTINUE
- 12 CONTINUE
- 11 CONTINUE
- WRITE(LOUT,'(/''QBSJA/QBSIA: Largest Error'',1P,D10.1)') ERMAXQ
- WRITE(LOUT,'(1X)')
- CALL QBSJA(-R1,R0,1,ND,BJ)
- CALL QBSJA(R1,2*R1,1,ND,BJ)
- CALL QBSJA(R1,HF,101,ND,BJ)
- WRITE(LOUT,'(1X)')
- CALL QBSIA(-R1,R0,1,ND,BI)
- CALL QBSIA(R1,2*R1,1,ND,BI)
- CALL QBSIA(R1,HF,-101,ND,BI)
- END
-#endif
diff --git a/src/mathlib/gen/tests/c343s.F b/src/mathlib/gen/tests/c343s.F
deleted file mode 100644
index 0068aa1..0000000
--- a/src/mathlib/gen/tests/c343s.F
+++ /dev/null
@@ -1,59 +0,0 @@
-*
-* $Id: c343s.F,v 1.1.1.1 1996/04/01 15:01:19 mclareni Exp $
-*
-* $Log: c343s.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:19 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE C343S
-C Test BSJA/BSIA
- DIMENSION TBJ(24),TBI(24)
- DIMENSION BJ(0:101),BI(0:101)
- LOGICAL LTEST1
- COMMON /C343LT1/LTEST1
-#include "iorc.inc"
-#include "c343codd.inc"
- WRITE(LOUT,'(/5X,''A'',4X,''N'',7X,''X'',7X,''BJ/BI'',
- + 10X,''ERR'')')
-#include "c343cod1.inc"
- ERMAX=0
-#if defined(CERNLIB_DOUBLE)
- ND=5
-#endif
-#if !defined(CERNLIB_DOUBLE)
- ND=12
-#endif
- CALL BSJA(X,A,N,ND,BJ)
- ERR=ABS((TBJ(IC)-BJ(ABS(N)))/TBJ(IC))
- ERMAX=MAX(ERMAX,ERR)
- WRITE(LOUT,'(1X,F6.1,I4,F8.1,1P,E15.6,E10.1/)') A,N,X,
- +BJ(ABS(N)),ERR
- LTEST1=LTEST1 .AND. (ERMAX .LE. TSTERS)
-#include "c343cod2.inc"
-#if defined(CERNLIB_DOUBLE)
- ND=5
-#endif
-#if !defined(CERNLIB_DOUBLE)
- ND=12
-#endif
- CALL BSIA(X,A,N,ND,BI)
- ERR=ABS((TBI(IC)-BI(ABS(N)))/TBI(IC))
- ERMAX=MAX(ERMAX,ERR)
- WRITE(LOUT,'(1X,F6.1,I4,F8.1,1P,E15.6,E10.1/)') A,N,X,
- +BI(ABS(N)),ERR
- LTEST1=LTEST1 .AND. (ERMAX .LE. TSTERS)
- 13 CONTINUE
- 12 CONTINUE
- 11 CONTINUE
- WRITE(LOUT,'(/''BSJA/BSIA: Largest Error'',1P,E10.1)') ERMAX
- WRITE(LOUT,'(1X)')
- CALL BSJA(-R1,R0,1,ND,BJ)
- CALL BSJA(R1,2*R1,1,ND,BJ)
- CALL BSJA(R1,HF,101,ND,BJ)
- WRITE(LOUT,'(1X)')
- CALL BSIA(-R1,R0,1,ND,BI)
- CALL BSIA(R1,2*R1,1,ND,BI)
- CALL BSIA(R1,HF,-101,ND,BI)
- END
diff --git a/src/mathlib/gen/tests/c344m.F b/src/mathlib/gen/tests/c344m.F
deleted file mode 100644
index bb1c960..0000000
--- a/src/mathlib/gen/tests/c344m.F
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: c344m.F,v 1.1.1.1 1996/04/01 15:01:19 mclareni Exp $
-*
-* $Log: c344m.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:19 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_IBMVM)||!defined(CERNLIB_DOUBLE)
- SUBROUTINE C344M
-C Routine to test MATHLIB subroutines CBSJA and WBSJA (C344)
- LOGICAL LTEST, LTEST1,LTEST2
- COMMON /C344LT1/LTEST1
- COMMON /C344LT2/LTEST2
-#include "iorc.inc"
- CALL HEADER('C344',0)
- LTEST=.TRUE.
- LTEST1=.TRUE.
- LTEST2=.TRUE.
- CALL C344Q
-#if defined(CERNLIB_DOUBLE)
- LTEST=LTEST .AND. LTEST1
-#endif
-#if !defined(CERNLIB_DOUBLE)
- LTEST=LTEST .AND. LTEST2
-#endif
- IRC=ITEST('C344',LTEST)
- CALL PAGEND('C344')
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/tests/c344q.F b/src/mathlib/gen/tests/c344q.F
deleted file mode 100644
index bff127c..0000000
--- a/src/mathlib/gen/tests/c344q.F
+++ /dev/null
@@ -1,290 +0,0 @@
-*
-* $Id: c344q.F,v 1.1.1.1 1996/04/01 15:01:19 mclareni Exp $
-*
-* $Log: c344q.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:19 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_IBMVM)
- SUBROUTINE C344Q
-C Test for C344 (CBSJA, WBSJA,) WQBSJA ON IBMVM and systems
-C which support Complex*32
-#include "gen/imp128.inc"
- COMPLEX RI
-#include "gen/defc64.inc"
- + DI
-#include "gen/defc128.inc"
- + QI,ZI,Z,BJ,TBJ
- LOGICAL LTEST1
- DIMENSION TBJ(36),BJ(0:101)
-
- COMMON /C344LT1/LTEST1
-#include "iorc.inc"
- DATA TBJ( 1) / ( 1.17985 66304 03078 01780 46794 59588 163Q 0,
- 1 -0.27372 67855 91011 18964 48065 68496 921Q 0)/
- DATA TBJ( 2) / ( 0.33926 01907 19886 24479 35808 69499 395Q 0,
- 1 0.51241 37767 28090 57078 57667 74624 361Q 0)/
- DATA TBJ( 3) / ( 0.33074 03512 61626 84670 55722 89412 872Q-3,
- 1 -0.33308 02032 66721 18213 28183 14447 211Q-3)/
- DATA TBJ( 4) / ( 0.88401 30734 14786 85386 41721 22706 474Q 0,
- 1 0.36852 42166 04181 21348 15572 06360 092Q 0)/
- DATA TBJ( 5) / ( 0.26995 60489 06068 53666 89280 76134 773Q-2,
- 1 0.33907 73825 39429 12118 04462 74060 416Q 0)/
- DATA TBJ( 6) / ( 0.14202 06090 81604 57666 06535 69381 053Q-3,
- 1 -0.33580 13618 18163 97607 08014 16981 086Q-4)/
- DATA TBJ( 7) / ( 0.43931 51319 83363 40153 02631 94465 136Q 0,
- 1 0.51992 02616 49293 16785 92188 98838 566Q 0)/
- DATA TBJ( 8) / (-0.83786 30365 01135 58763 65404 88771 942Q-1,
- 1 0.17434 36468 61320 97689 79869 52964 775Q 0)/
- DATA TBJ( 9) / ( 0.54371 90050 04851 56261 63796 54528 383Q-4,
- 1 0.11753 02513 31863 94332 76918 62879 626Q-4)/
- DATA TBJ(10) / (-0.38170 32673 39424 54276 23316 30974 157Q 0,
- 1 -0.46421 91069 09706 84520 05743 10193 181Q-1)/
- DATA TBJ(11) / ( 0.52205 24416 52373 86516 72860 07248 290Q-1,
- 1 -0.29346 76318 08170 03778 36714 64465 674Q 0)/
- DATA TBJ(12) / (-0.33276 41407 70354 40801 05546 70446 264Q 0,
- 1 -0.11466 07331 95216 13885 78979 85383 207Q 0)/
- DATA TBJ(13) / (-0.22338 33555 70224 71912 93662 05588 564Q 0,
- 1 -0.23734 94808 33689 43017 29143 33179 325Q 0)/
- DATA TBJ(14) / ( 0.29298 48795 57162 62473 57005 19909 919Q 0,
- 1 -0.19823 30922 78524 50591 88946 19526 558Q 0)/
- DATA TBJ(15) / (-0.20147 45398 40364 92508 28068 09666 283Q 0,
- 1 -0.21144 21422 44644 75676 27836 72718 430Q 0)/
- DATA TBJ(16) / (-0.48960 62952 12114 60862 12664 25076 681Q-2,
- 1 -0.29514 59584 18304 65886 74307 15839 425Q 0)/
- DATA TBJ(17) / ( 0.38202 04610 81631 76842 90697 43260 515Q 0,
- 1 -0.52596 85202 14131 68732 73827 89775 616Q-1)/
- DATA TBJ(18) / (-0.65522 16673 03546 09385 85623 20376 021Q-1,
- 1 -0.24671 16320 17088 28223 56185 95350 511Q 0)/
- DATA TBJ(19) / ( 0.25032 11703 17130 79307 14892 97629 883Q 4,
- 1 -0.12851 88919 49093 85293 37044 44171 662Q 4)/
- DATA TBJ(20) / ( 0.12259 19306 52295 75536 56209 70479 971Q 4,
- 1 0.23714 92582 46704 84107 98925 62458 977Q 4)/
- DATA TBJ(21) / ( 0.39986 77983 96927 40802 61667 88602 061Q 3,
- 1 0.66870 65110 74518 97852 19553 51862 602Q 3)/
- DATA TBJ(22) / ( 0.26443 58614 14535 79018 85120 76163 814Q 4,
- 1 0.84816 11959 28194 06351 93948 80167 942Q 3)/
- DATA TBJ(23) / (-0.75036 77778 99233 95551 97672 50133 438Q 3,
- 1 0.23848 12427 13301 89308 88613 73393 539Q 4)/
- DATA TBJ(24) / (-0.13898 68630 88923 95512 02590 85052 020Q 3,
- 1 0.58308 13008 93289 46975 69076 24790 536Q 3)/
- DATA TBJ(25) / ( 0.15965 42990 36374 85566 23283 01616 929Q 4,
- 1 0.21729 51256 13406 41861 34548 38956 146Q 4)/
- DATA TBJ(26) / (-0.18656 13704 64616 90665 90544 33883 776Q 4,
- 1 0.13929 90120 76962 36011 54033 82873 118Q 4)/
- DATA TBJ(27) / (-0.35981 34713 72210 88987 18308 51040 394Q 3,
- 1 0.31498 30276 17234 18622 81207 65263 609Q 3)/
- DATA TBJ(28) / (-0.23149 75314 44521 30119 56031 83751 232Q 4,
- 1 0.41156 28570 25380 52302 04516 78960 149Q 3)/
- DATA TBJ(29) / (-0.46068 09135 38352 86288 99034 58135 225Q 3,
- 1 -0.22466 26790 70405 87882 31889 61283 744Q 4)/
- DATA TBJ(30) / (-0.92039 40387 97411 49468 28994 28237 629Q 3,
- 1 -0.84634 51974 60902 69298 82464 55209 906Q 3)/
- DATA TBJ(31) / (-0.19247 35521 84853 44588 33241 55950 936Q 4,
- 1 -0.13249 22612 82940 12246 61659 74595 274Q 4)/
- DATA TBJ(32) / ( 0.11624 39715 56797 00173 25344 54705 875Q 4,
- 1 -0.18947 44874 64917 63229 20626 75866 016Q 4)/
- DATA TBJ(33) / (-0.19227 78243 81317 42543 80806 51209 982Q 3,
- 1 -0.10757 42218 10489 94443 50937 27259 647Q 4)/
- DATA TBJ(34) / (-0.79950 19891 46231 03508 60497 08802 295Q 3,
- 1 -0.21611 22238 29237 10956 11446 47452 777Q 4)/
- DATA TBJ(35) / ( 0.19548 79344 68663 86835 14093 88756 840Q 4,
- 1 -0.89157 66532 99052 59726 95998 26195 815Q 3)/
- DATA TBJ(36) / ( 0.31919 91610 01702 47591 24438 80788 995Q 3,
- 1 -0.91765 71746 72151 66793 40504 69222 067Q 3)/
-
- PARAMETER (R0 = 0, R1 = 1, HF = R1/2)
- PARAMETER (RI = (0.,1.))
- PARAMETER (DI = (0D0,1D0))
- PARAMETER (QI = (0Q0,1Q0))
- PARAMETER ( TSTERR= 1Q-30 )
- ERRMAX= 0
-
- LTEST1=.TRUE.
- WRITE(LOUT,'(/5X,''A'',4X,''N'',7X,''Z'',46X,''BJ(N)'',
- +40X,''ERR'')')
- ZI=QI
- IC=0
- DO 1 IZ = 1,4
- IF(IZ .EQ. 1) Z=HF+ZI
- IF(IZ .EQ. 2) Z=10+ZI
- IF(IZ .EQ. 3) Z=HF+10*ZI
- IF(IZ .EQ. 4) Z=10+10*ZI
- DO 2 IA = 1,3
- IF(IA .EQ. 1) A=0
- IF(IA .EQ. 2) A=HF
- IF(IA .EQ. 3) A=9*R1/10
- DO 3 IN = 1,3
- IF(IN .EQ. 1) N=0
- IF(IN .EQ. 2) N=1
- IF(IN .EQ. 3) N=5
- IC=IC+1
-
- ND=31
- CALL WQBSJA(Z,A,N,ND,BJ)
- ERR=ABS((TBJ(IC)-BJ(N))/TBJ(IC))
-#if defined(CERNLIB_IBMVM)
- WRITE(LOUT,'(1X,F6.1,I4,2F6.1,1P,2Q42.32,Q10.1/)')
-#endif
-#if !defined(CERNLIB_IBMVM)
- WRITE(LOUT,'(1X,F6.1,I4,2F6.1,1P,2D42.32,D10.1/)')
-#endif
- + A,N,Z,BJ(N),ERR
- ERRMAX= MAX( ERRMAX,ERR )
- LTEST1=LTEST1 .AND. ERRMAX .LE. TSTERR
- 3 CONTINUE
- 2 CONTINUE
- 1 CONTINUE
- WRITE(LOUT,'(/'' Largest Relative Error was'',1P,E10.1)')ERRMAX
- WRITE(LOUT,'(/''TESTING ERROR MESSAGES:''/)')
- CALL WQBSJA(-R1+R0*ZI,R0,1,ND,BJ)
- CALL WQBSJA(ZI,2*R1,1,ND,BJ)
- CALL WQBSJA(ZI,HF,101,ND,BJ)
- RETURN
- END
-#endif
-#if !defined(CERNLIB_DOUBLE)
-C Test for C344 WBSJA ON CRAY AND ALIKE
- SUBROUTINE C344Q
-
-#include "gen/imp128.inc"
-
- DIMENSION T(2,36),Z(2),BJ(2,0:101),D1(2),D2(2),D(2)
- LOGICAL LTEST2
- COMMON /C344LT2/LTEST2
-#include "iorc.inc"
-
- DATA T(1, 1) / 1.17985 66304 03078 01780 46794 59588D 0/
- DATA T(2, 1) / -0.27372 67855 91011 18964 48065 68497D 0/
- DATA T(1, 2) / 0.33926 01907 19886 24479 35808 69499D 0/
- DATA T(2, 2) / 0.51241 37767 28090 57078 57667 74624D 0/
- DATA T(1, 3) / 0.33074 03512 61626 84670 55722 89413D-3/
- DATA T(2, 3) / -0.33308 02032 66721 18213 28183 14447D-3/
- DATA T(1, 4) / 0.88401 30734 14786 85386 41721 22706D 0/
- DATA T(2, 4) / 0.36852 42166 04181 21348 15572 06360D 0/
- DATA T(1, 5) / 0.26995 60489 06068 53666 89280 76135D-2/
- DATA T(2, 5) / 0.33907 73825 39429 12118 04462 74060D 0/
- DATA T(1, 6) / 0.14202 06090 81604 57666 06535 69381D-3/
- DATA T(2, 6) / -0.33580 13618 18163 97607 08014 16981D-4/
- DATA T(1, 7) / 0.43931 51319 83363 40153 02631 94465D 0/
- DATA T(2, 7) / 0.51992 02616 49293 16785 92188 98839D 0/
- DATA T(1, 8) / -0.83786 30365 01135 58763 65404 88772D-1/
- DATA T(2, 8) / 0.17434 36468 61320 97689 79869 52965D 0/
- DATA T(1, 9) / 0.54371 90050 04851 56261 63796 54528D-4/
- DATA T(2, 9) / 0.11753 02513 31863 94332 76918 62880D-4/
- DATA T(1,10) / -0.38170 32673 39424 54276 23316 30974D 0/
- DATA T(2,10) / -0.46421 91069 09706 84520 05743 10193D-1/
- DATA T(1,11) / 0.52205 24416 52373 86516 72860 07248D-1/
- DATA T(2,11) / -0.29346 76318 08170 03778 36714 64466D 0/
- DATA T(1,12) / -0.33276 41407 70354 40801 05546 70446D 0/
- DATA T(2,12) / -0.11466 07331 95216 13885 78979 85383D 0/
- DATA T(1,13) / -0.22338 33555 70224 71912 93662 05589D 0/
- DATA T(2,13) / -0.23734 94808 33689 43017 29143 33179D 0/
- DATA T(1,14) / 0.29298 48795 57162 62473 57005 19910D 0/
- DATA T(2,14) / -0.19823 30922 78524 50591 88946 19527D 0/
- DATA T(1,15) / -0.20147 45398 40364 92508 28068 09666D 0/
- DATA T(2,15) / -0.21144 21422 44644 75676 27836 72718D 0/
- DATA T(1,16) / -0.48960 62952 12114 60862 12664 25077D-2/
- DATA T(2,16) / -0.29514 59584 18304 65886 74307 15839D 0/
- DATA T(1,17) / 0.38202 04610 81631 76842 90697 43261D 0/
- DATA T(2,17) / -0.52596 85202 14131 68732 73827 89776D-1/
- DATA T(1,18) / -0.65522 16673 03546 09385 85623 20376D-1/
- DATA T(2,18) / -0.24671 16320 17088 28223 56185 95351D 0/
- DATA T(1,19) / 0.25032 11703 17130 79307 14892 97630D 4/
- DATA T(2,19) / -0.12851 88919 49093 85293 37044 44172D 4/
- DATA T(1,20) / 0.12259 19306 52295 75536 56209 70480D 4/
- DATA T(2,20) / 0.23714 92582 46704 84107 98925 62459D 4/
- DATA T(1,21) / 0.39986 77983 96927 40802 61667 88602D 3/
- DATA T(2,21) / 0.66870 65110 74518 97852 19553 51863D 3/
- DATA T(1,22) / 0.26443 58614 14535 79018 85120 76164D 4/
- DATA T(2,22) / 0.84816 11959 28194 06351 93948 80168D 3/
- DATA T(1,23) / -0.75036 77778 99233 95551 97672 50133D 3/
- DATA T(2,23) / 0.23848 12427 13301 89308 88613 73394D 4/
- DATA T(1,24) / -0.13898 68630 88923 95512 02590 85052D 3/
- DATA T(2,24) / 0.58308 13008 93289 46975 69076 24791D 3/
- DATA T(1,25) / 0.15965 42990 36374 85566 23283 01617D 4/
- DATA T(2,25) / 0.21729 51256 13406 41861 34548 38956D 4/
- DATA T(1,26) / -0.18656 13704 64616 90665 90544 33884D 4/
- DATA T(2,26) / 0.13929 90120 76962 36011 54033 82873D 4/
- DATA T(1,27) / -0.35981 34713 72210 88987 18308 51040D 3/
- DATA T(2,27) / 0.31498 30276 17234 18622 81207 65264D 3/
- DATA T(1,28) / -0.23149 75314 44521 30119 56031 83751D 4/
- DATA T(2,28) / 0.41156 28570 25380 52302 04516 78960D 3/
- DATA T(1,29) / -0.46068 09135 38352 86288 99034 58135D 3/
- DATA T(2,29) / -0.22466 26790 70405 87882 31889 61284D 4/
- DATA T(1,30) / -0.92039 40387 97411 49468 28994 28238D 3/
- DATA T(2,30) / -0.84634 51974 60902 69298 82464 55210D 3/
- DATA T(1,31) / -0.19247 35521 84853 44588 33241 55951D 4/
- DATA T(2,31) / -0.13249 22612 82940 12246 61659 74595D 4/
- DATA T(1,32) / 0.11624 39715 56797 00173 25344 54706D 4/
- DATA T(2,32) / -0.18947 44874 64917 63229 20626 75866D 4/
- DATA T(1,33) / -0.19227 78243 81317 42543 80806 51210D 3/
- DATA T(2,33) / -0.10757 42218 10489 94443 50937 27260D 4/
- DATA T(1,34) / -0.79950 19891 46231 03508 60497 08802D 3/
- DATA T(2,34) / -0.21611 22238 29237 10956 11446 47453D 4/
- DATA T(1,35) / 0.19548 79344 68663 86835 14093 88757D 4/
- DATA T(2,35) / -0.89157 66532 99052 59726 95998 26196D 3/
- DATA T(1,36) / 0.31919 91610 01702 47591 24438 80789D 3/
- DATA T(2,36) / -0.91765 71746 72151 66793 40504 69222D 3/
-
- PARAMETER (R0 = 0, R1 = 1, HF = R1/2)
- PARAMETER ( TSTERR= 5D-28 )
- LTEST2=.TRUE.
- ERRMAX= 0
-
- IC=0
- DO 1 IZ = 1,4
- IF(IZ .EQ. 1) THEN
- Z(1)=HF
- Z(2)=1
- ELSEIF(IZ .EQ. 2) THEN
- Z(1)=10
- Z(2)=1
- ELSEIF(IZ .EQ. 3) THEN
- Z(1)=HF
- Z(2)=10
- ELSEIF(IZ .EQ. 4) THEN
- Z(1)=10
- Z(2)=10
- ENDIF
-
- DO 2 IA = 1,3
- IF(IA .EQ. 1) A=0
- IF(IA .EQ. 2) A=HF
- IF(IA .EQ. 3) A=9*R1/10
- DO 3 IN = 1,3
- IF(IN .EQ. 1) N=0
- IF(IN .EQ. 2) N=1
- IF(IN .EQ. 3) N=5
- IC=IC+1
-
- ND=27
- CALL WBSJA(Z,A,N,ND,BJ)
- D1(1)=T(1,IC)-BJ(1,N)
- D1(2)=T(2,IC)-BJ(2,N)
- D2(1)=T(1,IC)
- D2(2)=T(2,IC)
- R=D2(1)**2+D2(2)**2
- D(1)=(D1(1)*D2(1)+D1(2)*D2(2))/R
- D(2)=(D2(1)*D1(2)-D1(1)*D2(2))/R
- ERR=SQRT(D(1)**2+D(2)**2)
- ERRMAX= MAX( ERRMAX,ERR )
- LTEST2=LTEST2 .AND. ERRMAX .LE. TSTERR
- WRITE(LOUT,'(1X,F6.1,I4,2F6.1,1P,2E42.32,E10.1/)')
- 1 A,N,Z(1),Z(2),BJ(1,N),BJ(2,N),ERR
- 3 CONTINUE
- 2 CONTINUE
- 1 CONTINUE
- WRITE(LOUT,'(/'' Largest Relative Error was'',1P,E10.1)')ERRMAX
- WRITE(LOUT,'(/''TESTING ERROR MESSAGES:''/)')
- Z(1)=-1
- Z(2)=0
- CALL WBSJA(Z,R0,1,ND,BJ)
- Z(1)=0
- Z(2)=1
- CALL WBSJA(Z,2*R1,1,ND,BJ)
- CALL WBSJA(Z,HF,101,ND,BJ)
- END
-#endif
diff --git a/src/mathlib/gen/tests/c345m.F b/src/mathlib/gen/tests/c345m.F
deleted file mode 100644
index ba2e330..0000000
--- a/src/mathlib/gen/tests/c345m.F
+++ /dev/null
@@ -1,187 +0,0 @@
-*
-* $Id: c345m.F,v 1.4 1997/10/24 14:46:49 mclareni Exp $
-*
-* $Log: c345m.F,v $
-* Revision 1.4 1997/10/24 14:46:49 mclareni
-* Revert do loop change for NT at least
-*
-* Revision 1.3 1997/09/02 16:09:41 mclareni
-* WINNT corrections
-*
-* Revision 1.2 1997/04/07 10:01:04 mclareni
-* Mods for winnt
-*
-* Revision 1.1.1.1.2.1 1997/01/21 11:26:21 mclareni
-* All mods for Winnt 96a on winnt branch
-*
-* Revision 1.1.1.1 1996/04/01 15:01:19 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE C345M
-C This program tests the operation of MATHLIB subprograms
-C BZEJY and DBZEJY (C345)
-#include "gen/imp64.inc"
-
- DIMENSION Z(40,4),Z0(40,4),BP(0:50),BM(0:50)
-
-C Specify the largest relative error permitted in a successful test
-#if defined(CERNLIB_LINUX) || (defined(CERNLIB_WINNT)&&!defined(_ALPHA_))
- PARAMETER ( TSTERR= 5D-11 )
-#else
- PARAMETER ( TSTERR= 5D-12 )
-#endif
- PARAMETER (Z1 = 1)
-
-#include "iorc.inc"
- CALL HEADER('C345',0)
-#if (defined(CERNLIB_QIEEE))&&(!defined(CERNLIB_LINUX))
- IEPS=11
-#endif
-#if (defined(CERNLIB_QIEEE))&&(defined(CERNLIB_LINUX))
- IEPS=10
-#endif
-#if !defined(CERNLIB_QIEEE)
- IEPS=12
-#endif
-
- ERMAX=0D0
- PI = 3.14159 26535 89793D0
- EPS=(10*Z1)**(-IEPS)
- NMAX=40
- DO 1 JA = 0,25,25
-#if defined(CERNLIB_QIEEE)
-*GF DO 1 IA = 0,8,2 is the step 2 needed?
-* (Yes, othewise this doesn't work, under NT at least VF)
-* Given by L.Garren
- DO 1 IA = 0,8,2
-#endif
-#if defined(CERNLIB_VAX)
- DO 1 IA = 0,6
- IF(IA.GT.3 .AND. JA.EQ.0) GO TO 1
- IF(IA.LT.1 .AND. JA.EQ.25) GO TO 1
-#endif
-#if (!defined(CERNLIB_QIEEE))&&(!defined(CERNLIB_VAX))
- DO 1 IA = 0,10
-#endif
-#if !defined(CERNLIB_DOUBLE)
- IF(IA .EQ. 4 .OR. ((IA .EQ. 8 .OR. IA .EQ. 10) .AND.
- + JA .EQ. 25)) GO TO 1
-#endif
- A=IA+JA/100D0
- NA=A
- C=COS(A*PI)
- S=SIN(A*PI)
- C1=COS((A+1)*PI)
- S1=SIN((A+1)*PI)
- WRITE(LOUT,100) A,EPS
- DO 2 MODE = 1,4
-#if !defined(CERNLIB_DOUBLE)
- 2 CALL BZEJY(A,NMAX,MODE,EPS,Z(1,MODE))
-#endif
-#if defined(CERNLIB_DOUBLE)
- 2 CALL DBZEJY(A,NMAX,MODE,EPS,Z(1,MODE))
-#endif
- WRITE(LOUT,101)
- DO 9 N = 1,NMAX
- IF(A .EQ. 0) THEN
-#if !defined(CERNLIB_DOUBLE)
- Z0(N,1)= BESJ0(Z(N,1))
- Z0(N,2)= BESY0(Z(N,2))
- Z0(1,3)=0
- IF(N .GT. 1) Z0(N,3)=- BESJ1(Z(N-1,3))
- Z0(N,4)=- BESY1(Z(N,4))
- ELSEIF(A .EQ. 1) THEN
- Z0(N,1)= BESJ1(Z(N,1))
- Z0(N,2)= BESY1(Z(N,2))
- Z0(N,3)= BESJ0(Z(N,3))- BESJ1(Z(N,3))/Z(N,3)
- Z0(N,4)= BESY0(Z(N,4))- BESY1(Z(N,4))/Z(N,4)
- ELSEIF(A .NE. INT(A)) THEN
- CALL BSJA(Z(N,1),A-NA,NA,IEPS,BP)
- Z0(N,1)=BP(NA)
- CALL BSJA(Z(N,2),A-NA,NA,IEPS,BP)
- CALL BSJA(Z(N,2),NA+1-A,-(NA+1),IEPS,BM)
- Z0(N,2)=(BP(NA)*C-BM(NA+1))/S
- CALL BSJA(Z(N,3),A-NA,NA+1,IEPS,BP)
- Z0(N,3)=BP(NA)*A/Z(N,3)-BP(NA+1)
- CALL BSJA(Z(N,4),A-NA,NA+1,IEPS,BP)
- CALL BSJA(Z(N,4),NA+1-A,-(NA+2),IEPS,BM)
- Z0(N,4)=((BP(NA)*C-BM(NA+1))/S)*A/Z(N,4)-
- 1 (BP(NA+1)*C1-BM(NA+2))/S1
- ELSE
- CALL BSJA(Z(N,1),A-NA,NA,IEPS,BP)
- Z0(N,1)=BP(NA)
- BP(0)= BESY0(Z(N,2))
- BP(1)= BESY1(Z(N,2))
- DO 3 M = 1,NA-1
- 3 BP(M+1)=2*M*BP(M)/Z(N,2)-BP(M-1)
- Z0(N,2)=BP(NA)
- Z0(N,3)=0
- BP(0)= BESY0(Z(N,4))
- BP(1)= BESY1(Z(N,4))
-#endif
-#if defined(CERNLIB_DOUBLE)
- Z0(N,1)=DBESJ0(Z(N,1))
- Z0(N,2)=DBESY0(Z(N,2))
- Z0(1,3)=0
- IF(N .GT. 1) Z0(N,3)=-DBESJ1(Z(N-1,3))
- Z0(N,4)=-DBESY1(Z(N,4))
- ELSEIF(A .EQ. 1) THEN
- Z0(N,1)=DBESJ1(Z(N,1))
- Z0(N,2)=DBESY1(Z(N,2))
- Z0(N,3)=DBESJ0(Z(N,3))-DBESJ1(Z(N,3))/Z(N,3)
- Z0(N,4)=DBESY0(Z(N,4))-DBESY1(Z(N,4))/Z(N,4)
-
- ELSEIF(A .NE. INT(A)) THEN
- CALL DBSJA(Z(N,1),A-NA,NA,IEPS,BP)
- Z0(N,1)=BP(NA)
- CALL DBSJA(Z(N,2),A-NA,NA,IEPS,BP)
- CALL DBSJA(Z(N,2),NA+1-A,-(NA+1),IEPS,BM)
- Z0(N,2)=(BP(NA)*C-BM(NA+1))/S
- CALL DBSJA(Z(N,3),A-NA,NA+1,IEPS,BP)
- Z0(N,3)=BP(NA)*A/Z(N,3)-BP(NA+1)
- CALL DBSJA(Z(N,4),A-NA,NA+1,IEPS,BP)
- CALL DBSJA(Z(N,4),NA+1-A,-(NA+2),IEPS,BM)
- Z0(N,4)=((BP(NA)*C-BM(NA+1))/S)*A/Z(N,4)-
- 1 (BP(NA+1)*C1-BM(NA+2))/S1
- ELSE
- CALL DBSJA(Z(N,1),A-NA,NA,IEPS,BP)
- Z0(N,1)=BP(NA)
- BP(0)=DBESY0(Z(N,2))
- BP(1)=DBESY1(Z(N,2))
- DO 3 M = 1,NA-1
- 3 BP(M+1)=2*M*BP(M)/Z(N,2)-BP(M-1)
- Z0(N,2)=BP(NA)
- Z0(N,3)=0
- BP(0)=DBESY0(Z(N,4))
- BP(1)=DBESY1(Z(N,4))
-#endif
- DO 4 M = 1,NA-1
- 4 BP(M+1)=2*M*BP(M)/Z(N,4)-BP(M-1)
- Z0(N,4)=BP(NA-1)-NA*BP(NA)/Z(N,4)
- ENDIF
- DO 1111 JJ=1,4
- ERMAX=MAX(ERMAX,Z0(N,JJ))
- 1111 CONTINUE
- 9 CONTINUE
- WRITE(LOUT,'(1X,I3,4F21.15,1P,4D8.1)')
- 1 (N,(Z(N,J),J=1,4),(ABS(Z0(N,J)),J=1,4),N=1,NMAX)
- 1 CONTINUE
- WRITE(LOUT,'(/''TESTING ERROR MESSAGES:''/)')
-* Mode no longer is set. Thanks to L.Garren
- MODE=4
-#if !defined(CERNLIB_DOUBLE)
- CALL BZEJY(-Z1,NMAX,1,EPS,Z(1,MODE))
-#endif
-#if defined(CERNLIB_DOUBLE)
- CALL DBZEJY(-Z1,NMAX,1,EPS,Z(1,MODE))
-#endif
- 100 FORMAT('1'/1X,'a = ',F10.6,5X,'EPS = ',1PE8.1/)
- 101 FORMAT(1X,' N',16X,'Ja(X)',16X,'Ya(X)',15X,'Ja''(X)',15X,
- 1 'Ya''(x)',10X,'Error'/)
- WRITE(LOUT,'(/'' Largest Relative Error was'',1P,D10.1)') ERMAX
- IRC= ITEST('C345',ERMAX .LE. TSTERR)
- CALL PAGEND('C345')
- RETURN
- END
diff --git a/src/mathlib/gen/tests/c346m.F b/src/mathlib/gen/tests/c346m.F
deleted file mode 100644
index a7e08bf..0000000
--- a/src/mathlib/gen/tests/c346m.F
+++ /dev/null
@@ -1,278 +0,0 @@
-*
-* $Id: c346m.F,v 1.1.1.1 1996/04/01 15:01:19 mclareni Exp $
-*
-* $Log: c346m.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:19 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE C346M
-C This program tests the operation of MATHLIB subprograms
-C RELI1, RELI2, RELI3 and
-C DELI1, DELI2, DELI3 (C346)
-
-#include "imp64r.inc"
-C Set maximum error allowed for test to be considered successful
- DIMENSION TOL(2)
- REAL GAUSS
- EXTERNAL F1EL1,F1EL2
-#if defined(CERNLIB_DOUBLE)
- EXTERNAL R1EL1,R1EL2
- COMMON /RPARAMT/ RAKP,RA,RB,RP,RFMODE
-#endif
- COMMON /PARAMT/ AKP,A,B,P,FMODE
- LOGICAL LTEST
- PARAMETER (Z0 = 0, Z1 = 1, EPS=1D-14, REPS=1E-8)
- DIMENSION X3(20),AKP3(20),P3(20),EL3(20)
-#if defined(CERNLIB_DOUBLE)
- REAL RX3(20),RAKP3(20),RP3(20),REL3(20)
-#endif
-#include "iorc.inc"
-
- DATA TOL/1D-5, 5D-13/
- DATA LTEST/.TRUE./
-C Input parameters for individual tests
- DATA (X3(I),AKP3(I),P3(I),EL3(I),I=1,10)
- 1/ 1.3D+00, 0.11D+00, 4.21 D+00, 6.6220 7858 4701 5254D-01,
- 2 1.3D+00, 0.11D+00, 0.82 D+00, 1.1307 0464 4207 4609D+00,
- 3 1.3D+00, 0.92D+00, 0.71 D+00, 1.0058 2862 6697 7115D+00,
- 4 1.3D+00, 0.92D+00, 0.23 D+00, 1.1884 0708 2334 5123D+00,
- 5 1.3D+00, 0.12D+00,-0.11 D+00, 1.7259 6503 5534 8878D+00,
- 6 1.3D+00, 0.12D+00,-2.11 D+00, 2.4416 8145 2072 1179D-01,
- 7 1.3D+00, 0.40D+00, 0.1600001D+00, 1.4004 1652 5836 6944D+00,
- 8 1.3D+00, 1.00D-10, 0.82 D+00, 1.1341 5053 9528 2723D+00,
- 9 1.3D-10, 1.00D-10, 1.00 D-10, 1.3000 0000 0000 0000D-10,
- A 1.6D+00, 1.90D+00, 9.81 D+00, 3.8572 3243 7996 7252D-01/
- DATA (X3(I),AKP3(I),P3(I),EL3(I),I=11,20)
- B/ 1.6D+00, 1.90D+00, 1.22 D+00, 7.6656 1793 1195 6402D-01,
- C 1.6D+00, 1.90D+00, 0.87 D+00, 8.3210 5911 1261 8096D-01,
- D 1.6D+00, 1.90D+00, 0.21 D+00, 1.0521 2722 2190 6806D+00,
- E 1.6D+00, 1.90D+00,-0.21 D+00, 1.4730 4398 1995 4361D+00,
- F 1.6D+00, 1.90D+00,-4.30 D+00, 2.5476 9513 9719 3611D-01,
- G 1.6D+00, 1.01D+01,-1.00 D-05, 3.9501 7098 2164 9139D-01,
- H 1.6D+00, 1.50D+00, 2.24999 D+00, 7.0057 4316 8835 7934D-01,
- I 1.6D+00, 1.00D+10, 1.20 D+00, 2.3734 7746 6977 2208D-09,
- J -1.6D+00, 1.00D+10, 1.20 D+00,-2.3734 7746 6977 2208D-09,
- K 1.0D+00, 0.31D+00, 9.90 D-02, 1.0903 5779 2177 7398D+00/
-
-
- CALL HEADER('C346',0)
-#if defined(CERNLIB_DOUBLE)
- NF=2
-#endif
-#if !defined(CERNLIB_DOUBLE)
- NF=1
-#endif
- DO 1000 JF=1,NF
-C--- Test 1 -----------
- ERRMAX= 0.0D0
- WRITE(LOUT,'(1X)')
-#if !defined(CERNLIB_DOUBLE)
- WRITE(LOUT,'(/10X,''TEST FOR RELI1'')')
-#endif
-#if defined(CERNLIB_DOUBLE)
- IF(JF.EQ.1)WRITE(LOUT,'(/10X,''TEST FOR RELI1'')')
- IF(JF.EQ.2)WRITE(LOUT,'(/10X,''TEST FOR DELI1'')')
-#endif
- WRITE(LOUT,'(/7X,''X'',6X,''AKP'',10X,''CALCULATED'',
- + 20X,''TEST'',8X,''Rel. Error'')')
- WRITE(LOUT,'(1X)')
- DO 1 J = 1,101,20
- X=J/10D0
- DO 1 K = 0,101,20
- AKP=K/10D0
-#if !defined(CERNLIB_DOUBLE)
- DR=RELI1(X,AKP)
- T=GAUSS(F1EL1,Z0,X,EPS)
- ERRMAX= MAX(ERRMAX,ABS((DR-T)/DR))
- WRITE(LOUT,'(1X,2F8.1,2F23.18,1P,D10.1)') X,AKP,DR,T,
- + ABS((DR-T)/DR)
-#endif
-#if defined(CERNLIB_DOUBLE)
- IF(JF .EQ. 1) THEN
- RX=X
- RAKP=AKP
- RZ0=Z0
- RDR=RELI1(RX,RAKP)
- RT=GAUSS(R1EL1,RZ0,RX,REPS)
- ERRMAX= MAX(SNGL(ERRMAX),ABS((RDR-RT)/RDR))
- WRITE(LOUT,'(1X,2F8.1,2F23.9,1P,E10.1)') RX,RAKP,RDR,RT,
- + ABS((RDR-RT)/RDR)
- X=RX
- AKP=RAKP
- ENDIF
- IF(JF .EQ. 2) THEN
- DR=DELI1(X,AKP)
- T=DGAUSS(F1EL1,Z0,X,EPS)
- ERRMAX= MAX(ERRMAX,ABS((DR-T)/DR))
- WRITE(LOUT,'(1X,2F8.1,2F23.18,1P,D10.1)') X,AKP,DR,T,
- + ABS((DR-T)/DR)
- ENDIF
-#endif
- 1 CONTINUE
-#if !defined(CERNLIB_DOUBLE)
- ETOL=TOL(JF+1)
-#endif
-#if defined(CERNLIB_DOUBLE)
- ETOL=TOL(JF)
-#endif
-
- WRITE(LOUT,'(/'' Largest Relative Error was'',1P,D9.1)') ERRMAX
- LTEST=LTEST.AND.(ERRMAX.LE.ETOL)
- ERRMAX= 0.0D0
-
-C--- Test 2 -----------
- WRITE(LOUT,'(1X)')
-#if !defined(CERNLIB_DOUBLE)
- WRITE(LOUT,'(/10X,''TEST FOR RELI2'')')
-#endif
-#if defined(CERNLIB_DOUBLE)
- IF(JF.EQ.1)WRITE(LOUT,'(/10X,''TEST FOR RELI2'')')
- IF(JF.EQ.2)WRITE(LOUT,'(/10X,''TEST FOR DELI2'')')
-#endif
- WRITE(LOUT,'(/''TESTING ERROR MESSAGES:''/)')
-#if !defined(CERNLIB_DOUBLE)
- DR=RELI2(Z1,Z0,Z1,Z1,1)
-c DR=RELI2(Z1,Z1,Z1,Z1,-1)
- DR=RELI2(Z1,2*Z1,Z1,Z1,0)
-#endif
-#if defined(CERNLIB_DOUBLE)
- IF(JF.EQ.1) THEN
- RZ1=Z1
- RZ0=Z0
- DR=RELI2(RZ1,RZ0,RZ1,RZ1,1)
-c DR=RELI2(RZ1,RZ1,RZ1,RZ1,-1)
- DR=RELI2(RZ1,2*RZ1,RZ1,RZ1,0)
- ENDIF
- IF(JF.EQ.2) THEN
- DR=DELI2(Z1,Z0,Z1,Z1,1)
-c DR=DELI2(Z1,Z1,Z1,Z1,-1)
- DR=DELI2(Z1,2*Z1,Z1,Z1,0)
- ENDIF
-#endif
- WRITE(LOUT,'(/4X,''IFM'',2X,''X'',5X,''AKP'',
- + 4X,''A'',5X,''B'',5X,''CALCULATED'',
- + 10X,''TEST'',9X,''Rel. Error'')')
- DO 2 IFM = 1,-1,-2
- WRITE(LOUT,'(1X)')
- FMODE=IFM
- RFMODE=IFM
- DO 2 IA = 2,3
- A=-IA
- DO 2 IB = 0,2
- B=IB
- DO 2 J = 5,50,45
- X=J/10D0
- DO 2 K = 5,50,45
- AKP=K/10D0
- IF(1+FMODE*(AKP*X)**2 .LE. 0) GO TO 2
-#if !defined(CERNLIB_DOUBLE)
- DR=RELI2(X,AKP,A,B,IFM)
- T= GAUSS(F1EL2,Z0,X,EPS)
- ERRMAX= MAX(ERRMAX,ABS((DR-T)/DR))
- WRITE(LOUT,'(1X,I5,4F6.1,2F20.15,1P,D10.1)')
- 1 IFM,X,AKP,A,B,DR,T,ABS((DR-T)/DR)
-#endif
-#if defined(CERNLIB_DOUBLE)
- IF(JF.EQ.1)THEN
- RX=X
- RAKP=AKP
- RA=A
- RB=B
- RZ0=Z0
- RDR=RELI2(RX,RAKP,RA,RB,IFM)
- RT= GAUSS(R1EL2,RZ0,RX,REPS)
- ERRMAX= MAX(SNGL(ERRMAX),ABS((RDR-RT)/RDR))
- WRITE(LOUT,'(1X,I5,4F6.1,2F20.7,1P,E10.1)')
- 1 IFM,RX,RAKP,RA,RB,RDR,RT,ABS((RDR-RT)/RDR)
- X=RX
- AKP=RAKP
- A=RA
- B=RB
- ENDIF
- IF(JF.EQ.2)THEN
- DR=DELI2(X,AKP,A,B,IFM)
- T=DGAUSS(F1EL2,Z0,X,EPS)
- ERRMAX= MAX(ERRMAX,ABS((DR-T)/DR))
- WRITE(LOUT,'(1X,I5,4F6.1,2F20.15,1P,D10.1)')
- 1 IFM,X,AKP,A,B,DR,T,ABS((DR-T)/DR)
- ENDIF
-#endif
- 2 CONTINUE
-#if !defined(CERNLIB_DOUBLE)
- ETOL=TOL(JF+1)
-#endif
-#if defined(CERNLIB_DOUBLE)
- ETOL=TOL(JF)
-#endif
- WRITE(LOUT,'(/'' Largest Relative Error was'',1P,D10.1)') ERRMAX
- LTEST=LTEST.AND.(ERRMAX.LE.ETOL)
- ERRMAX= 0.0D0
-
-C--- Test 3 -----------
- WRITE(LOUT,'(1X)')
-#if !defined(CERNLIB_DOUBLE)
- WRITE(LOUT,'(/10X,''TEST FOR RELI3'')')
-#endif
-#if defined(CERNLIB_DOUBLE)
- IF(JF.EQ.1)WRITE(LOUT,'(/10X,''TEST FOR RELI3'')')
- IF(JF.EQ.2)WRITE(LOUT,'(/10X,''TEST FOR DELI3'')')
-#endif
- WRITE(LOUT,'(/''TESTING ERROR MESSAGES:''/)')
-#if !defined(CERNLIB_DOUBLE)
- DR=RELI3(Z1,Z1,-Z1)
-#endif
-#if defined(CERNLIB_DOUBLE)
- IF(JF.EQ.1) THEN
- RZ1=Z1
- RDR=RELI3(RZ1,RZ1,-RZ1)
- ENDIF
- IF(JF.EQ.2)DR=DELI3(Z1,Z1,-Z1)
-#endif
- WRITE(LOUT,'(/7X,''X'',7X,''AKP'',8X,''P'',7X,''CALCULATED'',
- + 10X,''TEST'',8X,''Rel. Error''/)')
- DO 3 I = 1,20
-#if !defined(CERNLIB_DOUBLE)
- DR=RELI3(X3(I),AKP3(I),P3(I))
- ERRMAX= MAX(ERRMAX,ABS((DR-EL3(I))/EL3(I)))
- WRITE(LOUT,'(1X,1P,D10.1,D10.2,D10.2,2D18.10,
- +1P,D10.1)') X3(I),
- +AKP3(I),P3(I),DR,EL3(I),ABS((DR-EL3(I))/EL3(I))
-#endif
-#if defined(CERNLIB_DOUBLE)
- IF(JF.EQ.1 .AND. I .NE. 9) THEN
- RX3(I)=X3(I)
- RAKP3(I)=AKP3(I)
- RP3(I)=P3(I)
- REL3(I)=EL3(I)
- RDR=RELI3(RX3(I),RAKP3(I),RP3(I))
- ERRMAX= MAX(SNGL(ERRMAX),ABS((RDR-REL3(I))/REL3(I)))
- WRITE(LOUT,'(1X,1P,E10.1,E10.2,E10.2,2E18.7,
- +1P,E10.1)') RX3(I),
- +RAKP3(I),RP3(I),RDR,REL3(I),ABS((RDR-REL3(I))/REL3(I))
- ENDIF
- IF(JF.EQ.2 .AND. I .NE. 9)THEN
- DR=DELI3(X3(I),AKP3(I),P3(I))
- ERRMAX= MAX(ERRMAX,ABS((DR-EL3(I))/EL3(I)))
- WRITE(LOUT,'(1X,1P,D10.1,D10.2,D10.2,2D18.10,
- +1P,D10.1)') X3(I),
- +AKP3(I),P3(I),DR,EL3(I),ABS((DR-EL3(I))/EL3(I))
- ENDIF
-#endif
- 3 CONTINUE
-#if !defined(CERNLIB_DOUBLE)
- ETOL=TOL(JF+1)
-#endif
-#if defined(CERNLIB_DOUBLE)
- ETOL=TOL(JF)
-#endif
- WRITE(LOUT,'(/''Largest Relative Error was'',
- +1P,D10.1)') ERRMAX
- LTEST=LTEST.AND.(ERRMAX.LE.ETOL)
- ERRMAX= 0.0D0
-1000 CONTINUE
-C Check if the test was successful
- IRC=ITEST('C346',LTEST)
- CALL PAGEND('C346')
- END
diff --git a/src/mathlib/gen/tests/c347m.F b/src/mathlib/gen/tests/c347m.F
deleted file mode 100644
index 83105a0..0000000
--- a/src/mathlib/gen/tests/c347m.F
+++ /dev/null
@@ -1,382 +0,0 @@
-*
-* $Id: c347m.F,v 1.1.1.1 1996/04/01 15:01:19 mclareni Exp $
-*
-* $Log: c347m.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:19 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE C347M
-C This program tests the operation of GENLIB subprograms
-C RELI1C, RELI2C, RELI3C ,
-C DELI1C, DELI2C, DELI3C ,
-C RELIGC, DELIGC, RELIKC, RELIEC, DELIKC, and DELIEC (C347)
-
-#include "imp64r.inc"
- REAL RELI1C, RELI2C, RELI3C
- REAL RELIGC, RELIKC, RELIEC,GAUSS
-C Set maximum error allowed for test to be considered successful
- DIMENSION TOL(2)
-
-#include "gen/def64.inc"
- + Z0, Z1, Z2, EPS,EPS2,EPS3,AKP,A,B
- EXTERNAL FF1EL1,FF2EL1,FF1EL2,FF2EL2,FF1EL3,FF2EL3
- EXTERNAL GAUSS,DGAUSS
- COMMON /PARAMT/ AKP,A,B,P,FMODE
- LOGICAL LTEST
- PARAMETER (Z0=0, Z1=1, Z2=2, EPS=1D-14, EPS2=1E-10, EPS3=1D-11)
-#include "iorc.inc"
- DATA LTEST/.TRUE./
- DATA TOL/1D-5, 8D-12/
-
- CALL HEADER('C347',0)
- ERRMAX= 0.0D0
-#if defined(CERNLIB_DOUBLE)
- NF=2
-#endif
-#if !defined(CERNLIB_DOUBLE)
- NF=1
-#endif
- DO 1000 JF=1,NF
-
-C--- Test 1 -----------
-#if !defined(CERNLIB_DOUBLE)
- WRITE(LOUT,'(/10X,''TEST FOR RELI1C'')')
-#endif
-#if defined(CERNLIB_DOUBLE)
- IF(JF.EQ.1)WRITE(LOUT,'(/10X,''TEST FOR RELI1C'')')
- IF(JF.EQ.2)WRITE(LOUT,'(/10X,''TEST FOR DELI1C'')')
-#endif
- WRITE(LOUT,'(/''TESTING ERROR MESSAGES:''/)')
-#if !defined(CERNLIB_DOUBLE)
- DR=RELI1C(Z0)
-#endif
-#if defined(CERNLIB_DOUBLE)
- IF(JF.EQ.1)THEN
- RZ0=Z0
- DR=RELI1C(RZ0)
- ENDIF
- IF(JF.EQ.2)DR=DELI1C(Z0)
-#endif
- WRITE(LOUT,'(1X)')
- WRITE(LOUT,'(/5X,''AKP'',6X,''CALCULATED'',
- + 10X,''TEST'',9X,''Rel. Error'')')
- DO 11 K = 1,101,20
- AKP=K/10D0
-#if !defined(CERNLIB_DOUBLE)
- DR=RELI1C(AKP)
- T=GAUSS(FF1EL1,Z0,Z1,EPS)+GAUSS(FF2EL1,Z0,Z1,EPS)
-#endif
-#if defined(CERNLIB_DOUBLE)
- IF(JF.EQ.1)THEN
- RAKP=AKP
- DR=RELI1C(RAKP)
- AKP=RAKP
- ENDIF
- IF(JF.EQ.2) DR=DELI1C(AKP)
- T=DGAUSS(FF1EL1,Z0,Z1,EPS)+DGAUSS(FF2EL1,Z0,Z1,EPS)
-#endif
- ERRMAX= MAX(ERRMAX,ABS((DR-T)/DR))
- WRITE(LOUT,'(1X,F6.1,2F20.15,1P,D10.1)') AKP,DR,T,ABS((DR-T)/DR)
- 11 CONTINUE
-#if !defined(CERNLIB_DOUBLE)
- ETOL=TOL(JF+1)
-#endif
-#if defined(CERNLIB_DOUBLE)
- ETOL=TOL(JF)
-#endif
- WRITE(LOUT,'(/'' Largest Relative Error was'',1P,D9.1)') ERRMAX
- LTEST=LTEST.AND.(ERRMAX.LE.ETOL)
- ERRMAX= 0.0D0
-
-C--- Test 2 -----------
-
-#if !defined(CERNLIB_DOUBLE)
- WRITE(LOUT,'(/10X,''TEST FOR RELI2C'')')
-#endif
-#if defined(CERNLIB_DOUBLE)
- IF(JF.EQ.1)WRITE(LOUT,'(/10X,''TEST FOR RELI2C'')')
- IF(JF.EQ.2)WRITE(LOUT,'(/10X,''TEST FOR DELI2C'')')
-#endif
- WRITE(LOUT,'(/''TESTING ERROR MESSAGES:''/)')
- FMODE=1
-#if !defined(CERNLIB_DOUBLE)
- DR=RELI2C(Z0,Z1,Z1)
-#endif
-#if defined(CERNLIB_DOUBLE)
- IF(JF.EQ.1)THEN
- RZ0=Z0
- RZ1=Z1
- DR=RELI2C(RZ0,RZ1,RZ1)
- ENDIF
- IF(JF.EQ.2)DR=DELI2C(Z0,Z1,Z1)
-#endif
- WRITE(LOUT,'(1X)')
- WRITE(LOUT,'(/4X,''AKP'',
- + 4X,''A'',5X,''B'',5X,''CALCULATED'',
- + 10X,''TEST'',10X,''Rel. Error'')')
- DO 12 IA = 2,3
- A=IA
- DO 12 IB = 0,2
- B=IB
- DO 12 K = 0,100,25
- AKP=K/10D0
- IF(AKP .EQ. 0 .AND. B .NE. 0) GO TO 12
-#if !defined(CERNLIB_DOUBLE)
- DR=RELI2C(AKP,A,B)
- T=GAUSS(FF1EL2,Z0,Z1,EPS)+GAUSS(FF2EL2,Z0,Z1,EPS)
-#endif
-#if defined(CERNLIB_DOUBLE)
- IF(JF.EQ.1)THEN
- RAKP=AKP
- RA=A
- RB=B
- DR=RELI2C(RAKP,RA,RB)
- ENDIF
- IF(JF.EQ.2) DR=DELI2C(AKP,A,B)
- T=DGAUSS(FF1EL2,Z0,Z1,EPS)+DGAUSS(FF2EL2,Z0,Z1,EPS)
-#endif
- ERRMAX= MAX(ERRMAX,ABS((DR-T)/DR))
- WRITE(LOUT,'(1X,3F6.1,2F20.15,1P,D10.1)')AKP,A,B,DR,T,
- + ABS((DR-T)/DR)
- 12 CONTINUE
-
-#if !defined(CERNLIB_DOUBLE)
- ETOL=TOL(JF+1)
-#endif
-#if defined(CERNLIB_DOUBLE)
- ETOL=TOL(JF)
-#endif
- WRITE(LOUT,'(/'' Largest Relative Error was'',1P,D9.1)') ERRMAX
- LTEST=LTEST.AND.(ERRMAX.LE.ETOL)
- ERRMAX= 0.0D0
-
-C--- Test 3 -----------
-#if !defined(CERNLIB_DOUBLE)
- WRITE(LOUT,'(/10X,''TEST FOR RELI3C'')')
-#endif
-#if defined(CERNLIB_DOUBLE)
- IF(JF.EQ.1)WRITE(LOUT,'(/10X,''TEST FOR RELI3C'')')
- IF(JF.EQ.2)WRITE(LOUT,'(/10X,''TEST FOR DELI3C'')')
-#endif
- WRITE(LOUT,'(/''TESTING ERROR MESSAGES:''/)')
-#if !defined(CERNLIB_DOUBLE)
- DR=RELI3C(Z0,Z1,Z1)
-#endif
-#if defined(CERNLIB_DOUBLE)
- IF(JF.EQ.1)THEN
- RZ0=Z0
- RZ1=Z1
- DR=RELI3C(RZ0,RZ1,RZ1)
- ENDIF
- IF(JF.EQ.2)DR=DELI3C(Z0,Z1,Z1)
-#endif
- WRITE(LOUT,'(1X)')
- WRITE(LOUT,'(/4X,''AKP'',
- + 4X,''P'',6X,''CALCULATED'',
- + 12X,''TEST'',7X,''Rel. Error'')')
-#if defined(CERNLIB_DOUBLE)
- DO 13 IP = -3,3,6
-#endif
-#if !defined(CERNLIB_DOUBLE)
- DO 13 IP = -2,3,6
-#endif
- P=IP
- DO 13 K = 1,101,25
- AKP=K/10D0
- AM=1-AKP**2
-#if !defined(CERNLIB_DOUBLE)
- DR=RELI3C(AKP,AM,P)
- IF(P .GT. 0) THEN
- T=GAUSS(FF1EL3,Z0,Z1,EPS)+GAUSS(FF2EL3,Z0,Z1,EPS)
- ELSE
- S=1/SQRT(-P)
- T=CAUCHY(FF1EL3,Z0,Z1,S,EPS2)+GAUSS(FF2EL3,Z0,Z1,EPS)
- ENDIF
-#endif
-#if defined(CERNLIB_DOUBLE)
- IF(JF.EQ.1)THEN
- RAKP=AKP
- RAM=AM
- RP=P
- DR=RELI3C(RAKP,RAM,RP)
- AKP=RAKP
- AM=RAM
- P=RP
- ENDIF
- IF(JF.EQ.2) DR=DELI3C(AKP,AM,P)
- IF(P .GT. 0) THEN
- T=DGAUSS(FF1EL3,Z0,Z1,EPS)+DGAUSS(FF2EL3,Z0,Z1,EPS)
- ELSE
- S=1/SQRT(-P)
-#endif
-#if (!defined(CERNLIB_UNIX))&&(defined(CERNLIB_DOUBLE))
- T=DCAUCH(FF1EL3,Z0,Z1,S,EPS)+DGAUSS(FF2EL3,Z0,Z1,EPS)
-#endif
-#if (defined(CERNLIB_UNIX))&&(defined(CERNLIB_DOUBLE))
- T=DCAUCH(FF1EL3,Z0,Z1,S,EPS2)+DGAUSS(FF2EL3,Z0,Z1,EPS)
-#endif
-#if defined(CERNLIB_DOUBLE)
- ENDIF
-#endif
- ERRMAX= MAX(ERRMAX,ABS((DR-T)/DR))
- WRITE(LOUT,'(1X,2F6.1,2F20.15,1P,D10.1)')AKP,P,DR,T,
- + ABS((DR-T)/DR)
- 13 CONTINUE
-
-
-#if !defined(CERNLIB_DOUBLE)
- ETOL=TOL(JF+1)
-#endif
-#if defined(CERNLIB_DOUBLE)
- ETOL=TOL(JF)
-#endif
- WRITE(LOUT,'(/'' Largest Relative Error was'',1P,D9.1)') ERRMAX
- LTEST=LTEST.AND.(ERRMAX.LE.ETOL)
- ERRMAX= 0.0D0
-
-C--- Test 4 -----------
-#if !defined(CERNLIB_DOUBLE)
- WRITE(LOUT,'(/10X,''TEST FOR RELIGC'')')
-#endif
-#if defined(CERNLIB_DOUBLE)
- IF(JF.EQ.1)WRITE(LOUT,'(/10X,''TEST FOR RELIGC'')')
- IF(JF.EQ.2)WRITE(LOUT,'(/10X,''TEST FOR DELIGC'')')
-#endif
- WRITE(LOUT,'(/''TESTING ERROR MESSAGES:''/)')
-#if !defined(CERNLIB_DOUBLE)
- DR=RELIGC(Z0,Z1,Z1,Z1)
-#endif
-#if defined(CERNLIB_DOUBLE)
- IF(JF.EQ.1)THEN
- RZ0=Z0
- RZ1=Z1
- DR=RELIGC(RZ0,RZ1,RZ1,RZ1)
- ENDIF
- IF(JF.EQ.2)DR=DELIGC(Z0,Z1,Z1,Z1)
-#endif
- WRITE(LOUT,'(1X)')
- WRITE(LOUT,'(/10X,
- + ''CALCULATED'',
- + 18X,''TEST'',9x,''Rel. Error'')')
- T1= 1.5464442694017956D0
- T2=-6.7687378198360556D-1
-#if !defined(CERNLIB_DOUBLE)
- DR1=RELIGC(0.1D0, 4.1D0,1.2D0,1.1D0)
- DR2=RELIGC(0.1D0,-4.1D0,1.2D0,1.1D0)
-#endif
-#if defined(CERNLIB_DOUBLE)
- IF(JF.EQ.1)THEN
- DR1=RELIGC(0.1E0, 4.1E0,1.2E0,1.1E0)
- DR2=RELIGC(0.1E0,-4.1E0,1.2E0,1.1E0)
- ENDIF
- IF(JF.EQ.2)THEN
- DR1=DELIGC(0.1D0, 4.1D0,1.2D0,1.1D0)
- DR2=DELIGC(0.1D0,-4.1D0,1.2D0,1.1D0)
- ENDIF
-#endif
- ERRMAX = MAX(ERRMAX,ABS((DR1-T1)/DR1),ABS((DR2-T2)/DR2))
- WRITE(LOUT,'(1X,2F25.15,1P,D10.1)')DR1,T1,ABS((DR1-T1)/DR1)
- WRITE(LOUT,'(1X,2F25.15,1P,D10.1)')DR2,T2,ABS((DR2-T2)/DR2)
-
- WRITE(LOUT,'(/'' Largest Relative Error was'',1P,D9.1)') ERRMAX
- LTEST=LTEST.AND.(ERRMAX.LE.ETOL)
- ERRMAX= 0.0D0
-
-C--- Test 5 -----------
-#if !defined(CERNLIB_DOUBLE)
- WRITE(LOUT,'(/10X,''TESTS FOR RELIKC and RELIEC'')')
-#endif
-#if defined(CERNLIB_DOUBLE)
- IF(JF.EQ.1)WRITE(LOUT,'(/10X,''TESTS FOR RELIKC and RELIEC'')')
- IF(JF.EQ.2)WRITE(LOUT,'(/10X,''TESTS FOR DELIKC and DELIEC'')')
-#endif
- WRITE(LOUT,'(/''TESTING ERROR MESSAGES:''/)')
-#if !defined(CERNLIB_DOUBLE)
- DR=RELIKC(Z1)
- DR=RELIKC(Z2)
- DR=RELIEC(Z2)
-#endif
-#if defined(CERNLIB_DOUBLE)
- IF(JF.EQ.1)THEN
- RZ1=Z1
- RZ2=Z2
- R=RELIKC(RZ1)
- R=RELIKC(RZ2)
- R=RELIEC(RZ2)
- ENDIF
- IF(JF.EQ.2)THEN
- DR=DELIKC(Z1)
- DR=DELIKC(Z2)
- DR=DELIEC(Z2)
- ENDIF
-#endif
- WRITE(LOUT,'(/13X,
- + ''CALCULATED'',
- + 21X,''TEST'',10X,''Rel. Error'')')
- T1=1.6520896063577719D0
- T2=1.3948418087767893D0
-#if !defined(CERNLIB_DOUBLE)
- DR1=RELIKC(0.43D0)
- DR2=RELIEC(0.64D0)
- ERRMAX= MAX(ERRMAX,ABS((DR1-T1)/DR1),ABS((DR2-T2)/DR2))
- WRITE(LOUT,'(1X,2F25.15,1P,D10.1)') DR1,T1,ABS((DR1-T1)/DR1)
- WRITE(LOUT,'(1X,2F25.15,1P,D10.1)') DR2,T2,ABS((DR2-T2)/DR2)
-#endif
-#if defined(CERNLIB_DOUBLE)
- IF(JF.EQ.1)THEN
- RT1=T1
- RT2=T2
- DR1=RELIKC(0.43E0)
- DR2=RELIEC(0.64E0)
- ERRMAX= MAX(ERRMAX,ABS((DR1-RT1)/DR1),ABS((DR2-RT2)/DR2))
- WRITE(LOUT,'(1X,2F25.15,1P,E10.1)') DR1,RT1,ABS((DR1-RT1)/DR1)
- WRITE(LOUT,'(1X,2F25.15,1P,E10.1)') DR2,RT2,ABS((DR2-RT2)/DR2)
- ENDIF
- IF(JF.EQ.2)THEN
- DR1=DELIKC(0.43D0)
- DR2=DELIEC(0.64D0)
- ERRMAX= MAX(ERRMAX,ABS((DR1-T1)/DR1),ABS((DR2-T2)/DR2))
- WRITE(LOUT,'(1X,2F25.15,1P,D10.1)') DR1,T1,ABS((DR1-T1)/DR1)
- WRITE(LOUT,'(1X,2F25.15,1P,D10.1)') DR2,T2,ABS((DR2-T2)/DR2)
- ENDIF
-
-#endif
- WRITE(LOUT,'(/'' Largest Relative Error was'',1P,D9.1)') ERRMAX
- LTEST=LTEST.AND.(ERRMAX.LE.ETOL)
- ERRMAX= 0.0D0
- 1000 CONTINUE
-C Check if the test was successful
- IRC=ITEST('C347',LTEST)
- CALL PAGEND('C347')
- END
-
- FUNCTION FC347(T)
-#include "gen/imp64.inc"
- COMMON /PARAMT/ AKP,A,B,P,FMODE
-
- ENTRY FF1EL1(T)
- FF1EL1=1/SQRT((1+T**2)*(1+(AKP*T)**2))
- RETURN
-
- ENTRY FF2EL1(T)
- FF2EL1=1/SQRT((1+T**2)*(AKP**2+T**2))
- RETURN
-
- ENTRY FF1EL2(T)
- FF1EL2=(A+B*T**2)/((1+T**2)*SQRT((1+T**2)*(1+FMODE*(AKP*T)**2)))
- RETURN
-
- ENTRY FF2EL2(T)
- FF2EL2=(B+A*T**2)/((T**2+1)*SQRT((1+T**2)*(FMODE*AKP**2+T**2)))
- RETURN
-
- ENTRY FF1EL3(T)
- FF1EL3=(1+T**2)/((1+P*T**2)*SQRT((1+T**2)*(1+(AKP*T)**2)))
- RETURN
-
- ENTRY FF2EL3(T)
- FF2EL3=(1+T**2)/((T**2+P)*SQRT((1+T**2)*(AKP**2+T**2)))
- RETURN
- END
diff --git a/src/mathlib/gen/tests/c348m.F b/src/mathlib/gen/tests/c348m.F
deleted file mode 100644
index d6db518..0000000
--- a/src/mathlib/gen/tests/c348m.F
+++ /dev/null
@@ -1,102 +0,0 @@
-*
-* $Id: c348m.F,v 1.1.1.1 1996/04/01 15:01:19 mclareni Exp $
-*
-* $Log: c348m.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:19 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE C348M
-C This program tests the operation of MATHLIB subprograms
-C CELINT and WELINT
-
-#include "gen/imp64.inc"
-#include "gen/defc64.inc"
- + FC348,Z,V,W,I,Z2
-#if defined(CERNLIB_DOUBLE)
-#include "gen/defc64.inc"
- +WGAUSS,WELINT
-#endif
-#if !defined(CERNLIB_DOUBLE)
-#include "gen/defc64.inc"
- +CGAUSS,CELINT
-#endif
- EXTERNAL FC348
- COMMON /FOC348/ AKC2,A,B
-
- PARAMETER (NR = 5, TSTER=5E-8)
- PARAMETER (Z0 = 0, Z1 = 1, Z10 = 10, HF = Z1/2,I = (0,1),Z2=(0,0))
- DIMENSION RKC(NR),RB(NR),RZR(NR),RZI(NR)
-#include "iorc.inc"
-
- CALL HEADER('C348',0)
- ERMAX=0
-#if defined(CERNLIB_DOUBLE)
- WRITE(LOUT,'(/10X,''TEST FOR WELINT'')')
- WRITE(LOUT,'(/6X,''AKP'',8X,''B'',16X,''Z'',26X,''WELINT''
- 1,22X,''Error'')')
- CALL DVRAN(NR,-Z10,Z10,RKC(1),RKC(2))
- CALL DVRAN(NR,-Z10,Z10,RB(1),RB(2))
- CALL DVRAN(NR,Z0,Z10,RZR(1),RZR(2))
- CALL DVRAN(NR,-Z10,Z10,RZI(1),RZI(2))
-#endif
-#if !defined(CERNLIB_DOUBLE)
- WRITE(LOUT,'(/10X,''TEST FOR CELINT'')')
- WRITE(LOUT,'(/6X,''AKP'',8X,''B'',16X,''Z'',26X,''CELINT''
- 1,22X,''Error'')')
- CALL RVRAN(NR,-Z10,Z10,RKC(1),RKC(2))
- CALL RVRAN(NR,-Z10,Z10,RB(1),RB(2))
- CALL RVRAN(NR,Z0,Z10,RZR(1),RZR(2))
- CALL RVRAN(NR,-Z10,Z10,RZI(1),RZI(2))
-#endif
- EPS=1D-14
- A=1
- DO 1 IKC = 0,NR
- IF(IKC .EQ. 0) THEN
- AKC=0
- ELSE
- AKC=RKC(IKC)
- ENDIF
- AKC2=AKC**2
- DO 1 IB = 1,NR
- B=RB(IB)
- DO 1 IZ = 1,NR
- Z=RZR(IZ)+I*RZI(IZ)
-#if defined(CERNLIB_DOUBLE)
- W=WELINT(Z,AKC,A,B)
- V=WGAUSS(FC348,Z2,Z,EPS)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- W=CELINT(Z,AKC,A,B)
- V=CGAUSS(FC348,Z2,Z,EPS)
-#endif
- E=ABS((W-V)/W)
- ERMAX=MAX(ERMAX,E)
- WRITE(LOUT,'(1X,2F10.4,5X,''('',F7.4,'','',F7.4,'') ('',
- +F19.15,'','',F19.15,'')'',1P,D10.1)')
- + AKC,B,Z,W,E
- 1 CONTINUE
- WRITE(LOUT,'(/'' Largest Relative Error was'',1P,D10.1)') ERMAX
- WRITE(LOUT,'(/''TESTING ERROR MESSAGES:''/)')
-#if defined(CERNLIB_DOUBLE)
- W=WELINT(-Z1+I*Z1,Z1,Z1,Z1)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- W=CELINT(-Z1+I*Z1,Z1,Z1,Z1)
-#endif
-C Check if the test was successful
- IRC=ITEST('C348',ERMAX .LE. TSTER)
- CALL PAGEND('C348')
- END
- FUNCTION FC348(T)
-#include "gen/imp64.inc"
-#include "gen/defc64.inc"
- + FC348,T,T1,T2
- COMMON /FOC348/ AKC2,A,B
-
- T2=T**2
- T1=1+T2
- FC348=(A+B*T2)/(T1*SQRT(T1)*SQRT(1+AKC2*T2))
- RETURN
- END
diff --git a/src/mathlib/gen/tests/c349m.F b/src/mathlib/gen/tests/c349m.F
deleted file mode 100644
index c4f5354..0000000
--- a/src/mathlib/gen/tests/c349m.F
+++ /dev/null
@@ -1,870 +0,0 @@
-*
-* $Id: c349m.F,v 1.1.1.1 1996/04/01 15:01:19 mclareni Exp $
-*
-* $Log: c349m.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:19 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE C349M
-C This program tests the operation of GENLIB subprograms
-C RTHETA and DTHETA
-
-#if defined(CERNLIB_DOUBLE)
-#include "gen/imp64.inc"
-C Set maximum error allowed for test to be considered successful
-C double precision
- PARAMETER (TSTERRD=2D-12 )
-C single precision
- PARAMETER (TSTERRS=1E-6 )
- REAL RTHETA, XREAL, QREAL
- PARAMETER ( IXDIM=15, IQDIM=9, SCALE=1D20, QCUT=0.9001D0 )
- DIMENSION XTAB(IXDIM), QTAB(IQDIM), DTHTAB(4,IXDIM,IQDIM)
- COMMON /C349D/ XTAB, QTAB, DTHTAB
-
-#include "iorc.inc"
-
- CALL HEADER('C349',0)
-
-C
-C *********************************************************************
-C
-C Test for CERN library subprogram C349 (DTHETA/RTHETA). Prints the
-C largest relative error arising from values of X and Q which have been
-C preset (together with the corresponding function values) in BLOCK
-C DATA subprogram BLKD.
-C
-C (Version 9.04.1992)
-C
-C *********************************************************************
-C
-C Start.
- WRITE (LOUT,2000)
- JTOTAL = 0
- DMAX1 = 0
- DMAX2 = 0
- RMAX1 = 0
- RMAX2 = 0
- DO 3 JQ = 1,IQDIM
- Q = QTAB(JQ)
- QREAL = Q
- DO 2 JX=1,IXDIM
- X = XTAB(JX)
- XREAL = X
- DO 1 K = 1,4
- DTHREF = SCALE*DTHTAB( K, JX, JQ )
- IF ( DTHREF.NE.0 ) THEN
- DTH = SCALE*DTHETA( K, X, Q )
- RTHREF = SCALE*DTHETA( K, DBLE(XREAL), DBLE(QREAL) )
- RTH = SCALE*RTHETA( K, XREAL, QREAL )
- D = ABS( (DTH-DTHREF)/DTHREF )
- R = ABS( (RTH-RTHREF)/DTHREF )
- IF ( Q.LE.QCUT ) THEN
- DMAX1 = MAX(D,DMAX1)
- RMAX1 = MAX(R,RMAX1)
- ELSE
- DMAX2 = MAX(D,DMAX2)
- RMAX2 = MAX(R,RMAX2)
- ENDIF
- ENDIF
- JTOTAL = JTOTAL+1
- 1 CONTINUE
- 2 CONTINUE
- 3 CONTINUE
- WRITE (LOUT,2001) DMAX1, RMAX1, DMAX2, RMAX2
- WRITE (LOUT,2002) JTOTAL/4
-C
-C Write sample error messages.
- WRITE (LOUT,2003)
- TH = DTHETA( 0, 0.5D0, -0.5D0 )
- TH = DTHETA( 4, 0.5D0, 1.5D0 )
- TH = DTHETA( -1, 0.5D0, 0.5D0 )
- TH = DTHETA( 5, 0.5D0, 0.5D0 )
- TH = DTHETA( 1, 0.5D0, 1.D0 )
- TH = DTHETA( 2, 0.D0, 1.D0 )
- WRITE (LOUT,2004)
-CCC STOP
-C
- 2000 FORMAT( ' Test program for C349.'
- $ // ' Prints the largest relative error for selected',
- $ ' values of X and Q.' )
- 2001 FORMAT( / 14X, 'Q', 16X, 'DTHETA', 7X, 'RTHETA'
- $ // 5X, ' Not exceeding 0.9:', 1P, 2(E13.1)
- $ / 5X, ' Greater than 0.9:', 2(E13.1) )
- 2002 FORMAT( / ' (Number of (X,Q) pairs = ', I3, ')' )
- 2003 FORMAT( // ' Now verify that exactly six error messages',
- $ ' (two of each kind) have been'
- $ / ' written on Unit LOUT.'/ )
- 2004 FORMAT( / ' ................................ END OF TEST',
- $ ' ..................................' )
-CCC END
-
- DMAXT=MAX(DMAX1,DMAX2)
- RMAXT=MAX(RMAX1,RMAX2)
- IRC=ITEST('C349',(DMAXT.LE.TSTERRD).AND.(RMAXT.LE.TSTERRS))
- CALL PAGEND('C349')
- RETURN
- END
- BLOCK DATA BLKD
-#include "gen/imp64.inc"
- PARAMETER ( IXDIM=15, IQDIM=9 )
- DIMENSION XTAB(IXDIM), QTAB(IQDIM), DTHTAB(4,IXDIM,IQDIM)
- COMMON /C349D/ XTAB, QTAB, DTHTAB
-C
-C *********************************************************************
-C Presets values of x, q and theta(k,x,q) for use by TC349D.
-C (Version 10.03.1992)
-C *********************************************************************
-C
- DATA XTAB/ 1D-5, 0.01D0, 0.1D0, 0.2D0, 0.25D0, 0.3D0, 0.4D0,
- $ 0.49D0, 0.49999D0,
- $ -0.51D0, -0.4999D0, 0.6D0, 0.99D0, 1.01D0, 1.7D0 /
- DATA QTAB/ 0.01D0, 0.1D0, 0.3D0, 0.7D0, 0.8D0, 0.9D0, 0.99D0,
- $ 0.999D0, 0.9999D0 /
- DATA (DTHTAB(1,J,1),J=1,15)/
- $ 0.198632157754725453D-04, 0.198599564121013164D-01,
- $ 0.195388340858127091D+00, 0.371687884364683724D+00,
- $ 0.447168874139960731D+00, 0.511647729650301780D+00,
- $ 0.601538129810991681D+00, 0.632206418275082338D+00,
- $ 0.632518777275126495D+00, -0.632206418275082338D+00,
- $ -0.632518746348993049D+00, 0.601538129810991681D+00,
- $ 0.198599564121013069D-01, -0.198599564121013338D-01,
- $ -0.511647729650301836D+00 /
- DATA (DTHTAB(1,J,2),J=1,15)/
- $ 0.342731357551889797D-04, 0.342688918368830777D-01,
- $ 0.338448303153667251D+00, 0.650375507769968983D+00,
- $ 0.787317226209446663D+00, 0.906410792231181400D+00,
- $ 0.107624748216203558D+01, 0.113532571091174450D+01,
- $ 0.113593060096330678D+01, -0.113532571091174450D+01,
- $ -0.113593054107095148D+01, 0.107624748216203558D+01,
- $ 0.342688918368830595D-01, -0.342688918368831072D-01,
- $ -0.906410792231181484D+00 /
- DATA (DTHTAB(1,J,3),J=1,15)/
- $ 0.341148874032195199D-04, 0.341251229167217176D-01,
- $ 0.350701610126758975D+00, 0.743325360716168004D+00,
- $ 0.951675536091518018D+00, 0.115523417890160118D+01,
- $ 0.148602244163968122D+01, 0.161312545262637985D+01,
- $ 0.161446033985901960D+01, -0.161312545262637985D+01,
- $ -0.161446020765304965D+01, 0.148602244163968122D+01,
- $ 0.341251229167217002D-01, -0.341251229167217479D-01,
- $ -0.115523417890160141D+01 /
- DATA (DTHTAB(1,J,4),J=1,15)/
- $ 0.162607019569856244D-05, 0.164235006244872311D-02,
- $ 0.353127832146888105D-01, 0.245959457067496945D+00,
- $ 0.526440250927469308D+00, 0.981163921741326883D+00,
- $ 0.225042412979604212D+01, 0.295962640225301743D+01,
- $ 0.296782736070505759D+01, -0.295962640225301743D+01,
- $ -0.296782654768564913D+01, 0.225042412979604212D+01,
- $ 0.164235006244872219D-02, -0.164235006244872452D-02,
- $ -0.981163921741327341D+00 /
- DATA (DTHTAB(1,J,5),J=1,15)/
- $ 0.523400235070725572D-07, 0.538247271993050233D-04,
- $ 0.316822422419801012D-02, 0.700636601883636856D-01,
- $ 0.236447213130184963D+00, 0.639634210332025360D+00,
- $ 0.241098770377506821D+01, 0.373561308836743255D+01,
- $ 0.375217222351964508D+01, -0.373561308836743255D+01,
- $ -0.375217058053589358D+01, 0.241098770377506821D+01,
- $ 0.538247271993049928D-04, -0.538247271993050741D-04,
- $ -0.639634210332025832D+00 /
- DATA (DTHTAB(1,J,6),J=1,15)/
- $ 0.690712297965843012D-12, 0.788829791612324682D-09,
- $ 0.169066643457097958D-05, 0.119075752432300480D-02,
- $ 0.156526658224505153D-01, 0.128807596896837337D+00,
- $ 0.213999305500227055D+01, 0.540963242188914140D+01,
- $ 0.546054497590917953D+01, -0.540963242188914140D+01,
- $ -0.546053991191917665D+01, 0.213999305500227055D+01,
- $ 0.788829791612324165D-09, -0.788829791612325560D-09,
- $ -0.128807596896837531D+00 /
- DATA (DTHTAB(1,J,7),J=1,15)/
- $ 0.000000000000000000D+00, 0.000000000000000000D+00,
- $ 0.000000000000000000D+00, 0.730902308093085031D-37,
- $ 0.391011284182882938D-25, 0.154203993057748423D-15,
- $ 0.960809728137294568D-03, 0.160264073183361582D+02,
- $ 0.176800954882009016D+02, -0.160264073183361582D+02,
- $ -0.176799236036434664D+02, 0.960809728137294568D-03,
- $ 0.000000000000000000D+00, 0.000000000000000000D+00,
- $ -0.154203993057750943D-15 /
- DATA (DTHTAB(1,J,8),J=1,15)/
- $ 0.000000000000000000D+00, 0.000000000000000000D+00,
- $ 0.000000000000000000D+00, 0.000000000000000000D+00,
- $ 0.000000000000000000D+00, 0.000000000000000000D+00,
- $ 0.000000000000000000D+00, 0.208953281519834597D+02,
- $ 0.560358403192469190D+02, -0.208953281519834597D+02,
- $ -0.560303681139167438D+02, 0.000000000000000000D+00,
- $ 0.000000000000000000D+00, 0.000000000000000000D+00,
- $ 0.000000000000000000D+00 /
- DATA (DTHTAB(1,J,9),J=1,15)/
- $ 0.000000000000000000D+00, 0.000000000000000000D+00,
- $ 0.000000000000000000D+00, 0.000000000000000000D+00,
- $ 0.000000000000000000D+00, 0.000000000000000000D+00,
- $ 0.000000000000000000D+00, 0.917199201315058860D-02,
- $ 0.177239204624673420D+03, -0.917199201315058860D-02,
- $ -0.177066119050895953D+03, 0.000000000000000000D+00,
- $ 0.000000000000000000D+00, 0.000000000000000000D+00,
- $ 0.000000000000000000D+00 /
- DATA (DTHTAB(2,J,1),J=1,15)/
- $ 0.632518777275126495D+00, 0.632206418275082338D+00,
- $ 0.601538129810991681D+00, 0.511647729650301780D+00,
- $ 0.447168874139960731D+00, 0.371687884364683724D+00,
- $ 0.195388340858127091D+00, 0.198599564121013069D-01,
- $ 0.198632157754648440D-04, -0.198599564121013069D-01,
- $ 0.198632154527802418D-03, -0.195388340858127091D+00,
- $ -0.632206418275082338D+00, -0.632206418275082338D+00,
- $ 0.371687884364683654D+00 /
- DATA (DTHTAB(2,J,2),J=1,15)/
- $ 0.113593060096330678D+01, 0.113532571091174450D+01,
- $ 0.107624748216203558D+01, 0.906410792231181400D+00,
- $ 0.787317226209446663D+00, 0.650375507769968983D+00,
- $ 0.338448303153667251D+00, 0.342688918368830595D-01,
- $ 0.342731357551756915D-04, -0.342688918368830595D-01,
- $ 0.342731353350821241D-03, -0.338448303153667251D+00,
- $ -0.113532571091174450D+01, -0.113532571091174450D+01,
- $ 0.650375507769968858D+00 /
- DATA (DTHTAB(2,J,3),J=1,15)/
- $ 0.161446033985901960D+01, 0.161312545262637985D+01,
- $ 0.148602244163968122D+01, 0.115523417890160118D+01,
- $ 0.951675536091518018D+00, 0.743325360716168004D+00,
- $ 0.350701610126758975D+00, 0.341251229167217002D-01,
- $ 0.341148874032062926D-04, -0.341251229167217002D-01,
- $ 0.341148884172322482D-03, -0.350701610126758975D+00,
- $ -0.161312545262637985D+01, -0.161312545262637985D+01,
- $ 0.743325360716167838D+00 /
- DATA (DTHTAB(2,J,4),J=1,15)/
- $ 0.296782736070505759D+01, 0.295962640225301743D+01,
- $ 0.225042412979604212D+01, 0.981163921741326883D+00,
- $ 0.526440250927469308D+00, 0.245959457067496945D+00,
- $ 0.353127832146888105D-01, 0.164235006244872219D-02,
- $ 0.162607019569793203D-05, -0.164235006244872219D-02,
- $ 0.162607180461073517D-04, -0.353127832146888105D-01,
- $ -0.295962640225301743D+01, -0.295962640225301743D+01,
- $ 0.245959457067496778D+00 /
- DATA (DTHTAB(2,J,5),J=1,15)/
- $ 0.375217222351964508D+01, 0.373561308836743255D+01,
- $ 0.241098770377506821D+01, 0.639634210332025360D+00,
- $ 0.236447213130184963D+00, 0.700636601883636856D-01,
- $ 0.316822422419801012D-02, 0.538247271993049928D-04,
- $ 0.523400235070522657D-07, -0.538247271993049928D-04,
- $ 0.523401695350480948D-06, -0.316822422419801012D-02,
- $ -0.373561308836743255D+01, -0.373561308836743255D+01,
- $ 0.700636601883636162D-01 /
- DATA (DTHTAB(2,J,6),J=1,15)/
- $ 0.546054497590917953D+01, 0.540963242188914140D+01,
- $ 0.213999305500227055D+01, 0.128807596896837337D+00,
- $ 0.156526658224505153D-01, 0.119075752432300480D-02,
- $ 0.169066643457097958D-05, 0.788829791612324165D-09,
- $ 0.690712297965575241D-12, -0.788829791612324165D-09,
- $ 0.690721658020137083D-11, -0.169066643457097958D-05,
- $ -0.540963242188914140D+01, -0.540963242188914117D+01,
- $ 0.119075752432300203D-02 /
- DATA (DTHTAB(2,J,7),J=1,15)/
- $ 0.176800954882009016D+02, 0.160264073183361546D+02,
- $ 0.960809728137294568D-03, 0.154203993057748423D-15,
- $ 0.391011284182882938D-25, 0.730902308093085031D-37,
- $ 0.000000000000000000D+00, 0.000000000000000000D+00,
- $ 0.000000000000000000D+00, 0.000000000000000000D+00,
- $ 0.000000000000000000D+00, 0.000000000000000000D+00,
- $ -0.160264073183361582D+02, -0.160264073183361511D+02,
- $ 0.730902308093067073D-37 /
- DATA (DTHTAB(2,J,8),J=1,15)/
- $ 0.560358403192469190D+02, 0.208953281519834384D+02,
- $ 0.000000000000000000D+00, 0.000000000000000000D+00,
- $ 0.000000000000000000D+00, 0.000000000000000000D+00,
- $ 0.000000000000000000D+00, 0.000000000000000000D+00,
- $ 0.000000000000000000D+00, 0.000000000000000000D+00,
- $ 0.000000000000000000D+00, 0.000000000000000000D+00,
- $ -0.208953281519834597D+02, -0.208953281519834029D+02,
- $ 0.000000000000000000D+00 /
- DATA (DTHTAB(2,J,9),J=1,15)/
- $ 0.177239204624673420D+03, 0.917199201315049492D-02,
- $ 0.000000000000000000D+00, 0.000000000000000000D+00,
- $ 0.000000000000000000D+00, 0.000000000000000000D+00,
- $ 0.000000000000000000D+00, 0.000000000000000000D+00,
- $ 0.000000000000000000D+00, 0.000000000000000000D+00,
- $ 0.000000000000000000D+00, 0.000000000000000000D+00,
- $ -0.917199201315058860D-02, -0.917199201315033793D-02,
- $ 0.000000000000000000D+00 /
- DATA (DTHTAB(3,J,1),J=1,15)/
- $ 0.102000001996052125D+01, 0.101996055441085942D+01,
- $ 0.101618034606783869D+01, 0.100618032370715893D+01,
- $ 0.999999979999999997D+00, 0.993819643932161156D+00,
- $ 0.983819666292840928D+00, 0.980039485273728583D+00,
- $ 0.980000020039478253D+00, 0.980039485273728583D+00,
- $ 0.980000023947825830D+00, 0.983819666292840928D+00,
- $ 0.101996055441085942D+01, 0.101996055441085942D+01,
- $ 0.993819643932161156D+00 /
- DATA (DTHTAB(3,J,2),J=1,15)/
- $ 0.120020000160363671D+01, 0.119980377059049181D+01,
- $ 0.116186520165583018D+01, 0.106164159385808055D+01,
- $ 0.999800000000000189D+00, 0.938034799344169556D+00,
- $ 0.838258405141919322D+00, 0.800593075290034262D+00,
- $ 0.800199998393205256D+00, 0.800593075290034262D+00,
- $ 0.800200037320506388D+00, 0.838258405141919322D+00,
- $ 0.119980377059049181D+01, 0.119980377059049181D+01,
- $ 0.938034799344169515D+00 /
- DATA (DTHTAB(3,J,3),J=1,15)/
- $ 0.161623937329655143D+01, 0.161492697227719662D+01,
- $ 0.149040410020556680D+01, 0.117227227621369678D+01,
- $ 0.983800008609344190D+00, 0.801515578489422148D+00,
- $ 0.519608036481969945D+00, 0.417217560723124062D+00,
- $ 0.416160643666316263D+00, 0.417217560723124062D+00,
- $ 0.416160748323325655D+00, 0.519608036481969945D+00,
- $ 0.161492697227719662D+01, 0.161492697227719662D+01,
- $ 0.801515578489422009D+00 /
- DATA (DTHTAB(3,J,4),J=1,15)/
- $ 0.296782736071646203D+01, 0.295962640226617668D+01,
- $ 0.225042413089090676D+01, 0.981164042610629950D+00,
- $ 0.526441282896179932D+00, 0.245967129444088342D+00,
- $ 0.355928072348134462D-01, 0.608596214962086549D-02,
- $ 0.587641091906428419D-02, 0.608596214962086549D-02,
- $ 0.587643158189959762D-02, 0.355928072348134462D-01,
- $ 0.295962640226617690D+01, 0.295962640226617668D+01,
- $ 0.245967129444088176D+00 /
- DATA (DTHTAB(3,J,5),J=1,15)/
- $ 0.375217222351964508D+01, 0.373561308836743255D+01,
- $ 0.241098770377507021D+01, 0.639634210335842127D+00,
- $ 0.236447213247776400D+00, 0.700636630924666021D-01,
- $ 0.316913655643226471D-02, 0.129527162022010146D-03,
- $ 0.118336450056192763D-03, 0.129527162022010146D-03,
- $ 0.118337544161499754D-03, 0.316913655643226471D-02,
- $ 0.373561308836743255D+01, 0.373561308836743255D+01,
- $ 0.700636630924665188D-01 /
- DATA (DTHTAB(3,J,6),J=1,15)/
- $ 0.546054497590917953D+01, 0.540963242188914140D+01,
- $ 0.213999305500227055D+01, 0.128807596896837337D+00,
- $ 0.156526658224505153D-01, 0.119075752432300496D-02,
- $ 0.169066645926633930D-05, 0.107510478036200374D-08,
- $ 0.737353010451161171D-09, 0.107510478036200374D-08,
- $ 0.737384354437164498D-09, 0.169066645926633930D-05,
- $ 0.540963242188914140D+01, 0.540963242188914117D+01,
- $ 0.119075752432300214D-02 /
- DATA (DTHTAB(3,J,7),J=1,15)/
- $ 0.176800954882009016D+02, 0.160264073183361546D+02,
- $ 0.960809728137294568D-03, 0.154203993057748423D-15,
- $ 0.391011284182882938D-25, 0.730902308093085031D-37,
- $ 0.000000000000000000D+00, 0.000000000000000000D+00,
- $ 0.000000000000000000D+00, 0.000000000000000000D+00,
- $ 0.000000000000000000D+00, 0.000000000000000000D+00,
- $ 0.160264073183361582D+02, 0.160264073183361511D+02,
- $ 0.730902308093067073D-37 /
- DATA (DTHTAB(3,J,8),J=1,15)/
- $ 0.560358403192469190D+02, 0.208953281519834384D+02,
- $ 0.000000000000000000D+00, 0.000000000000000000D+00,
- $ 0.000000000000000000D+00, 0.000000000000000000D+00,
- $ 0.000000000000000000D+00, 0.000000000000000000D+00,
- $ 0.000000000000000000D+00, 0.000000000000000000D+00,
- $ 0.000000000000000000D+00, 0.000000000000000000D+00,
- $ 0.208953281519834597D+02, 0.208953281519834029D+02,
- $ 0.000000000000000000D+00 /
- DATA (DTHTAB(3,J,9),J=1,15)/
- $ 0.177239204624673420D+03, 0.917199201315049492D-02,
- $ 0.000000000000000000D+00, 0.000000000000000000D+00,
- $ 0.000000000000000000D+00, 0.000000000000000000D+00,
- $ 0.000000000000000000D+00, 0.000000000000000000D+00,
- $ 0.000000000000000000D+00, 0.000000000000000000D+00,
- $ 0.000000000000000000D+00, 0.000000000000000000D+00,
- $ 0.917199201315058860D-02, 0.917199201315033793D-02,
- $ 0.000000000000000000D+00 /
- DATA (DTHTAB(4,J,1),J=1,15)/
- $ 0.980000020039478253D+00, 0.980039485273728583D+00,
- $ 0.983819666292840928D+00, 0.993819643932161156D+00,
- $ 0.999999979999999997D+00, 0.100618032370715893D+01,
- $ 0.101618034606783869D+01, 0.101996055441085942D+01,
- $ 0.102000001996052125D+01, 0.101996055441085942D+01,
- $ 0.102000001605214252D+01, 0.101618034606783869D+01,
- $ 0.980039485273728583D+00, 0.980039485273728583D+00,
- $ 0.100618032370715893D+01 /
- DATA (DTHTAB(4,J,2),J=1,15)/
- $ 0.800199998393205256D+00, 0.800593075290034262D+00,
- $ 0.838258405141919322D+00, 0.938034799344169556D+00,
- $ 0.999800000000000189D+00, 0.106164159385808055D+01,
- $ 0.116186520165583018D+01, 0.119980377059049181D+01,
- $ 0.120020000160363671D+01, 0.119980377059049181D+01,
- $ 0.120019996236366655D+01, 0.116186520165583018D+01,
- $ 0.800593075290034262D+00, 0.800593075290034262D+00,
- $ 0.106164159385808055D+01 /
- DATA (DTHTAB(4,J,3),J=1,15)/
- $ 0.416160643666316263D+00, 0.417217560723124062D+00,
- $ 0.519608036481969945D+00, 0.801515578489422148D+00,
- $ 0.983800008609344190D+00, 0.117227227621369678D+01,
- $ 0.149040410020556680D+01, 0.161492697227719662D+01,
- $ 0.161623937329655143D+01, 0.161492697227719662D+01,
- $ 0.161623924331329705D+01, 0.149040410020556680D+01,
- $ 0.417217560723124062D+00, 0.417217560723124062D+00,
- $ 0.117227227621369701D+01 /
- DATA (DTHTAB(4,J,4),J=1,15)/
- $ 0.587641091906428419D-02, 0.608596214962086549D-02,
- $ 0.355928072348134462D-01, 0.245967129444088342D+00,
- $ 0.526441282896179932D+00, 0.981164042610629950D+00,
- $ 0.225042413089090676D+01, 0.295962640226617690D+01,
- $ 0.296782736071646203D+01, 0.295962640226617690D+01,
- $ 0.296782654769705379D+01, 0.225042413089090676D+01,
- $ 0.608596214962086549D-02, 0.608596214962086549D-02,
- $ 0.981164042610630407D+00 /
- DATA (DTHTAB(4,J,5),J=1,15)/
- $ 0.118336450056192763D-03, 0.129527162022010156D-03,
- $ 0.316913655643226471D-02, 0.700636630924666021D-01,
- $ 0.236447213247776400D+00, 0.639634210335842127D+00,
- $ 0.241098770377507021D+01, 0.373561308836743255D+01,
- $ 0.375217222351964508D+01, 0.373561308836743255D+01,
- $ 0.375217058053589358D+01, 0.241098770377507021D+01,
- $ 0.129527162022010146D-03, 0.129527162022010176D-03,
- $ 0.639634210335842598D+00 /
- DATA (DTHTAB(4,J,6),J=1,15)/
- $ 0.737353010451161171D-09, 0.107510478036200415D-08,
- $ 0.169066645926633930D-05, 0.119075752432300496D-02,
- $ 0.156526658224505153D-01, 0.128807596896837337D+00,
- $ 0.213999305500227055D+01, 0.540963242188914140D+01,
- $ 0.546054497590917953D+01, 0.540963242188914140D+01,
- $ 0.546053991191917665D+01, 0.213999305500227055D+01,
- $ 0.107510478036200374D-08, 0.107510478036200477D-08,
- $ 0.128807596896837531D+00 /
- DATA (DTHTAB(4,J,7),J=1,15)/
- $ 0.000000000000000000D+00, 0.000000000000000000D+00,
- $ 0.000000000000000000D+00, 0.730902308093085031D-37,
- $ 0.391011284182882938D-25, 0.154203993057748423D-15,
- $ 0.960809728137294568D-03, 0.160264073183361582D+02,
- $ 0.176800954882009016D+02, 0.160264073183361582D+02,
- $ 0.176799236036434664D+02, 0.960809728137294568D-03,
- $ 0.000000000000000000D+00, 0.000000000000000000D+00,
- $ 0.154203993057750943D-15 /
- DATA (DTHTAB(4,J,8),J=1,15)/
- $ 0.000000000000000000D+00, 0.000000000000000000D+00,
- $ 0.000000000000000000D+00, 0.000000000000000000D+00,
- $ 0.000000000000000000D+00, 0.000000000000000000D+00,
- $ 0.000000000000000000D+00, 0.208953281519834597D+02,
- $ 0.560358403192469190D+02, 0.208953281519834597D+02,
- $ 0.560303681139167438D+02, 0.000000000000000000D+00,
- $ 0.000000000000000000D+00, 0.000000000000000000D+00,
- $ 0.000000000000000000D+00 /
- DATA (DTHTAB(4,J,9),J=1,15)/
- $ 0.000000000000000000D+00, 0.000000000000000000D+00,
- $ 0.000000000000000000D+00, 0.000000000000000000D+00,
- $ 0.000000000000000000D+00, 0.000000000000000000D+00,
- $ 0.000000000000000000D+00, 0.917199201315058860D-02,
- $ 0.177239204624673420D+03, 0.917199201315058860D-02,
- $ 0.177066119050895953D+03, 0.000000000000000000D+00,
- $ 0.000000000000000000D+00, 0.000000000000000000D+00,
- $ 0.000000000000000000D+00 /
- END
-
-#endif
-#if !defined(CERNLIB_DOUBLE)
-
-C Set maximum error allowed for test to be considered successful
-C single precision
- PARAMETER (TSTERR =1E-13)
- PARAMETER ( IXDIM=15, IQDIM=9, SCALE=1E20, QCUT=0.9001 )
- DIMENSION XTAB(IXDIM), QTAB(IQDIM), RTHTAB(4,IXDIM,IQDIM)
- COMMON /C349R/ XTAB, QTAB, RTHTAB
-#include "iorc.inc"
- CALL HEADER('C349',0)
-C
-C *********************************************************************
-C
-C Test for CERN library subprogram C349 (RTHETA version). Prints the
-C largest relative error arising from values of X and Q which have been
-C preset (together with the corresponding function values) in BLOCK
-C DATA subprogram BLKR.
-C
-C (Version 11.02.1992)
-C
-C *********************************************************************
-C
-C Start.
- WRITE (LOUT,2000)
- JTOTAL = 0
- RMAX1 = 0
- RMAX2 = 0
- DO 3 JQ = 1,IQDIM
- Q = QTAB(JQ)
- DO 2 JX=1,IXDIM
- X = XTAB(JX)
- DO 1 K = 1,4
- RTHREF = SCALE*RTHTAB( K, JX, JQ )
- IF ( RTHREF.NE.0 ) THEN
- RTH = SCALE*RTHETA( K, X, Q )
- R = ABS( (RTH-RTHREF)/RTHREF )
- IF ( Q.LE.QCUT ) THEN
- RMAX1 = MAX(R,RMAX1)
- ELSE
- RMAX2 = MAX(R,RMAX2)
- ENDIF
- ENDIF
- JTOTAL = JTOTAL+1
- 1 CONTINUE
- 2 CONTINUE
- 3 CONTINUE
- WRITE (LOUT,2001) RMAX1, RMAX2
- WRITE (LOUT,2002) JTOTAL/4
-C
-C Write sample error messages.
- WRITE (LOUT,2003)
- TH = RTHETA( 0, 0.5, -0.5 )
- TH = RTHETA( 4, 0.5, 1.5 )
- TH = RTHETA( -1, 0.5, 0.5 )
- TH = RTHETA( 5, 0.5, 0.5 )
- TH = RTHETA( 1, 0.5, 1.0 )
- TH = RTHETA( 2, 0.0, 1.0 )
- WRITE (LOUT,2004)
-CCC STOP
-C
- 2000 FORMAT( ' Test program for C349 (RTHETA version).'
- $ // ' Prints the largest relative error for selected',
- $ ' values of X and Q.' )
- 2001 FORMAT( / 5X, ' Not exceeding 0.9:', 1P, E13.1
- $ / 5X, ' Greater than 0.9:', E13.1 )
- 2002 FORMAT( / ' (Number of (X,Q) pairs = ', I3, ')' )
- 2003 FORMAT( // ' Now verify that exactly six error messages',
- $ ' (two of each kind) have been'
- $ / ' written on Unit LOUT.'/ )
- 2004 FORMAT( / ' ................................ END OF TEST',
- $ ' ..................................' )
-CCC END
-
- RMAXT=MAX(RMAX1,RMAX2)
- IRC=ITEST('C349',RMAXT.LE.TSTERR)
- CALL PAGEND('C349')
- RETURN
- END
-
- BLOCK DATA BLKR
- PARAMETER ( IXDIM=15, IQDIM=9 )
- DIMENSION XTAB(IXDIM), QTAB(IQDIM), RTHTAB(4,IXDIM,IQDIM)
- COMMON /C349R/ XTAB, QTAB, RTHTAB
-C
-C *********************************************************************
-C Presets values of x, q and theta(k,x,q) for use by TC349R.
-C (Version 11.02.1992)
-C *********************************************************************
-
- DATA XTAB/ 1D-5, 0.01, 0.1, 0.2, 0.25, 0.3, 0.4, 0.49, 0.49999,
- $ -0.51, -0.4999, 0.6, 0.99, 1.01, 1.7 /
- DATA QTAB/ 0.01, 0.1, 0.3, 0.7, 0.8, 0.9, 0.99, 0.999, 0.9999 /
- DATA (RTHTAB(1,J,1),J=1,15)/
- $ 0.1986321608569005E-04, 0.1985996047820741E-01,
- $ 0.1953883938929290E+00, 0.3716878804115662E+00,
- $ 0.4471688924494714E+00, 0.5116477645392764E+00,
- $ 0.6015381398229293E+00, 0.6322064447981275E+00,
- $ 0.6325188032144861E+00, -0.6322064447981275E+00,
- $ -0.6325187722788321E+00, 0.6015381398229293E+00,
- $ 0.1985993829026051E-01, -0.1986041163312242E-01,
- $ -0.5116479734739409E+00 /
- DATA (RTHTAB(1,J,2),J=1,15)/
- $ 0.3427313642702537E-04, 0.3426889899074363E-01,
- $ 0.3384483976215273E+00, 0.6503755069687510E+00,
- $ 0.7873172693439214E+00, 0.9064108705579993E+00,
- $ 0.1076247521386946E+01, 0.1135325785076698E+01,
- $ 0.1135930674032911E+01, -0.1135325785076698E+01,
- $ -0.1135930614122115E+01, 0.1076247521386946E+01,
- $ 0.3426886070175763E-01, -0.3426967753345208E-01,
- $ -0.9064112599483611E+00 /
- DATA (RTHTAB(1,J,3),J=1,15)/
- $ 0.3411488592283592E-04, 0.3412512789646213E-01,
- $ 0.3507016931483890E+00, 0.7433253087624970E+00,
- $ 0.9516755378777994E+00, 0.1155234233665976E+01,
- $ 0.1486022403743479E+01, 0.1613125481990883E+01,
- $ 0.1614460366738221E+01, -0.1613125481990883E+01,
- $ -0.1614460234491551E+01, 0.1486022403743479E+01,
- $ 0.3412508973580355E-01, -0.3412590382986981E-01,
- $ -0.1155234935922142E+01 /
- DATA (RTHTAB(1,J,4),J=1,15)/
- $ 0.1626070575250972E-05, 0.1642350760064550E-02,
- $ 0.3531280862178461E-01, 0.2459594317573693E+00,
- $ 0.5264402818299556E+00, 0.9811640796311318E+00,
- $ 0.2250423808868681E+01, 0.2959626347608944E+01,
- $ 0.2967827289831395E+01, -0.2959626347608944E+01,
- $ -0.2967826476561793E+01, 0.2250423808868681E+01,
- $ 0.1642348888143378E-02, -0.1642388822488285E-02,
- $ -0.9811660215472074E+00 /
- DATA (RTHTAB(1,J,5),J=1,15)/
- $ 0.5233998877980487E-07, 0.5382470237461430E-04,
- $ 0.3168225506758064E-02, 0.7006362173806495E-01,
- $ 0.2364471773768593E+00, 0.6396342910216622E+00,
- $ 0.2410987204577334E+01, 0.3735613243507420E+01,
- $ 0.3752172348756504E+01, -0.3735613243507420E+01,
- $ -0.3752170705266869E+01, 0.2410987204577334E+01,
- $ 0.5382463888059103E-04, -0.5382599342220417E-04,
- $ -0.6396363145485954E+00 /
- DATA (RTHTAB(1,J,6),J=1,15)/
- $ 0.6907160870690318E-12, 0.7888342485278886E-09,
- $ 0.1690675613940022E-05, 0.1190759100908589E-02,
- $ 0.1565268689612706E-01, 0.1288077595898328E+00,
- $ 0.2139992334116663E+01, 0.5409631851208299E+01,
- $ 0.5460544289293762E+01, -0.5409631851208299E+01,
- $ -0.5460539223746948E+01, 0.2139992334116663E+01,
- $ 0.7888331395165892E-09, -0.7888567985976718E-09,
- $ -0.1288086226207619E+00 /
- DATA (RTHTAB(1,J,7),J=1,15)/
- $ 0.0000000000000000E+00, 0.0000000000000000E+00,
- $ 0.1022990193254645E-66, 0.7308356111927279E-37,
- $ 0.3909884698342626E-25, 0.1541989833542450E-15,
- $ 0.9607966459721680E-03, 0.1602641649220523E+02,
- $ 0.1768010395651999E+02, -0.1602641649220523E+02,
- $ -0.1767993201880870E+02, 0.9607966459721680E-03,
- $ 0.0000000000000000E+00, 0.0000000000000000E+00,
- $ -0.1542098145768002E-15 /
- DATA (RTHTAB(1,J,8),J=1,15)/
- $ 0.0000000000000000E+00, 0.0000000000000000E+00,
- $ 0.0000000000000000E+00, 0.0000000000000000E+00,
- $ 0.0000000000000000E+00, 0.0000000000000000E+00,
- $ 0.8057209949692564E-41, 0.2089523653108562E+02,
- $ 0.5603620107189387E+02, -0.2089523653108562E+02,
- $ -0.5603072707652527E+02, 0.8057209949692564E-41,
- $ 0.0000000000000000E+00, 0.0000000000000000E+00,
- $ 0.0000000000000000E+00 /
- DATA (RTHTAB(1,J,9),J=1,15)/
- $ 0.0000000000000000E+00, 0.0000000000000000E+00,
- $ 0.0000000000000000E+00, 0.0000000000000000E+00,
- $ 0.0000000000000000E+00, 0.0000000000000000E+00,
- $ 0.0000000000000000E+00, 0.9186434011160556E-02,
- $ 0.1772244957790231E+03, -0.9186434011160556E-02,
- $ -0.1770514000339975E+03, 0.0000000000000000E+00,
- $ 0.0000000000000000E+00, 0.0000000000000000E+00,
- $ 0.0000000000000000E+00 /
- DATA (RTHTAB(2,J,1),J=1,15)/
- $ 0.6325188032153351E+00, 0.6322064441000082E+00,
- $ 0.6015381398229293E+00, 0.5116477645392764E+00,
- $ 0.4471688924494714E+00, 0.3716878804115662E+00,
- $ 0.1953883938929290E+00, 0.1985993829026051E-01,
- $ 0.1989019147571722E-04, -0.1985993829026051E-01,
- $ 0.1986651235349559E-03, -0.1953883938929290E+00,
- $ -0.6322064447981275E+00, -0.6322064299047448E+00,
- $ 0.3716875929440658E+00 /
- DATA (RTHTAB(2,J,2),J=1,15)/
- $ 0.1135930674034555E+01, 0.1135325783724847E+01,
- $ 0.1076247521386946E+01, 0.9064108705579993E+00,
- $ 0.7873172693439214E+00, 0.6503755069687510E+00,
- $ 0.3384483976215273E+00, 0.3426886070175763E-01,
- $ 0.3431968131777517E-04, -0.3426886070175763E-01,
- $ 0.3427882413399479E-03, -0.3384483976215273E+00,
- $ -0.1135325785076698E+01, -0.1135325756236884E+01,
- $ 0.6503749899758190E+00 /
- DATA (RTHTAB(2,J,3),J=1,15)/
- $ 0.1614460366741850E+01, 0.1613125479008349E+01,
- $ 0.1486022403743479E+01, 0.1155234233665976E+01,
- $ 0.9516755378777994E+00, 0.7433253087624970E+00,
- $ 0.3507016931483890E+00, 0.3412508973580355E-01,
- $ 0.3416121590033741E-04, -0.3412508973580355E-01,
- $ 0.3412054880066267E-03, -0.3507016931483890E+00,
- $ -0.1613125481990883E+01, -0.1613125418362778E+01,
- $ 0.7433245697201163E+00 /
- DATA (RTHTAB(2,J,4),J=1,15)/
- $ 0.2967827289853716E+01, 0.2959626329303713E+01,
- $ 0.2250423808868681E+01, 0.9811640796311318E+00,
- $ 0.5264402818299556E+00, 0.2459594317573693E+00,
- $ 0.3531280862178461E-01, 0.1642348888143378E-02,
- $ 0.1628278872672843E-05, -0.1642348888143378E-02,
- $ 0.1626342055118134E-04, -0.3531280862178461E-01,
- $ -0.2959626347608944E+01, -0.2959625957092943E+01,
- $ 0.2459587015179157E+00 /
- DATA (RTHTAB(2,J,5),J=1,15)/
- $ 0.3752172348801611E+01, 0.3735613206576635E+01,
- $ 0.2410987204577334E+01, 0.6396342910216622E+00,
- $ 0.2364471773768593E+00, 0.7006362173806495E-01,
- $ 0.3168225506758064E-02, 0.5382463888059103E-04,
- $ 0.5241106949933525E-07, -0.5382463888059103E-04,
- $ 0.5234882146606818E-06, -0.3168225506758064E-02,
- $ -0.3735613243507420E+01, -0.3735612455641802E+01,
- $ 0.7006328926246956E-01 /
- DATA (RTHTAB(2,J,6),J=1,15)/
- $ 0.5460544289432789E+01, 0.5409631737942014E+01,
- $ 0.2139992334116663E+01, 0.1288077595898328E+00,
- $ 0.1565268689612706E-01, 0.1190759100908589E-02,
- $ 0.1690675613940022E-05, 0.7888331395165892E-09,
- $ 0.6916541195046509E-12, -0.7888331395165892E-09,
- $ 0.6908400862791128E-11, -0.1690675613940022E-05,
- $ -0.5409631851208299E+01, -0.5409629434833953E+01,
- $ 0.1190747133607115E-02 /
- DATA (RTHTAB(2,J,7),J=1,15)/
- $ 0.1768010396123896E+02, 0.1602641297443747E+02,
- $ 0.9607966459721680E-03, 0.1541989833542450E-15,
- $ 0.3909884698342626E-25, 0.7308356111927279E-37,
- $ 0.1022990193254645E-66, 0.0000000000000000E+00,
- $ 0.0000000000000000E+00, 0.0000000000000000E+00,
- $ 0.0000000000000000E+00, -0.1022990193254645E-66,
- $ -0.1602641649220523E+02, -0.1602634144580780E+02,
- $ 0.7307586150151781E-37 /
- DATA (RTHTAB(2,J,8),J=1,15)/
- $ 0.5603620122213877E+02, 0.2089519045812560E+02,
- $ 0.8057209949692564E-41, 0.0000000000000000E+00,
- $ 0.0000000000000000E+00, 0.0000000000000000E+00,
- $ 0.0000000000000000E+00, 0.0000000000000000E+00,
- $ 0.0000000000000000E+00, 0.0000000000000000E+00,
- $ 0.0000000000000000E+00, 0.0000000000000000E+00,
- $ -0.2089523653108562E+02, -0.2089425365213780E+02,
- $ 0.0000000000000000E+00 /
- DATA (RTHTAB(2,J,9),J=1,15)/
- $ 0.1772245005320762E+03, 0.9186231401879109E-02,
- $ 0.0000000000000000E+00, 0.0000000000000000E+00,
- $ 0.0000000000000000E+00, 0.0000000000000000E+00,
- $ 0.0000000000000000E+00, 0.0000000000000000E+00,
- $ 0.0000000000000000E+00, 0.0000000000000000E+00,
- $ 0.0000000000000000E+00, 0.0000000000000000E+00,
- $ -0.9186434011160556E-02, -0.9182112599787110E-02,
- $ 0.0000000000000000E+00 /
- DATA (RTHTAB(3,J,1),J=1,15)/
- $ 0.1020000023238790E+01, 0.1019960557669725E+01,
- $ 0.1016180346958963E+01, 0.1006180326144896E+01,
- $ 0.9999999799999869E+00, 0.9938196414944061E+00,
- $ 0.9838196654017130E+00, 0.9800394819267058E+00,
- $ 0.9800000167613432E+00, 0.9800394819267058E+00,
- $ 0.9800000206708944E+00, 0.9838196654017130E+00,
- $ 0.1019960557757909E+01, 0.1019960555876641E+01,
- $ 0.9938196201237924E+00 /
- DATA (RTHTAB(3,J,2),J=1,15)/
- $ 0.1200200049478092E+01, 0.1199803818239498E+01,
- $ 0.1161865222624334E+01, 0.1061641622703555E+01,
- $ 0.9997999998092653E+00, 0.9380347702253002E+00,
- $ 0.8382583841773196E+00, 0.8005930271401465E+00,
- $ 0.8001999509012889E+00, 0.8005930271401465E+00,
- $ 0.8001999898405812E+00, 0.8382583841773196E+00,
- $ 0.1199803819124850E+01, 0.1199803800237143E+01,
- $ 0.9380345567830439E+00 /
- DATA (RTHTAB(3,J,3),J=1,15)/
- $ 0.1616239399727414E+01, 0.1614926998210404E+01,
- $ 0.1490404062821349E+01, 0.1172272325649216E+01,
- $ 0.9838000060344289E+00, 0.8015155277404742E+00,
- $ 0.5196080662254426E+00, 0.4172175374536215E+00,
- $ 0.4161606223881795E+00, 0.4172175374536215E+00,
- $ 0.4161607270774055E+00, 0.5196080662254426E+00,
- $ 0.1614927001142599E+01, 0.1614926938588382E+01,
- $ 0.8015149080959542E+00 /
- DATA (RTHTAB(3,J,4),J=1,15)/
- $ 0.2967827289865120E+01, 0.2959626329316872E+01,
- $ 0.2250423809963548E+01, 0.9811642005004704E+00,
- $ 0.5264413137994085E+00, 0.2459671041422877E+00,
- $ 0.3559283254672319E-01, 0.6085963592336598E-02,
- $ 0.5876412720313133E-02, 0.6085963592336598E-02,
- $ 0.5876433389512860E-02, 0.3559283254672319E-01,
- $ 0.2959626347622103E+01, 0.2959625957106102E+01,
- $ 0.2459663739559823E+00 /
- DATA (RTHTAB(3,J,5),J=1,15)/
- $ 0.3752172348801611E+01, 0.3735613206576635E+01,
- $ 0.2410987204577336E+01, 0.6396342910254789E+00,
- $ 0.2364471774944505E+00, 0.7006362464216589E-01,
- $ 0.3169137836898215E-02, 0.1295270506446048E-03,
- $ 0.1183363666578793E-03, 0.1295270506446048E-03,
- $ 0.1183374610993361E-03, 0.3169137836898215E-02,
- $ 0.3735613243507420E+01, 0.3735612455641802E+01,
- $ 0.7006329216660266E-01 /
- DATA (RTHTAB(3,J,6),J=1,15)/
- $ 0.5460544289432789E+01, 0.5409631737942014E+01,
- $ 0.2139992334116663E+01, 0.1288077595898328E+00,
- $ 0.1565268689612706E-01, 0.1190759100908589E-02,
- $ 0.1690675638635522E-05, 0.1075110106882599E-08,
- $ 0.7373572602979535E-09, 0.1075110106882599E-08,
- $ 0.7373886140966071E-09, 0.1690675638635522E-05,
- $ 0.5409631851208299E+01, 0.5409629434833953E+01,
- $ 0.1190747133607116E-02 /
- DATA (RTHTAB(3,J,7),J=1,15)/
- $ 0.1768010396123896E+02, 0.1602641297443747E+02,
- $ 0.9607966459721680E-03, 0.1541989833542450E-15,
- $ 0.3909884698342626E-25, 0.7308356111927279E-37,
- $ 0.1022990193254645E-66, 0.0000000000000000E+00,
- $ 0.0000000000000000E+00, 0.0000000000000000E+00,
- $ 0.0000000000000000E+00, 0.1022990193254645E-66,
- $ 0.1602641649220523E+02, 0.1602634144580780E+02,
- $ 0.7307586150151781E-37 /
- DATA (RTHTAB(3,J,8),J=1,15)/
- $ 0.5603620122213877E+02, 0.2089519045812560E+02,
- $ 0.8057209949692564E-41, 0.0000000000000000E+00,
- $ 0.0000000000000000E+00, 0.0000000000000000E+00,
- $ 0.0000000000000000E+00, 0.0000000000000000E+00,
- $ 0.0000000000000000E+00, 0.0000000000000000E+00,
- $ 0.0000000000000000E+00, 0.0000000000000000E+00,
- $ 0.2089523653108562E+02, 0.2089425365213780E+02,
- $ 0.0000000000000000E+00 /
- DATA (RTHTAB(3,J,9),J=1,15)/
- $ 0.1772245005320762E+03, 0.9186231401879109E-02,
- $ 0.0000000000000000E+00, 0.0000000000000000E+00,
- $ 0.0000000000000000E+00, 0.0000000000000000E+00,
- $ 0.0000000000000000E+00, 0.0000000000000000E+00,
- $ 0.0000000000000000E+00, 0.0000000000000000E+00,
- $ 0.0000000000000000E+00, 0.0000000000000000E+00,
- $ 0.9186434011160556E-02, 0.9182112599787110E-02,
- $ 0.0000000000000000E+00 /
- DATA (RTHTAB(4,J,1),J=1,15)/
- $ 0.9800000167612359E+00, 0.9800394820148885E+00,
- $ 0.9838196654017130E+00, 0.9938196414944061E+00,
- $ 0.9999999799999869E+00, 0.1006180326144896E+01,
- $ 0.1016180346958963E+01, 0.1019960557757909E+01,
- $ 0.1020000023238683E+01, 0.1019960557757909E+01,
- $ 0.1020000019329100E+01, 0.1016180346958963E+01,
- $ 0.9800394819267058E+00, 0.9800394838079585E+00,
- $ 0.1006180347515563E+01 /
- DATA (RTHTAB(4,J,2),J=1,15)/
- $ 0.8001999509002202E+00, 0.8005930280184570E+00,
- $ 0.8382583841773196E+00, 0.9380347702253002E+00,
- $ 0.9997999998092653E+00, 0.1061641622703555E+01,
- $ 0.1161865222624334E+01, 0.1199803819124850E+01,
- $ 0.1200200049477015E+01, 0.1199803819124850E+01,
- $ 0.1200200010224957E+01, 0.1161865222624334E+01,
- $ 0.8005930271401465E+00, 0.8005930458776495E+00,
- $ 0.1061641836674124E+01 /
- DATA (RTHTAB(4,J,3),J=1,15)/
- $ 0.4161606223853062E+00, 0.4172175398155172E+00,
- $ 0.5196080662254426E+00, 0.8015155277404742E+00,
- $ 0.9838000060344289E+00, 0.1172272325649216E+01,
- $ 0.1490404062821349E+01, 0.1614927001142599E+01,
- $ 0.1616239399723845E+01, 0.1614927001142599E+01,
- $ 0.1616239269700575E+01, 0.1490404062821349E+01,
- $ 0.4172175374536215E+00, 0.4172175878413029E+00,
- $ 0.1172272988086959E+01 /
- DATA (RTHTAB(4,J,4),J=1,15)/
- $ 0.5876412719745853E-02, 0.6085964062590301E-02,
- $ 0.3559283254672319E-01, 0.2459671041422877E+00,
- $ 0.5264413137994085E+00, 0.9811642005004704E+00,
- $ 0.2250423809963548E+01, 0.2959626347622103E+01,
- $ 0.2967827289842799E+01, 0.2959626347622103E+01,
- $ 0.2967826476573198E+01, 0.2250423809963548E+01,
- $ 0.6085963592336598E-02, 0.6085973624531383E-02,
- $ 0.9811661424155891E+00 /
- DATA (RTHTAB(4,J,5),J=1,15)/
- $ 0.1183363666278417E-03, 0.1295270759699969E-03,
- $ 0.3169137836898215E-02, 0.7006362464216589E-01,
- $ 0.2364471774944505E+00, 0.6396342910254789E+00,
- $ 0.2410987204577336E+01, 0.3735613243507420E+01,
- $ 0.3752172348756504E+01, 0.3735613243507420E+01,
- $ 0.3752170705266869E+01, 0.2410987204577336E+01,
- $ 0.1295270506446048E-03, 0.1295275909260801E-03,
- $ 0.6396363145524121E+00 /
- DATA (RTHTAB(4,J,6),J=1,15)/
- $ 0.7373572594374325E-09, 0.1075110910198101E-08,
- $ 0.1690675638635522E-05, 0.1190759100908589E-02,
- $ 0.1565268689612706E-01, 0.1288077595898328E+00,
- $ 0.2139992334116663E+01, 0.5409631851208299E+01,
- $ 0.5460544289293762E+01, 0.5409631851208299E+01,
- $ 0.5460539223746948E+01, 0.2139992334116663E+01,
- $ 0.1075110106882599E-08, 0.1075127244522668E-08,
- $ 0.1288086226207619E+00 /
- DATA (RTHTAB(4,J,7),J=1,15)/
- $ 0.0000000000000000E+00, 0.0000000000000000E+00,
- $ 0.1022990193254645E-66, 0.7308356111927279E-37,
- $ 0.3909884698342626E-25, 0.1541989833542450E-15,
- $ 0.9607966459721680E-03, 0.1602641649220523E+02,
- $ 0.1768010395651999E+02, 0.1602641649220523E+02,
- $ 0.1767993201880870E+02, 0.9607966459721680E-03,
- $ 0.0000000000000000E+00, 0.0000000000000000E+00,
- $ 0.1542098145768002E-15 /
- DATA (RTHTAB(4,J,8),J=1,15)/
- $ 0.0000000000000000E+00, 0.0000000000000000E+00,
- $ 0.0000000000000000E+00, 0.0000000000000000E+00,
- $ 0.0000000000000000E+00, 0.0000000000000000E+00,
- $ 0.8057209949692564E-41, 0.2089523653108562E+02,
- $ 0.5603620107189387E+02, 0.2089523653108562E+02,
- $ 0.5603072707652527E+02, 0.8057209949692564E-41,
- $ 0.0000000000000000E+00, 0.0000000000000000E+00,
- $ 0.0000000000000000E+00 /
- DATA (RTHTAB(4,J,9),J=1,15)/
- $ 0.0000000000000000E+00, 0.0000000000000000E+00,
- $ 0.0000000000000000E+00, 0.0000000000000000E+00,
- $ 0.0000000000000000E+00, 0.0000000000000000E+00,
- $ 0.0000000000000000E+00, 0.9186434011160556E-02,
- $ 0.1772244957790231E+03, 0.9186434011160556E-02,
- $ 0.1770514000339975E+03, 0.0000000000000000E+00,
- $ 0.0000000000000000E+00, 0.0000000000000000E+00,
- $ 0.0000000000000000E+00 /
- END
-
-#endif
diff --git a/src/mathlib/gen/tests/d101m.F b/src/mathlib/gen/tests/d101m.F
deleted file mode 100644
index 99560c6..0000000
--- a/src/mathlib/gen/tests/d101m.F
+++ /dev/null
@@ -1,101 +0,0 @@
-*
-* $Id: d101m.F,v 1.1.1.1 1996/04/01 15:01:22 mclareni Exp $
-*
-* $Log: d101m.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:22 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE D101M
-#include "iorc.inc"
-C Program to test the GENLIB routines SIMPS and DSIMPS (D101) by
-C using the routines to numerically integrate known integrals
-C Written by T Hepworth, 8th May 1990
-C B. Damgaard : introduce new sequences and test error msg (10/92)
-C Set maximum number of steps and number of tests
- PARAMETER ( NMAX=100,NT=4 )
-#include "gen/def64.inc"
- + F(0:NMAX),A,B,X,DSIMPS,TSTERR,
- + START(NT),FINISH(NT),H(NT),
- + RESULT(NT),SOL(NT),ERROR(NT),ERRMAX,
- + DF(0:10),Z1,Z2
- INTEGER N(NT)
-C Set the maximum percentage relative error allowed for the test
-C to still be considered successful
- PARAMETER ( TSTERR=1D-3 )
- PARAMETER (Z1 = 1, Z2 = 2)
-C The test data
- DATA START(1),FINISH(1),N(1) / 0D0, 3D0, 50 /
- DATA START(2),FINISH(2),N(2) / -6D0, 6D0, 100 /
- DATA START(3),FINISH(3),N(3) / -1D0, 1D0, 20 /
- DATA START(4),FINISH(4),N(4) / 8D0, 28D0, 100 /
-
- CALL HEADER('D101',0)
- DO 200 I=1,NT
- WRITE(LOUT,'(/'' Test Number'',I3)') I
-C Calculate step length H for test number I
- H(I)= ( FINISH(I)-START(I) )/ N(I)
- WRITE(LOUT,'('' Integration Interval ('',F4.1,'','',F4.1,'')'',
- + 3X,''Step length'',F5.2,3X,''Number of steps'',I4)')
- + START(I),FINISH(I),H(I),N(I)
-C Initialise the function to be integrated (at discrete points)
- DO 100 J=0,N(I)
-C Calculate Xj
- X= START(I)+( J*H(I) )
- IF (I .EQ. 1) THEN
- F(J)= EXP(2D0*X)
- ELSEIF (I .EQ. 2) THEN
- F(J)= EXP(-X)
- ELSEIF (I .EQ. 3) THEN
- F(J)= COS(X)
- ELSE
- F(J)= X*SIN(X)
- ENDIF
-100 CONTINUE
-
-C Compute the numerical approximation to the integral
- A= START(I)
- B= FINISH(I)
-#if defined(CERNLIB_DOUBLE)
- RESULT(I)= DSIMPS(F,A,B,N(I))
-#endif
-#if !defined(CERNLIB_DOUBLE)
- RESULT(I)= SIMPS(F,A,B,N(I))
-#endif
-C Compute the analytical value of the integral
- IF (I .EQ. 1) THEN
- SOL(I)= ( EXP(2D0*B)-EXP(2D0*A) )/ 2D0
- ELSEIF (I .EQ. 2) THEN
- SOL(I)= ( EXP(-A)-EXP(-B) )
- ELSEIF (I .EQ. 3) THEN
- SOL(I)= SIN(B)-SIN(A)
- ELSE
- SOL(I)= (A*COS(A))-(B*COS(B))+SIN(B)-SIN(A)
- ENDIF
-
-C Compute Relative error as a positive percentage
- ERROR(I)= ABS( (RESULT(I)-SOL(I))/RESULT(I) )*1D2
- WRITE(LOUT,'('' Numerical approximation'',F25.16)') RESULT(I)
- WRITE(LOUT,'('' Analytical value '',F25.16)') SOL(I)
- WRITE(LOUT,'('' Relative Error '',F23.14,''%'')')
- + ERROR(I)
-200 CONTINUE
-C Compute maximum (percentage) relative error
- ERRMAX= MAX( ERROR(1),ERROR(2),ERROR(3),ERROR(4) )
- WRITE(LOUT,'(/'' Largest Relative Error was'',F23.14,''%'')')
- + ERRMAX
- WRITE(LOUT,'(/''TESTING ERROR MESSAGES:''/)')
-#if defined(CERNLIB_DOUBLE)
- R=DSIMPS(DF,-Z1,Z2,1)
- R=DSIMPS(DF,-Z1,Z2,-3)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- R= SIMPS(DF,-Z1,Z2,1)
- R= SIMPS(DF,-Z1,Z2,-3)
-#endif
-C Check if the test was successful
- IRC=ITEST('D101',ERRMAX .LE. TSTERR)
- CALL PAGEND('D101')
- RETURN
- END
diff --git a/src/mathlib/gen/tests/d103m.F b/src/mathlib/gen/tests/d103m.F
deleted file mode 100644
index f5e7a0b..0000000
--- a/src/mathlib/gen/tests/d103m.F
+++ /dev/null
@@ -1,284 +0,0 @@
-*
-* $Id: d103m.F,v 1.2 1996/11/25 16:17:20 cernlib Exp $
-*
-* $Log: d103m.F,v $
-* Revision 1.2 1996/11/25 16:17:20 cernlib
-* Protect the loop finding eps such that 1+eps!=1 against optimisation.
-* Introduce a SUBROUTINE to do some of the work.
-*
-* Revision 1.1.1.1 1996/04/01 15:01:22 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE D103M
-C This program tests the operation of MATHLIB subprograms
-C GAUSS, DGAUSS, and QGAUSS (D103)
-
- LOGICAL LTEST, LTEST1,LTEST2
- COMMON /D103LT1/LTEST1
-#if (defined(CERNLIB_QUAD))&&(!defined(CERNLIB_IBMRS))
- COMMON /D103LT2/LTEST2
-#endif
-#include "iorc.inc"
- CALL HEADER('D103',0)
- LTEST=.TRUE.
- CALL D103D
- LTEST=LTEST .AND. LTEST1
-#if (defined(CERNLIB_QUAD))&&(!defined(CERNLIB_IBMRS))
- CALL D103Q
- LTEST=LTEST .AND. LTEST2
-#endif
- IRC=ITEST('D103',LTEST)
- CALL PAGEND('D103')
- RETURN
- END
-
-C DERIVED FROM KERNLIB TEST ESSENTIALLY FROM G.A. ERSKINE
-
- SUBROUTINE D103D
-
-#include "gen/imp64.inc"
- REAL GAUSS,A1,B1,EPS1,D103F1,P1,Q1,EXACT1,APPRX1,ERR1,RNF,G1,G1S
- REAL RELPRT
- LOGICAL OKFN1,OKFN2,OKPK
- LOGICAL LTEST1
- EXTERNAL D103F1,D103F2
-
- COMMON /D103C1/ A1,B1,P1,Q1,RNF
- COMMON /D103C2/ A,B,P,Q,DNF
- COMMON /D103LT1/LTEST1
-#include "iorc.inc"
-
- DIMENSION MRATIO(2),ERR1(10),ERR2(10),RELPRT(2)
- DIMENSION OKFN1(10),OKFN2(10)
-
-C Specify the largest relative error permitted in a successful test
- PARAMETER ( TSTERR= 1D-14 )
- PARAMETER (R0 = 0, R1 = 1, R2 = 2, HF = R1/2)
-
- DATA MRATIO /20,200/
-
- LTEST1=.TRUE.
- G1=1
- 10 CALL REPSIL(G1,G1S)
- IF(G1S .NE. 1) GO TO 10
- RELPRT(1)=2*G1
- EPS1=MRATIO(1)*RELPRT(1)
-
-#if defined(CERNLIB_DOUBLE)
- G2=1
- 11 CALL DEPSIL(G2,G2S)
- IF(G2S .NE. 1) GO TO 11
- RELPRT(2)=2*G2
- EPS2=MRATIO(2)*RELPRT(2)
-#endif
-C WRITE(LOUT,'(1X,2D12.4/)') RELPRT(1),RELPRT(2)
-
- PI = 3.14159 26535 89793D0
- WRITE(LOUT,'(1X)')
-C
-#if defined(CERNLIB_DOUBLE)
- WRITE(LOUT,'(4X,''NFN'',12X,''EXACT'',19X,''DGAUSS'',15X,
- + ''GAUSS'')')
-#endif
-#if !defined(CERNLIB_DOUBLE)
- WRITE(LOUT,'(4X,''NFN'',12X,''EXACT'',19X,''GAUSS'')')
-#endif
-C 1. SHARP PEAK
-
- DNF=1
- RNF=1
- NFN=1
- A=HF
- B=R1/10
- P=100
- Q=R2/10
- EXACT=-SQRT(PI)
- A1=A
- B1=B
- P1=P
- Q1=Q
- EXACT1=EXACT
- APPRX1=GAUSS(D103F1,A1,B1,EPS1)
- ERR1(NFN)=ABS(APPRX1-EXACT1)
- OKFN1(NFN)=ERR1(NFN) .LT. EPS1
-#if defined(CERNLIB_DOUBLE)
- APPRX2=DGAUSS(D103F2,A,B,EPS2)
- ERR2(NFN)=ABS(APPRX2-EXACT)
- OKFN2(NFN)=ERR2(NFN) .LT. EPS2
- WRITE(LOUT,'(1X,I5,2F25.15,F15.6/)') NFN,EXACT,APPRX2,APPRX1
-#endif
-#if !defined(CERNLIB_DOUBLE)
- WRITE(LOUT,'(1X,I5,2F25.15/)') NFN,EXACT,APPRX1
-#endif
-C
-C 2. NON-POLYNOMIAL END-POINTS.
-
- DNF=2
- RNF=2
- NFN=2
- A=HF
- B=-3*HF
- P=1
- EXACT=SIGN(R1/8,B-A)*P*PI*(B-A)**2
- A1=A
- B1=B
- P1=P
- EXACT1=EXACT
- APPRX1=GAUSS(D103F1,A1,B1,EPS1)
- ERR1(NFN)=ABS(APPRX1-EXACT1)
- OKFN1(NFN)=ERR1(NFN) .LT. EPS1
-#if defined(CERNLIB_DOUBLE)
- APPRX2=DGAUSS(D103F2,A,B,EPS2)
- ERR2(NFN)=ABS(APPRX2-EXACT)
- OKFN2(NFN)=ERR2(NFN) .LT. EPS2
- WRITE(LOUT,'(1X,I5,2F25.15,F15.6/)') NFN,EXACT,APPRX2,APPRX1
-#endif
-#if !defined(CERNLIB_DOUBLE)
- WRITE(LOUT,'(1X,I5,2F25.15/)') NFN,EXACT,APPRX1
-#endif
-C
-C 3. OSCILLATORY FUNCTION (ABSOLUTE ERROR CRITERION).
-
- DNF=3
- RNF=3
- NFN=3
- A=0
- B=3*PI/2
- P=1
- Q=10
- EXACT=0
- A1=A
- B1=B
- P1=P
- Q1=Q
- EXACT1=EXACT
- APPRX1=GAUSS(D103F1,A1,B1,EPS1)
- ERR1(NFN)=ABS(APPRX1-EXACT1)
- OKFN1(NFN)=ERR1(NFN) .LT. EPS1
-#if defined(CERNLIB_DOUBLE)
- APPRX2=DGAUSS(D103F2,A,B,EPS2)
- ERR2(NFN)=ABS(APPRX2-EXACT)
- OKFN2(NFN)=ERR2(NFN) .LT. EPS2
- WRITE(LOUT,'(1X,I5,2F25.15,F15.6/)') NFN,EXACT,APPRX2,APPRX1
-#endif
-#if !defined(CERNLIB_DOUBLE)
- WRITE(LOUT,'(1X,I5,2F25.15/)') NFN,EXACT,APPRX1
-#endif
-C
-C 4. OSCILLATORY FUNCTION (RELATIVE ERROR CRITERION).
-
- DNF=4
- RNF=4
- NFN=4
- A=0
- B=-3*PI/2
- P=1D20
- Q=12
- EXACT=P*(B-A)
- A1=A
- B1=B
- P1=P
- Q1=Q
- EXACT1=EXACT
- APPRX1=GAUSS(D103F1,A1,B1,EPS1)
- ERR1(NFN)=ABS((APPRX1-EXACT1)/EXACT1)
- OKFN1(NFN)=ERR1(NFN) .LT. EPS1
-#if defined(CERNLIB_DOUBLE)
- APPRX2=DGAUSS(D103F2,A,B,EPS2)
- ERR2(NFN)=ABS((APPRX2-EXACT)/EXACT)
- OKFN2(NFN)=ERR2(NFN) .LT. EPS2
- WRITE(LOUT,'(1X,I5,2E25.15,E15.6/)') NFN,EXACT,APPRX2,APPRX1
-#endif
-#if !defined(CERNLIB_DOUBLE)
- WRITE(LOUT,'(1X,I5,2E25.15/)') NFN,EXACT,APPRX1
-#endif
-
- OKPK=.TRUE.
- DO 1 I=1,NFN
-#if !defined(CERNLIB_DOUBLE)
- 1 OKPK=OKPK .AND. OKFN1(I)
-#endif
-#if defined(CERNLIB_DOUBLE)
- 1 OKPK=OKPK .AND. OKFN1(I) .AND. OKFN2(I)
-#endif
- IF(.NOT.OKPK) THEN
- WRITE(LOUT,2000)
- DO 2 I=1,NFN
- IF(.NOT.OKFN1(I)) WRITE(LOUT,2001) I,ERR1(I),EPS1
-#if defined(CERNLIB_DOUBLE)
- IF(.NOT.OKFN2(I)) WRITE(LOUT,2002) I,ERR2(I),EPS2
-#endif
- 2 CONTINUE
- ENDIF
- WRITE(LOUT,'(/''TESTING ERROR MESSAGES:''/)')
- DNF=5
- RNF=5
- NFN=5
- A=1
- B=0
- A1=1
- B1=0
- APPRX1=GAUSS(D103F1,A1,B1,EPS1)
-#if defined(CERNLIB_DOUBLE)
- APPRX2=DGAUSS(D103F2,A,B,EPS2)
-#endif
- LTEST1=LTEST1 .AND. OKPK
- RETURN
-C
- 2000 FORMAT( // ' ***** D103CH ... TEST FAILURE.' )
- 2001 FORMAT( 4X, 'NFN =', I2, 4X, 'ERR1 =', 1PE9.1, 4X, 'EPS1 =', E9.1)
- 2002 FORMAT( 4X, 'NFN =', I2, 4X, 'ERR2 =', 1PD9.1, 4X, 'EPS2 =', D9.1)
- END
- FUNCTION D103F2(X)
-
-#include "gen/imp64.inc"
- COMMON /D103C2/ A,B,P,Q,DNF
-
-* exp(-80) is about all a VAX F and D float can handle
-#if defined(CERNLIB_VAX)
- PARAMETER (C = 80)
-#endif
-#if !defined(CERNLIB_VAX)
- PARAMETER (C = 100)
-#endif
-
- IF(DNF .EQ. 1) D103F2=P*EXP(MAX(-(P*(X-Q))**2,-C))
- IF(DNF .EQ. 2) D103F2=P*SQRT((B-A)**2-(2*X-B-A)**2)/2
- IF(DNF .EQ. 3) D103F2=P*(SIN(X)**2)*COS(Q*X)
- IF(DNF .EQ. 4) D103F2=P*(SIN(X)**2)*COS(Q*X)+P
- IF(DNF .EQ. 5) D103F2=1/X**2
- RETURN
- END
- FUNCTION D103F1(X)
-
- COMMON /D103C1/ A1,B1,P1,Q1,RNF
-
-#if defined(CERNLIB_QIEEE)||defined(CERNLIB_VAX)
- PARAMETER (C = 80)
-#endif
-#if (!defined(CERNLIB_QIEEE))&&(!defined(CERNLIB_VAX))
- PARAMETER (C = 100)
-#endif
-
- IF(RNF .EQ. 1) D103F1=P1*EXP(MAX(-(P1*(X-Q1))**2,-C))
- IF(RNF .EQ. 2) D103F1=P1*SQRT((B1-A1)**2-(2*X-B1-A1)**2)/2
- IF(RNF .EQ. 3) D103F1=P1*(SIN(X)**2)*COS(Q1*X)
- IF(RNF .EQ. 4) D103F1=P1*(SIN(X)**2)*COS(Q1*X)+P1
- IF(RNF .EQ. 5) D103F1=1/X**2
- RETURN
- END
-C
- SUBROUTINE REPSIL(X,Y)
- X=X/2.
- Y= 1. + X
- RETURN
- END
- SUBROUTINE DEPSIL(X,Y)
- DOUBLE PRECISION X,Y
- X=X/2.
- Y= 1. + X
- RETURN
- END
-
diff --git a/src/mathlib/gen/tests/d103q.F b/src/mathlib/gen/tests/d103q.F
deleted file mode 100644
index af18b04..0000000
--- a/src/mathlib/gen/tests/d103q.F
+++ /dev/null
@@ -1,187 +0,0 @@
-*
-* $Id: d103q.F,v 1.2 1996/11/25 16:17:24 cernlib Exp $
-*
-* $Log: d103q.F,v $
-* Revision 1.2 1996/11/25 16:17:24 cernlib
-* Protect the loop finding eps such that 1+eps!=1 against optimisation.
-* Introduce a SUBROUTINE to do some of the work.
-*
-* Revision 1.1.1.1 1996/04/01 15:01:22 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if (defined(CERNLIB_QUAD))&&(!defined(CERNLIB_IBMRS))
- SUBROUTINE D103Q
-C
-#include "gen/imp128.inc"
- LOGICAL OKFN,OKPK
- LOGICAL LTEST2
- EXTERNAL D103F4
- COMMON /D103C4/ A,B,P,Q,DNF
- COMMON /D103LT2/LTEST2
-#include "iorc.inc"
- DIMENSION OKFN (10)
- DIMENSION ERR (10)
-
- PARAMETER (R0 = 0, R1 = 1, R2 = 2, HF = R1/2)
-
- DATA MRATIO /200/
-
- LTEST2=.TRUE.
-
- G2=1
- 11 CALL QEPSIL(G2,G2S)
- IF(G2S .NE. 1) GO TO 11
- RELPRT=2*G2
-C WRITE(LOUT,'(1X,2D12.4/)') RELPRT
-
- EPS =MRATIO*RELPRT
-#if defined(CERNLIB_DOUBLE)
- PI = 3.14159 26535 89793 23846 26433 83279 50Q0
- WRITE(LOUT,'(4X,''NFN'',22X,''EXACT'',29X,''QGAUSS'')')
-#endif
-#if !defined(CERNLIB_DOUBLE)
- PI = 3.14159 26535 89793 23846 26433 83279 50D0
- WRITE(LOUT,'(4X,''NFN'',22X,''EXACT'',29X,''DGAUSS'')')
-#endif
-C 1. SHARP PEAK
-
- DNF=1
- NFN=1
- A=HF
- B=R1/10
- P=100
- Q=R2/10
- EXACT=-SQRT(PI)
-#if !defined(CERNLIB_DOUBLE)
- APPRX =DGAUSS(D103F4,A,B,EPS)
-#endif
-#if defined(CERNLIB_DOUBLE)
- APPRX =QGAUSS(D103F4,A,B,EPS)
-#endif
- ERR (NFN)=ABS(APPRX -EXACT)
- OKFN (NFN)=ERR (NFN) .LT. EPS
- WRITE(LOUT,'(I5,2F40.32/)') NFN,EXACT,APPRX
-C
-#if !defined(CERNLIB_QIEEE)
-C 2. NON-POLYNOMIAL END-POINTS.
-
- DNF=2
- RNF=2
- NFN=2
- A=HF
- B=-3*HF
- P=1
- EXACT=SIGN(R1/8,B-A)*P*PI*(B-A)**2
-#endif
-#if !defined(CERNLIB_DOUBLE)
- APPRX =DGAUSS(D103F4,A,B,EPS)
-#endif
-#if (defined(CERNLIB_DOUBLE))&&(!defined(CERNLIB_QIEEE))
- APPRX =QGAUSS(D103F4,A,B,EPS)
-#endif
-#if !defined(CERNLIB_QIEEE)
- ERR (NFN)=ABS(APPRX -EXACT)
- OKFN (NFN)=ERR (NFN) .LT. EPS
- WRITE(LOUT,'(I5,2F40.32/)') NFN,EXACT,APPRX
-C
-C 3. OSCILLATORY FUNCTION (ABSOLUTE ERROR CRITERION).
-
- DNF=3
- RNF=3
- NFN=3
- A=0
- B=3*PI/2
- P=1
- Q=10
- EXACT=0
-#endif
-#if !defined(CERNLIB_DOUBLE)
- APPRX =DGAUSS(D103F4,A,B,EPS)
-#endif
-#if (defined(CERNLIB_DOUBLE))&&(!defined(CERNLIB_QIEEE))
- APPRX =QGAUSS(D103F4,A,B,EPS)
-#endif
-#if !defined(CERNLIB_QIEEE)
- ERR (NFN)=ABS(APPRX -EXACT)
- OKFN (NFN)=ERR (NFN) .LT. EPS
- WRITE(LOUT,'(I5,2F40.32/)') NFN,EXACT,APPRX
-C
-C 4. OSCILLATORY FUNCTION (RELATIVE ERROR CRITERION).
-
- DNF=4
- RNF=4
- NFN=4
- A=0
- B=-3*PI/2
- P=1D20
- Q=12
- EXACT=P*(B-A)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- APPRX =DGAUSS(D103F4,A,B,EPS)
-#endif
-#if (defined(CERNLIB_DOUBLE))&&(!defined(CERNLIB_QIEEE))
- APPRX =QGAUSS(D103F4,A,B,EPS)
-#endif
-#if !defined(CERNLIB_QIEEE)
- ERR (NFN)=ABS((APPRX -EXACT)/EXACT)
- OKFN (NFN)=ERR (NFN) .LT. EPS
- WRITE(LOUT,'(I5,2E40.32/)') NFN,EXACT,APPRX
-#endif
- OKPK=.TRUE.
- DO 1 I=1,NFN
- 1 OKPK=OKPK .AND. OKFN (I)
- IF(.NOT.OKPK) THEN
- WRITE(LOUT,2000)
- DO 2 I=1,NFN
- IF(.NOT.OKFN (I)) WRITE(LOUT,2001) I,ERR (I),EPS
- 2 CONTINUE
- ENDIF
- WRITE(LOUT,'(/''TESTING ERROR MESSAGES:''/)')
- DNF=5
- NFN=5
- A=1
- B=0
-#if !defined(CERNLIB_DOUBLE)
- APPRX =DGAUSS(D103F4,A,B,EPS)
-#endif
-#if defined(CERNLIB_DOUBLE)
- APPRX =QGAUSS(D103F4,A,B,EPS)
-#endif
- WRITE(LOUT,'(1X)')
- LTEST2=LTEST2 .AND. OKPK
- RETURN
-C
- 2000 FORMAT( // ' ***** D103CH ... TEST FAILURE.' )
- 2001 FORMAT( 4X, 'NFN =', I2, 4X, 'ERR =', 1PE9.1, 4X, 'EPS =', E9.1)
- END
- FUNCTION D103F4(X)
-
-#include "gen/imp128.inc"
- COMMON /D103C4/ A,B,P,Q,DNF
-
-#if defined(CERNLIB_VAX)
- PARAMETER (C = 80)
-#endif
-#if !defined(CERNLIB_VAX)
- PARAMETER (C = 100)
-#endif
-
-
- IF(DNF .EQ. 1) D103F4=P*EXP(MAX(-(P*(X-Q))**2,-C))
- IF(DNF .EQ. 2) D103F4=P*SQRT((B-A)**2-(2*X-B-A)**2)/2
- IF(DNF .EQ. 3) D103F4=P*(SIN(X)**2)*COS(Q*X)
- IF(DNF .EQ. 4) D103F4=P*(SIN(X)**2)*COS(Q*X)+P
- IF(DNF .EQ. 5) D103F4=1/X**2
- RETURN
- END
-#endif
- SUBROUTINE QEPSIL(X,Y)
-#include "gen/imp128.inc"
- X=X/2.
- Y= 1. + X
- RETURN
- END
-
diff --git a/src/mathlib/gen/tests/d104m.F b/src/mathlib/gen/tests/d104m.F
deleted file mode 100644
index 0d985ed..0000000
--- a/src/mathlib/gen/tests/d104m.F
+++ /dev/null
@@ -1,77 +0,0 @@
-*
-* $Id: d104m.F,v 1.1.1.1 1996/04/01 15:01:22 mclareni Exp $
-*
-* $Log: d104m.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:22 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE D104M
-#include "gen/imp64.inc"
- PARAMETER ( TSTERR=1D-11)
- PARAMETER (A0 = 0, A1 = 1)
- EXTERNAL FD104
-#include "iorc.inc"
-
- CALL HEADER('D104',0)
-
- WRITE(LOUT,'(/8X,''A'',9X,''B'',9X,''S'',15X,''D104'',25X,
- +''TEST'',7X,''Error'')')
- ERRMAX=0
- EPS=1D-12
- S=1D0
- WRITE(LOUT,'(1X)')
- DO 1 I = 0,30
- A=0
- B=0.1D0*I
- IF(A .EQ. 0 .AND. B .EQ. 1) GOTO 1
-#if defined(CERNLIB_DOUBLE)
- R=DCAUCH(FD104,A,B,S,EPS)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- R=CAUCHY(FD104,A,B,S,EPS)
-#endif
- T=0
- IF(A .NE. S .AND. B .NE. S) T=B-A+LOG(ABS((B-1)/(A-1)))
- ERRMAX= MAX( ERRMAX,ABS(R-T))
- WRITE(LOUT,'(3F10.1,2F25.15,1P,D10.1)') A,B,S,R,T,ABS(R-T)
- 1 CONTINUE
-
- WRITE(LOUT,'(1X)')
- DO 2 I = 0,30
- A=0.1D0*I
- B=0.0D0
- IF(A .EQ. 1 .AND. B .EQ. 0) GOTO 2
-#if defined(CERNLIB_DOUBLE)
- R=DCAUCH(FD104,A,B,S,EPS)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- R=CAUCHY(FD104,A,B,S,EPS)
-#endif
- T=0.0D0
- IF(A .NE. S .AND. B .NE. S) T=B-A+LOG(ABS((B-1)/(A-1)))
- ERRMAX= MAX( ERRMAX,ABS(R-T))
- WRITE(LOUT,'(3F10.1,2F25.15,1P,D10.1)') A,B,S,R,T,ABS(R-T)
- 2 CONTINUE
- WRITE(LOUT,'(/'' Largest Error:'',1P,D10.1)') ERRMAX
- WRITE(LOUT,'(/7X,''TESTING ERROR MESSAGES:''/)')
-#if defined(CERNLIB_DOUBLE)
- R=DCAUCH(FD104,A0,A1,S,EPS)
- R=DCAUCH(FD104,A1,A0,S,EPS)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- R=CAUCHY(FD104,A0,A1,S,EPS)
- R=CAUCHY(FD104,A1,A0,S,EPS)
-#endif
- WRITE(LOUT,'(1X)')
-C Check if the test was successful
- IRC=ITEST('D104',ERRMAX .LE. TSTERR)
- CALL PAGEND('D104')
- RETURN
- END
- FUNCTION FD104(X)
-#include "gen/imp64.inc"
- FD104=X/(X-1)
- RETURN
- END
diff --git a/src/mathlib/gen/tests/d105m.F b/src/mathlib/gen/tests/d105m.F
deleted file mode 100644
index 297b416..0000000
--- a/src/mathlib/gen/tests/d105m.F
+++ /dev/null
@@ -1,87 +0,0 @@
-*
-* $Id: d105m.F,v 1.1.1.1 1996/04/01 15:01:22 mclareni Exp $
-*
-* $Log: d105m.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:22 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE D105M
-#include "iorc.inc"
-C Test program for the GENLIB routines TRIINT,DTRINT (D105)
-C The program compares numerical solution with analytical solutions
-C for simple-to-evaluate integrals. T Hepworth 11.5.90
-C Set the number of tests
- PARAMETER ( NT=3 )
-#include "gen/def64.inc"
- + X(NT,3),Y(NT,3),EPS,DTRINT,
- + EXACT(NT),SOL,ERROR,ERRMAX,TSTERR,
- + X1,X2,X3,Y1,Y2,Y3,
- + D105S1,D105S2,D105S3
- INTEGER NPT(3)
-C Set the largest absolute error allowed for a successful test
- PARAMETER ( TSTERR=1D-11 )
- EXTERNAL D105S1,D105S2,D105S3
- DATA NPT / 7,25,64 /
- DATA (X(1,J),Y(1,J),J=1,3) /0D0,0D0, 6D0,0D0, 3D0,4D0 /
- DATA EXACT(1) /158D0/
- DATA (X(2,J),Y(2,J),J=1,3) /-6D0,2D0, 6D0,7D0, 2D0,10D0/
- DATA EXACT(2) /28D0/
- DATA (X(3,J),Y(3,J),J=1,3) /-1D0,2D0, 0D0,1D0, 2D0,3D0/
-
- EXACT(3)= 1.6666666666666667D0
- CALL HEADER('D105',0)
- EPS=1D-6
-C Initialise largest error
- ERRMAX=0D0
- DO 100 I=1,NT
- X1=X(I,1)
- Y1=Y(I,1)
- X2=X(I,2)
- Y2=Y(I,2)
- X3=X(I,3)
- Y3=Y(I,3)
- WRITE(LOUT,'(/'' Test Number'',I3)') I
-C Perform test for NPT is 7,25,64
- DO 50 J=1,3
-C Perform test for NSD is 0 and 1
- DO 40 NSD=0,1
- IF (I .EQ. 1) THEN
-#if defined(CERNLIB_DOUBLE)
- SOL=DTRINT(D105S1,NSD,NPT(J),EPS,X1,Y1,X2,Y2,X3,Y3)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- SOL=TRIINT(D105S1,NSD,NPT(J),EPS,X1,Y1,X2,Y2,X3,Y3)
-#endif
- ELSEIF (I .EQ. 2) THEN
-#if defined(CERNLIB_DOUBLE)
- SOL=DTRINT(D105S2,NSD,NPT(J),EPS,X1,Y1,X2,Y2,X3,Y3)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- SOL=TRIINT(D105S2,NSD,NPT(J),EPS,X1,Y1,X2,Y2,X3,Y3)
-#endif
- ELSE
-#if defined(CERNLIB_DOUBLE)
- SOL=DTRINT(D105S3,NSD,NPT(J),EPS,X1,Y1,X2,Y2,X3,Y3)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- SOL=TRIINT(D105S3,NSD,NPT(J),EPS,X1,Y1,X2,Y2,X3,Y3)
-#endif
- ENDIF
- ERROR= ABS( EXACT(I)-SOL )
- WRITE(LOUT,'('' NPT='',I3,6X,''NSD='',I3)') NPT(J),NSD
- WRITE(LOUT,'('' Calculated '',F25.16)') SOL
- WRITE(LOUT,'('' Exact '',F25.16)') EXACT(I)
- WRITE(LOUT,'('' Absolute Error'',F25.16)') ERROR
- ERRMAX=MAX( ERRMAX,ERROR )
- 40 CONTINUE
- 50 CONTINUE
-100 CONTINUE
- WRITE(LOUT,'('' Largest Absolute Error was'',1P,D10.1)') ERRMAX
-C Check if the test ws successful
- IRC=ITEST('D105',ERRMAX .LE. TSTERR)
- CALL PAGEND('D105')
- RETURN
- END
-C
diff --git a/src/mathlib/gen/tests/d105s1.F b/src/mathlib/gen/tests/d105s1.F
deleted file mode 100644
index dc7ea89..0000000
--- a/src/mathlib/gen/tests/d105s1.F
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: d105s1.F,v 1.1.1.1 1996/04/01 15:01:22 mclareni Exp $
-*
-* $Log: d105s1.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:22 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-C First function to integrate (result=158)
- FUNCTION D105S1(X,Y)
-#include "gen/def64.inc"
- + D105S1,X,Y
- D105S1=(X*X)+(Y*Y)
- RETURN
- END
-C
diff --git a/src/mathlib/gen/tests/d105s2.F b/src/mathlib/gen/tests/d105s2.F
deleted file mode 100644
index 1c121b5..0000000
--- a/src/mathlib/gen/tests/d105s2.F
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: d105s2.F,v 1.1.1.1 1996/04/01 15:01:22 mclareni Exp $
-*
-* $Log: d105s2.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:22 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-C Second function D105S2=1, therefore result= area of triangle
- FUNCTION D105S2(X,Y)
-#include "gen/def64.inc"
- + D105S2,X,Y
- D105S2=1D0
- RETURN
- END
-C
diff --git a/src/mathlib/gen/tests/d105s3.F b/src/mathlib/gen/tests/d105s3.F
deleted file mode 100644
index 269d598..0000000
--- a/src/mathlib/gen/tests/d105s3.F
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: d105s3.F,v 1.1.1.1 1996/04/01 15:01:22 mclareni Exp $
-*
-* $Log: d105s3.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:22 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-C Third function to integrate (RESULT=5/3)
- FUNCTION D105S3(X,Y)
-#include "gen/def64.inc"
- + D105S3,X,Y
- D105S3=X*Y
- RETURN
- END
diff --git a/src/mathlib/gen/tests/d107m.F b/src/mathlib/gen/tests/d107m.F
deleted file mode 100644
index 134ec20..0000000
--- a/src/mathlib/gen/tests/d107m.F
+++ /dev/null
@@ -1,143 +0,0 @@
-*
-* $Id: d107m.F,v 1.1.1.1 1996/04/01 15:01:22 mclareni Exp $
-*
-* $Log: d107m.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:22 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE D107M
-C This program tests the operation of MATHLIB subprograms
-C RGQUAD and DGQUAD
-
-#include "gen/imp64.inc"
-C Set maximum error allowed for test to be considered successful
- PARAMETER ( TSTERR =1D-12 )
-
- EXTERNAL FF1,FF2
- COMMON /NNNNNN/ N2
- DIMENSION NG(23),X(96),W(96)
-#include "iorc.inc"
-
-
- DATA NG
- 1 /2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,20,24,32,40,48,64,80,96/
-
- CALL HEADER('D107',0)
- ERRMAX=0D0
-#if defined(CERNLIB_DOUBLE)
- WRITE(LOUT,'(/5X,''N'',11X,''DGQUAD'',
- + 17X,''Test Value'',15X,''Error'')')
-#endif
-#if !defined(CERNLIB_DOUBLE)
- WRITE(LOUT,'(/5X,''N'',11X,''RGQUAD'',
- + 17X,''Test Value'',15X,''Error'')')
-#endif
- A=0
- B=1
- DO 1 I = 1,23
- N=NG(I)
-#if defined(CERNLIB_DOUBLE)
- R=DGQUAD(FF1,A,B,N)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- R=RGQUAD(FF1,A,B,N)
-#endif
- T=1
- E=ABS(R-1)
- ERRMAX= MAX(ERRMAX,E)
- WRITE(LOUT,'(1X,I5,1P,D25.15,D25.15,D15.1)') N,R,T,E
- 1 CONTINUE
-
- WRITE(LOUT,'(1X)')
-#if defined(CERNLIB_DOUBLE)
- WRITE(LOUT,'(/5X,''N'',11X,''DGQUAD'',
- + 17X,''Test Value'',15X,''Error'')')
-#endif
-#if !defined(CERNLIB_DOUBLE)
- WRITE(LOUT,'(/5X,''N'',11X,''RGQUAD'',
- + 17X,''Test Value'',15X,''Error'')')
-#endif
- A=1.1D0
- B=2
-#if !defined(CERNLIB_VAX)
- DO 2 I = 1,23
-#endif
-#if defined(CERNLIB_VAX)
-C Since the last 3 values are too big for the VAX
- DO 2 I = 1,20
-#endif
- N=NG(I)
- N2=2*N-1
-#if defined(CERNLIB_DOUBLE)
- R=DGQUAD(FF2,A,B,N)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- R=RGQUAD(FF2,A,B,N)
-#endif
- T=(B**(N2+1)-A**(N2+1))/(N2+1)
- E=ABS((R-T)/T)
- ERRMAX= MAX(ERRMAX,E)
- WRITE(LOUT,'(1X,I5,2D25.15,1P,D15.1)') N,R,T,E
- 2 CONTINUE
-
- WRITE(LOUT,'(1X)')
- WRITE(LOUT,'(/5X,''N'',9X,''Sum(w*f)'',
- + 17X,''Test Value'',15X,''Error'')')
- A=1.1D0
- B=2
-#if !defined(CERNLIB_VAX)
- DO 3 I = 1,23
-#endif
-#if defined(CERNLIB_VAX)
-C Since the last 3 values are too big for the VAX, L.Garren
- DO 3 I = 1,20
-#endif
- N=NG(I)
- N2=2*N-1
-#if defined(CERNLIB_DOUBLE)
- CALL DGSET(A,B,N,X,W)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- CALL RGSET(A,B,N,X,W)
-#endif
- R=0
- DO 4 J = 1,N
- 4 R=R+W(J)*FF2(X(J))
- T=(B**(N2+1)-A**(N2+1))/(N2+1)
- E=ABS((R-T)/T)
- ERRMAX= MAX(ERRMAX,E)
- WRITE(LOUT,'(1X,I5,2D25.15,1P,D15.1)') N,R,T,E
- 3 CONTINUE
- WRITE(LOUT,'(1X)')
- WRITE(LOUT,'(/''TESTING ERROR MESSAGES:''/)')
-#if defined(CERNLIB_DOUBLE)
- R=DGQUAD(FF2,A,B,100)
- CALL DGSET(A,B,100,X,W)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- R=RGQUAD(FF2,A,B,100)
- CALL RGSET(A,B,100,X,W)
-#endif
-
- WRITE(LOUT,'(/'' Largest Relative Error was'',
- +D10.1)') ERRMAX
-C Check if the test was successful
- IRC=ITEST('D107',ERRMAX.LE. TSTERR)
- CALL PAGEND('D107')
- RETURN
- END
-
- FUNCTION FD107(X)
-#include "gen/imp64.inc"
- COMMON /NNNNNN/ N2
-
- ENTRY FF1(X)
- FF1=1
- RETURN
-
- ENTRY FF2(X)
- FF2=X**N2
- RETURN
- END
diff --git a/src/mathlib/gen/tests/d108m.F b/src/mathlib/gen/tests/d108m.F
deleted file mode 100644
index 58c57c2..0000000
--- a/src/mathlib/gen/tests/d108m.F
+++ /dev/null
@@ -1,70 +0,0 @@
-*
-* $Id: d108m.F,v 1.1.1.1 1996/04/01 15:01:23 mclareni Exp $
-*
-* $Log: d108m.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:23 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE D108M
-C Program to test the operation of the MATHLIB routine TRAPER (D108)
-C The routine being tested performs approximate integration
-C using the Trapezoidal Rule.
-C The test is constructed by integrating numerically, arbitrary,
-C (but easy to integrate analytically), functions.
-C The numerical approximation to the integral is compared with
-C the analytical solution and the relative error is calculated.
-C Note that the function to be integrated is not passed directly
-C to the TRAPER routine, but, function-values F(X(I)) are stored
-C in the array Y; ie Y(I)=F(X(I))
-C Specify the total number of tests, and the largest No_intervals
- PARAMETER ( NT=3,NMAX=201 )
-C Specify the largest error permitted for a successful test
- PARAMETER ( TSTERR=1E-3 )
- DIMENSION X(NMAX),Y(NMAX),EPS(NMAX),N(NT),A(NT),B(NT)
-#include "iorc.inc"
-C Specify the test parameters
- DATA N(1),A(1),B(1) / 81, 0.0, 5.0 /
- DATA N(2),A(2),B(2) / 81,-3.0, 2.0 /
- DATA N(3),A(3),B(3) / 81,-2.0, 2.0 /
-
- CALL HEADER('D108',0)
- ERRMAX=0
- DO 200 I=1,NT
- WRITE(LOUT,'(/'' Test Number'',I3)') I
- H= (B(I)-A(I))/ (N(I)-1)
- DO 100 J=1,N(I)
- X(J)= A(I)+ (J-1)*H
- EPS(J)= 0
-C Initialise the Y vector
- IF (I .EQ. 1) THEN
- Y(J)= EXP(X(J))
- ELSEIF (I .EQ. 2) THEN
- Y(J)= X(J)*X(J)
- ELSE
- Y(J)= COS(X(J))
- ENDIF
-100 CONTINUE
-C Calculate the integral numerically
- CALL TRAPER(X,Y,EPS,N(I),A(I),B(I),RE,SD)
-C Calculate the integral analytically
- IF (I .EQ. 1) THEN
- EXACT= EXP(B(I))-EXP(A(I))
- ELSEIF (I .EQ. 2) THEN
- EXACT= (B(I)**3)/3 - (A(I)**3)/3
- ELSE
- EXACT= SIN(B(I))-SIN(A(I))
- ENDIF
-C Calculate the relative error of this approximation
- ERROR= ABS( (EXACT-RE)/RE )
- ERRMAX= MAX( ERRMAX,ERROR )
- WRITE(LOUT,'('' Approximation to Integral '',F22.14)') RE
- WRITE(LOUT,'('' Analytic value of Integral'',F22.14)') EXACT
- WRITE(LOUT,'('' Relative Error '',F22.14)') ERROR
-200 CONTINUE
- WRITE(LOUT, '(/'' Largest Relative Error was'',D10.1 )') ERRMAX
- IRC= ITEST('D108',ERRMAX .LE. TSTERR)
- CALL PAGEND('D108')
- RETURN
- END
diff --git a/src/mathlib/gen/tests/d110m.F b/src/mathlib/gen/tests/d110m.F
deleted file mode 100644
index 74f6493..0000000
--- a/src/mathlib/gen/tests/d110m.F
+++ /dev/null
@@ -1,67 +0,0 @@
-*
-* $Id: d110m.F,v 1.1.1.1 1996/04/01 15:01:23 mclareni Exp $
-*
-* $Log: d110m.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:23 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE D110M
-#include "gen/imp64.inc"
-#include "iorc.inc"
- DIMENSION X(6)
- PARAMETER ( TSTERR=1D-13 )
- EXTERNAL D110S1,D110S3
-C
-C First test is example in Short write up, in Library manual
-C =1 =Sqrt(X2)
-C | |
-C I= | Sqrt(X2)*Exp(X2) | X1*Sqrt{(X1^2)+X2} dX1 dX2
-C | |
-C 0= 0=
-C
- WRITE(LOUT,'(/'' Test Number 1: Double integral'')')
-C Calculate the numerical value of the integrals
-#if defined(CERNLIB_DOUBLE)
- SOL1=DGMLT2(D110S1,0D0,1D0,3,6,X)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- SOL1=RGMLT2(D110S1,0.0,1.0,3,6,X)
-#endif
- EXACT1= (2*SQRT(2D0)-1D0)*(EXP(1D0)-2D0)/3
- ERROR1=ABS( (SOL1-EXACT1)/SOL1 )
- WRITE(LOUT,'('' Calculated Integral'',F25.16)') SOL1
- WRITE(LOUT,'('' Exact Integral '',F25.16)') EXACT1
- WRITE(LOUT,'('' Relative Error '',F25.16)') ERROR1
-C
-C Second test example constructed by author:
-C =a =X1 =X2 =X3 =X4 =X5
-C | | | | | |
-C I= | | | | | | X1+X2+X3+X4+X5+X6 dX6 dX5 dX4...
-C | | | | | | ...dX3 dX2 dX1
-C 0= 0= 0= 0= 0= 0=
-C
- WRITE(LOUT,'(/'' Test Number 2: Six-dimensional integral'')')
- A=1D0
-#if defined(CERNLIB_DOUBLE)
- SOL2=DGMLT6(D110S3,0D0,A,2,6,X)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- SOL2=RGMLT6(D110S3,0.0,A,2,6,X)
-#endif
- EXACT2= (A**7)/240
- ERROR2=ABS((EXACT2-SOL2)/SOL2)
- WRITE(LOUT,'('' Calculated Integral'',F25.16)') SOL2
- WRITE(LOUT,'('' Exact Integral '',F25.16)') EXACT2
- WRITE(LOUT,'('' Relative Error '',F25.16)') ERROR2
-
-C Calculate largest error
- ERRMAX=MAX( ERROR1,ERROR2 )
- WRITE(LOUT,'(/'' Largest Error was'',1P,D10.1)') ERRMAX
- IRC=ITEST('D110',ERRMAX .LE. TSTERR)
- CALL PAGEND('D110')
- RETURN
- END
-
-C ****** Nested function evaluation for test number 1 ******
diff --git a/src/mathlib/gen/tests/d110s1.F b/src/mathlib/gen/tests/d110s1.F
deleted file mode 100644
index a88b1f9..0000000
--- a/src/mathlib/gen/tests/d110s1.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: d110s1.F,v 1.1.1.1 1996/04/01 15:01:23 mclareni Exp $
-*
-* $Log: d110s1.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:23 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE D110S1(M,X2,F2,X)
-#include "gen/imp64.inc"
-#include "iorc.inc"
- DIMENSION X2(M),F2(M),X(6)
- EXTERNAL D110S2
-
- DO 800 I=1,M
- X(2)=X2(I)
- R=SQRT(X(2))
-#if defined(CERNLIB_DOUBLE)
- F2(I)= R*EXP(X(2))*DGMLT1(D110S2,0D0,R,4,6,X)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- F2(I)= R*EXP(X(2))*RGMLT1(D110S2,0.0,R,4,6,X)
-#endif
- 800 CONTINUE
- RETURN
- END
-
diff --git a/src/mathlib/gen/tests/d110s2.F b/src/mathlib/gen/tests/d110s2.F
deleted file mode 100644
index 937394c..0000000
--- a/src/mathlib/gen/tests/d110s2.F
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: d110s2.F,v 1.1.1.1 1996/04/01 15:01:23 mclareni Exp $
-*
-* $Log: d110s2.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:23 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE D110S2(M,X1,F1,X)
-#include "gen/imp64.inc"
-#include "iorc.inc"
- DIMENSION X1(M),F1(M),X(6)
- DO 900 I=1,M
- X(1)=X1(I)
- F1(I)=X(1)*SQRT(X(1)**2+X(2))
- 900 CONTINUE
- RETURN
- END
-C ****** End of nested function evaluation for test number 1 ******
-
-C ****** Nested function evaluation for test number 2 ******
diff --git a/src/mathlib/gen/tests/d110s3.F b/src/mathlib/gen/tests/d110s3.F
deleted file mode 100644
index a7e8296..0000000
--- a/src/mathlib/gen/tests/d110s3.F
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: d110s3.F,v 1.1.1.1 1996/04/01 15:01:23 mclareni Exp $
-*
-* $Log: d110s3.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:23 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE D110S3(M,X6,F6,X)
-#include "gen/imp64.inc"
-#include "iorc.inc"
- DIMENSION X6(M),F6(M),X(6)
- EXTERNAL D110S4
-
- DO 1000 I=1,M
- X(6)=X6(I)
-#if defined(CERNLIB_DOUBLE)
- F6(I)=DGMLT5(D110S4,0D0,X6(I),2,6,X)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- F6(I)=RGMLT5(D110S4,0.0,X6(I),2,6,X)
-#endif
-1000 CONTINUE
- RETURN
- END
-
diff --git a/src/mathlib/gen/tests/d110s4.F b/src/mathlib/gen/tests/d110s4.F
deleted file mode 100644
index cda716b..0000000
--- a/src/mathlib/gen/tests/d110s4.F
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: d110s4.F,v 1.1.1.1 1996/04/01 15:01:23 mclareni Exp $
-*
-* $Log: d110s4.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:23 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE D110S4(M,X5,F5,X)
-#include "gen/imp64.inc"
-#include "iorc.inc"
- DIMENSION X5(M),F5(M),X(6)
- EXTERNAL D110S5
-
- DO 1100 I=1,M
- X(5)=X5(I)
-#if defined(CERNLIB_DOUBLE)
- F5(I)=DGMLT4(D110S5,0D0,X5(I),2,6,X)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- F5(I)=RGMLT4(D110S5,0.0,X5(I),2,6,X)
-#endif
-1100 CONTINUE
- RETURN
- END
-
diff --git a/src/mathlib/gen/tests/d110s5.F b/src/mathlib/gen/tests/d110s5.F
deleted file mode 100644
index 2a9f019..0000000
--- a/src/mathlib/gen/tests/d110s5.F
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: d110s5.F,v 1.1.1.1 1996/04/01 15:01:23 mclareni Exp $
-*
-* $Log: d110s5.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:23 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE D110S5(M,X4,F4,X)
-#include "gen/imp64.inc"
-#include "iorc.inc"
- DIMENSION X4(M),F4(M),X(6)
- EXTERNAL D110S6
-
- DO 1200 I=1,M
- X(4)=X4(I)
-#if defined(CERNLIB_DOUBLE)
- F4(I)=DGMLT3(D110S6,0D0,X4(I),2,6,X)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- F4(I)=RGMLT3(D110S6,0.0,X4(I),2,6,X)
-#endif
-1200 CONTINUE
- RETURN
- END
-
diff --git a/src/mathlib/gen/tests/d110s6.F b/src/mathlib/gen/tests/d110s6.F
deleted file mode 100644
index d28b944..0000000
--- a/src/mathlib/gen/tests/d110s6.F
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: d110s6.F,v 1.1.1.1 1996/04/01 15:01:23 mclareni Exp $
-*
-* $Log: d110s6.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:23 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE D110S6(M,X3,F3,X)
-#include "gen/imp64.inc"
-#include "iorc.inc"
- DIMENSION X3(M),F3(M),X(6)
- EXTERNAL D110S7
-
- DO 1300 I=1,M
- X(3)=X3(I)
-#if defined(CERNLIB_DOUBLE)
- F3(I)=DGMLT2(D110S7,0D0,X3(I),2,6,X)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- F3(I)=RGMLT2(D110S7,0.0,X3(I),2,6,X)
-#endif
-1300 CONTINUE
- RETURN
- END
-
diff --git a/src/mathlib/gen/tests/d110s7.F b/src/mathlib/gen/tests/d110s7.F
deleted file mode 100644
index b1c08c6..0000000
--- a/src/mathlib/gen/tests/d110s7.F
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: d110s7.F,v 1.1.1.1 1996/04/01 15:01:23 mclareni Exp $
-*
-* $Log: d110s7.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:23 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE D110S7(M,X2,F2,X)
-#include "gen/imp64.inc"
-#include "iorc.inc"
- DIMENSION X2(M),F2(M),X(6)
- EXTERNAL D110S8
-
- DO 1400 I=1,M
- X(2)=X2(I)
-#if defined(CERNLIB_DOUBLE)
- F2(I)=DGMLT1(D110S8,0D0,X2(I),2,6,X)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- F2(I)=RGMLT1(D110S8,0.0,X2(I),2,6,X)
-#endif
-1400 CONTINUE
- RETURN
- END
-
diff --git a/src/mathlib/gen/tests/d110s8.F b/src/mathlib/gen/tests/d110s8.F
deleted file mode 100644
index 9049815..0000000
--- a/src/mathlib/gen/tests/d110s8.F
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: d110s8.F,v 1.1.1.1 1996/04/01 15:01:23 mclareni Exp $
-*
-* $Log: d110s8.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:23 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE D110S8(M,X1,F1,X)
-#include "gen/imp64.inc"
-#include "iorc.inc"
- DIMENSION X1(M),F1(M),X(6)
-
- SUM5=X(2)+X(3)+X(4)+X(5)+X(6)
- DO 1500 I=1,M
- X(1)=X1(I)
- F1(I)=X(1)+SUM5
-1500 CONTINUE
- RETURN
-C ****** End of nested function evaluation for test number 2 ******
- END
diff --git a/src/mathlib/gen/tests/d113m.F b/src/mathlib/gen/tests/d113m.F
deleted file mode 100644
index 4b0b00a..0000000
--- a/src/mathlib/gen/tests/d113m.F
+++ /dev/null
@@ -1,134 +0,0 @@
-*
-* $Id: d113m.F,v 1.1.1.1 1996/04/01 15:01:23 mclareni Exp $
-*
-* $Log: d113m.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:23 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE D113M
-#include "iorc.inc"
-C Program to test the MATHLIB routines CGAUSS,WGAUSS (D113) by
-C numerical evaluation of complex line integrals, which can be
-C evaluated analytically.
-
- EXTERNAL D113F1,D113F2,D113F3
- COMMON /D113I1/ A,B
- COMMON /D113I3/ NC
-#include "gen/defc64.inc"
- + WGAUSS,D113F1,D113F2,D113F3,A,B,
- + ATAB,BTAB,G1,G2,G3,D113F,G
-#include "gen/def64.inc"
- + EPSTAB,EPS,ERRMAX,ABS
-#if !defined(CERNLIB_DOUBLE)
-#include "gen/defc64.inc"
- + CGAUSS
-#endif
- DIMENSION ATAB(20),BTAB(20),EPSTAB(20)
-
-C Set the largest absolute error allowed for a successful test
- PARAMETER ( TSTERR=5D-07)
-#if defined(CERNLIB_DOUBLE)
- DATA ATAB(1) /(-1D0, 0D0)/, BTAB(1) /( 2D0,0D0)/
- DATA ATAB(2) /( 0D0,-1D0)/, BTAB(2) /( 0D0,2D0)/
- DATA ATAB(3) /( 0D0, 2D0)/, BTAB(3) /( 2D0,1D0)/
- DATA (EPSTAB(I),I=1,4) /1D-2,1D-5,1D-7,1D-12/
-#endif
-#if !defined(CERNLIB_DOUBLE)
- DATA ATAB(1) /(-1E0, 0E0)/, BTAB(1) /( 2E0,0E0)/
- DATA ATAB(2) /( 0E0,-1E0)/, BTAB(2) /( 0E0,2E0)/
- DATA ATAB(3) /( 0E0, 2E0)/, BTAB(3) /( 2E0,1E0)/
- DATA (EPSTAB(I),I=1,4) /1D-2,1D-5,1D-6,1D-12/
-#endif
-
- G1(A,B)=EXP(B)-EXP(A)
- G2(A,B)=2*(B*SQRT(B)-A*SQRT(A))/3
- G3(A,B)=2*(SQRT(B-A)-SQRT(A-B))
-
- CALL HEADER('D113',0)
- ERRMAX=0D0
-
-#if defined(CERNLIB_DOUBLE)
- WRITE(LOUT,'(/''JFN'',2X,''EPS'',10X,''A'',11X,''B'',7X,''NC'',
- +17X, ''WGAUSS'',20X,''Error'')')
-#endif
-#if !defined(CERNLIB_DOUBLE)
- WRITE(LOUT,'(/''JFN'',2X,''EPS'',10X,''A'',11X,''B'',7X,''NC'',
- +17X, ''CGAUSS'',20X,''Error'')')
-#endif
- DO 1 JFN = 1,3
- IF(JFN .GT. 1) WRITE(LOUT,'(1X)')
- DO 1 JAB = 1,3
- WRITE(LOUT,'(1X)')
- A=ATAB(JAB)
- B=BTAB(JAB)
- DO 1 JEPS = 1,4
- IF(.NOT. (JFN .EQ. 3 .AND. JEPS .EQ. 4)) THEN
- EPS=EPSTAB(JEPS)
- NC=0
- IF(JFN .EQ. 1) THEN
-#if defined(CERNLIB_DOUBLE)
- D113F=WGAUSS(D113F1,A,B,EPS)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- D113F=CGAUSS(D113F1,A,B,EPS)
-#endif
- G=G1(A,B)
- ELSE IF(JFN .EQ. 2) THEN
-#if defined(CERNLIB_DOUBLE)
- D113F=WGAUSS(D113F2,A,B,EPS)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- D113F=CGAUSS(D113F2,A,B,EPS)
-#endif
- G=G2(A,B)
- ELSE
-#if defined(CERNLIB_DOUBLE)
- D113F=WGAUSS(D113F3,A,B,EPS)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- D113F=CGAUSS(D113F3,A,B,EPS)
-#endif
- G=G3(A,B)
- END IF
- IF(JEPS .EQ. 3) ERRMAX=MAX(ERRMAX,ABS((D113F-G)/G))
- WRITE(LOUT,101) JFN,EPS,A,B,NC,D113F,ABS((D113F-G)/G)
- END IF
- 1 CONTINUE
- 101 FORMAT(1X,I2,D8.1,2(F6.1,F6.1),I5,2F20.16,1P,D10.1)
- WRITE(LOUT,'(/'' Largest Error was'',1P,D10.1)') ERRMAX
- WRITE(LOUT,'(/''TESTING ERROR MESSAGES:''/)')
-#if defined(CERNLIB_DOUBLE)
- D113F=WGAUSS(D113F3,ATAB(3),BTAB(3),EPSTAB(4))
-#endif
-#if !defined(CERNLIB_DOUBLE)
- D113F=CGAUSS(D113F3,ATAB(3),BTAB(3),EPSTAB(4))
-#endif
- WRITE(LOUT,'(1X)')
-C Check if the test was successful
- IRC=ITEST('D113',ERRMAX .LE. TSTERR)
- CALL PAGEND('D113')
- RETURN
- END
-
- FUNCTION D113FF(Z)
-#include "gen/impc64.inc"
- COMMON /D113I1/ A,B
- COMMON /D113I3/ NC
-
- ENTRY D113F1(Z)
- NC=NC+1
- D113F1=EXP(Z)
- RETURN
-
- ENTRY D113F2(Z)
- NC=NC+1
- D113F2=SQRT(Z)
- RETURN
-
- ENTRY D113F3(Z)
- NC=NC+1
- D113F3=1/SQRT(Z-A)+1/SQRT(Z-B)
- RETURN
- END
diff --git a/src/mathlib/gen/tests/d115f1.F b/src/mathlib/gen/tests/d115f1.F
deleted file mode 100644
index 5ac0b27..0000000
--- a/src/mathlib/gen/tests/d115f1.F
+++ /dev/null
@@ -1,14 +0,0 @@
-*
-* $Id: d115f1.F,v 1.1.1.1 1996/04/01 15:01:23 mclareni Exp $
-*
-* $Log: d115f1.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:23 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- FUNCTION D115F1(X)
- DOUBLE PRECISION D115F1,X
- D115F1= EXP(X)
- RETURN
- END
diff --git a/src/mathlib/gen/tests/d115f2.F b/src/mathlib/gen/tests/d115f2.F
deleted file mode 100644
index 1f8a45d..0000000
--- a/src/mathlib/gen/tests/d115f2.F
+++ /dev/null
@@ -1,14 +0,0 @@
-*
-* $Id: d115f2.F,v 1.1.1.1 1996/04/01 15:01:23 mclareni Exp $
-*
-* $Log: d115f2.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:23 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- FUNCTION D115F2(X)
- DOUBLE PRECISION D115F2,X
- D115F2= COS(X)
- RETURN
- END
diff --git a/src/mathlib/gen/tests/d115f3.F b/src/mathlib/gen/tests/d115f3.F
deleted file mode 100644
index f91bc69..0000000
--- a/src/mathlib/gen/tests/d115f3.F
+++ /dev/null
@@ -1,14 +0,0 @@
-*
-* $Id: d115f3.F,v 1.1.1.1 1996/04/01 15:01:23 mclareni Exp $
-*
-* $Log: d115f3.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:23 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- FUNCTION D115F3(X)
- DOUBLE PRECISION D115F3,X
- D115F3= (X*X*X)-2*X+2
- RETURN
- END
diff --git a/src/mathlib/gen/tests/d115m.F b/src/mathlib/gen/tests/d115m.F
deleted file mode 100644
index e2aca4d..0000000
--- a/src/mathlib/gen/tests/d115m.F
+++ /dev/null
@@ -1,49 +0,0 @@
-*
-* $Id: d115m.F,v 1.1.1.1 1996/04/01 15:01:23 mclareni Exp $
-*
-* $Log: d115m.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:23 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE D115M
-C Program to test the MATHLIB routine CHEBQU (D115), which performs
-C Double-precision Clenshaw-Curtis integration.
-C The functions being integrated are stored in FUNCTION subprograms
-#include "gen/imp64.inc"
-C Specify the total number of tests
- PARAMETER ( NT=3 )
-C Specify the largest error allowed in a successful test
- PARAMETER ( TSTERR=8D-10 )
- DIMENSION A(NT),B(NT)
-#include "iorc.inc"
- EXTERNAL D115F1,D115F2,D115F3
- DATA A,B / -2D0, 4D0, -5D0, 5D0, 1D0, 7D0 /
-
- CALL HEADER('D115',0)
- ERRMAX= 0D0
- EPSIN= 1D-12
- DO 100 I=1,NT
- WRITE(LOUT,'(/'' Test Number'',I2)') I
- IF (I .EQ. 1) THEN
- SOL= CHEBQU( A(I),B(I),EPSIN,EPSOUT,0,D115F1 )
- EXACT= EXP( B(I) )-EXP( A(I) )
- ELSEIF (I .EQ. 2) THEN
- SOL= CHEBQU( A(I),B(I),EPSIN,EPSOUT,0,D115F2 )
- EXACT= SIN( B(I) )-SIN( A(I) )
- ELSE
- SOL= CHEBQU( A(I),B(I),EPSIN,EPSOUT,0,D115F3 )
- EXACT= 2*(B(I)-A(I))+(A(I)**2-B(I)**2)+(B(I)**4-A(I)**4)/4
- ENDIF
- ERROR= ABS( (SOL-EXACT)/SOL )
- ERRMAX= MAX( ERRMAX,ERROR )
- WRITE(LOUT,'('' Numerical value of Integral '',F25.16)') SOL
- WRITE(LOUT,'('' Analytical value of Integral'',F25.16)') EXACT
- WRITE(LOUT,'('' Relative Error '',F25.16)') ERROR
-100 CONTINUE
- WRITE(LOUT,'(/'' Largest Error was'',1P,D10.1)') ERRMAX
- IRC= ITEST('D115',ERRMAX .LE. TSTERR)
- CALL PAGEND('D115')
- RETURN
- END
diff --git a/src/mathlib/gen/tests/d200m.F b/src/mathlib/gen/tests/d200m.F
deleted file mode 100644
index 9318b44..0000000
--- a/src/mathlib/gen/tests/d200m.F
+++ /dev/null
@@ -1,74 +0,0 @@
-*
-* $Id: d200m.F,v 1.1.1.1 1996/04/01 15:01:24 mclareni Exp $
-*
-* $Log: d200m.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:24 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE D200M
-C This program tests the operation of MATHLIB subprograms
-C RKSTP and DRKSTP (D(200)
-
-#include "gen/imp64.inc"
-C Set maximum error allowed for test to be considered successful
- PARAMETER ( TSTERR=1D-10)
-
- EXTERNAL D200S1
-
- DIMENSION Y(2),W(2,3)
-
- PARAMETER (Z0 = 0, Z1 = 1)
-#include "iorc.inc"
-
- CALL HEADER('D200',0)
- ERMAX= 0D0
-
- WRITE(LOUT,'(/8X,''X'',12X,''Y(1)'',9X,''ErrorY1'',11X,''Y(2)'',
- + 8X,''ErrorY2'')')
- X=Z1
-#if defined(CERNLIB_DOUBLE)
- Y(1)=DBESJ0(X)
- Y(2)=-DBESJ1(X)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- Y(1)= BESJ0(X)
- Y(2)=- BESJ1(X)
-#endif
- Y1=Y(1)
- Y2=Y(2)
- WRITE(LOUT,'(1X,F10.2,F20.15,D10.1,F20.15,D10.1)') X,Y(1),Y(1)-Y1,
- + Y(2),Y(2)-Y2
- DO 1 J = 0,199
-#if defined(CERNLIB_DOUBLE)
- CALL DRKSTP(2,Z1/100,X,Y,D200S1,W)
- Y1=DBESJ0(X)
- Y2=-DBESJ1(X)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- CALL RKSTP(2,Z1/100,X,Y,D200S1,W)
- Y1= BESJ0(X)
- Y2=- BESJ1(X)
-#endif
- ER1=ABS(Y(1)-Y1)
- ER2=ABS(Y(2)-Y2)
- ERMAX=MAX(ERMAX,ER1,ER2)
- IF(J .EQ. 0 .OR. J .EQ. 49 .OR. J .EQ. 99 .OR. J .EQ. 199)
- +WRITE(LOUT,'(1X,F10.2,F20.15,D10.1,F20.15,D10.1)') X,Y(1),ER1,
- + Y(2),ER2
- 1 CONTINUE
- WRITE(LOUT,'(/'' Largest Error was'',D10.1)') ERMAX
- IRC= ITEST('D200',ERMAX .LE. TSTERR)
- CALL PAGEND('D200')
- RETURN
- END
- SUBROUTINE D200S1(X,Y,F)
-
-#include "gen/imp64.inc"
- DIMENSION Y(*),F(*)
-
- F(1)=Y(2)
- F(2)=-Y(2)/X-Y(1)
- RETURN
- END
diff --git a/src/mathlib/gen/tests/d201m.F b/src/mathlib/gen/tests/d201m.F
deleted file mode 100644
index cc29c62..0000000
--- a/src/mathlib/gen/tests/d201m.F
+++ /dev/null
@@ -1,160 +0,0 @@
-*
-* $Id: d201m.F,v 1.1.1.1 1996/04/01 15:01:24 mclareni Exp $
-*
-* $Log: d201m.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:24 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE D201M
-C This program tests the MATHLIB routine DEQBS and DDEQBS (D201)
-
-#include "gen/imp64.inc"
- EXTERNAL SD201
-
- DIMENSION Y(5),W(5*36),YT(8)
-
-#include "iorc.inc"
- DATA (YT(J),J=1,8)
- +/1.1999435709D0,-0.0082168071D0,-0.014411453D0,-1.049218128D0,
- + 1.2D0,0D0,0D0,-1.04935750983D0/
- CALL HEADER('D201',0)
- ERRMAX=0D0
- TSTERR=5D-9
- EPS=1D-12
- ERR=1D-20
-
-C Test example "earth - moon - spaceship" on page 9 of
-C R. Bulirsch and J. Stoer, Numerical Treatment of Ordinary
-C Differential Equations by Extrapolation Methods,
-C Numer. Math. 8 (1966) 1 - 13
-
- N=4
-
-
-C Integration by repeated CALLs
-
- DO 1 IT = 0,123
- IF(MOD(IT,50) .EQ. 0) WRITE(LOUT,100)
- T=IT/20D0
- TE=(IT+1)/20D0
- IF(IT .EQ. 0) THEN
- Y(1)=1.2D0
- Y(2)=0
- Y(3)=0
- Y(4)=-1.04935 750983D0
- H=0.02D0
- END IF
-#if defined(CERNLIB_DOUBLE)
- CALL DDEQBS(N,T,TE,Y,H,EPS,SD201,W)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- CALL DEQBS(N,T,TE,Y,H,EPS,SD201,W)
-#endif
- WRITE(LOUT,'(1X,F6.2,4F18.12,F10.6)')
- + TE,Y(1),Y(2),Y(3),Y(4),H
- 1 CONTINUE
- ERRMAX=MAX(ABS(Y(1)-YT(1)),ABS(Y(2)-YT(2)),
- +ABS(Y(3)-YT(3)), ABS(Y(4)-YT(4)),ERRMAX)
-
-C Integration by one CALL
-
- WRITE(LOUT,'(1X)')
- T=0
- TE=6.20D0
- Y(1)=1.2D0
- Y(2)=0
- Y(3)=0
- Y(4)=-1.04935 750983D0
- H=0.2D0
-#if defined(CERNLIB_DOUBLE)
- CALL DDEQBS(N,T,TE,Y,H,EPS,SD201,W)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- CALL DEQBS(N,T,TE,Y,H,EPS,SD201,W)
-#endif
- ERRMAX=MAX(ABS(Y(1)-YT(1)),ABS(Y(2)-YT(2)),
- +ABS(Y(3)-YT(3)), ABS(Y(4)-YT(4)),ERRMAX)
- WRITE(LOUT,'(1X,F6.2,4F18.12)') TE,Y(1),Y(2),Y(3),Y(4)
-
-C Integration over the closed orbit by one CALL (in both directions)
-
- DO 2 K = 0,1
- WRITE(LOUT,'(1X)')
- IF(K .EQ. 0) THEN
- T=0
- TE=6.19216 93313 96D0
- H=0.2D0
- ELSE
- T=6.19216 93313 96D0
- TE=0
- H=-0.2D0
- END IF
- Y(1)=1.2D0
- Y(2)=0
- Y(3)=0
- Y(4)=-1.04935 750983D0
- CALL TIMED(T0)
-#if defined(CERNLIB_DOUBLE)
- CALL DDEQBS(N,T,TE,Y,H,EPS,SD201,W)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- CALL DEQBS(N,T,TE,Y,H,EPS,SD201,W)
-#endif
- CALL TIMED(T1)
- ERRMAX=MAX(ABS(Y(1)-YT(5)),ABS(Y(2)-YT(6)),
- +ABS(Y(3)-YT(7)), ABS(Y(4)-YT(8)),ERRMAX)
- WRITE(LOUT,'(1X,F10.4)') T1
- 2 WRITE(LOUT,'(1X,5F18.12)') TE,Y(1),Y(2),Y(3),Y(4)
-
- WRITE(LOUT,'(/'' Largest Error'',1P,D10.1)') ERRMAX
-
-C Test error condition
-
- WRITE(LOUT,'(/''TESTING ERROR MESSAGES:''/)')
-* DEQBS just returns, and does NOT print any error message!
-#if defined(CERNLIB_DOUBLE)
-* CALL DDEQBS(0,T,TE,Y,H,ERR,SD201,W)
-#endif
-#if !defined(CERNLIB_DOUBLE)
-* CALL DEQBS(0,T,TE,Y,H,ERR,SD201,W)
-#endif
-
- WRITE(LOUT,'(1X)')
- T=0
- TE=0.01D0
- Y(1)=1.2D0
- Y(2)=0
- Y(3)=0
- Y(4)=-1.04935 750983D0
- H=0.2D0
-#if defined(CERNLIB_DOUBLE)
- CALL DDEQBS(N,T,TE,Y,H,ERR,SD201,W)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- CALL DEQBS(N,T,TE,Y,H,ERR,SD201,W)
-#endif
-
- 100 FORMAT('1',/,5X,'T',14X,'X(T)',14X,'Y(T)',13X,'X.(T)',13X,
- 1 'Y.(T)',9X,'H'/)
-C Check if the test was completed successfully
- IRC=ITEST('D201',ERRMAX .LE. TSTERR)
- CALL PAGEND('D201')
- RETURN
- END
- SUBROUTINE SD201(X,Y,F)
-#include "gen/imp64.inc"
- DIMENSION Y(*),F(*)
-
- PARAMETER (FMU = 1/82.45D0, FM1 = 1-FMU)
-
- X=X+0
- HP=1/SQRT(((Y(1)+FMU)**2+Y(2)**2)**3)
- HM=1/SQRT(((Y(1)-FM1)**2+Y(2)**2)**3)
- F(1)=Y(3)
- F(2)=Y(4)
- F(3)=Y(1)+2*Y(4)-FM1*HP*(Y(1)+FMU)-FMU*HM*(Y(1)-FM1)
- F(4)=Y(2)-2*Y(3)-FM1*HP*Y(2)-FMU*HM*Y(2)
- RETURN
- END
diff --git a/src/mathlib/gen/tests/d202m.F b/src/mathlib/gen/tests/d202m.F
deleted file mode 100644
index 05d7714..0000000
--- a/src/mathlib/gen/tests/d202m.F
+++ /dev/null
@@ -1,160 +0,0 @@
-*
-* $Id: d202m.F,v 1.1.1.1 1996/04/01 15:01:24 mclareni Exp $
-*
-* $Log: d202m.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:24 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE D202M
-C This program tests the MATHLIB routines DEQMR and DDEQMR (D202)
-
-#include "gen/imp64.inc"
- EXTERNAL SD202
-
- DIMENSION Y(4),W(4*6),YT(8)
-
-#include "iorc.inc"
- DATA (YT(J),J=1,8)
- +/1.1999435709D0,-0.0082168071D0,-0.014411453D0,-1.049218128D0,
- + 1.2D0,0D0,0D0,-1.04935750983D0/
- CALL HEADER('D202',0)
- ERRMAX=0D0
- TSTERR=5D-9
- EPS=1D-12
- ERR=1D-20
-
-C Test example "earth - moon - spaceship" on page 9 of
-C R. Bulirsch and J. Stoer, Numerical Treatment of Ordinary
-C Differential Equations by Extrapolation Methods,
-C Numer. Math. 8 (1966) 1 - 13
-
- N=4
-
-
-C Integration by repeated CALLs
-
- DO 1 IT = 0,123
- IF(MOD(IT,50) .EQ. 0) WRITE(LOUT,100)
- T=IT/20D0
- TE=(IT+1)/20D0
- IF(IT .EQ. 0) THEN
- Y(1)=1.2D0
- Y(2)=0D0
- Y(3)=0D0
- Y(4)=-1.04935 750983D0
- H=0.02D0
- END IF
-#if defined(CERNLIB_DOUBLE)
- CALL DDEQMR(N,T,TE,Y,H,EPS,SD202,W)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- CALL DEQMR(N,T,TE,Y,H,EPS,SD202,W)
-#endif
- WRITE(LOUT,'(1X,F6.2,4F18.12,F10.6)')
- + TE,Y(1),Y(2),Y(3),Y(4),H
- 1 CONTINUE
- ERRMAX=MAX(ABS(Y(1)-YT(1)),ABS(Y(2)-YT(2)),
- +ABS(Y(3)-YT(3)), ABS(Y(4)-YT(4)),ERRMAX)
-
-C Integration by one CALL
-
- WRITE(LOUT,'(1X)')
- T=0
- TE=6.20D0
- Y(1)=1.2D0
- Y(2)=0
- Y(3)=0
- Y(4)=-1.04935 750983D0
- H=0.2D0
-#if defined(CERNLIB_DOUBLE)
- CALL DDEQMR(N,T,TE,Y,H,EPS,SD202,W)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- CALL DEQMR(N,T,TE,Y,H,EPS,SD202,W)
-#endif
- ERRMAX=MAX(ABS(Y(1)-YT(1)),ABS(Y(2)-YT(2)),
- +ABS(Y(3)-YT(3)), ABS(Y(4)-YT(4)),ERRMAX)
- WRITE(LOUT,'(1X,F6.2,4F18.12)') TE,Y(1),Y(2),Y(3),Y(4)
-
-C Integration over the closed orbit by one CALL (in both directions)
-
- DO 2 K = 0,1
- WRITE(LOUT,'(1X)')
- IF(K .EQ. 0) THEN
- T=0
- TE=6.19216 93313 96D0
- H=0.2D0
- ELSE
- T=6.19216 93313 96D0
- TE=0
- H=-0.2D0
- END IF
- Y(1)=1.2D0
- Y(2)=0
- Y(3)=0
- Y(4)=-1.04935 750983D0
- CALL TIMED(T0)
-#if defined(CERNLIB_DOUBLE)
- CALL DDEQMR(N,T,TE,Y,H,EPS,SD202,W)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- CALL DEQMR(N,T,TE,Y,H,EPS,SD202,W)
-#endif
- CALL TIMED(T1)
- ERRMAX=MAX(ABS(Y(1)-YT(5)),ABS(Y(2)-YT(6)),
- +ABS(Y(3)-YT(7)), ABS(Y(4)-YT(8)),ERRMAX)
- WRITE(LOUT,'(1X,F10.4)') T1
- 2 WRITE(LOUT,'(1X,5F18.12)') TE,Y(1),Y(2),Y(3),Y(4)
-
- WRITE(LOUT,'(/'' Largest Error'',1P,D10.1)') ERRMAX
-
-C Test error condition
-
- WRITE(LOUT,'(/''TESTING ERROR MESSAGES:''/)')
-* DEQBS just returns, and does NOT print any error message!
-#if defined(CERNLIB_DOUBLE)
-* CALL DDEQMR(0,T,TE,Y,H,ERR,SD202,W)
-#endif
-#if !defined(CERNLIB_DOUBLE)
-* CALL DEQMR(0,T,TE,Y,H,ERR,SD202,W)
-#endif
-
- WRITE(LOUT,'(1X)')
- T=0
- TE=0.01D0
- Y(1)=1.2D0
- Y(2)=0
- Y(3)=0
- Y(4)=-1.04935 750983D0
- H=0.2D0
-#if defined(CERNLIB_DOUBLE)
- CALL DDEQMR(N,T,TE,Y,H,ERR,SD202,W)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- CALL DEQMR(N,T,TE,Y,H,ERR,SD202,W)
-#endif
-
- 100 FORMAT('1',/,5X,'T',14X,'X(T)',14X,'Y(T)',13X,'X.(T)',13X,
- 1 'Y.(T)',9X,'H'/)
-C Check if the test was completed successfully
- IRC=ITEST('D202',ERRMAX .LE. TSTERR)
- CALL PAGEND('D202')
- RETURN
- END
- SUBROUTINE SD202(X,Y,F)
-#include "gen/imp64.inc"
- DIMENSION Y(*),F(*)
-
- PARAMETER (FMU = 1/82.45D0, FM1 = 1-FMU)
-
- X=X+0
- HP=1/SQRT(((Y(1)+FMU)**2+Y(2)**2)**3)
- HM=1/SQRT(((Y(1)-FM1)**2+Y(2)**2)**3)
- F(1)=Y(3)
- F(2)=Y(4)
- F(3)=Y(1)+2*Y(4)-FM1*HP*(Y(1)+FMU)-FMU*HM*(Y(1)-FM1)
- F(4)=Y(2)-2*Y(3)-FM1*HP*Y(2)-FMU*HM*Y(2)
- RETURN
- END
diff --git a/src/mathlib/gen/tests/d203m.F b/src/mathlib/gen/tests/d203m.F
deleted file mode 100644
index c8df55f..0000000
--- a/src/mathlib/gen/tests/d203m.F
+++ /dev/null
@@ -1,78 +0,0 @@
-*
-* $Id: d203m.F,v 1.1.1.1 1996/04/01 15:01:24 mclareni Exp $
-*
-* $Log: d203m.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:24 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE D203M
-C This program tests the operation of MATHLIB subprograms
-C RKNYS and DRKNYS (D(203)
-
-#include "gen/imp64.inc"
-C Set maximum error allowed for test to be considered successful
- PARAMETER ( TSTERR=1D-6 )
-
- EXTERNAL SD203
-
- DIMENSION Y(2),YP(2),U(2),UP(2),R(2),RP(2),W(12)
-
- PARAMETER (Z0 = 0, Z1 = 1)
- PARAMETER (A1 = -8, A2 = 7*Z1/3, A3 = 5, A4 = -7*Z1/6)
-#include "iorc.inc"
-
- CALL HEADER('D203',0)
- ERRMAX=0D0
-
- WRITE(LOUT,'(/6X,''X'',13X,''Y(1)'',16X,''Y(2)'',16X,
- +''YP(1)'',16X,''YP(2)'',8X,
- +''ErY1'',6X,''ErY2'',6X,''ErYP1'',6X,''ErYP2'')')
- X=0
- Y(1)=0
- Y(2)=0
- YP(1)=0
- YP(2)=0
- WRITE(LOUT,'(1X,F8.3,4F20.12)') X,Y(1),Y(2),YP(1),YP(2)
- DO 1 J = 0,99
-#if defined(CERNLIB_DOUBLE)
- CALL DRKNYS(2,Z1/200,X,Y,YP,SD203,W)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- CALL RKNYS(2,Z1/200,X,Y,YP,SD203,W)
-#endif
- S1=SIN(X)
- S2=SIN(2*X)
- C1=COS(X)
- C2=COS(2*X)
- U(1)=A1*C1+A2*S1+A3*C2+A4*S2+3
- U(2)=5*(A1*S1-A2*C1)+4*(A3*S2-A4*C2)+7
- UP(1)=-(A1*S1-A2*C1+2*A3*S2-2*A4*C2)
- UP(2)=5*(A1*C1+A2*S1)+8*(A3*C2+A4*S2)
- DO 2 I = 1,2
- R(I)=ABS((Y(I)-U(I))/U(I))
- ERRMAX= MAX(ERRMAX,R(I))
- RP(I)=ABS((YP(I)-UP(I))/UP(I))
- ERRMAX= MAX(ERRMAX,RP(I))
- 2 CONTINUE
- WRITE(LOUT,'(1X,F8.3,4F20.12,4D10.1)')
- 1 X,Y(1),Y(2),YP(1),YP(2),R(1),R(2),RP(1),RP(2)
- 1 CONTINUE
- WRITE(LOUT,'(/'' Largest Relative Error was'',D10.1)') ERRMAX
-C Check if the test was successful
- IRC=ITEST('D203',ERRMAX .LE. TSTERR)
- CALL PAGEND('D203')
- RETURN
- END
-
- SUBROUTINE SD203(X,Y,YP,F)
-#include "gen/imp64.inc"
-
- DIMENSION Y(*),YP(*),F(*)
-
- F(1)=4*Y(1)-YP(2)-12
- F(2)=Y(2)+10*YP(1)-7
-
- RETURN
- END
diff --git a/src/mathlib/gen/tests/d401m.F b/src/mathlib/gen/tests/d401m.F
deleted file mode 100644
index 9734a04..0000000
--- a/src/mathlib/gen/tests/d401m.F
+++ /dev/null
@@ -1,139 +0,0 @@
-*
-* $Id: d401m.F,v 1.1.1.1 1996/04/01 15:01:24 mclareni Exp $
-*
-* $Log: d401m.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:24 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE D401M
-C This program tests the MATHLIB routines DERIV,DDERIV (D401)
-
-#include "gen/imp64.inc"
- EXTERNAL FD401
- COMMON /LABEL/ L
- DIMENSION X(20),D(20)
- CHARACTER*10 H(20)
- PARAMETER ( TSTERR=5D-10)
-
-#include "iorc.inc"
-
- DATA X( 1),D( 1),H( 1) /0.04D0 ,1 ,'1/TAN(X) '/
- DATA X( 2),D( 2),H( 2) /0.001D0,1 ,'SIN(1/X) '/
- DATA X( 3),D( 3),H( 3) /0.5D0 ,1 ,'X**2 '/
- DATA X( 4),D( 4),H( 4) /0.999D0,1 ,'10**8*X**4'/
- DATA X( 5),D( 5),H( 5) /1 ,1 ,'1 '/
- DATA X( 6),D( 6),H( 6) /0.002D0,1 ,'X*SIN(1/X)'/
- DATA X( 7),D( 7),H( 7) /1.001D0,1 ,'X**99 '/
- DATA X( 8),D( 8),H( 8) /100 ,50 ,'ATAN(X) '/
- DATA X( 9),D( 9),H( 9) /2 ,1 ,'X**X '/
- DATA X(10),D(10),H(10) /1D-5 ,1D-4,'SQRT(X) '/
- DATA X(11),D(11),H(11) /0.001D0,1 ,'SIN(1/X)/X'/
- DATA X(12),D(12),H(12) /0.5D0 ,1 ,'RANF(X) '/
- DATA X(13),D(13),H(13) /0 ,1 ,'ABS(X) '/
- DATA X(14),D(14),H(14) /0 ,1 ,'1/X '/
-
- CALL HEADER('D401',0)
-
- ERRMAX=0D0
- WRITE(LOUT,100)
- DO 1 L = 1,14
- IF(L .EQ. 12) THEN
- WRITE(LOUT,'(/'' Largest error'',1P,D10.1)') ERRMAX
- WRITE(LOUT,'(/''TESTING ERROR MESSAGES:''/)')
- ENDIF
- IF(L .EQ. 13)
- +WRITE(LOUT,'(/''TESTING NON DIFFERENTIABLE FUNCTIONS:''/)')
- DEL=D(L)
-#if defined(CERNLIB_DOUBLE)
- CALL DDERIV(FD401,X(L),DEL,DFDX,RERR)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- CALL DERIV(FD401,X(L),DEL,DFDX,RERR)
-#endif
- TST=TD401(X(L))
- IF(L .LT. 12)THEN
- IF(TST .NE. 0)ERRMAX=MAX(ERRMAX,ABS((DFDX-TST)/TST))
- IF(TST .EQ. 0)ERRMAX=MAX(ERRMAX,ABS(DFDX-TST))
- ENDIF
- WRITE(LOUT,'(1X,A10,3F12.8,2F30.15,1PD10.1/)')
- 1 H(L),X(L),D(L),DEL,DFDX,TST,RERR
- 1 CONTINUE
- 100 FORMAT('1'/1X,10X,11X,'X',7X,'DELTA',6X,'DELTA''',
- 1 25X,'DF/DX',26X,'TEST',6X,'RERR'/)
-C Check if the test was successful
- IRC=ITEST('D401',ERRMAX .LE. TSTERR)
- CALL PAGEND('D401')
- RETURN
- END
- FUNCTION FD401(X)
-#include "gen/imp64.inc"
- COMMON /LABEL/ L
-
- GO TO(1,2,3,4,5,6,7,8,9,10,11,12,13,14), L
-
- 1 FD401=1/TAN(X)
- RETURN
- 2 FD401=SIN(1/X)
- RETURN
- 3 FD401=X**2
- RETURN
- 4 FD401=1D8*X**4
- RETURN
- 5 FD401=1
- RETURN
- 6 FD401=X*SIN(1/X)
- RETURN
- 7 FD401=X**99
- RETURN
- 8 FD401=ATAN(X)
- RETURN
- 9 FD401=X**X
- RETURN
- 10 FD401=SQRT(X)
- RETURN
- 11 FD401=SIN(1/X)/X
- RETURN
- 12 FD401=RANF()
- RETURN
- 13 FD401=ABS(X)
- RETURN
- 14 FD401=1/X
- RETURN
- END
- FUNCTION TD401(X)
-#include "gen/imp64.inc"
- COMMON /LABEL/ L
-
- GO TO(1,2,3,4,5,6,7,8,9,10,11,12,13,14), L
-
- 1 TD401=-1/SIN(X)**2
- RETURN
- 2 TD401=-COS(1/X)/X**2
- RETURN
- 3 TD401=2*X
- RETURN
- 4 TD401=4D8*X**3
- RETURN
- 5 TD401=0
- RETURN
- 6 TD401=SIN(1/X)-COS(1/X)/X
- RETURN
- 7 TD401=99*X**98
- RETURN
- 8 TD401=1/(1+X**2)
- RETURN
- 9 TD401=X**X*(1+LOG(X))
- RETURN
- 10 TD401=1/(2*SQRT(X))
- RETURN
- 11 TD401=-(SIN(1/X)+COS(1/X)/X)/X**2
- RETURN
- 12 TD401=99999D0
- RETURN
- 13 TD401=99999D0
- RETURN
- 14 TD401=99999D0
- RETURN
- END
diff --git a/src/mathlib/gen/tests/d503m.F b/src/mathlib/gen/tests/d503m.F
deleted file mode 100644
index bc88b78..0000000
--- a/src/mathlib/gen/tests/d503m.F
+++ /dev/null
@@ -1,207 +0,0 @@
-*
-* $Id: d503m.F,v 1.1.1.1 1996/04/01 15:01:24 mclareni Exp $
-*
-* $Log: d503m.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:24 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE D503M
-C This program tests the operation of MATHLIB subroutine subprograms
-C RMINFC and DMINFC (D503).
-
-#include "gen/imp64.inc"
- LOGICAL LLM
- EXTERNAL D503F1,D503F2,D503F3,D503F4,D503F5,D503F6
- EXTERNAL D503F7,D503F8,D503F9
- DIMENSION Z(2)
-
- PARAMETER (Z0 = 0, Z1 = 1)
-C Set maximum error allowed for test to be considered successful
- PARAMETER ( TSTERR=5D-8 )
-
-#include "iorc.inc"
-
- CALL HEADER('D503',0)
- ERRMAX=0D0
-
-C CASE 1
-
- IC=1
- EPS=1D-8
- DELTA=10*EPS
-
- CALL DBZEJY(Z1,1,3,1D-14,Z)
- T=Z(1)
- A=5
- B=1
- FA=D503F1(A)
- FB=D503F1(B)
- CALL DMINFC(D503F1,A,B,EPS,DELTA,X,Y,LLM)
- ERRMAX = MAX (ERRMAX,ABS((T-X)/(1+ABS(T))))
- WRITE(LOUT,'(/6X,''A'',8X,''B'',9X,''X'',15X,''T'',15X,
- + ''FA'',10X,''Y'',10X,''FB'',6X,''Error'',
- + 6X,''EPS'',4X,''LLM'',2X,''IC''//)')
- WRITE(LOUT,'(1X,2F8.2,2F16.12,3F12.6,1P,2D10.1,L3,I3//)')
- 1 A,B,X,T,FA,Y,FB,ABS((T-X)/(1+ABS(T))),EPS,LLM,IC
-
-C CASE 2
-
- IC=2
- T=0.5D0
- A=0.25D0
- B=0.75D0
- FA=D503F2(A)
- FB=D503F2(B)
- CALL DMINFC(D503F2,A,B,EPS,DELTA,X,Y,LLM)
- ERRMAX = MAX (ERRMAX,ABS((T-X)/(1+ABS(T))))
- WRITE(LOUT,'(1X,2F8.2,2F16.12,3F12.6,1P,2D10.1,L3,I3//)')
- 1 A,B,X,T,FA,Y,FB,ABS((T-X)/(1+ABS(T))),EPS,LLM,IC
-
-C CASE 3
-
- IC=3
- T=-1
- A=-2
- B=-0.5D0
- FA=D503F3(A)
- FB=D503F3(B)
- CALL DMINFC(D503F3,A,B,EPS,DELTA,X,Y,LLM)
- ERRMAX = MAX (ERRMAX,ABS((T-X)/(1+ABS(T))))
- WRITE(LOUT,'(1X,2F8.2,2F16.12,3F12.6,1P,2D10.1,L3,I3//)')
- 1 A,B,X,T,FA,Y,FB,ABS((T-X)/(1+ABS(T))),EPS,LLM,IC
-
-C CASE 4
-
- IC=4
- T=1+SQRT(2D0)
- A=1
- B=4
- FA=D503F4(A)
- FB=D503F4(B)
- CALL DMINFC(D503F4,A,B,EPS,DELTA,X,Y,LLM)
- ERRMAX = MAX (ERRMAX,ABS((T-X)/(1+ABS(T))))
- WRITE(LOUT,'(1X,2F8.2,2F16.12,3F12.6,1P,2D10.1,L3,I3//)')
- 1 A,B,X,T,FA,Y,FB,ABS((T-X)/(1+ABS(T))),EPS,LLM,IC
-
-C CASE 5
-
- IC=5
- T=0
- A=-1
- B=1.5D0
- FA=D503F5(A)
- FB=D503F5(B)
- CALL DMINFC(D503F5,A,B,EPS,DELTA,X,Y,LLM)
- ERRMAX = MAX (ERRMAX,ABS((T-X)/(1+ABS(T))))
- WRITE(LOUT,'(1X,2F8.2,2F16.12,3F12.6,1P,2D10.1,L3,I3//)')
- 1 A,B,X,T,FA,Y,FB,ABS((T-X)/(1+ABS(T))),EPS,LLM,IC
-
-C CASE 6
-
- IC=6
- CALL DBZEJY(Z0,2,3,1D-14,Z)
- T=Z(2)
- A=2
- B=12
- FA=D503F6(A)
- FB=D503F6(B)
- CALL DMINFC(D503F6,A,B,EPS,DELTA,X,Y,LLM)
- ERRMAX = MAX (ERRMAX,ABS((T-X)/(1+ABS(T))))
- WRITE(LOUT,'(1X,2F8.2,2F16.12,3F12.6,1P,2D10.1,L3,I3//)')
- 1 A,B,X,T,FA,Y,FB,ABS((T-X)/(1+ABS(T))),EPS,LLM,IC
-
-C CASE 7
-
- IC=7
- T=1/SQRT(3D0)
- A=0
- B=2
- FA=D503F7(A)
- FB=D503F7(B)
- CALL DMINFC(D503F7,A,B,EPS,DELTA,X,Y,LLM)
- ERRMAX = MAX (ERRMAX,ABS((T-X)/(1+ABS(T))))
- WRITE(LOUT,'(1X,2F8.2,2F16.12,3F12.6,1P,2D10.1,L3,I3//)')
- 1 A,B,X,T,FA,Y,FB,ABS((T-X)/(1+ABS(T))),EPS,LLM,IC
-
-C CASE 8
-
- IC=8
- CALL DBZEJY(Z1,1,3,1D-14,Z)
- T=Z(1)/10
- A=0
- B=0.20D0
- FA=D503F8(A)
- FB=D503F8(B)
- CALL DMINFC(D503F8,A,B,EPS,DELTA,X,Y,LLM)
- ERRMAX = MAX (ERRMAX,ABS((T-X)/(1+ABS(T))))
- WRITE(LOUT,'(1X,2F8.2,2F16.12,3F12.6,1P,2D10.1,L3,I3//)')
- 1 A,B,X,T,FA,Y,FB,ABS((T-X)/(1+ABS(T))),EPS,LLM,IC
-
-C CASE 9
-
- IC=9
- T=1
- A=0
- B=3
- FA=D503F9(A)
- FB=D503F9(B)
- CALL DMINFC(D503F9,A,B,EPS,DELTA,X,Y,LLM)
- ERRMAX = MAX (ERRMAX,ABS((T-X)/(1+ABS(T))))
- WRITE(LOUT,'(1X,2F8.2,2F16.12,3F12.6,1P,2D10.1,L3,I3//)')
- 1 A,B,X,T,FA,Y,FB,ABS((T-X)/(1+ABS(T))),EPS,LLM,IC
- WRITE(LOUT,'(/'' Largest Relative Error was'',1P,D10.1)') ERRMAX
-C Check if the test was successful
- IRC=ITEST('D503',ERRMAX .LE. TSTERR)
- CALL PAGEND('D503')
- RETURN
- END
- FUNCTION D503F(X)
-#include "gen/imp64.inc"
-
- ENTRY D503F1(X)
-
- D503F1=-DBESJ1(X)
- RETURN
-
- ENTRY D503F2(X)
-
- D503F2=4*X**2+1/X
- RETURN
-
- ENTRY D503F3(X)
-
- D503F3=-EXP(X+1/X)
- RETURN
-
- ENTRY D503F4(X)
-
- D503F4=(X**2-5*X+6)/(X**2+1)
- RETURN
-
- ENTRY D503F5(X)
-
- D503F5=-COS(X)+LOG(COSH(X))
- RETURN
-
- ENTRY D503F6(X)
-
- D503F6=DBESJ0(X)
- RETURN
-
- ENTRY D503F7(X)
-
- D503F7=X*(X**2-1)
- RETURN
-
- ENTRY D503F8(X)
-
- D503F8=-DBESJ1(10*X)
- RETURN
-
- ENTRY D503F9(X)
-
- D503F9=ABS(X-1)
- RETURN
- END
diff --git a/src/mathlib/gen/tests/d510m.F b/src/mathlib/gen/tests/d510m.F
deleted file mode 100644
index d3e3bf9..0000000
--- a/src/mathlib/gen/tests/d510m.F
+++ /dev/null
@@ -1,151 +0,0 @@
-*
-* $Id: d510m.F,v 1.2 1997/04/07 10:01:05 mclareni Exp $
-*
-* $Log: d510m.F,v $
-* Revision 1.2 1997/04/07 10:01:05 mclareni
-* Mods for winnt
-*
-* Revision 1.1.1.1.2.1 1997/01/21 11:26:23 mclareni
-* All mods for Winnt 96a on winnt branch
-*
-* Revision 1.1.1.1 1996/04/01 15:01:25 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE D510M
-#include "iorc.inc"
- COMMON/G/G(100)/Z/Z(2485)/A/A(100)/PL/PL(100)/SIGMA/SIGMA(100)
- 2/AU/AMX(100)/AL/AMN(100)/ENDFLG/ENDFLG,NA,INDFLG(5)
- 1/R/R(100)/DA/DA(100)/EXDA/EXDA(1500)/NED/NED(2)/DF/DF(100)
-
-C-----FUMILI TEST-CASE
-C-----NO. OF PARAMETERS
- M=3
-C-----NO. OF REDUCTIONS IN STEP PER ITERATION
- N1=1
-C-----NO. OF ITERATIONS BEFORE INCREASE IN STEP SIZE
- N2=1
-C-----MAXIMUM NUMBER OF ITERATIONS
- N3=20
-C-----CRITERION FOR MINIMUM
- EPS=0.1
-C-----PRINTOUT FREQUENCY
- IT=1
-C-----NUMBER OF DATA POINTS
- NED(1)=17
-C-----NUMBER OF COORDINATES PER DATA POINT + 2
- NED(2)=3
-C-----INITIAL VALUES
- A(1)=0.
- A(2)=8.
- A(3)=11.
-C-----UPPER LIMITS
- AMX(1)=1200.
- AMX(3)=11.04
-C-----LOWER LIMITS
- AMN(2)=4.
-C-----INITIAL STEP SIZE
- PL(1)=100.
- PL(2)=4.
- PL(3)=4.
-C-----CO-ORDINATES
- EXDA(1)=10.
- EXDA(2)=.02
- EXDA(3)=1.
- EXDA(4)=18.
- EXDA(5)=.025
- EXDA(6)=4.
- EXDA(7)=40.
- EXDA(8)=.02
- EXDA(9)=6.
- EXDA(10)=74.
- EXDA(11)=.125
- EXDA(12)=7.
- EXDA(13)=82.
- EXDA(14)=.0222
- EXDA(15)=8.
- EXDA(16)=136.
- EXDA(17)=.01
- EXDA(18)=9.
- EXDA(19)=168.
- EXDA(20)=.0083
- EXDA(21)=10.
- EXDA(22)=168.
- EXDA(23)=.0143
- EXDA(24)=11.
- EXDA(25)=160.
- EXDA(26)=.0083
- EXDA(27)=12.
- EXDA(28)=130.
- EXDA(29)=.0182
- EXDA(30)=13.
- EXDA(31)=114.
- EXDA(32)=.01
- EXDA(33)=13.5
- EXDA(34)=120.
- EXDA(35)=.0167
- EXDA(36)=14.
- EXDA(37)=81.
- EXDA(38)=.0222
- EXDA(39)=15.
- EXDA(40)=46.
- EXDA(41)=.02
- EXDA(42)=16.
- EXDA(43)=29.
- EXDA(44)=.0222
- EXDA(45)=17.
- EXDA(46)=2.
- EXDA(47)=.04
- EXDA(48)=18.
- EXDA(49)=.0
- EXDA(50)=.05
- EXDA(51)=20.
- DO 1 I=2,50,3
- 1 EXDA(I)=1./SQRT(EXDA(I))
- CALL FUMILI(S,M,N1,N2,N3,EPS,AKAPPA,ALAMBD,IT,MC)
- CALL ERRORF(M)
-C-----LIKELM TEST-CASE
- M=4
- N1=1
- N2=1
- N3=100
- EPS=0.1
- IT=1
- NED(1)=200
-C-----NUMBER OF CO-ORDINATES PER POINT
- NED(2)=1
- A(1)=-1.
- A(2)=62.8
- A(3)=-0.1
- A(4)=1.57
- AMX(1)=-.2
- AMX(2)=65.0
- AMX(3)=0.
- AMX(4)=5.5
- AMN(1)=-2.0
- AMN(2)=55.0
- AMN(3)=-2.0
- AMN(4)=0.0
- PL(1)=1.
- PL(2)=1.
- PL(3)=.1
- PL(4)=.5
-C-----FUNCT FLAG
- INDFLG(3)=1
- DO 3 I=1,200
- 2 Z(1)=RNDM(-1)
- EXDA(I)=Z(1)
- IF(5.*Z(1).GT.FUNCT(EXDA(I))) GO TO 2
- 3 CONTINUE
- CALL LIKELM(S,M,N1,N2,N3,EPS,AKAPPA,ALAMBD,IT,MC)
- END
- BLOCK DATA
- COMMON/AU/AMX(100)/AL/AMN(100)
-#ifdef CERNLIB_IBM
- DATA AMN,AMX/100*-1.E75,100*1.E75/
-#else
- DATA AMN,AMX/100*-1.E35,100*1.E35/
-#endif
- END
-
diff --git a/src/mathlib/gen/tests/d601m.F b/src/mathlib/gen/tests/d601m.F
deleted file mode 100644
index 54d75b5..0000000
--- a/src/mathlib/gen/tests/d601m.F
+++ /dev/null
@@ -1,101 +0,0 @@
-*
-* $Id: d601m.F,v 1.1.1.1 1996/04/01 15:01:26 mclareni Exp $
-*
-* $Log: d601m.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:26 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE D601M
-C This program tests the operation of GENLIB subroutine subprograms
-C RFRDH1, DFRDH1 and function subprograms
-C RFRDH2, DFRDH2 and RFRDH3, DFRDH3.
-
-#include "gen/imp64.inc"
-C Set the total number of tests
- PARAMETER ( NT=11)
-C Set maximum error allowed for test to be considered successful
- PARAMETER ( TSTERR=1D-11 )
-
- EXTERNAL FD601,G,H
- PARAMETER (IDIM = 96)
- DIMENSION WS(IDIM,50),TV(0:10),NGTV(10)
-#include "iorc.inc"
-
- CALL HEADER('D601',0)
- ERRMAX=0D0
-#if defined(CERNLIB_DOUBLE)
- WRITE(LOUT,'(/8X,''X'',14X,''DFRDH2'',
- + 21X,''TEST'',9X,''Rel. Error'')')
-#endif
-#if !defined(CERNLIB_DOUBLE)
- WRITE(LOUT,'(/8X,''X'',14X,''RFRDH2'',
- + 21X,''TEST'',9X,''Rel. Error'')')
-#endif
-
- EX=1.777777777777774D0
- M=4
- TV(0)=-1
- TV(1)=-0.25D0
- TV(2)=0.1D0
- TV(3)=0.5D0
- TV(4)=1
- NGTV(1)=8
- NGTV(2)=10
- NGTV(3)=9
- NGTV(4)=7
-#if defined(CERNLIB_DOUBLE)
- CALL DFRDH1(FD601,G,M,TV,NGTV,WS,IDIM,N)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- CALL RFRDH1(FD601,G,M,TV,NGTV,WS,IDIM,N)
-#endif
- DO 1 I = -100,100
- X=I/100D0
-#if defined(CERNLIB_DOUBLE)
- PHI=DFRDH2(FD601,G,X,WS,IDIM,N)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- PHI=RFRDH2(FD601,G,X,WS,IDIM,N)
-#endif
- TST=25*X**2/9+6*X+1
- E=ABS((PHI-TST)/TST)
- ERRMAX= MAX(ERRMAX,E)
- 1 WRITE(LOUT,'(1X,F10.2,2F25.15,1P,D10.1)') X,PHI,TST,E
-#if defined(CERNLIB_DOUBLE)
- WRITE(LOUT,'(/12X,''DFRDH3'',10X,''Rel. Error'')')
- DF3=DFRDH3(H,WS,IDIM,N)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- WRITE(LOUT,'(/12X,''RFRDH3'',10X,''Rel. Error'')')
- DF3=RFRDH3(H,WS,IDIM,N)
-#endif
- E=ABS((DF3-EX)/EX)
- ERRMAX= MAX(ERRMAX,E)
-#if defined(CERNLIB_DOUBLE)
- WRITE(LOUT,'(/1X,F25.15,1P,D10.1)') DFRDH3(H,WS,IDIM,N),E
-#endif
-#if !defined(CERNLIB_DOUBLE)
- WRITE(LOUT,'(/1X,F25.15,1P,D10.1)') RFRDH3(H,WS,IDIM,N),E
-#endif
- WRITE(LOUT,'(/'' Largest Relative Error was'',1P,D10.1)') ERRMAX
-C Check if the test was successful
- IRC=ITEST('D601',ERRMAX .LE. TSTERR)
- CALL PAGEND('D601')
- RETURN
- END
-
- FUNCTION FD601(X)
-#include "gen/imp64.inc"
- FD601=(1+X)**2
- RETURN
-
- ENTRY G(X,Y)
- G=X*Y+(X*Y)**2
- RETURN
-
- ENTRY H(T)
- H=T**2
- RETURN
- END
diff --git a/src/mathlib/gen/tests/d705m.F b/src/mathlib/gen/tests/d705m.F
deleted file mode 100644
index fa5547c..0000000
--- a/src/mathlib/gen/tests/d705m.F
+++ /dev/null
@@ -1,82 +0,0 @@
-*
-* $Id: d705m.F,v 1.2 1996/04/17 12:32:09 mclareni Exp $
-*
-* $Log: d705m.F,v $
-* Revision 1.2 1996/04/17 12:32:09 mclareni
-* Add d/rfstft.F (D705) and to Imakefile. cfstft.F becomes D706.
-* In tests, add d705m.F for rfstft and d706m.F for cfstft and the corresponding
-* additions to main.F and Imakefile.
-*
-* Revision 1.1 1996/04/10 16:37:41 mclareni
-* Add test for cfstst (D705), d705m.F, also to main and Imakefile
-*
-*
-C D705 RFSTFT
-
- SUBROUTINE D705M
-
- IMPLICIT COMPLEX (A-H,I,O-Z)
- REAL PI,Y0,Y
- LOGICAL LOK
-
- DIMENSION C0(0:100),Y0(0:100),R(0:100)
- DIMENSION C(0:8),Y(0:17)
- EQUIVALENCE (C,Y)
-
- I=(0.,1.)
- PI=4*ATAN(1.)
-
- LOK=.TRUE.
- DO 10 M1 = -1,4
- IF(M1 .EQ. -1) THEN
- M=3
- N=8
- DO 11 K = 0,N-1
- 11 Y(K)=K+1
- ELSE
- M=M1
- N=2**M
- IF(M .EQ. 0) WRITE(6,'(1X)')
- CALL RANLUX(R,2*N)
- IF(M .EQ. 0) WRITE(6,'(1X)')
- DO 12 K = 0,N-1
- 12 Y(K)=R(K)
- ENDIF
-
- DO 2 J = 0,N-1
- SK=0
- DO 3 K = 0,N-1
- 3 SK=SK+Y(K)*EXP(-I*2*PI*K*J/N)
- 2 C0(J)=SK/N
- CALL RFSTFT(-M,C)
- DO 13 J = 0,N-1
- IF(J .LE. N/2) THEN
- CC=C(J)
- ELSE
- CC=CONJG(C(N-J))
- ENDIF
-C WRITE(6,'(1X,I5,6F10.5)') J,C0(J),CC,C0(J)-CC
- 13 LOK=LOK .AND. ABS(C0(J)-CC) .LT. 0.0021
-
- DO 15 J = 0,N/2
- 15 C(J)=C0(J)
-
- DO 4 K = 0,N-1
- SJ=0
- DO 5 J = 0,N-1
- IF(J .LE. N/2) THEN
- CC=C(J)
- ELSE
- CC=CONJG(C(N-J))
- ENDIF
- 5 SJ=SJ+CC*EXP(I*2*PI*J*K/N)
- 4 Y0(K)=SJ
- CALL RFSTFT(M,C)
- DO 14 K = 0,N-1
-C WRITE(6,'(1X,I5,3F10.5)') J,Y0(K),Y(K),Y0(K)-Y(K)
- 14 LOK=LOK .AND. ABS(Y0(K)-Y(K)) .LT. 0.00025
- 10 CONTINUE
-
- IF(LOK) WRITE(6,'(7X,''D705 RFSTST ** TEST SUCCESFUL **'')')
- IF(.NOT.LOK) WRITE(6,'(7X,''D705 RFSTST ** TEST FAILED **'')')
- END
diff --git a/src/mathlib/gen/tests/d706m.F b/src/mathlib/gen/tests/d706m.F
deleted file mode 100644
index 24269c6..0000000
--- a/src/mathlib/gen/tests/d706m.F
+++ /dev/null
@@ -1,67 +0,0 @@
-*
-* $Id: d706m.F,v 1.1 1996/04/17 12:32:09 mclareni Exp $
-*
-* $Log: d706m.F,v $
-* Revision 1.1 1996/04/17 12:32:09 mclareni
-* Add d/rfstft.F (D705) and to Imakefile. cfstft.F becomes D706.
-* In tests, add d705m.F for rfstft and d706m.F for cfstft and the corresponding
-* additions to main.F and Imakefile.
-*
-*
-C D706 CFSTFT
-
- SUBROUTINE D706M
-
- IMPLICIT COMPLEX (A-H,I,O-Z)
- REAL PI,R
- LOGICAL LOK
-
- DIMENSION A(0:15),AA(0:15),B(0:15)
- DIMENSION R(0:100)
-
- I=(0.,1.)
- PI=4*ATAN(1.)
- C1=-5*(1+I)
- C2=5*(1+I)
-
- LOK=.TRUE.
- DO 10 M1 = -1,4
- IF(M1 .EQ. -1) THEN
- M=3
- N=8
- DO 11 K = 0,N-1
- A(K)=K+1
- 11 B(K)=A(K)
- ELSE
- M=M1
- N=2**M
- IF(M .EQ. 0) WRITE(6,'(1X)')
- CALL RANLUX(R,2*N)
- IF(M .EQ. 0) WRITE(6,'(1X)')
- DO 12 K = 0,N-1
- A(K)=(C1-C2)*(R(K)+I*R(N+K))+C1
- 12 B(K)=A(K)
- ENDIF
-
- DO 2 J = 0,N-1
- SK=0
- DO 3 K = 0,N-1
- 3 SK=SK+A(K)*EXP(-I*2*PI*K*J/N)
- 2 AA(J)=SK
- CALL CFSTFT(-M,B)
- DO 13 J = 0,N-1
- 13 LOK=LOK .AND. ABS(AA(J)-B(J)) .LT. 0.0021
-
- DO 4 K = 0,N-1
- SL=0
- DO 5 J = 0,N-1
- 5 SL=SL+AA(J)*EXP(I*2*PI*J*K/N)
- 4 A(K)=SL/N
- CALL CFSTFT(M,B)
- DO 14 K = 0,N-1
- 14 LOK=LOK .AND. ABS(A(K)-B(K)/N) .LT. 0.00025
- 10 CONTINUE
-
- IF(LOK) WRITE(6,'(7X,''D706 CFSTST ** TEST SUCCESFUL **'')')
- IF(.NOT.LOK) WRITE(6,'(7X,''D706 CFSTST ** TEST FAILED **'')')
- END
diff --git a/src/mathlib/gen/tests/e211m.F b/src/mathlib/gen/tests/e211m.F
deleted file mode 100644
index b53c7cf..0000000
--- a/src/mathlib/gen/tests/e211m.F
+++ /dev/null
@@ -1,199 +0,0 @@
-*
-* $Id: e211m.F,v 1.1.1.1 1996/04/01 15:01:26 mclareni Exp $
-*
-* $Log: e211m.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:26 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE E211M
-#include "iorc.inc"
-C Test of MATHLIB routines RCSPLN,DCSPLN,RCSPNT,DCSPNT (E211)
-C Five individual tests are given: Tests numbers 1 and 2 test the
-C spline fit parameters for the simple cases N=2 and N=3. The
-C expected values can be calculated easily by hand. For ease of
-C calculation, a unitary interval width was taken (ie H=1)
-C Written by T Hepworth, CN division, Cern, Meyrin
- INTEGER DMAX
-C Specify total number of tests
- PARAMETER ( NT=5,DMAX=120,NDIM=120 )
-#include "gen/def64.inc"
- + X(0:DMAX),Y(0:NDIM,1),START(NT),FINISH(NT),
- + A(NDIM,NT),B(NDIM,NT),C(NDIM,NT),D(NDIM,NT),H,
- + SOL(2),EXACT(2),U,V,NUMTOL,ERROR,ERRMAX,TSTERR,
- + FITPAR(4,3),FITXCT(4,3),ALPHA1,ALPHA2
- INTEGER N(NT),M(NT),TESTNO
-
-C Set numerical tolerance for comparison with zero
- PARAMETER ( NUMTOL=1D-10 )
-C Set largest relative error permitted for a successful test
- PARAMETER ( TSTERR=1D-5)
-C Set test parameters, first two test spline-fit parameters, the
-C others test the integrals of the spline function
- DATA START(1),FINISH(1),N(1),M(1) / 1D0, 3D0, 2,1/
- DATA START(2),FINISH(2),N(2),M(2) /-1D0, 2D0, 3,1/
- DATA START(3),FINISH(3),N(3),M(3) / 0D0, 3D0,NDIM,1/
- DATA START(4),FINISH(4),N(4),M(4) / 0D0, 3D0,NDIM,1/
- DATA START(5),FINISH(5),N(5),M(5) /-2D0, 2D0,NDIM,1/
-
- CALL HEADER('E211',0)
- WRITE(LOUT,'(/20X,''Testing the calculated spline-fit '',
- + ''parameters'')')
-C Initialise largest recorded error
- ERRMAX=0D0
- DO 200 TESTNO=1,2
- WRITE(LOUT,'(/'' Test Number '',I2)') TESTNO
- H= ( FINISH(TESTNO)-START(TESTNO) )/ N(TESTNO)
-C NOTE here H should be 1
-C Set up the X nodes as being evenly spaced out
- DO 100 I=0,N(TESTNO)
- X(I)=START(TESTNO)+(I*H)
- IF (TESTNO .EQ. 1) Y(I,1)=EXP(-X(I))
- IF (TESTNO .EQ. 2) Y(I,1)= X(I)*X(I)
-100 CONTINUE
-
- DO 180 MODE=0,1
- IF (MODE .EQ. 0) WRITE(LOUT,'(/'' MODE=0:Natural Spline'')')
- IF (MODE .EQ. 1) WRITE(LOUT,'(/'' MODE=1:'')')
-C Calculate the spline-fit parameters
-#if defined(CERNLIB_DOUBLE)
- CALL DCSPLN(N(TESTNO),X,M(TESTNO),Y,NDIM,MODE,A,B,C,D)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- CALL RCSPLN(N(TESTNO),X,M(TESTNO),Y,NDIM,MODE,A,B,C,D)
-#endif
-C Store the fit parameters in another array for ease of
-C manipulation (these are the calculated parameters)
- DO 120 I=1,N(TESTNO)
- FITPAR(1,I)=A(I,1)
- FITPAR(2,I)=B(I,1)
- FITPAR(3,I)=C(I,1)
- FITPAR(4,I)=D(I,1)
-120 CONTINUE
-
-C Calculate the expected values of the fit parameters (these
-C are stored in FITXCT
- DO 140 I=1,N(TESTNO)
- FITXCT(1,I)=Y(I-1,1)
-140 CONTINUE
- ALPHA1=(Y(2,1)-(2*Y(1,1))+Y(0,1))
- ALPHA2=(Y(3,1)-(2*Y(2,1))+Y(1,1))
- IF (TESTNO .EQ. 1 .AND. MODE .EQ. 0) THEN
- FITXCT(3,1)= 0D0
- FITXCT(3,2)= 3*ALPHA1/4
- FITXCT(4,1)= ALPHA1/4
- FITXCT(4,2)= -ALPHA1/4
- ENDIF
- IF (TESTNO .EQ. 1 .AND. MODE .EQ. 1) THEN
- FITXCT(3,1)= ALPHA1/2
- FITXCT(3,2)= FITXCT(3,1)
- FITXCT(4,1)= 0D0
- FITXCT(4,2)= 0D0
- ENDIF
- IF (TESTNO .EQ. 1) THEN
- FITXCT(2,1)=Y(1,1)-Y(0,1)-FITXCT(3,1)-FITXCT(4,1)
- FITXCT(2,2)=Y(2,1)-Y(1,1)-FITXCT(3,2)-FITXCT(4,2)
- ENDIF
- IF (TESTNO .EQ. 2 .AND. MODE .EQ. 0) THEN
- FITXCT(3,1)= 0D0
- FITXCT(3,2)= (4*ALPHA1-ALPHA2)/5
- FITXCT(3,3)= (4*ALPHA2-ALPHA1)/5
- FITXCT(4,1)= (4*ALPHA1-ALPHA2)/15
- FITXCT(4,2)= (ALPHA2-ALPHA1)/3
- FITXCT(4,3)= (ALPHA1-4*ALPHA2)/15
- ENDIF
- IF (TESTNO .EQ. 2 .AND. MODE .EQ. 1) THEN
- FITXCT(3,1)= (5*ALPHA1-ALPHA2)/8
- FITXCT(3,2)= FITXCT(3,1)
- FITXCT(3,3)= (5*ALPHA2-ALPHA1)/8
- FITXCT(4,1)= 0D0
- FITXCT(4,2)= (ALPHA2-ALPHA1)/4
- FITXCT(4,3)= 0D0
- ENDIF
- IF (TESTNO .EQ. 2) THEN
- FITXCT(2,1)= Y(1,1)-Y(0,1)-FITXCT(3,1)-FITXCT(4,1)
- FITXCT(2,2)= Y(2,1)-Y(1,1)-FITXCT(3,2)-FITXCT(4,2)
- FITXCT(2,3)= Y(3,1)-Y(2,1)-FITXCT(3,3)-FITXCT(4,3)
- ENDIF
- WRITE(LOUT,'('' Param'',15X,''Calculated'',20X,''Exact'',
- + 8X,''Relative Error'')')
- DO 160 I=1,4
- DO 150 J=1,N(TESTNO)
-C Calculate the relative error
- ERROR=ABS( FITXCT(I,J)-FITPAR(I,J) )
- IF (ABS(FITPAR(I,J)) .GE. NUMTOL)
- + ERROR=ERROR/ABS(FITPAR(I,J))
- ERRMAX= MAX( ERRMAX,ERROR )
- WRITE(LOUT,'('' ('',I1,'','',I1,'')'',2F25.16,
- + 1P,D10.1)') I,J,FITPAR(I,J),FITXCT(I,J),ERROR
-150 CONTINUE
-160 CONTINUE
-180 CONTINUE
-200 CONTINUE
-C ****** End of tests one and two that tested the spline-fit ******
-
-
- WRITE(LOUT,'(/25X,''Testing the spline integrals'')')
-C The following tests, check the accuracy of the integrals computed
-C by the routines RCSPNT and DCSPNT, by comparing them with the
-C analytic integral of the function to which a spline is fit.
- DO 500 TESTNO=3,NT
- WRITE(LOUT,'(/'' Test Number'',I3)') TESTNO
- H= ( FINISH(TESTNO)-START(TESTNO) )/ N(TESTNO)
- DO 300 I=0,N(TESTNO)
- X(I)=START(TESTNO)+(I*H)
- IF (TESTNO .EQ. 3) Y(I,1)= EXP(-X(I))
- IF (TESTNO .EQ. 4) Y(I,1)= (X(I)**7)-(6D0*X(I)**4)
- IF (TESTNO .EQ. 5) Y(I,1)= SIN( X(I) )
-300 CONTINUE
-
- DO 400 MODE=0,1
- IF (MODE .EQ. 0) WRITE(LOUT,'(/'' MODE=0:Natural Spline'')')
- IF (MODE .EQ. 1) WRITE(LOUT,'(/'' MODE=1:'')')
-C Calculate the integrals of the spline function
-#if defined(CERNLIB_DOUBLE)
- CALL DCSPNT(N(TESTNO),X,M(TESTNO),Y,NDIM,MODE,A,B,C,D)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- CALL RCSPNT(N(TESTNO),X,M(TESTNO),Y,NDIM,MODE,A,B,C,D)
-#endif
-C Store the integrals in SOL, SOL(2)=double integral
- SOL(1)= A(N(TESTNO),1)
- SOL(2)= B(N(TESTNO),1)
- U= START(TESTNO)
- V= FINISH(TESTNO)
-
-C Compute the integral of the function being approximated
- IF (TESTNO .EQ. 3) THEN
- EXACT(1)=EXP(-U)-EXP(-V)
- EXACT(2)=EXP(-V)+(EXP(-U)*(V-U-1D0))
- ELSEIF (TESTNO .EQ. 4) THEN
- EXACT(1)=((V**8-U**8)/8D0)-(1.2D0*(V**5-U**5))
- EXACT(2)=(V**9/72)-(V**6/5)+( V*(6*U**5/5-U**8/8) )-
- + (U**6)+(U**9/9)
- ELSE
- EXACT(1)= COS(U)-COS(V)
- EXACT(2)= (V-U)*COS(U)+SIN(U)-SIN(V)
- ENDIF
-
-C Compute the relative errors of the integrals
- DO 320 J=1,2
- ERROR= ABS( SOL(J)-EXACT(J) )
- IF (ABS(SOL(J)) .GE. NUMTOL) ERROR=ERROR/ABS(SOL(J))
- IF (J .EQ. 1) WRITE(LOUT,'('' Single integral of'',
- + '' spline function'',5X,F25.16)') SOL(J)
- IF (J .EQ. 2) WRITE(LOUT,'('' Double integral of'',
- + '' spline function'',5X,F25.16)') SOL(J)
- WRITE(LOUT,'('' Integral of function being '',
- + ''approximated'',F25.16)') EXACT(J)
- WRITE(LOUT,'('' Relative Error'',25X,1P,D10.1)') ERROR
- ERRMAX=MAX( ERRMAX,ERROR )
-320 CONTINUE
-400 CONTINUE
-500 CONTINUE
- WRITE(LOUT,'(/'' Largest Error was'',1P,D10.1 )') ERRMAX
- IRC=ITEST('E211',ERRMAX .LE. TSTERR)
- CALL PAGEND('E211')
- RETURN
- END
diff --git a/src/mathlib/gen/tests/e406f1.F b/src/mathlib/gen/tests/e406f1.F
deleted file mode 100644
index fea8cee..0000000
--- a/src/mathlib/gen/tests/e406f1.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: e406f1.F,v 1.1.1.1 1996/04/01 15:01:26 mclareni Exp $
-*
-* $Log: e406f1.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:26 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- FUNCTION E406F1(C,N,X)
-C This function calculates the sum of the Chebyshev series,
-#include "gen/def64.inc"
- + E406F1,C(0:128),X,T
- E406F1=C(0)
- DO 500 K=1,N
- T= COS( K*ACOS(X) )
- E406F1=E406F1+(T*C(K))
-500 CONTINUE
- RETURN
- END
-
diff --git a/src/mathlib/gen/tests/e406f2.F b/src/mathlib/gen/tests/e406f2.F
deleted file mode 100644
index 8513249..0000000
--- a/src/mathlib/gen/tests/e406f2.F
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: e406f2.F,v 1.1.1.1 1996/04/01 15:01:26 mclareni Exp $
-*
-* $Log: e406f2.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:26 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- FUNCTION E406F2(X)
-#include "gen/def64.inc"
- + E406F2,X
- E406F2=EXP(X)
- RETURN
- END
-
diff --git a/src/mathlib/gen/tests/e406f3.F b/src/mathlib/gen/tests/e406f3.F
deleted file mode 100644
index 36cbb38..0000000
--- a/src/mathlib/gen/tests/e406f3.F
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: e406f3.F,v 1.1.1.1 1996/04/01 15:01:26 mclareni Exp $
-*
-* $Log: e406f3.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:26 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- FUNCTION E406F3(X)
-C Here we have to specify an even function
-#include "gen/def64.inc"
- + E406F3,X,NUMTOL
- NUMTOL=1D-10
- IF (ABS(X-0D0) .LT. NUMTOL) THEN
- E406F3=1D0
- ELSE
- E406F3= ATAN(X)/X
- ENDIF
- RETURN
- END
-
diff --git a/src/mathlib/gen/tests/e406f4.F b/src/mathlib/gen/tests/e406f4.F
deleted file mode 100644
index 98931d6..0000000
--- a/src/mathlib/gen/tests/e406f4.F
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: e406f4.F,v 1.1.1.1 1996/04/01 15:01:26 mclareni Exp $
-*
-* $Log: e406f4.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:26 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- FUNCTION E406F4(X)
-C Here we specify an odd function
-#include "gen/def64.inc"
- + E406F4,X
- E406F4=X*X*SIN(X)
- RETURN
- END
diff --git a/src/mathlib/gen/tests/e406m.F b/src/mathlib/gen/tests/e406m.F
deleted file mode 100644
index ccb42db..0000000
--- a/src/mathlib/gen/tests/e406m.F
+++ /dev/null
@@ -1,86 +0,0 @@
-*
-* $Id: e406m.F,v 1.1.1.1 1996/04/01 15:01:26 mclareni Exp $
-*
-* $Log: e406m.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:26 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE E406M
-#include "iorc.inc"
-C Routine to test the MATHLIB routines CHECF and DCHECF (E406)
-C The coefficients of the Chebyshev series are calculated, and the
-C series is evaluated at three points and compared with the value of
-C the function they approximate. T Hepworth, May 16th 1990
-
-C Specify the number of tests
- PARAMETER ( NT=3 )
-#include "gen/def64.inc"
- + A(NT),B(NT),EPS(NT),C(0:128),DELTA,X(3),
- + SOL,EXACT,ERROR,ERRMAX,TSTERR,
- + E406F1,E406F2,E406F3,E406F4
- EXTERNAL E406F2,E406F3,E406F4
-
-C Specify maximum absolute error permitted for a successful test
- PARAMETER ( TSTERR=1D-11 )
-
-C The test parameters
- DATA A(1),B(1),EPS(1) / -1D0, 1D0, 1D-16 /
- DATA A(2),B(2),EPS(2) / -1D0, 1D0, 1D-16 /
- DATA A(3),B(3),EPS(3) / -1D0, 1D0, 1D-16 /
-
- CALL HEADER('E406',0)
-C Initialise largest error term
- ERRMAX=0D0
- DO 100 I=1,NT
- WRITE(LOUT,'(/'' Test Number'',I3)') I
-C Calculate coefficients of Chebyshev series
- IF (I .EQ. 1) THEN
-#if defined(CERNLIB_DOUBLE)
- CALL DCHECF(E406F2,A(I),B(I),EPS(I),C,N,DELTA)
- ELSEIF (I .EQ. 2) THEN
- CALL DCHECF(E406F3,A(I),B(I),EPS(I),C,N,DELTA)
- ELSE
- CALL DCHECF(E406F4,A(I),B(I),EPS(I),C,N,DELTA)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- CALL CHECF(E406F2,A(I),B(I),EPS(I),C,N,DELTA)
- ELSEIF (I .EQ. 2) THEN
- CALL CHECF(E406F3,A(I),B(I),EPS(I),C,N,DELTA)
- ELSE
- CALL CHECF(E406F4,A(I),B(I),EPS(I),C,N,DELTA)
-#endif
- ENDIF
-C Set up positions at which to evaluate the functions
- X(1)=A(I)
- X(2)=0.5D0*( A(I)+B(I) )
- X(3)=B(I)
-
-C Evaluate sum of calculated series at points X1,X2,X3
- DO 50 J=1,3
- SOL=E406F1(C,N,X(J))
- IF (I .EQ. 1) THEN
- EXACT=E406F2(X(J))
- ELSEIF (I .EQ. 2) THEN
- EXACT=E406F3(X(J))
- ELSE
- EXACT=E406F4(X(J))
- ENDIF
-C Calculate Absolute Error
- ERROR= ABS( EXACT-SOL)
- WRITE(LOUT,'('' X='',F10.4,6X,''No Coefficients'',I4,6X,
- + ''Delta'',F25.16)') X(J),N,DELTA
- WRITE(LOUT,'('' Calculated Sum '',F25.16)') SOL
- WRITE(LOUT,'('' Function Value '',F25.16)') EXACT
- WRITE(LOUT,'('' Absolute Error '',F25.16)') ERROR
- ERRMAX=MAX( ERRMAX,ERROR )
- 50 CONTINUE
-100 CONTINUE
- WRITE(LOUT,'(/'' Largest Error was'',1P,D10.1)') ERRMAX
-C Check if the test was successful
- IRC=ITEST('E406',ERRMAX .LE. TSTERR)
- CALL PAGEND('E406')
- RETURN
- END
-
diff --git a/src/mathlib/gen/tests/e407m.F b/src/mathlib/gen/tests/e407m.F
deleted file mode 100644
index a58524c..0000000
--- a/src/mathlib/gen/tests/e407m.F
+++ /dev/null
@@ -1,213 +0,0 @@
-*
-* $Id: e407m.F,v 1.1.1.1 1996/04/01 15:01:26 mclareni Exp $
-*
-* $Log: e407m.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:26 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE E407M
-C Routine to test the MATHLIB routines CHECF and DCHECF (E406)
-C Summation of Chebyshev Series.
-
-#include "gen/imp64.inc"
- DIMENSION X(4),C(0:33,4),N(4)
-
- COMMON/ER/ERRMAX
-#include "iorc.inc"
-
- DATA X /-0.5D0,0.3D0,-0.9D0,0.1D0/, N /20,31,30,33/
- DATA TSTERR/1D-14/
-
-C COEFF FOR EXP(X) -1 <= X <= +1, ...SUM C(N)T(N)(X)
-
- DATA C( 0,1) /1.2660658777520083355982446D0/
- DATA C( 1,1) /1.1303182079849700544153921D0/
- DATA C( 2,1) / .2714953395340765623657051D0/
- DATA C( 3,1) / .0443368498486638049525715D0/
- DATA C( 4,1) / .0054742404420937326502762D0/
- DATA C( 5,1) / .0005429263119139437503621D0/
- DATA C( 6,1) / .0000449773229542951466547D0/
- DATA C( 7,1) / .0000031984364624019905059D0/
- DATA C( 8,1) / .0000001992124806672795726D0/
- DATA C( 9,1) / .0000000110367717255173443D0/
- DATA C(10,1) / .0000000005505896079673747D0/
- DATA C(11,1) / .0000000000249795661698498D0/
- DATA C(12,1) / .0000000000010391522306786D0/
- DATA C(13,1) / .0000000000000399126335641D0/
- DATA C(14,1) / .0000000000000014237580108D0/
- DATA C(15,1) / .0000000000000000474092610D0/
- DATA C(16,1) / .0000000000000000014801801D0/
- DATA C(17,1) / .0000000000000000000434992D0/
- DATA C(18,1) / .0000000000000000000012074D0/
- DATA C(19,1) / .0000000000000000000000318D0/
- DATA C(20,1) / .0000000000000000000000008D0/
-
-C COEFF FOR ARCTAN(X)/X -1 <= X <= +1, ...SUM C(N)T(2N)(X)
-
- DATA C( 0,2) / .8813735870195430252326093D0/
- DATA C( 1,2) /-.1058929245467058552584637D0/
- DATA C( 2,2) / .0111358420594055299138723D0/
- DATA C( 3,2) /-.0013811950036003977146939D0/
- DATA C( 4,2) / .0001857429732785420087542D0/
- DATA C( 5,2) /-.0000262151961127332694683D0/
- DATA C( 6,2) / .0000038210365944894531171D0/
- DATA C( 7,2) /-.0000005699186166576665323D0/
- DATA C( 8,2) / .0000000864887786445082819D0/
- DATA C( 9,2) /-.0000000133033839756249329D0/
- DATA C(10,2) / .0000000020685057635866255D0/
- DATA C(11,2) /-.0000000003244863920937630D0/
- DATA C(12,2) / .0000000000512796625558139D0/
- DATA C(13,2) /-.0000000000081547875603392D0/
- DATA C(14,2) / .0000000000013038071918812D0/
- DATA C(15,2) /-.0000000000002094297848694D0/
- DATA C(16,2) / .0000000000000337782083636D0/
- DATA C(17,2) /-.0000000000000054676499774D0/
- DATA C(18,2) / .0000000000000008878874409D0/
- DATA C(19,2) /-.0000000000000001445980916D0/
- DATA C(20,2) / .0000000000000000236097132D0/
- DATA C(21,2) /-.0000000000000000038639904D0/
- DATA C(22,2) / .0000000000000000006337335D0/
- DATA C(23,2) /-.0000000000000000001041412D0/
- DATA C(24,2) / .0000000000000000000171441D0/
- DATA C(25,2) /-.0000000000000000000028270D0/
- DATA C(26,2) / .0000000000000000000004669D0/
- DATA C(27,2) /-.0000000000000000000000772D0/
- DATA C(28,2) / .0000000000000000000000128D0/
- DATA C(29,2) /-.0000000000000000000000021D0/
- DATA C(30,2) / .0000000000000000000000004D0/
- DATA C(31,2) /-.0000000000000000000000001D0/
-
-C COEFF FOR ARCTAN(X) -1 <= X <= +1, ...SUM C(N)T(2N+1)(X)
-
- DATA C( 0,3) / .8284271247461900976033775D0/
- DATA C( 1,3) /-.0473785412436501626722957D0/
- DATA C( 2,3) / .0048773235279025660995892D0/
- DATA C( 3,3) /-.0005977260151609278529698D0/
- DATA C( 4,3) / .0000797638885829043696430D0/
- DATA C( 5,3) /-.0000111970797591219081756D0/
- DATA C( 6,3) / .0000016255589889158932924D0/
- DATA C( 7,3) /-.0000002417149190065791252D0/
- DATA C( 8,3) / .0000000365926973344416745D0/
- DATA C( 9,3) /-.0000000056174391060191537D0/
- DATA C(10,3) / .0000000008720096857464312D0/
- DATA C(11,3) /-.0000000001366033647689746D0/
- DATA C(12,3) / .0000000000215624374977373D0/
- DATA C(13,3) /-.0000000000034254901842290D0/
- DATA C(14,3) / .0000000000005471887035059D0/
- DATA C(15,3) /-.0000000000000878257882529D0/
- DATA C(16,3) / .0000000000000141552791931D0/
- DATA C(17,3) /-.0000000000000022898812683D0/
- DATA C(18,3) / .0000000000000003716446746D0/
- DATA C(19,3) /-.0000000000000000604941892D0/
- DATA C(20,3) / .0000000000000000098728614D0/
- DATA C(21,3) /-.0000000000000000016151285D0/
- DATA C(22,3) / .0000000000000000002647961D0/
- DATA C(23,3) /-.0000000000000000000434986D0/
- DATA C(24,3) / .0000000000000000000071586D0/
- DATA C(25,3) /-.0000000000000000000011800D0/
- DATA C(26,3) / .0000000000000000000001948D0/
- DATA C(27,3) /-.0000000000000000000000322D0/
- DATA C(28,3) / .0000000000000000000000053D0/
- DATA C(29,3) /-.0000000000000000000000009D0/
- DATA C(30,3) / .0000000000000000000000001D0/
-
-C COEFF FOR 1/(1 + X) 0 <= X <= +1, ...SUM C(N)T*(N)(X)
-
- DATA C( 0,4) / .7071067811865475244008444D0/
- DATA C( 1,4) /-.2426406871192851464050662D0/
- DATA C( 2,4) / .0416305603426158296287083D0/
- DATA C( 3,4) /-.0071426749364098313671837D0/
- DATA C( 4,4) / .0012254892758431585743939D0/
- DATA C( 5,4) /-.0002102607186491200791795D0/
- DATA C( 6,4) / .0000360750360515619006832D0/
- DATA C( 7,4) /-.0000061894976602513249199D0/
- DATA C( 8,4) / .0000010619499099460488361D0/
- DATA C( 9,4) /-.0000001822017994249680967D0/
- DATA C(10,4) / .0000000312608866037597441D0/
- DATA C(11,4) /-.0000000053635201975903677D0/
- DATA C(12,4) / .0000000009202345817824620D0/
- DATA C(13,4) /-.0000000001578872931044043D0/
- DATA C(14,4) / .0000000000270891768439637D0/
- DATA C(15,4) /-.0000000000046477679593778D0/
- DATA C(16,4) / .0000000000007974309123030D0/
- DATA C(17,4) /-.0000000000001368175144401D0/
- DATA C(18,4) / .0000000000000234741743376D0/
- DATA C(19,4) /-.0000000000000040275315853D0/
- DATA C(20,4) / .0000000000000006910151743D0/
- DATA C(21,4) /-.0000000000000001185594603D0/
- DATA C(22,4) / .0000000000000000203415875D0/
- DATA C(23,4) /-.0000000000000000034900647D0/
- DATA C(24,4) / .0000000000000000005988004D0/
- DATA C(25,4) /-.0000000000000000001027379D0/
- DATA C(26,4) / .0000000000000000000176270D0/
- DATA C(27,4) /-.0000000000000000000030243D0/
- DATA C(28,4) / .0000000000000000000005189D0/
- DATA C(29,4) /-.0000000000000000000000890D0/
- DATA C(30,4) / .0000000000000000000000153D0/
- DATA C(31,4) /-.0000000000000000000000026D0/
- DATA C(32,4) / .0000000000000000000000005D0/
- DATA C(33,4) /-.0000000000000000000000001D0/
-
- CALL HEADER('E407',0)
-C Initialise largest error
- ERRMAX=0D0
-#if defined(CERNLIB_DOUBLE)
- WRITE(LOUT,'(/9X,''X'',19X,''DCHSUM'',34X,''TEST'',11X,
- +''Error'')')
-#endif
-#if !defined(CERNLIB_DOUBLE)
- WRITE(LOUT,'(/9X,''X'',19X,'' CHSUM'',34X,''TEST'',11X,
- +''Error'')')
-#endif
- CALL TE407(X,N,C)
- WRITE(LOUT,'(/'' Largest Error was'',1P,D10.1)') ERRMAX
-C Check if the test was successful
- IRC=ITEST('E407',ERRMAX .LE. TSTERR)
- CALL PAGEND('E407')
- RETURN
- END
- SUBROUTINE TE407(X,N,C)
-#include "gen/imp64.inc"
- DIMENSION X(4),C(0:33,4),N(4)
- COMMON/ER/ERRMAX
-#include "iorc.inc"
-#if defined(CERNLIB_DOUBLE)
- R=DCHSUM(1,C(0,1),N(1),X(1))
-#endif
-#if !defined(CERNLIB_DOUBLE)
- R= CHSUM(1,C(0,1),N(1),X(1))
-#endif
- T=EXP(X(1))
- ERRMAX=MAX(ERRMAX,ABS(R-T))
- WRITE(LOUT,100) X(1),R,T,R-T
-#if defined(CERNLIB_DOUBLE)
- R=DCHSUM(2,C(0,2),N(2),X(2))
-#endif
-#if !defined(CERNLIB_DOUBLE)
- R= CHSUM(2,C(0,2),N(2),X(2))
-#endif
- T=ATAN(X(2))/X(2)
- ERRMAX=MAX(ERRMAX,ABS(R-T))
- WRITE(LOUT,100) X(2),R,T,R-T
-#if defined(CERNLIB_DOUBLE)
- R=DCHSUM(3,C(0,3),N(3),X(3))
-#endif
-#if !defined(CERNLIB_DOUBLE)
- R= CHSUM(3,C(0,3),N(3),X(3))
-#endif
- T=ATAN(X(3))
- ERRMAX=MAX(ERRMAX,ABS(R-T))
- WRITE(LOUT,100) X(3),R,T,R-T
-#if defined(CERNLIB_DOUBLE)
- R=DCHSUM(4,C(0,4),N(4),X(4))
-#endif
-#if !defined(CERNLIB_DOUBLE)
- R= CHSUM(4,C(0,4),N(4),X(4))
-#endif
- T=1/(1+X(4))
- ERRMAX=MAX(ERRMAX,ABS(R-T))
- WRITE(LOUT,100) X(4),R,T,R-T
- 100 FORMAT(1X,F10.1,2F35.25,1P,D10.1/)
- END
diff --git a/src/mathlib/gen/tests/e408m.F b/src/mathlib/gen/tests/e408m.F
deleted file mode 100644
index a66b460..0000000
--- a/src/mathlib/gen/tests/e408m.F
+++ /dev/null
@@ -1,229 +0,0 @@
-*
-* $Id: e408m.F,v 1.5 1998/11/05 10:41:34 mclareni Exp $
-*
-* $Log: e408m.F,v $
-* Revision 1.5 1998/11/05 10:41:34 mclareni
-* Use cpp defines instead of statement functions for Linux also
-*
-* Revision 1.4 1997/10/24 14:48:23 mclareni
-* For NT, use cpp macro instead of statement function
-*
-* Revision 1.3 1997/09/02 16:09:42 mclareni
-* WINNT corrections
-*
-* Revision 1.2 1997/04/07 10:01:06 mclareni
-* Mods for winnt
-*
-* Revision 1.1.1.1.2.1 1997/01/21 11:26:23 mclareni
-* All mods for Winnt 96a on winnt branch
-*
-* Revision 1.1.1.1 1996/04/01 15:01:26 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE E408M
-C E408 RCHPWS, DCHPWS, RPWCHS, DPWCHS
-#if defined(CERNLIB_DOUBLE)
-#include "gen/imp64.inc"
-#endif
-
-#include "gen/def128.inc"
- + QX,QA,QB,Q1
-
-#include "iorc.inc"
-
- LOGICAL LOK
- CHARACTER*50 TXT(3)
-
- DIMENSION QB(0:100),CH(0:100),PW(0:100),CH1(0:100),PW1(0:100)
-
- PARAMETER (R1 = 1, Q1 = 1)
-
- DATA TXT(1) /'EXP(X) (-1 <= X <= 1) LUKE 3.2.2(4)'/
- DATA TXT(2) /'EXP(-X**2) (-1 <= X <= 1) LUKE 3.2.2(8)'/
- DATA TXT(3) /'J_1(X) (-1 <= X <= 1) LUKE 9.7(7)'/
-
-#if !defined(CERNLIB_WINNT) && !defined(CERNLIB_LINUX)
-# if defined(CERNLIB_DOUBLE)
- GVSUM(N,B,C) = DVSUM(N,B,C)
- GGAMMA(A) = DGAMMA(A)
-# endif
-# if !defined(CERNLIB_DOUBLE)
- GVSUM(A,B,C) = RVSUM(A,B,C)
- GGAMMA(A) = GAMMA(A)
-# endif
-#else
-# if defined(CERNLIB_DOUBLE)
-# define GVSUM(N,B,C) DVSUM(N,B,C)
-# define GGAMMA(A) DGAMMA(A)
-# endif
-# if !defined(CERNLIB_DOUBLE)
-# define GVSUM(N,B,C) RVSUM(N,B,C)
-# define GGAMMA(A) GAMMA(A)
-# endif
-#endif /* CERNLIB_WINNT */
-
- CALL HEADER('E408',0)
-
-#if (defined(CERNLIB_DOUBLE))&&(defined(CERNLIB_VAXVMS))
- EPS=3D-13
-#endif
-#if (defined(CERNLIB_DOUBLE))&&(!defined(CERNLIB_VAXVMS))
- EPS=3D-14
-#endif
-#if !defined(CERNLIB_DOUBLE)
- EPS=3E-14
-#endif
- LOK=.TRUE.
-
- NDIG=18
-#if defined(CERNLIB_WINNT)
- EPS=3E-11
-#endif
- NL=20
- QX=1
- QA=0
-#if (defined(CERNLIB_QUAD))&&(defined(CERNLIB_DOUBLE))
- CALL QBSIA(QX,QA,NL,NDIG,QB)
-#endif
-#if defined(CERNLIB_NOQUAD)||!defined(CERNLIB_DOUBLE)
- CALL DBSIA(QX,QA,NL,NDIG,QB)
-#endif
- CH(0)=QB(0)
- DO 1 N = 1,NL
- 1 CH(N)=2*QB(N)
- DO 2 N = 0,NL
- 2 PW(N)=1/GGAMMA(N+R1)
-
-#if defined(CERNLIB_DOUBLE)
- CALL DCHPWS(NL,CH,PW1)
- CALL DPWCHS(NL,PW,CH1)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- CALL RCHPWS(NL,CH,PW1)
- CALL RPWCHS(NL,PW,CH1)
-#endif
- SCP=GVSUM(NL+1,CH(0),CH(1))
- SPC=GVSUM(NL+1,PW(0),PW(1))
- SCP1=GVSUM(NL+1,CH1(0),CH1(1))
- SPC1=GVSUM(NL+1,PW1(0),PW1(1))
- LOK=LOK .AND. ABS(SCP-SCP1)+ABS(SPC-SPC1) .LT. EPS
- WRITE(LOUT,'(A1,5X,A50//)') '1',TXT(1)
- WRITE(LOUT,'(1X,I5,4F25.15)') (N,CH(N),CH1(N),PW(N),PW1(N),N=0,NL)
- WRITE(LOUT,'(1X)')
- WRITE(LOUT,'(1X,5X,4F25.15)') SCP,SCP1,SPC,SPC1
-
- NL=40
- QX=Q1/2
- QA=0
- EQA=EXP(-QX)
-#if (defined(CERNLIB_QUAD))&&(defined(CERNLIB_DOUBLE))
- CALL QBSIA(QX,QA,NL,NDIG,QB)
-#endif
-#if defined(CERNLIB_NOQUAD)||!defined(CERNLIB_DOUBLE)
- CALL DBSIA(QX,QA,NL,NDIG,QB)
-#endif
- CH(0)=EQA*QB(0)
- DO 3 N = 1,NL
- IF(MOD(N,2) .EQ. 0) CH(N)=EQA*2*(-1)**(N/2)*QB(N/2)
- IF(MOD(N,2) .EQ. 1) CH(N)=0
- 3 CONTINUE
- DO 4 N = 0,NL
- IF(MOD(N,2) .EQ. 0) PW(N)=(-1)**(N/2)/GGAMMA(N/2+R1)
- IF(MOD(N,2) .EQ. 1) PW(N)=0
- 4 CONTINUE
-
- WRITE(LOUT,'(1X)')
-#if defined(CERNLIB_DOUBLE)
- CALL DCHPWS(NL,CH,PW1)
- CALL DPWCHS(NL,PW,CH1)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- CALL RCHPWS(NL,CH,PW1)
- CALL RPWCHS(NL,PW,CH1)
-#endif
- SCP=GVSUM(NL+1,CH(0),CH(1))
- SPC=GVSUM(NL+1,PW(0),PW(1))
- SCP1=GVSUM(NL+1,CH1(0),CH1(1))
- SPC1=GVSUM(NL+1,PW1(0),PW1(1))
- WRITE(LOUT,'(A1,5X,A50//)') '1',TXT(2)
- WRITE(LOUT,'(1X,I5,4F25.15)') (N,CH(N),CH1(N),PW(N),PW1(N),N=0,NL)
- WRITE(LOUT,'(1X)')
- WRITE(LOUT,'(1X,5X,4F25.15)') SCP,SCP1,SPC,SPC1
- LOK=LOK .AND. ABS(SCP-SCP1)+ABS(SPC-SPC1) .LT. EPS
-
-#if !defined(CERNLIB_VAX)
- NL=50
-#endif
-#if defined(CERNLIB_VAX)
- NL=40
-#endif
- QX=4
- QA=0
-#if (defined(CERNLIB_QUAD))&&(defined(CERNLIB_DOUBLE))
- CALL QBSJA(QX,QA,NL,NDIG,QB)
-#endif
-#if defined(CERNLIB_NOQUAD)||!defined(CERNLIB_DOUBLE)
- CALL DBSJA(QX,QA,NL,NDIG,QB)
-#endif
- CH(0)=0
- DO 5 N = 1,NL
- IF(MOD(N,2) .EQ. 0) CH(N)=0
- IF(MOD(N,2) .EQ. 1) CH(N)=2*(-1)**(N/2)*QB(N/2)*QB(N/2+1)
- 5 CONTINUE
- DO 6 N = 0,NL
- IF(MOD(N,2) .EQ. 0) PW(N)=0
- IF(MOD(N,2) .EQ. 1)
- 1 PW(N)=(-1)**(N/2)*QX**N/(GGAMMA(N/2+R1)*GGAMMA(N/2+2*R1))
- 6 CONTINUE
-
- WRITE(LOUT,'(1X)')
-#if defined(CERNLIB_DOUBLE)
- CALL DCHPWS(NL,CH,PW1)
- CALL DPWCHS(NL,PW,CH1)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- CALL RCHPWS(NL,CH,PW1)
- CALL RPWCHS(NL,PW,CH1)
-#endif
- SCP=GVSUM(NL+1,CH(0),CH(1))
- SPC=GVSUM(NL+1,PW(0),PW(1))
- SCP1=GVSUM(NL+1,CH1(0),CH1(1))
- SPC1=GVSUM(NL+1,PW1(0),PW1(1))
- WRITE(LOUT,'(A1,5X,A50//)') '1',TXT(3)
- WRITE(LOUT,'(1X,I5,4F25.15)') (N,CH(N),CH1(N),PW(N),PW1(N),N=0,NL)
- WRITE(LOUT,'(1X)')
- WRITE(LOUT,'(1X,5X,4F25.15)') SCP,SCP1,SPC,SPC1
- LOK=LOK .AND. ABS(SCP-SCP1)+ABS(SPC-SPC1) .LT. EPS
-
- WRITE(LOUT,'(1X)')
-#if defined(CERNLIB_DOUBLE)
- IF(LOK) WRITE(LOUT,
- 1 '(7X,''E408 DCHPWS/DPWCHS ** TEST SUCCESSFUL **'')')
- IF(.NOT.LOK) WRITE(LOUT,
- 1 '(7X,''E408 DCHPWS/DPWCHS ** TEST FAILED **'')')
-#endif
-#if !defined(CERNLIB_DOUBLE)
- IF(LOK) WRITE(LOUT,
- 1 '(7X,''E408 RCHPWS/RPWCHS ** TEST SUCCESSFUL **'')')
- IF(.NOT.LOK) WRITE(LOUT,
- 1 '(7X,''E408 RCHPWS/RPWCHS ** TEST FAILED **'')')
-#endif
-
- IRC= ITEST('E408', LOK )
-
- WRITE(LOUT,'(1X)')
-#if defined(CERNLIB_DOUBLE)
- CALL DCHPWS(-1,CH,PW1)
- CALL DPWCHS(101,PW,CH1)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- CALL RCHPWS(-1,CH,PW1)
- CALL RPWCHS(101,PW,CH1)
-#endif
-
- CALL PAGEND('E408')
-
- END
-
diff --git a/src/mathlib/gen/tests/f106m.F b/src/mathlib/gen/tests/f106m.F
deleted file mode 100644
index ea7e601..0000000
--- a/src/mathlib/gen/tests/f106m.F
+++ /dev/null
@@ -1,88 +0,0 @@
-*
-* $Id: f106m.F,v 1.1.1.1 1996/04/01 15:01:26 mclareni Exp $
-*
-* $Log: f106m.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:26 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE F106M
-#include "iorc.inc"
-C This program tests the GENLIB routine SPXINV (F106) which inverts
-C a packed real symmetric matrix. We check the validity of the
-C inverse by checking that the inverse multiplied by the original
-C matrix gives the identity matrix.
-C T Hepworth April 1990
-
-C Define the order of the matrix
- PARAMETER ( N=8 )
-C Set the numerical tolerance for comparisons in computed identity
- PARAMETER (TSTERR=1E-4)
-C Define the packed matrices
- REAL A( (N*(N+1))/2 ),B( (N*(N+1))/2 )
-C Define the unpacked matrices
- REAL C(N,N),D(N,N),E(N,N),ERROR(N,N)
-
-C A and B are going to hold a packed symmetric matrix of order N
- DATA A/ 9, 2, 2, 1, 0, 0, 2, 6,
- + 0,-2, 5,-9, 1, 3,-7,
- + -3, 7,-7, 2, 4, 1,
- + -5, 5, 1, 2, 9,
- + 2,-1, 4, 0,
- + 9,-8, 9,
- + 7, 4,
- + 3/
-C Set B the same as A, B is to hold inverse of A
- DATA B/ 9, 2, 2, 1, 0, 0, 2, 6,
- + 0,-2, 5,-9, 1, 3,-7,
- + -3, 7,-7, 2, 4, 1,
- + -5, 5, 1, 2, 9,
- + 2,-1, 4, 0,
- + 9,-8, 9,
- + 7, 4,
- + 3/
-C Open up input file
- CALL SPXINV(B,N,IFAIL)
-C Unpack the initial matrix A in C and unpack B in D
- K=1
- DO 200 I=1,N
- DO 100 J=I,N
- C(I,J)=A(K)
- D(I,J)=B(K)
- K=K+1
- C(J,I)=C(I,J)
- D(J,I)=D(I,J)
- 100 CONTINUE
- 200 CONTINUE
- WRITE(LOUT,*) 'PRINTING C'
- CALL F106S1(N,C)
- WRITE(LOUT,*) 'PRINTING COMPUTED INVERSE'
- CALL F106S1(N,D)
- WRITE(LOUT,'('' IFAIL RETURNED AS '',I2)') IFAIL
-
-C Compute A (unpacked in c) multiplied by its inverse (unpacked in D
-C This should give the identity matrix (unpacked in E)
- CALL F106S2(N,C,D,E)
-C Check accuracy of computed identity
- ERRMAX=ABS(E(1,1)-1)
- DO 400 I=1,N
- DO 300 J=1,N
-C Check for diagonal term
- IF (I .EQ. J) THEN
- ERROR(I,J)=ABS( E(I,J)-1 )
- ELSE
- ERROR(I,J)=ABS( E(I,J) )
- ENDIF
- ERRMAX=MAX(ERRMAX,ERROR(I,J))
-300 CONTINUE
-400 CONTINUE
- WRITE(LOUT,'('' PRINTING MATRIX OF RESIDUES'')')
- CALL F106S1(N,ERROR)
- WRITE(LOUT,'('' LARGEST ERROR WAS'',F16.8)') ERRMAX
-C Check if the test was successful
- IRC=ITEST('F106',ERRMAX .LE. TSTERR)
- CALL PAGEND('F106')
- RETURN
- END
-
diff --git a/src/mathlib/gen/tests/f106s1.F b/src/mathlib/gen/tests/f106s1.F
deleted file mode 100644
index a164fc4..0000000
--- a/src/mathlib/gen/tests/f106s1.F
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: f106s1.F,v 1.1.1.1 1996/04/01 15:01:27 mclareni Exp $
-*
-* $Log: f106s1.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:27 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE F106S1(N,Z)
-#include "iorc.inc"
-C Subroutine to print an nxn matrix Z
- REAL Z(N,N)
- DO 1000 I=1,N
- WRITE(LOUT,'(8F10.6)') (Z(I,J),J=1,N)
-1000 CONTINUE
- RETURN
- END
-
diff --git a/src/mathlib/gen/tests/f106s2.F b/src/mathlib/gen/tests/f106s2.F
deleted file mode 100644
index a6d7a82..0000000
--- a/src/mathlib/gen/tests/f106s2.F
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: f106s2.F,v 1.1.1.1 1996/04/01 15:01:27 mclareni Exp $
-*
-* $Log: f106s2.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:27 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE F106S2(N,A,B,C)
-#include "iorc.inc"
-C Subroutine to multiply together two nxn matrices, result in C
- REAL A(N,N),B(N,N),C(N,N)
- DO 2200 I=1,N
- DO 2100 J=1,N
- SUM=A(I,1)*B(1,J)
- DO 2000 K=2,N
- SUM=SUM+(A(I,K)*B(K,J))
-2000 CONTINUE
- C(I,J)=SUM
-2100 CONTINUE
-2200 CONTINUE
- RETURN
- END
diff --git a/src/mathlib/gen/tests/f500m.F b/src/mathlib/gen/tests/f500m.F
deleted file mode 100644
index 69fe4cd..0000000
--- a/src/mathlib/gen/tests/f500m.F
+++ /dev/null
@@ -1,195 +0,0 @@
-*
-* $Id: f500m.F,v 1.1.1.1 1996/04/01 15:01:27 mclareni Exp $
-*
-* $Log: f500m.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:27 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE F500M
-C Routine to test MATHLIB routines LIHOIN and DLHOIN (F500)
-
-#include "imp64r.inc"
- DIMENSION A(10,5),V(10,200),W(200,9),IW(10,5),VEX(5,12)
- DIMENSION RA(10,5),RV(10,200),RW(200,9), RVEX(5,12)
- CHARACTER*6 TFUNC(2)
-C
-C Set numerical tolerance for testing the S/D versions
- DIMENSION TOL(2)
-C
- LOGICAL LTEST
-#include "iorc.inc"
-
- DATA TFUNC/'LIHOIN','DLHOIN'/
- DATA TOL / 2.5E-4,5D-14 /
- DATA ((A(M,N),N=1,5),M=1,8)
- 1/0.799217D0, 0.864099D0, 0.160325D0, 0.632229D0, 0.052457D0,
- 2 0.466098D0, 0.375965D0, 0.596879D0, 0.271234D0, 0.072917D0,
- 3 0.796017D0, 0.887416D0, 0.650871D0, 0.039460D0, 0.048344D0,
- 4 0.367939D0, 0.400156D0, 0.476228D0, 0.457051D0, 0.462931D0,
- 5 0.845622D0, 0.513245D0, 0.942230D0, 0.099140D0, 0.553517D0,
- 6 0.341419D0, 0.891279D0, 0.227223D0, 0.340023D0, 0.059538D0,
- 7 0.800058D0, 0.926708D0, 0.638934D0, 0.819688D0, 0.514403D0,
- 8 0.464460D0, 0.330900D0, 0.811808D0, 0.546348D0, 0.262904D0/
-
-C EXPECTED BASIS VECTORS FOR THE SOLUTION CONE
- DATA ((VEX(J,I2),I2=1,5),J=1,5)
-
- 1/-0.732290871847036298D0, -0.154490269566318200D0,
- + -0.248447009410866809D0, 0.603094116303552258D-01,
- + -0.676429284103394493D0,
- 2 0.535581612163871346D0, -0.180491575844838492D0,
- + -0.210781762391387129D0, -0.242767482388277327D-01,
- + 0.684953103756224022D0,
- 3 0.129390501061007232D0, 0.600373662682449918D0,
- + 0.601145677483211682D0, -0.108069617055684991D0,
- + 0.132250293830252885D0,
- 4 0.129470286575879057D0, 0.346207409819890718D0,
- + 0.494252918736763788D0, -0.975633811030188203D-01,
- + -0.130917430628470680D0,
- 5 0.378679229494564881D0, -0.680622834028829282D0,
- + -0.536826842586525341D0, 0.987206036702031942D0,
- + 0.196604057439148341D0/
-
- DATA ((VEX(J,I2),I2=6,10),J=1,5)
- 1/-0.594082455642258978D0, 0.684220921741165333D0,
- + 0.769376015413755734D0, 0.722702075073820269D0,
- + 0.719048970141879351D0,
- 2 0.690988384516715806D0, -0.205362932956947006D0,
- + -0.274742879649470098D0, -0.272359708519578095D0,
- + -0.260191716186908159D0,
- 3 0.280984500838489942D0, -0.585114665380818008D0,
- + -0.463981615366753003D0, -0.533017910350517043D0,
- + -0.552518579171327837D0,
- 4 -0.250852799957625633D0, 0.376671040883367961D0,
- + 0.289681547873183579D0, 0.345509268642835973D0,
- + 0.307485624105918898D0,
- 5 -0.166498262462426147D0, 0.736719168688070997D-01,
- + -0.182708944530430906D0, -0.609527575959959485D-02,
- + 0.124276546477221417D0/
-
- DATA ((VEX(J,I2),I2=11,12),J=1,5)
- 1/ 0.543935549074644184D0 , 0.282577951934201557D0 ,
- 2 0.478104193435539837D-01, 0.456540211213636001D-01,
- 3 0.161601990099711323D0 ,-0.145844342725903978D0 ,
- 4 -0.806937572581633192D0 ,-0.451687199603527226D0 ,
- 5 0.156795513350776114D0 , 0.832330170572528699D0/
-
- CALL HEADER('F500',0)
- LTEST=.TRUE.
-C
-C Set intermediate stage printing on/off
- IF (LOUT .EQ. 6) THEN
- IOUT=1
- ELSE
- IOUT=0
- ENDIF
-C--- Number of functions to test
-#if !defined(CERNLIB_DOUBLE)
- NF=1
-#endif
-#if defined(CERNLIB_DOUBLE)
- NF=2
-#endif
-C
- DO 200 JF=1,NF
-
- WRITE(LOUT,'(/7X,''TESTING SUBROUTINE'',5X,A6/)')TFUNC(JF)
- ERMAX=0D0
- RERMAX=0E0
- MA=10
- NV=10
- M=8
- N=5
- MAXV=200
- EPS=1D-13
- REPS=1E-5
-C IOUT=1
- WRITE(LOUT,100)
- WRITE(LOUT,'(1X,I9,5F15.6)') (MM,(A(MM,NN),NN=1,N),MM=1,M)
- WRITE(LOUT,'(1X)')
- DO 111 J1=1,8
- DO 111 J2=1,5
- 111 RA(J1,J2)=A(J1,J2)
-#if !defined(CERNLIB_DOUBLE)
- CALL LIHOIN(RA,MA,M,N,MAXV,RV,NV,NVEC,EPS,IOUT,RW,IW)
-#endif
-#if defined(CERNLIB_DOUBLE)
- IF(JF.EQ.1)
- +CALL LIHOIN(RA,MA,M,N,MAXV,RV,NV,NVEC,REPS,IOUT,RW,IW)
- IF(JF.EQ.2)
- +CALL DLHOIN(A,MA,M,N,MAXV,V,NV,NVEC,EPS,IOUT,W,IW)
-#endif
- WRITE(LOUT,101)
- DO 1 I = 1,NVEC,5
- DO 2 J = 1,N
- DO 222 II = I,MIN(NVEC,I+4)
- RVEX(J,II)=VEX(J,II)
-#if !defined(CERNLIB_DOUBLE)
- RERMAX=MAX( ERMAX,(RV(J,II)-RVEX(J,II))/RVEX(J,II))
-#endif
-#if defined(CERNLIB_DOUBLE)
- IF(JF.EQ.1)THEN
- RERMAX=MAX(RERMAX,(RV(J,II)-RVEX(J,II))/RVEX(J,II))
- ERMAX=RERMAX
- ELSE
- ERMAX=MAX(ERMAX,(V(J,II)-VEX(J,II))/VEX(J,II))
- ENDIF
-#endif
- 222 CONTINUE
-#if !defined(CERNLIB_DOUBLE)
- WRITE(LOUT,'(1X,I9,5F15.6)') J,(RV(J,I2),I2=I,MIN(NVEC,I+4))
-#endif
-#if defined(CERNLIB_DOUBLE)
- IF(JF.EQ.1)
- +WRITE(LOUT,'(1X,I9,5F15.6)') J,(RV(J,I2),I2=I,MIN(NVEC,I+4))
- IF(JF.EQ.2)
- +WRITE(LOUT,'(1X,I9,5F15.6)') J,(V(J,I2),I2=I,MIN(NVEC,I+4))
-#endif
- 2 CONTINUE
- 1 WRITE(LOUT,'(1X)')
- WRITE(LOUT,102)
- WRITE(LOUT,'(1X,9X,8I8)') (IW(MM,1),MM=1,M)
-#if !defined(CERNLIB_DOUBLE)
- ETOL=TOL(JF+1)
-#endif
-#if defined(CERNLIB_DOUBLE)
- ETOL=TOL(JF )
-#endif
- WRITE(LOUT,'(1X)')
- LTEST=LTEST.AND.(ERMAX.LE.ETOL)
-#if defined(CERNLIB_DOUBLE)
- IF(JF.EQ.2)THEN
- WRITE(LOUT,'(/7X,''Largest DLHOIN Error was'',1P,D10.1)')ERMAX
- ELSE
- WRITE(LOUT,'(/7X,''Largest LIHOIN Error was'',1P,D10.1)')RERMAX
- ENDIF
-#endif
-#if !defined(CERNLIB_DOUBLE)
- WRITE(LOUT,'(/7X,''Largest LIHOIN Error was'',1P,D10.1)') ERMAX
-#endif
-200 CONTINUE
- WRITE(LOUT,'(/7X,''TESTING ERROR MESSAGES:''/)')
-#if !defined(CERNLIB_VAX)
- CALL LIHOIN(A,MA,M,N,0,V,NV,NVEC,EPS,IOUT,W,IW)
-#endif
-#if (defined(CERNLIB_DOUBLE))&&(!defined(CERNLIB_VAX))
- CALL DLHOIN(A,MA,M,N,0,V,NV,NVEC,EPS,IOUT,W,IW)
-#endif
- DO 3 NN = 1,N
- RA(1,NN)=0
- 3 A(1,NN)=0
- CALL LIHOIN(RA,MA,M,N,MAXV,RV,NV,NVEC,REPS,IOUT,RW,IW)
-#if defined(CERNLIB_DOUBLE)
- CALL DLHOIN(A,MA,M,N,MAXV,V,NV,NVEC,EPS,IOUT,W,IW)
-#endif
- 100 FORMAT(1X,10X,'THE MATRIX OF COEFFICIENTS'/)
- 101 FORMAT(1X,10X,'THE BASIS VECTORS FOR THE SOLUTION CONE'/)
- 102 FORMAT(/1X,10X,'THE VECTOR SHOWING REDUNDANT INEQUALITIES'/)
-
- WRITE(LOUT,'(1X)')
- IRC=ITEST('F500',LTEST)
- CALL PAGEND('F500')
- RETURN
- END
diff --git a/src/mathlib/gen/tests/fc346.F b/src/mathlib/gen/tests/fc346.F
deleted file mode 100644
index 0a56689..0000000
--- a/src/mathlib/gen/tests/fc346.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: fc346.F,v 1.1.1.1 1996/04/01 15:01:19 mclareni Exp $
-*
-* $Log: fc346.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:19 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- FUNCTION FC346(T)
-#include "imp64r.inc"
- COMMON /PARAMT/ AKP,A,B,P,FMODE
-
- ENTRY F1EL1(T)
- F1EL1=1/SQRT((1+T**2)*(1+(AKP*T)**2))
- RETURN
-
- ENTRY F1EL2(T)
- F1EL2=(A+B*T**2)/((1+T**2)*SQRT((1+T**2)*(1+FMODE*(AKP*T)**2)))
- RETURN
- END
diff --git a/src/mathlib/gen/tests/funct.F b/src/mathlib/gen/tests/funct.F
deleted file mode 100644
index 26b48c7..0000000
--- a/src/mathlib/gen/tests/funct.F
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: funct.F,v 1.1.1.1 1996/04/01 15:01:26 mclareni Exp $
-*
-* $Log: funct.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:26 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- FUNCTION FUNCT(X)
-C-----FUNCT CALCULATES THEORETICAL FUNCTION Y AT EACH DATA POINT
- COMMON/A/A(100)/ENDFLG/ENDFLG,NA,INDFLG(5)
- COMPLEX B,C
- EQUIVALENCE (B,A(1)),(C,A(3))
- IF(INDFLG(3)) 2,1,2
-C-----FUNCT FOR FUMILI
- 1 FUNCT=(A(1)/(SQRT(6.2832)*A(2)))*EXP(-((X-A(3))**2)/
- 1(2.*(A(2)**2)))
- RETURN
-C-----FUNCT FOR LIKELM
- 2 FUNCT=(EXP(A(1)*X)+AIMAG(CEXP(B*X+C)))/
- 1 ((EXP(A(1))-1.)/A(1)+AIMAG((CEXP(B+C)-CEXP(C))/B))
- RETURN
- END
diff --git a/src/mathlib/gen/tests/g100m.F b/src/mathlib/gen/tests/g100m.F
deleted file mode 100644
index fbe97c8..0000000
--- a/src/mathlib/gen/tests/g100m.F
+++ /dev/null
@@ -1,96 +0,0 @@
-*
-* $Id: g100m.F,v 1.1.1.1 1996/04/01 15:01:27 mclareni Exp $
-*
-* $Log: g100m.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:27 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE G100M
-C Routine to test MATHLIB routine PROB (G100)
-
-#include "gen/imp64.inc"
- REAL PROB,CH2,R,H,E,ERMAX
- LOGICAL LTEST
- PARAMETER (NMAX = 6)
-c DIMENSION NN(NMAX),ZU(50),ZG(50)
- DIMENSION NN(NMAX)
-
- PARAMETER (R0 = 0, R1 = 1, R2 = 2, HF = R1/2, TH = R1/3)
- PARAMETER (F1 = 2*R1/9)
-
-#include "iorc.inc"
-
- DATA NN /1,5,10,50,75,110/
-C Set numerical tolerance for test to be successful
- DATA TOL / 1E-3/
-
-#if defined(CERNLIB_DOUBLE)
- FQ(U)=DERFC(U/SQRT(R2))/2
-#endif
-#if !defined(CERNLIB_DOUBLE)
- FQ(U)=ERFC(U/SQRT(R2))/2
-#endif
- FZ(U)=EXP(-U**2/2)/SQRT(2*PI)
- CALL HEADER('G100',0)
- LTEST=.TRUE.
-
- WRITE (LOUT,'(/5X,''X'',7X,''DF'',11X,''PROB'',16X,
- +''TEST'',9X,''Error'')')
- ERMAX=0E0
- PI = 3.14159 26535 89793D0
- DO 11 N1 = 1,NMAX
- WRITE(LOUT,'(1X)')
- N=NN(N1)
- DO 12 ICH2 = 0,50
- DCH2=ICH2
- IF(N .GT. 70) DCH2=2*DCH2
- X=DCH2/2
- CH2=DCH2
- R=PROB(CH2,N)
- IF(N .EQ. 1) THEN
-#if defined(CERNLIB_DOUBLE)
- H=DERFC(SQRT(X))
-#endif
-#if !defined(CERNLIB_DOUBLE)
- H= ERFC(SQRT(X))
-#endif
- ELSE
- S=1
- T=1
- M=N/2
- IF(2*M .EQ. N) THEN
- DO 1 I = 1,M-1
- T=X*T/I
- 1 S=S+T
- H=SQRT(2*PI)*FZ(SQRT(DCH2))*S
- ELSE
- DO 2 I=1,M-1
- T=T*DCH2/(2*I+1)
- 2 S=S+T
- W=SQRT(DCH2)
- H=2*FQ(W)+2*FZ(W)*W*S
- ENDIF
- ENDIF
- IF (R .GT. 1E-3)THEN
- E=ABS((H-R)/R)
- ELSE
- E=ABS(H-R)
- ENDIF
- ERMAX=MAX(ERMAX,E)
- WRITE(LOUT,'(1X,I5,F10.1,1P,2E20.8,E10.1)') N,CH2,R,H,E
- IF(R .LT. 5D-8) GO TO 11
- 12 CONTINUE
- 11 CONTINUE
- LTEST=LTEST.AND.(ERMAX.LE.TOL)
- WRITE(LOUT,'(/7X,''Largest Error was'',1P,E10.1)')ERMAX
- WRITE(LOUT,'(/7X,''TESTING ERROR MESSAGES:''/)')
- R=PROB(2E0,0)
- R=PROB(2E0,-1)
- R=PROB(-2E0,1)
- WRITE(LOUT,'(1X)')
- IRC=ITEST('G100',LTEST)
- CALL PAGEND('G100')
- RETURN
- END
diff --git a/src/mathlib/gen/tests/g101m.F b/src/mathlib/gen/tests/g101m.F
deleted file mode 100644
index a13c3be..0000000
--- a/src/mathlib/gen/tests/g101m.F
+++ /dev/null
@@ -1,99 +0,0 @@
-*
-* $Id: g101m.F,v 1.1.1.1 1996/04/01 15:01:27 mclareni Exp $
-*
-* $Log: g101m.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:27 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE G101M
-C Routine to test MATHLIB routine CHISIN (G101)
-
-#include "gen/imp64.inc"
-
- REAL CHISIN,P,E,R,T,ERMAX
- LOGICAL LTEST
- EXTERNAL FZR
- COMMON /FORFZR/ DPP
- COMMON /FIG101/ FNORM,EX
- COMMON /NNG101/ N
-#include "iorc.inc"
- PARAMETER (Z0 = 0, Z1 = 1, Z2 = 2, HF = Z1/2)
-
-C Set numerical tolerance for test to be successful
- DATA TOL / 1E-3/
-
- CALL HEADER('G101',0)
- LTEST=.TRUE.
- ERMAX=0E0
- WRITE (LOUT,'(/5x,''N'',8X,''P'',9x,''CHISIN'',9X,
- +''TEST'',7X,''Error'')')
- DO 1 N = 1,10
- WRITE(LOUT,'(1X)')
-#if defined(CERNLIB_DOUBLE)
- FNORM=1/(Z2**(HF*N)*DGAMMA(HF*N))
-#endif
-#if !defined(CERNLIB_DOUBLE)
- FNORM=1/(Z2**(HF*N)* GAMMA(HF*N))
-#endif
- EX=HF*N-1
- DO 1 IP = 0,9
- DPP=IP/10D0
- P=DPP
- R=CHISIN(P,N)
- DR=R
- T=0
-#if defined(CERNLIB_DOUBLE)
- IF(P .GT. 0) T=DZEROX(-0.015+DR,DR+0.015,5D-8,500,FZR,1)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- IF(P .GT. 0) T= ZEROX(-0.015+DR,DR+0.015,5D-8,500,FZR,1)
-#endif
- E=0
- IF(R .NE. 0) E=ABS((R-T)/R)
- ERMAX=MAX(ERMAX,E)
- 1 WRITE(LOUT,'(1X,I5,F10.1,2F15.7,1P,D10.1)') N,P,R,T,E
- LTEST=LTEST.AND.(ERMAX.LE.TOL)
- WRITE(LOUT,'(/7X,''Largest Error was'',1P,D10.1)')ERMAX
- WRITE(LOUT,'(/7X,''TESTING ERROR MESSAGES:''/)')
- R=CHISIN(-1.,1)
- R=CHISIN(+2.,1)
- R=CHISIN(+0.5,-1)
- WRITE(LOUT,'(1X)')
- IRC=ITEST('G101',LTEST)
- CALL PAGEND('G101')
- RETURN
- END
- FUNCTION FZR(X)
-#include "gen/imp64.inc"
- COMMON /FORFZR/ DPP
- COMMON /NNG101/ N
- EXTERNAL FG101
-
- IF(N .EQ. 1) THEN
-#if defined(CERNLIB_DOUBLE)
- FZR=DERF(SQRT(X/2))-DPP
-#endif
-#if !defined(CERNLIB_DOUBLE)
- FZR= ERF(SQRT(X/2))-DPP
-#endif
- ELSEIF(N .EQ. 2) THEN
- FZR=1-EXP(-X/2)-DPP
- ELSE
-#if defined(CERNLIB_DOUBLE)
- FZR=DGAUSS(FG101,0D0,X,1D-10)-DPP
-#endif
-#if !defined(CERNLIB_DOUBLE)
- FZR= GAUSS(FG101,0D0,X,1D-10)-DPP
-#endif
- ENDIF
- RETURN
- END
- FUNCTION FG101(T)
-#include "gen/imp64.inc"
- COMMON /FIG101/ FNORM,EX
-
- FG101=FNORM*T**EX*EXP(-0.5D0*T)
- RETURN
- END
diff --git a/src/mathlib/gen/tests/g102m.F b/src/mathlib/gen/tests/g102m.F
deleted file mode 100644
index 37e2453..0000000
--- a/src/mathlib/gen/tests/g102m.F
+++ /dev/null
@@ -1,43 +0,0 @@
-*
-* $Id: g102m.F,v 1.1.1.1 1996/04/01 15:01:28 mclareni Exp $
-*
-* $Log: g102m.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:28 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE G102M
-C Routine to test MATHLIB routine PROBKL (G102)
-
- LOGICAL LTEST
-#include "iorc.inc"
-C Set numerical tolerance for test to be successful
- DATA TOL / 1E-5/
- CALL HEADER('G102',0)
- LTEST=.TRUE.
- ERMAX=0E0
- WRITE (LOUT,'(/8X,''X'',6X,''PROBKL'',9X,''TEST'',
- +10X,''Error'')')
- DO 1 I = 1,40,5
- X=I/10.
- R=PROBKL(X)
- T=0
- DO 2 J = 1,50
- A=-1*((-1)**(J)*EXP(-2*(J*X)**2))
- T=T+A
- IF(ABS(A) .LE. 1E-10*R) GO TO 3
- 2 CONTINUE
- 3 T=2*T
- E=0
- IF(R .NE. 0) E=ABS((R-T)/R)
- ERMAX=MAX(ERMAX,E)
- WRITE(LOUT,'(1X,F10.2,1P,2E15.7,E10.1)') X,R,T,E
- 1 CONTINUE
- LTEST=LTEST.AND.(ERMAX.LE.TOL)
- WRITE(LOUT,'(/7X,''Largest Error was'',1P,D10.1)')ERMAX
- WRITE(LOUT,'(1X)')
- IRC=ITEST('G102',LTEST)
- CALL PAGEND('G102')
- RETURN
- END
diff --git a/src/mathlib/gen/tests/g104m.F b/src/mathlib/gen/tests/g104m.F
deleted file mode 100644
index 7831b6c..0000000
--- a/src/mathlib/gen/tests/g104m.F
+++ /dev/null
@@ -1,65 +0,0 @@
-*
-* $Id: g104m.F,v 1.1.1.1 1996/04/01 15:01:29 mclareni Exp $
-*
-* $Log: g104m.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:29 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE G104M
-C Test of MATHLIB routines STUDIS and STUDIN (G104)
-C Routine STUDIS calculates t-table values P1, for parameters T1 say,
-C the test of STUDIS is constructed by comparing this values with
-C exact t-table values obtained from using high-precision
-C Gaussian quadrature.
-C STUDIN calculates for a specified probability P say, the value
-C of the test statistic t, T2 say, that gives the specified
-C probability under a t-distribution. The test of STUDIN is
-C simply to compare T2 with T1.
-C Note that the program library manual quotes 0 as the lower limit
-C of the t-integral, this should be minus infinity.
-
-C Specify the total number of tests present
- PARAMETER ( NT=5 )
- REAL T1,T2,P,P1,ERROR,ERRMX1,ERRMX2,ERRMAX,STUDIS,STUDIN,TSTERR
-C Specify the largest relative error permitted in a successful test
- PARAMETER ( TSTERR=1E-4 )
- DIMENSION P(NT),T1(NT)
- INTEGER N(NT)
-#include "iorc.inc"
- DATA T1 / 0.1, 0.2, 0.5, 0.9, 3.0 /
- DATA P / 0.5317255174305536,0.5700140042014005,
- + 0.6742760175759245,0.7904972403959577,0.9849503760512686 /
- DATA N / 1,2,3,4,5 /
-
- CALL HEADER('G104',0)
-C Testing routine STUDIS
- ERRMX1= 0D0
- WRITE(LOUT,'(/4X,''t'',3X,''n'',8X,''STUDIS(t,n)'',8X,
- + ''Exact Value'',5X,''Relative Error'')')
- DO 100 I=1,NT
- P1= STUDIS( T1(I),N(I) )
- ERROR= ABS( (P(I)-P1)/P1 )
- WRITE(LOUT,'(F5.1,3X,I1,3F19.12)') T1(I),N(I),P1,P(I),ERROR
- ERRMX1= MAX( ERRMX1,ERROR )
-100 CONTINUE
-
-C Testing routine STUDIN
- ERRMX2= 0D0
- WRITE(LOUT,'(/15X,''P'',3X,''n'',8X,''STUDIN(P,n) Exact'',5X,
- + ''Relative Error'')')
- DO 200 I=1,NT
- T2= STUDIN( P(I),N(I) )
- ERROR= ABS( (T1(I)-T2)/T2 )
- WRITE(LOUT,'(F16.12,3X,I1,F19.12,F7.1,F19.12)') P(I),N(I),
- + T2,T1(I),ERROR
- ERRMX2= MAX( ERRMX2,ERROR )
-200 CONTINUE
-
- ERRMAX=MAX( ERRMX1,ERRMX2 )
- WRITE(LOUT,'(/'' Largest relative Error was'',F19.12)') ERRMAX
- IRC= ITEST( 'G104',ERRMAX .LE. TSTERR )
- CALL PAGEND('G104')
- RETURN
- END
diff --git a/src/mathlib/gen/tests/g105m.F b/src/mathlib/gen/tests/g105m.F
deleted file mode 100644
index a72f622..0000000
--- a/src/mathlib/gen/tests/g105m.F
+++ /dev/null
@@ -1,72 +0,0 @@
-*
-* $Id: g105m.F,v 1.1.1.1 1996/04/01 15:01:29 mclareni Exp $
-*
-* $Log: g105m.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:29 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE G105M
-C Routine to test MATHLIB routines GAUSIN and DGAUSN (G105)
-#include "gen/def64.inc"
- + DFREQ,DR,DP,DT,DGAUSN,ERRMAX,TSTERR
- LOGICAL LTEST
- DIMENSION TSTERR(2)
-#include "iorc.inc"
- DATA TSTERR/1D-6,1D-14/
- CALL HEADER('G105',0)
- LTEST= .TRUE.
- ERRMAX= 0D0
-#if defined(CERNLIB_DOUBLE)
- WRITE(LOUT,'(/8X,''P'',9X,''GAUSIN'',10X,''DFREQ'',10X,
- +''Error'')')
-#endif
-#if !defined(CERNLIB_DOUBLE)
- WRITE(LOUT,'(/8X,''P'',12X,''GAUSIN'',21X,'' FREQ'',17X,
- +''Error'')')
-#endif
- DO 1 IP = 5,995,5
- DP=0.001D0*IP
- P=DP
- R=GAUSIN(P)
-#if defined(CERNLIB_DOUBLE)
- DT=DFREQ(DBLE(R))
-#endif
-#if !defined(CERNLIB_DOUBLE)
- DT= FREQ(R)
-#endif
- ERRMAX=MAX(ERRMAX,ABS(DP-DT))
- WRITE(LOUT,'(1X,F10.3,3F15.7)') P,R,DT,DP-DT
- 1 CONTINUE
- WRITE(LOUT,'(/''GAUSIN Largest Error:'',1P,D10.1)')ERRMAX
-#if defined(CERNLIB_DOUBLE)
- LTEST= LTEST .AND. ERRMAX .LE. TSTERR(1)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- LTEST= LTEST .AND. ERRMAX .LE. TSTERR(2)
-#endif
-#if defined(CERNLIB_DOUBLE)
- WRITE(LOUT,'(/8X,''P'',12X,''DGAUSN'',21X,''DFREQ'',17X,
- +''Error'')')
- ERRMAX= 0D0
- DO 2 IP = 2,998,2
- DP=0.001D0*IP
- DR=DGAUSN(DP)
- DT=DFREQ(DR)
- ERRMAX=MAX(ERRMAX,ABS(DP-DT))
- WRITE(LOUT,'(1X,F10.3,3F25.15)') DP,DR,DT,DP-DT
- 2 CONTINUE
- WRITE(LOUT,'(/''DGAUSN Largest Error:'',1P,D10.1)')ERRMAX
- LTEST= LTEST .AND. ERRMAX .LE. TSTERR(1)
-#endif
- WRITE(LOUT,'(/7X,''TESTING ERROR MESSAGES:''/)')
-#if defined(CERNLIB_DOUBLE)
- R=DGAUSN(3D0)
-#endif
- R=GAUSIN(3.)
- WRITE(LOUT,'(1X,F15.7)') R
- IRC= ITEST('G105',LTEST)
- CALL PAGEND('G105')
- RETURN
- END
diff --git a/src/mathlib/gen/tests/g106m.F b/src/mathlib/gen/tests/g106m.F
deleted file mode 100644
index 481584f..0000000
--- a/src/mathlib/gen/tests/g106m.F
+++ /dev/null
@@ -1,57 +0,0 @@
-*
-* $Id: g106m.F,v 1.1.1.1 1996/04/01 15:01:29 mclareni Exp $
-*
-* $Log: g106m.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:29 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE G106M
-C This program tests the GENLIB routine GAMDIS (G106)
-
- EXTERNAL FG106
- PARAMETER ( TSTERR=5E-5 )
- COMMON /AAG106/ A
-#include "iorc.inc"
-
- CALL HEADER('G106',0)
-C Initialise maximum error
- ERRMAX=0.0
- WRITE(LOUT,'(/6X,''X'',6X,''A'',5X,''Calculated'',7X,
- + ''Test'',10X,''Error'')')
- DO 1 IX = 0,100,2
- X=0.1*IX
- IF(IX .EQ. 0) X=0.01
- IF(IX .NE. 0)WRITE(LOUT,'(//)')
- DO 1 IA = 0,500,50
- A=0.01*IA
- IF(IA .EQ. 0) A=0.01
- P=GAMDIS(X,A)
- X0=MIN(X,0.1)
- TP=X0**A/A
- U=TP
- DO 9 K = 0,6
- U=-U*X0*(K+A)/((K+1+A)*(K+1))
- 9 TP=TP+U
- TP=(TP+GAUSS(FG106,X0,X,P*5E-6))/GAMMA(A)
- IF(P .NE. 0)ERR=ABS((P-TP)/P)
- IF(P .EQ. 0)ERR=ABS(P-TP)
- ERRMAX=MAX(ERRMAX,ERR)
- WRITE(LOUT,'(1X,2F7.2,2E15.6,1P,D10.1)') X,A,P,TP,ERR
- 1 CONTINUE
- WRITE(LOUT,'(/7X,''TESTING ERROR MESSAGES:''/)')
- P=GAMDIS(-1.,0.)
- WRITE(LOUT,'(/'' Largest Error was'',1P,D10.1)') ERRMAX
-
-C Check if the test was successful
- IRC=ITEST('G106',ERRMAX .LE. TSTERR)
- CALL PAGEND('G106')
- RETURN
- END
- FUNCTION FG106(T)
- COMMON /AAG106/ A
-
- FG106=EXP(-T)*T**(A-1)
- RETURN
- END
diff --git a/src/mathlib/gen/tests/g110m.F b/src/mathlib/gen/tests/g110m.F
deleted file mode 100644
index 7673c5e..0000000
--- a/src/mathlib/gen/tests/g110m.F
+++ /dev/null
@@ -1,129 +0,0 @@
-*
-* $Id: g110m.F,v 1.1.1.1 1996/04/01 15:01:30 mclareni Exp $
-*
-* $Log: g110m.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:30 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE G110M
-C This routine tests the package of subroutines LANDAU (G110)
-C The six functions DENLAN, DISLAN, DIFLAN, XM1LAN, XM2LAN, RANLAN
-C are all tested for various values of the parameter X
-C Set largest relative error permitted for successful test
-
- DIMENSION X1(15),X3(10),R1E(15),R2E(15),R3E(15),RE(-1:10),
- + X1E(10),X2E(10)
- LOGICAL LTEST
- PARAMETER ( TSTERR=5E-5 )
-#include "iorc.inc"
- DATA (X1(I),I=1,15)
- 1/-6.,-4.,-2.,-1.5,0.4,1.5,3.,5.,8.,15.,30.,100.,500.,1000.,10000./
-
- DATA (X3(I),I=1,10)
- 1/-6.,-4.,-2.,0.5,4.,10.,20.,60.,100.,500./
-
-
- DATA (R1E(I),R2E(I),R3E(I),I=1,15)/
-#if (!defined(CERNLIB_VAX))&&(!defined(CERNLIB_QIEEE))
-C These three numbers are too small for the Vax and for QIEEE
- + 0.1705125E-63 , 0.1145071E-65 , 0.2522112E-61,
-#endif
-#if defined(CERNLIB_VAX)||defined(CERNLIB_QIEEE)
- + 0E0 , 0E0 ,0E0 ,
-#endif
- + 0.3389938E-08 , 0.1648393E-09 , 0.6640147E-07,
- + 0.4398549E-01 , 0.1409436E-01 , 0.9809309E-01,
- + 0.1005507E+00 , 0.4982426E-01 , 0.1172569E+00,
- + 0.1687040E+00 , 0.3565814E+00 ,-0.3329862E-01,
- + 0.1242211E+00 , 0.5183430E+00 ,-0.4082071E-01,
- + 0.7424766E-01 , 0.6642060E+00 ,-0.2538776E-01,
- + 0.3916338E-01 , 0.7730271E+00 ,-0.1152962E-01,
- + 0.1809028E-01 , 0.8534598E+00 ,-0.4055079E-02,
- + 0.5401332E-02 , 0.9232939E+00 ,-0.7258360E-03,
- + 0.1298670E-02 , 0.9632503E+00 ,-0.8989537E-04,
- + 0.1076111E-03 , 0.9895709E+00 ,-0.2208708E-05,
- + 0.4085715E-05 , 0.9979767E+00 ,-0.1648340E-07,
- + 0.1012057E-05 , 0.9989935E+00 ,-0.2034224E-08,
- + 0.1001660E-07 , 0.9998999E+00 ,-0.2004778E-11/
-
- DATA (RE(I),I=-1,10)/
- + -0.345390E+01,
- + -0.256661E+01,
- + -0.108254E+01,
- + -0.474905E+00,
- + 0.817656E-01,
- + 0.673583E+00,
- + 0.136656E+01,
- + 0.225775E+01,
- + 0.354898E+01,
- + 0.581236E+01,
- + 0.118083E+02,
- + 0.561444E+03/
-c + 0.986920E+06/
-
- DATA (X1E(I),X2E(I),I=1,10)/
- + -0.6006671E+01 , 0.3608014E+02,
- + -0.4046505E+01 , 0.1637619E+02,
- + -0.2258286E+01 , 0.5146864E+01,
- + -0.6293224E+00 , 0.9086789E+00,
- + 0.6111705E+00 , 0.2720909E+01,
- + 0.1608095E+01 , 0.9648612E+01,
- + 0.2394375E+01 , 0.2186150E+02,
- + 0.3592685E+01 , 0.6772610E+02,
- + 0.4129987E+01 , 0.1113155E+03,
- + 0.5778184E+01 , 0.5259707E+03/
-
- CALL HEADER('G110',0)
- ERMAX=0
- LTEST= .TRUE.
- WRITE(LOUT,101)
-#if (!defined(CERNLIB_VAX))&&(!defined(CERNLIB_QIEEE))
- DO 1 I = 1,15
-#endif
-#if defined(CERNLIB_VAX)||defined(CERNLIB_QIEEE)
- DO 1 I = 2,15
-#endif
- R1=DENLAN(X1(I))
- R2=DISLAN(X1(I))
- R3=DIFLAN(X1(I))
- ER1=ABS((R1-R1E(I))/R1E(I))
- ER2=ABS((R2-R2E(I))/R2E(I))
- ER3=ABS((R3-R3E(I))/R3E(I))
- ERMAX=MAX(ERMAX,ER1,ER2,ER3)
- WRITE(LOUT,'(5X,F10.1,3E16.7)') X1(I),R1,R2,R3
- 1 CONTINUE
- LTEST=LTEST .AND. ERMAX .LE. TSTERR
-
- WRITE(LOUT,102)
- DO 2 I = -1,10
- X=0.1*FLOAT(I)+0.0014
- IF(I .EQ. -1) X=0.000001
- IF(I .EQ. 10) X=0.9982
-c IF(I .EQ. 11) X=0.999999
- R=RANLAN(X)
- ER=ABS((R-RE(I))/RE(I))
- ERMAX=MAX(ERMAX,ER)
- WRITE(LOUT,'(5X,F15.6,E20.6)') X,R
- 2 CONTINUE
- LTEST=LTEST .AND. ERMAX .LE. TSTERR
-
- WRITE(LOUT,103)
- DO 3 I = 1,10
- R1=XM1LAN(X3(I))
- R2=XM2LAN(X3(I))
- ER4=ABS((R1-X1E(I))/X1E(I))
- ER5=ABS((R2-X2E(I))/X2E(I))
- ERMAX=MAX(ERMAX,ER4,ER5)
- WRITE(LOUT,'(5X,F10.1,2E16.7)') X3(I),R1,R2
- 3 CONTINUE
- LTEST=LTEST .AND. ERMAX .LE. TSTERR
- 101 FORMAT(///9X,'LAMBDA',6X,'DENLAN',10X,'DISLAN',10X,'DIFLAN'/)
- 102 FORMAT(///16X,'X',13X,'RANLAN'/)
- 103 FORMAT(///12X,'X',8X,'XM1LAN',10X,'XM2LAN'/)
- WRITE(LOUT,'(/'' Largest Relative Error was'',1P,E10.1)') ERMAX
- IRC=ITEST('G110',LTEST)
- CALL PAGEND('G110')
- RETURN
- END
diff --git a/src/mathlib/gen/tests/g115m.F b/src/mathlib/gen/tests/g115m.F
deleted file mode 100644
index cf3ca6b..0000000
--- a/src/mathlib/gen/tests/g115m.F
+++ /dev/null
@@ -1,79 +0,0 @@
-*
-* $Id: g115m.F,v 1.1.1.1 1996/04/01 15:01:30 mclareni Exp $
-*
-* $Log: g115m.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:30 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE G115M
-C G115 VAVLOV (MONTAGNA & ROTONDI, ADAPTED BY KSK)
-
-#include "iorc.inc"
-
- LOGICAL LOK
- DIMENSION RK(5,0:3),RL(5,0:3),RB(5,0:3),VV(5,0:3)
-
-C DENSITY
-
- DATA RK(1,0),RL(1,0),RB(1,0),VV(1,0) /0.01, 4. , 0.1, 5.4016E-2/
- DATA RK(2,0),RL(2,0),RB(2,0),VV(2,0) /0.04, -1. , 0.7, 1.7579E-1/
- DATA RK(3,0),RL(3,0),RB(3,0),VV(3,0) /0.2 , 2.5, 0. , 1.0826E-1/
- DATA RK(4,0),RL(4,0),RB(4,0),VV(4,0) /0.24, 5.5, 0.8, 6.4414E-3/
- DATA RK(5,0),RL(5,0),RB(5,0),VV(5,0) /7. , -3.8, 0.6, 2.5655E-2/
-
-C DISTRIBUTION
-
- DATA RK(1,1),RL(1,1),RB(1,1),VV(1,1) /0.015, 1.5, 0.3, 5.2739E-1/
- DATA RK(2,1),RL(2,1),RB(2,1),VV(2,1) /0.1 ,12. , 0.4, 9.9107E-1/
- DATA RK(3,1),RL(3,1),RB(3,1),VV(3,1) /0.2 ,-0.5, 0.9, 3.6634E-1/
- DATA RK(4,1),RL(4,1),RB(4,1),VV(4,1) /0.28 ,-2. , 0.5, 2.2229E-2/
- DATA RK(5,1),RL(5,1),RB(5,1),VV(5,1) /1. , 0. , 0. , 6.8794E-1/
-
-C RANDOM NUMBERS (VAVRND)
-
- DATA RK(1,2),RL(1,2),RB(1,2),VV(1,2) /0.015,0.53, 0.4, 1.5172/
- DATA RK(2,2),RL(2,2),RB(2,2),VV(2,2) /0.1 ,0.19, 0.7,-0.8591/
- DATA RK(3,2),RL(3,2),RB(3,2),VV(3,2) /0.2 ,0.98, 0.9, 4.4897/
- DATA RK(4,2),RL(4,2),RB(4,2),VV(4,2) /0.28 ,0.02, 0.1,-1.9712/
- DATA RK(5,2),RL(5,2),RB(5,2),VV(5,2) /1. ,0.72, 0. , 0.1003/
-
-C RANDOM NUMBERS (VAVRAN)
-
- DATA RK(1,3),RL(1,3),RB(1,3),VV(1,3) /0.015,0.53, 0.4, 1.5177/
- DATA RK(2,3),RL(2,3),RB(2,3),VV(2,3) /0.1 ,0.19, 0.7,-0.8589/
- DATA RK(3,3),RL(3,3),RB(3,3),VV(3,3) /0.2 ,0.98, 0.9, 4.4914/
- DATA RK(4,3),RL(4,3),RB(4,3),VV(4,3) /0.28 ,0.02, 0.1,-1.9710/
- DATA RK(5,3),RL(5,3),RB(5,3),VV(5,3) /1. ,0.72, 0. , 0.1003/
-
- CALL HEADER('G115',0)
-
- LOK=.TRUE.
- DO 1 I = 0,3
- DO 1 J = 1,5
- CALL VAVSET(RK(J,I),RB(J,I),MIN(I,1))
- IF(I .EQ. 0) TEST=VAVDEN(RL(J,0))
- IF(I .EQ. 1) TEST=VAVDIS(RL(J,1))
- IF(I .EQ. 2) TEST=VAVRND(RL(J,2))
- IF(I .EQ. 3) TEST=VAVRAN(RK(J,3),RB(J,3),RL(J,3))
- LOK=LOK .AND. ABS((TEST-VV(J,I))/VV(J,I)) .LE. 0.00075
- 1 CONTINUE
-
- DO 2 I = 0,3
- DO 2 J = 1,5
- CALL VAVSET(RK(J,I),RB(J,I),1)
- IF(I .EQ. 0) TEST=VAVDEN(RL(J,0))
- IF(I .EQ. 1) TEST=VAVDIS(RL(J,1))
- IF(I .EQ. 2) TEST=VAVRND(RL(J,2))
- IF(I .EQ. 3) TEST=VAVRAN(RK(J,3),RB(J,3),RL(J,3))
- LOK=LOK .AND. ABS((TEST-VV(J,I))/VV(J,I)) .LE. 0.00075
- 2 CONTINUE
-
- IF(LOK) WRITE(LOUT,'(7X,''G115 VAVLOV **TEST SUCCESFUL**'')')
- IF(.NOT.LOK) WRITE(LOUT,'(7X,''G115 VAVLOV **TEST FAILED**'')')
-
- IRC= ITEST('G115',LOK)
- CALL PAGEND('G115')
-
- END
diff --git a/src/mathlib/gen/tests/g116m.F b/src/mathlib/gen/tests/g116m.F
deleted file mode 100644
index 112728a..0000000
--- a/src/mathlib/gen/tests/g116m.F
+++ /dev/null
@@ -1,76 +0,0 @@
-*
-* $Id: g116m.F,v 1.1.1.1 1996/04/01 15:01:30 mclareni Exp $
-*
-* $Log: g116m.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:30 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE G116M
-C G116 VVILOV (B. SCHORR, KSK)
-
-#include "iorc.inc"
-
- LOGICAL LOK
- DIMENSION RK(5,0:3),RL(5,0:3),RB(5,0:3),VV(5,0:3),RER(0:3)
-
-* DATA RER /2*0.000025, 2*0.0016/
- DATA RER /2*0.000095, 2*0.0016/
-
-C DENSITY
-
- DATA RK(1,0),RL(1,0),RB(1,0),VV(1,0) /0.01, 4. , 0.1, 5.3812E-2/
- DATA RK(2,0),RL(2,0),RB(2,0),VV(2,0) /0.04, -1. , 0.7, 1.7519E-1/
- DATA RK(3,0),RL(3,0),RB(3,0),VV(3,0) /0.2 , 2.5, 0. , 1.0767E-1/
- DATA RK(4,0),RL(4,0),RB(4,0),VV(4,0) /0.24, 5.5, 0.8, 6.0560E-3/
- DATA RK(5,0),RL(5,0),RB(5,0),VV(5,0) /7. , -3.8, 0.6, 2.5747E-2/
-
-C DISTRIBUTION
-
- DATA RK(1,1),RL(1,1),RB(1,1),VV(1,1) /0.015, 1.5, 0.3, 5.3557E-1/
- DATA RK(2,1),RL(2,1),RB(2,1),VV(2,1) /0.1 ,12. , 0.4, 9.9325E-1/
- DATA RK(3,1),RL(3,1),RB(3,1),VV(3,1) /0.2 ,-0.5, 0.9, 3.6597E-1/
- DATA RK(4,1),RL(4,1),RB(4,1),VV(4,1) /0.28 ,-2. , 0.5, 2.8715E-2/
- DATA RK(5,1),RL(5,1),RB(5,1),VV(5,1) /1. , 0. , 0. , 6.8799E-1/
-
-C LOWER LIMIT XL (DENSITY)
-
- DATA RK(1,2),RL(1,2),RB(1,2),VV(1,2) /0.01, 4. , 0.1, -3.03/
- DATA RK(2,2),RL(2,2),RB(2,2),VV(2,2) /0.04, -1. , 0.7, -3.05/
- DATA RK(3,2),RL(3,2),RB(3,2),VV(3,2) /0.2 , 2.5, 0. , -3.05/
- DATA RK(4,2),RL(4,2),RB(4,2),VV(4,2) /0.24, 5.5, 0.8, -3.16/
- DATA RK(5,2),RL(5,2),RB(5,2),VV(5,2) /7. , -3.8, 0.6, -4.07/
-
-C UPPER LIMIT XU (DISTRIBUTION)
-
- DATA RK(1,3),RL(1,3),RB(1,3),VV(1,3) /0.015, 1.5, 0.3, 100.06/
- DATA RK(2,3),RL(2,3),RB(2,3),VV(2,3) /0.1 ,12. , 0.4, 23.44/
- DATA RK(3,3),RL(3,3),RB(3,3),VV(3,3) /0.2 ,-0.5, 0.9, 11.44/
- DATA RK(4,3),RL(4,3),RB(4,3),VV(4,3) /0.28 ,-2. , 0.5, 10.67/
- DATA RK(5,3),RL(5,3),RB(5,3),VV(5,3) /1. , 0. , 0. , 4.72/
-
- CALL HEADER('G116',0)
-
- LOK=.TRUE.
- DO 1 I = 0,3
- DO 1 J = 1,5
- CALL VVISET(RK(J,I),RB(J,I),MOD(I,2),TL,TU)
- IF(I .EQ. 0) TEST=VVIDEN(RL(J,0))
- IF(I .EQ. 1) TEST=VVIDIS(RL(J,1))
- IF(I .EQ. 2) TEST=TL
- IF(I .EQ. 3) TEST=TU
- LOK=LOK .AND. ABS((TEST-VV(J,I))/VV(J,I)) .LE. RER(I)
-
- 1 CONTINUE
-
- IF(LOK) WRITE(LOUT,'(7X,''G115 VVILOV **TEST SUCCESFUL**'')')
- IF(.NOT.LOK) WRITE(LOUT,'(7X,''G115 VVILOV **TEST FAILED**'')')
-
- CALL VVISET(20.,0.,0,XL,XU)
- CALL VVISET(10.,2.,1,XL,XU)
-
- IRC= ITEST('G116',LOK)
- CALL PAGEND('G116')
-
- END
diff --git a/src/mathlib/gen/tests/gtopen.F b/src/mathlib/gen/tests/gtopen.F
deleted file mode 100644
index 9f7e054..0000000
--- a/src/mathlib/gen/tests/gtopen.F
+++ /dev/null
@@ -1,61 +0,0 @@
-*
-* $Id: gtopen.F,v 1.1.1.1 1996/04/01 15:01:12 mclareni Exp $
-*
-* $Log: gtopen.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:12 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE GTOPEN
-#include "iorc.inc"
-C ** This subroutine returns the number (LOUT) of the output **
-C ** stream for the verbose messages printed when running **
-C ** the GENLIB testing routines. The program also opens up **
-C ** the file (if selected) into which the long messages will **
-C ** be put. **
- CHARACTER QUEST1*1, QUEST2*1
- CHARACTER*(*) OUTFIL
-#include "outfil.inc"
-#if defined(CERNLIB_VERBOSE)
- DATA QUEST1/'Y'/,QUEST2/'Y'/
-#endif
-#if !defined(CERNLIB_VERBOSE)
- DATA QUEST1/'N'/,QUEST2/'N'/
-#endif
-#if defined(CERNLIB_INTERACT)
-100 PRINT *,'Do you wish to see verbose messages on screen ? (Y/N)'
- READ(5,'(A1)') QUEST1
- IF (QUEST1 .EQ. 'y') QUEST1='Y'
- IF (QUEST1 .EQ. 'n') QUEST1='N'
- IF (QUEST1 .NE. 'Y' .AND. QUEST1 .NE. 'N') GOTO 100
-#endif
-C So here we have a valid prompt Y or N
- IF (QUEST1 .EQ. 'N') THEN
- LOUT=1
-#if defined(CERNLIB_INTERACT)
-200 FORMAT(//' Do you want the verbose messages stored in a file ?')
-300 PRINT 200
- READ(5,'(A1)') QUEST2
- IF (QUEST2 .EQ. 'y') QUEST2='Y'
- IF (QUEST2 .EQ. 'n') QUEST2='N'
- IF (QUEST2 .NE. 'Y' .AND. QUEST2 .NE. 'N') GOTO 300
-#endif
- IF (QUEST2 .EQ. 'N') THEN
-C The verbose text file will be trashed upon exit
-#if defined(CERNLIB_IBM)
- CALL FILEINF(I,'RECFM','VBA','LRECL',137)
-#endif
- OPEN (UNIT=LOUT,FORM='FORMATTED',STATUS='SCRATCH')
- ELSE
- OPEN (UNIT=LOUT,FILE=OUTFIL,STATUS='UNKNOWN',ERR=400)
- ENDIF
- ELSE
-C Here verbose output is wanted, so LOUT points to the screen
- LOUT=6
- ENDIF
-C CALL MTLSET(' ',LOUT,100,100)
- CALL MTLSET(' ',LOUT,-1,-1)
- CALL KERSET(' ',LOUT,-1,-1)
-400 RETURN
- END
diff --git a/src/mathlib/gen/tests/h101m.F b/src/mathlib/gen/tests/h101m.F
deleted file mode 100644
index 7a26fc9..0000000
--- a/src/mathlib/gen/tests/h101m.F
+++ /dev/null
@@ -1,198 +0,0 @@
-*
-* $Id: h101m.F,v 1.1.1.1 1996/04/01 15:01:30 mclareni Exp $
-*
-* $Log: h101m.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:30 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE H101M
-C H101 RSMPLX, DSMPLX
-
-#if defined(CERNLIB_DOUBLE)
-#include "gen/imp64.inc"
-#endif
-
-#include "iorc.inc"
-
- CHARACTER*40 TITLE,TEXT
- LOGICAL LER
-
- PARAMETER (IDA = 4, ND = 7, NEX = 10)
- PARAMETER (IDW = IDA+2*ND)
-
- DIMENSION AA(IDA,ND,NEX),BB(IDA,NEX),CC(ND,NEX)
- DIMENSION ZZ(NEX),MM1(NEX),MM(NEX),NN1(NEX),NN(NEX)
- DIMENSION A(IDA,ND),B(IDA),C(ND)
- DIMENSION LW(IDW,5),TITLE(NEX)
- DIMENSION W(IDA+ND),X(IDA+ND)
- DIMENSION TEXT(4)
- DIMENSION IX(IDA,NEX),IY(ND,NEX),KEY(NEX),IRS(NEX)
-
- DATA MM1(1),MM(1),NN1(1),NN(1) /4, 4, 3, 3/
- DATA ((AA(I,K,1),I=1,4),K=1,3)
- 1 / -0.04D0, -60, 0.25D0, 9, -0.02D0, -90, 0.5D0, 3,
- 2 1, 0, 0, 0/
- DATA (BB(I,1),I=1,4),ZZ(1) /-0.02D0, 150, -0.75D0, 6, 0/
- DATA (CC(K,1),K=1,3) /0, 0, 1/
- DATA (IX(I,1),I=1,4),KEY(1),IRS(1) /100, 0, 4, 0, 11, 5/
- DATA (IY(K,1),K=1,3) /3, 0, 0/
-
- DATA MM1(2),MM(2),NN1(2),NN(2) /0, 2, 6, 6/
- DATA ((AA(I,K,2),I=1,2),K=1,6)
- 1 / -2, 5, -2, 15, 2, 5, 2, 1, 6, -1, 1, -1/
- DATA (BB(I,2),I=1,2),ZZ(2) /-1, -1, 0/
- DATA (CC(K,2),K=1,6) /20, 0, -40, -16, 0, 10/
- DATA (IX(I,2),I=1,2),KEY(2),IRS(2) /-500, -600, 21, -1100/
- DATA (IY(K,2),K=1,6) /4000, 8000, 0, 0, 2400, 900/
-
- DATA MM1(3),MM(3),NN1(3),NN(3) /0, 2, 6, 7/
- DATA ((AA(I,K,3),I=1,2),K=1,7)
- 1 / -2, 5, -2, 15, 2, 5, 2, 1, 6, -1, 1, -1, -10, 3/
- DATA (BB(I,3),I=1,2),ZZ(3) /-1, -1, 0/
- DATA (CC(K,3),K=1,7) /20, 0, -40, -16, 0, 10, 0/
- DATA (IX(I,3),I=1,2),KEY(3),IRS(3) /-300, -1000, 31, -1300/
- DATA (IY(K,3),K=1,7) /6400, 14400, 1600, 0, 800, 300, 0/
-
- DATA MM1(4),MM(4),NN1(4),NN(4) /2, 2, 3, 3/
- DATA ((AA(I,K,4),I=1,2),K=1,3)
- 1 / 10, 20, 1, 4, 1,1/
- DATA (BB(I,4),I=1,2),ZZ(4) /-1, -2, 0/
- DATA (CC(K,4),K=1,3) /1100, 160, 100/
- DATA (IX(I,4),I=1,2),KEY(4),IRS(4) /6000, 2500, 42, 11000/
- DATA (IY(K,4),K=1,3) /0, 0, 1500/
-
- DATA MM1(5),MM(5),NN1(5),NN(5) /0, 2, 7, 7/
- DATA ((AA(I,K,5),I=1,2),K=1,7)
- 1 / -2, 5, -2, 15, 2, 5, 2, 1, 6, -1, 1, -1, -1, 0/
- DATA (BB(I,5),I=1,2),ZZ(5) /-1, -1, 0/
- DATA (CC(K,5),K=1,7) /20, 0, -40, -16, 0, 10, -1/
- DATA (IX(I,5),I=1,2),KEY(5),IRS(5) /0, 0, 54, 0/
- DATA (IY(K,5),K=1,7) /0, 0, 0, 0, 0, 0, 0/
-
- DATA MM1(6),MM(6),NN1(6),NN(6) /0, 2, 6, 6/
- DATA ((AA(I,K,6),I=1,2),K=1,6)
- 1 / -2, 5, -2, 15, 2, 5, 2, 1, 6, -1, 1, -1/
- DATA (BB(I,6),I=1,2),ZZ(6) /1, 1, 0/
- DATA (CC(K,6),K=1,6) /20, 0, -40, -16, 0, 10/
- DATA (IX(I,6),I=1,2),KEY(6),IRS(6) /0, 0, 63, 0/
- DATA (IY(K,6),K=1,6) /0, 0, 0, 0, 0, 0/
-
- DATA MM1(7),MM(7),NN1(7),NN(7) /0, 2, 6, 6/
- DATA ((AA(I,K,7),I=1,2),K=1,6)
- 1 / -2, 5, -2, 15, 2, 5, 2, 1, 6, -1, 1, -1/
- DATA (BB(I,7),I=1,2),ZZ(7) /0, -1, 0/
- DATA (CC(K,7),K=1,6) /20, 0, -40, -16, 0, 10/
- DATA (IX(I,7),I=1,2),KEY(7),IRS(7) /-1500, -200, 71, -200/
- DATA (IY(K,7),K=1,6) /0, 0, 0, 1600, 8800, 2300/
-
- DATA MM1(8),MM(8),NN1(8),NN(8) /2, 2, 3, 3/
- DATA ((AA(I,K,8),I=1,2),K=1,3)
- 1 / -1, -4, -2, -3, -2, -1/
- DATA (BB(I,8),I=1,2),ZZ(8) /1, 1, 0/
- DATA (CC(K,8),K=1,3) /-8, -12, -6/
- DATA (IX(I,8),I=1,2),KEY(8),IRS(8) /150, 300, 81, -450/
- DATA (IY(K,8),K=1,3) /550, 0, 0/
-
- DATA MM1(9),MM(9),NN1(9),NN(9) /2, 4, 0, 4/
- DATA ((AA(I,K,9),I=1,4),K=1,4)
- 1 / -4, -9, 3, -7, -5, 2, -7, -1,
- 2 -10, -5, 2, -1, -2, 3, -2, 3/
- DATA (BB(I,9),I=1,4),ZZ(9) /-4, -10, 4, 5, -14/
- DATA (CC(K,9),K=1,4) /2, 12, -35, -11/
- DATA (IX(I,9),I=1,4),KEY(9),IRS(9) /200,400,-100,-700, 91, 7300/
- DATA (IY(K,9),K=1,4) /0, 0, 0, 0/
-
- DATA MM1(10),MM(10),NN1(10),NN(10) /2, 2, 3, 3/
- DATA ((AA(I,K,10),I=1,2),K=1,3)
- 1 / 1, -1, 0, 1, 1, 1/
- DATA (BB(I,10),I=1,2),ZZ(10) /1, 0, 0/
- DATA (CC(K,10),K=1,3) /-2, 1, -1/
- DATA (IX(I,10),I=1,2),KEY(10),IRS(10) /0, 0, 104, 0/
- DATA (IY(K,10),K=1,3) /0, 0, 0/
-
- DATA TITLE( 1) /'DEGENERACIES'/
- DATA TITLE( 2) /'NO RESTRICTIONS FOR THE VARIABLES X(I)'/
- DATA TITLE( 3) /'EQUATION CONSTRAINT'/
- DATA TITLE( 4) /'MORE THAN 1 SOLUTION'/
- DATA TITLE( 5) /'NO FEASIBLE INITIAL SOLUTION EXISTS'/
- DATA TITLE( 6) /'MAXIMUM = INFINITE'/
- DATA TITLE( 7) /'MAXIMUM IN DEGENERATED CORNER'/
- DATA TITLE( 8) /'ALL THE C(K) ARE NEGATIVE'/
- DATA TITLE( 9) /'ONLY EQUALITIES AS CONSTRAINTS'/
- DATA TITLE(10) /'NO FEASIBLE INITIAL SOLUTION'/
-
- DATA TEXT(1) /'EXACTLY ONE FINITE SOLUTION'/
- DATA TEXT(2) /'MORE THAN ONE SOLUTION EXISTS'/
- DATA TEXT(3) /'NO FINITE SOLUTION (MAX = INFINITE)'/
- DATA TEXT(4) /'NO FEASIBLE INITIAL SOLUTION EXISTS'/
-
- CALL HEADER('H101',0)
-
- LER=.FALSE.
- DO 11 IPRT = 0,1
- DO 10 NUM = 1,NEX
- DO 1 J = 1,4
- M1=MM1(NUM)
- M=MM(NUM)
- N1=NN1(NUM)
- 1 N=NN(NUM)
- DO 2 K = 1,N
- DO 2 I = 1,M
- 2 A(I,K)=AA(I,K,NUM)
- DO 3 K = 1,N
- 3 C(K)=CC(K,NUM)
- DO 4 I = 1,M
- 4 B(I)=BB(I,NUM)
- Z0=ZZ(NUM)
-#if defined(CERNLIB_DOUBLE)
- CALL DSMPLX(A,B,C,Z0,IDA,M,M1,N,N1,LW,IDW,W,X,Z,ITYPE)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- CALL RSMPLX(A,B,C,Z0,IDA,M,M1,N,N1,LW,IDW,W,X,Z,ITYPE)
-#endif
- LER=LER .OR. .NOT.(KEY(NUM) .EQ. 10*NUM+ITYPE)
- IF(ITYPE .EQ. 1 .OR. ITYPE .EQ. 2) THEN
- LER=LER .OR. .NOT.(IRS(NUM) .EQ. NINT(100*Z))
- DO 12 I = 1,M
- 12 LER=LER .OR. .NOT.(IX(I,NUM) .EQ. NINT(100*X(I)))
- DO 13 K = 1,N
- 13 LER=LER .OR. .NOT.(IY(K,NUM) .EQ. NINT(100*X(K+M)))
- ENDIF
-
- IF(IPRT .EQ. 0) THEN
- WRITE(LOUT,'(//7X,''*** EXAMPLE'',I3,5X,A40/)') NUM,TITLE(NUM)
- WRITE(LOUT,'(7X,''ITYPE '',I2,5X,A40//)') ITYPE,TEXT(ITYPE)
- IF(ITYPE .EQ. 1 .OR. ITYPE .EQ. 2) THEN
- WRITE(LOUT,120) (I,X(I),I+M,X(I+M),I=1,MIN(M,N))
- IF(M .LT. N) WRITE(LOUT,121) (K+M,X(K+M),K=M+1,N)
- IF(M .GT. N) WRITE(LOUT,122) (I,X(I),I=N+1,M)
- WRITE(LOUT,123) Z
- ENDIF
- ENDIF
- 10 CONTINUE
- 11 CONTINUE
- WRITE(LOUT,'(1X)')
- IF(.NOT.LER) WRITE(LOUT,'(7X,''H101 TEST SUCCESSFUL'')')
- IF(LER) WRITE(LOUT,'(7X,''H101 TEST FAILED'')')
-
- IRC= ITEST('H101', .NOT.LER )
-
- WRITE(LOUT,'(1X)')
-#if defined(CERNLIB_DOUBLE)
- CALL DSMPLX(A,B,C,Z0,IDA,0,M1,N,N1,LW,IDW,W,X,Z,ITYPE)
- CALL DSMPLX(A,B,C,Z0,IDA,M,M1,1,2,LW,IDW,W,X,Z,ITYPE)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- CALL RSMPLX(A,B,C,Z0,IDA,0,M1,N,N1,LW,IDW,W,X,Z,ITYPE)
- CALL RSMPLX(A,B,C,Z0,IDA,M,M1,1,2,LW,IDW,W,X,Z,ITYPE)
-#endif
-
- CALL PAGEND('H101')
-
- 120 FORMAT(7X,'X',I2,' = ',F12.4,29X,'X',I2,' = ',F12.4)
- 121 FORMAT(7X,47X,'X',I2,' = ',F12.4)
- 122 FORMAT(7X,'X',I2,' = ',F12.4)
- 123 FORMAT(//7X,'MAXIMUM VALUE OF THE OBJECTIVE FUNCTION = ',F12.4)
- END
diff --git a/src/mathlib/gen/tests/h301m.F b/src/mathlib/gen/tests/h301m.F
deleted file mode 100644
index 634ce1b..0000000
--- a/src/mathlib/gen/tests/h301m.F
+++ /dev/null
@@ -1,120 +0,0 @@
-*
-* $Id: h301m.F,v 1.1.1.1 1996/04/01 15:01:30 mclareni Exp $
-*
-* $Log: h301m.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:30 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE H301M
-C H301 ASSNDX
-
-#include "iorc.inc"
-
- LOGICAL LOK
-
- PARAMETER (IDQ = 10, IDW = 11)
-
- DIMENSION Q(IDQ,IDQ),Q1(IDQ,IDQ),Q2(IDQ,IDQ),IP(IDQ),IQ(IDQ)
- DIMENSION IW(6*IDW)
- DIMENSION IQ1(10,10),IQ2(10,10)
- DIMENSION JRC(10,2,2),JCR(10,2,2),JRCS(2,2),JCRS(2,2)
-
- DATA ((IQ1(I,J),J=1,10),I=1,10)
- 1/ 622, 955, 808, 368, 508, 106,-348,-375,-720, 444,
- 2 220,-849, 625,-189, 349,-658, 175, 991, 981, 724,
- 3 941, 291,-218, 876, 837,-587, 117,-383,-789, 947,
- 4 360,-626, 913,-898,-547,-457,-885, 938, 636,-289,
- 5 -899, 518, 665,-502,-512,-311, 787, 632,-499, 546,
- 6 930,-289,-849, 237, 862, 710, 934, 425, 328,-353,
- 7 -440,-184, 381,-699, 685, 559, 265, 448, 205,-867,
- 8 739,-750,-677, 114,-164, 959, 481,-449, 644,-907,
- 9 -169,-618,-917, 615,-210, 806,-630, 351, 507, 310,
- A -661,-824, 224,-565,-670, 766, 732, 556,-774,-606/
-
- DATA ((IQ2(I,J),J=1,10),I=1,10)
- 1/ 377, 537,-888,-821, 138,-908,-869, 869, 720,-551,
- 2 281, 266,-368, 872, 209, 297,-832,-958,-582, 619,
- 3 757, 426, 680, 555, 898,-446,-788,-893, 216,-167,
- 4 788, 925,-788,-556,-569,-957,-962,-926, 776, 390,
- 5 823,-920, 853,-415, 821, 513, 589,-881, 408, 365,
- 6 -730, 143, 270,-160,-177, 766, 577,-543, 196, 435,
- 7 -133, 267, 928,-725,-661,-951,-960,-637,-571, 403,
- 8 -314, 630,-665, 473, 501,-704, 272, 643, 570,-645,
- 9 343, 865, 233, 554,-375,-441,-263,-337, 834,-371,
- A -983,-103, 363,-147,-296, 572,-194, 583, 631,-773/
-
- DATA (JRC(I,1,1),I=1, 5),JRCS(1,1) /105,202,303,404,501, -2356/
- DATA (JCR(I,1,1),I=1, 5),JCRS(1,1) /301,502,203,104,405, -1921/
-
- DATA (JRC(I,1,2),I=1, 5),JRCS(1,2) /109,202,306,404,501, -3953/
- DATA (JCR(I,1,2),I=1,10),JCRS(1,2) /001,502,103,004,005,
- 1 406,307,208,009,010, -4511/
-
- DATA (JRC(I,2,1),I=1,10),JRCS(2,1) /100,202,300,404,501,
- 1 600,700,800,903,1005,-4233/
- DATA (JCR(I,2,1),I=1, 5),JCRS(2,1)/1001,502,403,104,705, -4173/
-
- DATA (JRC(I,2,2),I=1,10),JRCS(2,2) /109,202,306,404,501,
- 1 603,710,808,907,1005,-7418/
- DATA (JCR(I,2,2),I=1,10),JCRS(2,2) /601,502,803,104,905,
- 1 406,707,308,209,1010, -7676/
-
- CALL HEADER('H301',0)
-
- DO 8 I = 1,10
- DO 8 J = 1,10
- Q1(I,J)=IQ1(I,J)
- 8 Q2(I,J)=IQ2(I,J)
-
- LOK=.TRUE.
- DO 1 M = 5,10,5
- DO 1 N = 5,10,5
-C WRITE(LOUT,'(A1,7X,''M ='',I3,5X,''N ='',I3/)') '1',M,N
- DO 1 MODE = 1,2
- IF(MODE .EQ. 1) THEN
- CALL RMCPY(10,10,Q1(1,1),Q1(1,2),Q1(2,1),Q(1,1),Q(1,2),Q(2,1))
-C IF(M .EQ. 5) WRITE(LOUT,'( 5(5X,F6.0)/)') ((Q(I,J),J=1, 5),I=1,N)
-C IF(M .EQ. 10) WRITE(LOUT,'(10(5X,F6.0)/)') ((Q(I,J),J=1,10),I=1,N)
- CALL ASSNDX(1,Q,N,M,IDQ,IP,SUM,IW,IDW)
-C WRITE(LOUT,'(//7X,''MODE ='',I3,5X,
-C 1 ''ROW TO COLUMN; SUM = '',F8.0 /)') MODE,SUM
-C WRITE(LOUT,'(7X,10(4X,2I3))') (I,IP(I),I=1,N)
-
- DO 11 I = 1,N
- 11 LOK=LOK .AND. JRC(I,N/5,M/5) .EQ. 100*I+IP(I)
- LOK=LOK .AND. -JRCS(N/5,M/5) .EQ. NINT(-SUM)
-
-C WRITE(LOUT,'(1X)')
-C WRITE(LOUT,'(1X)')
- ELSE
- CALL RMCPY(10,10,Q2(1,1),Q2(1,2),Q2(2,1),Q(1,1),Q(1,2),Q(2,1))
-C IF(M .EQ. 5) WRITE(LOUT,'( 5(5X,F6.0)/)') ((Q(I,J),J=1, 5),I=1,N)
-C IF(M .EQ. 10) WRITE(LOUT,'(10(5X,F6.0)/)') ((Q(I,J),J=1,10),I=1,N)
- CALL ASSNDX(2,Q,N,M,IDQ,IQ,SUM,IW,IDW)
-C WRITE(LOUT,'(//7X,''MODE ='',I3,5X,
-C 1 ''COLUMN TO ROW; SUM = '',F8.0 /)') MODE,SUM
-C WRITE(LOUT,'(7X,10(4X,2I3))') (IQ(I),I,I=1,M)
-
- DO 12 I = 1,M
- 12 LOK=LOK .AND. JCR(I,N/5,M/5) .EQ. 100*IQ(I)+I
- LOK=LOK .AND. -JCRS(N/5,M/5) .EQ. NINT(-SUM)
-
-C WRITE(LOUT,'(1X)')
-C WRITE(LOUT,'(1X)')
- ENDIF
- 1 CONTINUE
-
- IF(LOK) WRITE(LOUT,'(7X,''H301 ASSNDX ** TEST SUCCESSFUL **'')')
- IF(.NOT.LOK) WRITE(LOUT,'(7X,''H301 ASSNDX ** TEST FAILED **'')')
-
- WRITE(LOUT,'(1X)')
-
- IRC= ITEST('H301', LOK)
-
- CALL ASSNDX(1,Q,0,1,IDQ,IP,SUM,IW,IDW)
- CALL ASSNDX(1,Q,1,0,IDQ,IP,SUM,IW,IDW)
-
- CALL PAGEND('H301')
- END
diff --git a/src/mathlib/gen/tests/header.F b/src/mathlib/gen/tests/header.F
deleted file mode 100644
index d79a7f9..0000000
--- a/src/mathlib/gen/tests/header.F
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: header.F,v 1.1.1.1 1996/04/01 15:01:12 mclareni Exp $
-*
-* $Log: header.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:12 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE HEADER(CODE,MODE)
-C This routine prints a page header with a testing routine name
-C message.
- CHARACTER*(*) CODE
-#include "iorc.inc"
- NTEST=NTEST+1
- IF(MODE.EQ.1) PRINT 1000, NTEST,CODE
- WRITE(LOUT,1001) CODE
- RETURN
-1000 FORMAT(' Test#',I3,' ( ',A,' ): started')
-1001 FORMAT('1',25X,30('*')/26X,'** Testing Routine ',A,3X,'**'/
- + 26X,30('*'))
- END
diff --git a/src/mathlib/gen/tests/imp64r.inc b/src/mathlib/gen/tests/imp64r.inc
deleted file mode 100644
index da17953..0000000
--- a/src/mathlib/gen/tests/imp64r.inc
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: imp64r.inc,v 1.1.1.1 1996/04/01 15:01:31 mclareni Exp $
-*
-* $Log: imp64r.inc,v $
-* Revision 1.1.1.1 1996/04/01 15:01:31 mclareni
-* Mathlib gen
-*
-*
-*
-* imp64r.inc
-*
-#if defined(CERNLIB_DOUBLE)
- IMPLICIT DOUBLE PRECISION (A-H,O-Q,S-Z)
- IMPLICIT REAL (R)
-
-#elif (defined(CERNLIB_F90))&&(defined(CERNLIB_DOUBLE))
- IMPLICIT REAL(2) (A-H,O-Q,S-Z)
- IMPLICIT REAL (R)
-
-#elif !defined(CERNLIB_DOUBLE)
-C
-
-#elif 1
- IMPLICIT REAL (A-H,O-Z)
-
-#endif
diff --git a/src/mathlib/gen/tests/iorc.inc b/src/mathlib/gen/tests/iorc.inc
deleted file mode 100644
index 5fb33e0..0000000
--- a/src/mathlib/gen/tests/iorc.inc
+++ /dev/null
@@ -1,13 +0,0 @@
-*
-* $Id: iorc.inc,v 1.1.1.1 1996/04/01 15:01:31 mclareni Exp $
-*
-* $Log: iorc.inc,v $
-* Revision 1.1.1.1 1996/04/01 15:01:31 mclareni
-* Mathlib gen
-*
-*
-*
-* iorc.inc
-*
- COMMON/IOLUNS/LIN,LOUT
- COMMON/GTSTAT/NTEST,NFAIL,IRC
diff --git a/src/mathlib/gen/tests/itest.F b/src/mathlib/gen/tests/itest.F
deleted file mode 100644
index 9d4c1ca..0000000
--- a/src/mathlib/gen/tests/itest.F
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: itest.F,v 1.1.1.1 1996/04/01 15:01:12 mclareni Exp $
-*
-* $Log: itest.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:12 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- FUNCTION ITEST(CODE,TEST)
-#include "iorc.inc"
- CHARACTER*(*) CODE
- LOGICAL TEST
- IF(TEST) THEN
- PRINT 1000,NTEST,CODE
- IF (LOUT .NE. 6) WRITE(LOUT,1000) NTEST,CODE
- ITEST=0
- ELSE
- PRINT 1001,NTEST,CODE
- IF (LOUT .NE. 6) WRITE(LOUT,1001) NTEST,CODE
- ITEST=1
- ENDIF
- NFAIL=NFAIL+ITEST
-1000 FORMAT(' Test#',I3,' ( ',A,' ): completed successfully')
-1001 FORMAT(' Test#',I3,' ( ',A,' ): *** failed ***')
- RETURN
- END
diff --git a/src/mathlib/gen/tests/main.F b/src/mathlib/gen/tests/main.F
deleted file mode 100644
index 388f9a8..0000000
--- a/src/mathlib/gen/tests/main.F
+++ /dev/null
@@ -1,336 +0,0 @@
-*
-* $Id: main.F,v 1.6 1996/09/17 08:53:22 cernlib Exp $
-*
-* $Log: main.F,v $
-* Revision 1.6 1996/09/17 08:53:22 cernlib
-* Add new routines funlux.F and its test v152m.F
-*
-* Revision 1.5 1996/04/22 14:49:57 mclareni
-* Remove obsolete routine ADIGAM/DDIGAM (C317) from c/Imakefile,
-* also from the test program and Imakefile.
-*
-* Revision 1.4 1996/04/17 12:32:11 mclareni
-* Add d/rfstft.F (D705) and to Imakefile. cfstft.F becomes D706.
-* In tests, add d705m.F for rfstft and d706m.F for cfstft and the corresponding
-* additions to main.F and Imakefile.
-*
-* Revision 1.3 1996/04/10 16:37:41 mclareni
-* Add test for cfstst (D705), d705m.F, also to main and Imakefile
-*
-* Revision 1.2 1996/04/02 16:23:50 mclareni
-* More precise dclaus64 (C326), test added and C344 removed from TESTALL
-*
-* Revision 1.1.1.1 1996/04/01 15:01:12 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- PROGRAM GENTST
-#include "iorc.inc"
-C Open output streams
- CALL GTOPEN
-#if defined(CERNLIB_TESTALL)||defined(CERNLIB_B100)
- CALL B100M
-#endif
-#if defined(CERNLIB_TESTALL)||defined(CERNLIB_B101)
- CALL B101M
-#endif
-#if defined(CERNLIB_TESTALL)||defined(CERNLIB_B102)
- CALL B102M
-#endif
-#if defined(CERNLIB_TESTALL)||defined(CERNLIB_B300)
- CALL B300M
-#endif
-#if defined(CERNLIB_TESTALL)||defined(CERNLIB_C200)
- CALL C200M
-#endif
-#if defined(CERNLIB_TESTALL)||defined(CERNLIB_C201)
- CALL C201M
-#endif
-#if defined(CERNLIB_TESTALL)||defined(CERNLIB_C202)
- CALL C202M
-#endif
-#if defined(CERNLIB_TESTALL)||defined(CERNLIB_C206)
-C OBSOLETE CALL C206M
-#endif
-#if defined(CERNLIB_TESTALL)||defined(CERNLIB_C207)
- CALL C207M
-#endif
-#if defined(CERNLIB_TESTALL)||defined(CERNLIB_C208)
- CALL C208M
-#endif
-#if defined(CERNLIB_TESTALL)||defined(CERNLIB_C209)
- CALL C209M
-#endif
-#if defined(CERNLIB_TESTALL)||defined(CERNLIB_C210)
- CALL C210M
-#endif
-#if defined(CERNLIB_TESTALL)||defined(CERNLIB_C300)
- CALL C300M
-#endif
-#if defined(CERNLIB_TESTALL)||defined(CERNLIB_C301)
- CALL C301M
-#endif
-#if defined(CERNLIB_TESTALL)||defined(CERNLIB_C302)
- CALL C302M
-#endif
-#if defined(CERNLIB_TESTALL)||defined(CERNLIB_C303)
- CALL C303M
-#endif
-#if defined(CERNLIB_TESTALL)||defined(CERNLIB_C304)
- CALL C304M
-#endif
-#if defined(CERNLIB_TESTALL)||defined(CERNLIB_C306)
- CALL C306M
-#endif
-#if defined(CERNLIB_TESTALL)||defined(CERNLIB_C307)
- CALL C307M
-#endif
-#if defined(CERNLIB_TESTALL)||defined(CERNLIB_C310)
- CALL C310M
-#endif
-#if defined(CERNLIB_TESTALL)||defined(CERNLIB_C312)
- CALL C312M
-#endif
-#if defined(CERNLIB_TESTALL)||defined(CERNLIB_C313)
- CALL C313M
-#endif
-#if defined(CERNLIB_TESTALL)||defined(CERNLIB_C315)
- CALL C315M
-#endif
-#if defined(CERNLIB_TESTALL)||defined(CERNLIB_C316)
- CALL C316M
-#endif
-#if defined(CERNLIB_TESTALL)||defined(CERNLIB_C318)
- CALL C318M
-#endif
-#if defined(CERNLIB_TESTALL)||defined(CERNLIB_C320)
- CALL C320M
-#endif
-#if defined(CERNLIB_TESTALL)||defined(CERNLIB_C321)
- CALL C321M
-#endif
-#if defined(CERNLIB_TESTALL)||defined(CERNLIB_C322)
- CALL C322M
-#endif
-#if defined(CERNLIB_TESTALL)||defined(CERNLIB_C323)
- CALL C323M
-#endif
-#if defined(CERNLIB_TESTALL)||defined(CERNLIB_C324)
- CALL C324M
-#endif
-#if defined(CERNLIB_TESTALL)||defined(CERNLIB_C324)
- CALL C326M
-#endif
-#if defined(CERNLIB_TESTALL)||defined(CERNLIB_C327)
- CALL C327M
-#endif
-#if defined(CERNLIB_TESTALL)||defined(CERNLIB_C328)
- CALL C328M
-#endif
-#if defined(CERNLIB_TESTALL)||defined(CERNLIB_C330)
- CALL C330M
-#endif
-#if defined(CERNLIB_TESTALL)||defined(CERNLIB_C331)
- CALL C331M
-#endif
-#if defined(CERNLIB_TESTALL)||defined(CERNLIB_C333)
- CALL C333M
-#endif
-#if defined(CERNLIB_TESTALL)||defined(CERNLIB_C334)
- CALL C334M
-#endif
-#if defined(CERNLIB_TESTALL)||defined(CERNLIB_C335)
- CALL C335M
-#endif
-#if defined(CERNLIB_TESTALL)||defined(CERNLIB_C336)
- CALL C336M
-#endif
-#if defined(CERNLIB_TESTALL)||defined(CERNLIB_C337)
- CALL C337M
-#endif
-#if defined(CERNLIB_TESTALL)||defined(CERNLIB_C338)
- CALL C338M
-#endif
-#if defined(CERNLIB_TESTALL)||defined(CERNLIB_C339)
- CALL C339M
-#endif
-#if defined(CERNLIB_TESTALL)||defined(CERNLIB_C340)
- CALL C340M
-#endif
-#if defined(CERNLIB_TESTALL)||defined(CERNLIB_C342)
- CALL C342M
-#endif
-#if defined(CERNLIB_TESTALL)||defined(CERNLIB_C343)
- CALL C343M
-#endif
-#if (defined(CERNLIB_C344))&&(defined(CERNLIB_IBMVM)||!defined(CERNLIB_DOUBLE))
- CALL C344M
-#endif
-#if defined(CERNLIB_TESTALL)||defined(CERNLIB_C345)
- CALL C345M
-#endif
-#if defined(CERNLIB_TESTALL)||defined(CERNLIB_C346)
- CALL C346M
-#endif
-#if defined(CERNLIB_TESTALL)||defined(CERNLIB_C347)
- CALL C347M
-#endif
-#if defined(CERNLIB_TESTALL)||defined(CERNLIB_C348)
- CALL C348M
-#endif
-#if defined(CERNLIB_TESTALL)||defined(CERNLIB_C349)
- CALL C349M
-#endif
-#if defined(CERNLIB_TESTALL)||defined(CERNLIB_D101)
- CALL D101M
-#endif
-#if defined(CERNLIB_TESTALL)||defined(CERNLIB_D103)
- CALL D103M
-#endif
-#if defined(CERNLIB_TESTALL)||defined(CERNLIB_D104)
- CALL D104M
-#endif
-#if defined(CERNLIB_TESTALL)||defined(CERNLIB_D105)
- CALL D105M
-#endif
-#if defined(CERNLIB_TESTALL)||defined(CERNLIB_D107)
- CALL D107M
-#endif
-#if defined(CERNLIB_TESTALL)||defined(CERNLIB_D108)
- CALL D108M
-#endif
-#if defined(CERNLIB_TESTALL)||defined(CERNLIB_D110)
- CALL D110M
-#endif
-#if defined(CERNLIB_TESTALL)||defined(CERNLIB_D113)
- CALL D113M
-#endif
-#if defined(CERNLIB_TESTALL)||defined(CERNLIB_D115)
-C OBSOLETE CALL D115M
-#endif
-#if defined(CERNLIB_TESTALL)||defined(CERNLIB_D200)
- CALL D200M
-#endif
-#if defined(CERNLIB_TESTALL)||defined(CERNLIB_D201)
- CALL D201M
-#endif
-#if defined(CERNLIB_TESTALL)||defined(CERNLIB_D202)
- CALL D202M
-#endif
-#if defined(CERNLIB_TESTALL)||defined(CERNLIB_D203)
- CALL D203M
-#endif
-#if defined(CERNLIB_TESTALL)||defined(CERNLIB_D401)
- CALL D401M
-#endif
-#if defined(CERNLIB_TESTALL)||defined(CERNLIB_D503)
- CALL D503M
-#endif
-#if defined(CERNLIB_TESTALL)||defined(CERNLIB_D601)
- CALL D601M
-#endif
-#if defined(CERNLIB_TESTALL)||defined(CERNLIB_D705)
- CALL D705M
-#endif
-#if defined(CERNLIB_TESTALL)||defined(CERNLIB_D706)
- CALL D706M
-#endif
-#if defined(CERNLIB_TESTALL)||defined(CERNLIB_E211)
- CALL E211M
-#endif
-#if defined(CERNLIB_TESTALL)||defined(CERNLIB_E406)
- CALL E406M
-#endif
-#if defined(CERNLIB_TESTALL)||defined(CERNLIB_E407)
- CALL E407M
-#endif
-#if defined(CERNLIB_TESTALL)||defined(CERNLIB_E408)
- CALL E408M
-#endif
-#if defined(CERNLIB_TESTALL)||defined(CERNLIB_F500)
- CALL F500M
-#endif
-#if defined(CERNLIB_TESTALL)||defined(CERNLIB_G100)
- CALL G100M
-#endif
-#if defined(CERNLIB_TESTALL)||defined(CERNLIB_G101)
- CALL G101M
-#endif
-#if defined(CERNLIB_TESTALL)||defined(CERNLIB_G102)
- CALL G102M
-#endif
-#if defined(CERNLIB_TESTALL)||defined(CERNLIB_G104)
- CALL G104M
-#endif
-#if defined(CERNLIB_TESTALL)||defined(CERNLIB_G105)
- CALL G105M
-#endif
-#if defined(CERNLIB_TESTALL)||defined(CERNLIB_G106)
- CALL G106M
-#endif
-#if defined(CERNLIB_TESTALL)||defined(CERNLIB_G110)
- CALL G110M
-#endif
-#if defined(CERNLIB_TESTALL)||defined(CERNLIB_G115)
- CALL G115M
-#endif
-#if defined(CERNLIB_TESTALL)||defined(CERNLIB_G116)
- CALL G116M
-#endif
-#if defined(CERNLIB_TESTALL)||defined(CERNLIB_H101)
- CALL H101M
-#endif
-#if defined(CERNLIB_TESTALL)||defined(CERNLIB_H301)
- CALL H301M
-#endif
-#if defined(CERNLIB_TESTALL)||defined(CERNLIB_U501)
- CALL U501M
-#endif
-#if defined(CERNLIB_TESTALL)||defined(CERNLIB_V100)
- CALL V100M
-#endif
-#if defined(CERNLIB_TESTALL)||defined(CERNLIB_V101)
- CALL V101M
-#endif
-#if defined(CERNLIB_TESTALL)||defined(CERNLIB_V106)
- CALL V106M
-#endif
-#if defined(CERNLIB_TESTALL)||defined(CERNLIB_V110)
- CALL V110M
-#endif
-#if defined(CERNLIB_TESTALL)||defined(CERNLIB_V135)
- CALL V135M
-#endif
-#if defined(CERNLIB_TESTALL)||defined(CERNLIB_V136)
- CALL V136M
-#endif
-#if defined(CERNLIB_TESTALL)||defined(CERNLIB_V137)
- CALL V137M
-#endif
-#if defined(CERNLIB_TESTALL)||defined(CERNLIB_V138)
- CALL V138M
-#endif
-#if defined(CERNLIB_TESTALL)||defined(CERNLIB_V152)
- CALL V152M
-#endif
-#if defined(CERNLIB_TESTALL)||defined(CERNLIB_V202)
- CALL V202M
-#endif
-#if defined(CERNLIB_TESTALL)||defined(CERNLIB_V700)
- CALL V700M
-#endif
-C
- PRINT 1000,NTEST,NFAIL
-1000 FORMAT(///1X,30('*')
- 1 /' GENLIB Test statistics:'
- 2 /I7,' tests executed'
- 3 /I7,' tests failed '/1X,30('*'))
-
-#if !defined(CERNLIB_RGENT)
- IRC=ITEST('GENT',NFAIL.EQ.0)
-#endif
-C Close output streams
- IF (LOUT .NE. 6) CLOSE(UNIT=LOUT)
- STOP
- END
diff --git a/src/mathlib/gen/tests/outfil.inc b/src/mathlib/gen/tests/outfil.inc
deleted file mode 100644
index cf6bc18..0000000
--- a/src/mathlib/gen/tests/outfil.inc
+++ /dev/null
@@ -1,15 +0,0 @@
-*
-* $Id: outfil.inc,v 1.1.1.1 1996/04/01 15:01:31 mclareni Exp $
-*
-* $Log: outfil.inc,v $
-* Revision 1.1.1.1 1996/04/01 15:01:31 mclareni
-* Mathlib gen
-*
-*
-*
-* outfil.inc
-*
-#if defined(CERNLIB_IBMVM)
- PARAMETER (OUTFIL='/GENT OUTPUT A')
-#endif
- PARAMETER (OUTFIL='gent.out')
diff --git a/src/mathlib/gen/tests/pagend.F b/src/mathlib/gen/tests/pagend.F
deleted file mode 100644
index 5494e6c..0000000
--- a/src/mathlib/gen/tests/pagend.F
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: pagend.F,v 1.1.1.1 1996/04/01 15:01:12 mclareni Exp $
-*
-* $Log: pagend.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:12 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE PAGEND(CODE)
-C This subroutine prints a page end message
- CHARACTER*(*) CODE
-#include "iorc.inc"
- WRITE(LOUT,1001) CODE
- RETURN
-1001 FORMAT(/26X,30('*')/26X,'** End of Test of ',A,3X,'**'/
- + 26X,30('*'))
- END
diff --git a/src/mathlib/gen/tests/rc346.F b/src/mathlib/gen/tests/rc346.F
deleted file mode 100644
index fa215d3..0000000
--- a/src/mathlib/gen/tests/rc346.F
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: rc346.F,v 1.1.1.1 1996/04/01 15:01:19 mclareni Exp $
-*
-* $Log: rc346.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:19 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- FUNCTION RC346(R)
- COMMON /RPARAMT/ RAKP,RA,RB,RP,RFMODE
-
- ENTRY R1EL1(R)
- R1EL1=1/SQRT((1+R**2)*(1+(RAKP*R)**2))
- RETURN
-
- ENTRY R1EL2(R)
- R1EL2=(RA+RB*R**2)/((1+R**2)*SQRT((1+R**2)*
- +(1+RFMODE*(RAKP*R)**2)))
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/tests/u501m.F b/src/mathlib/gen/tests/u501m.F
deleted file mode 100644
index 1f8bb4b..0000000
--- a/src/mathlib/gen/tests/u501m.F
+++ /dev/null
@@ -1,134 +0,0 @@
-*
-* $Id: u501m.F,v 1.1.1.1 1996/04/01 15:01:30 mclareni Exp $
-*
-* $Log: u501m.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:30 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE U501M
-C This Subroutine tests the MATHLIB routines DJMNB and DDJMNB (U501)
-#include "gen/imp64.inc"
-
- DIMENSION JI(0:9),MI(0:9),NI(0:9),JH(0:9),MH(0:9),NH(0:9)
- DIMENSION TI(0:9),TH(0:9),DI(0:9),DH(0:9),BE(0:9)
-
-#include "iorc.inc"
- PARAMETER (Z0 = 0, Z1 = 1)
- PARAMETER ( TSTERR=1D-12 )
-
- DATA JI(0) / 0/, MI(0) / 0/, NI(0) / 0/
- DATA JI(1) / 1/, MI(1) / 0/, NI(1) / 1/
- DATA JI(2) / 3/, MI(2) / 1/, NI(2) / -3/
- DATA JI(3) / 4/, MI(3) / -3/, NI(3) / 2/
- DATA JI(4) / 8/, MI(4) / 7/, NI(4) / 0/
- DATA JI(5) / 9/, MI(5) / 0/, NI(5) / 6/
- DATA JI(6) / 10/, MI(6) / 0/, NI(6) / -8/
- DATA JI(7) / 15/, MI(7) /-15/, NI(7) /-13/
- DATA JI(8) / 20/, MI(8) /-18/, NI(8) /-19/
- DATA JI(9) / 25/, MI(9) /-25/, NI(9) /-25/
- DATA JH(0) / 1/, MH(0) / 1/, NH(0) / 1/
- DATA JH(1) / 3/, MH(1) / -1/, NH(1) / 1/
- DATA JH(2) / 3/, MH(2) / 1/, NH(2) / -3/
- DATA JH(3) / 5/, MH(3) / -3/, NH(3) / 3/
- DATA JH(4) / 7/, MH(4) / 7/, NH(4) / 1/
- DATA JH(5) / 9/, MH(5) / -3/, NH(5) / 5/
- DATA JH(6) / 11/, MH(6) / -7/, NH(6) / -9/
- DATA JH(7) / 15/, MH(7) /-15/, NH(7) /-13/
- DATA JH(8) / 21/, MH(8) /-17/, NH(8) /-19/
- DATA JH(9) / 25/, MH(9) /-23/, NH(9) /-21/
-
- DATA BE /0,1,45,90,135,180,225,270,315,360/
-
- W(I)=SQRT(I+Z0)
- CALL HEADER('U501',0)
- ERMAX=0D0
-
- PI = 3.14159 26535 89793D0
-
- DO 3 IB = 0,9
- IF(MOD(IB,2) .EQ. 0) WRITE(LOUT,100)
- BETA=BE(IB)
- B=(PI/180)*BETA
- IF(BETA .EQ. 180)THEN
- C=0
- S=1
- ELSEIF(BETA .EQ. 360)THEN
- C=-1
- S=0
- ELSE
- C=COS(B/2)
- S=SIN(B/2)
- ENDIF
-
- TI(0)=1
- TI(1)=W(2)*C*S
- TI(2)=W(15)*C**2*S**4
- TI(3)=W(14)*C*S**5*(3*C**2-S**2)
- TI(4)=6*W(1430)*(C*S)**7*(-C**2+S**2)
- TI(5)=2*W(2145)*(C*S)**6*(7*C**6-27*C**4*S**2+27*C**2*S**4-7*S**6)
- TI(6)=W(24310)*(C*S)**8*(9*C**4-20*C**2*S**2+9*S**4)
- TI(7)=W(435)*C**28*S**2
- TI(8)=W(78)*C**37*S*(-C**2+19*S**2)
- TI(9)=C**50
-
- TH(0)=C
- TH(1)=S*(2*C**2-S**2)
- TH(2)=W(3)*C*S**2
- TH(3)=S**3*(4*C**2-S**2)
- TH(4)=-W(35)*C**4*S**3
- TH(5)=W(21)*C*S**4*(5*C**4-6*C**2*S**2+S**4)
- TH(6)=W(5)*C**8*S*(-2*C**2+9*S**2)
- TH(7)=W(15)*C**14*S
- TH(8)=W(10)*C**18*S*(-2*C**2+19*S**2)
- TH(9)=2*W(3)*C**22*S*(2*C**2-23*S**2)
-
- WRITE(LOUT,'(1X)')
- DO 1 K = 0,9
- AJ=JI(K)
- AM=MI(K)
- AN=NI(K)
-#if defined(CERNLIB_DOUBLE)
- DI(K)=DDJMNB(AJ,AM,AN,BETA)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- DI(K)= DJMNB(AJ,AM,AN,BETA)
-#endif
- ER=ABS(DI(K)-TI(K))
- ERMAX=MAX(ERMAX,ER)
- WRITE(LOUT,'(1X,3F6.1,F7.0,3F25.15)')
- 1 AJ,AM,AN,BETA,DI(K),TI(K),ER
- 1 CONTINUE
-
- WRITE(LOUT,'(1X)')
- DO 2 K = 0,9
- AJ=JH(K)
- AM=MH(K)
- AN=NH(K)
-#if defined(CERNLIB_DOUBLE)
- DH(K)=DDJMNB(AJ/2,AM/2,AN/2,BETA)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- DH(K)= DJMNB(AJ/2,AM/2,AN/2,BETA)
-#endif
- ER=ABS(DH(K)-TH(K))
- ERMAX=MAX(ERMAX,ER)
- WRITE(LOUT,'(1X,3F6.1,F7.0,3F25.15)')
- 1 AJ/2,AM/2,AN/2,BETA,DH(K),TH(K),ER
- 2 CONTINUE
- 3 CONTINUE
- WRITE(LOUT,'(/7X,''TESTING ERROR MESSAGES:''/)')
-#if defined(CERNLIB_DOUBLE)
- DI(0)=DDJMNB(45*Z1,Z1,Z1,Z0)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- DI(0)= DJMNB(45*Z1,Z1,Z1,Z0)
-#endif
- 100 FORMAT('1'/1X,5X,'J',5X,'M',5X,'N',3X,'BETA',15X,
- 1 'DMNJ(BETA)',21X,'TEST',10X,'Error')
- WRITE(LOUT,'('' Largest Error was'',1P,D10.1)') ERMAX
- IRC= ITEST('U501',ERMAX .LE. TSTERR)
- CALL PAGEND('U501')
- RETURN
- END
diff --git a/src/mathlib/gen/tests/v100m.F b/src/mathlib/gen/tests/v100m.F
deleted file mode 100644
index 9736b73..0000000
--- a/src/mathlib/gen/tests/v100m.F
+++ /dev/null
@@ -1,37 +0,0 @@
-*
-* $Id: v100m.F,v 1.1.1.1 1996/04/01 15:01:30 mclareni Exp $
-*
-* $Log: v100m.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:30 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE V100M
-C
- CHARACTER*(*) CODE
- PARAMETER (CODE='V100')
-C
-C This Subroutine tests the GENLIB routine V100 RANNOR
-C and draws in the range -5s,5s
-CSEQ,IMP64.
-#include "iorc.inc"
- PARAMETER (NBIN=50)
- REAL V(NBIN),RA,RB
- DATA V/NBIN*0.D0/
- CALL HEADER(CODE,1)
- IRCT=0
- DO 10 I=1,5000
- CALL RANNOR(RA,RB)
- NX=(RA+5.)*0.1*NBIN +1
- NX=MIN(50,MAX(1,NX))
- V(NX)=V(NX)+1
- NX=(RB+5.)*0.1*NBIN +1
- NX=MIN(NBIN,MAX(1,NX))
- V(NX)=V(NX)+1
-10 CONTINUE
- CALL VECDRAW(V,NBIN)
- IRC= ITEST(CODE,IRCT.EQ.0)
- CALL PAGEND(CODE)
- RETURN
- END
diff --git a/src/mathlib/gen/tests/v101m.F b/src/mathlib/gen/tests/v101m.F
deleted file mode 100644
index e0fd3e9..0000000
--- a/src/mathlib/gen/tests/v101m.F
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: v101m.F,v 1.1.1.1 1996/04/01 15:01:30 mclareni Exp $
-*
-* $Log: v101m.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:30 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE V101M
-C
- CHARACTER*(*) CODE
- PARAMETER (CODE='V101')
-C
-C This Subroutine tests the GENLIB routine V101 NORRAN
-C and draws in the range -5s,5s
-CSEQ,IMP64.
-#include "iorc.inc"
- PARAMETER (NBIN=50)
- REAL V(NBIN),RA
- DATA V/NBIN*0.D0/
- CALL HEADER(CODE,1)
- IRCT=0
- DO 10 I=1,5000
- CALL NORRAN(RA)
- NX=(RA+5.)*0.1*NBIN+1.
- NX=MIN(NBIN,MAX(1,NX))
- V(NX)=V(NX)+1
-10 CONTINUE
- CALL VECDRAW(V,NBIN)
- IRC= ITEST(CODE,IRCT.EQ.0)
- CALL PAGEND(CODE)
- RETURN
- END
diff --git a/src/mathlib/gen/tests/v106m.F b/src/mathlib/gen/tests/v106m.F
deleted file mode 100644
index 5a80ff4..0000000
--- a/src/mathlib/gen/tests/v106m.F
+++ /dev/null
@@ -1,42 +0,0 @@
-*
-* $Id: v106m.F,v 1.1.1.1 1996/04/01 15:01:30 mclareni Exp $
-*
-* $Log: v106m.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:30 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE V106M
-C
- CHARACTER*(*) CODE
- PARAMETER (CODE='V106')
- PARAMETER ( TSTERR=1D-03 )
-C
-C This Subroutine tests the GENLIB routine V106 RN32
-CSEQ,IMP64.
-#include "iorc.inc"
- PARAMETER (NBIN=20)
- REAL V(NBIN),RA
- DATA V/NBIN*0.D0/,NP/5000/
- CALL HEADER(CODE,1)
- IRCT=0
- DO 10 I=1,NP
- RA=RN32(ID)
- NX=RA*NBIN +1
- NX=MIN(NBIN,MAX(1,NX))
- V(NX)=V(NX)+1
-10 CONTINUE
- CALL VECDRAW(V,NBIN)
- DP=0.
- DV=0.
- DO 20 I=1,NBIN
- DP=DP+(1.*NP/NBIN - V(I))**2
- DV=DV+V(I)*V(I)
-20 CONTINUE
-C ERRMAX=NP*SQRT(DP/(DV*NBIN))
- ERRMAX=0.D0
- IRC= ITEST(CODE,ERRMAX.LT.TSTERR)
- CALL PAGEND(CODE)
- RETURN
- END
diff --git a/src/mathlib/gen/tests/v110m.F b/src/mathlib/gen/tests/v110m.F
deleted file mode 100644
index dd12713..0000000
--- a/src/mathlib/gen/tests/v110m.F
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: v110m.F,v 1.1.1.1 1996/04/01 15:01:30 mclareni Exp $
-*
-* $Log: v110m.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:30 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE V110M
-C
- CHARACTER*(*) CODE
- PARAMETER (CODE='V110')
-C
-C This Subroutine tests the GENLIB routine V110 POISSN
-CSEQ,IMP64.
-#include "iorc.inc"
- PARAMETER (NBIN=20)
- REAL V(NBIN),X
- DATA V/NBIN*0.D0/,X/3.9/
- CALL HEADER(CODE,1)
- IRCT=0
- DO 10 I=1,2000
- CALL POISSN(X,NX,IRC)
- IRCT=IRCT+IRC
- IF(NX.GT.0.AND.NX.LE.NBIN) V(NX)=V(NX)+1
-10 CONTINUE
- CALL VECDRAW(V,NBIN)
- IRC= ITEST(CODE,IRCT.EQ.0)
- CALL PAGEND(CODE)
- RETURN
- END
diff --git a/src/mathlib/gen/tests/v135m.F b/src/mathlib/gen/tests/v135m.F
deleted file mode 100644
index aa9f00d..0000000
--- a/src/mathlib/gen/tests/v135m.F
+++ /dev/null
@@ -1,48 +0,0 @@
-*
-* $Id: v135m.F,v 1.1.1.1 1996/04/01 15:01:30 mclareni Exp $
-*
-* $Log: v135m.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:30 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE V135M
-C
- CHARACTER*(*) CODE
- PARAMETER (CODE='V135')
-C
-C This Subroutine tests the MATHLIB routine V135 RNGAMA
-CSEQ,IMP64.
-#include "iorc.inc"
-
- LOGICAL LOK
- DIMENSION R(50),RT(50)
-
- DATA EPS /1E-5/
-
- DATA (RT(I),I=1,50)
- 1/ 0.368585, 0.013064, 0.031687, 0.283820, 0.061787,
- 2 1.007356, 0.046791, 2.535777, 0.264645, 0.443505,
- 3 0.587862, 0.266885, 0.631598, 1.830675, 2.270047,
- 4 2.664580, 1.000799, 1.203981, 5.018713, 0.951597,
- 5 2.297888, 0.910781, 2.736375, 1.050737, 3.708016,
- 6 2.653227, 2.746237,11.184518, 3.538424, 4.215284,
- 7 2.417769, 1.234898, 1.576784, 2.405226, 1.348569,
- 8 5.547483, 4.733562, 4.184811, 2.867677, 3.769053,
- 9 3.601086, 2.503126, 3.163369, 0.825783, 4.583592,
- A 0.740949, 2.361048, 3.623955, 5.648046, 2.919302/
-
- CALL HEADER(CODE,1)
-
- CALL RLUXGO(3,314159265,0,0)
-
- LOK=.TRUE.
- DO 2 I = 1,50
- P=0.1*I
- R(I)=RNGAMA(P)
- 2 LOK=LOK .AND. ABS(R(I)-RT(I)) .LE. EPS
- IRC= ITEST(CODE,LOK)
- CALL PAGEND(CODE)
- RETURN
- END
diff --git a/src/mathlib/gen/tests/v136m.F b/src/mathlib/gen/tests/v136m.F
deleted file mode 100644
index dec3255..0000000
--- a/src/mathlib/gen/tests/v136m.F
+++ /dev/null
@@ -1,93 +0,0 @@
-*
-* $Id: v136m.F,v 1.1.1.1 1996/04/01 15:01:30 mclareni Exp $
-*
-* $Log: v136m.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:30 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE V136M
-C
- CHARACTER*(*) CODE
- PARAMETER (CODE='V136')
-C
-C This Subroutine tests the MATHLIB routine V136 RNPSSN
-CSEQ,IMP64.
-#include "iorc.inc"
-C V136 RNPSSN
-
- LOGICAL LOK
-
- DIMENSION AMU(6),NT(50,6)
-
- DATA AMU /1,5,10,50,87,100/
-
- DATA (NT( 1,L),L=1,6) / 2, 4, 13, 44, 87, 105/
- DATA (NT( 2,L),L=1,6) / 1, 4, 10, 66, 87, 101/
- DATA (NT( 3,L),L=1,6) / 0, 7, 14, 62, 90, 116/
- DATA (NT( 4,L),L=1,6) / 1, 1, 9, 36, 91, 88/
- DATA (NT( 5,L),L=1,6) / 1, 8, 10, 49, 69, 82/
- DATA (NT( 6,L),L=1,6) / 1, 5, 8, 52, 100, 110/
- DATA (NT( 7,L),L=1,6) / 0, 7, 9, 44, 82, 115/
- DATA (NT( 8,L),L=1,6) / 1, 3, 12, 54, 72, 112/
- DATA (NT( 9,L),L=1,6) / 0, 5, 11, 49, 82, 103/
- DATA (NT(10,L),L=1,6) / 1, 9, 10, 45, 101, 99/
- DATA (NT(11,L),L=1,6) / 0, 5, 7, 56, 76, 99/
- DATA (NT(12,L),L=1,6) / 0, 3, 10, 57, 93, 118/
- DATA (NT(13,L),L=1,6) / 2, 4, 10, 50, 80, 89/
- DATA (NT(14,L),L=1,6) / 1, 5, 9, 59, 81, 104/
- DATA (NT(15,L),L=1,6) / 0, 5, 7, 62, 91, 93/
- DATA (NT(16,L),L=1,6) / 0, 5, 8, 61, 82, 95/
- DATA (NT(17,L),L=1,6) / 0, 6, 13, 55, 80, 109/
- DATA (NT(18,L),L=1,6) / 3, 6, 11, 58, 85, 90/
- DATA (NT(19,L),L=1,6) / 2, 6, 10, 42, 80, 98/
- DATA (NT(20,L),L=1,6) / 2, 3, 14, 55, 71, 82/
- DATA (NT(21,L),L=1,6) / 1, 5, 8, 46, 92, 89/
- DATA (NT(22,L),L=1,6) / 0, 5, 16, 41, 80, 96/
- DATA (NT(23,L),L=1,6) / 2, 4, 8, 51, 86, 97/
- DATA (NT(24,L),L=1,6) / 0, 4, 6, 53, 77, 94/
- DATA (NT(25,L),L=1,6) / 1, 8, 4, 45, 81, 106/
- DATA (NT(26,L),L=1,6) / 0, 6, 11, 62, 85, 95/
- DATA (NT(27,L),L=1,6) / 0, 2, 9, 53, 90, 113/
- DATA (NT(28,L),L=1,6) / 0, 4, 10, 44, 85, 88/
- DATA (NT(29,L),L=1,6) / 0, 6, 13, 40, 92, 113/
- DATA (NT(30,L),L=1,6) / 1, 6, 8, 62, 79, 101/
- DATA (NT(31,L),L=1,6) / 0, 5, 10, 54, 79, 100/
- DATA (NT(32,L),L=1,6) / 1, 4, 4, 47, 80, 86/
- DATA (NT(33,L),L=1,6) / 3, 7, 7, 53, 88, 96/
- DATA (NT(34,L),L=1,6) / 0, 5, 7, 58, 82, 102/
- DATA (NT(35,L),L=1,6) / 1, 4, 13, 44, 70, 92/
- DATA (NT(36,L),L=1,6) / 0, 0, 7, 49, 75, 111/
- DATA (NT(37,L),L=1,6) / 0, 3, 14, 39, 104, 103/
- DATA (NT(38,L),L=1,6) / 0, 3, 9, 47, 89, 102/
- DATA (NT(39,L),L=1,6) / 1, 8, 12, 51, 83, 85/
- DATA (NT(40,L),L=1,6) / 1, 5, 11, 40, 89, 114/
- DATA (NT(41,L),L=1,6) / 2, 6, 7, 61, 92, 102/
- DATA (NT(42,L),L=1,6) / 1, 5, 7, 45, 83, 103/
- DATA (NT(43,L),L=1,6) / 1, 5, 11, 58, 98, 110/
- DATA (NT(44,L),L=1,6) / 2, 5, 11, 57, 89, 96/
- DATA (NT(45,L),L=1,6) / 2, 5, 13, 54, 96, 102/
- DATA (NT(46,L),L=1,6) / 0, 1, 11, 49, 81, 119/
- DATA (NT(47,L),L=1,6) / 2, 3, 8, 44, 77, 100/
- DATA (NT(48,L),L=1,6) / 0, 3, 10, 44, 64, 96/
- DATA (NT(49,L),L=1,6) / 1, 6, 13, 40, 76, 103/
- DATA (NT(50,L),L=1,6) / 1, 7, 15, 41, 88, 108/
-
- CALL RLUXGO(3,314159265,0,0)
-
- CALL RNPSET(100.)
-
- LOK=.TRUE.
- DO 2 I = 1,50
- DO 1 MU = 1,6
- CALL RNPSSN(AMU(MU),N,IERR)
- 1 LOK=LOK .AND. N .EQ. NT(I,MU)
- 2 CONTINUE
-
- CALL RNPSET(60.)
-
- IRC= ITEST(CODE,LOK)
- CALL PAGEND(CODE)
- RETURN
- END
diff --git a/src/mathlib/gen/tests/v137m.F b/src/mathlib/gen/tests/v137m.F
deleted file mode 100644
index d85a288..0000000
--- a/src/mathlib/gen/tests/v137m.F
+++ /dev/null
@@ -1,51 +0,0 @@
-*
-* $Id: v137m.F,v 1.1.1.1 1996/04/01 15:01:30 mclareni Exp $
-*
-* $Log: v137m.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:30 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE V137M
-C
- CHARACTER*(*) CODE
- PARAMETER (CODE='V137')
-C
-C This Subroutine tests the MATHLIB routine V137 RNBNML
-CSEQ,IMP64.
-#include "iorc.inc"
-C V137 RNBNML
-
- LOGICAL LOK
-
- DIMENSION NT(11,9)
-
- DATA (NT( 1,I),I=1,9) / 0, 1, 1, 0, 0, 2, 1, 1, 2/
- DATA (NT( 2,I),I=1,9) / 1, 4, 5, 6, 7, 7, 11, 7, 8/
- DATA (NT( 3,I),I=1,9) / 0, 10, 5, 7, 6, 11, 16, 19, 20/
- DATA (NT( 4,I),I=1,9) / 3, 3, 7, 14, 13, 22, 25, 25, 29/
- DATA (NT( 5,I),I=1,9) / 4, 7, 10, 17, 25, 24, 30, 28, 33/
- DATA (NT( 6,I),I=1,9) / 4, 11, 21, 19, 34, 36, 36, 43, 48/
- DATA (NT( 7,I),I=1,9) / 4, 6, 16, 25, 36, 36, 47, 47, 54/
- DATA (NT( 8,I),I=1,9) / 8, 10, 26, 26, 30, 38, 49, 56, 62/
- DATA (NT( 9,I),I=1,9) / 8, 14, 27, 35, 44, 46, 69, 69, 73/
- DATA (NT(10,I),I=1,9) / 9, 22, 29, 45, 50, 59, 62, 74, 78/
- DATA (NT(11,I),I=1,9) / 8, 21, 37, 35, 44, 58, 74, 80, 94/
-
- CALL HEADER(CODE,1)
-
- CALL RLUXGO(3,314159265,0,0)
-
- LOK=.TRUE.
- DO 2 J = 1,11
- M=10*(J-1)+2
- DO 1 I = 1,9
- P=0.1*I
- CALL RNBNML(M,P,N,IERR)
- 1 LOK=LOK .AND. N .EQ. NT(J,I)
- 2 CONTINUE
- IRC= ITEST(CODE,LOK)
- CALL PAGEND(CODE)
- RETURN
- END
diff --git a/src/mathlib/gen/tests/v138m.F b/src/mathlib/gen/tests/v138m.F
deleted file mode 100644
index 3189185..0000000
--- a/src/mathlib/gen/tests/v138m.F
+++ /dev/null
@@ -1,59 +0,0 @@
-*
-* $Id: v138m.F,v 1.1.1.1 1996/04/01 15:01:31 mclareni Exp $
-*
-* $Log: v138m.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:31 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE V138M
-C
- CHARACTER*(*) CODE
- PARAMETER (CODE='V138')
-C
-C This Subroutine tests the MATHLIB routine V138 RNMNML
-CSEQ,IMP64.
-#include "iorc.inc"
-C V138 RNMNML
-
- LOGICAL LOK
- CHARACTER*47 HT(10)
-
- DIMENSION NV(47),P(47),PCUM(47),NT(47)
-
- DATA HT( 1) /'34 '/
- DATA HT( 2) /'4202450 '/
- DATA HT( 3) /'012640506111 '/
- DATA HT( 4) /'40063032033203017 '/
- DATA HT( 5) /'1543313001300112407044 '/
- DATA HT( 6) /'032011121044222321040645241 '/
- DATA HT( 7) /'01512142101002014610523932005312 '/
- DATA HT( 8) /'3431210142240120347002420140312810212 '/
- DATA HT( 9) /'346441514002212200064200011242115300301343 '/
- DATA HT(10) /'12433141302001313641340247012411010050316620100'/
-
- CALL HEADER(CODE,1)
-
- CALL RLUXGO(3,314159265,0,0)
-
- LOK=.TRUE.
- DO 2 J = 1,10
- N=5*J-3
- NSUM=2*N+3
- READ(HT(J),'(47I1)') (NT(I),I=1,N)
- CALL RANLUX(P,N)
- SP=RVSUM(N,P(1),P(2))
- CALL RVSCL(N,1/SP,P(1),P(2),P(1),P(2))
- PCUM(1)=P(1)
- DO 1 I = 2,N-1
- 1 PCUM(I)=PCUM(I-1)+P(I)
- PCUM(N)=1
- CALL RNMNML(N,NSUM,PCUM,NV,IERR)
- DO 4 I = 1,N
- 4 LOK=LOK .AND. NV(I) .EQ. NT(I)
- 2 CONTINUE
- IRC= ITEST(CODE,LOK)
- CALL PAGEND(CODE)
- RETURN
- END
diff --git a/src/mathlib/gen/tests/v152m.F b/src/mathlib/gen/tests/v152m.F
deleted file mode 100644
index 1867b44..0000000
--- a/src/mathlib/gen/tests/v152m.F
+++ /dev/null
@@ -1,107 +0,0 @@
- SUBROUTINE V152M
-C
- CHARACTER*(*) CODE
- PARAMETER (CODE='V152')
-C
-C This Subroutine tests the MATHLIB routine V152 FUNLUX and FUNLXP
-C
-C PROGRAM FLTST
- DIMENSION XF(200)
- DIMENSION XR(10)
- EXTERNAL FCNSP,TRUINT
- COMMON /fltest/ncalls
- COMMON/CAUGOB/POS(10),WID(10),NRES
- COMMON/FUNINT/XUNI
- COMMON/V152T/ktest
-
- CALL HEADER(CODE,1)
-
- ncalls = 0
-C sum of Breit-Wigners at POS with WID
- WRITE (6,'(//A)') '1 sum of 5 Breit-Wigners at POS with WID '
- NRES = 5
- WID(1) = .1
- POS(1) = 1.
- WID(2) = 2.
- POS(2) = 5.
- WID(3) = 1.
- POS(3) = 7.
- WID(4) = .1
- POS(4) = 8.
- WID(5) = .051
- POS(5) = 9.
- ALIM = -2.
- BLIM = 20.
-C
- call RLUXGO(0,0,0,0)
- do 500 ktest= 1,3
- print *, ' TEST NUMBER',ktest
- n1 = ncalls
- CALL FUNLXP(FCNSP,XF, ALIM,BLIM)
- n2 = ncalls
- nnew = n2 - n1
-C
- TOTINT = TRUINT(ALIM,BLIM)
- print *, ' True integral from',alim,' to',blim,' is',totint
- CHISQ1 = 0.
- NBINS = 99
- HOPE = 1.0/REAL(NBINS)
- DO 100 IBIN= 1, NBINS
- TRU1 = TRUINT(XF(IBIN),XF(IBIN+1))/TOTINT
- DIFF1 = TRU1-HOPE
- CHISQ1 = CHISQ1 + DIFF1**2
-
- 100 CONTINUE
- print *,' Chisq=',chisq1,' Calls=',nnew
-C
-C now test the actual generation (transformation) of r.n.'s
- NN = 10000
- CHISQ2 = 0.
- DO 300 IN= 1, NN
- CALL FUNLUX(XF,XR,1)
- DR = TRUINT(ALIM,XR)/TOTINT - XUNI
- CHISQ2 = CHISQ2 + DR**2
- if (abs(dr) .gt. 0.01) print *, ' FUNLUX weak for UNI=',xuni,dr
- 300 CONTINUE
- print *, ' NN=',nn,' Chisq =',chisq2
- 500 CONTINUE
-C STOP
- IRC= ITEST(CODE,.TRUE.)
- CALL PAGEND(CODE)
- RETURN
- END
- FUNCTION TRUINT(XLO,XHI)
- COMMON/CAUGOB/POS(10),WID(10),NRES
- COMMON/V152T/ktest
- IF (ktest .eq. 1) then
- ERVAL = 0.
- DO 660 I= 1, NRES
- GAMI = 1.0/WID(I)
- ERVAL = ERVAL + GAMI*(ATAN(GAMI*(XHI-POS(I))) -
- + ATAN(GAMI*(XLO-POS(I))) )
- 660 CONTINUE
- TRUINT = ERVAL
- elseIF (ktest .eq. 2) then
- truint = exp(-xlo) - exp(-xhi)
- else
- truint = xhi-xlo - 0.5* (cos(2.*xhi) - cos(2.*xlo))
- endif
- END
- FUNCTION FCNSP(X)
- COMMON/CAUGOB/POS(10),WID(10),NRES
- COMMON /fltest/ncalls
- COMMON/V152T/ktest
- ncalls = ncalls + 1
- if (ktest .eq. 1) then
- GOBCAU = 0.
- DO 25 I= 1, NRES
- GOBCAU = GOBCAU + 1.0/(WID(I)**2+(X-POS(I))**2)
- 25 CONTINUE
- FCNSP = GOBCAU
- else if (ktest .eq. 2) then
- FCNSP = EXP(-X)
- else
- fcnsp = 1.0 + sin(2.0*x)
- endif
- RETURN
- END
diff --git a/src/mathlib/gen/tests/v202m.F b/src/mathlib/gen/tests/v202m.F
deleted file mode 100644
index 830c19a..0000000
--- a/src/mathlib/gen/tests/v202m.F
+++ /dev/null
@@ -1,122 +0,0 @@
-*
-* $Id: v202m.F,v 1.1.1.1 1996/04/01 15:01:31 mclareni Exp $
-*
-* $Log: v202m.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:31 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE V202M
-C This program tests the operation of MATHLIB subprograms
-C PERMU, PERMUT and COMBI
-
-#include "gen/imp64.inc"
-C Set maximum error allowed for test to be considered successful
- PARAMETER ( ITSTERR=0 )
-
- DIMENSION IPT(12),IP(12),IAT(9),IA(9),IBT(12),IB(12),IB1(6)
- DIMENSION IFCT(0:12)
-#include "iorc.inc"
- DATA (IFCT(I),I=0,12)
- 1 /1,1,2,6,24,120,720,5040,40320,362880,3628800,39916800,
- 2 479001600/
-
- DATA IAT /2,4,6,8,5*0/
- DATA IPT/ 1,12,11,10,9,8,7,6,5,4,3,2/
- DATA IBT/ 1,2,3,5,8,8,7,8,4,6,4,7/
- DATA IB / 1,2,3,4,4,5,6,7,7,8,8,8/
- DATA IB1/ 1,2,3,4,4,5/
-
- CALL HEADER('V202',0)
- IERRMAX=0
-
- WRITE(LOUT,*)'COMBI(IA,8,4)'
-
- IA(1)=0
- J=4
- N=8
- DO 1 I = 1,IFCT(8)/(IFCT(4)*IFCT(4))
- CALL COMBI(IA,N,J)
- IF(I .EQ. 50) THEN
- IS=0
- DO 11 K = 1,J
- 11 IS=IS+IA(K)-IAT(K)
- IERRMAX=IABS(MAX(IERRMAX,IS))
- WRITE(LOUT,'(/3X,''IA(1)'',1X,''IA(2)'',1X,''IA(3)'',1X,
- +''IA(4)'',5X,''Error'')')
- WRITE(LOUT,'(1X,4I6,6X,I3)') (IA(K),K=1,J),IS
- ENDIF
- 1 CONTINUE
- CALL COMBI(IA,N,J)
- WRITE(LOUT,'(/3X,''IA(1)'')')
- WRITE(LOUT,'(1X,I6)') IA(1)
-
- WRITE(LOUT,'(//)')
- WRITE(LOUT,*)'PERMU(IB,12)'
- WRITE(LOUT,'(/''IB(1)'',1X,''IB(2)'',1X,''IB(3)'',1X,
- +''IB(4)'',1X,''IB(5)'',1X,''IB(6)'',1X,
- +''IB(7)'',1X,''IB(8)'',1X,''IB(9)'',1X,
- +''IB(10)'',1X,''IB(11)'',1X,
- +''IB(12)'')')
- N=12
- WRITE(LOUT,'(1X,I3,8I6,3I7)') (IB(K),K=1,N)
- DO 2 I = 1,5000
- 2 CALL PERMU(IB,N)
- IS=0
- DO 12 I = 1,N
- 12 IS=IS+IB(I)-IBT(I)
- IERRMAX=IABS(MAX(IERRMAX,IS))
- WRITE(LOUT,'(1X,I3,8I6,3I7)') (IB(K),K=1,N)
- WRITE(LOUT,'(1X,''Error'')')
- WRITE(LOUT,'(1X,I3)') IS
- WRITE(LOUT,'(//)')
- WRITE(LOUT,*) 'PERMU(IB1,6)'
- N=6
- WRITE(LOUT,'(/3X,''IB1(1)'',1X,''IB1(2)'',1X,''IB1(3)'',1X,
- +''IB1(4)'',1X,''IB1(5)'',1X,''IB1(6)'')')
- WRITE(LOUT,'(1X,6I7)') (IB1(K),K=1,N)
- I1=IFCT(6)/IFCT(2)
- DO 22 I = 2,I1
- CALL PERMU(IB1,N)
- IF(I .EQ. I1) WRITE(LOUT,'(1X,6I7)') (IB1(K),K=1,N)
- 22 CONTINUE
- WRITE(LOUT,'(/3X,''IB1(1)'')')
- CALL PERMU(IB1,N)
- WRITE(LOUT,'(1X,I6)') IB1(1)
-
- WRITE(LOUT,'(//)')
- WRITE(LOUT,*) 'PERMUT(39916800,12,IP)'
- N=12
- CALL PERMUT(IFCT(11),N,IP)
- IS=0
- DO 3 I = 1,N
- 3 IS=IS+IP(I)-IPT(I)
- IERRMAX=IABS(MAX(IERRMAX,IS))
- WRITE(LOUT,'(/''IP(1)'',1X,''IP(2)'',1X,''IP(3)'',1X,
- +''IP(4)'',1X,''IP(5)'',1X,''IP(6)'',1X,
- +''IP(7)'',1X,''IP(8)'',1X,''IP(9)'',1X,
- +''IP(10)'',1X,''IP(11)'',1X,
- +''IP(12)'')')
- WRITE(LOUT,'(1X,I3,8I6,3I7)') (IP(I),I=1,N)
- WRITE(LOUT,'(1X,''Error'')')
- WRITE(LOUT,'(1X,I3)') IS
- CALL PERMUT(1,0,IP)
- WRITE(LOUT,'(1X)')
- WRITE(LOUT,*) 'PERMUT(L,4,IP) with L=1,24'
- WRITE(LOUT,'(/3X,''IP(1)'',1X,''IP(2)'',1X,''IP(3)'',1X,
- +''IP(4)'')')
- DO 4 L = 1,24
- CALL PERMUT(L,4,IP)
- 4 WRITE(LOUT,'(1X,4I6)') (IP(I),I=1,4)
- WRITE(LOUT,'(/''TESTING ERROR MESSAGES:''/)')
- CALL PERMUT(10,3,IP)
- CALL PERMUT(5,13,IP)
- CALL COMBI(IA,3,6)
-
- WRITE(LOUT,'(/'' Largest Absolute Error was'',I3)') IERRMAX
-C Check if the test was successful
- IRC=ITEST('V202',IERRMAX .LE. ITSTERR)
- CALL PAGEND('V202')
- RETURN
- END
diff --git a/src/mathlib/gen/tests/v700m.F b/src/mathlib/gen/tests/v700m.F
deleted file mode 100644
index 913742c..0000000
--- a/src/mathlib/gen/tests/v700m.F
+++ /dev/null
@@ -1,148 +0,0 @@
-*
-* $Id: v700m.F,v 1.1.1.1 1996/04/01 15:01:31 mclareni Exp $
-*
-* $Log: v700m.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:31 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE V700M
-C This program tests the operation of MATHLIB subprograms
-C RVNSPC and DVNSPC
-
-#include "gen/imp64.inc"
- REAL RVNSPC,RV,VTR,RA0,RA1,RX0,REPS,RFV700,RRS2,RRC2,RB
- REAL ERR,GAUSS,ERRMAXS
-C Set maximum error allowed for test to be considered successful
- PARAMETER ( TSTERRD=5D-10 )
- PARAMETER ( TSTERRS=5D-4 )
-
-
- EXTERNAL FV700,RFV700,GAUSS,DGAUSS
- COMMON /FORINT2/ RS2,RC2,B
- COMMON /RORINT2/ RRS2,RRC2,RB
-
- PARAMETER (Z0 = 0, Z1 = 1, HF = Z1/2)
-#include "iorc.inc"
-
- CALL HEADER('V700',0)
- ERRMAXD=0
- ERRMAXS=0
-
-#if defined(CERNLIB_DOUBLE)
- WRITE(LOUT,'(/7X,''Rsph.'',5X,''Rcyl.'',11X,''DVNSPC'',12X,
- +''RVNSPC'',4X,''ErrorD'',4x,''ErrorR'')')
-#endif
-#if !defined(CERNLIB_DOUBLE)
- WRITE(LOUT,'(/7X,''Rsph.'',5X,''Rcyl.'',11X,''RVNSPC'',4X,
- +''ErrorR'')')
-#endif
-
- EPS=1D-14
- REPS=1D-6
- DO 1 IRS = 1,5
- WRITE(LOUT,'(1X)')
- RS=IRS
- RS2=RS**2
-#if defined(CERNLIB_DOUBLE)
- RRS2=SNGL(RS2)
-#endif
- DO 1 IIRC = 1,5
- WRITE(LOUT,'(1X)')
- RC=HF*IIRC
- RC2=RC**2
-#if defined(CERNLIB_DOUBLE)
- RRC2=SNGL(RC2)
-#endif
- DO 1 IB = 0,5
- B=0.25*IB
-#if defined(CERNLIB_DOUBLE)
- RB=SNGL(B)
-#endif
- X0=0
- IF(B .GT. 0) X0=(RS2-RC2+B**2)/(2*B)
- A0=MAX(B-RC,-RS)
- A1=MIN(B+RC,RS)
- IF(A0 .GE. A1) THEN
- V=0
- RV=0
- ELSEIF(A0 .LT. X0 .AND. X0. LT. A1) THEN
-#if !defined(CERNLIB_DOUBLE)
- RV=2*(GAUSS(FV700,A0,X0,EPS)+GAUSS(FV700,X0,A1,EPS))
-#endif
-#if defined(CERNLIB_DOUBLE)
- V=2*(DGAUSS(FV700,A0,X0,EPS)+DGAUSS(FV700,X0,A1,EPS))
- RA0=SNGL(A0)
- RA1=SNGL(A1)
- RX0=SNGL(X0)
- RV=2*(GAUSS(RFV700,RA0,RX0,REPS)+GAUSS(RFV700,RX0,RA1,REPS))
-#endif
- ELSE
-#if !defined(CERNLIB_DOUBLE)
- RV=2*GAUSS(FV700,A0,A1,EPS)
-#endif
-#if defined(CERNLIB_DOUBLE)
- V=2*DGAUSS(FV700,A0,A1,EPS)
- RA0=SNGL(A0)
- RA1=SNGL(A1)
- RV=2*GAUSS(RFV700,RA0,RA1,REPS)
-#endif
- ENDIF
-#if defined(CERNLIB_DOUBLE)
- VTD=DVNSPC(RS,RC,B)
- VTR=RVNSPC(SNGL(RS),SNGL(RC),SNGL(B))
-#endif
-#if !defined(CERNLIB_DOUBLE)
- VTR=RVNSPC(RS,RC,B)
-#endif
- ERD=0D0
- ERR=0E0
-#if defined(CERNLIB_DOUBLE)
- IF(VTD .NE. 0) ERD= ABS((V-VTD)/VTD)
- ERRMAXD= ABS(MAX(ERRMAXD,ERD))
-#endif
- IF(VTR .NE. 0) ERR=ABS((RV-VTR)/VTR)
- ERRMAXS= ABS(MAX(ERRMAXS,ERR))
-#if defined(CERNLIB_DOUBLE)
- WRITE(LOUT,'(1X,2F10.2,F25.16,F12.6,1P,2D10.1)')
- 1 RS,RC,VTD,VTR,ERD,ERR
-#endif
-#if !defined(CERNLIB_DOUBLE)
- WRITE(LOUT,'(1X,2F10.2,F25.16,1P,E10.1)')
- 1 RS,RC,VTR,ERR
-#endif
- 1 CONTINUE
-
-#if defined(CERNLIB_DOUBLE)
- WRITE(LOUT,'(/'' Largest Rel. Error for DVNSPC was'',1P,D10.1)')
- + ERRMAXD
-#endif
- WRITE(LOUT,'(/'' Largest Rel. Error for RVNSPC was'',1P,D10.1)')
- + ERRMAXS
-C Check if the test was successful
-#if !defined(CERNLIB_DOUBLE)
- IRC=ITEST('V700',(ERRMAXS.LE.TSTERRD))
-#endif
-#if defined(CERNLIB_DOUBLE)
- IRC=ITEST('V700',(ERRMAXD.LE.TSTERRD).AND.(ERRMAXS.LE.TSTERRS))
-#endif
- CALL PAGEND('V700')
- RETURN
- END
-
- FUNCTION FV700(X)
-#include "gen/imp64.inc"
- COMMON /FORINT2/ RS2,RC2,B
- H0=RS2-X**2
- H1=MIN(RC2-(X-B)**2,H0)
- FV700=SQRT(H1*(H0-H1))+H0*ASIN(SQRT(H1/H0))
- RETURN
- END
- FUNCTION RFV700(RX)
- COMMON /RORINT2/ RRS2,RRC2,RB
- RH0=RRS2-RX**2
- RH1=MIN(RRC2-(RX-RB)**2,RH0)
- RFV700=SQRT(RH1*(RH0-RH1))+RH0*ASIN(SQRT(RH1/RH0))
- RETURN
- END
diff --git a/src/mathlib/gen/tests/vecdraw.F b/src/mathlib/gen/tests/vecdraw.F
deleted file mode 100644
index 2ae9de7..0000000
--- a/src/mathlib/gen/tests/vecdraw.F
+++ /dev/null
@@ -1,54 +0,0 @@
-*
-* $Id: vecdraw.F,v 1.1.1.1 1996/04/01 15:01:31 mclareni Exp $
-*
-* $Log: vecdraw.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:31 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE VECDRAW(V,N)
-C
-C CERN PROGLIB# VECDRAW .VERSION GENT 1.02 920318
-C Author: M.Marquina 92/03/18
-C
-C- Simple vector drawing routine
-C
- DIMENSION V(*)
- CHARACTER*78 LINE,REPEAT
-C
- VMAX=0.
- VMIN=0.
- DO 10 I=1,N
- IF(V(I).GT.VMAX) VMAX=V(I)
- IF(V(I).LT.VMIN) VMIN=V(I)
-10 CONTINUE
- LWIDTH=LEN(LINE)
- LINE =REPEAT('-',LWIDTH)
-C
- VWIDTH=VMAX-VMIN
- I0 =-VMIN/VWIDTH *LWIDTH + 1
- IF(I0.GT.LWIDTH) I0=LWIDTH
- LINE(I0:I0)='|'
- PRINT 1000,N,VMIN,VMAX
- PRINT 1001,LINE
-C
- DO 20 I=1,N
- LINE=' '
- I1=(V(I)-VMIN)/VWIDTH *LWIDTH +1
- IF(I1.GT.LWIDTH) I1=LWIDTH
- IF(I1.LT.1 ) I1=1
- IS=SIGN(1.,V(I))
- J=I1
- DO WHILE(J.NE.I0)
- LINE(J:J)='*'
- J=J-IS
- ENDDO
- LINE(I0:I0)='|'
- PRINT 1001,LINE
-20 CONTINUE
- PRINT 1001
- RETURN
-1000 FORMAT(/' Vector drawing:',I4,' components; range:',2F8.2/)
-1001 FORMAT(1X,A)
- END
diff --git a/src/mathlib/gen/u/Imakefile b/src/mathlib/gen/u/Imakefile
deleted file mode 100644
index 7862fa3..0000000
--- a/src/mathlib/gen/u/Imakefile
+++ /dev/null
@@ -1,19 +0,0 @@
-DoIncludePackage(gen)
-#include "pilot.h"
-
-SRCS_F= clebs.F clebsg.F djmnb64.F dtclgn64.F dwig3j64.F \ @@\
- u100dv.F u100fc.F u100pm.F u100pr.F
-
-#if defined(CERNLIB_DOUBLE)
-SRCS_F:= $(SRCS_F) dwig9j64.F rdjmnb.F rtclgn.F rwig3j.F
-#else
-SRCS_F:= $(SRCS_F) djmnb.F djmnb128.F dtclgn.F dwig3j.F
-#endif
-
-FORTRANSAVEOPTION = FortranSaveFlags
-
-#if defined(CERNLIB_SGI)
-IMAKE_DEFINES=-DFortranDoesCpp=NO
-#endif
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/mathlib/gen/u/clebs.F b/src/mathlib/gen/u/clebs.F
deleted file mode 100644
index 729d9e9..0000000
--- a/src/mathlib/gen/u/clebs.F
+++ /dev/null
@@ -1,94 +0,0 @@
-*
-* $Id: clebs.F,v 1.1.1.1 1996/04/01 15:01:45 mclareni Exp $
-*
-* $Log: clebs.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:45 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE CLEBS(J1,J2,J3,JM1,JM2, JM3,K,M)
-C*NS DIMENSION L1(40),L2(40),IB(40),K(2),LS(40,11),LD(40,6),IIL(40,2),
-C*NS F LLSN(40),LLSD(40),IL(2),LL(40),LR(40,100),LQ(40),
- DIMENSION IB(40),K(2),LS(40,11),LD(40,6),IIL(40,2),
- F LLSN(40),LLSD(40), LL(40),LR(40,100),LQ(40),
- F IS(100),ISK(40),M(41)
-C*NS DIMENSION LR1(40),ICGC(40)
- DIMENSION ICGC(40)
- IF((JM1+JM2).NE.JM3) GO TO 1
- CALL U100PR(J3+1,LS(1,1),ID)
- CALL U100FC((J3+J1-J2)/2,LS(1,2))
- CALL U100FC((J3-J1+J2)/2,LS(1,3))
- CALL U100FC((J1+J2-J3)/2,LS(1,4))
- CALL U100FC((J3+JM3)/2,LS(1,5))
- CALL U100FC((J3-JM3)/2,LS(1,6))
- CALL U100FC((J1+J2+J3)/2+1,LS(1,7))
- CALL U100FC((J1-JM1)/2,LS(1,8))
- CALL U100FC((J1+JM1)/2,LS(1,9))
- CALL U100FC((J2-JM2)/2,LS(1,10))
- CALL U100FC((J2+JM2)/2,LS(1,11))
- DO 2 LZ=1,11
- IF (LS(1,LZ) .EQ. (-77)) GO TO 45
- 2 CONTINUE
- CALL VZERO (M,41)
- CALL VZERO (LLSN,40)
- CALL VZERO (LLSD, 40)
- DO 5 J=1,40
- DO 5 I=1,6
- 5 LLSN(J)=LLSN(J)+LS(J,I)
- DO 6 J=1,40
- DO 6 I=7,11
- 6 LLSD(J)=LLSD(J)+LS(J,I)
- CALL U100DV(LLSN,LLSD,LL)
- MJ=1
- N=-1
- MM=0
- 3 N=N+1
- CALL U100FC((J2+J3+JM1)/2-N,LD(1,1))
- CALL U100FC((J1-JM1)/2+N,LD(1,2))
- CALL U100FC(N,LD(1,3))
- CALL U100FC((J3-J1+J2)/2-N,LD(1,4))
- CALL U100FC((J3+JM3)/2-N,LD(1,5))
- CALL U100FC((J1-J2-JM3)/2+N,LD(1,6))
- IF(LD(1,1).EQ.(-77)) GO TO 4
- IF(LD(1,4).EQ.(-77)) GO TO 4
- IF(LD(1,5).EQ.(-77)) GO TO 4
- IF(LD(1,2).EQ.(-77)) GO TO 3
- IF(LD(1,6).EQ.(-77)) GO TO 3
- MM=MM+1
- IS(MM)=(-1)**(N+(J2+JM2)/2)
- DO 7 JK=1,40
- IIL(JK,1)=LD(JK,1)+LD(JK,2)
- 7 IIL(JK,2)=LD(JK,3)+LD(JK,4)+LD(JK,5)+LD(JK,6)
- CALL U100DV (IIL(1,1),IIL(1,2),LR(1,MM))
- GO TO 3
- 4 DO 31 JJ=1,40
- IB(JJ)=10000
- DO 31 JK=1,MM
- IF (LR(JJ,JK) .LT. IB(JJ)) IB(JJ)=LR(JJ,JK)
- 31 CONTINUE
- ISUM=0
- DO 32 JM=1,MM
- DO 33 IO=1,40
- 33 LQ(IO)=LR(IO,JM)-IB(IO)
- CALL U100PM(LQ,K(1),K(2))
- 32 ISUM=ISUM+K(1)*IS(JM)
- IX=ABS(ISUM)
- IF(IX.EQ.0) GO TO 1
- CALL U100PR(IX,ISK,IP)
- DO 22 LK=1,40
- 22 ICGC(LK)=LL(LK)+2*IB(LK)+2*ISK(LK)
- IXX=IP* ISUM/ABS(ISUM)
- ISIGN=ISUM/ABS(ISUM)
- IXXX=IP*ISIGN
- M(41)=IXXX
- CALL UCOPY (ICGC, M, 40)
- CALL U100PM(ICGC,K(1),K(2))
- K(1)=K(1)*IXX
- RETURN
- 45 WRITE(6,50)
- 50 FORMAT(1H ,'CHECK YOUR PARAMETERS ONCE MORE'///)
- 1 K(1)=0
- K(2)=1
- RETURN
- END
diff --git a/src/mathlib/gen/u/clebsg.F b/src/mathlib/gen/u/clebsg.F
deleted file mode 100644
index ba03bbf..0000000
--- a/src/mathlib/gen/u/clebsg.F
+++ /dev/null
@@ -1,466 +0,0 @@
-*
-* $Id: clebsg.F,v 1.1.1.1 1996/04/01 15:01:46 mclareni Exp $
-*
-* $Log: clebsg.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:46 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB_F4))
- FUNCTION CLEBSG(/A/,/B/,/C/,/XX/,/YY/,/ZZ/,/GG/,/HH/,/PP/)
-#endif
-#if !defined(CERNLIB_IBM)||!defined(CERNLIB_F4)
- FUNCTION CLEBSG( A , B , C , XX , YY , ZZ , GG , HH , PP )
-#endif
-C
-C ADAPTED FROM HARWELL LIBRARY BY T. LINDELOF AND F. JAMES
-C 08/01/74 LAST UPDATE OF HARWELL LIBRARY
-C
-C WIGN3J- WIGNER 3-J SYMBOL
-C CLEBSG- CLEBSCH-GORDAN COEFFICIENT
-C WIGN6J- WIGNER 6-J SYMBOL
-C RACAHC- RACAH COEFFICIENT
-C JAHNUF- U-FUNCTION (JAHN)
-C WIGN9J- WIGNER 9-J SYMBOL
-C
-#if !defined(CERNLIB_F4)
- REAL JAHNUF
-#endif
- DIMENSION H(101),J(101)
- DIMENSION AY(4),IAY(4)
- COMMON/FGERCM/IERR,IERCT
- DATA JJJ/0/
- INTPTF(Q)=Q+Q+SIGN(.10,Q)
- IPARF(I)=4*(I/4)-I+1
-C*IA Q
- DATA Q/0/
- IERR= 0
- KEY= 2
- CALL NOARG(NARG)
- IF (NARG.EQ.3) KEY=4
- GO TO 1
-C
-#if (defined(CERNLIB_CDC))&&(defined(CERNLIB_F4))
- ENTRY WIGN3J
-#endif
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB_F4))
- ENTRY WIGN3J(/A/,/B/,/C/,/XX/,/YY/,/ZZ/,/GG/,/HH/,/PP/)
-#endif
-#if (!defined(CERNLIB_CDC)||!defined(CERNLIB_F4))&&(!defined(CERNLIB_IBM)||!defined(CERNLIB_F4))
- ENTRY WIGN3J(A,B,C,XX,YY,ZZ,GG,HH,PP)
-#endif
- IERR=0
- CALL NOARG(NARG)
- IF(NARG.EQ.3) GOTO 2
- KEY=1
- GOTO 1
- 2 KEY=3
- GOTO 1
-C
-#if (defined(CERNLIB_CDC))&&(defined(CERNLIB_F4))
- ENTRY RACAHC
-#endif
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB_F4))
- ENTRY RACAHC(/A/,/B/,/C/,/XX/,/YY/,/ZZ/,/GG/,/HH/,/PP/)
-#endif
-#if (!defined(CERNLIB_CDC)||!defined(CERNLIB_F4))&&(!defined(CERNLIB_IBM)||!defined(CERNLIB_F4))
- ENTRY RACAHC(A,B,C,XX,YY,ZZ,GG,HH,PP)
-#endif
- KEY=12
- IERR=0
- GOTO 100
-C
-#if (defined(CERNLIB_CDC))&&(defined(CERNLIB_F4))
- ENTRY WIGN6J
-#endif
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB_F4))
- ENTRY WIGN6J(/A/,/B/,/C/,/XX/,/YY/,/ZZ/,/GG/,/HH/,/PP/)
-#endif
-#if (!defined(CERNLIB_CDC)||!defined(CERNLIB_F4))&&(!defined(CERNLIB_IBM)||!defined(CERNLIB_F4))
- ENTRY WIGN6J(A,B,C,XX,YY,ZZ,GG,HH,PP)
-#endif
- KEY=11
- IERR=0
- GOTO 100
-C
-#if (defined(CERNLIB_CDC))&&(defined(CERNLIB_F4))
- ENTRY JAHNUF
-#endif
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB_F4))
- ENTRY JAHNUF(/A/,/B/,/C/,/XX/,/YY/,/ZZ/,/GG/,/HH/,/PP/)
-#endif
-#if (!defined(CERNLIB_CDC)||!defined(CERNLIB_F4))&&(!defined(CERNLIB_IBM)||!defined(CERNLIB_F4))
- ENTRY JAHNUF(A,B,C,XX,YY,ZZ,GG,HH,PP)
-#endif
- KEY=13
- IERR=0
- GOTO 100
-C
- 1 K1=INTPTF(A)
- K2=INTPTF(B)
- K3=INTPTF(C)
- IF(KEY.GE.3) GOTO 100
- K4=INTPTF(XX)
- K5=INTPTF(YY)
- K6= INTPTF(ZZ)
- IF (KEY.EQ.1) K6= -K6
-C
- 100 IF(JJJ.NE.0) GOTO 500
- JJJ=1
- IERCT=0
- H(1)=1.0
- J(1)=0
- X=0.
- DO 400 I=2,101
- X=X+1.0
- H(I)=H(I-1)*X
- J(I)=J(I-1)
- 200 IF(H(I).LT.10.0) GOTO 400
- H(I)=0.01*H(I)
- J(I)=J(I)+2
- GOTO 200
- 400 CONTINUE
-C
- 500 IF(KEY.LT.-5) GOTO 750
- IF(KEY.GE.3) GOTO 320
- IF((K4+K5-K6).NE.0) GOTO 710
- M1=K1+K2-K3
- M2=K2+K3-K1
- M3=K3+K1-K2
- M4=K1+K4
- M5=K1-K4
- M6=K2+K5
- M7=K2-K5
- M8=K3+K6
- M9=K3-K6
- M10=K1+K2+K3+2
-C
- IF(M1.LT.0) GOTO 710
- IF(M2.LT.0) GOTO 710
- IF(M3.LT.0) GOTO 710
- IF(M4.LT.0) GOTO 710
- IF(M5.LT.0) GOTO 710
- IF(M6.LT.0) GOTO 710
- IF(M7.LT.0) GOTO 710
- IF(M8.LT.0) GOTO 710
- IF(M9.LT.0) GOTO 710
- IF((M4-(M4/2)-(M4/2)).NE.0) GOTO 710
- IF((M6-(M6/2)-(M6/2)).NE.0) GOTO 710
- IF((M8-(M8/2)-(M8/2)).NE.0) GOTO 710
- IF((M10-(M10/2)-(M10/2)).NE.0) GOTO 710
-C
- Y=K3+1
- M1=M1/2+1
- M2=M2/2+1
- M3=M3/2+1
- M4=M4/2+1
- M5=M5/2+1
- M6=M6/2+1
- M7=M7/2+1
- M8=M8/2+1
- M9=M9/2+1
- M10=M10/2+1
-C
- Y= SQRT(Y*H(M1)*H(M2)*H(M3)*H(M4)*H(M5)*
- X H(M6)*H(M7)*H(M8)*H(M9)/H(M10))
- IY=(J(M1)+J(M2)+J(M3)+J(M4)+J(M5)+
- X J(M6)+J(M7)+J(M8)+J(M9)-J(M10))/2
-C
- N4=M1
- IF(N4.GT.M5)N4=M5
- IF(N4.GT.M6)N4=M6
- N4=N4-1
- M2=K2-K3-K4
- M3=K1+K5-K3
- N5=0
- IF(N5.LT.M2) N5=M2
- IF(N5.LT.M3) N5=M3
- N5PAR=IPARF(N5)
- N5=N5/2
- Z=0.0
- GOTO 610
-C
- 700 MM1=M1-N5
- MM2=M5-N5
- MM3=M6-N5
- MM4=N5-(M2/2)+1
- MM5=N5-(M3/2)+1
-C
- X=1./(H(MM1)*H(MM2)*H(MM3)*H(MM4)*H(MM5)*H(N5+1))
- IX=-J(MM1)-J(MM2)-J(MM3)-J(MM4)-J(MM5)-J(N5+1)
-C
- 800 IF(IX+IY)900,210,110
- 900 X=0.1*X
- IX=IX+1
- GOTO 800
- 110 X=10.0 *X
- IX=IX-1
- GOTO 800
-C
- 210 IF(N5PAR.LT.0) X=-X
- Z=Z+X
-C*UL 510 N5PAR=-N5PAR
- N5PAR=-N5PAR
- N5=N5+1
-C
- 610 IF(N5-N4)700,700,810
-C
- 710 CLEBSH=0.0
- IERR=1
- IERCT=IERCT+1
- GOTO 220
-C
- 810 CLEBSH=Z*Y
-C*UL 910 GOTO(120,220),KEY
- GOTO(120,220),KEY
-C
- 220 CLEBSG=CLEBSH
- RETURN
-C
- 120 JS=K1-K2+K6
- IF(JS.LT.0) JS=-JS
- JSPAR=IPARF(JS)
- CLEBSG=JSPAR*CLEBSH/ SQRT(K3+1.0 )
- RETURN
-C
- 320 IF(KEY.GE.10) GOTO 130
- KEY=KEY-2
- IF((K1-(K1/2)-(K1/2)).NE.0) GOTO 420
- IF((K2-(K2/2)-(K2/2)).NE.0) GOTO 420
- IF((K3-(K3/2)-(K3/2)).NE.0) GOTO 420
- IJ=K1+K2+K3
- IJPAR=IPARF(IJ)
- IF(IJPAR.LE.0) GOTO 420
- M1=IJ-K1-K1
- M2=IJ-K2-K2
- M3=IJ-K3-K3
- M4=IJ+2
- IF(M1.LT.0) GOTO 420
- IF(M2.LT.0) GOTO 420
- IF(M3.LT.0) GOTO 420
- M1=M1/2+1
- M2=M2/2+1
- M3=M3/2+1
- M4=IJ/2+2
- Y= SQRT(H(M1)*H(M2)*H(M3)/H(M4))
- IY=(J(M1)+J(M2)+J(M3)-J(M4))/2
- IJ=IJ/2
- IJPAR=IPARF(IJ)
- IJ=IJ/2+1
- M1=M1/2+1
- M2=M2/2+1
- M3=M3/2+1
- Z=H(IJ)/(H(M1)*H(M2)*H(M3))
- IZ=J(IJ)-J(M1)-J(M2)-J(M3)
- IZ=IZ+IY
- CLEBSH=IJPAR*Y*Z*10.0 **IZ
- GOTO(220,720),KEY
-C
- 720 JQ=K2-K1
- IF(JQ.LT.0) JQ=-JQ
- IJPAR=IPARF(JQ)
- CLEBSG=CLEBSH*IJPAR* SQRT(K3+1.0 )
- RETURN
-C
- 420 CLEBSH=0.0
- IERR=1
- IERCT=IERCT+1
- GOTO(220,720),KEY
-C
- 130 IF(KEY.EQ.11) GOTO 450
- IF(KEY.GT.19) GOTO 750
-C*UL 550 K1=INTPTF(A)
- K1=INTPTF(A)
- K2=INTPTF(B)
- K3=INTPTF(YY)
- K4=INTPTF(XX)
- K5=INTPTF(C)
- K6=INTPTF(ZZ)
-C
- 750 KA=K1
- KB=K2
- KC=K3
- KEYTRI=1
- GOTO 630
-C
- 230 KA=K4
- KB=K5
- KEYTRI=2
- GOTO 630
-C
- 330 KB=K2
- KC=K6
- KEYTRI=3
- GOTO 630
-C
- 430 KA=K1
- KB=K5
- KEYTRI=4
- GOTO 630
-C
- 530 Y=AY(1)*AY(2)*AY(3)*AY(4)
- IYY=IAY(1)+IAY(2)+IAY(3)+IAY(4)
- M1=(K1+K2+K4+K5)/2+2
- M2=(K1+K2-K3)/2+1
- M3=(K4+K5-K3)/2+1
- M4=(K1+K5-K6)/2+1
- M5=(K2+K4-K6)/2+1
- M6=K1+K4-K3-K6
- M7=K2+K5-K3-K6
-C
- N4=M1
- IF(N4.GT.M2) N4=M2
- IF(N4.GT.M3) N4=M3
- IF(N4.GT.M4) N4=M4
- IF(N4.GT.M5) N4=M5
- N4=N4-1
- N5=0
- IF(N5.LT.M6) N5=M6
- IF(N5.LT.M7) N5=M7
- N5PAR=IPARF(N5)
- N5=N5/2
- M6=M6/2-1
- M7=M7/2-1
- Z=0.0
- GOTO 730
-C
- 140 X=H(M1-N5)/(H(N5+1)*H(M2-N5)*H(M3-N5)*H(M4-N5)
- X *H(M5-N5)*H(N5-M6)*H(N5-M7))
- IX=J(M1-N5)-J(N5+1)-J(M2-N5)-J(M3-N5)-J(M4-N5)
- X -J(M5-N5)-J(N5-M6)-J(N5-M7)
- 240 IF(IX+IYY)340,440,540
- 340 X=0.1*X
- IX=IX+1
- GOTO 240
- 540 X=10.0 *X
- IX=IX-1
- GOTO 240
- 440 IF(N5PAR.LT.0) X=-X
- Z=Z+X
- N5PAR=-N5PAR
- N5=N5+1
-C
- 730 IF(N5.LE.N4) GOTO 140
-C
- RACAH=Z*Y
- 840 IF(KEY.LT.-5) GOTO 160
- KEY=KEY-10
- GOTO(150,250,350),KEY
-C
- 830 RACAH=0.0
- IERR=1
- IERCT=IERCT+1
- GOTO 840
-C
- 150 IJPAR=IPARF(K1+K2+K4+K5)
- IF(IJPAR.LT.0) RACAH=-RACAH
- 250 CLEBSG=RACAH
- RETURN
-C
- 350 FACTOR= SQRT((K3+1.0 )*(K6+1))
- CLEBSG=FACTOR*RACAH
- RETURN
- 450 K1=INTPTF(A)
- K2=INTPTF(B)
- K3=INTPTF(C)
- K4=INTPTF(XX)
- K5=INTPTF(YY)
- K6=INTPTF(ZZ)
- GOTO 750
-C
-C TRIANGLE FUNCTION
-C
- 630 MA=KA+KB-KC
- MB=KA-KB+KC
- MC=-KA+KB+KC
- MD=KA+KB+KC+2
- IF(MA.LT.0) GOTO 830
- IF(MB.LT.0) GOTO 830
- IF(MC.LT.0) GOTO 830
- IF((MD-(MD/2)-(MD/2)).NE.0) GOTO 830
- MA=MA/2+1
- MB=MB/2+1
- MC=MC/2+1
- MD=MD/2+1
- AY(KEYTRI)= SQRT(H(MA)*H(MB)*H(MC)/H(MD))
- IAY(KEYTRI)=(J(MA)+J(MB)+J(MC)-J(MD))/2
- GOTO(230,330,430,530),KEYTRI
-C
-#if (defined(CERNLIB_CDC))&&(defined(CERNLIB_F4))
- ENTRY WIGN9J
-#endif
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB_F4))
- ENTRY WIGN9J(/A/,/B/,/C/,/XX/,/YY/,/ZZ/,/GG/,/HH/,/PP/)
-#endif
-#if (!defined(CERNLIB_CDC)||!defined(CERNLIB_F4))&&(!defined(CERNLIB_IBM)||!defined(CERNLIB_F4))
- ENTRY WIGN9J(A,B,C,XX,YY,ZZ,GG,HH,PP)
-#endif
-C
- KEY=-10
- IERR=0
-C
- KK1=INTPTF(A)
- KK2=INTPTF(B)
- KK3=INTPTF(C)
- KK4=INTPTF(XX)
- KK5=INTPTF(YY)
- KK6=INTPTF(ZZ)
- KK7=INTPTF(GG)
- KK8=INTPTF(HH)
- KK9=INTPTF(PP)
-C
- KUP=KK1+KK9
- M1=KK4+KK8
- M2=KK2+KK6
- IF(KUP.GT.M1) KUP=M1
- IF(KUP.GT.M2) KUP=M2
-C
- K=KK1-KK9
- IF(K.LT.0) K=-K
- M1=KK4-KK8
- IF(M1.LT.0) M1=-M1
- M2=KK2-KK6
- IF(M2.LT.0) M2=-M2
- IF(K.LT.M1) K=M1
- IF(K.LT.M2) K=M2
-C
- ANINE=0.0
-C
- 660 IF(K.GT.KUP) GOTO 260
- K1=KK1
- K2=KK4
- K3=KK7
- K4=KK8
- K5=KK9
- K6=K
- KEYRAC=1
- GOTO 100
-C
- 160 GOTO(360,460,560),KEYRAC
-C
- 360 RA=RACAH
- K1=KK2
- K2=KK8
- K3=KK5
- K4=KK4
- K5=KK6
- KEYRAC=2
- GOTO 750
-C
- 460 RB=RACAH
- K1=KK9
- K2=KK6
- K3=KK3
- K4=KK2
- K5=KK1
- KEYRAC=3
- GOTO 750
-C
- 560 ANINE=ANINE+RA*RB*RACAH*(K+1)
- K=K+2
- GOTO 660
-C
- 260 CLEBSG=ANINE
- RETURN
- END
diff --git a/src/mathlib/gen/u/djmnb.F b/src/mathlib/gen/u/djmnb.F
deleted file mode 100644
index 039f6d1..0000000
--- a/src/mathlib/gen/u/djmnb.F
+++ /dev/null
@@ -1,14 +0,0 @@
-*
-* $Id: djmnb.F,v 1.1.1.1 1996/04/01 15:01:48 mclareni Exp $
-*
-* $Log: djmnb.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:48 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION DJMNB(AJ,AM,AN,BETA)
- DJMNB = RDJMNB(AJ,AM,AN,BETA)
- END
-#endif
diff --git a/src/mathlib/gen/u/djmnb128.F b/src/mathlib/gen/u/djmnb128.F
deleted file mode 100644
index 86229dd..0000000
--- a/src/mathlib/gen/u/djmnb128.F
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: djmnb128.F,v 1.1.1.1 1996/04/01 15:01:48 mclareni Exp $
-*
-* $Log: djmnb128.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:48 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION DDJMNB(AJ,AM,AN,BETA)
-#include "gen/imp128.inc"
- CHARACTER NAME*(*)
- PARAMETER (NAME = 'DDJMNB')
- DDJMNB=0
- CALL MTLPRT(NAME,'U501.0','Not available on this machine')
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/u/djmnb64.F b/src/mathlib/gen/u/djmnb64.F
deleted file mode 100644
index 528f18b..0000000
--- a/src/mathlib/gen/u/djmnb64.F
+++ /dev/null
@@ -1,141 +0,0 @@
-*
-* $Id: djmnb64.F,v 1.1.1.1 1996/04/01 15:01:49 mclareni Exp $
-*
-* $Log: djmnb64.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:49 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION RDJMNB(AJ,AM,AN,BETA)
-#endif
-#if defined(CERNLIB_DOUBLE)
- FUNCTION DDJMNB(AJ,AM,AN,BETA)
-#include "gen/imp64.inc"
-#endif
-C Calculates the beta-term
-C d j mn (beta)
-C in the matrix element of the finite rotation operator
-C (Wigner's D-function), according to formula 4.3.1(3) in
-C D.A. Varshalovich, A.N. Moskalev, and V.K. Khersonskii,
-C Quantum Theory of Angular Momentum, World Scientific,
-C Singapore 1988
-
-
- CHARACTER NAME*(*)
- CHARACTER*80 ERRTXT
-#if !defined(CERNLIB_DOUBLE)
- PARAMETER (NAME = 'DJMNB')
-#endif
-#if defined(CERNLIB_DOUBLE)
- PARAMETER (NAME = 'DDJMNB')
-#endif
- DIMENSION FCL(0:50)
-
- PARAMETER (Z1 = 1, HF = Z1/2)
- PARAMETER (F = 8.72664 62599 71647 88D-3)
-
- DATA FCL( 0) /0/
- DATA FCL( 1) /0/
- DATA FCL( 2) /6.93147180559945309D-01/
- DATA FCL( 3) /1.79175946922805500D+00/
- DATA FCL( 4) /3.17805383034794562D+00/
- DATA FCL( 5) /4.78749174278204599D+00/
- DATA FCL( 6) /6.57925121201010100D+00/
- DATA FCL( 7) /8.52516136106541430D+00/
- DATA FCL( 8) /1.06046029027452502D+01/
- DATA FCL( 9) /1.28018274800814696D+01/
- DATA FCL(10) /1.51044125730755153D+01/
- DATA FCL(11) /1.75023078458738858D+01/
- DATA FCL(12) /1.99872144956618861D+01/
- DATA FCL(13) /2.25521638531234229D+01/
- DATA FCL(14) /2.51912211827386815D+01/
- DATA FCL(15) /2.78992713838408916D+01/
- DATA FCL(16) /3.06718601060806728D+01/
- DATA FCL(17) /3.35050734501368889D+01/
- DATA FCL(18) /3.63954452080330536D+01/
- DATA FCL(19) /3.93398841871994940D+01/
- DATA FCL(20) /4.23356164607534850D+01/
- DATA FCL(21) /4.53801388984769080D+01/
- DATA FCL(22) /4.84711813518352239D+01/
- DATA FCL(23) /5.16066755677643736D+01/
- DATA FCL(24) /5.47847293981123192D+01/
- DATA FCL(25) /5.80036052229805199D+01/
- DATA FCL(26) /6.12617017610020020D+01/
- DATA FCL(27) /6.45575386270063311D+01/
- DATA FCL(28) /6.78897431371815350D+01/
- DATA FCL(29) /7.12570389671680090D+01/
- DATA FCL(30) /7.46582363488301644D+01/
- DATA FCL(31) /7.80922235533153106D+01/
- DATA FCL(32) /8.15579594561150372D+01/
- DATA FCL(33) /8.50544670175815174D+01/
- DATA FCL(34) /8.85808275421976788D+01/
- DATA FCL(35) /9.21361756036870925D+01/
- DATA FCL(36) /9.57196945421432025D+01/
- DATA FCL(37) /9.93306124547874269D+01/
- DATA FCL(38) /1.02968198614513813D+02/
- DATA FCL(39) /1.06631760260643459D+02/
- DATA FCL(40) /1.10320639714757395D+02/
- DATA FCL(41) /1.14034211781461703D+02/
- DATA FCL(42) /1.17771881399745072D+02/
- DATA FCL(43) /1.21533081515438634D+02/
- DATA FCL(44) /1.25317271149356895D+02/
- DATA FCL(45) /1.29123933639127215D+02/
- DATA FCL(46) /1.32952575035616310D+02/
- DATA FCL(47) /1.36802722637326368D+02/
- DATA FCL(48) /1.40673923648234259D+02/
- DATA FCL(49) /1.44565743946344886D+02/
- DATA FCL(50) /1.48477766951773032D+02/
-
- JPM=NINT(AJ+AM)
- JPN=NINT(AJ+AN)
- JMM=NINT(AJ-AM)
- JMN=NINT(AJ-AN)
- MPN=NINT(AM+AN)
-
- IF(JPM .LT. 0 .OR. JPN .LT. 0 .OR. JMM .LT. 0 .OR. JMN .LT. 0
- 1 .OR. AJ .LT. 0 .OR. AJ .GT. 25
- 2 .OR. BETA .LT. 0 .OR. BETA .GT. 360) THEN
- R=0
- WRITE(ERRTXT,101) AJ,AM,AN,BETA
- CALL MTLPRT(NAME,'U501.1',ERRTXT)
- ELSEIF(BETA .EQ. 0) THEN
- R=0
- IF(JPM .EQ. JPN) R=1
- ELSEIF(BETA .EQ. 180) THEN
- R=0
- IF(JPM .EQ. JMN) R=(-1)**MOD(ABS(JPM),2)
- ELSEIF(BETA .EQ. 360) THEN
- R=0
- IF(JPM .EQ. JPN) R=(-1)**MOD(ABS(MPN),2)
- ELSE
- B=F*BETA
- S=LOG(SIN(B))
- C=LOG(ABS(COS(B)))
- RT=HF*(FCL(JPM)+FCL(JMM)+FCL(JPN)+FCL(JMN))
- K0=MAX(0,MPN)
- KQ=K0+JPM
- IF(BETA .GT. 180) KQ=KQ+MPN
- Q=(-1)**KQ
- KQ=K0+K0
- CX=KQ-MPN
- SX=JPM+JPN-KQ
- R=0
- DO 1 K = K0,MIN(JPM,JPN)
- R=R+Q*EXP(RT-FCL(K)-FCL(JPM-K)-FCL(JPN-K)-FCL(K-MPN)+
- 1 CX*C+SX*S)
- CX=CX+2
- SX=SX-2
- 1 Q=-Q
- ENDIF
-#if !defined(CERNLIB_DOUBLE)
- RDJMNB=R
-#endif
-#if defined(CERNLIB_DOUBLE)
- DDJMNB=R
-#endif
- RETURN
- 101 FORMAT('ILLEGAL ARGUMENT(S) AJ = ',F6.1,' AM = ',F6.1,' AN = ',
- 1 F6.1,' BETA = ',F8.2)
- END
diff --git a/src/mathlib/gen/u/dtclgn.F b/src/mathlib/gen/u/dtclgn.F
deleted file mode 100644
index a3336bc..0000000
--- a/src/mathlib/gen/u/dtclgn.F
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: dtclgn.F,v 1.1.1.1 1996/04/01 15:01:48 mclareni Exp $
-*
-* $Log: dtclgn.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:48 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if !defined(CERNLIB_DOUBLE)
- SUBROUTINE DTCLGN(J1,J2,J3,M1,M2,M3,DNUM,DDEN,KPEX)
-#include "gen/imp128.inc"
- CHARACTER*6 NAME
- NAME ='DTCLGN'
- CALL MTLPRT(NAME,'U112',
- +'not available on this machine - see documentation')
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/u/dtclgn64.F b/src/mathlib/gen/u/dtclgn64.F
deleted file mode 100644
index 663f324..0000000
--- a/src/mathlib/gen/u/dtclgn64.F
+++ /dev/null
@@ -1,199 +0,0 @@
-*
-* $Id: dtclgn64.F,v 1.1.1.1 1996/04/01 15:01:48 mclareni Exp $
-*
-* $Log: dtclgn64.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:48 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- SUBROUTINE DTCLGN(J1,J2,J3,M1,M2,M3,DNUM,DDEN,KPEX)
- IMPLICIT DOUBLE PRECISION (A-H,O-Z)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- SUBROUTINE DTCLGN(J1,J2,J3,M1,M2,M3,DNUM,DDEN,KPEX)
-#include "gen/imp64.inc"
-#endif
- CHARACTER NAME*(*)
- CHARACTER*80 ERRTXT
- PARAMETER (NAME = 'DTCLGN')
-
- PARAMETER (MXP = 40)
-
- DIMENSION KPEX(*)
- DIMENSION IPRIM(MXP),PRIM(MXP),LS(MXP,12),LR(MXP,100)
- DIMENSION ISD(11),JS(100),IA(7)
-
- DATA (IA(I),I=1,7) /-1,1,1,-1,-1,1,1/
-
- DATA (IPRIM(I),I=1,MXP)
- 1/ 2, 3, 5, 7, 11, 13, 17, 19, 23, 29, 31, 37, 41, 43, 47, 53,
- 2 59, 61, 67, 71, 73, 79, 83, 89, 97,101,103,107,109,113,127,131,
- 3 137,139,149,151,157,163,167,173/
-
- DO 11 J = 1,MXP
- LS(J,12)=0
- PRIM(J)=IPRIM(J)
- 11 KPEX(J)=0
- DNUM=0
- DDEN=1
- IF(J1 .LT. 0 .OR. J2 .LT. 0 .OR. J3 .LT. 0) GO TO 99
- IF(MOD(J1+J2+J3,2) .NE. 0) GO TO 99
- MX=ABS(M1)
- MY=ABS(M2)
- MZ=ABS(M3)
- IF(J1 .LT. MX .OR. J2 .LT. MY .OR. J3 .LT. MZ) GO TO 99
- IF(MOD(J1+MX,2) .NE. 0 .OR. MOD(J2+MY,2) .NE. 0) GOTO 99
- IF(MOD(J3+MZ,2) .NE. 0) GOTO 99
- IF(M1+M2 .NE. M3) GO TO 99
- ISD(1)=J3+1
- ISD(2)=(J3+J1-J2)/2
- ISD(3)=(J3-J1+J2)/2
- ISD(4)=(J1+J2-J3)/2
- ISD(5)=(J3-M3)/2
- ISD(6)=(J3+M3)/2
- ISD(7)=(J1+J2+J3)/2+1
- ISD(8)=(J1-M1)/2
- ISD(9)=(J1+M1)/2
- ISD(10)=(J2-M2)/2
- ISD(11)=(J2+M2)/2
-
- IF(ISD(2) .LT. 0 .OR. ISD(3) .LT. 0 .OR. ISD(4) .LT. 0) GO TO 99
-
- DO 41 K = 1,MXP
- DO 41 L = 1,11
- 41 LS(K,L)=0
- IF(ISD(1) .GT. 1) THEN
- KOVF=1
- N1=ISD(1)
- K=0
- 42 K=K+1
- IF(K .EQ. MXP+1) GO TO 48
- 43 IF(MOD(N1,IPRIM(K)) .NE. 0) GO TO 42
- LS(K,1)=LS(K,1)+1
- N1=N1/IPRIM(K)
- IF(N1 .NE. 1) GO TO 43
- 48 KOVF=MAX(KOVF,N1)
- IF(KOVF .NE. 1) THEN
- WRITE(ERRTXT,101) J1,J2,J3,M1,M2,M3
- CALL MTLPRT(NAME,'U112.1',ERRTXT)
- GO TO 99
- ENDIF
- ENDIF
- DO 59 L = 2,11
- DO 54 N = 2,ISD(L)
- KOVF=1
- N1=N
- K=0
- 52 K=K+1
- IF(K .EQ. MXP+1) GO TO 58
- 53 IF(MOD(N1,IPRIM(K)) .NE. 0) GO TO 52
- LS(K,L)=LS(K,L)+1
- N1=N1/IPRIM(K)
- IF(N1 .NE. 1) GO TO 53
- 58 KOVF=MAX(KOVF,N1)
- IF(KOVF .NE. 1) THEN
- WRITE(ERRTXT,101) J1,J2,J3,M1,M2,M3
- CALL MTLPRT(NAME,'U112.1',ERRTXT)
- GO TO 99
- ENDIF
- 54 CONTINUE
- 59 CONTINUE
-
- DO 5 J = 1,MXP
- 5 LS(J,12)=LS(J,12)+LS(J,1)+LS(J,2)+LS(J,3)+LS(J,4)+LS(J,5)+LS(J,6)
- 1 -LS(J,7)-LS(J,8)-LS(J,9)-LS(J,10)-LS(J,11)
- MM=0
- ISD(1)=J2+J3+M1
- ISD(2)=J1-M1
- ISD(3)=0
- ISD(4)=J3-J1+J2
- ISD(5)=J3+M3
- ISD(6)=J1-J2-M3
- ISD(7)=J2+M2
- DO 12 L = 1,7
- 12 ISD(L)=ISD(L)/2-IA(L)
- 3 DO 13 L = 1,7
- 13 ISD(L)=ISD(L)+IA(L)
- IF(ISD(2) .LT. 0 .OR. ISD(6) .LT. 0) GO TO 3
- IF(ISD(1) .LT. 0 .OR. ISD(4) .LT. 0 .OR. ISD(5) .LT. 0) GO TO 4
-
- DO 69 L = 1,6
- DO 61 K = 1,MXP
- 61 LS(K,L)=0
- DO 64 N = 2,ISD(L)
- KOVF=1
- N1=N
- K=0
- 62 K=K+1
- IF(K .EQ. MXP+1) GO TO 68
- 63 IF(MOD(N1,IPRIM(K)) .NE. 0) GO TO 62
- LS(K,L)=LS(K,L)+1
- N1=N1/IPRIM(K)
- IF(N1 .NE. 1) GO TO 63
- 68 KOVF=MAX(KOVF,N1)
- IF(KOVF .NE. 1) THEN
- WRITE(ERRTXT,101) J1,J2,J3,M1,M2,M3
- CALL MTLPRT(NAME,'U112.1',ERRTXT)
- GO TO 99
- ENDIF
- 64 CONTINUE
- 69 CONTINUE
-
- MM=MM+1
- JS(MM)=(-1)**ISD(7)
- DO 9 J = 1,MXP
- 9 LR(J,MM)=LS(J,1)+LS(J,2)-LS(J,3)-LS(J,4)-LS(J,5)-LS(J,6)
- GO TO 3
-
- 4 DO 31 J = 1,MXP
- LS(J,8)=10000
- DO 31 JK = 1,MM
- 31 LS(J,8)=MIN(LS(J,8),LR(J,JK))
- BSUM=0
- DO 32 JM = 1,MM
- BNUM=1
- DO 33 J = 1,MXP
- JEX=LR(J,JM)-LS(J,8)
- IF(JEX .GT. 0) BNUM=BNUM*PRIM(J)**JEX
- 33 CONTINUE
- 32 BSUM=BSUM+BNUM*JS(JM)
- IF(BSUM .EQ. 0) GO TO 99
- DO 71 K = 1,MXP
- 71 LS(K,1)=0
- ASUM=ABS(BSUM)
- IF(ASUM .GT. 1) THEN
- OVF=1
- A1=ASUM
- K=0
- 72 K=K+1
- IF(K .EQ. MXP+1) GO TO 78
- 73 IF(MOD(A1,PRIM(K)) .NE. 0) GO TO 72
- LS(K,1)=LS(K,1)+1
- A1=A1/PRIM(K)
- IF(A1 .NE. 1) GO TO 73
- 78 OVF=MAX(OVF,A1)
- IF(OVF .NE. 1) THEN
- WRITE(ERRTXT,101) J1,J2,J3,M1,M2,M3
- CALL MTLPRT(NAME,'U112.1',ERRTXT)
- GO TO 99
- ENDIF
- ENDIF
- DO 22 J = 1,MXP
- 22 KPEX(J)=LS(J,12)+2*(LS(J,8)+LS(J,1))
- BNUM=1
- BDEN=1
- DO 16 J = 1,MXP
- PP=PRIM(J)**ABS(KPEX(J))
- IF(KPEX(J) .GE. 0) THEN
- BNUM=BNUM*PP
- ELSE
- BDEN=BDEN*PP
- ENDIF
- 16 CONTINUE
- DNUM=SIGN(BNUM,BSUM)
- DDEN=BDEN
- 99 RETURN
- 101 FORMAT('LIST OF PRIME NUMBERS EXHAUSTED',2X,3I5,2X,3I5)
- END
diff --git a/src/mathlib/gen/u/dwig3j.F b/src/mathlib/gen/u/dwig3j.F
deleted file mode 100644
index 4ca4688..0000000
--- a/src/mathlib/gen/u/dwig3j.F
+++ /dev/null
@@ -1,55 +0,0 @@
-*
-* $Id: dwig3j.F,v 1.1.1.1 1996/04/01 15:01:48 mclareni Exp $
-*
-* $Log: dwig3j.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:48 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION DWIG3J(A,B,C,X,Y,Z)
-#include "gen/imp128.inc"
- CHARACTER*6 NAME
- DWIG3J=0
- NAME ='DWIG3J'
- CALL MTLPRT(NAME,'U111',
- +'not available on this machine - see documentation')
- RETURN
-
- ENTRY DCLEBG(A,B,C,X,Y,Z)
- DCLEBG=0
- NAME ='DCLEBG'
- CALL MTLPRT(NAME,'U111',
- +'not available on this machine - see documentation')
- RETURN
-
- ENTRY DWIG6J(A,B,C,X,Y,Z)
- DWIG6J=0
- NAME ='DWIG6J'
- CALL MTLPRT(NAME,'U111',
- +'not available on this machine - see documentation')
- RETURN
-
- ENTRY DRACAW(A,B,C,X,Y,Z)
- DRACAW=0
- NAME ='DRACAW'
- CALL MTLPRT(NAME,'U111',
- +'not available on this machine - see documentation')
- RETURN
-
- ENTRY DJAHNU(A,B,C,X,Y,Z)
- DJAHNU=0
- NAME ='DJAHNU'
- CALL MTLPRT(NAME,'U111',
- +'not available on this machine - see documentation')
- RETURN
-
- ENTRY DWIG9J(A,B,C,P,Q,R,X,Y,Z)
- DWIG9J=0
- NAME ='DWIG9J'
- CALL MTLPRT(NAME,'U111',
- +'not available on this machine - see documentation')
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/u/dwig3j64.F b/src/mathlib/gen/u/dwig3j64.F
deleted file mode 100644
index 0017ec1..0000000
--- a/src/mathlib/gen/u/dwig3j64.F
+++ /dev/null
@@ -1,230 +0,0 @@
-*
-* $Id: dwig3j64.F,v 1.1.1.1 1996/04/01 15:01:48 mclareni Exp $
-*
-* $Log: dwig3j64.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:48 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- FUNCTION DWIG3J(A1,B1,C1,X1,Y1,Z1)
- IMPLICIT DOUBLE PRECISION (A-H,O-Z)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION RWIG3J(A1,B1,C1,X1,Y1,Z1)
-#include "gen/imp64.inc"
-#endif
- LOGICAL LCG,LJN,LRC
-
- DIMENSION U(0:202)
-
- PARAMETER (R1 = 1, HF = R1/2)
-
- DATA U(0),U(2),(U(2*N-1),N=1,101) /103*0/
- DATA U( 4),U( 6) /6.931471805599453D-01, 1.791759469228055D+00/
- DATA U( 8),U( 10) /3.178053830347946D+00, 4.787491742782046D+00/
- DATA U( 12),U( 14) /6.579251212010101D+00, 8.525161361065414D+00/
- DATA U( 16),U( 18) /1.060460290274525D+01, 1.280182748008147D+01/
- DATA U( 20),U( 22) /1.510441257307552D+01, 1.750230784587389D+01/
- DATA U( 24),U( 26) /1.998721449566189D+01, 2.255216385312342D+01/
- DATA U( 28),U( 30) /2.519122118273868D+01, 2.789927138384089D+01/
- DATA U( 32),U( 34) /3.067186010608067D+01, 3.350507345013689D+01/
- DATA U( 36),U( 38) /3.639544520803305D+01, 3.933988418719949D+01/
- DATA U( 40),U( 42) /4.233561646075349D+01, 4.538013889847691D+01/
- DATA U( 44),U( 46) /4.847118135183522D+01, 5.160667556776437D+01/
- DATA U( 48),U( 50) /5.478472939811232D+01, 5.800360522298052D+01/
- DATA U( 52),U( 54) /6.126170176100200D+01, 6.455753862700633D+01/
- DATA U( 56),U( 58) /6.788974313718153D+01, 7.125703896716801D+01/
- DATA U( 60),U( 62) /7.465823634883016D+01, 7.809222355331531D+01/
- DATA U( 64),U( 66) /8.155795945611504D+01, 8.505446701758152D+01/
- DATA U( 68),U( 70) /8.858082754219768D+01, 9.213617560368709D+01/
- DATA U( 72),U( 74) /9.571969454214320D+01, 9.933061245478743D+01/
- DATA U( 76),U( 78) /1.029681986145138D+02, 1.066317602606435D+02/
- DATA U( 80),U( 82) /1.103206397147574D+02, 1.140342117814617D+02/
- DATA U( 84),U( 86) /1.177718813997451D+02, 1.215330815154386D+02/
- DATA U( 88),U( 90) /1.253172711493569D+02, 1.291239336391272D+02/
- DATA U( 92),U( 94) /1.329525750356163D+02, 1.368027226373264D+02/
- DATA U( 96),U( 98) /1.406739236482343D+02, 1.445657439463449D+02/
- DATA U(100),U(102) /1.484777669517730D+02, 1.524095925844974D+02/
- DATA U(104),U(106) /1.563608363030788D+02, 1.603311282166309D+02/
- DATA U(108),U(110) /1.643201122631952D+02, 1.683274454484277D+02/
- DATA U(112),U(114) /1.723527971391628D+02, 1.763958484069974D+02/
- DATA U(116),U(118) /1.804562914175438D+02, 1.845338288614495D+02/
- DATA U(120),U(122) /1.886281734236716D+02, 1.927390472878449D+02/
- DATA U(124),U(126) /1.968661816728900D+02, 2.010093163992815D+02/
- DATA U(128),U(130) /2.051681994826412D+02, 2.093425867525368D+02/
- DATA U(132),U(134) /2.135322414945633D+02, 2.177369341139542D+02/
- DATA U(136),U(138) /2.219564418191303D+02, 2.261905483237276D+02/
- DATA U(140),U(142) /2.304390435657770D+02, 2.347017234428183D+02/
- DATA U(144),U(146) /2.389783895618343D+02, 2.432688490029827D+02/
- DATA U(148),U(150) /2.475729140961869D+02, 2.518904022097232D+02/
- DATA U(152),U(154) /2.562211355500095D+02, 2.605649409718632D+02/
- DATA U(156),U(158) /2.649216497985528D+02, 2.692910976510198D+02/
- DATA U(160),U(162) /2.736731242856937D+02, 2.780675734403661D+02/
- DATA U(164),U(166) /2.824742926876304D+02, 2.868931332954270D+02/
- DATA U(168),U(170) /2.913239500942703D+02, 2.957666013507606D+02/
- DATA U(172),U(174) /3.002209486470141D+02, 3.046868567656687D+02/
- DATA U(176),U(178) /3.091641935801469D+02, 3.136528299498791D+02/
- DATA U(180),U(182) /3.181526396202093D+02, 3.226634991267262D+02/
- DATA U(184),U(186) /3.271852877037752D+02, 3.317178871969285D+02/
- DATA U(188),U(190) /3.362611819791985D+02, 3.408150588707990D+02/
- DATA U(192),U(194) /3.453794070622669D+02, 3.499541180407702D+02/
- DATA U(196),U(198) /3.545390855194408D+02, 3.591342053695754D+02/
- DATA U(200),U(202) /3.637393755555635D+02, 3.683544960724047D+02/
-
- LCG=.FALSE.
- GO TO 7
-
-#if defined(CERNLIB_DOUBLE)
- ENTRY DCLEBG(A1,B1,C1,X1,Y1,Z1)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- ENTRY RCLEBG(A1,B1,C1,X1,Y1,Z1)
-#endif
- LCG=.TRUE.
-
- 7 H=0
- IA=NINT(2*A1)
- IB=NINT(2*B1)
- IC=NINT(2*C1)
- IX=NINT(2*X1)
- IY=NINT(2*Y1)
- IZ=NINT(2*Z1)
- IF(IA .LT. 0 .OR. IB .LT. 0 .OR. IC .LT. 0) GO TO 99
- IF(MOD(IA+IB+IC,2) .NE. 0) GO TO 99
- JX=ABS(IX)
- JY=ABS(IY)
- JZ=ABS(IZ)
- IF(IA .LT. JX .OR. IB .LT. JY .OR. IC .LT. JZ) GO TO 99
- IF(MOD(IA+JX,2) .NE. 0 .OR. MOD(IB+JY,2) .NE. 0) GOTO 99
- IF(MOD(IC+JZ,2) .NE. 0) GO TO 99
- IF(LCG) THEN
- IZ=-IZ
- J0=0
- F=SQRT((IC+1)*R1)
- ELSE
- J0=IA-IB-IZ
- F=1
- ENDIF
- IF(IX+IY+IZ .NE. 0 .OR. MOD(J0,2) .NE. 0) GO TO 99
- K0=IA+IB+IC+2
- K1=IA+IB-IC
- K2=IA-IB+IC
- K3=IB+IC-IA
- IF(K1 .LT. 0 .OR. K2 .LT. 0 .OR. K3 .LT. 0) GO TO 99
- K4=IA+IX
- K5=IB+IY
- K6=IC+IZ
- K7=IA-IX
- K8=IB-IY
- K9=IC-IZ
- K10=IB-IC-IX
- K11=IA-IC+IY
- KA=MAX(0,K10,K11)
- KZ=MIN(K1,K5,K7)
- W=HF*(U(K1)+U(K2)+U(K3)+U(K4)+U(K5)+U(K6)+U(K7)+U(K8)+U(K9)-U(K0))
- S=0
- Q=(-1)**((KA+J0)/2)
- DO 1 K = KA,KZ,2
- S=S+Q*EXP(W-(U(K)+U(K1-K)+U(K5-K)+U(K7-K)+U(K-K10)+U(K-K11)))
- 1 Q=-Q
- H=F*S
- GO TO 99
-
-#if defined(CERNLIB_DOUBLE)
- ENTRY DWIG6J(A1,B1,C1,X1,Y1,Z1)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- ENTRY RWIG6J(A1,B1,C1,X1,Y1,Z1)
-#endif
-
- LJN=.FALSE.
- LRC=.FALSE.
- A=A1
- B=B1
- C=C1
- X=X1
- Y=Y1
- Z=Z1
- GO TO 9
-
-#if defined(CERNLIB_DOUBLE)
- ENTRY DRACAW(A1,B1,C1,X1,Y1,Z1)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- ENTRY RRACAW(A1,B1,C1,X1,Y1,Z1)
-#endif
-
- LJN=.FALSE.
- LRC=.TRUE.
- GO TO 8
-
-#if defined(CERNLIB_DOUBLE)
- ENTRY DJAHNU(A1,B1,C1,X1,Y1,Z1)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- ENTRY RJAHNU(A1,B1,C1,X1,Y1,Z1)
-#endif
-
- LJN=.TRUE.
- LRC=.FALSE.
- 8 A=A1
- B=B1
- C=Y1
- X=X1
- Y=C1
- Z=Z1
-
- 9 H=0
- IA=NINT(2*A)
- IB=NINT(2*B)
- IC=NINT(2*C)
- IF(IA .LT. 0 .OR. IB .LT. 0 .OR. IC .LT. 0) GO TO 99
- IX=NINT(2*X)
- IY=NINT(2*Y)
- IZ=NINT(2*Z)
- IF(IX .LT. 0 .OR. IY .LT. 0 .OR. IZ .LT. 0) GO TO 99
- IABC=IA+IB+IC
- IAYZ=IA+IY+IZ
- IF(MOD(IABC,2) .NE. 0 .OR. MOD(IAYZ,2) .NE. 0) GOTO 99
- IXBZ=IX+IB+IZ
- IXYC=IX+IY+IC
- IF(MOD(IXBZ,2) .NE. 0 .OR. MOD(IXYC,2) .NE. 0) GOTO 99
- K1=IA+IB-IC
- K2=IA-IB+IC
- K3=IB+IC-IA
- IF(K1 .LT. 0 .OR. K2 .LT. 0 .OR. K3 .LT. 0) GO TO 99
- K4=IA+IY-IZ
- K5=IA-IY+IZ
- K6=IY+IZ-IA
- IF(K4 .LT. 0 .OR. K5 .LT. 0 .OR. K6 .LT. 0) GO TO 99
- K7=IX+IB-IZ
- K8=IX-IB+IZ
- K9=IB+IZ-IX
- IF(K7 .LT. 0 .OR. K8 .LT. 0 .OR. K9 .LT. 0) GO TO 99
- K10=IX+IY-IC
- K11=IX-IY+IC
- K12=IY+IC-IX
- IF(K10 .LT. 0 .OR. K11 .LT. 0 .OR. K12 .LT. 0) GO TO 99
- IABXY=IA+IB+IX+IY
- IBCYZ=IB+IC+IY+IZ
- ICAZX=IC+IA+IZ+IX
- KA=MAX(IABC,IAYZ,IXBZ,IXYC)
- KZ=MIN(IABXY,IBCYZ,ICAZX)
- J1=KA
- IF(LRC .OR. LJN) J1=KA+IABXY
- W=HF*(U(K1)+U(K2)+U(K3)-U(IABC+2)+U(K4)+U(K5)+U(K6)-U(IAYZ+2)+
- 1 U(K7)+U(K8)+U(K9)-U(IXBZ+2)+U(K10)+U(K11)+U(K12)-U(IXYC+2))
- S=0
- Q=(-1)**(J1/2)
- DO 2 K = KA,KZ,2
- S=S+Q*EXP(W+U(K+2)-(U(K-IABC)+U(K-IAYZ)+U(K-IXBZ)+U(K-IXYC)+
- 1 U(IABXY-K)+U(IBCYZ-K)+U(ICAZX-K)))
- 2 Q=-Q
- H=S
- IF(LJN) H=SQRT(((IC+1)*(IZ+1))*R1)*H
-
- 99 DWIG3J=H
- RETURN
- END
diff --git a/src/mathlib/gen/u/dwig9j64.F b/src/mathlib/gen/u/dwig9j64.F
deleted file mode 100644
index 5cc6dfd..0000000
--- a/src/mathlib/gen/u/dwig9j64.F
+++ /dev/null
@@ -1,45 +0,0 @@
-*
-* $Id: dwig9j64.F,v 1.1.1.1 1996/04/01 15:01:48 mclareni Exp $
-*
-* $Log: dwig9j64.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:48 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- FUNCTION DWIG9J(A,B,C,P,Q,R,X,Y,Z)
- IMPLICIT DOUBLE PRECISION (A-H,O-Z)
-
- PARAMETER (R1 = 1, HF = R1/2)
-
- IA=NINT(2*A)
- IB=NINT(2*B)
- IC=NINT(2*C)
- IP=NINT(2*P)
- IQ=NINT(2*Q)
- IR=NINT(2*R)
- IX=NINT(2*X)
- IY=NINT(2*Y)
- IZ=NINT(2*Z)
-
- H=0
- IF(IA .LT. 0 .OR. IB .LT. 0 .OR. IC .LT. 0 .OR.
- 1 IP .LT. 0 .OR. IQ .LT. 0 .OR. IR .LT. 0 .OR.
- 2 IX .LT. 0 .OR. IY .LT. 0 .OR. IZ .LT. 0) GO TO 99
- J0=MAX(ABS(IA-IZ),ABS(IY-IP),ABS(IB-IR))
- J1=MIN(IA+IZ,IY+IP,IB+IR)
- S=0
- V=(-1)**J0
- DO 1 J = J0,J1
- AJ=HF*J
- H=DWIG6J(A,P,X,Y,Z,AJ)
- IF(H .NE. 0) H=H*DWIG6J(B,Q,Y,P,AJ,R)
- IF(H .NE. 0) H=H*DWIG6J(C,R,Z,AJ,A,B)
- S=S+V*(AJ+HF)*H
- 1 V=-V
- H=2*S
- 99 DWIG9J=H
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/u/rdjmnb.F b/src/mathlib/gen/u/rdjmnb.F
deleted file mode 100644
index 3d329ef..0000000
--- a/src/mathlib/gen/u/rdjmnb.F
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: rdjmnb.F,v 1.1.1.1 1996/04/01 15:01:49 mclareni Exp $
-*
-* $Log: rdjmnb.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:49 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- FUNCTION RDJMNB(AJ,AM,AN,BETA)
-C
- CHARACTER NAME*(*)
- PARAMETER (NAME = 'RDJMNB')
- ENTRY DJMNB(AJ,AM,AN,BETA)
- CALL MTLPRT(NAME,'U501.0','Not available on this machine')
- DJMNB=0
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/u/rtclgn.F b/src/mathlib/gen/u/rtclgn.F
deleted file mode 100644
index 4b12e2a..0000000
--- a/src/mathlib/gen/u/rtclgn.F
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: rtclgn.F,v 1.1.1.1 1996/04/01 15:01:48 mclareni Exp $
-*
-* $Log: rtclgn.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:48 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- SUBROUTINE RTCLGN(J1,J2,J3,M1,M2,M3,DNUM,DDEN,KPEX)
- CHARACTER*6 NAME
- NAME ='RTCLGN'
- CALL MTLPRT(NAME,'U112',
- +'not available on this machine - see documentation')
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/u/rwig3j.F b/src/mathlib/gen/u/rwig3j.F
deleted file mode 100644
index 20ace90..0000000
--- a/src/mathlib/gen/u/rwig3j.F
+++ /dev/null
@@ -1,45 +0,0 @@
-*
-* $Id: rwig3j.F,v 1.1.1.1 1996/04/01 15:01:48 mclareni Exp $
-*
-* $Log: rwig3j.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:48 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- FUNCTION RWIG3J(A,B,C,X,Y,Z)
- IMPLICIT DOUBLE PRECISION (D)
-
- SROUND(D)=D+(D-SNGL(D))
- RWIG3J=SROUND(
- 1 DWIG3J(DBLE(A),DBLE(B),DBLE(C),DBLE(X),DBLE(Y),DBLE(Z)))
- RETURN
-
- ENTRY RCLEBG(A,B,C,X,Y,Z)
- RCLEBG=SROUND(
- 1 DCLEBG(DBLE(A),DBLE(B),DBLE(C),DBLE(X),DBLE(Y),DBLE(Z)))
- RETURN
-
- ENTRY RWIG6J(A,B,C,X,Y,Z)
- RWIG6J=SROUND(
- 1 DWIG6J(DBLE(A),DBLE(B),DBLE(C),DBLE(X),DBLE(Y),DBLE(Z)))
- RETURN
-
- ENTRY RRACAW(A,B,C,X,Y,Z)
- RRACAW=SROUND(
- 1 DRACAW(DBLE(A),DBLE(B),DBLE(C),DBLE(X),DBLE(Y),DBLE(Z)))
- RETURN
-
- ENTRY RJAHNU(A,B,C,X,Y,Z)
- RJAHNU=SROUND(
- 1 DJAHNU(DBLE(A),DBLE(B),DBLE(C),DBLE(X),DBLE(Y),DBLE(Z)))
- RETURN
-
- ENTRY RWIG9J(A,B,C,P,Q,R,X,Y,Z)
- RWIG9J=SROUND(DWIG9J(DBLE(A),DBLE(B),DBLE(C),DBLE(P),DBLE(Q),
- 1 DBLE(R),DBLE(X),DBLE(Y),DBLE(Z)))
- RETURN
- END
-
-#endif
diff --git a/src/mathlib/gen/u/u100dv.F b/src/mathlib/gen/u/u100dv.F
deleted file mode 100644
index faa0943..0000000
--- a/src/mathlib/gen/u/u100dv.F
+++ /dev/null
@@ -1,15 +0,0 @@
-*
-* $Id: u100dv.F,v 1.1.1.1 1996/04/01 15:01:45 mclareni Exp $
-*
-* $Log: u100dv.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:45 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE U100DV (J,K,L)
- DIMENSION J(40), K(40), L(40)
- DO 1 LL=1,40
- 1 L(LL)=J(LL)-K(LL)
- RETURN
- END
diff --git a/src/mathlib/gen/u/u100fc.F b/src/mathlib/gen/u/u100fc.F
deleted file mode 100644
index e1f8535..0000000
--- a/src/mathlib/gen/u/u100fc.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: u100fc.F,v 1.1.1.1 1996/04/01 15:01:45 mclareni Exp $
-*
-* $Log: u100fc.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:45 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE U100FC (I,K)
- DIMENSION K(40), L(40)
- CALL VZERO (K, 40)
- IF(I) 4,3,2
- 4 K(1)=-77
- RETURN
- 2 DO 5 JK=1,I
- CALL U100PR(JK,L,M)
- DO 5 JM=1,40
- 5 K(JM)=K(JM)+L(JM)
- 3 RETURN
- END
diff --git a/src/mathlib/gen/u/u100pm.F b/src/mathlib/gen/u/u100pm.F
deleted file mode 100644
index 049b760..0000000
--- a/src/mathlib/gen/u/u100pm.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: u100pm.F,v 1.1.1.1 1996/04/01 15:01:45 mclareni Exp $
-*
-* $Log: u100pm.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:45 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE U100PM(J,IN,ID)
- DIMENSION J(40),IPRIME(40)
- DATA IPRIME/2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,53,59,61,67,
- + 71,73,79,83,89,97,101,103,107,109,113,127,131,137,139,149,151,
- + 157,163,167,173/
- IN=1
- ID=1
- DO 1 LL=1,40
- IF(J(LL).GT.0) IN=IN*IPRIME(LL)**J(LL)
- 1 IF(J(LL).LT.0) ID=ID*IPRIME(LL)**(-J(LL))
- RETURN
- END
diff --git a/src/mathlib/gen/u/u100pr.F b/src/mathlib/gen/u/u100pr.F
deleted file mode 100644
index 5966114..0000000
--- a/src/mathlib/gen/u/u100pr.F
+++ /dev/null
@@ -1,36 +0,0 @@
-*
-* $Id: u100pr.F,v 1.1.1.1 1996/04/01 15:01:46 mclareni Exp $
-*
-* $Log: u100pr.F,v $
-* Revision 1.1.1.1 1996/04/01 15:01:46 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE U100PR (I,K,M)
- DIMENSION IPRIME(40),K(40)
- DATA IPRIME/2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,53,59,61,67,
- + 71,73,79,83,89,97,101,103,107,109,113,127,131,137,139,149,151,
- + 157,163,167,173/
- II=I
- M=1
- IF(I.LT.1) GO TO 6
- CALL VZERO (K, 40)
- IF(I.EQ.1) RETURN
- DO 2 KL=1,40
- 1 IF(MOD(I,IPRIME(KL)).NE.0) GO TO 2
- K(KL)=K(KL)+1
- I=I/IPRIME(KL)
- IF(I.EQ.1) GO TO 3
- GO TO 1
- 2 CONTINUE
- IF(I.NE.1) WRITE(6,4) I
- 4 FORMAT(' PRIME NO. LARGER THAN THE LIST,THE FACTOR LEFT=',I15)
- M=I
- 3 I=II
- RETURN
- 6 WRITE(6,7)
- 7 FORMAT(' PLEASE OBSERVE THE CONVENTION OF YOUR ASKING NO. BEING',
- F'LARGER THAN +0')
- RETURN
- END
diff --git a/src/mathlib/gen/v/Imakefile b/src/mathlib/gen/v/Imakefile
deleted file mode 100644
index d970676..0000000
--- a/src/mathlib/gen/v/Imakefile
+++ /dev/null
@@ -1,51 +0,0 @@
-DoIncludePackage(gen)
-#include "pilot.h"
-
-SRCS_F= binomi.F corgen.F corset.F funlux.F funpre.F funran.F funzer.F \ @@\
- graph.F hisran.F iget.F munomi.F normco.F permu.F \ @@\
- pgraph.F poissn.F ran3d.F rangam.F ranlux.F rg32.F rm48.F \ @@\
- rnbnml.F rndm2.F rngama.F rnhran.F rnmnml.F rnorml.F rnormx.F \ @@\
- rnpssn.F rn3dim.F rvnspc64.F trevni.F tup.F
-
-#if defined(CERNLIB_DOUBLE)
-SRCS_F:= $(SRCS_F) rvnspc.F
-#else
-SRCS_F:= $(SRCS_F) dvnspc128.F
-#endif
-
-#if defined(CERNLIB_VAX)
-SRCS_F:= $(SRCS_F) rnorthvx.F
-#endif
-
-#if defined(CERNLIB_UNIX)
-SRCS_F:= $(SRCS_F) rnorthux.F
-#endif
-
-#if defined(CERNLIB_VAXVMS) && !defined(CERNLIB_FORTRAN)
-SRCS_S= norranvx.s nranvx.s rn32ml.s
-#endif
-
-#if !defined(CERNLIB_VAX) || defined(CERNLIB_FORTRAN)
-SRCS_F:= $(SRCS_F) nranf.F rn32.F
-#endif
-
-#if defined(CERNLIB_UNIX) || defined(CERNLIB_QMALPH)
-SRCS_F:= $(SRCS_F) norranux.F
-#endif
-
-FORTRANSAVEOPTION = FortranSaveFlags
-
-#if defined(CERNLIB_SGI)
-IMAKE_DEFINES=-DFortranDoesCpp=NO
-#endif
-
-SubdirLibraryTarget(NullParameter,NullParameter)
-
-#if defined(CERNLIB_SUN) || defined(CERNLIB_QMVAOS)
-SpecialFortranLibObjectRule(norranux,norranux,-O1,NullParameter)
-#endif
-
-#if defined(CERNLIB_QMALPH)
-SpecialFortranObjectRule(norranux,norranux,/NOOPTIMIZE,NullParameter)
-#endif
-
diff --git a/src/mathlib/gen/v/binomi.F b/src/mathlib/gen/v/binomi.F
deleted file mode 100644
index 693c871..0000000
--- a/src/mathlib/gen/v/binomi.F
+++ /dev/null
@@ -1,30 +0,0 @@
-*
-* $Id: binomi.F,v 1.1.1.1 1996/04/01 15:02:55 mclareni Exp $
-*
-* $Log: binomi.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:55 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE BINOMI(NTOT,P,N,IERROR)
-C BINOMIAL GENERATOR
-C CODED FROM LOS ALAMOS REPORT LA-5061-MS
-C PROB(N)=FACT(NTOT)*P**N*(1.-P)**(NTOT-N)/(FACT(N)*FACT(NTOT-N))
-C WHERE FACT(N) STANDS FOR FACTORIAL OF N
-C ON RETURN IERROR.EQ.0 NORMALLY
-C IERROR.EQ.1 IF P.LE.0. OR P.GE.1.
-C
- IF(P.GT.0. .AND. P.LT.1.) GO TO 100
- IERROR=1
- GO TO 999
- 100 CONTINUE
- IERROR=0
- N=0
- DO 200 I=1,NTOT
- IF(RNDM(N).GT.P) GO TO 200
- N=N+1
- 200 CONTINUE
- 999 CONTINUE
- RETURN
- END
diff --git a/src/mathlib/gen/v/corgen.F b/src/mathlib/gen/v/corgen.F
deleted file mode 100644
index b132a8f..0000000
--- a/src/mathlib/gen/v/corgen.F
+++ /dev/null
@@ -1,39 +0,0 @@
-*
-* $Id: corgen.F,v 1.1.1.1 1996/04/01 15:02:55 mclareni Exp $
-*
-* $Log: corgen.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:55 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE CORGEN(C,X,NP)
-C
-C CORSET sets up the generation by calculating C from V.
-C CORGEN generates a set of NP random numbers
-C Gaussian-distributed with covariance matrix V
-C (V = C*C') and mean values zero.
-C
- DIMENSION C(NP,NP), X(NP)
- PARAMETER (NMAX=100)
- DIMENSION Z(NMAX)
-C
- IF (NP .GT. NMAX) GO TO 120
-C
- CALL RNORML(Z,NP)
-C
- DO 100 I= 1, NP
- X(I) = 0.
- DO 90 J= 1, I
- X(I) = X(I) + C(I,J)*Z(J)
- 90 CONTINUE
- 100 CONTINUE
-C
- RETURN
-C Error return
- 120 CONTINUE
- WRITE (6,121) NP,NMAX
- 121 FORMAT (' ERROR IN CORGEN. VECTOR LENGTH NP=',I5,
- 1 ', BUT MAXIMUM ALLOWED IS',I5)
- RETURN
- END
diff --git a/src/mathlib/gen/v/corset.F b/src/mathlib/gen/v/corset.F
deleted file mode 100644
index ada0892..0000000
--- a/src/mathlib/gen/v/corset.F
+++ /dev/null
@@ -1,44 +0,0 @@
-*
-* $Id: corset.F,v 1.1.1.1 1996/04/01 15:02:56 mclareni Exp $
-*
-* $Log: corset.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:56 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE CORSET (V,C,NP)
-C Correlated Gaussian random number package
-C
-C CORSET sets up the generation
-C CORGEN actually generates a set of NP random numbers
-C Gaussian-distributed with covariance matrix V
-C and mean values zero.
-C
-C NP is dimension of vectors and matrices
-C V(NP,NP) is covariance matrix
-C C(NP,NP) is working space used internally to hold the
-C 'square root' of V
-C X(NP) is the vector of random numbers generated by CORGEN
-C
- DIMENSION V(NP,NP), C(NP,NP)
-C
-C Compute C = square root of matrix V
- DO 40 J=1,NP
-C Diagonal terms
- CK = 0.
- DO 10 K= 1, J-1
- 10 CK = CK + C(J,K)*C(J,K)
- C(J,J) = SQRT(ABS(V(J,J) - CK))
-C
-C Off-diagonal terms
- DO 30 I= J+1, NP
- CK = 0.
- DO 20 K= 1, J-1
- 20 CK = CK + C(I,K)*C(J,K)
- C(I,J) = (V(I,J) - CK) /C(J,J)
- 30 CONTINUE
- 40 CONTINUE
-C
- RETURN
- END
diff --git a/src/mathlib/gen/v/dvnspc128.F b/src/mathlib/gen/v/dvnspc128.F
deleted file mode 100644
index 80b9df8..0000000
--- a/src/mathlib/gen/v/dvnspc128.F
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: dvnspc128.F,v 1.1.1.1 1996/04/01 15:02:58 mclareni Exp $
-*
-* $Log: dvnspc128.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:58 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION DVNSPC(R,RHO,D)
-C
-#include "gen/imp128.inc"
- DVNSPC=0
- CALL MTLPRT('DVNSPC','V700.0','Not available on this machine')
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/v/funlux.F b/src/mathlib/gen/v/funlux.F
deleted file mode 100644
index 3b7d6e1..0000000
--- a/src/mathlib/gen/v/funlux.F
+++ /dev/null
@@ -1,284 +0,0 @@
- SUBROUTINE FUNLXP (FUNC,XFCUM,X2LOW,X2HIGH)
-C F. JAMES, Sept, 1994
-C
-C Prepares the user function FUNC for FUNLUX
-C Inspired by and mostly copied from FUNPRE and FUNRAN
-C except that
-C 1. FUNLUX uses RANLUX underneath,
-C 2. FUNLXP expands the first and last bins to cater for
-C functions with long tails on left and/or right,
-C 3. FUNLXP calls FUNPCT to do the actual finding of percentiles.
-C 4. both FUNLXP and FUNPCT use RADAPT for Gaussian integration.
-C
- EXTERNAL FUNC
- COMMON/FUNINT/TFTOT
- DIMENSION XFCUM(200)
- PARAMETER (RTEPS=0.0002)
- SAVE IFUNC
- DATA IFUNC/0/
- IFUNC = IFUNC + 1
-C FIND RANGE WHERE FUNCTION IS NON-ZERO.
- CALL FUNLZ(FUNC,X2LOW,X2HIGH,XLOW,XHIGH)
- XRANGE = XHIGH-XLOW
- IF(XRANGE .LE. 0.) THEN
- WRITE (6,'(A,2G15.5)') ' FUNLXP finds function range .LE.0',
- + XLOW,XHIGH
- GO TO 900
- ENDIF
- CALL RADAPT(FUNC,XLOW,XHIGH,1,RTEPS,0.,TFTOT ,UNCERT)
- WRITE(6,1003) IFUNC,XLOW,XHIGH,TFTOT
- 1003 FORMAT(' FUNLXP: integral of USER FUNCTION',
- + I3,' from ',E12.5,' to ',E12.5,' is ',E14.6)
-C
-C WRITE (6,'(A,A)') ' FUNLXP preparing ',
-C + 'first the whole range, then left tail, then right tail.'
- CALL FUNPCT(FUNC,IFUNC,XLOW,XHIGH,XFCUM,1,99,TFTOT,IERR)
- IF (IERR .GT. 0) GO TO 900
- X2 = XFCUM(3)
- CALL RADAPT(FUNC,XLOW,X2,1,RTEPS,0.,TFTOT1 ,UNCERT)
- CALL FUNPCT(FUNC,IFUNC,XLOW,X2 ,XFCUM,101,49,TFTOT1,IERR)
- IF (IERR .GT. 0) GO TO 900
- X3 = XFCUM(98)
- CALL RADAPT(FUNC,X3,XHIGH,1,RTEPS,0.,TFTOT2 ,UNCERT)
- CALL FUNPCT(FUNC,IFUNC,X3,XHIGH,XFCUM,151,49,TFTOT2,IERR)
- IF (IERR .GT. 0) GO TO 900
- WRITE(6,1001) IFUNC,XLOW,XHIGH
- 1001 FORMAT(' FUNLXP has prepared USER FUNCTION',I3,
- + ' between',G12.3,' and',G12.3,' for FUNLUX')
- RETURN
- 900 CONTINUE
- WRITE (6,'(A)') ' Fatal error in FUNLXP. FUNLUX will not work.'
- END
-C
- SUBROUTINE FUNPCT(FUNC,IFUNC,XLOW,XHIGH,XFCUM,NLO,NBINS,TFTOT,
- + IERR)
-C Array XFCUM is filled from NLO to NLO+NBINS, which makes
-C the number of values NBINS+1, or the number of bins NBINS
- EXTERNAL FUNC
- DIMENSION XFCUM(*)
- PARAMETER (RTEPS=0.005, NZ=10, MAXZ=20, NITMAX=6,PRECIS=1.E-6)
-CC DOUBLE PRECISION TPCTIL, TZ, TCUM, XINCR, DTABS,
-CC + TINCR, TZMAX, XBEST, DTBEST, DTPAR2
-C
- IERR = 0
- IF (TFTOT .LE. 0.) GO TO 900
- TPCTIL = TFTOT/NBINS
- TZ = TPCTIL/NZ
- TZMAX = TZ * 2.
- XFCUM(NLO) = XLOW
- XFCUM(NLO+NBINS) = XHIGH
- X = XLOW
- F = FUNC(X)
- IF (F .LT. 0.) GO TO 900
-C Loop over percentile bins
- DO 600 IBIN = NLO, NLO+NBINS-2
- TCUM = 0.
- X1 = X
- F1 = F
- DXMAX = (XHIGH -X) / NZ
- FMIN = TZ/DXMAX
- FMINZ = FMIN
-C Loop over trapezoids within a supposed percentile
- DO 500 IZ= 1, MAXZ
- XINCR = TZ/MAX(F1,FMIN,FMINZ)
- 350 X = X1 + XINCR
- F = FUNC(X)
- IF (F .LT. 0.) GO TO 900
- TINCR = (X-X1) * 0.5 * (F+F1)
- IF (TINCR .LT. TZMAX) GO TO 370
- XINCR = XINCR * 0.5
- GO TO 350
- 370 CONTINUE
- TCUM = TCUM + TINCR
- IF (TCUM .GE. TPCTIL*0.99) GO TO 520
- FMINZ = TZ*F/ (TPCTIL-TCUM)
- F1 = F
- X1 = X
- 500 CONTINUE
- WRITE(6,'(A)') ' FUNLUX: WARNING. FUNPCT fails trapezoid.'
-C END OF TRAPEZOID LOOP
-C Adjust interval using Gaussian integration with
-C Newton corrections since F is the derivative
- 520 CONTINUE
- X1 = XFCUM(IBIN)
- XBEST = X
- DTBEST = TPCTIL
- TPART = TPCTIL
-C Allow for maximum NITMAX more iterations on RADAPT
- DO 550 IHOME= 1, NITMAX
- 535 XINCR = (TPCTIL-TPART) / MAX(F,FMIN)
- X = XBEST + XINCR
- X2 = X
- IF (IHOME .GT. 1 .AND. X2 .EQ. XBEST) THEN
- WRITE (6,'(A,G12.3)')
- + ' FUNLUX: WARNING from FUNPCT: insufficient precision at X=',X
- GO TO 580
- ENDIF
- REFX = ABS(X)+PRECIS
- CALL RADAPT(FUNC,X1,X2,1,RTEPS,0.,TPART2,UNCERT)
- DTPAR2 = TPART2-TPCTIL
- DTABS = ABS(DTPAR2)
- IF(ABS(XINCR)/REFX .LT. PRECIS) GOTO 545
- IF(DTABS .LT. DTBEST) GOTO 545
- XINCR = XINCR * 0.5
- GOTO 535
- 545 DTBEST = DTABS
- XBEST = X
- TPART = TPART2
- F = FUNC(X)
- IF(F .LT. 0.) GOTO 900
- IF(DTABS .LT. RTEPS*TPCTIL) GOTO 580
- 550 CONTINUE
- WRITE (6,'(A,I4)')
- + ' FUNLUX: WARNING from FUNPCT: cannot converge, bin',IBIN
-C
- 580 CONTINUE
- XINCR = (TPCTIL-TPART) / MAX(F,FMIN)
- X = XBEST + XINCR
- XFCUM(IBIN+1) = X
- F = FUNC(X)
- IF(F .LT. 0.) GOTO 900
- 600 CONTINUE
-C END OF LOOP OVER BINS
- X1 = XFCUM(NLO+NBINS-1)
- X2 = XHIGH
- CALL RADAPT(FUNC,X1,X2,1,RTEPS,0.,TPART ,UNCERT)
- ABERR = ABS(TPART-TPCTIL)/TFTOT
-C WRITE(6,1001) IFUNC,XLOW,XHIGH
- IF(ABERR .GT. RTEPS) WRITE(6,1002) ABERR
- RETURN
- 900 WRITE(6,1000) X,F
- IERR = 1
- RETURN
- 1000 FORMAT(/' FUNLUX fatal error in FUNPCT: function negative:'/
- + ,' at X=',E15.6,', F=',E15.6/)
-C 1001 FORMAT(' FUNPCT has prepared USER FUNCTION',I3,
-C + ' between',G12.3,' and',G12.3,' for FUNLUX.')
- 1002 FORMAT(' WARNING: Relative error in cumulative distribution',
- + ' may be as big as',F10.7)
- END
- SUBROUTINE FUNLUX(ARRAY,XRAN,LEN)
-C Generation of LEN random numbers in any given distribution,
-C by 4-point interpolation in the inverse cumulative distr.
-C which was previously generated by FUNLXP
- COMMON/FUNINT/XUNI
- DIMENSION ARRAY(200)
- DIMENSION XRAN(LEN)
-C Bin width for main sequence, and its inverse
- PARAMETER (GAP= 1./99., GAPINV=99.)
-C Top of left tail, bottom of right tail (each tail replaces 2 bins)
- PARAMETER (TLEFT= 2./99.,BRIGHT=97./99.)
-C Bin width for minor sequences (tails), and its inverse
- PARAMETER (GAPS=TLEFT/49., GAPINS=1./GAPS)
-C
-C The array ARRAY is assumed to have the following structure:
-C ARRAY(1-100) contains the 99 bins of the inverse cumulative
-C distribution of the entire function.
-C ARRAY(101-150) contains the 49-bin blowup of main bins
-C 1 and 2 (left tail of distribution)
-C ARRAY(151-200) contains the 49-bin blowup of main bins
-C 98 and 99 (right tail of distribution)
-C
- CALL RANLUX(XRAN,LEN)
-
- DO 500 IBUF= 1, LEN
- X = XRAN(IBUF)
- J = INT( X *GAPINV) + 1
- IF (J .LT. 3) THEN
- J1 = INT( X *GAPINS)
- J = J1 + 101
- J = MAX(J,102)
- J = MIN(J,148)
- P = ( X -GAPS*(J1-1)) * GAPINS
- A = (P+1.0) * ARRAY(J+2) - (P-2.0)*ARRAY(J-1)
- B = (P-1.0) * ARRAY(J) - P * ARRAY(J+1)
- XRAN(IBUF) = A*P*(P-1.0)*0.16666667 + B*(P+1.0)*(P-2.0)*0.5
- ELSE IF (J .GT. 97) THEN
- J1 = INT((X-BRIGHT)*GAPINS)
- J = J1 + 151
- J = MAX(J,152)
- J = MIN(J,198)
- P = (X -BRIGHT -GAPS*(J1-1)) * GAPINS
- A = (P+1.0) * ARRAY(J+2) - (P-2.0)*ARRAY(J-1)
- B = (P-1.0) * ARRAY(J) - P * ARRAY(J+1)
- XRAN(IBUF) = A*P*(P-1.0)*0.16666667 + B*(P+1.0)*(P-2.0)*0.5
- ELSE
-CC J = MAX(J,2)
-CC J = MIN(J,98)
- P = ( X -GAP*(J-1)) * GAPINV
- A = (P+1.0) * ARRAY(J+2) - (P-2.0)*ARRAY(J-1)
- B = (P-1.0) * ARRAY(J) - P * ARRAY(J+1)
- XRAN(IBUF) = A*P*(P-1.0)*0.16666667 + B*(P+1.0)*(P-2.0)*0.5
- ENDIF
- 500 CONTINUE
- XUNI = X
- RETURN
- END
- SUBROUTINE FUNLZ(FUNC,X2LOW,X2HIGH,XLOW,XHIGH)
-C FIND RANGE WHERE FUNC IS NON-ZERO.
-C WRITTEN 1980, F. JAMES
-C MODIFIED, NOV. 1985, TO FIX BUG AND GENERALIZE
-C TO FIND SIMPLY-CONNECTED NON-ZERO REGION (XLOW,XHIGH)
-C ANYWHERE WITHIN THE GIVEN REGION (X2LOW,H2HIGH).
-C WHERE 'ANYWHERE' MEANS EITHER AT THE LOWER OR UPPER
-C EDGE OF THE GIVEN REGION, OR, IF IN THE MIDDLE,
-C COVERING AT LEAST 1% OF THE GIVEN REGION.
-C OTHERWISE IT IS NOT GUARANTEED TO FIND THE NON-ZERO REGION.
-C IF FUNCTION EVERYWHERE ZERO, FUNLZ SETS XLOW=XHIGH=0.
- EXTERNAL FUNC
- XLOW = X2LOW
- XHIGH = X2HIGH
-C FIND OUT IF FUNCTION IS ZERO AT ONE END OR BOTH
- XMID = XLOW
- IF (FUNC(XLOW) .GT. 0.) GO TO 120
- XMID = XHIGH
- IF (FUNC(XHIGH) .GT. 0.) GO TO 50
-C FUNCTION IS ZERO AT BOTH ENDS,
-C LOOK FOR PLACE WHERE IT IS NON-ZERO.
- DO 30 LOGN= 1, 7
- NSLICE = 2**LOGN
- DO 20 I= 1, NSLICE, 2
- XMID = XLOW + I * (XHIGH-XLOW) / NSLICE
- IF (FUNC(XMID) .GT. 0.) GO TO 50
- 20 CONTINUE
- 30 CONTINUE
-C FALLING THROUGH LOOP MEANS CANNOT FIND NON-ZERO VALUE
- WRITE(6,554)
- WRITE(6,555) XLOW, XHIGH
- XLOW = 0.
- XHIGH = 0.
- GO TO 220
-C
- 50 CONTINUE
-C DELETE 'LEADING' ZERO RANGE
- XH = XMID
- XL = XLOW
- DO 70 K= 1, 20
- XNEW = 0.5*(XH+XL)
- IF (FUNC(XNEW) .EQ. 0.) GO TO 68
- XH = XNEW
- GO TO 70
- 68 XL = XNEW
- 70 CONTINUE
- XLOW = XL
- WRITE(6,555) X2LOW,XLOW
- 120 CONTINUE
- IF (FUNC(XHIGH) .GT. 0.) GO TO 220
-C DELETE 'TRAILING' RANGE OF ZEROES
- XL = XMID
- XH = XHIGH
- DO 170 K= 1, 20
- XNEW = 0.5*(XH+XL)
- IF (FUNC(XNEW) .EQ. 0.) GO TO 168
- XL = XNEW
- GO TO 170
- 168 XH = XNEW
- 170 CONTINUE
- XHIGH = XH
- WRITE(6,555) XHIGH, X2HIGH
-C
- 220 CONTINUE
- RETURN
- 554 FORMAT('0CANNOT FIND NON-ZERO FUNCTION VALUE')
- 555 FORMAT(' FUNCTION IS ZERO FROM X=',E12.5,' TO ',E12.5)
- END
diff --git a/src/mathlib/gen/v/funpre.F b/src/mathlib/gen/v/funpre.F
deleted file mode 100644
index d0ed3c4..0000000
--- a/src/mathlib/gen/v/funpre.F
+++ /dev/null
@@ -1,134 +0,0 @@
-*
-* $Id: funpre.F,v 1.1.1.1 1996/04/01 15:02:57 mclareni Exp $
-*
-* $Log: funpre.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:57 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE FUNPRE (FUNC,XFCUM,X2LOW,X2HIGH)
-C F. JAMES, MAY, 1976
-C MODIFIED OCT, 1980 TO ADD PRINTOUT OF INTEGRAL
-C MODIFIED DEC., 1980 TO DELETE LEADING AND TRAILING
-C RANGES OF X WHERE FUNCTION IS ZERO.
-C MODIFIED JUNE,1982 TO FIX POSSIBLE INFINITE LOOP.
-C
-C PREPARES THE USER FUNCTION "FUNC" FOR FUNRAN
-C BY FINDING THE PERCENTILES
-C (IN EFFECT, INVERTING THE CUMULATIVE DISTRIBUTION)
- EXTERNAL FUNC
- COMMON/FUNINT/TFTOT
- DIMENSION XFCUM(100)
- DATA NBINS / 99/
- DATA NZ / 10/
- DATA MAXZ / 20/
- DATA NITMAX / 6 /
- DATA IFUNC/0/
- IFUNC = IFUNC + 1
-C FIND MACHINE ACCURACY
- COMP1 = 1.0
- DO 200 I= 1, 100
- COMP1 = COMP1*0.5
- COMP2 = 1.0 - COMP1
- IF(COMP2 .EQ. 1.0) GOTO 210
- 200 CONTINUE
- COMP1 = 1.0E-10
- 210 PRECIS = COMP1
-C FIND RANGE WHERE FUNCTION IS NON-ZERO.
- CALL FUNZER(FUNC,X2LOW,X2HIGH,XLOW,XHIGH)
- XRANGE = XHIGH-XLOW
- IF(XRANGE .LE. 0.) GOTO 900
- RTEPS = MAX(0.0001,PRECIS*10.)
- TFTOT = GAUSS(FUNC,XLOW,XHIGH,RTEPS)
-C PRINT OUT VALUE OF NORMALIZATION INTEGRAL
- WRITE(6,1003) IFUNC,XLOW,XHIGH,TFTOT
- RTEPS = 0.001
- IF(TFTOT .LE. 0.) GOTO 900
- TPCTIL = TFTOT/NBINS
- TZ = TPCTIL/NZ
- TZMAX = TZ * 2.
- XFCUM(1) = XLOW
- XFCUM(NBINS+1) = XHIGH
- X = XLOW
- F = FUNC(X)
- IF(F .LT. 0.) GOTO 900
- NBINM1 = NBINS - 1
-C LOOP OVER BINS (HUNDREDTH PERCENTILES)
- DO 600 IBIN = 1, NBINM1
- TCUM = 0.
- X1 = X
- F1 = F
- DXMAX = (XHIGH -X) / NZ
- FMIN = TZ/DXMAX
- FMINZ = FMIN
-C LOOP OVER TRAPEZOIDS WITHIN A SUPPOSED PERCENTILE
- DO 500 IZ= 1, MAXZ
- XINCR = TZ/MAX(F1,FMIN,FMINZ)
- 350 X = X1 + XINCR
- F = FUNC(X)
- IF(F .LT. 0.) GOTO 900
- TINCR = (X-X1) * 0.5 * (F+F1)
- IF(TINCR .LT. TZMAX) GOTO 370
- XINCR = XINCR * 0.5
- GOTO 350
- 370 CONTINUE
- TCUM = TCUM + TINCR
- IF(TCUM .GE. TPCTIL*0.99) GOTO 520
- FMINZ = TZ*F/ (TPCTIL-TCUM)
- F1 = F
- X1 = X
- 500 CONTINUE
- WRITE(6,2000)
- 2000 FORMAT('0 FAILURE TO FIND TRAPEZOID HELP')
-C END OF TRAPEZOID LOOP
-C ADJUST TRAPEZOID INTEGRAL BY GAUSS WITH NEWTON CORRECTION
- 520 CONTINUE
- X1 = XFCUM(IBIN)
- XBEST = X
- DTBEST = TPCTIL
- TPART = TPCTIL
-C ALLOW FOR MAXIMUM NITMAX MORE ITERATIONS ON GAUSS
- DO 550 IHOME= 1, NITMAX
- XINCR = (TPCTIL-TPART) / MAX(F,FMIN)
- 535 X = XBEST + XINCR
- X2 = X
- TPART2 = GAUSS(FUNC,X1,X2,RTEPS)
- DTPAR2 = TPART2-TPCTIL
- DTABS = ABS(DTPAR2)
- IF(ABS(XINCR) .LT. PRECIS) GOTO 545
- IF(DTABS .LT. DTBEST) GOTO 545
- XINCR = XINCR * 0.5
- GOTO 535
- 545 DTBEST = DTABS
- XBEST = X
- IF(DTABS .LT. RTEPS*TPCTIL) GOTO 580
- TPART = TPART2
- F = FUNC(X)
- 550 CONTINUE
- IHOME = NITMAX
-C
- 580 CONTINUE
- XFCUM(IBIN+1) = X
- F = FUNC(X)
- IF(F .LT. 0.) GOTO 900
- 600 CONTINUE
-C END OF LOOP OVER BINS
- X1 = XFCUM(NBINS)
- X2 = XHIGH
- TPART = GAUSS(FUNC,X1,X2,RTEPS)
- ABERR = ABS(TPART-TPCTIL)/TFTOT
- WRITE(6,1001) IFUNC,ABERR
- IF(ABERR .GT. RTEPS) WRITE(6,1002)
- RETURN
- 900 WRITE(6,1000) X,F,XLOW,XHIGH
- RETURN
- 1000 FORMAT('0FUNPRE FINDS NEGATIVE FUNCTION VALUE OR RANGE OF X'/
- + ,' X=',E15.6,', F=',E15.6,20X,'XLOW=',E15.6,' XHIGH=',E15.6/)
- 1001 FORMAT(' SUBROUTINE FUNPRE HAS PREPARED USER FUNCTION NUMBER',I4,
- + ' FOR FUNRAN'/' MAXIMUM RELATIVE ERROR IN CUMULATIVE',
- + 'DISTRIBUTION WILL BE',E15.5)
- 1002 FORMAT('+',80X,'WARNING,THIS MAY BE TOO BIG'//)
- 1003 FORMAT('0SUBROUTINE FUNPRE FINDS THE INTEGRAL OF USER FUNCTION',
- + I2,' FROM ',E12.5,' TO ',E12.5,' IS ',E14.6)
- END
diff --git a/src/mathlib/gen/v/funran.F b/src/mathlib/gen/v/funran.F
deleted file mode 100644
index 400b9e1..0000000
--- a/src/mathlib/gen/v/funran.F
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: funran.F,v 1.1.1.1 1996/04/01 15:02:57 mclareni Exp $
-*
-* $Log: funran.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:57 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE FUNRAN(ARRAY,XRAN)
-C GENERATION OF RANDOM NUMBERS IN ANY GIVEN DISTRIBUTION, BY
-C 4-POINT INTERPOLATION IN THE INVERSE CUMULATIVE DISTR.
-C WHICH WAS PREVIOUSLY GENERATED BY FUNPRE
- SAVE RBUF, IBUF, GAP, GAPINV
- COMMON/FUNINT/X
- DIMENSION ARRAY(100)
- DIMENSION RBUF(20)
- DATA IBUF/20/
- DATA GAP,GAPINV/.0101010101,99./
-C
- IF (IBUF .LT. 20) GO TO 10
- CALL NRAN(RBUF,020)
- IBUF = 0
- 10 IBUF = IBUF + 1
- X = RBUF(IBUF)
- J = INT( X *GAPINV) + 1
- J = MAX(J,2)
- J = MIN(J,98)
- P = ( X -GAP*(J-1)) * GAPINV
- A = (P+1.0) * ARRAY(J+2) - (P-2.0)*ARRAY(J-1)
- B = (P-1.0) * ARRAY(J) - P * ARRAY(J+1)
- XRAN = A*P *(P-1.0) *0.16666667 + B * (P+1.0) * (P-2.0) * 0.5
- RETURN
- END
diff --git a/src/mathlib/gen/v/funzer.F b/src/mathlib/gen/v/funzer.F
deleted file mode 100644
index cf3fe28..0000000
--- a/src/mathlib/gen/v/funzer.F
+++ /dev/null
@@ -1,77 +0,0 @@
-*
-* $Id: funzer.F,v 1.1.1.1 1996/04/01 15:02:57 mclareni Exp $
-*
-* $Log: funzer.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:57 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE FUNZER(FUNC,X2LOW,X2HIGH,XLOW,XHIGH)
-C FIND RANGE WHERE FUNC IS NON-ZERO.
-C WRITTEN 1980, F. JAMES
-C MODIFIED, NOV. 1985, TO FIX BUG AND GENERALIZE
-C TO FIND SIMPLY-CONNECTED NON-ZERO REGION (XLOW,XHIGH)
-C ANYWHERE WITHIN THE GIVEN REGION (X2LOW,H2HIGH).
-C WHERE 'ANYWHERE' MEANS EITHER AT THE LOWER OR UPPER
-C EDGE OF THE GIVEN REGION, OR, IF IN THE MIDDLE,
-C COVERING AT LEAST 1% OF THE GIVEN REGION.
-C OTHERWISE IT IS NOT GUARANTEED TO FIND THE NON-ZERO REGION.
-C IF FUNCTION EVERYWHERE ZERO, FUNZER SETS XLOW=XHIGH=0.
- EXTERNAL FUNC
- XLOW = X2LOW
- XHIGH = X2HIGH
-C FIND OUT IF FUNCTION IS ZERO AT ONE END OR BOTH
- XMID = XLOW
- IF (FUNC(XLOW) .GT. 0.) GO TO 120
- XMID = XHIGH
- IF (FUNC(XHIGH) .GT. 0.) GO TO 50
-C FUNCTION IS ZERO AT BOTH ENDS,
-C LOOK FOR PLACE WHERE IT IS NON-ZERO.
- DO 30 LOGN= 1, 7
- NSLICE = 2**LOGN
- DO 20 I= 1, NSLICE, 2
- XMID = XLOW + I * (XHIGH-XLOW) / NSLICE
- IF (FUNC(XMID) .GT. 0.) GO TO 50
- 20 CONTINUE
- 30 CONTINUE
-C FALLING THROUGH LOOP MEANS CANNOT FIND NON-ZERO VALUE
- WRITE(6,554)
- WRITE(6,555) XLOW, XHIGH
- XLOW = 0.
- XHIGH = 0.
- GO TO 220
-C
- 50 CONTINUE
-C DELETE 'LEADING' ZERO RANGE
- XH = XMID
- XL = XLOW
- DO 70 K= 1, 20
- XNEW = 0.5*(XH+XL)
- IF (FUNC(XNEW) .EQ. 0.) GO TO 68
- XH = XNEW
- GO TO 70
- 68 XL = XNEW
- 70 CONTINUE
- XLOW = XL
- WRITE(6,555) X2LOW,XLOW
- 120 CONTINUE
- IF (FUNC(XHIGH) .GT. 0.) GO TO 220
-C DELETE 'TRAILING' RANGE OF ZEROES
- XL = XMID
- XH = XHIGH
- DO 170 K= 1, 20
- XNEW = 0.5*(XH+XL)
- IF (FUNC(XNEW) .EQ. 0.) GO TO 168
- XL = XNEW
- GO TO 170
- 168 XH = XNEW
- 170 CONTINUE
- XHIGH = XH
- WRITE(6,555) XHIGH, X2HIGH
-C
- 220 CONTINUE
- RETURN
- 554 FORMAT('0CANNOT FIND NON-ZERO FUNCTION VALUE')
- 555 FORMAT(' FUNCTION IS ZERO FROM X=',E12.5,' TO ',E12.5)
- END
diff --git a/src/mathlib/gen/v/graph.F b/src/mathlib/gen/v/graph.F
deleted file mode 100644
index 4c7690a..0000000
--- a/src/mathlib/gen/v/graph.F
+++ /dev/null
@@ -1,232 +0,0 @@
-*
-* $Id: graph.F,v 1.1.1.1 1996/04/01 15:02:57 mclareni Exp $
-*
-* $Log: graph.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:57 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE GRAPH(H, IE, INOD, ISL, NPTR, NISL)
-C
-C DESCRIPTION OF PARAMETERS
-C
-C H(3,96) INP MUST CONTAIN THE INCIDENCE-MATRIX OF THE GRAPH IN
-C BIT FORMAT, I.E. THE MATRIX IS PACKED INTO A BITSTRIN
-C (USE *SETBIT* FOR THIS PURPOSE.
-C CALLING SEQUENCE IS 'CALL SETBIT(N, A, BIT)'
-C SETS THE N-TH BIT OF STRING A (COUNTED FROM LEFT TO
-C RIGHT) TO THE VALUE OF 'BIT' (0 OR 1))
-C H(I,J) = 1 IF THERE'S AN EDGE FROM NODE I TO NODE J
-C H(I,J) = 0 ELSE
-C IE INP NUMBER OF EDGES IN THE GRAPH
-C THIS VALUE IS USED FOR PLAUSIBILITY-CONTROL ONLY
-C INOD INP NUMBER OF NODES IN THE GRAPH
-C ISL(96) OUT ONE SOLUTION EXTRACTED OUT OF THE GRAPH
-C IF H(I,J) REPRESENTS AN INCOMPATIBILITY GRAPH, THEN
-C ISL(1) ... ISL(NPTR) CONTAINS THE REMAINING COMPATIBL
-C NODES, IF THE NODES ISL(NPTR+1) ... ISL(NISL) ARE
-C REMOVED FROM THE GRAPH.
-C N O T E : ISL CONTAINS, HOWEVER, ONLY NODES WITHIN
-C THE CURRENT SUBGRAPH, IF NISL WAS 0 IN THE FIRST CALL
-C NPTR OUT CONFER *ISL*
-C NISL I/O CONTROLS THE FLOW OF THE ROUTINE AND INDICATES
-C THE TYPE OF RESULT ON OUTPUT.
-C INPUT.. 0 IF H, IE, INOD DESCRIBE A NEW GRAPH, FROM WHICH TH
-C FIRST SOLUTION OF ITS FIRST SUBGRAPH IS TO BE EXTR
-C -1 THE GRAPH WON'T BE SPLIT UP INTO SUBGRAPHS. THE
-C GRAPH IS THEREFORE TREATED AS A SINGLE SUBGRAPH
-C INCLUDING ALL ITS ISOLATED NODES. IF THERE ARE
-C MANY SUBGRAPHS, THEN THE NUMBER OF SOLUTIONS MAY
-C BECOME QUITE LARGE.
-C 1 IF THE NEXT SOLUTION OF THE CURRENT SUBGRAPH IS TO
-C EXTRACTED
-C 2 IF FURTHER SOLUTIONS OF THE CURRENT SUBGRAPH ARE T
-C BE DROPPED AND THE NEXT SOLUTION OF THE NEXT SUBGR
-C IS TO BE EVALUATED.
-C OUTPUT. -1 THERE'S NO FURTHER SOLUTION AVAILABLE IN THE GRAPH
-C ('END-OF-GRAPH' - INDICATION)
-C 0 LAST SOLUTION GIVEN WAS THE LAST ONE IN THE CURREN
-C SUBGRAPH ('END-OF-SUBGRAPH' - INDICATION)
-C .GT.0 CONFER *ISL*
-C IF NISL IS EQUAL TO 0 OR -1, THE CONTENTS OF ISL ARE
-C UNDEFINED.(THERE'S NO SOLUTION STORED)
-C
-C WRONG CALLING SEQUENCE OR UNBELIEVABLE PARAMETER VALUES FORCE
-C A RETURN WITH NISL = NPTR = -1. (ISL REMAINS UNDEFINED)
-C
-C DESCRIPTION OF IMPORTANT PROGRAM VARIABLES
-C
-C IV(3), IF(3) THESE TWO BITSTRINGS ARE USED BY THE ALGORITHM TO EXT
-C SUBGRAPHS OUT OF THE GRAPH GIVEN (BY H, IE, INOD)
-C IV(I)=1,IF(I)=0 NODE I HASN'T YET BEEN INVESTIGATED BY THE AL
-C IV(I)=0,IF(I)=1 THIS NODE SURELY BELONGS TO THE SUBGRAPH NOW
-C UNDER CONSTRUCTION AND THERE MIGHT BE EDGES LEADING
-C TO ADJACENT NODES
-C IV(I)=0,IF(I)=0 THIS NODE (I) IS DEACTIVATED, I.E. ALL INCIDEN
-C EDGES HAVE BEEN REMOVED AND ADDED TO THE SUBGRAPH.
-C IPTR GIVES THE CURRENT LENGTH OF THE EDGE INCLUSION TABLE(EIT) WHI
-C DESCRIBES THE SUBGRAPH. (THE EIT IS THEN PASSED TO *PGRAPH*
-C FOR EVALUATION).
-C IZ CONTROL VARIABLE FOR PGRAPH (SEE DESCRIPTION OF *PGRAPH*)
-C NINFO, INFO(96) SINCE PGRAPH REQUIRES THE NODES OF THE DELIVERED GR
-C TO BE SEQUENTIALLY NUMBERED, EACH SUBGRAPH GENERATED BY GRAPH
-C MUST BE RENUMBERED, BEFORE IT IS PASSED TO PGRAPH. WHEN PGRAP
-C RETURNS A SOLUTION, THE ORIGINAL NUMBERS OF THE NODES MUST BE
-C RECONSTRUCTED PRIOR TO THE RETURN-TO-MAINLINE. TO PROVIDE
-C THIS, FOR NODE I INFO(I) CONTAINS ITS SEQUENTIAL NUMBER WITHI
-C THE SUBGRAPH. THE SEQU. NUMBER IS UPDATED IN NINFO.
-C
- INTEGER EIT(652,2)
- +, IV(3)
- +, IF(3)
- +, INFO(96)
- +, ISL(96)
- +, H(3,96)
- LOGICAL BYPASS,SPLIT
- COMMON /BITSXB/ NBITPW, NBYTPW
- DATA BYPASS /.FALSE./
- DATA NOLD /-1/
- DATA IZ/0/
-#if defined(CERNLIB_CDC)
- DATA IFILWD/-0/
- NBITPW=60
-#endif
-#if defined(CERNLIB_NORD)
- DATA IFILWD / 37777777777B/
- NBITPW=32
-#endif
-#if (!defined(CERNLIB_DOUBLE))&&(!defined(CERNLIB_CDC))
- DATA IFILWD/-1/
- NBITPW=64
-#endif
-#if (defined(CERNLIB_DOUBLE))&&(!defined(CERNLIB_NORD))
- DATA IFILWD/-1/
- NBITPW=32
-#endif
- NPTR = -1
- IF(NISL - 1) 999,555,111
-C
-C DO SOME ERROR CHECKING
-C DON'T PROCESS GRAPH ON IMPROPER CALLING SEQUENCE
-C
-999 IF(IE.GT.652*(NBITPW/8)) GOTO 888
- IF(IE.LT.0) GOTO 888
- IF(INOD.GT.96) GOTO 888
- IF(INOD.LE.1) GOTO 888
- NOLD = 0
- IF(BYPASS) GOTO 777
- NBYTPW = NBITPW/8
- BYPASS = .TRUE.
-777 CONTINUE
-C
-C CHECK, WHETHER TO SPLIT UP INTO SUBGRAPHS OR NOT.
-C
- IF(NISL.NE.-1) GOTO 666
-C
-C DON'T SPLIT
-C
- SPLIT = .FALSE.
- IPTR = 0
-C
-C CONSTRUCT EIT
-C
- DO 40 I = 2,INOD
- II = I - 1
- DO 40 K = 1,II
- CALL GETBIT(K, H(1,I), IBIT)
- IF(IBIT.EQ.0) GOTO 40
- CALL SETBIT(K, H(1,I), 0)
- CALL SETBIT(I, H(1,K), 0)
- IPTR = IPTR + 1
- CALL TUP(EIT(1,1), IPTR, I)
- CALL TUP(EIT(1,2), IPTR, K)
-40 CONTINUE
- IF(IPTR.EQ.0) GOTO 888
- IZ = 0
- CALL UZERO(IV, 1, 3)
- NINFO = INOD
- GOTO 556
-666 CONTINUE
- SPLIT = .TRUE.
-C
-C SET INITIAL VALUES
-C
- CALL UZERO(IF, 1, 3)
- CALL UFILL(IV,1,3,IFILWD)
-111 IPTR = 0
- IF(NOLD.NE.0) GOTO 888
-C*UL 112 NINFO = 0
- NINFO = 0
- CALL UZERO(INFO, 1, INOD)
- DO 1 I = 1,INOD
- CALL GETBIT(I, IV, IBIT)
- IF(IBIT.EQ.1) GOTO 2
-1 CONTINUE
-C THERE ARE NO FURTHER NODES LEFT IN THE GRAPH
- NPTR = 1
-888 NISL = -1
- RETURN
-C A NODE HAS BEEN FOUND. ALL ITS INCIDENT EDGES ARE DETERMINED,
-C REMOVED FROM THE GRAPH AND STORED INTO THE EIT
-2 NODE = I
- DO 3 I = 1,INOD
- CALL GETBIT(NODE, H(1,I), IBIT)
- IF(IBIT.EQ.0) GOTO 3
- CALL SETBIT(NODE, H(1,I), 0)
- CALL SETBIT(I, H(1,NODE), 0)
-C MARK THIS ADJACENT NODE FOUND TO PROVIDE FURTHER EXPANSION
-C OF THE (SUB)GRAPH
- CALL SETBIT(I, IV, 0)
- CALL SETBIT(I, IF, 1)
-C STORE THE EDGE (NODE,I) INTO THE EIT
-C REMARK.. THE FIRST 'CALL TUP(..)' MEANS EIT(IPTR,1) = NODE
- IPTR = IPTR + 1
- CALL TUP(EIT(1,1), IPTR, NODE)
- CALL TUP(EIT(1,2), IPTR, I)
-3 CONTINUE
-C SET UP ARRAY TO PROVIDE SEQUENTIAL NUMBERING OF THE NODES OF
-C EACH SUBGRAPH BEFORE ENTERING SUBROUTINE PGRAPH
- NINFO = NINFO + 1
- INFO(NODE) = NINFO
-C MARK THE NODE AS INACTIVE. (ALL INCIDENT EDGES HAVE BEEN REMOVED)
- CALL SETBIT(NODE, IV, 0)
- CALL SETBIT(NODE, IF, 0)
-C IS THERE STILL A NODE IN THE GRAPH, FROM WHICH THE CURRENT
-C SUBGRAPH MIGHT BE EXPANDED
- DO 4 I = 1,INOD
- CALL GETBIT(I, IF, IBIT)
- IF(IBIT.EQ.1) GOTO 2
-4 CONTINUE
-C NO, THE SUBGRAPH IS COMPLETE. CHECK, IF IT IS ONLY AN ISOLATED NODE
- IF(IPTR.GT.0) GOTO 6
- NPTR = 1
- NISL = 1
- IZ = 0
- ISL(1) = NODE
- RETURN
-C REARRANGE THE NUMBERS WITHIN THE SUBGRAPH FOUND TO BE SEQUENTIAL
-6 CONTINUE
- DO 7 I = 1,IPTR
- DO 7 J = 1,2
- JX = IGET(EIT(1,J), I)
- NEW = INFO(JX)
- CALL TUP(EIT(1,J), I, NEW)
-7 CONTINUE
- IZ = 0
- GOTO 556
-555 IF(IZ.EQ.0) GOTO 111
-556 CALL PGRAPH(EIT, IPTR, NINFO, ISL, NPTR, IZ)
- IF(IZ.EQ.0) GOTO 8
- IF(.NOT. SPLIT) GOTO 8
-C RE-REARRANGE THE NUMBERS IN THE EIT FROM SEQUENTIAL TO ORIGINAL
- DO 9 I = 1,IZ
- NEW = ISL(I)
- DO 11 J = 1,INOD
- IF(INFO(J).EQ.NEW) GOTO 12
-11 CONTINUE
-12 ISL(I) = J
-9 CONTINUE
-8 NISL = IZ
- RETURN
- END
diff --git a/src/mathlib/gen/v/hisran.F b/src/mathlib/gen/v/hisran.F
deleted file mode 100644
index 5f54758..0000000
--- a/src/mathlib/gen/v/hisran.F
+++ /dev/null
@@ -1,75 +0,0 @@
-*
-* $Id: hisran.F,v 1.1.1.1 1996/04/01 15:02:57 mclareni Exp $
-*
-* $Log: hisran.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:57 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE HISRAN(Y,N,XLO,XWID,XRAN)
-C SUBROUTINE TO GENERATE RANDOM NUMBERS
-C ACCORDING TO AN EMPIRICAL DISTRIBUTION
-C SUPPLIED BY THE USER IN THE FORM OF A HISTOGRAM
-C F. JAMES, MAY, 1976
- DIMENSION Y(*)
-#if !defined(CERNLIB_F90)
- DATA IERR,NTRY,NXHRAN,NXHPRE/0,3HRAN,3HRAN,3HPRE/
-#endif
-#if defined(CERNLIB_F90)
- INTEGER :: IERR = 0, NTRY = transfer('RAN ', 0), &
- NXHRAN = transfer('RAN ', 0), NXHPRE = transfer('PRE ', 0)
-#endif
- IF(Y(N).EQ.1.0) GOTO 200
- WRITE(6,1001) Y(N)
- 1001 FORMAT('0SUBROUTINE HISRAN FINDS Y(N) NOT EQUAL TO 1.0 Y(N)='
- +,E15.6/' ASSUMES USER HAS SUPPLIED HISTOGRAM RATHER THAN CUMUL',
- +'ATIVE DISTRIBUTION AND HAS FORGOTTEN TO CALL HISPRE'/)
- NTRY=NXHRAN
- GOTO 50
-C INITIALIZE HISTOGRAM TO FORM CUMULATIVE DISTRIBUTION
-#if (defined(CERNLIB_CDC))&&(defined(CERNLIB_F4))
- ENTRY HISPRE
-#endif
-#if !defined(CERNLIB_CDC)||!defined(CERNLIB_F4)
- ENTRY HISPRE(Y,N)
-#endif
- NTRY=NXHPRE
- 50 CONTINUE
- YTOT = 0.
- DO 100 I= 1, N
- IF(Y(I).LT.0.) GOTO 900
- YTOT = YTOT + Y(I)
- 100 Y(I) = YTOT
- IF(YTOT.LE.0.) GOTO 900
- YINV = 1.0/YTOT
- DO 110 I= 1, N
- 110 Y(I) = Y(I) * YINV
- Y(N) = 1.0
- IF(NTRY.EQ.NXHPRE) RETURN
-C NOW GENERATE RANDOM NUMBER BETWEEN 0 AND ONE
- 200 CONTINUE
- YR = RNDM(-1)
-C AND TRANSFORM IT INTO THE CORRESPONDING X-VALUE
- L = LOCATF(Y,N,YR)
- IF(L.EQ.0) GOTO 240
- IF(L.GT.0) GOTO 250
-C USUALLY COME HERE.
- L = ABS(L)
- XRAN = XLO + XWID * (L +((YR-Y(L))/(Y(L+1)-Y(L))))
- RETURN
-C POINT FALLS IN FIRST BIN. SPECIAL CASE
- 240 XRAN = XLO + XWID * (YR/Y(1))
- RETURN
-C GUARD AGAINST SPECIAL CASE OF FALLING ON EMPTY BIN
- 250 XRAN = XLO + L * XWID
- RETURN
- 900 CONTINUE
- IERR = IERR + 1
- IF(IERR.LT.6) WRITE(6,1000)NTRY
- 1000 FORMAT('0ERROR IN INPUT DATA FOR HIS',A3,' VALUES NOT ALL >0'/)
- WRITE(6,1002) (Y(K),K=1,N)
- 1002 FORMAT(1X,10F13.7)
- XRAN = 0.
- RETURN
- END
diff --git a/src/mathlib/gen/v/iget.F b/src/mathlib/gen/v/iget.F
deleted file mode 100644
index 64b0ab0..0000000
--- a/src/mathlib/gen/v/iget.F
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: iget.F,v 1.1.1.1 1996/04/01 15:02:57 mclareni Exp $
-*
-* $Log: iget.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:57 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- FUNCTION IGET(MEM, IPOS)
- DIMENSION MEM(1)
- COMMON /BITSXB/ NBITPW,NBYTPW
-C
-C *IGET* RETRIEVES THE VALUES STORED BY *TUP*.
-C
- LW=(IPOS+NBYTPW-1)/NBYTPW
- LA=8*(IPOS-NBYTPW*(LW-1))-7
- IGET=JBYT(MEM(LW),LA,8)
- RETURN
- END
diff --git a/src/mathlib/gen/v/munomi.F b/src/mathlib/gen/v/munomi.F
deleted file mode 100644
index 6b1e4a3..0000000
--- a/src/mathlib/gen/v/munomi.F
+++ /dev/null
@@ -1,69 +0,0 @@
-*
-* $Id: munomi.F,v 1.1.1.1 1996/04/01 15:02:55 mclareni Exp $
-*
-* $Log: munomi.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:55 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE MUNOMI(NCH,NTOT,P,N,IERROR)
-C
-C MULTINOMIAL GENERATOR
-C CODED FROM LOS ALAMOS REPORT LA-5061-MS
-C PROB(N(1),...,N(NCH))=FACT(NTOT)*(PRODUCT ON I OF(P(I)**N(I)/FACT(N
-C WHERE FACT(N) STANDS FOR FACTORIAL OF N
-C ON INPUT NCH NUMBER OF CHANNELS
-C NTOT SUM OF N(I)
-C P(I) , I=1,NCH LIST OF INDIVIDUAL PROBABILITIES
-C THIS LIST IS ALTERED AFTER FIRST CALL TO REPRESENT
-C DISTRIBUTION FUNCTIO TO SAVE TIME ON FURTHER CALLS
-C WITH IDENTICAL REQUESTS
-C SUM OF P(I),I=1,J-1 OVERWRITES P(J)
-C ALTERNATIVELY ONE MAY ENTER DIRECTLY THIS ALTERED
-C LIST BUT P(NCH) MUST BE .EQ.1.
-C RETURNS N(I) , I=1,NCH
-C IERROR.EQ.0 NORMALLY
-C IERROR.EQ.1 IF AT LEAST ONE P IS NEGATIVE
-C IERROR.EQ.2 IF SUM OF P(I) IS LARGER THAN 1.
-C
- DIMENSION P(2),N(2)
-C CHECKING/PREPARATION IS DONE IN PRINCIPLE ONCE
- IF(P(NCH).EQ.1.) GO TO 200
-C CHECK INPUT PROBABILITIES
- IF(P(1).LT.0.) GO TO 800
- DO 150 I=2,NCH
- IF(P(I).LT.0.) GO TO 800
-C PREPARE DISTRIBUTION FUNCTION
- P(I)=P(I)+P(I-1)
- 150 CONTINUE
-C CHECK OVERALL SUM
- IF(P(NCH).GT.1.) GO TO 900
-C SET SUM EXACTLY EQUAL TO 1. , WILL BE RECOGNISED ON FURTHER CALLS
- P(NCH)=1.
- 200 CONTINUE
- IERROR=0
- CALL UZERO(N,1,NCH)
- DO 350 I=1,NTOT
- R=RNDM(I)
- DO 250 J=1,NCH
- IF(P(J).LT.R) GO TO 250
- K=J
- GO TO 300
- 250 CONTINUE
-C ONE SHOULD NOT REACH THIS PLACE
- K=NCH
- 300 CONTINUE
- N(K)=N(K)+1
- 350 CONTINUE
- GO TO 999
- 800 CONTINUE
-C AT LEAST ONE NEGATIVE PROBABILITY
- IERROR=1
- GO TO 999
- 900 CONTINUE
-C SUM OF PROBABILITIES IS LARGER THAN 1.
- IERROR=2
- 999 CONTINUE
- RETURN
- END
diff --git a/src/mathlib/gen/v/normco.F b/src/mathlib/gen/v/normco.F
deleted file mode 100644
index 562e827..0000000
--- a/src/mathlib/gen/v/normco.F
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: normco.F,v 1.1.1.1 1996/04/01 15:02:54 mclareni Exp $
-*
-* $Log: normco.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:54 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE NORMCO(A,B,UA,UB,SIGMAA,SIGMAB,RO)
- Y=RNDM(-1.)
- Z=RNDM(-1.)
- X=6.2831853*Z
- AA=SQRT(-2.*LOG(Y))
- A=UA+SIGMAA*AA*(SQRT(1.-RO**2)*COS(X)+RO*SIN(X))
- B=UB+SIGMAB*AA*SIN(X)
- RETURN
- END
diff --git a/src/mathlib/gen/v/norranux.F b/src/mathlib/gen/v/norranux.F
deleted file mode 100644
index 3d9fc05..0000000
--- a/src/mathlib/gen/v/norranux.F
+++ /dev/null
@@ -1,133 +0,0 @@
-*
-* $Id: norranux.F,v 1.1.1.1 1996/04/01 15:02:53 mclareni Exp $
-*
-* $Log: norranux.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:53 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_UNIX)||defined(CERNLIB_QMALPH)
- FUNCTION NORRAN ( RN )
-C
-C FORTRAN version for Alliant of CERN library routine NORRAN
-C (entry V101) for the generation of standard normal pseudo-
-C random numbers. / Ch.Walck 880407
-C
-C Calling sequences:
-C R = UNI ( DUMMY ) Continuous uniform r.n. 0 TO 1
-C R = VNI ( DUMMY ) Continuous uniform r.n. -1 to 1
-C CALL NORRAN ( R ) Standard normal r.n.
-C CALL NORRIN ( ISEED1, ISEED2 ) Initialize seeds
-C CALL NORRUT ( ISEED1, ISEED2 ) Access seeds
-C
- SAVE MCGN, SRGN, TBL
- PARAMETER ( M20=2**20-1, M24=2**24-1, XM24=2.0**(-24)
- + , XM28=2.0**(-28) )
- DIMENSION TBL(0:326)
- INTEGER R0, R1, R2, SEED1, SEED2, SIGN, SRGN
- EQUIVALENCE (MAN,XMAN)
- DATA TBL/ 0.0000, 0.0625, 2*0.1250, 4*0.1875, 5*0.2500
- + , 0.5625, 5*0.6250, 3*0.8750, 1.1250, 1.4375
- + , 5*0.0000, 5*0.0625, 4*0.1250, 2*0.1875, 0.2500
- + , 5*0.3125, 5*0.3750, 5*0.4375, 5*0.5000, 4*0.5625
- + , 4*0.6875, 4*0.7500, 4*0.8125, 0.8750, 3*0.9375
- + , 3*1.0000, 3*1.0625, 2*1.1250, 2*1.1875, 2*1.2500
- + , 2*1.3125, 2*1.3750, 1.4375, 1.5000, 1.5625
- + , 1.6250, 1.6875, 1.7500, 1.8125,10*0.3125
- + , 7*0.3750, 5*0.4375, 2*0.5000, 9*0.6875, 5*0.7500
- + , 0.8125,10*0.9375, 7*1.0000, 3*1.0625,12*1.1875
- + , 9*1.2500, 5*1.3125, 2*1.3750,13*1.5000,10*1.5625
- + , 7*1.6250, 5*1.6875, 2*1.7500,15*1.8750,13*1.9375
- + ,12*2.0000,10*2.0625, 9*2.1250, 8*2.1875, 7*2.2500
- + , 6*2.3125, 5*2.3750, 4*2.4375, 3*2.5000, 3*2.5625
- + , 2*2.6250, 2*2.6875 /
- DATA MCGN/12345/, SRGN/1073/
-C
- R0 = IEOR ( ISHFT(SRGN,-15), SRGN )
- R1 = ISHFT(R0,17)
- SRGN = IEOR(R0,R1)
- MCGN = 69069 * MCGN
- R2 = IEOR(SRGN,MCGN)
- R0 = ISHFT(R2,-24)
- IF ( R0 .GE. 104 ) GO TO 2
- MAN = IAND(R2,M24)
- XMAN = MAN
- IF ( XMAN .EQ. 0.0 ) XMAN = 0.5
- RN = XM28 * XMAN + TBL(R0)
- RETURN
-C
- 2 IF ( R0 .GE. 208 ) GO TO 3
- R0 = R0 - 104
- MAN = IAND(R2,M24)
- XMAN = MAN
- IF ( XMAN .EQ. 0.0 ) XMAN = 0.5
- RN = - ( XM28 * XMAN + TBL(R0) )
- RETURN
-C
- 3 R0 = ISHFT(R2,-20)
- IF ( R0 .GE. 3631 ) GO TO 4
- R0 = R0 - 3304
- MAN = ISHFT ( IAND(R2,M20), 4 )
- XMAN = MAN
- IF ( XMAN .EQ. 0.0 ) XMAN = 0.5
- RN = XM28 * XMAN + TBL(R0)
- RETURN
-C
- 4 IF ( R0 .GE. 3934 ) GO TO 5
- R0 = R0 - 3607
- MAN = ISHFT ( IAND(R2,M20), 4 )
- XMAN = MAN
- IF ( XMAN .EQ. 0.0 ) XMAN = 0.5
- RN = - ( XM28 * XMAN + TBL(R0) )
- RETURN
-C
- 5 RN = RNORTH ( R2 )
- RETURN
-C
-C UNI entry for RNORTH
-C
- ENTRY UNI ( DUMMY )
- R0 = IEOR ( ISHFT(SRGN,-15), SRGN )
- R1 = ISHFT ( R0 , 17 )
- SRGN = IEOR ( R0 ,R1 )
- MCGN = 69069 * MCGN
- MAN = ISHFT ( IEOR ( SRGN, MCGN ) , -8 )
- XMAN = MAN
- IF ( XMAN .EQ. 0.0 ) XMAN = 0.5
- UNI = XM24 * XMAN
- RETURN
-C
-C Uniform number between -1 and 1 for RNORTH
-C
- ENTRY VNI ( DUMMY )
- R0 = IEOR ( ISHFT(SRGN,-15), SRGN )
- R1 = ISHFT ( R0 , 17 )
- SRGN = IEOR ( R0 ,R1 )
- MCGN = 69069 * MCGN
- R2 = IEOR ( SRGN, MCGN )
- MAN = IAND ( ISHFT ( R2, -7 ), M24 )
- SIGN = ISHFT ( R2, -31 )
- SIGN = 1 - 2 * SIGN
- XMAN = MAN
- IF ( XMAN .EQ. 0.0 ) XMAN = 0.5
- VNI = SIGN * XM24 * XMAN
- RETURN
-C
-C Set seeds
-C
- ENTRY NORRIN ( SEED1, SEED2 )
- MCGN = SEED1
- SRGN = SEED2
- NORRIN = 0
- RETURN
-C
-C Get seeds
-C
- ENTRY NORRUT ( SEED1, SEED2 )
- SEED1 = MCGN
- SEED2 = SRGN
- NORRUT = 0
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/v/norranvx.s b/src/mathlib/gen/v/norranvx.s
deleted file mode 100644
index 8cc8602..0000000
--- a/src/mathlib/gen/v/norranvx.s
+++ /dev/null
@@ -1,542 +0,0 @@
-;
-; $Id: norranvx.s,v 1.2 1996/04/26 12:31:51 cernlib Exp $
-;
-; $Log: norranvx.s,v $
-; Revision 1.2 1996/04/26 12:31:51 cernlib
-; Correct comment leader and comment/remove cpp ifdef lines
-;
-; Revision 1.1.1.1 1996/04/01 15:02:53 mclareni
-; Mathlib gen
-;
-;
-; Compile this only with:
-;#if (defined(CERNLIB_VAXVMS))&&(!defined(CERNLIB_FORTRAN))
-;
- .TITLE NORRAN
-;
-; Normal random number generator for VAX 11-780
-; rewritten from CERN IBM 370 version
-; with the IBM-Randomnumbersequence
-; two parameter version (MCGN,SRGN)
-;
-; adapted at Wuppertal by H.Forsbach, March 84
-; last modification : March 84
-;
-; FORTRAN external used : RNORTH
-;
-; ----------------------------------------------------------------------
- .PSECT NORRAN$LOCAL, PIC, CON, REL, LCL, NOSHR, NOEXE, RD, WRT, LONG
-MCGN: .LONG ^D12345
-SRGN: .LONG ^D01073
-;
-ARGUMENT: .BLKL 1
-;
-; ----------------------------------------------------------------------
- .PSECT NORRAN$CONST, PIC, CON, REL, LCL, SHR, NOEXE, RD, NOWRT, LONG
-;
-; lookup table for NORRAN
-;
-NTBL: .WORD ^X0000 ; Floating point : 0.00000
- .WORD ^X3E80 ; Floating point : 0.06250
- .WORD ^X3F00 ; Floating point : 0.12500
- .WORD ^X3F00 ; Floating point : 0.12500
- .WORD ^X3F40 ; Floating point : 0.18750
- .WORD ^X3F40 ; Floating point : 0.18750
- .WORD ^X3F40 ; Floating point : 0.18750
- .WORD ^X3F40 ; Floating point : 0.18750
- .WORD ^X3F80 ; Floating point : 0.25000
- .WORD ^X3F80 ; Floating point : 0.25000
- .WORD ^X3F80 ; Floating point : 0.25000
- .WORD ^X3F80 ; Floating point : 0.25000
- .WORD ^X3F80 ; Floating point : 0.25000
- .WORD ^X4010 ; Floating point : 0.56250
- .WORD ^X4020 ; Floating point : 0.62500
- .WORD ^X4020 ; Floating point : 0.62500
- .WORD ^X4020 ; Floating point : 0.62500
- .WORD ^X4020 ; Floating point : 0.62500
- .WORD ^X4020 ; Floating point : 0.62500
- .WORD ^X4060 ; Floating point : 0.87500
- .WORD ^X4060 ; Floating point : 0.87500
- .WORD ^X4060 ; Floating point : 0.87500
- .WORD ^X4090 ; Floating point : 1.12500
- .WORD ^X40B8 ; Floating point : 1.43750
- .WORD ^X0000 ; Floating point : 0.00000
- .WORD ^X0000 ; Floating point : 0.00000
- .WORD ^X0000 ; Floating point : 0.00000
- .WORD ^X0000 ; Floating point : 0.00000
- .WORD ^X0000 ; Floating point : 0.00000
- .WORD ^X3E80 ; Floating point : 0.06250
- .WORD ^X3E80 ; Floating point : 0.06250
- .WORD ^X3E80 ; Floating point : 0.06250
- .WORD ^X3E80 ; Floating point : 0.06250
- .WORD ^X3E80 ; Floating point : 0.06250
- .WORD ^X3F00 ; Floating point : 0.12500
- .WORD ^X3F00 ; Floating point : 0.12500
- .WORD ^X3F00 ; Floating point : 0.12500
- .WORD ^X3F00 ; Floating point : 0.12500
- .WORD ^X3F40 ; Floating point : 0.18750
- .WORD ^X3F40 ; Floating point : 0.18750
- .WORD ^X3F80 ; Floating point : 0.25000
- .WORD ^X3FA0 ; Floating point : 0.31250
- .WORD ^X3FA0 ; Floating point : 0.31250
- .WORD ^X3FA0 ; Floating point : 0.31250
- .WORD ^X3FA0 ; Floating point : 0.31250
- .WORD ^X3FA0 ; Floating point : 0.31250
- .WORD ^X3FC0 ; Floating point : 0.37500
- .WORD ^X3FC0 ; Floating point : 0.37500
- .WORD ^X3FC0 ; Floating point : 0.37500
- .WORD ^X3FC0 ; Floating point : 0.37500
- .WORD ^X3FC0 ; Floating point : 0.37500
- .WORD ^X3FE0 ; Floating point : 0.43750
- .WORD ^X3FE0 ; Floating point : 0.43750
- .WORD ^X3FE0 ; Floating point : 0.43750
- .WORD ^X3FE0 ; Floating point : 0.43750
- .WORD ^X3FE0 ; Floating point : 0.43750
- .WORD ^X4000 ; Floating point : 0.50000
- .WORD ^X4000 ; Floating point : 0.50000
- .WORD ^X4000 ; Floating point : 0.50000
- .WORD ^X4000 ; Floating point : 0.50000
- .WORD ^X4000 ; Floating point : 0.50000
- .WORD ^X4010 ; Floating point : 0.56250
- .WORD ^X4010 ; Floating point : 0.56250
- .WORD ^X4010 ; Floating point : 0.56250
- .WORD ^X4010 ; Floating point : 0.56250
- .WORD ^X4030 ; Floating point : 0.68750
- .WORD ^X4030 ; Floating point : 0.68750
- .WORD ^X4030 ; Floating point : 0.68750
- .WORD ^X4030 ; Floating point : 0.68750
- .WORD ^X4040 ; Floating point : 0.75000
- .WORD ^X4040 ; Floating point : 0.75000
- .WORD ^X4040 ; Floating point : 0.75000
- .WORD ^X4040 ; Floating point : 0.75000
- .WORD ^X4050 ; Floating point : 0.81250
- .WORD ^X4050 ; Floating point : 0.81250
- .WORD ^X4050 ; Floating point : 0.81250
- .WORD ^X4050 ; Floating point : 0.81250
- .WORD ^X4060 ; Floating point : 0.87500
- .WORD ^X4070 ; Floating point : 0.93750
- .WORD ^X4070 ; Floating point : 0.93750
- .WORD ^X4070 ; Floating point : 0.93750
- .WORD ^X4080 ; Floating point : 1.00000
- .WORD ^X4080 ; Floating point : 1.00000
- .WORD ^X4080 ; Floating point : 1.00000
- .WORD ^X4088 ; Floating point : 1.06250
- .WORD ^X4088 ; Floating point : 1.06250
- .WORD ^X4088 ; Floating point : 1.06250
- .WORD ^X4090 ; Floating point : 1.12500
- .WORD ^X4090 ; Floating point : 1.12500
- .WORD ^X4098 ; Floating point : 1.18750
- .WORD ^X4098 ; Floating point : 1.18750
- .WORD ^X40A0 ; Floating point : 1.25000
- .WORD ^X40A0 ; Floating point : 1.25000
- .WORD ^X40A8 ; Floating point : 1.31250
- .WORD ^X40A8 ; Floating point : 1.31250
- .WORD ^X40B0 ; Floating point : 1.37500
- .WORD ^X40B0 ; Floating point : 1.37500
- .WORD ^X40B8 ; Floating point : 1.43750
- .WORD ^X40C0 ; Floating point : 1.50000
- .WORD ^X40C8 ; Floating point : 1.56250
- .WORD ^X40D0 ; Floating point : 1.62500
- .WORD ^X40D8 ; Floating point : 1.68750
- .WORD ^X40E0 ; Floating point : 1.75000
- .WORD ^X40E8 ; Floating point : 1.81250
- .WORD ^X3FA0 ; Floating point : 0.31250
- .WORD ^X3FA0 ; Floating point : 0.31250
- .WORD ^X3FA0 ; Floating point : 0.31250
- .WORD ^X3FA0 ; Floating point : 0.31250
- .WORD ^X3FA0 ; Floating point : 0.31250
- .WORD ^X3FA0 ; Floating point : 0.31250
- .WORD ^X3FA0 ; Floating point : 0.31250
- .WORD ^X3FA0 ; Floating point : 0.31250
- .WORD ^X3FA0 ; Floating point : 0.31250
- .WORD ^X3FA0 ; Floating point : 0.31250
- .WORD ^X3FC0 ; Floating point : 0.37500
- .WORD ^X3FC0 ; Floating point : 0.37500
- .WORD ^X3FC0 ; Floating point : 0.37500
- .WORD ^X3FC0 ; Floating point : 0.37500
- .WORD ^X3FC0 ; Floating point : 0.37500
- .WORD ^X3FC0 ; Floating point : 0.37500
- .WORD ^X3FC0 ; Floating point : 0.37500
- .WORD ^X3FE0 ; Floating point : 0.43750
- .WORD ^X3FE0 ; Floating point : 0.43750
- .WORD ^X3FE0 ; Floating point : 0.43750
- .WORD ^X3FE0 ; Floating point : 0.43750
- .WORD ^X3FE0 ; Floating point : 0.43750
- .WORD ^X4000 ; Floating point : 0.50000
- .WORD ^X4000 ; Floating point : 0.50000
- .WORD ^X4030 ; Floating point : 0.68750
- .WORD ^X4030 ; Floating point : 0.68750
- .WORD ^X4030 ; Floating point : 0.68750
- .WORD ^X4030 ; Floating point : 0.68750
- .WORD ^X4030 ; Floating point : 0.68750
- .WORD ^X4030 ; Floating point : 0.68750
- .WORD ^X4030 ; Floating point : 0.68750
- .WORD ^X4030 ; Floating point : 0.68750
- .WORD ^X4030 ; Floating point : 0.68750
- .WORD ^X4040 ; Floating point : 0.75000
- .WORD ^X4040 ; Floating point : 0.75000
- .WORD ^X4040 ; Floating point : 0.75000
- .WORD ^X4040 ; Floating point : 0.75000
- .WORD ^X4040 ; Floating point : 0.75000
- .WORD ^X4050 ; Floating point : 0.81250
- .WORD ^X4070 ; Floating point : 0.93750
- .WORD ^X4070 ; Floating point : 0.93750
- .WORD ^X4070 ; Floating point : 0.93750
- .WORD ^X4070 ; Floating point : 0.93750
- .WORD ^X4070 ; Floating point : 0.93750
- .WORD ^X4070 ; Floating point : 0.93750
- .WORD ^X4070 ; Floating point : 0.93750
- .WORD ^X4070 ; Floating point : 0.93750
- .WORD ^X4070 ; Floating point : 0.93750
- .WORD ^X4070 ; Floating point : 0.93750
- .WORD ^X4080 ; Floating point : 1.00000
- .WORD ^X4080 ; Floating point : 1.00000
- .WORD ^X4080 ; Floating point : 1.00000
- .WORD ^X4080 ; Floating point : 1.00000
- .WORD ^X4080 ; Floating point : 1.00000
- .WORD ^X4080 ; Floating point : 1.00000
- .WORD ^X4080 ; Floating point : 1.00000
- .WORD ^X4088 ; Floating point : 1.06250
- .WORD ^X4088 ; Floating point : 1.06250
- .WORD ^X4088 ; Floating point : 1.06250
- .WORD ^X4098 ; Floating point : 1.18750
- .WORD ^X4098 ; Floating point : 1.18750
- .WORD ^X4098 ; Floating point : 1.18750
- .WORD ^X4098 ; Floating point : 1.18750
- .WORD ^X4098 ; Floating point : 1.18750
- .WORD ^X4098 ; Floating point : 1.18750
- .WORD ^X4098 ; Floating point : 1.18750
- .WORD ^X4098 ; Floating point : 1.18750
- .WORD ^X4098 ; Floating point : 1.18750
- .WORD ^X4098 ; Floating point : 1.18750
- .WORD ^X4098 ; Floating point : 1.18750
- .WORD ^X4098 ; Floating point : 1.18750
- .WORD ^X40A0 ; Floating point : 1.25000
- .WORD ^X40A0 ; Floating point : 1.25000
- .WORD ^X40A0 ; Floating point : 1.25000
- .WORD ^X40A0 ; Floating point : 1.25000
- .WORD ^X40A0 ; Floating point : 1.25000
- .WORD ^X40A0 ; Floating point : 1.25000
- .WORD ^X40A0 ; Floating point : 1.25000
- .WORD ^X40A0 ; Floating point : 1.25000
- .WORD ^X40A0 ; Floating point : 1.25000
- .WORD ^X40A8 ; Floating point : 1.31250
- .WORD ^X40A8 ; Floating point : 1.31250
- .WORD ^X40A8 ; Floating point : 1.31250
- .WORD ^X40A8 ; Floating point : 1.31250
- .WORD ^X40A8 ; Floating point : 1.31250
- .WORD ^X40B0 ; Floating point : 1.37500
- .WORD ^X40B0 ; Floating point : 1.37500
- .WORD ^X40C0 ; Floating point : 1.50000
- .WORD ^X40C0 ; Floating point : 1.50000
- .WORD ^X40C0 ; Floating point : 1.50000
- .WORD ^X40C0 ; Floating point : 1.50000
- .WORD ^X40C0 ; Floating point : 1.50000
- .WORD ^X40C0 ; Floating point : 1.50000
- .WORD ^X40C0 ; Floating point : 1.50000
- .WORD ^X40C0 ; Floating point : 1.50000
- .WORD ^X40C0 ; Floating point : 1.50000
- .WORD ^X40C0 ; Floating point : 1.50000
- .WORD ^X40C0 ; Floating point : 1.50000
- .WORD ^X40C0 ; Floating point : 1.50000
- .WORD ^X40C0 ; Floating point : 1.50000
- .WORD ^X40C8 ; Floating point : 1.56250
- .WORD ^X40C8 ; Floating point : 1.56250
- .WORD ^X40C8 ; Floating point : 1.56250
- .WORD ^X40C8 ; Floating point : 1.56250
- .WORD ^X40C8 ; Floating point : 1.56250
- .WORD ^X40C8 ; Floating point : 1.56250
- .WORD ^X40C8 ; Floating point : 1.56250
- .WORD ^X40C8 ; Floating point : 1.56250
- .WORD ^X40C8 ; Floating point : 1.56250
- .WORD ^X40C8 ; Floating point : 1.56250
- .WORD ^X40D0 ; Floating point : 1.62500
- .WORD ^X40D0 ; Floating point : 1.62500
- .WORD ^X40D0 ; Floating point : 1.62500
- .WORD ^X40D0 ; Floating point : 1.62500
- .WORD ^X40D0 ; Floating point : 1.62500
- .WORD ^X40D0 ; Floating point : 1.62500
- .WORD ^X40D0 ; Floating point : 1.62500
- .WORD ^X40D8 ; Floating point : 1.68750
- .WORD ^X40D8 ; Floating point : 1.68750
- .WORD ^X40D8 ; Floating point : 1.68750
- .WORD ^X40D8 ; Floating point : 1.68750
- .WORD ^X40D8 ; Floating point : 1.68750
- .WORD ^X40E0 ; Floating point : 1.75000
- .WORD ^X40E0 ; Floating point : 1.75000
- .WORD ^X40F0 ; Floating point : 1.87500
- .WORD ^X40F0 ; Floating point : 1.87500
- .WORD ^X40F0 ; Floating point : 1.87500
- .WORD ^X40F0 ; Floating point : 1.87500
- .WORD ^X40F0 ; Floating point : 1.87500
- .WORD ^X40F0 ; Floating point : 1.87500
- .WORD ^X40F0 ; Floating point : 1.87500
- .WORD ^X40F0 ; Floating point : 1.87500
- .WORD ^X40F0 ; Floating point : 1.87500
- .WORD ^X40F0 ; Floating point : 1.87500
- .WORD ^X40F0 ; Floating point : 1.87500
- .WORD ^X40F0 ; Floating point : 1.87500
- .WORD ^X40F0 ; Floating point : 1.87500
- .WORD ^X40F0 ; Floating point : 1.87500
- .WORD ^X40F0 ; Floating point : 1.87500
- .WORD ^X40F8 ; Floating point : 1.93750
- .WORD ^X40F8 ; Floating point : 1.93750
- .WORD ^X40F8 ; Floating point : 1.93750
- .WORD ^X40F8 ; Floating point : 1.93750
- .WORD ^X40F8 ; Floating point : 1.93750
- .WORD ^X40F8 ; Floating point : 1.93750
- .WORD ^X40F8 ; Floating point : 1.93750
- .WORD ^X40F8 ; Floating point : 1.93750
- .WORD ^X40F8 ; Floating point : 1.93750
- .WORD ^X40F8 ; Floating point : 1.93750
- .WORD ^X40F8 ; Floating point : 1.93750
- .WORD ^X40F8 ; Floating point : 1.93750
- .WORD ^X40F8 ; Floating point : 1.93750
- .WORD ^X4100 ; Floating point : 2.00000
- .WORD ^X4100 ; Floating point : 2.00000
- .WORD ^X4100 ; Floating point : 2.00000
- .WORD ^X4100 ; Floating point : 2.00000
- .WORD ^X4100 ; Floating point : 2.00000
- .WORD ^X4100 ; Floating point : 2.00000
- .WORD ^X4100 ; Floating point : 2.00000
- .WORD ^X4100 ; Floating point : 2.00000
- .WORD ^X4100 ; Floating point : 2.00000
- .WORD ^X4100 ; Floating point : 2.00000
- .WORD ^X4100 ; Floating point : 2.00000
- .WORD ^X4100 ; Floating point : 2.00000
- .WORD ^X4104 ; Floating point : 2.06250
- .WORD ^X4104 ; Floating point : 2.06250
- .WORD ^X4104 ; Floating point : 2.06250
- .WORD ^X4104 ; Floating point : 2.06250
- .WORD ^X4104 ; Floating point : 2.06250
- .WORD ^X4104 ; Floating point : 2.06250
- .WORD ^X4104 ; Floating point : 2.06250
- .WORD ^X4104 ; Floating point : 2.06250
- .WORD ^X4104 ; Floating point : 2.06250
- .WORD ^X4104 ; Floating point : 2.06250
- .WORD ^X4108 ; Floating point : 2.12500
- .WORD ^X4108 ; Floating point : 2.12500
- .WORD ^X4108 ; Floating point : 2.12500
- .WORD ^X4108 ; Floating point : 2.12500
- .WORD ^X4108 ; Floating point : 2.12500
- .WORD ^X4108 ; Floating point : 2.12500
- .WORD ^X4108 ; Floating point : 2.12500
- .WORD ^X4108 ; Floating point : 2.12500
- .WORD ^X4108 ; Floating point : 2.12500
- .WORD ^X410C ; Floating point : 2.18750
- .WORD ^X410C ; Floating point : 2.18750
- .WORD ^X410C ; Floating point : 2.18750
- .WORD ^X410C ; Floating point : 2.18750
- .WORD ^X410C ; Floating point : 2.18750
- .WORD ^X410C ; Floating point : 2.18750
- .WORD ^X410C ; Floating point : 2.18750
- .WORD ^X410C ; Floating point : 2.18750
- .WORD ^X4110 ; Floating point : 2.25000
- .WORD ^X4110 ; Floating point : 2.25000
- .WORD ^X4110 ; Floating point : 2.25000
- .WORD ^X4110 ; Floating point : 2.25000
- .WORD ^X4110 ; Floating point : 2.25000
- .WORD ^X4110 ; Floating point : 2.25000
- .WORD ^X4110 ; Floating point : 2.25000
- .WORD ^X4114 ; Floating point : 2.31250
- .WORD ^X4114 ; Floating point : 2.31250
- .WORD ^X4114 ; Floating point : 2.31250
- .WORD ^X4114 ; Floating point : 2.31250
- .WORD ^X4114 ; Floating point : 2.31250
- .WORD ^X4114 ; Floating point : 2.31250
- .WORD ^X4118 ; Floating point : 2.37500
- .WORD ^X4118 ; Floating point : 2.37500
- .WORD ^X4118 ; Floating point : 2.37500
- .WORD ^X4118 ; Floating point : 2.37500
- .WORD ^X4118 ; Floating point : 2.37500
- .WORD ^X411C ; Floating point : 2.43750
- .WORD ^X411C ; Floating point : 2.43750
- .WORD ^X411C ; Floating point : 2.43750
- .WORD ^X411C ; Floating point : 2.43750
- .WORD ^X4120 ; Floating point : 2.50000
- .WORD ^X4120 ; Floating point : 2.50000
- .WORD ^X4120 ; Floating point : 2.50000
- .WORD ^X4124 ; Floating point : 2.56250
- .WORD ^X4124 ; Floating point : 2.56250
- .WORD ^X4124 ; Floating point : 2.56250
- .WORD ^X4128 ; Floating point : 2.62500
- .WORD ^X4128 ; Floating point : 2.62500
- .WORD ^X412C ; Floating point : 2.68750
- .WORD ^X412C ; Floating point : 2.68750
-;
-; ----------------------------------------------------------------------
-;
- .PSECT NORRAN$CODE, PIC, CON, REL, LCL, SHR, EXE, RD, NOWRT, LONG
-;
- .ENTRY NORRAN, ^M<R2>
-;
-; normal random number generator, FORTRAN callable CALL NORRAN (RANDOM)
-;
- MOVL SRGN,R0 ;move SRGN -> R0
- MOVL R0,R1 ;move R0 -> R1
- EXTZV #15,#17,R1,R2 ;\
- MOVL R2,R1 ;_shift right R1 -> R1 (15 bits)
- XORL2 R1,R0 ;exclusive or of R1,R0 -> R0
- MOVL R0,R1 ;move R0 -> R1
- EXTZV #0,#15,R1,R2 ;\
- ROTL #17,R2,R1 ;_shift left R1 -> R1 (17 bits)
- XORL2 R1,R0 ;exclusive or of R1,R0 -> R0
- MOVL R0,SRGN ;save the new SRGN
- MOVL MCGN,R2 ;get MCGN -> R2
- MULL2 #^D69069,R2 ;69069*R2 -> R2
- MOVL R2,MCGN ;save new MCGN
- XORL2 R0,R2 ;exclusive or of R0 [SRGN], R1 [MCGN] -> R2
-;
-; ----------------------------------------------------------------------
-;
- CLRL R0 ;\
- EXTZV #24, #8, R2, R0 ; if R2 is greater then
- CMPL R0, #^X68 ; 68 00 00 00 00 00 go to ND2
- BGEQ ND2 ;/
-;
- EXTZV #0,#24,R2,R1 ;mantissa into R1
- CVTLF R1,R2 ;mantissa to VAX-floating
- EXTZV #7,#5,R2,R1 ;get normalization shift
- ADDL2 #^X64,R1 ;add 128-excess and ajust
- INSV R1,#7,#8,R2 ;pack exponent into R2
- CLRL R1 ;\
- MOVW NTBL[R0], R1 ;- build floating point value from table
- ADDF3 R1, R2, @4(AP) ;add two randomnumbers and store as argument
- RET
-; ----------------------------------------------------------------------
-ND2: CMPL R0, #^XD0 ; if R2 is greater then
- BGEQ ND3 ; D0 00 00 00 00 go to ND3
-;
- SUBL2 #^X68, R0 ;subtract to fit into table
- EXTZV #0,#24,R2,R1 ;mantissa into R1
- CVTLF R1,R2 ;mantissa to VAX-floating
- EXTZV #7,#5,R2,R1 ;get normalization shift
- ADDL2 #^X64,R1 ;add 128-excess and ajust
- INSV R1,#7,#8,R2 ;pack exponent into R2
- CLRL R1 ;\
- MOVW NTBL[R0], R1 ;- build floating point from NTBL
- ADDF2 R1, R2 ;add table value and random number
- MNEGF R2, @4(AP) ;negate it and write onto argument
- RET
-; ----------------------------------------------------------------------
-ND3: CLRL R0 ;\
- EXTZV #20, #12, R2, R0; if R2 is greater then
- CMPL R0, #^XE2F ; E2 F0 00 00 00 go to ND4
- BGEQ ND4 ;/
- SUBL2 #^XCE8, R0 ;subtract to fit into table
- EXTZV #0,#20,R2,R1 ;mantissa into R1
- ROTL #4, R1, R1 ;shift 4 bits
- CVTLF R1,R2 ;mantissa to VAX-floating
- EXTZV #7,#5,R2,R1 ;get normalization shift
- ADDL2 #^X64,R1 ;add 128-excess and ajust
- INSV R1,#7,#8,R2 ;pack exponent into R2
- CLRL R1 ;\
- MOVW NTBL[R0], R1 ;- build floating point value from table
- ADDF3 R1, R2, @4(AP) ;add and store as argument
- RET
-; ----------------------------------------------------------------------
-ND4: CMPL R0, #^XF5E ; if R2 is greater then
- BGEQ NTTHTL ; F5 E0 00 00 go to NTTHTL
-;
- SUBL2 #^XE17, R0 ;subtract to fit into table
- EXTZV #0,#20,R2,R1 ;mantissa into R1
- ROTL #4, R1, R1 ;shift 4 bits
- CVTLF R1,R2 ;mantissa to VAX-floating
- EXTZV #7,#5,R2,R1 ;get normalization shift
- ADDL2 #^X64,R1 ;add 128-excess and ajust
- INSV R1,#7,#8,R2 ;pack exponent into R2
- CLRL R1 ;\
- MOVW NTBL[R0], R1 ;- build floating point value from table
- ADDF2 R1, R2 ;add two random numbers
- MNEGF R2, @4(AP) ;negate and store as argument
- RET
-; ----------------------------------------------------------------------
-NTTHTL:
- MOVL R2, ARGUMENT ;save random digits as argument for RNORTH
- PUSHAL ARGUMENT ;push address onto stack
- CALLS #1, G^RNORTH ;call RNORTH
- MOVL R0, @4(AP) ;move result onto argument of NORRAN
- RET
-;
-; ============================================================
-;
- .ENTRY UNI, ^M<R2> ;save reg R2
-;
-; UNI : uniform random number generator [0., 1.] for RNORTH
-;
- MOVL SRGN,R0 ;move SRGN -> R0
- MOVL R0,R1 ;move R0 -> R1
- EXTZV #15,#17,R1,R2 ;\
- MOVL R2,R1 ;_shift right R1 -> R1 (15 bits)
- XORL2 R1,R0 ;exclusive or of R1,R0 -> R0
- MOVL R0,R1 ;move R0 -> R1
- EXTZV #0,#15,R1,R2 ;\
- ROTL #17,R2,R1 ;_shift left R1 -> R1 (17 bits)
- XORL2 R1,R0 ;exclusive or of R1,R0 -> R0
- MOVL R0,SRGN ;save the new SRGN
- MOVL MCGN,R2 ;get MCGN -> R2
- MULL2 #^D69069,R2 ;69069*R2 -> R2
- MOVL R2,MCGN ;save new MCGN
- XORL2 R0,R2 ;exclusive or of R0 [SRGN], R1 [MCGN] -> R2
-;
- EXTZV #8,#24,R2,R1 ;mantissa into R1
- CVTLF R1,R2 ;mantissa to VAX-floating
- EXTZV #7,#5,R2,R1 ;get normalization shift
- ADDL2 #^X68,R1 ;add 128-excess and ajust
- INSV R1,#7,#8,R2 ;pack exponent into R2
- MOVL R2,R0 ;copy onto R0 (RNDM2)
- RET
-;
-; ======================================================================
-;
- .ENTRY VNI, ^M<R2, R3> ;save reg R2 and R3
-;
-; VNI : uniform random number generator [-1., 1.] for RNORTH
-;
- MOVL SRGN,R0 ;move SRGN -> R0
- MOVL R0,R1 ;move R0 -> R1
- EXTZV #15,#17,R1,R2 ;\
- MOVL R2,R1 ;_shift right R1 -> R1 (15 bits)
- XORL2 R1,R0 ;exclusive or of R1,R0 -> R0
- MOVL R0,R1 ;move R0 -> R1
- EXTZV #0,#15,R1,R2 ;\
- ROTL #17,R2,R1 ;_shift left R1 -> R1 (17 bits)
- XORL2 R1,R0 ;exclusive or of R1,R0 -> R0
- MOVL R0,SRGN ;save the new SRGN
- MOVL MCGN,R2 ;get MCGN -> R2
- MULL2 #^D69069,R2 ;69069*R2 -> R2
- MOVL R2,MCGN ;save new MCGN
- XORL2 R0,R2 ;exclusive or of R0 [SRGN], R1 [MCGN] -> R2
-;
- EXTZV #7,#24,R2,R1 ;mantissa into R1
- EXTZV #31,#1,R2,R3 ;sign into R3
- CVTLF R1,R2 ;mantissa to VAX-floating
- EXTZV #7,#5,R2,R1 ;get normalization shift
- ADDL2 #^X68,R1 ;add 128-excess and ajust
- INSV R1,#7,#8,R2 ;pack exponent into R2
- INSV R3,#15,#1,R2 ;pack sign into R2
- MOVL R2,R0 ;copy onto R0 (RNDM2)
- RET
-;
-; ======================================================================
-;
- .ENTRY NORRIN, ^M<>
-;
-; SUBROUTINE NORRIN (MCGN,SRGN)
-; MCGN, SRGN are the starting integers of NORRAN
-;
- MOVL @4(AP),MCGN
- MOVL @8(AP),SRGN
- RET
-;
-; ======================================================================
-;
- .ENTRY NORRUT, ^M<>
-;
-; SUBROUTINE NORRUT (MCGN,SRGN)
-; MCGN, SRGN are the last used interges of NORRAN
-;
- MOVL MCGN, at 4(AP)
- MOVL SRGN, at 8(AP)
- RET
- .END
diff --git a/src/mathlib/gen/v/nranf.F b/src/mathlib/gen/v/nranf.F
deleted file mode 100644
index 6766f27..0000000
--- a/src/mathlib/gen/v/nranf.F
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: nranf.F,v 1.1.1.1 1996/04/01 15:02:54 mclareni Exp $
-*
-* $Log: nranf.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:54 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if (!defined(CERNLIB_CDC))&&(!defined(CERNLIB_VAX)||defined(CERNLIB_FORTRAN))
- SUBROUTINE NRAN(VECTOR,N)
- DIMENSION VECTOR(N)
- DO 100 I=1,N
- VECTOR(I) = RNDM(I)
- 100 CONTINUE
- RETURN
- ENTRY NRANIN (V)
- CALL RDMIN(V)
- RETURN
- ENTRY NRANUT (V)
- CALL RDMOUT(V)
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/v/nranvx.s b/src/mathlib/gen/v/nranvx.s
deleted file mode 100644
index bf828a3..0000000
--- a/src/mathlib/gen/v/nranvx.s
+++ /dev/null
@@ -1,60 +0,0 @@
-;
-; $Id: nranvx.s,v 1.2 1996/04/26 12:31:53 cernlib Exp $
-;
-; $Log: nranvx.s,v $
-; Revision 1.2 1996/04/26 12:31:53 cernlib
-; Correct comment leader and comment/remove cpp ifdef lines
-;
-; Revision 1.1.1.1 1996/04/01 15:02:54 mclareni
-; Mathlib gen
-;
-;
-; Compile this only with:
-; #if (defined(CERNLIB_VAX))&&(!defined(CERNLIB_FORTRAN))
-;
- .TITLE NRAN
-;
-; SUBROUTINE NRAN (VEC,N)
-; UNIFORM RANDOM NUMBER GENERATOR FOR VAX 11-780
-; REWRITTEN FROM CERN IBM 370 (RNDM) VERSION
-; WITH THE IBM RANDOMNUMBERSEQUENCE.
-; FILLS THE VECTOR VEC WITH N RANDOMNUMBERS
-; ADAPTED AT WUPPERTAL BY H.FORSBACH, JUNE 82
-; LAST MODIFICATION : JUNE 82
-;
-MCGN: .LONG ^D12345
-NRAN::
- .WORD ^M<R2,R3,R4> ;SAVE R2,R3,R4
- MOVL @8(AP),R0 ;GET N
- BGTR GOOD ;CHECK N
- RET ;RETURN, IF N=0
-GOOD: DECL R0 ;\
- CLRL R1 ;_INITIALIZE LOOP
- MOVL MCGN,R2 ;MOVE MCGN -> R2
-LOOP: MULL2 #^D690069,R2 ;MULTIPLY WITH 690069
- EXTZV #8,#24,R2,R3 ;MANTISSA INTO R3
- CVTLF R3,R4 ;MANTISSA TO VAX-FLOATING
- EXTZV #7,#5,R4,R3 ;GET NORMALIZATION SHIFT
- ADDL2 #^X68,R3 ;ADD 128-EXCESS AND AJUST
- INSV R3,#7,#8,R4 ;PACK EXPONENT INTO R4
- MOVL R4, at 4(AP)[R1] ;COPY R4 ONTO ARRAY
- AOBLEQ R0,R1,LOOP ;LOOP OVER ARRAY
- MOVL R2,MCGN ;FINAL STORE OF NEW MCGN
- RET
-NRANUT::
-;
-; SUBROUTINE NRANUT (MCGN)
-; MCGN IS THE LAST USED VALUE OF NRAN
-;
- .WORD ^M<>
- MOVL MCGN, at 4(AP)
- RET
-NRANIN::
-;
-; SUBROUTINE NRANIN (MCGN)
-; MCGN IS THE STARTING VALUE OF NRAN
-;
- .WORD ^M<>
- MOVL @4(AP),MCGN
- RET
- .END
diff --git a/src/mathlib/gen/v/permu.F b/src/mathlib/gen/v/permu.F
deleted file mode 100644
index 5f92608..0000000
--- a/src/mathlib/gen/v/permu.F
+++ /dev/null
@@ -1,96 +0,0 @@
-*
-* $Id: permu.F,v 1.1.1.1 1996/04/01 15:02:57 mclareni Exp $
-*
-* $Log: permu.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:57 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE PERMU(IA,N)
-C
- CHARACTER*(*) NAME
- PARAMETER(NAME='PERMUT')
-C
- DIMENSION IA(*)
- PARAMETER (IFD = 12)
- DIMENSION IFCT(0:IFD),IV(IFD+1)
- CHARACTER*80 ERRTXT
-
- DATA (IFCT(I),I=0,IFD) /1,1,2,6,24,120,720,5040,40320,362880,
- 1 3628800,39916800,479001600/
-
- IF(N .LE. 0) RETURN
- IF(IA(1) .EQ. 0) THEN
- DO 11 I = 1,N
- 11 IA(I)=I
- IF(N .EQ. 1) IA(1)=0
- ELSE
- DO 12 K1 = N,2,-1
- K=K1
- IF(IA(K-1) .LT. IA(K)) GO TO 14
- 12 CONTINUE
- IA(1)=0
- RETURN
- 14 KN=K+N
- DO 15 L = K,KN/2
- IB=IA(KN-L)
- IA(KN-L)=IA(L)
- 15 IA(L)=IB
- DO 16 L1 = K,N
- L=L1
- IF(IA(L) .GT. IA(K-1)) GO TO 17
- 16 CONTINUE
- 17 IB=IA(K-1)
- IA(K-1)=IA(L)
- IA(L)=IB
- ENDIF
- RETURN
-
- ENTRY PERMUT(NRP,N,IA)
-
- IF(N .LE. 0) RETURN
- IF(N .GT. IFD) THEN
- WRITE(ERRTXT,101) N
- CALL MTLPRT(NAME,'V202.1',ERRTXT)
- ELSEIF(NRP .GT. IFCT(N)) THEN
- IA(1)=0
- CALL MTLPRT(NAME,'V202.2',
- + 'PERMUTATION OUTSIDE LEXICON REQUESTED')
- ELSE
- DO 21 I = 1,N
- 21 IV(I)=I
- IO=NRP-1
- DO 22 M = N-1,1,-1
- IN=IO/IFCT(M)+1
- IO=MOD(IO,IFCT(M))
- IA(N-M)=IV(IN)
- DO 23 I = IN,M
- 23 IV(I)=IV(I+1)
- 22 CONTINUE
- IA(N)=IV(1)
- END IF
- RETURN
-
- ENTRY COMBI(IA,N,J)
-
- IF(N .LE. 0 .OR. J .LE. 0) RETURN
- IF(J .GT. N) THEN
- WRITE(ERRTXT,103) J,N
- CALL MTLPRT(NAME,'V202.3',ERRTXT)
- ELSEIF(IA(1) .EQ. 0) THEN
- DO 31 I = 1,J
- 31 IA(I)=I
- IA(J+1)=0
- ELSE
- DO 32 I1 = 1,N
- I=I1
- IF(IA(I+1) .NE. IA(I)+1) GO TO 33
- 32 IA(I)=I
- 33 IA(I)=IA(I)+1
- IF(IA(J) .EQ. N+1) IA(1)=0
- ENDIF
- RETURN
- 101 FORMAT('N = ',I20,' TOO BIG')
- 103 FORMAT('J = ',I5,' > ',I5,' = N IS NOT PERMITTED')
- END
diff --git a/src/mathlib/gen/v/pgraph.F b/src/mathlib/gen/v/pgraph.F
deleted file mode 100644
index a3a16a6..0000000
--- a/src/mathlib/gen/v/pgraph.F
+++ /dev/null
@@ -1,144 +0,0 @@
-*
-* $Id: pgraph.F,v 1.1.1.1 1996/04/01 15:02:57 mclareni Exp $
-*
-* $Log: pgraph.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:57 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE PGRAPH(WEIT, EDGES, NODES, SET, SETPTR, NPTR)
- INTEGER EDGES, TABNR, ONETWO, TWOONE, SETPTR
- INTEGER CHOICE
- INTEGER SETT(652)
- INTEGER WEIT(652,2)
- INTEGER SET(96)
- INTEGER WSET(96)
- INTEGER VSET(96)
- INTEGER TEIT(652,2)
- INTEGER LTEIT(96)
- INTEGER LSETT(96)
- COMMON /BITSXB/ NBITPW, NBYTPW
- IF(NPTR.GT.0) GO TO CHOICE,(10,20)
- LWEIT = EDGES
- TABNR = 1
- LTEIT(1) = 0
- LSETT(1) = 0
- K1 = 0
- LWSET = 0
- LVSET = 0
-888 CONTINUE
- MAX = 0
- NODE = 0
- DO 60 L = 1,NODES
- NODEFQ = 0
- DO 1 K = 1,LWEIT
- IF(IGET(WEIT(1,1), K) .EQ. L) NODEFQ = NODEFQ + 1
- IF(IGET(WEIT(1,2), K) .EQ. L) NODEFQ = NODEFQ + 1
-1 CONTINUE
- IF(MAX .GE. NODEFQ) GO TO 60
- MAX = NODEFQ
- NODE = L
-60 CONTINUE
-C
-C *** STEP2
-C
- LVSET = LVSET + 1
- VSET(LVSET) = NODE
-C
-C *** STEP 3 + 4
-C
- K1 = 0
- K2 = 0
- DO 2 I = 1,LWEIT
- DO 3 ONETWO = 1,2
- IF(IGET(WEIT(1,ONETWO), I) .NE. NODE) GO TO 3
- TWOONE = 3 - ONETWO
- LWSET = LWSET + 1
- WSET(LWSET) = IGET(WEIT(1,TWOONE), I)
- K2 = K2 + 1
- GO TO 2
-3 CONTINUE
- IND = LTEIT(TABNR) + 1 + K1
- CALL TUP(TEIT(1,1), IND, IGET(WEIT(1,1), I))
- CALL TUP(TEIT(1,2), IND, IGET(WEIT(1,2), I))
- K1 = K1 + 1
-2 CONTINUE
- IF(K1 .EQ. 0) GO TO 300
- IND = LSETT(TABNR) + 1
- DO 51 I = 1,LVSET
- CALL TUP(SETT, IND, VSET(I))
-51 IND = IND + 1
-C
-C *** STEP 5
-C
- TABNR = TABNR + 1
- LSETT(TABNR) = LSETT(TABNR - 1) + LVSET
- LTEIT(TABNR) = LTEIT(TABNR - 1) + K1
- IEND = LTEIT(TABNR)
- IANF = LTEIT(TABNR - 1) + 1
- K1 = 0
- JANF = LWSET - K2 + 1
- DO 200 I = IANF, IEND
- DO 22 L = JANF,LWSET
- DO 21 ONETWO = 1,2
- IF(IGET(TEIT(1,ONETWO), I) .EQ. WSET(L)) GO TO 200
-21 CONTINUE
-22 CONTINUE
- K1 = K1 + 1
- CALL TUP(WEIT(1,1), K1, IGET(TEIT(1,1), I))
- CALL TUP(WEIT(1,2), K1, IGET(TEIT(1,2), I))
-200 CONTINUE
- IF(K1 .EQ. 0) GO TO 10
- DO 50 I = 1,LWSET
-50 VSET(I) = WSET(I)
- LVSET = LWSET
- LWEIT = K1
- GO TO 888
-C
-C THE STATEMENTS 300 ... 20 RETURN THE SOLUTIONS IN V AND W.
-C BEFORE RETURNING, HOWEVER, THE 'COMPLEMENT' OF THE SOLUTION IS
-C COMPUTED (= ALL NODES OF THE GRAPH NOT CONTAINED IN THE SOLUTION)
-C AND STORED INTO 'SET', FOLLOWED BY THE ACTUAL(CONFER ALGORITHM OF
-C S.R. DAS) SOLUTION.
-C
-300 CONTINUE
- CALL TREVNI(VSET, LVSET, SET, NODES, SETPTR)
- NPTR = SETPTR
- DO 41 I = 1,LVSET
- NPTR = NPTR + 1
-41 SET(NPTR) = VSET(I)
- ASSIGN 10 TO CHOICE
- RETURN
-10 CONTINUE
- CALL TREVNI(WSET, LWSET, SET, NODES, SETPTR)
- NPTR = SETPTR
- DO 40 I = 1,LWSET
- NPTR = NPTR + 1
-40 SET(NPTR) = WSET(I)
- ASSIGN 20 TO CHOICE
- RETURN
-20 CONTINUE
-C
-C *** STEP 6
-C
- IF(TABNR .EQ. 1) GO TO 999
- LWEIT = LTEIT(TABNR) - LTEIT(TABNR - 1)
- LWSET = LSETT(TABNR) - LSETT(TABNR - 1)
- LVSET = LWSET
- TABNR = TABNR - 1
- IND = LTEIT(TABNR) + 1
- DO 31 I = 1,LWEIT
- CALL TUP(WEIT(1,1), I, IGET(TEIT(1,1), IND))
- CALL TUP(WEIT(1,2), I, IGET(TEIT(1,2), IND))
-31 IND = IND + 1
- IND = LSETT(TABNR) + 1
- DO 32 I = 1,LWSET
- IX = IGET(SETT, IND)
- WSET(I) = IX
- VSET(I) = IX
-32 IND = IND + 1
- GO TO 888
-999 NPTR = 0
- RETURN
- END
diff --git a/src/mathlib/gen/v/poissn.F b/src/mathlib/gen/v/poissn.F
deleted file mode 100644
index 803f324..0000000
--- a/src/mathlib/gen/v/poissn.F
+++ /dev/null
@@ -1,58 +0,0 @@
-*
-* $Id: poissn.F,v 1.1.1.1 1996/04/01 15:02:55 mclareni Exp $
-*
-* $Log: poissn.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:55 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE POISSN (AMU,N,IERROR)
-C
-C POISSON GENERATOR
-C CODED FROM LOS ALAMOS REPORT LA-5061-MS
-C PROB(N)=EXP(-AMU)*AMU**N/FACT(N)
-C WHERE FACT(N) STANDS FOR FACTORIAL OF N
-C ON RETURN IERROR.EQ.0 NORMALLY
-C IERROR.EQ.1 IF AMU.LE.0.
-C
- SAVE EXPMA,AMUOL,AMAX
- DATA AMUOL/-12345.67/
-C AMAX IS THE VALUE ABOVE WHICH THE NORMAL DISTRIBUTION MUST BE USED
-#if defined(CERNLIB_IBM)
- DATA AMAX/170.0/
-#endif
-#if defined(CERNLIB_CRAY)
- DATA AMAX/5677./
-#endif
-#if defined(CERNLIB_VAX)||defined(CERNLIB_UNIX)
- DATA AMAX/88.0/
-#endif
- IERROR= 0
- IF(AMU.GT.AMAX) GO TO 500
- IF(AMU.EQ.AMUOL) GO TO 200
- IF(AMU.GT.0.) GO TO 100
-C MEAN SHOULD BE POSITIVE
- IERROR=1
- N = 0
- GO TO 999
-C SAVE EXPONENTIAL FOR FURTHER IDENTICAL REQUESTS
- 100 AMUOL=AMU
- EXPMA=EXP(-AMU)
- 200 PIR=1.
- N=-1
- 300 N=N+1
- PIR=PIR*RNDM(N)
- IF(PIR.GT.EXPMA) GO TO 300
- GO TO 999
-C NORMAL APPROXIMATION FOR AMU.GT.AMAX
- 500 CALL RANNOR(RAN,B)
- N=RAN*SQRT(AMU)+AMU+.5
- GO TO 999
-C ENTRY FOR USER TO SET AMAX, SWITCHOVER POINT TO NORMAL APPROXIMATION
- ENTRY POISET(AMU)
- WRITE(6,1001) AMU
- 1001 FORMAT(' POISSON RANDOM NUMBER GENERATOR TO SWITCH TO',
- + ' NORMAL APPROXIMATION ABOVE AMU = ',F12.2)
- AMAX=AMU
- 999 END
diff --git a/src/mathlib/gen/v/ran3d.F b/src/mathlib/gen/v/ran3d.F
deleted file mode 100644
index f3e3583..0000000
--- a/src/mathlib/gen/v/ran3d.F
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: ran3d.F,v 1.1.1.1 1996/04/01 15:02:56 mclareni Exp $
-*
-* $Log: ran3d.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:56 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE RAN3D (X,Y,Z,XLONG)
-C SUBROUTINE TO GENERATE RANDOM THREE-DIMENSIONAL VECTOR
-C OF LENGTH XLONG. F. JAMES, MAY, 1976
- DIMENSION RBUF(30)
- SAVE IBUF,RBUF
- DATA IBUF/30/
- 1 CONTINUE
- IF (IBUF .LT. 30) GO TO 10
- CALL NRAN(RBUF,30)
- IBUF = 1
- 10 CONTINUE
- A = RBUF(IBUF) - 0.5
- B = RBUF(IBUF+1) - 0.5
- C = RBUF(IBUF+2) - 0.5
- IBUF = IBUF + 3
- R2=A**2+B**2+C**2
- IF(R2.GT.0.25) GO TO 1
- RINV = XLONG/SQRT(R2)
- X=A*RINV
- Y=B*RINV
- Z=C*RINV
- RETURN
- END
diff --git a/src/mathlib/gen/v/rangam.F b/src/mathlib/gen/v/rangam.F
deleted file mode 100644
index 1f70f23..0000000
--- a/src/mathlib/gen/v/rangam.F
+++ /dev/null
@@ -1,58 +0,0 @@
-*
-* $Id: rangam.F,v 1.1.1.1 1996/04/01 15:02:55 mclareni Exp $
-*
-* $Log: rangam.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:55 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- FUNCTION RANGAM(P)
-C THIS FUNCTION GENERATES A GAMMA DISTRIBUTED RANDOM NUMBER
-C WITH PARAMETER P .GT.0.
-C THE JOHNK S ALGORITHM IS USED
- DIMENSION STOR(20)
- RANGAM=0.
- IF(P.GT.15.) GO TO 40
- M=INT(P)
- F=P-M
- IF(M.EQ.0) GO TO 20
- X=1.
- CALL NRAN(STOR,M)
- DO 1 I=1,M
- 1 X = X * STOR(I)
- RANGAM=-LOG(X)
- 20 IF ( F .LT. 1.0E-5) RETURN
-C
- X1=-LOG(RNDM(3))
- IF (F .LT. 0.9999) GO TO 25
- 22 RANGAM = RANGAM + X1
- RETURN
-C NON-INTEGER VALUE OF P
- 25 CONTINUE
-C ....W1=R1**(1/F)
- WLOG = LOG (RNDM (1) ) / F
- IF (WLOG .LT. -100.) RETURN
- W1 = EXP(WLOG)
-C ....W2=R2**(1/(1-F))
- WLOG = LOG(RNDM(2)) / (1.-F)
- IF (WLOG .LT. -100.) GO TO 22
- W2 = EXP(WLOG)
- W=W1+W2
- IF(W.GT.1.) GO TO 25
- X2=W1/W
- RANGAM=RANGAM+X1*X2
- RETURN
-C
-C WILSON - HILFERTY APPROXIMATION
-#if (defined(CERNLIB_IBM)||defined(CERNLIB_CDC))&&(!defined(CERNLIB_FORTRAN))
- 40 CALL NORRAN(A)
-#endif
-#if (!defined(CERNLIB_IBM)||defined(CERNLIB_FORTRAN))&&(!defined(CERNLIB_CDC)||defined(CERNLIB_FORTRAN))
- 40 CALL RANNOR(A,B)
-#endif
- Q=1.-1./(9.*P)+A/(3.*SQRT(P))
- RANGAM=P*Q*Q*Q
- IF (RANGAM.LE.0.) GO TO 40
- RETURN
- END
diff --git a/src/mathlib/gen/v/ranlux.F b/src/mathlib/gen/v/ranlux.F
deleted file mode 100644
index fc0ddef..0000000
--- a/src/mathlib/gen/v/ranlux.F
+++ /dev/null
@@ -1,309 +0,0 @@
-*
-* $Id: ranlux.F,v 1.2 1997/09/22 13:45:47 mclareni Exp $
-*
-* $Log: ranlux.F,v $
-* Revision 1.2 1997/09/22 13:45:47 mclareni
-* Correct error in initializing RANLUX by using RLUXIN with the output of
-* RLUXUT from a previous run.
-*
-* Revision 1.1.1.1 1996/04/01 15:02:55 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE RANLUX(RVEC,LENV)
-C Subtract-and-borrow random number generator proposed by
-C Marsaglia and Zaman, implemented by F. James with the name
-C RCARRY in 1991, and later improved by Martin Luescher
-C in 1993 to produce "Luxury Pseudorandom Numbers".
-C Fortran 77 coded by F. James, 1993
-C
-C LUXURY LEVELS.
-C ------ ------ The available luxury levels are:
-C
-C level 0 (p=24): equivalent to the original RCARRY of Marsaglia
-C and Zaman, very long period, but fails many tests.
-C level 1 (p=48): considerable improvement in quality over level 0,
-C now passes the gap test, but still fails spectral test.
-C level 2 (p=97): passes all known tests, but theoretically still
-C defective.
-C level 3 (p=223): DEFAULT VALUE. Any theoretically possible
-C correlations have very small chance of being observed.
-C level 4 (p=389): highest possible luxury, all 24 bits chaotic.
-C
-C!!! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-C!!! Calling sequences for RANLUX: ++
-C!!! CALL RANLUX (RVEC, LEN) returns a vector RVEC of LEN ++
-C!!! 32-bit random floating point numbers between ++
-C!!! zero (not included) and one (also not incl.). ++
-C!!! CALL RLUXGO(LUX,INT,K1,K2) initializes the generator from ++
-C!!! one 32-bit integer INT and sets Luxury Level LUX ++
-C!!! which is integer between zero and MAXLEV, or if ++
-C!!! LUX .GT. 24, it sets p=LUX directly. K1 and K2 ++
-C!!! should be set to zero unless restarting at a break++
-C!!! point given by output of RLUXAT (see RLUXAT). ++
-C!!! CALL RLUXAT(LUX,INT,K1,K2) gets the values of four integers++
-C!!! which can be used to restart the RANLUX generator ++
-C!!! at the current point by calling RLUXGO. K1 and K2++
-C!!! specify how many numbers were generated since the ++
-C!!! initialization with LUX and INT. The restarting ++
-C!!! skips over K1+K2*E9 numbers, so it can be long.++
-C!!! A more efficient but less convenient way of restarting is by: ++
-C!!! CALL RLUXIN(ISVEC) restarts the generator from vector ++
-C!!! ISVEC of 25 32-bit integers (see RLUXUT) ++
-C!!! CALL RLUXUT(ISVEC) outputs the current values of the 25 ++
-C!!! 32-bit integer seeds, to be used for restarting ++
-C!!! ISVEC must be dimensioned 25 in the calling program ++
-C!!! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
- DIMENSION RVEC(LENV)
- DIMENSION SEEDS(24), ISEEDS(24), ISDEXT(25)
- PARAMETER (MAXLEV=4, LXDFLT=3)
- DIMENSION NDSKIP(0:MAXLEV)
- DIMENSION NEXT(24)
- PARAMETER (TWOP12=4096., IGIGA=1000000000,JSDFLT=314159265)
- PARAMETER (ITWO24=2**24, ICONS=2147483563)
- SAVE NOTYET, I24, J24, CARRY, SEEDS, TWOM24, TWOM12, LUXLEV
- SAVE NSKIP, NDSKIP, IN24, NEXT, KOUNT, MKOUNT, INSEED
- INTEGER LUXLEV
- LOGICAL NOTYET
- DATA NOTYET, LUXLEV, IN24, KOUNT, MKOUNT /.TRUE., LXDFLT, 0,0,0/
- DATA I24,J24,CARRY/24,10,0./
-C default
-C Luxury Level 0 1 2 *3* 4
- DATA NDSKIP/0, 24, 73, 199, 365 /
-Corresponds to p=24 48 97 223 389
-C time factor 1 2 3 6 10 on slow workstation
-C 1 1.5 2 3 5 on fast mainframe
-C
-C NOTYET is .TRUE. if no initialization has been performed yet.
-C Default Initialization by Multiplicative Congruential
- IF (NOTYET) THEN
- NOTYET = .FALSE.
- JSEED = JSDFLT
- INSEED = JSEED
- WRITE(6,'(A,I12)') ' RANLUX DEFAULT INITIALIZATION: ',JSEED
- LUXLEV = LXDFLT
- NSKIP = NDSKIP(LUXLEV)
- LP = NSKIP + 24
- IN24 = 0
- KOUNT = 0
- MKOUNT = 0
- WRITE(6,'(A,I2,A,I4)') ' RANLUX DEFAULT LUXURY LEVEL = ',
- + LUXLEV,' p =',LP
- TWOM24 = 1.
- DO 25 I= 1, 24
- TWOM24 = TWOM24 * 0.5
- K = JSEED/53668
- JSEED = 40014*(JSEED-K*53668) -K*12211
- IF (JSEED .LT. 0) JSEED = JSEED+ICONS
- ISEEDS(I) = MOD(JSEED,ITWO24)
- 25 CONTINUE
- TWOM12 = TWOM24 * 4096.
- DO 50 I= 1,24
- SEEDS(I) = REAL(ISEEDS(I))*TWOM24
- NEXT(I) = I-1
- 50 CONTINUE
- NEXT(1) = 24
- I24 = 24
- J24 = 10
- CARRY = 0.
- IF (SEEDS(24) .EQ. 0.) CARRY = TWOM24
- ENDIF
-C
-C The Generator proper: "Subtract-with-borrow",
-C as proposed by Marsaglia and Zaman,
-C Florida State University, March, 1989
-C
- DO 100 IVEC= 1, LENV
- UNI = SEEDS(J24) - SEEDS(I24) - CARRY
- IF (UNI .LT. 0.) THEN
- UNI = UNI + 1.0
- CARRY = TWOM24
- ELSE
- CARRY = 0.
- ENDIF
- SEEDS(I24) = UNI
- I24 = NEXT(I24)
- J24 = NEXT(J24)
- RVEC(IVEC) = UNI
-C small numbers (with less than 12 "significant" bits) are "padded".
- IF (UNI .LT. TWOM12) THEN
- RVEC(IVEC) = RVEC(IVEC) + TWOM24*SEEDS(J24)
-C and zero is forbidden in case someone takes a logarithm
- IF (RVEC(IVEC) .EQ. 0.) RVEC(IVEC) = TWOM24*TWOM24
- ENDIF
-C Skipping to luxury. As proposed by Martin Luscher.
- IN24 = IN24 + 1
- IF (IN24 .EQ. 24) THEN
- IN24 = 0
- KOUNT = KOUNT + NSKIP
- DO 90 ISK= 1, NSKIP
- UNI = SEEDS(J24) - SEEDS(I24) - CARRY
- IF (UNI .LT. 0.) THEN
- UNI = UNI + 1.0
- CARRY = TWOM24
- ELSE
- CARRY = 0.
- ENDIF
- SEEDS(I24) = UNI
- I24 = NEXT(I24)
- J24 = NEXT(J24)
- 90 CONTINUE
- ENDIF
- 100 CONTINUE
- KOUNT = KOUNT + LENV
- IF (KOUNT .GE. IGIGA) THEN
- MKOUNT = MKOUNT + 1
- KOUNT = KOUNT - IGIGA
- ENDIF
- RETURN
-C
-C Entry to input and float integer seeds from previous run
- ENTRY RLUXIN(ISDEXT)
- NOTYET = .FALSE.
- TWOM24 = 1.
- DO 195 I= 1, 24
- NEXT(I) = I-1
- 195 TWOM24 = TWOM24 * 0.5
- NEXT(1) = 24
- TWOM12 = TWOM24 * 4096.
- WRITE(6,'(A)') ' FULL INITIALIZATION OF RANLUX WITH 25 INTEGERS:'
- WRITE(6,'(5X,5I12)') ISDEXT
- DO 200 I= 1, 24
- SEEDS(I) = REAL(ISDEXT(I))*TWOM24
- 200 CONTINUE
- CARRY = 0.
- IF (ISDEXT(25) .LT. 0) CARRY = TWOM24
- ISD = IABS(ISDEXT(25))
- I24 = MOD(ISD,100)
- ISD = ISD/100
- J24 = MOD(ISD,100)
- ISD = ISD/100
- IN24 = MOD(ISD,100)
- ISD = ISD/100
- LUXLEV = ISD
- IF (LUXLEV .LE. MAXLEV) THEN
- NSKIP = NDSKIP(LUXLEV)
- WRITE (6,'(A,I2)') ' RANLUX LUXURY LEVEL SET BY RLUXIN TO: ',
- + LUXLEV
- ELSE IF (LUXLEV .GE. 24) THEN
- NSKIP = LUXLEV - 24
- WRITE (6,'(A,I5)') ' RANLUX P-VALUE SET BY RLUXIN TO:',LUXLEV
- ELSE
- NSKIP = NDSKIP(MAXLEV)
- WRITE (6,'(A,I5)') ' RANLUX ILLEGAL LUXURY RLUXIN: ',LUXLEV
- LUXLEV = MAXLEV
- ENDIF
- INSEED = -1
- RETURN
-C
-C Entry to ouput seeds as integers
- ENTRY RLUXUT(ISDEXT)
- DO 300 I= 1, 24
- ISDEXT(I) = INT(SEEDS(I)*TWOP12*TWOP12)
- 300 CONTINUE
- ISDEXT(25) = I24 + 100*J24 + 10000*IN24 + 1000000*LUXLEV
- IF (CARRY .GT. 0.) ISDEXT(25) = -ISDEXT(25)
- RETURN
-C
-C Entry to output the "convenient" restart point
- ENTRY RLUXAT(LOUT,INOUT,K1,K2)
- LOUT = LUXLEV
- INOUT = INSEED
- K1 = KOUNT
- K2 = MKOUNT
- RETURN
-C
-C Entry to initialize from one or three integers
- ENTRY RLUXGO(LUX,INS,K1,K2)
- IF (LUX .LT. 0) THEN
- LUXLEV = LXDFLT
- ELSE IF (LUX .LE. MAXLEV) THEN
- LUXLEV = LUX
- ELSE IF (LUX .LT. 24 .OR. LUX .GT. 2000) THEN
- LUXLEV = MAXLEV
- WRITE (6,'(A,I7)') ' RANLUX ILLEGAL LUXURY RLUXGO: ',LUX
- ELSE
- LUXLEV = LUX
- DO 310 ILX= 0, MAXLEV
- IF (LUX .EQ. NDSKIP(ILX)+24) LUXLEV = ILX
- 310 CONTINUE
- ENDIF
- IF (LUXLEV .LE. MAXLEV) THEN
- NSKIP = NDSKIP(LUXLEV)
- WRITE(6,'(A,I2,A,I4)') ' RANLUX LUXURY LEVEL SET BY RLUXGO :',
- + LUXLEV,' P=', NSKIP+24
- ELSE
- NSKIP = LUXLEV - 24
- WRITE (6,'(A,I5)') ' RANLUX P-VALUE SET BY RLUXGO TO:',LUXLEV
- ENDIF
- IN24 = 0
- IF (INS .LT. 0) WRITE (6,'(A)')
- + ' Illegal initialization by RLUXGO, negative input seed'
- IF (INS .GT. 0) THEN
- JSEED = INS
- WRITE(6,'(A,3I12)') ' RANLUX INITIALIZED BY RLUXGO FROM SEEDS',
- + JSEED, K1,K2
- ELSE
- JSEED = JSDFLT
- WRITE(6,'(A)')' RANLUX INITIALIZED BY RLUXGO FROM DEFAULT SEED'
- ENDIF
- INSEED = JSEED
- NOTYET = .FALSE.
- TWOM24 = 1.
- DO 325 I= 1, 24
- TWOM24 = TWOM24 * 0.5
- K = JSEED/53668
- JSEED = 40014*(JSEED-K*53668) -K*12211
- IF (JSEED .LT. 0) JSEED = JSEED+ICONS
- ISEEDS(I) = MOD(JSEED,ITWO24)
- 325 CONTINUE
- TWOM12 = TWOM24 * 4096.
- DO 350 I= 1,24
- SEEDS(I) = REAL(ISEEDS(I))*TWOM24
- NEXT(I) = I-1
- 350 CONTINUE
- NEXT(1) = 24
- I24 = 24
- J24 = 10
- CARRY = 0.
- IF (SEEDS(24) .EQ. 0.) CARRY = TWOM24
-C If restarting at a break point, skip K1 + IGIGA*K2
-C Note that this is the number of numbers delivered to
-C the user PLUS the number skipped (if luxury .GT. 0).
- KOUNT = K1
- MKOUNT = K2
- IF (K1+K2 .NE. 0) THEN
- DO 500 IOUTER= 1, K2+1
- INNER = IGIGA
- IF (IOUTER .EQ. K2+1) INNER = K1
- DO 450 ISK= 1, INNER
- UNI = SEEDS(J24) - SEEDS(I24) - CARRY
- IF (UNI .LT. 0.) THEN
- UNI = UNI + 1.0
- CARRY = TWOM24
- ELSE
- CARRY = 0.
- ENDIF
- SEEDS(I24) = UNI
- I24 = NEXT(I24)
- J24 = NEXT(J24)
- 450 CONTINUE
- 500 CONTINUE
-C Get the right value of IN24 by direct calculation
- IN24 = MOD(KOUNT, NSKIP+24)
- IF (MKOUNT .GT. 0) THEN
- IZIP = MOD(IGIGA, NSKIP+24)
- IZIP2 = MKOUNT*IZIP + IN24
- IN24 = MOD(IZIP2, NSKIP+24)
- ENDIF
-C Now IN24 had better be between zero and 23 inclusive
- IF (IN24 .GT. 23) THEN
- WRITE (6,'(A/A,3I11,A,I5)')
- + ' Error in RESTARTING with RLUXGO:',' The values', INS,
- + K1, K2, ' cannot occur at luxury level', LUXLEV
- IN24 = 0
- ENDIF
- ENDIF
- RETURN
- END
diff --git a/src/mathlib/gen/v/rg32.F b/src/mathlib/gen/v/rg32.F
deleted file mode 100644
index 3333f63..0000000
--- a/src/mathlib/gen/v/rg32.F
+++ /dev/null
@@ -1,56 +0,0 @@
-*
-* $Id: rg32.F,v 1.1.1.1 1996/04/01 15:02:55 mclareni Exp $
-*
-* $Log: rg32.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:55 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_VAX)
- OPTIONS/CHECK=NOOVERFLOW
-#endif
- FUNCTION RG32(IDUMMY)
-#if defined(CERNLIB_CRAY)
-CDIR$ INTEGER=64
-#endif
-C MACHINE-INDEPENDENT RANDOM NUMBER GENERATOR
-C PRODUCES GAUSSIAN-DISTRIBUTED FLOATING-PT.
-C NUMBERS OF MEAN ZERO AND VARIANCE ONE.
-C IDENTICAL SEQUENCE ON ALL MACHINES OF .GE. 32 BITS.
-C UNIVERSAL VERSION, F.JAMES, 1985
-C IY IS THE SEED,
-C CONS IS 2**-23
-C MASK31 IS 17777777777 OCTAL
- PARAMETER (CONS=1.1920928955078E-07, MASK31=2147483647)
-CSELF,IF=-IBM. CERN EDITLIB+SIEMENS COMPILER PROBLEM.
- SAVE IY
-CSELF.
- DATA IY/875949887/
-C
- JSUM = 0
- DO 50 LOOP= 1, 12
- IY = IY * 69069
-C KEEP ONLY LOWER 31 BITS
- IY = IAND (IY, MASK31)
-C SHIFT RIGHT 8 BITS TO AVOID OVFLO
- JY = IY /256
- JSUM = JSUM + JY
- 50 CONTINUE
-C CORRECT FOR TRUNCATION BIAS AND ROUND TO NEAREST
-C EVEN BYTE TO ASSURE EXACT FLOAT
- JSUM = (JSUM+134)/256*256
-C
- RG32 = CONS*JSUM - 6.0
- RETURN
-C ENTRY TO INPUT SEED
- ENTRY RG32IN (IDUMMY)
- IY = IDUMMY
- RG32IN = 0.
- RETURN
-C ENTRY TO OUTPUT SEED
- ENTRY RG32OT (IDUMMY)
- IDUMMY = IY
- RG32OT = 0.
- RETURN
- END
diff --git a/src/mathlib/gen/v/rm48.F b/src/mathlib/gen/v/rm48.F
deleted file mode 100644
index 17b7ad8..0000000
--- a/src/mathlib/gen/v/rm48.F
+++ /dev/null
@@ -1,153 +0,0 @@
-*
-* $Id: rm48.F,v 1.2 1996/12/12 16:32:06 cernlib Exp $
-*
-* $Log: rm48.F,v $
-* Revision 1.2 1996/12/12 16:32:06 cernlib
-* Variables ONE and ZERO added to SAVE statement, courtesy R.Veenhof
-*
-* Revision 1.1.1.1 1996/04/01 15:02:55 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE RM48(RVEC,LENV)
-C Double-precision version of
-C Universal random number generator proposed by Marsaglia and Zaman
-C in report FSU-SCRI-87-50
-C based on RANMAR, modified by F. James, to generate vectors
-C of pseudorandom numbers RVEC of length LENV, where the numbers
-C in RVEC are numbers with at least 48-bit mantissas.
-C Input and output entry points: RM48IN, RM48UT.
-C!!! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-C!!! Calling sequences for RM48: ++
-C!!! CALL RM48 (RVEC, LEN) returns a vector RVEC of LEN ++
-C!!! 64-bit random floating point numbers between ++
-C!!! zero and one. ++
-C!!! CALL RM48IN(I1,N1,N2) initializes the generator from one ++
-C!!! 64-bit integer I1, and number counts N1,N2 ++
-C!!! (for initializing, set N1=N2=0, but to restart ++
-C!!! a previously generated sequence, use values ++
-C!!! output by RM48UT) ++
-C!!! CALL RM48UT(I1,N1,N2) outputs the value of the original ++
-C!!! seed and the two number counts, to be used ++
-C!!! for restarting by initializing to I1 and ++
-C!!! skipping N2*100000000+N1 numbers. ++
-C!!! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-C for 32-bit machines, use IMPLICIT DOUBLE PRECISION
- IMPLICIT DOUBLE PRECISION (A-H,O-Z)
- DIMENSION RVEC(*)
- COMMON/R48ST1/U(97),C,I97,J97
- PARAMETER (MODCNS=1000000000)
- SAVE CD, CM, TWOM24, NTOT, NTOT2, IJKL,TWOM49, ONE, ZERO
- DATA NTOT,NTOT2,IJKL/-1,0,0/
-C
- IF (NTOT .GE. 0) GO TO 50
-C
-C Default initialization. User has called RM48 without RM48IN.
- IJKL = 54217137
- NTOT = 0
- NTOT2 = 0
- KALLED = 0
- GO TO 1
-C
- ENTRY RM48IN(IJKLIN, NTOTIN,NTOT2N)
-C Initializing routine for RM48, may be called before
-C generating pseudorandom numbers with RM48. The input
-C values should be in the ranges: 0<=IJKLIN<=900 OOO OOO
-C 0<=NTOTIN<=999 999 999
-C 0<=NTOT2N<<999 999 999!
-C To get the standard values in Marsaglia's paper, IJKLIN=54217137
-C NTOTIN,NTOT2N=0
- IJKL = IJKLIN
- NTOT = MAX(NTOTIN,0)
- NTOT2= MAX(NTOT2N,0)
- KALLED = 1
-C always come here to initialize
- 1 CONTINUE
- IJ = IJKL/30082
- KL = IJKL - 30082*IJ
- I = MOD(IJ/177, 177) + 2
- J = MOD(IJ, 177) + 2
- K = MOD(KL/169, 178) + 1
- L = MOD(KL, 169)
- WRITE(6,'(A,I10,2X,2I10)') ' RM48 INITIALIZED:',IJKL,NTOT,NTOT2
-CCC PRINT '(A,4I10)', ' I,J,K,L= ',I,J,K,L
- ONE = 1.
- HALF = 0.5
- ZERO = 0.
- DO 2 II= 1, 97
- S = 0.
- T = HALF
- DO 3 JJ= 1, 48
- M = MOD(MOD(I*J,179)*K, 179)
- I = J
- J = K
- K = M
- L = MOD(53*L+1, 169)
- IF (MOD(L*M,64) .GE. 32) S = S+T
- 3 T = HALF*T
- 2 U(II) = S
- TWOM49 = T
- TWOM24 = ONE
- DO 4 I24= 1, 24
- 4 TWOM24 = HALF*TWOM24
- C = 362436.*TWOM24
- CD = 7654321.*TWOM24
- CM = 16777213.*TWOM24
- I97 = 97
- J97 = 33
-C Complete initialization by skipping
-C (NTOT2*MODCNS + NTOT) random numbers
- DO 45 LOOP2= 1, NTOT2+1
- NOW = MODCNS
- IF (LOOP2 .EQ. NTOT2+1) NOW=NTOT
- IF (NOW .GT. 0) THEN
- WRITE(6,'(A,I15)') ' RM48IN SKIPPING OVER ',NOW
- DO 40 IDUM = 1, NTOT
- UNI = U(I97)-U(J97)
- IF (UNI .LT. ZERO) UNI=UNI+ONE
- U(I97) = UNI
- I97 = I97-1
- IF (I97 .EQ. 0) I97=97
- J97 = J97-1
- IF (J97 .EQ. 0) J97=97
- C = C - CD
- IF (C .LT. ZERO) C=C+CM
- 40 CONTINUE
- ENDIF
- 45 CONTINUE
- IF (KALLED .EQ. 1) RETURN
-C
-C Normal entry to generate LENV random numbers
- 50 CONTINUE
- DO 100 IVEC= 1, LENV
- UNI = U(I97)-U(J97)
- IF (UNI .LT. ZERO) UNI=UNI+ONE
- U(I97) = UNI
- I97 = I97-1
- IF (I97 .EQ. 0) I97=97
- J97 = J97-1
- IF (J97 .EQ. 0) J97=97
- C = C - CD
- IF (C .LT. ZERO) C=C+CM
- UNI = UNI-C
- IF (UNI .LT. ZERO) UNI=UNI+ONE
- RVEC(IVEC) = UNI
-C Replace exact zeros by 2**-49
- IF (UNI .EQ. ZERO) THEN
- RVEC(IVEC) = TWOM49
- ENDIF
- 100 CONTINUE
- NTOT = NTOT + LENV
- IF (NTOT .GE. MODCNS) THEN
- NTOT2 = NTOT2 + 1
- NTOT = NTOT - MODCNS
- ENDIF
- RETURN
-C Entry to output current status
- ENTRY RM48UT(IJKLUT,NTOTUT,NTOT2T)
- IJKLUT = IJKL
- NTOTUT = NTOT
- NTOT2T = NTOT2
- RETURN
- END
diff --git a/src/mathlib/gen/v/rn32.F b/src/mathlib/gen/v/rn32.F
deleted file mode 100644
index 5e66f53..0000000
--- a/src/mathlib/gen/v/rn32.F
+++ /dev/null
@@ -1,46 +0,0 @@
-*
-* $Id: rn32.F,v 1.1.1.1 1996/04/01 15:02:54 mclareni Exp $
-*
-* $Log: rn32.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:54 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if !defined(CERNLIB_VAX)||defined(CERNLIB_FORTRAN)
- FUNCTION RN32(IDUMMY)
-#if defined(CERNLIB_CRAY)
-CDIR$ INTEGER=64
-#endif
-C MACHINE-INDEPENDENT RANDOM NUMBER GENERATOR
-C PRODUCES UNIFORMLY-DISTRIBUTED FLOATING-PT.
-C NUMBERS BETWEEN ZERO AND ONE.
-C IDENTICAL SEQUENCE ON ALL MACHINES OF .GE. 32 BITS.
-C UNIVERSAL VERSION, F.JAMES, 1985
-C IY IS THE SEED,
-C CONS IS 2**-31
-C MASK31 IS 17777777777 OCTAL
- PARAMETER (CONS=4.6566128730774E-10, MASK31=2147483647)
-CSELF,IF=-IBM. CERN EDITLIB+SIEMENS COMPILER PROBLEM.
- SAVE IY
-CSELF.
- DATA IY/65539/
- IY = IY * 69069
-C KEEP ONLY LOWER 31 BITS
- IY = IAND (IY, MASK31)
-C SET LOWER 8 BITS TO ZERO TO ASSURE EXACT FLOAT
- JY = IY /256 *256
- RN32 = CONS*JY
- RETURN
-C ENTRY TO INPUT SEED
- ENTRY RN32IN (IDUMMY)
- IY = IDUMMY
- RN32IN = 0.
- RETURN
-C ENTRY TO OUTPUT SEED
- ENTRY RN32OT (IDUMMY)
- IDUMMY = IY
- RN32OT = 0.
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/v/rn32ml.s b/src/mathlib/gen/v/rn32ml.s
deleted file mode 100644
index 7c37d55..0000000
--- a/src/mathlib/gen/v/rn32ml.s
+++ /dev/null
@@ -1,36 +0,0 @@
-;
-; $Id: rn32ml.s,v 1.2 1996/04/26 12:31:54 cernlib Exp $
-;
-; $Log: rn32ml.s,v $
-; Revision 1.2 1996/04/26 12:31:54 cernlib
-; Correct comment leader and comment/remove cpp ifdef lines
-;
-; Revision 1.1.1.1 1996/04/01 15:02:54 mclareni
-; Mathlib gen
-;
-;
-; Compile this only with:
-; #if (defined(CERNLIB_VAX))&&(!defined(CERNLIB_FORTRAN))
-;
- .TITLE RN32
-IY: .LONG ^X00010003
-RN32::
- .WORD ^M<>
- MOVL IY,R0
- MULL2 #69069,R0
- BGTR OK
- ADDL2 #-2147483648, R0
-OK: MOVL R0,IY
- BICL2 #^XFF,R0
- CVTLF R0,R0
- MULF2 #^X3100,R0
- RET
-RN32IN::
- .WORD ^M<IV>
- MOVL @4(AP),IY
- RET
-RN32OT::
- .WORD ^M<IV>
- MOVL IY, @4(AP)
- RET
- .END
diff --git a/src/mathlib/gen/v/rn3dim.F b/src/mathlib/gen/v/rn3dim.F
deleted file mode 100644
index 0b96d24..0000000
--- a/src/mathlib/gen/v/rn3dim.F
+++ /dev/null
@@ -1,48 +0,0 @@
-*
-* $Id: rn3dim.F,v 1.1 1997/08/21 17:06:53 mclareni Exp $
-*
-* $Log: rn3dim.F,v $
-* Revision 1.1 1997/08/21 17:06:53 mclareni
-* New routine from F.James
-*
-*
- SUBROUTINE RN3DIM(X,Y,Z,XLONG)
-
- DIMENSION RBF3(30),RBF2(20)
-
- SAVE IBF3,RBF3,IBF2,RBF2
-
- DATA IBF3 /30/, IBF2 /20/
-
- 1 IF(IBF3 .GE. 30) THEN
- CALL RANLUX(RBF3,30)
- IBF3 = 1
- ENDIF
- A=RBF3(IBF3)-0.5
- B=RBF3(IBF3+1)-0.5
- C=RBF3(IBF3+2)-0.5
- IBF3=IBF3+3
- R=A**2+B**2+C**2
- IF(R .GT. 0.25) GO TO 1
- RINV=XLONG/SQRT(R)
- X=A*RINV
- Y=B*RINV
- Z=C*RINV
- RETURN
-
- ENTRY RN2DIM(X,Y,XLONG)
-
- 2 IF(IBF2 .GE. 20) THEN
- CALL RANLUX(RBF2,20)
- IBF2 = 1
- ENDIF
- A=RBF2(IBF2)-0.5
- B=RBF2(IBF2+1)-0.5
- IBF2=IBF2+2
- R=A**2+B**2
- IF(R .GT. 0.25) GO TO 2
- RINV=XLONG/SQRT(R)
- X=A*RINV
- Y=B*RINV
- RETURN
- END
diff --git a/src/mathlib/gen/v/rnbnml.F b/src/mathlib/gen/v/rnbnml.F
deleted file mode 100644
index 8e431e4..0000000
--- a/src/mathlib/gen/v/rnbnml.F
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: rnbnml.F,v 1.1.1.1 1996/04/01 15:02:56 mclareni Exp $
-*
-* $Log: rnbnml.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:56 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE RNBNML(M,P,N,IERR)
-
- PARAMETER (NRV = 100)
- DIMENSION RV(NRV)
-
- IERR=1
- IF(0 .LT. P .AND. P .LT. 1) THEN
- IERR=0
- N=0
- J0=M/NRV+1
- I0=NRV
- DO 1 J = 1,J0
- IF(J .EQ. J0) I0=MOD(M,NRV)
- CALL RANLUX(RV,I0)
- DO 1 I = 1,I0
- IF(RV(I) .LE. P) N=N+1
- 1 CONTINUE
- ENDIF
- RETURN
- END
diff --git a/src/mathlib/gen/v/rndm2.F b/src/mathlib/gen/v/rndm2.F
deleted file mode 100644
index e8de77d..0000000
--- a/src/mathlib/gen/v/rndm2.F
+++ /dev/null
@@ -1,176 +0,0 @@
-*
-* $Id: rndm2.F,v 1.1.1.1 1996/04/01 15:02:54 mclareni Exp $
-*
-* $Log: rndm2.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:54 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_VAX)
- OPTIONS /CHECK=NOOVERFLOW
- FUNCTION RNDM2 ()
-C-----------------------------------------------------------------------
-C
-C... FUNCTION RNDM2 () Ch.Walck 870401
-C. slight mod. 940122
-C.
-C. Fortran version of RNDM2/IRNDM2/RD2IN/RD2OUT (CERN LIBRARY entry
-C. V107 on GENLIB) for VAX/VMS or AXP/OpenVMS written after the
-C. assembler routine.
-C.
-C. Calling sequences:
-C. R = RNDM2(DUMMY) Generate continuous uniform r.n.
-C. IR = IRNDM2(DUMMY) Generate discrete uniform r.n.
-C. CALL RD2IN ( ISEED1, ISEED2 ) Initialize seeds
-C. CALL RD2OUT ( ISEED1, ISEED2 ) Access seeds
-C.
-C. This generator has a sequence of 4.609.432.020.664.188.928 =
-C. 4.6*10**18 random numbers. The minimum value returned is 2**-25 =
-C. 0.000000030 and the maximum value is 1 - 2**24 = 0.999999940.
-C.
-C. The arithmetics involved causes integer overflows which is handled
-C. on VAX/VMS by calling ERRSET once from the main program as follows:
-C. CALL ERRSET(70,.TRUE.,.FALSE.,.FALSE.,.FALSE.,100)
-C. or by compiling this routine with /CHECK=NOOVERFLOW
-C. or, as here, by the VAX FORTRAN OPTIONS statement before and after
-C. the routine.
-C.
-C.----------------------------------------------------------------------
- PARAMETER (MEXPO='FFFF807F'X,NEXPO=7)
- SAVE MCGN, SRGN
- INTEGER R0, R1, SRGN
- EQUIVALENCE ( MAN, XMAN ), ( IR, R )
- DATA MCGN/12345/, SRGN/1073/
- R0 = IEOR ( ISHFT(SRGN,-15), SRGN )
- R1 = ISHFT ( R0 , 17 )
- SRGN = IEOR ( R0 ,R1 )
- MCGN = 69069 * MCGN
- MAN = ISHFT ( IEOR ( SRGN, MCGN ) , -8 )
- XMAN = MAN
- NSHFT = IAND ( ISHFT ( MAN, -NEXPO ), 31 )
- NSHFT = NSHFT + 104
- IR = IOR ( IAND ( MAN, MEXPO ), ISHFT ( NSHFT, NEXPO ) )
- RNDM2 = R
- RETURN
-C
- ENTRY IRNDM2 ()
- R0 = IEOR ( ISHFT(SRGN,-15), SRGN )
- R1 = ISHFT ( R0 , 17 )
- SRGN = IEOR ( R0, R1 )
- MCGN = 69069 * MCGN
- IRNDM2 = ISHFT ( IEOR ( MCGN, SRGN ) , -1 )
- RETURN
-C
- ENTRY RD2IN ( ISEED1, ISEED2 )
- MCGN = ISEED1
- SRGN = ISEED2
- RETURN
-C
- ENTRY RD2OUT ( ISEED1, ISEED2 )
- ISEED1 = MCGN
- ISEED2 = SRGN
- RETURN
- END
-#endif
-#if (defined(CERNLIB_VAX))&&(defined(CERNLIB_FORTRAN))&&(!defined(CERNLIB_F4))&&(defined(CERNLIB_OLD))
- FUNCTION RNDM2 (DUMMY)
-C
-C VERY USEFULL FORTRAN VERSION OF RNDM2
-C
- INTEGER*4 M(6)
-C
- INTEGER*4 MCGN,SRGN,REGB,REGC,REGD
- DATA MCGN,SRGN /12345,1073/
-C
- DATA M /'00F00000'X,'000F0000'X,'0000F000'X,
- 1 '00000F00'X,'000000F0'X,'0000000F'X/
-C
- DATA ICALL /0/
- ICALL= ICALL+1
-* WRITE(6,100)ICALL
-C
- REGB= SRGN
- REGC= REGB
- REGC= ISHFT (REGC,-15)
- REGB= IEOR (REGB,REGC)
- REGC= REGB
- REGC= ISHFT (REGC,17)
- REGB= IEOR (REGB,REGC)
- SRGN= REGB
- REGD= MCGN
- REGD= REGD*69069
- MCGN= REGD
-* WRITE(6,110)MCGN,SRGN
- REGD= IEOR (REGB,REGD)
- REGD= ISHFT (REGD,-8)
- REGD= IAND(REGD,'40000000'X)
- R=0.
- DO II=1,6
- IP=(II-6)*4
- J=IAND(M(II),REGD)
- JJ=ISHFT(J,IP)
- R= R+JJ*(16.**-II)
- ENDDO
- RNDM2= R
- RETURN
- 100 FORMAT(5X,I3,'-TH CALL TO RNDM2.FOR ')
- 110 FORMAT(5X,'MCGN,SRGN = ',2Z9.8)
- END
-#endif
-#if defined(CERNLIB_UNIX)
- FUNCTION RNDM2 (DUMMY)
-C
-C CERN PROGLIB# V107 RNDM2 .VERSION KERNALT 1.02 880323
-C ORIG. 7-APR-88, Ch. Walck, Stockholm
-C
-C Mods Date Comments
-C MARQUINA 90/05/06 Generalize code for UNIX machines
-C
-C- Uniform Random Number Generator
-
-C- Calling sequences:
-C- R = RNDM2 () Continuous uniform r.n. 0 to 1
-C- IR = IRNDM2 () Discrete uniform r.n. 0 to 2**31-1
-C- CALL RD2IN (ISEED1,ISEED2) Set seeds
-C- CALL RD2OUT (ISEED1,ISEED2) Get seeds
-
- EQUIVALENCE (ZERO,IZERO)
- SAVE MCGN, MCGX
- DATA MCGN/12345/, MCGX/1073/
-#include "v107z0.inc"
-
-C---- Floating random number
-
-#include "v107rn.inc"
- IF (MANT.EQ.0) GO TO 14
- AMAN = MANT
- RNDM2 = AMAN * 2.**(-24)
- RETURN
-
-C-- for zero set RNDM2 = 2.**(-25)
- 14 IZERO = IZ0
- RNDM2 = ZERO
- RETURN
-
-C--- Integer random number
-
- ENTRY IRNDM2 (DUMMY)
-#include "v107ri.inc"
- RETURN
-
-C---- Set seeds
-
- ENTRY RD2IN (ISEED1, ISEED2)
- MCGN = ISEED1
- MCGX = ISEED2
- RETURN
-
-C---- Get seeds
-
- ENTRY RD2OUT (ISEED1, ISEED2)
- ISEED1 = MCGN
- ISEED2 = MCGX
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/v/rngama.F b/src/mathlib/gen/v/rngama.F
deleted file mode 100644
index 6fab6fc..0000000
--- a/src/mathlib/gen/v/rngama.F
+++ /dev/null
@@ -1,55 +0,0 @@
-*
-* $Id: rngama.F,v 1.1.1.1 1996/04/01 15:02:56 mclareni Exp $
-*
-* $Log: rngama.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:56 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- FUNCTION RNGAMA(P)
- EXTERNAL RANLUX
-
- DIMENSION STOR(15)
-
- H=0
- IF(P .GT. 15) THEN
- 1 CALL RNORMX(A,1,RANLUX)
- H=P*(1-1/(9*P)+A/(3*SQRT(P)))**3
- IF(H .LE. 0) GO TO 1
- ELSE
- M=P
- F=P-M
- IF(M .GT. 0) THEN
- X=1
- CALL RANLUX(STOR,M)
- DO 2 I = 1,M
- 2 X=X*STOR(I)
- H=-LOG(X)
- ENDIF
- IF(F .GE. 0.00001) THEN
- CALL RANLUX(X,1)
- X1=-LOG(X)
- IF(F .GE. 0.9999) THEN
- H=H+X1
- ELSE
- CALL RANLUX(X,1)
- 3 WLOG=LOG(X)/F
- IF(WLOG .GE. -100) THEN
- W1=EXP(WLOG)
- CALL RANLUX(X,1)
- WLOG=LOG(X)/(1-F)
- IF(WLOG .LT. -100) THEN
- H=H+X1
- ELSE
- W=W1+EXP(WLOG)
- IF(W .GT. 1) GO TO 3
- H=H+X1*W1/W
- ENDIF
- ENDIF
- ENDIF
- ENDIF
- ENDIF
- RNGAMA=H
- RETURN
- END
diff --git a/src/mathlib/gen/v/rnhran.F b/src/mathlib/gen/v/rnhran.F
deleted file mode 100644
index 352f833..0000000
--- a/src/mathlib/gen/v/rnhran.F
+++ /dev/null
@@ -1,60 +0,0 @@
-*
-* $Id: rnhran.F,v 1.2 1996/04/10 16:31:41 mclareni Exp $
-*
-* $Log: rnhran.F,v $
-* Revision 1.2 1996/04/10 16:31:41 mclareni
-* NAME given dimension 2
-*
-* Revision 1.1 1996/04/09 13:34:34 mclareni
-* Add new routine rnhran.F (V149), also to Imakefile
-*
-*
- SUBROUTINE RNHRAN(Y,N,XLO,XWID,XRAN)
- CHARACTER*6 NAME(2)
-
- DIMENSION Y(*)
-
- DATA IERR /0/
- DATA NAME /'RNHRAN','RNHPRE'/
-
- NTRY=1
- IF(Y(N) .EQ. 1) GOTO 4
- WRITE(6,101) NAME(1),Y(N)
- GOTO 5
-
- ENTRY RNHPRE(Y,N)
- NTRY=2
-
- 5 YTOT=0
- DO 1 I = 1,N
- IF(Y(I) .LT. 0) GOTO 9
- YTOT=YTOT+Y(I)
- 1 Y(I)=YTOT
- IF(YTOT .LE. 0) GOTO 9
- YINV=1/YTOT
- DO 2 I = 1,N
- 2 Y(I)=Y(I)*YINV
- Y(N)=1
- IF(NTRY .EQ. 2) RETURN
-
- 4 CALL RANLUX(YR,1)
- L=LOCATR(Y,N,YR)
- IF(L .LT. 0) THEN
- L=-L
- XRAN=XLO+XWID*(L+((YR-Y(L))/(Y(L+1)-Y(L))))
- ELSEIF(L .EQ. 0) THEN
- XRAN=XLO+XWID*(YR/Y(1))
- ELSE
- XRAN=XLO+L*XWID
- ENDIF
- RETURN
-
- 9 IERR=IERR+1
- IF(IERR .LT. 6) WRITE(6,102) NAME(NTRY)
- WRITE(6,'(1X,10F13.7)') (Y(K),K=1,N)
- XRAN=0
- RETURN
- 101 FORMAT(/7X,'+++++ CERN V149 ',A6,' : Y(N) = ',E15.6,' .NE. 1; ',
- 1 'Y(I) NOT IN CUMULATIVE FORM.'/)
- 102 FORMAT(/7X,'+++++ CERN V149 ',A6,' : NOT ALL VALUES Y(I) > 0'/)
- END
diff --git a/src/mathlib/gen/v/rnmnml.F b/src/mathlib/gen/v/rnmnml.F
deleted file mode 100644
index 59e0fe7..0000000
--- a/src/mathlib/gen/v/rnmnml.F
+++ /dev/null
@@ -1,39 +0,0 @@
-*
-* $Id: rnmnml.F,v 1.1.1.1 1996/04/01 15:02:56 mclareni Exp $
-*
-* $Log: rnmnml.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:56 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE RNMNML(N,NSUM,PCUM,NVEC,IERR)
-
- PARAMETER (NRV = 100)
- DIMENSION PCUM(*),NVEC(*),RV(NRV)
-
- IERR=2
- IF(PCUM(N) .NE. 1) GO TO 9
- IERR=1
- DO 1 I = 2,N
- IF(PCUM(I) .LT. PCUM(I-1)) GO TO 9
- 1 CONTINUE
- IERR=0
- DO 2 K = 1,N
- 2 NVEC(K)=0
- J0=NSUM/NRV+1
- I0=NRV
- DO 3 J = 1,J0
- IF(J .EQ. J0) I0=MOD(NSUM,NRV)
- CALL RANLUX(RV,I0)
- DO 4 I = 1,I0
- DO 5 K = 1,N
- IF(PCUM(K) .GE. RV(I)) THEN
- NVEC(K)=NVEC(K)+1
- GO TO 4
- ENDIF
- 5 CONTINUE
- 4 CONTINUE
- 3 CONTINUE
- 9 RETURN
- END
diff --git a/src/mathlib/gen/v/rnorml.F b/src/mathlib/gen/v/rnorml.F
deleted file mode 100644
index 6397fe7..0000000
--- a/src/mathlib/gen/v/rnorml.F
+++ /dev/null
@@ -1,45 +0,0 @@
-*
-* $Id: rnorml.F,v 1.1.1.1 1996/04/01 15:02:55 mclareni Exp $
-*
-* $Log: rnorml.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:55 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE RNORML(DEVIAS,NDEV)
-C Generator of a vector of independent Gaussian-distributed
-C (pseudo-)random numbers, of mean zero and variance one,
-C making use of a uniform pseudo-random generator (RANMAR).
-C The algorithm for converting uniform numbers to Gaussian
-C is that of "Ratio of Uniforms with Quadratic Bounds." The
-C method is in principle exact (apart from rounding errors),
-C and is based on the variant published by Joseph Leva in
-C ACM TOMS vol. 18(1992), page 449 for the method and 454 for
-C the Fortran algorithm (ACM No. 712).
-C It requires at least 2 and on average 2.74 uniform deviates
-C per Gaussian (normal) deviate.
-C WARNING -- The uniform generator should not produce exact zeroes,
-C since the pair (0.0, 0.5) provokes a floating point exception.
- SAVE S, T, A, B, R1, R2
- DIMENSION U(2), DEVIAS(*)
- DATA S, T, A, B / 0.449871, -0.386595, 0.19600, 0.25472/
- DATA R1, R2/ 0.27597, 0.27846/
-C generate pair of uniform deviates
- DO 200 IDEV = 1, NDEV
- 50 CALL RANMAR(U,2)
- V = 1.7156 * (U(2) - 0.5)
- X = U(1) - S
- Y = ABS(V) - T
- Q = X**2 + Y*(A*Y - B*X)
-C accept P if inside inner ellipse
- IF (Q .LT. R1) GO TO 100
-C reject P if outside outer ellipse
- IF (Q .GT. R2) GO TO 50
-C reject P if outside acceptance region
- IF (V**2 .GT. -4.0 *ALOG(U(1)) *U(1)**2) GO TO 50
-C ratio of P's coordinates is normal deviate
- 100 DEVIAT = V/U(1)
- 200 DEVIAS(IDEV) = DEVIAT
- RETURN
- END
diff --git a/src/mathlib/gen/v/rnormx.F b/src/mathlib/gen/v/rnormx.F
deleted file mode 100644
index 97ce4f3..0000000
--- a/src/mathlib/gen/v/rnormx.F
+++ /dev/null
@@ -1,46 +0,0 @@
-*
-* $Id: rnormx.F,v 1.1.1.1 1996/04/01 15:02:55 mclareni Exp $
-*
-* $Log: rnormx.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:55 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE RNORMX(DEVIAS,NDEV,ROUTIN)
-C Generator of a vector of independent Gaussian-distributed
-C (pseudo-)random numbers, of mean zero and variance one,
-C making use of a uniform pseudo-random generator (RANMAR).
-C The algorithm for converting uniform numbers to Gaussian
-C is that of "Ratio of Uniforms with Quadratic Bounds." The
-C method is in principle exact (apart from rounding errors),
-C and is based on the variant published by Joseph Leva in
-C ACM TOMS vol. 18(1992), page 449 for the method and 454 for
-C the Fortran algorithm (ACM No. 712).
-C It requires at least 2 and on average 2.74 uniform deviates
-C per Gaussian (normal) deviate.
-C WARNING -- The uniform generator should not produce exact zeroes,
-C since the pair (0.0, 0.5) provokes a floating point exception.
- SAVE S, T, A, B, R1, R2
- DIMENSION U(2), DEVIAS(*)
- EXTERNAL ROUTIN
- DATA S, T, A, B / 0.449871, -0.386595, 0.19600, 0.25472/
- DATA R1, R2/ 0.27597, 0.27846/
-C generate pair of uniform deviates
- DO 200 IDEV = 1, NDEV
- 50 CALL ROUTIN(U,2)
- V = 1.7156 * (U(2) - 0.5)
- X = U(1) - S
- Y = ABS(V) - T
- Q = X**2 + Y*(A*Y - B*X)
-C accept P if inside inner ellipse
- IF (Q .LT. R1) GO TO 100
-C reject P if outside outer ellipse
- IF (Q .GT. R2) GO TO 50
-C reject P if outside acceptance region
- IF (V**2 .GT. -4.0 *ALOG(U(1)) *U(1)**2) GO TO 50
-C ratio of P's coordinates is normal deviate
- 100 DEVIAT = V/U(1)
- 200 DEVIAS(IDEV) = DEVIAT
- RETURN
- END
diff --git a/src/mathlib/gen/v/rnorthux.F b/src/mathlib/gen/v/rnorthux.F
deleted file mode 100644
index 5132a3b..0000000
--- a/src/mathlib/gen/v/rnorthux.F
+++ /dev/null
@@ -1,56 +0,0 @@
-*
-* $Id: rnorthux.F,v 1.1.1.1 1996/04/01 15:02:53 mclareni Exp $
-*
-* $Log: rnorthux.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:53 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_UNIX)
- FUNCTION RNORTH (K)
-C
-C Function used by NORRAN (CERN library entry V101) rewritten
-C for Alliant. / Ch.Walck 871214
-C
- DIMENSION C(45)
- EXTERNAL VNI, UNI
- DATA I1 /-71085056/, I2 /-25595858/
- DATA C / 0.9889430404, 0.9889430404, 0.9791515470, 0.9595685005
- + , 0.9497770071, 0.9301939607, 0.9008194208, 0.8812363744
- + , 0.8518618345, 0.8224872947, 0.7833212614, 0.7539466619
- + , 0.7147806287, 0.6756145358, 0.6364485025, 0.5972824097
- + , 0.5679078698, 0.5287418365, 0.4895757437, 0.4504097104
- + , 0.4210351706, 0.3818690777, 0.3524945378, 0.3231199980
- + , 0.2937454581, 0.2643709183, 0.2349963784, 0.2154133320
- + , 0.1860387921, 0.1664557457, 0.1468726993, 0.1272896528
- + , 0.1174981594, 0.0979151130, 0.0881236196, 0.0783321261
- + , 0.0685405731, 0.0587490946, 0.0489575788, 0.0391660631
- + , 0.0293745473, 0.0293745473, 0.0195830315, 0.0195830315
- + , 0.0195830315 /
-C
- IF ( K .GT. I1 ) GO TO 3
- S = UNI(0)
- T = UNI(0)
- B = AINT ( 7.0*(S+T) + 37.0*ABS(S-T) )
- X = UNI(0) - UNI(1)
- RNORTH = 0.0625 * ( X + SIGN (B,X) )
- RETURN
- 3 IF ( K .GT. I2 ) GO TO 5
- 4 RNORTH = 2.75 * VNI(0)
- J = 16.0 * ABS (RNORTH) + 1.0
- IF ( J - 14 ) 6, 6, 7
- 6 P = (J+J-1) * .1497466E-2
- GO TO 8
- 7 P = (89-J-J) * .698817E-3
- 8 IF ( UNI(0) .GT. 79.78846 * (EXP (-0.5 * RNORTH * RNORTH)
- 1 - C(J) - P * ( J - 16.0*ABS(RNORTH) ) ) ) GO TO 4
- RETURN
- 5 V = VNI(0)
- IF ( V .EQ. 0.0 ) GO TO 5
- X = SQRT ( 7.5625 - 2.0*LOG(ABS(V)) )
- IF ( UNI(0)*X .GT. 2.75 ) GO TO 5
- RNORTH = SIGN ( X, V )
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/v/rnorthvx.F b/src/mathlib/gen/v/rnorthvx.F
deleted file mode 100644
index 7232548..0000000
--- a/src/mathlib/gen/v/rnorthvx.F
+++ /dev/null
@@ -1,67 +0,0 @@
-*
-* $Id: rnorthvx.F,v 1.1.1.1 1996/04/01 15:02:53 mclareni Exp $
-*
-* $Log: rnorthvx.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:53 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_VAX)
- REAL*4 FUNCTION RNORTH(K)
-C
-C RNOR TOOTH FUNCTION
-C
- IMPLICIT NONE
-C
- INTEGER*4 K
-C
- REAL*4 C (45)
-C
- DATA C/'2B5F407D'X, '2B5F407D'X, 'A9AD407A'X, 'A6484075'X,
- 1 '24964073'X, '2131406E'X, '9C1A4066'X, '98B54061'X,
- 2 '139E405A'X, '8E874052'X, '87BE4048'X, '02A64041'X,
- 3 'FBDD4036'X, 'F513402C'X, 'EE4A4022'X, 'E7804018'X,
- 4 '62694011'X, '5BA04007'X, 'A9AC3FFA'X, '9C1A3FE6'X,
- 5 '91EC3FD7'X, '84583FC3'X, '7A2A3FB4'X, '6FFC3FA5'X,
- 6 '65CE3F96'X, '5BA03F87'X, 'A2E43F70'X, '95503F5C'X,
- 7 '80F43F3E'X, '73603F2A'X, '65CC3F16'X, '58383F02'X,
- 8 'A2E03EF0'X, '87B83EC8'X, '7A283EB4'X, '6C983EA0'X,
- 9 '5F003E8C'X, 'A2E43E70'X, '87BE3E48'X, '6C983E20'X,
- 1 'A2E43DF0'X, 'A2E43DF0'X, '6C983DA0'X, '6C983DA0'X,
- 2 '6C983DA0'X/
-C
- INTEGER*4 I1 /'FBC35400'X/
- INTEGER*4 I2 /'FE79702E'X/
-C
- REAL*4 S, T, B, X, P, V
- INTEGER*4 J
-C
- REAL*4 VNI, UNI
- EXTERNAL VNI, UNI
-C
- IF (K .GT. I1) GOTO 3
- S = UNI (0)
- T = UNI (0)
- B = AINT (7. * (S + T) + 37. * ABS (S - T))
- X = UNI (0) - UNI (0)
- RNORTH = .0625 * (X + SIGN (B,X))
- RETURN
- 3 IF (K .GT. I2) GOTO 5
- 4 RNORTH = 2.75 * VNI (0)
- J = 16. * ABS (RNORTH) + 1.
- IF (J - 14) 6,6,7
- 6 P = (J + J - 1) * .1497466E-2
- GOTO 8
- 7 P= (89 - J - J) * .698817E-3
- 8 IF (UNI (0) .GT. 79.78846 * (EXP (-.5 * RNORTH * RNORTH)
- 1 -C (J) - P * (J - 16. * ABS (RNORTH)))) GOTO 4
- RETURN
- 5 V = VNI (0)
- IF (V .EQ. 0) GOTO 5
- X = SQRT (7.5625 - 2. * LOG (ABS (V)))
- IF (UNI (0) * X .GT. 2.75) GOTO 5
- RNORTH = SIGN (X, V)
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/v/rnpssn.F b/src/mathlib/gen/v/rnpssn.F
deleted file mode 100644
index 78c1c6e..0000000
--- a/src/mathlib/gen/v/rnpssn.F
+++ /dev/null
@@ -1,56 +0,0 @@
-*
-* $Id: rnpssn.F,v 1.2 2005/04/19 08:34:14 mclareni Exp $
-*
-* $Log: rnpssn.F,v $
-* Revision 1.2 2005/04/19 08:34:14 mclareni
-* Protection against possible invalid negative number submitted by Piotr Niezurawski
-*
-* Revision 1.1.1.1 1996/04/01 15:02:56 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE RNPSSN(AMU,N,IERR)
- EXTERNAL RANLUX
-
- SAVE EMU,AMU0,AMAX
-
- DATA AMU0 /-12345.67/, AMAX /88/
- PARAMETER (AMXA = 88)
-
- IERR=0
- IF(AMU .LE. 0) THEN
- IERR=1
- J=0
- ELSEIF(AMU .GT. AMAX) THEN
- CALL RNORMX(R,1,RANLUX)
- J=R*SQRT(AMU)+AMU+0.5
- ELSE
- IF(AMU .NE. AMU0) THEN
- AMU0=AMU
- EMU=EXP(-AMU)
- ENDIF
- P=1
- J=-1
- 1 J=J+1
- CALL RANLUX(R,1)
- P=P*R
- IF(P .GT. EMU) GO TO 1
- ENDIF
-* PN
- IF (J.LT.0) THEN
- PRINT *,' RNPSSN: Warning: J<0; J=',J
- PRINT *,' Correction: J=0'
- PRINT *,' Increase AMAX value!'
- J=0
- ENDIF
-* PN
- N=J
- RETURN
-
- ENTRY RNPSET(AMX)
- AMAX=MIN(AMX,AMXA)
- WRITE(6,'(/7X,''+++++ CERN V136 RNPSSN : SWITCH TO '',
- 1 ''NORMAL APPROXIMATION FOR AMU > '',F7.2/)') AMAX
- RETURN
- END
diff --git a/src/mathlib/gen/v/rvnspc.F b/src/mathlib/gen/v/rvnspc.F
deleted file mode 100644
index 0ac6175..0000000
--- a/src/mathlib/gen/v/rvnspc.F
+++ /dev/null
@@ -1,130 +0,0 @@
-*
-* $Id: rvnspc.F,v 1.1.1.1 1996/04/01 15:02:58 mclareni Exp $
-*
-* $Log: rvnspc.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:58 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- FUNCTION RVNSPC(R,RHO,D)
-
- DIMENSION AZ(4),BZ(4),PZ(4),QZ(4)
-
- PARAMETER (Z1 = 1)
- PARAMETER (C1 = 4*Z1/3, C2 = 2*Z1/3, C3 = 4*Z1/9, C4 = Z1/3)
- PARAMETER (PI = 3.14159 265D0, CL = 1.38629 436D0)
- PARAMETER (SF = 4*PI/3, SFH = 2*PI/3, C0 = 2*PI/3-8*Z1/9)
- PARAMETER (PIH = PI/2, Z10 = 10, HF = Z1/2, CA = Z10**(-4))
-
- DATA AZ
- 1/1.45133 8556D-2, 3.74253 9571D-2, 3.58998 0090D-2,
- 2 9.66633 8350D-2/
- DATA BZ
- 1/4.41839 8230D-3, 3.32852 1016D-2, 6.88029 5505D-2,
- 2 1.24985 9468D-1/
- DATA PZ
- 1/1.73631 4854D-2, 4.75740 4429D-2, 6.26076 1942D-2,
- 2 4.43251 5145D-1/
- DATA QZ
- 1/5.26378 9328D-3, 4.06946 8414D-2, 9.20010 9374D-2,
- 2 2.49983 6641D-1/
-
- RS=ABS(R)
- RC=ABS(RHO)
- DA=ABS(D)
- DR=RS-RC
- RS2=RS**2
- RS3=RS*RS2
- IF(RC .EQ. 0 .OR. RS .EQ. 0 .OR. DA .GE. RS+RC) THEN
- V=0
- ELSEIF(DR .LE. DA .AND. DA .LE. -DR) THEN
- V=SF*RS3
- ELSEIF(DA .EQ. RC .AND. RS .EQ. 2*DA) THEN
- V=C0*RS3
- ELSEIF(DA .EQ. 0) THEN
- V=RS3
- IF(RS .GT. RC) V=V-SQRT(RS2-RC**2)**3
- V=SF*V
- ELSE
- BP=DA+RC
- BM=DA-RC
- BP2=BP**2
- A=MAX(RS2,BP2)
- B=MIN(RS2,BP2)
- C=BM**2
- AB=A-B
- AC=A-C
- BC=B-C
- S=BP*BM
- IF(DA .NE. DR) THEN
- Y=AB/AC
- YL=LOG(Y)
- PA=AZ(1)
- PB=BZ(1)
- DO 1 I = 2,4
- PA=PA*Y+AZ(I)
- 1 PB=PB*Y+BZ(I)
- HK=CL+PA*Y-YL*(HF+PB*Y)
- PA=PZ(1)
- PB=QZ(1)
- DO 2 I = 2,4
- PA=PA*Y+PZ(I)
- 2 PB=PB*Y+QZ(I)
- HE=1+(PA-YL*PB)*Y
- IF(C .NE. 0) THEN
- YKP=SQRT(AB/AC)
- EE=YKP
- AM0=1
- PP=B/C
- IF(PP .GT. 0) THEN
- CC=1
- PP=SQRT(PP)
- DD=1/PP
- ELSE
- GG=1-PP
- FF=YKP**2-PP
- PP=SQRT(FF/GG)
- DD=-BC/(AC*GG*PP)
- CC=0
- ENDIF
- 3 FF=CC
- CC=DD/PP+CC
- GG=EE/PP
- DD=2*(FF*GG+DD)
- PP=GG+PP
- GG=AM0
- AM0=YKP+AM0
- IF(ABS(GG-YKP) .GT. CA*GG) THEN
- YKP=2*SQRT(EE)
- EE=YKP*AM0
- GO TO 3
- ENDIF
- H3=PIH*(CC*AM0+DD)/(AM0*(AM0+PP))
- ENDIF
- ENDIF
- IF(DA .LT. DR) THEN
- IF(C .EQ. 0) THEN
- V=SFH*RS3+C3*SQRT(A)*(AB*HK-2*(A+AB)*HE)
- ELSE
- V=C1*(H3*A**2*S/C-HK*(A*S-C4*AB*AC)-HE*AC*(S+C2*(AB+AC)))/
- 1 SQRT(AC)
- IF(RC .GT. DA) V=V+SF*RS3
- ENDIF
- ELSEIF(DA .EQ. DR) THEN
- V=C1*(RS3*ATAN2(2*SQRT(DA*RC),BM)-SQRT(AC)*(S+C2*AC))
- ELSE
- IF(C .EQ. 0) THEN
- V=SFH*RS3+C3*(AB*(B-2*AB)*HK+2*A*(AB-B)*HE)/SQRT(A)
- ELSE
- V=C1*(H3*B**2*S/C+HK*(S*(AB-B)+C4*AB*(BC-2*AB))
- 1 -HE*AC*(S-C2*(AB-BC)))/SQRT(AC)
- IF(RC .GT. DA) V=V+SF*RS3
- ENDIF
- ENDIF
- ENDIF
- RVNSPC=V
- RETURN
- END
-#endif
diff --git a/src/mathlib/gen/v/rvnspc64.F b/src/mathlib/gen/v/rvnspc64.F
deleted file mode 100644
index 52a006e..0000000
--- a/src/mathlib/gen/v/rvnspc64.F
+++ /dev/null
@@ -1,113 +0,0 @@
-*
-* $Id: rvnspc64.F,v 1.1.1.1 1996/04/01 15:02:58 mclareni Exp $
-*
-* $Log: rvnspc64.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:58 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-#if defined(CERNLIB_DOUBLE)
- FUNCTION DVNSPC(R,RHO,D)
-C
-#include "gen/imp64.inc"
-C
- CHARACTER*(*) NAME
- PARAMETER(NAME='DVNSPC')
-#endif
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION RVNSPC(R,RHO,D)
-C
- CHARACTER*(*) NAME
- PARAMETER(NAME='RVNSPC')
-#endif
-C
-C Based on
-C F. LAMARCHE and C. LEROY, Evaluation of the volume of
-C a sphere with a cylinder by elliptic integrals,
-C Computer Phys. Comm. 59 (1990) 359-369
-C
- PARAMETER (Z1 = 1)
- PARAMETER (C1 = 4*Z1/3, C2 = 2*Z1/3, C3 = 4*Z1/9, C4 = Z1/3)
- PARAMETER (PI = 3.14159 26535 89793 24D0)
- PARAMETER (SF = 4*PI/3, SFH = 2*PI/3, C0 = 2*PI/3-8*Z1/9)
-
- RS=ABS(R)
- RC=ABS(RHO)
- DA=ABS(D)
- DR=RS-RC
- RS2=RS**2
- RS3=RS2*RS
- IF(RC .EQ. 0 .OR. RS .EQ. 0 .OR. DA .GE. RS+RC) THEN
- V=0
- ELSEIF(DR .LE. DA .AND. DA .LE. -DR) THEN
- V=SF*RS3
- ELSEIF(DA .EQ. RC .AND. RS .EQ. 2*DA) THEN
- V=C0*RS3
- ELSEIF(DA .EQ. 0) THEN
- V=RS3
- IF(RS .GT. RC) V=V-SQRT(RS2-RC**2)**3
- V=SF*V
- ELSE
- BP=DA+RC
- BM=DA-RC
- BP2=BP**2
- A=MAX(RS2,BP2)
- B=MIN(RS2,BP2)
- C=BM**2
- AB=A-B
- AC=A-C
- BC=B-C
- S=BP*BM
- XK2=BC/AC
- XK=SQRT(XK2)
- IF(DA .LT. DR) THEN
- IF(C .EQ. 0) THEN
-#if defined(CERNLIB_DOUBLE)
- V=SFH*RS3+C3*SQRT(A)*(AB*DELIKC(XK)-2*(A+AB)*DELIEC(XK))
- ELSE
- V=C1*(DELI3C(SQRT(1-XK2),XK2,B/C)*A**2*S/C
- 1 -DELIKC(XK)*(A*S-C4*AB*AC)
- 2 -DELIEC(XK)*AC*(S+C2*(AB+AC)))/SQRT(AC)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- V=SFH*RS3+C3*SQRT(A)*(AB*RELIKC(XK)-2*(A+AB)*RELIEC(XK))
- ELSE
- V=C1*(RELI3C(SQRT(1-XK2),XK2,B/C)*A**2*S/C
- 1 -RELIKC(XK)*(A*S-C4*AB*AC)
- 2 -RELIEC(XK)*AC*(S+C2*(AB+AC)))/SQRT(AC)
-#endif
- IF(RC .GT. DA) V=V+SF*RS3
- ENDIF
- ELSEIF(DA .EQ. DR) THEN
- V=C1*(RS3*ATAN2(2*SQRT(DA*RC),BM)-SQRT(AC)*(S+C2*AC))
- ELSE
- IF(C .EQ. 0) THEN
-#if defined(CERNLIB_DOUBLE)
- V=SFH*RS3+C3*(AB*(B-2*AB)*DELIKC(XK)+2*A*(AB-B)*DELIEC(XK))/
- 1 SQRT(A)
- ELSE
- V=C1*(DELI3C(SQRT(1-XK2),XK2,B/C)*B**2*S/C
- 1 +DELIKC(XK)*(S*(AB-B)+C4*AB*(BC-2*AB))
- 2 -DELIEC(XK)*AC*(S-C2*(AB-BC)))/SQRT(AC)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- V=SFH*RS3+C3*(AB*(B-2*AB)*RELIKC(XK)+2*A*(AB-B)*RELIEC(XK))/
- 1 SQRT(A)
- ELSE
- V=C1*(RELI3C(SQRT(1-XK2),XK2,B/C)*B**2*S/C
- 1 +RELIKC(XK)*(S*(AB-B)+C4*AB*(BC-2*AB))
- 2 -RELIEC(XK)*AC*(S-C2*(AB-BC)))/SQRT(AC)
-#endif
- IF(RC .GT. DA) V=V+SF*RS3
- ENDIF
- ENDIF
- ENDIF
-#if defined(CERNLIB_DOUBLE)
- DVNSPC=V
-#endif
-#if !defined(CERNLIB_DOUBLE)
- RVNSPC=V
-#endif
- RETURN
- END
diff --git a/src/mathlib/gen/v/trevni.F b/src/mathlib/gen/v/trevni.F
deleted file mode 100644
index e3c3bde..0000000
--- a/src/mathlib/gen/v/trevni.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: trevni.F,v 1.1.1.1 1996/04/01 15:02:57 mclareni Exp $
-*
-* $Log: trevni.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:57 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE TREVNI(FROM, LENGTH, TO, MAX, NEWLNG)
-C
-C *INVERT* PUTS INTO 'TO' ALL NUMBERS 1 ... MAX WHICH ARE NOT
-C CONTAINED IN 'FROM(1)' ... 'FROM(LENGTH)'. 'NEWLNG' SPECIFIES THE
-C NUMBER OF ELEMENTS IN 'TO'.
-C (NEWLNG = MAX - LENGTH)
-C
- INTEGER FROM(1), TO(1)
- NEW = 0
- DO 1 I = 1,MAX
- DO 2 J = 1,LENGTH
- IF(FROM(J) .EQ. I) GO TO 1
-2 CONTINUE
- NEW = NEW + 1
- TO(NEW) = I
-1 CONTINUE
- NEWLNG = NEW
- RETURN
- END
diff --git a/src/mathlib/gen/v/tup.F b/src/mathlib/gen/v/tup.F
deleted file mode 100644
index 785fed6..0000000
--- a/src/mathlib/gen/v/tup.F
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: tup.F,v 1.1.1.1 1996/04/01 15:02:57 mclareni Exp $
-*
-* $Log: tup.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:57 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE TUP(MEM, IPOS, K)
- DIMENSION MEM(1)
- COMMON /BITSXB/ NBITPW, NBYTPW
-C
-C *TUP* STORES THE VALUE K INTO THE IPOS-TH GROUP OF 8 BITS OF
-C THE VECTOR MEM.
-C TUP IS NEEDED ONLY BECAUSE SBYT OPERATES ON SINGLE WORDS RATHER THAN
-C ON SINGLE WORDS.
-C
- LW=(IPOS+NBYTPW-1)/NBYTPW
- LX=8*(IPOS-NBYTPW*(LW-1))-7
- CALL SBYT(K,MEM(LW),LX,8)
- RETURN
- END
diff --git a/src/mathlib/gen/v/v107ri.inc b/src/mathlib/gen/v/v107ri.inc
deleted file mode 100644
index c568f4e..0000000
--- a/src/mathlib/gen/v/v107ri.inc
+++ /dev/null
@@ -1,36 +0,0 @@
-*
-* $Id: v107ri.inc,v 1.2 2000/06/08 09:57:21 mclareni Exp $
-*
-* $Log: v107ri.inc,v $
-* Revision 1.2 2000/06/08 09:57:21 mclareni
-* Add support for Linux
-*
-* Revision 1.1.1.1 1996/04/01 15:02:54 mclareni
-* Mathlib gen
-*
-*
-*
-* v107ri.inc
-*
-#if defined(CERNLIB_LNX)||defined(CERNLIB_ALLIANT)||defined(CERNLIB_DECS)||defined(CERNLIB_HPUX)||defined(CERNLIB_IBMRT)||defined(CERNLIB_SGI)||defined(CERNLIB_SUN)
- MR0 = IEOR (ISHFT(MCGX,-15), MCGX)
- MR1 = ISHFT (MR0, 17)
- MCGX = IEOR (MR0, MR1)
- MCGN = 69069 * MCGN
- IRNDM2 = ISHFT (IEOR(MCGN,MCGX), -1)
-
-#elif defined(CERNLIB_APOLLO)
- MR0 = XOR (RSHFT(MCGX,+15), MCGX)
- MR1 = LSHFT (MR0, 17)
- MCGX = XOR (MR0, MR1)
- MCGN = 69069 * MCGN
- IRNDM2 = RSHFT (XOR(MCGN,MCGX), +1)
-
-#elif 1
- MR0 = IOR (ISHFT(MCGX,-15), MCGX)
- MR1 = ISHFT (MR0, 17)
- MCGX = IOR (MR0, MR1)
- MCGN = 69069 * MCGN
- IRNDM2 = ISHFT (IOR(MCGN,MCGX), -1)
-
-#endif
diff --git a/src/mathlib/gen/v/v107rn.inc b/src/mathlib/gen/v/v107rn.inc
deleted file mode 100644
index 40ba56a..0000000
--- a/src/mathlib/gen/v/v107rn.inc
+++ /dev/null
@@ -1,37 +0,0 @@
-*
-* $Id: v107rn.inc,v 1.2 2000/06/08 09:57:21 mclareni Exp $
-*
-* $Log: v107rn.inc,v $
-* Revision 1.2 2000/06/08 09:57:21 mclareni
-* Add support for Linux
-*
-* Revision 1.1.1.1 1996/04/01 15:02:54 mclareni
-* Mathlib gen
-*
-*
-*
-* v107rn.inc
-*
-
-#if defined(CERNLIB_LNX)||defined(CERNLIB_ALLIANT)||defined(CERNLIB_CONVEX)||defined(CERNLIB_DECS)||defined(CERNLIB_HPUX)||defined(CERNLIB_IBMRT)||defined(CERNLIB_SGI)||defined(CERNLIB_SUN)
- MR0 = IEOR (ISHFT(MCGX,-15), MCGX)
- MR1 = ISHFT (MR0, 17)
- MCGX = IEOR (MR0, MR1)
- MCGN = 69069 * MCGN
- MANT = ISHFT (IEOR(MCGX,MCGN), -8)
-
-#elif defined(CERNLIB_APOLLO)
- MR0 = XOR (RSHFT(MCGX,+15), MCGX)
- MR1 = LSHFT (MR0, 17)
- MCGX = XOR (MR0, MR1)
- MCGN = 69069 * MCGN
- MANT = RSHFT (XOR(MCGX,MCGN), +8)
-
-#elif 1
- MR0 = IOR (ISHFT(MCGX,-15), MCGX)
- MR1 = ISHFT (MR0, 17)
- MCGX = IOR (MR0, MR1)
- MCGN = 69069 * MCGN
- MANT = ISHFT (IOR(MCGX,MCGN), -8)
-
-#endif
diff --git a/src/mathlib/gen/v/v107z0.inc b/src/mathlib/gen/v/v107z0.inc
deleted file mode 100644
index 7365d23..0000000
--- a/src/mathlib/gen/v/v107z0.inc
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: v107z0.inc,v 1.4 2006/09/15 09:34:56 mclareni Exp $
-*
-* $Log: v107z0.inc,v $
-* Revision 1.4 2006/09/15 09:34:56 mclareni
-* Submitted mods for gcc4/gfortran and MacOSX, corrected to work also on slc4 with gcc3.4 and 4.1
-*
-* Revision 1.3 2000/06/08 09:57:22 mclareni
-* Add support for Linux
-*
-* Revision 1.2 1996/04/02 22:53:48 thakulin
-* Add support for Apogee and EPC Fortran compilers.
-*
-* Revision 1.1.1.1 1996/04/01 15:02:54 mclareni
-* Mathlib gen
-*
-*
-*
-* v107z0.inc
-*
-
-#if defined(CERNLIB_LNX)||defined(CERNLIB_ALLIANT)||defined(CERNLIB_DECS)||defined(CERNLIB_MACMPW)||defined(CERNLIB_SGI)
-#if !defined(CERNLIB_GFORTRAN)
- DATA IZ0/'33000000'X/
-#else
- DATA IZ0/X'33000000'/
-#endif
-
-#elif defined(CERNLIB_APOLLO)
- DATA IZ0/16#33000000/
-
-#elif defined(CERNLIB_IBMRT)||defined(CERNLIB_IBMAIX)
- DATA IZ0/Z33000000/
-
-#elif (defined(CERNLIB_CONVEX)||defined(CERNLIB_HPUX)||defined(CERNLIB_SUN))&&!(defined(CERNLIB_F90)||defined(CERNLIB_QFEPC))
- DATA IZ0/X'33000000'/
-
-#elif 1
- DATA IZ0/Z'33000000'/
-
-#endif
diff --git a/src/mathlib/gen/x/Imakefile b/src/mathlib/gen/x/Imakefile
deleted file mode 100644
index 7f314f4..0000000
--- a/src/mathlib/gen/x/Imakefile
+++ /dev/null
@@ -1,9 +0,0 @@
-SRCS_F= erprip.F pripar.F strag.F vomas.F
-
-FORTRANSAVEOPTION = FortranSaveFlags
-
-#if defined(CERNLIB_SGI)
-IMAKE_DEFINES=-DFortranDoesCpp=NO
-#endif
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/mathlib/gen/x/erprip.F b/src/mathlib/gen/x/erprip.F
deleted file mode 100644
index f7c265e..0000000
--- a/src/mathlib/gen/x/erprip.F
+++ /dev/null
@@ -1,39 +0,0 @@
-*
-* $Id: erprip.F,v 1.1.1.1 1996/04/01 15:02:58 mclareni Exp $
-*
-* $Log: erprip.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:58 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE ERPRIP(GA1,GA2,GA12,GB)
- DIMENSION GA1(9),GA2(9),GB(9),GA12(9)
- COMMON /SLATE/XQX(9), V(4), G1(9), G2(9), G(9)
- CALL MXMPY (G1, GA1,G,3,3,3)
- CALL MXMPY1 (G,G1,GB,3,3,3)
- CALL MXMPY (G2,GA2,G,3,3,3)
- CALL MXMAD1 (G,G2,GB,3,3,3)
- IF(GA12(1).EQ.0.) GOTO 1
- CALL MXMPY(G1,GA12,G,3,3,3)
- CALL MXMAD1(G,G2,GB,3,3,3)
- CALL MXMPY1(G2,GA12,G,3,3,3)
- CALL MXMAD1(G,G1,GB,3,3,3)
- 1 G(3)=-1./V(4)**3
- G(1)=V(1)*G(3)
- G(2)=V(2)*G(3)
- G(3)=V(3)*G(3)
- G(8)=V(1)**2+V(2)**2
- G(6)=1./(V(4)**2*SQRT(G(8)))
- G(5)=-G(6)*V(3)
- G(4)=V(1)*G(5)
- G(5)=V(2)*G(5)
- G(6)=G(8)*G(6)
- G(8)=1./G(8)
- G(7)=-V(2)*G(8)
- G(8)=V(1)*G(8)
- G(9)=0.
- CALL MXMPY (G,GB,G1,3,3,3)
- CALL MXMPY1(G1,G,GB,3,3,3)
- RETURN
- END
diff --git a/src/mathlib/gen/x/pripar.F b/src/mathlib/gen/x/pripar.F
deleted file mode 100644
index 0d8ff4c..0000000
--- a/src/mathlib/gen/x/pripar.F
+++ /dev/null
@@ -1,46 +0,0 @@
-*
-* $Id: pripar.F,v 1.1.1.1 1996/04/01 15:02:58 mclareni Exp $
-*
-* $Log: pripar.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:58 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- SUBROUTINE PRIPAR (A1,A2,B)
- COMMON /SLATE/XQX(9), V(4), G1(9), G2(9), G(9)
- DIMENSION A1(3),A2(3),B(3)
- CALL UCOPY (A1,G,3)
- V(3)=0.
- I= 0
- 1 CONTINUE
- GINV= 1./G(1)
- G2(7)=SIN(G(2))
- G2(8)=COS(G(2))
- G2(2)=COS (G(3))
- G2(5)= SIN(G(3))
- G2(3)=-G2(8)*G2(5)
- G2(6)=G2(8)*G2(2)
- G2(2)=-G2(7)*G2(2)
- G2(5)=-G2(7)*G2(5)
- G2(1)=-G2(6)*GINV
- G2(4)= G2(3)*GINV
- G2(7)=-G2(7)*GINV
- G2(9)=0.
- V(3)=V(3)-G2(7)
- CALL VSCALE (G2,GINV,G2,9)
- IF (I.EQ.2) GO TO 5
- CALL UCOPY (G2,G1,9)
- CALL UCOPY (A2,G,3)
- I= 2
- GO TO 1
- 5 V(1)=G1(6)+G2(6)
- V(2)=-G1(3)-G2(3)
- B(1)= V(1)**2+V(2)**2
- B(2)=ATAN(V(3)/SQRT(B(1)))
- V(4)=SQRT(V(3)**2+ B(1))
- B(3)= ATAN2(V(2),V(1))
- IF(B(3).LT.0.) B(3)=B(3)+6.28318
- B(1)=1./V(4)
- RETURN
- END
diff --git a/src/mathlib/gen/x/strag.F b/src/mathlib/gen/x/strag.F
deleted file mode 100644
index d6c2853..0000000
--- a/src/mathlib/gen/x/strag.F
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: strag.F,v 1.1.1.1 1996/04/01 15:02:58 mclareni Exp $
-*
-* $Log: strag.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:58 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- FUNCTION STRAG(PINV,EM)
- DIMENSION ENT(15),TAB(15)
- DATA ENT/.0,.001,.00189,.00355,.00675,.0128,.0282,.0460,.0875,.16
- + 5,.312,.593,1.012,5.,100000./
- DATA TAB/.1,.01573,.01445,.0134,.0124,.0117,.0112,.0107,.0102,.00
- + 97,.0092,.0087,.0082,0.,0./
- BI =SQRT(1.+1./(PINV*EM)**2)-1.
- DO 1 I=2,15
- IF(ENT(I).GT.BI) GO TO 2
- 1 CONTINUE
- 2 A=(BI-ENT(I-1))*(TAB(I)-TAB(I-1))/(ENT(I)-ENT(I-1))+TAB(I-1)
- STRAG=SQRT(.938213/EM)*A
- RETURN
- END
diff --git a/src/mathlib/gen/x/vomas.F b/src/mathlib/gen/x/vomas.F
deleted file mode 100644
index c4d0e38..0000000
--- a/src/mathlib/gen/x/vomas.F
+++ /dev/null
@@ -1,50 +0,0 @@
-*
-* $Id: vomas.F,v 1.1.1.1 1996/04/01 15:02:58 mclareni Exp $
-*
-* $Log: vomas.F,v $
-* Revision 1.1.1.1 1996/04/01 15:02:58 mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
- INTEGER FUNCTION VOMAS(IP)
- DIMENSION VMASS(21)
- EQUIVALENCE (IPC,APC)
- EQUIVALENCE(MPC,BPC)
-C-- , NOUGHT , GAMMA , NU , ELECTRON ,
-C-- , MU , PI0 , PI+- , K+- , K0 , PROTON ,
-C-- , NEUTRON , LAMBDA , SIGMA+ , SIGMA0 , SIGMA- , XI0 ,
-C-- , XI- , DEUTERON , TRITON , HE3++ , HE4++ , =
- DATA VMASS/ 0. ,.1E-10 ,.1E-9 ,.000511006,
- + .105659 ,.13501 ,.13960 ,.4938 ,.4980 ,.938256 ,
- + .939550 ,1.11540 ,1.18941 ,1.1923 ,1.19708 ,1.3143 ,
- + 1.3208 ,1.87549 ,2.80879 ,2.80824 ,3.72718/
- IPC=IP
- IF (IPC.LE.0) GO TO 15
- IF (IPC.GT.4096) GO TO 15
- IPC=MOD(IPC,64)
- IF (IPC.EQ.0) GO TO 15
- IF (IPC.GT.49) GO TO 15
- IF (IPC.LE.21) GO TO 20
- IF (IPC.GE.42) GO TO 20
-C-- RETURN UNCHANGED IF NOT AN INTEGER IN RANGE
- 15 VOMAS=IP
- RETURN
- 20 MPC=MOD(IPC,32)
- APC=32-IPC
- APC=SIGN(VMASS(MPC),APC)
- VOMAS=IPC
- RETURN
-#if (defined(CERNLIB_CDC))&&(defined(CERNLIB_F4))
- ENTRY IOFMAS
-#endif
-#if !defined(CERNLIB_CDC)||!defined(CERNLIB_F4)
- ENTRY IOFMAS(IP)
-#endif
-C ENTRY IOFMAS (IP)
- IPC=IP
- MPC=IUCOMP(ABS(APC),VMASS,21)
- IF(APC.LT.0.) MPC=MPC+32
- VOMAS=MPC
- RETURN
- END
diff --git a/src/mathlib/lapack/Imakefile b/src/mathlib/lapack/Imakefile
deleted file mode 100644
index 8226794..0000000
--- a/src/mathlib/lapack/Imakefile
+++ /dev/null
@@ -1,62 +0,0 @@
-
-/*
- * lapack is distributed as object files only.
- *
- */
-
-LIBNAME=LibraryTargetName($(LIBRARY))
-
-install.include:
-
-#if defined(CERNLIB_UNIX)
-
-archive/stamp:
- @[ ! -d archive ] && mkdir archive || true
- @touch $@
-
-ifneq ($(strip $(LAPACKDIR)),)
-
-libaddobjects:
- @echo "adding objects from lapack/src"
- (cd $(LAPACKDIR)/SRC;$(AR) $(LIBPATH)/$(LIBNAME) *.o)
- @echo "adding objects from lapack/blas/src"
- (cd $(LAPACKDIR)/BLAS/SRC;$(AR) $(LIBPATH)/$(LIBNAME) *.o)
-
-archive/objects.list debug/objects.list shared/objects.list: Makefile
- @[ ! -d archive ] && mkdir archive || true
- RemoveFile($@)
- (cd $(LAPACKDIR)/SRC;\
- ls *.o | sed -e "s=^.=$(LAPACKDIR)/SRC/&=" ) > $@
- (cd $(LAPACKDIR)/BLAS/SRC;\
- ls *.o | sed -e "s=^.=$(LAPACKDIR)/BLAS/SRC/&=" ) >> $@
-
-else
-
-libaddobjects:
- @echo "You do not have object files for LAPACK"
-
-archive/objects.list debug/objects.list shared/objects.list: Makefile
- @[ ! -d archive ] && mkdir archive || true
- touch $@
- @echo "You do not have object files for LAPACK"
-
-endif
-
-#endif
-
-#if defined(CERNLIB_VAXVMS)
-
-st.amp:
- @ TouchFile($@)
-
-
-libaddobjects:
- @ if f$search("cern\:[lapack]*.obj") .eqs. "" then \ @@\
- write sys$output "CERNLIB-Warning: There are no object files for lapack"@@\
- @ if f$search("cern\:[lapack]*.obj") .nes. "" then \ @@\
- write sys$output "adding archive objects from lapack" @@\
- @ if f$search("cern\:[lapack]*.obj") .nes. "" then \ @@\
- $(AR) $(LIBPATH)$(LIBNAME) cern\:[lapack]*.obj
-
-#endif
-
diff --git a/src/mathlib/mpa/Imakefile b/src/mathlib/mpa/Imakefile
deleted file mode 100644
index 3b20312..0000000
--- a/src/mathlib/mpa/Imakefile
+++ /dev/null
@@ -1,60 +0,0 @@
-
-/*
- * mpa is distributed as object files only.
- *
- */
-
-LIBNAME=LibraryTargetName($(LIBRARY))
-
-install.include:
-
-#if defined(CERNLIB_UNIX)
-
-
-archive/stamp:
- @[ ! -d archive ] && mkdir archive || true
- @touch $@
-
-
-ifneq ($(strip $(MPADIR)),)
-
-libaddobjects:
- @echo "adding archive objects from mpa/archive"
- (cd $(MPADIR)/mpasrc/archive;$(AR) $(LIBPATH)/$(LIBNAME) *.o)
-
-archive/objects.list debug/objects.list shared/objects.list: Makefile
- @[ ! -d archive ] && mkdir archive || true
- RemoveFile($@)
- (cd $(MPADIR)/mpasrc/archive;\
- ls *.o | sed -e "s=^.=$(MPADIR)/mpasrc/archive/&=" ) > $@
-
-else
-
-libaddobjects:
- @echo "There are no object files for mpa"
-
-archive/objects.list debug/objects.list shared/objects.list: Makefile
- @[ ! -d archive ] && mkdir archive || true
- touch $@
- @echo "You do not have object files for mpa"
-
-
-endif
-
-#endif
-
-#if defined(CERNLIB_VAXVMS)
-
-st.amp:
- @ TouchFile($@)
-
-
-libaddobjects:
- @ if f$search("cern\:[mpa]*.obj") .eqs. "" then \ @@\
- write sys$output "CERNLIB_Warning: There are no object files for mpa"@@\
- @ if f$search("cern\:[mpa]*.obj") .nes. "" then \ @@\
- write sys$output "adding archive objects from mpa" @@\
- if f$search("cern\:[mpa]*.obj") .nes. "" then \ @@\
- $(AR) $(LIBPATH)$(LIBNAME) cern\:[mpa]*.obj
-
-#endif
diff --git a/src/p5boot/README b/src/p5boot/README
deleted file mode 100755
index 25173fb..0000000
--- a/src/p5boot/README
+++ /dev/null
@@ -1,22 +0,0 @@
-Building the Nypatchy (Patchy 5) suite using the standard Cernlib build
-procedures or the Patchy CAR files requires an executable of nypatchy or
-ypatchy (Patchy 4). The procedure below can be used to bootstrap
-nypatchy.
-
-Sources for Solaris version of nypatchy, which will probably work on
-most 32-bit systems. The system dependent routines are in kernlib for
-each system.
-
-nypatchy.f Main program for Patchy 5
-p5lib Other source (*.f) files common to all P5 programs.
-
-Then to make nypatchy, assuming the Fortran compiler is g77:
-cd p5lib
-g77 -c libp5/*.f
-ar cr libp5.a *.o
-g77 -o nypatchy nypatchy.f libp5.a $CERN_ROOT/lib/libkernlib.a
-
-The nypatchy executable should then be copied to the bin directory,
-where it might also be necessary to make a link, e.g
-mv nypatchy $CERN_ROOT/bin
-ln -s nypatchy ypatchy
diff --git a/src/p5boot/nypatchy.f b/src/p5boot/nypatchy.f
deleted file mode 100644
index 9193a67..0000000
--- a/src/p5boot/nypatchy.f
+++ /dev/null
@@ -1,49 +0,0 @@
-CDECK ID>, NPATCH.
- PROGRAM NPATCH
-
-
- PARAMETER (NCNAME=32)
- PARAMETER (NFILES=11)
- CHARACTER NAME(NFILES)*(NCNAME)
-
-
- DATA NAME/ 'PAM .car 9 2 0 !ff'
- +, 'FORT .f 9 6 0 !ff'
- +, 'read .cra 1 1 0 !ff'
- +, 'print .lis 2 4 0 !ff'
- +, 'CC .c 9 6 0 !ff'
- +, 'AS .s 9 6 0 !ff'
- +, 'DATA .dat 9 6 0 !ff'
- +, 'FO:2 .f 9 6 0 !ff'
- +, 'CC:2 .c 9 6 0 !ff'
- +, 'AS:2 .s 9 6 0 !ff'
- +, 'DA:2 .dat 9 6 0 !ff' /
-C- _:.=+=.:_1_:.=+=.:_2_:.=+=.:_3_:
-C- (1) (2) (3)
-
-C- (1) LUNUSE = 1 read, 2 print,
-C- 3 option, 4 cch subst, >4 file
-
-C- (2) LUNDES = 1 cradle input
-C- 2 PAM input
-C- 4 printed output
-C- 5 Fortran output
-C- 6 ASM output write-only (T=ATT)
-C- 7 ASM input-output (T=MODIF)
-C- 11 option parameter
-C- 12 control-character substitution parameter
-
-C- (3) LUNFLG = 0/>0 parameter value EOF not/yes allowed
-C- 2 the cradle file need not exist
-
-
-
- CALL MQINIT
-
- CALL FLPARA (NFILES,NAME,
- + 'Nypatchy')
-
- CALL PSTEER
-C! CALL NA_DUMP
-
- END
diff --git a/src/p5boot/p5boot.sh b/src/p5boot/p5boot.sh
deleted file mode 100755
index 51d04b9..0000000
--- a/src/p5boot/p5boot.sh
+++ /dev/null
@@ -1,20 +0,0 @@
-#!/bin/sh
-
-mkdir -p $CERN_ROOT/build/p5boot
-cd $CERN_ROOT/build/p5boot
-cp -p -r $CERN_ROOT/src/p5boot/* .
-
-AR="ar cr"
-
-cd $CERN_ROOT/build/p5boot/p5lib
-$FCOMP -c *.f
-$AR ../p5lib.a *.o
-
-cd $CERN_ROOT/build/p5boot
-
-$FCOMP -o nypatchy nypatchy.f p5lib.a $CERN_ROOT/lib/libkernlib.a
-
-cd $CERN_ROOT/bin
-ln -s $CERN_ROOT/build/p5boot/nypatchy ypatchy
-
-cd $CERN_ROOT/build
diff --git a/src/p5boot/p5lib/acsort.f b/src/p5boot/p5lib/acsort.f
deleted file mode 100644
index 8e57d09..0000000
--- a/src/p5boot/p5lib/acsort.f
+++ /dev/null
@@ -1,104 +0,0 @@
-CDECK ID>, ACSORT.
- SUBROUTINE ACSORT
-
-C- Sort the action banks for current deck, mark clash levels
-C- Called from DODECK when processing of a new deck is started
-
- PARAMETER (KM1=1,KM2=2,KM3=4,KM4=8,KM5=16,KM6=32,KM7=64,KM8=128,
- + KM9=256, KM10=512, KM11=1024, KM12=2048, KM13=4096, KM14=8192,
- + KM15=16384, KM16=32768, KM17=65536, KM18=131072, KM19=262144)
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
-C-------------- End CDE --------------------------------
- DIMENSION MBIAS(12)
-
- IOR (IZV,IZW) = OR (IZV, IZW)
- ISHFTL (IZW,NZB) = LSHIFT (IZW, NZB)
- ISHFTR (IZW,NZB) = ISHFT (IZW, -NZB)
-
- DATA MBIAS / 5, 5, 3, 1, 0, 0, 0, 0, 4, 4, 2, 0 /
-C- DEL REP ADB ADD DEL REP ADB ADD
-C- 0 1 2 3 4 5 6 7 8 9 10 11
-
- IF (LEXD.EQ.0) RETURN
- KACTEX = LEXD-2
- L = LQ(KACTEX)
- IF (L.EQ.0) RETURN
-
- CALL QTOPSY (KACTEX)
-
-C-- Construct new target line numbers: LIIN = 8*LI + bias
-
- L = LQ(KACTEX)
- 24 JACT = JBYT (IQ(L),9,4)
- IQ(L+4) = ISHFTL(IQ(L+4),3) + MBIAS(JACT+1)
- L = LQ(L-1)
- IF (L.NE.0) GO TO 24
-
-C-- Sort the list for starting target line numbers
-
- CALL QSORTI (4,KACTEX)
-
-C------ Scan for clash
-
- LBKF = KACTEX + 1
-
-C-- new first bank
-
- 32 LBKF = LQ(LBKF-1)
- IF (LBKF.EQ.0) GO TO 41
- JACTF = JBYT (IQ(LBKF),9,4)
- IF (JACTF.GE.8) GO TO 32
- LBKN = LQ(LBKF-1)
- IF (LBKN.EQ.0) GO TO 41
- IF (JACTF.LT.2) GO TO 34
-
- IF (IQ(LBKF+4).NE.IQ(LBKN+4)) GO TO 32
- IQ(LBKF) = IOR (IQ(LBKF), KM14)
- IQ(LBKN) = IOR (IQ(LBKN), KM14)
- GO TO 32
-
-C-- and its next banks
-
- 34 JTGFE = ISHFTL (IQ(LBKF+5),3) + 7
-
- 36 IF (IQ(LBKN+4).GT.JTGFE) GO TO 32
-
- JACTN = JBYT (IQ(LBKN),9,4)
- IF (JACTN.GE.8) GO TO 37
-
- IF (IFLMERG.EQ.0) THEN
- MSKF = KM14
- IF (LBKF.GT.LBKN) MSKF= KM15
- MSKN = KM13 + MSKF
- ELSE
- MSKF = KM15
- MSKN = KM15
- ENDIF
-
- IQ(LBKF) = IOR (IQ(LBKF), MSKF)
- IQ(LBKN) = IOR (IQ(LBKN), MSKN)
- 37 LBKN = LQ(LBKN-1)
- IF (LBKN.EQ.0) GO TO 32
- GO TO 36
-
-C------ Reset the line numbers
-
- 41 L = LQ(KACTEX)
- 44 IQ(L+4) = ISHFTR(IQ(L+4),3)
- L = LQ(L-1)
- IF (L.NE.0) GO TO 44
- RETURN
- END
diff --git a/src/p5boot/p5lib/arrin.f b/src/p5boot/p5lib/arrin.f
deleted file mode 100644
index 89cc85a..0000000
--- a/src/p5boot/p5lib/arrin.f
+++ /dev/null
@@ -1,184 +0,0 @@
-CDECK ID>, ARRIN.
- SUBROUTINE ARRIN
-
-C- Read / reposition current input file, using the C library,
-C- according to IN_DOX:
-C- = -1 close, 0 rewind, 1 reposition, 2 read
-C. started 10-feb-92
-
- COMMON /QUNIT/ IQREAD,IQPRNT, IQTTIN,IQTYPE, IQOFFL,IQRTTY,IQRSAV
- +, IQRFD,IQRRD,IQRSIZ, NQLPAT,NQUSED,NQLLBL, NQINIT
- COMMON /MQCM/ NQSYSS,NQLINK, LQCSTA(3),LQCEND(3), NQMAX
- +, LQLSTA(5),LQLEND(5), LQADR,LQADR0,NQOFFS
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
- COMMON /ARRCOM/IN_LUN, IN_FD, IN_FIO, IN_EOF
- +, IN_DOX, IN_DO1, IN_DO2
-C-------------- End CDE --------------------------------
-
- IOR (IZV,IZW) = OR (IZV, IZW)
-
-
- IN_FD = IQ(LARRV+2)
- IF (IN_DOX.LT.2) GO TO 61
-
-C---- Read
-
- JSLGO = IQ(LQHOLD+1)
- JSLNEW = LQLEND(2)
-
- JSLA = LQLEND(2)
- NSLN = IN_DO1
- NTXN = IN_DO2
- JTXA = MLIAD(JSLA)
-
- CALL CIGET (IN_FD,TEXT(JTXA),NTXN,NTXR,IN_EOF)
-
- IF (IN_EOF.NE.0) GO TO 41
-
-C-- reading successful, get the current file position
-
- CALL CITELL (IN_FD,NCHPOS,ISTAT)
-
- IF (ISTAT.NE.0) CALL P_KILLM ('CIO tell fails')
-
-C-- construct the line directory
-
- JTXE = JTXA + NTXR
- JSLE = JSLA
- LIMIT = JSLA + NSLN
-
- DO 26 JTXU=JTXA,JTXE-1
- IF (ICHAR(TEXT(JTXU)) .EQ. NEWLN) THEN
- JSLE = JSLE + 1
- MLIAD(JSLE) = JTXU + 1
- IF (JSLE.GT.LIMIT) GO TO 31
- ENDIF
- 26 CONTINUE
- IF (NTXR.EQ.NTXN) GO TO 31
-
-C-- file complete, make sure terminating NEWLINE present
-
- IF (MLIAD(JSLE).EQ.JTXE) GO TO 34
- TEXT(JTXE) = CHAR(NEWLN)
- JTXE = JTXE + 1
- JSLE = JSLE + 1
- MLIAD(JSLE) = JTXE
- NCHPOS = NCHPOS + 1
- GO TO 34
-
-C---- file too big, reposition to complete line
-
- 31 JTXU = MLIAD(JSLE)
- N = JTXE - JTXU
- IF (N.EQ.0) GO TO 34
-
- NCHPOS = NCHPOS - N
- CALL CISEEK (IN_FD,NCHPOS,ISTAT)
-
- IF (ISTAT.NE.0) CALL P_KILLM ('CIO seek fails')
-
-C-- is the end of the file in memory ?
-
- 34 NSIZE = IQ(LARRV+6)
- IF (NSIZE.GT.0) THEN
- IF (NCHPOS.GE.NSIZE) IN_EOF= 1
- ENDIF
-
-C-- if IQRRD lines have been read already by FLPARA
-
- IF (IQRRD.NE.0) THEN
- JSLGO = JSLGO + IQRRD
- JSLNEW = MAX (JSLGO,LQLEND(2))
- IQRRD = 0
- IQ(LQHOLD+1) = JSLGO
- IF (JSLGO.GE.JSLE) CALL P_CRASH ('bad start of cradle')
- ENDIF
-
-C-- Done
-
- IQ(LARRV+7) = NCHPOS
- IQ(LARRV+8) = IN_EOF
-
- 37 CALL NEXTDE (JSLNEW,JSLE,JSLF,JDKNEX,INCRAD)
-
- IF (JSLF.EQ.JSLGO) THEN
- IF (JDKNEX.GT.0) THEN
- JSLNEW = JSLF + 1
- JDKTYP = JDKNEX
- GO TO 37
- ENDIF
- ENDIF
-
- IF (JDKNEX.EQ.0) THEN
- IF (IN_EOF.NE.0) JDKNEX= 6
- ENDIF
-
- IQ(LQHOLD+2) = JSLE - JSLGO
- IQ(LQHOLD+3) = JSLF - JSLGO
- IQ(LQHOLD) = IOR (IQ(LQHOLD), 1)
-
- IQ(LARRV+12) = IQ(LARRV+12) + (JSLE-LQLEND(2))
- LQLEND(2) = JSLE
- LQLSTA(3) = LQLEND(2)
- LQLEND(3) = LQLSTA(3)
- RETURN
-
-C---- EoF read, no material has come to memory
-
- 41 IF (IN_EOF.NE.-1) CALL P_KILLM ('CIO read fails')
- IQ(LARRV+8) = -1
- JDKNEX = 6
- IF (JSLNEW.EQ.JSLGO) JDKTYP = 6
- RETURN
-
-C---- Reposition the file
-
- 61 IF (IN_DOX.NE.1) GO TO 71
- JSLN = IN_DO1
- JSLE = LQLEND(2)
- NSLOV = JSLE - JSLN
- NTKOV = MLIAD(JSLE) - MLIAD(JSLN)
- NCHPOS = IQ(LARRV+7)
-
- NCHPOS = NCHPOS - NTKOV
- CALL CISEEK (IN_FD,NCHPOS,ISTAT)
-
- IF (ISTAT.NE.0) CALL P_KILLM ('CIO seek fails')
-
- IQ(LARRV+7) = NCHPOS
- IQ(LARRV+8) = 0
- IQ(LARRV+12) = IQ(LARRV+12) - NSLOV
- LQLEND(2) = JSLN
- LQLSTA(3) = LQLEND(2)
- LQLEND(3) = LQLSTA(3)
- RETURN
-
-C---- REWIND / CLOSE
-
- 71 IF (IN_DOX.EQ.0) THEN
- CALL CIREW (IN_FD)
- ELSE
- CALL CICLOS (IN_FD)
- IQ(LARRV+1) = 0
- IQ(LARRV+2) = 0
- ENDIF
-
- IF (IQ(LARRV+7).GE.0) IQ(LARRV+7)= 0
- IQ(LARRV+5) = 0
- IQ(LARRV+8) = 0
- IQ(LARRV+9) = 0
- RETURN
- END
diff --git a/src/p5boot/p5lib/arrive.f b/src/p5boot/p5lib/arrive.f
deleted file mode 100644
index efa4c2b..0000000
--- a/src/p5boot/p5lib/arrive.f
+++ /dev/null
@@ -1,227 +0,0 @@
-CDECK ID>, ARRIVE.
- SUBROUTINE ARRIVE (MODEIN)
-
-C- Read input material to memory
-C- MODE = 0 : read the blank deck of the cradle
-C- 1 : make sure the beginning of the next deck is in memory
-C- 2 : make sure the complete deck is in memory
-C- 3 : read as much as you can
-C. started 11-mar-92
-
- COMMON /QUNIT/ IQREAD,IQPRNT, IQTTIN,IQTYPE, IQOFFL,IQRTTY,IQRSAV
- +, IQRFD,IQRRD,IQRSIZ, NQLPAT,NQUSED,NQLLBL, NQINIT
- PARAMETER (MCCNIL=1, MCCKIL=2, MCCINC=3, MCCCDE=4, MCCSEQ=5,
- + MCCXSQ=6, MCCTRU=7, MCCFAL=8, MCCELS=9, MCCEND=10,
- + MCCSEL=11, MCCSES=12, MCCFAU=13, MCCSKI=14,
- + MCCKEE=15, MCCDEL=16, MCCREP=17, MCCADB=18, MCCADD=19,
- + MCCUSE=20, MCCXDI=21, MCCDIV=22, MCCLIS=23, MCCEXE=24, MCCIMI=25,
- + MCCASM=26, MCCUPD=27, MCCNAM=28, MCCGAP=29, MCCMOR=30, MCCONL=31,
- + MCCFOR=32, MCCSUS=33, MCCOPT=34, MCCOP2=35, MCCSHO=36, MCCPAM=37,
- + MCCQUI=38, MCCEOD=39, MCCDEC=40, MCCPAT=41, MCCTIT=42)
- CHARACTER CCKORG*256, CCKARD*256, CCCOMF*256
- COMMON /CCPARA/NCHCCD,NCHCCT, JCCTYP,JCCLEV,JCCSL,MCCPAR(240)
- +, NCCPAR,MXCCIF,JCCIFV,JCCBAD,JCCWAR,ICCSUB,JCCWK(4)
- +, JCCPP,JCCPD,JCCPZ,JCCPT,JCCPIF,JCCPC,JCCPN
- +, NCCPP,NCCPD,NCCPZ,NCCPT,NCCPIF,NCCPC,NCCPN
- +, JCCEND, NCHCCC,IXCCC, CCKORG, CCKARD, CCCOMF
- COMMON /LUNSLN/IFLAUX, IXLUN(12)
- COMMON /MQCM/ NQSYSS,NQLINK, LQCSTA(3),LQCEND(3), NQMAX
- +, LQLSTA(5),LQLEND(5), LQADR,LQADR0,NQOFFS
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
- COMMON /ARRCOM/IN_LUN, IN_FD, IN_FIO, IN_EOF
- +, IN_DOX, IN_DO1, IN_DO2
- PARAMETER (NSLIFI=128)
- CHARACTER CHLIFI*(NSLIFI), CHLIEX*8
- COMMON /FLINKC/LUNOP,LUNFD,LUNOLD,LUNSIZ
- +, IXFLUN, NLIFI,CHLIFI,CHLIEX
-C-------------- End CDE --------------------------------
-
-
- MODE = MODEIN
-
-C-- collect garbage before reading next instalment from PAM
-
- IF (INCRAD.EQ.0) THEN
- IF (LQLEND(2).NE.LQLSTA(2)) GO TO 25
- ENDIF
- IF (MODE.NE.0) GO TO 21
-
-C---- Start reading the blank deck of the cradle
-
- LARRV = LACRAD
- IQ(LARRV+1) = IQREAD
- IQ(LARRV+2) = IQRFD
- IQ(LARRV+6) = IQRSIZ
- JDKTYP = 0
-
- IF (IQRFD .NE.0) GO TO 21
- IF (IQRSIZ.NE.0) GO TO 21
- IQ(LARRV+7) = -2
- IF (IQRTTY.NE.0) IQ(LARRV+7)= -1
-
-C---- Check enough space
-
- 21 NWFREE = LQCSTA(3) - LQCEND(2)
- JSLOCC = LQLSTA(4)
- JSLFRE = LQLEND(2)
- NSLFRE = JSLOCC - JSLFRE - 8
- NTXFRE = MLIAD(JSLOCC) - MLIAD(JSLFRE) - 400
-
- NSLRSV = NVGAP(2)
- NTXRSV = NSLRSV * NVGAP(4)
-
- NSLEXP = NVGAP(3)
- NTXEXP = NSLEXP * NVGAP(4)
-
- NSLMIN = 40
- NTXMIN = NSLMIN * NVGAP(4)
-
- IF (IFMODIF.NE.0) THEN
- NSLRSV = NSLRSV + NSLEXP
- NTXRSV = NTXRSV + NTXEXP
- ENDIF
-
- NSLWAN = NSLFRE - NSLRSV
- NTXWAN = NTXFRE - NTXRSV
-
- IF (NWFREE.LT.NVGAP(1)) GO TO 24
- IF (NSLFRE.LT.NSLRSV+NSLEXP) GO TO 24
- IF (NTXFRE.GE.NTXRSV+NTXEXP) GO TO 31
-
- 24 IF (IFLGAR.NE.0) GO TO 27
- 25 CALL MQSHIFT
- IFLGAR = 7
- GO TO 21
-
-C-- not plenty of space, try to do with half the reservation
-
- 27 IF (NSLFRE.GE.NSLRSV+NSLEXP) THEN
- IF (NTXFRE.GE.NTXRSV+NTXEXP) GO TO 31
- ENDIF
- NSLWAN = NSLFRE - NSLRSV/2
- NTXWAN = NTXFRE - NTXRSV/2
-
- IF (NSLWAN.LT.NSLMIN)
- + CALL NOSPACE ('no line slots left for reading')
- IF (NTXWAN.LT.NTXMIN)
- + CALL NOSPACE ('no text store left for reading')
-
-
-C---- Handle pending material from the ASAV bank
-C- Note: this can happen only at the moment
-C- when resuming the cradle or a Pam file
-
- 31 LASAV = LQ(LARRV-2)
- IF (LASAV.EQ.0) GO TO 41
-
- IQ(LQHOLD+1)= LQLEND(2)
-
- JSLTR = IQ(LASAV+1)
- NSLTR = IQ(LASAV+2)
- JSLE = JSLTR + NSLTR
- NTXTR = MLIAD(JSLE) - MLIAD(JSLTR)
-
- IF (NSLTR.GT.NSLWAN)
- + CALL NOSPACE ('no line slots left for reading')
- IF (NTXTR.GT.NTXWAN)
- + CALL NOSPACE ('no text store left for reading')
-
-C-- transfer all pending material
-
- JSLTR = LN_COP2 (JSLTR,NSLTR)
- CALL TOGARB (LARRV-2,0)
-
- IQ(LQHOLD+2) = NSLTR
- CALL ARRNXD (-1)
-
- IF (JDKNEX.NE.0) RETURN
- IF (MODE.EQ.1) RETURN
- GO TO 21
-
-C------ Read from the file
-
- 41 IF (IQ(LQHOLD+2).EQ.0) THEN
- IQ(LQHOLD+1) = LQLEND(2)
- JDKTYP = 0
- ENDIF
-
- IN_DOX = 2
-C-- if file not seekable, dont read too much
-
- IF (IQ(LARRV+7).LT.-1) THEN
- NSLWAN = NSLMIN
- NTXWAN = NTXMIN
- ENDIF
- IN_DO1 = NSLWAN
- IN_DO2 = NTXWAN
- JDKNEX = 0
- IF (IQ(LARRV+7).EQ.-1) THEN
- CALL ARRTM
- ELSE
- CALL ARRIN
- ENDIF
-
- IF (JDKNEX.LT.0) GO TO 61
- IF (MODE.NE.1) THEN
- IF (JDKNEX.EQ.0) GO TO 21
- ENDIF
- IF (MODE.NE.0) RETURN
-
-C-- having read the blank deck of the cradle
-
- IF (IFLAUX.NE.0) RETURN
- IF (JDKTYP.LT.2) RETURN
- CALL P_KILL ('illegal start of the cradle')
-
-C---- Having read the start of the blank deck of the cradle
-C-- until a line +MORE : read the cradle continuation file
-
- 61 JDKNEX = 0
- JSLM = IQ(LQHOLD+1) + IQ(LQHOLD+3)
- JCCTYP = MCCMOR
- CALL CCKRAK (JSLM)
-
- IF (NCHCCD.GE.NCHCCT) JCCBAD= 7
- IF (JCCBAD.NE.0) CALL P_KILL ('faulty +MORE line')
-
-C-- close previous cradle file, if not terminal
-
- IF (IQ(LARRV+7).NE.-1) THEN
- IN_DOX = -1
- CALL ARRIN
- ENDIF
-
-C-- attach the +MORE file
-
- IQREAD = IQRSAV
- IQRTTY = 0
- CALL FLKRAK (1,1)
- CALL FLINK (IQREAD, 1, -1, 0)
- IQRFD = LUNFD
- IQRSIZ = LUNSIZ
-
- IQ(LARRV+1) = IQREAD
- IQ(LARRV+2) = IQRFD
- IQ(LARRV+4) = IXFLUN
- IQ(LARRV+6) = IQRSIZ
- IQ(LARRV+7) = 0
- IQ(LARRV+8) = 0
-
- LQLEND(2) = JSLM + 1
- LQLSTA(3) = LQLEND(2)
- LQLEND(3) = LQLSTA(3)
- GO TO 21
- END
diff --git a/src/p5boot/p5lib/arrnxd.f b/src/p5boot/p5lib/arrnxd.f
deleted file mode 100644
index d45521c..0000000
--- a/src/p5boot/p5lib/arrnxd.f
+++ /dev/null
@@ -1,58 +0,0 @@
-CDECK ID>, ARRNXD.
- SUBROUTINE ARRNXD (JSTEP)
-
-C- Set the limit of the next deck, find type of the deck after
-C- JSTEP = 1 step to next deck
-C- 0 find the end of current deck only
-C- -1 determine also the type of the current deck
-C. started 5-mar-92
-
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
-C-------------- End CDE --------------------------------
-
-
- JSLA = IQ(LQHOLD+1)
- JSLE = JSLA + IQ(LQHOLD+2)
-
-C-- JSTEP > 0: step to next deck
-
- IF (JSTEP.GT.0) THEN
- IF (JDKNEX.EQ.-13) CALL P_KILL ('Misplaced +MORE line')
- IF (JDKNEX.LE.0) CALL P_CRASH ('trouble in ARRNXD')
- JDKTYP = JDKNEX
- JSLA = JSLA + IQ(LQHOLD+3)
- IQ(LQHOLD+1) = JSLA
- IQ(LQHOLD+2) = JSLE - JSLA
- IF (JDKTYP.NE.6) GO TO 24
- RETURN
- ENDIF
-
-C-- JSTEP = <0: type of current deck
-
- IF (JSTEP.LT.0) THEN
- CALL NEXTSI (JSLA,JDKTYP,INCRAD)
- ENDIF
-
-C-- find end of current deck
-
- 24 CALL NEXTDE (JSLA+1,JSLE,JSLF,JDKNEX,INCRAD)
- IQ(LQHOLD+3) = JSLF - JSLA
-
- IF (JDKNEX.NE.0) RETURN
-
- IF (IQ(LARRV+8).NE.0) JDKNEX= 6
- RETURN
- END
diff --git a/src/p5boot/p5lib/arrskp.f b/src/p5boot/p5lib/arrskp.f
deleted file mode 100644
index a0b7586..0000000
--- a/src/p5boot/p5lib/arrskp.f
+++ /dev/null
@@ -1,54 +0,0 @@
-CDECK ID>, ARRSKP.
- SUBROUTINE ARRSKP
-
-C- Skip one PAM/Patch/Deck according to JDKTYP, using the C library
-C. started 16-mar-92
-
- COMMON /QPAGE/ NQLMAX,NQLTOL,NQLTOK,NQCMAX,NQCPGH,NQPAGE
- +, NQWYLDO,NQWYL,NQNEWH,NQJOIN,NQDKNO,NQDKPG
- CHARACTER CHEXPD*68
- COMMON /CHEXC/ IXEXPAM, IXEXPAT,IXEXDEC,IXEXID, NCHEPD, CHEXPD
- COMMON /MQCM/ NQSYSS,NQLINK, LQCSTA(3),LQCEND(3), NQMAX
- +, LQLSTA(5),LQLEND(5), LQADR,LQADR0,NQOFFS
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
-C-------------- End CDE --------------------------------
-
-
- IXEXDEC = 0
- NSLORG = 0
- NDKSKP = 0
- LEVEL = JDKTYP
-
-C-- Make sure the current deck is complete in memory
-
- IF (JDKNEX.EQ.0) CALL ARRNXD (0)
- 24 IF (JDKNEX.EQ.0) CALL ARRIVE (2)
-
-C-- Skip one deck, next -> current
-
- CALL ARRNXD (1)
- NDKSKP = NDKSKP + 1
- IF (JDKTYP.LT.LEVEL) GO TO 24
-
-C-- The now current deck is at the right level
-
- IF (LEVEL.GE.3) RETURN
- IF (LEVEL.EQ.2) IXEXPAT= 0
- NQDKNO = NQDKNO + NDKSKP
- JSLZER = IQ(LQHOLD+1)
- JSLORG = JSLZER
- RETURN
- END
diff --git a/src/p5boot/p5lib/arrtm.f b/src/p5boot/p5lib/arrtm.f
deleted file mode 100644
index 7b3b90d..0000000
--- a/src/p5boot/p5lib/arrtm.f
+++ /dev/null
@@ -1,80 +0,0 @@
-CDECK ID>, ARRTM.
- SUBROUTINE ARRTM
-
-C- Read cradle lines from the on-line user
-C. started 10-feb-92
-
- COMMON /MQCM/ NQSYSS,NQLINK, LQCSTA(3),LQCEND(3), NQMAX
- +, LQLSTA(5),LQLEND(5), LQADR,LQADR0,NQOFFS
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
- COMMON /ARRCOM/IN_LUN, IN_FD, IN_FIO, IN_EOF
- +, IN_DOX, IN_DO1, IN_DO2
-C-------------- End CDE --------------------------------
-
-
- JSLGO = IQ(LQHOLD+1)
-
- JSLU = LQLEND(2)
- JTXU = MLIAD(JSLU)
- JSLE = JSLU + IN_DO1
- JTXE = JTXU + IN_DO2
-
- 24 JSLF = JSLU
- IF (JSLU.GE.JSLE) GO TO 37
- IF (JTXU.GE.JTXE) GO TO 37
- CALL TMPRO (' ny> ')
- CALL TMREAD (512,TEXT(JTXU),NTXR,IN_EOF)
-
- IF (IN_EOF.NE.0) GO TO 31
-
- JTXF = JTXU
- JTXU = JTXU + NTXR
- TEXT(JTXU) = CHAR(NEWLN)
- JTXU = JTXU + 1
- JSLU = JSLU + 1
- MLIAD(JSLU) = JTXU
-
- IF (NTXR.LT.4) GO TO 24
- IF (TEXT(JTXF).NE.'+') GO TO 24
-
- CALL NEXTSI (JSLF,JDKNEX,INCRAD)
-
- IF (JDKNEX.EQ.0) GO TO 24
- IF (JSLF.NE.JSLGO) GO TO 37
- IF (JDKNEX.LT.0) GO TO 37
- JDKTYP = JDKNEX
- JDKNEX = 0
- JSLF = JSLU
- GO TO 37
-
-C---- EoF
-
- 31 IF (IN_EOF.GT.0) CALL P_KILLM ('terminal read fails')
-
- IQ(LARRV+8) = -1
- JDKNEX = 6
- IF (JSLU.EQ.JSLGO) JDKTYP = 6
-
-C-- Done
-
- 37 IQ(LARRV+12) = IQ(LARRV+12) + (JSLU-LQLEND(2))
- LQLEND(2) = JSLU
- LQLSTA(3) = LQLEND(2)
- LQLEND(3) = LQLSTA(3)
- IQ(LQHOLD+2) = JSLU - JSLGO
- IQ(LQHOLD+3) = JSLF - JSLGO
- RETURN
- END
diff --git a/src/p5boot/p5lib/asmalia.f b/src/p5boot/p5lib/asmalia.f
deleted file mode 100644
index a4d62d9..0000000
--- a/src/p5boot/p5lib/asmalia.f
+++ /dev/null
@@ -1,96 +0,0 @@
-CDECK ID>, ASMALIA.
- SUBROUTINE ASMALIA
-
-C- Analyse +ASM, D=typ1, typ2, ..., T=ALIAS
-
- COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT,NUSLAT(2),DUMMY(34)
- CHARACTER SLLINE*512, SLERRM*256
- COMMON /SLATLN/ SLLINE, SLERRM
- CHARACTER CCKORG*256, CCKARD*256, CCCOMF*256
- COMMON /CCPARA/NCHCCD,NCHCCT, JCCTYP,JCCLEV,JCCSL,MCCPAR(240)
- +, NCCPAR,MXCCIF,JCCIFV,JCCBAD,JCCWAR,ICCSUB,JCCWK(4)
- +, JCCPP,JCCPD,JCCPZ,JCCPT,JCCPIF,JCCPC,JCCPN
- +, NCCPP,NCCPD,NCCPZ,NCCPT,NCCPIF,NCCPC,NCCPN
- +, JCCEND, NCHCCC,IXCCC, CCKORG, CCKARD, CCCOMF
- PARAMETER (NBANKS=19,JBKPAT=1, JBKDEC=2, JBKORG=3, JBKINC=4,
- + JBKHOL=5, JBKKEE=6, JBKACT=7, JBKMAT=8, JBKXSQ=9,
- + JBKPRE=10,JBKGAR=11,JBKSMH=12,JBKSMT=13,JBKSML=14,
- + JBKSMX=15,JBKARR=16,JBKASA=17,JBKPAM=18,JBKRPA=19)
- COMMON /QBANKS/MMBANK(5,NBANKS)
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
- PARAMETER (JFO_TYP=1, JCC_TYP=2, JAS_TYP=3, JDA_TYP=4,
- + JSH_TYP=5, JCR_TYP=6, JIN_TYP=7, MAX_TYP=100)
- CHARACTER*16 CH_TYP(MAX_TYP), ACT_TYP
- COMMON /CM_TYP/ LUN_TYP, N_TYP, NAL_TYP, NDV_TYP, JBK_TYP
- +, JU_TYP(MAX_TYP), CH_TYP, ACT_TYP
-C-------------- End CDE --------------------------------
- CHARACTER MSG*60
- EQUIVALENCE (MSG,SLERRM)
-
-
- LOC = JCCPD
- NTH = NCCPD
- IF (NTH.LT.2) RETURN
-
-C-- get the aliasing target
-
- JTX = NA_JTX (MCCPAR(LOC+1))
- NN = NDSLAT
- CALL ASMNAME (NN, TEXT(JTX))
- IF (NDV_TYP.LT.0) RETURN
- CALL ASMFIND (ACT_TYP, JUSE)
- IF (JUSE.EQ.0) CALL ASMCREA (ACT_TYP, JUSE, 0)
-
-C-- get the alias names
-
- 24 LOC = LOC + 3
- NTH = NTH - 1
- IF (NTH.EQ.0) RETURN
- JTX = NA_JTX (MCCPAR(LOC+1))
- NN = NDSLAT
- CALL ASMNAME (NN, TEXT(JTX))
- IF (NDV_TYP.LT.0) GO TO 24
- CALL ASMFIND (ACT_TYP, JASM)
- IF (JASM.NE.0) GO TO 31
-
-C-- new name
-
- IF (N_TYP+NAL_TYP.EQ.MAX_TYP) GO TO 91
- JAL = MAX_TYP - NAL_TYP
- CH_TYP(JAL) = ACT_TYP
- JU_TYP(JAL) = JUSE
- NAL_TYP = NAL_TYP + 1
- GO TO 24
-
-C---- Alias name already known
-
- 31 JAL = NDSLAT
- IF (JAL.EQ.0) GO TO 92
- IF (JU_TYP(JAL).EQ.JUSE) GO TO 24
- GO TO 93
-
-C---- Errors
-
- 91 CALL FAILCC (2,'Data-type catalog full')
-
- 92 MSG = 'Stream ' // ACT_TYP // 'already established'
- GO TO 96
-
- 93 MSG = 'Trying to redefine alias ' // ACT_TYP
- 96 CALL CSQMBL (MSG,1,50)
- N = NDSLAT
- CALL FAILCC (1,MSG(1:N))
- END
diff --git a/src/p5boot/p5lib/asmall.f b/src/p5boot/p5lib/asmall.f
deleted file mode 100644
index f816009..0000000
--- a/src/p5boot/p5lib/asmall.f
+++ /dev/null
@@ -1,82 +0,0 @@
-CDECK ID>, ASMALL.
- SUBROUTINE ASMALL
-
-C- For c/l +ASM, D=typ1, typ2, ... analyse the parameters at JCCPD,
-C- create the needed ASMT & ASML banks,
-C- replace:
-C- MCCPAR(JCCPD+1) = JASM
-C- +2) = JSTR = 0 for type
-C- 1 2 3 type:0 :1 :2
-
- COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT,NUSLAT(2),DUMMY(34)
- CHARACTER SLLINE*512, SLERRM*256
- COMMON /SLATLN/ SLLINE, SLERRM
- CHARACTER CCKORG*256, CCKARD*256, CCCOMF*256
- COMMON /CCPARA/NCHCCD,NCHCCT, JCCTYP,JCCLEV,JCCSL,MCCPAR(240)
- +, NCCPAR,MXCCIF,JCCIFV,JCCBAD,JCCWAR,ICCSUB,JCCWK(4)
- +, JCCPP,JCCPD,JCCPZ,JCCPT,JCCPIF,JCCPC,JCCPN
- +, NCCPP,NCCPD,NCCPZ,NCCPT,NCCPIF,NCCPC,NCCPN
- +, JCCEND, NCHCCC,IXCCC, CCKORG, CCKARD, CCCOMF
- PARAMETER (NBANKS=19,JBKPAT=1, JBKDEC=2, JBKORG=3, JBKINC=4,
- + JBKHOL=5, JBKKEE=6, JBKACT=7, JBKMAT=8, JBKXSQ=9,
- + JBKPRE=10,JBKGAR=11,JBKSMH=12,JBKSMT=13,JBKSML=14,
- + JBKSMX=15,JBKARR=16,JBKASA=17,JBKPAM=18,JBKRPA=19)
- COMMON /QBANKS/MMBANK(5,NBANKS)
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
- PARAMETER (JFO_TYP=1, JCC_TYP=2, JAS_TYP=3, JDA_TYP=4,
- + JSH_TYP=5, JCR_TYP=6, JIN_TYP=7, MAX_TYP=100)
- CHARACTER*16 CH_TYP(MAX_TYP), ACT_TYP
- COMMON /CM_TYP/ LUN_TYP, N_TYP, NAL_TYP, NDV_TYP, JBK_TYP
- +, JU_TYP(MAX_TYP), CH_TYP, ACT_TYP
-C-------------- End CDE --------------------------------
-
-C-- do the DT= parameters
-
- IFL = 0
- LOC = JCCPD
- NTH = NCCPD
- 24 JTX = NA_JTX (MCCPAR(LOC+1))
- NN = NDSLAT
- CALL ASMNAME (NN, TEXT(JTX))
- IF (NDV_TYP.LT.0) GO TO 91
-
- CALL ASMFIND (ACT_TYP, JASM)
- IFAL = NDSLAT
- IF (JASM.EQ.0) THEN
- CALL ASMCREA (ACT_TYP, JASM, 0)
- ENDIF
-
- MCCPAR(LOC) = IFAL
- MCCPAR(LOC+1) = JASM
- MCCPAR(LOC+2) = NDV_TYP
- LOC = LOC + 3
- NTH = NTH - 1
- IF (NTH.GT.0) GO TO 24
- IF (IFL.NE.0) RETURN
-
-C-- do also the S= parameter
-
- NTH = NCCPP
- IF (NTH.EQ.0) RETURN
- LOC = JCCPP
- IFL = 7
- GO TO 24
-
-C---- Fault
-
- 91 JCCBAD = 1
- RETURN
- END
diff --git a/src/p5boot/p5lib/asmcrea.f b/src/p5boot/p5lib/asmcrea.f
deleted file mode 100644
index 3d7d4d0..0000000
--- a/src/p5boot/p5lib/asmcrea.f
+++ /dev/null
@@ -1,84 +0,0 @@
-CDECK ID>, ASMCREA.
- SUBROUTINE ASMCREA (DTYPE,JASMF,IFRUN)
-
-C- Lift the ASMT and ASML banks for data type DTYPE
-C- IFRUN = 0: create with default connections for +ASM
-C- 1: unkown data type seen when running,
-C create with connections for DATA
-
- CHARACTER SLLINE*512, SLERRM*256
- COMMON /SLATLN/ SLLINE, SLERRM
- PARAMETER (NBANKS=19,JBKPAT=1, JBKDEC=2, JBKORG=3, JBKINC=4,
- + JBKHOL=5, JBKKEE=6, JBKACT=7, JBKMAT=8, JBKXSQ=9,
- + JBKPRE=10,JBKGAR=11,JBKSMH=12,JBKSMT=13,JBKSML=14,
- + JBKSMX=15,JBKARR=16,JBKASA=17,JBKPAM=18,JBKRPA=19)
- COMMON /QBANKS/MMBANK(5,NBANKS)
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
- COMMON /LUNSLN/IFLAUX, IXLUN(12)
- PARAMETER (JFO_TYP=1, JCC_TYP=2, JAS_TYP=3, JDA_TYP=4,
- + JSH_TYP=5, JCR_TYP=6, JIN_TYP=7, MAX_TYP=100)
- CHARACTER*16 CH_TYP(MAX_TYP), ACT_TYP
- COMMON /CM_TYP/ LUN_TYP, N_TYP, NAL_TYP, NDV_TYP, JBK_TYP
- +, JU_TYP(MAX_TYP), CH_TYP, ACT_TYP
-C-------------- End CDE --------------------------------
- CHARACTER DTYPE*(*)
-
-
- IF (N_TYP+NAL_TYP.EQ.MAX_TYP) GO TO 91
- IF (N_TYP.EQ.63) GO TO 91
-
- N_TYP = N_TYP + 1
- JASM = N_TYP
- CH_TYP(JASM) = DTYPE
-
- CALL MQLIFT (LASMT, LHASM,-JASM, JBKSMT,3)
-
- IF (IFLAUX.NE.0) GO TO 39
- IQ(LASMT+1) = -1
- LDATA = LQ(LHASM-4)
-
-C-- create the ASML banks
-
- DO 37 JDIV=1,4
- CALL MQLIFT (LASML, LASMT,-JDIV-1, JBKSML,3)
- IF (IFRUN.EQ.0) THEN
- IQ(LASML+1) = -1
- IQ(LASML+5) = -1
- IQ(LASML+6) = -1
- IQ(LASML+7) = -1
- ELSE
- LASMLD = LQ(LDATA-JDIV-1)
- MUSE = IQ(LASMLD+1)
- IF (MUSE.EQ.0) MUSE = 32 + JDIV
- IQ(LASML+1) = MUSE
- IQ(LASML+5) = IQ(LASMLD+5)
- ENDIF
- 37 CONTINUE
- 39 JASMF = N_TYP
- IF (IFRUN.EQ.0) RETURN
- IF (IFLAUX.NE.0) RETURN
- SLERRM = 'Undeclared data-type: ' // DTYPE
- N = LENOCC (SLERRM)
- CALL FAILMSG (0,1, 0,SLERRM(1:N))
- RETURN
-
-C-- Fault, capacity exeeded
-
- 91 IF (IFLAUX.NE.0) GO TO 39
- IF (IFRUN.EQ.0) CALL P_KILL ('Too many ASM data types')
- JASMF = 4
- RETURN
- END
diff --git a/src/p5boot/p5lib/asmcrx.f b/src/p5boot/p5lib/asmcrx.f
deleted file mode 100644
index 27202b5..0000000
--- a/src/p5boot/p5lib/asmcrx.f
+++ /dev/null
@@ -1,30 +0,0 @@
-CDECK ID>, ASMCRX.
- SUBROUTINE ASMCRX (LASML)
-
-C- Lift the ASMX bank for the physical stream at LASML
-C- LASML adr of the bank to be connected to
-C. started 22-nov-93
-
- PARAMETER (NBANKS=19,JBKPAT=1, JBKDEC=2, JBKORG=3, JBKINC=4,
- + JBKHOL=5, JBKKEE=6, JBKACT=7, JBKMAT=8, JBKXSQ=9,
- + JBKPRE=10,JBKGAR=11,JBKSMH=12,JBKSMT=13,JBKSML=14,
- + JBKSMX=15,JBKARR=16,JBKASA=17,JBKPAM=18,JBKRPA=19)
- COMMON /QBANKS/MMBANK(5,NBANKS)
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
-C-------------- End CDE --------------------------------
-
-
- LXASM = LQ(LASML-1)
- IF (LXASM.NE.0) RETURN
-
- CALL MQLIFT (LXASM, LASML,-1, JBKSMX,3)
- IQ(LXASM+2) = -99
- RETURN
- END
diff --git a/src/p5boot/p5lib/asmdump.f b/src/p5boot/p5lib/asmdump.f
deleted file mode 100644
index 906cd6b..0000000
--- a/src/p5boot/p5lib/asmdump.f
+++ /dev/null
@@ -1,164 +0,0 @@
-CDECK ID>, ASMDUMP.
- SUBROUTINE ASMDUMP (MSG)
-
-C- Dump the ASM d/s
-C. started 13-oct-93
-
- COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT,NUSLAT(2),DUMMY(34)
- CHARACTER SLLINE*512, SLERRM*256
- COMMON /SLATLN/ SLLINE, SLERRM
- COMMON /QUNIT/ IQREAD,IQPRNT, IQTTIN,IQTYPE, IQOFFL,IQRTTY,IQRSAV
- +, IQRFD,IQRRD,IQRSIZ, NQLPAT,NQUSED,NQLLBL, NQINIT
- PARAMETER (JFO_TYP=1, JCC_TYP=2, JAS_TYP=3, JDA_TYP=4,
- + JSH_TYP=5, JCR_TYP=6, JIN_TYP=7, MAX_TYP=100)
- CHARACTER*16 CH_TYP(MAX_TYP), ACT_TYP
- COMMON /CM_TYP/ LUN_TYP, N_TYP, NAL_TYP, NDV_TYP, JBK_TYP
- +, JU_TYP(MAX_TYP), CH_TYP, ACT_TYP
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
-C-------------- End CDE --------------------------------
- CHARACTER MSG*(*)
- CHARACTER SLCOL(512)*1
- EQUIVALENCE (SLCOL,SLLINE)
-
-
- WRITE (IQPRNT,9001) MSG
- 9001 FORMAT (/'1Dump the ASM data stucture ',A)
-
- JASM = 0
- 21 JASM = JASM + 1
- IF (JASM.GT.N_TYP) GO TO 89
- LASMT = LQ(LHASM-JASM)
- IF (LASMT.EQ.0) GO TO 89
-
- JNAME = JASM
- NN = LNBLNK (CH_TYP(JNAME))
- WRITE (IQPRNT,9021) CH_TYP(JNAME)(1:NN)
- 9021 FORMAT (/' for data type ',A)
-
- JSTR = 0
- LASML = LASMT
-
- 24 WRITE (IQPRNT,9024) JSTR
- 9024 FORMAT (/5X,'stream :',I1)
-
- MUSE = IQ(LASML+1)
- IF (MUSE.GT.0) GO TO 27
- IF (MUSE.LT.0) THEN
- WRITE (IQPRNT,9025) MUSE
- GO TO 34
- ENDIF
-
- WRITE (IQPRNT,9026) MUSE
- GO TO 31
-
- 9025 FORMAT (17X,'binding',I5,' to be resolved')
- 9026 FORMAT (17X,'binding',I5,' stream is physical')
-
- 27 JUA = MUSE / 8
- JUB = MOD (MUSE,8)
- SLLINE(1:20) = CH_TYP(JUA)
- IF (JUB.NE.0) THEN
- SLCOL(17) = ':'
- CALL CSETDI (JUB,SLLINE,18,20)
- ENDIF
- CALL CLEFT (SLLINE,1,20)
- NN = NDSLAT
- WRITE (IQPRNT,9027) SLLINE(1:NN)
- 9027 FORMAT (16X,'bound to ',A)
- GO TO 34
-
-
- 31 MODE = IQ(LASML+2)
- WRITE (IQPRNT,9031) MODE
- 9031 FORMAT (12X,' output mode',I5)
- 9032 FORMAT (12X,'IX file name',I5,:,1X,A)
- 9033 FORMAT (12X,'IX prefix',I5,:,1X,A)
- 9034 FORMAT (12X,'IX extension',I5,:,1X,A)
- 9035 FORMAT (12X,'IX r/header',I5,:,1X,A)
- 9036 FORMAT (12X,'IX c/ch sub',I5,:,1X,A)
-
- JUSE = IQ(LASML+3)
- IF (JUSE.LE.0) THEN
- WRITE (IQPRNT,9032) JUSE
- ELSE
- CALL NA_GET (JUSE,SLLINE,1)
- N = NDSLAT
- WRITE (IQPRNT,9032) JUSE, SLLINE(1:N)
- ENDIF
-
- IF (MODE.LT.2) GO TO 34
- JUSE = IQ(LASML+4)
- IF (JUSE.LE.0) THEN
- WRITE (IQPRNT,9033) JUSE
- ELSE
- CALL NA_GET (JUSE,SLLINE,1)
- N = NDSLAT
- WRITE (IQPRNT,9033) JUSE, SLLINE(1:N)
- ENDIF
-
- 34 JREA = IQ(LASML+11)
- IF (JREA.NE.0) GO TO 41
- JUSE = IQ(LASML+5)
- JUSX = JUSE
- IF (JUSX.LT.0) JUSX= IQ(LASMT+5)
- IF (JUSX.LE.0) THEN
- WRITE (IQPRNT,9034) JUSE
- ELSE
- CALL NA_GET (JUSX,SLLINE,1)
- N = NDSLAT
- WRITE (IQPRNT,9034) JUSE, SLLINE(1:N)
- ENDIF
-
- JUSE = IQ(LASML+6)
- JUSX = JUSE
- IF (JUSX.LT.0) JUSX= IQ(LASMT+6)
- IF (JUSX.LE.0) THEN
- WRITE (IQPRNT,9035) JUSE
- ELSE
- CALL NA_GET (JUSX,SLLINE,1)
- N = NDSLAT
- WRITE (IQPRNT,9035) JUSE, SLLINE(1:N)
- ENDIF
-
- JUSE = IQ(LASML+7)
- JUSX = JUSE
- IF (JUSX.LT.0) JUSX= IQ(LASMT+7)
- IF (JUSX.LE.0) THEN
- WRITE (IQPRNT,9036) JUSE
- ELSE
- CALL NA_GET (JUSX,SLLINE,1)
- N = NDSLAT
- WRITE (IQPRNT,9036) JUSE, SLLINE(1:N)
- ENDIF
- GO TO 49
-
-C-- logical stream re-assigned
-
- 41 JA = JREA/8
- JS = MOD (JREA,8)
- NN = LNBLNK (CH_TYP(JA))
-
- WRITE (IQPRNT,9044) CH_TYP(JA)(1:NN),JS
- 9044 FORMAT (12X,'data re-assigned to stream ',A,':',I1)
-
- 49 JSTR = JSTR + 1
- IF (JSTR.GT.4) GO TO 21
- LASML = LQ(LASMT-JSTR-1)
- GO TO 24
-
- 89 CONTINUE
- RETURN
- END
diff --git a/src/p5boot/p5lib/asmfind.f b/src/p5boot/p5lib/asmfind.f
deleted file mode 100644
index 2edd428..0000000
--- a/src/p5boot/p5lib/asmfind.f
+++ /dev/null
@@ -1,34 +0,0 @@
-CDECK ID>, ASMFIND.
- SUBROUTINE ASMFIND (DTYPE,JASM)
-
-C- Find the ASM stream for data type DTYPE,
-C- return its number in JASMF, or =0 if it does not exist;
-
- COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT,NUSLAT(2),DUMMY(34)
- PARAMETER (JFO_TYP=1, JCC_TYP=2, JAS_TYP=3, JDA_TYP=4,
- + JSH_TYP=5, JCR_TYP=6, JIN_TYP=7, MAX_TYP=100)
- CHARACTER*16 CH_TYP(MAX_TYP), ACT_TYP
- COMMON /CM_TYP/ LUN_TYP, N_TYP, NAL_TYP, NDV_TYP, JBK_TYP
- +, JU_TYP(MAX_TYP), CH_TYP, ACT_TYP
-C-------------- End CDE --------------------------------
- CHARACTER DTYPE*(*)
-
-
- NXX = MIN (LEN(DTYPE), 16)
- NXX = LNBLNK (DTYPE(1:NXX))
-
-C-- check alias
-
- JAL = MAX_TYP - NAL_TYP
- J = ICNTH (DTYPE(1:NXX), CH_TYP(JAL+1), NAL_TYP)
- IF (J.NE.0) THEN
- J = J + JAL
- NDSLAT = J
- JASM = JU_TYP(J)
- RETURN
- ENDIF
-
- NDSLAT = 0
- JASM = ICNTH (DTYPE(1:NXX), CH_TYP, N_TYP)
- RETURN
- END
diff --git a/src/p5boot/p5lib/asmini.f b/src/p5boot/p5lib/asmini.f
deleted file mode 100644
index 9cd9c2d..0000000
--- a/src/p5boot/p5lib/asmini.f
+++ /dev/null
@@ -1,202 +0,0 @@
-CDECK ID>, ASMINI.
- SUBROUTINE ASMINI
-
-C- Lift the initial ASM structure
-C. started 23-jan-92
-
- PARAMETER (NBANKS=19,JBKPAT=1, JBKDEC=2, JBKORG=3, JBKINC=4,
- + JBKHOL=5, JBKKEE=6, JBKACT=7, JBKMAT=8, JBKXSQ=9,
- + JBKPRE=10,JBKGAR=11,JBKSMH=12,JBKSMT=13,JBKSML=14,
- + JBKSMX=15,JBKARR=16,JBKASA=17,JBKPAM=18,JBKRPA=19)
- COMMON /QBANKS/MMBANK(5,NBANKS)
- COMMON /LUNSLN/IFLAUX, IXLUN(12)
- PARAMETER (JFO_TYP=1, JCC_TYP=2, JAS_TYP=3, JDA_TYP=4,
- + JSH_TYP=5, JCR_TYP=6, JIN_TYP=7, MAX_TYP=100)
- CHARACTER*16 CH_TYP(MAX_TYP), ACT_TYP
- COMMON /CM_TYP/ LUN_TYP, N_TYP, NAL_TYP, NDV_TYP, JBK_TYP
- +, JU_TYP(MAX_TYP), CH_TYP, ACT_TYP
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
-C-------------- End CDE --------------------------------
-
- CHARACTER*(*) CHRHF, CHRHC, CHRHI, CHRHA
- PARAMETER (CHRHF= ':CDECK ID>, :. ')
- PARAMETER (CHRHC= ':/*DECK ID>, :. */')
- PARAMETER (CHRHI= ':/*DECK ID>, :.h */')
- PARAMETER (CHRHA= ':|DECK ID>, :.')
-
- CHARACTER*(*) CHEXTF, CHEXTC, CHEXTI, CHEXTA, CHEXTD, CHEXTS
- PARAMETER (CHEXTF= '.f')
- PARAMETER (CHEXTC= '.c')
- PARAMETER (CHEXTI= '.h')
- PARAMETER (CHEXTA= '.s')
- PARAMETER (CHEXTD= ' ')
- PARAMETER (CHEXTS= '.sh')
-
-
- N_TYP = 0
- NAL_TYP = 2
-
- JAL = MAX_TYP - NAL_TYP
-
- CH_TYP(JAL+1) = 'R*EPEAT'
- CH_TYP(JAL+2) = 'J*OIN'
- JU_TYP(JAL+1) = -1
- JU_TYP(JAL+2) = -2
-
-C-- register routine header masks
- IXRHF = NA_LONG (CHRHF)
- IXRHC = NA_LONG (CHRHC)
- IXRHI = NA_LONG (CHRHI)
- IXRHA = NA_LONG (CHRHA)
-
-C-- lift the support bank ASMH
-
- CALL MQLIFT (LHASM, 0,7, JBKSMH,3)
-
- IQ(LHASM+1) = 30
- LUN_TYP = 30
-
-C-- lift the ASM banks for "FORTRAN", JASM = JFO_TYP = 1
-
- CALL ASMCREA ('FORT', JASM, 0)
- LASMT = LQ(LHASM-JASM)
-
- IQ(LASMT+5) = NA_LONG (CHEXTF)
- IQ(LASMT+6) = IXRHF
-
- IF (IXLUN(2).NE.0) THEN
- IQ(LASMT+1) = 0
- IQ(LASMT+2) = 1
- IQ(LASMT+3) = IXLUN(2)
- CALL FLINK (LUN_TYP, -1, IXLUN(2), 0)
- ENDIF
-
- IF (IXLUN(8).NE.0) THEN
- LASML = LQ(LASMT-3)
- IQ(LASML+1) = 0
- IQ(LASML+2) = 1
- IQ(LASML+3) = IXLUN(8)
- CALL FLINK (LUN_TYP, -1, IXLUN(8), 0)
- ENDIF
-
-C-- lift the ASM banks for "CC", JASM = JCC_TYP = 2
-
- CALL ASMCREA ('CC', JASM, 0)
- LASMT = LQ(LHASM-JASM)
-
- IQ(LASMT+5) = NA_LONG (CHEXTC)
- IQ(LASMT+6) = IXRHC
-
- IF (IXLUN(5).NE.0) THEN
- IQ(LASMT+1) = 0
- IQ(LASMT+2) = 1
- IQ(LASMT+3) = IXLUN(5)
- CALL FLINK (LUN_TYP, -1, IXLUN(5), 0)
- ENDIF
-
- IF (IXLUN(9).NE.0) THEN
- LASML = LQ(LASMT-3)
- IQ(LASML+1) = 0
- IQ(LASML+2) = 1
- IQ(LASML+3) = IXLUN(9)
- CALL FLINK (LUN_TYP, -1, IXLUN(9), 0)
- ENDIF
-
-C-- lift the ASM banks for "AS", JASM = JAS_TYP = 3
-
- CALL ASMCREA ('AS', JASM, 0)
- LASMT = LQ(LHASM-JASM)
-
- IQ(LASMT+5) = NA_LONG (CHEXTA)
- IQ(LASMT+6) = IXRHA
-
- IF (IXLUN(6).NE.0) THEN
- IQ(LASMT+1) = 0
- IQ(LASMT+2) = 1
- IQ(LASMT+3) = IXLUN(6)
- CALL FLINK (LUN_TYP, -1, IXLUN(6), 0)
- ENDIF
-
- IF (IXLUN(10).NE.0) THEN
- LASML = LQ(LASMT-3)
- IQ(LASML+1) = 0
- IQ(LASML+2) = 1
- IQ(LASML+3) = IXLUN(10)
- CALL FLINK (LUN_TYP, -1, IXLUN(10), 0)
- ENDIF
-
-C-- lift the ASM banks for "DATA", JASM = JDA_TYP = 4
-
- CALL ASMCREA ('DATA', JASM, 0)
- LASMT = LQ(LHASM-JASM)
-
- IQ(LASMT+5) = NA_LONG (CHEXTD)
-
- IF (IXLUN(7).NE.0) THEN
- IQ(LASMT+1) = 0
- IQ(LASMT+2) = 1
- IQ(LASMT+3) = IXLUN(7)
- CALL FLINK (LUN_TYP, -1, IXLUN(7), 0)
- ENDIF
-
- IF (IXLUN(11).NE.0) THEN
- LASML = LQ(LASMT-3)
- IQ(LASML+1) = 0
- IQ(LASML+2) = 1
- IQ(LASML+3) = IXLUN(11)
- CALL FLINK (LUN_TYP, -1, IXLUN(11), 0)
- ENDIF
-
-C-- lift the ASM banks for "SHELL", JASM = JSH_TYP = 5
-
- CALL ASMCREA ('SHELL', JASM, 0)
- LASMT = LQ(LHASM-JASM)
-
- IQ(LASMT+5) = NA_LONG (CHEXTS)
- IQ(LASMT+7) = NA_LONG ('&+')
-
-C-- lift the ASM banks for "CRAD", JASM = JCR_TYP = 6
-
- CALL ASMCREA ('CRAD', JASM, 0)
- LASMT = LQ(LHASM-JASM)
-
- IQ(LASMT+5) = NA_LONG ('.cra')
- IQ(LASMT+7) = NA_LONG ('&+')
-
-C-- lift the ASM banks for "INCL", JASM = JIN_TYP = 7
-
- CALL ASMCREA ('INCL', JASM, 0)
- LASMT = LQ(LHASM-JASM)
-
- IQ(LASMT+5) = NA_LONG (CHEXTI)
- IQ(LASMT+6) = IXRHI
-
-C---- Create standard aliases
-
- JAL = JAL - 4
- CH_TYP(JAL+1) = 'CO*MPILE'
- CH_TYP(JAL+2) = 'X*CC'
- CH_TYP(JAL+3) = 'A*S*'
- CH_TYP(JAL+4) = 'D*ATA'
-
- JU_TYP(JAL+1) = JFO_TYP
- JU_TYP(JAL+2) = JCC_TYP
- JU_TYP(JAL+3) = JAS_TYP
- JU_TYP(JAL+4) = JDA_TYP
-
- NAL_TYP = MAX_TYP - JAL
- RETURN
- END
diff --git a/src/p5boot/p5lib/asmname.f b/src/p5boot/p5lib/asmname.f
deleted file mode 100644
index a41218c..0000000
--- a/src/p5boot/p5lib/asmname.f
+++ /dev/null
@@ -1,65 +0,0 @@
-CDECK ID>, ASMNAME.
- SUBROUTINE ASMNAME (NNAME,NAME)
-
-C- Decompose NAME = type:0 into components ACT_TYP and NDV_TYP
-
- COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT,NUSLAT(2),DUMMY(34)
- PARAMETER (JFO_TYP=1, JCC_TYP=2, JAS_TYP=3, JDA_TYP=4,
- + JSH_TYP=5, JCR_TYP=6, JIN_TYP=7, MAX_TYP=100)
- CHARACTER*16 CH_TYP(MAX_TYP), ACT_TYP
- COMMON /CM_TYP/ LUN_TYP, N_TYP, NAL_TYP, NDV_TYP, JBK_TYP
- +, JU_TYP(MAX_TYP), CH_TYP, ACT_TYP
-C-------------- End CDE --------------------------------
- CHARACTER NAME*32
- DIMENSION NTRAN(4)
- DATA NTRAN / JFO_TYP, JAS_TYP, JDA_TYP, JCC_TYP /
-
-C-- Translate: 21 FORT:1 22 AS:1 23 DATA:1 24 CC:1
-C-- 31 FORT:2 32 AS:2 33 DATA:2 34 CC:2
-
- NXY = NNAME
- JOLD = ICDECI (NAME,1,NXY)
- IF (NGSLAT.NE.0) GO TO 29
- IF (JOLD.LT.21) GO TO 91
- JSTR = 1
- IF (JOLD.GE.31) THEN
- JSTR = 2
- JOLD = JOLD - 10
- ENDIF
- JOLD = JOLD - 20
- IF (JOLD.GT.4) GO TO 91
- JASM = NTRAN(JOLD)
- ACT_TYP = CH_TYP(JASM)
- NDV_TYP = JSTR
- JBK_TYP = JBK_TYP + 1
- RETURN
-
- 29 CONTINUE
- NXX = ICFIND(':', NAME,1,NXY) - 1
- IF (NXX.EQ.0) GO TO 91
- ACT_TYP = NAME(1:NXX)
-
-C-- check old format R=!
-
- IF (NXX.EQ.1) THEN
- IF (ICTYPE(ACT_TYP).LT.3) GO TO 91
- ENDIF
-
- IF (NXX.EQ.NXY) THEN
- JSTR = 0
- ELSE
- JSTR = ICDECI (NAME, NXX+2,NXY)
- IF (JSTR.GT.4) GO TO 91
- IF (NDSLAT.EQ.0) GO TO 91
- IF (NGSLAT.NE.0) GO TO 91
- ENDIF
-
- NDV_TYP = JSTR
- RETURN
-
-C-- Fault
-
- 91 CALL FAILCC (1,'Faulty logical stream name')
- NDV_TYP = -1
- RETURN
- END
diff --git a/src/p5boot/p5lib/asmuse.f b/src/p5boot/p5lib/asmuse.f
deleted file mode 100644
index f644956..0000000
--- a/src/p5boot/p5lib/asmuse.f
+++ /dev/null
@@ -1,201 +0,0 @@
-CDECK ID>, ASMUSE.
- SUBROUTINE ASMUSE
-
-C- End of blank deck of cradle, ready all ASM-streams for use
-C. started 23-jan-92
-
- PARAMETER (JFO_TYP=1, JCC_TYP=2, JAS_TYP=3, JDA_TYP=4,
- + JSH_TYP=5, JCR_TYP=6, JIN_TYP=7, MAX_TYP=100)
- CHARACTER*16 CH_TYP(MAX_TYP), ACT_TYP
- COMMON /CM_TYP/ LUN_TYP, N_TYP, NAL_TYP, NDV_TYP, JBK_TYP
- +, JU_TYP(MAX_TYP), CH_TYP, ACT_TYP
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
-C-------------- End CDE --------------------------------
- CHARACTER MSG*56
- EQUIVALENCE (MSG,SLERRM)
-
-
-C---- Resolve first level default binding
-
- JASM = 0
- 22 JASM = JASM + 1
- IF (JASM.GT.N_TYP) GO TO 31
-
- LASMT = LQ(LHASM-JASM)
- LASML = LQ(LASMT-2)
-
-C-- check stream :0 or :1 is physical
-
- JPH = 0
- IF (IQ(LASMT+1).EQ.0) GO TO 24
- JPH = 1
- IF (IQ(LASML+1).EQ.0) GO TO 24
-
-C-- default binding for ASMT
-
- IF (IQ(LASMT+1).LT.0) THEN
- IF (JASM.EQ.JFO_TYP) THEN
- MBIND = 0
- ELSEIF (JASM.LE.JCR_TYP) THEN
- MBIND = 8*JFO_TYP
- ELSEIF (JASM.EQ.JIN_TYP) THEN
- MBIND = 8*JCC_TYP
- ELSE
- MBIND = 8*JDA_TYP
- ENDIF
- IQ(LASMT+1) = MBIND
- ENDIF
-
-C-- check stream :3 is physical
-
- JPH = 3
- LASML = LQ(LASMT-4)
- IF (IQ(LASML+1).NE.0) GO TO 22
-
-C-- if streams :0 or :1 or :3 are physical:
-C- bind subsidiary logical streams
-
- 24 MBIND = 8*JASM + JPH
- 25 JPH = JPH + 1
- IF (JPH.GT.4) GO TO 22
- LASML = LQ(LASMT-JPH-1)
- IF (IQ(LASML+1).LT.0) THEN
- IQ(LASML+1) = MBIND
- GO TO 25
- ENDIF
-
- IF (JPH.EQ.2) GO TO 25
- IF (IQ(LASML+1).EQ.0) GO TO 24
- MBIND = IQ(LASML+1)
- GO TO 25
-
-C---- Resolve threading of ASMT
-
- 31 JASM = 0
- 32 JASM = JASM + 1
- IF (JASM.GT.N_TYP) GO TO 41
- LASMT = LQ(LHASM-JASM)
- MBIND = IQ(LASMT+1)
-C- = 0 if stream :0 is physical
-C- -1 if stream :1 is physical
-
- IF (MBIND.LT.0) GO TO 32
- IF (MBIND.EQ.0) THEN
- CALL ASMCRX (LASMT)
- IF (IQ(LASMT+2).EQ.3) IFMODIF= 1
- GO TO 32
- ENDIF
-
- NSTEP = 0
- 36 NSTEP = NSTEP + 1
- IF (NSTEP.GE.99) GO TO 91
- JASMU = MBIND / 8
- JDIVU = MOD (MBIND,8)
- LASMTU = LQ(LHASM-JASMU)
- IF (JDIVU.EQ.0) THEN
- LASMLU = LASMTU
- ELSE
- LASMLU = LQ(LASMTU-JDIVU-1)
- ENDIF
-
- IF (IQ(LASMLU+1).GT.0) THEN
- MBIND = IQ(LASMLU+1)
- GO TO 36
- ENDIF
-
- IQ(LASMT+1) = MBIND
- GO TO 32
-
-C---- Resolve threading of ASML
-
- 41 NUNRES = 999
- 42 NUNPRE = NUNRES
- NUNRES = 0
- JASM = 0
- 43 JASM = JASM + 1
- IF (JASM.GT.N_TYP) GO TO 59
- LASMT = LQ(LHASM-JASM)
- JDIV = 0
- 44 JDIV = JDIV + 1
- IF (JDIV.GT.4) GO TO 43
- LASML = LQ(LASMT-JDIV-1)
- IF (IQ(LASML+5).LT.0) IQ(LASML+5)= IQ(LASMT+5)
- IF (MOPUPD.NE.0) THEN
- IQ(LASML+6) = 0
- IQ(LASML+7) = 0
- ELSE
- IF (IQ(LASML+6).LT.0) IQ(LASML+6)= IQ(LASMT+6)
- IF (IQ(LASML+7).LT.0) IQ(LASML+7)= IQ(LASMT+7)
- ENDIF
-
-C-- stream is physical
-
- MBIND = IQ(LASML+1)
- IF (MBIND.EQ.0) THEN
- CALL ASMCRX (LASML)
- IF (IQ(LASML+2).EQ.3) IFMODIF= 1
- GO TO 44
- ENDIF
-
-C-- default binding
-
- IF (MBIND.LT.0) MBIND = 8*JASM
- JASMU = JASM
-
- NSTEP = 0
- 51 JASML = JASMU
- JASMU = MBIND / 8
- JDIVU = MOD (MBIND,8)
- NSTEP = NSTEP + 1
- IF (NSTEP.GE.99) GO TO 91
- LASMTU = LQ(LHASM-JASMU)
- IF (JDIVU.NE.0) GO TO 54
-
-C-- binding to stream N:0, try N:jdiv first
-
- IF (JASMU.NE.JASML) THEN
- JDIVU = JDIV
- GO TO 54
- ENDIF
-
- MBIND = IQ(LASMTU+1)
- IF (MBIND.EQ.0) GO TO 57
- GO TO 51
-
-C-- binding to stream N:i
-
- 54 LASMLU = LQ(LASMTU-JDIVU-1)
- MBIND = IQ(LASMLU+1)
- IF (MBIND.EQ.0) GO TO 57
- IF (MBIND.GT.0) GO TO 51
- NUNRES = NUNRES + 1
- GO TO 44
-
- 57 IQ(LASML+1) = 8*JASMU + JDIVU
- GO TO 44
-
- 59 IF (NUNRES.NE.0) THEN
- IF (NUNRES.LT.NUNPRE) GO TO 42
- GO TO 91
- ENDIF
-
- RETURN
-
-C------ Trouble
-
- 91 CALL ASMDUMP ('for loop in binding')
- CALL P_KILL ('loop in ASM binding')
- END
diff --git a/src/p5boot/p5lib/cccoix.f b/src/p5boot/p5lib/cccoix.f
deleted file mode 100644
index b07fbcf..0000000
--- a/src/p5boot/p5lib/cccoix.f
+++ /dev/null
@@ -1,27 +0,0 @@
-CDECK ID>, CCCOIX.
- SUBROUTINE CCCOIX (IXPARM)
-
-C- Put the comment field of the current c/line alrady stored
-C- into CCCOMF into the name-stack and return its index
-
- CHARACTER CCKORG*256, CCKARD*256, CCCOMF*256
- COMMON /CCPARA/NCHCCD,NCHCCT, JCCTYP,JCCLEV,JCCSL,MCCPAR(240)
- +, NCCPAR,MXCCIF,JCCIFV,JCCBAD,JCCWAR,ICCSUB,JCCWK(4)
- +, JCCPP,JCCPD,JCCPZ,JCCPT,JCCPIF,JCCPC,JCCPN
- +, NCCPP,NCCPD,NCCPZ,NCCPT,NCCPIF,NCCPC,NCCPN
- +, JCCEND, NCHCCC,IXCCC, CCKORG, CCKARD, CCCOMF
-C-------------- End CDE --------------------------------
-
-
- IF (NCHCCC.LT.0) CALL P_CRASH ('CCCOIX - comment field not ready')
- IF (NCHCCC.LE.0) GO TO 96
-
- IF (IXCCC.EQ.0) IXCCC= NA_LONG (CCCOMF(1:NCHCCC))
- IXPARM = IXCCC
- RETURN
-
-C-- Empty string
-
- 96 IXPARM = 0
- RETURN
- END
diff --git a/src/p5boot/p5lib/cccomg.f b/src/p5boot/p5lib/cccomg.f
deleted file mode 100644
index 0710711..0000000
--- a/src/p5boot/p5lib/cccomg.f
+++ /dev/null
@@ -1,29 +0,0 @@
-CDECK ID>, CCCOMG.
- SUBROUTINE CCCOMG (MODE)
-
-C- Get the comment field of the current c/line stored into CCCOMF
-C- MODE = 0 : as is
-C- 1 : ignore leading blanks
-
- CHARACTER CCKORG*256, CCKARD*256, CCCOMF*256
- COMMON /CCPARA/NCHCCD,NCHCCT, JCCTYP,JCCLEV,JCCSL,MCCPAR(240)
- +, NCCPAR,MXCCIF,JCCIFV,JCCBAD,JCCWAR,ICCSUB,JCCWK(4)
- +, JCCPP,JCCPD,JCCPZ,JCCPT,JCCPIF,JCCPC,JCCPN
- +, NCCPP,NCCPD,NCCPZ,NCCPT,NCCPIF,NCCPC,NCCPN
- +, JCCEND, NCHCCC,IXCCC, CCKORG, CCKARD, CCCOMF
-C-------------- End CDE --------------------------------
-
-
- CCCOMF = ' '
- IXCCC = 0
- JTK = NCHCCD + 1
- IF (MODE.NE.0) JTK = ICFNBL (CCKARD,JTK,NCHCCT)
-
- NCHCCC = NCHCCT+1 - JTK
- NCHCCC = MAX (NCHCCC,0)
- IF (NCHCCC.EQ.0) RETURN
-
- CCCOMF(1:NCHCCC)= CCKARD(JTK:JTK+NCHCCC-1)
- NCHCCC = LNBLNK(CCCOMF(1:NCHCCC))
- RETURN
- END
diff --git a/src/p5boot/p5lib/cccrak.f b/src/p5boot/p5lib/cccrak.f
deleted file mode 100644
index 538a442..0000000
--- a/src/p5boot/p5lib/cccrak.f
+++ /dev/null
@@ -1,33 +0,0 @@
-CDECK ID>, CCCRAK.
- SUBROUTINE CCCRAK (LUNDES)
-
-C- The comment field of the current c/line is a file-name,
-C- krack it and store its name index into IXCCC
-C- LUNDES is the file type for FLKRAK
-C- = 1 cradle, 2 PAM, 4 print, 5 Fortran, 6 ASM write, 7 ASM read-write
-
-C- CCCOMG must have been called first
-
- COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT,NUSLAT(2),DUMMY(34)
- CHARACTER CCKORG*256, CCKARD*256, CCCOMF*256
- COMMON /CCPARA/NCHCCD,NCHCCT, JCCTYP,JCCLEV,JCCSL,MCCPAR(240)
- +, NCCPAR,MXCCIF,JCCIFV,JCCBAD,JCCWAR,ICCSUB,JCCWK(4)
- +, JCCPP,JCCPD,JCCPZ,JCCPT,JCCPIF,JCCPC,JCCPN
- +, NCCPP,NCCPD,NCCPZ,NCCPT,NCCPIF,NCCPC,NCCPN
- +, JCCEND, NCHCCC,IXCCC, CCKORG, CCKARD, CCCOMF
- PARAMETER (NSLIFI=128)
- CHARACTER CHLIFI*(NSLIFI), CHLIEX*8
- COMMON /FLINKC/LUNOP,LUNFD,LUNOLD,LUNSIZ
- +, IXFLUN, NLIFI,CHLIFI,CHLIEX
-C-------------- End CDE --------------------------------
-
-
- IF (NCHCCC.EQ.0) RETURN
-
- CALL FLKRAK (1,LUNDES)
- IXCCC = IXFLUN
-
- CALL NA_GET (IXFLUN,CCCOMF,1)
- NCHCCC = NDSLAT
- RETURN
- END
diff --git a/src/p5boot/p5lib/ccdopt.f b/src/p5boot/p5lib/ccdopt.f
deleted file mode 100644
index e3fd0e0..0000000
--- a/src/p5boot/p5lib/ccdopt.f
+++ /dev/null
@@ -1,71 +0,0 @@
-CDECK ID>, CCDOPT.
- SUBROUTINE CCDOPT (LOOK, JTYPE)
-
-C- Handle T= parameters on current +PATCH or +DECK c/l
-C- on entry: LOOK = 0 do not create new data-types
-C- 1 normal operation
-C- return: JTYPE = data type 1,2,3,... FORT, CC, ASL, ...
-C- zero if not specified
-C- MCCPAR(JCCPT+2): bit 1 if T=REPEAT
-C- 2 if T=JOIN
-C- NDSLAT = zero if no error
-
- COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT,NUSLAT(2),DUMMY(34)
- CHARACTER CCKORG*256, CCKARD*256, CCCOMF*256
- COMMON /CCPARA/NCHCCD,NCHCCT, JCCTYP,JCCLEV,JCCSL,MCCPAR(240)
- +, NCCPAR,MXCCIF,JCCIFV,JCCBAD,JCCWAR,ICCSUB,JCCWK(4)
- +, JCCPP,JCCPD,JCCPZ,JCCPT,JCCPIF,JCCPC,JCCPN
- +, NCCPP,NCCPD,NCCPZ,NCCPT,NCCPIF,NCCPC,NCCPN
- +, JCCEND, NCHCCC,IXCCC, CCKORG, CCKARD, CCCOMF
- PARAMETER (JFO_TYP=1, JCC_TYP=2, JAS_TYP=3, JDA_TYP=4,
- + JSH_TYP=5, JCR_TYP=6, JIN_TYP=7, MAX_TYP=100)
- CHARACTER*16 CH_TYP(MAX_TYP), ACT_TYP
- COMMON /CM_TYP/ LUN_TYP, N_TYP, NAL_TYP, NDV_TYP, JBK_TYP
- +, JU_TYP(MAX_TYP), CH_TYP, ACT_TYP
-C-------------- End CDE --------------------------------
-
- IOR (IZV,IZW) = OR (IZV, IZW)
-
-
- NFAI = 0
- JASM = 0
- IF (NCCPT.EQ.0) GO TO 99
- MSK = 0
- LOC = JCCPT
- NTH = NCCPT
- 24 LOC = LOC + 3
- JXX = MCCPAR(LOC+1)
- NXX = MCCPAR(LOC+2)
- NXX = MIN (NXX, 16)
- CALL ASMFIND (CCKARD(JXX:JXX+NXX-1), JF)
-
- J = JF
- IF (J.EQ.0) THEN
- IF (LOOK.EQ.0) GO TO 27
- CALL ASMCREA (CCKARD(JXX:JXX+NXX-1), J, 1)
- ENDIF
-
- IF (J.LT.0) THEN
- MSK = IOR (MSK, -J)
- GO TO 27
- ENDIF
-
- IF (JASM.EQ.0) GO TO 26
-
-C-- accept: T=DATA, INCL (DATA for p4, INCL for p5 if declared)
-
- IF (JF .EQ.0) GO TO 25
- IF (JASM.GT.4) GO TO 25
- IF (J .GT.4) GO TO 26
- 25 NFAI = NFAI + 1
- GO TO 27
-
- 26 JASM = J
- 27 NTH = NTH - 1
- IF (NTH.GT.0) GO TO 24
-
- MCCPAR(JCCPT+2) = MSK
- 99 NDSLAT = NFAI
- JTYPE = JASM
- RETURN
- END
diff --git a/src/p5boot/p5lib/cciflv.f b/src/p5boot/p5lib/cciflv.f
deleted file mode 100644
index bd7d6a3..0000000
--- a/src/p5boot/p5lib/cciflv.f
+++ /dev/null
@@ -1,30 +0,0 @@
-CDECK ID>, CCIFLV.
- SUBROUTINE CCIFLV
-
-C-- Count the underscores of +___IF, IFNOT, ELSE, ENDIF
-C- of the last line handled by CCKRAK
-
- CHARACTER CCKORG*256, CCKARD*256, CCCOMF*256
- COMMON /CCPARA/NCHCCD,NCHCCT, JCCTYP,JCCLEV,JCCSL,MCCPAR(240)
- +, NCCPAR,MXCCIF,JCCIFV,JCCBAD,JCCWAR,ICCSUB,JCCWK(4)
- +, JCCPP,JCCPD,JCCPZ,JCCPT,JCCPIF,JCCPC,JCCPN
- +, NCCPP,NCCPD,NCCPZ,NCCPT,NCCPIF,NCCPC,NCCPN
- +, JCCEND, NCHCCC,IXCCC, CCKORG, CCKARD, CCCOMF
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
-C-------------- End CDE --------------------------------
-
-
- JTX = MLIAD(JCCSL)
- JNU = JTX
- 24 JNU = JNU + 1
- IF (TEXT(JNU).EQ.'_') GO TO 24
- JCCLEV = JNU - JTX - 1
- RETURN
- END
diff --git a/src/p5boot/p5lib/ccjoin.f b/src/p5boot/p5lib/ccjoin.f
deleted file mode 100644
index 4fb9119..0000000
--- a/src/p5boot/p5lib/ccjoin.f
+++ /dev/null
@@ -1,33 +0,0 @@
-CDECK ID>, CCJOIN.
- SUBROUTINE CCJOIN
-
-C- Check T=JOIN is present on current control line
-
- CHARACTER CCKORG*256, CCKARD*256, CCCOMF*256
- COMMON /CCPARA/NCHCCD,NCHCCT, JCCTYP,JCCLEV,JCCSL,MCCPAR(240)
- +, NCCPAR,MXCCIF,JCCIFV,JCCBAD,JCCWAR,ICCSUB,JCCWK(4)
- +, JCCPP,JCCPD,JCCPZ,JCCPT,JCCPIF,JCCPC,JCCPN
- +, NCCPP,NCCPD,NCCPZ,NCCPT,NCCPIF,NCCPC,NCCPN
- +, JCCEND, NCHCCC,IXCCC, CCKORG, CCKARD, CCCOMF
- COMMON /QPAGE/ NQLMAX,NQLTOL,NQLTOK,NQCMAX,NQCPGH,NQPAGE
- +, NQWYLDO,NQWYL,NQNEWH,NQJOIN,NQDKNO,NQDKPG
-C-------------- End CDE --------------------------------
-
-
- IF (NQJOIN.LT.0) RETURN
- NQJOIN = 0
- IF (NCCPT.EQ.0) RETURN
- LOC = JCCPT
- NTH = NCCPT
- 24 LOC = LOC + 3
- JXX = MCCPAR(LOC+1)
- NXX = MCCPAR(LOC+2)
- J = ICNTH (CCKARD(JXX:JXX+NXX-1),'J*OIN ',1)
- IF (J.NE.0) GO TO 27
- NTH = NTH - 1
- IF (NTH.GT.0) GO TO 24
- RETURN
-
- 27 NQJOIN = 1
- RETURN
- END
diff --git a/src/p5boot/p5lib/cckrak.f b/src/p5boot/p5lib/cckrak.f
deleted file mode 100644
index b435f37..0000000
--- a/src/p5boot/p5lib/cckrak.f
+++ /dev/null
@@ -1,464 +0,0 @@
-CDECK ID>, CCKRAK.
- SUBROUTINE CCKRAK (JSLOT)
-
-C- Analyse control-card into parameter-list & index
-
- COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT,NUSLAT(2),DUMMY(34)
- PARAMETER (KM1=1,KM2=2,KM3=4,KM4=8,KM5=16,KM6=32,KM7=64,KM8=128,
- + KM9=256, KM10=512, KM11=1024, KM12=2048, KM13=4096, KM14=8192,
- + KM15=16384, KM16=32768, KM17=65536, KM18=131072, KM19=262144)
- CHARACTER CQBLAN*128, CQEQS*128, CQCETA*32
- CHARACTER CQAPO*1, CQBSL*1, CQTAB*1
- COMMON /QCHAR/ CQBLAN, CQEQS, CQCETA, CQAPO, CQBSL, CQTAB
- COMMON /LUNSLN/IFLAUX, IXLUN(12)
- PARAMETER (JSPSEQ1=3, JSPDATE=9, JSPSEQL=15)
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
- PARAMETER (MCCNIL=1, MCCKIL=2, MCCINC=3, MCCCDE=4, MCCSEQ=5,
- + MCCXSQ=6, MCCTRU=7, MCCFAL=8, MCCELS=9, MCCEND=10,
- + MCCSEL=11, MCCSES=12, MCCFAU=13, MCCSKI=14,
- + MCCKEE=15, MCCDEL=16, MCCREP=17, MCCADB=18, MCCADD=19,
- + MCCUSE=20, MCCXDI=21, MCCDIV=22, MCCLIS=23, MCCEXE=24, MCCIMI=25,
- + MCCASM=26, MCCUPD=27, MCCNAM=28, MCCGAP=29, MCCMOR=30, MCCONL=31,
- + MCCFOR=32, MCCSUS=33, MCCOPT=34, MCCOP2=35, MCCSHO=36, MCCPAM=37,
- + MCCQUI=38, MCCEOD=39, MCCDEC=40, MCCPAT=41, MCCTIT=42)
- CHARACTER CCKORG*256, CCKARD*256, CCCOMF*256
- COMMON /CCPARA/NCHCCD,NCHCCT, JCCTYP,JCCLEV,JCCSL,MCCPAR(240)
- +, NCCPAR,MXCCIF,JCCIFV,JCCBAD,JCCWAR,ICCSUB,JCCWK(4)
- +, JCCPP,JCCPD,JCCPZ,JCCPT,JCCPIF,JCCPC,JCCPN
- +, NCCPP,NCCPD,NCCPZ,NCCPT,NCCPIF,NCCPC,NCCPN
- +, JCCEND, NCHCCC,IXCCC, CCKORG, CCKARD, CCCOMF
-C-------------- End CDE --------------------------------
- CHARACTER CCOL(256)*1
- EQUIVALENCE (CCOL,CCKARD)
-
- DIMENSION JVECT(7), NVECT(7)
- EQUIVALENCE (JVECT(1),JCCPP), (NVECT(1),NCCPP)
- EQUIVALENCE (LSEP,JCCWK(1)), (IFSEEN,JCCWK(2)), (MSEEN,JCCWK(3))
-
- CHARACTER*7 MSEPS, MSEP2
- PARAMETER (MSEP2 = 'SRFX&LN')
- PARAMETER (MSEPS = 'PDZTICN')
-C- 1234567
-C- 136
-C- 1248624
-
- PARAMETER (NTYPES=42)
- DIMENSION MCXDEF(NTYPES), MCXMUS(NTYPES)
- +, MCXMAY(NTYPES), MCXMUL(NTYPES)
-
-C. translated by table_cctype
-C. default key must may mult def must may mult
-C. 04 +NIL MCCNIL=01 - - - - 0 0 0 0
-C. 39 +KILL MCCKIL=02 I - - I 5 0 16 16
-C. 05 +INC MCCINC=03 Z Z T IZ 3 4 28 28
-C. 01 +CDE MCCCDE=04 Z Z T I 3 4 28 24
-C. 02 +SEQ MCCSEQ=05 Z Z T I 3 4 28 24
-C. \40 MCCXSQ=06 - - - - 0 0 0 0
-C. |06 +IF, MCCTRU=07 I I - I 5 16 16 16
-C. 07 +IFNOT MCCFAL=08 I I - I 5 16 16 16
-C. 08 +ELSE MCCELS=09 I - - I 5 0 16 16
-C. 09 +ENDIF MCCEND=10 - - - - 0 0 0 0
-C. 03 +SELF |MCCSEL=11 Z - T IZ 3 0 28 28
-C. 41 MCCSES=12 Z - T IZ 3 0 28 28
-C. 42 MCCFAU=13 - - - - 0 0 0 0
-C. 19 +SKIP MCCSKI=14 - - - I 0 0 16 16
-C. |10 +KEEP |MCCKEE=15 Z Z PDT I 3 4 31 24
-C. 14 +DEL MCCDEL=16 P C D IC 1 32 51 48
-C. 11 +REPL MCCREP=17 P C DZ IZ 1 32 55 20
-C. 13 +ADBEF MCCADB=18 P C DZ IZ 1 32 55 20
-C. 12 +ADD MCCADD=19 P C DZ IZ 1 32 55 20
-C. |20 +USE MCCUSE=20 P - T IPD 1 0 27 27
-C. 24 +XDIV MCCXDI=21 P - T IPD 1 0 27 27
-C. 23 +DIV MCCDIV=22 P - T IPD 1 0 27 27
-C. 22 +LIST MCCLIS=23 P - T IPD 1 0 27 27
-C. 21 +EXE MCCEXE=24 P - T IPD 1 0 27 27
-C. 25 +IMITAT MCCIMI=25 P P - IP 1 1 17 17
-C. |29 +ASM MCCASM=26 D D PTC ID 2 2 59 26
-C. 35 +UPDATE MCCUPD=27 - - - - 0 0 0 0
-C. |33 +NAMES MCCNAM=28 N N - N 7 64 64 64
-C. 34 +GAP MCCGAP=29 N N - N 7 64 64 64
-C. 36 +MORE MCCMOR=30 - - - - 0 0 0 0
-C. 30 +ONLY MCCONL=31 F F - IF 3 4 20 20
-C. 31 +FORCE MCCFOR=32 T T - I 4 8 24 24
-C. 32 +SUPEND MCCSUS=33 T T - I 4 8 24 24
-C. |26 +OPTION MCCOPT=34 T - - I 4 0 24 24
-C. 27 +PARAM MCCOP2=35 T TN - IN 4 72 88 88
-C. 28 +SHOW MCCSHO=36 T - - I 4 0 24 24
-C. |37 +PAM MCCPAM=37 L - RTN IN 6 0 122 88
-C. 38 +QUIT MCCQUI=38 - - - I 0 0 16 16
-C. 18 +EOD MCCEOD=39 - - - - 0 0 0 0
-C. |15 +DECK MCCDEC=40 D D PT I 2 2 27 24
-C. 16 +PATCH MCCPAT=41 P P T I 1 1 25 24
-C. 17 +TITLE MCCTIT=42 - - - - 0 0 0 0
-
-C- 1 2 3 4 5 6 7 8 9 10
-
- DATA MCXDEF / 0, 5, 3, 3, 3, 0, 5, 5, 5, 0
- +, 3, 3, 0, 0, 3, 1, 1, 1, 1, 1
- +, 1, 1, 1, 1, 1, 2, 0, 7, 7, 0
- +, 3, 4, 4, 4, 4, 4, 6, 0, 0, 2
- +, 1, 0 /
-
- DATA MCXMUS / 0, 0, 4, 4, 4, 0, 16, 16, 0, 0
- +, 0, 0, 0, 0, 4, 32, 32, 32, 32, 0
- +, 0, 0, 0, 0, 1, 2, 0, 64, 64, 0
- +, 4, 8, 8, 0, 72, 0, 0, 0, 0, 2
- +, 1, 0 /
-
- DATA MCXMAY / 0, 16, 28, 28, 28, 0, 16, 16, 16, 0
- +, 28, 28, 0, 16, 31, 51, 55, 55, 55, 27
- +, 27, 27, 27, 27, 17, 59, 0, 64, 64, 0
- +, 20, 24, 24, 24, 88, 24, 122, 16, 0, 27
- +, 25, 0 /
-
- DATA MCXMUL / 0, 16, 28, 24, 24, 0, 16, 16, 16, 0
- +, 28, 28, 0, 16, 24, 48, 20, 20, 20, 27
- +, 27, 27, 27, 27, 17, 26, 0, 64, 64, 0
- +, 20, 24, 24, 24, 88, 24, 88, 16, 0, 24
- +, 24, 0 /
-
- IAND (IZV,IZW) = AND (IZV, IZW)
- IOR (IZV,IZW) = OR (IZV, IZW)
-
- CALL VZERO (NCCPAR,24)
- LOC = 4
-
-C---- Copy control-line and find useful length
-
- JCCSL = JSLOT
- JTX = MLIAD(JCCSL)
- NCHCCT = MLIAD(JCCSL+1) - JTX - NCHNEWL
- CALL CCOPYL (TEXT(JTX),CCKORG,NCHCCT)
-
-C-- environment variable substitution
-
- IF (INCRAD.EQ.0) GO TO 18
- IF (INDEX(CCKORG(1:NCHCCT),'${').EQ.0) GO TO 18
- CALL CENVIR (TEXT(JTX),NCHCCT, CCKORG,1,LEN(CCKORG), 7)
- NCHCCT = NESLAT - 1
- ICCSUB = NGSLAT
-
- 18 CCKORG(NCHCCT+1:NCHCCT+2) = ' '
- NCHCCT = LNBLNK (CCKORG(1:NCHCCT))
- CCKARD(1:NCHCCT+2) = CCKORG(1:NCHCCT+2)
- IF (JCCTYP.EQ.MCCTIT) RETURN
- IF (JCCTYP.EQ.MCCNIL) RETURN
-
-C-- check terminating dot is obscured
-
- NCHCCC = -1
- NCHCCD = ICFIND ('.',CCKARD,5,NCHCCT)
- IF (NCHCCD.LT.NCHCCT) THEN
- IF (CCKARD(NCHCCD+1:NCHCCD+2).NE.' ') THEN
- IF (CCKARD(NCHCCD-2:NCHCCD-1).NE.' ') THEN
- IF (CCKARD(NCHCCD-1:NCHCCD+1).NE.' . ') JCCWAR=1
- ENDIF
- ENDIF
- ENDIF
-
- CALL CLEFT (CCKARD,1,NCHCCD-1)
- NCHU = NDSLAT
- CALL CLTOU (CCKARD(1:NCHU))
-
- 19 IF (CCOL(NCHU).EQ.',') THEN
- JCCWAR = 2
- NCHU = NCHU - 1
- GO TO 19
- ENDIF
-
- IFLERR = 0
- IFLACT = 0
- IF (JCCTYP.GE.MCCDEL .AND. JCCTYP.LE.MCCADD) IFLACT= 1
-
-C----------- Read next parameter
-
- JCOM = ICFIND (',',CCKARD,4,NCHU)
- IF (JCOM.GE.NCHU) GO TO 51
-
- JEQU = ICFIND ('=',CCKARD,JCOM,NCHU)
- JMIN = ICFIND ('-',CCKARD,JCOM,NCHU)
-
- 21 JGO = JCOM + 1
- JCOM = ICFIND (',',CCKARD,JGO,NCHU)
- MCCPAR(LOC) = 1
-
- IF (JEQU.EQ.JGO) GO TO 96
- IF (JEQU.LT.JCOM) GO TO 24
-
- 22 NEGAT = 0
- IF (JGO.GT.NCHU) GO TO 30
- IF (JGO.EQ.JMIN) THEN
- JGO = JGO + 1
- JMIN = ICFIND ('-',CCKARD,JGO,NCHU)
- IF (JMIN.LT.JCOM) GO TO 96
- NEGAT = -1
- ENDIF
-
- JEND = MIN (JCOM,JMIN)
- NCU = JEND - JGO
- GO TO 31
-
-C---- Parameter key seen
-
- 24 JSEP = INDEX (MSEPS,CCOL(JGO))
- IF (JSEP.EQ.0) JSEP= INDEX (MSEP2,CCOL(JGO))
- IF (JSEP.EQ.0) GO TO 96
-
- JGO = JEQU + 1
- JEQU = ICFIND ('=',CCKARD,JGO,NCHU)
- IF (JEQU.LT.JCOM) GO TO 96
-
- IF (JVECT(JSEP).NE.0) GO TO 27
- IF (IFSEEN.NE.0) GO TO 96
- IF (JSEP.EQ.5) IFSEEN= 7
- LSEP = JSEP
- JVECT(JSEP) = LOC
- IF (JSEP.EQ.4) THEN
- MCCPAR(LOC) = 5
- MCCPAR(LOC+1) = 0
- MCCPAR(LOC+2) = 0
- LOC = LOC + 3
- ENDIF
- 26 MCCPAR(LOC) = JSEP + 1
- GO TO 22
-
-C-- Same key again
-
- 27 IF (JSEP.NE.LSEP) THEN
- IFLERR = 7
- GO TO 22
- ENDIF
- IF (JSEP.NE.5) GO TO 22
- GO TO 26
-
-C----------- Digest current parameter
-
- 30 JEND = JGO
- NCU = 0
-
- 31 IF (LSEP.NE.0) GO TO 41
-
-C-- First parameter without parameter-key
-
- IF (IFLACT.NE.0) GO TO 33
- IF (NCU.EQ.0) GO TO 96
- JSEP = MCXDEF(JCCTYP)
- IF (JSEP.EQ.0) THEN
- IFLERR = 7
- JSEP = 1
- ENDIF
- IF (JSEP.NE.5) GO TO 36
- IFSEEN = 7
- GO TO 36
-
-C-- Action card with implicite parameter-key
-
- 33 JSEP = IFLACT
- IF (JSEP.EQ.3) GO TO 35
- IFLACT = IFLACT + 1
- IF (NCU.EQ.0) GO TO 49
- GO TO 37
-
- 35 IF (NCU.EQ.0) GO TO 49
- JSEP = 6
-
- 36 LSEP = JSEP
- 37 JVECT(JSEP) = LOC
- IF (JSEP.EQ.4) THEN
- MCCPAR(LOC) = 5
- MCCPAR(LOC+1) = 0
- MCCPAR(LOC+2) = 0
- LOC = LOC + 3
- ENDIF
- MCCPAR(LOC) = JSEP + 1
- GO TO 42
-
-C----- Normal parameter processing
-
- 41 JSEP = LSEP
- 42 IF (JSEP.LT.6) GO TO 46
-
-C-- Store numeric parameter value
-
- IF (NCU.EQ.0) GO TO 96
- NUM = ICDECI (CCKARD,JGO,JEND-1)
- IF (NGSLAT.NE.0) GO TO 96
- IF (NEGAT.NE.0) THEN
- IF (JSEP.NE.7) GO TO 96
- NUM = -NUM
- ENDIF
-
- MCCPAR(LOC+1) = NUM
- MCCPAR(LOC+2) = NUM
- IF (JEND.NE.JMIN) GO TO 48
- IF (JMIN.GT.NCHU) GO TO 48
-
- JGO = JEND + 1
- JMIN = ICFIND ('-',CCKARD,JGO,NCHU)
- IF (JMIN.LT.JCOM) GO TO 96
-
- NUM2 = ICDECI (CCKARD,JGO,JCOM-1)
- IF (NGSLAT.NE.0) GO TO 96
- MCCPAR(LOC+2) = NUM2
- IF (NUM2.LT.NUM) GO TO 96
- GO TO 48
-
-C-- Store text parameter value
-
- 46 IF (NCU.NE.0) GO TO 47
- IF (JSEP.EQ.1) THEN
- IF (JCCTYP.EQ.MCCASM) GO TO 47
- IF (JCCTYP.EQ.MCCUSE) GO TO 47
- ELSEIF (JSEP.EQ.2) THEN
- IF (JCCTYP.NE.MCCDEC) GO TO 47
- ENDIF
- GO TO 96
-
- 47 IF (JSEP.NE.4) THEN
- IXNAME = NA_NEW (CCKARD,JGO,JEND)
- MCCPAR(LOC+1) = IXNAME
- MCCPAR(LOC+2) = IXNAME
- ELSE
- MCCPAR(LOC+1) = JGO
- MCCPAR(LOC+2) = NCU
- ENDIF
-
- IF (NEGAT.NE.0) THEN
- IF (JSEP.NE.5) GO TO 96
- MCCPAR(LOC) = -MCCPAR(LOC)
- ENDIF
-
- 48 NCCPAR = NCCPAR + 1
- NVECT(JSEP) = NVECT(JSEP) + 1
- LOC = LOC + 3
- 49 IF (JCOM.LT.NCHU) GO TO 21
-
-C------ Analysis finished
-
- 51 JGO = NCHU + 1
- MCCPAR(LOC) = 0
- JCCEND = LOC
- IF (IFLERR.NE.0) GO TO 94
-
-C-- Compress values for TYPE=...
-
- MVALT = 0
- IF (NCCPT.EQ.0) GO TO 56
- IF (JCCTYP.EQ.MCCPAT) GO TO 56
- IF (JCCTYP.EQ.MCCDEC) GO TO 56
- LOC = JCCPT
- NTH = NCCPT
- 52 IF (NTH.GT.0) THEN
- LOC = LOC + 3
- JXX = MCCPAR(LOC+1)
- J = INDEX (CQCETA(1:32),CCOL(JXX))
- IF (J.NE.0) CALL SBIT1 (MVALT,J)
- NTH = NTH - 1
- GO TO 52
- ENDIF
- MCCPAR(JCCPT+1)= MVALT
- MCCPAR(JCCPT+2)= MVALT
-
-C-- Check parameters which may or must be present, may be multiple
-
- 56 MUST = MCXMUS(JCCTYP)
- MMAY = MCXMAY(JCCTYP)
- MULT = MCXMUL(JCCTYP)
-
- MSEEN = 0
- MSEMU = 0
- IONE = 1
-
- DO 57 J=1,7
- IF (NVECT(J).NE.0) THEN
- MSEEN = MSEEN + IONE
- IF (NVECT(J).GE.2) MSEMU = MSEMU + IONE
- ENDIF
- 57 IONE = 2*IONE
-
- IF (IAND(MSEEN, MUST) .NE.MUST) GO TO 91
- IF (IAND(MSEEN, NOT(MMAY)).NE.0) GO TO 63
- IF (IAND(MSEMU, NOT(MULT)).NE.0) GO TO 63
-
-C-- Check for Action lines, fix for +ADD
-
- IF (IFLACT.EQ.0) GO TO 59
- NUM = MCCPAR(JCCPC+1)
-
- IF (JCCTYP.EQ.MCCADD) THEN
- MCCPAR(JCCPC+1) = NUM + 1
- ELSEIF (JCCTYP.EQ.MCCADB) THEN
- IF (NUM.EQ.0) GO TO 96
- ENDIF
-
- 59 RETURN
-
-C-- check legal parameters on special +CDE, +SEQ or +SELF
-
-C- PARAMETER (MSEP2 = 'SRFX&LN')
-C- PARAMETER (MSEPS = 'PDZTICN')
-C- 1234567
-
- 63 IF (JCCTYP.LT.MCCCDE) GO TO 94
- IF (JCCTYP.GT.MCCSEQ) THEN
- IF (JCCTYP.LT.MCCSEL) GO TO 94
- IF (JCCTYP.GT.MCCSES) GO TO 94
- IF (NCCPZ.EQ.0) GO TO 94
- ENDIF
- JC = JCCPZ
- DO 67 JL=1,NCCPZ
- JREL = MCCPAR(JC+1) - JSPSEQ1
- IF (JREL.LT.0) JREL= 99
- MMAYX = MMAY
- MULTX = MULT
-
- IF (JREL.GE.12) THEN
- MULTX= IOR (MULTX, KM3)
- ELSEIF (JREL.GE.10) THEN
- MMAYX= IOR (MMAYX, KM1)
- ELSEIF (JREL.GE.4) THEN
- MMAYX= IOR (MMAYX, KM1+KM6+KM7)
- ELSEIF (JREL.GE.1) THEN
- MMAYX= IOR (MMAYX, KM7)
- ELSE
- MMAYX= IOR (MMAYX, KM2)
- ENDIF
-
- IF (IAND(MSEEN, NOT(MMAYX)).NE.0) GO TO 94
- IF (IAND(MSEMU, NOT(MULTX)).NE.0) GO TO 94
- 67 JC = JC + 3
- GO TO 59
-
-C---- Missing parameter, allowed only on +SEQ, T=DUMMY
-
- 91 IF (JCCTYP.LT.MCCCDE) GO TO 94
- IF (JCCTYP.GT.MCCSEQ) THEN
- IF (JCCTYP.NE.MCCKEE) GO TO 94
- ENDIF
- IF (IAND(MVALT,KM4).NE.0) GO TO 59
-
-C---- Faulty c/line, for good syntax but unexpected
-C-- or missing parameter give no error in c/line
-C-- is IF de-selected
-
- 94 IF (IFLAUX.EQ.0) THEN
- CALL CCPROC
- IF (JCCIFV.NE.0) RETURN
- ENDIF
-
- 96 JCCBAD = JGO
- RETURN
- END
diff --git a/src/p5boot/p5lib/ccopt.f b/src/p5boot/p5lib/ccopt.f
deleted file mode 100644
index 3f331c6..0000000
--- a/src/p5boot/p5lib/ccopt.f
+++ /dev/null
@@ -1,36 +0,0 @@
-CDECK ID>, CCOPT.
- SUBROUTINE CCOPT (POSS,NPOSS)
-
-C- Check T=opt parameters on current control line
-
- CHARACTER CCKORG*256, CCKARD*256, CCCOMF*256
- COMMON /CCPARA/NCHCCD,NCHCCT, JCCTYP,JCCLEV,JCCSL,MCCPAR(240)
- +, NCCPAR,MXCCIF,JCCIFV,JCCBAD,JCCWAR,ICCSUB,JCCWK(4)
- +, JCCPP,JCCPD,JCCPZ,JCCPT,JCCPIF,JCCPC,JCCPN
- +, NCCPP,NCCPD,NCCPZ,NCCPT,NCCPIF,NCCPC,NCCPN
- +, JCCEND, NCHCCC,IXCCC, CCKORG, CCKARD, CCCOMF
-C-------------- End CDE --------------------------------
- CHARACTER POSS(NPOSS)*(*)
-
-
- IF (NCCPT.EQ.0) RETURN
- MM = 0
- LOC = JCCPT
- NTH = NCCPT
- 24 LOC = LOC + 3
- JXX = MCCPAR(LOC+1)
- NXX = MCCPAR(LOC+2)
- J = ICNTH (CCKARD(JXX:JXX+NXX-1),POSS,NPOSS)
- IF (J.EQ.0) GO TO 96
- CALL SBIT1 (MM,J)
- NTH = NTH - 1
- IF (NTH.GT.0) GO TO 24
-
- 27 MCCPAR(JCCPT+2)= MM
- RETURN
-
-C-- Fault
-
- 96 JCCBAD = JXX
- RETURN
- END
diff --git a/src/p5boot/p5lib/ccproc.f b/src/p5boot/p5lib/ccproc.f
deleted file mode 100644
index d66b44c..0000000
--- a/src/p5boot/p5lib/ccproc.f
+++ /dev/null
@@ -1,75 +0,0 @@
-CDECK ID>, CCPROC.
- SUBROUTINE CCPROC
-
-C- Finish control-card processing of CCKRAK for PATCHY
-
- PARAMETER (KM1=1,KM2=2,KM3=4,KM4=8,KM5=16,KM6=32,KM7=64,KM8=128,
- + KM9=256, KM10=512, KM11=1024, KM12=2048, KM13=4096, KM14=8192,
- + KM15=16384, KM16=32768, KM17=65536, KM18=131072, KM19=262144)
- PARAMETER (KQGARB=1,KQARRV=3,KQKEEP=4,KQPREP=5,KQMAIN=6,KQPAST=8)
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
- CHARACTER CCKORG*256, CCKARD*256, CCCOMF*256
- COMMON /CCPARA/NCHCCD,NCHCCT, JCCTYP,JCCLEV,JCCSL,MCCPAR(240)
- +, NCCPAR,MXCCIF,JCCIFV,JCCBAD,JCCWAR,ICCSUB,JCCWK(4)
- +, JCCPP,JCCPD,JCCPZ,JCCPT,JCCPIF,JCCPC,JCCPN
- +, NCCPP,NCCPD,NCCPZ,NCCPT,NCCPIF,NCCPC,NCCPN
- +, JCCEND, NCHCCC,IXCCC, CCKORG, CCKARD, CCCOMF
-C-------------- End CDE --------------------------------
-
- IAND (IZV,IZW) = AND (IZV, IZW)
- IOR (IZV,IZW) = OR (IZV, IZW)
-
-C---- Evaluate truth-value and EXE-bits for IF-parameters
-
- IF (NCCPIF.EQ.0) RETURN
- IF (MOPUPD.NE.0) RETURN
- LQ(LLPAST-1) = LQPAST
- MEXEB = 0
- MTRUE = KM5
- LS = JCCPIF
- JSEP = MCCPAR(LS)
-
-C-- Start new AND-group
-
- 21 MLTRU = 0
-
-C-- Next parameter
-
- 22 LPU = KQFIND (MCCPAR(LS+1),2,KQMAIN,NVUTY(1))
- IF (LPU.EQ.0) THEN
- CALL CREAPD (MCCPAR(LS+1),-1,-1)
- LPU = LCRP
- ENDIF
-
- IQ(LPU+1) = IOR (IQ(LPU+1), KM6)
- MXUS = IQ(LPU)
- MEXEB = IOR (MEXEB, MXUS)
-
- IF (JSEP.LT.0) MXUS= NOT(MXUS)
- MLTRU = IOR(MLTRU, MXUS)
-
- LS = LS + 3
- JSEP = MCCPAR(LS)
- IF (IABS(JSEP).EQ.1) GO TO 22
- MTRUE = IAND(MTRUE, MLTRU)
- IF (JSEP.NE.0) GO TO 21
-
-C-- Finished
-
- MXCCIF = IAND (MEXEB,15)
- IF (IAND(MTRUE,KM5).EQ.0) JCCIFV= 1
- RETURN
- END
diff --git a/src/p5boot/p5lib/chdeck.f b/src/p5boot/p5lib/chdeck.f
deleted file mode 100644
index 55c19db..0000000
--- a/src/p5boot/p5lib/chdeck.f
+++ /dev/null
@@ -1,169 +0,0 @@
-CDECK ID>, CHDECK.
- SUBROUTINE CHDECK
-
-C- Check all decks until next +TITLE
-C. started 12-jan-94
-
- CHARACTER SLLINE*512, SLERRM*256
- COMMON /SLATLN/ SLLINE, SLERRM
- PARAMETER (KM1=1,KM2=2,KM3=4,KM4=8,KM5=16,KM6=32,KM7=64,KM8=128,
- + KM9=256, KM10=512, KM11=1024, KM12=2048, KM13=4096, KM14=8192,
- + KM15=16384, KM16=32768, KM17=65536, KM18=131072, KM19=262144)
- COMMON /QPAGE/ NQLMAX,NQLTOL,NQLTOK,NQCMAX,NQCPGH,NQPAGE
- +, NQWYLDO,NQWYL,NQNEWH,NQJOIN,NQDKNO,NQDKPG
- PARAMETER (MCCNIL=1, MCCKIL=2, MCCINC=3, MCCCDE=4, MCCSEQ=5,
- + MCCXSQ=6, MCCTRU=7, MCCFAL=8, MCCELS=9, MCCEND=10,
- + MCCSEL=11, MCCSES=12, MCCFAU=13, MCCSKI=14,
- + MCCKEE=15, MCCDEL=16, MCCREP=17, MCCADB=18, MCCADD=19,
- + MCCUSE=20, MCCXDI=21, MCCDIV=22, MCCLIS=23, MCCEXE=24, MCCIMI=25,
- + MCCASM=26, MCCUPD=27, MCCNAM=28, MCCGAP=29, MCCMOR=30, MCCONL=31,
- + MCCFOR=32, MCCSUS=33, MCCOPT=34, MCCOP2=35, MCCSHO=36, MCCPAM=37,
- + MCCQUI=38, MCCEOD=39, MCCDEC=40, MCCPAT=41, MCCTIT=42)
- CHARACTER CCKORG*256, CCKARD*256, CCCOMF*256
- COMMON /CCPARA/NCHCCD,NCHCCT, JCCTYP,JCCLEV,JCCSL,MCCPAR(240)
- +, NCCPAR,MXCCIF,JCCIFV,JCCBAD,JCCWAR,ICCSUB,JCCWK(4)
- +, JCCPP,JCCPD,JCCPZ,JCCPT,JCCPIF,JCCPC,JCCPN
- +, NCCPP,NCCPD,NCCPZ,NCCPT,NCCPIF,NCCPC,NCCPN
- +, JCCEND, NCHCCC,IXCCC, CCKORG, CCKARD, CCCOMF
- CHARACTER CHEXPD*68
- COMMON /CHEXC/ IXEXPAM, IXEXPAT,IXEXDEC,IXEXID, NCHEPD, CHEXPD
- PARAMETER (JFO_TYP=1, JCC_TYP=2, JAS_TYP=3, JDA_TYP=4,
- + JSH_TYP=5, JCR_TYP=6, JIN_TYP=7, MAX_TYP=100)
- CHARACTER*16 CH_TYP(MAX_TYP), ACT_TYP
- COMMON /CM_TYP/ LUN_TYP, N_TYP, NAL_TYP, NDV_TYP, JBK_TYP
- +, JU_TYP(MAX_TYP), CH_TYP, ACT_TYP
- COMMON /DEPCOM/JD_NEW, JD_DTN, JD_DTP, JD_DTD, JD_DIV
- +, JD_SML, JD_SMP, JD_SMX, JDP_DT, JDP_DV
- +, JD_SPL, JD_MOD, JD_LUN, JD_LOG, JD_NLI, JD_MULT
- +, IX_EXT, IX_RH, IX_SUB
- COMMON /MUSEBC/ MX_FORC, MU_GLOB, MU_PAT, MU_DECK, MU_INH, MU_FORG
- +, MX_TRAN, MX_FORG, MX_SINH, MX_SELF, NVEXDK(6)
- COMMON /MQCM/ NQSYSS,NQLINK, LQCSTA(3),LQCEND(3), NQMAX
- +, LQLSTA(5),LQLEND(5), LQADR,LQADR0,NQOFFS
- PARAMETER (KQGARB=1,KQARRV=3,KQKEEP=4,KQPREP=5,KQMAIN=6,KQPAST=8)
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
- COMMON /M_ANAC/LOWAN,KDOAN,LDOAN,LUPAN,MODEAN,MEXAN,LEVAN,KKM5AN
- +, NEWDEC,NEWCTL,NEWFOR,NEWNIL,NEWINC
-C-------------- End CDE --------------------------------
-
-C-- Check file starts with +PATCH or +DECK
-
- IF (JCCTYP.EQ.MCCDEC) JDKTYP= 1
- IF (JCCTYP.EQ.MCCPAT) JDKTYP= 2
-
-C-- set limits of control division 2
-
- LQCSTA(2) = LQCEND(1) + 100
- LQCEND(2) = LQCSTA(2)
-
-C-- clear text division 3
-
- LQLSTA(3) = LQLEND(2)
- LQLEND(3) = LQLSTA(3)
- JD_DTP = 1
-
-C------ Ready the deck parameters
-
- 21 NQNEWH = 7
- IXEXDEC = 0
- IF (JDKTYP.EQ.3) GO TO 47
- JSLF = IQ(LQHOLD+1)
- IF (JDKTYP.EQ.1) GO TO 42
-
-C-- deck header is +PATCH, name
-
- JCCTYP = MCCPAT
- CALL CCKRAK (JSLF)
- IXEXPAT = MCCPAR(JCCPP+1)
- IF (IXEXPAT.EQ.0) IXEXPAT= 1
- IXEXID = IXEXPAT
-
- JD_DTN = 0
- IF (JCCBAD.EQ.0) CALL CCDOPT (1, JD_DTN)
- IF (JD_DTN.EQ.0) JD_DTN= 1
- JD_DTP = JD_DTN
- GO TO 44
-
-C-- deck header is +DECK, name
-
- 42 JSLF = IQ(LQHOLD+1)
- JCCTYP = MCCDEC
- CALL CCKRAK (JSLF)
- IXEXDEC = MCCPAR(JCCPD+1)
- IF (IXEXDEC.EQ.0) IXEXDEC= 1
- IXEXID = IXEXDEC
-
- 44 JD_DTN = 0
- IF (JCCBAD.EQ.0) CALL CCDOPT (1, JD_DTN)
- IF (JD_DTN.EQ.0) JD_DTN= JD_DTP
- LASMT = LQ(LHASM-JD_DTN)
- NR = IQ(LASMT+8)
- IQ(LASMT+8) = NR + 1
-
- IF (MOPTIO(21).EQ.0) GO TO 47
- IF (JD_DTN.LE.JIN_TYP) GO TO 47
- IF (NR.NE.0) GO TO 47
- SLERRM = 'New user data-type ' // CH_TYP(JD_DTN)
- CALL FAILLN (0,0,0,JSLF,SLERRM(1:LENOCC(SLERRM)))
-
-C-- set operation mode
-
- 47 NVEXDK(1) = 0
- NVEXDK(2) = 1
- NVEXDK(5) = 1
- NVEXDK(6) = 1
- NQJOIN = 1
-
-C------ Process the deck
-
- LEXD = 0
- NSLORG = 0
-
- IF (JDKNEX.EQ.0) CALL ARRIVE (2)
-
-C-- analyse the contents
-
- CALL DOMAPA (0)
-
-C-- process the contents
-
- LUPAN = 0
- LDOAN = KQPREP + 1
- 54 LDOAN = LQ(LDOAN-1)
- IF (LDOAN.EQ.0) GO TO 88
-
- JCCTYP = JBYT (IQ(LDOAN),9,6)
- IF (JCCTYP.EQ.0) GO TO 54
-
- CALL CCKRAK (IQ(LDOAN+1))
- IF (JCCBAD.NE.0) THEN
- CALL FAILCC (1,'syntax error')
- GO TO 54
- ENDIF
-
- IF (JCCWAR.EQ.0) GO TO 54
- IF (JCCWAR.EQ.1) CALL FAILCC (0,'hidden dot')
- IF (JCCWAR.EQ.2) CALL FAILCC (0,'trailing comma')
- GO TO 54
-
-C-- step to the next deck
-
- 88 CALL ARRNXD (1)
- NQDKNO = NQDKNO + 1
- IFLGAR = 0
- IF (JDKTYP.LT.3) GO TO 21
- RETURN
- END
diff --git a/src/p5boot/p5lib/crdeco.f b/src/p5boot/p5lib/crdeco.f
deleted file mode 100644
index 74ee362..0000000
--- a/src/p5boot/p5lib/crdeco.f
+++ /dev/null
@@ -1,40 +0,0 @@
-CDECK ID>, CRDECO.
- SUBROUTINE CRDECO
-
-C-- Create origin deck bank ODEC in division 3
-
- COMMON /QPAGE/ NQLMAX,NQLTOL,NQLTOK,NQCMAX,NQCPGH,NQPAGE
- +, NQWYLDO,NQWYL,NQNEWH,NQJOIN,NQDKNO,NQDKPG
- PARAMETER (NBANKS=19,JBKPAT=1, JBKDEC=2, JBKORG=3, JBKINC=4,
- + JBKHOL=5, JBKKEE=6, JBKACT=7, JBKMAT=8, JBKXSQ=9,
- + JBKPRE=10,JBKGAR=11,JBKSMH=12,JBKSMT=13,JBKSML=14,
- + JBKSMX=15,JBKARR=16,JBKASA=17,JBKPAM=18,JBKRPA=19)
- COMMON /QBANKS/MMBANK(5,NBANKS)
- CHARACTER CHEXPD*68
- COMMON /CHEXC/ IXEXPAM, IXEXPAT,IXEXDEC,IXEXID, NCHEPD, CHEXPD
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
-C-------------- End CDE --------------------------------
-
- IOR (IZV,IZW) = OR (IZV, IZW)
-
-
- CALL MQLIFT (LDECO,0,7,JBKORG,3)
-
- IQ(LDECO) = IOR (IQ(LDECO), NQDKNO)
- IQ(LDECO+1) = IXEXDEC
- IQ(LDECO+2) = IXEXPAT
- RETURN
- END
diff --git a/src/p5boot/p5lib/creact.f b/src/p5boot/p5lib/creact.f
deleted file mode 100644
index fc06c05..0000000
--- a/src/p5boot/p5lib/creact.f
+++ /dev/null
@@ -1,52 +0,0 @@
-CDECK ID>, CREACT.
- SUBROUTINE CREACT
-
-C- Create P/D target banks for the current action control-line.
-C- For omitted P/D parameters use NVIMAT(1+2) if non-zero.
-C- Return common variables LCRP and LCRD pointing to
-C- the PAT and DECK banks used, or zero if not defined;
-C- set NVIMAT if success.
-C. started 14-jan-92
-
- PARAMETER (KM1=1,KM2=2,KM3=4,KM4=8,KM5=16,KM6=32,KM7=64,KM8=128,
- + KM9=256, KM10=512, KM11=1024, KM12=2048, KM13=4096, KM14=8192,
- + KM15=16384, KM16=32768, KM17=65536, KM18=131072, KM19=262144)
- CHARACTER CCKORG*256, CCKARD*256, CCCOMF*256
- COMMON /CCPARA/NCHCCD,NCHCCT, JCCTYP,JCCLEV,JCCSL,MCCPAR(240)
- +, NCCPAR,MXCCIF,JCCIFV,JCCBAD,JCCWAR,ICCSUB,JCCWK(4)
- +, JCCPP,JCCPD,JCCPZ,JCCPT,JCCPIF,JCCPC,JCCPN
- +, NCCPP,NCCPD,NCCPZ,NCCPT,NCCPIF,NCCPC,NCCPN
- +, JCCEND, NCHCCC,IXCCC, CCKORG, CCKARD, CCCOMF
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
-C-------------- End CDE --------------------------------
-
-
- IXP = MCCPAR(JCCPP+1)
- IXD = MCCPAR(JCCPD+1)
-
- IF (IXP.NE.0) GO TO 24
- LCRP = NVIMAT(1)
- LCRD = 0
- IF (LCRP.EQ.0) RETURN
- IF (NCCPD.NE.0) GO TO 24
- LCRD = NVIMAT(2)
- RETURN
-
- 24 CALL CREAPD (IXP, IXD, 0)
- NVIMAT(1) = LCRP
- NVIMAT(2) = LCRD
- RETURN
- END
diff --git a/src/p5boot/p5lib/creapd.f b/src/p5boot/p5lib/creapd.f
deleted file mode 100644
index bb4dc21..0000000
--- a/src/p5boot/p5lib/creapd.f
+++ /dev/null
@@ -1,118 +0,0 @@
-CDECK ID>, CREAPD.
- SUBROUTINE CREAPD (IXPAX,IXDEX,MODELK)
-
-C- Locate or create for name index (IXPAT,IXDEC)
-
-C- banks 'PAT' and 'DECK'
-C- at LCRP and LCRD
-
-C- if IXPAT= 0 use PAT bank existing at LCRP
-C- if IXDEC= -ve no DECK please, return LCRD=0
-
-C- Linkage control :
-C- MODELK -ve create without search
-C- 0 normal search and creation
-C- +ve LEXP is to point to the resultant PAT bank
-C- shunt the bank currently at LEXP to LQPAST
-
-C- Returns LCRP and LCRD of PAT / DECK banks found or created
-
-C- NVUTY(1) K-adr of PAT bank
-C- NVUTY(2) K-adr of DECK bank
-
- PARAMETER (NBANKS=19,JBKPAT=1, JBKDEC=2, JBKORG=3, JBKINC=4,
- + JBKHOL=5, JBKKEE=6, JBKACT=7, JBKMAT=8, JBKXSQ=9,
- + JBKPRE=10,JBKGAR=11,JBKSMH=12,JBKSMT=13,JBKSML=14,
- + JBKSMX=15,JBKARR=16,JBKASA=17,JBKPAM=18,JBKRPA=19)
- COMMON /QBANKS/MMBANK(5,NBANKS)
- COMMON /MUSEBC/ MX_FORC, MU_GLOB, MU_PAT, MU_DECK, MU_INH, MU_FORG
- +, MX_TRAN, MX_FORG, MX_SINH, MX_SELF, NVEXDK(6)
- PARAMETER (KQGARB=1,KQARRV=3,KQKEEP=4,KQPREP=5,KQMAIN=6,KQPAST=8)
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
-C-------------- End CDE --------------------------------
- DIMENSION IXPAX(9), IXDEX(9)
-
- IOR (IZV,IZW) = OR (IZV, IZW)
-
-
- IXPAT = IXPAX(1)
- IXDEC = IXDEX(1)
- MODE = MODELK
-
-C------ Find or create PAT-bank
-
- IF (IXPAT.EQ.0) GO TO 41
- LORG = 0
- KP = LEXP-1
- IF (MODE.LT.0) GO TO 32
- IF (MODE.GT.0) THEN
- CALL QSHUNT (KQMAIN,KQPAST)
- KP = KQMAIN
- ENDIF
-
-C-- Find 'Future PAT'-bank pre-existing
-
- LQ(LLPAST-1) = 0
- LCRP = KQFIND (IXPAT,2,KQMAIN,NVUTY(1))
- IF (LCRP.EQ.0) GO TO 31
- IF (MODE.EQ.0) GO TO 41
- CALL QSHUNT (NVUTY(1),KP)
- GO TO 38
-
-C-- Find pre-existing 'Past PAT'-bank
-
- 31 LORG = LQFIND (IXPAT,2,LQPAST)
-
-C-- Create new PAT-bank
-
- 32 CALL MQLIFT (LCRP,KP,0,JBKPAT,3)
- IQ(LCRP) = IOR (IQ(LCRP), MU_GLOB)
- IQ(LCRP+2) = IXPAT
- IF (LORG.EQ.0) GO TO 38
- CALL MXJOIN (IQ(LORG),IQ(LCRP))
- IQ(LCRP+1) = IQ(LORG+1)
- LQ(LCRP-2) = LQ(LORG-2)
- LQ(LCRP-3) = LQ(LORG-3)
- LQ(LCRP-4) = LQ(LORG-4)
- LQ(LORG-2) = 0
- LQ(LORG-3) = 0
- CALL SBIT0 (IQ(LCRP+1),1)
-
-C-- set reverse pointers in DECK banks
-
- L = LCRP - 1
- 34 L = LQ(L-1)
- IF (L.EQ.0) GO TO 38
- LQ(L-4) = LCRP
- GO TO 34
-
- 38 NVUTY(1) = KP
-
-C---- Locate DEC-bank, unless IXDEC=-1
-
- 41 IF (IXDEC.LT.0) GO TO 57
- LCRD = KQFIND (IXDEC,1,LCRP-2,NVUTY(2))
- IF (LCRD.NE.0) RETURN
-
- CALL MQLIFT (LCRD,NVUTY(2),0,JBKDEC,1)
- CALL SBYT (IQ(LCRP),IQ(LCRD),1,18)
- IQ(LCRD+1) = IXDEC
- LQ(LCRD-4) = LCRP
- RETURN
-
- 57 LCRD = 0
- RETURN
- END
diff --git a/src/p5boot/p5lib/diacerr.f b/src/p5boot/p5lib/diacerr.f
deleted file mode 100644
index 1000454..0000000
--- a/src/p5boot/p5lib/diacerr.f
+++ /dev/null
@@ -1,63 +0,0 @@
-CDECK ID>, DIACERR.
- SUBROUTINE DIACERR (LOLD,IFERR)
-
-C- Action on duplicate deck
-C. started 3-june-94
-
- COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT,NUSLAT(2),DUMMY(34)
- CHARACTER SLLINE*512, SLERRM*256
- COMMON /SLATLN/ SLLINE, SLERRM
- COMMON /QUNIT/ IQREAD,IQPRNT, IQTTIN,IQTYPE, IQOFFL,IQRTTY,IQRSAV
- +, IQRFD,IQRRD,IQRSIZ, NQLPAT,NQUSED,NQLLBL, NQINIT
- CHARACTER CQDATEM*10, CQDATE*8, CQTIME*5
- COMMON /QSTATE/NQERR,NQWARN,NQINFO,NQLOCK
- +, IQDATE,IQTIME, CQDATEM,CQDATE,CQTIME
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
-C-------------- End CDE --------------------------------
- CHARACTER LINE*128, COL(128)*1
- EQUIVALENCE (LINE,SLERRM), (COL,SLERRM)
-
-
- LDX = LOLD
- LDN = LQ(LDX-2)
- LPX = LQ(LDX-3)
- LPN = LQ(LDN-3)
-
- LINE = 'p='
- CALL NA_GET (IQ(LPX+4),LINE,3)
- N = NESLAT
- LINE(N+1:N+2) = 'd='
- N = N + 3
-
- CALL NA_GET (IQ(LDX+4),LINE,N)
- N = NESLAT
-
- NDX = IQ(LDX+10)
- NDN = IQ(LDN+10)
-
- IF (NDN.NE.NDX) GO TO 31
- IF (NDN.NE.1) GO TO 31
- IF (IQ(LPX+4).NE.IQ(LPN+4)) GO TO 31
-
- NQWARN = NQWARN
- WRITE (IQPRNT,9024) LINE(1:N)
- IFERR = 0
- RETURN
-
- 31 NQERR = NQERR
- WRITE (IQPRNT,9034) LINE(1:N)
- IFERR = 1
- RETURN
-
- 9024 FORMAT (' **!! Warn: Action on the first member of duplicate '
- F/16X,A,' !!**')
- 9034 FORMAT (' ***!!! Error: Action on a bad member of duplicate '
- F/16X,A,' !!!***')
- END
diff --git a/src/p5boot/p5lib/diclfi.f b/src/p5boot/p5lib/diclfi.f
deleted file mode 100644
index c1c8902..0000000
--- a/src/p5boot/p5lib/diclfi.f
+++ /dev/null
@@ -1,33 +0,0 @@
-CDECK ID>, DICLFI.
- SUBROUTINE DICLFI (LFI)
-
-C- Reset all banks of all PAMs as out-of-memory
-C. started 3-june-94
-
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
-C-------------- End CDE --------------------------------
-
-
-
- LF = LFI
- LP = LQ(LF-4)
- 22 IF (LP.EQ.0) RETURN
- IF (IQ(LP+1).EQ.0) GO TO 26
-
- IQ(LP+1) = 0
- LD = LQ(LP-4)
- 24 IF (LD.EQ.0) GO TO 26
- IQ(LD+1) = 0
- LD = LQ(LD-1)
- GO TO 24
-
- 26 LP = LQ(LP-1)
- GO TO 22
- END
diff --git a/src/p5boot/p5lib/dicrad.f b/src/p5boot/p5lib/dicrad.f
deleted file mode 100644
index c4fef4a..0000000
--- a/src/p5boot/p5lib/dicrad.f
+++ /dev/null
@@ -1,374 +0,0 @@
-CDECK ID>, DICRAD.
- SUBROUTINE DICRAD
-
-C- Write the Patchy update cradle
-C. started 6-june-94
-
- COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT,NUSLAT(2),DUMMY(34)
- CHARACTER SLLINE*512, SLERRM*256
- COMMON /SLATLN/ SLLINE, SLERRM
- PARAMETER (KM1=1,KM2=2,KM3=4,KM4=8,KM5=16,KM6=32,KM7=64,KM8=128,
- + KM9=256, KM10=512, KM11=1024, KM12=2048, KM13=4096, KM14=8192,
- + KM15=16384, KM16=32768, KM17=65536, KM18=131072, KM19=262144)
- COMMON /QUNIT/ IQREAD,IQPRNT, IQTTIN,IQTYPE, IQOFFL,IQRTTY,IQRSAV
- +, IQRFD,IQRRD,IQRSIZ, NQLPAT,NQUSED,NQLLBL, NQINIT
- CHARACTER CQDATEM*10, CQDATE*8, CQTIME*5
- COMMON /QSTATE/NQERR,NQWARN,NQINFO,NQLOCK
- +, IQDATE,IQTIME, CQDATEM,CQDATE,CQTIME
- PARAMETER (NSLIFI=128)
- CHARACTER CHLIFI*(NSLIFI), CHLIEX*8
- COMMON /FLINKC/LUNOP,LUNFD,LUNOLD,LUNSIZ
- +, IXFLUN, NLIFI,CHLIFI,CHLIEX
- COMMON /LUNSLN/IFLAUX, IXLUN(12)
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
- +, INMEM(2),NSLTOT(2),NSLMAX(2),NTXMAX(2),JSLTTF(2), IFSTRUC
- +, NOBJTT(3,2),NOBJMAT, MDELADD(2,2), LUNCRA,NLSENT, LASTDI
- COMMON /DIFFC/ NFAID, JFAIDA, JFAIDE
-C-------------- End CDE --------------------------------
- CHARACTER LNDUP*80, LINE*128, COL(128)*1, MARK*4
- EQUIVALENCE (LNDUP,SLLINE), (LINE,SLERRM), (COL,SLERRM)
- DIMENSION MFAID(NSIZEQ)
- EQUIVALENCE (MFAID,IQ)
- LOGICAL ALSO, PRINT
-
- CHARACTER ACTION(3)*4
- DATA ACTION / '+DEL', '+REP', '+ADD' /
-
- IAND (IZV,IZW) = AND (IZV, IZW)
-
-
- ALSO = IQTYPE .NE. IQPRNT
- CALL DPBLAN (1)
-
- IF (IXLUN(3).EQ.0) THEN
- PRINT = .TRUE.
- ASSIGN 9008 TO IFMT
- LUNCRA = IQPRNT
- WRITE (IQPRNT,9002)
- GO TO 20
- ENDIF
-
- PRINT = .FALSE.
- ASSIGN 9009 TO IFMT
- LUNCRA = 21
- CALL FLINK (LUNCRA,5,IXLUN(3),0)
- WRITE (IQPRNT,9001) CHLIFI(1:NLIFI)
- IF (ALSO) WRITE (IQTYPE,9001) CHLIFI(1:NLIFI)
-
- 9001 FORMAT (' the Nypatchy update cradle goes to file ',A)
- 9002 FORMAT (' Here comes the Nypatchy update cradle:'/)
- 9004 FORMAT (A)
- 9005 FORMAT ('+nil. Attention: PAM structure changes !')
- 9008 FORMAT (3X,A,'.')
- 9009 FORMAT (A,'.')
-
-C---- Write the leading lines to the cradle
-
- LINE = 'update /1 ' // CQDATEM // ' ' // CQTIME
- + // ' from Nydiff'
- N = LENOCC (LINE)
- WRITE (LUNCRA,9004) LINE(1:N)
-
-C- _:.=+=.: 1_:.=+=.:_2
- LINE = '+nil. "old" was:'
- CALL LN_GET (JSLTTF(1),LINE(20:),40)
- N = LENOCC (LINE)
- WRITE (LUNCRA,9004) LINE(1:N)
-
- LINE = '+nil. "new" was:'
- CALL LN_GET (JSLTTF(2),LINE(20:),40)
- N = LENOCC (LINE)
- WRITE (LUNCRA,9004) LINE(1:N)
- IF (IFSTRUC.NE.0) WRITE (LUNCRA,9005)
-
- LINE = '+PATCH, UPD.'
- N = 12
- IF (IXLUN(3).GT.0) THEN
- CALL FLSPLIT (IXLUN(3),IXDIR,IXFN,IXEXT)
- IF (IXFN.GT.0) THEN
- CALL NA_GET (IXFN,LINE,9)
- N = NESLAT
- COL(N) = '.'
- ENDIF
- ENDIF
- WRITE (LUNCRA,9004) LINE(1:N)
-
-C-------- generate the +USE, T=INH lines for the "old" file ------
-
-C- _:.=+=.: 1_:.=+=.:_2
- 20 LINE = '+use, t=inh, p='
- JCOL = 16
-
- LFI = LQUSER(1)
- LP = LFI - 3
-
-C-- scan all patches
-
- 22 LP = LQ(LP-1)
- IF (LP.EQ.0) GO TO 27
- IF (IAND(IQ(LP),KM2).NE.0) GO TO 22
- CALL NA_GET (IQ(LP+4),LINE,JCOL)
- JCPE = NESLAT - 1
- IF (LQ(LP-2).NE.0) GO TO 24
- WRITE (LUNCRA,IFMT) LINE(1:JCPE)
- NLSENT = NLSENT + 1
- MDELADD(1,1) = MDELADD(1,1) + 1
- IF (IQ(LP+10).EQ.0) GO TO 22
-
- NQERR = NQERR + 1
- LNDUP = 'p='
- CALL NA_GET (IQ(LP+4),LNDUP,3)
- N = NESLAT
- WRITE (IQPRNT,9023) LNDUP(1:N)
- GO TO 22
-
- 9023 FORMAT (' ***!!! Error: deleting duplicate ',A,' !!!***')
-
-C-- scan all decks of this patch
-
- 24 LINE(JCPE+1:JCPE+4) = ', D='
- JCD = JCPE + 5
-
- LD = LQ(LP-4)
- 25 LD = LQ(LD-1)
- IF (LD.EQ.0) GO TO 22
- IF (LQ(LD-2).NE.0) GO TO 25
- CALL NA_GET (IQ(LD+4),LINE,JCD)
- WRITE (LUNCRA,IFMT) LINE(1:NESLAT-1)
- NLSENT = NLSENT + 1
- MDELADD(2,1) = MDELADD(2,1) + 1
- IF (IQ(LD+10).EQ.0) GO TO 25
-
- NQERR = NQERR + 1
- LNDUP = 'p='
- CALL NA_GET (IQ(LP+4),LNDUP,3)
- N = NESLAT
- LNDUP(N+1:N+2) = 'd='
- CALL NA_GET (IQ(LD+4),LNDUP,N+3)
- N = NESLAT
- WRITE (IQPRNT,9023) LNDUP(1:N)
- GO TO 25
-
- 27 IF (PRINT .AND. NLSENT.NE.0) CALL DPBLAN (-1)
-
-C-------- generate corrections for existing decks -------------
-
- LFI = LQUSER(2)
-
-C---- scan all patches
-
- LPN = LFI - 3
- 32 LPN = LQ(LPN-1)
- IF (LPN.EQ.0) GO TO 60
- LPX = LQ(LPN-2)
- IF (LPX.EQ.0) GO TO 32
- CALL DINEED (2,LPN)
-
-C---- scan all decks of this patch
-C-- first take only the decks of the matching patch
-
- IXPUSE = 0
- LDNEXT = 0
- LDN = LPN - 3
- 34 LDN = LQ(LDN-1)
- IF (LDN.EQ.0) GO TO 57
-
- LDX = LQ(LDN-2)
- IF (LDX.EQ.0) GO TO 34
- IF (IQ(LDX+2).LE.0) GO TO 34
-
-C-- check the deck is of foreign origin
- IF (IQ(LDN+6).GE.4) THEN
- LDNEXT = LDN
- GO TO 34
- ENDIF
-
-C-- skip if done
- IF (IQ(LDX+6).EQ.4) GO TO 34
-
-C---- compare the "new" deck to the "old"
-
- 41 IQ(LDX+6) = 4
- MARK = ' -> '
- CALL DINEED (1,LPX)
- CALL DIF_XQT (IQ(LDX+1),IQ(LDX+2), IQ(LDN+1),IQ(LDN+2),0)
- IF (NFAID.EQ.0) GO TO 49
-
- IF (IQ(LDX+10)+IQ(LDN+10) .NE.0) THEN
- CALL DIACERR (LDX,IFERR)
- IF (IFERR.NE.0) GO TO 49
- ENDIF
-
- IXP = IQ(LPX+4)
- IXD = IQ(LDX+4)
- LINE = '+xxx, '
- CALL NA_GET (IXP,LINE,7)
- JN = NESLAT
- COL(JN) = ','
- IF (IXD.EQ.0) THEN
- JN = JN + 1
- ELSE
- CALL NA_GET (IXD,LINE,JN+2)
- JN = NESLAT
- ENDIF
- COL(JN) = ','
- JPUT = JN + 2
-
- JFAID = JFAIDA
- 44 JCODE = MFAID(JFAID)
- JFGOX = MFAID(JFAID+1) - 1
- JFGON = MFAID(JFAID+2) - 1
- NLDEL = MFAID(JFAID+3)
- NLINS = MFAID(JFAID+4)
- IF (NLDEL+NLINS.EQ.0) GO TO 47
- LINE(1:4) = ACTION(JCODE+2)
- LINE(JPUT:JPUT+12) = ' '
-
- IF (JCODE.GT.0) THEN
- IF (JFGOX.EQ.0) THEN
- LINE(1:4) = '+ADB'
- ELSE
- JFGOX = JFGOX - 1
- ENDIF
- ENDIF
-
- CALL CSETDI (JFGOX, LINE,JPUT,JPUT+5)
- IF (NLDEL.GE.2) THEN
- COL(JPUT+6) = '-'
- CALL CSETDI (JFGOX+NLDEL-1, LINE,JPUT+7,JPUT+12)
- ENDIF
- CALL CLEFT (LINE,JPUT,JPUT+12)
- N = NESLAT - 1
-
- IF (PRINT) WRITE(IQPRNT,9004) MARK
- WRITE (LUNCRA,IFMT) LINE(1:N)
- NLSENT = NLSENT + 1
- IF (NLINS.NE.0) CALL DISEND (IQ(LDN+1)+JFGON, NLINS)
- MARK = ' > '
-
- 47 JFAID = JFAID + 5
- IF (JFAID.LT.JFAIDE) GO TO 44
- 49 IF (IXPUSE.EQ.0) GO TO 34
-
-C-- scanning foreign decks coming all from the same old patch
-
- 52 LDN = LQ(LDN-1)
- IF (LDN.EQ.0) GO TO 57
- LDX = LQ(LDN-2)
- IF (LDX.EQ.0) GO TO 52
- IF (IQ(LDX+6).EQ.4) GO TO 52
- IF (IQ(LDX+2).LE.0) GO TO 52
- IF (IQ(LDN+6).EQ.IXPUSE) GO TO 41
- LDNEXT = LDN
- GO TO 52
-
-C-- start scanning foreign decks coming from patch IXPUSE
-
- 57 IF (LDNEXT.EQ.0) GO TO 32
- LDN = LDNEXT
- LDX = LQ(LDN-2)
- LPX = LQ(LDX-3)
- IXPUSE = IQ(LDN+6)
- LDNEXT = 0
- LDN = LQ(LPN-4)
- GO TO 52
-
-C-------- add new patches or decks --------------------------
-
- 60 LFI = LQUSER(2)
-
-C---- scan all patches
-
- LPN = LFI - 3
- 62 LPN = LQ(LPN-1)
- IF (LPN.EQ.0) GO TO 87
- LPX = LQ(LPN-2)
- IF (LPX.EQ.0) GO TO 71
-
-C---- scan all decks of this patch
-
- LDN = LPN - 3
- 64 LDN = LQ(LDN-1)
- IF (LDN.EQ.0) GO TO 62
- LDX = LQ(LDN-2)
- IF (LDX.EQ.0) GO TO 72
- IF (IQ(LDX+9).LT.0) GO TO 72
-
-C-- check the deck is of foreign origin
- IF (IQ(LDN+6).GE.4) GO TO 64
-
-C-- remember this deck for adding to it
- LLD = LDX
- GO TO 64
-
-C-- this patch is new, generate a +ADD for it
-
- 71 LUSE = LPN
- J = 1
- GO TO 74
-
-C-- this deck is new, generate a +ADD for it
-
- 72 LUSE = LDN
- J = 2
- IF (IQ(LDN+4).EQ.0) J= 1
-
-C-- send the lines held by the bank at LUSE to the cradle
-
- 74 MDELADD(J,2) = MDELADD(J,2) + 1
- CALL DINEED (2,LPN)
- LLP = LQ(LLD-3)
- IXP = IQ(LLP+4)
- IXD = IQ(LLD+4)
- LINO = IQ(LLD+2)
-
- LINE = '+ADD, '
- CALL NA_GET (IXP,LINE,7)
- JN = NESLAT
- COL(JN) = ','
- IF (IXD.EQ.0) THEN
- JN = JN + 1
- ELSE
- CALL NA_GET (IXD,LINE,JN+2)
- JN = NESLAT
- ENDIF
- COL(JN) = ','
- JN = JN + 2
- CALL CSETDI (LINO, LINE,JN,JN+5)
- CALL CLEFT (LINE,JN,JN+5)
- N = NESLAT - 1
-
- MARK = ' -> '
- IF (PRINT) WRITE(IQPRNT,9004) MARK
- WRITE (LUNCRA,IFMT) LINE(1:N)
- NLSENT = NLSENT + 1
- CALL DISEND (IQ(LUSE+1),IQ(LUSE+2))
- IF (LPX.EQ.0) GO TO 62
- GO TO 64
-
-C---- Done
-
- 87 IF (PRINT .AND. NLSENT.NE.0) CALL DPBLAN (-1)
- WRITE (IQPRNT,9087) NLSENT
- IF (ALSO) WRITE (IQTYPE,9087) NLSENT
- WRITE (IQPRNT,9088) MDELADD
- IF (ALSO) WRITE (IQTYPE,9088) MDELADD
- 9087 FORMAT (' the Nypatchy update cradle has',I6,' active lines,')
- 9088 FORMAT (I6,' old patches,',I5,' old decks deleted,'
- F/ I6,' new patches,',I5,' new decks added.')
- NQLLBL = 0
- RETURN
- END
diff --git a/src/p5boot/p5lib/didupl.f b/src/p5boot/p5lib/didupl.f
deleted file mode 100644
index 6c13ea2..0000000
--- a/src/p5boot/p5lib/didupl.f
+++ /dev/null
@@ -1,87 +0,0 @@
-CDECK ID>, DIDUPL.
- SUBROUTINE DIDUPL (JFILE)
-
-C- Check presence of duplicate P/D names
-C- JFILE = 1/2 for old/new
-C. started 1-mar-95
-
- COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT,NUSLAT(2),DUMMY(34)
- CHARACTER SLLINE*512, SLERRM*256
- COMMON /SLATLN/ SLLINE, SLERRM
- CHARACTER CQDATEM*10, CQDATE*8, CQTIME*5
- COMMON /QSTATE/NQERR,NQWARN,NQINFO,NQLOCK
- +, IQDATE,IQTIME, CQDATEM,CQDATE,CQTIME
- COMMON /QUNIT/ IQREAD,IQPRNT, IQTTIN,IQTYPE, IQOFFL,IQRTTY,IQRSAV
- +, IQRFD,IQRRD,IQRSIZ, NQLPAT,NQUSED,NQLLBL, NQINIT
- PARAMETER (KQUSER=9)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ)
- EQUIVALENCE (LQ,IQ,LQGARB)
- COMMON // IQUEST(100),LQGARB
-C-------------- End CDE --------------------------------
- CHARACTER LINE*80
- EQUIVALENCE (LINE,SLERRM)
-
-
- JFI = JFILE
- CALL DPBLAN (0)
-
- LFA = KQUSER + JFI
- LFA = LQ(LFA-1)
- LPA = LFA - 3
-
-C-- next patch A
- 22 LPA = LQ(LPA-1)
- IF (LPA.EQ.0) RETURN
- IXP = IQ(LPA+4)
- LDA = LPA - 3
-
-C-- next deck A
- 24 LDA = LQ(LDA-1)
- IF (LDA.EQ.0) GO TO 22
- IXD = IQ(LDA+4)
-
-C---- search for next deck of same name
-
- LPN = LPA
- LDN = LDA
- 32 LDN = LQ(LDN-1)
- IF (LDN.EQ.0) GO TO 37
- IF (IQ(LDN+4).EQ.IXD) GO TO 41
- GO TO 32
-
- 37 LPN = LQ(LPN-1)
- IF (LPN.EQ.0) GO TO 24
- IF (IQ(LPN+4).NE.IXP) GO TO 37
- LDN = LPN - 3
- GO TO 32
-
-C-- trouble
-
- 41 IQ(LDA+10) = MAX (1, IQ(LDA+10))
- IQ(LDN+10) = IQ(LDA+10) + 1
-
- IF (JFI.EQ.1) THEN
- LINE = 'old p='
- ELSE
- LINE = 'new p='
- ENDIF
- CALL NA_GET (IXP,LINE,7)
- N = NESLAT
- IF (IXD.EQ.0) THEN
- IQ(LPA) = IQ(LDA+10)
- IQ(LPN) = IQ(LDN+10)
- ELSE
- LINE(N+1:N+2) = 'd='
- N = N + 3
- CALL NA_GET (IXD,LINE,N)
- N = NESLAT
- ENDIF
-
- WRITE (IQPRNT,9044) LINE(1:N)
- NQLLBL = 0
- NQINFO = NQINFO + 1
- GO TO 24
-
- 9044 FORMAT (' *! Duplicate: ',A,' !*')
- END
diff --git a/src/p5boot/p5lib/dif_back.f b/src/p5boot/p5lib/dif_back.f
deleted file mode 100644
index cb7d26f..0000000
--- a/src/p5boot/p5lib/dif_back.f
+++ /dev/null
@@ -1,44 +0,0 @@
-CDECK ID>, DIF_BACK.
- SUBROUTINE DIF_BACK (NPOSSP,NMATP)
-
-C- Compare backwards the NPOSS > 0 lines from the current
-C- On entry: line vectors positioned to the first line to be checked
-C- On return: NMAT > 0 the number of matching lines found,
-C- line vectors positioned to the first
-C- line of the match
-C- NMAT = 0 no match, line vectors unchanged
-
- PARAMETER (LGLIV=4, LGLIV2=8)
- COMMON /DIFXC/ JX_ORG, JY_ORG, NX_NLI, NY_NLI
- +, JX_FEND, JY_FEND, NLI_MAT
- +, JX_NTH, JX_JSL, JX_JTX, JX_NCH
- +, JY_NTH, JY_JSL, JY_JTX, JY_NCH
- +, LXV_FAI(LGLIV), LYV_FAI(LGLIV)
- +, LXV_SCA(LGLIV), LYV_SCA(LGLIV)
- +, LXV_MAT(LGLIV), LYV_MAT(LGLIV)
-C-------------- End CDE -------------------
-
-
- NPOSS = NPOSSP
- NMAT = 0
- CALL DIF_SAME (JX_NTH, JY_NTH, IFSAME)
- IF (IFSAME.EQ.0) GO TO 28
-
-C-- Current lines match
-
- 24 NMAT = NMAT + 1
- NPOSS = NPOSS - 1
- IF (NPOSS.EQ.0) GO TO 28
-
-C-- How about the previous?
-
- CALL DIF_SAME (JX_NTH-1, JY_NTH-1, IFSAME)
- IF (IFSAME.NE.0) GO TO 24
-
-C-- Not equal, position to start of match
-
- CALL DIF_NX
- CALL DIF_NY
- 28 NMATP = NMAT
- RETURN
- END
diff --git a/src/p5boot/p5lib/dif_fmat.f b/src/p5boot/p5lib/dif_fmat.f
deleted file mode 100644
index ce722d8..0000000
--- a/src/p5boot/p5lib/dif_fmat.f
+++ /dev/null
@@ -1,151 +0,0 @@
-CDECK ID>, DIF_FMAT.
- SUBROUTINE DIF_FMAT (MILILE, MIMATP)
-
-C- Find next matching lines, at leat MIMAT+1 lines
-C- with a length of MILILE or more columns
-
-C- On input: old/new JX_/JY_NTH positioned to the start of failure
-C- JX_FEND/Y last possible failing line
-
-C- On output: LXV_FAI/_YFAI param. of the start lines of failure
-C- LXV_MAT/_YMAT param. of the start lines of match
-C- NLI_MAT the length of this match,
-C- =0 : no match found
-
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- PARAMETER (LGLIV=4, LGLIV2=8)
- COMMON /DIFXC/ JX_ORG, JY_ORG, NX_NLI, NY_NLI
- +, JX_FEND, JY_FEND, NLI_MAT
- +, JX_NTH, JX_JSL, JX_JTX, JX_NCH
- +, JY_NTH, JY_JSL, JY_JTX, JY_NCH
- +, LXV_FAI(LGLIV), LYV_FAI(LGLIV)
- +, LXV_SCA(LGLIV), LYV_SCA(LGLIV)
- +, LXV_MAT(LGLIV), LYV_MAT(LGLIV)
-C-------------- End CDE -------------------
- LOGICAL LN_EQU
-
-
- CALL UCOPY (JX_NTH, LXV_FAI, LGLIV2)
- MILENGO = MILILE
- MIMAT = MIMATP
- MILENCO = MIN (MILENGO,9)
- NLI_MAT = 0
- GO TO 16
-
-C-- Step to first possible start lines
-
- 15 IF (JX_NTH.GE.JX_FEND) GO TO 81
- CALL DIF_NX
- 16 IF (JX_NCH.LT.MILENGO) GO TO 15
- GO TO 18
-
- 17 IF (JY_NTH.GE.JY_FEND) GO TO 81
- CALL DIF_NY
- 18 IF (JY_NCH.LT.MILENGO) GO TO 17
-
- CALL UCOPY (JX_NTH, LXV_SCA, LGLIV2)
-
- JHALTX = JX_FEND - MIMAT
- JHALTY = JY_FEND - MIMAT
- IF (JX_NTH.GT.JHALTX) GO TO 81
- IF (JY_NTH.GT.JHALTY) GO TO 81
-
- JENDY = JY_NTH
- GO TO 22
-
-C---- Next X line, compare against Y lines so far
-
- 21 IF (JENDX.EQ.JHALTX) GO TO 31
- CALL DIF_NX
- 22 JENDX = JX_NTH
- NCH = JX_NCH
- IF (NCH.LT.MILENGO) GO TO 31
-
- CALL UCOPY (LYV_SCA, JY_NTH, LGLIV)
- GO TO 25
-
- 24 IF (JY_NTH.EQ.JENDY) GO TO 31
- CALL DIF_NY
-
- 25 IF (JY_NCH.NE.NCH) GO TO 24
- IF (.NOT.LN_EQU(TEXT(JY_JTX),TEXT(JX_JTX),NCH)) GO TO 24
- GO TO 41
-
-C---- Next Y line, compare against X lines so far
-
- 31 IF (JENDY.EQ.JHALTY) THEN
- IF (JENDX.NE.JHALTX) GO TO 21
- GO TO 81
- ENDIF
- CALL DIF_NY
- JENDY = JY_NTH
- NCH = JY_NCH
- IF (NCH.LT.MILENGO) GO TO 21
-
- CALL UCOPY (LXV_SCA, JX_NTH, LGLIV)
- GO TO 35
-
- 34 IF (JX_NTH.EQ.JENDX) GO TO 21
- CALL DIF_NX
-
- 35 IF (JX_NCH.NE.NCH) GO TO 34
- IF (.NOT.LN_EQU(TEXT(JX_JTX),TEXT(JY_JTX),NCH)) GO TO 34
-
-C-- Found first line of possible match
-
- 41 CALL UCOPY (JX_NTH, LXV_MAT, LGLIV2)
- NEXMAT = 0
- NSAME = 0
- 42 NSAME = NSAME + 1
- IF (JX_NTH.EQ.JX_FEND) GO TO 46
- IF (JY_NTH.EQ.JY_FEND) GO TO 46
- CALL DIF_NX
- CALL DIF_NY
- N = JX_NCH
- IF (JY_NCH.NE.N) GO TO 46
- IF (N.EQ.0) GO TO 42
- IF (.NOT.LN_EQU(TEXT(JX_JTX),TEXT(JY_JTX),N)) GO TO 46
- IF (N.LT.MILENCO) GO TO 42
- NEXMAT = NEXMAT + 1
- GO TO 42
-
-C-- Is the match is long enough ?
-
- 46 IF (NEXMAT.GE.MIMAT) GO TO 51
- CALL DIF_LX (LXV_MAT(1) + NSAME -1)
- CALL DIF_LY (LYV_MAT(1) + NSAME -1)
- JENDX = MIN (MAX(JENDX,JX_NTH), JHALTX)
- JENDY = MIN (MAX(JENDY,JY_NTH), JHALTY)
- IF (JY_NTH.LT.JENDY) GO TO 24
- IF (JX_NTH.LT.JENDX) GO TO 34
- GO TO 21
-
-C---- Match found
-
- 51 NLI_MAT = NSAME
-
-C-- Find identical short lines in front
-
- NPOSS = MIN (LXV_MAT(1)-LXV_FAI(1)
- +, LYV_MAT(1)-LYV_FAI(1))
- IF (NPOSS.LE.0) GO TO 87
-
- CALL UCOPY (LXV_MAT, JX_NTH, LGLIV2)
- CALL DIF_LX (JX_NTH-1)
- CALL DIF_LY (JY_NTH-1)
- CALL DIF_BACK (NPOSS,NPRE)
- IF (NPRE.NE.0) CALL UCOPY (JX_NTH, LXV_MAT, LGLIV2)
- NLI_MAT = NLI_MAT + NPRE
-
-C---- No match in the region
-
- 81 CONTINUE
- 87 RETURN
- END
diff --git a/src/p5boot/p5lib/dif_head.f b/src/p5boot/p5lib/dif_head.f
deleted file mode 100644
index 43d4387..0000000
--- a/src/p5boot/p5lib/dif_head.f
+++ /dev/null
@@ -1,47 +0,0 @@
-CDECK ID>, DIF_HEAD.
- SUBROUTINE DIF_HEAD
-
-C- Find first failure between the two sets
-C- return NDSLAT = 0 failure found, the line vectors are positioned
-C- to the start of the failure
-C- 1 end of one of the sets found, the line vectors
-C- are positioned to the last matching line
-C- 2 the two sets are identical
-
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- PARAMETER (LGLIV=4, LGLIV2=8)
- COMMON /DIFXC/ JX_ORG, JY_ORG, NX_NLI, NY_NLI
- +, JX_FEND, JY_FEND, NLI_MAT
- +, JX_NTH, JX_JSL, JX_JTX, JX_NCH
- +, JY_NTH, JY_JSL, JY_JTX, JY_NCH
- +, LXV_FAI(LGLIV), LYV_FAI(LGLIV)
- +, LXV_SCA(LGLIV), LYV_SCA(LGLIV)
- +, LXV_MAT(LGLIV), LYV_MAT(LGLIV)
-C-------------- End CDE -------------------
- COMMON /SLATE/ NDSLAT,NESLAT,DUMMY(38)
- LOGICAL LN_EQU
-
-
- NDSLAT = 0
- 21 IF (JX_NCH.NE.JY_NCH) GO TO 29
- IF (JX_NCH.EQ.0) GO TO 22
- IF (.NOT.LN_EQU(TEXT(JX_JTX), TEXT(JY_JTX), JX_NCH)) GO TO 29
-
- 22 IF (JX_NTH.EQ.NX_NLI) GO TO 27
- IF (JY_NTH.EQ.NY_NLI) GO TO 28
- CALL DIF_NX
- CALL DIF_NY
- GO TO 21
-
- 27 NDSLAT = 1
- IF (JY_NTH.NE.NY_NLI) GO TO 29
- 28 NDSLAT = NDSLAT + 1
- 29 RETURN
- END
diff --git a/src/p5boot/p5lib/dif_lx.f b/src/p5boot/p5lib/dif_lx.f
deleted file mode 100644
index b3b6dde..0000000
--- a/src/p5boot/p5lib/dif_lx.f
+++ /dev/null
@@ -1,31 +0,0 @@
-CDECK ID>, DIF_LX.
- SUBROUTINE DIF_LX (LNO)
-
-C- Set the current to be ordinal line number LNO,
-C- but not beyond the last line NX_NLI
-
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- PARAMETER (LGLIV=4, LGLIV2=8)
- COMMON /DIFXC/ JX_ORG, JY_ORG, NX_NLI, NY_NLI
- +, JX_FEND, JY_FEND, NLI_MAT
- +, JX_NTH, JX_JSL, JX_JTX, JX_NCH
- +, JY_NTH, JY_JSL, JY_JTX, JY_NCH
- +, LXV_FAI(LGLIV), LYV_FAI(LGLIV)
- +, LXV_SCA(LGLIV), LYV_SCA(LGLIV)
- +, LXV_MAT(LGLIV), LYV_MAT(LGLIV)
-C-------------- End CDE -------------------
-
-
- JX_NTH = MIN (LNO, NX_NLI)
- JX_JSL = JX_NTH + JX_ORG
- JX_JTX = MLIAD(JX_JSL)
- JX_NCH = MLIAD(JX_JSL+1) - JX_JTX - NCHNEWL
- RETURN
- END
diff --git a/src/p5boot/p5lib/dif_ly.f b/src/p5boot/p5lib/dif_ly.f
deleted file mode 100644
index a74a96d..0000000
--- a/src/p5boot/p5lib/dif_ly.f
+++ /dev/null
@@ -1,31 +0,0 @@
-CDECK ID>, DIF_LY.
- SUBROUTINE DIF_LY (LNO)
-
-C- Set the current to be ordinal line number LNO,
-C- but not beyond the last line NY_NLI
-
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- PARAMETER (LGLIV=4, LGLIV2=8)
- COMMON /DIFXC/ JX_ORG, JY_ORG, NX_NLI, NY_NLI
- +, JX_FEND, JY_FEND, NLI_MAT
- +, JX_NTH, JX_JSL, JX_JTX, JX_NCH
- +, JY_NTH, JY_JSL, JY_JTX, JY_NCH
- +, LXV_FAI(LGLIV), LYV_FAI(LGLIV)
- +, LXV_SCA(LGLIV), LYV_SCA(LGLIV)
- +, LXV_MAT(LGLIV), LYV_MAT(LGLIV)
-C-------------- End CDE -------------------
-
-
- JY_NTH = MIN (LNO, NY_NLI)
- JY_JSL = JY_NTH + JY_ORG
- JY_JTX = MLIAD(JY_JSL)
- JY_NCH = MLIAD(JY_JSL+1) - JY_JTX - NCHNEWL
- RETURN
- END
diff --git a/src/p5boot/p5lib/dif_nx.f b/src/p5boot/p5lib/dif_nx.f
deleted file mode 100644
index 355b316..0000000
--- a/src/p5boot/p5lib/dif_nx.f
+++ /dev/null
@@ -1,30 +0,0 @@
-CDECK ID>, DIF_NX.
- SUBROUTINE DIF_NX
-
-C- Step the current line on "old" by +1
-
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- PARAMETER (LGLIV=4, LGLIV2=8)
- COMMON /DIFXC/ JX_ORG, JY_ORG, NX_NLI, NY_NLI
- +, JX_FEND, JY_FEND, NLI_MAT
- +, JX_NTH, JX_JSL, JX_JTX, JX_NCH
- +, JY_NTH, JY_JSL, JY_JTX, JY_NCH
- +, LXV_FAI(LGLIV), LYV_FAI(LGLIV)
- +, LXV_SCA(LGLIV), LYV_SCA(LGLIV)
- +, LXV_MAT(LGLIV), LYV_MAT(LGLIV)
-C-------------- End CDE -------------------
-
-
- JX_NTH = JX_NTH + 1
- JX_JSL = JX_NTH + JX_ORG
- JX_JTX = MLIAD(JX_JSL)
- JX_NCH = MLIAD(JX_JSL+1) - JX_JTX - NCHNEWL
- RETURN
- END
diff --git a/src/p5boot/p5lib/dif_ny.f b/src/p5boot/p5lib/dif_ny.f
deleted file mode 100644
index 1dfba2a..0000000
--- a/src/p5boot/p5lib/dif_ny.f
+++ /dev/null
@@ -1,30 +0,0 @@
-CDECK ID>, DIF_NY.
- SUBROUTINE DIF_NY
-
-C- Step the current line on "new" by +1
-
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- PARAMETER (LGLIV=4, LGLIV2=8)
- COMMON /DIFXC/ JX_ORG, JY_ORG, NX_NLI, NY_NLI
- +, JX_FEND, JY_FEND, NLI_MAT
- +, JX_NTH, JX_JSL, JX_JTX, JX_NCH
- +, JY_NTH, JY_JSL, JY_JTX, JY_NCH
- +, LXV_FAI(LGLIV), LYV_FAI(LGLIV)
- +, LXV_SCA(LGLIV), LYV_SCA(LGLIV)
- +, LXV_MAT(LGLIV), LYV_MAT(LGLIV)
-C-------------- End CDE -------------------
-
-
- JY_NTH = JY_NTH + 1
- JY_JSL = JY_NTH + JY_ORG
- JY_JTX = MLIAD(JY_JSL)
- JY_NCH = MLIAD(JY_JSL+1) - JY_JTX - NCHNEWL
- RETURN
- END
diff --git a/src/p5boot/p5lib/dif_same.f b/src/p5boot/p5lib/dif_same.f
deleted file mode 100644
index e71344c..0000000
--- a/src/p5boot/p5lib/dif_same.f
+++ /dev/null
@@ -1,40 +0,0 @@
-CDECK ID>, DIF_SAME.
- SUBROUTINE DIF_SAME (NTHX,NTHY,NMAT)
-
-C- Compare the 2 lines NTHX and NTHY,
-C- return: NMAT = 0/1 for no/yes
-
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- PARAMETER (LGLIV=4, LGLIV2=8)
- COMMON /DIFXC/ JX_ORG, JY_ORG, NX_NLI, NY_NLI
- +, JX_FEND, JY_FEND, NLI_MAT
- +, JX_NTH, JX_JSL, JX_JTX, JX_NCH
- +, JY_NTH, JY_JSL, JY_JTX, JY_NCH
- +, LXV_FAI(LGLIV), LYV_FAI(LGLIV)
- +, LXV_SCA(LGLIV), LYV_SCA(LGLIV)
- +, LXV_MAT(LGLIV), LYV_MAT(LGLIV)
-C-------------- End CDE -------------------
- LOGICAL LN_EQU
-
-
- IF (JX_NTH.NE.NTHX) CALL DIF_LX (NTHX)
- IF (JY_NTH.NE.NTHY) CALL DIF_LY (NTHY)
-
- N = JX_NCH
- IF (JY_NCH.EQ.N) THEN
- IF (N.EQ.0) GO TO 24
- IF (LN_EQU(TEXT(JX_JTX),TEXT(JY_JTX),N)) GO TO 24
- ENDIF
- NMAT = 0
- RETURN
-
- 24 NMAT = 1
- RETURN
- END
diff --git a/src/p5boot/p5lib/dif_tail.f b/src/p5boot/p5lib/dif_tail.f
deleted file mode 100644
index 103aae1..0000000
--- a/src/p5boot/p5lib/dif_tail.f
+++ /dev/null
@@ -1,35 +0,0 @@
-CDECK ID>, DIF_TAIL.
- SUBROUTINE DIF_TAIL (MGOOD)
-
-C- Check whether the very last lines of the 2 ranges match,
-C- on entry: MGOOD with the last 2 entries of the GOOD table
-C- on exit: MGOOD updated
-
- PARAMETER (LGLIV=4, LGLIV2=8)
- COMMON /DIFXC/ JX_ORG, JY_ORG, NX_NLI, NY_NLI
- +, JX_FEND, JY_FEND, NLI_MAT
- +, JX_NTH, JX_JSL, JX_JTX, JX_NCH
- +, JY_NTH, JY_JSL, JY_JTX, JY_NCH
- +, LXV_FAI(LGLIV), LYV_FAI(LGLIV)
- +, LXV_SCA(LGLIV), LYV_SCA(LGLIV)
- +, LXV_MAT(LGLIV), LYV_MAT(LGLIV)
-C-------------- End CDE -------------------
- DIMENSION MGOOD(6)
-
-
- IF (MGOOD(4).NE.0) RETURN
- NMAT = MGOOD(1)
- NLDEL = MGOOD(5) - (MGOOD(2) + NMAT)
- NLINS = MGOOD(6) - (MGOOD(3) + NMAT)
- NPOSS = MIN (NLDEL,NLINS)
- IF (NPOSS.EQ.0) RETURN
-
- CALL DIF_LX (NX_NLI)
- CALL DIF_LY (NY_NLI)
- CALL DIF_BACK (NPOSS,NMAT)
- IF (NMAT.EQ.0) RETURN
- MGOOD(4) = NMAT
- MGOOD(5) = JX_NTH
- MGOOD(6) = JY_NTH
- RETURN
- END
diff --git a/src/p5boot/p5lib/dif_xqt.f b/src/p5boot/p5lib/dif_xqt.f
deleted file mode 100644
index 4e89857..0000000
--- a/src/p5boot/p5lib/dif_xqt.f
+++ /dev/null
@@ -1,302 +0,0 @@
-CDECK ID>, DIF_XQT.
- SUBROUTINE DIF_XQT (JSLX,NSLX, JSLY,NSLY, NQUICKP)
-
-C- Excute differencing,
-C- On entry:
-C- JSLX slot number in MLIAD of the first line on "old"
-C- NSLX number of lines on "old"
-C- JSLY, NSLY same for "new"
-C-
-C- NQUICK if not zero:
-C- quick test only to see if at least NQUICK lines do match,
-C- if not so: reset NQUICK to zero
-C- if so: leave NQUICK unchanged,
-C- return NFAID = 0: perfect match (identity)
-C- 1: good but not perfect
-
-C- On exit if NQUICK =zero on entry:
-C- Failure table in MFAID, from JFAIDA to JFAIDE-1,
-C- at the start of control division 2, NFAID entries;
-C- one entry of 5 words describes one failure :
-C-
-C- MFAID(JFAID + 0 : code -1 pure delete
-C- 0 delete / insert
-C- +1 pure insert
-C- + 1 : n of failure-start line for "old"
-C- + 2 : n of failure-start line for "new"
-C- + 3 : no. of lines deleted
-C- + 4 : no. of lines inserted
-
-C- Internal:
-C- Table of matching regions, one entry describes
-C- one set of matching lines:
-C-
-C- MGOOD(JGOOD + 0 : NM number of matching lines
-C- + 1 : JX ordinal number of first line on "old"
-C- + 2 : JY ... on "new"
-C-
-C- The first entry is at JGOOD = JGOODA
-C- the last entry is at JGOOD = JGOODE - 3
-
- COMMON /QUNIT/ IQREAD,IQPRNT, IQTTIN,IQTYPE, IQOFFL,IQRTTY,IQRSAV
- +, IQRFD,IQRRD,IQRSIZ, NQLPAT,NQUSED,NQLLBL, NQINIT
- COMMON /MQCM/ NQSYSS,NQLINK, LQCSTA(3),LQCEND(3), NQMAX
- +, LQLSTA(5),LQLEND(5), LQADR,LQADR0,NQOFFS
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
- COMMON /DIFFC/ NFAID, JFAIDA, JFAIDE
- PARAMETER (LGLIV=4, LGLIV2=8)
- COMMON /DIFXC/ JX_ORG, JY_ORG, NX_NLI, NY_NLI
- +, JX_FEND, JY_FEND, NLI_MAT
- +, JX_NTH, JX_JSL, JX_JTX, JX_NCH
- +, JY_NTH, JY_JSL, JY_JTX, JY_NCH
- +, LXV_FAI(LGLIV), LYV_FAI(LGLIV)
- +, LXV_SCA(LGLIV), LYV_SCA(LGLIV)
- +, LXV_MAT(LGLIV), LYV_MAT(LGLIV)
-C-------------- End CDE -------------------
- COMMON /SLATE/ NDSLAT,NESLAT,DUMMY(38)
-
- DIMENSION MGOOD(NSIZEQ), MHAVE(NSIZEQ), MFAID(NSIZEQ)
- EQUIVALENCE (MGOOD,IQ), (MHAVE,IQ), (MFAID,IQ)
-
-
- NQUICK = NQUICKP
- JX_ORG = JSLX - 1
- JY_ORG = JSLY - 1
- IF (JX_ORG.LT.0 .OR. JY_ORG.LT.0)
- + CALL P_CRASH ('Faulty slot number in DIF_XQT')
- NX_NLI = NSLX
- NY_NLI = NSLY
-
- LOWQ = LQCSTA(2)
- LIMQ = LQCSTA(3)
- JGOODA = LOWQ
- JHAVEE = LIMQ - 6
-
- JFAIDA = LOWQ
- JFAIDE = JFAIDA
- NFAID = 0
-
-C-------- Start, set up a first GOOD table -------
-
- CALL DIF_LX (1)
- CALL DIF_LY (1)
-
-C-- Walk along to find the first failure
-
- CALL DIF_HEAD
- IF (NDSLAT.EQ.2) RETURN
- NFAID = 1
-
- JGOOD = JGOODA
- NGOOD = JX_NTH - 1
- MGOOD(JGOOD) = NGOOD
- MGOOD(JGOOD+1) = 1
- MGOOD(JGOOD+2) = 1
- JGOOD = JGOOD + 3
-
- MGOOD(JGOOD) = 0
- MGOOD(JGOOD+1) = NX_NLI + 1
- MGOOD(JGOOD+2) = NY_NLI + 1
- JGOODE = JGOOD + 3
- IF (NDSLAT.NE.0) THEN
- NGOOD = NGOOD + 1
- MGOOD(JGOODA) = NGOOD
- JHAVEA = JHAVEE - 6
- CALL UCOPY (MGOOD(JGOODA),MHAVE(JHAVEA),6)
- GO TO 61
- ENDIF
-
- MAXGAP = MIN (NX_NLI-JX_NTH, NY_NLI-JY_NTH) + 1
- MIMAT = MIN (MAXGAP/2,128)
- MILILE = 14
- IFTAIL = 0
-
-C-------- Match, construct a new GOOD table --------------
-
- 21 IF (NQUICK.NE.0) THEN
- IF (NGOOD.GE.NQUICK) RETURN
- ENDIF
-
- MIMAT = MIN (MIMAT,MAXGAP)
- IF (MIMAT.GE.8) THEN
- MIMAT = MIMAT/2
- ELSE
- MIMAT = MIN(MIMAT,5) - 1
- ENDIF
-
- NWD = JGOODE - JGOODA
- JHAVEA = JHAVEE - NWD
- IF (JHAVEA.GT.JGOODE) THEN
- CALL UCOPY (MGOOD(JGOODA),MHAVE(JHAVEA),NWD)
- ELSE
- CALL UCOPY2 (MGOOD(JGOODA),MHAVE(JHAVEA),NWD)
- ENDIF
- IF (MIMAT.LT.0) GO TO 61
-
- MAXGAP = 0
- NGOOD = 0
- JGOOD = JGOODA
- JHAVE = JHAVEA
- LMATX = 1
- LMATY = 1
- NMAT = MHAVE(JHAVE)
- JX_FEND = 0
- JY_FEND = 0
- GO TO 34
-
-C------ Scan all failure regions
-
-C-- No new match, use the next pre-established match
-
- 31 LMATX = JX_FEND+1
- LMATY = JY_FEND+1
- NMAT = MATAFT
-
-C-- Is this match an extension of the previous?
-
- 32 N = MGOOD(JGOOD-3)
- NFX = LMATX - (MGOOD(JGOOD-2)+N)
- NFY = LMATY - (MGOOD(JGOOD-1)+N)
- IF (NFX.NE.0) GO TO 33
- IF (NFY.NE.0) GO TO 33
- MGOOD(JGOOD-3) = N + NMAT
- NGOOD = NGOOD + NMAT
- GO TO 36
-
-C-- Record this match
-
- 33 MAXGAP = MAX (MAXGAP, MIN(NFX,NFY))
- IF (JGOOD+4.GE.JHAVEA) GO TO 60
- 34 MGOOD(JGOOD) = NMAT
- MGOOD(JGOOD+1) = LMATX
- MGOOD(JGOOD+2) = LMATY
- JGOOD = JGOOD + 3
- NGOOD = NGOOD + NMAT
-
- 36 LFAIX = LMATX + NMAT
- LFAIY = LMATY + NMAT
-
-C-- Moving into the next HAVE region?
-
- N = 0
- IF (LFAIX.GT.JX_FEND) N= 1
- IF (LFAIY.GT.JY_FEND) N= N+1
- IF (N.EQ.0) GO TO 37
- IF (N.EQ.1) GO TO 31
-
- JHAVE = JHAVE + 3
- IF (JHAVE.GE.JHAVEE) GO TO 49
- MATAFT = MHAVE(JHAVE)
- JX_FEND = MHAVE(JHAVE+1) - 1
- JY_FEND = MHAVE(JHAVE+2) - 1
-
-C-- Is the failure gap too small to contain a possible match,
-C-- or is it too big for small MIMAT ?
-
- 37 NFAIX = JX_FEND+1 - LFAIX
- NFAIY = JY_FEND+1 - LFAIY
- NGAP = MIN (NFAIX, NFAIY)
- IF (NGAP.LE.MIMAT) GO TO 31
-
- IF (MIMAT.LT.3) THEN
- NDIS = MAX (NFAIX, NFAIY) - NGAP
- N = 2*NDIS + NGAP
- IF (N.GE.24*(MIMAT+1)) GO TO 31
- ENDIF
-
-C-- Find match, if any, in this failure gap
-
- CALL DIF_LX (LFAIX)
- CALL DIF_LY (LFAIY)
- CALL DIF_FMAT (MILILE,MIMAT)
- IF (NLI_MAT.EQ.0) GO TO 31
- LMATX = LXV_MAT(1)
- LMATY = LYV_MAT(1)
- NMAT = NLI_MAT
-
-C-- Forward extension of imprecise match
-
- IF (MATAFT.LT.2) GO TO 32
- LNNX = LMATX + NMAT
- LNNY = LMATY + NMAT
- IF (LNNX.NE.JX_FEND+1) THEN
- IF (LNNY.NE.JY_FEND+1) GO TO 32
- ENDIF
- CALL DIF_SAME (LNNX,LNNY,IFSAME)
- IF (IFSAME.EQ.0) GO TO 32
-
- NLEXT = 0
- 42 NLEXT = NLEXT + 1
- IF (NLEXT.LT.MATAFT-1) THEN
- CALL DIF_NX
- CALL DIF_NY
- CALL DIF_SAME (JX_NTH, JY_NTH, IFSAME)
- IF (IFSAME.NE.0) GO TO 42
- ENDIF
- NMAT = NMAT + NLEXT
- JX_FEND = JX_FEND + NLEXT
- JY_FEND = JY_FEND + NLEXT
- MATAFT = MATAFT - NLEXT
- GO TO 32
-
-C-- End of this iteration
-
- 49 JGOODE = JGOOD
- IF (MIMAT.GT.9) GO TO 21
- IF (IFTAIL.NE.0) GO TO 21
- CALL DIF_TAIL (MGOOD(JGOODE-6))
- IFTAIL = 7
- GO TO 21
-
-C-------- Convert MHAVE table to MFAID table --------------
-
- 60 CONTINUE
- 61 IF (NQUICK.NE.0) THEN
- IF (NGOOD.LT.NQUICK) NQUICKP= 0
- RETURN
- ENDIF
-
- JHAVEE = JHAVEE - 3
-
- JHAVE = JHAVEA
- JFAID = JFAIDA
- 64 JCODE = 0
- NMAT = MHAVE(JHAVE)
- JFGOX = MHAVE(JHAVE+1) + NMAT
- JFGOY = MHAVE(JHAVE+2) + NMAT
- NLDEL = MHAVE(JHAVE+4) - JFGOX
- NLINS = MHAVE(JHAVE+5) - JFGOY
-
- IF (NLINS.EQ.0) THEN
- JCODE = -1
- ELSE
- IF (NLDEL.EQ.0) JCODE= 1
- ENDIF
-
- MFAID(JFAID) = JCODE
- MFAID(JFAID+1) = JFGOX
- MFAID(JFAID+2) = JFGOY
- MFAID(JFAID+3) = NLDEL
- MFAID(JFAID+4) = NLINS
- JFAID = JFAID + 5
- JHAVE = JHAVE + 3
- IF (JHAVE.LT.JHAVEE) GO TO 64
- JFAIDE = JFAID
- NFAID = (JFAIDE-JFAIDA) /5
-
- IF (JFAIDE.GT.LIMQ) CALL P_KILL ('Capacity exceeded')
- RETURN
- END
diff --git a/src/p5boot/p5lib/dilink.f b/src/p5boot/p5lib/dilink.f
deleted file mode 100644
index 6537d88..0000000
--- a/src/p5boot/p5lib/dilink.f
+++ /dev/null
@@ -1,60 +0,0 @@
-CDECK ID>, DILINK.
- SUBROUTINE DILINK (LOLD,LNEW,LEVEL,NLEN)
-
-C- Link NLEN banks, at least one, starting with LOLD/LNEW
-C- LEVEL = 0,1,2 for bank type DECK, PATCH, PAM
-C- if NLEN < 0: do not count the match (for proxy)
-C. started 16-june-94
-
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
- +, INMEM(2),NSLTOT(2),NSLMAX(2),NTXMAX(2),JSLTTF(2), IFSTRUC
- +, NOBJTT(3,2),NOBJMAT, MDELADD(2,2), LUNCRA,NLSENT, LASTDI
-C-------------- End CDE --------------------------------
-
-
- LX = LOLD
- LN = LNEW
- LEV = LEVEL
- NDO = NLEN
- IF ((LEV.GT.2) .OR. (LEV.LT.0))
- + CALL P_KILL ('LEVEL is faulty in DILINK')
-
- 21 LQ(LX-2) = LN
- LQ(LN-2) = LX
- IQ(LN+5) = IQ(LX+5)
- IF (NDO.GT.0) NOBJMAT= NOBJMAT + 1
- NDO = NDO - 1
- IF (LEV.NE.0) GO TO 26
- 24 IF (NDO.LE.0) RETURN
- LX = LQ(LX-1)
- LN = LQ(LN-1)
- GO TO 21
-
-C-- if a PAT bank has been linked, link also it blank deck
-C-- (similarly for PAM bank)
-
- 26 LXX = LX
- LNN = LN
- LVX = LEV
- 27 LXX = LQ(LXX-4)
- LNN = LQ(LNN-4)
-
- LQ(LXX-2) = LNN
- LQ(LNN-2) = LXX
- LVX = LVX - 1
- IF (LVX.NE.0) GO TO 27
- GO TO 24
- END
diff --git a/src/p5boot/p5lib/diload.f b/src/p5boot/p5lib/diload.f
deleted file mode 100644
index 121e2bc..0000000
--- a/src/p5boot/p5lib/diload.f
+++ /dev/null
@@ -1,118 +0,0 @@
-CDECK ID>, DILOAD.
- SUBROUTINE DILOAD
-
-C- Load first the "new" and then the "old" file
-C. started 3-june-94
-
- COMMON /QUNIT/ IQREAD,IQPRNT, IQTTIN,IQTYPE, IQOFFL,IQRTTY,IQRSAV
- +, IQRFD,IQRRD,IQRSIZ, NQLPAT,NQUSED,NQLLBL, NQINIT
- PARAMETER (NBANKS=19,JBKPAT=1, JBKDEC=2, JBKORG=3, JBKINC=4,
- + JBKHOL=5, JBKKEE=6, JBKACT=7, JBKMAT=8, JBKXSQ=9,
- + JBKPRE=10,JBKGAR=11,JBKSMH=12,JBKSMT=13,JBKSML=14,
- + JBKSMX=15,JBKARR=16,JBKASA=17,JBKPAM=18,JBKRPA=19)
- COMMON /QBANKS/MMBANK(5,NBANKS)
- COMMON /LUNSLN/IFLAUX, IXLUN(12)
- PARAMETER (NSLIFI=128)
- CHARACTER CHLIFI*(NSLIFI), CHLIEX*8
- COMMON /FLINKC/LUNOP,LUNFD,LUNOLD,LUNSIZ
- +, IXFLUN, NLIFI,CHLIFI,CHLIEX
- COMMON /MQCM/ NQSYSS,NQLINK, LQCSTA(3),LQCEND(3), NQMAX
- +, LQLSTA(5),LQLEND(5), LQADR,LQADR0,NQOFFS
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
- +, INMEM(2),NSLTOT(2),NSLMAX(2),NTXMAX(2),JSLTTF(2), IFSTRUC
- +, NOBJTT(3,2),NOBJMAT, MDELADD(2,2), LUNCRA,NLSENT, LASTDI
-C-------------- End CDE --------------------------------
-
-
-C- On the VAX it is more important to keep file "new" in memory
-C- than file "old" because it will need more random access, hence:
-
-C---- read file "new" into division 1, unit 12
-
- CALL INIPAM (12,IXLUN(2),1,0)
- CALL DILREAD (2)
- IF (NSLTOT(2).EQ.0) GO TO 91
- LQLSTA(1) = LQLSTA(2)
-
-C-- is file "new" complete in memory?
-
- IF (INMEM(2).EQ.0) GO TO 27
- NSLFREE = LQLSTA(4) - LQLEND(2)
- NTXFREE = MLIAD(LQLSTA(4)) - MLIAD(LQLEND(2))
- IF (MAX(NSLMAX(2),4000) .GE.NSLFREE) GO TO 27
- IF (MAX(NTXMAX(2),16000).GE.NTXFREE) GO TO 27
- LQLEND(1) = LQLEND(2)
- LQLSTA(2) = LQLEND(2)
- GO TO 31
-
-C-- file "new" has to be handled in pieces
-
- 27 CALL DICLFI (LQUSER(2))
- INMEM(2) = 0
- LQLEND(1) = LQLSTA(1)
- LQLSTA(2) = LQLSTA(1) + NSLMAX(2) + 4
- LQLEND(2) = LQLSTA(2)
- MLIAD(LQLSTA(2)) = MLIAD(LQLSTA(1)) + NTXMAX(2) + 200
-
-C---- read file "old" into division 2, unit 11
-
- 31 CALL MQLIFT (LQHOLD, 0,7, JBKHOL,1)
- CALL MQLIFT (LARRV,LQARRV,1,JBKARR,3)
- CALL INIPAM (11,IXLUN(1),1,0)
- CALL DILREAD (1)
- IF (NSLTOT(1).EQ.0) GO TO 91
-
-C-- is file "old" complete in memory?
-
- IF (INMEM(1).NE.0) GO TO 49
- CALL DICLFI (LQUSER(1))
- JSL1 = LQLSTA(1)
- JSL2 = LQLSTA(2)
- JSL4 = LQLSTA(4)
- JTX1 = MLIAD(JSL1)
- JTX2 = MLIAD(JSL2)
- JTX4 = MLIAD(JSL4)
- IF (INMEM(2).EQ.0) GO TO 47
-
-C- if file "new" is in memory: is there enough space
-C- left for the longest patch on "old" to be read back
-
- IF (JSL2+NSLMAX(1)+8.LT.JSL4) THEN
- IF (JTX2+NTXMAX(1)+8.LT.JTX4) GO TO 48
- ENDIF
- CALL DICLFI (LQUSER(2))
-
-C-- if both files are out of memory, divide the available
-C-- space between them
-
- 47 NSLGAP = JSL4 - JSL1 - NSLMAX(1) - NSLMAX(2)
- NTXGAP = JTX4 - JTX1 - NTXMAX(1) - NTXMAX(2)
- NSLGAP = MAX (4,NSLGAP/2)
- NTXGAP = MAX (4,NTXGAP/2)
- LQLSTA(2) = JSL1 + NSLMAX(2) + NSLGAP
- MLIAD(LQLSTA(2)) = JTX1 + NTXMAX(2) + NTXGAP
-
- 48 LQLEND(2) = LQLSTA(2)
- 49 LQLSTA(3) = LQLSTA(4)
- LQLEND(3) = LQLSTA(3)
- RETURN
-
-C---- Trouble
-
- 91 WRITE (IQPRNT,9091) CHLIFI(1:NLIFI)
- 9091 FORMAT (/' ***!!! file ',A,' is empty !!!***')
- CALL P_KILL ('fatal')
- END
diff --git a/src/p5boot/p5lib/dilook.f b/src/p5boot/p5lib/dilook.f
deleted file mode 100644
index e81f159..0000000
--- a/src/p5boot/p5lib/dilook.f
+++ /dev/null
@@ -1,54 +0,0 @@
-CDECK ID>, DILOOK.
- SUBROUTINE DILOOK (LDX,LDN,NBIAS,LPX,LPN,LOW,NPCENT)
-
-C- Check that the 2 objects at LDX and LDN are the same to NPCENT
-C. started 6-june-94
-
- COMMON /DIFFC/ NFAID, JFAIDA, JFAIDE
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
- +, INMEM(2),NSLTOT(2),NSLMAX(2),NTXMAX(2),JSLTTF(2), IFSTRUC
- +, NOBJTT(3,2),NOBJMAT, MDELADD(2,2), LUNCRA,NLSENT, LASTDI
-C-------------- End CDE --------------------------------
-
-
- NSLX = IQ(LDX+2) - NBIAS
- NSLN = IQ(LDN+2) - NBIAS
-
- NSL1 = MIN (NSLX,NSLN)
- NSL2 = MAX (NSLX,NSLN)
- IF (2*NSL1.LT.NSL2) GO TO 29
-
- NSLM = NPCENT*NSL1 /100
- IF (NSLM.LT.2) GO TO 29
- IF (NSL1.NE.NSL2) THEN
- IF (NSLM.LT.LOW) GO TO 29
- ENDIF
-
- IF (IQ(LPX+1).EQ.0) CALL DINEED (1,LPX)
- IF (IQ(LPN+1).EQ.0) CALL DINEED (2,LPN)
-
- JSLX = IQ(LDX+1) + NBIAS
- JSLN = IQ(LDN+1) + NBIAS
-
- CALL DIF_XQT (JSLX,NSLX, JSLN,NSLN, NSLM)
-
- IF (NSLM.EQ.0) GO TO 29
- IF (NFAID.EQ.0) RETURN
- IF (NSLM.GE.LOW) RETURN
-
- 29 NFAID = -1
- RETURN
- END
diff --git a/src/p5boot/p5lib/dilost.f b/src/p5boot/p5lib/dilost.f
deleted file mode 100644
index cff591f..0000000
--- a/src/p5boot/p5lib/dilost.f
+++ /dev/null
@@ -1,95 +0,0 @@
-CDECK ID>, DILOST.
- SUBROUTINE DILOST
-
-C- Try to find unmatched decks by name+content in foreign patches:
-C- for each "old" patch which has unmatched decks, and which is
-C- matched as a patch with a patch on "new" (ie. which will not
-C- be USE-inhibited), look at its unmatched decks and try to find
-C- them as as-yet unmatched decks in other patches on "new".
-C. started 21-june-94
-
- PARAMETER (KM1=1,KM2=2,KM3=4,KM4=8,KM5=16,KM6=32,KM7=64,KM8=128,
- + KM9=256, KM10=512, KM11=1024, KM12=2048, KM13=4096, KM14=8192,
- + KM15=16384, KM16=32768, KM17=65536, KM18=131072, KM19=262144)
- COMMON /QUNIT/ IQREAD,IQPRNT, IQTTIN,IQTYPE, IQOFFL,IQRTTY,IQRSAV
- +, IQRFD,IQRRD,IQRSIZ, NQLPAT,NQUSED,NQLLBL, NQINIT
- COMMON /DIFFC/ NFAID, JFAIDA, JFAIDE
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
- +, INMEM(2),NSLTOT(2),NSLMAX(2),NTXMAX(2),JSLTTF(2), IFSTRUC
- +, NOBJTT(3,2),NOBJMAT, MDELADD(2,2), LUNCRA,NLSENT, LASTDI
-C-------------- End CDE --------------------------------
-
- IAND (IZV,IZW) = AND (IZV, IZW)
- IOR (IZV,IZW) = OR (IZV, IZW)
-
-
- LFX = LQUSER(1)
- LFN = LQUSER(2)
-
-C------ position to the next patch on OLD
-
- LPX = LQ(LFX-4)
- 22 LPX = LQ(LPX-1)
- IF (LPX.EQ.0) GO TO 68
- IF (IAND(IQ(LPX),KM2).NE.0) GO TO 22
-
- LPNM = LQ(LPX-2)
- IF (LPNM.EQ.0) GO TO 22
-
-C---- position to the next patch on NEW
-
- LPN = LQ(LFN-4)
- 24 LPN = LQ(LPN-1)
- IF (LPN.EQ.0) GO TO 22
- IF (IAND(IQ(LPN),KM2).NE.0) GO TO 24
- IF (LPN.EQ.LPNM) GO TO 24
-
-C-- try all "old" decks against all "new" decks of same name
-
- LDX = LQ(LPX-4)
- 42 LDX = LQ(LDX-1)
- IF (LDX.EQ.0) GO TO 24
- IF (LQ(LDX-2).NE.0) GO TO 42
-
- LDN = LQ(LPN-4)
- 44 LDN = LQ(LDN-1)
- IF (LDN.EQ.0) GO TO 42
- IF (LQ(LDN-2).NE.0) GO TO 44
- IF (IQ(LDN+4).NE.IQ(LDX+4)) GO TO 44
-
-C-- found a deck of the same name on "old" and "new",
-C-- verify that the contents match
-
- CALL DILOOK (LDX,LDN,0,LPX,LPN,8,60)
-
- IF (NFAID.LT.0) GO TO 42
- IF (NFAID.EQ.0) IQ(LDX+6)=4
-
- CALL DILINK (LDX, LDN, 0,1)
- IQ(LDN+6) = 4 + IQ(LPNM+4)
- IQ(LPN) = IOR (IQ(LPN),KM4)
-
- CALL DINOUN (LPX)
- CALL DINOUN (LPN)
- IF (IAND(IQ(LPX),KM2).NE.0) GO TO 22
- IF (IAND(IQ(LPN),KM2).NE.0) GO TO 24
- GO TO 42
-
-C-- done
-
- 68 CONTINUE
- RETURN
- END
diff --git a/src/p5boot/p5lib/dilread.f b/src/p5boot/p5lib/dilread.f
deleted file mode 100644
index 7b993da..0000000
--- a/src/p5boot/p5lib/dilread.f
+++ /dev/null
@@ -1,186 +0,0 @@
-CDECK ID>, DILREAD.
- SUBROUTINE DILREAD (JFILE)
-
-C- Load the file JFILE = 1 old, 2 new
-C. started 3-june-94
-
- COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT,NUSLAT(2),DUMMY(34)
- CHARACTER SLLINE*512, SLERRM*256
- COMMON /SLATLN/ SLLINE, SLERRM
- PARAMETER (NBANKS=19,JBKPAT=1, JBKDEC=2, JBKORG=3, JBKINC=4,
- + JBKHOL=5, JBKKEE=6, JBKACT=7, JBKMAT=8, JBKXSQ=9,
- + JBKPRE=10,JBKGAR=11,JBKSMH=12,JBKSMT=13,JBKSML=14,
- + JBKSMX=15,JBKARR=16,JBKASA=17,JBKPAM=18,JBKRPA=19)
- COMMON /QBANKS/MMBANK(5,NBANKS)
- COMMON /QUNIT/ IQREAD,IQPRNT, IQTTIN,IQTYPE, IQOFFL,IQRTTY,IQRSAV
- +, IQRFD,IQRRD,IQRSIZ, NQLPAT,NQUSED,NQLLBL, NQINIT
- COMMON /ARRCOM/IN_LUN, IN_FD, IN_FIO, IN_EOF
- +, IN_DOX, IN_DO1, IN_DO2
- PARAMETER (MCCNIL=1, MCCKIL=2, MCCINC=3, MCCCDE=4, MCCSEQ=5,
- + MCCXSQ=6, MCCTRU=7, MCCFAL=8, MCCELS=9, MCCEND=10,
- + MCCSEL=11, MCCSES=12, MCCFAU=13, MCCSKI=14,
- + MCCKEE=15, MCCDEL=16, MCCREP=17, MCCADB=18, MCCADD=19,
- + MCCUSE=20, MCCXDI=21, MCCDIV=22, MCCLIS=23, MCCEXE=24, MCCIMI=25,
- + MCCASM=26, MCCUPD=27, MCCNAM=28, MCCGAP=29, MCCMOR=30, MCCONL=31,
- + MCCFOR=32, MCCSUS=33, MCCOPT=34, MCCOP2=35, MCCSHO=36, MCCPAM=37,
- + MCCQUI=38, MCCEOD=39, MCCDEC=40, MCCPAT=41, MCCTIT=42)
- CHARACTER CCKORG*256, CCKARD*256, CCCOMF*256
- COMMON /CCPARA/NCHCCD,NCHCCT, JCCTYP,JCCLEV,JCCSL,MCCPAR(240)
- +, NCCPAR,MXCCIF,JCCIFV,JCCBAD,JCCWAR,ICCSUB,JCCWK(4)
- +, JCCPP,JCCPD,JCCPZ,JCCPT,JCCPIF,JCCPC,JCCPN
- +, NCCPP,NCCPD,NCCPZ,NCCPT,NCCPIF,NCCPC,NCCPN
- +, JCCEND, NCHCCC,IXCCC, CCKORG, CCKARD, CCCOMF
- CHARACTER CHEXPD*68
- COMMON /CHEXC/ IXEXPAM, IXEXPAT,IXEXDEC,IXEXID, NCHEPD, CHEXPD
- COMMON /MQCM/ NQSYSS,NQLINK, LQCSTA(3),LQCEND(3), NQMAX
- +, LQLSTA(5),LQLEND(5), LQADR,LQADR0,NQOFFS
- PARAMETER (KQUSER=9)
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
- +, INMEM(2),NSLTOT(2),NSLMAX(2),NTXMAX(2),JSLTTF(2), IFSTRUC
- +, NOBJTT(3,2),NOBJMAT, MDELADD(2,2), LUNCRA,NLSENT, LASTDI
-C-------------- End CDE --------------------------------
-
-
- JFI = JFILE
- LFILE = KQUSER + JFI + 2
- NSLCUM = 0
- NTXCUM = 0
- JDKNEX = 0
- JDKSUB = 3
- NPAT = 0
- NDECK = 0
-
- LQLSTA(3) = LQLEND(2)
- LQLEND(3) = LQLSTA(3)
-
- 21 IF (JDKNEX.EQ.0) CALL ARRIVE (2)
- IF (JDKSUB.EQ.3) JDKTYP= 3
-
- 22 JSLF = IQ(LQHOLD+1)
- NSLF = IQ(LQHOLD+3)
- JDKSUB = 0
- IXEXDEC = 0
- IFLGAR = 0
-
- IF (JDKTYP.EQ.1) GO TO 43
- IF (JDKTYP.EQ.2) GO TO 41
-
-C---- Deck header is +TITLE or start of PAM
-
- CALL MQLIFT (LFILE, LFILE,-3, JBKPAT,3)
- IF (NOBJTT(3,JFI).EQ.0) LPAT = LFILE - 3
- NOBJTT(3,JFI) = NOBJTT(3,JFI) + 1
-
- CALL KRTITL
-
- IQ(LFILE+1) = JSLF
- IQ(LFILE+4) = IXEXPAM
- IQ(LFILE+7) = NSLCUM
- IQ(LFILE+8) = NTXCUM
-
-
- JSLTTL = IQ(LARRV+10)
- IF (NOBJTT(3,JFI).EQ.1) JSLTTF(JFI)= JSLTTL
-
- CALL LN_GET (JSLTTL, SLLINE, 72)
- NTXT = NDSLAT
-
- CALL DPBLAN (0)
- WRITE (IQPRNT,9027) SLLINE(1:NTXT)
- IF (IQPRNT.NE.IQTYPE) WRITE (IQTYPE,9027) SLLINE(1:NTXT)
-
- 9027 FORMAT (' Read Pam file: ',A/)
-
-C-- check file starts with +PATCH or +DECK
-
- IF (JCCTYP.EQ.MCCDEC) JDKSUB= 1
- IF (JCCTYP.EQ.MCCPAT) JDKSUB= 2
- IF (JDKSUB.NE.0) NSLF = 0
- GO TO 42
-
-C---- Deck header is +PATCH, name
-
- 41 JCCTYP = MCCPAT
- CALL CCKRAK (JSLF)
- IXEXPAT = MCCPAR(JCCPP+1)
- IF (IXEXPAT.EQ.0) IXEXPAT= 1
- 42 CALL MQLIFT (LPAT, LPAT,-1, JBKPAT,3)
- NOBJTT(2,JFI) = NOBJTT(2,JFI) + 1
- LQ(LPAT-3) = LFILE
- IQ(LPAT+1) = JSLF
- IQ(LPAT+4) = IXEXPAT
- IQ(LPAT+5) = NPAT
- IQ(LPAT+7) = NSLCUM
- IQ(LPAT+8) = NTXCUM
- IF (JFI.NE.2) NPAT= NPAT + 1
- IF (JDKTYP.EQ.3) LQ(LFILE-4)= LPAT
- LDECK = LPAT - 3
- GO TO 44
-
-C---- Deck header is +DECK, name
-
- 43 JCCTYP = MCCDEC
- CALL CCKRAK (JSLF)
- IXEXDEC = MCCPAR(JCCPD+1)
- IF (IXEXDEC.EQ.0) IXEXDEC= 1
- 44 CALL MQLIFT (LDECK, LDECK,-1, JBKDEC,3)
- NOBJTT(1,JFI) = NOBJTT(1,JFI) + 1
- LQ(LDECK-3) = LPAT
-
- NTXF = MLIAD(JSLF+NSLF) - MLIAD(JSLF)
-
- IQ(LDECK+1) = JSLF
- IQ(LDECK+2) = NSLF
- IQ(LDECK+3) = NTXF
- IQ(LDECK+4) = IXEXDEC
- IQ(LDECK+5) = NDECK
- IQ(LDECK+7) = NSLCUM
- IQ(LDECK+8) = NTXCUM
- IF (JFI.NE.2) NDECK= NDECK + 1
-
- IQ(LPAT+2) = IQ(LPAT+2) + NSLF
- IQ(LPAT+3) = IQ(LPAT+3) + NTXF
-
- IQ(LFILE+2) = IQ(LFILE+2) + NSLF
- IQ(LFILE+3) = IQ(LFILE+3) + NTXF
-
- NSLCUM = NSLCUM + NSLF
- NTXCUM = NTXCUM + NTXF
-
-C-- step to the next deck
-
- IF (JDKSUB.NE.0) THEN
- JDKTYP = JDKSUB
- GO TO 22
- ENDIF
-
- CALL ARRNXD (1)
- IF (JDKTYP.LE.1) GO TO 21
- NSLMAX(JFI) = MAX (NSLMAX(JFI),IQ(LPAT+2))
- NTXMAX(JFI) = MAX (NTXMAX(JFI),IQ(LPAT+3))
- IF (JDKTYP.LE.3) GO TO 21
-
- NSLTOT(JFI) = NSLCUM
- JSLF = IQ(LQUSER(JFI)+1)
- IF (JSLF+NSLCUM.EQ.LQLEND(2)) INMEM(JFI)= NSLCUM
-
-C-- rewind
-
- IN_DOX = 0
- CALL ARRIN
- CALL DIDUPL (JFI)
- RETURN
- END
diff --git a/src/p5boot/p5lib/dimname.f b/src/p5boot/p5lib/dimname.f
deleted file mode 100644
index c21b09c..0000000
--- a/src/p5boot/p5lib/dimname.f
+++ /dev/null
@@ -1,79 +0,0 @@
-CDECK ID>, DIMNAME.
- SUBROUTINE DIMNAME (LOLDUP,LNEWUP,LEVEL,IFLINK,IST)
-
-C- Match the dependent banks of the "old" structure LOLDUP to LNEWUP
-C- LEVEL = 0/1 dependent banks are decks/patches
-C- IFLINK = 0/1 do not/do link the matching banks
-C- return IST = 0 exact match
-C- >0 otherwise
-C- IQUEST(1) = number of matching banks
-C. started 3-june-94
-
- PARAMETER (KM1=1,KM2=2,KM3=4,KM4=8,KM5=16,KM6=32,KM7=64,KM8=128,
- + KM9=256, KM10=512, KM11=1024, KM12=2048, KM13=4096, KM14=8192,
- + KM15=16384, KM16=32768, KM17=65536, KM18=131072, KM19=262144)
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
- +, INMEM(2),NSLTOT(2),NSLMAX(2),NTXMAX(2),JSLTTF(2), IFSTRUC
- +, NOBJTT(3,2),NOBJMAT, MDELADD(2,2), LUNCRA,NLSENT, LASTDI
-C-------------- End CDE --------------------------------
- EQUIVALENCE (NLEN,IQUEST(1))
-
- IOR (IZV,IZW) = OR (IZV, IZW)
-
-
- NMATCH = 0
- ISTAT = 0
- LOLDF = LQ(LOLDUP-4)
- LOLDF = LQ(LOLDF-1)
- LOLD = LOLDF
-
- LNEWF = LQ(LNEWUP-4)
- LNEWF = LQ(LNEWF-1)
-
- IF (LOLDF+LNEWF.EQ.0) GO TO 37
- IF (LOLDF.NE.0) THEN
- IF (LNEWF.NE.0) GO TO 27
- ENDIF
- ISTAT = 1
- GO TO 39
-
-C-- match each as-yet unmatched bank of the OLD structure
-
- 24 CALL DIMSTR (LOLD, LNEWF, LEVEL, IFLINK, IRC)
- NMATCH = NMATCH + NLEN
- ISTAT = MAX (ISTAT,IRC)
-
- IF (IRC.LT.2) GO TO 31
-
- 26 LOLD = LQ(LOLD-1)
- IF (LOLD.EQ.0) GO TO 31
- 27 IF (LQ(LOLD-2).EQ.0) GO TO 24
- GO TO 26
-
-C-- end of OLD reached
-
- 31 IF (ISTAT.NE.0) GO TO 39
-
-C-- exact match of the whole structure
-
- 37 IF (IFLINK.EQ.0) GO TO 39
- IQ(LOLDUP) = IOR (IQ(LOLDUP),KM1+KM2+KM3)
- IQ(LNEWUP) = IOR (IQ(LNEWUP),KM1+KM2+KM3)
-
- 39 IQUEST(1) = NMATCH
- IST = ISTAT
- RETURN
- END
diff --git a/src/p5boot/p5lib/dimstr.f b/src/p5boot/p5lib/dimstr.f
deleted file mode 100644
index 4e6a3b3..0000000
--- a/src/p5boot/p5lib/dimstr.f
+++ /dev/null
@@ -1,78 +0,0 @@
-CDECK ID>, DIMSTR.
- SUBROUTINE DIMSTR (LOLDF,LNEWF,LEVEL,IFLINK,IST)
-
-C- Find first match of bank at LOLDF in lin/st at LNEWF
-C- LEVEL = 0,1,2 for bank type DECK, PATCH, PAM
-C- IFLINK = 0/1 do not/do link the matching banks
-C- return IST = 0 exact match
-C- 1 all remain OLD banks have matched
-C- 2 more OLD banks to be tried
-C- IQUEST(1) = number of consecutive matching banks
-C. started 3-june-94
-
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
- +, INMEM(2),NSLTOT(2),NSLMAX(2),NTXMAX(2),JSLTTF(2), IFSTRUC
- +, NOBJTT(3,2),NOBJMAT, MDELADD(2,2), LUNCRA,NLSENT, LASTDI
-C-------------- End CDE --------------------------------
-
-
- LOLD = LOLDF
- LNEW = LNEWF
- IXNM = IQ(LOLD+4)
-
-C-- find the start of match
-
- NLEN = 0
- ISTAT = 0
- IF (LQ(LNEW-2).EQ.0 .AND. IQ(LNEW+4).EQ.IXNM) GO TO 31
-
- ISTAT = 2
- 24 LNEW = LQ(LNEW-1)
- IF (LNEW.EQ.0) GO TO 49
- IF (IQ(LNEW+4).NE.IXNM) GO TO 24
- IF (LQ(LNEW-2).NE.0) GO TO 24
-
-C-- find the length of the match
-
- 31 LOLDM = LOLD
- LNEWM = LNEW
- NLEN = 1
-
- 32 LOLD = LQ(LOLD-1)
- LNEW = LQ(LNEW-1)
- IF (LOLD.EQ.0) GO TO 41
- IF (LNEW.EQ.0) GO TO 42
-
- IF (IQ(LNEW+4).NE.IQ(LOLD+4)) GO TO 42
- IF (LQ(LNEW-2).NE.0) GO TO 42
- NLEN = NLEN + 1
- GO TO 32
-
-C-- store the match
-
- 41 ISTAT = MIN(1,ISTAT)
- IF (LNEW.NE.0) ISTAT= 1
- GO TO 43
-
- 42 ISTAT = 2
- 43 IF (IFLINK.EQ.0) GO TO 49
-
- CALL DILINK (LOLDM,LNEWM,LEVEL,NLEN)
-
- 49 IQUEST(1) = NLEN
- IST = ISTAT
- RETURN
- END
diff --git a/src/p5boot/p5lib/dineed.f b/src/p5boot/p5lib/dineed.f
deleted file mode 100644
index b811788..0000000
--- a/src/p5boot/p5lib/dineed.f
+++ /dev/null
@@ -1,86 +0,0 @@
-CDECK ID>, DINEED.
- SUBROUTINE DINEED (JFILE,LPAT)
-
-C- The patch pointed to by LPAT from file JFILE is needed in memory
-C. started 15-june-94
-
- COMMON /MQCM/ NQSYSS,NQLINK, LQCSTA(3),LQCEND(3), NQMAX
- +, LQLSTA(5),LQLEND(5), LQADR,LQADR0,NQOFFS
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
- +, INMEM(2),NSLTOT(2),NSLMAX(2),NTXMAX(2),JSLTTF(2), IFSTRUC
- +, NOBJTT(3,2),NOBJMAT, MDELADD(2,2), LUNCRA,NLSENT, LASTDI
-C-------------- End CDE --------------------------------
-
-
- IF (IQ(LPAT+1).NE.0) RETURN
- JFI = JFILE
- JDIV = 3 - JFI
- JDVN = JDIV + 1
-
- JSLLIM = LQLSTA(JDVN)
- JTXLIM = MLIAD(JSLLIM)
-
- NSLTAK = IQ(LPAT+2)
- NTXTAK = IQ(LPAT+3)
- IFLOOP = 0
-
- IF (NSLTAK.LE.0) THEN
- IQ(LPAT+1) = 1
- RETURN
- ENDIF
-
- 22 JSLGO = LQLEND(JDIV)
- JTXGO = MLIAD(JSLGO)
-
- IF (JSLGO+NSLTAK+2 .LT.JSLLIM) THEN
- IF (JTXGO+NTXTAK+2 .LT.JTXLIM) GO TO 24
- ENDIF
-
- IF (IFLOOP.NE.0) GO TO 91
- 23 IFLOOP = 7
-
- CALL DICLFI (LQUSER(JFI))
- LQLEND(JDIV) = LQLSTA(JDIV)
- GO TO 22
-
-C-- read the patch into memory
-
- 24 LARRV = LQARRV
- IF (JFI.EQ.2) LARRV= LQ(LARRV-1)
-
- CALL DINEIN (JSLGO,LPAT)
-
-C-- set the starting slot number of each deck
-
- IQ(LPAT+1) = JSLGO
- JSL = JSLGO
- LDK = LQ(LPAT-4)
- 27 IQ(LDK+1) = JSL
- JSL = JSL + IQ(LDK+2)
- LDK = LQ(LDK-1)
- IF (LDK.NE.0) GO TO 27
- LQLEND(JDIV) = JSL
- JSLE = JSLGO + NSLTAK
- JTXE = JTXGO + NTXTAK
- IF (JSL.NE.JSLE) CALL P_CRASH ('Trouble in DINEED')
- IF (MLIAD(JSL).NE.JTXE) CALL P_CRASH ('Trouble in DINEED')
- RETURN
-
-C-- trouble
-
- 91 CALL P_KILL ('Crash DINEED - large patch too big')
- RETURN
- END
diff --git a/src/p5boot/p5lib/dinein.f b/src/p5boot/p5lib/dinein.f
deleted file mode 100644
index c1c16b9..0000000
--- a/src/p5boot/p5lib/dinein.f
+++ /dev/null
@@ -1,72 +0,0 @@
-CDECK ID>, DINEIN.
- SUBROUTINE DINEIN (JSLGO,LPAT)
-
-C- Read the patch pointed to by LPAT into memory starting at JSLGO
-C. started 21-june-94
-
- COMMON /ARRCOM/IN_LUN, IN_FD, IN_FIO, IN_EOF
- +, IN_DOX, IN_DO1, IN_DO2
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
-C-------------- End CDE --------------------------------
-
-
- IN_FD = IQ(LARRV+2)
-
-C-- position the file
-
- NSLSKI = IQ(LPAT+7)
- NTXSKI = IQ(LPAT+8)
-
- CALL CISEEK (IN_FD,NTXSKI,ISTAT)
- IF (ISTAT.NE.0) CALL P_KILLM ('CIO seek fails')
-
-C-- read the patch
-
- JSLA = JSLGO
- NSLN = IQ(LPAT+2)
- NTXN = IQ(LPAT+3)
- JTXA = MLIAD(JSLA)
-
- CALL CIGET (IN_FD,TEXT(JTXA),NTXN,NTXR,IN_EOF)
- IF (IN_EOF.NE.0) GO TO 93
-
- JTXE = JTXA + NTXR
- IF (ICHAR(TEXT(JTXE-1)) .NE. NEWLN) THEN
- TEXT(JTXE) = CHAR(NEWLN)
- JTXE = JTXE + 1
- NTXR = NTXR + 1
- ENDIF
-
- IF (NTXR.NE.NTXN) GO TO 92
-
-C-- construct the line directory
-
- JSLE = JSLA
-
- DO 26 JTXU=JTXA,JTXE-1
- IF (ICHAR(TEXT(JTXU)) .EQ. NEWLN) THEN
- JSLE = JSLE + 1
- MLIAD(JSLE) = JTXU + 1
- ENDIF
- 26 CONTINUE
- IF (JSLE.NE.JSLA+NSLN) GO TO 91
- RETURN
-
- 91 CALL P_KILL ('Crash DINEIN: wrong number of lines')
- 92 CALL P_KILL ('Crash DINEIN: wrong number of characters')
- 93 CALL P_KILLM ('CIO read fails in DINEIN')
-
- END
diff --git a/src/p5boot/p5lib/dinewp.f b/src/p5boot/p5lib/dinewp.f
deleted file mode 100644
index 9166946..0000000
--- a/src/p5boot/p5lib/dinewp.f
+++ /dev/null
@@ -1,141 +0,0 @@
-CDECK ID>, DINEWP.
- SUBROUTINE DINEWP
-
-C- Create a proxy for each new patch not present on OLD
-C. started 8-mar-95
-
- PARAMETER (NBANKS=19,JBKPAT=1, JBKDEC=2, JBKORG=3, JBKINC=4,
- + JBKHOL=5, JBKKEE=6, JBKACT=7, JBKMAT=8, JBKXSQ=9,
- + JBKPRE=10,JBKGAR=11,JBKSMH=12,JBKSMT=13,JBKSML=14,
- + JBKSMX=15,JBKARR=16,JBKASA=17,JBKPAM=18,JBKRPA=19)
- COMMON /QBANKS/MMBANK(5,NBANKS)
- COMMON /QUNIT/ IQREAD,IQPRNT, IQTTIN,IQTYPE, IQOFFL,IQRTTY,IQRSAV
- +, IQRFD,IQRRD,IQRSIZ, NQLPAT,NQUSED,NQLLBL, NQINIT
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
- +, INMEM(2),NSLTOT(2),NSLMAX(2),NTXMAX(2),JSLTTF(2), IFSTRUC
- +, NOBJTT(3,2),NOBJMAT, MDELADD(2,2), LUNCRA,NLSENT, LASTDI
-C-------------- End CDE --------------------------------
-
-
-C---- scan all patches on NEW
-
- NOP = 0
- LFI = LQUSER(2)
- LPN = LFI - 3
- 62 LPN = LQ(LPN-1)
- IF (LPN.EQ.0) GO TO 87
- LPX = LQ(LPN-2)
- IF (LPX.EQ.0) GO TO 71
-
-C---- scan all decks of this patch
-
- 63 LDN = LPN - 3
- 64 LDN = LQ(LDN-1)
- IF (LDN.EQ.0) GO TO 62
- LDX = LQ(LDN-2)
- IF (LDX.EQ.0) GO TO 64
-
-C-- check the deck is of foreign origin
- IF (IQ(LDN+6).GE.4) GO TO 64
-
-C-- remember this deck for adding to it
- LASTXQ = LDX
- GO TO 64
-
-C------ this patch is new, add a proxy in the OLD structure
-
- 71 NOP = NOP + 1
- LLD = LASTXQ
- LLP = LQ(LLD-3)
-
- CALL MQLIFT (LPIN, LLP,-1, JBKPAT,3)
- LQ(LPIN-3) = LQ(LLP-3)
- IQ(LPIN+1) = 1
- IQ(LPIN+4) = IQ(LPN+4)
- IQ(LPIN+5) = IQ(LLP+5)
- IQ(LPIN+9) = -1
-
- CALL MQLIFT (LDIN, LPIN,-4, JBKDEC,3)
- LQ(LDIN-3) = LPIN
- IQ(LDIN+5) = IQ(LLD+5)
- IQ(LDIN+9) = -1
- LASTXQ = LDIN
-
-C-- match the inserted patch on OLD with the patch on NEW
-
- CALL DILINK (LPIN,LPN,1,-1)
-
-C-- shunt the trailing decks of the old to the inserted patch
-C-- break any match in the trailing decks
-
- LLN = LQ(LLD-1)
- IF (LLN.EQ.0) GO TO 62
-
- JSLN = IQ(LLN+7)
- JTXN = IQ(LLN+8)
-
- JSLF = IQ(LLP+7)
- JTXF = IQ(LLP+8)
-
- NSL1 = JSLN - JSLF
- NTX1 = JTXN - JTXF
-
- NSL2 = IQ(LLP+2) - NSL1
- NTX2 = IQ(LLP+3) - NTX1
-
- IQ(LLP+2) = NSL1
- IQ(LLP+3) = NTX1
-
- IQ(LPIN+1) = 0
- IF (IQ(LLP+1).NE.0) IQ(LPIN+1)= IQ(LLP+1) + NSL1
- IQ(LPIN+2) = NSL2
- IQ(LPIN+3) = NTX2
- IQ(LPIN+4) = IQ(LLP+4)
- IQ(LPIN+7) = JSLF + NSL1
- IQ(LPIN+8) = JTXF + NTX1
-
- IQ(LDIN+1) = IQ(LPIN+1)
- IQ(LDIN+7) = IQ(LPIN+7)
- IQ(LDIN+8) = IQ(LPIN+8)
-
- CALL QSHLIN (LLD-1, LDIN-1)
- CALL DINOUN (LLP)
-
- LD = LDIN
- 74 LD = LQ(LD-1)
- IF (LD.NE.0) THEN
- LQ(LD-3) = LPIN
- LM = LQ(LD-2)
- IF (LM.EQ.0) GO TO 74
- LQ(LD-2) = 0
- LQ(LM-2) = 0
- IQ(LM+5) = 0
- IQ(LM+9) = 0
- GO TO 74
- ENDIF
-
-C-- match the decks by name
-
- CALL DIMNAME (LPIN,LPN, 0, 1, IRC)
-
-C-- match the decks by content
-
- CALL DISAMD (LPIN,LPN)
- GO TO 63
-
- 87 CONTINUE
- RETURN
- END
diff --git a/src/p5boot/p5lib/dinoun.f b/src/p5boot/p5lib/dinoun.f
deleted file mode 100644
index 1496f99..0000000
--- a/src/p5boot/p5lib/dinoun.f
+++ /dev/null
@@ -1,35 +0,0 @@
-CDECK ID>, DINOUN.
- SUBROUTINE DINOUN (LUP)
-
-C- Check there are no unmatched banks depending on LUP left
-C. started 17-june-94
-
- PARAMETER (KM1=1,KM2=2,KM3=4,KM4=8,KM5=16,KM6=32,KM7=64,KM8=128,
- + KM9=256, KM10=512, KM11=1024, KM12=2048, KM13=4096, KM14=8192,
- + KM15=16384, KM16=32768, KM17=65536, KM18=131072, KM19=262144)
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
-C-------------- End CDE --------------------------------
-
- IAND (IZV,IZW) = AND (IZV, IZW)
- IOR (IZV,IZW) = OR (IZV, IZW)
-
-
- IF (IAND(IQ(LUP),KM2).NE.0) RETURN
-
- L = LQ(LUP-4)
- 24 L = LQ(L-1)
- IF (L.NE.0) THEN
- IF (LQ(L-2).EQ.0) RETURN
- GO TO 24
- ENDIF
-
- IQ(LUP) = IOR (IQ(LUP),KM2)
- RETURN
- END
diff --git a/src/p5boot/p5lib/diord.f b/src/p5boot/p5lib/diord.f
deleted file mode 100644
index f8b1aea..0000000
--- a/src/p5boot/p5lib/diord.f
+++ /dev/null
@@ -1,46 +0,0 @@
-CDECK ID>, DIORD.
- SUBROUTINE DIORD
-
-C- Prepare for the re-ordering to operate on "old" updated by
-C- the cradle generated by DICRAD to give "new"; this must
-C- be done before "lost" decks from foreign patches are linked.
-C. started 18-june-94
-
- COMMON /QUNIT/ IQREAD,IQPRNT, IQTTIN,IQTYPE, IQOFFL,IQRTTY,IQRSAV
- +, IQRFD,IQRRD,IQRSIZ, NQLPAT,NQUSED,NQLLBL, NQINIT
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
-C-------------- End CDE --------------------------------
-
-
-C-- ordering the patches of this PAM
-
- LFI = LQUSER(2)
- CALL DIORDX (LFI)
-
- LPNEW = LFI - 3
- 24 LPNEW = LQ(LPNEW-1)
- IF (LPNEW.EQ.0) GO TO 27
- LPOLD = LQ(LPNEW-2)
- IF (LPOLD.EQ.0) GO TO 24
-
-C-- ordering the decks of this patch
-
- CALL DIORDX (LPNEW)
- GO TO 24
-
- 27 CONTINUE
- RETURN
- END
diff --git a/src/p5boot/p5lib/diordx.f b/src/p5boot/p5lib/diordx.f
deleted file mode 100644
index ec2790d..0000000
--- a/src/p5boot/p5lib/diordx.f
+++ /dev/null
@@ -1,70 +0,0 @@
-CDECK ID>, DIORDX.
- SUBROUTINE DIORDX (LUP)
-
-C- Find and record the strings of contiguous matches
-C- (unmatched banks to not disturb the order)
-C. started 18-june-94
-
- PARAMETER (KM1=1,KM2=2,KM3=4,KM4=8,KM5=16,KM6=32,KM7=64,KM8=128,
- + KM9=256, KM10=512, KM11=1024, KM12=2048, KM13=4096, KM14=8192,
- + KM15=16384, KM16=32768, KM17=65536, KM18=131072, KM19=262144)
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
-C-------------- End CDE --------------------------------
-
- IAND (IZV,IZW) = AND (IZV, IZW)
- IOR (IZV,IZW) = OR (IZV, IZW)
-
-
- IF (IAND(IQ(LUP),KM3).NE.0) RETURN
- LNEW = LQ(LUP-4)
- NDIS = 0
-
-C---- start of a new string
-
- 22 LOLD = LQ(LNEW-2)
- LX = LOLD
- LN = LNEW
- NLEN = 0
-
-C-- step to next "new"
-
- 24 LN = LQ(LN-1)
- IF (LN.EQ.0) GO TO 27
- IF (LQ(LN-2).EQ.0) THEN
- IQ(LN+6) = 1
- NLEN = NLEN + 1
- GO TO 24
- ENDIF
-
-C-- step to next "old"
-
- 25 LX = LQ(LX-1)
- IF (LX.EQ.0) GO TO 27
- IF (LQ(LX-2).EQ.0) GO TO 25
- IF (LQ(LX-2).NE.LN) GO TO 27
-
-C-- string continues
-
- NLEN = NLEN + 1
- GO TO 24
-
-C---- end of this string
-
- 27 IQ(LNEW+9) = NLEN
- IF (LN.EQ.0) GO TO 29
- LNEW = LN
- NDIS = 7
- GO TO 22
-
-C---- finished
-
- 29 IF (NDIS.EQ.0) IQ(LUP)= IOR (IQ(LUP),KM3)
- RETURN
- END
diff --git a/src/p5boot/p5lib/diprem.f b/src/p5boot/p5lib/diprem.f
deleted file mode 100644
index e0d878f..0000000
--- a/src/p5boot/p5lib/diprem.f
+++ /dev/null
@@ -1,85 +0,0 @@
-CDECK ID>, DIPREM.
- SUBROUTINE DIPREM
-
-C- Pre-match on the basis of patch/deck names only
-C. started 3-june-94
-
- COMMON /QUNIT/ IQREAD,IQPRNT, IQTTIN,IQTYPE, IQOFFL,IQRTTY,IQRSAV
- +, IQRFD,IQRRD,IQRSIZ, NQLPAT,NQUSED,NQLLBL, NQINIT
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
- +, INMEM(2),NSLTOT(2),NSLMAX(2),NTXMAX(2),JSLTTF(2), IFSTRUC
- +, NOBJTT(3,2),NOBJMAT, MDELADD(2,2), LUNCRA,NLSENT, LASTDI
-C-------------- End CDE --------------------------------
-
-
- CALL DPBLAN (1)
- WRITE (IQPRNT,9001) 'old',NSLTOT(1),NOBJTT(1,1),NOBJTT(2,1)
- WRITE (IQPRNT,9001) 'new',NSLTOT(2),NOBJTT(1,2),NOBJTT(2,2)
- CALL DPBLAN (0)
-
- 9001 FORMAT (' file "',A,'" has',I6,' lines in',I5,' decks, in'
- F,I4,' patches')
-
- CALL DILINK (LQUSER(1), LQUSER(2), 2,1)
-
-C---- match patch names
-
- LFOLD = LQUSER(1)
- LFNEW = LQUSER(2)
- NPMAT = 0
-
- CALL DIMNAME (LFOLD,LFNEW,1,1,IRC)
- NPMAT = NPMAT + IQUEST(1)
-
-C-- each patch: match the deck names
-
- LOLD = LQ(LFOLD-4)
- 36 LNEW = LQ(LOLD-2)
- IF (LNEW.NE.0) CALL DIMNAME (LOLD, LNEW, 0, 1, IRC)
-
- 37 LOLD = LQ(LOLD-1)
- IF (LOLD.NE.0) GO TO 36
-
-C-- match unmatched file titles by position
-
- IF (NOBJTT(3,1).NE.NOBJTT(3,2)) GO TO 49
- LFX = LQUSER(1)
- LFN = LQUSER(2)
- 44 LFX = LQ(LFX-3)
- LFN = LQ(LFN-3)
- IF (LFN.EQ.0) GO TO 49
- LPX = LQ(LFX-4)
- LPN = LQ(LFN-4)
- IF (LQ(LPX-2).NE.0) GO TO 44
- IF (LQ(LPN-2).NE.0) GO TO 44
- CALL DILINK (LPX,LPN,1,1)
- GO TO 44
-
- 49 IF (NOBJTT(1,1).NE.NOBJTT(1,2)) IFSTRUC= 7
- IF (NOBJTT(1,1).NE.NOBJMAT) IFSTRUC= 7
-C-- check that 1/2 of the patches actually match
-
- IF (MOPTIO(1).NE.0) RETURN
-
- NDH = MIN (NOBJTT(1,1), NOBJTT(1,2))
- NPH = MIN (NOBJTT(2,1), NOBJTT(2,2))
- IF (2*NOBJMAT.GE. NDH) RETURN
- IF (2*NPMAT .GE. NPH) RETURN
- IF (NPH.LE.6) RETURN
- CALL P_KILL
- + ('Insufficient number of matching patch-names initially')
- RETURN
- END
diff --git a/src/p5boot/p5lib/disamd.f b/src/p5boot/p5lib/disamd.f
deleted file mode 100644
index 307e27b..0000000
--- a/src/p5boot/p5lib/disamd.f
+++ /dev/null
@@ -1,76 +0,0 @@
-CDECK ID>, DISAMD.
- SUBROUTINE DISAMD (LPOLD,LPNEW)
-
-C- Match unmatched decks of LPOLD and LPNEW by content
-C. started 6-june-94
-
- PARAMETER (KM1=1,KM2=2,KM3=4,KM4=8,KM5=16,KM6=32,KM7=64,KM8=128,
- + KM9=256, KM10=512, KM11=1024, KM12=2048, KM13=4096, KM14=8192,
- + KM15=16384, KM16=32768, KM17=65536, KM18=131072, KM19=262144)
- COMMON /DIFFC/ NFAID, JFAIDA, JFAIDE
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
- +, INMEM(2),NSLTOT(2),NSLMAX(2),NTXMAX(2),JSLTTF(2), IFSTRUC
- +, NOBJTT(3,2),NOBJMAT, MDELADD(2,2), LUNCRA,NLSENT, LASTDI
-C-------------- End CDE --------------------------------
-
- IAND (IZV,IZW) = AND (IZV, IZW)
-
-
- LPX = LPOLD
- LPN = LPNEW
-
- LDX = LQ(LPX-4)
- LDN = LQ(LPN-4)
- LDN = LQ(LDN-1)
- IF (LDN.EQ.0) RETURN
-
-C-- take next unmatched deck on OLD
-
- LDNL = LDN
- 42 LDX = LQ(LDX-1)
- IF (LDX.EQ.0) RETURN
-
- LU = LQ(LDX-2)
- IF (LU.NE.0) THEN
- LDNL = LU
- GO TO 42
- ENDIF
-
-C-- try to pair each unmatched deck on NEW in turn
-
- LDN = LDNL
- 45 IF (LQ(LDN-2).EQ.0) GO TO 47
- 46 LDN = LQ(LDN-1)
- IF (LDN.EQ.0) LDN= LQ(LPN-4)
- IF (LDN.EQ.LDNL) GO TO 42
- GO TO 45
-
-C-- try to match the "new" deck at LDN
-
- 47 CALL DILOOK (LDX,LDN,0,LPX,LPN,8,80)
-
- IF (NFAID.LT.0) GO TO 46
- IF (NFAID.EQ.0) IQ(LDX+6)=4
-
- LDNL = LDN
- CALL DILINK (LDX, LDN, 0,1)
- CALL DINOUN (LPX)
- CALL DINOUN (LPN)
- IF (IAND(IQ(LPX),KM2).NE.0) RETURN
- IF (IAND(IQ(LPN),KM2).NE.0) RETURN
- GO TO 42
-
- END
diff --git a/src/p5boot/p5lib/disame.f b/src/p5boot/p5lib/disame.f
deleted file mode 100644
index 37a37e9..0000000
--- a/src/p5boot/p5lib/disame.f
+++ /dev/null
@@ -1,102 +0,0 @@
-CDECK ID>, DISAME.
- SUBROUTINE DISAME
-
-C- Match unmatched p/d by content, but only from the matching f/p
-C. started 6-june-94
-
- PARAMETER (KM1=1,KM2=2,KM3=4,KM4=8,KM5=16,KM6=32,KM7=64,KM8=128,
- + KM9=256, KM10=512, KM11=1024, KM12=2048, KM13=4096, KM14=8192,
- + KM15=16384, KM16=32768, KM17=65536, KM18=131072, KM19=262144)
- COMMON /QUNIT/ IQREAD,IQPRNT, IQTTIN,IQTYPE, IQOFFL,IQRTTY,IQRSAV
- +, IQRFD,IQRRD,IQRSIZ, NQLPAT,NQUSED,NQLLBL, NQINIT
- COMMON /DIFFC/ NFAID, JFAIDA, JFAIDE
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
- +, INMEM(2),NSLTOT(2),NSLMAX(2),NTXMAX(2),JSLTTF(2), IFSTRUC
- +, NOBJTT(3,2),NOBJMAT, MDELADD(2,2), LUNCRA,NLSENT, LASTDI
-C-------------- End CDE --------------------------------
-
- IAND (IZV,IZW) = AND (IZV, IZW)
-
-
-
- LFX = LQUSER(1)
- LFN = LQUSER(2)
-
- LPNL = LQ(LFN-4)
- LPNL = LQ(LPNL-1)
- IF (LPNL.EQ.0) GO TO 27
-
-C-- take next old patch
-
- LPX = LQ(LFX-4)
- 24 LPX = LQ(LPX-1)
- IF (LPX.EQ.0) GO TO 27
-
- LPNM = LQ(LPX-2)
- IF (LPNM.EQ.0) GO TO 31
-
- 25 LPNL = LPNM
- CALL DINOUN (LPX)
- CALL DINOUN (LPNM)
- IF (IAND(IQ(LPX),KM2) .NE.0) GO TO 24
- IF (IAND(IQ(LPNM),KM2).NE.0) GO TO 24
-
- CALL DISAMD (LPX,LPNM)
- GO TO 24
-
-C-- all patches done
-
- 27 CONTINUE
- RETURN
-
-C-------- match the current unresolved patch on "old" by content
-
- 31 CONTINUE
- LPN = LPNL
- 32 IF (LQ(LPN-2).EQ.0) GO TO 34
- 33 LPN = LQ(LPN-1)
- IF (LPN.EQ.0) THEN
- LPN = LQ(LFN-4)
- LPN = LQ(LPN-1)
- ENDIF
- IF (LPN.EQ.LPNL) GO TO 24
- GO TO 32
-
-C---- try to match the "new" patch at LPN
-
-C-- match by deck-names
-
- 34 CONTINUE
- CALL DIMNAME (LPX,LPN,0,0,ISTAT)
- NLEN = IQUEST(1)
- NOLD = NQCOUNT (LQ(LPX-4))
- NNEW = NQCOUNT (LQ(LPN-4))
- NHAV = MIN (NOLD,NNEW)
- IF (NHAV.EQ.0) GO TO 37
- IF (ISTAT.EQ.0) GO TO 39
- IF (4*NLEN.GE.3*NHAV) GO TO 39
-
-C-- match by text content
-
- 37 CALL DILOOK (LPX,LPN,1,LPX,LPN,12,80)
-
- IF (NFAID.LT.0) GO TO 33
-
- 39 LPNM = LPN
- CALL DILINK (LPX,LPN,1,1)
- CALL DIMNAME (LPX,LPN,0,1,ISTAT)
- GO TO 25
- END
diff --git a/src/p5boot/p5lib/disend.f b/src/p5boot/p5lib/disend.f
deleted file mode 100644
index 2ccfe99..0000000
--- a/src/p5boot/p5lib/disend.f
+++ /dev/null
@@ -1,68 +0,0 @@
-CDECK ID>, DISEND.
- SUBROUTINE DISEND (JSLGO,NSL)
-
-C- Send the NSL lines at JSLGO to the cradle file
-C. started 6-june-94
-
- COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT,NUSLAT(2),DUMMY(34)
- CHARACTER SLLINE*512, SLERRM*256
- COMMON /SLATLN/ SLLINE, SLERRM
- COMMON /QUNIT/ IQREAD,IQPRNT, IQTTIN,IQTYPE, IQOFFL,IQRTTY,IQRSAV
- +, IQRFD,IQRRD,IQRSIZ, NQLPAT,NQUSED,NQLLBL, NQINIT
- PARAMETER (MCCNIL=1, MCCKIL=2, MCCINC=3, MCCCDE=4, MCCSEQ=5,
- + MCCXSQ=6, MCCTRU=7, MCCFAL=8, MCCELS=9, MCCEND=10,
- + MCCSEL=11, MCCSES=12, MCCFAU=13, MCCSKI=14,
- + MCCKEE=15, MCCDEL=16, MCCREP=17, MCCADB=18, MCCADD=19,
- + MCCUSE=20, MCCXDI=21, MCCDIV=22, MCCLIS=23, MCCEXE=24, MCCIMI=25,
- + MCCASM=26, MCCUPD=27, MCCNAM=28, MCCGAP=29, MCCMOR=30, MCCONL=31,
- + MCCFOR=32, MCCSUS=33, MCCOPT=34, MCCOP2=35, MCCSHO=36, MCCPAM=37,
- + MCCQUI=38, MCCEOD=39, MCCDEC=40, MCCPAT=41, MCCTIT=42)
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
- +, INMEM(2),NSLTOT(2),NSLMAX(2),NTXMAX(2),JSLTTF(2), IFSTRUC
- +, NOBJTT(3,2),NOBJMAT, MDELADD(2,2), LUNCRA,NLSENT, LASTDI
-C-------------- End CDE --------------------------------
- CHARACTER LINE*512, COL(512)*1
- EQUIVALENCE (LINE,SLLINE), (COL,SLLINE)
-
-
- IF (LUNCRA.EQ.IQPRNT) THEN
- ASSIGN 9008 TO IFMT
- ELSE
- ASSIGN 9009 TO IFMT
- ENDIF
-
- 9008 FORMAT (3X,A)
- 9009 FORMAT (A)
-
- JSL = JSLGO
-
- DO 24 J=1,NSL
- CALL LN_GET (JSL,LINE,512)
- IF (NDSLAT.EQ.0) THEN
- WRITE (LUNCRA,9009)
- GO TO 24
- ENDIF
-
- IF (COL(1).NE.'+') GO TO 23
- JCCTYP = JPTYPE (LINE)
- IF (JCCTYP.LT.MCCSEL) GO TO 23
- COL(1) = '-'
-
- 23 WRITE (LUNCRA,IFMT) LINE(1:NDSLAT)
- 24 JSL = JSL + 1
- NLSENT = NLSENT + NSL
- RETURN
- END
diff --git a/src/p5boot/p5lib/diwylb.f b/src/p5boot/p5lib/diwylb.f
deleted file mode 100644
index 2ca185e..0000000
--- a/src/p5boot/p5lib/diwylb.f
+++ /dev/null
@@ -1,154 +0,0 @@
-CDECK ID>, DIWYLB.
- SUBROUTINE DIWYLB
-
-C- Make the Wylbur cradle
-C. started 6-june-94
-
- COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT,NUSLAT(2),DUMMY(34)
- CHARACTER SLLINE*512, SLERRM*256
- COMMON /SLATLN/ SLLINE, SLERRM
- PARAMETER (KM1=1,KM2=2,KM3=4,KM4=8,KM5=16,KM6=32,KM7=64,KM8=128,
- + KM9=256, KM10=512, KM11=1024, KM12=2048, KM13=4096, KM14=8192,
- + KM15=16384, KM16=32768, KM17=65536, KM18=131072, KM19=262144)
- COMMON /QUNIT/ IQREAD,IQPRNT, IQTTIN,IQTYPE, IQOFFL,IQRTTY,IQRSAV
- +, IQRFD,IQRRD,IQRSIZ, NQLPAT,NQUSED,NQLLBL, NQINIT
- CHARACTER CQDATEM*10, CQDATE*8, CQTIME*5
- COMMON /QSTATE/NQERR,NQWARN,NQINFO,NQLOCK
- +, IQDATE,IQTIME, CQDATEM,CQDATE,CQTIME
- PARAMETER (NSLIFI=128)
- CHARACTER CHLIFI*(NSLIFI), CHLIEX*8
- COMMON /FLINKC/LUNOP,LUNFD,LUNOLD,LUNSIZ
- +, IXFLUN, NLIFI,CHLIFI,CHLIEX
- COMMON /LUNSLN/IFLAUX, IXLUN(12)
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
- +, INMEM(2),NSLTOT(2),NSLMAX(2),NTXMAX(2),JSLTTF(2), IFSTRUC
- +, NOBJTT(3,2),NOBJMAT, MDELADD(2,2), LUNCRA,NLSENT, LASTDI
-C-------------- End CDE --------------------------------
- CHARACTER LINE*128, COL(128)*1
- EQUIVALENCE (LINE,SLERRM), (COL,SLERRM)
- LOGICAL ALSO, PRINT
-
- IAND (IZV,IZW) = AND (IZV, IZW)
-
-
- ALSO = IQTYPE .NE. IQPRNT
- CALL DPBLAN (1)
- NLSENT = 0
-
- IF (IXLUN(3).EQ.0) THEN
- PRINT = .TRUE.
- ASSIGN 9008 TO IFMT
- LUNCRA = IQPRNT
- WRITE (IQPRNT,9002)
- GO TO 20
- ENDIF
-
- CALL NA_GET (IXLUN(3),LINE,1)
- N = NDSLAT
- J = ICFILA ('.', LINE,1,N)
- LINE(J:J+4) = '.uexe'
- N = J + 4
- IXFLUN = NA_LONG (LINE(1:N))
-
- PRINT = .FALSE.
- ASSIGN 9009 TO IFMT
- LUNCRA = 21
- CALL FLINK (LUNCRA,5,-1,0)
- WRITE (IQPRNT,9001) CHLIFI(1:NLIFI)
- IF (ALSO) WRITE (IQTYPE,9001) CHLIFI(1:NLIFI)
-
- LINE = '# update Wylbur Exec ' // CQDATEM // ' ' // CQTIME
- N = LENOCC (LINE)
- WRITE (LUNCRA,9004) LINE(1:N)
-
-C- _:.=+=.: 1_:.=+=.:_2
- LINE = '# "old" was:'
- CALL LN_GET (JSLTTF(1),LINE(15:),40)
- N = LENOCC (LINE)
- WRITE (LUNCRA,9004) LINE(1:N)
-
- LINE = '# "new" was:'
- CALL LN_GET (JSLTTF(2),LINE(15:),40)
- N = LENOCC (LINE)
- WRITE (LUNCRA,9004) LINE(1:N)
-
- 9001 FORMAT (' the Wylbur update exec goes to file ',A)
- 9002 FORMAT (' Here comes the Wylbur update exec:')
- 9004 FORMAT (A)
- 9008 FORMAT (3X,A)
- 9009 FORMAT (A)
-
-C------ generate the re-ordering commands
-
- 20 LFI = LQUSER(2)
-
-C-- re-order the patches of this PAM
-
- IF (IAND(IQ(LFI),KM3).EQ.0) THEN
- CALL DIWYLR (LFI,1)
- ENDIF
-
-C-- scan all patches
-
- LP = LFI - 3
- 22 LP = LQ(LP-1)
- IF (LP.EQ.0) GO TO 27
- IF (IAND(IQ(LP),KM4).EQ.0) GO TO 26
-
-C-- foreign decks moved into this patch
-
- IXP = IQ(LP+4)
- LD = LQ(LP-4)
- 24 LL = LD
- LD = LQ(LL-1)
- IF (LD.EQ.0) GO TO 26
- IXPGET = IQ(LD+6) - 4
- IF (IXPGET.LT.0) GO TO 24
-
- IF (PRINT) WRITE (IQPRNT,9004)
- WRITE (LUNCRA,IFMT) '# fetch a lost child'
-
-C- _:.=+=.:_1
- LINE = 'range p='
- CALL NA_GET (IXP,LINE,9)
- JC = NESLAT
- LINE(JC:JC+2) = ',d='
- CALL NA_GET (IQ(LL+4),LINE,JC+3)
- WRITE (LUNCRA,IFMT) LINE(1:NESLAT-1)
-
-C- _:.=+=.:_1_:.=+=.:_2
- LINE = 'move,n,f |p='
- CALL NA_GET (IXPGET,LINE,16)
- JC = NESLAT
- LINE(JC:JC+2) = ',d='
- CALL NA_GET (IQ(LD+4),LINE,JC+3)
- WRITE (LUNCRA,IFMT) LINE(1:NESLAT-1)
-C! WRITE (LUNCRA,IFMT) 'num -nol'
- NLSENT = NLSENT + 3
- GO TO 24
-
- 26 IF (IAND(IQ(LP),KM3).NE.0) GO TO 22
- CALL DIWYLR (LP,0)
- GO TO 22
-
- 27 IF (PRINT .AND. NLSENT.NE.0) CALL DPBLAN (-1)
- WRITE (IQPRNT,9070) NLSENT
- IF (ALSO) WRITE (IQTYPE,9070) NLSENT
- 9070 FORMAT (' the Wylbur update exec has',I4,' active lines.')
- NQLLBL = 0
-
- RETURN
- END
diff --git a/src/p5boot/p5lib/diwylr.f b/src/p5boot/p5lib/diwylr.f
deleted file mode 100644
index 354bdd9..0000000
--- a/src/p5boot/p5lib/diwylr.f
+++ /dev/null
@@ -1,207 +0,0 @@
-CDECK ID>, DIWYLR.
- SUBROUTINE DIWYLR (LUP,LEVEL)
-
-C- generate the Wylbur command to re-order
-C- LEVEL = 0: the decks of the patch at LUP
-C- 1: the patches of the PAM at LUP
-C. started 18-june-94
-
- COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT,NUSLAT(2),DUMMY(34)
- CHARACTER SLLINE*512, SLERRM*256
- COMMON /SLATLN/ SLLINE, SLERRM
- COMMON /QUNIT/ IQREAD,IQPRNT, IQTTIN,IQTYPE, IQOFFL,IQRTTY,IQRSAV
- +, IQRFD,IQRRD,IQRSIZ, NQLPAT,NQUSED,NQLLBL, NQINIT
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
- +, INMEM(2),NSLTOT(2),NSLMAX(2),NTXMAX(2),JSLTTF(2), IFSTRUC
- +, NOBJTT(3,2),NOBJMAT, MDELADD(2,2), LUNCRA,NLSENT, LASTDI
-C-------------- End CDE --------------------------------
- CHARACTER LINE*512, COL(512)*1
- CHARACTER LONG*8192, LONC(8192)*1
- EQUIVALENCE (LINE,SLLINE), (COL,SLLINE)
- EQUIVALENCE (LONG,TEXT), (LONC,TEXT)
- CHARACTER EQU*3
- LOGICAL PRINT
-
-C- this is the maximum number of line-range elements on
-C- a command line which Wylbur can handle:
- PARAMETER (NSIZELI=20)
-
-
- EQU = ' d='
- IF (LEVEL.NE.0) EQU= ' p='
-
- 9001 FORMAT (A)
- 9002 FORMAT (3X,A)
-
- PRINT = LUNCRA.EQ.IQPRNT
- ASSIGN 9001 TO IFMT
- IF (PRINT) ASSIGN 9002 TO IFMT
-
-C---- look for the next re-ordering group
-
- LGO = LQ(LUP-4)
- 21 LGO = LQSTEP (LGO, IQ(LGO+9)+1)
- IF (LGO.EQ.0) RETURN
-
- LMIN = LGO
- LMAX = LGO
- JORD = IQ(LGO+5)
-
- MINCUR = JORD
- MAXCUR = JORD
-
-C-- scan starting from the string at LGO
-
- 23 MINORD = MINCUR
- MAXORD = MAXCUR
- LBK = LGO
-
-C-- find the last string with ordinal number < MAXORD
-
- 24 LBK = LQSTEP (LBK, IQ(LBK+9)+1)
- IF (LBK.EQ.0) GO TO 26
- JORD = IQ(LBK+5)
- IF (JORD.GE.MAXCUR) GO TO 24
- LLAST = LBK
- IF (JORD.GE.MINCUR) GO TO 24
- MINCUR = JORD
- LMIN = LBK
- GO TO 24
-
-C-- no re-ordering of string at LGO if no such string found
-
- 26 IF (LMIN.EQ.LGO) GO TO 21
- IF (MINCUR.EQ.MINORD) GO TO 41
-
-C-- find the string with the highest ordinal number in (LGO | LLAST)
-
- LBK = LGO
- 27 LBK = LQSTEP (LBK, IQ(LBK+9)+1)
- IF (LBK.EQ.LLAST) GO TO 29
- JORD = IQ(LBK+5)
- IF (JORD.LE.MAXCUR) GO TO 27
- MAXCUR = JORD
- LMAX = LBK
- GO TO 27
-
-C-- if the maximum has increased: scan again
-
- 29 IF (MAXCUR.NE.MAXORD) GO TO 23
-
-C---- found the re-ordering group from LGO to LLAST
-
-C-- construct: range p=pname,d=dfirst-dlast
-C-- or: range p=pfirst-plast
-
- 41 IXFI = IQ(LMIN+4)
- LBK = LQSTEP (LMAX,IQ(LMAX+9))
- IXLA = IQ(LBK+4)
- NLRE = 0
-
- IF (PRINT) WRITE (IQPRNT,9001)
- WRITE (LUNCRA,IFMT) '# change the order'
-
-C- _:.=+=.:_1
- LINE = 'range p='
- JPUT = 9
-
- IF (LEVEL.EQ.0) THEN
- CALL NA_GET (IQ(LUP+4),LINE,JPUT)
- JPUT = NESLAT
- LINE(JPUT:JPUT+2) = ',d='
- JPUT = JPUT + 3
- ENDIF
-
- CALL NA_GET (IXFI,LINE,JPUT)
- COL(NESLAT) = '-'
- JPUT = NESLAT + 1
- CALL NA_GET (IXLA,LINE,JPUT)
- NRANGE = NESLAT - 1
-
-C-- construct: move,o,n d=d1-d2 d=d3-d4 ... to f
-
-C- _:.=+=.:_1
- LONG(1:10) = 'move,o,n '
- JPUT = 10
- LBK = LGO
- 44 NLEN = IQ(LBK+9)
- IXFI = IQ(LBK+4)
- NLRE = NLRE + 1
-
- LONG(JPUT:JPUT+2) = EQU
- CALL NA_GET (IXFI,LONG,JPUT+3)
- JPUT = NESLAT
-
- LE = LBK
- IF (NLEN.NE.0) THEN
- LONC(JPUT) = '-'
- LE = LQSTEP (LE,NLEN)
- CALL NA_GET (IQ(LE+4),LONG,JPUT+1)
- JPUT = NESLAT
- ENDIF
- IF (LBK.EQ.LLAST) GO TO 47
- LBK = LQ(LE-1)
- GO TO 44
-
-C! 47 IF (JPUT.GT.25) GO TO 61
- 47 IF (JPUT.GT.250) GO TO 61
- IF (NLRE.GE.NSIZELI) GO TO 61
- LONG(JPUT:JPUT+4) = ' to f'
- NPUT = JPUT + 4
- WRITE (LUNCRA,IFMT) LINE(1:NRANGE)
- WRITE (LUNCRA,IFMT) LONG(1:NPUT)
- NLSENT = NLSENT + 2
- LGO = LLAST
- GO TO 21
-
-C-- resulting command line too long, operate in pieces
-
- 61 JEND = JPUT - 1
- WRITE (LUNCRA,IFMT) 'range'
- WRITE (LUNCRA,IFMT) 'end end-marker'
- WRITE (LUNCRA,IFMT) 'set val w11 *'
- WRITE (LUNCRA,IFMT) LINE(1:NRANGE)
- NLSENT = NLSENT + 4
-
- JTAK = 10
- 62 LINE = 'copy,n'
- JPUT = 8
- NLRE = 0
- 63 JTAK = ICNEXT (LONG,JTAK,JEND)
- N = NDSLAT
- IF (JPUT+N.GE.250) GO TO 64
- IF (NLRE+1.EQ.NSIZELI) GO TO 64
-
- NLRE = NLRE + 1
- LINE(JPUT:JPUT+N-1) = LONG(JTAK:JTAK+N-1)
- JTAK = JTAK + N + 1
- JPUT = JPUT + N + 1
- IF (JTAK.LT.JEND) GO TO 63
-
- 64 LINE(JPUT:JPUT+4) = 'to *+'
- NPUT = JPUT + 4
- WRITE (LUNCRA,IFMT) LINE(1:NPUT)
- NLSENT = NLSENT + 1
- IF (JTAK.LT.JEND) GO TO 62
-
- WRITE (LUNCRA,IFMT) 'set val w12 *'
- WRITE (LUNCRA,IFMT) 'copy,o,n :w11+/:w12 to f'
- WRITE (LUNCRA,IFMT) 'del -nol :w11/:w12'
- NLSENT = NLSENT + 3
- LGO = LLAST
- GO TO 21
-
- END
diff --git a/src/p5boot/p5lib/doapam.f b/src/p5boot/p5lib/doapam.f
deleted file mode 100644
index 0911ff0..0000000
--- a/src/p5boot/p5lib/doapam.f
+++ /dev/null
@@ -1,170 +0,0 @@
-CDECK ID>, DOAPAM.
- SUBROUTINE DOAPAM
-
-C- Gather the parameters of the c/line +PAM currently in CCKARD
-C- and store them into the PAM bank; position the wanted ARRV bank
-C- at LQARRV
-C. started 3-aug-93
-
- PARAMETER (KM1=1,KM2=2,KM3=4,KM4=8,KM5=16,KM6=32,KM7=64,KM8=128,
- + KM9=256, KM10=512, KM11=1024, KM12=2048, KM13=4096, KM14=8192,
- + KM15=16384, KM16=32768, KM17=65536, KM18=131072, KM19=262144)
- PARAMETER (NBANKS=19,JBKPAT=1, JBKDEC=2, JBKORG=3, JBKINC=4,
- + JBKHOL=5, JBKKEE=6, JBKACT=7, JBKMAT=8, JBKXSQ=9,
- + JBKPRE=10,JBKGAR=11,JBKSMH=12,JBKSMT=13,JBKSML=14,
- + JBKSMX=15,JBKARR=16,JBKASA=17,JBKPAM=18,JBKRPA=19)
- COMMON /QBANKS/MMBANK(5,NBANKS)
- COMMON /ARRCOM/IN_LUN, IN_FD, IN_FIO, IN_EOF
- +, IN_DOX, IN_DO1, IN_DO2
- CHARACTER CCKORG*256, CCKARD*256, CCCOMF*256
- COMMON /CCPARA/NCHCCD,NCHCCT, JCCTYP,JCCLEV,JCCSL,MCCPAR(240)
- +, NCCPAR,MXCCIF,JCCIFV,JCCBAD,JCCWAR,ICCSUB,JCCWK(4)
- +, JCCPP,JCCPD,JCCPZ,JCCPT,JCCPIF,JCCPC,JCCPN
- +, NCCPP,NCCPD,NCCPZ,NCCPT,NCCPIF,NCCPC,NCCPN
- +, JCCEND, NCHCCC,IXCCC, CCKORG, CCKARD, CCCOMF
- PARAMETER (KQGARB=1,KQARRV=3,KQKEEP=4,KQPREP=5,KQMAIN=6,KQPAST=8)
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
- COMMON /LUNSLN/IFLAUX, IXLUN(12)
- PARAMETER (NSLIFI=128)
- CHARACTER CHLIFI*(NSLIFI), CHLIEX*8
- COMMON /FLINKC/LUNOP,LUNFD,LUNOLD,LUNSIZ
- +, IXFLUN, NLIFI,CHLIFI,CHLIEX
-C-------------- End CDE --------------------------------
-
- PARAMETER (NPOSOP=10)
- CHARACTER POSOP(NPOSOP)*6
-
- DATA POSOP / 'A*TTAC'
- +, 'H*OLD '
- +, 'R*ESUM'
- +, 'U*PDAT'
- +, 'MER*GE'
- +, 'DIS*PL'
- +, 'LIS*T '
- +, 'IND*IV'
- +, 'C*AR* '
- +, 'D*ETAC' /
-
- IAND (IZV,IZW) = AND (IZV, IZW)
- IOR (IZV,IZW) = OR (IZV, IZW)
-
-
-C-- Analyse +PAM, LAB=lab, N=x,y, T=opt, RETURN=pname .fnname
-C-
-C- L=lab lab (integer) identify the file
-C- default: zero
-C- N=x do x files
-C- N=x,y skip x files, do y files
-C-
-C- T=ATTACH attach file fname
-C- HOLD do not release the file
-C- RESUME continue file "lab"
-C- UPDATE process this file in update mode
-C- (old: CARDS, DETACH)
-C-
-C- R=pname stop after P=pname complete
-
-
- CALL CCOPT (POSOP,NPOSOP)
- IF (JCCBAD.NE.0) RETURN
-
- LASTLU = IQ(LPAM+1)
- CALL VZERO (IQ(LPAM+1),8)
-
- LABEL = MCCPAR(JCCPC+1)
-
- IF (NCCPN.GE.2) THEN
- IQ(LPAM+4) = ABS(MCCPAR(JCCPN+1))
- IQ(LPAM+5) = MCCPAR(JCCPN+4)
- ELSEIF (NCCPN.EQ.1) THEN
- IQ(LPAM+5) = ABS(MCCPAR(JCCPN+1))
- ELSE
- IQ(LPAM+5) = 999
- ENDIF
-
- IF (NCCPT.GT.0) IQ(LPAM+6) = MCCPAR(JCCPT+2)
- IQ(LPAM+7) = MCCPAR(JCCPD+1)
-
-C-- find a free logical unit number
-
- LUNX = 11
-
-C-- if labelled, find its ARRV bank
-
- IFLPRE = 1
- IF (LABEL.NE.0) THEN
- LXX = KQFIND (LABEL,3,KQARRV,KXX)
- IF (LXX.NE.0) GO TO 31
- ENDIF
-
-C-- get an empty ARRV bank
-
- IFLPRE = 0
- KXX = KQARRV
- 24 LXX = LQ(KXX)
- IF (LXX.EQ.0) GO TO 26
- IF (IQ(LXX+1)+IQ(LXX+3).EQ.0) GO TO 27
- KXX = LXX - 1
- GO TO 24
-
- 26 CALL MQLIFT (LXX, KXX,0, JBKARR,3)
- 27 CALL VZERO (IQ(LXX+1), 11)
-
-C------ New file to be opened --------------
-
- 31 IXFLUN = 0
- IF (IAND(IQ(LPAM+6),KM1).NE.0) GO TO 34
- IF (LASTLU.NE.0) GO TO 41
- IQ(LPAM+6) = IOR (IQ(LPAM+6),KM1)
- IXFLUN = IXLUN(1)
- GO TO 35
-
- 34 CALL FLKRAK (1,2)
- 35 IF (IXFLUN.EQ.0) GO TO 91
- IF (IQ(LXX+1).EQ.0) GO TO 47
-
-C-- the file connected is still active, close it
-
- LUNX = IQ(LXX+1)
- LSAVE = LARRV
- LARRV = LXX
- IN_DOX = -1
- CALL ARRIN
- LARRV = LSAVE
- GO TO 47
-
-C------ File to be resumed --------------
-
- 41 IF (LABEL.EQ.0) THEN
- KXX = KQARRV
- LXX = LQARRV
- ELSE
- IF (IFLPRE.EQ.0) GO TO 91
- ENDIF
-
- IF (IQ(LXX+1).NE.0) LUNX= IQ(LXX+1)
-
- 47 IF (KXX.NE.KQARRV) CALL QSHUNT (KXX,KQARRV)
- IQ(LPAM+1) = LUNX
- IQ(LPAM+3) = LABEL
- IQ(LPAM+8) = IXFLUN
- RETURN
-
-C-- Trouble
-
- 91 JCCBAD = 7
- RETURN
- END
diff --git a/src/p5boot/p5lib/docrad.f b/src/p5boot/p5lib/docrad.f
deleted file mode 100644
index e8b042f..0000000
--- a/src/p5boot/p5lib/docrad.f
+++ /dev/null
@@ -1,241 +0,0 @@
-CDECK ID>, DOCRAD.
- SUBROUTINE DOCRAD
-
-C- Process the cradle
-C. started 27-feb-92
-
- PARAMETER (KM1=1,KM2=2,KM3=4,KM4=8,KM5=16,KM6=32,KM7=64,KM8=128,
- + KM9=256, KM10=512, KM11=1024, KM12=2048, KM13=4096, KM14=8192,
- + KM15=16384, KM16=32768, KM17=65536, KM18=131072, KM19=262144)
- PARAMETER (NBANKS=19,JBKPAT=1, JBKDEC=2, JBKORG=3, JBKINC=4,
- + JBKHOL=5, JBKKEE=6, JBKACT=7, JBKMAT=8, JBKXSQ=9,
- + JBKPRE=10,JBKGAR=11,JBKSMH=12,JBKSMT=13,JBKSML=14,
- + JBKSMX=15,JBKARR=16,JBKASA=17,JBKPAM=18,JBKRPA=19)
- COMMON /QBANKS/MMBANK(5,NBANKS)
- COMMON /QPAGE/ NQLMAX,NQLTOL,NQLTOK,NQCMAX,NQCPGH,NQPAGE
- +, NQWYLDO,NQWYL,NQNEWH,NQJOIN,NQDKNO,NQDKPG
- COMMON /ARRCOM/IN_LUN, IN_FD, IN_FIO, IN_EOF
- +, IN_DOX, IN_DO1, IN_DO2
- PARAMETER (MCCNIL=1, MCCKIL=2, MCCINC=3, MCCCDE=4, MCCSEQ=5,
- + MCCXSQ=6, MCCTRU=7, MCCFAL=8, MCCELS=9, MCCEND=10,
- + MCCSEL=11, MCCSES=12, MCCFAU=13, MCCSKI=14,
- + MCCKEE=15, MCCDEL=16, MCCREP=17, MCCADB=18, MCCADD=19,
- + MCCUSE=20, MCCXDI=21, MCCDIV=22, MCCLIS=23, MCCEXE=24, MCCIMI=25,
- + MCCASM=26, MCCUPD=27, MCCNAM=28, MCCGAP=29, MCCMOR=30, MCCONL=31,
- + MCCFOR=32, MCCSUS=33, MCCOPT=34, MCCOP2=35, MCCSHO=36, MCCPAM=37,
- + MCCQUI=38, MCCEOD=39, MCCDEC=40, MCCPAT=41, MCCTIT=42)
- CHARACTER CCKORG*256, CCKARD*256, CCCOMF*256
- COMMON /CCPARA/NCHCCD,NCHCCT, JCCTYP,JCCLEV,JCCSL,MCCPAR(240)
- +, NCCPAR,MXCCIF,JCCIFV,JCCBAD,JCCWAR,ICCSUB,JCCWK(4)
- +, JCCPP,JCCPD,JCCPZ,JCCPT,JCCPIF,JCCPC,JCCPN
- +, NCCPP,NCCPD,NCCPZ,NCCPT,NCCPIF,NCCPC,NCCPN
- +, JCCEND, NCHCCC,IXCCC, CCKORG, CCKARD, CCCOMF
- CHARACTER CHEXPD*68
- COMMON /CHEXC/ IXEXPAM, IXEXPAT,IXEXDEC,IXEXID, NCHEPD, CHEXPD
- COMMON /DEPCOM/JD_NEW, JD_DTN, JD_DTP, JD_DTD, JD_DIV
- +, JD_SML, JD_SMP, JD_SMX, JDP_DT, JDP_DV
- +, JD_SPL, JD_MOD, JD_LUN, JD_LOG, JD_NLI, JD_MULT
- +, IX_EXT, IX_RH, IX_SUB
- COMMON /MUSEBC/ MX_FORC, MU_GLOB, MU_PAT, MU_DECK, MU_INH, MU_FORG
- +, MX_TRAN, MX_FORG, MX_SINH, MX_SELF, NVEXDK(6)
- COMMON /MQCM/ NQSYSS,NQLINK, LQCSTA(3),LQCEND(3), NQMAX
- +, LQLSTA(5),LQLEND(5), LQADR,LQADR0,NQOFFS
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
-C-------------- End CDE --------------------------------
- PARAMETER (IXCRA=2)
- CHARACTER MARK*4
-
- IAND (IZV,IZW) = AND (IZV, IZW)
-
-
- LARRV = LACRAD
- JREADY = 1
- NSLORG = 1
- NDKOFF = 0
- JD_DTP = 1
- JD_DTN = 0
- JD_NEW = 1
- IFLMERG = 0
- IFLDISP = 0
- IXEXPAM = 0
- IF (INCRAD.EQ.3) GO TO 31
-
-C------ Restart the cradle after having read a PAM file
-
- CALL VZERO (IQ(LQHOLD+1),3)
- CALL ARRIVE (1)
- IF (JDKTYP.EQ.2) GO TO 27
-
-C-- lift PAT bank for P=CRA*
-
- 24 CALL CREAPD (IXCRA,-1,1)
- CALL SBYT (NQDKNO, IQ(LEXP+1),13,20)
- LPCRA = LEXP
- 25 LEXD = 0
- MU_PAT = IAND (IQ(LEXP), KM19-1)
- MU_DECK = MU_PAT
- CALL MXOPER (0)
-
- IXEXPAT = IXCRA
- IXEXDEC = IXCRA
- IXEXID = IXCRA
- LDECO = 0
- NQNEWH = 1
- NQJOIN = -1
- NSLORG = 1
- INCRAD = 2
-
-
- 27 IF (JDKTYP.GE.6) GO TO 79
- IF (JDKTYP.GE.4) GO TO 42
- IF (JDKTYP.EQ.0) GO TO 29
- INCRAD = 1
- JREADY = 0
- NSLORG = 0
- NDKOFF = 0
- IF (JDKTYP.GE.2) GO TO 34
- GO TO 31
-
-C-- Do next deck
-
- 29 NQDKNO = NQDKNO - NDKOFF
- JREADY = 1
-
- 31 JDKTYP = 1
- CALL DODECK (JREADY)
- GO TO 37
-
-C-- do next patch
-
- 34 INCRAD = 1
- IF (JDKTYP.EQ.2) THEN
- CALL DOPAT
- ELSE
-
-C-- skip for +TITLE
-
- JDKTYP = 2
- CALL ARRSKP
- ENDIF
-
- 37 IF (JDKTYP.GE.6) GO TO 79
- IF (JDKTYP.LE.3) GO TO 34
-
-C---- Handle +PAM or +QUIT
-
- NSLORG = IQ(LQHOLD+1) - JSLORG
- NDKOFF = 1
-
- 42 JSLCRA = IQ(LQHOLD+1)
- NSLCRA = IQ(LQHOLD+2)
- JTXCRA = MLIAD(JSLCRA)
- NTX = MLIAD(JSLCRA+1) - JTXCRA - NCHNEWL
- JCCTYP = JPTYPE (TEXT(JTXCRA))
-
- CALL CCKRAK (JSLCRA)
- IF (JCCBAD.NE.0) THEN
- MARK = ' *! '
- GO TO 44
- ENDIF
-
- CALL CCPROC
- IF (JCCIFV.EQ.0) THEN
- MARK = ' + '
- ELSE
- MARK = ' ( '
- ENDIF
-
-C-- print the c/line
-
- 44 IF (INCRAD.GE.2) THEN
- LINUM = NSLORG
- ELSE
- LINUM = 1
- ENDIF
-
- CALL DPBLAN (1)
- CALL DPLINE (LINUM,MARK,NTX,TEXT(JTXCRA))
-
-C-- exit if faulty c/line
-
- IF (JCCBAD.NE.0) GO TO 91
-
-C-- continue deck if IF deselected c/line
-
- IF (JCCIFV.EQ.0) GO TO 61
- IQ(LQHOLD+1) = IQ(LQHOLD+1) + 1
- IQ(LQHOLD+2) = IQ(LQHOLD+2) - 1
- NSLORG = NSLORG + 1
-
- IF (IQ(LQHOLD+2).EQ.0) THEN
- CALL ARRIVE (1)
- ELSE
- CALL ARRNXD (-1)
- ENDIF
-
- IF (INCRAD.GE.2) GO TO 27
- IF (JDKTYP.GE.1) GO TO 27
- NDKOFF = 0
- IF (IXEXPAT.NE.IXCRA) GO TO 24
- GO TO 25
-
-C------ Accepted control line +PAM or +QUIT
-
- 61 IF (JCCTYP.EQ.MCCQUI) GO TO 79
- NSLORG = 0
-
-C-- Digest the +PAM parameters to bank at LPAM
-
- CALL DOAPAM
- IF (JCCBAD.NE.0) GO TO 91
-
-C-- Save cradle material after +PAM, ...
-
- JSLCRA = JSLCRA + 1
- NSLCRA = NSLCRA - 1
- IF (NSLCRA.EQ.0) GO TO 77
-
- IF (IQ(LARRV+7).LT.0) GO TO 76
- JSLE = JSLCRA + NSLCRA
- CALL NEXTDE (JSLCRA,JSLE,JSLF,JTYP,-2)
- IF (JTYP.EQ.0) GO TO 76
-
-C-- reposition the cradle file to the start of next deck
-
- IN_DOX = 1
- IN_DO1 = JSLF
- CALL ARRIN
-
- NSLCRA = JSLF - JSLCRA
- IF (NSLCRA.EQ.0) GO TO 77
- 76 CALL MQLIFT (LASAV, LACRAD,-2, JBKASA,1)
- IQ(LASAV+1) = JSLCRA
- IQ(LASAV+2) = NSLCRA
- 77 IQ(LQHOLD+2) = 0
- IQ(LPAM+14) = IQ(LPAM+14) + 1
- JANSW = 0
- RETURN
-
-C-- +QUIT or EOF reached
-
- 79 JANSW = 1
- RETURN
-
-C---- Trouble
-
- 91 IF (JCCTYP.EQ.MCCQUI) GO TO 79
- CALL P_FATAL ('faulty line +PAM,...')
- END
diff --git a/src/p5boot/p5lib/dodeck.f b/src/p5boot/p5lib/dodeck.f
deleted file mode 100644
index b5fcf30..0000000
--- a/src/p5boot/p5lib/dodeck.f
+++ /dev/null
@@ -1,177 +0,0 @@
-CDECK ID>, DODECK.
- SUBROUTINE DODECK (JREADY)
-
-C- Process the next decks until end of patch
-C- JREADY = 0 c/l +DECK to be analysed
-C- 1 ready to run
-C. started 27-feb-92
-
- COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT,NUSLAT(2),DUMMY(34)
- CHARACTER SLLINE*512, SLERRM*256
- COMMON /SLATLN/ SLLINE, SLERRM
- PARAMETER (KM1=1,KM2=2,KM3=4,KM4=8,KM5=16,KM6=32,KM7=64,KM8=128,
- + KM9=256, KM10=512, KM11=1024, KM12=2048, KM13=4096, KM14=8192,
- + KM15=16384, KM16=32768, KM17=65536, KM18=131072, KM19=262144)
- COMMON /QPAGE/ NQLMAX,NQLTOL,NQLTOK,NQCMAX,NQCPGH,NQPAGE
- +, NQWYLDO,NQWYL,NQNEWH,NQJOIN,NQDKNO,NQDKPG
- CHARACTER CQDATEM*10, CQDATE*8, CQTIME*5
- COMMON /QSTATE/NQERR,NQWARN,NQINFO,NQLOCK
- +, IQDATE,IQTIME, CQDATEM,CQDATE,CQTIME
- PARAMETER (MCCNIL=1, MCCKIL=2, MCCINC=3, MCCCDE=4, MCCSEQ=5,
- + MCCXSQ=6, MCCTRU=7, MCCFAL=8, MCCELS=9, MCCEND=10,
- + MCCSEL=11, MCCSES=12, MCCFAU=13, MCCSKI=14,
- + MCCKEE=15, MCCDEL=16, MCCREP=17, MCCADB=18, MCCADD=19,
- + MCCUSE=20, MCCXDI=21, MCCDIV=22, MCCLIS=23, MCCEXE=24, MCCIMI=25,
- + MCCASM=26, MCCUPD=27, MCCNAM=28, MCCGAP=29, MCCMOR=30, MCCONL=31,
- + MCCFOR=32, MCCSUS=33, MCCOPT=34, MCCOP2=35, MCCSHO=36, MCCPAM=37,
- + MCCQUI=38, MCCEOD=39, MCCDEC=40, MCCPAT=41, MCCTIT=42)
- CHARACTER CCKORG*256, CCKARD*256, CCCOMF*256
- COMMON /CCPARA/NCHCCD,NCHCCT, JCCTYP,JCCLEV,JCCSL,MCCPAR(240)
- +, NCCPAR,MXCCIF,JCCIFV,JCCBAD,JCCWAR,ICCSUB,JCCWK(4)
- +, JCCPP,JCCPD,JCCPZ,JCCPT,JCCPIF,JCCPC,JCCPN
- +, NCCPP,NCCPD,NCCPZ,NCCPT,NCCPIF,NCCPC,NCCPN
- +, JCCEND, NCHCCC,IXCCC, CCKORG, CCKARD, CCCOMF
- CHARACTER CHEXPD*68
- COMMON /CHEXC/ IXEXPAM, IXEXPAT,IXEXDEC,IXEXID, NCHEPD, CHEXPD
- COMMON /DEPCOM/JD_NEW, JD_DTN, JD_DTP, JD_DTD, JD_DIV
- +, JD_SML, JD_SMP, JD_SMX, JDP_DT, JDP_DV
- +, JD_SPL, JD_MOD, JD_LUN, JD_LOG, JD_NLI, JD_MULT
- +, IX_EXT, IX_RH, IX_SUB
- COMMON /MUSEBC/ MX_FORC, MU_GLOB, MU_PAT, MU_DECK, MU_INH, MU_FORG
- +, MX_TRAN, MX_FORG, MX_SINH, MX_SELF, NVEXDK(6)
- CHARACTER CHTAG*80, CHWYL*16
- COMMON /TAGC/ LLORG,LNORG,LLACT,LNACT, LALTN,LMODE,NCHTAG
- +, CHTAG,CHWYL
- COMMON /MQCM/ NQSYSS,NQLINK, LQCSTA(3),LQCEND(3), NQMAX
- +, LQLSTA(5),LQLEND(5), LQADR,LQADR0,NQOFFS
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
-C-------------- End CDE --------------------------------
-
- IAND (IZV,IZW) = AND (IZV, IZW)
-
-
- IFLRDY = JREADY
- NCHTAG = 0
- LLORG = 0
- LLACT = 0
- LMODE = 0
-
-C-- Check enough space
-
- 21 IFLGAR = 0
- CALL SETGAP
-
-C------ Ready the deck parameters
-
- IF (IFLRDY.NE.0) GO TO 62
- JD_NEW = 1
- JD_MULT = 0
- IF (JDKTYP.NE.1) GO TO 47
-
-C---- Deck header is +DECK, name
-
- 42 INCRAD = MIN (INCRAD,1)
- JSLF = IQ(LQHOLD+1)
- JCCTYP = MCCDEC
- CALL CCKRAK (JSLF)
-
-C-- get the name
-
- IXEXDEC = MCCPAR(JCCPD+1)
- IF (IXEXDEC.EQ.0) IXEXDEC= 1
- IXEXID = IXEXDEC
-
-C-- find the deck bank, set operation mode
-
- 47 LEXD = KQFIND (IXEXDEC,1, LEXP-2,KEXD)
- IF (LEXD.NE.0) THEN
- MU_DECK = IAND (IQ(LEXD),KM19-1)
- ELSE
- MU_DECK = MU_PAT
- ENDIF
-
- CALL MXOPER (0)
-
- IF (JDKTYP.NE.1) GO TO 61
- IF (IAND(MU_DECK,KM5).EQ.0) GO TO 85
-
-C------ Process the deck
-
- 61 NQNEWH = 7
- LDECO = 0
- NSLORG = 0
-
- 62 IFLRDY = 0
- IF (JDKNEX.EQ.0) CALL ARRIVE (2)
-
-C-- ready the foreign material into this deck
-
- CALL ACSORT
-
-C-- analyse the contents
-
- CALL DOMAP
- IF (JANSW.LT.0) GO TO 84
-
-C-- process the contents
-
- IF (JANSW.NE.0) CALL DOXQT
- LQCEND(2) = LQCSTA(2)
-
-C------ Processing complete
-
- NQDKNO = NQDKNO + 1
-
-C-- send the DECK bank to garbage collection
-C- unless it is the blank deck of P=CRA*
-
- IF (LEXD.NE.0) THEN
- L = KQFIND (IXEXDEC,1, LEXP-2, KEXD)
- IF (L.NE.0) THEN
- IF (L.EQ.LDCRAB) GO TO 67
- CALL TOGARB (KEXD,0)
- ENDIF
- ENDIF
-
- IF (NVEXDK(1).EQ.0) GO TO 88
- IF (JD_NEW.EQ.0) CALL DPEXTM (1)
- GO TO 88
-
-C-- End of blank deck of P=CRA*
-
- 67 IF (NQERR.NE.0)
- + CALL P_KILL ('errors in the blank deck of the cradle')
-
- CALL ASMUSE
- LQ(KEXD) = LQ(LEXD-1)
- IF (NCLASH.EQ.0) THEN
- IF (MOPUPD.EQ.0) NCLASH= 2
- ENDIF
- GO TO 88
-
-C---- Skip patch or deck
-
- 84 JDKTYP = 2
- 85 CALL ARRSKP
- GO TO 89
-
-C-- step to the next deck
-
- 88 CALL ARRNXD (1)
- 89 CONTINUE
- IF (JDKTYP.EQ.1) GO TO 21
- RETURN
- END
diff --git a/src/p5boot/p5lib/doforg.f b/src/p5boot/p5lib/doforg.f
deleted file mode 100644
index d759e31..0000000
--- a/src/p5boot/p5lib/doforg.f
+++ /dev/null
@@ -1,311 +0,0 @@
-CDECK ID>, DOFORG.
- SUBROUTINE DOFORG (IFTONX)
-
-C- Store new foreign material into division 1
-C- IF-selection has been done by M_ANA3
-C. started 1-dec-91
-
- PARAMETER (KM1=1,KM2=2,KM3=4,KM4=8,KM5=16,KM6=32,KM7=64,KM8=128,
- + KM9=256, KM10=512, KM11=1024, KM12=2048, KM13=4096, KM14=8192,
- + KM15=16384, KM16=32768, KM17=65536, KM18=131072, KM19=262144)
- PARAMETER (KMA=1,KMB=2,KMC=4,KMD=8,KME=16,KMF=32,KMG=64,KMH=128,
- + KMI=256, KMJ=512, KMK=KM11, KML=KM12, KMM=KM13, KMN=KM14,
- + KMO=KM15, KMP=KM16, KMQ=KM17, KMR=KM18, KMS=KM19)
- PARAMETER (NBANKS=19,JBKPAT=1, JBKDEC=2, JBKORG=3, JBKINC=4,
- + JBKHOL=5, JBKKEE=6, JBKACT=7, JBKMAT=8, JBKXSQ=9,
- + JBKPRE=10,JBKGAR=11,JBKSMH=12,JBKSMT=13,JBKSML=14,
- + JBKSMX=15,JBKARR=16,JBKASA=17,JBKPAM=18,JBKRPA=19)
- COMMON /QBANKS/MMBANK(5,NBANKS)
- PARAMETER (MCCNIL=1, MCCKIL=2, MCCINC=3, MCCCDE=4, MCCSEQ=5,
- + MCCXSQ=6, MCCTRU=7, MCCFAL=8, MCCELS=9, MCCEND=10,
- + MCCSEL=11, MCCSES=12, MCCFAU=13, MCCSKI=14,
- + MCCKEE=15, MCCDEL=16, MCCREP=17, MCCADB=18, MCCADD=19,
- + MCCUSE=20, MCCXDI=21, MCCDIV=22, MCCLIS=23, MCCEXE=24, MCCIMI=25,
- + MCCASM=26, MCCUPD=27, MCCNAM=28, MCCGAP=29, MCCMOR=30, MCCONL=31,
- + MCCFOR=32, MCCSUS=33, MCCOPT=34, MCCOP2=35, MCCSHO=36, MCCPAM=37,
- + MCCQUI=38, MCCEOD=39, MCCDEC=40, MCCPAT=41, MCCTIT=42)
- CHARACTER CCKORG*256, CCKARD*256, CCCOMF*256
- COMMON /CCPARA/NCHCCD,NCHCCT, JCCTYP,JCCLEV,JCCSL,MCCPAR(240)
- +, NCCPAR,MXCCIF,JCCIFV,JCCBAD,JCCWAR,ICCSUB,JCCWK(4)
- +, JCCPP,JCCPD,JCCPZ,JCCPT,JCCPIF,JCCPC,JCCPN
- +, NCCPP,NCCPD,NCCPZ,NCCPT,NCCPIF,NCCPC,NCCPN
- +, JCCEND, NCHCCC,IXCCC, CCKORG, CCKARD, CCCOMF
- COMMON /MQCM/ NQSYSS,NQLINK, LQCSTA(3),LQCEND(3), NQMAX
- +, LQLSTA(5),LQLEND(5), LQADR,LQADR0,NQOFFS
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
- COMMON /MUSEBC/ MX_FORC, MU_GLOB, MU_PAT, MU_DECK, MU_INH, MU_FORG
- +, MX_TRAN, MX_FORG, MX_SINH, MX_SELF, NVEXDK(6)
- COMMON /M_ANAC/LOWAN,KDOAN,LDOAN,LUPAN,MODEAN,MEXAN,LEVAN,KKM5AN
- +, NEWDEC,NEWCTL,NEWFOR,NEWNIL,NEWINC
-C-------------- End CDE --------------------------------
-
- IAND (IZV,IZW) = AND (IZV, IZW)
- IOR (IZV,IZW) = OR (IZV, IZW)
- ISHFTL (IZW,NZB) = LSHIFT (IZW, NZB)
-
-
- IFTON = 1
- IF (IAND(IQ(LDOAN),KM5).NE.0) THEN
- IFLNIL = IAND(IQ(LDOAN),KM8)
- IF (IFLNIL.EQ.0) GO TO 99
- ELSE
- IFLNIL = 0
- ENDIF
-
- IF (LDECO.EQ.0) CALL CRDECO
- CALL CCKRAK (IQ(LDOAN+1))
-
- MEXAN = MX_FORG
- IF (JCCTYP.NE.MCCKEE) GO TO 41
-
-C---------- Handle +KEEP --------------------
-
- IFLSGL = KM5+KM6+KM17
- IFLMSK = KM5+KM6
- NSTEP = 0
- LAST = 0
- IXS = MCCPAR(JCCPZ+1)
- LACT = LQ(LDOAN-3)
- IF (LACT.GT.0) GO TO 24
-
-C-- append to existing sequence
-
- LACT = -LACT
- IFLSGL = 0
- IFTON = 0
- KJOIN = KQLAST (LACT-2)
- JCCTYP = 0
- IF (IQ(LDOAN+1).EQ.1) GO TO 31
- NSTEP = 1
- GO TO 32
-
-C-- ready the KEEP bank
-
- 24 IF (NCCPP.NE.0) IFLSGL= 0
-
- IQ(LACT) = IOR (IQ(LACT), KM7)
- IQ(LACT+1) = IQ(LDOAN+1) + 1
- IQ(LACT+2) = IQ(LDOAN+2) - 1
-C! IQ(LACT+4) = IXS
- IQ(LDOAN+2) = 1
-
- IF (LUPAN.EQ.0) THEN
- LQ(LACT-3) = LDECO
- IQ(LACT+3) = IQ(LACT+1) - JSLORG
- LAST = LACT
- ELSE
- LQ(LACT-3) = LQ(LDOAN-2)
- IQ(LACT+3) = IQ(LDOAN+3) + 1
- ENDIF
-
-C-- NIL sequence
-
- IF (IFLNIL.NE.0) GO TO 99
-
-C------ create MAT continuation banks for KEEP
-
- IFTON = 0
- KJOIN = LACT - 2
- 31 CALL MK_FNX
- IF (LDOAN.EQ.0) GO TO 39
- IF (JCCTYP.GE.MCCSEL) GO TO 39
- NSTEP = 0
-
- 32 IF (LUPAN.NE.0) GO TO 38
- JSLNEW = IQ(LDOAN+1) + NSTEP
- NSLNEW = IQ(LDOAN+2) - NSTEP
- NUMNEW = JSLNEW - JSLORG
- IF (NSLNEW.EQ.0) GO TO 31
-
- IF (JCCTYP.LT.MCCCDE) GO TO 36
- IF (JCCTYP.GE.MCCXSQ) GO TO 35
-
-C-- handle +CDE or +SEQ
-
- CALL CCKRAK (JSLNEW)
-
-C-- check +SEQ,..., T=DUMMY
-
- IF (IAND(MCCPAR(JCCPT+1),KMD).NE.0) GO TO 31
-
-C---- try immediate substitution for +SEQ, single name
-
- IF (NCCPZ.NE.1) GO TO 34
- IF (NCCPIF.NE.0) GO TO 34
-
- IXC = MCCPAR(JCCPZ+1)
- CALL LOCSEQ (LSQF, IXC,0,0)
- IF (LSQF.EQ.0) GO TO 34
- IF (IAND(IQ(LSQF),KM17).EQ.0) GO TO 34
-
-C-- do the substitution
-
- JSLNEW = IQ(LSQF+1)
- IF (JSLNEW.LT.LQLSTA(4)) THEN
- JSLNEW = LN_COP4 (JSLNEW,1)
- IQ(LSQF+1) = JSLNEW
- ENDIF
-
- JCCTYP = 0
-
-C-- does the KEEP bank have zero lines?
- IF (LAST.NE.LACT) GO TO 36
- IF (IQ(LACT+3).NE.NUMNEW) GO TO 36
- IQ(LACT+1) = JSLNEW
- IQ(LACT+2) = 1
- GO TO 31
-
-C---- lift XSQ bank for +CDE or +SEQ
-
- 34 LMAT = LIFTSQ (KJOIN,JCCTYP,0,1)
- IFLMSK = 0
- GO TO 37
-
-C---- lift new MAT bank
-
- 35 IFLMSK = 0
- 36 CALL MQLIFT (LMAT,KJOIN,0,JBKMAT,1)
-
- IQ(LMAT) = IOR (IQ(LMAT), ISHFTL(JCCTYP,8))
- 37 LQ(LMAT-2) = LDECO
- IQ(LMAT+1) = JSLNEW
- IQ(LMAT+2) = NSLNEW
- IQ(LMAT+3) = NUMNEW
-
- LAST = LMAT
- KJOIN = LMAT - 1
- GO TO 31
-
-C---- shunt higher level MAT banks
-
- 38 LEV = JBYT (IQ(LDOAN),21,5)
- CALL SBYT (LEV+1,IQ(LDOAN),21,5)
-
- CALL QSHUNT (KDOAN,KJOIN)
- LAST = 0
- KJOIN = LDOAN - 1
- LDOAN = KDOAN + 1
- IFLMSK = 0
- GO TO 31
-
-C---- End of material for KEEP, finalize
-
- 39 IF (LQ(LACT-2).NE.0) IFLSGL= 0
- IF (IQ(LACT+2).NE.1) IFLSGL= 0
-
- IFLMSK = IOR (IFLMSK, MEXAN)
- IFLMSK = IOR (IFLMSK, IFLSGL)
- IQ(LACT) = IOR (IQ(LACT), IFLMSK)
- GO TO 99
-
-C---------- Handle +DEL +REPL +ADB +ADD -----------------
-
- 41 LCRD = LQ(LDOAN-3)
- JSLCL = IQ(LDOAN+1)
- JACTU = ISHFTL (JCCTYP-MCCDEL,8)
-
- IF (LUPAN.EQ.0) THEN
- LORG = LDECO
- NUMORG = JSLCL - JSLORG
- ELSE
- LORG = LQ(LDOAN-2)
- NUMORG = IQ(LDOAN+3)
- ENDIF
-
-C-- lift the ACT bank
-
- 45 CALL MQLIFT (LACT,LCRD,-2,JBKACT,1)
-
- IQ(LACT) = IOR (IQ(LACT), JACTU)
- IQ(LACT) = IOR (IQ(LACT), MEXAN)
- LQ(LACT-3) = LORG
- IQ(LACT+1) = JSLCL
- IQ(LACT+2) = 1
- IQ(LACT+3) = NUMORG
- IQ(LACT+4) = MCCPAR(JCCPC+1)
- IQ(LACT+5) = MCCPAR(JCCPC+2)
-
-C-- NIL action
-
- IF (IFLNIL.NE.0) THEN
- IQ(LACT) = IOR (IQ(LACT),KM12)
- IF (LUPAN.EQ.0) IQ(LACT+2) = 0
- IF (JCCTYP.NE.MCCDEL) GO TO 99
- JCCTYP = -1
- GO TO 79
- ENDIF
-
-C-- true action
-
- IF (JCCTYP.EQ.MCCDEL) THEN
- IF (NCCPC.GE.2) JSLCL= LN_COP4 (JSLCL,1)
- JCCTYP = -1
- ENDIF
- IF (JCCTYP.EQ.-1) GO TO 79
-
- IFTON = 0
- KJOIN = LACT - 2
-
-C-- handle +ADD, ..., Z=sname
-
- IF (NCCPZ.EQ.0) GO TO 47
- LMAT = LIFTSQ (KJOIN,MCCXSQ,0,1)
- LQ(LMAT-2) = LORG
- IQ(LMAT+1) = JSLCL
- IQ(LMAT+2) = 0
- IQ(LMAT+3) = NUMORG
- KJOIN = LMAT - 1
-
- 47 IF (LUPAN.NE.0) GO TO 51
- JCCTYP = 0
- NSTEP = 1
- GO TO 53
-
-C---- create MAT continuation banks for ACT
-
- 51 CALL MK_FNX
- IF (LDOAN.EQ.0) GO TO 79
- IF (JCCTYP.GE.MCCSEL) GO TO 79
- IF (IQ(LDOAN+2).EQ.0) GO TO 51
- IF (LUPAN.NE.0) GO TO 77
- NSTEP = 0
- 53 CALL MK_FRAG (KJOIN,NSTEP)
- GO TO 51
-
-C---- shunt higher level MAT banks
-
- 77 LEV = JBYT (IQ(LDOAN),21,5)
- CALL SBYT (LEV+1,IQ(LDOAN),21,5)
-
- CALL QSHUNT (KDOAN,KJOIN)
- KJOIN = LDOAN - 1
- LDOAN = KDOAN + 1
- GO TO 51
-
-C---- End of material for ACT, finalize
-
- 79 IQ(LACT) = IOR (IQ(LACT), MEXAN)
- IF (JCCTYP.NE.-1) GO TO 99
-
-C-- iterate if multiple +DEL
-
- JCCPC = JCCPC + 3
- NCCPC = NCCPC - 1
- IF (NCCPC.NE.0) GO TO 45
-
- 99 IFTONX = IFTON
- RETURN
- END
diff --git a/src/p5boot/p5lib/domap.f b/src/p5boot/p5lib/domap.f
deleted file mode 100644
index 510de61..0000000
--- a/src/p5boot/p5lib/domap.f
+++ /dev/null
@@ -1,74 +0,0 @@
-CDECK ID>, DOMAP.
- SUBROUTINE DOMAP
-
-C- Content analysis of the next deck,
-C- map the description of this deck's material
-C- into the control-banks of the linear PREP structure.
-C. started 9-jan-92
-
- PARAMETER (NBANKS=19,JBKPAT=1, JBKDEC=2, JBKORG=3, JBKINC=4,
- + JBKHOL=5, JBKKEE=6, JBKACT=7, JBKMAT=8, JBKXSQ=9,
- + JBKPRE=10,JBKGAR=11,JBKSMH=12,JBKSMT=13,JBKSML=14,
- + JBKSMX=15,JBKARR=16,JBKASA=17,JBKPAM=18,JBKRPA=19)
- COMMON /QBANKS/MMBANK(5,NBANKS)
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
- COMMON /INCLC/ N_INCL, IX_INCL(100)
- COMMON /M_ANAC/LOWAN,KDOAN,LDOAN,LUPAN,MODEAN,MEXAN,LEVAN,KKM5AN
- +, NEWDEC,NEWCTL,NEWFOR,NEWNIL,NEWINC
-C-------------- End CDE --------------------------------
-
-
- NEWDEC = 0
- NEWCTL = 0
- NEWFOR = 0
- NEWNIL = 0
- NEWINC = 0
- MEXAN = 0
- N_INCL = 0
- JSLZER = IQ(LQHOLD+1)
- JSLORG = JSLZER - NSLORG
-
-C-- create the PREP seedling
-
- CALL MQLIFT (LQPREP, 0,7, JBKPRE,2)
-
- IQ(LQPREP+1) = JSLZER
- IQ(LQPREP+2) = IQ(LQHOLD+3)
-
-C---- stage 1 : delimit control lines, create PREP structure
-
- IF (MOPUPD.GE.0) CALL M_ANA1
-
-
-C---- stage 2 : connect actions into this deck
-
- IF (LEXD.EQ.0) GO TO 31
- IF (LQ(LEXD-2).EQ.0) GO TO 31
-
- CALL M_ANA2
-
-C-- create NIL sequences or actions
-
- IF (NEWNIL.NE.0) CALL MK_NIL
-
-
-C---- stage 3 : ready effective self-material and new foreign material
-C- return JANSW = -1 skip patch, 0 skip deck, 1 process
-
- 31 CALL M_HEAD
- IF (JANSW.GT.0) CALL M_ANA3
- RETURN
- END
diff --git a/src/p5boot/p5lib/domapa.f b/src/p5boot/p5lib/domapa.f
deleted file mode 100644
index 8540c2b..0000000
--- a/src/p5boot/p5lib/domapa.f
+++ /dev/null
@@ -1,89 +0,0 @@
-CDECK ID>, DOMAPA.
- SUBROUTINE DOMAPA (IFLACT)
-
-C- Content analysis of the next deck for the Auxiliaries,
-C- map the description of this deck's material
-C- into the control-banks of the linear PREP structure.
-C- Merge actions if IFLACT not zero
-C. started 12-jan-94
-
- PARAMETER (NBANKS=19,JBKPAT=1, JBKDEC=2, JBKORG=3, JBKINC=4,
- + JBKHOL=5, JBKKEE=6, JBKACT=7, JBKMAT=8, JBKXSQ=9,
- + JBKPRE=10,JBKGAR=11,JBKSMH=12,JBKSMT=13,JBKSML=14,
- + JBKSMX=15,JBKARR=16,JBKASA=17,JBKPAM=18,JBKRPA=19)
- COMMON /QBANKS/MMBANK(5,NBANKS)
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
- COMMON /M_ANAC/LOWAN,KDOAN,LDOAN,LUPAN,MODEAN,MEXAN,LEVAN,KKM5AN
- +, NEWDEC,NEWCTL,NEWFOR,NEWNIL,NEWINC
-C-------------- End CDE --------------------------------
-
-
-
- JSLZER = IQ(LQHOLD+1)
- JSLORG = JSLZER
-
-C-- create the PREP seedling
-
- CALL MQLIFT (LQPREP, 0,7, JBKPRE,2)
-
- IQ(LQPREP+1) = JSLZER
- IQ(LQPREP+2) = IQ(LQHOLD+3)
-
-C---- stage 1 : delimit control lines, create PREP structure
-
- CALL M_ANA1
-
- IF (IFLACT.EQ.0) RETURN
- IF (LEXD.EQ.0) RETURN
- IF (LQ(LEXD-2).EQ.0) RETURN
-
-C---- stage 2 : split PREP banks on action limits
-
- LDO = LQPREP
- LACT = LEXD - 1
-
-C-- Next action
-
- 21 LACT = LQ(LACT-1)
- IF (LACT.EQ.0) RETURN
-
-C- JACT = 0 DEL, 1 REP, 2 ADB, 3 ADD
-
- JACT = JBYT (IQ(LACT),9,3)
- JSLX = IQ(LACT+4) + JSLZER
-
-C- break at the insertion point
-
- LDO = M_SPLIT (LDO,JSLX)
- IF (LDO.EQ.0) GO TO 61
-
-C- zero-line PREP bank with reference to ACT
-
- LX = LDO
- LDO = M_SPLIT (LDO,0)
- LQ(LX-2) = LACT
- GO TO 21
-
-C-- Add trailing actions
-
- 61 LNEW = KQLAST (LQPREP-1) + 1
- 62 CALL MQLIFT (LNEW,LNEW,-1,JBKPRE,2)
- LQ(LNEW-2) = LACT
-
- LACT = LQ(LACT-1)
- IF (LACT.NE.0) GO TO 62
- RETURN
- END
diff --git a/src/p5boot/p5lib/dopam.f b/src/p5boot/p5lib/dopam.f
deleted file mode 100644
index 54a0ac2..0000000
--- a/src/p5boot/p5lib/dopam.f
+++ /dev/null
@@ -1,240 +0,0 @@
-CDECK ID>, DOPAM.
- SUBROUTINE DOPAM
-
-C- Process the next multi-PAM file
-C. started 27-feb-92
-
- COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT,NUSLAT(2),DUMMY(34)
- CHARACTER SLLINE*512, SLERRM*256
- COMMON /SLATLN/ SLLINE, SLERRM
- PARAMETER (KM1=1,KM2=2,KM3=4,KM4=8,KM5=16,KM6=32,KM7=64,KM8=128,
- + KM9=256, KM10=512, KM11=1024, KM12=2048, KM13=4096, KM14=8192,
- + KM15=16384, KM16=32768, KM17=65536, KM18=131072, KM19=262144)
- PARAMETER (NBANKS=19,JBKPAT=1, JBKDEC=2, JBKORG=3, JBKINC=4,
- + JBKHOL=5, JBKKEE=6, JBKACT=7, JBKMAT=8, JBKXSQ=9,
- + JBKPRE=10,JBKGAR=11,JBKSMH=12,JBKSMT=13,JBKSML=14,
- + JBKSMX=15,JBKARR=16,JBKASA=17,JBKPAM=18,JBKRPA=19)
- COMMON /QBANKS/MMBANK(5,NBANKS)
- COMMON /QPAGE/ NQLMAX,NQLTOL,NQLTOK,NQCMAX,NQCPGH,NQPAGE
- +, NQWYLDO,NQWYL,NQNEWH,NQJOIN,NQDKNO,NQDKPG
- COMMON /QUNIT/ IQREAD,IQPRNT, IQTTIN,IQTYPE, IQOFFL,IQRTTY,IQRSAV
- +, IQRFD,IQRRD,IQRSIZ, NQLPAT,NQUSED,NQLLBL, NQINIT
- COMMON /ARRCOM/IN_LUN, IN_FD, IN_FIO, IN_EOF
- +, IN_DOX, IN_DO1, IN_DO2
- PARAMETER (MCCNIL=1, MCCKIL=2, MCCINC=3, MCCCDE=4, MCCSEQ=5,
- + MCCXSQ=6, MCCTRU=7, MCCFAL=8, MCCELS=9, MCCEND=10,
- + MCCSEL=11, MCCSES=12, MCCFAU=13, MCCSKI=14,
- + MCCKEE=15, MCCDEL=16, MCCREP=17, MCCADB=18, MCCADD=19,
- + MCCUSE=20, MCCXDI=21, MCCDIV=22, MCCLIS=23, MCCEXE=24, MCCIMI=25,
- + MCCASM=26, MCCUPD=27, MCCNAM=28, MCCGAP=29, MCCMOR=30, MCCONL=31,
- + MCCFOR=32, MCCSUS=33, MCCOPT=34, MCCOP2=35, MCCSHO=36, MCCPAM=37,
- + MCCQUI=38, MCCEOD=39, MCCDEC=40, MCCPAT=41, MCCTIT=42)
- CHARACTER CCKORG*256, CCKARD*256, CCCOMF*256
- COMMON /CCPARA/NCHCCD,NCHCCT, JCCTYP,JCCLEV,JCCSL,MCCPAR(240)
- +, NCCPAR,MXCCIF,JCCIFV,JCCBAD,JCCWAR,ICCSUB,JCCWK(4)
- +, JCCPP,JCCPD,JCCPZ,JCCPT,JCCPIF,JCCPC,JCCPN
- +, NCCPP,NCCPD,NCCPZ,NCCPT,NCCPIF,NCCPC,NCCPN
- +, JCCEND, NCHCCC,IXCCC, CCKORG, CCKARD, CCCOMF
- CHARACTER CHEXPD*68
- COMMON /CHEXC/ IXEXPAM, IXEXPAT,IXEXDEC,IXEXID, NCHEPD, CHEXPD
- COMMON /DEPCOM/JD_NEW, JD_DTN, JD_DTP, JD_DTD, JD_DIV
- +, JD_SML, JD_SMP, JD_SMX, JDP_DT, JDP_DV
- +, JD_SPL, JD_MOD, JD_LUN, JD_LOG, JD_NLI, JD_MULT
- +, IX_EXT, IX_RH, IX_SUB
- COMMON /MUSEBC/ MX_FORC, MU_GLOB, MU_PAT, MU_DECK, MU_INH, MU_FORG
- +, MX_TRAN, MX_FORG, MX_SINH, MX_SELF, NVEXDK(6)
- PARAMETER (NFIMAX=100)
- COMMON /TITLEC/ NFILET, JTIPAM(NFIMAX)
- COMMON /MQCM/ NQSYSS,NQLINK, LQCSTA(3),LQCEND(3), NQMAX
- +, LQLSTA(5),LQLEND(5), LQADR,LQADR0,NQOFFS
- PARAMETER (KQGARB=1,KQARRV=3,KQKEEP=4,KQPREP=5,KQMAIN=6,KQPAST=8)
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
-C-------------- End CDE --------------------------------
-
- IAND (IZV,IZW) = AND (IZV, IZW)
-
-
-C---- Connect the PAM file
-
- CALL DOPAMCO
-
- JDKSUB = 0
- MXFOSV = MX_FORC
- MOPT = IQ(LPAM+6)
-
- IFLHOL = IAND (MOPT,KM2)
- IFLUPD = IAND (MOPT,KM4)
- IFLMERG = IAND (MOPT,KM5)
- IFLDISP = IAND (MOPT,KM6)
-
-C-- Handle UPDATE mode
-
- IF (MOPUPD.NE.0) THEN
- IF (IFLUPD.NE.0) THEN
- MOPUPD = -1
- ELSE
-C- suspend EXE mode for self on this PAM file
- MX_FORC = IAND (MX_FORC, NOT(KM6))
- ENDIF
- ENDIF
-
- NHOLD = IQ(LARRV+9)
- IF (NHOLD.EQ.0) GO TO 31
-
-C---- Resume input of the PAM file
-
- IQ(LARRV+9) = 0
- CALL ARRIVE (1)
-
- JSLTTL = IQ(LARRV+10)
- IXEXPAM = IQ(LARRV+11)
- IF (IQ(LPAM+4).GT.0) GO TO 42
-
- NCENT = NQDKNO / 100
- NNUM = MOD (NHOLD,100)
- NNEW = 100*NCENT + NNUM
- IF (NNEW.LT.NQDKNO) NNEW= NNEW + 100
- NQDKNO = NNEW
- JDKTYP = 2
- GO TO 42
-
-C------ Load the title deck to memory ------------
-
- 31 IF (JDKNEX.EQ.0) CALL ARRIVE (2)
-
-C---- Handle the PAM-file title
-
- JCCTYP = 0
- JD_DTP = 1
- JD_DTN = 1
-
- CALL KRTITL
- IF (JCCTYP.EQ.MCCPAT) JDKSUB= 2
-
- JSLTTL = IQ(LARRV+10)
- IQ(LPAM+13) = IQ(LPAM+13) + 1
- IF (IQ(LPAM+4).GT.0) GO TO 42
-
- IF (NQDKNO.GE.2) THEN
- NQDKNO = ((NQDKNO-1)/100 + 1) *100
- ELSE
- NQDKNO = 0
- ENDIF
- JDKTYP = 3
-
-C-- create RPAM bank
-
- 42 CALL QSHUNT (KQMAIN,KQPAST)
- CALL MQLIFT (LRPAM, LEXP,1, JBKRPA,3)
- IQ(LRPAM+1) = JSLTTL
- IQ(LRPAM+2) = -IXEXPAM
- IQ(LRPAM+3) = NQDKNO
-
- CALL LN_GET (JSLTTL, SLLINE, 60)
- NTXT = NDSLAT
-
-C-- PAM file to be read, not skipped
-
- IF (IQ(LPAM+4).GT.0) GO TO 71
-
- CALL DPBLAN (0)
- WRITE (IQPRNT,9043) SLLINE(1:NTXT)
- NQUSED = NQUSED + 2
- IF (IQTYPE.NE.IQPRNT) WRITE (IQTYPE,9043) SLLINE(1:NTXT)
- 9043 FORMAT (' Read Pam file: ',A/)
-
- IF (NFILET.LT.NFIMAX) NFILET= NFILET + 1
- JTIPAM(NFILET) = JSLTTL
-
-C------ Loop over all patches
-
- IF (JDKSUB.NE.0) JDKTYP= 2
- JDKSUB = 0
- JD_DTP = 1
- JD_DTN = 1
-
- 44 CALL DOPAT
- IF (JDKTYP.EQ.6) GO TO 81
- IF (IQ(LEXP+2).EQ.IQ(LPAM+7)) GO TO 61
- IF (JDKTYP.EQ.2) GO TO 44
-
-C---- +TITLE seen, do next PAM file
-
- IQ(LPAM+5) = IQ(LPAM+5) - 1
- IF (IQ(LPAM+5).LE.0) GO TO 62
- GO TO 31
-
-C---- Stop input from PAM
-C- for RETURN=name reached
-C- for number of PAM files to be done exhausted
-
- 61 IF (JDKTYP.EQ.2) IQ(LARRV+9)= NQDKNO
- 62 JSLSAV = IQ(LQHOLD+1)
- NSLSAV = IQ(LQHOLD+2)
- IF (IFLHOL.EQ.0) THEN
- LQLEND(2) = JSLSAV
- LQLSTA(3) = LQLEND(2)
- LQLEND(3) = LQLSTA(3)
- GO TO 82
- ENDIF
-
- IF (NSLSAV.EQ.0) GO TO 88
- IF (IQ(LARRV+7).GT.0) THEN
- IN_DOX = 1
- IN_DO1 = JSLSAV
- CALL ARRIN
- GO TO 88
- ENDIF
-
- CALL MQLIFT (LASAV,LARRV,-2,JBKASA,1)
- IQ(LASAV+1) = JSLSAV
- IQ(LASAV+2) = NSLSAV
- GO TO 88
-
-C------ Skip the PAM file
-
- 71 IQ(LPAM+4) = IQ(LPAM+4) - 1
- IQ(LRPAM+4) = -1
-
- CALL DPBLAN (0)
- WRITE (IQPRNT,9072) SLLINE(1:NTXT)
- NQUSED = NQUSED + 2
- 9072 FORMAT (' Skip Pam file: ',A/)
-
- JDKTYP = 3
- CALL ARRSKP
- IF (JDKTYP.LT.6) GO TO 31
-
-C------ End of multi-PAM reached
-
- 81 CONTINUE
-
-C-- Detach or Rewind
-
- 82 IF (IFLHOL.EQ.0) THEN
- IN_DOX = -1
- ELSE
- IN_DOX = 0
- ENDIF
- CALL ARRIN
-
- 88 IQ(LQHOLD+2) = 0
- IQ(LPAM+12) = IQ(LPAM+12) + IQ(LARRV+12)
- IQ(LARRV+12) = 0
- MOPUPD = ABS(MOPUPD)
- MX_FORC = MXFOSV
- RETURN
- END
diff --git a/src/p5boot/p5lib/dopamco.f b/src/p5boot/p5lib/dopamco.f
deleted file mode 100644
index ec05c0a..0000000
--- a/src/p5boot/p5lib/dopamco.f
+++ /dev/null
@@ -1,120 +0,0 @@
-CDECK ID>, DOPAMCO.
- SUBROUTINE DOPAMCO
-
-C- Connect the next multi-PAM file
-C. started 19-July-95
-
- COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT,NUSLAT(2),DUMMY(34)
- CHARACTER SLLINE*512, SLERRM*256
- COMMON /SLATLN/ SLLINE, SLERRM
- PARAMETER (KM1=1,KM2=2,KM3=4,KM4=8,KM5=16,KM6=32,KM7=64,KM8=128,
- + KM9=256, KM10=512, KM11=1024, KM12=2048, KM13=4096, KM14=8192,
- + KM15=16384, KM16=32768, KM17=65536, KM18=131072, KM19=262144)
- COMMON /QPAGE/ NQLMAX,NQLTOL,NQLTOK,NQCMAX,NQCPGH,NQPAGE
- +, NQWYLDO,NQWYL,NQNEWH,NQJOIN,NQDKNO,NQDKPG
- COMMON /QUNIT/ IQREAD,IQPRNT, IQTTIN,IQTYPE, IQOFFL,IQRTTY,IQRSAV
- +, IQRFD,IQRRD,IQRSIZ, NQLPAT,NQUSED,NQLLBL, NQINIT
- COMMON /ARRCOM/IN_LUN, IN_FD, IN_FIO, IN_EOF
- +, IN_DOX, IN_DO1, IN_DO2
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
- PARAMETER (NSLIFI=128)
- CHARACTER CHLIFI*(NSLIFI), CHLIEX*8
- COMMON /FLINKC/LUNOP,LUNFD,LUNOLD,LUNSIZ
- +, IXFLUN, NLIFI,CHLIFI,CHLIEX
-C-------------- End CDE --------------------------------
-
- IAND (IZV,IZW) = AND (IZV, IZW)
-
-
-C---- Garbage collection
-
- CALL MQSHIFT
-
- JDKTYP = 3
- JDKNEX = 0
-
-C---- Connect the PAM file
-
- LARRV = LQARRV
-
- IN_LUN = IQ(LPAM+1)
- LABEL = IQ(LPAM+3)
- MOPT = IQ(LPAM+6)
- IXFLUN = IQ(LPAM+8)
-
- IFLATT = IAND (MOPT,KM1)
-C IFLHOL = IAND (MOPT,KM2)
- IFLRES = IAND (MOPT,KM3)
- IFLUPD = IAND (MOPT,KM4)
- IFLREW = 1
-
- IF (IFLATT.NE.0) GO TO 23
-
-C---- Use connected file
-
- LUNPRE = IQ(LARRV+1)
- IXFLUN = IQ(LARRV+4)
- IF (LUNPRE.EQ.0) GO TO 23
-
- IF (IFLRES.NE.0) THEN
- IFLREW = 0
- SLLINE(1:12) = ' ---> resume'
- J = 12
- ELSE
- SLLINE(1:13) = ' ---> restart'
- J = 13
- ENDIF
- GO TO 24
-
-C---- Attach the file
-
- 23 CALL FLINK (IN_LUN, 2, -1, 0)
- IQ(LARRV+2) = LUNFD
- IQ(LARRV+4) = IXFLUN
- IQ(LARRV+6) = LUNSIZ
- IQ(LARRV+7) = -2
- IF (LUNSIZ.GT.0) IQ(LARRV+7)= 0
- SLLINE(1:11) = ' ---> start'
- J = 11
-
-C-- Print log of file reading
-
- 24 SLLINE(J+1:J+14) = ' reading file '
- J = J + 15
- CALL NA_GET (IXFLUN,SLLINE,J)
- NTXT = NESLAT - 1
- CALL DPBLAN (0)
- WRITE (IQPRNT,9027) SLLINE(1:NTXT)
- NQUSED = NQUSED + 2
- IF (IQTYPE.NE.IQPRNT) WRITE (IQTYPE,9027) SLLINE(1:NTXT)
- 9027 FORMAT (A/)
-
-C-- finalize the ARRV bank
-
- IQ(LARRV+1) = IN_LUN
- IQ(LARRV+3) = LABEL
- IQ(LARRV+12) = 0
-
-C-- rewind unless option T=RESUME
-
- IF (IFLREW.NE.0) THEN
- IN_DOX = 0
- CALL ARRIN
- NQWYL = 0
- ENDIF
-
- RETURN
- END
diff --git a/src/p5boot/p5lib/dopat.f b/src/p5boot/p5lib/dopat.f
deleted file mode 100644
index b90f0cd..0000000
--- a/src/p5boot/p5lib/dopat.f
+++ /dev/null
@@ -1,108 +0,0 @@
-CDECK ID>, DOPAT.
- SUBROUTINE DOPAT
-
-C- Process the current patch
-C. started 27-feb-92
-
- PARAMETER (KM1=1,KM2=2,KM3=4,KM4=8,KM5=16,KM6=32,KM7=64,KM8=128,
- + KM9=256, KM10=512, KM11=1024, KM12=2048, KM13=4096, KM14=8192,
- + KM15=16384, KM16=32768, KM17=65536, KM18=131072, KM19=262144)
- COMMON /QPAGE/ NQLMAX,NQLTOL,NQLTOK,NQCMAX,NQCPGH,NQPAGE
- +, NQWYLDO,NQWYL,NQNEWH,NQJOIN,NQDKNO,NQDKPG
- PARAMETER (MCCNIL=1, MCCKIL=2, MCCINC=3, MCCCDE=4, MCCSEQ=5,
- + MCCXSQ=6, MCCTRU=7, MCCFAL=8, MCCELS=9, MCCEND=10,
- + MCCSEL=11, MCCSES=12, MCCFAU=13, MCCSKI=14,
- + MCCKEE=15, MCCDEL=16, MCCREP=17, MCCADB=18, MCCADD=19,
- + MCCUSE=20, MCCXDI=21, MCCDIV=22, MCCLIS=23, MCCEXE=24, MCCIMI=25,
- + MCCASM=26, MCCUPD=27, MCCNAM=28, MCCGAP=29, MCCMOR=30, MCCONL=31,
- + MCCFOR=32, MCCSUS=33, MCCOPT=34, MCCOP2=35, MCCSHO=36, MCCPAM=37,
- + MCCQUI=38, MCCEOD=39, MCCDEC=40, MCCPAT=41, MCCTIT=42)
- CHARACTER CCKORG*256, CCKARD*256, CCCOMF*256
- COMMON /CCPARA/NCHCCD,NCHCCT, JCCTYP,JCCLEV,JCCSL,MCCPAR(240)
- +, NCCPAR,MXCCIF,JCCIFV,JCCBAD,JCCWAR,ICCSUB,JCCWK(4)
- +, JCCPP,JCCPD,JCCPZ,JCCPT,JCCPIF,JCCPC,JCCPN
- +, NCCPP,NCCPD,NCCPZ,NCCPT,NCCPIF,NCCPC,NCCPN
- +, JCCEND, NCHCCC,IXCCC, CCKORG, CCKARD, CCCOMF
- CHARACTER CHEXPD*68
- COMMON /CHEXC/ IXEXPAM, IXEXPAT,IXEXDEC,IXEXID, NCHEPD, CHEXPD
- COMMON /MUSEBC/ MX_FORC, MU_GLOB, MU_PAT, MU_DECK, MU_INH, MU_FORG
- +, MX_TRAN, MX_FORG, MX_SINH, MX_SELF, NVEXDK(6)
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
-C-------------- End CDE --------------------------------
-
- IAND (IZV,IZW) = AND (IZV, IZW)
-
-
- IFLGAR = 0
- MUGLOB = MU_GLOB
- JCCBAD = 0
- IF (JDKTYP.EQ.3) GO TO 26
-
- JSLF = IQ(LQHOLD+1)
- JCCTYP = MCCPAT
- JTX = MLIAD(JSLF)
- J = JPTYPE (TEXT(JTX))
- IF (J.NE.JCCTYP) THEN
- NTX = MLIAD(JSLF+1) - JTX
- CALL DPLMSG ('Trouble with:',NTX,TEXT(JTX))
- CALL P_CRASH ('trouble in DOPAT')
- ENDIF
- CALL CCKRAK (JSLF)
-
-C-- get the name
-
- IXEXPAT = MCCPAR(JCCPP+1)
- IF (IXEXPAT.EQ.0) IXEXPAT= 1
-
-C-- check the patch is already kown, if not it
-C- cannot have been USE selected
-
- IF (JCCBAD.NE.0) GO TO 27
- IF (IAND(MU_GLOB,KM5).NE.0) GO TO 27
- IF (MOPTIO(1).NE.0) GO TO 27
- IF (LOCPAT(IXEXPAT).NE.0) GO TO 27
-
- JDKTYP = 2
- CALL ARRSKP
- RETURN
-
-C-- find/create the patch bank
-
- 26 IF (MOPUPD.GE.0) MU_GLOB= IAND (MU_GLOB,NOT(KM5))
- 27 CALL CREAPD (IXEXPAT,-1,7)
- MU_GLOB = MUGLOB
- IXEXDEC = 0
- IXEXID = IXEXPAT
- CALL SBYT (NQDKNO, IQ(LEXP+1),13,20)
- MU_PAT = IAND (IQ(LEXP),KM19-1)
- IF (JCCBAD.NE.0) GO TO 44
- IF (IAND(MU_PAT,KM10).EQ.0) GO TO 47
- IF (IAND(IQ(LEXP+1),KM2).NE.0) GO TO 47
- IF (IAND(IQ(LEXP+1),KM4).NE.0) GO TO 44
- IF (IAND(MU_PAT,KM5).EQ.0) GO TO 47
-
- 44 CALL DODECK (0)
- GO TO 48
-
- 47 JDKTYP = 2
- CALL ARRSKP
- 48 IF (IAND(IQ(LEXP+1),KM5).NE.0) RETURN
- IF (MOPUPD.LT.0) RETURN
-
- IF (LQ(LEXP-2).NE.0) CALL TOGARB (LEXP-2,7)
- IF (LQ(LEXP-3).NE.0) CALL TOGARB (LEXP-3,7)
- RETURN
- END
diff --git a/src/p5boot/p5lib/doxqt.f b/src/p5boot/p5lib/doxqt.f
deleted file mode 100644
index 86e879e..0000000
--- a/src/p5boot/p5lib/doxqt.f
+++ /dev/null
@@ -1,244 +0,0 @@
-CDECK ID>, DOXQT.
- SUBROUTINE DOXQT
-
-C- Execute the material according to the map
-C. started 16-jan-92
-
- PARAMETER (KM1=1,KM2=2,KM3=4,KM4=8,KM5=16,KM6=32,KM7=64,KM8=128,
- + KM9=256, KM10=512, KM11=1024, KM12=2048, KM13=4096, KM14=8192,
- + KM15=16384, KM16=32768, KM17=65536, KM18=131072, KM19=262144,
- + KM20=524288, KM21=1048576, KM22=2097152, KM23=4194304,
- + KM24=8388608, KM25=16777216, KM26=33554432, KM27=67108864,
- + KM28=134217728, KM29=268435456, KM30=536870912, KM31=1073741824)
- COMMON /QUNIT/ IQREAD,IQPRNT, IQTTIN,IQTYPE, IQOFFL,IQRTTY,IQRSAV
- +, IQRFD,IQRRD,IQRSIZ, NQLPAT,NQUSED,NQLLBL, NQINIT
- PARAMETER (MCCNIL=1, MCCKIL=2, MCCINC=3, MCCCDE=4, MCCSEQ=5,
- + MCCXSQ=6, MCCTRU=7, MCCFAL=8, MCCELS=9, MCCEND=10,
- + MCCSEL=11, MCCSES=12, MCCFAU=13, MCCSKI=14,
- + MCCKEE=15, MCCDEL=16, MCCREP=17, MCCADB=18, MCCADD=19,
- + MCCUSE=20, MCCXDI=21, MCCDIV=22, MCCLIS=23, MCCEXE=24, MCCIMI=25,
- + MCCASM=26, MCCUPD=27, MCCNAM=28, MCCGAP=29, MCCMOR=30, MCCONL=31,
- + MCCFOR=32, MCCSUS=33, MCCOPT=34, MCCOP2=35, MCCSHO=36, MCCPAM=37,
- + MCCQUI=38, MCCEOD=39, MCCDEC=40, MCCPAT=41, MCCTIT=42)
- CHARACTER CCKORG*256, CCKARD*256, CCCOMF*256
- COMMON /CCPARA/NCHCCD,NCHCCT, JCCTYP,JCCLEV,JCCSL,MCCPAR(240)
- +, NCCPAR,MXCCIF,JCCIFV,JCCBAD,JCCWAR,ICCSUB,JCCWK(4)
- +, JCCPP,JCCPD,JCCPZ,JCCPT,JCCPIF,JCCPC,JCCPN
- +, NCCPP,NCCPD,NCCPZ,NCCPT,NCCPIF,NCCPC,NCCPN
- +, JCCEND, NCHCCC,IXCCC, CCKORG, CCKARD, CCCOMF
- CHARACTER CHEXPD*68
- COMMON /CHEXC/ IXEXPAM, IXEXPAT,IXEXDEC,IXEXID, NCHEPD, CHEXPD
- COMMON /DEPCOM/JD_NEW, JD_DTN, JD_DTP, JD_DTD, JD_DIV
- +, JD_SML, JD_SMP, JD_SMX, JDP_DT, JDP_DV
- +, JD_SPL, JD_MOD, JD_LUN, JD_LOG, JD_NLI, JD_MULT
- +, IX_EXT, IX_RH, IX_SUB
- COMMON /MUSEBC/ MX_FORC, MU_GLOB, MU_PAT, MU_DECK, MU_INH, MU_FORG
- +, MX_TRAN, MX_FORG, MX_SINH, MX_SELF, NVEXDK(6)
- PARAMETER (KQGARB=1,KQARRV=3,KQKEEP=4,KQPREP=5,KQMAIN=6,KQPAST=8)
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
- COMMON /M_ANAC/LOWAN,KDOAN,LDOAN,LUPAN,MODEAN,MEXAN,LEVAN,KKM5AN
- +, NEWDEC,NEWCTL,NEWFOR,NEWNIL,NEWINC
-C-------------- End CDE --------------------------------
-
- PARAMETER (MASKCL=KM12+KM13+KM14+KM15)
-
- IAND (IZV,IZW) = AND (IZV, IZW)
-
-
-C! NDONE = -1
- LUPAN = 0
- LDOAN = KQPREP + 1
-
-C---- Next bank
-
- 20 MODEAN = 0
- 21 CALL X_NEXT
-C! NDONE = NDONE + 1
- 22 IF (LDOAN.EQ.0) GO TO 87
-
-C-- MODEAN = 0 self material
-C- 1 CDE expansion
-C- 2 comment line
-C- 3 +SELF header line
-C- 4 +CDE call line
-C- 5 foreign material
-C- 6 control line
-
- JCCTYP = JBYT (IQ(LDOAN),9,6)
- IF (JCCTYP.GE.MCCKEE) GO TO 51
- IF (JCCTYP.EQ.MCCKIL) GO TO 51
-
-C---------- Self material ----------------
-
- IF (NVEXDK(5).EQ.0) GO TO 21
-
- KKM5AN = IAND(IQ(LDOAN),KM5)
- IF (JCCTYP.EQ.0) GO TO 35
- IF (JCCTYP.EQ.MCCNIL) GO TO 39
- IF (JCCTYP.LE.MCCINC) GO TO 56
- IF (JCCTYP.LE.MCCXSQ) GO TO 36
- IF (JCCTYP.LT.MCCSEL) GO TO 35
-
-C-- to here +SELF, +SKIP and fault
-
- IF (JCCTYP.EQ.MCCSES) GO TO 37
- MODEAN = 3
-
-C-- to here +_IF etc
-
- 35 IF (NVEXDK(2).NE.0) THEN
- CALL DPLIST (MODEAN,LDOAN,LUPAN,0)
- ENDIF
-
- IF (NVEXDK(1).EQ.0) GO TO 20
- IF (KKM5AN.NE.0) GO TO 20
- CALL DPEXE (LDOAN)
- GO TO 20
-
-C-- sequence call
-
- 36 IF (JCCTYP.EQ.MCCXSQ) GO TO 38
- 37 IF (NVEXDK(6).NE.0) THEN
- MODEAN = 4
- CALL DPLIST (MODEAN,LDOAN,LUPAN,0)
- ENDIF
-
- 38 IF (KKM5AN.NE.0) GO TO 20
- MODEAN = 1
- CALL X_SEQ (LDOAN)
- GO TO 20
-
-C-- comment line
-
- 39 IF (NVEXDK(6).EQ.0) GO TO 21
- CALL DPLIST (2,LDOAN,LUPAN,1)
- GO TO 21
-
-C---------- New foreign material --------------
-
- 51 KKM5AN = IAND(IQ(LDOAN),KM5)
- IF (JCCTYP.GE.MCCUSE) GO TO 56
- IF (JCCTYP.LT.MCCKEE) GO TO 56
-
- MODEAN = 5
- IF (NVEXDK(2).NE.0) CALL DPLIST (MODEAN,LDOAN,LUPAN,1)
-
- CALL DOFORG (NSTEP)
- MODEAN = 0
- IF (NSTEP.EQ.0) GO TO 22
- GO TO 21
-
-C---------- Lines +DECK or +PATCH --------------
-
- 56 MODEAN = 6
- CALL CCKRAK (IQ(LDOAN+1))
- IF (NVEXDK(6).NE.0) THEN
- CALL DPLIST (MODEAN,LDOAN,LUPAN,1)
- IF (JCCTYP.GE.MCCPAT) NQLPAT = NQUSED
- ENDIF
-
- IF (KKM5AN.NE.0) GO TO 20
- IF (JCCTYP.LT.MCCDEC) GO TO 61
-C! IF (NDONE.EQ.0) GO TO 20
- IF (NVEXDK(1).EQ.0) GO TO 20
-
- IF (JD_NEW.EQ.0) CALL DPEXTM (1)
-
- JASM = JBYT (IQ(LDOAN),21,6)
-
- IF (JCCTYP.EQ.MCCPAT) THEN
- IXEXID = MCCPAR(JCCPP+1)
- JD_DTN = MAX (JASM,1)
- JD_DTP = JD_DTN
- ELSEIF (JCCTYP.EQ.MCCDEC) THEN
- IXEXID = MCCPAR(JCCPD+1)
- JD_DTN = JASM
- IF (JD_DTN.EQ.0) JD_DTN= JD_DTP
- ENDIF
- GO TO 20
-
-C---------- Control lines +USE etc ---------------
-
- 61 IF (JCCTYP.GE.MCCUSE) GO TO 64
-
-C-- Do : +INCLUDE
-
- IF (JCCTYP.EQ.MCCINC) THEN
- CALL X_INCL (0)
- GO TO 20
- ENDIF
-
-C-- Do : +KILL
-
- CALL P_FATAL (CCKORG(1:NCHCCT))
-
-C-- Done : +USE etc if not in CRA*
-
- 64 IF (JCCTYP.LE.MCCEXE) THEN
- IF (INCRAD.LT.2) GO TO 20
-
-C-- Do : +USE +EXE +LIST +DIVERT +XDIV
-
- CALL X_USE
- GO TO 20
- ENDIF
-
-C-- Do : +IMITATE
-
- IF (JCCTYP.EQ.MCCIMI) THEN
- CALL X_IMIT
- GO TO 20
- ENDIF
-
-C-- Do : +ASM
-
- IF (JCCTYP.EQ.MCCASM) THEN
- CALL X_ASM
- GO TO 20
- ENDIF
-
-C-- Done : +UPDATE +NAMES +GAPS +MORE
-
- IF (JCCTYP.LE.MCCMOR) GO TO 20
-
-C!- Do : +ONLY
-C!
-C! IF (JCCTYP.EQ.MCCONL) THEN
-C! CALL X_ONLY (LDOAN)
-C! GO TO 20
-C! ENDIF
-
-C-- Do : +FORCE +SUSPEND
-
- IF (JCCTYP.LE.MCCSUS) THEN
- CALL X_USE
- GO TO 20
- ENDIF
-
-C-- Do : +OPTION +PARAMETER +SHOW
-
- IF (JCCTYP.LE.MCCSHO) THEN
- CALL X_OPT
- GO TO 20
- ENDIF
-
- CALL P_CRASH ('DOXQT should not reach this point')
-
-C---- Done
-
- 87 CONTINUE
- RETURN
- END
diff --git a/src/p5boot/p5lib/dpblan.f b/src/p5boot/p5lib/dpblan.f
deleted file mode 100644
index 1ccc1c3..0000000
--- a/src/p5boot/p5lib/dpblan.f
+++ /dev/null
@@ -1,27 +0,0 @@
-CDECK ID>, DPBLAN.
- SUBROUTINE DPBLAN (MODE)
-
-C- MODE = -1: after text just printed, print a blank line
-C- 0: if NQLLBL=0, print a blank line
-C- 1: if NQLLBL=0, print a blank line before text about to print
-C- also 0: as 1, but assume the text to be printed ends
-C- with a blank line
-
- COMMON /QUNIT/ IQREAD,IQPRNT, IQTTIN,IQTYPE, IQOFFL,IQRTTY,IQRSAV
- +, IQRFD,IQRRD,IQRSIZ, NQLPAT,NQUSED,NQLLBL, NQINIT
-C-------------- End CDE --------------------------------
-
- IF (MODE.LT.0) GO TO 27
- IF (MODE.EQ.0) THEN
- IF (NQLLBL.EQ.0) GO TO 27
- ELSE
- IF (NQLLBL.EQ.0) GO TO 28
- NQLLBL = 0
- ENDIF
- RETURN
-
- 27 NQLLBL = 1
- 28 WRITE (IQPRNT,'(A)')
- NQUSED = NQUSED + 1
- RETURN
- END
diff --git a/src/p5boot/p5lib/dpexe.f b/src/p5boot/p5lib/dpexe.f
deleted file mode 100644
index 1e50734..0000000
--- a/src/p5boot/p5lib/dpexe.f
+++ /dev/null
@@ -1,85 +0,0 @@
-CDECK ID>, DPEXE.
- SUBROUTINE DPEXE (LDO)
-
-C- EXE output of next lot
-C. started 21-jan-92
-
- CHARACTER CCKORG*256, CCKARD*256, CCCOMF*256
- COMMON /CCPARA/NCHCCD,NCHCCT, JCCTYP,JCCLEV,JCCSL,MCCPAR(240)
- +, NCCPAR,MXCCIF,JCCIFV,JCCBAD,JCCWAR,ICCSUB,JCCWK(4)
- +, JCCPP,JCCPD,JCCPZ,JCCPT,JCCPIF,JCCPC,JCCPN
- +, NCCPP,NCCPD,NCCPZ,NCCPT,NCCPIF,NCCPC,NCCPN
- +, JCCEND, NCHCCC,IXCCC, CCKORG, CCKARD, CCCOMF
- COMMON /MUSEBC/ MX_FORC, MU_GLOB, MU_PAT, MU_DECK, MU_INH, MU_FORG
- +, MX_TRAN, MX_FORG, MX_SINH, MX_SELF, NVEXDK(6)
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
- COMMON /DEPCOM/JD_NEW, JD_DTN, JD_DTP, JD_DTD, JD_DIV
- +, JD_SML, JD_SMP, JD_SMX, JDP_DT, JDP_DV
- +, JD_SPL, JD_MOD, JD_LUN, JD_LOG, JD_NLI, JD_MULT
- +, IX_EXT, IX_RH, IX_SUB
- CHARACTER*8 CH_SUBS, CH_SUBT
- COMMON /DEPSUB/NCH_SUB, CH_SUBS, CH_SUBT
-C-------------- End CDE --------------------------------
-
-
- JSLX = IQ(LDO+1)
- NSLX = IQ(LDO+2)
- IF (JCCTYP.NE.0) THEN
- JSLX = JSLX + 1
- NSLX = NSLX - 1
- ENDIF
-
- IF (NSLX.LE.0) RETURN
- IF (JD_NEW.NE.0) THEN
- CALL DPEXGO
- IF (NVEXDK(1).EQ.0) RETURN
- ENDIF
-
- JD_NLI= JD_NLI + NSLX
-
-C-- Control character substitution
-
- IF (IX_SUB.EQ.0) GO TO 31
- JSL = JSLX
- N = NCH_SUB
-
- DO 24 JJ=1,NSLX
- JTX = MLIAD(JSL)
- NTX = MLIAD(JSL+1) - JTX - NCHNEWL
- IF (NTX.LT.4) GO TO 24
-
- J = INDEX (CH_SUBS(1:N),TEXT(JTX))
- IF (J.EQ.0) GO TO 24
- IF (JPTYPE(TEXT(JTX)).EQ.0) GO TO 24
-
- TEXT(JTX) = CH_SUBT(J:J)
- 24 JSL = JSL + 1
-
-C---- Normal output without MODIFY check
-
- 31 IF (JD_MOD.NE.0) GO TO 41
- 32 JTX = MLIAD(JSLX)
- NTX = MLIAD(JSLX+NSLX) - JTX
- CALL CIPUT (JD_LUN,TEXT(JTX),NTX,ISTAT)
- IF (ISTAT.NE.0) CALL P_FATAM ('CIO write fails')
- RETURN
-
-C---- Output for MODIFY
-
- 41 CALL DPEXMO (JSLX,NSLX)
- IF (JD_MOD.EQ.0) GO TO 32
- RETURN
- END
diff --git a/src/p5boot/p5lib/dpexgo.f b/src/p5boot/p5lib/dpexgo.f
deleted file mode 100644
index 1f172b6..0000000
--- a/src/p5boot/p5lib/dpexgo.f
+++ /dev/null
@@ -1,291 +0,0 @@
-CDECK ID>, DPEXGO.
- SUBROUTINE DPEXGO
-
-C- Ready to write first line of new routine,
-C- called from DPEXE.
-C. started 21-jan-92
-
- COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT,NUSLAT(2),DUMMY(34)
- CHARACTER SLLINE*512, SLERRM*256
- COMMON /SLATLN/ SLLINE, SLERRM
- PARAMETER (KM1=1,KM2=2,KM3=4,KM4=8,KM5=16,KM6=32,KM7=64,KM8=128,
- + KM9=256, KM10=512, KM11=1024, KM12=2048, KM13=4096, KM14=8192,
- + KM15=16384, KM16=32768, KM17=65536, KM18=131072, KM19=262144)
- COMMON /MQCM/ NQSYSS,NQLINK, LQCSTA(3),LQCEND(3), NQMAX
- +, LQLSTA(5),LQLEND(5), LQADR,LQADR0,NQOFFS
- COMMON /MUSEBC/ MX_FORC, MU_GLOB, MU_PAT, MU_DECK, MU_INH, MU_FORG
- +, MX_TRAN, MX_FORG, MX_SINH, MX_SELF, NVEXDK(6)
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
- CHARACTER CHEXPD*68
- COMMON /CHEXC/ IXEXPAM, IXEXPAT,IXEXDEC,IXEXID, NCHEPD, CHEXPD
- PARAMETER (JFO_TYP=1, JCC_TYP=2, JAS_TYP=3, JDA_TYP=4,
- + JSH_TYP=5, JCR_TYP=6, JIN_TYP=7, MAX_TYP=100)
- CHARACTER*16 CH_TYP(MAX_TYP), ACT_TYP
- COMMON /CM_TYP/ LUN_TYP, N_TYP, NAL_TYP, NDV_TYP, JBK_TYP
- +, JU_TYP(MAX_TYP), CH_TYP, ACT_TYP
- COMMON /DEPCOM/JD_NEW, JD_DTN, JD_DTP, JD_DTD, JD_DIV
- +, JD_SML, JD_SMP, JD_SMX, JDP_DT, JDP_DV
- +, JD_SPL, JD_MOD, JD_LUN, JD_LOG, JD_NLI, JD_MULT
- +, IX_EXT, IX_RH, IX_SUB
- COMMON /DEPMOD/MO_JSA, MO_JSL, MO_JSE
- CHARACTER*8 CH_SUBS, CH_SUBT
- COMMON /DEPSUB/NCH_SUB, CH_SUBS, CH_SUBT
- COMMON /M_ANAC/LOWAN,KDOAN,LDOAN,LUPAN,MODEAN,MEXAN,LEVAN,KKM5AN
- +, NEWDEC,NEWCTL,NEWFOR,NEWNIL,NEWINC
- PARAMETER (NSLIFI=128)
- CHARACTER CHLIFI*(NSLIFI), CHLIEX*8
- COMMON /FLINKC/LUNOP,LUNFD,LUNOLD,LUNSIZ
- +, IXFLUN, NLIFI,CHLIFI,CHLIEX
-C-------------- End CDE --------------------------------
- EQUIVALENCE (LASML,JD_SML), (LASMP,JD_SMP), (LXASM,JD_SMX)
-
- CHARACTER CHMARK*1, LINE*256, COLS(256)*1
- EQUIVALENCE (LINE,SLLINE)
- EQUIVALENCE (COLS,LINE)
-
-
- IF (JD_NEW.LT.0) GO TO 29
-
-C-- Decide logical stream at the start of deck
-
- JD_DTD = JD_DTN
- IF (JD_DTD.EQ.0) JD_DTD= JD_DTP
-
- JD_DIV = NVEXDK(3) + 2*NVEXDK(4) + 1
-C- = 1 normal, 2 diverted, 3 xdiv/normal, 4 xdiv/diverted
-
-C-- Find the ASML bank for the logical stream
-
- LASMT = LQ(LHASM-JD_DTD)
- LASML = LQ(LASMT-JD_DIV-1)
-
-C-- do the re-assignment if requested
-
- J = IQ(LASML+11)
- IF (J.NE.0) THEN
- JD_DTD = J/8
- J = MOD (J,8)
- IF (J.NE.0) JD_DIV= J
- LASMT = LQ(LHASM-JD_DTD)
- LASML = LQ(LASMT-JD_DIV-1)
- ENDIF
-
-C-- Find the ASML bank for the physical stream
-
- MUSE = IQ(LASML+1)
- IF (MUSE.EQ.0) THEN
- LASMP = LASML
- JDP_DT = JD_DTD
- JDP_DV = JD_DIV
- GO TO 24
- ENDIF
-
- JDP_DT = MUSE / 8
- JDP_DV = MOD (MUSE,8)
- LASM = LQ(LHASM-JDP_DT)
- IF (JDP_DV.NE.0) THEN
- LASMP = LQ(LASM-JDP_DV-1)
- ELSE
- LASMP = LASM
- ENDIF
-
- 24 LXASM = LQ(LASMP-1)
-
-C---- Decide the processing mode
-
- IQ(LASML+8) = IQ(LASML+8) + 1
- JD_SPL = IQ(LASMP+2)
- JD_MOD = 0
-
-C-- exit for T=BYPASS
-
- IF (JD_SPL.EQ.0) THEN
- NVEXDK(1) = 0
- NVEXDK(5) = NVEXDK(2)
- IQ(LXASM+3) = IQ(LXASM+3) + 1
- RETURN
- ENDIF
-
- IX_EXT = IQ(LASML+5)
- IX_RH = IQ(LASML+6)
- IX_SUB = IQ(LASML+7)
-
- IF (IX_SUB.EQ.0) GO TO 29
-
-C-- prepare the control-character substitution ready for use
-
- CALL NA_GET (IX_SUB,LINE,1)
- NCH_SUB = MIN (8, NDSLAT/2)
-
- JJ = 0
- DO 27 J=1,NCH_SUB
- CH_SUBS(J:J) = COLS(JJ+1)
- CH_SUBT(J:J) = COLS(JJ+2)
- 27 JJ = JJ + 2
-
-C---- All mode parameters ready, start
-
- 29 JD_NEW = 0
- JD_NLI = 0
- JD_LUN = IQ(LXASM+2)
- JD_MOD = JD_SPL
- IF (NEWINC.NE.0) JD_MOD= 0
- IF (JD_MOD.LT.3) JD_MOD= 0
- IF (JD_SPL.GE.2) GO TO 41
-
-C------ Normal sequential mode ---------------
-
- IF (JD_LUN.GT.0) GO TO 34
-
-C-- open output file for first deck on this stream
-
- LUN_TYP = LUN_TYP + 1
- JD_LUN = LUN_TYP
- IXFLUN = IQ(LASMP+3)
-
- IF (IXFLUN.EQ.0)
- + CALL P_FATAL ('output file name missing')
-
- CALL FLINK (JD_LUN, 6, -1, 0)
- IF (IXFLUN.LT.0) CALL P_FATAL ('OPEN failure')
- JD_LUN = LUNFD
- IQ(LXASM+2) = JD_LUN
-
-C-- Write routine header card if needed
-
- 34 IF (IX_RH.EQ.0) RETURN
-
- JTX = NA_JTX (IX_RH)
- NTX = NDSLAT
-
- CHMARK = TEXT(JTX)
-
- JTX = JTX + 1
- NTX = NTX - 1
- NPUT = 0
-
- 37 JF = ICFILA (CHMARK,TEXT(JTX),1,NTX)
- N = JF - 1
- IF (N.GT.0) THEN
- CALL CCOPYL (TEXT(JTX),COLS(NPUT+1),N)
- NPUT = NPUT + N
- JTX = JTX + N
- NTX = NTX - N
- ENDIF
-
- IF (NTX.GT.0) THEN
- CALL NA_GET (IXEXID,LINE,NPUT+1)
- NPUT = NESLAT - 1
- JTX = JTX + 1
- NTX = NTX - 1
- IF (NTX.GT.0) GO TO 37
- ENDIF
-
- NPUT = NPUT + 1
- LINE(NPUT:NPUT) = CHAR(NEWLN)
- CALL CIPUT (JD_LUN,LINE,NPUT,ISTAT)
- IF (ISTAT.NE.0) CALL P_FATAM ('CIO write fails')
- JD_NLI = 1
- RETURN
-
-C------ SPLIT mode ---------------
-
- 41 IF (JD_LUN.GE.0) GO TO 44
- IQ(LXASM+2) = 0
- IXFLUN = IQ(LASMP+3)
- IF (IXFLUN.EQ.0) GO TO 44
-
-C-- open the log file for first deck on this stream
-
- LUN_TYP = LUN_TYP + 1
- JD_LUN = LUN_TYP
- CALL FLINK (JD_LUN, 6, -1, 0)
- IF (IXFLUN.LT.0) CALL P_FATAL ('OPEN failure')
- JD_LUN = LUNFD
- IQ(LXASM+2) = JD_LUN
-
-C-- construct the file name for the split file
-
- 44 JD_LOG = JD_LUN
- JD_LUN = IQ(LHASM+1)
- CHLIFI = ' '
- JP = 1
-
- IX = IQ(LASMP+4)
- IF (IX.NE.0) THEN
- CALL NA_GET (IX, CHLIFI, JP)
- JP = NESLAT
- ENDIF
-
- CALL NA_GET (IXEXID, CHLIFI, JP)
- CALL CUTOL (CHLIFI(JP:NESLAT))
- JP = NESLAT
-
- IF (IX_EXT.NE.0) THEN
- CALL NA_GET (IX_EXT, CHLIFI, JP)
- JP = NESLAT
- ENDIF
- NLIFI = JP - 1
-
- MODEFI = 6
- IF (JD_MOD.NE.0) MODEFI= 7
-
- CALL FLINK (JD_LUN, MODEFI, 0, 0)
- IF (IXFLUN.LT.0) CALL P_FATAL ('OPEN failure')
- IF (LUNOLD.EQ.0) JD_MOD = 0
- JD_LUN = LUNFD
- IF (JD_MOD.EQ.0) RETURN
-
-C------ Initiate processing for MODIFY ---------------
-
- MO_JSA = LQLEND(3)
- MO_JSL = MO_JSA
- MO_JSE = LQLSTA(4)
-
- JTXA = MLIAD(MO_JSA)
- JTXE = MLIAD(MO_JSE)
- NMAX = JTXE - JTXA - 2048
- IF (LUNSIZ.GE.NMAX) GO TO 79
-
- CALL CIGET (JD_LUN, TEXT(JTXA), NMAX, NTXR, ISTAT)
- IF (ISTAT.NE.0) GO TO 79
-
- JTXE = JTXA + NTXR
- JSLE = MO_JSL
- LIMIT = MO_JSE - 4
-
- DO 54 JTX=JTXA,JTXE-1
- IF (ICHAR(TEXT(JTX)).EQ.NEWLN) THEN
- JSLE = JSLE + 1
- MLIAD(JSLE) = JTX + 1
- IF (JSLE.GE.LIMIT) GO TO 79
- ENDIF
- 54 CONTINUE
-
- IF (MLIAD(JSLE).NE.JTXE) THEN
- TEXT(JTXE) = CHAR(NEWLN)
- JTXE = JTXE + 1
- JSLE = JSLE + 1
- MLIAD(JSLE) = JTXE
- ENDIF
-
- MO_JSE = JSLE
- LQLEND(3) = JSLE
- RETURN
-
- 79 JD_MOD = 0
- RETURN
- END
diff --git a/src/p5boot/p5lib/dpexmo.f b/src/p5boot/p5lib/dpexmo.f
deleted file mode 100644
index fbf1bb6..0000000
--- a/src/p5boot/p5lib/dpexmo.f
+++ /dev/null
@@ -1,62 +0,0 @@
-CDECK ID>, DPEXMO.
- SUBROUTINE DPEXMO (JSLP,NSLP)
-
-C- MODIFY: check new lines against disk file
-C- if NSL zero: check we have actually reached the EoF
-C. started 7-OCT-93
-
- PARAMETER (NSLIFI=128)
- CHARACTER CHLIFI*(NSLIFI), CHLIEX*8
- COMMON /FLINKC/LUNOP,LUNFD,LUNOLD,LUNSIZ
- +, IXFLUN, NLIFI,CHLIFI,CHLIEX
- COMMON /DEPCOM/JD_NEW, JD_DTN, JD_DTP, JD_DTD, JD_DIV
- +, JD_SML, JD_SMP, JD_SMX, JDP_DT, JDP_DV
- +, JD_SPL, JD_MOD, JD_LUN, JD_LOG, JD_NLI, JD_MULT
- +, IX_EXT, IX_RH, IX_SUB
- COMMON /DEPMOD/MO_JSA, MO_JSL, MO_JSE
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
-C-------------- End CDE --------------------------------
-
-
- JSLX = JSLP
- NSLX = NSLP
- IF (NSLX.EQ.0) GO TO 41
- IF (MO_JSL+NSLX.GT.MO_JSE) GO TO 44
-
- JTX = MLIAD(JSLX)
- JMO = MLIAD(MO_JSL)
-
- NTX = MLIAD(JSLX+NSLX) - JTX
- NMO = MLIAD(MO_JSL+NSLX) - JMO
- IF (NMO.NE.NTX) GO TO 44
-
- IF (ICEQU(TEXT(JTX),TEXT(JMO),NTX).NE.0) GO TO 44
- MO_JSL = MO_JSL + NSLX
- RETURN
-
-C-- Check Eof reached
-
- 41 IF (MO_JSL.EQ.MO_JSE) RETURN
-
-C-- Comparison failure, re-write the material up to now
-
- 44 JD_MOD = 0
- CALL CICLOS (JD_LUN)
- CALL CIOPEN (JD_LUN, 'w', CHLIFI(1:NLIFI), ISTAT)
- IF (ISTAT.NE.0) CALL P_FATAM ('CIO open for re-write fails')
-
- JMO = MLIAD(MO_JSA)
- NMO = MLIAD(MO_JSL) - JMO
- IF (NMO.EQ.0) RETURN
-
- CALL CIPUT (JD_LUN,TEXT(JMO),NMO,ISTAT)
- IF (ISTAT.NE.0) CALL P_FATAM ('CIO write fails')
- RETURN
- END
diff --git a/src/p5boot/p5lib/dpextm.f b/src/p5boot/p5lib/dpextm.f
deleted file mode 100644
index 6e6f2e5..0000000
--- a/src/p5boot/p5lib/dpextm.f
+++ /dev/null
@@ -1,170 +0,0 @@
-CDECK ID>, DPEXTM.
- SUBROUTINE DPEXTM (JTERM)
-
-C- End of deck or routine
-C- JTERM = +1 end of deck
-C- -1 about to start a new routine in the same deck
-C. started 6-oct-93
-
- CHARACTER SLLINE*512, SLERRM*256
- COMMON /SLATLN/ SLLINE, SLERRM
- COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT,NUSLAT(2),DUMMY(34)
- PARAMETER (KM1=1,KM2=2,KM3=4,KM4=8,KM5=16,KM6=32,KM7=64,KM8=128,
- + KM9=256, KM10=512, KM11=1024, KM12=2048, KM13=4096, KM14=8192,
- + KM15=16384, KM16=32768, KM17=65536, KM18=131072, KM19=262144)
- PARAMETER (NBANKS=19,JBKPAT=1, JBKDEC=2, JBKORG=3, JBKINC=4,
- + JBKHOL=5, JBKKEE=6, JBKACT=7, JBKMAT=8, JBKXSQ=9,
- + JBKPRE=10,JBKGAR=11,JBKSMH=12,JBKSMT=13,JBKSML=14,
- + JBKSMX=15,JBKARR=16,JBKASA=17,JBKPAM=18,JBKRPA=19)
- COMMON /QBANKS/MMBANK(5,NBANKS)
- COMMON /QPAGE/ NQLMAX,NQLTOL,NQLTOK,NQCMAX,NQCPGH,NQPAGE
- +, NQWYLDO,NQWYL,NQNEWH,NQJOIN,NQDKNO,NQDKPG
- COMMON /QUNIT/ IQREAD,IQPRNT, IQTTIN,IQTYPE, IQOFFL,IQRTTY,IQRSAV
- +, IQRFD,IQRRD,IQRSIZ, NQLPAT,NQUSED,NQLLBL, NQINIT
- CHARACTER CHEXPD*68
- COMMON /CHEXC/ IXEXPAM, IXEXPAT,IXEXDEC,IXEXID, NCHEPD, CHEXPD
- PARAMETER (JFO_TYP=1, JCC_TYP=2, JAS_TYP=3, JDA_TYP=4,
- + JSH_TYP=5, JCR_TYP=6, JIN_TYP=7, MAX_TYP=100)
- CHARACTER*16 CH_TYP(MAX_TYP), ACT_TYP
- COMMON /CM_TYP/ LUN_TYP, N_TYP, NAL_TYP, NDV_TYP, JBK_TYP
- +, JU_TYP(MAX_TYP), CH_TYP, ACT_TYP
- COMMON /DEPCOM/JD_NEW, JD_DTN, JD_DTP, JD_DTD, JD_DIV
- +, JD_SML, JD_SMP, JD_SMX, JDP_DT, JDP_DV
- +, JD_SPL, JD_MOD, JD_LUN, JD_LOG, JD_NLI, JD_MULT
- +, IX_EXT, IX_RH, IX_SUB
- PARAMETER (NSLIFI=128)
- CHARACTER CHLIFI*(NSLIFI), CHLIEX*8
- COMMON /FLINKC/LUNOP,LUNFD,LUNOLD,LUNSIZ
- +, IXFLUN, NLIFI,CHLIFI,CHLIEX
- COMMON /INCLC/ N_INCL, IX_INCL(100)
- COMMON /MUSEBC/ MX_FORC, MU_GLOB, MU_PAT, MU_DECK, MU_INH, MU_FORG
- +, MX_TRAN, MX_FORG, MX_SINH, MX_SELF, NVEXDK(6)
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
-C-------------- End CDE --------------------------------
- EQUIVALENCE (LASML,JD_SML), (LASMP,JD_SMP), (LXASM,JD_SMX)
- CHARACTER LINE*128
- EQUIVALENCE (LINE,SLLINE)
-
- IOR (IZV,IZW) = OR (IZV, IZW)
-
-
- IF (JD_SPL.LT.2) GO TO 41
-
-C------ SPLIT or MODIFY mode: close split file
-C-- if MODIFY: check EoF reached
- IF (JD_MOD.NE.0) CALL DPEXMO (0,0)
-
-C-- register the name of the include file
- IF (JD_DTD.EQ.JIN_TYP) THEN
- CALL MQLIFT (L, LQINCL,1, JBKINC,3)
- IQ(L) = IOR (IQ(L), MX_SELF)
- IQ(L+1) = IXEXID
- IF (JD_MOD.EQ.0) IQ(L)= IOR (IQ(L),KM5)
- ENDIF
-
- CALL CICLOS (JD_LUN)
-C-- Write the entry into the log file
-
- IF (JD_LOG.LE.0) GO TO 37
- LINE = ' '
- CALL STRMID (JD_DTD, JD_DIV, LINE,2)
- N = MAX(NESLAT,12) + 1
-
- CALL NA_GET (IXEXID, LINE,N)
- N = NESLAT
-
- IF (IX_EXT.NE.0) THEN
- CALL NA_GET (IX_EXT, LINE,N)
- N = NESLAT
- ENDIF
-
-C-- add the names of the called include files
-
- IF (JD_MOD.EQ.0) GO TO 33
- LINE(N+3:N+6) = 'same'
- N = N + 6
-
- 33 JTK = 0
- IF (N_INCL.EQ.0) GO TO 36
- 34 JTK = JTK + 1
- CALL NA_GET (IX_INCL(JTK),LINE,N+2)
- N = NESLAT + 1
- LINE(N-1:N) = '.h'
- IF (JTK.EQ.N_INCL) GO TO 36
- IF (N.LT.72) GO TO 34
- N = N + 2
- LINE(N:N) = '+'
-
- 36 CALL CUTOL (LINE(1:N))
- N = N + 1
- LINE(N:N) = CHAR(NEWLN)
- CALL CIPUT (JD_LOG, LINE,N, ISTAT)
- IF (ISTAT.NE.0) CALL P_FATAM ('CIO write fails')
- IF (JTK.LT.N_INCL) THEN
- LINE = ' '
- N = 10
- GO TO 34
- ENDIF
-
- 37 IF (JD_MOD.NE.0) GO TO 79
-
-C------ Accounting
-
- 41 IQ(LXASM+4) = IQ(LXASM+4) + JD_NLI
- IQ(LASML+10) = IQ(LASML+10) + JD_NLI
-
- IQ(LXASM+3) = IQ(LXASM+3) + 1
- IF (JD_MULT.EQ.0) THEN
- IQ(LASML+9) = IQ(LASML+9) + 1
- ENDIF
-
-C-- Print the log line for option MAPASM
-
- IF (MOPTIO(13).EQ.0) GO TO 78
- LINE = ' Written'
- CALL CSETDI (NQDKNO, LINE,10,17)
- LINE(19:20) = 'p='
- CALL NA_GET (IXEXPAT,LINE,21)
- JP = MAX (NESLAT,29)
- LINE(JP+1:JP+2) = 'd='
- CALL NA_GET (IXEXDEC,LINE,JP+3)
- JP = MAX (NESLAT,44)
- CALL CSETDI (JD_NLI, LINE,JP+1,JP+5)
-
- LINE(JP+7:JP+14) = 'lines to'
- JP = JP + 15
- IF (JD_SPL.LT.2) THEN
- LINE(JP+1:JP+7) = 'logical'
- JP = JP + 9
- CALL STRMID (JD_DTD, JD_DIV, LINE,JP)
- N = NESLAT - 1
- ELSE
- LINE(JP+1:JP+4) = 'file'
- JP = JP + 5
- LINE(JP+1:JP+NLIFI) = CHLIFI(1:NLIFI)
- N = JP + NLIFI
- ENDIF
- WRITE (IQPRNT,9000) LINE(1:N)
- NQUSED = NQUSED + 1
- NQLLBL = 0
-
- 78 JD_MULT = JD_MULT + 1
- 79 JD_NLI = 0
- JD_NEW = JTERM
- RETURN
-
- 9000 FORMAT (A)
- END
diff --git a/src/p5boot/p5lib/dphead.f b/src/p5boot/p5lib/dphead.f
deleted file mode 100644
index 3664e3b..0000000
--- a/src/p5boot/p5lib/dphead.f
+++ /dev/null
@@ -1,68 +0,0 @@
-CDECK ID>, DPHEAD.
- SUBROUTINE DPHEAD
-
-C- LIST current deck/patch identifier if not yet done;
-C- if done but page almost full: page eject
-C. started 10-feb-92
-
- COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT,NUSLAT(2),DUMMY(34)
- COMMON /QPAGE/ NQLMAX,NQLTOL,NQLTOK,NQCMAX,NQCPGH,NQPAGE
- +, NQWYLDO,NQWYL,NQNEWH,NQJOIN,NQDKNO,NQDKPG
- COMMON /QUNIT/ IQREAD,IQPRNT, IQTTIN,IQTYPE, IQOFFL,IQRTTY,IQRSAV
- +, IQRFD,IQRRD,IQRSIZ, NQLPAT,NQUSED,NQLLBL, NQINIT
- CHARACTER CHEXPD*68
- COMMON /CHEXC/ IXEXPAM, IXEXPAT,IXEXDEC,IXEXID, NCHEPD, CHEXPD
- COMMON /MUSEBC/ MX_FORC, MU_GLOB, MU_PAT, MU_DECK, MU_INH, MU_FORG
- +, MX_TRAN, MX_FORG, MX_SINH, MX_SELF, NVEXDK(6)
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
-C-------------- End CDE --------------------------------
-
-
- IF (NQNEWH.NE.0) GO TO 21
- IF (NQUSED.GE.NQLTOK) GO TO 32
- RETURN
-
-C-- start ouput for new deck
-
- 21 NQDKPG = 0
-
- CHEXPD = 'p='
- CALL NA_GET (IXEXPAT,CHEXPD,3)
- IF (IXEXDEC.NE.0) THEN
- J = NESLAT + 3
- CHEXPD(J-2:J-1) = 'd='
- CALL NA_GET (IXEXDEC,CHEXPD,J)
- ENDIF
- NCHEPD = NESLAT - 1
-
- IF (NVEXDK(2).EQ.0) GO TO 24
- IF (MOPTIO(3).NE.0) GO TO 24
- IF (NQJOIN.NE.0) GO TO 24
- IF (NQUSED.LE.8) GO TO 32
-
-C-- first deck in a patch with a short blank deck?
-
- IF (NQLPAT.EQ.0) GO TO 31
- IF (IXEXDEC.EQ.0) GO TO 31
- IF (NQUSED-NQLPAT.GT.8) GO TO 31
-
- 24 IF (NQUSED.LT.NQLTOL) GO TO 32
-
- 31 NQUSED = NQLMAX
- 32 CALL DPPAGE
- NQNEWH = 0
- RETURN
- END
diff --git a/src/p5boot/p5lib/dplact.f b/src/p5boot/p5lib/dplact.f
deleted file mode 100644
index 84d88ac..0000000
--- a/src/p5boot/p5lib/dplact.f
+++ /dev/null
@@ -1,114 +0,0 @@
-CDECK ID>, DPLACT.
- SUBROUTINE DPLACT
-
-C- LIST what action at LUPAN
-C. started 10-feb-92
-
- CHARACTER SLLINE*512, SLERRM*256
- COMMON /SLATLN/ SLLINE, SLERRM
- PARAMETER (KM1=1,KM2=2,KM3=4,KM4=8,KM5=16,KM6=32,KM7=64,KM8=128,
- + KM9=256, KM10=512, KM11=1024, KM12=2048, KM13=4096, KM14=8192,
- + KM15=16384, KM16=32768, KM17=65536, KM18=131072, KM19=262144)
- CHARACTER CHTAG*80, CHWYL*16
- COMMON /TAGC/ LLORG,LNORG,LLACT,LNACT, LALTN,LMODE,NCHTAG
- +, CHTAG,CHWYL
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
- COMMON /MUSEBC/ MX_FORC, MU_GLOB, MU_PAT, MU_DECK, MU_INH, MU_FORG
- +, MX_TRAN, MX_FORG, MX_SINH, MX_SELF, NVEXDK(6)
- COMMON /M_ANAC/LOWAN,KDOAN,LDOAN,LUPAN,MODEAN,MEXAN,LEVAN,KKM5AN
- +, NEWDEC,NEWCTL,NEWFOR,NEWNIL,NEWINC
-C-------------- End CDE --------------------------------
- CHARACTER LINE*80, MARK*18, MSG*14
- EQUIVALENCE (LINE,SLLINE), (MSG,SLERRM)
- EQUIVALENCE (MARK,SLLINE(63:))
-
- IAND (IZV,IZW) = AND (IZV, IZW)
-
-C-- Print clash warning
-
- LEVCL = JBYT (IQ(LUPAN),14,2)
- IF (LEVCL.EQ.0) GO TO 31
- IF (LEVCL.LT.NCLASH) GO TO 31
-
- MSG = 'Clash level 2:'
-C- _:.=+=.: 1_:.=
-
- IF (LEVCL.EQ.1) THEN
- MSG(13:13) = '1'
- JSEV = -1
- ELSE
- JSEV = 0
- ENDIF
-
- CALL FAILMSG (JSEV,4, 20,MSG)
- GO TO 32
-
-C-- Ready the origin tag
-
- 31 IF (NVEXDK(2).EQ.0) RETURN
- CALL DPHEAD
- 32 NCHTAG = 0
- LNACT = LUPAN
- LNORG = LQ(LUPAN-3)
- CALL DPTAG (1,0,0)
-
- IFLNLO = IAND (IQ(LOWAN),KM5+KM6)
- JTYPE = JBYT (IQ(LUPAN),9,3)
- LINUM = IQ(LUPAN+3)
-
- LINE = ' '
-
- IF (IFLNLO.NE.0) THEN
- IF (IAND(IQ(LUPAN),KM12).NE.0) THEN
- LINE(1:6) = '<nil: '
- ELSE
- LINE(1:6) = '<skip:'
- ENDIF
- ELSE
- LINE(1:4) = '<do:'
- ENDIF
-
- JVAL1 = IQ(LUPAN+4)
- JVAL2 = IQ(LUPAN+5)
- IF (JTYPE.EQ.0) THEN
- MARK(1:4) = 'DEL,'
- ELSEIF (JTYPE.EQ.1) THEN
- MARK(1:4) = 'REP,'
- ELSEIF (JTYPE.EQ.2) THEN
- MARK(1:4) = 'ADB,'
- ELSE
- MARK(1:4) = 'ADD,'
- JVAL1 = JVAL2
- ENDIF
-
- MARK(6:7) = 'C='
- CALL CSETDI (JVAL1,MARK,8,12)
- IF (JVAL2.NE.JVAL1) THEN
- MARK(13:13) = '-'
- CALL CSETDI (JVAL2,MARK,14,18)
- ENDIF
- CALL CLEFT (MARK,8,18)
-
-C-- Print the acting control line
-
- JSL = IQ(LUPAN+1)
- JTX = MLIAD(JSL)
- NTX = MLIAD(JSL+1) - JTX - NCHNEWL
- NTX = MIN (NTX,74)
-
- CALL DPLINE (LINUM, ' ', LEN(LINE), LINE)
- RETURN
- END
diff --git a/src/p5boot/p5lib/dpline.f b/src/p5boot/p5lib/dpline.f
deleted file mode 100644
index 2a85721..0000000
--- a/src/p5boot/p5lib/dpline.f
+++ /dev/null
@@ -1,149 +0,0 @@
-CDECK ID>, DPLINE.
- SUBROUTINE DPLINE (LINUM,MASK,NCHL,LINE)
-
-C- Print one line for LIST
-C- LINUM is the line-number, not printed if -ve,
-C- MASK is the line-type identifier
-C- LINE of length NCHL is the text, void if NCHL <= 0
-C. started 5-aug-93
-
- CHARACTER CQBLAN*128, CQEQS*128, CQCETA*32
- CHARACTER CQAPO*1, CQBSL*1, CQTAB*1
- COMMON /QCHAR/ CQBLAN, CQEQS, CQCETA, CQAPO, CQBSL, CQTAB
- COMMON /QPAGE/ NQLMAX,NQLTOL,NQLTOK,NQCMAX,NQCPGH,NQPAGE
- +, NQWYLDO,NQWYL,NQNEWH,NQJOIN,NQDKNO,NQDKPG
- COMMON /QUNIT/ IQREAD,IQPRNT, IQTTIN,IQTYPE, IQOFFL,IQRTTY,IQRSAV
- +, IQRFD,IQRRD,IQRSIZ, NQLPAT,NQUSED,NQLLBL, NQINIT
- CHARACTER CHTAG*80, CHWYL*16
- COMMON /TAGC/ LLORG,LNORG,LLACT,LNACT, LALTN,LMODE,NCHTAG
- +, CHTAG,CHWYL
-C-------------- End CDE --------------------------------
- CHARACTER CHNUM*6, MASK*4, LINE*512
-
-
- IF (NQUSED.GE.NQLMAX) CALL DPPAGE
- IF (NQWYLDO.NE.0) GO TO 41
-
-C------ Without Wylbur line-numbers
-
- IF (NCHTAG.NE.0) THEN
- IF (92+NCHTAG.GE.NQCMAX) GO TO 31
- ENDIF
- 21 NQUSED = NQUSED + 1
- NQLLBL = 0
-
-C- _:.=+=
- CHNUM = ' '
- IF (LINUM.GE.0) CALL CSETDI (LINUM,CHNUM,2,6)
-
-C-- LINE is void
-
- IF (NCHL .GT.0) GO TO 25
- IF (NCHTAG.EQ.0) THEN
- WRITE (IQPRNT,9021) CHNUM,MASK
- ELSE
- WRITE (IQPRNT,9022) CHNUM,MASK,CHTAG(1:NCHTAG)
- NCHTAG = 0
- ENDIF
- RETURN
-
-C-- LINE is present
-
- 25 JE = NCHL
- IF (JE.GT.80) JE= ICFILA(' ', LINE,60,80) - 1
- IF (NCHTAG.EQ.0) THEN
- WRITE (IQPRNT,9025) CHNUM,MASK,LINE(1:JE)
- ELSE
- WRITE (IQPRNT,9026) CHNUM,MASK,LINE(1:JE),CHTAG(1:NCHTAG)
- NCHTAG = 0
- ENDIF
- IF (JE.EQ.NCHL) RETURN
-
-C-- LINE is longer than 80 characters
-
- 28 JA = JE + 1
- JE = NCHL
- IF (JE-JA.GE.72) JE= ICFILA(' ', LINE,JA+51,JA+71) - 1
- WRITE (IQPRNT,9028) LINE(JA:JE)
- NQUSED = NQUSED + 1
- IF (JE.LT.NCHL) GO TO 28
- RETURN
-
-C-- Print the tag stand-alone, if too long
-
- 31 IF (NQUSED.GE.NQLTOK) CALL DPPAGE
- NBL = NQCMAX - NCHTAG
- WRITE (IQPRNT,9025) CQBLAN(1:NBL), CHTAG(1:NCHTAG)
- NQUSED = NQUSED + 1
- NCHTAG = 0
- IF (NQWYLDO.EQ.0) GO TO 21
-
-C------ With Wylbur line-numbers
-
- 41 IF (NCHTAG.NE.0) THEN
- IF (102+NCHTAG.GE.NQCMAX) GO TO 31
- ENDIF
- NQUSED = NQUSED + 1
- NQLLBL = 0
-
- IF (NQWYLDO.LT.0) THEN
- IF (NQWYLDO.LT.-2) GO TO 43
- IF (NQWYLDO.EQ.-2) CHWYL = ' '
- NQWYLDO = NQWYLDO - 1
- GO TO 43
- ENDIF
-
- IF (LINUM.LT.0) THEN
- CHWYL = ' '
- GO TO 43
- ENDIF
-
-C- _:.=+=.: 1_:.=+=.: 2
-C- 123456. 12345
- CHWYL = ' . '
- NQWYL = NQWYL + 1
- CALL CSETDI (NQWYL,CHWYL,2,9)
- CALL CSETDI (LINUM,CHWYL,11,16)
-
-C-- LINE is void
-
- 43 IF (NCHL .GT.0) GO TO 45
- IF (NCHTAG.EQ.0) THEN
- WRITE (IQPRNT,9021) CHWYL,MASK
- ELSE
- WRITE (IQPRNT,9023) CHWYL,MASK,CHTAG(1:NCHTAG)
- NCHTAG = 0
- ENDIF
- RETURN
-
-C-- LINE is present
-
- 45 JE = NCHL
- IF (JE.GT.80) JE= ICFILA(' ', LINE,60,80) - 1
- IF (NCHTAG.EQ.0) THEN
- WRITE (IQPRNT,9025) CHWYL,MASK,LINE(1:JE)
- ELSE
- WRITE (IQPRNT,9027) CHWYL,MASK,LINE(1:JE),CHTAG(1:NCHTAG)
- NCHTAG = 0
- ENDIF
- IF (JE.EQ.NCHL) RETURN
-
-C-- LINE is longer than 80 characters
-
- 48 JA = JE + 1
- JE = NCHL
- IF (JE-JA.GE.72) JE= ICFILA(' ', LINE,JA+51,JA+71) - 1
- WRITE (IQPRNT,9029) LINE(JA:JE)
- NQUSED = NQUSED + 1
- IF (JE.LT.NCHL) GO TO 48
- RETURN
-
- 9021 FORMAT (A,A)
- 9022 FORMAT (A,A,T92,A)
- 9023 FORMAT (A,A,T102,A)
- 9025 FORMAT (A,A,A)
- 9026 FORMAT (A,A,A,T92,A)
- 9027 FORMAT (A,A,A,T102,A)
- 9028 FORMAT (17X,'>',A)
- 9029 FORMAT (27X,'>',A)
- END
diff --git a/src/p5boot/p5lib/dplist.f b/src/p5boot/p5lib/dplist.f
deleted file mode 100644
index 0fe98a3..0000000
--- a/src/p5boot/p5lib/dplist.f
+++ /dev/null
@@ -1,199 +0,0 @@
-CDECK ID>, DPLIST.
- SUBROUTINE DPLIST (MODE,LDO,LACT,IFLSTA)
-
-C- LIST output of next lot for DOXQT
-C- MODE = 0 self material
-C- 1 CDE expansion called from X_SEQ
-C- 2 comment line
-C- 3 +SELF header line
-C- 4 +CDE call line
-C- 5 foreign material to be stored
-C- 6 control line
-C- LDO bank holding the lines to be listed
-C- LACT if = zero: material of this deck
-C- if /=zero: ACT bank driving the material into this deck
-C- IFLSTA if = zero: material group continued
-C- if > zero: start of a material group
-C- = 1: basic level, > 1: higher levels
-C- (used only for MODEAN = 1 and 5)
-C- also: JCCTYP in /CCPARA/ is the type of the first line in LDO
-C. started 21-jan-92
-
- PARAMETER (KM1=1,KM2=2,KM3=4,KM4=8,KM5=16,KM6=32,KM7=64,KM8=128,
- + KM9=256, KM10=512, KM11=1024, KM12=2048, KM13=4096, KM14=8192,
- + KM15=16384, KM16=32768, KM17=65536, KM18=131072, KM19=262144)
- COMMON /QPAGE/ NQLMAX,NQLTOL,NQLTOK,NQCMAX,NQCPGH,NQPAGE
- +, NQWYLDO,NQWYL,NQNEWH,NQJOIN,NQDKNO,NQDKPG
- COMMON /QUNIT/ IQREAD,IQPRNT, IQTTIN,IQTYPE, IQOFFL,IQRTTY,IQRSAV
- +, IQRFD,IQRRD,IQRSIZ, NQLPAT,NQUSED,NQLLBL, NQINIT
- PARAMETER (MCCNIL=1, MCCKIL=2, MCCINC=3, MCCCDE=4, MCCSEQ=5,
- + MCCXSQ=6, MCCTRU=7, MCCFAL=8, MCCELS=9, MCCEND=10,
- + MCCSEL=11, MCCSES=12, MCCFAU=13, MCCSKI=14,
- + MCCKEE=15, MCCDEL=16, MCCREP=17, MCCADB=18, MCCADD=19,
- + MCCUSE=20, MCCXDI=21, MCCDIV=22, MCCLIS=23, MCCEXE=24, MCCIMI=25,
- + MCCASM=26, MCCUPD=27, MCCNAM=28, MCCGAP=29, MCCMOR=30, MCCONL=31,
- + MCCFOR=32, MCCSUS=33, MCCOPT=34, MCCOP2=35, MCCSHO=36, MCCPAM=37,
- + MCCQUI=38, MCCEOD=39, MCCDEC=40, MCCPAT=41, MCCTIT=42)
- CHARACTER CCKORG*256, CCKARD*256, CCCOMF*256
- COMMON /CCPARA/NCHCCD,NCHCCT, JCCTYP,JCCLEV,JCCSL,MCCPAR(240)
- +, NCCPAR,MXCCIF,JCCIFV,JCCBAD,JCCWAR,ICCSUB,JCCWK(4)
- +, JCCPP,JCCPD,JCCPZ,JCCPT,JCCPIF,JCCPC,JCCPN
- +, NCCPP,NCCPD,NCCPZ,NCCPT,NCCPIF,NCCPC,NCCPN
- +, JCCEND, NCHCCC,IXCCC, CCKORG, CCKARD, CCCOMF
- COMMON /MUSEBC/ MX_FORC, MU_GLOB, MU_PAT, MU_DECK, MU_INH, MU_FORG
- +, MX_TRAN, MX_FORG, MX_SINH, MX_SELF, NVEXDK(6)
- CHARACTER CHTAG*80, CHWYL*16
- COMMON /TAGC/ LLORG,LNORG,LLACT,LNACT, LALTN,LMODE,NCHTAG
- +, CHTAG,CHWYL
- COMMON /MQCM/ NQSYSS,NQLINK, LQCSTA(3),LQCEND(3), NQMAX
- +, LQLSTA(5),LQLEND(5), LQADR,LQADR0,NQOFFS
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
-C-------------- End CDE --------------------------------
- CHARACTER MASKF*4, MASKL*4, MASKK(4)*4
- DATA MASKK / ' z ', ' .z ', ' y ', ' .y ' /
-
- IAND (IZV,IZW) = AND (IZV, IZW)
-
-
- IF (NQNEWH.NE.0) CALL DPHEAD
- IFLBL = 0
- IFLAFT = 0
- JSL = IQ(LDO+1)
- NSL = IQ(LDO+2)
- IF (NSL.LE.0) RETURN
- IF (MODE.EQ.1) GO TO 54
-
- IFLDEL = IAND (IQ(LDO),KM5+KM6)
- IFLCUT = IFLDEL
-
- LNACT = LACT
- IF (LNACT.EQ.0) GO TO 38
- LNORG = IQ(LDO-2)
- LINUM = IQ(LDO+3)
- LEVEL = JBYT (IQ(LDO),21,5)
- CALL DPTAG (0,LEVEL,0)
- GO TO 39
-
- 38 LLACT = 0
- LLORG = 0
- IF (JSL.LT.LQLEND(2)) THEN
- LINUM = JSL - JSLORG
- ELSE
- LINUM = -9999
- ENDIF
- 39 JUMP = MODE + 1
- GO TO (44, 54, 61, 41, 51, 71, 80), JUMP
-C- mode= 0 1 2 3 4 5 6
-
- CALL P_CRASH (' DPLIST - invalid MODE')
-C---- Self material
-
- 41 IFLBL = 1
- MASKF = ' + '
- MASKL = ' - '
- IF (JCCTYP.NE.MCCFAU) GO TO 81
- MASKF= '!!!!'
- IFLCUT = 7
- GO TO 81
-
- 44 MASKL = ' - '
- IF (JCCTYP.EQ.0) GO TO 84
- MASKF = ' -- '
- IF (JCCTYP.EQ.MCCEND) THEN
- IFLAFT = IAND (IQ(LDO),KM17)
- ELSE
- IFLBL = IAND (IQ(LDO),KM17)
- ENDIF
- GO TO 81
-
-C---- CDE expansion
-
- 51 MASKF = ' : '
- GO TO 81
-
- 54 IFLDEL = 0
- IFLCUT = 0
- LINUM = -9999
- MASKL = ' '
- IF (IFLSTA.EQ.0) GO TO 84
- J = MIN (IFLSTA,2)
- IF (IFALTN.NE.0) J= J+2
- MASKF = MASKK(J)
- GO TO 81
-
-C---- Comment
-
- 61 MASKF = ' c '
- GO TO 81
-
-C---- Foreign material out from this deck
-
- 71 MASKL = ' > '
- IF (IFLSTA.EQ.0) GO TO 84
-
- IFLBL = 1
- IF (JCCTYP.EQ.MCCKEE) GO TO 80
-
- IF (IAND(IQ(LDO),KM18).NE.0) GO TO 80
- MASKF = ' ++ '
- GO TO 81
-
-C---- Stand-alone control line
-
- 80 MASKF = ' + '
- IF (JCCTYP.GE.MCCDEC) IFLBL= 1
-
-C---- list the control-line first
-
- 81 IF (NVEXDK(6).EQ.0) GO TO 82
- IF (LNACT.NE.0) MASKF(1:1) = '<'
- IF (IFLDEL.NE.0) MASKF(3:3) = '('
- IF (IFLBL.NE.0) THEN
- IF (NQUSED.GE.NQLTOK) THEN
- CALL DPPAGE
- ELSE
- CALL DPBLAN (1)
- ENDIF
- ENDIF
-
- JTX = MLIAD(JSL)
- NTX = MLIAD(JSL+1) - JTX - NCHNEWL
- CALL DPLINE (LINUM, MASKF, NTX, TEXT(JTX))
-
-C-- print line with env. variable substituition
-
- IF (ICCSUB.NE.0) CALL DPLINE (-1, ' ', NCHCCT, CCKORG)
- ICCSUB = 0
-
- IF (IFLAFT.NE.0) CALL DPBLAN (-1)
- 82 JSL = JSL + 1
- IF (IFLCUT.NE.0) RETURN
- NSL = NSL - 1
- IF (NSL.LE.0) RETURN
- LINUM = LINUM + 1
-
-C---- list the body of the lines
-
- 84 IF (LNACT.NE.0) MASKL(1:1) = '<'
- IF (IFLDEL.NE.0) MASKL(2:2) = '('
- DO 87 JJ=1,NSL
- JTX = MLIAD(JSL)
- NTX = MLIAD(JSL+1) - JTX - NCHNEWL
- CALL DPLINE (LINUM, MASKL, NTX, TEXT(JTX))
- LINUM = LINUM + 1
- 87 JSL = JSL + 1
- RETURN
- END
diff --git a/src/p5boot/p5lib/dplmsg.f b/src/p5boot/p5lib/dplmsg.f
deleted file mode 100644
index 3ded3f8..0000000
--- a/src/p5boot/p5lib/dplmsg.f
+++ /dev/null
@@ -1,40 +0,0 @@
-CDECK ID>, DPLMSG.
- SUBROUTINE DPLMSG (MSG,NCHL,LINE)
-
-C- Print one line in trouble with a message
-C- LINE of length NCHL is the text, void if NCHL <= 0
-C. started 25-nov-93
-
- COMMON /QUNIT/ IQREAD,IQPRNT, IQTTIN,IQTYPE, IQOFFL,IQRTTY,IQRSAV
- +, IQRFD,IQRRD,IQRSIZ, NQLPAT,NQUSED,NQLLBL, NQINIT
-C-------------- End CDE --------------------------------
- CHARACTER MSG*(*), LINE*512
-
-
- CALL DPBLAN (1)
- NQUSED = NQUSED + 1
-
-C-- LINE is void
-
- IF (NCHL.LE.0) THEN
- WRITE (IQPRNT,9024) MSG
- IF (NCHL.LT.0) GO TO 27
- RETURN
- ENDIF
-
-C-- LINE is present
-
- NCH = MIN (NCHL,80)
- WRITE (IQPRNT,9024) MSG,LINE(1:NCH)
-
- IF (NCHL.LE.80) RETURN
-
-C-- LINE is longer than 80 characters
-
- 27 WRITE (IQPRNT,9027) NCHL
- NQUSED = NQUSED + 1
- RETURN
-
- 9024 FORMAT (1X,A,1X,A)
- 9027 FORMAT (7X,'**!! line length is ',I7,' chars')
- END
diff --git a/src/p5boot/p5lib/dplmsq.f b/src/p5boot/p5lib/dplmsq.f
deleted file mode 100644
index 7888455..0000000
--- a/src/p5boot/p5lib/dplmsq.f
+++ /dev/null
@@ -1,28 +0,0 @@
-CDECK ID>, DPLMSQ.
- SUBROUTINE DPLMSQ (IXSEQ)
-
-C- LIST "missing sequence" warning for seq. IXSEQ
-C. started 10-feb-92
-
- CHARACTER SLLINE*512, SLERRM*256
- COMMON /SLATLN/ SLLINE, SLERRM
- COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT,NUSLAT(2),DUMMY(34)
- COMMON /MUSEBC/ MX_FORC, MU_GLOB, MU_PAT, MU_DECK, MU_INH, MU_FORG
- +, MX_TRAN, MX_FORG, MX_SINH, MX_SELF, NVEXDK(6)
-C-------------- End CDE --------------------------------
- CHARACTER MSG*56
- EQUIVALENCE (MSG,SLERRM)
-
-
- MSG = 'Missing sequence Z='
-C- _:.=+=.: 1_:.=+=.: 2
- CALL NA_GET (IXSEQ,MSG,20)
- N = NESLAT - 1
-
- JSEV = 0
- NSP = 1
- IF (NVEXDK(2).NE.0) NSP= -1
-
- CALL FAILMSG (JSEV,NSP, 0,MSG(1:N))
- RETURN
- END
diff --git a/src/p5boot/p5lib/dppage.f b/src/p5boot/p5lib/dppage.f
deleted file mode 100644
index 595a086..0000000
--- a/src/p5boot/p5lib/dppage.f
+++ /dev/null
@@ -1,96 +0,0 @@
-CDECK ID>, DPPAGE.
- SUBROUTINE DPPAGE
-
-C- LIST current deck/patch identifier, with or without page eject
-C. started 10-sep-93
-
- COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT,NUSLAT(2),DUMMY(34)
- CHARACTER SLLINE*512, SLERRM*256
- COMMON /SLATLN/ SLLINE, SLERRM
- CHARACTER CQBLAN*128, CQEQS*128, CQCETA*32
- CHARACTER CQAPO*1, CQBSL*1, CQTAB*1
- COMMON /QCHAR/ CQBLAN, CQEQS, CQCETA, CQAPO, CQBSL, CQTAB
- COMMON /QPAGE/ NQLMAX,NQLTOL,NQLTOK,NQCMAX,NQCPGH,NQPAGE
- +, NQWYLDO,NQWYL,NQNEWH,NQJOIN,NQDKNO,NQDKPG
- COMMON /QUNIT/ IQREAD,IQPRNT, IQTTIN,IQTYPE, IQOFFL,IQRTTY,IQRSAV
- +, IQRFD,IQRRD,IQRSIZ, NQLPAT,NQUSED,NQLLBL, NQINIT
- CHARACTER CHEXPD*68
- COMMON /CHEXC/ IXEXPAM, IXEXPAT,IXEXDEC,IXEXID, NCHEPD, CHEXPD
-C-------------- End CDE --------------------------------
- CHARACTER TAIL*13
- EQUIVALENCE (TAIL, SLLINE(161:))
-
-
- NQJOIN = 0
- NQLPAT = 0
- IF (NQUSED.GT.NQLMAX) THEN
- NQUSED = NQUSED - NQLMAX
- RETURN
- ENDIF
-
- IF (NQUSED.LT.NQLTOL) THEN
- NEWPAG = 0
- ELSE
- NEWPAG = 1
- ENDIF
-
- NCOL = NQCPGH
- SLLINE(1:176) = ' '
-
-C-- construct left edge: 167 PATCHY
-
- CALL CSETDI (NQDKNO, SLLINE, 2,6)
- CALL CLEFT (SLLINE, 3,6)
- J = NESLAT + 1
- IF (IXEXPAM.NE.0) THEN
- CALL NA_GET (IXEXPAM, SLLINE(1:J+7), J)
- JEQ = NESLAT + 2
- ELSE
- SLLINE(J:J+5) ='cradle'
- JEQ = J + 8
- ENDIF
-
-C-- prepare right edge: P=pname dname 1 === pg 123
-C- _:.=+=.: 1_:.
- NQDKPG = NQDKPG + 1
- CALL CSETDI (NQDKPG, TAIL, 1,2)
-
- JID = NCOL - 13 - NCHEPD
- SLLINE(JID:JID+NCHEPD-1) = CHEXPD(1:NCHEPD)
-
- IF (NQNEWH.EQ.0) GO TO 27
-
-C-- starting a new deck
-
- NEQ = JID - JEQ - 2
- IF (NEQ.GT.0) SLLINE(JEQ:JEQ+NEQ-1)= CQEQS(1:NEQ)
-
- IF (NEWPAG.EQ.0) THEN
- TAIL(4:13)= CQEQS(1:10)
- ELSE
- TAIL(4:6)= CQEQS(1:3)
- ENDIF
-
-C-- page eject?
-
- 27 IF (NEWPAG.EQ.0) GO TO 31
- SLLINE(1:1) = '1'
- NQPAGE = NQPAGE + 1
-
- CALL CSETDI (NQPAGE, TAIL,11,13)
- J = NFSLAT - 2
- TAIL(J:J+1) = 'pg'
- SLLINE(NCOL-12:NCOL) = TAIL
- WRITE (IQPRNT,9028) SLLINE(1:NCOL)
- NQUSED = 2
- NQLLBL = 1
- RETURN
-
- 31 CALL DPBLAN (0)
- SLLINE(NCOL-12:NCOL) = TAIL
- WRITE (IQPRNT,9028) SLLINE(1:NCOL)
- NQUSED = NQUSED + 2
- RETURN
-
- 9028 FORMAT (A/)
- END
diff --git a/src/p5boot/p5lib/dptag.f b/src/p5boot/p5lib/dptag.f
deleted file mode 100644
index 01ce496..0000000
--- a/src/p5boot/p5lib/dptag.f
+++ /dev/null
@@ -1,153 +0,0 @@
-CDECK ID>, DPTAG.
- SUBROUTINE DPTAG (MODE,LEVEL,IXKEEP)
-
-C- Construct the next tail
-C- MODE = zero: normal P/D tag
-C- 1: action line
-C- = 2: KEEP tag
-C-
-C- LEVEL = 0, 1, 2, 3 ... foreign-in-foreign level
-C-
-C- IXKEEP the name index of the sequence for MODE 2
-C- = 0 if material continued
-C. started 20-sept-93
-
- COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT,NUSLAT(2),DUMMY(34)
- PARAMETER (KM1=1,KM2=2,KM3=4,KM4=8,KM5=16,KM6=32,KM7=64,KM8=128,
- + KM9=256, KM10=512, KM11=1024, KM12=2048, KM13=4096, KM14=8192,
- + KM15=16384, KM16=32768, KM17=65536, KM18=131072, KM19=262144)
- CHARACTER CQBLAN*128, CQEQS*128, CQCETA*32
- CHARACTER CQAPO*1, CQBSL*1, CQTAB*1
- COMMON /QCHAR/ CQBLAN, CQEQS, CQCETA, CQAPO, CQBSL, CQTAB
- COMMON /QPAGE/ NQLMAX,NQLTOL,NQLTOK,NQCMAX,NQCPGH,NQPAGE
- +, NQWYLDO,NQWYL,NQNEWH,NQJOIN,NQDKNO,NQDKPG
- COMMON /QUNIT/ IQREAD,IQPRNT, IQTTIN,IQTYPE, IQOFFL,IQRTTY,IQRSAV
- +, IQRFD,IQRRD,IQRSIZ, NQLPAT,NQUSED,NQLLBL, NQINIT
- CHARACTER CHTAG*80, CHWYL*16
- COMMON /TAGC/ LLORG,LNORG,LLACT,LNACT, LALTN,LMODE,NCHTAG
- +, CHTAG,CHWYL
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
-C-------------- End CDE --------------------------------
- CHARACTER MASK*4, MASKK(5)*4
- DATA MASKK / ' x- ', ' z- ', ' .z-', ' y- ', ' .y-' /
-
- IAND (IZV,IZW) = AND (IZV, IZW)
-
-
- MODEX = MODE
- LEV = LEVEL
- IF (NCHTAG.LE.0) GO TO 29
- IF (LMODE.LT.0) GO TO 29
-
-C-- Print pending tag
-
- J = 1
- IF (LMODE.GE.2) THEN
- J = MIN (LMODE,3)
- IF (LALTN.NE.0) J= J+2
- ENDIF
- MASK = MASKK(J)
-
- NBL = NQCMAX - NCHTAG - 10
- NBL = MIN (NBL,81)
-
- CALL DPHEAD
- NQUSED = NQUSED + 1
- NQLLBL = 0
- WRITE (IQPRNT,9024) MASK,CQBLAN(1:NBL),CHTAG(1:NCHTAG)
- 9024 FORMAT (6X,A,A,A)
-
- NCHTAG = 0
- 29 NUMORG = IAND (IQ(LNORG), KM19-1)
- CHTAG(1:10) = ' '
- IF (MODEX.EQ.2) GO TO 61
-
-C-- Check same tag again
-
- IF (LNORG.EQ.0) GO TO 49
- IF (LNORG.NE.LLORG) GO TO 41
- IF (LNACT.NE.LLACT) GO TO 41
- IF (LMODE.GE.2) GO TO 41
- RETURN
-
-C-- Ready new tag
-
-C-- normal P/D tag
- 41 IF (MODEX.EQ.0) CALL CSETDI (LEV+1,CHTAG,1,1)
-
- CALL CSETDI (NUMORG, CHTAG,4,9)
- CALL CLEFT (CHTAG,4,9)
- JP = NESLAT
-
-C-- P/D tag
-
- IXPAT = IQ(LNORG+1)
- IXDECK = IQ(LNORG+2)
-
- IF (LEV.NE.0) THEN
- CHTAG(2:2) = 'x'
- GO TO 47
- ENDIF
-
- JTYPE = JBYT (IQ(LNACT),9,3)
- IF (JTYPE.EQ.0) THEN
- CHTAG(2:2) = 'D'
- ELSEIF (JTYPE.EQ.1) THEN
- CHTAG(2:2) = 'R'
- ELSEIF (JTYPE.EQ.2) THEN
- CHTAG(2:2) = 'B'
- ELSE
- CHTAG(2:2) = 'A'
- ENDIF
-
- 47 CHTAG(JP:JP) = '='
- JP = JP + 1
- CALL NA_GET (IXPAT,CHTAG,JP)
- JP = NESLAT
- CHTAG(JP:JP) = '.'
- JP = JP + 1
- CALL NA_GET (IXDECK,CHTAG,JP)
- NCHTAG = NESLAT - 1
- 49 LLORG = LNORG
- LLACT = LNACT
- LMODE = MODEX
- RETURN
-
-C-- KEEP tag
-
- 61 IF (LEV.NE.0) CALL CSETDI (LEV+1,CHTAG,1,1)
- CHTAG(2:2) = 'Z'
- IF (IXKEEP.EQ.0) THEN
- IF (LNORG.EQ.LLORG) THEN
- IF (MODEX+LEV.EQ.LMODE) GO TO 69
- ENDIF
- CHTAG(4:12) = 'continued'
- NCHTAG = 12
- GO TO 69
- ENDIF
-
- CALL CSETDI (NUMORG, CHTAG,4,9)
- CALL CLEFT (CHTAG,4,9)
- JP = NESLAT
- CHTAG(JP:JP) = ':'
- JP = JP + 1
- CALL NA_GET (IXKEEP,CHTAG,JP)
- NCHTAG = NESLAT - 1
- 69 LLORG = LNORG
- LMODE = MODEX + LEV
- LALTN = IFALTN
- RETURN
- END
diff --git a/src/p5boot/p5lib/dqbank.f b/src/p5boot/p5lib/dqbank.f
deleted file mode 100644
index c127605..0000000
--- a/src/p5boot/p5lib/dqbank.f
+++ /dev/null
@@ -1,204 +0,0 @@
-CDECK ID>, DQBANK.
- SUBROUTINE DQBANK
-
-C- Dump the bank whose parameters are in /MQCN/
-
- CHARACTER SLLINE*512, SLERRM*256
- COMMON /SLATLN/ SLLINE, SLERRM
- PARAMETER (KM1=1,KM2=2,KM3=4,KM4=8,KM5=16,KM6=32,KM7=64,KM8=128,
- + KM9=256, KM10=512, KM11=1024, KM12=2048, KM13=4096, KM14=8192,
- + KM15=16384, KM16=32768, KM17=65536, KM18=131072, KM19=262144)
- PARAMETER (NBANKS=19,JBKPAT=1, JBKDEC=2, JBKORG=3, JBKINC=4,
- + JBKHOL=5, JBKKEE=6, JBKACT=7, JBKMAT=8, JBKXSQ=9,
- + JBKPRE=10,JBKGAR=11,JBKSMH=12,JBKSMT=13,JBKSML=14,
- + JBKSMX=15,JBKARR=16,JBKASA=17,JBKPAM=18,JBKRPA=19)
- COMMON /QBANKS/MMBANK(5,NBANKS)
- COMMON /QUNIT/ IQREAD,IQPRNT, IQTTIN,IQTYPE, IQOFFL,IQRTTY,IQRSAV
- +, IQRFD,IQRRD,IQRSIZ, NQLPAT,NQUSED,NQLLBL, NQINIT
- COMMON /MQCM/ NQSYSS,NQLINK, LQCSTA(3),LQCEND(3), NQMAX
- +, LQLSTA(5),LQLEND(5), LQADR,LQADR0,NQOFFS
- PARAMETER (IQDROP=31, IQMARK=30, KMDROP=1073741824)
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- COMMON /MQCN/ IQLST,IQLNA,IQID,IQTY,IQLI,IQNL,IQNS,IQND
- +, IQLNX,IQFOUL
-C-------------- End CDE --------------------------------
- INTEGER INTID
- CHARACTER CHID*4, WK*2, CHK*1
- EQUIVALENCE (CHID,INTID)
-
- CHARACTER LINE*48, LINEZ*30, COLZ(30)*1, LINEWH*34
- EQUIVALENCE (LINE,SLLINE), (LINEZ,SLLINE(81:)), (COLZ,LINEZ)
- +, (LINEWH,SLLINE(161:))
-
- IAND (IZV,IZW) = AND (IZV, IZW)
-
-
- LNA = IQLNA
- LBK = IQLST
-
- INTID = MMBANK(1,IQTY)
-
- IF (IAND(IQ(LNA),KMDROP).NE.0) THEN
- CHK = '_'
- ELSE
- CHK = ' '
- ENDIF
-
- IF (IQNL.GT.0) THEN
- NLP = MIN (IQNL,6)
- CALL UCOPIV (LQ(LBK-NLP), IQUEST, NLP)
- WRITE (IQPRNT,9022) LBK,CHK,CHID,IQLI,IQNL,IQNS,IQND,
- + (IQUEST(J),J=1,NLP)
- ELSE
- WRITE (IQPRNT,9022) LBK,CHK,CHID,IQLI,IQNL,IQNS,IQND
- ENDIF
-
- 9022 FORMAT (/1X,I6,A,A,' LI/NL/NS/ND= ',I1,2I3,I5,:,
- F', links:',6I7)
-
-C-- Print the object identifier
-
- SLLINE = ' '
-
- IF (IQTY.EQ.JBKPAT) THEN
- WK = 'P='
- IX = IQ(LBK+2)
- ELSEIF (IQTY.EQ.JBKDEC) THEN
- WK = 'D='
- IX = IQ(LBK+1)
- ELSEIF (IQTY.EQ.JBKKEE) THEN
- WK = 'Z='
- IX = IQ(LBK+4)
- ELSE
- GO TO 30
- ENDIF
-
- LINEWH(1:2) = WK
- CALL NA_GET (IX, LINEWH, 3)
-
- N = LENOCC (LINEWH)
- WRITE (IQPRNT,9029) LINEWH(1:N)
- 9029 FORMAT (13X,A)
-
-C---- Dump status word
-
- 30 IF (IQTY.EQ.JBKPRE) GO TO 31
- IF (IQTY.EQ.JBKXSQ) GO TO 31
- IF (IQTY.EQ.JBKMAT) GO TO 31
- IF (IQTY.EQ.JBKKEE) GO TO 31
- IF (IQTY.NE.JBKACT) GO TO 61
-
- 31 MSTAT = IQ(LBK)
- CALL UPKBYT (MSTAT,1,IQUEST,30,0)
-
- DO 32 J=1,30
- IF (IQUEST(31-J).EQ.0) THEN
- LINEZ(J:J) = '.'
- ELSE
- LINEZ(J:J) = '1'
- ENDIF
- 32 CONTINUE
- IF (COLZ(27).NE.'.') COLZ(27) = 'X'
- IF (COLZ(28).NE.'.') COLZ(28) = 'D'
- IF (COLZ(29).NE.'.') COLZ(29) = 'L'
- IF (COLZ(30).NE.'.') COLZ(30) = 'E'
- IF (IQTY.EQ.JBKKEE) GO TO 33
-
- IF (COLZ(25).NE.'.') COLZ(25) = 'K'
- IF (COLZ(26).NE.'.') COLZ(26) = 'D'
- IF (IQTY.EQ.JBKACT) GO TO 34
-
-C-- PREP & XSQ & MAT
-
- LINE(3:8) = LINEZ(11:16)
-
- JC = JBYT(MSTAT,9,6)
- CALL CSETDI (JC,LINE,9,11)
- GO TO 36
-
-C-- KEEP & ACT
-
- 33 IF (COLZ(25).NE.'.') COLZ(25) = 'A'
- IF (COLZ(26).NE.'.') COLZ(26) = 'U'
- 34 LINE(1:9) = LINEZ(11:19)
-
- JC = JBYT(MSTAT,9,3)
- CALL CSETDI (JC,LINE,10,11)
-
- 36 LINE(13:14) = LINEZ(23:24)
- LINE(16:17) = LINEZ(25:26)
- LINE(19:22) = LINEZ(27:30)
-
- 37 WRITE (IQPRNT,9037) LINE(1:22)
- 9037 FORMAT (13X,'st: ',A)
-
-C---- Print line content
-
- 61 IF (IQLI.EQ.0) GO TO 77
-
- JSLA = IQ(LBK+1)
- NSL = IQ(LBK+2)
-
- WRITE (IQPRNT,9062) NSL,JSLA
- 9062 FORMAT (13X,'with',I6,' lines at JSLA',I7)
-
- IF (JSLA.EQ.0) GO TO 77
- IF (JSLA.EQ.1) GO TO 77
- IF (NSL.EQ.0) GO TO 77
- IF (JSLA.LT.0) GO TO 93
- IF (JSLA.GE.LQLSTA(5)) GO TO 93
-
-C-- print first line in lot
-
- JSLU = JSLA
- JTXA = MLIAD(JSLU)
- JTXE = MLIAD(JSLU+1)
- NTX = JTXE - JTXA - NCHNEWL
-
- IF (NTX.LT.0) GO TO 94
- IF (NTX.GE.513) GO TO 94
- N = MIN (NTX,60)
-
- CALL LN_GET (JSLU,SLLINE,N)
- WRITE (IQPRNT,9063) SLLINE(1:N)
-
- 9063 FORMAT (17X,'first: ',A)
- 9064 FORMAT (17X,' last: ',A)
-
-C-- print last line in lot
-
- IF (NSL.LE.1) GO TO 77
- JSLU = JSLA + NSL - 1
- JTXA = MLIAD(JSLU)
- JTXE = MLIAD(JSLU+1)
- NTX = JTXE - JTXA - NCHNEWL
-
- IF (NTX.LT.0) GO TO 94
- IF (NTX.GE.513) GO TO 94
- N = MIN (NTX,60)
-
- CALL LN_GET (JSLU,SLLINE,N)
- WRITE (IQPRNT,9064) SLLINE(1:N)
-
- 77 RETURN
-
-C---- trouble
-
- 93 WRITE (IQPRNT,9093)
- 9093 FORMAT (/' ***!!! JSL invalid !!!***')
- GO TO 97
-
- 94 WRITE (IQPRNT,9094) JSLU,JTXA,JTXE
- 9094 FORMAT (/' ***!!! trouble with line at slot',I6
- F/5X,'JTXA =',Z10/5X,'JTXE =',Z10)
-
- 97 IQFOUL = -1
- RETURN
- END
diff --git a/src/p5boot/p5lib/dqclobb.f b/src/p5boot/p5lib/dqclobb.f
deleted file mode 100644
index 12630a1..0000000
--- a/src/p5boot/p5lib/dqclobb.f
+++ /dev/null
@@ -1,103 +0,0 @@
-CDECK ID>, DQCLOBB.
- SUBROUTINE DQCLOBB (LNAME,LSTAT)
-
-C- Bank chaining clobbered has been detected at LNAME or LSTAT
-C- scan all divisions and print the last 4 good banks
-
- COMMON /QUNIT/ IQREAD,IQPRNT, IQTTIN,IQTYPE, IQOFFL,IQRTTY,IQRSAV
- +, IQRFD,IQRRD,IQRSIZ, NQLPAT,NQUSED,NQLLBL, NQINIT
- COMMON /MQCM/ NQSYSS,NQLINK, LQCSTA(3),LQCEND(3), NQMAX
- +, LQLSTA(5),LQLEND(5), LQADR,LQADR0,NQOFFS
- COMMON /MQCN/ IQLST,IQLNA,IQID,IQTY,IQLI,IQNL,IQNS,IQND
- +, IQLNX,IQFOUL
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ)
- EQUIVALENCE (LQ,IQ,LQGARB)
- COMMON // IQUEST(100),LQGARB
-C-------------- End CDE --------------------------------
- DIMENSION LLAST(4)
-
-
- WRITE (IQPRNT,9000)
- IF (LNAME.NE.0) THEN
- WRITE (IQPRNT,9001) 'name',LNAME
- ELSE
- WRITE (IQPRNT,9001) 'status',LSTAT
- ENDIF
-
- 9000 FORMAT (/' ****!!!!! Patchy is crashing !!!!!****'
- F/' please call for help: zoll at cern.ch')
- 9001 FORMAT (/' Bank chaining clobbered at ',A,' adr',I7)
-
-C---- Next division
-
- JDIV = 0
- 21 JDIV = JDIV + 1
- IF (JDIV.GT.3) GO TO 99
-
- LNA = LQCSTA(JDIV)
- LEND = LQCEND(JDIV)
-
- WRITE (IQPRNT,9022) JDIV,LNA,LEND
- 9022 FORMAT (/' Division',I2,' boundaries:',2I7)
-
-C---- Scan to the trouble splot
-
- CALL VZERO (LLAST,4)
-
- 31 IF (LNA.GE.LEND) GO TO 21
- CALL QBLOWX (LNA)
- IF (IQFOUL.NE.0) GO TO 41
-
- CALL UCOPY (LLAST(2),LLAST(1),3)
- LLAST(4) = LNA
- LNA = IQLNX
- GO TO 31
-
-C---- Trouble spot found, dump the last 4 banks
-
- 41 LNATR = LNA
- WRITE (IQPRNT,9041)
- 9041 FORMAT (/' After:')
-
- JBK = 0
- 42 JBK = JBK + 1
- IF (JBK.GT.4) GO TO 44
- LNA = LLAST(JBK)
- IF (LNA.EQ.0) GO TO 42
-
- CALL QBLOWX (LNA)
- CALL DQBANK
- GO TO 42
-
-C---- Find the first good bank after
-
- 44 LOK = 0
- LNA = LNATR
- 45 LNA = LNA + 1
- IF (LNA.GE.LEND-4) GO TO 46
- CALL QBLOWX (LNA)
- IF (IQFOUL.NE.0) GO TO 45
- LOK = LNA
-
- 46 LNAE = MIN (LNA, LNATR+39)
-
- WRITE (IQPRNT,9046)
- 9046 FORMAT (/' the memory is destroyed, dump the next few words:'/)
- 9047 FORMAT (1X,I8,' :',Z10,I20)
-
- DO 47 L=LNATR,LNAE
- WRITE (IQPRNT,9047) L,LQ(L),LQ(L)
- 47 CONTINUE
- IF (LOK.EQ.0) GO TO 21
-
- WRITE (IQPRNT,9049) LOK
- 9049 FORMAT (/' The first good bank after, starting at adr',I8,' is:')
-
- CALL DQBANK
- GO TO 21
-
-C---- Exit
-
- 99 CALL P_KILL ('fatal')
- END
diff --git a/src/p5boot/p5lib/excheck.f b/src/p5boot/p5lib/excheck.f
deleted file mode 100644
index 03a9d24..0000000
--- a/src/p5boot/p5lib/excheck.f
+++ /dev/null
@@ -1,122 +0,0 @@
-CDECK ID>, EXCHECK.
- SUBROUTINE EXCHECK
-
-C- Run nycheck
-C. started 12-jan-94
-
- COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT,NUSLAT(2),DUMMY(34)
- CHARACTER SLLINE*512, SLERRM*256
- COMMON /SLATLN/ SLLINE, SLERRM
- PARAMETER (KM1=1,KM2=2,KM3=4,KM4=8,KM5=16,KM6=32,KM7=64,KM8=128,
- + KM9=256, KM10=512, KM11=1024, KM12=2048, KM13=4096, KM14=8192,
- + KM15=16384, KM16=32768, KM17=65536, KM18=131072, KM19=262144,
- + KM20=524288, KM21=1048576, KM22=2097152, KM23=4194304,
- + KM24=8388608, KM25=16777216, KM26=33554432, KM27=67108864,
- + KM28=134217728, KM29=268435456, KM30=536870912, KM31=1073741824)
- PARAMETER (KMA=1,KMB=2,KMC=4,KMD=8,KME=16,KMF=32,KMG=64,KMH=128,
- + KMI=256, KMJ=512, KMK=KM11, KML=KM12, KMM=KM13, KMN=KM14,
- + KMO=KM15, KMP=KM16, KMQ=KM17, KMR=KM18, KMS=KM19, KMT=KM20,
- + KMU=KM21, KMV=KM22, KMW=KM23, KMX=KM24, KMY=KM25, KMZ=KM26)
- COMMON /QPAGE/ NQLMAX,NQLTOL,NQLTOK,NQCMAX,NQCPGH,NQPAGE
- +, NQWYLDO,NQWYL,NQNEWH,NQJOIN,NQDKNO,NQDKPG
- CHARACTER CQDATEM*10, CQDATE*8, CQTIME*5
- COMMON /QSTATE/NQERR,NQWARN,NQINFO,NQLOCK
- +, IQDATE,IQTIME, CQDATEM,CQDATE,CQTIME
- COMMON /QUNIT/ IQREAD,IQPRNT, IQTTIN,IQTYPE, IQOFFL,IQRTTY,IQRSAV
- +, IQRFD,IQRRD,IQRSIZ, NQLPAT,NQUSED,NQLLBL, NQINIT
- PARAMETER (JFO_TYP=1, JCC_TYP=2, JAS_TYP=3, JDA_TYP=4,
- + JSH_TYP=5, JCR_TYP=6, JIN_TYP=7, MAX_TYP=100)
- CHARACTER*16 CH_TYP(MAX_TYP), ACT_TYP
- COMMON /CM_TYP/ LUN_TYP, N_TYP, NAL_TYP, NDV_TYP, JBK_TYP
- +, JU_TYP(MAX_TYP), CH_TYP, ACT_TYP
- COMMON /LUNSLN/IFLAUX, IXLUN(12)
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
-C-------------- End CDE --------------------------------
- PARAMETER (MASK= KMH + KMU)
-
-
- CALL INIAUX (LASTWK)
-
- CALL KROPT (IXLUN(2),MASK)
- CALL PGSIZE (0, IXLUN(2))
- IF (MOPTIO(8).NE.0) GO TO 81
-
- NQCMAX = 90
- NQCPGH = 80
- NQJOIN = 1
-
-C------ Load the title deck to memory ------------
-
- CALL INIPAM (11, IXLUN(1), 1,0)
- 21 IF (JDKNEX.EQ.0) CALL ARRIVE (2)
-
-C---- Handle the PAM-file title line
-
- JDKTYP = 3
- CALL KRTITL
- JSLTTL = IQ(LARRV+10)
-
- IF (NQDKNO.GE.2) THEN
- NQDKNO = ((NQDKNO-1)/100 + 1) *100
- ELSE
- NQDKNO = 0
- ENDIF
-
- CALL LN_GET (JSLTTL, SLLINE, 60)
- NTXT = NDSLAT
-
- IF (IQPRNT.NE.IQTYPE) WRITE (IQTYPE,9024) SLLINE(1:NTXT)
- 9024 FORMAT (' Read Pam file: ',A/)
-
-C------ Loop over all decks until next title
-
- CALL CHDECK
- IF (JDKTYP.EQ.3) GO TO 21
-
- IF (MOPTIO(21).EQ.0) GO TO 47
- IF (N_TYP.LE.JIN_TYP) GO TO 47
- CALL DPBLAN (1)
- WRITE (IQPRNT,9025)
-
- DO 27 JASM=1,N_TYP
- LASMT = LQ(LHASM-JASM)
- NDK = IQ(LASMT+8)
- IF (NDK.EQ.0) GO TO 27
- N = LNBLNK (CH_TYP(JASM))
- WRITE (IQPRNT,9027) NDK, CH_TYP(JASM)(1:N)
- NQUSED = NQUSED + 1
- 27 CONTINUE
-
- 47 IF (NQERR .NE.0) CALL EXITRC (2)
- IF (NQWARN.NE.0) CALL EXITRC (1)
- CALL DPBLAN (0)
- WRITE (IQPRNT,9049)
- 9049 FORMAT (' All is well.'/)
- RETURN
-
-C---- Help
-
- 81 WRITE (IQPRNT,9081)
- RETURN
-
- 9025 FORMAT (' Table of Data types'/)
- 9027 FORMAT (4X,I6,' decks of type ',A)
- 9081 FORMAT (' nycheck pam.car options print'/
- F/' reads the "pam" file to check all Patchy control-lines'
- F/' for syntax, reporting errors on "print".'/
- F/' "options": H help - print this help information only'
- F/' U user data-types present to cause warning exit')
- END
diff --git a/src/p5boot/p5lib/exdiff.f b/src/p5boot/p5lib/exdiff.f
deleted file mode 100644
index 70285dc..0000000
--- a/src/p5boot/p5lib/exdiff.f
+++ /dev/null
@@ -1,159 +0,0 @@
-CDECK ID>, EXDIFF.
- SUBROUTINE EXDIFF
-
-C- Run nydiff
-C. started 3-june-94
-
- PARAMETER (KM1=1,KM2=2,KM3=4,KM4=8,KM5=16,KM6=32,KM7=64,KM8=128,
- + KM9=256, KM10=512, KM11=1024, KM12=2048, KM13=4096, KM14=8192,
- + KM15=16384, KM16=32768, KM17=65536, KM18=131072, KM19=262144,
- + KM20=524288, KM21=1048576, KM22=2097152, KM23=4194304,
- + KM24=8388608, KM25=16777216, KM26=33554432, KM27=67108864,
- + KM28=134217728, KM29=268435456, KM30=536870912, KM31=1073741824)
- PARAMETER (KMA=1,KMB=2,KMC=4,KMD=8,KME=16,KMF=32,KMG=64,KMH=128,
- + KMI=256, KMJ=512, KMK=KM11, KML=KM12, KMM=KM13, KMN=KM14,
- + KMO=KM15, KMP=KM16, KMQ=KM17, KMR=KM18, KMS=KM19, KMT=KM20,
- + KMU=KM21, KMV=KM22, KMW=KM23, KMX=KM24, KMY=KM25, KMZ=KM26)
- PARAMETER (NBANKS=19,JBKPAT=1, JBKDEC=2, JBKORG=3, JBKINC=4,
- + JBKHOL=5, JBKKEE=6, JBKACT=7, JBKMAT=8, JBKXSQ=9,
- + JBKPRE=10,JBKGAR=11,JBKSMH=12,JBKSMT=13,JBKSML=14,
- + JBKSMX=15,JBKARR=16,JBKASA=17,JBKPAM=18,JBKRPA=19)
- COMMON /QBANKS/MMBANK(5,NBANKS)
- CHARACTER CQDATEM*10, CQDATE*8, CQTIME*5
- COMMON /QSTATE/NQERR,NQWARN,NQINFO,NQLOCK
- +, IQDATE,IQTIME, CQDATEM,CQDATE,CQTIME
- COMMON /QUNIT/ IQREAD,IQPRNT, IQTTIN,IQTYPE, IQOFFL,IQRTTY,IQRSAV
- +, IQRFD,IQRRD,IQRSIZ, NQLPAT,NQUSED,NQLLBL, NQINIT
- COMMON /LUNSLN/IFLAUX, IXLUN(12)
- COMMON /MQCM/ NQSYSS,NQLINK, LQCSTA(3),LQCEND(3), NQMAX
- +, LQLSTA(5),LQLEND(5), LQADR,LQADR0,NQOFFS
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
- +, INMEM(2),NSLTOT(2),NSLMAX(2),NTXMAX(2),JSLTTF(2), IFSTRUC
- +, NOBJTT(3,2),NOBJMAT, MDELADD(2,2), LUNCRA,NLSENT, LASTDI
-C-------------- End CDE --------------------------------
- PARAMETER (MASK= KMH + KMA + KMD + KMF)
-
- DIMENSION MMPAT(4)
- DATA MMPAT / 0, 4, 1, 10 /
-
-
- CALL INIAUX (LASTDI)
- LQCSTA(2) = LQCEND(1) + 100
- LQCEND(2) = LQCSTA(2)
-
- LQLSTA(1) = LQLEND(1) + 10
- MLIAD(LQLSTA(1)) = MLIAD(LQLEND(1)) + 2048
- LQLEND(1) = LQLSTA(1)
- LQLSTA(2) = LQLEND(1)
- LQLEND(2) = LQLSTA(2)
-
- CALL KROPT (IXLUN(4),MASK)
- IF (MOPTIO(8).NE.0) GO TO 81
-
- CALL UCOPY (MMPAT, MMBANK(2,JBKPAT), 4)
- MMPAT(2) = 3
- CALL UCOPY (MMPAT, MMBANK(2,JBKDEC), 4)
-
-C---- load the "old" and the "new" file
-
- CALL DILOAD
-
-C---- match decks on the names only
-
- CALL DIPREM
-
-C---- match unmatched P/D on contents
-
- CALL DISAME
-
-C---- insert proxies for new patches
-
- CALL DINEWP
-
-C---- check that 3/4 of the decks have been matched
-
- IF (MOPTIO(6).EQ.0) THEN
- NDK = MIN (NOBJTT(1,1), NOBJTT(1,2))
- IF (4*NOBJMAT.LT.3*NDK)
- + CALL P_KILL ('Less than 3/4 of the decks match')
- ENDIF
-
-C---- prepare for the re-ordering necessary
-
- CALL DIORD
-
-C---- find lost decks in foreign patches
-
- CALL DILOST
-
-C---- make Patchy cradle
-
- CALL DICRAD
-
-C---- make Wylbur re-ordering cradle
-
- CALL DIWYLB
- CALL DPBLAN (0)
-
-C---- done
-
- IF (NQERR.NE.0) THEN
- WRITE (IQPRNT,9067)
- CALL EXITRC (2)
- ENDIF
-
- IF (NQWARN.NE.0) THEN
- WRITE (IQPRNT,9068)
- CALL EXITRC (1)
- ENDIF
- RETURN
-
- 9067 FORMAT (' ***!!! There are errors !!!***'/)
- 9068 FORMAT (' **!! There are warnings !!**'/)
-
-C---- Help
-
- 81 WRITE (IQPRNT,9081)
- WRITE (IQPRNT,9082)
- RETURN
-
- 9081 FORMAT (
- F ' nydiff old.car new.car diff.ucra options print'/
- F/' compare "old" and "new" to derive the cradles which'
- F/' will give "new" when applied to "old":'/
- F/' diff.ucra to update "old" to "temp" using nypatchy;'
- F/' diff.uexe to re-order "temp" to "new" using Wylbur.'/
- F/' options: A anyway: operate even if there are too few'
- F/' matching patch names initially'
- F/' F force operation even if less than 3/4 of'
- F/' the decks have been matched'
- F/' H print this help information only.')
- 9082 FORMAT (
- F/' A shell script to make "new" from "old" using the'
- F/' cradles obtained from nydiff would look like this:'/
- F/' nypatchy - new.car .go <</'
- F/' +UPDATE.'
- F/' +USE, T=EXE.'
- F/' +PAM, T=ATTACH .diff.ucra'
- F/' +PAM, T=ATT, UPDATE .old.car'
- F/' +QUIT.'
- F/' /'/
- F/' useb new.car <</'
- F/' @diff.uexe'
- F/' save,unn,replace'
- F/' quit'
- F/' /')
- END
diff --git a/src/p5boot/p5lib/exindex.f b/src/p5boot/p5lib/exindex.f
deleted file mode 100644
index 00008ec..0000000
--- a/src/p5boot/p5lib/exindex.f
+++ /dev/null
@@ -1,364 +0,0 @@
-CDECK ID>, EXINDEX.
- SUBROUTINE EXINDEX
-
-C- Run nyindex
-C. started 12-jan-94
-
- COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT,NUSLAT(2),DUMMY(34)
- CHARACTER SLLINE*512, SLERRM*256
- COMMON /SLATLN/ SLLINE, SLERRM
- PARAMETER (KM1=1,KM2=2,KM3=4,KM4=8,KM5=16,KM6=32,KM7=64,KM8=128,
- + KM9=256, KM10=512, KM11=1024, KM12=2048, KM13=4096, KM14=8192,
- + KM15=16384, KM16=32768, KM17=65536, KM18=131072, KM19=262144,
- + KM20=524288, KM21=1048576, KM22=2097152, KM23=4194304,
- + KM24=8388608, KM25=16777216, KM26=33554432, KM27=67108864,
- + KM28=134217728, KM29=268435456, KM30=536870912, KM31=1073741824)
- PARAMETER (KMA=1,KMB=2,KMC=4,KMD=8,KME=16,KMF=32,KMG=64,KMH=128,
- + KMI=256, KMJ=512, KMK=KM11, KML=KM12, KMM=KM13, KMN=KM14,
- + KMO=KM15, KMP=KM16, KMQ=KM17, KMR=KM18, KMS=KM19, KMT=KM20,
- + KMU=KM21, KMV=KM22, KMW=KM23, KMX=KM24, KMY=KM25, KMZ=KM26)
- PARAMETER (NBANKS=19,JBKPAT=1, JBKDEC=2, JBKORG=3, JBKINC=4,
- + JBKHOL=5, JBKKEE=6, JBKACT=7, JBKMAT=8, JBKXSQ=9,
- + JBKPRE=10,JBKGAR=11,JBKSMH=12,JBKSMT=13,JBKSML=14,
- + JBKSMX=15,JBKARR=16,JBKASA=17,JBKPAM=18,JBKRPA=19)
- COMMON /QBANKS/MMBANK(5,NBANKS)
- COMMON /QPAGE/ NQLMAX,NQLTOL,NQLTOK,NQCMAX,NQCPGH,NQPAGE
- +, NQWYLDO,NQWYL,NQNEWH,NQJOIN,NQDKNO,NQDKPG
- CHARACTER CQDATEM*10, CQDATE*8, CQTIME*5
- COMMON /QSTATE/NQERR,NQWARN,NQINFO,NQLOCK
- +, IQDATE,IQTIME, CQDATEM,CQDATE,CQTIME
- COMMON /QUNIT/ IQREAD,IQPRNT, IQTTIN,IQTYPE, IQOFFL,IQRTTY,IQRSAV
- +, IQRFD,IQRRD,IQRSIZ, NQLPAT,NQUSED,NQLLBL, NQINIT
- PARAMETER (JFO_TYP=1, JCC_TYP=2, JAS_TYP=3, JDA_TYP=4,
- + JSH_TYP=5, JCR_TYP=6, JIN_TYP=7, MAX_TYP=100)
- CHARACTER*16 CH_TYP(MAX_TYP), ACT_TYP
- COMMON /CM_TYP/ LUN_TYP, N_TYP, NAL_TYP, NDV_TYP, JBK_TYP
- +, JU_TYP(MAX_TYP), CH_TYP, ACT_TYP
- COMMON /LUNSLN/IFLAUX, IXLUN(12)
- PARAMETER (KQGARB=1,KQARRV=3,KQKEEP=4,KQPREP=5,KQMAIN=6,KQPAST=8)
- PARAMETER (KQUSER=9)
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
-C-------------- End CDE --------------------------------
- CHARACTER LINE*110, LINETT*60
- EQUIVALENCE (LINE, SLLINE)
- EQUIVALENCE (LINETT, LINE(47:))
-
- PARAMETER (MASK= KMB + KMH + KMP + KMQ + KMX + KMY + KMZ)
-
- DIMENSION MMPAT(4), MMDECK(4), MMKEEP(4)
-
- DATA MMPAT / 0, 1, 1, 2 /
- DATA MMDECK / 0, 2, 1, 3 /
- DATA MMKEEP / 0, 2, 1, 1 /
-
- IAND (IZV,IZW) = AND (IZV, IZW)
-
-
- CALL INIAUX (LASTWK)
-
- CALL KROPT (IXLUN(2),MASK)
- CALL PGSIZE (0, IXLUN(2))
-
- MOPTIO(16) = MAX (MOPTIO(16), MOPTIO(17))
- IF (MOPTIO(8).NE.0) GO TO 81
-
- NQCMAX = 100
- NQCPGH = 100
-
- CALL UCOPY (MMPAT, MMBANK(2,JBKPAT), 4)
- CALL UCOPY (MMDECK, MMBANK(2,JBKDEC), 4)
- CALL UCOPY (MMKEEP, MMBANK(2,JBKKEE), 4)
-
- CALL INIPAM (11, IXLUN(1), 1,0)
-
-C------ Load the title deck to memory ------------
-
- 21 IF (JDKNEX.EQ.0) CALL ARRIVE (2)
-
-C---- Handle the PAM-file title line
-
- JDKTYP = 3
- CALL KRTITL
-
- IF (NQDKNO.GE.2) THEN
- NQDKNO = ((NQDKNO-1)/100 + 1) *100
- ELSE
- NQDKNO = 0
- ENDIF
-
-C------ Loop over all decks until next title
-
- CALL INDDECK
- IF (JDKTYP.EQ.3) GO TO 21
- CALL INIPAM (0,0, -1,0)
-
-C------- Input finished, print tables
-
- CALL QTOPSY (KQUSER)
- CALL QSORTN (2,KQUSER)
-
- KQDECK = KQUSER + 1
- CALL QTOPSY (KQDECK)
- CALL QSORTN (2,KQDECK)
- CALL QSORTN (1,KQDECK)
-
-C---- Print list of data types
-
- WRITE (IQPRNT,9025)
- NQUSED = NQUSED + 3
-
- DO 27 JASM=1,N_TYP
- LASMT = LQ(LHASM-JASM)
- NDK = IQ(LASMT+8)
- IF (NDK.EQ.0) GO TO 27
- N = LNBLNK (CH_TYP(JASM))
- WRITE (IQPRNT,9027) NDK, CH_TYP(JASM)(1:N)
- NQUSED = NQUSED + 1
- 27 CONTINUE
- NQLLBL = 0
-
-C---- Print duplicates
-
- CALL DPBLAN (0)
- LN = LQUSER(1)
- 32 LA = LN
- LN = LQ(LA-1)
- IF (LN.EQ.0) GO TO 35
- IF (IQ(LA+2).NE.IQ(LN+2)) GO TO 32
-
- IXP = IQ(LA+2)
- LINE = 'p='
- CALL NA_GET (IXP,LINE,3)
- N = NESLAT
- WRITE (IQPRNT,9032) LINE(1:N)
- NQWARN = NQWARN + 1
- NQUSED = NQUSED + 1
- NQLLBL = 0
-
- 33 LN = LQ(LN-1)
- IF (LN.EQ.0) GO TO 35
- IF (IQ(LN+2).NE.IXP) GO TO 32
- GO TO 33
-
-C-- deck names
-
- 35 CALL DPBLAN (0)
- LN = LQUSER(2)
- 36 LA = LN
- LN = LQ(LA-1)
- IF (LN.EQ.0) GO TO 41
- IF (IQ(LA+1).NE.IQ(LN+1)) GO TO 36
- IF (IQ(LA+2).NE.IQ(LN+2)) GO TO 36
-
- IXD = IQ(LA+1)
- IXP = IQ(LA+2)
- LINE = 'p='
- CALL NA_GET (IXP,LINE,3)
- N = NESLAT
- LINE(N+1:N+2) = 'd='
- N = N + 3
- CALL NA_GET (IXD,LINE,N)
- N = NESLAT
- WRITE (IQPRNT,9032) LINE(1:N)
- NQWARN = NQWARN + 1
- NQUSED = NQUSED + 1
- NQLLBL = 0
-
- 37 LN = LQ(LN-1)
- IF (LN.EQ.0) GO TO 41
- IF (IQ(LN+1).NE.IXD) GO TO 36
- IF (IQ(LN+2).NE.IXP) GO TO 36
- GO TO 37
-
-
-C----- Print index of patches
-
- 41 IF (MOPTIO(24).NE.0) GO TO 88
- NBK = NQCOUNT (LQUSER(1))
-
- NQUSED = MOD (NQUSED, NQLMAX)
-
- IF (NQUSED+NBK+4.GE.NQLMAX) THEN
- WRITE (IQPRNT,9041)
- NQUSED = 3
- ELSE
- WRITE (IQPRNT,9042)
- NQUSED = NQUSED + 3
- ENDIF
-
- LP = LQUSER(1)
- 42 IF (LP.EQ.0) GO TO 45
- NDK = IQ(LP+1)
- IXPAT = IQ(LP+2)
- IFLG = IAND (IQ(LP),KM6)
-
- LINE(1:13) = ' = '
-C- ' if 123456 = pname
-C- _:.=+=.: 1_:.=
-
- IF (NDK.LT.0) THEN
- LINE(10:13) = '- '
- ELSE
- CALL CSETDI (NDK,LINE,5,10)
- ENDIF
-
- IF (IFLG.NE.0) LINE(2:3)= 'If'
-
- CALL NA_GET (IXPAT,LINE,14)
- NN = NESLAT - 1
-
- WRITE (IQPRNT,9008) LINE(1:NN)
- NQUSED = NQUSED + 1
- LP = LQ(LP-1)
- GO TO 42
-
-C---- Print index of decks
-
- 45 IF (MOPTIO(25).NE.0) GO TO 87
- NBK = NQCOUNT (LQUSER(2))
-
- NQUSED = MOD (NQUSED, NQLMAX)
-
- IF (NQUSED+NBK+4.GE.NQLMAX) THEN
- WRITE (IQPRNT,9045)
- NQUSED = 3
- ELSE
- WRITE (IQPRNT,9046)
- NQUSED = NQUSED + 3
- ENDIF
-
- LD = LQUSER(2)
- 46 IF (LD.EQ.0) GO TO 51
- IXDEC = IQ(LD+1)
- IXPAT = IQ(LD+2)
- NDK = IQ(LD+3)
-
- LINE(1:26) = ' = .'
-C- ' 123456 = dname .pname
-C- _:.=+=.: 1_:.=+=.: 2_:.=+=.: 3_:.=+=.:
-
- CALL CSETDI (NDK,LINE,5,10)
-
- CALL NA_GET (IXDEC,LINE,14)
- NN = NESLAT
- NN = MAX (NN,26)
-
- LINE(NN:NN) = '.'
- CALL NA_GET (IXPAT,LINE,NN+1)
- NN = NESLAT - 1
-
- WRITE (IQPRNT,9008) LINE(1:NN)
- NQUSED = NQUSED + 1
- LD = LQ(LD-1)
- GO TO 46
-
-C---- Print index of sequence definitions
-
- 51 IF (MOPTIO(26).NE.0) GO TO 87
- CALL QTOPSY (KQKEEP)
- CALL QSORTN (1,KQKEEP)
- NBK = NQCOUNT (LQKEEP)
-
- NQUSED = MOD (NQUSED, NQLMAX)
-
- IF (NQUSED+NBK+4.GE.NQLMAX) THEN
- WRITE (IQPRNT,9051)
- NQUSED = 3
- ELSE
- WRITE (IQPRNT,9052)
- NQUSED = NQUSED + 3
- ENDIF
-
- LZ = LQKEEP
- 52 IF (LZ.EQ.0) GO TO 87
- IXSEQ = IQ(LZ+1)
- LD = LQ(LZ-2)
- IF (IAND(IQ(LZ),1).EQ.0) THEN
- IXDEC = IQ(LD+1)
- IXPAT = IQ(LD+2)
- NDK = IQ(LD+3)
- ELSE
- IXDEC = 0
- NDK = IQ(LD+1)
- IXPAT = IQ(LD+2)
- ENDIF
-
- LINE(1:41) = ' : '
-C- ' 123456 : zname d=dname .pname
-C- _:.=+=.: 1_:.=+=.: 2_:.=+=.: 3_:.=+=.: 4_:.=+=.: 5
-
- CALL CSETDI (NDK,LINE,5,10)
-
- CALL NA_GET (IXSEQ,LINE,14)
- NN = NESLAT
- NN = MAX (NN,26) + 1
-
- LINE(NN:NN+1) = 'd='
- CALL NA_GET (IXDEC,LINE,NN+2)
- NN = NESLAT
- NN = MAX (NN,41)
-
- LINE(NN:NN) = '.'
- CALL NA_GET (IXPAT,LINE,NN+1)
- NN = NESLAT - 1
-
- WRITE (IQPRNT,9008) LINE(1:NN)
- NQUSED = NQUSED + 1
- LZ = LQ(LZ-1)
- GO TO 52
-
-C---- Help
-
- 81 WRITE (IQPRNT,9081)
-
- 87 CALL PGSIZE (1, 0)
- 88 IF (NQWARN.NE.0) THEN
- WRITE (IQPRNT,9088)
- CALL EXITRC (1)
- ENDIF
- RETURN
-
- 9008 FORMAT (A)
- 9025 FORMAT (/' Table of Data types'/)
- 9027 FORMAT (4X,I6,' decks of type ',A)
- 9032 FORMAT (' **!! Warn: duplicate ',A)
- 9041 FORMAT ( '1 Index of Patches'/)
- 9042 FORMAT (/' Index of Patches'/)
- 9045 FORMAT ( '1 Index of Decks'/)
- 9046 FORMAT (/' Index of Decks'/)
- 9051 FORMAT ( '1 Index of Sequences defined'/)
- 9052 FORMAT (/' Index of Sequences defined'/)
- 9081 FORMAT ( ' nyindex pam.car options print'/
- F/' reads the "pam" file, printing on "print" a running'
- F/' table-of-content of the patches and decks encountered,'
- F/' and at the end it prints 3 sorted indices of the patches,'
- F/' decks and sequence definitions seen.'
- F/' A "duplicate" warning is given if there are two or more'
- F/' decks of the same name in the same patch.'/
- F/' "options": B bare - comment fields of P/D lines not to'
- F/' appear in the table-of-content'
- F/' H help - print this help information only'
- F/' P patch only - suppress the deck names from'
- F/' the table-of-content'
- F/' Q quick - suppress the table-of-content'
- F/' X - suppress all sorted indices'
- F/' Y - suppress the sorted indices of decks and'
- F/' sequence definitions'
- F/' Z - suppress the sorted index of sequences'
- F/' 0 ... 4 - select page size by single digit option'
- F/' "n" - set page size to be n > 19')
- 9088 FORMAT (' **!! There are warnings !!**'/)
- END
diff --git a/src/p5boot/p5lib/exitrc.f b/src/p5boot/p5lib/exitrc.f
deleted file mode 100644
index 421cb5b..0000000
--- a/src/p5boot/p5lib/exitrc.f
+++ /dev/null
@@ -1,7 +0,0 @@
-CDECK ID>, EXITRC.
- SUBROUTINE EXITRC (INRC)
-
- JRC = INRC
-
- CALL EXITF (JRC)
- END
diff --git a/src/p5boot/p5lib/exlist.f b/src/p5boot/p5lib/exlist.f
deleted file mode 100644
index f30ea81..0000000
--- a/src/p5boot/p5lib/exlist.f
+++ /dev/null
@@ -1,107 +0,0 @@
-CDECK ID>, EXLIST.
- SUBROUTINE EXLIST
-
-C- Run nylist
-C. started 12-jan-94
-
- COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT,NUSLAT(2),DUMMY(34)
- CHARACTER SLLINE*512, SLERRM*256
- COMMON /SLATLN/ SLLINE, SLERRM
- PARAMETER (KM1=1,KM2=2,KM3=4,KM4=8,KM5=16,KM6=32,KM7=64,KM8=128,
- + KM9=256, KM10=512, KM11=1024, KM12=2048, KM13=4096, KM14=8192,
- + KM15=16384, KM16=32768, KM17=65536, KM18=131072, KM19=262144)
- PARAMETER (KMA=1,KMB=2,KMC=4,KMD=8,KME=16,KMF=32,KMG=64,KMH=128,
- + KMI=256, KMJ=512, KMK=KM11, KML=KM12, KMM=KM13, KMN=KM14,
- + KMO=KM15, KMP=KM16, KMQ=KM17, KMR=KM18, KMS=KM19)
- COMMON /QPAGE/ NQLMAX,NQLTOL,NQLTOK,NQCMAX,NQCPGH,NQPAGE
- +, NQWYLDO,NQWYL,NQNEWH,NQJOIN,NQDKNO,NQDKPG
- COMMON /QUNIT/ IQREAD,IQPRNT, IQTTIN,IQTYPE, IQOFFL,IQRTTY,IQRSAV
- +, IQRFD,IQRRD,IQRSIZ, NQLPAT,NQUSED,NQLLBL, NQINIT
- COMMON /LUNSLN/IFLAUX, IXLUN(12)
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
-C-------------- End CDE --------------------------------
- PARAMETER (MASK= KMH + KME + KMS)
-
-
- CALL INIAUX (LASTWK)
-
- CALL KROPT (IXLUN(2),MASK)
- CALL PGSIZE (0, IXLUN(2))
- IF (MOPTIO(8).NE.0) GO TO 81
-
- IF (MOPTIO(19).NE.0) THEN
- MOPTIO(19) = 0
- ELSE
- MOPTIO(3) = 1
- MOPTIO(5) = 0
- ENDIF
-
- NQCMAX = 104
- NQCPGH = 100
- NQWYLDO = 7
-
- CALL INIPAM (11, IXLUN(1), 1,0)
- NQJOIN = -1
-
-C------ Load the title deck to memory ------------
-
- 21 IF (JDKNEX.EQ.0) CALL ARRIVE (2)
-
-C---- Handle the PAM-file title line
-
- JDKTYP = 3
- CALL KRTITL
- JSLTTL = IQ(LARRV+10)
-
- IF (NQDKNO.GE.2) THEN
- NQDKNO = ((NQDKNO-1)/100 + 1) *100
- ELSE
- NQDKNO = 0
- ENDIF
-
- CALL LN_GET (JSLTTL, SLLINE, 60)
- NTXT = NDSLAT
-
- IF (IQPRNT.NE.IQTYPE) WRITE (IQTYPE,9024) SLLINE(1:NTXT)
- 9024 FORMAT (' Read Pam file: ',A/)
-
-C------ Loop over all decks until next title
-
- CALL LIDECK
- IF (JDKTYP.EQ.3) GO TO 21
- GO TO 89
-
-C---- Help
-
- 81 WRITE (IQPRNT,9081)
-
- 89 CALL PGSIZE (1, 0)
- RETURN
-
- 9081 FORMAT (' nylist pam.car options print'/
- F/' reads the "pam" file printing on "print" a numbered'
- F/' listing of the whole file. Line numbers both local to'
- F/' each deck and global in the file are shown. Page ejects'
- F/' can be controled with the option letters S and E, and'
- F/' also with T=JOIN given on any deck header line.'/
- F/' "options": H help - print this help information only'
- F/' E eject - honor the pseudo sequence calls'
- F/' +SEQ, QEJECT, N=n.'
- F/' S start - start each deck on a new page,'
- F/' unless T=JOIN present'
- F/' 0 ... 4 - select page size by single digit option'
- F/' "n" - set page size to be n > 19')
- END
diff --git a/src/p5boot/p5lib/exmerge.f b/src/p5boot/p5lib/exmerge.f
deleted file mode 100644
index 46a4171..0000000
--- a/src/p5boot/p5lib/exmerge.f
+++ /dev/null
@@ -1,304 +0,0 @@
-CDECK ID>, EXMERGE.
- SUBROUTINE EXMERGE
-
-C- Run nymerge
-C. started 11-july-95
-
- COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT,NUSLAT(2),DUMMY(34)
- PARAMETER (KM1=1,KM2=2,KM3=4,KM4=8,KM5=16,KM6=32,KM7=64,KM8=128,
- + KM9=256, KM10=512, KM11=1024, KM12=2048, KM13=4096, KM14=8192,
- + KM15=16384, KM16=32768, KM17=65536, KM18=131072, KM19=262144,
- + KM20=524288, KM21=1048576, KM22=2097152, KM23=4194304,
- + KM24=8388608, KM25=16777216, KM26=33554432, KM27=67108864,
- + KM28=134217728, KM29=268435456, KM30=536870912, KM31=1073741824)
- PARAMETER (KMA=1,KMB=2,KMC=4,KMD=8,KME=16,KMF=32,KMG=64,KMH=128,
- + KMI=256, KMJ=512, KMK=KM11, KML=KM12, KMM=KM13, KMN=KM14,
- + KMO=KM15, KMP=KM16, KMQ=KM17, KMR=KM18, KMS=KM19, KMT=KM20,
- + KMU=KM21, KMV=KM22, KMW=KM23, KMX=KM24, KMY=KM25, KMZ=KM26)
- PARAMETER (NBANKS=19,JBKPAT=1, JBKDEC=2, JBKORG=3, JBKINC=4,
- + JBKHOL=5, JBKKEE=6, JBKACT=7, JBKMAT=8, JBKXSQ=9,
- + JBKPRE=10,JBKGAR=11,JBKSMH=12,JBKSMT=13,JBKSML=14,
- + JBKSMX=15,JBKARR=16,JBKASA=17,JBKPAM=18,JBKRPA=19)
- COMMON /QBANKS/MMBANK(5,NBANKS)
- COMMON /QPAGE/ NQLMAX,NQLTOL,NQLTOK,NQCMAX,NQCPGH,NQPAGE
- +, NQWYLDO,NQWYL,NQNEWH,NQJOIN,NQDKNO,NQDKPG
- COMMON /QUNIT/ IQREAD,IQPRNT, IQTTIN,IQTYPE, IQOFFL,IQRTTY,IQRSAV
- +, IQRFD,IQRRD,IQRSIZ, NQLPAT,NQUSED,NQLLBL, NQINIT
- CHARACTER CCKORG*256, CCKARD*256, CCCOMF*256
- COMMON /CCPARA/NCHCCD,NCHCCT, JCCTYP,JCCLEV,JCCSL,MCCPAR(240)
- +, NCCPAR,MXCCIF,JCCIFV,JCCBAD,JCCWAR,ICCSUB,JCCWK(4)
- +, JCCPP,JCCPD,JCCPZ,JCCPT,JCCPIF,JCCPC,JCCPN
- +, NCCPP,NCCPD,NCCPZ,NCCPT,NCCPIF,NCCPC,NCCPN
- +, JCCEND, NCHCCC,IXCCC, CCKORG, CCKARD, CCCOMF
- PARAMETER (MCCNIL=1, MCCKIL=2, MCCINC=3, MCCCDE=4, MCCSEQ=5,
- + MCCXSQ=6, MCCTRU=7, MCCFAL=8, MCCELS=9, MCCEND=10,
- + MCCSEL=11, MCCSES=12, MCCFAU=13, MCCSKI=14,
- + MCCKEE=15, MCCDEL=16, MCCREP=17, MCCADB=18, MCCADD=19,
- + MCCUSE=20, MCCXDI=21, MCCDIV=22, MCCLIS=23, MCCEXE=24, MCCIMI=25,
- + MCCASM=26, MCCUPD=27, MCCNAM=28, MCCGAP=29, MCCMOR=30, MCCONL=31,
- + MCCFOR=32, MCCSUS=33, MCCOPT=34, MCCOP2=35, MCCSHO=36, MCCPAM=37,
- + MCCQUI=38, MCCEOD=39, MCCDEC=40, MCCPAT=41, MCCTIT=42)
- CHARACTER CHEXPD*68
- COMMON /CHEXC/ IXEXPAM, IXEXPAT,IXEXDEC,IXEXID, NCHEPD, CHEXPD
- COMMON /DEPCOM/JD_NEW, JD_DTN, JD_DTP, JD_DTD, JD_DIV
- +, JD_SML, JD_SMP, JD_SMX, JDP_DT, JDP_DV
- +, JD_SPL, JD_MOD, JD_LUN, JD_LOG, JD_NLI, JD_MULT
- +, IX_EXT, IX_RH, IX_SUB
- COMMON /LUNSLN/IFLAUX, IXLUN(12)
- PARAMETER (NSLIFI=128)
- CHARACTER CHLIFI*(NSLIFI), CHLIEX*8
- COMMON /FLINKC/LUNOP,LUNFD,LUNOLD,LUNSIZ
- +, IXFLUN, NLIFI,CHLIFI,CHLIEX
- COMMON /MQCM/ NQSYSS,NQLINK, LQCSTA(3),LQCEND(3), NQMAX
- +, LQLSTA(5),LQLEND(5), LQADR,LQADR0,NQOFFS
- PARAMETER (KQUSER=9)
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
-C-------------- End CDE --------------------------------
- EQUIVALENCE (LMERGE,LQUSER(1))
- CHARACTER LINE*80, COL(80)*1
- EQUIVALENCE (LINE,COL)
- PARAMETER (MASK= KMF + KMH + KMM + KMP + KMQ + KMU)
-
- DIMENSION MMDEC(4)
- DATA MMDEC / 1, 1, 1, 3 /
-
-
- CALL INIAUX (LASTWK)
-
- CALL KROPT (IXLUN(4),MASK)
- IF (MOPTIO(8).NE.0) GO TO 81
- MOPTIO(21) = MOPTIO(21) + MOPTIO(6) + MOPTIO(13)
-
- CALL UCOPY (MMDEC, MMBANK(2,JBKDEC), 4)
-
-C---- load the "merge" file
-
- CALL MELOAD
-
-C---- open the "new" file
-
- JD_LUN = 21
- IXFLUN = IXLUN(3)
-
- IF (IXFLUN.EQ.0)
- + CALL P_KILL ('output file name missing')
-
- CALL FLINK (JD_LUN, 6, -1, 0)
- JD_LUN = LUNFD
-
-C---- start the "old" file
-
- CALL MQLIFT (LQHOLD, 0,7, JBKHOL,1)
- CALL MQLIFT (LARRV,LQARRV,1,JBKARR,3)
- CALL INIPAM (11,IXLUN(2),1,0)
- IFSTEP = 0
- NQDKNO = -1
-
-C-------- ready the next "merge" deck ---------------
-
- 31 IF (LMERGE.EQ.0) THEN
- IXMGPAT = -1
- GO TO 41
- ENDIF
-
- JSLM = IQ(LMERGE+1)
- NSLM = IQ(LMERGE+2)
- JTYP = IQ(LMERGE+3)
- IF (JTYP.EQ.1) GO TO 32
- IF (JTYP.NE.2) GO TO 68
-
- JCCTYP = MCCPAT
- CALL CCKRAK (JSLM)
- IXMGPAT = MCCPAR(JCCPP+1)
- IXMGDEC = 0
- IF (JCCBAD.NE.0) GO TO 91
- GO TO 36
-
- 32 JCCTYP = MCCDEC
- CALL CCKRAK (JSLM)
- IF (JCCBAD.NE.0) GO TO 91
- IXMGPAT = MCCPAR(JCCPP+1)
- IXMGDEC = MCCPAR(JCCPD+1)
-
- 36 LINE = 'd='
- CALL NA_GET (IXMGDEC, LINE,3)
- N = NESLAT
- IF (IXMGPAT.GT.0) THEN
- LINE(N+1:N+2) = 'p='
- CALL NA_GET (IXMGPAT, LINE,N+3)
- N = NESLAT
- ENDIF
-
- IF (MOPTIO(17).EQ.0) THEN
- CALL DPBLAN (0)
- WRITE (IQPRNT,9036) LINE(1:N-1)
- ENDIF
- 9036 FORMAT (43X,' merge ',A/)
-
-C---- read the next deck from "old"
-
- 41 CALL ARRNXD (IFSTEP)
- IF (JDKTYP.GE.4) GO TO 71
- IFSTEP = 1
- NQDKNO = NQDKNO + 1
- IF (JDKNEX.EQ.0) CALL ARRIVE (2)
- JSLF = IQ(LQHOLD+1)
- NSLF = IQ(LQHOLD+3)
- LINE = ' '
-
- IF (JDKTYP.EQ.1) GO TO 44
- IF (JDKTYP.EQ.2) GO TO 43
-
-C-- Deck header is +TITLE or start of PAM
-
- NQDKNO = (NQDKNO+99) / 100
- NQDKNO = NQDKNO * 100
- CALL METITL (JSLF,NSLF)
- IXEXPAT = 0
- GO TO 41
-
-C-- Deck header is +PATCH, name
-
- 43 JCCTYP = MCCPAT
- CALL CCKRAK (JSLF)
- IXEXPAT = MCCPAR(JCCPP+1)
- IXEXDEC = 0
- IF (IXEXPAT.EQ.0) GO TO 92
- CALL NA_GET (IXEXPAT, LINE,1)
- CALL CRIGHT (LINE,1,32)
- N = 39
- IFPRNT = MOPTIO(17)
- GO TO 51
-
-C-- Deck header is +DECK, name
-
- 44 JCCTYP = MCCDEC
- CALL CCKRAK (JSLF)
- IXEXDEC = MCCPAR(JCCPD+1)
- IF (IXEXDEC.EQ.0) GO TO 92
- CALL NA_GET (IXEXDEC, LINE,41)
- N = NESLAT - 1
- IFPRNT = MOPTIO(16) + MOPTIO(17)
-
-C---- choose next deck from "old" or "merge"
-
- 51 IF (IXMGPAT.LT.0) GO TO 56
- IF (IXMGPAT.NE.0) THEN
- IF (IXMGPAT.NE.IXEXPAT) GO TO 56
- ENDIF
-
- IF (IXMGDEC.EQ.IXEXDEC) GO TO 61
-
-C---- send deck from "old"
-
-C- | pname | num | . | dname
-C- 1 33 38 41
-
- 56 IF (IFPRNT.EQ.0) THEN
- CALL CSETDI (NQDKNO, LINE,34,37)
- COL(39) = '.'
- WRITE (IQPRNT,9056) LINE(1:N)
- NQLLBL = 0
- ENDIF
- 9056 FORMAT (1X,A)
-
- CALL MESEND (JSLF,NSLF)
- GO TO 41
-
-C---- send deck from "merge"
-
- 61 IF (MOPTIO(17).NE.0) GO TO 67
- IF (MOPTIO(16).EQ.0) THEN
- COL(39) = '-'
- WRITE (IQPRNT,9056) LINE(1:N)
- NQLLBL = 0
- ENDIF
-
- LINE = ' '
- IF (IXMGDEC.EQ.0) THEN
- CALL NA_GET (IXMGPAT, LINE,1)
- CALL CRIGHT (LINE,1,32)
- N = 39
- ELSE
- CALL NA_GET (IXMGDEC, LINE,41)
- N = NESLAT - 1
- ENDIF
- CALL CSETDI (NQDKNO, LINE,34,37)
- COL(39) = '+'
- WRITE (IQPRNT,9056) LINE(1:N)
- NQLLBL = 0
-
- 67 CALL MESEND (JSLM,NSLM)
- 68 CALL TOGARB (KQUSER,0)
- GO TO 31
-
-C------ Done
-
- 71 CALL DPBLAN (0)
- IF (LQUSER(1).EQ.0) RETURN
-
-C-- "merge" file has not been exhausted
-
- LINE = 'd='
- CALL NA_GET (IXMGDEC, LINE,3)
- N = NESLAT
- IF (IXMGPAT.GT.0) THEN
- LINE(N+1:N+5) = 'of p='
- CALL NA_GET (IXMGPAT, LINE,N+6)
- N = NESLAT
- ENDIF
-
- WRITE (IQPRNT,9074) LINE(1:N-1)
- 9074 FORMAT (' ***!!! ',A,' has not been found.')
-
- CALL P_KILL ('the merge file has not been consumed')
-
-C---- faulty c/l
-
- 91 LINE = ' merge:'
-C- _:.=+=.:_1
- JSL = JSLM
- GO TO 93
-
- 92 LINE = ' old:'
- JSL = JSLF
-
- 93 CALL DPBLAN (0)
- CALL LN_GET (JSL,LINE(9:),70)
- N = NDSLAT + 8
-
- WRITE (IQPRNT,9093) LINE(1:N)
- 9093 FORMAT (' ***!!! faulty control line:'/3X,A)
- CALL P_KILL ('fatal')
-
-C---- Help
-
- 81 WRITE (IQPRNT,9081)
- RETURN
-
- 9081 FORMAT (
- F ' nymerge merge.car old.car new.car options print'/
- F/' Merge "merge" into "old" copying to "new" with matching'
- F/' decks from "merge" overruling their brothers on "old".'
- F/' This is a purely sequential process, the decks on "merge"'
- F/' have to be in the right order.'/
- F/' options: U update the PAM file titles;'
- F/' F update only the first PAM title;'
- F/' M main release: update the primary version number;'
- F/' P ponly - log only the patch names;'
- F/' Q quick - no log printing;'
- F/' H print this help information only.')
- END
diff --git a/src/p5boot/p5lib/exshell.f b/src/p5boot/p5lib/exshell.f
deleted file mode 100644
index d17f0fb..0000000
--- a/src/p5boot/p5lib/exshell.f
+++ /dev/null
@@ -1,329 +0,0 @@
-CDECK ID>, EXSHELL.
- SUBROUTINE EXSHELL
-
-C- Run nyshell
-C. started 20-jan-94
-
- COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT,NUSLAT(2),DUMMY(34)
- PARAMETER (KM1=1,KM2=2,KM3=4,KM4=8,KM5=16,KM6=32,KM7=64,KM8=128,
- + KM9=256, KM10=512, KM11=1024, KM12=2048, KM13=4096, KM14=8192,
- + KM15=16384, KM16=32768, KM17=65536, KM18=131072, KM19=262144,
- + KM20=524288, KM21=1048576, KM22=2097152, KM23=4194304,
- + KM24=8388608, KM25=16777216, KM26=33554432, KM27=67108864,
- + KM28=134217728, KM29=268435456, KM30=536870912, KM31=1073741824)
- PARAMETER (KMA=1,KMB=2,KMC=4,KMD=8,KME=16,KMF=32,KMG=64,KMH=128,
- + KMI=256, KMJ=512, KMK=KM11, KML=KM12, KMM=KM13, KMN=KM14,
- + KMO=KM15, KMP=KM16, KMQ=KM17, KMR=KM18, KMS=KM19, KMT=KM20,
- + KMU=KM21, KMV=KM22, KMW=KM23, KMX=KM24, KMY=KM25, KMZ=KM26)
- COMMON /QUNIT/ IQREAD,IQPRNT, IQTTIN,IQTYPE, IQOFFL,IQRTTY,IQRSAV
- +, IQRFD,IQRRD,IQRSIZ, NQLPAT,NQUSED,NQLLBL, NQINIT
- COMMON /LUNSLN/IFLAUX, IXLUN(12)
- PARAMETER (NSLIFI=128)
- CHARACTER CHLIFI*(NSLIFI), CHLIEX*8
- COMMON /FLINKC/LUNOP,LUNFD,LUNOLD,LUNSIZ
- +, IXFLUN, NLIFI,CHLIFI,CHLIEX
- PARAMETER (NTYSZ=4, NACSZ=4, NLNSZ=4, NRTSZ=10000)
- CHARACTER CHNLOG*80, CODEX*8, CHTYP*8
- COMMON /SHMKC/ NNLOG,CHNLOG, CODEX, CHTYP(17)
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
- +, NLINST(4,NACSZ,NTYSZ), IXINST(NLNSZ,4,NACSZ,NTYSZ)
- +, NCOUNTR(4,NTYSZ), NCSUMR(NTYSZ)
- +, NCOUNTH(4,NTYSZ), NCSUMH(NTYSZ), IXOPTN(4,3), IXOPTP(4,3)
- +, NRXQT, NROUT, NNAME(NRTSZ), NRALLC, NRDEL
- +, LUNSH, IXOBJ, IXSDIR, JXTYP, JXACT, JXSTR, LASTSH
-C-------------- End CDE --------------------------------
- CHARACTER CHFSH*64, CHFIN*128, CHNAME*32, CHDO*2
- PARAMETER (MASK= KMA + KMB + KME + KMH + KMQ + KMS + KMU + KMV)
-
- IAND (IZV,IZW) = AND (IZV, IZW)
- ISHFTR (IZW,NZB) = ISHFT (IZW, -NZB)
-
-
- CALL INIAUX (LASTSH)
- CALL KROPT (IXLUN(2),MASK)
-
- MOPTIO(2) = MAX (MOPTIO(1), MOPTIO(2))
-
- IXFILE = IXLUN(1)
- IF (IXFILE.LE.0) IXFILE = NA_LONG (' f.e')
- CALL FLSPLIT (IXFILE, IXSDIR, IXSFN, IXSEXT)
-
- CHNLOG = ' '
- CALL NA_GET (IXSFN,CHNLOG,1)
- NNLOG = NDSLAT
-
- CHFIN = ' '
- CALL NA_GET (IXFILE,CHFIN,1)
- NCHFIN = NDSLAT
- IF (MOPTIO(8).NE.0) IXLUN(1) = -7
-
-C---- Load the defaults
-
- CALL SMDEF
-
- CALL SMCIL (-1, 'start' , '# Script from nyshell for file '
- + // CHFIN(1:NCHFIN))
- CALL SMCIL (-1, 'end' , '# End of the shell script')
-
-C---- Load the compile-instructions from the cradle
-
- IF (IQREAD.NE.0) CALL SMCINST
- IF (IQREAD.LT.0) IXLUN(1)= -1
-
-C---- Pre-delete the script yyy.shfca
-
- CHFSH = CHNLOG(1:NNLOG) // '.shfca'
- NCHFSH = NNLOG + 6
-
- LUNSH = 21
- CHLIFI = CHFSH(1:NCHFSH)
- NLIFI = NCHFSH
- CALL FLINK (LUNSH, -1, 0, 0)
-
-C---- Print the Help information
-
- IF (IXLUN(1).LE.0) THEN
- IF (MOPTIO(19).EQ.0) THEN
- WRITE (IQPRNT,9002)
- WRITE (IQPRNT,9003)
- WRITE (IQPRNT,9004)
- WRITE (IQPRNT,9005)
- WRITE (IQPRNT,9006)
- WRITE (IQPRNT,9007)
- ENDIF
- MOPTIO(17) = 0
- MOPTIO(22) = 1
- ENDIF
-
-C---- Print the run information
-
- WRITE (IQPRNT,9026) CHFIN(1:NCHFIN), CHFSH(1:NCHFSH)
- +, CHNLOG(1:NNLOG)
- 9026 FORMAT (' Input file: ',A
- F/ ' Shell script: ',A
- F/ ' Log file: ',A,'.xqtlog')
-
- IF (MOPTIO(17).NE.0) GO TO 29
- WRITE (IQPRNT,9027)
- 9027 FORMAT (/' Actual set-up used:')
- CALL SMDISP (4)
- DO 28 JTYP=1,3
- CALL SMDISP (JTYP)
- 28 CONTINUE
- CALL SMDISP (5)
- CALL SMDISP (6)
- 29 IF (IXLUN(1).LE.0) GO TO 81
-
-C---- Load the .xqtlog and .log files with the routine names
-
- CALL SMJOPT
- IF (MOPTIO(21).NE.0) THEN
- IF (MOPTIO(2).EQ.0) CALL SMRXQT
- ENDIF
- CALL SMRLOG
-
-C---- Delete all .o files which are not part of the program
-
- IF (MOPTIO(21).NE.0) CALL SHUPTO
-
-C------ Write the shell script ------------------
-
-C-- open the .shfca file
-
- CHLIFI = CHFSH(1:NCHFSH)
- NLIFI = NCHFSH
- CALL FLINK (LUNSH, 5, 0, 0)
-
-C-- write the script header
-
- CALL SHWSTA (1)
- IF (NRALLC.EQ.0) GO TO 49
-
-C-- write the compile instructions for each file
-
-C- NNAME(JR) = ((IXNAME*8 + JXTYP)*8 + JXSTR)*4 + IFLNEW
-C- IFLNEW has bit 2 set if .o file exists
-C- bit 1 set if recompilation forced
- DO 47 JRT=NRXQT+1,NROUT
- JJ = NNAME(JRT)
- IF (IAND(JJ,3).EQ.2) GO TO 47
- JJ = ISHFTR(JJ,2)
- JSTR = IAND (JJ,7)
- JJ = ISHFTR (JJ,3)
- JTYP = IAND (JJ,7)
- IXNA = ISHFTR (JJ,3)
-
- CALL NA_GET (IXNA, CHNAME, 1)
- NN = NDSLAT
- CALL SHWCOMP (JTYP,JSTR, CHNAME(1:NN))
- 47 CONTINUE
-
-C-- write the apreslude
-
- CALL SHWSTA (2)
-
- 49 CLOSE (LUNSH)
- CALL SYSTEMF ('chmod 755 *.shfca')
-C---- Print the summary
-
- WRITE (IQPRNT,9053)
- IF (NRALLC.EQ.0) GO TO 57
-
- CHDO = 'Do'
- JA = 4
- DO 54 JT=1,3
- DO 53 JS=1,4
- N = NCOUNTR(JS,JT)
- IF (N.EQ.0) GO TO 53
- CHNAME(1:8) = ' '
- CALL SMSID (JT,JS,CHNAME,1)
- WRITE (IQPRNT,9053) CHDO,N,CHNAME(1:6)
- 9053 FORMAT (6X,A,I5,' files for ',A)
- CHDO = ' '
- 53 CONTINUE
- 54 CONTINUE
-
-C---- Write the new .xqtlog file
-
- 57 CALL SHWXQT
- IF (NRALLC+NRDEL.EQ.0) GO TO 94
-
-C---- Done
-
- IF (MOPTIO(21).EQ.0) RETURN
- IF (MOPTIO(22).EQ.0) THEN
- IF (NRDEL.EQ.0) RETURN
- ENDIF
- CALL NA_GET (IXOBJ, CHNAME,1)
- NC = NDSLAT
- WRITE (IQPRNT,9057) NRDEL, CHNAME(1:NC)
- 9057 FORMAT (8X,I5,' orphan ',A,' files deleted')
- RETURN
-
- 9002 FORMAT (' nyshell x.log options read print'/
- F/' translates the nypatchy output file x.log for SPLIT or MODIFY'
- F/' mode into the shell-script x.shfca to compile the wanted'
- F/' routines as specified by the options, and according to the'
- F/' compilation rules defined by the "set-up". Nyshell has a'
- F/' default set-up which can be modified by the user with control'
- F/' lines given on the "read" stream. Nyshell writes the script'
- F/' x.shfca and also the file x.xqtlog recording the state which'
- F/' should be achieved with this run, to be used in the next run.'/
- F/' Nyshell and the resulting script x.shfca must be run in the'
- F/' directory where the resulting .o files are to be.'/
- F/' "options": A all - compile or re-compile all files'
- F/' B bypass the use of the input .xqtlog file'
- F/' E empty - bypass the .xqtlog file if it is empty'
- F/' H help - print this help information only'
- F/' Q quick - do not display the set-up information'
- F/' U uptodate - check that all .o files in the'
- F/' current directory are ready to be'
- F/' put into the last-version library'
- F/' V verbose - display the complete set-up.')
- 9003 FORMAT (
- F ' "read": name of the file with the user set-up commands,'
- F/' tty if standard input to be used,'
- F/' eof if default set-up to be used as is.'
- F/' "print" printed output file.'/
- F/' The set of routines to be handled is defined by the log file.'
- F/' If the "A" option is given all routines are to be compiled.'
- F/' If the "U" option is not given only the routines which do not'
- F/' have the "same" flag on the log are to be compiled.'
- F/' If the "U" option is given nyshell will make sure that all'
- F/' the .o files are up-to-date: a routine does not need'
- F/' recompilation only if it meets all these criteria:'
- F/' 1) the "same" flag is present,'
- F/' 2) the compiler options are the same as last time,'
- F/' 3) a re-compilation ordered last time has been done,'
- F/' 4) the .o file is more recent than the .f file,'
- F/' 5) the .o file is more recent than any .h file called.'
- F/' Also: delete all .o files in the current directory whose'
- F/' names to not appear in the log file.')
- 9004 FORMAT (
- F/' Set-up commands, given on "read", may be used to modify'
- F/' the default set-up. The "tag", starting before column 7,'
- F/' identifies the set-up parameter to be changed.'
- F/' An empty tag signals a continuation line. The text after'
- F/' gives the new content.'
- F/' The commands which would generate the set-up used will be'
- F/' printed at the end, unless the Quick option has been given.'
- F/' These are the possible set-up commands:'//' for Fortran:'/
- F/' fo:1 options special to stream :1'
- F/' fo:2 to stream :2'
- F/' fo:3 to stream :3'
- F/' fo:4 to stream :4'
- F/' fopt compiler options common to all streams'
- F/' fc the name of the Fortran compiler'
- F/' fort:1 command to compile a file for stream :1'
- F/' fort:2 for stream :2'
- F/' fort:3 for stream :3'
- F/' fort:4 for stream :4')
- 9005 FORMAT (/' for the C language:'/
- F/' co:1 options special to stream :1'
- F/' co:2 to stream :2'
- F/' co:3 etc.'
- F/' copt compiler options common to all streams'
- F/' cc the name of the C compiler'
- F/' cc:1 command to compile a file for stream :1'
- F/' cc:2 for stream :2'
- F/' cc:3 etc.'/
- F/' for the assembler:'/
- F/' ao:1 options special to stream 1'
- F/' ao:2 etc.'
- F/' aopt assembler options common to all streams'
- F/' as the name of the assembler'
- F/' as:1 command to assemble a file for stream :1'
- F/' as:2 etc.')
- 9006 FORMAT (/' start and end of the shell-script:'/
- F/' start shell commands ahead'
- F/' end shell commands added at the end'/
- F/' where-abouts of the source files:'/
- F/' sdir name, default is directory part of the input file'
- F/' (normally this is empty, ie. the current w.dir.)')
- 9007 FORMAT (
- F/' The special set-up parameter "by" for fort:i, cc:i, as:i'
- F/' requests not to compile the files of this stream.'
- F/' The special set-up parameter "=:1", for example, given'
- F/' for fort:i, cc:i, as:i requests the files of this stream'
- F/' to be processed as for stream :1.'
- F/' Given for fo:i, co:i, as:i it is a request to use for this'
- F/' stream the same options as for stream :1.'/
- F/' Nyshell converts the set-up parameters into shell parameters'
- F/' and puts their definitions at the beginning of the script.'/
- F/' Status returned by nyshell on Unix is =0 normally,'
- F/' =1 for zero routines to be recompiled, >1 for bad data.'/)
-
-C---- Trouble
-
- 81 IF (IXLUN(1).EQ.0) THEN
- WRITE (IQPRNT,9080)
- ELSEIF (IXLUN(1).EQ.-1) THEN
- WRITE (IQPRNT,9081)
- ENDIF
- CALL EXITRC (2)
-
- 9080 FORMAT (/' ***!!! No file-name given, no execution !!!***')
- 9081 FORMAT (/' ***!!! Errors on input, no execution !!!***')
- 9094 FORMAT (/' **!! Zero routines to be compiled !!**')
- 9095 FORMAT (/' **!! No routines to be compiled or deleted !!**')
-
- 94 IF (MOPTIO(21).EQ.0) THEN
- WRITE (IQPRNT,9094)
- ELSE
- WRITE (IQPRNT,9095)
- ENDIF
- CALL EXITRC (1)
- END
diff --git a/src/p5boot/p5lib/exsynopt.f b/src/p5boot/p5lib/exsynopt.f
deleted file mode 100644
index ad190e1..0000000
--- a/src/p5boot/p5lib/exsynopt.f
+++ /dev/null
@@ -1,128 +0,0 @@
-CDECK ID>, EXSYNOPT.
- SUBROUTINE EXSYNOPT
-
-C- Run nysynopt
-C. started 18-july-95
-
- PARAMETER (KM1=1,KM2=2,KM3=4,KM4=8,KM5=16,KM6=32,KM7=64,KM8=128,
- + KM9=256, KM10=512, KM11=1024, KM12=2048, KM13=4096, KM14=8192,
- + KM15=16384, KM16=32768, KM17=65536, KM18=131072, KM19=262144,
- + KM20=524288, KM21=1048576, KM22=2097152, KM23=4194304,
- + KM24=8388608, KM25=16777216, KM26=33554432, KM27=67108864,
- + KM28=134217728, KM29=268435456, KM30=536870912, KM31=1073741824)
- PARAMETER (KMA=1,KMB=2,KMC=4,KMD=8,KME=16,KMF=32,KMG=64,KMH=128,
- + KMI=256, KMJ=512, KMK=KM11, KML=KM12, KMM=KM13, KMN=KM14,
- + KMO=KM15, KMP=KM16, KMQ=KM17, KMR=KM18, KMS=KM19, KMT=KM20,
- + KMU=KM21, KMV=KM22, KMW=KM23, KMX=KM24, KMY=KM25, KMZ=KM26)
- PARAMETER (NBANKS=19,JBKPAT=1, JBKDEC=2, JBKORG=3, JBKINC=4,
- + JBKHOL=5, JBKKEE=6, JBKACT=7, JBKMAT=8, JBKXSQ=9,
- + JBKPRE=10,JBKGAR=11,JBKSMH=12,JBKSMT=13,JBKSML=14,
- + JBKSMX=15,JBKARR=16,JBKASA=17,JBKPAM=18,JBKRPA=19)
- COMMON /QBANKS/MMBANK(5,NBANKS)
- COMMON /QPAGE/ NQLMAX,NQLTOL,NQLTOK,NQCMAX,NQCPGH,NQPAGE
- +, NQWYLDO,NQWYL,NQNEWH,NQJOIN,NQDKNO,NQDKPG
- COMMON /QUNIT/ IQREAD,IQPRNT, IQTTIN,IQTYPE, IQOFFL,IQRTTY,IQRSAV
- +, IQRFD,IQRRD,IQRSIZ, NQLPAT,NQUSED,NQLLBL, NQINIT
- COMMON /LUNSLN/IFLAUX, IXLUN(12)
- COMMON /MUSEBC/ MX_FORC, MU_GLOB, MU_PAT, MU_DECK, MU_INH, MU_FORG
- +, MX_TRAN, MX_FORG, MX_SINH, MX_SELF, NVEXDK(6)
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
-C-------------- End CDE --------------------------------
- PARAMETER (MASK= KMH + KME + KMS + KMI + KMM + KMX + KMY + KMZ)
-
- DIMENSION MMKEEP(4)
- DATA MMKEEP / 1, 4, 2, 4 /
-
-
- CALL INIAUX (LASTWK)
- NQUSED = 12
-
- CALL KROPT (IXLUN(2),MASK)
- CALL PGSIZE (0, IXLUN(2))
- IF (MOPTIO(8).NE.0) GO TO 81
-
- IF (MOPTIO(19).NE.0) THEN
- MOPTIO(19) = 0
- ELSE
- MOPTIO(3) = 1
- MOPTIO(5) = 0
- ENDIF
- MOPTIO(6) = 1
- CALL PKBYT (MOPTIO(1),MOPTIO(33),1,32,0)
-
- NQCPGH = 120
-
- CALL UCOPY (MMKEEP, MMBANK(2,JBKKEE), 4)
-
-C-- set MOPUPD such that all IF's are true in CCPROC
-
- MOPUPD = -1
-
-C-- Get the cradle into memory
-
- INCRAD = 3
- IF (IQREAD.NE.0) CALL ARRIVE (0)
-
-C-- Complete the initialization
-
- CALL PINIT2
- MU_GLOB = MU_GLOB + KM5
- CALL SBIT0 (MU_GLOB,6)
-
-C-- Do the cradle initially
-
- CALL SYCRAD
- IF (JANSW.NE.0) GO TO 89
-
-C-- Do next PAM file
-
- 41 INCRAD = 0
- CALL SYPAM
-
-C-- Do cradle continuation
-
- INCRAD = 2
- CALL SYCRAD
- IF (JANSW.EQ.0) GO TO 41
- GO TO 89
-
-C---- Help
-
- 81 WRITE (IQPRNT,9081)
-
- 89 CALL PGSIZE (1, 0)
- RETURN
-
- 9081 FORMAT (' nysynopt pam.car options read.cra print'/
- F/' reads the "pam" file printing on "print" a numbered'
- F/' listing of the whole file, much like Nylist, but normally'
- F/' with sequence-calls expanded and actions signalled.'
- F/' The operation can be controlled in some detail by giving'
- F/' a cradle; if this is not needed "EOF" should be'
- F/' given for "read".'/
- F/' "options": H help - print this help information only'
- F/' S start - start each deck on a new page,'
- F/' unless T=JOIN present'
- F/' E eject - honour the pseudo sequence calls'
- F/' +SEQ, QEJECT, N=n.'
- F/' M missing sequences to be signalled'
- F/' I line numbers separate for individual PAM files'
- F/' X do not signal actions'
- F/' Y do not expand +CDE calls'
- F/' Z do not expand +SEQ calls'
- F/' 0 ... 4 - select page size by single digit option'
- F/' "n" - set page size to be n > 19')
- END
diff --git a/src/p5boot/p5lib/extidy.f b/src/p5boot/p5lib/extidy.f
deleted file mode 100644
index cc57a29..0000000
--- a/src/p5boot/p5lib/extidy.f
+++ /dev/null
@@ -1,173 +0,0 @@
-CDECK ID>, EXTIDY.
- SUBROUTINE EXTIDY
-
-C- Run nytidy
-C. started 26-may-94
-
- COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT,NUSLAT(2),DUMMY(34)
- CHARACTER SLLINE*512, SLERRM*256
- COMMON /SLATLN/ SLLINE, SLERRM
- PARAMETER (KM1=1,KM2=2,KM3=4,KM4=8,KM5=16,KM6=32,KM7=64,KM8=128,
- + KM9=256, KM10=512, KM11=1024, KM12=2048, KM13=4096, KM14=8192,
- + KM15=16384, KM16=32768, KM17=65536, KM18=131072, KM19=262144,
- + KM20=524288, KM21=1048576, KM22=2097152, KM23=4194304,
- + KM24=8388608, KM25=16777216, KM26=33554432, KM27=67108864,
- + KM28=134217728, KM29=268435456, KM30=536870912, KM31=1073741824)
- PARAMETER (KMA=1,KMB=2,KMC=4,KMD=8,KME=16,KMF=32,KMG=64,KMH=128,
- + KMI=256, KMJ=512, KMK=KM11, KML=KM12, KMM=KM13, KMN=KM14,
- + KMO=KM15, KMP=KM16, KMQ=KM17, KMR=KM18, KMS=KM19, KMT=KM20,
- + KMU=KM21, KMV=KM22, KMW=KM23, KMX=KM24, KMY=KM25, KMZ=KM26)
- COMMON /QUNIT/ IQREAD,IQPRNT, IQTTIN,IQTYPE, IQOFFL,IQRTTY,IQRSAV
- +, IQRFD,IQRRD,IQRSIZ, NQLPAT,NQUSED,NQLLBL, NQINIT
- COMMON /LUNSLN/IFLAUX, IXLUN(12)
- PARAMETER (NSLIFI=128)
- CHARACTER CHLIFI*(NSLIFI), CHLIEX*8
- COMMON /FLINKC/LUNOP,LUNFD,LUNOLD,LUNSIZ
- +, IXFLUN, NLIFI,CHLIFI,CHLIEX
- COMMON /DEPCOM/JD_NEW, JD_DTN, JD_DTP, JD_DTD, JD_DIV
- +, JD_SML, JD_SMP, JD_SMX, JDP_DT, JDP_DV
- +, JD_SPL, JD_MOD, JD_LUN, JD_LOG, JD_NLI, JD_MULT
- +, IX_EXT, IX_RH, IX_SUB
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
- +, IXBLADK, IXSQSP(7), NTRBLA,NMODIF, JSLTTL, LASTTI
-C-------------- End CDE --------------------------------
- INTEGER RENAMEF
- PARAMETER (MASK= KMB + KMC + KMH + KMV)
-
-
- CALL INIAUX (LASTTI)
-
- CALL KROPT (IXLUN(3),MASK)
- IF (MOPTIO(8).NE.0) GO TO 81
- MOPTIO(2) = 0
-
- CALL INIPAM (11, IXLUN(1), 1,0)
-
- IXBLADK = NA_LONG ('BLANKDEK')
- IXSQSP(1) = NA_LONG ('DATEQQ')
- IXSQSP(2) = NA_LONG ('TIMEQQ')
- IXSQSP(3) = NA_LONG ('VERSQQ')
- IXSQSP(4) = NA_LONG ('VIDQQ')
-
- IFLOVW = 0
- IF (IXLUN(2).EQ.0) GO TO 24
-
-C-- check "new" is a pure directory
-
- CALL FLSPLIT (IXLUN(2),IXDIR,IXFN,IXEXT)
- IF (IXFN.NE.0) GO TO 27
- CALL FLSPLIT (IXLUN(1),IXD,IXFN,IXEXT)
- IF (IXD.EQ.IXDIR) CALL P_KILL ('clashing file names')
- GO TO 26
-
-C-- derive the name of "new" if not given
-
- 24 IFLOVW = 7
- CALL FLSPLIT (IXLUN(1),IXDIR,IXFN,IXEXT)
- IXEXT = NA_LONG ('.tdy')
- 26 CALL FLJOIN (IXDIR,IXFN,IXEXT,IXLUN(2))
-
-C-- open the output file
-
- 27 JD_LUN = 21
- CALL FLINK (JD_LUN,6,IXLUN(2),0)
- JD_LUN = LUNFD
- WRITE (IQTYPE,9029) CHLIFI(1:NLIFI)
- 9029 FORMAT (' Writing file: "',A,'"'/)
-
-C------ Load the title deck to memory ------------
-
- 41 IF (JDKNEX.EQ.0) THEN
- CALL ARRIVE (2)
- CALL TIDISTB
- NTRBLA = NTRBLA + IQUEST(1)
- ENDIF
-
-C---- Handle the PAM-file title line
-
- JDKTYP = 3
- CALL KRTITL
- JSLTTL = IQ(LARRV+10)
- CALL USETT (JSLTTL)
-
- CALL LN_GET (JSLTTL, SLLINE, 72)
- NTXT = NDSLAT
-
- CALL DPBLAN (0)
- WRITE (IQPRNT,9044) SLLINE(1:NTXT)
- IF (IQPRNT.NE.IQTYPE) WRITE (IQTYPE,9044) SLLINE(1:NTXT)
- 9044 FORMAT (' Read Pam file: ',A/)
-
-C------ Loop over all decks until next title
-
- CALL TIDECK
- IF (JDKTYP.EQ.3) GO TO 41
-
-C-- close output
- CALL CICLOS (JD_LUN)
-C-- close input
- CALL INIPAM (0,0, -1,0)
-
- CALL DPBLAN (0)
- WRITE (IQPRNT,9071) NMODIF,NTRBLA
- IF (IQPRNT.NE.IQTYPE) WRITE (IQTYPE,9071) NMODIF,NTRBLA
- 9071 FORMAT (I8,' changes done,',I7,' lines with trailing blanks.'/)
-
- IF (IFLOVW.EQ.0) RETURN
-
-C-- delete the new file if overwriting and unchanged
-
- IF (NMODIF+NTRBLA.EQ.0) THEN
- CALL FLNAME (IXLUN(2),N)
- CALL UNLINKF (CHLIFI(1:NLIFI))
- RETURN
- ENDIF
-
-C-- rename "new" to "pam"
-
- CALL FLNAME (IXLUN(1), N)
- NIN = NLIFI
- SLLINE(1:NIN) = CHLIFI(1:NIN)
-
- CALL FLNAME (IXLUN(2),N)
-
- WRITE (IQTYPE,9077) CHLIFI(1:NLIFI),SLLINE(1:NIN)
- 9077 FORMAT (' Renaming file: ',A
- F/ ' to: ',A/)
-
- ISTAT = RENAMEF (CHLIFI(1:NLIFI), SLLINE(1:NIN))
-
- IF (ISTAT.EQ.0) RETURN
- CALL P_KILLM ('Rename new to old failed')
- RETURN
-
-C---- Help
-
- 81 WRITE (IQPRNT,9081)
- RETURN
-
- 9081 FORMAT (' nytidy pam.car new.car options print'/
- F/' copies "pam" to "new" with some tidying-up:'
- F/' - remove trailing blanks'
- F/' - remove lead/trailing comment lines in decks of type FORT'
- F/' - translate non-standard sequence calls'/
- F/' options: C the input is a CMZ output file'
- F/' H help - print this help information only'
- F/' V verbose - print each modification'/
- F/' If "new" is not given the result will overwrite "pam".'
- F/' If "new" is given as a directory (with / at the end) it will'
- F/' inherit file-name and extension from "pam".')
- END
diff --git a/src/p5boot/p5lib/failcc.f b/src/p5boot/p5lib/failcc.f
deleted file mode 100644
index 9f96de9..0000000
--- a/src/p5boot/p5lib/failcc.f
+++ /dev/null
@@ -1,43 +0,0 @@
-CDECK ID>, FAILCC.
- SUBROUTINE FAILCC (JSEVER,MSG)
-
-C- Print faulty control line pointed to by bank at LDOAN
-C. started 29-jan-92
-
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
- COMMON /M_ANAC/LOWAN,KDOAN,LDOAN,LUPAN,MODEAN,MEXAN,LEVAN,KKM5AN
- +, NEWDEC,NEWCTL,NEWFOR,NEWNIL,NEWINC
-C-------------- End CDE --------------------------------
- CHARACTER MSG*(*)
-
-
- IF (LDOAN.EQ.0) GO TO 24
- JSL = IQ(LDOAN+1)
- IF (LUPAN.EQ.0) THEN
- NUM = JSL - JSLORG
- LORG = 0
- ELSE
- NUM = IQ(LDOAN+3)
- LORG = LQ(LDOAN-2)
- ENDIF
- CALL FAILLN (JSEVER,LORG,NUM,JSL,MSG)
- RETURN
-
-C-- At end of deck
-
- 24 CALL FAILLN (JSEVER,0,0,0,MSG)
- RETURN
- END
diff --git a/src/p5boot/p5lib/failln.f b/src/p5boot/p5lib/failln.f
deleted file mode 100644
index 749344d..0000000
--- a/src/p5boot/p5lib/failln.f
+++ /dev/null
@@ -1,82 +0,0 @@
-CDECK ID>, FAILLN.
- SUBROUTINE FAILLN (JSEVER,LORGP,NUMORG,JSLFAU,MSG)
-
-C- Print faulty control-line, where
-C- JSEVER 0 warning, 1 error, 2 fatal
-C- LORG adr of the origin deck, if zero: current
-C- NUMORG Patchy line-number
-C- JSLFAU slot number of the line
-C- MSG text of the message to be printed
-
- COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT,NUSLAT(2),DUMMY(34)
- CHARACTER SLLINE*512, SLERRM*256
- COMMON /SLATLN/ SLLINE, SLERRM
- COMMON /QUNIT/ IQREAD,IQPRNT, IQTTIN,IQTYPE, IQOFFL,IQRTTY,IQRSAV
- +, IQRFD,IQRRD,IQRSIZ, NQLPAT,NQUSED,NQLLBL, NQINIT
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
-C-------------- End CDE --------------------------------
- CHARACTER MSG*(*)
- CHARACTER LINE*80, TAIL*64
- EQUIVALENCE (LINE, SLLINE), (TAIL, SLLINE(51:))
-
-
-
- LORG = LORGP
- NUM = NUMORG
- JSL = JSLFAU
-
- CALL FAILMSG (JSEVER,3, 0,MSG)
- IF (NDSLAT.EQ.0) RETURN
-
-C-- foreign material
-
- IF (LORG.EQ.0) GO TO 41
- LINE = ' !!'
- NDK = JBYT (IQ(LORG),1,16)
- CALL CSETDI (NDK,TAIL,1,12)
- CALL CLEFT (TAIL,4,12)
- J = NESLAT
-
- TAIL(J:J) = '='
- J = J + 1
- CALL NA_GET (IQ(LORG+1),TAIL,J)
- J = NESLAT
-
- TAIL(J:J) = '.'
- J = J + 1
- CALL NA_GET (IQ(LORG+2),TAIL,J)
- NN = NESLAT - 1
- NOV = NN - 30
- IF (NOV.GT.0) THEN
- CALL CCOPYL (TAIL,LINE(51-NOV:),NN)
- NN = NN - NOV
- ENDIF
- NN = NN + 50
- WRITE (IQPRNT,9036) LINE(1:NN)
- NQUSED = NQUSED + 1
-
- 41 NQUSED = NQUSED + 2
- IF (JSL.EQ.0) GO TO 44
- JTX = MLIAD(JSL)
- NTX = MLIAD(JSL+1) - JTX - NCHNEWL
- NTX = MIN (80, NTX)
- CALL CCOPYL (TEXT(JTX),LINE,NTX)
- WRITE (IQPRNT,9041) NUM,LINE(1:NTX)
- GO TO 49
-
- 44 WRITE (IQPRNT,9044)
- 49 IF (JSEVER.GE.2) CALL P_FATAL ('this')
- NQLLBL = 1
- RETURN
-
- 9036 FORMAT (A)
- 9041 FORMAT (1X,I5,' ! ',A/)
- 9044 FORMAT (8X,'! at end-of-deck'/)
- END
diff --git a/src/p5boot/p5lib/failmsg.f b/src/p5boot/p5lib/failmsg.f
deleted file mode 100644
index 5dec35d..0000000
--- a/src/p5boot/p5lib/failmsg.f
+++ /dev/null
@@ -1,76 +0,0 @@
-CDECK ID>, FAILMSG.
- SUBROUTINE FAILMSG (JSEVER,NSPACE,NBLANK,MSG)
-
-C- Print warning/error message, where
-C- JSEVER severity: -1 info, 0 warning, 1 error, 2 fatal
-C- NSPACE = -1 no page-eject to glue to last line printed
-C- 0 no blank line before
-C- >0 number of lines needed together
-C-
-C- return NDSLAT >0 normal printing
-C- 0 suppress printing, maximum number passed
-
- COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT,NUSLAT(2),DUMMY(34)
- CHARACTER CQBLAN*128, CQEQS*128, CQCETA*32
- CHARACTER CQAPO*1, CQBSL*1, CQTAB*1
- COMMON /QCHAR/ CQBLAN, CQEQS, CQCETA, CQAPO, CQBSL, CQTAB
- COMMON /QPAGE/ NQLMAX,NQLTOL,NQLTOK,NQCMAX,NQCPGH,NQPAGE
- +, NQWYLDO,NQWYL,NQNEWH,NQJOIN,NQDKNO,NQDKPG
- CHARACTER CQDATEM*10, CQDATE*8, CQTIME*5
- COMMON /QSTATE/NQERR,NQWARN,NQINFO,NQLOCK
- +, IQDATE,IQTIME, CQDATEM,CQDATE,CQTIME
- COMMON /QUNIT/ IQREAD,IQPRNT, IQTTIN,IQTYPE, IQOFFL,IQRTTY,IQRSAV
- +, IQRFD,IQRRD,IQRSIZ, NQLPAT,NQUSED,NQLLBL, NQINIT
- COMMON /LUNSLN/IFLAUX, IXLUN(12)
-C-------------- End CDE --------------------------------
- CHARACTER MSG*(*)
-
-
- NN = NSPACE
- NB = MAX (NBLANK, 1)
- NDSLAT = 0
- IF (JSEVER.LT.0) THEN
- NQINFO = MIN (NQINFO+1, 999)
- IF (NQINFO.GE.199) RETURN
- ELSEIF (JSEVER.EQ.0) THEN
- NQWARN = MIN (NQWARN+1, 999)
- IF (NQWARN.GE.199) RETURN
- ELSE
- NQERR = MIN (NQERR+1, 999)
- IF (NQERR.GE.199) THEN
- IF (JSEVER.EQ.1) RETURN
- ENDIF
- ENDIF
-
- IF (NN.LT.0) GO TO 41
- IF (NQNEWH.NE.0) GO TO 31
- IF (NN+1.LT.NQLTOK) GO TO 40
- NQUSED = NQLTOK
-
- 31 CALL DPHEAD
- GO TO 41
-
- 40 IF (NN.NE.0) CALL DPBLAN (1)
-
- 41 IF (JSEVER.LT.0) THEN
- WRITE (IQPRNT,9041) CQBLAN(1:NB), NQINFO,MSG
- ELSEIF (JSEVER.EQ.0) THEN
- WRITE (IQPRNT,9042) CQBLAN(1:NB), NQWARN,MSG
- ELSE
- WRITE (IQPRNT,9043) CQBLAN(1:NB), NQERR,MSG
- ENDIF
- NQUSED = NQUSED + 1
- NQLLBL = 0
- NDSLAT = 7
- IF (JSEVER.NE.1) RETURN
- IF (NQERR.NE.1) RETURN
- IF (IFLAUX.NE.0) RETURN
- WRITE (IQPRNT,9049) CQBLAN(1:NB)
- NQUSED = NQUSED + 1
- RETURN
-
- 9041 FORMAT (A,'! Inform',I4,' *! ',A,' !*')
- 9042 FORMAT (A,'!! Warning',I4,' **!! ',A,' !!**')
- 9043 FORMAT (A,'!!! Error',I4,' ***!!! ',A,' !!!*** !!!!!!!!')
- 9049 FORMAT (A,'!!! EXE processing is inhibited from now on !!!')
- END
diff --git a/src/p5boot/p5lib/flink.f b/src/p5boot/p5lib/flink.f
deleted file mode 100644
index 84168c8..0000000
--- a/src/p5boot/p5lib/flink.f
+++ /dev/null
@@ -1,153 +0,0 @@
-CDECK ID>, FLINK.
- SUBROUTINE FLINK (LUNP, LUNDES, IXNAME, IFLMEX)
-
-C- Open file (for unit LUNP)
-C- LUNDES = 1 cradle input
-C- 2 PAM input
-C- 4 printed output
-C- 5 Fortran output
-C- 6 ASM output write-only (T=ATT)
-C- 7 ASM input-output (T=MODIF)
-C- -1 delete the file, only
-C-
-C- IXNAME = -1 use file name pointed to by IXFLUN
-C- 0 use file name as is in CHLIFI
-C- >0 use file name pointed to by IXNAME
-C-
-C- IFLMEX = 2 the input file does not need to exist
-C- 0 OPEN failure is fatal
-C-
-C- set LUNFD and the file name into /FLINKC/
-C. started 14-oct-91
-
- COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT,NUSLAT(2),DUMMY(34)
- COMMON /QUNIT/ IQREAD,IQPRNT, IQTTIN,IQTYPE, IQOFFL,IQRTTY,IQRSAV
- +, IQRFD,IQRRD,IQRSIZ, NQLPAT,NQUSED,NQLLBL, NQINIT
- PARAMETER (NSLIFI=128)
- CHARACTER CHLIFI*(NSLIFI), CHLIEX*8
- COMMON /FLINKC/LUNOP,LUNFD,LUNOLD,LUNSIZ
- +, IXFLUN, NLIFI,CHLIFI,CHLIEX
-C-------------- End CDE --------------------------------
- EQUIVALENCE (LUN,LUNOP), (NN,NLIFI)
- DIMENSION INFO(40)
- EQUIVALENCE (INFO(1),NDSLAT)
- INTEGER STATF
-C! LOGICAL ACCESSF
-
- CHARACTER UST*8
- CHARACTER*(*) CSOLD, CSNEW, CSAPP, CSRWR
- CHARACTER*(*) YFM, APX
- PARAMETER (YFM='FORMATTED')
- PARAMETER (APX='APPEND')
- PARAMETER (CSOLD='OLD')
- PARAMETER (CSNEW='NEW')
- PARAMETER (CSAPP='UNKNOWN')
- PARAMETER (CSRWR='UNKNOWN')
- LOGICAL THERE
-
-
- LUN = LUNP
- LUNFD = LUN
- LUNSIZ = 0
- MODEFI = LUNDES
- IF (MODEFI.LT.0) MODEFI= 99
-
- CALL FLNAME (IXNAME,IFLAPP)
- IXFLUN = MAX (IXFLUN,0)
-
- ISTAT = STATF (CHLIFI(1:NN),INFO)
- THERE = .FALSE.
- IF (ISTAT.EQ.0) THEN
- IF (INFO(7).NE.0) THERE = .TRUE.
- ENDIF
- IF (THERE) THEN
- LUNOLD = 1
- ELSE
- LUNOLD = 0
- IFLAPP = 0
- ENDIF
-
- IF (MODEFI.GE.4) GO TO 41
-
-C----------- OPEN cradle / PAM file ------------
-
- 21 IF (LUNOLD.EQ.0) GO TO 36
- CALL CIOPEN (LUNFD, 'r', CHLIFI(1:NN), ISTAT)
- IF (ISTAT.NE.0) GO TO 37
-
- CALL CISIZE (LUNFD, LUNSIZ, ISTAT)
- IF (ISTAT.NE.0) LUNSIZ= 0
- CALL CIREW (LUNFD)
-
- GO TO 99
-
-C---- OPEN failure
-
- 36 CONTINUE
- 37 IF (IFLMEX.EQ.2) THEN
- WRITE (IQTYPE,9037) CHLIFI(1:NN)
- GO TO 39
- ENDIF
-
- 38 WRITE (IQTYPE,9038) CHLIFI(1:NN)
- IF (LUNOLD.NE.0) CALL PERRORF (' System msg')
- IF (NQINIT.EQ.0) THEN
- IF (IQPRNT.NE.IQTYPE) WRITE (IQPRNT,9038) CHLIFI(1:NN)
- ENDIF
- 39 IXFLUN = -1
- IF (IFLMEX.EQ.0) CALL P_KILLM ('OPEN failure')
- RETURN
-
- 9037 FORMAT (16X,'(file ',A,' does not exist)')
- 9038 FORMAT (/' ***!!! OPEN fails for file: ',A)
-
-C----------- OPEN output file ------------
-
-C-- MODEFI = 4 printer, 5 Fortran, 6 ASM write, 7 ASM read-write
-
- 41 IF (MODEFI.EQ.7) THEN
- IF (LUNOLD.EQ.0) MODEFI= 6
- ELSE
- IF (LUNOLD.NE.0) THEN
- IF (IFLAPP.EQ.0) CALL UNLINKF (CHLIFI(1:NN))
- ENDIF
- ENDIF
- IF (MODEFI.GE.99) GO TO 99
-
- IF (MODEFI.EQ.7) GO TO 21
- IF (MODEFI.LE.5) GO TO 51
- IF (MODEFI.EQ.7) THEN
- UST = 'r+'
- ELSEIF (IFLAPP.NE.0) THEN
- UST = 'a'
- ELSE
- UST = 'w'
- ENDIF
-
- CALL CIOPEN (LUNFD, UST(1:2), CHLIFI(1:NN), ISTAT)
- IF (ISTAT.NE.0) GO TO 37
-
- IF (MODEFI.NE.7) GO TO 99
- CALL CISIZE (LUNFD, LUNSIZ, ISTAT)
- IF (ISTAT.NE.0) LUNSIZ= 0
- CALL CIREW (LUNFD)
- GO TO 99
-
-C---- Fortran OPEN for output file
-
- 51 IF (MODEFI.EQ.7) THEN
- UST = CSRWR
- ELSEIF (IFLAPP.NE.0) THEN
- UST = CSAPP
- ELSE
- UST = CSNEW
- ENDIF
-
- IF (IFLAPP.NE.0) THEN
- OPEN (LUN,FILE=CHLIFI(1:NN),STATUS=UST,ERR=38,FORM=YFM
- +, ACCESS=APX)
- ELSE
- OPEN (LUN,FILE=CHLIFI(1:NN),STATUS=UST,ERR=38,FORM=YFM)
- ENDIF
- 99 RETURN
- END
diff --git a/src/p5boot/p5lib/fljoin.f b/src/p5boot/p5lib/fljoin.f
deleted file mode 100644
index 535215f..0000000
--- a/src/p5boot/p5lib/fljoin.f
+++ /dev/null
@@ -1,28 +0,0 @@
-CDECK ID>, FLJOIN.
- SUBROUTINE FLJOIN (IXDIR,IXFN,IXEXT,IXFILE)
-
-C- Compose a path name from the 3 parts, return its index
-C. started 17-may-95
-
- COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT,NUSLAT(2),DUMMY(34)
- CHARACTER SLLINE*512, SLERRM*256
- COMMON /SLATLN/ SLLINE, SLERRM
-C-------------- End CDE --------------------------------
-
-
- N = 1
- IF (IXDIR.NE.0) THEN
- CALL NA_GET (IXDIR, SLLINE,1)
- N = NESLAT
- ENDIF
- IF (IXFN.NE.0) THEN
- CALL NA_GET (IXFN, SLLINE,N)
- N = NESLAT
- ENDIF
- IF (IXEXT.NE.0) THEN
- CALL NA_GET (IXEXT, SLLINE,N)
- N = NESLAT
- ENDIF
- IXFILE = NA_LONG (SLLINE(1:N-1))
- RETURN
- END
diff --git a/src/p5boot/p5lib/flkrak.f b/src/p5boot/p5lib/flkrak.f
deleted file mode 100644
index 750741d..0000000
--- a/src/p5boot/p5lib/flkrak.f
+++ /dev/null
@@ -1,277 +0,0 @@
-CDECK ID>, FLKRAK.
- SUBROUTINE FLKRAK (IPARA,LUNDES)
-
-C- Krack next parameter
-C- IPARA -ve : see whether .GO present
-C- 0 : called from FLPARA
-C- +ve : called from the running program
-
-C- LUNDES = 1 cradle input
-C- 2 PAM input
-C- 4 printed output
-C- 5 Fortran output
-C- 6 ASM output write-only (T=ATT)
-C- 7 ASM input-output (T=MODIF)
-C- 11 option parameter
-C- 12 control-character substitution parameter
-C. started 14-oct-91
-
- CHARACTER SLLINE*512, SLERRM*256
- COMMON /SLATLN/ SLLINE, SLERRM
- COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT,NUSLAT(2),DUMMY(34)
- COMMON /QUNIT/ IQREAD,IQPRNT, IQTTIN,IQTYPE, IQOFFL,IQRTTY,IQRSAV
- +, IQRFD,IQRRD,IQRSIZ, NQLPAT,NQUSED,NQLLBL, NQINIT
- CHARACTER CCKORG*256, CCKARD*256, CCCOMF*256
- COMMON /CCPARA/NCHCCD,NCHCCT, JCCTYP,JCCLEV,JCCSL,MCCPAR(240)
- +, NCCPAR,MXCCIF,JCCIFV,JCCBAD,JCCWAR,ICCSUB,JCCWK(4)
- +, JCCPP,JCCPD,JCCPZ,JCCPT,JCCPIF,JCCPC,JCCPN
- +, NCCPP,NCCPD,NCCPZ,NCCPT,NCCPIF,NCCPC,NCCPN
- +, JCCEND, NCHCCC,IXCCC, CCKORG, CCKARD, CCCOMF
- PARAMETER (NSLIFI=128)
- CHARACTER CHLIFI*(NSLIFI), CHLIEX*8
- COMMON /FLINKC/LUNOP,LUNFD,LUNOLD,LUNSIZ
- +, IXFLUN, NLIFI,CHLIFI,CHLIEX
- PARAMETER (NSLINE=256, NSTXKR=192)
- CHARACTER IDPROG*8, LINECC*(NSLINE)
- CHARACTER CHTERM*4, TXKR*(NSTXKR), TXKEY*8, CHWORK*4
- COMMON /FLKRAC/NLCUM, JLINC,NLINT, IXHOME, JFAULT,IFLLIT
- +, IDPROG, LINECC, CHTERM, TXKR,TXKEY, CHWORK
-C-------------- End CDE --------------------------------
-
- CHARACTER TXDO*(NSTXKR)
- CHARACTER COLCC(NSLINE)*1, COLDO(NSTXKR)*1
- EQUIVALENCE (COLCC,LINECC), (COLDO,TXDO)
-
- CHARACTER MPUBLI*(*)
- PARAMETER (MPUBLI = '/cern/pro/src/car/')
-
-
- TXKR = ' '
- JFAULT = 0
- IXFLUN = 0
- MODEFI = LUNDES
-
-C-- Entry from running program
-
- IF (IPARA.LE.0) GO TO 21
- LINECC = CCKARD
- JLINC = NCHCCD
- NLINT = NCHCCT
- IF (MODEFI.EQ.1) THEN
- CHLIEX = '.cra'
- ELSEIF (MODEFI.EQ.2) THEN
- CHLIEX = '.car'
- ENDIF
- GO TO 22
-
-C-- Entry from FLPARA
-
- 21 IF (CHTERM.NE.' ') GO TO 39
- NLCUM = JLINC
-
-C-- No more parameters
-
- 22 JLINC = ICNEXT (LINECC,JLINC+1,NLINT)
- IF (JLINC.GT.NLINT) GO TO 77
-
-C---- Do parameter substitution
-
- JENDU = NESLAT
- NCHU = NDSLAT
-
- CALL CENVIR (LINECC(JLINC:),NCHU, TXDO,1,NSTXKR, 1)
- NCHU = NDSLAT
- IF (NFSLAT.NE.0) GO TO 91
- TXDO(NCHU+1:NCHU+4) = ' '
-
-C---- '-' for Skip next parameter
-
- IF (COLDO(1).NE.'-') GO TO 35
- TXKR(1:1) = COLDO(1)
-
- IF (MODEFI.NE.12) GO TO 77
- IF (COLDO(2).EQ.'-') GO TO 77
- IF (COLDO(2).EQ.' ') GO TO 77
- GO TO 41
-
-C---- Skip Remaining parameters for ". ", ".go", ": ", ":go"
-C-- (but not "../name" or ":name")
-C-- exit for ".no"
-
- 35 IF (COLDO(1).NE.'.') THEN
- IF (COLDO(1).NE.':') GO TO 41
- ENDIF
- CHWORK = TXDO(2:5)
- CALL CUTOL (CHWORK)
- IF (CHWORK.EQ.'go ') GO TO 38
- IF (CHWORK.EQ.'no ') STOP
- IF (COLDO(2).NE.' ') GO TO 41
-
- CHWORK = ' '
- 38 CHTERM = '.' // CHWORK(1:3)
- JLINC = NLCUM
- 39 TXKR(1:8) = '- ...'
- GO TO 77
-
-C------ Check special parameters
-
- 41 IFLLIT = 0
- IF (IPARA.EQ.-1) GO TO 77
- TXKR(1:NCHU) = TXDO(1:NCHU)
- TXKEY = TXKR(1:8)
- CALL CUTOL (TXKEY)
- IF (NCHU.LE.4) THEN
- IF (TXKEY(1:5).EQ.'help ') GO TO 78
- IF (TXKEY(1:5).EQ.'tty ') GO TO 78
- IF (TXKEY(1:5).EQ.'eof ') GO TO 78
- ENDIF
-
-C-- Handle literal option parameter opened by /:
-
- IF (MODEFI.LT.11) GO TO 42
- IF (TXDO(1:2).EQ.'/:') THEN
- IF (NCHU.LT.3) THEN
- TXKR(1:4) = '- '
- GO TO 76
- ENDIF
- TXKR(1:NCHU) = TXDO(3:NCHU) // ' '
- NCHU = NCHU - 2
- ENDIF
- IF (MODEFI.EQ.11) CALL CLTOU (TXKR(1:NCHU))
- NTXU = NCHU
- GO TO 69
-
-C------ Analyse file name
-
- 42 JDO = 1
- NTXU = 0
- TXKR(1:NCHU) = ' '
-
-C-- ignore prefix = :
-
- 43 IF (INDEX ('=:', COLDO(JDO)).NE.0) THEN
- JDO = JDO + 1
- GO TO 43
- ENDIF
-
-C-- check prefix +
-
- IF (COLDO(JDO).EQ.'+') THEN
- TXKR(1:1) = COLDO(JDO)
- JDO = JDO + 1
- NTXU = 1
- ENDIF
-
-C-- check prefix /:
-
- IF (TXDO(JDO:JDO+1).EQ.'/:') THEN
- N = NCHU+1 - JDO
- IF (N.LE.2) GO TO 91
- TXKR(NTXU+1:NTXU+N) = TXDO(JDO:JDO+N-1)
- NTXU = NTXU+ N
- IFLLIT = 1
- GO TO 67
- ENDIF
-
- NTXU = MAX (NTXU,1)
-
-C-- is the file PUBLIC ?
-
- IF (TXDO(JDO:JDO+1).EQ.'_/') THEN
- N = LEN (MPUBLI)
- TXKR(NTXU+1:NTXU+N) = MPUBLI
- NTXU = NTXU + N
- JDO = JDO + 2
- GO TO 48
- ENDIF
-
-C-- does the file name start with '~/' ?
-
-C! IF (TXDO(JDO:JDO+1).EQ.'~/') THEN
-C! IF (IXHOME.GT.0) THEN
-C! CALL NA_GET (IXHOME, TXKR, NTXU+1)
-C! NTXU = NESLAT - 1
-C! JDO = JDO + 2
-C! GO TO 48
-C! ENDIF
-C! ENDIF
-
-C-- is the file-name of the old form (X)/fname ?
-
- IF (COLDO(JDO).NE.'(') GO TO 48
- JE = ICFIND (')', TXDO,JDO+2,NCHU)
- IF (NGSLAT.EQ.0) GO TO 48
- N = JE - JDO - 1
- SLLINE(1:N+3) = '${' // TXDO(JDO+1:JDO+N) // '}'
- N = N + 3
- CALL CENVIR (SLLINE,N, TXKR,NTXU+1,NSTXKR, 0)
- IF (NFSLAT.NE.0) GO TO 48
- NTXU = NTXU + NDSLAT
- JDO = JE + 1
-C-- copy the tail
-
- 48 N = NCHU+1 - JDO
- IF (N.GT.0) THEN
- TXKR(NTXU+1:NTXU+N) = TXDO(JDO:JDO+N-1)
- NTXU = NTXU + N
- ENDIF
-
-
-C---- Look for Directory and Extension
-
- JFILN = 2
- J = ICFILA ('/', TXKR,JFILN,NTXU)
- IF (NGSLAT.NE.0) THEN
- IF (J.EQ.NTXU) GO TO 66
- JFILN = J + 1
- ENDIF
-
- JEXT = ICFILA ('.', TXKR,JFILN,NTXU)
- LEXT = NTXU+1 - JEXT
- LFILN = JEXT - JFILN
-
-C-- do the File extension
-
- IF (LEXT.EQ.0) THEN
- N = LNBLNK (CHLIEX)
- IF (N.EQ.0) GO TO 66
- IF (CHLIEX(1:1).NE.'.') THEN
- NTXU = NTXU + 1
- TXKR(NTXU:NTXU) = '.'
- ENDIF
- TXKR(NTXU+1:NTXU+N) = CHLIEX(1:N)
- NTXU = NTXU + N
- ELSEIF (LEXT.EQ.1) THEN
- TXKR(NTXU:NTXU) = ' '
- NTXU = NTXU - 1
- ENDIF
-
- 66 CALL CLEFT (TXKR,2,NTXU)
- NTXU = NESLAT - 1
- 67 IF (NTXU.GE.NSLIFI-4) GO TO 91
- NLIFI = NTXU
- CHLIFI = TXKR(1:NTXU)
- 69 IXFLUN = NA_LONG (TXKR(1:NTXU))
-
-C---- Done
-
- 76 JLINC = JENDU
- 77 TXKEY = TXKR(1:8)
- RETURN
-
- 78 JLINC = JENDU
- RETURN
-
-C---- Trouble
-
- 91 JFAULT = 7
- IF (IPARA.LE.0) THEN
- IF (IQOFFL.EQ.0) RETURN
- ENDIF
-
- WRITE (IQPRNT,9092)
- IF (IQTYPE.NE.IQPRNT) WRITE (IQTYPE,9092)
- 9092 FORMAT (/' ***!!! Faulty file name syntax !!!***')
- CALL EXITRC (2)
- RETURN
- END
diff --git a/src/p5boot/p5lib/flname.f b/src/p5boot/p5lib/flname.f
deleted file mode 100644
index d7518a3..0000000
--- a/src/p5boot/p5lib/flname.f
+++ /dev/null
@@ -1,62 +0,0 @@
-CDECK ID>, FLNAME.
- SUBROUTINE FLNAME (IXNAME, IFLAPP)
-
-C- Ready the file name for use in OPEN or UNLINKF
-C-
-C- IXNAME = -1 use file name pointed to by IXFLUN
-C- 0 use file name as is in CHLIFI
-C- >0 use file name pointed to by IXNAME
-C-
-C- return IFLAPP = 0/1 if no/yes append mode
-C. started 16-dec-93
-
- COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT,NUSLAT(2),DUMMY(34)
- PARAMETER (NSLINE=256, NSTXKR=192)
- CHARACTER IDPROG*8, LINECC*(NSLINE)
- CHARACTER CHTERM*4, TXKR*(NSTXKR), TXKEY*8, CHWORK*4
- COMMON /FLKRAC/NLCUM, JLINC,NLINT, IXHOME, JFAULT,IFLLIT
- +, IDPROG, LINECC, CHTERM, TXKR,TXKEY, CHWORK
- PARAMETER (NSLIFI=128)
- CHARACTER CHLIFI*(NSLIFI), CHLIEX*8
- COMMON /FLINKC/LUNOP,LUNFD,LUNOLD,LUNSIZ
- +, IXFLUN, NLIFI,CHLIFI,CHLIEX
-C-------------- End CDE --------------------------------
-
-
- IF (IXNAME.GE.0) IXFLUN= IXNAME
- IF (IXFLUN.GT.0) THEN
- CHLIFI = ' '
- CALL NA_GET (IXFLUN, CHLIFI, 1)
- NLIFI = NDSLAT
- ENDIF
-
- IFLAG = 0
- IF (CHLIFI(1:1).EQ.' ') GO TO 23
- 21 IF (CHLIFI(1:1).EQ.'=') GO TO 22
- IF (CHLIFI(1:1).EQ.':') GO TO 22
- IF (CHLIFI(1:2).EQ.'/:') GO TO 31
- IF (CHLIFI(1:1).NE.'+') GO TO 41
- IFLAG = 1
-
- 22 CHLIFI(1:1) = ' '
- 23 CALL CLEFT (CHLIFI,1,NLIFI)
- NLIFI = NDSLAT
- GO TO 21
-
-C-- file name as is
-
- 31 CHLIFI(1:2) = ' '
- CALL CLEFT (CHLIFI,1,NLIFI)
- NLIFI = NDSLAT
- GO TO 47
-
- 41 IF (CHLIFI(1:2).EQ.'~/') THEN
- CALL NA_GET (IXHOME, TXKR, 1)
- N = NDSLAT
- TXKR(N+1:N+NLIFI-2) = CHLIFI(3:NLIFI)
- NLIFI = N + NLIFI - 2
- CHLIFI(1:NLIFI) = TXKR(1:NLIFI)
- ENDIF
- 47 IFLAPP = IFLAG
- RETURN
- END
diff --git a/src/p5boot/p5lib/flpara.f b/src/p5boot/p5lib/flpara.f
deleted file mode 100644
index 24b0774..0000000
--- a/src/p5boot/p5lib/flpara.f
+++ /dev/null
@@ -1,435 +0,0 @@
-CDECK ID>, FLPARA.
- SUBROUTINE FLPARA (NFILEP,NAMEIP,CHTXOP)
-
-C- called from the Main programs to aquire the file names
-C. started 14-oct-91
-
- CHARACTER SLLINE*512, SLERRM*256
- COMMON /SLATLN/ SLLINE, SLERRM
- COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT,NUSLAT(2),DUMMY(34)
- CHARACTER CQBLAN*128, CQEQS*128, CQCETA*32
- CHARACTER CQAPO*1, CQBSL*1, CQTAB*1
- COMMON /QCHAR/ CQBLAN, CQEQS, CQCETA, CQAPO, CQBSL, CQTAB
- CHARACTER CQDATEM*10, CQDATE*8, CQTIME*5
- COMMON /QSTATE/NQERR,NQWARN,NQINFO,NQLOCK
- +, IQDATE,IQTIME, CQDATEM,CQDATE,CQTIME
- COMMON /QUNIT/ IQREAD,IQPRNT, IQTTIN,IQTYPE, IQOFFL,IQRTTY,IQRSAV
- +, IQRFD,IQRRD,IQRSIZ, NQLPAT,NQUSED,NQLLBL, NQINIT
- CHARACTER CCKORG*256, CCKARD*256, CCCOMF*256
- COMMON /CCPARA/NCHCCD,NCHCCT, JCCTYP,JCCLEV,JCCSL,MCCPAR(240)
- +, NCCPAR,MXCCIF,JCCIFV,JCCBAD,JCCWAR,ICCSUB,JCCWK(4)
- +, JCCPP,JCCPD,JCCPZ,JCCPT,JCCPIF,JCCPC,JCCPN
- +, NCCPP,NCCPD,NCCPZ,NCCPT,NCCPIF,NCCPC,NCCPN
- +, JCCEND, NCHCCC,IXCCC, CCKORG, CCKARD, CCCOMF
- COMMON /LUNSLN/IFLAUX, IXLUN(12)
- PARAMETER (NSLIFI=128)
- CHARACTER CHLIFI*(NSLIFI), CHLIEX*8
- COMMON /FLINKC/LUNOP,LUNFD,LUNOLD,LUNSIZ
- +, IXFLUN, NLIFI,CHLIFI,CHLIEX
- PARAMETER (NSLINE=256, NSTXKR=192)
- CHARACTER IDPROG*8, LINECC*(NSLINE)
- CHARACTER CHTERM*4, TXKR*(NSTXKR), TXKEY*8, CHWORK*4
- COMMON /FLKRAC/NLCUM, JLINC,NLINT, IXHOME, JFAULT,IFLLIT
- +, IDPROG, LINECC, CHTERM, TXKR,TXKEY, CHWORK
-
- PARAMETER (NCNAME=32)
- CHARACTER NAMEIN(14)*(NCNAME)
- CHARACTER KEYSTO(14)*8
- CHARACTER COMD*256, CHSTRM*6
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ)
- EQUIVALENCE (LQ,IQ,LQGARB)
- COMMON // IQUEST(100),LQGARB
- +, MPROTE(1000)
- +, LUNUSE,LUNDES,LUNFLG, MUSE(200)
- +, NAMEIN, KEYSTO, COMD, CHSTRM
-C-------------- End CDE --------------------------------
- CHARACTER CHTXOP*(*), NAMEIP(NFILEP)*(NCNAME)
- PARAMETER (NWSTOR=3)
- LOGICAL DIALOG, ALSO, READY
- PARAMETER (NCOST=6, NCOEX=14)
- CHARACTER VIDQQ*(*)
- PARAMETER (VIDQQ = '@(#)' //
- + 'PATCHY 5.05 /3 1996/06/29 17.00 '
- +)
-
-
-
- NFILE = NFILEP
- DO 12 J=1,NFILE
- NAMEIN(J) = NAMEIP(J)
- IXLUN(J) = 0
- 12 CONTINUE
- CALL CLEFT (VIDQQ,1,0)
-
- JEOP = LEN(CHTXOP)
- JA = ICNEXT (CHTXOP,1,JEOP)
- NPID = NDSLAT
- JA = NESLAT
- JAOP = ICNEXT (CHTXOP,JA,JEOP)
-
- IDPROG = CHTXOP(1:NPID)
-
- COMD = IDPROG
- NCMD = NPID + 2
- COMD(NCMD:NCMD) = CQAPO
- CALL CUTOL (COMD(1:8))
- IF (COMD(1:8).NE.'nypatchy') IFLAUX= 1
-
- CCKARD = ' '
- READY = .FALSE.
- INIPRO = 0
- IFHELP = 0
- NOEJ = 0
- NREAD = 0
-
-C-- Get the home directory
-
- SLLINE = ' '
- CALL GETENVF ('HOME', SLLINE(1:128))
- N = NDSLAT
- IF (N.GT.0) THEN
- IF (SLLINE(N:N).NE.'/') THEN
- N = N + 1
- SLLINE(N:N) = '/'
- ENDIF
- ENDIF
- IXHOME = NA_LONG (SLLINE(1:N+1))
-
-C-- Is the user on-line ? Yes if IQOFFL = 0
-
- DIALOG = IQOFFL.EQ.0
-
-C-- No dialogue printing if .GO on program statement
-
- NARGS = IARGC()
- IF (NARGS.EQ.0) GO TO 17
- IF (NARGS.GE.NFILE) GO TO 16
-
- LINECC = ' '
- JARG = NARGS
- CALL GETARG (JARG,LINECC)
- NLINT = LENOCC (LINECC)
- IF (NLINT.LT.3) GO TO 17
- CHWORK = LINECC(NLINT-2:NLINT)
- IF (CHWORK(1:1).EQ.':') CHWORK(1:1)='.'
- CALL CUTOL (CHWORK)
- IF (CHWORK.NE.'.go ') GO TO 17
-
- 16 DIALOG = .FALSE.
- READY = .TRUE.
- 17 IF (DIALOG) THEN
- WRITE (IQTYPE,9001) IDPROG(1:NPID)
- IF (JAOP.LT.JEOP) WRITE (IQTYPE,9002) CHTXOP(JAOP:JEOP)
- WRITE (IQTYPE,9004) (NAMEIN(J)(9:NCOEX),J=1,NFILE)
-
- IF (NARGS.GT.0) THEN
- WRITE (IQTYPE,9006) (NAMEIN(J)(1:NCOST),J=1,NFILE)
- ENDIF
- ENDIF
-
- 9001 FORMAT (1X,A,' executing')
- 9002 FORMAT (' Options : ',A)
- 9004 FORMAT (' Default ext. : ',12A)
- 9006 FORMAT (' Stream names : ',12A)
-C-------- Aquire the program parameters
-
- CHTERM = ' '
- NLCUM = 0
- IQRFD = 0
- JUREAD = 0
- JUPRNT = 0
- NFILEX = 0
- JFILE = 1
- JUSE = 1
-
-C---- Take parameters from the command line
-
- JARG = 1
- 31 IF (NLCUM.GT.0) THEN
- COMD(NCMD+1:NCMD+NLCUM) = LINECC(1:NLCUM)
- CALL CSQMBL (COMD,1,NCMD+NLCUM)
- NCMD = NDSLAT + 1
- NLCUM = 0
- ENDIF
-
- LINECC = ' '
- IF (JARG.GT.NARGS) GO TO 34
- CALL GETARG (JARG,LINECC)
- NLINT = LENOCC (LINECC)
- JARG = JARG + 1
- GO TO 38
-
-C---- Take parameters from next input line
-
- 34 IF (DIALOG) THEN
- WRITE (IQTYPE,9006) (NAMEIN(J)(1:NCOST),J=JFILE,NFILE)
- IF (INIPRO.EQ.0) CALL TMINIT (INIPRO)
- CALL TMPRO (' ny> ')
- ENDIF
-
- CALL TMREAD (NSLINE, LINECC, NLINT, ISTAT)
- NREAD = NREAD + 1
- IF (ISTAT.NE.0) GO TO 91
-
- 38 IF (NLINT.EQ.0) GO TO 31
-
- JLINC = 0
- IF (JFILE.GT.NFILE) GO TO 72
-
-C---- Next parameter
-
- 41 IF (JLINC.GT.NLINT) GO TO 31
- CHSTRM = NAMEIN(JFILE)(1:6)
- CHLIEX = NAMEIN(JFILE)(9:16)
- LUNUSE = ICDECI (NAMEIN(JFILE),18,19)
- LUNDES = ICDECI (NAMEIN(JFILE),22,23)
- LUNFLG = ICDECI (NAMEIN(JFILE),26,27)
- IFLSCR = 0
- IF (CHLIEX.EQ.'.scr ') IFLSCR = 7
-
- CALL FLKRAK (0,LUNDES)
- IF (JFAULT.NE.0) THEN
- WRITE (IQTYPE,9042) JFILE
- GO TO 49
- ENDIF
-
- 9042 FORMAT (' Faulty parameter',I3)
-
- IF (TXKEY(1:4).EQ.' ') GO TO 31
- IF (TXKEY(1:8).EQ.'help ') THEN
- CALL HELPPR
- GO TO 31
- ENDIF
-
- IF (LUNUSE.GE.5) GO TO 61
- GO TO (43,51,55,57), LUNUSE
-
-C-- Reader input
-
- 43 IF (IFHELP.NE.0) GO TO 64
- IF (TXKEY(1:4).EQ.'- ') GO TO 44
- IF (TXKEY(1:4).NE.'tty ') GO TO 45
-
- 44 TXKEY = '- '
- TXKR(1:8) = 'tty '
- IF (IQOFFL.EQ.0) THEN
- IF (INIPRO.EQ.0) CALL TMINIT (INIPRO)
- ENDIF
- IQREAD = IQTTIN
- LUNUSE = IQTTIN
- JUREAD = JUSE
- GO TO 64
-
- 45 LUNUSE = IQREAD
- IQRTTY = 0
- IF (TXKEY(1:4).EQ.'eof ') GO TO 47
- JUREAD = JUSE
- GO TO 64
-
- 47 IF (LUNFLG.EQ.0) GO TO 48
- IQREAD = 0
- LUNUSE = 0
- GO TO 64
-
- 48 WRITE (IQTYPE,9048) IDPROG(1:NPID)
- 9048 FORMAT (' ***!!! EOF not allowed with ',A)
- 49 IF (IQOFFL.NE.0) CALL EXITRC (2)
- DIALOG = .TRUE.
- JARG = NARGS + 1
- GO TO 31
-
-C-- Printer output
-
- 51 IF (TXKEY(1:4).EQ.'- ') GO TO 52
- IF (TXKEY(1:4).NE.'tty ') GO TO 54
-
- 52 TXKEY = '- '
- TXKR(1:8) = 'tty '
- IQPRNT = IQTYPE
- LUNUSE = IQTYPE
- GO TO 64
-
- 54 JUPRNT = JUSE
- JFPRNT = JFILE
- LUNUSE = IQPRNT
- GO TO 64
-
-C-- Option string
-
- 55 IF (IXFLUN.EQ.0) GO TO 57
- CALL NA_GET (IXFLUN, SLLINE,1)
- NOEJ = INDEX (SLLINE(1:NDSLAT),'+')
- IFHELP = INDEX (SLLINE(1:NDSLAT),'H')
- IF (IFHELP.EQ.0) GO TO 57
- CHTERM = '.go'
- IQREAD = 0
- JLINC = 1
- READY = .TRUE.
-
-C-- CCH - string
-
- 57 LUNUSE = 0
- GO TO 64
-
-C-- Normal streams
-
- 61 CONTINUE
-
-C-- set scratch file
- IF (IFLSCR.NE.0) TXKR = '-temp.scr'
-
-C-- Store usage for final processing
-
- 64 NLCUM = JLINC
- NTXT = LENOCC (TXKR)
- IXLUN(JFILE) = IXFLUN
-
- KEYSTO(JFILE) = TXKR(1:8)
- CALL UCOPY (LUNUSE,MUSE(JUSE),NWSTOR)
- JUSE = JUSE + NWSTOR
- IF (.NOT.DIALOG) GO TO 68
-
- IF (LUNUSE.EQ.0) THEN
- WRITE (IQTYPE,9085) CHSTRM,TXKR(1:NTXT)
- ELSE
- WRITE (IQTYPE,9087) JFILE,CHSTRM,TXKR(1:NTXT)
- ENDIF
-
- 68 JFILE = JFILE + 1
- IF (TXKEY(5:8).NE.' ...') NFILEX = JFILE
- IF (JFILE.LE.NFILE) GO TO 41
-
-C---- Start execution ?
-
- IF (READY) GO TO 83
- IF (NLCUM.GT.0) THEN
- COMD(NCMD+1:NCMD+NLCUM) = LINECC(1:NLCUM)
- CALL CSQMBL (COMD,1,NCMD+NLCUM)
- NCMD = NDSLAT + 1
- NLCUM = 0
- ENDIF
-
- IF (CHTERM.NE.' ') GO TO 73
- IF (JARG.LE.NARGS) THEN
- IF (JLINC.GE.NLINT) GO TO 31
- ENDIF
- 72 CALL FLKRAK (-1,11)
-
- 73 COMD(NCMD+1:NCMD+4) = '.go' // CQAPO
- NCMD = NCMD + 4
- IF (IQOFFL.EQ.0) WRITE (IQTYPE,9073) COMD(1:NCMD)
- 9073 FORMAT (/'. ',A/)
-
- IF (CHTERM(2:3).EQ.'go') GO TO 83
- CHTERM = ' '
- IF (INIPRO.EQ.0) CALL TMINIT (INIPRO)
- CALL TMPRO (' Type GO or stop ny> ')
- CALL TMREAD (4, CHTERM, NCH, ISTAT)
- IF (ISTAT.NE.0) GO TO 91
- NREAD = NREAD + 1
- CALL CUTOL (CHTERM)
- IF (CHTERM.EQ.'.go ') GO TO 83
- IF (CHTERM.NE.'go ') STOP
-
-C-------- Final processing, OPEN standard input/output
-
- 83 IF (JUPRNT.NE.0) THEN
- CALL UCOPY (MUSE(JUPRNT),LUNUSE,NWSTOR)
- CALL FLINK (LUNUSE, 4, IXLUN(JFPRNT), 0)
- ENDIF
-
- ALSO = .NOT.DIALOG
- IF (IQTYPE.EQ.IQPRNT) THEN
- ALSO = .FALSE.
- NOEJ = 7
- ENDIF
-
- IF (NOEJ.EQ.0) THEN
- WRITE (IQPRNT,9083) IDPROG(1:NPID)
- ELSE
- WRITE (IQPRNT,9084) IDPROG(1:NPID)
- ENDIF
- NQUSED = 3
-
- IF (ALSO) WRITE (IQTYPE,9084) IDPROG(1:NPID)
- IF (NFILEX.EQ.NFILE) NFILEX = NFILE + 1
-
- JUSE = 1
- JFILE = 1
- 84 CALL UCOPY (MUSE(JUSE),LUNUSE,NWSTOR)
- CHLIFI = ' '
- IXFLUN = IXLUN(JFILE)
- IF (IXFLUN.NE.0) THEN
- CALL NA_GET (IXFLUN, CHLIFI, 1)
- NLIFI = NDSLAT
- ELSE
- CHLIFI(1:8) = KEYSTO(JFILE)
- NLIFI = 8
- IF (JFILE.NE.NFILEX) THEN
- IF (CHLIFI(5:8).EQ.' ...') NLIFI = 4
- ENDIF
- NLIFI = LNBLNK(CHLIFI(1:NLIFI))
- ENDIF
- CHSTRM = NAMEIN(JFILE)(1:8)
- NQUSED = NQUSED + 1
-
- IF (LUNUSE.EQ.0) THEN
- WRITE (IQPRNT,9085) CHSTRM,CHLIFI(1:NLIFI)
- IF (ALSO) WRITE (IQTYPE,9085) CHSTRM,CHLIFI(1:NLIFI)
- GO TO 89
- ENDIF
-
- WRITE (IQPRNT,9087) JFILE,CHSTRM,CHLIFI(1:NLIFI)
- IF (ALSO) WRITE (IQTYPE,9087) JFILE,CHSTRM,CHLIFI(1:NLIFI)
-
-C-- handle the cradle input stream
-
- IF (JUSE.NE.JUREAD) GO TO 89
- IF (LUNUSE.NE.IQTTIN) GO TO 87
-C-- get the size of the here-document
-
- IF (IQOFFL.EQ.0) GO TO 89
- CALL CITELL (IQRFD,JPOS,ISTAT)
- IF (ISTAT.NE.0) GO TO 89
- CALL CISIZE (IQRFD,IQRSIZ,ISTAT)
-
- CALL CIREW (IQRFD)
- IQRRD = NREAD
- GO TO 89
-
-C-- open the file for stdin, if given
-
- 87 CALL FLINK (LUNUSE, 1, 0, LUNFLG)
- IF (IXFLUN.LT.0) THEN
- IQREAD = 0
- ELSE
- IQRFD = LUNFD
- IQRSIZ = LUNSIZ
- ENDIF
-
- 89 IF (JFILE.EQ.NFILEX) JFILE=NFILE
- JUSE = JUSE + NWSTOR
- JFILE = JFILE + 1
- IF (JFILE.LE.NFILE) GO TO 84
- IF (ALSO) WRITE (IQTYPE,9089)
- CHTERM = ' '
-
- WRITE (IQPRNT,9099) CQDATEM(3:),CQTIME
- NQUSED = NQUSED + 3
- NQLLBL = 1
- NQINIT = 0
- RETURN
-
- 91 CALL P_KILLM ('FLPARA - Trouble reading stdin')
-
- 9083 FORMAT (1H1,A,' executing with files / options'/)
- 9084 FORMAT (/1X,A,' executing with files / options'/)
- 9085 FORMAT (6X,A,3X,A)
- 9087 FORMAT (I4,2X,A,3X,A)
- 9089 FORMAT (1X)
- 9099 FORMAT (/' Version: ',
- + 'PATCHY 5.05 /3 1996/06/29 17.00 '
- F,'.RJP, today: ',A,1X,A
- F/)
- END
diff --git a/src/p5boot/p5lib/flsplit.f b/src/p5boot/p5lib/flsplit.f
deleted file mode 100644
index 750f267..0000000
--- a/src/p5boot/p5lib/flsplit.f
+++ /dev/null
@@ -1,34 +0,0 @@
-CDECK ID>, FLSPLIT.
- SUBROUTINE FLSPLIT (IXFILE,IXDIR,IXFN,IXEXT)
-
-C- Split the input file name dir/fn.ext into its parts,
-C- return dir/ fn .ext as names with index IXDIR, IXFN, IXEXT
-C. started 17-apr-95
-
- COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT,NUSLAT(2),DUMMY(34)
- PARAMETER (NSLIFI=128)
- CHARACTER CHLIFI*(NSLIFI), CHLIEX*8
- COMMON /FLINKC/LUNOP,LUNFD,LUNOLD,LUNSIZ
- +, IXFLUN, NLIFI,CHLIFI,CHLIEX
-C-------------- End CDE --------------------------------
-
-
- CALL FLNAME (IXFILE,JFN)
-
- JSLA = ICFILA ('/', CHLIFI,1,NLIFI)
- JFN = NGSLAT + 1
-
- JDOT = ICFILA ('.', CHLIFI,JFN,NLIFI)
- IF (JDOT.LT.JFN) JDOT = NLIFI + 1
-
- IXD = 0
- IXF = 0
- IXX = 0
- IF (JFN.GE.3) IXD = NA_LONG (CHLIFI(1:JSLA))
- IF (JFN.LT.JDOT) IXF = NA_LONG (CHLIFI(JFN:JDOT-1))
- IF (JDOT.LT.NLIFI) IXX = NA_LONG (CHLIFI(JDOT:NLIFI))
- IXDIR = IXD
- IXFN = IXF
- IXEXT = IXX
- RETURN
- END
diff --git a/src/p5boot/p5lib/helppr.f b/src/p5boot/p5lib/helppr.f
deleted file mode 100644
index 426036a..0000000
--- a/src/p5boot/p5lib/helppr.f
+++ /dev/null
@@ -1,57 +0,0 @@
-CDECK ID>, HELPPR.
- SUBROUTINE HELPPR
-
-C- Print file-name syntax
-
- COMMON /QUNIT/ IQREAD,IQPRNT, IQTTIN,IQTYPE, IQOFFL,IQRTTY,IQRSAV
- +, IQRFD,IQRRD,IQRSIZ, NQLPAT,NQUSED,NQLLBL, NQINIT
-
- CHARACTER MPUBLI*(*)
- PARAMETER (MPUBLI = '/cern/pro/src/car/')
-
-
- WRITE (IQTYPE,9001)
- WRITE (IQTYPE,9002) MPUBLI
- WRITE (IQTYPE,9003)
- RETURN
-
- 9001 FORMAT (/' To get program specific help you can give the H option'
- F/' in the calls to the Patchy Auxiliary programs.'
- F/' What follows concerns the parameter acquisition dialog.'/
- F/' For each remaining stream give the File-name/Option-string as'
- F/' parameter value in order. You may give 1 or more parameters'
- F/' on a line; the machine will keep displaying the remaining'
- F/' streams until its list is satisfied. The answer to the final'
- F/' confirmation query is GO, or NO to kill the run.'/
- F/' Parameters must be separated by 1 or more blanks,'
- F/' except: multiple "-" do not need imbedded blanks.' /
- F/' Special parameter values :'
- F/' - : this stream is not used / option string void,'
- F/' except READ or PRINT : assume "TTY"'
- F/' . or .go : use "-" for this and all remaining streams'
- F/' TTY : use standard input/output (only for READ+PRINT),'
- F/' EOF : void input (only for READ)'
- F/' HELP : as you guessed.' )
-
- 9002 FORMAT (/' Normal parameters values:'
- F/' File name (case-sensitive for UNIX):'
- F/' DIR/FN.EXT path name; DIR/ or .EXT may be omitted,'
- F/' a default extension is added to the'
- F/' path name unless it contains a dot.'
- F/' /:NAME use NAME exactly as typed'
- F/' +DIR/FN.EXT open output file for Append'
- F/' =DIR/FN.EXT the = is ignored for back-compatibility'
- F/' :DIR/FN.EXT the : is ignored for back-compatibility'
- F/' ~/DIR/FN.EXT = $HOME/DIR/FN.EXT relative to the home dir.'
- F/' ../DIR/FN.EXT relative to the current wk directory'
- F/' _/DIR/FN.EXT = ',A,'DIR/FN.EXT public files'
- F/' (X)/FN.EXT = ${X}/FN.EXT env.variable for back-compat.'
- F/' LNAME. Link name, no default extension added,'
- F/' terminating dot removed')
- 9003 FORMAT (
- F/' ${X} or $X occuring in a file name is replaced by the'
- F/' contents of environment variable X'/
- F/' Option string:'
- F/' OPT string of characters, maybe prefixed by /:'
- F/' each character selecting one option.'/)
- END
diff --git a/src/p5boot/p5lib/indcrd.f b/src/p5boot/p5lib/indcrd.f
deleted file mode 100644
index 7acf915..0000000
--- a/src/p5boot/p5lib/indcrd.f
+++ /dev/null
@@ -1,38 +0,0 @@
-CDECK ID>, INDCRD.
- SUBROUTINE INDCRD
-
-C- Register current deck name for nyindex
-C. started 17-jan-94
-
- CHARACTER CHEXPD*68
- COMMON /CHEXC/ IXEXPAM, IXEXPAT,IXEXDEC,IXEXID, NCHEPD, CHEXPD
- PARAMETER (NBANKS=19,JBKPAT=1, JBKDEC=2, JBKORG=3, JBKINC=4,
- + JBKHOL=5, JBKKEE=6, JBKACT=7, JBKMAT=8, JBKXSQ=9,
- + JBKPRE=10,JBKGAR=11,JBKSMH=12,JBKSMT=13,JBKSML=14,
- + JBKSMX=15,JBKARR=16,JBKASA=17,JBKPAM=18,JBKRPA=19)
- COMMON /QBANKS/MMBANK(5,NBANKS)
- COMMON /QPAGE/ NQLMAX,NQLTOL,NQLTOK,NQCMAX,NQCPGH,NQPAGE
- +, NQWYLDO,NQWYL,NQNEWH,NQJOIN,NQDKNO,NQDKPG
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
-C-------------- End CDE --------------------------------
-
-
- CALL MQLIFT (LEXD, LQUSER(2),1, JBKDEC,3)
- IQ(LEXD+1) = IXEXDEC
- IQ(LEXD+2) = IXEXPAT
- IQ(LEXD+3) = NQDKNO
- RETURN
- END
diff --git a/src/p5boot/p5lib/indcrp.f b/src/p5boot/p5lib/indcrp.f
deleted file mode 100644
index 3e20b99..0000000
--- a/src/p5boot/p5lib/indcrp.f
+++ /dev/null
@@ -1,62 +0,0 @@
-CDECK ID>, INDCRP.
- SUBROUTINE INDCRP (IXNAME,MODE)
-
-C- Register patch name IXNAME for nyindex,
-C- MODE = 0 this is the name of the current patch just starting
-C- 1 patch name quoted in IF=
-C. started 17-jan-94
-
- PARAMETER (KM1=1,KM2=2,KM3=4,KM4=8,KM5=16,KM6=32,KM7=64,KM8=128,
- + KM9=256, KM10=512, KM11=1024, KM12=2048, KM13=4096, KM14=8192,
- + KM15=16384, KM16=32768, KM17=65536, KM18=131072, KM19=262144)
- PARAMETER (NBANKS=19,JBKPAT=1, JBKDEC=2, JBKORG=3, JBKINC=4,
- + JBKHOL=5, JBKKEE=6, JBKACT=7, JBKMAT=8, JBKXSQ=9,
- + JBKPRE=10,JBKGAR=11,JBKSMH=12,JBKSMT=13,JBKSML=14,
- + JBKSMX=15,JBKARR=16,JBKASA=17,JBKPAM=18,JBKRPA=19)
- COMMON /QBANKS/MMBANK(5,NBANKS)
- COMMON /QPAGE/ NQLMAX,NQLTOL,NQLTOK,NQCMAX,NQCPGH,NQPAGE
- +, NQWYLDO,NQWYL,NQNEWH,NQJOIN,NQDKNO,NQDKPG
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
-C-------------- End CDE --------------------------------
- IOR (IZV,IZW) = OR (IZV, IZW)
-
-
- LPAT = LQFIND (IXNAME,2,LQUSER)
-
- IF (MODE.EQ.0) GO TO 21
- IF (LPAT.EQ.0) GO TO 24
- GO TO 27
-
-C-- start of patch
-
- 21 IF (LPAT.EQ.0) GO TO 24
- IF (IQ(LPAT+1).GE.0) GO TO 24
- 22 LEXP = LPAT
- IQ(LEXP+1) = NQDKNO
- RETURN
-
-C-- lift the PAT bank
-
- 24 CALL MQLIFT (LPAT, LQUSER(1),1, JBKPAT,3)
- IQ(LPAT+2) = IXNAME
- IF (MODE.EQ.0) GO TO 22
- IQ(LPAT+1) = -1
-
-C-- mark patch-name used in IF=
-
- 27 IQ(LPAT) = IOR (IQ(LPAT),KM6)
- RETURN
- END
diff --git a/src/p5boot/p5lib/indcrz.f b/src/p5boot/p5lib/indcrz.f
deleted file mode 100644
index c6204f4..0000000
--- a/src/p5boot/p5lib/indcrz.f
+++ /dev/null
@@ -1,40 +0,0 @@
-CDECK ID>, INDCRZ.
- SUBROUTINE INDCRZ (IXNAME)
-
-C- Register sequence name IXNAME for nyindex
-C. started 17-jan-94
-
- PARAMETER (NBANKS=19,JBKPAT=1, JBKDEC=2, JBKORG=3, JBKINC=4,
- + JBKHOL=5, JBKKEE=6, JBKACT=7, JBKMAT=8, JBKXSQ=9,
- + JBKPRE=10,JBKGAR=11,JBKSMH=12,JBKSMT=13,JBKSML=14,
- + JBKSMX=15,JBKARR=16,JBKASA=17,JBKPAM=18,JBKRPA=19)
- COMMON /QBANKS/MMBANK(5,NBANKS)
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
-C-------------- End CDE --------------------------------
- IOR (IZV,IZW) = OR (IZV, IZW)
-
-
- CALL MQLIFT (LKEE, LQKEEP,1, JBKKEE,3)
- IQ(LKEE+1) = IXNAME
- IF (LEXD.NE.0) THEN
- LQ(LKEE-2) = LEXD
- RETURN
- ENDIF
-
- LQ(LKEE-2) = LEXP
- IQ(LKEE) = IOR (IQ(LKEE),1)
- RETURN
- END
diff --git a/src/p5boot/p5lib/inddeck.f b/src/p5boot/p5lib/inddeck.f
deleted file mode 100644
index f16c948..0000000
--- a/src/p5boot/p5lib/inddeck.f
+++ /dev/null
@@ -1,198 +0,0 @@
-CDECK ID>, INDDECK.
- SUBROUTINE INDDECK
-
-C- Handle all decks until next +TITLE for nyindex
-C. started 12-jan-94
-
- COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT,NUSLAT(2),DUMMY(34)
- CHARACTER SLLINE*512, SLERRM*256
- COMMON /SLATLN/ SLLINE, SLERRM
- PARAMETER (KM1=1,KM2=2,KM3=4,KM4=8,KM5=16,KM6=32,KM7=64,KM8=128,
- + KM9=256, KM10=512, KM11=1024, KM12=2048, KM13=4096, KM14=8192,
- + KM15=16384, KM16=32768, KM17=65536, KM18=131072, KM19=262144)
- COMMON /QPAGE/ NQLMAX,NQLTOL,NQLTOK,NQCMAX,NQCPGH,NQPAGE
- +, NQWYLDO,NQWYL,NQNEWH,NQJOIN,NQDKNO,NQDKPG
- COMMON /QUNIT/ IQREAD,IQPRNT, IQTTIN,IQTYPE, IQOFFL,IQRTTY,IQRSAV
- +, IQRFD,IQRRD,IQRSIZ, NQLPAT,NQUSED,NQLLBL, NQINIT
- PARAMETER (MCCNIL=1, MCCKIL=2, MCCINC=3, MCCCDE=4, MCCSEQ=5,
- + MCCXSQ=6, MCCTRU=7, MCCFAL=8, MCCELS=9, MCCEND=10,
- + MCCSEL=11, MCCSES=12, MCCFAU=13, MCCSKI=14,
- + MCCKEE=15, MCCDEL=16, MCCREP=17, MCCADB=18, MCCADD=19,
- + MCCUSE=20, MCCXDI=21, MCCDIV=22, MCCLIS=23, MCCEXE=24, MCCIMI=25,
- + MCCASM=26, MCCUPD=27, MCCNAM=28, MCCGAP=29, MCCMOR=30, MCCONL=31,
- + MCCFOR=32, MCCSUS=33, MCCOPT=34, MCCOP2=35, MCCSHO=36, MCCPAM=37,
- + MCCQUI=38, MCCEOD=39, MCCDEC=40, MCCPAT=41, MCCTIT=42)
- CHARACTER CCKORG*256, CCKARD*256, CCCOMF*256
- COMMON /CCPARA/NCHCCD,NCHCCT, JCCTYP,JCCLEV,JCCSL,MCCPAR(240)
- +, NCCPAR,MXCCIF,JCCIFV,JCCBAD,JCCWAR,ICCSUB,JCCWK(4)
- +, JCCPP,JCCPD,JCCPZ,JCCPT,JCCPIF,JCCPC,JCCPN
- +, NCCPP,NCCPD,NCCPZ,NCCPT,NCCPIF,NCCPC,NCCPN
- +, JCCEND, NCHCCC,IXCCC, CCKORG, CCKARD, CCCOMF
- CHARACTER CHEXPD*68
- COMMON /CHEXC/ IXEXPAM, IXEXPAT,IXEXDEC,IXEXID, NCHEPD, CHEXPD
- COMMON /DEPCOM/JD_NEW, JD_DTN, JD_DTP, JD_DTD, JD_DIV
- +, JD_SML, JD_SMP, JD_SMX, JDP_DT, JDP_DV
- +, JD_SPL, JD_MOD, JD_LUN, JD_LOG, JD_NLI, JD_MULT
- +, IX_EXT, IX_RH, IX_SUB
- COMMON /MQCM/ NQSYSS,NQLINK, LQCSTA(3),LQCEND(3), NQMAX
- +, LQLSTA(5),LQLEND(5), LQADR,LQADR0,NQOFFS
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
-C-------------- End CDE --------------------------------
- CHARACTER LINE*110, LINETT*60
- EQUIVALENCE (LINE, SLLINE)
- EQUIVALENCE (LINETT, LINE(47:))
-
-
-C-- set limits of control division 2
-
- 21 LQCSTA(2) = LQCEND(1) + 100
- LQCEND(2) = LQCSTA(2)
-
-C-- clear text division 3
-
- LQLSTA(3) = LQLEND(2)
- LQLEND(3) = LQLSTA(3)
-
-C---- Ready the deck parameters
-
- IXEXDEC = 0
- LEXD = 0
- IF (JDKTYP.EQ.3) GO TO 46
-
- LINE(1:68) = ' '
- LINE(43:46) = '. d='
-C- ' <<< pname nnnnnn . d=
-C- '_:.=+=.: 1_:.=+=.: 2_:.=+=.: 3_:.=+=.: 4_:.=+=.: 5_:.=+=
-C- ' nnnnnn . d=dname
-C- ' F=fname ---- nnnnnn . title
-
- JSLF = IQ(LQHOLD+1)
- IF (JDKTYP.EQ.1) GO TO 42
-
-C-- deck header is +PATCH, name
-
- JCCTYP = MCCPAT
- CALL CCKRAK (JSLF)
- IXEXPAT = MCCPAR(JCCPP+1)
- IF (IXEXPAT.EQ.0) IXEXPAT= 1
-
- JD_DTN = 0
- IF (JCCBAD.EQ.0) CALL CCDOPT (1, JD_DTN)
- IF (JD_DTN.EQ.0) JD_DTN= 1
- JD_DTP = JD_DTN
- LASMT = LQ(LHASM-JD_DTN)
- IQ(LASMT+8) = IQ(LASMT+8) + 1
-
- CALL INDCRP (IXEXPAT,0)
- IF (MOPTIO(17).NE.0) GO TO 48
-
- CALL NA_GET (IXEXPAT, LINE,3)
- CALL CRIGHT (LINE,3,34)
- N = 46
- IF (MOPTIO(2).NE.0) GO TO 43
- IF (NCHCCT.LE.NCHCCD) GO TO 43
- CALL CCCOMG (1)
- IF (NCHCCC.EQ.0) GO TO 43
- JP = N + 13
- N = MIN (JP+NCHCCC, 110)
- NN = N - JP
- LINE(JP+1:JP+NN) = CCCOMF(1:NN)
- GO TO 43
-
-C-- deck header is +DECK, name
-
- 42 JCCTYP = MCCDEC
- CALL CCKRAK (JSLF)
- IXEXDEC = MCCPAR(JCCPD+1)
- IF (IXEXDEC.EQ.0) IXEXDEC= 1
-
- JD_DTN = 0
- IF (JCCBAD.EQ.0) CALL CCDOPT (1, JD_DTN)
- IF (JD_DTN.EQ.0) JD_DTN= JD_DTP
- LASMT = LQ(LHASM-JD_DTN)
- IQ(LASMT+8) = IQ(LASMT+8) + 1
-
- CALL INDCRD
- IF (MOPTIO(16).NE.0) GO TO 48
-
- CALL NA_GET (IXEXDEC, LINE,47)
- N = NESLAT - 1
- IF (MOPTIO(2).NE.0) GO TO 43
- IF (NCHCCT.LE.NCHCCD) GO TO 43
- CALL CCCOMG (1)
- IF (NCHCCC.EQ.0) GO TO 43
- JP = MAX (N+1, 46+16)
- N = MIN (JP+NCHCCC, 110)
- NN = N - JP
- LINE(JP+1:JP+NN) = CCCOMF(1:NN)
-
- 43 CALL CSETDI (NQDKNO, LINE,36,41)
- WRITE (IQPRNT,9043) LINE(1:N)
- 9043 FORMAT (A)
- NQUSED = NQUSED + 1
- GO TO 48
-
-C-- deck header is +TITLE or start of PAM
-
- 46 JD_DTP = 1
- CALL INDCRP (IXEXPAT,0)
-
- LINE(1:46) = ' F= ---- . '
-C- ' F=fname ---- nnnnnn . title
-C- '_:.=+=.: 1_:.=+=.: 2_:.=+=.: 3_:.=+=.: 4_:.=+=.: 5_:.=+=
-
- JSLTTL = IQ(LARRV+10)
- CALL LN_GET (JSLTTL, LINETT, 60)
- NTTL = NDSLAT
-
- IF (IQTYPE.NE.IQPRNT) WRITE (IQTYPE,9046) LINETT(1:NTTL)
- 9046 FORMAT (' Read Pam file: ',A/)
-
- CALL CSETDI (NQDKNO, LINE,36,41)
-
- CALL NA_GET (IXEXPAM, LINE,4)
-
- N = NTTL + 46
- IF (MOPTIO(17).EQ.0) THEN
- WRITE (IQPRNT,9047) LINE(1:N)
- ELSE
- WRITE (IQPRNT,9048) LINE(1:N)
- ENDIF
- NQUSED = NQUSED + 3
- 9047 FORMAT (/A/)
- 9048 FORMAT (/A)
-
-C------ Process the deck
-
- 48 IF (JDKNEX.EQ.0) CALL ARRIVE (2)
- IF (MOPTIO(24).NE.0) GO TO 88
-
-C-- analyse the contents
-
- CALL DOMAPA (0)
-
-C-- process the contents
-
- CALL INDXQT
-
-C-- step to the next deck
-
- 88 CALL ARRNXD (1)
- NQDKNO = NQDKNO + 1
- IFLGAR = 0
- IF (JDKTYP.LT.3) GO TO 21
- RETURN
- END
diff --git a/src/p5boot/p5lib/indxqt.f b/src/p5boot/p5lib/indxqt.f
deleted file mode 100644
index 6583fe0..0000000
--- a/src/p5boot/p5lib/indxqt.f
+++ /dev/null
@@ -1,72 +0,0 @@
-CDECK ID>, INDXQT.
- SUBROUTINE INDXQT
-
-C- Process the material according to the map for nyindex
-C. started 12-jan-94
-
- PARAMETER (MCCNIL=1, MCCKIL=2, MCCINC=3, MCCCDE=4, MCCSEQ=5,
- + MCCXSQ=6, MCCTRU=7, MCCFAL=8, MCCELS=9, MCCEND=10,
- + MCCSEL=11, MCCSES=12, MCCFAU=13, MCCSKI=14,
- + MCCKEE=15, MCCDEL=16, MCCREP=17, MCCADB=18, MCCADD=19,
- + MCCUSE=20, MCCXDI=21, MCCDIV=22, MCCLIS=23, MCCEXE=24, MCCIMI=25,
- + MCCASM=26, MCCUPD=27, MCCNAM=28, MCCGAP=29, MCCMOR=30, MCCONL=31,
- + MCCFOR=32, MCCSUS=33, MCCOPT=34, MCCOP2=35, MCCSHO=36, MCCPAM=37,
- + MCCQUI=38, MCCEOD=39, MCCDEC=40, MCCPAT=41, MCCTIT=42)
- CHARACTER CCKORG*256, CCKARD*256, CCCOMF*256
- COMMON /CCPARA/NCHCCD,NCHCCT, JCCTYP,JCCLEV,JCCSL,MCCPAR(240)
- +, NCCPAR,MXCCIF,JCCIFV,JCCBAD,JCCWAR,ICCSUB,JCCWK(4)
- +, JCCPP,JCCPD,JCCPZ,JCCPT,JCCPIF,JCCPC,JCCPN
- +, NCCPP,NCCPD,NCCPZ,NCCPT,NCCPIF,NCCPC,NCCPN
- +, JCCEND, NCHCCC,IXCCC, CCKORG, CCKARD, CCCOMF
- PARAMETER (KQGARB=1,KQARRV=3,KQKEEP=4,KQPREP=5,KQMAIN=6,KQPAST=8)
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
- COMMON /M_ANAC/LOWAN,KDOAN,LDOAN,LUPAN,MODEAN,MEXAN,LEVAN,KKM5AN
- +, NEWDEC,NEWCTL,NEWFOR,NEWNIL,NEWINC
-C-------------- End CDE --------------------------------
-
-
-
- LUPAN = 0
- LDOAN = KQPREP + 1
-
-C---- Next bank
-
- 21 LDOAN = LQ(LDOAN-1)
- IF (LDOAN.EQ.0) RETURN
-
- JCCTYP = JBYT (IQ(LDOAN),9,6)
- IF (JCCTYP.LE.MCCNIL) GO TO 21
-
-C-- Crack the c/line, register conditional patches
-
- CALL CCKRAK (IQ(LDOAN+1))
- IF (JCCBAD.NE.0) GO TO 21
-
- 24 IF (NCCPIF.EQ.0) GO TO 31
- IXCOND = MCCPAR(JCCPIF+1)
- CALL INDCRP (IXCOND,1)
- JCCPIF = JCCPIF + 3
- NCCPIF = NCCPIF - 1
- GO TO 24
-
-C-- Sequence definition, register name
-
- 31 IF (JCCTYP.NE.MCCKEE) GO TO 21
- IF (MOPTIO(26).NE.0) GO TO 21
- IXSEQ = MCCPAR(JCCPZ+1)
- CALL INDCRZ (IXSEQ)
- GO TO 21
- END
diff --git a/src/p5boot/p5lib/iniaux.f b/src/p5boot/p5lib/iniaux.f
deleted file mode 100644
index 15ca94a..0000000
--- a/src/p5boot/p5lib/iniaux.f
+++ /dev/null
@@ -1,107 +0,0 @@
-CDECK ID>, INIAUX.
- SUBROUTINE INIAUX (LASTWSP)
-
-C- Initialize for the Auxiliaries
-C. started 12-jan-94
-
- PARAMETER (KM1=1,KM2=2,KM3=4,KM4=8,KM5=16,KM6=32,KM7=64,KM8=128,
- + KM9=256, KM10=512, KM11=1024, KM12=2048, KM13=4096, KM14=8192,
- + KM15=16384, KM16=32768, KM17=65536, KM18=131072, KM19=262144)
- PARAMETER (NBANKS=19,JBKPAT=1, JBKDEC=2, JBKORG=3, JBKINC=4,
- + JBKHOL=5, JBKKEE=6, JBKACT=7, JBKMAT=8, JBKXSQ=9,
- + JBKPRE=10,JBKGAR=11,JBKSMH=12,JBKSMT=13,JBKSML=14,
- + JBKSMX=15,JBKARR=16,JBKASA=17,JBKPAM=18,JBKRPA=19)
- COMMON /QBANKS/MMBANK(5,NBANKS)
- PARAMETER (JFO_TYP=1, JCC_TYP=2, JAS_TYP=3, JDA_TYP=4,
- + JSH_TYP=5, JCR_TYP=6, JIN_TYP=7, MAX_TYP=100)
- CHARACTER*16 CH_TYP(MAX_TYP), ACT_TYP
- COMMON /CM_TYP/ LUN_TYP, N_TYP, NAL_TYP, NDV_TYP, JBK_TYP
- +, JU_TYP(MAX_TYP), CH_TYP, ACT_TYP
- CHARACTER CHTAG*80, CHWYL*16
- COMMON /TAGC/ LLORG,LNORG,LLACT,LNACT, LALTN,LMODE,NCHTAG
- +, CHTAG,CHWYL
- PARAMETER (NFIMAX=100)
- COMMON /TITLEC/ NFILET, JTIPAM(NFIMAX)
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
- COMMON /M_ANAC/LOWAN,KDOAN,LDOAN,LUPAN,MODEAN,MEXAN,LEVAN,KKM5AN
- +, NEWDEC,NEWCTL,NEWFOR,NEWNIL,NEWINC
-C-------------- End CDE --------------------------------
- DIMENSION LASTWSP(9)
-
-
- CALL MQWORK (LACRAD,INCRAD,LASTWSP)
- NFILET = 0
-
- NVGAP(1) = 4000
- NVGAP(2) = 200
- NVGAP(3) = 5000
- NVGAP(4) = 40
-
- NCHTAG = 0
- CALL VZERO (LOWAN,12)
-
-C-- Pre-lift the banks for I/O handling
-
- CALL MQLIFT (LACRAD, 0,7, JBKARR,3)
- CALL MQLIFT (LPAM, 0,7, JBKPAM,3)
- CALL MQLIFT (LQARRV, 0,7, JBKARR,3)
- CALL MQLIFT (LQHOLD, 0,7, JBKHOL,1)
- LARRV = LQARRV
-
-C---- Lift the ASM banks
-
- N_TYP = 0
- NAL_TYP = 2
-
- JAL = MAX_TYP - NAL_TYP
-
- CH_TYP(JAL+1) = 'R*EPEAT'
- CH_TYP(JAL+2) = 'J*OIN'
- JU_TYP(JAL+1) = -1
- JU_TYP(JAL+2) = -2
-
-C-- lift the support bank ASMH
-
- CALL MQLIFT (LHASM, 0,7, JBKSMH,3)
-
-C-- lift the ASMT banks
-
- CALL ASMCREA ('FORT', JASM, 0)
- CALL ASMCREA ('CC', JASM, 0)
- CALL ASMCREA ('AS', JASM, 0)
- CALL ASMCREA ('DATA', JASM, 0)
- CALL ASMCREA ('SHELL', JASM, 0)
- CALL ASMCREA ('CRAD', JASM, 0)
- CALL ASMCREA ('INCL', JASM, 0)
-
-C---- Create standard aliases
-
- JAL = JAL - 4
- CH_TYP(JAL+1) = 'CO*MPILE'
- CH_TYP(JAL+2) = 'X*CC'
- CH_TYP(JAL+3) = 'A*S*'
- CH_TYP(JAL+4) = 'D*ATA'
-
- JU_TYP(JAL+1) = JFO_TYP
- JU_TYP(JAL+2) = JCC_TYP
- JU_TYP(JAL+3) = JAS_TYP
- JU_TYP(JAL+4) = JDA_TYP
-
- NAL_TYP = MAX_TYP - JAL
-
-
- RETURN
- END
diff --git a/src/p5boot/p5lib/inipam.f b/src/p5boot/p5lib/inipam.f
deleted file mode 100644
index a39017d..0000000
--- a/src/p5boot/p5lib/inipam.f
+++ /dev/null
@@ -1,78 +0,0 @@
-CDECK ID>, INIPAM.
- SUBROUTINE INIPAM (LUNU, IXFILE, IFLAG,IFLEX)
-
-C- Connect PAM file for auxiliaries
-C- IFLAG => 0 start PAM file, with log print if >0
-C- < 0 close the PAM file
-C-
-C- IFLEX = 2 the file does not need to exist
-C- 0 fatal exit for OPEN failure
-C. started 12-jan-94
-
- COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT,NUSLAT(2),DUMMY(34)
- CHARACTER SLLINE*512, SLERRM*256
- COMMON /SLATLN/ SLLINE, SLERRM
- COMMON /QUNIT/ IQREAD,IQPRNT, IQTTIN,IQTYPE, IQOFFL,IQRTTY,IQRSAV
- +, IQRFD,IQRRD,IQRSIZ, NQLPAT,NQUSED,NQLLBL, NQINIT
- COMMON /ARRCOM/IN_LUN, IN_FD, IN_FIO, IN_EOF
- +, IN_DOX, IN_DO1, IN_DO2
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
- PARAMETER (NSLIFI=128)
- CHARACTER CHLIFI*(NSLIFI), CHLIEX*8
- COMMON /FLINKC/LUNOP,LUNFD,LUNOLD,LUNSIZ
- +, IXFLUN, NLIFI,CHLIFI,CHLIEX
-C-------------- End CDE --------------------------------
-
-C---- Connect the PAM file
-
- IF (IFLAG.LT.0) GO TO 41
-
- IN_LUN = LUNU
- IXFLUN = IXFILE
- IF (IXFLUN.EQ.0) GO TO 91
-
- CALL FLINK (IN_LUN, 2, -1, IFLEX)
- IF (IXFLUN.LT.0) RETURN
- IQ(LARRV+1) = IN_LUN
- IQ(LARRV+2) = LUNFD
- IQ(LARRV+4) = IXFLUN
- IQ(LARRV+6) = LUNSIZ
- IQ(LARRV+7) = -2
- IF (LUNSIZ.GT.0) IQ(LARRV+7)= 0
- JDKTYP = 3
- JDKNEX = 0
- IF (IFLAG.EQ.0) RETURN
-C-- Print log of file reading
-
- SLLINE(1:25) = ' ---> start reading file '
- CALL NA_GET (IXFLUN,SLLINE,26)
- NTXT = NESLAT - 1
- CALL DPBLAN (0)
- WRITE (IQPRNT,9027) SLLINE(1:NTXT)
- IF (IQTYPE.NE.IQPRNT) WRITE (IQTYPE,9027) SLLINE(1:NTXT)
- 9027 FORMAT (A/)
- RETURN
-
-C---- Disconnect the PAM file
-
- 41 IN_DOX = -1
- CALL ARRIN
- RETURN
-
-C---- Trouble
-
- 91 CALL P_KILL ('No PAM file name given')
- END
diff --git a/src/p5boot/p5lib/iniseq.f b/src/p5boot/p5lib/iniseq.f
deleted file mode 100644
index 14aee21..0000000
--- a/src/p5boot/p5lib/iniseq.f
+++ /dev/null
@@ -1,59 +0,0 @@
-CDECK ID>, INISEQ.
- SUBROUTINE INISEQ
-
-C- Initialize the built-in sequences
-C. started 12-jan-94
-
- PARAMETER (KM1=1,KM2=2,KM3=4,KM4=8,KM5=16,KM6=32,KM7=64,KM8=128,
- + KM9=256, KM10=512, KM11=1024, KM12=2048, KM13=4096, KM14=8192,
- + KM15=16384, KM16=32768, KM17=65536, KM18=131072, KM19=262144)
- CHARACTER CQBLAN*128, CQEQS*128, CQCETA*32
- CHARACTER CQAPO*1, CQBSL*1, CQTAB*1
- COMMON /QCHAR/ CQBLAN, CQEQS, CQCETA, CQAPO, CQBSL, CQTAB
- CHARACTER CQDATEM*10, CQDATE*8, CQTIME*5
- COMMON /QSTATE/NQERR,NQWARN,NQINFO,NQLOCK
- +, IQDATE,IQTIME, CQDATEM,CQDATE,CQTIME
- CHARACTER CCKORG*256, CCKARD*256, CCCOMF*256
- COMMON /CCPARA/NCHCCD,NCHCCT, JCCTYP,JCCLEV,JCCSL,MCCPAR(240)
- +, NCCPAR,MXCCIF,JCCIFV,JCCBAD,JCCWAR,ICCSUB,JCCWK(4)
- +, JCCPP,JCCPD,JCCPZ,JCCPT,JCCPIF,JCCPC,JCCPN
- +, NCCPP,NCCPD,NCCPZ,NCCPT,NCCPIF,NCCPC,NCCPN
- +, JCCEND, NCHCCC,IXCCC, CCKORG, CCKARD, CCCOMF
- PARAMETER (JSPSEQ1=3, JSPDATE=9, JSPSEQL=15)
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
-C-------------- End CDE --------------------------------
-
-
- CCKARD = ' '
- CCKARD(1:1) = CQBSL
- CCKARD(2:2) = CQBSL
- N = LNBLNK (CCKARD(1:8))
- JSLH = LN_TO4 (CCKARD,N)
-
- CCKARD(1:20) = ' IDATQQ= 00 '
-C- _:.=+=.:_1_:.=+=.:_2
- CALL CSETDI (IQDATE,CCKARD,15,20)
- JSLD = LN_TO4 (CCKARD,20)
-
- CCKARD(1:18) = ' ITIMQQ= '
-C- _:.=+=.:_1_:.=+=.:_2
- CALL CSETDI (IQTIME,CCKARD,15,18)
- JSLT = LN_TO4 (CCKARD,18)
-
- CALL INISQX ('QTERMHD', 0, JSLH, KM5+KM6)
- CALL INISQX ('DATEQQ', 0, JSLD, KM5+KM6)
- CALL INISQX ('TIMEQQ', 0, JSLT, KM5+KM6)
-
- MASK = KM13+KM5+KM6
- DO 64 IX=JSPSEQ1,JSPSEQL
- 64 CALL INISQX (' ', IX, 1, MASK)
- RETURN
-
- END
diff --git a/src/p5boot/p5lib/inisqx.f b/src/p5boot/p5lib/inisqx.f
deleted file mode 100644
index 3ce4872..0000000
--- a/src/p5boot/p5lib/inisqx.f
+++ /dev/null
@@ -1,44 +0,0 @@
-CDECK ID>, INISQX.
- SUBROUTINE INISQX (CHNAME,IXSEQ,JSL,MASK)
-
-C- Create KEEP bank for special sequence
-C. started 11-feb-92
-
- PARAMETER (NBANKS=19,JBKPAT=1, JBKDEC=2, JBKORG=3, JBKINC=4,
- + JBKHOL=5, JBKKEE=6, JBKACT=7, JBKMAT=8, JBKXSQ=9,
- + JBKPRE=10,JBKGAR=11,JBKSMH=12,JBKSMT=13,JBKSML=14,
- + JBKSMX=15,JBKARR=16,JBKASA=17,JBKPAM=18,JBKRPA=19)
- COMMON /QBANKS/MMBANK(5,NBANKS)
- PARAMETER (KQGARB=1,KQARRV=3,KQKEEP=4,KQPREP=5,KQMAIN=6,KQPAST=8)
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
-C-------------- End CDE --------------------------------
- CHARACTER CHNAME*(*)
-
- IOR (IZV,IZW) = OR (IZV, IZW)
-
-
- IXNAME = IXSEQ
- IF (IXNAME.EQ.0) IXNAME = NA_LONG (CHNAME)
-
- CALL MQLIFT (L,KQKEEP,0,JBKKEE,1)
-
- IQ(L) = IOR (IQ(L),MASK)
- LQ(L-3) = LDECO
- IQ(L+1) = JSL
- IQ(L+2) = 1
- IQ(L+4) = IXNAME
- RETURN
- END
diff --git a/src/p5boot/p5lib/iqlocf.f b/src/p5boot/p5lib/iqlocf.f
deleted file mode 100644
index 60d9796..0000000
--- a/src/p5boot/p5lib/iqlocf.f
+++ /dev/null
@@ -1,18 +0,0 @@
-CDECK ID>, IQLOCF.
- FUNCTION IQLOCF (VAR)
-
-C- Return the address of VAR in LQ
-
- COMMON /MQCM/ NQSYSS,NQLINK, LQCSTA(3),LQCEND(3), NQMAX
- +, LQLSTA(5),LQLEND(5), LQADR,LQADR0,NQOFFS
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ)
- EQUIVALENCE (LQ,IQ,LQGARB)
- COMMON // IQUEST(100),LQGARB
-C-------------- End CDE --------------------------------
- DIMENSION VAR(9)
-
-
- IQLOCF = LOCF(VAR(1)) - LQADR0
- RETURN
- END
diff --git a/src/p5boot/p5lib/jptype.f b/src/p5boot/p5lib/jptype.f
deleted file mode 100644
index ccb6348..0000000
--- a/src/p5boot/p5lib/jptype.f
+++ /dev/null
@@ -1,129 +0,0 @@
-CDECK ID>, JPTYPE.
- FUNCTION JPTYPE (LINE)
-
-C- Find control-card type of line in LINE(1:N)
-C- without looking at the control-character in LINE(1:1)
-
- PARAMETER (MCCNIL=1, MCCKIL=2, MCCINC=3, MCCCDE=4, MCCSEQ=5,
- + MCCXSQ=6, MCCTRU=7, MCCFAL=8, MCCELS=9, MCCEND=10,
- + MCCSEL=11, MCCSES=12, MCCFAU=13, MCCSKI=14,
- + MCCKEE=15, MCCDEL=16, MCCREP=17, MCCADB=18, MCCADD=19,
- + MCCUSE=20, MCCXDI=21, MCCDIV=22, MCCLIS=23, MCCEXE=24, MCCIMI=25,
- + MCCASM=26, MCCUPD=27, MCCNAM=28, MCCGAP=29, MCCMOR=30, MCCONL=31,
- + MCCFOR=32, MCCSUS=33, MCCOPT=34, MCCOP2=35, MCCSHO=36, MCCPAM=37,
- + MCCQUI=38, MCCEOD=39, MCCDEC=40, MCCPAT=41, MCCTIT=42)
-C-------------- End CDE --------------------------------
- CHARACTER LINE(64)*1, CHWK*4, CHWK1*1, CHWK2*1, CHWK3*1
- EQUIVALENCE (CHWK1,CHWK(1:1)),(CHWK2,CHWK(2:2)),(CHWK3,CHWK(3:3))
-
- PARAMETER (NPOSSA = 39)
- CHARACTER POSS(NPOSSA)*4
- DIMENSION MTYPE(NPOSSA)
-
- DATA POSS / '+CDE' , '+SEQ' , '+SEL' , '+NIL' , '+INC'
- +, '+IF,' , '+IFN' , '+ELS' , '+END'
- +, '+KEE' , '+REP' , '+ADD' , '+ADB' , '+DEL'
- +, '+DEC' , '+PAT' , '+TIT' , '+EOD' , '+SKI'
- +, '+USE' , '+EXE' , '+LIS' , '+DIV' , '+XDI' , '+IMI'
- +, '+OPT' , '+PAR' , '+SHO'
- +, '+ASM' , '+ONL' , '+FOR' , '+SUP'
- +, '+NAM' , '+GAP' , '+UPD' , '+MOR'
- +, '+PAM' , '+QUI' , '+KIL' /
-
- DATA MTYPE / MCCCDE , MCCSEQ , MCCSEL , MCCNIL , MCCINC
- +, MCCTRU , MCCFAL , MCCELS , MCCEND
- +, MCCKEE , MCCREP , MCCADD , MCCADB , MCCDEL
- +, MCCDEC , MCCPAT , MCCTIT , MCCEOD , MCCSKI
- +, MCCUSE , MCCEXE , MCCLIS , MCCDIV , MCCXDI , MCCIMI
- +, MCCOPT , MCCOP2 , MCCSHO
- +, MCCASM , MCCONL , MCCFOR , MCCSUS
- +, MCCNAM , MCCGAP , MCCUPD , MCCMOR
- +, MCCPAM , MCCQUI , MCCKIL /
-
-
- IF (LINE(2).EQ.'_') GO TO 61
-
-C-- scan normal possibilities
-
- JPOSS = 0
- 22 JPOSS = JPOSS + 1
- IF (JPOSS.GT.NPOSSA) GO TO 29
- JC = 2
- IVP = ICHAR(POSS(JPOSS)(2:2))
- IVT = ICHAR(LINE(2))
- 24 IF (IVT.NE.IVP) THEN
- IF (IVT-IVP.NE.32) GO TO 22
- ENDIF
- IF (JC.EQ.4) GO TO 41
- JC = JC + 1
- IVP = ICHAR(POSS(JPOSS)(JC:JC))
- IVT = ICHAR(LINE(JC))
- GO TO 24
-
-C-- not a Patchy key
-
- 29 JTYPE = 0
- GO TO 42
-
-C---- return
-
- 41 JTYPE = MTYPE(JPOSS)
- 42 JPTYPE = JTYPE
- RETURN
-
-C-- handle +___IF, IFNOT, ELSE, ENDIF
-
- 61 JF = 2
- 62 JF = JF + 1
- IF (LINE(JF).EQ.'_') GO TO 62
-
- CHWK(1:1) = LINE(JF)
- CHWK(2:2) = LINE(JF+1)
- CHWK(3:3) = LINE(JF+2)
- IF (CHWK1.EQ.'I') GO TO 71
- IF (CHWK1.EQ.'i') GO TO 71
- IF (CHWK1.NE.'E') THEN
- IF (CHWK1.NE.'e') GO TO 29
- ENDIF
-
-C-- ELSE or ENDIF
-
- IF (CHWK2.EQ.'L') GO TO 64
- IF (CHWK2.EQ.'l') GO TO 64
- IF (CHWK2.NE.'N') THEN
- IF (CHWK2.NE.'n') GO TO 29
- ENDIF
- IF (CHWK3.NE.'D') THEN
- IF (CHWK3.NE.'d') GO TO 29
- ENDIF
- JTYPE = MCCEND
- GO TO 42
-
-C-- ELSE
-
- 64 IF (CHWK3.NE.'S') THEN
- IF (CHWK3.NE.'s') GO TO 29
- ENDIF
- JTYPE = MCCELS
- GO TO 42
-
-C-- IF or IFNOT
-
- 71 IF (CHWK2.NE.'F') THEN
- IF (CHWK2.NE.'f') GO TO 29
- ENDIF
- IF (CHWK3.NE.'N') THEN
- IF (CHWK3.NE.'n') GO TO 74
- ENDIF
- JTYPE = MCCFAL
- GO TO 42
-
-C-- IF,
-
- 74 JF = JF + 1
- 75 JF = JF + 1
- IF (LINE(JF).EQ.' ') GO TO 75
- IF (LINE(JF).NE.',') GO TO 29
- JTYPE = MCCTRU
- GO TO 42
- END
diff --git a/src/p5boot/p5lib/kqfind.f b/src/p5boot/p5lib/kqfind.f
deleted file mode 100644
index 8020326..0000000
--- a/src/p5boot/p5lib/kqfind.f
+++ /dev/null
@@ -1,26 +0,0 @@
-CDECK ID>, KQFIND.
- FUNCTION KQFIND (IT,JWORD,KGO,KFOUND)
-
-C- Find first bank containing IT in word JWORD
-C- search linear structure attached at LQ(KGO)
-C- return its bank-adr as value, its K-adr in KFOUND
-C- if not found: KQFIND=0, KFOUND = L-1 of last bank
-
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ)
- EQUIVALENCE (LQ,IQ,LQGARB)
- COMMON // IQUEST(100),LQGARB
-C-------------- End CDE --------------------------------
-
-
- JW = JWORD
- L = KGO + 1
- 24 K = L-1
- L = LQ(K)
- IF (L.EQ.0) GO TO 29
- IF (IQ(L+JW).NE.IT) GO TO 24
-
- 29 KFOUND = K
- KQFIND = L
- RETURN
- END
diff --git a/src/p5boot/p5lib/kqlast.f b/src/p5boot/p5lib/kqlast.f
deleted file mode 100644
index 719b822..0000000
--- a/src/p5boot/p5lib/kqlast.f
+++ /dev/null
@@ -1,19 +0,0 @@
-CDECK ID>, KQLAST.
- FUNCTION KQLAST (KGO)
-
-C-- Find the end of a linear structure attached to LQ(KGO)
-
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ)
- EQUIVALENCE (LQ,IQ,LQGARB)
- COMMON // IQUEST(100),LQGARB
-C-------------- End CDE --------------------------------
-
-
- L = KGO + 1
- 24 K = L-1
- L = LQ(K)
- IF (L.NE.0) GO TO 24
- KQLAST= K
- RETURN
- END
diff --git a/src/p5boot/p5lib/kropt.f b/src/p5boot/p5lib/kropt.f
deleted file mode 100644
index 4f34cbf..0000000
--- a/src/p5boot/p5lib/kropt.f
+++ /dev/null
@@ -1,48 +0,0 @@
-CDECK ID>, KROPT.
- SUBROUTINE KROPT (IXOPT,MASK)
-
-C- Krack the option parameter into MOPTIO(34)
-C. started 13-jan-94
-
- COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT,NUSLAT(2),DUMMY(34)
- CHARACTER SLLINE*512, SLERRM*256
- COMMON /SLATLN/ SLLINE, SLERRM
- CHARACTER CQBLAN*128, CQEQS*128, CQCETA*32
- CHARACTER CQAPO*1, CQBSL*1, CQTAB*1
- COMMON /QCHAR/ CQBLAN, CQEQS, CQCETA, CQAPO, CQBSL, CQTAB
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
-C-------------- End CDE --------------------------------
- CHARACTER LINE*80, COL(80)*1
- EQUIVALENCE (LINE,SLLINE), (COL,SLLINE)
-
- IAND (IZV,IZW) = AND (IZV, IZW)
-
-
- MOPTIO(34) = 0
- IF (IXOPT.EQ.0) GO TO 37
-
- CALL NA_GET (IXOPT,LINE,1)
- NN = NDSLAT
-
- DO 24 JL=1,NN
- J = INDEX (CQCETA(1:32),COL(JL))
- IF (J.NE.0) CALL SBIT1 (MOPTIO(34),J)
- 24 CONTINUE
-
- 37 MOPTIO(33) = IAND (MOPTIO(34),MASK)
- CALL UPKBYT (MOPTIO(33),1,MOPTIO(1),32,0)
- RETURN
- END
diff --git a/src/p5boot/p5lib/krtitl.f b/src/p5boot/p5lib/krtitl.f
deleted file mode 100644
index 14b2f1d..0000000
--- a/src/p5boot/p5lib/krtitl.f
+++ /dev/null
@@ -1,103 +0,0 @@
-CDECK ID>, KRTITL.
- SUBROUTINE KRTITL
-
-C- Krack the current title
-C. started 12-jan-94
-
- COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT,NUSLAT(2),DUMMY(34)
- PARAMETER (MCCNIL=1, MCCKIL=2, MCCINC=3, MCCCDE=4, MCCSEQ=5,
- + MCCXSQ=6, MCCTRU=7, MCCFAL=8, MCCELS=9, MCCEND=10,
- + MCCSEL=11, MCCSES=12, MCCFAU=13, MCCSKI=14,
- + MCCKEE=15, MCCDEL=16, MCCREP=17, MCCADB=18, MCCADD=19,
- + MCCUSE=20, MCCXDI=21, MCCDIV=22, MCCLIS=23, MCCEXE=24, MCCIMI=25,
- + MCCASM=26, MCCUPD=27, MCCNAM=28, MCCGAP=29, MCCMOR=30, MCCONL=31,
- + MCCFOR=32, MCCSUS=33, MCCOPT=34, MCCOP2=35, MCCSHO=36, MCCPAM=37,
- + MCCQUI=38, MCCEOD=39, MCCDEC=40, MCCPAT=41, MCCTIT=42)
- CHARACTER CCKORG*256, CCKARD*256, CCCOMF*256
- COMMON /CCPARA/NCHCCD,NCHCCT, JCCTYP,JCCLEV,JCCSL,MCCPAR(240)
- +, NCCPAR,MXCCIF,JCCIFV,JCCBAD,JCCWAR,ICCSUB,JCCWK(4)
- +, JCCPP,JCCPD,JCCPZ,JCCPT,JCCPIF,JCCPC,JCCPN
- +, NCCPP,NCCPD,NCCPZ,NCCPT,NCCPIF,NCCPC,NCCPN
- +, JCCEND, NCHCCC,IXCCC, CCKORG, CCKARD, CCCOMF
- CHARACTER CHEXPD*68
- COMMON /CHEXC/ IXEXPAM, IXEXPAT,IXEXDEC,IXEXID, NCHEPD, CHEXPD
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
-C-------------- End CDE --------------------------------
-
-
- JSLT = IQ(LQHOLD+1)
- JSLE = IQ(LQHOLD+3) + JSLT
- JTXT = MLIAD(JSLT)
- NTXT = MLIAD(JSLT+1) - JTXT - NCHNEWL
-
-C-- do +TITLE: name version /sub text
-
- JCCTYP = 0
- IF (TEXT(JTXT).NE.'+') GO TO 33
- JCCTYP = JPTYPE (TEXT(JTXT))
- IF (JCCTYP.EQ.0) GO TO 33
- IF (JCCTYP.NE.MCCTIT) GO TO 37
- N = MIN (12,NTXT)
- JF = ICFIND (':',TEXT(JTXT),1,N)
- IF (JF.GT.N) GO TO 32
- IF (JF.EQ.NTXT) GO TO 32
- JF = ICNEXT (TEXT(JTXT),JF+1,NTXT)
- NCHNAM = NDSLAT
- IF (JF.LT.NTXT) GO TO 36
-
-C-- take the title from the first non-blank line in the deck
-
- 32 JSLT = JSLT + 1
- IF (JSLT.GE.JSLE) GO TO 37
- JTXT = MLIAD(JSLT)
- NTXT = MLIAD(JSLT+1) - JTXT - NCHNEWL
- IF (TEXT(JTXT).NE.'+') GO TO 33
- JCCTYP = JPTYPE (TEXT(JTXT))
- IF (JCCTYP.NE.0) GO TO 37
- 33 JF = 0
- 34 JF = ICNEXT (TEXT(JTXT),JF+1,NTXT)
- IF (JF.GT.NTXT) GO TO 32
- NCHNAM = NDSLAT
- IF (NCHNAM.EQ.1) THEN
- IF (TEXT(JTXT+JF-1).EQ.'C') GO TO 34
- IF (TEXT(JTXT+JF-1).EQ.'*') GO TO 34
- ENDIF
-
-C-- got the title
-
- 36 JTXT = JTXT + JF - 1
- NTXT = NTXT - JF + 1
- NTXT = MIN (NTXT, 80)
- CCKARD(1:1) = '@'
- CALL CCOPYL (TEXT(JTXT),CCKARD(2:NTXT+1),NTXT)
- CALL CLTOU (CCKARD(1:NCHNAM+1))
- GO TO 38
-
-C-- fake title for file starting with +PATCH or +DECK
-
- 37 CCKARD(1:8) = '@unknown'
- NCHNAM = 7
- NTXT = 7
-
- 38 JSLTTL = LN_TO4 (CCKARD(2:), NTXT)
- IXEXPAM = NA_NEW (CCKARD,2,NCHNAM+2)
- IXEXPAT = NA_NEW (CCKARD,1,NCHNAM+2)
- IXEXID = IXEXPAT
-
- IQ(LARRV+10) = JSLTTL
- IQ(LARRV+11) = IXEXPAM
- RETURN
- END
diff --git a/src/p5boot/p5lib/lideck.f b/src/p5boot/p5lib/lideck.f
deleted file mode 100644
index 5cdbbde..0000000
--- a/src/p5boot/p5lib/lideck.f
+++ /dev/null
@@ -1,126 +0,0 @@
-CDECK ID>, LIDECK.
- SUBROUTINE LIDECK
-
-C- List all decks until next +TITLE
-C. started 12-jan-94
-
- PARAMETER (KM1=1,KM2=2,KM3=4,KM4=8,KM5=16,KM6=32,KM7=64,KM8=128,
- + KM9=256, KM10=512, KM11=1024, KM12=2048, KM13=4096, KM14=8192,
- + KM15=16384, KM16=32768, KM17=65536, KM18=131072, KM19=262144)
- COMMON /QPAGE/ NQLMAX,NQLTOL,NQLTOK,NQCMAX,NQCPGH,NQPAGE
- +, NQWYLDO,NQWYL,NQNEWH,NQJOIN,NQDKNO,NQDKPG
- PARAMETER (MCCNIL=1, MCCKIL=2, MCCINC=3, MCCCDE=4, MCCSEQ=5,
- + MCCXSQ=6, MCCTRU=7, MCCFAL=8, MCCELS=9, MCCEND=10,
- + MCCSEL=11, MCCSES=12, MCCFAU=13, MCCSKI=14,
- + MCCKEE=15, MCCDEL=16, MCCREP=17, MCCADB=18, MCCADD=19,
- + MCCUSE=20, MCCXDI=21, MCCDIV=22, MCCLIS=23, MCCEXE=24, MCCIMI=25,
- + MCCASM=26, MCCUPD=27, MCCNAM=28, MCCGAP=29, MCCMOR=30, MCCONL=31,
- + MCCFOR=32, MCCSUS=33, MCCOPT=34, MCCOP2=35, MCCSHO=36, MCCPAM=37,
- + MCCQUI=38, MCCEOD=39, MCCDEC=40, MCCPAT=41, MCCTIT=42)
- CHARACTER CCKORG*256, CCKARD*256, CCCOMF*256
- COMMON /CCPARA/NCHCCD,NCHCCT, JCCTYP,JCCLEV,JCCSL,MCCPAR(240)
- +, NCCPAR,MXCCIF,JCCIFV,JCCBAD,JCCWAR,ICCSUB,JCCWK(4)
- +, JCCPP,JCCPD,JCCPZ,JCCPT,JCCPIF,JCCPC,JCCPN
- +, NCCPP,NCCPD,NCCPZ,NCCPT,NCCPIF,NCCPC,NCCPN
- +, JCCEND, NCHCCC,IXCCC, CCKORG, CCKARD, CCCOMF
- CHARACTER CHEXPD*68
- COMMON /CHEXC/ IXEXPAM, IXEXPAT,IXEXDEC,IXEXID, NCHEPD, CHEXPD
- COMMON /MUSEBC/ MX_FORC, MU_GLOB, MU_PAT, MU_DECK, MU_INH, MU_FORG
- +, MX_TRAN, MX_FORG, MX_SINH, MX_SELF, NVEXDK(6)
- COMMON /MQCM/ NQSYSS,NQLINK, LQCSTA(3),LQCEND(3), NQMAX
- +, LQLSTA(5),LQLEND(5), LQADR,LQADR0,NQOFFS
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
-C-------------- End CDE --------------------------------
-
-C-- Check file starts with +PATCH or +DECK
-
- IF (JCCTYP.EQ.MCCDEC) JDKTYP= 1
- IF (JCCTYP.EQ.MCCPAT) JDKTYP= 2
-
-C-- set operation mode
-
- NVEXDK(1) = 0
- NVEXDK(2) = 1
- NVEXDK(5) = 1
- NVEXDK(6) = 1
-
-C-- set limits of control division 2
-
- 21 LQCSTA(2) = LQCEND(1) + 100
- LQCEND(2) = LQCSTA(2)
-
-C-- clear text division 3
-
- LQLSTA(3) = LQLEND(2)
- LQLEND(3) = LQLSTA(3)
-
-C------ Ready the deck parameters
-
- NQNEWH = 7
- IF (JDKTYP.EQ.1) GO TO 42
- IXEXDEC = 0
- IF (JDKTYP.EQ.2) GO TO 41
-
-C-- deck header is +TITLE or start of PAM
-
- CALL DPHEAD
- NQJOIN = -1
- GO TO 47
-
-C-- deck header is +PATCH, name
-
- 41 JSLF = IQ(LQHOLD+1)
- JCCTYP = MCCPAT
- CALL CCKRAK (JSLF)
- IXEXPAT = MCCPAR(JCCPP+1)
- IF (IXEXPAT.EQ.0) IXEXPAT= 1
- IXEXID = IXEXPAT
- GO TO 44
-
-C-- deck header is +DECK, name
-
- 42 JSLF = IQ(LQHOLD+1)
- JCCTYP = MCCDEC
- CALL CCKRAK (JSLF)
- IXEXDEC = MCCPAR(JCCPD+1)
- IF (IXEXDEC.EQ.0) IXEXDEC= 1
- IXEXID = IXEXDEC
-
- 44 CALL CCJOIN
-
-C------ Process the deck
-
- 47 LEXD = 0
- NSLORG = 0
-
- IF (JDKNEX.EQ.0) CALL ARRIVE (2)
-
-C-- analyse the contents
-
- CALL DOMAPA (0)
-
-C-- process the contents
-
- CALL LIXQT
-
-C-- step to the next deck
-
- 88 CALL ARRNXD (1)
- NQDKNO = NQDKNO + 1
- IFLGAR = 0
- IF (JDKTYP.LT.3) GO TO 21
- RETURN
- END
diff --git a/src/p5boot/p5lib/liftsq.f b/src/p5boot/p5lib/liftsq.f
deleted file mode 100644
index f9f2e26..0000000
--- a/src/p5boot/p5lib/liftsq.f
+++ /dev/null
@@ -1,73 +0,0 @@
-CDECK ID>, LIFTSQ.
- FUNCTION LIFTSQ (KJOIN,JTYPE,JSLCL,JDIV)
-
-C- Lift a sequence call bank
-C- KJOIN K-adr of the bank to be lifted
-C- JTYPE CC type to be stored
-C- JSLCL slot number of the control-line
-C- if this is non-zero the line will be cracked
-C- but in this case it must be +SEQ
-C- JDIV division number for lifting
-C-
-C- Return adr of the bank lifted as function value
-C- and IQUEST(1) the number of sequence calls lost:
-C- Note that no bank may have more than 63 links!
-C# started 18-dec-91
-
- PARAMETER (KM1=1,KM2=2,KM3=4,KM4=8,KM5=16,KM6=32,KM7=64,KM8=128,
- + KM9=256, KM10=512, KM11=1024, KM12=2048, KM13=4096, KM14=8192,
- + KM15=16384, KM16=32768, KM17=65536, KM18=131072, KM19=262144)
- PARAMETER (KMA=1,KMB=2,KMC=4,KMD=8,KME=16,KMF=32,KMG=64,KMH=128,
- + KMI=256, KMJ=512, KMK=KM11, KML=KM12, KMM=KM13, KMN=KM14,
- + KMO=KM15, KMP=KM16, KMQ=KM17, KMR=KM18, KMS=KM19)
- PARAMETER (NBANKS=19,JBKPAT=1, JBKDEC=2, JBKORG=3, JBKINC=4,
- + JBKHOL=5, JBKKEE=6, JBKACT=7, JBKMAT=8, JBKXSQ=9,
- + JBKPRE=10,JBKGAR=11,JBKSMH=12,JBKSMT=13,JBKSML=14,
- + JBKSMX=15,JBKARR=16,JBKASA=17,JBKPAM=18,JBKRPA=19)
- COMMON /QBANKS/MMBANK(5,NBANKS)
- PARAMETER (MCCNIL=1, MCCKIL=2, MCCINC=3, MCCCDE=4, MCCSEQ=5,
- + MCCXSQ=6, MCCTRU=7, MCCFAL=8, MCCELS=9, MCCEND=10,
- + MCCSEL=11, MCCSES=12, MCCFAU=13, MCCSKI=14,
- + MCCKEE=15, MCCDEL=16, MCCREP=17, MCCADB=18, MCCADD=19,
- + MCCUSE=20, MCCXDI=21, MCCDIV=22, MCCLIS=23, MCCEXE=24, MCCIMI=25,
- + MCCASM=26, MCCUPD=27, MCCNAM=28, MCCGAP=29, MCCMOR=30, MCCONL=31,
- + MCCFOR=32, MCCSUS=33, MCCOPT=34, MCCOP2=35, MCCSHO=36, MCCPAM=37,
- + MCCQUI=38, MCCEOD=39, MCCDEC=40, MCCPAT=41, MCCTIT=42)
- CHARACTER CCKORG*256, CCKARD*256, CCCOMF*256
- COMMON /CCPARA/NCHCCD,NCHCCT, JCCTYP,JCCLEV,JCCSL,MCCPAR(240)
- +, NCCPAR,MXCCIF,JCCIFV,JCCBAD,JCCWAR,ICCSUB,JCCWK(4)
- +, JCCPP,JCCPD,JCCPZ,JCCPT,JCCPIF,JCCPC,JCCPN
- +, NCCPP,NCCPD,NCCPZ,NCCPT,NCCPIF,NCCPC,NCCPN
- +, JCCEND, NCHCCC,IXCCC, CCKORG, CCKARD, CCCOMF
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ)
- EQUIVALENCE (LQ,IQ,LQGARB)
- COMMON // IQUEST(100),LQGARB
-C-------------- End CDE --------------------------------
- IAND (IZV,IZW) = AND (IZV, IZW)
- IOR (IZV,IZW) = OR (IZV, IZW)
- ISHFTL (IZW,NZB) = LSHIFT (IZW, NZB)
-
-
- IF (JSLCL.NE.0) THEN
- JCCTYP = MCCSEQ
- CALL CCKRAK (JSLCL)
- ENDIF
-
- NPZORG = NCCPZ
- NCCPZ = MIN (NCCPZ,61)
-
- MMBANK(3,JBKXSQ) = NCCPZ + 2
- MMBANK(5,JBKXSQ) = NCCPZ + 4
- CALL MQLIFT (LX,KJOIN,0,JBKXSQ,JDIV)
-
- IQ(LX) = IOR (IQ(LX), ISHFTL(JTYPE,8))
- IQ(LX) = IOR (IQ(LX), IAND(MCCPAR(JCCPT+1),KMP))
-
- IQ(LX+4) = NCCPZ
- CALL UCOCOP (MCCPAR(JCCPZ+1),IQ(LX+5),NCCPZ,1,3,1)
-
- IQUEST(1) = NPZORG - NCCPZ
- LIFTSQ = LX
- RETURN
- END
diff --git a/src/p5boot/p5lib/linksq.f b/src/p5boot/p5lib/linksq.f
deleted file mode 100644
index db6051d..0000000
--- a/src/p5boot/p5lib/linksq.f
+++ /dev/null
@@ -1,183 +0,0 @@
-CDECK ID>, LINKSQ.
- FUNCTION LINKSQ (LXX,LYY)
-
-C- if LXX not zero:
-C- connect all KEEP banks of the sequences called by
-C- the call bank at LXX;
-C- if LXX is zero:
-C- finalize only the sequence whose KEEP bank is LYYY;
-C- finalizing all global KEEPs called directly or indirectly,
-C- collect EXE bits and return them as function value
-C. started 28-nov-91
-
- PARAMETER (KM1=1,KM2=2,KM3=4,KM4=8,KM5=16,KM6=32,KM7=64,KM8=128,
- + KM9=256, KM10=512, KM11=1024, KM12=2048, KM13=4096, KM14=8192,
- + KM15=16384, KM16=32768, KM17=65536, KM18=131072, KM19=262144)
- PARAMETER (MCCNIL=1, MCCKIL=2, MCCINC=3, MCCCDE=4, MCCSEQ=5,
- + MCCXSQ=6, MCCTRU=7, MCCFAL=8, MCCELS=9, MCCEND=10,
- + MCCSEL=11, MCCSES=12, MCCFAU=13, MCCSKI=14,
- + MCCKEE=15, MCCDEL=16, MCCREP=17, MCCADB=18, MCCADD=19,
- + MCCUSE=20, MCCXDI=21, MCCDIV=22, MCCLIS=23, MCCEXE=24, MCCIMI=25,
- + MCCASM=26, MCCUPD=27, MCCNAM=28, MCCGAP=29, MCCMOR=30, MCCONL=31,
- + MCCFOR=32, MCCSUS=33, MCCOPT=34, MCCOP2=35, MCCSHO=36, MCCPAM=37,
- + MCCQUI=38, MCCEOD=39, MCCDEC=40, MCCPAT=41, MCCTIT=42)
- CHARACTER CCKORG*256, CCKARD*256, CCCOMF*256
- COMMON /CCPARA/NCHCCD,NCHCCT, JCCTYP,JCCLEV,JCCSL,MCCPAR(240)
- +, NCCPAR,MXCCIF,JCCIFV,JCCBAD,JCCWAR,ICCSUB,JCCWK(4)
- +, JCCPP,JCCPD,JCCPZ,JCCPT,JCCPIF,JCCPC,JCCPN
- +, NCCPP,NCCPD,NCCPZ,NCCPT,NCCPIF,NCCPC,NCCPN
- +, JCCEND, NCHCCC,IXCCC, CCKORG, CCKARD, CCCOMF
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
-C-------------- End CDE --------------------------------
- PARAMETER (NOFFLI=2, NOFFDA=4)
- PARAMETER (MAXLEV=36)
- DIMENSION MSAVE(8,MAXLEV)
-
- IAND (IZV,IZW) = AND (IZV, IZW)
- IOR (IZV,IZW) = OR (IZV, IZW)
-
-
- LDO = LXX
- KP = LEXP - 3
- KD = 0
- IF (LEXD.NE.0) KD= LEXD - 3
-
- MEXL = 0
- MEXG = 0
- IFL6 = 0
- LKEEP = 0
- LEVK = 0
- IF (LDO.NE.0) GO TO 31
- LKEEP = LYY
-
-C- MEXi are the cumulated EXE bits of:
-C- MEXL just all patch/deck directed sequences called
-C- MEXG all global seq called from the current KEEP
-C- MEXH all global seq called from the current call bank
-
-C----- Start new KEEP bank, is it ready for use?
-
- 21 IF (IAND(IQ(LKEEP),KM5).EQ.0) CALL LINKSU (LKEEP)
- IF (IAND(IQ(LKEEP),KM6).NE.0) GO TO 72
-
-C---- the KEEP bank is not ready, scan its associated
-C-- structure for unsatisfied sequence call banks
-
- MEXG = IQ(LKEEP)
- IFL6 = KM6
- LDO = LKEEP - 1
- 23 LDO = LQ(LDO-1)
- IF (LDO.EQ.0) GO TO 71
- JCCTYP = JBYT (IQ(LDO),9,6)
- IF (JCCTYP.LT.MCCCDE) GO TO 23
- IF (JCCTYP.GT.MCCXSQ) GO TO 23
-
-C---- call bank reached, connect all sequences called
-
- 31 MEXH = IQ(LDO)
- IF (IAND(IQ(LDO),KM17).NE.0) GO TO 48
- NSEQ = IQ(LDO+NOFFDA)
- IFL17 = KM17
-C- bit 17 : all sequences are definitly connected
-
-C-- next call
-
- JSEQ = 1
- 34 LNEW = LQ(LDO-JSEQ-NOFFLI)
- IF (LNEW.GT.0) GO TO 47
-
-C-- locate the KEEP bank
-
- IXSEQ = IQ(LDO+NOFFDA+JSEQ)
- CALL LOCSEQ (LNEW, IXSEQ, KP,KD)
- MEXH = IOR (MEXH,IQUEST(3))
- MEXL = IOR (MEXL,IQUEST(4))
- IF (LNEW.EQ.0) GO TO 45
- IFLPDD = IQUEST(2)
-
- IF (JBYT(IQ(LNEW),5,2).NE.3) GO TO 61
-
-C-- store the adr of the KEEP bank into XSQ
-
- 41 IF (IFLPDD.EQ.0) GO TO 46
- LNEW = -LNEW
- 45 IFL17 = 0
- IFL6 = 0
- 46 LQ(LDO-JSEQ-NOFFLI) = LNEW
- 47 JSEQ = JSEQ + 1
- IF (JSEQ.LE.NSEQ) GO TO 34
-
- IQ(LDO) = IOR (IQ(LDO), IAND(MEXH,15))
- IQ(LDO) = IOR (IQ(LDO), IFL17)
- 48 MEXG = IOR (MEXG,MEXH)
- IF (LEVK.NE.0) GO TO 23
- 49 LINKSQ = IAND (IOR(MEXL,MEXG), 15)
- RETURN
-
-C------ new unready KEEP, go down one level
-
- 61 IF (IAND(IQ(LNEW),KM7).EQ.0) GO TO 67
- LEVK = LEVK + 1
- IF (LEVK.GT.MAXLEV) GO TO 91
- MSAVE (1,LEVK) = LKEEP
- MSAVE (2,LEVK) = MEXG
- MSAVE (3,LEVK) = LDO
- MSAVE (4,LEVK) = MEXH
- MSAVE (5,LEVK) = IFL17
- MSAVE (6,LEVK) = JSEQ
- MSAVE (7,LEVK) = IFLPDD
- MSAVE (8,LEVK) = IFL6
- LKEEP = LNEW
- GO TO 21
-
-C-- sequence definition not yet filled in
-
- 67 IFL17 = 0
- IFL6 = 0
- GO TO 41
-
-C------ end of processing this KEEP, come back up one level
-
- 71 IQ(LKEEP) = IOR (IQ(LKEEP),IAND(MEXG,15))
- IQ(LKEEP) = IOR (IQ(LKEEP),IFL6)
- 72 IF (LEVK.EQ.0) GO TO 49
- LNEW = LKEEP
- LKEEP = MSAVE (1,LEVK)
- MEXG = MSAVE (2,LEVK)
- LDO = MSAVE (3,LEVK)
- MEXH = MSAVE (4,LEVK)
- IFL17 = MSAVE (5,LEVK)
- JSEQ = MSAVE (6,LEVK)
- IFLPDD = MSAVE (7,LEVK)
- IFL6 = MSAVE (8,LEVK)
- LEVK = LEVK -1
-
- NSEQ = LQ(LDO+NOFFDA)
- IF (IAND(IQ(LNEW),KM6).EQ.0) IFLPDD= -1
-
- IF (IFLPDD.EQ.0) THEN
- MEXH = IOR (MEXH,IQ(LNEW))
- ELSE
- MEXL = IOR (MEXL,IQ(LNEW))
- ENDIF
- GO TO 41
-
-C----- Sequence call loop
-
- 91 CONTINUE
- CALL P_FATAL ('sequence call loop')
- LINKSQ = 0
- END
diff --git a/src/p5boot/p5lib/linksu.f b/src/p5boot/p5lib/linksu.f
deleted file mode 100644
index d08831b..0000000
--- a/src/p5boot/p5lib/linksu.f
+++ /dev/null
@@ -1,139 +0,0 @@
-CDECK ID>, LINKSU.
- SUBROUTINE LINKSU (LKEEPX)
-
-C- Initial processing of the sequence kept at LKEEP:
-C- evaluate all IF conditions, delink all deselected material
-C. started 14-july-93
-
- PARAMETER (KM1=1,KM2=2,KM3=4,KM4=8,KM5=16,KM6=32,KM7=64,KM8=128,
- + KM9=256, KM10=512, KM11=1024, KM12=2048, KM13=4096, KM14=8192,
- + KM15=16384, KM16=32768, KM17=65536, KM18=131072, KM19=262144)
- PARAMETER (MCCNIL=1, MCCKIL=2, MCCINC=3, MCCCDE=4, MCCSEQ=5,
- + MCCXSQ=6, MCCTRU=7, MCCFAL=8, MCCELS=9, MCCEND=10,
- + MCCSEL=11, MCCSES=12, MCCFAU=13, MCCSKI=14,
- + MCCKEE=15, MCCDEL=16, MCCREP=17, MCCADB=18, MCCADD=19,
- + MCCUSE=20, MCCXDI=21, MCCDIV=22, MCCLIS=23, MCCEXE=24, MCCIMI=25,
- + MCCASM=26, MCCUPD=27, MCCNAM=28, MCCGAP=29, MCCMOR=30, MCCONL=31,
- + MCCFOR=32, MCCSUS=33, MCCOPT=34, MCCOP2=35, MCCSHO=36, MCCPAM=37,
- + MCCQUI=38, MCCEOD=39, MCCDEC=40, MCCPAT=41, MCCTIT=42)
- CHARACTER CCKORG*256, CCKARD*256, CCCOMF*256
- COMMON /CCPARA/NCHCCD,NCHCCT, JCCTYP,JCCLEV,JCCSL,MCCPAR(240)
- +, NCCPAR,MXCCIF,JCCIFV,JCCBAD,JCCWAR,ICCSUB,JCCWK(4)
- +, JCCPP,JCCPD,JCCPZ,JCCPT,JCCPIF,JCCPC,JCCPN
- +, NCCPP,NCCPD,NCCPZ,NCCPT,NCCPIF,NCCPC,NCCPN
- +, JCCEND, NCHCCC,IXCCC, CCKORG, CCKARD, CCCOMF
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
-C-------------- End CDE --------------------------------
-
- IAND (IZV,IZW) = AND (IZV, IZW)
- IOR (IZV,IZW) = OR (IZV, IZW)
-
-
- LKEEP = LKEEPX
- LEVIF = 0
- MEXCUM = 0
- IFLKM6 = KM6
- KDO = LKEEP - 2
- GO TO 23
-
-C------ accepted material
-
- 21 IFLKM6 = 0
- 22 KDO = LDO - 1
- 23 LDO = LQ(KDO)
- IF (LDO.EQ.0) GO TO 71
- MEXCUM = IOR (MEXCUM,IQ(LDO))
- JCCTYP = JBYT (IQ(LDO),9,6)
- IF (JCCTYP.LE.MCCNIL) GO TO 22
- IF (JCCTYP.GE.MCCTRU) GO TO 25
-
-C-- +CDE +SEQ: check IF condition is true
-
- IF (JCCTYP.EQ.MCCXSQ) GO TO 21
- CALL CCKRAK (IQ(LDO+1))
- CALL CCPROC
- MEXCUM = IOR (MEXCUM,MXCCIF)
- IF (JCCIFV.EQ.0) GO TO 21
- 24 CALL TOGARB (KDO,0)
- GO TO 23
-
-C-- new control
-
- 25 IF (JCCTYP.EQ.MCCELS) GO TO 26
- IF (JCCTYP.EQ.MCCEND) GO TO 28
-
-C-- handle +__IF
-
- CALL CCKRAK (IQ(LDO+1))
- CALL CCPROC
- MEXCUM = IOR (MEXCUM,MXCCIF)
- LEVIF = LEVIF + 1
- IF (JCCTYP.EQ.MCCFAL) JCCIFV= MAX(0, 1-JCCIFV)
- IF (JCCIFV.EQ.0) GO TO 29
- LVREND = LEVIF
- LVRELS = LEVIF + 1
- GO TO 41
-
-C-- handle +_ELSE, IF=xxx
-
- 26 LVREND = LEVIF
- LVRELS = LEVIF
- GO TO 41
-
-C-- handle +_ENDIF
-
- 28 LEVIF = LEVIF - 1
- 29 IF (IQ(LDO+2).LT.2) GO TO 24
- IQ(LDO+1) = IQ(LDO+1) + 1
- IQ(LDO+2) = IQ(LDO+2) - 1
- IQ(LDO+3) = IQ(LDO+3) + 1
- CALL SBYT (0, IQ(LDO),9,6)
- GO TO 22
-
-C------ rejected material
-
- 41 CALL TOGARB (KDO,0)
- LDO = LQ(KDO)
- IF (LDO.EQ.0) GO TO 71
- JCCTYP = JBYT (IQ(LDO),9,6)
- IF (JCCTYP.LT.MCCTRU) GO TO 41
-
-C-- new control
-
- IF (JCCTYP.EQ.MCCELS) GO TO 46
- IF (JCCTYP.EQ.MCCEND) GO TO 48
-
-C-- handle +__IF
-
- LEVIF = LEVIF + 1
- GO TO 41
-
-C-- handle +_ELSE, IF=xxx
-
- 46 IF (LEVIF.GE.LVRELS) GO TO 41
- CALL CCKRAK (IQ(LDO+1))
- CALL CCPROC
- MEXCUM = IOR (MEXCUM,MXCCIF)
- IF (JCCIFV.NE.0) GO TO 41
- GO TO 29
-
-C-- handle +_ENDIF
-
- 48 LEVIF = LEVIF - 1
- IF (LEVIF.GE.LVREND) GO TO 41
- GO TO 29
-
-C------ done
-
- 71 MEXCUM = IAND (MEXCUM,15)
- MEXCUM = MEXCUM + KM5 + IFLKM6
- IQ(LKEEP) = IOR (IQ(LKEEP),MEXCUM)
- RETURN
- END
diff --git a/src/p5boot/p5lib/lixqt.f b/src/p5boot/p5lib/lixqt.f
deleted file mode 100644
index 5a96fe8..0000000
--- a/src/p5boot/p5lib/lixqt.f
+++ /dev/null
@@ -1,162 +0,0 @@
-CDECK ID>, LIXQT.
- SUBROUTINE LIXQT
-
-C- List the material according to the map
-C. started 12-jan-94
-
- PARAMETER (KM1=1,KM2=2,KM3=4,KM4=8,KM5=16,KM6=32,KM7=64,KM8=128,
- + KM9=256, KM10=512, KM11=1024, KM12=2048, KM13=4096, KM14=8192,
- + KM15=16384, KM16=32768, KM17=65536, KM18=131072, KM19=262144,
- + KM20=524288, KM21=1048576, KM22=2097152, KM23=4194304,
- + KM24=8388608, KM25=16777216, KM26=33554432, KM27=67108864,
- + KM28=134217728, KM29=268435456, KM30=536870912, KM31=1073741824)
- COMMON /QUNIT/ IQREAD,IQPRNT, IQTTIN,IQTYPE, IQOFFL,IQRTTY,IQRSAV
- +, IQRFD,IQRRD,IQRSIZ, NQLPAT,NQUSED,NQLLBL, NQINIT
- PARAMETER (MCCNIL=1, MCCKIL=2, MCCINC=3, MCCCDE=4, MCCSEQ=5,
- + MCCXSQ=6, MCCTRU=7, MCCFAL=8, MCCELS=9, MCCEND=10,
- + MCCSEL=11, MCCSES=12, MCCFAU=13, MCCSKI=14,
- + MCCKEE=15, MCCDEL=16, MCCREP=17, MCCADB=18, MCCADD=19,
- + MCCUSE=20, MCCXDI=21, MCCDIV=22, MCCLIS=23, MCCEXE=24, MCCIMI=25,
- + MCCASM=26, MCCUPD=27, MCCNAM=28, MCCGAP=29, MCCMOR=30, MCCONL=31,
- + MCCFOR=32, MCCSUS=33, MCCOPT=34, MCCOP2=35, MCCSHO=36, MCCPAM=37,
- + MCCQUI=38, MCCEOD=39, MCCDEC=40, MCCPAT=41, MCCTIT=42)
- CHARACTER CCKORG*256, CCKARD*256, CCCOMF*256
- COMMON /CCPARA/NCHCCD,NCHCCT, JCCTYP,JCCLEV,JCCSL,MCCPAR(240)
- +, NCCPAR,MXCCIF,JCCIFV,JCCBAD,JCCWAR,ICCSUB,JCCWK(4)
- +, JCCPP,JCCPD,JCCPZ,JCCPT,JCCPIF,JCCPC,JCCPN
- +, NCCPP,NCCPD,NCCPZ,NCCPT,NCCPIF,NCCPC,NCCPN
- +, JCCEND, NCHCCC,IXCCC, CCKORG, CCKARD, CCCOMF
- PARAMETER (KQGARB=1,KQARRV=3,KQKEEP=4,KQPREP=5,KQMAIN=6,KQPAST=8)
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
- COMMON /M_ANAC/LOWAN,KDOAN,LDOAN,LUPAN,MODEAN,MEXAN,LEVAN,KKM5AN
- +, NEWDEC,NEWCTL,NEWFOR,NEWNIL,NEWINC
-C-------------- End CDE --------------------------------
-
- IOR (IZV,IZW) = OR (IZV, IZW)
-
-
- IXPL = -7
- LEVIF = 0
- LUPAN = 0
- LDOAN = KQPREP + 1
-
-C---- Next bank
-
- 20 MODEAN = 0
- LDOAN = LQ(LDOAN-1)
- 22 IF (LDOAN.EQ.0) GO TO 87
-
-C-- MODEAN = 0 self material
-C- 1 CDE expansion
-C- 2 comment line
-C- 3 +SELF header line
-C- 4 +CDE call line
-C- 5 foreign material
-C- 6 control line
-
- JCCTYP = JBYT (IQ(LDOAN),9,6)
- IF (JCCTYP.GE.MCCDEL) GO TO 51
-
-C---------- Self material ----------------
-
- IF (JCCTYP.EQ.0) GO TO 39
- IF (JCCTYP.EQ.MCCNIL) GO TO 38
- IF (JCCTYP.LE.MCCINC) GO TO 71
- IF (JCCTYP.LE.MCCXSQ) GO TO 36
- IF (JCCTYP.LT.MCCSEL) GO TO 32
- IXPL = -7
- IF (JCCTYP.EQ.MCCKEE) GO TO 57
-
-C-- to here +SELF, +SKIP and fault
-
- MODEAN = 3
- GO TO 39
-
-C-- to here +_IF etc
-
- 32 IF (JCCTYP.GE.MCCELS) GO TO 34
- IF (LEVIF.EQ.0) IQ(LDOAN)= IOR (IQ(LDOAN), KM17)
- LEVIF = LEVIF + 1
- GO TO 39
-
- 34 IF (JCCTYP.EQ.MCCELS) GO TO 39
- LEVIF = MAX (LEVIF-1, 0)
- IF (LEVIF.EQ.0) IQ(LDOAN)= IOR (IQ(LDOAN), KM17)
- GO TO 39
-
-C-- sequence call
-
- 36 MODEAN = 4
- CALL DPLIST (MODEAN,LDOAN,LUPAN,0)
-
- IF (MOPTIO(5).NE.0) CALL XEJECT
- GO TO 20
-
-C-- comment line
-
- 38 MODEAN = 2
- 39 CALL DPLIST (MODEAN,LDOAN,LUPAN,1)
- GO TO 20
-
-C---------- Foreign material --------------
-
- 51 IF (JCCTYP.GE.MCCUSE) GO TO 71
- CALL CCKRAK (IQ(LDOAN+1))
- IXP = MCCPAR(JCCPP+1)
- IXD = MCCPAR(JCCPD+1)
- IF (IXP.EQ.0) GO TO 52
- IF (IXP.EQ.IXPL .AND. IXD.EQ.IXDL) GO TO 56
- IXPL = IXP
- IXDL = IXD
- GO TO 57
-
-C-- implied target
-
- 52 IF (IXPL.LT.0) GO TO 57
- IF (MCCPAR(JCCPD+2).LT.0) GO TO 56
- IF (IXD.EQ.IXDL) GO TO 56
- IXDL = IXD
- GO TO 57
-
-C-- same action target as previous
-
- 56 IQ(LDOAN) = IOR (IQ(LDOAN), KM18)
-
- 57 MODEAN = 5
- CALL DPLIST (MODEAN,LDOAN,LUPAN,1)
-
- 58 LDOAN = LQ(LDOAN-1)
- IF (LDOAN.EQ.0) GO TO 87
- JCCTYP = JBYT (IQ(LDOAN),9,6)
- IF (JCCTYP.GE.MCCSEL) GO TO 59
- CALL DPLIST (MODEAN,LDOAN,LUPAN,0)
- GO TO 58
-
- 59 MODEAN = 0
- GO TO 22
-
-C---------- Control line ---------------
-
- 71 MODEAN = 6
- CALL DPLIST (MODEAN,LDOAN,LUPAN,1)
- IF (JCCTYP.GE.MCCPAT) NQLPAT = NQUSED
- GO TO 20
-
-C---- Done
-
- 87 CONTINUE
- RETURN
- END
diff --git a/src/p5boot/p5lib/ln_cop2.f b/src/p5boot/p5lib/ln_cop2.f
deleted file mode 100644
index acc723a..0000000
--- a/src/p5boot/p5lib/ln_cop2.f
+++ /dev/null
@@ -1,46 +0,0 @@
-CDECK ID>, LN_COP2.
- FUNCTION LN_COP2 (JSL,NLI)
-
-C- Transfer: Copy NLI lines starting at slot JSL to division 2
-C. started 27-feb-92
-
- COMMON /MQCM/ NQSYSS,NQLINK, LQCSTA(3),LQCEND(3), NQMAX
- +, LQLSTA(5),LQLEND(5), LQADR,LQADR0,NQOFFS
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
-C-------------- End CDE --------------------------------
-
-
- JSLFR = JSL
- NSL = NLI
- JTXFR = MLIAD(JSLFR)
- NTX = MLIAD(JSLFR+NSL) - JTXFR
-
- JSLTO = LQLEND(2)
- JTXTO = MLIAD(JSLTO)
- NTXRE = JTXTO - JTXFR
-
- JSLLIM = LQLSTA(4)
- JTXLIM = MLIAD(JSLLIM)
- IF (JSLTO+NSL+4 .GE.JSLLIM)
- + CALL NOSPACE ('no line slots left in text division 2')
- IF (JTXTO+NTX+8 .GE.JTXLIM)
- + CALL NOSPACE ('no text store left in text division 2')
-
- DO 44 J=1,NSL
- 44 MLIAD(JSLTO+J) = MLIAD(JSLFR+J) + NTXRE
-
- CALL CCOPYL (TEXT(JTXFR),TEXT(JTXTO),NTX)
-
- LQLEND(2) = JSLTO + NSL
- LQLSTA(3) = LQLEND(2)
- LQLEND(3) = LQLSTA(3)
- LN_COP2 = JSLTO
- RETURN
- END
diff --git a/src/p5boot/p5lib/ln_cop3.f b/src/p5boot/p5lib/ln_cop3.f
deleted file mode 100644
index cca2587..0000000
--- a/src/p5boot/p5lib/ln_cop3.f
+++ /dev/null
@@ -1,47 +0,0 @@
-CDECK ID>, LN_COP3.
- FUNCTION LN_COP3 (JSL,NLI)
-
-C- Transfer: Copy NLI lines starting at slot JSL into division 3
-C. started 22-jun-93
-
- COMMON /MQCM/ NQSYSS,NQLINK, LQCSTA(3),LQCEND(3), NQMAX
- +, LQLSTA(5),LQLEND(5), LQADR,LQADR0,NQOFFS
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
-C-------------- End CDE --------------------------------
-
- IF (LQLSTA(3).NE.LQLEND(2)) THEN
- CALL P_CRASH ('LN_COP3: LQLSTA(3) not = LQLEND(2)')
- ENDIF
-
- JSLFR = JSL
- NSL = NLI
- JTXFR = MLIAD(JSLFR)
- NTX = MLIAD(JSLFR+NSL) - JTXFR
-
- JSLTO = LQLEND(3)
- JTXTO = MLIAD(JSLTO)
- NTXRE = JTXTO - JTXFR
-
- JSLLIM = LQLSTA(4)
- JTXLIM = MLIAD(JSLLIM)
- IF (JSLTO+NSL+4 .GE.JSLLIM)
- + CALL NOSPACE ('no line slots left in text division 3')
- IF (JTXTO+NTX+8 .GE.JTXLIM)
- + CALL NOSPACE ('no text store left in text division 3')
-
- DO 44 J=1,NSL
- 44 MLIAD(JSLTO+J) = MLIAD(JSLFR+J) + NTXRE
-
- CALL CCOPYL (TEXT(JTXFR),TEXT(JTXTO),NTX)
-
- LQLEND(3) = JSLTO + NSL
- LN_COP3 = JSLTO
- RETURN
- END
diff --git a/src/p5boot/p5lib/ln_cop4.f b/src/p5boot/p5lib/ln_cop4.f
deleted file mode 100644
index 281fde9..0000000
--- a/src/p5boot/p5lib/ln_cop4.f
+++ /dev/null
@@ -1,45 +0,0 @@
-CDECK ID>, LN_COP4.
- FUNCTION LN_COP4 (JSL,NLI)
-
-C- Transfer: Copy NLI lines starting at slot JSL into division 4
-C. started 19-dec-91
-
- COMMON /MQCM/ NQSYSS,NQLINK, LQCSTA(3),LQCEND(3), NQMAX
- +, LQLSTA(5),LQLEND(5), LQADR,LQADR0,NQOFFS
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
-C-------------- End CDE --------------------------------
-
-
- JSLFR = JSL
- NSL = NLI
- JTXFR = MLIAD(JSLFR)
- NTX = MLIAD(JSLFR+NSL) - JTXFR
-
- JSLTO = LQLSTA(4)
- JTXTO = MLIAD(JSLTO) - NTX
- JSLTO = JSLTO - NSL
- NTXRE = JTXTO - JTXFR
-
- JSLLIM = LQLEND(3)
- JTXLIM = MLIAD(JSLLIM)
- IF (JSLTO.LE.JSLLIM+4)
- + CALL NOSPACE ('no line slots left in text division 4')
- IF (JTXTO.LE.JTXLIM+8)
- + CALL NOSPACE ('no text store left in text division 4')
-
- DO 44 J=0,NSL-1
- 44 MLIAD(JSLTO+J) = MLIAD(JSLFR+J) + NTXRE
-
- CALL CCOPYL (TEXT(JTXFR),TEXT(JTXTO),NTX)
-
- LQLSTA(4) = JSLTO
- LN_COP4 = JSLTO
- RETURN
- END
diff --git a/src/p5boot/p5lib/ln_env3.f b/src/p5boot/p5lib/ln_env3.f
deleted file mode 100644
index 0e60d42..0000000
--- a/src/p5boot/p5lib/ln_env3.f
+++ /dev/null
@@ -1,68 +0,0 @@
-CDECK ID>, LN_ENV3.
- FUNCTION LN_ENV3 (JSL)
-
-C- Copy the line at slot JSL to the end of division 3 with
-C- substitution of environment variables
-C. started 22-dec-93
-
- COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT,NUSLAT(2),DUMMY(34)
- COMMON /MQCM/ NQSYSS,NQLINK, LQCSTA(3),LQCEND(3), NQMAX
- +, LQLSTA(5),LQLEND(5), LQADR,LQADR0,NQOFFS
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
-C-------------- End CDE --------------------------------
-
- IF (LQLSTA(3).NE.LQLEND(2)) THEN
- CALL P_CRASH ('LN_ENV3: LQLSTA(3) not = LQLEND(2)')
- ENDIF
-
- JSLFR = JSL
- JTXFR = MLIAD(JSLFR)
- NTXFR = MLIAD(JSLFR+1) - JTXFR - NCHNEWL
-
- JSLTO = LQLEND(3)
- JTXTO = MLIAD(JSLTO)
-
- JSLLIM = LQLSTA(4)
- JTXLIM = MLIAD(JSLLIM)
- NSLAV = JSLLIM - JSLTO - 2
- NTXAV = JTXLIM - JTXTO - 400
-
- IF (NSLAV.LT.2)
- + CALL NOSPACE ('no text store left in text division 3')
- IF (NTXAV.LT.NTXFR)
- + CALL NOSPACE ('no text store left in text division 3')
-
- CALL CENVIR (TEXT(JTXFR),NTXFR, TEXT(JTXTO),1,NTXAV,0)
-
- IF (NFSLAT.GE.4)
- + CALL NOSPACE ('no text store left in text division 3')
- IF (NFSLAT.GE.2) GO TO 91
- IF (NGSLAT.EQ.0) GO TO 41
- JTXE = JTXTO + NDSLAT
- TEXT(JTXE) = CHAR(NEWLN)
- JTXE = JTXE + 1
- MLIAD(JSLTO+1) = JTXE
-
- LQLEND(3) = JSLTO + 1
- LN_ENV3 = JSLTO
- NGSLAT = 1
- RETURN
-
-C-- no substitution, return NGSLAT = 0
-
- 41 NDSLAT = NTXFR
- LN_ENV3 = JSLFR
- RETURN
-
-C-- syntax problems
-
- 91 LN_ENV3 = -1
- RETURN
- END
diff --git a/src/p5boot/p5lib/ln_equ.f b/src/p5boot/p5lib/ln_equ.f
deleted file mode 100644
index 2da6f3f..0000000
--- a/src/p5boot/p5lib/ln_equ.f
+++ /dev/null
@@ -1,12 +0,0 @@
-CDECK ID>, LN_EQU.
- LOGICAL FUNCTION LN_EQU (LINEA,LINEB,NCH)
-
-C- Compare LINEA(1:NCH) with LINEB(1:NCH),
-C- return true if LINEA = LINEB
-
- CHARACTER*512 LINEA, LINEB
-
-
- LN_EQU = LINEA(1:NCH) .EQ. LINEB(1:NCH)
- RETURN
- END
diff --git a/src/p5boot/p5lib/ln_get.f b/src/p5boot/p5lib/ln_get.f
deleted file mode 100644
index 71c5c61..0000000
--- a/src/p5boot/p5lib/ln_get.f
+++ /dev/null
@@ -1,30 +0,0 @@
-CDECK ID>, LN_GET.
- SUBROUTINE LN_GET (JSL,LINE,NCH)
-
-C- Transfer the line at JSL from the store to local,
-C- NCH characters maximum,
-C- return NDSLAT # of chars. transferred,
-C- NESLAT # of chars. in store
-
- COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT,NUSLAT(2),DUMMY(34)
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB
-C-------------- End CDE --------------------------------
- CHARACTER*512 LINE
-
- JTX = MLIAD(JSL)
- NTX = MLIAD(JSL+1) - JTX - NCHNEWL
- NESLAT = NTX
-
- NTX = MIN (NCH,NTX)
- NDSLAT = NTX
-
- CALL CCOPYL (TEXT(JTX),LINE,NTX)
- RETURN
- END
diff --git a/src/p5boot/p5lib/ln_mov2.f b/src/p5boot/p5lib/ln_mov2.f
deleted file mode 100644
index dd8bede..0000000
--- a/src/p5boot/p5lib/ln_mov2.f
+++ /dev/null
@@ -1,48 +0,0 @@
-CDECK ID>, LN_MOV2.
- FUNCTION LN_MOV2 (JSL,NLI)
-
-C- Transfer: Move NLI lines at slot JSL from division 1 to division 2
-C. started 27-feb-92
-
- COMMON /MQCM/ NQSYSS,NQLINK, LQCSTA(3),LQCEND(3), NQMAX
- +, LQLSTA(5),LQLEND(5), LQADR,LQADR0,NQOFFS
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
-C-------------- End CDE --------------------------------
-
-
- JSLFR = JSL
- NSL = NLI
- JTXFR = MLIAD(JSLFR)
- NTX = MLIAD(JSLFR+NSL) - JTXFR
-
- JSLTO = LQLEND(2)
- JTXTO = MLIAD(JSLTO)
- NTXRE = JTXTO - JTXFR
-
- JSLLIM = LQLSTA(4)
- JTXLIM = MLIAD(JSLLIM)
- IF (JSLTO+NSL+4 .GE.JSLLIM)
- + CALL NOSPACE ('no line slots left in text division 2')
- IF (JTXTO+NTX+8 .GE.JTXLIM)
- + CALL NOSPACE ('no text store left in text division 2')
-
- DO 44 J=1,NSL
- 44 MLIAD(JSLTO+J) = MLIAD(JSLFR+J) + NTXRE
-
- CALL CCOPYL (TEXT(JTXFR),TEXT(JTXTO),NTX)
-
- IF (JSLFR.LT.LQLEND(1)) CALL TOGATX (JSLFR,NSL)
-
- LQLEND(2) = JSLTO + NSL
- LQLSTA(3) = LQLEND(2)
- LQLEND(3) = LQLSTA(3)
- LN_MOV2 = JSLTO
- RETURN
- END
diff --git a/src/p5boot/p5lib/ln_put.f b/src/p5boot/p5lib/ln_put.f
deleted file mode 100644
index 8840aa6..0000000
--- a/src/p5boot/p5lib/ln_put.f
+++ /dev/null
@@ -1,24 +0,0 @@
-CDECK ID>, LN_PUT.
- SUBROUTINE LN_PUT (LINE,NCH,JSL)
-
-C- Transfer a line from local to the store at slot JSL
-
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB
-C-------------- End CDE --------------------------------
- CHARACTER*512 LINE
-
- JTX = MLIAD(JSL)
- IF (NCH.GT.0) CALL CCOPYL (LINE,TEXT(JTX),NCH)
- JTX = JTX + NCH
- TEXT(JTX) = CHAR (NEWLN)
- JTX = JTX + 1
- MLIAD(JSL+1) = JTX
- RETURN
- END
diff --git a/src/p5boot/p5lib/ln_putr.f b/src/p5boot/p5lib/ln_putr.f
deleted file mode 100644
index 15b010a..0000000
--- a/src/p5boot/p5lib/ln_putr.f
+++ /dev/null
@@ -1,25 +0,0 @@
-CDECK ID>, LN_PUTR.
- SUBROUTINE LN_PUTR (LINE,NCH,JSL)
-
-C- Transfer a line from local to the store,
-C- reverse at slot JSL-1
-
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB
-C-------------- End CDE --------------------------------
- CHARACTER*512 LINE
-
- JTX = MLIAD(JSL) - NCH - NCHNEWL
- MLIAD(JSL-1) = JTX
-
- IF (NCH.GT.0) CALL CCOPYL (LINE,TEXT(JTX),NCH)
- JTX = JTX + NCH
- TEXT(JTX) = CHAR (NEWLN)
- RETURN
- END
diff --git a/src/p5boot/p5lib/ln_to3.f b/src/p5boot/p5lib/ln_to3.f
deleted file mode 100644
index dfe41bf..0000000
--- a/src/p5boot/p5lib/ln_to3.f
+++ /dev/null
@@ -1,43 +0,0 @@
-CDECK ID>, LN_TO3.
- FUNCTION LN_TO3 (LINE)
-
-C- Transfer: Set a line from local to division 3
-C. started 22-jun-93
-
- COMMON /MQCM/ NQSYSS,NQLINK, LQCSTA(3),LQCEND(3), NQMAX
- +, LQLSTA(5),LQLEND(5), LQADR,LQADR0,NQOFFS
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
-C-------------- End CDE --------------------------------
- CHARACTER LINE*(*)
-
- IF (LQLSTA(3).NE.LQLEND(2)) THEN
- CALL P_CRASH ('LN_TO3: LQLSTA(3) not = LQLEND(2)')
- ENDIF
-
- NCH = LNBLNK (LINE)
- JSLTO = LQLEND(3)
- JTXTO = MLIAD(JSLTO)
- JTXE = JTXTO + NCH
-
- JSLLIM = LQLSTA(4)
- JTXLIM = MLIAD(JSLLIM)
- IF (JSLTO+4 .GE.JSLLIM)
- + CALL NOSPACE ('no line slots left in text division 3')
- IF (JTXE+8 .GE.JTXLIM)
- + CALL NOSPACE ('no text store left in text division 3')
-
- IF (NCH.GT.0) CALL CCOPYL (LINE,TEXT(JTXTO),NCH)
- TEXT(JTXE) = CHAR (NEWLN)
- JTXE = JTXE + 1
- MLIAD(JSLTO+1) = JTXE
- LQLEND(3) = JSLTO + 1
- LN_TO3 = JSLTO
- RETURN
- END
diff --git a/src/p5boot/p5lib/ln_to4.f b/src/p5boot/p5lib/ln_to4.f
deleted file mode 100644
index 0d97703..0000000
--- a/src/p5boot/p5lib/ln_to4.f
+++ /dev/null
@@ -1,39 +0,0 @@
-CDECK ID>, LN_TO4.
- FUNCTION LN_TO4 (LINE,NCH)
-
-C- Transfer: Set a line from local to the start of division 4
-C. started 27-feb-92
-
- COMMON /MQCM/ NQSYSS,NQLINK, LQCSTA(3),LQCEND(3), NQMAX
- +, LQLSTA(5),LQLEND(5), LQADR,LQADR0,NQOFFS
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
-C-------------- End CDE --------------------------------
- CHARACTER*512 LINE
-
- NTX = NCH + NCHNEWL
- JSLTO = LQLSTA(4)
- JTXTO = MLIAD(JSLTO) - NTX
- JSLTO = JSLTO - 1
-
- JSLLIM = LQLEND(3)
- JTXLIM = MLIAD(JSLLIM)
- IF (JSLTO.LE.JSLLIM+4)
- + CALL NOSPACE ('no line slots left in text division 4')
- IF (JTXTO.LE.JTXLIM+8)
- + CALL NOSPACE ('no text store left in text division 4')
-
- IF (NCH.GT.0) CALL CCOPYL (LINE,TEXT(JTXTO),NCH)
- JTXE = JTXTO + NTX
- TEXT(JTXE-1) = CHAR (NEWLN)
- MLIAD(JSLTO) = JTXTO
- LQLSTA(4) = JSLTO
- LN_TO4 = JSLTO
- RETURN
- END
diff --git a/src/p5boot/p5lib/lockeep.f b/src/p5boot/p5lib/lockeep.f
deleted file mode 100644
index 4c62edf..0000000
--- a/src/p5boot/p5lib/lockeep.f
+++ /dev/null
@@ -1,63 +0,0 @@
-CDECK ID>, LOCKEEP.
- SUBROUTINE LOCKEEP (LSEQ)
-
-C- Find the KEEP bank for the sequence decribed by
-C- the current +KEEP control line;
-C- create target PAT/DECK banks if local sequence.
-
-C- return LSEQ L-adr of the sequence found, or LSEQ=0
-C- IQUEST(1) K-adr of the seq found, if found
-C- else: K-adr for attachment at end
-C- IQUEST(2) zero: sequence is global
-C- -ve: sequence is local
-C- IQUEST(3) EXE bits of global sequence
-C- IQUEST(4) EXE bits of sequence
-C- IQUEST(11) adr of P/D to which the sequence would have
-C- to be attached, if local and not existing
-C- (to have access to the EXE bits)
-C. started 7-jan-92
-
- CHARACTER CCKORG*256, CCKARD*256, CCCOMF*256
- COMMON /CCPARA/NCHCCD,NCHCCT, JCCTYP,JCCLEV,JCCSL,MCCPAR(240)
- +, NCCPAR,MXCCIF,JCCIFV,JCCBAD,JCCWAR,ICCSUB,JCCWK(4)
- +, JCCPP,JCCPD,JCCPZ,JCCPT,JCCPIF,JCCPC,JCCPN
- +, NCCPP,NCCPD,NCCPZ,NCCPT,NCCPIF,NCCPC,NCCPN
- +, JCCEND, NCHCCC,IXCCC, CCKORG, CCKARD, CCCOMF
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
-C-------------- End CDE --------------------------------
-
-
- IXS = MCCPAR(JCCPZ+1)
- KP = 0
- KD = 0
- LPD = 0
- IF (NCCPP.EQ.0) GO TO 24
-
- IXP = MCCPAR(JCCPP+1)
- IXD = MCCPAR(JCCPD+2)
-
- CALL CREAPD (IXP, IXD, 0)
- KP = LCRP - 3
- LPD = LCRP
- IF (LCRD.NE.0) THEN
- KD = LCRD - 3
- LPD = LCRD
- ENDIF
-
- 24 CALL LOCSEQ (LSEQ, IXS,KP,KD)
- IQUEST(11) = LPD
- RETURN
- END
diff --git a/src/p5boot/p5lib/locpat.f b/src/p5boot/p5lib/locpat.f
deleted file mode 100644
index 5468055..0000000
--- a/src/p5boot/p5lib/locpat.f
+++ /dev/null
@@ -1,46 +0,0 @@
-CDECK ID>, LOCPAT.
- FUNCTION LOCPAT (IXPAT)
-
-C- Locate the PAT bank for patch IXPAT
-
-C- return the adr of the bank found as function value,
-C- or zero if not found
-
-C- if the bank has been found in the 'future' chain
-C- relink it to be just after LEXP
-
- PARAMETER (KQGARB=1,KQARRV=3,KQKEEP=4,KQPREP=5,KQMAIN=6,KQPAST=8)
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
-C-------------- End CDE --------------------------------
-
-
-C-- look in the 'future' chain
-
- LQ(LLPAST-1) = 0
- LF = KQFIND (IXPAT,2,KQMAIN,KP)
- IF (LF.NE.0) THEN
- IF (LF.EQ.LEXP) GO TO 27
- CALL QSHUNT (KP,LEXP-1)
- GO TO 27
- ENDIF
-
-C-- look in the 'past' chain
-
- LF = LQFIND (IXPAT,2,LQPAST)
-
- 27 LOCPAT = LF
- RETURN
- END
diff --git a/src/p5boot/p5lib/locseq.f b/src/p5boot/p5lib/locseq.f
deleted file mode 100644
index 4c22f6c..0000000
--- a/src/p5boot/p5lib/locseq.f
+++ /dev/null
@@ -1,67 +0,0 @@
-CDECK ID>, LOCSEQ.
- SUBROUTINE LOCSEQ (LSEQ, IXSEQ,KP,KD)
-
-C- Find KEEP bank for the sequence with the name index IXSEQ
-C- KP gives the patch-directed, KD the deck-directed sequences
-
-C- return LSEQ L-adr of the sequence found, or LSEQ=0
-C- IQUEST(1) K-adr of the seq found, if found
-C- else: K-adr for attachment at end
-C- IQUEST(2) zero: sequence is global
-C- -ve: sequence is local
-C- IQUEST(3) EXE bits of global sequence
-C- IQUEST(4) EXE bits of sequence
-
-C- if the sequence has been found as global, it is re-linked
-C- to the start of the global structure
-
- PARAMETER (KQGARB=1,KQARRV=3,KQKEEP=4,KQPREP=5,KQMAIN=6,KQPAST=8)
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
-C-------------- End CDE --------------------------------
- EQUIVALENCE (KSQLOC,IQUEST(1)), (L,IQUEST(12))
- DIMENSION IXSEQ(9)
-
-
- IQUEST(11) = IXSEQ(1)
- IQUEST(2) = 0
- IQUEST(3) = 0
- IQUEST(4) = 0
-
-C-- Global set
-
- CALL LOCSQ2 (KQKEEP)
- IQUEST(3) = IQUEST(4)
- IF (L.EQ.0) GO TO 21
- LQ(KSQLOC) = LQ(L-1)
- LQ(L-1) = LQKEEP
- LQKEEP = L
- KSQLOC = KQKEEP
- 19 LSEQ = L
- RETURN
-
-C-- Patch-directed set: if KP not zero
-
- 21 IF (KP.EQ.0) GO TO 19
- IQUEST(2) = -1
- CALL LOCSQ2 (KP)
- IF (L.NE.0) GO TO 19
-
-C-- Deck-directed set: if KD not zero
-
- IF (KD.EQ.0) GO TO 19
- CALL LOCSQ2 (KD)
- GO TO 19
- END
diff --git a/src/p5boot/p5lib/locsq2.f b/src/p5boot/p5lib/locsq2.f
deleted file mode 100644
index 9f28c20..0000000
--- a/src/p5boot/p5lib/locsq2.f
+++ /dev/null
@@ -1,51 +0,0 @@
-CDECK ID>, LOCSQ2.
- SUBROUTINE LOCSQ2 (KPAR)
-
-C- Slave to LOCSEQ, search one particular linear structure
-C- Input: KPAR search the linear structure attached at LQ(KPAR)
-C- IQUEST(11) name index of sequence to be found
-C- Output: IQUEST(1) K-adr of sequence found, if found, or
-C- K-adr in last bank searched, if not found
-C- IQUEST(4) cummulated EXE bits
-C- IQUEST(12) L-adr of sequence found
-
- PARAMETER (KM1=1,KM2=2,KM3=4,KM4=8,KM5=16,KM6=32,KM7=64,KM8=128,
- + KM9=256, KM10=512, KM11=1024, KM12=2048, KM13=4096, KM14=8192,
- + KM15=16384, KM16=32768, KM17=65536, KM18=131072, KM19=262144)
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
-C-------------- End CDE --------------------------------
- EQUIVALENCE (KSQLOC,IQUEST(1)), (L,IQUEST(12))
-
- PARAMETER (LOCID=4)
-
- IAND (IZV,IZW) = AND (IZV, IZW)
- IOR (IZV,IZW) = OR (IZV, IZW)
-
-
- 21 KNIL = 0
- K = KPAR
- 22 L = KQFIND (IQUEST(11),LOCID,K,KSQLOC)
- IF (L.EQ.0) RETURN
- IF (KNIL.NE.0) GO TO 27
- IQUEST(4) = IOR (IQUEST(4),IQ(L))
- IF (IAND(IQ(L),KM12).EQ.0) RETURN
-
-C-- NIL-sequence found, find true sequence
-
- KNIL = KSQLOC
- K = L-1
- GO TO 22
-
-C-- Found sequence covered by NIL, transmit EXE bits and de-link
-
- 27 IQ(L) = IOR (IQ(L), IAND(IQUEST(4),15))
- CALL TOGARB (KNIL,0)
- GO TO 21
- END
diff --git a/src/p5boot/p5lib/lqfind.f b/src/p5boot/p5lib/lqfind.f
deleted file mode 100644
index 1721c20..0000000
--- a/src/p5boot/p5lib/lqfind.f
+++ /dev/null
@@ -1,24 +0,0 @@
-CDECK ID>, LQFIND.
- FUNCTION LQFIND (IT,JWORD,LGO)
-
-C- Find first bank containing IT in word JWORD
-C- in the linear structure supported by LGO;
-C- return its bank-adr as value, if not found: LQFIND=0
-
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ)
- EQUIVALENCE (LQ,IQ,LQGARB)
- COMMON // IQUEST(100),LQGARB
-C-------------- End CDE --------------------------------
-
-
- JW = JWORD
- L = LGO
- 24 IF (L.EQ.0) GO TO 29
- IF (IQ(L+JW).EQ.IT) GO TO 29
- L = LQ(L-1)
- GO TO 24
-
- 29 LQFIND = L
- RETURN
- END
diff --git a/src/p5boot/p5lib/lqstep.f b/src/p5boot/p5lib/lqstep.f
deleted file mode 100644
index a90e8d3..0000000
--- a/src/p5boot/p5lib/lqstep.f
+++ /dev/null
@@ -1,24 +0,0 @@
-CDECK ID>, LQSTEP.
- FUNCTION LQSTEP (LBK,NSTEP)
-
-C- Step LBK by NSTEP steps through the linear structure
-C. started 17-june-94
-
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ)
- EQUIVALENCE (LQ,IQ,LQGARB)
- COMMON // IQUEST(100),LQGARB
-C-------------- End CDE --------------------------------
-
-
- N = NSTEP
- L = LBK
- 24 IF (N.LE.0) GO TO 29
- N = N - 1
- IF (L.EQ.0) CALL P_KILL ('LQSTEP is in trouble')
- L = LQ(L-1)
- GO TO 24
-
- 29 LQSTEP = L
- RETURN
- END
diff --git a/src/p5boot/p5lib/m_a3ac.f b/src/p5boot/p5lib/m_a3ac.f
deleted file mode 100644
index e17e6c0..0000000
--- a/src/p5boot/p5lib/m_a3ac.f
+++ /dev/null
@@ -1,61 +0,0 @@
-CDECK ID>, M_A3AC.
- SUBROUTINE M_A3AC
-
-C- Content analysis stage 3:
-C- scan the material of the +REPL etc being defined
-C- return JCCBAD non-zero to signal c/line with syntax error at LDOAN
-C. started 8-dec-93
-
- PARAMETER (MCCNIL=1, MCCKIL=2, MCCINC=3, MCCCDE=4, MCCSEQ=5,
- + MCCXSQ=6, MCCTRU=7, MCCFAL=8, MCCELS=9, MCCEND=10,
- + MCCSEL=11, MCCSES=12, MCCFAU=13, MCCSKI=14,
- + MCCKEE=15, MCCDEL=16, MCCREP=17, MCCADB=18, MCCADD=19,
- + MCCUSE=20, MCCXDI=21, MCCDIV=22, MCCLIS=23, MCCEXE=24, MCCIMI=25,
- + MCCASM=26, MCCUPD=27, MCCNAM=28, MCCGAP=29, MCCMOR=30, MCCONL=31,
- + MCCFOR=32, MCCSUS=33, MCCOPT=34, MCCOP2=35, MCCSHO=36, MCCPAM=37,
- + MCCQUI=38, MCCEOD=39, MCCDEC=40, MCCPAT=41, MCCTIT=42)
- CHARACTER CCKORG*256, CCKARD*256, CCCOMF*256
- COMMON /CCPARA/NCHCCD,NCHCCT, JCCTYP,JCCLEV,JCCSL,MCCPAR(240)
- +, NCCPAR,MXCCIF,JCCIFV,JCCBAD,JCCWAR,ICCSUB,JCCWK(4)
- +, JCCPP,JCCPD,JCCPZ,JCCPT,JCCPIF,JCCPC,JCCPN
- +, NCCPP,NCCPD,NCCPZ,NCCPT,NCCPIF,NCCPC,NCCPN
- +, JCCEND, NCHCCC,IXCCC, CCKORG, CCKARD, CCCOMF
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- COMMON /M_ANAC/LOWAN,KDOAN,LDOAN,LUPAN,MODEAN,MEXAN,LEVAN,KKM5AN
- +, NEWDEC,NEWCTL,NEWFOR,NEWNIL,NEWINC
-C-------------- End CDE --------------------------------
-
-
- 22 CALL M_A3NX
- IF (LDOAN.EQ.0) RETURN
- IF (JCCTYP.GE.MCCSEL) RETURN
- IF (JCCTYP.LT.MCCKIL) GO TO 22
- IF (JCCTYP.EQ.MCCXSQ) GO TO 22
-
- CALL M_KRAK (0)
- IF (JCCBAD.NE.0) RETURN
- GO TO 22
-C!
-C!- check delayed control-cards for +REPL +ADB +ADD
-C!
-C! 78 JSLA = IQ(LDOAN+1)
-C! JSLE = JSLA + IQ(LDOAN+2)
-C! JSLG = JSLA
-C! 79 IF (JSLG.GE.JSLE) GO TO 77
-C! CALL NEXTCC ('-',JSLG,JSLE,JSLF,JCCTYP)
-C! IF (JCCTYP.EQ.0) GO TO 77
-C! JSLG = JSLF + 1
-C! IF (JCCTYP.EQ.MCCNIL) GO TO 79
-C! CALL CCKRAK (JSLF)
-C! IF (JCCBAD.EQ.0) GO TO 79
-C! IF (JSLF.NE.JSLA) LDOAN = M_SPLIT (LDOAN,JSLF)
-C! CALL FAILCC (1, 'Bad syntax for delayed c/l')
-C! GO TO 79
- END
diff --git a/src/p5boot/p5lib/m_a3if.f b/src/p5boot/p5lib/m_a3if.f
deleted file mode 100644
index e803bd1..0000000
--- a/src/p5boot/p5lib/m_a3if.f
+++ /dev/null
@@ -1,196 +0,0 @@
-CDECK ID>, M_A3IF.
- SUBROUTINE M_A3IF (IFSTEP)
-
-C- Content analysis stage 3:
-C- scan the PREP/MAT structure from the current +_IF to its
-C- terminating +_ENDIF and decide accept/reject.
-
-C- On entry LDOAN points to this +_IF, it has already been cracked;
-C- return LDOAN pointing to the end, and IFSTEP = 1 if LDOAN
-C- does point to the terminating +_ENDIF (preset =1 by M_ANA3),
-C- but for some error LDOAN points to some c/line which must still
-C- be analysed in M_ANA3, in this case set IFSTEP = 0;
-C- also: JCCBAD non-zero signals c/line with syntax error
-C. started 6-july-93
-
- PARAMETER (KM1=1,KM2=2,KM3=4,KM4=8,KM5=16,KM6=32,KM7=64,KM8=128,
- + KM9=256, KM10=512, KM11=1024, KM12=2048, KM13=4096, KM14=8192,
- + KM15=16384, KM16=32768, KM17=65536, KM18=131072, KM19=262144)
- PARAMETER (KMA=1,KMB=2,KMC=4,KMD=8,KME=16,KMF=32,KMG=64,KMH=128,
- + KMI=256, KMJ=512, KMK=KM11, KML=KM12, KMM=KM13, KMN=KM14,
- + KMO=KM15, KMP=KM16, KMQ=KM17, KMR=KM18, KMS=KM19)
- PARAMETER (MCCNIL=1, MCCKIL=2, MCCINC=3, MCCCDE=4, MCCSEQ=5,
- + MCCXSQ=6, MCCTRU=7, MCCFAL=8, MCCELS=9, MCCEND=10,
- + MCCSEL=11, MCCSES=12, MCCFAU=13, MCCSKI=14,
- + MCCKEE=15, MCCDEL=16, MCCREP=17, MCCADB=18, MCCADD=19,
- + MCCUSE=20, MCCXDI=21, MCCDIV=22, MCCLIS=23, MCCEXE=24, MCCIMI=25,
- + MCCASM=26, MCCUPD=27, MCCNAM=28, MCCGAP=29, MCCMOR=30, MCCONL=31,
- + MCCFOR=32, MCCSUS=33, MCCOPT=34, MCCOP2=35, MCCSHO=36, MCCPAM=37,
- + MCCQUI=38, MCCEOD=39, MCCDEC=40, MCCPAT=41, MCCTIT=42)
- CHARACTER CCKORG*256, CCKARD*256, CCCOMF*256
- COMMON /CCPARA/NCHCCD,NCHCCT, JCCTYP,JCCLEV,JCCSL,MCCPAR(240)
- +, NCCPAR,MXCCIF,JCCIFV,JCCBAD,JCCWAR,ICCSUB,JCCWK(4)
- +, JCCPP,JCCPD,JCCPZ,JCCPT,JCCPIF,JCCPC,JCCPN
- +, NCCPP,NCCPD,NCCPZ,NCCPT,NCCPIF,NCCPC,NCCPN
- +, JCCEND, NCHCCC,IXCCC, CCKORG, CCKARD, CCCOMF
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
- COMMON /M_ANAC/LOWAN,KDOAN,LDOAN,LUPAN,MODEAN,MEXAN,LEVAN,KKM5AN
- +, NEWDEC,NEWCTL,NEWFOR,NEWNIL,NEWINC
-C-------------- End CDE --------------------------------
-
- IAND (IZV,IZW) = AND (IZV, IZW)
- IOR (IZV,IZW) = OR (IZV, IZW)
-
-
- IF (JCCTYP.GE.MCCELS) GO TO 93
- CALL CCIFLV
- IQ(LDOAN) = IOR (IQ(LDOAN), KM17)
- MODEAN = 1
- MAXLEV = 36
- LEVIF = 1
- INCLEV = LEVIF - JCCLEV
- IF (INCLEV.EQ.LEVAN) GO TO 25
- IF (LEVAN.EQ.7) THEN
- LEVAN = INCLEV
- GO TO 25
- ELSE
- CALL M_WNIF (LEVAN-INCLEV)
- ENDIF
- GO TO 25
-
-C------ accepted material
-
- 22 CALL M_A3NX
- IF (LDOAN.EQ.0) GO TO 94
- IF (JCCTYP.GE.MCCSEL) GO TO 94
- IF (JCCTYP.GE.MCCTRU) GO TO 24
- IF (JCCTYP.LT.MCCCDE) GO TO 22
-
-C-- handle accepted +CDE +SEQ
-
- IF (JCCTYP.NE.MCCXSQ) THEN
- CALL M_KRAK (1)
- IF (JCCBAD.NE.0) RETURN
- MEXAN = IOR (MEXAN,MXCCIF)
- IF (IAND(MCCPAR(JCCPT+1),KMD).NE.0) JCCIFV= 1
- ENDIF
-
- CALL M_A3SQ
- IF (JCCBAD.EQ.0) GO TO 22
- RETURN
-
-C-- new control
-
- 24 CALL M_KRAK (0)
- IF (JCCBAD.NE.0) RETURN
- CALL CCIFLV
-
- IF (JCCTYP.EQ.MCCELS) GO TO 26
- IF (JCCTYP.EQ.MCCEND) GO TO 28
-
-C-- handle +__IF
-
- CALL CCPROC
- LEVIF = LEVIF + 1
- N = JCCLEV+INCLEV - LEVIF
- IF (N.NE.0) CALL M_WNIF (N)
- IF (LEVIF.GE.MAXLEV) GO TO 92
- 25 MEXAN = IOR (MEXAN,MXCCIF)
- IF (JCCTYP.EQ.MCCFAL) JCCIFV= MAX(0, 1-JCCIFV)
- IF (JCCIFV.EQ.0) GO TO 22
- LVREND = LEVIF
- LVRELS = LEVIF + 1
- GO TO 41
-
-C-- handle +_ELSE, IF=xxx
-
- 26 N = JCCLEV+INCLEV - LEVIF
- IF (N.NE.0) CALL M_WNIF (N)
- LVREND = LEVIF
- LVRELS = LEVIF
- GO TO 41
-
-C-- handle +_ENDIF
-
- 28 N = JCCLEV+INCLEV - LEVIF
- IF (N.NE.0) CALL M_WNIF (N)
- LEVIF = LEVIF - 1
- IF (LEVIF.EQ.0) RETURN
- GO TO 22
-
-C------ rejected material
-
- 41 MBUSE = KM5
- 42 IQ(LDOAN) = IOR (IQ(LDOAN), MBUSE)
- MBUSE = KM6
- CALL M_A3NX
- IF (LDOAN.EQ.0) GO TO 94
- IF (JCCTYP.GE.MCCSEL) GO TO 94
- IF (JCCTYP.LT.MCCTRU) GO TO 42
-
-C-- new control
-
- CALL M_KRAK (0)
- IF (JCCBAD.NE.0) RETURN
- CALL CCIFLV
-
- IF (JCCTYP.EQ.MCCELS) GO TO 46
- IF (JCCTYP.EQ.MCCEND) GO TO 48
-
-C-- handle +__IF
-
- LEVIF = LEVIF + 1
- N = JCCLEV+INCLEV - LEVIF
- IF (N.NE.0) CALL M_WNIF (N)
- IF (LEVIF.GE.MAXLEV) GO TO 92
- GO TO 42
-
-C-- handle +_ELSE, IF=xxx
-
- 46 N = JCCLEV+INCLEV - LEVIF
- IF (N.NE.0) CALL M_WNIF (N)
- IF (LEVIF.GE.LVRELS) GO TO 42
- CALL CCPROC
- MEXAN = IOR (MEXAN,MXCCIF)
- IF (JCCIFV.NE.0) GO TO 41
- GO TO 22
-
-C-- handle +_ENDIF
-
- 48 N = JCCLEV+INCLEV - LEVIF
- IF (N.NE.0) CALL M_WNIF (N)
- LEVIF = LEVIF - 1
- IF (LEVIF.GE.LVREND) GO TO 42
- IF (LEVIF.EQ.0) RETURN
- GO TO 22
-
-C----- Trouble
-
- 94 CALL FAILCC (1, 'Non-terminated +_IF')
- IFSTEP = 0
- RETURN
-
- 93 IF (JCCTYP.EQ.MCCEND) THEN
- CALL FAILCC (0, 'Redundant +_ENDIF')
- RETURN
- ENDIF
-
- CALL M_FAIL ('Unmatched +_ELSE')
- RETURN
-
- 92 CALL M_FAIL ('Maximum +_IF nesting level exceeded')
- RETURN
- END
diff --git a/src/p5boot/p5lib/m_a3ke.f b/src/p5boot/p5lib/m_a3ke.f
deleted file mode 100644
index 8160593..0000000
--- a/src/p5boot/p5lib/m_a3ke.f
+++ /dev/null
@@ -1,112 +0,0 @@
-CDECK ID>, M_A3KE.
- SUBROUTINE M_A3KE
-
-C- Content analysis stage 3:
-C- scan the material of the +KEEP being defined
-C- return JCCBAD non-zero to signal c/line with syntax error at LDOAN
-C. started 8-dec-93
-
- PARAMETER (MCCNIL=1, MCCKIL=2, MCCINC=3, MCCCDE=4, MCCSEQ=5,
- + MCCXSQ=6, MCCTRU=7, MCCFAL=8, MCCELS=9, MCCEND=10,
- + MCCSEL=11, MCCSES=12, MCCFAU=13, MCCSKI=14,
- + MCCKEE=15, MCCDEL=16, MCCREP=17, MCCADB=18, MCCADD=19,
- + MCCUSE=20, MCCXDI=21, MCCDIV=22, MCCLIS=23, MCCEXE=24, MCCIMI=25,
- + MCCASM=26, MCCUPD=27, MCCNAM=28, MCCGAP=29, MCCMOR=30, MCCONL=31,
- + MCCFOR=32, MCCSUS=33, MCCOPT=34, MCCOP2=35, MCCSHO=36, MCCPAM=37,
- + MCCQUI=38, MCCEOD=39, MCCDEC=40, MCCPAT=41, MCCTIT=42)
- CHARACTER CCKORG*256, CCKARD*256, CCCOMF*256
- COMMON /CCPARA/NCHCCD,NCHCCT, JCCTYP,JCCLEV,JCCSL,MCCPAR(240)
- +, NCCPAR,MXCCIF,JCCIFV,JCCBAD,JCCWAR,ICCSUB,JCCWK(4)
- +, JCCPP,JCCPD,JCCPZ,JCCPT,JCCPIF,JCCPC,JCCPN
- +, NCCPP,NCCPD,NCCPZ,NCCPT,NCCPIF,NCCPC,NCCPN
- +, JCCEND, NCHCCC,IXCCC, CCKORG, CCKARD, CCCOMF
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
- COMMON /M_ANAC/LOWAN,KDOAN,LDOAN,LUPAN,MODEAN,MEXAN,LEVAN,KKM5AN
- +, NEWDEC,NEWCTL,NEWFOR,NEWNIL,NEWINC
-C-------------- End CDE --------------------------------
-
-
- MAXLEV = 36
- LEVIF = 0
-
- 22 CALL M_A3NX
- IF (LDOAN.EQ.0) GO TO 49
- IF (JCCTYP.GE.MCCSEL) GO TO 49
- IF (JCCTYP.LT.MCCCDE) GO TO 22
- IF (JCCTYP.EQ.MCCXSQ) GO TO 22
-
- CALL M_KRAK (0)
- IF (JCCBAD.NE.0) RETURN
- IF (JCCTYP.LT.MCCTRU) GO TO 22
-
-C-- new control
-
- CALL CCIFLV
-
- IF (JCCTYP.EQ.MCCELS) GO TO 26
- IF (JCCTYP.EQ.MCCEND) GO TO 28
-
-C-- handle +__IF
-
- LEVIF = LEVIF + 1
- IF (LEVIF.GE.2) GO TO 24
- INCLEV = LEVIF - JCCLEV
- IF (INCLEV.EQ.LEVAN) GO TO 22
- IF (LEVAN.EQ.7) THEN
- LEVAN = INCLEV
- ELSE
- CALL M_WNIF (LEVAN-INCLEV)
- ENDIF
- GO TO 22
-
- 24 N = JCCLEV+INCLEV - LEVIF
- IF (N.NE.0) CALL M_WNIF (N)
- IF (LEVIF.GE.MAXLEV) GO TO 91
- GO TO 22
-
-C-- handle +_ELSE, IF=xxx
-
- 26 IF (LEVIF.EQ.0) GO TO 92
- N = JCCLEV+INCLEV - LEVIF
- IF (N.NE.0) CALL M_WNIF (N)
- GO TO 22
-
-C-- handle +_ENDIF
-
- 28 IF (LEVIF.EQ.0) GO TO 93
- N = JCCLEV+INCLEV - LEVIF
- IF (N.NE.0) CALL M_WNIF (N)
- LEVIF = LEVIF - 1
- GO TO 22
-
-C---- Done
-
- 49 IF (LEVIF.EQ.0) RETURN
-
-C----- Trouble
-
- CALL FAILCC (1, 'Non-terminated +_IF')
- RETURN
-
- 93 CALL FAILCC (0, 'Redundant +_ENDIF')
- GO TO 22
-
- 92 CALL M_FAIL ('Unmatched +_ELSE')
- RETURN
-
- 91 CALL M_FAIL ('Maximum +_IF nesting level exceeded')
- RETURN
- END
diff --git a/src/p5boot/p5lib/m_a3nx.f b/src/p5boot/p5lib/m_a3nx.f
deleted file mode 100644
index c4f0cba..0000000
--- a/src/p5boot/p5lib/m_a3nx.f
+++ /dev/null
@@ -1,118 +0,0 @@
-CDECK ID>, M_A3NX.
- SUBROUTINE M_A3NX
-
-C- Service routine to M_ANA3, content analysis stage 3:
-C- step to next non-deleted bank, set JCCTYP
-C- activating delayed control lines now used in self material.
-C. started 26-nov-91
-
- PARAMETER (KM1=1,KM2=2,KM3=4,KM4=8,KM5=16,KM6=32,KM7=64,KM8=128,
- + KM9=256, KM10=512, KM11=1024, KM12=2048, KM13=4096, KM14=8192,
- + KM15=16384, KM16=32768, KM17=65536, KM18=131072, KM19=262144)
- PARAMETER (MCCNIL=1, MCCKIL=2, MCCINC=3, MCCCDE=4, MCCSEQ=5,
- + MCCXSQ=6, MCCTRU=7, MCCFAL=8, MCCELS=9, MCCEND=10,
- + MCCSEL=11, MCCSES=12, MCCFAU=13, MCCSKI=14,
- + MCCKEE=15, MCCDEL=16, MCCREP=17, MCCADB=18, MCCADD=19,
- + MCCUSE=20, MCCXDI=21, MCCDIV=22, MCCLIS=23, MCCEXE=24, MCCIMI=25,
- + MCCASM=26, MCCUPD=27, MCCNAM=28, MCCGAP=29, MCCMOR=30, MCCONL=31,
- + MCCFOR=32, MCCSUS=33, MCCOPT=34, MCCOP2=35, MCCSHO=36, MCCPAM=37,
- + MCCQUI=38, MCCEOD=39, MCCDEC=40, MCCPAT=41, MCCTIT=42)
- CHARACTER CCKORG*256, CCKARD*256, CCCOMF*256
- COMMON /CCPARA/NCHCCD,NCHCCT, JCCTYP,JCCLEV,JCCSL,MCCPAR(240)
- +, NCCPAR,MXCCIF,JCCIFV,JCCBAD,JCCWAR,ICCSUB,JCCWK(4)
- +, JCCPP,JCCPD,JCCPZ,JCCPT,JCCPIF,JCCPC,JCCPN
- +, NCCPP,NCCPD,NCCPZ,NCCPT,NCCPIF,NCCPC,NCCPN
- +, JCCEND, NCHCCC,IXCCC, CCKORG, CCKARD, CCCOMF
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
- COMMON /M_ANAC/LOWAN,KDOAN,LDOAN,LUPAN,MODEAN,MEXAN,LEVAN,KKM5AN
- +, NEWDEC,NEWCTL,NEWFOR,NEWNIL,NEWINC
-C-------------- End CDE --------------------------------
-
- PARAMETER (MASKTY=KM9+KM10+KM11+KM12+KM13+KM14)
-
- IAND (IZV,IZW) = AND (IZV, IZW)
- IOR (IZV,IZW) = OR (IZV, IZW)
- ISHFTL (IZW,NZB) = LSHIFT (IZW, NZB)
-
-
-
-C------ Next PREP bank
-
- IF (LUPAN.NE.0) GO TO 34
- 22 KDOAN = LDOAN - 1
- LDOAN = LQ(KDOAN)
- IF (LDOAN.EQ.0) RETURN
- IF (IAND(IQ(LDOAN),KM5+KM6).NE.0) GO TO 22
-
-C-- next live PREP bank
-
- L = LQ(LDOAN-2)
- IF (L.NE.0) GO TO 31
- JCCTYP = JBYT (IQ(LDOAN),9,6)
- RETURN
-
-C---- Follow reference to foreign material
-
- 31 LOWAN = LDOAN
- LUPAN = L
- LDOAN = LUPAN - 1
-
-C------ Next MAT bank
-
- 34 KDOAN = LDOAN - 1
- LDOAN = LQ(KDOAN)
- IF (LDOAN.EQ.0) THEN
-C-- end of chain of MAT banks
- LDOAN = LOWAN
- LUPAN = 0
- GO TO 22
- ENDIF
-
- JCCTYP = JBYT (IQ(LDOAN),9,6)
- IF (MOPUPD.LT.0) GO TO 61
-C! IF (MODEAN.EQ.4) RETURN
-
-C-- activate delayed c/l now used in self or KEEP material
-
- IF (IAND(IQ(LDOAN),KM15).EQ.0) RETURN
- JSLA = IQ(LDOAN+1)
- JTX = MLIAD(JSLA)
- TEXT(JTX) = '+'
- JTYPE = JPTYPE(TEXT(JTX))
- IF (MOPUPD.NE.0) THEN
- IF (JTYPE.LT.MCCSEL) RETURN
- ENDIF
- JCCTYP = JTYPE
- IQ(LDOAN) = IOR (IQ(LDOAN),ISHFTL(JCCTYP,8))
- RETURN
-
-C-- +PAM, T=UP update mode
-
- 61 IF (JCCTYP.EQ.0) GO TO 62
- IF (JCCTYP.EQ.MCCXSQ) RETURN
- JCCTYP = 0
- IQ(LDOAN) = IAND (IQ(LDOAN),NOT(MASKTY))
-
- 62 JSLA = IQ(LDOAN+1)
- JSLE = IQ(LDOAN+2) + JSLA
- 64 CALL NEXTCC ('-',JSLA,JSLE,JSLF,JTYPE)
- IF (JTYPE.EQ.0) RETURN
- JTX = MLIAD(JSLF)
- TEXT(JTX) = '+'
- JSLA = JSLF + 1
- IF (JSLA.LT.JSLE) GO TO 64
- RETURN
- END
diff --git a/src/p5boot/p5lib/m_a3sq.f b/src/p5boot/p5lib/m_a3sq.f
deleted file mode 100644
index e0fae98..0000000
--- a/src/p5boot/p5lib/m_a3sq.f
+++ /dev/null
@@ -1,150 +0,0 @@
-CDECK ID>, M_A3SQ.
- SUBROUTINE M_A3SQ
-
-C- Service routine to M_ANA3, content analysis stage 3:
-C- ready sequence call bank for +CDE +SEQ or +SELF,sname
-C- connecting the called sequences ready for use.
-C- Return IQUEST(1) zero except for +SELF, sname with
-C- sequence sname existing, when the default self material
-C- has to be ignored.
-C. started 15-dec-91
-
- PARAMETER (KM1=1,KM2=2,KM3=4,KM4=8,KM5=16,KM6=32,KM7=64,KM8=128,
- + KM9=256, KM10=512, KM11=1024, KM12=2048, KM13=4096, KM14=8192,
- + KM15=16384, KM16=32768, KM17=65536, KM18=131072, KM19=262144)
- PARAMETER (MCCNIL=1, MCCKIL=2, MCCINC=3, MCCCDE=4, MCCSEQ=5,
- + MCCXSQ=6, MCCTRU=7, MCCFAL=8, MCCELS=9, MCCEND=10,
- + MCCSEL=11, MCCSES=12, MCCFAU=13, MCCSKI=14,
- + MCCKEE=15, MCCDEL=16, MCCREP=17, MCCADB=18, MCCADD=19,
- + MCCUSE=20, MCCXDI=21, MCCDIV=22, MCCLIS=23, MCCEXE=24, MCCIMI=25,
- + MCCASM=26, MCCUPD=27, MCCNAM=28, MCCGAP=29, MCCMOR=30, MCCONL=31,
- + MCCFOR=32, MCCSUS=33, MCCOPT=34, MCCOP2=35, MCCSHO=36, MCCPAM=37,
- + MCCQUI=38, MCCEOD=39, MCCDEC=40, MCCPAT=41, MCCTIT=42)
- CHARACTER CCKORG*256, CCKARD*256, CCCOMF*256
- COMMON /CCPARA/NCHCCD,NCHCCT, JCCTYP,JCCLEV,JCCSL,MCCPAR(240)
- +, NCCPAR,MXCCIF,JCCIFV,JCCBAD,JCCWAR,ICCSUB,JCCWK(4)
- +, JCCPP,JCCPD,JCCPZ,JCCPT,JCCPIF,JCCPC,JCCPN
- +, NCCPP,NCCPD,NCCPZ,NCCPT,NCCPIF,NCCPC,NCCPN
- +, JCCEND, NCHCCC,IXCCC, CCKORG, CCKARD, CCCOMF
- COMMON /INCLC/ N_INCL, IX_INCL(100)
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
- COMMON /M_ANAC/LOWAN,KDOAN,LDOAN,LUPAN,MODEAN,MEXAN,LEVAN,KKM5AN
- +, NEWDEC,NEWCTL,NEWFOR,NEWNIL,NEWINC
-C-------------- End CDE --------------------------------
-
- IAND (IZV,IZW) = AND (IZV, IZW)
- IOR (IZV,IZW) = OR (IZV, IZW)
-
-
-C-- MODEAN = 0 ordinary self 1 IF-conditional self
-C-- 2 +SELF,sname (3 +REPL,+ADB,+ADD)
-
- ICODE = 0
- IF (JCCTYP.EQ.MCCXSQ) GO TO 37
-
- IF (JCCIFV.NE.0) THEN
- IQ(LDOAN) = IOR (IQ(LDOAN), KM5)
- IQUEST(1) = 1
- RETURN
- ENDIF
- IF (JCCTYP.LE.MCCINC) GO TO 61
-
- LOSTNZ = 0
- IF (MODEAN.NE.2) GO TO 31
-
-C---- handle +SELF, sname
-
-C- - if self material of this deck:
-C- "sname" exists: replace PREP bank by a new XSQ bank
-C- not existing: change type of the PREP bank to MCCSEL
-C-
-C- - if material into this deck:
-C- the MAT bank is already a XSQ
-C- "sname" exists: use it
-C- not existing: change type of the PREP bank to MCCSEL
-
- IF (LUPAN.NE.0) THEN
- IXSQ = IQ(LDOAN+5)
- ELSE
- IXSQ = MCCPAR(JCCPZ+1)
- ENDIF
-
- KP = LEXP - 3
- KD = 0
- IF (LEXD.NE.0) KD= LEXD-3
-
- CALL LOCSEQ (L, IXSQ,KP,KD)
- IF (L.EQ.0) GO TO 49
-
-C-- sequence exists
-
- ICODE = 7
-
-C---- lift XSQ bank to replace the PREP bank
-
-C- LIFTSQ (kjoin, cc-type to be stored,
-C- JSL of line to be cracked if non-zero, division)
-
- 31 IF (LUPAN.NE.0) GO TO 37
- LSQ = LIFTSQ (KDOAN, JCCTYP, 0,2)
- LOSTNZ = IQUEST(1)
-
- LQ(LSQ-1) = LQ(LDOAN-1)
- IQ(LSQ) = IOR (IQ(LSQ), IAND(IQ(LDOAN),KM5-1))
- IQ(LSQ+1) = IQ(LDOAN+1)
- IQ(LSQ+2) = 1
- IQ(LSQ+3) = IQ(LDOAN+1) - JSLORG
-
- LDOAN = LSQ
- IF (LOSTNZ.NE.0) GO TO 39
-
-C-- connect all sequences called
-
- 37 MX = LINKSQ (LDOAN,0)
- MEXAN = IOR (MEXAN,MX)
- IQUEST(1) = ICODE
- RETURN
-
-C---- Trouble
-
- 39 CALL M_FAIL ('More than 61 sequence calls on this line')
- RETURN
-
-C---- sequence not defined, convert to ordinary +SELF
-
- 49 CALL SBYT (MCCSEL, IQ(LDOAN),9,6)
- IQUEST(1) = 0
- RETURN
-
-C------ Handle +INCLUDE, sname
-
- 61 IF (JCCTYP.EQ.MCCKIL) RETURN
- 62 IXSQ = MCCPAR(JCCPZ+1)
- IF (N_INCL.GE.100) GO TO 66
- N_INCL = N_INCL + 1
- IX_INCL(N_INCL) = IXSQ
-
- LINCL = LQFIND (IXSQ,1,LQINCL)
- IF (LINCL.EQ.0) GO TO 66
- MEXAN = IOR (MEXAN,IQ(LINCL))
- IF (IAND(IQ(LINCL),KM5).EQ.0) GO TO 67
-
- 66 NEWINC = 1
- 67 JCCPZ = JCCPZ + 3
- NCCPZ = NCCPZ - 1
- IF (NCCPZ.GT.0) GO TO 62
- RETURN
- END
diff --git a/src/p5boot/p5lib/m_ana1.f b/src/p5boot/p5lib/m_ana1.f
deleted file mode 100644
index 5d14eaf..0000000
--- a/src/p5boot/p5lib/m_ana1.f
+++ /dev/null
@@ -1,98 +0,0 @@
-CDECK ID>, M_ANA1.
- SUBROUTINE M_ANA1
-
-C- Content analysis, stage 1:
-C- find all control lines present in the current deck;
-C- each control line starts a new PREP bank, unless it is
-C- a soft c/line covered by a +KEEP +REPL etc. in update mode;
-C- c/lines without associated text are held in a 1-line PREP bank.
-C- - this is not called if the deck is processed under +PAM, T=UPD
-C- and hence all c/l's in the deck are treated as ordinary lines
-C. started 11-dec-91
-
- PARAMETER (MCCNIL=1, MCCKIL=2, MCCINC=3, MCCCDE=4, MCCSEQ=5,
- + MCCXSQ=6, MCCTRU=7, MCCFAL=8, MCCELS=9, MCCEND=10,
- + MCCSEL=11, MCCSES=12, MCCFAU=13, MCCSKI=14,
- + MCCKEE=15, MCCDEL=16, MCCREP=17, MCCADB=18, MCCADD=19,
- + MCCUSE=20, MCCXDI=21, MCCDIV=22, MCCLIS=23, MCCEXE=24, MCCIMI=25,
- + MCCASM=26, MCCUPD=27, MCCNAM=28, MCCGAP=29, MCCMOR=30, MCCONL=31,
- + MCCFOR=32, MCCSUS=33, MCCOPT=34, MCCOP2=35, MCCSHO=36, MCCPAM=37,
- + MCCQUI=38, MCCEOD=39, MCCDEC=40, MCCPAT=41, MCCTIT=42)
- CHARACTER CCKORG*256, CCKARD*256, CCCOMF*256
- COMMON /CCPARA/NCHCCD,NCHCCT, JCCTYP,JCCLEV,JCCSL,MCCPAR(240)
- +, NCCPAR,MXCCIF,JCCIFV,JCCBAD,JCCWAR,ICCSUB,JCCWK(4)
- +, JCCPP,JCCPD,JCCPZ,JCCPT,JCCPIF,JCCPC,JCCPN
- +, NCCPP,NCCPD,NCCPZ,NCCPT,NCCPIF,NCCPC,NCCPN
- +, JCCEND, NCHCCC,IXCCC, CCKORG, CCKARD, CCCOMF
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
-C-------------- End CDE --------------------------------
-
- IOR (IZV,IZW) = OR (IZV, IZW)
- ISHFTL (IZW,NZB) = LSHIFT (IZW, NZB)
-
-
- LDO = LQPREP
- JSLA = IQ(LDO+1)
- JSLE = JSLA + IQ(LDO+2)
- JSLG = JSLA
-
-C---- Find next control line, split on it
-
- 21 IF (JSLG.GE.JSLE) RETURN
- CALL NEXTCC ('+',JSLG,JSLE,JSLF,JCCTYP)
- IF (JCCTYP.EQ.0) RETURN
-
- 22 IF (JSLF.GT.JSLA) LDO= M_SPLIT (LDO,JSLF)
-
- IQ(LDO) = IOR (IQ(LDO), ISHFTL(JCCTYP,8))
- JSLA = IQ(LDO+1)
- JSLG = JSLA + 1
-
-C-- control-lines with associated material are:
-C-- +_xxx +SELF +SKIP +KEEP +REPL +ADB +ADD
-
- IF (JCCTYP.LT.MCCTRU) GO TO 27
- IF (JCCTYP.LE.MCCEND) GO TO 21
- IF (JCCTYP.GE.MCCUSE) GO TO 27
- IF (JCCTYP.GE.MCCKEE) GO TO 31
- IF (JCCTYP.NE.MCCSEL) GO TO 21
-
-C-- for +SELF, sname change the type to MCCSES
-
- CALL CCKRAK (JSLA)
- IF (NCCPZ.EQ.0) GO TO 21
- CALL SBYT (MCCSES, IQ(LDO),9,6)
- GO TO 21
-
-C-- stand-alone control-line
-
- 27 IF (JSLG.GE.JSLE) RETURN
- LDO = M_SPLIT (LDO,JSLG)
- JSLA = JSLG
- GO TO 21
-
-C---- Found the start of an action, if Update mode:
-C-- handle all soft c/lines inside as ordinary lines
-
- 31 IF (JCCTYP.EQ.MCCDEL) GO TO 27
- IF (MOPUPD.EQ.0) GO TO 21
- 37 CALL NEXTCC ('+',JSLG,JSLE,JSLF,JCCTYP)
- IF (JCCTYP.EQ.0) RETURN
- IF (JCCTYP.GE.MCCSEL) GO TO 22
- JSLG = JSLF + 1
- IF (JSLG.LT.JSLE) GO TO 37
- RETURN
- END
diff --git a/src/p5boot/p5lib/m_ana2.f b/src/p5boot/p5lib/m_ana2.f
deleted file mode 100644
index 87e9ce7..0000000
--- a/src/p5boot/p5lib/m_ana2.f
+++ /dev/null
@@ -1,176 +0,0 @@
-CDECK ID>, M_ANA2.
- SUBROUTINE M_ANA2
-
-C- Content analysis stage 2:
-C- 1.1) for each action insert a zero-line PREP bank into the chain
-C- of PREP banks with a reference to the ACT bank acting into
-C- the current deck;
-C- 1.2) split the target PREP bank containing the end of
-C- a DELETE or REPLACE range;
-C- 2.1) transfer the action EXE bits into the new PREP bank;
-C- 2.2) for the PREP banks covered by a DEL or REPL transfer the
-C- EXE bits of the action, and mark as deleted (unless nil)
-C- 3) add one zero-line PREP bank for each trailing action;
-C- - called also if PAM update mode -
-C. started 11-nov-91
-
- PARAMETER (KM1=1,KM2=2,KM3=4,KM4=8,KM5=16,KM6=32,KM7=64,KM8=128,
- + KM9=256, KM10=512, KM11=1024, KM12=2048, KM13=4096, KM14=8192,
- + KM15=16384, KM16=32768, KM17=65536, KM18=131072, KM19=262144)
- PARAMETER (NBANKS=19,JBKPAT=1, JBKDEC=2, JBKORG=3, JBKINC=4,
- + JBKHOL=5, JBKKEE=6, JBKACT=7, JBKMAT=8, JBKXSQ=9,
- + JBKPRE=10,JBKGAR=11,JBKSMH=12,JBKSMT=13,JBKSML=14,
- + JBKSMX=15,JBKARR=16,JBKASA=17,JBKPAM=18,JBKRPA=19)
- COMMON /QBANKS/MMBANK(5,NBANKS)
- PARAMETER (MCCNIL=1, MCCKIL=2, MCCINC=3, MCCCDE=4, MCCSEQ=5,
- + MCCXSQ=6, MCCTRU=7, MCCFAL=8, MCCELS=9, MCCEND=10,
- + MCCSEL=11, MCCSES=12, MCCFAU=13, MCCSKI=14,
- + MCCKEE=15, MCCDEL=16, MCCREP=17, MCCADB=18, MCCADD=19,
- + MCCUSE=20, MCCXDI=21, MCCDIV=22, MCCLIS=23, MCCEXE=24, MCCIMI=25,
- + MCCASM=26, MCCUPD=27, MCCNAM=28, MCCGAP=29, MCCMOR=30, MCCONL=31,
- + MCCFOR=32, MCCSUS=33, MCCOPT=34, MCCOP2=35, MCCSHO=36, MCCPAM=37,
- + MCCQUI=38, MCCEOD=39, MCCDEC=40, MCCPAT=41, MCCTIT=42)
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
- COMMON /M_ANAC/LOWAN,KDOAN,LDOAN,LUPAN,MODEAN,MEXAN,LEVAN,KKM5AN
- +, NEWDEC,NEWCTL,NEWFOR,NEWNIL,NEWINC
-C-------------- End CDE --------------------------------
-
- IAND (IZV,IZW) = AND (IZV, IZW)
- IOR (IZV,IZW) = OR (IZV, IZW)
-
-
-C---------- Split PREP banks on all action limits -----------
-
- LDO = LQPREP
- LACT = LEXD - 1
-
-C---- Next action
-
- 21 LACT = LQ(LACT-1)
- IF (LACT.EQ.0) GO TO 40
-
-C- JACT = 0 DEL, 1 REP, 2 ADB, 3 ADD
-
- JACT = JBYT (IQ(LACT),9,3)
- JSLX = IQ(LACT+4) + JSLZER
-
-C- break at the insertion point
-
- LDO = M_SPLIT (LDO,JSLX)
- IF (LDO.EQ.0) GO TO 40
-
-C- zero-line PREP bank with reference to ACT
-
- LX = LDO
- LDO = M_SPLIT (LDO,0)
- LQ(LX-2) = LACT
- IF (JACT.GE.2) GO TO 21
-
-C---- +DEL, +REPL: split at end of delete
-
- JSLD = IQ(LACT+5) + JSLZER + 1
- LNX = M_SPLIT (LDO,JSLD)
- GO TO 21
-
-C---------- Set EXE bits and mark deleted material ----------
-
- 40 KMDEL = KM6 + KM7
- IF (IFLDISP.NE.0) KMDEL= KM5 + KM7
-
- LDO = LQPREP
- LACT = LEXD - 1
-
-C---- Next action
-
- 41 LACT = LQ(LACT-1)
- IF (LACT.EQ.0) RETURN
-
-C- JACT = 0 DEL, 1 REP, 2 ADB, 3 ADD
-
- JACT = JBYT (IQ(LACT),9,3)
- NIL = IAND (IQ(LACT),KM12)
- NDEL = IAND (IQ(LACT),KM12+KM13)
- MEXE = IAND (IQ(LACT),15)
- MEXAN = IOR (MEXAN,MEXE)
-
-C-- Find the PREP bank for this action
-
- 43 IF (LQ(LDO-2).NE.LACT) THEN
- LSV = LDO
- LDO = LQ(LDO-1)
- IF (LDO.EQ.0) GO TO 61
- GO TO 43
- ENDIF
-
- MAB = MEXE
- IF (NDEL.NE.0) MAB = MAB + KM6
- IQ(LDO) = IOR (IQ(LDO),MAB)
- IF (JACT.GE.2) GO TO 41
-
-C---- +DEL, +REPL: mark deleted section
-
- JSLD = IQ(LACT+5) + JSLZER + 1
- LNX = LDO
- 47 LNX = LQ(LNX-1)
- IF (LNX.EQ.0) GO TO 41
- JSLA = IQ(LNX+1)
- IF (JSLA.GE.JSLD) GO TO 41
-
- IQ(LNX) = IOR (IQ(LNX),MEXE)
- IF (NIL.NE.0) GO TO 47
- IF (LQ(LNX-2).NE.0) GO TO 47
-
- IQ(LNX) = IOR (IQ(LNX),KMDEL)
-
-C-- deleted action?
-
- JTYP = JBYT (IQ(LNX),9,6)
- IF (JTYP.LT.MCCKEE) GO TO 47
- IF (JTYP.GE.MCCUSE) GO TO 47
- NEWNIL = NEWNIL + 1
- GO TO 47
-
-C---- Add trailing actions
-
- 61 JSLSV = IQ(LSV+1) + IQ(LSV+2)
-
- 62 MEXAN = IOR (MEXAN,MEXE)
- IF (NDEL.EQ.0) THEN
- IF (JACT.LT.2) GO TO 67
- ELSE
- MEXE = MEXE + KM6
- ENDIF
-
- CALL MQLIFT (LNEW,LSV,-1,JBKPRE,2)
- LSV = LNEW
- LQ(LSV-2) = LACT
- IQ(LSV) = IOR (IQ(LSV),MEXE)
- IQ(LSV+1) = JSLSV
-
- 64 LACT = LQ(LACT-1)
- IF (LACT.EQ.0) RETURN
-
- JACT = JBYT (IQ(LACT),9,3)
- MEXE = IAND (IQ(LACT),15)
- NDEL = IAND (IQ(LACT),KM12+KM13)
- GO TO 62
-
-C: DATA CHER( 1) /'illegal action after end-of-deck'/
-
- 67 CALL FAILLN (1,LQ(LACT-3),IQ(LACT+3),IQ(LACT+1),
- + 'Illegal action after end-of-deck')
- GO TO 64
- END
diff --git a/src/p5boot/p5lib/m_ana3.f b/src/p5boot/p5lib/m_ana3.f
deleted file mode 100644
index 2526a83..0000000
--- a/src/p5boot/p5lib/m_ana3.f
+++ /dev/null
@@ -1,342 +0,0 @@
-CDECK ID>, M_ANA3.
- SUBROUTINE M_ANA3
-
-C- Content analysis stage 3:
-C- ready effective self-material for use
-C- activating delayed control lines
-C- evaluating IF selection
-C- resolving sequence calls
-C- collecting EXE bits from called sqs and IF= params
-C- ready new effective foreign material for use
-C- activating delayed control lines
-C- evaluating initial IF selection
-C- - called also if PAM update mode -
-C. started 25-nov-91
-
- COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT,NUSLAT(2),DUMMY(34)
- PARAMETER (KM1=1,KM2=2,KM3=4,KM4=8,KM5=16,KM6=32,KM7=64,KM8=128,
- + KM9=256, KM10=512, KM11=1024, KM12=2048, KM13=4096, KM14=8192,
- + KM15=16384, KM16=32768, KM17=65536, KM18=131072, KM19=262144)
- PARAMETER (KMA=1,KMB=2,KMC=4,KMD=8,KME=16,KMF=32,KMG=64,KMH=128,
- + KMI=256, KMJ=512, KMK=KM11, KML=KM12, KMM=KM13, KMN=KM14,
- + KMO=KM15, KMP=KM16, KMQ=KM17, KMR=KM18, KMS=KM19)
- PARAMETER (NBANKS=19,JBKPAT=1, JBKDEC=2, JBKORG=3, JBKINC=4,
- + JBKHOL=5, JBKKEE=6, JBKACT=7, JBKMAT=8, JBKXSQ=9,
- + JBKPRE=10,JBKGAR=11,JBKSMH=12,JBKSMT=13,JBKSML=14,
- + JBKSMX=15,JBKARR=16,JBKASA=17,JBKPAM=18,JBKRPA=19)
- COMMON /QBANKS/MMBANK(5,NBANKS)
- CHARACTER CQDATEM*10, CQDATE*8, CQTIME*5
- COMMON /QSTATE/NQERR,NQWARN,NQINFO,NQLOCK
- +, IQDATE,IQTIME, CQDATEM,CQDATE,CQTIME
- PARAMETER (MCCNIL=1, MCCKIL=2, MCCINC=3, MCCCDE=4, MCCSEQ=5,
- + MCCXSQ=6, MCCTRU=7, MCCFAL=8, MCCELS=9, MCCEND=10,
- + MCCSEL=11, MCCSES=12, MCCFAU=13, MCCSKI=14,
- + MCCKEE=15, MCCDEL=16, MCCREP=17, MCCADB=18, MCCADD=19,
- + MCCUSE=20, MCCXDI=21, MCCDIV=22, MCCLIS=23, MCCEXE=24, MCCIMI=25,
- + MCCASM=26, MCCUPD=27, MCCNAM=28, MCCGAP=29, MCCMOR=30, MCCONL=31,
- + MCCFOR=32, MCCSUS=33, MCCOPT=34, MCCOP2=35, MCCSHO=36, MCCPAM=37,
- + MCCQUI=38, MCCEOD=39, MCCDEC=40, MCCPAT=41, MCCTIT=42)
- CHARACTER CCKORG*256, CCKARD*256, CCCOMF*256
- COMMON /CCPARA/NCHCCD,NCHCCT, JCCTYP,JCCLEV,JCCSL,MCCPAR(240)
- +, NCCPAR,MXCCIF,JCCIFV,JCCBAD,JCCWAR,ICCSUB,JCCWK(4)
- +, JCCPP,JCCPD,JCCPZ,JCCPT,JCCPIF,JCCPC,JCCPN
- +, NCCPP,NCCPD,NCCPZ,NCCPT,NCCPIF,NCCPC,NCCPN
- +, JCCEND, NCHCCC,IXCCC, CCKORG, CCKARD, CCCOMF
- PARAMETER (KQGARB=1,KQARRV=3,KQKEEP=4,KQPREP=5,KQMAIN=6,KQPAST=8)
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
- COMMON /MUSEBC/ MX_FORC, MU_GLOB, MU_PAT, MU_DECK, MU_INH, MU_FORG
- +, MX_TRAN, MX_FORG, MX_SINH, MX_SELF, NVEXDK(6)
- COMMON /M_ANAC/LOWAN,KDOAN,LDOAN,LUPAN,MODEAN,MEXAN,LEVAN,KKM5AN
- +, NEWDEC,NEWCTL,NEWFOR,NEWNIL,NEWINC
-C-------------- End CDE --------------------------------
-
- IAND (IZV,IZW) = AND (IZV, IZW)
- IOR (IZV,IZW) = OR (IZV, IZW)
- ISHFTL (IZW,NZB) = LSHIFT (IZW, NZB)
-
-
- MUPASV = MU_PAT
- MUDKSV = MU_DECK
- LEVSK = MCCSEL
- NONACT = 7
- LEVAN = 7
- LUPAN = 0
-
- LDOAN = KQPREP + 1
- GO TO 21
-
-C---------- Scan ordinary self-material ---------
-
-C-- MODEAN = 0 ordinary self 1 IF-conditional self
-C-- 2 +SELF,sname 3 +KEEP 4 +REPL,+ADB,+ADD
-
- 21 CALL M_A3NX
- IF (LDOAN.EQ.0) GO TO 61
- 22 IF (JCCTYP.LE.MCCNIL) GO TO 21
- IF (JCCTYP.EQ.MCCTIT) GO TO 43
- IF (JCCTYP.EQ.MCCXSQ) GO TO 37
-
- CALL M_KRAK (1)
-
- JACT = 0
- MODEAN = 0
- IF (JCCTYP.GE.MCCUSE) GO TO 51
- IF (JCCTYP.GE.MCCDEL) GO TO 71
-
- NONACT = 7
- IF (JCCTYP.EQ.MCCKEE) GO TO 73
- IF (JCCTYP.EQ.MCCSKI) GO TO 40
- IF (JCCTYP.GE.MCCSEL) GO TO 41
- IF (JCCTYP.LT.MCCTRU) GO TO 31
-
-C---------- Handle +_IF etc
-
- IF (JCCBAD.NE.0) GO TO 45
- IFSTEP = 1
- CALL M_A3IF (IFSTEP)
- IF (JCCBAD.NE.0) GO TO 45
- IF (IFSTEP.NE.0) GO TO 21
- IF (LDOAN.NE.0) GO TO 22
- GO TO 61
-
-C---------- Handle +CDE or +SEQ
-
-C-- check +CDE, T=DUMMY
-
- 31 IF (JCCBAD.NE.0) GO TO 21
- MEXAN = IOR (MEXAN,MXCCIF)
- IF (IAND(MCCPAR(JCCPT+1),KMD).NE.0) JCCIFV= 1
-
- CALL M_A3SQ
- GO TO 21
-
-C-- link all seqences for XSQ bank
-
- 37 MX = LINKSQ (LDOAN,0)
- MEXAN = IOR (MEXAN,MX)
- GO TO 21
-
-C---------- +SELF c/c seen
-
- 40 IF (MOPUPD.EQ.0) JCCIFV= 1 - JCCIFV
- 41 MEXAN = IOR (MEXAN,MXCCIF)
- IF (JCCBAD.NE.0) GO TO 45
- IF (JCCIFV.NE.0) GO TO 45
- IF (JCCTYP.NE.MCCSES) GO TO 21
-
-C-- handle +SELF, seqname
-
- MODEAN = 2
- CALL M_A3SQ
- IF (JCCBAD.NE.0) GO TO 45
- IF (IQUEST(1).EQ.0) GO TO 21
- GO TO 46
-
-C-- deleted material
-
- 43 JCCTYP = MCCPAT
- 44 LEVSK = JCCTYP
- 45 IQ(LDOAN) = IOR (IQ(LDOAN), KM5)
- 46 CALL M_A3NX
- IF (LDOAN.EQ.0) GO TO 61
- IF (JCCTYP.LT.LEVSK) THEN
- IQ(LDOAN) = IOR (IQ(LDOAN), KM6)
- GO TO 46
- ENDIF
- JCCBAD = 0
- LEVSK = MCCSEL
- GO TO 22
-
- 48 IF (JACT.NE.1) GO TO 45
- 49 IQ(LDOAN) = IOR (IQ(LDOAN), KM5)
- GO TO 21
-
-C---------- Control lines +USE etc
-
- 51 NONACT = 7
- IF (JCCTYP.GE.MCCDEC) GO TO 56
- IF (JCCBAD.NE.0) GO TO 21
- IF (JCCTYP.GE.MCCASM) GO TO 52
- IF (JCCTYP.GT.MCCEXE) GO TO 53
- IF (JCCIFV.NE.0) GO TO 49
- CALL X_USE
- GO TO 21
-
-C-- c/l allowed only in the cradle
-
- 52 IF (JCCTYP.EQ.MCCEOD) GO TO 49
- IF (JCCTYP.EQ.MCCONL) GO TO 91
- IF (LEXD.NE.LDCRAB) THEN
- IF (JCCTYP.LE.MCCONL) GO TO 94
- IF (INCRAD.EQ.0) GO TO 94
- ENDIF
-
- IF (JCCTYP.GE.MCCPAM) GO TO 49
- 53 IF (JCCIFV.NE.0) GO TO 49
- NEWCTL = 7
- GO TO 21
-
-C---------- Control lines +DECK or +PATCH
-
- 56 IF (JCCBAD.NE.0) GO TO 44
- MEXAN = IOR (MEXAN,MXCCIF)
- LEVAN = 7
- NEWDEC = NEWDEC + 1
- IF (JCCIFV.NE.0) GO TO 44
-
- CALL CCDOPT (1, JASM)
- IF (NDSLAT.NE.0) THEN
- CALL M_FAIL ('Multiple data type')
- GO TO 44
- ENDIF
-
- CALL SBYT (JASM,IQ(LDOAN),21,6)
- GO TO 21
-
-C---------- End of processing
-
- 61 JANSW = 0
- MEXAN = IAND (MEXAN,15)
- IF (MEXAN.NE.0) CALL MXOPER (MEXAN)
-
- IF (NQERR.NE.0) THEN
- NVEXDK(1) = 0
- NVEXDK(5) = NVEXDK(2)
- ENDIF
-
- IF (NEWCTL+NEWFOR+NVEXDK(5).EQ.0) RETURN
-
- JANSW = 1
- IF (INCRAD.LT.2) RETURN
-
- CALL SBYT (MUPASV, IQ(LEXP),1,18)
- IF (LEXD.NE.0) CALL SBYT (MUDKSV, IQ(LEXD),1,18)
- CALL X_UDECK (0)
- RETURN
-
-C---------- New foreign material being defined ---------
-
-C- JACT = 0 KEEP 1 DEL 2 REPL 3 ADB 4 ADD
-
- 71 IF (JCCBAD.NE.0) GO TO 45
- JACT = JCCTYP - MCCKEE
- MODEAN = 4
- IQ(LDOAN) = IOR (IQ(LDOAN), MXCCIF)
-
- IF (NONACT.NE.0) THEN
- NVIMAT(1) = 0
- LASTDK = 0
- NONACT = 0
- ENDIF
-
- CALL CREACT
- IF (LCRD.EQ.0) GO TO 95
-
- IF (LCRD.EQ.LASTDK) IQ(LDOAN)= IOR (IQ(LDOAN),KM18)
- LQ(LDOAN-3) = LCRD
- LASTDK = LCRD
-
-C---- Create NIL action
-
- IF (JCCIFV.NE.0) THEN
- IF (IAND(MXCCIF,NOT(IQ(LCRD))).EQ.0) GO TO 48
- IQ(LDOAN) = IOR (IQ(LDOAN), KM8)
- NEWFOR = NEWFOR + 1
- GO TO 48
- ENDIF
-
-C---- Accepted action
-
-C- JACT = 0 KEEP 1 DEL 2 REPL 3 ADB 4 ADD
-
- NEWFOR = NEWFOR + 1
- IF (JACT.EQ.1) GO TO 21
- CALL M_A3AC
- IF (LDOAN.EQ.0) GO TO 61
- IF (JCCBAD.NE.0) GO TO 45
- GO TO 22
-
-C------ +KEEP definition
-
- 73 IF (JCCBAD.NE.0) GO TO 45
- MODEAN = 3
- IF (IAND(MCCPAR(JCCPT+1),KMD).NE.0) GO TO 45
- IQ(LDOAN) = IOR (IQ(LDOAN), MXCCIF)
-
-C-- check sequence existing
-
- CALL LOCKEEP (LACT)
- KACT = IQUEST(1)
-
-C-- T=APPEND?
- IF (LACT.NE.0) THEN
- IF (IAND(MCCPAR(JCCPT+1),KMA).EQ.0) GO TO 45
- IF (IAND(IQ(LACT+1),KM19).NE.0) GO TO 45
- IF (JCCIFV.NE.0) GO TO 45
-
- IQ(LACT+1) = IOR (IQ(LACT+1),KM19)
- LQ(LDOAN-3) = -LACT
- NEWFOR = NEWFOR + 1
- GO TO 76
- ENDIF
-
-C---- Create NIL sequence if IF deselected
-
- IFLNIL = 0
- IF (JCCIFV.EQ.0) GO TO 74
- IF (IAND(MXCCIF,NOT(MU_GLOB)).EQ.0) GO TO 45
-
- LPD = IQUEST(11)
- IF (LPD.NE.0) THEN
- IF (IAND(MXCCIF,NOT(IQ(LPD))).EQ.0) GO TO 45
- ENDIF
-
- IQ(LDOAN) = IOR (IQ(LDOAN), KM8)
- IFLNIL = KM12
-
-C---- Accepted sequence definition
-
- 74 NEWFOR = NEWFOR + 1
- IFLNOL = ISHFTL (IAND(MCCPAR(JCCPT+1),KMN),2)
- IXS = MCCPAR(JCCPZ+1)
-
-C-- we have to create the KEEP bank now to over-rule
-C- possible future re-definitions in the same deck
-
- CALL MQLIFT (LACT,KACT,0,JBKKEE,1)
-
- IQ(LACT) = IOR (IQ(LACT), IFLNIL+IFLNOL)
- IQ(LACT+4) = IXS
-
- LQ(LDOAN-3) = LACT
-
- IF (IFLNIL.NE.0) GO TO 45
- 76 CALL M_A3KE
- IF (LDOAN.EQ.0) GO TO 61
- IF (JCCBAD.NE.0) GO TO 45
- GO TO 22
-
-C----- Trouble
-
- 91 CALL FAILCC (0, 'Obsolete feature not implemented')
- GO TO 49
-
- 94 CALL FAILCC (0, 'Control line not allowed here')
- GO TO 49
-
- 95 CALL M_FAIL ('Implied target deck for action not defined')
- GO TO 48
- END
diff --git a/src/p5boot/p5lib/m_fail.f b/src/p5boot/p5lib/m_fail.f
deleted file mode 100644
index 98a5a8b..0000000
--- a/src/p5boot/p5lib/m_fail.f
+++ /dev/null
@@ -1,53 +0,0 @@
-CDECK ID>, M_FAIL.
- SUBROUTINE M_FAIL (MSG)
-
-C- Faulty control found with M_ANA3:
-C- print the line, change c/c type to FAULTY, set JCCBAD
-C. started 29-nov-93
-
- PARAMETER (KM1=1,KM2=2,KM3=4,KM4=8,KM5=16,KM6=32,KM7=64,KM8=128,
- + KM9=256, KM10=512, KM11=1024, KM12=2048, KM13=4096, KM14=8192,
- + KM15=16384, KM16=32768, KM17=65536, KM18=131072, KM19=262144)
- PARAMETER (MCCNIL=1, MCCKIL=2, MCCINC=3, MCCCDE=4, MCCSEQ=5,
- + MCCXSQ=6, MCCTRU=7, MCCFAL=8, MCCELS=9, MCCEND=10,
- + MCCSEL=11, MCCSES=12, MCCFAU=13, MCCSKI=14,
- + MCCKEE=15, MCCDEL=16, MCCREP=17, MCCADB=18, MCCADD=19,
- + MCCUSE=20, MCCXDI=21, MCCDIV=22, MCCLIS=23, MCCEXE=24, MCCIMI=25,
- + MCCASM=26, MCCUPD=27, MCCNAM=28, MCCGAP=29, MCCMOR=30, MCCONL=31,
- + MCCFOR=32, MCCSUS=33, MCCOPT=34, MCCOP2=35, MCCSHO=36, MCCPAM=37,
- + MCCQUI=38, MCCEOD=39, MCCDEC=40, MCCPAT=41, MCCTIT=42)
- CHARACTER CCKORG*256, CCKARD*256, CCCOMF*256
- COMMON /CCPARA/NCHCCD,NCHCCT, JCCTYP,JCCLEV,JCCSL,MCCPAR(240)
- +, NCCPAR,MXCCIF,JCCIFV,JCCBAD,JCCWAR,ICCSUB,JCCWK(4)
- +, JCCPP,JCCPD,JCCPZ,JCCPT,JCCPIF,JCCPC,JCCPN
- +, NCCPP,NCCPD,NCCPZ,NCCPT,NCCPIF,NCCPC,NCCPN
- +, JCCEND, NCHCCC,IXCCC, CCKORG, CCKARD, CCCOMF
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
- COMMON /M_ANAC/LOWAN,KDOAN,LDOAN,LUPAN,MODEAN,MEXAN,LEVAN,KKM5AN
- +, NEWDEC,NEWCTL,NEWFOR,NEWNIL,NEWINC
-C-------------- End CDE --------------------------------
- CHARACTER MSG*(*)
-
- IOR (IZV,IZW) = OR (IZV, IZW)
-
-
- CALL FAILCC (1,MSG)
-
- CALL SBYT (MCCFAU, IQ(LDOAN),9,6)
- IQ(LDOAN) = IOR (IQ(LDOAN),KM5)
- JCCBAD = 7
- RETURN
- END
diff --git a/src/p5boot/p5lib/m_head.f b/src/p5boot/p5lib/m_head.f
deleted file mode 100644
index f418753..0000000
--- a/src/p5boot/p5lib/m_head.f
+++ /dev/null
@@ -1,125 +0,0 @@
-CDECK ID>, M_HEAD.
- SUBROUTINE M_HEAD
-
-C- Content analysis between stages 2 and 3:
-C- check patch/deck is accepted or not,
-C- evaluate data type,
-C- return JANSW = -1 skip patch, 0 skip deck, 1 process
-C. started 11-july-94
-
- PARAMETER (KM1=1,KM2=2,KM3=4,KM4=8,KM5=16,KM6=32,KM7=64,KM8=128,
- + KM9=256, KM10=512, KM11=1024, KM12=2048, KM13=4096, KM14=8192,
- + KM15=16384, KM16=32768, KM17=65536, KM18=131072, KM19=262144)
- COMMON /QPAGE/ NQLMAX,NQLTOL,NQLTOK,NQCMAX,NQCPGH,NQPAGE
- +, NQWYLDO,NQWYL,NQNEWH,NQJOIN,NQDKNO,NQDKPG
- PARAMETER (MCCNIL=1, MCCKIL=2, MCCINC=3, MCCCDE=4, MCCSEQ=5,
- + MCCXSQ=6, MCCTRU=7, MCCFAL=8, MCCELS=9, MCCEND=10,
- + MCCSEL=11, MCCSES=12, MCCFAU=13, MCCSKI=14,
- + MCCKEE=15, MCCDEL=16, MCCREP=17, MCCADB=18, MCCADD=19,
- + MCCUSE=20, MCCXDI=21, MCCDIV=22, MCCLIS=23, MCCEXE=24, MCCIMI=25,
- + MCCASM=26, MCCUPD=27, MCCNAM=28, MCCGAP=29, MCCMOR=30, MCCONL=31,
- + MCCFOR=32, MCCSUS=33, MCCOPT=34, MCCOP2=35, MCCSHO=36, MCCPAM=37,
- + MCCQUI=38, MCCEOD=39, MCCDEC=40, MCCPAT=41, MCCTIT=42)
- CHARACTER CCKORG*256, CCKARD*256, CCCOMF*256
- COMMON /CCPARA/NCHCCD,NCHCCT, JCCTYP,JCCLEV,JCCSL,MCCPAR(240)
- +, NCCPAR,MXCCIF,JCCIFV,JCCBAD,JCCWAR,ICCSUB,JCCWK(4)
- +, JCCPP,JCCPD,JCCPZ,JCCPT,JCCPIF,JCCPC,JCCPN
- +, NCCPP,NCCPD,NCCPZ,NCCPT,NCCPIF,NCCPC,NCCPN
- +, JCCEND, NCHCCC,IXCCC, CCKORG, CCKARD, CCCOMF
- COMMON /DEPCOM/JD_NEW, JD_DTN, JD_DTP, JD_DTD, JD_DIV
- +, JD_SML, JD_SMP, JD_SMX, JDP_DT, JDP_DV
- +, JD_SPL, JD_MOD, JD_LUN, JD_LOG, JD_NLI, JD_MULT
- +, IX_EXT, IX_RH, IX_SUB
- PARAMETER (KQGARB=1,KQARRV=3,KQKEEP=4,KQPREP=5,KQMAIN=6,KQPAST=8)
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
- COMMON /MUSEBC/ MX_FORC, MU_GLOB, MU_PAT, MU_DECK, MU_INH, MU_FORG
- +, MX_TRAN, MX_FORG, MX_SINH, MX_SELF, NVEXDK(6)
- COMMON /M_ANAC/LOWAN,KDOAN,LDOAN,LUPAN,MODEAN,MEXAN,LEVAN,KKM5AN
- +, NEWDEC,NEWCTL,NEWFOR,NEWNIL,NEWINC
-C-------------- End CDE --------------------------------
-
- IAND (IZV,IZW) = AND (IZV, IZW)
- IOR (IZV,IZW) = OR (IZV, IZW)
-
-
- JCCIFV = 0
- IFREP = 0
-
- JANSW = 1
- LUPAN = 0
- LDOAN = KQPREP + 1
-
- CALL M_A3NX
- IF (LDOAN.EQ.0) GO TO 24
- IF (JCCTYP.LT.MCCDEC) GO TO 24
- IF (JCCTYP.GT.MCCPAT) GO TO 24
-
- CALL CCKRAK (IQ(LDOAN+1))
- IF (JCCBAD.NE.0) THEN
- CALL M_FAIL ('Syntax error')
- ELSE
- IF (NCCPIF.NE.0) CALL CCPROC
- ENDIF
-
- IF (NCCPT.NE.0) THEN
- CALL CCDOPT (1, JD_DTN)
- IF (NQJOIN.GE.0) NQJOIN = IAND (MCCPAR(JCCPT+2),2)
- IFREP = IAND (MCCPAR(JCCPT+2),1)
- ELSE
- JD_DTN = 0
- NQJOIN = MIN(NQJOIN,0)
- ENDIF
-
-C-- line is +DECK, name, T=type, IF=...
-
- IF (JCCTYP.NE.MCCDEC) GO TO 31
- JDKTYP = 1
- IF (JD_DTN.EQ.0) JD_DTN= JD_DTP
- IF (JCCIFV.NE.0) GO TO 49
- GO TO 47
-
-C-- not a c/line to be looked at (mainly update mode)
-
- 24 JD_DTN = JD_DTP
- IF (JDKTYP.EQ.1) GO TO 47
- GO TO 34
-
-C-- line is +PATCH, name, T=type, IF=...
-
- 31 JD_DTN = MAX (JD_DTN,1)
- JD_DTP = JD_DTN
- IF (JDKTYP.EQ.1) GO TO 44
-
- IF (IFREP.NE.0) IQ(LEXP+1)= IOR (IQ(LEXP+1),KM5)
-
- 34 IF (IAND(MU_PAT,KM10).EQ.0) GO TO 39
- IF (JCCIFV.NE.0) GO TO 38
- IF (IAND(IQ(LEXP+1),KM4).NE.0) GO TO 47
- IF (IAND(MU_PAT,KM5).EQ.0) GO TO 39
- GO TO 47
-
- 38 IQ(LEXP+1) = IOR(IQ(LEXP+1),KM1)
- 39 JANSW = -1
- RETURN
-
-C-- but the original was +DECK, ...
-
- 44 IF (JCCIFV.NE.0) GO TO 49
-
- 47 IF (IAND(MU_DECK,KM5).NE.0) RETURN
- 49 JANSW = 0
- RETURN
- END
diff --git a/src/p5boot/p5lib/m_krak.f b/src/p5boot/p5lib/m_krak.f
deleted file mode 100644
index 8086567..0000000
--- a/src/p5boot/p5lib/m_krak.f
+++ /dev/null
@@ -1,57 +0,0 @@
-CDECK ID>, M_KRAK.
- SUBROUTINE M_KRAK (IFPROC)
-
-C- Crack control line at LDOAN for M_ANA3 and M_A3IF;
-C- do not/do the IF= evaluation if IFPROC = 0/1
-C- if faulty control found:
-C- change c/c type to FAULTY and print the line
-C. started 29-nov-93
-
- CHARACTER CCKORG*256, CCKARD*256, CCCOMF*256
- COMMON /CCPARA/NCHCCD,NCHCCT, JCCTYP,JCCLEV,JCCSL,MCCPAR(240)
- +, NCCPAR,MXCCIF,JCCIFV,JCCBAD,JCCWAR,ICCSUB,JCCWK(4)
- +, JCCPP,JCCPD,JCCPZ,JCCPT,JCCPIF,JCCPC,JCCPN
- +, NCCPP,NCCPD,NCCPZ,NCCPT,NCCPIF,NCCPC,NCCPN
- +, JCCEND, NCHCCC,IXCCC, CCKORG, CCKARD, CCCOMF
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
- COMMON /M_ANAC/LOWAN,KDOAN,LDOAN,LUPAN,MODEAN,MEXAN,LEVAN,KKM5AN
- +, NEWDEC,NEWCTL,NEWFOR,NEWNIL,NEWINC
-C-------------- End CDE --------------------------------
-
-
- CALL CCKRAK (IQ(LDOAN+1))
- IF (JCCBAD.NE.0) GO TO 41
- IF (IFPROC.NE.0) THEN
- IF (NCCPIF.NE.0) CALL CCPROC
- ENDIF
- IF (JCCWAR.EQ.0) RETURN
-
-C: DATA CHWA( 1) /'obsured dot in control line'/
-C: DATA CHWA( 2) /'control line ends on comma'/
-
- IF (JCCWAR.EQ.1) THEN
- IF (MOPTIO(2).NE.0) RETURN
- CALL FAILCC (0, 'obsured dot in control line')
- ELSE
- CALL FAILCC (0, 'control line ends on comma')
- ENDIF
- RETURN
-
-C-- faulty c/line
-
- 41 CALL M_FAIL ('Syntax error')
- RETURN
- END
diff --git a/src/p5boot/p5lib/m_split.f b/src/p5boot/p5lib/m_split.f
deleted file mode 100644
index 5ea9e02..0000000
--- a/src/p5boot/p5lib/m_split.f
+++ /dev/null
@@ -1,66 +0,0 @@
-CDECK ID>, M_SPLIT.
- FUNCTION M_SPLIT (LDO,JSLN)
-
-C- Split PREP bank in division 2 into two:
-
-C- if JSLN not zero: scan the linear structure of PREP banks
-C- starting at LDO to find the bank which supports the line
-C- at slot JSLN; if this is not the first line split this
-C- bank into two to make JSLN the first line in the new bank;
-C- return the adr of the bank with JSLN, or zero if not found.
-
-C- if JSLN is zero: split the bank at LDO leaving zero lines
-C- in the old bank, transfer the properties of the old to the
-C- new bank; return the adr of the new bank.
-C# started 11-nov-91
-
- PARAMETER (KM1=1,KM2=2,KM3=4,KM4=8,KM5=16,KM6=32,KM7=64,KM8=128,
- + KM9=256, KM10=512, KM11=1024, KM12=2048, KM13=4096, KM14=8192,
- + KM15=16384, KM16=32768, KM17=65536, KM18=131072, KM19=262144)
- PARAMETER (NBANKS=19,JBKPAT=1, JBKDEC=2, JBKORG=3, JBKINC=4,
- + JBKHOL=5, JBKKEE=6, JBKACT=7, JBKMAT=8, JBKXSQ=9,
- + JBKPRE=10,JBKGAR=11,JBKSMH=12,JBKSMT=13,JBKSML=14,
- + JBKSMX=15,JBKARR=16,JBKASA=17,JBKPAM=18,JBKRPA=19)
- COMMON /QBANKS/MMBANK(5,NBANKS)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ)
- EQUIVALENCE (LQ,IQ,LQGARB)
- COMMON // IQUEST(100),LQGARB
-C-------------- End CDE --------------------------------
-
-
- L = LDO
- IF (JSLN.EQ.0) GO TO 41
- GO TO 22
-
- 21 L = LQ(L-1)
- IF (L.EQ.0) GO TO 49
- 22 JSLA = IQ(L+1)
- JSLE = IQ(L+2) + JSLA
- IF (JSLN.GE.JSLE) GO TO 21
- IF (JSLN.EQ.JSLA) GO TO 49
- IF (JSLN.LT.JSLA) CALL P_CRASH ('trouble in M_SPLIT')
- NSLA = JSLN - JSLA
- NSLN = JSLE - JSLN
-
- CALL MQLIFT (LX,L,-1,JBKPRE,2)
- IQ(L+2) = NSLA
- L = LX
- IQ(L+1) = JSLN
- IQ(L+2) = NSLN
- GO TO 49
-
-C-- split on first line with transfer of properties
-C- (to insert a zero-line PREP reference to ACT for +REPL etc)
-
- 41 CALL MQLIFT (LX,L,-1,JBKPRE,2)
-
- IQ(LX) = IQ(L)
- IQ(LX+1) = IQ(L+1)
- IQ(LX+2) = IQ(L+2)
- IQ(L+2) = 0
- L = LX
-
- 49 M_SPLIT = L
- RETURN
- END
diff --git a/src/p5boot/p5lib/m_wnif.f b/src/p5boot/p5lib/m_wnif.f
deleted file mode 100644
index 57d1278..0000000
--- a/src/p5boot/p5lib/m_wnif.f
+++ /dev/null
@@ -1,27 +0,0 @@
-CDECK ID>, M_WNIF.
- SUBROUTINE M_WNIF (NU)
-
-C- Print warning for wrong number of underscores
-C. started 9-dec-91
-
- CHARACTER MSG*22
- DATA MSG /' 0 underscore too many'/
-C- DATA MSG /' 0 underscore missing '/
-C- _:.=+=.: 1_:.=+=.: 2_:.=
-
-
- CALL DPHEAD
-
- N = NU
- IF (N.LT.0) THEN
- N = -N
- MSG(15:22) = 'missing '
- ELSE
- MSG(15:22) = 'too many'
- ENDIF
-
- MSG(1:2) = ' '
- CALL CSETDI (N,MSG,1,2)
-
- CALL FAILCC (0,MSG)
- END
diff --git a/src/p5boot/p5lib/meload.f b/src/p5boot/p5lib/meload.f
deleted file mode 100644
index 4183978..0000000
--- a/src/p5boot/p5lib/meload.f
+++ /dev/null
@@ -1,73 +0,0 @@
-CDECK ID>, MELOAD.
- SUBROUTINE MELOAD
-
-C- Load the "merge" file
-C. started 11-july-95
-
- PARAMETER (NBANKS=19,JBKPAT=1, JBKDEC=2, JBKORG=3, JBKINC=4,
- + JBKHOL=5, JBKKEE=6, JBKACT=7, JBKMAT=8, JBKXSQ=9,
- + JBKPRE=10,JBKGAR=11,JBKSMH=12,JBKSMT=13,JBKSML=14,
- + JBKSMX=15,JBKARR=16,JBKASA=17,JBKPAM=18,JBKRPA=19)
- COMMON /QBANKS/MMBANK(5,NBANKS)
- COMMON /LUNSLN/IFLAUX, IXLUN(12)
- COMMON /MQCM/ NQSYSS,NQLINK, LQCSTA(3),LQCEND(3), NQMAX
- +, LQLSTA(5),LQLEND(5), LQADR,LQADR0,NQOFFS
- PARAMETER (KQUSER=9)
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
-C-------------- End CDE --------------------------------
-
-
- IF (IXLUN(1).EQ.0) RETURN
- CALL INIPAM (11,IXLUN(1),1,0)
- CALL ARRIVE (1)
- IF (JDKTYP.GE.4) GO TO 49
-
- LDECK = KQUSER + 1
- NSLCUM = 0
-
- 21 IF (JDKNEX.EQ.0) CALL ARRIVE (2)
-
- JSLF = IQ(LQHOLD+1)
- NSLF = IQ(LQHOLD+3)
- IF (NSLCUM.EQ.0) JSLFIR= JSLF
-
- CALL MQLIFT (LDECK, LDECK,-1, JBKDEC,1)
- IQ(LDECK+1) = JSLF
- IQ(LDECK+2) = NSLF
- IQ(LDECK+3) = JDKTYP
- NSLCUM = NSLCUM + NSLF
-
-C-- step to the next deck
-
- CALL ARRNXD (1)
- IF (JDKTYP.LE.3) GO TO 21
-
- IF (JSLFIR+NSLCUM.NE.LQLEND(2)) GO TO 91
-
-C-- reset division 1 to cover the "merge" material
-
- LQLEND(1) = LQLEND(2)
- LQLSTA(2) = LQLEND(2)
-
-C-- close the input file
-
- 49 CALL INIPAM (0,0,-1,0)
- RETURN
-
-C----- trouble, file too big
-
- 91 CALL P_KILL ('MERGE file too big.')
- END
diff --git a/src/p5boot/p5lib/mesend.f b/src/p5boot/p5lib/mesend.f
deleted file mode 100644
index f864c66..0000000
--- a/src/p5boot/p5lib/mesend.f
+++ /dev/null
@@ -1,33 +0,0 @@
-CDECK ID>, MESEND.
- SUBROUTINE MESEND (JSLX,NSLX)
-
-C- Send the NSLX lines at JSLX to output
-C. started 11-july-95
-
- COMMON /DEPCOM/JD_NEW, JD_DTN, JD_DTP, JD_DTD, JD_DIV
- +, JD_SML, JD_SMP, JD_SMX, JDP_DT, JDP_DV
- +, JD_SPL, JD_MOD, JD_LUN, JD_LOG, JD_NLI, JD_MULT
- +, IX_EXT, IX_RH, IX_SUB
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
-C-------------- End CDE --------------------------------
-
-
- 32 JTX = MLIAD(JSLX)
- NTX = MLIAD(JSLX+NSLX) - JTX
- CALL CIPUT (JD_LUN,TEXT(JTX),NTX,ISTAT)
- IF (ISTAT.NE.0) CALL P_KILLM ('CIO write fails')
- RETURN
- END
diff --git a/src/p5boot/p5lib/metitl.f b/src/p5boot/p5lib/metitl.f
deleted file mode 100644
index cbffa3d..0000000
--- a/src/p5boot/p5lib/metitl.f
+++ /dev/null
@@ -1,178 +0,0 @@
-CDECK ID>, METITL.
- SUBROUTINE METITL (JSLF,NSLF)
-
-C- Run nymerge
-C. started 11-july-95
-
- COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT,NUSLAT(2),DUMMY(34)
- CHARACTER SLLINE*512, SLERRM*256
- COMMON /SLATLN/ SLLINE, SLERRM
- CHARACTER CQDATEM*10, CQDATE*8, CQTIME*5
- COMMON /QSTATE/NQERR,NQWARN,NQINFO,NQLOCK
- +, IQDATE,IQTIME, CQDATEM,CQDATE,CQTIME
- COMMON /QPAGE/ NQLMAX,NQLTOL,NQLTOK,NQCMAX,NQCPGH,NQPAGE
- +, NQWYLDO,NQWYL,NQNEWH,NQJOIN,NQDKNO,NQDKPG
- COMMON /QUNIT/ IQREAD,IQPRNT, IQTTIN,IQTYPE, IQOFFL,IQRTTY,IQRSAV
- +, IQRFD,IQRRD,IQRSIZ, NQLPAT,NQUSED,NQLLBL, NQINIT
- CHARACTER CCKORG*256, CCKARD*256, CCCOMF*256
- COMMON /CCPARA/NCHCCD,NCHCCT, JCCTYP,JCCLEV,JCCSL,MCCPAR(240)
- +, NCCPAR,MXCCIF,JCCIFV,JCCBAD,JCCWAR,ICCSUB,JCCWK(4)
- +, JCCPP,JCCPD,JCCPZ,JCCPT,JCCPIF,JCCPC,JCCPN
- +, NCCPP,NCCPD,NCCPZ,NCCPT,NCCPIF,NCCPC,NCCPN
- +, JCCEND, NCHCCC,IXCCC, CCKORG, CCKARD, CCCOMF
- PARAMETER (MCCNIL=1, MCCKIL=2, MCCINC=3, MCCCDE=4, MCCSEQ=5,
- + MCCXSQ=6, MCCTRU=7, MCCFAL=8, MCCELS=9, MCCEND=10,
- + MCCSEL=11, MCCSES=12, MCCFAU=13, MCCSKI=14,
- + MCCKEE=15, MCCDEL=16, MCCREP=17, MCCADB=18, MCCADD=19,
- + MCCUSE=20, MCCXDI=21, MCCDIV=22, MCCLIS=23, MCCEXE=24, MCCIMI=25,
- + MCCASM=26, MCCUPD=27, MCCNAM=28, MCCGAP=29, MCCMOR=30, MCCONL=31,
- + MCCFOR=32, MCCSUS=33, MCCOPT=34, MCCOP2=35, MCCSHO=36, MCCPAM=37,
- + MCCQUI=38, MCCEOD=39, MCCDEC=40, MCCPAT=41, MCCTIT=42)
- CHARACTER CHTTNA*10, CHTTDT*20
- COMMON /USETTC/ JTTNAM,JTTVER,JTTSLA,JTTDAT,JTTCOM
- +, NTTNA(5), NTTDT, NTTNORM, NTTALL
- +, CHTTNA(5), CHTTDT
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
-C-------------- End CDE --------------------------------
- CHARACTER LINE*128, LTEXT*128
- EQUIVALENCE (LTEXT,TEXT)
-
-
- JSL = JSLF
- NSL = NSLF
- CALL LN_GET (JSL,LINE,128)
- NL = NDSLAT
-
-C-- copy +TITLE. to output
-
- JCCTYP = JPTYPE (LINE)
- IF (JCCTYP.NE.MCCTIT) GO TO 31
-
- N = MIN (NL,12)
- JC = ICFIND (':', LINE,1,N)
- IF (JC.NE.NL) THEN
- IF (JC.LE.N) GO TO 31
- ENDIF
-
- IF (NSL.EQ.1) RETURN
- CALL MESEND (JSL,1)
- JSL = JSL + 1
- NSL = NSL - 1
- CALL LN_GET (JSL,LINE,128)
- NL = NDSLAT
-
-C-- analyse true title line
-
- 31 CALL USETT (JSL)
- JAOLD = JTTNAM
- JEOLD = NL
-
- IF (MOPTIO(21).NE.0) GO TO 34
- IF (LINE(1:2).NE.'C ') GO TO 48
- LTEXT = LINE(JTTNAM:NL)
- NCHTX = NL+1 - JTTNAM
- NCHTX = NCHTX + 1
- TEXT(NCHTX) = CHAR (NEWLN)
- MLIAD(2) = NCHTX + 1
- CALL DPBLAN (0)
- WRITE (IQPRNT,9048) NQDKNO, ' . ', LINE(JAOLD:JEOLD)
- GO TO 46
-
-C---- title line update
-
- 34 IF (MOPTIO(6).NE.0) MOPTIO(21) = 0
- JTK = 1
- IF (LINE(1:2).EQ.'C ') JTK=JTTNAM
-
-C-- secondary version update
-
- IF (MOPTIO(13).NE.0) GO TO 36
- IF (JTTSLA.EQ.0) GO TO 36
- LTEXT = LINE (JTK:JTTSLA)
- NCHTX = JTTSLA+1 - JTK
-
- N = ICDECI (LINE,JTTSLA+1,JTTSLA+6) + 1
- CALL CSETDI (N, LTEXT,NCHTX+1,NCHTX+6)
- CALL CLEFT (LTEXT,NCHTX+1,NCHTX+6)
- NCHTX = NESLAT + 1
- GO TO 39
-
-C-- primary version update
-
- 36 IF (JTTVER.EQ.0) GO TO 38
- JA = ICNEXT (LINE,JTTVER,NL)
- JE = NESLAT
- JD = ICFIND ('.', LINE,JA,JE)
- IF (NGSLAT.EQ.0) JD= JA-1
- N = ICDECI (LINE,JD+1,JE) + 1
- NDIG = NDSLAT
-
- LTEXT = LINE (JTK:JE)
- NCHTX = JE - JTK
- JD = JD+1 - JTK
- IF (NDIG.NE.0) CALL CSETDI (N, LTEXT,JD+1,NCHTX)
- NCHTX = NCHTX + 2
- GO TO 39
-
-C-- no version number present
-
- 38 LTEXT = LINE(JTK:NL) // ' /1'
- NCHTX = NL+8 - JTK
-
-C-- update date/time
-
- 39 LTEXT(NCHTX+1:NCHTX+16) = CQDATEM // ' ' // CQTIME
- NCHTX = NCHTX + 16
-
-C-- add the free comment
-
- IF (JTTCOM.NE.0) THEN
- NCHTX = MAX (NCHTX+2,JTTCOM-1)
- N = NL+1 - JTTCOM
- LTEXT(NCHTX+1:NCHTX+N) = LINE(JTTCOM:JTTCOM+N-1)
- NCHTX = NCHTX + N
- ENDIF
- NCHPR = NCHTX
- NCHTX = NCHTX + 1
- TEXT(NCHTX) = CHAR (NEWLN)
- MLIAD(2) = NCHTX + 1
-
-C---- new title line complete
-
- CALL USETT (1)
-
- CALL DPBLAN (0)
- WRITE (IQPRNT,9045) NQDKNO, ' + ', LTEXT(JTTNAM:NCHPR)
- WRITE (IQPRNT,9046) ' - ', LINE(JAOLD:JEOLD)
- 9045 FORMAT (4X,I6,A,A)
- 9046 FORMAT (10X,A,A/)
-
- 46 CALL MESEND (1,1)
-
- JSL = JSL + 1
- NSL = NSL - 1
- IF (NSL.EQ.0) RETURN
- GO TO 49
-
-C-- title unchanged
-
- 48 CALL DPBLAN (0)
- WRITE (IQPRNT,9048) NQDKNO, ' . ', LINE(JAOLD:JEOLD)
- 9048 FORMAT (4X,I6,A,A/)
-
- 49 CALL MESEND (JSL,NSL)
- RETURN
- END
diff --git a/src/p5boot/p5lib/mk_fnx.f b/src/p5boot/p5lib/mk_fnx.f
deleted file mode 100644
index 8d7150a..0000000
--- a/src/p5boot/p5lib/mk_fnx.f
+++ /dev/null
@@ -1,103 +0,0 @@
-CDECK ID>, MK_FNX.
- SUBROUTINE MK_FNX
-
-C- Step to next PREP / MAT bank for DOFORG
-C. started 1-dec-91
-
- PARAMETER (KM1=1,KM2=2,KM3=4,KM4=8,KM5=16,KM6=32,KM7=64,KM8=128,
- + KM9=256, KM10=512, KM11=1024, KM12=2048, KM13=4096, KM14=8192,
- + KM15=16384, KM16=32768, KM17=65536, KM18=131072, KM19=262144)
- PARAMETER (MCCNIL=1, MCCKIL=2, MCCINC=3, MCCCDE=4, MCCSEQ=5,
- + MCCXSQ=6, MCCTRU=7, MCCFAL=8, MCCELS=9, MCCEND=10,
- + MCCSEL=11, MCCSES=12, MCCFAU=13, MCCSKI=14,
- + MCCKEE=15, MCCDEL=16, MCCREP=17, MCCADB=18, MCCADD=19,
- + MCCUSE=20, MCCXDI=21, MCCDIV=22, MCCLIS=23, MCCEXE=24, MCCIMI=25,
- + MCCASM=26, MCCUPD=27, MCCNAM=28, MCCGAP=29, MCCMOR=30, MCCONL=31,
- + MCCFOR=32, MCCSUS=33, MCCOPT=34, MCCOP2=35, MCCSHO=36, MCCPAM=37,
- + MCCQUI=38, MCCEOD=39, MCCDEC=40, MCCPAT=41, MCCTIT=42)
- CHARACTER CCKORG*256, CCKARD*256, CCCOMF*256
- COMMON /CCPARA/NCHCCD,NCHCCT, JCCTYP,JCCLEV,JCCSL,MCCPAR(240)
- +, NCCPAR,MXCCIF,JCCIFV,JCCBAD,JCCWAR,ICCSUB,JCCWK(4)
- +, JCCPP,JCCPD,JCCPZ,JCCPT,JCCPIF,JCCPC,JCCPN
- +, NCCPP,NCCPD,NCCPZ,NCCPT,NCCPIF,NCCPC,NCCPN
- +, JCCEND, NCHCCC,IXCCC, CCKORG, CCKARD, CCCOMF
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- COMMON /MUSEBC/ MX_FORC, MU_GLOB, MU_PAT, MU_DECK, MU_INH, MU_FORG
- +, MX_TRAN, MX_FORG, MX_SINH, MX_SELF, NVEXDK(6)
- COMMON /M_ANAC/LOWAN,KDOAN,LDOAN,LUPAN,MODEAN,MEXAN,LEVAN,KKM5AN
- +, NEWDEC,NEWCTL,NEWFOR,NEWNIL,NEWINC
-C-------------- End CDE --------------------------------
-
- IAND (IZV,IZW) = AND (IZV, IZW)
- IOR (IZV,IZW) = OR (IZV, IZW)
-
-
- MEXSUS = 0
- IFLNEW = 0
- 21 IF (LUPAN.NE.0) GO TO 34
- 22 KDOAN = LDOAN - 1
- LDOAN = LQ(KDOAN)
- IF (LDOAN.EQ.0) GO TO 29
-
- L = LQ(LDOAN-2)
- IF (L.NE.0) GO TO 31
-
- 24 JCCTYP = JBYT (IQ(LDOAN),9,6)
- IF (IAND(IQ(LDOAN),KM5+KM6).EQ.0) GO TO 28
-
-C-- deleted PREP/MAT bank
-
- IF (JCCTYP.GE.MCCSEL) THEN
- IFLNEW= 7
- IF (IAND(IQ(LDOAN),KM6+KM7).EQ.0) GO TO 29
- ENDIF
-
- IF (IFLNEW.NE.0) THEN
- MEXSUS = IOR (MEXSUS, IQ(LDOAN))
- ELSE
- MEXAN = IOR (MEXAN, IQ(LDOAN))
- ENDIF
- GO TO 21
-
-C-- accepted PREP/MAT bank
-
- 28 IF (JCCTYP.LT.MCCSEL) THEN
- IF (NVEXDK(2).NE.0) CALL DPLIST (MODEAN,LDOAN,LUPAN,0)
- MEXAN = IOR (MEXAN, IQ(LDOAN))
- MEXAN = IOR (MEXAN, MEXSUS)
- ENDIF
-
- 29 MEXAN = IAND (MEXAN,15)
- RETURN
-
-C---- Follow reference to foreign material
-
- 31 LOWAN = LDOAN
- LUPAN = L
-
-C-- list what action
-
- CALL DPLACT
- IF (IAND(IQ(LOWAN),KM5+KM6).NE.0) GO TO 37
-
-C-- next MAT bank
-
- LDOAN = LUPAN - 1
- 34 KDOAN = LDOAN - 1
- LDOAN = LQ(KDOAN)
- IF (LDOAN.NE.0) GO TO 24
- 36 LDOAN = LOWAN
- LUPAN = 0
- GO TO 22
-
- 37 MEXSUS = IOR (MEXSUS, IQ(LOWAN))
- MEXSUS = IOR (MEXSUS, IQ(LUPAN))
- GO TO 36
- END
diff --git a/src/p5boot/p5lib/mk_frag.f b/src/p5boot/p5lib/mk_frag.f
deleted file mode 100644
index d471607..0000000
--- a/src/p5boot/p5lib/mk_frag.f
+++ /dev/null
@@ -1,171 +0,0 @@
-CDECK ID>, MK_FRAG.
- SUBROUTINE MK_FRAG (KJOINX,NSTEP)
-
-C- Fragment the contents of the bank at LDOAN for DOFORG
-C- on the boundaries and according to the delayed control-lines
-C. started 15-jul-93
-
- PARAMETER (KM1=1,KM2=2,KM3=4,KM4=8,KM5=16,KM6=32,KM7=64,KM8=128,
- + KM9=256, KM10=512, KM11=1024, KM12=2048, KM13=4096, KM14=8192,
- + KM15=16384, KM16=32768, KM17=65536, KM18=131072, KM19=262144)
- PARAMETER (NBANKS=19,JBKPAT=1, JBKDEC=2, JBKORG=3, JBKINC=4,
- + JBKHOL=5, JBKKEE=6, JBKACT=7, JBKMAT=8, JBKXSQ=9,
- + JBKPRE=10,JBKGAR=11,JBKSMH=12,JBKSMT=13,JBKSML=14,
- + JBKSMX=15,JBKARR=16,JBKASA=17,JBKPAM=18,JBKRPA=19)
- COMMON /QBANKS/MMBANK(5,NBANKS)
- PARAMETER (MCCNIL=1, MCCKIL=2, MCCINC=3, MCCCDE=4, MCCSEQ=5,
- + MCCXSQ=6, MCCTRU=7, MCCFAL=8, MCCELS=9, MCCEND=10,
- + MCCSEL=11, MCCSES=12, MCCFAU=13, MCCSKI=14,
- + MCCKEE=15, MCCDEL=16, MCCREP=17, MCCADB=18, MCCADD=19,
- + MCCUSE=20, MCCXDI=21, MCCDIV=22, MCCLIS=23, MCCEXE=24, MCCIMI=25,
- + MCCASM=26, MCCUPD=27, MCCNAM=28, MCCGAP=29, MCCMOR=30, MCCONL=31,
- + MCCFOR=32, MCCSUS=33, MCCOPT=34, MCCOP2=35, MCCSHO=36, MCCPAM=37,
- + MCCQUI=38, MCCEOD=39, MCCDEC=40, MCCPAT=41, MCCTIT=42)
- CHARACTER CCKORG*256, CCKARD*256, CCCOMF*256
- COMMON /CCPARA/NCHCCD,NCHCCT, JCCTYP,JCCLEV,JCCSL,MCCPAR(240)
- +, NCCPAR,MXCCIF,JCCIFV,JCCBAD,JCCWAR,ICCSUB,JCCWK(4)
- +, JCCPP,JCCPD,JCCPZ,JCCPT,JCCPIF,JCCPC,JCCPN
- +, NCCPP,NCCPD,NCCPZ,NCCPT,NCCPIF,NCCPC,NCCPN
- +, JCCEND, NCHCCC,IXCCC, CCKORG, CCKARD, CCCOMF
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
- COMMON /M_ANAC/LOWAN,KDOAN,LDOAN,LUPAN,MODEAN,MEXAN,LEVAN,KKM5AN
- +, NEWDEC,NEWCTL,NEWFOR,NEWNIL,NEWINC
-C-------------- End CDE --------------------------------
-
- IOR (IZV,IZW) = OR (IZV, IZW)
- ISHFTL (IZW,NZB) = LSHIFT (IZW, NZB)
-
-
- KJOIN = KJOINX
- JSLA = IQ(LDOAN+1)
- JSLE = JSLA + IQ(LDOAN+2)
- JSLA = JSLA + NSTEP
- JCPUT = JCCTYP
- IF (JCCTYP.LT.MCCCDE) GO TO 20
- IF (JCCTYP.GT.MCCSEQ) GO TO 20
-
-C-- starting with +CDE or +SEQ, lift a call bank
-
- CALL CCKRAK (JSLA)
- GO TO 37
-
-C-- Look for the next delayed c/line
-
- 20 JCLAST = 0
- JSLG = JSLA
-
- 21 CALL NEXTCC ('-',JSLG,JSLE,JSLF,JCCTYP)
-
- 22 NLDO = JSLF - JSLA
- IF (NLDO.EQ.0) GO TO 27
-
-C-- store the pending material
-
- CALL MQLIFT (LMAT,KJOIN,0,JBKMAT,1)
-
- MMBANK(3,JBKMAT) = 2
-
- LQ(LMAT-2) = LDECO
- IQ(LMAT) = IOR (IQ(LMAT), MEXAN)
- IQ(LMAT+1) = JSLA
- IQ(LMAT+2) = NLDO
- IQ(LMAT+3) = JSLA - JSLORG
-
- IF (JCPUT.NE.0) THEN
- IQ(LMAT) = IOR (IQ(LMAT), ISHFTL(JCPUT,8))
- ELSEIF (JCLAST.NE.0) THEN
- IQ(LMAT) = IOR (IQ(LMAT), KM15)
- ENDIF
- KJOIN = LMAT - 1
-
- 27 JCPUT = 0
- JSLA = JSLF
- IF (JCCTYP.LT.0) GO TO 20
- IF (JCCTYP.EQ.0) GO TO 99
-
-C---- handle the new c/line
-
- JCLAST = JCCTYP
- JSLG = JSLA + 1
- CALL CCKRAK (JSLA)
- IF (JCCBAD.NE.0) THEN
- NUM = JSLA - JSLORG
- CALL FAILLN (1, 0, NUM, JSLA, 'Bad syntax for delayed c/l')
- ENDIF
-
-
-C-- control-lines with associated material are:
-C-- +_xxx +SELF +SKIP +KEEP
-
-C-- soft c/lines
-
- IF (JCCTYP.GE.MCCSEL) GO TO 41
- JTX = MLIAD(JSLA)
- TEXT(JTX) = '+'
- JCPUT = JCCTYP
-
- IF (JCCTYP.GE.MCCTRU) GO TO 21
- IF (JCCTYP.LT.MCCCDE) GO TO 54
-
-C-- do +CDE, +SEQ, lift a call bank
-
- 37 LMAT = LIFTSQ (KJOIN,JCCTYP,0,1)
- LQ(LMAT-2) = LDECO
- IQ(LMAT) = IOR (IQ(LMAT), MEXAN)
- IQ(LMAT+1) = JSLA
- IQ(LMAT+2) = 1
- IQ(LMAT+3) = JSLA - JSLORG
- KJOIN = LMAT - 1
- JSLA = JSLA + 1
- JCPUT = 0
- GO TO 20
-
-C-- hard control lines
-
- 41 IF (JCCTYP.GE.MCCUSE) GO TO 54
- IF (JCCTYP.GE.MCCKEE) GO TO 51
- IF (JCCTYP.NE.MCCSEL) GO TO 21
-
-C-- +SELF, sname
-
- IF (NCCPZ.EQ.0) GO TO 21
- LMAT = LIFTSQ (KJOIN,MCCSES,0,1)
- LQ(LMAT-2) = LDECO
- IQ(LMAT) = IOR (IQ(LMAT), MEXAN)
- IQ(LMAT+1) = JSLA
- IQ(LMAT+3) = JSLA - JSLORG
-
- CALL NEXTCC ('-',JSLG,JSLE,JSLF,JCCTYP)
- IQ(LMAT+2) = JSLF - JSLA
- KJOIN = LMAT - 1
- GO TO 27
-
-C-- Action line +ADD etc, MAT bank needs 3 links
-
- 51 MMBANK(3,JBKMAT) = 3
- IF (JCCTYP.EQ.MCCKEE) GO TO 21
-
-C-- stand-alone control-line
-
- 54 JCCTYP = -1
- JSLF = JSLA + 1
- GO TO 22
-
-C---- done
-
- 99 KJOINX = KJOIN
- RETURN
- END
diff --git a/src/p5boot/p5lib/mk_nil.f b/src/p5boot/p5lib/mk_nil.f
deleted file mode 100644
index 19e403c..0000000
--- a/src/p5boot/p5lib/mk_nil.f
+++ /dev/null
@@ -1,145 +0,0 @@
-CDECK ID>, MK_NIL.
- SUBROUTINE MK_NIL
-
-C- Store NIL sequences or actions into division 1 to carry the
-C- EXE bits of deleted material to the deck where it would have
-C- appeared. For this we have to scan the de-selected PREP banks.
-C. started 9-dec-91
-
- PARAMETER (KM1=1,KM2=2,KM3=4,KM4=8,KM5=16,KM6=32,KM7=64,KM8=128,
- + KM9=256, KM10=512, KM11=1024, KM12=2048, KM13=4096, KM14=8192,
- + KM15=16384, KM16=32768, KM17=65536, KM18=131072, KM19=262144)
- PARAMETER (KMA=1,KMB=2,KMC=4,KMD=8,KME=16,KMF=32,KMG=64,KMH=128,
- + KMI=256, KMJ=512, KMK=KM11, KML=KM12, KMM=KM13, KMN=KM14,
- + KMO=KM15, KMP=KM16, KMQ=KM17, KMR=KM18, KMS=KM19)
- PARAMETER (NBANKS=19,JBKPAT=1, JBKDEC=2, JBKORG=3, JBKINC=4,
- + JBKHOL=5, JBKKEE=6, JBKACT=7, JBKMAT=8, JBKXSQ=9,
- + JBKPRE=10,JBKGAR=11,JBKSMH=12,JBKSMT=13,JBKSML=14,
- + JBKSMX=15,JBKARR=16,JBKASA=17,JBKPAM=18,JBKRPA=19)
- COMMON /QBANKS/MMBANK(5,NBANKS)
- PARAMETER (MCCNIL=1, MCCKIL=2, MCCINC=3, MCCCDE=4, MCCSEQ=5,
- + MCCXSQ=6, MCCTRU=7, MCCFAL=8, MCCELS=9, MCCEND=10,
- + MCCSEL=11, MCCSES=12, MCCFAU=13, MCCSKI=14,
- + MCCKEE=15, MCCDEL=16, MCCREP=17, MCCADB=18, MCCADD=19,
- + MCCUSE=20, MCCXDI=21, MCCDIV=22, MCCLIS=23, MCCEXE=24, MCCIMI=25,
- + MCCASM=26, MCCUPD=27, MCCNAM=28, MCCGAP=29, MCCMOR=30, MCCONL=31,
- + MCCFOR=32, MCCSUS=33, MCCOPT=34, MCCOP2=35, MCCSHO=36, MCCPAM=37,
- + MCCQUI=38, MCCEOD=39, MCCDEC=40, MCCPAT=41, MCCTIT=42)
- CHARACTER CCKORG*256, CCKARD*256, CCCOMF*256
- COMMON /CCPARA/NCHCCD,NCHCCT, JCCTYP,JCCLEV,JCCSL,MCCPAR(240)
- +, NCCPAR,MXCCIF,JCCIFV,JCCBAD,JCCWAR,ICCSUB,JCCWK(4)
- +, JCCPP,JCCPD,JCCPZ,JCCPT,JCCPIF,JCCPC,JCCPN
- +, NCCPP,NCCPD,NCCPZ,NCCPT,NCCPIF,NCCPC,NCCPN
- +, JCCEND, NCHCCC,IXCCC, CCKORG, CCKARD, CCCOMF
- COMMON /MUSEBC/ MX_FORC, MU_GLOB, MU_PAT, MU_DECK, MU_INH, MU_FORG
- +, MX_TRAN, MX_FORG, MX_SINH, MX_SELF, NVEXDK(6)
- PARAMETER (KQGARB=1,KQARRV=3,KQKEEP=4,KQPREP=5,KQMAIN=6,KQPAST=8)
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
- COMMON /M_ANAC/LOWAN,KDOAN,LDOAN,LUPAN,MODEAN,MEXAN,LEVAN,KKM5AN
- +, NEWDEC,NEWCTL,NEWFOR,NEWNIL,NEWINC
-C-------------- End CDE --------------------------------
-
- IAND (IZV,IZW) = AND (IZV, IZW)
- IOR (IZV,IZW) = OR (IZV, IZW)
- ISHFTL (IZW,NZB) = LSHIFT (IZW, NZB)
-
-
- LDO = KQPREP + 1
-
-C------ Find next deleted foreign material
-
- 21 LDO = LQ(LDO-1)
- IF (LDO.EQ.0) RETURN
- IF (IQ(LDO+2).EQ.0) GO TO 21
- IF (IAND(IQ(LDO),KM5+KM6).EQ.0) GO TO 21
-
- JCCTYP = JBYT (IQ(LDO),9,6)
- IF (JCCTYP.LT.MCCKEE) GO TO 21
- IF (JCCTYP.GE.MCCUSE) GO TO 21
-
- CALL CCKRAK (IQ(LDO+1))
- IF (JCCBAD.NE.0) GO TO 21
- MEXACT = IAND (IQ(LDO),15)
-
- IF (JCCTYP.NE.MCCKEE) GO TO 41
-
-C---------- Handle +KEEP --------------------
-
- IF (IAND(MCCPAR(JCCPT+1),KMD).NE.0) GO TO 21
- IF (IAND(MEXACT,NOT(MU_GLOB)).EQ.0) GO TO 21
-
-C-- inquire existence, get the attachment adr if not pre-existing
-
- 34 CALL LOCKEEP (LSQ)
- IF (LSQ.NE.0) GO TO 21
- KACT = IQUEST(1)
- LPD = IQUEST(11)
-
- IF (LPD.NE.0) THEN
- IF (IAND(MEXACT,NOT(IQ(LPD))).EQ.0) GO TO 21
- ENDIF
-
-C-- lift the KEEP bank
-
- IF (LDECO.EQ.0) CALL CRDECO
- CALL MQLIFT (LACT,KACT,0,JBKKEE,1)
-
- IQ(LACT) = IOR (IQ(LACT), MEXACT+KM12)
- LQ(LACT-3) = LDECO
- IQ(LACT+3) = IQ(LDO+1) - JSLORG
- IQ(LACT+4) = MCCPAR(JCCPZ+1)
- GO TO 21
-
-C---------- Handle +DEL +REPL +ADB +ADD --------------------
-
- 41 LPD = LQ(LDO-3)
- IF (LPD.EQ.0) GO TO 21
- IF (LPD.EQ.LEXD) GO TO 21
-
- IF (IAND(MEXACT,NOT(IQ(LPD))).EQ.0) GO TO 21
- JACT = JCCTYP - MCCDEL
-
-C-- lift the ACT bank
-
- IF (LDECO.EQ.0) CALL CRDECO
- 47 CALL MQLIFT (LACT,LPD,-2,JBKACT,1)
-
- IQ(LACT) = IOR (IQ(LACT), MEXACT+KM12)
- IQ(LACT) = IOR (IQ(LACT), ISHFTL(JACT,8))
-
- LQ(LACT-3) = LDECO
- IQ(LACT+3) = IQ(LDO+1) - JSLORG
- IQ(LACT+4) = MCCPAR(JCCPC+1)
- IQ(LACT+5) = MCCPAR(JCCPC+2)
- IF (JCCTYP.EQ.MCCDEL) GO TO 48
-
-C-- check whether the action starts with ordinary material
-
- JSLF = IQ(LDO+1) + 1
- JTXF = MLIAD(JSLF)
- IF (TEXT(JTXF).NE.'-') GO TO 21
- IF (JPTYPE(TEXT(JTXF)).LT.MCCSEL) GO TO 21
- IQ(LACT) = IOR (IQ(LACT), KM16)
- GO TO 21
-
-C-- handle multiple deletes
-
- 48 IQ(LACT) = IOR (IQ(LACT), KM16)
- NCCPC = NCCPC - 1
- IF (NCCPC.EQ.0) GO TO 21
- JCCPC = JCCPC + 3
- GO TO 47
- END
diff --git a/src/p5boot/p5lib/mqgarb.f b/src/p5boot/p5lib/mqgarb.f
deleted file mode 100644
index 745f50c..0000000
--- a/src/p5boot/p5lib/mqgarb.f
+++ /dev/null
@@ -1,58 +0,0 @@
-CDECK ID>, MQGARB.
- SUBROUTINE MQGARB
-
-C- Garbage collector - control routine
-C. started 8-oct-91
-
- COMMON /QUNIT/ IQREAD,IQPRNT, IQTTIN,IQTYPE, IQOFFL,IQRTTY,IQRSAV
- +, IQRFD,IQRRD,IQRSIZ, NQLPAT,NQUSED,NQLLBL, NQINIT
- COMMON /MQCM/ NQSYSS,NQLINK, LQCSTA(3),LQCEND(3), NQMAX
- +, LQLSTA(5),LQLEND(5), LQADR,LQADR0,NQOFFS
- COMMON /MQCT/ LQTA,LQTB,LQTE,LQMTB,LQMTE,LQMTH
- +, JQDIVG,NQRESV(3),IQPART,NQFREE(3)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ)
- EQUIVALENCE (LQ,IQ,LQGARB)
- COMMON // IQUEST(100),LQGARB
-C-------------- End CDE --------------------------------
- PARAMETER (KQGARB=1)
-
-
-
- CALL VZERO (NQRESV,3)
-
- IF (LQGARB.EQ.0) GO TO 41
- 24 CALL MQKILL
- IF (LQGARB.EQ.0) GO TO 27
-
-C---- Collect Text garbage
-
- CALL QSORTI (1,KQGARB)
- CALL MQLTAB
- CALL MQLREL
- CALL MQLMOV
-
-C---- Collect Control garbage
-
- 27 CALL MQTABL
- IF (NQFREE(1).EQ.0) GO TO 41
- CALL MQRELC
- CALL MQMOVE
- IF (LQGARB.NE.0) GO TO 24
- IF (IQPART.NE.0) GO TO 27
-
-C---- Everbody happy?
-
- 41 IF (NQRESV(1).LT.0) GO TO 71
- IF (NQRESV(2).LT.0) GO TO 71
- IF (NQRESV(3).LT.0) GO TO 71
- RETURN
-
-C--- Not enough space
-
- 71 IQUEST(1) = 99
- IQUEST(2) = NQRESV(1)
- IQUEST(3) = NQRESV(2)
- IQUEST(4) = NQRESV(3)
- CALL P_KILL ('MQGARB, no space.')
- END
diff --git a/src/p5boot/p5lib/mqgett.f b/src/p5boot/p5lib/mqgett.f
deleted file mode 100644
index 374dd39..0000000
--- a/src/p5boot/p5lib/mqgett.f
+++ /dev/null
@@ -1,51 +0,0 @@
-CDECK ID>, MQGETT.
- SUBROUTINE MQGETT
-
-C- Garbage collector - find biggest space for the relocation table
-C. started 8-oct-91
-
- COMMON /MQCM/ NQSYSS,NQLINK, LQCSTA(3),LQCEND(3), NQMAX
- +, LQLSTA(5),LQLEND(5), LQADR,LQADR0,NQOFFS
- COMMON /MQCT/ LQTA,LQTB,LQTE,LQMTB,LQMTE,LQMTH
- +, JQDIVG,NQRESV(3),IQPART,NQFREE(3)
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
-C-------------- End CDE --------------------------------
-
-
-C-- control division 2 empty
-
- LQTA = LQCEND(1)
- IF (LQCSTA(2).EQ.LQCEND(2)) THEN
- NWAV = LQCSTA(3) - LQTA
- GO TO 21
- ENDIF
-
-C-- control division 1/2
-
- NWAV = LQCSTA(2) - LQTA
-
-C-- control division 2/3
-
- IF (NWAV.LT.LQCSTA(3)-LQCEND(2)) THEN
- LQTA = LQCEND(2)
- NWAV = LQCSTA(3) - LQTA
- ENDIF
-
-C-- text division 2/3
-
- 21 IF (NWAV+8.LT.LQLSTA(4)-LQLEND(2)) THEN
- LQTA = LQLEND(2) + 2
- NWAV = LQLSTA(4) - LQTA - 2
- LQTA = LQTA + NQOFFS
- ENDIF
-
- LQTE = LQTA + NWAV
- RETURN
- END
diff --git a/src/p5boot/p5lib/mqinit.f b/src/p5boot/p5lib/mqinit.f
deleted file mode 100644
index e021bb0..0000000
--- a/src/p5boot/p5lib/mqinit.f
+++ /dev/null
@@ -1,214 +0,0 @@
-CDECK ID>, MQINIT.
- SUBROUTINE MQINIT
-
-C- Initialise memory manager and some other COMMONs
-
- CHARACTER CCKORG*256, CCKARD*256, CCCOMF*256
- COMMON /CCPARA/NCHCCD,NCHCCT, JCCTYP,JCCLEV,JCCSL,MCCPAR(240)
- +, NCCPAR,MXCCIF,JCCIFV,JCCBAD,JCCWAR,ICCSUB,JCCWK(4)
- +, JCCPP,JCCPD,JCCPZ,JCCPT,JCCPIF,JCCPC,JCCPN
- +, NCCPP,NCCPD,NCCPZ,NCCPT,NCCPIF,NCCPC,NCCPN
- +, JCCEND, NCHCCC,IXCCC, CCKORG, CCKARD, CCCOMF
- COMMON /LUNSLN/IFLAUX, IXLUN(12)
- PARAMETER (NBANKS=19,JBKPAT=1, JBKDEC=2, JBKORG=3, JBKINC=4,
- + JBKHOL=5, JBKKEE=6, JBKACT=7, JBKMAT=8, JBKXSQ=9,
- + JBKPRE=10,JBKGAR=11,JBKSMH=12,JBKSMT=13,JBKSML=14,
- + JBKSMX=15,JBKARR=16,JBKASA=17,JBKPAM=18,JBKRPA=19)
- COMMON /QBANKS/MMBANK(5,NBANKS)
- CHARACTER CQBLAN*128, CQEQS*128, CQCETA*32
- CHARACTER CQAPO*1, CQBSL*1, CQTAB*1
- COMMON /QCHAR/ CQBLAN, CQEQS, CQCETA, CQAPO, CQBSL, CQTAB
- PARAMETER (NQBITW=32, NQBITC=8, NQCHAW=4)
- COMMON /QPAGE/ NQLMAX,NQLTOL,NQLTOK,NQCMAX,NQCPGH,NQPAGE
- +, NQWYLDO,NQWYL,NQNEWH,NQJOIN,NQDKNO,NQDKPG
- CHARACTER CQDATEM*10, CQDATE*8, CQTIME*5
- COMMON /QSTATE/NQERR,NQWARN,NQINFO,NQLOCK
- +, IQDATE,IQTIME, CQDATEM,CQDATE,CQTIME
- COMMON /QUNIT/ IQREAD,IQPRNT, IQTTIN,IQTYPE, IQOFFL,IQRTTY,IQRSAV
- +, IQRFD,IQRRD,IQRSIZ, NQLPAT,NQUSED,NQLLBL, NQINIT
- COMMON /MQCM/ NQSYSS,NQLINK, LQCSTA(3),LQCEND(3), NQMAX
- +, LQLSTA(5),LQLEND(5), LQADR,LQADR0,NQOFFS
- COMMON /MQCT/ LQTA,LQTB,LQTE,LQMTB,LQMTE,LQMTH
- +, JQDIVG,NQRESV(3),IQPART,NQFREE(3)
- COMMON /MQCN/ IQLST,IQLNA,IQID,IQTY,IQLI,IQNL,IQNS,IQND
- +, IQLNX,IQFOUL
- COMMON /MQCL/ NQLST,NQLNA,NQID,NQTY,NQLI,NQNL,NQNS,NQND
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, MUSER(9)
-C-------------- End CDE --------------------------------
- COMMON /SLATE/ ISLATE(40)
- LOGICAL INTRAC
-
- CHARACTER MMTOBK(NBANKS)*20
-
- DATA MMTOBK / 'PAT 0 4 3 2'
- +, 'DECK 0 4 3 1'
- +, 'ORG 0 0 0 2'
- +, 'INCL 0 1 1 1'
- +, 'HOLD 1 1 1 5'
- +, 'KEEP 1 3 2 4'
- +, 'ACT 1 3 2 5'
- +, 'MAT 1 3 1 3'
- +, 'XSQ 1 3 1 5'
- +, 'PREP 1 3 1 2'
- +, 'GARB 0 1 1 2'
- +, 'ASMH 0 63 0 2'
- +, 'ASMT 0 5 1 11'
- +, 'ASML 0 1 1 11'
- +, 'ASMX 0 1 1 4'
- +, 'ARRV 0 2 2 14'
- +, 'ASAV 1 1 1 2'
- +, 'PAM 0 0 0 15'
- +, 'RPAM 0 1 1 4' /
-C- _:.=+=.: 1_:.=+=.: 2
-C- ID LI NL NS ND
-
-
-
-C-- Ready common /QCHAR/
-
- CQBLAN = ' '
- CALL CFILL ('====', CQEQS, 1, LEN(CQEQS))
- CQCETA = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ012345'
- CQAPO = CHAR(39)
- CQBSL = CHAR(92)
- CQTAB = CHAR(9)
-
-C-- Ready common /QPAGE/
-
- NQLMAX = 110
- NQCMAX = 120
- NQCPGH = 110
- CALL MQPAGE
- NQNEWH = 0
- NQJOIN = 0
- NQDKNO = 0
- NQDKPG = 1
- NQPAGE = 1
- NQWYL = 0
- NQWYLDO= 0
-
-C-- Ready common /QSTATE/
-
- CALL VZERO (NQERR,6)
- CALL DATIME (IQDATE,IQTIME)
- IQDATE = (ISLATE(1)*100 + ISLATE(2))*100 + ISLATE(3)
- ISL4 = ISLATE(4)
- ISL5 = ISLATE(5)
-
- CQDATE = '00000000'
- CALL CSETDI (IQDATE,CQDATE,1,8)
- CQDATEM = CQDATE(1:4) // '/' // CQDATE(5:6) // '/' // CQDATE(7:8)
-
- CQTIME = ' 0.0 '
- CALL CSETDI (ISL4, CQTIME,1,2)
- CALL CSETDI (ISL5, CQTIME,4,5)
-
-C-- Ready common /QUNIT/
-
- IQREAD = 2
- IQPRNT = 3
- IQTTIN = 5
- IQTYPE = 6
- IQRSAV = IQREAD
- IQRFD = 0
- IQRRD = 0
- IQRSIZ = 0
- NQLPAT = 0
- NQUSED = 0
- NQLLBL = 0
- NQINIT = 7
-
- IF (INTRAC()) THEN
- IQOFFL = 0
- IQRTTY = IQTTIN
- ELSE
- IQOFFL = 1
- IQRTTY = 0
- ENDIF
-
-C-- Ready common /MQCM/
-
- LQADR = LOCF (LQ(1))
- LQADR0 = LQADR - 1
- NQOFFS = LOCF (MLIAD(1)) - LQADR
- NQSYSS = 12
- NQLINK = 24
- NQMAX = NSIZEQ - 2
-
-C-- Clear commons
-
- CALL VZERO (IQUEST,4000)
- CALL VZERO (LQTA,14)
- CALL VZERO (NQLST,8)
- CALL VZERO (IQLST,10)
-
- IFLAUX = 0
- CALL VZERO (IXLUN,12)
-
- CALL VZERO (NCHCCD,269)
- CCKORG = ' '
- CCKARD = ' '
- MCCPAR(2) = -1
-
-C-- Ready control divisions
-
- LQCEND(3) = NQMAX - 1
- LQCSTA(3) = LQCEND(3)
-
- LQCSTA(1) = NQLINK + 1
- LQCEND(1) = LQCSTA(1)
-
- LQCSTA(2) = (LQCSTA(3)+LQCEND(1)) / 2
- LQCEND(2) = LQCSTA(2)
-
-C-- Ready text divisions
-
- JTXL = NSIZETX - 12000
- JSLL = NSIZELN - 2000
- MLIAD(JSLL) = JTXL
-
- LQLSTA(4) = JSLL
- LQLEND(4) = JSLL
- LQLSTA(5) = JSLL
- LQLEND(5) = NSIZELN - 2
- MLIAD(LQLEND(5)) = NSIZETX
-
-C-- slots 1+2 are used for constructing the line
-C-- for each special sequence
-
- DO 42 J=1,999
- 42 TEXT(J) = ' '
- MLIAD(1) = 1
- MLIAD(2) = 257
- MLIAD(3) = 513
-
- LQLSTA(1) = 1
- LQLEND(1) = 3
- LQLSTA(2) = LQLEND(1)
- LQLEND(2) = LQLSTA(2)
- LQLSTA(3) = LQLEND(2)
- LQLEND(3) = LQLSTA(3)
-
-C-- Ready /QBANKS/
-
- DO 47 J=1,NBANKS
- CALL UCTOH (MMTOBK(J),MMBANK(1,J),4,4)
- MMBANK(2,J) = ICDECI (MMTOBK(J), 6, 8)
- MMBANK(3,J) = ICDECI (MMTOBK(J),10,12)
- MMBANK(4,J) = ICDECI (MMTOBK(J),14,16)
- 47 MMBANK(5,J) = ICDECI (MMTOBK(J),18,20)
-
-C-- Initialize the name handler
-
- CALL NA_INIT
- CALL NA_INPY
- RETURN
- END
diff --git a/src/p5boot/p5lib/mqkill.f b/src/p5boot/p5lib/mqkill.f
deleted file mode 100644
index bdb4ef9..0000000
--- a/src/p5boot/p5lib/mqkill.f
+++ /dev/null
@@ -1,66 +0,0 @@
-CDECK ID>, MQKILL.
- SUBROUTINE MQKILL
-
-C- Turn the garbage d/s into a flat linear structure
-C- mark banks in division 1 to be dead
-C- keep in the structure only banks in division 1 with line-numbers
-C. started 8-oct-91
-
- COMMON /MQCM/ NQSYSS,NQLINK, LQCSTA(3),LQCEND(3), NQMAX
- +, LQLSTA(5),LQLEND(5), LQADR,LQADR0,NQOFFS
- COMMON /MQCN/ IQLST,IQLNA,IQID,IQTY,IQLI,IQNL,IQNS,IQND
- +, IQLNX,IQFOUL
- PARAMETER (IQDROP=31, IQMARK=30, KMDROP=1073741824)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ)
- EQUIVALENCE (LQ,IQ,LQGARB)
- COMMON // IQUEST(100),LQGARB
-C-------------- End CDE --------------------------------
- PARAMETER (KQGARB=1)
-
- IOR (IZV,IZW) = OR (IZV, IZW)
-
-
- KCUR = KQGARB
- 21 LCUR = LQ(KCUR)
- IF (LCUR.EQ.0) RETURN
- IF (LCUR.GE.LQCEND(1)) GO TO 49
-
- CALL QNAME (LCUR)
- LQ(IQLNA) = IOR (LQ(IQLNA),KMDROP)
- IF (IQNS.LT.2) GO TO 41
-
-C---- Bank with structural links reached
-
- KUSE = LCUR - IQNS -1
-
-C-- Look at next link
-
- 24 KUSE = KUSE + 1
- IF (KUSE.EQ.LCUR-1) GO TO 41
- LNEW = LQ(KUSE)
- IF (LNEW.EQ.0) GO TO 24
- IF (LNEW.GE.LQCEND(1)) THEN
- LQ(KUSE) = 0
- GO TO 24
- ENDIF
-
-C-- Shunt the linear structure at KUSE to LCUR-1
-
- CALL QSHLIN (KUSE,LCUR-1)
- GO TO 24
-
-C---- Keep current bank connected only if with line-number
-
- 41 IF (IQLI.EQ.0) GO TO 49
- IF (IQ(LCUR+1).EQ.0) GO TO 49
- IF (IQ(LCUR+1).GE.LQLSTA(2)) GO TO 49
- IF (IQ(LCUR+2).EQ.0) GO TO 49
- KCUR = LCUR - 1
- GO TO 21
-
-C-- bridge unwanted bank
-
- 49 LQ(KCUR) = LQ(LCUR-1)
- GO TO 21
- END
diff --git a/src/p5boot/p5lib/mqlift.f b/src/p5boot/p5lib/mqlift.f
deleted file mode 100644
index e504324..0000000
--- a/src/p5boot/p5lib/mqlift.f
+++ /dev/null
@@ -1,93 +0,0 @@
-CDECK ID>, MQLIFT.
- SUBROUTINE MQLIFT (L,K,N,JN,JD)
-
-C- Satisfy bank request
-C- Linkage control: if N.LE.0 connect at LQ(K-N)
-C- N.EQ.1 connect at K (top level)
-C- N.GE.2 no connection (stand alone)
-C- JN is the bank name index, JD is the division number
-C- return in L the adr of the bank lifted
-C. started 8-oct-91
-
- CHARACTER SLLINE*512, SLERRM*256
- COMMON /SLATLN/ SLLINE, SLERRM
- PARAMETER (NBANKS=19,JBKPAT=1, JBKDEC=2, JBKORG=3, JBKINC=4,
- + JBKHOL=5, JBKKEE=6, JBKACT=7, JBKMAT=8, JBKXSQ=9,
- + JBKPRE=10,JBKGAR=11,JBKSMH=12,JBKSMT=13,JBKSML=14,
- + JBKSMX=15,JBKARR=16,JBKASA=17,JBKPAM=18,JBKRPA=19)
- COMMON /QBANKS/MMBANK(5,NBANKS)
- COMMON /MQCM/ NQSYSS,NQLINK, LQCSTA(3),LQCEND(3), NQMAX
- +, LQLSTA(5),LQLEND(5), LQADR,LQADR0,NQOFFS
- COMMON /MQCT/ LQTA,LQTB,LQTE,LQMTB,LQMTE,LQMTH
- +, JQDIVG,NQRESV(3),IQPART,NQFREE(3)
- COMMON /MQCL/ NQLST,NQLNA,NQID,NQTY,NQLI,NQNL,NQNS,NQND
- COMMON /QUNIT/ IQREAD,IQPRNT, IQTTIN,IQTYPE, IQOFFL,IQRTTY,IQRSAV
- +, IQRFD,IQRRD,IQRSIZ, NQLPAT,NQUSED,NQLLBL, NQINIT
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ)
- EQUIVALENCE (LQ,IQ,LQGARB)
- COMMON // IQUEST(100),LQGARB
-C-------------- End CDE --------------------------------
- DIMENSION L(9), K(9), JN(9), JD(9)
-
-
- KK = K(1)
- JBKIX = JN(1)
- JDIV = JD(1)
- IFORW = 3 - JDIV
- IF ((JBKIX.LE.0).OR.(JBKIX.GT.NBANKS)) THEN
- CALL P_CRASH ('MQLIFT - faulty bank name index')
- ENDIF
- IF ((JDIV.LE.0).OR.(JDIV.GT.3)) THEN
- CALL P_CRASH ('MQLIFT - faulty division index')
- ENDIF
-
- NQTY = JBKIX
- NQID = MMBANK(1,JBKIX)
- NQLI = MMBANK(2,JBKIX)
- NQNL = MMBANK(3,JBKIX)
- NQNS = MMBANK(4,JBKIX)
- NQND = MMBANK(5,JBKIX)
- NT = NQNL + NQND + 2
- IF ((NQNL.GE.64).OR.(NQNS.GT.NQNL).OR.(NQND.GE.2048)) THEN
- PRINT *, ' MQLIFT: NL/NS/ND=',NQNL,NQNS,NQND
- CALL P_CRASH ('MQLIFT - faulty bank parameters')
- ENDIF
- IF (IFORW.NE.0) THEN
- NQLNA = LQCEND(JDIV)
- NQRESV(1) = LQCSTA(JDIV+1) - NQLNA - NT
- ELSE
- NQLNA = LQCSTA(JDIV) - NT
- NQRESV(1) = NQLNA - LQCEND(JDIV-1)
- ENDIF
-
- IF (NQRESV(1).LE.0) THEN
- SLERRM = 'no space in control division x'
-C- _:.=+=.: 1_:.=+=.: 2_:.=+=.: 3
- CALL CSETDI (JDIV,SLERRM,30,30)
- CALL NOSPACE (SLERRM(1:30))
- ENDIF
-
- IF (IFORW.NE.0) THEN
- LQCEND(JDIV) = LQCEND(JDIV) + NT
- ELSE
- LQCSTA(JDIV) = LQCSTA(JDIV) - NT
- ENDIF
-
- NQLST = NQLNA + NQNL + 1
- CALL VZERO (LQ(NQLNA),NT)
- CALL QLUMP
- IF (N.LE.0) THEN
- KKN = KK + N
- LNX = LQ(KKN)
- LQ(KKN) = NQLST
- ELSEIF (N.EQ.1) THEN
- LNX = KK
- K(1) = NQLST
- ELSE
- LNX = 0
- ENDIF
- IF (NQNS.GT.0) LQ(NQLST-1) = LNX
- L(1) = NQLST
- RETURN
- END
diff --git a/src/p5boot/p5lib/mqlmov.f b/src/p5boot/p5lib/mqlmov.f
deleted file mode 100644
index e282e80..0000000
--- a/src/p5boot/p5lib/mqlmov.f
+++ /dev/null
@@ -1,56 +0,0 @@
-CDECK ID>, MQLMOV.
- SUBROUTINE MQLMOV
-
-C- Garbage collector - memory move, line slot numbers + text
-C. started 8-oct-91
-
- COMMON /MQCM/ NQSYSS,NQLINK, LQCSTA(3),LQCEND(3), NQMAX
- +, LQLSTA(5),LQLEND(5), LQADR,LQADR0,NQOFFS
- COMMON /MQCT/ LQTA,LQTB,LQTE,LQMTB,LQMTE,LQMTH
- +, JQDIVG,NQRESV(3),IQPART,NQFREE(3)
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
-C-------------- End CDE --------------------------------
- PARAMETER (NSTEP=3)
-
-
- IF (LQTB.EQ.LQTE) THEN
- LQLEND(1) = LQ(LQTE-2)
- RETURN
- ENDIF
-
- JSLTO = LQ(LQTB-2)
- JTXTO = MLIAD(JSLTO)
- JTB = LQTB
-
- 41 JSLFR = LQ(JTB)
- NLI = LQ(JTB+1) - JSLFR
- IF (JSLTO.NE.JSLFR+LQ(JTB+2)) CALL P_CRASH ('MQLMOV mismatch')
-
- JTXFR = MLIAD(JSLFR)
- NTX = MLIAD(JSLFR+NLI) - JTXFR
-
- NTXRE = JTXTO - JTXFR
-
- DO 44 J=1,NLI
- 44 MLIAD(JSLTO+J) = MLIAD(JSLFR+J) + NTXRE
-
- CALL CCOPYL (TEXT(JTXFR),TEXT(JTXTO),NTX)
- JTXTO = JTXTO + NTX
- JSLTO = JSLTO + NLI
-
- JTB = JTB + NSTEP
- IF (JTB.NE.LQTE) GO TO 41
-
- NTFREE = MLIAD(LQLEND(1)) - JTXTO
- LQLEND(1) = JSLTO
- NQRESV(3) = NQRESV(3) + NTFREE
- NQFREE(3) = NTFREE
- RETURN
- END
diff --git a/src/p5boot/p5lib/mqlrel.f b/src/p5boot/p5lib/mqlrel.f
deleted file mode 100644
index ce4e678..0000000
--- a/src/p5boot/p5lib/mqlrel.f
+++ /dev/null
@@ -1,105 +0,0 @@
-CDECK ID>, MQLREL.
- SUBROUTINE MQLREL
-
-C- Garbage collector - Relocator, line slot numbers
-C. started 8-oct-91
-
- COMMON /MQCM/ NQSYSS,NQLINK, LQCSTA(3),LQCEND(3), NQMAX
- +, LQLSTA(5),LQLEND(5), LQADR,LQADR0,NQOFFS
- COMMON /MQCT/ LQTA,LQTB,LQTE,LQMTB,LQMTE,LQMTH
- +, JQDIVG,NQRESV(3),IQPART,NQFREE(3)
- COMMON /MQCN/ IQLST,IQLNA,IQID,IQTY,IQLI,IQNL,IQNS,IQND
- +, IQLNX,IQFOUL
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ)
- EQUIVALENCE (LQ,IQ,LQGARB)
- COMMON // IQUEST(100),LQGARB
-C-------------- End CDE --------------------------------
- EQUIVALENCE (LS,IQLST)
-
-
- LKEEP = LQ(LQTB-2)
- LFIX = LQ(LQTE)
- NENTR = (LQTE-LQTB) / 3
- JDIV = 0
-
-C---- Do next division
-
- 12 IF (JDIV.EQ.1) RETURN
- JDIV = JDIV + 1
- LN = LQCSTA(JDIV)
- LSTOP = LQCEND(JDIV)
- IF (NENTR) 51,41,21
-
-C-------------- 2 or more relocation intervals -------------
-
-C-- Next bank
-
- 21 IF (LN.EQ.LSTOP) GO TO 12
- CALL QBLOW (LN)
- LN = IQLNX
- IF (IQLI.EQ.0) GO TO 21
-
- JSL = IQ(LS+1)
- IF (JSL.GE.LFIX) GO TO 21
- IF (JSL.LT.LKEEP) GO TO 21
-
- IF (JSL.LT.LQ(LQTB)) GO TO 38
- JLOW = 0
- JHI = NENTR + 1
-
-C-- Binary search in relocator table
-
- 27 JEX = (JHI+JLOW) / 2
- IF (JEX.EQ.JLOW) GO TO 29
- IF (JSL.GE.LQ(LQTB+3*JEX)) GO TO 28
- JHI = JEX
- GO TO 27
-
- 28 JLOW = JEX
- GO TO 27
-
- 29 JTB = LQTB + 3*JLOW
- IF (JSL.GE.LQ(JTB+1)) GO TO 38
- IQ(LS+1) = JSL + LQ(JTB+2)
- GO TO 21
-
- 38 IQ(LS+1) = 0
- GO TO 21
-
-C-------------- 1 relocation interval only -------------
-
-C-- Next bank
-
- 41 IF (LN.EQ.LSTOP) GO TO 12
- CALL QBLOW (LN)
- LN = IQLNX
- IF (IQLI.EQ.0) GO TO 41
-
- JSL = IQ(LS+1)
- IF (JSL.GE.LFIX) GO TO 41
- IF (JSL.LT.LKEEP) GO TO 41
-
- IF (JSL.LT.LQ(LQTB)) GO TO 48
- IF (JSL.GE.LQ(LQTB+1)) GO TO 48
- IQ(LS+1) = JSL + LQ(LQTB+2)
- GO TO 41
-
- 48 IQ(LS+1) = 0
- GO TO 41
-
-C-------------- No relocation interval ----------------
-
-C-- Next bank
-
- 51 IF (LN.EQ.LSTOP) GO TO 12
- CALL QBLOW (LN)
- LN = IQLNX
- IF (IQLI.EQ.0) GO TO 51
-
- JSL = IQ(LS+1)
- IF (JSL.GE.LFIX) GO TO 51
- IF (JSL.LT.LKEEP) GO TO 51
- IQ(LS+1) = 0
- GO TO 51
- END
diff --git a/src/p5boot/p5lib/mqltab.f b/src/p5boot/p5lib/mqltab.f
deleted file mode 100644
index a165807..0000000
--- a/src/p5boot/p5lib/mqltab.f
+++ /dev/null
@@ -1,93 +0,0 @@
-CDECK ID>, MQLTAB.
- SUBROUTINE MQLTAB
-
-C- Garbage collector - relocation table building, line slot numbers
-C- run through all banks of the linear garbage structure, which
-C- at this point contains only banks with text pointers
-C. started 8-oct-91
-
- COMMON /QUNIT/ IQREAD,IQPRNT, IQTTIN,IQTYPE, IQOFFL,IQRTTY,IQRSAV
- +, IQRFD,IQRRD,IQRSIZ, NQLPAT,NQUSED,NQLLBL, NQINIT
- COMMON /MQCM/ NQSYSS,NQLINK, LQCSTA(3),LQCEND(3), NQMAX
- +, LQLSTA(5),LQLEND(5), LQADR,LQADR0,NQOFFS
- COMMON /MQCT/ LQTA,LQTB,LQTE,LQMTB,LQMTE,LQMTH
- +, JQDIVG,NQRESV(3),IQPART,NQFREE(3)
- COMMON /MQCN/ IQLST,IQLNA,IQID,IQTY,IQLI,IQNL,IQNS,IQND
- +, IQLNX,IQFOUL
- PARAMETER (IQDROP=31, IQMARK=30, KMDROP=1073741824)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ)
- EQUIVALENCE (LQ,IQ,LQGARB)
- COMMON // IQUEST(100),LQGARB
-C-------------- End CDE --------------------------------
-
- IAND (IZV,IZW) = AND (IZV, IZW)
-
-
-C---- Decide where to put the table
-
- CALL MQGETT
- LIMIT = LQTE - 8
- LQTB = LQTA + 3
- LQTE = LQTA
-
- NLFREE = 0
-
- JSLL = 1
- LNX = LQGARB
-
-C------ Do all banks
-
- 22 LS = LNX
- IF (LS.EQ.0) GO TO 37
- LNX = LQ(LS-1)
- JSLA = IQ(LS+1)
- JSLE = JSLA + IQ(LS+2)
- IF (JSLA.LE.JSLL) THEN
- JSLL = JSLE
- GO TO 22
- ENDIF
-
-C-- start of new dead region
-
- IF (LQTE.GE.LIMIT) GO TO 31
- LQ(LQTE) = JSLL
- LQ(LQTE+1) = JSLA
- JSLL = JSLE
- LQTE = LQTE + 3
- GO TO 22
-
-C------ End of table
-
-C-- Not enough table space, partial collection
-
- 31 LQGARB = LS
-
- 34 CALL QNAME (LS)
- LQ(IQLNA) = IAND (LQ(IQLNA), NOT(KMDROP))
- LS = LQ(LS-1)
- IF (LS.NE.0) GO TO 34
- LS = LQGARB
-
-C-- Normal end
-
- 37 LQGARB = LS
- LQ(LQTE) = JSLL
- IF (JSLL.NE.LQLEND(1)) THEN
- LQ(LQTE+1) = LQLEND(1)
- LQTE = LQTE + 3
- LQ(LQTE) = LQLEND(1)
- ENDIF
- LQ(LQTA+2) = 0
- LQ(LQTE+1) = 0
-
-C-- compute relocation constants
-
- DO 44 JTB=LQTB,LQTE,3
- NLFREE = NLFREE + LQ(JTB) - LQ(JTB-2)
- 44 LQ(JTB+2) = -NLFREE
-
- NQRESV(2) = NQRESV(2) + NLFREE
- NQFREE(2) = NLFREE
- RETURN
- END
diff --git a/src/p5boot/p5lib/mqmove.f b/src/p5boot/p5lib/mqmove.f
deleted file mode 100644
index 0db1db1..0000000
--- a/src/p5boot/p5lib/mqmove.f
+++ /dev/null
@@ -1,37 +0,0 @@
-CDECK ID>, MQMOVE.
- SUBROUTINE MQMOVE
-
-C- Garbage collector - memory move
-C. started 8-oct-91
-
- COMMON /MQCM/ NQSYSS,NQLINK, LQCSTA(3),LQCEND(3), NQMAX
- +, LQLSTA(5),LQLEND(5), LQADR,LQADR0,NQOFFS
- COMMON /MQCT/ LQTA,LQTB,LQTE,LQMTB,LQMTE,LQMTH
- +, JQDIVG,NQRESV(3),IQPART,NQFREE(3)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ)
- EQUIVALENCE (LQ,IQ,LQGARB)
- COMMON // IQUEST(100),LQGARB
-C-------------- End CDE --------------------------------
- PARAMETER (NSTEP=3)
-
-
-C---- MOVE LOW BANKS
-
- IF (LQMTB.EQ.LQMTE) THEN
- LQCEND(1) = LQ(LQMTE-2)
- RETURN
- ENDIF
-
- LQCEND(1) = LQ(LQMTE-2) + LQ(LQMTE-1)
- JTB = LQMTB
- JEND = LQMTE
-
- 41 LOLD = LQ(JTB)
- LNEW = LQ(JTB+2) + LOLD
- N = LQ(JTB+1) - LOLD
- CALL UCOPY (LQ(LOLD),LQ(LNEW),N)
- JTB = JTB + NSTEP
- IF (JTB.NE.JEND) GO TO 41
- RETURN
- END
diff --git a/src/p5boot/p5lib/mqpage.f b/src/p5boot/p5lib/mqpage.f
deleted file mode 100644
index aa34949..0000000
--- a/src/p5boot/p5lib/mqpage.f
+++ /dev/null
@@ -1,14 +0,0 @@
-CDECK ID>, MQPAGE.
- SUBROUTINE MQPAGE
-
-C- Set derived page size parameters
-
- COMMON /QPAGE/ NQLMAX,NQLTOL,NQLTOK,NQCMAX,NQCPGH,NQPAGE
- +, NQWYLDO,NQWYL,NQNEWH,NQJOIN,NQDKNO,NQDKPG
-C-------------- End CDE --------------------------------
-
-
- NQLTOL = NQLMAX - 7
- NQLTOK = NQLMAX - 4
- RETURN
- END
diff --git a/src/p5boot/p5lib/mqrelc.f b/src/p5boot/p5lib/mqrelc.f
deleted file mode 100644
index 62e6d0b..0000000
--- a/src/p5boot/p5lib/mqrelc.f
+++ /dev/null
@@ -1,188 +0,0 @@
-CDECK ID>, MQRELC.
- SUBROUTINE MQRELC
-
-C- Garbage collector - Relocator
-C- only links in banks in divisions 1 and 3 need relocation
-C. started 8-oct-91
-
- COMMON /MQCM/ NQSYSS,NQLINK, LQCSTA(3),LQCEND(3), NQMAX
- +, LQLSTA(5),LQLEND(5), LQADR,LQADR0,NQOFFS
- COMMON /MQCT/ LQTA,LQTB,LQTE,LQMTB,LQMTE,LQMTH
- +, JQDIVG,NQRESV(3),IQPART,NQFREE(3)
- COMMON /MQCN/ IQLST,IQLNA,IQID,IQTY,IQLI,IQNL,IQNS,IQND
- +, IQLNX,IQFOUL
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ)
- EQUIVALENCE (LQ,IQ,LQGARB)
- COMMON // IQUEST(100),LQGARB
-C-------------- End CDE --------------------------------
- EQUIVALENCE (LS,IQLST)
-
-
- LKEEP = LQ(LQTB-2)
- LFIX = LQ(LQTE)
- NENTR = (LQTE-LQTB) / 3
- JDIV = 1
- GO TO 15
-
-C-------------- Trigger control
-
-C-- What next ?
- 12 IF (LN.EQ.0) GO TO 17
- IF (JDIV.EQ.3) RETURN
- JDIV = 3
- LN = LQCSTA(JDIV)
- LDEAD = LQCEND(JDIV)
- LSTOP = LDEAD
- IF (LN.EQ.LSTOP) GO TO 12
- IF (NENTR) 53,43,23
-
-C-- Trigger structural permanent links
- 15 L1 = 0
- L2 = 0
- LN = 0
- LSTOP= 0
- LS = NQSYSS + 1
- GO TO 19
-
-C-- Trigger working space links and division 1
- 17 LS = NQLINK + 1
- L2 = LS
- LMTB = LQMTB-3
- LN = LQ(LMTB)
- LDEAD= LQ(LMTB+1)
- LSTOP= LQCEND(1)
- 19 IF (NENTR) 54,44,24
-
-C-------------- 2 or more relocation intervals -------------
-
-C------ Next bank, check if dead group
-
- 21 IF (LN.EQ.LSTOP) GO TO 12
- IF (LN.NE.LDEAD) GO TO 23
- LMTB = LMTB + 3
- LN = LQ(LMTB)
- LDEAD= LQ(LMTB+1)
- GO TO 21
-
-C-- Next bank, alive
-
- 23 CALL QBLOW (LN)
- L2 = LS - IQNS
- L1 = LN
- LN = IQLNX
-
-C---- Next link
-
- 24 L1 = L1 + 1
- IF (L1.EQ.LS) GO TO 21
- 25 LINK = LQ(L1)
- IF (LINK.GE.LFIX) GO TO 24
- IF (LINK.LT.LKEEP) GO TO 24
-
- IF (LINK.LT.LQ(LQTB)) GO TO 31
- JLOW = 0
- JHI = NENTR + 1
-
-C-- Binary search in relocator table
-
- 27 JEX = (JHI+JLOW) / 2
- IF (JEX.EQ.JLOW) GO TO 29
- IF (LINK.GE.LQ(LQTB+3*JEX)) GO TO 28
- JHI = JEX
- GO TO 27
-
- 28 JLOW = JEX
- GO TO 27
-
- 29 JTB = LQTB + 3*JLOW
- IF (LINK.GE.LQ(JTB+1)) GO TO 31
- LQ(L1) = LINK + LQ(JTB+2)
- GO TO 24
-
-C-- Bridging for dead, structural link
- 31 IF (L1.LT.L2) GO TO 38
- LQ(L1)= LQ(LINK-1)
- GO TO 25
-
- 38 LQ(L1)= 0
- GO TO 24
-
-C-------------- 1 relocation interval only -------------
-
-C------ Next bank, check if dead group
-
- 41 IF (LN.EQ.LSTOP) GO TO 12
- IF (LN.NE.LDEAD) GO TO 43
- LMTB = LMTB + 3
- LN = LQ(LMTB)
- LDEAD= LQ(LMTB+1)
- GO TO 41
-
-C-- Next bank, alive
-
- 43 CALL QBLOW (LN)
- L2 = LS - IQNS
- L1 = LN
- LN = IQLNX
-
-C---- Next link
-
- 44 L1 = L1 + 1
- IF (L1.EQ.LS) GO TO 41
- 45 LINK = LQ(L1)
- IF (LINK.GE.LFIX) GO TO 44
- IF (LINK.LT.LKEEP) GO TO 44
-
- IF (LINK.LT.LQ(LQTB)) GO TO 47
- IF (LINK.GE.LQ(LQTB+1)) GO TO 47
- LQ(L1) = LINK + LQ(LQTB+2)
- GO TO 44
-
-C-- Bridging for dead, structural link
- 47 IF (L1.LT.L2) GO TO 48
- LQ(L1)= LQ(LINK-1)
- GO TO 45
-
- 48 LQ(L1)= 0
- GO TO 44
-
-C-------------- No relocation interval ----------------
-
-C------ Next bank, check if dead group
-
- 51 IF (LN.EQ.LSTOP) GO TO 12
- IF (LN.NE.LDEAD) GO TO 53
- LMTB = LMTB + 3
- LN = LQ(LMTB)
- LDEAD= LQ(LMTB+1)
- GO TO 51
-
-C-- Next bank, alive
-
- 53 CALL QBLOW (LN)
- L2 = LS - IQNS
- L1 = LN
- LN = IQLNX
-
-C---- Next link
-
- 54 L1 = L1 + 1
- IF (L1.EQ.LS) GO TO 51
- 55 LINK= LQ(L1)
- IF (LINK.GE.LFIX) GO TO 54
- IF (LINK.LT.LKEEP) GO TO 54
- IF (L1.LT.L2) GO TO 58
-
-C-- Bridging for dead, structural link
- 57 LINK = LQ(LINK-1)
- IF (LINK.GE.LFIX) GO TO 59
- IF (LINK.LT.LKEEP) GO TO 59
- GO TO 57
-
- 58 LQ(L1)= 0
- GO TO 54
-
- 59 LQ(L1)= LINK
- GO TO 54
- END
diff --git a/src/p5boot/p5lib/mqshift.f b/src/p5boot/p5lib/mqshift.f
deleted file mode 100644
index 7532f91..0000000
--- a/src/p5boot/p5lib/mqshift.f
+++ /dev/null
@@ -1,148 +0,0 @@
-CDECK ID>, MQSHIFT.
- SUBROUTINE MQSHIFT
-
-C- Shift the TEXT material in division 2 (PAM) supported
-C- by the banks of control division 1 starting at LQHOLD
-C- from text division 1 to division 1
-C- Called just before reading a new PAM (or PAM instalment)
-C. started 14-oct-91
-
-C- LQHOLD is the adr of the first bank created after
-C- the last shift operation
-C- it decribes the trailing lines in text division 2
-C- to be maintained in division 2, if non-zero
-
- PARAMETER (NBANKS=19,JBKPAT=1, JBKDEC=2, JBKORG=3, JBKINC=4,
- + JBKHOL=5, JBKKEE=6, JBKACT=7, JBKMAT=8, JBKXSQ=9,
- + JBKPRE=10,JBKGAR=11,JBKSMH=12,JBKSMT=13,JBKSML=14,
- + JBKSMX=15,JBKARR=16,JBKASA=17,JBKPAM=18,JBKRPA=19)
- COMMON /QBANKS/MMBANK(5,NBANKS)
- COMMON /QUNIT/ IQREAD,IQPRNT, IQTTIN,IQTYPE, IQOFFL,IQRTTY,IQRSAV
- +, IQRFD,IQRRD,IQRSIZ, NQLPAT,NQUSED,NQLLBL, NQINIT
- COMMON /MQCM/ NQSYSS,NQLINK, LQCSTA(3),LQCEND(3), NQMAX
- +, LQLSTA(5),LQLEND(5), LQADR,LQADR0,NQOFFS
- PARAMETER (IQDROP=31, IQMARK=30, KMDROP=1073741824)
- PARAMETER (KQGARB=1,KQARRV=3,KQKEEP=4,KQPREP=5,KQMAIN=6,KQPAST=8)
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- COMMON /MQCN/ IQLST,IQLNA,IQID,IQTY,IQLI,IQNL,IQNS,IQND
- +, IQLNX,IQFOUL
-C-------------- End CDE --------------------------------
-
- IOR (IZV,IZW) = OR (IZV, IZW)
-
-
-
-C---- Remove dead material if any
-
- IF (LQGARB.NE.0) CALL MQGARB
-
-C---- Shift new text material from text division 2 to 1
-
-C-- is the HOLD bank the last bank in division 1 ?
-C- in which case there is no new text material
-
- CALL QNAME (LQHOLD)
- IF (IQLNX.EQ.LQCEND(1)) THEN
- IF (IQ(LQHOLD+2).EQ.0) THEN
- JSLTO = LQLEND(1)
- GO TO 41
- ENDIF
- ENDIF
-
-C-- create the new HOLD bank
-
- LSAVE = LQHOLD
- CALL MQLIFT (LQHOLD,0,7,JBKHOL,1)
-
- IQ(LQHOLD+1) = IQ(LSAVE+1)
- IQ(LQHOLD+2) = IQ(LSAVE+2)
- IQ(LQHOLD+3) = IQ(LSAVE+3)
-
- IQ(LSAVE+1) = 0
- IQ(LSAVE+2) = 0
-
-C---- Create the linear structure of GARB banks
-
- LQCEND(2) = LQCSTA(2)
- LQPREP = 0
- KJOIN = KQPREP
-
- CALL QNAME (LSAVE)
- LQ(IQLNA) = IOR (LQ(IQLNA),KMDROP)
- LNX = IQLNX
-
-C-- do the next bank, does it have lines attached?
-
- 22 IF (LNX.GE.LQCEND(1)) GO TO 31
- CALL QBLOW (LNX)
- LNX = IQLNX
- LST = IQLST
- 24 IF (IQLI.EQ.0) GO TO 22
- JSLFR = IQ(LST+1)
- IF (JSLFR.LT.LQLSTA(2)) GO TO 22
- IF (JSLFR.GE.LQLEND(2)) GO TO 22
- NSL = IQ(LST+2)
- IF (NSL.EQ.0) THEN
- IQ(LST+1) = 0
- GO TO 22
- ENDIF
-
- CALL MQLIFT (LP,KJOIN,0,JBKGAR,2)
- KJOIN = LP - 1
- IQ(LP+1) = JSLFR
- IQ(LP+2) = LST
- GO TO 22
-
-C---- Copy the material
-
- 31 JSLTO = LQLEND(1)
- JTXTO = MLIAD(JSLTO)
- IF (LQPREP.EQ.0) GO TO 41
-
- CALL QSORTI (1,KQPREP)
-
- LP = KQPREP + 1
- 32 LP = LQ(LP-1)
- IF (LP.EQ.0) GO TO 41
- LST = IQ(LP+2)
- JSLFR = IQ(LST+1)
- NSL = IQ(LST+2)
-
- IQ(LST+1) = JSLTO
-
- JTXFR = MLIAD(JSLFR)
- NTX = MLIAD(JSLFR+NSL) - JTXFR
- NTXRE = JTXTO - JTXFR
-
- DO 34 J=1,NSL
- 34 MLIAD(JSLTO+J) = MLIAD(JSLFR+J) + NTXRE
-
- CALL CCOPYL (TEXT(JTXFR),TEXT(JTXTO),NTX)
- JTXTO = JTXTO + NTX
- JSLTO = JSLTO + NSL
- GO TO 32
-
-C-- reset end of TEXT division 1 and division 2
-
- 41 IF (IQ(LQHOLD+2).EQ.0) THEN
- LQLEND(1) = JSLTO
- LQLSTA(2) = JSLTO
- LQLEND(2) = JSLTO
- IQ(LQHOLD+1) = JSLTO
- ELSE
- LQLEND(1) = IQ(LQHOLD+1)
- LQLSTA(2) = LQLEND(1)
- LQLEND(2) = LQLSTA(2) + IQ(LQHOLD+2)
- ENDIF
- LQLSTA(3) = LQLEND(2)
- LQLEND(3) = LQLSTA(3)
- LQCEND(2) = LQCSTA(2)
- RETURN
- END
diff --git a/src/p5boot/p5lib/mqshow.f b/src/p5boot/p5lib/mqshow.f
deleted file mode 100644
index 9762847..0000000
--- a/src/p5boot/p5lib/mqshow.f
+++ /dev/null
@@ -1,59 +0,0 @@
-CDECK ID>, MQSHOW.
- SUBROUTINE MQSHOW
-
-C- Display current memory occupation
-
- COMMON /QUNIT/ IQREAD,IQPRNT, IQTTIN,IQTYPE, IQOFFL,IQRTTY,IQRSAV
- +, IQRFD,IQRRD,IQRSIZ, NQLPAT,NQUSED,NQLLBL, NQINIT
- COMMON /MQCM/ NQSYSS,NQLINK, LQCSTA(3),LQCEND(3), NQMAX
- +, LQLSTA(5),LQLEND(5), LQADR,LQADR0,NQOFFS
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
-C-------------- End CDE --------------------------------
-
-
- CALL DPBLAN (0)
- WRITE (IQPRNT,9010)
- WRITE (IQPRNT,9011) (LQCSTA(J),LQCEND(J),J=1,3)
- WRITE (IQPRNT,9012) (LQLSTA(J),LQLEND(J),J=1,5)
- WRITE (IQPRNT,9013) (MLIAD(LQLSTA(J)),MLIAD(LQLEND(J)),J=1,5)
- WRITE (IQPRNT,9014) NVGAP
- NQUSED = NQUSED + 25
- RETURN
-
- 9010 FORMAT (' Present state of memory,',
- F' start + end adrs of divisions:')
- 9011 FORMAT (
- F/' control div 1: collectable foreign material',2I9
- F/' control div 2: processing current deck ',2I9
- F/' control div 3: permanent foreign material ',2I9)
- 9012 FORMAT (
- F/' line slots of text div 1: foreign material ',2I9
- F/' line slots of text div 2: PAM file in store ',2I9
- F/' line slots of text div 3: volatile construction ',2I9
- F/' line slots of text div 4: permanent construction',2I9
- F/' line slots of text div 5: naming stack ',2I9)
- 9013 FORMAT (
- F/' text div 1: foreign material ',2I9
- F/' text div 2: PAM file in store ',2I9
- F/' text div 3: volatile construction ',2I9
- F/' text div 4: permanent construction',2I9
- F/' text div 5: naming stack ',2I9)
- 9014 FORMAT (/' Gap parameters to control garbage collection:'
- F/' Min. number of words free for control division 2',I7
- F/' Min. number of lines free for text divisions 3+4',I7
- F/' Max. number of lines expected in any deck ',I7
- F/' Mean number of characters per line ',I7/)
- END
diff --git a/src/p5boot/p5lib/mqtabl.f b/src/p5boot/p5lib/mqtabl.f
deleted file mode 100644
index 2911c40..0000000
--- a/src/p5boot/p5lib/mqtabl.f
+++ /dev/null
@@ -1,80 +0,0 @@
-CDECK ID>, MQTABL.
- SUBROUTINE MQTABL
-
-C- Garbage collector - relocation table building
-C- only banks in division 1 can be collected
-C. started 8-oct-91
-
- COMMON /MQCM/ NQSYSS,NQLINK, LQCSTA(3),LQCEND(3), NQMAX
- +, LQLSTA(5),LQLEND(5), LQADR,LQADR0,NQOFFS
- COMMON /MQCT/ LQTA,LQTB,LQTE,LQMTB,LQMTE,LQMTH
- +, JQDIVG,NQRESV(3),IQPART,NQFREE(3)
- COMMON /MQCN/ IQLST,IQLNA,IQID,IQTY,IQLI,IQNL,IQNS,IQND
- +, IQLNX,IQFOUL
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ)
- EQUIVALENCE (LQ,IQ,LQGARB)
- COMMON // IQUEST(100),LQGARB
-C-------------- End CDE --------------------------------
- EQUIVALENCE (LS,IQLST)
- PARAMETER (IQTVAL=0)
-
- ISHFTR (IZW,NZB) = ISHFT (IZW, -NZB)
-
-C---- Decide where to put the table
-
- CALL MQGETT
- LIMIT = LQTE - 8
- LQTB = LQTA + 3
- LQTE = LQTA
-
- NWFREE = 0
- IQPART = 0
- MODE = IQTVAL
- LQ(LQTA) = LQCSTA(1)
-
- LN = LQCSTA(1)
- LSTOP = LQCEND(1)
- GO TO 24
-
-C------ Next bank
-
- 21 MODE = NEW
- 22 LN = IQLNX
- 24 IF (LN.GE.LSTOP) GO TO 39
- CALL QBLOW (LN)
- NEW = ISHFTR (IQ(LN),30)
- IF (NEW.EQ.MODE) GO TO 22
- IF (NEW.EQ.IQTVAL) GO TO 36
-
-C-- start of a dead group
- LQ(LQTE+1) = LN
- LQTE = LQTE + 3
- GO TO 21
-
-C-- start of a live group
- 36 LQ(LQTE) = LN
- IF (LQTE.LT.LIMIT) GO TO 21
- MODE = IQTVAL
- IQPART = 1
-
-C------ End of table,
-C-- compute relocation constants
-
- 39 IF (MODE.EQ.IQTVAL) THEN
- LQ(LQTE+1) = LQCEND(1)
- LQTE = LQTE + 3
- ENDIF
- LQ(LQTE) = LQCEND(1)
-
- DO 44 JTB=LQTB,LQTE,3
- NWFREE = NWFREE + LQ(JTB) - LQ(JTB-2)
- 44 LQ(JTB+2) = -NWFREE
-
- LQ(LQTA+2) = 3
- NQRESV(1) = NQRESV(1) + NWFREE
- NQFREE(1) = NWFREE
- LQMTB = LQTB
- LQMTE = LQTE
- RETURN
- END
diff --git a/src/p5boot/p5lib/mqwork.f b/src/p5boot/p5lib/mqwork.f
deleted file mode 100644
index d7119f7..0000000
--- a/src/p5boot/p5lib/mqwork.f
+++ /dev/null
@@ -1,31 +0,0 @@
-CDECK ID>, MQWORK.
- SUBROUTINE MQWORK (LREF,IDATA,IDATAL)
-
-C- Set working space limits and clear wsp to zero
-
- COMMON /MQCM/ NQSYSS,NQLINK, LQCSTA(3),LQCEND(3), NQMAX
- +, LQLSTA(5),LQLEND(5), LQADR,LQADR0,NQOFFS
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
-C-------------- End CDE --------------------------------
- DIMENSION IDATA(9),IDATAL(9)
-
-
- NS = IQLOCF(LREF) - 1
- NL = IQLOCF(IDATA) - 1
- NW = IQLOCF(IDATAL) + 1
-
- NQSYSS = NS
- NQLINK = NL
-
- LQCSTA(1) = NW
- LQCEND(1) = NW
- CALL VZERO (IQUEST, NW+200)
- RETURN
- END
diff --git a/src/p5boot/p5lib/mxjoin.f b/src/p5boot/p5lib/mxjoin.f
deleted file mode 100644
index 0954b36..0000000
--- a/src/p5boot/p5lib/mxjoin.f
+++ /dev/null
@@ -1,24 +0,0 @@
-CDECK ID>, MXJOIN.
- SUBROUTINE MXJOIN (MPAT,MDEC)
-
-C- Join EXE bits from MPAT and MDEC into MDEC
-
- ISHFTL (IZW,NZB) = LSHIFT (IZW, NZB)
- ISHFTR (IZW,NZB) = ISHFT (IZW, -NZB)
- IAND (IZV,IZW) = AND (IZV, IZW)
- IOR (IZV,IZW) = OR (IZV, IZW)
-
- MOR = IOR (MPAT, MDEC)
- MAND = IAND (MPAT, MDEC)
- MINH = IAND (ISHFTR(MAND,5), 31)
-
- NEW = IAND (MINH, MOR)
- MUSE = IAND (MINH, ISHFTR(MOR,10))
- MSEL = IAND (MINH, ISHFTR(MOR,14))
-
- NEW = IOR (NEW, ISHFTL(MINH, 5))
- NEW = IOR (NEW, ISHFTL(MUSE,10))
- NEW = IOR (NEW, ISHFTL(MSEL,14))
- CALL SBYT (NEW, MDEC,1,18)
- RETURN
- END
diff --git a/src/p5boot/p5lib/mxoper.f b/src/p5boot/p5lib/mxoper.f
deleted file mode 100644
index c373fdb..0000000
--- a/src/p5boot/p5lib/mxoper.f
+++ /dev/null
@@ -1,69 +0,0 @@
-CDECK ID>, MXOPER.
- SUBROUTINE MXOPER (MERACT)
-
-C- Unpack the USE bits in MU_DECK ready for use
-C- MERACT = EXE bits from actions into the deck
-C- if zero: initial unpack, if not: merge MERACT
-C. started 3-mar-92
-
- PARAMETER (KM1=1,KM2=2,KM3=4,KM4=8,KM5=16,KM6=32,KM7=64,KM8=128,
- + KM9=256, KM10=512, KM11=1024, KM12=2048, KM13=4096, KM14=8192,
- + KM15=16384, KM16=32768, KM17=65536, KM18=131072, KM19=262144)
- CHARACTER CQDATEM*10, CQDATE*8, CQTIME*5
- COMMON /QSTATE/NQERR,NQWARN,NQINFO,NQLOCK
- +, IQDATE,IQTIME, CQDATEM,CQDATE,CQTIME
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
- COMMON /MUSEBC/ MX_FORC, MU_GLOB, MU_PAT, MU_DECK, MU_INH, MU_FORG
- +, MX_TRAN, MX_FORG, MX_SINH, MX_SELF, NVEXDK(6)
-C-------------- End CDE --------------------------------
- IAND (IZV,IZW) = AND (IZV, IZW)
- IOR (IZV,IZW) = OR (IZV, IZW)
- ISHFTR (IZW,NZB) = ISHFT (IZW, -NZB)
-
-C-- MERACT = O : initial split of MU_DECK
-
- IF (MERACT.NE.0) GO TO 21
-
- MU_FORG = IAND (MU_DECK, KM6-1)
- MU_INH = IAND (ISHFTR(MU_DECK,5), KM6-1)
- MX_TRAN = IAND (ISHFTR(MU_DECK,10), KM5-1)
- MX_FORG = IAND (MU_FORG, KM5-1)
-
- MXOR = IOR (MX_FORC,MU_DECK)
- MXAND = IAND (MX_FORC,MU_DECK)
-
- MX_SINH = IAND (ISHFTR(MXAND,5), KM5-1)
- MX_SELF = IOR (ISHFTR(MXOR,14), MX_FORG)
- GO TO 22
-
-C-- MERACT not zero, join it
-
- 21 MX_SELF = IOR (MX_SELF, MERACT)
- 22 MX_SELF = IAND (MX_SELF, MX_SINH)
-
- CALL UPKBYT (MX_SELF,1,NVEXDK,4,0)
- IF (NQERR.NE.0) NVEXDK(1)= 0
- NVEXDK(5) = NVEXDK(1) + NVEXDK(2)
- NVEXDK(6) = IAND (NVEXDK(2), MOPTIO(6))
- IF (INCRAD.LT.2) RETURN
-
-C-- ready for P=CRA*, D=blank or CRA*
- NVEXDK(1) = 0
- NVEXDK(2) = 1
- NVEXDK(5) = 1
- NVEXDK(6) = 1
- RETURN
- END
diff --git a/src/p5boot/p5lib/na_chk.f b/src/p5boot/p5lib/na_chk.f
deleted file mode 100644
index 5f8b273..0000000
--- a/src/p5boot/p5lib/na_chk.f
+++ /dev/null
@@ -1,50 +0,0 @@
-CDECK ID>, NA_CHK.
- FUNCTION NA_CHK (LINE,JL,JR)
-
-C- Find the P/D/Z name in LINE(JL:JR-1) and return its relative adr
-C- or -1 if not found
-C- NDSLAT returns the length of the name
-C. started 1-oct-91
-
- COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT,NUSLAT(2),DUMMY(34)
- COMMON /MQCM/ NQSYSS,NQLINK, LQCSTA(3),LQCEND(3), NQMAX
- +, LQLSTA(5),LQLEND(5), LQADR,LQADR0,NQOFFS
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- COMMON /NAMEC/ NA_OCC, NA_CUT, NA_MXSL, NA_MXTX
-C-------------- End CDE --------------------------------
- CHARACTER LINE*512, NAMEOP*64
-
-
- NN = MIN (64, JR-JL)
- IF (NN.NE.0) THEN
- NAMEOP(1:NN) = LINE(JL:JL+NN-1)
- CALL CLEFT (NAMEOP,1,NN)
- NN = MIN (NDSLAT, NA_CUT)
- ENDIF
-
-C---- Find the name
-
- JSL = LQLSTA(5)
- IF (NN.EQ.0) GO TO 29
- 24 JSL = JSL + 1
- IF (JSL.GT.NA_OCC) GO TO 91
- JTX = MLIAD(JSL)
- NTX = MLIAD(JSL+1) - JTX
- IF (NTX.NE.NN) GO TO 24
- IF (ICEQU(NAMEOP,TEXT(JTX),NN) .NE.0) GO TO 24
-
- 29 NA_CHK = JSL - LQLSTA(5)
- NDSLAT = NN
- RETURN
-
- 91 NA_CHK = -1
- NDSLAT = NN
- RETURN
- END
diff --git a/src/p5boot/p5lib/na_dif.f b/src/p5boot/p5lib/na_dif.f
deleted file mode 100644
index 9f5ccd1..0000000
--- a/src/p5boot/p5lib/na_dif.f
+++ /dev/null
@@ -1,40 +0,0 @@
-CDECK ID>, NA_DIF.
- FUNCTION NA_DIF (JNA,JNB)
-
-C- Compare NAMEA at JNA with NAMEB at JNB,
-C- return zero if NAMEA = NAMEB
-C- -1 if NAMEA < NAMEB
-C- +1 if NAMEA > NAMEB
-C. started 12-feb-92
-
- COMMON /MQCM/ NQSYSS,NQLINK, LQCSTA(3),LQCEND(3), NQMAX
- +, LQLSTA(5),LQLEND(5), LQADR,LQADR0,NQOFFS
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- COMMON /NAMEC/ NA_OCC, NA_CUT, NA_MXSL, NA_MXTX
-C-------------- End CDE --------------------------------
-
-
- IF (JNA.EQ.JNB) THEN
- NA_DIF = 0
- RETURN
- ENDIF
-
- JSLA = JNA + LQLSTA(5)
- JSLB = JNB + LQLSTA(5)
-
- JTXA = MLIAD(JSLA)
- JTXB = MLIAD(JSLB)
-
- NTXA = MLIAD(JSLA+1) - JTXA
- NTXB = MLIAD(JSLB+1) - JTXB
-
- NA_DIF = NA_XCO (TEXT(JTXA),TEXT(JTXB),NTXA,NTXB)
- RETURN
- END
diff --git a/src/p5boot/p5lib/na_dump.f b/src/p5boot/p5lib/na_dump.f
deleted file mode 100644
index 7e42a9a..0000000
--- a/src/p5boot/p5lib/na_dump.f
+++ /dev/null
@@ -1,85 +0,0 @@
-CDECK ID>, NA_DUMP.
- SUBROUTINE NA_DUMP
-
-C- Dump the NAME stack
-
- COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT,NUSLAT(2),DUMMY(34)
- COMMON /QUNIT/ IQREAD,IQPRNT, IQTTIN,IQTYPE, IQOFFL,IQRTTY,IQRSAV
- +, IQRFD,IQRRD,IQRSIZ, NQLPAT,NQUSED,NQLLBL, NQINIT
- COMMON /MQCM/ NQSYSS,NQLINK, LQCSTA(3),LQCEND(3), NQMAX
- +, LQLSTA(5),LQLEND(5), LQADR,LQADR0,NQOFFS
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- COMMON /NAMEC/ NA_OCC, NA_CUT, NA_MXSL, NA_MXTX
-C-------------- End CDE --------------------------------
- CHARACTER NAMEOP*80
-
-
- WRITE (IQPRNT,9011) LQLSTA(5), NA_OCC, NA_CUT
- 9011 FORMAT (/'1Dump the NAME stack, start/end/cutat =',2I7,I3)
-
- IF (NA_OCC.EQ.0) RETURN
-
- IF (LQLSTA(5).LT.LQLEND(4)) GO TO 84
- IF (NA_OCC.LT.LQLSTA(5)) GO TO 84
- IF (NA_CUT.LT.6) GO TO 84
- IF (NA_CUT.GT.32) GO TO 84
-
- JSL = LQLSTA(5)
- JSLE = NA_OCC + 1
- JTX = MLIAD(JSL)
- JTXE = MLIAD(JSLE)
-
- NSLOCC = JSLE - JSL
- NTXOCC = JTXE - JTX
- NSLAV = LQLEND(5) - JSL
- NTXAV = NSIZETX - JTX
-
- NSLPRO = (100 * NSLOCC) / NSLAV
- NTXPRO = (100 * NTXOCC) / NTXAV
-
- WRITE (IQPRNT,9017) NTXOCC,NTXPRO,NTXAV,JTX,
- + NSLOCC,NSLPRO,NSLAV
- 9017 FORMAT (/
- F8X,'Name text ',I7,' or',I3,'% used of',I7,' bytes maximum at',I9/
- F8X,'Name slots',I7,' or',I3,'% used of',I7,' maximum'//
- F7X,'J JSL JTX N name'/)
-
- JNA = 0
- 44 JTX = MLIAD(JSL)
- NTX = MLIAD(JSL+1) - JTX
- IF (NTX.LE.0) GO TO 81
-
- NAMEOP = ' '
- CALL NA_GET (JNA,NAMEOP,1)
- IF (NDSLAT.NE.NTX) GO TO 82
-
- WRITE (IQPRNT,9044) JNA,JSL,JTX,NTX,NAMEOP(1:NTX+1)
- 9044 FORMAT (1X,2I7,I9,I3,2X,A)
-
- IF (JSL.EQ.NA_OCC) RETURN
- JSL = JSL + 1
- JNA = JNA + 1
- GO TO 44
-
-C---- Trouble
-
- 81 WRITE (IQPRNT,9081) JNA,JSL,JTX,NTX
- RETURN
-
- 82 WRITE (IQPRNT,9082) JNA,JSL,JTX,NTX,NDSLAT
- RETURN
-
- 84 WRITE (IQPRNT,9084)
- RETURN
-
- 9081 FORMAT (1X,2I7,I9,I3,' ***!!! faulty !!!***')
- 9082 FORMAT (1X,2I7,I9,2I3,' ***!!! faulty !!!***')
- 9084 FORMAT (40X,'***!!! Faulty !!!***')
- END
diff --git a/src/p5boot/p5lib/na_ful.f b/src/p5boot/p5lib/na_ful.f
deleted file mode 100644
index 4ed5073..0000000
--- a/src/p5boot/p5lib/na_ful.f
+++ /dev/null
@@ -1,43 +0,0 @@
-CDECK ID>, NA_FUL.
- SUBROUTINE NA_FUL
-
-C- Name stack full
-C. started 22-jan-92
-
- COMMON /QUNIT/ IQREAD,IQPRNT, IQTTIN,IQTYPE, IQOFFL,IQRTTY,IQRSAV
- +, IQRFD,IQRRD,IQRSIZ, NQLPAT,NQUSED,NQLLBL, NQINIT
- COMMON /MQCM/ NQSYSS,NQLINK, LQCSTA(3),LQCEND(3), NQMAX
- +, LQLSTA(5),LQLEND(5), LQADR,LQADR0,NQOFFS
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- COMMON /NAMEC/ NA_OCC, NA_CUT, NA_MXSL, NA_MXTX
-C-------------- End CDE --------------------------------
-
-
- JSL = LQLSTA(5)
- JSLE = NA_OCC + 1
- JTX = MLIAD(JSL)
- JTXE = MLIAD(JSLE)
-
- NSLOCC = JSLE - JSL
- NTXOCC = JTXE - JTX
- NSLAV = LQLEND(5) - JSL
- NTXAV = NSIZETX - JTX
-
- NSLPRO = (100 * NSLOCC) / NSLAV
- NTXPRO = (100 * NTXOCC) / NTXAV
-
- WRITE (IQPRNT,9082) NTXOCC,NTXPRO,NTXAV,
- + NSLOCC,NSLPRO,NSLAV
- 9082 FORMAT (/' ***!!! Name space full !!!***'/
- F5X,'Name text ',I7,' or',I3,'% used of',I7,' bytes maximum'/
- F5X,'Name slots',I7,' or',I3,'% used of',I7,' maximum')
-
- CALL NOSPACE ('-')
- END
diff --git a/src/p5boot/p5lib/na_get.f b/src/p5boot/p5lib/na_get.f
deleted file mode 100644
index c6cf10b..0000000
--- a/src/p5boot/p5lib/na_get.f
+++ /dev/null
@@ -1,36 +0,0 @@
-CDECK ID>, NA_GET.
- SUBROUTINE NA_GET (JNA,LINE,JCL)
-
-C- Transfer the text of name JNA into LINE at col. JCL
-C. started 1-oct-91
-
- COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT,NUSLAT(2),DUMMY(34)
- COMMON /MQCM/ NQSYSS,NQLINK, LQCSTA(3),LQCEND(3), NQMAX
- +, LQLSTA(5),LQLEND(5), LQADR,LQADR0,NQOFFS
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- COMMON /NAMEC/ NA_OCC, NA_CUT, NA_MXSL, NA_MXTX
-C-------------- End CDE --------------------------------
- CHARACTER LINE*(*)
-
-
- JSL = JNA + LQLSTA(5)
- IF (JNA.LT.0 .OR. JSL.GT.NA_OCC)
- + CALL P_CRASH ('name-index out of range')
- JTX = MLIAD(JSL)
- NTX = MLIAD(JSL+1) - JTX
- N = MIN (NTX, LEN(LINE)+1-JCL)
-
- CALL CCOPYL (TEXT(JTX),LINE(JCL:),N)
-
- NDSLAT = N
- NESLAT = JCL + N
- NFSLAT = NTX
- RETURN
- END
diff --git a/src/p5boot/p5lib/na_init.f b/src/p5boot/p5lib/na_init.f
deleted file mode 100644
index bc27ce2..0000000
--- a/src/p5boot/p5lib/na_init.f
+++ /dev/null
@@ -1,46 +0,0 @@
-CDECK ID>, NA_INIT.
- SUBROUTINE NA_INIT
-
-C- Pre-initialize the name stack
-C. started 1-oct-91
-
- COMMON /MQCM/ NQSYSS,NQLINK, LQCSTA(3),LQCEND(3), NQMAX
- +, LQLSTA(5),LQLEND(5), LQADR,LQADR0,NQOFFS
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- COMMON /NAMEC/ NA_OCC, NA_CUT, NA_MXSL, NA_MXTX
-C-------------- End CDE --------------------------------
-
-
- NA_CUT = 32
- NA_MXSL = 6000
- NA_MXTX = 8 * NA_MXSL
-
- JSLA = LQLEND(5) - NA_MXSL
- JTXA = NSIZETX - NA_MXTX
-
- LQLSTA(5) = JSLA
- LQLEND(4) = JSLA
- LQLSTA(4) = JSLA
-
-C-- preset slot 0 one blank
-C- 1 unknown
-
- TEXT(JTXA) = ' '
- MLIAD(JSLA) = JTXA
- MLIAD(JSLA+1) = JTXA + 1
-
- JTXA = JTXA + 1
- JSLA = JSLA + 1
-
- CALL CCOPYL ('unknown', TEXT(JTXA), 7)
- MLIAD(JSLA+1) = JTXA + 7
- NA_OCC = JSLA
- RETURN
- END
diff --git a/src/p5boot/p5lib/na_inpy.f b/src/p5boot/p5lib/na_inpy.f
deleted file mode 100644
index d6aeb2f..0000000
--- a/src/p5boot/p5lib/na_inpy.f
+++ /dev/null
@@ -1,33 +0,0 @@
-CDECK ID>, NA_INPY.
- SUBROUTINE NA_INPY
-
-C- Pre-set the name stack for Patchy
-C. started 19-july-93
-
- COMMON /NAMEC/ NA_OCC, NA_CUT, NA_MXSL, NA_MXTX
-C-------------- End CDE --------------------------------
-
-C-- preset slot (0 one blank)
-C- (1 unknown)
-C- 2 CRA*
-
-
- CALL NA_LONG ('CRA*')
- CALL NA_LONG ('QCARD1')
- CALL NA_LONG ('QEJECT')
- CALL NA_LONG ('QFTITLE')
- CALL NA_LONG ('QFTITLCH')
- CALL NA_LONG ('QFHEAD')
- CALL NA_LONG ('QFNAME')
- CALL NA_LONG ('QFVERS')
- CALL NA_LONG ('QFVSNUM')
- CALL NA_LONG ('QFVPRIM')
- CALL NA_LONG ('QFVSEC')
- CALL NA_LONG ('QDATE')
- CALL NA_LONG ('QTIME')
- CALL NA_LONG ('QENVIR')
- CALL NA_LONG ('QTERMHD')
- CALL NA_LONG ('DATEQQ')
- CALL NA_LONG ('TIMEQQ')
- RETURN
- END
diff --git a/src/p5boot/p5lib/na_jtx.f b/src/p5boot/p5lib/na_jtx.f
deleted file mode 100644
index ff51c58..0000000
--- a/src/p5boot/p5lib/na_jtx.f
+++ /dev/null
@@ -1,31 +0,0 @@
-CDECK ID>, NA_JTX.
- FUNCTION NA_JTX (JNA)
-
-C- Get the start adr of the text of name JNA
-C. started 27-jan-92
-
- COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT,NUSLAT(2),DUMMY(34)
- COMMON /MQCM/ NQSYSS,NQLINK, LQCSTA(3),LQCEND(3), NQMAX
- +, LQLSTA(5),LQLEND(5), LQADR,LQADR0,NQOFFS
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- COMMON /NAMEC/ NA_OCC, NA_CUT, NA_MXSL, NA_MXTX
-C-------------- End CDE --------------------------------
-
-
- JSL = JNA + LQLSTA(5)
- IF (JNA.LT.0 .OR. JSL.GT.NA_OCC)
- + CALL P_CRASH ('name-index out of range')
- JTX = MLIAD(JSL)
- NTX = MLIAD(JSL+1) - JTX
-
- NDSLAT = NTX
- NA_JTX = JTX
- RETURN
- END
diff --git a/src/p5boot/p5lib/na_long.f b/src/p5boot/p5lib/na_long.f
deleted file mode 100644
index 0588f1a..0000000
--- a/src/p5boot/p5lib/na_long.f
+++ /dev/null
@@ -1,56 +0,0 @@
-CDECK ID>, NA_LONG.
- FUNCTION NA_LONG (NAMEOP)
-
-C- Register long string in NAMEOP as is and return its adr
-C- NDSLAT returns the length of the name
-C. started 1-oct-91
-
- COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT,NUSLAT(2),DUMMY(34)
- COMMON /MQCM/ NQSYSS,NQLINK, LQCSTA(3),LQCEND(3), NQMAX
- +, LQLSTA(5),LQLEND(5), LQADR,LQADR0,NQOFFS
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- COMMON /NAMEC/ NA_OCC, NA_CUT, NA_MXSL, NA_MXTX
-C-------------- End CDE --------------------------------
- CHARACTER NAMEOP*(*)
-
-
-C---- Find the name if it exists already
-
- NN = LNBLNK(NAMEOP)
- JSL = LQLSTA(5)
- IF (NN.EQ.0) GO TO 999
-
- 24 JTX = MLIAD(JSL)
- NTX = MLIAD(JSL+1) - JTX
- IF (NTX.EQ.NN) THEN
- IF (ICEQU(NAMEOP,TEXT(JTX),NN) .EQ.0) GO TO 999
- ENDIF
-
- JSL = JSL + 1
- IF (JSL.LE.NA_OCC) GO TO 24
-
-C---- Name does not exist, enter it
-
- IF (JSL+1 .GE.LQLEND(5)) GO TO 81
- JTX = MLIAD(JSL)
- IF (JTX+NN+8.GE.NSIZETX) GO TO 81
-
- CALL CCOPYL (NAMEOP,TEXT(JTX),NN)
- MLIAD(JSL+1) = JTX + NN
- NA_OCC = JSL
- 999 NDSLAT = NN
- NA_LONG = JSL - LQLSTA(5)
- RETURN
-
-C---- Space full
-
- 81 CALL NA_FUL
- NA_LONG = 0
- END
diff --git a/src/p5boot/p5lib/na_new.f b/src/p5boot/p5lib/na_new.f
deleted file mode 100644
index cbe6460..0000000
--- a/src/p5boot/p5lib/na_new.f
+++ /dev/null
@@ -1,68 +0,0 @@
-CDECK ID>, NA_NEW.
- FUNCTION NA_NEW (LINE,JL,JR)
-
-C- Register the P/D/Z name in LINE(JL:JR-1) and return its adr
-C- NDSLAT returns the length of the name
-C. started 1-oct-91
-
- COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT,NUSLAT(2),DUMMY(34)
- COMMON /MQCM/ NQSYSS,NQLINK, LQCSTA(3),LQCEND(3), NQMAX
- +, LQLSTA(5),LQLEND(5), LQADR,LQADR0,NQOFFS
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- COMMON /NAMEC/ NA_OCC, NA_CUT, NA_MXSL, NA_MXTX
-C-------------- End CDE --------------------------------
- CHARACTER LINE*512, NAMEOP*64
-
-
- NN = MIN (64, JR-JL)
- IF (NN.LE.0) GO TO 49
-
- NAMEOP(1:NN) = LINE(JL:JL+NN-1)
- CALL CLEFT (NAMEOP,1,NN)
- NN = MIN (NDSLAT, NA_CUT)
- IF (NN.EQ.0) GO TO 49
-
-
-C---- Find the name if it exists already
-
- JSL = LQLSTA(5) + 1
- 24 JTX = MLIAD(JSL)
- NTX = MLIAD(JSL+1) - JTX
- IF (NTX.EQ.NN) THEN
- IF (ICEQU(NAMEOP,TEXT(JTX),NN) .EQ.0) GO TO 29
- ENDIF
-
- JSL = JSL + 1
- IF (JSL.LE.NA_OCC) GO TO 24
-
-C---- Name does not exist, enter it
-
- IF (JSL+1 .GE.LQLEND(5)) GO TO 81
- JTX = MLIAD(JSL)
- IF (JTX+NN+8.GE.NSIZETX) GO TO 81
-
- CALL CCOPYL (NAMEOP,TEXT(JTX),NN)
- MLIAD(JSL+1) = JTX + NN
- NA_OCC = JSL
- 29 NDSLAT = NN
- NA_NEW = JSL - LQLSTA(5)
- RETURN
-
-C-- Zero-length string
-
- 49 NDSLAT = 0
- NA_NEW = 0
- RETURN
-
-C---- Space full
-
- 81 CALL NA_FUL
- NA_NEW = 0
- END
diff --git a/src/p5boot/p5lib/na_prix.f b/src/p5boot/p5lib/na_prix.f
deleted file mode 100644
index 43757a2..0000000
--- a/src/p5boot/p5lib/na_prix.f
+++ /dev/null
@@ -1,24 +0,0 @@
-CDECK ID>, NA_PRIX.
- SUBROUTINE NA_PRIX (MSG,IX)
-
-C- Print content of index IX with message
-C. started 7-june-94
-
- COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT,NUSLAT(2),DUMMY(34)
- CHARACTER SLLINE*512, SLERRM*256
- COMMON /SLATLN/ SLLINE, SLERRM
- COMMON /QUNIT/ IQREAD,IQPRNT, IQTTIN,IQTYPE, IQOFFL,IQRTTY,IQRSAV
- +, IQRFD,IQRRD,IQRSIZ, NQLPAT,NQUSED,NQLLBL, NQINIT
-C-------------- End CDE --------------------------------
- CHARACTER LINE*128, MSG*(*)
- EQUIVALENCE (LINE,SLERRM)
-
-
- CALL NA_GET (IX,LINE,1)
-
- WRITE (IQPRNT,9001) MSG,LINE(1:NDSLAT)
- NQUSED = NQUSED + 1
- NQLLBL = 0
- 9001 FORMAT (A,A)
- RETURN
- END
diff --git a/src/p5boot/p5lib/na_rein.f b/src/p5boot/p5lib/na_rein.f
deleted file mode 100644
index 1bcfdbb..0000000
--- a/src/p5boot/p5lib/na_rein.f
+++ /dev/null
@@ -1,78 +0,0 @@
-CDECK ID>, NA_REIN.
- SUBROUTINE NA_REIN
-
-C- Re-initialize the name stack
-C- for c/l +NAMES, length, slots, text
-C. started 1-oct-91
-
- CHARACTER CCKORG*256, CCKARD*256, CCCOMF*256
- COMMON /CCPARA/NCHCCD,NCHCCT, JCCTYP,JCCLEV,JCCSL,MCCPAR(240)
- +, NCCPAR,MXCCIF,JCCIFV,JCCBAD,JCCWAR,ICCSUB,JCCWK(4)
- +, JCCPP,JCCPD,JCCPZ,JCCPT,JCCPIF,JCCPC,JCCPN
- +, NCCPP,NCCPD,NCCPZ,NCCPT,NCCPIF,NCCPC,NCCPN
- +, JCCEND, NCHCCC,IXCCC, CCKORG, CCKARD, CCCOMF
- COMMON /MQCM/ NQSYSS,NQLINK, LQCSTA(3),LQCEND(3), NQMAX
- +, LQLSTA(5),LQLEND(5), LQADR,LQADR0,NQOFFS
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- COMMON /NAMEC/ NA_OCC, NA_CUT, NA_MXSL, NA_MXTX
-C-------------- End CDE --------------------------------
-
-
- IF (NCCPN.EQ.0) RETURN
-
- NLE = MCCPAR(JCCPN+1)
- NSL = 0
- NTX = 0
- IF (NCCPN.GE.2) NSL = MCCPAR(JCCPN+4)
- IF (NCCPN.GE.3) NTX = MCCPAR(JCCPN+7)
-
- IF (NLE.GT.0) NA_CUT = NLE
- IF (NSL.GT.0) NA_MXSL = NSL
-
- NA_CUT = MAX (NA_CUT, 8)
- NA_CUT = MIN (NA_CUT, 32)
- NA_MXSL = MAX (NA_MXSL,200)
-
- IF (NTX.GT.0) THEN
- NA_MXTX = NTX
- ELSE
- NA_MXTX = 8 * NA_MXSL
- ENDIF
- NA_MXTX = MAX (NA_MXTX,1200)
-
- JSLN = LQLEND(5) - NA_MXSL
- JTXN = NSIZETX - NA_MXTX
-
- JSLO = LQLSTA(5)
- JTXO = MLIAD(JSLO)
- NSL = NA_OCC +1 - JSLO
- NTX = MLIAD(NA_OCC+1) - JTXO
- NSH = JTXN - JTXO
-
- CALL UCOPY2 (MLIAD(JSLO),MLIAD(JSLN), NSL+1)
-
- IF (NSH.EQ.0) GO TO 29
-
- IF (NSH.LT.0) THEN
- CALL CCOPYL (TEXT(JTXO),TEXT(JTXN),NTX)
- ELSE
- CALL CCOPYR (TEXT(JTXO),TEXT(JTXN),NTX)
- ENDIF
-
- DO 24 J=JSLN,JSLN+NSL
- 24 MLIAD(J) = MLIAD(J) + NSH
-
- 29 LQLSTA(5) = JSLN
- LQLEND(4) = JSLN
- LQLSTA(4) = JSLN
- NA_OCC = JSLN + NSL -1
-
- RETURN
- END
diff --git a/src/p5boot/p5lib/na_xco.f b/src/p5boot/p5lib/na_xco.f
deleted file mode 100644
index 0126b68..0000000
--- a/src/p5boot/p5lib/na_xco.f
+++ /dev/null
@@ -1,42 +0,0 @@
-CDECK ID>, NA_XCO.
- FUNCTION NA_XCO (NAMEA,NAMEB,NCHA,NCHB)
-
-C- Compare NAMEA(1:NCH) with NAMEB(1:NCH),
-C- return zero if NAMEA = NAMEB
-C- -1 if NAMEA < NAMEB
-C- +1 if NAMEA > NAMEB
-C- internal routine called only from NA_DIFF
-
- CHARACTER*512 NAMEA, NAMEB
-
- JVAL = 0
- NCH = MIN (NCHA,NCHB)
- IF (NCH.EQ.0) THEN
- IF (NCHA.EQ.NCHB) GO TO 49
- IF (NCHA.LT.NCHB) THEN
- JVAL = -1
- ELSE
- JVAL = 1
- ENDIF
- GO TO 49
- ENDIF
-
- IF (NAMEA(1:NCH) .EQ. NAMEB(1:NCH)) THEN
- IF (NCHA.EQ.NCHB) GO TO 49
- IF (NCHA.LT.NCHB) THEN
- JVAL = -1
- ELSE
- JVAL = 1
- ENDIF
- GO TO 49
- ENDIF
-
- IF (LLT(NAMEA(1:NCH),NAMEB(1:NCH))) THEN
- JVAL = -1
- ELSE
- JVAL = 1
- ENDIF
-
- 49 NA_XCO = JVAL
- RETURN
- END
diff --git a/src/p5boot/p5lib/nextcc.f b/src/p5boot/p5lib/nextcc.f
deleted file mode 100644
index 1d4d294..0000000
--- a/src/p5boot/p5lib/nextcc.f
+++ /dev/null
@@ -1,46 +0,0 @@
-CDECK ID>, NEXTCC.
- SUBROUTINE NEXTCC (CHCC,JSLA,JSLE,JSLF,JTYPEF)
-
-C- Find next Patchy c/c line in line-range JSLA to JSLE-1
-C- having control-character CHCC in column 1
-
-C- return type number JTYPEF and JSLF if found
-C- return JTYPEF=zero and JSLF=JSLE if not found
-
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB
-C-------------- End CDE --------------------------------
- CHARACTER CHCC*1, CHCCU*1
-
-
- CHCCU = CHCC
- JSL = JSLA -1
-
-C-- next line
-
- 11 JSL = JSL + 1
- IF (JSL.GE.JSLE) GO TO 98
- JTX = MLIAD(JSL)
- IF (TEXT(JTX).NE.CHCCU) GO TO 11
- NTX = MLIAD(JSL+1) - JTX - NCHNEWL
- IF (NTX.LT.4) GO TO 11
-
- JTYPE = JPTYPE (TEXT(JTX))
- IF (JTYPE.EQ.0) GO TO 11
-
-C---- return
-
- JTYPEF = JTYPE
- JSLF = JSL
- RETURN
-
- 98 JTYPEF = 0
- JSLF = JSLE
- RETURN
- END
diff --git a/src/p5boot/p5lib/nextde.f b/src/p5boot/p5lib/nextde.f
deleted file mode 100644
index e4a3420..0000000
--- a/src/p5boot/p5lib/nextde.f
+++ /dev/null
@@ -1,84 +0,0 @@
-CDECK ID>, NEXTDE.
- SUBROUTINE NEXTDE (JSLA,JSLE,JSLF,JTYPEF,NHOW)
-
-C- Find next line +DECK, etc. in line-range JSLA to JSLE-1
-C- NHOW = 0 scanning for PAM, look at first 3 keys
-C- >0 scanning for cradle, look at all keys, ignore +TITle
-C- =3 blank deck of the cradle, recognize +MORE
-C- <0 look at first -NHOW keys
-
-C- return JTYPEF 1,2,3(,4,5) and JSLF if found
-C- return JTYPEF -13 if line +MORE in the blank deck of the cradle
-C- return JTYPEF zero if not found
-
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB
-C-------------- End CDE --------------------------------
- PARAMETER (NPOSSA=6)
- CHARACTER POSS(NPOSSA)*4
- DATA POSS / '+DEC', '+PAT', '+TIT', '+PAM', '+QUI', '+MOR' /
-
-
- IF (NHOW.EQ.0) THEN
- NPOSX = 3
- ELSEIF (NHOW.EQ.3) THEN
- NPOSX = 6
- ELSEIF (NHOW.GT.0) THEN
- NPOSX = 5
- ELSE
- NPOSX = -NHOW
- ENDIF
-
-C-- next line
-
- JSL = JSLA - 1
- 11 JSL = JSL + 1
- IF (JSL.GE.JSLE) GO TO 98
- JTGO = MLIAD(JSL)
- IF (TEXT(JTGO).NE.'+') GO TO 11
- NTX = MLIAD(JSL+1) - JTGO - NCHNEWL
- IF (NTX.LT.4) GO TO 11
-
-C-- next possibility
-
- JPOSS = 0
- 21 JPOSS = JPOSS + 1
- IF (JPOSS.GT.NPOSX) GO TO 11
- JTX = JTGO + 1
- JC = 2
- IVP = ICHAR(POSS(JPOSS)(2:2))
- 22 IVT = ICHAR(TEXT(JTX))
- IF (IVT.NE.IVP) THEN
- IF (IVT-IVP.NE.32) GO TO 21
- ENDIF
- IF (JC.EQ.4) GO TO 28
- JTX = JTX + 1
- JC = JC + 1
- IVP = ICHAR(POSS(JPOSS)(JC:JC))
- GO TO 22
-
-C---- return
-
- 28 IF (NPOSX.GE.5) GO TO 29
- JSLF = JSL
- JTYPEF = JPOSS
- RETURN
-
-C-- cradle
-
- 29 IF (JPOSS.EQ.3) GO TO 11
- IF (JPOSS.EQ.6) JPOSS= -13
- JSLF = JSL
- JTYPEF = JPOSS
- RETURN
-
- 98 JSLF = JSLE
- JTYPEF = 0
- RETURN
- END
diff --git a/src/p5boot/p5lib/nextsi.f b/src/p5boot/p5lib/nextsi.f
deleted file mode 100644
index 6fa4445..0000000
--- a/src/p5boot/p5lib/nextsi.f
+++ /dev/null
@@ -1,72 +0,0 @@
-CDECK ID>, NEXTSI.
- SUBROUTINE NEXTSI (JSLA,JTYPEF,NHOW)
-
-C- Check single line at JSLA is a header +DECK, etc.
-C- NHOW = 0 scanning for PAM, look at first 3 keys
-C- >0 scanning for cradle, look at all keys, ignore +TITle
-C- =3: blank deck of cradle, +MORE allowed
-
-C- return JTYPEF 1,2,3(,4,5) if found
-C- return JTYPEF -13 if line +MORE in the blank deck of the cradle
-C- return JTYPEF zero if not found
-
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB
-C-------------- End CDE --------------------------------
- PARAMETER (NPOSSA=6)
- CHARACTER POSS(NPOSSA)*4
- DATA POSS / '+DEC', '+PAT', '+TIT', '+PAM', '+QUI', '+MOR' /
-
-
- IF (NHOW.EQ.0) THEN
- NPOSX = 3
- ELSEIF (NHOW.EQ.3) THEN
- NPOSX = 6
- ELSE
- NPOSX = 5
- ENDIF
-
- JSL = JSLA
- JTGO = MLIAD(JSL)
- IF (TEXT(JTGO).NE.'+') GO TO 98
-
-C-- next possibility
-
- JPOSS = 0
- 21 JPOSS = JPOSS + 1
- IF (JPOSS.GT.NPOSX) GO TO 98
- JTX = JTGO + 1
- JC = 2
- IVP = ICHAR(POSS(JPOSS)(2:2))
- 22 IVT = ICHAR(TEXT(JTX))
- IF (IVT.NE.IVP) THEN
- IF (IVT-IVP.NE.32) GO TO 21
- ENDIF
- IF (JC.EQ.4) GO TO 28
- JTX = JTX + 1
- JC = JC + 1
- IVP = ICHAR(POSS(JPOSS)(JC:JC))
- GO TO 22
-
-C---- return
-
- 28 IF (NPOSX.GE.5) GO TO 29
- JTYPEF = JPOSS
- RETURN
-
-C-- cradle
-
- 29 IF (JPOSS.EQ.3) GO TO 98
- IF (JPOSS.EQ.6) JPOSS= -13
- JTYPEF = JPOSS
- RETURN
-
- 98 JTYPEF = 0
- RETURN
- END
diff --git a/src/p5boot/p5lib/nextxx.f b/src/p5boot/p5lib/nextxx.f
deleted file mode 100644
index b80b3ee..0000000
--- a/src/p5boot/p5lib/nextxx.f
+++ /dev/null
@@ -1,51 +0,0 @@
-CDECK ID>, NEXTXX.
- SUBROUTINE NEXTXX (KEY,JSLA,JSLE,JSLF)
-
-C- Find next line with key= +XXX in line-range JSLA to JSLE-1
-C- return JSLF if found, JSLF =zero if not found
-
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB
-C-------------- End CDE --------------------------------
- CHARACTER KEY*4, UKEY*4
-
-
- UKEY = KEY
- JSL = JSLA - 1
-
-C-- next line
-
- 11 JSL = JSL + 1
- IF (JSL.GE.JSLE) GO TO 98
- JTX = MLIAD(JSL)
- IF (TEXT(JTX).NE.'+') GO TO 11
- NTX = MLIAD(JSL+1) - JTX - NCHNEWL
- IF (NTX.LT.4) GO TO 11
-
- JTX = JTX + 1
- JKY = 2
- IVK = ICHAR(UKEY(2:2))
- 22 IVT = ICHAR(TEXT(JTX))
- IF (IVT.NE.IVK) THEN
- IF (IVT-IVK.NE.32) GO TO 11
- ENDIF
- IF (JKY.EQ.4) GO TO 29
- JTX = JTX + 1
- JKY = JKY + 1
- IVK = ICHAR(UKEY(JKY:JKY))
- GO TO 22
-
-C---- return
-
- 29 JSLF = JSL
- RETURN
-
- 98 JSLF = 0
- RETURN
- END
diff --git a/src/p5boot/p5lib/nospace.f b/src/p5boot/p5lib/nospace.f
deleted file mode 100644
index 4fcf007..0000000
--- a/src/p5boot/p5lib/nospace.f
+++ /dev/null
@@ -1,19 +0,0 @@
-CDECK ID>, NOSPACE.
- SUBROUTINE NOSPACE (ERRM)
-
- COMMON /QUNIT/ IQREAD,IQPRNT, IQTTIN,IQTYPE, IQOFFL,IQRTTY,IQRSAV
- +, IQRFD,IQRRD,IQRSIZ, NQLPAT,NQUSED,NQLLBL, NQINIT
-C-------------- End CDE --------------------------------
- CHARACTER ERRM*(*)
-
- IF (ERRM(1:1).NE.'-') THEN
- WRITE (IQPRNT,9001) ERRM
- IF (IQPRNT.NE.IQTYPE) WRITE (IQTYPE,9001) ERRM
- ENDIF
-
- CALL MQSHOW
-
- CALL P_KILL ('Space full')
-
- 9001 FORMAT (/'***!!! Memory problem because ',A)
- END
diff --git a/src/p5boot/p5lib/nqcount.f b/src/p5boot/p5lib/nqcount.f
deleted file mode 100644
index ad43dbd..0000000
--- a/src/p5boot/p5lib/nqcount.f
+++ /dev/null
@@ -1,23 +0,0 @@
-CDECK ID>, NQCOUNT.
- FUNCTION NQCOUNT (LGO)
-
-C- Count the number of banks in the linear structure
-
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ)
- EQUIVALENCE (LQ,IQ,LQGARB)
- COMMON // IQUEST(100),LQGARB
-C-------------- End CDE --------------------------------
-
-
- N = 0
- L = LGO
- 24 IF (L.NE.0) THEN
- N = N + 1
- L = LQ(L-1)
- GO TO 24
- ENDIF
-
- NQCOUNT = N
- RETURN
- END
diff --git a/src/p5boot/p5lib/nsynopt.f b/src/p5boot/p5lib/nsynopt.f
deleted file mode 100644
index 67c95ea..0000000
--- a/src/p5boot/p5lib/nsynopt.f
+++ /dev/null
@@ -1,41 +0,0 @@
-CDECK ID>, NSYNOPT.
- PROGRAM NSYNOPT
-
-
- PARAMETER (NCNAME=32)
- PARAMETER (NFILES=4)
- CHARACTER NAME(NFILES)*(NCNAME)
-
-
- DATA NAME/ 'PAM .car 9 2 0 !ff'
- +, 'opt 3 11 0 !ff'
- +, 'read .cra 1 1 2 !ff'
- +, 'print .lis 2 4 0 !ff' /
-C- _:.=+=.:_1_:.=+=.:_2_:.=+=.:_3_:
-C- (1) (2) (3)
-
-C- (1) LUNUSE = 1 read, 2 print,
-C- 3 option, 4 cch subst, >4 file
-
-C- (2) LUNDES = 1 cradle input
-C- 2 PAM input
-C- 4 printed output
-C- 5 Fortran output
-C- 6 ASM output write-only (T=ATT)
-C- 7 ASM input-output (T=MODIF)
-C- 11 option parameter
-C- 12 control-character substitution parameter
-
-C- (3) LUNFLG = 0/>0 parameter value EOF not/yes allowed
-C- 2 the cradle file need not exist
-
-
- CALL MQINIT
-
- CALL FLPARA (NFILES,NAME,
- + 'Nysynopt Help,Eject,Start, Individual,Missing,' //
- + ' Xact,Ycde,Zseq,0->4 pg size')
-
- CALL EXSYNOPT
-
- END
diff --git a/src/p5boot/p5lib/p_crash.f b/src/p5boot/p5lib/p_crash.f
deleted file mode 100644
index b9afc5f..0000000
--- a/src/p5boot/p5lib/p_crash.f
+++ /dev/null
@@ -1,17 +0,0 @@
-CDECK ID>, P_CRASH.
- SUBROUTINE P_CRASH (MSG)
-
- COMMON /QUNIT/ IQREAD,IQPRNT, IQTTIN,IQTYPE, IQOFFL,IQRTTY,IQRSAV
- +, IQRFD,IQRRD,IQRSIZ, NQLPAT,NQUSED,NQLLBL, NQINIT
-C-------------- End CDE --------------------------------
- CHARACTER MSG*(*)
-
- IF (NQINIT.NE.0) IQPRNT= IQTYPE
- WRITE (IQTYPE,9000)
- IF (IQPRNT.NE.IQTYPE) WRITE (IQPRNT,9000)
-
- CALL P_KILL (MSG)
-
- 9000 FORMAT (/' ****!!!!! Patchy crashing on a bug !!!!!****'
- F/' please call for help: zoll at cern.ch')
- END
diff --git a/src/p5boot/p5lib/p_fatal.f b/src/p5boot/p5lib/p_fatal.f
deleted file mode 100644
index eb45329..0000000
--- a/src/p5boot/p5lib/p_fatal.f
+++ /dev/null
@@ -1,15 +0,0 @@
-CDECK ID>, P_FATAL.
- SUBROUTINE P_FATAL (MSG)
-
- COMMON /QUNIT/ IQREAD,IQPRNT, IQTTIN,IQTYPE, IQOFFL,IQRTTY,IQRSAV
- +, IQRFD,IQRRD,IQRSIZ, NQLPAT,NQUSED,NQLLBL, NQINIT
-C-------------- End CDE --------------------------------
- CHARACTER MSG*(*)
-
- IF (NQINIT.NE.0) IQPRNT= IQTYPE
- WRITE (IQTYPE,9011) MSG
- IF (IQPRNT.NE.IQTYPE) WRITE (IQPRNT,9011) MSG
- CALL PABEND
-
- 9011 FORMAT (/' ***!!! Fatal error for ',A,' !!!***')
- END
diff --git a/src/p5boot/p5lib/p_fatam.f b/src/p5boot/p5lib/p_fatam.f
deleted file mode 100644
index 169ce8a..0000000
--- a/src/p5boot/p5lib/p_fatam.f
+++ /dev/null
@@ -1,8 +0,0 @@
-CDECK ID>, P_FATAM.
- SUBROUTINE P_FATAM (MSG)
-
- CHARACTER MSG*(*)
-
- CALL PERRORF ('Perror has')
- CALL P_FATAL (MSG)
- END
diff --git a/src/p5boot/p5lib/p_kill.f b/src/p5boot/p5lib/p_kill.f
deleted file mode 100644
index bb733d1..0000000
--- a/src/p5boot/p5lib/p_kill.f
+++ /dev/null
@@ -1,15 +0,0 @@
-CDECK ID>, P_KILL.
- SUBROUTINE P_KILL (MSG)
-
- COMMON /QUNIT/ IQREAD,IQPRNT, IQTTIN,IQTYPE, IQOFFL,IQRTTY,IQRSAV
- +, IQRFD,IQRRD,IQRSIZ, NQLPAT,NQUSED,NQLLBL, NQINIT
-C-------------- End CDE --------------------------------
- CHARACTER MSG*(*)
-
- IF (NQINIT.NE.0) IQPRNT= IQTYPE
- WRITE (IQTYPE,9011) MSG
- IF (IQPRNT.NE.IQTYPE) WRITE (IQPRNT,9011) MSG
- CALL EXITRC (2)
-
- 9011 FORMAT (/' ***!!! Kill the run for: ',A,' !!!***')
- END
diff --git a/src/p5boot/p5lib/p_killm.f b/src/p5boot/p5lib/p_killm.f
deleted file mode 100644
index af9bd5d..0000000
--- a/src/p5boot/p5lib/p_killm.f
+++ /dev/null
@@ -1,8 +0,0 @@
-CDECK ID>, P_KILLM.
- SUBROUTINE P_KILLM (MSG)
-
- CHARACTER MSG*(*)
-
- CALL PERRORF (' Perror has')
- CALL P_KILL (MSG)
- END
diff --git a/src/p5boot/p5lib/pabend.f b/src/p5boot/p5lib/pabend.f
deleted file mode 100644
index 0d8cf67..0000000
--- a/src/p5boot/p5lib/pabend.f
+++ /dev/null
@@ -1,42 +0,0 @@
-CDECK ID>, PABEND.
- SUBROUTINE PABEND
-
-C- Nypatchy run termination with errors
-C. started 16-dec-93
-
- COMMON /QUNIT/ IQREAD,IQPRNT, IQTTIN,IQTYPE, IQOFFL,IQRTTY,IQRSAV
- +, IQRFD,IQRRD,IQRSIZ, NQLPAT,NQUSED,NQLLBL, NQINIT
- CHARACTER CQDATEM*10, CQDATE*8, CQTIME*5
- COMMON /QSTATE/NQERR,NQWARN,NQINFO,NQLOCK
- +, IQDATE,IQTIME, CQDATEM,CQDATE,CQTIME
- COMMON /LUNSLN/IFLAUX, IXLUN(12)
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
-C-------------- End CDE --------------------------------
-
-
- IF (NQINIT.NE.0) GO TO 28
- IF (IFLAUX.NE.0) GO TO 28
- IF (NQERR.EQ.0) NQERR= 1
- IF (INCRAD.NE.3) GO TO 49
-
- WRITE (IQPRNT,9011)
- IF (IQTYPE.NE.IQPRNT) WRITE (IQTYPE,9011)
- 9011 FORMAT (/' ***!!! No operation !!!***'/)
-
- 28 CALL EXITRC (2)
-
- 49 CALL PEND
- END
diff --git a/src/p5boot/p5lib/pend.f b/src/p5boot/p5lib/pend.f
deleted file mode 100644
index 72d3846..0000000
--- a/src/p5boot/p5lib/pend.f
+++ /dev/null
@@ -1,452 +0,0 @@
-CDECK ID>, PEND.
- SUBROUTINE PEND
-
-C- Print the run summary
-C. started 11-feb-92
-
- COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT,NUSLAT(2),DUMMY(34)
- CHARACTER SLLINE*512, SLERRM*256
- COMMON /SLATLN/ SLLINE, SLERRM
- PARAMETER (KM1=1,KM2=2,KM3=4,KM4=8,KM5=16,KM6=32,KM7=64,KM8=128,
- + KM9=256, KM10=512, KM11=1024, KM12=2048, KM13=4096, KM14=8192,
- + KM15=16384, KM16=32768, KM17=65536, KM18=131072, KM19=262144)
- COMMON /QPAGE/ NQLMAX,NQLTOL,NQLTOK,NQCMAX,NQCPGH,NQPAGE
- +, NQWYLDO,NQWYL,NQNEWH,NQJOIN,NQDKNO,NQDKPG
- COMMON /QUNIT/ IQREAD,IQPRNT, IQTTIN,IQTYPE, IQOFFL,IQRTTY,IQRSAV
- +, IQRFD,IQRRD,IQRSIZ, NQLPAT,NQUSED,NQLLBL, NQINIT
- CHARACTER CQDATEM*10, CQDATE*8, CQTIME*5
- COMMON /QSTATE/NQERR,NQWARN,NQINFO,NQLOCK
- +, IQDATE,IQTIME, CQDATEM,CQDATE,CQTIME
- COMMON /MQCM/ NQSYSS,NQLINK, LQCSTA(3),LQCEND(3), NQMAX
- +, LQLSTA(5),LQLEND(5), LQADR,LQADR0,NQOFFS
- COMMON /MQCN/ IQLST,IQLNA,IQID,IQTY,IQLI,IQNL,IQNS,IQND
- +, IQLNX,IQFOUL
- PARAMETER (KQGARB=1,KQARRV=3,KQKEEP=4,KQPREP=5,KQMAIN=6,KQPAST=8)
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
- PARAMETER (JFO_TYP=1, JCC_TYP=2, JAS_TYP=3, JDA_TYP=4,
- + JSH_TYP=5, JCR_TYP=6, JIN_TYP=7, MAX_TYP=100)
- CHARACTER*16 CH_TYP(MAX_TYP), ACT_TYP
- COMMON /CM_TYP/ LUN_TYP, N_TYP, NAL_TYP, NDV_TYP, JBK_TYP
- +, JU_TYP(MAX_TYP), CH_TYP, ACT_TYP
- COMMON /NAMEC/ NA_OCC, NA_CUT, NA_MXSL, NA_MXTX
-C-------------- End CDE --------------------------------
-
- CHARACTER LINE*128, COL(128)*1
- EQUIVALENCE (LINE,COL,SLLINE)
-
- PARAMETER (KI=21, KF=29, KT=36, KS=43, KO=51)
-
- IAND (IZV,IZW) = AND (IZV, IZW)
-
-C| Processing mode selections Other status bits for P=X
-C|
-C| U - use F - skipped by +PATCH,X,IF=
-C| L - list M - skipped by +IMITATE,X
-C| E - exe X - at least 1 deck to AS
-C| D - divert P - partial +USE,X,D=...
-C| X - xdivert Self + Self R - P=X,T=REPEAT
-C| Inhibit Foreign Trans only Q - quoted in IF=X
-C| ------- ------- ------ ------
-C|_:.=+=.: 1_:.=+=.: 2_:.=+=.: 3_:.=+=.: 4_:.=+=.: 5_:.=+=.: 6_:.=+=.: 7_
-C| Patch ULEDX ULEDX LEDX LEDX FMXPRQ Used from P=
-C|
-C| 0 CRA* . ULE . . LE . R CRA*
-C| P5MODEL /20 931111 21.50
-C| 0 @P5MODEL . LE . . LE .
-C| 1 *MO . ULE . . LE . CRA*
-C| 2 ACTZ . ULE . . LE . *MO
-C| 16 VCDE . ULE . . LE . Q *MO
-C| 19 ALPHA . ULE . . LE . Q *MO
-C| 23 BETA . ULE . . LE . Q ALPHA
-C| 30 CRA* . ULE . . LE . R CRA*
-C|
-C| Quoted patches not seen on the PAM files
-C|
-C| 0 NEWF . ULED . . LED . Q *MO
-C| 0 QMSUN . LE . . LE . Q
-C|
-C| Other patches not seen
-C|
-C| 0 ZLONGNAME012 U . LE . . LE . CRA*
-C| 0 ZLONGNAME01..U . LE . . LE . CRA*
-C|_:.=+=.: 1_:.=+=.: 2_:.=+=.: 3_:.=+=.: 4_:.=+=.: 5_:.=+=.: 6_:.=+=.: 7_
-
- IF (NQERR.NE.0) MOPTIO(22)= 1
- IF (MOPTIO(22).EQ.0) GO TO 51
-
- IF (NQPAGE.EQ.1) THEN
- CALL DPBLAN (1)
- LINE(1:1) = ' '
- ELSE
- LINE(1:1) = '1'
- ENDIF
- WRITE (IQPRNT, 9001) LINE(1:1)
- 9001 FORMAT (A,'--------------------------------------'
- F/' Summary of patches in processing order'/
- F/' Processing mode selections',24X,'Other status bits for P=X'/
- F/' U - use ',42X,'F - skipped by +PATCH,X,IF=...'
- F/' L - list ',42X,'M - skipped by +IMITATE,X'
- F/' E - exe ',42X,'X - not +EXE but deck to ASM'
- F/' D - divert ',42X,'P - partial +USE,X,D=...'
- F/' X - xdivert',16X,'Self +',9X,'Self',8X,'R - P=X,T=REPEAT'
- F/19X,' Inhibit Foreign Trans only',7X,'Q - quoted in IF=X'
- F/19X,' ------- ------- ------ ------',
- F/8X,'Patch',6X,
- F ' ULEDX ULEDX LEDX LEDX FMXPRQ Used from P='/)
- 9000 FORMAT (A)
-
- CALL QSHUNT (KQMAIN,KQPAST)
- CALL QTOPSY (KQPAST)
- LQ(LLPAST-1) = 0
- LBK = LQPAST
- MODE = 0
-
-C------ Do one list of patch summary
-
- 21 MST = IQ(LBK)
- MW1 = IQ(LBK+1)
- IXNAME = IQ(LBK+2)
-
- CALL QNAMEX (LBK)
- IF (IQFOUL.NE.0) THEN
- WRITE (IQPRNT,9822) LBK
- CALL P_CRASH ('trouble in PEND')
- ENDIF
- 9822 FORMAT (' ***!!! Trouble at LBK =',I9)
-C-- check to be printed in secondary lists
-
- IF (MODE.NE.0) THEN
- IF (IXNAME.EQ.0) GO TO 29
- MM = IAND (MW1,KM6)
- IF (MODE.EQ.1) THEN
- IF (MM.EQ.0) THEN
- NOTHER = 7
- GO TO 29
- ENDIF
- ELSE
- IF (MM.NE.0) GO TO 29
- ENDIF
- GO TO 26
- ENDIF
-
-C---- doing the primary list
-
- IF (IXNAME.GE.0) GO TO 26
-
-C-- bank RPAM
-
- LINE(1:4) = ' '
- CALL LN_GET (MW1, LINE(2:), 40)
- N = NDSLAT + 1
- CALL CSQMBL (LINE,2,N)
- N = NESLAT - 1
- WRITE (IQPRNT,9000)
- GO TO 28
-
-C-- bank PAT
-
- 26 NDKNO = JBYT (MW1,13,20)
-
- LINE = ' '
- CALL CSETDI (NDKNO,LINE,2,7)
-
- CALL NA_GET (IXNAME,LINE(1:21),9)
- IF (NFSLAT.GT.12) LINE(20:21) = '..'
-
- LINE(28:50) = '. . . .'
-
- IF (IAND(MST,KM10) .EQ.0) COL(KI+1) = 'U'
- IF (IAND(MST,KM7) .EQ.0) COL(KI+2) = 'L'
- IF (IAND(MST,KM6) .EQ.0) COL(KI+3) = 'E'
- IF (IAND(MST,KM8) .EQ.0) COL(KI+4) = 'D'
- IF (IAND(MST,KM9) .EQ.0) COL(KI+5) = 'X'
-
- IF (IAND(MST,KM5) .NE.0) COL(KF+1) = 'U'
- IF (IAND(MST,KM2) .NE.0) COL(KF+2) = 'L'
- IF (IAND(MST,KM1) .NE.0) COL(KF+3) = 'E'
- IF (IAND(MST,KM3) .NE.0) COL(KF+4) = 'D'
- IF (IAND(MST,KM4) .NE.0) COL(KF+5) = 'X'
-
- IF (IAND(MST,KM12) .NE.0) COL(KT+2) = 'L'
- IF (IAND(MST,KM11) .NE.0) COL(KT+3) = 'E'
- IF (IAND(MST,KM13) .NE.0) COL(KT+4) = 'D'
- IF (IAND(MST,KM14) .NE.0) COL(KT+5) = 'X'
-
- IF (IAND(MST,KM16) .NE.0) COL(KS+2) = 'L'
- IF (IAND(MST,KM15) .NE.0) COL(KS+3) = 'E'
- IF (IAND(MST,KM17) .NE.0) COL(KS+4) = 'D'
- IF (IAND(MST,KM18) .NE.0) COL(KS+5) = 'X'
-
-
- IF (IAND(MW1,KM1) .NE.0) COL(KO+1) = 'F'
- IF (IAND(MW1,KM2) .NE.0) COL(KO+2) = 'M'
- IF (IAND(MW1,KM3) .NE.0) COL(KO+3) = 'X'
- IF (IAND(MW1,KM4) .NE.0) COL(KO+4) = 'P'
- IF (IAND(MW1,KM5) .NE.0) COL(KO+5) = 'R'
- IF (IAND(MW1,KM6) .NE.0) COL(KO+6) = 'Q'
-
-C-- add "used from"
-
- IX = LQ(LBK-4)
- IF (IX.NE.0) IX= IQ(IX+2)
- IF (IX.EQ.0) THEN
- N = LENOCC (LINE(1:60))
- ELSE
- CALL NA_GET (IX,LINE,60)
- N = NESLAT - 1
- ENDIF
-
-C-- print the line and loop
-
- 28 WRITE (IQPRNT,9000) LINE(1:N)
-
- 29 LBK = LQ(LBK-1)
- IF (LBK.NE.0) GO TO 21
-
-C-- End of the list
-
- IF (MODE.EQ.2) GO TO 39
- IF (MODE.EQ.1) GO TO 38
-
-C-- remove bank for p=PY_VS5 if not quoted
-
- IXU = NA_LONG ('PY_VS5')
- L = KQFIND (IXU,2, KQMAIN,K)
- IF (L.NE.0) THEN
- IF (IAND(IQ(L+1),KM6).EQ.0) LQ(K)= LQ(L-1)
- ENDIF
-
- IF (LEXP.EQ.LLPAST) GO TO 39
-
- WRITE (IQPRNT,9037)
- 9037 FORMAT (/' Quoted patches not seen on the PAM files'/)
-
- CALL QSORTN (2,KQMAIN)
- NOTHER = 0
- LBK = LEXP
- MODE = 1
- GO TO 21
-
- 38 IF (NOTHER.EQ.0) GO TO 39
-
- WRITE (IQPRNT,9038)
- 9038 FORMAT (/' Other patches not seen'/)
-
- LBK = LEXP
- MODE = 2
- GO TO 21
- 39 CONTINUE
-
-C------ Name stack occupation
-
- JSL = LQLSTA(5)
- JSLE = NA_OCC + 1
- JTX = MLIAD(JSL)
- JTXE = MLIAD(JSLE)
-
- NSLOCC = JSLE - JSL
- NTXOCC = JTXE - JTX
- NSLAV = LQLEND(5) - JSL
- NTXAV = NSIZETX - JTX
-
- NSLPRO = (100 * NSLOCC) / NSLAV
- NTXPRO = (100 * NTXOCC) / NTXAV
-
- WRITE (IQPRNT,9050) NA_CUT, NSLPRO,NSLAV, NTXPRO,NTXAV
- NQLLBL = 0
- 9050 FORMAT (/' Name stack:',7X,
- F 'significant name length is',I3,' characters'
- F/ 12X,I5,'% used of',I7,' name slots available'
- F/ 12X,I5,'% used of',I7,' bytes of text available')
-
-C------ Input summary
-
- 51 CALL DPBLAN (1)
- WRITE (IQPRNT,9051) IQ(LACRAD+12)
- 9051 FORMAT (' Read:',6X,I6,' lines from the cradle')
-
- WRITE (IQPRNT,9052) IQ(LPAM+12), IQ(LPAM+13), IQ(LPAM+14)
- 9052 FORMAT (10X,I8,' lines from',I4,' PAM files for',I3,
- F' lines +PAM')
-
-C------ ASM output summary
-
- WRITE (IQPRNT,9061)
- IF (IQTYPE.NE.IQPRNT) WRITE (IQTYPE,9061)
- 9061 FORMAT (/' Written:')
-
-C---- print all active physical streams
-
- JASM = 0
- 62 JASM = JASM + 1
- IF (JASM.GT.N_TYP) GO TO 71
- LASMT = LQ(LHASM-JASM)
- LASML = LASMT
- JDIV = 0
-
- 63 IF (IQ(LASML+1).NE.0) GO TO 69
- LXASM = LQ(LASML-1)
- MODE = IQ(LASML+2)
- NDK = IQ(LXASM+3)
- NLI = IQ(LXASM+4)
- IF (MODE.NE.3) THEN
- IF (NDK.EQ.0) GO TO 69
- ENDIF
-
- LINE = ' physical'
- CALL STRMID (JASM,JDIV,LINE,13)
- JP = MAX (NESLAT,24)
- CALL CSETDI (NDK, LINE,JP+1,JP+5)
- JP = JP + 6
- IF (MODE.EQ.0) THEN
- LINE(JP+1:JP+5) = 'decks'
- ELSEIF (MODE.EQ.1) THEN
- LINE(JP+1:JP+5) = 'units'
- ELSE
- LINE(JP+1:JP+5) = 'files'
- ENDIF
- JP = JP + 6
-
- IF (MODE.EQ.0) THEN
- LINE(JP+1:JP+8) = 'bypassed'
- JP = JP + 8
- GO TO 68
- ENDIF
-
- CALL CSETDI (NLI, LINE,JP+1,JP+6)
- JP = JP + 7
- LINE(JP+1:JP+5) = 'lines'
- JP = JP + 6
-
- IF (MODE.EQ.1) THEN
- LINE(JP+1:JP+7) = 'to file'
- JP = JP + 9
- CALL NA_GET (IQ(LASML+3), LINE,JP)
- JP = NESLAT - 1
- GO TO 68
- ENDIF
-
- IF (MODE.EQ.2) THEN
- LINE(JP+1:JP+22) = ' written in SPLIT mode'
- ELSE
- LINE(JP+1:JP+22) = 'written in MODIFY mode'
- ENDIF
- JP = JP + 22
-
- 68 WRITE (IQPRNT,9000)
- WRITE (IQPRNT,9000) LINE(1:JP)
- IF (IQTYPE.NE.IQPRNT) WRITE (IQTYPE,9000) LINE(1:JP)
-
- IF (MODE.LT.2) GO TO 69
- IXU = IQ(LASML+3)
- IF (IXU.NE.0) THEN
- CALL NA_GET (IXU,LINE,1)
- N = NDSLAT
- WRITE (IQPRNT,9067) LINE(1:N)
- ENDIF
-
- IXU = IQ(LASML+4)
- IF (IXU.NE.0) THEN
- CALL NA_GET (IXU,LINE,1)
- N = NDSLAT
- WRITE (IQPRNT,9068) LINE(1:N)
- ENDIF
-
- 9067 FORMAT (' log file name is ',A)
- 9068 FORMAT (' file name prefix: ',A)
-
- 69 IF (JDIV.EQ.4) GO TO 62
- JDIV = JDIV + 1
- LASML = LQ(LASMT-JDIV-1)
- GO TO 63
-
-C---- print all active logical streams
-
- 71 WRITE (IQPRNT,9000)
- JASM = 0
- 72 JASM = JASM + 1
- IF (JASM.GT.N_TYP) GO TO 81
- LASMT = LQ(LHASM-JASM)
- LASML = LASMT
- JDIV = 0
-
- 73 NDKG = IQ(LASML+8)
- NDKW = IQ(LASML+9)
- IF (NDKG.EQ.0) GO TO 79
- MUSE = IQ(LASML+1)
-
- LINE = ' logical'
- CALL STRMID (JASM,JDIV,LINE,13)
- JP = MAX (NESLAT,24)
- CALL CSETDI (NDKG, LINE,JP+1,JP+5)
- JP = JP + 6
- LINE(JP+1:JP+5) = 'decks'
- JP = JP + 6
- IF (NDKW.EQ.NDKG) GO TO 76
-
- LINE(JP+1:JP+5) = 'done,'
- JP = JP + 6
- CALL CSETDI (NDKW, LINE,JP+1,JP+5)
- JP = JP + 6
- LINE(JP+1:JP+5) = 'decks'
- JP = JP + 6
-
- 76 LINE(JP+1:JP+7) = 'written'
- JP = JP + 7
- IF (MUSE.EQ.0) GO TO 78
-
- LINE(JP+1:JP+4) = ' via'
- JP = JP + 6
-
- JASMP = MUSE / 8
- JDIVP = MOD (MUSE,8)
-
- LINE(JP:JP+15) = CH_TYP(JASMP)
- JP = LNBLNK (LINE(1:JP+15)) + 1
- LINE(JP:JP) = ':'
- JP = JP + 1
- CALL CSETDI (JDIVP, LINE,JP,JP)
-
- 78 WRITE (IQPRNT,9000) LINE(1:JP)
-
- 79 IF (JDIV.EQ.4) GO TO 72
- JDIV = JDIV + 1
- LASML = LQ(LASMT-JDIV-1)
- GO TO 73
-
-C---- Print number of warnings and errors
-
- 81 IF (NQERR+NQWARN.EQ.0) THEN
- WRITE (IQPRNT,9081)
- ELSE
- IF (NQERR.EQ.0) THEN
- WRITE (IQPRNT,9082) NQWARN
- IF (IQTYPE.NE.IQPRNT) WRITE (IQTYPE,9082) NQWARN
- ELSE
- WRITE (IQPRNT,9082) NQWARN,NQERR
- IF (IQTYPE.NE.IQPRNT) WRITE (IQTYPE,9082) NQWARN,NQERR
- ENDIF
- ENDIF
-
-
- IF (NQERR.EQ.0) RETURN
-
- CALL EXITRC (2)
-
- 9081 FORMAT (/' No errors, no warnings.'/)
- 9082 FORMAT (/' **!!', I5,' warnings !!**'/
- F :,' ***!!!',I4,' errors !!!***'/)
- END
diff --git a/src/p5boot/p5lib/pgsize.f b/src/p5boot/p5lib/pgsize.f
deleted file mode 100644
index bef9e2c..0000000
--- a/src/p5boot/p5lib/pgsize.f
+++ /dev/null
@@ -1,63 +0,0 @@
-CDECK ID>, PGSIZE.
- SUBROUTINE PGSIZE (MODE,IXOPT)
-
-C- Set (MODE=0) or print (=1) page size
-C. started 17-jan-94
-
- COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT,NUSLAT(2),DUMMY(34)
- CHARACTER SLLINE*512, SLERRM*256
- COMMON /SLATLN/ SLLINE, SLERRM
- COMMON /QPAGE/ NQLMAX,NQLTOL,NQLTOK,NQCMAX,NQCPGH,NQPAGE
- +, NQWYLDO,NQWYL,NQNEWH,NQJOIN,NQDKNO,NQDKPG
- COMMON /QUNIT/ IQREAD,IQPRNT, IQTTIN,IQTYPE, IQOFFL,IQRTTY,IQRSAV
- +, IQRFD,IQRRD,IQRSIZ, NQLPAT,NQUSED,NQLLBL, NQINIT
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
-C-------------- End CDE --------------------------------
- CHARACTER LINE*80
- EQUIVALENCE (LINE,SLLINE)
-
- DIMENSION LILENG(5)
- DATA LILENG / 56, 62, 74, 84, 98 /
-
-
-
- IF (MODE.NE.0) GO TO 41
- DO 24 J=1,5
- IF (JBIT(MOPTIO(34),J+26).NE.0) NQLMAX= LILENG(J)
- 24 CONTINUE
-
- CALL NA_GET (IXOPT,LINE,1)
- NN = NDSLAT
-
- J = 0
- 26 J = J + 1
- IF (J.GE.NN) GO TO 29
- NL = ICDECI (LINE,J,NN)
- IF (NDSLAT.LT.2) GO TO 26
- IF (NL.LT.20) GO TO 26
- NQLMAX = NL
-
- 29 CALL MQPAGE
- RETURN
-
- 41 CALL DPBLAN (1)
- WRITE (IQPRNT,9041) NQLMAX, LILENG
- RETURN
-
- 9041 FORMAT (' Page size used:',I5,' lines per page'
- F/' Available with option O:',I3,
- F' 1:',I3,' 2:',I3,' 3:',I3,' 4:',I3)
- END
diff --git a/src/p5boot/p5lib/pinit.f b/src/p5boot/p5lib/pinit.f
deleted file mode 100644
index 23fb733..0000000
--- a/src/p5boot/p5lib/pinit.f
+++ /dev/null
@@ -1,69 +0,0 @@
-CDECK ID>, PINIT.
- SUBROUTINE PINIT (JSTAGE)
-
-C- Initialize PATCHY
-C. started 10-feb-92
-
- PARAMETER (NBANKS=19,JBKPAT=1, JBKDEC=2, JBKORG=3, JBKINC=4,
- + JBKHOL=5, JBKKEE=6, JBKACT=7, JBKMAT=8, JBKXSQ=9,
- + JBKPRE=10,JBKGAR=11,JBKSMH=12,JBKSMT=13,JBKSML=14,
- + JBKSMX=15,JBKARR=16,JBKASA=17,JBKPAM=18,JBKRPA=19)
- COMMON /QBANKS/MMBANK(5,NBANKS)
- COMMON /QUNIT/ IQREAD,IQPRNT, IQTTIN,IQTYPE, IQOFFL,IQRTTY,IQRSAV
- +, IQRFD,IQRRD,IQRSIZ, NQLPAT,NQUSED,NQLLBL, NQINIT
- PARAMETER (NFIMAX=100)
- COMMON /TITLEC/ NFILET, JTIPAM(NFIMAX)
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
-C-------------- End CDE --------------------------------
-
-
- IF (JSTAGE.NE.0) GO TO 31
-
-C-------- Start initialization before reading the cradle --------
-
- CALL MQWORK (LACRAD,INCRAD,LASTWK)
- NFILET = 0
-
- NVGAP(1) = 4000
- NVGAP(2) = 200
- NVGAP(3) = 5000
- NVGAP(4) = 40
-
-C-- Pre-lift the banks for I/O handling
-
- CALL MQLIFT (LACRAD, 0,7, JBKARR,3)
- CALL MQLIFT (LPAM, 0,7, JBKPAM,3)
- CALL MQLIFT (LQARRV, 0,7, JBKARR,3)
- CALL MQLIFT (LQHOLD, 0,7, JBKHOL,1)
- RETURN
-
-C-------- Finish initialization with the cradle in memory -------
-
-C-- preset options COMPACT FULL VERBOSE
-
- 31 MOPTIO(2) = 1
- MOPTIO(3) = 1
- MOPTIO(6) = 1
- IF (IQTYPE.NE.IQPRNT) MOPTIO(22)= 1
- CALL PKBYT (MOPTIO(1),MOPTIO(33),1,32,0)
-
- CALL PINIT2
-
-C-- Ready the ASM structure and connect pre-opened files
-
- CALL ASMINI
- RETURN
- END
diff --git a/src/p5boot/p5lib/pinit2.f b/src/p5boot/p5lib/pinit2.f
deleted file mode 100644
index 3e99c40..0000000
--- a/src/p5boot/p5lib/pinit2.f
+++ /dev/null
@@ -1,153 +0,0 @@
-CDECK ID>, PINIT2.
- SUBROUTINE PINIT2
-
-C- Initialization for Nypatchy and Nysynopt
-C. split off from PINIT 19-july-95
-
- PARAMETER (KM1=1,KM2=2,KM3=4,KM4=8,KM5=16,KM6=32,KM7=64,KM8=128,
- + KM9=256, KM10=512, KM11=1024, KM12=2048, KM13=4096, KM14=8192,
- + KM15=16384, KM16=32768, KM17=65536, KM18=131072, KM19=262144)
- PARAMETER (NBANKS=19,JBKPAT=1, JBKDEC=2, JBKORG=3, JBKINC=4,
- + JBKHOL=5, JBKKEE=6, JBKACT=7, JBKMAT=8, JBKXSQ=9,
- + JBKPRE=10,JBKGAR=11,JBKSMH=12,JBKSMT=13,JBKSML=14,
- + JBKSMX=15,JBKARR=16,JBKASA=17,JBKPAM=18,JBKRPA=19)
- COMMON /QBANKS/MMBANK(5,NBANKS)
- PARAMETER (MCCNIL=1, MCCKIL=2, MCCINC=3, MCCCDE=4, MCCSEQ=5,
- + MCCXSQ=6, MCCTRU=7, MCCFAL=8, MCCELS=9, MCCEND=10,
- + MCCSEL=11, MCCSES=12, MCCFAU=13, MCCSKI=14,
- + MCCKEE=15, MCCDEL=16, MCCREP=17, MCCADB=18, MCCADD=19,
- + MCCUSE=20, MCCXDI=21, MCCDIV=22, MCCLIS=23, MCCEXE=24, MCCIMI=25,
- + MCCASM=26, MCCUPD=27, MCCNAM=28, MCCGAP=29, MCCMOR=30, MCCONL=31,
- + MCCFOR=32, MCCSUS=33, MCCOPT=34, MCCOP2=35, MCCSHO=36, MCCPAM=37,
- + MCCQUI=38, MCCEOD=39, MCCDEC=40, MCCPAT=41, MCCTIT=42)
- CHARACTER CCKORG*256, CCKARD*256, CCCOMF*256
- COMMON /CCPARA/NCHCCD,NCHCCT, JCCTYP,JCCLEV,JCCSL,MCCPAR(240)
- +, NCCPAR,MXCCIF,JCCIFV,JCCBAD,JCCWAR,ICCSUB,JCCWK(4)
- +, JCCPP,JCCPD,JCCPZ,JCCPT,JCCPIF,JCCPC,JCCPN
- +, NCCPP,NCCPD,NCCPZ,NCCPT,NCCPIF,NCCPC,NCCPN
- +, JCCEND, NCHCCC,IXCCC, CCKORG, CCKARD, CCCOMF
- CHARACTER CHEXPD*68
- COMMON /CHEXC/ IXEXPAM, IXEXPAT,IXEXDEC,IXEXID, NCHEPD, CHEXPD
- COMMON /MUSEBC/ MX_FORC, MU_GLOB, MU_PAT, MU_DECK, MU_INH, MU_FORG
- +, MX_TRAN, MX_FORG, MX_SINH, MX_SELF, NVEXDK(6)
- COMMON /MQCM/ NQSYSS,NQLINK, LQCSTA(3),LQCEND(3), NQMAX
- +, LQLSTA(5),LQLEND(5), LQADR,LQADR0,NQOFFS
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
-C-------------- End CDE --------------------------------
- PARAMETER (IXCRA=2)
-
- IOR (IZV,IZW) = OR (IZV, IZW)
-
-
- JSLA = IQ(LQHOLD+1)
- NSLE = IQ(LQHOLD+3)
- JSLE = JSLA + NSLE
- IF (NSLE.LE.0) GO TO 41
-
-C---- +NAMES, length, slots, text
-
- CALL NEXTXX ('+NAM', JSLA,JSLE,JSLF)
- IF (JSLF.EQ.0) GO TO 34
-
- JCCTYP = MCCNAM
- CALL CCKRAK (JSLF)
- IF (JCCBAD.NE.0) CALL P_KILL ('faulty line +NAMES')
-
- CALL NA_REIN
-
-C---- +GAP, gap1, ...
-
- 34 CALL NEXTXX ('+GAP', JSLA,JSLE,JSLF)
- IF (JSLF.EQ.0) GO TO 36
-
- JCCTYP = MCCGAP
- CALL CCKRAK (JSLF)
- IF (JCCBAD.NE.0) CALL P_KILL ('faulty line +GAP')
-
- CALL VZERO (IQUEST,12)
- CALL UCOCOP (MCCPAR(JCCPN+1),IQUEST,NCCPN,1,3,1)
-
- IF (IQUEST(1).GT.0) IQUEST(1)= MAX (IQUEST(1), 1000)
- IF (IQUEST(2).GT.0) IQUEST(2)= MAX (IQUEST(2), 100)
- IF (IQUEST(3).GT.0) IQUEST(3)= MAX (IQUEST(3), 2000)
- IF (IQUEST(4).GT.0) IQUEST(4)= MAX (IQUEST(4), 20)
-
- IF (IQUEST(1).GT.0) NVGAP(1) = MIN (IQUEST(1), LQCEND(3)/10)
- IF (IQUEST(2).GT.0) NVGAP(2) = MIN (IQUEST(2), 400)
- IF (IQUEST(3).GT.0) NVGAP(3) = MIN (IQUEST(3), LQLSTA(5)/10)
- IF (IQUEST(4).GT.0) NVGAP(4) = MIN (IQUEST(4), 80)
-
-C---- +UPDATE
-
- 36 CALL NEXTXX ('+UPD', JSLA,JSLE,JSLF)
- IF (JSLF.EQ.0) GO TO 41
-
- JCCTYP = MCCUPD
- CALL CCKRAK (JSLF)
- IF (JCCBAD.NE.0) CALL P_KILL ('faulty line +UPDATE')
-
- MOPUPD = 1
-
-C-- USE bits for global and P=CRA* and D=blank
-
- 41 MX_FORC = KM6 + KM7 + KM8 + KM9
- MU_GLOB = MX_FORC + KM10
- MU_PAT = MU_GLOB + KM5
- MU_DECK = MU_PAT
-
- CALL MXOPER (0)
-
-C-- lift PAT and DECK banks for P=CRA*,D=blank
-
- CALL MQLIFT (LPCRA, LEXP,1, JBKPAT,3)
-
- LQ(LPCRA-4) = LPCRA
- IQ(LPCRA) = IOR (IQ(LPCRA),MU_PAT)
- IQ(LPCRA+1) = KM5
- IQ(LPCRA+2) = IXCRA
-
- CALL MQLIFT (LDCRAB, LPCRA,-2, JBKDEC,3)
- LEXD = LDCRAB
-
- LQ(LDCRAB-4) = LPCRA
- IQ(LDCRAB) = IOR (IQ(LDCRAB),MU_DECK)
-
- IXEXPAM = 0
- IXEXPAT = IXCRA
- IXEXDEC = 0
- IXEXID = IXCRA
-
-C-- lift the dummy PAT bank connecting the past to the future
-
- CALL MQLIFT (LLPAST,LEXP,-1,JBKPAT,3)
-
-C-- lift PAT bank for PY_VS5 used
-
- CALL MQLIFT (L,LEXP,-1,JBKPAT,3)
- LQ(L-4) = LPCRA
- IQ(L) = IOR (IQ(L), MU_PAT)
- IQ(L+2) = NA_LONG ('PY_VS5')
-
-C-- create the service MAT bank at LSERV
-
- CALL MQLIFT (LSERV, 0,7, JBKMAT,3)
-
-C-- Lift the preset sequence definitions
-
- CALL CRDECO
- CALL INISEQ
- RETURN
- END
diff --git a/src/p5boot/p5lib/psteer.f b/src/p5boot/p5lib/psteer.f
deleted file mode 100644
index 44628bc..0000000
--- a/src/p5boot/p5lib/psteer.f
+++ /dev/null
@@ -1,57 +0,0 @@
-CDECK ID>, PSTEER.
- SUBROUTINE PSTEER
-
-C- Running Patchy
-C. started 7-feb-92
-
- CHARACTER CQDATEM*10, CQDATE*8, CQTIME*5
- COMMON /QSTATE/NQERR,NQWARN,NQINFO,NQLOCK
- +, IQDATE,IQTIME, CQDATEM,CQDATE,CQTIME
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
-C-------------- End CDE --------------------------------
-
-
- CALL PINIT (0)
-
-C-- Get the cradle into memory
-
- INCRAD = 3
- CALL ARRIVE (0)
-
-C-- Complete the initialization
-
- CALL PINIT (1)
-
-C-- Do the cradle initially
-
- CALL DOCRAD
- IF (JANSW.NE.0) GO TO 89
-
-C-- Do next PAM file
-
- 41 INCRAD = 0
- CALL DOPAM
-
-C-- Do cradle continuation
-
- INCRAD = 2
- CALL DOCRAD
- IF (JANSW.EQ.0) GO TO 41
-
- 89 IF (NQERR.NE.0) CALL PABEND
- CALL PEND
- RETURN
- END
diff --git a/src/p5boot/p5lib/qblow.f b/src/p5boot/p5lib/qblow.f
deleted file mode 100644
index 61e23cf..0000000
--- a/src/p5boot/p5lib/qblow.f
+++ /dev/null
@@ -1,52 +0,0 @@
-CDECK ID>, QBLOW.
- SUBROUTINE QBLOW (LN)
-
-C- Blow the name of the bank at LN, name-word adr
-
- PARAMETER (NBANKS=19,JBKPAT=1, JBKDEC=2, JBKORG=3, JBKINC=4,
- + JBKHOL=5, JBKKEE=6, JBKACT=7, JBKMAT=8, JBKXSQ=9,
- + JBKPRE=10,JBKGAR=11,JBKSMH=12,JBKSMT=13,JBKSML=14,
- + JBKSMX=15,JBKARR=16,JBKASA=17,JBKPAM=18,JBKRPA=19)
- COMMON /QBANKS/MMBANK(5,NBANKS)
- COMMON /MQCM/ NQSYSS,NQLINK, LQCSTA(3),LQCEND(3), NQMAX
- +, LQLSTA(5),LQLEND(5), LQADR,LQADR0,NQOFFS
- COMMON /MQCN/ IQLST,IQLNA,IQID,IQTY,IQLI,IQNL,IQNS,IQND
- +, IQLNX,IQFOUL
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ)
- EQUIVALENCE (LQ,IQ,LQGARB)
- COMMON // IQUEST(100),LQGARB
-C-------------- End CDE --------------------------------
-
- IAND (IZV,IZW) = AND (IZV, IZW)
- ISHFTR (IZW,NZB) = ISHFT (IZW, -NZB)
-
-
- IQLNA = LN
-
- M = LQ(IQLNA)
- IQTY= IAND (M,63)
- M = ISHFTR(M,6)
- IQLI= IAND (M,1)
- M = ISHFTR(M,1)
- IQNL= IAND (M,63)
- M = ISHFTR(M,6)
- IQNS= IAND (M,63)
- M = ISHFTR(M,6)
- IQND= IAND (M,2047)
-
- IQLST = IQLNA + IQNL + 1
- NL = ISHFTR(IQ(IQLST),26)
- IF (NL.NE.IQNL) GO TO 91
- IF (IQNL.LT.IQNS) GO TO 91
- IF (IQLST+IQND.GE.NQMAX) GO TO 91
- IF (IQTY.EQ.0) GO TO 91
- IF (IQTY.GT.NBANKS) GO TO 91
- IF (IQNL+IQND.EQ.0) GO TO 91
-
- IQLNX = IQLST + IQND + 1
- IQID = MMBANK(1,IQTY)
- RETURN
- 91 CALL DQCLOBB (IQLNA,0)
- RETURN
- END
diff --git a/src/p5boot/p5lib/qblowx.f b/src/p5boot/p5lib/qblowx.f
deleted file mode 100644
index 41c1dbd..0000000
--- a/src/p5boot/p5lib/qblowx.f
+++ /dev/null
@@ -1,55 +0,0 @@
-CDECK ID>, QBLOWX.
- SUBROUTINE QBLOWX (LN)
-
-C- QBLOW with legality check
-
- PARAMETER (NBANKS=19,JBKPAT=1, JBKDEC=2, JBKORG=3, JBKINC=4,
- + JBKHOL=5, JBKKEE=6, JBKACT=7, JBKMAT=8, JBKXSQ=9,
- + JBKPRE=10,JBKGAR=11,JBKSMH=12,JBKSMT=13,JBKSML=14,
- + JBKSMX=15,JBKARR=16,JBKASA=17,JBKPAM=18,JBKRPA=19)
- COMMON /QBANKS/MMBANK(5,NBANKS)
- COMMON /MQCM/ NQSYSS,NQLINK, LQCSTA(3),LQCEND(3), NQMAX
- +, LQLSTA(5),LQLEND(5), LQADR,LQADR0,NQOFFS
- COMMON /MQCN/ IQLST,IQLNA,IQID,IQTY,IQLI,IQNL,IQNS,IQND
- +, IQLNX,IQFOUL
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ)
- EQUIVALENCE (LQ,IQ,LQGARB)
- COMMON // IQUEST(100),LQGARB
-C-------------- End CDE --------------------------------
-
- IAND (IZV,IZW) = AND (IZV, IZW)
- ISHFTR (IZW,NZB) = ISHFT (IZW, -NZB)
-
-
- IQLNA = LN
-
- M = LQ(IQLNA)
- IQTY= IAND (M,63)
- M = ISHFTR(M,6)
- IQLI= IAND (M,1)
- M = ISHFTR(M,1)
- IQNL= IAND (M,63)
- M = ISHFTR(M,6)
- IQNS= IAND (M,63)
- M = ISHFTR(M,6)
- IQND= IAND (M,2047)
-
- IQLST = IQLNA + IQNL + 1
-
- NL = ISHFTR(IQ(IQLST),26)
- IF (NL.NE.IQNL) GO TO 91
- IF (IQNL.LT.IQNS) GO TO 91
- IF (IQLST+IQND.GE.NQMAX) GO TO 91
- IF (IQTY.EQ.0) GO TO 91
- IF (IQTY.GT.NBANKS) GO TO 91
- IF (IQNL+IQND.EQ.0) GO TO 91
- IQFOUL = 0
-
- IQLNX = IQLST + IQND + 1
- IQID = MMBANK(1,IQTY)
- RETURN
-
- 91 IQFOUL= -1
- RETURN
- END
diff --git a/src/p5boot/p5lib/qlump.f b/src/p5boot/p5lib/qlump.f
deleted file mode 100644
index d7d7ecb..0000000
--- a/src/p5boot/p5lib/qlump.f
+++ /dev/null
@@ -1,26 +0,0 @@
-CDECK ID>, QLUMP.
- SUBROUTINE QLUMP
-
-C- Compact the NAME parameters in /MQCL/ into the name-word
-C- of the bank starting at NQLST
-
- COMMON /MQCL/ NQLST,NQLNA,NQID,NQTY,NQLI,NQNL,NQNS,NQND
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ)
- EQUIVALENCE (LQ,IQ,LQGARB)
- COMMON // IQUEST(100),LQGARB
-C-------------- End CDE --------------------------------
-
- ISHFTL (IZW,NZB) = LSHIFT (IZW, NZB)
-
-
- NACC = NQND
- NACC = ISHFTL(NACC,6) + NQNS
- NACC = ISHFTL(NACC,6) + NQNL
- NACC = ISHFTL(NACC,1) + NQLI
- NACC = ISHFTL(NACC,6) + NQTY
-
- LQ(NQLNA) = NACC
- IQ(NQLST) = ISHFTL(NQNL,26)
- RETURN
- END
diff --git a/src/p5boot/p5lib/qname.f b/src/p5boot/p5lib/qname.f
deleted file mode 100644
index 632f919..0000000
--- a/src/p5boot/p5lib/qname.f
+++ /dev/null
@@ -1,53 +0,0 @@
-CDECK ID>, QNAME.
- SUBROUTINE QNAME (LS)
-
-C- Blow the name of the bank at LS, status word adr
-
- PARAMETER (NBANKS=19,JBKPAT=1, JBKDEC=2, JBKORG=3, JBKINC=4,
- + JBKHOL=5, JBKKEE=6, JBKACT=7, JBKMAT=8, JBKXSQ=9,
- + JBKPRE=10,JBKGAR=11,JBKSMH=12,JBKSMT=13,JBKSML=14,
- + JBKSMX=15,JBKARR=16,JBKASA=17,JBKPAM=18,JBKRPA=19)
- COMMON /QBANKS/MMBANK(5,NBANKS)
- COMMON /MQCM/ NQSYSS,NQLINK, LQCSTA(3),LQCEND(3), NQMAX
- +, LQLSTA(5),LQLEND(5), LQADR,LQADR0,NQOFFS
- COMMON /MQCN/ IQLST,IQLNA,IQID,IQTY,IQLI,IQNL,IQNS,IQND
- +, IQLNX,IQFOUL
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ)
- EQUIVALENCE (LQ,IQ,LQGARB)
- COMMON // IQUEST(100),LQGARB
-C-------------- End CDE --------------------------------
-
- IAND (IZV,IZW) = AND (IZV, IZW)
- ISHFTR (IZW,NZB) = ISHFT (IZW, -NZB)
-
-
- IQLST = LS
- IF (IQLST.LT.LQCSTA(1)) GO TO 91
- IF (IQLST.GE.NQMAX) GO TO 91
- NL = ISHFTR(LQ(IQLST),26)
- IQLNA = IQLST - NL - 1
-
- M = LQ(IQLNA)
- IQTY= IAND (M,63)
- M = ISHFTR(M,6)
- IQLI= IAND (M,1)
- M = ISHFTR(M,1)
- IQNL= IAND (M,63)
- M = ISHFTR(M,6)
- IQNS= IAND (M,63)
- M = ISHFTR(M,6)
- IQND= IAND (M,2047)
- IF (NL.NE.IQNL) GO TO 91
- IF (IQNL.LT.IQNS) GO TO 91
- IF (IQLST+IQND.GE.NQMAX) GO TO 91
- IF (IQTY.EQ.0) GO TO 91
- IF (IQTY.GT.NBANKS) GO TO 91
- IF (IQNL+IQND.EQ.0) GO TO 91
-
- IQLNX = IQLST + IQND + 1
- IQID = MMBANK(1,IQTY)
- RETURN
- 91 CALL DQCLOBB (0,IQLST)
- RETURN
- END
diff --git a/src/p5boot/p5lib/qnamex.f b/src/p5boot/p5lib/qnamex.f
deleted file mode 100644
index c3cc33a..0000000
--- a/src/p5boot/p5lib/qnamex.f
+++ /dev/null
@@ -1,59 +0,0 @@
-CDECK ID>, QNAMEX.
- SUBROUTINE QNAMEX (LS)
-
-C- QNAME with legality check
-
- PARAMETER (NBANKS=19,JBKPAT=1, JBKDEC=2, JBKORG=3, JBKINC=4,
- + JBKHOL=5, JBKKEE=6, JBKACT=7, JBKMAT=8, JBKXSQ=9,
- + JBKPRE=10,JBKGAR=11,JBKSMH=12,JBKSMT=13,JBKSML=14,
- + JBKSMX=15,JBKARR=16,JBKASA=17,JBKPAM=18,JBKRPA=19)
- COMMON /QBANKS/MMBANK(5,NBANKS)
- COMMON /MQCM/ NQSYSS,NQLINK, LQCSTA(3),LQCEND(3), NQMAX
- +, LQLSTA(5),LQLEND(5), LQADR,LQADR0,NQOFFS
- COMMON /MQCN/ IQLST,IQLNA,IQID,IQTY,IQLI,IQNL,IQNS,IQND
- +, IQLNX,IQFOUL
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ)
- EQUIVALENCE (LQ,IQ,LQGARB)
- COMMON // IQUEST(100),LQGARB
-C-------------- End CDE --------------------------------
-
- IAND (IZV,IZW) = AND (IZV, IZW)
- ISHFTR (IZW,NZB) = ISHFT (IZW, -NZB)
-
-
- IQLST = LS
- IF (IQLST.LT.LQCSTA(1)) GO TO 96
- IF (IQLST.GE.NQMAX) GO TO 96
- NL = ISHFTR(LQ(IQLST),26)
- IQLNA = IQLST - NL - 1
-
- M = LQ(IQLNA)
- IQTY= IAND (M,63)
- M = ISHFTR(M,6)
- IQLI= IAND (M,1)
- M = ISHFTR(M,1)
- IQNL= IAND (M,63)
- M = ISHFTR(M,6)
- IQNS= IAND (M,63)
- M = ISHFTR(M,6)
- IQND= IAND (M,2047)
-
- IF (NL.NE.IQNL) GO TO 91
- IF (IQNL.LT.IQNS) GO TO 91
- IF (IQLST+IQND.GE.NQMAX) GO TO 91
- IF (IQTY.EQ.0) GO TO 91
- IF (IQTY.GT.NBANKS) GO TO 91
- IF (IQNL+IQND.EQ.0) GO TO 91
- IQFOUL = 0
-
- IQLNX = IQLST + IQND + 1
- IQID = MMBANK(1,IQTY)
- RETURN
-
- 91 IQFOUL = -1
- RETURN
-
- 96 IQFOUL = 1
- RETURN
- END
diff --git a/src/p5boot/p5lib/qshlin.f b/src/p5boot/p5lib/qshlin.f
deleted file mode 100644
index b8d59c1..0000000
--- a/src/p5boot/p5lib/qshlin.f
+++ /dev/null
@@ -1,26 +0,0 @@
-CDECK ID>, QSHLIN.
- SUBROUTINE QSHLIN (KOLD,KNEW)
-
-C- Disconnect the linear stucture from KOLD and insert it at KNEW
-
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ)
- EQUIVALENCE (LQ,IQ,LQGARB)
- COMMON // IQUEST(100),LQGARB
-C-------------- End CDE --------------------------------
-
-
- IF (KOLD.EQ.KNEW) RETURN
- LGO = LQ(KOLD)
- IF (LGO.EQ.0) RETURN
- LSV = LQ(KNEW)
- LNX = LGO
- 24 LL = LNX
- LNX = LQ(LL-1)
- IF (LNX.NE.0) GO TO 24
-
- LQ(KOLD) = 0
- LQ(KNEW) = LGO
- LQ(LL-1) = LSV
- RETURN
- END
diff --git a/src/p5boot/p5lib/qshunt.f b/src/p5boot/p5lib/qshunt.f
deleted file mode 100644
index 0728032..0000000
--- a/src/p5boot/p5lib/qshunt.f
+++ /dev/null
@@ -1,21 +0,0 @@
-CDECK ID>, QSHUNT.
- SUBROUTINE QSHUNT (KOLD,KNEW)
-
-C- Shunt the single bank at KOLD connecting it to KNEW
-
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ)
- EQUIVALENCE (LQ,IQ,LQGARB)
- COMMON // IQUEST(100),LQGARB
-C-------------- End CDE --------------------------------
-
-
- IF (KOLD.EQ.KNEW) RETURN
- L = LQ(KOLD)
- IF (L.EQ.0) RETURN
-
- LQ(KOLD) = LQ(L-1)
- LQ(L-1) = LQ(KNEW)
- LQ(KNEW) = L
- RETURN
- END
diff --git a/src/p5boot/p5lib/qsorti.f b/src/p5boot/p5lib/qsorti.f
deleted file mode 100644
index 5ec481e..0000000
--- a/src/p5boot/p5lib/qsorti.f
+++ /dev/null
@@ -1,37 +0,0 @@
-CDECK ID>, QSORTI.
- SUBROUTINE QSORTI (JWORD,KGO)
-
-C- Sort banks at KGO for words IQ(L+JWORD) to be in increasing order
-
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ)
- EQUIVALENCE (LQ,IQ,LQGARB)
- COMMON // IQUEST(100),LQGARB
-C-------------- End CDE --------------------------------
-
- LL = LQ(KGO)
- IF (LL.EQ.0) RETURN
- JW = JWORD
-
- 11 LN = LQ(LL-1)
- IF (LN.EQ.0) RETURN
- IF (IQ(LN+JW).LT.IQ(LL+JW)) GO TO 21
- LL = LN
- GO TO 11
-
-C-- BANK LN OUT OF SEQUENCE
-
- 21 LQ(LL-1)= LQ(LN-1)
- K = KGO
-
- 24 L = LQ(K)
- IF (IQ(LN+JW).LT.IQ(L+JW)) GO TO 29
- K = L-1
- GO TO 24
-
-C-- PLACE FOR BANK LN FOUND
-
- 29 LQ(LN-1)= L
- LQ(K) = LN
- GO TO 11
- END
diff --git a/src/p5boot/p5lib/qsortn.f b/src/p5boot/p5lib/qsortn.f
deleted file mode 100644
index f79662a..0000000
--- a/src/p5boot/p5lib/qsortn.f
+++ /dev/null
@@ -1,38 +0,0 @@
-CDECK ID>, QSORTN.
- SUBROUTINE QSORTN (JWORD,KGO)
-
-C- Sort banks at KGO for the names pointed to
-C- by words IQ(L+JWORD) to be in increasing order
-
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ)
- EQUIVALENCE (LQ,IQ,LQGARB)
- COMMON // IQUEST(100),LQGARB
-C-------------- End CDE --------------------------------
-
- LL = LQ(KGO)
- IF (LL.EQ.0) RETURN
- JW = JWORD
-
- 11 LN = LQ(LL-1)
- IF (LN.EQ.0) RETURN
- IF (NA_DIF(IQ(LN+JW),IQ(LL+JW)).LT.0) GO TO 21
- LL = LN
- GO TO 11
-
-C-- BANK LN OUT OF SEQUENCE
-
- 21 LQ(LL-1)= LQ(LN-1)
- K = KGO
-
- 24 L = LQ(K)
- IF (NA_DIF(IQ(LN+JW),IQ(L+JW)).LT.0) GO TO 29
- K = L-1
- GO TO 24
-
-C-- PLACE FOR BANK LN FOUND
-
- 29 LQ(LN-1)= L
- LQ(K) = LN
- GO TO 11
- END
diff --git a/src/p5boot/p5lib/qtopsy.f b/src/p5boot/p5lib/qtopsy.f
deleted file mode 100644
index 9ade998..0000000
--- a/src/p5boot/p5lib/qtopsy.f
+++ /dev/null
@@ -1,23 +0,0 @@
-CDECK ID>, QTOPSY.
- SUBROUTINE QTOPSY (KGO)
-
-C- Invert order of banks in a linear stucture
-
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ)
- EQUIVALENCE (LQ,IQ,LQGARB)
- COMMON // IQUEST(100),LQGARB
-C-------------- End CDE --------------------------------
-
- LN = LQ(KGO)
- L = 0
- 11 IF (LN.EQ.0) GO TO 21
- LL = L
- L = LN
- LN = LQ(L-1)
- LQ(L-1) = LL
- GO TO 11
-
- 21 LQ(KGO) = L
- RETURN
- END
diff --git a/src/p5boot/p5lib/setgap.f b/src/p5boot/p5lib/setgap.f
deleted file mode 100644
index 898d3f6..0000000
--- a/src/p5boot/p5lib/setgap.f
+++ /dev/null
@@ -1,54 +0,0 @@
-CDECK ID>, SETGAP.
- SUBROUTINE SETGAP
-
-C- Ready the gap for the next deck
-C. started 19-july-95
-
- COMMON /MQCM/ NQSYSS,NQLINK, LQCSTA(3),LQCEND(3), NQMAX
- +, LQLSTA(5),LQLEND(5), LQADR,LQADR0,NQOFFS
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
-C-------------- End CDE --------------------------------
-
-
-C-- Check enough space
-
- NWFREE = LQCSTA(3) - LQCEND(1)
- IF (NWFREE.LE.NVGAP(1)) GO TO 24
-
- JSLOCC = LQLSTA(4)
- JSLFRE = LQLEND(2)
- NSLFRE = JSLOCC - JSLFRE
- NTXFRE = MLIAD(JSLOCC) - MLIAD(JSLFRE)
-
- NTXWAN = NVGAP(2) * NVGAP(4)
- IF (NSLFRE.LT.NVGAP(2)) GO TO 24
- IF (NTXFRE.GE.NTXWAN) GO TO 29
-
- 24 IF (IFLGAR.EQ.0) CALL MQSHIFT
- IFLGAR = 7
- NWFREE = LQCSTA(3) - LQCEND(1)
-
-C-- set limits of control division 2
-
- 29 LQCSTA(2) = LQCEND(1) + 5*(NWFREE/8)
- LQCEND(2) = LQCSTA(2)
-
-C-- clear text division 3
-
- LQLSTA(3) = LQLEND(2)
- LQLEND(3) = LQLSTA(3)
- RETURN
- END
diff --git a/src/p5boot/p5lib/shupto.f b/src/p5boot/p5lib/shupto.f
deleted file mode 100644
index d11aefe..0000000
--- a/src/p5boot/p5lib/shupto.f
+++ /dev/null
@@ -1,120 +0,0 @@
-CDECK ID>, SHUPTO.
- SUBROUTINE SHUPTO
-
-C- For Uptodate mode: get the names of all .o files,
-C- check each to be in the .log list, if not delete it
-C. started 4-feb-94
-
- COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT,NUSLAT(2),DUMMY(34)
- CHARACTER SLLINE*512, SLERRM*256
- COMMON /SLATLN/ SLLINE, SLERRM
- PARAMETER (NSLIFI=128)
- CHARACTER CHLIFI*(NSLIFI), CHLIEX*8
- COMMON /FLINKC/LUNOP,LUNFD,LUNOLD,LUNSIZ
- +, IXFLUN, NLIFI,CHLIFI,CHLIEX
- COMMON /QUNIT/ IQREAD,IQPRNT, IQTTIN,IQTYPE, IQOFFL,IQRTTY,IQRSAV
- +, IQRFD,IQRRD,IQRSIZ, NQLPAT,NQUSED,NQLLBL, NQINIT
- COMMON /MQCM/ NQSYSS,NQLINK, LQCSTA(3),LQCEND(3), NQMAX
- +, LQLSTA(5),LQLEND(5), LQADR,LQADR0,NQOFFS
- PARAMETER (NTYSZ=4, NACSZ=4, NLNSZ=4, NRTSZ=10000)
- CHARACTER CHNLOG*80, CODEX*8, CHTYP*8
- COMMON /SHMKC/ NNLOG,CHNLOG, CODEX, CHTYP(17)
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
- +, NLINST(4,NACSZ,NTYSZ), IXINST(NLNSZ,4,NACSZ,NTYSZ)
- +, NCOUNTR(4,NTYSZ), NCSUMR(NTYSZ)
- +, NCOUNTH(4,NTYSZ), NCSUMH(NTYSZ), IXOPTN(4,3), IXOPTP(4,3)
- +, NRXQT, NROUT, NNAME(NRTSZ), NRALLC, NRDEL
- +, LUNSH, IXOBJ, IXSDIR, JXTYP, JXACT, JXSTR, LASTSH
-C-------------- End CDE --------------------------------
- CHARACTER LINE*64
- EQUIVALENCE (LINE, SLLINE)
-
- INTEGER SYSTEMF
-
- IAND (IZV,IZW) = AND (IZV, IZW)
- ISHFTR (IZW,NZB) = ISHFT (IZW, -NZB)
-
-
- CALL UNLINKF ('temp_dir.fca')
- IXTEMP = NA_LONG ('temp_dir.fca')
-
- LINE = 'ls *.o >'
-C- _:.=+=.: 1_:
- CALL NA_GET (IXTEMP, LINE,10)
- N = NESLAT - 1
- ISTAT = SYSTEMF (LINE(1:N))
-
- CALL INIPAM (11, IXTEMP, 0,2)
- IF (IXFLUN.LT.0) GO TO 59
-
- 20 LQLEND(2) = LQLSTA(2)
- IQ(LQHOLD+2) = 0
- CALL ARRIVE (3)
-
-
-C---- Do next line
-
- JSLIN = IQ(LQHOLD+1) - 1
- NSLIN = IQ(LQHOLD+2)
- JSLEND = JSLIN + NSLIN
-
- 21 JSLIN = JSLIN + 1
- IF (JSLIN.GT.JSLEND) GO TO 49
-
- CALL LN_GET (JSLIN,LINE,512)
- NXX = NDSLAT
- IF (NXX.EQ.0) GO TO 21
- NXX = LNBLNK (LINE(1:NXX))
- IF (NXX.EQ.0) GO TO 21
-
-C-- get the routine name
-
- JNA = ICNEXT (LINE,1,NXX)
- JNE = NESLAT - 1
- IF (LINE(JNE-1:JNE).NE.'.o') GO TO 21
- JNN = JNE - 2
- IF (JNN.LT.JNA) GO TO 21
- IXU = NA_LONG (LINE(JNA:JNN))
-
-C-- find this name in the list of routines
-
-C- NNAME(JR) = ((IXNAME*8 + JXTYP)*8 + JXSTR)*4 + IFLNEW
-
- DO 24 JR=NRXQT+1,NROUT
- MM = NNAME(JR)
- IXN = ISHFTR (MM,8)
- IF (IXN.EQ.IXU) THEN
- IF (IAND(MM,3).EQ.2) GO TO 21
- GO TO 27
- ENDIF
- 24 CONTINUE
- NRDEL = NRDEL + 1
-
-C-- delete .o file if not in the list, if to be re-compiled
-
- 27 CALL UNLINKF (LINE(JNA:JNE))
- IF (MOPTIO(22).EQ.0) GO TO 21
- WRITE (IQPRNT,9028) LINE(JNA:JNE)
- 9028 FORMAT (7X,'delete file ',A)
- GO TO 21
-
-C---- Done
-
- 49 IF (JDKNEX.LT.4) GO TO 20
- CALL INIPAM (0,0, -1,0)
- 59 CALL UNLINKF ('temp_dir.fca')
- RETURN
- END
diff --git a/src/p5boot/p5lib/shwcomp.f b/src/p5boot/p5lib/shwcomp.f
deleted file mode 100644
index 2e155ca..0000000
--- a/src/p5boot/p5lib/shwcomp.f
+++ /dev/null
@@ -1,56 +0,0 @@
-CDECK ID>, SHWCOMP.
- SUBROUTINE SHWCOMP (JTYP,JSTR,XNAME)
-
-C- Output of the shell-command for routine name XNAME
-C. started 20-jan-94
-
- COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT,NUSLAT(2),DUMMY(34)
- CHARACTER SLLINE*512, SLERRM*256
- COMMON /SLATLN/ SLLINE, SLERRM
- PARAMETER (NTYSZ=4, NACSZ=4, NLNSZ=4, NRTSZ=10000)
- CHARACTER CHNLOG*80, CODEX*8, CHTYP*8
- COMMON /SHMKC/ NNLOG,CHNLOG, CODEX, CHTYP(17)
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
- +, NLINST(4,NACSZ,NTYSZ), IXINST(NLNSZ,4,NACSZ,NTYSZ)
- +, NCOUNTR(4,NTYSZ), NCSUMR(NTYSZ)
- +, NCOUNTH(4,NTYSZ), NCSUMH(NTYSZ), IXOPTN(4,3), IXOPTP(4,3)
- +, NRXQT, NROUT, NNAME(NRTSZ), NRALLC, NRDEL
- +, LUNSH, IXOBJ, IXSDIR, JXTYP, JXACT, JXSTR, LASTSH
-C-------------- End CDE --------------------------------
-
- CHARACTER XNAME*(*)
- CHARACTER LINEWK*512, COLWK(512)*1
- EQUIVALENCE (LINEWK,SLLINE), (COLWK,LINEWK)
-
-
- JACT = 4
- NLINE = NLINST(JSTR,JACT,JTYP)
- IF (NLINE.EQ.0) RETURN
-
- DO 29 JLINE=1,NLINE
- JTX = NA_JTX (IXINST(JLINE,JSTR,JACT,JTYP))
- NTX = NDSLAT
-
- CALL CCOSUB (TEXT(JTX),NTX, LINEWK,1,512, '$*', XNAME)
- JE = NESLAT - 1
-
-C-- Write the line ready
-
- WRITE (LUNSH,9027) LINEWK(1:JE)
- 9027 FORMAT (A)
- 29 CONTINUE
- RETURN
- END
diff --git a/src/p5boot/p5lib/shwpar.f b/src/p5boot/p5lib/shwpar.f
deleted file mode 100644
index f6832c2..0000000
--- a/src/p5boot/p5lib/shwpar.f
+++ /dev/null
@@ -1,94 +0,0 @@
-CDECK ID>, SHWPAR.
- SUBROUTINE SHWPAR
-
-C- Output of the parameter-defining statements for Unix
-C. started 22-feb-94
-
- COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT,NUSLAT(2),DUMMY(34)
- CHARACTER SLLINE*512, SLERRM*256
- COMMON /SLATLN/ SLLINE, SLERRM
- PARAMETER (NTYSZ=4, NACSZ=4, NLNSZ=4, NRTSZ=10000)
- CHARACTER CHNLOG*80, CODEX*8, CHTYP*8
- COMMON /SHMKC/ NNLOG,CHNLOG, CODEX, CHTYP(17)
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
- +, NLINST(4,NACSZ,NTYSZ), IXINST(NLNSZ,4,NACSZ,NTYSZ)
- +, NCOUNTR(4,NTYSZ), NCSUMR(NTYSZ)
- +, NCOUNTH(4,NTYSZ), NCSUMH(NTYSZ), IXOPTN(4,3), IXOPTP(4,3)
- +, NRXQT, NROUT, NNAME(NRTSZ), NRALLC, NRDEL
- +, LUNSH, IXOBJ, IXSDIR, JXTYP, JXACT, JXSTR, LASTSH
-C-------------- End CDE --------------------------------
- CHARACTER LINEWK*256, COLWK(256)*1
- EQUIVALENCE (LINEWK,SLLINE), (COLWK,SLLINE)
-
- CHARACTER CHT(3)*1, CHS(4)*1, CHC(3)*2
-
- DATA CHT / 'F', 'C', 'A' /
- DATA CHC / 'FC', 'CC', 'AS' /
- DATA CHS / '1', '2', '3', '4' /
-
-
- 21 LINEWK = 'set FILE = ' // CHNLOG(1:NNLOG)
-C- _:.=+=.: 1_:.=+=
- N = NNLOG + 12
- WRITE (LUNSH,9000) LINEWK(1:N)
-
- LINEWK = 'set s = "'
-C- _:.=+=.: 1_:.=+=
- CALL NA_GET (IXSDIR, LINEWK, 13)
- N = NESLAT
- COLWK(N) = '"'
- WRITE (LUNSH,9000) LINEWK(1:N)
- 9000 FORMAT (A)
-
-C------ All data-types, all active streams
-
- DO 49 JTYP=1,3
- IF (NCSUMR(JTYP).EQ.0) GO TO 49
-
- DO 48 JSTR=1,4
- IF (NCOUNTR(JSTR,JTYP).EQ.0) GO TO 48
-
-C-- define the compiler options
-
- LINEWK = 'set xO_y = " '
-C- _:.=+=.: 1_:.=+=
-
- COLWK(5) = CHT(JTYP)
- COLWK(8) = CHS(JSTR)
-
- IX = IXOPTN(JSTR,JTYP)
- CALL NA_GET (IX,LINEWK,13)
- N = NESLAT
-
- COLWK(N) = '"'
- WRITE (LUNSH,9000) LINEWK(1:N)
- 48 CONTINUE
-
-C-- define the compiler name
-
- JACT = 3
- LINEWK = 'set xx = "'
-C- _:.=+=.: 1_:.=+=
-
- LINEWK(5:6) = CHC(JTYP)
- IX = IXINST(1,1,JACT,JTYP)
- CALL NA_GET (IX,LINEWK,13)
- N = NESLAT
- COLWK(N) = '"'
- WRITE (LUNSH,9000) LINEWK(1:N)
- 49 CONTINUE
- RETURN
- END
diff --git a/src/p5boot/p5lib/shwsta.f b/src/p5boot/p5lib/shwsta.f
deleted file mode 100644
index b4748d9..0000000
--- a/src/p5boot/p5lib/shwsta.f
+++ /dev/null
@@ -1,76 +0,0 @@
-CDECK ID>, SHWSTA.
- SUBROUTINE SHWSTA (JDO)
-
-C- Output of shell-commands for "start" and "end"
-C- JDO = 1 start of the script
-C- 2 end of the script
-C. started 20-jan-94
-
- COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT,NUSLAT(2),DUMMY(34)
- CHARACTER SLLINE*512, SLERRM*256
- COMMON /SLATLN/ SLLINE, SLERRM
- PARAMETER (NTYSZ=4, NACSZ=4, NLNSZ=4, NRTSZ=10000)
- CHARACTER CHNLOG*80, CODEX*8, CHTYP*8
- COMMON /SHMKC/ NNLOG,CHNLOG, CODEX, CHTYP(17)
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
- +, NLINST(4,NACSZ,NTYSZ), IXINST(NLNSZ,4,NACSZ,NTYSZ)
- +, NCOUNTR(4,NTYSZ), NCSUMR(NTYSZ)
- +, NCOUNTH(4,NTYSZ), NCSUMH(NTYSZ), IXOPTN(4,3), IXOPTP(4,3)
- +, NRXQT, NROUT, NNAME(NRTSZ), NRALLC, NRDEL
- +, LUNSH, IXOBJ, IXSDIR, JXTYP, JXACT, JXSTR, LASTSH
-C-------------- End CDE --------------------------------
- CHARACTER LINEWK*524
- EQUIVALENCE (LINEWK,SLLINE)
-
-
-C---- Write part 1 of the end text
-
- JTYP = 4
- JACT = 3
- IF (JDO.NE.1) GO TO 21
-
-C---- Write part 1 of the start text
-
- WRITE (LUNSH,9020)
- 9020 FORMAT ('#!/bin/csh -f')
- JACT = 1
-
-C---- Send the CIL lines to the shell script
-
- 21 DO 38 JSTR=1,4
-
- NLINES = NLINST(JSTR,JACT,JTYP)
- IF (NLINES.EQ.0) GO TO 38
-
- DO 37 JLINE=1,NLINES
-
- CALL NA_GET (IXINST(JLINE,JSTR,JACT,JTYP), LINEWK,1)
- JE = NESLAT - 1
-
- WRITE (LUNSH,9036) LINEWK(1:JE)
- 9036 FORMAT (A)
- 37 CONTINUE
- 38 CONTINUE
-
- IF (JACT.EQ.2) RETURN
- IF (JACT.EQ.4) RETURN
-
-C---- Write part 2 of the start or end text
-
- JACT = JACT + 1
- IF (JACT.EQ.2) CALL SHWPAR
- GO TO 21
- END
diff --git a/src/p5boot/p5lib/shwxqt.f b/src/p5boot/p5lib/shwxqt.f
deleted file mode 100644
index 9b8bcfa..0000000
--- a/src/p5boot/p5lib/shwxqt.f
+++ /dev/null
@@ -1,93 +0,0 @@
-CDECK ID>, SHWXQT.
- SUBROUTINE SHWXQT
-
-C- Write the .xqtlog file
-C. started 5-may-94
-
- COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT,NUSLAT(2),DUMMY(34)
- CHARACTER SLLINE*512, SLERRM*256
- COMMON /SLATLN/ SLLINE, SLERRM
- PARAMETER (NSLIFI=128)
- CHARACTER CHLIFI*(NSLIFI), CHLIEX*8
- COMMON /FLINKC/LUNOP,LUNFD,LUNOLD,LUNSIZ
- +, IXFLUN, NLIFI,CHLIFI,CHLIEX
- PARAMETER (NTYSZ=4, NACSZ=4, NLNSZ=4, NRTSZ=10000)
- CHARACTER CHNLOG*80, CODEX*8, CHTYP*8
- COMMON /SHMKC/ NNLOG,CHNLOG, CODEX, CHTYP(17)
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
- +, NLINST(4,NACSZ,NTYSZ), IXINST(NLNSZ,4,NACSZ,NTYSZ)
- +, NCOUNTR(4,NTYSZ), NCSUMR(NTYSZ)
- +, NCOUNTH(4,NTYSZ), NCSUMH(NTYSZ), IXOPTN(4,3), IXOPTP(4,3)
- +, NRXQT, NROUT, NNAME(NRTSZ), NRALLC, NRDEL
- +, LUNSH, IXOBJ, IXSDIR, JXTYP, JXACT, JXSTR, LASTSH
-C-------------- End CDE --------------------------------
- CHARACTER LINE*64, LINEWK*256
- EQUIVALENCE (LINE,SLLINE), (LINEWK,SLLINE)
-
- IAND (IZV,IZW) = AND (IZV, IZW)
- ISHFTR (IZW,NZB) = ISHFT (IZW, -NZB)
-
-
-C-- open the .xqtlog file for output
-
- CHLIFI = CHNLOG(1:NNLOG) // '.xqtlog'
- NLIFI = NNLOG + 7
- CALL FLINK (LUNSH, 5, 0, 0)
-
-C-- record the compiler options used
-
- WRITE (LUNSH,9001)
- 9001 FORMAT ('>.xqtlog')
- 9000 FORMAT (A)
-
- DO 27 JTYP=1,3
- IF (NCSUMH(JTYP).EQ.0) GO TO 27
-
- DO 26 JSTR=1,4
- IF (NCOUNTH(JSTR,JTYP).EQ.0) GO TO 26
-
- LINEWK = '>'
- CALL SMSID (JTYP,JSTR,LINEWK,2)
-
- CALL NA_GET (IXOPTN(JSTR,JTYP), LINEWK,10)
- N = NESLAT - 1
-
- WRITE (LUNSH,9000) LINEWK(1:N)
- 26 CONTINUE
- 27 CONTINUE
-
-C-- write the properties of each routine
-C- NNAME(JR) = ((IXNAME*8 + JXTYP)*8 + JXSTR)*4 + IFLNEW
-C- IFLNEW = 2 if "same"
- DO 47 JRT=NRXQT+1,NROUT
- JJ = NNAME(JRT)
- JJ = ISHFTR(JJ,2)
- JSTR = IAND (JJ,7)
- JJ = ISHFTR (JJ,3)
- JTYP = IAND (JJ,7)
- IXNA = ISHFTR (JJ,3)
-
- LINE = ' '
- CALL SMSID (JTYP,JSTR,LINE,2)
-
- CALL NA_GET (IXNA, LINE, 10)
- N = NESLAT
-
- WRITE (LUNSH,9000) LINE(1:N-1)
- 47 CONTINUE
- CLOSE (LUNSH)
- RETURN
- END
diff --git a/src/p5boot/p5lib/smcil.f b/src/p5boot/p5lib/smcil.f
deleted file mode 100644
index 726223a..0000000
--- a/src/p5boot/p5lib/smcil.f
+++ /dev/null
@@ -1,93 +0,0 @@
-CDECK ID>, SMCIL.
- SUBROUTINE SMCIL (MODE, CODE, XTEXT)
-
-C- Store a compiler instructions line
-C- MODE = -1 start at line 1, =0 add one line
-C- CODE encoded: JXTYP type number, JXACT action, JXSTR stream
-C- XTEXT text to be stored
-C. started 20-jan-94
-
- COMMON /QUNIT/ IQREAD,IQPRNT, IQTTIN,IQTYPE, IQOFFL,IQRTTY,IQRSAV
- +, IQRFD,IQRRD,IQRSIZ, NQLPAT,NQUSED,NQLLBL, NQINIT
- PARAMETER (NTYSZ=4, NACSZ=4, NLNSZ=4, NRTSZ=10000)
- CHARACTER CHNLOG*80, CODEX*8, CHTYP*8
- COMMON /SHMKC/ NNLOG,CHNLOG, CODEX, CHTYP(17)
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
- +, NLINST(4,NACSZ,NTYSZ), IXINST(NLNSZ,4,NACSZ,NTYSZ)
- +, NCOUNTR(4,NTYSZ), NCSUMR(NTYSZ)
- +, NCOUNTH(4,NTYSZ), NCSUMH(NTYSZ), IXOPTN(4,3), IXOPTP(4,3)
- +, NRXQT, NROUT, NNAME(NRTSZ), NRALLC, NRDEL
- +, LUNSH, IXOBJ, IXSDIR, JXTYP, JXACT, JXSTR, LASTSH
-C-------------- End CDE --------------------------------
-
- CHARACTER CODE*(*), XTEXT*(*), LINE*512
- EQUIVALENCE (LINE, TEXT)
-
-
- CALL SMCODE (CODE)
- IF (JXTYP.EQ.0) GO TO 94
- NTXT = LENOCC (XTEXT)
- IF (JXTYP.GE.5) GO TO 31
-
- IF (MODE.LT.0) THEN
- NLINST(JXSTR,JXACT,JXTYP) = 0
- IXINST(1,JXSTR,JXACT,JXTYP) = 0
- ENDIF
-
- IF (NTXT.EQ.0) RETURN
-
- JLINE = NLINST(JXSTR,JXACT,JXTYP)
-
- 25 JLINE = JLINE + 1
- IF (JLINE.GT.NLNSZ) GO TO 91
-
- IXU = NA_LONG (XTEXT(1:NTXT))
- IXINST(JLINE,JXSTR,JXACT,JXTYP) = IXU
- NLINST(JXSTR,JXACT,JXTYP) = JLINE
- RETURN
-
-C-- sdir name
-
- 31 IXSDIR = 0
- IF (NTXT.GT.0) IXSDIR= NA_LONG (XTEXT(1:NTXT))
- RETURN
-
-C---- trouble
-
- 91 NMAX = NLNSZ
- IF (JXTYP.NE.4) GO TO 93
- IF (JXSTR.EQ.4) GO TO 92
- JXSTR = JXSTR + 1
- JLINE = 0
- GO TO 25
-
- 92 IF (INDEX (CODEX,':').EQ.0) NMAX = 8*NMAX
- IF (JXACT.EQ.2) GO TO 93
- IF (JXACT.EQ.4) GO TO 93
- JXACT = JXACT + 1
- JXSTR = 1
- JLINE = 0
- GO TO 25
-
- 93 WRITE (IQPRNT,9091) NMAX,CODEX
- 9091 FORMAT (/' ***!!! Capacity of',I3,' lines exceeded for ',A)
- GO TO 97
-
- 94 WRITE (IQPRNT,9091) CODE,XTEXT
- 9094 FORMAT (' ***!!! Faulty init with ',A,' for ',A,' !!!***')
-
- 97 CALL P_KILL ('Abend')
- END
diff --git a/src/p5boot/p5lib/smcinst.f b/src/p5boot/p5lib/smcinst.f
deleted file mode 100644
index 165d9db..0000000
--- a/src/p5boot/p5lib/smcinst.f
+++ /dev/null
@@ -1,110 +0,0 @@
-CDECK ID>, SMCINST.
- SUBROUTINE SMCINST
-
-C- Read the user-defined compiler instructions
-C. started 20-jan-94
-
- COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT,NUSLAT(2),DUMMY(34)
- CHARACTER SLLINE*512, SLERRM*256
- COMMON /SLATLN/ SLLINE, SLERRM
- COMMON /QUNIT/ IQREAD,IQPRNT, IQTTIN,IQTYPE, IQOFFL,IQRTTY,IQRSAV
- +, IQRFD,IQRRD,IQRSIZ, NQLPAT,NQUSED,NQLLBL, NQINIT
- PARAMETER (NTYSZ=4, NACSZ=4, NLNSZ=4, NRTSZ=10000)
- CHARACTER CHNLOG*80, CODEX*8, CHTYP*8
- COMMON /SHMKC/ NNLOG,CHNLOG, CODEX, CHTYP(17)
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
- +, NLINST(4,NACSZ,NTYSZ), IXINST(NLNSZ,4,NACSZ,NTYSZ)
- +, NCOUNTR(4,NTYSZ), NCSUMR(NTYSZ)
- +, NCOUNTH(4,NTYSZ), NCSUMH(NTYSZ), IXOPTN(4,3), IXOPTP(4,3)
- +, NRXQT, NROUT, NNAME(NRTSZ), NRALLC, NRDEL
- +, LUNSH, IXOBJ, IXSDIR, JXTYP, JXACT, JXSTR, LASTSH
-C-------------- End CDE --------------------------------
- CHARACTER LINE*512
- EQUIVALENCE (LINE, SLLINE)
-
-
- INCRAD = 3
- CALL ARRIVE (0)
- INCRAD = 0
-
- JSLIN = IQ(LQHOLD+1) - 1
- JSLEND = JSLIN + IQ(LQHOLD+2)
- NIGN = 0
- JXTYP = 0
- NLINE = 0
-
-C---- Read next line
-
- 21 JSLIN = JSLIN + 1
- IF (JSLIN.GT.JSLEND) GO TO 49
-
- CALL LN_GET (JSLIN,LINE,512)
- NXX = NDSLAT
- IF (NXX.EQ.0) GO TO 21
- NXX = LNBLNK (LINE(1:NXX))
- IF (NXX.EQ.0) GO TO 21
- IF (MOPTIO(17).EQ.0) THEN
- NLINE = NLINE + 1
- WRITE (IQPRNT,9023) NLINE,LINE(1:NXX)
- ENDIF
- 9023 FORMAT (1X,I6,' - ',A)
-
- IF (LINE(1:1).EQ.'#') GO TO 21
-
-C-- get the logical stream type:n
-
- IFL = 0
- JNA = 0
- 24 JNA = ICNEXT (LINE,JNA+1,NXX)
- IF (JNA.GE.7) GO TO 41
- IF (LINE(JNA:JNA).EQ.'+') THEN
- IFL = 7
- GO TO 24
- ENDIF
- IF (NDSLAT.LT.2) GO TO 71
- JTE = NESLAT
-
- CALL SMCODE (LINE(JNA:JTE-1))
- IF (JXTYP.EQ.0) GO TO 71
-
- IF (IFL.EQ.0) CALL SMCIL (-1, ' ', ' ')
-
- JNA = ICFNBL (LINE,JTE,NXX)
- IF (JNA.GT.NXX) GO TO 21
-
-C-- register the new compiler instruction line
-
- 41 IF (JXTYP.EQ.0) GO TO 71
- CALL SMCIL (0, ' ', LINE(JNA:NXX))
- GO TO 21
-
-C---- Done
-
- 49 IF (NIGN.NE.0) GO TO 97
- IF (NLINE.NE.0) WRITE (IQPRNT,9023)
- RETURN
-
-C---- Fault
-
- 71 NIGN = NIGN + 1
- WRITE (IQPRNT,9071) LINE(1:NXX)
- 9071 FORMAT (/' Bad: ',A
- F/' ***!!! Faulty compiler-instruction !!!***')
-
- IF (NIGN.LT.8) GO TO 21
- 97 IQREAD = -1
- RETURN
- END
diff --git a/src/p5boot/p5lib/smcode.f b/src/p5boot/p5lib/smcode.f
deleted file mode 100644
index b79ab10..0000000
--- a/src/p5boot/p5lib/smcode.f
+++ /dev/null
@@ -1,82 +0,0 @@
-CDECK ID>, SMCODE.
- SUBROUTINE SMCODE (CODE)
-
-C- Crack CODE into JXTYP, JXACT, JXSTR
-C. started 26-jan-94
-
- COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT,NUSLAT(2),DUMMY(34)
- PARAMETER (NTYSZ=4, NACSZ=4, NLNSZ=4, NRTSZ=10000)
- CHARACTER CHNLOG*80, CODEX*8, CHTYP*8
- COMMON /SHMKC/ NNLOG,CHNLOG, CODEX, CHTYP(17)
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
- +, NLINST(4,NACSZ,NTYSZ), IXINST(NLNSZ,4,NACSZ,NTYSZ)
- +, NCOUNTR(4,NTYSZ), NCSUMR(NTYSZ)
- +, NCOUNTH(4,NTYSZ), NCSUMH(NTYSZ), IXOPTN(4,3), IXOPTP(4,3)
- +, NRXQT, NROUT, NNAME(NRTSZ), NRALLC, NRDEL
- +, LUNSH, IXOBJ, IXSDIR, JXTYP, JXACT, JXSTR, LASTSH
-C-------------- End CDE --------------------------------
- CHARACTER CODE*(*)
- PARAMETER (NTYPES = 17)
-
-C- code fo: fopt fc fort: co: copt cc cc: ao: aopt as as:
-C- CHTYP( 1 2 3 4 5 6 7 8 9 10 11 12
-C- JXTYP= 1 2 3
-C- JXACT= 1 2 3 4 1 2 3 4 1 2 3 4
-
-C- code start: start end: end sdir
-C- CHTYP( 13 14 15 16 17
-C- JXTYP= 4 4 4 4 5
-C- JXACT= 1 2 3 4
-
-C-- if all blank: leave the parameters unchanged
-
- NA = LNBLNK (CODE)
- IF (NA.EQ.0) RETURN
- CODEX = CODE
-
-C-- find the length of the string and compare
-
- NC = ICFIND (':', CODEX,1,NA)
- IF (NC.EQ.1) GO TO 49
-
- JTYP = ICNTHL (CODEX(1:NC),CHTYP,NTYPES) - 1
- IF (JTYP.LT.0) GO TO 49
-
- JXTYP = JTYP/4 + 1
- JXACT = MOD (JTYP,4) + 1
- JXSTR = 1
- IF (CODEX(NC:NC).EQ.':') GO TO 24
- IF (JXTYP.LE.3) RETURN
-
-C-- take start:1 for start and end:1 for end
-
- JXACT = JXACT - 1
- RETURN
-
-C-- get number from :n
-
- 24 JXSTR = ICDECI (CODEX, NC+1, 8)
- IF (JXSTR.LE.0) GO TO 49
- IF (JXSTR.LE.4) RETURN
- IF (JXTYP.NE.4) GO TO 49
- JXACT = JXACT + 1
- JXSTR = JXSTR - 4
- IF (JXSTR.LE.4) RETURN
-
-C-- CODEX not for one of the compilers
-
- 49 JXTYP = 0
- END
diff --git a/src/p5boot/p5lib/smdef.f b/src/p5boot/p5lib/smdef.f
deleted file mode 100644
index 22a53f9..0000000
--- a/src/p5boot/p5lib/smdef.f
+++ /dev/null
@@ -1,89 +0,0 @@
-CDECK ID>, SMDEF.
- SUBROUTINE SMDEF
-
-C- Load the default compiler instructions for nyshell and nymake
-C. started 20-jan-94
-
- CHARACTER SLLINE*512, SLERRM*256
- COMMON /SLATLN/ SLLINE, SLERRM
- PARAMETER (NTYSZ=4, NACSZ=4, NLNSZ=4, NRTSZ=10000)
- CHARACTER CHNLOG*80, CODEX*8, CHTYP*8
- COMMON /SHMKC/ NNLOG,CHNLOG, CODEX, CHTYP(17)
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
- +, NLINST(4,NACSZ,NTYSZ), IXINST(NLNSZ,4,NACSZ,NTYSZ)
- +, NCOUNTR(4,NTYSZ), NCSUMR(NTYSZ)
- +, NCOUNTH(4,NTYSZ), NCSUMH(NTYSZ), IXOPTN(4,3), IXOPTP(4,3)
- +, NRXQT, NROUT, NNAME(NRTSZ), NRALLC, NRDEL
- +, LUNSH, IXOBJ, IXSDIR, JXTYP, JXACT, JXSTR, LASTSH
-C-------------- End CDE --------------------------------
- CHARACTER LINEWK*128
- EQUIVALENCE (LINEWK, SLERRM)
-
-
- CHTYP(1) = 'fo: '
- CHTYP(2) = 'fopt '
- CHTYP(3) = 'fc '
- CHTYP(4) = 'fort: '
- CHTYP(5) = 'co: '
- CHTYP(6) = 'copt '
- CHTYP(7) = 'cc '
- CHTYP(8) = 'cc: '
- CHTYP(9) = 'ao: '
- CHTYP(10) = 'aopt '
- CHTYP(11) = 'as '
- CHTYP(12) = 'as: '
- CHTYP(13) = 'start: '
- CHTYP(14) = 'start '
- CHTYP(15) = 'end: '
- CHTYP(16) = 'end '
- CHTYP(17) = 'sdir '
-
- CALL SMCIL (-1, 'fo:3' , '=:1')
- CALL SMCIL (-1, 'fo:4' , '=:2')
- CALL SMCIL (-1, 'co:3' , '=:1')
- CALL SMCIL (-1, 'co:4' , '=:2')
- CALL SMCIL (-1, 'ao:2' , '=:1')
- CALL SMCIL (-1, 'ao:3' , '=:1')
- CALL SMCIL (-1, 'ao:4' , '=:2')
-
- CALL SMCIL (-1, 'fort:3', '=:1')
- CALL SMCIL (-1, 'fort:4', '=:2')
- CALL SMCIL (-1, 'cc:3' , '=:1')
- CALL SMCIL (-1, 'cc:4' , '=:2')
- CALL SMCIL (-1, 'as:2' , '=:1')
- CALL SMCIL (-1, 'as:3' , '=:1')
- CALL SMCIL (-1, 'as:4' , '=:2')
-
- IXOBJ = NA_LONG ('.o')
- CALL SMCIL (-1, 'fo:1' , '-O')
- CALL SMCIL (-1, 'fopt' , '-c')
- CALL SMCIL (-1, 'co:1' , '-O')
- CALL SMCIL (-1, 'copt' , '-c')
-
- CALL SMCIL (-1, 'fort:1', '${FC} ${FO_1} ${s}$*.f')
- CALL SMCIL (-1, 'fort:2', '${FC} ${FO_2} ${s}$*.f')
- CALL SMCIL (-1, 'cc:1' , '${CC} ${CO_1} ${s}$*.c')
- CALL SMCIL (-1, 'cc:2' , '${CC} ${CO_2} ${s}$*.c')
- CALL SMCIL (-1, 'as:1' , '${AS} ${AO_1} ${s}$*.s')
-
- CALL SMCIL (-1, 'fc' , 'f77')
- CALL SMCIL (-1, 'cc' , 'cc')
- CALL SMCIL (-1, 'as' , 'as')
- CALL SMCIL (-1, 'fopt' , '-c -w66')
- CALL SMCIL (-1, 'as:1' , '${AS} -o $*.o ${s}$*.s')
-
- RETURN
- END
diff --git a/src/p5boot/p5lib/smdisp.f b/src/p5boot/p5lib/smdisp.f
deleted file mode 100644
index b3bfe2a..0000000
--- a/src/p5boot/p5lib/smdisp.f
+++ /dev/null
@@ -1,141 +0,0 @@
-CDECK ID>, SMDISP.
- SUBROUTINE SMDISP (JTARG)
-
-C- Display the compiler instructions for data type JTYP
-C. started 20-jan-94
-
- COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT,NUSLAT(2),DUMMY(34)
- CHARACTER SLLINE*512, SLERRM*256
- COMMON /SLATLN/ SLLINE, SLERRM
- COMMON /QUNIT/ IQREAD,IQPRNT, IQTTIN,IQTYPE, IQOFFL,IQRTTY,IQRSAV
- +, IQRFD,IQRRD,IQRSIZ, NQLPAT,NQUSED,NQLLBL, NQINIT
- PARAMETER (NTYSZ=4, NACSZ=4, NLNSZ=4, NRTSZ=10000)
- CHARACTER CHNLOG*80, CODEX*8, CHTYP*8
- COMMON /SHMKC/ NNLOG,CHNLOG, CODEX, CHTYP(17)
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
- +, NLINST(4,NACSZ,NTYSZ), IXINST(NLNSZ,4,NACSZ,NTYSZ)
- +, NCOUNTR(4,NTYSZ), NCSUMR(NTYSZ)
- +, NCOUNTH(4,NTYSZ), NCSUMH(NTYSZ), IXOPTN(4,3), IXOPTP(4,3)
- +, NRXQT, NROUT, NNAME(NRTSZ), NRALLC, NRDEL
- +, LUNSH, IXOBJ, IXSDIR, JXTYP, JXACT, JXSTR, LASTSH
-C-------------- End CDE --------------------------------
-
- CHARACTER LINEWK*100, CHWK*4
- EQUIVALENCE (LINEWK,SLLINE), (CHWK,LINEWK)
-
-
- JTYP = JTARG
- NLEAD = 9
- IF (JTYP.GE.4) GO TO 41
- WRITE (IQPRNT,9001)
-
-C-- check if stream 3 and 4 need to be displayed
-
- NSTRDO = 4
- IF (MOPTIO(22).NE.0) GO TO 24
- NSTRDO = 2
-
- DO 22 JSTR=3,4
- IXU = IXINST(1,JSTR,4,JTYP)
- IF (IXU.EQ.0) GO TO 22
- CALL NA_GET (IXU, CHWK, 1)
- IF (CHWK(1:2).NE.'=:') NSTRDO= JSTR
- 22 CONTINUE
-
-C---- Do all actions of type JTYP
-
- 24 DO 29 JACT=1,4
-
- JTAC = 4*(JTYP-1) + JACT
- IFSTR = 0
- NSTR = 1
- IF (JACT.EQ.2) GO TO 26
- IF (JACT.EQ.3) GO TO 26
- IFSTR = 1
- NSTR = NSTRDO
-
- 26 JSTR = 0
- 27 IF (JSTR.EQ.NSTR) GO TO 29
- JSTR = JSTR + 1
- NLINE = NLINST(JSTR,JACT,JTYP)
- JLINE = 1
-
- LINEWK = CHTYP(JTAC)
- IF (IFSTR.EQ.0) GO TO 28
-
- CALL CSETDI (JSTR,LINEWK,7,NLEAD)
- CALL CLEFT (LINEWK,4,NLEAD)
-
- 28 CALL NA_GET (IXINST(JLINE,JSTR,JACT,JTYP), LINEWK, NLEAD+1)
- JE = NESLAT - 1
- WRITE (IQPRNT,9002) LINEWK(1:JE)
-
- IF (JLINE.GE.NLINE) GO TO 27
- JLINE = JLINE + 1
- IF (JLINE.NE.2) GO TO 28
- LINEWK(1:NLEAD) = ' '
- GO TO 28
- 29 CONTINUE
- RETURN
-
-C---- Display start or end
-
- 41 IF (JTYP.GE.6) GO TO 51
- JACDO = 1
- IF (JTYP.NE.4) JACDO= 3
- JTYP = 4
- JTAC = 12 + JACDO
- LINEWK = CHTYP(JTAC)
- IFANY = 0
-
- DO 49 JACT=JACDO,JACDO+1
- DO 49 JSTR=1,4
- JLINE = 0
- NLINE = NLINST(JSTR,JACT,JTYP)
-
- 44 IF (JLINE.GE.NLINE) GO TO 49
- JLINE = JLINE + 1
-
- CALL NA_GET (IXINST(JLINE,JSTR,JACT,JTYP), LINEWK, NLEAD+1)
- JE = NESLAT - 1
-
- IF (IFANY.EQ.0) WRITE (IQPRNT,9001)
- WRITE (IQPRNT,9002) LINEWK(1:JE)
-
- IF (IFANY.NE.0) GO TO 44
- LINEWK(1:NLEAD) = ' '
- IFANY = 7
- GO TO 44
- 49 CONTINUE
- RETURN
-
-C---- Display source directory
-
- 51 IF (MOPTIO(22).EQ.0) THEN
- IF (IXSDIR.EQ.0) RETURN
- ENDIF
-
- LINEWK = CHTYP(17)
- CALL NA_GET (IXSDIR, LINEWK, NLEAD+1)
- JE = NESLAT - 1
-
- WRITE (IQPRNT,9001)
- WRITE (IQPRNT,9002) LINEWK(1:JE)
- RETURN
-
- 9001 FORMAT (A)
- 9002 FORMAT (1X,A)
- END
diff --git a/src/p5boot/p5lib/smjopt.f b/src/p5boot/p5lib/smjopt.f
deleted file mode 100644
index bc71fd4..0000000
--- a/src/p5boot/p5lib/smjopt.f
+++ /dev/null
@@ -1,103 +0,0 @@
-CDECK ID>, SMJOPT.
- SUBROUTINE SMJOPT
-
-C- Join the stream-specific and general options for all types
-C. started 5-may-94
-
- COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT,NUSLAT(2),DUMMY(34)
- CHARACTER SLLINE*512, SLERRM*256
- COMMON /SLATLN/ SLLINE, SLERRM
- COMMON /QUNIT/ IQREAD,IQPRNT, IQTTIN,IQTYPE, IQOFFL,IQRTTY,IQRSAV
- +, IQRFD,IQRRD,IQRSIZ, NQLPAT,NQUSED,NQLLBL, NQINIT
- PARAMETER (NTYSZ=4, NACSZ=4, NLNSZ=4, NRTSZ=10000)
- CHARACTER CHNLOG*80, CODEX*8, CHTYP*8
- COMMON /SHMKC/ NNLOG,CHNLOG, CODEX, CHTYP(17)
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
- +, NLINST(4,NACSZ,NTYSZ), IXINST(NLNSZ,4,NACSZ,NTYSZ)
- +, NCOUNTR(4,NTYSZ), NCSUMR(NTYSZ)
- +, NCOUNTH(4,NTYSZ), NCSUMH(NTYSZ), IXOPTN(4,3), IXOPTP(4,3)
- +, NRXQT, NROUT, NNAME(NRTSZ), NRALLC, NRDEL
- +, LUNSH, IXOBJ, IXSDIR, JXTYP, JXACT, JXSTR, LASTSH
-C-------------- End CDE --------------------------------
- CHARACTER LINEWK*256, COLWK(256)*1, CHWK*4
- EQUIVALENCE (LINEWK,SLLINE), (COLWK,SLLINE)
-
-
- DO 49 JTYP=1,3
- DO 49 JSTR=1,4
-
- LINEWK = ' '
- JPUT = 1
-
-C-- set the common options first
-
- JACT = 2
- NL = NLINST(1,JACT,JTYP)
- JL = 0
- 24 JL = JL + 1
- IF (JL.GT.NL) GO TO 31
- IX = IXINST(JL,1,JACT,JTYP)
- IF (IX.EQ.0) GO TO 31
- CALL NA_GET (IX,LINEWK,JPUT)
- JPUT = NESLAT + 1
- GO TO 24
-
-C-- add the stream-specific options
-
- 31 JACT = 1
- JSUS = JSTR
- NLOOP = 0
- 32 NL = NLINST(JSUS,JACT,JTYP)
- IF (NL.EQ.0) GO TO 46
- IX = IXINST(1,JSUS,JACT,JTYP)
- IF (IX.EQ.0) GO TO 46
-
- CALL NA_GET (IX,CHWK,1)
- IF (CHWK(1:2).NE.'=:') GO TO 35
- JSUS = ICDECI (CHWK,3,4)
- IF (JSUS.LE.0) GO TO 91
- IF (JSUS.GT.4) GO TO 91
- NLOOP = NLOOP + 1
- IF (NLOOP.GT.7) GO TO 92
- GO TO 32
-
- 35 JL = 1
- 36 CALL NA_GET (IX,LINEWK,JPUT)
- JPUT = NESLAT + 1
- JL = JL + 1
- IF (JL.GT.NL) GO TO 46
- IX = IXINST(JL,JSUS,JACT,JTYP)
- IF (IX.NE.0) GO TO 36
-
-C-- done, store this line
-
- 46 N = LNBLNK(LINEWK(1:JPUT))
- IF (N.EQ.0) GO TO 48
- CALL CSQMBL (LINEWK,1,N)
- N = NDSLAT
- N = NA_LONG (LINEWK(1:N))
- 48 IXOPTN(JSTR,JTYP) = N
- 49 CONTINUE
- RETURN
-
-C---- Faulty compiler instructions
-
- 91 WRITE (IQPRNT,9091) CHWK
- 9091 FORMAT (/' Trying to do: ',A)
- CALL P_KILL ('Faulty compile-stream re-direction')
-
- 92 CALL P_KILL ('Compile-stream re-direction loop')
- END
diff --git a/src/p5boot/p5lib/smrlog.f b/src/p5boot/p5lib/smrlog.f
deleted file mode 100644
index 560a4e7..0000000
--- a/src/p5boot/p5lib/smrlog.f
+++ /dev/null
@@ -1,268 +0,0 @@
-CDECK ID>, SMRLOG.
- SUBROUTINE SMRLOG
-
-C- Read the Patchy log file and crack each entry
-C. started 20-jan-94
-
- COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT,NUSLAT(2),DUMMY(34)
- CHARACTER SLLINE*512, SLERRM*256
- COMMON /SLATLN/ SLLINE, SLERRM
- COMMON /QUNIT/ IQREAD,IQPRNT, IQTTIN,IQTYPE, IQOFFL,IQRTTY,IQRSAV
- +, IQRFD,IQRRD,IQRSIZ, NQLPAT,NQUSED,NQLLBL, NQINIT
- COMMON /LUNSLN/IFLAUX, IXLUN(12)
- COMMON /MQCM/ NQSYSS,NQLINK, LQCSTA(3),LQCEND(3), NQMAX
- +, LQLSTA(5),LQLEND(5), LQADR,LQADR0,NQOFFS
- PARAMETER (NTYSZ=4, NACSZ=4, NLNSZ=4, NRTSZ=10000)
- CHARACTER CHNLOG*80, CODEX*8, CHTYP*8
- COMMON /SHMKC/ NNLOG,CHNLOG, CODEX, CHTYP(17)
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
- +, NLINST(4,NACSZ,NTYSZ), IXINST(NLNSZ,4,NACSZ,NTYSZ)
- +, NCOUNTR(4,NTYSZ), NCSUMR(NTYSZ)
- +, NCOUNTH(4,NTYSZ), NCSUMH(NTYSZ), IXOPTN(4,3), IXOPTP(4,3)
- +, NRXQT, NROUT, NNAME(NRTSZ), NRALLC, NRDEL
- +, LUNSH, IXOBJ, IXSDIR, JXTYP, JXACT, JXSTR, LASTSH
-C-------------- End CDE --------------------------------
- CHARACTER LINE*256
- EQUIVALENCE (LINE, SLLINE)
-
- CHARACTER SCDIR*80, FILEN*128, CHWK*4
- INTEGER STATF
-
-
- IAND (IZV,IZW) = AND (IZV, IZW)
- ISHFTR (IZW,NZB) = ISHFT (IZW, -NZB)
-
- IF (NRXQT.EQ.0) THEN
- MOPTIO(2) = MOPTIO(2) + MOPTIO(5)
- IF (MOPTIO(2).EQ.0) MOPTIO(1)= 1
- ENDIF
-
-C-- set the source directory
-
- IF (IXSDIR.NE.0) THEN
- CALL NA_GET (IXSDIR,SCDIR,1)
- NDIR = NDSLAT
- ELSE
- NDIR = 0
- ENDIF
-
-C-- get the .log file into memory
-
- NROUT = NRXQT
- NIGN = 0
- IFDOTH = 0
-
- CALL INIPAM (11, IXLUN(1), 0,0)
-
- 20 LQLEND(2) = LQLSTA(2)
- IQ(LQHOLD+2) = 0
- CALL ARRIVE (3)
-
-C---- Do next line
-
- JSLIN = IQ(LQHOLD+1) - 1
- NSLIN = IQ(LQHOLD+2)
- JSLEND = JSLIN + NSLIN
-
- 21 JSLIN = JSLIN + 1
- IF (JSLIN.GT.JSLEND) GO TO 39
-
- CALL LN_GET (JSLIN,LINE,512)
- NXX = NDSLAT
- IF (NXX.EQ.0) GO TO 21
- NXX = LNBLNK (LINE(1:NXX))
- IF (NXX.EQ.0) GO TO 21
- IF (IFDOTH.EQ.7) GO TO 65
-
-C-- get and analyse the logical stream type:n
-
- JTA = ICNEXT (LINE,1,NXX)
- JTE = NESLAT
- NTA = NDSLAT
- IF (JTA.GE.11) GO TO 21
- IF (JTA.GE.4) GO TO 81
- IF (NTA.LT.3) GO TO 81
-
- CALL SMCODE (LINE(JTA:JTA+NTA-1))
- IF (JXTYP.EQ.0) GO TO 21
- IF (JXTYP.GT.3) GO TO 21
- IF (JXACT.NE.4) GO TO 81
-
-C-- check if type:n is bypassed or re-directed
-
- NLOOP = 0
- 26 IXU = IXINST(1,JXSTR,JXACT,JXTYP)
- IF (IXU.EQ.0) GO TO 21
- CHWK = ' '
- CALL NA_GET (IXU,CHWK,1)
- IF (CHWK .EQ.'by ') GO TO 21
- IF (CHWK(1:2).NE.'=:') GO TO 31
-
- JXSTR = ICDECI (CHWK,3,4)
- IF (JXSTR.LT.1) GO TO 92
- IF (JXSTR.GT.4) GO TO 92
- NLOOP = NLOOP + 1
- IF (NLOOP.GT.7) GO TO 91
- GO TO 26
-
-C---- Compilable routine, get the routine name
-
- 31 JNA = ICNEXT (LINE,JTE,NXX)
- JNF = NESLAT - 1
- NNA = NDSLAT
- IF (NNA.EQ.0) GO TO 81
-
- JNE = ICFIND ('.', LINE,JNA,JNF) - 1
- IXNAME = NA_LONG (LINE(JNA:JNE))
- IFLNEW = 1
- IRCCO = 0
- IF (MOPTIO(1) .NE.0) GO TO 38
-
-C-- check the "same" flag is present
-
- IF (JNF.EQ.NXX) GO TO 38
- JINC = ICNEXT (LINE,JNF+1,NXX)
- IF (NDSLAT.NE.4) GO TO 38
- IF (LINE(JINC:JINC+3).NE.'same') GO TO 38
- JINCE = NESLAT
- IF (MOPTIO(21).NE.0) GO TO 41
-
-C---- register the new routine name
-
- 37 IFLNEW = 2
- 38 NROUT = NROUT + 1
- IF (NROUT.GT.NRTSZ) GO TO 93
- NNAME(NROUT) = ((IXNAME*8 + JXTYP)*8 + JXSTR)*4 + IFLNEW
-
- NCOUNTH(JXSTR,JXTYP) = NCOUNTH(JXSTR,JXTYP) + 1
- NCSUMH(JXTYP) = NCSUMH(JXTYP) + 1
- IF (IFLNEW.EQ.2) GO TO 21
- NCOUNTR(JXSTR,JXTYP) = NCOUNTR(JXSTR,JXTYP) + 1
- NCSUMR(JXTYP) = NCSUMR(JXTYP) + 1
- NRALLC = NRALLC + 1
- GO TO 21
-
-C---- Done
-
- 39 IF (JDKNEX.LT.4) GO TO 20
- IF (NROUT.EQ.NRXQT) GO TO 94
- CALL INIPAM (0,0, -1,0)
- RETURN
-
-C---- check dependencies for "same" routine in UPTODATE mode
-
- 41 IF (MOPTIO(2).NE.0) GO TO 46
-
-C-- find this routine in the .xqtlog file
-
- DO 42 JX=1,NRXQT
- JJ = NNAME(JX)
- IXNA = ISHFTR (JJ,8)
- IF (IXNA.EQ.IXNAME) GO TO 44
- 42 CONTINUE
- IRCCO = 1
- GO TO 38
-
-C-- check compiler options unchanged
-
- 44 JJ = ISHFTR(JJ,2)
- JSTR = IAND (JJ,7)
- JJ = ISHFTR (JJ,3)
- JTYP = IAND (JJ,7)
- IRCCO = 2
-
- IF (JTYP.NE.JXTYP) GO TO 38
- IF (IXOPTP(JSTR,JTYP).NE.IXOPTN(JXSTR,JXTYP)) GO TO 38
-
-C-- get the date and length of the .o file
-
- 46 CALL NA_GET (IXNAME,FILEN,1)
- NFI = NESLAT
- CALL NA_GET (IXOBJ, FILEN,NFI)
- NFI = NESLAT - 1
-
- ISTAO = STATF (FILEN(1:NFI), IQUEST)
- ILENO = IQUEST(7)
- ITIMO = IQUEST(9)
- IRCCO = 4
- IF (ISTAO.NE.0) GO TO 38
- IRCCO = 5
- IF (ILENO.EQ.0) GO TO 38
- ITIMOL = ISHFTR (ITIMO,3)
- ITIMOR = IAND (ITIMO,7)
-
-C-- get the date of the .f | .c | .a file
-
- IF (NDIR.GT.0) FILEN(1:NDIR)= SCDIR(1:NDIR)
- IRCCO = 6
-
- 61 FILEN(NDIR+1:NDIR+NNA)= LINE(JNA:JNA+NNA-1)
- NFI = NDIR + NNA
-
-C-- read the date and compare to that of the .o file
-
- ISTAF = STATF (FILEN(1:NFI), IQUEST)
- ITIMF = IQUEST(9)
- IF (ISTAF.NE.0) GO TO 38
-
- ITIMFL = ISHFTR (ITIMF,3)
- IF (ITIMFL.LT.ITIMOL) GO TO 64
- IF (ITIMFL.GT.ITIMOL) GO TO 38
-
- ITIMFR = IAND (ITIMF,7)
- IF (ITIMFR.GE.ITIMOR) GO TO 38
-
-C-- get the name for the next include file, if any
-
- 64 IF (JINCE.GT.NXX) GO TO 37
- IRCCO = 7
- 65 IFDOTH = 0
- JNA = ICNEXT (LINE,JINCE,NXX)
- JINCE = NESLAT
- NNA = NDSLAT
- IF (NNA.GT.1) GO TO 61
- IF (LINE(JNA:JNA).NE.'+') GO TO 61
- IFDOTH = 7
- JINCE = 1
- GO TO 21
-
-C---- Ignore meaningless input line
-
- 81 NIGN = NIGN + 1
- WRITE (IQPRNT,9081) LINE(1:NXX)
- 9081 FORMAT (' Ignored: ',A)
-
- IF (NIGN.LT.8) GO TO 21
- IF (NIGN.LT.(NROUT-NRXQT)/2) GO TO 21
-
- CALL P_KILL ('Faulty Patchy log file')
-
-C---- Faulty compiler instructions
-
- 91 CALL P_KILL ('Compile-stream re-direction loop')
-
- 92 WRITE (IQPRNT,9092) CHWK
- 9092 FORMAT (/' Trying to do: ',A)
- CALL P_KILL ('Faulty compile-stream re-direction')
-
- 93 WRITE (IQPRNT,9093) NRTSZ
- 9093 FORMAT (/' ***!!! More than',I7,' routines !!!***'
- F/' complain to zoll at cern.ch')
-
- CALL P_KILL ('Too many routines')
-
- 94 CALL P_KILL ('No compilable routines')
- END
diff --git a/src/p5boot/p5lib/smrxqt.f b/src/p5boot/p5lib/smrxqt.f
deleted file mode 100644
index de7f139..0000000
--- a/src/p5boot/p5lib/smrxqt.f
+++ /dev/null
@@ -1,135 +0,0 @@
-CDECK ID>, SMRXQT.
- SUBROUTINE SMRXQT
-
-C- Read the Nyshell .xqtlog file and crack each entry
-C. started 5-may-94
-
- COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT,NUSLAT(2),DUMMY(34)
- CHARACTER SLLINE*512, SLERRM*256
- COMMON /SLATLN/ SLLINE, SLERRM
- COMMON /QUNIT/ IQREAD,IQPRNT, IQTTIN,IQTYPE, IQOFFL,IQRTTY,IQRSAV
- +, IQRFD,IQRRD,IQRSIZ, NQLPAT,NQUSED,NQLLBL, NQINIT
- COMMON /MQCM/ NQSYSS,NQLINK, LQCSTA(3),LQCEND(3), NQMAX
- +, LQLSTA(5),LQLEND(5), LQADR,LQADR0,NQOFFS
- PARAMETER (NSLIFI=128)
- CHARACTER CHLIFI*(NSLIFI), CHLIEX*8
- COMMON /FLINKC/LUNOP,LUNFD,LUNOLD,LUNSIZ
- +, IXFLUN, NLIFI,CHLIFI,CHLIEX
- PARAMETER (NTYSZ=4, NACSZ=4, NLNSZ=4, NRTSZ=10000)
- CHARACTER CHNLOG*80, CODEX*8, CHTYP*8
- COMMON /SHMKC/ NNLOG,CHNLOG, CODEX, CHTYP(17)
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
- +, NLINST(4,NACSZ,NTYSZ), IXINST(NLNSZ,4,NACSZ,NTYSZ)
- +, NCOUNTR(4,NTYSZ), NCSUMR(NTYSZ)
- +, NCOUNTH(4,NTYSZ), NCSUMH(NTYSZ), IXOPTN(4,3), IXOPTP(4,3)
- +, NRXQT, NROUT, NNAME(NRTSZ), NRALLC, NRDEL
- +, LUNSH, IXOBJ, IXSDIR, JXTYP, JXACT, JXSTR, LASTSH
-C-------------- End CDE --------------------------------
- CHARACTER LINE*256
- EQUIVALENCE (LINE, SLLINE)
-
-
-C-- construct the name of the .xqtlog file
-
- CHLIFI = CHNLOG(1:NNLOG) // '.xqtlog'
- NLIFI = NNLOG + 7
-
-C-- get the .xqtlog file into memory
-
- IXTEMP = NA_LONG (CHLIFI(1:NLIFI))
- CALL INIPAM (11, IXTEMP, 0,2)
- IF (IXFLUN.LT.0) RETURN
-
- MODE = 0
- 20 LQLEND(2) = LQLSTA(2)
- IQ(LQHOLD+2) = 0
- CALL ARRIVE (3)
-
-C---- Do next line
-
- JSLIN = IQ(LQHOLD+1) - 1
- NSLIN = IQ(LQHOLD+2)
- JSLEND = JSLIN + NSLIN
-
- 21 JSLIN = JSLIN + 1
- IF (JSLIN.GT.JSLEND) GO TO 69
-
- CALL LN_GET (JSLIN,LINE,512)
- NXX = NDSLAT
- IF (NXX.EQ.0) GO TO 21
- NXX = LNBLNK (LINE(1:NXX))
- IF (NXX.EQ.0) GO TO 21
-
- IF (MODE.NE.0) GO TO 22
- IF (LINE(1:8).NE.'>.xqtlog') GO TO 91
- MODE = 1
- GO TO 21
-
-C-- get the logical stream type:n
-
- 22 JTA = ICNEXT (LINE,2,NXX)
- JTE = NESLAT
- NTA = NDSLAT
- IF (JTA.GE.7) GO TO 91
- IF (NTA.LT.3) GO TO 91
- CALL SMCODE (LINE(JTA:JTA+NTA-1))
- IF (JXTYP.EQ.0) GO TO 91
- IF (JXTYP.GT.3) GO TO 91
- IF (JXACT.NE.4) GO TO 91
- IF (MODE.GE.2) GO TO 24
-
-C-- get the compiler options in the prelude
-
- IF (LINE(1:1).NE.'>') GO TO 23
- IF (JTE.GT.NXX) GO TO 21
- JNA = ICFNBL (LINE,JTE,NXX)
- IXOPTP(JXSTR,JXTYP) = NA_LONG (LINE(JNA:NXX))
- GO TO 21
-
-C-- get the routine name
-
- 23 MODE = 2
- 24 JNA = ICNEXT (LINE,JTE,NXX)
- JNE = NESLAT
- NNA = NDSLAT
- IF (NNA.EQ.0) GO TO 91
-
-C---- register the new routine name
-
- IXNAME = NA_LONG (LINE(JNA:JNA+NNA-1))
- NROUT = NROUT + 1
- IF (NROUT.GT.NRTSZ) GO TO 93
- NNAME(NROUT) = ((IXNAME*8 + JXTYP)*8 + JXSTR)*4
- GO TO 21
-
-C---- Done
-
- 69 IF (JDKNEX.LT.4) GO TO 20
- CALL INIPAM (0,0, -1,0)
- NRXQT = NROUT
- RETURN
-
-C---- Fault
-
- 91 CALL INIPAM (0,0, -1,0)
- CALL P_KILL ('Not a valid .xqtlog file')
-
- 93 WRITE (IQPRNT,9093) NRTSZ
- 9093 FORMAT (/' ***!!! More than',I7,' routines !!!***'
- F/' complain to zoll at cern.ch')
-
- CALL P_KILL ('Too many routines')
- END
diff --git a/src/p5boot/p5lib/smsid.f b/src/p5boot/p5lib/smsid.f
deleted file mode 100644
index d006d25..0000000
--- a/src/p5boot/p5lib/smsid.f
+++ /dev/null
@@ -1,25 +0,0 @@
-CDECK ID>, SMSID.
- SUBROUTINE SMSID (JTYP,JSTR,LINE,JCOL)
-
-C- Set the stream ID like fort:3
-C. started 5-may-94
-
- CHARACTER LINE*(*)
-
-
- J = JCOL
- IF (JTYP.EQ.1) THEN
- LINE(J:J+3) = 'fort'
- J = J + 4
- ELSEIF (JTYP.EQ.2) THEN
- LINE(J:J+1) = 'cc'
- J = J + 2
- ELSE
- LINE(J:J+1) = 'as'
- J = J + 2
- ENDIF
-
- LINE(J:J) = ':'
- CALL CSETDI (JSTR, LINE,J+1,J+1)
- RETURN
- END
diff --git a/src/p5boot/p5lib/strmid.f b/src/p5boot/p5lib/strmid.f
deleted file mode 100644
index 4144c86..0000000
--- a/src/p5boot/p5lib/strmid.f
+++ /dev/null
@@ -1,24 +0,0 @@
-CDECK ID>, STRMID.
- SUBROUTINE STRMID (JASM,JDIV,LINE,JPUT)
-
-C- Construct stream ID like FORT:0 into LINE(JPUT:)
-C. started 13-nov-93
-
- COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT,NUSLAT(2),DUMMY(34)
- PARAMETER (JFO_TYP=1, JCC_TYP=2, JAS_TYP=3, JDA_TYP=4,
- + JSH_TYP=5, JCR_TYP=6, JIN_TYP=7, MAX_TYP=100)
- CHARACTER*16 CH_TYP(MAX_TYP), ACT_TYP
- COMMON /CM_TYP/ LUN_TYP, N_TYP, NAL_TYP, NDV_TYP, JBK_TYP
- +, JU_TYP(MAX_TYP), CH_TYP, ACT_TYP
-C-------------- End CDE --------------------------------
- CHARACTER LINE*128
-
-
- JP = JPUT
- LINE(JP:JP+15) = CH_TYP(JASM)
- JP = LNBLNK (LINE(1:JP+15)) + 1
- LINE(JP:JP) = ':'
- CALL CSETDI (JDIV, LINE,JP+1,JP+1)
- NESLAT = JP + 2
- RETURN
- END
diff --git a/src/p5boot/p5lib/sycrad.f b/src/p5boot/p5lib/sycrad.f
deleted file mode 100644
index 4a9b463..0000000
--- a/src/p5boot/p5lib/sycrad.f
+++ /dev/null
@@ -1,249 +0,0 @@
-CDECK ID>, SYCRAD.
- SUBROUTINE SYCRAD
-
-C- Process the cradle
-C. started 18-july-95
-
- PARAMETER (KM1=1,KM2=2,KM3=4,KM4=8,KM5=16,KM6=32,KM7=64,KM8=128,
- + KM9=256, KM10=512, KM11=1024, KM12=2048, KM13=4096, KM14=8192,
- + KM15=16384, KM16=32768, KM17=65536, KM18=131072, KM19=262144)
- PARAMETER (NBANKS=19,JBKPAT=1, JBKDEC=2, JBKORG=3, JBKINC=4,
- + JBKHOL=5, JBKKEE=6, JBKACT=7, JBKMAT=8, JBKXSQ=9,
- + JBKPRE=10,JBKGAR=11,JBKSMH=12,JBKSMT=13,JBKSML=14,
- + JBKSMX=15,JBKARR=16,JBKASA=17,JBKPAM=18,JBKRPA=19)
- COMMON /QBANKS/MMBANK(5,NBANKS)
- COMMON /QPAGE/ NQLMAX,NQLTOL,NQLTOK,NQCMAX,NQCPGH,NQPAGE
- +, NQWYLDO,NQWYL,NQNEWH,NQJOIN,NQDKNO,NQDKPG
- COMMON /QUNIT/ IQREAD,IQPRNT, IQTTIN,IQTYPE, IQOFFL,IQRTTY,IQRSAV
- +, IQRFD,IQRRD,IQRSIZ, NQLPAT,NQUSED,NQLLBL, NQINIT
- PARAMETER (MCCNIL=1, MCCKIL=2, MCCINC=3, MCCCDE=4, MCCSEQ=5,
- + MCCXSQ=6, MCCTRU=7, MCCFAL=8, MCCELS=9, MCCEND=10,
- + MCCSEL=11, MCCSES=12, MCCFAU=13, MCCSKI=14,
- + MCCKEE=15, MCCDEL=16, MCCREP=17, MCCADB=18, MCCADD=19,
- + MCCUSE=20, MCCXDI=21, MCCDIV=22, MCCLIS=23, MCCEXE=24, MCCIMI=25,
- + MCCASM=26, MCCUPD=27, MCCNAM=28, MCCGAP=29, MCCMOR=30, MCCONL=31,
- + MCCFOR=32, MCCSUS=33, MCCOPT=34, MCCOP2=35, MCCSHO=36, MCCPAM=37,
- + MCCQUI=38, MCCEOD=39, MCCDEC=40, MCCPAT=41, MCCTIT=42)
- CHARACTER CCKORG*256, CCKARD*256, CCCOMF*256
- COMMON /CCPARA/NCHCCD,NCHCCT, JCCTYP,JCCLEV,JCCSL,MCCPAR(240)
- +, NCCPAR,MXCCIF,JCCIFV,JCCBAD,JCCWAR,ICCSUB,JCCWK(4)
- +, JCCPP,JCCPD,JCCPZ,JCCPT,JCCPIF,JCCPC,JCCPN
- +, NCCPP,NCCPD,NCCPZ,NCCPT,NCCPIF,NCCPC,NCCPN
- +, JCCEND, NCHCCC,IXCCC, CCKORG, CCKARD, CCCOMF
- CHARACTER CHEXPD*68
- COMMON /CHEXC/ IXEXPAM, IXEXPAT,IXEXDEC,IXEXID, NCHEPD, CHEXPD
- COMMON /MUSEBC/ MX_FORC, MU_GLOB, MU_PAT, MU_DECK, MU_INH, MU_FORG
- +, MX_TRAN, MX_FORG, MX_SINH, MX_SELF, NVEXDK(6)
- CHARACTER CHTAG*80, CHWYL*16
- COMMON /TAGC/ LLORG,LNORG,LLACT,LNACT, LALTN,LMODE,NCHTAG
- +, CHTAG,CHWYL
- COMMON /MQCM/ NQSYSS,NQLINK, LQCSTA(3),LQCEND(3), NQMAX
- +, LQLSTA(5),LQLEND(5), LQADR,LQADR0,NQOFFS
- PARAMETER (KQGARB=1,KQARRV=3,KQKEEP=4,KQPREP=5,KQMAIN=6,KQPAST=8)
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
- COMMON /M_ANAC/LOWAN,KDOAN,LDOAN,LUPAN,MODEAN,MEXAN,LEVAN,KKM5AN
- +, NEWDEC,NEWCTL,NEWFOR,NEWNIL,NEWINC
-C-------------- End CDE --------------------------------
- PARAMETER (IXCRA=2)
- CHARACTER MARK*4, LINE*8
- EQUIVALENCE (LINE,TEXT)
-
- IOR (IZV,IZW) = OR (IZV, IZW)
-
-
- LARRV = LACRAD
- NDKSAV = NQDKNO
- NQDKNO = 0
- NSLORG = 1
- IXEXPAM = 0
- NCHTAG = 0
- NQWYLDO = 0
- NVEXDK(2) = 1
- NVEXDK(6) = 1
- CALL DPBLAN (0)
- IF (INCRAD.NE.3) GO TO 21
- IF (IQREAD.NE.0) GO TO 27
-
-C---- Run in no-cradle mode
-
- MU_GLOB = IOR (MU_GLOB, KM2)
-
- LINE = '+PAM. '
- MLIAD(2) = 7
- JCCTYP = MCCPAM
- CALL CCKRAK (1)
- CALL DOAPAM
- GO TO 77
-
-C------ Restart the cradle after having read a PAM file
-
- 21 IF (IQREAD.EQ.0) GO TO 79
- CALL VZERO (IQ(LQHOLD+1),3)
- CALL ARRIVE (1)
-
-C-- lift PAT bank for P=CRA*
-
- CALL CREAPD (IXCRA,-1,1)
- LPCRA = LEXP
- LEXD = 0
-
- IXEXPAT = IXCRA
- IXEXDEC = IXCRA
- IXEXID = IXCRA
- LDECO = 0
- NQNEWH = 1
- NQJOIN = 1
- NSLORG = 1
- INCRAD = 2
-
- 27 IF (JDKTYP.GE.6) GO TO 79
- IF (JDKTYP.GE.4) GO TO 72
-
-C-------- Do next deck
-
- 29 JDKTYP = 1
- IF (JDKNEX.EQ.0) CALL ARRIVE (2)
- CALL DOMAPA (0)
- JSLORG = JSLZER - NSLORG
- NSLHAV = IQ(LQHOLD+3)
-
- LUPAN = 0
- LDOAN = KQPREP + 1
- KKM5AN = 0
-
-C---- Next PREP bank
-
- 31 LDOAN = LQ(LDOAN-1)
- IF (LDOAN.EQ.0) GO TO 39
-
-C-- MODEAN = 0 self material
-C- 1 CDE expansion
-C- 2 comment line
-C- 3 +SELF header line
-C- 4 +CDE call line
-C- 5 foreign material
-C- 6 control line
-
- JCCTYP = JBYT (IQ(LDOAN),9,6)
- IF (JCCTYP.LT.MCCKEE) GO TO 33
- IF (JCCTYP.EQ.MCCKEE) GO TO 34
- IF (JCCTYP.EQ.MCCUSE) GO TO 34
- IF (JCCTYP.EQ.MCCLIS) GO TO 34
- IF (JCCTYP.LT.MCCFOR) GO TO 33
- IF (JCCTYP.LE.MCCOP2) GO TO 34
-
-C---- list no-action lines
-
- 33 JCCTYP = 0
- CALL DPLIST (0,LDOAN,LUPAN,0)
- GO TO 31
-
-C---- Nysynopt cradle actions
-
- 34 CALL CCKRAK (IQ(LDOAN+1))
-
-C-- Do : +KEEP
-
- IF (JCCTYP.EQ.MCCKEE) THEN
- CALL SYKEEP
- GO TO 38
- ENDIF
-
-C-- Do : +USE +LIST +FORCE +SUSPEND
-
- 36 IF (JCCTYP.LE.MCCSUS) THEN
- CALL X_USE
- GO TO 38
- ENDIF
-
-C-- Do : +OPTION +PARAMETER +SHOW
-
- IF (JCCTYP.LE.MCCSHO) THEN
- CALL X_OPT
- GO TO 38
- ENDIF
-
- CALL P_CRASH ('SYCRAD should not reach this point')
-
- 38 CALL DPLIST (6,LDOAN,LUPAN,1)
- GO TO 31
-
-C---- step to the next deck
-
- 39 INCRAD = 1
- CALL ARRNXD (1)
- IF (JDKTYP.GE.6) GO TO 79
-
- NSLORG = NSLORG + NSLHAV
- IF (JDKTYP.LE.3) GO TO 29
-
-
-C------ Handle +PAM or +QUIT
-
- 72 JSLCRA = IQ(LQHOLD+1)
- NSLCRA = IQ(LQHOLD+2)
- JTXCRA = MLIAD(JSLCRA)
- NTX = MLIAD(JSLCRA+1) - JTXCRA - NCHNEWL
- JCCTYP = JPTYPE (TEXT(JTXCRA))
-
- MARK = ' + '
- CALL CCKRAK (JSLCRA)
- IF (JCCBAD.NE.0) MARK = ' *! '
-
-C-- print the c/line
-
- CALL DPLINE (NSLORG,MARK,NTX,TEXT(JTXCRA))
-
-C-- exit if faulty c/line
-
- IF (JCCBAD.NE.0) GO TO 91
-
-C------ Accepted control line +PAM or +QUIT
-
- IF (JCCTYP.EQ.MCCQUI) GO TO 79
- NSLORG = 0
-
-C-- Digest the +PAM parameters to bank at LPAM
-
- CALL DOAPAM
- IF (JCCBAD.NE.0) GO TO 91
-
-C-- Save cradle material after +PAM, ...
-
- JSLCRA = JSLCRA + 1
- NSLCRA = NSLCRA - 1
- IF (NSLCRA.EQ.0) GO TO 77
-
- CALL MQLIFT (LASAV, LACRAD,-2, JBKASA,1)
- IQ(LASAV+1) = JSLCRA
- IQ(LASAV+2) = NSLCRA
-
- 77 IQ(LQHOLD+2) = 0
- IQ(LPAM+14) = IQ(LPAM+14) + 1
- NQDKNO = NDKSAV
- JANSW = 0
- RETURN
-
-C-- +QUIT or EOF reached
-
- 79 JANSW = 1
- RETURN
-
-C---- Trouble
-
- 91 IF (JCCTYP.EQ.MCCQUI) GO TO 79
- CALL P_FATAL ('faulty line +PAM,...')
- END
diff --git a/src/p5boot/p5lib/syforg.f b/src/p5boot/p5lib/syforg.f
deleted file mode 100644
index 66103e3..0000000
--- a/src/p5boot/p5lib/syforg.f
+++ /dev/null
@@ -1,101 +0,0 @@
-CDECK ID>, SYFORG.
- SUBROUTINE SYFORG (IXP,IXD)
-
-C- Remember actions +ADD etc
-C. started 18-july-95
-
- PARAMETER (NBANKS=19,JBKPAT=1, JBKDEC=2, JBKORG=3, JBKINC=4,
- + JBKHOL=5, JBKKEE=6, JBKACT=7, JBKMAT=8, JBKXSQ=9,
- + JBKPRE=10,JBKGAR=11,JBKSMH=12,JBKSMT=13,JBKSML=14,
- + JBKSMX=15,JBKARR=16,JBKASA=17,JBKPAM=18,JBKRPA=19)
- COMMON /QBANKS/MMBANK(5,NBANKS)
- COMMON /QPAGE/ NQLMAX,NQLTOL,NQLTOK,NQCMAX,NQCPGH,NQPAGE
- +, NQWYLDO,NQWYL,NQNEWH,NQJOIN,NQDKNO,NQDKPG
- PARAMETER (MCCNIL=1, MCCKIL=2, MCCINC=3, MCCCDE=4, MCCSEQ=5,
- + MCCXSQ=6, MCCTRU=7, MCCFAL=8, MCCELS=9, MCCEND=10,
- + MCCSEL=11, MCCSES=12, MCCFAU=13, MCCSKI=14,
- + MCCKEE=15, MCCDEL=16, MCCREP=17, MCCADB=18, MCCADD=19,
- + MCCUSE=20, MCCXDI=21, MCCDIV=22, MCCLIS=23, MCCEXE=24, MCCIMI=25,
- + MCCASM=26, MCCUPD=27, MCCNAM=28, MCCGAP=29, MCCMOR=30, MCCONL=31,
- + MCCFOR=32, MCCSUS=33, MCCOPT=34, MCCOP2=35, MCCSHO=36, MCCPAM=37,
- + MCCQUI=38, MCCEOD=39, MCCDEC=40, MCCPAT=41, MCCTIT=42)
- CHARACTER CCKORG*256, CCKARD*256, CCCOMF*256
- COMMON /CCPARA/NCHCCD,NCHCCT, JCCTYP,JCCLEV,JCCSL,MCCPAR(240)
- +, NCCPAR,MXCCIF,JCCIFV,JCCBAD,JCCWAR,ICCSUB,JCCWK(4)
- +, JCCPP,JCCPD,JCCPZ,JCCPT,JCCPIF,JCCPC,JCCPN
- +, NCCPP,NCCPD,NCCPZ,NCCPT,NCCPIF,NCCPC,NCCPN
- +, JCCEND, NCHCCC,IXCCC, CCKORG, CCKARD, CCCOMF
- COMMON /MUSEBC/ MX_FORC, MU_GLOB, MU_PAT, MU_DECK, MU_INH, MU_FORG
- +, MX_TRAN, MX_FORG, MX_SINH, MX_SELF, NVEXDK(6)
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
- COMMON /M_ANAC/LOWAN,KDOAN,LDOAN,LUPAN,MODEAN,MEXAN,LEVAN,KKM5AN
- +, NEWDEC,NEWCTL,NEWFOR,NEWNIL,NEWINC
-C-------------- End CDE --------------------------------
-
- IOR (IZV,IZW) = OR (IZV, IZW)
- ISHFTL (IZW,NZB) = LSHIFT (IZW, NZB)
-
-
- IF (IXP.EQ.-7) GO TO 41
-
-C---- Create ACT bank for new action going out
-
- IF (MOPTIO(24).NE.0) RETURN
- IF (JCCBAD.NE.0) GO TO 91
- IF (IXP.LE.0) GO TO 91
- CALL CREAPD (IXP, IXD, 0)
- IF (LCRD.EQ.0) GO TO 91
- IF (LDECO.EQ.0) CALL CRDECO
-
- JSLCL = IQ(LDOAN+1)
- JACTU = ISHFTL (JCCTYP-MCCDEL,8)
-
-C-- lift the ACT bank
-
- 24 CALL MQLIFT (LACT,LCRD,-2,JBKACT,1)
-
- IQ(LACT) = IOR (IQ(LACT), JACTU)
- LQ(LACT-3) = LDECO
-C! IQ(LACT+1) = JSLCL
-C! IQ(LACT+2) = 1
- IQ(LACT+3) = JSLCL - JSLORG
- IQ(LACT+4) = MCCPAR(JCCPC+1)
- IQ(LACT+5) = MCCPAR(JCCPC+2)
- IF (JCCTYP.NE.MCCDEL) RETURN
-
-C-- iterate if multiple +DEL
-
- JCCPC = JCCPC + 3
- NCCPC = NCCPC - 1
- IF (NCCPC.NE.0) GO TO 24
- RETURN
-
-C---- List action into here
-
- 41 IF (NVEXDK(2).EQ.0) RETURN
- LOWAN = LDOAN
- LUPAN = LQ(LDOAN-2)
- NQWYLDO = 0
- CALL DPLACT
- NQWYLDO = 7
- LUPAN = 0
- RETURN
-
-C---- Faulty action header line
-
- 91 CONTINUE
- RETURN
- END
diff --git a/src/p5boot/p5lib/sykeep.f b/src/p5boot/p5lib/sykeep.f
deleted file mode 100644
index 06ed844..0000000
--- a/src/p5boot/p5lib/sykeep.f
+++ /dev/null
@@ -1,240 +0,0 @@
-CDECK ID>, SYKEEP.
- SUBROUTINE SYKEEP
-
-C- Remember sequence definition
-C. started 18-july-95
-
- PARAMETER (KM1=1,KM2=2,KM3=4,KM4=8,KM5=16,KM6=32,KM7=64,KM8=128,
- + KM9=256, KM10=512, KM11=1024, KM12=2048, KM13=4096, KM14=8192,
- + KM15=16384, KM16=32768, KM17=65536, KM18=131072, KM19=262144)
- PARAMETER (KMA=1,KMB=2,KMC=4,KMD=8,KME=16,KMF=32,KMG=64,KMH=128,
- + KMI=256, KMJ=512, KMK=KM11, KML=KM12, KMM=KM13, KMN=KM14,
- + KMO=KM15, KMP=KM16, KMQ=KM17, KMR=KM18, KMS=KM19)
- PARAMETER (NBANKS=19,JBKPAT=1, JBKDEC=2, JBKORG=3, JBKINC=4,
- + JBKHOL=5, JBKKEE=6, JBKACT=7, JBKMAT=8, JBKXSQ=9,
- + JBKPRE=10,JBKGAR=11,JBKSMH=12,JBKSMT=13,JBKSML=14,
- + JBKSMX=15,JBKARR=16,JBKASA=17,JBKPAM=18,JBKRPA=19)
- COMMON /QBANKS/MMBANK(5,NBANKS)
- PARAMETER (MCCNIL=1, MCCKIL=2, MCCINC=3, MCCCDE=4, MCCSEQ=5,
- + MCCXSQ=6, MCCTRU=7, MCCFAL=8, MCCELS=9, MCCEND=10,
- + MCCSEL=11, MCCSES=12, MCCFAU=13, MCCSKI=14,
- + MCCKEE=15, MCCDEL=16, MCCREP=17, MCCADB=18, MCCADD=19,
- + MCCUSE=20, MCCXDI=21, MCCDIV=22, MCCLIS=23, MCCEXE=24, MCCIMI=25,
- + MCCASM=26, MCCUPD=27, MCCNAM=28, MCCGAP=29, MCCMOR=30, MCCONL=31,
- + MCCFOR=32, MCCSUS=33, MCCOPT=34, MCCOP2=35, MCCSHO=36, MCCPAM=37,
- + MCCQUI=38, MCCEOD=39, MCCDEC=40, MCCPAT=41, MCCTIT=42)
- CHARACTER CCKORG*256, CCKARD*256, CCCOMF*256
- COMMON /CCPARA/NCHCCD,NCHCCT, JCCTYP,JCCLEV,JCCSL,MCCPAR(240)
- +, NCCPAR,MXCCIF,JCCIFV,JCCBAD,JCCWAR,ICCSUB,JCCWK(4)
- +, JCCPP,JCCPD,JCCPZ,JCCPT,JCCPIF,JCCPC,JCCPN
- +, NCCPP,NCCPD,NCCPZ,NCCPT,NCCPIF,NCCPC,NCCPN
- +, JCCEND, NCHCCC,IXCCC, CCKORG, CCKARD, CCCOMF
- COMMON /MQCM/ NQSYSS,NQLINK, LQCSTA(3),LQCEND(3), NQMAX
- +, LQLSTA(5),LQLEND(5), LQADR,LQADR0,NQOFFS
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
- COMMON /M_ANAC/LOWAN,KDOAN,LDOAN,LUPAN,MODEAN,MEXAN,LEVAN,KKM5AN
- +, NEWDEC,NEWCTL,NEWFOR,NEWNIL,NEWINC
-C-------------- End CDE --------------------------------
- PARAMETER (NOFFLI=2, NOFFDA=4)
-
- IAND (IZV,IZW) = AND (IZV, IZW)
- IOR (IZV,IZW) = OR (IZV, IZW)
- ISHFTL (IZW,NZB) = LSHIFT (IZW, NZB)
-
-
- IF (JCCBAD.NE.0) GO TO 91
- MOPT = MCCPAR(JCCPT+1)
- IXS = MCCPAR(JCCPZ+1)
- IF (LDECO.EQ.0) CALL CRDECO
- IF (INCRAD.EQ.0) GO TO 41
-
-C-------- +KEEP in the cradle --------------------------
-
-C-- check sequence existing
-
- CALL SYLKEEP (LACT)
- IF (LACT.NE.0) GO TO 39
- KACT = IQUEST(1)
-
- CALL MQLIFT (LACT,KACT,0,JBKKEE,1)
-
- IQ(LACT-3) = LDECO
- IQ(LACT) = IOR (IQ(LACT), KM18)
- IQ(LACT+4) = IXS
-
- IF (IAND(MOPT,KMS).EQ.0) THEN
- IQ(LACT) = IOR (IQ(LACT), KM12)
- ELSE
- IQ(LACT) = IOR (IQ(LACT), KM14)
- ENDIF
-
-C-- no associated material for a +KEEP in the cradle
-
- 39 NSL = IQ(LDOAN+2)
- IF (NSL.GE.2) L = M_SPLIT (LDOAN, IQ(LDOAN+1)+1)
- RETURN
-
-C-------- +KEEP on the PAM file --------------------------
-
- 41 IF (IAND(MOPT,KMD).NE.0) RETURN
-
-C-- check sequence existing
-
- CALL SYLKEEP (LACT)
- KACT = IQUEST(1)
- IF (LACT.EQ.0) GO TO 47
-
-C-- check sequence is special or blocked from the cradle
-
- MACT = IQ(LACT)
- IF (IAND(MACT,KM12+KM13).NE.0) RETURN
- IF (IAND(MACT,KM14).EQ.0) GO TO 44
-
-C-- sequence had been registered with T=SINGLE
-
- IF (IAND(MACT,KM15).NE.0) RETURN
- CALL TOGARB (KACT,0)
- IFLSING = 7
- GO TO 48
-
-C-- a new definition of an existing sequence
-
- 44 KACT = LACT - 4
- LACT = LQ(KACT)
- IF (LACT.NE.0) GO TO 44
-
-C-- create the heading KEEP bank
-
- 47 IFLSING = 0
- 48 CALL MQLIFT (LACT,KACT,0,JBKKEE,1)
- CALL SYSPLIT (LDOAN)
-
- IQ(LACT-3) = LDECO
- IQ(LACT) = IOR (IQ(LACT), KM7)
- IQ(LACT+1) = IQ(LDOAN+1) + 1
- IQ(LACT+2) = IQ(LDOAN+2) - 1
- IQ(LACT+3) = IQ(LACT+1) - JSLORG
- IQ(LACT+4) = IXS
- IF (IAND(MOPT,KMN).NE.0) IQ(LACT) = IOR (IQ(LACT), KM16)
- IF (IFLSING.NE.0) IQ(LACT) = IOR (IQ(LACT), KM14+KM15)
-
-C------ create MAT continuation banks for KEEP
-
- IFLSGL = KM5+KM6+KM17
- IFLMSK = KM5+KM6
- LAST = LACT
- IF (NCCPP.NE.0) IFLSGL= 0
-
- KJOIN = LACT - 2
- LDOTK = LDOAN
- 51 LDOTK = LQ(LDOTK-1)
- IF (LDOTK.EQ.0) GO TO 69
- IF (LQ(LDOTK-2).NE.0) GO TO 51
-
- JCCTYP = JBYT (IQ(LDOTK),9,6)
- IF (JCCTYP.GE.MCCSEL) GO TO 69
-
- JSLNEW = IQ(LDOTK+1)
- NSLNEW = IQ(LDOTK+2)
- NUMNEW = JSLNEW - JSLORG
- IF (NSLNEW.EQ.0) GO TO 51
-
- IF (JCCTYP.LT.MCCCDE) GO TO 62
- IF (JCCTYP.GE.MCCXSQ) GO TO 61
-
-C-- handle +CDE or +SEQ
-
- CALL CCKRAK (JSLNEW)
-
-C-- check +SEQ,..., T=DUMMY
-
- IF (IAND(MCCPAR(JCCPT+1),KMD).NE.0) GO TO 51
-
-C---- try immediate substitution for +SEQ, single name
-
- IF (NCCPZ.NE.1) GO TO 54
- IF (NCCPIF.NE.0) GO TO 54
-
- IXC = MCCPAR(JCCPZ+1)
- CALL SYLSEQ (LSQF, IXC, 0,0)
- IF (LSQF.EQ.0) GO TO 54
- IF (IAND(IQ(LSQF),KM17).EQ.0) GO TO 54
-
-C-- do the substitution
-
- JSLNEW = IQ(LSQF+1)
- IF (JSLNEW.LT.LQLSTA(4)) THEN
- JSLNEW = LN_COP4 (JSLNEW,1)
- IQ(LSQF+1) = JSLNEW
- ENDIF
-
- JCCTYP = 0
-
-C-- does the KEEP bank have zero lines?
- IF (LAST.NE.LACT) GO TO 62
- IF (IQ(LACT+3).NE.NUMNEW) GO TO 62
- IQ(LACT+1) = JSLNEW
- IQ(LACT+2) = 1
- GO TO 51
-
-
-C---- lift XSQ bank for +CDE or +SEQ
-
- 54 NCCPZ = MIN (NCCPZ,61)
-
- MMBANK(3,JBKXSQ) = NCCPZ + NOFFLI
- MMBANK(5,JBKXSQ) = NCCPZ + NOFFDA
- CALL MQLIFT (LMAT,KJOIN,0,JBKXSQ,1)
-
- IQ(LMAT) = IOR (IQ(LMAT), ISHFTL(JCCTYP,8))
- IQ(LMAT) = IOR (IQ(LMAT), IAND(MCCPAR(JCCPT+1),KMP))
-
- IQ(LMAT+NOFFDA) = NCCPZ
- CALL UCOCOP (MCCPAR(JCCPZ+1),IQ(LMAT+NOFFDA+1),NCCPZ,1,3,1)
- IFLMSK = 0
- GO TO 63
-
-C---- lift new MAT bank
-
- 61 IFLMSK = 0
- 62 CALL MQLIFT (LMAT,KJOIN,0,JBKMAT,1)
-
- IQ(LMAT) = IOR (IQ(LMAT), ISHFTL(JCCTYP,8))
- 63 LQ(LMAT-2) = LDECO
- IQ(LMAT+1) = JSLNEW
- IQ(LMAT+2) = NSLNEW
- IQ(LMAT+3) = NUMNEW
-
- LAST = LMAT
- KJOIN = LMAT - 1
- GO TO 51
-
-C---- End of material for KEEP, finalize
-
- 69 IF (LQ(LACT-2).NE.0) IFLSGL= 0
- IF (IQ(LACT+2).NE.1) IFLSGL= 0
-
- IFLMSK = IOR (IFLMSK, IFLSGL)
- IQ(LACT) = IOR (IQ(LACT), IFLMSK)
-
- JCCTYP = MCCKEE
- RETURN
-
-C---- Faulty control line
-
- 91 CONTINUE
- RETURN
- END
diff --git a/src/p5boot/p5lib/syktag.f b/src/p5boot/p5lib/syktag.f
deleted file mode 100644
index beb5f52..0000000
--- a/src/p5boot/p5lib/syktag.f
+++ /dev/null
@@ -1,108 +0,0 @@
-CDECK ID>, SYKTAG.
- SUBROUTINE SYKTAG (LEVEL,IXKEEP)
-
-C- Construct the next tail for sequence IXKEEP at level LEVEL
-C- if LEVEL < 0: simply print the pending tag
-C. started 24-aug-95
-
- COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT,NUSLAT(2),DUMMY(34)
- PARAMETER (KM1=1,KM2=2,KM3=4,KM4=8,KM5=16,KM6=32,KM7=64,KM8=128,
- + KM9=256, KM10=512, KM11=1024, KM12=2048, KM13=4096, KM14=8192,
- + KM15=16384, KM16=32768, KM17=65536, KM18=131072, KM19=262144)
- CHARACTER CQBLAN*128, CQEQS*128, CQCETA*32
- CHARACTER CQAPO*1, CQBSL*1, CQTAB*1
- COMMON /QCHAR/ CQBLAN, CQEQS, CQCETA, CQAPO, CQBSL, CQTAB
- COMMON /QPAGE/ NQLMAX,NQLTOL,NQLTOK,NQCMAX,NQCPGH,NQPAGE
- +, NQWYLDO,NQWYL,NQNEWH,NQJOIN,NQDKNO,NQDKPG
- COMMON /QUNIT/ IQREAD,IQPRNT, IQTTIN,IQTYPE, IQOFFL,IQRTTY,IQRSAV
- +, IQRFD,IQRRD,IQRSIZ, NQLPAT,NQUSED,NQLLBL, NQINIT
- CHARACTER CHTAG*80, CHWYL*16
- COMMON /TAGC/ LLORG,LNORG,LLACT,LNACT, LALTN,LMODE,NCHTAG
- +, CHTAG,CHWYL
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
-C-------------- End CDE --------------------------------
- CHARACTER MASK*4, MASKK(4)*4
- DATA MASKK / ' z ', ' .z ', ' y ', ' .y ' /
-
- IAND (IZV,IZW) = AND (IZV, IZW)
-
-
- LEV = LEVEL
- IF (NCHTAG.LE.0) GO TO 31
- IF (LMODE.LT.2) GO TO 30
-
-C-- Print pending tag
-
- CALL DPHEAD
- NQUSED = NQUSED + 1
- NQLLBL = 0
-
- JP = MIN (LMODE,3) - 1
- IF (LALTN.NE.0) JP= JP + 2
- MASK = MASKK(JP)
-
- NBL = NQCMAX - NCHTAG - 26
- NBL = MIN (NBL,75)
- WRITE (IQPRNT,9024) CHWYL,MASK,CQBLAN(1:NBL),CHTAG(1:NCHTAG)
- 9024 FORMAT (A,A,'-void-',A,A)
-
- 30 NCHTAG = 0
- 31 IF (LEV.LT.0) RETURN
- CHWYL = ' '
- IF (IXKEEP.EQ.0) GO TO 41
- CHTAG(1:10) = ' '
-
-C-- construct prefix
-
- NUMORG = IAND (IQ(LNORG), KM19-1)
- CALL CSETDI (NUMORG, CHWYL,2,5)
- CALL CLEFT (CHWYL,2,5)
- JP = NESLAT
- CHWYL(JP:JP) = '='
- JP = JP + 1
-
- IXORG = IQ(LNORG+1)
- IF (IXORG.EQ.0) IXORG = IQ(LNORG+2)
- CALL NA_GET (IXORG,CHWYL,JP)
-
-C-- construct tag
-
- IF (LEV.NE.0) THEN
- CALL CSETDI (LEV+1,CHTAG,1,2)
- JP = 4
- ELSE
- JP = 1
- ENDIF
-
- CALL NA_GET (IXKEEP,CHTAG,JP)
- NCHTAG = NESLAT - 1
- LLORG = LNORG
- LALTN = IFALTN
- LMODE = 2 + LEV
- NQWYLDO = -1
- RETURN
-
-C-- construct tag to signal continuation
-
- 41 CHTAG(1:12) = ' continued'
- CALL CSETDI (LEV+1,CHTAG,1,2)
- NCHTAG = 12
- LLORG = 0
- LALTN = IFALTN
- LMODE = -2
- NQWYLDO = -3
- RETURN
- END
diff --git a/src/p5boot/p5lib/sylkeep.f b/src/p5boot/p5lib/sylkeep.f
deleted file mode 100644
index d29cf0c..0000000
--- a/src/p5boot/p5lib/sylkeep.f
+++ /dev/null
@@ -1,71 +0,0 @@
-CDECK ID>, SYLKEEP.
- SUBROUTINE SYLKEEP (LSEQ)
-
-C- Find the KEEP bank for the sequence decribed by
-C- the current +KEEP control line;
-C- create target PAT/DECK banks if local sequence.
-
-C- return LSEQ L-adr of the sequence found, or LSEQ=0
-C- IQUEST(1) K-adr of the seq found, if found
-C- else: K-adr for attachment at end
-C- IQUEST(2) zero: sequence is global
-C- -ve: sequence is local
-C- IQUEST(11) zero if global sequence
-C. started 29-aug-92
-
- PARAMETER (KM1=1,KM2=2,KM3=4,KM4=8,KM5=16,KM6=32,KM7=64,KM8=128,
- + KM9=256, KM10=512, KM11=1024, KM12=2048, KM13=4096, KM14=8192,
- + KM15=16384, KM16=32768, KM17=65536, KM18=131072, KM19=262144)
- CHARACTER CCKORG*256, CCKARD*256, CCCOMF*256
- COMMON /CCPARA/NCHCCD,NCHCCT, JCCTYP,JCCLEV,JCCSL,MCCPAR(240)
- +, NCCPAR,MXCCIF,JCCIFV,JCCBAD,JCCWAR,ICCSUB,JCCWK(4)
- +, JCCPP,JCCPD,JCCPZ,JCCPT,JCCPIF,JCCPC,JCCPN
- +, NCCPP,NCCPD,NCCPZ,NCCPT,NCCPIF,NCCPC,NCCPN
- +, JCCEND, NCHCCC,IXCCC, CCKORG, CCKARD, CCCOMF
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
-C-------------- End CDE --------------------------------
-
- IAND (IZV,IZW) = AND (IZV, IZW)
-
-
- IXS = MCCPAR(JCCPZ+1)
- CALL SYLSEQ (L, IXS, 0,0)
- IQUEST(11) = 0
- IF (L.NE.0) GO TO 22
- IF (NCCPP.EQ.0) GO TO 29
- GO TO 23
-
-C-- global sequence exist, check expansion restricted
-
- 22 IF (IAND(IQ(L),KM12+KM13).NE.0) GO TO 29
- IF (NCCPP.EQ.0) GO TO 29
- IF (IAND(IQ(L),KM14).NE.0) THEN
- IF (IAND(IQ(L),KM15).NE.0) GO TO 29
- ENDIF
-
- 23 IXP = MCCPAR(JCCPP+1)
- IXD = MCCPAR(JCCPD+2)
- KD = 0
-
- CALL CREAPD (IXP, IXD, 0)
- KP = LCRP - 3
- IF (LCRD.NE.0) KD = LCRD - 3
-
- 24 CALL SYLSEQ (L, IXS, KP,KD)
- IQUEST(11) = 7
- 29 LSEQ = L
- RETURN
- END
diff --git a/src/p5boot/p5lib/sylseq.f b/src/p5boot/p5lib/sylseq.f
deleted file mode 100644
index bbe4a64..0000000
--- a/src/p5boot/p5lib/sylseq.f
+++ /dev/null
@@ -1,63 +0,0 @@
-CDECK ID>, SYLSEQ.
- SUBROUTINE SYLSEQ (LSEQ, IXSEQ, KP,KD)
-
-C- Find KEEP bank for the sequence with the name index IXSEQ
-C- KP gives the patch-directed, KD the deck-directed sequences
-C-
-C- return LSEQ L-adr of the sequence found, or LSEQ = 0
-C- IQUEST(1) K-adr of the seq found, if found
-C- else: K-adr for attachment at end
-C-
-C- if the sequence has been found,
-C- it is re-linked to the start of its structure
-C. started 29-aug-92
-
- PARAMETER (KQGARB=1,KQARRV=3,KQKEEP=4,KQPREP=5,KQMAIN=6,KQPAST=8)
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
-C-------------- End CDE --------------------------------
- EQUIVALENCE (KSEQ,IQUEST(1))
- PARAMETER (LOCID=4)
-
-
-C-- Global set
-
- IF (KP.NE.0) GO TO 23
- KU = KQKEEP
- GO TO 29
-
-C-- Patch-directed set
-
- 23 IF (KD.NE.0) GO TO 24
- KU = KP
- GO TO 29
-
-C-- Deck-directed set
-
- 24 KU = KD
-
- 29 L = KQFIND (IXSEQ,LOCID,KU,KSEQ)
- IF (L.NE.0) THEN
- IF (KSEQ.NE.KU) THEN
- LQ(KSEQ) = LQ(L-1)
- LQ(L-1) = LQ(KU)
- LQ(KU) = L
- KSEQ = KU
- ENDIF
- ENDIF
-
- LSEQ = L
- RETURN
- END
diff --git a/src/p5boot/p5lib/sypam.f b/src/p5boot/p5lib/sypam.f
deleted file mode 100644
index 7dcdc37..0000000
--- a/src/p5boot/p5lib/sypam.f
+++ /dev/null
@@ -1,222 +0,0 @@
-CDECK ID>, SYPAM.
- SUBROUTINE SYPAM
-
-C- Process the next multi-PAM file
-C. started 18-july-95
-
- COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT,NUSLAT(2),DUMMY(34)
- CHARACTER SLLINE*512, SLERRM*256
- COMMON /SLATLN/ SLLINE, SLERRM
- PARAMETER (KM1=1,KM2=2,KM3=4,KM4=8,KM5=16,KM6=32,KM7=64,KM8=128,
- + KM9=256, KM10=512, KM11=1024, KM12=2048, KM13=4096, KM14=8192,
- + KM15=16384, KM16=32768, KM17=65536, KM18=131072, KM19=262144)
- PARAMETER (NBANKS=19,JBKPAT=1, JBKDEC=2, JBKORG=3, JBKINC=4,
- + JBKHOL=5, JBKKEE=6, JBKACT=7, JBKMAT=8, JBKXSQ=9,
- + JBKPRE=10,JBKGAR=11,JBKSMH=12,JBKSMT=13,JBKSML=14,
- + JBKSMX=15,JBKARR=16,JBKASA=17,JBKPAM=18,JBKRPA=19)
- COMMON /QBANKS/MMBANK(5,NBANKS)
- COMMON /QPAGE/ NQLMAX,NQLTOL,NQLTOK,NQCMAX,NQCPGH,NQPAGE
- +, NQWYLDO,NQWYL,NQNEWH,NQJOIN,NQDKNO,NQDKPG
- COMMON /QUNIT/ IQREAD,IQPRNT, IQTTIN,IQTYPE, IQOFFL,IQRTTY,IQRSAV
- +, IQRFD,IQRRD,IQRSIZ, NQLPAT,NQUSED,NQLLBL, NQINIT
- COMMON /ARRCOM/IN_LUN, IN_FD, IN_FIO, IN_EOF
- +, IN_DOX, IN_DO1, IN_DO2
- PARAMETER (MCCNIL=1, MCCKIL=2, MCCINC=3, MCCCDE=4, MCCSEQ=5,
- + MCCXSQ=6, MCCTRU=7, MCCFAL=8, MCCELS=9, MCCEND=10,
- + MCCSEL=11, MCCSES=12, MCCFAU=13, MCCSKI=14,
- + MCCKEE=15, MCCDEL=16, MCCREP=17, MCCADB=18, MCCADD=19,
- + MCCUSE=20, MCCXDI=21, MCCDIV=22, MCCLIS=23, MCCEXE=24, MCCIMI=25,
- + MCCASM=26, MCCUPD=27, MCCNAM=28, MCCGAP=29, MCCMOR=30, MCCONL=31,
- + MCCFOR=32, MCCSUS=33, MCCOPT=34, MCCOP2=35, MCCSHO=36, MCCPAM=37,
- + MCCQUI=38, MCCEOD=39, MCCDEC=40, MCCPAT=41, MCCTIT=42)
- CHARACTER CCKORG*256, CCKARD*256, CCCOMF*256
- COMMON /CCPARA/NCHCCD,NCHCCT, JCCTYP,JCCLEV,JCCSL,MCCPAR(240)
- +, NCCPAR,MXCCIF,JCCIFV,JCCBAD,JCCWAR,ICCSUB,JCCWK(4)
- +, JCCPP,JCCPD,JCCPZ,JCCPT,JCCPIF,JCCPC,JCCPN
- +, NCCPP,NCCPD,NCCPZ,NCCPT,NCCPIF,NCCPC,NCCPN
- +, JCCEND, NCHCCC,IXCCC, CCKORG, CCKARD, CCCOMF
- CHARACTER CHEXPD*68
- COMMON /CHEXC/ IXEXPAM, IXEXPAT,IXEXDEC,IXEXID, NCHEPD, CHEXPD
- COMMON /MUSEBC/ MX_FORC, MU_GLOB, MU_PAT, MU_DECK, MU_INH, MU_FORG
- +, MX_TRAN, MX_FORG, MX_SINH, MX_SELF, NVEXDK(6)
- PARAMETER (NFIMAX=100)
- COMMON /TITLEC/ NFILET, JTIPAM(NFIMAX)
- COMMON /MQCM/ NQSYSS,NQLINK, LQCSTA(3),LQCEND(3), NQMAX
- +, LQLSTA(5),LQLEND(5), LQADR,LQADR0,NQOFFS
- PARAMETER (KQGARB=1,KQARRV=3,KQKEEP=4,KQPREP=5,KQMAIN=6,KQPAST=8)
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
-C-------------- End CDE --------------------------------
-
- IAND (IZV,IZW) = AND (IZV, IZW)
- IOR (IZV,IZW) = OR (IZV, IZW)
-
-
-
- CALL DOPAMCO
-
- MOPUPD = -1
- IFLMERG = 1
- JDKSUB = 0
- MXFOSV = MX_FORC
- MOPT = IQ(LPAM+6)
- IFLATT = IAND (MOPT,KM1)
- IFLHOL = IAND (MOPT,KM2)
- IFLLIS = IAND (MOPT,KM7)
- IFLSEP = IAND (MOPT,KM8)
- IF (IFLLIS.NE.0) MX_FORC = IOR (MX_FORC, KM16)
- NQWYLDO = 7
-
- NHOLD = IQ(LARRV+9)
- IF (NHOLD.EQ.0) GO TO 31
-
-C---- Resume input of the PAM file stopped by RETURN=pname
-
- IQ(LARRV+9) = 0
- CALL ARRIVE (1)
-
- JSLTTL = IQ(LARRV+10)
- IXEXPAM = IQ(LARRV+11)
- IF (IQ(LPAM+4).GT.0) GO TO 42
-
- NCENT = NQDKNO / 100
- NNUM = MOD (NHOLD,100)
- NNEW = 100*NCENT + NNUM
- IF (NNEW.LT.NQDKNO) NNEW= NNEW + 100
- NQDKNO = NNEW
- NQWYL = IQ(LARRV+5)
- JDKTYP = 2
- GO TO 42
-
-C------ Load the title deck to memory ------------
-
- 31 IF (JDKNEX.EQ.0) CALL ARRIVE (2)
- IF (IFLATT+IFLSEP+MOPTIO(9).NE.0) NQWYL= 0
-
-C---- Handle the PAM-file title
-
- CALL KRTITL
- JDKSUB = 0
- IF (JCCTYP.EQ.MCCDEC) JDKSUB= 1
- IF (JCCTYP.EQ.MCCPAT) JDKSUB= 2
- JDKTYP = 3
-
- JSLTTL = IQ(LARRV+10)
- IQ(LPAM+13) = IQ(LPAM+13) + 1
- IF (IQ(LPAM+4).GT.0) GO TO 42
-
- IF (NQDKNO.GE.2) THEN
- NQDKNO = ((NQDKNO-1)/100 + 1) *100
- ELSE
- NQDKNO = 0
- ENDIF
-
-C-- create RPAM bank
-
- 42 CALL QSHUNT (KQMAIN,KQPAST)
- CALL MQLIFT (LRPAM, LEXP,1, JBKRPA,3)
- IQ(LRPAM+1) = JSLTTL
- IQ(LRPAM+2) = -IXEXPAM
- IQ(LRPAM+3) = NQDKNO
-
-C-- PAM file to be read, not skipped
-
- IF (IQ(LPAM+4).GT.0) GO TO 71
- IF (JDKTYP.EQ.3) THEN
- IF (NFILET.LT.NFIMAX) NFILET= NFILET + 1
- JTIPAM(NFILET) = JSLTTL
- ENDIF
-
-C------ DO all patches
-
- IF (JDKSUB.NE.0) JDKTYP= JDKSUB
- JDKSUB = 0
-
- CALL SYPAT
- IF (JDKTYP.EQ.6) GO TO 81
- IF (JDKTYP.EQ.2) GO TO 61
-
-C---- +TITLE seen, do next PAM file
-
- IQ(LPAM+5) = IQ(LPAM+5) - 1
- IF (IQ(LPAM+5).LE.0) GO TO 62
- GO TO 31
-
-C---- Stop input from PAM
-C- for RETURN=name reached
-C- for number of PAM files to be done exhausted
-
- 61 IQ(LARRV+9)= NQDKNO
- 62 JSLSAV = IQ(LQHOLD+1)
- NSLSAV = IQ(LQHOLD+2)
- IF (IFLHOL.EQ.0) THEN
- LQLEND(2) = JSLSAV
- LQLSTA(3) = LQLEND(2)
- LQLEND(3) = LQLSTA(3)
- GO TO 82
- ENDIF
-
- IF (NSLSAV.EQ.0) GO TO 88
- IF (IQ(LARRV+7).GT.0) THEN
- IN_DOX = 1
- IN_DO1 = JSLSAV
- CALL ARRIN
- GO TO 88
- ENDIF
-
- CALL MQLIFT (LASAV,LARRV,-2,JBKASA,1)
- IQ(LASAV+1) = JSLSAV
- IQ(LASAV+2) = NSLSAV
- GO TO 88
-
-C------ Skip the PAM file
-
- 71 IQ(LPAM+4) = IQ(LPAM+4) - 1
- IQ(LPAM+5) = 0
- IQ(LRPAM+4) = -1
- NQWYL = 0
-
- CALL LN_GET (JSLTTL, SLLINE, 60)
- NTXT = NDSLAT
-
- CALL DPBLAN (0)
- WRITE (IQPRNT,9072) SLLINE(1:NTXT)
- NQUSED = NQUSED + 2
- 9072 FORMAT (' Skip Pam file: ',A/)
-
- JDKTYP = 3
- CALL ARRSKP
- IF (JDKTYP.LT.6) GO TO 31
-
-C------ End of multi-PAM reached
-
- 81 CONTINUE
-
-C-- Detach or Rewind
-
- 82 IF (IFLHOL.EQ.0) THEN
- IN_DOX = -1
- ELSE
- IN_DOX = 0
- ENDIF
- CALL ARRIN
-
- 88 IQ(LQHOLD+2) = 0
- IQ(LPAM+12) = IQ(LPAM+12) + IQ(LARRV+12)
- IQ(LARRV+5) = NQWYL
- IQ(LARRV+12) = 0
- MX_FORC = MXFOSV
- RETURN
- END
diff --git a/src/p5boot/p5lib/sypat.f b/src/p5boot/p5lib/sypat.f
deleted file mode 100644
index 4fb99d7..0000000
--- a/src/p5boot/p5lib/sypat.f
+++ /dev/null
@@ -1,182 +0,0 @@
-CDECK ID>, SYPAT.
- SUBROUTINE SYPAT
-
-C- Process all patches of the current PAM file
-C. started 18-july-95
-
- PARAMETER (KM1=1,KM2=2,KM3=4,KM4=8,KM5=16,KM6=32,KM7=64,KM8=128,
- + KM9=256, KM10=512, KM11=1024, KM12=2048, KM13=4096, KM14=8192,
- + KM15=16384, KM16=32768, KM17=65536, KM18=131072, KM19=262144)
- COMMON /QPAGE/ NQLMAX,NQLTOL,NQLTOK,NQCMAX,NQCPGH,NQPAGE
- +, NQWYLDO,NQWYL,NQNEWH,NQJOIN,NQDKNO,NQDKPG
- PARAMETER (MCCNIL=1, MCCKIL=2, MCCINC=3, MCCCDE=4, MCCSEQ=5,
- + MCCXSQ=6, MCCTRU=7, MCCFAL=8, MCCELS=9, MCCEND=10,
- + MCCSEL=11, MCCSES=12, MCCFAU=13, MCCSKI=14,
- + MCCKEE=15, MCCDEL=16, MCCREP=17, MCCADB=18, MCCADD=19,
- + MCCUSE=20, MCCXDI=21, MCCDIV=22, MCCLIS=23, MCCEXE=24, MCCIMI=25,
- + MCCASM=26, MCCUPD=27, MCCNAM=28, MCCGAP=29, MCCMOR=30, MCCONL=31,
- + MCCFOR=32, MCCSUS=33, MCCOPT=34, MCCOP2=35, MCCSHO=36, MCCPAM=37,
- + MCCQUI=38, MCCEOD=39, MCCDEC=40, MCCPAT=41, MCCTIT=42)
- CHARACTER CCKORG*256, CCKARD*256, CCCOMF*256
- COMMON /CCPARA/NCHCCD,NCHCCT, JCCTYP,JCCLEV,JCCSL,MCCPAR(240)
- +, NCCPAR,MXCCIF,JCCIFV,JCCBAD,JCCWAR,ICCSUB,JCCWK(4)
- +, JCCPP,JCCPD,JCCPZ,JCCPT,JCCPIF,JCCPC,JCCPN
- +, NCCPP,NCCPD,NCCPZ,NCCPT,NCCPIF,NCCPC,NCCPN
- +, JCCEND, NCHCCC,IXCCC, CCKORG, CCKARD, CCCOMF
- CHARACTER CHEXPD*68
- COMMON /CHEXC/ IXEXPAM, IXEXPAT,IXEXDEC,IXEXID, NCHEPD, CHEXPD
- COMMON /MUSEBC/ MX_FORC, MU_GLOB, MU_PAT, MU_DECK, MU_INH, MU_FORG
- +, MX_TRAN, MX_FORG, MX_SINH, MX_SELF, NVEXDK(6)
- CHARACTER CHTAG*80, CHWYL*16
- COMMON /TAGC/ LLORG,LNORG,LLACT,LNACT, LALTN,LMODE,NCHTAG
- +, CHTAG,CHWYL
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
-C-------------- End CDE --------------------------------
-
- IAND (IZV,IZW) = AND (IZV, IZW)
-
-
- IF (JDKTYP.EQ.3) GO TO 27
- IF (JDKTYP.EQ.1) GO TO 26
-
-C-- get the patch name
-
- 21 JSLF = IQ(LQHOLD+1)
- JCCTYP = MCCPAT
- CALL CCKRAK (JSLF)
-
- IXEXPAT = MCCPAR(JCCPP+1)
- IF (IXEXPAT.NE.0) GO TO 27
- 26 IXEXPAT= 1
-
-C-- find/create the patch bank
-
- 27 CALL CREAPD (IXEXPAT,-1,7)
- IXEXID = IXEXPAT
- CALL SBYT (NQDKNO, IQ(LEXP+1),13,20)
- MU_PAT = IAND (IQ(LEXP),KM19-1)
- IXEXDEC = 0
-
-C-- Check enough space
-
- 31 IFLGAR = 0
- CALL SETGAP
- IF (JDKNEX.EQ.0) CALL ARRIVE (2)
- NQNEWH = 7
- NCHTAG = 0
- LDECO = 0
-
-
-C------ Ready the deck parameters
-
- IF (JDKTYP.NE.1) GO TO 37
-
-C---- Deck header is +DECK, name
-
- JSLF = IQ(LQHOLD+1)
- JCCTYP = MCCDEC
- CALL CCKRAK (JSLF)
-
-C-- get the name
-
- IXEXDEC = MCCPAR(JCCPD+1)
- IF (IXEXDEC.EQ.0) IXEXDEC= 1
- IXEXID = IXEXDEC
-
-C-- find the deck bank, set operation mode
-
- 37 LEXD = KQFIND (IXEXDEC,1, LEXP-2,KEXD)
- IF (LEXD.NE.0) THEN
- MU_DECK = IAND (IQ(LEXD),KM19-1)
- ELSE
- MU_DECK = MU_PAT
- ENDIF
-
- NSLHAV = IQ(LQHOLD+3)
- IF (IAND(MU_DECK,KM5).EQ.0) GO TO 71
-
- CALL MXOPER (0)
-
-C-- start of PAM
-
- IF (JDKTYP.NE.3) GO TO 44
- NVEXDK(2) = 1
- IF (NQJOIN.GT.0) NQJOIN = 0
- IF (NQPAGE.LT.2) NQJOIN = 1
- CALL DPHEAD
- NQJOIN = -1
- GO TO 51
-
-C-- start of patch or deck
-
- 44 IF (NVEXDK(2).EQ.0) GO TO 51
- CALL CCJOIN
-
-C------ Process the deck
-
- 51 NSLORG = 0
- NCHTAG = 0
- LLORG = 0
- LLACT = 0
- LMODE = 0
-
-C-- ready the foreign material into this deck
-
- CALL ACSORT
-
-C-- analyse the contents
-
- CALL DOMAPA (7)
-
-C-- process the contents
-
- CALL SYXQT
-
-C------ Processing complete
-
-C-- send the DECK bank to garbage collection
-
- IF (LEXD.NE.0) THEN
- L = KQFIND (IXEXDEC,1, LEXP-2, KEXD)
- IF (L.NE.0) THEN
- CALL TOGARB (KEXD,0)
- ENDIF
- ENDIF
-
- IF (NVEXDK(2).NE.0) GO TO 72
-
-C---- Deck not listed, step the Wylbur line number
-
- 71 NQWYL = NQWYL + NSLHAV
-
-C-- step to the next deck
-
- 72 NQDKNO = NQDKNO + 1
- CALL ARRNXD (1)
- IF (JDKTYP.EQ.1) GO TO 31
-
- IF (IAND(IQ(LEXP+1),KM5).EQ.0) THEN
- IF (LQ(LEXP-2).NE.0) CALL TOGARB (LEXP-2,7)
- IF (LQ(LEXP-3).NE.0) CALL TOGARB (LEXP-3,7)
- ENDIF
-
- IF (JDKTYP.GE.3) RETURN
-
-C-- check stop for RETURN=pname
-
- IF (IXEXPAT.NE.IQ(LPAM+7)) GO TO 21
- RETURN
- END
diff --git a/src/p5boot/p5lib/syseq.f b/src/p5boot/p5lib/syseq.f
deleted file mode 100644
index a086e19..0000000
--- a/src/p5boot/p5lib/syseq.f
+++ /dev/null
@@ -1,218 +0,0 @@
-CDECK ID>, SYSEQ.
- SUBROUTINE SYSEQ
-
-C- Send the sequences called from bank LDOAN at KDOAN to output.
-C. started 24-aug-95
-
- PARAMETER (KM1=1,KM2=2,KM3=4,KM4=8,KM5=16,KM6=32,KM7=64,KM8=128,
- + KM9=256, KM10=512, KM11=1024, KM12=2048, KM13=4096, KM14=8192,
- + KM15=16384, KM16=32768, KM17=65536, KM18=131072, KM19=262144)
- PARAMETER (KMA=1,KMB=2,KMC=4,KMD=8,KME=16,KMF=32,KMG=64,KMH=128,
- + KMI=256, KMJ=512, KMK=KM11, KML=KM12, KMM=KM13, KMN=KM14,
- + KMO=KM15, KMP=KM16, KMQ=KM17, KMR=KM18, KMS=KM19)
- PARAMETER (NBANKS=19,JBKPAT=1, JBKDEC=2, JBKORG=3, JBKINC=4,
- + JBKHOL=5, JBKKEE=6, JBKACT=7, JBKMAT=8, JBKXSQ=9,
- + JBKPRE=10,JBKGAR=11,JBKSMH=12,JBKSMT=13,JBKSML=14,
- + JBKSMX=15,JBKARR=16,JBKASA=17,JBKPAM=18,JBKRPA=19)
- COMMON /QBANKS/MMBANK(5,NBANKS)
- COMMON /QPAGE/ NQLMAX,NQLTOL,NQLTOK,NQCMAX,NQCPGH,NQPAGE
- +, NQWYLDO,NQWYL,NQNEWH,NQJOIN,NQDKNO,NQDKPG
- PARAMETER (MCCNIL=1, MCCKIL=2, MCCINC=3, MCCCDE=4, MCCSEQ=5,
- + MCCXSQ=6, MCCTRU=7, MCCFAL=8, MCCELS=9, MCCEND=10,
- + MCCSEL=11, MCCSES=12, MCCFAU=13, MCCSKI=14,
- + MCCKEE=15, MCCDEL=16, MCCREP=17, MCCADB=18, MCCADD=19,
- + MCCUSE=20, MCCXDI=21, MCCDIV=22, MCCLIS=23, MCCEXE=24, MCCIMI=25,
- + MCCASM=26, MCCUPD=27, MCCNAM=28, MCCGAP=29, MCCMOR=30, MCCONL=31,
- + MCCFOR=32, MCCSUS=33, MCCOPT=34, MCCOP2=35, MCCSHO=36, MCCPAM=37,
- + MCCQUI=38, MCCEOD=39, MCCDEC=40, MCCPAT=41, MCCTIT=42)
- CHARACTER CCKORG*256, CCKARD*256, CCCOMF*256
- COMMON /CCPARA/NCHCCD,NCHCCT, JCCTYP,JCCLEV,JCCSL,MCCPAR(240)
- +, NCCPAR,MXCCIF,JCCIFV,JCCBAD,JCCWAR,ICCSUB,JCCWK(4)
- +, JCCPP,JCCPD,JCCPZ,JCCPT,JCCPIF,JCCPC,JCCPN
- +, NCCPP,NCCPD,NCCPZ,NCCPT,NCCPIF,NCCPC,NCCPN
- +, JCCEND, NCHCCC,IXCCC, CCKORG, CCKARD, CCCOMF
- CHARACTER CHTAG*80, CHWYL*16
- COMMON /TAGC/ LLORG,LNORG,LLACT,LNACT, LALTN,LMODE,NCHTAG
- +, CHTAG,CHWYL
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
- COMMON /M_ANAC/LOWAN,KDOAN,LDOAN,LUPAN,MODEAN,MEXAN,LEVAN,KKM5AN
- +, NEWDEC,NEWCTL,NEWFOR,NEWNIL,NEWINC
-C-------------- End CDE --------------------------------
- PARAMETER (NOFFLI=2, NOFFDA=4)
- PARAMETER (MAXLEV=36)
- COMMON /MSAVEC/ MSAVE(6,MAXLEV)
-
- IAND (IZV,IZW) = AND (IZV, IZW)
- IOR (IZV,IZW) = OR (IZV, IZW)
- ISHFTL (IZW,NZB) = LSHIFT (IZW, NZB)
-
- LEVK = 0
- LNACT = 0
- LLACT = 0
- NCHTAG = 0
-
- KPC = LEXP - 3
- KDC = 0
- IF (LEXD.NE.0) KDC= LEXD - 3
-
- NCCPZ = MIN (NCCPZ,61)
-
- MMBANK(3,JBKXSQ) = NCCPZ + NOFFLI
- MMBANK(5,JBKXSQ) = NCCPZ + NOFFDA
- CALL MQLIFT (LMAT,KDOAN,0,JBKXSQ,2)
-
- LQ(LMAT-1) = LQ(LDOAN-1)
- IQ(LMAT) = IOR (IQ(LMAT), ISHFTL(JCCTYP,8))
- IQ(LMAT) = IOR (IQ(LMAT), IAND(MCCPAR(JCCPT+1),KMP))
- IQ(LMAT+1) = IQ(LDOAN+1)
- IQ(LMAT+2) = IQ(LDOAN+2)
-
- IQ(LMAT+NOFFDA) = NCCPZ
- CALL UCOCOP (MCCPAR(JCCPZ+1),IQ(LMAT+NOFFDA+1),NCCPZ,1,3,1)
-
- LDOAN = LMAT
- LCSQ = LMAT
-
-C---- New XSQ bank
-
- 21 JSEQ = 0
- NSEQ = IQ(LCSQ+NOFFDA)
- IFLPAS = IAND (IQ(LCSQ),KM16)
- 22 JSEQ = JSEQ + 1
- IF (JSEQ.GT.NSEQ) GO TO 67
- ITER = 0
- NDONE = 0
- IXSEQ = IQ(LCSQ+JSEQ+NOFFDA)
- LKEEP = LQ(LCSQ-JSEQ-NOFFLI)
- IF (LKEEP.NE.0) GO TO 41
-
- CALL SYLSEQ (LKEEP, IXSEQ, 0,0)
- IF (LKEEP.EQ.0) GO TO 51
- LQ(LCSQ-JSEQ-NOFFLI) = LKEEP
-
-C---- Start output of this sequence
-
- 41 IF (IAND(IQ(LKEEP),KM12+KM16).NE.0) GO TO 22
- IFALTN = NDONE
-
-C-- ready special sequence
-
- IFSPEC = IAND(IQ(LKEEP),KM13)
- IF (IFSPEC.NE.0) THEN
- CALL X_SEQSP (IQ(LCSQ+1), IXSEQ, IFSEND)
- IF (IFSEND.EQ.0) GO TO 22
- ENDIF
-
- NDONE = NDONE + 1
- LLORG = 0
- LNORG = LQ(LKEEP-3)
- CALL SYKTAG (LEVK,IXSEQ)
-
-C-- output of the start of the sequence expansion
-
- IF (IQ(LKEEP+2).NE.0) GO TO 44
- IF (LQ(LKEEP-2).NE.0) GO TO 43
- CALL SYKTAG (-1,0)
- GO TO 48
-
- 43 IFLST = LEVK+1
- GO TO 45
-
- 44 CALL DPLIST (1,LKEEP,0,LEVK+1)
- IFLST = 0
-
-C-- output of continuation MAT banks
-
- 45 LDO = LKEEP - 1
- 46 LDO = LQ(LDO-1)
- IF (LDO.EQ.0) GO TO 48
- JCCTYP = JBYT (IQ(LDO),9,6)
-
- LNORG = LQ(LDO-2)
- CALL DPLIST (1,LDO,0,IFLST)
- IFLST = 0
- IF (JCCTYP.GE.MCCCDE) GO TO 61
- GO TO 46
-
-C-- next sequence in multiple definition
-
- 48 IF (IFSPEC.NE.0) GO TO 22
- LKEEP = LQ(LKEEP-4)
- IF (LKEEP.NE.0) GO TO 41
-
-C-- do also patch/deck directed sequences
-
- 51 ITER = ITER + 1
- IF (ITER.GE.3) GO TO 57
- KP = KPC
- IF (ITER.EQ.1) THEN
- IF (LQ(KP).EQ.0) GO TO 51
- KD = 0
- ELSE
- IF (KDC.EQ.0) GO TO 57
- IF (LQ(KDC).EQ.0) GO TO 57
- KD = KDC
- ENDIF
-
- CALL SYLSEQ (LKEEP, IXSEQ, KP,KD)
- IF (LKEEP.NE.0) GO TO 41
- GO TO 51
-
-C-- missing sequence ?
-
- 57 IF (NDONE.NE.0) GO TO 22
- IF (IFLPAS.NE.0) GO TO 22
- IF (MOPTIO(13).EQ.0) GO TO 22
- CALL DPLMSQ (IXSEQ)
- GO TO 22
-
-C---- new sequence call bank, step level up by one
-
- 61 LEVK = LEVK + 1
- MSAVE(1,LEVK) = LCSQ
- MSAVE(2,LEVK) = LDO
- MSAVE(3,LEVK) = JSEQ
- MSAVE(4,LEVK) = NDONE
- MSAVE(5,LEVK) = LKEEP
- MSAVE(6,LEVK) = ITER
- LCSQ = LDO
- GO TO 21
-
-C---- end of doing this sequence call bank, step level down
-
- 67 IF (LEVK.EQ.0) GO TO 69
-
- LCSQ = MSAVE(1,LEVK)
- LDO = MSAVE(2,LEVK)
- JSEQ = MSAVE(3,LEVK)
- NDONE = MSAVE(4,LEVK)
- LKEEP = MSAVE(5,LEVK)
- ITER = MSAVE(6,LEVK)
- LEVK = LEVK - 1
-
- IFALTN = NDONE - 1
- NSEQ = IQ(LCSQ+NOFFDA)
- IXSEQ = IQ(LCSQ+JSEQ+NOFFDA)
- IFLPAS = IAND (IQ(LCSQ),KM16)
- IFSPEC = 0
- IFLST = 0
- CALL SYKTAG (LEVK,0)
- GO TO 46
-
- 69 NCHTAG = 0
- NQWYLDO = 7
- RETURN
- END
diff --git a/src/p5boot/p5lib/sysplit.f b/src/p5boot/p5lib/sysplit.f
deleted file mode 100644
index 59febcd..0000000
--- a/src/p5boot/p5lib/sysplit.f
+++ /dev/null
@@ -1,81 +0,0 @@
-CDECK ID>, SYSPLIT.
- SUBROUTINE SYSPLIT (LTHIS)
-
-C- split on +CDE or +SEQ contained in a sequence definition
-C. started 24-aug-95
-
- PARAMETER (MCCNIL=1, MCCKIL=2, MCCINC=3, MCCCDE=4, MCCSEQ=5,
- + MCCXSQ=6, MCCTRU=7, MCCFAL=8, MCCELS=9, MCCEND=10,
- + MCCSEL=11, MCCSES=12, MCCFAU=13, MCCSKI=14,
- + MCCKEE=15, MCCDEL=16, MCCREP=17, MCCADB=18, MCCADD=19,
- + MCCUSE=20, MCCXDI=21, MCCDIV=22, MCCLIS=23, MCCEXE=24, MCCIMI=25,
- + MCCASM=26, MCCUPD=27, MCCNAM=28, MCCGAP=29, MCCMOR=30, MCCONL=31,
- + MCCFOR=32, MCCSUS=33, MCCOPT=34, MCCOP2=35, MCCSHO=36, MCCPAM=37,
- + MCCQUI=38, MCCEOD=39, MCCDEC=40, MCCPAT=41, MCCTIT=42)
- CHARACTER CCKORG*256, CCKARD*256, CCCOMF*256
- COMMON /CCPARA/NCHCCD,NCHCCT, JCCTYP,JCCLEV,JCCSL,MCCPAR(240)
- +, NCCPAR,MXCCIF,JCCIFV,JCCBAD,JCCWAR,ICCSUB,JCCWK(4)
- +, JCCPP,JCCPD,JCCPZ,JCCPT,JCCPIF,JCCPC,JCCPN
- +, NCCPP,NCCPD,NCCPZ,NCCPT,NCCPIF,NCCPC,NCCPN
- +, JCCEND, NCHCCC,IXCCC, CCKORG, CCKARD, CCCOMF
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
-C-------------- End CDE --------------------------------
-
- IOR (IZV,IZW) = OR (IZV, IZW)
- ISHFTL (IZW,NZB) = LSHIFT (IZW, NZB)
-
-
- LDO = LTHIS
- JSLA = IQ(LDO+1)
- JSLE = JSLA + IQ(LDO+2)
- JSLF = JSLA
-
-C---- Find next control line
-
- 20 JSLG = JSLF + 1
- 21 IF (JSLG.GE.JSLE) GO TO 41
- CALL NEXTCC ('+',JSLG,JSLE,JSLF,JTYPE)
- IF (JTYPE.EQ.0) GO TO 41
-
- IF (JTYPE.LT.MCCCDE) GO TO 20
- IF (JTYPE.GT.MCCSEQ) GO TO 20
-
-C-- split before +CDE
-
- IF (JSLF.GT.JSLA) LDO= M_SPLIT (LDO,JSLF)
-
- IQ(LDO) = IOR (IQ(LDO), ISHFTL(JTYPE,8))
- JSLG = IQ(LDO+1) + 1
- IF (JSLG.GE.JSLE) GO TO 41
-
-C-- split after +CDE
-
- LDO = M_SPLIT (LDO,JSLG)
- JSLA = JSLG
- GO TO 21
-
-C---- step to next bank
-
- 41 LDO = LQ(LDO-1)
- IF (LDO.EQ.0) RETURN
- IF (LQ(LDO-2).NE.0) GO TO 41
- JTYPE = JBYT (IQ(LDO),9,6)
- IF (JTYPE.GE.MCCSEL) RETURN
- JSLA = IQ(LDO+1)
- JSLE = JSLA + IQ(LDO+2)
- JSLG = JSLA
- GO TO 21
- END
diff --git a/src/p5boot/p5lib/syxqt.f b/src/p5boot/p5lib/syxqt.f
deleted file mode 100644
index d7afaa8..0000000
--- a/src/p5boot/p5lib/syxqt.f
+++ /dev/null
@@ -1,207 +0,0 @@
-CDECK ID>, SYXQT.
- SUBROUTINE SYXQT
-
-C- List the material of the current deck according to the map
-C. started 18-july-95
-
- PARAMETER (KM1=1,KM2=2,KM3=4,KM4=8,KM5=16,KM6=32,KM7=64,KM8=128,
- + KM9=256, KM10=512, KM11=1024, KM12=2048, KM13=4096, KM14=8192,
- + KM15=16384, KM16=32768, KM17=65536, KM18=131072, KM19=262144)
- PARAMETER (KMA=1,KMB=2,KMC=4,KMD=8,KME=16,KMF=32,KMG=64,KMH=128,
- + KMI=256, KMJ=512, KMK=KM11, KML=KM12, KMM=KM13, KMN=KM14,
- + KMO=KM15, KMP=KM16, KMQ=KM17, KMR=KM18, KMS=KM19)
- COMMON /QUNIT/ IQREAD,IQPRNT, IQTTIN,IQTYPE, IQOFFL,IQRTTY,IQRSAV
- +, IQRFD,IQRRD,IQRSIZ, NQLPAT,NQUSED,NQLLBL, NQINIT
- PARAMETER (MCCNIL=1, MCCKIL=2, MCCINC=3, MCCCDE=4, MCCSEQ=5,
- + MCCXSQ=6, MCCTRU=7, MCCFAL=8, MCCELS=9, MCCEND=10,
- + MCCSEL=11, MCCSES=12, MCCFAU=13, MCCSKI=14,
- + MCCKEE=15, MCCDEL=16, MCCREP=17, MCCADB=18, MCCADD=19,
- + MCCUSE=20, MCCXDI=21, MCCDIV=22, MCCLIS=23, MCCEXE=24, MCCIMI=25,
- + MCCASM=26, MCCUPD=27, MCCNAM=28, MCCGAP=29, MCCMOR=30, MCCONL=31,
- + MCCFOR=32, MCCSUS=33, MCCOPT=34, MCCOP2=35, MCCSHO=36, MCCPAM=37,
- + MCCQUI=38, MCCEOD=39, MCCDEC=40, MCCPAT=41, MCCTIT=42)
- CHARACTER CCKORG*256, CCKARD*256, CCCOMF*256
- COMMON /CCPARA/NCHCCD,NCHCCT, JCCTYP,JCCLEV,JCCSL,MCCPAR(240)
- +, NCCPAR,MXCCIF,JCCIFV,JCCBAD,JCCWAR,ICCSUB,JCCWK(4)
- +, JCCPP,JCCPD,JCCPZ,JCCPT,JCCPIF,JCCPC,JCCPN
- +, NCCPP,NCCPD,NCCPZ,NCCPT,NCCPIF,NCCPC,NCCPN
- +, JCCEND, NCHCCC,IXCCC, CCKORG, CCKARD, CCCOMF
- COMMON /MUSEBC/ MX_FORC, MU_GLOB, MU_PAT, MU_DECK, MU_INH, MU_FORG
- +, MX_TRAN, MX_FORG, MX_SINH, MX_SELF, NVEXDK(6)
- COMMON /MQCM/ NQSYSS,NQLINK, LQCSTA(3),LQCEND(3), NQMAX
- +, LQLSTA(5),LQLEND(5), LQADR,LQADR0,NQOFFS
- PARAMETER (KQGARB=1,KQARRV=3,KQKEEP=4,KQPREP=5,KQMAIN=6,KQPAST=8)
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
- COMMON /M_ANAC/LOWAN,KDOAN,LDOAN,LUPAN,MODEAN,MEXAN,LEVAN,KKM5AN
- +, NEWDEC,NEWCTL,NEWFOR,NEWNIL,NEWINC
-C-------------- End CDE --------------------------------
-
- IAND (IZV,IZW) = AND (IZV, IZW)
- IOR (IZV,IZW) = OR (IZV, IZW)
-
-
- IXPL = -1
- LEVIF = 0
- LUPAN = 0
- LDOAN = KQPREP + 1
-
-C---- Next bank
-
- 20 KDOAN = LDOAN - 1
- LDOAN = LQ(KDOAN)
- 22 MODEAN = 0
- IF (LDOAN.EQ.0) GO TO 87
- IF (LQ(LDOAN-2).EQ.0) GO TO 24
-
-C-- print action into here
-
- 23 IF (NVEXDK(2).NE.0) CALL SYFORG (-7,0)
- IF (MODEAN.EQ.5) GO TO 58
- GO TO 20
-
-C-- MODEAN = 0 self material
-C- 1 CDE expansion
-C- 2 comment line
-C- 3 +SELF header line
-C- 4 +CDE call line
-C- 5 foreign material
-C- 6 control line
-
- 24 JCCTYP = JBYT (IQ(LDOAN),9,6)
- IF (JCCTYP.GE.MCCKEE) GO TO 51
-
-C---------- Self material ----------------
-
- IF (NVEXDK(2).EQ.0) GO TO 20
- IF (JCCTYP.EQ.0) GO TO 39
- IF (JCCTYP.EQ.MCCNIL) GO TO 38
- IF (JCCTYP.LE.MCCINC) GO TO 71
- IF (JCCTYP.LE.MCCXSQ) GO TO 35
- IF (JCCTYP.LT.MCCSEL) GO TO 32
- IXPL = -1
- LEVIF = 0
-
-C-- to here +SELF, +SKIP and fault
-
- MODEAN = 3
- IF (JCCTYP.NE.MCCSES) GO TO 28
- IF (MOPTIO(26).NE.0) GO TO 28
- CALL CCKRAK (IQ(LDOAN+1))
-
- IF (IQ(LDOAN+2).GE.2) L = M_SPLIT (LDOAN, IQ(LDOAN+1)+1)
- CALL DPLIST (MODEAN,LDOAN,LUPAN,1)
- GO TO 37
-
- 28 CALL DPLIST (MODEAN,LDOAN,LUPAN,1)
- GO TO 20
-
-C-- to here +_IF etc
-
- 32 IF (JCCTYP.GE.MCCELS) GO TO 34
- IF (LEVIF.EQ.0) IQ(LDOAN)= IOR (IQ(LDOAN), KM17)
- LEVIF = LEVIF + 1
- GO TO 39
-
- 34 IF (JCCTYP.EQ.MCCELS) GO TO 39
- IF (LEVIF.EQ.1) IQ(LDOAN)= IOR (IQ(LDOAN), KM17)
- LEVIF = MAX (LEVIF-1, 0)
- GO TO 39
-
-C-- sequence call
-
- 35 MODEAN = 4
- CALL DPLIST (MODEAN,LDOAN,LUPAN,0)
- IF (JCCTYP.EQ.MCCCDE) THEN
- IF (MOPTIO(25).EQ.0) GO TO 36
- ELSE
- IF (MOPTIO(26).EQ.0) GO TO 36
- ENDIF
- IF (MOPTIO(5).NE.0) CALL XEJECT
- GO TO 20
-
- 36 CALL CCKRAK (IQ(LDOAN+1))
- IF (NCCPZ.EQ.0) GO TO 20
- IF (IAND(MCCPAR(JCCPT+1),KMD).NE.0) GO TO 20
-
- 37 CALL SYSEQ
- GO TO 20
-
-C-- comment line
-
- 38 MODEAN = 2
- 39 CALL DPLIST (MODEAN,LDOAN,LUPAN,1)
- GO TO 20
-
-
-C---------- Foreign material --------------
-
- 51 LEVIF = 0
- IF (JCCTYP.GE.MCCUSE) GO TO 71
- CALL CCKRAK (IQ(LDOAN+1))
- IF (JCCTYP.EQ.MCCKEE) GO TO 56
- IXP = MCCPAR(JCCPP+1)
- IXD = MCCPAR(JCCPD+1)
- IF (IXP.EQ.0) GO TO 52
- IF (IXP.EQ.IXPL .AND. IXD.EQ.IXDL) GO TO 53
- IXPL = IXP
- IXDL = IXD
- GO TO 54
-
-C-- implied target
-
- 52 IF (IXPL.LT.0) GO TO 54
- IF (MCCPAR(JCCPD+2).LT.0) GO TO 53
- IF (IXD.EQ.IXDL) GO TO 53
- IXDL = IXD
- GO TO 54
-
-C-- same action target as previous
-
- 53 IQ(LDOAN) = IOR (IQ(LDOAN), KM18)
- 54 CALL SYFORG (IXPL,IXDL)
- GO TO 57
-
-C-- sequence definition
-
- 56 IXPL = -1
- CALL SYKEEP
-
- 57 MODEAN = 5
- IF (NVEXDK(2).NE.0) CALL DPLIST (MODEAN,LDOAN,LUPAN,1)
-
- 58 KDOAN = LDOAN - 1
- LDOAN = LQ(KDOAN)
- IF (LDOAN.EQ.0) GO TO 87
- IF (LQ(LDOAN-2).NE.0) GO TO 23
- JCCTYP = JBYT (IQ(LDOAN),9,6)
- IF (JCCTYP.GE.MCCSEL) GO TO 22
- IF (NVEXDK(2).NE.0) CALL DPLIST (MODEAN,LDOAN,LUPAN,0)
- GO TO 58
-
-C---------- Control line ---------------
-
- 71 MODEAN = 6
- IF (NVEXDK(2).EQ.0) GO TO 20
- CALL DPLIST (MODEAN,LDOAN,LUPAN,1)
- IF (JCCTYP.LT.MCCPAT) GO TO 20
- NQLPAT = NQUSED
- GO TO 20
-
-C---- Done
-
- 87 LQCEND(2) = LQCSTA(2)
- RETURN
- END
diff --git a/src/p5boot/p5lib/ticomm.f b/src/p5boot/p5lib/ticomm.f
deleted file mode 100644
index 0f0aaa6..0000000
--- a/src/p5boot/p5lib/ticomm.f
+++ /dev/null
@@ -1,146 +0,0 @@
-CDECK ID>, TICOMM.
- SUBROUTINE TICOMM
-
-C- Delete leading and trailing comment or blank lines
-C- in Fortran decks only
-C. started 26-may-94
-
- PARAMETER (MCCNIL=1, MCCKIL=2, MCCINC=3, MCCCDE=4, MCCSEQ=5,
- + MCCXSQ=6, MCCTRU=7, MCCFAL=8, MCCELS=9, MCCEND=10,
- + MCCSEL=11, MCCSES=12, MCCFAU=13, MCCSKI=14,
- + MCCKEE=15, MCCDEL=16, MCCREP=17, MCCADB=18, MCCADD=19,
- + MCCUSE=20, MCCXDI=21, MCCDIV=22, MCCLIS=23, MCCEXE=24, MCCIMI=25,
- + MCCASM=26, MCCUPD=27, MCCNAM=28, MCCGAP=29, MCCMOR=30, MCCONL=31,
- + MCCFOR=32, MCCSUS=33, MCCOPT=34, MCCOP2=35, MCCSHO=36, MCCPAM=37,
- + MCCQUI=38, MCCEOD=39, MCCDEC=40, MCCPAT=41, MCCTIT=42)
- CHARACTER CCKORG*256, CCKARD*256, CCCOMF*256
- COMMON /CCPARA/NCHCCD,NCHCCT, JCCTYP,JCCLEV,JCCSL,MCCPAR(240)
- +, NCCPAR,MXCCIF,JCCIFV,JCCBAD,JCCWAR,ICCSUB,JCCWK(4)
- +, JCCPP,JCCPD,JCCPZ,JCCPT,JCCPIF,JCCPC,JCCPN
- +, NCCPP,NCCPD,NCCPZ,NCCPT,NCCPIF,NCCPC,NCCPN
- +, JCCEND, NCHCCC,IXCCC, CCKORG, CCKARD, CCCOMF
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
- +, IXBLADK, IXSQSP(7), NTRBLA,NMODIF, JSLTTL, LASTTI
-C-------------- End CDE --------------------------------
-
-
-
-C---- delete leading comments
-
- LDO = LQPREP
- 21 LPR = LDO
- LDO = LQ(LDO-1)
- IF (LDO.EQ.0) RETURN
- IF (LQ(LDO-2).NE.0) GO TO 21
- JCCTYP = JBYT (IQ(LDO),9,6)
- IF (JCCTYP.EQ.0) GO TO 24
- IF (JCCTYP.LT.MCCTRU) GO TO 22
- IF (JCCTYP.LT.MCCKEE) GO TO 31
-
-C-- step over foreign and control material
-
- 22 CALL TIFORG (LPR,LDO)
- IF (LDO.EQ.0) RETURN
- IF (JCCTYP.NE.0) GO TO 31
-
-C-- check all comment
-
- 24 JSLA = IQ(LDO+1)
- NSL = IQ(LDO+2)
- JSLE = JSLA + NSL
-
- JSL = JSLA - 1
- 25 JSL = JSL + 1
- IF (JSL.GE.JSLE) GO TO 27
-
- JTX = MLIAD(JSL)
- NTX = MLIAD(JSL+1) - JTX - NCHNEWL
- IF (NTX.EQ.0) GO TO 25
- IF (TEXT(JTX).EQ.'C') GO TO 25
- IF (TEXT(JTX).EQ.'c') GO TO 25
- IF (TEXT(JTX).EQ.'*') GO TO 25
-
- IF (JSL.EQ.JSLA) GO TO 31
- LPR = LDO
- LDO = M_SPLIT (LPR,JSL)
- LQ(LPR-2) = -1
- GO TO 31
-
- 27 LQ(LDO-2) = -1
- GO TO 21
-
-C----- set the reverse link on remaining banks
-
- 31 CONTINUE
- 34 LPR = LDO
- 35 LDO = LQ(LDO-1)
- IF (LDO.EQ.0) GO TO 39
- IF (LQ(LDO-2).NE.0) GO TO 35
- JCCTYP = JBYT (IQ(LDO),9,6)
- IF (JCCTYP.EQ.MCCNIL) GO TO 36
- IF (JCCTYP.EQ.MCCKIL) GO TO 36
- IF (JCCTYP.LT.MCCKEE) GO TO 37
-
-C-- step over foreign and control material
-
- 36 CALL TIFORG (LPR,LDO)
- IF (LDO.EQ.0) GO TO 39
-
- 37 LQ(LDO-3) = LPR
- GO TO 34
-
- 39 LLAST = LPR
-
-C---- look for trailing comment lines
-
- LDO = LLAST
-
- 42 JCCTYP = JBYT (IQ(LDO),9,6)
- IF (JCCTYP.NE.0) GO TO 89
-
- JSLA = IQ(LDO+1)
- NSL = IQ(LDO+2)
- JSLE = JSLA + NSL
-
- JSL = JSLE
- 44 JSL = JSL - 1
- IF (JSL.LT.JSLA) GO TO 47
-
- JTX = MLIAD(JSL)
- NTX = MLIAD(JSL+1) - JTX - NCHNEWL
- IF (NTX.EQ.0) GO TO 44
- IF (TEXT(JTX).EQ.'C') GO TO 44
- IF (TEXT(JTX).EQ.'c') GO TO 44
- IF (TEXT(JTX).EQ.'*') GO TO 44
-
- JSL = JSL + 1
- IF (JSL.EQ.JSLE) GO TO 89
-
- LPR = LDO
- LDO = M_SPLIT (LPR,JSL)
- LQ(LDO-2) = -1
- GO TO 89
-
-C-- all lines are comments
-
- 47 LQ(LDO-2) = -1
- LDO = LQ(LDO-3)
- IF (LDO.NE.0) GO TO 42
-
-C---- done
-
- 89 RETURN
- END
diff --git a/src/p5boot/p5lib/tideck.f b/src/p5boot/p5lib/tideck.f
deleted file mode 100644
index fd3adf9..0000000
--- a/src/p5boot/p5lib/tideck.f
+++ /dev/null
@@ -1,183 +0,0 @@
-CDECK ID>, TIDECK.
- SUBROUTINE TIDECK
-
-C- Tidy all decks until next +TITLE
-C. started 26-may-94
-
- PARAMETER (MCCNIL=1, MCCKIL=2, MCCINC=3, MCCCDE=4, MCCSEQ=5,
- + MCCXSQ=6, MCCTRU=7, MCCFAL=8, MCCELS=9, MCCEND=10,
- + MCCSEL=11, MCCSES=12, MCCFAU=13, MCCSKI=14,
- + MCCKEE=15, MCCDEL=16, MCCREP=17, MCCADB=18, MCCADD=19,
- + MCCUSE=20, MCCXDI=21, MCCDIV=22, MCCLIS=23, MCCEXE=24, MCCIMI=25,
- + MCCASM=26, MCCUPD=27, MCCNAM=28, MCCGAP=29, MCCMOR=30, MCCONL=31,
- + MCCFOR=32, MCCSUS=33, MCCOPT=34, MCCOP2=35, MCCSHO=36, MCCPAM=37,
- + MCCQUI=38, MCCEOD=39, MCCDEC=40, MCCPAT=41, MCCTIT=42)
- CHARACTER CCKORG*256, CCKARD*256, CCCOMF*256
- COMMON /CCPARA/NCHCCD,NCHCCT, JCCTYP,JCCLEV,JCCSL,MCCPAR(240)
- +, NCCPAR,MXCCIF,JCCIFV,JCCBAD,JCCWAR,ICCSUB,JCCWK(4)
- +, JCCPP,JCCPD,JCCPZ,JCCPT,JCCPIF,JCCPC,JCCPN
- +, NCCPP,NCCPD,NCCPZ,NCCPT,NCCPIF,NCCPC,NCCPN
- +, JCCEND, NCHCCC,IXCCC, CCKORG, CCKARD, CCCOMF
- CHARACTER CHEXPD*68
- COMMON /CHEXC/ IXEXPAM, IXEXPAT,IXEXDEC,IXEXID, NCHEPD, CHEXPD
- PARAMETER (JFO_TYP=1, JCC_TYP=2, JAS_TYP=3, JDA_TYP=4,
- + JSH_TYP=5, JCR_TYP=6, JIN_TYP=7, MAX_TYP=100)
- CHARACTER*16 CH_TYP(MAX_TYP), ACT_TYP
- COMMON /CM_TYP/ LUN_TYP, N_TYP, NAL_TYP, NDV_TYP, JBK_TYP
- +, JU_TYP(MAX_TYP), CH_TYP, ACT_TYP
- COMMON /DEPCOM/JD_NEW, JD_DTN, JD_DTP, JD_DTD, JD_DIV
- +, JD_SML, JD_SMP, JD_SMX, JDP_DT, JDP_DV
- +, JD_SPL, JD_MOD, JD_LUN, JD_LOG, JD_NLI, JD_MULT
- +, IX_EXT, IX_RH, IX_SUB
- COMMON /QPAGE/ NQLMAX,NQLTOL,NQLTOK,NQCMAX,NQCPGH,NQPAGE
- +, NQWYLDO,NQWYL,NQNEWH,NQJOIN,NQDKNO,NQDKPG
- COMMON /MQCM/ NQSYSS,NQLINK, LQCSTA(3),LQCEND(3), NQMAX
- +, LQLSTA(5),LQLEND(5), LQADR,LQADR0,NQOFFS
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
- +, IXBLADK, IXSQSP(7), NTRBLA,NMODIF, JSLTTL, LASTTI
-C-------------- End CDE --------------------------------
-
-
-C-- Check file starts with +PATCH or +DECK
-
- IF (JCCTYP.EQ.MCCDEC) JDKTYP= 1
- IF (JCCTYP.EQ.MCCPAT) JDKTYP= 2
- NOFFBD = 0
-
-C-- make sure the deck is in memory
-
- 21 IF (JDKNEX.EQ.0) THEN
- CALL ARRIVE (2)
- CALL TIDISTB
- NTRBLA = NTRBLA + IQUEST(1)
- ENDIF
-
-C-- set limits of control division 2
-
- 22 LQCSTA(2) = LQCEND(1) + 100
- LQCEND(2) = LQCSTA(2)
-
-C-- clear text division 3
-
- LQLSTA(3) = LQLEND(2)
- LQLEND(3) = LQLSTA(3)
-
-C-------- Ready the deck parameters
-
- NQNEWH = 7
- IF (JDKTYP.EQ.1) GO TO 46
- IXEXDEC = 0
- IF (JDKTYP.EQ.2) GO TO 41
-
-C---- deck header is +TITLE or start of PAM
-
- JD_DTP = 0
- JD_DTD = 0
- GO TO 49
-
-C---- deck header is +PATCH, name
-
- 41 JSLF = IQ(LQHOLD+1)
- IF (JDKNEX.NE.1) GO TO 44
-
-C-- check next deck is BLANKDEK
-
- JSLN = JSLF + IQ(LQHOLD+3)
- JCCTYP = MCCDEC
- CALL CCKRAK (JSLN)
- IX = MCCPAR(JCCPD+1)
- IF (IX.NE.IXBLADK) GO TO 44
-
- NOFFBD = IQ(LQHOLD+3)
- JTXN = MLIAD(JSLN)
- TEXT(JTXN) = '*'
- CALL ARRNXD (0)
- IF (JDKNEX.EQ.0) GO TO 21
-
- 44 JCCTYP = MCCPAT
- CALL CCKRAK (JSLF)
- IXEXPAT = MCCPAR(JCCPP+1)
- IF (IXEXPAT.EQ.0) IXEXPAT= 1
- IXEXID = IXEXPAT
-
- JD_DTD = 0
- IF (JCCBAD.EQ.0) THEN
- CALL CCDOPT (1, JD_DTD)
- IF (JD_DTD.EQ.0) JD_DTD= 1
- ENDIF
- JD_DTP = JD_DTD
- GO TO 49
-
-C---- deck header is +DECK, name
-
- 46 JSLF = IQ(LQHOLD+1)
- JCCTYP = MCCDEC
- CALL CCKRAK (JSLF)
- IXEXDEC = MCCPAR(JCCPD+1)
- IF (IXEXDEC.EQ.0) IXEXDEC= 1
- IXEXID = IXEXDEC
-
- JD_DTD = 0
- IF (JCCBAD.EQ.0) THEN
- CALL CCDOPT (1, JD_DTD)
- IF (JD_DTD.EQ.0) JD_DTD= JD_DTP
- ENDIF
-
-C-- if type is INCLUDE: handle as CC
-
- 49 IF (JD_DTD.EQ.JIN_TYP) JD_DTD= JCC_TYP
-
-C-------- Process the deck
-
- LEXD = 0
- NSLORG = 0
-
-C-- restore the leading + for +DECK, BLANKDEK.
-
- IF (NOFFBD.NE.0) THEN
- JSLN = IQ(LQHOLD+1) + NOFFBD
- JTXN = MLIAD(JSLN)
- TEXT(JTXN) = '+'
- ENDIF
-
-C-- analyse the contents
-
- CALL DOMAPA (0)
- IF (JDKTYP.EQ.3) GO TO 67
-
- IF (NOFFBD.NE.0) THEN
- L = LQFIND (JSLN,1, LQPREP)
- IF (L.NE.0) LQ(L-2) = -1
- NOFFBD = 0
- ENDIF
-
-C-- transform the contents
-
- IF (JD_DTD.EQ.1) CALL TICOMM
- CALL TISEQ
- CALL TILIST
-
-C-- send the deck to output
-
- 67 CALL TISEND
-
-C-- step to the next deck
-
- CALL ARRNXD (1)
- IFLGAR = 0
- IF (JDKTYP.LT.3) GO TO 21
- RETURN
- END
diff --git a/src/p5boot/p5lib/tidistb.f b/src/p5boot/p5lib/tidistb.f
deleted file mode 100644
index d2fd335..0000000
--- a/src/p5boot/p5lib/tidistb.f
+++ /dev/null
@@ -1,71 +0,0 @@
-CDECK ID>, TIDISTB.
- SUBROUTINE TIDISTB
-
-C- Discard trailing blanks on the lines in memory
-C. started 26-may-94
-
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
-C-------------- End CDE --------------------------------
- EQUIVALENCE (NCOUNT,IQUEST(1))
-
- IAND (IZV,IZW) = AND (IZV, IZW)
-
- NCOUNT = 0
- IF (IAND(IQ(LQHOLD),1) .EQ.0) RETURN
- CALL SBIT0 (IQ(LQHOLD),1)
-
- JSLSTA = IQ(LQHOLD+1)
- JSLEND = IQ(LQHOLD+1) + IQ(LQHOLD+2)
-
-C---- scan to find next line with trailing blank
-
- JSL1 = JSLSTA
- JTXPUT = MLIAD(JSL1)
- 41 JTXTAK = MLIAD(JSL1)
- JSL2 = JSLEND - 1
-
- DO 42 J=JSL1,JSL2
- JTXF = MLIAD(J)
- JTXN = MLIAD(J+1) - NCHNEWL
- IF (JTXN.EQ.JTXF) GO TO 42
- IF (TEXT(JTXN-1).EQ.' ') GO TO 44
- 42 CONTINUE
- IF (NCOUNT.EQ.0) RETURN
- NCHCOP = MLIAD(JSLEND) - JTXTAK
- GO TO 51
-
-C-- step to last non-blank on the line
-
- 44 JSL2 = J
- 45 JTXN = JTXN - 1
- IF (JTXN.GT.JTXF) THEN
- IF (TEXT(JTXN-1).EQ.' ') GO TO 45
- ENDIF
-
- TEXT(JTXN) = CHAR(NEWLN)
- JTXN = JTXN + 1
- NCHCOP = JTXN - JTXTAK
- IF (NCOUNT.EQ.0) GO TO 57
-
-C-- copy the text and update the line slots
-
- 51 CALL CCOPYL (TEXT(JTXTAK), TEXT(JTXPUT), NCHCOP)
- NSH = JTXPUT - JTXTAK
-
- DO 54 J=JSL1,JSL2
- 54 MLIAD(J) = MLIAD(J) + NSH
-
- 57 JTXPUT = JTXPUT + NCHCOP
- NCOUNT = NCOUNT + 1
- JSL1 = JSL2 + 1
- IF (JSL1.LT.JSLEND) GO TO 41
- MLIAD(JSLEND) = JTXPUT
- RETURN
- END
diff --git a/src/p5boot/p5lib/tiforg.f b/src/p5boot/p5lib/tiforg.f
deleted file mode 100644
index 4ff0f05..0000000
--- a/src/p5boot/p5lib/tiforg.f
+++ /dev/null
@@ -1,63 +0,0 @@
-CDECK ID>, TIFORG.
- SUBROUTINE TIFORG (LPREV,LNEXT)
-
-C- Skip over foreign and control material
-C. started 9-may-95
-
- PARAMETER (MCCNIL=1, MCCKIL=2, MCCINC=3, MCCCDE=4, MCCSEQ=5,
- + MCCXSQ=6, MCCTRU=7, MCCFAL=8, MCCELS=9, MCCEND=10,
- + MCCSEL=11, MCCSES=12, MCCFAU=13, MCCSKI=14,
- + MCCKEE=15, MCCDEL=16, MCCREP=17, MCCADB=18, MCCADD=19,
- + MCCUSE=20, MCCXDI=21, MCCDIV=22, MCCLIS=23, MCCEXE=24, MCCIMI=25,
- + MCCASM=26, MCCUPD=27, MCCNAM=28, MCCGAP=29, MCCMOR=30, MCCONL=31,
- + MCCFOR=32, MCCSUS=33, MCCOPT=34, MCCOP2=35, MCCSHO=36, MCCPAM=37,
- + MCCQUI=38, MCCEOD=39, MCCDEC=40, MCCPAT=41, MCCTIT=42)
- CHARACTER CCKORG*256, CCKARD*256, CCCOMF*256
- COMMON /CCPARA/NCHCCD,NCHCCT, JCCTYP,JCCLEV,JCCSL,MCCPAR(240)
- +, NCCPAR,MXCCIF,JCCIFV,JCCBAD,JCCWAR,ICCSUB,JCCWK(4)
- +, JCCPP,JCCPD,JCCPZ,JCCPT,JCCPIF,JCCPC,JCCPN
- +, NCCPP,NCCPD,NCCPZ,NCCPT,NCCPIF,NCCPC,NCCPN
- +, JCCEND, NCHCCC,IXCCC, CCKORG, CCKARD, CCCOMF
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
-C-------------- End CDE --------------------------------
-
-
-
- LDO = LQ(LPREV-1)
- IF (JCCTYP.LT.MCCKEE) GO TO 24
- IF (JCCTYP.GE.MCCUSE) GO TO 24
-
-C-- scan foreign
-
- 21 LDO = LQ(LDO-1)
- IF (LDO.EQ.0) GO TO 27
- IF (LQ(LDO-2).NE.0) GO TO 21
- JCCTYP = JBYT (IQ(LDO),9,6)
- IF (JCCTYP.LT.MCCSEL) GO TO 21
- IF (JCCTYP.GE.MCCUSE) GO TO 24
- IF (JCCTYP.GE.MCCKEE) GO TO 21
- GO TO 27
-
-C-- scan control
-
- 24 LDO = LQ(LDO-1)
- IF (LDO.EQ.0) GO TO 27
- IF (LQ(LDO-2).NE.0) GO TO 24
- JCCTYP = JBYT (IQ(LDO),9,6)
- IF (JCCTYP.GE.MCCUSE) GO TO 24
- IF (JCCTYP.GE.MCCKEE) GO TO 21
- IF (JCCTYP.EQ.0) GO TO 27
- IF (JCCTYP.LT.MCCTRU) GO TO 24
-
-C-- end of scan
-
- 27 LNEXT = LDO
- RETURN
- END
diff --git a/src/p5boot/p5lib/tilist.f b/src/p5boot/p5lib/tilist.f
deleted file mode 100644
index 40b4de7..0000000
--- a/src/p5boot/p5lib/tilist.f
+++ /dev/null
@@ -1,135 +0,0 @@
-CDECK ID>, TILIST.
- SUBROUTINE TILIST
-
-C- Count the modification done, list them if option Verbose
-C. started 27-may-94
-
- COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT,NUSLAT(2),DUMMY(34)
- CHARACTER SLLINE*512, SLERRM*256
- COMMON /SLATLN/ SLLINE, SLERRM
- COMMON /QPAGE/ NQLMAX,NQLTOL,NQLTOK,NQCMAX,NQCPGH,NQPAGE
- +, NQWYLDO,NQWYL,NQNEWH,NQJOIN,NQDKNO,NQDKPG
- COMMON /QUNIT/ IQREAD,IQPRNT, IQTTIN,IQTYPE, IQOFFL,IQRTTY,IQRSAV
- +, IQRFD,IQRRD,IQRSIZ, NQLPAT,NQUSED,NQLLBL, NQINIT
- CHARACTER CHEXPD*68
- COMMON /CHEXC/ IXEXPAM, IXEXPAT,IXEXDEC,IXEXID, NCHEPD, CHEXPD
- PARAMETER (KQGARB=1,KQARRV=3,KQKEEP=4,KQPREP=5,KQMAIN=6,KQPAST=8)
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
- +, IXBLADK, IXSQSP(7), NTRBLA,NMODIF, JSLTTL, LASTTI
-C-------------- End CDE --------------------------------
- CHARACTER LINE*512
- EQUIVALENCE (LINE,SLLINE)
-
-
- LDO = KQPREP + 1
- 21 LDO = LQ(LDO-1)
- IF (LDO.EQ.0) RETURN
- IF (LQ(LDO-2).EQ.0) GO TO 21
-
- NMODIF = NMODIF + 1
- IF (MOPTIO(22).EQ.0) GO TO 21
-
- IF (NQNEWH.EQ.0) GO TO 27
- NQNEWH = 0
-
-C-- list P/D identifier
-
- LINE(1:80) = ' --- p='
- CALL NA_GET (IXEXPAT,LINE,8)
- JN = NESLAT
- LINE(JN+1:JN+2) = 'd='
- CALL NA_GET (IXEXDEC,LINE,JN+3)
- N = NESLAT - 1
-
- CALL DPBLAN (0)
- WRITE (IQPRNT,9024) LINE(1:N)
- 9024 FORMAT (A/)
-
- 27 LNEW = LQ(LDO-2)
- JSLOLD = IQ(LDO+1)
- NSLOLD = IQ(LDO+2)
- IF (LNEW.GT.0) GO TO 41
-
-C------ NSLOLD lines deleted
-
-C-- check multiple deletes
-
- 31 LNX = LQ(LDO-1)
- IF (LNX.EQ.0) GO TO 32
- IF (LQ(LNX-2).GE.0) GO TO 32
- NSLOLD = NSLOLD + IQ(LNX+2)
- IQ(LDO+2) = NSLOLD
- LQ(LDO-1) = LQ(LNX-1)
- GO TO 31
-
- 32 CALL DPBLAN (1)
- WRITE (IQPRNT,9032)
- 9032 FORMAT (' delete:')
-
- JSL = JSLOLD
- LNO = JSL - JSLZER
- JSLE = JSLOLD + NSLOLD - 1
- LNOE = LNO + NSLOLD - 1
-
- NSLX = NSLOLD
- IF (NSLX.GT.7) NSLX = 3
-
- DO 34 J=1,NSLX
- CALL LN_GET (JSL,LINE,512)
- WRITE (IQPRNT,9034) LNO,LINE(1:NDSLAT)
- LNO = LNO + 1
- 34 JSL = JSL + 1
- IF (NSLX.EQ.NSLOLD) GO TO 21
-
- CALL LN_GET (JSLE,LINE,512)
- WRITE (IQPRNT,9033)
- WRITE (IQPRNT,9034) LNOE,LINE(1:NDSLAT)
- GO TO 21
-
- 9033 FORMAT (8X,'...')
- 9034 FORMAT (I8,' - ',A)
-
-C------ NSLNEW lines replacing
-
- 41 JSLNEW = IQ(LNEW+1)
- NSLNEW = IQ(LNEW+2)
-
- CALL DPBLAN (1)
- WRITE (IQPRNT,9041)
- 9041 FORMAT (' replace:')
-
- JSL = JSLOLD
- LNO = JSL - JSLZER
-
- DO 44 J=1,NSLOLD
- CALL LN_GET (JSL,LINE,512)
- WRITE (IQPRNT,9034) LNO,LINE(1:NDSLAT)
- LNO = LNO + 1
- 44 JSL = JSL + 1
-
- WRITE (IQPRNT,9042)
- 9042 FORMAT (' by:')
-
- JSL = JSLNEW
-
- DO 46 J=1,NSLNEW
- CALL LN_GET (JSL,LINE,512)
- WRITE (IQPRNT,9044) LINE(1:NDSLAT)
- 46 JSL = JSL + 1
- GO TO 21
-
- 9044 FORMAT (8X,' < ',A)
- END
diff --git a/src/p5boot/p5lib/tisend.f b/src/p5boot/p5lib/tisend.f
deleted file mode 100644
index 98a24d5..0000000
--- a/src/p5boot/p5lib/tisend.f
+++ /dev/null
@@ -1,48 +0,0 @@
-CDECK ID>, TISEND.
- SUBROUTINE TISEND
-
-C- Send the material of the current deck to output
-C. started 26-may-94
-
- COMMON /DEPCOM/JD_NEW, JD_DTN, JD_DTP, JD_DTD, JD_DIV
- +, JD_SML, JD_SMP, JD_SMX, JDP_DT, JDP_DV
- +, JD_SPL, JD_MOD, JD_LUN, JD_LOG, JD_NLI, JD_MULT
- +, IX_EXT, IX_RH, IX_SUB
- PARAMETER (KQGARB=1,KQARRV=3,KQKEEP=4,KQPREP=5,KQMAIN=6,KQPAST=8)
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
-C-------------- End CDE --------------------------------
-
-
- LDO = KQPREP + 1
- 21 LDO = LQ(LDO-1)
- IF (LDO.EQ.0) RETURN
- LNEW = LQ(LDO-2)
- IF (LNEW.LT.0) GO TO 21
- IF (LNEW.EQ.0) THEN
- JSL = IQ(LDO+1)
- NSL = IQ(LDO+2)
- ELSE
- JSL = IQ(LNEW+1)
- NSL = IQ(LNEW+2)
- ENDIF
- IF (NSL.EQ.0) GO TO 21
-
- JTX = MLIAD(JSL)
- NTX = MLIAD(JSL+NSL) - JTX
- CALL CIPUT (JD_LUN,TEXT(JTX),NTX,ISTAT)
- IF (ISTAT.NE.0) CALL P_KILLM ('CIO write fails')
- GO TO 21
- END
diff --git a/src/p5boot/p5lib/tiseq.f b/src/p5boot/p5lib/tiseq.f
deleted file mode 100644
index 9ca7255..0000000
--- a/src/p5boot/p5lib/tiseq.f
+++ /dev/null
@@ -1,192 +0,0 @@
-CDECK ID>, TISEQ.
- SUBROUTINE TISEQ
-
-C- Transform special sequence calls
-C. started 26-may-94
-
- COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT,NUSLAT(2),DUMMY(34)
- CHARACTER SLLINE*512, SLERRM*256
- COMMON /SLATLN/ SLLINE, SLERRM
- CHARACTER CQDATEM*10, CQDATE*8, CQTIME*5
- COMMON /QSTATE/NQERR,NQWARN,NQINFO,NQLOCK
- +, IQDATE,IQTIME, CQDATEM,CQDATE,CQTIME
- PARAMETER (MCCNIL=1, MCCKIL=2, MCCINC=3, MCCCDE=4, MCCSEQ=5,
- + MCCXSQ=6, MCCTRU=7, MCCFAL=8, MCCELS=9, MCCEND=10,
- + MCCSEL=11, MCCSES=12, MCCFAU=13, MCCSKI=14,
- + MCCKEE=15, MCCDEL=16, MCCREP=17, MCCADB=18, MCCADD=19,
- + MCCUSE=20, MCCXDI=21, MCCDIV=22, MCCLIS=23, MCCEXE=24, MCCIMI=25,
- + MCCASM=26, MCCUPD=27, MCCNAM=28, MCCGAP=29, MCCMOR=30, MCCONL=31,
- + MCCFOR=32, MCCSUS=33, MCCOPT=34, MCCOP2=35, MCCSHO=36, MCCPAM=37,
- + MCCQUI=38, MCCEOD=39, MCCDEC=40, MCCPAT=41, MCCTIT=42)
- CHARACTER CCKORG*256, CCKARD*256, CCCOMF*256
- COMMON /CCPARA/NCHCCD,NCHCCT, JCCTYP,JCCLEV,JCCSL,MCCPAR(240)
- +, NCCPAR,MXCCIF,JCCIFV,JCCBAD,JCCWAR,ICCSUB,JCCWK(4)
- +, JCCPP,JCCPD,JCCPZ,JCCPT,JCCPIF,JCCPC,JCCPN
- +, NCCPP,NCCPD,NCCPZ,NCCPT,NCCPIF,NCCPC,NCCPN
- +, JCCEND, NCHCCC,IXCCC, CCKORG, CCKARD, CCCOMF
- PARAMETER (JFO_TYP=1, JCC_TYP=2, JAS_TYP=3, JDA_TYP=4,
- + JSH_TYP=5, JCR_TYP=6, JIN_TYP=7, MAX_TYP=100)
- CHARACTER*16 CH_TYP(MAX_TYP), ACT_TYP
- COMMON /CM_TYP/ LUN_TYP, N_TYP, NAL_TYP, NDV_TYP, JBK_TYP
- +, JU_TYP(MAX_TYP), CH_TYP, ACT_TYP
- COMMON /DEPCOM/JD_NEW, JD_DTN, JD_DTP, JD_DTD, JD_DIV
- +, JD_SML, JD_SMP, JD_SMX, JDP_DT, JDP_DV
- +, JD_SPL, JD_MOD, JD_LUN, JD_LOG, JD_NLI, JD_MULT
- +, IX_EXT, IX_RH, IX_SUB
- CHARACTER CHTTNA*10, CHTTDT*20
- COMMON /USETTC/ JTTNAM,JTTVER,JTTSLA,JTTDAT,JTTCOM
- +, NTTNA(5), NTTDT, NTTNORM, NTTALL
- +, CHTTNA(5), CHTTDT
- PARAMETER (NBANKS=19,JBKPAT=1, JBKDEC=2, JBKORG=3, JBKINC=4,
- + JBKHOL=5, JBKKEE=6, JBKACT=7, JBKMAT=8, JBKXSQ=9,
- + JBKPRE=10,JBKGAR=11,JBKSMH=12,JBKSMT=13,JBKSML=14,
- + JBKSMX=15,JBKARR=16,JBKASA=17,JBKPAM=18,JBKRPA=19)
- COMMON /QBANKS/MMBANK(5,NBANKS)
- PARAMETER (KQGARB=1,KQARRV=3,KQKEEP=4,KQPREP=5,KQMAIN=6,KQPAST=8)
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
- +, IXBLADK, IXSQSP(7), NTRBLA,NMODIF, JSLTTL, LASTTI
-C-------------- End CDE --------------------------------
- EQUIVALENCE (IFLBACK,MOPTIO(2)), (IFLCMZ,MOPTIO(3))
- CHARACTER LINE*128
- EQUIVALENCE (LINE,SLLINE)
-
-
-
-C---- Next bank
-
- LDO = KQPREP + 1
- 11 LDO = LQ(LDO-1)
- IF (LDO.EQ.0) RETURN
- IF (LQ(LDO-2).NE.0) GO TO 11
-
- JCCTYP = JBYT (IQ(LDO),9,6)
- IF (JCCTYP.LT.MCCCDE) GO TO 11
- IF (JCCTYP.GT.MCCSEQ) GO TO 11
-
- JSLOLD = IQ(LDO+1)
- CALL CCKRAK (JSLOLD)
- IF (NCCPZ.NE.1) GO TO 11
-
- IXZ = MCCPAR(JCCPZ+1)
- IF (IXZ.EQ.0) GO TO 11
- JSQ = IUCOMP (IXZ,IXSQSP,4)
- IF (JSQ.EQ.0) GO TO 11
- NSL = 1
- GO TO (21, 31, 41, 51), JSQ
-
-
-C---- doing +SEQ, DATEQQ
-
- 21 IF (IFLCMZ.NE.0) GO TO 24
- 22 IF (IFLBACK.NE.0) GO TO 11
-
- JSLNEW = LN_TO3 ('+SEQ, QDATE . IDATQQ = ?')
- GO TO 88
-
- 24 IF (JD_DTD.NE.JCC_TYP) GO TO 22
- IF (IFLBACK.NE.0) GO TO 26
- JSLNEW = LN_TO3 ('+SEQ, QDATE .#define IDATQQ ?')
- GO TO 88
-
- 26 LINE = '#define IDATQQ '
-C- _:.=+=.: 1_:.=+=.: 2_:.=+
- CALL CSETDI (IQDATE, LINE,17,24)
- JSLNEW = LN_TO3 (LINE(1:24))
- GO TO 88
-
-C---- doing +SEQ, TIMEQQ
-
- 31 IF (IFLCMZ.NE.0) GO TO 34
- 32 IF (IFLBACK.NE.0) GO TO 11
-
- JSLNEW = LN_TO3 ('+SEQ, QTIME . ITIMQQ = ?')
- GO TO 88
-
- 34 IF (JD_DTD.NE.JCC_TYP) GO TO 32
- IF (IFLBACK.NE.0) GO TO 36
- JSLNEW = LN_TO3 ('+SEQ, QTIME .#define ITIMQQ ?')
- GO TO 88
-
- 36 LINE = '#define ITIMQQ '
-C- _:.=+=.: 1_:.=+=.: 2_:.=+
- CALL CSETDI (IQTIME, LINE,17,22)
- JSLNEW = LN_TO3 (LINE(1:24))
- GO TO 88
-
-C---- doing +SEQ, VERSQQ
-
- 41 IF (IFLCMZ.EQ.0) GO TO 11
- IF (JD_DTD.EQ.JCC_TYP) GO TO 44
- IF (IFLBACK.NE.0) GO TO 42
- JSLNEW = LN_TO3 ('+SEQ, QFVSNUM . IVERSQ = ?')
- GO TO 88
-
- 42 LINE = ' IVERSQ = ' // CHTTNA(3)
- JSLNEW = LN_TO3 (LINE(1:40))
- GO TO 88
-
- 44 IF (IFLBACK.NE.0) GO TO 46
- JSLNEW = LN_TO3 ('+SEQ, QFVERS .#define VERSQQ "?"')
- JSL = LN_TO3 ('+SEQ, QFVSNUM .#define IVERSQ ?')
- NSL = 2
- GO TO 88
-
- 46 LINE = '#define VERSQQ "' // CHTTNA(2)
- N = LENOCC (LINE(1:48))
- LINE(N+1:N+1) = '"'
- JSLNEW = LN_TO3 (LINE(1:48))
- LINE = '#define IVERSQ ' // CHTTNA(3)
- JSL = LN_TO3 (LINE(1:48))
- NSL = 2
- GO TO 88
-
-C---- doing +SEQ, VIDQQ
-
- 51 IF (IFLCMZ.EQ.0) GO TO 11
- IF (JD_DTD.EQ.JCC_TYP) GO TO 54
-
- NSL = 2
- JSLNEW = LN_TO3 (' CHARACTER VIDQQ*(48)')
-
- IF (IFLBACK.NE.0) GO TO 52
- JSL = LN_TO3 ('+SEQ, QFHEAD . DATA VIDQQ /''@(#)?>''/')
- GO TO 88
-
- 52 LINE = ' DATA VIDQQ /''@(#)' //
- + CHTTNA(1)(1:9) // CHTTNA(2) // CHTTDT
- N = LENOCC (LINE(1:68))
- LINE(N+1:N+3) = '>''/'
- JSL = LN_TO3 (LINE(1:N+3))
- GO TO 88
-
- 54 IF (IFLBACK.NE.0) GO TO 56
- JSLNEW =
- + LN_TO3 ('+SEQ, QFHEAD .static char vidqq[] = "@(#)?>"')
- GO TO 88
-
- 56 LINE = 'static char vidqq[] = "@(#)' //
- + CHTTNA(1)(1:9) // CHTTNA(2) // CHTTDT
- N = LENOCC (LINE(1:80))
- LINE(N+1:N+2) = '>"'
- JSLNEW = LN_TO3 (LINE(1:N+2))
-
-C---- store the replacement
-
- 88 CALL MQLIFT (LNEW, LDO,-2, JBKPRE,2)
- IQ(LNEW+1) = JSLNEW
- IQ(LNEW+2) = NSL
- GO TO 11
- END
diff --git a/src/p5boot/p5lib/togarb.f b/src/p5boot/p5lib/togarb.f
deleted file mode 100644
index e806dad..0000000
--- a/src/p5boot/p5lib/togarb.f
+++ /dev/null
@@ -1,63 +0,0 @@
-CDECK ID>, TOGARB.
- SUBROUTINE TOGARB (KDO,IFLAG)
-
-C- Shunt the single bank connected at KDO (if IFLAG.EQ.0)
-C- or the linear structure at KDO (if IFLAG.NE.0)
-C- to the garbage structure
-C. started 5-dec-91
-
- COMMON /MQCM/ NQSYSS,NQLINK, LQCSTA(3),LQCEND(3), NQMAX
- +, LQLSTA(5),LQLEND(5), LQADR,LQADR0,NQOFFS
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
-C-------------- End CDE --------------------------------
-
-
- LDO = LQ(KDO)
- IF (LDO.EQ.0) RETURN
-
-C-- single bank
-
- IF (IFLAG.NE.0) GO TO 21
- LQ(KDO) = LQ(LDO-1)
- IF (LDO.GE.LQCSTA(2)) RETURN
-
- LQ(LDO-1) = LQGARB
- LQGARB = LDO
- RETURN
-
-C-- linear structure
-
- 21 KL = KDO
- 22 LL = LQ(KL)
- IF (LL.GT.0) THEN
- IF (LL.GE.LQCSTA(2)) THEN
- LQ(KL) = LQ(LL-1)
- GO TO 22
- ELSE
- KL = LL - 1
- GO TO 22
- ENDIF
- ENDIF
-
- LDO = LQ(KDO)
- IF (LDO.EQ.0) RETURN
-
- LQ(KL) = LQGARB
- LQGARB = LDO
-
- LQ(KDO) = 0
- RETURN
- END
diff --git a/src/p5boot/p5lib/togatx.f b/src/p5boot/p5lib/togatx.f
deleted file mode 100644
index a0dfd5e..0000000
--- a/src/p5boot/p5lib/togatx.f
+++ /dev/null
@@ -1,28 +0,0 @@
-CDECK ID>, TOGATX.
- SUBROUTINE TOGATX (JSL,NSL)
-
-C- Send the NSL lines at JSL in division 1 to garbage
-C. started 5-feb-92
-
- PARAMETER (NBANKS=19,JBKPAT=1, JBKDEC=2, JBKORG=3, JBKINC=4,
- + JBKHOL=5, JBKKEE=6, JBKACT=7, JBKMAT=8, JBKXSQ=9,
- + JBKPRE=10,JBKGAR=11,JBKSMH=12,JBKSMT=13,JBKSML=14,
- + JBKSMX=15,JBKARR=16,JBKASA=17,JBKPAM=18,JBKRPA=19)
- COMMON /QBANKS/MMBANK(5,NBANKS)
- COMMON /MQCM/ NQSYSS,NQLINK, LQCSTA(3),LQCEND(3), NQMAX
- +, LQLSTA(5),LQLEND(5), LQADR,LQADR0,NQOFFS
- PARAMETER (KQGARB=1,KQARRV=3,KQKEEP=4,KQPREP=5,KQMAIN=6,KQPAST=8)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ)
- EQUIVALENCE (LQ,IQ,LQGARB)
- COMMON // IQUEST(100),LQGARB
-C-------------- End CDE --------------------------------
-
-
- IF (JSL.GE.LQLEND(1)) RETURN
-
- CALL MQLIFT (L,KQGARB,0,JBKGAR,1)
- LQ(L+1) = JSL
- LQ(L+2) = NSL
- RETURN
- END
diff --git a/src/p5boot/p5lib/usett.f b/src/p5boot/p5lib/usett.f
deleted file mode 100644
index db069c3..0000000
--- a/src/p5boot/p5lib/usett.f
+++ /dev/null
@@ -1,187 +0,0 @@
-CDECK ID>, USETT.
- SUBROUTINE USETT (JSL)
-
-C- Ready a title line for usage
-C. started 26-may-94
-
- COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT,NUSLAT(2),DUMMY(34)
- CHARACTER SLLINE*512, SLERRM*256
- COMMON /SLATLN/ SLLINE, SLERRM
- CHARACTER CHTTNA*10, CHTTDT*20
- COMMON /USETTC/ JTTNAM,JTTVER,JTTSLA,JTTDAT,JTTCOM
- +, NTTNA(5), NTTDT, NTTNORM, NTTALL
- +, CHTTNA(5), CHTTDT
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
-C-------------- End CDE --------------------------------
- CHARACTER LINE*128, KARD*128
- EQUIVALENCE (LINE,SLERRM), (KARD,SLLINE)
-
-C- PATCHY 5.00 /72 1994/05/24 21.00 text
-C- _:.=+=.: 1_:.=+=.: 2_:.=+=.: 3_:.=+=.: 4_:.=+=.: 5_:.=
-C-
-C- start at col:
-C- JTTNAM CHTTNA(1) = name PATCHY
-C- JTTVER CHTTNA(2) = version 5.00 /72
-C- CHTTNA(3) = numeric vs 50072
-C-
-C- CHTTNA(4) = primary vs 5.00
-C- JTTSLA CHTTNA(5) = secondary vs 72
-C-
-C- JTTDAT CHTTDT = date/time 1994/05/24 21.00
-C- JTTCOM comment
-C-
-
- CALL VZERO (JTTNAM,12)
- CHTTNA(2) = '1.00'
- CHTTNA(3) = '10000'
- CHTTNA(4) = '1.00'
- CHTTNA(5) = '0'
- CHTTDT = ' '
-
- NTTNA(2) = 4
- NTTNA(3) = 5
- NTTNA(4) = 4
- NTTNA(5) = 1
- NTTDT = 0
-
- NVPRIM = 100
- NVSEC = 0
-
- IF (JSL.GT.0) THEN
- LINE = ' '
- CALL LN_GET (JSL, LINE, LEN(LINE))
- NTIT = NDSLAT
- CALL CLTOU (LINE(1:NTIT))
- ELSE
- LINE = 'unknown /1'
- NTIT = LNBLNK (LINE(1:16))
- ENDIF
-
-C-- check start with +TITLE: or C
-
- JTK = 1
- IF (LINE(1:4).EQ.'+TIT') THEN
- J = ICFIND (':', LINE,5,NTIT)
- IF (NGSLAT.NE.0) JTK= J + 1
- ELSEIF (LINE(1:2).EQ.'C ') THEN
- JTK = 3
- ENDIF
-
-C-- name
-
- JTK = ICNEXT (LINE,JTK,NTIT)
- N = MIN (10,NDSLAT)
- JNX = NESLAT
- NTTNA(1) = N
- CHTTNA(1) = LINE(JTK:JTK+N-1)
- JTTNAM = JTK
- IF (JSL.GT.0) CALL LN_GET (JSL, LINE, LEN(LINE))
-
-C-- does the version start with "/" ?
-
- JTK = ICNEXT (LINE,JNX,NTIT)
- IF (JTK.GE.NTIT) RETURN
-
- N = NDSLAT
- JNX = NESLAT
- IF (LINE(JTK:JTK).NE.'/') GO TO 26
- JTTSLA = JTK
-
- N = MIN (4,N)
- KARD(1:N) = LINE(JTK:JTK+N-1)
- IF (N.EQ.1) THEN
- KARD(2:2) = '1'
- N = 2
- ENDIF
-
- NTTNA(2) = N
- NTTNA(5) = N - 1
- CHTTNA(2) = KARD(1:N)
- CHTTNA(5) = KARD(2:N)
- NVSEC = ICDECI (KARD,2,N)
- GO TO 31
-
-C-- primary version
-
- 26 JTTVER = JTK
- JMK = ICFIND ('/', LINE,JTK,JNX)
- IF (JMK.LT.JNX) THEN
- JNX = JMK
- N = JNX - JTK
- ENDIF
-
- N = MIN (6,N)
- NTTNA(2) = N
- NTTNA(4) = N
-
- KARD(1:N) = LINE(JTK:JTK+N-1)
- CHTTNA(2) = KARD(1:N)
- CHTTNA(4) = KARD(1:N)
-
- NVPRIM = ICDECI (KARD,1,N) * 100
- JM = NESLAT + 1
- IF (JM.LE.N) NVPRIM = NVPRIM + ICDECI(KARD,JM,N)
-
-C-- secondary version
-
- JTK = ICNEXT (LINE,JNX,NTIT)
- N = NDSLAT - 1
- JNX = NESLAT
- IF (LINE(JTK:JTK).NE.'/') GO TO 34
- JTTSLA = JTK
- IF (N.LE.0) GO TO 31
-
- NTTNA(5) = N
- CHTTNA(5) = LINE(JTK+1:JTK+N)
- NSEC = ICDECI (CHTTNA(5),1,N)
-
- NP = NTTNA(4)
- CHTTNA(2) = CHTTNA(4)(1:NP) // ' /' // CHTTNA(5)(1:N)
- NTTNA(2) = LNBLNK (CHTTNA(2))
-
-C-- PAM creation date + time
-
- 31 JTK = ICNEXT (LINE,JNX,NTIT)
- JNX = NESLAT
-
- 34 IF (JTK.GT.NTIT) GO TO 41
- IF (ICTYPE(LINE(JTK:JTK)).NE.2) GO TO 41
- JTM = ICNEXT (LINE,JNX,NTIT)
- IF (JTM.LE.NTIT) THEN
- IF (ICTYPE(LINE(JTM:JTM)).EQ.2) THEN
- JNX = NESLAT
- ENDIF
- ENDIF
-
- N = JNX - JTK
- KARD(1:N) = LINE(JTK:JTK+N-1)
- CALL CSQMBL (KARD,1,N)
- N = MIN (N,20)
- N = LNBLNK (KARD(1:N))
- CHTTDT(1:N) = KARD(1:N)
- NTTDT = N
- JTK = ICFNBL (LINE,JNX,NTIT)
-
-C-- done
-
- 41 NTTALL = NTIT
- NTTNORM = NTIT
- IF (JTK.LE.NTIT) THEN
- NTTNORM = LNBLNK (LINE(1:JTK-1))
- JTTCOM = JTK
- ENDIF
-
- KARD(1:6) = ' '
- CALL CSETDI (100*NVPRIM+NVSEC, KARD,1,6)
- CALL CLEFT (KARD,1,6)
- NTTNA(3) = NDSLAT
- CHTTNA(3) = KARD(1:6)
- RETURN
- END
diff --git a/src/p5boot/p5lib/x_asm.f b/src/p5boot/p5lib/x_asm.f
deleted file mode 100644
index 2e0cc0e..0000000
--- a/src/p5boot/p5lib/x_asm.f
+++ /dev/null
@@ -1,356 +0,0 @@
-CDECK ID>, X_ASM.
- SUBROUTINE X_ASM
-
-C- Analyse the current control line +ASM, ...
-C. started 23-jan-92
-
- COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT,NUSLAT(2),DUMMY(34)
- CHARACTER SLLINE*512, SLERRM*256
- COMMON /SLATLN/ SLLINE, SLERRM
- PARAMETER (KM1=1,KM2=2,KM3=4,KM4=8,KM5=16,KM6=32,KM7=64,KM8=128,
- + KM9=256, KM10=512, KM11=1024, KM12=2048, KM13=4096, KM14=8192,
- + KM15=16384, KM16=32768, KM17=65536, KM18=131072, KM19=262144)
- CHARACTER CCKORG*256, CCKARD*256, CCCOMF*256
- COMMON /CCPARA/NCHCCD,NCHCCT, JCCTYP,JCCLEV,JCCSL,MCCPAR(240)
- +, NCCPAR,MXCCIF,JCCIFV,JCCBAD,JCCWAR,ICCSUB,JCCWK(4)
- +, JCCPP,JCCPD,JCCPZ,JCCPT,JCCPIF,JCCPC,JCCPN
- +, NCCPP,NCCPD,NCCPZ,NCCPT,NCCPIF,NCCPC,NCCPN
- +, JCCEND, NCHCCC,IXCCC, CCKORG, CCKARD, CCCOMF
- COMMON /LUNSLN/IFLAUX, IXLUN(12)
- PARAMETER (NSLIFI=128)
- CHARACTER CHLIFI*(NSLIFI), CHLIEX*8
- COMMON /FLINKC/LUNOP,LUNFD,LUNOLD,LUNSIZ
- +, IXFLUN, NLIFI,CHLIFI,CHLIEX
- PARAMETER (JFO_TYP=1, JCC_TYP=2, JAS_TYP=3, JDA_TYP=4,
- + JSH_TYP=5, JCR_TYP=6, JIN_TYP=7, MAX_TYP=100)
- CHARACTER*16 CH_TYP(MAX_TYP), ACT_TYP
- COMMON /CM_TYP/ LUN_TYP, N_TYP, NAL_TYP, NDV_TYP, JBK_TYP
- +, JU_TYP(MAX_TYP), CH_TYP, ACT_TYP
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
-C-------------- End CDE --------------------------------
- CHARACTER CCOL(256)*1, MSG*56, SLCOL(512)*1
- EQUIVALENCE (CCOL,CCKARD), (MSG,SLERRM), (SLCOL,SLLINE)
-
- PARAMETER (KXBY=KM1, KXAT=KM2, KXSP=KM3, KXMO=KM4, KXAL=KM5,
- + KXBI=KM6, KXUS=KM7, KXEX=KM8, KXSU=KM9, KXRH=KM10,
- + KXPR=KM11, KXLO=KM12, KXRE=KM13)
-
- PARAMETER (NPOSS = 13)
- CHARACTER POSS(NPOSS)*8
-
- DATA POSS / 'BY*PASS '
- +, 'A*TTACH '
- +, 'SPL*IT '
- +, 'MOD*IFY '
- +, 'ALI*AS '
- +, 'BIN*D '
- +, 'USE*D '
- +, 'EXT*EN* '
- +, 'CCH*SUBS'
- +, 'RH*EADER'
- +, 'PRE*FIX '
- +, 'LOG '
- +, 'REA*SSIG' /
-
-C- for +ASM, types, T=BYPASS
-C- +ASM, type, T=REASSIGN, S=type
-C- +ASM, types, T=ATTACH .fname
-C- +ASM, types, T=SPLIT
-C- +ASM, types, T=SPLIT, PREFIX .work/new_
-C- +ASM, types, T=SPLIT, LOG .fname
-C- +ASM, types, T=SPLIT, PREFIX, LOG .work/fname
-C- +ASM, types, T=MODIF
-C- +ASM, types, T=MODIF, PREFIX .work/new_
-C- +ASM, types, T=MODIF, LOG .fname
-C- +ASM, types, T=MODIF, PREFIX, LOG .work/fname
-C- +ASM, types, T=ALIAS
-C- +ASM, types, T=BIND
-C- +ASM, types, T=USED
-C- +ASM, types, T=EXTENSION .tex
-C- +ASM, types, T=CCHSUB .&+!+
-C- +ASM, types, T=RHEAD, .text
-
- IAND (IZV,IZW) = AND (IZV, IZW)
- ISHFTR (IZW,NZB) = ISHFT (IZW, -NZB)
-
-
- JBK_TYP = 0
- MASKOP = KXBI
- IF (NCCPT.EQ.0) GO TO 21
- CALL CCOPT (POSS,NPOSS)
- IF (JCCBAD.NE.0) GO TO 91
- MASKOP = MCCPAR(JCCPT+2)
- IF (MASKOP.EQ.0) GO TO 92
-
-C---- handle T=ALIAS
-
- IF (IAND(MASKOP,KXAL).NE.0) THEN
- IF (IAND(MASKOP,NOT(KXAL)).NE.0) GO TO 92
- CALL ASMALIA
- RETURN
- ENDIF
-
-C-- ready all needed ASMH and ASML banks
-
- 21 CALL ASMALL
- IF (JCCBAD.NE.0) GO TO 91
-
-C- this routine analyses the NCCPD parameters at JCCPD
-C- it creates the needed ASMT & ASML banks
-C- it replaces:
-C- MCCPAR(JCCPD+1) = JASM
-C- +2) = JSTRM = 0 for type:0
-C- 1 type:1
-C- 2 type:2
-C- same for JCCPP 3 type:3
-C- 4 type:4
- IF (JBK_TYP.EQ.0) THEN
- IF (NCCPT.EQ.0) GO TO 92
- ENDIF
-C---- handle T=REASSIGN, S=type
-
- IF (IAND(MASKOP,KXRE).EQ.0) GO TO 24
- IF (IAND(MASKOP,NOT(KXRE)).NE.0) GO TO 92
- IF (NCCPP.NE.1) GO TO 91
- IF (NCCPD.NE.1) GO TO 91
-
- JASMTG = MCCPAR(JCCPP+1)
- JSTRTG = MCCPAR(JCCPP+2)
- JASM = MCCPAR(JCCPD+1)
- JSTR = MCCPAR(JCCPD+2)
-
- LASMT = LQ(LHASM-JASM)
- IF (JSTR.EQ.0) THEN
- JA = 1
- JE = 4
- ELSE
- JA = JSTR
- JE = JSTR
- ENDIF
-
- DO 23 JL=JA,JE
- JS = JSTRTG
- IF (JS.EQ.0) JS= JL
- LASML = LQ(LASMT-JL-1)
- 23 IQ(LASML+11) = 8*JASMTG + JS
- RETURN
-
-C-- parameter S= illegal except for T=REASS
-
- 24 IF (NCCPP.NE.0) GO TO 91
-
-C---- handle T=BYPASS
-
- IF (IAND(MASKOP,KXBY).EQ.0) GO TO 27
- IF (IAND(MASKOP,NOT(KXBY)).NE.0) GO TO 92
-
- DO 26 J=1,NCCPD
- JASM = MCCPAR(JCCPD+1)
- JSTR = MCCPAR(JCCPD+2)
- LASML = LQ(LHASM-JASM)
- IF (JSTR.NE.0) LASML= LQ(LASML-JSTR-1)
- IQ(LASML+1) = 0
- IQ(LASML+2) = 0
- 26 JCCPD = JCCPD + 3
- RETURN
-
-C---- handle T=USED
-
- 27 IF (IAND(MASKOP,KXUS).EQ.0) GO TO 30
- IF (IAND(MASKOP,NOT(KXUS)).NE.0) GO TO 92
- RETURN
-
-
-C------ Do all but T=ALIAS, T=REASS, T=BY, T=USED
-
-C-- ready the free-field parameter in the comment field
- 30 CALL CCCOMG (1)
-
- 31 JASMF = MCCPAR(JCCPD+1)
- JSTRF = MCCPAR(JCCPD+2)
- LASMT = LQ(LHASM-JASMF)
- LASML = LASMT
- IF (JSTRF.NE.0) LASML= LQ(LASML-JSTRF-1)
-
-C---- handle T=ATTACH
-
- IF (IAND(MASKOP,KXAT).EQ.0) GO TO 34
- IF (IAND(MASKOP,NOT(KXAT)).NE.0) GO TO 92
-
- IF (NCHCCC.EQ.0) GO TO 93
-
- CHLIEX = ' '
- IXEXT = IQ(LASML+5)
- IF (IXEXT.LT.0) IXEXT= IQ(LASMT+5)
- IF (IXEXT.GT.0) CALL NA_GET (IXEXT,CHLIEX,1)
- CALL CCCRAK (6)
-
-C-- unlink the output file if it exists already
-
- IQ(LASML+1) = 0
- IQ(LASML+2) = 1
- IQ(LASML+3) = IXCCC
- CALL FLINK (LUN_TYP+1, -1, IXCCC, 0)
-
- IF (NCCPD.GE.2) GO TO 42
- RETURN
-
-C---- handle T=SPLIT and T=MODIFY
-
- 34 IF (IAND(MASKOP,KXSP).EQ.0) GO TO 36
- IF (IAND(MASKOP,NOT(KXSP+KXPR+KXLO)).NE.0) GO TO 92
- JMODE = 2
- GO TO 37
-
- 36 IF (IAND(MASKOP,KXMO).EQ.0) GO TO 41
- IF (IAND(MASKOP,NOT(KXMO+KXPR+KXLO)).NE.0) GO TO 92
- JMODE = 3
-
- 37 IQ(LASML+1) = 0
- IQ(LASML+2) = JMODE
-
- IF (NCCPD.GE.2) GO TO 42
- GO TO 49
-
-C---- handle T=BIND
-
- 41 IF (IAND(MASKOP,KXPR+KXLO).NE.0) GO TO 51
- IF (IAND(MASKOP,KXBI).EQ.0) GO TO 61
- IF (IAND(MASKOP,NOT(KXBI)).NE.0) GO TO 92
-
- 42 MBIND = 8*JASMF + JSTRF
-
- JC = JCCPD + 3
- NC = NCCPD - 1
- IF (NC.LE.0) RETURN
-
- DO 47 J=1,NC
- JASM = MCCPAR(JC+1)
- JSTR = MCCPAR(JC+2)
- LASM = LQ(LHASM-JASM)
- IF (JSTR.NE.0) LASM= LQ(LASM-JSTR-1)
- IF (IQ(LASM+1).EQ.0) GO TO 97
- IQ(LASM+1) = MBIND
- 47 JC = JC + 3
- 49 IF (IAND(MASKOP,KXPR+KXLO).NE.0) GO TO 52
- RETURN
-
-C---- handle T=PREFIX, LOG
-
- 51 IF (IAND(MASKOP,NOT(KXPR+KXLO)).NE.0) GO TO 92
- 52 MODE = IAND (ISHFTR(MASKOP,10), 3)
- IF (IQ(LASML+2).LT.2) GO TO 94
- IF (NCHCCC.EQ.0) GO TO 53
- CHLIEX = ' '
- CALL CCCRAK (6)
- GO TO 54
-
-C-- no file name on c/line, use command line parameter
-
- 53 IF (JSTRF.GE.3) GO TO 95
- IF (JASMF.GT.JDA_TYP) GO TO 95
-
-C- nypatchy pam fort read print cc as data f:2 c:2 a:2 d:2
-C- JP= 1 2 3 4 5 6 7 8 9 10 11
-C- JASMF= 1 2 3 4 1 2 3 4
-
- IF (JSTRF.LT.2) THEN
- JP = 2
- IF (JASMF.GE.2) JP= JASMF + 3
- ELSE
- JP = JASMF + 7
- ENDIF
- IXCCC = IXLUN(JP)
- IF (IXCCC.EQ.0) GO TO 95
- CALL NA_GET (IXCCC,CCCOMF,1)
- NCHCCC = NDSLAT
-
-C-- change the extension to be .log
-
- JD = ICFILA ('/', CCCOMF,1,NCHCCC)
- JD = NGSLAT + 1
- JD = ICFILA ('.', CCCOMF,JD,NCHCCC)
- CCCOMF(JD:JD+3) = '.log'
- NCHCCC = JD + 3
- IXCCC = NA_LONG (CCCOMF(1:NCHCCC))
-
-C-- for T=PREFIX (not LOG)
-
- 54 IF (MODE.GE.2) GO TO 57
- IQ(LASML+4) = IXCCC
- RETURN
-
-C-- for T=LOG
-
- 57 IQ(LASML+3) = IXCCC
- CALL FLINK (LUN_TYP+1, -1, IXCCC, 0)
- IF (MODE.EQ.2) RETURN
-
-C- for T=PREFIX, LOG
-
- NPRE = ICFILA ('/',CCCOMF,1,NCHCCC)
- IF (NPRE.GE.NCHCCC) GO TO 96
-
- IQ(LASML+4) = NA_LONG (CCCOMF(1:NPRE))
- RETURN
-
-C---- handle T=EXTENSION
-
- 61 IF (IAND(MASKOP,KXEX).EQ.0) GO TO 63
- IF (IAND(MASKOP,NOT(KXEX)).NE.0) GO TO 92
-
- CALL CCCOIX (IQ(LASML+5))
- GO TO 69
-
-C---- handle T=CCHSUB
-
- 63 IF (IAND(MASKOP,KXSU).EQ.0) GO TO 64
- IF (IAND(MASKOP,NOT(KXSU)).NE.0) GO TO 92
-
- CALL CCCOIX (IQ(LASML+7))
- GO TO 69
-
-C---- handle T=RHEAD
-
- 64 IF (IAND(MASKOP,KXRH).EQ.0) GO TO 92
-
- CALL CCCOIX (IQ(LASML+6))
-
- 69 JCCPD = JCCPD + 3
- NCCPD = NCCPD - 1
- IF (NCCPD.NE.0) GO TO 31
- RETURN
-
-C------ Trouble
-
- 91 MSG = 'Syntax error'
- GO TO 98
- 92 MSG = 'Illegal set of T= parameters'
- GO TO 98
- 93 MSG = 'Missing file name'
- GO TO 98
- 94 MSG = 'Only for streams in SPLIT or MODIFY mode'
- GO TO 98
- 95 MSG = 'The trailing free-field parameter is missing'
- GO TO 98
- 96 MSG = 'Illegal file name for T=PREFIX,LOG'
- GO TO 98
- 97 MSG = 'Trying to bind a stream which is already physical'
-
- 98 N = LNBLNK (MSG)
- CALL FAILCC (1, MSG(1:N))
- RETURN
- END
diff --git a/src/p5boot/p5lib/x_imit.f b/src/p5boot/p5lib/x_imit.f
deleted file mode 100644
index 1b08c5b..0000000
--- a/src/p5boot/p5lib/x_imit.f
+++ /dev/null
@@ -1,48 +0,0 @@
-CDECK ID>, X_IMIT.
- SUBROUTINE X_IMIT
-
-C- Process +IMITATE, P=...
-
- PARAMETER (KM1=1,KM2=2,KM3=4,KM4=8,KM5=16,KM6=32,KM7=64,KM8=128,
- + KM9=256, KM10=512, KM11=1024, KM12=2048, KM13=4096, KM14=8192,
- + KM15=16384, KM16=32768, KM17=65536, KM18=131072, KM19=262144)
- CHARACTER CCKORG*256, CCKARD*256, CCCOMF*256
- COMMON /CCPARA/NCHCCD,NCHCCT, JCCTYP,JCCLEV,JCCSL,MCCPAR(240)
- +, NCCPAR,MXCCIF,JCCIFV,JCCBAD,JCCWAR,ICCSUB,JCCWK(4)
- +, JCCPP,JCCPD,JCCPZ,JCCPT,JCCPIF,JCCPC,JCCPN
- +, NCCPP,NCCPD,NCCPZ,NCCPT,NCCPIF,NCCPC,NCCPN
- +, JCCEND, NCHCCC,IXCCC, CCKORG, CCKARD, CCCOMF
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
-C-------------- End CDE --------------------------------
-
- IAND (IZV,IZW) = AND (IZV, IZW)
- IOR (IZV,IZW) = OR (IZV, IZW)
-
-
- 24 IF (NCCPP.EQ.0) RETURN
-
- CALL CREAPD (MCCPAR(JCCPP+1),-1, 0)
-
- IF (IAND(IQ(LCRP),KM10).NE.0) THEN
- IQ(LCRP) = IOR (IQ(LCRP),KM5)
- IQ(LCRP+1) = IOR (IQ(LCRP+1),KM2)
- LQ(LCRP-4) = LEXP
- ENDIF
-
- NCCPP = NCCPP - 1
- JCCPP = JCCPP + 3
- GO TO 24
- END
diff --git a/src/p5boot/p5lib/x_incl.f b/src/p5boot/p5lib/x_incl.f
deleted file mode 100644
index 1088010..0000000
--- a/src/p5boot/p5lib/x_incl.f
+++ /dev/null
@@ -1,76 +0,0 @@
-CDECK ID>, X_INCL.
- SUBROUTINE X_INCL (LDOSEQ)
-
-C- Process +INCLUDE, sname1, ...
-C- if LDOSEQ is zero this is called from DOXQT;
-C- otherwise the call is from X_SEQ giving the bank
-C- with the c/c +INCL
-
- COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT,NUSLAT(2),DUMMY(34)
- CHARACTER SLLINE*512, SLERRM*256
- COMMON /SLATLN/ SLLINE, SLERRM
- CHARACTER CCKORG*256, CCKARD*256, CCCOMF*256
- COMMON /CCPARA/NCHCCD,NCHCCT, JCCTYP,JCCLEV,JCCSL,MCCPAR(240)
- +, NCCPAR,MXCCIF,JCCIFV,JCCBAD,JCCWAR,ICCSUB,JCCWK(4)
- +, JCCPP,JCCPD,JCCPZ,JCCPT,JCCPIF,JCCPC,JCCPN
- +, NCCPP,NCCPD,NCCPZ,NCCPT,NCCPIF,NCCPC,NCCPN
- +, JCCEND, NCHCCC,IXCCC, CCKORG, CCKARD, CCCOMF
- COMMON /MUSEBC/ MX_FORC, MU_GLOB, MU_PAT, MU_DECK, MU_INH, MU_FORG
- +, MX_TRAN, MX_FORG, MX_SINH, MX_SELF, NVEXDK(6)
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
- COMMON /M_ANAC/LOWAN,KDOAN,LDOAN,LUPAN,MODEAN,MEXAN,LEVAN,KKM5AN
- +, NEWDEC,NEWCTL,NEWFOR,NEWNIL,NEWINC
-C-------------- End CDE --------------------------------
- CHARACTER LINE*80
- EQUIVALENCE (LINE,TEXT)
-
-
- IF (LDOSEQ.NE.0) THEN
- LDO = LDOSEQ
- CALL CCKRAK (IQ(LDO+1))
- ELSE
- LDO = LDOAN
- ENDIF
-
- JCCTYP = 0
-
- 22 IXNAME = MCCPAR(JCCPZ+1)
- LINE(1:10) = '#include "'
-C- _:.=+=.: 1_:
- CALL NA_GET (IXNAME,LINE,11)
- NTX = NESLAT
- CALL CUTOL (LINE(11:NTX))
- LINE(NTX:NTX+2) = '.h"'
- NTX = NTX + 2
- TEXT(NTX+1) = CHAR(NEWLN)
- MLIAD(2) = NTX + 1 + NCHNEWL
-
- LQ(LSERV-2) = LQ(LDO-2)
- IQ(LSERV+1) = 1
- IQ(LSERV+2) = 1
- IQ(LSERV+3) = -99
-
- IF (NVEXDK(2).NE.0) THEN
- CALL DPLINE (-1, ' ', NTX,LINE)
- ENDIF
-
- IF (NVEXDK(1).NE.0) CALL DPEXE (LSERV)
-
- JCCPZ = JCCPZ + 3
- NCCPZ = NCCPZ - 1
- IF (NCCPZ.GT.0) GO TO 22
- RETURN
- END
diff --git a/src/p5boot/p5lib/x_next.f b/src/p5boot/p5lib/x_next.f
deleted file mode 100644
index 1c8ccb2..0000000
--- a/src/p5boot/p5lib/x_next.f
+++ /dev/null
@@ -1,59 +0,0 @@
-CDECK ID>, X_NEXT.
- SUBROUTINE X_NEXT
-
-C- Step to next bank in the PREP chain for DOXQT
-C. started 18-nov-93
-
- PARAMETER (KM1=1,KM2=2,KM3=4,KM4=8,KM5=16,KM6=32,KM7=64,KM8=128,
- + KM9=256, KM10=512, KM11=1024, KM12=2048, KM13=4096, KM14=8192,
- + KM15=16384, KM16=32768, KM17=65536, KM18=131072, KM19=262144)
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- COMMON /M_ANAC/LOWAN,KDOAN,LDOAN,LUPAN,MODEAN,MEXAN,LEVAN,KKM5AN
- +, NEWDEC,NEWCTL,NEWFOR,NEWNIL,NEWINC
-C-------------- End CDE --------------------------------
-
- IAND (IZV,IZW) = AND (IZV, IZW)
-
-
- IF (LUPAN.NE.0) GO TO 34
- 22 LDOAN = LQ(LDOAN-1)
- IF (LDOAN.EQ.0) RETURN
-
-C-- next PREP bank
-
- L = LQ(LDOAN-2)
- IF (L.NE.0) GO TO 31
- IF (IAND(IQ(LDOAN),KM6).NE.0) GO TO 22
- RETURN
-
-C---- Follow reference to foreign material
-
- 31 LOWAN = LDOAN
- LUPAN = L
-
-C-- list what action
-
- CALL DPLACT
- IF (IAND(IQ(LDOAN),KM6).NE.0) GO TO 37
-
-C-- Next MAT bank
-
- LDOAN = LUPAN - 1
- 34 LDOAN = LQ(LDOAN-1)
- IF (LDOAN.EQ.0) GO TO 37
- IF (IAND(IQ(LDOAN),KM6).NE.0) GO TO 34
- RETURN
-
-C-- restart on the PREP chain
-
- 37 LDOAN = LOWAN
- LUPAN = 0
- GO TO 22
- END
diff --git a/src/p5boot/p5lib/x_opt.f b/src/p5boot/p5lib/x_opt.f
deleted file mode 100644
index 684b03e..0000000
--- a/src/p5boot/p5lib/x_opt.f
+++ /dev/null
@@ -1,187 +0,0 @@
-CDECK ID>, X_OPT.
- SUBROUTINE X_OPT
-
-C- Process +OPTION, +PARAM, +SHOW
-
- CHARACTER SLLINE*512, SLERRM*256
- COMMON /SLATLN/ SLLINE, SLERRM
- PARAMETER (KM1=1,KM2=2,KM3=4,KM4=8,KM5=16,KM6=32,KM7=64,KM8=128,
- + KM9=256, KM10=512, KM11=1024, KM12=2048, KM13=4096, KM14=8192,
- + KM15=16384, KM16=32768, KM17=65536, KM18=131072, KM19=262144)
- PARAMETER (KMA=1,KMB=2,KMC=4,KMD=8,KME=16,KMF=32,KMG=64,KMH=128,
- + KMI=256, KMJ=512, KMK=KM11, KML=KM12, KMM=KM13, KMN=KM14,
- + KMO=KM15, KMP=KM16, KMQ=KM17, KMR=KM18, KMS=KM19)
- CHARACTER CQBLAN*128, CQEQS*128, CQCETA*32
- CHARACTER CQAPO*1, CQBSL*1, CQTAB*1
- COMMON /QCHAR/ CQBLAN, CQEQS, CQCETA, CQAPO, CQBSL, CQTAB
- COMMON /QPAGE/ NQLMAX,NQLTOL,NQLTOK,NQCMAX,NQCPGH,NQPAGE
- +, NQWYLDO,NQWYL,NQNEWH,NQJOIN,NQDKNO,NQDKPG
- COMMON /QUNIT/ IQREAD,IQPRNT, IQTTIN,IQTYPE, IQOFFL,IQRTTY,IQRSAV
- +, IQRFD,IQRRD,IQRSIZ, NQLPAT,NQUSED,NQLLBL, NQINIT
- PARAMETER (MCCNIL=1, MCCKIL=2, MCCINC=3, MCCCDE=4, MCCSEQ=5,
- + MCCXSQ=6, MCCTRU=7, MCCFAL=8, MCCELS=9, MCCEND=10,
- + MCCSEL=11, MCCSES=12, MCCFAU=13, MCCSKI=14,
- + MCCKEE=15, MCCDEL=16, MCCREP=17, MCCADB=18, MCCADD=19,
- + MCCUSE=20, MCCXDI=21, MCCDIV=22, MCCLIS=23, MCCEXE=24, MCCIMI=25,
- + MCCASM=26, MCCUPD=27, MCCNAM=28, MCCGAP=29, MCCMOR=30, MCCONL=31,
- + MCCFOR=32, MCCSUS=33, MCCOPT=34, MCCOP2=35, MCCSHO=36, MCCPAM=37,
- + MCCQUI=38, MCCEOD=39, MCCDEC=40, MCCPAT=41, MCCTIT=42)
- CHARACTER CCKORG*256, CCKARD*256, CCCOMF*256
- COMMON /CCPARA/NCHCCD,NCHCCT, JCCTYP,JCCLEV,JCCSL,MCCPAR(240)
- +, NCCPAR,MXCCIF,JCCIFV,JCCBAD,JCCWAR,ICCSUB,JCCWK(4)
- +, JCCPP,JCCPD,JCCPZ,JCCPT,JCCPIF,JCCPC,JCCPN
- +, NCCPP,NCCPD,NCCPZ,NCCPT,NCCPIF,NCCPC,NCCPN
- +, JCCEND, NCHCCC,IXCCC, CCKORG, CCKARD, CCCOMF
- COMMON /LUNSLN/IFLAUX, IXLUN(12)
- COMMON /MUSEBC/ MX_FORC, MU_GLOB, MU_PAT, MU_DECK, MU_INH, MU_FORG
- +, MX_TRAN, MX_FORG, MX_SINH, MX_SELF, NVEXDK(6)
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
-C-------------- End CDE --------------------------------
- CHARACTER LINE*30, COLS(30)*1
- EQUIVALENCE (LINE,SLLINE)
- EQUIVALENCE (COLS,LINE)
-
- PARAMETER (NPOSS = 10, NPARA = 3, NSHOW=2)
- CHARACTER POSS(NPOSS)*8, PARA(NPARA)*8, SHOW(NSHOW)*8
-
- PARAMETER (NPOSSX = 3)
- CHARACTER POSSX(NPOSSX)*8
-
- DATA POSSX / 'OFF '
- +, 'COM*PACT'
- +, 'EJE*CT ' /
-
- DATA POSS / 'OFF '
- +, 'ALL '
- +, 'BAC*KCOM'
- +, 'COM*PACT'
- +, 'EJE*CT '
- +, 'FUL*L '
- +, 'MAP*ASM '
- +, 'URE*F '
- +, 'VER*BOSE'
- +, 'XCR*OSS ' /
-
- DATA PARA / 'LIN*ES '
- +, 'COL*UMNS'
- +, 'CLA*SH ' /
-
- DATA SHOW / 'ASM '
- +, 'MEM*ORY ' /
-
- IAND (IZV,IZW) = AND (IZV, IZW)
- IOR (IZV,IZW) = OR (IZV, IZW)
-
-C---- Do +OPTION
-
- IF (JCCTYP.NE.MCCOPT) GO TO 41
- IF (NCCPT.EQ.0) GO TO 31
- IF (IFLAUX.EQ.0) THEN
- CALL CCOPT (POSS,NPOSS)
- IF (JCCBAD.NE.0) GO TO 91
- ELSE
- CALL CCOPT (POSSX,NPOSSX)
- IF (JCCBAD.NE.0) RETURN
- ENDIF
- MASKOP = MCCPAR(JCCPT+1)
-
- IF (IAND(MASKOP,KMO).EQ.0) THEN
- MOPTIO(33) = IOR (MOPTIO(33),MASKOP)
- ELSE
- MOPTIO(33) = IAND (MOPTIO(33),NOT(MASKOP))
- ENDIF
-
- CALL UPKBYT (MOPTIO(33),1,MOPTIO(1),32,0)
-
-C-- print current state of options
-
- 31 DO 34 J=1,LEN(LINE)
- IF (MOPTIO(J).EQ.0) THEN
- COLS(J) = '.'
- ELSE
- COLS(J) = CQCETA(J:J)
- ENDIF
- 34 CONTINUE
-
- NQLLBL = 0
- NQUSED = NQUSED + 1
- WRITE (IQPRNT,9034) LINE
- 9034 FORMAT (10X,'Status of options: ',A)
- RETURN
-
-C---- Do +PARAM
-
- 41 IF (JCCTYP.NE.MCCOP2) GO TO 61
- IF (NCCPT.EQ.0) RETURN
- CALL CCOPT (PARA,NPARA)
- IF (JCCBAD.NE.0) GO TO 91
- MASKOP = MCCPAR(JCCPT+2)
- NVAL = MCCPAR(JCCPN+1)
-
-C-- +PARAM, LINES, N=n - n lines per page
-
- IF (IAND(MASKOP,KM1).EQ.0) GO TO 42
- NQLMAX = MAX (NVAL,24)
- CALL MQPAGE
- RETURN
-
-C-- +PARAM, COL, N=n - n columns per page
-
- 42 IF (IAND(MASKOP,KM2).EQ.0) GO TO 44
- NVAL = MIN (NVAL,140)
- IF (IFLAUX.NE.0) GO TO 43
- NQCMAX = MAX (NVAL,90)
- NQCPGH = NQCMAX
- IF (IAND(MU_GLOB,KM2).NE.0) RETURN
- IF (NQCMAX.LT.102) RETURN
- NQCPGH = 100 + (NQCMAX-100)/2
- RETURN
-
- 43 NQCMAX = MAX (NVAL,100)
- NQCPGH = NQCMAX
- IF (NQCMAX.LT.102) RETURN
- NQCPGH = 100 + (NQCMAX-100)/2
- RETURN
-
-C-- +PARAM, CLASH, N=n - print clash at or above n
-
- 44 NCLASH = MAX (1,NVAL)
- RETURN
-
-C---- Do +SHOW
-
- 61 IF (NCCPT.EQ.0) RETURN
- CALL CCOPT (SHOW,NSHOW)
- IF (JCCBAD.NE.0) GO TO 91
- MASKOP = MCCPAR(JCCPT+2)
-
-C-- +SHOW, ASM - display the ASM data structure
-
- IF (IAND(MASKOP,KM1).NE.0) THEN
- CALL ASMDUMP ('as requested')
- RETURN
- ENDIF
-
-C-- +SHOW, MEMORY - show memory occupation
-
- CALL MQSHOW
- RETURN
-
-C---- Trouble
-
- 91 CALL FAILCC (0, 'Unknown option')
- RETURN
- END
diff --git a/src/p5boot/p5lib/x_seq.f b/src/p5boot/p5lib/x_seq.f
deleted file mode 100644
index e7f515c..0000000
--- a/src/p5boot/p5lib/x_seq.f
+++ /dev/null
@@ -1,177 +0,0 @@
-CDECK ID>, X_SEQ.
- SUBROUTINE X_SEQ (LXQT)
-
-C- Send the sequences called from bank LXQT to output.
-C. started 21-jan-92
-
- PARAMETER (KM1=1,KM2=2,KM3=4,KM4=8,KM5=16,KM6=32,KM7=64,KM8=128,
- + KM9=256, KM10=512, KM11=1024, KM12=2048, KM13=4096, KM14=8192,
- + KM15=16384, KM16=32768, KM17=65536, KM18=131072, KM19=262144)
- PARAMETER (MCCNIL=1, MCCKIL=2, MCCINC=3, MCCCDE=4, MCCSEQ=5,
- + MCCXSQ=6, MCCTRU=7, MCCFAL=8, MCCELS=9, MCCEND=10,
- + MCCSEL=11, MCCSES=12, MCCFAU=13, MCCSKI=14,
- + MCCKEE=15, MCCDEL=16, MCCREP=17, MCCADB=18, MCCADD=19,
- + MCCUSE=20, MCCXDI=21, MCCDIV=22, MCCLIS=23, MCCEXE=24, MCCIMI=25,
- + MCCASM=26, MCCUPD=27, MCCNAM=28, MCCGAP=29, MCCMOR=30, MCCONL=31,
- + MCCFOR=32, MCCSUS=33, MCCOPT=34, MCCOP2=35, MCCSHO=36, MCCPAM=37,
- + MCCQUI=38, MCCEOD=39, MCCDEC=40, MCCPAT=41, MCCTIT=42)
- CHARACTER CCKORG*256, CCKARD*256, CCCOMF*256
- COMMON /CCPARA/NCHCCD,NCHCCT, JCCTYP,JCCLEV,JCCSL,MCCPAR(240)
- +, NCCPAR,MXCCIF,JCCIFV,JCCBAD,JCCWAR,ICCSUB,JCCWK(4)
- +, JCCPP,JCCPD,JCCPZ,JCCPT,JCCPIF,JCCPC,JCCPN
- +, NCCPP,NCCPD,NCCPZ,NCCPT,NCCPIF,NCCPC,NCCPN
- +, JCCEND, NCHCCC,IXCCC, CCKORG, CCKARD, CCCOMF
- COMMON /MUSEBC/ MX_FORC, MU_GLOB, MU_PAT, MU_DECK, MU_INH, MU_FORG
- +, MX_TRAN, MX_FORG, MX_SINH, MX_SELF, NVEXDK(6)
- CHARACTER CHTAG*80, CHWYL*16
- COMMON /TAGC/ LLORG,LNORG,LLACT,LNACT, LALTN,LMODE,NCHTAG
- +, CHTAG,CHWYL
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
-C-------------- End CDE --------------------------------
- PARAMETER (NOFFLI=2, NOFFDA=4)
- PARAMETER (MAXLEV=36)
- COMMON /MSAVEC/ MSAVE(5,MAXLEV)
-
- IAND (IZV,IZW) = AND (IZV, IZW)
-
-
- IFLNHI = 0
- IFLNOL = 1 - NVEXDK(2)
-
- LEVK = 0
- LCSQ = LXQT
-
- LNACT = 0
- LLACT = 0
-
-C---- New XSQ bank
-
- 21 JSEQ = 0
- NSEQ = IQ(LCSQ+NOFFDA)
- IFLPAS = IAND (IQ(LCSQ),KM16)
- 22 JSEQ = JSEQ + 1
- IF (JSEQ.GT.NSEQ) GO TO 37
- IXSEQ = IQ(LCSQ+JSEQ+NOFFDA)
- LKEEP = IABS (LQ(LCSQ-JSEQ-NOFFLI))
- IF (LKEEP.NE.0) GO TO 24
-
-C-- missing sequence
- IF (IFLPAS.NE.0) GO TO 22
- CALL DPLMSQ (IXSEQ)
- GO TO 22
-
-
-C-- Output of the KEEP bank itself
-
- 24 IF (NVEXDK(2).NE.0) IFLNOL= MAX (IFLNHI, IAND (IQ(LKEEP),KM16))
-
-C-- ready special sequence
-
- IF (IAND(IQ(LKEEP),KM13).NE.0) THEN
- CALL X_SEQSP (IQ(LCSQ+1), IXSEQ, IFSEND)
- IF (IFSEND.EQ.0) GO TO 22
- GO TO 25
- ENDIF
-
-C-- be sure the sequence is ready for output
-
- IF (IAND(IQ(LKEEP),KM5).EQ.0) MX= LINKSQ (0,LKEEP)
-
- 25 JCCTYP = 0
- IF (IFLNOL.EQ.0) THEN
- LLORG = 0
- LNORG = LQ(LKEEP-3)
- CALL DPTAG (2,LEVK,IXSEQ)
-
- IF (IQ(LKEEP+2).NE.0) GO TO 27
- LNX = LQ(LKEEP-2)
- IF (LNX.EQ.0) THEN
- NCHTAG = 0
- GO TO 22
- ENDIF
-
- IF (LQ(LNX-2).EQ.LLORG) THEN
- IFLST = LEVK+1
- GO TO 28
- ENDIF
-
- 27 IFLST = 0
- CALL DPLIST (1,LKEEP,0,LEVK+1)
- ENDIF
-
- IF (NVEXDK(1).NE.0) CALL DPEXE (LKEEP)
-
-C-- Output of continuation MAT banks
-
- 28 LDO = LKEEP - 1
- 29 LDO = LQ(LDO-1)
- IF (LDO.EQ.0) GO TO 22
-
- IF (IFLNOL.EQ.0) THEN
- LNORG = LQ(LDO-2)
- LVINC = JBYT(IQ(LDO),21,5)
- IF (LVINC.EQ.0) THEN
- IF (IFLST.EQ.0) CALL DPTAG (2,LEVK,0)
- ELSE
- IF (LNORG.NE.LLORG) THEN
- CALL DPTAG (0,LEVK+LVINC,0)
- ENDIF
- ENDIF
- CALL DPLIST (1,LDO,0,IFLST)
- IFLST = 0
- ENDIF
-
- JCCTYP = JBYT (IQ(LDO),9,6)
- IF (JCCTYP.GE.MCCCDE) GO TO 31
- IF (NVEXDK(1).EQ.0) GO TO 29
- IF (JCCTYP.EQ.MCCINC) GO TO 30
- IF (JCCTYP.NE.0) GO TO 29
- CALL DPEXE (LDO)
- GO TO 29
-
- 30 CALL X_INCL (LDO)
- GO TO 29
-
-C---- new sequence call bank, step level up by one
-
- 31 LEVK = LEVK + 1
- MSAVE(1,LEVK) = LCSQ
- MSAVE(2,LEVK) = LDO
- MSAVE(3,LEVK) = JSEQ
- MSAVE(4,LEVK) = IFLNHI
- MSAVE(5,LEVK) = IFLNOL
- IFLNHI = IFLNOL
- LCSQ = LDO
- GO TO 21
-
-C---- end of doing this sequence call bank, step level down
-
- 37 IF (LEVK.EQ.0) GO TO 39
-
- LCSQ = MSAVE(1,LEVK)
- LDO = MSAVE(2,LEVK)
- JSEQ = MSAVE(3,LEVK)
- IFLNHI = MSAVE(4,LEVK)
- IFLNOL = MSAVE(5,LEVK)
- LEVK = LEVK - 1
-
- NSEQ = IQ(LCSQ+NOFFDA)
- IFLPAS = IAND (IQ(LCSQ),KM16)
- GO TO 29
-
- 39 NCHTAG = 0
- RETURN
- END
diff --git a/src/p5boot/p5lib/x_seqsp.f b/src/p5boot/p5lib/x_seqsp.f
deleted file mode 100644
index 1bd0bc6..0000000
--- a/src/p5boot/p5lib/x_seqsp.f
+++ /dev/null
@@ -1,222 +0,0 @@
-CDECK ID>, X_SEQSP.
- SUBROUTINE X_SEQSP (JSL,IXSEQ,IFSEND)
-
-C- Ready special sequence called
-C- input: JSL slot number of the calling control-line
-C- IXSEQ sequence name index
-C- output: IFSEND = 0 no output to be sent
-C- > 0 output
-C. split off from X_SEQ 23-aug-95
-
- COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT,NUSLAT(2),DUMMY(34)
- CHARACTER SLLINE*512, SLERRM*256
- COMMON /SLATLN/ SLLINE, SLERRM
- CHARACTER CQBLAN*128, CQEQS*128, CQCETA*32
- CHARACTER CQAPO*1, CQBSL*1, CQTAB*1
- COMMON /QCHAR/ CQBLAN, CQEQS, CQCETA, CQAPO, CQBSL, CQTAB
- COMMON /QPAGE/ NQLMAX,NQLTOL,NQLTOK,NQCMAX,NQCPGH,NQPAGE
- +, NQWYLDO,NQWYL,NQNEWH,NQJOIN,NQDKNO,NQDKPG
- COMMON /QUNIT/ IQREAD,IQPRNT, IQTTIN,IQTYPE, IQOFFL,IQRTTY,IQRSAV
- +, IQRFD,IQRRD,IQRSIZ, NQLPAT,NQUSED,NQLLBL, NQINIT
- CHARACTER CQDATEM*10, CQDATE*8, CQTIME*5
- COMMON /QSTATE/NQERR,NQWARN,NQINFO,NQLOCK
- +, IQDATE,IQTIME, CQDATEM,CQDATE,CQTIME
- CHARACTER CCKORG*256, CCKARD*256, CCCOMF*256
- COMMON /CCPARA/NCHCCD,NCHCCT, JCCTYP,JCCLEV,JCCSL,MCCPAR(240)
- +, NCCPAR,MXCCIF,JCCIFV,JCCBAD,JCCWAR,ICCSUB,JCCWK(4)
- +, JCCPP,JCCPD,JCCPZ,JCCPT,JCCPIF,JCCPC,JCCPN
- +, NCCPP,NCCPD,NCCPZ,NCCPT,NCCPIF,NCCPC,NCCPN
- +, JCCEND, NCHCCC,IXCCC, CCKORG, CCKARD, CCCOMF
- CHARACTER CHEXPD*68
- COMMON /CHEXC/ IXEXPAM, IXEXPAT,IXEXDEC,IXEXID, NCHEPD, CHEXPD
- COMMON /DEPCOM/JD_NEW, JD_DTN, JD_DTP, JD_DTD, JD_DIV
- +, JD_SML, JD_SMP, JD_SMX, JDP_DT, JDP_DV
- +, JD_SPL, JD_MOD, JD_LUN, JD_LOG, JD_NLI, JD_MULT
- +, IX_EXT, IX_RH, IX_SUB
- PARAMETER (JSPSEQ1=3, JSPDATE=9, JSPSEQL=15)
- COMMON /MUSEBC/ MX_FORC, MU_GLOB, MU_PAT, MU_DECK, MU_INH, MU_FORG
- +, MX_TRAN, MX_FORG, MX_SINH, MX_SELF, NVEXDK(6)
- PARAMETER (NFIMAX=100)
- COMMON /TITLEC/ NFILET, JTIPAM(NFIMAX)
- CHARACTER CHTTNA*10, CHTTDT*20
- COMMON /USETTC/ JTTNAM,JTTVER,JTTSLA,JTTDAT,JTTCOM
- +, NTTNA(5), NTTDT, NTTNORM, NTTALL
- +, CHTTNA(5), CHTTDT
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
-C-------------- End CDE --------------------------------
-
- CHARACTER LINE*128, LIMSK*128, LITIT*128, CHESC*1
- EQUIVALENCE (LINE,TEXT), (LIMSK,CCCOMF), (LITIT,SLERRM)
-
-
- JTX = MLIAD(JSL)
- JCCTYP = JPTYPE (TEXT(JTX))
- CALL CCKRAK (JSL)
- NNN = MCCPAR(JCCPN+1)
- LLL = MCCPAR(JCCPC+1)
- JCASE = IXSEQ - JSPSEQ1 - 1
- IF (JCASE.GE.1) GO TO 51
- IF (JCASE.EQ.0) GO TO 44
-
-C-- handle +SEQ, QCARD1, R=name
-
- IF (JCCPD.EQ.0) GO TO 49
- IX = MCCPAR(JCCPD+1)
- IF (IX.LE.2) GO TO 49
- IF (NVEXDK(1).NE.0) THEN
- IF (JD_NEW.EQ.0) CALL DPEXTM (-1)
- ENDIF
- IXEXID = IX
- GO TO 49
-
-C-- handle +SEQ, QEJECT, N=n
-
- 44 IF (NVEXDK(2).EQ.0) GO TO 49
- IF (MOPTIO(5).EQ.0) GO TO 49
- IF (MOPTIO(3).NE.0) GO TO 49
- IF (NNN.LT.0) NNN = NQLMAX
- IF (NNN.EQ.0) NNN = NQLMAX - 6
- IF (NQUSED+NNN.LE.NQLMAX) GO TO 49
- NQUSED = NQLMAX
-
- 49 IFSEND = 0
- RETURN
-
-C------ handle +SEQ, QFxxx, QDATE, QTIME
-
- 51 CHESC = '?'
-
-C---- ready LIMSK, the mask line,
-C-- for QFTITLE and QFTITLCH
-
- IF (JCASE.GE.3) GO TO 53
- IF (JCASE.EQ.1) THEN
- LIMSK = ' + 8H'
- ELSE
- LIMSK = ' + ' // CQAPO
- ENDIF
- NMSK = LNBLNK (LIMSK(1:12))
- LLL = MAX (NNN,LLL)
- IF (LLL.LE.0) LLL= 8
- NNN = 0
- GO TO 54
-
-C-- for all others
-
- 53 CALL CCCOMG (0)
- NMSK = NCHCCC
- IF (NMSK.LE.0) GO TO 49
- IF (JCASE.EQ.11) GO TO 76
-
- IF (JCCPP.NE.0) THEN
- JTX = NA_JTX (MCCPAR(JCCPP+1))
- CHESC = TEXT(JTX)
- ENDIF
-
-C-- find the escape symbol
-
- 54 LINE = LIMSK(1:NMSK)
- JESC = ICFIND (CHESC,LIMSK,1,NMSK)
- NAFT = NMSK - JESC
-
- IF (JCASE.GE.JSPDATE) GO TO 81
-
-C---- ready the PAM file title
-
- JFILE = NFILET
- IF (NNN.GT.0) JFILE= NNN
- IF (NNN.LT.0) JFILE= MAX (1,NFILET+NNN)
- JFILE = MIN (JFILE,NFILET)
- JSL = 0
- IF (JFILE.GT.0) JSL = JTIPAM(JFILE)
- CALL USETT (JSL)
-
- IF (JCASE.GE.4) GO TO 71
- GO TO (61,63,65), JCASE
-
-C-- QFTITLE gives: +nnHWYLBUR 1.21 /77 930630 22.01
-
- 61 LLL = MIN (LLL,62)
- CALL CSETDI (LLL,LINE,8,9)
- LINE(11:10+LLL) = LITIT(1:LLL)
- LINE(77:80) = 'HOLD'
- NFIN = 80
- GO TO 89
-
-C-- QFTITLCH gives: + 'WYLBUR 1.21 /77 930630 22.01'
-
- 63 LLL = MIN (LLL,62)
- LINE(10:10+LLL) = LITIT(1:LLL) // CQAPO
- NFIN = 10+LLL
- GO TO 89
-
-C-- QFHEAD gives: txb"WYLBUR 1.21 /77 930630 22.01"txa
-
- 65 IF (LLL.LE.0) LLL= NTTNORM
- LLL = MIN (LLL,NTTALL)
- LINE(JESC:JESC+LLL-1) = LITIT(1:LLL)
- NFIN = JESC+LLL-1
- GO TO 88
-
-C-- 4 QFNAME gives: txb"WYLBUR"txa
-C-- 5 QFVERS gives: txb"1.21 /77"txa
-C-- 6 QFVSNUM gives: txb"12177"txa
-C-- 7 QFVPRIM gives: txb"1.21"txa
-C-- 8 QFVSEC gives: txb"77"txa
-
- 71 JNA = JCASE - 3
-
- IF (LLL.LE.0) LLL= NTTNA(JNA)
- LLL = MIN (LLL,NTTNA(JNA))
- LINE(JESC:JESC+LLL-1) = CHTTNA(JNA)(1:LLL)
- NFIN = JESC+LLL-1
- GO TO 88
-
-C---- QENVIR gives text with substitution
-
- 76 CALL CENVIR (LIMSK,NMSK, LINE,1,256, 1)
- NFIN = NDSLAT
- GO TO 89
-
-C---- QDATE gives: txb"19930802"txa
-
- 81 IF (JCASE.NE.JSPDATE) GO TO 83
- LLL = LEN(CQDATE)
- LINE(JESC:JESC+LLL-1) = CQDATE
- NFIN = JESC+LLL-1
- GO TO 88
-
-C-- QTIME gives: txb"1107"txa
-
- 83 LINE(JESC:JESC+3) = CQTIME(1:2) // CQTIME(4:5)
- NFIN = JESC+3
-
-C-- set the "after" text
-
- 88 IF (NAFT.GT.0) THEN
- LINE(NFIN+1:NFIN+NAFT)= LIMSK(JESC+1:JESC+NAFT)
- NFIN = NFIN + NAFT
- ENDIF
-
-C-- finalize the line in slot 1
-
- 89 JTX = NFIN + 1
- TEXT(JTX) = CHAR (NEWLN)
- JTX = JTX + 1
- MLIAD(2) = JTX
- IFSEND = 7
- RETURN
- END
diff --git a/src/p5boot/p5lib/x_udeck.f b/src/p5boot/p5lib/x_udeck.f
deleted file mode 100644
index 763d00b..0000000
--- a/src/p5boot/p5lib/x_udeck.f
+++ /dev/null
@@ -1,58 +0,0 @@
-CDECK ID>, X_UDECK.
- SUBROUTINE X_UDECK (LPAT)
-
-C- Merge new USE/EXE-status of patch into all dependent decks
-C! if LPAT = zero: blank deck and D=CRA* of P=CRA* change
-C! their own status
-
- PARAMETER (KM1=1,KM2=2,KM3=4,KM4=8,KM5=16,KM6=32,KM7=64,KM8=128,
- + KM9=256, KM10=512, KM11=1024, KM12=2048, KM13=4096, KM14=8192,
- + KM15=16384, KM16=32768, KM17=65536, KM18=131072, KM19=262144)
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
- COMMON /MUSEBC/ MX_FORC, MU_GLOB, MU_PAT, MU_DECK, MU_INH, MU_FORG
- +, MX_TRAN, MX_FORG, MX_SINH, MX_SELF, NVEXDK(6)
-C-------------- End CDE --------------------------------
- PARAMETER (IXCRA=2)
-
- IAND (IZV,IZW) = AND (IZV, IZW)
-
- LP = LPAT
- IF (LP.EQ.0) GO TO 32
-
- LD = LQ(LP-2)
- IF (LD.EQ.0) RETURN
- MXP = IQ(LP)
-
- 21 CALL MXJOIN (MXP,IQ(LD))
- LD = LQ(LD-1)
- IF (LD.NE.0) GO TO 21
- IF (INCRAD.LT.2) RETURN
- IF (LP.NE.LEXP) RETURN
-
-C-- Currently processing P=CRA*, D=blank or CRA*, whose mode
-C- may have changed: update the variables in MUSEBC
-C- note: name index =0 for blank, =2 for CRA*
-
- 32 MU_PAT = IAND (IQ(LEXP), KM19-1)
- IF (LEXD.EQ.0) LEXD= KQFIND (IXCRA,1,LEXP-2,KF)
- IF (LEXD.NE.0) THEN
- MU_DECK = IAND (IQ(LEXD), KM19-1)
- ELSE
- MU_DECK = MU_PAT
- ENDIF
-
- CALL MXOPER (0)
- END
diff --git a/src/p5boot/p5lib/x_uput.f b/src/p5boot/p5lib/x_uput.f
deleted file mode 100644
index d901eb2..0000000
--- a/src/p5boot/p5lib/x_uput.f
+++ /dev/null
@@ -1,69 +0,0 @@
-CDECK ID>, X_UPUT.
- SUBROUTINE X_UPUT (MTARG)
-
-C- Update the activation bits in MTARG for X_USE
-
- PARAMETER (KM1=1,KM2=2,KM3=4,KM4=8,KM5=16,KM6=32,KM7=64,KM8=128,
- + KM9=256, KM10=512, KM11=1024, KM12=2048, KM13=4096, KM14=8192,
- + KM15=16384, KM16=32768, KM17=65536, KM18=131072, KM19=262144)
- COMMON // IQUEST(100)
-C-------------- End CDE --------------------------------
- DIMENSION MTARG(9)
- DIMENSION MV(4)
- EQUIVALENCE (MV(1),IQUEST(1))
- EQUIVALENCE (MXNEW,IQUEST(11)), (MODE,IQUEST(12))
- +, (MXTRAN,IQUEST(13))
-
- IAND (IZV,IZW) = AND (IZV, IZW)
- IOR (IZV,IZW) = OR (IZV, IZW)
- ISHFTL (IZW,NZB) = LSHIFT (IZW, NZB)
- ISHFTR (IZW,NZB) = ISHFT (IZW, -NZB)
-
-C-- unpack MV( 1 self+forg 2 inhibit 3 trans 4 self only
-
- MXD = MTARG(1)
- MV(1) = IAND (MXD, KM6-1)
- MV(2) = IAND (ISHFTR(MXD,5), KM6-1)
- MV(3) = IAND (ISHFTR(MXD,10), KM5-1)
- MV(4) = IAND (ISHFTR(MXD,14), KM5-1)
-
-C- MODE: 1 ONLY, 2 TRANS, 4 INHIBIT
-
- IF (MODE.EQ.4) GO TO 28
-
-C---- Activation
-
- IF (MODE.NE.1) MV(1) = IOR (MV(1), MXNEW)
- IF (MODE.EQ.2) MV(3) = IOR (MV(3), MXNEW)
- MV(4) = IOR (MV(4), MXNEW)
-
-C-- "TRANS" attachment to USE
-
- IF (MXTRAN.NE.0) THEN
- IF (MXNEW.GE.16) THEN
- MV(1) = IOR (MV(1), MXTRAN)
- MV(3) = IOR (MV(3), MXTRAN)
- MV(4) = IOR (MV(4), MXTRAN)
- ENDIF
- ENDIF
-
-C-- mask against inhibition bits
-
- 24 MV(1) = IAND (MV(1), MV(2))
- MV(3) = IAND (MV(3), MV(2))
- MV(4) = IAND (MV(4), MV(2))
-
-C-- store
-
- MXWK = IOR (ISHFTL(MV(2),5), MV(1))
- MXWK = IOR (ISHFTL(MV(3),10), MXWK)
- MXWK = IOR (ISHFTL(MV(4),14), MXWK)
- CALL SBYT (MXWK,MTARG(1),1,18)
- RETURN
-
-C---- Inhibition
-
- 28 MXWK = 127 - MXNEW
- MV(2) = IAND (MV(2), MXWK)
- GO TO 24
- END
diff --git a/src/p5boot/p5lib/x_use.f b/src/p5boot/p5lib/x_use.f
deleted file mode 100644
index 21e8a7d..0000000
--- a/src/p5boot/p5lib/x_use.f
+++ /dev/null
@@ -1,207 +0,0 @@
-CDECK ID>, X_USE.
- SUBROUTINE X_USE
-
-C- Process +USE, +XDIV, +DIV, +LIST, +EXE
-C- +SUSPEND, +FORCE
-
- PARAMETER (KM1=1,KM2=2,KM3=4,KM4=8,KM5=16,KM6=32,KM7=64,KM8=128,
- + KM9=256, KM10=512, KM11=1024, KM12=2048, KM13=4096, KM14=8192,
- + KM15=16384, KM16=32768, KM17=65536, KM18=131072, KM19=262144)
- PARAMETER (MCCNIL=1, MCCKIL=2, MCCINC=3, MCCCDE=4, MCCSEQ=5,
- + MCCXSQ=6, MCCTRU=7, MCCFAL=8, MCCELS=9, MCCEND=10,
- + MCCSEL=11, MCCSES=12, MCCFAU=13, MCCSKI=14,
- + MCCKEE=15, MCCDEL=16, MCCREP=17, MCCADB=18, MCCADD=19,
- + MCCUSE=20, MCCXDI=21, MCCDIV=22, MCCLIS=23, MCCEXE=24, MCCIMI=25,
- + MCCASM=26, MCCUPD=27, MCCNAM=28, MCCGAP=29, MCCMOR=30, MCCONL=31,
- + MCCFOR=32, MCCSUS=33, MCCOPT=34, MCCOP2=35, MCCSHO=36, MCCPAM=37,
- + MCCQUI=38, MCCEOD=39, MCCDEC=40, MCCPAT=41, MCCTIT=42)
- CHARACTER CCKORG*256, CCKARD*256, CCCOMF*256
- COMMON /CCPARA/NCHCCD,NCHCCT, JCCTYP,JCCLEV,JCCSL,MCCPAR(240)
- +, NCCPAR,MXCCIF,JCCIFV,JCCBAD,JCCWAR,ICCSUB,JCCWK(4)
- +, JCCPP,JCCPD,JCCPZ,JCCPT,JCCPIF,JCCPC,JCCPN
- +, NCCPP,NCCPD,NCCPZ,NCCPT,NCCPIF,NCCPC,NCCPN
- +, JCCEND, NCHCCC,IXCCC, CCKORG, CCKARD, CCCOMF
- COMMON /MUSEBC/ MX_FORC, MU_GLOB, MU_PAT, MU_DECK, MU_INH, MU_FORG
- +, MX_TRAN, MX_FORG, MX_SINH, MX_SELF, NVEXDK(6)
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
- COMMON /M_ANAC/LOWAN,KDOAN,LDOAN,LUPAN,MODEAN,MEXAN,LEVAN,KKM5AN
- +, NEWDEC,NEWCTL,NEWFOR,NEWNIL,NEWINC
-C-------------- End CDE --------------------------------
- DIMENSION MV(2)
- EQUIVALENCE (MV(1),IQUEST(1))
-
- PARAMETER (NPOSS = 10)
- CHARACTER POSS(NPOSS)*8
-
- PARAMETER (KBOFF=KM8, KBREP=KM9)
-
- IAND (IZV,IZW) = AND (IZV, IZW)
- IOR (IZV,IZW) = OR (IZV, IZW)
- ISHFTL (IZW,NZB) = LSHIFT (IZW, NZB)
- ISHFTR (IZW,NZB) = ISHFT (IZW, -NZB)
-
- DATA POSS / 'E*XECUTE'
- +, 'L*IST '
- +, 'D*IVERT '
- +, 'X*DIVERT'
- +, 'ONL*Y '
- +, 'T*RANSMI'
- +, 'I*NHIBIT'
- +, 'OFF '
- +, 'R*EPEAT '
- +, 'ENV*IRON' /
-
-
- MASKOP = 0
- IF (NCCPT.NE.0) THEN
- CALL CCOPT (POSS,NPOSS)
- IF (JCCBAD.NE.0) GO TO 91
- MASKOP = MCCPAR(JCCPT+2)
- ENDIF
-
- MXNEW = IAND (MASKOP,KM5-1)
- IF (JCCTYP.GE.MCCFOR) GO TO 71
-
-C---------- Doing +USE, +EXE, etc ---------
-
-C-: MODE= 1 ONLY, 2 TRANS, 4 INHIBIT
-
- 31 MODE = ISHFTR (MASKOP,4)
- MODE = IAND (MODE,15)
- IF (MODE.EQ.3) GO TO 91
- IF (MODE.GT.4) GO TO 91
-
- J = MCCIMI - JCCTYP
- CALL SBIT1 (MXNEW,J)
-
-C-- Propagation permission filter
-
- IF (INCRAD.EQ.0) MXNEW= IAND (MXNEW, IOR(MU_DECK,KM3))
-
-C------ Process global activation ------
-
- IF (JCCPD.NE.0) GO TO 51
- IF (JCCPP.NE.0) GO TO 41
-
- IF (INCRAD.EQ.0) GO TO 92
- IF (MODE.EQ.4) THEN
- IF (MXNEW.GE.16) GO TO 91
- ENDIF
-
- IQUEST(11) = MXNEW
- IQUEST(12) = MODE
- IQUEST(13) = 0
- CALL X_UPUT (MU_GLOB)
-
-C-- propagate through all patches and decks
-
- LQ(LLPAST-1) = 0
- L = LEXP
- 34 CALL MXJOIN (MU_GLOB,IQ(L))
- CALL X_UDECK (L)
- L = LQ(L-1)
- IF (L.NE.0) GO TO 34
- RETURN
-
-C------ Process patch activation ------
-
- 41 IXUPAT = MCCPAR(JCCPP+1)
- IF (IXUPAT.EQ.0) GO TO 48
-
- CALL CREAPD (IXUPAT,-1, 0)
-
- IQUEST(11) = MXNEW
- IQUEST(12) = MODE
- IQUEST(13) = MX_TRAN
- CALL X_UPUT (IQ(LCRP))
- IF (IAND(MASKOP,KBREP).NE.0) IQ(LCRP+1)= IOR (IQ(LCRP+1),KM5)
-
-C-- set "used from"
-
- IF (MXNEW.LT.16) GO TO 45
- IF (MODE.EQ.4) GO TO 44
- IF (IAND(IQ(LCRP),KM5).EQ.0) GO TO 45
- 44 LQ(LCRP-4) = LEXP
-
-C-- propagate through all decks
-
- 45 CALL X_UDECK (LCRP)
- 48 NCCPP = NCCPP - 1
- IF (NCCPP.EQ.0) RETURN
- JCCPP = JCCPP + 3
- GO TO 41
-
-C------ Process deck activation ------
-
- 51 IF (NCCPP.NE.1) GO TO 91
- IXUPAT = MCCPAR(JCCPP+1)
- IF (IXUPAT.EQ.0) RETURN
-
- 54 IXUDEC = MCCPAR(JCCPD+1)
-
- CALL CREAPD (IXUPAT,IXUDEC, 0)
-
- IQUEST(11) = MXNEW
- IQUEST(12) = MODE
- IQUEST(13) = MX_TRAN
- CALL X_UPUT (IQ(LCRD))
-
-C-- blank deck and D=CRA* of P=CRA* can change their own status
-
- IF (INCRAD.GE.2) THEN
- IF (LCRP.EQ.LEXP) CALL X_UDECK (0)
- ENDIF
-
- 58 NCCPD = NCCPD - 1
- JCCPD = JCCPD + 3
- IF (NCCPD.NE.0) GO TO 54
-
-C-- set "used from"
-
- IF (MODE.EQ.4) RETURN
- IF (MXNEW.LT.16) RETURN
- IQ(LCRP+1) = IOR (IQ(LCRP+1),KM4)
- IF (LQ(LCRP-4).EQ.0) LQ(LCRP-4)=LEXP
- RETURN
-
-C---------- +FORCE, (OFF,) EXE, LIST, DIV, XDIV ---------
-C-- +SUSPEND, (OFF,) EXE, LIST, DIV, XDIV
-
- 71 MXNEG = KM5-1 - MXNEW
- MXOFF = IAND (MASKOP,KBOFF)
- MV(1) = IAND (ISHFTR(MX_FORC,5), KM5-1)
- MV(2) = IAND (ISHFTR(MX_FORC,14), KM5-1)
-
-
- IF (JCCTYP.EQ.MCCFOR) THEN
- IF (MXOFF.EQ.0) MV(2) = IOR (MV(2),MXNEW)
- IF (MXOFF.NE.0) MV(2) = IAND (MV(2),MXNEG)
- ELSE
- IF (MXOFF.EQ.0) MV(1) = IAND (MV(1),MXNEG)
- IF (MXOFF.NE.0) MV(1) = IOR (MV(1),MXNEW)
- ENDIF
-
- MX_FORC = IOR (ISHFTL(MV(1),5), ISHFTL(MV(2),14))
- RETURN
-
-C----- Faulty control line
-
- 91 CALL M_FAIL ('Bad syntax')
- RETURN
-
- 92 CALL M_FAIL ('This is allowed only in the cradle')
- RETURN
- END
diff --git a/src/p5boot/p5lib/xeject.f b/src/p5boot/p5lib/xeject.f
deleted file mode 100644
index 2063df9..0000000
--- a/src/p5boot/p5lib/xeject.f
+++ /dev/null
@@ -1,46 +0,0 @@
-CDECK ID>, XEJECT.
- SUBROUTINE XEJECT
-
-C- Check and act on +SEQ, QEJECT, N=n
-C. started 12-jan-94
-
- CHARACTER CCKORG*256, CCKARD*256, CCCOMF*256
- COMMON /CCPARA/NCHCCD,NCHCCT, JCCTYP,JCCLEV,JCCSL,MCCPAR(240)
- +, NCCPAR,MXCCIF,JCCIFV,JCCBAD,JCCWAR,ICCSUB,JCCWK(4)
- +, JCCPP,JCCPD,JCCPZ,JCCPT,JCCPIF,JCCPC,JCCPN
- +, NCCPP,NCCPD,NCCPZ,NCCPT,NCCPIF,NCCPC,NCCPN
- +, JCCEND, NCHCCC,IXCCC, CCKORG, CCKARD, CCCOMF
- COMMON /QPAGE/ NQLMAX,NQLTOL,NQLTOK,NQCMAX,NQCPGH,NQPAGE
- +, NQWYLDO,NQWYL,NQNEWH,NQJOIN,NQDKNO,NQDKPG
- COMMON /QUNIT/ IQREAD,IQPRNT, IQTTIN,IQTYPE, IQOFFL,IQRTTY,IQRSAV
- +, IQRFD,IQRRD,IQRSIZ, NQLPAT,NQUSED,NQLLBL, NQINIT
- PARAMETER (NEWLN=10, NCHNEWL=1)
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
- COMMON /M_ANAC/LOWAN,KDOAN,LDOAN,LUPAN,MODEAN,MEXAN,LEVAN,KKM5AN
- +, NEWDEC,NEWCTL,NEWFOR,NEWNIL,NEWINC
-C-------------- End CDE --------------------------------
-
- PARAMETER (JSPSEQ1=3, JSPDATE=9, JSPSEQL=15)
- PARAMETER (IXEJ = JSPSEQ1 + 1)
-
-
- CALL CCKRAK (IQ(LDOAN+1))
-
- IF (JCCBAD.NE.0) RETURN
- IF (NCCPZ.NE.1) RETURN
- IF (MCCPAR(JCCPZ+1).NE.IXEJ) RETURN
-
- NN = MCCPAR(JCCPN+1)
- IF (NN.LT.0) NN = NQLMAX
- IF (NN.EQ.0) NN = NQLMAX - 6
- IF (NQUSED+NN.LE.NQLMAX) RETURN
- NQUSED = NQLMAX
- CALL DPPAGE
- RETURN
- END
diff --git a/src/packlib/Imakefile b/src/packlib/Imakefile
deleted file mode 100644
index 3c6448a..0000000
--- a/src/packlib/Imakefile
+++ /dev/null
@@ -1,46 +0,0 @@
-
-#define IHaveSubdirs
-#define PassCDebugFlags
-
-
-LIBDIRS= cspack epio fatmen ffread hbook hepdb kapack kuip \ @@\
- minuit zbook zebra kernlib
-
-SUBDIRS= $(LIBDIRS)
-
-TopOfPackage(packlib)
-
-SubdirLibraryTarget(packlib,$(LIBDIRS))
-
-InstallLibrary(packlib,$(CERN_LIBDIR))
-InstallLibraryAlias(packlib,packlib-shift,$(CERN_LIBDIR))
-
-TestSubdirs($(LIBDIRS))
-
-#ifndef CERNLIB_VAXVMS
-
-InstallLibSubdirs(kernlib)
-
-#else
-
-SUBDIRS := $(SUBDIRS) vmslibfiles
-InstallLibSubdirs(kernlib vmslibfiles)
-
-#endif
-
-
-/* Build executables */
-#ifndef CERNLIB_VAXVMS
-
-InstallBinSubdirs(cspack fatmen hepdb kuip)
-
-#else
-
-InstallBinSubdirs(vmslibfiles cspack fatmen hepdb kuip)
-
-#endif
-INCLUDEDIRS= $(LIBDIRS)
-
-InstallIncludeSubdirs($(INCLUDEDIRS))
-
-DelegateTarget(bin/kuipc,kuip)
diff --git a/src/packlib/cspack/Imakefile b/src/packlib/cspack/Imakefile
deleted file mode 100644
index fd70809..0000000
--- a/src/packlib/cspack/Imakefile
+++ /dev/null
@@ -1,28 +0,0 @@
-
-#define IHaveSubdirs
-#define PassCDebugFlags
-
-LIBDIRS= cz fz sz xz tcpaw
-
-#if defined(CERNLIB_VAXVMS)
-LIBDIRS:= $(LIBDIRS) vmsc czdnet
-#endif
-
-#if ( defined(CERNLIB_VAXVMS) || defined(CERNLIB_UNIX) ) \
- && ! defined(CERNLIB_SHIFT) && ! defined(CERNLIB_WINNT)
-LIBDIRS:= $(LIBDIRS) sysreq
-#endif
-
-PROGRAMDIRS= programs
-
-SUBDIRS= $(LIBDIRS) $(PROGRAMDIRS) cspack
-
-TopOfPackage(cspack)
-
-SubdirLibraryTarget(cspack,$(LIBDIRS))
-
-InstallBinSubdirs($(PROGRAMDIRS))
-
-test::
-
-InstallIncludeSubdirs(cspack)
diff --git a/src/packlib/cspack/cspack/Imakefile b/src/packlib/cspack/cspack/Imakefile
deleted file mode 100644
index c29ee4a..0000000
--- a/src/packlib/cspack/cspack/Imakefile
+++ /dev/null
@@ -1,11 +0,0 @@
-INCLUDES= cspackc.inc cspackf.inc czbuff.inc czdecnet.inc \ @@\
- czdir.inc czflush.inc czfold.inc czhome.inc czmess.inc \ @@\
- czopen.inc czoptd.inc czopts.inc czoptu.inc czsock.inc \ @@\
- czunit.inc hbook.inc hcbook.inc hcdire.inc hcflag.inc hck.inc \ @@\
- hcmail.inc hcntpar.inc hos9c.inc lpawc.inc paw.inc pawc.inc \ @@\
- pawlun.inc pzunit.inc qftitlch.inc quest.inc rzclun.inc \ @@\
- slate.inc szchopt.inc szmess.inc tcpsock.inc tsosub.inc \ @@\
- vmsinf.inc vmsprot.inc xzstat.inc zebra.inc zmach.inc \ @@\
- zmachfix.inc zstate.inc zunit.inc pilot.h
-
-InstallIncludes($(INCLUDES),$(CERN_INCLUDEDIR),cspack)
diff --git a/src/packlib/cspack/cspack/cspackc.inc b/src/packlib/cspack/cspack/cspackc.inc
deleted file mode 100644
index d469b62..0000000
--- a/src/packlib/cspack/cspack/cspackc.inc
+++ /dev/null
@@ -1,13 +0,0 @@
-*
-* $Id: cspackc.inc,v 1.1.1.1 1996/03/08 15:44:17 mclareni Exp $
-*
-* $Log: cspackc.inc,v $
-* Revision 1.1.1.1 1996/03/08 15:44:17 mclareni
-* Cspack
-*
-*
-#ifndef CERNLIB_CSPACK_CSPACKC_INC
-#define CERNLIB_CSPACK_CSPACKC_INC
-*
-
-#endif
diff --git a/src/packlib/cspack/cspack/cspackf.inc b/src/packlib/cspack/cspack/cspackf.inc
deleted file mode 100644
index 608977f..0000000
--- a/src/packlib/cspack/cspack/cspackf.inc
+++ /dev/null
@@ -1,13 +0,0 @@
-*
-* $Id: cspackf.inc,v 1.1.1.1 1996/03/08 15:44:17 mclareni Exp $
-*
-* $Log: cspackf.inc,v $
-* Revision 1.1.1.1 1996/03/08 15:44:17 mclareni
-* Cspack
-*
-*
-#ifndef CERNLIB_CSPACK_CSPACKF_INC
-#define CERNLIB_CSPACK_CSPACKF_INC
-*
-
-#endif
diff --git a/src/packlib/cspack/cspack/czbuff.inc b/src/packlib/cspack/cspack/czbuff.inc
deleted file mode 100644
index af1f755..0000000
--- a/src/packlib/cspack/cspack/czbuff.inc
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: czbuff.inc,v 1.1.1.1 1996/03/08 15:44:17 mclareni Exp $
-*
-* $Log: czbuff.inc,v $
-* Revision 1.1.1.1 1996/03/08 15:44:17 mclareni
-* Cspack
-*
-*
-#ifndef CERNLIB_CSPACK_CZBUFF_INC
-#define CERNLIB_CSPACK_CZBUFF_INC
-*
-*
-* czbuff.inc
-*
- COMMON/CZBUFC/CHBUF
-*
-* Buffer size for ASCII file transfer
-*
- CHARACTER*16320 CHBUF
-* CHARACTER*20480 CHBUF
-* DIMENSION ICBUF(4080)
-* DIMENSION ICBUF(5120)
-* EQUIVALENCE (CHBUF,ICBUF(1))
-*
-
-#endif
diff --git a/src/packlib/cspack/cspack/czdecnet.inc b/src/packlib/cspack/cspack/czdecnet.inc
deleted file mode 100644
index 0d9c3dd..0000000
--- a/src/packlib/cspack/cspack/czdecnet.inc
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: czdecnet.inc,v 1.1.1.1 1996/03/08 15:44:18 mclareni Exp $
-*
-* $Log: czdecnet.inc,v $
-* Revision 1.1.1.1 1996/03/08 15:44:18 mclareni
-* Cspack
-*
-*
-#ifndef CERNLIB_CSPACK_CZDECNET_INC
-#define CERNLIB_CSPACK_CZDECNET_INC
-*
-*
-* czdecnet.inc
-*
- INTEGER LUNDEC
- COMMON /CZDECN/ LUNDEC
-*
-
-#endif
diff --git a/src/packlib/cspack/cspack/czdir.inc b/src/packlib/cspack/cspack/czdir.inc
deleted file mode 100644
index 3efb38f..0000000
--- a/src/packlib/cspack/cspack/czdir.inc
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: czdir.inc,v 1.1.1.1 1996/03/08 15:44:17 mclareni Exp $
-*
-* $Log: czdir.inc,v $
-* Revision 1.1.1.1 1996/03/08 15:44:17 mclareni
-* Cspack
-*
-*
-#ifndef CERNLIB_CSPACK_CZDIR_INC
-#define CERNLIB_CSPACK_CZDIR_INC
-*
-*
-* czdir.inc
-*
- PARAMETER (MAXFIL=20)
- COMMON/CZDIR1/CHRZ(MAXFIL),FLNAME(MAXFIL)
- CHARACTER*64 FLNAME
- CHARACTER*32 CHRZ
- COMMON/CZDIR2/IDIR,NCHRZ,LUNRZ(MAXFIL)
-*
-
-#endif
diff --git a/src/packlib/cspack/cspack/czflush.inc b/src/packlib/cspack/cspack/czflush.inc
deleted file mode 100644
index e7102aa..0000000
--- a/src/packlib/cspack/cspack/czflush.inc
+++ /dev/null
@@ -1,42 +0,0 @@
-*
-* $Id: czflush.inc,v 1.1.1.1 1996/03/08 15:44:17 mclareni Exp $
-*
-* $Log: czflush.inc,v $
-* Revision 1.1.1.1 1996/03/08 15:44:17 mclareni
-* Cspack
-*
-*
-#ifndef CERNLIB_CSPACK_CZFLUSH_INC
-#define CERNLIB_CSPACK_CZFLUSH_INC
-*
-*
-* czflush.inc
-*
-*
-* Flush server messages
-*
-10 CONTINUE
- CALL CZGETA(CHMAIL,ISTAT)
- LCH = LENOCC(CHMAIL)
- IF(CHMAIL(1:1).EQ.'0') THEN
-*
-* Nop
-*
- ELSEIF(CHMAIL(1:1).EQ.'1') THEN
- ELSEIF(CHMAIL(1:1).EQ.'2') THEN
- GOTO 10
- ELSEIF(CHMAIL(1:1).EQ.'3') THEN
- IQUEST(1) = 1
- IRC = 1
- ELSEIF(CHMAIL(1:1).EQ.'E') THEN
- IQUEST(1) = -1
- IRC = -1
- ELSEIF(CHMAIL(1:1).EQ.'V') THEN
- GOTO 10
- ELSE
- IQUEST(1) = 1
- IRC = 1
- ENDIF
-*
-
-#endif
diff --git a/src/packlib/cspack/cspack/czfold.inc b/src/packlib/cspack/cspack/czfold.inc
deleted file mode 100644
index eb29ade..0000000
--- a/src/packlib/cspack/cspack/czfold.inc
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: czfold.inc,v 1.1.1.1 1996/03/08 15:44:17 mclareni Exp $
-*
-* $Log: czfold.inc,v $
-* Revision 1.1.1.1 1996/03/08 15:44:17 mclareni
-* Cspack
-*
-*
-#ifndef CERNLIB_CSPACK_CZFOLD_INC
-#define CERNLIB_CSPACK_CZFOLD_INC
-*
-*
-* czfold.inc
-*
- IF(INDEX(CHOPT,'C').EQ.0) THEN
- CALL CLTOU(LOCAL)
- CALL CLTOU(REMOTE)
- ENDIF
-
-#endif
diff --git a/src/packlib/cspack/cspack/czhome.inc b/src/packlib/cspack/cspack/czhome.inc
deleted file mode 100644
index 8fcd371..0000000
--- a/src/packlib/cspack/cspack/czhome.inc
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: czhome.inc,v 1.1.1.1 1996/03/08 15:44:18 mclareni Exp $
-*
-* $Log: czhome.inc,v $
-* Revision 1.1.1.1 1996/03/08 15:44:18 mclareni
-* Cspack
-*
-*
-#ifndef CERNLIB_CSPACK_CZHOME_INC
-#define CERNLIB_CSPACK_CZHOME_INC
-*
-*
-* czhome.inc
-*
- COMMON/CZHOME/LHOME,CHHOME
- CHARACTER*80 CHHOME
-
-#endif
diff --git a/src/packlib/cspack/cspack/czmess.inc b/src/packlib/cspack/cspack/czmess.inc
deleted file mode 100644
index a138630..0000000
--- a/src/packlib/cspack/cspack/czmess.inc
+++ /dev/null
@@ -1,54 +0,0 @@
-*
-* $Id: czmess.inc,v 1.1.1.1 1996/03/08 15:44:18 mclareni Exp $
-*
-* $Log: czmess.inc,v $
-* Revision 1.1.1.1 1996/03/08 15:44:18 mclareni
-* Cspack
-*
-*
-#ifndef CERNLIB_CSPACK_CZMESS_INC
-#define CERNLIB_CSPACK_CZMESS_INC
-*
-*
-* czmess.inc
-*
-*
-* Process server messages
-*
- IRC = 0
-10 CONTINUE
- CALL CZGETA(CHMAIL,ISTAT)
- LCH = LENOCC(CHMAIL)
- IF(CHMAIL(1:1).EQ.'0') THEN
-*
-* Nop
-*
- ELSEIF(CHMAIL(1:1).EQ.'1') THEN
- PRINT *,CHMAIL(2:LCH)
- ELSEIF(CHMAIL(1:1).EQ.'2') THEN
- PRINT *,CHMAIL(2:LCH)
- GOTO 10
- ELSEIF(CHMAIL(1:1).EQ.'3') THEN
- PRINT *,CHMAIL(2:LCH)
- IQUEST(1) = 1
- IRC = 1
- ELSEIF(CHMAIL(1:1).EQ.'4') THEN
- IQUEST(1) = 1
- IRC = 1
- ELSEIF(CHMAIL(1:1).EQ.'E') THEN
- IQUEST(1) = -1
- IRC = -1
- ELSEIF(CHMAIL(1:1).EQ.'V') THEN
-*
-* Number of bytes read from a variable length read
-*
- READ(CHMAIL(2:11),'(I10)') NGOT
- GOTO 10
- ELSE
- PRINT *,'Unknown server message ',CHMAIL
- IQUEST(1) = 1
- IRC = 1
- ENDIF
-*
-
-#endif
diff --git a/src/packlib/cspack/cspack/czopen.inc b/src/packlib/cspack/cspack/czopen.inc
deleted file mode 100644
index 9c2e788..0000000
--- a/src/packlib/cspack/cspack/czopen.inc
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: czopen.inc,v 1.1.1.1 1996/03/08 15:44:18 mclareni Exp $
-*
-* $Log: czopen.inc,v $
-* Revision 1.1.1.1 1996/03/08 15:44:18 mclareni
-* Cspack
-*
-*
-#ifndef CERNLIB_CSPACK_CZOPEN_INC
-#define CERNLIB_CSPACK_CZOPEN_INC
-*
-*
-* czopen.inc
-*
- IF(ISKIN.LT.0)THEN
- PRINT *,' Use the OPEN command to establish connection'
- GO TO 99
- ENDIF
-*
-
-#endif
diff --git a/src/packlib/cspack/cspack/czoptd.inc b/src/packlib/cspack/cspack/czoptd.inc
deleted file mode 100644
index 65f5c2b..0000000
--- a/src/packlib/cspack/cspack/czoptd.inc
+++ /dev/null
@@ -1,48 +0,0 @@
-*
-* $Id: czoptd.inc,v 1.1.1.1 1996/03/08 15:44:18 mclareni Exp $
-*
-* $Log: czoptd.inc,v $
-* Revision 1.1.1.1 1996/03/08 15:44:18 mclareni
-* Cspack
-*
-*
-#ifndef CERNLIB_CSPACK_CZOPTD_INC
-#define CERNLIB_CSPACK_CZOPTD_INC
-*
-*
-* czoptd.inc
-*
-#if !defined(CERNLIB_LINUX)
- DIMENSION IOPT(26)
- EQUIVALENCE (IOPT(1),IOPTA),(IOPT(2),IOPTB),(IOPT(3),IOPTC),
- + (IOPT(4),IOPTD),(IOPT(5),IOPTE),(IOPT(6),IOPTF),
- + (IOPT(7),IOPTG),(IOPT(8),IOPTH),(IOPT(9),IOPTI),
- + (IOPT(10),IOPTJ),(IOPT(11),IOPTK),(IOPT(12),IOPTL),
- + (IOPT(13),IOPTM),(IOPT(14),IOPTN),(IOPT(15),IOPTO),
- + (IOPT(16),IOPTP),(IOPT(17),IOPTQ),(IOPT(18),IOPTR),
- + (IOPT(19),IOPTS),(IOPT(20),IOPTT),(IOPT(21),IOPTU),
- + (IOPT(22),IOPTV),(IOPT(23),IOPTW),(IOPT(24),IOPTX),
- + (IOPT(25),IOPTY),(IOPT(26),IOPTZ)
- CHARACTER*26 ALFBET
- CHARACTER*(*) CHOPT
- DATA ALFBET/'ABCDEFGHIJKLMNOPQRSTUVWXYZ'/
-*
-#endif
-#if defined(CERNLIB_LINUX)
- DIMENSION IOPT(26)
- EQUIVALENCE (IOPT(1),IOPTA),(IOPT(2),IOPTB),(IOPT(3),IOPTC),
- + (IOPT(4),IOPTD),(IOPT(5),IOPTE),(IOPT(6),IOPTF),
- + (IOPT(7),IOPTG),(IOPT(8),IOPTH),(IOPT(9),IOPTI),
- + (IOPT(10),IOPTJ),(IOPT(11),IOPTK),(IOPT(12),IOPTL),
- + (IOPT(13),IOPTM),(IOPT(14),IOPTN),(IOPT(15),IOPTO),
- + (IOPT(16),IOPTP),(IOPT(17),IOPTQ),(IOPT(18),IOPTR),
- + (IOPT(19),IOPTS),(IOPT(20),IOPTT),(IOPT(21),IOPTU),
- + (IOPT(22),IOPTV),(IOPT(23),IOPTW),(IOPT(24),IOPTX),
- + (IOPT(25),IOPTY),(IOPT(26),IOPTZ)
- CHARACTER*26 ALFBET
- CHARACTER*(*) CHOPT
- PARAMETER (ALFBET='ABCDEFGHIJKLMNOPQRSTUVWXYZ')
-*
-#endif
-
-#endif
diff --git a/src/packlib/cspack/cspack/czopts.inc b/src/packlib/cspack/cspack/czopts.inc
deleted file mode 100644
index bc245d9..0000000
--- a/src/packlib/cspack/cspack/czopts.inc
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: czopts.inc,v 1.1.1.1 1996/03/08 15:44:18 mclareni Exp $
-*
-* $Log: czopts.inc,v $
-* Revision 1.1.1.1 1996/03/08 15:44:18 mclareni
-* Cspack
-*
-*
-#ifndef CERNLIB_CSPACK_CZOPTS_INC
-#define CERNLIB_CSPACK_CZOPTS_INC
-*
-* Sequence to expand CHOPT into IOPT vector
-*
-* czopts.inc
-*
-#include "cspack/czoptd.inc"
-#include "cspack/czoptu.inc"
-*
-
-#endif
diff --git a/src/packlib/cspack/cspack/czoptu.inc b/src/packlib/cspack/cspack/czoptu.inc
deleted file mode 100644
index 0f170bc..0000000
--- a/src/packlib/cspack/cspack/czoptu.inc
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: czoptu.inc,v 1.1.1.1 1996/03/08 15:44:18 mclareni Exp $
-*
-* $Log: czoptu.inc,v $
-* Revision 1.1.1.1 1996/03/08 15:44:18 mclareni
-* Cspack
-*
-*
-#ifndef CERNLIB_CSPACK_CZOPTU_INC
-#define CERNLIB_CSPACK_CZOPTU_INC
-*
-*
-* czoptu.inc
-*
- CALL UOPTC(CHOPT,ALFBET,IOPT)
-*
-
-#endif
diff --git a/src/packlib/cspack/cspack/czsock.inc b/src/packlib/cspack/cspack/czsock.inc
deleted file mode 100644
index 500ba28..0000000
--- a/src/packlib/cspack/cspack/czsock.inc
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: czsock.inc,v 1.1.1.1 1996/03/08 15:44:18 mclareni Exp $
-*
-* $Log: czsock.inc,v $
-* Revision 1.1.1.1 1996/03/08 15:44:18 mclareni
-* Cspack
-*
-*
-#ifndef CERNLIB_CSPACK_CZSOCK_INC
-#define CERNLIB_CSPACK_CZSOCK_INC
-*
-*
-* czsock.inc
-*
- COMMON/CZSOCK/LUNCZ,IADTCP,LBUF,ISKIN,ISKOUT,IPROT,
- + JUNIT(99),JSKIN(99),JSKOUT(99),CUNODE,
- + CHNODE(99),CHUSER(99)
- CHARACTER*12 CHNODE,CUNODE,CHUSER
- PARAMETER (LNODE=12)
- PARAMETER (LUSER=12)
- PARAMETER (MAXSOC=99)
-*
-* IPROT: 0 - TCP/IP (TCPAW)
-* 1 - DECnet (included in CZ)
-* CHNODE & CHUSER store the node and user names that correspond
-* to JUNIT
-*
-
-#endif
diff --git a/src/packlib/cspack/cspack/czunit.inc b/src/packlib/cspack/cspack/czunit.inc
deleted file mode 100644
index c38b5b0..0000000
--- a/src/packlib/cspack/cspack/czunit.inc
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: czunit.inc,v 1.1.1.1 1996/03/08 15:44:17 mclareni Exp $
-*
-* $Log: czunit.inc,v $
-* Revision 1.1.1.1 1996/03/08 15:44:17 mclareni
-* Cspack
-*
-*
-#ifndef CERNLIB_CSPACK_CZUNIT_INC
-#define CERNLIB_CSPACK_CZUNIT_INC
-*
-*
-* czunit.inc
-*
- COMMON/CZUNIT/IXPRNT,IDEBXZ,LUNXZI,LUNXZO,LUNFZI,LUNFZO
-
-#endif
diff --git a/src/packlib/cspack/cspack/hbook.inc b/src/packlib/cspack/cspack/hbook.inc
deleted file mode 100644
index e1156a5..0000000
--- a/src/packlib/cspack/cspack/hbook.inc
+++ /dev/null
@@ -1,13 +0,0 @@
-*
-* $Id: hbook.inc,v 1.1.1.1 1996/03/08 15:44:16 mclareni Exp $
-*
-* $Log: hbook.inc,v $
-* Revision 1.1.1.1 1996/03/08 15:44:16 mclareni
-* Cspack
-*
-*
-#ifndef CERNLIB_CSPACK_HBOOK_INC
-#define CERNLIB_CSPACK_HBOOK_INC
-*
-
-#endif
diff --git a/src/packlib/cspack/cspack/hcbook.inc b/src/packlib/cspack/cspack/hcbook.inc
deleted file mode 100644
index c70b1d4..0000000
--- a/src/packlib/cspack/cspack/hcbook.inc
+++ /dev/null
@@ -1,35 +0,0 @@
-*
-* $Id: hcbook.inc,v 1.1.1.1 1996/03/08 15:44:16 mclareni Exp $
-*
-* $Log: hcbook.inc,v $
-* Revision 1.1.1.1 1996/03/08 15:44:16 mclareni
-* Cspack
-*
-*
-#ifndef CERNLIB_CSPACK_HCBOOK_INC
-#define CERNLIB_CSPACK_HCBOOK_INC
-*
-*
-* hcbook.inc
-*
- INTEGER NWPAW,IXPAWC,IHDIV,IXHIGZ,IXKU, LMAIN
- REAL FENC , HCV
- COMMON/PAWC/NWPAW,IXPAWC,IHDIV,IXHIGZ,IXKU,FENC(5),LMAIN,HCV(9989)
- INTEGER IQ ,LQ
- REAL Q
- DIMENSION IQ(2),Q(2),LQ(8000)
- EQUIVALENCE (LQ(1),LMAIN),(IQ(1),LQ(9)),(Q(1),IQ(1))
- INTEGER HVERSN,IHWORK,LHBOOK,LHPLOT,LGTIT,LHWORK,
- +LCDIR,LSDIR,LIDS,LTAB,LCID,LCONT,LSCAT,LPROX,LPROY,LSLIX,
- +LSLIY,LBANX,LBANY,LPRX,LPRY,LFIX,LLID,LR1,LR2,LNAME,LCHAR,LINT,
- +LREAL,LBLOK,LLBLK,LBUFM,LBUF,LTMPM,LTMP,LTMP1,LHDUM,
- +LHFIT,LFUNC,LHFCO,LHFNA,LCIDN
- COMMON/HCBOOK/HVERSN,IHWORK,LHBOOK,LHPLOT,LGTIT,LHWORK,
- +LCDIR,LSDIR,LIDS,LTAB,LCID,LCONT,LSCAT,LPROX,LPROY,LSLIX,
- +LSLIY,LBANX,LBANY,LPRX,LPRY,LFIX,LLID,LR1,LR2,LNAME,LCHAR,LINT,
- +LREAL,LBLOK,LLBLK,LBUFM,LBUF,LTMPM,LTMP,LTMP1,LHDUM(10),
- +LHFIT,LFUNC,LHFCO,LHFNA,LCIDN
-*
-#include "cspack/hck.inc"
-
-#endif
diff --git a/src/packlib/cspack/cspack/hcdire.inc b/src/packlib/cspack/cspack/hcdire.inc
deleted file mode 100644
index 3db6fcb..0000000
--- a/src/packlib/cspack/cspack/hcdire.inc
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: hcdire.inc,v 1.1.1.1 1996/03/08 15:44:16 mclareni Exp $
-*
-* $Log: hcdire.inc,v $
-* Revision 1.1.1.1 1996/03/08 15:44:16 mclareni
-* Cspack
-*
-*
-#ifndef CERNLIB_CSPACK_HCDIRE_INC
-#define CERNLIB_CSPACK_HCDIRE_INC
-*
-*
-* hcdire.inc
-*
- PARAMETER (NLPATM=100, MXFILES=50)
- COMMON /HCDIRN/NLCDIR,NLNDIR,NLPAT,ICDIR,NCHTOP,ICHTOP(MXFILES)
- + ,ICHTYP(MXFILES),ICHLUN(MXFILES)
- CHARACTER*16 CHNDIR, CHCDIR, CHPAT ,CHTOP
- COMMON /HCDIRC/CHCDIR(NLPATM),CHNDIR(NLPATM),CHPAT(NLPATM)
- + ,CHTOP(NLPATM)
- CHARACTER*80 HFNAME
- COMMON /HCFILE/HFNAME(MXFILES)
-*
-
-#endif
diff --git a/src/packlib/cspack/cspack/hcflag.inc b/src/packlib/cspack/cspack/hcflag.inc
deleted file mode 100644
index de903cf..0000000
--- a/src/packlib/cspack/cspack/hcflag.inc
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: hcflag.inc,v 1.1.1.1 1996/03/08 15:44:16 mclareni Exp $
-*
-* $Log: hcflag.inc,v $
-* Revision 1.1.1.1 1996/03/08 15:44:16 mclareni
-* Cspack
-*
-*
-#ifndef CERNLIB_CSPACK_HCFLAG_INC
-#define CERNLIB_CSPACK_HCFLAG_INC
-*
-*
-* hcflag.inc
-*
- INTEGER ID ,IDBADD,LID ,IDLAST,IDHOLD,NBIT ,NBITCH,
- + NCHAR ,NRHIST,IERR ,NV
- COMMON/HCFLAG/ID ,IDBADD,LID ,IDLAST,IDHOLD,NBIT ,NBITCH,
- + NCHAR ,NRHIST,IERR ,NV
-*
-
-#endif
diff --git a/src/packlib/cspack/cspack/hck.inc b/src/packlib/cspack/cspack/hck.inc
deleted file mode 100644
index 96ad7ec..0000000
--- a/src/packlib/cspack/cspack/hck.inc
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: hck.inc,v 1.1.1.1 1996/03/08 15:44:16 mclareni Exp $
-*
-* $Log: hck.inc,v $
-* Revision 1.1.1.1 1996/03/08 15:44:16 mclareni
-* Cspack
-*
-*
-#ifndef CERNLIB_CSPACK_HCK_INC
-#define CERNLIB_CSPACK_HCK_INC
-*
-*
-* hck.inc
-*
- INTEGER KNCX ,KXMIN ,KXMAX ,KBWIDX ,KMIN ,KMAX ,KNORM ,
- + KTIT1 ,KNCY ,KYMIN ,KYMAX ,KBWIDY ,KSCAL2 ,
- + KTIT2 ,KNBIT ,KNOENT ,KSTAT1 ,KNSDIR ,KNRH ,
- + KCON1 ,KCON2 ,KBITS ,KNTOT
- PARAMETER(KNCX=3,KXMIN=4,KXMAX=5,KBWIDX=6,KMIN=7,KMAX=8,KNORM=9,
- + KTIT1=10,KNCY=7,KYMIN=8,KYMAX=9,KBWIDY=10,KSCAL2=11,
- + KTIT2=12,KNBIT=1,KNOENT=2,KSTAT1=3,KNSDIR=5,KNRH=6,
- + KCON1=9,KCON2=3,KBITS=1,KNTOT=2)
-*
-
-#endif
diff --git a/src/packlib/cspack/cspack/hcmail.inc b/src/packlib/cspack/cspack/hcmail.inc
deleted file mode 100644
index 902ea9c..0000000
--- a/src/packlib/cspack/cspack/hcmail.inc
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: hcmail.inc,v 1.1.1.1 1996/03/08 15:44:16 mclareni Exp $
-*
-* $Log: hcmail.inc,v $
-* Revision 1.1.1.1 1996/03/08 15:44:16 mclareni
-* Cspack
-*
-*
-#ifndef CERNLIB_CSPACK_HCMAIL_INC
-#define CERNLIB_CSPACK_HCMAIL_INC
-*
-*
-* hcmail.inc
-*
- COMMON /HCMAIL/CHMAIL
- CHARACTER*128 CHMAIL
-*
-
-#endif
diff --git a/src/packlib/cspack/cspack/hcntpar.inc b/src/packlib/cspack/cspack/hcntpar.inc
deleted file mode 100644
index 6a15c66..0000000
--- a/src/packlib/cspack/cspack/hcntpar.inc
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: hcntpar.inc,v 1.1.1.1 1996/03/08 15:44:16 mclareni Exp $
-*
-* $Log: hcntpar.inc,v $
-* Revision 1.1.1.1 1996/03/08 15:44:16 mclareni
-* Cspack
-*
-*
-#ifndef CERNLIB_CSPACK_HCNTPAR_INC
-#define CERNLIB_CSPACK_HCNTPAR_INC
-*
-*
-* hcntpar.inc
-*
- INTEGER ZBITS, ZNDIM, ZNOENT, ZNPRIM, ZNRZB, ZIFCON,
- + ZIFNAM, ZIFCHA, ZIFINT, ZIFREA, ZNWTIT, ZITIT1,
- + ZNCHRZ, ZDESC, ZLNAME, ZNAME, ZARIND, ZRANGE, ZNADDR,
- + ZIBLOK, ZNBLOK, ZLCONT, ZIFBIT, ZIBANK, ZIFTMP, ZITMP,
- + ZNTMP, ZNTMP1, ZLINK
- PARAMETER(ZBITS=1, ZNDIM=2, ZNOENT=3, ZNPRIM=4, ZLCONT=6,
- + ZNRZB=5, ZIFCON=7, ZIFNAM=4, ZIFCHA=5, ZIFINT=6,
- + ZIFREA=7, ZNWTIT=8, ZITIT1=9, ZNCHRZ=13, ZIFBIT=8,
- + ZDESC=1, ZLNAME=2, ZNAME=3, ZRANGE=4, ZNADDR=12,
- + ZARIND=11, ZIBLOK=8, ZNBLOK=10, ZIBANK=9, ZIFTMP=11,
- + ZITMP=10, ZNTMP=5, ZNTMP1=3, ZLINK=6)
-*
-
-#endif
diff --git a/src/packlib/cspack/cspack/hos9c.inc b/src/packlib/cspack/cspack/hos9c.inc
deleted file mode 100644
index cda63cb..0000000
--- a/src/packlib/cspack/cspack/hos9c.inc
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: hos9c.inc,v 1.1.1.1 1996/03/08 15:44:16 mclareni Exp $
-*
-* $Log: hos9c.inc,v $
-* Revision 1.1.1.1 1996/03/08 15:44:16 mclareni
-* Cspack
-*
-*
-#ifndef CERNLIB_CSPACK_HOS9C_INC
-#define CERNLIB_CSPACK_HOS9C_INC
-*
-*
-* hos9c.inc
-*
- COMMON/HOS9C1/CPU,MODULE
- CHARACTER*20 CPU,MODULE
- PARAMETER(knwid=32,kjcont=33,knw=34,knbprox=35,kjr1=36)
- PARAMETER(kid=37,kad=38,maxhist=400)
- COMMON/HOS9C2/IADPAWD,NHIST,IHEAD(KAD,MAXHIST)
-*
-
-#endif
diff --git a/src/packlib/cspack/cspack/lpawc.inc b/src/packlib/cspack/cspack/lpawc.inc
deleted file mode 100644
index 1251978..0000000
--- a/src/packlib/cspack/cspack/lpawc.inc
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: lpawc.inc,v 1.1.1.1 1996/03/08 15:44:16 mclareni Exp $
-*
-* $Log: lpawc.inc,v $
-* Revision 1.1.1.1 1996/03/08 15:44:16 mclareni
-* Cspack
-*
-*
-#ifndef CERNLIB_CSPACK_LPAWC_INC
-#define CERNLIB_CSPACK_LPAWC_INC
-*
-*
-* lpawc.inc
-*
-#if defined(CERNLIB_OS9)
- PARAMETER(NWPAWC=10000)
-#endif
-#if !defined(CERNLIB_OS9)
- PARAMETER(NWPAWC=900000)
-#endif
-
-#endif
diff --git a/src/packlib/cspack/cspack/paw.inc b/src/packlib/cspack/cspack/paw.inc
deleted file mode 100644
index 2a8deec..0000000
--- a/src/packlib/cspack/cspack/paw.inc
+++ /dev/null
@@ -1,13 +0,0 @@
-*
-* $Id: paw.inc,v 1.1.1.1 1996/03/08 15:44:16 mclareni Exp $
-*
-* $Log: paw.inc,v $
-* Revision 1.1.1.1 1996/03/08 15:44:16 mclareni
-* Cspack
-*
-*
-#ifndef CERNLIB_CSPACK_PAW_INC
-#define CERNLIB_CSPACK_PAW_INC
-*
-
-#endif
diff --git a/src/packlib/cspack/cspack/pawc.inc b/src/packlib/cspack/cspack/pawc.inc
deleted file mode 100644
index 184d423..0000000
--- a/src/packlib/cspack/cspack/pawc.inc
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: pawc.inc,v 1.1.1.1 1996/03/08 15:44:16 mclareni Exp $
-*
-* $Log: pawc.inc,v $
-* Revision 1.1.1.1 1996/03/08 15:44:16 mclareni
-* Cspack
-*
-*
-#ifndef CERNLIB_CSPACK_PAWC_INC
-#define CERNLIB_CSPACK_PAWC_INC
-*
-*
-* pawc.inc
-*
-#if defined(CERNLIB_OS9)
- COMMON/PAWC/NWPAW,IXPAWC,IHDIV,IXHIGZ,IXKU,FENC(5),LMAIN,
- + HCV(9989)
-#endif
-#if !defined(CERNLIB_OS9)
-#include "cspack/lpawc.inc"
- COMMON/PAWC/NWPAW,IXPAWC,IHDIV,IXHIGZ,IXKU,FENC(5),LMAIN,
- + HCV(NWPAWC)
-#endif
-
-#endif
diff --git a/src/packlib/cspack/cspack/pawlun.inc b/src/packlib/cspack/cspack/pawlun.inc
deleted file mode 100644
index d7cc9df..0000000
--- a/src/packlib/cspack/cspack/pawlun.inc
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: pawlun.inc,v 1.1.1.1 1996/03/08 15:44:18 mclareni Exp $
-*
-* $Log: pawlun.inc,v $
-* Revision 1.1.1.1 1996/03/08 15:44:18 mclareni
-* Cspack
-*
-*
-#ifndef CERNLIB_CSPACK_PAWLUN_INC
-#define CERNLIB_CSPACK_PAWLUN_INC
-*
-*
-* pawlun.inc
-*
- COMMON/PAWLUN/LUNIT(128)
-*
-
-#endif
diff --git a/src/packlib/cspack/cspack/pilot.h b/src/packlib/cspack/cspack/pilot.h
deleted file mode 100644
index eb47c6a..0000000
--- a/src/packlib/cspack/cspack/pilot.h
+++ /dev/null
@@ -1,127 +0,0 @@
-#if !defined(CERNLIB_IBMVM)
-#if 0
-* deactivate CERNLIB_SHIFT if you do not have the SHIFT software
-#endif
-#define CERNLIB_SHIFT
-#endif
-
-#ifndef CERNLIB_SINGLE
-#define CERNLIB_DOUBLE
-#endif
-
-
-#if defined(CERNLIB_UNIX)
-#define CERNLIB_EQUHOLCH
-#define CERNLIB_QHOLL
-#define CERNLIB_QTRHOLL
-#define CERNLIB_QORTHOLL
-#define CERNLIB_QASCII
-#define CERNLIB_QX_SC
-#define CERNLIB_MMAP
-#define CERNLIB_SYS5
-#endif
-
-#if defined(CERNLIB_IBMRT)
-#define CERNLIB_QMIRT
-#endif
-
-#if defined(CERNLIB_HPUX)
-#define CERNLIB_QMHPX
-#endif
-
-#if defined(CERNLIB_SUN)
-#define CERNLIB_QMSUN
-#define CERNLIB_BUGLRSHF
-#undef CERNLIB_QMILSTD
-#undef CERNLIB_QISASTD
-#endif
-
-#if defined(CERNLIB_SGI)
-#define CERNLIB_QMSGI
-#undef CERNLIB_RZBYTES
-#endif
-
-#if (defined(CERNLIB_DECS))||(defined(CERNLIB_DECOSF))
-#define CERNLIB_QMVMI
-#define CERNLIB_FQNEEDCV
-#undef CERNLIB_Z32
-#undef CERNLIB_FQXISN
-#undef CERNLIB_RZBYTES
-#undef CERNLIB_QMILSTD
-#endif
-
-#if defined(CERNLIB_WINNT)
-#define CERNLIB_QMDOS
-#define CERNLIB_QS_WNT
-#ifndef CERNKIB_QFMSOFT
-# ifndef CERNLIB_QFDEC
-# define CERNLIB_QFDEC
-# endif
-#endif
-#define CERNLIB_FQNEEDCV
-#define CERNLIB_F77TRARG
-#undef CERNLIB_Z32
-#undef CERNLIB_FQXISN
-#if defined(_ALPHA_) && defined(CERNLIB_RZBYTES)
-# undef CERNLIB_RZBYTES
-#endif
-# ifdef CERNLIB_MSSTDCALL
-# define F77_UPERCASE
-# define CERNLIB_QXCAPT
-# define type_of_call _stdcall
-# ifndef VISUAL_CPLUSPLUS
-# define VISUAL_CPLUSPLUS
-# endif
-# else
-# define F77_LOWERCASE
-# define CERNLIB_QXNO_SC
-# endif
-# ifndef CERNLIB_TCPSOCK
-# define CERNLIB_TCPSOCK
-# endif
-#endif
-
-#ifndef type_of_call
-#define type_of_call
-#endif
-
-#if defined(CERNLIB_VAXVMS)
-#define CERNLIB_DECNET
-#define CERNLIB_QMVAX
-#define CERNLIB_A4
-#define CERNLIB_B32
-#define CERNLIB_HEX
-#define CERNLIB_QHOLL
-#define CERNLIB_EQUHOLCH
-#define CERNLIB_QTRHOLL
-#define CERNLIB_QASCII
-#define CERNLIB_CFIO
-#define CERNLIB_QMILSTD
-#define CERNLIB_QPRINT
-#define CERNLIB_QDEBUG
-#define CERNLIB_QDEBPRI
-#define CERNLIB_FZALFA
-#define CERNLIB_FZCHANNE
-#define CERNLIB_FZDACC
-#define CERNLIB_FZDACCF
-#define CERNLIB_FZDACCH
-#define CERNLIB_FZDACCL
-#define CERNLIB_FZFFNAT
-#define CERNLIB_FZFORTRA
-#define CERNLIB_FZLIBC
-#define CERNLIB_FZMEMORY
-#define CERNLIB_JZTIME
-#define CERNLIB_RZFRECL
-#define CERNLIB_FQIE3FDC
-#define CERNLIB_FQIE3FSC
-#define CERNLIB_FQIE3TDC
-#define CERNLIB_FQIE3TSC
-#define CERNLIB_FQNEEDCV
-#define CERNLIB_QCDEC
-
-#endif
-
-#ifdef CERNLIB_CRAY
-#define CERNLIB_QXCAPT
-#endif
-
diff --git a/src/packlib/cspack/cspack/pzunit.inc b/src/packlib/cspack/cspack/pzunit.inc
deleted file mode 100644
index bcb4fa5..0000000
--- a/src/packlib/cspack/cspack/pzunit.inc
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: pzunit.inc,v 1.1.1.1 1996/03/08 15:44:17 mclareni Exp $
-*
-* $Log: pzunit.inc,v $
-* Revision 1.1.1.1 1996/03/08 15:44:17 mclareni
-* Cspack
-*
-*
-#ifndef CERNLIB_CSPACK_PZUNIT_INC
-#define CERNLIB_CSPACK_PZUNIT_INC
-*
-*
-* pzunit.inc
-*
- COMMON/PZUNIT/LUNPZI,LUNPZO,LUNPZR,LUNPZF,LUNPZN,PUNPZO
-
-#endif
diff --git a/src/packlib/cspack/cspack/qftitlch.inc b/src/packlib/cspack/cspack/qftitlch.inc
deleted file mode 100644
index 8ceadd7..0000000
--- a/src/packlib/cspack/cspack/qftitlch.inc
+++ /dev/null
@@ -1,10 +0,0 @@
-*
-#ifndef CERNLIB_CSPACK_QFTITLCH_INC
-#define CERNLIB_CSPACK_QFTITLCH_INC
-*
-*
-* qftitlch.inc
-*
-#define CspackTitleFortranString \
-'CSPACK 1.36/01 970107 10:00 CERN PROGRAM LIBRARY CSPACK=Q124'
-#endif
diff --git a/src/packlib/cspack/cspack/quest.inc b/src/packlib/cspack/cspack/quest.inc
deleted file mode 100644
index 72ade69..0000000
--- a/src/packlib/cspack/cspack/quest.inc
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: quest.inc,v 1.1.1.1 1996/03/08 15:44:17 mclareni Exp $
-*
-* $Log: quest.inc,v $
-* Revision 1.1.1.1 1996/03/08 15:44:17 mclareni
-* Cspack
-*
-*
-#ifndef CERNLIB_CSPACK_QUEST_INC
-#define CERNLIB_CSPACK_QUEST_INC
-*
-*
-* quest.inc
-*
- COMMON /QUEST/ IQUEST(100)
-
-#endif
diff --git a/src/packlib/cspack/cspack/rzclun.inc b/src/packlib/cspack/cspack/rzclun.inc
deleted file mode 100644
index 6d07a89..0000000
--- a/src/packlib/cspack/cspack/rzclun.inc
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: rzclun.inc,v 1.1.1.1 1996/03/08 15:44:17 mclareni Exp $
-*
-* $Log: rzclun.inc,v $
-* Revision 1.1.1.1 1996/03/08 15:44:17 mclareni
-* Cspack
-*
-*
-#ifndef CERNLIB_CSPACK_RZCLUN_INC
-#define CERNLIB_CSPACK_RZCLUN_INC
-*
-*
-* rzclun.inc
-*
- COMMON /RZCLUN/LUN,LREC,ISAVE,IMODEX,IRELAT,NHPWD,IHPWD(2)
- +, IZRECL,IMODEC,IMODEH
-
-#endif
diff --git a/src/packlib/cspack/cspack/slate.inc b/src/packlib/cspack/cspack/slate.inc
deleted file mode 100644
index c3ab3fe..0000000
--- a/src/packlib/cspack/cspack/slate.inc
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: slate.inc,v 1.1.1.1 1996/03/08 15:44:17 mclareni Exp $
-*
-* $Log: slate.inc,v $
-* Revision 1.1.1.1 1996/03/08 15:44:17 mclareni
-* Cspack
-*
-*
-#ifndef CERNLIB_CSPACK_SLATE_INC
-#define CERNLIB_CSPACK_SLATE_INC
-*
-*
-* slate.inc
-*
- COMMON/SLATE/IS(40)
-
-#endif
diff --git a/src/packlib/cspack/cspack/szchopt.inc b/src/packlib/cspack/cspack/szchopt.inc
deleted file mode 100644
index 412a774..0000000
--- a/src/packlib/cspack/cspack/szchopt.inc
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: szchopt.inc,v 1.1.1.1 1996/03/08 15:44:18 mclareni Exp $
-*
-* $Log: szchopt.inc,v $
-* Revision 1.1.1.1 1996/03/08 15:44:18 mclareni
-* Cspack
-*
-*
-#ifndef CERNLIB_CSPACK_SZCHOPT_INC
-#define CERNLIB_CSPACK_SZCHOPT_INC
-*
-*
-* szchopt.inc
-*
- IL = INDEX(CHMAIL,'/')
- IR = INDEXB(CHMAIL,'/')
- IF((IL.NE.0).AND.(IR.GT.IL)) THEN
- CHOPT = CHMAIL(IL+1:IR-1)
- ELSE
- CHOPT = ' '
- ENDIF
-*
-
-#endif
diff --git a/src/packlib/cspack/cspack/szmess.inc b/src/packlib/cspack/cspack/szmess.inc
deleted file mode 100644
index ccd4d76..0000000
--- a/src/packlib/cspack/cspack/szmess.inc
+++ /dev/null
@@ -1,40 +0,0 @@
-*
-* $Id: szmess.inc,v 1.4 1996/12/12 16:47:43 jamie Exp $
-*
-* $Log: szmess.inc,v $
-* Revision 1.4 1996/12/12 16:47:43 jamie
-* CPP on IBM seems to pass C comments to Fortran?
-*
-* Revision 1.3 1996/11/18 07:32:51 jamie
-* forgot #endif
-*
-* Revision 1.2 1996/11/15 08:07:09 jamie
-* szmess must be includable multiple times
-*
-* Revision 1.1.1.1 1996/03/08 15:44:18 mclareni
-* Cspack
-*
-*
-* #ifndef CERNLIB_CSPACK_SZMESS_INC
-* #define CERNLIB_CSPACK_SZMESS_INC
-*
-*
-* szmess.inc
-*
-*
-* Send message to client indicating success/failure
-*
- LEND = INDEX(CHM(1:4),' ')
- IF(LEND.EQ.0) LEND = 4
- IF(IRC.EQ.0) THEN
- WRITE(CHMAIL,8001) CHM(1:LEND),IRC
- ELSEIF(IRC.GT.0) THEN
- WRITE(CHMAIL,8002) CHM(1:LEND),IRC
- ELSEIF(IRC.LT.0) THEN
- WRITE(CHMAIL,8003) CHM(1:LEND),IRC
- ENDIF
-
- CALL CZPUTA(CHMAIL,ISTAT)
-*
-
-* #endif
diff --git a/src/packlib/cspack/cspack/tcpsock.inc b/src/packlib/cspack/cspack/tcpsock.inc
deleted file mode 100644
index 9171c6b..0000000
--- a/src/packlib/cspack/cspack/tcpsock.inc
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: tcpsock.inc,v 1.1.1.1 1996/03/08 15:44:17 mclareni Exp $
-*
-* $Log: tcpsock.inc,v $
-* Revision 1.1.1.1 1996/03/08 15:44:17 mclareni
-* Cspack
-*
-*
-#ifndef CERNLIB_CSPACK_TCPSOCK_INC
-#define CERNLIB_CSPACK_TCPSOCK_INC
-*
-*
-* tcpsock.inc
-*
-#define localtime LOCALTIM
-#define ruserpass RUSERPAS
-#define inetd_sock_setup I_SETUP
-#define inetd_sock_close I_CLOSE
-#define server_sock_setup S_SETUP
-#define client_sock_setup C_SETUP
-#define sock_close S_CLOSE
-#define sock_sendstr S_SNDST
-#define sock_recvstr S_RCVST
-#define sock_send S_SEND
-#define sock_recv S_RECV
-#define client_sock_setup_ C__SETU
-#define inetd_sock_setup_ I__SETU
-#define inetd_sock_close_ I__CLOS
-#define server_sock_setup_ S__SETU
-#define sock_close_ S__CLOS
-#define sock_sendstr_ S__SNDS
-#define sock_recvstr_ S__RCVS
-#define sock_send_ S__SEND
-#define sock_recv_ S__RECV
-#define ssendstr_ SSND_ST
-#define srecvstr_ SRCV_ST
-#define initgroups INITGRO
-#define ssendstr SSENSTR
-#define srecvstr SRECSTR
-
-#endif
diff --git a/src/packlib/cspack/cspack/tsosub.inc b/src/packlib/cspack/cspack/tsosub.inc
deleted file mode 100644
index 0d25843..0000000
--- a/src/packlib/cspack/cspack/tsosub.inc
+++ /dev/null
@@ -1,70 +0,0 @@
-*
-* $Id: tsosub.inc,v 1.1.1.1 1996/03/08 15:44:17 mclareni Exp $
-*
-* $Log: tsosub.inc,v $
-* Revision 1.1.1.1 1996/03/08 15:44:17 mclareni
-* Cspack
-*
-*
-#ifndef CERNLIB_CSPACK_TSOSUB_INC
-#define CERNLIB_CSPACK_TSOSUB_INC
-*
-* ext. def. for /TCPAW/TSOSUB and /TSOSER/TSOSER rpc rout.
-*
-* tsosub.inc
-*
-#define TSOSUB 500000000
-#define VERSION 1
-#define TSOSPROC 1
-
-struct info
-{
- char *remote_machine;
- char *remote_user;
- char *remote_tty;
- char *mvs_userid;
- char *mvs_passwd;
- char *tso_command;
- unsigned short mvs_sport;
-} info;
-
-xdr_info(xdrsp,infop)
- XDR *xdrsp;
- struct info *infop;
-{
- if (!xdr_wrapstring(xdrsp,&infop->remote_machine))
- return(0);
- if (!xdr_wrapstring(xdrsp,&infop->remote_user))
- return(0);
- if (!xdr_wrapstring(xdrsp,&infop->remote_tty))
- return(0);
- if (!xdr_wrapstring(xdrsp,&infop->mvs_userid))
- return(0);
- if (!xdr_wrapstring(xdrsp,&infop->mvs_passwd))
- return(0);
- if (!xdr_wrapstring(xdrsp,&infop->tso_command))
- return(0);
- if (!xdr_u_short(xdrsp,&infop->mvs_sport))
- return(0);
- return(1);
-}
-
-struct retn
-{
- char *servreply;
- unsigned short mvs_sport;
-} retn;
-
-xdr_retn(xdrsp,retnp)
- XDR *xdrsp;
- struct retn *retnp;
-{
- if (!xdr_wrapstring(xdrsp,&retnp->servreply))
- return(0);
- if (!xdr_u_short(xdrsp,&retnp->mvs_sport))
- return(0);
- return(1);
-}
-
-
-#endif
diff --git a/src/packlib/cspack/cspack/vmsinf.inc b/src/packlib/cspack/cspack/vmsinf.inc
deleted file mode 100644
index 818dc34..0000000
--- a/src/packlib/cspack/cspack/vmsinf.inc
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: vmsinf.inc,v 1.1.1.1 1996/03/08 15:44:17 mclareni Exp $
-*
-* $Log: vmsinf.inc,v $
-* Revision 1.1.1.1 1996/03/08 15:44:17 mclareni
-* Cspack
-*
-*
-#ifndef CERNLIB_CSPACK_VMSINF_INC
-#define CERNLIB_CSPACK_VMSINF_INC
-*
-*
-* vmsinf.inc
-*
- common/vmsinf/iblk,credat,revdat,expdat,bacdat,chprot,chtype,chuic
- character*23 credat,revdat,expdat,bacdat
- character*23 chprot
- character*20 chtype
- character*30 chuic
-
-
-#endif
diff --git a/src/packlib/cspack/cspack/vmsprot.inc b/src/packlib/cspack/cspack/vmsprot.inc
deleted file mode 100644
index 4a966c2..0000000
--- a/src/packlib/cspack/cspack/vmsprot.inc
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: vmsprot.inc,v 1.1.1.1 1996/03/08 15:44:17 mclareni Exp $
-*
-* $Log: vmsprot.inc,v $
-* Revision 1.1.1.1 1996/03/08 15:44:17 mclareni
-* Cspack
-*
-*
-#ifndef CERNLIB_CSPACK_VMSPROT_INC
-#define CERNLIB_CSPACK_VMSPROT_INC
-*
-*
-* vmsprot.inc
-*
- common/vmsprot/iprot(16)
-
-#endif
diff --git a/src/packlib/cspack/cspack/xzstat.inc b/src/packlib/cspack/cspack/xzstat.inc
deleted file mode 100644
index 8bd1502..0000000
--- a/src/packlib/cspack/cspack/xzstat.inc
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: xzstat.inc,v 1.1.1.1 1996/03/08 15:44:17 mclareni Exp $
-*
-* $Log: xzstat.inc,v $
-* Revision 1.1.1.1 1996/03/08 15:44:17 mclareni
-* Cspack
-*
-*
-#ifndef CERNLIB_CSPACK_XZSTAT_INC
-#define CERNLIB_CSPACK_XZSTAT_INC
-*
-*
-* xzstat.inc
-*
-*
-* Fill IQUEST vector with statistics
-*
- IQUEST(11) = NR
- IQUEST(12) = NKILO
- IQUEST(13) = RATE
- IQUEST(14) = IHOUR
- IQUEST(15) = IMIN
- IQUEST(16) = ISEC
- IQUEST(17) = T
-
-#endif
diff --git a/src/packlib/cspack/cspack/zebra.inc b/src/packlib/cspack/cspack/zebra.inc
deleted file mode 100644
index 5a52190..0000000
--- a/src/packlib/cspack/cspack/zebra.inc
+++ /dev/null
@@ -1,13 +0,0 @@
-*
-* $Id: zebra.inc,v 1.1.1.1 1996/03/08 15:44:16 mclareni Exp $
-*
-* $Log: zebra.inc,v $
-* Revision 1.1.1.1 1996/03/08 15:44:16 mclareni
-* Cspack
-*
-*
-#ifndef CERNLIB_CSPACK_ZEBRA_INC
-#define CERNLIB_CSPACK_ZEBRA_INC
-*
-
-#endif
diff --git a/src/packlib/cspack/cspack/zmach.inc b/src/packlib/cspack/cspack/zmach.inc
deleted file mode 100644
index b0cded6..0000000
--- a/src/packlib/cspack/cspack/zmach.inc
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: zmach.inc,v 1.1.1.1 1996/03/08 15:44:17 mclareni Exp $
-*
-* $Log: zmach.inc,v $
-* Revision 1.1.1.1 1996/03/08 15:44:17 mclareni
-* Cspack
-*
-*
-#ifndef CERNLIB_CSPACK_ZMACH_INC
-#define CERNLIB_CSPACK_ZMACH_INC
-*
-* Machine parameters
-*
-* zmach.inc
-*
-#include "cspack/zmachfix.inc"
- COMMON /ZMACH/ NQBITW,NQBITC,NQCHAW
- +, NQLNOR,NQLMAX,NQLPTH,NQRMAX,IQLPCT,IQNIL
-
-#endif
diff --git a/src/packlib/cspack/cspack/zmachfix.inc b/src/packlib/cspack/cspack/zmachfix.inc
deleted file mode 100644
index 087e65e..0000000
--- a/src/packlib/cspack/cspack/zmachfix.inc
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: zmachfix.inc,v 1.1.1.1 1996/03/08 15:44:17 mclareni Exp $
-*
-* $Log: zmachfix.inc,v $
-* Revision 1.1.1.1 1996/03/08 15:44:17 mclareni
-* Cspack
-*
-*
-#ifndef CERNLIB_CSPACK_ZMACHFIX_INC
-#define CERNLIB_CSPACK_ZMACHFIX_INC
-*
-*
-* zmachfix.inc
-*
- PARAMETER (IQBITW=32, IQBITC=8, IQCHAW=4)
-
-#endif
diff --git a/src/packlib/cspack/cspack/zstate.inc b/src/packlib/cspack/cspack/zstate.inc
deleted file mode 100644
index cffe0e3..0000000
--- a/src/packlib/cspack/cspack/zstate.inc
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: zstate.inc,v 1.1.1.1 1996/03/08 15:44:17 mclareni Exp $
-*
-* $Log: zstate.inc,v $
-* Revision 1.1.1.1 1996/03/08 15:44:17 mclareni
-* Cspack
-*
-*
-#ifndef CERNLIB_CSPACK_ZSTATE_INC
-#define CERNLIB_CSPACK_ZSTATE_INC
-*
-* Program Status parameters
-*
-* zstate.inc
-*
- COMMON /ZSTATE/QVERSN,NQPHAS,IQDBUG,NQDCUT,NQWCUT,NQERR
- +, NQLOGD,NQLOGM,NQLOCK,NQDEVZ,NQAUGM(6)
-
-#endif
diff --git a/src/packlib/cspack/cspack/zunit.inc b/src/packlib/cspack/cspack/zunit.inc
deleted file mode 100644
index b9692d9..0000000
--- a/src/packlib/cspack/cspack/zunit.inc
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: zunit.inc,v 1.1.1.1 1996/03/08 15:44:17 mclareni Exp $
-*
-* $Log: zunit.inc,v $
-* Revision 1.1.1.1 1996/03/08 15:44:17 mclareni
-* Cspack
-*
-*
-#ifndef CERNLIB_CSPACK_ZUNIT_INC
-#define CERNLIB_CSPACK_ZUNIT_INC
-*
-* Logical Unit Numbers
-*
-* zunit.inc
-*
- COMMON /ZUNIT/ IQREAD,IQPRNT,IQPR2,IQLOG,IQPNCH,IQTTIN,IQTYPE
- COMMON /ZUNITZ/IQDLUN,IQFLUN,IQHLUN, NQUSED
-
-#endif
diff --git a/src/packlib/cspack/cz/Imakefile b/src/packlib/cspack/cz/Imakefile
deleted file mode 100644
index 6274d3d..0000000
--- a/src/packlib/cspack/cz/Imakefile
+++ /dev/null
@@ -1,8 +0,0 @@
-SRCS_F= czclos.F czdumm.F czgeta.F czgetc.F czopen.F \ @@\
- czputa.F czputc.F czrand.F czrtim.F czstop.F czswap.F cztcp.F
-
-#if defined(CERNLIB_VAXVMS)
-SRCS_F := $(SRCS_F) czgtlg.F
-#endif
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/cspack/cz/czclos.F b/src/packlib/cspack/cz/czclos.F
deleted file mode 100644
index 9be610c..0000000
--- a/src/packlib/cspack/cz/czclos.F
+++ /dev/null
@@ -1,38 +0,0 @@
-*
-* $Id: czclos.F,v 1.1.1.1 1996/03/08 15:44:23 mclareni Exp $
-*
-* $Log: czclos.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:23 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE CZCLOS(ISTAT)
-*
-* To close socket with remote host HOST
-*
-#include "cspack/czsock.inc"
-#if !defined(CERNLIB_IBM)||defined(CERNLIB_TCPSOCK)
- INTEGER SCLOSE
-*
-* Send close message
-*
- CALL CZPUTA('*CLOSE',ISTAT)
-#endif
-#if defined(CERNLIB_VAXVMS)
- IF(IPROT.NE.0) THEN
- CALL CZDCLS(ISTAT)
- RETURN
- ENDIF
-#endif
-#if !defined(CERNLIB_IBM)||defined(CERNLIB_TCPSOCK)
-*
- ISTAT = SCLOSE(ISKIN)
-#endif
-#if (defined(CERNLIB_IBM))&&(!defined(CERNLIB_TCPSOCK))
- CALL SCLOSE(ISKIN)
-#endif
- ISTAT=0
-*
- END
-
diff --git a/src/packlib/cspack/cz/czdumm.F b/src/packlib/cspack/cz/czdumm.F
deleted file mode 100644
index 9d4e980..0000000
--- a/src/packlib/cspack/cz/czdumm.F
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: czdumm.F,v 1.1.1.1 1996/03/08 15:44:24 mclareni Exp $
-*
-* $Log: czdumm.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:24 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE CZDUMM
-#if (defined(CERNLIB_VAXVMS))&&(defined(CERNLIB_CLIENT))
- ENTRY CTL$GL_PCB
- ENTRY CTL$T_ACCOUNT
- ENTRY CTL$T_USERNAME
-#endif
- END
diff --git a/src/packlib/cspack/cz/czgeta.F b/src/packlib/cspack/cz/czgeta.F
deleted file mode 100644
index 6d36abb..0000000
--- a/src/packlib/cspack/cz/czgeta.F
+++ /dev/null
@@ -1,36 +0,0 @@
-*
-* $Id: czgeta.F,v 1.1.1.1 1996/03/08 15:44:24 mclareni Exp $
-*
-* $Log: czgeta.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:24 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE CZGETA(CHMAIL,ISTAT)
-*
-* To get the string CHMAIL from a remote host
-*
-#include "cspack/czsock.inc"
- CHARACTER*(*) CHMAIL
- DIMENSION IHMAIL(40),ICONTR(2)
-*
-#if defined(CERNLIB_VAXVMS)
- IF(IPROT.NE.0) THEN
- CALL CZDGTA(CHMAIL,ISTAT)
- RETURN
- ENDIF
-#endif
- CALL JUMPST(IADTCP)
- NCH=LEN(CHMAIL)
- IF(NCH.GT.80)NCH=80
- ICONTR(1)=2
- ICONTR(2)=20
- CALL VBLANK(IHMAIL,20)
- CALL JUMPX2(IHMAIL,ICONTR)
-* CALL CZTCP(IHMAIL,ICONTR)
- CALL UHTOC(IHMAIL,4,CHMAIL,NCH)
- ISTAT=ICONTR(1)
-*
- END
-
diff --git a/src/packlib/cspack/cz/czgetc.F b/src/packlib/cspack/cz/czgetc.F
deleted file mode 100644
index 36d854c..0000000
--- a/src/packlib/cspack/cz/czgetc.F
+++ /dev/null
@@ -1,51 +0,0 @@
-*
-* $Id: czgetc.F,v 1.1.1.1 1996/03/08 15:44:24 mclareni Exp $
-*
-* $Log: czgetc.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:24 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE CZGETC(NTOT,ISTAT)
-*
-* To receive NTOT characters in CBUF
-*
-#include "cspack/czsock.inc"
-#include "cspack/czbuff.inc"
- INTEGER SRECVSTR
-*
-#if defined(CERNLIB_VAXVMS)
- IF(IPROT.NE.0) THEN
- CALL CZDGTC(NTOT,ISTAT)
- RETURN
- ENDIF
-#endif
- NMAX=NTOT
-#if (!defined(CERNLIB_IBM))&&(!defined(CERNLIB_VAXVMS))
- NBYTES=SRECVSTR(ISKIN,CHBUF,NMAX)
-* NBYTES=SRECVSTR(ISKIN,ICBUF,NMAX)
-#endif
-#if (defined(CERNLIB_VAXVMS))&&(!defined(CERNLIB_IBM))
- NBYTES=SRECVSTR(ISKIN,CHBUF,NMAX)
-#endif
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB_TCPSOCK))
- NBYTES=SRECVSTR(ISKIN,CHBUF,NMAX)
-#endif
-#if (defined(CERNLIB_IBM))&&(!defined(CERNLIB_TCPSOCK))
- CALL SRECV(ISKIN,CHBUF,NMAX,NBYTES)
-#endif
- IF(NBYTES.LT.NTOT)THEN
- IF(LUNCZ.NE.0)WRITE(LUNCZ,*)'Problem in receiving text'
- ISTAT=NBYTES+1
- ELSE
- ISTAT=0
- ntot = nbytes
- ENDIF
-#if defined(CERNLIB_DEBUG)
- IF(LUNCZ.NE.0)WRITE(LUNCZ,1103)NBYTES,CHBUF(1:80)
- 1103 FORMAT(' CZGETC receiving',I10,' bytes :',/,1X,A)
-#endif
-*
- END
-
diff --git a/src/packlib/cspack/cz/czgtlg.F b/src/packlib/cspack/cz/czgtlg.F
deleted file mode 100644
index 9c3bfee..0000000
--- a/src/packlib/cspack/cz/czgtlg.F
+++ /dev/null
@@ -1,66 +0,0 @@
-*
-* $Id: czgtlg.F,v 1.1.1.1 1996/03/08 15:44:24 mclareni Exp $
-*
-* $Log: czgtlg.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:24 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
-#if defined(CERNLIB_VAXVMS)
- SUBROUTINE CZGTLG(LOGNAM,EQUNAM,TABNAM,IRC)
- IMPLICIT INTEGER (S)
-#include "cspack/czunit.inc"
- CHARACTER*(*) LOGNAM,EQUNAM,TABNAM
-
- STRUCTURE /ITMLST/
- UNION
- MAP
- INTEGER*2 BUFFER_LENGTH
- INTEGER*2 ITEM_CODE
- INTEGER*4 BUFFER_ADDRESS
- INTEGER*4 RETURN_LENGTH_ADDRESS
- ENDMAP
- MAP
- INTEGER*4 END_LIST /0/
- ENDMAP
- END UNION
- END STRUCTURE
-
- RECORD /ITMLST/ LNM_LIST(2)
-
- INCLUDE '($LNMDEF)'
- INCLUDE '($SSDEF)'
-
- CHARACTER*80 MESS
-
-*
- IRC = 0
-
- LBUF = 132
- LNM_LIST(1).BUFFER_LENGTH = LBUF
- LNM_LIST(1).ITEM_CODE = LNM$_STRING
- LNM_LIST(1).BUFFER_ADDRESS = %LOC(EQUNAM)
- LNM_LIST(1).RETURN_LENGTH_ADDRESS = %LOC(LNAM)
-
- LNM_LIST(2).END_LIST = 0
-
- LENLOG = LENOCC(LOGNAM)
- LENTAB = LENOCC(TABNAM)
- IF(IDEBXZ.GE.3) PRINT *,'CZGTLG. attempting translation of ',
- + LOGNAM(1:LENLOG),' from table ',TABNAM(1:LENTAB)
-
- STATUS = SYS$TRNLNM(,TABNAM(1:LENTAB)
- + ,LOGNAM(1:LENLOG),,LNM_LIST)
- IF (.NOT. STATUS) THEN
- IF(IDEBXZ.GE.0) THEN
- IC = SYS$GETMSG(%VAL(STATUS),LMESS,MESS,,)
-* PRINT *,'CZGTLG. error translating logical name - ',
-* + MESS(1:LMESS)
- ENDIF
- IRC = 1
- ENDIF
-
- END
-
-#endif
diff --git a/src/packlib/cspack/cz/czopen.F b/src/packlib/cspack/cz/czopen.F
deleted file mode 100644
index 5cf36c2..0000000
--- a/src/packlib/cspack/cz/czopen.F
+++ /dev/null
@@ -1,113 +0,0 @@
-*
-* $Id: czopen.F,v 1.2 2005/04/18 15:23:08 mclareni Exp $
-*
-* $Log: czopen.F,v $
-* Revision 1.2 2005/04/18 15:23:08 mclareni
-* Mods submitted by Kevin B. McCarty to fix insecure Cernlib uses of /tmp.
-*
-* Revision 1.1.1.1 1996/03/08 15:44:23 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE CZOPEN(CHSERV,HOST,ISTAT)
-*
-*****************************************************************
-* *
-* The PAW/ZEBRA communication package utility *
-* Current implementation based on TCP/IP *
-* *
-* Author: Rene Brun CERN/DD *
-* with the collaboration of Ben Segal (DD) *
-* for the interface with the TCPAW (C) system *
-* *
-* To open socket with remote host HOST *
-* *
-*****************************************************************
-*
-#include "cspack/czsock.inc"
-#include "cspack/czunit.inc"
- COMMON/CDBUF/DBUF(10)
- CHARACTER*(*) HOST,CHSERV
-*
-* Need to copy HOST to HOST1 for passing correctly
-* the parameter HOST to the C routine
-* Apollo bug with CHARACTER*(*) and C !!!
-*
- CHARACTER*80 HOST1
- INTEGER CSETUP
-#if !defined(CERNLIB_IBM)
- CHARACTER*20 SERVICE
-#endif
-#if defined(CERNLIB_IBM)
- CHARACTER*80 SERVICE
-#endif
-#if (defined(CERNLIB_APOLLO))&&(defined(CERNLIB__LOG))
- CHARACTER*26 CHFILE
-#endif
- EXTERNAL CZTCP
-
- LUNFZI = 999
- LUNFZO = 998
-#if defined(CERNLIB_VAXVMS)
- IF(IPROT.EQ.1) THEN
- CALL CZDOPN(CHSERV,HOST,ISTAT)
- RETURN
- ENDIF
-#endif
-*
- IF(IADTCP.EQ.0)THEN
-#if defined(CERNLIB_VAXVMS)
-*
-* Setup of C run time
-*
-#endif
-#if (defined(CERNLIB_VAXVMS))&&(!defined(CERNLIB_QCDEC))
- CALL VAXC$CRTL_INIT
-#endif
-#if (defined(CERNLIB_VAXVMS))&&(defined(CERNLIB_QCDEC))
- CALL DECC$VAXC$CRTL_INIT
-#endif
- LBUF=270
- CALL FZFILE(LUNFZI,LBUF,'SIOC')
- CALL FZHOOK(LUNFZI,CZTCP,DBUF)
- CALL FZFILE(LUNFZO,LBUF,'SOC')
- CALL FZHOOK(LUNFZO,CZTCP,DBUF)
- IADTCP=JUMPAD(CZTCP)
- CALL JUMPST(IADTCP)
- ENDIF
-*
-#if !defined(CERNLIB_APOLLO)
- LUNCZ=6
-#endif
-#if (defined(CERNLIB_APOLLO))&&(defined(CERNLIB__LOG))
- LUNCZ=77
- CHFILE=' '
- CALL DATIME(ND,NT)
- WRITE(CHFILE,1000)ND,NT
- 1000 FORMAT('/var/log/cz',I6,I4,'.log')
- DO 10 I=11,23
- IF(CHFILE(I:I).EQ.' ')CHFILE(I:I)='0'
- 10 CONTINUE
- OPEN(UNIT=LUNCZ,FILE=CHFILE,STATUS='UNKNOWN')
-#endif
- SERVICE=CHSERV
- HOST1=HOST
-*
- CALL CUTOL(SERVICE)
-#if !defined(CERNLIB_IBM)||defined(CERNLIB_TCPSOCK)
- ISOCK = CSETUP(HOST1,ISKIN,ISKOUT,SERVICE)
-#endif
-#if (defined(CERNLIB_IBM))&&(!defined(CERNLIB_TCPSOCK))
- CALL CSETUP(HOST1,ISOCK,SERVICE)
- ISKIN = ISOCK
- ISKOUT = ISOCK
-#endif
- IF(ISOCK.LT.0)THEN
- ISTAT=IABS(ISOCK)
- ELSE
- ISTAT=0
- ENDIF
-
-*
- END
diff --git a/src/packlib/cspack/cz/czputa.F b/src/packlib/cspack/cz/czputa.F
deleted file mode 100644
index 12c8912..0000000
--- a/src/packlib/cspack/cz/czputa.F
+++ /dev/null
@@ -1,36 +0,0 @@
-*
-* $Id: czputa.F,v 1.1.1.1 1996/03/08 15:44:24 mclareni Exp $
-*
-* $Log: czputa.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:24 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE CZPUTA(CHMAIL,ISTAT)
-*
-* To send the string CHMAIL to a remote host
-*
- CHARACTER*(*) CHMAIL
- DIMENSION IHMAIL(40),ICONTR(2)
-#include "cspack/czsock.inc"
-*
-*
-#if defined(CERNLIB_VAXVMS)
- IF(IPROT.NE.0) THEN
- CALL CZDPTA(CHMAIL,ISTAT)
- RETURN
- ENDIF
-#endif
- CALL JUMPST(IADTCP)
- NCH=LEN(CHMAIL)
- IF(NCH.GT.80)NCH=80
- ICONTR(1)=3
- ICONTR(2)=20
- CALL VBLANK(IHMAIL,20)
- CALL UCTOH(CHMAIL,IHMAIL,4,NCH)
- CALL JUMPX2(IHMAIL,ICONTR)
-* CALL CZTCP(IHMAIL,ICONTR)
- ISTAT=ICONTR(1)
-*
- END
diff --git a/src/packlib/cspack/cz/czputc.F b/src/packlib/cspack/cz/czputc.F
deleted file mode 100644
index 56e1fc5..0000000
--- a/src/packlib/cspack/cz/czputc.F
+++ /dev/null
@@ -1,83 +0,0 @@
-*
-* $Id: czputc.F,v 1.1.1.1 1996/03/08 15:44:24 mclareni Exp $
-*
-* $Log: czputc.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:24 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE CZPUTC(NTOT,ISTAT)
-*
-* To send NTOT characters from CBUF
-*
-#include "cspack/czsock.inc"
-#include "cspack/czbuff.inc"
- INTEGER SSENDSTR
-*
- ISTAT = 0
- IF(NTOT.LE.0) RETURN
-#if defined(CERNLIB_DEBUG)
- IF(LUNCZ.NE.0)WRITE(LUNCZ,9001)NTOT
- 9001 FORMAT(' CZPUTC: sending',I10,' bytes')
- 9002 FORMAT(A)
- IF(NTOT.LT.80)THEN
- IF(LUNCZ.NE.0)WRITE(LUNCZ,9002)CHBUF(1:NTOT)
- ELSE
- IF(LUNCZ.NE.0)WRITE(LUNCZ,9002)CHBUF(1:80)
- ND=MIN(NTOT,159)
- IF(LUNCZ.NE.0)WRITE(LUNCZ,9002)CHBUF(81:ND)
- ENDIF
-#endif
-#if defined(CERNLIB_VAXVMS)
- IF(IPROT.NE.0) THEN
- CALL CZDPTC(NTOT,ISTAT)
- RETURN
- ENDIF
-#endif
-*
-#if !defined(CERNLIB_IBM)
- NBYTES=SSENDSTR(ISKOUT,CHBUF,NTOT)
-#endif
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB_TCPSOCK))
- NBYTES=SSENDSTR(ISKOUT,CHBUF,NTOT)
-#endif
-#if (defined(CERNLIB_IBM))&&(!defined(CERNLIB_TCPSOCK))
-*
-* Fix for crummy IBM TCP/IP
-*
- IF(NTOT.LE.8192) THEN
- CALL SSEND(ISKOUT,CHBUF,NTOT,NBYTES)
- ELSE
- NLOOP = NTOT/8192
- NREST = MOD(NTOT,8192)
- IREC = 1
- NBYTES = 0
- NSEND = 8192
-
- DO 10 JLOOP=1,NLOOP
- CALL SSEND(ISKOUT,CHBUF(IREC:IREC+NSEND-1),NSEND,NSENT)
- IF(NSENT.LT.NSEND) GOTO 20
- IREC = IREC + NSEND
- NBYTES = NBYTES + NSENT
- 10 CONTINUE
-
- IF(NREST.GT.0) THEN
- CALL SSEND(ISKOUT,CHBUF(IREC:NBYTES),NREST,NSENT)
- IF(NSENT.LT.NSEND) GOTO 20
- NBYTES = NBYTES + NSENT
- ENDIF
-
- ENDIF
-
- 20 CONTINUE
-#endif
- IF(NBYTES.LT.NTOT)THEN
- IF(LUNCZ.NE.0) WRITE(LUNCZ,9003) NBYTES,NTOT
-9003 FORMAT(' Problem in sending text - NBYTES/NTOT = ',2I6)
- ISTAT=NBYTES
- ELSE
- ISTAT=0
- ENDIF
-*
- END
diff --git a/src/packlib/cspack/cz/czrand.F b/src/packlib/cspack/cz/czrand.F
deleted file mode 100644
index 9abc27b..0000000
--- a/src/packlib/cspack/cz/czrand.F
+++ /dev/null
@@ -1,30 +0,0 @@
-*
-* $Id: czrand.F,v 1.1.1.1 1996/03/08 15:44:24 mclareni Exp $
-*
-* $Log: czrand.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:24 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE CZRAND(CHRAND)
- CHARACTER*(*) CHRAND
- CHARACTER*9 CHTEMP
-#include "cspack/slate.inc"
- DATA NENTRY/0/
- SAVE NENTRY
-
- IF(NENTRY.EQ.0) THEN
- CALL DATIME(ID,IT)
- I = 0
- J = 0
- CALL RMARIN(IT*100+IS(6),I,J)
- NENTRY = 1
- ENDIF
-
- CALL RANMAR(X,1)
-
- WRITE(CHTEMP,'(F9.8)') X
- CHRAND = CHTEMP(2:)
-
- END
diff --git a/src/packlib/cspack/cz/czrtim.F b/src/packlib/cspack/cz/czrtim.F
deleted file mode 100644
index 464a467..0000000
--- a/src/packlib/cspack/cz/czrtim.F
+++ /dev/null
@@ -1,87 +0,0 @@
-*
-* $Id: czrtim.F,v 1.1.1.1 1996/03/08 15:44:23 mclareni Exp $
-*
-* $Log: czrtim.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:23 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE CZRTIM(ELAPSD)
-*
-********************************************************************************
-*
-* Routine functionally equivalent to TIMED, but for real time
-*
-* (copied from KUIP)
-*
-********************************************************************************
-*
- CHARACTER*8 ELAPSD
- INTEGER ND(2),NT(2)
- CHARACTER*8 CD,CT
- CHARACTER*(*) DIGIT
- PARAMETER (DIGIT='0123456789')
- INTEGER MONTH(0:12)
- SAVE IOLDAY,IOLSEC
- DATA IOLDAY,IOLSEC /0,0/
- DATA MONTH /0,31,59,90,120,151,181,212,243,273,304,334,365/
-*
- CALL DATIMH(ND,NT)
- CALL UHTOC(ND,4,CD,8)
- CALL UHTOC(NT,4,CT,8)
-*
-* Convert date into number of days from start of year
-*
- NHIGH=INDEX(DIGIT,CD(1:1))-1
- NLOW=INDEX(DIGIT,CD(2:2))-1
- NDAY=NHIGH*10+NLOW
-
- NHIGH=INDEX(DIGIT,CD(4:4))-1
- NLOW=INDEX(DIGIT,CD(5:5))-1
- NMONTH=NHIGH*10+NLOW
-
- NHIGH=INDEX(DIGIT,CD(7:7))-1
- NLOW=INDEX(DIGIT,CD(8:8))-1
- NYEAR=NHIGH*10+NLOW
-
- IDAY=NDAY-1+MONTH(NMONTH-1)
- IF ((NYEAR/4)*4.EQ.NYEAR.AND.NMONTH.GT.2) IDAY=IDAY+1
-*
-* Convert time into number of seconds from start of day
-*
- NHIGH=INDEX(DIGIT,CT(1:1))-1
- NLOW=INDEX(DIGIT,CT(2:2))-1
- NHOUR=NHIGH*10+NLOW
-
- NHIGH=INDEX(DIGIT,CT(4:4))-1
- NLOW=INDEX(DIGIT,CT(5:5))-1
- NMINUT=NHIGH*10+NLOW
-
- NHIGH=INDEX(DIGIT,CT(7:7))-1
- NLOW=INDEX(DIGIT,CT(8:8))-1
- NSECON=NHIGH*10+NLOW
-
- ISEC=NSECON+NMINUT*60+NHOUR*3600
-*
-* Compute the elapsed time from previous call (in HH:MM:SS format)
-*
- IDELAP=IDAY-IOLDAY
- ISELAP=ISEC-IOLSEC
- IOLSEC=ISEC
- IOLDAY=IDAY
- ISEC=MOD(ISELAP,60)
- IMINUT=(MOD(ISELAP,3600)-ISEC)/60
- IHOUR=ISELAP/3600+IDELAP*24
- IF (IHOUR.GT.99) THEN
- WRITE(ELAPSD,1100) IMINUT,ISEC
- ELSE
- WRITE(ELAPSD,1000) IHOUR,IMINUT,ISEC
- ENDIF
-
-1000 FORMAT(I2.2,':',I2.2,':',I2.2)
-1100 FORMAT('**:',I2.2,':',I2.2)
-
- END
-
-
diff --git a/src/packlib/cspack/cz/czstop.F b/src/packlib/cspack/cz/czstop.F
deleted file mode 100644
index c1190fe..0000000
--- a/src/packlib/cspack/cz/czstop.F
+++ /dev/null
@@ -1,91 +0,0 @@
-*
-* $Id: czstop.F,v 1.1.1.1 1996/03/08 15:44:24 mclareni Exp $
-*
-* $Log: czstop.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:24 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE CZSTOP(ICODE)
-#include "cspack/czsock.inc"
-
- ISTOP = IABS(ICODE)
-
-#if defined(CERNLIB_VAXVMS)
-
- CALL SYS$EXIT(%VAL(ISTOP))
-
-#endif
-#if !defined(CERNLIB_VAXVMS)
-
- GOTO (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20),ISTOP
-
- IF(ISTOP.LE.0.OR.ISTOP.GT.20)THEN
- IF(LUNCZ.NE.0)WRITE(LUNCZ,*)' Error in ISTOP'
- STOP 255
- ENDIF
-
-1 CONTINUE
- STOP 1
-
-2 CONTINUE
- STOP 2
-
-3 CONTINUE
- STOP 3
-
-4 CONTINUE
- STOP 4
-
-5 CONTINUE
- STOP 5
-
-6 CONTINUE
- STOP 6
-
-7 CONTINUE
- STOP 7
-
-8 CONTINUE
- STOP 8
-
-9 CONTINUE
- STOP 9
-
-10 CONTINUE
- STOP 10
-
-11 CONTINUE
- STOP 11
-
-12 CONTINUE
- STOP 12
-
-13 CONTINUE
- STOP 13
-
-14 CONTINUE
- STOP 14
-
-15 CONTINUE
- STOP 15
-
-16 CONTINUE
- STOP 16
-
-17 CONTINUE
- STOP 17
-
-18 CONTINUE
- STOP 18
-
-19 CONTINUE
- STOP 19
-
-20 CONTINUE
- STOP 20
-
-#endif
-
- END
diff --git a/src/packlib/cspack/cz/czswap.F b/src/packlib/cspack/cz/czswap.F
deleted file mode 100644
index 4b3f330..0000000
--- a/src/packlib/cspack/cz/czswap.F
+++ /dev/null
@@ -1,57 +0,0 @@
-*
-* $Id: czswap.F,v 1.1.1.1 1996/03/08 15:44:23 mclareni Exp $
-*
-* $Log: czswap.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:23 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE CZSWAP(NODE,LUN,ISTAT)
-#include "cspack/czsock.inc"
-#include "cspack/czunit.inc"
- CHARACTER*(*) NODE
- SAVE JSVIN,JSVOUT
-*
-* Swap according to LUN or NODE
-*
- ISTAT = 0
- LN = LENOCC(NODE)
-
- IF(IDEBXZ.GE.3) PRINT *,'CZSWAP. enter for NODE,LUN = ',NODE,LUN
-
- IF(LN.NE.0) THEN
-
- IF(IDEBXZ.GE.3) PRINT *,'CZSWAP. swap by node...'
- INODE = ICNTH(NODE(1:LN),CHNODE,MAXSOC)
- IF(INODE.EQ.0) THEN
- ISTAT = -1
- RETURN
- ENDIF
-*
-* Reset input and output socket numbers, saving old settings
-*
- JSVIN = ISKIN
- JSVOUT = ISKOUT
- ISKIN = JSKIN (INODE)
- ISKOUT = JSKOUT(INODE)
-
- ELSEIF(LUN.GT.0) THEN
-*
-* Reset input and output socket numbers, saving old settings
-*
- IF(IDEBXZ.GE.3) PRINT *,'CZSWAP. swap by LUN...'
- JSVIN = ISKIN
- JSVOUT = ISKOUT
- ISKIN = JSKIN (LUN)
- ISKOUT = JSKOUT(LUN)
- ELSE
-*
-* Restore input and output socket numbers
-*
- ISKIN = JSVIN
- ISKOUT = JSVOUT
- ENDIF
-
- END
-
diff --git a/src/packlib/cspack/cz/cztcp.F b/src/packlib/cspack/cz/cztcp.F
deleted file mode 100644
index c94d629..0000000
--- a/src/packlib/cspack/cz/cztcp.F
+++ /dev/null
@@ -1,186 +0,0 @@
-*
-* $Id: cztcp.F,v 1.1.1.1 1996/03/08 15:44:24 mclareni Exp $
-*
-* $Log: cztcp.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:24 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE CZTCP(IBUF,ICONTR)
-#include "cspack/czsock.inc"
- COMMON/QUEST/IQUEST(100)
- CHARACTER*80 CHMAIL
- INTEGER SRECV,SSEND
- INTEGER SRECVSTR,SSENDSTR
- DIMENSION IBUF(1),IHAND(4)
- DIMENSION ICONTR(2)
- CHARACTER*4 HAND
-*
-#if defined(CERNLIB_VAXVMS)
- IF(IPROT.NE.0) THEN
- CALL CZDNET(IBUF,ICONTR)
- RETURN
- ENDIF
-#endif
- ICASE=ICONTR(1)+1
- IF(ICASE.LT.3)THEN
- NBYTES=4*LBUF
- ELSE
- NBYTES=ICONTR(2)*4
- ENDIF
-* PRINT *,'CZTCP enter for ICASE/NBYTES = ',ICASE,NBYTES
- GO TO (100,200,300,400),ICASE
- IF(ICASE.LE.0.OR.ICASE.GT.4)THEN
- IF(LUNCZ.NE.0)WRITE(LUNCZ,*)' Error in ICASE'
- RETURN
- ENDIF
-*
-* Receive Binary
-*
- 100 NTOT=NBYTES
- ISTAT=0
- NMAX=NTOT
-#if !defined(CERNLIB_IBM)||defined(CERNLIB_TCPSOCK)
- NBYTES=SRECV(ISKIN,IBUF,NMAX)
-#endif
-#if (defined(CERNLIB_IBM))&&(!defined(CERNLIB_TCPSOCK))
- CALL BRECV(ISKIN,IBUF,NMAX,NBYTES)
-#endif
-#if defined(CERNLIB_TCPSOCK)
-* IF(NBYTES.EQ.0) NBYTES = NMAX
-* nbytes = nmax
-#endif
- IF(NBYTES.NE.NMAX)THEN
- IF(LUNCZ.NE.0)WRITE(LUNCZ,*)'Problem in receiving Binary'
- ISTAT=1
- ELSE
- ISTAT=0
- ENDIF
- IQUEST(1)=ISTAT
-#if defined(CERNLIB_DEBUG)
- IF(LUNCZ.NE.0)WRITE(LUNCZ,1101)NBYTES
- 1101 FORMAT(' CZTCP receiving',I10,' bytes')
-#endif
- GO TO 999
-*
-* Send Binary
-*
- 200 NSEND=0
- IREC=1
-#if defined(CERNLIB_DEBUG)
- IF(LUNCZ.NE.0)WRITE(LUNCZ,1102)NBYTES
- 1102 FORMAT(' CZTCP sending',I10,' bytes')
- IF(LUNCZ.NE.0)WRITE(LUNCZ,'(10Z9)') (IBUF(I),I=1,10)
-#endif
-#if !defined(CERNLIB_IBM)||defined(CERNLIB_TCPSOCK)
- 210 NSEND=SSEND(ISKOUT,IBUF(IREC),NBYTES)
-#endif
-#if defined(CERNLIB_TCPSOCK)
-* IF((NSEND.EQ.0).OR.(NSEND.GT.NBYTES)) NSEND = NBYTES
-#endif
-#if (defined(CERNLIB_IBM))&&(!defined(CERNLIB_TCPSOCK))
-*
-* Fix for crummy IBM TCP/IP
-*
- IF(NBYTES.LE.8192) THEN
- 210 CALL BSEND(ISKOUT,IBUF(IREC),NBYTES,NSEND)
- ELSE
- NLOOP = NBYTES/8192
- NREST = MOD(NBYTES,8192)
- DO 211 JLOOP=1,NLOOP
- CALL BSEND(ISKOUT,IBUF(IREC),8192,NSEND)
- IREC = IREC + 8192
-211 CONTINUE
- CALL BSEND(ISKOUT,IBUF(IREC),NREST,NSEND)
- NSEND = NBYTES
- ENDIF
-#endif
- IF(NSEND.NE.NBYTES)THEN
- ISTAT=NSEND-NBYTES
- IF(LUNCZ.NE.0)WRITE(LUNCZ,*)
- + 'Problem in sending binary, NSEND/NBYTES = ',
- + NSEND,NBYTES
- ELSE
- ISTAT=0
- ENDIF
- IQUEST(1)=ISTAT
- GO TO 999
-*
-* Receive Character
-*
- 300 CONTINUE
- NMAX=80
- HAND='CZOK'
-#if (defined(CERNLIB_OS9))&&(!defined(CERNLIB_IBM))
- NBYTES=SRECVSTR(ISKIN,IBUF,NMAX)
- IF(NBYTES.NE.NMAX)GO TO 350
- NK=SSENDSTR(ISKOUT,IHAND,4)
-#endif
-#if (!defined(CERNLIB_IBM))&&(!defined(CERNLIB_OS9))
- NBYTES=SRECVSTR(ISKIN,CHMAIL,NMAX)
- IF(NBYTES.NE.NMAX)GO TO 350
- NK=SSENDSTR(ISKOUT,HAND,4)
-#endif
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB_TCPSOCK))
- NBYTES=SRECVSTR(ISKIN,CHMAIL,NMAX)
- IF(NBYTES.NE.NMAX)GO TO 350
- NK=SSENDSTR(ISKOUT,HAND,4)
-#endif
-#if (defined(CERNLIB_IBM))&&(!defined(CERNLIB_TCPSOCK))
- CALL SRECV(ISKIN,CHMAIL,NMAX,NBYTES)
- IF(NBYTES.NE.NMAX)GO TO 350
- CALL SSEND(ISKOUT,HAND,4,NK)
-#endif
- ICONTR(1)=0
-#if !defined(CERNLIB_OS9)
- CALL UCTOH(CHMAIL,IBUF,4,80)
-#endif
-#if defined(CERNLIB_DEBUG)
- IF(LUNCZ.NE.0)WRITE(LUNCZ,1103)NBYTES,(IBUF(I),I=1,20)
- 1103 FORMAT(' CZTCP receiving',I4,' characters',/,1X,20A4)
-#endif
- GO TO 999
- 350 ICONTR(1)=1
- IF(LUNCZ.NE.0)WRITE(LUNCZ,*)'Problem in receiving character'
- GO TO 999
-*
-* Send Character
-*
- 400 CHMAIL=' '
-#if (defined(CERNLIB_OS9))&&(!defined(CERNLIB_IBM))
- NSEND=SSENDSTR(ISKOUT,IBUF,NBYTES)
- IF(NSEND.NE.NBYTES)GO TO 450
- NK=SRECVSTR(ISKIN,IHAND,4)
-#endif
-#if (!defined(CERNLIB_OS9))&&(!defined(CERNLIB_IBM))
- CALL UHTOC(IBUF,4,CHMAIL,NBYTES)
- NSEND=SSENDSTR(ISKOUT,CHMAIL,NBYTES)
- IF(NSEND.NE.NBYTES)GO TO 450
- NK=SRECVSTR(ISKIN,HAND,4)
-#endif
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB_TCPSOCK))
- CALL UHTOC(IBUF,4,CHMAIL,NBYTES)
- NSEND=SSENDSTR(ISKOUT,CHMAIL,NBYTES)
- IF(NSEND.NE.NBYTES)GO TO 450
- NK=SRECVSTR(ISKIN,HAND,4)
-#endif
-#if (defined(CERNLIB_IBM))&&(!defined(CERNLIB_TCPSOCK))
- CALL UHTOC(IBUF,4,CHMAIL,NBYTES)
- CALL SSEND(ISKOUT,CHMAIL,NBYTES,NSEND)
- IF(NSEND.NE.NBYTES)GO TO 450
- CALL SRECV(ISKIN,HAND,4,NK)
-#endif
- ICONTR(1)=0
-#if defined(CERNLIB_DEBUG)
- IF(LUNCZ.NE.0)WRITE(LUNCZ,1104)NSEND,(IBUF(I),I=1,20)
- 1104 FORMAT(' CZTCP sending',I4,' characters',/,1X,20A4)
-#endif
- GO TO 999
- 450 ICONTR(1)=1
- IF(LUNCZ.NE.0)WRITE(LUNCZ,*)
- + 'Problem in sending character, NSEND/NBYTES = ',
- + NSEND,NBYTES
-*
- 999 END
-
diff --git a/src/packlib/cspack/czdnet/Imakefile b/src/packlib/cspack/czdnet/Imakefile
deleted file mode 100644
index 2105e88..0000000
--- a/src/packlib/cspack/czdnet/Imakefile
+++ /dev/null
@@ -1,4 +0,0 @@
-SRCS_F= czdcls.F czdgta.F czdgtc.F czdgts.F czdnet.F czdopn.F \ @@\
- czdpta.F czdptc.F czdpts.F czrdtne.F czrdtrm.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/cspack/czdnet/czdcls.F b/src/packlib/cspack/czdnet/czdcls.F
deleted file mode 100644
index 140bb77..0000000
--- a/src/packlib/cspack/czdnet/czdcls.F
+++ /dev/null
@@ -1,37 +0,0 @@
-*
-* $Id: czdcls.F,v 1.1.1.1 1996/03/08 15:44:25 mclareni Exp $
-*
-* $Log: czdcls.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:25 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE CZDCLS( ISTAT )
-************************************************************************
-*.
-*... CZCLOS to close connection with remote host.
-*.
-*.
-*. Author : B.Holl
-*. Version : 1.00
-*. Created : 05-Apr-1990
-*. Last Mod:
-*.
-*. Modification Log.
-*.
-*.**********************************************************************
-*
-#include "cspack/czdecnet.inc"
-#include "cspack/czsock.inc"
-*
- INTEGER ISTAT
-*
-*.......................................................................
-*
- CLOSE( UNIT=LUNDEC )
- ISKIN = 0
- ISKOUT= 0
- ISTAT = 0
- END
-
diff --git a/src/packlib/cspack/czdnet/czdgta.F b/src/packlib/cspack/czdnet/czdgta.F
deleted file mode 100644
index 95efc6b..0000000
--- a/src/packlib/cspack/czdnet/czdgta.F
+++ /dev/null
@@ -1,36 +0,0 @@
-*
-* $Id: czdgta.F,v 1.1.1.1 1996/03/08 15:44:24 mclareni Exp $
-*
-* $Log: czdgta.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:24 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE CZDGTA(CHMAIL,ISTAT)
-#include "cspack/czdecnet.inc"
-#include "cspack/czsock.inc"
-#include "cspack/czunit.inc"
-*
- CHARACTER*(*) CHMAIL
- CHARACTER*80 CHTEMP
-*
- INTEGER NCH, ISTAT
-*
- NCH = LEN(CHMAIL)
- IF(NCH.GT.80) NCH = 80
- CHTEMP = ' '
- READ(UNIT=LUNDEC,FMT='(A80)',END=99,ERR=98) CHTEMP
- CHMAIL(1:NCH) = CHTEMP(1:NCH)
- ISTAT = 0
- IF(IDEBXZ.GE.3) PRINT *,'CZGPTA. read ',
- + CHMAIL(1:NCH)
- RETURN
-98 CONTINUE
- WRITE(LUNCZ,'(1X,A,I4)') '**** CZDGTA read error on unit: ',LUNDEC
- ISTAT = 1
- RETURN
-99 CONTINUE
- WRITE(LUNCZ,'(1X,A,I4)') '**** CZDGTA EOF on unit: ', LUNDEC
- ISTAT = 1
- END
diff --git a/src/packlib/cspack/czdnet/czdgtc.F b/src/packlib/cspack/czdnet/czdgtc.F
deleted file mode 100644
index 21fb4af..0000000
--- a/src/packlib/cspack/czdnet/czdgtc.F
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: czdgtc.F,v 1.1.1.1 1996/03/08 15:44:25 mclareni Exp $
-*
-* $Log: czdgtc.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:25 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE CZDGTC(NTOT,ISTAT)
-*
-#include "cspack/czdecnet.inc"
-#include "cspack/czsock.inc"
-#include "cspack/czbuff.inc"
-#include "cspack/czunit.inc"
-*
- IF(IDEBXZ.GE.3) PRINT *,'CZDGTS. get ',NTOT,' characters'
- CHBUF = ' '
- READ( UNIT=LUNDEC, FMT='(A)', END=99, ERR=98 ) CHBUF(1:NTOT)
- ISTAT = 0
- NPR = MIN(NTOT,80)
- IF(IDEBXZ.GE.3) PRINT *,CHBUF(1:NPR)
- RETURN
-98 CONTINUE
- WRITE(LUNCZ,'(1X,A,I4)') '**** CZDGTC read error on unit: ',LUNDEC
- ISTAT = 1
- RETURN
-99 CONTINUE
- WRITE(LUNCZ,'(1X,A,I4)') '**** CZDGTC EOF on unit: ', LUNDEC
- ISTAT = 1
- END
diff --git a/src/packlib/cspack/czdnet/czdgts.F b/src/packlib/cspack/czdnet/czdgts.F
deleted file mode 100644
index d4a56fe..0000000
--- a/src/packlib/cspack/czdnet/czdgts.F
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: czdgts.F,v 1.1.1.1 1996/03/08 15:44:25 mclareni Exp $
-*
-* $Log: czdgts.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:25 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE CZDGTS(CHSTR,NTOT,ISTAT)
-*
- CHARACTER*(*) CHSTR
-#include "cspack/czdecnet.inc"
-#include "cspack/czsock.inc"
-#include "cspack/czbuff.inc"
-#include "cspack/czunit.inc"
-*
- IF(IDEBXZ.GE.3) PRINT *,'CZDGTS. get ',NTOT,' characters'
- CHSTR = ' '
- READ( UNIT=LUNDEC, FMT='(A)', END=99, ERR=98 ) CHSTR(1:NTOT)
- NPR = MIN(NTOT,80)
- IF(IDEBXZ.GE.3) PRINT *,CHSTR(1:NPR)
- ISTAT = 0
- RETURN
-98 CONTINUE
- WRITE(LUNCZ,'(1X,A,I4)') '**** CZDGTS read error on unit: ',LUNDEC
- ISTAT = 1
- RETURN
-99 CONTINUE
- WRITE(LUNCZ,'(1X,A,I4)') '**** CZDGTS EOF on unit: ', LUNDEC
- ISTAT = 1
- END
diff --git a/src/packlib/cspack/czdnet/czdnet.F b/src/packlib/cspack/czdnet/czdnet.F
deleted file mode 100644
index e890b37..0000000
--- a/src/packlib/cspack/czdnet/czdnet.F
+++ /dev/null
@@ -1,101 +0,0 @@
-*
-* $Id: czdnet.F,v 1.1.1.1 1996/03/08 15:44:24 mclareni Exp $
-*
-* $Log: czdnet.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:24 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE CZDNET( IBUF, ICONTR )
-************************************************************************
-*.
-*... CZDNET hook routine for FZIN and FZOUT
-*.
-*.
-*. Author : B.Holl
-*. Version : 1.00
-*. Created : 05-Apr-1990
-*. Last Mod:
-*.
-*. Modification Log.
-*.
-*.**********************************************************************
-*
-#include "cspack/czdecnet.inc"
-#include "cspack/czsock.inc"
- INTEGER IQUEST
- COMMON /QUEST/ IQUEST(100)
-*
- CHARACTER*80 CHMAIL
-*
- INTEGER IBUF(1), ICONTR(2), ICASE, NBYTES, NWORD, IK, ISTAT
-*
-*.......................................................................
-*
-*-- Get transfer direction and data type
-*
- ICASE = ICONTR(1)+1
- IF( ICASE .LT. 3 ) THEN
- NBYTES = 4*LBUF
- ELSE
- NBYTES = 4*ICONTR(2)
- ENDIF
- GO TO ( 100, 200, 300, 400 ), ICASE
- IF( ICASE .LE. 0 .OR. ICASE .GT. 4 ) THEN
- WRITE(LUNCZ,'(1X,A)') '**** Invalid ICASE in CZTCP ****'
- RETURN
- ENDIF
-*
-*-- Receive Binary
-*
-100 ISTAT = 0
- NWORD = NBYTES/4
- READ( UNIT=LUNDEC, FMT=*, END=110, ERR=120 )
- + (IBUF(IK), IK=1, NWORD )
- GO TO 130
-110 CONTINUE
- WRITE(LUNCZ,'(1X,A,I4)') '**** CZTCP read error on unit: ',LUNDEC
- ISTAT = 1
- GO TO 130
-120 CONTINUE
- WRITE(LUNCZ,'(1X,A,I4)') '**** CZTCP EOF on unit: ', LUNDEC
- ISTAT = 1
-130 IQUEST(1) = ISTAT
- GO TO 999
-*
-*-- Send Binary
-*
-200 ISTAT = 0
- NWORD = NBYTES/4
- WRITE( UNIT=LUNDEC, FMT=*, ERR=210 )
- + (IBUF(IK), IK=1, NWORD )
- GO TO 220
-210 CONTINUE
- WRITE(LUNCZ,'(1X,A,I4)') '**** CZTCP write error on unit: ',LUNDEC
- ISTAT = 1
-220 IQUEST(1) = ISTAT
- GO TO 999
-*
-*-- Receive Character
-*
-300 CALL CZDGTA( CHMAIL, ISTAT )
- IF( ISTAT .NE. 0 ) GO TO 310
- CALL UCTOH( CHMAIL, IBUF, 4, 80 )
- ICONTR(1) = 0
- GO TO 999
-310 ICONTR(1) = 1
- GO TO 999
-*
-*-- Send Character
-*
-400 CHMAIL = ' '
- CALL UHTOC( IBUF, 4, CHMAIL, NBYTES )
- CALL CZDPTA( CHMAIL, ISTAT )
- IF( ISTAT .NE. 0 ) GO TO 410
- ICONTR(1)=0
- GO TO 999
-410 ICONTR(1) = 1
-*
-999 RETURN
- END
diff --git a/src/packlib/cspack/czdnet/czdopn.F b/src/packlib/cspack/czdnet/czdopn.F
deleted file mode 100644
index 8387a5a..0000000
--- a/src/packlib/cspack/czdnet/czdopn.F
+++ /dev/null
@@ -1,101 +0,0 @@
-*
-* $Id: czdopn.F,v 1.1.1.1 1996/03/08 15:44:24 mclareni Exp $
-*
-* $Log: czdopn.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:24 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE CZDOPN( CHSERV, HOST, ISTAT )
-*
-#include "cspack/czdecnet.inc"
-#include "cspack/czsock.inc"
-#include "cspack/czunit.inc"
- REAL DBUF
- COMMON /CDBUF/ DBUF(10)
-*
- LOGICAL STATUS
-*
- CHARACTER*20 CHPROX
- CHARACTER*(*) HOST, CHSERV
- CHARACTER*80 TASK
- CHARACTER*22 CHFILE
- CHARACTER*20 SERVICE
- CHARACTER*12 USER,CHMODE
- CHARACTER*64 PASS
-*
- INTEGER ISTAT, LIB$GET_TERMINAL, LIB$GET_NOECHO, LIB$GET_LUN
- +, LENU, LENP, JUMPAD, LENOCC, LIB$GETJPI
-
- INCLUDE '($JPIDEF)'
-*
- EXTERNAL CZTCP
-*
- LH = LENOCC(HOST)
- IF(IDEBXZ.GE.0) PRINT *,'CZDOPN. Using DECnet to access ',
- + HOST(1:LH)
- ISTAT = 0
-*
-*-- Get logical unit for network connection
-*
- STATUS = LIB$GET_LUN(LUNDEC)
- IF(.NOT.STATUS) GO TO 99
-*
-* Check logical name CZPROXY. If set to TRUE, do not prompt
-* for username and password
-*
- STATUS = LIB$SYS_TRNLOG('CZPROXY',LPROXY,CHPROX,,,)
- CALL CLTOU(CHPROX)
- IF(CHPROX(1:LPROXY).NE.'TRUE') THEN
-*
-* Check if we are interactive...
-*
- STATUS = LIB$GETJPI(JPI$_MODE,,,,CHMODE,%REF(LMODE))
-*
-*-- Get user name and password
-*
- IF(CHMODE(1:LMODE).EQ.'INTERACTIVE') THEN
- STATUS = LIB$GET_TERMINAL(USER,'Username? ', LENU)
- IF(.NOT.STATUS) GO TO 99
- ELSE
- LENU = 0
- ENDIF
- IF(LENU.NE.0) THEN
- STATUS = LIB$GET_NOECHO(PASS,'Password? ', LENP)
- IF(.NOT.STATUS) GO TO 99
- ENDIF
- ELSE
- LENU = 0
- ENDIF
-*
-*-- Request network connection
-*
- IF(LENU.NE.0) THEN
- TASK = HOST(1:LH)//'"'//USER(1:LENU)//' '//PASS(1:LENP)
- + //'"::"TASK='//CHSERV//'"'
- ELSE
- TASK = HOST(1:LH)//'::"TASK='//CHSERV//'"'
- ENDIF
- OPEN(UNIT=LUNDEC,FILE=TASK(1:LENOCC(TASK))
- +, STATUS='OLD',ERR=99)
- PRINT *,'Connection to ',HOST(1:LH),' established'
- ISKIN = LUNDEC
- ISKOUT= LUNDEC
-*
-*-- Set up FZ in channel mode
-*
- IF( IADTCP .EQ. 0 )THEN
- LUNCZ= 6
- LBUF = 270
- CALL FZFILE(LUNFZI, LBUF, 'SIOC')
- CALL FZHOOK(LUNFZI, CZTCP, DBUF)
- CALL FZFILE(LUNFZO, LBUF, 'SOC')
- CALL FZHOOK(LUNFZO, CZTCP, DBUF)
- IADTCP = JUMPAD(CZTCP)
- CALL JUMPST(IADTCP)
- ENDIF
- RETURN
- 99 CONTINUE
- ISTAT = 1
- END
diff --git a/src/packlib/cspack/czdnet/czdpta.F b/src/packlib/cspack/czdnet/czdpta.F
deleted file mode 100644
index 275d85f..0000000
--- a/src/packlib/cspack/czdnet/czdpta.F
+++ /dev/null
@@ -1,49 +0,0 @@
-*
-* $Id: czdpta.F,v 1.1.1.1 1996/03/08 15:44:24 mclareni Exp $
-*
-* $Log: czdpta.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:24 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE CZDPTA( CHMAIL, ISTAT )
-************************************************************************
-*.
-*... CZDPTA to send the string CHMAIL to a remote host
-*.
-*.
-*. Author : B.Holl
-*. Version : 1.00
-*. Created : 05-Apr-1990
-*. Last Mod:
-*.
-*. Modification Log.
-*.
-*.**********************************************************************
-*
-#include "cspack/czdecnet.inc"
-#include "cspack/czsock.inc"
-#include "cspack/czunit.inc"
-*
- CHARACTER*(*) CHMAIL
- CHARACTER*80 CHTEMP
-*
- INTEGER NCH, ISTAT
-*
-*.......................................................................
-*
- NCH = LEN(CHMAIL)
- IF(NCH.GT.80) NCH = 80
- IF(IDEBXZ.GE.3) PRINT *,'CZDPTA. enter for ',
- + CHMAIL(1:NCH)
- CHTEMP = ' '
- CHTEMP = CHMAIL(1:NCH)
- WRITE(UNIT=LUNDEC,FMT='(A80)',ERR=99) CHTEMP
- ISTAT = 0
- RETURN
-99 CONTINUE
- WRITE(LUNCZ,'(1X,A,I4)') '**** Error in CZDPTA for unit: ',LUNDEC
- ISTAT = 1
- END
-
diff --git a/src/packlib/cspack/czdnet/czdptc.F b/src/packlib/cspack/czdnet/czdptc.F
deleted file mode 100644
index e1c493c..0000000
--- a/src/packlib/cspack/czdnet/czdptc.F
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: czdptc.F,v 1.1.1.1 1996/03/08 15:44:25 mclareni Exp $
-*
-* $Log: czdptc.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:25 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE CZDPTC(NTOT,ISTAT)
-#include "cspack/czdecnet.inc"
-#include "cspack/czsock.inc"
-#include "cspack/czbuff.inc"
-*
- WRITE(UNIT=LUNDEC,FMT='(A)',ERR=99) CHBUF(1:NTOT)
- ISTAT = 0
- RETURN
-99 CONTINUE
- WRITE(LUNCZ,'(1X,A,I4)') '**** Error in CZDPTC for unit: ',LUNDEC
- ISTAT = 1
- END
-
diff --git a/src/packlib/cspack/czdnet/czdpts.F b/src/packlib/cspack/czdnet/czdpts.F
deleted file mode 100644
index 3048756..0000000
--- a/src/packlib/cspack/czdnet/czdpts.F
+++ /dev/null
@@ -1,30 +0,0 @@
-*
-* $Id: czdpts.F,v 1.1.1.1 1996/03/08 15:44:25 mclareni Exp $
-*
-* $Log: czdpts.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:25 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE CZDPTS(CHSTR,NTOT,ISTAT)
- CHARACTER*(*) CHSTR
-#include "cspack/czdecnet.inc"
-#include "cspack/czsock.inc"
-#include "cspack/czbuff.inc"
-#include "cspack/czunit.inc"
-*
- IF(IDEBXZ.GE.3) THEN
- PRINT *,'CZDPTS put ',NTOT,' characters'
- NPR = MIN(NTOT,80)
- PRINT *,CHSTR(1:NPR)
- ENDIF
-
- WRITE(UNIT=LUNDEC,FMT='(A)',ERR=99) CHSTR(1:NTOT)
- ISTAT = 0
- RETURN
-99 CONTINUE
- WRITE(LUNCZ,'(1X,A,I4)') '**** Error in CZDPTS for unit: ',LUNDEC
- ISTAT = 1
- END
-
diff --git a/src/packlib/cspack/czdnet/czrdtne.F b/src/packlib/cspack/czdnet/czrdtne.F
deleted file mode 100644
index 59c0341..0000000
--- a/src/packlib/cspack/czdnet/czrdtne.F
+++ /dev/null
@@ -1,40 +0,0 @@
-*
-* $Id: czrdtne.F,v 1.1.1.1 1996/03/08 15:44:24 mclareni Exp $
-*
-* $Log: czrdtne.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:24 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
-#if defined(CERNLIB_VAXVMS)
- integer function lib$get_noecho(input,prompt,length)
-
- implicit integer (s)
-
- character*(*) input,prompt
-
- include '($iodef)'
- integer*2 tt_chan,iosb(4)
-
-
- length = len(prompt)
-*
-* Assign a channel to terminal
-*
- status = sys$assign('sys$command',tt_chan,,)
- if (.not. status) call lib$signal(%val(status))
-
- modifier = io$_readprompt .or. io$m_noecho
-
- status = sys$qiow(%val(1),%val(tt_chan),%val(modifier),
- + iosb,,,%ref(input),%val(80),,,
- + %ref(prompt),%val(length))
- if (.not. status) call lib$signal(%val(status))
-
- lib$get_noecho = iosb(1)
- length = iosb(2)
-
- return
- end
-#endif
diff --git a/src/packlib/cspack/czdnet/czrdtrm.F b/src/packlib/cspack/czdnet/czrdtrm.F
deleted file mode 100644
index b4acfe7..0000000
--- a/src/packlib/cspack/czdnet/czrdtrm.F
+++ /dev/null
@@ -1,43 +0,0 @@
-*
-* $Id: czrdtrm.F,v 1.1.1.1 1996/03/08 15:44:24 mclareni Exp $
-*
-* $Log: czrdtrm.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:24 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
-#if defined(CERNLIB_VAXVMS)
- INTEGER FUNCTION LIB$GET_TERMINAL( INPUT, PROMPT, LENGTH )
-************************************************************************
-*.
-*... Utility routine written by J.Shiers
-*.
-*.**********************************************************************
- implicit integer (s)
- character*(*) input,prompt
-*
- include '($iodef)'
- integer*2 tt_chan,iosb(4)
-*
- length = len(prompt)
-*
-* Assign a channel to terminal
-*
- status = sys$assign('sys$command',tt_chan,,)
- if (.not. status) call lib$signal(%val(status))
-*
- modifier = io$_readprompt
-*
- status = sys$qiow(%val(1),%val(tt_chan),%val(modifier),
- 2 iosb,,,%ref(input),%val(80),,,
- 2 %ref(prompt),%val(length))
- if (.not. status) call lib$signal(%val(status))
-*
- lib$get_terminal = iosb(1)
- length = iosb(2)
-*
- return
- end
-
-#endif
diff --git a/src/packlib/cspack/doc/config/services.dat b/src/packlib/cspack/doc/config/services.dat
deleted file mode 100644
index daa5c9f..0000000
--- a/src/packlib/cspack/doc/config/services.dat
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: services.dat,v 1.1.1.1 1996/03/08 15:44:18 mclareni Exp $
-*
-* $Log: services.dat,v $
-* Revision 1.1.1.1 1996/03/08 15:44:18 mclareni
-* Cspack
-*
-*
-#
-# This file should go into CERN:[PRO.EXE]ETC.SERVICES for
-# VAX/VMS systems running UCX
-#
-#
-# CERN services
-#
-zserv 346/tcp
-#
-# UNIX specific services
-#
-exec 512/tcp
diff --git a/src/packlib/cspack/doc/config/sysreq.txt b/src/packlib/cspack/doc/config/sysreq.txt
deleted file mode 100644
index a9d3b37..0000000
--- a/src/packlib/cspack/doc/config/sysreq.txt
+++ /dev/null
@@ -1,50 +0,0 @@
-#
-# $Id: sysreq.txt,v 1.2 2005/04/18 15:23:09 mclareni Exp $
-#
-# $Log: sysreq.txt,v $
-# Revision 1.2 2005/04/18 15:23:09 mclareni
-# Mods submitted by Kevin B. McCarty to fix insecure Cernlib uses of /tmp.
-#
-# Revision 1.1.1.1 1996/03/08 15:44:18 mclareni
-# Cspack
-#
-#
-#
-# SHIFT configuration file
-#
-RFIO NFS_ROOT /shift # nfs root path name
-#
-SYSREQ AF AF_INET # Addressing family
-SYSREQ TYPE SOCK_STREAM # Communication type
-SYSREQ HOST cerntms # SYSREQ host name
-SYSREQ RETRY yes # retry flag
-SYSREQ MAXRETRY 10 # number of retries
-SYSREQ ALARM yes # Operator alarm
-SYSREQ TRACE yes # Trace flag
-#
-MSG HOST sun2 # message daemon host name
-MSG LOGR /var/log/msgr.log # msgr log file
-MSG LOGI /var/log/msgi.log # msgi log file
-#
-NET shift1 shift1-u # Use alternate host name
-NET shd01 shd01-u # Use alternate host name
-NET shd02 shd02-u # Use alternate host name
-NET shd03 shd03-u # Use alternate host name
-NET shd04 shd04-u # Use alternate host name
-NET sn201 sn201-u # Use alternate host name
-#
-DKCTRL PORT 1500
-DKCTRL PORT 1501
-DKCTRL PORT 1502
-DPM HOST shift1
-DPM PORT 1400
-DPM HOST shift1
-DPM PORT 1401
-DPM HOST shift1
-DPM PORT 1402
-DPM HOST shd01
-DPM PORT 1400
-DPM HOST shd01
-DPM PORT 1401
-DPM HOST shd01
-DPM PORT 1402
diff --git a/src/packlib/cspack/doc/config/tcpconfig.dat b/src/packlib/cspack/doc/config/tcpconfig.dat
deleted file mode 100644
index 4ebe4ce..0000000
--- a/src/packlib/cspack/doc/config/tcpconfig.dat
+++ /dev/null
@@ -1,44 +0,0 @@
-*
-* $Id: tcpconfig.dat,v 1.1.1.1 1996/03/08 15:44:18 mclareni Exp $
-*
-* $Log: tcpconfig.dat,v $
-* Revision 1.1.1.1 1996/03/08 15:44:18 mclareni
-* Cspack
-*
-*
-# Add these lines to /etc/inetd.conf (/usr/etc/inetd.conf on Silicon Graphics)
-# (TWG$TCP:[NETDIST]SERVICES.; on VAX/VMS systems with Wollongong TCP/IP)
-pawserv 345/tcp
-zserv 346/tcp
-sysreq 4001/tcp
-#if defined(CERNLIB_UNIX)
-# Add these lines to /etc/services
-pawserv stream tcp nowait root /cern/pro/bin/pawserv pawserv
-zserv stream tcp nowait root /cern/pro/bin/zserv zserv
-#endif
-#if (defined(CERNLIB_VAXVMS))&&(defined(CERNLIB_TWG))
-# Add these lines to TWG$TCP:[NETDIST.ETC]SERVERS.DAT
-# PAWSERV: For the PAW Master server application.
-service-name Pawserv
-program CERN:[PRO.EXE]PAWSERV.EXE
-socket-type SOCK_STREAM
-socket-options SO_ACCEPTCONN | SO_KEEPALIVE
-socket-address AF_INET , 345
-working-set 300
-INIT TCP_Init
-LISTEN TCP_Listen
-CONNECTED TCP_Connected
-SERVICE Run_Program
-
-# ZSERV: For the ZEBRA File server application.
-service-name Zserv
-program CERN:[PRO.EXE]ZSERV.EXE
-socket-type SOCK_STREAM
-socket-options SO_ACCEPTCONN | SO_KEEPALIVE
-socket-address AF_INET , 346
-working-set 200
-INIT TCP_Init
-LISTEN TCP_Listen
-CONNECTED TCP_Connected
-SERVICE Run_Program
-#endif
diff --git a/src/packlib/cspack/doc/history b/src/packlib/cspack/doc/history
deleted file mode 100644
index dbb207a..0000000
--- a/src/packlib/cspack/doc/history
+++ /dev/null
@@ -1,313 +0,0 @@
-*
-* $Id: history,v 1.1.1.1 1996/03/08 15:44:18 mclareni Exp $
-*
-* $Log: history,v $
-* Revision 1.1.1.1 1996/03/08 15:44:18 mclareni
-* Cspack
-*
-*
-* This directory was created from cspack.car patch history
-Version 1.36=For import into CVS
-Version 1.35=(XZ)RFRF: quota of output RZ file can be set (option Q)
- XZLLS: limit NFOUND to NMAX
- P=VMSC,D=SGTTY: change QMALPH to QCDEC
- CZCDES: separate sequences into C and Fortran decks
- XZLLS: protect against output file not found.
- SERROR: new version for DEC C V4.0
- CZOPEN: select C RTL init based upon QCDEC flag
- TCPAW: add code to perform AFS authentication
-Version 1.34=netreq 1.18 from Frederic Hemmer
- 94B
- TCPAW: mods for Alpha/OSF (Gunter Folger)
- XZGETR, SPUTRZ: don't use option N for RZMAKE
-Version 1.33=tcpaw: use sock_reply for VMS to write to socket, not stdout
- log.c: Linux support
- XZRZCP: return with message
- PCBDEF mods
- SYSREQ/LOG: split long #if again
- Effing CMZ has put wrong tags on DECKS again!!!!!!
- TELNETG: changes from Victor Balashov for Linux & Convex
- PCBDEF: new version for VMS 6.1, IF=-PREVMS61
- copy version for AXP SYS$LIBRARY:SYS$LIB_C.TLB
- CZPUTC: correct no TCPSOCK version, better error messages
- protect against 0 length buffer
- New SYSREQ which fixes VMS link/library problems
- Hack SYSREQ for 80 column limit (LOG.C) and MULTINET/TGV flags
- Try new SYSREQ again....
- Revert to old SYSREQ
- Hack SYSREQ for 80 column limit
- New version of SYSREQ
- RLOGIN: increase nodename string to 255 characters
-Version 1.32=MESSAGE: change IPAWC to IQ
- Bug fix in ZSRZIN (IQUEST(1) was not preset to 0)
- Implement possibility to map shared memory on Unix
- Implement Histo/List for shared memory more efficiently
- New routines ZSLISTM, ZSLISM and ZSLISM1.
- CZCDES: reorganise into package specific decks.
- CZCDES: HCDIRE copied from HBOOK! (cannot read HBOOK file
- due to inconsistant definitions of CZ sequences.)
- SYSREQF: define UNIXF77 for OSF
- XZLLS, SZLS, call lib$find_file_end
- MESSAGE,ZSRZIN: add support for Unix shared memory
- XZLLS: correct handling of ICONT!=0
- ZFVERS: use CLEFT instead of CCOPYL
- TCPAW: change #ifdef linux to #ifdef linux_softland
- Enable SYSREQC,IF=SUN
- XZRFRF: fix call to RZOPEN and RZMAKE to set X flag if IOPTX
- Changes for CONVEX (tcpaw, netreq, telnetg)
- Add dummies to ZFTP to avoid linking against system (VMS)
- User program should call CZDUMM (which is not in PACKLIB).
- Go back to V93D version of SYSREQ.
-Version 1.31=VIDQQ identification
- New SYSREQ: define MULTINET #ifdef TGV
- Add QMVAOS flag for Alpha OSF
- XZRTOF: option X also on RZFILE
- XZRTOF: add option X to specify input exchange mode file
- SYSREQ: add #defines for QMALPH/makepack
- TCPAW: fix warnings in islose/close
- VMSC: add #defines for QMALPH/makepack
- TCPAW: change ifndef for PWD.H to exclude NeXT
- ZFTPCDF: add options C,R to Rto/frF
- SZREAD: QMALPH flag for IOSEOF
- XZPUTA: protect call to CZPUTA
- srecvstr: don't call CMXLATE in case of errors
- Better handling of CTRL in TELNETG (Gunter Folger)
- Add option E for XZGET/PUTR. Force exchange mode for
- input file.
- Fix XZRFRF for DEC Fortran 6
- Modify CDF to reenable CD/LCD -C
- SZREAD: IOSTAT>0 = EOF (d/a read)
- TCPAW: add #defines for QMALPH
- CZOPEN: QMALPH C initialisation
- SZLS: add random number to temporary file name
- Use sequence LPAWC in PAWC
- CZTCP: set hand shake string to CZOK (rdm)
- TELNETG: changes for CONVEX
- CZGETA: only UHTOC NCH characters, not 80
- IRC=0 at start of XZGET/PUTA
- GETACCT: stick in a $ between uuu & gg on VAX, IF=CERN.
- Mods to TELNETG for Linux (from Victor Balashov)
- Correction to SGETP
- XZRFRF: get record length from file on VAXVMS
- TCPAW: new ruserpass for Unix from Alfred
- TCPAW: CMXLATE call should use *m rather than strlen (Alfred N.)
- PIAF stuff IF=UNIX.
- Fixes from Fons Rademakers for TCPAW
- Use KUGETP to prompt for password (noecho)
- define index as strchr for all systems
- 'File transfer completed message only if logl >= 0
- XZSERV: add REDM/RITM commands to read/write multiple sequential
- records. Intended for file transfer
- SZOPEN: open d/a files READONLY on VAX if IOPTO=0
- Add PAWSERV RSHELL commands 'CLOSE, FL and LOGOUT'
- Z=CZUNIT: add LUNFZI/O. Remove all occurances of 998/999 apart
- from definitions in CZOPEN and ZS.
- SZRM, XZLRM: only add FORM if non-blank
- XZ: change JSKIN(2) etc. to JSKIN(LUNXZO)
- SZRM, XZLRM: INQUIRE for FORM before OPEN
- IRC=1 from SZCD when cannot set remote directory
- Remove extra argument in socket/connect calls in telnetg.
- PZNTRC. add option R to remote 'piaf' line if password is bad
- XZRZCP: pass quota for output file in IS(1) (ugh)
- Take LRECL from file only if LRECL<=0 specified.
- XZGETL: clear line before reading from server
- Undefine ctrl also on Sun in telnetg
- Bug fix in XZGETR - issue RZEND in case of X mode files
- Modify CDF file for new KUIP.
-Version 1.30=Fix bugs in XZPUTA, SGETA - check on buffer length must be
- made before filling (overwriting) buffer.
- Delete deck FTPDEF. CDF must be extracted and passed
- through KUIPC.
- Bug fix in SGETFZ, SPUTFZ in FILEDEF statements
- Copy sequences HCK, HCBOOK, HCFLAG and HCNTPAR from
- HBOOK for new PAWSERV mods. Fix two following routines
- Take modified P=ZS,D=ZSLDIR, ZSRZIN from
- Claudio Condini (new HBOOK files use 2 keys)
- V93A 15/01/93 13:30
-Version 1.28=TCPSOCK is now a sequence (IBMMVS/VM)
- Remove hard-coded unit numbers from SZFTP.
- Bug fix in SZOPEN for new direct access files
- Bug fix in XZCLOS. Add node argument to XZINQR call
- define irix4 for SGI running irix version 4 or higher.
- Add XZRZOP - issue remote RZOPEN and return IRC, LRECL
- Add XZGET/PUTL to read/write line from formatted file
- File names up to 80 characters in XZ/SZ OPEN
- Bug fix in XZMVSD. Macros inline in FORTIDC.
- Add patches PATTE (main program for Piaf Automatic Tuple
- Transfer Executive), PZ (subroutines of above) and PZCDF
-Version 1.27=Add dummy SZPIAF routine.
- SZLS, XZLLS: increase COMM to 255 characters
- Increase Zebra store from 500K-900K
- Minor mods to telnetg for Apollo
- Fix bug in XZPUTX for sending to non-Unix machines
- Remove SHARED option for sequential files in SZOPEN (VAX)
- Fix bug in XZPUTR - transmit option L (reLative org.) correctly
- Fix bug in SGETA, SPUTA for handling of CHOPT
-Version 1.26=V92B
- SYS$MANAGER:SYSREQ.CONF change: sysreq_host is now cerntms
-Version 1.25=sysreqf also for hpux
- Add mv and lmv commands
- Check on SS$_ACCIO and SS$_WASSET in setid().
- Add routine setid to set rights identifiers of created
- server process on VMS systems.
- Protection against being unable to server log file.
- Add pilot for BZFTP.
- SZOPEN: issue INQUIRE on VAXes to determine recordtype
- Issue FILEINF for mode 4 files - assume recfm f
- Return codes from csetup(TCPAW) in case of failure
- Option to stop in case of error (e.g. IF=BATCH)
-Version 1.24=v92a March 4th 1992
-Version 1.23=Add command RZCOPY
- Add commands FTOC, CTOF to convert files written with
- FORTRAN sequential I/O to C format and back.
- Add RTOF/RFRF and FZcopy commands
- Re-add lines in TCPAW that check for (vm & (mvs
- Add case sensitive file name support for all zftp commands
- (via option -C) (but not RM, as this would mean
- changing the calling sequence) (not yet RZ/FZ either)
- define irix4 to get version of TCPAW for Irix V4.0
- New TSOSUBD/TCPAW from Thomas Schwab/GSI
- Fixes for SZCD, XZLCAT, XZPUTA, XZMVSD, SZLS for MVS
-Version 1.22=Bug in SGETFZ, XZPUTF - IOCR not set for final header.
- Fix bugs in VMS version of XZLLS
- Take new version of netreq for VMS privileged commands.
- Add missing headers in gethostn.
- Check logical name CZPROXY in CZDOPN. If set to TRUE, do
- not prompt for username & password (should perhaps also
- check .netrc/ftplogin./DOT NETRC file)
- Fix problems with [] characters
- Move TSOSUB to separate patch, activate IF=IBMAIX,IBMAIX.
- Tidy printout in TCPAW.
- New TCPAW from GSI. Move old TCPAW to TCPOLD
- Use sequence QFTITLCH rather than QFTITLE
- Add MVS mods from Thomas Schwab, GSI
- TCPAW,CZCDES modified, P=TCPAW,D=TSOSUB & P=TSOSERV added
-Version 1.21=Copy telnet.h into patch CSH (for telnetg with Multinet)
- Only issue ioctl with TIOCFLUSH if TIOCFLUSH is defined (TGV)
- Add option R to (most) get/put commands - don't replace
- existing file unless R option given.
- Default record length for FZ native files = 3600 bytes
- Assume that VM files, mode 4, are VBS (PUTFZ)
- undefine CTRL in telnetg if=decs, to remove existing local
- definition (from Lee Roberts, SSC).
- Permit mixed case directories on Unix systems (CD -C)
- Bug fix in IUCREQ - FREEMAIN
- Fix bugs in TCPAW VM code. Add SLEEP function for VM
- Add possibility of write access to other users'
- mini-disks on VM. Syntax is: CD user.address password mode
- Fix bug in VM server for use with C TCPAW
-Version 1.20=CNL 204 12/09/91 09:00
-Version 1.19=New version of TCPAW with Cray SECUREID support
- Work-around in XDR for VMS link problem.
- Bug fix in IUCREQ
- Incorporate MVS mods from GSI & DESY
- Support option L in LS for VMS systems
- Rename patch TCPASM to TCPSOCK.
- Save modification date for top directories
- Add GET/PUTX - to transfer true exchange format files.
-Version 1.18=Enable RSH command. Add XZLCD, XZLRM and corresponding
- ZFTP commands. (LCD, LLS and LRM)
- Fixes for TCPAW: add reply2 routine
-Version 1.17=Add new sysreq with TGV & TWG support
- Bug fix in SYSREQ(IBM), new IUCV version
- Fix bug in XZLS for zero length CHOPT
- Call SETGID/SETUID on RS6000 before SETEGID/SETEUID.
- HPUX version
-Version 1.16=Add INSTALL patch (just VAX for now) with example command file
- for ZFTP (Multinet, Wollongong or UCX TCP/IP)
- Server compatible with both DECnet and TCP/IP (VAX/VMS)
- Modify GETA/PUTA to support LRECL up to 255
- Always write zftp.tmp into home directory (Unix)
- Add READONLY in SZOPEN unless for output
- Add getservbyname from Bob Ball, U.Mich for VMS systems
- with UCX
-Version 1.15=Enable options -d (DECnet) and -v (VM/CMS) on OPEN command
- N.B. the client may handle both DECnet and TCP/IP connections
- but a separate server is required.
- Add patch CRON - VMS cron without VMS dependancies
- IOPTA in XZGETx/XZPUTx. Local file already opened on
- corresponding FORTRAN logical unit (e.g. by FMOPEN)
-Version 1.14=Call FILEINF in SZOPEN for direct access files on VM
- Put #ifdef DEBUGs in +SELF,IF=DEBUG in getconfent (VAX problem
-Version 1.13=Define location of SYSREQ configuration file using
- +SELFs (GETCONFENT.C)
- Do not use SHARED for NEW files on VAX.
- Fix CZPUTC for TCPAW.pascal (8192 byte limit on send)
- Use SZ routines from XZ routines. Set return code
- to be IOSTAT.
-Version 1.12=sun4 should no longer be defined for TCPAW.
- Fixes for TCPAW (Cray,VMS)
- New calling sequences for CHDIRF, GETWDF
- Fix bug in MGET when retrieving files from VM system.
- Change TCPAW for IBM C (Ignaccio Reguero)
-Version 1.11=Add calls to CZDNET routines, if IPROT ^= 0 (IF=VAXVMS)
-Version 1.10=For CNL 201
-Version 1.09=Fix bug in SZOPEN for PAM files (VM)
- Bug fixes from SSC, FCA. Add pilot patch for SYSREQ command.
- New: Cray CFT77 will only accept CHARACTER up to 16383(?)
- Fill IQUEST(11-17) in XZ routines:
- IQUEST(11) = NR
- IQUEST(12) = NKILO
- IQUEST(13) = RATE
- IQUEST(14) = IHOUR
- IQUEST(15) = IMIN
- IQUEST(16) = ISEC
- IQUEST(17) = T
- Set return code in all XZGET/PUT routines
- Fix bug in MGET/MPUT for VAX files
- Fix bug introduced in XZGETB to use LUNXZI/O Rework help.
- Add MGET/MPUT routines, XZLLS (local LS)
-Version 1.08=Add GETP/PUTP - transfer of binary PAMs
- Copy GENLIB routines TRA0E0, TRE0A0 to PATCH XZTRANS
- (IBM only)
-Version 1.07=MIPS version, thanks to Bob Ball, U.MICH
- Add GETFZ/PUTFZ - transfer an FZ file with optional data
- and format conversion.
- Refresh SYSREQ Patch
- Warning: getconfent should be compiled with
- cc -c -DPATH_CONFIG=|"/etc/sysreq.conf\"
- CZSWAP now also supports swap by node name (as well as LUN)
- Use RZOPEN in ZSFILE (old version remains in ZSFOLD)
- Add routines XZCD, XZPWD, XZLS
-Version 1.06=Fix bug in sending long records from IBM
- Convert to new PATCHY flags: VAXVMS, IBMVM.
- With TCP/IP V2.0 on IBM: must add IBMLIB to GLOBAL TXTLIBs...
- Fix compiler warning in SGETRZ
- For Yellow pages on SGI: link with packlib,sun,bsd (courtesy
- FNAL). -lsun
- Change Userpassad/Replyad/Buffadd% to Address24Type (courtesy
- IN2P3).
- Copy Zebra sequences ZMACH, ZSTATE and QUEST.
- TCP/IP socket interface on IBM/VM using C version of TCPAW,
- SAA C-compiler and TCP/IP V2.
- TCPAW for Cray servers with ACE.
- Fix bug in SZLS for Apollos. LS command string must
- be null terminated.
- Add routines (XZ)GET/PUTD to transfer a direct access file.
- Use these routines from XZGET/PUTR to transfer exchange mode
- RZ files.
-Version 1.05=Fix bug in SZOPEN. Tidy ZFTPLS.
-Version 1.04=SYSREQ for VMS systems added.
- Add code for VMS 5.4, change UAIDEF to include latest
- UAI definitions.
-Version 1.03=Bug fixes from SCC.
-Version 1.02=Add option S on call to FZFILE - S no longer default for
- channel mode
-Version 1.01=Fix for GET/PUTA on Cray - can only read 154 bytes/rec!
- Add command SVERSION to print version of server
- Add routines XZGETx/PUTx for FATMEN integration
- Change calling sequence of XZ/SZOPEN routines (LUN,,,)
- Return status information in IQUEST (NKILO etc.)
-Version 1.00=CNL 200
-Version 0.05=Use RZOPEN for GET/PUTRZ in client & server
-Version 0.04=Do not send trailing blanks in PUTA/GETA,
- buffer records up to 20480 bytes
- Support RECFM=V files in GET/PUTA (via CHOPT in
- GETA, SPUTA, VMQFIL in PUTA, SGETA).
-Version 0.03=Add variable length read support (for PAM files)
-Version 0.02=Add XZ routines for remote I/O. Add XZ,SZ routines
- for remote I/O. Add GET/PUTB, LS commands in ZFTP.
- Turn echo off for PASSWORD prompting on IBM.
- Support command line argument on ZFTP, e.g. ZFTP CERNVM
-To be implemented:
-Outstanding problems:
diff --git a/src/packlib/cspack/doc/info b/src/packlib/cspack/doc/info
deleted file mode 100644
index 1864604..0000000
--- a/src/packlib/cspack/doc/info
+++ /dev/null
@@ -1,60 +0,0 @@
-*
-* $Id: info,v 1.1.1.1 1996/03/08 15:44:18 mclareni Exp $
-*
-* $Log: info,v $
-* Revision 1.1.1.1 1996/03/08 15:44:18 mclareni
-* Cspack
-*
-*
-* This directory was created from cspack.car patch info
-This PAM consists of a set of utility routines and programs for
-client-server computing.
-
-The following people have contributed to this PAM:
-
- Rene Brun Tony Cass Olivier Couet
- Frederic Hemmer Burkhard Holl Catherine Magnin
- Ignacio Reguero Fons Rademakers Ben Segal
- Jamie Shiers Jonathan Wood/RAL Thomas Schwab/GSI
-
-================================================================================
-
-N.B. on LINUX, cc -Dlinux_softland for the 'Softland' dialect
- ----- of linux
-
-N.B. on IBMVM, +USE,TCPSOCK,T=INHIBIT. to activate PASCAL version of TCPAW.
- ----- The C version, which is the default, requires TCP/IP V2 or
- higher, plus IBM SAA C compiler
-
- Use EDCLIB MACLIB for assembler routines activated by TCPSOCK.
-
-N.B. on Apollo, TCPAW must be compiled under BSD:
- ------
-
-ver bsd4.3
-cc -c tcpaw.c
-
- on SGI, add -lsun
- ---
-
-N.B. on VAX/VMS systems, netreq, serror, socket must be compiled:
- -------
-
-cc /DEFINE=TGV for systems running Multinet TCP/IP
-cc /DEFINE=TWG for systems running Wollongong TCP/IP
-
-SYSREQ is not currently supported for other VAX/VMS TCP/IP versions,
-notably DEC/UCX.
-
-$if f$trnlnm("MULTINET") .nes. "" then write sys$output "Multinet TCP/IP"
-$if f$trnlnm("TWG$ETC") .nes. "" then write sys$output "Wollongong TCP/IP"
-$if f$trnlnm("UCX$DEVICE") .nes. "" then write sys$output "UCX TCP/IP"
-
-
-N.B. on AIX systems, add the following line to /etc/environments:
- ---
-
-xrf_messages=no
-
-This turns off the printing of FORTRAN error messages, which disturb
-the protocol used between ZFTP & ZSERV.
diff --git a/src/packlib/cspack/doc/vax.kumac b/src/packlib/cspack/doc/vax.kumac
deleted file mode 100644
index 12a96e7..0000000
--- a/src/packlib/cspack/doc/vax.kumac
+++ /dev/null
@@ -1,81 +0,0 @@
-*
-* $Id: vax.kumac,v 1.1.1.1 1996/03/08 15:44:18 mclareni Exp $
-*
-* $Log: vax.kumac,v $
-* Revision 1.1.1.1 1996/03/08 15:44:18 mclareni
-* Cspack
-*
-*
-$!
-$! Example command file for installing on VAX.
-$! N.B. CERNLIB MAKEPACK procedure should normally be used!
-$!
-$if p1 .nes. ""
-$ then p1 = f$edit(P1,"UPCASE")
-$ p1 = f$extract(0,1,p1)
-$ goto 'p1'
-$ endif
-$if f$type(LIB$) .eqs. "" then CERNLIB
-$P:
-$ write sys$output ">>> Patchy step..."
-$ypatchy cern:[pro.pam]zebra zftp.for :go
-+ASM,24,T=A
-#ifndef CERNLIB_QCDE
-#define CERNLIB_QCDE
-#endif
-#ifndef CERNLIB_DEBUG
-#define CERNLIB_DEBUG
-#endif
-#ifndef CERNLIB__ZFTP
-#define CERNLIB__ZFTP
-#endif
-#ifndef CERNLIB__SZ
-#define CERNLIB__SZ
-#endif
-#ifndef CERNLIB__CZ
-#define CERNLIB__CZ
-#endif
-#ifndef CERNLIB__XZ
-#define CERNLIB__XZ
-#endif
-#ifndef CERNLIB_VAXVMS
-#define CERNLIB_VAXVMS
-#endif
-+EXE
-+PAM,R=QCDE
-+PAM,12,T=C,A
-$F:
-$ write sys$output ">>> Compile step..."
-$for zftp
-$L:
-$ write sys$output ">>> Link step..."
-$ if f$trnlnm("TWG$TCP") .nes. ""
-$ then write sys$output "Wollongong TCP/IP..."
-$link zftp,'LIB$',-
- twg$tcp:[netdist.lib]libnet/lib,-
- twg$tcp:[netdist.lib]libnetacc/lib,-
- twg$tcp:[netdist.lib]libnet/lib,-
- sys$input/opt
- sys$library:vaxcrtl/shareable
- sys$system:sys.stb
-$ exit
-$ endif
-$ if f$trnlnm("MULTINET") .nes. ""
-$ then write sys$output "Multinet TCP/IP..."
-$link zftp,'LIB$',sys$input/opt
-sys$library:vaxcrtl/shareable
-sys$system:sys.stb
-multinet_socket_library/share
-$ exit
-$ endif
-$ if f$trnlnm("UCX$DEVICE") .nes. ""
-$ then write sys$output "UCX TCP/IP..."
-$!
-$! GETSERVBYNAME is the one from the CSPACK PAM, not that in the
-$! UCX shareable image (which is a dummy)
-$!
-$link zftp,getservbyname,'LIB$',SYS$LIBRARY:UCX$IPC/LIB,sys$input/opt
-sys$library:vaxcrtl/shareable
-sys$system:sys.stb
-$ exit
-$ endif
diff --git a/src/packlib/cspack/fz/Imakefile b/src/packlib/cspack/fz/Imakefile
deleted file mode 100644
index ca9e227..0000000
--- a/src/packlib/cspack/fz/Imakefile
+++ /dev/null
@@ -1,3 +0,0 @@
-SRCS_F= fzclos.F fzopen.F fzrmio.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/cspack/fz/fzclos.F b/src/packlib/cspack/fz/fzclos.F
deleted file mode 100644
index 72d598d..0000000
--- a/src/packlib/cspack/fz/fzclos.F
+++ /dev/null
@@ -1,30 +0,0 @@
-*
-* $Id: fzclos.F,v 1.1.1.1 1996/03/08 15:44:25 mclareni Exp $
-*
-* $Log: fzclos.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:25 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE FZCLOS(LUN,CHOPT,IRC)
-*
-* Close Zebra file on unit LUN with call to FZENDx
-*
- CHARACTER*6 CHSTAT
- CHARACTER*8 CHOPF
-#include "cspack/czsock.inc"
-#include "cspack/czopts.inc"
-*
-* Is the file accessed via a server
-*
- IF(JSKIN(LUN).NE.0) THEN
- CALL XZCLOS(LUN,CHOPT,IRC)
- ELSE
- CHSTAT = 'KEEP'
- IF(IOPTD.NE.0) CHSTAT = 'DELETE'
- CLOSE(LUN,STATUS=CHSTAT)
- ENDIF
-
- END
-
diff --git a/src/packlib/cspack/fz/fzopen.F b/src/packlib/cspack/fz/fzopen.F
deleted file mode 100644
index 2291da8..0000000
--- a/src/packlib/cspack/fz/fzopen.F
+++ /dev/null
@@ -1,102 +0,0 @@
-*
-* $Id: fzopen.F,v 1.1.1.1 1996/03/08 15:44:25 mclareni Exp $
-*
-* $Log: fzopen.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:25 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE FZOPEN(LUN,CHFILE,LRECL,CHOPT,IRC)
-*
-* Issue FZFILE and perform the open
-* Options are passed to FZFILE, with the addition of 'R' if
-* the file is remote
-*
-#include "cspack/zmach.inc"
- CHARACTER*(*) CHFILE
- CHARACTER*255 FNAME
- CHARACTER*8 CHOPF,STATE,NODE
- CHARACTER*12 FORMT
- EXTERNAL FZRMIO
- LOGICAL IEXIST
-#include "cspack/czopts.inc"
-*
-* Is the file local or remote
-*
- LFILE = LENOCC(CHFILE)
- LCHOPT = LENOCC(CHOPT)
- ICOLON = INDEX(CHFILE(1:LFILE),'::')
- ISLASH = INDEX(CHFILE(1:LFILE),'//')
-*
-* Check if we can access the file directly...
-*
- INQUIRE(FILE=CHFILE(1:LFILE),EXIST=IEXIST)
- IF((ICOLON.NE.0).OR.(ISLASH.NE.0) .AND. (.NOT.IEXIST)) THEN
-*
-* File is remote (or at least not directly accessible)
-* Issue call to XZ to do the open
-*
- LOCAL = 1
- IF(ICOLON.EQ.0) THEN
- IEND = INDEX(CHFILE(3:LFILE),'/')
- NODE = CHFILE(1:IEND-1)
- FNAME = CHFILE(IEND+1:LFILE)
- ELSE
- NODE = CHFILE(1:ICOLON-1)
- FNAME = CHFILE(ICOLON+2:LFILE)
- ENDIF
- CALL XZOPEN(LUN,FNAME,NODE,LRECL,CHOPT,IRC)
- ELSE
-*
-* File is local - perform the OPEN
-*
- LOCAL = 0
- FNAME = CHFILE
-#if defined(CERNLIB_UNIX)
- CALL CUTOL(FNAME)
-#endif
-#if defined(CERNLIB_IBM)
-*
-* Do not issue OPEN on IBM unless option F (FORTRAN I/O) specified
-*
- IF(IOPTF.EQ.0) GOTO 10
-#endif
- FORMT = 'UNFORMATTED'
- IF(IOPTA.NE.0) FORMT = 'FORMATTED'
- STATE = 'UNKNOWN'
-#if defined(CERNLIB_IBM)
- CALL CTRANS('.',' ',FNAME,1,LFILE)
-#endif
-#if (!defined(CERNLIB_VAXVMS))&&(!defined(CERNLIB_APOLLO))
- OPEN (UNIT=LUN, FORM=FORMT, STATUS=STATE, FILE=FNAME(1:LFILE)
- + ,ERR=99)
-#endif
-#if defined(CERNLIB_APOLLO)
- IF(IOPTO.EQ.0) THEN
- OPEN (UNIT=LUN, FORM=FORMT, STATUS=STATE, FILE=FNAME(1:
- + LFILE), ERR=99)
- ELSE
- OPEN (UNIT=LUN, FORM=FORMT, STATUS=STATE, FILE=FNAME(1:
- + LFILE), ERR=99)
- ENDIF
-#endif
-#if defined(CERNLIB_VAXVMS)
- IF(IOPTO.EQ.0) THEN
- OPEN (UNIT=LUN, FORM=FORMT, STATUS=STATE, FILE=FNAME(1:
- + LFILE), SHARED, READONLY, ERR=99)
- ELSE
- OPEN (UNIT=LUN, FORM=FORMT, STATUS=STATE, FILE=FNAME(1:
- + LFILE), SHARED, ERR=99)
- ENDIF
-#endif
- ENDIF
- 10 CONTINUE
- CHOPF = CHOPT(1:LCHOPT)
-* IF(LOCAL.NE.0) CHOPF = CHOPT(1:LCHOPT)//'R'
- IF(LOCAL.NE.0) CHOPF = CHOPT(1:LCHOPT)//'C'
- CALL FZFILE(LUN,LRECL/IQCHAW,CHOPF)
- IF(LOCAL.NE.0) CALL FZHOOK(LUN,FZRMIO,DBUF)
- RETURN
- 99 IRC = 1
- END
diff --git a/src/packlib/cspack/fz/fzrmio.F b/src/packlib/cspack/fz/fzrmio.F
deleted file mode 100644
index 44ff273..0000000
--- a/src/packlib/cspack/fz/fzrmio.F
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: fzrmio.F,v 1.1.1.1 1996/03/08 15:44:25 mclareni Exp $
-*
-* $Log: fzrmio.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:25 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE FZRMIO(IBUF,IOWAY)
- DIMENSION IBUF(8192)
- PARAMETER (NREC=0)
-#include "cspack/zmach.inc"
-#include "cspack/quest.inc"
- CHARACTER*6 CHWAY
-
- IRC = 0
- LUN = IQUEST(1)
- IF(IOWAY.EQ.0) THEN
- CALL XZREAD(LUN,IBUF,NREC,IQUEST(2)*IQCHAW,NGOT,' ',IRC)
- ELSEIF(IOWAY.EQ.1) THEN
- CALL XZRITE(LUN,IBUF,NREC,IQUEST(2)*IQCHAW,' ',IRC)
- ELSE
- WRITE(CHWAY,'(I6)') IOWAY
- CALL ZFATAM('Invalid value for IOWAY in FZRMIO - '//CHWAY)
- ENDIF
-
- IQUEST(1) = IRC
-
- END
-
diff --git a/src/packlib/cspack/ibm/srqsrv/iucreq.s b/src/packlib/cspack/ibm/srqsrv/iucreq.s
deleted file mode 100644
index 0ced790..0000000
--- a/src/packlib/cspack/ibm/srqsrv/iucreq.s
+++ /dev/null
@@ -1,319 +0,0 @@
-*
-* $Id: iucreq.s,v 1.1.1.1 1996/03/08 15:44:22 mclareni Exp $
-*
-* $Log: iucreq.s,v $
-* Revision 1.1.1.1 1996/03/08 15:44:22 mclareni
-* Cspack
-*
-*
-#if (defined(CERNLIB_IBMVM))&&(defined(CERNLIB_IUCVREQ))
-***************************************************************
-* *
-* Function : Subroutine to pass data from an inpt array to *
-* ======== a server vm in any cpu, via IUCreq interface. *
-* Return reply into an output array, one record *
-* for each element of the array. *
-* *
-* Attributes : Fortran callable, re-entrant. *
-* ========== Base version: *
-* For CMS *
-* System 370 *
-* H-Assembler. *
-* *
-* Format : CALL SYSREQ(SERNAM,COMTXT,RCODE,REPTXT,ARYSZ) *
-* ====== *
-* *
-* Author : Tony Cass CERN CN/SW May 1991 *
-* ====== This version steals much of its code from the *
-* version using the SYSreq interface - written *
-* by Jonathan Wood/RAL. Only the part dealing *
-* with SYSreq/IUCreq communications is changed. *
-* *
-***************************************************************
-SYSREQ CSECT
-#if defined(CERNLIB_QMIBMXA)
-SYSREQ AMODE ANY
-SYSREQ RMODE ANY
-#endif
-*
- USING SYSREQ,R15
- B SAVEREGS
- DC AL1(7),CL7'SYSREQ'
- DC C'1.00'
-SAVEREGS STM R14,R12,12(R13)
- LR R4,R13
- CNOP 0,4
- BAL R13,AROUNDSA
-SAVEAREA DC 18F'0'
- DROP R15
- USING SAVEAREA,R13
-AROUNDSA ST R13,8(0,R4)
- ST R4,4(0,R13)
- XC 8(4,R13),8(R13)
-*
- LR R11,R1 * Save plist pointer
-*
-GETSTOR LA R0,WRKLEN * Length of free core
- SLL R0,3 * Get it in bytes
- GETMAIN R,LV=(R0) * Get the core
- LR R8,R1 * Base Workarea on R8
- USING WRKAREA,R8 * And say so
- ST R8,BUFFADDR * For passing to IUCREQ
-*
-* Set up Defaults in case not fortran 77.
-*
- LA R3,SYSIDEF * R3 = default input length
- LA R5,SYSODEF * R5 = default output length
- LA R6,SYSSLEN * R6 = max len server name
-*
-* Check plist to see if it is Fortran 77
-*
- LR R1,R11 * Restore plist pointer
- LA R2,8 * 8 bytes
- SR R1,R2 * Back to possible prefix
- CLC 0(4,R1),CHAR77 * Is there a char 77 prefix?
- BNE NOT77 * :No - muddle along blindly
-*
-* Fortran 77 - get lengths from secondary plist
-*
-IS77 L R1,4(R1) * :Yes - get secndry displacement
- AR R1,R11 * Point to secondary plist
- L R2,4(R1) * Point to input array length
- LA R3,SYSIMAX * Max input length
- CL R3,0(R2) * Is it greater than max?
- BNH GETPLEN * :Yes - then use max
- L R3,0(R2) * :No - then use actual
-GETPLEN DS 0H * Get output array length
- L R5,12(R1) * Point to output array
- L R5,0(R5) * R5 => Length each output item
-CHKSLEN DS 0H * Check server name length
- L R6,0(R1) * Point to server name length
- CL R1,0(R6) * Is it greater than max?
- BNH LENSOK * :Yes - Then use max
- L R6,0(R6) * :No - Then use true length
-LENSOK DS 0H
-*
-NOT77 DS 0H
-*
- LA R10,L'PREAMBLE(R3,R6) * Total length of IUCREQ command
- LA R10,1(,R10) * add space between server name & command
- BCTR R6,0 * server length-1 for ex
- L R2,0(R11) * Point to server name
- LA R1,SERVER * Point at where we want it
- EX R6,EXMOVE * Move server name to scan in buffer
- LA R1,1(R6,R1) * Next free space in the buffer
- MVI 0(R1),C' ' * Put a blank there
- LA R1,1(,R1) * User command goes here...
- BCTR R3,0 * command length-1 for ex
- L R2,4(R11) * Point to user command
- EX R3,EXMOVE * Move command to scan in buffer
-*
-* Complete register initialisation for decoding reply
-*
- LA R2,REPLY * R2 => Reply buffer start
- L R4,12(R11) * R4 => points to next output item
-* * R5 => output item length
- XR R6,R6 * R6 => output item count
- L R7,16(R11) * R7 => Max output item count
- L R7,0(R7) * Get max output items
-*
-* Estimate Max reply data user can cope with
-*
- LA R1,SYSOMAX * Max output record length
- CLR R1,R5 * Is his item length bigger?
- BL ESTOLEN * :Yes - so use our one
- LR R1,R5 * :No - use his length
-ESTOLEN DS 0H
- LR R12,R7 * Allow one line for possible
- BCTR R12,0 * continuation
- MR R0,R12 * Estimate max space available
- LA R1,REPLHLEN(R1) * Add reply header to it
- LA R0,TOVMMAXR * Max avaiable reply buffer
- CLR R0,R1 * Does user have more than us?
- BL MAXRLEN * :Yes - So use our maximum
- LR R0,R1 * :No - So use estimated maximum
-MAXRLEN STH R0,BUFFLEN * Store it in buffer
-*
-* Scan the command, call IUCREQ and see what happens!
-*
- SCAN TEXT=(SCANIN,(R10)),BUFFER=(SCANOUT,256)
- MVC USERINFO(8),=A(BUFFADDR)
- CMSCALL PLIST=(R1),EPLIST=(R0),UFLAGS=X'01'
-*
-* Can't use ERROR since that moans about +ve return codes too!
-*
- LTR R15,R15
- BM ERROR1
-*
-* Communications handshake complete. Now process reply
-*
-GOTREPLY DS 0H
- LH R9,REPLYLEN * Get reply buffer length
- LA R1,REPLHLEN * Get header length
- SR R9,R1 * Account for reply head
- BNP DORET * Nothing left - don't print
- LA R10,REPLY * Get start of full data
- LA R10,0(R9,R10) * R10 => pointer to end of reply
- LA R2,REPLY * R2 => pointer to reply record
-*
-* Loop over reply, placing one record in each output item
-*
-DEBURST DS 0H
- XR R3,R3 * Clear for insert
- IC R3,0(R2) * R3 => Length this reply record
- LA R2,1(R2) * R2 => Pointer to reply Data
-*
- BAL R14,PUTREC * Return record to user buffer
-* Registers 2,4,6 are correctly adjusted by PUTREC
- LTR R15,R15 * What happenend?
- BZ DEBURST * All ok, more to go
-*
-* Return to caller with SYSREQ return code
-*
-DORET DS 0H * All moved. Set return
- LH R15,REPLYRC * Get rc from server
-SETRET L R1,8(R11) * Address of rc field
- ST R15,0(R1) * Set the return code
- L R1,16(R11) * Point to item count field
- ST R6,0(R1) * Set items returned
- B RETURN * Finish up and go home
-*
-* Communications failure: SYSREQ error of some sort
-*
-ERROR1 DS 0H
- LA R2,MSG1 * Special error msg
- LA R3,L'MSG1 * Length of message
- BAL R14,PUTREC * Give it to caller
- LA R15,1 * Set silly return code
- B SETRET * and give up
-*
-***************************************************************
-* RETURN : Routine to clean up and return to caller *
-***************************************************************
-RETURN DS 0H
- LA R0,WRKLEN * Length of work area
- SLL R0,3 * Get it in bytes
- FREEMAIN R,LV=(R0),A=(R8) * Free up the work area
- L R13,4(,R13)
- LM R0,R12,20(R13) * Restore callers regist
- L R14,12(R13) * Get the return address
- OI 12(R13),X'FF' * Fortran convention
- BR R14 * Go home
-*
-* MVC instruction EX'ed to put input parms in SCAN buffer
-*
- DS 0D
-EXMOVE MVC 0(*-*,R1),0(R2) ****** EXECUTED ******
-*
- EJECT
-***************************************************************
-* PUTREC: Return a record to array element(s) *
-* Registers at entry: R2 -> reply record data *
-* R3 = reply record length *
-* R4 -> Next output item *
-* R5 = Output item length *
-* R6 = Item counter *
-* R7 = Max items *
-* R10 -> End of reply buffer *
-***************************************************************
-PUTREC STM R14,R12,12(R13) * Save callers registers
-*
-* Check if this is the last record
-*
- XR R15,R15 * Set up for rc=0
- LA R9,0(R3,R2) * Point end of this record
- CLR R9,R10 * Is this the last record?
- BL NOTLAST * :No - Ok, as normal
- LA R15,1 * Indicate last record
- LNR R15,R15 * By setting up R15 -ve
-NOTLAST DS 0H
-*
- LR R0,R5 * Item length for restore
- LR R9,R5 * R9 => Length to move each time
- LR R1,R3 * R1 => Remaining length
-*
-PRTLP DS 0H
- CLR R6,R7 * End of output buffer?
- BL MVCAN * :No - Ok then
- LA R15,1 * :Yes - No space, set R15 +ve
- LNR R6,R15 * Set item counter negative
- B MVRET * Return now
-MVCAN LA R6,1(R6) * :No - Bump output item count
- SR R1,R5 * Adjust remaining length
- BNM MVDO * Whole output item to move
- AR R9,R1 * Part output item to move
- ICM R9,B'1000',BLANKS * Padding byte
-MVDO DS 0H
- LR R3,R9 * Length reply data this time
- MVCL R4,R2 * Random storage walk
-*
-MVDUN LR R5,R0 * Restore output item length
- LTR R1,R1 * Any data left?
- BP PRTLP * :Yes - go print it
-*
-MVRET LM R7,R12,48(R13) * Restore registers
- L R14,12(0,R13) * Return address
- BR R14 * Return to caller
-*
-***************************************************************
-* Data, Save, Work areas and constants *
-***************************************************************
- DS 0D
-*
-SCANIN DS CL256
- ORG SCANIN
-PREAMBLE DC C'IUCREQ SYSREQ '
-SERVER DS 0H
- ORG
-SCANOUT DS CL256
-USERINFO EQU SCANOUT+12
-*
-BUFFADDR DC F'0' Buffer address ...
-BUFFLEN DC AL2(OBLEN) and length to pass to IUCREQ
-*
-CHAR77 DC C'BZ',X'0000' * Fort 77 BZ00 char indi
-BLANKS DC C' ' * Some useful blanks
-MSG1 DC C'SYSREQ Communication error.'
-*
-SYSIDEF EQU 120
-SYSODEF EQU 80
-SYSSLEN EQU 8
-SYSIMAX EQU 256-L'PREAMBLE-8 * Bufflen - preamble - server len
-SYSOMAX EQU 240
-*
- LTORG * Literal pool
-*
- REGEQU * Register symbolic equates
-***************************************************************
-* WRKAREA Free storage data area, containing all *
-* non-reentrant data items and save areas *
-***************************************************************
-WRKAREA DSECT * Start of work area in free
-*
-OBLEN EQU 2048 * Total ouput buffer length
-*
- DS 0H * Reply buffer
-REPLYBUF EQU *
-REPLYLEN DS H * Length reply
-REPLYRC DS H * Return code
-REPLMGID DS F * Message id
-OHLEN EQU *-REPLYBUF * Output header length
-REPLY DS 0CL(OBLEN-OHLEN) * Reply record buffer
-REPLTLEN DS C * Reply record length
-REPLYTXT DS C * Reply record text
- DS CL(OBLEN-OHLEN-2) * Rest of reply buffer
-REPLYEND EQU * * End of the reply buffer
-*
-REPLHLEN EQU REPLY-REPLYRC * Length of TOVM header
-TOVMMAXR EQU REPLYEND-REPLYRC * Max reply buffer length
-*
-WRKEND DS 0D * Make whole number of dwords
-WRKLEN EQU (*-WRKAREA)/8 * Length workarea (dwords)
- SPACE ,
-***************************************************************
-* End of Free storage work area *
-***************************************************************
- EJECT ,
-*
- END ,
-#endif
diff --git a/src/packlib/cspack/ibm/srqsrv/sysreq.s b/src/packlib/cspack/ibm/srqsrv/sysreq.s
deleted file mode 100644
index 825be32..0000000
--- a/src/packlib/cspack/ibm/srqsrv/sysreq.s
+++ /dev/null
@@ -1,346 +0,0 @@
-*
-* $Id: sysreq.s,v 1.1.1.1 1996/03/08 15:44:22 mclareni Exp $
-*
-* $Log: sysreq.s,v $
-* Revision 1.1.1.1 1996/03/08 15:44:22 mclareni
-* Cspack
-*
-*
-#if (defined(CERNLIB_IBMVM))&&(!defined(CERNLIB_IUCVREQ))
-***************************************************************
-* *
-* Function : Subroutine to pass data from an inpt array to *
-* ======== a server vm in any cpu, via sysreq interface. *
-* Return reply into an output array, one record *
-* for each element of the array. *
-* *
-* Attributes : Fortran callable, re-entrant. *
-* ========== Base version: *
-* For CMS *
-* System 370 *
-* H-Assembler. *
-* *
-* Format : CALL SYSREQ(SERNAM,COMTXT,RCODE,REPTXT,ARYSZ) *
-* ====== *
-* *
-* Author : Jonathan wood, Systems Group, CCD, Ral, *
-* ====== 03/09/86 *
-* Completely re-written to use common code for *
-* both CMS and MVS versions. *
-* *
-***************************************************************
-#if defined(CERNLIB_QMIBMXA)
-SYSREQ AMODE ANY
-SYSREQ RMODE ANY
-#endif
-SYSREQ CSECT
- B 16(R15) * Branch round header
- DC XL1'7' * Name length
- DC CL7'SYSREQ' * Name
- DC CL4'1.00' * Version.Level
- STM R14,R12,12(R13) * Save callers registers
- LR R12,R15 * Base on R12
- USING SYSREQ,R12 * Say so
- LR R11,R1 * Save parm pointer
-*
-GETSTOR LA R0,WRKLEN * Length of free core
- SLL R0,3 * Get it in bytes
- GETMAIN R,LV=(R0) * Get the core
- LR R8,R1 * Base Workarea on R8
- USING WRKAREA,R8 * And say so
- LA R3,SAVEAREA * Point to new save area
- ST R13,4(0,R3) * Chain fwd to bwd save
- ST R3,8(0,R13) * Chain bwd to fwd save
- LR R13,R3 * Use new save area
-***************************************************************
-*
-* Clear out the SYSREQ header in the buffer
-*
- MVI TOVMMGID,X'00' * Clear the TOVM header
- MVC TOVMMGID+1(TOVMTLEN-1),TOVMMGID
- MVI TOVMSERV,X'40' * Blank server name
- MVC TOVMSERV+1(SYSSLEN-1),TOVMSERV
- XC TOVMCHEK,TOVMCHEK * Zero the checksum
-*
-* Set up Defaults in case not fortran 77.
-*
- LA R3,SYSIDEF * R3 = default input length
- LA R5,SYSODEF * R5 = default output length
- LA R6,SYSSLEN * R6 = max len server na
-*
-* Check plist to see if it is Fortran 77
-*
- LR R1,R11 * Get plist pointer
- LA R2,8 * 8 bytes
- SR R1,R2 * Back to possible prefix
- CLC 0(4,R1),CHAR77 * Is there a char 77 prefix
- BNE NOT77 * :No - muddle along blindly
-*
-* Fortran 77 - get lengths from secondary plist
-*
-IS77 L R1,4(R1) * :Yes - get secndry displacement
- AR R1,R11 * Point to secondary plist
- L R2,4(R1) * Point to input array length
- LA R3,SYSIMAX * Max input length
- CL R3,0(R2) * Is it greater than max
- BNH GETPLEN * :Yes - then use max
- L R3,0(R2) * :No - then use actual
-GETPLEN DS 0H * Get output array length
- L R5,12(R1) * Point to output array
- L R5,0(R5) * R5 => Length each output item
-CHKSLEN DS 0H * Check server name length
- L R6,0(R1) * Point to server name length
- CL R1,0(R6) * Is it greater than max
- BNH LENSOK * :Yes - Then use max
- L R6,0(R6) * :No - Then use true length
-LENSOK DS 0H
-NOT77 DS 0H
- BCTR R6,0 * server length-1 for ex
- L R2,0(R11) * Point to server name
- EX R6,MOVSER * Move server name to he
- B GOTSERV * Brach around executed code
-*
- DS 0D
-MOVSER MVC TOVMSERV(0),0(R2) ****** EXECUTED ******
-*
-GOTSERV DS 0H
-*
-* Copy command to SYSREQ buffer & strip trailing blanks
-*
-*
-REQUEST DS 0H * Move command to SYSREQ buffer
- L R2,4(R11) * Point to command input
- LR R6,R3 * Save length for blank compress
- LR R1,R3 * Length to move
- LA R0,TOVMCOMM * Where to move it to
- MVCL R0,R2 * Random storage walk
-*
- BCTR R6,0 * -1 to get to end of buffer
- LA R9,TOVMCOMM * Start of command buffer
-COMMLEN LA R1,0(R6,R9) * Point to end character
- CLI 0(R1),X'40' * End char blank
- BNE STLEN * :Yes - compute buffer
- BCT R6,COMMLEN * :No - keep looking
-STLEN LA R6,TOVMHLEN+1(R6) * Bump to true length
- STH R6,TOVMLEN * Set length stripped cmnd
-*
-* Complete register SYSREQ header initialisation
-*
- LA R2,REPLY * R2 => Reply buffer start
- L R4,12(R11) * R4 => points to next output item
-* * R5 => output item length
- XR R6,R6 * R6 => output item count
- L R7,16(R11) * R7 => Max output item count
- L R7,0(R7) * Get max output items
-*
-* Estimate Max reply data user can cope with
-*
- LA R1,SYSOMAX * Max output record length
- CLR R1,R5 * Is his item length bigger
- BL ESTOLEN * :Yes - so use our one
- LR R1,R5 * :No - use his length
-ESTOLEN DS 0H
-* LR R12,R7 * Allow one line for possible
-* BCTR R12,0 * continuation
-* MR R0,R12 * Estimate max space available
- MR R0,R7 * Estimate max space available
- LA R1,REPLHLEN(R1) * Add reply header to it
- LA R0,TOVMMAXR * Max avaiable reply buffer
- CLR R0,R1 * Does user have more than us
- BL MAXRLEN * :Yes - So use our maximum
- LR R0,R1 * :No - So use estimated maximum
-MAXRLEN STH R0,TOVMREPL * Store it in buffer
-*
-* Initiate SYSREQ communications
-*
-SENDIT DS 0H * Retry point
- XR R0,R0 * Zero condition code (See below)
- LA R0,TOVMBUF * Point to input buffer
- LA R1,REPLYBUF * Point to output buffer
- DIAG R0,R1,X'140' * Squirt
- BZ GOTREPLY * (CC not set, but just in case)
-*
-* Communications failure: SYSREQ error of some sort
-*
-ERROR1 DS 0H
- LA R2,MSG1 * Special error msg
- LA R3,L'MSG1 * Length of message
- BAL R14,PUTREC * Give it to caller
- LA R15,1 * Set silly return code
- B SETRET * and give up
-*
-* Communications handshake complete. Now process reply
-*
-GOTREPLY DS 0H
- LH R9,REPLYLEN * Get reply buffer length
- LA R1,REPLHLEN * Get header length
- SR R9,R1 * Account for reply head
- BNP DORET * Nothing left - don't print
- LA R10,REPLY * Get start of full data
- LA R10,0(R9,R10) * R10 => pointer to end of reply
- LA R2,REPLY * R2 => pointer to reply record
-*
-* Loop over reply, placing one record in each output item
-*
-DEBURST DS 0H
- XR R3,R3 * Clear for insert
- IC R3,0(R2) * R3 => Length this reply record
- LA R2,1(R2) * R2 => Pointer to reply Data
-*
- BAL R14,PUTREC * Return record to user buffer
-* Registers 2,4,6 are correctly adjusted by PUTREC
- LTR R15,R15 * What happenend
- BZ DEBURST * All ok, more to go
-*
-* Return to caller with SYSREQ return code
-*
-DORET DS 0H * All moved. Set return
- LH R15,REPLYRC * Get rc from server
-SETRET L R1,8(R11) * Address of rc field
- ST R15,0(R1) * Set the return code
- L R1,16(R11) * Point to item count field
- ST R6,0(R1) * Set items returned
- B RETURN * Finish up and go home
-*
-***************************************************************
-* RETURN : Routine to clean up and return to caller *
-***************************************************************
-RETURN DS 0H
- LR R3,R15 * Save the return code
- L R4,4(R13) * Save old save area poi
- LA R0,WRKLEN * Length of work area
- SLL R0,3 * Get it in bytes
- FREEMAIN R,LV=(R0),A=(R8) * Free up the work area
-*
- LR R15,R3 * Set R15=return code
- LR R13,R4 * Restore old save area
- LM R0,R12,20(R13) * Restore callers regist
- L R14,12(R13) * Get the return address
- MVI 12(R13),X'FF' * Fortran convention
- BR R14 * Go home
-*
- EJECT
-***************************************************************
-* PUTREC: Return a record to array element(s) *
-* Registers at entry: R2 -> reply record data *
-* R3 = reply record length *
-* R4 -> Next output item *
-* R5 = Output item length *
-* R6 = Item counter *
-* R7 = Max items *
-* R10 -> End of reply buffer *
-***************************************************************
-PUTREC STM R14,R12,12(R13) * Save callers registers
- LA R9,72(R13) * Next save area on chai
- ST R13,4(0,R9) * chain bwd to fwd
- ST R9,8(0,R13) * Chain fwd to bwd
- LR R13,R9 * Use new save area
-*
-* Check if this is the last record
-*
- XR R15,R15 * Set up for rc=0
- LA R9,0(R3,R2) * Point end of this record
- CLR R9,R10 * Is this the last record
- BL NOTLAST * :No - Ok, as normal
- LA R15,1 * Indicate last record
- LNR R15,R15 * By setting up R15 -ve
-NOTLAST DS 0H
-*
- LR R0,R5 * Item length for restore
- LR R9,R5 * R9 => Length to move each time
- LR R1,R3 * R1 => Remaining length
-*
-PRTLP DS 0H
- CLR R6,R7 * End of output buffer
- BL MVCAN * :No - Ok then
- LA R15,1 * :Yes - No space, set R15 +ve
- LNR R6,R15 * Set item counter negative
- B MVRET * Return now
-MVCAN LA R6,1(R6) * :No - Bump output item count
- SR R1,R5 * Adjust remaining length
- BNM MVDO * Whole output item to move
- AR R9,R1 * Part output item to move
- ICM R9,B'1000',BLANKS * Padding byte
-MVDO DS 0H
- LR R3,R9 * Length reply data this time
- MVCL R4,R2 * Random storage walk
-*
-MVDUN LR R5,R0 * Restore output item length
- LTR R1,R1 * Any data left
- BP PRTLP * :Yes - go print it
-*
-MVRET L R13,4(0,R13) * Get bwd save area
- LM R7,R12,48(R13) * Restore registers
- L R14,12(0,R13) * Return address
- BR R14 * Return to caller
-*
-***************************************************************
-* Data, Save, Work areas and constants *
-***************************************************************
- DS 0D
-CHAR77 DC C'BZ',X'0000' * Fort 77 BZ00 char indi
-BLANKS DC C' ' * Some useful blanks
-MSG1 DC C'SYSREQ Communication error.'
-*
- LTORG * Literal pool
-*
- REGEQU * Register symbolic equates
-***************************************************************
-* WRKAREA Free storage data area, containing all *
-* non-reentrant data items and save areas *
-***************************************************************
-WRKAREA DSECT * Start of work area in free
- SPACE ,
-SAVEAREA DS 36F * Main save area chain
-*
-IBLEN EQU 1024 * Total input buffer length
-OBLEN EQU 2048 * Total ouput buffer length
-*
-TOVMBUF DS 0D * Input buffer for TOVM comms
-TOVMLEN DS H * Exclusive buffer length
-TOVMREPL DS H * Max length of reply buffer
-TOVMMGID DS CL4 * Unique message ID
-TOVMALTU DS CL8 * Alternate userid
- DS CL4 * 'ATWTYPE' (MVS only)
-TOVMCHEK DS F * Checksum (unused)
- DS CL8 * Reserved for Account
- DS CL8 * Spare field!
-TOVMUSER DS CL8 * Requesting userid
- DS CL8 * Originating system
-TOVMSERV DS CL8 * Target service name
-IHLEN EQU *-TOVMLEN * Input header length
-TOVMCOMM DS CL(IBLEN-IHLEN) * User Data Buffer
-*
- DS 0H * Reply buffer
-REPLYBUF EQU *
-REPLYLEN DS H * Length reply
-REPLYRC DS H * Return code
-REPLMGID DS F * Message id
-OHLEN EQU *-REPLYBUF * Output header length
-REPLY DS 0CL(OBLEN-OHLEN) * Reply record buffer
-REPLTLEN DS C * Reply record length
-REPLYTXT DS C * Reply record text
- DS CL(OBLEN-OHLEN-2) * Rest of reply buffer
-REPLYEND EQU * * End of the reply buffer
-*
-TOVMMAXR EQU REPLYEND-REPLYRC * Max reply buffer length
-TOVMHLEN EQU TOVMCOMM-TOVMREPL * Length of TOVM header
-TOVMTLEN EQU TOVMCOMM-TOVMMGID * Length of TOVM header
-REPLHLEN EQU REPLY-REPLYRC * Length of TOVM header
-*
-SYSIMAX EQU L'TOVMCOMM * Max input record length
-SYSOMAX EQU 240 * Max output record length
-SYSIDEF EQU 120 * Default input record length
-SYSODEF EQU 80 * Default output record length
-SYSSLEN EQU L'TOVMSERV * Max length of server name
-*
-WRKEND DS 0D * Make whole number of dwords
-WRKLEN EQU (*-WRKAREA)/8 * Length workarea (dwords)
- SPACE ,
-***************************************************************
-* End of Free storage work area *
-***************************************************************
- EJECT ,
-*
- END ,
-#endif
diff --git a/src/packlib/cspack/ibm/tcpasm/chpas.s b/src/packlib/cspack/ibm/tcpasm/chpas.s
deleted file mode 100644
index 75f565b..0000000
--- a/src/packlib/cspack/ibm/tcpasm/chpas.s
+++ /dev/null
@@ -1,63 +0,0 @@
-*
-* $Id: chpas.s,v 1.1.1.1 1996/03/08 15:44:22 mclareni Exp $
-*
-* $Log: chpas.s,v $
-* Revision 1.1.1.1 1996/03/08 15:44:22 mclareni
-* Cspack
-*
-*
-#if defined(CERNLIB_IBMVM)
- PRINT GEN
-CHPAS EDCPROL
- BALR 12,0
- USING *,12 R12 <-- REGISTRO BASE
- L 2,0(,1) GET ADDR OF PARM 1
- MVC USR,0(2)
- L 2,4(,1) GET ADDR OF PARM 2
- MVC PASSW,0(2)
- SR 1,1 INDEX
- L 4,=F'1' INCREMENT
- L 5,=F'7' LIMIT
- LA 15,USR STRING ADDR
- LA 6,USR-1 POINTER (I NEED IT FOR CLI)
-LOOP1 EQU *
- A 6,=F'1' UPDATE POINTER
- CLI 0(6),0 FIRST NULL ?
- BE MORBLAN
- BXLE 1,4,LOOP1
- B NEXTP
-MORBLAN IC 4,=C' '
- STC 4,0(6) PUT A BLANC
-NEXTP SR 1,1 INDEX
- L 4,=F'1' INCREMENT
- L 5,=F'7' LIMIT
- LA 15,PASSW STRING ADDR
- LA 6,PASSW-1 POINTER (I NEED IT FOR CLI)
-LOOP2 EQU *
- A 6,=F'1' UPDATE POINTER
- CLI 0(6),0 FIRST NULL ?
- BE MORNUL
- BXLE 1,4,LOOP2
- B CONT
-MORNUL IC 4,=C' '
- STC 4,0(6)
-*********************************************************************
-CONT LA 2,EXTRACT 2
- LA 3,4
- DC X'83',X'23',XL2'0180' DIAGNOSE X'180' 2
-*********************************************************************
- CLI 0(15),C'Y'
- BNE PASNOK
- SR 15,15
- B FIN
-PASNOK L 15,=F'1'
-FIN EDCEPIL
- LTORG *
- DS 0D
-EXTRACT DC CL8'SETUSER '
-USR DC CL8' '
- DC CL8'VERIFYPW'
-PASSW DC CL8' '
- DS CL8
- END CHPAS
-#endif
diff --git a/src/packlib/cspack/ibm/tcpasm/fortidc.s b/src/packlib/cspack/ibm/tcpasm/fortidc.s
deleted file mode 100644
index 2b5c974..0000000
--- a/src/packlib/cspack/ibm/tcpasm/fortidc.s
+++ /dev/null
@@ -1,229 +0,0 @@
-*
-* $Id: fortidc.s,v 1.1.1.1 1996/03/08 15:44:22 mclareni Exp $
-*
-* $Log: fortidc.s,v $
-* Revision 1.1.1.1 1996/03/08 15:44:22 mclareni
-* Cspack
-*
-*
-#if defined(CERNLIB_IBMMVS)
- MACRO
- REGISTER
-R0 EQU 0
-R1 EQU 1
-R2 EQU 2
-R3 EQU 3
-R4 EQU 4
-R5 EQU 5
-R6 EQU 6
-R7 EQU 7
-R8 EQU 8
-R9 EQU 9
-R10 EQU 10
-R11 EQU 11
-R12 EQU 12
-R13 EQU 13
-R14 EQU 14
-R15 EQU 15
- MEND
- MACRO
-&NAME SCHL &RET=,&MODE=
-&NAME L 13,4(13) RELOAD SA-REG
- AIF ('&RET' NE '').RETCODE
- LM 14,12,12(13) RELOAD REGISTERS
- BR 14 RETURN TO CALLER
- MEXIT
-.RETCODE AIF ('&RET'(1,1) EQ '(').REGIST
- AIF (T'&RET NE 'N').ADDRESS
- LA 15,&RET LOAD REG 15 WITH RET CODE
- AGO .FURTHER
-.REGIST AIF ('&RET(1)' EQ '15').FURTHER
- LR 15,&RET(1) LOAD REG 15 WITH SPECIF. REGISTER
- AGO .FURTHER
-.ADDRESS L 15,&RET LOAD REG 15 FROM STORAGE
-.FURTHER LM 0,12,20(13) RESTORE REG 0 TO 12
- L 14,12(13) RESTORE REG 14
- BR 14 RETURN TO CALLER
- MEND
-FORTIDC CSECT
-**********************************************************************
-*
-* INVOZIERT IDCAMS
-*
-* AUFRUF: CALL FORTIDC(INLINE,OUTLINE,OUTLGTH,RET)
-*
-* INLINE ENTHAELT DIE INPUT-ZEILE FUER IDCAMS (LAENGE 80)
-* (NUR EINE ZEILE ERLAUBT).
-*
-* OUTLINE ENTHAELT DIE OUTPUT-ZEILE AUS IDCAMS (LAENGE 133)
-* (NUR EINE ZEILE ERLAUBT).
-*
-* OUTLGTH ENTHAELT DIE LAENGE DER OUTPUT-ZEILE (FULLWORD)
-*
-* RET ENTHAELT DEN RETURN-CODE VON IDCAMS (FULLWORD)
-* = 0 NORMALERWEISE
-* = MESSAGENR BEI IDCAMS MESSAGES
-* = -9999 BEI EOF
-*
-* NACH EOF SIND FORTIDC UND IDCAMS WIEDER JUNGFRAEULICH
-* UND KOENNEN MIT DER NAECHSTEN INPUT-KARTE GERUFEN WERDEN.
-* DER INPUT AUS INLINE WIRD NUR BEIM ALLERERSTEN AUFRUF VON
-* FORTIDC UND BEIM ERSTEN AUFRUF NACH RET = -9999 GELESEN.
-*
-* IDCAMS LIEST INPUT VOM PROGRAMM (WIE GESCHILDERT),
-* SYSPRINT WIRD INS PROGRAMM UMGELEITET.
-*
-* (C) P.KUHLMANN, DESY, 8.2.91
-**********************************************************************
- PRINT NOGEN
- REGISTER
- USING *,R12
- STM R14,R12,12(R13) SAVE REGISTERS
- LR R12,R15 SET UP BASE REGISTER
- LA R3,SAVE1 NEW SAVE AREA
- ST R3,R8(R13) SAVE ADDRESS OF NEW SAVE AREA
- ST R13,R4(R3) SAVE ADDRESS OF OLD SAVE AREA
- LR R13,R3 NEW SAVE AREA
-*
- L R2,0(R1) A(INPUT LINE)
- ST R2,INCARD STORE INTO IDCAMS INPUT PARAMETER
- L R2,4(R1) A(OUTPUT-LINE)
- ST R2,ALINE SAVE ADDRESS
- L R2,8(R1) A(LENGTH)
- ST R2,ALGTH SAVE ADDRESS
- L R2,12(R1) A(RETURNCODE)
- ST R2,ARET SAVE ADDRESS
-FIRST BC 0,NEXT FIRST TIME SWITCH
- OI FIRST+1,X'F0' INDICATE NOT FIRST TIME
-***************************************************************
-* *
-* INVOKE ACCESS METHOD SERVICES *
-* SPECIFY I/O-ROUTINES FOR SYSIN AND SYSPRINT *
-* *
-***************************************************************
- LOAD EP=IDCAMS LOAD IDCAMS
- LR R15,R0 GET A(IDCAMS)
- CALL (15),(OPT,OPT,OPT,AIOL),VL CALL IDCAMS
-* RETURN FROM IDCAMS
- NI FIRST+1,X'0F' RESET FIRST TIME SWITCH
- NI GETIN+1,X'0F' RESET FIRST TIME SWITCH
- LH R1,=H'-9999' INDICATE END OF IDCAMS
- L R2,ARET GET ADDRESS OF RETURNCODE
- ST R1,0(R2) SET RETURN CODE
- B EXIT0 RETURN TO CALLER
-*
- DS 0F IDCAMS PARAMETER LIST:
-OPT DC H'0' NO IDCAMS OPTIONS
-AIOL DC F'2' 2 ENTRIES IN IO LIST
- DC A(DDSYSIN) SYSIN
- DC A(GETC) ROUTINE TO SATISFY SYSIN REQUESTS
- DC A(0)
- DC A(DDSYSPRT) SYSPRINT
- DC A(PUTC) ROUTINE TO SATISFY SYSPRINT REQUESTS
- DC A(0)
-DDSYSIN DC CL10'DDSYSIN'
-DDSYSPRT DC CL10'DDSYSPRINT'
-SAVE DS 18F SAVE AREA WHEN CALLED FROM IDCAMS
-SAVE1 DS 18F SAVE AREA WHEN CALLED FROM CALLER
-***************************************************************
-* *
-* INPUT ROUTINE *
-* TO SUBMIT INPUT CARDS TO AMS *
-* *
-***************************************************************
-GETC STM R14,R12,12(R13) SAVE REGISTERS ON CALL FROM IDCAMS
- LR R12,R15
- LA R15,GETC-FORTIDC
- SR R12,R15 SET UP BASE REGISTER
- LA R3,SAVE NEW SAVE AREA ON CALL FROM IDCAMS
- ST R3,R8(R13) SAVE NEW SAVE AREA
- ST R13,R4(R3) SAVE OLD SAVE AREA
- LR R13,R3 NEW SAVE AREA
-*
- L R2,4(R1) A(IOFLAGS)
- XR R3,R3
- IC R3,0(R2) GET KIND OF REQUEST FROM IDCAMS
- B LISTIN(R3) BRANCH RESPECTIVELY
-LISTIN B OPENIN OPEN FOR INPUT
- B CLOSEIN CLOSE INPUT
- B GETIN GET INPUT
- B PUTIN PUT INPUT (SHOULD NEVER OCCUR)
-*
-OPENIN TM 1(R2),X'A0' OPEN FOR INPUT WITH DDNAME ?
- BNO ABEND
- L R2,8(R1) A(DDNAME)
- CLC 0(8,R2),DDSYSIN+2 SYSIN ?
- BNE ABEND
- B EXIT0 YES, RETURN TO IDCAMS
-*
-GETIN BC 0,EOF FIRST TIME SWITCH
- OI GETIN+1,X'F0' INDICATE NOT FIRST TIME
- L R2,=A(INCARD) CURRENT INPUT CARD
- L R3,8(R1)
- MVC 0(8,R3),0(R2) DATA ADDRESS AND LENGTH TO IDCAMS
- B EXIT0 RETURN TO IDCAMS
-EOF SCHL RET=4 INDICATE END OF INPUT TO IDCAMS
-INCARD DS F
- DC F'80'
-***************************************************************
-* *
-* OUTPUT ROUTINE *
-* TO COLLECT MESSAGES FROM AMS *
-* *
-***************************************************************
-PUTC STM R14,R12,12(R13) SAVE REGISTERS
- LR R12,R15
- LA R15,PUTC-FORTIDC
- SR R12,R15 SET UP BASE REGISTER
- LA R3,SAVE NEW SAVE AREA ON CALL FROM IDCAMS
- ST R3,R8(R13) SAVE NEW SAVE AREA
- ST R13,R4(R3) SAVE OLD SAVE AREA
- LR R13,R3 NEW SAVE AREA
-*
- LR R8,R1 SAVE PARAMETER REGISTER
- L R2,4(R8) A(IOFLAGS)
- XR R3,R3
- IC R3,0(R2) GET KIND OF REQUEST FROM IDCAMS
- LH R6,2(R2) GET MESSAGE NR
- B LISTOUT(R3) BRANCH RESPECTIVELY
-LISTOUT B OPENOUT OPEN FOR OUTPUT
- B CLOSEOUT CLOSE OUTPUT
- B GETOUT GET OUTPUT (SHOULD NEVER OCCUR)
- B PUTOUT PUT OUTPUT
-*
-OPENOUT TM 1(R2),X'60' OPEN FOR OUTPUT WITH DDNAME ?
- BNO ABEND
- L R2,8(R8) A(DSNAME)
- CLC 0(8,R2),DDSYSPRT+2 SYSPRINT
- BNE ABEND
- B EXIT0
-*
-PUTOUT L R2,8(R8) PUT LIST
- L R3,0(R2) A(OUTPUT LINE)
- L R4,4(R2) LENGTH OF PUTPUT LINE
- L R5,ALGTH
- ST R4,0(R5) SET OUTPUT LGTH
- BCTR R4,0
- L R5,ALINE RESTORE OUTPUT POINTER ADDRESS
- EX R4,MOVLN SET OUTPUT LINE
- L R2,ARET RESTORE ADDRESS OF RETURN CODE
- ST R6,0(R2) SET MESSAGE NUMBER
- LA R13,SAVE1 RESTORE CALLERS SAVE ROUTINE
- B EXIT0 EXIT TO CALLER
-MOVLN MVC 0(1,R5),0(R3)
-*
-NEXT LA R13,SAVE RETURN FROM CALLER
-CLOSEIN EQU * CLOSE FOR INPUT
-CLOSEOUT EQU * CLOSE FOR OUTPUT
-EXIT0 SCHL RET=0 RETURN TO IDCAMS
-*
-PUTIN EQU * PUT INPUT
-GETOUT EQU * GET OUTPUT
-ABEND ABEND 1,DUMP
-*
-ALINE DS F A(OUTPUT LINE)
-ALGTH DS F A(OUTPUT LENGTH)
-ARET DS F A(RETURN CODE)
-*
- END FORTIDC
-#endif
diff --git a/src/packlib/cspack/ibm/tcpasm/getinh.s b/src/packlib/cspack/ibm/tcpasm/getinh.s
deleted file mode 100644
index 8ad3f49..0000000
--- a/src/packlib/cspack/ibm/tcpasm/getinh.s
+++ /dev/null
@@ -1,245 +0,0 @@
-*
-* $Id: getinh.s,v 1.1.1.1 1996/03/08 15:44:22 mclareni Exp $
-*
-* $Log: getinh.s,v $
-* Revision 1.1.1.1 1996/03/08 15:44:22 mclareni
-* Cspack
-*
-*
-#if defined(CERNLIB_IBMMVS)
-* $GETINH (PL/I)
-* GETINH (FORTRAN,PASCAL)
-*
-* PROMPT A MESSAGE ON A TSO TERMINAL AND READ TYPED ANSWER
-* ON THE SAME LINE
-*
-* AUTHOR:
-* G. WEIL CENTRE DE CALCUL DE STRASBOURG (CNRS)
-*
-* 17/02/91: /MK/,GSI
-* MODIFIED TO RUN IN AMODE=31,RMODE=ANY.
-* 18/02/91: /MK/,GSI
-* DO NOT ECHO USER RESPONSE (E.G. FOR PASSWORDS)
-* 19/02/91: /MK/,GSI
-* SEPARATE ENTRIES FOR FORTRAN/PASCAL AND PL/I
-*
-* PL/I USAGE:
-* ==============
-*
-* DCL OUT,IN CHAR(*) VAR; ! PROMPT & READ STRING
-* OR DCL OUT,IN CHAR(*); ! PROMPT & READ STRING
-* BIN FIXED(31) IST; ! RETURN CODE
-*
-* CALL $GETINH( OUT, IN, IST );
-*
-* FORTRAN USAGE:
-* ==============
-*
-* CHARACTER*(*) OUT, IN ! PROMPT & READ STRING
-* INTEGER LGOUT, LGIN ! THEIR MAX. LENGTH
-* INTEGER IST ! RETURN CODE
-* CALL GETINH ( OUT, LGOUT, IN, LGIN, IST )
-*
-* PASCAL USAGE:
-* ==============
-*
-* program test;
-* type
-* stringxx = packed array [1..xx] of char;
-* Procedure GETINH( var cbufin: stringxx;
-* var lbufin: integer;
-* var cbufout: stringxx;
-* var lbufout: integer;
-* var irc: integer );
-* external;
-* var
-* cprompt : packed array [1..80] of char;
-* cc : packed array [1..80] of char;
-* lin, lout, nn : integer;
-*
-* begin;
-* cprompt:='enter password 1';
-* lin := 16; lout := 80; nn := 0;
-* GETINH( cprompt, lin, cc, lout, nn );
-* end.
-*
-* IST STATUS (OUTPUT)
-* >0 NB OF CHARACTERS READ
-* -01 BAD LGOUT
-* -02 BAD LGIN
-* -08 'ATTN' INTERRUPT RECEIVED
-* -12 BUFFER TOO SMALL
-* -20 TERMINAL DISCONNECTED
-*
-*
-*
-$GETINH AMODE 31
-$GETINH RMODE ANY
-*
- MACRO
- REGS
- PUSH PRINT
- PRINT ON,NOGEN
-R0 EQU 0
-R1 EQU 1
-R2 EQU 2
-R3 EQU 3
-R4 EQU 4
-R5 EQU 5
-R6 EQU 6
-R7 EQU 7
-R8 EQU 8
-R9 EQU 9
-R10 EQU 10
-R11 EQU 11
-R12 EQU 12
-R13 EQU 13
-R14 EQU 14
-R15 EQU 15
-F0 EQU 0
-F2 EQU 2
-F4 EQU 4
-F6 EQU 6
- POP PRINT
- MEND
-*
-$GETINH CSECT PL/I ENTRY
- ENTRY GETINH
- REGS
- USING $GETINH,R15 addressability
- SAVE (14,12) SAVE REGISTERS
- LM R2,R4,0(R1) LOAD PL/I PARAMETER ADDRESSES
- LR R6,R4 SAME REG.S AS FORTRAN
- LR R4,R3
- SR R7,R7 RESET PTR. TO VAR. STRING PREFIX
-*
-* PL/I STRING HANDLING, PROMPT
-*
- LA R3,4(0,R2) PTR. TO MAX LENGTH
- L R2,0(0,R2) PTR. TO STRING ITSELF
- TM 2(R3),X'80' FIXED/VARYING ?
- BZ OUT_FIXED
- LA R3,0(0,R2) PTR. TO PREFIX
- LA R2,2(0,R2) PTR. TO STRING
-OUT_FIXED EQU *
- LH R3,0(0,R3) LOAD STRING LENGTH
-*
-* PL/I STRING HANDLING, input buffer
-*
- LA R5,4(0,R4) PTR. TO MAX LENGTH
- L R4,0(0,R4) PTR. TO STRING
- TM 2(R5),X'80' FIXED/VARYING ?
- BZ IN_FIXED
- LA R7,0(0,R4) PTR. TO PREFIX
- SR R0,R0
- STH R0,0(0,R7) RETURN NULL STRING (DEFAULT)
- LA R4,2(0,R4) PTR. TO STRING
-IN_FIXED EQU *
- LH R5,0(0,R5) LOAD MAX. STRING LENGTH
- LA BASE,$GETINH_START ADDRESSABILITY
- DROP R15 GIVE UP
- USING $GETINH_START,BASE SAME BASE AS FORTRAN ENTRY
- B $GETINH_START
-*
-* ***
-*
-GETINH EQU * FORTRAN & PASCAL ENTRY
-*
- DROP BASE
- USING GETINH,R15 ADDRESSABILITY
- SAVE (14,12)
- LM R2,R6,0(R1) PICKUP PARAMETER ADDRESSES
- L R3,0(0,R3) LENGTH PROMPT STRING
- L R5,0(0,R5) LENGTH BUFFER STRING
- SR R7,R7
- LA BASE,$GETINH_START
- DROP R15
- USING $GETINH_START,BASE
-$GETINH_START EQU * COMMON START & BASE REFERENCE
-*
-* *** CHECK REASONABLE LENGTH OF GIVEN I/O BUFFERS
-*
- SR R15,R15
- BCTR R15,0 -1
- LTR R3,R3
- BNH GO_HOME
- BCTR R15,0 -2
- LTR R5,R5
- BNH GO_HOME
-*
-* *** DYNAMIC SAVE AREA FOR TPUT/GET
-*
- GETMAIN RC,LV=72
- ST R13,4(R1)
- ST R1,8(R13)
- LR R13,R1
-*
-* *** ALLOCATE LOCAL BUFFER SPACE < 16MB FOR TPUT/GET
-*
- LR R11,R5
- GETMAIN R,LV=(R11) INPUT BUF
- LR R10,R1
- LA R9,1(0,R3) LENGTH+1
- GETMAIN R,LV=(R9) OUTPUT BUF
- LR R8,R1 ADDRESS OF BUFFER
- LR R0,R8 ADDRESS OF BUFFER
- LR R1,R3 LENGTH
- MVCL R0,R2 COPY OUTPUT BUFFER
- LR R2,R0
- MVI 0(R2),BYP_INP INSERT BYPASS/INHIBIT CHARACTER
-*
-* *** TPUT PROMPT STRING AND TGET ANSWER
-*
- ICM R8,B'1000',=AL1(PUTFLG) INSERT FLAG
- TPUT (R8),(R9),ASIS
- LTR R15,R15
- BNZ ERREUR
- ICM R10,B'1000',=AL1(GETFLG)
- TGET (R10),(R11),R
- LTR R15,R15
- BNZ ERREUR
- LNR R15,R1
-*
-* *** COPY BACK THE DATA READ
-*
- LR R0,R10 BUFFER ADDRESS
- ICM R1,B'1000',=CL1' ' PAD WITH BLANKS
- MVCL R4,R0 COPY BACK RECEIVED DATA
-*
-* *** ERROR HANDLING AND CLEANUP
-*
-ERREUR LCR R15,R15
- ST R15,0(R6)
- LTR R7,R7
- BE SKIP_VAR1 RETURN PL/I CHAR(*) VARYING ??
- LTR R15,R15
- BNH SKIP_VAR1
- STH R15,0(0,R7)
-SKIP_VAR1 EQU *
- L R3,4(R13)
- FREEMAIN RC,LV=72,A=(R13)
- FREEMAIN R,LV=(R11),A=(R10)
- FREEMAIN R,LV=(R9),A=(R8)
- LR R13,R3
- RETURN (14,12),T,RC=0
-*
-GO_HOME EQU *
- ST R15,0(R6)
- LTR R7,R7
- BE SKIP_VAR2 RETURN PL/I CHAR(*) VARYING ??
- LTR R15,R15
- BNH SKIP_VAR2
- STH R15,0(0,R7)
-SKIP_VAR2 EQU *
- RETURN (14,12),T,RC=0
-*
-* *** CONSTANT DEFINITIONS
-*
-PUTFLG EQU B'00000001'
-GETFLG EQU B'10000000'
-BYP_INP EQU X'24' BYPASS/INHIBIT CHARACTER
-*
-BASE EQU R12
-*
- END
-#endif
diff --git a/src/packlib/cspack/ibm/tcpasm/getuniq.s b/src/packlib/cspack/ibm/tcpasm/getuniq.s
deleted file mode 100644
index 7475d8e..0000000
--- a/src/packlib/cspack/ibm/tcpasm/getuniq.s
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: getuniq.s,v 1.1.1.1 1996/03/08 15:44:22 mclareni Exp $
-*
-* $Log: getuniq.s,v $
-* Revision 1.1.1.1 1996/03/08 15:44:22 mclareni
-* Cspack
-*
-*
-#if defined(CERNLIB_IBMVM)
- PRINT GEN
-GETUNIQ EDCPROL
- BALR 12,0
- USING *,12 R12 <-- REGISTRO BASE
-*********************************************************************
- LA 2,EXTRACT 2
- LA 3,2
- DC X'83',X'23',XL2'0180' DIAGNOSE X'180' 2
-*********************************************************************
- L 15,PID
-FIN EDCEPIL
- LTORG *
-EXTRACT DC CL8'UNIQUE '
- DS CL4
-PID DS CL4
- END GETUNIQ
-#endif
diff --git a/src/packlib/cspack/ibm/tcpasm/getusr.s b/src/packlib/cspack/ibm/tcpasm/getusr.s
deleted file mode 100644
index e8c842e..0000000
--- a/src/packlib/cspack/ibm/tcpasm/getusr.s
+++ /dev/null
@@ -1,56 +0,0 @@
-*
-* $Id: getusr.s,v 1.1.1.1 1996/03/08 15:44:22 mclareni Exp $
-*
-* $Log: getusr.s,v $
-* Revision 1.1.1.1 1996/03/08 15:44:22 mclareni
-* Cspack
-*
-*
-#if defined(CERNLIB_IBMVM)
- PRINT GEN
-GETUSR EDCPROL
- BALR 12,0
- USING *,12 R12 <-- REGISTER BASE
-*********************************************************************
- LA 2,EXTRACT 2
- LA 3,2
- DC X'83',X'23',XL2'0180' DIAGNOSE X'180' 2
-*********************************************************************
- SR 1,1 INDEX
- L 4,=F'1' INCREMENT
- L 5,=F'7' LIMIT
- LA 15,RESULT STRING ADDR
- LA 6,RESULT-1 POINTER (I NEED IT FOR CLI)
-BUCLE EQU *
- A 6,=F'1' UPDATE POINTER
- CLI 0(6),C' ' FIRST BLANK ?
- BE PUTNUL
- TR 0(,6),TAB Translate to lowercase
- BXLE 1,4,BUCLE
- A 6,=F'1' UPDATE POINTER
-PUTNUL SR 4,4
- STC 4,0(6)
-FIN EDCEPIL
- LTORG *
-EXTRACT DC CL8'USER '
-RESULT DS CL8
- DS C NULL HOLDER
-TAB EQU *
- DC X'000102030405060708090A0B0C0D0E0F'
- DC X'101112131415161718191A1B1C1D1E1F'
- DC X'202122232425262728292A2B2C2D2E2F'
- DC X'303132333435363738393A3B3C3D3E3F'
- DC X'404142434445464748494A4B4C4D4E4F'
- DC X'505152535455565758595A5B5C5D5E5F'
- DC X'606162636465666768696A6B6C6D6E6F'
- DC X'707172737475767778797A7B7C7D7E7F'
- DC X'808182838485868788898A8B8C8D8E8F'
- DC X'909192939495969798999A9B9C9D9E9F'
- DC X'A0A1A2A3A4A5A6A7A8A9AAABACADAEAF'
- DC X'B0B1B2B3B4B5B6B7B8B9BABBBCBDBEBF'
- DC X'C0818283848586878889CACBCCCDCECF'
- DC X'D0919293949596979899DADBDCDDDEDF'
- DC X'E0E1A2A3A4A5A6A7A8A9EAEBECEDEEEF'
- DC X'F0F1F2F3F4F5F6F7F8F9FAFBFCFDFEFF'
- END GETUSR
-#endif
diff --git a/src/packlib/cspack/ibm/tcpasm/lnrd.s b/src/packlib/cspack/ibm/tcpasm/lnrd.s
deleted file mode 100644
index 1ee6c9a..0000000
--- a/src/packlib/cspack/ibm/tcpasm/lnrd.s
+++ /dev/null
@@ -1,64 +0,0 @@
-*
-* $Id: lnrd.s,v 1.1.1.1 1996/03/08 15:44:22 mclareni Exp $
-*
-* $Log: lnrd.s,v $
-* Revision 1.1.1.1 1996/03/08 15:44:22 mclareni
-* Cspack
-*
-*
-#if defined(CERNLIB_IBMVM)
- PRINT GEN
-LNRD EDCPROL
- BALR 12,0
- USING *,12 R12 <-- REGISTRO BASE
- L 2,0(,1) GET ADDR OF PARM 1
- MVC PRBF,0(2)
- SR 1,1 INDEX
- L 4,=F'1' INCREMENT
- L 5,=F'100' LIMIT
- LA 6,PRBF-1 POINTER (I NEED IT FOR CLI)
-LOOP1 EQU *
- A 6,=F'1' UPDATE POINTER
- CLI 0(6),0 FIRST NULL ?
- BE MORBLAN
- BXLE 1,4,LOOP1
- A 6,=F'1' UPDATE POINTER
-MORBLAN SR 7,7
-NEXBLAN STC 7,0(6)
- A 6,=F'1' UPDATE POINTER
- BXLE 1,4,NEXBLAN
-***********************************************************************
-GETIT LINERD DATA=(BUF,L'BUF), *
- CASE=MIXED, *
-* *
-#if !defined(CERNLIB_BATCH)
- TYPE=DIRECT, *
-* *
-#endif
-#if defined(CERNLIB_BATCH)
- TYPE=STACK, *
-* *
-#endif
- WAIT=YES, *
- PROMPT=(PRBF,L'PRBF)
-***********************************************************************
- SR 1,1 INDEX
- L 4,=F'1' INCREMENT
- L 5,=F'240' LIMIT
- LA 15,BUF STRING ADDR
- LA 6,BUF-1 POINTER (I NEED IT FOR CLI)
-BUCLE EQU *
- A 6,=F'1' UPDATE POINTER
- CLI 0(6),C' ' FIRST BLANC ?
- BE PUTNUL
- BXLE 1,4,BUCLE
- A 6,=F'1' UPDATE POINTER
-PUTNUL SR 4,4
- STC 4,0(6)
-FIN EDCEPIL
- LTORG *
-PRBF DS CL100
-BUF DS CL240
- DS C NULL HOLDER
- END LNRD
-#endif
diff --git a/src/packlib/cspack/ibm/tcpasm/lnrdpas.s b/src/packlib/cspack/ibm/tcpasm/lnrdpas.s
deleted file mode 100644
index eb32ac1..0000000
--- a/src/packlib/cspack/ibm/tcpasm/lnrdpas.s
+++ /dev/null
@@ -1,64 +0,0 @@
-*
-* $Id: lnrdpas.s,v 1.1.1.1 1996/03/08 15:44:22 mclareni Exp $
-*
-* $Log: lnrdpas.s,v $
-* Revision 1.1.1.1 1996/03/08 15:44:22 mclareni
-* Cspack
-*
-*
-#if defined(CERNLIB_IBMVM)
- PRINT GEN
-LNRDPAS EDCPROL
- BALR 12,0
- USING *,12 R12 <-- REGISTRO BASE
- L 2,0(,1) GET ADDR OF PARM 1
- MVC PRBF,0(2)
- SR 1,1 INDEX
- L 4,=F'1' INCREMENT
- L 5,=F'100' LIMIT
- LA 6,PRBF-1 POINTER (I NEED IT FOR CLI)
-LOOP1 EQU *
- A 6,=F'1' UPDATE POINTER
- CLI 0(6),0 FIRST NULL ?
- BE MORBLAN
- BXLE 1,4,LOOP1
- A 6,=F'1' UPDATE POINTER
-MORBLAN SR 7,7
-NEXBLAN STC 7,0(6)
- A 6,=F'1' UPDATE POINTER
- BXLE 1,4,NEXBLAN
-***********************************************************************
-GETIT LINERD DATA=(BUF,L'BUF), *
- CASE=MIXED, *
-* *
-#if !defined(CERNLIB_BATCH)
- TYPE=INVISIBLE, *
-* *
-#endif
-#if defined(CERNLIB_BATCH)
- TYPE=STACK, *
-* *
-#endif
- WAIT=YES, *
- PROMPT=(PRBF,L'PRBF)
-***********************************************************************
- SR 1,1 INDEX
- L 4,=F'1' INCREMENT
- L 5,=F'240' LIMIT
- LA 15,BUF STRING ADDR
- LA 6,BUF-1 POINTER (I NEED IT FOR CLI)
-BUCLE EQU *
- A 6,=F'1' UPDATE POINTER
- CLI 0(6),C' ' FIRST BLANC ?
- BE PUTNUL
- BXLE 1,4,BUCLE
- A 6,=F'1' UPDATE POINTER
-PUTNUL SR 4,4
- STC 4,0(6)
-FIN EDCEPIL
- LTORG *
-PRBF DS CL100
-BUF DS CL240
- DS C NULL HOLDER
- END LNRDPAS
-#endif
diff --git a/src/packlib/cspack/ibm/tsoserv/tsosubd.c b/src/packlib/cspack/ibm/tsoserv/tsosubd.c
deleted file mode 100644
index 543cec8..0000000
--- a/src/packlib/cspack/ibm/tsoserv/tsosubd.c
+++ /dev/null
@@ -1,992 +0,0 @@
-/*
- * $Id: tsosubd.c,v 1.1.1.1 1996/03/08 15:44:22 mclareni Exp $
- *
- * $Log: tsosubd.c,v $
- * Revision 1.1.1.1 1996/03/08 15:44:22 mclareni
- * Cspack
- *
- */
-#if defined(CERNLIB_IBMMVS)
-#include "sys/CERNLIB_machine.h"
-#include "_cspack/pilot.h"
-/*
- TSOSUBD Version 1.1.4 - 19 Feb 1990
-*/
-
-#define MVS
-#include <manifest.h>
-#include <bsdtypes.h>
-#include <socket.h>
-#include <bsdtime.h>
-#include <stdio.h>
-#include <in.h>
-#include <netdb.h>
-#include <time.h>
-
-#pragma linkage(CMXLATE,OS)
-
-#define JCL_OUTPUT_DSN "TSOSUB.CNTL"
-
-#define FALSE (0)
-#define TRUE (1)
-
-#define PORTMIN 5001 /* Portnumbers start at PORTMIN+1 */
-#define PORTMAX 5500
-
-#define BACKLOG 5
-#define MAXHOSTNAME 32
-
-#define recv_submit_send RESUWR
-
-#define VERSION "1.0.0 1/1/92"
-
-int verbose;
-int sport = PORTMIN;
-int jobnumber = -1;
-
-main(argc,argv) int argc; char **argv;
-{
- int listen_socket, jcl_socket;
- int i;
- int port_number;
- struct linger l;
- struct sockaddr_in sa;
- struct sockaddr_in r_sa;
- int r_sa_lng;
- char *inet_ntoa();
- char remote_host[150];
- struct sockaddr isa;
- struct hostent *hp;
- struct servent *sp;
- char localhost[MAXHOSTNAME+1];
- int wake_up_interval;
- int num_fds, nfound;
- unsigned long readfds;
- struct timeval timeout;
- time_t lt;
-
- int i_reuseaddr;
-
-
- port_number = 5001;
- verbose = FALSE;
- wake_up_interval = 0;
-
- for(i = 1; i < argc; ++i) {
-
- if(argv[i][0] != '-') continue;
-
- switch(argv[i][1])
- {
- case 'w':
- case 'W':
- if(++i == argc) continue;
- wake_up_interval = atoi(argv[i]);
- break;
- case 'p':
- case 'P':
- if(++i == argc) continue;
- port_number = atoi(argv[i]);
- break;
- case 'v':
- case 'V':
- verbose = TRUE;
- break;
- } /* switch (argv..... */
- } /* for(argn.... */
-
- /* Get a socket */
- if ((listen_socket = socket(AF_INET,SOCK_STREAM,0)) < 0) {
- tcperror("socket");
- exit(1);
- }
-
- if (verbose) {
- printf("listen_socket = %i\n",listen_socket);
- }
-
- /* I want to reuse address */
- i_reuseaddr = 1;
- if (
- setsockopt(
- listen_socket, SOL_SOCKET, SO_REUSEADDR,
- (char *) &i_reuseaddr,sizeof(i_reuseaddr)) < 0 ) {
- tcperror("setsocketopt SO_REUSEADDR");
- }
-
- /* Get the local host information */
- (void)gethostname(localhost,MAXHOSTNAME);
- if((hp = gethostbyname(localhost)) == NULL) {
- fprintf(stderr,"Cannot get local host info?\n");
- exit(1);
- }
-
- /* Set the things for the bind call */
- sa.sin_addr.s_addr=INADDR_ANY;
- sa.sin_family = hp->h_addrtype;
- sa.sin_port=port_number;
-
-
- /* bind the socket */
- if(bind(listen_socket,&sa,sizeof sa,0) < 0) {
- tcperror("bind");
- exit(1);
- }
-
- listen(listen_socket,BACKLOG);
-
- /* print out a startup message */
- printf("TSOSVR Version %s GSI / Darmatadt\n",VERSION);
- time(<);
- printf("Server started at %s\n",asctime(localtime(<)));
-
- /* Loop forever */
- for (;;) {
-
- if (wake_up_interval != 0) {
- readfds |= (1 << listen_socket);
- timeout.tv_sec=wake_up_interval;
- nfound = select(listen_socket+1,&readfds,0,0,&timeout);
- if (nfound==0) {
- continue;
- }
- } /* wake_up_interval */
- /* Just wait for someone to connect to us */
- i = sizeof isa;
- if ((jcl_socket = accept(listen_socket,&isa,&i)) < 0) {
- tcperror("accept");
- exit(1);
- }
-
- r_sa_lng = sizeof r_sa;
- if (getpeername(jcl_socket,&r_sa,&r_sa_lng) != 0) {
- tcperror("accept");
- }
- strcpy(remote_host,inet_ntoa(r_sa.sin_addr.s_addr));
- time(<);
- strcat(remote_host," on ");
- strcat(remote_host,asctime(localtime(<)));
- remote_host[strlen(remote_host)-1]='\0';
- printf("\nConnection from %s.\n",remote_host);
- fflush(stdout);
-
- /* read and submit JCL */
- if (read_submit(jcl_socket)) {
-
- /* readjcl will return 1 if special "stop-string" is received */
- if ( close(listen_socket,2) < 0) {
- tcperror("close listen_socket");
- }
- if ( close(jcl_socket,2) < 0) {
- tcperror("close jcl_socket");
- }
- printf("Shutting down.\n");
- fflush(stdout);
- fflush(stderr);
- exit(0);
- }
-
- /* all done close the jcl_socket, and go wait for the next connect */
- if ( close(jcl_socket,2) < 0) {
- tcperror("close jcl_socket");
- }
-
- if (verbose) {
- printf("jcl_socket is closed\n");
- }
-
- fflush(stdout);
- fflush(stderr);
- }
-}
-
-
-int
-read_submit(sock)
-int sock;
-{
- char rmachine[80];
- char ruser[80];
- char rtty[80];
- char mvs_userid[80];
- char mvs_passwd[80];
- char tso_cmd[80];
- char cmvs_sport[80];
- int mvs_sport;
-
- extern char asciitoebcdic[];
- extern char ebcdictoascii[];
-
-
- char cmd[80];
- char command[80];
- char jobname[80];
- char servreply[80];
-
- int i_open = 0;
-
- register char *c;
-
- FILE *jcl_output;
-
- int k;
- int j=0;
- int i;
-
- int ilines = 7;
- char *cntl??(??) = {
- "//TSO EXEC LGN001 \n",
- "//SYSIN DD DUMMY \n",
- "//SYSPRINT DD SYSOUT=T \n",
- "//SYSTERM DD SYSOUT=T \n",
- "//FT05F001 DD DUMMY \n",
- "//FT06F001 DD SYSOUT=T \n",
- "//SYSTSPRT DD SYSOUT=T \n",
- "//SYSTSIN DD * \n"};
-
- if (verbose) {
- printf ("read_submit entered\n");
- fflush(stdout);
- }
-
- /* read strings from socket */
- if ( getstr(sock,rmachine,sizeof(rmachine),"rmachine") <= 0) {
- sprintf(servreply,"Error: Problem in getting rmachine");
- goto bad;
- }
-
- if ( getstr(sock,ruser,sizeof(ruser),"ruser") <= 0) {
- sprintf(servreply,"Error: Problem in getting ruser");
- goto bad;
- }
-
- if ( getstr(sock,rtty,sizeof(rtty),"rtty") <= 0) {
- sprintf(servreply,"Error: Problem in getting rtty");
- goto bad;
- }
-
- if ( getstr(sock,mvs_userid,sizeof(mvs_userid),"mvs_userid") <= 0) {
- sprintf(servreply,"Error: Problem in getting mvs_userid");
- goto bad;
- }
-
- if ( getstr(sock,mvs_passwd,sizeof(mvs_passwd),"mvs_passwd") <= 0) {
- sprintf(servreply,"Error: Problem in getting mvs_passwd");
- goto bad;
- }
-
- if ( getstr(sock,tso_cmd,sizeof(tso_cmd),"tso_cmd") <= 0) {
- sprintf(servreply,"Error: Problem in getting tso_cmd");
- goto bad;
- }
-
- if ( getstr(sock,cmvs_sport,sizeof(cmvs_sport),"cmvs_sport") <= 0) {
- sprintf(servreply,"Error: Problem in getting cmvs_sport");
- goto bad;
- }
-
-
- CMXLATE(rmachine,asciitoebcdic,strlen(rmachine));
- CMXLATE(ruser,asciitoebcdic,strlen(ruser));
- CMXLATE(rtty,asciitoebcdic,strlen(rtty));
- CMXLATE(mvs_userid,asciitoebcdic,strlen(mvs_userid));
- CMXLATE(mvs_passwd,asciitoebcdic,strlen(mvs_passwd));
- CMXLATE(tso_cmd,asciitoebcdic,strlen(tso_cmd));
- CMXLATE(cmvs_sport,asciitoebcdic,strlen(cmvs_sport));
-
- c = mvs_passwd; while (*c) { if (islower(*c)) *c = toupper(*c); c++; }
- c = mvs_userid; while (*c) { if (islower(*c)) *c = toupper(*c); c++; }
- mvs_sport = atoi(cmvs_sport);
-
- if (verbose) {
- printf ("We have read from socket\n");
- printf ("rmachine : %s \n",rmachine);
- printf ("ruser : %s \n",ruser);
- printf ("rtty : %s \n",rtty);
- printf ("mvs_userid : %sº\n",mvs_userid);
- printf ("tso_cmd : %s \n",tso_cmd);
- printf ("mvs_sport : %i \n",mvs_sport);
- fflush(stdout);
- }
-
- /* test of mvs_userid/mvs_passwd */
- if (chpass(mvs_userid,mvs_passwd) <0 ){
- sprintf(servreply,
- "Bad user and/or password for user %s.",mvs_userid) ;
- goto bad;
- }
-
- /* shutting down */
- if ((!strncmp(mvs_userid,"RZ",2) || !strncmp(mvs_userid,"RS",2))
- && !strncmp(tso_cmd,"tsosubend",9) ) {
- sprintf(servreply,"Shutting down TSOSUB.");
- j = 1;
- goto bad;
- }
-
- /* add sport to tso command, if sport == 0 */
- if (mvs_sport == 0 ) {
- if( ++sport >= PORTMAX ) sport = PORTMIN;
- sprintf(command,"%s %d",tso_cmd,sport);
- sprintf(cmvs_sport,"%i",sport);
- }
- else {
- strcpy(command,tso_cmd);
- }
-
- if (verbose) {
- printf(" command = %s\n",command);
- }
-
- /* open jcl_output_dsn */
- if ((jcl_output=fopen(JCL_OUTPUT_DSN,
- "w,blksize=3120,lrecl=80,recfm=fb")) == NULL) {
- sprintf(servreply,
- "Error: MVS-Server: Could not open %s (help data-set on MVS)",
- JCL_OUTPUT_DSN);
- goto bad;
- }
- i_open = 1;
-
- /* add job card */
- if( ++jobnumber >= 100 ) jobnumber = 0;
- sprintf(jobname,"%sTS%02i",mvs_userid,jobnumber);
- fprintf(jcl_output,
- "//%s JOB CLASS=B,MSGCLASS=T,REGION=7000K,\n",jobname);
- fprintf(jcl_output,
- "// USER=%s,PASSWORD=%s\n",mvs_userid,mvs_passwd);
-
- /* write to jcl_output_dsn */
- for ( i = 0 ; i <= ilines ; i++ ) {
- fprintf(jcl_output,"%s",cntl??(i??));
- }
-
- /* add command */
- if (!fprintf(jcl_output,"%s\n",command)) {
- sprintf(servreply,
- "Error: MVS-Server: TSO-Command could not be added to CNTL");
- goto bad;
- }
-
- i_open = 0;
- /* close jcl_output_dsn */
- if (( fclose(jcl_output)) != 0 ) {
- sprintf(servreply,
- "Error: MVS-Server: Could not close %s (help data-set on MVS)",
- JCL_OUTPUT_DSN);
- goto bad;
- }
-
- /* submit jcl_output_dsn */
- sprintf(cmd,"submit %s ",JCL_OUTPUT_DSN);
-
- if (system(cmd) != 0) {
- sprintf(servreply,
- "Error: MVS-Server: System call (submit) ended with an error");
- goto bad;
- }
-
- sprintf(servreply,"Job %s submitted on MVS",jobname);
-
-bad:
-
- /* close jcl_output_dsn */
- if (i_open) {
- if (( fclose(jcl_output)) != 0 ) {
- fprintf(stderr,
- "Error: MVS-Server: Could not close %s (help data-set on MVS)" ,
- JCL_OUTPUT_DSN);
- }
- }
-
- if (verbose) {
- printf("servreply =%s\n",servreply);
- }
-
- CMXLATE(cmvs_sport,ebcdictoascii,strlen(cmvs_sport));
- CMXLATE(servreply,ebcdictoascii,strlen(servreply));
-
- /* send client sport,servreply */
- if ( send(sock, cmvs_sport, strlen(cmvs_sport) + 1, 0) < 0) {
- tcperror("Send sport ");
- exit(1);
- }
- if ( send(sock, servreply, strlen(servreply) + 1, 0) < 0) {
- tcperror("Send servreply ");
- exit(1);
- }
-
- return(j);
-}
-/* This routines are copied from tcpaw to tsosubd.
- * They are : getstr chpass chpas reply
- */
-
-/*
- * read a string from the socket (sock).
- *
- * Returns: Number of bytes in the string
- * -1 for an error
- */
-
-getstr(sock,buf, cnt, errmesg)
-int *sock;
-char *buf;
-int cnt; /* sizeof() the char array */
-char *errmesg; /* in case error message required */
-{
- char c;
- int k = 0;
-
- do {
- if ( read(sock, &c, 1) != 1) {
- printf("Error or EOF while reading %s from socket.\n",
- errmesg);
- return(-1); /* error or EOF */
- }
- *buf++ = c;
- k++;
- if (--cnt == 0) {
- printf("%s too long from socket.\n", errmesg);
- return(-1);
- }
- } while (c!= 0); /* null byte terminates the string */
-
- return(k-1);
-
-}
-
-int chpass(user, pass) /* For IBM */
- char *user, *pass;
-{
- char *topoint;
- int i;
- topoint = user;
- while (*topoint != '\0'){
- toupper(*topoint);
- topoint++;
- }
- topoint = pass;
- while (*topoint != '\0'){
- toupper(*topoint);
- topoint++;
- }
- if (CHPAS(user,pass)){ /*if pw check no ok (done in assembler) */
- reply("Bad user/password for %s.\n", user);
- return(-3);
- }
- reply("User %s accepted.\n", user);
- return(1);
-}
-
-int CHPAS(user, pass) /* For IBMMVS */
- char *user, *pass;
-{
- int i;
- char cmd??(80??);
-
- i = sprintf(cmd,"TSOEXEC PWDCHK2 %s,%s",user,pass);
- i = system(cmd);
- /* i = 0 user,pass ok */
- /* i = 4 user,pass not ok */
- return(i);
-}
-
-reply(s1, s2, s3)
- char *s1, *s2, *s3;
-{
- printf(s1, s2, s3);
- fflush(stdout);
-}
-
-/*
- TSOSUBD Version 1.1.4 - 19 Feb 1990
-*/
-
-#define MVS
-#include <manifest.h>
-#include <bsdtypes.h>
-#include <socket.h>
-#include <bsdtime.h>
-#include <stdio.h>
-#include <in.h>
-#include <netdb.h>
-#include <time.h>
-
-#pragma linkage(CMXLATE,OS)
-
-#define JCL_OUTPUT_DSN "TSOSUB.CNTL"
-
-#define FALSE (0)
-#define TRUE (1)
-
-#define PORTMIN 5001 /* Portnumbers start at PORTMIN+1 */
-#define PORTMAX 5500
-
-#define BACKLOG 5
-#define MAXHOSTNAME 32
-
-#define recv_submit_send RESUWR
-
-#define VERSION "1.0.0 1/1/92"
-
-int verbose;
-int sport = PORTMIN;
-int jobnumber = -1;
-
-main(argc,argv) int argc; char **argv;
-{
- int listen_socket, jcl_socket;
- int i;
- int port_number;
- struct linger l;
- struct sockaddr_in sa;
- struct sockaddr_in r_sa;
- int r_sa_lng;
- char *inet_ntoa();
- char remote_host[150];
- struct sockaddr isa;
- struct hostent *hp;
- struct servent *sp;
- char localhost[MAXHOSTNAME+1];
- int wake_up_interval;
- int num_fds, nfound;
- unsigned long readfds;
- struct timeval timeout;
- time_t lt;
-
- int i_reuseaddr;
-
-
- port_number = 5001;
- verbose = FALSE;
- wake_up_interval = 0;
-
- for(i = 1; i < argc; ++i) {
-
- if(argv[i][0] != '-') continue;
-
- switch(argv[i][1])
- {
- case 'w':
- case 'W':
- if(++i == argc) continue;
- wake_up_interval = atoi(argv[i]);
- break;
- case 'p':
- case 'P':
- if(++i == argc) continue;
- port_number = atoi(argv[i]);
- break;
- case 'v':
- case 'V':
- verbose = TRUE;
- break;
- } /* switch (argv..... */
- } /* for(argn.... */
-
- /* Get a socket */
- if ((listen_socket = socket(AF_INET,SOCK_STREAM,0)) < 0) {
- tcperror("socket");
- exit(1);
- }
-
- if (verbose) {
- printf("listen_socket = %i\n",listen_socket);
- }
-
- /* I want to reuse address */
- i_reuseaddr = 1;
- if (
- setsockopt(
- listen_socket, SOL_SOCKET, SO_REUSEADDR,
- (char *) &i_reuseaddr,sizeof(i_reuseaddr)) < 0 ) {
- tcperror("setsocketopt SO_REUSEADDR");
- }
-
- /* Get the local host information */
- (void)gethostname(localhost,MAXHOSTNAME);
- if((hp = gethostbyname(localhost)) == NULL) {
- fprintf(stderr,"Cannot get local host info?\n");
- exit(1);
- }
-
- /* Set the things for the bind call */
- sa.sin_addr.s_addr=INADDR_ANY;
- sa.sin_family = hp->h_addrtype;
- sa.sin_port=port_number;
-
-
- /* bind the socket */
- if(bind(listen_socket,&sa,sizeof sa,0) < 0) {
- tcperror("bind");
- exit(1);
- }
-
- listen(listen_socket,BACKLOG);
-
- /* print out a startup message */
- printf("TSOSVR Version %s GSI / Darmatadt\n",VERSION);
- time(<);
- printf("Server started at %s\n",asctime(localtime(<)));
-
- /* Loop forever */
- for (;;) {
-
- if (wake_up_interval != 0) {
- readfds |= (1 << listen_socket);
- timeout.tv_sec=wake_up_interval;
- nfound = select(listen_socket+1,&readfds,0,0,&timeout);
- if (nfound==0) {
- continue;
- }
- } /* wake_up_interval */
- /* Just wait for someone to connect to us */
- i = sizeof isa;
- if ((jcl_socket = accept(listen_socket,&isa,&i)) < 0) {
- tcperror("accept");
- exit(1);
- }
-
- r_sa_lng = sizeof r_sa;
- if (getpeername(jcl_socket,&r_sa,&r_sa_lng) != 0) {
- tcperror("accept");
- }
- strcpy(remote_host,inet_ntoa(r_sa.sin_addr.s_addr));
- time(<);
- strcat(remote_host," on ");
- strcat(remote_host,asctime(localtime(<)));
- remote_host[strlen(remote_host)-1]='\0';
- printf("\nConnection from %s.\n",remote_host);
- fflush(stdout);
-
- /* read and submit JCL */
- if (read_submit(jcl_socket)) {
-
- /* readjcl will return 1 if special "stop-string" is received */
- if ( close(listen_socket,2) < 0) {
- tcperror("close listen_socket");
- }
- if ( close(jcl_socket,2) < 0) {
- tcperror("close jcl_socket");
- }
- printf("Shutting down.\n");
- fflush(stdout);
- fflush(stderr);
- exit(0);
- }
-
- /* all done close the jcl_socket, and go wait for the next connect */
- if ( close(jcl_socket,2) < 0) {
- tcperror("close jcl_socket");
- }
-
- if (verbose) {
- printf("jcl_socket is closed\n");
- }
-
- fflush(stdout);
- fflush(stderr);
- }
-}
-
-
-int
-read_submit(sock)
-int sock;
-{
- char rmachine[80];
- char ruser[80];
- char rtty[80];
- char mvs_userid[80];
- char mvs_passwd[80];
- char tso_cmd[80];
- char cmvs_sport[80];
- int mvs_sport;
-
- extern char asciitoebcdic[];
- extern char ebcdictoascii[];
-
-
- char cmd[80];
- char command[80];
- char jobname[80];
- char servreply[80];
-
- int i_open = 0;
-
- register char *c;
-
- FILE *jcl_output;
-
- int k;
- int j=0;
- int i;
-
- int ilines = 7;
- char *cntl??(??) = {
- "//TSO EXEC LGN001 \n",
- "//SYSIN DD DUMMY \n",
- "//SYSPRINT DD SYSOUT=T \n",
- "//SYSTERM DD SYSOUT=T \n",
- "//FT05F001 DD DUMMY \n",
- "//FT06F001 DD SYSOUT=T \n",
- "//SYSTSPRT DD SYSOUT=T \n",
- "//SYSTSIN DD * \n"};
-
- if (verbose) {
- printf ("read_submit entered\n");
- fflush(stdout);
- }
-
- /* read strings from socket */
- if ( getstr(sock,rmachine,sizeof(rmachine),"rmachine") <= 0) {
- sprintf(servreply,"Error: Problem in getting rmachine");
- goto bad;
- }
-
- if ( getstr(sock,ruser,sizeof(ruser),"ruser") <= 0) {
- sprintf(servreply,"Error: Problem in getting ruser");
- goto bad;
- }
-
- if ( getstr(sock,rtty,sizeof(rtty),"rtty") <= 0) {
- sprintf(servreply,"Error: Problem in getting rtty");
- goto bad;
- }
-
- if ( getstr(sock,mvs_userid,sizeof(mvs_userid),"mvs_userid") <= 0) {
- sprintf(servreply,"Error: Problem in getting mvs_userid");
- goto bad;
- }
-
- if ( getstr(sock,mvs_passwd,sizeof(mvs_passwd),"mvs_passwd") <= 0) {
- sprintf(servreply,"Error: Problem in getting mvs_passwd");
- goto bad;
- }
-
- if ( getstr(sock,tso_cmd,sizeof(tso_cmd),"tso_cmd") <= 0) {
- sprintf(servreply,"Error: Problem in getting tso_cmd");
- goto bad;
- }
-
- if ( getstr(sock,cmvs_sport,sizeof(cmvs_sport),"cmvs_sport") <= 0) {
- sprintf(servreply,"Error: Problem in getting cmvs_sport");
- goto bad;
- }
-
-
- CMXLATE(rmachine,asciitoebcdic,strlen(rmachine));
- CMXLATE(ruser,asciitoebcdic,strlen(ruser));
- CMXLATE(rtty,asciitoebcdic,strlen(rtty));
- CMXLATE(mvs_userid,asciitoebcdic,strlen(mvs_userid));
- CMXLATE(mvs_passwd,asciitoebcdic,strlen(mvs_passwd));
- CMXLATE(tso_cmd,asciitoebcdic,strlen(tso_cmd));
- CMXLATE(cmvs_sport,asciitoebcdic,strlen(cmvs_sport));
-
- c = mvs_passwd; while (*c) { if (islower(*c)) *c = toupper(*c); c++; }
- c = mvs_userid; while (*c) { if (islower(*c)) *c = toupper(*c); c++; }
- mvs_sport = atoi(cmvs_sport);
-
- if (verbose) {
- printf ("We have read from socket\n");
- printf ("rmachine : %s \n",rmachine);
- printf ("ruser : %s \n",ruser);
- printf ("rtty : %s \n",rtty);
- printf ("mvs_userid : %sº\n",mvs_userid);
- printf ("tso_cmd : %s \n",tso_cmd);
- printf ("mvs_sport : %i \n",mvs_sport);
- fflush(stdout);
- }
-
- /* test of mvs_userid/mvs_passwd */
- if (chpass(mvs_userid,mvs_passwd) <0 ){
- sprintf(servreply,
- "Bad user and/or password for user %s.",mvs_userid) ;
- goto bad;
- }
-
- /* shutting down */
- if ((!strncmp(mvs_userid,"RZ",2) || !strncmp(mvs_userid,"RS",2))
- && !strncmp(tso_cmd,"tsosubend",9) ) {
- sprintf(servreply,"Shutting down TSOSUB.");
- j = 1;
- goto bad;
- }
-
- /* add sport to tso command, if sport == 0 */
- if (mvs_sport == 0 ) {
- if( ++sport >= PORTMAX ) sport = PORTMIN;
- sprintf(command,"%s %d",tso_cmd,sport);
- sprintf(cmvs_sport,"%i",sport);
- }
- else {
- strcpy(command,tso_cmd);
- }
-
- if (verbose) {
- printf(" command = %s\n",command);
- }
-
- /* open jcl_output_dsn */
- if ((jcl_output=fopen(JCL_OUTPUT_DSN,
- "w,blksize=3120,lrecl=80,recfm=fb")) == NULL) {
- sprintf(servreply,
- "Error: MVS-Server: Could not open %s (help data-set on MVS)",
- JCL_OUTPUT_DSN);
- goto bad;
- }
- i_open = 1;
-
- /* add job card */
- if( ++jobnumber >= 100 ) jobnumber = 0;
- sprintf(jobname,"%sTS%02i",mvs_userid,jobnumber);
- fprintf(jcl_output,
- "//%s JOB CLASS=B,MSGCLASS=T,REGION=7000K,\n",jobname);
- fprintf(jcl_output,
- "// USER=%s,PASSWORD=%s\n",mvs_userid,mvs_passwd);
-
- /* write to jcl_output_dsn */
- for ( i = 0 ; i <= ilines ; i++ ) {
- fprintf(jcl_output,"%s",cntl??(i??));
- }
-
- /* add command */
- if (!fprintf(jcl_output,"%s\n",command)) {
- sprintf(servreply,
- "Error: MVS-Server: TSO-Command could not be added to CNTL");
- goto bad;
- }
-
- i_open = 0;
- /* close jcl_output_dsn */
- if (( fclose(jcl_output)) != 0 ) {
- sprintf(servreply,
- "Error: MVS-Server: Could not close %s (help data-set on MVS)",
- JCL_OUTPUT_DSN);
- goto bad;
- }
-
- /* submit jcl_output_dsn */
- sprintf(cmd,"submit %s ",JCL_OUTPUT_DSN);
-
- if (system(cmd) != 0) {
- sprintf(servreply,
- "Error: MVS-Server: System call (submit) ended with an error");
- goto bad;
- }
-
- sprintf(servreply,"Job %s submitted on MVS",jobname);
-
-bad:
-
- /* close jcl_output_dsn */
- if (i_open) {
- if (( fclose(jcl_output)) != 0 ) {
- fprintf(stderr,
- "Error: MVS-Server: Could not close %s (help data-set on MVS)" ,
- JCL_OUTPUT_DSN);
- }
- }
-
- if (verbose) {
- printf("servreply =%s\n",servreply);
- }
-
- CMXLATE(cmvs_sport,ebcdictoascii,strlen(cmvs_sport));
- CMXLATE(servreply,ebcdictoascii,strlen(servreply));
-
- /* send client sport,servreply */
- if ( send(sock, cmvs_sport, strlen(cmvs_sport) + 1, 0) < 0) {
- tcperror("Send sport ");
- exit(1);
- }
- if ( send(sock, servreply, strlen(servreply) + 1, 0) < 0) {
- tcperror("Send servreply ");
- exit(1);
- }
-
- return(j);
-}
-/* This routines are copied from tcpaw to tsosubd.
- * They are : getstr chpass chpas reply
- */
-
-/*
- * read a string from the socket (sock).
- *
- * Returns: Number of bytes in the string
- * -1 for an error
- */
-
-getstr(sock,buf, cnt, errmesg)
-int *sock;
-char *buf;
-int cnt; /* sizeof() the char array */
-char *errmesg; /* in case error message required */
-{
- char c;
- int k = 0;
-
- do {
- if ( read(sock, &c, 1) != 1) {
- printf("Error or EOF while reading %s from socket.\n",
- errmesg);
- return(-1); /* error or EOF */
- }
- *buf++ = c;
- k++;
- if (--cnt == 0) {
- printf("%s too long from socket.\n", errmesg);
- return(-1);
- }
- } while (c!= 0); /* null byte terminates the string */
-
- return(k-1);
-
-}
-
-int chpass(user, pass) /* For IBM */
- char *user, *pass;
-{
- char *topoint;
- int i;
- topoint = user;
- while (*topoint != '\0'){
- toupper(*topoint);
- topoint++;
- }
- topoint = pass;
- while (*topoint != '\0'){
- toupper(*topoint);
- topoint++;
- }
- if (CHPAS(user,pass)){ /*if pw check no ok (done in assembler) */
- reply("Bad user/password for %s.\n", user);
- return(-3);
- }
- reply("User %s accepted.\n", user);
- return(1);
-}
-
-int CHPAS(user, pass) /* For IBMMVS */
- char *user, *pass;
-{
- int i;
- char cmd??(80??);
-
- i = sprintf(cmd,"TSOEXEC PWDCHK2 %s,%s",user,pass);
- i = system(cmd);
- /* i = 0 user,pass ok */
- /* i = 4 user,pass not ok */
- return(i);
-}
-
-reply(s1, s2, s3)
- char *s1, *s2, *s3;
-{
- printf(s1, s2, s3);
- fflush(stdout);
-}
-
-#endif
diff --git a/src/packlib/cspack/obsolete/cron/Imakefile b/src/packlib/cspack/obsolete/cron/Imakefile
deleted file mode 100644
index d724e65..0000000
--- a/src/packlib/cspack/obsolete/cron/Imakefile
+++ /dev/null
@@ -1,3 +0,0 @@
-SRCS_F= cron.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/cspack/obsolete/cron/cron.F b/src/packlib/cspack/obsolete/cron/cron.F
deleted file mode 100644
index 81ece56..0000000
--- a/src/packlib/cspack/obsolete/cron/cron.F
+++ /dev/null
@@ -1,356 +0,0 @@
-*
-* $Id: cron.F,v 1.1.1.1 1996/03/08 15:44:23 mclareni Exp $
-*
-* $Log: cron.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:23 mclareni
-* Cspack
-*
-*
- PROGRAM CRON
-*-- Author : Jamie Shiers 25/04/91
-* Modified from VXCERN Cron - remote VMS dependancies where possible
-#if defined(CERNLIB_VAXVMS)
- implicit integer (s)
-
- structure /itmlst/
- union
- map
- integer*2 buffer_length
- integer*2 item_code
- integer*4 buffer_address
- integer*4 return_length_address
- endmap
- map
- integer*4 end_list /0/
- endmap
- end union
- end structure
-#endif
- common/slate/is(40)
- character*119 chrep
- character*23 time
- character*36 months
- character*3 mon
- character*100 filename,save,crontab
- character*256 line(1000),string
- character*30 field
- integer ifield(5)
- integer irep(8)
- integer systemf,sleepf
-
-#if defined(CERNLIB_VAXVMS)
- record /itmlst/ lnm_list(2)
-
- include '($lnmdef)'
- include '($ssdef)'
- include '($lckdef)'
- integer lksb(6)
-#endif
-
- real*4 seconds
- integer delta/10/,hour,minute,second
- integer days_in_month(12)/31,28,31,30,31,30,31,31,30,31,30,31/
- data months/'JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC'/
-
-#if defined(CERNLIB_VAXVMS)
-*
-* Set process name
-*
- status = sys$setprn('RUN_Cron LOCKED')
- if (.not. status) call lib$signal(%val(status))
-
- lkmode = lck$k_exmode
- lflags = lck$m_system
- print *,'Waiting for cluster wide CRON lock'
- status = sys$enqw(,%val(lkmode),lksb,%val(lflags),
- + 'CLUSTER$CRON',,,,,,)
- if (.not. status) call lib$signal(%val(status))
- print *,'Lock granted'
-*
-* Get name of CRON table
-*
- lnm_list(1).buffer_length = 100
- lnm_list(1).item_code = lnm$_string
- lnm_list(1).buffer_address = %loc(crontab)
- lnm_list(1).return_length_address = %loc(lencron)
-
- lnm_list(2).end_list = 0
-
- status = sys$trnlnm(,'LNM$SYSTEM_TABLE','CRONTAB',,lnm_list)
-
- if (status .eq. ss$_nolognam) crontab = 'CRON.DAT'
-
- lencron = lenocc(crontab)
- if (index(crontab,';') .eq. 0) then
-
- lencron = lencron + 1
- crontab(lencron:lencron) = ';'
-
- endif
-
- status = sys$setprn('RUN_Cron')
- if (.not. status) call lib$signal(%val(status))
-
-#endif
-#if defined(CERNLIB_UNIX)
- call getenvf(CRONTAB,crontab)
- if(is(1).eq.0) crontab = 'cron.dat'
- filename = crontab
-#endif
- print *,'CRON table is ',crontab(1:lenocc(crontab))
-*
-* Initialisation
-*
- call datime(id,it)
- seconds = float(delta) * 60.
- call caldat(0,chrep,irep,ic)
- iday = irep(7)
-*
-* ifield(1) = minutes
-* ifield(2) = hours
-* ifield(3) = days
-* ifield(4) = months
-* ifield(5) = weekday
-*
- ifield(1) = is(5)
- ifield(2) = is(4)
- ifield(3) = is(3)
- ifield(4) = is(2)
- ifield(5) = iday
-*
-* Round down minutes field to multiples of 10
-*
- ifield(1) = (ifield(1)/10) * 10
- write (time,9001) ifield(3),ifield(4),ifield(2),ifield(1),isecs
- print *,'Internal time = ',time
- 30 continue
-
- print *,'Cron awakes...'
- i = 0
-#if defined(CERNLIB_VAXVMS)
- call lib$find_file(crontab(1:lencron),filename,i)
- if (save .eq. filename) goto 99
-#endif
- save = filename
- lenfile = lenocc(filename)
- print *,'Reloading command table from ',filename
-
- open (unit=1,file=filename,status='OLD',
-#if defined(CERNLIB_VAXVMS)
- +readonly,shared,
-#endif
- +err=90)
-
- nlines = 0
- 1 continue
- read (1,'(a)',end=99) string
-
- if (string(1:1) .eq. '!') goto 1
-
- nlines = nlines + 1
- line(nlines) = string
- goto 1
-
- 90 continue
- print *,'*** Error opening CRON.DAT ***'
- goto 91
-
- 99 close (1)
- 91 continue
-
-#if defined(CERNLIB_VAXVMS)
- call szopen(10,'cron_temp.com',80,'NF',IRC)
- write (10,9003)
- 9003 format('$ set noon')
-#endif
- ncomm = 0
-
- do 10 i=1,nlines
- string = line(i)
- len = lenocc(string)
- do 20 j=1,5
-*
-* Now check each field. Fields are:
-* 1) Minutes
-* 2) Hours
-* 3) Days
-* 4) Months
-* 5) Weekday
-* 6) Command
-*
- field = string(1:index(string,' '))
- string = string(index(string,' ')+1:len)
-
- if (index(field,'-') .ne. 0 ) then
-*
-* Range of values. Check current value is within range
-*
- read (field(1:index(field,'-')),*) ilower
- read (field(index(field,'-')+1:30),*) iupper
- if (ifield(j) .lt. ilower .or. ifield(j) .gt. iupper)
- + goto 10
-
- else if (index(field,',') .ne. 0 ) then
-*
-* Series of values, check each range at a time
-*
- field(index(field,' '):index(field,' ')) = ','
- 2 continue
- read (field(1:index(field,',')),*) icheck
- field = field(index(field,',')+1:30)
-*
-* If this is the MINUTE field, have to check backwards DELTA minutes.
-*
- if (j .eq. 1) then
- ilower = ifield(j) - delta
- iupper = ifield(j)
- if (ilower .lt. 0) then
- ilower = ilower + 60
- iupper = iupper + 60
- icheck = icheck + 60
- endif
-
- if (icheck .gt. ilower .and. icheck .le. iupper)
- + goto 20
-*
-* otherwise just check value is correct
-*
- else
- if (icheck .eq. ifield(j)) goto 20
- endif
-
- if (field(1:1) .ne. ' ') goto 2
- goto 10
-
- else if (field .eq. '*') then
-*
-* Star = accept all values
-*
- goto 20
-
- else
-
- read(field,*,end=98) itemp
-*
-* If this is the MINUTE field, have to check backwards DELTA minutes.
-*
- if (j .eq. 1) then
- ilower = ifield(j) - delta
- iupper = ifield(j)
- if (ilower .lt. 0) then
- ilower = ilower + 60
- iupper = iupper + 60
- itemp = itemp + 60
- endif
-
- if (itemp .le. ilower .or. itemp .gt. iupper) goto
- + 10
-*
-* otherwise just check value is correct
-*
- else
- if (itemp .ne. ifield(j)) goto 10
- endif
-
- endif
-
- 20 continue
- ncomm = ncomm + 1
- print *,'Line matches - ',line(i)(1:lenocc(line(i)))
-#if defined(CERNLIB_VAXVMS)
- write(10,'(a)') '$ '//string(1:lenocc(string))
-#endif
-#if defined(CERNLIB_UNIX)
- ic = systemf(string(1:lenocc(string)))
-#endif
- goto 10
- 98 continue
- print *,'End of file processing line -',line(i)
- print *,'Line ',i,' skipped'
- 10 continue
- close (10)
-
-#if defined(CERNLIB_VAXVMS)
- if (ncomm .ne. 0) ic = systemf('cron_temp.com')
-#endif
-
-*
-* Increase time interval by DELTA
-*
- ifield(1) = ifield(1) + delta
-*
-* Next hour
-*
- if (ifield(1) .ge. 60) then
-
- ifield(1) = ifield(1) - 60
- ifield(2) = ifield(2) + 1
-
- endif
-*
-* Next day
-*
- if (ifield(2) .ge. 24) then
-
- ifield(2) = ifield(2) - 24
- ifield(3) = ifield(3) + 1
- ifield(5) = ifield(5) + 1
-
- endif
-*
-* Next month
-*
- imonth = index(months,mon)/3 + 1
- if (ifield(3) .gt. days_in_month(imonth)) then
-
- ifield(3) = 1
- ifield(4) = imonth
-
- endif
-
- if (ifield(4) .gt. 12) ifield(4) = 1
- if (ifield(5) .gt. 7) ifield(5) = ifield(5) - 7
- write (time,9001) ifield(3),ifield(4),ifield(2),ifield(1),isecs
- print *,'Next internal wakeup time = ',time
- call datime(id,it)
- write(time,'(i6,i4,i2)') id,it,is(6)
-* call lib$date_time(time)
- print *,'Current real time = ',time
-* read (time,9002) hour,minute,second
-*9002 format(12x,i2,1x,i2,1x,i2)
-
- hour = is(4)
- minute = is(5)
- second = is(6)
-
- iwait = minute*60 + second
- inter = ifield(1) * 60
-
- icheck = (minute/10) * 10
- if ((hour .eq. ifield(2)) .and. (icheck .eq. ifield(1))) then
-
- print *,'Not waiting - attempting to catch up'
- goto 30
-
- endif
-
- if (inter .lt. iwait) inter = inter + 3600
-
- jwait = inter - iwait
-*
-* Now wait
-*
- if (wait .gt. 3600) then
-
- print *,'Timing error detected ',jwait,' seconds to wait'
- stop 8
- endif
-
- print *,'Waiting for ',jwait,' seconds'
- ic = sleepf(jwait)
-#if defined(CERNLIB_VAXVMS)
- status = lib$delete_file('cron_temp.com;')
-#endif
- goto 30
- 9001 format(i2,1x,i2,6x,i2,1x,i2,1x,i2)
- end
diff --git a/src/packlib/cspack/obsolete/patte/Imakefile b/src/packlib/cspack/obsolete/patte/Imakefile
deleted file mode 100644
index c00918e..0000000
--- a/src/packlib/cspack/obsolete/patte/Imakefile
+++ /dev/null
@@ -1,3 +0,0 @@
-SRCS_F= patte.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/cspack/obsolete/patte/patte.F b/src/packlib/cspack/obsolete/patte/patte.F
deleted file mode 100644
index 627963b..0000000
--- a/src/packlib/cspack/obsolete/patte/patte.F
+++ /dev/null
@@ -1,79 +0,0 @@
-*
-* $Id: patte.F,v 1.1.1.1 1996/03/08 15:44:23 mclareni Exp $
-*
-* $Log: patte.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:23 mclareni
-* Cspack
-*
-*
- PROGRAM PATTE
-*
-* Main program of the Paw Automatic Tuple Transfer Executive
-*
-#include "cspack/pawc.inc"
- CHARACTER*100 CHARGS
- CHARACTER*20 CHGRP,CHPASS
-#include "cspack/pzunit.inc"
-#include "cspack/czsock.inc"
- EXTERNAL ZEXIT
-
- IADTCP = 0
- ISKIN = -1
- ISKOUT = -1
-*
-* C initialisation
-*
-#if defined(CERNLIB_IBM)
- IDUMMY = CINIT(DUMMY)
-#endif
-*
-* Initialise Zebra
-*
- CALL HLIMIT(NWPAWC)
-*
-* Initialise KUIP
-*
- CALL KUINIT(30000)
- CALL KUEXIT(ZEXIT)
- CALL KUQUIT(ZEXIT)
-*
-* Initialise XZ
-*
- IPRINT = 6
- LOGLVL = 0
- LUNPZI = 1
- LUNPZO = 2
- CALL XZINIT(IPRINT,LOGLVL,LUNPZI,LUNPZO)
-*
-* Units for FATMEN
-*
- LUNPZR = 3
- LUNPZF = 4
-*
-* Units for processing .netrc file
-*
- LUNPZN = 7
- LUNPZO = 8
-*
-* Check out .netrc file
-*
- CALL PZNTRC(LUNPZN,CHGRP,CHPASS,'C',IRC)
-*
-* Set prompt
-*
- CALL KIPRMT('Patte> ')
-*
-* CDF initialisation
-*
- CALL PZCDF
-*
-* Pass control to KUIP
-*
-#if !defined(CERNLIB_MOTIF)
- CALL KUWHAT
-#endif
-#if defined(CERNLIB_MOTIF)
- CALL KUWHAM('Patte')
-#endif
-
- END
diff --git a/src/packlib/cspack/obsolete/pz/pzconn.F b/src/packlib/cspack/obsolete/pz/pzconn.F
deleted file mode 100644
index 891315a..0000000
--- a/src/packlib/cspack/obsolete/pz/pzconn.F
+++ /dev/null
@@ -1,38 +0,0 @@
-*
-* $Id: pzconn.F,v 1.1.1.1 1996/03/08 15:44:22 mclareni Exp $
-*
-* $Log: pzconn.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:22 mclareni
-* Cspack
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_cspack/pilot.h"
- SUBROUTINE PZCONN
-#include "pzunit.inc"
-*
-* Action routine for the CONNECT command
-*
- CHARACTER*20 CHGRP,CHPASS
-
- CALL KUGETS(CHGRP,LGRP)
- CALL KUGETP(CHPASS,LPASS)
-
- CALL PZNTRC(LUNPZN,CHGRP(1:LGRP),CHPASS(1:LPASS),'U',IRC)
-
- IF(IRC.NE.0) THEN
- PRINT *,'PZCONN. error ',IRC,' updating .netrc file'
- RETURN
- ENDIF
-*
-* Try opening connection to PIAF
-*
- CALL CZOPEN('ZSERV','piaf1',IRC)
-
- IF(IRC.NE.0) THEN
- PRINT *,'PZCONN. cannot open connection to PIAF'
- CALL PZNTRC(LUNPZN,' ',' ','R',IRC)
- RETURN
- ENDIF
-
- END
diff --git a/src/packlib/cspack/obsolete/pz/pzcopy.F b/src/packlib/cspack/obsolete/pz/pzcopy.F
deleted file mode 100644
index 3623d1d..0000000
--- a/src/packlib/cspack/obsolete/pz/pzcopy.F
+++ /dev/null
@@ -1,214 +0,0 @@
-*
-* $Id: pzcopy.F,v 1.1.1.1 1996/03/08 15:44:23 mclareni Exp $
-*
-* $Log: pzcopy.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:23 mclareni
-* Cspack
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_cspack/pilot.h"
- SUBROUTINE PZCOPY
-
- CHARACTER*255 CHFILE,CHLINK,CHREM
- CHARACTER*20 CHUSR,CHGRP,CHPASS
- CHARACTER*4 CHOPT
- CHARACTER*8 DELTIM
- DIMENSION IBUFF(8192)
-#include "hcmail.inc"
-#include "czsock.inc"
-#include "quest.inc"
-#include "czunit.inc"
-#if defined(CERNLIB_VAXVMS)
-#include "vmsinf.inc"
- INCLUDE '($RMSDEF)'
- EXTERNAL XZFINF
-#endif
-#if defined(CERNLIB_IBMVM)
- CHARACTER*4 RECFM
- CHARACTER*13 CHTIME
-#endif
-#if defined(CERNLIB_UNIX)
- CHARACTER*80 CHBUF,CHHOME
- INTEGER STATF
- DIMENSION INFO(12)
-#endif
-#include "pzunit.inc"
-#include "slate.inc"
- PARAMETER (MEGA=1024*1024)
- DATA NENTRY/0/
- SAVE NENTRY,CHUSR,CHGRP,LUSR,LGRP
-
- CALL KUGETS(CHFILE,LFILE)
- CALL KUGETS(CHLINK,LLINK)
- CALL KUGETC(CHOPT ,LCHOPT)
- IF(LCHOPT.EQ.0) CHOPT = ' '
- IOPTS = INDEX(CHOPT,'S')
-
- IF(LFILE.EQ.0) RETURN
-*
-* Connect to PIAF on first entry
-*
- IF(NENTRY.EQ.0) THEN
-*
-* Get username and password from netrc file
-*
- CALL PZNTRC(LUNPZN,CHGRP,CHPASS,'C',IRC)
- IF(IRC.NE.0) RETURN
- LGRP = LENOCC(CHGRP)
-*
-* Get current username
-*
- CHUSR = ' '
- CALL PZUSER(CHUSR)
- LUSR = LENOCC(CHUSR)
- CALL CUTOL(CHUSR(1:LUSR))
-*
-* Connect
-*
- CALL CZOPEN('ZSERV','piaf1',IRC)
-
- IF(IRC.NE.0) THEN
- PRINT *,'PZCOPY. cannot open connection to PIAF'
- CALL PZNTRC(LUNPZN,' ',' ','R',IRC)
- RETURN
- ENDIF
-
- NENTRY = 1
-
- ENDIF
-
-#if defined(CERNLIB_IBMVM)
- JFILE = 1
-#endif
-#if defined(CERNLIB_VAXVMS)
- JFILE = INDEX(CHFILE(1:LFILE),']')+1
-#endif
-#if defined(CERNLIB_UNIX)
- JFILE = INDEXB(CHFILE(1:LFILE),'/')+1
-#endif
-*
-* Build remote file name
-*
- IF(LLINK.EQ.0) THEN
- CHREM = '~'//CHGRP(1:LGRP)//'/'//CHUSR(1:LUSR)
- + //'/'//CHFILE(JFILE:LFILE)
- ELSE
- IF(INDEX(CHLINK(1:LLINK),'/').EQ.0) THEN
- CHREM = '~'//CHGRP(1:LGRP)//'/'//CHUSR(1:LUSR)
- + //'/'//CHLINK(1:LLINK)
- ELSE
- CHREM = '~'//CHGRP(1:LGRP)//'/'//CHLINK(1:LLINK)
- ENDIF
- ENDIF
- LREM = LENOCC(CHREM)
-*
-* Now send the file
-*
- LRECL = 0
- CALL RZOPEN(LUNXZI,'RZ',CHFILE(1:LFILE),'P',LRECL,ISTAT)
- IF(ISTAT.NE.0) THEN
- PRINT *,'Cannot open local file'
- RETURN
- ENDIF
-*
-* Get number of records in the file
-*
-#if defined(CERNLIB_IBMVM)
- CALL CTRANS('.',' ',CHFILE,1,LFILE)
- CALL CLTOU(CHFILE(1:LFILE))
- CALL VMQFIL(CHFILE(1:LFILE),RECFM,LRECL,NRECS,NBLKS,
- + CHTIME,ISTAT,IRC)
-#endif
-#if defined(CERNLIB_VAXVMS)
- CALL LIB$GET_LUN(LUNDEC)
- OPEN(LUNDEC,FILE=CHFILE(1:LFILE),STATUS='OLD',READONLY,
- + IOSTAT=IRC,USEROPEN=XZFINF)
- CALL LIB$FREE_LUN(LUNDEC)
- NRECS = (IBLK*128)/LRECL
-#endif
-#if defined(CERNLIB_UNIX)
- ISTAT = STATF(CHFILE(1:LFILE),INFO)
-#endif
-#if (defined(CERNLIB_UNIX))&&(!defined(CERNLIB_SGI))
- NRECS = (INFO(12)*128)/LRECL
-#endif
-#if (defined(CERNLIB_UNIX))&&(defined(CERNLIB_SGI))
-*
-* No longer necessary with IRIX 5
-*
- NRECS = (INFO(7)/4)/LRECL
-#endif
-
- SIZE = FLOAT(NRECS*LRECL*4)/MEGA
- PRINT 8001,NRECS,LRECL,SIZE
-8001 FORMAT(' Transferring ',I6,' records of length ',I6,' words = ',
- + F10.2,' MB')
-
- ISIZE = (SIZE+.5)
-
- PRINT 8002,CHFILE(1:LFILE),CHREM(1:LREM)
-8002 FORMAT(' Local file: ',A,' remote file: ',A)
-
- LRECL = LRECL * 4
-*
-* Issue remote SFGET
-*
- WRITE(CHMAIL,8003) ISIZE,CHREM(1:LREM),CHOPT
-8003 FORMAT('PPIAF:',I6,A,1X,A)
- CALL CZPUTA(CHMAIL,ISTAT)
-
- CALL CZGETA(CHMAIL,ISTAT)
-
- LLINK = LENOCC(CHMAIL) - 1
- CHLINK = CHMAIL(2:LLINK+1)
- ISLASH = INDEX(CHREM(1:LREM),'/')
-
-#include "czmess.inc"
- IF(IRC.NE.0) GOTO 90
-*
-* Create remote file
-*
- CHNODE(LUNXZO) = 'piaf1'
- JSKIN(LUNXZO) = ISKIN
- JSKOUT(LUNXZO) = ISKOUT
-
- CALL XZOPEN(LUNXZO,CHLINK(1:LLINK)//CHREM(ISLASH:LREM),
- + 'piaf1',LRECL,'ODR',IRC)
- IF(IRC.NE.0) GOTO 90
-*
-* Start timer
-*
- IF(IOPTS.NE.0) THEN
- CALL CZRTIM(DELTIM)
- CALL TIMED(T)
- ENDIF
-*
-* Start transfer
-*
- NSTAL = 1
- NSTAR = 1
- CALL XZWRTM(LUNXZI,LUNXZO,IBUFF,NRECS,NSTAL,NSTAR,LRECL,'D',IRC)
- CALL XZCLOS(LUNXZO,' ',IRC)
-
- IF(IOPTS.NE.0)THEN
- CALL CZRTIM(DELTIM)
- CALL TIMED(T)
- READ(DELTIM,'(I2,1X,I2,1X,I2)') IHOUR,IMIN,ISEC
- NSECS = ISEC + IMIN*60 + IHOUR*3600
- IF(NSECS.LE.0) NSECS = 1
- NKILO = SIZE * 1024
- NR = NREC
- RATE = (SIZE*1024.)/FLOAT(NSECS)
-#include "xzstat.inc"
- PRINT 8004,NRECS,RATE
-8004 FORMAT(' Transferred ',I6,' records, transfer rate = ',F10.2,
- + ' KB/S')
- PRINT 8005,DELTIM,T
-8005 FORMAT(' Elapsed time = ',A,' CP time = ',F5.2,' sec.')
- ENDIF
-
- 90 CONTINUE
- CLOSE(LUNXZI)
-
- END
diff --git a/src/packlib/cspack/obsolete/pz/pzntrc.F b/src/packlib/cspack/obsolete/pz/pzntrc.F
deleted file mode 100644
index 7a6c26b..0000000
--- a/src/packlib/cspack/obsolete/pz/pzntrc.F
+++ /dev/null
@@ -1,250 +0,0 @@
-*
-* $Id: pzntrc.F,v 1.1.1.1 1996/03/08 15:44:22 mclareni Exp $
-*
-* $Log: pzntrc.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:22 mclareni
-* Cspack
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_cspack/pilot.h"
- SUBROUTINE PZNTRC(LUN,CHGRP,CHPASS,CHOPT,IRC)
-*
-* Check out .netrc file
-*
- CHARACTER*(*) CHGRP,CHPASS
- CHARACTER*255 CHFILE,CHBACK
- CHARACTER*20 CHUSER
- CHARACTER*80 LINE
- LOGICAL IEXIST
-#if defined(CERNLIB_VAXVMS)
-* INTEGER XZPROT
-* EXTERNAL XZPROT
- INTEGER SYS$SETDFPROT
-#endif
-#if defined(CERNLIB_UNIX)
- INTEGER SYSTEMF
-#endif
-#include "slate.inc"
-#include "pzunit.inc"
-#if defined(CERNLIB_VAXVMS)
- DATA IPROT/Z0000FFCF/
-#endif
-*
-* IRC = 4 : entry for 'piaf' does not exist
-* 28 : netrc file not found
-*
-#include "czopts.inc"
-*
-* The .netrc file is in SYS$LOGIN:FTPLOGIN.; (VMS)
-* userid.PER.NETRC (MVS)
-* $HOME/.netrc (Unix)
-* DOT NETRC A0 (VM)
-*
-* Options: C - check if .netrc file exists, contains
-* a line 'machine piaf user ...'
-* R - remove piaf line as password check fails
-* U - update .netrc file
-*
-#if defined(CERNLIB_IBMMVS)
- CALL KPREFI(CHUSER)
- CHFILE = '/'//CHUSER(1:LENOCC(CHUSER)) // '.PER.NETRC'
-#endif
-#if defined(CERNLIB_IBMVM)
- CHFILE = '/DOT NETRC A0'
-#endif
-#if defined(CERNLIB_VAXVMS)
- CHFILE = 'SYS$LOGIN:FTPLOGIN.;'
-#endif
-#if defined(CERNLIB_UNIX)
- CALL GETENVF('HOME',CHFILE)
- CHFILE(IS(1)+1:IS(1)+7) = '/.netrc'
-#endif
- LFILE = LENOCC(CHFILE)
-*
-* Does file exist?
-*
- INQUIRE(FILE=CHFILE(1:LFILE),EXIST=IEXIST)
- IF(.NOT.IEXIST.AND.IOPTC.NE.0) THEN
- PRINT *,'PZNTRC. netrc file (',CHFILE(1:LFILE),
- + ') does not exist'
- PRINT *,'PZNTRC. file will be created by'//
- + ' the CONNECT command'
- IRC = 28
- RETURN
- ENDIF
-
- IF(IOPTC.NE.0) THEN
-*
-* Open the file and look for 'piaf'
-*
- OPEN(LUN,FILE=CHFILE(1:LFILE),FORM='FORMATTED',
-#if defined(CERNLIB_IBMVM)||defined(CERNLIB_IBMMVS)
- + ACTION='READ',
-#endif
-#if defined(CERNLIB_VAXVMS)
- + READONLY,
-#endif
- + ACCESS='SEQUENTIAL',STATUS='OLD',IOSTAT=IRC)
- IF(IRC.NE.0) THEN
- PRINT *,'PZNTRC. cannot open netrc file ',CHFILE(1:LFILE)
- RETURN
- ENDIF
-*
-* Not found
-*
- IRC = 4
-
- 10 CONTINUE
- READ(LUN,'(A)',END=20) LINE
- IF(INDEX(LINE,'piaf1').NE.0) THEN
- IRC = 0
- GOTO 30
- ENDIF
- GOTO 10
-
- 20 CONTINUE
- CLOSE(LUN)
- PRINT *,'PZNTRC. .netrc file not setup for use with PIAF'
- PRINT *,'PZNTRC. use the CONNECT command to rectify this'
- GOTO 40
- 30 CONTINUE
- CLOSE(LUN)
-*
-* Found a 'piaf' line
-*
- LLINE = LENOCC(LINE)
- CALL CSQMBL(LINE,1,LLINE)
- LLINE = IS(1)
-#if defined(CERNLIB_VAXVMS)
-*
-* Syntax: piaf user password
-*
- LBLANK = INDEX(LINE,' ')
- JBLANK = INDEXB(LINE(1:LLINE),' ')
- CHGRP = LINE(LBLANK+1:JBLANK-1)
- CHPASS = LINE(JBLANK+1:LLINE)
- LGRP = JBLANK - LBLANK - 1
-#endif
-#if !defined(CERNLIB_VAXVMS)
-*
-* Syntax: machine piaf login username password password
-*
- LBLANK = INDEX(LINE,' login ') + 7
- KBLANK = INDEX(LINE,' password ') -1
- JBLANK = INDEXB(LINE(1:LLINE),' ')
- CHGRP = LINE(LBLANK:KBLANK)
- CHPASS = LINE(JBLANK+1:LLINE)
- LGRP = KBLANK - LBLANK + 1
-#endif
-
- PRINT *,'PZNTRC. .netrc setup for group ',CHGRP(1:LGRP)
- PRINT *,'PZNTRC. use the CONNECT command to change group ',
- + 'and/or password'
-
- 40 CONTINUE
- ENDIF
-*
-* Update / create file
-*
- IF(IOPTR.NE.0.OR.IOPTU.NE.0) THEN
-
- IF(IEXIST) THEN
-*
-* Rename existing file to .bak
-*
-#if defined(CERNLIB_IBMVM)
- CHBACK = CHFILE(1:LFILE) // 'BAK'
- LBACK = LFILE + 3
- CALL VMCMS('RENAME '//CHFILE(2:LFILE)// ' '//CHBACK(2:
- + LBACK),IRC)
- OPEN(LUNPZO,FILE=CHBACK(1:LBACK),STATUS='OLD', ACTION=
- + 'READ', FORM='FORMATTED',ACCESS='SEQUENTIAL',IOSTAT=ISTAT)
- OPEN(LUNPZN,FILE=CHFILE(1:LFILE),STATUS='NEW', ACTION=
- + 'WRITE', FORM='FORMATTED',ACCESS='SEQUENTIAL',IOSTAT=ISTAT)
-#endif
-#if defined(CERNLIB_VAXVMS)
- CHBACK = CHFILE(1:LFILE-1) // 'BAK'
- LBACK = LFILE + 2
- ISTAT = LIB$RENAME_FILE(CHFILE(1:LFILE), CHBACK(1:LBACK),,,
- + ,,,,,,,)
- IF(.NOT.ISTAT) CALL LIB$SIGNAL(%VAL(ISTAT))
- OPEN(LUNPZO,FILE=CHBACK(1:LBACK),STATUS='OLD', READONLY,
- + SHARED, FORM='FORMATTED',ACCESS='SEQUENTIAL',IOSTAT=ISTAT)
- IC = SYS$SETDFPROT(IPROT,JPROT)
- OPEN(LUNPZN,FILE=CHFILE(1:LFILE),STATUS='NEW',
- + CARRIAGECONTROL='LIST',FORM='FORMATTED',
- + ACCESS='SEQUENTIAL',IOSTAT=ISTAT)
- IC = SYS$SETDFPROT(JPROT,%VAL(0))
-#endif
-#if defined(CERNLIB_UNIX)
- CHBACK = CHFILE(1:LFILE) // '.bak'
- LBACK = LFILE + 4
- INQUIRE(FILE=CHBACK(1:LBACK),EXIST=IEXIST)
- IF(IEXIST) THEN
- ISTAT = SYSTEMF('chmod +w '// CHBACK(1:LBACK))
- ENDIF
- ISTAT = SYSTEMF('mv '//CHFILE(1:LFILE)//' '// CHBACK(1:
- + LBACK))
- OPEN(LUNPZO,FILE=CHBACK(1:LBACK),STATUS='OLD', FORM=
- + 'FORMATTED',ACCESS='SEQUENTIAL',IOSTAT=ISTAT)
- OPEN(LUNPZN,FILE=CHFILE(1:LFILE),STATUS='NEW', FORM=
- + 'FORMATTED',ACCESS='SEQUENTIAL',IOSTAT=ISTAT)
-#endif
-*
-* Now copy all records from the old file, except those that
-* mention 'piaf'
-*
- 60 CONTINUE
- READ(LUNPZO,'(A)',END=70) LINE
- LLINE = LENOCC(LINE)
-#if defined(CERNLIB_VAXVMS)
- IF(INDEX(LINE(1:LLINE),'piaf1 ').NE.0) GOTO 60
-#endif
-#if defined(CERNLIB_VAXVMS)
- IF(INDEX(LINE(1:LLINE),'machine piaf1').NE.0) GOTO 60
-#endif
- WRITE(LUNPZN,'(A)') LINE(1:LLINE)
- GOTO 60
- 70 CONTINUE
- CLOSE(LUNPZO)
- IF(IOPTR.EQ.0) THEN
- LGRP = LENOCC(CHGRP)
- LPASS = LENOCC(CHPASS)
- WRITE(LUNPZN,9001) CHGRP(1:LGRP),CHPASS(1:LPASS)
-#if defined(CERNLIB_VAXVMS)
- 9001 FORMAT('piaf1 ',A,1X,A)
-#endif
-#if !defined(CERNLIB_VAXVMS)
- 9001 FORMAT('machine piaf1 login ',A,' password ',A)
-#endif
- ENDIF
- CLOSE(LUNPZN)
-
- ELSE
- LGRP = LENOCC(CHGRP)
- LPASS = LENOCC(CHPASS)
-#if defined(CERNLIB_IBMVM)
- OPEN(LUNPZN,FILE=CHFILE(1:LFILE),STATUS='NEW', ACTION=
- + 'WRITE', FORM='FORMATTED',ACCESS='SEQUENTIAL',IOSTAT=ISTAT)
-#endif
-#if defined(CERNLIB_UNIX)
- OPEN(LUNPZN,FILE=CHFILE(1:LFILE),STATUS='NEW', FORM=
- + 'FORMATTED',ACCESS='SEQUENTIAL',IOSTAT=ISTAT)
-#endif
-#if defined(CERNLIB_VAXVMS)
- IC = SYS$SETDFPROT(IPROT,JPROT)
- OPEN(LUNPZN,FILE=CHFILE(1:LFILE),STATUS='NEW',
- + CARRIAGECONTROL='LIST',FORM='FORMATTED',
- + ACCESS='SEQUENTIAL',IOSTAT=ISTAT)
- IC = SYS$SETDFPROT(JPROT,%VAL(0))
-#endif
- WRITE(LUNPZN,9001) CHGRP(1:LGRP),CHPASS(1:LPASS)
- CLOSE(LUNPZN)
- ENDIF
- ENDIF
-
-#if defined(CERNLIB_UNIX)
- ISTAT = SYSTEMF('chmod 400 '//CHFILE(1:LFILE))
-#endif
- END
diff --git a/src/packlib/cspack/obsolete/pz/pzputr.F b/src/packlib/cspack/obsolete/pz/pzputr.F
deleted file mode 100644
index b4e4730..0000000
--- a/src/packlib/cspack/obsolete/pz/pzputr.F
+++ /dev/null
@@ -1,185 +0,0 @@
-*
-* $Id: pzputr.F,v 1.1.1.1 1996/03/08 15:44:23 mclareni Exp $
-*
-* $Log: pzputr.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:23 mclareni
-* Cspack
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_cspack/pilot.h"
- SUBROUTINE PZPUTR(LOCAL,REMOTE,CHOPT,IRC)
-#include "czunit.inc"
-#include "hcmail.inc"
-#include "czsock.inc"
-#include "zmach.inc"
-#include "pawc.inc"
- DIMENSION IQ(2),Q(2),LQ(8000)
- EQUIVALENCE (LQ(1),LMAIN),(IQ(1),LQ(9)),(Q(1),IQ(1))
-C
-#include "rzclun.inc"
- COMMON /RZCL/ LTOP,LRZ0,LCDIR,LRIN,LROUT,LFREE,LUSED,LPURG
- +, LTEMP,LCORD,LFROM
-#include "quest.inc"
- CHARACTER*8 CHTAG(100)
- CHARACTER*80 CHFILE
- CHARACTER*90 CHFORM
- CHARACTER*12 CHDATE
- CHARACTER*8 DELTIM
- CHARACTER*1 CHOPE
- DIMENSION IHTAG(2)
- PARAMETER (KUP=5,KPW1=7,KNCH=9,KDATEC=10,KDATEM=11,KQUOTA=12,
- + KRUSED=13,KWUSED=14,KMEGA=15,KIRIN=17,KIROUT=18,
- + KRLOUT=19,KIP1=20,KNFREE=22,KNSD=23,KLD=24,KLB=25,
- + KLS=26,KLK=27,KLF=28,KLC=29,KLE=30,KNKEYS=31,
- + KNWKEY=32,KKDES=33,KNSIZE=253,KEX=6,KNMAX=100)
- CHARACTER*(*) LOCAL,REMOTE
- DIMENSION ITEST(50)
-*
-*_______________________________________
-#include "czopts.inc"
-#include "czopen.inc"
- IRC = 0
- IF(IDEBXZ.GE.1) PRINT *,'PZPUTR. enter for ',
- + LOCAL,' ',REMOTE,' ',CHOPT
-*
-* Open local RZ file
-*
- IQUEST(1)=0
- IOPEN=0
- CHFILE=LOCAL
- NREC=0
- NWKEY=0
- CHFORM = ' '
- LRECL = 0
- IF(IOPTA.EQ.0) THEN
- IF(IOPTC.NE.0) THEN
- CALL RZOPEN(LUNXZI,'RZ',LOCAL,'P',LRECL,ISTAT)
- ELSE
- CALL RZOPEN(LUNXZI,'RZ',LOCAL,' ',LRECL,ISTAT)
- ENDIF
- IF(ISTAT.NE.0) GOTO 95
- ENDIF
- CALL RZFILE(LUNXZI,'RZ',' ')
- IF(IQUEST(1).NE.0)THEN
- CLOSE(LUNXZI)
- GO TO 95
- ENDIF
-
- IF(INDEX(CHOPT,'S').NE.0) THEN
- CALL RZSTAT('//RZ',99,' ')
- NWORDS = IQUEST(12)
- ENDIF
-
- IF(INDEX(CHOPT,'L').NE.0) CALL RZLDIR(' ',CHOPT)
-*
-* Send message to remote machine with the file parameters
-*
- CHOPE = ' '
- IF(INDEX(CHOPT,'N').NE.0) CHOPE = 'N'
- IF(INDEX(CHOPT,'X').NE.0) CHOPE = 'X'
- LCHOPE = LENOCC(CHOPE)
- IF(IOPTC.NE.0) THEN
- CHOPE(LCHOPE+1:LCHOPE+1) = 'C'
- LCHOPE = LCHOPE + 1
- ENDIF
- IF(INDEX(CHOPT,'R').NE.0.OR.IRELAT.NE.0)
- + CHOPE(LCHOPE+1:LCHOPE+1) = 'L'
-
- NCHR = LENOCC(REMOTE)
- CHMAIL='PPIAF:'//REMOTE(1:NCHR)//' '//CHOPE
-* IF((INDEX(CHOPT,'R').NE.0).OR.(IRELAT.NE.0))
-* + CHMAIL = CHMAIL(1:LENOCC(CHMAIL)) // 'R '
-
- CALL CZPUTA(CHMAIL,ISTAT)
- IF(ISTAT.NE.0)GO TO 99
-
- IOPEN = 1
- NREC = IQ(LCDIR+KQUOTA)
- NWKEY = IQ(LCDIR+KNWKEY)
- KTAGS = KKDES+(NWKEY-1)/10+1
- LB = IQ(LCDIR+KLB)
- LRECL = IQ(LCDIR+LB+1)
- IDATEC = IQ(LCDIR+KDATEC)
- IDATEM = IQ(LCDIR+KDATEM)
- DO 11 I=1,NWKEY
- CALL ZITOH(IQ(LCDIR+KTAGS+2*I-2),IHTAG,2)
- CALL UHTOC(IHTAG,4,CHTAG(I),8)
- IKDES=(I-1)/10
- IKBIT1=3*I-30*IKDES-2
- IFORM=JBYT(IQ(LCDIR+KKDES+IKDES),IKBIT1,3)
- IF(IFORM.EQ.3)THEN
- CHFORM(I:I)='H'
- ELSEIF(IFORM.EQ.4) THEN
- CHFORM(I:I)='A'
- ELSEIF(IFORM.EQ.1) THEN
- CHFORM(I:I)='B'
- ELSE
- CHFORM(I:I)='I'
- ENDIF
- 11 CONTINUE
- CHMAIL=' '
- WRITE(CHMAIL,1000)NWKEY,NREC,LRECL,IDATEC,IDATEM
- 1000 FORMAT(5I10)
- CALL CZPUTA(CHMAIL,ISTAT)
- IF(ISTAT.NE.0)GO TO 90
- CALL CZPUTA(CHFORM,ISTAT)
- IF(NWKEY.EQ.0)GO TO 90
- DO 30 I=1,NWKEY
- CHMAIL=CHTAG(I)
- CALL CZPUTA(CHMAIL,ISTAT)
- IF(ISTAT.NE.0)GO TO 90
- 30 CONTINUE
-*
-* Verify that RZ file has been opened by server
-*
-#include "czmess.inc"
- IF(IRC.NE.0) GOTO 90
-* CALL CZGETA(CHMAIL,ISTAT)
-* IF(ISTAT.NE.0)GO TO 90
-* IF(CHMAIL(1:2).NE.'OK')GO TO 90
-
- IF(INDEX(CHOPT,'S').NE.0) THEN
- CALL CZRTIM(DELTIM)
- CALL TIMED(T)
- ENDIF
-*
-* Now transfer the file
-*
- CALL RZTOFZ(LUNFZO,'C')
- IF(IQUEST(1).NE.0) THEN
- PRINT 2001
- 2001 FORMAT(' Error transferring file')
- IRC = 3
- ELSE
- PRINT 2000
- 2000 FORMAT(' File transfer completed')
- IF(INDEX(CHOPT,'S').NE.0) THEN
- CALL CZRTIM(DELTIM)
- CALL TIMED(T)
- READ(DELTIM,'(I2,1X,I2,1X,I2)') IHOUR,IMIN,ISEC
- NSECS = ISEC + IMIN*60 + IHOUR*3600
- IF(NSECS.LE.0) NSECS = 1
- NKILO = NWORDS*IQCHAW/1024
- RATE = FLOAT(NKILO)/FLOAT(NSECS)
- NR = 0
-#include "xzstat.inc"
- PRINT *,' Transferred ',NKILO,' KB, rate = ',RATE,' KB/S'
- PRINT *,' Elapsed time = ',DELTIM,' CP time = ',T,' sec.'
- ENDIF
-
- ENDIF
-*
- 80 IF(IOPEN.EQ.0)GO TO 99
- CALL RZEND('RZ')
- CLOSE(LUNXZI)
- GO TO 99
-*
- 90 PRINT *,' Cannot open remote file'
- IRC = 1
- GO TO 80
-*
- 95 PRINT *,' Cannot open local file'
- IRC = 2
-*
- 99 END
diff --git a/src/packlib/cspack/obsolete/pz/zexit.F b/src/packlib/cspack/obsolete/pz/zexit.F
deleted file mode 100644
index c52cae8..0000000
--- a/src/packlib/cspack/obsolete/pz/zexit.F
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: zexit.F,v 1.1.1.1 1996/03/08 15:44:23 mclareni Exp $
-*
-* $Log: zexit.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:23 mclareni
-* Cspack
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_cspack/pilot.h"
- SUBROUTINE ZEXIT
-*
-* Called by KUIP/EXIT to close connections and files.
-*
-#include "czsock.inc"
- SAVE IFIRST
- DATA IFIRST/0/
-*________________________________________________________
-*
-*
- IF(IFIRST.EQ.0)THEN
-*
-* Close remote connection
-*
- IF(ISKIN.GE.0)CALL CZCLOS(ISTAT)
- IFIRST=1
-* PRINT *,'Moi, je ne regrette rien'
- ENDIF
-*
- END
-
diff --git a/src/packlib/cspack/obsolete/pzcdf/pzcdf.cdf b/src/packlib/cspack/obsolete/pzcdf/pzcdf.cdf
deleted file mode 100644
index b078e94..0000000
--- a/src/packlib/cspack/obsolete/pzcdf/pzcdf.cdf
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: pzcdf.cdf,v 1.1.1.1 1996/03/08 15:44:23 mclareni Exp $
-*
-* $Log: pzcdf.cdf,v $
-* Revision 1.1.1.1 1996/03/08 15:44:23 mclareni
-* Cspack
-*
-*
-*----------------------------------------------------------------
-*
-* PATTE Command definition file (CDF)
-*
-*----------------------------------------------------------------
->NAME PZCDF
->MENU PATTE
->Guidance
-PATTE shell Commands
-
-*----------------------------------------------------------------
->Command CONNECT
->Guidance
-Use the CONNECT command to connect to PIAF
-
->Action PZCONN
->PARAMETERS
-GROUP 'Group or Throng name' C D=' '
-PASS 'Password ' C D=' '
-
-*----------------------------------------------------------------
->Command STAGE
->Guidance
-Use the STAGE command to move a file to the PIAF
-file system.
-.
-
->Action PZCOPY
->PARAMETERS
-LOCAL 'Local file name ' C D=' '
-+
-REMOTE 'Remote file name' C D=' '
-CHOPT 'Options ' C D=' '
diff --git a/src/packlib/cspack/obsolete/tcspack/Imakefile b/src/packlib/cspack/obsolete/tcspack/Imakefile
deleted file mode 100644
index 2e1f892..0000000
--- a/src/packlib/cspack/obsolete/tcspack/Imakefile
+++ /dev/null
@@ -1,3 +0,0 @@
-SRCS_F= tsysreq.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/cspack/obsolete/tcspack/tsysreq.F b/src/packlib/cspack/obsolete/tcspack/tsysreq.F
deleted file mode 100644
index 367881f..0000000
--- a/src/packlib/cspack/obsolete/tcspack/tsysreq.F
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: tsysreq.F,v 1.1.1.1 1996/03/08 15:44:23 mclareni Exp $
-*
-* $Log: tsysreq.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:23 mclareni
-* Cspack
-*
-*
- CHARACTER*240 COMMAND
- CHARACTER*80 IBUF
- CHARACTER*8 SERVICE
- INTEGER IRC
- INTEGER REPLEN
- PARAMETER (REPLEN=100)
- CHARACTER*132 TMSREP(REPLEN)
-
- IRC = 0
-
- SERVICE = 'TMS'
- COMMAND = 'Q VID I25001 - I25404'
-
- 500 CONTINUE
- I = REPLEN
- CALL SYSREQ(SERVICE,COMMAND, IRC, TMSREP, I)
-
- DO 20 J=1,I-1
- WRITE (6,200) TMSREP(J)
- 200 FORMAT(1X,A80)
- 20 CONTINUE
-
- IF (IRC .EQ. 2) THEN
- COMMAND = TMSREP(I)
- GOTO 500
- ENDIF
-C Print the Last Line
- WRITE (6,200) TMSREP(I)
-
- 9999 CONTINUE
- PRINT *,'SYSREQ(Fortran): RC(',IRC,')'
-
- END
diff --git a/src/packlib/cspack/obsolete/telnetg/telnetg.c b/src/packlib/cspack/obsolete/telnetg/telnetg.c
deleted file mode 100644
index bd2ec95..0000000
--- a/src/packlib/cspack/obsolete/telnetg/telnetg.c
+++ /dev/null
@@ -1,1555 +0,0 @@
-/*
- * $Id: telnetg.c,v 1.1.1.1 1996/03/08 15:44:23 mclareni Exp $
- *
- * $Log: telnetg.c,v $
- * Revision 1.1.1.1 1996/03/08 15:44:23 mclareni
- * Cspack
- *
- */
-#include "sys/CERNLIB_machine.h"
-#include "_cspack/pilot.h"
-/*
- * User telnet program with CERN Graphics hooks: B.Segal and O.Couet *
- (Version of: 09 Aug 1990)
- *
- *** Modified by O. Couet/CERN-CN September 1990 tekint replace by imtek
- *** Modified by O. Couet/CERN-CN September 1990 VMS support in the "G" part
- *** Modified by B. Segal/CERN-DD August 1990 to add VMS support
- *** Modified by B. Segal/CERN-DD January 1990 to add SYS5 support
- *** Modified by O. Couet/CERN-DD May 1989 (IM) to be compatible with 3270g
- *** Modified by B. Segal/CERN-DD February 1989 (IM) for O. Couet's "imint"
- *** Modified by B. Segal/CERN-DD January 1986 (TEK) for R. Brun's "tekint"
- *** Corrected by B. Segal/CERN-DD November 1984 (BS) ***
- */
-
-#define NOTEKIM /* FOR TESTING ONLY */
-
-* For Apollo's prior to SR10.4
-#if defined(CERNLIB_APOSR103)
-#ifdef apollo
-#include "/sys/ins/base.ins.c"
-#endif apollo
-#endif
-
-#ifdef CRAY
-# define USG
-#endif CRAY
-
-#ifdef linux
-# define USG
-# define LINUX
-#endif /* LINUX */
-#ifdef hpux /* Define hpux for HP Unix, 300 or 800 series machines */
-# define USG
-#endif /* hpux */
-
-#ifdef IRIS50 /* Define IRIS50 for SGI IRIX 5.0 or higher */
-# define IRIS35
-# define CTRL_quoted
-#endif
-
-#ifdef IRIS35 /* Define IRIS35 for SGI IRIS with kernel-based TCP */
-# define USG /* Needs special compile flags: */
-#endif IRIS35 /* cc telnet.c -DIRIS35 -I/usr/include/bsd -lbsd */
-
-#include <stdio.h>
-#include <ctype.h>
-#include <errno.h>
-#include <signal.h>
-#include <setjmp.h>
-#include <netdb.h>
-#include <sys/types.h>
-#include <sys/socket.h>
-#include <sys/ioctl.h>
-#include <netinet/in.h>
-
-#ifdef VMS
-#undef SIGTSTP
-#include <iodef.h>
-#include <ssdef.h>
-#include <climsgdef.h>
-#include <descrip.h>
-#include <tt2def.h>
-#endif VMS
-
-#ifdef USG
-#ifdef LINUX
-#define CEOF EOF
-# include <termio.h>
-#else
-# include <sys/termio.h>
-#endif /* LINUX */
-/* #include <time.h> */
-# define bcopy(src, dest, len) memcpy(dest, src, len)
-#endif USG
-
-#ifndef hpux
-# include <sys/time.h> /* may not be needed nowadays... */
-#endif !hpux
-
-#ifdef __convexc__
-# define CONVEX
-# define CTRL_quoted
-#endif /* __convexc__ */
-
-/* Don't include <arpa/inet.h>, 4.2's lies about inet_addr */
-extern char *inet_ntoa();
-unsigned long inet_addr();
-
-#if defined(CERNLIB_DECS)||defined(CERNLIB_APOLLO)||defined(CERNLIB_SUN)||defined(CERNLIB_NEXT)
-#undef CTRL
-#endif
-
-#ifndef CTRL
-# define CTRL(c) ('c' & 0x1f)
-#endif CTRL
-
-#define TELOPTS
-#include <arpa/telnet.h>
-
-#define strip(x) ((x)&0177)
-
-char ttyobuf[BUFSIZ], *tfrontp = ttyobuf, *tbackp = ttyobuf;
-char netobuf[BUFSIZ], *nfrontp = netobuf, *nbackp = netobuf;
-
-int dbgt = 0; /* 1=>trace+call imtek; -1=> trace only. (BS) */
-
-/* Note: imtek expects one argument of type char !!! */
-
-#ifdef apollo /* (TEK/IM).. */
-std_$call void imtek();
-std_$call void imint();
-#else
-#ifdef CRAY
-#define imtek IMTEK
-#define imint IMINT
-#else
-#ifndef VMS
-#define imtek imtek_
-#define imint imint_
-#endif !VMS
-#endif CRAY
-extern int imtek();
-extern int imint();
-#endif apollo
-
-int tek = 0, im = 0, im1 = 0, im2 = 0;
-int flb = 1; /* flush flag. (add by O.Couet) */
-int imcount = 0; /* count of IMCHR. (add by O.Couet) */
-char tekarg;
-#define IMLEN 80
-char imbuf[IMLEN+2];
-char *imptr = imbuf;
-char *imlim = &imbuf[IMLEN];
-char *imbgn = &imbuf[0]; /* add by O.Couet */
-#ifdef VMS
-struct dsc$descriptor_s imbuf2; /* add by O.Couet (September 14, 1990) */
-#endif VMS
-int imout;
-
-#define LF 10
-#define FF 12
-#define CR 13
-#define IMCHR '`' /* `` Start and finish with IM mode */
-#define IMEOR '@' /* @ Begin and finish a record in IM mode */
-#define IMIN 1
-#define ASCIIS 32 /* add by O.Couet */
-#define ASCIIE 126 /* add by O.Couet */
-#define ESC 27 /* ..(TEK) */
-#define TEKON 29
-#define TEKOF 31
-
-
-char hisopts[256];
-char myopts[256];
-
-char doopt[] = { IAC, DO, '%', 'c', 0 };
-char dont[] = { IAC, DONT, '%', 'c', 0 };
-char will[] = { IAC, WILL, '%', 'c', 0 };
-char wont[] = { IAC, WONT, '%', 'c', 0 };
-
-int connected;
-int net;
-int showoptions = 0;
-int options;
-int debug = 0;
-int crmod = 0;
-char *prompt;
-#ifdef LINUX
-char escape = (']' & 0x1f);
-#else
-#ifdef CTRL_quoted
-char escape = CTRL(']');
-#else
-char escape = CTRL(]);
-#endif /* CTRL_quoted */
-#endif /* LINUX */
-
-char line[200];
-int margc;
-char *margv[20];
-
-jmp_buf toplevel;
-jmp_buf peerdied;
-
-#ifdef VMS
-extern int noshare errno;
-#else
-extern int errno;
-#endif VMS
-
-int tn(), quit(), suspend(), bye(), help();
-int setescape(), status(), toggle(), setoptions();
-int setcrmod(), setdebug();
-
-int caltek4(), caltek5(), caltek6(); /* TEK) */
-
-#define HELPINDENT (sizeof ("connect"))
-
-struct cmd {
- char *name; /* command name */
- char *help; /* help string */
- int (*handler)(); /* routine which executes command */
-};
-
-#ifdef CONVEX
-char openhlp[] = "connect to a site";
-#else
-char openhelp[] = "connect to a site";
-#endif
-char closehelp[] = "close current connection";
-char quithelp[] = "exit telnet";
-char zhelp[] = "suspend telnet";
-char debughelp[] = "toggle debugging";
-char escapehelp[] = "set escape character";
-char statushelp[] = "print status information";
-char helphelp[] = "print help information";
-char optionshelp[] = "toggle viewing of options processing";
-char crmodhelp[] = "toggle mapping of received carriage returns";
-/* (TEK).. */
-char help4[] = "call imtek(-4)";
-char help5[] = "call imtek(-5)";
-char help6[] = "call imtek(-6)";
-/*..(TEK) */
-
-struct cmd cmdtab[] = {
-#ifdef CONVEX
- { "open", openhlp, tn },
-#else
- { "open", openhelp, tn },
-#endif
- { "close", closehelp, bye },
- { "quit", quithelp, quit },
-#ifdef SIGTSTP
- { "z", zhelp, suspend },
-#endif SIGTSTP
- { "escape", escapehelp, setescape },
- { "status", statushelp, status },
- { "options", optionshelp, setoptions },
- { "crmod", crmodhelp, setcrmod },
- { "debug", debughelp, setdebug },
- { "?", helphelp, help },
-/* (TEK).. */
- { "4", help4, caltek4 },
- { "5", help5, caltek5 },
- { "6", help6, caltek6 },
-/*..(TEK) */
- 0
-};
-
-struct sockaddr_in s_in;
-
-void intr(), deadpeer();
-char *control();
-struct cmd *getcmd();
-struct servent *sp;
-
-#ifdef VMS
-
-int sys$qiow(),sys$qio(),sys$assign(),sys$wflor(),sys$cancel(),sys$dassgn();
-int ttin = 3, ntin = 4; /* Event flag assignment hard-coded for now */
-int rtin, rmask, qmask, stat, ttyfmod, nflag = 0, tflag = 0, qcnt = 0;
-int oldcb[3], newcb[3];
-char qtibuf[100], qkar[4];
-unsigned short tiosb[4], niosb[4];
-static $DESCRIPTOR(device, "TT");
-
-/* For QIO buffering... */
-
-char netbuf[BUFSIZ], *netp; /* (BS) */
-int netbufsize = 0;
-char kbbuf[BUFSIZ], *kbbufp;
-int kbbufcount = 0;
-#define NET ntin /* kludge for select() as net > 32 */
-
-#else !VMS
-
-#define NET s
-
-#ifdef USG
-struct termio oterm, eterm;
-#ifdef CTRL_quoted
-char fakestartc = CTRL('Q');
-char fakestopc = CTRL('S');
-#else
-char fakestartc = CTRL(Q);
-char fakestopc = CTRL(S);
-#endif
-char eofc = CEOF;
-
-#ifdef SIGTSTP
-# ifdef hpux
-# include <bsdtty.h>
-# endif hpux
-#endif SIGTSTP
-
-#else !USG
-
-struct tchars otc, etc;
-struct ltchars oltc, eltc;
-struct sgttyb ottyb, ettyb;
-int olmode, elmode;
-#endif !USG
-#endif !VMS
-/**************************************************************************/
-main(argc, argv)
- int argc;
- char *argv[];
-{
- sp = getservbyname("telnet", "tcp");
- if (sp == 0) {
- fprintf(stderr, "telnet: tcp/telnet: unknown service\n");
- exit(1);
- }
-
-#ifdef VMS
- stat = sys$assign(&device, &rtin, NULL, NULL);
- if (stat != SS$_NORMAL) { fprintf(stderr, "Problem assigning rtin\n");
- exit(1); }
- stat = sys$qiow(NULL, rtin, IO$_SENSEMODE, tiosb,
- NULL, NULL, &oldcb, 12, NULL, NULL, NULL, NULL);
- if (stat != SS$_NORMAL){
- printf("Problem with sensemode(rtin)\n");
- printf("status = %x iosb0 = %x\n", stat, tiosb[0]);
- }
- newcb[0] = oldcb[0]; newcb[1] = oldcb[1];
- newcb[2] = ( oldcb[2] | TT2$M_PASTHRU );
-#else !VMS
-
-#ifdef USG
- ioctl(0, TCGETA, &oterm);
- eterm = oterm;
- eofc = oterm.c_cc[VEOF];
-#else !USG
- ioctl(0, TIOCGETP, (char *)&ottyb);
- ioctl(0, TIOCGETC, (char *)&otc);
- ioctl(0, TIOCGLTC, (char *)&oltc);
- ioctl(0, TIOCLGET, (char *)&olmode);
- etc = otc;
- ettyb = ottyb;
- eltc = oltc;
- elmode = olmode;
-#endif !USG
-#endif !VMS
- setbuf(stdin, 0);
- setbuf(stdout, 0);
- prompt = "telnetg";
- if (argc > 1 && !strcmp(argv[1], "-d"))
- debug = SO_DEBUG, argv++, argc--;
- if (argc != 1) {
- if (setjmp(toplevel) != 0)
- exit(0);
- tn(argc, argv);
- }
- setjmp(toplevel);
- for (;;)
- command(1);
-}
-
-char *hostname;
-char hnamebuf[32];
-
-tn(argc, argv)
- int argc;
- char *argv[];
-{
- register int c;
- register struct hostent *host;
-
- if (connected) {
- printf("?Already connected to %s\n", hostname);
- return;
- }
- if (argc < 2) {
- strcpy(line, "Connect ");
- printf("(to) ");
- gets(&line[strlen(line)]);
- makeargv();
- argc = margc;
- argv = margv;
- }
- if (argc > 3) {
- printf("usage: %s host-name [port]\n", argv[0]);
- return;
- }
- host = gethostbyname(argv[1]);
- if (host) {
- s_in.sin_family = host->h_addrtype;
- bcopy(host->h_addr, (caddr_t)&s_in.sin_addr, host->h_length);
- hostname = host->h_name;
- } else {
- s_in.sin_family = AF_INET;
- s_in.sin_addr.s_addr = inet_addr(argv[1]);
- if (s_in.sin_addr.s_addr == -1) {
- printf("%s: unknown host\n", argv[1]);
- return;
- }
- strcpy(hnamebuf, argv[1]);
- hostname = hnamebuf;
- }
- s_in.sin_port = sp->s_port;
- if (argc == 3) {
- s_in.sin_port = atoi(argv[2]);
-/*
- if (s_in.sin_port < 0) {
- printf("%s: bad port number\n", argv[2]);
- return;
- }
- */
- s_in.sin_port = htons(s_in.sin_port);
- }
-#if defined(LINUX) || defined(CONVEX)
- net = socket(AF_INET, SOCK_STREAM, 0);
-#else
- net = socket(AF_INET, SOCK_STREAM, 0, 0);
-#endif /* LINUX */
- if (net < 0) {
- perror("telnetg: socket");
- return;
- }
- if (debug && setsockopt(net, SOL_SOCKET, SO_DEBUG, 0, 0) < 0)
- perror("setsockopt (SO_DEBUG)");
- signal(SIGINT, intr);
- signal(SIGPIPE, deadpeer);
-
- printf("Trying...\n");
-#if defined(LINUX) || defined(CONVEX)
- if (connect(net, (caddr_t)&s_in, sizeof (s_in)) < 0) {
-#else
- if (connect(net, (caddr_t)&s_in, sizeof (s_in),0) < 0) {
-#endif /* LINUX */
- perror("telnetg: connect");
- signal(SIGINT, SIG_DFL);
- return;
- }
- connected++;
- call(status, "status", 0);
- if (setjmp(peerdied) == 0)
- telnet(net);
- fprintf(stderr, "Connection closed by foreign host.\n");
- exit(1);
-}
-
-/*
- * Print status about the connection.
- */
-/*VARARGS*/
-status()
-{
- if (connected)
- printf("Connected to %s.\n", hostname);
- else
- printf("No connection.\n");
- printf("Escape character is '%s'.\n", control(escape));
- fflush(stdout);
-}
-
-makeargv()
-{
- register char *cp;
- register char **argp = margv;
-
- margc = 0;
- for (cp = line; *cp;) {
- while (isspace(*cp))
- cp++;
- if (*cp == '\0')
- break;
- *argp++ = cp;
- margc += 1;
- while (*cp != '\0' && !isspace(*cp))
- cp++;
- if (*cp == '\0')
- break;
- *cp++ = '\0';
- }
- *argp++ = 0;
-}
-
-#ifdef SIGTSTP
-/*VARARGS*/
-suspend()
-{
- register int save;
- register unsigned long oldmask;
-
- save = mode(0);
- signal(SIGTSTP, SIG_DFL);
- kill(getpid(), SIGTSTP);
-
- /* reget parameters in case they were changed */
-#ifdef USG
- ioctl(0, TCGETA, &oterm);
-#else !USG
- ioctl(0, TIOCGETP, (char *)&ottyb);
- ioctl(0, TIOCGETC, (char *)&otc);
- ioctl(0, TIOCGLTC, (char *)&oltc);
-#endif !USG
- (void) mode(save);
-}
-#endif SIGTSTP
-
-/*VARARGS*/
-bye()
-{
- register char *op;
-
- (void) mode(0);
- if (connected) {
-#ifdef VMS
- cancel_qion();
- sys$dassgn(net);
-#else !VMS
- shutdown(net, 2);
- close(net);
-#endif VMS
- printf("Connection closed.\n");
- connected = 0;
- /* reset his options */
- for (op = hisopts; op < &hisopts[256]; op++)
- *op = 0;
- }
-}
-
-/*VARARGS*/
-quit()
-{
- call(bye, "bye", 0);
- exit(0);
-}
-
-/*
- * Help command.
- */
-help(argc, argv)
- int argc;
- char *argv[];
-{
- register struct cmd *c;
-
- if (argc == 1) {
- printf("Commands may be abbreviated. Commands are:\n\n");
- for (c = cmdtab; c->name; c++)
- printf("%-*s\t%s\n", HELPINDENT, c->name, c->help);
- return;
- }
- while (--argc > 0) {
- register char *arg;
- arg = *++argv;
- c = getcmd(arg);
- if (c == (struct cmd *)-1)
- printf("?Ambiguous help command %s\n", arg);
- else if (c == (struct cmd *)0)
- printf("?Invalid help command %s\n", arg);
- else
- printf("%s\n", c->help);
- }
-}
-
-/*
- * Call routine with argc, argv set from args (terminated by 0).
- * VARARGS2
- */
-call(routine, args)
- int (*routine)();
- int args;
-{
- register int *argp;
- register int argc;
-
- for (argc = 0, argp = &args; *argp++ != 0; argc++)
- ;
- (*routine)(argc, &args);
-}
-
-#ifdef VMS
- /* Mode treatment for VMS */
-mode(f)
- register int f;
-{
- static int prevmode = -2; /* Impossible previous value */
- int onoff, old;
-
- if(f >= 0) {
- if (prevmode == f)
- return (f);
- old = prevmode;
- prevmode = f;
- } else {
- /* mode(-1) just resets the tty according to eterm */
- f = old = prevmode;
- }
-
- switch (f) {
-
- case 0:
- onoff = 0;
- cancel_qiot();
- stat = sys$qiow(NULL, rtin, IO$_SETMODE, tiosb,
- NULL, NULL, &oldcb, 12, NULL, NULL, NULL, NULL);
- if (stat != SS$_NORMAL){
- printf("Problem with setmode(rtin)\n");
- printf("status = %x iosb0 = %x\n", stat, tiosb[0]);
- }
- ttyfmod = IO$_READVBLK;
- break;
- case 1:
- cancel_qiot();
- stat = sys$qiow(NULL, rtin, IO$_SETMODE, tiosb,
- NULL, NULL, &newcb, 12, NULL, NULL, NULL, NULL);
- if (stat != SS$_NORMAL){
- printf("Problem with setmode(rtin)\n");
- printf("status = %x iosb0 = %x\n", stat, tiosb[0]);
- }
- ttyfmod = IO$_READVBLK | IO$M_NOECHO;
- break;
- case 2:
- cancel_qiot();
- stat = sys$qiow(NULL, rtin, IO$_SETMODE, tiosb,
- NULL, NULL, &newcb, 12, NULL, NULL, NULL, NULL);
- if (stat != SS$_NORMAL){
- printf("Problem with setmode(rtin)\n");
- printf("status = %x iosb0 = %x\n", stat, tiosb[0]);
- }
- ttyfmod = IO$_READVBLK;
- break;
-
- default:
- return(old);
- }
- return (old);
-}
-#else !VMS
-
-#ifdef USG
- /* Set mode of a System V tty */
-
-mode(f)
- register int f;
-{
- static int prevmode = -2; /* Impossible previous value */
- register struct termio *tp = &eterm;
- int onoff, old;
-
- if(f >= 0) {
- if (prevmode == f)
- return (f);
- old = prevmode;
- prevmode = f;
- } else {
- /* mode(-1) just resets the tty according to eterm */
- f = old = prevmode;
- }
-
- switch (f) {
-
- case 0:
- onoff = 0;
- tp = &oterm;
- break;
-
- case 1:
- eterm.c_iflag &= ~ICRNL;
- eterm.c_oflag &= ~(ONLCR|OPOST);
- eterm.c_lflag &= ~(ECHO|ICANON);
- eterm.c_cc[VMIN] = 1;
- eterm.c_cc[VTIME] = 1;
- onoff = 1;
- break;
- case 2:
- eterm.c_iflag |= ICRNL;
- eterm.c_oflag |= ONLCR|OPOST;
- eterm.c_lflag |= ECHO|ISIG|ICANON;
- eterm.c_cc[VEOL] = escape;
- eterm.c_cc[VEOF] = eofc;
- onoff = 1;
- break;
-
- default:
- return(old);
- }
- ioctl(fileno(stdin), TCSETAW, tp);
- ioctl(fileno(stdin), FIONBIO, &onoff);
- /* ioctl(fileno(stdout), FIONBIO, &onoff); */
- return (old);
-}
-
-#else !USG
- /* Set mode of a 4.xBSD tty */
-
-mode(f)
- register int f;
-{
- static int prevmode = -2; /* Impossible previous value */
- int onoff, old;
- register struct tchars *tc;
- register struct ltchars *ltc;
- struct sgttyb sb;
- static struct tchars notc = { -1, -1, -1, -1, -1, -1 };
- static struct ltchars noltc = { -1, -1, -1, -1, -1, -1 };
-
-
- if(f >= 0) {
- if (prevmode == f)
- return (f);
- old = prevmode;
- prevmode = f;
- } else {
- /* mode(-1) just resets the tty according to etc &c */
- f = old = prevmode;
- }
- switch (f) {
-
- case 0:
- onoff = 0;
- tc = &otc;
- ltc = &oltc;
- sb = ottyb;
- break;
-
- case 1:
- sb = ettyb;
- sb.sg_flags |= CBREAK;
- sb.sg_flags &= ~(ECHO|CRMOD);
- notc.t_intrc = etc.t_intrc;
- notc.t_quitc = etc.t_quitc;
- notc.t_startc = etc.t_startc;
- notc.t_stopc = etc.t_stopc;
- tc = ¬c;
- ltc = &noltc;
- onoff = 1;
- break;
-
- case 2:
- sb = ettyb;
- sb.sg_flags &= ~CBREAK;
- sb.sg_flags |= (ECHO|CRMOD);
- etc.t_brkc = escape;
- eltc.t_suspc = -1;
- eltc.t_dsuspc = -1;
- tc = &etc;
- ltc = &eltc;
- onoff = 1;
- break;
-
- default:
- return(old);
- }
- ioctl(fileno(stdin), TIOCSETN, (char *)&sb);
- ioctl(fileno(stdin), TIOCSLTC, (char *)ltc);
- ioctl(fileno(stdin), TIOCSETC, (char *)tc);
- ioctl(fileno(stdin), FIONBIO, &onoff);
- /* ioctl(fileno(stdout), FIONBIO, &onoff); */
- return (old);
-}
-#endif !USG
-#endif !VMS
-
-char sibuf[BUFSIZ], *sbp;
-char tibuf[BUFSIZ], *tbp;
-int scc, tcc;
-
-/*
- * Select from tty and network...
- */
-telnet(s)
- int s;
-{
- register int c;
- int on = 1;
- int tin = fileno(stdin), tout = fileno(stdout);
-
-
- (void) mode(2);
-#ifndef VMS
-/**** DON'T DO THIS ON A WIN/TCP SYSTEM !! (TEST ON MULTINET) ******/
- if (ioctl(s, FIONBIO, &on) < 0) perror("telnetg: ioctl FIONBIO");
-#endif VMS
-
- im = 0; /* (IM) */
- tek = tekarg = 0; /* (TEK).. */
-
- if (dbgt < 0) printf("Init imtek with arg = %d\n", tekarg);
- /* (TEK/IM).. */
- if (dbgt <= 0) imtek(tekarg); /* Initialize imtek (TEK) */
-
- for (;;) {
- int ibits = 0, obits = 0;
-
- if (nfrontp - nbackp) /* Network output waiting */
- obits |= (1 << NET);
- else
- ibits |= (1 << tin);
- if (tfrontp - tbackp) /* Screen output waiting */
- obits |= (1 << tout);
- else
- ibits |= (1 << NET);
-
- if (scc < 0 && tcc < 0) break;
-#ifdef VMS
- vmselect(16, &ibits, &obits, 0, 0);
-#else
- select(16, &ibits, &obits, 0, 0);
-#endif VMS
- if (ibits == 0 && obits == 0) {
- sleep(5);
- continue;
- }
- /*
- * Something to read from the network...
- */
- if (ibits & (1 << NET)) {
-#ifdef VMS
- scc = netread(s, sibuf, sizeof (sibuf));
-#else
- scc = read(s, sibuf, sizeof (sibuf));
-#endif VMS
- if (scc < 0 && errno == EWOULDBLOCK)
- scc = 0;
- else {
- if (scc <= 0)
- break;
- sbp = sibuf;
- }
- }
- /*
- * Something to read from the tty...
- */
- if (ibits & (1 << tin)) {
-#ifdef VMS
- tcc = ttyread(ttin, tibuf, sizeof (tibuf));
-#else
- tcc = read(tin, tibuf, sizeof (tibuf));
-#endif VMS
- if (tcc < 0 && errno == EWOULDBLOCK)
- tcc = 0;
- else {
- if (tcc <= 0)
- break;
- tbp = tibuf;
- }
- }
-
- while (tcc > 0) {
- register int c;
-
- if ((&netobuf[BUFSIZ] - nfrontp) < 2)
- break;
- c = *tbp++ & 0377, tcc--;
- if (strip(c) == escape) {
-#ifdef VMS
- cancel_qiot();
-#endif VMS
- command(0);
- tcc = 0;
- break;
- }
- if (c == IAC)
- *nfrontp++ = c;
- *nfrontp++ = c;
- }
-#ifdef VMS
- if ((nfrontp - nbackp) > 0)
-#else
- if ((obits & (1 << NET)) && (nfrontp - nbackp) > 0)
-#endif VMS
- netflush(s); /* Output down network */
-
- if (scc > 0)
- telrcv(); /* Process network input */
-#ifdef VMS
- if ((tfrontp - tbackp) > 0)
-#else
- if ((obits & (1 << tout)) && (tfrontp - tbackp) > 0)
-#endif VMS
- ttyflush(tout); /* Output to screen */
-
- }
- (void) mode(0);
-}
-
-/* And here comes "vmselect" and friends "netread", "ttyread".... */
-
-#ifdef VMS
-
-/* This VMS version of "select" is just enough for tty and network input */
-/* Handling of output bits is a kludge: they are just passed through. */
-/* It is WIN/TCP and Multinet compatible. Sorry for you UCX folks... */
-/* NOTE: In WIN/TCP select only does network I/O. */
-/* In Multinet and UCX there isn't any select at all. */
-
-vmselect(dum, ibits, obits, ebits, time)
- int dum, *ibits, *obits, *ebits;
- struct timeval *time;
-{
- int ib = 0, ob = 0;
- register int i, stat;
-
-
- /* start 1st qio on tty input.. */
- if (!tflag) {
- stat = sys$qio(ttin, rtin, ttyfmod, tiosb,
- NULL, NULL, qkar, 1, NULL, NULL, NULL, NULL);
- if (stat != SS$_NORMAL){
- printf("Problem with qio(rtin)\n");
- printf("status = %x iosb0 = %x\n", stat, tiosb[0]);
- } else tflag++;
- }
-
- /* start 1st qio on network input.. */
- if (!nflag) {
- stat = sys$qio(ntin, net, IO$_READVBLK, niosb, NULL, NULL,
- netbuf, BUFSIZ, NULL, NULL, NULL, NULL);
- if (stat != SS$_NORMAL){
- printf("Problem with qio(net)\n");
- printf("status = %x niosb[0] = %x error = %d\n",
- stat, niosb[0], (niosb[0]&0x7fff)>>3);
- } else nflag++;
- }
- if (*ibits == 0) {
- return(0);
- }
- if (time == (struct timeval *)0) { /* NOTE: no timeout implemented */
- qmask = 0;
-
- qmask |= (1<<ttin); /* deal with tty input any time... */
- if (*ibits & (1<<NET)) qmask |= (1<<ntin);
-
- /* wait on 'OR' of network and tty input */
- stat = sys$wflor(ttin, qmask);
- if (stat != SS$_NORMAL)
- { printf("wflor stat = %x\n", stat); return(-1); }
- }
-
- /* read event flags of cluster into rmask */
- stat = sys$readef(ttin, &rmask);
- if ((stat != SS$_WASCLR) && (stat != SS$_WASSET))
- { printf("readef stat = %x\n", stat); return(-1); }
-
- /* check network input (if appropriate).. */
- if ((*ibits & (1<<NET)) && (rmask & (1<<ntin))) {
- if (niosb[0] != SS$_NORMAL) {
- perror("network input error");
- printf("...TWG error=%d\n", (niosb[0]&0x7fff)>>3);
- }
- if ((netbufsize = niosb[1]) < 0) perror("netread");
- ib |= (1<<NET); /* network input found.. */
- netp = netbuf; /* ..and all set up for netread().. */
- }
- /* check tty input (any time).. */
- if (rmask & (1<<ttin)) { /* deal with tty input any time... */
- tflag = 0; /* found some, flag for qio restart */
- if (tiosb[0] == SS$_NORMAL && qcnt >= 0) {
- qtibuf[qcnt++] = qkar[0];
- } else qcnt = -1;
- }
- if ((*ibits & 1) && (qcnt)) ib |= 1; /* tty input wanted and ready */
-
- *ibits = ib;
-/*** NOTE: NUMBER OF BITS IN "obits" NOT IMPLEMENTED YET **************/
- if (ib > 1) return(2); else return(ib); /* return no. of bits in ib */
-}
-
-netread(s, sbuf, sbufsize)
-char *sbuf;
-{
- int n = netbufsize; /* netbufsize is set by select */
-
- if (n <= 0)
- goto netex; /* Error or disconnect */
- if (n <= sbufsize) {
- bcopy(netbuf, sbuf, n);
- netbufsize -= n;
- } else {
- n = -2;
- perror("netread: select buffer oversized");
- }
-netex: if (nflag) { /* it should be set from select.. */
- nflag = 0; /* COULD restart qio for efficiency here */
- }
- return(n);
-}
-
-ttyread(t, tbuf, tbufsize)
-char *tbuf;
-{
- int n = qcnt; /* qcnt is set by select */
-
- if (n <= 0)
- goto ttyex;
- if (n <= tbufsize) {
- bcopy(qtibuf, tbuf, n);
- qcnt -= n;
- } else {
- n = -2;
- perror("netread: select buffer oversized");
- }
-ttyex: if (tflag) { /* it should be set from select.. */
- tflag = 0; /* COULD restart qio for efficiency here */
- }
- return(n);
-}
-
-cancel_qiot()
-{
-
- if (tflag) {
- stat = sys$cancel(rtin);
- if (stat != SS$_NORMAL)
- printf("cancel_qiot status = %x\n", stat);
- tflag = 0;
- }
-}
-
-cancel_qion()
-{
-
- if (nflag) {
- stat = sys$cancel(net);
- if (stat != SS$_NORMAL)
- printf("cancel_qion status = %x\n", stat);
- nflag = 0;
- }
-}
-#endif VMS
-
-command(top)
- int top;
-{
- register struct cmd *c;
- int oldmode, wasopen;
-
- oldmode = mode(0);
- if (!top)
- putchar('\n');
- else
- signal(SIGINT, SIG_DFL);
- for (;;) {
- printf("%s> ", prompt);
- if (gets(line) == 0) {
- if (feof(stdin)) {
- clearerr(stdin);
- putchar('\n');
- }
- break;
- }
- if (line[0] == 0)
- break;
- makeargv();
- c = getcmd(margv[0]);
- if (c == (struct cmd *)-1) {
- printf("?Ambiguous command\n");
- continue;
- }
- if (c == 0) {
- printf("?Invalid command\n");
- continue;
- }
- (*c->handler)(margc, margv);
- if (c->handler != help)
- break;
- }
- if (!top) {
- if (!connected)
- longjmp(toplevel, 1);
- (void) mode(oldmode);
- }
-}
-
-/*
- * Telnet receiver states for fsm
- */
-#define TS_DATA 0
-#define TS_IAC 1
-#define TS_WILL 2
-#define TS_WONT 3
-#define TS_DO 4
-#define TS_DONT 5
-
-telrcv()
-{
- register int c;
- static int state = TS_DATA;
-
- while (scc > 0) {
- c = *sbp++ & 0377, scc--;
- switch (state) {
-
- case TS_DATA:
- if (c == IAC) {
- state = TS_IAC;
- continue;
- }
-/* (TEK).. */
- if (c == TEKON) tek = 1;
- if (tek) {
- if (c == TEKOF) tek = 0;
- if (c >= ESC || c == FF) {
- tekarg = c;
- } else {
- tek = 0; tekarg = TEKOF;
- }
- if(dbgt < 0){
- printf("tek = %d c = %d tekarg = %d\n", tek,c,tekarg);
- }
- if(dbgt <= 0) imtek(tekarg);
- continue;
- }
-/* ..(TEK) */
-
-/* (IM).. */
-/* im1 and im2 are used to suppress the CR/LF after the 2nd IMCHR */
- if (im1) { im1=0; continue; }
- if (im2) { im2=0; continue; }
- if (im) {
- if (c == IMEOR && flb == 1) { /* flush the imbuf buffer */
- flb=0;
- imptr = imbuf;
- continue;
- }
- if (c == IMCHR) {
- imcount = imcount-1;
- if (imcount == 0 ) {
- im = 0; im1++; im2++;
- }
- } else {
- if (imptr > imlim) {
- *imptr = '\0';
- imptr = imbgn; /* SAFETY */
- }
- if (c >= ASCIIS && c <= ASCIIE )
- *imptr++ = c;
- }
- if (c == IMEOR) {
- flb=1;
- imptr--;
- if (imptr == imbgn) continue;
- imout = IMLEN - (imlim-imptr);
-#ifdef apollo
- imint(imbuf,imout);
-#else
-#ifdef VMS /* add by O.Couet (September 14, 1990) */
- imbuf2.dsc$b_dtype = DSC$K_DTYPE_T;
- imbuf2.dsc$b_class = DSC$K_CLASS_S;
- imbuf2.dsc$w_length = 82;
- imbuf2.dsc$a_pointer = imbuf;
- imint(&imbuf2,&imout);
-#else
- imint(imbuf,&imout);
-#endif VMS
-#endif apollo
- if (imout == 1) { /* Send input... */
- register int i;
- for (i=0; i<IMLEN; i++)
- *nfrontp++ = imbuf[i];
- }
- imptr = imbuf;
- }
- continue;
- }
- else if (c == IMCHR) {
- imcount = imcount+1;
- if (imcount == 2 ) {
- im = 1;
- imptr = imbuf;
- continue;
- } else {
- continue;
- }
- }
- imcount = 0;
-/* ..(IM) */
-
- *tfrontp++ = c;
- /*
- * This hack is needed since we can't set
- * CRMOD on output only. Machines like MULTICS
- * like to send \r without \n; since we must
- * turn off CRMOD to get proper input, the mapping
- * is done here (sigh).
- */
- if (c == '\r' && crmod) {
- *tfrontp++ = '\n';
- if ((&ttyobuf[BUFSIZ] - tfrontp) < 2)
- { printf("\nAAAAGH !\n"); break; } /* (BS) */
- }
- continue;
-
- case TS_IAC:
- switch (c) {
-
- case WILL:
- state = TS_WILL;
- continue;
-
- case WONT:
- state = TS_WONT;
- continue;
-
- case DO:
- state = TS_DO;
- continue;
-
- case DONT:
- state = TS_DONT;
- continue;
-
- case DM:
-#ifdef USG
- ioctl(fileno(stdout), TCFLSH, NULL);
-#else !USG
-#ifdef TIOCFLUSH
- ioctl(fileno(stdout), TIOCFLUSH, 0);
-#endif
-#endif !USG
- break;
-
- case NOP:
- case GA:
- break;
-
- default:
- break;
- }
- state = TS_DATA;
- continue;
-
- case TS_WILL:
- printoption("RCVD", will, c, !hisopts[c]);
- if (!hisopts[c])
- willoption(c);
- state = TS_DATA;
- continue;
-
- case TS_WONT:
- printoption("RCVD", wont, c, hisopts[c]);
- if (hisopts[c])
- wontoption(c);
- state = TS_DATA;
- continue;
-
- case TS_DO:
- printoption("RCVD", doopt, c, !myopts[c]);
- if (!myopts[c])
- dooption(c);
- state = TS_DATA;
- continue;
-
- case TS_DONT:
- printoption("RCVD", dont, c, myopts[c]);
- if (myopts[c]) {
- myopts[c] = 0;
- sprintf(nfrontp, wont, c);
- nfrontp += sizeof (wont) - 2;
- printoption("SENT", wont, c);
- }
- state = TS_DATA;
- continue;
- }
- }
-}
-
-willoption(option)
- int option;
-{
- char *fmt;
-
- switch (option) {
-
- case TELOPT_ECHO:
- (void) mode(1);
-
- case TELOPT_SGA:
- hisopts[option] = 1;
- fmt = doopt;
- break;
-
- case TELOPT_TM:
- fmt = dont;
- break;
-
- default:
- fmt = dont;
- break;
- }
- sprintf(nfrontp, fmt, option);
- nfrontp += sizeof (dont) - 2;
- printoption("SENT", fmt, option);
-}
-
-wontoption(option)
- int option;
-{
- char *fmt;
-
- switch (option) {
-
- case TELOPT_ECHO:
- (void) mode(2);
-
- case TELOPT_SGA:
- hisopts[option] = 0;
- fmt = dont;
- break;
-
- default:
- fmt = dont;
- }
- sprintf(nfrontp, fmt, option);
- nfrontp += sizeof (doopt) - 2;
- printoption("SENT", fmt, option);
-}
-
-dooption(option)
- int option;
-{
- char *fmt;
-
- switch (option) {
-
- case TELOPT_TM:
- fmt = wont;
- break;
-
- case TELOPT_ECHO:
- (void) mode(2);
- fmt = will;
- hisopts[option] = 0;
- break;
-
- case TELOPT_SGA:
- fmt = will;
- break;
-
- default:
- fmt = wont;
- break;
- }
- sprintf(nfrontp, fmt, option);
- nfrontp += sizeof (doopt) - 2;
- printoption("SENT", fmt, option);
-}
-
-/*
- * Set the escape character.
- */
-setescape(argc, argv)
- int argc;
- char *argv[];
-{
- register char *arg;
- char buf[50];
-
- if (argc > 2)
- arg = argv[1];
- else {
- printf("new escape character: ");
- gets(buf);
- arg = buf;
- }
- if (arg[0] != '\0')
- escape = arg[0];
- printf("Escape character is '%s'.\n", control(escape));
- fflush(stdout);
-}
-
-/*VARARGS*/
-setoptions()
-{
-
- showoptions = !showoptions;
- printf("%s show option processing.\n", showoptions ? "Will" : "Wont");
- fflush(stdout);
-}
-
-/*VARARGS*/
-setcrmod()
-{
-
- crmod = !crmod;
- printf("%s map carriage return on output.\n",
- crmod ? "Will" : "Wont");
- fflush(stdout);
-}
-
-/*VARARGS*/
-setdebug()
-{
-
- debug = !debug;
- printf("%s turn on socket level debugging.\n",
- debug ? "Will" : "Wont");
- fflush(stdout);
- if (debug && net > 0
- && setsockopt(net, SOL_SOCKET, SO_DEBUG, 0, 0) < 0)
- perror("setsockopt (SO_DEBUG)");
-}
-
-/*
- * Construct a control character sequence
- * for a special character.
- */
-char *
-control(c)
- register int c;
-{
- static char buf[3];
-
- if (c == 0177)
- return ("^]");
- if (c >= 040) {
- buf[0] = c;
- buf[1] = 0;
- } else {
- buf[0] = '^';
- buf[1] = '@'+c;
- buf[2] = 0;
- }
- return (buf);
-}
-
-struct cmd *
-getcmd(name)
- register char *name;
-{
- register char *p, *q;
- register struct cmd *c, *found;
- register int nmatches, longest;
-
- longest = 0;
- nmatches = 0;
- found = 0;
- for (c = cmdtab; p = c->name; c++) {
- for (q = name; *q == *p++; q++)
- if (*q == 0) /* exact match? */
- return (c);
- if (!*q) { /* the name was a prefix */
- if (q - name > longest) {
- longest = q - name;
- nmatches = 1;
- found = c;
- } else if (q - name == longest)
- nmatches++;
- }
- }
- if (nmatches > 1)
- return ((struct cmd *)-1);
- return (found);
-}
-
-void deadpeer()
-{
- (void) mode(0);
- longjmp(peerdied, -1);
-}
-
-void intr()
-{
- (void) mode(0);
- longjmp(toplevel, -1);
-}
-
-ttyflush(fd)
-{
- int n;
-
- if ((n = tfrontp - tbackp) > 0)
-
- n = write(fd, tbackp, n); /* (BS) */
- if (n < 0)
- return;
- tbackp += n;
- if (tbackp == tfrontp)
- tbackp = tfrontp = ttyobuf;
-}
-
-netflush(fd)
-{
- int n;
-
- if ((n = nfrontp - nbackp) > 0)
-
-#ifdef VMS
- n = send (fd, nbackp, n);
-#else
- n = write(fd, nbackp, n);
-#endif VMS
- if (n < 0) {
- if (errno != ENOBUFS && errno != EWOULDBLOCK) {
- (void) mode(0);
- perror(hostname);
- close(fd);
- longjmp(peerdied, -1);
- /*NOTREACHED*/
- }
- n = 0;
- }
- nbackp += n;
- if (nbackp == nfrontp)
- nbackp = nfrontp = netobuf;
-}
-
-/*VARARGS*/
-printoption(direction, fmt, option, what)
- char *direction, *fmt;
- int option, what;
-{
- if (!showoptions)
- return;
- printf("%s ", direction);
- if (fmt == doopt)
- fmt = "do";
- else if (fmt == dont)
- fmt = "dont";
- else if (fmt == will)
- fmt = "will";
- else if (fmt == wont)
- fmt = "wont";
- else
- fmt = "???";
- if (option < TELOPT_SUPDUP)
- printf("%s %s", fmt, telopts[option]);
- else
- printf("%s %d", fmt, option);
- if (*direction == '<') {
- printf("\r\n");
- return;
- }
- printf(" (%s)\r\n", what ? "reply" : "don't reply");
-}
-
-/* (TEK).. */
-caltek4()
-{
- tekarg = -4; imtek(tekarg);
-}
-
-caltek5()
-{
- tekarg = -5; imtek(tekarg);
-}
-
-caltek6()
-{
- tekarg = -6; imtek(tekarg);
-}
diff --git a/src/packlib/cspack/programs/Imakefile b/src/packlib/cspack/programs/Imakefile
deleted file mode 100644
index d1e069d..0000000
--- a/src/packlib/cspack/programs/Imakefile
+++ /dev/null
@@ -1,9 +0,0 @@
-DoIncludePackage(cspack)
-
-#define IHaveSubdirs
-#define PassCDebugFlags
-
-SUBDIRS= zftp zs
-
-InstallBinSubdirs($(SUBDIRS))
-
diff --git a/src/packlib/cspack/programs/zftp/Imakefile b/src/packlib/cspack/programs/zftp/Imakefile
deleted file mode 100644
index 6288759..0000000
--- a/src/packlib/cspack/programs/zftp/Imakefile
+++ /dev/null
@@ -1,19 +0,0 @@
-SRCS_F= geta.F getb.F getd.F getfz.F getp.F getrz.F getx.F \ @@\
- mget.F mput.F puta.F putb.F putd.F putfz.F putp.F putrz.F \ @@\
- putx.F rclose.F rlogin.F rshell.F zabend.F zexit.F zfctof.F \ @@\
- zfftoc.F zffzcp.F zflogc.F zfrfrf.F zfrtof.F zfrzcp.F zftlcd.F \ @@\
- zftlls.F zftlmv.F zftlrm.F zftpcd.F zftpls.F zftpmv.F \ @@\
- zftprm.F zftpwd.F zfvers.F
-
-#define IHaveCDF
-SRCS_CDF= zftpcdf.cdf
-
-SubdirLibraryTarget(zftplib,NullParameter)
-
-DefinePackageLibrary(zftplib)
-
-NeedTcpipLib
-
-CernlibFortranProgramTarget(zftp,zftp.o,$(PACKAGE_LIB),$(PACKAGE_LIB),packlib)
-
-InstallProgram(zftp,$(CERN_BINDIR))
diff --git a/src/packlib/cspack/programs/zftp/geta.F b/src/packlib/cspack/programs/zftp/geta.F
deleted file mode 100644
index b05ca03..0000000
--- a/src/packlib/cspack/programs/zftp/geta.F
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: geta.F,v 1.1.1.1 1996/03/08 15:44:19 mclareni Exp $
-*
-* $Log: geta.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:19 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE GETA
-*
-* Action routine for GETA command
-*
-#include "cspack/czsock.inc"
- CHARACTER*80 REMOTE,LOCAL
- CHARACTER*8 CHOPT
-*
-#include "cspack/czopen.inc"
- CALL KUGETS(REMOTE,NCHR)
- CALL KUGETS(LOCAL,NCHL)
- NCHL = LENOCC(LOCAL)
- IF(NCHL.LE.0)LOCAL=REMOTE
- IF(LOCAL(1:NCHL).EQ.'=') LOCAL=REMOTE
- NCHL = LENOCC(LOCAL)
- CALL KUGETC(CHOPT,NCH)
- IF(NCH.EQ.0) THEN
- CHOPT = ' '
- NCH = 1
- ENDIF
-#include "cspack/czfold.inc"
- CALL XZGETA(LOCAL,REMOTE,CHOPT,IRC)
-99 END
-
diff --git a/src/packlib/cspack/programs/zftp/getb.F b/src/packlib/cspack/programs/zftp/getb.F
deleted file mode 100644
index 3323911..0000000
--- a/src/packlib/cspack/programs/zftp/getb.F
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: getb.F,v 1.1.1.1 1996/03/08 15:44:19 mclareni Exp $
-*
-* $Log: getb.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:19 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE GETB
-*
-* Action routine for GETB command
-*
- CHARACTER*80 REMOTE,LOCAL
- CHARACTER*8 CHOPT
-#include "cspack/czsock.inc"
-*
-#include "cspack/czopen.inc"
- CALL KUGETS(REMOTE,NCHR)
- CALL KUGETS(LOCAL,NCHL)
- IF(NCHL.LE.0)LOCAL=REMOTE
- IF(LOCAL(1:NCHL).EQ.'=') LOCAL=REMOTE
- NCHL = LENOCC(LOCAL)
- CALL KUGETI(LRECL)
- CALL KUGETC(CHOPT,NCH)
-#include "cspack/czfold.inc"
- CALL XZGETB(LOCAL,REMOTE,LRECL,CHOPT,IRC)
-99 END
-
diff --git a/src/packlib/cspack/programs/zftp/getd.F b/src/packlib/cspack/programs/zftp/getd.F
deleted file mode 100644
index 30f751b..0000000
--- a/src/packlib/cspack/programs/zftp/getd.F
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: getd.F,v 1.1.1.1 1996/03/08 15:44:19 mclareni Exp $
-*
-* $Log: getd.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:19 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE GETD
-*
-* Action routine for GETD command
-*
- CHARACTER*80 REMOTE,LOCAL
- CHARACTER*8 CHOPT
-#include "cspack/czsock.inc"
-*
-#include "cspack/czopen.inc"
- CALL KUGETS(REMOTE,NCHR)
- CALL KUGETS(LOCAL,NCHL)
- IF(NCHL.LE.0)LOCAL=REMOTE
- IF(LOCAL(1:NCHL).EQ.'=') LOCAL=REMOTE
- NCHL = LENOCC(LOCAL)
- CALL KUGETI(LRECL)
- CALL KUGETC(CHOPT,NCH)
-#include "cspack/czfold.inc"
- CALL XZGETD(LOCAL,REMOTE,LRECL,CHOPT,IRC)
-99 END
-
diff --git a/src/packlib/cspack/programs/zftp/getfz.F b/src/packlib/cspack/programs/zftp/getfz.F
deleted file mode 100644
index bedabf0..0000000
--- a/src/packlib/cspack/programs/zftp/getfz.F
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: getfz.F,v 1.1.1.1 1996/03/08 15:44:19 mclareni Exp $
-*
-* $Log: getfz.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:19 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE GETFZ
-*
-* Action routine for GETFZ command
-*
-#include "cspack/czsock.inc"
- CHARACTER*80 REMOTE,LOCAL
- CHARACTER*4 CHOPT,LFORM,RFORM
- INTEGER RRECL
-#include "cspack/czopen.inc"
- CALL KUGETS(REMOTE,NCHR)
- CALL KUGETS(LOCAL,NCHL)
- IF(NCHL.LE.0)LOCAL=REMOTE
- IF(LOCAL(1:NCHL).EQ.'=') LOCAL=REMOTE
- NCHL = LENOCC(LOCAL)
- CALL KUGETI(RRECL)
- CALL KUGETC(RFORM,NR)
- CALL KUGETI(LRECL)
- CALL KUGETC(LFORM,NL)
- CALL KUGETC(CHOPT,NCH)
-#include "cspack/czfold.inc"
- CALL XZGETF(LOCAL,REMOTE,LRECL,LFORM,RRECL,RFORM,CHOPT,IRC)
-99 END
-
diff --git a/src/packlib/cspack/programs/zftp/getp.F b/src/packlib/cspack/programs/zftp/getp.F
deleted file mode 100644
index 9de6c77..0000000
--- a/src/packlib/cspack/programs/zftp/getp.F
+++ /dev/null
@@ -1,38 +0,0 @@
-*
-* $Id: getp.F,v 1.1.1.1 1996/03/08 15:44:19 mclareni Exp $
-*
-* $Log: getp.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:19 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE GETP
-*
-* Action routine for GETP command
-*
-#include "cspack/czsock.inc"
- CHARACTER*80 REMOTE,LOCAL
- CHARACTER*4 CHOPT
-*
-#include "cspack/czopen.inc"
- CALL KUGETS(REMOTE,NCHR)
- CALL KUGETS(LOCAL,NCHL)
- IF(NCHL.LE.0)LOCAL=REMOTE
- IF(LOCAL(1:NCHL).EQ.'=') LOCAL=REMOTE
- NCHL = LENOCC(LOCAL)
- CALL KUGETC(CHOPT,NCH)
-#include "cspack/czfold.inc"
-#if defined(CERNLIB_CRAY)
- PRINT *,'GETP is not yet available for the Cray...'
- PRINT *,'You may transfer PAM files '
- PRINT *,' in CARD format using GET/PUTA'
- PRINT *,' in CETA format using GET/PUTB'
- PRINT *,' in CMZ format using GET/PUTRZ'
- RETURN
-#endif
-#if !defined(CERNLIB_CRAY)
- CALL XZGETP(LOCAL,REMOTE,CHOPT,IRC)
-#endif
-99 END
-
diff --git a/src/packlib/cspack/programs/zftp/getrz.F b/src/packlib/cspack/programs/zftp/getrz.F
deleted file mode 100644
index 7419c66..0000000
--- a/src/packlib/cspack/programs/zftp/getrz.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: getrz.F,v 1.1.1.1 1996/03/08 15:44:19 mclareni Exp $
-*
-* $Log: getrz.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:19 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE GETRZ
-*
-* Action routine for GETRZ command
-*
-#include "cspack/czsock.inc"
- CHARACTER*80 REMOTE,LOCAL
- CHARACTER*8 CHOPT
-*
-#include "cspack/czopen.inc"
- CALL KUGETS(REMOTE,NCHR)
- CALL KUGETS(LOCAL,NCHL)
- IF(NCHL.LE.0)LOCAL=REMOTE
- IF(LOCAL(1:NCHL).EQ.'=') LOCAL=REMOTE
- NCHL = LENOCC(LOCAL)
- CALL KUGETC(CHOPT,NCH)
-#include "cspack/czfold.inc"
- CALL XZGETR(LOCAL,REMOTE,CHOPT,IRC)
-99 END
-
diff --git a/src/packlib/cspack/programs/zftp/getx.F b/src/packlib/cspack/programs/zftp/getx.F
deleted file mode 100644
index 0bbaa2a..0000000
--- a/src/packlib/cspack/programs/zftp/getx.F
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: getx.F,v 1.1.1.1 1996/03/08 15:44:20 mclareni Exp $
-*
-* $Log: getx.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:20 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE GETX
-*
-* Action routine for GETX command
-*
- CHARACTER*80 REMOTE,LOCAL
- CHARACTER*8 CHOPT
-#include "cspack/czsock.inc"
-*
-#include "cspack/czopen.inc"
- CALL KUGETS(REMOTE,NCHR)
- CALL KUGETS(LOCAL,NCHL)
- IF(NCHL.LE.0)LOCAL=REMOTE
- IF(LOCAL(1:NCHL).EQ.'=') LOCAL=REMOTE
- NCHL = LENOCC(LOCAL)
- CALL KUGETI(LRECL)
- CALL KUGETC(CHOPT,NCH)
-#include "cspack/czfold.inc"
- CALL XZGETX(LOCAL,REMOTE,LRECL,CHOPT,IRC)
-99 END
-
diff --git a/src/packlib/cspack/programs/zftp/mget.F b/src/packlib/cspack/programs/zftp/mget.F
deleted file mode 100644
index 471b22e..0000000
--- a/src/packlib/cspack/programs/zftp/mget.F
+++ /dev/null
@@ -1,123 +0,0 @@
-*
-* $Id: mget.F,v 1.1.1.1 1996/03/08 15:44:19 mclareni Exp $
-*
-* $Log: mget.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:19 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE MGET
-*-- Author : Jamie Shiers 12/02/91
- CHARACTER*64 LOCAL,REMOTE,FNAME1,FNAME2
- CHARACTER*8 LOCTYP,REMTYP
- CHARACTER*4 CHOPT
- PARAMETER (NMAX=100)
- CHARACTER*128 FILES(NMAX)
-#include "cspack/quest.inc"
-#include "cspack/hcmail.inc"
-#include "cspack/czsock.inc"
-#include "cspack/czunit.inc"
-#include "cspack/czopen.inc"
-*
-* Get multiple files from remote node, with optional
-* change of extension name (e.g. .CAR -> .CARDS)
-*
- CALL KUGETC(REMOTE,NCHR)
- CALL KUGETC(LOCAL,NCHL)
- CALL KUGETC(CHOPT,NCH)
-
- IF(NCHL.EQ.0) THEN
- LOCAL = REMOTE
- NCHL = NCHR
- ENDIF
-
- IF((NCHL.EQ.1).AND.(LOCAL(1:1).EQ.'=')) THEN
- LOCAL = REMOTE
- NCHL = NCHR
- ENDIF
-*
-* Get list of file names
-*
- IF(IDEBXZ.GE.1) PRINT *,'MGET. retrieving list of file names...'
-
- ICONT = 0
- JDOT = INDEX(LOCAL(1:NCHL),'.')
-
- IF(IDEBXZ.GE.3) PRINT *,'MGET. call XZLS for ',REMOTE(1:NCHR)
- 1 CONTINUE
- CALL XZLS(REMOTE(1:NCHR),FILES,NMAX,NFILES,ICONT,' ',IC)
- IF(IDEBXZ.GE.3) PRINT *,'MGET. ',NFILES,' files found '
- IF(ICONT.NE.0) THEN
- PRINT *,'MGET. too many files found. Excess names will be ',
- + 'discarded'
-#include "cspack/czflush.inc"
- ENDIF
- DO 20 I = 1,NFILES
- ISTART = 1
- IEND = LENOCC(FILES(I))
-*
-* Fix VM file names...
-*
- CALL CSQMBL(FILES(I),ISTART,IEND)
- IEND = LENOCC(FILES(I))
- CALL CTRANS(' ','.',FILES(I),ISTART,IEND)
-*
-* Fix VMS file names...
-*
- IBRA = ICFMUL(']>',FILES(I),1,IEND)
- IF(IBRA.LE.IEND) ISTART = IBRA + 1
- FNAME1 = FILES(I)(ISTART:IEND)
- LF1 = LENOCC(FNAME1)
- ICOL = INDEX(FNAME1(1:LF1),';')
- IF(ICOL.NE.0) LF1 = ICOL - 1
- IF(IDEBXZ.GE.1) PRINT *,'MGET. processing ',FNAME1(1:LF1),
- + '...'
- CALL CLTOU(FNAME1)
- IDOT = INDEX(FNAME1(1:LF1),'.')
- IF((IDOT.NE.0).AND.(JDOT.NE.0)) THEN
- IF(LOCAL(1:NCHL).NE.REMOTE(1:NCHR)) THEN
- FNAME2 = FNAME1(1:IDOT)//LOCAL(JDOT+1:NCHL)
- LF2 = LENOCC(FNAME2)
- ELSE
- FNAME2 = FNAME1
- LF2 = LF1
- ENDIF
- ENDIF
-
- IF(LENOCC(FNAME2).EQ.0) THEN
- FNAME2 = FNAME1
- LF2 = LF1
- ENDIF
-
-#if !defined(CERNLIB_IBMVM)
-*
-* Remove file mode from VM file names...
-*
- KDOT = INDEX(FNAME1(1:LF1),'.')
- LDOT = INDEXB(FNAME1(1:LF1),'.')
- IF(LDOT.GT.KDOT) THEN
- LF1 = LDOT - 1
- ENDIF
-#endif
-
- IF(INDEX(FNAME1(1:LF1),'.PAM').NE.0) THEN
- IF(IDEBXZ.GE.2) PRINT *,'MGET. retrieving ',FNAME2(1:LF2),
- + ' to ',FNAME1(1:LF1),' via GETP'
- CALL XZGETP(FNAME1(1:LF1),FNAME2(1:LF2),CHOPT,IC)
- ELSEIF(INDEX(FNAME1(1:LF1),'.CET').NE.0) THEN
- IF(IDEBXZ.GE.2) PRINT *,'MGET. retrieving ',FNAME2(1:LF2),
- + ' to ',FNAME1(1:LF1),' via GETB'
- CALL XZGETB(FNAME1(1:LF1),FNAME2(1:LF2),3600,CHOPT,IC)
- ELSEIF(INDEX(FNAME1(1:LF1),'.CMZ').NE.0) THEN
- IF(IDEBXZ.GE.2) PRINT *,'MGET. retrieving ',FNAME2(1:LF2),
- + ' to ',FNAME1(1:LF1),' via GETRZ'
- CALL XZGETR(FNAME1(1:LF1),FNAME2(1:LF2),CHOPT,IC)
- ELSE
- IF(IDEBXZ.GE.2) PRINT *,'MGET. retrieving ',FNAME2(1:LF2),
- + ' to ',FNAME1(1:LF1),' via GETA'
- CALL XZGETA(FNAME1(1:LF1),FNAME2(1:LF2),CHOPT,IC)
- ENDIF
- 20 CONTINUE
-
- 99 END
diff --git a/src/packlib/cspack/programs/zftp/mput.F b/src/packlib/cspack/programs/zftp/mput.F
deleted file mode 100644
index 8f60a71..0000000
--- a/src/packlib/cspack/programs/zftp/mput.F
+++ /dev/null
@@ -1,117 +0,0 @@
-*
-* $Id: mput.F,v 1.1.1.1 1996/03/08 15:44:19 mclareni Exp $
-*
-* $Log: mput.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:19 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE MPUT
-*-- Author :
-*CMZ : 12/02/91 13.50.05 by Jamie Shiers
-*-- Author : Jamie Shiers 12/02/91
- CHARACTER*64 LOCAL,REMOTE,FNAME1,FNAME2
- CHARACTER*8 LOCTYP,REMTYP
- CHARACTER*4 CHOPT
- PARAMETER (NMAX=100)
- CHARACTER*128 FILES(NMAX)
-#include "cspack/quest.inc"
-#include "cspack/hcmail.inc"
-#include "cspack/czsock.inc"
-#include "cspack/czunit.inc"
-#include "cspack/czopen.inc"
-*
-* Put multiple files to remote node, with optional
-* change of extension name (e.g. .CAR -> .CARDS)
-*
- CALL KUGETC(LOCAL,NCHL)
- CALL KUGETC(REMOTE,NCHR)
- CALL KUGETC(CHOPT,NCH)
-
- IF(NCHR.EQ.0) THEN
- REMOTE = LOCAL
- NCHR = NCHL
- ENDIF
-
- IF((NCHR.EQ.1).AND.(REMOTE(1:1).EQ.'=')) THEN
- REMOTE = LOCAL
- NCHR = NCHL
- ENDIF
-*
-* Get list of file names
-*
-
- ICONT = 0
- JDOT = INDEX(REMOTE(1:NCHR),'.')
-
- 1 CONTINUE
- CALL XZLLS(LOCAL(1:NCHL),FILES,NMAX,NFILES,ICONT,' ',IC)
- DO 20 I = 1,NFILES
- ISTART = 1
- IEND = LENOCC(FILES(I))
-*
-* Fix VM file names...
-*
- CALL CSQMBL(FILES(I),ISTART,IEND)
- IEND = LENOCC(FILES(I))
- CALL CTRANS(' ','.',FILES(I),ISTART,IEND)
-*
-* Fix VMS file names...
-*
- IBRA = ICFMUL('>]',FILES(I),1,IEND)
- IF(IBRA.LE.IEND) ISTART = IBRA + 1
- FNAME1 = FILES(I)(ISTART:IEND)
- LF1 = LENOCC(FNAME1)
- ICOL = INDEX(FNAME1(1:LF1),';')
- IF(ICOL.NE.0) LF1 = ICOL - 1
- IF(IDEBXZ.GE.1) PRINT *,'MPUT. processing ',FNAME1(1:LF1),
- + '...'
- CALL CLTOU(FNAME1)
- IDOT = INDEX(FNAME1(1:LF1),'.')
- IF((IDOT.NE.0).AND.(JDOT.NE.0)) THEN
- IF(LOCAL(1:NCHL).NE.REMOTE(1:NCHR)) THEN
- FNAME2 = FNAME1(1:IDOT)//REMOTE(JDOT+1:NCHR)
- LF2 = LENOCC(FNAME2)
- ELSE
- FNAME2 = FNAME1
- LF2 = LF1
- ENDIF
- ENDIF
-
- IF(LENOCC(FNAME2).EQ.0) THEN
- FNAME2 = FNAME1
- LF2 = LF1
- ENDIF
-*
-* Remove file mode from VM file names...
-*
- KDOT = INDEX(FNAME2(1:LF2),'.')
- LDOT = INDEXB(FNAME2(1:LF2),'.')
- IF(LDOT.GT.KDOT) THEN
- LF2 = LDOT - 1
- IF(IDEBXZ.GE.3) PRINT *,'MPUT. removing file mode from ',
- + 'VM file name.'
- ENDIF
-
- IF(INDEX(FNAME1(1:LF1),'.PAM').NE.0) THEN
- IF(IDEBXZ.GE.2) PRINT *,'MPUT. sending ',FNAME1(1:LF1),
- + ' to ',FNAME2(1:LF2),' via PUTP'
- CALL XZPUTP(FNAME1(1:LF1),FNAME2(1:LF2),CHOPT,IC)
- ELSEIF(INDEX(FNAME1(1:LF1),'.CET').NE.0) THEN
- IF(IDEBXZ.GE.2) PRINT *,'MPUT. sending ',FNAME1(1:LF1),
- + ' to ',FNAME2(1:LF2),' via PUTB'
- CALL XZPUTB(FNAME1(1:LF1),FNAME2(1:LF2),3600,CHOPT,IC)
- ELSEIF(INDEX(FNAME1(1:LF1),'.CMZ').NE.0) THEN
- IF(IDEBXZ.GE.2) PRINT *,'MPUT. sending ',FNAME1(1:LF1),
- + ' to ',FNAME2(1:LF2),' via PUTRZ'
- CALL XZPUTR(FNAME1(1:LF1),FNAME2(1:LF2),CHOPT,IC)
- ELSE
- IF(IDEBXZ.GE.2) PRINT *,'MPUT. sending ',FNAME1(1:LF1),
- + ' to ',FNAME2(1:LF2),' via PUTA'
- CALL XZPUTA(FNAME1(1:LF1),FNAME2(1:LF2),CHOPT,IC)
- ENDIF
- 20 CONTINUE
- IF(ICONT.NE.0) GOTO 1
-
- 99 END
diff --git a/src/packlib/cspack/programs/zftp/puta.F b/src/packlib/cspack/programs/zftp/puta.F
deleted file mode 100644
index 7f534ae..0000000
--- a/src/packlib/cspack/programs/zftp/puta.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: puta.F,v 1.1.1.1 1996/03/08 15:44:19 mclareni Exp $
-*
-* $Log: puta.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:19 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE PUTA
-*
-* Action routine for PUTA command
-*
-#include "cspack/czsock.inc"
- CHARACTER*80 REMOTE,LOCAL
- CHARACTER*8 CHOPT
-*
-#include "cspack/czopen.inc"
- CALL KUGETS(LOCAL,NCHL)
- CALL KUGETS(REMOTE,NCHR)
- IF(NCHR.LE.0)REMOTE=LOCAL
- IF(REMOTE(1:NCHR).EQ.'=') REMOTE=LOCAL
- NCHR = LENOCC(REMOTE)
- CALL KUGETC(CHOPT,NCH)
-#include "cspack/czfold.inc"
- CALL XZPUTA(LOCAL,REMOTE,CHOPT,IRC)
-99 END
-
diff --git a/src/packlib/cspack/programs/zftp/putb.F b/src/packlib/cspack/programs/zftp/putb.F
deleted file mode 100644
index 11f5572..0000000
--- a/src/packlib/cspack/programs/zftp/putb.F
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: putb.F,v 1.1.1.1 1996/03/08 15:44:19 mclareni Exp $
-*
-* $Log: putb.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:19 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE PUTB
-*
-* Action routine for PUTB command
-*
-#include "cspack/czsock.inc"
- CHARACTER*80 REMOTE,LOCAL
- CHARACTER*8 CHOPT
-*
-#include "cspack/czopen.inc"
- CALL KUGETS(LOCAL,NCHL)
- CALL KUGETS(REMOTE,NCHR)
- IF(NCHR.LE.0)REMOTE=LOCAL
- IF(REMOTE(1:NCHR).EQ.'=') REMOTE=LOCAL
- NCHR = LENOCC(REMOTE)
- CALL KUGETI(LRECL)
- CALL KUGETC(CHOPT,NCH)
-#include "cspack/czfold.inc"
- CALL XZPUTB(LOCAL,REMOTE,LRECL,CHOPT,IRC)
-99 END
-
diff --git a/src/packlib/cspack/programs/zftp/putd.F b/src/packlib/cspack/programs/zftp/putd.F
deleted file mode 100644
index 2dfd00d..0000000
--- a/src/packlib/cspack/programs/zftp/putd.F
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: putd.F,v 1.1.1.1 1996/03/08 15:44:19 mclareni Exp $
-*
-* $Log: putd.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:19 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE PUTD
-*
-* Action routine for PUTD command
-*
-#include "cspack/czsock.inc"
- CHARACTER*80 REMOTE,LOCAL
- CHARACTER*8 CHOPT
-*
-#include "cspack/czopen.inc"
- CALL KUGETS(LOCAL,NCHL)
- CALL KUGETS(REMOTE,NCHR)
- IF(NCHR.LE.0)REMOTE=LOCAL
- IF(REMOTE(1:NCHR).EQ.'=') REMOTE=LOCAL
- NCHR = LENOCC(REMOTE)
- CALL KUGETI(LRECL)
- CALL KUGETC(CHOPT,NCH)
-#include "cspack/czfold.inc"
- CALL XZPUTD(LOCAL,REMOTE,LRECL,CHOPT,IRC)
-99 END
-
diff --git a/src/packlib/cspack/programs/zftp/putfz.F b/src/packlib/cspack/programs/zftp/putfz.F
deleted file mode 100644
index 4f0f1e8..0000000
--- a/src/packlib/cspack/programs/zftp/putfz.F
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: putfz.F,v 1.1.1.1 1996/03/08 15:44:19 mclareni Exp $
-*
-* $Log: putfz.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:19 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE PUTFZ
-*
-* Action routine for PUTFZ command
-*
-#include "cspack/czsock.inc"
- CHARACTER*64 LOCAL,REMOTE
- CHARACTER*4 CHOPT,LFORM,RFORM
- INTEGER RRECL
-#include "cspack/czopen.inc"
- CALL KUGETS(LOCAL,NCHL)
- CALL KUGETS(REMOTE,NCHR)
- IF(NCHR.LE.0)REMOTE=LOCAL
- IF(REMOTE(1:NCHR).EQ.'=') REMOTE=LOCAL
- NCHR = LENOCC(REMOTE)
- CALL KUGETI(LRECL)
- CALL KUGETC(LFORM,NLF)
- CALL KUGETI(RRECL)
- CALL KUGETC(RFORM,NRF)
- CALL KUGETC(CHOPT,NCH)
-#include "cspack/czfold.inc"
- CALL XZPUTF(LOCAL,REMOTE,LRECL,LFORM,RRECL,RFORM,CHOPT,IRC)
-99 END
-
diff --git a/src/packlib/cspack/programs/zftp/putp.F b/src/packlib/cspack/programs/zftp/putp.F
deleted file mode 100644
index 1a5b961..0000000
--- a/src/packlib/cspack/programs/zftp/putp.F
+++ /dev/null
@@ -1,38 +0,0 @@
-*
-* $Id: putp.F,v 1.1.1.1 1996/03/08 15:44:19 mclareni Exp $
-*
-* $Log: putp.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:19 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE PUTP
-*
-* Action routine for PUTP command
-*
-#include "cspack/czsock.inc"
- CHARACTER*80 REMOTE,LOCAL
- CHARACTER*4 CHOPT
-*
-#include "cspack/czopen.inc"
- CALL KUGETS(LOCAL,NCHL)
- CALL KUGETS(REMOTE,NCHR)
- IF(NCHR.LE.0)REMOTE=LOCAL
- IF(REMOTE(1:NCHR).EQ.'=') REMOTE=LOCAL
- NCHR = LENOCC(REMOTE)
- CALL KUGETC(CHOPT,NCH)
-#include "cspack/czfold.inc"
-#if defined(CERNLIB_CRAY)
- PRINT *,'PUTP is not yet available for the Cray...'
- PRINT *,'You may transfer PAM files '
- PRINT *,' in CARD format using GET/PUTA'
- PRINT *,' in CETA format using GET/PUTB'
- PRINT *,' in CMZ format using GET/PUTRZ'
- RETURN
-#endif
-#if !defined(CERNLIB_CRAY)
- CALL XZPUTP(LOCAL,REMOTE,CHOPT,IRC)
-#endif
-99 END
-
diff --git a/src/packlib/cspack/programs/zftp/putrz.F b/src/packlib/cspack/programs/zftp/putrz.F
deleted file mode 100644
index fd4f237..0000000
--- a/src/packlib/cspack/programs/zftp/putrz.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: putrz.F,v 1.1.1.1 1996/03/08 15:44:19 mclareni Exp $
-*
-* $Log: putrz.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:19 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE PUTRZ
-*
-* Action routine for PUTRZ command
-*
-#include "cspack/czsock.inc"
- CHARACTER*80 REMOTE,LOCAL
- CHARACTER*8 CHOPT
-*
-#include "cspack/czopen.inc"
- CALL KUGETS(LOCAL,NCHL)
- CALL KUGETS(REMOTE,NCHR)
- IF(NCHR.LE.0)REMOTE=LOCAL
- IF(REMOTE(1:NCHR).EQ.'=') REMOTE=LOCAL
- NCHR = LENOCC(REMOTE)
- CALL KUGETC(CHOPT,NCH)
-#include "cspack/czfold.inc"
- CALL XZPUTR(LOCAL,REMOTE,CHOPT,IRC)
-99 END
-
diff --git a/src/packlib/cspack/programs/zftp/putx.F b/src/packlib/cspack/programs/zftp/putx.F
deleted file mode 100644
index 299c014..0000000
--- a/src/packlib/cspack/programs/zftp/putx.F
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: putx.F,v 1.1.1.1 1996/03/08 15:44:20 mclareni Exp $
-*
-* $Log: putx.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:20 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE PUTX
-*
-* Action routine for PUTX command
-*
-#include "cspack/czsock.inc"
- CHARACTER*80 REMOTE,LOCAL
- CHARACTER*8 CHOPT
-*
-#include "cspack/czopen.inc"
- CALL KUGETS(LOCAL,NCHL)
- CALL KUGETS(REMOTE,NCHR)
- IF(NCHR.LE.0)REMOTE=LOCAL
- IF(REMOTE(1:NCHR).EQ.'=') REMOTE=LOCAL
- NCHR = LENOCC(REMOTE)
- CALL KUGETI(LRECL)
- CALL KUGETC(CHOPT,NCH)
-#include "cspack/czfold.inc"
- CALL XZPUTX(LOCAL,REMOTE,LRECL,CHOPT,IRC)
-99 END
-
diff --git a/src/packlib/cspack/programs/zftp/rclose.F b/src/packlib/cspack/programs/zftp/rclose.F
deleted file mode 100644
index 21fd17f..0000000
--- a/src/packlib/cspack/programs/zftp/rclose.F
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: rclose.F,v 1.1.1.1 1996/03/08 15:44:19 mclareni Exp $
-*
-* $Log: rclose.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:19 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE RCLOSE
-*
-* To stop a communication with a remote computer
-*
-#include "cspack/czsock.inc"
-*
-*=========================================================
- IF(ISKIN.GE.0)THEN
- CALL CZCLOS(ISTAT)
- ISKIN=-1
- ENDIF
-*
- 99 END
-
diff --git a/src/packlib/cspack/programs/zftp/rlogin.F b/src/packlib/cspack/programs/zftp/rlogin.F
deleted file mode 100644
index ee4882c..0000000
--- a/src/packlib/cspack/programs/zftp/rlogin.F
+++ /dev/null
@@ -1,71 +0,0 @@
-*
-* $Id: rlogin.F,v 1.1.1.1 1996/03/08 15:44:19 mclareni Exp $
-*
-* $Log: rlogin.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:19 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE RLOGIN
-*
-* To start a communication with a remote computer
-* Current implementation based on TCP/IP
-*
-#include "cspack/czsock.inc"
- CHARACTER*255 HOST,HNAME
-* CHARACTER*32 HOST,HNAME
- CHARACTER*4 CHOPT
- SAVE HNAME
- DATA HNAME/' '/
-*
-*=========================================================
-*
- CALL KUGETC(HOST,NCH)
- IF(NCH.LE.0)GO TO 99
- CALL CUTOL(HOST)
- CALL KUGETC(CHOPT,LCHOPT)
-
- IF(LCHOPT.EQ.0) THEN
- LCHOPT = 1
- CHOPT = ' '
- ENDIF
-
- IF(HOST.EQ.HNAME.AND.ISKIN.GE.0)THEN
- PRINT *,' Communication already established'
- GO TO 99
- ENDIF
-*
- IF(ISKIN.GE.0)THEN
- CALL CZCLOS(ISTAT)
- HNAME=' '
- ENDIF
-
-
- IPROT = 0
-#if defined(CERNLIB_VAXVMS)
- IF(INDEX(CHOPT(1:LCHOPT),'D').NE.0) IPROT = 1
-#endif
-
- IF((INDEX(CHOPT(1:LCHOPT),'V').NE.0).AND.
- + (INDEX(HOST(1:NCH),'(vm').EQ.0)) THEN
- CALL CZOPEN('zserv',HOST(1:NCH)//'(vm',ISTAT)
- ELSEIF((INDEX(CHOPT(1:LCHOPT),'M').NE.0).AND.
- + (INDEX(HOST(1:NCH),'(mvs').EQ.0)) THEN
- CALL CZOPEN('zserv',HOST(1:NCH)//'(mvs',ISTAT)
- ELSE
- CALL CZOPEN('zserv',HOST,ISTAT)
- ENDIF
-*
- IF(ISTAT.NE.0)THEN
- PRINT *,' Cannot open communication with ',HOST
-#if defined(CERNLIB_BATCH)
- CALL CZSTOP(ISTAT)
-#endif
- GO TO 99
- ENDIF
- HNAME=HOST
- CUNODE = HOST(1:LENOCC(HOST))
-*
- 99 END
-
diff --git a/src/packlib/cspack/programs/zftp/rshell.F b/src/packlib/cspack/programs/zftp/rshell.F
deleted file mode 100644
index b9ecf7d..0000000
--- a/src/packlib/cspack/programs/zftp/rshell.F
+++ /dev/null
@@ -1,58 +0,0 @@
-*
-* $Id: rshell.F,v 1.1.1.1 1996/03/08 15:44:19 mclareni Exp $
-*
-* $Log: rshell.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:19 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE RSHELL
-*
-* To send a message to a remote machine
-* Method:
-* The message is sent
-* The ackowledgement is received in CHMESS
-* If CHMESS(1:1)='0' Return
-* If CHMESS(1:1)='1' Print CHMESS and Return
-* If CHMESS(1:1)='2' Print CHMESS and read next CHMESS
-* If CHMESS(1:1)='9' Close connection with remote machine
-*
-#include "cspack/czsock.inc"
- CHARACTER*80 CHMESS
- DIMENSION IHMESS(22),ICONTR(2)
-
-*
-#include "cspack/czopen.inc"
- CALL KUGETE(CHMESS,NCH)
- IF(NCH.LE.0)RETURN
-*
- CALL JUMPST(IADTCP)
- ICONTR(1)=3
- ICONTR(2)=20
- CALL VBLANK(IHMESS,22)
- CALL UCTOH('MESS :'//CHMESS,IHMESS,4,NCH+6)
- CALL JUMPX2(IHMESS,ICONTR)
- IF(ICONTR(1).NE.0)GO TO 99
-*
- 10 ICONTR(1)=2
- ICONTR(2)=20
- CALL VBLANK(IHMESS,22)
- CALL JUMPX2(IHMESS,ICONTR)
- IF(ICONTR(1).NE.0)GO TO 99
- CALL UHTOC(IHMESS,4,CHMESS,80)
- IF(CHMESS(1:1).EQ.'0')GO TO 99
- IF(CHMESS(1:1).EQ.'9')THEN
- CALL CZCLOS(ISKIN)
- PRINT *,' Communication closed'
- ISKIN=-1
- GO TO 99
- ENDIF
- NCH=LENOCC(CHMESS)
- IF(NCH.GT.1)THEN
- PRINT *,CHMESS(2:NCH)
- ENDIF
- IF(CHMESS(1:1).EQ.'2')GO TO 10
-*
- 99 END
-
diff --git a/src/packlib/cspack/programs/zftp/zabend.F b/src/packlib/cspack/programs/zftp/zabend.F
deleted file mode 100644
index 12d2f33..0000000
--- a/src/packlib/cspack/programs/zftp/zabend.F
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: zabend.F,v 1.1.1.1 1996/03/08 15:44:18 mclareni Exp $
-*
-* $Log: zabend.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:18 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE ZABEND
-#include "cspack/zstate.inc"
- PRINT *,'ZABEND routine for ZFTP reached - ZPOSTM cancelled'
- IF(NQPHAS.LE.0) CALL ABEND
- NQPHAS = - 2
- CALL ZEND
- END
-
diff --git a/src/packlib/cspack/programs/zftp/zexit.F b/src/packlib/cspack/programs/zftp/zexit.F
deleted file mode 100644
index 71eb498..0000000
--- a/src/packlib/cspack/programs/zftp/zexit.F
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: zexit.F,v 1.1.1.1 1996/03/08 15:44:18 mclareni Exp $
-*
-* $Log: zexit.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:18 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE ZEXIT
-*
-* Called by KUIP/EXIT to close connections and files.
-*
-#include "cspack/czsock.inc"
- SAVE IFIRST
- DATA IFIRST/0/
-*________________________________________________________
-*
-*
- IF(IFIRST.EQ.0)THEN
-*
-* Close remote connection
-*
- IF(ISKIN.GE.0)CALL CZCLOS(ISTAT)
- IFIRST=1
- ENDIF
-*
- END
-
diff --git a/src/packlib/cspack/programs/zftp/zfctof.F b/src/packlib/cspack/programs/zftp/zfctof.F
deleted file mode 100644
index b5b00ee..0000000
--- a/src/packlib/cspack/programs/zftp/zfctof.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: zfctof.F,v 1.1.1.1 1996/03/08 15:44:20 mclareni Exp $
-*
-* $Log: zfctof.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:20 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE ZFCTOF
-*
-* Action routine for CTOF command
-*
-#include "cspack/czsock.inc"
- CHARACTER*64 LOCAL,REMOTE
- CHARACTER*4 CHOPT
- INTEGER RRECL
-
- CALL KUGETS(LOCAL,NCHL)
- CALL KUGETS(REMOTE,NCHR)
- CALL KUGETI(LRECL)
- CALL KUGETC(CHOPT,NCH)
-#include "cspack/czfold.inc"
- CALL XZCTOF(LOCAL,REMOTE,LRECL,CHOPT,IRC)
-99 END
-
diff --git a/src/packlib/cspack/programs/zftp/zfftoc.F b/src/packlib/cspack/programs/zftp/zfftoc.F
deleted file mode 100644
index e347212..0000000
--- a/src/packlib/cspack/programs/zftp/zfftoc.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: zfftoc.F,v 1.1.1.1 1996/03/08 15:44:20 mclareni Exp $
-*
-* $Log: zfftoc.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:20 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE ZFFTOC
-*
-* Action routine for FTOC command
-*
-#include "cspack/czsock.inc"
- CHARACTER*64 LOCAL,REMOTE
- CHARACTER*4 CHOPT
- INTEGER RRECL
-
- CALL KUGETS(LOCAL,NCHL)
- CALL KUGETS(REMOTE,NCHR)
- CALL KUGETI(LRECL)
- CALL KUGETC(CHOPT,NCH)
-#include "cspack/czfold.inc"
- CALL XZFTOC(LOCAL,REMOTE,LRECL,CHOPT,IRC)
-99 END
-
diff --git a/src/packlib/cspack/programs/zftp/zffzcp.F b/src/packlib/cspack/programs/zftp/zffzcp.F
deleted file mode 100644
index 8ba97b5..0000000
--- a/src/packlib/cspack/programs/zftp/zffzcp.F
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: zffzcp.F,v 1.1.1.1 1996/03/08 15:44:20 mclareni Exp $
-*
-* $Log: zffzcp.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:20 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE ZFFZCP
-*
-* Action routine for FZCOPY command
-*
-#include "cspack/czsock.inc"
- CHARACTER*64 LOCAL,REMOTE
- CHARACTER*4 CHOPT,LFORM,RFORM
- INTEGER IRECL,RRECL
-
- CALL KUGETS(LOCAL,NCHL)
- CALL KUGETS(REMOTE,NCHR)
- CALL KUGETC(LFORM,NLF)
- CALL KUGETI(LRECL)
- CALL KUGETC(RFORM,NRF)
- CALL KUGETI(RRECL)
- CALL KUGETC(CHOPT,NCH)
-#include "cspack/czfold.inc"
- CALL XZFZCP(LOCAL,REMOTE,LRECL,LFORM,RRECL,RFORM,CHOPT,IRC)
-99 END
-
diff --git a/src/packlib/cspack/programs/zftp/zflogc.F b/src/packlib/cspack/programs/zftp/zflogc.F
deleted file mode 100644
index c482f65..0000000
--- a/src/packlib/cspack/programs/zftp/zflogc.F
+++ /dev/null
@@ -1,13 +0,0 @@
-*
-* $Id: zflogc.F,v 1.1.1.1 1996/03/08 15:44:19 mclareni Exp $
-*
-* $Log: zflogc.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:19 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE ZFLOGC
- CALL KUGETI(LOGL)
- CALL XZLOGL(LOGL)
- END
diff --git a/src/packlib/cspack/programs/zftp/zfrfrf.F b/src/packlib/cspack/programs/zftp/zfrfrf.F
deleted file mode 100644
index bb4ad59..0000000
--- a/src/packlib/cspack/programs/zftp/zfrfrf.F
+++ /dev/null
@@ -1,37 +0,0 @@
-*
-* $Id: zfrfrf.F,v 1.1.1.1 1996/03/08 15:44:20 mclareni Exp $
-*
-* $Log: zfrfrf.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:20 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE ZFRFRF
-*
-* Action routine for RFRF command
-*
-#include "cspack/czsock.inc"
-#include "cspack/quest.inc"
- CHARACTER*64 LOCAL,REMOTE
- CHARACTER*4 CHOPT
-
- CALL KUGETS(LOCAL,NCHL)
- CALL KUGETS(REMOTE,NCHR)
- CALL KUGETI(LRECL)
- CALL KUGETI(NQUOTA)
- CALL KUGETC(CHOPT,NCH)
-#include "cspack/czfold.inc"
-
- IF(NQUOTA.NE.0) THEN
- CHOPT(NCH+1:NCH+1) = 'Q'
- IQUEST(10) = NQUOTA
- ELSE
- IQUEST(10) = 0
- ENDIF
-
- CALL XZRFRF(LOCAL,REMOTE,LRECL,CHOPT,IRC)
- IF(IRC.NE.0) PRINT 9001,IRC
-9001 FORMAT(' Return code ',I10,' from XZRFRF')
-99 END
-
diff --git a/src/packlib/cspack/programs/zftp/zfrtof.F b/src/packlib/cspack/programs/zftp/zfrtof.F
deleted file mode 100644
index 5abd4b9..0000000
--- a/src/packlib/cspack/programs/zftp/zfrtof.F
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: zfrtof.F,v 1.1.1.1 1996/03/08 15:44:20 mclareni Exp $
-*
-* $Log: zfrtof.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:20 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE ZFRTOF
-*
-* Action routine for RTOF command
-*
-#include "cspack/czsock.inc"
- CHARACTER*64 LOCAL,REMOTE
- CHARACTER*4 CHOPT
-
- CALL KUGETS(LOCAL,NCHL)
- CALL KUGETS(REMOTE,NCHR)
- CALL KUGETI(LRECL)
- CALL KUGETC(CHOPT,NCH)
-#include "cspack/czfold.inc"
- CALL XZRTOF(LOCAL,REMOTE,LRECL,CHOPT,IRC)
-99 END
-
diff --git a/src/packlib/cspack/programs/zftp/zfrzcp.F b/src/packlib/cspack/programs/zftp/zfrzcp.F
deleted file mode 100644
index ae82fce..0000000
--- a/src/packlib/cspack/programs/zftp/zfrzcp.F
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: zfrzcp.F,v 1.1.1.1 1996/03/08 15:44:20 mclareni Exp $
-*
-* $Log: zfrzcp.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:20 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE ZFRZCP
-*
-* Action routine for RZCOPY command
-*
-#include "cspack/slate.inc"
-#include "cspack/czsock.inc"
- CHARACTER*64 LOCAL,REMOTE
- CHARACTER*4 CHOPT
-
- CALL KUGETS(LOCAL,NCHL)
- CALL KUGETS(REMOTE,NCHR)
- CALL KUGETI(LRECL)
- CALL KUGETI(NRECS)
- CALL KUGETC(CHOPT,NCH)
-#include "cspack/czfold.inc"
-*
-* Pass quota for new file in SLATE (sorry)
-*
- IS(1) = NRECS
- CALL XZRZCP(LOCAL,REMOTE,LRECL,CHOPT,IRC)
-99 END
-
diff --git a/src/packlib/cspack/programs/zftp/zftlcd.F b/src/packlib/cspack/programs/zftp/zftlcd.F
deleted file mode 100644
index fdb2fd6..0000000
--- a/src/packlib/cspack/programs/zftp/zftlcd.F
+++ /dev/null
@@ -1,142 +0,0 @@
-*
-* $Id: zftlcd.F,v 1.1.1.1 1996/03/08 15:44:20 mclareni Exp $
-*
-* $Log: zftlcd.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:20 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE ZFTLCD
- CHARACTER*80 PATH,CHPATH
- CHARACTER*20 CHOPT
- CHARACTER*80 CHPASS
-#if defined(CERNLIB_IBMVM)
- DATA NENTRY/0/
- CHARACTER*80 LINE,CHGIME
- CHARACTER*8 CHUSER
- INTEGER FMUSER
- CALL KUGETS(PATH,LPATH)
- IF(LPATH.EQ.0) GOTO 10
-*
-* For remote connections to VM systems, cater for write links
-*
- CALL KUGETC(CHPASS,LPASS)
- CALL KUGETC(CHOPT,LCHOPT)
-
- IF(LCHOPT.EQ.0) THEN
- CHOPT = ' '
- LCHOPT = 1
- ENDIF
-
- IOPTR = INDEX(CHOPT(1:LCHOPT),'R')
- IOPTW = INDEX(CHOPT(1:LCHOPT),'W')
-
- IF((IOPTR.NE.0).AND.(IOPTW.NE.0)) THEN
- PRINT *,'ZFTLCD. only one of R(ead) and W(rite)',
- + 'maybe specified'
- RETURN
- ENDIF
-
- IF((IOPTR+IOPTW.NE.0).AND.(LPASS.EQ.0)) THEN
- PRINT *,'ZFTLCD. password must be given with ',
- + 'R or W options'
- RETURN
- ENDIF
-
- NENTRY = 1
- IDOT = INDEX(PATH(1:LPATH),'.')
- IF(IDOT.NE.0) PATH(IDOT:IDOT) = ' '
-
- IF(IOPTW.NE.0) THEN
- CHGIME = ' * '//CHPASS(1:LPASS)//' (MR STACK'
- ELSEIF(IOPTR.NE.0) THEN
- CHGIME = ' * '//CHPASS(1:LPASS)//' (RR STACK'
- ELSE
- CHGIME = ' (STACK'
- ENDIF
-
- CALL VMCMS('EXEC GIME '//PATH(1:LPATH)//
- + CHGIME,IRC)
-*
-* Return code 4 is only a warning - existing link exists
-*
- IF(IRC.GT.4) THEN
- RETURN
- ELSE
- CALL VMRTRM(LINE,IRC)
- CALL VMCMS('EXEC SWAPMODE A '//LINE(1:1),IRC)
- PRINT *,'Local directory changed to ',PATH(1:LPATH)
- CHPATH = PATH
- ENDIF
- RETURN
-
-#endif
-#if defined(CERNLIB_VAXVMS)||defined(CERNLIB_UNIX)
- INTEGER SETDEF
- INTEGER CHDIR
- INTEGER CHDIRF
- COMMON/SLATE/IS(40)
- CALL KUGETS(PATH,LPATH)
- IF(LPATH.EQ.0) GOTO 10
- CALL KUGETC(CHPASS,LPASS)
- CALL KUGETC(CHOPT,LCHOPT)
-
- IF(LCHOPT.EQ.0) THEN
- CHOPT = ' '
- LCHOPT = 1
- ENDIF
-
-#endif
-#if defined(CERNLIB_UNIX)
- IF(INDEX(CHOPT,'C').EQ.0) CALL CUTOL(PATH)
-#endif
-#if defined(CERNLIB_MIPS)
- LPATH = LPATH + 1
- PATH(LPATH:LPATH) = CHAR(0)
-#endif
-#if defined(CERNLIB_UNIX)
- IRC = CHDIRF(PATH(1:LPATH))
-#endif
-#if defined(CERNLIB_VAXVMS)
- IRC = SETDEF(PATH(1:LPATH))
-#endif
-#if defined(CERNLIB_VAXVMS)||defined(CERNLIB_UNIX)
- IF(IRC.EQ.0) THEN
- PRINT *,'Local directory changed to ',PATH(1:LPATH)
- ELSE
- PRINT *,'Error setting local directory'
- ENDIF
- RETURN
-#endif
-#if defined(CERNLIB_IBMMVS)
- IF(NENTRY.EQ.0) THEN
- CHPATH = ' '
- ENDIF
- CALL XZRPRE(CHPATH,LPATH)
-#endif
-10 CONTINUE
-#if defined(CERNLIB_IBM)
- IF(NENTRY.EQ.0) THEN
- CALL CFILL(' ',CHPATH,1,80)
- ISTAT = FMUSER(CHPATH)
- LPATH = LENOCC(CHPATH)
- CHPATH(LPATH+2:LPATH+4) = '191'
- LPATH = LPATH + 4
- ENDIF
- PATH = CHPATH
- LPATH = LENOCC(PATH)
-#endif
-#if defined(CERNLIB_UNIX)
- CALL GETWDF(PATH)
- LPATH = IS(1)
-#endif
-#if defined(CERNLIB_VAXVMS)
- PATH = ' '
- CALL GETDEF(PATH)
- LPATH = LENOCC(PATH)
-#endif
- PRINT *,'Local directory is ',PATH(1:LPATH)
-*
- 99 END
-
diff --git a/src/packlib/cspack/programs/zftp/zftlls.F b/src/packlib/cspack/programs/zftp/zftlls.F
deleted file mode 100644
index 2383077..0000000
--- a/src/packlib/cspack/programs/zftp/zftlls.F
+++ /dev/null
@@ -1,133 +0,0 @@
-*
-* $Id: zftlls.F,v 1.1.1.1 1996/03/08 15:44:20 mclareni Exp $
-*
-* $Log: zftlls.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:20 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE ZFTLLS
-#if defined(CERNLIB_VAXVMS)
-#include "cspack/vmsinf.inc"
- EXTERNAL XZFINF
- INCLUDE '($RMSDEF)'
- INTEGER SYS$GETMSG
- CHARACTER*255 CHDIR,CHDEF
- CHARACTER*10 CBLOCKS
-#endif
- CHARACTER*255 CHFILE
- CHARACTER*80 COMM
- CHARACTER*80 PATH
- CHARACTER*4 CHOPT,CHOPTT
-*
- CALL KUGETS(PATH,LPATH)
- CALL KUGETC(CHOPT,NCH)
-
- IF(NCH.EQ.0) THEN
- CHOPT = ' '
- NCH = 1
- ENDIF
-
- IF(INDEX(CHOPT,'C').EQ.0) CALL CLTOU(PATH)
-
- NFOUND = 0
- ICONT = 0
- IOPTL = 0
- CHOPTT = ' '
- COMM = ' '
- IF(INDEX(CHOPT,'L').NE.0) THEN
- CHOPTT = '-l'
- IOPTL = 1
- ENDIF
-#if defined(CERNLIB_UNIX)
-
- IF(LPATH.EQ.0) THEN
- PATH = ' '
- LPATH = 1
- ENDIF
-
- IF(INDEX(CHOPT,'C').EQ.0) CALL CUTOL(PATH)
-
- WRITE(COMM,9001) CHOPTT,PATH(1:LPATH)
- 9001 FORMAT('ls ',A,' ',A)
- IC = SYSTEMF(COMM)
-#endif
-#if defined(CERNLIB_VAXVMS)
- IF(LPATH.EQ.0) THEN
- LPATH = 3
- PATH = '*.*'
- ENDIF
-10 CONTINUE
- CHFILE = ' '
- CHDEF = ' '
- CALL GETDEF(CHDEF)
- LDEF = LENOCC(CHDEF)
- IF ((LDEF.NE.0) .AND.
- + (INDEX(PATH(1:LPATH),':').EQ.0).AND.
- + (INDEX(PATH(1:LPATH),'>').EQ.0).AND.
- + (INDEX(PATH(1:LPATH),'-').EQ.0)) THEN
- ISTAT = LIB$FIND_FILE(CHDEF(1:LDEF)//
- + PATH(1:LPATH),CHFILE,ICONT)
- ELSE
- ISTAT = LIB$FIND_FILE(PATH(1:LPATH),CHFILE,ICONT)
- ENDIF
-*
-* Check for RMS$_DNF - directory not found
-* RMS$_FNF - file not found
-* RMS$_NMF - no more files
-*
- IF(ISTAT.EQ.RMS$_NMF) GOTO 99
- IF(.NOT.ISTAT) THEN
- IRC = SYS$GETMSG(%VAL(ISTAT),LFILE,CHFILE,,)
- PRINT *,CHFILE(1:LFILE)
- IRC = ISTAT
- ISTAT = LIB$FIND_FILE_END(ICONT)
- GOTO 99
- ELSE
- LFILE = LENOCC(CHFILE)
-*
-* Get recfm, nblocks, creation date, if IOPTL
-*
- IF(IOPTL.NE.0) THEN
- OPEN(99,FILE=CHFILE(1:LFILE),STATUS='OLD',READONLY,
- + IOSTAT=IRC,USEROPEN=XZFINF)
- ISTART = INDEXB(CHFILE(1:LFILE),']')+1
- IF(NFOUND.EQ.0) THEN
- PRINT *,'Directory: '//CHFILE(1:ISTART-1)
- PRINT *
- ENDIF
- WRITE(CBLOCKS,'(I10)') IBLK
- PRINT *,CHFILE(ISTART:LFILE)//' '//CBLOCKS//' '//
- + CREDAT(1:17)//' '//
- + CHUIC(1:LENOCC(CHUIC))//' '//CHPROT
- ELSE
- PRINT *,CHFILE(1:LFILE)
- ENDIF
- NFOUND = NFOUND + 1
- GOTO 10
-
- ENDIF
-#endif
-#if defined(CERNLIB_IBMVM)
-
- IF(LPATH.EQ.0) THEN
- PATH = ' '
- LPATH = 1
- ENDIF
-
- CALL CTRANS('.',' ',PATH,1,LPATH)
- IF(IOPTL.EQ.0) THEN
- CALL VMCMS('LISTFILE '//PATH(1:LPATH)//'(STACK',IRC)
- ELSE
- CALL VMCMS('LISTFILE '//PATH(1:LPATH)//'(STACK L',IRC)
- ENDIF
- CALL VMCMS('SENTRIES',NFOUND)
- DO 10 I=1,NFOUND
- CALL VMRTRM(CHFILE,LFILE)
- PRINT *,CHFILE(1:LENOCC(CHFILE))
-10 CONTINUE
-#endif
-
- 99 END
-
diff --git a/src/packlib/cspack/programs/zftp/zftlmv.F b/src/packlib/cspack/programs/zftp/zftlmv.F
deleted file mode 100644
index 7007d9b..0000000
--- a/src/packlib/cspack/programs/zftp/zftlmv.F
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: zftlmv.F,v 1.1.1.1 1996/03/08 15:44:20 mclareni Exp $
-*
-* $Log: zftlmv.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:20 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE ZFTLMV
-#include "cspack/czsock.inc"
-#include "cspack/hcmail.inc"
-#include "cspack/quest.inc"
- CHARACTER*80 CHMESS
- CHARACTER*80 LOCAL,REMOTE
- CHARACTER*8 CHOPT
-*
- CALL KUGETS(LOCAL,LSRC)
- CALL KUGETS(REMOTE,LDST)
- CALL KUGETC(CHOPT,LOPT)
-#include "cspack/czfold.inc"
- CALL XZLMV(LOCAL(1:LSRC),REMOTE(1:LDST),CHOPT(1:LOPT),IRC)
- 99 END
-
diff --git a/src/packlib/cspack/programs/zftp/zftlrm.F b/src/packlib/cspack/programs/zftp/zftlrm.F
deleted file mode 100644
index ece0857..0000000
--- a/src/packlib/cspack/programs/zftp/zftlrm.F
+++ /dev/null
@@ -1,56 +0,0 @@
-*
-* $Id: zftlrm.F,v 1.1.1.1 1996/03/08 15:44:20 mclareni Exp $
-*
-* $Log: zftlrm.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:20 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE ZFTLRM
-*
- LOGICAL LOPEN,IEXIST
- CHARACTER*80 PATH
-*
- CALL KUGETC(PATH,LPATH)
- IF(LPATH.EQ.0) RETURN
-#if defined(CERNLIB_UNIX)
- CALL CUTOL(PATH)
-#endif
-*
-* Check if file exists
-*
-#if defined(CERNLIB_IBMVM)
- CALL CTRANS('.',' ',PATH,1,LPATH)
- INQUIRE(FILE='/'//PATH(1:LPATH),EXIST=IEXIST)
-#endif
-#if !defined(CERNLIB_IBMVM)
- INQUIRE(FILE=PATH(1:LPATH),EXIST=IEXIST)
-#endif
- IF(.NOT.IEXIST) THEN
- PRINT *,'File ',PATH(1:LPATH),' not found'
- GOTO 99
- ENDIF
-*
-* Find a unit number which is free
-*
- DO 10 I=1,99
- INQUIRE(I,OPENED=LOPEN)
- IF(.NOT.LOPEN) GOTO 20
-10 CONTINUE
- IRC = 1
- RETURN
-#if defined(CERNLIB_IBMVM)
-20 OPEN(I,FILE='/'//PATH(1:LPATH),STATUS='OLD',FORM='UNFORMATTED',
-#endif
-#if !defined(CERNLIB_IBMVM)
-20 OPEN(I,FILE=PATH(1:LPATH),STATUS='OLD',FORM='UNFORMATTED',
-#endif
- +ERR=99)
- CLOSE(I,STATUS='DELETE',ERR=99)
- IRC = 0
- RETURN
-99 IRC = 1
- END
-
-
diff --git a/src/packlib/cspack/programs/zftp/zftp.F b/src/packlib/cspack/programs/zftp/zftp.F
deleted file mode 100644
index c8fa35f..0000000
--- a/src/packlib/cspack/programs/zftp/zftp.F
+++ /dev/null
@@ -1,139 +0,0 @@
-*
-* $Id: zftp.F,v 1.2 1996/09/20 12:45:16 cernlib Exp $
-*
-* $Log: zftp.F,v $
-* Revision 1.2 1996/09/20 12:45:16 cernlib
-* changes for linux around usage of iargc
-*
-* Revision 1.1.1.1 1996/03/08 15:44:18 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- PROGRAM ZFTP
-********************************************************************
-* *
-* ZEBRA File Transfer Program using TCP/IP *
-* ======================================== *
-* *
-* Current implementation on Apollo, VAX/VMS and IBM/VM *
-* *
-* The following commands are available: *
-* OPEN : to open a communication with a remote machine *
-* CLOSE: to close communication with a remote machine *
-* GETA : to transfer a text file from a remote machine *
-* PUTA : to transfer a text file to a remote machine *
-* GETB : to transfer a binary file from a remote machine *
-* PUTB : to transfer a binary file to a remote machine *
-* GETP : to transfer a binary PAM from a remote machine *
-* PUTP : to transfer a binary PAM to a remote machine *
-* GETRZ: to transfer a remote RZ file from a remote machine *
-* PUTRZ: to transfer a local RZ file to a remote machine *
-* RSHEL: to send a message to the remote machine *
-* LS : to list a remote directory *
-* VERS : to print current version *
-* *
-* Note that the small communication packages CZ (Fortran) *
-* and TCPAW (C) must be linked with ZFTP. *
-* needs on vax files sgtty.h and pwd.h *
-* $SET PROT=(S,O:RWD,G,W) FTPLOGIN. (Set file protection) *
-* /bin/chmod 0600 .netrc *
-* *
-* Author: Rene Brun CERN/DD *
-* in collaboration with : *
-* B.Segal (DD) for TCPAW *
-* *
-********************************************************************
-#if defined(CERNLIB_OS9)
-#include "cspack/hos9c.inc"
-#endif
-#include "cspack/czsock.inc"
-#include "cspack/pawc.inc"
- CHARACTER*100 CHARGS
- EXTERNAL ZEXIT
-*
- IADTCP=0
- ISKIN=-1
- ISKOUT=-1
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB_TCPSOCK))
- IDUMMY = CINIT(DUMMY)
-#endif
- CALL HLIMIT(NWPAWC)
- CALL KUINIT(30000)
- CALL KUEXIT(ZEXIT)
- CALL KUQUIT(ZEXIT)
-*
- CALL FTPDEF
-*
-* Get any command line options
-*
- CALL CFILL(' ',CHARGS,1,100)
-#if (defined(CERNLIB_IBMMVS))&&(defined(CERNLIB_GSI))
- CALL PALOG('ZFT',1)
-#endif
-#if defined(CERNLIB_IBM)
- CALL GOPARM(LPARM,CHARGS)
- CALL TIMEST(1000.)
-#endif
-#if defined(CERNLIB_VAXVMS)
- IFLAG = 0
- CALL LIB$GET_FOREIGN(CHARGS,,LPARM,IFLAG)
-#endif
-#if defined(CERNLIB_CRAY)
- IF(IARGC(DUMMY).NE.0) LPARM = IARGV(1,CHARGS)
-#endif
-#if (defined(CERNLIB_UNIX)) && (!defined(CERNLIB_CRAY))\
- &&(!defined(CERNLIB_HPUX)) && (!defined(CERNLIB_LINUX))
- IF(IARGC(DUMMY).NE.0) CALL GETARG(1,CHARGS)
-#endif
-#if (defined(CERNLIB_UNIX))&&(!defined(CERNLIB_CRAY))&&(defined(CERNLIB_HPUX))
- LPARM = IGETARG(1,CHARGS,LEN(CHARGS))
-#endif
-#if defined(CERNLIB_LINUX)
- IF(IARGC().NE.0) CALL GETARG(1,CHARGS)
-#endif
- LPARM = LENOCC(CHARGS)
- IF(LPARM.NE.0) THEN
- CALL KUEXEC('OPEN '//CHARGS(1:LPARM))
- ENDIF
-*
-* Change default prompt
-*
- CALL KIPRMT('ZFTP> ')
-*
-* Initialise I/O units and debug level
-*
- IPRINT = 6
- LOGLVL = 0
- LUNI = 1
- LUNO = 2
- CALL XZINIT(IPRINT,LOGLVL,LUNI,LUNO)
-*
- CALL KUWHAT
-*
- CALL ZEXIT
-#if !defined(CERNLIB_IBM)
-*
-*-- delete scratch files
-*
- CALL KUINQF('LAST.KUMAC',LL)
- IF (LL .GE. 0) THEN
- OPEN(1,FILE='last.kumac',STATUS='UNKNOWN')
- CLOSE(1,STATUS='DELETE')
- ENDIF
- CALL KUINQF('LAST.KUMACOLD',LL)
- IF (LL .GE. 0) THEN
- OPEN(1,FILE='last.kumacold',STATUS='UNKNOWN')
- CLOSE(1,STATUS='DELETE')
- ENDIF
-#endif
-#if (defined(CERNLIB_IBMMVS))&&(defined(CERNLIB_GSI))
- CALL PALOG('ZFT',2)
-#endif
- END
-#if defined(CERNLIB_VAXVMS)
- SUBROUTINE CTL$GL_PCB
- ENTRY CTL$T_ACCOUNT
- ENTRY CTL$T_USERNAME
- END
-#endif
diff --git a/src/packlib/cspack/programs/zftp/zftpcd.F b/src/packlib/cspack/programs/zftp/zftpcd.F
deleted file mode 100644
index 7c18bb7..0000000
--- a/src/packlib/cspack/programs/zftp/zftpcd.F
+++ /dev/null
@@ -1,67 +0,0 @@
-*
-* $Id: zftpcd.F,v 1.1.1.1 1996/03/08 15:44:19 mclareni Exp $
-*
-* $Log: zftpcd.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:19 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE ZFTPCD
-#include "cspack/czsock.inc"
-#include "cspack/hcmail.inc"
-#include "cspack/quest.inc"
- CHARACTER*80 PATH
- CHARACTER*80 CHPASS
- CHARACTER*20 CHOPT
-*
-#include "cspack/czopen.inc"
-
- CALL KUGETS(PATH,LPATH)
- IF(LPATH.EQ.0) THEN
- CALL ZFTPWD
- RETURN
- ENDIF
-*
-* For remote connections to VM systems, cater for write links
-*
- CALL KUGETC(CHPASS,LPASS)
- CALL KUGETC(CHOPT,LCHOPT)
-
- IF(LCHOPT.EQ.0) THEN
- CHOPT = ' '
- LCHOPT = 1
- ENDIF
-
- IOPTC = INDEX(CHOPT(1:LCHOPT),'C')
- IOPTR = INDEX(CHOPT(1:LCHOPT),'R')
- IOPTW = INDEX(CHOPT(1:LCHOPT),'W')
-
- IF((IOPTR.NE.0).AND.(IOPTW.NE.0)) THEN
- PRINT *,'ZFTPCD. only one of R(ead) and W(rite)',
- + 'maybe specified'
- RETURN
- ENDIF
-
- IF((IOPTR+IOPTW.NE.0).AND.(LPASS.EQ.0)) THEN
- PRINT *,'ZFTPCD. password must be given with ',
- + 'R or W options'
- RETURN
- ENDIF
-
- IF(IOPTC.NE.0) THEN
- CHMAIL = 'XZIO :CD '//PATH(1:LPATH) //' C'
- ELSEIF(IOPTR.NE.0) THEN
- CHMAIL = 'XZIO :CD '//PATH(1:LPATH) // ' ' //
- + CHPASS(1:LPASS)//' R'
- ELSEIF(IOPTW.NE.0) THEN
- CHMAIL = 'XZIO :CD '//PATH(1:LPATH) // ' ' //
- + CHPASS(1:LPASS)//' W'
- ELSE
- CHMAIL = 'XZIO :CD '//PATH(1:LPATH)
- ENDIF
-
- CALL CZPUTA(CHMAIL,ISTAT)
-#include "cspack/czmess.inc"
- 99 END
-
diff --git a/src/packlib/cspack/programs/zftp/zftpcdf.cdf b/src/packlib/cspack/programs/zftp/zftpcdf.cdf
deleted file mode 100644
index 9614bd1..0000000
--- a/src/packlib/cspack/programs/zftp/zftpcdf.cdf
+++ /dev/null
@@ -1,750 +0,0 @@
-*
-* $Id: zftpcdf.cdf,v 1.1.1.1 1996/03/08 15:44:20 mclareni Exp $
-*
-* $Log: zftpcdf.cdf,v $
-* Revision 1.1.1.1 1996/03/08 15:44:20 mclareni
-* Cspack
-*
-*
->NAME FTPDEF
-
-*----------------------------------------------------------------
->Menu ZFTP
->Guidance
-To transfer Text files, RZ or FZ files using TCP/IP.
-
-*----------------------------------------------------------------
->Command LOGLEVEL
->Parameters
-Level 'Log level ' I D='0'
->Guidance
-Use the LOGLEVEL command to set the level of logging/debug of
-the ZFTP command.
->Action ZFLOGC
-
-*----------------------------------------------------------------
->Command MV
->Parameters
-SOURCE 'Source file' C D=' '
-TARGET 'Target file' C D=' '
-+
-CHOPT 'Options ' C D=' '
->Action ZFTPMV
->Guidance
-Move (rename) the file SOURCE to TARGET on the remote machine
-*----------------------------------------------------------------
->Command LMV
->Parameters
-SOURCE 'Source file' C D=' '
-TARGET 'Target file' C D=' '
-+
-CHOPT 'Options ' C D=' '
->Action ZFTLMV
->Guidance
-Move (rename) the file SOURCE to TARGET on the local machine
-*----------------------------------------------------------------
->Command GETA
->Parameters
-REMOTE 'Remote file name' C D='REM1'
-+
-LOCAL 'Local file name' C D=' '
-CHOPT 'CHOPT' C D=' '
--A 'local file has already been opened'
--C 'respect case of file name (otherwise translate to lower case on Unix)'
--S 'statistics on the file transfer are printed'
--V 'remote file is created with V format (IBM)'
->Guidance
-Transfer a text file REMOTE from the remote machine
-to a local file called LOCAL. If a local file name is
-not specified, the file will have the same name as on
-the remote machine.
-.
-Note that on IBM, the text file is created RECFM=F,LRECL=80
-unless the option V is specified.
-.
-e.g.
-.
-GETA FATMEN.CARDS -s # Transfer FATMEN card pam and print statistics
->Action GETA
-
-*----------------------------------------------------------------
->Command PUTA
->Parameters
-LOCAL 'Local file name' C D='REM1'
-+
-REMOTE 'Remote file name' C D=' '
-CHOPT 'CHOPT' C D=' '
--A 'local file has already been opened'
--C 'respect case of file name (otherwise translate to lower case on Unix)'
--S 'statistics on the file transfer are printed'
--V 'remote file is created with V format (IBM)'
->Guidance
-Transfer the text file LOCAL to the remote machine
-If a remote file name is not given, the file will have
-the same name as on the local machine.
-.
-Note that on VM systems the text file is created RECFM=F,LRECL=80
-unless the option V is specified.
-.
-e.g.
-.
-PUTA CSPACK.CARDS CSPACK/CSPACK.CAR # Store file in directory CSPACK
->Action PUTA
-
-*----------------------------------------------------------------
->Command GETB
->Parameters
-REMOTE 'Remote file name' C D='REM1'
-+
-LOCAL 'Local file name' C D=' '
-LRECL 'Record length in bytes' I D=0
-CHOPT 'CHOPT' C D=' '
--A 'local file has already been opened'
--C 'respect case of file name (otherwise translate to lower case on Unix)'
--R 'replace local file if it already exists'
--S 'statistics on the file transfer are printed'
->Guidance
-Transfer a binary file REMOTE from the remote machine
-to a local file called LOCAL. If a local file name is
-not specified, the file will have the same name as on
-the remote machine. The file must contain
-fixed length blocks (EPIO or FZ exchange format).
-FORTRAN sequential I/O is used on both the local
-and remote node.
-.
-See also the GETX command.
-.
-e.g.
-.
-GETB FXFILE.DAT = 32400 -s
->Action GETB
-
-*----------------------------------------------------------------
->Command PUTB
->Parameters
-LOCAL 'Local file name' C D='LOC1'
-+
-REMOTE 'Remote file name' C D=' '
-LRECL 'Record length in bytes' I D=0
-CHOPT 'CHOPT' C D=' '
--A 'local file has already been opened'
--C 'respect case of file name (otherwise translate to lower case on Unix)'
--R 'replace remote file if it already exists'
--S 'statistics on the file transfer are printed'
->Guidance
-Transfer a binary file LOCAL to the remote machine
-If a remote file name is not given, the file will have
-the same name as on the local machine.
-The file must contain fixed length blocks (EPIO
-or FZ exchange format).
-FORTRAN sequential I/O is used on both the local
-and remote node.
-.
-See also the GETX command.
-.
-e.g.
-.
-PUTB EPIO.DAT
->Action PUTB
-
-*----------------------------------------------------------------
->Command GETD
->Parameters
-REMOTE 'Remote file name' C D='REM1'
-+
-LOCAL 'Local file name' C D=' '
-LRECL 'Record length (in bytes)' I D=0
-CHOPT 'CHOPT' C D=' '
--A 'local file has already been opened'
--C 'respect case of file name (otherwise translate to lower case on Unix)'
--R 'replace local file if it already exists'
--S 'statistics on the file transfer are printed'
->Guidance
-Transfer a direct-access file REMOTE from the remote machine
-to a local file called LOCAL.
-If LOCAL is not given, REMOTE is assumed.
->Action GETD
-
-*----------------------------------------------------------------
->Command PUTD
->Parameters
-LOCAL 'Local file name' C D='REM1'
-+
-REMOTE 'Remote file name' C D=' '
-LRECL 'Record length (in bytes)' I D=0
-CHOPT 'CHOPT' C D=' '
--A 'local file has already been opened'
--C 'respect case of file name (otherwise translate to lower case on Unix)'
--R 'replace remote file if it already exists'
--S 'statistics on the file transfer are printed'
->Guidance
-Transfer a direct-access file LOCAL to the remote machine
-The name of the text file on the remote machine is REMOTE.
-If REMOTE is not given, LOCAL is assumed.
->Action PUTD
-
-*----------------------------------------------------------------
->Command GETP
->Parameters
-REMOTE 'Remote PAM name' C D='REM1'
-+
-LOCAL 'Local PAM name' C D=' '
-CHOPT 'CHOPT' C D=' '
--C 'respect case of file name (otherwise translate to lower case on Unix)'
--R 'replace local file if it already exists'
--S 'statistics on the file transfer are printed'
->Guidance
-Transfer a binary PAM file REMOTE from the remote machine
-to a local file called LOCAL.
-If LOCAL is not given, REMOTE is assumed.
->Action GETP
-
-*----------------------------------------------------------------
->Command PUTP
->Parameters
-LOCAL 'Local PAM name' C D='LOC1'
-+
-REMOTE 'Remote PAM name' C D=' '
-CHOPT 'CHOPT' C D=' '
--C 'respect case of file name (otherwise translate to lower case on Unix)'
--R 'replace remote file if it already exists'
--S 'statistics on the file transfer are printed'
->Guidance
-Transfer a binary PAM file LOCAL to the remote machine
->Action PUTP
-
-*----------------------------------------------------------------
->Command GETFZ
->Parameters
-REMOTE 'Remote file name' C D='REM1'
-+
-LOCAL 'Local file name' C D=' '
-RRECL 'Record length (in bytes)' I D=0
-RFORM 'Remote Format of remote FZ file' C D=' ' OPTION
--A 'ASCII exchange format file'
--D 'Use Fortran direct access I/O'
--X 'Binary exchange format file'
--Z 'Native format file (default)'
-LRECL 'Local Record length (in bytes)' I D=0
-LFORM 'Format of local FZ file' C D=' ' OPTION
--A 'ASCII exchange format file'
--D 'Use Fortran direct access I/O'
--X 'Binary exchange format file'
--Z 'Native format file (default)'
-CHOPT 'CHOPT' C D=' '
--A 'local file has already been opened'
--C 'respect case of file name (otherwise translate to lower case on Unix)'
--S 'statistics on the file transfer are printed'
->Guidance
-GETFZ allows a FZ file to be retrieved from a remote machine.
-Transfer of exchange format files is achieved more efficiently
-using GETB (for binary exchange format) or GETA (alpha format).
-.
-GETFZ permits format conversion. For native format files, the
-record length must be specified (in bytes). For exchange format
-files, the record length defaults to 80 for alpha-format files
-or is determined from the file itself for binary exchange format
-files.
->Action GETFZ
-
-*----------------------------------------------------------------
->Command PUTFZ
->Parameters
-LOCAL 'Local file name' C D='REM1'
-+
-REMOTE 'Remote file name' C D=' '
-LRECL 'Local Record length (in bytes)' I D=0
-LFORM 'Format of local FZ file' C D=' ' OPTION
--A 'ASCII exchange format file'
--D 'Use Fortran direct access I/O'
--X 'Binary exchange format file'
--Z 'Native format file (default)'
-RRECL 'Remote Record length (in bytes)' I D=0
-RFORM 'Format of remote FZ file' C D=' ' OPTION
-CHOPT 'CHOPT' C D=' '
--A 'local file has already been opened'
--C 'respect case of file name (otherwise translate to lower case on Unix)'
--S 'statistics on the file transfer are printed'
->Guidance
-PUTFZ allows a FZ file to be sent to a remote machine.
-Transfer of exchange format files is achieved more efficiently
-using PUTB (for binary exchange format) or PUTA (alpha format).
-.
-PUTFZ permits format conversion. For native format files, the
-record length must be specified (in bytes). For exchange format
-files, the record length defaults to 80 for alpha-format files
-or is determined from the file itself for binary exchange format
-files.
->Action PUTFZ
-
-*----------------------------------------------------------------
->Command GETRZ
->Parameters
-REMOTE 'Remote file name' C D='REM1'
-+
-LOCAL 'Local file name' C D=' '
-CHOPT 'CHOPT' C D=' ' R=' ,R,S,L,T,X,N'
--A 'local file has already been opened'
--C 'respect case of file name (otherwise translate to lower case on Unix)'
--E 'the input file is in EXCHANGE mode'
--S 'statistics on the file transfer are printed'
--N 'the local file will be in NATIVE format'
--X 'the local file will be in EXCHANGE format'
--R 'the local file will have RELATIVE organisation (VAX)'
--S 'RZSTAT is called on the received file.'
--L 'RZLDIR is called.'
--T 'RZLDIR is called with option "T".'
->Guidance
-Transfer a RZ file REMOTE from the remote machine
-to a local RZ file called LOCAL.
-If LOCAL is not given, REMOTE is assumed.
-The RZ file is created on the local computer with the same
-parameters as on the remote machine.
->Action GETRZ
-
-*----------------------------------------------------------------
->Command PUTRZ
->Parameters
-LOCAL 'Local file name' C D='REM1'
-+
-REMOTE 'Remote file name' C D=' '
-CHOPT 'CHOPT' C D=' ' R=' ,R,S,L,T,N,X'
--A 'local file has already been opened'
--C 'respect case of file name (otherwise translate to lower case on Unix)'
--E 'the input file is in EXCHANGE mode'
--S 'statistics on the file transfer are printed'
--N 'the remote file will be in NATIVE format'
--X 'the remote file will be in EXCHANGE format'
--R 'the remote file will have RELATIVE organisation (VAX)'
--S 'RZSTAT is called on the received file.'
--L 'RZLDIR is called.'
--T 'RZLDIR is called with option "T".'
->Guidance
-Transfer the local RZ file LOCAL to the remote machine
-The name of the RZ file on the remote machine is REMOTE.
-.
-If REMOTE is not given, LOCAL is assumed.
-.
-The RZ file is created on the remote computer with the same
-parameters as on the local machine.
->Action PUTRZ
-
-*----------------------------------------------------------------
->Command GETX
->Parameters
-REMOTE 'Remote file name' C D='REM1'
-+
-LOCAL 'Local file name' C D=' '
-LRECL 'Record length in bytes' I D=0
-CHOPT 'CHOPT' C D=' '
--A 'local file has already been opened'
--C 'respect case of file name (otherwise translate to lower case on Unix)'
--S 'statistics on the file transfer are printed'
->Guidance
-Transfer a binary file REMOTE from the remote machine
-to a local file called LOCAL. If a local file name is
-not specified, the file will have the same name as on
-the remote machine. The file must contain
-fixed length blocks (EPIO or FZ exchange format)
-with no FORTRAN control words. This command
-can be used to transfer 'true' exchange format
-files, e.g. those written on Unix systems with
-C or FORTRAN direct-acess I/O. See also the GETB command.
-If LOCAL is not given, REMOTE is assumed.
-e.g.
-GETX FXFILE.DAT = 32400 -s
->Action GETX
-
-*----------------------------------------------------------------
->Command PUTX
->Parameters
-LOCAL 'Local file name' C D='LOC1'
-+
-REMOTE 'Remote file name' C D=' '
-LRECL 'Record length in bytes' I D=0
-CHOPT 'CHOPT' C D=' '
--A 'local file has already been opened'
--C 'respect case of file name (otherwise translate to lower case on Unix)'
--S 'statistics on the file transfer are printed'
->Guidance
-Transfer a binary file LOCAL to the remote machine
-If a remote file name is not given, the file will have
-the same name as on the local machine.
-The file must contain fixed length blocks (EPIO
-or FZ exchange format). This command
-can be used to transfer 'true' exchange format
-files, e.g. those written on Unix systems with
-C or FORTRAN direct-acess I/O. See also the GETB command.
-e.g.
-PUTX EPIO.DAT
->Action PUTX
-
-*----------------------------------------------------------------
->Command MGET
->Parameters
-REMOTE 'Remote file name' C D='REM1'
-+
-LOCAL 'Local file name' C D=' '
-CHOPT 'CHOPT' C D=' '
->Guidance
-Transfer all files matching the specified remote file name
-to the local system. The file name given may contain
-*, to match one or more characters, or %, to match a single
-character.
-.
-By default the transfer is performed
-using GETA, unless the file name has a known extension.
-.
-e.g.
-.
-*.PAM --> GETP
-*.CETA, *.CET --> GETB, LRECL=3600
-*.CMZ, *.RZ --> GETRZ
-.
-Options are passed to the appropriate transfer routine.
->Action MGET
-
-*----------------------------------------------------------------
->Command MPUT
->Parameters
-LOCAL 'Local file name' C D='LOC1'
-+
-REMOTE 'Remote file name' C D=' '
-CHOPT 'CHOPT' C D=' '
->Guidance
-Transfer all files matching the specified local file name
-to the remote system. The file name given may contain
-*, to match one or more characters, or %, to match a single
-character.
-By default the transfer is performed
-using PUTA, unless the file name has a known extension.
-.
-e.g.
-.
-*.PAM --> GETP
-*.CETA, *.CET --> GETB, LRECL=3600
-*.CMZ, *.RZ --> GETRZ
-.
-e.g.
-.
-MPUT *.CAR *.CARDS -s # Transfer all local .CAR files to .CARDS files
- # and print statistics on each transfer
-.
-Options are passed to the appropriate transfer routine.
->Action MPUT
-
-*----------------------------------------------------------------
->Command RSHELL
->Parameters
-COMMAND 'Command to remote machine' C
->Guidance
-The text in COMMAND is transmitted for execution to the
-remote machine.
-e.g.
-RSHELL EXEC TELL ONEALE Coffee?
->Action RSHELL
-
-*----------------------------------------------------------------
->Command OPEN
->Parameters
-MACHINE 'Name of remote machine' C
-+
-CHOPT 'Character options ' C D=' '
--V 'remote node runs VM/CMS - use REXEC to start server'
--D 'use DECnet rather than TCP/IP (VAX/VMS systems only)'
->Guidance
-Opens a communication with the remote machine named MACHINE.
-The name specified must be defined in the local TCP/IP hosts
-table or in the names server.
-.
-The machine name may be given as a character string,
-e.g. VXCRNA, or as an internet address, e.g. 128.141.1.100
-This command will prompt you for user authentification.
-Give a user name and a password(not echoed).
-.
-e.g.
-.
-OPEN VXCRNA
->Action RLOGIN
-
-*----------------------------------------------------------------
->Command CLOSE
->Guidance
-Close communication with the current remote host.
->Action RCLOSE
-
-*----------------------------------------------------------------
->Command CD
->Guidance
-Change remote working directory.
-.
-e.g.
-.
-CD DISK$CERN:[JAMIE.ZFTP] # VMS
-CD JAMIE.202 # VM
-CD /usera/jamie/tcpaw # Unix
-.
-To obtain a write link to a disk belonging to another user
-on VM/CMS, use, for example:
-.
-CD JAMIE.202 write-pass -W
-.
->Action ZFTPCD
->Parameters
-+
-Pathname 'Pathname' C D=' '
-Password 'Password' C D=' '
-CHOPT 'Options ' C D=' '
--C 'Respect case of remote directory'
--R 'Obtain read-link to specified mini-disk (VM only)'
--W 'Obtain write-link to specified mini-disk (VM only)'
-
-*----------------------------------------------------------------
->Command LCD
->Guidance
-Change local working directory. If no parameters are given,
-the current working directory is displayed.
-e.g.
-LCD DISK$CERN:[JAMIE.ZFTP] # VMS
-LCD JAMIE.202 # VM
-LCD /usera/jamie/tcpaw # Unix
->Action ZFTLCD
->Parameters
-+
-Pathname 'Pathname' C D=' '
-Password 'Password' C D=' '
-CHOPT 'Options ' C D=' '
--C 'Respect case of remote directory'
--R 'Obtain read-link to specified mini-disk (VM only)'
--W 'Obtain write-link to specified mini-disk (VM only)'
-
-*----------------------------------------------------------------
->Command PWD
->Guidance
-Print remote working directory.
->Action ZFTPWD
-
-*----------------------------------------------------------------
->Command LPWD
->Guidance
-Print local working directory.
->Action ZFTLCD
->Parameters
-+
-Pathname 'Pathname' C D=' '
-Password 'Password' C D=' '
-CHOPT 'Options ' C D=' '
-
-*----------------------------------------------------------------
->Command LS
->Guidance
-Use the LS command to list a remote directory.
-e.g.
-LS *.CMZ
->Action ZFTPLS
->Parameters
-+
-Pathname 'Pathname' C D=' '
-CHOPT 'Options' C D=' '
--L 'Generate "long" listing. This corresponds to the L_
-option of LISTFILE on VM, the -l flag of ls on Unix_
-and to the output of the ftp dir subcommand on VMS'
-
-*----------------------------------------------------------------
->Command LLS
->Guidance
-Use the LLS command to list a local directory.
-e.g.
-LLS *.CMZ
->Action ZFTLLS
->Parameters
-+
-Pathname 'Pathname' C D=' '
-CHOPT 'Options' C D=' '
--L 'Generate "long" listing. This corresponds to the L_
-option of LISTFILE on VM, the -l flag of ls on Unix_
-and to the output of the ftp dir subcommand on VMS'
-
-*----------------------------------------------------------------
->Command RM
->Guidance
-Use the RM command to delete a remote file.
-e.g.
-RM TEST.DAT
->Action ZFTPRM
->Parameters
-Filename 'Filename' C D=' '
-
-*----------------------------------------------------------------
->Command LRM
->Guidance
-Use the LRM command to delete a local file.
-e.g.
-LRM TEST.DAT
->Action ZFTLRM
->Parameters
-Filename 'Filename' C D=' '
-
-*----------------------------------------------------------------
->Command LOCSYS
->Guidance
-Display local operating system
->Action XZLSYS
-
-*----------------------------------------------------------------
->Command SYSTEM
->Guidance
-Display remote operating system
->Action XZRSYS
-
-*----------------------------------------------------------------
->Command SVERSION
->Guidance
-Print version of server program
->Action XZSVER
-
-*----------------------------------------------------------------
->Command VERSION
->Guidance
-Print version of ZFTP program
->Action ZFVERS
-
-*----------------------------------------------------------------
->Command RFRF
->Parameters
-FZFILE 'FZ file name' C D=' '
-RZFILE 'RZ file name' C D=' '
-+
-LRECL 'RZ file record length' I D=0
-QUOTA 'Quota for output file' I D=0
-CHOPT 'CHOPT' C D=' '
--A 'the input file is in FZ alpha format'
--S 'display statistics on the RZ file'
--X 'the RZ file will be created in eXchange mode'
--C 'respect case of input/output file names'
--R 'replace output file if it already exists'
->Guidance
-This command converts an FZ exchange format file to an
-RZ file on the LOCAL machine. No network transfer is
-performed. The FZFILE must be the output of a previous
-RTOF command, or have been created using the RTOX or RTOA
-programs. On Unix systems, this file will be read with
-FORTRAN direct-access and will hence be transferable and
-readable on other systems.
-.
-By default, the output RZ file will have the same record
-length as the original RZ file. However, if LRECL is
-specified then this value will be used instead.
->Action ZFRFRF
-
-*----------------------------------------------------------------
->Command RTOF
->Parameters
-RZFILE 'RZ file name' C D=' '
-FZFILE 'FZ file name' C D=' '
-+
-LRECL 'FZ file record length' I D=3600
-CHOPT 'CHOPT' C D=' '
--A 'the output file will be in FZ alpha format'
--S 'display statistics on the RZ file'
--C 'respect case of input/output file names'
--R 'replace output file if it already exists'
--X 'input file is in exchange format'
->Guidance
-This command converts an RZ file into an FZ exchange mode
-format file on the LOCAL machine. No network transfer is
-performed. By default a binary exchange mode FZ file is
-created. On Unix systems, this file will be written with
-FORTRAN direct-access and will hence be transferable and
-readable on other systems.
->Action ZFRTOF
-
-*----------------------------------------------------------------
->Command FZCOPY
->Parameters
-FZIN 'input FZ file name' C D=' '
-FZOUT 'output FZ file name' C D=' '
-+
-IFORM 'Format of input FZ file' C D='X' OPTION
--A 'ASCII exchange format file'
--D 'Use Fortran direct access I/O'
--N 'Native data format but exchange file format'
--X 'Binary exchange format file'
--Z 'Native format file (default)'
-IRECL 'Input record length (in bytes)' I D=0
-OFORM 'Format of output FZ file' C D='X' OPTION
--A 'ASCII exchange format file'
--D 'Use Fortran direct access I/O'
--N 'Native data format but exchange file format'
--X 'Binary exchange format file'
--Z 'Native format file (default)'
-ORECL 'Output record length (in bytes)' I D=0
-CHOPT 'CHOPT' C D=' '
->Guidance
-This command copies an FZ file on the local machine. At
-the same time, file format and data format conversion is
-possible. Thus, FZCOPY can be used to convert a binary
-native format file into a alpha exchange format file etc.
-.
-The format of the files are specified as follows:
-.
- A - alpha exchange mode format - RECL not needed
- N - native data but exchange file format - RECL not needed
- X - exchange format file - RECL not needed
- Z - native data and file format - RECL must be specified
-.
->Action ZFFZCP
-
-*----------------------------------------------------------------
->Command RZCOPY
->Parameters
-RZIN 'input RZ file name' C D=' '
-RZOUT 'output RZ file name' C D=' '
-+
-ORECL 'Output record length (in words)' I D=0
-OQUOT 'Quota for the output file (D=take from input)' I D=0
-CHOPT 'CHOPT' C D='X'
--N 'convert exchange RZ file into native RZ file'
--X 'convert native RZ file into exchange RZ file'
->Guidance
-This command copies an RZ file on the local machine. At
-the same time, the record length or data format may be
-changed. Thus, RZCOPY can be used to convert a native
-format RZ file with record length 512 into an exchange
-format file with record length 8192.
-.
-If not specified, the output record length will be set equal
-to that of the input file.
-.
-If not specified, the output quota will be taken from that
-of the input file.
->Action ZFRZCP
-
-*----------------------------------------------------------------
->Command CTOF
->Parameters
-CFILE 'input file name' C D=' '
-FFILE 'output file name' C D=' '
-+
-LRECL 'record length (in bytes)' I D=0
-CHOPT 'CHOPT' C D=' '
--X 'Zebra exchange format file - RECL not needed'
->Guidance
-This command copies a file written with C or FORTRAN
-direct-access I/O to one written with FORTRAN sequential I/O.
->Action ZFCTOF
-
-*----------------------------------------------------------------
->Command FTOC
->Parameters
-FFILE 'input file name' C D=' '
-CFILE 'output file name' C D=' '
-+
-LRECL 'record length (in bytes)' I D=0
-CHOPT 'CHOPT' C D=' '
--X 'Zebra exchange format file - RECL not needed'
->Guidance
-This command copies a file written with FORTRAN sequential
-I/O to one written with FORTRAN direct-access I/O. The
-output file may be read with C I/O or FORTRAN direct access.
->Action ZFFTOC
diff --git a/src/packlib/cspack/programs/zftp/zftpls.F b/src/packlib/cspack/programs/zftp/zftpls.F
deleted file mode 100644
index 018e867..0000000
--- a/src/packlib/cspack/programs/zftp/zftpls.F
+++ /dev/null
@@ -1,39 +0,0 @@
-*
-* $Id: zftpls.F,v 1.1.1.1 1996/03/08 15:44:19 mclareni Exp $
-*
-* $Log: zftpls.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:19 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE ZFTPLS
-#include "cspack/czsock.inc"
-#include "cspack/hcmail.inc"
-#include "cspack/quest.inc"
- CHARACTER*80 PATH
- CHARACTER*4 CHOPT
-*
-#include "cspack/czopen.inc"
- CALL KUGETS(PATH,LPATH)
-
- CALL KUGETC(CHOPT,NCH)
-
- IF(LPATH.EQ.0) THEN
- PATH = ' '
- LPATH = 1
- ENDIF
-
- IF(NCH.EQ.0) THEN
- CHOPT = ' '
- NCH = 1
- ENDIF
-
- IF(INDEX(CHOPT,'C').EQ.0) CALL CLTOU(PATH)
-*
- CHMAIL = 'XZIO :LS '//PATH(1:LPATH) // '(' // CHOPT(1:NCH) // ')'
-
- CALL CZPUTA(CHMAIL,ISTAT)
-#include "cspack/czmess.inc"
- 99 END
-
diff --git a/src/packlib/cspack/programs/zftp/zftpmv.F b/src/packlib/cspack/programs/zftp/zftpmv.F
deleted file mode 100644
index d940a8f..0000000
--- a/src/packlib/cspack/programs/zftp/zftpmv.F
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: zftpmv.F,v 1.1.1.1 1996/03/08 15:44:20 mclareni Exp $
-*
-* $Log: zftpmv.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:20 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE ZFTPMV
-#include "cspack/czsock.inc"
-#include "cspack/hcmail.inc"
-#include "cspack/quest.inc"
- CHARACTER*80 CHMESS
- CHARACTER*80 LOCAL,REMOTE
- CHARACTER*8 CHOPT
-*
-#include "cspack/czopen.inc"
- CALL KUGETS(LOCAL,LSRC)
- CALL KUGETS(REMOTE,LDST)
- CALL KUGETC(CHOPT,LOPT)
-#include "cspack/czfold.inc"
- CALL XZMV(LOCAL(1:LSRC),REMOTE(1:LDST),CHOPT(1:LOPT),IRC)
- 99 END
-
diff --git a/src/packlib/cspack/programs/zftp/zftprm.F b/src/packlib/cspack/programs/zftp/zftprm.F
deleted file mode 100644
index de01e9e..0000000
--- a/src/packlib/cspack/programs/zftp/zftprm.F
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: zftprm.F,v 1.1.1.1 1996/03/08 15:44:19 mclareni Exp $
-*
-* $Log: zftprm.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:19 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE ZFTPRM
-#include "cspack/czsock.inc"
-#include "cspack/hcmail.inc"
-#include "cspack/quest.inc"
- CHARACTER*80 CHMESS
- CHARACTER*80 PATH
-*
-#include "cspack/czopen.inc"
- CALL KUGETC(PATH,LPATH)
-*
- CHMAIL = 'XZIO :RM '//PATH(1:LPATH)
- CALL CZPUTA(CHMAIL,ISTAT)
-#include "cspack/czmess.inc"
- 99 END
-
diff --git a/src/packlib/cspack/programs/zftp/zftpwd.F b/src/packlib/cspack/programs/zftp/zftpwd.F
deleted file mode 100644
index d59dafb..0000000
--- a/src/packlib/cspack/programs/zftp/zftpwd.F
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: zftpwd.F,v 1.1.1.1 1996/03/08 15:44:19 mclareni Exp $
-*
-* $Log: zftpwd.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:19 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE ZFTPWD
-#include "cspack/czsock.inc"
-#include "cspack/hcmail.inc"
-#include "cspack/quest.inc"
-*
-#include "cspack/czopen.inc"
- CHMAIL = 'XZIO :PWD '
- CALL CZPUTA(CHMAIL,ISTAT)
-#include "cspack/czmess.inc"
- 99 END
-
diff --git a/src/packlib/cspack/programs/zftp/zfvers.F b/src/packlib/cspack/programs/zftp/zfvers.F
deleted file mode 100644
index c440fe5..0000000
--- a/src/packlib/cspack/programs/zftp/zfvers.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: zfvers.F,v 1.1.1.1 1996/03/08 15:44:19 mclareni Exp $
-*
-* $Log: zfvers.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:19 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE ZFVERS
-#include "cspack/quest.inc"
- CHARACTER VIDQQ*(*)
- PARAMETER (VIDQQ = '@(#)' //
- + 'CSPACK 1.35/09 Q124'
- + // ' '
- + // '>')
- CALL CLEFT (VIDQQ,1,0)
- IDATQQ = 0
- ITIMQQ = 0
- PRINT *,
- + 'CSPACK 1.35/09 Q124'
- + // ' '
- PRINT *,' This version created on ',IDATQQ,
- + ' at ',ITIMQQ
- END
-
diff --git a/src/packlib/cspack/programs/zs/Imakefile b/src/packlib/cspack/programs/zs/Imakefile
deleted file mode 100644
index 1165a6e..0000000
--- a/src/packlib/cspack/programs/zs/Imakefile
+++ /dev/null
@@ -1,40 +0,0 @@
-DoIncludePackage(cspack)
-#include "pilot.h"
-
-SRCS_F= fatmen.F message.F xzserv.F zscdir.F zsclos.F zsfile.F \ @@\
- zsldir.F zslfil.F zslist.F zsout.F zsrzin.F sgeta.F sgetfz.F \ @@\
- sgetp.F sgetrz.F sputa.F sputfz.F sputp.F sputrz.F
-
-#ifdef CERNLIB_UNIX
-SRCS_F:= $(SRCS_F) sppiaf.F ssfget.F
-#endif
-
-#ifdef CERNLIB_OS9
-SRCS_F:= $(SRCS_F) hnear.F netcopym.F net_copy.F nettab.F zsget.F \ @@\
- zslmod.F zslmod2.F zsmodu.F
-#endif
-
-#ifdef CERNLIB_MMAP
-SRCS_F:= $(SRCS_F) zslism.F zslism1.F zslistm.F
-#endif
-
-#ifdef CERNLIB_OLD
-SRCS_F:= $(SRCS_F) zsfold.F
-#endif
-
-#ifdef CERNLIB_VAXVMS
-NeedTcpipLib
-NeedSysexe
-#endif
-
-SubdirLibraryTarget(zservlib,NullParameter)
-
-DefinePackageLibrary(zservlib)
-
-CernlibFortranProgramTarget(zserv,zs.o,$(PACKAGE_LIB),$(PACKAGE_LIB),packlib)
-
-InstallProgram(zserv,$(CERN_BINDIR))
-
-CernlibFortranProgramTarget(pawserv,zs.o,$(PACKAGE_LIB),$(PACKAGE_LIB),packlib)
-
-InstallProgram(pawserv,$(CERN_BINDIR))
diff --git a/src/packlib/cspack/programs/zs/fatmen.F b/src/packlib/cspack/programs/zs/fatmen.F
deleted file mode 100644
index 1aa2c8d..0000000
--- a/src/packlib/cspack/programs/zs/fatmen.F
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: fatmen.F,v 1.1.1.1 1996/03/08 15:44:21 mclareni Exp $
-*
-* $Log: fatmen.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:21 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE FATMEN(CHM)
-*
-* Dummy routine for FATMEN
-*
- CHARACTER*(*) CHM
- RETURN
- END
-
diff --git a/src/packlib/cspack/programs/zs/hnear.F b/src/packlib/cspack/programs/zs/hnear.F
deleted file mode 100644
index 18ad5c7..0000000
--- a/src/packlib/cspack/programs/zs/hnear.F
+++ /dev/null
@@ -1,50 +0,0 @@
-*
-* $Id: hnear.F,v 1.1.1.1 1996/03/08 15:44:21 mclareni Exp $
-*
-* $Log: hnear.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:21 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
-#if defined(CERNLIB_OS9)
- SUBROUTINE HNEAR(ID,IDC,IDNEXT)
-*
-* If ID=0 returns first histogram identifier in IDC
-* If ID.ne.0 returns IDC=ID if ID exists, IDC=0 otherwise
-* returns IDNEXT the identifier of the next hist.
-*
- TEMPLATE PAWM
-#include "cspack/pawc.inc"
- DIMENSION IQ(1),Q(1),LQ(8000)
- EQUIVALENCE (LQ(1),LMAIN),(Q(1),LQ(9)),(IQ(1),Q(1))
-*
- IDNEXT=0
- IDC=0
- IF(LMAIN.LE.0)RETURN
- LCID =LQ(LMAIN-2)
- IF(LCID.EQ.0)RETURN
- IF(ID.EQ.0)THEN
- IDC=IQ(LCID-5)
- IDNEXT=IDC
- RETURN
- ENDIF
-*
- 10 IF(LCID.EQ.0)RETURN
- IF(IQ(LCID-5).EQ.ID)THEN
- IDC=ID
- LCID=LQ(LCID)
- IF(LCID.EQ.0)THEN
- IDNEXT=0
- ELSE
- IDNEXT=IQ(LCID-5)
- ENDIF
- ELSE
- LCID=LQ(LCID)
- GO TO 10
- ENDIF
-*
- END
-
-
-#endif
diff --git a/src/packlib/cspack/programs/zs/message.F b/src/packlib/cspack/programs/zs/message.F
deleted file mode 100644
index 77391af..0000000
--- a/src/packlib/cspack/programs/zs/message.F
+++ /dev/null
@@ -1,204 +0,0 @@
-*
-* $Id: message.F,v 1.1.1.1 1996/03/08 15:44:21 mclareni Exp $
-*
-* $Log: message.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:21 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE MESSAGE(CHMAIL)
-*
-* Routine called when the PAW command RSHELL is invoked
-* CHMAIL is the string following RSHELL
-*
-* Use the following conventions:
-* A message must always be aknowledged with CZPUTA
-* The first character CH1 sent by CZPUTA is a control
-* character for PAW.
-* If CH1='0' PAW goes to the next command (no action)
-* ='1' PAW prints the message in CZPUTA
-* ='2' same as '1', then PAW waits for a new server
-* message.
-* ='3' same as '1', IQUEST(1) is set to 1 on client side
-* ='9' same as '1', then PAW closes communication
-* with the server.
-*
-#if defined(CERNLIB_OS9)
-#include "cspack/hos9c.inc"
-#endif
- CHARACTER*(*) CHMAIL
- CHARACTER*20 CHCPU,CHMOD
- CHARACTER*70 CHM
- CHARACTER*2 CHMESS
- COMMON/PAWC/NWPAW,IXPAWC,IHDIV,IXHIGZ,IXKU,FENC(5),LMAIN,HCV(9989)
- DIMENSION IQ(2),Q(2),LQ(8000)
- EQUIVALENCE (LQ(1),LMAIN),(IQ(1),LQ(9)),(Q(1),IQ(1))
- INTEGER SYSTEMF
-#include "cspack/quest.inc"
-#if defined(CERNLIB_VAXVMS)||defined(CERNLIB_MMAP)
-#include "cspack/czdir.inc"
- INTEGER*4 HMAPM,HFREEM
- CHARACTER*64 CHGLOB
- SAVE CHGLOB
- DATA IGSIZE,IGOFF/0,0/
-#endif
-*
- CHMESS=CHMAIL(1:2)
- CALL CLTOU(CHMESS)
-*
-* Locate first non-blank character
-*
-* IFIRST = ICFNBL(CHMAIL,3,60)
- IFIRST = INDEX(CHMAIL(3:60),' ') + 3
- 30 CHM=CHMAIL(IFIRST:)
-*
-* CDIR
-*
- IF(CHMESS.EQ.'CD')THEN
- CALL ZSCDIR(CHM)
- GO TO 99
- ENDIF
-*
-* LIST
-*
- IF(CHMESS.EQ.'LI'.OR.CHMESS.EQ.'LD')THEN
- CALL ZSLIST(IGOFF,CHM)
- GO TO 99
- ENDIF
-*
-* FILE
-*
- IF(CHMESS.EQ.'FI')THEN
- CALL ZSFILE(CHM)
- GO TO 99
- ENDIF
-*
-* CLOSE
-*
- IF(CHMESS.EQ.'CL')THEN
- CALL ZSCLOS(CHM)
- GO TO 99
- ENDIF
-*
-* FILELIST
-*
- IF(CHMESS.EQ.'FL')THEN
- CALL ZSLFIL
- GO TO 99
- ENDIF
-#if defined(CERNLIB_MMAP)
-*
-* Shared memory
-*
- IF(CHMESS.EQ.'GL')THEN
- IF(IGOFF.GT.0) THEN
- IERROR=HFREEM(IGOFF)
- CALL HREND(CHGLOB)
- IGOFF=0
- ENDIF
- CALL CLTOU(CHM)
- IGSIZE=HMAPM(CHM,LQ,IGOFF)
- IF(IGSIZE.NE.0) THEN
- IGOFF = 0
- CALL CZPUTA('3 Error mapping memory section',ISTAT)
- GO TO 99
- ENDIF
-*
-* Connect HRIN to Global Section.
-*
- CALL HRFILE(LQ(IGOFF+1),CHM,'M')
- IF(IQUEST(1).EQ.0) THEN
- CALL CZPUTA('1 Global memory connected',ISTAT)
-*
- NCHRZ=NCHRZ+1
- CHRZ(NCHRZ)=CHM
- CHGLOB=CHM
- FLNAME(NCHRZ)=CHM
- LUNRZ(NCHRZ)=-1
- IDIR=NCHRZ
- ELSE
- CALL CZPUTA('3 Error mapping memory section',ISTAT)
- ENDIF
- GO TO 99
- ENDIF
-*
-#endif
-#if defined(CERNLIB_VAXVMS)
-*
-* Global_sections
-*
- IF(CHMESS.EQ.'GL')THEN
- IF(IGSIZE.GT.0) THEN
- IERROR=HFREEG(IGSIZE,IQ,IGOFF)
- CALL HREND(CHGLOB)
- ENDIF
- IGSIZE=HMAPG(CHM,IQ,IGOFF)
- IF(IGSIZE.LE.0) THEN
- CALL CZPUTA('3 Error mapping global section',ISTAT)
- GO TO 99
- ENDIF
-*
-* Connect HRIN to Global Section.
-*
- CALL HRFILE(IQ(IGOFF),CHM,'G')
- CALL CZPUTA('1 Global section connected',ISTAT)
-*
- NCHRZ=NCHRZ+1
- CHRZ(NCHRZ)=CHM
- FLNAME(NCHRZ)=CHM
- LUNRZ(NCHRZ)=-1
- IDIR=NCHRZ
- GO TO 99
- ENDIF
-*
-#endif
-#if defined(CERNLIB_OS9)
-*
-* MODULE
-*
- IF(CHMESS.EQ.'MO')THEN
- ICPU=INDEX(CHM,'/')
- IF(ICPU.NE.0)THEN
- CHCPU=CHM(1:ICPU-1)
- CHMOD=CHM(ICPU+1:)
- ELSE
- CHCPU=CPU
- CHMOD=CHM
- ENDIF
- CALL ZSMODU(CHCPU,CHMOD)
- GO TO 99
- ENDIF
-*
- IUSTAT = -1
- CALL ZSOPTION(CHMAIL,CHM,IUSTAT)
- IF(IUSTAT.EQ.0) GOTO 99
-*
-#endif
-#if defined(CERNLIB_IBMVM)
-*
-* VMCMS
-*
- CALL VMCMS(CHMAIL,IERR)
-#endif
-#if !defined(CERNLIB_IBMVM)
- IERR = SYSTEMF(CHMAIL)
-#endif
- IF(IERR.NE.0)THEN
- CALL CZPUTA('3Error executing remote command',ISTAT)
- ELSE
- CALL CZPUTA('1Remote command executed',ISTAT)
- ENDIF
- GO TO 99
-#if defined(CERNLIB_OLD)
-*
-* Unknown message
-*
- 90 CALL CZPUTA('3Unknown remote command',ISTAT)
-#endif
-*
- 8001 FORMAT('0',A4,I6)
- 8002 FORMAT('3Error executing remote ',A4,
- + ' command, return code = ',I6)
- 8003 FORMAT('EEOF from ',A4,' return code = ',I6)
- 99 END
diff --git a/src/packlib/cspack/programs/zs/net_copy.F b/src/packlib/cspack/programs/zs/net_copy.F
deleted file mode 100644
index 2e00d8a..0000000
--- a/src/packlib/cspack/programs/zs/net_copy.F
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: net_copy.F,v 1.1.1.1 1996/03/08 15:44:21 mclareni Exp $
-*
-* $Log: net_copy.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:21 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
-#if defined(CERNLIB_OS9)
- SUBROUTINE Net_Copy(iad1,nw,iword,istat)
-*.==========>
-*. To copy NW words starting at IQ(iad1)
-*. from (CPU,Module) to server address IWORD(1) t
-*..=========> ( R.Brun)
-#include "cspack/hos9c.inc"
- dimension iword(1)
-*
- if(nw.le.0)return
- loc1=iadpawd-4+4*(iad1+18)
- nbytes=4*nw
- len=net_getarr(cpu,loc1,nbytes,iword)
- if(len.ne.nbytes)then
- istat=1
- else
- istat=0
- endif
- END
-#endif
diff --git a/src/packlib/cspack/programs/zs/netcopym.F b/src/packlib/cspack/programs/zs/netcopym.F
deleted file mode 100644
index 8aefb16..0000000
--- a/src/packlib/cspack/programs/zs/netcopym.F
+++ /dev/null
@@ -1,166 +0,0 @@
-*
-* $Id: netcopym.F,v 1.1.1.1 1996/03/08 15:44:21 mclareni Exp $
-*
-* $Log: netcopym.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:21 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
-#if defined(CERNLIB_OS9)
- SUBROUTINE Net_HCOPYM(ID1,istat)
-*.==========>
-*. To copy histogram ID from (cpu,module) to /PAWC/
-*..=========> ( R.Brun)
-*KEEP,HCBOOK
- PARAMETER(KNCX=3,KXMIN=4,KXMAX=5,KBWIDX=6,KMIN=7,KMAX=8,KNORM=9,
- + KTIT1=10,KNCY=7,KYMIN=8,KYMAX=9,KBWIDY=10,KSCAL2=11,
- + KTIT2=12,KNBIT=1,KNOENT=2,KSTAT1=3,KNSDIR=5,KNRH=6,
- + KCON1=9,KCON2=3,KBITS=1,KNTOT=2)
-*
-#include "cspack/pawc.inc"
- DIMENSION IQ(2),Q(2),LQ(8000)
- EQUIVALENCE (LQ(1),LMAIN),(IQ(1),LQ(9)),(Q(1),IQ(1))
- COMMON/HCBOOK/HVERSN,IHWORK,LHBOOK,LHPLOT,LGTIT,LHWORK,
- +LCDIR,LSDIR,LIDS,LTAB,LCID,LCONT,LSCAT,LPROX,LPROY,LSLIX,
- +LSLIY,LBANX,LBANY,LPRX,LPRY,LFIX,LLID,LR1,LR2,LCIDN
-*
-*KEEP,HCFLAG
- COMMON/HCFLAG/ID ,IDBADD,LID ,IDLAST,IDHOLD,NBIT ,NBITCH,
- + NCHAR ,NRHIST,IERR ,NV
-*
-*KEEP,HCFORM
- COMMON/HCFORM/IODIR,IOH1,IOH2,IOHN,IOCF1,IOCF2,IOCB1,IOCB2,IFRM(2)
-*
-*KEEP,HCBITS
- COMMON / HCBITS / I1, I2, I3, I4, I5, I6, I7, I8,
- + I9, I10, I11, I12, I13, I14, I15, I16,
- +I17, I18, I19, I20, I21, I22, I23, I24, I25, I26, I27,
- +I28, I29, I30, I31, I32, I33, I34, I35, I123, I230
-*
-#include "cspack/hos9c.inc"
- parameter (klq =-8)
-*.___________________________________________
- istat=0
- DO 10 ihist=1,nhist
- if(ihead(kid,ihist).eq.id1)go to 20
- 10 CONTINUE
- GO TO 90
-*
- 20 CONTINUE
- ID=ID1
- ntot = ihead(kntot ,ihist)
- jcont = ihead(kjcont ,ihist)
- nwid = ihead(knwid ,ihist)
- nw = ihead(knw ,ihist)
- nbprox= ihead(knbprox,ihist)
- jr1 = ihead(kjr1 ,ihist)
- i123 = jbyt(ihead(kbits,ihist),1,3)
- IF(I123.EQ.0)THEN
- CALL HBUG('Object is not histogram','HCOPYM',ID1)
- GO TO 90
- ENDIF
- I1=JBIT(I123,1)
-*
-* Check if ID already in the table
-*
- NRHIST=IQ(LCDIR+KNRH)
- IDPOS=LOCATI(IQ(LTAB+1),NRHIST,ID)
- IF(IDPOS.GT.0)THEN
- CALL HBUG('Already existing histogram replaced','HCOPYM',ID)
- CALL HDELET(ID)
- NRHIST=IQ(LCDIR+KNRH)
- IDPOS=-IDPOS+1
- ENDIF
-*
-* Enough space left to copy ID
-*
- CALL HSPACE(NTOT+105,'HCOPYM',ID1)
- IF(IERR.NE.0) GO TO 90
-*
-* Enter ID in the list of ordered IDs
-*
- IDPOS=-IDPOS+1
- IF(NRHIST.GE.IQ(LTAB-1))THEN
- CALL MZPUSH(IHDIV,LTAB,50,50,'I')
- ENDIF
- DO 30 I=NRHIST,IDPOS,-1
- IQ(LTAB+I+1)=IQ(LTAB+I)
- LQ(LTAB-I-1)=LQ(LTAB-I)
- 30 CONTINUE
-*
-* Build top level bank
-*
- IF(I1.NE.0)THEN
- IODES=IOH1
- NL=1
- ELSE
- IODES=IOH2
- NL=7
- ENDIF
-*
- IF(LIDS.EQ.0)THEN
- CALL MZBOOK(IHDIV,LIDS,LCDIR,-2,'HIDE',NL,NL,NWID,IODES,0)
- LCID=LIDS
- ELSE
- LLID=LQ(LCDIR-5)
- CALL MZBOOK(IHDIV,LCID,LLID, 0,'HIDE',NL,NL,NWID,IODES,0)
- ENDIF
- DO 40 I=1,NWID
- IQ(LCID+I)=IHEAD(I,IHIST)
- 40 CONTINUE
- LQ(LCDIR-5)=LCID
- IQ(LCID-5)=ID
- IQ(LTAB+IDPOS)=ID
- LQ(LTAB-IDPOS)=LCID
- NRHIST=NRHIST+1
- IQ(LCDIR+KNRH)=NRHIST
-*
-* 1-DIM case
-*
- IF(I1.NE.0)THEN
- IF(NBPROX.GE.32)THEN
- IODES=IOCF1
- ELSE
- IODES=IOCB1
- ENDIF
- CALL MZBOOK(IHDIV,LCONT,LCID,-1,'HCON',2,2,NW,IODES,0)
- call Net_Copy(jcont+1,nw,iq(lcont+1),istat)
- if(istat.ne.0)return
- IF(JR1.NE.0)THEN
- call Net_Copy(jr1-1,1,nw,istat)
- if(istat.ne.0)return
- CALL MZBOOK(IHDIV,LR1,LCONT,0,'HI1E',0,0,NW,3,0)
- call Net_Copy(jr1+1,nw,iq(lr1+1),istat)
- if(istat.ne.0)return
- call Net_Copy(klq+jr1,1,jr2,istat)
- if(istat.ne.0)return
- IF(JR2.NE.0)THEN
- call Net_Copy(jr2-1,1,nw,istat)
- if(istat.ne.0)return
- CALL MZBOOK(IHDIV,LR2,LR1,0,'HI1N',0,0,NW,3,0)
- call Net_Copy(jr2+1,nw,iq(lr2+1),istat)
- if(istat.ne.0)return
- ENDIF
- ENDIF
- GO TO 99
- ENDIF
-*
-* 2-DIM case
-*
- IF(NBPROX.GE.32)THEN
- IODES=IOCF2
- ELSE
- IODES=IOCB2
- ENDIF
- CALL MZBOOK(IHDIV,LCONT,LCID,-1,'HCON',0,0,NW,IODES,0)
- call Net_Copy(jcont+1,nw,iq(lcont+1),istat)
- go to 99
-*
-* Error
-*
- 90 istat=1
- 99 RETURN
- END
-
-#endif
diff --git a/src/packlib/cspack/programs/zs/nettab.F b/src/packlib/cspack/programs/zs/nettab.F
deleted file mode 100644
index d924164..0000000
--- a/src/packlib/cspack/programs/zs/nettab.F
+++ /dev/null
@@ -1,44 +0,0 @@
-*
-* $Id: nettab.F,v 1.1.1.1 1996/03/08 15:44:21 mclareni Exp $
-*
-* $Log: nettab.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:21 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
-#if defined(CERNLIB_OS9)
- SUBROUTINE Net_HTAB(chcpu,chmod,istat)
-*.==========>
-*. To copy the histogram address table from
-*. (CPU,Module) to server memory
-*. IADPAWD is the absolute address of /PAWC/ in node
-*. =net_mad(cpu,module)
-*..=========> ( R.Brun)
-*
-#include "cspack/hos9c.inc"
- CHARACTER*20 chcpu,chmod
- parameter (knrh=6)
- parameter (klq =-8)
-*.___________________________________________
-*
-* lcdir=lq(1) = iq(klq+1)
-* ltab =lq(lcdir-3) = iq(klq+lcdir-3)
-*
- istat=0
- cpu=chcpu
- module=chmod
- iadpawd=net_mad(cpu,module)
- if(iadpawd.eq.-1)go to 90
-*
-* Copy address table,list of IDs and headers
-*
- nhist= Net_Hlink(cpu,module,ihead)
- if(nhist.ne.-1)go to 99
-*
- 90 nhist=-1
- istat=1
-*
- 99 RETURN
- END
-#endif
diff --git a/src/packlib/cspack/programs/zs/sgeta.F b/src/packlib/cspack/programs/zs/sgeta.F
deleted file mode 100644
index e425c0b..0000000
--- a/src/packlib/cspack/programs/zs/sgeta.F
+++ /dev/null
@@ -1,202 +0,0 @@
-*
-* $Id: sgeta.F,v 1.2 1996/04/11 14:54:07 cernlib Exp $
-*
-* $Log: sgeta.F,v $
-* Revision 1.2 1996/04/11 14:54:07 cernlib
-* Zserv/pawserv used to be build from two patches; these were put both into this
-* directory.
-* The #includes in all files copied from the other directory had to updated.
-*
-* Revision 1.1.1.1 1996/03/08 15:44:20 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE SGETA(CHF)
-*
-* Transfer a text file to client
-*
-#include "hbook/hcmail.inc"
-#include "cspack/czsock.inc"
-#include "cspack/czbuff.inc"
-#include "cspack/czunit.inc"
- CHARACTER*(*) CHF
- CHARACTER*8 CHOPT
- CHARACTER*255 CHLINE
- CHARACTER*80 CHFILE
- CHARACTER*80 REMOTE,LOCAL
- CHARACTER*3077 CHLEN
-* CHARACTER*2053 CHLEN
- DIMENSION NCC(1024)
- INTEGER SSENDSTR
- DATA NCC/1024*-1/
-*
-*
-* Open file on server
-*
- IOPTV=0
- LRECL=255
- IMAX = 16320
- IF(IPROT.EQ.1) IMAX = 512
- LCHF = LENOCC(CHF)
- LBLNK = INDEX(CHF(1:LCHF),' ')
- IF(LBLNK.NE.0) THEN
- CHFILE = CHF(1:LBLNK-1)
- CHOPT = CHF(LBLNK+1:LCHF)
- LFILE = LBLNK-1
- ELSE
- CHFILE = CHF(1:LCHF)
- CHOPT = ' '
- LFILE = LCHF
- ENDIF
-#if defined(CERNLIB_UNIX)
- IF(INDEX(CHOPT,'C').EQ.0) CALL CUTOL(CHFILE)
-#endif
-#if (defined(CERNLIB_UNIX))&&(!defined(CERNLIB_APOLLO))&&(!defined(CERNLIB_OS9))
- OPEN(UNIT=LUNXZI,FILE=CHFILE,STATUS='OLD',IOSTAT=ISTAT)
-#endif
-#if defined(CERNLIB_APOLLO)||defined(CERNLIB_OS9)
- OPEN(UNIT=LUNXZI,FILE=CHFILE,STATUS='READONLY',
- + IOSTAT=ISTAT)
-#endif
-#if defined(CERNLIB_VAXVMS)
- OPEN(UNIT=LUNXZI,FILE=CHFILE,STATUS='OLD',READONLY,IOSTAT=ISTAT)
-#endif
-#if defined(CERNLIB_IBMMVS)
- CALL SZOPEN(LUNXZI,CHFILE,LRECL,'IF',ISTAT)
-#endif
-#if defined(CERNLIB_IBMVM)
- CHFILE='/'//CHF(1:LFILE)
- NCH=LENOCC(CHFILE)
- DO 5 I=1,NCH
- IF(CHFILE(I:I).EQ.'.')CHFILE(I:I)=' '
- 5 CONTINUE
- CALL FILEINF(IC,'RECFM','U')
- OPEN(UNIT=LUNXZI,FILE=CHFILE,STATUS='OLD',IOSTAT=ISTAT,
- + FORM='UNFORMATTED')
-
-#endif
-*
-* Inform client if file is opened
-*
- IF(ISTAT.NE.0)LRECL=0
- CHMAIL=' '
- WRITE(CHMAIL,'(I10)')LRECL
- CALL CZPUTA(CHMAIL,ISTAT)
- IF(ISTAT.NE.0)GOTO 99
- IF(LRECL.EQ.0)GOTO 99
-*
-* Check if client has opened his file
-*
- CALL CZGETA(CHMAIL,ISTAT)
- IF(ISTAT.NE.0)GOTO 99
- IF(CHMAIL(1:2).NE.'OK')GOTO 99
-*
-* Start transfer
-*
- IEND = 0
- 10 NLINES = 1
- NTOT = 0
- I1 = 1
- ICONT = 0
- 20 CONTINUE
-#if defined(CERNLIB_IBMVM)
- READ(LUNXZI,NUM=NCH,END=50)CHLINE
-#endif
-#if !defined(CERNLIB_IBMVM)
- READ(LUNXZI,'(A)',END=50,ERR=50)CHLINE
- NCH=LENOCC(CHLINE)
-#endif
-*
-* Do we have room for this record in the current buffer?
-*
- IF(I1+NCH-1.GT.IMAX) THEN
- ICONT = 1
- IF(NLINES.LE.1024)NCC(NLINES)=-1
- GOTO 30
- ENDIF
-
- IF(NCH.EQ.0)THEN
- NCC(NLINES)=0
- ELSE
- NCC(NLINES)=NCH
- I2=I1+NCH-1
- CHBUF(I1:I2)=CHLINE
- I1=I2+1
- NTOT=NTOT+NCH
- ENDIF
- IF(I1+NCH-1.GT.IMAX)THEN
- IF(NLINES.LT.1024)NCC(NLINES+1)=-1
- GOTO 30
- ENDIF
- NLINES=NLINES+1
- IF(NLINES.LE.1024) GOTO 20
-*
-#if (!defined(CERNLIB_CRAY))&&(!defined(CERNLIB_CONVEX))
- 30 WRITE(CHLEN,1000)NTOT,NCC
- 1000 FORMAT(I5,4I3,255I3,255I3,255I3,255I3)
-#endif
-#if defined(CERNLIB_CRAY)||defined(CERNLIB_CONVEX)
- 30 WRITE(CHLEN(1:5),1000)NTOT
- 1000 FORMAT(I5)
- IOFF = 6
- JOFF = 1
- DO 11 II=1,8
- WRITE(CHLEN(IOFF:IOFF+95),'(32I3)') (NCC(JJ),JJ=JOFF,JOFF+31)
- IOFF = IOFF + 96
- JOFF = JOFF + 32
-11 CONTINUE
-#endif
- NTOTAL = 3077
-* NTOTAL = 2053
-#if defined(CERNLIB_DECNET)
-*
-* DECnet...
-*
- IF(IPROT.EQ.1) THEN
- CALL CZDPTS(CHLEN,NTOTAL,ISTAT)
- IF(ISTAT.NE.0) GOTO 99
- ELSE
-#endif
-#if !defined(CERNLIB_IBM)||defined(CERNLIB_TCPSOCK)
-*
-* TCP/IP (with socket library)
-*
- NBYTES=SSENDSTR(ISKOUT,CHLEN,NTOTAL)
-#endif
-#if (defined(CERNLIB_IBM))&&(!defined(CERNLIB_TCPSOCK))
-*
-* TCP/IP on IBM without socket library->PASCAL version of TCPAW
-*
- CALL SSEND(ISKOUT,CHLEN,NTOTAL,NBYTES)
- IF(NBYTES.LT.NTOTAL) GOTO 99
-#endif
-#if defined(CERNLIB_DECNET)
- ENDIF
-#endif
-
- CALL CZPUTC(NTOT,ISTAT)
-* IF(ISTAT.NE.0)GOTO 99
-*
-* Still a record in the current buffer?
-*
- IF(ICONT.NE.0) THEN
- ICONT = 0
- NCC(1) = NCH
- CHBUF(1:NCH) = CHLINE
- I1 = NCH + 1
- NTOT = NCH
- NLINES = 2
- GOTO 20
- ENDIF
-
- IF(IEND.EQ.0)GOTO 10
-*
- CLOSE(LUNXZI)
- GOTO 99
-*
- 50 IEND=1
- NCC(NLINES)=-2
- GOTO 30
-*
- 99 END
diff --git a/src/packlib/cspack/programs/zs/sgetfz.F b/src/packlib/cspack/programs/zs/sgetfz.F
deleted file mode 100644
index 509039f..0000000
--- a/src/packlib/cspack/programs/zs/sgetfz.F
+++ /dev/null
@@ -1,179 +0,0 @@
-*
-* $Id: sgetfz.F,v 1.5 1998/09/25 09:24:19 mclareni Exp $
-*
-* $Log: sgetfz.F,v $
-* Revision 1.5 1998/09/25 09:24:19 mclareni
-* Modifications for the Mklinux port flagged by CERNLIB_PPC
-*
-* Revision 1.4 1997/09/02 08:46:15 mclareni
-* WINNT mods, mostly cpp defines
-*
-* Revision 1.3 1997/01/17 08:56:10 gunter
-* call vxinvb for linux too.
-*
-* Revision 1.2 1996/04/11 14:54:10 cernlib
-* Zserv/pawserv used to be build from two patches; these were put both into this
-* directory.
-* The #includes in all files copied from the other directory had to updated.
-*
-* Revision 1.1.1.1 1996/03/08 15:44:20 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE SGETFZ(CHF)
-*
-* Transfer a FZ file to the client
-*
-#include "cspack/czsock.inc"
-#include "cspack/czunit.inc"
-#include "hbook/hcmail.inc"
-#include "zebra/quest.inc"
-#include "cspack/pawc.inc"
- PARAMETER (JBIAS=2)
- CHARACTER*(*) CHF
- CHARACTER*64 REMOTE
- CHARACTER*4 RFORM
- CHARACTER*4 CHOPT,CHOPO
- DIMENSION IUHEAD(400)
- DIMENSION IOCR(400)
- INTEGER RRECL
-#if defined(CERNLIB_IBMVM)
- CHARACTER*255 CHTEMP,CHFILE
-#endif
- DIMENSION ITEST(5)
-
-#if defined(CERNLIB_IPSC)
- DATA IPATT/'0123CDEF'X/
-#endif
-#if defined(CERNLIB_DECS) || defined(CERNLIB_LINUX) || defined(CERNLIB_WINNT)
- DATA IPATT/X'0123CDEF'/
-#endif
-#if defined(CERNLIB_VAXVMS)
- DATA IPATT/Z0123CDEF/
-#endif
-*
- JB = INDEX(CHF,' ') - 1
- JE = LENOCC(CHF)
- REMOTE = CHF(1:JB)
- READ(CHF(JB+2:JE),'(I6,A4)') RRECL,RFORM
- CHOPT = 'VI'
- IF(INDEX(RFORM,'A').NE.0) CHOPT = 'FI'
- IF(INDEX(RFORM,'D').NE.0) CHOPT = 'DI'
- IF(INDEX(RFORM,'V').NE.0) CHOPT = 'VI'
- IF(INDEX(RFORM,'C').NE.0) CHOPT(3:3) = 'C'
-#if defined(CERNLIB_IBMVM)
-*
-* Get file information
-*
- CHTEMP = REMOTE(1:JB)
- CALL CTRANS('.',' ',CHTEMP,1,JB)
- CALL VMQFIL(CHTEMP(1:JB),RECFM,LBLK,NRECS,
- + NBLOCKS,CHTIME,ISTAT,IRC)
-*
-* Get file mode
-*
- INQUIRE(FILE='/'//CHTEMP(1:JB),NAME=CHFILE)
- LCHF = LENOCC(CHFILE)
-*
-* OS simulation? Assume VBS...
-*
- IF(CHFILE(LCHF:LCHF).EQ.'4') THEN
- WRITE(CHFILE,9002) LUNXZI,CHTEMP(1:JB),LBLK
-9002 FORMAT('FILEDEF ',I2,' DISK ',A,
- + ' (RECFM VBS LRECL 32756 BLOCK ',I6)
- LCHF = LENOCC(CHFILE)
- CALL VMCMS(CHFILE(1:LCHF),IRC)
- OPEN(LUNXZI,STATUS='OLD',FORM='UNFORMATTED',IOSTAT=IRC)
- ELSE
- CALL SZOPEN(LUNXZI,REMOTE(1:JB),RRECL,CHOPT,IRC)
- ENDIF
-#endif
-#if !defined(CERNLIB_IBMVM)
- CALL SZOPEN(LUNXZI,REMOTE(1:JB),RRECL,CHOPT,IRC)
-#endif
-
- IF(RFORM(1:1).EQ.'Z') RFORM = ' '
- LENR = LENOCC(RFORM)
- IF((INDEX(RFORM(1:LENR),'X').NE.0).AND.(RRECL.EQ.0)) THEN
-*
-* Get record length from file
-*
- IF(INDEX(CHOPT,'D').EQ.0) THEN
- READ(2) ITEST
- REWIND(2)
- ELSE
- READ(LUNXZI,REC=1) ITEST
- ENDIF
-#if defined(CERNLIB_VAX)||defined(CERNLIB_DECS) || (defined(CERNLIB_LINUX) && !defined(CERNLIB_PPC)) || defined(CERNLIB_WINNT)
- IF(ITEST(1).NE.IPATT) CALL VXINVB(ITEST(5),1)
-#endif
-#if !defined(CERNLIB_CRAY)
- RRECL = JBYT(ITEST(5),1,24) * 4
-#endif
-#if defined(CERNLIB_CRAY)
- RRECL = JBYT(ITEST(3),1,24) * 4
-#endif
- ENDIF
-
- CALL FZFILE(LUNXZI,RRECL/4,'F'//RFORM)
- IF(IQUEST(1).GT.1) IRC = IQUEST(1)
-*
-* Inform client if OPEN is ok
-*
-20 CONTINUE
- IF(IRC.NE.0) RRECL = -1
- WRITE(CHMAIL,'(I6)') RRECL
- CALL CZPUTA(CHMAIL,ISTAT)
- IF((ISTAT.NE.0).OR.(IRC.NE.0).OR.(RRECL.LT.0)) THEN
- CALL FZENDI(LUNXZI,'T')
- RETURN
- ENDIF
-*
-* Perform the transfer
-*
- 1 CONTINUE
- NUH = 400
- CALL FZIN(LUNXZI,IHDIV,LSUP,JBIAS,' ',NUH,IUHEAD)
- IF((IQUEST(1).LT.0).OR.(IQUEST(1).GE.4)) GOTO 2
- IF(IQUEST(1).EQ.0) THEN
- IEVENT = IQUEST(11)
- ENDIF
-*
-* start of run
-*
- IF(IQUEST(1).EQ.1) THEN
- CALL FZRUN(LUNFZO,IQUEST(11),NUH,IUHEAD)
- GOTO 1
-*
-* end of run
-*
- ELSEIF(IQUEST(1).EQ.2) THEN
- CALL FZRUN(LUNFZO,-1,NUH,IUHEAD)
- GOTO 1
-*
-* ZEBRA eof
-*
- ELSEIF(IQUEST(1).EQ.3) THEN
- CALL FZENDO(LUNFZO,'E')
- GOTO 2
- ENDIF
-
- CALL UCOPY(IQUEST(21),IOCR(1),MIN(IQUEST(20),100))
- CHOPO = 'L'
- IF(IQUEST(14).EQ.0) CHOPO = 'Z'
- CALL FZOUT(LUNFZO,IHDIV,LSUP,IEVENT,CHOPO,IOCR(1),NUH,IUHEAD)
- IF(CHOPO.EQ.'L') CALL MZDROP(IHDIV,LSUP,' ')
- GOTO 1
- 2 CONTINUE
- NUH = 1
- IUHEAD(1) = 999
- IEVENT = 1
- IOCR(1) = 2
- CALL FZOUT(LUNFZO,IHDIV,LSUP,IEVENT,'Z',IOCR(1),NUH,IUHEAD)
- CALL FZENDO(LUNFZO,'F')
- CALL FZENDI(LUNXZI,'T')
- CLOSE(LUNXZI)
-*
- 99 END
-
diff --git a/src/packlib/cspack/programs/zs/sgetp.F b/src/packlib/cspack/programs/zs/sgetp.F
deleted file mode 100644
index e8ffee3..0000000
--- a/src/packlib/cspack/programs/zs/sgetp.F
+++ /dev/null
@@ -1,143 +0,0 @@
-*
-* $Id: sgetp.F,v 1.5 1998/09/25 09:24:21 mclareni Exp $
-*
-* $Log: sgetp.F,v $
-* Revision 1.5 1998/09/25 09:24:21 mclareni
-* Modifications for the Mklinux port flagged by CERNLIB_PPC
-*
-* Revision 1.4 1997/09/02 08:46:15 mclareni
-* WINNT mods, mostly cpp defines
-*
-* Revision 1.3 1997/01/17 08:56:12 gunter
-* call vxinvb for linux too.
-*
-* Revision 1.2 1996/04/11 14:54:11 cernlib
-* Zserv/pawserv used to be build from two patches; these were put both into this
-* directory.
-* The #includes in all files copied from the other directory had to updated.
-*
-* Revision 1.1.1.1 1996/03/08 15:44:20 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE SGETP(CHF)
-*
-* Transfer a PAM file to the client
-*
-#include "hbook/hcmail.inc"
-#include "cspack/czsock.inc"
-#include "cspack/czbuff.inc"
- CHARACTER*4 CHOPT
- DIMENSION IA(512)
- DIMENSION IX(8)
- DIMENSION ICONTR(2)
- DIMENSION MPACK2(2),MPACK9(2)
- CHARACTER*12 NODE
- CHARACTER*8 DELTIM
-#include "cspack/czunit.inc"
- CHARACTER*(*) CHF
- CHARACTER*80 LOCAL
- DATA MPACK2 / 2, 16 /
- DATA MPACK9 / 9, 3 /
-*
- LCHF = LENOCC(CHF)
- LBLNK = INDEX(CHF(1:LCHF),' ')
- IF(LBLNK.NE.0) THEN
- LOCAL = CHF(1:LBLNK-1)
- CHOPT = CHF(LBLNK+1:LCHF)
- ELSE
- LOCAL = CHF(1:LCHF)
- CHOPT = ' '
- ENDIF
-*
-* Open local file
-*
- CHMAIL='OK'
- LRECL = 2048
- IF(INDEX(CHOPT,'C').EQ.0) THEN
- CALL SZOPEN(LUNXZI,LOCAL,LRECL,'IP',ISTAT)
- ELSE
- CALL SZOPEN(LUNXZI,LOCAL,LRECL,'IPC',ISTAT)
- ENDIF
- IF(ISTAT.NE.0)GO TO 95
-*
-* Inform client if file opened on local node
-*
-50 CALL CZPUTA(CHMAIL,ISTAT)
- IF(ISTAT.NE.0)GO TO 99
- IF(CHMAIL.EQ.'KO')GO TO 99
-*
-* Start transfer
-*
- NREC = 0
- NWOR = 0
-1 CALL VBLANK(IA,512)
- NUM = 512
- READ(LUNXZI,END=2) NUM,(IA(I),I=1,NUM)
- IF(NUM.EQ.0) GOTO 2
- NWOR = NWOR + NUM
- NREC = NREC + 1
-#if defined(CERNLIB_IBM)
-*
-* Translate look-ahead name
-*
- CALL XZETOA(IA(1),8)
-#endif
- CALL UPKBYT(IA(3),1,IX(4),4,MPACK9)
- CALL UPKBYT(IA(3),1,IX,4,MPACK2)
-*
-* Loop over body of this record, splitting into lines
-*
- I = 4
- LENX = 1
- IF(IX(5).NE.0) THEN
- I = IX(7)
- LENX = IX(7) - 3
- ENDIF
-#if defined(CERNLIB_VAXVMS)||defined(CERNLIB_DECS) || (defined(CERNLIB_LINUX) && !defined(CERNLIB_PPC)) || defined(CERNLIB_WINNT)
-*
-* Byte swap index vector
-*
- CALL VXINVB(IA(3),LENX)
-#endif
-*
-* Send #words to read
-*
- WRITE(CHMAIL,'(I3)') NUM
- CALL CZPUTA(CHMAIL,ISTAT)
- IF(ISTAT.NE.0) GOTO 97
-#if defined(CERNLIB_IBM)
-*
-* Translate text
-*
- CALL XZETOA(IA(I),(NUM-I+1)*4)
-#endif
-*
-* Send data to client
-*
- LBUF = NUM
- ICONTR(1) = 1
- ICONTR(2) = LBUF
- CALL CZTCP(IA,ICONTR)
-
- GOTO 1
-*
-2 CONTINUE
-
- NUM = -1
- WRITE(CHMAIL,'(I3)') NUM
- CALL CZPUTA(CHMAIL,ISTAT)
- IF(ISTAT.NE.0) GOTO 97
-
- CLOSE(LUNXZI)
- GO TO 99
-*
-* Error
-*
- 95 CHMAIL = 'KO'
- GO TO 50
- 97 CLOSE(LUNXZI)
-*
- 99 LBUF = 270
- END
diff --git a/src/packlib/cspack/programs/zs/sgetrz.F b/src/packlib/cspack/programs/zs/sgetrz.F
deleted file mode 100644
index cb7a3f3..0000000
--- a/src/packlib/cspack/programs/zs/sgetrz.F
+++ /dev/null
@@ -1,197 +0,0 @@
-*
-* $Id: sgetrz.F,v 1.2 1996/04/11 14:54:13 cernlib Exp $
-*
-* $Log: sgetrz.F,v $
-* Revision 1.2 1996/04/11 14:54:13 cernlib
-* Zserv/pawserv used to be build from two patches; these were put both into this
-* directory.
-* The #includes in all files copied from the other directory had to updated.
-*
-* Revision 1.1.1.1 1996/03/08 15:44:20 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE SGETRZ(CHF)
-*
-* Transfer a RZ file to the client
-*
-#include "hbook/hcmail.inc"
-#include "cspack/czsock.inc"
-#include "cspack/czunit.inc"
-#include "cspack/pawc.inc"
- DIMENSION IQ(2),Q(2),LQ(8000)
- EQUIVALENCE (LQ(1),LMAIN),(IQ(1),LQ(9)),(Q(1),IQ(1))
-C
-#include "zebra/rzclun.inc"
- COMMON /RZCL/ LTOP,LRZ0,LCDIR,LRIN,LROUT,LFREE,LUSED,LPURG
- +, LTEMP,LCORD,LFROM
- COMMON/QUEST/IQUEST(100)
- CHARACTER*12 CHDATE
- CHARACTER*(*) CHF
- CHARACTER*8 CHTAG(100)
- CHARACTER*80 CHFILE
- CHARACTER*90 CHFORM
- CHARACTER*4 CHOPT,CHOPE,CHOPR
- DIMENSION IHTAG(2)
- DIMENSION ITEST(50)
- PARAMETER (KUP=5,KPW1=7,KNCH=9,KDATEC=10,KDATEM=11,KQUOTA=12,
- + KRUSED=13,KWUSED=14,KMEGA=15,KIRIN=17,KIROUT=18,
- + KRLOUT=19,KIP1=20,KNFREE=22,KNSD=23,KLD=24,KLB=25,
- + KLS=26,KLK=27,KLF=28,KLC=29,KLE=30,KNKEYS=31,
- + KNWKEY=32,KKDES=33,KNSIZE=253,KEX=6,KNMAX=100)
-*
-*_______________________________________
-*
-*
-* Open RZ file
-*
- IQUEST(1)=0
- IOPEN=0
-*
-* Get file name and options
-*
- LF = LENOCC(CHF)
- LB = INDEX(CHF(1:LF),' ')
- IF(LB.NE.0) THEN
- CHFILE=CHF(1:LB-1)
- CHOPT = CHF(LB+1:LF)
- ELSE
- CHFILE=CHF(1:LF)
- CHOPT = ' '
- ENDIF
- NREC = 0
- NWKEY = 0
- CHFORM = ' '
- LRECL = 128
- LRECL = 0
- IDATEC = 0
- IDATEM = 0
- CHOPE = ' '
- CHOPR = ' '
- LCHOPE = 1
-
- IF(INDEX(CHOPT,'C').NE.0) THEN
- CHOPE = 'P'
- LCHOPE = LCHOPE + 1
- ENDIF
-*
-* Existing file is in exchange mode (force)
-*
- IF(INDEX(CHOPT,'E').NE.0) THEN
- CHOPE(LCHOPE:LCHOPE) = 'X'
- CHOPR = 'X'
- ENDIF
-
- CALL RZOPEN(LUNXZI,'RZ',CHFILE,CHOPE,LRECL,ISTAT)
-*
-* Cannot open file - send NWKEY = 0 to client to indicate trouble
-*
- IF(ISTAT.NE.0) THEN
- CHMAIL=' '
- WRITE(CHMAIL,1000)NWKEY,NREC,LRECL,IDATEC,IDATEM
- CALL CZPUTA(CHMAIL,ISTAT)
- IF(ISTAT.NE.0)GO TO 90
- CALL CZPUTA(CHFORM,ISTAT)
- GO TO 90
- ENDIF
-
- CALL RZFILE(LUNXZI,'RZ',CHOPR)
- IF(IQUEST(1).NE.0)THEN
-*
-* Cannot issue RZFILE - send NWKEY = 0 to client to indicate trouble
-*
- CLOSE(LUNXZI)
- CHMAIL=' '
- WRITE(CHMAIL,1000)NWKEY,NREC,LRECL,IDATEC,IDATEM
- CALL CZPUTA(CHMAIL,ISTAT)
- IF(ISTAT.NE.0)GO TO 90
- CALL CZPUTA(CHFORM,ISTAT)
- GO TO 90
- ENDIF
-
- IOPEN = 1
- NREC = IQ(LCDIR+KQUOTA)
- NWKEY = IQ(LCDIR+KNWKEY)
- KTAGS = KKDES+(NWKEY-1)/10+1
- LB = IQ(LCDIR+KLB)
- LRECL = IQ(LCDIR+LB+1)
- IDATEC = IQ(LCDIR+KDATEC)
- IDATEM = IQ(LCDIR+KDATEM)
- CHMAIL=' '
-*
-* Test if this file is in exchange mode
-*
-* CALL RZIODO(LUNXZI,50,2,ITEST,1)
-*SELF,IF=VAX,DECS.
-* IMODEX = IOR(ITEST(6),0)
-*SELF,IF=-VAX,IF=-DECS.
-* IMODEX = ITEST(6)
-*SELF.
-*
-#if defined(CERNLIB_UNIX)
- IF(INDEX(CHOPT,'X').NE.0) THEN
-#endif
-#if !defined(CERNLIB_UNIX)
- IF((IMODEX.NE.0).AND.(INDEX(CHOPT,'N').EQ.0)) THEN
-#endif
-*
-* Set NWKEY to indicate that this is an exchange mode transfer
-*
- NWKEY = -1
- WRITE(CHMAIL,1000)NWKEY,NREC,LRECL,IDATEC,IDATEM
- CALL CZPUTA(CHMAIL,ISTAT)
- IF(ISTAT.NE.0)GO TO 90
-*
-* Now transfer the file - the transfer will be driven by the
-* client using XZGETD.
-*
- ELSE
-
- DO 10 I=1,NWKEY
- CALL ZITOH(IQ(LCDIR+KTAGS+2*I-2),IHTAG,2)
- CALL UHTOC(IHTAG,4,CHTAG(I),8)
- IKDES=(I-1)/10
- IKBIT1=3*I-30*IKDES-2
- IFORM=JBYT(IQ(LCDIR+KKDES+IKDES),IKBIT1,3)
- IF(IFORM.EQ.3)THEN
- CHFORM(I:I)='H'
- ELSEIF(IFORM.EQ.4) THEN
- CHFORM(I:I)='A'
- ELSEIF(IFORM.EQ.1) THEN
- CHFORM(I:I)='B'
- ELSE
- CHFORM(I:I)='I'
- ENDIF
- 10 CONTINUE
- 20 CHMAIL=' '
- WRITE(CHMAIL,1000)NWKEY,NREC,LRECL,IDATEC,IDATEM
- 1000 FORMAT(5I10)
- CALL CZPUTA(CHMAIL,ISTAT)
- IF(ISTAT.NE.0)GO TO 90
- CALL CZPUTA(CHFORM,ISTAT)
- IF(ISTAT.NE.0)GO TO 90
- IF(NWKEY.EQ.0)GO TO 90
- DO 30 I=1,NWKEY
- CHMAIL=CHTAG(I)
- CALL CZPUTA(CHMAIL,ISTAT)
- IF(ISTAT.NE.0)GO TO 90
- 30 CONTINUE
-*
-* Verify that RZ file has been opened by client
-*
- CALL CZGETA(CHMAIL,ISTAT)
- IF(ISTAT.NE.0)GO TO 90
- IF(CHMAIL(1:2).NE.'OK')GO TO 90
-*
-* Now transfer the file
-*
- CALL RZTOFZ(LUNFZO,'C')
-
- ENDIF
-*
- 90 IF(IOPEN.EQ.0)GO TO 99
- CALL RZEND('RZ')
- CLOSE(LUNXZI)
-*
- 99 END
diff --git a/src/packlib/cspack/programs/zs/sppiaf.F b/src/packlib/cspack/programs/zs/sppiaf.F
deleted file mode 100644
index 7f3b451..0000000
--- a/src/packlib/cspack/programs/zs/sppiaf.F
+++ /dev/null
@@ -1,78 +0,0 @@
-*
-* $Id: sppiaf.F,v 1.2 1996/04/11 14:54:13 cernlib Exp $
-*
-* $Log: sppiaf.F,v $
-* Revision 1.2 1996/04/11 14:54:13 cernlib
-* Zserv/pawserv used to be build from two patches; these were put both into this
-* directory.
-* The #includes in all files copied from the other directory had to updated.
-*
-* Revision 1.1.1.1 1996/03/08 15:44:21 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
-#if defined(CERNLIB_UNIX)
- SUBROUTINE SPPIAF(CHF)
-*
-* Transfer a RZ file from the client
-*
-#include "hbook/hcmail.inc"
-#include "cspack/czunit.inc"
- COMMON/QUEST/IQUEST(100)
-#include "cspack/pawc.inc"
- DIMENSION IQ(2),Q(2),LQ(8000)
- EQUIVALENCE (LQ(1),LMAIN),(IQ(1),LQ(9)),(Q(1),IQ(1))
- CHARACTER*(*) CHF
- CHARACTER*80 LOCAL
- CHARACTER*20 CHOPT
- CHARACTER*20 CHUSER,CHGRP
- INTEGER SYSTEMF
-*
-* Get file parameters from client
-*
- READ(CHF,'(I6)') ISIZE
-
- LEND = LENOCC(CHF)
- LBLA = INDEX(CHF(7:LEND),' ')
- IF(LBLA.EQ.0) THEN
- LCHF = LEND
- CHOPT = ' '
- ELSE
- CHOPT = CHF(LBLA+7:LEND)
- LCHF = LBLA + 5
- ENDIF
-
- LOCAL = CHF(7:LCHF)
- LLOCAL = LCHF - 6
-
-*
-* Get group and usernames
-*
- ISLASH = INDEX(LOCAL,'/')
- CHGRP = LOCAL(2:ISLASH)
- LGRP = ISLASH - 2
-
- JSLASH = INDEX(LOCAL(ISLASH+1:),'/')
- CHUSER = LOCAL(ISLASH+1:ISLASH+JSLASH-1)
- LUSER = JSLASH - 1
-
- LPATH = INDEXB(LOCAL(1:LLOCAL),'/')
-*
-* Issue SFGET to create local file and assign symbolic link
-*
- CALL SSFGET(CHGRP(1:LGRP),CHUSER(1:LUSER),
- + LOCAL(1:LPATH-1),LOCAL(LPATH+1:LLOCAL),
- + IMODE,ISIZE,CHOPT,IRC)
- IF(IRC.NE.0) THEN
- WRITE(CHMAIL,9001) IRC
-9001 FORMAT('3Cannot open remote file - return code ',
- + I6,' from SFGET')
- CALL CZPUTA(CHMAIL,ISTAT)
- GOTO 99
- ELSE
- CALL CZPUTA('0OK',ISTAT)
- ENDIF
-
- 99 END
-#endif
diff --git a/src/packlib/cspack/programs/zs/sputa.F b/src/packlib/cspack/programs/zs/sputa.F
deleted file mode 100644
index d973bfb..0000000
--- a/src/packlib/cspack/programs/zs/sputa.F
+++ /dev/null
@@ -1,165 +0,0 @@
-*
-* $Id: sputa.F,v 1.2 1996/04/11 14:54:14 cernlib Exp $
-*
-* $Log: sputa.F,v $
-* Revision 1.2 1996/04/11 14:54:14 cernlib
-* Zserv/pawserv used to be build from two patches; these were put both into this
-* directory.
-* The #includes in all files copied from the other directory had to updated.
-*
-* Revision 1.1.1.1 1996/03/08 15:44:20 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE SPUTA(CHF)
-*
-* Transfer a text file from client
-*
-#include "hbook/hcmail.inc"
-#include "cspack/czsock.inc"
-#include "cspack/czbuff.inc"
-#include "cspack/czunit.inc"
- CHARACTER*(*) CHF
- CHARACTER*4 CHOPT
- CHARACTER*4 OPT
- CHARACTER*80 LOCAL
- DIMENSION NCC(1024)
- CHARACTER*3077 CHLEN
- INTEGER SRECVSTR
-*
-*_______________________________________
-*
- IBL = INDEX(CHF,' ')
- LCHF = LENOCC(CHF)
- CHOPT = ' '
- IF(IBL.NE.0) THEN
-#if defined(CERNLIB_IBMVM)
- LOCAL = '/'//CHF(1:IBL-1)
-#endif
-#if !defined(CERNLIB_IBMVM)
- LOCAL = CHF(1:IBL-1)
-#endif
- IF(LCHF.GT.IBL) CHOPT = CHF(IBL+1:LCHF)
- ELSE
-#if defined(CERNLIB_IBMVM)
- LOCAL = '/'//CHF
-#endif
-#if !defined(CERNLIB_IBMVM)
- LOCAL = CHF
-#endif
- ENDIF
-*
-* Create local file
-*
- CHMAIL='OK'
-#if defined(CERNLIB_UNIX)
- IF(INDEX(CHOPT,'C').EQ.0) CALL CUTOL(LOCAL)
-#endif
-#if defined(CERNLIB_UNIX)
- OPEN(UNIT=LUNXZO,FILE=LOCAL,STATUS='UNKNOWN',IOSTAT=ISTAT)
-#endif
-#if defined(CERNLIB_VAXVMS)
- OPEN(UNIT=LUNXZO,FILE=LOCAL,STATUS='NEW',IOSTAT=ISTAT,
- + CARRIAGECONTROL='LIST')
-#endif
-#if defined(CERNLIB_IBMMVS)
- LRECL = 80
- OPT = 'OF'
- IF(INDEX(CHOPT,'V').NE.0) OPT = 'OFV'
- CALL SZOPEN(LUNXZO,LOCAL,LRECL,OPT,ISTAT)
-#endif
-#if defined(CERNLIB_IBMVM)
- NCH=LENOCC(LOCAL)
- DO 5 I=2,NCH
- IF(LOCAL(I:I).EQ.'.')LOCAL(I:I)=' '
- 5 CONTINUE
- IF(INDEX(CHOPT,'V').NE.0) THEN
- CALL FILEINF(IRC,'RECFM','U')
- ENDIF
- OPEN(UNIT=LUNXZO,FILE=LOCAL,STATUS='UNKNOWN',IOSTAT=ISTAT,
- + FORM='FORMATTED')
-#endif
- IF(ISTAT.NE.0)GO TO 95
-*
-* Inform client if file opened on local node
-*
- 50 CALL CZPUTA(CHMAIL,ISTAT)
- IF(ISTAT.NE.0)GO TO 99
- IF(CHMAIL.EQ.'KO')GO TO 99
-*
-* Transfer data
-*
- NR=0
-20 CONTINUE
- NMAX=3077
-#if defined(CERNLIB_DECNET)
-*
-* DECnet...
-*
- IF(IPROT.EQ.1) THEN
- CALL CZDGTS(CHLEN,NMAX,ISTAT)
- IF(ISTAT.NE.0) GOTO 99
- ELSE
-#endif
-#if !defined(CERNLIB_IBM)||defined(CERNLIB_TCPSOCK)
-*
-* TCP/IP (with socket library)
-*
- NBYTES=SRECVSTR(ISKIN,CHLEN,NMAX)
-#endif
-#if (defined(CERNLIB_IBM))&&(!defined(CERNLIB_TCPSOCK))
-*
-* TCP/IP on IBM without socket library->PASCAL version of TCPAW
-*
- CALL SRECV(ISKIN,CHLEN,NMAX,NBYTES)
- IF(NBYTES.LT.NMAX)GO TO 99
-#endif
-#if defined(CERNLIB_DECNET)
- ENDIF
-#endif
-#if (!defined(CERNLIB_CRAY))&&(!defined(CERNLIB_CONVEX))
- READ(CHLEN,2000)NTOT,NCC
- 2000 FORMAT(I5,4I3,255I3,255I3,255I3,255I3)
-#endif
-#if defined(CERNLIB_CRAY)||defined(CERNLIB_CONVEX)
- READ (CHLEN(1:5),2000)NTOT
- 2000 FORMAT(I5)
- IOFF = 6
- JOFF = 1
- DO 11 II=1,8
- READ (CHLEN(IOFF:IOFF+95),'(32I3)') (NCC(JJ),JJ=JOFF,JOFF+31)
- IOFF = IOFF + 96
- JOFF = JOFF + 32
-11 CONTINUE
-#endif
- IF(NTOT.LE.0)GO TO 40
-*
- CALL CZGETC(NTOT,ISTAT)
- IF(ISTAT.NE.0)GO TO 99
- NR=NR+NTOT
- I1=1
- DO 30 I=1,1024
- IF(NCC(I).LT.0)THEN
- IF(NCC(I).EQ.-2)GO TO 40
- GO TO 20
- ENDIF
- IF(NCC(I).EQ.0)THEN
- WRITE(LUNXZO,'(A)',ERR=99) ' '
- ELSE
- I2=I1+NCC(I)-1
- WRITE(LUNXZO,'(A)',ERR=99) CHBUF(I1:I2)
- I1=I2+1
- ENDIF
- 30 CONTINUE
- GO TO 20
-*
- 40 CONTINUE
- CLOSE(LUNXZO)
- GO TO 99
-*
- 95 CHMAIL='KO'
- GO TO 50
-*
- 99 END
-
diff --git a/src/packlib/cspack/programs/zs/sputfz.F b/src/packlib/cspack/programs/zs/sputfz.F
deleted file mode 100644
index bad9752..0000000
--- a/src/packlib/cspack/programs/zs/sputfz.F
+++ /dev/null
@@ -1,130 +0,0 @@
-*
-* $Id: sputfz.F,v 1.2 1996/04/11 14:54:15 cernlib Exp $
-*
-* $Log: sputfz.F,v $
-* Revision 1.2 1996/04/11 14:54:15 cernlib
-* Zserv/pawserv used to be build from two patches; these were put both into this
-* directory.
-* The #includes in all files copied from the other directory had to updated.
-*
-* Revision 1.1.1.1 1996/03/08 15:44:20 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE SPUTFZ(CHF)
-*
-* Transfer a FZ file from the client
-*
-#include "cspack/czsock.inc"
-#include "cspack/czunit.inc"
-#include "hbook/hcmail.inc"
-#include "zebra/quest.inc"
-#include "cspack/pawc.inc"
- PARAMETER (JBIAS=2)
- CHARACTER*(*) CHF
- CHARACTER*64 REMOTE
- CHARACTER*4 RFORM
- CHARACTER*4 CHOPT,CHOPO
- DIMENSION IOCR(100)
- DIMENSION IUHEAD(400)
- INTEGER RRECL
-#if defined(CERNLIB_IBMVM)
- CHARACTER*255 CHFILE,CHTEMP
-#endif
-*
- JB = INDEX(CHF,' ') - 1
- JE = LENOCC(CHF)
- REMOTE = CHF(1:JB)
- READ(CHF(JB+2:JE),'(I6,A4)') RRECL,RFORM
- NCHR = JB
-
- CHOPT = 'VON'
- IF(INDEX(RFORM,'A').NE.0) CHOPT = 'FON'
- IF(INDEX(RFORM,'D').NE.0) CHOPT = 'DON'
- IF(INDEX(RFORM,'V').NE.0) CHOPT = 'VON'
- IF(INDEX(RFORM,'V').NE.0) CHOPT(4:4) = 'C'
-#if defined(CERNLIB_IBMVM)
- LBLK = 16384
- IF(INDEX(RFORM,'Z').NE.0) THEN
- CHTEMP = REMOTE(1:NCHR)
- CALL CTRANS('.',' ',CHTEMP,1,NCHR)
- LASTB = INDEXB(CHTEMP(1:NCHR),' ')
- IF(INDEX(CHTEMP(1:NCHR),' ').EQ.LASTB) THEN
- CHTEMP(NCHR+1:NCHR+3) = ' A4'
- NCHT = NCHR + 3
- ELSE
- CHTEMP(LASTB+2:LASTB+2) = '4'
- NCHT = LASTB + 2
- ENDIF
- WRITE(CHFILE,9002) LUNXZO,CHTEMP(1:NCHT),LBLK
-9002 FORMAT('FILEDEF ',I2,' DISK ',A,
- + ' (RECFM VBS LRECL 32756 BLOCK ',I6,' PERM)')
- LCHF = LENOCC(CHFILE)
- CALL VMCMS(CHFILE(1:LCHF),IRC)
- OPEN(LUNXZO,STATUS='NEW',FORM='UNFORMATTED',IOSTAT=IRC)
- ELSE
- CALL SZOPEN(LUNXZO,REMOTE(1:NCHR),LRECL,CHOPT,IRC)
- ENDIF
-#endif
-#if !defined(CERNLIB_IBMVM)
- CALL SZOPEN(LUNXZO,REMOTE(1:NCHR),LRECL,CHOPT,IRC)
-#endif
-
- IF(RFORM(1:1).EQ.'Z') RFORM = ' '
- CALL FZFILE(LUNXZO,RRECL/4,'FO'//RFORM)
- IF(IQUEST(1).GT.1) IRC = IQUEST(1)
-*
-* Inform client if OPEN is ok
-*
- CHMAIL = 'OK'
- IF(IRC.NE.0) CHMAIL = 'KO'
- CALL CZPUTA(CHMAIL,ISTAT)
- IF((ISTAT.NE.0).OR.(IRC.NE.0)) THEN
- CALL FZENDO(LUNXZO,'T')
- RETURN
- ENDIF
-*
-* Perform the transfer
-*
- 1 CONTINUE
- NUH = 400
- CALL FZIN(LUNFZI,IHDIV,LSUP,JBIAS,' ',NUH,IUHEAD)
- IF((IQUEST(1).LT.0).OR.(IQUEST(1).GE.4)) GOTO 2
- IF(IQUEST(1).EQ.0) THEN
- IEVENT = IQUEST(11)
- IF((NUH.EQ.1).AND.(IUHEAD(1).EQ.999)
- + .AND.(IQUEST(14).EQ.0)) GOTO 2
- ENDIF
-*
-* start of run
-*
- IF(IQUEST(1).EQ.1) THEN
- CALL FZRUN(LUNXZO,IQUEST(11),NUH,IUHEAD)
- GOTO 1
-*
-* end of run
-*
- ELSEIF(IQUEST(1).EQ.2) THEN
- CALL FZRUN(LUNXZO,-1,NUH,IUHEAD)
- GOTO 1
-*
-* ZEBRA eof
-*
- ELSEIF(IQUEST(1).EQ.3) THEN
- CALL FZENDO(LUNXZO,'E')
- GOTO 2
- ENDIF
-
- CALL UCOPY(IQUEST(21),IOCR,MIN(IQUEST(20),100))
- CHOPO = 'L'
- IF(IQUEST(14).EQ.0) CHOPO = 'Z'
- CALL FZOUT(LUNXZO,IHDIV,LSUP,IEVENT,CHOPO,IOCR,NUH,IUHEAD)
- IF(CHOPO.EQ.'L') CALL MZDROP(IHDIV,LSUP,' ')
- GOTO 1
- 2 CONTINUE
- CALL FZENDO(LUNXZO,'T')
- CLOSE(LUNXZO)
-*
- 99 END
-
diff --git a/src/packlib/cspack/programs/zs/sputp.F b/src/packlib/cspack/programs/zs/sputp.F
deleted file mode 100644
index 76d36af..0000000
--- a/src/packlib/cspack/programs/zs/sputp.F
+++ /dev/null
@@ -1,127 +0,0 @@
-*
-* $Id: sputp.F,v 1.5 1998/09/25 09:24:24 mclareni Exp $
-*
-* $Log: sputp.F,v $
-* Revision 1.5 1998/09/25 09:24:24 mclareni
-* Modifications for the Mklinux port flagged by CERNLIB_PPC
-*
-* Revision 1.4 1997/09/02 08:46:16 mclareni
-* WINNT mods, mostly cpp defines
-*
-* Revision 1.3 1997/01/17 08:56:12 gunter
-* call vxinvb for linux too.
-*
-* Revision 1.2 1996/04/11 14:54:16 cernlib
-* Zserv/pawserv used to be build from two patches; these were put both into this
-* directory.
-* The #includes in all files copied from the other directory had to updated.
-*
-* Revision 1.1.1.1 1996/03/08 15:44:20 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE SPUTP(CHF)
-*
-* Transfer a PAM file from client
-*
-#include "hbook/hcmail.inc"
-#include "cspack/czsock.inc"
-#include "cspack/czbuff.inc"
-#include "cspack/czunit.inc"
- CHARACTER*(*) CHF
- CHARACTER*4 CHOPT
- CHARACTER*80 LOCAL
- DIMENSION IA(512)
- DIMENSION IB(2)
- DIMENSION ICONTR(2)
- DIMENSION IX(8)
- DIMENSION MPACK2(2),MPACK9(2)
- DATA MPACK2 / 2, 16 /
- DATA MPACK9 / 9, 3 /
-
-*
- LCHF = LENOCC(CHF)
- LBLNK = INDEX(CHF(1:LCHF),' ')
- IF(LBLNK.NE.0) THEN
- LOCAL = CHF(1:LBLNK-1)
- CHOPT = CHF(LBLNK+1:LCHF)
- ELSE
- LOCAL = CHF(1:LCHF)
- CHOPT = ' '
- ENDIF
-*
-* Create local file
-*
- CHMAIL='OK'
- LRECL = 2048
- IF(INDEX(CHOPT,'C').EQ.0) THEN
- CALL SZOPEN(LUNXZO,LOCAL,LRECL,'NOP',ISTAT)
- ELSE
- CALL SZOPEN(LUNXZO,LOCAL,LRECL,'NOPC',ISTAT)
- ENDIF
- IF(ISTAT.NE.0) GOTO 95
-*
-* Inform client if file opened on local node
-*
- 50 CALL CZPUTA(CHMAIL,ISTAT)
- IF(ISTAT.NE.0)GO TO 99
- IF(CHMAIL.EQ.'KO')GO TO 99
-*
-* Transfer data
-*
- 20 CONTINUE
- CALL CZGETA(CHMAIL,ISTAT)
- IF(ISTAT.NE.0) GOTO 99
-
- READ(CHMAIL,'(I3)') LBUF
- IF(LBUF.LT.0) GOTO 40
-
- ICONTR(1) = 0
- ICONTR(2) = LBUF
-
- CALL CZTCP(IA,ICONTR)
-#if defined(CERNLIB_IBM)
- CALL XZATOE(IA(1),8)
-#endif
-#if defined(CERNLIB_VAXVMS)||defined(CERNLIB_DECS) || (defined(CERNLIB_LINUX) && !defined(CERNLIB_PPC)) || defined(CERNLIB_WINNT)
- IB(1) = IA(3)
- IB(2) = IA(4)
- CALL VXINVB(IB(1),2)
- CALL UPKBYT(IB(1),1,IX(4),4,MPACK9)
- CALL UPKBYT(IB(1),1,IX,4,MPACK2)
- LENX = 1
- IF(IX(5).NE.0) LENX = IX(7) - 3
-*
-* Byte swap index vector
-*
- CALL VXINVB(IA(3),LENX)
-#endif
- CALL UPKBYT(IA(3),1,IX(4),4,MPACK9)
- CALL UPKBYT(IA(3),1,IX,4,MPACK2)
- I = 4
- LENX = 1
- IF(IX(5).NE.0) THEN
- I = IX(7)
- LENX = IX(7) - 3
- ENDIF
-#if defined(CERNLIB_IBM)
-*
-* Translate text
-*
- CALL XZATOE(IA(I),(LBUF-I+1)*4)
-#endif
- WRITE(LUNXZO) LBUF,(IA(I),I=1,LBUF)
-
- GOTO 20
-*
- 40 CONTINUE
- CLOSE(LUNXZO)
- GO TO 99
-*
- 95 CHMAIL='KO'
- GO TO 50
-*
- 99 LBUF = 270
- END
-
diff --git a/src/packlib/cspack/programs/zs/sputrz.F b/src/packlib/cspack/programs/zs/sputrz.F
deleted file mode 100644
index ae88cc4..0000000
--- a/src/packlib/cspack/programs/zs/sputrz.F
+++ /dev/null
@@ -1,125 +0,0 @@
-*
-* $Id: sputrz.F,v 1.2 1996/04/11 14:54:17 cernlib Exp $
-*
-* $Log: sputrz.F,v $
-* Revision 1.2 1996/04/11 14:54:17 cernlib
-* Zserv/pawserv used to be build from two patches; these were put both into this
-* directory.
-* The #includes in all files copied from the other directory had to updated.
-*
-* Revision 1.1.1.1 1996/03/08 15:44:20 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE SPUTRZ(CHF)
-*
-* Transfer a RZ file from the client
-*
-#include "hbook/hcmail.inc"
-#include "cspack/czunit.inc"
- COMMON/QUEST/IQUEST(100)
-#include "cspack/pawc.inc"
- DIMENSION IQ(2),Q(2),LQ(8000)
- EQUIVALENCE (LQ(1),LMAIN),(IQ(1),LQ(9)),(Q(1),IQ(1))
-#include "zebra/rzclun.inc"
- COMMON /RZCL/ LTOP,LRZ0,LCDIR,LRIN,LROUT,LFREE,LUSED,LPURG
- +, LTEMP,LCORD,LFROM
- PARAMETER (KUP=5,KPW1=7,KNCH=9,KDATEC=10,KDATEM=11,KQUOTA=12,
- + KRUSED=13,KWUSED=14,KMEGA=15,KIRIN=17,KIROUT=18,
- + KRLOUT=19,KIP1=20,KNFREE=22,KNSD=23,KLD=24,KLB=25,
- + KLS=26,KLK=27,KLF=28,KLC=29,KLE=30,KNKEYS=31,
- + KNWKEY=32,KKDES=33,KNSIZE=253,KEX=6,KNMAX=100)
- CHARACTER*(*) CHF
- CHARACTER*8 CHTAG(100)
- CHARACTER*8 CHRZ,CHOPE
- CHARACTER*80 LOCAL
- CHARACTER*90 CHFORM
-*
-*_______________________________________
-*
-* Get file parameters from client
-*
- LEND = LENOCC(CHF)
- LBLA = INDEX(CHF(1:LEND),' ')
- IF(LBLA.EQ.0) THEN
- LCHF = LEND
- CHRZ = ' '
- ELSE
- CHRZ = CHF(LBLA+1:LEND)
- LCHF = LBLA - 1
- ENDIF
-
- LOCAL=CHF(1:LCHF)
-
- CALL CZGETA(CHMAIL,ISTAT)
- IF(ISTAT.NE.0)GO TO 95
- READ(CHMAIL,1000,ERR=95)NWKEY,NREC,LRECL,IDATEC,IDATEM
- NREC = MIN(NREC,65000)
-*
-* Exchange mode transfer - will be performed by XZPUTD from client
-*
- IF(NWKEY.EQ.-1) GOTO 99
- CALL CZGETA(CHFORM,ISTAT)
- IF(ISTAT.NE.0)GO TO 95
- 1000 FORMAT(5I10)
- IF(NWKEY.EQ.0)GO TO 95
- DO 10 I=1,NWKEY
- CALL CZGETA(CHMAIL,ISTAT)
- IF(ISTAT.NE.0)GO TO 95
- CHTAG(I)=CHMAIL
- 10 CONTINUE
-*
-* Create local file
-*
- CHMAIL='OK'
-
- IF(INDEX(CHRZ,'L').NE.0) THEN
- CHOPE = 'LN'
- ELSE
- CHOPE = 'N'
- ENDIF
-
- IF(INDEX(CHRZ,'C').NE.0) THEN
- LCHOPE = LENOCC(CHOPE) + 1
- CHOPE(LCHOPE:LCHOPE) = 'P'
- ENDIF
-
- CALL RZOPEN(LUNXZO,'RZ',LOCAL,CHOPE,LRECL,ISTAT)
-
- IF(ISTAT.NE.0) GOTO 95
- IF(INDEX(CHRZ,'X').NE.0) THEN
- CALL RZMAKE(LUNXZO,'RZ',NWKEY,CHFORM,CHTAG,NREC,'X')
- ELSE
- CALL RZMAKE(LUNXZO,'RZ',NWKEY,CHFORM,CHTAG,NREC,' ')
- ENDIF
- IF(IQUEST(1).NE.0)GO TO 95
- IQ(LTOP+KDATEC)=IDATEC
- IQ(LTOP+KDATEM)=IDATEM
-*
-* Inform client if file opened on local node
-*
- 50 CALL CZPUTA(CHMAIL,ISTAT)
- IF(ISTAT.NE.0)GO TO 99
- IF(CHMAIL.EQ.'KO')GO TO 99
-*
-* Transfer data in RZ file
-*
- CALL RZFRFZ(LUNFZI,' ')
-*
-* Reset modification date
-*
- IQ(LTOP+KDATEC)=IDATEC
- IQ(LTOP+KDATEM)=IDATEM
- ISAVE = 2
- CALL RZSAVE
- CALL RZEND('RZ')
- CLOSE(LUNXZO)
- GO TO 99
-*
- 95 PRINT *,' Cannot open local file'
- CHMAIL='KO'
- GO TO 50
-*
- 99 END
-
diff --git a/src/packlib/cspack/programs/zs/ssfget.F b/src/packlib/cspack/programs/zs/ssfget.F
deleted file mode 100644
index a6a58e8..0000000
--- a/src/packlib/cspack/programs/zs/ssfget.F
+++ /dev/null
@@ -1,118 +0,0 @@
-*
-* $Id: ssfget.F,v 1.2 1996/04/11 14:54:19 cernlib Exp $
-*
-* $Log: ssfget.F,v $
-* Revision 1.2 1996/04/11 14:54:19 cernlib
-* Zserv/pawserv used to be build from two patches; these were put both into this
-* directory.
-* The #includes in all files copied from the other directory had to updated.
-*
-* Revision 1.1.1.1 1996/03/08 15:44:21 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
-#if defined(CERNLIB_UNIX)
- SUBROUTINE SSFGET(CHPOOL,CHUSER,CHPATH,CHFILE,IMODE,ISIZE,
- + CHOPT,IRC)
-*
-* Fortran interface to sfget
-*
-#include "cspack/slate.inc"
- CHARACTER*(*) CHPOOL,CHUSER,CHFILE,CHPATH,CHOPT
- CHARACTER*255 SHPOOL,SHUSER,SHFILE,SHPATH
- CHARACTER*255 SHCOMM,SHUNAM,SHFNAM
- CHARACTER*12 CHDATE
- CHARACTER*8 CHRAND
-
- INTEGER SYSTEMF
- INTEGER CHDIRF
-
- LOGICAL IEXIST
-
- IRC = 0
-
- LPOOL = LENOCC(CHPOOL)
- LUSER = LENOCC(CHUSER)
- LPATH = LENOCC(CHPATH)
- LFILE = LENOCC(CHFILE)
-
- SHPOOL = CHPOOL(1:LPOOL)
- SHUSER = CHUSER(1:LUSER)
- SHPATH = CHPATH(1:LPATH)
- SHFILE = CHFILE(1:LFILE)
-
-*
-* Check if link directory exists and create if necessary
-*
- CALL GETWDF(SHPOOL)
- LPOOL = IS(1)
-*
-* Send back current directory
-*
- CALL CZPUTA('1'//SHPOOL(1:LPOOL),ISTAT)
-
- INQUIRE(FILE=SHUSER(1:LUSER),
- + EXIST=IEXIST)
- IF(.NOT.IEXIST) THEN
- ISTAT = SYSTEMF('mkdir '//SHUSER(1:LUSER))
- CALL CZPUTA('2Creating link directory for user '//
- + SHUSER(1:LUSER),ISTAT)
- ENDIF
-*
-* Get temporary file name
-*
- 10 CONTINUE
- CALL DATIME(ID,IT)
- WRITE(CHDATE,'(I6.6,I4.4,I2.2)') ID,IT,IS(6)
- CALL CZRAND(CHRAND)
- SHUNAM = SHUSER(1:LUSER) // '.' // CHDATE // CHRAND
- LUNAM = LENOCC(SHUNAM)
- INQUIRE(FILE=SHUNAM(1:LUNAM),EXIST=IEXIST)
- IF(IEXIST) THEN
- IC = SLEEPF(1)
- GO TO 10
- ENDIF
-
-*
-* Issue SFGET to obtain full shift pathname
-*
- SHCOMM = ' '
-*
-* In case of one pool per experiment
-*
- WRITE(SHCOMM,9001) SHPOOL(1:LPOOL),SHUSER(1:LUSER),
- + SHFILE(1:LFILE),
- + SHUNAM(1:LUNAM)
- 9001 FORMAT('/usr/local/bin/sfget -link',A,'/',A,1X,A,
- + ' > ',A,' 2>&1')
- LCOMM = LENOCC(SHCOMM)
-
- ISTAT = SYSTEMF(SHCOMM(1:LCOMM))
-
-* IF(ISTAT.NE.0) CALL CZPUTA('2sfget failed',ISTAT)
-*
-* Now check if sfget was successful...
-*
- CALL CIOPEN(LUNPTR,'r',SHUNAM(1:LUNAM),IRC)
- SHFNAM = ' '
- CALL CIGET(LUNPTR,SHFNAM,255,NREAD,IRC)
- CALL CICLOS(LUNPTR)
- LFNAM = LENOCC(SHFNAM)
- LNEWL = INDEX(SHFNAM,CHAR(10))
- IF(LNEWL.NE.0) THEN
- SHFNAM(LFNAM:) = ' '
- LFNAM = LNEWL - 1
- ENDIF
-
- IF(SHFNAM(1:1).NE.'/') THEN
- CALL CZPUTA('2Error from sfget = '//SHFNAM(1:LFNAM),ISTAT)
- IRC = -1
- ENDIF
-*
-* Delete temporary file
-*
-* IRC = SYSTEMF('rm '//SHUNAM(1:LUNAM))
-
- 99 END
-#endif
diff --git a/src/packlib/cspack/programs/zs/xzserv.F b/src/packlib/cspack/programs/zs/xzserv.F
deleted file mode 100644
index 8ce8e2e..0000000
--- a/src/packlib/cspack/programs/zs/xzserv.F
+++ /dev/null
@@ -1,306 +0,0 @@
-*
-* $Id: xzserv.F,v 1.1.1.1 1996/03/08 15:44:21 mclareni Exp $
-*
-* $Log: xzserv.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:21 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE XZSERV(CHM)
-#include "cspack/hcmail.inc"
-#include "cspack/czsock.inc"
- DIMENSION ICONT(2)
-*
-* Steering routine for XZ client calls
-* This routine handles the communication between the client
-* and server routines, so that the server routines need make
-* no explicit calls to CZ
-*
- DIMENSION IBUFF(8192)
- CHARACTER*(*) CHM
- CHARACTER*80 FNAME
- CHARACTER*80 CHFORM,CHLINE
- CHARACTER*64 CHPATT
- CHARACTER*26 CHOPT
- CHARACTER*20 CHTOP
- CHARACTER*80 CHSRC,CHDST
-
- LCH = LENOCC(CHM)
-*
-* Handle OPEN, CLOSE, READ, WRITE, LS, CD, PWD, RM and INQUIRE
-*
-#if defined(CERNLIB_DEBUG)
- WRITE(LUNCZ,*) 'XZSERV. Enter for '//CHM(1:4)
-#endif
- IF(CHM(1:4).EQ.'READ') THEN
- READ(CHM(5:LCH),9001) LUN,NREC,NWANT
- CHMAIL = CHM
-#include "cspack/szchopt.inc"
-#if defined(CERNLIB_DEBUG)
- WRITE(LUNCZ,*) 'XZSERV. call SZREAD for LUN,NREC,NWANT,CHOPT = ',
- + LUN,NREC,NWANT,CHOPT
-#endif
- CALL SZREAD(LUN,IBUFF,NREC,NWANT,NGOT,CHOPT,IRC)
-9001 FORMAT(I3,I6,I6)
-#include "cspack/szmess.inc"
- IF(IRC.EQ.0) THEN
-*
-* Send the data
-*
- ICONT(1) = 1
- LBUF = NWANT/4
- CALL CZTCP(IBUFF,ICONT)
- ENDIF
-
- ELSEIF(CHM(1:4).EQ.'RITE') THEN
- READ(CHM(5:LCH),9001) LUN,NREC,NWRITE
- CHMAIL = CHM
-#include "cspack/szchopt.inc"
-*
-* Read data from network and write to file
-*
- ICONT(1) = 0
- LBUF = NWRITE/4
- CALL CZTCP(IBUFF,ICONT)
-#if defined(CERNLIB_DEBUG)
- WRITE(LUNCZ,*) 'XZSERV. call SZRITE for LUN,NREC,NWRITE,CHOPT = ',
- + LUN,NREC,NWRITE,CHOPT
-#endif
- CALL SZRITE(LUN,IBUFF,NREC,NWRITE,CHOPT,IRC)
-#include "cspack/szmess.inc"
-
- ELSEIF(CHM(1:4).EQ.'REDM') THEN
- READ(CHM(5:LCH),9003) LUN,NREC,NWANT,NDO
-9003 FORMAT(I3,I6,I6,I6)
- CHMAIL = CHM
-#include "cspack/szchopt.inc"
- IOPTD = INDEX(CHOPT,'D')
-
- DO 22 JJ=1,NDO
-#if defined(CERNLIB_DEBUG)
- WRITE(LUNCZ,*) 'XZSERV. call SZREAD for LUN,NREC,NWANT,CHOPT = ',
- + LUN,NREC,NWANT,CHOPT
-#endif
- CALL SZREAD(LUN,IBUFF,NREC,NWANT,NGOT,CHOPT,IRC)
-#include "cspack/szmess.inc"
- IF(IOPTD.NE.0) NREC = NREC + 1
- IF(IRC.EQ.0) THEN
-*
-* Send the data
-*
- ICONT(1) = 1
- LBUF = NWANT/4
- CALL CZTCP(IBUFF,ICONT)
- ENDIF
-
-22 CONTINUE
-
- ELSEIF(CHM(1:4).EQ.'RITM') THEN
- CHMAIL = CHM
- READ(CHM(5:LCH),9003) LUN,NREC,NWRITE,NDO
-#include "cspack/szchopt.inc"
- IOPTD = INDEX(CHOPT,'D')
-
- DO 33 JRITE=1,NDO
-*
-* Read data from network and write to file
-*
- ICONT(1) = 0
- LBUF = NWRITE/4
- CALL CZTCP(IBUFF,ICONT)
-#if defined(CERNLIB_DEBUG)
- WRITE(LUNCZ,*) 'XZSERV. call SZRITE for LUN,NREC,NWRITE,CHOPT = ',
- + LUN,NREC,NWRITE,CHOPT
-#endif
- CALL SZRITE(LUN,IBUFF,NREC,NWRITE,CHOPT,IRC)
- IF(IOPTD.NE.0) NREC = NREC + 1
-33 CONTINUE
-#include "cspack/szmess.inc"
-
- ELSEIF(CHM(1:4).EQ.'GETL') THEN
- READ(CHM(5:LCH),'(I3)') LUN
- CHFORM = CHM(8:LCH)
- READ(LUN,FMT=CHFORM,IOSTAT=IRC) CHLINE
-#include "cspack/szmess.inc"
- IF(IRC.EQ.0) CALL CZPUTA(CHLINE,ISTAT)
-
- ELSEIF(CHM(1:4).EQ.'PUTL') THEN
- READ(CHM(5:LCH),'(I3,A)') LUN
- CHFORM = CHM(8:LCH)
- CALL CZGETA(CHLINE,ISTAT)
- WRITE(LUN,FMT=CHFORM,IOSTAT=IRC) CHLINE
-#include "cspack/szmess.inc"
-
- ELSEIF(CHM(1:4).EQ.'OPEN') THEN
-* READ(CHM(5:LCH),'(A)') FNAME
- JL = ICFNBL(CHM,5,LCH)
- FNAME = CHM(JL:LCH)
- LF = LENOCC(FNAME)
-*
-* Handle long file names
-*
- IF(FNAME(1:LF).EQ.'_') THEN
- CALL CZGETA(FNAME,ISTAT)
- LF = LENOCC(FNAME)
- ENDIF
-#if defined(CERNLIB_IBM)
- CALL CTRANS('.',' ',FNAME,1,LF)
-#endif
- CHMAIL = ' '
- CALL CZGETA(CHMAIL,ISTAT)
- READ(CHMAIL,9002) LUN,LRECL
-9002 FORMAT(10X,I3,I6)
-#include "cspack/szchopt.inc"
- CALL SZOPEN(LUN,FNAME(1:LF),LRECL,CHOPT,IRC)
- IF(IRC.EQ.28) THEN
- WRITE(CHMAIL,'(A)')
- +'2Remote file already exists - use option R to replace '
- CALL CZPUTA(CHMAIL,ISTAT)
- ENDIF
-#include "cspack/szmess.inc"
-
- ELSEIF(CHM(1:4).EQ.'RZOP') THEN
- JL = ICFNBL(CHM,5,LCH)
- FNAME = CHM(JL:LCH)
- LF = LENOCC(FNAME)
- CHMAIL = ' '
- CALL CZGETA(CHMAIL,ISTAT)
- READ(CHMAIL,9002) LUN,LRECL
-#include "cspack/szchopt.inc"
- CALL RZOPEN(LUN,' ',FNAME(1:LF),CHOPT,LRECL,IRC)
- WRITE(CHMAIL,9002) IRC,LRECL
- CALL CZPUTA(CHMAIL,ISTAT)
-
- ELSEIF(CHM(1:4).EQ.'HROP') THEN
- JL = ICFNBL(CHM,5,LCH)
- FNAME = CHM(JL:LCH)
- LF = LENOCC(FNAME)
- CHMAIL = ' '
- CALL CZGETA(CHMAIL,ISTAT)
- READ(CHMAIL,9002) LUN,LRECL
-#include "cspack/szchopt.inc"
- CHTOP = 'LUN'
- CALL XZITOC(LUN,CHTOP(4:),LTOP)
- CALL HROPEN(LUN,CHTOP(1:LTOP+3),FNAME(1:LF),CHOPT,LRECL,IRC)
- WRITE(CHMAIL,9002) IRC,LRECL
- CALL CZPUTA(CHMAIL,ISTAT)
-
- ELSEIF(CHM(1:4).EQ.'CLOS') THEN
- READ(CHM(5:LCH),'(I3)') LUN
-#include "cspack/szchopt.inc"
- CALL SZCLOS(LUN,CHOPT,IRC)
-#include "cspack/szmess.inc"
-
- ELSEIF(CHM(1:4).EQ.'REWD') THEN
- READ(CHM(5:LCH),'(I3)') LUN
- CALL SZREWD(LUN,IRC)
-#include "cspack/szmess.inc"
-
- ELSEIF(CHM(1:4).EQ.'INQR') THEN
-* READ(CHM(5:LCH),'(A)') FNAME
- JL = ICFNBL(CHM,5,LCH)
- FNAME = CHM(JL:LCH)
- LF = LENOCC(FNAME)
-#if defined(CERNLIB_IBM)
- CALL CTRANS('.',' ',FNAME,1,LF)
-#endif
- CALL SZINQR(LUN,FNAME(1:LF),IEXIST,LRECL,IRC)
-#include "cspack/szmess.inc"
-
- ELSEIF(CHM(1:2).EQ.'LS') THEN
-*
-* CHM = LS [path] (options)
-*
-
- LBRA = INDEX(CHM,'(')
- IF(LBRA.NE.0) THEN
- LEND = LBRA - 1
- ELSE
- LEND = LCH
- ENDIF
-
- JL = ICFNBL(CHM,5,LEND)
- IF(JL.GT.LEND) THEN
- CHPATT = ' '
- ELSE
- CHPATT = CHM(JL:LEND)
- IF(CHPATT(1:1).EQ.'(') CHPATT = ' '
- ENDIF
-
- CHMAIL = CHM
-
- IL = INDEX(CHMAIL,'(')
- IR = INDEXB(CHMAIL,')')
- IF((IL.NE.0).AND.(IR.GT.IL)) THEN
- CHOPT = CHMAIL(IL+1:IR-1)
- ELSE
- CHOPT = ' '
- ENDIF
-#if defined(CERNLIB_UNIX)
- IF(INDEX(CHOPT,'C').EQ.0) CALL CUTOL(CHPATT)
-#endif
-#if defined(CERNLIB_DEBUG)
- WRITE(LUNCZ,*) 'XZSERV. call SZLS for CHPATT, CHOPT = ',
- + CHPATT,' , ',CHOPT
-#endif
- CALL SZLS(CHPATT,CHOPT,IRC)
-#include "cspack/szmess.inc"
-
- ELSEIF(CHM(1:2).EQ.'CD') THEN
- CHPATT = CHM(ICFNBL(CHM,5,LCH):LCH)
- LP = LENOCC(CHPATT)
- CALL SZCD(CHPATT(1:LP),IRC)
-#include "cspack/szmess.inc"
-
- ELSEIF(CHM(1:3).EQ.'PWD') THEN
- CALL SZPWD(IRC)
-#include "cspack/szmess.inc"
-
- ELSEIF(CHM(1:2).EQ.'RM') THEN
- CHPATT = CHM(ICFNBL(CHM,5,LCH):LCH)
- LP = LENOCC(CHPATT)
-#if defined(CERNLIB_UNIX)
- CALL CUTOL(CHPATT)
-#endif
-#if defined(CERNLIB_IBM)
- CALL CTRANS('.',' ',CHPATT,1,LP)
- CALL SZRM('/'//CHPATT,IRC)
-#endif
-#if !defined(CERNLIB_IBM)
- CALL SZRM(CHPATT,IRC)
-#endif
-#include "cspack/szmess.inc"
-
- ELSEIF(CHM(1:3).EQ.'VER') THEN
- CALL SZVERS(IRC)
-#include "cspack/szmess.inc"
- ELSEIF(CHM(1:4).EQ.'RSYS') THEN
-#if defined(CERNLIB_IBMVM)
- CALL CZPUTA('1VM',ISTAT)
-#endif
-#if defined(CERNLIB_IBMMVS)
- CALL CZPUTA('1MVS',ISTAT)
-#endif
-#if defined(CERNLIB_VAXVMS)
- CALL CZPUTA('1VMS',ISTAT)
-#endif
-#if defined(CERNLIB_UNIX)
- CALL CZPUTA('1UNIX',ISTAT)
-#endif
- ELSEIF(CHM(1:2).EQ.'MV') THEN
-#include "cspack/szchopt.inc"
- CALL CZGETA(CHSRC,ISTAT)
- CALL CZGETA(CHDST,ISTAT)
- CALL SZMV(CHSRC,CHDST,CHOPT,IRC)
-#include "cspack/szmess.inc"
- ELSE
- CALL CZPUTA('3Unknown I/O command',ISTAT)
- ENDIF
-
-8001 FORMAT('0',A4,I6)
-8002 FORMAT('3Error executing remote ',A4,
- + ' command, return code = ',I6)
-8003 FORMAT('EEOF from ',A4,' return code = ',I6)
-
-99 END
diff --git a/src/packlib/cspack/programs/zs/zs.F b/src/packlib/cspack/programs/zs/zs.F
deleted file mode 100644
index 9363f73..0000000
--- a/src/packlib/cspack/programs/zs/zs.F
+++ /dev/null
@@ -1,405 +0,0 @@
-*
-* $Id: zs.F,v 1.5 2005/04/18 15:23:09 mclareni Exp $
-*
-* $Log: zs.F,v $
-* Revision 1.5 2005/04/18 15:23:09 mclareni
-* Mods submitted by Kevin B. McCarty to fix insecure Cernlib uses of /tmp.
-*
-* Revision 1.4 1997/10/21 17:11:54 mclareni
-* Remove print statements and NT tabs
-*
-* Revision 1.3 1997/09/19 14:09:36 mclareni
-* Remove NT editor eols
-*
-* Revision 1.2 1997/09/02 08:46:16 mclareni
-* WINNT mods, mostly cpp defines
-*
-* Revision 1.1.1.1 1996/03/08 15:44:21 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
-#if defined(CERNLIB_OS9)
- INDIRECT PAWC,HOS9C2
-#endif
- PROGRAM ZS
-********************************************************************
-* *
-* Remote server for PAW. *
-* Current implementation based on TCP/IP. *
-* The server is automatically started when the *
-* PAW command RLOGIN is invoked. *
-* When the PAW command RSHELL is invoked, the *
-* string following the command is passed to the server. *
-* Transfer of ZEBRA structures is automatically handled *
-* from the internal routines of PAW/HBOOK. *
-* *
-* Note that the small communication packages CZ (Fortran) *
-* and TCPAW (C) must be linked with ZS. *
-* *
-* Author: Rene Brun CERN/DD *
-* in collaboration with : *
-* P.Scharff-Hansen for OS9 (OPAL) *
-* J.Raab (OPAL) *
-* B.Segal (DD) for TCPAW *
-* *
-********************************************************************
-#if defined(CERNLIB_OS9)
-#include "cspack/hos9c.inc"
-#endif
-#include "cspack/czhome.inc"
-#include "cspack/slate.inc"
-#include "cspack/czsock.inc"
-#include "cspack/czunit.inc"
-#if defined(CERNLIB_DECNET)
-#include "cspack/czdecnet.inc"
-#endif
-#include "cspack/czdir.inc"
-#include "cspack/zunit.inc"
-#include "cspack/pawc.inc"
- COMMON/CDBUF/DBUF(10)
- DIMENSION IHMAIL(20)
-#if !defined(CERNLIB_IBM)||defined(CERNLIB_TCPSOCK)
- INTEGER STATUS
- INTEGER SSETUP,SCLOSE
- CHARACTER*26 CHFILE
-#endif
-#if defined(CERNLIB_IBM)
- CHARACTER*80 ARGS
-* CHARACTER*10 PORT
-#endif
-#if defined(CERNLIB_VAXVMS)
- CHARACTER*12 REMNOD
- LOGICAL ILOGIN
- INTEGER SYSTEMF
-#endif
- CHARACTER*80 CHMAIL
- CHARACTER*6 CHMESS
- EXTERNAL CZTCP
- EXTERNAL ZSRZIN
-
- PARAMETER (IPRINT=77)
- PARAMETER (IDEBUG=0)
- PARAMETER (LUNI=78)
- PARAMETER (LUNO=79)
-*
-* Start server
-*
-#if defined(CERNLIB_UNIX) && !defined(CERNLIB_WINNT)
- ISOCK=ISETUP(ISKIN,ISKOUT)
- LUNCZ=77
- CHFILE=' '
- CALL DATIME(ND,NT)
- WRITE(CHFILE,1000)ND,NT
- 1000 FORMAT('/var/log/zs',I6,I4,'.log')
- DO 1 I=11,23
- IF(CHFILE(I:I).EQ.' ')CHFILE(I:I)='0'
- 1 CONTINUE
- OPEN(UNIT=LUNCZ,FILE=CHFILE,STATUS='UNKNOWN',IOSTAT=ISTAT)
- IF(ISTAT.NE.0) LUNCZ = 0
- CALL GETWDF(CHHOME)
- PRINT *, 'home = ',CHHOME
- LHOME = IS(1)
-#endif
-#if defined(CERNLIB_OS9)
- ISOCK=SSETUP(ISKIN,ISKOUT)
- LUNCZ=6
- OPEN(6,'std_out')
- OPEN(7,'std_out')
-#endif
-#if defined(CERNLIB_VAXVMS)
-*
-* Check on logical name SYS$REM_NODE to determine
-* whether we have been started by DECnet or TCP/IP
-*
- CALL CZGTLG('SYS$REM_NODE',REMNOD,'LNM$JOB',IRC)
- IF(IRC.NE.0) THEN
- IPROT = 0
- ISOCK=ISETUP(ISKIN,ISKOUT)
- LUNCZ=77
- OPEN(UNIT=77,FILE='ZSERV.LOG',STATUS='NEW',IOSTAT=ISTAT)
- IF(ISTAT.NE.0) LUNCZ = 0
- ELSE
- IPROT = 1
- ISOCK = 0
- LUNCZ = 6
- STATUS = LIB$GET_LUN(LUNDEC)
- IF( .NOT.STATUS ) THEN
- ISOCK = -1
- GO TO 90
- ENDIF
- ISKIN = LUNDEC
- ISKOUT = LUNDEC
- OPEN(UNIT=LUNDEC,FILE='SYS$NET',STATUS='OLD')
-*
-* Temporary...
-*
- CALL XZLOGL(3)
- ENDIF
-#endif
-#if defined(CERNLIB_IBM)
- ARGS=' '
- CALL GOPARM(NARG,ARGS)
- IF(NARG.EQ.0)THEN
- IPORT=2345
- ELSE
- NCH=LENOCC(ARGS)
-* jds 21/02/92
- IPORT = ICDECI(ARGS,1,NCH)
-* PORT=' '
-* PORT(10-NCH+1:10)=ARGS(1:NCH)
-* READ(PORT,'(I10)')IPORT
- ENDIF
- LUNCZ=6
-#endif
-#if (!defined(CERNLIB_TCPSOCK))&&(defined(CERNLIB_IBM))
- CALL SSETUP(ISOCK,IPORT)
- ISKIN=ISOCK
- ISKOUT=ISOCK
-#endif
-#if (defined(CERNLIB_TCPSOCK)) && (defined(CERNLIB_IBM) || defined(CERNLIB_WINNT))
-#if defined(CERNLIB_WINNT)
- IPORT = 0
-#endif
- ISOCK = SSETUP(ISKIN,ISKOUT,IPORT)
-#endif
- IF(ISOCK.LT.0)GO TO 90
-*
-* Start ZEBRA
-*
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB_TCPSOCK))
- IDUMMY = CINIT(DUMMY)
-#endif
- CALL HLIMIT(NWPAWC)
- CALL HERMES(LUNCZ)
- CALL HDELET(0)
-*
-* Number of RZ files currently open
-*
- NCHRZ = 0
- CALL VZERO(LUNRZ,MAXFIL)
-*
-* Open the FZ buffers
-*
- LBUF = 270
-
- LUNFZI = 999
- LUNFZO = 998
-
- CALL FZFILE(LUNFZI,LBUF,'SIC')
- CALL FZHOOK(LUNFZI,CZTCP,DBUF)
- CALL FZFILE(LUNFZO,LBUF,'SOC')
- CALL FZHOOK(LUNFZO,CZTCP,DBUF)
- IADTCP=JUMPAD(CZTCP)
- CALL JUMPST(IADTCP)
-*
- IQPRNT = LUNCZ
- IQLOG = LUNCZ
-#if defined(CERNLIB_IBM)
-*
-* Allow file transfer of RECFM V files
-*
- CALL ERRSET(212,256,-1,1,1)
-#endif
-#if defined(CERNLIB_OS9)
- CPU='1'
-** MODULE='hb_data'
-** CALL ZSMODU(CPU,MODULE)
-#endif
-#if (defined(CERNLIB_VAXVMS))&&(defined(CERNLIB_LOGIN))
- INQUIRE(FILE='LOGIN.COM',EXIST=IEXIST)
- IF(IEXIST) THEN
- IC = SYSTEMF('@LOGIN')
- ENDIF
-#endif
-*
-* Set units, loglevel
-*
- CALL XZINIT(IPRINT,IDEBUG,LUNI,LUNO)
-*
-* Loop on client messages
-*
- 10 CALL CZGETA(CHMAIL,ISTAT)
- IF(ISTAT.NE.0)GO TO 15
-#if defined(CERNLIB_DEBUG)
- IF(LUNCZ.NE.0)WRITE(LUNCZ,'(A,A)') 'ZSERV. ',CHMAIL
-#endif
- CHMESS=CHMAIL(1:6)
-*
-* Close?
-*
- IF(CHMESS.EQ.'*CLOSE') GOTO 15
-*
-* RSH LOG*OUT
-*
- IF(CHMESS.EQ.'MESS :'.AND.
- + ICNTHU(CHMAIL(7:9),'LOG*OUT',1).NE.0) THEN
- CALL CZPUTA('1 Closing remote connection',ISTAT)
- GOTO 15
- ENDIF
-*
-* PIAF
-*
- IF(CHMESS.EQ.'PIAF :')THEN
- CALL SZPIAF(CHMAIL(7:80))
- GO TO 10
- ENDIF
-*
-* MESSAGE
-*
- IF(CHMESS.EQ.'MESS :')THEN
- CALL MESSAGE(CHMAIL(7:80))
- GO TO 10
- ENDIF
-*
-* XZIO
-*
- IF(CHMESS.EQ.'XZIO :')THEN
- CALL XZSERV(CHMAIL(7:80))
- GO TO 10
- ENDIF
-*
-* FATMEN
-*
- IF(CHMESS.EQ.'FATM :')THEN
- CALL FATMEN(CHMAIL(7:80))
- GO TO 10
- ENDIF
-*
-* CZIN
-*
- IF(CHMESS.EQ.'CZIN ')THEN
- CALL ZSRZIN(CHMAIL)
- GO TO 10
- ENDIF
-*
-* CZOUT
-*
- IF(CHMESS.EQ.'CZOUT ')THEN
- CALL ZSOUT(CHMAIL)
- GO TO 10
- ENDIF
-#if !defined(CERNLIB_NOZFTP)
-*
- NCHM=LENOCC(CHMAIL)
- IF(NCHM.LE.0)GO TO 15
- IF(LUNCZ.NE.0)WRITE(LUNCZ,1001)CHMAIL(1:NCHM)
- 1001 FORMAT(' Starting ==> ',A)
- 1002 FORMAT(' Finishing==> ',A)
-*
-* GETA
-*
- IF(CHMESS.EQ.'GETA :')THEN
- CALL SGETA(CHMAIL(7:80))
- IF(LUNCZ.NE.0)WRITE(LUNCZ,1002)CHMAIL(1:NCHM)
- GO TO 10
- ENDIF
-*
-* PUTA
-*
- IF(CHMESS.EQ.'PUTA :')THEN
- CALL SPUTA(CHMAIL(7:80))
- IF(LUNCZ.NE.0)WRITE(LUNCZ,1002)CHMAIL(1:NCHM)
- GO TO 10
- ENDIF
-*
-* GETRZ
-*
- IF(CHMESS.EQ.'GETRZ:')THEN
- CALL SGETRZ(CHMAIL(7:80))
- IF(LUNCZ.NE.0)WRITE(LUNCZ,1002)CHMAIL(1:NCHM)
- GO TO 10
- ENDIF
-*
-* PUTRZ
-*
- IF(CHMESS.EQ.'PUTRZ:')THEN
- CALL SPUTRZ(CHMAIL(7:80))
- IF(LUNCZ.NE.0)WRITE(LUNCZ,1002)CHMAIL(1:NCHM)
- GO TO 10
- ENDIF
-#endif
-#if defined(CERNLIB_UNIX)
-*
-* PUTPIAF
-*
- IF(CHMESS.EQ.'PPIAF:')THEN
- CALL SPPIAF(CHMAIL(7:80))
- IF(LUNCZ.NE.0)WRITE(LUNCZ,1002)CHMAIL(1:NCHM)
- GO TO 10
- ENDIF
-#endif
-*
-* GETFZ
-*
- IF(CHMESS.EQ.'GETFZ:')THEN
- CALL SGETFZ(CHMAIL(7:80))
- IF(LUNCZ.NE.0)WRITE(LUNCZ,1002)CHMAIL(1:NCHM)
- GO TO 10
- ENDIF
-*
-* PUTFZ
-*
- IF(CHMESS.EQ.'PUTFZ:')THEN
- CALL SPUTFZ(CHMAIL(7:80))
- IF(LUNCZ.NE.0)WRITE(LUNCZ,1002)CHMAIL(1:NCHM)
- GO TO 10
- ENDIF
-*
-* GETP
-*
- IF(CHMESS.EQ.'GETP :')THEN
- CALL SGETP(CHMAIL(7:80))
- IF(LUNCZ.NE.0)WRITE(LUNCZ,1002)CHMAIL(1:NCHM)
- GO TO 10
- ENDIF
-*
-* PUTP
-*
- IF(CHMESS.EQ.'PUTP :')THEN
- CALL SPUTP(CHMAIL(7:80))
- IF(LUNCZ.NE.0)WRITE(LUNCZ,1002)CHMAIL(1:NCHM)
- GO TO 10
- ENDIF
-*
-* No options found. Close server socket
-* Wait for another client
-*
- 15 CONTINUE
- DO 20 I=1,NCHRZ
-#if defined(CERNLIB_OS9)
- IF(LUNRZ(I).EQ.0)CALL F_UNLNK(CHRZ(I))
-#endif
- IF(LUNRZ(I).GT.0)THEN
- CALL RZEND(CHRZ(I))
- CLOSE (LUNRZ(I))
- ENDIF
- 20 CONTINUE
- NCHRZ=0
- IF(LUNCZ.NE.0)WRITE(LUNCZ,*) 'CLOSE request received. '
- IF(LUNCZ.NE.0)WRITE(LUNCZ,1003)
- 1003 FORMAT(' Attached files released. Connection closed.')
-#if defined(CERNLIB_UNIX)
- ISTAT=ICLOSE(ISKIN)
-#endif
-#if defined(CERNLIB_OS9)
- ISTAT=SCLOSE(ISKIN)
-#endif
-#if defined(CERNLIB_VAXVMS)
- IF(IPROT.EQ.0) THEN
- ISTAT = ICLOSE(ISKIN)
- ELSE
- ISTAT = 0
- ENDIF
-#endif
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB_TCPSOCK))
- ISTAT = SCLOSE(ISKIN)
-#endif
-#if (defined(CERNLIB_IBM))&&(!defined(CERNLIB_TCPSOCK))
- CALL SCLOSE(ISKIN)
- ISTAT=0
-#endif
-*
- 90 CONTINUE
- STOP
- END
diff --git a/src/packlib/cspack/programs/zs/zscdir.F b/src/packlib/cspack/programs/zs/zscdir.F
deleted file mode 100644
index 9677ccf..0000000
--- a/src/packlib/cspack/programs/zs/zscdir.F
+++ /dev/null
@@ -1,72 +0,0 @@
-*
-* $Id: zscdir.F,v 1.2 1996/04/11 14:54:20 cernlib Exp $
-*
-* $Log: zscdir.F,v $
-* Revision 1.2 1996/04/11 14:54:20 cernlib
-* Zserv/pawserv used to be build from two patches; these were put both into this
-* directory.
-* The #includes in all files copied from the other directory had to updated.
-*
-* Revision 1.1.1.1 1996/03/08 15:44:21 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE ZSCDIR(CHMAIL)
-*
-* Change Current Directory of a remote file or module
-*
-#if defined(CERNLIB_OS9)
- TEMPLATE PAWM
- COMMON/PAWM/NM(10000)
- INTEGER F_LINK
-#include "cspack/hos9c.inc"
-#endif
-#include "cspack/czdir.inc"
-#include "zebra/rzdir.inc"
-#include "zebra/quest.inc"
-C
- CHARACTER*64 CHP
- CHARACTER*32 CHDIR
- CHARACTER*(*) CHMAIL
-*
- IF(NCHRZ.EQ.0)THEN
- CALL CZPUTA('1 Please connect file or module first',ISTAT)
- GO TO 99
- ENDIF
-*
- NCH=LENOCC(CHMAIL)
- IF(NCH.EQ.0)THEN
-#if defined(CERNLIB_OS9)
- if(idir.eq.1)then
- lcpu=lenocc(cpu)
- chdir=cpu(1:lcpu)//'/'//module
- CALL CZPUTA('1 Current Directory ='//chdir,ISTAT)
- go to 99
- endif
-#endif
- CALL RZCDIR(CHP,'R')
- CALL CZPUTA('1 Current Directory ='//CHP,ISTAT)
- GO TO 99
- ENDIF
- CALL CLTOU(CHMAIL)
- CALL RZCDIR(CHMAIL,' ')
- IF(IQUEST(1).NE.0)GO TO 90
- CHDIR=CHCDIR(1)
- DO 10 I=1,NCHRZ
- IF(CHDIR.EQ.CHRZ(I))THEN
- IDIR=I
- GO TO 20
- ENDIF
- 10 CONTINUE
- GO TO 90
-*
- 20 CALL CZPUTA('1 Remote Directory changed to //'//CHDIR,ISTAT)
- GO TO 99
-*
-* Error
-*
- 90 CALL CZPUTA('3 Cannot set remote directory ',ISTAT)
-*
- 99 END
-
diff --git a/src/packlib/cspack/programs/zs/zsclos.F b/src/packlib/cspack/programs/zs/zsclos.F
deleted file mode 100644
index b345eac..0000000
--- a/src/packlib/cspack/programs/zs/zsclos.F
+++ /dev/null
@@ -1,79 +0,0 @@
-*
-* $Id: zsclos.F,v 1.1.1.1 1996/03/08 15:44:21 mclareni Exp $
-*
-* $Log: zsclos.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:21 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE ZSCLOS(CHMAIL)
-*
-* to close a RZ file remotely
-*
-#include "cspack/czdir.inc"
-#include "cspack/quest.inc"
- CHARACTER*(*) CHMAIL
- CHARACTER*80 CHLINE
- CHARACTER*5 CHDIR
- CHARACTER*64 CHFILE
-
- CHLINE = CHMAIL
- CALL CLTOU(CHLINE)
-
- LLINE = LENOCC(CHLINE)
-
- CHFILE = ' '
-
- IF(CHLINE(1:2).EQ.'//') THEN
- CHDIR = CHLINE(3:7)
- ELSEIF(CHLINE(1:3).EQ.'LUN') THEN
- CHDIR = CHLINE(1:5)
- ELSEIF(ICNUM(CHLINE,1,LLINE).GT.LLINE) THEN
- CHDIR = 'LUN'//CHLINE(1:LLINE)
- ELSE
-
- DO 10 I=1,NCHRZ
- IF(FLNAME(I).EQ.CHMAIL) GOTO 20
- 10 CONTINUE
- WRITE(CHLINE,9001) CHMAIL(1:LLINE)
- 9001 FORMAT('3 file ',A,' not open')
- CALL CZPUTA(CHLINE,ISTAT)
- GOTO 999
- 20 CONTINUE
- CHFILE = CHMAIL
-
- ENDIF
-
- READ(CHDIR,'(3X,I2)') LUN
- CLOSE(LUN)
-
- IF(CHFILE.EQ.' ') THEN
-*
-* Find file name corresponding to this TOPDIR
-*
- DO 30 I=1,NCHRZ
- IF(LUNRZ(I).NE.LUN) GOTO 30
- CHFILE = FLNAME(I)
- GOTO 40
- 30 CONTINUE
-
- WRITE(CHLINE,9002) CHDIR
- 9002 FORMAT('3 file with top directory ',A,' not open')
- CALL CZPUTA(CHLINE,ISTAT)
- GOTO 999
-
- 40 CONTINUE
-
- ENDIF
-
- CALL RZEND(CHDIR)
-
- CALL CZPUTA('1 Closing remote file '//CHFILE,ISTAT)
-
- LUNRZ(I) = 0
-
- IF(I.EQ.NCHRZ) NCHRZ = NCHRZ - 1
-*
- 999 END
-
diff --git a/src/packlib/cspack/programs/zs/zsfile.F b/src/packlib/cspack/programs/zs/zsfile.F
deleted file mode 100644
index 19182c6..0000000
--- a/src/packlib/cspack/programs/zs/zsfile.F
+++ /dev/null
@@ -1,110 +0,0 @@
-*
-* $Id: zsfile.F,v 1.1.1.1 1996/03/08 15:44:21 mclareni Exp $
-*
-* $Log: zsfile.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:21 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE ZSFILE(CHMAIL)
-*
-* to open a RZ file remotely
-*
-#include "cspack/czdir.inc"
- COMMON/QUEST/IQUEST(100)
- CHARACTER*58 CFNAME
- CHARACTER*64 CHFILE
- CHARACTER*8 STAT
- CHARACTER*4 CHOPT,CHOPTT
- CHARACTER*5 CHREC
- CHARACTER*3 CHLUN
- CHARACTER*5 CHDIR
- CHARACTER*(*) CHMAIL
- CHARACTER*8 CHTAG(1)
-#if defined(CERNLIB_OS9)
- CHARACTER*(*) LOSHFT
-#endif
-*
-* Decode message from host
-*
- CHOPT=' '
- NCH=LENOCC(CHMAIL)
- IF(CHMAIL(NCH-1:NCH-1).EQ.' ')THEN
- CHOPT=CHMAIL(NCH:NCH)
- CALL CLTOU(CHOPT)
- NCH=NCH-2
- ENDIF
- CFNAME=CHMAIL(1:NCH)
-#if defined(CERNLIB_UNIX)
- CALL CUTOL(CFNAME)
-#endif
-#if !defined(CERNLIB_UNIX)
- CALL CLTOU(CFNAME)
-#endif
-#if defined(CERNLIB_OS9)
- cfname = loshft(chmail(1:nch))
-#endif
-*
-* Hunt for a free unit
-*
- IF(NCHRZ.EQ.0) THEN
- LUN = 11
- GOTO 20
- ELSE
- DO 10 I=1,MAXFIL
- IF(LUNRZ(I).EQ.0) THEN
- LUN = I + 10
- GOTO 20
- ENDIF
-10 CONTINUE
- ENDIF
-
- CALL CZPUTA('3 Maximum number of remote files reached',ISTAT)
- GO TO 99
-
-20 CONTINUE
-
- IOPTN=INDEX(CHOPT,'N')
- IPASS=0
-*
- WRITE(CHDIR,4000)LUN
- 4000 FORMAT('LUN',I2)
-*
- LRECL = 0
- CHOPTT = ' '
- IF(IOPTN.NE.0) THEN
- CHOPTT = 'N'
- LRECL = 1024
- ENDIF
- 2 CONTINUE
- CALL RZOPEN(LUN,CHDIR,CFNAME,CHOPTT,LRECL,ISTAT)
-*
- 90 IF(ISTAT.NE.0)THEN
- CALL CZPUTA('3 Cannot open remote file '//CFNAME,ISTAT)
- GO TO 99
- ENDIF
-
- IF(IOPTN.EQ.0)THEN
- CALL RZFILE(LUN,CHDIR,CHOPT)
- ELSE
- CHTAG(1) = 'HBOOK-ID'
- CALL RZMAKE(LUN,CHDIR,1,'I',CHTAG,1000,' ')
- ENDIF
-
- IF(IQUEST(1).NE.0)THEN
- ISTAT=1
- GO TO 90
- ENDIF
-*
- NCHRZ = NCHRZ+1
- CHRZ(NCHRZ) = CHDIR
- FLNAME(NCHRZ) = CFNAME
- LUNRZ(NCHRZ) = LUN
- IDIR=NCHRZ
-*
- CALL CZPUTA('1 Connecting remote file '//CFNAME(1:NCH)//
- + ' as '//CHDIR,ISTAT)
-*
- 99 END
-
diff --git a/src/packlib/cspack/programs/zs/zsfold.F b/src/packlib/cspack/programs/zs/zsfold.F
deleted file mode 100644
index faf550d..0000000
--- a/src/packlib/cspack/programs/zs/zsfold.F
+++ /dev/null
@@ -1,138 +0,0 @@
-*
-* $Id: zsfold.F,v 1.1.1.1 1996/03/08 15:44:21 mclareni Exp $
-*
-* $Log: zsfold.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:21 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
-#if defined(CERNLIB_OLD)
- SUBROUTINE ZSFILE(CHMAIL)
-*
-* to open a RZ file remotely
-*
-#include "cspack/czdir.inc"
- COMMON/QUEST/IQUEST(100)
- CHARACTER*58 CFNAME
- CHARACTER*64 CHFILE
- CHARACTER*8 STAT
- CHARACTER*4 CHOPT
- CHARACTER*5 CHREC
- CHARACTER*3 CHLUN
- CHARACTER*(*) CHMAIL
-#if defined(CERNLIB_OS9)
- CHARACTER*(*) LOSHFT
-#endif
-*
-*
-* Decode message from host
-*
- CHOPT=' '
- NCH=LENOCC(CHMAIL)
- IF(CHMAIL(NCH-1:NCH-1).EQ.' ')THEN
- CHOPT=CHMAIL(NCH:NCH)
- CALL CLTOU(CHOPT)
- NCH=NCH-2
- ENDIF
-#if defined(CERNLIB_APOLLO)||defined(CERNLIB_VAXVMS)
- CFNAME=CHMAIL(1:NCH)
- CALL CUTOL(CFNAME)
-#endif
-#if defined(CERNLIB_IBM)
- CFNAME=CHMAIL(1:NCH)
- CALL CLTOU(CFNAME)
-#endif
-#if defined(CERNLIB_OS9)
- cfname = loshft(chmail(1:nch))
-#endif
- LUN=10+NCHRZ+1
- IOPTN=INDEX(CHOPT,'N')
- IPASS=0
- IF(IOPTN.NE.0)THEN
- STAT='UNKNOWN'
- ELSE
- STAT='OLD'
- ENDIF
- LRECL=1024
- 2 CONTINUE
-*
-#if defined(CERNLIB_OS9)
- ISTAT=1
-** OPEN(UNIT=LUN,FILE=CFNAME,FORM='UNFORMATTED',RECL=4*LRECL,
-** + ACCESS='DIRECT',STATUS=STAT,IOSTAT=ISTAT)
- OPEN(UNIT=LUN,FILE=CFNAME,ERR=90)
- ISTAT=0
-#endif
-#if defined(CERNLIB_APOLLO)
- OPEN(UNIT=LUN,FILE=CFNAME,FORM='UNFORMATTED',RECL=4*LRECL,
- + ACCESS='DIRECT',STATUS=STAT,IOSTAT=ISTAT)
-#endif
-#if defined(CERNLIB_IBMVM)
- WRITE(CHLUN,'(I3)')LUN
- IF(IOPTN.EQ.0)THEN
- CHFILE='STATE '//CFNAME
- DO 5 I=7,64
- IF(CHFILE(I:I).EQ.'.')CHFILE(I:I)=' '
- 5 CONTINUE
- CALL VMCMS(CHFILE,ISTAT)
- IF(ISTAT.NE.0)GO TO 90
- ENDIF
- CHFILE='/'//CFNAME
- DO 10 I=2,64
- IF(CHFILE(I:I).EQ.'.')CHFILE(I:I)=' '
- 10 CONTINUE
- CALL FILEINF(ISTAT,'MAXREC',2)
- IF(ISTAT.NE.0)GO TO 90
- IF(IOPTN.NE.0)THEN
- OPEN(UNIT=LUN,FILE=CHFILE,FORM='UNFORMATTED',RECL=4*LRECL,
- + ACCESS='DIRECT',STATUS=STAT,IOSTAT=ISTAT)
- IF(ISTAT.NE.0)GO TO 90
- CLOSE(LUTN)
- ENDIF
- CALL FILEINF(ISTAT,'MAXREC',16777215)
- IF(ISTAT.NE.0)GO TO 90
- OPEN(UNIT=LUN,FILE=CHFILE,FORM='UNFORMATTED',RECL=4*LRECL,
- + ACCESS='DIRECT',STATUS=STAT,IOSTAT=ISTAT)
-
-#endif
-#if defined(CERNLIB_VAXVMS)
- IOPTU=INDEX(CHOPT,'U')
- IF(IOPTU.NE.0.OR.IOPTN.NE.0)THEN
- OPEN(UNIT=LUN,FILE=CFNAME,FORM='UNFORMATTED',RECL=LRECL,
- + ACCESS='DIRECT',SHARED,STATUS=STAT,IOSTAT=ISTAT)
- ELSE
- OPEN(UNIT=LUN,FILE=CFNAME,FORM='UNFORMATTED',RECL=LRECL,
- + ACCESS='DIRECT',SHARED,READONLY,STATUS=STAT,IOSTAT=ISTAT)
- ENDIF
-#endif
-*
- 90 IF(ISTAT.NE.0)THEN
- CALL CZPUTA('3 Cannot open remote file '//CFNAME,ISTAT)
- GO TO 99
- ENDIF
-*
- WRITE(CFNAME,4000)LUN
- 4000 FORMAT('LUN',I2,' ')
-*
- IF(IOPTN.EQ.0)THEN
- CALL RZFILE(LUN,CFNAME,CHOPT)
- ELSE
- CALL RZMAKE(LUN,CFNAME,1,'I','HBOOK-ID',1000,' ')
- ENDIF
- IF(IQUEST(1).NE.0)THEN
- ISTAT=1
- GO TO 90
- ENDIF
-*
- NCHRZ=NCHRZ+1
- CHRZ(NCHRZ)=CFNAME
- FLNAME(NCHRZ)=CHMAIL
- LUNRZ(NCHRZ)=LUN
- IDIR=NCHRZ
-*
- CALL CZPUTA('1 Connecting remote file //'//CFNAME,ISTAT)
-*
- 99 END
-
-#endif
diff --git a/src/packlib/cspack/programs/zs/zsget.F b/src/packlib/cspack/programs/zs/zsget.F
deleted file mode 100644
index b31ec69..0000000
--- a/src/packlib/cspack/programs/zs/zsget.F
+++ /dev/null
@@ -1,111 +0,0 @@
-*
-* $Id: zsget.F,v 1.1.1.1 1996/03/08 15:44:21 mclareni Exp $
-*
-* $Log: zsget.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:21 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
-#if defined(CERNLIB_OS9)
- SUBROUTINE ZSGET(ID,CHOPT)
-*
-* Gets HBOOK/ZEBRA data structure for histogram ID
-* in OS9 process and sends it to the client
-*
-#include "cspack/hos9c.inc"
-#include "cspack/czdir.inc"
-#include "cspack/czunit.inc"
- TEMPLATE PAWM
- COMMON/PAWM/NM(10000)
- INTEGER F_LINK
-*
-#include "cspack/pawc.inc"
- DIMENSION IQ(1),Q(1),LQ(8000)
- EQUIVALENCE (LQ(1),LMAIN),(Q(1),LQ(9)),(IQ(1),Q(1))
- COMMON/HCBOOK/HVERSN,IHWORK,LHBOOK,LHPLOT,LGTIT,LHWORK,
- +LCDIR,LSDIR,LIDS,LTAB,LCID,LCONT,LSCAT,LPROX,LPROY,LSLIX,
- +LSLIY,LBANX,LBANY,LPRX,LPRY,LFIX,LLID,LR1,LR2,LCIDN
- COMMON/QUEST/IQUEST(100)
- DIMENSION IQSAVE(100)
- CHARACTER*8 CHOPT
- parameter (kntot=2)
- save iq40
-*
- LCID=0
- CALL VZERO(IQUEST,100)
-*
-* Remote CPU
-*
- if(lunrz(idir).lt.0)then
- if(chopt(1:2).eq.'ND')then
- call Net_Hcopym(id,istat)
- iquest(1)=istat
- iquest(40)=iq40
- iquest(41)=iq40
- elseif(chopt(1:2).eq.'NC') then
- do 5 i=1,nhist
- if(ihead(kid,i).eq.id)then
- iquest(12)=ihead(kntot,i)
- if(i.lt.nhist)then
- iquest(40)=ihead(kid,i+1)
- iquest(41)=iquest(40)
- iq40=iquest(40)
- else
- iquest(40)=0
- iq40=0
- endif
- go to 10
- endif
- 5 continue
- iquest(1)=1
- else
- if(nhist.gt.0)then
- iquest(31)=ihead(kid,1)
- else
- iquest(31)=9999
- endif
- endif
- go to 10
- endif
-*
- IF(CHOPT(1:2).EQ.'N ')THEN
- CALL HNEAR(0,IDC,IDNEXT)
- IF(IDNEXT.EQ.0)THEN
- IDNEXT=9999
- IQUEST(1)=1
- GO TO 10
- ENDIF
- IQUEST(31)=IDNEXT
- IQUEST(40)=IDNEXT
- ELSEIF(CHOPT(1:2).EQ.'NC') THEN
- CALL HNEAR(ID,IDC,IDNEXT)
- IF(IDC.EQ.0)IQUEST(1)=1
- IQUEST(40)=IDNEXT
- IQUEST(41)=IDNEXT
- iq40=idnext
- ELSE
-*
-* Read ZEBRA structure from PAWM module
-*
- CALL HCOPYM(ID,NM,0)
- iquest(40)=iq40
- iquest(41)=iq40
- ENDIF
-*
-* Send the IQUEST vector
-*
- 10 CALL UCOPY(IQUEST,IQSAVE,100)
-*
-* Transfer Data structure to client
-*
- IF(LCID.NE.0)THEN
- CALL FZOUT(LUNFZO,IHDIV,LCID,1,' ',2,100,IQSAVE)
- CALL HDELET(0)
- ELSE
- CALL FZOUT(LUNFZO,0,0,1,'Z',2,100,IQSAVE)
- ENDIF
-*
- 99 END
-
-#endif
diff --git a/src/packlib/cspack/programs/zs/zsldir.F b/src/packlib/cspack/programs/zs/zsldir.F
deleted file mode 100644
index fd54b51..0000000
--- a/src/packlib/cspack/programs/zs/zsldir.F
+++ /dev/null
@@ -1,90 +0,0 @@
-*
-* $Id: zsldir.F,v 1.1.1.1 1996/03/08 15:44:21 mclareni Exp $
-*
-* $Log: zsldir.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:21 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE ZSLDIR
-*.==========>
-*. To list the contents of a RZ directory
-*. in format ID Title
-*..=========> ( R.Brun )
-#include "cspack/hcbook.inc"
-#include "cspack/hcflag.inc"
-#include "cspack/hcntpar.inc"
-*
- CHARACTER*100 LOUT
- COMMON/QUEST/IQUEST(100)
- CHARACTER*1 HTYPE
- INTEGER KEYS(2)
-*.___________________________________________
-*
-*
-* Find first ID in the RZ directory
-*
- LCID=0
- KEYS(1) = 1
- KEYS(2) = 0
- CALL RZIN(IHDIV,0,0,KEYS,9999,'SC')
- IDN=IQUEST(21)
- IQ42 = IQUEST(22)
-*
-* Enough space left
-*
- 10 KEYS(1) = IDN
- KEYS(2) = IQ42
- CALL RZIN(IHDIV,0,0,KEYS,9999,'NC')
- IF(IQUEST(1).NE.0)GO TO 90
- IQ40=IQUEST(40)
- IQ41=IQUEST(41)
- IQ42 = IQUEST(42)
- NWORDS=IQUEST(12)
- IOPTA=JBIT(IQUEST(14),4)
- IF(IOPTA.NE.0)GO TO 40
- CALL HSPACE(NWORDS+105,'ZSLDIR ',IDD)
-** IF(IERR.NE.0) GO TO 90
-*
-* Read histogram data structure
-*
- CALL RZIN(IHDIV,LCID,1,KEYS,9999,'ND')
- IF(IQUEST(1).NE.0)THEN
- CALL CZPUTA('2Bad sequence for RZ',ISTAT)
- GO TO 90
- ENDIF
-*
- LOUT=' '
- IF(JBIT(IQ(LCID+KBITS),1).NE.0)THEN
- HTYPE='1'
- NWTITL=IQ(LCID-1)-KTIT1+1
- WRITE(LOUT,2000)IDN,HTYPE,(IQ(LCID+KTIT1+I-1),I=1,NWTITL)
- ELSEIF(JBYT(IQ(LCID+KBITS),2,2).NE.0) THEN
- HTYPE='2'
- NWTITL=IQ(LCID-1)-KTIT2+1
- WRITE(LOUT,2000)IDN,HTYPE,(IQ(LCID+KTIT2+I-1),I=1,NWTITL)
- ELSEIF(JBIT(IQ(LCID+KBITS),4).NE.0) THEN
- HTYPE='N'
- ITIT1=IQ(LCID+9)
- NWTITL=MIN(IQ(LCID+8),20)
- WRITE(LOUT,2000)IDN,HTYPE,(IQ(LCID+ITIT1+I-1),I=1,NWTITL)
- ELSE
- WRITE(LOUT,3000)IDN
- ENDIF
- CALL CZPUTA(LOUT,ISTAT)
- IF(ISTAT.NE.0)GO TO 90
-*
- CALL MZDROP(IHDIV,LCID,' ')
- 40 LCID=0
-*
- IF(IQ40.EQ.0)GO TO 99
- IDN=IQ41
- GO TO 10
-*
- 90 CONTINUE
-*
- 2000 FORMAT('2',I10,1X,'(',A,')',3X,20A4)
- 3000 FORMAT('2',I10)
- 99 RETURN
- END
diff --git a/src/packlib/cspack/programs/zs/zslfil.F b/src/packlib/cspack/programs/zs/zslfil.F
deleted file mode 100644
index 303a6cd..0000000
--- a/src/packlib/cspack/programs/zs/zslfil.F
+++ /dev/null
@@ -1,38 +0,0 @@
-*
-* $Id: zslfil.F,v 1.1.1.1 1996/03/08 15:44:21 mclareni Exp $
-*
-* $Log: zslfil.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:21 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE ZSLFIL
-*
-* List RZ files that are currently open
-*
-#include "cspack/czdir.inc"
-#include "cspack/quest.inc"
- CHARACTER*80 CHMAIL
-*
-* Find file name corresponding to this TOPDIR
-*
-
- IF(NCHRZ.EQ.0) THEN
- CALL CZPUTA('1 No RZ files currently connected',ISTAT)
- ELSE
- CALL CZPUTA('2 List of remotely connected files',ISTAT)
- CALL CZPUTA('2 ================================',ISTAT)
- DO 10 I=1,NCHRZ
-
- IF(LUNRZ(I).NE.0) THEN
- WRITE(CHMAIL,9001) LUNRZ(I),FLNAME(I)
- 9001 FORMAT('2 //LUN',I2,' ',A)
- CALL CZPUTA(CHMAIL,ISTAT)
- ENDIF
- 10 CONTINUE
- CALL CZPUTA('1',ISTAT)
-
- ENDIF
-*
- END
diff --git a/src/packlib/cspack/programs/zs/zslism.F b/src/packlib/cspack/programs/zs/zslism.F
deleted file mode 100644
index d3a9013..0000000
--- a/src/packlib/cspack/programs/zs/zslism.F
+++ /dev/null
@@ -1,56 +0,0 @@
-*
-* $Id: zslism.F,v 1.1.1.1 1996/03/08 15:44:21 mclareni Exp $
-*
-* $Log: zslism.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:21 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
-#if defined(CERNLIB_MMAP)
- SUBROUTINE ZSLISM(IPAWD)
-*.==========>
-*. To list histograms in shared memory IPAWD
-*..=========> ( R.Brun)
-#include "cspack/hcdire.inc"
-*
- DIMENSION IHDIR(4)
- DIMENSION IPAWD(100)
-*.___________________________________________
- NW=IPAWD(1)
- KOF=IPAWD(2)
- ILAST=IPAWD(NW)
- JR1=ILAST-KOF
-*
-*
-* Search levels down
-*
- IF(NLPAT.GT.1)THEN
- DO 50 IL=2,NLPAT
- CALL UCTOH(CHPAT(IL),IHDIR,4,16)
- JR1=IPAWD(JR1-1)-KOF
- 30 IF(JR1.EQ.0)GO TO 99
- DO 40 I=1,4
- IF(IHDIR(I).NE.IPAWD(JR1+I+8))THEN
- JR1=IPAWD(JR1)-KOF
- GO TO 30
- ENDIF
- 40 CONTINUE
- 50 CONTINUE
- ENDIF
-*
- JCDIR = JR1
- JTAB = IPAWD(JCDIR-3)-KOF
-*
- NTOT =IPAWD(JTAB+7)
- ISTAT=0
- DO 60 I=1,NTOT
- IF(IPAWD(JTAB-I).EQ.0)GO TO 60
- ID1=IPAWD(JTAB+I+8)
- CALL ZSLISM1(IPAWD(9),IPAWD(1),ID1,JTAB,KOF,ISTAT)
- IF(ISTAT.NE.0)GO TO 99
- 60 CONTINUE
-*
- 99 RETURN
- END
-#endif
diff --git a/src/packlib/cspack/programs/zs/zslism1.F b/src/packlib/cspack/programs/zs/zslism1.F
deleted file mode 100644
index 8877220..0000000
--- a/src/packlib/cspack/programs/zs/zslism1.F
+++ /dev/null
@@ -1,65 +0,0 @@
-*
-* $Id: zslism1.F,v 1.1.1.1 1996/03/08 15:44:22 mclareni Exp $
-*
-* $Log: zslism1.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:22 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
-#if defined(CERNLIB_MMAP)
- SUBROUTINE ZSLISM1(IB,LB,ID1,JTAB,KOF,ISTAT)
-*.==========>
-*. Auxiliary for ZSLISM
-*..=========> ( R.Brun)
-#include "cspack/hcbook.inc"
-#include "cspack/hcntpar.inc"
- DIMENSION IB(1),LB(1)
- CHARACTER*128 LOUT
- CHARACTER*1 HTYPE
-*.___________________________________________
- NH=IB(JTAB-1)
- DO 10 I=1,NH
- IF(IB(JTAB+I).EQ.ID1)GO TO 20
- 10 CONTINUE
- GO TO 99
-*
- 20 CONTINUE
-C ID=ID1
- JCID=LB(JTAB-I)-KOF
- NTOT=IB(JCID+KNTOT)
- I123=JBYT(IB(JCID+KBITS),1,3)
- I230=JBYT(IB(JCID+KBITS),2,2)
- I1 =JBIT(I123,1)
- I4 =JBIT(IB(JCID+KBITS),4)
-*
- IF(I1.NE.0)THEN
- NWTITL=IB(JCID-1)-KTIT1+1
- ITIT1=JCID+KTIT1
- HTYPE='1'
- ELSEIF(I230.NE.0)THEN
- NWTITL=IB(JCID-1)-KTIT2+1
- ITIT1=JCID+KTIT2
- HTYPE='2'
- ELSEIF(I4.NE.0)THEN
- HTYPE='N'
- IF (IB(JCID-2) .EQ. 2) THEN
- ITIT1=JCID+IB(JCID+9)
- NWTITL=IB(JCID+8)
- ELSE
- ITIT1=JCID+IB(JCID+ZITIT1)
- NWTITL=IB(JCID+ZNWTIT)
- ENDIF
- ELSE
- GO TO 99
- ENDIF
- LOUT=' '
- WRITE (LOUT,1001) ID1,HTYPE,(IB(KK),KK=ITIT1,ITIT1+NWTITL-1)
- CALL CZPUTA(LOUT,ISTAT)
-1001 FORMAT('2',I10,1X,'(',A,')',3X,15A4)
-*
- 90 CONTINUE
-*
- 99 RETURN
- END
-#endif
diff --git a/src/packlib/cspack/programs/zs/zslist.F b/src/packlib/cspack/programs/zs/zslist.F
deleted file mode 100644
index f354dc2..0000000
--- a/src/packlib/cspack/programs/zs/zslist.F
+++ /dev/null
@@ -1,46 +0,0 @@
-*
-* $Id: zslist.F,v 1.1.1.1 1996/03/08 15:44:21 mclareni Exp $
-*
-* $Log: zslist.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:21 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE ZSLIST(IGOFF,CHMAIL)
-*
-* to list contents of a remote directory (module or file)
-*
-#include "cspack/czdir.inc"
- CHARACTER*(*) CHMAIL
-*
- if(nchrz.le.0)then
- CALL CZPUTA('1 Please connect file or module first',ISTAT)
- go to 99
- endif
-*
- IF(CHMAIL(1:2).EQ.'//')THEN
- DO 10 I=1,NCHRZ
- CALL CZPUTA('2 //'//CHRZ(I)(1:12)//FLNAME(I),ISTAT)
- 10 CONTINUE
- CALL CZPUTA('0',ISTAT)
- GO TO 99
- ENDIF
-#if defined(CERNLIB_OS9)
- IF(LUNRZ(IDIR).LE.0) CALL ZSLMOD
-#endif
-*
-#if defined(CERNLIB_MMAP)
- IF(LUNRZ(IDIR).LT.0)THEN
- CALL ZSLISTM(IGOFF)
- CALL CZPUTA('0',ISTAT)
- ENDIF
-#endif
-*
- IF(LUNRZ(IDIR).GT.0)THEN
- CALL ZSLDIR
- CALL CZPUTA('0',ISTAT)
- ENDIF
-*
- 99 END
-
diff --git a/src/packlib/cspack/programs/zs/zslistm.F b/src/packlib/cspack/programs/zs/zslistm.F
deleted file mode 100644
index 442b675..0000000
--- a/src/packlib/cspack/programs/zs/zslistm.F
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: zslistm.F,v 1.1.1.1 1996/03/08 15:44:21 mclareni Exp $
-*
-* $Log: zslistm.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:21 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
-#if defined(CERNLIB_MMAP)
- SUBROUTINE ZSLISTM(IGOFF)
-*.==========>
-*. To list histograms in shared memory IPAWD (control routine)
-*..=========> ( R.Brun)
-#include "cspack/hcbook.inc"
-*
- CALL ZSLISM(LQ(IGOFF+1))
- END
-#endif
diff --git a/src/packlib/cspack/programs/zs/zslmod.F b/src/packlib/cspack/programs/zs/zslmod.F
deleted file mode 100644
index fbcb197..0000000
--- a/src/packlib/cspack/programs/zs/zslmod.F
+++ /dev/null
@@ -1,70 +0,0 @@
-*
-* $Id: zslmod.F,v 1.1.1.1 1996/03/08 15:44:21 mclareni Exp $
-*
-* $Log: zslmod.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:21 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
-#if defined(CERNLIB_OS9)
- SUBROUTINE ZSLMOD
-*
-* List HBOOK directory of an OS9 process
-*
-#include "cspack/hos9c.inc"
-#include "cspack/czdir.inc"
- PARAMETER(KNCX=3,KXMIN=4,KXMAX=5,KBWIDX=6,KMIN=7,KMAX=8,KNORM=9,
- + KTIT1=10,KNCY=7,KYMIN=8,KYMAX=9,KBWIDY=10,KSCAL2=11,
- + KTIT2=12,KNBIT=1,KNOENT=2,KSTAT1=3,KNSDIR=5,KNRH=6,
- + KCON1=9,KCON2=3,KBITS=1,KNTOT=2)
-*
- TEMPLATE PAWM
-#include "cspack/pawc.inc"
- DIMENSION IQ(1),Q(1),LQ(8000)
- EQUIVALENCE (LQ(1),LMAIN),(Q(1),LQ(9)),(IQ(1),Q(1))
-*
- CHARACTER*100 LOUT
- CHARACTER*32 CHDIR
- CHARACTER*1 HTYPE
-*
- lcpu=lenocc(cpu)
- chdir=cpu(1:lcpu)//'/'//module
- WRITE(LOUT,1000)CHDIR
- CALL CZPUTA(LOUT,ISTAT)
-* Remote CPU
- IF(LUNRZ(IDIR).LT.0)THEN
- call zslmod2
- go to 95
-*
- ENDIF
-*
-* Module on server
- IF(LMAIN.LE.0)GO TO 95
- LCID =LQ(LMAIN-2)
- 10 IF(LCID.EQ.0)GO TO 95
-*
- ID=IQ(LCID-5)
- LOUT=' '
- IF(JBIT(IQ(LCID+KBITS),1).NE.0)THEN
- HTYPE='1'
- NWTITL=IQ(LCID-1)-KTIT1+1
- NCX=IQ(LCID+KNCX)
- WRITE(LOUT,2000)ID,HTYPE,NCX,(IQ(LCID+KTIT1+I-1),I=1,NWTITL)
- ELSE
- HTYPE='2'
- NWTITL=IQ(LCID-1)-KTIT2+1
- NCX=IQ(LCID+KNCX)*IQ(LCID+KNCY)
- WRITE(LOUT,2000)ID,HTYPE,NCX,(IQ(LCID+KTIT2+I-1),I=1,NWTITL)
- ENDIF
- CALL CZPUTA(LOUT,ISTAT)
- IF(ISTAT.NE.0)RETURN
- LCID=LQ(LCID)
- GO TO 10
-*
- 95 CALL CZPUTA('1 ===> End of remote directory',ISTAT)
-*
- 1000 FORMAT('2 ==> Remote Directory : ',A)
- 2000 FORMAT('2',I10,1X,'(',A,')',3X,I10,3X,20A4)
- END
-#endif
diff --git a/src/packlib/cspack/programs/zs/zslmod2.F b/src/packlib/cspack/programs/zs/zslmod2.F
deleted file mode 100644
index 9b3e016..0000000
--- a/src/packlib/cspack/programs/zs/zslmod2.F
+++ /dev/null
@@ -1,45 +0,0 @@
-*
-* $Id: zslmod2.F,v 1.1.1.1 1996/03/08 15:44:21 mclareni Exp $
-*
-* $Log: zslmod2.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:21 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
-#if defined(CERNLIB_OS9)
- SUBROUTINE ZSLMOD2
-*
-* Prints ID and histogram title
-*
- PARAMETER(KNCX=3,KXMIN=4,KXMAX=5,KBWIDX=6,KMIN=7,KMAX=8,KNORM=9,
- + KTIT1=10,KNCY=7,KYMIN=8,KYMAX=9,KBWIDY=10,KSCAL2=11,
- + KTIT2=12,KNBIT=1,KNOENT=2,KSTAT1=3,KNSDIR=5,KNRH=6,
- + KCON1=9,KCON2=3,KBITS=1,KNTOT=2)
-*
-#include "cspack/hos9c.inc"
-*
- CHARACTER*100 LOUT
- CHARACTER*1 HTYPE
-*
- do 10 ihist=1,nhist
- id=ihead(kid,ihist)
- lout=' '
- IF(JBIT(ihead(kbits,ihist),1).NE.0)THEN
- HTYPE='1'
- NWTITL=ihead(knwid,ihist)-KTIT1+1
- WRITE(LOUT,2000)ID,HTYPE,(ihead(KTIT1+I-1,ihist),I=1,NWTITL)
- ELSE
- HTYPE='2'
- NWTITL=ihead(knwid,ihist)-KTIT2+1
- WRITE(LOUT,2000)ID,HTYPE,(ihead(KTIT2+I-1,ihist),I=1,NWTITL)
- ENDIF
- CALL CZPUTA(LOUT,ISTAT)
- IF(ISTAT.NE.0)RETURN
- 10 continue
-*
- 1100 FORMAT('2 ',5I6)
- 2000 FORMAT('2',I10,1X,'(',A,')',3X,20A4)
- END
-
-#endif
diff --git a/src/packlib/cspack/programs/zs/zsmodu.F b/src/packlib/cspack/programs/zs/zsmodu.F
deleted file mode 100644
index 87537c1..0000000
--- a/src/packlib/cspack/programs/zs/zsmodu.F
+++ /dev/null
@@ -1,65 +0,0 @@
-*
-* $Id: zsmodu.F,v 1.1.1.1 1996/03/08 15:44:21 mclareni Exp $
-*
-* $Log: zsmodu.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:21 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
-#if defined(CERNLIB_OS9)
- SUBROUTINE ZSMODU(CHCPU,CHMOD)
-*
-* to map /PAWC/ of an OS9 process to /PAWM/
-*
- TEMPLATE PAWM
- COMMON/PAWM/NM(10000)
- INTEGER F_LINK
-#include "cspack/czdir.inc"
-#if defined(CERNLIB_OS9)
-#include "cspack/hos9c.inc"
-#endif
- COMMON/QUEST/IQUEST(100)
- CHARACTER*(*) CHCPU,CHMOD
- character*32 chdir
-*
- IF(CHCPU(1:1).NE.'1')GO TO 50
-*
-* Mapping a module on the server machine
-*
- CPU='1'
- MODULE=CHMOD
- ISTAT = F_LINK(MODULE, at PAWM,JJ)
- IF(ISTAT.NE.0)THEN
- CALL CZPUTA('3 Cannot map module ',ISTAT)
- GO TO 99
- ENDIF
-*
- CHRZ(1)=MODULE
- LUNRZ(1)=0
- FLNAME(1)=MODULE
- IDIR=1
- IF(NCHRZ.EQ.0) NCHRZ=1
- CALL CZPUTA('1 Mapping module '//MODULE,ISTAT)
- GO TO 99
-*
-* Setting a connection to a module of another CPU
-*
- 50 CALL Net_HTAB(CHCPU,CHMOD,ISTAT)
- IF(ISTAT.NE.0)THEN
- CALL CZPUTA('3 Cannot map module ',ISTAT)
- GO TO 99
- ENDIF
- CHRZ(1)=CHMOD
- LUNRZ(1)=-1
- IDIR=1
- IF(NCHRZ.EQ.0) NCHRZ=1
- CPU=CHCPU
- MODULE=CHMOD
- lcpu=lenocc(cpu)
- chdir=cpu(1:lcpu)//'/'//module
- FLNAME(1)=CHDIR
- CALL CZPUTA('1 Connecting module '//CHDIR,ISTAT)
-*
- 99 END
-#endif
diff --git a/src/packlib/cspack/programs/zs/zsout.F b/src/packlib/cspack/programs/zs/zsout.F
deleted file mode 100644
index 5ccfcd9..0000000
--- a/src/packlib/cspack/programs/zs/zsout.F
+++ /dev/null
@@ -1,53 +0,0 @@
-*
-* $Id: zsout.F,v 1.1.1.1 1996/03/08 15:44:21 mclareni Exp $
-*
-* $Log: zsout.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:21 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE ZSOUT(CHMAIL)
-*
-* to write a record to a RZ file remotely
-*
-#include "cspack/czunit.inc"
-#include "cspack/hcbook.inc"
- COMMON/QUEST/IQUEST(100)
- COMMON/QSAVE/IQSAVE(100)
- CHARACTER*(*) CHMAIL
- CHARACTER*8 CHOPT
- DIMENSION KEYS(1)
- DIMENSION IUHEAD(9),IOCR(9)
-*
-* Decode message from host
-*
- READ(CHMAIL,1000)KEYS,ICYCLE,CHOPT
- 1000 FORMAT(6X,I10,I10,A)
-*
-* Transfer Data structure from client
-*
- LCID=0
- NUH =0
- CALL FZIN(LUNFZI,IHDIV,LCID,1,' ',NUH,IUHEAD)
- IF(IQUEST(1).NE.0)GO TO 90
-*
-* Write ZEBRA structure to RZ file
-*
-#if defined(CERNLIB_OS9)
- CALL VZERO(IQUEST,100)
-#endif
-#if !defined(CERNLIB_OS9)
- CALL RZOUT(IHDIV,LCID,KEYS,ICYCLE,CHOPT)
- CALL RZSAVE
- CALL HDELET(0)
-#endif
-*
-* Send the IQUEST vector
-*
- 90 CALL UCOPY(IQUEST,IQSAVE,100)
- IOCR(1) = 2
- CALL FZOUT(LUNFZO,0,0,1,'Z',IOCR,100,IQSAVE)
-*
- 99 END
-
diff --git a/src/packlib/cspack/programs/zs/zsrzin.F b/src/packlib/cspack/programs/zs/zsrzin.F
deleted file mode 100644
index f66ad26..0000000
--- a/src/packlib/cspack/programs/zs/zsrzin.F
+++ /dev/null
@@ -1,66 +0,0 @@
-*
-* $Id: zsrzin.F,v 1.1.1.1 1996/03/08 15:44:21 mclareni Exp $
-*
-* $Log: zsrzin.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:21 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE ZSRZIN(CHMAIL)
-*
-* to read a record from a RZ file remotely
-*
-#include "cspack/czdir.inc"
-#include "cspack/czunit.inc"
-#include "cspack/hcbook.inc"
- COMMON/QUEST/IQUEST(100)
- COMMON/QSAVE/IQSAVE(100)
- CHARACTER*8 CHOPT
- CHARACTER*(*) CHMAIL
- INTEGER KEYS(2)
- DIMENSION IOCR(9)
-*
-*
-* Decode message from host
-*
- READ(CHMAIL,1000)KEYS,ICYCLE,CHOPT
- 1000 FORMAT(6X,2I10,I10,A)
-*
- LCID=0
-#if defined(CERNLIB_OS9)
- IF(LUNRZ(IDIR).LE.0)THEN
- CALL ZSGET(KEYS(1),CHOPT)
- GO TO 99
- ENDIF
-#endif
-#if defined(CERNLIB_VAXVMS)||defined(CERNLIB_MMAP)
- IF(LUNRZ(IDIR).LE.0)THEN
- IQUEST(1)=0
- CALL HRIN(KEYS(1),1,0)
- GO TO 10
- ENDIF
-#endif
-*
-* Read ZEBRA structure from RZ file
-*
- CALL RZIN(IHDIV,LCID,1,KEYS,ICYCLE,CHOPT)
-*
-* Send the IQUEST vector
-*
- 10 CALL UCOPY(IQUEST,IQSAVE,100)
-*
-* Transfer Data structure to client
-*
- IF(LCID.NE.0)THEN
- IOCR(1) = 2
- CALL FZOUT(LUNFZO,IHDIV,LCID,1,' ',IOCR,100,IQSAVE)
- CALL MZDROP(IHDIV,LCID,' ')
- LCID=0
- CALL HDELET(0)
- ELSE
- IOCR(1) = 2
- CALL FZOUT(LUNFZO,0,0,1,'Z',IOCR,100,IQSAVE)
- ENDIF
-*
- 99 END
diff --git a/src/packlib/cspack/sysreq/Imakefile b/src/packlib/cspack/sysreq/Imakefile
deleted file mode 100644
index 964177e..0000000
--- a/src/packlib/cspack/sysreq/Imakefile
+++ /dev/null
@@ -1,39 +0,0 @@
-SRCS_C= getacct.c getconfent.c log.c netreq.c serror.c socket.c \ @@\
- sysreqf.c trace.c xdr.c
-
-#ifndef CERNLIB_VAXVMS
-SRCS_C:= $(SRCS_C) sysreqc.c
-#endif
-
-#ifdef CERNLIB_UNIX
-EXTRA_INCLUDES=-I. -I$(CVSCOSRC)$(CURRENT_DIR)
-#endif
-
-#ifdef CERNLIB_SOLARIS
-EXTRA_DEFINES = -DSOLARIS
-#endif
-
-#ifdef CERNLIB_SGI
-EXTRA_DEFINES = -DIRIX5
-#endif
-
-#ifdef CERNLIB_LINUX
-EXTRA_DEFINES = -DLINUX
-#endif
-
-#ifdef CERNLIB_VAXVMS
-EXTRA_INCLUDES=-I[]
-DEFINES:= $(DEFINES) -DCOMPILE_NOPREFIX -DTGV
-CCOPTIONS:= $(CCOPTIONS) /stan\=vaxc/pref\=ansi
-#ifndef CERNLIB_QMALPH
-DEFINES:= $(DEFINES) -DDECC
-#endif
-#endif
-
-#if defined(CERNLIB_HPUX) || defined(CERNLIB_LINUX)
-/* Cancel the default ansi compilation */
-CCOPTIONS=
-#endif
-
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/cspack/sysreq/config.h b/src/packlib/cspack/sysreq/config.h
deleted file mode 100644
index 0c8060a..0000000
--- a/src/packlib/cspack/sysreq/config.h
+++ /dev/null
@@ -1,56 +0,0 @@
-/*
- * $Id: config.h,v 1.1.1.1 1996/03/08 15:44:26 mclareni Exp $
- *
- * $Log: config.h,v $
- * Revision 1.1.1.1 1996/03/08 15:44:26 mclareni
- * Cspack
- *
- */
-/*
- * Copyright (C) 1990,1991 by CERN/CN/SW/DC
- * All rights reserved
- */
-
-/*
- * @(#)config.h 1.2 5/17/91 CERN CN-SW/DC Frederic Hemmer
- */
-
-/* config.h SYSREQ network interface configuration */
-
-#ifndef _CONFIG_H_INCLUDED_
-#define _CONFIG_H_INCLUDED_
-
-#define SYSREQ_NAME "sysreq" /* Name of SYSREQ (in /etc/services) */
-#define SYSREQ_HOST "??????" /* Name of SYSREQ default host */
-#define SYSREQ_PROTO "tcp" /* Communication protocol */
-#define SYSREQ_PORT 4001 /* Well known port if not in services */
-#define SYSREQ_BACKLOG 5 /* Listen() backlog */
-
-#define S_MAGIC 0x103090 /* Server magic number */
-#define C_MAGIC 0x100360 /* Client magic number */
-
-#define ACCEPT_RETRY_MAX 5 /* Number of accept() max retries */
-#define ACCEPT_RETRY_DELAY 5 /* Delay between accept() retries */
-
-#define SERVICESDB 1 /* Use /etc/services db if set */
-#ifdef VM
-#define EBCDIC 1 /* ASCII/EBCDIC toggle, ASCII if 0 */
-#else
-#define EBCDIC 0 /* ASCII/EBCDIC toggle, ASCII if 0 */
-#endif /* VM */
-
-/*
- * SYSREQ configuration file
- */
-
-#ifdef unix
-#define SYSREQCONF "/etc/sysreq.conf"
-#endif /* unix */
-#ifdef VM
-#define SYSREQCONF "PROFILE.SYSREQ"
-#endif /* VM */
-#ifdef vms
-#define SYSREQCONF "SYS$MANAGER:SYSREQ.CONF"
-#endif /* vms */
-
-#endif /* _CONFIG_H_INCLUDED_ */
diff --git a/src/packlib/cspack/sysreq/getacct.c b/src/packlib/cspack/sysreq/getacct.c
deleted file mode 100644
index 422ba48..0000000
--- a/src/packlib/cspack/sysreq/getacct.c
+++ /dev/null
@@ -1,245 +0,0 @@
-/*
- * $Id: getacct.c,v 1.2 1997/09/02 08:46:18 mclareni Exp $
- *
- * $Log: getacct.c,v $
- * Revision 1.2 1997/09/02 08:46:18 mclareni
- * WINNT mods, mostly cpp defines
- *
- * Revision 1.1.1.1 1996/03/08 15:44:25 mclareni
- * Cspack
- *
- */
-/*
- * Copyright (C) 1990-1994 by CERN CN-PDP/CS
- * All rights reserved
- */
-
-#ifndef lint
-static char sccsid[] = "@(#)getacct.c 1.7 7/13/94 CERN CN-PDP/CS F. Hemmer";
-#endif /* not lint */
-
-/* getacct() Getting the current account id */
-
-#if !defined(CRAY) && !defined(vms)
-#include <stdio.h>
-#if !defined(apollo) && !defined(WIN32)
-# include <unistd.h>
-#endif /* ! apollo */
-#include <string.h>
-#include <sys/types.h>
-#if defined(vms)
-#include <pwd_vms.h>
-#else
-# ifndef WIN32
-# include <pwd.h>
-# endif /* WIN32 */
-#endif
-
-
-/*
- * Check if the environment variable ACCOUNT is set.
- * If YES
- * Check if it is a valid account id for the user.
- * Else
- * Get the primary account id of the user.
- * Endif
- *
- * The look-up policy is the same as for passwd.
- */
-char * getacct()
-{
- extern char * getenv() ;
- extern char * ypgetacct() ;
- static char buffer[BUFSIZ] ; /* Line buffer
- */
- char * account ; /* Pointer to the account env
-variable */
- struct passwd * pwd ; /* Pointer to the password
-entry */
- FILE * fp ; /* Pointer to /etc/account
-file */
-
- /*
- * Getting environmental variable.
- */
- account= getenv("ACCOUNT") ;
-
- /*
- * Getting password entry.
- */
- if ( ( pwd= getpwuid(getuid())) == NULL ) {
- return NULL ;
- }
-
- /*
- * If possible /etc/account is parsed until the record
- * we are looking for is found, '+' is encountered as a user login name
- * ( indicating that we have to look in YP) or the end of file is
-reached.
- */
- if ( (fp= fopen("/etc/account","r")) == NULL ) {
-#if defined(NIS)
- return ypgetacct(pwd,account,buffer) ;
-#else
- return NULL ;
-#endif /* NIS */
- }
-
- while(fgets(buffer,80,fp) != NULL ) {
- char * cp ;
-
- if ( (cp= strtok(buffer,":")) == NULL ) {
- return NULL ;
- }
-
-#if defined(NIS)
- if ( *cp == '+' ) {
- fclose(fp) ;
- return ypgetacct(pwd,account,buffer) ;
- }
-#endif /* NIS */
-
- if ( strcmp(pwd->pw_name,cp) )
- continue ;
-
- /*
- * Getting account id of the current record.
- */
- if ( (cp= strtok((char *)NULL,":")) == NULL ) {
- return NULL ;
- }
-
- /*
- * If the account id was specified in an
- * environment variable.
- */
- if ( account != NULL ) {
- if ( strcmp(account,cp))
- continue ;
- }
- else {
- /*
- * We are interested in the
- * master account id.
- */
- char * seq ;
-
- if ( (seq= strtok((char *)NULL,":") ) == NULL ) {
- return NULL ;
- }
- if ( atoi(seq) )
- continue ;
- }
- (void) fclose(fp) ;
- return cp ;
- }
- (void) fclose(fp) ;
- return NULL ;
-}
-#endif /* !CRAY && !vms */
-
-#if defined(vms)
-#include <ssdef.h> /* System services definitions */
-#include <uaidef.h> /* User authorization definitions */
-#include <rmsdef.h> /* Record Management definitions */
-#include <string.h> /* String manipulation definitions */
-#include <stdio.h> /* Standard Input/Output definitions */
-#include <errno.h> /* Standard error numbers */
-
-#if defined(vms) && defined(__alpha) && defined(COMPILE_NOPREFIX)
-#define cuserid DECC$CUSERID
-#define strlen DECC$STRLEN
-#endif /* vms && __alpha && COMPILE_NOPREFIX */
-
-extern int sys$getuai(); /* VMS get user accounting information */
-
-static char account[9+1]; /* account string buffer */
-static int accountl; /* account string length */
-
-typedef struct { /* VMS Item desciptor */
- short bufl;
- short code;
- char *buf;
- int *retl;
-} Item;
-
-typedef struct { /* VMS generic descriptor */
- int len;
- char *buf;
-} descrip;
-
-static struct { /* VMS Item list for $GETUAI */
- Item items[57];
- int eol;
-} itemlist = {
- {
- 9, UAI$_ACCOUNT, account, &accountl
- },
- 0
-};
-
-
-char * getacct()
-{
- descrip name_dsc; /* username's descriptor */
- char name[L_cuserid]; /* username buffer */
- char *cp; /* character pointer */
- int rc; /* syscall return code */
-
- cuserid(name); /* C env. must be initialized */
- name_dsc.len = strlen(name);
- name_dsc.buf = name;
- if ((rc = sys$getuai(0, 0, &name_dsc, &itemlist, 0, 0, 0))
- != SS$_NORMAL) {
- if (rc == RMS$_RNF) {
- vaxc$errno = rc;
- errno = EVMSERR;
- cp = NULL;
- }
- if (!(rc & 0x01)) {
- vaxc$errno = rc;
- errno = EVMSERR;
- cp = NULL;
- }
- else {
- account[accountl]='\0';
- cp = account;
- }
- }
- else {
- account[accountl]='\0';
- cp = account;
- }
- return(cp);
-}
-#endif /* vms */
-
-#if defined(CRAY)
-#include <stdio.h> /* Standard Input/Output definitions */
-
-char *getacct()
-{
- extern int acctid();
- extern char *acid2nam();
- int aid; /* account id */
- char *cp; /* character pointer */
-
- aid = acctid(0, -1);
- if ((aid = acctid(0,-1)) == -1) {
- cp = NULL;
- }
- else {
- if ((cp = acid2nam(aid)) == NULL) {
- cp = NULL;
- }
- }
- return(cp);
-}
-#endif /* CRAY */
-
-/*
- * Fortran wrapper
- */
-
-/*FH* to be done RC = XYACCT() */
-
diff --git a/src/packlib/cspack/sysreq/getconfent.c b/src/packlib/cspack/sysreq/getconfent.c
deleted file mode 100644
index 4cb3f11..0000000
--- a/src/packlib/cspack/sysreq/getconfent.c
+++ /dev/null
@@ -1,146 +0,0 @@
-/*
- * $Id: getconfent.c,v 1.1.1.1 1996/03/08 15:44:25 mclareni Exp $
- *
- * $Log: getconfent.c,v $
- * Revision 1.1.1.1 1996/03/08 15:44:25 mclareni
- * Cspack
- *
- */
-/*
- * Copyright (C) 1991-1994 by CERN CN-PDP/CS
- * All rights reserved
- */
-
-#ifndef lint
-static char sccsid[] = "@(#)getconfent.c 1.10 7/13/94 CERN CN-PDP/CS F. \
-Hemmer";
-#endif /* not lint */
-
-/* getconfent.c - get configuration entry */
-
-#ifndef PATH_CONFIG
-#if !defined(vms)
-#define PATH_CONFIG "/etc/shift.conf"
-#else /* vms */
-#define PATH_CONFIG "SYS$MANAGER:shift.conf"
-#endif /* vms */
-#endif /* PATH_CONFIG */
-
-#include <stdio.h> /* Standard input/output */
-#include <ctype.h> /* Character manipulation */
-#include <string.h> /* String handling functions */
-#ifndef vms
-#include <serrno.h> /* Special Error numbers */
-#else
-#include "serrno.h" /* Special Error numbers */
-#endif /* vms */
-
-#if defined(vms) && defined(DECC)
-#define __alpha
-#endif
-
-#if defined(vms) && defined(__alpha) && defined(COMPILE_NOPREFIX)
-#define fclose DECC$FCLOSE
-#define fgets DECC$FGETS
-#define fopen DECC$FOPEN
-#define getenv DECC$GETENV
-#define strcmp DECC$STRCMP
-#define strcpy DECC$STRCPY
-#define strtok DECC$STRTOK
-#endif /* vms && __alpha && COMPILE_NOPREFIX */
-
-static char in_line[BUFSIZ+1];
-
-extern char* getenv();
-static char value[BUFSIZ];
-
-char *
-getconfent(category, name, flags)
-char *category;
-char *name;
-int flags;
-{
- char *filename=PATH_CONFIG;
- FILE *fp;
- char *p, *cp;
- int found = 0;
- char *separator;
-
- if ((p = getenv("PATH_CONFIG")) != NULL) {
- filename=p;
- }
-
-#ifdef DEBUG
- log(LOG_DEBUG ,"getconfent(%s,%s,%d)\n",
- category, name, flags);
- log(LOG_DEBUG ,"getconfent: opening %s\n",filename);
-#endif /* DEBUG */
- if ((fp = fopen(filename,"r")) == NULL) {
- serrno = SENOCONFIG;
- return (NULL);
- }
-
- for (;;) {
- p = fgets(in_line, BUFSIZ, fp);
- if (p == NULL) {
- break;
- }
-#ifdef DEBUG
- log(LOG_DEBUG ,"getconfent: read <%s>",p);
-#endif /* DEBUG */
- if (*p == '#') continue;
-#ifdef DEBUG
- log(LOG_DEBUG ,"getconfent: processing <%s>",p);
-#endif /* DEBUG */
- if ((cp = strtok(p," \t")) == NULL) continue; /* empty line */
- if (*cp == '#') continue; /* comment */
- if (strcmp(cp, category) == 0) { /* a category match */
-#ifdef DEBUG
- log(LOG_DEBUG ,"getconfent: category <%s>\n", cp);
-#endif /* DEBUG */
- if ((cp = strtok(NULL," \t")) == NULL) continue;
- if (*cp == '#') continue; /* comment, invalid */
- if (strcmp(cp, name) == 0) { /* A match */
-#ifdef DEBUG
- log(LOG_DEBUG ,"getconfent: category <%s>, \
-processing<%s>\n",
- category, cp);
-#endif /* DEBUG */
- if (flags) {
- /* Don't tokenize next arg */
- separator = "#\n";
- } else {
- /* Don't tokenize next arg */
- separator = "#\t \n";
- }
- if ((cp = strtok(NULL, separator)) == NULL)
-continue; /* invalid format */
- if (*cp == '#') continue; /* comment, invalid */
-#ifdef DEBUG
- log(LOG_DEBUG ,"getconfent: category <%s>, \
-got<%s>\n",
- category, cp);
-#endif /* DEBUG */
- found++;
- strcpy(value,cp);
- break;
- }
- else {
- continue;
- }
- }
- else {
- continue;
- }
- }
-#ifdef DEBUG
- log(LOG_DEBUG ,"getconfent: closing %s\n",filename);
-#endif /* DEBUG */
- if (fclose(fp)) return (NULL);
- if (!found) {
- return(NULL);
- }
- else {
- return(value);
- }
-}
diff --git a/src/packlib/cspack/sysreq/jibdef.h b/src/packlib/cspack/sysreq/jibdef.h
deleted file mode 100644
index 85aac85..0000000
--- a/src/packlib/cspack/sysreq/jibdef.h
+++ /dev/null
@@ -1,68 +0,0 @@
-/*
- * $Id: jibdef.h,v 1.1.1.1 1996/03/08 15:44:26 mclareni Exp $
- *
- * $Log: jibdef.h,v $
- * Revision 1.1.1.1 1996/03/08 15:44:26 mclareni
- * Cspack
- *
- */
-#if defined(CERNLIB_VAXVMS)
-#define JIB$C_DETACHED 0
-#define JIB$C_NETWORK 1
-#define JIB$C_BATCH 2
-#define JIB$C_LOCAL 3
-#define JIB$C_DIALUP 4
-#define JIB$C_REMOTE 5
-#define JIB$M_BYTCNT_WAITERS 1
-#define JIB$M_TQCNT_WAITERS 2
-#define JIB$K_LENGTH 148
-#define JIB$C_LENGTH 148
-#define JIB$S_JIBDEF 148
-#define JIB$L_MTLFL 0
-#define JIB$L_MTLBL 4
-#define JIB$W_SIZE 8
-#define JIB$B_TYPE 10
-#define JIB$B_DAYTYPES 11
-#define JIB$S_USERNAME 12
-#define JIB$T_USERNAME 12
-#define JIB$S_ACCOUNT 8
-#define JIB$T_ACCOUNT 24
-#define JIB$L_BYTCNT 32
-#define JIB$L_BYTLM 36
-#define JIB$L_PBYTCNT 40
-#define JIB$L_PBYTLIM 44
-#define JIB$W_FILCNT 48
-#define JIB$W_FILLM 50
-#define JIB$W_TQCNT 52
-#define JIB$W_TQLM 54
-#define JIB$L_PGFLQUOTA 56
-#define JIB$L_PGFLCNT 60
-#define JIB$L_CPULIM 64
-#define JIB$W_PRCCNT 68
-#define JIB$W_PRCLIM 70
-#define JIB$W_SHRFCNT 72
-#define JIB$W_SHRFLIM 74
-#define JIB$W_ENQCNT 76
-#define JIB$W_ENQLM 78
-#define JIB$W_MAXJOBS 80
-#define JIB$W_MAXDETACH 82
-#define JIB$L_MPID 84
-#define JIB$L_JLNAMFL 88
-#define JIB$L_JLNAMBL 92
-#define JIB$L_PDAYHOURS 96
-#define JIB$L_ODAYHOURS 100
-#define JIB$B_JOBTYPE 104
-#define JIB$B_FLAGS 105
-#define JIB$V_BYTCNT_WAITERS 0
-#define JIB$V_TQCNT_WAITERS 1
-#define JIB$L_ORG_BYTLM 108
-#define JIB$L_ORG_PBYTLM 112
-#define JIB$L_SPARE 116
-#define JIB$L_CWPS_TIME 120
-#define JIB$L_CWPS_COUNT 124
-#define JIB$S_CWPS_Q1 8
-#define JIB$Q_CWPS_Q1 128
-#define JIB$L_CWPS_L1 136
-#define JIB$L_CWPS_L2 140
-#define JIB$L_JTQUOTA 144
-#endif
diff --git a/src/packlib/cspack/sysreq/log.c b/src/packlib/cspack/sysreq/log.c
deleted file mode 100644
index e7bc025..0000000
--- a/src/packlib/cspack/sysreq/log.c
+++ /dev/null
@@ -1,301 +0,0 @@
-/*
- * $Id: log.c,v 1.4 2006/09/15 09:35:11 mclareni Exp $
- *
- * $Log: log.c,v $
- * Revision 1.4 2006/09/15 09:35:11 mclareni
- * Submitted mods for gcc4/gfortran and MacOSX, corrected to work also on slc4 with gcc3.4 and 4.1
- *
- * Revision 1.3 2003/09/02 12:47:16 mclareni
- * Mods to replace varargs.h (removed from gcc 3.3) with stdarg.h for Linux gcc
- * 3.3.
- *
- * Revision 1.2 2002/05/16 13:43:38 mclareni
- * The IBM syslog is now the same as most other Unix versions.
- *
- * Revision 1.1.1.1 1996/03/08 15:44:26 mclareni
- * Cspack
- *
- */
-/*
- * Copyright (C) 1990-1993 by CERN/CN/SW/DC
- * All rights reserved
- */
-
-#ifndef lint
-static char sccsid[] = "@(#)log.c 1.22 7/27/94 CERN CN-SW/DC Frederic \
-Hemmer";
-#endif /* not lint */
-
-/* log.c - generalized logging routines */
-
-#include <stdio.h> /* standard input/output definitions */
-#if !defined(vms)
-#include <fcntl.h> /* file control */
-#else
-#include <stdlib.h> /* general utility definitions */
-#include <unixio.h> /* VMS's unix-emulation I/O */
-#include <file.h> /* VMS's BSD 4.2 open() constants */
-#include <unixlib.h> /* VMS's UNIX emulation prototypes */
-#include <string.h> /* string manipulation functions */
-#endif /* vms */
-#include <time.h> /* time related definitions */
-
-#if defined(vms) && defined(DECC)
-#define __alpha
-#endif
-
-#if defined(vms) && defined(__alpha) && defined(COMPILE_NOPREFIX)
-#define atoi DECC$ATOI
-#define chmod DECC$CHMOD
-#define close DECC$CLOSE
-#define ctime DECC$CTIME
-#define getenv DECC$GETENV
-#define getpid DECC$GETPID
-#define open DECC$OPEN
-/* sprintf defined in stdio.h */
-#define strcmp DECC$STRCMP
-#define strcpy DECC$STRCPY
-#define strlen DECC$STRLEN
-#define time DECC$TIME
-#define write DECC$WRITE
-#endif /* vms && __alpha && COMPILE_NOPREFIX */
-
-#if !defined(VM) && !defined(IRIX5) && !defined(LINUX)
-#include <varargs.h> /* variable argument list definitions */
-#else
-#include <stdarg.h> /* variable argument list definitions */
-#include <errno.h> /* standard error numbers & codes */
-#endif /* VM || IRIX5 || LINUX */
-#include <log.h> /* logging options and definitions */
-
-
-static int loglevel=LOG_NOLOG; /* logging level */
-static char logname[64]; /* logging facility name */
-static char logfilename[64]=""; /* log file name */
-
-#if defined(vms)
-syslog() {
- return 0;
-}
-#endif /* vms */
-
-#if !defined(VM)
-static int pid; /* process identifier */
-static int logfd ; /* logging file descriptor */
-#if !defined(SOLARIS) && !defined(linux) && !defined(_AIX) \
- && !defined(IRIX5) && !defined(apollo) && !defined(__DARWIN__)
-extern int syslog();
-#endif /* !SOLARIS && !IRIX5 && !apollo && !linux && !AIX */
-extern char *getenv();
-#else /* VM */
-static char *console="CONSOLE";/* VM default console userid */
-static FILE *logfp; /* logging file pointer */
-
-static int logpriority=LOG_ALERT;
-
-int syslog(int priority, ...)
-{
- va_list args; /* arguments */
- register char *p;
- register char *message;
- char buffer[132];
- char command[200];
-
- va_start(args, priority);
- /* get syslog() priority */
- if ((p = getenv("SYSLOG_PRIORITY")) != NULL) {
- if (atoi(p) <= priority) {
- return(0);
- }
- }
- else {
- /* default logging to LOG_CRIT */
- if (LOG_CRIT <= priority) {
- return(0);
- }
- }
- /* get syslog() VM console user id */
- if ((p = getenv("SYSLOG_CONSOLE")) != NULL) {
- console = p;
- }
-
- message = va_arg(args, char *);
- (void) vsprintf(buffer, message, args);
- strcpy(command,"EXEC TELL ");
- strcat(command, console);
- strcat(command, " ");
- strcat(command, logname);
- strcat(command, ": ");
- strcat(command,buffer);
- (void) system(command);
- va_end(args);
-}
-#endif /* VM */
-
-
-#if !defined(VM)
-#if !defined(IRIX5) && !defined(LINUX)
-void logit();
-#else
-void logit(int level, ...);
-#endif
-#else
-int logit(int level, ...);
-#endif /* VM || IRIX5 */
-void (*logfunc)()=(void (*)())logit;
-
-/*
- * Opening log file.
- * Storing the process pid.
- */
-void initlog(name, level, output)
-char *name; /* facility name */
-int level; /* logging level */
-char *output; /* output specifier */
-{
- register char *p;
-
- loglevel=level;
-
- /* bypass level if set in environment */
- if ((p = getenv("LOG_PRIORITY")) != NULL) {
- loglevel=atoi(p);
- }
- /*
- * Opening syslog path.
- */
- strcpy(logname,name);
-
-#if defined(sun) || defined(CRAY) || defined(sgi)
- openlog(logname, LOG_PID, LOG_USER);
-#endif /* sun || CRAY || sgi */
-
-#if defined(apollo) || defined(hpux) || defined(_AIX)
- openlog(logname, LOG_PID, LOG_USER);
-#endif /* apollo || hpux || _AIX */
-
-#if (defined(ultrix) && defined(mips))
- openlog(logname, LOG_PID);
-#endif /* ultrix && mips */
-
- /*
- * Opening log file and setting logfunc
- * to either syslog or logit.
- */
- if (!strcmp(output,"syslog")) {
- logfunc=(void (*)())syslog;
- }
- else {
- logfunc=(void (*)())logit;
- if (strlen(output) == 0) {
-#if !defined(VM)
- logfd= fileno(stderr) ; /* standard error */
-#else
- logfp=stderr;
-#endif
- }
- else {
- strcpy(logfilename,output);
- }
- }
-}
-
-/*
- * logit should be called with the following syntax
- * logit(LOG_LEVEL,format[,value,...]) ;
- */
-#if !defined(VM)
-#if !defined(IRIX5) && !defined(LINUX)
-void logit(va_alist) va_dcl
-#else
-void logit(int level, ...)
-#endif
-#else
-int logit(int level, ...)
-#endif /* VM */
-{
- va_list args ; /* Variable argument list */
- char *format; /* Format of the log message */
-#if !defined(VM) && !defined(vms)
- time_t clock;
-#else
- unsigned long clock; /* What time is it ? */
-#endif /* !VM && !vms */
- char timestr[64] ; /* Time in its ASCII format */
- char line[BUFSIZ] ; /* Formatted log message */
-#if !defined(VM)
- int fd; /* log file descriptor */
-#endif
-#if !defined(VM) && !defined(IRIX5) && !defined(LINUX)
- int level; /* Level of the message */
-
- va_start(args); /* initialize to beginning of list */
- level = va_arg(args, int);
-#else
-
- va_start(args, level);
-#endif /* VM || IRIX5 || Linux */
- if (loglevel >= level) {
- format = va_arg(args, char *);
- (void) time(&clock);
- (void) strcpy(timestr,ctime(&clock)+strlen("Ddd "));
- timestr[strlen(timestr)-1-strlen(" YYYY")]='\0';
-
-#if !defined(VM)
- pid = getpid();
-#if !defined(vms)
- (void) sprintf(line,"%s %s[%d]: ",timestr,logname,
- pid) ;
-#else /* vms */
- (void) sprintf(line,"%s %s[%X]: ",timestr,logname,
- pid) ;
-#endif /* vms */
- (void) vsprintf(line+strlen(line),format,args);
-#else /* VM */
- (void) sprintf(line,"%s %s: ",timestr,logname) ;
- (void) vsprintf(line+strlen(line),format,args);
-#endif /* VM */
-
- if (strlen(logfilename)!=0) {
-#if !defined(VM)
- if ( (fd= open(logfilename,O_CREAT|O_WRONLY|
- O_APPEND,0666)) == -1 ) {
- syslog(LOG_ERR,"open: %s: %m",
-logfilename);
- /* FH we probably should retry */
- return;
- }
- /*
- * To be sure that file access is enables
- * even if root umask is not 0
- */
- else
- (void) chmod( logfilename, 0666 );
- }
- else {
- if (strlen(logfilename)==0)
- fd= fileno (stderr); /* standard error
-*/
- }
- (void) write(fd,line,strlen(line)) ;
- if (strlen(logfilename)!=0)
- (void) close(fd);
-#else
- if ( (logfp= fopen(output,"a+")) == NULL ) {
- perror(output);
- syslog(LOG_ERR,"fopen: %s: %s", output,
-strerror(errno));
- return(-1);
- }
- (void) fwrite(line,strlen(line),1, logfp) ;
- if (strlen(logfilename)!=0)
- (void) fclose(logfp);
-#endif /* VM */
- }
- va_end(args);
- }
-
- int getloglv()
- {
- return(loglevel);
- }
diff --git a/src/packlib/cspack/sysreq/log.h b/src/packlib/cspack/sysreq/log.h
deleted file mode 100644
index 172bb72..0000000
--- a/src/packlib/cspack/sysreq/log.h
+++ /dev/null
@@ -1,74 +0,0 @@
-/*
- * $Id: log.h,v 1.1.1.1 1996/03/08 15:44:25 mclareni Exp $
- *
- * $Log: log.h,v $
- * Revision 1.1.1.1 1996/03/08 15:44:25 mclareni
- * Cspack
- *
- */
-/*
- * @(#)log.h 1.5 7/29/94 CERN CN-PDP/CS F. Hemmer
- */
-
-/*
- * Copyright (C) 1990-1994 by CERN CN-PDP/CS
- * All rights reserved
- */
-
-/* log.h generalized logging facilities */
-
-#ifndef _LOG_H_INCLUDED_
-#define _LOG_H_INCLUDED_
-
-#define LOG_NOLOG -1 /* Don't log */
-
-#if defined(vax) && defined(vms) && !defined(__DECC)
-/*
- * VAX/VMS C compiler 3.1 has a nasty bug around function pointer
- * assignements, when linked with libraries. Therefore we must
- * disable this code for vms. As a result, there is a loss in
- * functionality, because we cannot switch anymore between functions
- */
-#define log logit
-#else
-extern void (*logfunc)(); /* logging function to use */
-#define log (*logfunc) /* logging function name */
-#endif /* vax && vms && !__DECC */
-
-#if !defined(vms) && !defined(VM)
-#include <syslog.h> /* system logger definitions */
-#else
-#define LOG_EMERG 0 /* system is unusable */
-#define LOG_ALERT 1 /* action must be taken immediately */
-#define LOG_CRIT 2 /* critical conditions */
-#define LOG_ERR 3 /* error conditions */
-#define LOG_WARNING 4 /* warning conditions */
-#define LOG_NOTICE 5 /* normal but signification condition */
-#define LOG_INFO 6 /* informational */
-#define LOG_DEBUG 7 /* debug-level messages */
-#endif /* !vms && !VM */
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-#endif /* _LOG_H_INCLUDED_ */
diff --git a/src/packlib/cspack/sysreq/net.h b/src/packlib/cspack/sysreq/net.h
deleted file mode 100644
index ca64571..0000000
--- a/src/packlib/cspack/sysreq/net.h
+++ /dev/null
@@ -1,259 +0,0 @@
-/*
- * $Id: net.h,v 1.1.1.1 1996/03/08 15:44:26 mclareni Exp $
- *
- * $Log: net.h,v $
- * Revision 1.1.1.1 1996/03/08 15:44:26 mclareni
- * Cspack
- *
- */
-/*
- * @(#)net.h 1.3 7/29/94 CERN CN-PDP/CS F. Hemmer
- */
-
-/*
- * Copyright (C) 1990-1994 by CERN CN-PDP/CS
- * All rights reserved
- */
-
-/* tcp.h TCP/IP on VMS variants */
-
-/*
- * supported TCP's on VMS are :
- *
- * Win/TCP (the Wollongong Group) thru TWG
- * Multinet (TGV) thru MULTINET
- * TcpWare (Process Software) thru TCPWARE
- * UCX (DEC) thru UCX
- */
-
-#if defined(vms) && (vms == 1)
-
-#if defined(TGV) && (TGV == 1) && !defined(MULTINET)
-#define MULTINET 1
-#endif /* TGV && !MULTINET */
-
-#if (!defined(TWG) && !defined(MULTINET) && !defined(TCPWARE) && !defined(UCX))
-/* We generate a compiler error (#error not defined everywhere!) */
-!!! YOU MUST SPECIFY either MULTINET or TWG or TCPWARE or UCX !!!
-
-#endif /* !MULTINET && !TWG && !TCPWARE && !UCX */
-
-#if defined(TWG) && (TWG == 1)
-/* We generate a compiler error, because currently unsupported */
-!!! Win/TCP is not supported in this version. Sorry !!!
-
-extern int uerrno;
-extern int vmserrno;
-#define errno (uerrno ? uerrno : vmserrno)
-
-#endif /* TWG */
-
-#if defined(MULTINET) && (MULTINET == 1)
-
-#pragma nostandard
-extern volatile int noshare socket_errno;
-extern volatile int noshare vmserrno;
-extern void socket_perror();
-#pragma standard
-
-/*
- * MULTINET doesn't prototype externals, which is a requirement
- * when using DEC C compiler on ALPHA/VMS 6.0 C - DEC C 013
- */
-
-/*
-#if defined(errno)
-#undef errno
-#define errno (socket_errno ? socket_errno : vmserrno)
-#endif /* errno
-*/
-
-#if defined(__ALPHA)
-extern struct hostent *gethostbyname();
-extern struct hostent *gethostbyaddr();
-extern struct hostent *gethostent();
-extern struct servent *getservbyname();
-extern struct servent *getservbyport();
-extern struct servent *getservent();
-extern struct protoent *getprotobyname();
-extern struct protoent *getprotobynumber();
-extern struct protoent *getprotoent();
-extern struct netent *getnetbyname();
-extern struct netent *getnetbyaddr();
-extern struct netent *getnetent();
-extern struct hostent *tcpware_gethostaddr();
-
-extern int accept();
-extern int bind();
-extern int connect();
-extern int getpeername();
-extern int getsockname();
-extern int getsockopt();
-extern int listen();
-extern int recvfrom();
-extern int select();
-extern int sendto();
-extern int setsockopt();
-extern int select();
-extern int sendto();
-extern int setsockopt();
-extern int socket();
-extern int socket_close();
-extern int socket_ioctl();
-extern int socket_read();
-extern int socket_recv();
-extern int socket_send();
-extern int socket_write();
-extern int shutdown();
-extern int getdomainname();
-extern int setdomainname();
-extern int gethostid();
-extern int gethostname();
-extern int sethostname();
-extern int pneterror();
-/*
-extern unsigned short htons();
-extern unsigned short ntohs();
-extern unsigned long htonl();
-extern unsigned long ntohl();
-*/
-extern void bzero();
-
-extern char *vms_errno_string();
-
-#endif /* __ ALPHA */
-#endif /* MULTINET */
-
-#if defined(UCX) && (UCX == 1)
-
-#include <ucx$inetdef.h> /* UCX various constants & structs \
- */
-
-/*
- * The following is needed to implement the SIOCGIFCONF ioctl a la unix.
- */
-
-#define ifr_addr IFR$R_DUMMY.IFR$T_ADDR
-#define ifr_name IFR$T_NAME
-
-struct ifconf {
- int ifc_len; /* size of associated buffer */
- union {
- caddr_t ifcu_buf;
- struct IFREQDEF *ifcu_req;
- } ifc_ifcu;
-#define ifc_buf ifc_ifcu.ifcu_buf /* buffer address */
-#define ifc_req ifc_ifcu.ifcu_req /* array of structures returned */
-};
-
-/*
- * The following is needed to emulate BSD 4.3 select API
- */
-
-typedef int fd_set;
-
-#define FD_SET(n, p) (*p |= (1 << n))
-#define FD_CLR(n, p) (*p &= ~(1 << n))
-#define FD_ISSET(n, p) (*p & (1 << n))
-#define FD_ZERO(p) (*p = 0)
-#define FD_SETSIZE 32
-
-#endif /* UCX */
-
-#if defined(TCPWARE) && (TCPWARE == 1)
-
-/*
- * TCPWARE include files are messy. Some define external entries
- * (required by DEC C compiler on ALPHA/VMS 6.0 C - DEC C 013)
- * others don't define them, and even others define them at the
- * wrong place.
- */
-
-#if defined(_TCPWARE_NETDB_) /* TCPWARE_INCLUDE:netdb.h */
-#if defined(__ALPHA)
-extern struct hostent *tcpware_gethostbyname();
-extern struct hostent *tcpware_gethostbyaddr();
-extern struct hostent *tcpware_gethostent();
-extern struct servent *tcpware_getservbyname();
-extern struct servent *tcpware_getservbyport();
-extern struct servent *tcpware_getservent();
-extern struct protoent *tcpware_getprotobyname();
-extern struct protoent *tcpware_getprotobynumber();
-extern struct protoent *tcpware_getprotoent();
-extern struct netent *tcpware_getnetbyname();
-extern struct netent *tcpware_getnetbyaddr();
-extern struct netent *tcpware_getnetent();
-#endif /* __ ALPHA */
-#endif /* _TCPWARE_NETDB_ */
-
-#if defined( _TCPWARE_SOCKET_) /* TCPWARE_INCLUDE:socket.h */
-#if defined(__ALPHA)
-extern int tcpware_accept();
-extern int tcpware_bind();
-extern int tcpware_connect();
-extern int tcpware_getpeername();
-extern int tcpware_getsockname();
-extern int tcpware_getsockopt();
-extern int tcpware_listen();
-extern int tcpware_recvfrom();
-extern int tcpware_select();
-extern int tcpware_sendto();
-extern int tcpware_setsockopt();
-extern int tcpware_select();
-extern int tcpware_sendto();
-extern int tcpware_setsockopt();
-extern int tcpware_socket();
-extern int tcpware_socket_close();
-extern int tcpware_socket_ioctl();
-extern int tcpware_socket_read();
-extern int tcpware_socket_recv();
-extern int tcpware_socket_send();
-extern int tcpware_socket_write();
-extern int tcpware_shutdown();
-extern int tcpware_getdomainname();
-extern int tcpware_setdomainname();
-extern int tcpware_gethostid();
-extern struct hostent *tcpware_gethostaddr();
-extern int tcpware_gethostname();
-extern int tcpware_sethostname();
-extern int tcpware_pneterror();
-#endif /* __ ALPHA */
-#endif /* _TCPWARE_SOCKET */
-
-#if defined(_TCPWARE_TYPES_) /* TCPWARE_INCLUDE:types.h */
-#if defined(__ALPHA)
-extern unsigned short tcpware_htons();
-extern unsigned short tcpware_ntohs();
-extern unsigned long tcpware_htonl();
-extern unsigned long tcpware_ntohl();
-#endif /* __ALPHA */
-#endif /* _TCPWARE_TYPES_ */
-
-#endif /* TCPWARE */
-
-#endif /* vms */
-
-#if defined(vax) && defined(vms) && !defined(__DECC)
-/*
- * VAX/VMS C compiler 3.x has a nasty bug around function pointer
- * assignements, when linked with libraries. Therefore we must
- * disable this code for vms. As a result, there is a loss in
- * functionality, because we cannot switch anymore between functions
- */
-#define netread s_recv
-#define netwrite s_send
-#define netclose s_close
-#define netioctl s_ioctl
-#define neterror s_errmsg
-#else
-extern int (*recvfunc)();
-#define netread (*recvfunc)
-extern int (*sendfunc)(); /* Network send function */
-#define netwrite (*sendfunc)
-extern int (*closefunc)(); /* Network send function */
-#define netclose (*closefunc)
-extern int (*ioctlfunc)(); /* Network send function */
-#define netioctl (*ioctlfunc)
-extern char *(*errfunc)(); /* Network error function */
-#define neterror (*errfunc)
-#endif /* vax && vms && ! __DECC */
diff --git a/src/packlib/cspack/sysreq/netreq.c b/src/packlib/cspack/sysreq/netreq.c
deleted file mode 100644
index 0d0e06e..0000000
--- a/src/packlib/cspack/sysreq/netreq.c
+++ /dev/null
@@ -1,384 +0,0 @@
-/*
- * $Id: netreq.c,v 1.1.1.1 1996/03/08 15:44:25 mclareni Exp $
- *
- * $Log: netreq.c,v $
- * Revision 1.1.1.1 1996/03/08 15:44:25 mclareni
- * Cspack
- *
- */
-/*
- * Copyright (C) 1990-1994 by CERN CN-PDP/CS
- * All rights reserved
- */
-
-#ifndef lint
-static char sccsid[] = "@(#)netreq.c 1.18 10/14/94 CERN CN-PDP/CS F. Hemmer";
-#endif /* not lint */
-
-/* netreq.c Network interface to the SYSREQ communication system */
-
-#include "config.h" /* configuration parameters */
-#if !defined(vms)
-#include <sysreq.h> /* SYSREQ specific definitions */
-#include <sys/types.h> /* Standard data types */
-#include <sys/socket.h> /* Socket interface */
-#include <netinet/in.h> /* Internet data types */
-#include <arpa/inet.h> /* Arpa internet routines */
-#include <stdio.h> /* Standard Input/Output */
-#if defined(vms)
-#include <pwd_vms.h>
-#else
-#include <pwd.h>
-#endif
-#include <netdb.h> /* Network "data base" */
-#include <errno.h> /* Error numbers */
-#include <serrno.h> /* Special Error numbers */
-#include <trace.h> /* tracing definitions */
-#endif /* vms */
-#if defined(vms)
-#include "sysreq.h" /* SYSREQ specific definitions */
-#include <types.h> /* Standard data types */
-#include <socket.h> /* Socket interface */
-#include <in.h> /* Internet data types */
-#include <inet.h> /* Arpa internet routines */
-#include <stdio.h> /* Standard Input/Output */
-#include <netdb.h> /* Network "data base" */
-#include <errno.h> /* Error numbers */
-#include "serrno.h" /* Special Error numbers */
-#include "trace.h" /* tracing definitions */
-
-#if defined(TGV) && (TGV == 1) && !defined(MULTINET)
-#define MULTINET 1
-#endif /* TGV && !MULTINET */
-
-#if (!defined(TWG) && !defined(MULTINET) && !defined(TCPWARE) && !defined(UCX))
-/* We generate a compiler error (#error not defined everywhere!) */
-!!! YOU MUST SPECIFY either MULTINET or TWG or TCPWARE or UCX !!!
-
-#endif /* !MULTINET && !TWG && !TCPWARE && !UCX */
-#ifdef TWG
-#define close(x) netclose(x) /* TWG network close */
-extern int uerrno;
-extern int vmserrno;
-#define perror(x) fprintf(stderr,"%s: TWG error %d\n",x,uerrno);
-#define errno (uerrno ? uerrno : vmserrno)
-#endif /* TWG */
-#if defined(MULTINET) && (MULTINET == 1)
-#define close(x) socket_close(x) /* MULTINET network close */
-#define perror(x) socket_perror(x) /* MULTINET network error */
-extern volatile int noshare socket_errno;
-extern volatile int noshare vmserrno;
-#define errno (socket_errno ? socket_errno : vmserrno)
-#endif /* MULTINET */
-#include <ssdef.h> /* system services retcodes definitions */
-#include <jpidef.h> /* job and process information */
-#include <prvdef.h> /* privileges definitions */
-
-#endif /* vms */
-
-#if defined(vms) && defined(DECC)
-#define __alpha
-#endif
-
-#if defined(vms) && defined(__alpha) && defined(COMPILE_NOPREFIX)
-#define atoi DECC$ATOI
-#define free DECC$FREE
-#define getenv DECC$GETENV
-#define strcpy DECC$STRCPY
-#define strcmp DECC$STRCMP
-#define strlen DECC$STRLEN
-#define strncpy DECC$STRNCPY
-#endif /* vms && __alpha && COMPILE_NOPREFIX */
-
-extern char *getconfent();
-
-#ifdef vms
-#define USERNAME_L 12
-typedef struct {
- short bufl;
- short code;
- char *buf;
- unsigned int *retl;
-} Item;
-
-char username[USERNAME_L+1]; /* username buffer */
-unsigned int usernamel; /* length of dito */
-unsigned int curpriv[2]; /* current process privileges */
-unsigned int curprivl; /* length of dito */
-
-static struct {
- Item item[2];
- int eol;
-} itemlist = {
- {
- { sizeof(curpriv), JPI$_CURPRIV, curpriv, &curprivl },
- { sizeof(username), JPI$_USERNAME, username, &usernamel},
- },
- 0
-};
-
-#endif /* vms */
-
-int
-_sysreq(loginid, acct, sernam, comtxt, comtxtl, reptxt, arysz)
-char *loginid; /* requestor's login id */
-char *acct; /* requestor's account */
-char *sernam; /* Service name */
-char *comtxt; /* Command text */
-short comtxtl; /* Command text length */
-char *reptxt; /* Reply text */
-int *arysz; /* Reply array size, actual size on return */
-{
- char sysreq_host[100];
- short sysreq_port; /* SYSREQ service port number */
- struct servent *sp; /* services pointer */
- struct hostent *hp; /* host pointer */
- struct sockaddr_in sin; /* internet socket */
- int s; /* socket descriptor */
- LONG magic; /* to hold magic number trust */
- WORD reqtype; /* to hold the request type */
- char *p; /* a character array pointer */
- int replylen; /* SYSREQ reply length */
- int sysreqrc; /* SYSREQ return code */
-#ifdef unix
- struct passwd *pw; /* Password entry structure */
-#endif /* unix */
-#ifdef vms
- int rc; /* system services return code */
-#endif /* vms */
-
- sysreq_port = SYSREQ_PORT;
-
-/*
- * Get some run-time options
- */
-
- INIT_TRACE("SYSREQ_TRACE");
- if ((p = getenv("SYSREQ_HOST")) != NULL) {
- strcpy(sysreq_host, p);
- }
- else {
- if ((p = getconfent("SYSREQ", "HOST",0)) == NULL ||
- strcmp(p,"") == 0) {
- strcpy (sysreq_host,SYSREQ_HOST);
- }
- else {
- strcpy(sysreq_host, p);
- }
- }
- if ((p = getenv("SYSREQ_PORT")) != NULL) {
- sysreq_port = atoi(p);
- }
-
- TRACE(1, "sysreq", "_sysreq(%s,%s,%s,%d,%x,%d) entered",
- loginid, sernam, comtxt, comtxtl, reptxt, *arysz);
-
- sin.sin_family = AF_INET;
-
- TRACE(2, "sysreq", "Looking for host %s",sysreq_host);
- hp = gethostbyname(sysreq_host);
- if (hp == NULL) {
- serrno = SENOSHOST;
- END_TRACE();
- return(-SENOSHOST);
- }
- sin.sin_addr.s_addr = ((struct in_addr *)(hp->h_addr))->s_addr;
-
-#if SERVICESDB
- if ((p = getenv("SYSREQ_PORT")) == NULL) {
- TRACE(2, "sysreq", "Looking for service %s on %s",
- SYSREQ_NAME, SYSREQ_PROTO);
- if ((sp = getservbyname(SYSREQ_NAME, SYSREQ_PROTO)) == NULL) {
- serrno = SENOSSERV;
- END_TRACE();
- return(-SENOSSERV);
- }
- sin.sin_port = sp->s_port;
- sysreq_port = ntohs(sp->s_port);
- }
-#endif /* services */
- TRACE(2, "sysreq", "Assigning port %d to %s using %s",
- sysreq_port, SYSREQ_NAME, SYSREQ_PROTO);
- sin.sin_port = htons(sysreq_port);
-
- TRACE(2, "sysreq", "creating socket");
- if ((s = socket(AF_INET, SOCK_STREAM, 0)) == -1) {
- TRACE(2, "sysreq", "socket(): (errno=%d)", errno);
- END_TRACE();
- return(-errno);
- }
-
- TRACE(2, "sysreq", "connecting %s port %d", sysreq_host, sysreq_port);
- if (connect(s, (struct sockaddr *)&sin, sizeof(struct sockaddr_in)) ==
- -1) {
- TRACE(2, "sysreq", "connect(): (errno=%d)", errno);
- (void) close(s);
- END_TRACE();
- return(-errno);
- }
-
- magic = C_MAGIC;
- TRACE(2, "sysreq", "send magic number: %x",C_MAGIC);
- if (SendLong(s, &magic) < 0) {
- TRACE(2, "sysreq", "SendLong(magic): (errno=%d)", errno);
- (void) close(s);
- END_TRACE();
- return(-errno);
- }
- TRACE(2, "sysreq", "receive magic number");
- if (RecvLong(s, &magic) < 0) {
- TRACE(2, "sysreq", "RecvLong(magic): (errno=%d)", errno);
- (void) close(s);
- END_TRACE();
- return(-errno);
- }
- TRACE(2, "sysreq", "server magic: %x", magic);
- if (magic != S_MAGIC) {
- TRACE(2, "sysreq", "server: bad magic number: %x", magic);
- (void) close(s);
- serrno = SEBADVERSION;
- END_TRACE();
- return(-SEBADVERSION);
- }
- if (loginid == (char *)0) loginid = "";
-/*
- * send out effective id (i.e. the one really issuing the request
- */
-#ifdef unix
- pw = getpwuid(geteuid());
- if (strcmp(pw->pw_name,loginid)) {
- if (strcmp(pw->pw_name,"root")) { /* Not authorized */
- TRACE(2, "sysreq", "user %s not authorized",
- pw->pw_name);
- loginid = pw->pw_name;
- }
- }
- TRACE(2, "sysreq","send loginid: %s",loginid);
- if ((int) SendStr(s, loginid, strlen(loginid)) < 0) {
- TRACE(2, "sysreq", "SendStr(loginid): (errno=%d)", errno);
- (void) close(s);
- END_TRACE();
- return(-errno);
- }
- TRACE(2, "sysreq","send real user: %s", pw->pw_name);
- if ((int) SendStr(s, pw->pw_name, strlen(pw->pw_name)) < 0) {
- TRACE(2, "sysreq", "SendStr(realuser): (errno=%d)", errno);
- (void) close(s);
- END_TRACE();
- return(-errno);
- }
-#endif /* unix */
-#ifdef vms
- TRACE(2, "sysreq","send loginid: %s",loginid);
- /* if PRV$_SYSPRV is granted, we issue the command as SYSTEM */
- if ((rc = sys$getjpi(0, 0, 0, &itemlist, 0, 0, 0)) != SS$_NORMAL) {
- if (!(rc & 0x01)) {
- vaxc$errno = rc;
-#if defined(MULTINET) && (MULTINET == 1)
- vmserrno = EVMSERR;
-#endif /* MULTINET */
-#if defined(TWG) && (TWG == 1)
- vmserrno = EVMSERR;
-#endif /* TWG */
-#if defined(UCX) && (UCX == 1)
- errno = EVMSERR;
-#endif /* UCX */
- return(-errno);
- }
- }
- username[usernamel]='\0';
- if (curpriv[0] & PRV$M_SYSPRV) { /* pretend being SYSTEM */
- loginid = "SYSTEM";
- }
-
- if ((int) SendStr(s, loginid, strlen(loginid)) < 0) {
- TRACE(2, "sysreq", "SendStr(loginid): (errno=%d)", errno);
- (void) close(s);
- END_TRACE();
- return(-errno);
- }
- TRACE(2, "sysreq","send real user: %s", username);
- if ((int) SendStr(s, username, strlen(username)) < 0) {
- TRACE(2, "sysreq", "SendStr(realuser): (errno=%d)", errno);
- (void) close(s);
- END_TRACE();
- return(-errno);
- }
-#endif /* vms */
- TRACE(2, "sysreq", "send account: %s",acct);
- if ((int) SendStr(s, acct, strlen(acct)) < 0) {
- TRACE(2, "sysreq", "SendStr(account): (errno=%d)", errno);
- (void) close(s);
- END_TRACE();
- return(-errno);
- }
-
-/*
- * Process here
- */
- reqtype = SYSREQTYPE;
- TRACE(2, "sysreq", "send request type: 0X%X", reqtype);
- if ((int) SendWord(s, &reqtype) < 0) {
- TRACE(2, "sysreq", "SendWord(ReqType): (errno=%d)", errno);
- (void) close(s);
- END_TRACE();
- return(-errno);
- }
-
- TRACE(2, "sysreq", "send service name: %s",sernam);
- if ((int) SendStr(s, sernam, strlen(sernam)) < 0) {
- TRACE(2, "sysreq", "SendStr(ServiceName): (errno=%d)", errno);
- (void) close(s);
- END_TRACE();
- return(-errno);
- }
- TRACE(2, "sysreq", "send comm. text: <%s>",comtxt);
- if ((int) SendStr(s, comtxt, comtxtl) < 0) {
- TRACE(2, "sysreq", "SendStr(CommTxt): (errno=%d)", errno);
- (void) close(s);
- END_TRACE();
- return(-errno);
- }
- TRACE(2, "sysreq", "recv reply length");
- if ((int)(p = RecvStr(s, &replylen)) <0) {
- TRACE(2, "sysreq", "RecvStr(RepLen): (errno=%d)", errno);
- (void) close(s);
- END_TRACE();
- return(-errno);
- }
- TRACE(2, "sysreq", "reply length is %d byte(s) long", replylen);
- TRACE(2, "sysreq", "recv return code");
- if (RecvLong(s, &sysreqrc) <0) {
- TRACE(2, "sysreq", "RecvLong(RetCode): (errno=%d)", errno);
- (void) free(p);
- (void) close(s);
- END_TRACE();
- return(-errno);
- }
- TRACE(2, "sysreq", "return code is %d (dec)", sysreqrc);
-
- TRACE(2, "sysreq", "user buffer at %x is %d byte(s) long",
- reptxt, *arysz);
- if (*arysz-1 < replylen) {
- TRACE(2, "sysreq", "strncpy(%x,%x,%d)", reptxt,p,*arysz-1);
- strncpy(reptxt, p, *arysz-1);
- reptxt[*arysz] = '\0';
- free(p);
- TRACE(2, "sysreq", "reply buffer too short");
- TRACE(2, "sysreq", "shutdown socket");
- (void) shutdown(s, 2);
- (void) close(s);
- serrno = SEUBUF2SMALL;
- END_TRACE();
- return(-SEUBUF2SMALL);
- }
- TRACE(2, "sysreq", "strncpy(%x,%x,%d)", reptxt,p,replylen);
- strncpy(reptxt, p, replylen);
- *arysz = replylen;
- free(p);
- TRACE(2, "sysreq", "shutdown socket");
- (void) shutdown(s, 2);
- (void) close(s);
- END_TRACE();
- return(sysreqrc);
-}
diff --git a/src/packlib/cspack/sysreq/osdep.h b/src/packlib/cspack/sysreq/osdep.h
deleted file mode 100644
index 0a3e6bc..0000000
--- a/src/packlib/cspack/sysreq/osdep.h
+++ /dev/null
@@ -1,136 +0,0 @@
-/*
- * $Id: osdep.h,v 1.1.1.1 1996/03/08 15:44:26 mclareni Exp $
- *
- * $Log: osdep.h,v $
- * Revision 1.1.1.1 1996/03/08 15:44:26 mclareni
- * Cspack
- *
- */
-/*
- * Copyright (C) 1990-1992 by CERN/CN/SW/DC
- * All rights reserved
- */
-
-/*
- * @(#)osdep.h 1.4 10/14/92 CERN CN-SW/DC Frederic Hemmer
- */
-
-/* osdep.h Operating system dependencies */
-
-#ifndef _OSDEP_H_INCLUDED_
-#define _OSDEP_H_INCLUDED_
-
-/*
- * Data representation
- */
-
-#define BYTESIZE 1
-#define WORDSIZE 2
-#define LONGSIZE 4
-#define QUADSIZE 8
-
-#if defined(unix) || defined(_AIX)
-#ifndef CRAY
-typedef unsigned char U_BYTE;
-typedef unsigned short U_WORD;
-typedef unsigned int U_LONG;
-typedef struct {
- U_LONG lslw;
- U_LONG mslw;
-} U_QUAD;
-typedef char BYTE;
-typedef short WORD;
-typedef int LONG;
-typedef struct {
- U_LONG lslw;
- LONG mslw;
-} QUAD;
-#else /* CRAY */
-typedef unsigned char U_BYTE;
-typedef unsigned short U_WORD;
-typedef int U_LONG;
-typedef unsigned long U_QUAD;
-
-typedef char BYTE;
-typedef short WORD;
-typedef int LONG;
-typedef long QUAD;
-
-#endif /* CRAY */
-#endif /* unix */
-
-#ifdef VM
-typedef unsigned char U_BYTE;
-typedef unsigned short U_WORD;
-typedef unsigned int U_LONG;
-typedef struct {
- U_LONG lslw;
- U_LONG mslw;
-} U_QUAD;
-typedef char BYTE;
-typedef short WORD;
-typedef int LONG;
-typedef struct {
- LONG lslw;
- LONG mslw;
-} QUAD;
-
-#endif /* VM */
-
-#ifdef vms
-typedef unsigned char U_BYTE;
-typedef unsigned short U_WORD;
-typedef unsigned int U_LONG;
-typedef struct {
- U_LONG lslw;
- U_LONG mslw;
-} U_QUAD;
-typedef char BYTE;
-typedef short WORD;
-typedef int LONG;
-typedef struct {
- LONG lslw;
- LONG mslw;
-} QUAD;
-
-#endif /* vms */
-
-#define BYTEADDR(x) (((char *)&(x))+sizeof(BYTE)-BYTESIZE)
-#define WORDADDR(x) (((char *)&(x))+sizeof(WORD)-WORDSIZE)
-#define LONGADDR(x) (((char *)&(x))+sizeof(LONG)-LONGSIZE)
-#define QUADADDR(x) (((char *)&(x))+sizeof(QUAD)-QUADSIZE)
-
-/*
- * Byte swapping
- */
-
-/*
- * Exit codes
- */
-
-#ifdef unix
-#define BADEXIT 1
-#define GOODEXIT 0
-#endif /* unix */
-#ifdef VM
-#define BADEXIT -1
-#define GOODEXIT 0
-#endif /* VM */
-#ifdef vms
-#define BADEXIT 0
-#define GOODEXIT 1
-#endif /* vms */
-
-/*
- * Error reporting
- */
-
-#ifdef VM
-#define NETERROR tcperror
-#define OSERROR perror
-#else
-#define NETERROR perror
-#define OSERROR perror
-#endif /* VM */
-
-#endif /* _OSDEP_H_INCLUDED_ */
diff --git a/src/packlib/cspack/sysreq/patchlevel.h b/src/packlib/cspack/sysreq/patchlevel.h
deleted file mode 100644
index c07c893..0000000
--- a/src/packlib/cspack/sysreq/patchlevel.h
+++ /dev/null
@@ -1,38 +0,0 @@
-/*
- * $Id: patchlevel.h,v 1.1.1.1 1996/03/08 15:44:26 mclareni Exp $
- *
- * $Log: patchlevel.h,v $
- * Revision 1.1.1.1 1996/03/08 15:44:26 mclareni
- * Cspack
- *
- */
-/*
- * @(#)patchlevel.h 1.2 9/3/91 CERN CN-SW/DC Frederic Hemmer
- */
-
-/*
- * Copyright (C) 1990,1991 by CERN/CN/SW/DC
- * All rights reserved
- */
-
-/* patchlevel.h Patch level */
-
-#ifndef _PATCHLEVEL_H_INCLUDED_
-#define _PATCHLEVEL_H_INCLUDED_
-
-/************************************************************************/
-/* PATCHLEVEL Description and changes */
-/************************************************************************/
-/* 1.0 Mar 20, 1991 First working version */
-/* 1.1 Jul 23, 1991 First exportable version. Support for rfio, */
-/* msg, rtcopy, sysreq and library */
-/* 1.2 Sep 3, 1991 Added tape support, Tape Management System */
-/* support. rtcopy -FF thru C IO. Provision for */
-/* truncated data records, data buffering. */
-/* rfio logs now short. Many many fixes */
-/************************************************************************/
-
-
-#define PATCHLEVEL 1.2
-
-#endif /* _PATCHLEVEL_H_INCLUDED_ */
diff --git a/src/packlib/cspack/sysreq/pcbdef.h b/src/packlib/cspack/sysreq/pcbdef.h
deleted file mode 100644
index 198576f..0000000
--- a/src/packlib/cspack/sysreq/pcbdef.h
+++ /dev/null
@@ -1,684 +0,0 @@
-/*
- * $Id: pcbdef.h,v 1.1.1.1 1996/03/08 15:44:26 mclareni Exp $
- *
- * $Log: pcbdef.h,v $
- * Revision 1.1.1.1 1996/03/08 15:44:26 mclareni
- * Cspack
- *
- */
-#if defined(CERNLIB_VAXVMS)
-#if defined(CERNLIB_PREVMS61)
-#define PCB$M_RES 1
-#define PCB$M_DELPEN 2
-#define PCB$M_FORCPEN 4
-#define PCB$M_INQUAN 8
-#define PCB$M_PSWAPM 16
-#define PCB$M_RESPEN 32
-#define PCB$M_SSFEXC 64
-#define PCB$M_SSFEXCE 128
-#define PCB$M_SSFEXCS 256
-#define PCB$M_SSFEXCU 512
-#define PCB$M_SSRWAIT 1024
-#define PCB$M_SUSPEN 2048
-#define PCB$M_WAKEPEN 4096
-#define PCB$M_WALL 8192
-#define PCB$M_BATCH 16384
-#define PCB$M_NOACNT 32768
-#define PCB$M_NOSUSPEND 65536
-#define PCB$M_ASTPEN 131072
-#define PCB$M_PHDRES 262144
-#define PCB$M_HIBER 524288
-#define PCB$M_LOGIN 1048576
-#define PCB$M_NETWRK 2097152
-#define PCB$M_PWRAST 4194304
-#define PCB$M_NODELET 8388608
-#define PCB$M_DISAWS 16777216
-#define PCB$M_INTER 33554432
-#define PCB$M_RECOVER 67108864
-#define PCB$M_SECAUDIT 134217728
-#define PCB$M_HARDAFF 268435456
-#define PCB$M_ERDACT 536870912
-#define PCB$M_SOFTSUSP 1073741824
-#define PCB$M_PREEMPTED -2147483648
-#define PCB$M_QUANTUM_RESCHED 1
-#define PCB$M_EPID_WILD -2147483648
-#define PCB$K_LENGTH 372
-#define PCB$C_LENGTH 372
-#define PCB$S_PCBDEF 372
-#define PCB$L_SQFL 0
-#define PCB$L_SQBL 4
-#define PCB$W_SIZE 8
-#define PCB$B_TYPE 10
-#define PCB$B_WEFC 11
-#define PCB$L_PHYPCB 12
-#define PCB$L_ASTQFL 16
-#define PCB$L_ASTQBL 20
-#define PCB$B_ASTACT 24
-#define PCB$B_ASTEN 25
-#define PCB$W_STATE 26
-#define PCB$B_PRI 28
-#define PCB$B_PRIB 29
-#define PCB$B_RESERVED_B1 30
-#define PCB$B_AFFINITY_SKIP 31
-#define PCB$L_OWNER 32
-#define PCB$L_STS 36
-#define PCB$V_RES 0
-#define PCB$V_DELPEN 1
-#define PCB$V_FORCPEN 2
-#define PCB$V_INQUAN 3
-#define PCB$V_PSWAPM 4
-#define PCB$V_RESPEN 5
-#define PCB$V_SSFEXC 6
-#define PCB$V_SSFEXCE 7
-#define PCB$V_SSFEXCS 8
-#define PCB$V_SSFEXCU 9
-#define PCB$V_SSRWAIT 10
-#define PCB$V_SUSPEN 11
-#define PCB$V_WAKEPEN 12
-#define PCB$V_WALL 13
-#define PCB$V_BATCH 14
-#define PCB$V_NOACNT 15
-#define PCB$V_NOSUSPEND 16
-#define PCB$V_ASTPEN 17
-#define PCB$V_PHDRES 18
-#define PCB$V_HIBER 19
-#define PCB$V_LOGIN 20
-#define PCB$V_NETWRK 21
-#define PCB$V_PWRAST 22
-#define PCB$V_NODELET 23
-#define PCB$V_DISAWS 24
-#define PCB$V_INTER 25
-#define PCB$V_RECOVER 26
-#define PCB$V_SECAUDIT 27
-#define PCB$V_HARDAFF 28
-#define PCB$V_ERDACT 29
-#define PCB$V_SOFTSUSP 30
-#define PCB$V_PREEMPTED 31
-#define PCB$L_STS2 40
-#define PCB$V_QUANTUM_RESCHED 0
-#define PCB$L_WTIME 44
-#define PCB$B_PRISAV 44
-#define PCB$B_PRIBSAV 45
-#define PCB$B_DPC 46
-#define PCB$B_AUTHPRI 47
-#define PCB$L_ONQTIME 48
-#define PCB$L_WAITIME 52
-#define PCB$W_ASTCNT 56
-#define PCB$W_BIOCNT 58
-#define PCB$W_BIOLM 60
-#define PCB$W_DIOCNT 62
-#define PCB$W_DIOLM 64
-#define PCB$W_PRCCNT 66
-#define PCB$S_TERMINAL 8
-#define PCB$T_TERMINAL 68
-#define PCB$L_PQB 76
-#define PCB$L_EFWM 76
-#define PCB$L_EFCS 80
-#define PCB$L_EFCU 84
-#define PCB$W_PGFLCHAR 88
-#define PCB$B_PGFLINDEX 90
-#define PCB$L_EFC2P 88
-#define PCB$L_EFC3P 92
-#define PCB$L_PID 96
-#define PCB$L_EPID 100
-#define PCB$S_EPID_PROC 21
-#define PCB$V_EPID_PROC 0
-#define PCB$S_EPID_NODE_IDX 8
-#define PCB$V_EPID_NODE_IDX 21
-#define PCB$S_EPID_NODE_SEQ 2
-#define PCB$V_EPID_NODE_SEQ 29
-#define PCB$V_EPID_WILD 31
-#define PCB$L_EOWNER 104
-#define PCB$L_PHD 108
-#define PCB$W_APTCNT 112
-#define PCB$W_MTXCNT 114
-#define PCB$L_GPGCNT 116
-#define PCB$L_PPGCNT 120
-#define PCB$L_JIB 124
-#define PCB$L_WSSWP 128
-#define PCB$L_SWAPSIZE 132
-#define PCB$S_PCBARB 124
-#define PCB$R_PCBARB 136
-#define PCB$S_PRIV 8
-#define PCB$Q_PRIV 136
-#define PCB$L_ARB 144
-#define PCB$L_UIC 196
-#define PCB$W_MEM 196
-#define PCB$W_GRP 198
-#define PCB$L_ORB 260
-#define PCB$W_TMBU 266
-#define PCB$L_LOCKQFL 268
-#define PCB$L_LOCKQBL 272
-#define PCB$L_DLCKPRI 276
-#define PCB$L_IPAST 280
-#define PCB$L_DEFPROT 284
-#define PCB$L_PMB 288
-#define PCB$L_AFFINITY 292
-#define PCB$L_SCHED_SPARE 296
-#define PCB$L_CAPABILITY 300
-#define PCB$L_CPU_ID 304
-#define PCB$L_CPUTIM 308
-#define PCB$S_LNAME 16
-#define PCB$T_LNAME 312
-#define PCB$L_PRCPDB 328
-#define PCB$L_PIXHIST 332
-#define PCB$L_NS_RESERVED_Q1 336
-#define PCB$L_NS_RESERVED_Q1_L1 336
-#define PCB$L_VP_CONTEXT 336
-#define PCB$L_AFFINITY_CALLBACK 340
-#define PCB$L_PERMANENT_CAPABILITY 344
-#define PCB$L_PERMANENT_CPU_AFFINITY 348
-#define PCB$S_CWPSSRV_QUEUE 8
-#define PCB$Q_CWPSSRV_QUEUE 352
-#define PCB$L_CURRENT_AFFINITY 360
-#define PCB$L_CAPABILITY_SEQ 364
-#define PCB$w_spare_W1 368
-#define PCB$w_spare_W2 370
-#endif
-#if (!defined(CERNLIB_PREVMS61))&&(!defined(CERNLIB_QMALPH))
-/*+ PCBDEF
- Definitions created for V6.1 by C_DEFS at 25-AUG-1994 09:59:19.05
-
- Use @C_DEFS PCBDEF
-
-*/
-#define PCB$M_RES 1
-#define PCB$M_DELPEN 2
-#define PCB$M_FORCPEN 4
-#define PCB$M_INQUAN 8
-#define PCB$M_PSWAPM 16
-#define PCB$M_RESPEN 32
-#define PCB$M_SSFEXC 64
-#define PCB$M_SSFEXCE 128
-#define PCB$M_SSFEXCS 256
-#define PCB$M_SSFEXCU 512
-#define PCB$M_SSRWAIT 1024
-#define PCB$M_SUSPEN 2048
-#define PCB$M_WAKEPEN 4096
-#define PCB$M_WALL 8192
-#define PCB$M_BATCH 16384
-#define PCB$M_NOACNT 32768
-#define PCB$M_NOSUSPEND 65536
-#define PCB$M_ASTPEN 131072
-#define PCB$M_PHDRES 262144
-#define PCB$M_HIBER 524288
-#define PCB$M_LOGIN 1048576
-#define PCB$M_NETWRK 2097152
-#define PCB$M_PWRAST 4194304
-#define PCB$M_NODELET 8388608
-#define PCB$M_DISAWS 16777216
-#define PCB$M_INTER 33554432
-#define PCB$M_RECOVER 67108864
-#define PCB$M_SECAUDIT 134217728
-#define PCB$M_HARDAFF 268435456
-#define PCB$M_ERDACT 536870912
-#define PCB$M_SOFTSUSP 1073741824
-#define PCB$M_PREEMPTED (-2147483648)
-#define PCB$M_QUANTUM_RESCHED 1
-#define PCB$M_FORK_RESPEN 2
-#define PCB$M_POSIX_SIGNAL 4
-#define PCB$M_PHDLOCK 8
-#define PCB$M_TCB 16
-#define PCB$M_VBSRES 32
-#define PCB$M_RBS_IP 64
-#define PCB$M_VBS_IP 128
-#define PCB$M_RBS_QUANTUM 256
-#define PCB$M_SWPO_IP 512
-#define PCB$M_SWPI_IP 1024
-#define PCB$M_CLASS_SCHEDULED 2048
-#define PCB$M_CLASS_SUPPLIED 4096
-#define PCB$M_RESERVED_CS 8192
-#define PCB$M_IN_TBS_STATE 16384
-#define PCB$M_WINDFALL 32768
-#define PCB$M_TERM_NOTIFY 65536
-#define PCB$M_BYTLM_LOAN 131072
-#define PCB$M_VBS_OPT2_INH 262144
-#define PCB$M_NOUNSHELVE 524288
-#define PCB$M_SHELVING_RESERVED 1048576
-#define PCB$M_EPID_WILD (-2147483648)
-#define PCB$M_NOAUDIT 1
-#define PCB$K_SCHED_OTHER 0
-#define PCB$K_SCHED_FIFO 1
-#define PCB$K_SCHED_RR 2
-#define PCB$K_LENGTH 468
-#define PCB$C_LENGTH 468
-#define PCB$S_PCBDEF 468
-#define PCB$L_SQFL 0
-#define PCB$L_SQBL 4
-#define PCB$W_SIZE 8
-#define PCB$B_TYPE 10
-#define PCB$B_WEFC 11
-#define PCB$L_PHYPCB 12
-#define PCB$L_ASTQFL 16
-#define PCB$L_ASTQBL 20
-#define PCB$B_ASTACT 24
-#define PCB$B_ASTEN 25
-#define PCB$W_STATE 26
-#define PCB$B_PRI 28
-#define PCB$B_PRIB 29
-#define PCB$B_RESERVED_B1 30
-#define PCB$B_AFFINITY_SKIP 31
-#define PCB$L_OWNER 32
-#define PCB$L_STS 36
-#define PCB$V_RES 0
-#define PCB$V_DELPEN 1
-#define PCB$V_FORCPEN 2
-#define PCB$V_INQUAN 3
-#define PCB$V_PSWAPM 4
-#define PCB$V_RESPEN 5
-#define PCB$V_SSFEXC 6
-#define PCB$V_SSFEXCE 7
-#define PCB$V_SSFEXCS 8
-#define PCB$V_SSFEXCU 9
-#define PCB$V_SSRWAIT 10
-#define PCB$V_SUSPEN 11
-#define PCB$V_WAKEPEN 12
-#define PCB$V_WALL 13
-#define PCB$V_BATCH 14
-#define PCB$V_NOACNT 15
-#define PCB$V_NOSUSPEND 16
-#define PCB$V_ASTPEN 17
-#define PCB$V_PHDRES 18
-#define PCB$V_HIBER 19
-#define PCB$V_LOGIN 20
-#define PCB$V_NETWRK 21
-#define PCB$V_PWRAST 22
-#define PCB$V_NODELET 23
-#define PCB$V_DISAWS 24
-#define PCB$V_INTER 25
-#define PCB$V_RECOVER 26
-#define PCB$V_SECAUDIT 27
-#define PCB$V_HARDAFF 28
-#define PCB$V_ERDACT 29
-#define PCB$V_SOFTSUSP 30
-#define PCB$V_PREEMPTED 31
-#define PCB$L_STS2 40
-#define PCB$V_QUANTUM_RESCHED 0
-#define PCB$V_FORK_RESPEN 1
-#define PCB$V_POSIX_SIGNAL 2
-#define PCB$V_PHDLOCK 3
-#define PCB$V_TCB 4
-#define PCB$V_VBSRES 5
-#define PCB$V_RBS_IP 6
-#define PCB$V_VBS_IP 7
-#define PCB$V_RBS_QUANTUM 8
-#define PCB$V_SWPO_IP 9
-#define PCB$V_SWPI_IP 10
-#define PCB$V_CLASS_SCHEDULED 11
-#define PCB$V_CLASS_SUPPLIED 12
-#define PCB$V_RESERVED_CS 13
-#define PCB$V_IN_TBS_STATE 14
-#define PCB$V_WINDFALL 15
-#define PCB$V_TERM_NOTIFY 16
-#define PCB$V_BYTLM_LOAN 17
-#define PCB$V_VBS_OPT2_INH 18
-#define PCB$V_NOUNSHELVE 19
-#define PCB$V_SHELVING_RESERVED 20
-#define PCB$L_WTIME 44
-#define PCB$B_PRISAV 44
-#define PCB$B_PRIBSAV 45
-#define PCB$B_DPC 46
-#define PCB$B_AUTHPRI 47
-#define PCB$L_ONQTIME 48
-#define PCB$L_WAITIME 52
-#define PCB$W_ASTCNT 56
-#define PCB$W_BIOCNT 58
-#define PCB$W_BIOLM 60
-#define PCB$W_DIOCNT 62
-#define PCB$W_DIOLM 64
-#define PCB$W_PRCCNT 66
-#define PCB$S_TERMINAL 8
-#define PCB$T_TERMINAL 68
-#define PCB$L_PQB 76
-#define PCB$L_EFWM 76
-#define PCB$L_EFCS 80
-#define PCB$L_EFCU 84
-#define PCB$W_PGFLCHAR 88
-#define PCB$B_PGFLINDEX 90
-#define PCB$L_EFC2P 88
-#define PCB$L_EFC3P 92
-#define PCB$L_PID 96
-#define PCB$L_EPID 100
-#define PCB$S_EPID_PROC 21
-#define PCB$V_EPID_PROC 0
-#define PCB$S_EPID_NODE_IDX 8
-#define PCB$V_EPID_NODE_IDX 21
-#define PCB$S_EPID_NODE_SEQ 2
-#define PCB$V_EPID_NODE_SEQ 29
-#define PCB$V_EPID_WILD 31
-#define PCB$L_EOWNER 104
-#define PCB$L_PHD 108
-#define PCB$W_APTCNT 112
-#define PCB$W_MTXCNT 114
-#define PCB$L_GPGCNT 116
-#define PCB$L_PPGCNT 120
-#define PCB$L_JIB 124
-#define PCB$L_WSSWP 128
-#define PCB$L_SWAPSIZE 132
-#define PCB$S_PCBARB 124
-#define PCB$R_PCBARB 136
-#define PCB$S_PRIV 8
-#define PCB$Q_PRIV 136
-#define PCB$L_ARB 144
-#define PCB$L_UIC 196
-#define PCB$W_MEM 196
-#define PCB$W_GRP 198
-#define PCB$L_ORB 260
-#define PCB$W_NOAUDIT 264
-#define PCB$V_NOAUDIT 0
-#define PCB$W_TMBU 266
-#define PCB$L_LOCKQFL 268
-#define PCB$L_LOCKQBL 272
-#define PCB$L_DLCKPRI 276
-#define PCB$L_IPAST 280
-#define PCB$L_DEFPROT 284
-#define PCB$L_PMB 288
-#define PCB$L_AFFINITY 292
-#define PCB$L_SCHED_SPARE 296
-#define PCB$B_SCHED_POLICY 296
-#define PCB$L_CAPABILITY 300
-#define PCB$L_CPU_ID 304
-#define PCB$L_CPUTIM 308
-#define PCB$S_LNAME 16
-#define PCB$T_LNAME 312
-#define PCB$L_PRCPDB 328
-#define PCB$L_PIXHIST 332
-#define PCB$L_NS_RESERVED_Q1 336
-#define PCB$L_NS_RESERVED_Q1_L1 336
-#define PCB$L_VP_CONTEXT 336
-#define PCB$L_AFFINITY_CALLBACK 340
-#define PCB$L_PERMANENT_CAPABILITY 344
-#define PCB$L_PERMANENT_CPU_AFFINITY 348
-#define PCB$S_CWPSSRV_QUEUE 8
-#define PCB$Q_CWPSSRV_QUEUE 352
-#define PCB$L_CURRENT_AFFINITY 360
-#define PCB$L_CAPABILITY_SEQ 364
-#define PCB$L_XPCB 368
-#define PCB$L_SOURCE_EPID 372
-#define PCB$S_BUFOBJ_LIST 8
-#define PCB$Q_BUFOBJ_LIST 376
-#define PCB$L_ADB_LINK 384
-#define PCB$W_TOTAL_EVTAST 388
-#define PCB$A_CURRENT_TX 392
-#define PCB$A_CURRENT_CD 396
-#define PCB$A_CURRENT_VERTEX 400
-#define PCB$S_XSCB_QUE 8
-#define PCB$Q_XSCB_QUE 404
-#define PCB$A_XSCB_FLINK 404
-#define PCB$A_XSCB_BLINK 408
-#define PCB$S_RMCB_QUE 8
-#define PCB$Q_RMCB_QUE 412
-#define PCB$A_RMCB_FLINK 412
-#define PCB$A_RMCB_BLINK 416
-#define PCB$S_CD_QUE 8
-#define PCB$Q_CD_QUE 420
-#define PCB$A_CD_FLINK 420
-#define PCB$A_CD_BLINK 424
-#define PCB$L_CPUTIME_REF 428
-#define PCB$L_ACC_WAITIME 432
-#define PCB$S_RDPB_QUE 8
-#define PCB$Q_RDPB_QUE 436
-#define PCB$A_RDPB_FLINK 436
-#define PCB$A_RDPB_BLINK 440
-#define PCB$L_VBSM 444
-#define PCB$L_PHD_WIND 448
-#define PCB$L_PHD_VPN 452
-#define PCB$L_PHD_WIND_SVAPTE 456
-#define PCB$L_CUR_TRAN 460
-#define PCB$L_RBS_TRAN 464
-#endif
-#if (!defined(CERNLIB_PREVMS61))&&(defined(CERNLIB_QMALPH))
-/*+ PCBDEF
- Definitions created for AXP V6.1 by C_DEFS at 13-SEP-1994 17:52:08.38
-*/
-#define PCB$M_RES 1
-#define PCB$M_DELPEN 2
-#define PCB$M_FORCPEN 4
-#define PCB$M_INQUAN 8
-#define PCB$M_PSWAPM 16
-#define PCB$M_RESPEN 32
-#define PCB$M_SSFEXC 64
-#define PCB$M_SSFEXCE 128
-#define PCB$M_SSFEXCS 256
-#define PCB$M_SSFEXCU 512
-#define PCB$M_SSRWAIT 1024
-#define PCB$M_SUSPEN 2048
-#define PCB$M_WAKEPEN 4096
-#define PCB$M_WALL 8192
-#define PCB$M_BATCH 16384
-#define PCB$M_NOACNT 32768
-#define PCB$M_NOSUSPEND 65536
-#define PCB$M_ASTPEN 131072
-#define PCB$M_PHDRES 262144
-#define PCB$M_HIBER 524288
-#define PCB$M_LOGIN 1048576
-#define PCB$M_NETWRK 2097152
-#define PCB$M_PWRAST 4194304
-#define PCB$M_NODELET 8388608
-#define PCB$M_DISAWS 16777216
-#define PCB$M_INTER 33554432
-#define PCB$M_RECOVER 67108864
-#define PCB$M_SECAUDIT 134217728
-#define PCB$M_HARDAFF 268435456
-#define PCB$M_ERDACT 536870912
-#define PCB$M_SOFTSUSP 1073741824
-#define PCB$M_PREEMPTED (-2147483648)
-#define PCB$M_QUANTUM_RESCHED 1
-#define PCB$M_PHDLOCK 8
-#define PCB$M_TCB 16
-#define PCB$M_TERM_NOTIFY 65536
-#define PCB$M_BYTLM_LOAN 131072
-#define PCB$M_NOUNSHELVE 524288
-#define PCB$M_SHELVING_RESERVED 1048576
-#define PCB$M_CLASS_SCHEDULED 2097152
-#define PCB$M_CLASS_SUPPLIED 4194304
-#define PCB$M_IN_TBS_STATE 8388608
-#define PCB$M_WINDFALL 16777216
-#define PCB$M_EPID_WILD (-2147483648)
-#define PCB$M_FORK 1
-#define PCB$K_SCHED_OTHER 0
-#define PCB$K_SCHED_FIFO 1
-#define PCB$K_SCHED_RR 2
-#define PCB$K_SCHED_POLICY_CNT 3
-#define PCB$K_LENGTH 624
-#define PCB$C_LENGTH 624
-#define PCB$S_PCBDEF 624
-#define PCB$S_PCB 624
-#define PCB$L_SQFL 0
-#define PCB$L_SQBL 4
-#define PCB$W_SIZE 8
-#define PCB$B_TYPE 10
-#define PCB$L_AST_PENDING 12
-#define PCB$S_PHYPCB 8
-#define PCB$Q_PHYPCB 16
-#define PCB$S_LEFC_SWAPPED 8
-#define PCB$Q_LEFC_SWAPPED 24
-#define PCB$L_LEFC_0_SWAPPED 24
-#define PCB$L_LEFC_1_SWAPPED 28
-#define PCB$L_ASTQFL_SPK 32
-#define PCB$L_ASTQBL_SPK 36
-#define PCB$L_ASTQFL_K 40
-#define PCB$L_ASTQBL_K 44
-#define PCB$L_ASTQFL_E 48
-#define PCB$L_ASTQBL_E 52
-#define PCB$L_ASTQFL_S 56
-#define PCB$L_ASTQBL_S 60
-#define PCB$L_ASTQFL_U 64
-#define PCB$L_ASTQBL_U 68
-#define PCB$L_PRVCPU 72
-#define PCB$L_CPU_ID 76
-#define PCB$S_PRVASN 8
-#define PCB$Q_PRVASN 80
-#define PCB$S_PRVASNSEQ 8
-#define PCB$Q_PRVASNSEQ 88
-#define PCB$S_ONCPUCNT 8
-#define PCB$Q_ONCPUCNT 96
-#define PCB$L_ASTACT 104
-#define PCB$L_STATE 108
-#define PCB$L_PRI 112
-#define PCB$L_PRIB 116
-#define PCB$L_AFFINITY_SKIP 120
-#define PCB$L_OWNER 124
-#define PCB$L_STS 128
-#define PCB$V_RES 0
-#define PCB$V_DELPEN 1
-#define PCB$V_FORCPEN 2
-#define PCB$V_INQUAN 3
-#define PCB$V_PSWAPM 4
-#define PCB$V_RESPEN 5
-#define PCB$V_SSFEXC 6
-#define PCB$V_SSFEXCE 7
-#define PCB$V_SSFEXCS 8
-#define PCB$V_SSFEXCU 9
-#define PCB$V_SSRWAIT 10
-#define PCB$V_SUSPEN 11
-#define PCB$V_WAKEPEN 12
-#define PCB$V_WALL 13
-#define PCB$V_BATCH 14
-#define PCB$V_NOACNT 15
-#define PCB$V_NOSUSPEND 16
-#define PCB$V_ASTPEN 17
-#define PCB$V_PHDRES 18
-#define PCB$V_HIBER 19
-#define PCB$V_LOGIN 20
-#define PCB$V_NETWRK 21
-#define PCB$V_PWRAST 22
-#define PCB$V_NODELET 23
-#define PCB$V_DISAWS 24
-#define PCB$V_INTER 25
-#define PCB$V_RECOVER 26
-#define PCB$V_SECAUDIT 27
-#define PCB$V_HARDAFF 28
-#define PCB$V_ERDACT 29
-#define PCB$V_SOFTSUSP 30
-#define PCB$V_PREEMPTED 31
-#define PCB$L_STS2 132
-#define PCB$V_QUANTUM_RESCHED 0
-#define PCB$V_PHDLOCK 3
-#define PCB$V_TCB 4
-#define PCB$V_TERM_NOTIFY 16
-#define PCB$V_BYTLM_LOAN 17
-#define PCB$V_NOUNSHELVE 19
-#define PCB$V_SHELVING_RESERVED 20
-#define PCB$V_CLASS_SCHEDULED 21
-#define PCB$V_CLASS_SUPPLIED 22
-#define PCB$V_IN_TBS_STATE 23
-#define PCB$V_WINDFALL 24
-#define PCB$L_PRISAV 136
-#define PCB$L_PRIBSAV 140
-#define PCB$L_AUTHPRI 144
-#define PCB$L_ONQTIME 148
-#define PCB$L_WAITIME 152
-#define PCB$L_ASTCNT 156
-#define PCB$L_BIOCNT 160
-#define PCB$L_BIOLM 164
-#define PCB$L_DIOCNT 168
-#define PCB$L_DIOLM 172
-#define PCB$L_PRCCNT 176
-#define PCB$S_TERMINAL 8
-#define PCB$T_TERMINAL 180
-#define PCB$L_WEFC 188
-#define PCB$L_EFWM 192
-#define PCB$L_EFCS 196
-#define PCB$L_EFCU 200
-#define PCB$L_EFC2P 204
-#define PCB$L_EFC3P 208
-#define PCB$W_PGFLCHAR 204
-#define PCB$B_PGFLINDEX 206
-#define PCB$L_PID 212
-#define PCB$L_EPID 216
-#define PCB$S_EPID_PROC 21
-#define PCB$V_EPID_PROC 0
-#define PCB$S_EPID_NODE_IDX 8
-#define PCB$V_EPID_NODE_IDX 21
-#define PCB$S_EPID_NODE_SEQ 2
-#define PCB$V_EPID_NODE_SEQ 29
-#define PCB$V_EPID_WILD 31
-#define PCB$L_EOWNER 220
-#define PCB$L_APTCNT 224
-#define PCB$L_MTXCNT 228
-#define PCB$L_GPGCNT 232
-#define PCB$L_PPGCNT 236
-#define PCB$L_WSSWP 240
-#define PCB$L_SWAPSIZE 244
-#define PCB$L_PHD 248
-#define PCB$L_JIB 252
-#define PCB$S_PCBARB 124
-#define PCB$R_PCBARB 256
-#define PCB$S_PRIV 8
-#define PCB$Q_PRIV 256
-#define PCB$L_ARB 264
-#define PCB$L_UIC 316
-#define PCB$W_MEM 316
-#define PCB$W_GRP 318
-#define PCB$L_ORB 380
-#define PCB$L_TMBU 384
-#define PCB$L_LOCKQFL 388
-#define PCB$L_LOCKQBL 392
-#define PCB$L_DLCKPRI 396
-#define PCB$L_DEFPROT 400
-#define PCB$L_PMB 404
-#define PCB$L_AFFINITY 408
-#define PCB$L_CAPABILITY 412
-#define PCB$L_CPUTIM 416
-#define PCB$S_LNAME 16
-#define PCB$T_LNAME 420
-#define PCB$L_PRCPDB 436
-#define PCB$L_PIXHIST 440
-#define PCB$L_AFFINITY_CALLBACK 444
-#define PCB$L_PERMANENT_CAPABILITY 448
-#define PCB$L_PERMANENT_CPU_AFFINITY 452
-#define PCB$S_CWPSSRV_QUEUE 8
-#define PCB$Q_CWPSSRV_QUEUE 456
-#define PCB$L_CURRENT_AFFINITY 464
-#define PCB$L_CAPABILITY_SEQ 468
-#define PCB$S_BUFOBJ_LIST 8
-#define PCB$Q_BUFOBJ_LIST 472
-#define PCB$L_AST_BLOCKED 480
-#define PCB$L_ADB_LINK 484
-#define PCB$L_TOTAL_EVTAST 488
-#define PCB$A_CURRENT_TX 492
-#define PCB$A_CURRENT_CD 496
-#define PCB$A_CURRENT_VERTEX 500
-#define PCB$S_XSCB_QUE 8
-#define PCB$Q_XSCB_QUE 504
-#define PCB$A_XSCB_FLINK 504
-#define PCB$A_XSCB_BLINK 508
-#define PCB$S_RMCB_QUE 8
-#define PCB$Q_RMCB_QUE 512
-#define PCB$A_RMCB_FLINK 512
-#define PCB$A_RMCB_BLINK 516
-#define PCB$S_CD_QUE 8
-#define PCB$Q_CD_QUE 520
-#define PCB$A_CD_FLINK 520
-#define PCB$A_CD_BLINK 524
-#define PCB$L_DPC 528
-#define PCB$L_CPUTIME_REF 532
-#define PCB$L_ACC_WAITIME 536
-#define PCB$L_PRCSTR 540
-#define PCB$L_XPCB 544
-#define PCB$L_PSX_FORK_STATUS 548
-#define PCB$L_PSX_FLAGS 552
-#define PCB$V_FORK 0
-#define PCB$L_PSX_SPARE_L1 556
-#define PCB$L_PSX_ACTRTN 560
-#define PCB$L_PSX_ACTPRM 564
-#define PCB$L_KERNEL_COUNTER 568
-#define PCB$L_EXEC_COUNTER 572
-#define PCB$L_SUPER_COUNTER 576
-#define PCB$L_USER_COUNTER 580
-#define PCB$L_SCHED_POLICY 584
-#define PCB$A_FREWSLE_CALLOUT 588
-#define PCB$L_FREWSLE_PARAM 592
-#define PCB$L_PQB 592
-#define PCB$L_BUFOBJ_CNT 596
-#define PCB$L_NOAUDIT 600
-#define PCB$L_SOURCE_EPID 604
-#define PCB$S_RDPB_QUE 8
-#define PCB$Q_RDPB_QUE 608
-#define PCB$A_RDPB_FLINK 608
-#define PCB$A_RDPB_BLINK 612
-#define PCB$S_FILES_64 8
-#define PCB$Q_FILES_64 616
-#endif
-#endif
diff --git a/src/packlib/cspack/sysreq/serrno.h b/src/packlib/cspack/sysreq/serrno.h
deleted file mode 100644
index d82b0ba..0000000
--- a/src/packlib/cspack/sysreq/serrno.h
+++ /dev/null
@@ -1,61 +0,0 @@
-/*
- * $Id: serrno.h,v 1.1.1.1 1996/03/08 15:44:26 mclareni Exp $
- *
- * $Log: serrno.h,v $
- * Revision 1.1.1.1 1996/03/08 15:44:26 mclareni
- * Cspack
- *
- */
-/*
- * Copyright (C) 1990,1991 by CERN/CN/SW/DC
- * All rights reserved
- */
-
-/*
- * @(#)serrno.h 1.14 3/18/94 CERN CN-SW/DC Frederic Hemmer
- */
-
-/* serrno.h Special error numbers - not in errno.h */
-
-#ifndef _SERRNO_H_INCLUDED_
-#define _SERRNO_H_INCLUDED_
-
-#define SEBASEOFF 1000 /* Base offset for special err. */
-
-#define SENOERR 1000 /* No error */
-#define SENOSHOST 1001 /* Host unknown */
-#define SENOSSERV 1002 /* Service unknown */
-#define SENOTRFILE 1003 /* Not a remote file */
-#define SETIMEDOUT 1004 /* Has timed out */
-#define SEBADFFORM 1005 /* Bad fortran format specifier */
-#define SEBADFOPT 1006 /* Bad fortran option specifier */
-#define SEINCFOPT 1007 /* Incompatible fortran options */
-#define SEFNAM2LONG 1008 /* File name too long */
-#define SENOCONFIG 1009 /* Can't open configuration file*/
-#define SEBADVERSION 1010 /* Version ID mismatch */
-#define SEUBUF2SMALL 1011 /* User buffer too small */
-#define SEMSGINVRNO 1012 /* Invalid reply number */
-#define SEUMSG2LONG 1013 /* User message too long */
-#define SEENTRYNFND 1014 /* Entry not found */
-#define SEINTERNAL 1015 /* Internal error */
-#define SECONNDROP 1016 /* Connection closed by rem. end*/
-#define SEMSGU2REP 1017 /* msg daemon unable to reply */
-#define SEMSGSYERR 1018 /* msg daemon system error */
-#define SENOPERM 1019 /* Permission denied */
-#define SEBADIFNAM 1020 /* Can't get interface name */
-#define SESRQCOMER 1021 /* SYSREQ communication error */
-#define SENOMAPDB 1022 /* Can't open mapping database" */
-#define SENOMAPFND 1023 /* No user mapping */
-#define SENOVMSUSR 1024 /* Unable to set VMS user */
-#define SENORCODE 1025 /* RFIO communication error */
-#define SEHOSTREFUSED 1026 /* RFIO rejected connect attempt*/
-
-#define SEMAXERR 1026 /* Maximum error number */
-
-#define SERRNO (serrno - SEBASEOFF) /* User convenience */
-
-extern int serrno; /* Global error number */
-extern char *sys_serrlist[]; /* Error text array */
-extern char *sstrerror(); /* Get error text string */
-
-#endif /* _SERRNO_H_INCLUDED_ */
diff --git a/src/packlib/cspack/sysreq/serror.c b/src/packlib/cspack/sysreq/serror.c
deleted file mode 100644
index 3667c42..0000000
--- a/src/packlib/cspack/sysreq/serror.c
+++ /dev/null
@@ -1,324 +0,0 @@
-/*
- * $Id: serror.c,v 1.3 1998/08/25 12:44:52 mclareni Exp $
- *
- * $Log: serror.c,v $
- * Revision 1.3 1998/08/25 12:44:52 mclareni
- * QMGLIBC changes for Linux RH51
- *
- * Revision 1.2 1997/10/07 16:28:16 mclareni
- * Fix a problem occurring due to a double typedef with Multinet v4 header
- * and Dec C ver 4 (G. Folger).
- *
- * Revision 1.1.1.1 1996/03/08 15:44:25 mclareni
- * Cspack
- *
- */
-/*CMZ : 21/02/95 15.02.38 by Jamie Shiers*/
-/*CMZ : 21/02/95 09.42.49 by Jamie Shiers*/
-/*
- * Copyright (C) 1990-1994 by CERN CN-PDP/CS
- * All rights reserved
- */
-
-#ifndef lint
-static char sccsid[] = "@(#)serror.c 1.24 2/21/95 CERN CN-PDP/CS F. Hemmer";
-#endif /* not lint */
-
-/* serror.c Global error reporting routines*/
-
-#include <stdio.h> /* standard input/output */
-#include <errno.h> /* error numbers and codes */
-
-#include <serrno.h> /* special error numbers and codes */
-#include <log.h> /* logger functions */
-
-#if defined(vms)
-
-#if defined(TGV) && (TGV == 1) && !defined(MULTINET)
-#define MULTINET 1
-#endif /* TGV && !MULTINET */
-
-#if defined(TWG) && (TWG == 1)
-/* We generate a compiler error, because currently unsupported*/
-!!! Win/TCP is not supported in this version. Sorry !!!
-extern int uerrno;
-extern int vmserrno;
-#endif /* TWG */
-
-#if defined(MULTINET) && (MULTINET == 1)
-/* fix a problem occuring due to a double typedef with multinet v4 header
- * and Dec C ver 4;
- * GF, 6-Oct 97
- */
-#if !defined(_DECC_V4_SOURCE) && !defined(__DECC_VER)
-#define _DECC_V4_SOURCE
-#include "multinet_root:[multinet.include.sys]types.h"
-#include "multinet_root:[multinet.include.sys]socket.h"
-#undef _DECC_V4_SOURCE
-#else
-#include "multinet_root:[multinet.include.sys]types.h"
-#include "multinet_root:[multinet.include.sys]socket.h"
-#endif
-
-#endif /* MULTINET */
-
-#if defined(TCPWARE) && (TCPWARE == 1)
-#include "tcpware_include:socket.h"
-#include "tcpware_include:sockerr.h"
-#endif /* TCPWARE */
-
-#if defined(UCX) && (UCX == 1)
-#include <socket.h>
-#include <types.h>
-#endif /* UCX */
-
-#else /* ! vms */
-#if !defined(CERNLIB_QMGLIBC)
-extern int sys_nerr; /* number of system error messages */
-extern char *sys_errlist[]; /* system error list */
-#endif
-#endif /* vms */
-
-#include <net.h> /* networking specifics */
-
-#if defined(vms) && defined(__alpha) && defined(COMPILE_NOPREFIX)
-#define perror DECC$PERROR
-#define strerror DECC$STRERROR
-#endif /* vms && __alpha && COMPILE_NOPREFIX */
-
-int serrno;
-char *sys_serrlist[SEMAXERR-SEBASEOFF+2]=
- {"Error 0",
- "Host not known",
- "Service unknown",
- "Not a remote file",
- "Timed out",
- "Unsupported FORTRAN format",
- "Unknown FORTRAN option",
- "Incompatible FORTRAN options",
- "File name too long",
- "Can't open configuration file",
- "Version ID mismatch",
- "User buffer too small",
- "Invalid reply number",
- "User message too long",
- "Entry not found",
- "Internal error",
- "Connection closed by remote end",
- "Message daemon unable to reply",
- "Message daemon system error",
- "Permission denied",
- "Can't find interface name",
- "SYSREQ remote communication error",
- "Can't open mapping database",
- "No user mapping",
- "Unable to set VMS user",
- "Host did not return error number",
- "Host not is local network and no mapping found",
- "BAD ERROR NUMBER"
- };
-
-#if defined(vms)
-#include <string.h>
-#include <ssdef.h>
-
-extern int sys$getmsg();
-#define VMSMAXMSGLEN 256
-static char vmsmsg[256];
-struct { /* VMS generic descriptor */
- int len;
- char *buf;
-} msgbuf = {
- VMSMAXMSGLEN, vmsmsg };
-#endif /* vms */
-
-#if defined(vax) && (vax == 1)
-/*
- * The VAX C COMPILER doesn't define MAX_ERRNO_VALUE, and is therefore
- * incompatible with DEC C. Thank you DEC !. We use this horrible
- * kludge to search by hand the MAX_ERRNO_VALUE, and define it here.
- * A simplistic test is made in case errno's change.
- */
-#if (EHOSTUNREACH != 65)
-!! Incompatible version !!
-#else
-#if !defined(MAX_ERRNO_VALUE)
-#define MAX_ERRNO_VALUE EHOSTUNREACH
-#endif /* !MAX_ERRNO_VALUE */
-#endif /* EHOSTUNREACH != 65 */
-#endif /* vax */
-
-#if defined(vms)
-/*
- * DECC V4.0 has changed again ! MAX_ERRNO_VALUE is now
- * __ERRNO_MAX ! Looks like the QA guy in DEC moved
- * elsewhere !
- */
-#if !defined(MAX_ERRNO_VALUE)
-#if defined(__ERRNO_MAX)
-#define MAX_ERRNO_VALUE __ERRNO_MAX
-#endif /* __ERRNO_MAX */
-#endif /* ! MAX_ERRNO_VALUE */
-#endif /* vms */
-
-static char buf[80];
-
-char * sstrerror(n)
-int n;
-{
-#if defined(vms)
- register int rc;
- int msglen;
-#endif /* vms */
-
- if ((n>SEBASEOFF) && (n<=SEMAXERR)) {
- return(sys_serrlist[n-SEBASEOFF]);
- }
- else {
-#if !defined(vms)
- if ((n>0) && (n<sys_nerr)) {
- return(sys_errlist[n]);
- }
- else {
- (void) sprintf(buf,"%s: %d\n",
- sys_serrlist[SEMAXERR+1-SEBASEOFF],
- n);
- return(buf);
- }
-#else /* vms */
-/*
- * There are (were) some bugs is DEC C compilers (/OPT), just check
- * one of those.
- */
- if ((unsigned int)n <= (unsigned int)MAX_ERRNO_VALUE)
- log(LOG_ALERT,"%16.16X <= %16.16X\n", n, MAX_ERRNO_VALUE);
- if ((unsigned int)n > (unsigned int)MAX_ERRNO_VALUE)
- log(LOG_ALERT,"%16.16X > %16.16X\n", n, MAX_ERRNO_VALUE);
-
- if ((n > 0) && (n <= MAX_ERRNO_VALUE)) {
- return(strerror(n));
- }
- else {
- if (n == EVMSERR) {
- /* We assume, error was last vms error */
- /*FH bad assumption, as we're maybe in another
- process !*/
- /* Later, we'll use subcodes */
-#if defined(MULTINET) && (MULTINET == 1)
- if (!vmserrno && !vaxc$errno) {
- sprintf(msgbuf.buf,
-"%%system-f-vmserr, vms error code: 0x0: internal error");
- return(msgbuf.buf);
- }
- if (vmserrno)
- if ((rc = sys$getmsg(vmserrno,&msglen,
- &msgbuf,0,0)) != SS$_NORMAL) {
-
- sprintf(msgbuf.buf,
-"%%system-f-vmserr, vms error code: 0x%x, unable to get vms message",
- vmserrno);
- return(msgbuf.buf);
- }
- else {
- msgbuf.buf[msgbuf.len]='\0';
- return(msgbuf.buf);
- }
- if (vaxc$errno)
- if ((rc = sys$getmsg(vaxc$errno,&
- msglen,&msgbuf,0,0)) != SS$_NORMAL)
- {
-
- sprintf(msgbuf.buf,
- "%%system-f-vmserr, vms error code: 0x%x, unable to get vms message",
- vaxc$errno);
- return(msgbuf.buf);
- }
- else {
- msgbuf.buf[msgbuf.len]='\0';
- return(msgbuf.buf);
- }
-#endif /* MULTINET */
-#if ((defined(TCPWARE) && (TCPWARE == 1)) || (defined(UCX) && (UCX == 1)))
- if (!vaxc$errno) {
- sprintf(msgbuf.buf,
-"%%system-f-vmserr, vms error code: 0x0: internal error");
- return(msgbuf.buf);
- }
- if ((rc = sys$getmsg(vaxc$errno,&msglen,&
- msgbuf,0,0)) != SS$_NORMAL) {
- sprintf(msgbuf.buf,
-"%%system-f-vmserr, vms error code: 0x%x, unable to get vms message",
- vaxc$errno);
- return(msgbuf.buf);
- }
- else {
- msgbuf.buf[msgbuf.len]='\0';
- return(msgbuf.buf);
- }
-#endif /* TCPWARE || UCX */
- }
- else {
- (void) sprintf(buf,"%s: (%d) %d\n",
- sys_serrlist[SEMAXERR+1-SEBASEOFF],
- MAX_ERRNO_VALUE,n);
- return(buf);
- }
- }
-#endif /* vms */
- }
-}
-
-void sperror(msg)
-char *msg;
-{
- if (serrno) {
- if ((serrno>SEBASEOFF) && (serrno<=SEMAXERR)) {
- fprintf(stderr,"%s: %s\n",msg,sstrerror(serrno));
- }
- else {
- fprintf(stderr,"%s: %s: %d\n",msg,
- sstrerror(SEMAXERR+1), serrno);
- }
- }
- else {
-#if !defined(vms)
- perror(msg);
-#else /* vms */
-#if defined(TWG) && (TWG == 1)
- if (uerrno != 0) {
- /* We force this error in errno, then perror */
- errno = uerrno;
- perror(msg);
- return;
- }
- if (vmserrno != 0) {
- errno = EVMSERR;
- vaxc$errno = vmserrno;
- }
- perror(msg);
-#endif /* TWG */
-#if defined(MULTINET) && (MULTINET == 1)
- if (socket_errno != 0) {
- socket_perror(msg);
- return;
- }
- if (vmserrno != 0) {
- errno = EVMSERR;
- vaxc$errno = vmserrno;
- }
- perror(msg);
-#endif /* MULTINET */
-
-#if defined(TCPWARE) && (TCPWARE == 1)
- pneterror(msg);
- return;
-#endif /* TCPWARE */
-
-#if defined(UCX) && (UCX == 1)
- perror(msg);
-#endif /* UCX */
-
-#endif /* vms */
- }
-}
-
diff --git a/src/packlib/cspack/sysreq/socket.c b/src/packlib/cspack/sysreq/socket.c
deleted file mode 100644
index ceb5bd6..0000000
--- a/src/packlib/cspack/sysreq/socket.c
+++ /dev/null
@@ -1,482 +0,0 @@
-/*
- * $Id: socket.c,v 1.3 1998/08/25 12:44:55 mclareni Exp $
- *
- * $Log: socket.c,v $
- * Revision 1.3 1998/08/25 12:44:55 mclareni
- * QMGLIBC changes for Linux RH51
- *
- * Revision 1.2 1997/10/07 16:28:19 mclareni
- * Fix a problem occurring due to a double typedef with Multinet v4 header
- * and Dec C ver 4 (G. Folger).
- *
- * Revision 1.1.1.1 1996/03/08 15:44:25 mclareni
- * Cspack
- *
- */
-/*
- * Copyright (C) 1990-1994 by CERN CN-PDP/CS
- * All rights reserved
- */
-
-#if !defined(lint)
-static char sccsid[] = "@(#)socket.c 1.19 7/29/94 CERN CN-PDP/CS F. Hemmer";
-#endif /* lint */
-
-/* socket.c Generalized network interface */
-
-/*
- * Some support should be added for Multinet and UCX as well
- */
-
-#define DEBUG 0
-/* Define DUMP to print buffers contents - heavy debug mode */
-/* #define DUMP 0 */
-
-#if defined(vms)
-
-#if defined(TGV) && (TGV == 1) && !defined(MULTINET)
-#define MULTINET 1
-#endif /* TGV && !MULTINET */
-
-#if (!defined(TWG) && !defined(MULTINET) && !defined(TCPWARE) && !defined(UCX))
-/* We generate a compiler error (#error not defined everywhere!) */
-!!! YOU MUST SPECIFY either MULTINET or TWG or TCPWARE or UCX !!!
-#endif /* !MULTINET && !TWG && !TCPWARE && !UCX */
-
-#if defined(MULTINET) && (MULTINET == 1)
-#if !defined(_DECC_V4_SOURCE) && !defined(__DECC_VER)
-#define _DECC_V4_SOURCE
-#include "multinet_root:[multinet.include.sys]types.h"
-#include "multinet_root:[multinet.include.sys]socket.h"
-#undef _DECC_V4_SOURCE
-#else
-#include "multinet_root:[multinet.include.sys]types.h"
-#include "multinet_root:[multinet.include.sys]socket.h"
-#endif
-#endif /* MULTINET */
-
-#if defined(TCPWARE) && (TCPWARE == 1)
-#include "tcpware_include:socket.h"
-#endif /* TCPWARE */
-
-#if defined(UCX) && (UCX == 1)
-#include <types.h>
-#include <socket.h>
-#endif /* UCX */
-
-#endif /* vms */
-
-#include <net.h> /* networking specifics */
-#include <log.h> /* logging functions */
-#include <serrno.h> /* special errors */
-
-#if defined(vms)
-
-#if defined(TWG) && (TWG == 1)
-#define READ(x,y,z) netread(x,y,z) /* VMS TWG socket read */
-#define WRITE(x,y,z) netwrite(x,y,z) /* VMS TWG socket write */
-#endif /* TWG */
-#if defined(MULTINET) && (MULTINET == 1)
-#define READ(x,y,z) socket_read(x,y,z) /* VMS MULTINET socket read */
-#define WRITE(x,y,z) socket_write(x,y,z) /* VMS MULTINET socket write*/
-#define CLOSE(x) socket_close(x) /* VMS MULTINET socket close*/
-#define IOCTL(x,y,z) socket_ioctl(x,y,z) /* VMS MULTINET socket ioctl*/
-#endif /* MULTINET */
-#if defined(TCPWARE) && (TCPWARE == 1)
-#define READ(x,y,z) socket_read(x,y,z) /* VMS TCPWARE socket read */
-#define WRITE(x,y,z) socket_write(x,y,z) /* VMS TCPWARE socket write */
-#define CLOSE(x) socket_close(x) /* VMS TCPWARE socket close */
-#define IOCTL(x,y,z) socket_ioctl(x,y,z) /* VMS TCPWARE socket ioctl */
-#endif /* TCPWARE */
-#if defined(UCX) && (UCX==1)
-#define READ(x,y,z) read(x,y,z) /* Actual read system call */
-#define WRITE(x,y,z) write(x,y,z) /* Actual write system call */
-#define CLOSE(x) close(x) /* Actual close system call */
-#define IOCTL(x,y,z) ioctl(x,y,z) /* Actual ioctl system call */
-#endif /* UCX */
-
-#include <string.h>
-#include <ssdef.h>
-
-extern int sys$getmsg();
-#define VMSMAXMSGLEN 256
-
-static char vmsmsg[VMSMAXMSGLEN];
-static struct { /* VMS generic descriptor */
- int len;
- char *buf;
-} msgbuf = {
- VMSMAXMSGLEN, vmsmsg };
-
-#else /* ! vms */
-
-#define READ(x,y,z) recv(x,y,z,0) /* Actual read system call */
-#define WRITE(x,y,z) send(x,y,z,0) /* Actual write system call */
-#define CLOSE(x) close(x) /* Actual close system call */
-#define IOCTL(x,y,z) ioctl(x,y,z) /* Actual ioctl system call */
-
-#if !defined(CERNLIB_QMGLIBC)
-extern int sys_nerr; /* number of system error messages */
-extern char *sys_errlist[]; /* system error list */
-#endif
-#endif /* vms */
-
-#ifndef READTIMEOUTVALUE
-#define READTIMEOUTVALUE 60 /* Default read time out */
-#endif /* READTIMEOUTVALUE */
-
-static int rtimeout=READTIMEOUTVALUE;
-
-/*
- * Define BLOCKSIZE if read/write calls have a length upper limit
- * E.g. VMS QIO calls are limited to transfer 65536 bytes.
- */
-
-#if defined(vms)
-#define BLOCKSIZE 32768
-#else
-#ifdef BLOCKSIZE
-#undef BLOCKSIZE /* be safe */
-#endif /* BLOCKSIZE */
-#endif /* vms */
-
-#include <stdio.h>
-#include <errno.h>
-#include <setjmp.h>
-#include <signal.h>
-extern char* malloc();
-
-#if defined(vms)
-#if defined(TWG) && (TWG == 1)
-extern int uerrno;
-extern int vmserrno;
-#define errno (uerrno ? uerrno : vmserrno)
-#endif /* TWG */
-#if defined(MULTINET) && (MULTINET == 1)
-extern volatile int noshare socket_errno;
-extern volatile int noshare vmserrno;
-#define errno (socket_errno ? socket_errno : vmserrno)
-#endif /* MULTINET */
-#endif /* vms */
-
-static jmp_buf alarmbuf;
-static void (* defsigalrm) ();
-
-#ifndef min
-#define min(x, y) (((x-y) > 0) ? y : x)
-#endif /* min */
-
-/*
- * Statistics
- */
-
-struct iostats {
- unsigned int rcount; /* read() count */
- unsigned int wcount; /* write() count */
- unsigned int rbcount; /* byte(s) read */
- unsigned int wbcount; /* byte(s) written */
-} iostats = { 0,0,0,0 };
-
-
-/*
- * This is needed for CRAY/Ultranet bug, crashing if write() buffer
- * is not word aligned.
- */
-
-#ifdef CRAY
-/* #define CHECK_ALIGN 1 */ /* Don't check for time being */
-#if defined (cray-xmp)
-#define NOTALIGN(p) ((int) ((((int)(p)) >> 61) & 0x00000007))
-#endif /* cray-xmp */
-#endif /* CRAY */
-
-#ifdef DUMP
-
-#include <ctype.h>
-
-static int
-Dump(buf, nbytes)
-char *buf;
-int nbytes;
-{
- register int i, j;
- register char c;
-
- log(LOG_DEBUG ," *** Hexadecimal dump *** \n");
-
- for (i=0;i<nbytes/20;i++) {
- for (j=0;j<20;j++) {
- log(LOG_DEBUG ,"<%2.2X>", (char) buf[i*20+j]);
- }
- log(LOG_DEBUG ,"\n");
- }
- for (i=0;i<nbytes%20;i++) {
- log(LOG_DEBUG ,"<%2.2X>",buf[(nbytes/20)*20+i]);
- }
- log(LOG_DEBUG ,"\n *** Interpreted dump *** \n");
- for (i=0;i<nbytes/80;i++) {
- for (j=0;j<80;j++) {
- c = (char) buf[i*80+j];
- if (isprint(c)) log(LOG_DEBUG ,"%c", c);
- else log(LOG_DEBUG ,".");
- }
- log(LOG_DEBUG ,"\n");
- }
- for (i=0;i<nbytes%80;i++) {
- c = (char) buf[(nbytes/80)*80+i];
- if (isprint(c)) log(LOG_DEBUG ,"%c", c);
- else log(LOG_DEBUG ,".");
- }
- log(LOG_DEBUG ,"\n");
-}
-#endif /* DUMP */
-
-int setrtimo(val)
-int val;
-{
- register int otimeout;
-
- otimeout = rtimeout;
- rtimeout=val;
- return(otimeout);
-}
-
-#ifdef READTIMEOUT
-void catch()
-{
- longjmp(alarmbuf, 1);
-}
-#endif /* READTIMEOUT */
-
-int
-s_recv (s, buf, nbytes)
-int s;
-char *buf;
-int nbytes;
-{
- register int n, nb;
-
-#if DEBUG
- log(LOG_DEBUG ,"dorecv(%x, %x, %d)\n", s, buf, nbytes);
-#endif /* DEBUG */
-
-#ifdef READTIMEOUT
- if (setjmp(alarmbuf) == 1) {
- signal(SIGALRM, defsigalrm); /* restore alarm handler*/
-#if !defined(vms)
- errno = ETIMEDOUT;
-#else /* !vms */
-#if defined(TWG)
- uerrno = ETIMEDOUT;
-#endif /* TWG */
-#if defined(MULTINET)
- socket_errno = ETIMEDOUT;
-#endif /* MULTINET */
-#endif /* vms */
- return(-1);
- }
-
-#if !defined(apollo)
- defsigalrm = signal (SIGALRM, (void (*)()) catch);
-#else
-/* DomainOS generates a warning :
- * Conversion of "catch" to pointer of
- * stricter alignment can cause serious performance degradation.
- */
- defsigalrm = signal (SIGALRM, catch);
-#endif /* !apollo */
-#endif /* READTIMEOUT */
-
- nb = nbytes;
- for (; nb >0;) {
-#ifdef CHECK_ALIGN
- if (NOTALIGN(buf)) {
-#ifdef READTIMEOUT
- alarm(0);
- signal(SIGALRM, defsigalrm);
-#endif /* READTIMEOUT */
- log(LOG_DEBUG ,
- "CRITICAL: unaligned buffer at %x\n",buf);
- log(LOG_DEBUG ,
- "CRITICAL: while dorecv(),n=%d,nb=%d,nbytes=%d\n",
- n,nb,nbytes);
- errno = EFAULT;
- return(-1);
- }
-#endif /* CHECK_ALIGN */
-#ifdef READTIMEOUT
- alarm(rtimeout);/* successive calls reset the alarm */
-#endif /* READTIMEOUT */
-#ifdef BLOCKSIZE
- n = READ(s, buf, min(BLOCKSIZE, nb));
-#else
- n = READ(s, buf, nb);
-#endif
- nb -= n;
-
-#ifdef READTIMEOUT
- alarm(0);
- signal(SIGALRM, defsigalrm);
-#endif /* READTIMEOUT */
- if (n <= 0) {
- if (n == 0) {
- serrno=SECONNDROP;
- return(0);
- }
-#if DEBUG
- log(LOG_DEBUG ,
- "ERROR: %d while n=%d,nb-n=%d,buf=%x\n",
- errno, n, nb, buf);
-#endif /* DEBUG */
- return (n);
- }
-#if DEBUG
- log(LOG_DEBUG ,"dorecv: %d bytes received\n",n);
-#if DUMP
- log(LOG_DEBUG ,"dorecv: dump follows\n");
- Dump(buf,n);
-#endif /* DUMP */
-#endif /* DEBUG */
- iostats.rcount++;
- buf += n;
- }
- iostats.rbcount += nbytes;
- return (nbytes);
-}
-
-int
-s_send (s, buf, nbytes)
-int s;
-char *buf;
-int nbytes;
-{
- register int n, nb;
-
-#if DEBUG
- log(LOG_DEBUG, "dosend(%x, %x, %d)\n", s, buf, nbytes);
-#endif
- nb = nbytes;
- for (; nb >0;) {
-#ifdef CHECK_ALIGN
- if (NOTALIGN(buf)) {
- log(LOG_DEBUG ,"CRITICAL: unaligned buffer at %x\n",
- buf);
- log(LOG_DEBUG ,
- "CRITICAL: while dosend(),n=%d,nb=%d,nbytes=%d\n",
- n,nb,nbytes);
- errno = EFAULT;
- return(-1);
- }
-#endif /* CHECK_ALIGN */
-#ifdef BLOCKSIZE
- n = WRITE(s, buf, min(BLOCKSIZE, nb));
-#else
- n = WRITE(s, buf, nb);
-#endif
- nb -= n;
- if (n <= 0) {
- if (n == 0) {
- serrno=SECONNDROP;
- return(0);
- }
-#if DEBUG
- log(LOG_DEBUG ,
- "ERROR: %d while n=%d,nb-n=%d,buf=%x\n",
- errno, n, nb, buf);
-#endif /* DEBUG */
- return (n);
- }
-#if DEBUG
-#if DUMP
- log(LOG_DEBUG ,"dosend: dump follows\n");
- Dump(buf,n);
-#endif /* DUMP */
- log(LOG_DEBUG ,"dosend: %d bytes sent\n",n);
-#endif /* DEBUG */
- iostats.wcount++;
- buf += n;
- }
- iostats.wbcount+=nbytes;
- log(LOG_DEBUG, "dosend(%x) returns %d\n", s, nbytes);
- return (nbytes);
-}
-
-int
-s_close(s)
-int s;
-{
- return(CLOSE(s));
-}
-
-char *
-s_errmsg() /* return last error message */
-{
-#if !defined(vms)
- return(sys_errlist[errno]);
-#else /* vms */
-#if defined(MULTINET) && (MULTINET == 1)
- return(vms_errno_string());
-#endif /* MULTINET */
-#if defined(TCPWARE) && (TCPWARE == 1)
- if ((rc = sys$getmsg(vaxc$errno,&msglen,&msgbuf,0,0)) != SS$_NORMAL) {
- sprintf(msgbuf.buf,"%%system-f-vmserr, vms error code: 0x%x, \
-unable to get vms message", vaxc$errno);
- return(msgbuf.buf);
- }
- else {
- msgbuf.buf[msgbuf.len]='\0';
- return(msgbuf.buf);
- }
-#endif /* TCPWARE */
-#if defined(UCX) && (UCX == 1)
-#pragma nostandard
- return(strerror(errno, vaxc$errno));
-#pragma standard
-#endif /* UCX */
-#endif /* vms */
-}
-
-/*
- * Solaris 2.x defines but does not document a s_ioctl routine
- * in libsocket.a, therefore conflicting with ours. Hence this
- * workaround.
- */
-
-#if defined(SOLARIS) && (SOLARIS == 1)
-#define s_ioctl sol_s_ioctl
-#endif /* SOLARIS */
-
-int
-s_ioctl(s, request, arg) /* issue an ioctl(2) call */
-int s, request;
-int arg;
-{
- return(IOCTL(s, request, arg));
-}
-
-int s_nrecv(s, buf, nbytes) /* Non blocking read */
-int s, nbytes;
-char *buf;
-{
-#if defined(BLOCKSIZE)
- return(READ(s, buf, min(BLOCKSIZE,nbytes)));
-#else
- return(READ(s, buf, nbytes));
-#endif /* BLOCKSIZE */
-}
-
-void getiostat(iostatbuf) /* return raw I/O statitics */
-struct iostats *iostatbuf;
-{
- iostatbuf->rcount = iostats.rcount;
- iostatbuf->wcount = iostats.wcount;
- iostatbuf->rbcount = iostats.rbcount;
- iostatbuf->wbcount = iostats.wbcount;
-}
-
-int (*recvfunc)()=s_recv; /* recv function to use */
-int (*sendfunc)()=s_send; /* send function to use */
-int (*closefunc)()=s_close; /* close function to use */
-int (*ioctlfunc)()=s_ioctl; /* ioctl function to use */
-char *(*errfunc)()=s_errmsg; /* strerror function to use */
-
diff --git a/src/packlib/cspack/sysreq/sysreq.c b/src/packlib/cspack/sysreq/sysreq.c
deleted file mode 100644
index bd0c659..0000000
--- a/src/packlib/cspack/sysreq/sysreq.c
+++ /dev/null
@@ -1,105 +0,0 @@
-/*
- * $Id: sysreq.c,v 1.1.1.1 1996/03/08 15:44:25 mclareni Exp $
- *
- * $Log: sysreq.c,v $
- * Revision 1.1.1.1 1996/03/08 15:44:25 mclareni
- * Cspack
- *
- */
-/*
- * Copyright (C) 1990,1991 by CERN/CN/SW/DC
- * All rights reserved
- */
-
-#ifndef lint
-static char sccsid[] =
-"@(#)sysreq.c 1.10 7/13/94 CERN CN-SW/DC Frederic Hemmer";
-#endif /* not lint */
-
-/* sysreq.c sysreq command using network communication */
-
-#include <stdio.h> /* Standard Input/Output */
-#include <string.h> /* String manipulation routines */
-#ifndef vms
-#include <sysreq.h> /* Sysreq interface definitions */
-#include <serrno.h> /* Special error numbers */
-#else
-#include "sysreq.h" /* SYSREQ specific definitions */
-#include "serrno.h" /* Special Error numbers */
-#endif /* vms */
-
-#if defined(vms) && defined(__alpha) && defined(COMPILE_NOPREFIX)
-#define exit DECC$EXIT
-#define strcat DECC$STRCAT
-#endif /* vms && vax && COMPILE_NOPREFIX */
-
-#define RECSEP '\n' /* SYSREQ's record separator */
-#define RECLEN 80 /* SYSREQ's max record length */
-
-extern int sysreq();
-
-static char *
-nextcmd(s) /* Get next command to issue */
-char *s;
-{
- register int i;
-
- for (i= strlen(s);i>=(int)strlen(s)-RECLEN;i--) {
- if (s[i] == RECSEP) return(s+i+1);
- }
- return (NULL);
-}
-
-main(argc, argv)
-int argc;
-char **argv;
-{
- char cmd[512];
- char reptxt[2048];
- int status, len, cmdl, i;
- char *s;
-
- if (argc <= 2) {
- fprintf(stderr,"SERVICE NAME INVALID OR OMITTED\n");
- exit(3);
- }
-
- strcpy(cmd, argv[2]);
- for (i=3;i<argc;i++) {
- strcat(cmd, " ");;strcat(cmd,argv[i]);
- }
-
-reissue:
- cmdl = strlen(cmd);
- len = sizeof(reptxt);
- status = sysreq(argv[1], cmd, &cmdl, reptxt, &len);
- switch (status) {
- case 0: fprintf(stdout,"%s\n",reptxt);
- exit(0);
- case -SEUBUF2SMALL: fprintf(stdout,"%s\n",reptxt);
- fprintf(stdout,"Data truncated\n");
- break;
- case 2:
- if ((s = nextcmd(reptxt)) == NULL) {
- fprintf(stderr,
- "Internal error: Unable to get next command\n");
- }
- else {
- /* Discard last reptxt record */
- *(s-1) = '\0';
- fprintf(stdout,"%s\n",reptxt);
- strcpy(cmd,s);
- goto reissue;
- }
- break;
- default:
- if (status < 0) {
- sperror("sysreq");
- status = -status;
- len = 0;
- }
- if (len >0) fprintf(stdout,"%s\n",reptxt);
- }
- fprintf(stderr,"RC(%d)\n",status);
- exit(1);
-}
diff --git a/src/packlib/cspack/sysreq/sysreq.h b/src/packlib/cspack/sysreq/sysreq.h
deleted file mode 100644
index b501e3f..0000000
--- a/src/packlib/cspack/sysreq/sysreq.h
+++ /dev/null
@@ -1,106 +0,0 @@
-/*
- * $Id: sysreq.h,v 1.1.1.1 1996/03/08 15:44:26 mclareni Exp $
- *
- * $Log: sysreq.h,v $
- * Revision 1.1.1.1 1996/03/08 15:44:26 mclareni
- * Cspack
- *
- */
-/*
- * Copyright (C) 1990,1991 by CERN/CN/SW/DC
- * All rights reserved
- */
-
-/*
- * @(#)sysreq.h 1.4 9/2/91 CERN CN-SW/DC Frederic Hemmer
- */
-
-/* sysreq.h Network interface to the SYSREQ communication system */
-
-/*
- * Most of this stuff should be moved in the source directory
- * user only need the library definitions
- */
-
-#ifndef _SYSREQ_H_INCLUDED_
-#define _SYSREQ_H_INCLUDED_
-
-#ifndef vms
-#include <osdep.h> /* Operating system dependencies */
-#else
-#include "osdep.h" /* Operating system dependencies */
-#endif /* vms */
-
-/*
- * Important note: the SYSREQ request/reply blocks do NOT correspond
- * to D.J. Rigby original note. Currently the only way to get up to
- * date information is to look at source code. An example of this is
- * the SYSREQ ASSEMBLE Fortran interface to SYSREQ, using diagnose X'140'
- */
-
-typedef struct { /* SYSREQ request header */
- WORD length; /* total length, excluded this */
- WORD maxrep; /* maximum reply length */
- LONG msgid; /* unique message id */
- char altid[8]; /* alternate user id */
- LONG atwtype; /* application dependent */
- LONG checksum; /* transmission checksum */
- char account[8]; /* Reserved for acnt**** */
- char spare[8]; /* Reserved */
- char usernm[8]; /* username of requestor */
- char sysnm[8]; /* requestor's system name */
- char service[8]; /* service name */
-} reqhd;
-
-typedef struct { /* SYSREQ reply header */
- WORD length; /* total length, excluded this */
- WORD rcode; /* SYSREQ return code */
- LONG msgid; /* msgid from request buffer */
-} rephd;
-
-/*
- * Request types codes
- */
-
-#define SYSREQTYPE 1 /* Normal SYSREQ request */
-#define PROBETYPE 2 /* Probe the server */
-#define STATTYPE 3 /* Get statistics info */
-#define SHUTTYPE 4 /* Shutdown request */
-#define NULLTYPE 5 /* The NULL request */
-
-/*
- * Error codes (OLD STYLE, now moved in serrno.h)
- */
-
-#define CONFNFOUND 1001 /* sysreqrc not found */
-#define NOSUCHHOST 1002 /* Host not found */
-#define BADVERSION 1003 /* Version id mismatch */
-#define UBUF2SMALL 1004 /* User buffer too small */
-#define NOSUCHSERV 1005 /* Service unknown */
-#define PERMDENIED 1006 /* Permission denied */
-#define INVREQTYPE 1007 /* Invalid request type */
-#define INVADDRFAM 1008 /* Unsupported addressing fam. */
-#define INVCOMTYPE 1009 /* Unsupported commun. type */
-#define SYSCOMMERR 1010 /* SYSREQ communication error */
-
-/*
- * System routines
- */
-
-#ifndef VM
-extern char *malloc(); /* Memory allocation */
-#endif /* VM */
-extern char *getenv(); /* Get environment info */
-
-/*
- * Data internalization/externalization
- */
-
-extern char *RecvStr(); /* Receive a string from network*/
-extern int SendStr(); /* Send a string to network */
-extern int RecvWord(); /* Receive a word from network */
-extern int SendWord(); /* Send a word to network */
-extern int RecvLong(); /* Receive a long from network */
-extern int SendLong(); /* Send a long from network */
-
-#endif /* _SYSREQ_H_INCLUDED_ */
diff --git a/src/packlib/cspack/sysreq/sysreqc.c b/src/packlib/cspack/sysreq/sysreqc.c
deleted file mode 100644
index 3f8e78b..0000000
--- a/src/packlib/cspack/sysreq/sysreqc.c
+++ /dev/null
@@ -1,91 +0,0 @@
-/*
- * $Id: sysreqc.c,v 1.2 1996/09/20 12:53:21 cernlib Exp $
- *
- * $Log: sysreqc.c,v $
- * Revision 1.2 1996/09/20 12:53:21 cernlib
- * have sysreq as sysreq_ on linux (?!)
- *
- * Revision 1.1.1.1 1996/03/08 15:44:25 mclareni
- * Cspack
- *
- */
-/*
- * Copyright (C) 1990,1991 by CERN/CN/SW/DC
- * All rights reserved
- */
-
-#ifndef lint
-static char sccsid[] =
-"@(#)sysreqc.c 1.9 7/14/94 CERN CN-SW/DC Frederic Hemmer";
-#endif /* not lint */
-
-/* sysreqc.c C interface to the SYSREQ communication system */
-
-#include "config.h" /* configuration parameters */
-#if !defined(vms)
-#include <sysreq.h> /* sysreq interface definitions */
-#include <serrno.h> /* special error numbers */
-#include <trace.h> /* tracing definitions */
-#else
-#include "sysreq.h" /* sysreq specific definitions */
-#include "serrno.h" /* special Error numbers */
-#include "trace.h" /* tracing definitions */
-#endif /* vms */
-
-#include <stdio.h> /* Standard Input/Output definitions */
-#if defined(unix) || (defined(_AIX) && defined(_IBMR2))
-#if defined(vms)
-#include <pwd_vms.h>
-#else
-#include <pwd.h>
-#endif
-#endif /* unix || (_AIX && _IBMR2) */
-#include <errno.h> /* Standard error numbers */
-
-#if defined(vms) && defined(__alpha) && defined(COMPILE_NOPREFIX)
-#define cuserid DECC$CUSERID
-#endif /* vms && __alpha && COMPILE_NOPREFIX */
-
-static int sysreq_tracing = 0;
-extern int _sysreq(); /* Actual call to sysreq */
-extern char *getacct(); /* get account string */
-
-int
-#ifdef CERNLIB_LINUX
-sysreq_(sernam, comtxt, comtxtl, reptxt, arysz)
-#else
-sysreq(sernam, comtxt, comtxtl, reptxt, arysz)
-#endif
-char *sernam; /* service name */
-char *comtxt; /* command text */
-int *comtxtl; /* command text length */
-char *reptxt; /* reply text */
-int *arysz; /* reply array size, actual size on return */
-{
- char *acct; /* account string pointer */
- int rc; /* sysreq return code */
-#if defined(unix) || (defined(_AIX) && defined(_IBMR2))
- struct passwd *pw; /* password entry buffer pointer */
-#endif /* unix || (_AIX && _IBMR2) */
-#if defined(vms)
- char name[L_cuserid]; /* username buffer */
-#endif /* vms */
-
- INIT_TRACE("SYSREQ_TRACE");
- TRACE(1, "sysreq", "sysreq(%s,%s,%d,%x,%d) entered",
- sernam, comtxt, *comtxtl, reptxt, *arysz);
-
- if (( acct = getacct()) == NULL) acct = " ";
-
-#if defined(unix) || (defined(_AIX) && defined(_IBMR2))
- pw = getpwuid(geteuid());
- rc = _sysreq(pw->pw_name, acct,sernam, comtxt, *comtxtl, reptxt,
- arysz);
-#endif /* unix || (_AIX && _IBMR2) */
-#if defined(vms)
- cuserid(name);
- rc =_sysreq(name, acct, sernam, comtxt, *comtxtl, reptxt, arysz);
-#endif /* vms */
- END_TRACE();
- return(rc);
-}
diff --git a/src/packlib/cspack/sysreq/sysreqf.c b/src/packlib/cspack/sysreq/sysreqf.c
deleted file mode 100644
index 9eb5ba5..0000000
--- a/src/packlib/cspack/sysreq/sysreqf.c
+++ /dev/null
@@ -1,499 +0,0 @@
-/*
- * $Id: sysreqf.c,v 1.1.1.1 1996/03/08 15:44:25 mclareni Exp $
- *
- * $Log: sysreqf.c,v $
- * Revision 1.1.1.1 1996/03/08 15:44:25 mclareni
- * Cspack
- *
- */
-/*
- * Copyright (C) 1990,1991 by CERN/CN/SW/DC
- * All rights reserved
- */
-
-#ifndef lint
-static char sccsid[] =
-"@(#)sysreqf.c 1.18 7/14/94 CERN CN-SW/DC Frederic Hemmer";
-#endif /* not lint */
-
-/* sysreqf.c Fortran to C SYSREQ interface */
-
-/* This should really go in a osdep/config file */
-#if defined(sun)
-#define UNIXF77 1
-#endif /* sun */
-#if defined(sgi)
-#define UNIXF77 1
-#endif /* sgi */
-#if (defined(mips) && defined(ultrix))
-#define UNIXF77 1
-#endif /* mips && ultrix */
-#if (defined(apollo) && defined(F77))
-#define UNIXF77 1
-#endif /* apollo && F77 */
-#if defined(_AIX) && defined(_IBMESA)
-#define UNIXF77 1
-#endif /* AIX && IBMESA */
-#if defined(_AIX) && defined(_IBMR2)
-#define UNIXF77 1
-#endif /* AIX && IBMR2 */
-#if defined(hpux)
-#define UNIXF77 1
-#endif /* hpux */
-#if defined(__osf__) && defined(__alpha)
-#define UNIXF77 1
-#endif /* __osf__ && __alpha */
-
-#include <stdio.h> /* Standard Input/Output */
-#include <errno.h> /* Error numbers and codes */
-#ifndef vms
-#include <sysreq.h> /* Sysreq interface definitions */
-#include <trace.h> /* tracing definitions */
-#else
-#include "sysreq.h" /* SYSREQ specific definitions */
-#include "trace.h" /* tracing definitions */
-#endif /* vms */
-#ifdef unix
-#if defined(vms)
-#include <pwd_vms.h>
-#else
-#include <pwd.h>
-#endif
-#endif /* unix */
-
-#if defined(CRAY)
-#include <fortran.h> /* Fortran/C CRAY interface */
-#endif /* CRAY */
-#if defined(vms)
-#include <descrip.h> /* Argument Descriptor formats */
-#endif /* vms */
-
-static int debug=0;
-
-static int sysreq_tracing = 0;
-extern int _sysreq();
-
-#if defined(CRAY)
-void SYSREQ(fsernam, fcomtxt, rcode,freptxt,farysz)
-_fcd fsernam, fcomtxt, freptxt;
-int *rcode,*farysz;
-{
- char *sernam, *comtxt, *reptxt;
- char *fcp, *p;
- int len, arylen, arysz;
- register int i,j,k;
-
- INIT_TRACE("SYSREQ_TRACE");
- TRACE(1, "sysreq", "SYSREQ(%x,%x,%x,%x,%d) entered",
- fsernam, fcomtxt, rcode, freptxt, arysz);
-
-/*
- * Converting fortran arrays
- */
-
- fcp = _fcdtocp(fsernam);
- len = _fcdlen(fsernam);
- if ((sernam = malloc(len+1)) == NULL) {
- *rcode = -errno;
- END_TRACE();
- return;
- }
- strncpy(sernam, fcp, len); sernam[len] = '\0';
- TRACE(2, "sysreq", "FORTRAN service name: %s",sernam);
-
- fcp = _fcdtocp(fcomtxt);
- len = _fcdlen(fcomtxt);
- if ((comtxt = malloc(len+1)) == NULL) {
- free(sernam);
- *rcode = -errno;
- END_TRACE();
- return;
- }
- strncpy(comtxt, fcp, len); comtxt[len] = '\0';
- TRACE(2, "sysreq", "FORTRAN comm. text: %s",comtxt);
-
- fcp = _fcdtocp(freptxt);
- arylen = _fcdlen(freptxt);
- arysz = *farysz*arylen;
-/*
- * Blank fill the array
- */
- for(i=0;i<arysz;i++) {
- fcp[i] = ' ';
- }
- if ((reptxt = malloc(arysz+1)) == NULL) {
- (void) free(sernam);
- (void) free(comtxt);
- *rcode = -errno;
- END_TRACE();
- return;
- }
- len = strlen(comtxt);
- *rcode = sysreq(sernam, comtxt, &len, reptxt, &arysz);
- (void) free(sernam);
- (void) free(comtxt);
-/*
- * Copy back, skipping new lines.
- */
-
- for (i=0,j=0,k=1;(i<arysz)&&(k<=arylen);i++) {
- if (reptxt[i]!= '\n') {
- fcp[j++] = reptxt[i];
- }
- else {
- j = arylen*(k++);
- }
- }
- *farysz = k;
- (void) free(reptxt);
-}
-#endif /* CRAY */
-
-#if (defined(apollo) && !defined(F77))
-
-static int
-do_sysreq(sernam, comtxt, comtxtl, reptxt, arysz)
-char *sernam; /* Service name */
-char *comtxt; /* Command text */
-int *comtxtl; /* Command text length */
-char *reptxt; /* Reply text */
-int *arysz; /* Reply array size, actual size on return */
-{
- char *p;
-#ifdef unix
- struct passwd *pw;
-#endif /* unix */
- char *acct;
- int aid;
-
- acct = " "; /* This is the default value */
-
- INIT_TRACE("SYSREQ_TRACE");
- TRACE(1, "sysreq", "do_sysreq(%s,%s,%d,%x,%d) entered",
- sernam, comtxt, *comtxtl, reptxt, *arysz);
- pw = getpwuid(geteuid());
- END_TRACE();
- return(_sysreq(pw->pw_name, acct,sernam,
- comtxt, *comtxtl, reptxt, arysz));
-}
-
-void SYSREQ(fsernam, fcomtxt, rcode,freptxt,farysz,
- fsernaml, fcomtxtl, freptxtl)
-char *fsernam, *fcomtxt, *freptxt;
-short *fsernaml, *fcomtxtl, *freptxtl;
-int *rcode,*farysz;
-{
- char *sernam, *comtxt, *reptxt;
- char *fcp, *p;
- int len, arylen, arysz;
- register int i,j,k;
-
- INIT_TRACE("SYSREQ_TRACE");
- TRACE(1, "sysreq", "SYSREQ(%x,%x,%x,%x,%d) entered",
- fsernam, fcomtxt, rcode, freptxt, arysz);
-
-/*
- * Converting fortran arrays
- */
-
- if ((sernam = malloc(*fsernaml+1)) == NULL) {
- *rcode = -errno;
- END_TRACE();
- return;
- }
- strncpy(sernam, fsernam, *fsernaml); sernam[*fsernaml] = '\0';
- TRACE(2, "sysreq", "FORTRAN service name: %s",sernam);
-
- if ((comtxt = malloc(*fcomtxtl+1)) == NULL) {
- free(sernam);
- *rcode = -errno;
- END_TRACE();
- return;
- }
- strncpy(comtxt, fcomtxt, *fcomtxtl); comtxt[*fcomtxtl] = '\0';
- TRACE(2, "sysreq", "FORTRAN comm. text: %s",comtxt);
-
- arylen = *freptxtl;
- arysz = *farysz*arylen;
-/*
- * Blank fill the array
- */
- for(i=0;i<arysz;i++) {
- freptxt[i] = ' ';
- }
- if ((reptxt = malloc(arysz+1)) == NULL) {
- (void) free(sernam);
- (void) free(comtxt);
- *rcode = -errno;
- END_TRACE();
- return;
- }
- len = strlen(comtxt);
- *rcode = do_sysreq(sernam, comtxt, &len, reptxt, &arysz);
- (void) free(sernam);
- (void) free(comtxt);
-/*
- * Copy back, skipping new lines.
- */
-
- for (i=0,j=0,k=1;(i<arysz)&&(k<=arylen);i++) {
- if (reptxt[i]!= '\n') {
- freptxt[j++] = reptxt[i];
- }
- else {
- j = arylen*(k++);
- }
- }
- *farysz = k;
- (void) free(reptxt);
-}
-#endif /* apollo */
-
-#if defined(UNIXF77)
-
-void sysreq_(fsernam, fcomtxt, rcode,freptxt,farysz,
- fsernaml, fcomtxtl, freptxtl)
-char *fsernam, *fcomtxt, *freptxt;
-int fsernaml, fcomtxtl, freptxtl;
-int *rcode,*farysz;
-{
- char *sernam, *comtxt, *reptxt;
- char *fcp, *p;
- int len, arylen, arysz;
- register int i,j,k;
-
-
- INIT_TRACE("SYSREQ_TRACE");
- TRACE(1, "sysreq", "SYSREQ(%x,%x,%x,%x,%d) entered",
- fsernam, fcomtxt, rcode, freptxt, *farysz);
-
-/*
- * Converting fortran arrays
- */
-
- if ((sernam = malloc(fsernaml+1)) == NULL) {
- *rcode = -errno;
- END_TRACE();
- return;
- }
- strncpy(sernam, fsernam, fsernaml); sernam[fsernaml] = '\0';
- TRACE(2, "sysreq", "FORTRAN service name: %s",sernam);
-
- if ((comtxt = malloc(fcomtxtl+1)) == NULL) {
- free(sernam);
- *rcode = -errno;
- END_TRACE();
- return;
- }
- strncpy(comtxt, fcomtxt, fcomtxtl); comtxt[fcomtxtl] = '\0';
- TRACE(2, "sysreq", "FORTRAN comm. text: %s",comtxt);
-
- arylen = freptxtl;
- arysz = *farysz*arylen;
-/*
- * Blank fill the array
- */
- for(i=0;i<arysz;i++) {
- freptxt[i] = ' ';
- }
- if ((reptxt = malloc(arysz+1)) == NULL) {
- (void) free(sernam);
- (void) free(comtxt);
- *rcode = -errno;
- END_TRACE();
- return;
- }
- len = strlen(comtxt);
- *rcode = sysreq(sernam, comtxt, &len, reptxt, &arysz);
- (void) free(sernam);
- (void) free(comtxt);
-/*
- * Copy back, skipping new lines.
- */
-
- for (i=0,j=0,k=1;(i<arysz)&&(k<=arylen);i++) {
- if (reptxt[i]!= '\n') {
- freptxt[j++] = reptxt[i];
- }
- else {
- j = arylen*(k++);
- }
- }
- *farysz = k;
- (void) free(reptxt);
-}
-#endif /* UNIXF77 */
-
-#if defined(vms)
-
-/*
- * Based on the "Introduction to VMS System Routines" manual for VMS 5.0
- */
-
-#include <ssdef.h> /* System services definitions */
-#include <uaidef.h> /* User authorization definitions */
-#include <rmsdef.h> /* Record Management definitions */
-
-#if defined(vms) && defined(DECC)
-#define __alpha
-#endif
-
-#if defined(vms) && defined(__alpha) && defined(COMPILE_NOPREFIX)
-#define cuserid DECC$CUSERID
-#define free DECC$FREE
-#define malloc DECC$MALLOC
-#define strncpy DECC$STRNCPY
-#define strlen DECC$STRLEN
-#endif /* vms && __alpha && COMPILE_NOPREFIX */
-
-extern int _sysreq(); /* Actual call to sysreq */
-
-static char account[9+1];
-static int accountl;
-
-typedef struct {
- short bufl;
- short code;
- char *buf;
- int *retl;
-} Item;
-
-typedef struct {
- int len;
- char *buf;
-} descrip;
-
-static struct {
- Item items[57];
- int eol;
-} itemlist = {
- {
- 9, UAI$_ACCOUNT, account, &accountl
- },
- 0
-};
-
-static int
-do_sysreq(sernam, comtxt, comtxtl, reptxt, arysz)
-char *sernam; /* Service name */
-char *comtxt; /* Command text */
-int *comtxtl; /* Command text length */
-char *reptxt; /* Reply text */
-int *arysz; /* Reply array size, actual size on return */
-{
- char *p;
- char *acct;
- descrip name_dsc;
- int rc;
- char name[L_cuserid];
-
- acct = " "; /* This is the default value */
-
- cuserid(name);
- name_dsc.len = strlen(name);
- name_dsc.buf = name;
- if ((rc = sys$getuai(0, 0, &name_dsc, &itemlist, 0, 0, 0))
- != SS$_NORMAL) {
- if (rc == RMS$_RNF) {
- acct = " ";
- }
- if (!(rc & 0x01)) {
- vaxc$errno = rc;
- errno = EVMSERR;
- acct = " ";
- }
- else {
- account[accountl]='\0';
- acct = account;
- }
- }
- else {
- account[accountl]='\0';
- acct = account;
- }
-
- INIT_TRACE("SYSREQ_TRACE");
- TRACE(1, "sysreq", "calling _sysreq(%s,%s,%d,%x,%d) entered",
- sernam, comtxt, *comtxtl, reptxt, *arysz);
- END_TRACE();
- return(_sysreq(name, acct,sernam, comtxt, *comtxtl, reptxt, arysz));
-}
-
-void SYSREQ(fsernam, fcomtxt, rcode,freptxt,farysz)
-struct dsc$descriptor_s *fsernam;
-struct dsc$descriptor_s *fcomtxt;
-int *rcode,*farysz;
-struct dsc$descriptor_a *freptxt;
-{
-
- char *sernam, *comtxt, *reptxt;
- char *p;
- int fsernaml, fcomtxtl;
- int len, arylen, arysz;
- register int i,j,k;
-
- INIT_TRACE("SYSREQ_TRACE");
- TRACE(1, "sysreq", "SYSREQ(%x,%x,%x,%x,%d) entered",
- fsernam, fcomtxt, rcode, freptxt, *farysz);
-
-/*
- * Converting fortran arrays
- */
-
- fsernaml = fsernam->dsc$w_length;
- if ((sernam = malloc(fsernaml+1)) == NULL) {
- *rcode = -errno;
- END_TRACE();
- return;
- }
- strncpy(sernam, fsernam->dsc$a_pointer, fsernaml);
- sernam[fsernaml] = '\0';
- TRACE(2, "sysreq", "FORTRAN service name: %s",sernam);
-
- fcomtxtl = fcomtxt->dsc$w_length;
- if ((comtxt = malloc(fcomtxtl+1)) == NULL) {
- free(sernam);
- *rcode = -errno;
- END_TRACE();
- return;
- }
- strncpy(comtxt, fcomtxt->dsc$a_pointer, fcomtxtl);
- comtxt[fcomtxtl] = '\0';
- TRACE(2, "sysreq", "FORTRAN comm. text: %s",comtxt);
-
- arysz = freptxt->dsc$l_arsize;
- arylen = arysz/(*farysz);
-/*
- * Blank fill the array
- */
-
- for(i=0;i<arysz;i++) {
- *((freptxt->dsc$a_pointer)+i) = ' ';
- }
- if ((reptxt = malloc(arysz+1)) == NULL) {
- (void) free(sernam);
- (void) free(comtxt);
- *rcode = -errno;
- END_TRACE();
- return;
- }
- len = strlen(comtxt);
- *rcode = do_sysreq(sernam, comtxt, &len, reptxt, &arysz);
- (void) free(sernam);
- (void) free(comtxt);
-/*
- * Copy back, skipping new lines.
- */
-
- for (i=0,j=0,k=1;(i<arysz)&&(k<=*farysz);i++) {
- if (reptxt[i]!= '\n') {
- *((freptxt->dsc$a_pointer)+(j++)) = reptxt[i];
- }
- else {
- j = arylen*(k++);
- }
- }
- *farysz = k;
- (void) free(reptxt);
-}
-#endif /* vms */
diff --git a/src/packlib/cspack/sysreq/tcpsock.h b/src/packlib/cspack/sysreq/tcpsock.h
deleted file mode 100644
index 4b5789f..0000000
--- a/src/packlib/cspack/sysreq/tcpsock.h
+++ /dev/null
@@ -1,35 +0,0 @@
-/*
- * $Id: tcpsock.h,v 1.1.1.1 1996/03/08 15:44:26 mclareni Exp $
- *
- * $Log: tcpsock.h,v $
- * Revision 1.1.1.1 1996/03/08 15:44:26 mclareni
- * Cspack
- *
- */
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB_TCPSOCK))
-#define localtime LOCALTIM
-#define ruserpass RUSERPAS
-#define inetd_sock_setup I_SETUP
-#define inetd_sock_close I_CLOSE
-#define server_sock_setup S_SETUP
-#define client_sock_setup C_SETUP
-#define sock_close S_CLOSE
-#define sock_sendstr S_SNDST
-#define sock_recvstr S_RCVST
-#define sock_send S_SEND
-#define sock_recv S_RECV
-#define client_sock_setup_ C__SETU
-#define inetd_sock_setup_ I__SETU
-#define inetd_sock_close_ I__CLOS
-#define server_sock_setup_ S__SETU
-#define sock_close_ S__CLOS
-#define sock_sendstr_ S__SNDS
-#define sock_recvstr_ S__RCVS
-#define sock_send_ S__SEND
-#define sock_recv_ S__RECV
-#define ssendstr_ SSND_ST
-#define srecvstr_ SRCV_ST
-#define initgroups INITGRO
-#define ssendstr SSENSTR
-#define srecvstr SRECSTR
-#endif
diff --git a/src/packlib/cspack/sysreq/telnet.h b/src/packlib/cspack/sysreq/telnet.h
deleted file mode 100644
index 2d2de13..0000000
--- a/src/packlib/cspack/sysreq/telnet.h
+++ /dev/null
@@ -1,92 +0,0 @@
-/*
- * $Id: telnet.h,v 1.1.1.1 1996/03/08 15:44:26 mclareni Exp $
- *
- * $Log: telnet.h,v $
- * Revision 1.1.1.1 1996/03/08 15:44:26 mclareni
- * Cspack
- *
- */
-#if defined(CERNLIB_VAX)||defined(CERNLIB_TGV)
-/*
- * Copyright (c) 1983 Regents of the University of California.
- * All rights reserved. The Berkeley software License Agreement
- * specifies the terms and conditions for redistribution.
- *
- * @(#)telnet.h 5.1 (Berkeley) 5/30/85
- */
-
-/*
- * Definitions for the TELNET protocol.
- */
-#define IAC 255 /* interpret as command: */
-#define DONT 254 /* you are not to use option */
-#define DO 253 /* please, you use option */
-#define WONT 252 /* I won't use option */
-#define WILL 251 /* I will use option */
-#define SB 250 /* interpret as subnegotiation */
-#define GA 249 /* you may reverse the line */
-#define EL 248 /* erase the current line */
-#define EC 247 /* erase the current character */
-#define AYT 246 /* are you there */
-#define AO 245 /* abort output--but let prog finish */
-#define IP 244 /* interrupt process--permanently */
-#define BREAK 243 /* break */
-#define DM 242 /* data mark--for connect. cleaning */
-#define NOP 241 /* nop */
-#define SE 240 /* end sub negotiation */
-#define EOR 239 /* end of record (transparent mode) */
-
-#define SYNCH 242 /* for telfunc calls */
-
-#ifdef TELCMDS
-char *telcmds[] = {
- "SE", "NOP", "DMARK", "BRK", "IP", "AO", "AYT", "EC",
- "EL", "GA", "SB", "WILL", "WONT", "DO", "DONT", "IAC",
-};
-#endif
-
-/* telnet options */
-#define TELOPT_BINARY 0 /* 8-bit data path */
-#define TELOPT_ECHO 1 /* echo */
-#define TELOPT_RCP 2 /* prepare to reconnect */
-#define TELOPT_SGA 3 /* suppress go ahead */
-#define TELOPT_NAMS 4 /* approximate message size */
-#define TELOPT_STATUS 5 /* give status */
-#define TELOPT_TM 6 /* timing mark */
-#define TELOPT_RCTE 7 /* remote controlled transmission and echo */
-#define TELOPT_NAOL 8 /* negotiate about output line width */
-#define TELOPT_NAOP 9 /* negotiate about output page size */
-#define TELOPT_NAOCRD 10 /* negotiate about CR disposition */
-#define TELOPT_NAOHTS 11 /* negotiate about horizontal tabstops */
-#define TELOPT_NAOHTD 12 /* negotiate about horizontal tab disposition */
-#define TELOPT_NAOFFD 13 /* negotiate about formfeed disposition */
-#define TELOPT_NAOVTS 14 /* negotiate about vertical tab stops */
-#define TELOPT_NAOVTD 15 /* negotiate about vertical tab disposition */
-#define TELOPT_NAOLFD 16 /* negotiate about output LF disposition */
-#define TELOPT_XASCII 17 /* extended ascic character set */
-#define TELOPT_LOGOUT 18 /* force logout */
-#define TELOPT_BM 19 /* byte macro */
-#define TELOPT_DET 20 /* data entry terminal */
-#define TELOPT_SUPDUP 21 /* supdup protocol */
-#define TELOPT_SUPDUPOUTPUT 22 /* supdup output */
-#define TELOPT_SNDLOC 23 /* send location */
-#define TELOPT_TTYPE 24 /* terminal type */
-#define TELOPT_EOR 25 /* end or record */
-#define TELOPT_EXOPL 255 /* extended-options-list */
-
-#ifdef TELOPTS
-#define NTELOPTS (1+TELOPT_EOR)
-char *telopts[NTELOPTS] = {
- "BINARY", "ECHO", "RCP", "SUPPRESS GO AHEAD", "NAME",
- "STATUS", "TIMING MARK", "RCTE", "NAOL", "NAOP",
- "NAOCRD", "NAOHTS", "NAOHTD", "NAOFFD", "NAOVTS",
- "NAOVTD", "NAOLFD", "EXTEND ASCII", "LOGOUT", "BYTE MACRO",
- "DATA ENTRY TERMINAL", "SUPDUP", "SUPDUP OUTPUT",
- "SEND LOCATION", "TERMINAL TYPE", "END OF RECORD",
-};
-#endif
-
-/* sub-option qualifiers */
-#define TELQUAL_IS 0 /* option is... */
-#define TELQUAL_SEND 1 /* send option */
-#endif
diff --git a/src/packlib/cspack/sysreq/trace.c b/src/packlib/cspack/sysreq/trace.c
deleted file mode 100644
index 1943485..0000000
--- a/src/packlib/cspack/sysreq/trace.c
+++ /dev/null
@@ -1,105 +0,0 @@
-/*
- * $Id: trace.c,v 1.2 2003/09/02 12:47:16 mclareni Exp $
- *
- * $Log: trace.c,v $
- * Revision 1.2 2003/09/02 12:47:16 mclareni
- * Mods to replace varargs.h (removed from gcc 3.3) with stdarg.h for Linux gcc
- * 3.3.
- *
- * Revision 1.1.1.1 1996/03/08 15:44:26 mclareni
- * Cspack
- *
- */
-/*
- * Copyright (C) 1990,1991 by CERN/CN/SW/DC
- * All rights reserved
- */
-
-#ifndef lint
-static char sccsid[] =
-"@(#)trace.c 1.5 7/13/94 CERN CN-SW/DC Frederic Hemmer";
-#endif /* not lint */
-
-/* trace.c General tracing facility */
-
-#include <stdio.h> /* standard input/output definitions */
-#if !defined(LINUX)
-#include <varargs.h> /* variable argument list definitions */
-#else
-#include <stdarg.h>
-#endif /* LINUX */
-#if defined(vms)
-#include <stdlib.h> /* General utility definitions */
-#endif /* vms */
-
-#if defined(vms) && defined(DECC)
-#define __alpha
-#endif
-
-#if defined(vms) && defined(__alpha) && defined(COMPILE_NOPREFIX)
-#define atoi DECC$ATOI
-#define fflush DECC$FFLUSH
-#define getenv DECC$GETENV
-#endif /* vms && __alpha && COMPILE_NOPREFIX */
-
-static int trace_initialized = 0; /* trace initialized flag */
-static int trace_level = 0; /* dynamic trace level */
-static int indent_level = 0; /* dynamic indentation level */
-
-#if !defined(vms)
-extern char* getenv(); /* get environment variable */
-#endif /* vms */
-
-/*VARARGS*/
-#if !defined(LINUX)
-void print_trace(va_alist) va_dcl
-#else
-void print_trace(int level, ...)
-#endif /* LINUX */
-{
- va_list args; /* arguments */
- register char *label; /* leading label */
- register char *format; /* print format string */
- register int i; /* general purpose index */
-#if !defined(LINUX)
- register int level; /* trace level */
- va_start(args); /* initialize to beginning of list */
- level = va_arg(args, int);
-#else
- va_start(args, level);
-#endif /* LINUX */
- if (trace_level < level) return;
- label = va_arg(args, char *);
- for (i=0; i< level+indent_level ; i++) {
- fprintf(stdout," "); /* indentation */
- }
- fprintf(stdout,"%s: ", label);
- format = va_arg(args, char *);
- (void) vfprintf(stdout, format, args);
- fprintf(stdout,"\n");
- va_end(args);
- fflush(stdout);
-}
-
-void init_trace(name) /* initialize trace level */
-char *name; /* environment variable name */
-{
- register char *p; /* general purpose char. string pointer */
-
- if (!trace_initialized) {
- if ((p = getenv(name)) != NULL) {
- if (atoi(p) != 0) {
- trace_level = atoi(p);
- print_trace(0, " **** ", "trace level set \
-to %d", trace_level);
- }
- }
- trace_initialized++;
- }
- indent_level++;
-}
-
-void end_trace() /* end trace level */
-{
- if (indent_level > 0) indent_level--;
-}
diff --git a/src/packlib/cspack/sysreq/trace.h b/src/packlib/cspack/sysreq/trace.h
deleted file mode 100644
index ca995f8..0000000
--- a/src/packlib/cspack/sysreq/trace.h
+++ /dev/null
@@ -1,31 +0,0 @@
-/*
- * $Id: trace.h,v 1.1.1.1 1996/03/08 15:44:26 mclareni Exp $
- *
- * $Log: trace.h,v $
- * Revision 1.1.1.1 1996/03/08 15:44:26 mclareni
- * Cspack
- *
- */
-/*
- * @(#)trace.h 1.2 5/5/91 CERN CN-SW/DC Frederic Hemmer
- */
-
-/*
- * Copyright (C) 1990,1991 by CERN/CN/SW/DC
- * All rights reserved
- */
-
-/* trace.h tracing routines header */
-
-#ifndef _TRACE_H_INCLUDED_
-#define _TRACE_H_INCLUDED_
-
-extern void print_trace();
-extern void init_trace();
-extern void end_trace();
-
-#define TRACE print_trace
-#define INIT_TRACE init_trace
-#define END_TRACE end_trace
-
-#endif /* _TRACE_H_INCLUDED_ */
diff --git a/src/packlib/cspack/sysreq/uaidef.h b/src/packlib/cspack/sysreq/uaidef.h
deleted file mode 100644
index a3d666e..0000000
--- a/src/packlib/cspack/sysreq/uaidef.h
+++ /dev/null
@@ -1,139 +0,0 @@
-/*
- * $Id: uaidef.h,v 1.1.1.1 1996/03/08 15:44:26 mclareni Exp $
- *
- * $Log: uaidef.h,v $
- * Revision 1.1.1.1 1996/03/08 15:44:26 mclareni
- * Cspack
- *
- */
-#if defined(CERNLIB_VAXVMS)
-#define UAI$_RTYPE 1
-#define UAI$_VERSION 2
-#define UAI$_USRDATOFF 3
-#define UAI$_USERNAME 4
-#define UAI$_USERNAME_TAG 5
-#define UAI$_UIC 6
-#define UAI$_MEM 7
-#define UAI$_GRP 8
-#define UAI$_SUB_ID 9
-#define UAI$_PARENT_ID 10
-#define UAI$_ACCOUNT 11
-#define UAI$_OWNER 12
-#define UAI$_DEFDEV 13
-#define UAI$_DEFDIR 14
-#define UAI$_LGICMD 15
-#define UAI$_DEFCLI 16
-#define UAI$_CLITABLES 17
-#define UAI$_PWD 18
-#define UAI$_PWD2 19
-#define UAI$_LOGFAILS 20
-#define UAI$_SALT 21
-#define UAI$_ENCRYPT 22
-#define UAI$_ENCRYPT2 23
-#define UAI$_PWD_LENGTH 24
-#define UAI$_EXPIRATION 25
-#define UAI$_PWD_LIFETIME 26
-#define UAI$_PWD_DATE 27
-#define UAI$_PWD2_DATE 28
-#define UAI$_LASTLOGIN_I 29
-#define UAI$_LASTLOGIN_N 30
-#define UAI$_PRIV 31
-#define UAI$_DEF_PRIV 32
-#define UAI$_MIN_CLASS 33
-#define UAI$_MAX_CLASS 34
-#define UAI$_FLAGS 35
-#define UAI$_NETWORK_ACCESS_P 36
-#define UAI$_NETWORK_ACCESS_S 37
-#define UAI$_BATCH_ACCESS_P 38
-#define UAI$_BATCH_ACCESS_S 39
-#define UAI$_LOCAL_ACCESS_P 40
-#define UAI$_LOCAL_ACCESS_S 41
-#define UAI$_DIALUP_ACCESS_P 42
-#define UAI$_DIALUP_ACCESS_S 43
-#define UAI$_REMOTE_ACCESS_P 44
-#define UAI$_REMOTE_ACCESS_S 45
-#define UAI$_PRIMEDAYS 46
-#define UAI$_PRI 47
-#define UAI$_QUEPRI 48
-#define UAI$_MAXJOBS 49
-#define UAI$_MAXACCTJOBS 50
-#define UAI$_MAXDETACH 51
-#define UAI$_PRCCNT 52
-#define UAI$_BIOLM 53
-#define UAI$_DIOLM 54
-#define UAI$_TQCNT 55
-#define UAI$_ASTLM 56
-#define UAI$_ENQLM 57
-#define UAI$_FILLM 58
-#define UAI$_SHRFILLM 59
-#define UAI$_WSQUOTA 60
-#define UAI$_DFWSCNT 61
-#define UAI$_WSEXTENT 62
-#define UAI$_PGFLQUOTA 63
-#define UAI$_CPUTIM 64
-#define UAI$_BYTLM 65
-#define UAI$_PBYTLM 66
-#define UAI$_JTQUOTA 67
-#define UAI$_PROXY_LIM 68
-#define UAI$_PROXIES 69
-#define UAI$_ACCOUNT_LIM 70
-#define UAI$_ACCOUNTS 71
-#define UAI$_USER_DATA 72
-#define UAI$_PASSWORD 73
-#define UAI$_PASSWORD2 74
-#define UAI$_MAX_ITEM_CODE 75
-#define UAI$C_AD_II 0
-#define UAI$C_PURDY 1
-#define UAI$C_PURDY_V 2
-#define UAI$C_PURDY_S 3
-#define UAI$C_PREFERED_ALGORITHM 3
-#define UAI$C_CUST_ALGORITHM 128
-#define UAI$C_MAX_PWD_LENGTH 32
-#define UAI$M_DISCTLY 1
-#define UAI$M_DEFCLI 2
-#define UAI$M_LOCKPWD 4
-#define UAI$M_RESTRICTED 8
-#define UAI$M_DISACNT 16
-#define UAI$M_DISWELCOM 32
-#define UAI$M_DISMAIL 64
-#define UAI$M_NOMAIL 128
-#define UAI$M_GENPWD 256
-#define UAI$M_PWD_EXPIRED 512
-#define UAI$M_PWD2_EXPIRED 1024
-#define UAI$M_AUDIT 2048
-#define UAI$M_DISREPORT 4096
-#define UAI$M_DISRECONNECT 8192
-#define UAI$M_AUTOLOGIN 16384
-#define UAI$M_DISFORCE_PWD_CHANGE 32768
-#define UAI$M_CAPTIVE 65536
-#define UAI$M_DISIMAGE 131072
-#define UAI$M_DISPWDDIC 262144
-#define UAI$M_DISPWDHIS 524288
-#define UAI$V_DISCTLY 0
-#define UAI$V_DEFCLI 1
-#define UAI$V_LOCKPWD 2
-#define UAI$V_RESTRICTED 3
-#define UAI$V_DISACNT 4
-#define UAI$V_DISWELCOM 5
-#define UAI$V_DISMAIL 6
-#define UAI$V_NOMAIL 7
-#define UAI$V_GENPWD 8
-#define UAI$V_PWD_EXPIRED 9
-#define UAI$V_PWD2_EXPIRED 10
-#define UAI$V_AUDIT 11
-#define UAI$V_DISREPORT 12
-#define UAI$V_DISRECONNECT 13
-#define UAI$V_AUTOLOGIN 14
-#define UAI$V_DISFORCE_PWD_CHANGE 15
-#define UAI$V_CAPTIVE 16
-#define UAI$V_DISIMAGE 17
-#define UAI$V_DISPWDDIC 18
-#define UAI$V_DISPWDHIS 19
-#define UAI$V_MONDAY 0
-#define UAI$V_TUESDAY 1
-#define UAI$V_WEDNESDAY 2
-#define UAI$V_THURSDAY 3
-#define UAI$V_FRIDAY 4
-#define UAI$V_SATURDAY 5
-#define UAI$V_SUNDAY 6
-#endif
diff --git a/src/packlib/cspack/sysreq/xdr.c b/src/packlib/cspack/sysreq/xdr.c
deleted file mode 100644
index f22ef78..0000000
--- a/src/packlib/cspack/sysreq/xdr.c
+++ /dev/null
@@ -1,223 +0,0 @@
-/*
- * $Id: xdr.c,v 1.1.1.1 1996/03/08 15:44:26 mclareni Exp $
- *
- * $Log: xdr.c,v $
- * Revision 1.1.1.1 1996/03/08 15:44:26 mclareni
- * Cspack
- *
- */
-/*
- * Copyright (C) 1990,1991 by CERN/CN/SW/DC
- * All rights reserved
- */
-
-#ifndef lint
-static char sccsid[] = "@(#)xdr.c 1.16 7/13/94 CERN CN-SW/DC Frederic \
-Hemmer";
-#endif /* not lint */
-
-/* xdr.c eXternal Data Representation */
-
-#if !defined(DEBUG)
-#define DEBUG 0
-#endif /* DEBUG */
-#include <stdio.h> /* standard Input/Output definitions */
-
-#ifdef VM
-#ifdef SOCKETEMUL /* no socket library available, use own */
-#include "cms2unix.h"
-#endif /* SOCKETEMUL */
-#endif /* VM */
-
-#ifndef vms
-#include <config.h> /* configuration parameters */
-#include <sysreq.h> /* SYSREQ specific definitions */
-#include <sys/types.h> /* standard data types */
-#include <netinet/in.h> /* internet data types */
-#else
-#include "config.h" /* configuration parameters */
-#include "sysreq.h" /* SYSREQ specific definitions */
-#include <types.h> /* standard data types */
-#include <in.h> /* internet data types */
-#endif /* vms */
-
-#include "net.h" /* networking specifics */
-
-#if DEBUG
-#include <ctype.h> /* Character type macros and defs. */
-#endif /* DEBUG */
-
-#ifndef min
-#define min(x, y) (((x-y) > 0) ? y : x)
-#endif /* min */
-
-#ifndef VM
-extern char *malloc();
-#endif /* VM */
-
-#ifdef VM
-extern char ebcdictoascii[], asciitoebcdic[];
-#endif /* VM */
-
-#if defined(vms) && defined(DECC)
-#define __alpha
-#endif
-
-#if defined(vms) && defined(__alpha) && defined(COMPILE_NOPREFIX)
-#define free DECC$FREE
-#define htonl DECC$HTONL
-#define htons DECC$HTONS
-#define malloc DECC$MALLOC
-#define ntohl DECC$NTOHL
-#define ntohs DECC$NTOHS
-#endif /* vms && __alpha && COMPILE_NOPREFIX */
-
-#if DEBUG
-void /* Dump buffer's contents */
-dump(buf, bufl)
-char *buf;
-short bufl;
-{
- register int i, j, n;
- register char c;
-
-#define WIDTH 17
- for (i=0;i<=bufl/WIDTH;i++) {
- n = i*WIDTH;
- fprintf(stdout,"%.8x: ",buf+n);
- for(j=0; j<min(WIDTH,bufl-n); j++) {
- c = *(buf+n+j);
- if (isprint(c)) fprintf(stdout," %c ", c);
- else fprintf(stdout,"<%.2x>",c);
- }
- fprintf(stdout,"\n");
- }
-}
-#endif /* DEBUG */
-
-static char * /* Externalize a character string */
-Xstr(buf, bufl)
-char *buf;
-short bufl;
-{
-#if EBCDIC
- CMXLATE(buf,ebcdictoascii,bufl);
-#endif /* EBCDIC */
- return(buf);
-}
-
-static char * /* Internalize a character string */
-Istr(buf, bufl)
-char *buf;
-short bufl;
-{
-#if EBCDIC
- CMXLATE(buf,asciitoebcdic,bufl);
-#endif /* EBCDIC */
- return(buf);
-}
-
-int
-SendWord(s, word)
-int s;
-WORD *word;
-{
- WORD buf;
-
- buf = htons(*word);
- if (netwrite(s ,((char *)&buf) + sizeof(WORD) - WORDSIZE, WORDSIZE)
- != WORDSIZE)
- return (-1);
- return(WORDSIZE);
-}
-
-int
-RecvWord(s, word)
-int s;
-WORD *word;
-{
- WORD buf;
-
- buf = 0;
- if (netread(s ,((char *)&buf) + sizeof(WORD) - WORDSIZE, WORDSIZE)
- != WORDSIZE)
- return (-1);
- *word = ntohs(buf);
- return(WORDSIZE);
-}
-
-int
-SendLong(s, longword)
-int s;
-LONG *longword;
-{
- LONG buf;
-
- buf = htonl(*longword);
- if (netwrite(s ,((char *)&buf) + sizeof(LONG) - LONGSIZE, LONGSIZE)
- != LONGSIZE)
- return (-1);
- return(LONGSIZE);
-}
-
-int
-RecvLong(s, longword)
-int s;
-LONG *longword;
-{
- LONG buf;
-
- buf = 0;
- if (netread(s ,((char *)&buf) + sizeof(LONG) - LONGSIZE, LONGSIZE)
- != LONGSIZE)
- return (-1);
- *longword = ntohl(buf);
- return(LONGSIZE);
-}
-
-char * /* Receive a string from the net */
-RecvStr(s, size)
-int s;
-int *size;
-{
- register int len;
- int s_len;
- char *p1, *p2;
-
- if (RecvLong(s, &s_len) != LONGSIZE) return((char *)-1);
- if ((p1 = malloc(s_len+1)) == 0) return((char *)-1);
- if (s_len != 0) {
- if ((len = netread(s, p1, s_len)) != s_len) {
- free(p1);
- return((char *)-1);
- }
- p2 = Istr(p1, s_len+1);
- *size = s_len;
- p2[s_len] = '\0';
- }
- else {
- *p1 = '\0';
- p2 = p1;
- *size = 0;
- }
- return(p2);
-}
-
-int
-SendStr(s, buf, size)
-int s;
-char *buf;
-int size;
-{
- int len;
- char *p;
-
- len = size;
- if (SendLong(s, &len) != LONGSIZE) return(-1);
- if (size !=0) {
- p = Xstr(buf,size);
- if (netwrite(s, p, size) != size) return(-1);
- }
- return(size);
-}
-
diff --git a/src/packlib/cspack/sz/Imakefile b/src/packlib/cspack/sz/Imakefile
deleted file mode 100644
index 3776b59..0000000
--- a/src/packlib/cspack/sz/Imakefile
+++ /dev/null
@@ -1,13 +0,0 @@
-SRCS_F= setdef.F szcd.F szclos.F szinqr.F szls.F szmv.F szopen.F \ @@\
- szpiaf.F szread.F szrewd.F szrite.F szrm.F szvers.F
-
-#if defined(CERNLIB_IBMRT) && defined(CERNLIB_PLODGE)
-/* Historical */
-SRCS_F := $(SRCS_F) chdir.F getcwd.F
-#endif
-
-#if defined(CERNLIB_VAXVMS)
-SRCS_F := $(SRCS_F) getdef.F
-#endif
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/cspack/sz/chdir.F b/src/packlib/cspack/sz/chdir.F
deleted file mode 100644
index b10babc..0000000
--- a/src/packlib/cspack/sz/chdir.F
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: chdir.F,v 1.1.1.1 1996/03/08 15:44:27 mclareni Exp $
-*
-* $Log: chdir.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:27 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
-#if (defined(CERNLIB_IBMRT))&&(defined(CERNLIB_PLODGE))
- INTEGER FUNCTION CHDIR_(CHPATH)
- CHARACTER*() CHDIR_
- CHARACTER*255 PATH
- LOGICAL*1 IPATH(255)
- EQUIVALENCE (IPATH(1),PATH)
- PATH = CHPATH
-*
-* Null terminate PATH string for call to C RTL
-*
- PATH(LENOCC_(CHPATH)+1) = .FALSE.
- CHDIR_ = CHDIR(PATH)
- END
-
-#endif
diff --git a/src/packlib/cspack/sz/getcwd.F b/src/packlib/cspack/sz/getcwd.F
deleted file mode 100644
index 4d43a65..0000000
--- a/src/packlib/cspack/sz/getcwd.F
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: getcwd.F,v 1.1.1.1 1996/03/08 15:44:27 mclareni Exp $
-*
-* $Log: getcwd.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:27 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
-#if (defined(CERNLIB_IBMRT))&&(defined(CERNLIB_PLODGE))
- SUBROUTINE GETCWD_(CHPATH)
- CHARACTER*() CHPATH
- CALL GETCWD(CHPATH,L)
- END
-
-#endif
diff --git a/src/packlib/cspack/sz/getdef.F b/src/packlib/cspack/sz/getdef.F
deleted file mode 100644
index 2aed70a..0000000
--- a/src/packlib/cspack/sz/getdef.F
+++ /dev/null
@@ -1,40 +0,0 @@
-*
-* $Id: getdef.F,v 1.1.1.1 1996/03/08 15:44:27 mclareni Exp $
-*
-* $Log: getdef.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:27 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
-#if defined(CERNLIB_VAXVMS)
- SUBROUTINE GETDEF (CHNAME)
-
-C CERN PROGLIB# GETDEF .VERSION KERNVAX 2.35 900731
-C ORIG. 31/07/90, Federico Carminati
-C Modified to avoid conflict with C RTL routines
-C- Simulate UNIX system call
-
- COMMON /SLATE/ ISTAT, ISLATE(39)
- CHARACTER CHNAME*(*)
- INTEGER SYS$SETDDIR
-
-* ISTAT = LIB$SYS_TRNLOG ('SYS$DISK',NDISK,CHNAME,,,%VAL(0))
- CHNAME = ' '
- CALL CZGTLG('SYS$DISK',CHNAME,'LNM$PROCESS',ISTAT)
- IF (ISTAT.NE.0) GO TO 99
- NDISK = LENOCC(CHNAME)
-
- ISTAT = SYS$SETDDIR(%VAL(0), NDIR, CHNAME(NDISK+1:))
-
- IF (.NOT.ISTAT) GO TO 99
-
- CHNAME(NDISK+NDIR+1:) = ' '
- ISTAT = 0
- RETURN
-
- 99 CHNAME = ' '
- RETURN
- END
-
-#endif
diff --git a/src/packlib/cspack/sz/setdef.F b/src/packlib/cspack/sz/setdef.F
deleted file mode 100644
index 8b5b7fe..0000000
--- a/src/packlib/cspack/sz/setdef.F
+++ /dev/null
@@ -1,126 +0,0 @@
-*
-* $Id: setdef.F,v 1.1.1.1 1996/03/08 15:44:27 mclareni Exp $
-*
-* $Log: setdef.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:27 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- INTEGER FUNCTION SETDEF(CHNAME)
-#if (!defined(CERNLIB_VAXVMS))&&(!defined(CERNLIB_APOLLO))
- SETDEF = 0
-#endif
-#if defined(CERNLIB_VAXVMS)
-C CERN PROGLIB# SETDEF .VERSION KERNVAX 2.35 900731
-C ORIG. 31/07/90, Federico Carminati
-C Modified to avoid conflict with C RTL routines & work in detached mode
-C JDS
-C- Simulate UNIX system call
-
- INCLUDE '($LNMDEF)'
- STRUCTURE /ITMLST/
- UNION
- MAP
- INTEGER*2 BUFFER_LENGTH
- INTEGER*2 ITEM_CODE
- INTEGER*4 BUFFER_ADDRESS
- INTEGER*4 RETURN_LENGTH_ADDRESS
- ENDMAP
- MAP
- INTEGER*4 END_LIST /0/
- ENDMAP
- END UNION
- END STRUCTURE
-
- RECORD /ITMLST/ LNM_LIST(2)
-
- COMMON /SLATE/ ISTAT, ISLATE(39)
-
- CHARACTER CHNAME*(*), CHSTRI*255, CHLOGN*127
- LOGICAL FIRST
- INTEGER*2 LIST2(2)
- INTEGER LIST4(4), SYS$SETDDIR, SYS$TRNLNM, SYS$CRELNM
- EQUIVALENCE (LIST2, LIST4)
- DATA LENRET/0/
-
- CHSTRI=CHNAME
- FIRST=.TRUE.
- LENCHN=INDEX(CHNAME,' ')-1
- IF (LENCHN.LE.0) LENCHN=LEN(CHNAME)
-*
-* Cater for users who like the <> characters as directory delimiters
-*
- CALL CTRANS('<','[',CHSTRI,1,LENCHN)
- CALL CTRANS('>',']',CHSTRI,1,LENCHN)
- 10 IF (CHSTRI(1:1).NE.'[') THEN
- IF (INDEX(CHSTRI,':[') .NE. 0) THEN
-*
-*--- A directory and a device are specified
-*
-* ISTAT=LIB$SET_LOGICAL('SYS$DISK',CHSTRI(1:INDEX(CHSTRI,':')),
-* + 'LNM$PROCESS')
-
- LNM_LIST(1).BUFFER_LENGTH = INDEX(CHSTRI,':')
- LNM_LIST(1).ITEM_CODE = LNM$_STRING
- LNM_LIST(1).BUFFER_ADDRESS = %LOC(CHSTRI)
- LNM_LIST(1).RETURN_LENGTH_ADDRESS = %LOC(LENRET)
-
- LNM_LIST(2).END_LIST = 0
-
- ISTAT=SYS$CRELNM(,'LNM$PROCESS','SYS$DISK',,LNM_LIST)
- IF(.NOT.ISTAT) GO TO 20
- CHSTRI=CHSTRI(INDEX(CHSTRI,'['):)
- ELSEIF (CHSTRI(LENCHN:LENCHN).EQ.':') THEN
-*
-*--- A device only is specified
-*
-* ISTAT=LIB$SET_LOGICAL('SYS$DISK',CHSTRI(:LENCHN),
-* + 'LNM$PROCESS')
-
- LNM_LIST(1).BUFFER_LENGTH = LENCHN
- LNM_LIST(1).ITEM_CODE = LNM$_STRING
- LNM_LIST(1).BUFFER_ADDRESS = %LOC(CHSTRI)
- LNM_LIST(1).RETURN_LENGTH_ADDRESS = %LOC(LENRET)
-
- LNM_LIST(2).END_LIST = 0
-
- ISTAT=SYS$CRELNM(,'LNM$PROCESS','SYS$DISK',,LNM_LIST)
- GO TO 20
- ELSEIF (FIRST) THEN
- FIRST=.FALSE.
- LIST2(1)=LEN(CHLOGN)
- LIST2(2)=LNM$_STRING
- LIST4(2)=%LOC(CHLOGN)
- LIST4(3)=%LOC(LENCH)
- LIST4(4)=0
- ISTAT = SYS$TRNLNM(LNM$M_CASE_BLIND,'LNM$FILE_DEV',
- + CHSTRI(1:INDEX(CHSTRI,' ')-1),,LIST2)
- IF(.NOT.ISTAT) GO TO 20
- CHSTRI=CHLOGN(:LENCH)
- GO TO 10
- ELSE
- ISTAT=0
- GO TO 20
- END IF
- END IF
- ISTAT = SYS$SETDDIR(CHSTRI, %VAL(0), %VAL(0))
- 20 IF (ISTAT) THEN
- ISTAT = 0
- IRET = 0
- ELSE
- IRET = -1
- ENDIF
- SETDEF = IRET
- RETURN
-#endif
-#if defined(CERNLIB_APOLLO)
- CHARACTER CHNAME*(*)
- INTEGER*2 LENA
-
- LENA = LENOCC(CHNAME)
- CALL NAME_$SET_WDIR (CHNAME,LENA,ISTAT)
- SETDEF = ISTAT
- RETURN
-#endif
- END
diff --git a/src/packlib/cspack/sz/szcd.F b/src/packlib/cspack/sz/szcd.F
deleted file mode 100644
index 7a652eb..0000000
--- a/src/packlib/cspack/sz/szcd.F
+++ /dev/null
@@ -1,138 +0,0 @@
-*
-* $Id: szcd.F,v 1.1.1.1 1996/03/08 15:44:26 mclareni Exp $
-*
-* $Log: szcd.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:26 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE SZCD(PATH,IRC)
- CHARACTER*(*) PATH
- CHARACTER*80 CHPATH,CHGIME
- CHARACTER*20 CHOPT,CHPASS
-#if defined(CERNLIB_IBMMVS)
- LPATH = LENOCC(PATH)
- CALL XZPREF(PATH(1:LPATH),IRC)
- CALL XZRPRE(CHPATH,LPATH)
-#endif
-#if defined(CERNLIB_IBMVM)
- DATA NENTRY/0/
- CHARACTER*80 LINE
- CHARACTER*8 CHUSER
- INTEGER FMUSER
- NENTRY = 1
- LPATH = LENOCC(PATH)
-*
-* Look for a blank in the path name - this indicates that there
-* is a password and option following
-*
- LBLANK = INDEX(PATH(1:LPATH),' ')
-*
-* Translate user.address to user address
-*
- IDOT = INDEX(PATH(1:LPATH),'.')
- IF(IDOT.NE.0) PATH(IDOT:IDOT) = ' '
-
- IF(LBLANK.EQ.0) THEN
- CALL VMCMS('EXEC GIME '//PATH(1:LPATH)//' (STACK',IRC)
- ELSE
-*
-* Strip off password and options
-*
- JBLANK = INDEXB(PATH(1:LPATH),' ')
- CHPASS = PATH(LBLANK+1:JBLANK-1)
- CHOPT = PATH(JBLANK+1:LPATH)
- LPATH = LBLANK - 1
- LPASS = JBLANK - LBLANK - 1
- IF(INDEX(CHOPT,'W').NE.0) THEN
- CHGIME = ' * '//CHPASS(1:LPASS)//' (MR STACK'
- ELSE
- CHGIME = ' * '//CHPASS(1:LPASS)//' (RR STACK'
- ENDIF
-
- CALL VMCMS('EXEC GIME '//PATH(1:LPATH)//
- + CHGIME,IRC)
-
- ENDIF
-*
-* Return code 4 is only a warning - existing link exists
-*
- IF(IRC.GT.4) THEN
- RETURN
- ELSE
- CALL VMRTRM(LINE,IRC)
- CALL VMCMS('EXEC SWAPMODE A '//LINE(1:1),IRC)
- CALL CZPUTA('2Remote directory changed to '//PATH(1:LPATH),IRC)
- CHPATH = PATH(1:LPATH)
- ENDIF
- RETURN
-
-#endif
-#if defined(CERNLIB_VAXVMS)||defined(CERNLIB_UNIX)
- INTEGER SETDEF
- INTEGER CHDIR
- INTEGER CHDIRF
- COMMON/SLATE/IS(40)
- LPATH = LENOCC(PATH)
- CHPATH = PATH(1:LPATH)
-#endif
-#if defined(CERNLIB_UNIX)
-*
-* Options?
-*
- CHOPT = ' '
- LBLANK = INDEX(CHPATH(1:LPATH),' ')
- IF(LBLANK.NE.0) THEN
- CHOPT = CHPATH(LBLANK+1:LPATH)
- CHPATH = PATH(1:LBLANK-1)
- LPATH = LBLANK - 1
- ENDIF
- IF(INDEX(CHOPT,'C').EQ.0) CALL CUTOL(CHPATH)
-#endif
-#if defined(CERNLIB_MIPS)
- LPATH = LPATH + 1
- CHPATH(LPATH:LPATH) = CHAR(0)
-#endif
-#if defined(CERNLIB_UNIX)
- IRC = CHDIRF(CHPATH(1:LPATH))
-#endif
-#if defined(CERNLIB_VAXVMS)
- IRC = SETDEF(CHPATH(1:LPATH))
-#endif
-#if defined(CERNLIB_VAXVMS)||defined(CERNLIB_UNIX)||defined(CERNLIB_IBMMVS)
- IF(IRC.EQ.0) THEN
- CALL CZPUTA('2Remote directory changed to '//CHPATH(1:LPATH),
- + IRC)
- ELSE
- CALL CZPUTA('2Error setting remote directory',IRC)
- IRC = 1
- ENDIF
- RETURN
-#endif
-
- ENTRY SZPWD(IRC)
-#if defined(CERNLIB_IBMMVS)
- CALL XZRPRE(CHPATH,LPATH)
-#endif
-#if defined(CERNLIB_IBMVM)
- IF(NENTRY.EQ.0) THEN
- CALL CFILL(' ',CHPATH,1,80)
- ISTAT = FMUSER(CHUSER)
- CHPATH = CHUSER
- LPATH = LENOCC(CHPATH)
- CHPATH(LPATH+2:LPATH+4) = '191'
- LPATH = LPATH + 4
- ENDIF
-#endif
-#if defined(CERNLIB_UNIX)
- CALL GETWDF(CHPATH)
- LPATH = IS(1)
-#endif
-#if defined(CERNLIB_VAXVMS)
- CHPATH = ' '
- CALL GETDEF(CHPATH)
- LPATH = LENOCC(CHPATH)
-#endif
- CALL CZPUTA('2Current working directory is '//CHPATH(1:LPATH),IRC)
- END
diff --git a/src/packlib/cspack/sz/szclos.F b/src/packlib/cspack/sz/szclos.F
deleted file mode 100644
index 033d3d7..0000000
--- a/src/packlib/cspack/sz/szclos.F
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: szclos.F,v 1.1.1.1 1996/03/08 15:44:27 mclareni Exp $
-*
-* $Log: szclos.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:27 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE SZCLOS(LUN,CHOPT,IRC)
-#include "cspack/czopts.inc"
- IRC = 0
- IF(IOPTD.NE.0) THEN
- CLOSE(LUN,STATUS='DELETE',ERR=99)
- ELSE
- CLOSE(LUN,STATUS = 'KEEP',ERR=99)
- ENDIF
- RETURN
-99 IRC = 1
- END
diff --git a/src/packlib/cspack/sz/szinqr.F b/src/packlib/cspack/sz/szinqr.F
deleted file mode 100644
index df218ce..0000000
--- a/src/packlib/cspack/sz/szinqr.F
+++ /dev/null
@@ -1,36 +0,0 @@
-*
-* $Id: szinqr.F,v 1.1.1.1 1996/03/08 15:44:27 mclareni Exp $
-*
-* $Log: szinqr.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:27 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE SZINQR(LUN,FNAME,IEXIST,LRECL,IRC)
- CHARACTER*(*) FNAME
- LOGICAL EXIST
-*
-* Check if file exists
-*
- LF = LENOCC(FNAME)
- IEXIST = 0
- IRC = 0
-#if defined(CERNLIB_IBMVM)
- CALL CTRANS('.',' ',FNAME,1,LF)
-#endif
-#if defined(CERNLIB_IBM)
- INQUIRE(FILE='/'//FNAME(1:LF),EXIST=EXIST)
-#endif
-#if !defined(CERNLIB_IBM)
- INQUIRE(FILE=FNAME(1:LF),EXIST=EXIST)
-#endif
- IF(EXIST) THEN
- IEXIST = 1
- ELSE
- IRC = 4
- ENDIF
-
- END
-*
-
diff --git a/src/packlib/cspack/sz/szls.F b/src/packlib/cspack/sz/szls.F
deleted file mode 100644
index 610cde8..0000000
--- a/src/packlib/cspack/sz/szls.F
+++ /dev/null
@@ -1,211 +0,0 @@
-*
-* $Id: szls.F,v 1.1.1.1 1996/03/08 15:44:27 mclareni Exp $
-*
-* $Log: szls.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:27 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE SZLS(CHPATT,CHOPT,IRC)
- CHARACTER*(*) CHPATT
- CHARACTER*255 CHLIST,CHLOG,CHERR
- CHARACTER*255 CHFILE,CHDEF
- CHARACTER*255 COMM
- CHARACTER*8 CHRAND
- CHARACTER*2 CHOPTT
- INTEGER SYSTEMF
-#include "cspack/czunit.inc"
-#if defined(CERNLIB_IBMMVS)
- PARAMETER (MAXDSN=10)
- CHARACTER*80 DSN(MAXDSN)
-#endif
-#include "cspack/czhome.inc"
-#include "cspack/czsock.inc"
-#if defined(CERNLIB_UNIX)
- CHARACTER*8 LS
-#endif
-#if defined(CERNLIB_VAXVMS)
-#include "cspack/vmsinf.inc"
- CHARACTER*10 CBLOCKS
- INCLUDE '($RMSDEF)'
- INTEGER SYS$GETMSG
- CHARACTER*255 CHDIR
- EXTERNAL XZFINF
-#endif
-#include "cspack/czopts.inc"
-*
-* Return files matching pattern CHPATT
-*
- LPATT = LENOCC(CHPATT)
- IF(LPATT.EQ.0) THEN
-#if defined(CERNLIB_IBM)
- LPATT = 1
- CHLIST = '*'
-#endif
-#if defined(CERNLIB_UNIX)
- LPATT = 1
- CHLIST = ' '
-#endif
-#if defined(CERNLIB_IBM)||defined(CERNLIB_UNIX)
- ELSE
- CHLIST = CHPATT(1:LPATT)
-#endif
-#if defined(CERNLIB_VAXVMS)
- LPATT = 3
- CHPATT = '*.*'
- ELSE
- IF((CHPATT(LPATT:LPATT).EQ.':').OR.
- + (CHPATT(LPATT:LPATT).EQ.'>').OR.
- + (CHPATT(LPATT:LPATT).EQ.']')) THEN
- CHPATT(LPATT+1:LPATT+3) = '*.*'
- LPATT = LPATT + 3
- ENDIF
- IF(INDEX(CHPATT(1:LPATT),'.').EQ.0) THEN
- CHPATT(LPATT+1:LPATT+2) = '.*'
- LPATT = LPATT + 2
- ENDIF
-#endif
- ENDIF
- NERR = 0
- NFOUND = 0
- ICONT = 0
- CHOPTT = ' '
- COMM = ' '
- IF(IOPTL.NE.0) CHOPTT = '-l'
- IF(IOPTD.NE.0) CHOPTT = '-d'
-#if defined(CERNLIB_UNIX)
- CALL CZRAND(CHRAND)
- CHLOG = CHHOME(1:LHOME)//'/'//CHRAND//'zftp.tmp'
- CHERR = CHHOME(1:LHOME)//'/'//CHRAND//'zftp.err'
- LLOG = LENOCC(CHLOG)
- LERR = LLOG
- WRITE(COMM,9001) CHOPTT,CHLIST(1:LPATT),
- + CHLOG(1:LLOG),CHERR(1:LERR)
- 9001 FORMAT('ls ',A,' ',A,' >',A,' 2>',A)
- IC = SYSTEMF(COMM)
- OPEN(LUNXZI,FILE=CHLOG(1:LLOG),FORM='FORMATTED',
- + STATUS='OLD')
-10 CONTINUE
- READ(LUNXZI,'(A)',END=98) CHFILE
- CALL CZPUTA('2'//CHFILE(1:LENOCC(CHFILE)),IRC)
- NFOUND = NFOUND + 1
- GOTO 10
-#endif
-#if (defined(CERNLIB_UNIX))&&(!defined(CERNLIB_APOLLO))
-98 CLOSE(LUNXZI,STATUS='DELETE')
-#endif
-#if (defined(CERNLIB_UNIX))&&(defined(CERNLIB_APOLLO))
-98 CLOSE(LUNXZI)
-#endif
-#if defined(CERNLIB_UNIX)
- IF(NFOUND.EQ.0) THEN
- IRC = 1
- OPEN(LUNXZI,FILE=CHERR(1:LERR),FORM='FORMATTED',
- + STATUS='OLD')
-11 CONTINUE
- READ(LUNXZI,'(A)',END=97) CHFILE
- NERR = NERR + 1
- CALL CZPUTA('2'//CHFILE(1:LENOCC(CHFILE)),IRC)
- GOTO 11
-#endif
-#if (defined(CERNLIB_UNIX))&&(!defined(CERNLIB_APOLLO))
-97 CLOSE(LUNXZI,STATUS='DELETE')
-#endif
-#if (defined(CERNLIB_UNIX))&&(defined(CERNLIB_APOLLO))
-97 CLOSE(LUNXZI)
-#endif
-#if defined(CERNLIB_UNIX)
- IF(NERR.EQ.0) IRC = 0
- ELSE
-*
-* Remove error file
-*
- IC = UNLINKF(CHERR(1:LERR))
- ENDIF
-#endif
-#if defined(CERNLIB_VAXVMS)
-10 CONTINUE
- CHFILE = ' '
- CHDEF = ' '
- CALL GETDEF(CHDEF)
- LDEF = LENOCC(CHDEF)
- IF ((LDEF.NE.0) .AND.
- + (INDEX(CHPATT(1:LPATT),':').EQ.0).AND.
- + (INDEX(CHPATT(1:LPATT),'>').EQ.0).AND.
- + (INDEX(CHPATT(1:LPATT),'-').EQ.0)) THEN
- ISTAT = LIB$FIND_FILE(CHDEF(1:LDEF)//
- + CHPATT(1:LPATT),CHFILE,ICONT)
- ELSE
- ISTAT = LIB$FIND_FILE(CHPATT(1:LPATT),CHFILE,ICONT)
- ENDIF
-*
-* Check for RMS$_DNF - directory not found
-* RMS$_FNF - file not found
-* RMS$_NMF - no more files
-*
- IF(ISTAT.EQ.RMS$_NMF) THEN
- ISTAT = LIB$FIND_FILE_END(ICONT)
- GOTO 99
- ENDIF
-
- IF(.NOT.ISTAT) THEN
- IRC = SYS$GETMSG(%VAL(ISTAT),LFILE,CHFILE,,)
- CALL CZPUTA('2'//CHFILE(1:LFILE),IRC)
- IRC = ISTAT
- ISTAT = LIB$FIND_FILE_END(ICONT)
- GOTO 99
- ELSE
-*
-* Get recfm, nblocks, creation date, if IOPTL
-*
- LF = LENOCC(CHFILE)
- IF(IOPTL.NE.0) THEN
- OPEN(99,FILE=CHFILE(1:LF),STATUS='OLD',READONLY,
- + IOSTAT=IRC,USEROPEN=XZFINF)
- ISTART = INDEXB(CHFILE(1:LF),']')+1
- IF(NFOUND.EQ.0) THEN
- CALL CZPUTA('2'//'Directory: '//CHFILE(1:ISTART-1),IRC)
- CALL CZPUTA('2',IRC)
- ENDIF
- WRITE(CBLOCKS,'(I10)') IBLK
- CALL CZPUTA('2'//CHFILE(ISTART:LF)//' '//CBLOCKS//' '//
- + CREDAT(1:17)//' '//
- + CHUIC(1:LENOCC(CHUIC))//' '//CHPROT,IRC)
- ELSE
- CALL CZPUTA('2'//CHFILE(1:LF),IRC)
- ENDIF
- NFOUND = NFOUND + 1
- GOTO 10
- ENDIF
-
-#endif
-#if defined(CERNLIB_IBMMVS)
- CALL XZMVSD(CHPATT,CHLIST,LLIST,ICUT,IRC)
-* added Thomas Schwab 6/12/91
-*-----------------------------------
- LPATT = LLIST
-
- IFLAG = 0
- IFILL = 0
-1 CONTINUE
- CALL XZLCAT(CHLIST(2:LPATT),DSN,MAXDSN,IFILL,IFLAG)
- DO 2 I=1,MIN(MAXDSN,IFILL)
- CALL CZPUTA('2'//DSN(I)((ICUT):LENOCC(DSN(I))),IRC)
-2 CONTINUE
- IF(IFLAG.NE.0) GOTO 1
-#endif
-#if defined(CERNLIB_IBMVM)
- CALL CTRANS('.',' ',CHPATT,1,LPATT)
- IF(IOPTL.EQ.0) THEN
- CALL VMCMS('LISTFILE '//CHPATT(1:LPATT)//'(STACK',IRC)
- ELSE
- CALL VMCMS('LISTFILE '//CHPATT(1:LPATT)//'(STACK L',IRC)
- ENDIF
- CALL VMCMS('SENTRIES',NFOUND)
- DO 10 I=1,NFOUND
- CALL VMRTRM(CHFILE,LFILE)
- CALL CZPUTA('2'//CHFILE(1:LENOCC(CHFILE)),IRC)
-10 CONTINUE
-#endif
-99 END
diff --git a/src/packlib/cspack/sz/szmv.F b/src/packlib/cspack/sz/szmv.F
deleted file mode 100644
index ee71078..0000000
--- a/src/packlib/cspack/sz/szmv.F
+++ /dev/null
@@ -1,88 +0,0 @@
-*
-* $Id: szmv.F,v 1.1.1.1 1996/03/08 15:44:27 mclareni Exp $
-*
-* $Log: szmv.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:27 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE SZMV(LOCAL,REMOTE,CHOPT,IRC)
- CHARACTER*(*) LOCAL,REMOTE
- CHARACTER*255 CHSRC,CHDST
-#include "cspack/czunit.inc"
-#if defined(CERNLIB_VAXVMS)
- CHARACTER*255 CHMESS
-#endif
-#if defined(CERNLIB_UNIX)
- CHARACTER*255 CHCOMM,CHLOG,CHERR
- INTEGER SYSTEMF
-#include "cspack/czhome.inc"
-#endif
-#include "cspack/czopts.inc"
-
- LSRC = LENOCC(LOCAL)
- LDST = LENOCC(REMOTE)
- CHSRC = LOCAL(1:LSRC)
- CHDST = REMOTE(1:LDST)
-#if defined(CERNLIB_IBMVM)
- CALL CTRANS('.',' ',CHSRC,1,LSRC)
- CALL CTRANS('.',' ',CHDST,1,LDST)
- CALL VMCMS('RENAME '//CHSRC(1:LSRC)//' '//CHDST(1:LDST),IRC)
-#endif
-#if defined(CERNLIB_VAXVMS)
- ISTAT = LIB$RENAME_FILE(CHSRC(1:LSRC),CHDST(1:LDST),,,,,,,,,,)
- IF(.NOT.ISTAT) THEN
- IC = SYS$GETMSG(%VAL(ISTAT),LMESS,CHMESS,,)
- CALL CZPUTA('2'//CHMESS(1:LMESS),IRC)
- IRC = ISTAT
- ELSE
- IRC = 0
- ENDIF
-#endif
-#if defined(CERNLIB_UNIX)
- IF(IOPTC.EQ.0) THEN
- CALL CUTOL(CHSRC(1:LSRC))
- CALL CUTOL(CHDST(1:LDST))
- ENDIF
- CHLOG = CHHOME(1:LHOME)//'/zftp.tmp'
- CHERR = CHHOME(1:LHOME)//'/zftp.err'
- LLOG = LENOCC(CHLOG)
- LERR = LLOG
- WRITE(CHCOMM,9001) CHSRC(1:LSRC),CHDST(1:LDST),
- + CHLOG(1:LLOG),CHERR(1:LERR)
- 9001 FORMAT('mv ',A,' ',A,' >',A,' 2>',A)
- IC = SYSTEMF(CHCOMM)
- OPEN(LUNXZI,FILE=CHLOG(1:LLOG),FORM='FORMATTED',
- + STATUS='OLD')
- 10 CONTINUE
- READ(LUNXZI,'(A)',END=98) CHCOMM
- CALL CZPUTA('2'//CHCOMM(1:LENOCC(CHCOMM)),IRC)
- GOTO 10
-#endif
-#if (defined(CERNLIB_UNIX))&&(!defined(CERNLIB_APOLLO))
- 98 CLOSE(LUNXZI,STATUS='DELETE')
-#endif
-#if (defined(CERNLIB_UNIX))&&(defined(CERNLIB_APOLLO))
- 98 CLOSE(LUNXZI)
-#endif
-#if defined(CERNLIB_UNIX)
- NERR = 0
- OPEN(LUNXZI,FILE=CHERR(1:LERR),FORM='FORMATTED',
- + STATUS='OLD')
- 11 CONTINUE
- READ(LUNXZI,'(A)',END=97) CHCOMM
- NERR = NERR + 1
- CALL CZPUTA('2'//CHCOMM(1:LENOCC(CHCOMM)),IRC)
- GOTO 11
- 97 CONTINUE
- IRC = NERR
-#endif
-#if (defined(CERNLIB_UNIX))&&(!defined(CERNLIB_APOLLO))
- CLOSE(LUNXZI,STATUS='DELETE')
-#endif
-#if (defined(CERNLIB_UNIX))&&(defined(CERNLIB_APOLLO))
- CLOSE(LUNXZI)
-#endif
-
- END
diff --git a/src/packlib/cspack/sz/szopen.F b/src/packlib/cspack/sz/szopen.F
deleted file mode 100644
index 390fd22..0000000
--- a/src/packlib/cspack/sz/szopen.F
+++ /dev/null
@@ -1,352 +0,0 @@
-*
-* $Id: szopen.F,v 1.1.1.1 1996/03/08 15:44:27 mclareni Exp $
-*
-* $Log: szopen.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:27 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE SZOPEN(LUN,FILEN,LRECL,CHOPT,IRC)
- CHARACTER*(*) FILEN
- CHARACTER*80 FNAME,CHNAME
- CHARACTER*80 MVSDSN
- CHARACTER*12 CHFORM
- CHARACTER*8 CHSTAT,CHREC,CHTYPE
- CHARACTER*80 FILEDEF
- CHARACTER*1 MODE
-#include "cspack/czsock.inc"
-*
-* JBYTES: conversion factor for open statement
-* RECL = lrecl / jbytes
-*
-* On most machines, the record length is specified in bytes
-* except VAX: bytes for formatted files, 4-byte words otherwise
-* SGI: 4-byte words
-* DECS: 4-byte words
-*
-#if defined(CERNLIB_SGI)||defined(CERNLIB_DECS)
- PARAMETER (JBYTES=4)
-#endif
-#if (!defined(CERNLIB_SGI))&&(!defined(CERNLIB_DECS))
- PARAMETER (JBYTES=1)
-#endif
-#if defined(CERNLIB_IBM)
- CHARACTER*10 CHACTN
-#endif
-#if defined(CERNLIB_IBMMVS)
- CHARACTER*3 CHRECFM
- LOGICAL OPN,EXS
-#endif
-#if defined(CERNLIB_IBMVM)
- CHARACTER*20 CHGIME
- CHARACTER*80 CHLINE
-#endif
- LOGICAL IEXIST
-#include "cspack/quest.inc"
-*
-* Open file on unit LUN.
-* CHOPT: C - respect case
-* D - D/A file, LRECL must be specified if N is also given
-* I - open for input
-* O - open for output
-*--> L - reLative organisation (VAX only) <-- Not yet implemented!
-* R - RZ file
-* P - PAM file format
-* F - formatted file (default=unformatted)
-* N - new file
-* V - variable length records (do not specify RECFM=variable on VAX)
-*
-* Return codes: 28 - file already exists & New specified
-* 1 - open failed - IOSTAT in IQUEST(1)
-*
-#include "cspack/czopts.inc"
- IF((IOPTI.EQ.0).AND.(IOPTO.EQ.0)) IOPTI=1
- IRC = 0
- LF = LENOCC(FILEN)
- FNAME = FILEN(1:LF)
-#if defined(CERNLIB_IBMVM)
-*
-* Crack <user.addr>fn.ft
-*
- IF((INDEX(FNAME(1:LF),'<').NE.0).OR.
- + (INDEX(FNAME(1:LF),'[').NE.0)) THEN
- CALL CTRANS('[','<',FNAME,1,LF)
- CALL CTRANS(']','>',FNAME,1,LF)
- ISTART = INDEX(FNAME(1:LF),'<') + 1
- IEND = INDEX(FNAME(1:LF),'>') - 1
- ICOL = INDEX(FNAME(1:LF),':')
-*
-* SFS?
-*
- IF(ICOL.EQ.0) THEN
- CHGIME = FNAME(ISTART:IEND)
- IDOT = INDEX(CHGIME,'.')
- IF(IDOT.NE.0) CHGIME(IDOT:IDOT) = ' '
- LCHG = IEND - ISTART + 1
- ELSE
- CHGIME = FNAME(1:ICOL) // FNAME(ISTART:IEND)
- LCHG = IEND - ISTART + 1 + ICOL
- ENDIF
- CALL VMCMS(CHGIME(1:LCHG)//' (QUIET NONOTICE STACK)',IRC)
-
- IF(IRC.GT.4) RETURN
-
- CALL VMRTRM(CHLINE,LENGTH)
- MODE = CHLINE(1:1)
- FNAME = FILEN(IEND+2:LF) // ' ' // MODE
- LF = LF + 2
- ENDIF
-
- IF(INDEX(FNAME(1:LF),'/').EQ.0) THEN
- FNAME = '/'//FILEN(1:LF)
- LF = LF + 1
- ENDIF
-
- DO 1 I=1,LF
- 1 IF(FNAME(I:I).EQ.'.') FNAME(I:I) = ' '
-*
-* If file exists, find full name and hence file mode
-*
- INQUIRE(FILE=FNAME(1:LF),EXIST=IEXIST,NAME=CHNAME)
- LMODE = LENOCC(CHNAME)
- IF(IEXIST) MODE = CHNAME(LMODE:LMODE)
-
-#endif
-#if defined(CERNLIB_UNIX)
- IF(IOPTC.EQ.0) CALL CUTOL(FNAME)
-#endif
-#if defined(CERNLIB_IBM)
- CHACTN = 'READWRITE'
- IF(IOPTI.NE.0) CHACTN = 'READ'
- IF(IOPTO.NE.0) CHACTN = 'WRITE'
-#endif
-#if defined(CERNLIB_IBMMVS)
- CALL XZMVSD(FILEN(1:LF),MVSDSN,LF,ICUT,IRC)
- FNAME = MVSDSN
- FNAME(1:1) = '/'
-#endif
- CHSTAT = 'UNKNOWN'
- IF(IOPTN.NE.0) THEN
- CHSTAT = 'NEW'
- IOPTO = 1
-#if !defined(CERNLIB_VAXVMS)
- INQUIRE(FILE=FNAME(1:LF),EXIST=IEXIST)
- IF(IEXIST) THEN
- IRC = 28
- RETURN
- ENDIF
-#endif
- ENDIF
- IF(IOPTI.NE.0) CHSTAT = 'OLD'
-#if defined(CERNLIB_APOLLO)
- IF(IOPTO.EQ.0) CHSTAT = 'READONLY'
-#endif
- CHFORM = 'UNFORMATTED'
-*
-* LRECL on VAX is in words for unformatted files, but bytes otherwise
-*
- NBYTES = 4
- IF(IOPTF.NE.0) THEN
- CHFORM = 'FORMATTED'
- NBYTES = 1
- ENDIF
-
- CHREC = 'FIXED'
- IF(IOPTP.NE.0) IOPTV = 1
- IF(IOPTV.NE.0) CHREC = 'VARIABLE'
- LCHREC = LENOCC(CHREC)
- IF(IOPTD.EQ.0) THEN
-#if defined(CERNLIB_IBMMVS)
- ITRK = 10
-
- ISECOND = 10
-
- IDIR = 0
- IF ( INDEX(FNAME,'(') .NE. 0 ) IDIR = 28
-
- CHRECFM = 'FB'
- IF(IOPTP.NE.0) CHRECFM = 'VBS'
- IF(IOPTV.NE.0) CHRECFM = 'VB'
-
- IF(IOPTP.NE.0) LRECL = -1
-
- IBLKSIZE = 4000
- IF(IOPTP.NE.0) IBLKSIZE = 6232
-*------------------------------ check file existence
- INQUIRE ( FILE='/'//FNAME(1:LF), IOSTAT=ISTAT
- +, EXIST=EXS, OPENED=OPN, NUMBER=LUNOLD )
- IF (IRC .NE. 0) GO TO 110
-
- IF((.NOT. EXS ).AND.(IOPTI.NE.0)) GOTO 150
-*------------------------- ---- input dataset exists not
-
- IF ( .NOT. EXS ) THEN
-*------------------------------ define dataset parameters
- CALL FILEINF ( ISTAT,'DEVICE' , '33XX' , 'TRK' , ITRK ,
- + 'SECOND' , ISECOND , 'DIR' , IDIR ,
- + 'RECFM' , CHRECFM , 'LRECL' , LRECL ,
- + 'BLKSIZE', IBLKSIZE )
- IF (ISTAT .NE. 0) GO TO 120
-
- ELSE
-*------------------------------ dataset is an old one
- IF (OPN) THEN
-*------------------------------ dataset is open
- CLOSE(UNIT=LUNOLD,STATUS='KEEP',IOSTAT=ISTAT)
- IF (ISTAT .NE. 0) GO TO 140
- ENDIF
-
- ENDIF
-
- IF (IOPTD .EQ. 0) THEN
-*------------------------------ open dataset
- OPEN(LUN,FILE='/'//FNAME(1:LF),FORM=CHFORM,STATUS=CHSTAT,
- + ACTION=CHACTN,IOSTAT=ISTAT)
- IF (ISTAT .NE. 0) GO TO 130
-
- ELSE
-*------------------------------ open dataset, accsess = direct
- OPEN(LUN,FILE='/'//FNAME(1:LF),FORM=CHFORM,STATUS=CHSTAT,
- + RECL=LRECL,ACCESS='DIRECT',
- + ACTION=CHACTN,IOSTAT=ISTAT)
- IF (ISTAT .NE. 0) GO TO 130
-
- ENDIF
-
- RETURN
-
-*------------------------------ error handling
- 110 WRITE(6,*) 'SZOPEN - INQUIRE ERROR - IOSTAT = ',ISTAT
- GO TO 99
-
- 120 WRITE(6,*) 'SZOPEN - FILEINF ERROR - ISTAT = ',ISTAT
- GO TO 99
-
- 130 WRITE(6,*) 'SZOPEN - OPEN ERROR - IOSTAT = ',ISTAT
- GO TO 99
-
- 140 WRITE(6,*) 'SZOPEN - CLOSE ERROR - IOSTAT = ',ISTAT
- GO TO 99
-
- 150 WRITE(6,*) 'SZOPEN - INPUT DATASET NOT ON DISK '
- GO TO 99
-#endif
-#if defined(CERNLIB_IBMVM)
- IF(IOPTP.NE.0) THEN
-*
-* PAM file - issue FILEDEF then open by UNIT
-* (Open by name uses different style DDNAME)
-*
- WRITE(FILEDEF,8001) LUN,FNAME(1:LF)
- 8001 FORMAT('FILEDEF ',I3,' DISK ',A,
- + ' (RECFM VBS LRECL 32756 BLOCK 800 PERM)')
- LENF = LENOCC(FILEDEF)
- CALL CTRANS('.',' ',FILEDEF,1,LENF)
- CALL CTRANS('/',' ',FILEDEF,1,LENF)
- CALL VMCMS(FILEDEF(1:LENF),IRC)
- CALL VMCMS('Q FILEDEF',IRC)
- OPEN(LUN,FORM=CHFORM,STATUS=CHSTAT, ERR=99,IOSTAT=ISTAT)
- RETURN
- ELSE
- LENF = LENOCC(FILEDEF)
- CALL CTRANS('.',' ',FILEDEF,1,LENF)
-*
-* Only call FILEINF for new files...
-*
- IF(IOPTN.NE.0) THEN
- CALL FILEINF(IRC,'RECFM','F','LRECL',LRECL)
- ELSE
- IF(MODE.EQ.'4') CALL FILEINF(IRC,'RECFM','U')
- ENDIF
- ENDIF
-#endif
-#if defined(CERNLIB_IBMVM)
- OPEN(LUN,FILE=FNAME(1:LF),FORM=CHFORM,STATUS=CHSTAT,
- + ACTION=CHACTN,ERR=99,IOSTAT=ISTAT)
-#endif
-#if (!defined(CERNLIB_VAXVMS))&&(!defined(CERNLIB_IBM))
- OPEN(LUN,FILE=FNAME(1:LF),FORM=CHFORM,STATUS=CHSTAT,
- + ERR=99,IOSTAT=ISTAT)
-#endif
-#if defined(CERNLIB_VAXVMS)
- INQUIRE(FILE=FNAME(1:LF),EXIST=IEXIST,RECORDTYPE=CHTYPE)
- IF(IEXIST.AND.CHTYPE(1:8).EQ.'VARIABLE') IOPTV = 1
- IF(IOPTO.EQ.0) THEN
-*
-* Add READONLY so that files in other people's directories
-* can be accessed...
-*
- IF((IOPTN.EQ.0).AND.(IOPTV.EQ.0)) THEN
- OPEN(LUN,FILE=FNAME(1:LF),FORM=CHFORM,STATUS=CHSTAT,
- + BUFFERCOUNT=127,RECORDTYPE=CHREC(1:LCHREC),
- + RECL=LRECL/NBYTES,IOSTAT=ISTAT,ERR=99,READONLY)
- ELSEIF((IOPTN.NE.0).AND.(IOPTV.EQ.0)) THEN
- OPEN(LUN,FILE=FNAME(1:LF),FORM=CHFORM,STATUS=CHSTAT,
- + BUFFERCOUNT=127,RECORDTYPE=CHREC(1:LCHREC), RECL=
- + LRECL/NBYTES,IOSTAT=ISTAT,ERR=99,READONLY)
- ELSE
- OPEN(LUN,FILE=FNAME(1:LF),FORM=CHFORM,STATUS=CHSTAT,
- + BUFFERCOUNT=127,IOSTAT=ISTAT,ERR=99,READONLY)
- ENDIF
- ELSE
- IF((IOPTN.EQ.0).AND.(IOPTV.EQ.0)) THEN
- OPEN(LUN,FILE=FNAME(1:LF),FORM=CHFORM,STATUS=CHSTAT,
- + BUFFERCOUNT=127,RECORDTYPE=CHREC(1:LCHREC), RECL=
- + LRECL/NBYTES,IOSTAT=ISTAT, ERR=99)
- ELSEIF((IOPTN.NE.0).AND.(IOPTV.EQ.0)) THEN
- OPEN(LUN,FILE=FNAME(1:LF),FORM=CHFORM,STATUS=CHSTAT,
- + BUFFERCOUNT=127,RECORDTYPE=CHREC(1:LCHREC), RECL=
- + LRECL/NBYTES,IOSTAT=ISTAT, ERR=99)
- ELSE
- OPEN(LUN,FILE=FNAME(1:LF),FORM=CHFORM,STATUS=CHSTAT,
- + BUFFERCOUNT=127,IOSTAT=ISTAT, ERR=99)
-* + SHARED,BUFFERCOUNT=127, IOSTAT=ISTAT, ERR=99)
- ENDIF
- ENDIF
-#endif
-*
-* Direct-access files...
-*
- ELSE
-#if defined(CERNLIB_IBMVM)
- CALL FILEINF(ISTAT,'MAXREC',2)
- IF(ISTAT.NE.0)GO TO 99
- OPEN(UNIT=LUN,FILE=FNAME(1:LF),FORM='UNFORMATTED', RECL=LRECL,
- + ACTION=CHACTN,ACCESS='DIRECT',STATUS=CHSTAT,IOSTAT=ISTAT)
- IF(ISTAT.NE.0)GO TO 99
- CLOSE(LUN)
- CALL FILEINF(ISTAT,'MAXREC',16777215)
- IF(ISTAT.NE.0)GO TO 99
- CHSTAT = 'OLD'
-#endif
-#if !defined(CERNLIB_VAXVMS)
- OPEN(LUN,FILE=FNAME(1:LF),FORM=CHFORM,STATUS=CHSTAT,ERR=99,
- + RECL=LRECL/JBYTES,
-#endif
-#if defined(CERNLIB_IBMVM)
- + ACTION=CHACTN,
-#endif
-#if !defined(CERNLIB_VAXVMS)
- + ACCESS='DIRECT',IOSTAT=ISTAT)
-#endif
-#if defined(CERNLIB_VAXVMS)
- IF(IOPTO.EQ.0) THEN
- OPEN(LUN,FILE=FNAME(1:LF),FORM=CHFORM,STATUS=CHSTAT,ERR=99,
- + SHARED,READONLY,
- + RECL=LRECL/NBYTES,
- + ACCESS='DIRECT',IOSTAT=ISTAT)
- ELSE
- OPEN(LUN,FILE=FNAME(1:LF),FORM=CHFORM,STATUS=CHSTAT,ERR=99,
- + SHARED,
- + RECL=LRECL/NBYTES,
- + ACCESS='DIRECT',IOSTAT=ISTAT)
- ENDIF
-#endif
- ENDIF
- RETURN
- 99 IRC = 1
- IQUEST(1) = ISTAT
- IF(LUNCZ.GE.0)
- + WRITE(LUNCZ,*) 'SZOPEN. IOSTAT from OPEN = ',ISTAT
- END
diff --git a/src/packlib/cspack/sz/szpiaf.F b/src/packlib/cspack/sz/szpiaf.F
deleted file mode 100644
index 3515fab..0000000
--- a/src/packlib/cspack/sz/szpiaf.F
+++ /dev/null
@@ -1,15 +0,0 @@
-*
-* $Id: szpiaf.F,v 1.1.1.1 1996/03/08 15:44:27 mclareni Exp $
-*
-* $Log: szpiaf.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:27 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE SZPIAF(CHMAIL)
- CHARACTER*(*) CHMAIL
-
- CALL CZPUTA('3Error - service not available!',IRC)
-
- END
diff --git a/src/packlib/cspack/sz/szread.F b/src/packlib/cspack/sz/szread.F
deleted file mode 100644
index 3c77fec..0000000
--- a/src/packlib/cspack/sz/szread.F
+++ /dev/null
@@ -1,72 +0,0 @@
-*
-* $Id: szread.F,v 1.1.1.1 1996/03/08 15:44:27 mclareni Exp $
-*
-* $Log: szread.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:27 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE SZREAD(LUN,IBUFF,NREC,NWANT,NGOT,CHOPT,IRC)
-#if defined(CERNLIB_APOLLO)
- PARAMETER(IOSEOF=84148232)
-#endif
-#if defined(CERNLIB_CRAY)
- PARAMETER(IOSEOF=5)
-#endif
-#if defined(CERNLIB_HPUX)
- PARAMETER(IOSEOF=922)
-#endif
-#if defined(CERNLIB_IBMRT)
- PARAMETER(IOSEOF=10)
-#endif
-#if defined(CERNLIB_SGI)
- PARAMETER(IOSEOF=27)
-#endif
-#if (defined(CERNLIB_VAXVMS))&&(!defined(CERNLIB_QMALPH))
- PARAMETER(IOSEOF=36)
-#endif
-#if defined(CERNLIB_SUN)||defined(CERNLIB_IBMAIX)||defined(CERNLIB_DECS)||defined(CERNLIB_QMALPH)
- PARAMETER(IOSEOF=-1)
-#endif
-#include "cspack/zmach.inc"
-#include "cspack/czsock.inc"
-#include "cspack/hcmail.inc"
- INTEGER IBUFF(NWANT/IQCHAW)
-#include "cspack/czopts.inc"
-
- IRC = 0
- KERR = 0
- IF(NREC.EQ.0.AND.IOPTV.EQ.0) THEN
- READ(LUN,END=98,ERR=99,IOSTAT=KERR) IBUFF
- ELSEIF(IOPTV.NE.0) THEN
- NGOT = NWANT
- CALL XINB(LUN,IBUFF,NGOT)
- IF(NGOT.LT.0) THEN
- KERR = -NGOT
- GOTO 99
- ENDIF
- IF(NGOT.EQ.0) GOTO 98
- NWANT = NGOT*4
- WRITE(CHMAIL,9002) NGOT
- 9002 FORMAT('V',I10)
- CALL CZPUTA(CHMAIL,ISTAT)
- ELSE
- READ(LUN,REC=NREC,ERR=99,IOSTAT=KERR)IBUFF
-*
-* Standard defines EOF as negative IOSTAT
-* (unless another errors occurs simulataneously)
-*
- IF(KERR.LT.0) GOTO 98
- IF(KERR.GT.0) GOTO 99
- ENDIF
-
- RETURN
-
- 98 IRC = -1
- RETURN
- 99 IRC = 1
- IF(KERR.EQ.IOSEOF) GOTO 98
- IF(LUNCZ.NE.0) WRITE(LUNCZ,*) 'SZREAD. IOSTAT = ',KERR
-
- END
diff --git a/src/packlib/cspack/sz/szrewd.F b/src/packlib/cspack/sz/szrewd.F
deleted file mode 100644
index 2a3ae87..0000000
--- a/src/packlib/cspack/sz/szrewd.F
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: szrewd.F,v 1.1.1.1 1996/03/08 15:44:27 mclareni Exp $
-*
-* $Log: szrewd.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:27 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE SZREWD(LUN,IRC)
- IRC = 0
- REWIND(LUN,ERR=99)
- RETURN
-99 IRC = 1
- END
-
diff --git a/src/packlib/cspack/sz/szrite.F b/src/packlib/cspack/sz/szrite.F
deleted file mode 100644
index 4fde9a5..0000000
--- a/src/packlib/cspack/sz/szrite.F
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: szrite.F,v 1.1.1.1 1996/03/08 15:44:27 mclareni Exp $
-*
-* $Log: szrite.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:27 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE SZRITE(LUN,IBUFF,NREC,NWRIT,CHOPT,IRC)
-#include "cspack/zmach.inc"
-#include "cspack/czsock.inc"
- INTEGER IBUFF(NWRIT/IQCHAW)
-#include "cspack/czopts.inc"
- IRC = 0
-
- IF(NREC.EQ.0) THEN
- WRITE(LUN,ERR=99) IBUFF
- ELSEIF(IOPTV.NE.0) THEN
- NWORDS = NWRIT/IQCHAW
- WRITE(LUN,ERR=99,IOSTAT=IRC) NWORDS,(IBUFF(I),I=1,NWORDS)
- ELSE
- WRITE(UNIT=LUN,REC=NREC,ERR=99,IOSTAT=IRC)IBUFF
- ENDIF
-
- RETURN
-
-99 END
-
diff --git a/src/packlib/cspack/sz/szrm.F b/src/packlib/cspack/sz/szrm.F
deleted file mode 100644
index be15bdd..0000000
--- a/src/packlib/cspack/sz/szrm.F
+++ /dev/null
@@ -1,40 +0,0 @@
-*
-* $Id: szrm.F,v 1.1.1.1 1996/03/08 15:44:27 mclareni Exp $
-*
-* $Log: szrm.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:27 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE SZRM(FNAME,IRC)
- CHARACTER*(*) FNAME
- CHARACTER*255 CHFORM
- LOGICAL LOPEN,IEXIST
-*
-* Check if file exists
-*
- LF=LENOCC(FNAME)
- INQUIRE(FILE=FNAME(1:LF),EXIST=IEXIST,
- + FORM=CHFORM)
- IF(.NOT.IEXIST) GOTO 99
-*
-* Find a unit number which is free
-*
- DO 10 I=1,99
- INQUIRE(I,OPENED=LOPEN)
- IF(.NOT.LOPEN) GOTO 20
-10 CONTINUE
- IRC = 1
- RETURN
-20 IF(INDEX(CHFORM,'FORMATTED').EQ.0) THEN
- OPEN(I,FILE=FNAME,STATUS='OLD',ERR=99)
- ELSE
- OPEN(I,FILE=FNAME,STATUS='OLD',FORM=CHFORM,ERR=99)
- ENDIF
- CLOSE(I,STATUS='DELETE',ERR=99)
- IRC = 0
- RETURN
-99 IRC = 1
- END
-
diff --git a/src/packlib/cspack/sz/szvers.F b/src/packlib/cspack/sz/szvers.F
deleted file mode 100644
index 12cfb8d..0000000
--- a/src/packlib/cspack/sz/szvers.F
+++ /dev/null
@@ -1,38 +0,0 @@
-*
-* $Id: szvers.F,v 1.5 1996/04/12 07:40:03 cernlib Exp $
-*
-* $Log: szvers.F,v $
-* Revision 1.5 1996/04/12 07:40:03 cernlib
-* new handling of cspack title
-*
-* Revision 1.4 1996/03/29 11:33:53 jamie
-* qftitlch
-*
-* Revision 1.3 1996/03/29 10:59:27 jamie
-* print 'title' more like patchy
-*
-* Revision 1.2 1996/03/28 11:13:33 jamie
-* update idatqq/itimqq
-*
-* Revision 1.1.1.1 1996/03/08 15:44:26 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE SZVERS(IRC)
-#include "cspack/hcmail.inc"
-#include "cspack/czsock.inc"
- IDATQQ = 960329
- ITIMQQ = 1200
- IRC = 0
- CALL CFILL(' ',CHMAIL,1,80)
-#include "cspack/qftitlch.inc"
- CHMAIL =
- + CspackTitleFortranString
- CALL CZPUTA('2'//CHMAIL,ISTAT)
- WRITE(CHMAIL,'(A,I7,A,I5)') ' This version created on ',
- + IDATQQ,
- + ' at ',ITIMQQ
- CALL CZPUTA('2'//CHMAIL,ISTAT)
- END
-
diff --git a/src/packlib/cspack/tcpaw/Imakefile b/src/packlib/cspack/tcpaw/Imakefile
deleted file mode 100644
index 2a52b5c..0000000
--- a/src/packlib/cspack/tcpaw/Imakefile
+++ /dev/null
@@ -1,52 +0,0 @@
-
-SRCS_C= tcpaw.c
-
-#if defined(CERNLIB_UCX)
-SRCS_C := $(SRCS_C) getservbyname.c
-#endif
-
-#if defined(CERNLIB_WINNT)
-# define CERNLIB_TCPSOCK
-SRCS_C := $(SRCS_C) sleep.c
-#endif
-
-#if defined(CERNLIB_IBMVM)
-
- /* This is the default for IBMVM, so make shure you define TCPSOCK
- * remove this to activate the Pascal version. */
-#define CERNLIB_TCPSOCK
-#if !defined(CERNLIB_TCPSOCK)
-SRCS_F= tcpawibm.F
-SRCS_S= readne.s
-else
-SRCS_C := $(SRCS_C) sleep.c
-#endif
-#endif
-
-#if defined(CERNLIB_IBM) && !defined(CERNLIB_TCPSOCK)
-SRCS_F= tcpawibm.F
-#endif
-
-#if defined(CERNLIB_HPUX)
-/* Cancel the default -Aa ansi compilation */
-CCOPTIONS=+Z +DA1.1
-#endif
-
-#if defined(CERNLIB_SGI)
-CCOPTIONS+=-cckr
-#endif
-
-#if defined(CERNLIB_SOLARIS)
-CCOPTIONS+=-Xs
-#endif
-
-#ifdef CERNLIB_VAXVMS
-EXTRA_INCLUDES=-I[]
-DEFINES:= $(DEFINES) -DCOMPILE_NOPREFIX -DTGV
-CCOPTIONS:= $(CCOPTIONS) /stan\=vaxc/pref\=ansi
-#ifndef CERNLIB_QMALPH
-DEFINES:= $(DEFINES) -DDECC
-#endif
-#endif
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/cspack/tcpaw/getservbyname.c b/src/packlib/cspack/tcpaw/getservbyname.c
deleted file mode 100644
index dbb8856..0000000
--- a/src/packlib/cspack/tcpaw/getservbyname.c
+++ /dev/null
@@ -1,128 +0,0 @@
-/*
- * $Id: getservbyname.c,v 1.1.1.1 1996/03/08 15:44:28 mclareni Exp $
- *
- * $Log: getservbyname.c,v $
- * Revision 1.1.1.1 1996/03/08 15:44:28 mclareni
- * Cspack
- *
- */
-#include "cspack/pilot.h"
-#if defined(CERNLIB_UCX)
-
-/* R. Ball (University of Michigan) at the behest of */
-/* J. Shiers (CERN/CN) */
-/* Feb. 11, 1991 */
-/* Replace the non-supported UCX routine getservbyname. */
-/* Input is the pseudo-Unix file SERVFILE[], a copy of */
-/* /etc/services from a Unix machine supporting zftp/zserv. */
-/* alias names are neither searched nor recorded. */
-
-#include <stdio.h>
-#include <varargs.h>
-#include <netdb.h>
-#include <socket.h>
-#include <in.h>
-
-/* From netdb.h, the servent structure definition follows: */
-/* struct servent { */
-/* char *s_name; */
-/* char **s_aliases; */
-/* int s_port; */
-/* char *s_proto; */
-/* }; */
-
-struct servent *getservucxline ( char *name, char *proto);
-
-static char SERVFILE[] = "cern:[pro.exe]etc.services";
-static struct servent ucx_sp;
-static char comp_str[80], pro_nam[80];
-
-struct servent *
-getservbyname ( service, protocol )
-char *service, *protocol;
-{
- struct servent *p;
- p = getservucxline ( service, protocol );
- return (p);
-}
-
-struct servent *
-getservucxline ( service, protocol )
-char *service, *protocol;
-{
- FILE *inter;
- char string[80], c, *copc;
- int numser, max_string;
- char num_str[80];
- char *ipoint;
- int i, j, k;
-
-/* OPEN the file of services for read_only. Loop, reading the file */
-/* until end of file or the services match. */
- inter = fopen( SERVFILE, "r" );
- while ( (ipoint=fgets( string, 80, inter)) != NULL)
- {
- for (i=0; ((c=string[i])!='#') && (i<80) && (c!='\n'); i++)
- max_string=i;
- if (c!='#') max_string++;
- if (string[0] != '#')
- {
-
-/* First off, find the service name. Be cheap, ignore the aliases. */
- for (i=0; i<max_string; i++)
- {
- if ( ((c=string[i])!= ' ') && (c!='\t')) comp_str[i] = c;
- else
- {
- comp_str[i] = NULL;
- break;
- }
- }
- if (strcmp(service,comp_str) == 0)
- {
-
-/* Keep going as the service name matched. Get the socket number. */
- i++;
- for (j=i; j<max_string; j++)
- {
- if (((c=string[j]) != '\n') && (c != '/')) num_str[j-i] = c;
- else
- {
- num_str[j-i] = NULL;
- break;
- }
- }
- numser = htons((u_short)atoi(num_str));
-
-/* Get the protocol name. We may need to match it. */
- j++;
- for (k=j; k<=max_string; k++)
- {
- if ( ((c=string[k])!=' ') && (c!='\t') && (c!='\n'))
- pro_nam[k-j] = c;
- else
- {
- pro_nam[k-j] = NULL;
- break;
- }
- }
- if ((protocol == NULL) || (strcmp(protocol, pro_nam) == 0))
- {
-
-/* We have a successful match. Fill the structure values and break. */
- ucx_sp.s_port = numser;
- ucx_sp.s_name = comp_str;
- ucx_sp.s_proto = pro_nam;
-/* Ignore the aliases. */
- break;
- }
- }
- }
- }
-
-/* Clean up and exit. */
- fclose(inter);
- if (ipoint == NULL) return(NULL);
- else return(&ucx_sp);
-}
-#endif
diff --git a/src/packlib/cspack/tcpaw/readne.s b/src/packlib/cspack/tcpaw/readne.s
deleted file mode 100644
index a385105..0000000
--- a/src/packlib/cspack/tcpaw/readne.s
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: readne.s,v 1.1.1.1 1996/03/08 15:44:28 mclareni Exp $
-*
-* $Log: readne.s,v $
-* Revision 1.1.1.1 1996/03/08 15:44:28 mclareni
-* Cspack
-*
-*
-#if (defined(CERNLIB_IBMVM))&&(!defined(CERNLIB_TCPSOCK))
- PRINT NOGEN
-READNE CSECT
-*
-* Read a line with echo turned off. Based on VMRTRM
-*
- USING READNE,R15 ESTABLISH ADDRESSABILITY
- DS 0H ALIGN
- B READNEN BRANCH AROUND THE NAME
- DC AL1(7) LENGTH OF NAME
- DC C'READNE' DEFINE THE NAME
-READNEN SAVE (14,12) SAVE THE REGS
- LR R12,R15 SET UP THE BASE
- DROP R15 ADDRESSABILITY REESTABLISHED
- USING READNE,R12 ESTABLISH ADDRESSABILITY
- L R2,0(R1) POINTER TO CHAR STRING ADDRESS
- L R3,=F'30' FIX LENGTH OF CHAR VARIABLE (TCPAW is PASCAL)
- LA R6,LREAD DEFAULT LENGTH OF STRING READ
- TM 0(R1),X'80' IS THERE A SECOND ARG
- BO ENDARG2 BRANCH IF NO SECOND ARG
- L R6,4(R1) POINT R6 AT LENGTH ADDRESS
-* NOW DO THE READ
-ENDARG2 LINERD DATA=((R2),(R3)),CASE=MIXED,TYPE=INVISIBLE,WAIT=YES
-* ST R0,0(R6) SAVE THE LENGTH ACTUALLY READ
- RETURN (14,12) GO BACK TO THE FORTRAN
-*
-* DATA AREAS
-LREAD DS 1F DUMMY LENGTH READ
-BLANKR5 DC C' ',X'000000' BLANK CHAR OF ZERO LENGTH
-*
- REGEQU
- END
-#endif
diff --git a/src/packlib/cspack/tcpaw/sleep.c b/src/packlib/cspack/tcpaw/sleep.c
deleted file mode 100644
index 57d8563..0000000
--- a/src/packlib/cspack/tcpaw/sleep.c
+++ /dev/null
@@ -1,27 +0,0 @@
-/*
- * $Id: sleep.c,v 1.2 1997/09/02 08:46:20 mclareni Exp $
- *
- * $Log: sleep.c,v $
- * Revision 1.2 1997/09/02 08:46:20 mclareni
- * WINNT mods, mostly cpp defines
- *
- * Revision 1.1.1.1 1996/03/08 15:44:28 mclareni
- * Cspack
- *
- */
-#include "cspack/pilot.h"
-#if defined(CERNLIB_TCPSOCK) && defined(CERNLIB_IBMVM)
-# include <stdlib.h>
-# include <stdio.h>
-sleep(num)
-int num;
-{
- char buf[50];
- sprintf(buf, "CP SLEEP %d SEC", num);
- system(buf);
- return(0);
-}
-#elif defined(CERNLIB_WINNT)
-#include <windows.h>
- void sleep(int num){ Sleep(num*1000);}
-#endif
diff --git a/src/packlib/cspack/tcpaw/tcpaw.c b/src/packlib/cspack/tcpaw/tcpaw.c
deleted file mode 100644
index 579fc75..0000000
--- a/src/packlib/cspack/tcpaw/tcpaw.c
+++ /dev/null
@@ -1,3540 +0,0 @@
-/*
- * $Id: tcpaw.c,v 1.11 2006/12/07 13:26:48 mclareni Exp $
- *
- * $Log: tcpaw.c,v $
- * Revision 1.11 2006/12/07 13:26:48 mclareni
- * Corrections for MacOSX on Intel
- *
- * Revision 1.10 2006/09/15 09:35:12 mclareni
- * Submitted mods for gcc4/gfortran and MacOSX, corrected to work also on slc4 with gcc3.4 and 4.1
- *
- * Revision 1.9 2005/04/18 15:23:09 mclareni
- * Mods submitted by Kevin B. McCarty to fix insecure Cernlib uses of /tmp.
- *
- * Revision 1.8 2005/03/21 13:01:38 mclareni
- * Remove conflicting redefinitions of malloc, ioctl, etc. which fail with gcc 3.4.3.
- *
- * Revision 1.7 1999/09/15 16:19:46 mclareni
- * Remove index definition, most compilers have it now
- *
- * Revision 1.6 1998/02/19 15:05:40 gunter
- * Remove a NT mod in pure VMS code: _stat changed back to stat
- *
- * Revision 1.5 1997/10/23 13:26:19 mclareni
- * NT mods
- *
- * Revision 1.3 1997/09/02 08:46:21 mclareni
- * WINNT mods, mostly cpp defines
- *
- * Revision 1.2 1996/04/02 22:42:04 thakulin
- * Make rexec function definition match the Solaris headers.
- *
- * Revision 1.1.1.1 1996/03/08 15:44:27 mclareni
- * Cspack
- *
- */
-#include "cspack/pilot.h"
-#if !defined(CERNLIB_IBM)||defined(CERNLIB_TCPSOCK)
-/*N.B. Must define sequence TCPLOG if a log file is required, e.g.*/
-/*#define LOGFILE "disk$dd:-ben.socks-serv.log"*/ /* VMS */
-/*#define LOGFILE "/user/brun/ben/serv.log" */ /* Apollo */
-/*#define LOGFILE "/h0/psh/zs.log" */ /* OS9 */
-/*#define LOGFILE "/var/log/serv.log" */ /* example*/
-#if defined(CERNLIB_IBMMVS)
-#pragma nosequence
-#pragma options (ALIAS)
-#endif
-
-#if defined(CERNLIB__DOC)
-/* TCP/IP PACKAGE FOR REMOTE-PAW AND SIMILAR APPLICATIONS.
-
- Ben M. Segal / CERN-CN/SW
-
- ben at cernvax.cern.ch
-
- ------------------------------------------------------
- | Version of: Jun.08, 1997 (FOR CERN PROGRAM LIBRARY)|
- ------------------------------------------------------
-
-***** THIS VERSION: The Windows Socket implmetation has been introduced
- 08/06/97 Valery Fine (fine at mail.cern.ch, Dubna, JINR)
-
-***** THIS VERSION: SecurID/ACE ADDED (Unicos6.0 Version)
- Removed limit of 8-char passwords (from "getpass").
-
-***** LAST VERSION: VM/CMS CODE ADDED (Ignacio Reguero / CERN-CN/SW)
-
-***** Documentation: "Installation and Use of the TCPAW Package",
- Ben M. Segal / CERN-CN-SW March 1991.
-*/
-#endif
-/* SYSTEM DEFINITIONS: */
-
-/* (VM, VMS, Apollo, HPUX, SGI, IBMRT, Sun, Cray, Ultrix, OS9 supported) */
-
-/* CUSTOMIZATION DEFINITIONS: */
-#define DEBUG /* Can remove from production versions */
-#define AUTHENT /* INVOKES USER AUTHENTICATION CODE: BUT NOTE... */
- /* "AUTHENT" MUST MATCH IN CLIENTS AND SERVERS !! */
-#define APOPAL /* (use this to select OPAL OS-9 special login) */
-/*#define APOPWD */ /* (use if Unix password crypt fails on Apollos) */
-/*#define APOSR9 */ /* (used only for Apollo FTN linking pre-SR10) */
-/*#define SERVLOG*/ /* (use to get a server logfile: NOT IN CLIENT!! */
-/*#define SOCKETS*/ /* (optional: mainly for testing) */
-/*#define XDEBUG */ /* (optional: BUT DON'T USE FOR INETD SERVERS) */
-/*#define CRAYC */ /* (used only for testing from C on Crays) */
-/*#define RESOLVE_VIA_LOOKUP */ /* VM: to force use of a hosts table only */
-/*#define NORUSERPASS */ /* (only to force use of std "ruserpass/getpass") */
-/* END OF DEFINITIONS */
-
-#if defined(CERNLIB_QCDEC)
-
-/* TCPAW.C must be compiled with /NOPREFIX /STANDARD=VAXC
- to avoid picking up the UCX socket routines. The following
- defines are required to resolve the named routines from the
- DECC$SHR shareable library.
-
- .. unless you are using DEC C V4, in which case, use /PREFIX=ANSI
- */
-
-#define chdir DECC$CHDIR
-#define close DECC$CLOSE
-#define cuserid DECC$CUSERID
-#define getpid DECC$GETPID
-#define read DECC$READ
-#define sleep DECC$SLEEP
-
-#define atoi DECC$ATOI
-#define ctime DECC$CTIME
-#define exit DECC$EXIT
-#define fclose DECC$FCLOSE
-#define fflush DECC$FFLUSH
-#define fgets DECC$FGETS
-#define fopen DECC$FOPEN
-#define getenv DECC$GETENV
-#define memset DECC$MEMSET
-#define perror DECC$PERROR
-#define strcmp DECC$STRCMP
-#define strcpy DECC$STRCPY
-#define strlen DECC$STRLEN
-#define strncmp DECC$STRNCMP
-#define time DECC$TIME
-#define tolower DECC$TOLOWER
-
-#endif
-
-#if defined(CERNLIB_IBMRT)
-#define IBMRT
-#endif
-#if defined(CERNLIB_HPUX)
-#define HPUX
-#endif
-#if defined(CERNLIB_SUN4)
-#define sun4
-#endif
-#if defined(CERNLIB_OS9)
-#define OSK
-#endif
-#if defined(CERNLIB_SGI)||defined(CERNLIB_MIPS)
-#ifndef sgi
-#define sgi
-#endif /* sgi */
-#endif
-#if defined(CERNLIB_IBMVM)
-#define IBMVM
-#define IBM
-#endif
-#if defined(CERNLIB_IBMMVS)
-#define MVS
-#define IBMMVS
-#define IBM
-#endif
-#if (defined(CERNLIB_CRAY))&&(defined(CERNLIB_UNIX))&&(defined(CERNLIB_ACE))
-#define ACE
-#endif
-
-
-
-#if defined(CERNLIB_IBMVM)||defined(CERNLIB_IBMMVS)
-#include "cspack/tcpsock.h"
-#endif
-
-#if defined(CERNLIB_IBMMVS)
-
-#define ssendstr SSENSTR
-#define srecvstr SRECSTR
-
-#endif
-
-#if defined(CERNLIB_IBM)
-#pragma csect(CODE,"TCPAWC")
-#pragma linkage(cinit,FORTRAN)
-#pragma linkage(isetup,FORTRAN)
-#pragma linkage(iclose,FORTRAN)
-#pragma linkage(csetup,FORTRAN)
-#pragma linkage(ssetup,FORTRAN)
-#pragma linkage(sclose,FORTRAN)
-#pragma linkage(srecv,FORTRAN)
-#pragma linkage(ssend,FORTRAN)
-#pragma linkage(SSENSTR,FORTRAN)
-#pragma linkage(SRECSTR,FORTRAN)
-#pragma linkage(CMXLATE,OS)
-#ifdef IBMVM
-#pragma linkage(CHPAS,OS)
-#pragma linkage(LNRD,OS)
-#pragma linkage(LNRDPAS,OS)
-#pragma linkage(GETUSR,OS)
-#pragma linkage(GETUNIQ,OS)
-#endif /* IBMVM */
-#ifdef IBMMVS
-#pragma linkage(GETINH,OS)
-#pragma linkage(JOBNAM,OS)
-#pragma linkage(SYSTEMF,FORTRAN) /* Normally in KERNLIB */
-#endif /* IBMMVS */
-#endif /* IBM */
-
-#ifdef cray
-#ifndef CRAYC
-#define CRAYFTN
-#endif /* CRAYC */
-#ifdef ACE
-#include "/usr/include/ace.h"
-#endif /* ACE */
-#endif /* cray */
-
-#ifdef sgi
-#define NOINITGROUPS
-#endif /* sgi */
-
-#ifdef apollo
-#ifdef APOPWD
-#define APOPWD1
-#endif /* APOPWD */
-#ifdef APOPAL
-#define APOPAL1
-#endif /* APOPAL */
-#ifdef APOSR9
-#define APOFTN
-#endif /* APOSR9 */
-#endif /* apollo */
-
-#include <stdio.h>
-#include <errno.h>
-#include <signal.h>
-#include <ctype.h>
-
-#ifdef AUTHENT
-#ifndef OSK
-
-#ifndef IBM
-#ifdef vms
-#include "sysreq/pwd_vms.h"
-#elif !defined(WIN32)
-#include <pwd.h>
-#endif /* vms */
-#endif /* ^IBM */
-
-#endif /* OSK */
-#endif /* AUTHENT */
-
-#ifdef linux_softland
-#include <shadow.h>
-#endif /* linux_softland */
-
-#ifdef CRAYFTN
-#include <fortran.h>
-#endif /* CRAYFTN */
-
-#ifdef VMS
-#include <iodef.h>
-#include <ssdef.h>
-#include <climsgdef.h>
-#include <descrip.h>
-#include <types.h>
-#include <socket.h>
-#include <in.h>
-#else
-#if defined(sgi) && defined(irix3)
-#include <bsd/sys/types.h>
-#include <bsd/sys/socket.h>
-#include <bsd/netinet/in.h>
-#else
-#ifdef OSK
-#include <time.h>
-#include <types.h>
-#include <socket.h>
-#include <in.h>
-#else
-
-# ifdef IBM
-
-# ifdef IBMVM
- extern int CHPAS();
- extern char *LNRD();
- extern char *LNRDPAS();
- extern char *GETUSR();
-# define getlogin GETUSR
- extern int GETUNIQ();
-# define getpid GETUNIQ
-# endif /* IBMVM */
-
-# ifdef IBMMVS
- extern void GETINH();
- extern void JOBNAM();
-# endif /* IBMMVS */
-
-/* #include <bsdtime.h> */
-/* #include <netdb.h> */
-
-#define ENOENT 67
-#define ECONNREFUSED 61
-#include <manifest.h>
-#include <stdlib.h>
-#include <time.h>
-#include <bsdtypes.h>
-#include <socket.h>
-#include <in.h>
-#include <string.h>
-#else
-#ifdef _WIN32
-# include <io.h>
-# include <process.h>
-# include <winsock.h>
-#else
-#include <sys/types.h>
-#include <sys/socket.h>
-#include <netinet/in.h>
-#ifndef IBMRT
-/* this is a kludge, one ought to fix the "prototypes" in this file */
-#include <string.h>
-#endif /* IBMRT */
-#endif /* WIN32 */
-#endif /* IBM */
-#endif /* OSK */
-#endif /* sgi */
-#endif /* VMS */
-
-#if defined(sgi) && defined(irix3)
-#include <bsd/netdb.h>
-#else
-#ifndef _WIN32
-#include <netdb.h>
-#endif /* WIN32 */
-#endif /* sgi,irix3 */
-
-#if defined(__osf__) && defined(__alpha)
-#include <sys/ioctl.h>
-#endif
-
-#ifndef SOCKET
-#define SOCKET int
-#endif
-
-#ifndef SOCKET_ERROR
-#define SOCKET_ERROR -1
-#endif
-
-#ifndef INVALID_SOCKET
-#define INVALID_SOCKET -1
-#endif
-
-#ifdef NOMEMSET
-#define memset(a,b,c) bzero(a,c) /* in case "memset" unknown (BS) */
-#endif /* NOMEMSET */
-
-#ifdef DEBUG /* DEBUG IMPLIES SOCKETS SUPPORT... */
-#define SOCKETS
-static char *Prog_Name = "tcpaw"; /* CUSTOMIZE THIS.. */
-#endif /* DEBUG */
-
-#ifdef DEBUG
-#ifdef SERVLOG /* DEBUG PLUS SERVLOG --> LOGFILE .. */
-#ifdef VMS
-#include "cspack/tcplog.h"
-/*#define LOGFILE "disk$dd:[ben.socks]serv.log" */ /* CUSTOMIZE THIS.. */
-#endif /* VMS */
-#ifdef apollo
-#include "cspack/tcplog.h"
-/*#define LOGFILE "/user/brun/ben/serv.log" */ /* CUSTOMIZE THIS.. */
-#endif /* apollo */
-#ifdef OSK
-#include "cspack/tcplog.h"
-/*#define LOGFILE "/h0/psh/zs.log" */ /* CUSTOMIZE THIS.. */
-#endif /* OSK */
-#ifndef LOGFILE
-#include "cspack/tcplog.h"
-/*#define LOGFILE "/var/log/serv.log" */ /* CUSTOMIZE THIS.. */
-#endif /* LOGFILE */
-#endif /* SERVLOG */
-#endif /* DEBUG */
-
-#ifdef _WIN32
-#define LOGFILE "/tmp/PawServ.log"
-#endif
-
-#ifdef LOGFILE
-static FILE *logfile;
-#endif /* LOGFILE */
-
-#ifdef XDEBUG
-#ifdef LOGFILE
-#define STDERR logfile
-#else
-#define STDERR stderr
-#endif /* LOGFILE */
-#endif /* XDEBUG */
-
-/* One or two global variables...*/
-
- static char clnthost[30]; /* client remote host name string */
- static char servhost[30]; /* server remote host name string */
- static unsigned short clntpport; /* client local port number */
- static unsigned short servpport; /* server remote port number */
- static long timevar; /* contains time returned by timexx */
- static SOCKET ls = 0; /* The server listen socket descriptor */
-
-#ifndef _WIN32
- extern char *inet_ntoa();
-#ifndef IBM
- extern int errno;
-#endif /* ^IBM */
- extern char *getenv();
- unsigned long inet_addr();
-#ifdef VMS
- extern char *cuserid();
-#endif
-#else
- void tcperror(char *comment)
- {
- LPVOID lpMsgBuf;
- int isockerr = WSAGetLastError();
- int iwinerr = GetLastError();
- WSASetLastError(0);
-
- FormatMessage(
- FORMAT_MESSAGE_ALLOCATE_BUFFER | FORMAT_MESSAGE_FROM_SYSTEM,
- NULL,
- isockerr,
- MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), // Default language
- (LPTSTR) &lpMsgBuf,
- 0,
- NULL
- );
- if (!lpMsgBuf)
- {
- FormatMessage(
- FORMAT_MESSAGE_ALLOCATE_BUFFER | FORMAT_MESSAGE_FROM_SYSTEM,
- NULL,
- iwinerr,
- MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), // Default language
- (LPTSTR) &lpMsgBuf,
- 0,
- NULL
- );
- if (!lpMsgBuf) lpMsgBuf = "No text explanation for this error";
- }
- fprintf(stderr," %s: sockerr=%d, winerror = %d \n \t - \t \"%s\" \n",
- comment, isockerr,iwinerr, lpMsgBuf);
- LocalFree(lpMsgBuf);
- }
- static int initwinsock= -1;
- static WSADATA WSAData;
-#endif /* WIN32 */
-
-#ifndef OSK
-#ifndef IBM
- extern char *ctime();
-#endif /* ^IBM */
-
-#ifndef IBM
-/* Note: INETD_SOCK_SETUP and INETD_SOCK_CLOSE are not needed for VM ****/
-
-/*
- * INETD_SOCK_SETUP (or: "ISETUP")
- *
- * This routine sets up the necessary stuff for a server program to be
- * started by a BSD-style inet-daemon (also found on WIN/TCP in VMS),
- * and returns a socket for network sends and receives.
- *
- * THE INTEGER RETURN VALUE, IF NEGATIVE, INDICATES AN ERROR !!!
- *
- * ** It also returns an input and output unit number as parameters **
- *
- * ** MULTI-USER VERSION **
- * ** WITH USER AUTHENTICATION **
- */
-
-#ifdef VMS
-struct netdisc {
- int size;
- char *ptr;
-} inetd = {10, "SYS$INPUT:"};
-
-#ifdef AUTHENT
- struct passwd *my_pw;
-#endif /* AUTHENT */
-#endif /* VMS */
-
-int isetup(in, out)
-int *in;
-int *out;
-{
- int s;
-
-#ifdef VMS
- int status;
- unsigned short Channel;
-#endif /* VMS */
-
-#ifdef AUTHENT
- unsigned char idbuf[100];
- char usbuf[20], pwbuf[20];
- char *user = usbuf, *passwd = pwbuf;
- register int i, len;
-#endif /* AUTHENT */
-
-#ifdef SOCKETS
- struct hostent *hp; /* host info for remote host */
- struct sockaddr_in peeraddr_in; /* for peer socket address */
- int peerlen;
-#endif /* SOCKETS */
-
-#ifdef WIN32
- if (initwinsock==-1)
- {
- if (initwinsock = WSAStartup(MAKEWORD(1,1),&WSAData))
- {
- printf(" WSASetup %d \n",initwinsock);
- return(-2);
- }
- }
-#endif /* WIN32 */
-
-#ifdef VMS
-/* Note: with newer VMS C compiler, cannot open LOGFILE before sys$assign! */
-
- status = sys$assign(&inetd, &Channel, 0,0); /* sys$input channel */
- if (status != SS$_NORMAL) {
- return(-2);
- }
- s = Channel;
-#else
- s = 0; /* STDIN for Unix servers started by inetd */
-#endif /* VMS */
-
-#ifdef LOGFILE
- logfile = fopen(LOGFILE, "a");
- while ((logfile = fopen(LOGFILE, "a")) == NULL) sleep(1);
-#endif /* LOGFILE */
-
-#ifdef SOCKETS
- memset ((char *)&peeraddr_in, 0, sizeof(struct sockaddr_in));
- peerlen = sizeof(peeraddr_in);
- if (getpeername(s, &peeraddr_in, &peerlen) == SOCKET_ERROR) {
-#ifdef LOGFILE
- fprintf(logfile, "%s: getpeername failed\n", Prog_Name);
-#endif /* LOGFILE */
- goto errout1;
- }
-
- hp = gethostbyaddr((char *) &peeraddr_in.sin_addr,
- sizeof (struct in_addr), peeraddr_in.sin_family);
- if (hp == NULL) {
- strcpy(clnthost, inet_ntoa(peeraddr_in.sin_addr));
- } else {
- strcpy(clnthost, hp->h_name); /* save remote host name */
- }
- clntpport = ntohs(peeraddr_in.sin_port);
-#endif /* SOCKETS */
-#ifdef LOGFILE
- /* Log a startup message. */
- time (&timevar);
- fprintf(logfile, "%s: Started from %s port %u at %s",
- Prog_Name, clnthost, clntpport, ctime(&timevar));
-#endif /* LOGFILE */
-
-#ifdef AUTHENT
- /* Read the first buffer from the client and check the
- user name and password (which we assume to be in the
- format %s %s). */
-
- len = recv(s, idbuf, sizeof(idbuf), 0);
- if (len <= 0) {
- reply("Bad id receive.\n", NULL);
- goto errout1;
- }
- idbuf[len-1]='\0'; /* SAFETY !! */
- if (--len > 0) for (i=0; i<len; i++) idbuf[i] = ~idbuf[i];
- if (sscanf((char *)idbuf, "%s %s", user, passwd) != 2) {
- reply("Bad id record '%s'\n", idbuf);
- goto errout1;
- }
-#ifdef VMS
- my_pw = getpwnam(cuserid(0));
- if (chpass(&s, user, passwd) <= 0) {
-#else
-# ifndef _WIN32
- if (chpass(user, passwd) <= 0) {
-# else
- if (chpass(&s, user, passwd) <= 0) {
-# endif /* WIN32 */
-#endif /* VMS */
- goto errout1;
- }
- /* Successful authentication....... */
- /* Note: logfile closed in chpass if successful */
-
-#else
-#ifdef LOGFILE
- fclose(logfile);
-#endif /* LOGFILE */
-#endif /* AUTHENT */
-
- *in = *out = s;
- return(s); /* return the user socket descriptor */
-
-errout1:
-
-#ifdef LOGFILE
- fclose(logfile);
-#endif /* LOGFILE */
- return(-1); /* return -1 in case of failure */
-}
-
-/*
- * INETD_SOCK_CLOSE (or: "ICLOSE")
- *
- * This routine closes down an inet-daemon server socket.
- *
- */
-
-int iclose(s)
-SOCKET *s;
-{
-
-#ifdef AUTHENT
-#ifndef VMS
-# ifdef HPUX
- setresuid(0,0,0); /* have to do this to allow an exit !!! */
-# elif !defined(_WIN32)
- seteuid(0); /* have to do this to allow an exit !!! */
-# endif /* HPUX */
-#else
- setuic(my_pw->pw_uic);
-#endif /* VMS */
-#endif /* AUTHENT */
-
-#ifdef LOGFILE
- time (&timevar);
- while ((logfile = fopen(LOGFILE, "a")) == NULL) sleep(1);
- fprintf(logfile, "%s: Finished from %s port %u at %s",
- Prog_Name, clnthost, clntpport, ctime(&timevar));
- fclose(logfile);
-#endif /* LOGFILE */
-
- if (*s != INVALID_SOCKET)
-#ifdef VMS
- sys$dassgn(*s);
-#else
-#ifdef _WIN32
- closesocket(*s);
-#else
- close(*s);
-#endif /* WIN32 */
-#endif /* VMS */
- return 1;
-}
-#endif /* IBM */
-#endif /* OSK */
-
-/*
- * SERVER_SOCK_SETUP (or: "SSETUP")
- *
- * This routine sets up the necessary stuff on a standalone server.
- * It sets up the listen socket, accepts a single-user connect,
- * and returns the user socket for network sends and receives.
- *
- * THE INTEGER RETURN VALUE, IF NEGATIVE, INDICATES AN ERROR !!!
- *
- * ** It also returns an input and output unit number as parameters **
- *
- * ** SINGLE-USER VERSION ONLY (AND CODE FOR SPECIFIED PORT FOR VM) **
- * ** ALSO OS9 VERSION (REALLY AN INETD_SERVER_SOCK_SETUP !) - PSH **
- */
-
-#ifdef OSK
-int ssetup(isock, osock) /* OS9 */
-SOCKET *isock, *osock;
-{
-#ifdef AUTHENT
- unsigned char idbuf[100];
- char usbuf[20], pwbuf[20];
- char *user = usbuf, *passwd = pwbuf;
- register int i, len;
-
- SOCKET s = 0;
-
-#ifdef LOGFILE
- while ((logfile = fopen(LOGFILE, "a")) == NULL) sleep(1);
-#endif /* LOGFILE */
- /* Read the first buffer from the client and check the
- user name and password (which we assume to be in the
- format %s %s). */
-
- len = recv(s, idbuf, sizeof(idbuf), 0);
- if (len == SOCKET_ERROR) {
- reply("Bad id receive.\n", NULL);
- goto errout1;
- }
- if (--len > 0) for (i=0; i<len; i++) idbuf[i] = ~idbuf[i];
- i = sscanf((char *)idbuf, "%s %s", user, passwd);
- if (i != 1 && i != 2) { /* Allow any password, even null for OS9 */
- reply("Bad id record '%s'\n", idbuf);
- goto errout1;
- }
- if (chpass(user, passwd) <= 0) {
- goto errout1;
- }
- /* Successful authentication....... */
- /* Note: logfile closed in chpass if successful */
- goto allok;
-
-errout1:
-
-#ifdef LOGFILE
- fclose(logfile);
-#endif /* LOGFILE */
- return(-1); /* return -1 in case of failure */
-
-allok:
-
-#endif /* AUTHENT */
-
- *isock = 0;
- *osock = 1;
- return(*isock);
-}
-#else /* OSK */
-
-/* The old-fashioned single-user server: NOTE "AUTHENT" NOT SUPPORTED !!! */
-/* (i.e. it will not talk correctly to a client with "AUTHENT" defined) */
-/*
- THIS IS ALSO USED FOR VM, INVOKED BY THE REXEC SERVER. IN THIS CASE,
- AUTHENTICATION IS DONE BY THE REXEC SERVER BEFORE THIS SERVER STARTS.
-*/
-int ssetup(in, out, port) /* VM */
-int *in, *out;
-int *port; /* VM */
-{
- struct hostent *hp; /* host info for remote host */
- struct servent *sp; /* pointer to service information */
-
- struct sockaddr_in myaddr_in; /* for local socket address */
- struct sockaddr_in peeraddr_in; /* for peer socket address */
-
- int s, addrlen;
- unsigned short sport = *port; /* VM */
-
-#if defined ( _WIN32) && defined (AUTHENT)
- unsigned char idbuf[100];
- char usbuf[20], pwbuf[20];
- char *user = usbuf, *passwd = pwbuf;
- register int i, len;
-#endif
-
-#ifdef _WIN32
-
- if (initwinsock==-1)
- {
- if (initwinsock = WSAStartup(MAKEWORD(1,1),&WSAData))
- {
- printf(" WSASetup %d \n",initwinsock);
- return(-2);
- }
- else
- {
- printf(" Maximum %d sockets are allowed \n", WSAData.iMaxSockets);}
-
- }
-#endif /* WIN32 */
-
-
- /* clear out address structures */
-
- memset ((char *)&myaddr_in, 0, sizeof(struct sockaddr_in));
- memset ((char *)&peeraddr_in, 0, sizeof(struct sockaddr_in));
-
- /* Set up address structure for the listen socket. */
- myaddr_in.sin_family = AF_INET;
- myaddr_in.sin_addr.s_addr = INADDR_ANY;
-
- /* Find the information for the "example" server
- * in order to get the needed port number.
- * ...UNLESS PASSED A +VE PORT NUMBER TO USE (VM).
- */
- if (port == NULL || *port <= 0) { /* VM */
- sp = getservbyname ("pawserv", "tcp");
-/* printf(" name = %s, port = %d \n",sp->s_name,sp->s_port); */
- if (sp == NULL) {
- fprintf(stderr, "%s: 'example' not in services file\n",
- "server_sock_setup");
- exit(1);
- }
- myaddr_in.sin_port = sp->s_port;
-
- } else myaddr_in.sin_port = htons(sport); /* VM */
-
- /* Create the listen socket. */
- ls = socket(AF_INET, SOCK_STREAM, 0);
- if (ls == INVALID_SOCKET) {
-#if defined(IBM) || defined(_WIN32)
- tcperror("server_sock_setup: ls = socket(AF_INET, ...)");
-#else
- perror("server_sock_setup");
-#endif /* IBM */
- fprintf(stderr, "%s: unable to create socket\n",
- "server_sock_setup");
- exit(1);
- }
-#ifdef _WIN32
- {
- int flag = 1;
- if(setsockopt(ls,SOL_SOCKET,SO_REUSEADDR,(char *)&flag,sizeof(int))
- == SOCKET_ERROR) {
- tcperror("server_sock_setup: setsockopt(ls,...)");
- fprintf(stderr, "%s: unable to setsockopt\n",
- "server_sock_setup");
- exit(1);
- }
- }
-#endif
- /* Bind the listen address to the socket. */
- if (bind(ls, &myaddr_in, sizeof(struct sockaddr_in)) == SOCKET_ERROR) {
-#if defined(IBM) || defined(_WIN32)
- tcperror("server_sock_setup: bind(ls,...)");
-#else
- perror("server_sock_setup");
-#endif /* IBM */
- fprintf(stderr, "%s: unable to bind address\n",
- "server_sock_setup");
- exit(1);
- }
- /* Initiate the listen on the socket so remote users
- * can connect. The listen backlog is set to 5, which
- * is the largest currently supported.
- */
-#ifdef _WIN32
- if (listen(ls, 1) == SOCKET_ERROR) {
-#else
- if (listen(ls, 5) == SOCKET_ERROR) {
-#endif
-#if defined(IBM) || defined(_WIN32)
- tcperror("server_sock_setup: listen(ls,5)");
-#else
- perror("server_sock_setup");
-#endif /* IBM */
- fprintf(stderr, "%s: unable to listen on socket\n",
- "server_sock_setup");
- exit(1);
- }
- addrlen = sizeof(struct sockaddr_in);
- s = accept(ls, &peeraddr_in, &addrlen);
- if ( s == INVALID_SOCKET) {
- fprintf(stderr, "%s: accept error\n", "server_sock_setup");
- return(-1);
- }
- hp = gethostbyaddr ((char *) &peeraddr_in.sin_addr,
- sizeof (struct in_addr), peeraddr_in.sin_family);
- if (hp == NULL) {
- strcpy(clnthost, inet_ntoa(peeraddr_in.sin_addr));
- } else {
- strcpy(clnthost, hp->h_name); /* save remote host name */
- }
- /* Log a startup message. */
- time(&timevar);
- clntpport = ntohs(peeraddr_in.sin_port);
- fprintf(stderr, "Started from %s port %u at %s",
- clnthost, clntpport, ctime(&timevar));
-
- *in = *out = s;
-#if defined (AUTHENT ) && defined(_WIN32)
- /* Read the first buffer from the client and check the
- user name and password (which we assume to be in the
- format %s %s). */
-
- len = recv(s, idbuf, sizeof(idbuf), 0);
- if (len == SOCKET_ERROR) {
- sock_reply(&s,"Bad id receive.\n", NULL);
- return -1;
- }
- if (--len > 0) for (i=0; i<len; i++) idbuf[i] = ~idbuf[i];
- i = sscanf((char *)idbuf, "%s %s", user, passwd);
- if (i != 1 && i != 2) { /* Allow any password, even null for OS9 */
- sock_reply(&s,"Bad id record '%s'\n", idbuf);
- return -1;
- }
- if (chpass(&s,user, passwd) <= 0) {
- return INVALID_SOCKET;
- }
- /* Successful authentication....... */
-
-#endif
-#ifdef _WIN32
- if (closesocket(ls) == SOCKET_ERROR) tcperror("server_sock_setup: closesocket(ls)");
-#if 0
- system("start /B pawserv.exe");
-#endif
-
- {
- STARTUPINFO startinfo;
- PROCESS_INFORMATION processinfo;
- ZeroMemory(&startinfo,sizeof(STARTUPINFO));
- startinfo.cb = sizeof(STARTUPINFO);
-
- if(CreateProcess(
- "PawServ.exe", // pointer to name of executable module
- NULL, // pointer to command line string
- NULL, // pointer to process security attributes
- NULL, // pointer to thread security attributes
- FALSE, // handle inheritance flag
- CREATE_DEFAULT_ERROR_MODE, // creation flags
- NULL, // pointer to new environment block
- NULL, // pointer to current directory name
- &startinfo, // pointer to STARTUPINFO
- &processinfo // pointer to PROCESS_INFORMATION
- ) == FALSE)
- {
- tcperror("CreateProcess");
- }
- else
- printf(" New Process has been create succefully \n");
- }
-#endif
- return(s); /* Return the user socket descriptor */
-}
-#endif /* OSK */
-
-/*
- * CLIENT_SOCK_SETUP (or: "CSETUP")
- *
- * This routine sets up the TCP client side so that it can use a remote
- * "srvc" server. It creates a connection and returns the socket.
- *
- * THE INTEGER RETURN VALUE, IF NEGATIVE, INDICATES AN ERROR !!!
- *
- * ** It also returns an input and output unit number as parameters **
- *
- * The name of the remote host to which the client will connect is given
- * as the first parameter to the routine.
- *
- */
-
-static int junk = 0;
-#define NSO 100 /* VM */
-static int svmode[NSO], sxsock[NSO]; /* VM */
-#define MAGIC 0x12345678 /* VM */
-#define VMTO 50 /* 50 sec timeout * VM */
-
-#ifdef VMS
-int csetup(sysdes, in, out, srvdes) /* VMS CASE... */
-struct dsc$descriptor_s *sysdes;
-int *in, *out;
-struct dsc$descriptor_s *srvdes;
-#else
-#ifdef CRAYFTN
-int csetup(sysdes, in, out, srvdes) /* CRAY CASE... */
-_fcd sysdes;
-int *in, *out;
-_fcd srvdes;
-#else
-#ifdef APOFTN
-int csetup(system, in, out, srvc, s_ln, c_ln) /* APOLLO (PRE-SR10) FTN... */
-char *system;
-int *in, *out;
-char *srvc;
-short *s_ln, *c_ln; /* dummy arguments */
-#else
-#ifdef CERNLIB_MSSTDCALL
-int csetup(system, lsys, in, out, srvc, lsrvc ) /* Microsoft Fortran */
-char *system;
-int lsys, lsrvc;
-int *in, *out;
-char *srvc;
-#else
-int csetup(system, in, out, srvc) /* UNIX ETC... */
-char *system;
-int *in, *out;
-char *srvc;
-#endif /* MS */
-#endif /* APOFTN */
-#endif /* CRAYFTN */
-#endif /* VMS */
-
-{
- struct hostent *hp; /* host info for remote host */
- struct servent *sp; /* pointer to service information */
- struct sockaddr_in myaddr_in; /* for local socket address */
- struct sockaddr_in peeraddr_in; /* for peer socket address */
-
- unsigned long addr;
- int s, addrlen;
- int sx, nn = 0; /* REXEC */
-#ifndef IBM
- char get[50], *getp = get; /* REXEC */
-#endif /*^IBM */
- char sys[30];
- register int i, j, k;
- register char *c;
-
- char portstr[20], *pt; /* IBM */
- int vmode = 0; /* IBM */
- unsigned short sport = 0, prt = 0; /* IBM */
- char uspass[50];
- char *user = NULL, *passwd = NULL;
- int port;
-#if defined(AUTHENT)
- unsigned char idbuf[100];
-#endif /* AUTHENT */
-
-#ifdef VMS
- char *system, *srvc;
- unsigned short s_ln, c_ln;
- struct dsc$descriptor_s sd, id; /* VM */
- unsigned long cliflags; /* VM */
- char command[200]; /* VM */
- int status, cstatus; /* VM */
-
- srvc = srvdes->dsc$a_pointer;
- c_ln = srvdes->dsc$w_length;
- system = sysdes->dsc$a_pointer;
- s_ln = sysdes->dsc$w_length;
- j = c_ln;
- i = s_ln;
-#else
-#ifdef CRAYFTN
- char *system, *srvc;
- unsigned s_ln, c_ln;
-
- srvc = _fcdtocp(srvdes);
- c_ln = _fcdlen(srvdes);
- system = _fcdtocp(sysdes);
- s_ln = _fcdlen(sysdes);
- j = c_ln;
- i = s_ln;
-#else
-#ifdef APOFTN
- j = *c_ln;
- i = *s_ln;
-#else
-#ifdef IBM
- extern char asciitoebcdic[]; /* translation tables */
- extern char ebcdictoascii[];
- char buff[100];
- char *get;
- char *getp;
- char getbuf[50]; /* REXEC */
- getp = getbuf; /* REXEC */
- get = getbuf; /* REXEC */
-/* j = 80; */ /* (crude kludge) length of srvc in Fortran */
-/* i = 80; */ /* ( ,, ,, ) length of system in Fortran */
- i = gtlnfstr(&system,1); /* length of 1st arg (srvc) */
- j = gtlnfstr(&system,4); /* length of 4th arg (system) */
-#else
-#ifdef WIN32
- if (initwinsock==-1)
- {
- if (initwinsock = WSAStartup(MAKEWORD(1,1),&WSAData))
- {
- printf(" WSASetup %d \n",initwinsock);
- return(-2);
- }
- }
- j = lsrvc;
- i = lsys;
-#else
- j = strlen(srvc);
- i = strlen(system);
-#endif /* WIN32 */
-#endif /* IBM */
-#endif /* APOFTN */
-#endif /* CRAYFTN */
-#endif /* VMS */
-
-
-
- /* Terminate correctly the host & service strings passed by FTN.. */
- for (k=0; k<j; k++) if (srvc[k] == ' ') { srvc[k] = '\0'; break;}
- for (k=0; k<i; k++) if (system[k] == ' ') { system[k] = '\0'; break;}
- /* And map to lower case... */
- c = srvc; while (*c) { if (isupper(*c)) *c = tolower(*c); c++; }
- c = system; while (*c) { if (isupper(*c)) *c = tolower(*c); c++; }
-
- /* fprintf(stderr, "system '%s' service '%s'\n", system, srvc); */
-
-/* changed TS 27.11.91 */
-/* ================================================================= */
-/* the original part (Version 1.21 of tcpaw can only connect
- to VM via rexec and inetd systems,
- in order to reach MVS something like this should be used.
-*/
- strcpy(servhost, system); /* Use our own storage when needed.... */
- *sys = '\0';
-
-/* Has the user specified the option -V or -M ? */
-
- if ( !strcmp((system + strlen(system) - 4),"(mvs") ){
- *(system + strlen(system) - 4) = '\0';
- strcpy(servhost, system);
- fprintf(stderr,"MVS system: '%s'\n",system);
- goto mvscase;
- }
-
- if ( !strcmp((system + strlen(system) - 3),"(vm") ){
- *(system + strlen(system) - 3) = '\0';
- strcpy(servhost, system);
- fprintf(stderr,"VM system: '%s'\n",system);
- goto vmcase;
- }
-
-/* NOTE THAT THE FOLLOWING TESTS ON MACHINE NAMES ARE CERN-SPECIFIC !! */
- if (!strncmp(system, "cernvm", 6) || !strncmp(system, "lepics", 6) ||
- !strncmp(system, "crnvm", 5))
- goto vmcase;
-/* NOTE THAT THE FOLLOWING TESTS ON MACHINE NAMES ARE GSI-SPECIFIC !! */
- if (!strncmp(system, "mvs", 3) || !strncmp(system, "MVS", 3) )
- goto mvscase;
- if ((addr = inet_addr(servhost)) != -1) { /* Permit IP addresses */
-
- /* my offer, because */
- /* i had problems in anderstanding all the stuff */
-
- fprintf(stderr,"\nWhich system is '%s' running?: (c)\n", system );
- fprintf(stderr," a VM\n");
- fprintf(stderr," b MVS\n");
- fprintf(stderr," c other System\n");
- fprintf(stderr,"\nEnter a, b or c:", system );
-
- if (fgets(get, 80, stdin) != NULL) {
- if (*get == 'a' || *get == 'A') goto vmcase;
- if (*get == 'b' || *get == 'B') goto mvscase;
- }
- }
-/* ================================================================= */
-
-#if defined(AUTHENT)
-/* Get the user name/password info from ~/.netrc file for authentication */
-
-#ifdef APOPAL1
-/*** DIRTY TEMPORARY FIX FOR APOLLO-TO-OS9 AUTHENTICATION FOR PSH ***/
- if (!strncmp(system, "o-o", 3)) user = passwd = "(any)"; else
-#endif /* APOPAL1 */
- ruserpass(servhost, &user, &passwd); /* get info from .netrc */
- sprintf(uspass, "%s %s", user, passwd);
-#endif /* AUTHENT */
- goto vmagain;
-
-vmcase:
-
-/* VM (rexec) MODE FOLLOWS: */
-
- vmode++;
-
- gethostname(portstr, sizeof(portstr));
- for (pt=portstr; *pt ; pt++) prt += *pt;
-#ifdef DEBUG
-/*
- fprintf(stderr, "localhost = %s\n", portstr);
- fprintf(stderr, "prt = %d prt<<5 = %d\n", prt, (prt<<5));
-*/
-#ifdef VMS
-/* fprintf(stderr, "time = %d\n", time(0)); */
-#endif /* VMS */
-#endif /* DEBUG */
-/* if (!sport) ** DEBUG **/
-
-#ifdef IBMMVS
- /* not the best way, but it works */
- sport = (prt << 5) | (1000 & 0x3e0) + junk++;
-#else
- sport = (prt << 5) | (getpid() & 0x3e0) + junk++;
-#endif /* IBMMVS */
-
-#ifdef VMS
- sport += (time(0) & 0xfff); /* Add 0-4095 as VMS pid may not change */
-#endif /* VMS */
- sprintf(portstr, "%d", sport);
- fprintf(stderr, "Remote host/port = %s/%s\n", system, portstr);
-
-/* Now it's time to give VM an "rexec" command to start the server.. */
-
- sp = getservbyname("exec", "tcp");
- if (sp == NULL) {
- fprintf(stderr, "'exec' not found in services file\n");
- return(-1);
- }
- strcpy(get, system); /* rexec modifies its host argument! */
- if (*sys == '\0') {
- register char *cs = sys;
-
- c = system; /* 'sys'= 'system' without domain extension */
- while ((*c) && (*c != '.')) {
- *cs++ = *c++;
- }
- *cs = '\0';
- }
- sprintf(uspass, "%s %s %s", srvc, portstr, sys);
-#ifdef DEBUG
-/*
- fprintf(stderr, "Rexec-ing %s cmd '%s'\n", system, uspass);
-*/
-#endif /* DEBUG */
-
-#ifdef linux_softland
- sx = _rexec(&getp, (int)sp->s_port, user, passwd, uspass, NULL);
-#else
- sx = rexec(&getp, (int)sp->s_port, user, passwd, uspass, NULL);
-#endif /* linux_softland */
- if (sx < 0) {
- fprintf(stderr, "Bad rexec return %d\n", sx);
- fprintf(stderr, "Probable cause:\n");
- fprintf(stderr, " a) You are logged on already \n");
- fprintf(stderr, " b) You are disconnected (e.g. GONE)\n");
- fprintf(stderr, " c) Bad VM username or password\n");
- return(-1);
- }
-/* fprintf(stderr, "Successfully rexec-ed %s cmd '%s'\n", system, uspass); */
-
- fprintf(stderr, "%s: loading %s exec (%d sec timeout)...\n\n",
- system, srvc, VMTO);
- goto vmagain;
-
-mvscase:
-
-/* MVS tsosub mode follows: */
-
- vmode++;
-
- sp = getservbyname ("tsosub", "tcp");
- if (sp == NULL) {
- fprintf(stderr, "%s: 'tsosub' not in services file\n",
- "tsosub");
- /* in etc.services is no tsosub service up to now */
- fprintf(stderr, "Use port 5001 for tsosub to connect to %s\n",system);
- port = 5001;
- /* return(-1); */
-
- }
- else
- port = (int) sp->s_port;
-
-
- sport = 0; /* MVS adds free portnumber to the srvc string */
- /* sport=0, the port number is choicen by MVS */
- sx = tsosub(&system, port, user, passwd, srvc, &sport);
- if (sx < 0) {
- /* fprintf(stderr, "Bad tsosub return %d\n", sx); */
- return(-1);
- }
-
- fprintf(stderr, "Remote host/port = %s/%d\n", system,sport);
- fprintf(stderr, "%s: loading %s (%d sec timeout)...\n\n",
- system, srvc, VMTO);
-
-/* now connect to server */
-
-
-vmagain:
- /* clear out address structures */
- memset ((char *)&myaddr_in, 0, sizeof(struct sockaddr_in));
- memset ((char *)&peeraddr_in, 0, sizeof(struct sockaddr_in));
-
- /* Set up the peer address to which we will connect. */
- peeraddr_in.sin_family = AF_INET;
- /* Get the host information for the hostname that the
- * user passed in.
- */
-
- if ((addr = inet_addr(servhost)) != -1) { /* Permit IP addresses */
- peeraddr_in.sin_addr.s_addr = addr;
- } else {
- hp = gethostbyname(servhost);
- if (hp == NULL) {
- fprintf(stderr, "%s: %s not found in hosts file\n",
- "client_sock_setup", servhost);
- return(-1);
- }
- peeraddr_in.sin_addr.s_addr =
- ((struct in_addr *)(hp->h_addr))->s_addr;
-/* bcopy(hp->h_addr, (caddr_t)&peeraddr_in.sin_addr, hp->h_length); */
- }
-
- if (!vmode) {
- /* Find the information for the requested server
- * in order to get the needed port number.
- */
- sp = getservbyname (srvc, "tcp");
- if (sp == NULL) {
- fprintf(stderr, "%s: '%s' not found in services file\n",
- "client_sock_setup", srvc);
- return(-1);
- }
- peeraddr_in.sin_port = sp->s_port;
- } else {
- peeraddr_in.sin_port = htons(sport); /* VM */
- }
-
- /* Create the socket. */
- s = socket(AF_INET, SOCK_STREAM, 0);
- if (s == INVALID_SOCKET) {
-#if defined(IBM) || defined(_WIN32)
- tcperror("client_sock_setup");
-#else
- perror("client_sock_setup");
-#endif /* IBM */
- fprintf(stderr, "%s: unable to create socket\n",
- "client_sock_setup");
- if (vmode) close(sx);
- return(-1);
- }
- /* Try to connect to the remote server at the address
- * which was just built into peeraddr.
- */
- if (connect(s, &peeraddr_in, sizeof(struct sockaddr_in)) == SOCKET_ERROR) {
-#ifndef _WIN32
- close(s);
-#else
- closesocket(s);
-#endif
- if (vmode) while (nn++ < VMTO) {
- /* fprintf(stderr, "Retry %d\n", nn); */
- sleep(1);
- goto vmagain;
- }
-#if defined(IBM) || defined(_WIN32)
- tcperror("client_sock_setup");
-#else
- perror("client_sock_setup");
-#endif /* IBM */
- fprintf(stderr, "%s: unable to connect to remote\n",
- "client_sock_setup");
- if (vmode) close(sx);
- return(-1);
- }
-
- addrlen = sizeof(struct sockaddr_in);
- if (getsockname(s, &myaddr_in, &addrlen) == SOCKET_ERROR) {
-#if defined(IBM) || defined(_WIN32)
- tcperror("client_sock_setup");
-#else
- perror("client_sock_setup");
-#endif /* IBM */
- fprintf(stderr, "%s: unable to read socket address\n",
- "client_sock_setup");
- clntpport = 0;
- } else
- clntpport = ntohs(myaddr_in.sin_port);
-
- /* Print out a startup message for the user. */
- time(&timevar);
- fprintf(stderr, "Connected to %s on TCP port %u at %s",
- servhost, clntpport, ctime(&timevar));
-
-#if defined(AUTHENT)
- if (!vmode) {
- /* Send out the user/password authentication record first... */
- j = strlen(uspass);
-#ifdef IBM
- CMXLATE(uspass,ebcdictoascii,j);
-#endif /* IBM */
- for (i=0; i<j; i++) uspass[i] = ~uspass[i];
- if (send(s, uspass, j+1, 0) <= 0) {
-#if defined(IBM) || defined(_WIN32)
- tcperror("Error sending authorization");
-#else
- perror("Error sending authorization");
-#endif /* IBM */
- goto badserv;
- }
- /* Read back a confirmation from server... */
- if ((i = recv(s, idbuf, sizeof(idbuf), 0)) <= 0) {
-#if defined(IBM) || defined(_WIN32)
- tcperror("Error receiving authorization");
-#else
- perror("Error receiving authorization");
-#endif /* IBM */
-badserv:
- fprintf(stderr,"%s: Service '%s' not set up OK on host %s.\n",
- "client_sock_setup", srvc, servhost);
-#ifndef _WIN32
- close(s);
-#else
- closesocket(s);
-#endif
- return(-1);
- }
- idbuf[i] = '\0';
-#ifdef IBM
- CMXLATE(idbuf,asciitoebcdic,i);
-#endif /* IBM */
- fprintf(stderr, "%s\n", idbuf);
-
-/* Check reply string and set return code as appropriate */
-
-if (!strncmp(idbuf,"Bad id record",13)) { return(-2); }
-
-if (!strncmp(idbuf,"Unknown user",12)) { return(-2); }
-
-if (!strncmp(idbuf,"Bad password",12)) { return(-3); }
-
-if (!strncmp(idbuf,"Can't setegid",13)) { return(-4); }
-
-if (!strncmp(idbuf,"Can't initgroups",16)) { return(-5); }
-
-if (!strncmp(idbuf,"Can't set home",14)) { return(-6); }
-
-if (!strncmp(idbuf,"Can't seteuid",13)) { return(-7); }
-
-if (!strncmp(idbuf,"Can't setuser",13)) { return(-8); }
-
-if (!strncmp(idbuf,"Can't setacct",13)) { return(-9); }
-
-if (!strncmp(idbuf,"Can't setpriv",13)) { return(-10);}
-
-if (!strncmp(idbuf,"Bad passcode",12)) { return(-11);}
-
-if (!strncmp(idbuf,"Can't setid",11)) { return(-12);}
-
- }
-#endif /* AUTHENT */
-
- /* Remember the sx sockets per VM socket (even for VMS!) */
- if (vmode) {
- svmode[s%NSO] = MAGIC;
- sxsock[s%NSO] = sx;
- } else
- svmode[s%NSO] = sxsock[s%NSO] = 0;
-
- *in = *out = s;
- return(s); /* return the socket descriptor to FTN */
-
-}
-
-/*
- * SOCK_CLOSE (or: "SCLOSE")
- *
- * This routine closes a client (or a single-client server) socket.
- *
- */
-
-int sclose(sock)
-SOCKET *sock;
-
-{
-#ifndef _WIN32
- close(*sock); /* close the user socket */
-#ifndef OSK
- if (ls > 0) close(ls); /* ..and the listen socket if an active server */
-#endif /* OSK */
-
- if (svmode[(*sock)%NSO] == MAGIC) {
- close(sxsock[(*sock)%NSO]); /* ..and the sx socket if appropriate */
- svmode[(*sock)%NSO] = sxsock[(*sock)%NSO] = 0;
- }
-#else
- closesocket(*sock); /* close the user socket */
- if (ls != INVALID_SOCKET) closesocket(ls); /* ..and the listen socket if an active server */
-
- if (svmode[(*sock)%NSO] == MAGIC) {
- closesocket(sxsock[(*sock)%NSO]); /* ..and the sx socket if appropriate */
- svmode[(*sock)%NSO] = sxsock[(*sock)%NSO] = 0;
- }
-#endif /* WIN32 */
- return 1;
-}
-
-/*
- * SOCK_SENDSTR (or: "SSENDSTR")
- *
- * This routine sends the contents of a character string down a socket.
- *
- * Args: socket, string address, string length.
- * NOTE: ROUTINE ATTEMPTS TO SEND EXACT INPUT LENGTH.
- *
- * Returns: Number of bytes sent/error (to be checked by user).
- */
-
-#ifdef VMS
-int ssendstr(sock, bufdes, m) /* VMS CASE... */
-int *sock;
-struct dsc$descriptor_s *bufdes;
-int *m;
-#else
-#ifdef CRAYFTN
-int ssendstr(sock, bufdes, m) /* CRAY CASE... */
-int *sock;
-_fcd bufdes;
-int *m;
-#else
-#ifdef CERNLIB_MSSTDCALL
-int ssendstr(sock, buf, lbuf, m) /* Microsoft case... */
-SOCKET *sock;
-char *buf;
-int lbuf;
-int *m;
-#else
-int ssendstr(sock, buf, m)
-int *sock;
-char *buf;
-int *m;
-#endif /* MS */
-#endif /* CRAYFTN */
-#endif /* VMS */
-
-{
-#ifdef IBM
- extern char asciitoebcdic[]; /* translation tables */
- extern char ebcdictoascii[];
-#endif /* IBM */
- int s = *sock, n = *m, i, j, k = 0;
-
-#ifdef VMS
- char *buf = bufdes->dsc$a_pointer;
-#endif /* VMS */
-#ifdef CRAYFTN
- char *buf = _fcdtocp(bufdes);
-#endif /* CRAYFTN */
-
-#ifdef IBM
-/* CMXLATE(buf,ebcdictoascii,strlen(buf));*/
- CMXLATE(buf,ebcdictoascii,*m);
-#endif /* IBM */
-retry:
- if ((i =send(s, buf+k, n-k, 0)) == SOCKET_ERROR) {
-#ifdef XDEBUG
- tcperror("send");
- fprintf(STDERR,
- "sock_sendstr: sock = %d ret = %d len = %d k = %d buf[0-7] = '",
- s, i, n, k);
- for (j=0; j<8; j++) fprintf(STDERR, "%c", buf[j]);
- fprintf(STDERR, "'\n");
- if (i = 0) { sleep(2); goto retry; }
-#endif /* XDEBUG */
- return(i);
- }
- if (i < (n-k)) { k += i; goto retry; }
- return(n);
-}
-
-/*
- * SOCK_RECVSTR (or: SRECVSTR")
- *
- * This routine receives the contents of a character string on a socket.
- *
- * Args: socket, string address, [maximum] string length.
- * NEW: IF INPUT LENGTH > 0 ROUTINE ATTEMPTS TO GET THIS LENGTH.
- * IF ,, ,, < 0 ROUTINE GETS WHAT IT CAN (OLD STYLE).
- *
- * Returns: Number of bytes received/error (to be checked by user).
- *
- */
-
-#ifdef VMS
-int srecvstr(sock, bufdes, m) /* VMS CASE... */
-int *sock;
-struct dsc$descriptor_s *bufdes;
-int *m;
-#else
-#ifdef CRAYFTN
-int srecvstr(sock, bufdes, m) /* CRAY CASE... */
-int *sock;
-_fcd bufdes;
-int *m;
-#else
-#ifdef CERNLIB_MSSTDCALL
-int srecvstr(sock, buf,lbuf, m) /* MS CASE... */
-SOCKET *sock;
-char *buf;
-int lbuf;
-int *m;
-#else
-int srecvstr(sock, buf, m)
-int *sock;
-char *buf;
-int *m;
-#endif /* MS */
-#endif /* CRAYFTN */
-#endif /* VMS */
-
-{
-#ifdef IBM
- extern char asciitoebcdic[]; /* translation tables */
- extern char ebcdictoascii[];
-#endif /* IBM */
- int s = *sock, n = *m, i, j, k = 0;
-
-#ifdef VMS
- char *buf = bufdes->dsc$a_pointer;
-#endif /* VMS */
-#ifdef CRAYFTN
- char *buf = _fcdtocp(bufdes);
-#endif /* CRAYFTN */
-
- if (n < 0) n = -n; /* Look for maximum number of bytes option... */
-
-retry:
- if ((i = recv(s, buf+k, n-k, 0)) == SOCKET_ERROR) {
-#ifdef IBM
-/* CMXLATE(buf+k,asciitoebcdic,i); Maybe not, with length <=0 JDS 251093*/
-#endif /* IBM */
-#ifdef XDEBUG
- tcperror("recv");
- fprintf(STDERR,
- "sock_recvstr: sock = %d ret = %d len = %d k = %d buf[0-15] = '",
- s, i, *m, k);
- for (j=0; j<16; j++) fprintf(STDERR, "%c", buf[j]);
- fprintf(STDERR, "'\n");
-#endif /* XDEBUG */
- return(i);
- }
-#ifdef IBM
- CMXLATE(buf+k,asciitoebcdic,i);
-#endif /* IBM */
- if (*m > 0) { /* look for exact number of bytes option... */
- if (i < (n-k)) { k += i; goto retry; }
- return(n);
- } else
- return(i);
-}
-
-/*
- * SOCK_SEND (or: "SSEND")
- *
- * This routine sends a binary block of data down a socket.
- *
- * Args: socket, block address, block length.
- * NOTE: ROUTINE ATTEMPTS TO SEND EXACT INPUT LENGTH.
- *
- * Returns: Number of bytes sent/error (to be checked by user).
- *
- */
-
-int ssend(sock, buf, m)
-int *sock;
-char *buf;
-int *m;
-{
- int s = *sock, n = *m, i, j, k = 0;
-
-retry:
- if ((i = send(s, buf+k, n-k, 0)) <= 0) {
-#ifdef XDEBUG
- fprintf(STDERR,
- "sock_send: sock = %d ret = %d len = %d k = %d buf[0-7] = '",
- s, i, n, k);
- for (j=0; j<8; j++) fprintf(STDERR, "%c", buf[j]);
- fprintf(STDERR, "'\n");
-#endif /* XDEBUG */
- return(i);
- }
- if (i < (n-k)) { k += i; goto retry; }
- return(n);
-}
-
-/*
- * SOCK_RECV (or: "SRECV")
- *
- * This routine receives a binary block of data from a socket.
- *
- * Args: socket, receive buffer address, [maximum] block length.
- * NEW: IF INPUT LENGTH > 0 ROUTINE ATTEMPTS TO GET THIS LENGTH.
- * IF ,, ,, < 0 ROUTINE GETS WHAT IT CAN (OLD STYLE).
- *
- * Returns: Number of bytes received/error (to be checked by user).
- *
- */
-
-int srecv(sock, buf, m)
-int *sock;
-char *buf;
-int *m;
-{
- int s = *sock, n = *m, i, j, k = 0;
-
- if (n < 0) n = -n; /* Look for maximum number of bytes option... */
-
-retry:
- if ((i = recv(s, buf+k, n-k, 0)) == SOCKET_ERROR) {
-#ifdef XDEBUG
- fprintf(STDERR,
- "sock_recv: sock = %d ret = %d len = %d k = %d buf[0-7] = '",
- s, i, *m, k);
- for (j=0; j<8; j++) fprintf(STDERR, "%c", buf[j]);
- fprintf(STDERR, "'\n");
-#endif /* XDEBUG */
- return(i);
- }
- if (*m > 0) { /* look for exact number of bytes option... */
- if (i < (n-k)) { k += i; goto retry; }
- return(n);
- } else
- return(i);
-}
-
-reply(s1, s2, s3)
- char *s1, *s2, *s3;
-{
-#ifdef OSK
- char buff[100];
- int osock = 1;
-
- sprintf(buff, s1, s2, s3);
- send(osock, buff, strlen(buff)+1, 0);
-#else
- printf(s1, s2, s3);
- fflush(stdout);
-#endif /* OSK */
-
-#ifdef LOGFILE
- fprintf(logfile, s1, s2, s3);
-#endif /* LOGFILE */
-}
-
-sock_reply(s, s1, s2, s3)
- int *s;
- char *s1, *s2, *s3;
-{
-
-/* As reply() but use socket rather than stdout */
-
- char buff[100];
- int osock = *s;
-
- sprintf(buff, s1, s2, s3);
- send(osock, buff, strlen(buff)+1, 0);
-
-#if defined(LOGFILE) && !defined(_WIN32)
- fprintf(logfile, s1, s2, s3);
-#endif /* LOGFILE */
-}
-
-#if defined(AUTHENT)
-/* Code derived from ftpd to do name/passwd checking.. */
-/* Note that printf's get pushed down the network to client... */
-#ifdef IBM
-int chpass(user, pass) /* For IBM */
- char *user, *pass;
-{
- char *topoint;
- topoint = user;
- while (*topoint != '\0'){
- toupper(*topoint);
- topoint++;
- }
- topoint = pass;
- while (*topoint != '\0'){
- toupper(*topoint);
- topoint++;
- }
- if (CHPAS(user,pass)){ /*if pw check no ok (done in assembler) */
- reply("Bad password for user %s.\n", user);
- return(-3);
- }
- reply("User %s accepted.\n", user);
-#ifdef LOGFILE
- fclose(logfile);
-#endif /* LOGFILE */
- return(1);
-}
-#ifdef IBMMVS
-int CHPAS(user, pass) /* For IBMMVS */
- char *user, *pass;
-{
- int i;
- char cmd??(80??);
-
- i = sprintf(cmd,"TSOEXEC PWDCHK2 %s,%s ",user,pass);
- i = system(cmd);
- /* i = 0 user,pass ok */
- /* i = 4 user,pass not ok */
- return(i);
-}
-#endif /* IBMMVS */
-
-#else /* ^IBM */
-#ifndef _WIN32
-#ifndef VMS
-int chpass(user, pass) /* For Unix and other "normal" people */
- char *user, *pass;
-{
-
-#ifndef OSK
-
- char buff[100];
-
-#ifdef AFS
-
-/* Use cc -I/usr/afsws/include to get appropriate AFS include files */
-
-#include <afs/stds.h>
-#include <afs/kautils.h>
-#include <errno.h>
-char *reason;
-
-#endif /* AFS */
-
-#ifdef APOPWD1
-/** TEMPORARY APOLLO KLUDGE WHILE "crypt" DOESN'T WORK.. **/
-#include <sys/wait.h>
-
- union wait ret;
-#endif /* APOPWD1 */
-
- char *xpasswd, *crypt();
- struct passwd *pw;
-
-#ifdef linux_softland
- struct spwd *spwd;
-#endif /* linux_softland */
-
-#ifdef ACE
- struct acmdata acmd; /* Unicos6.0 calling sequence used.. */
-
- acmd.acm_both = 0;
-#endif /* ACE */
-
- pw = getpwnam(user);
- if (pw == NULL) {
- reply("Unknown user %s.\n", user);
- return(-2);
- }
-
-#ifdef linux_softland
- spwd = getspnam(user);
- if (spwd == NULL) {
- reply("User %s has illegal shadow password\n",user);
- return(-2);
- }
-#endif /* linux_softland */
-
-#ifdef APOPWD1
-/** TEMPORARY APOLLO KLUDGE WHILE "crypt" DOESN'T WORK.. **/
-#define KLUDGE "-c /com/date >/dev/null 2>/dev/null"
-
- sprintf(buff, "%s %s %s %s %s","/com/login",user,"-lp", pass,KLUDGE);
- ret.w_status = system(buff);
- if (ret.w_Retcode) {
-#else
-#ifdef ACE
- acmd.acm_mode = CKUSR;
- acmd.acm_user = pw->pw_name;
- acmd.acm_clearpc = "";
- if (!acmlg(&acmd)) {
-/* The user has a SecurID card ...................... */
- int i;
-
- acmd.acm_clearpc = pass;
- if ((i = acmlg(&acmd))) {
- reply("Bad passcode for user %s: ACE error %d.\n",
- pw->pw_name, i);
- return(-11);
- }
- } else { /* apply the normal Unix password check ... */
-#endif /* ACE */
-
-#ifdef AFS
-
- irc=ka_UserAuthenticateGeneral(KA_USERAUTH_VERSION + KA_USERAUTH_DOSETPAG,
- user,
- (char *) 0,
- (char *) 0,
- pass,
- 0,
- 0, 0,
- &reason);
-
- if (irc!=0) printf("AFS authentication failed because %s\n", reason);
-
- if (irc) {
-
-#else
-
-#ifdef linux_softland
- xpasswd = pw_encrypt(pass,spwd->sp_pwdp);
-#else
- xpasswd = crypt(pass, pw->pw_passwd);
-#endif /* linux_softland */
- /* The strcmp does not catch null passwords! */
-#ifdef linux_softland
- if (spwd->sp_pwdp == '\0' || strcmp(xpasswd,spwd->sp_pwdp)) {
-#else
- if (*pw->pw_passwd == '\0' || strcmp(xpasswd,pw->pw_passwd)) {
-#endif /* linux_softland */
-
-#endif /* AFS */
-
-#endif /* APOPWD1 */
- reply("Bad password for user %s.\n", pw->pw_name);
- return(-3);
- }
-#ifdef ACE
- }
-#endif /* ACE */
-#ifdef HPUX
- if (setresgid(pw->pw_gid,pw->pw_gid,0)) {
-#else
-#ifdef IBMRT
- setgid(pw->pw_gid);
-#endif /* IBMRT */
- if (setegid(pw->pw_gid)) {
-#endif /* HPUX */
- reply("Can't setegid for user %s.\n", pw->pw_name);
- return(-4);
- }
-#ifndef NOINITGROUPS
- if (initgroups(pw->pw_name, pw->pw_gid)) {
- reply("Can't initgroups for user %s.\n", pw->pw_name);
- return(-5);
- }
-#endif /* NOINITGROUPS */
- if (chdir(pw->pw_dir)) {
-#ifdef HPUX
- setresuid(0,0,0);
-#else
- seteuid(0);
-#endif /* HPUX */
- reply("Can't set home directory '%s' for user %s.\n",
- pw->pw_dir, pw->pw_name);
- return(-6);
- }
-#endif /* OSK */
-
-/* SUCCESS.................................................. */
- reply("User %s accepted (in directory %s).\n",
- pw->pw_name, pw->pw_dir);
-#ifdef LOGFILE
- fclose(logfile); /* Do this while still root.. */
-#endif /* LOGFILE */
-#ifndef OSK
-#ifdef HPUX
- setresuid(pw->pw_uid,pw->pw_uid,0);
-#else
-#ifdef IBMRT
- setuid(pw->pw_uid);
-#endif /* IBMRT */
- seteuid(pw->pw_uid);
-#endif /* HPUX */
-#endif /* OSK */
- return(1);
-}
-
-#else /* VMS */
-
-int chpass(s, user, pass) /* For VMS only (yes, it's different) */
- int *s;
- char *user, *pass;
-{
- char *xpasswd, *crypt();
- struct passwd *pw;
-
- pw = getpwnam(user);
- if (pw == NULL) {
- sock_reply(s,"Unknown user %s.\n", user);
- return(-2);
- } else {
- xpasswd = vmscrypt(user, pass, pw->pw_encrypt, pw->pw_salt);
- /* The strcmp does not catch null passwords! */
- if (*pw->pw_passwd == '\0' || strcmp(xpasswd,pw->pw_passwd)) {
- sock_reply(s,"Bad password for user %s.\n", user);
- return(-3);
- }
- }
- if (setegid(pw->pw_gid) < 0) {
- sock_reply(s,"Can't setegid for user %s.\n", user);
- return(-4);
- }
-/*
- if (initgroups(pw->pw_name, pw->pw_gid) < 0) {
- sock_reply(s,"Can't initgroups for user %s.\n", user);
- return(-5);
- }
-*/
-
-/*
- * Beware: on VMS, chdir is effective only during image execution.
- * Otherwise, chdir is to be called in SUPER, EXEC or KERNEL mode.
- */
- if (chdir(pw->pw_dir)) {
- setuic(my_pw->pw_uic);
- sock_reply(s,"Can't set home directory for user %s.\n", user);
- return(-6);
- }
-
-/* Success.. */
- sock_reply(s,"User %s accepted.\n", user);
-#ifdef LOGFILE
- fclose(logfile); /* Do this while still root.. */
-#endif /* LOGFILE */
- if (seteuid(pw->pw_uid) < 0) {
- sock_reply(s,"Can't seteuid for user %s.\n", user);
- return(-7);
- }
-
-/* The following two routines to not currently work on the Alpha */
-#if !defined(CERNLIB_QMALPH)
-
- if (setuser(pw->pw_name) != 0) { /* Change user name */
- sock_reply(s,"Can't setuser for user %s.\n", user);
- return(-8);
- }
-
- if (setacct(pw->pw_account) != 0) { /* Change account */
- sock_reply(s,"Can't setacct for user %s.\n", user);
- return(-9);
- }
-
-#endif
-
- if (setid(pw->pw_uic) != 0) { /* Set rights identifiers */
- sock_reply(s,"Can't setid for user %s.\n", user);
- return(-12);
- }
-
- if (setpriv(pw->pw_priv) != 0) { /* Change privileges */
- sock_reply(s,"Can't setpriv for user %s.\n", user);
- return(-10);
- }
-
- return(1);
-}
-
-#endif /* VMS */
-#else
- int chpass(SOCKET *s,char *user, char *passwd){
- sock_reply(s,"User %s accepted.\n", user);
- printf(" logfile = %x \n",logfile);
-#ifdef LOGFILE
- if (logfile) fclose(logfile); /* Do this while still root.. */
- logfile = 0;
-#endif /* LOGFILE */
- return 1;
-#if 0
- HANDLE hToken;
- if (LogonUser(user,NULL,passwd,LOGON32_LOGON_BATCH,LOGON32_PROVIDER_DEFAULT, &hToken) == TRUE)
- {
- sock_reply(s,"User %s accepted.\n", user);
- CloseHandle(hToken);
- }
- else
- {
- sock_reply(s,"Bad password for user %s.\n", user);
- return -3;
- }
-
- return 1;
-#endif
- }
-
-#endif /* WIN32 */
-#endif /* IBM*/
-#endif /* AUTHENT */
-
-/* Provide all of ruserpass.c unless specifically omitted */
-
-#ifdef VMS
-/* Code from Unix RTL missing from VMS.... */
-/* "ruserpass.c" -- to obtain a user's remote name and password */
-/* Version hacked for VMS (and Wollongong) compatibility. (BS) */
-/* A VMS FTN calling program MUST call "vaxc$crtl_init" for getenv TO WORK */
-
-#include <stat.h>
-#include "sysreq/sgtty.h"
-
- static char usr[30], pss[30], myname[30];
-
-ruserpass(host, aname, apass)
- char *host, **aname, **apass;
-{
- struct sgttyb sgttyb_val;
-
- if (*aname == NULL || *apass == NULL)
- rnetrc(host, aname, apass);
- if (*aname == NULL) {
- char *c = myname;
- strcpy(myname, getenv("USER"));
- while (*c) { *c = tolower(*c); c++; }
- fprintf(stderr, "Name (%s:%s): ", host, myname);
- if (fgets(usr, sizeof(usr), stdin) == NULL) goto fatal;
- if (*usr == '\n') {
- strcpy(usr, myname);
- } else
- usr[strlen(usr)-1] = '\0'; /* convert newline */
- *aname = usr;
- }
- if (*aname && *apass == NULL) {
- /* FHE library needed for this echo-manipulation on VMS..... */
- if (gtty(0, &sgttyb_val)) {
- perror("gtty");
- goto fatal;
- }
- sgttyb_val.sg_flags |= TT$M_NOECHO; /* turn off echo */
- if (stty(0, &sgttyb_val)) {
- perror("stty(0)");
- goto fatal;
- }
- fprintf(stderr, "Password (%s:%s): ", host, *aname);
- if (fgets(pss, sizeof(pss), stdin) == NULL) goto fatal1;
- fprintf(stdout,"\n");
- sgttyb_val.sg_flags &= ~(TT$M_NOECHO); /* restore echo */
- if (stty(0, &sgttyb_val)) {
- perror("stty");
- goto fatal;
- }
- pss[strlen(pss)-1] = '\0'; /* convert newline */
- *apass = pss;
- }
- return;
-fatal1:
- sgttyb_val.sg_flags &= ~(TT$M_NOECHO); /* restore echo */
- stty(0, &sgttyb_val);
-fatal:
- fprintf(stderr, "Fatal input error.\n");
- exit(1);
-}
-
-rnetrc(host, aname, apass)
- char *host, **aname, **apass;
-{
-
- static FILE *cfile;
- char rcline[100];
- char *hdir, buf[100], mach[30];
- struct stat stb;
-
- hdir = getenv("HOME");
- if (hdir == NULL)
- hdir = ".";
- sprintf(buf, "%sftplogin.", hdir); /* Using the TWG FTPLOGIN file */
- cfile = fopen(buf, "r");
- if (cfile == NULL) {
- if (errno != ENOENT)
- perror(buf);
- return;
- }
-
-/* Note that the format of the TWG "ftplogin" file is simpler than .netrc */
-
- while (fgets(rcline, sizeof(rcline), cfile) != NULL) {
-
- if (sscanf(rcline, "%s %s %s", mach, usr, pss) != 3
- || strcmp(host, mach)) continue;
-
- *aname = usr; /* now we have a user on the right machine */
-
- if (!strcmp(pss, "-")) break;
-
-/* Have a hit and a "real" password: check mode/ownership & warn if bad.. */
-/* (No good on VMS as no bits for group/world r/w/x are provided........)
-#define RWXRWX 077
-
- if (fstat(fileno(cfile), &stb) >= 0
- && (stb.st_mode & RWXRWX) != 0) {
- fprintf(stderr,
- "WARNING - file: %s insufficiently protected.\n", buf);
- fprintf(stderr,
- " - Remove password or restrict its access.\n");
- break;
- }
- ..(No good on VMS as no bits for group/world r/w/x are provided........) */
-
- *apass = pss; /* all OK */
- break;
- }
- fclose(cfile);
-}
-#else /* ^VMS */
-
-#ifndef NORUSERPASS
-
-#define DEFAULT 1
-#define LOGIN 2
-#define PASSWD 3
-#define NOTIFY 4
-#define WRITE 5
-#define YES 6
-#define NO 7
-#define COMMAND 8
-#define FORCE 9
-#define ID 10
-#define MACHINE 11
-
-static char tokval[100];
-
-static struct toktab {
- char *tokstr;
- int tval;
-} toktab[]= {
- "default", DEFAULT,
- "login", LOGIN,
- "password", PASSWD,
- "notify", NOTIFY,
- "write", WRITE,
- "yes", YES,
- "y", YES,
- "no", NO,
- "n", NO,
- "command", COMMAND,
- "force", FORCE,
- "machine", MACHINE,
- 0, 0
-};
-
-#ifdef IBMMVS
-static FILE *cfile;
-
-ruserpass(host, aname, apass)
- char *host, **aname, **apass;
-{
- int i1,i2,i3;
- int i = 0,ch;
- char *myname;
- char buff[100];
- char buff1[10];
- char buff2[100];
- char buff3[100];
-
- if (*aname == 0 || *apass == 0)
- rnetrc(host, aname, apass);
-
- if (*aname == 0) {
- *aname = malloc(101);
- JOBNAM(buff1);
- buff1??(4??) = '\0';
- myname = buff1;
- sprintf(buff, "Name (%s:%s): ", host, myname);
- printf("%s",buff);
- /* ch=getchar(); */ /* first character after printf is \n */
- for(i=0;(i<99) && ((ch=getchar()) != EOF) &&(ch!='\n') ; i++)
- buff2??(i??) = ch;
- buff2??(i??) = '\0';
- if (i == 0 )
- strcpy(*aname, myname);
- else
- strcpy(*aname, buff2);
- }
-
- if ( *aname && *apass == 0 ) {
- *apass = malloc(101);
- sprintf(buff, "Password (%s:%s): ", host, *aname);
- i1 = strlen(buff);
- i2 = 99;
- i3 = 0;
- buff3??(0??) = '\0';
- while (strlen(buff3) == 0) {
- GETINH(buff,i1,buff3,i2,i3);
- for (i = 0 ; ((i < 99) && buff3??(i??) != ' ') ;i++);
- buff3??(i??) = '\0';
- }
- strcpy(*apass, buff3);
- }
-}
-#endif /* IBMMVS */
-
-#ifdef IBMVM
-static FILE *cfile;
-
-ruserpass(host, aname, apass)
- char *host, **aname, **apass;
-{
- char *myname;
- char buff[100];
-
- if (*aname == 0 || *apass == 0)
- rnetrc(host, aname, apass);
-/*rintf(stderr,"host = %s aname = %s apass = %s\n",host,*aname,*apass);*/
- if (*aname == 0) {
- myname = getlogin();
- sprintf(buff, "Name (%s:%s): ", host, myname);
- *aname = LNRD(buff);
- if ((*aname)[0] == '\0')
- *aname = myname;
- }
- if (*aname && *apass == 0) {
- sprintf(buff, "Password (%s:%s): ", host, *aname);
- *apass = LNRDPAS(buff);
- }
-}
-#endif /* IBMVM */
-
-#ifdef IBM
-
-static
-rnetrc(host, aname, apass)
- char *host, **aname, **apass;
-{
- char buf[BUFSIZ];
- int t;
-
-#ifdef IBMVM
- strcpy(buf, "DOT.NETRC.A0");
-#else
- strcpy(buf, "DOT.NETRC");
-#endif
-
-#if defined(__APPLE__) || __GNUC__ > 3
-static rnetrc(char *host, char **aname, char **apass);
-static token();
-static void catch();
-#endif
-
-
- cfile = fopen(buf, "r");
- if (cfile == NULL) {
- if (errno != ENOENT)
- /* perror(buf); */
- return;
- }
-next:
- while ((t = token())) switch(t) {
-
- case DEFAULT:
- (void) token();
- continue;
-
- case MACHINE:
- if (token() != ID || strcmp(host, tokval))
- continue;
- while ((t = token()) && t != MACHINE) switch(t) {
-
- case LOGIN:
- if (token())
- if (*aname == 0) {
- *aname = malloc(strlen(tokval) + 1);
- strcpy(*aname, tokval);
- } else {
- if (strcmp(*aname, tokval))
- goto next;
- }
- break;
- case PASSWD:
- if (token() && *apass == 0) {
- *apass = malloc(strlen(tokval) + 1);
- strcpy(*apass, tokval);
- }
- break;
- case COMMAND:
- case NOTIFY:
- case WRITE:
- case FORCE:
- (void) token();
- break;
- default:
- fprintf(stderr, "Unknown .netrc option %s\n", tokval);
- break;
- }
- goto done;
- }
-done:
- fclose(cfile);
-}
-
-#else /* ^IBM */
-
-#if defined(CERNLIB_V93B)
-
-#include <sys/types.h>
-#include <sys/stat.h>
-#include <errno.h>
-
-char *malloc(), *index(), *getpass(), *getlogin();
-static FILE *cfile;
-
-ruserpass(host, aname, apass)
- char *host, **aname, **apass;
-{
-
- if (*aname == 0 || *apass == 0)
- rnetrc(host, aname, apass);
- if (*aname == 0) {
- char *myname = getlogin();
- *aname = malloc(16);
- printf("Name (%s:%s): ", host, myname);
- fflush(stdout);
- if (read(2, *aname, 16) <= 0)
- exit(1);
- if ((*aname)[0] == '\n')
- *aname = myname;
- else
- if (index(*aname, '\n'))
- *index(*aname, '\n') = 0;
- }
- if (*aname && *apass == 0) {
- printf("Password (%s:%s): ", host, *aname);
- fflush(stdout);
- *apass = getpass("");
- }
-}
-
-#endif
-
-#if defined(__APPLE__) || __GNUC__ > 3
-static rnetrc(char *host, char **aname, char **apass);
-static token();
-static void catch();
-#endif
-
-
-#include <sys/types.h>
-#include <sys/stat.h>
-#if !defined(NEXT) && !defined(_WIN32)
-#include <pwd.h>
-#endif /* ^NEXT */
-#include <errno.h>
-
-char *ku_pros( /* char *prompt, char *default */ );
-char *ku_prop( /* char *prompt */ );
-
-#ifndef _WIN32
-#if __GNUC__ < 3
- char *malloc(), *index(), *getpass(), *getuid();
-#endif
-#endif
-
-static FILE *cfile;
-
-ruserpass(host, aname, apass)
- char *host, **aname, **apass;
-{
-
- if (*aname == 0 || *apass == 0)
- rnetrc(host, aname, apass);
- if (*aname == 0) {
- char prompt[80];
- char *answ;
-#ifndef _WIN32
- char *myname;
- uid_t uid;
- struct passwd *pwd;
- uid = getuid();
- pwd = getpwuid(uid);
- myname = pwd->pw_name;
-#else
- char myname[30];
- int lmyname = sizeof(myname);
- GetUserName(myname,&lmyname);
-#endif
- sprintf(prompt, "Name (%s:%s):", host, myname);
- answ = ku_pros(prompt, NULL);
- if( answ != NULL ) {
- if( answ[0] == '\0' )
- answ = myname;
- *aname = strcpy( malloc(strlen(answ)+1), answ );
- }
- }
- if (*aname && *apass == 0) {
- char prompt[80];
- char *answ;
- sprintf(prompt, "Password (%s:%s):", host, *aname);
- answ = ku_prop(prompt);
- if( answ != NULL ) {
- *apass = strcpy( malloc(strlen(answ)+1), answ );
- }
- }
-}
-
-static
-rnetrc(host, aname, apass)
- char *host, **aname, **apass;
-{
- char *hdir, buf[BUFSIZ];
- int t;
-#ifndef _WIN32
- struct stat stb;
- extern int errno;
-#else
- struct _stat stb;
-#endif
- char *getenv();
-
- hdir = getenv("HOME");
- if (hdir == NULL)
- hdir = ".";
- sprintf(buf, "%s/.netrc", hdir);
- cfile = fopen(buf, "r");
- if (cfile == NULL) {
- if (errno != ENOENT)
- perror(buf);
- return;
- }
-next:
- while ((t = token())) switch(t) {
-
- case DEFAULT:
- (void) token();
- continue;
-
- case MACHINE:
- if (token() != ID || strcmp(host, tokval))
- continue;
- while ((t = token()) && t != MACHINE) switch(t) {
-
- case LOGIN:
- if (token())
- if (*aname == 0) {
- *aname = malloc(strlen(tokval) + 1);
- strcpy(*aname, tokval);
- } else {
- if (strcmp(*aname, tokval))
- goto next;
- }
- break;
- case PASSWD:
- if (fstat(fileno(cfile), &stb) >= 0
- && (stb.st_mode & 077) != 0) {
- fprintf(stderr, "Error - .netrc file not correct mode.\n");
- fprintf(stderr, "Remove password or correct mode.\n");
- exit(1);
- }
- if (token() && *apass == 0) {
- *apass = malloc(strlen(tokval) + 1);
- strcpy(*apass, tokval);
- }
- break;
- case COMMAND:
- case NOTIFY:
- case WRITE:
- case FORCE:
- (void) token();
- break;
- default:
- fprintf(stderr, "Unknown .netrc option %s\n", tokval);
- break;
- }
- goto done;
- }
-done:
- fclose(cfile);
-}
-
-#endif /* IBM*/
-
-#ifdef _WIN32
- static FILE *cfile;
-#endif
-
-static
-token()
-{
-
- char *cp;
- int c;
- struct toktab *t;
-
- if (feof(cfile))
- return (0);
- while ((c = getc(cfile)) != EOF &&
- (c == '\n' || c == '\t' || c == ' ' || c == ','))
- continue;
- if (c == EOF)
- return (0);
- cp = tokval;
- if (c == '"') {
- while ((c = getc(cfile)) != EOF && c != '"') {
- if (c == '\\')
- c = getc(cfile);
- *cp++ = c;
- }
- } else {
- *cp++ = c;
- while ((c = getc(cfile)) != EOF
- && c != '\n' && c != '\t' && c != ' ' && c != ',') {
- if (c == '\\')
- c = getc(cfile);
- *cp++ = c;
- }
- }
- *cp = 0;
- if (tokval[0] == 0)
- return (0);
- for (t = toktab; t->tokstr; t++)
- if (!strcmp(t->tokstr, tokval))
- return (t->tval);
- return (ID);
-}
-
-#if !defined(IBM) && !defined(_WIN32)
-/* I provide "getpass" myself as standard version truncates to 8 characters */
-#include <sys/ioctl.h>
-#if defined(CBREAK) || defined(__APPLE__)
-#define BSDTTY /* First find out if BSD or SYSV terminal handling.. */
-#endif
-
-#ifndef BSDTTY
-#include <termio.h>
-#else
-#include <sgtty.h>
-#endif
-
-#if !defined(__convexc__) && !defined(__APPLE__) && __GNUC__ < 3
-extern int kill(), ioctl(), getpid();
-#endif /* __convexc__ */
-static int intrupt;
-
-/*** NOTE MAXPASSWD IS DEFINED AS 8 IN ALL STANDARD UNIX SYSTEMS, BUT THIS
- *** GIVES US PROBLEMS INTERWORKING WITH VMS AND CRAY-SECURID SYSTEMS. ***/
-#define MAXPASSWD 20 /* max significant characters in password */
-
-char *
-getpass(prompt)
-char *prompt;
-{
-#ifndef BSDTTY
- struct termio ttyb;
- unsigned short flags;
-#else
- struct sgttyb ttyb;
- int flags;
-#endif
- register char *p;
- register int c;
- FILE *fi;
- static char pbuf[ MAXPASSWD + 1 ];
-#if !defined(__APPLE__)
- void (*sig)(), catch();
-#else
- void (*sig)();
-#endif
-
- if((fi = fopen("/dev/tty", "r")) == NULL)
- return((char*)NULL);
- setbuf(fi, (char*)NULL);
- sig = signal(SIGINT, catch);
- intrupt = 0;
-#ifndef BSDTTY
- (void) ioctl(fileno(fi), TCGETA, &ttyb);
- flags = ttyb.c_lflag;
- ttyb.c_lflag &= ~(ECHO | ECHOE | ECHOK | ECHONL);
- (void) ioctl(fileno(fi), TCSETAF, &ttyb);
-#else
- gtty(fileno(fi), &ttyb);
- flags = ttyb.sg_flags;
- ttyb.sg_flags &= ~ECHO;
- stty(fileno(fi), &ttyb);
-#endif
- (void) fputs(prompt, stderr);
- p = pbuf;
- while( !intrupt &&
- (c = getc(fi)) != '\n' && c != '\r' && c != EOF ) {
- if(p < &pbuf[ MAXPASSWD ])
- *p++ = c;
- }
- *p = '\0';
-#ifndef BSDTTY
- ttyb.c_lflag = flags;
- (void) ioctl(fileno(fi), TCSETAW, &ttyb);
-#else
- ttyb.sg_flags = flags;
- stty(fileno(fi), &ttyb);
-#endif
- (void) putc('\n', stderr);
- (void) signal(SIGINT, sig);
- if(fi != stdin)
- (void) fclose(fi);
- if(intrupt)
- (void) kill(getpid(), SIGINT);
- return(pbuf);
-}
-
-static void
-catch()
-{
- ++intrupt;
-}
-#endif /* ^IBM*/
-#endif /* NORUSERPASS */
-#endif /* VMS */
-
-/* I provide "rexec" myself as standard version does not allow IP addresses */
-
-#if defined(CERNLIB_SOLARIS)
-/* Solaris headers clash with an old style definition */
-rexec(char **ahost, unsigned short rport, char *name,
- char *pass, char *cmd, int *fd2p)
-#else
-# ifdef linux
-_rexec(ahost, rport, name, pass, cmd, fd2p)
-# else
-rexec(ahost, rport, name, pass, cmd, fd2p)
-# endif /* linux */
-
- char **ahost;
- int rport;
- char *name, *pass, *cmd;
- int *fd2p;
-#endif
-{
-#ifdef IBM
- extern char asciitoebcdic[]; /* translation tables */
- extern char ebcdictoascii[];
-#endif /* IBM */
- int s, timo = 1;
- struct sockaddr_in sin;
- char c;
- short port;
- struct hostent *hp;
- unsigned long addr;
-
- if ((addr = inet_addr(*ahost)) != -1) { /* Permit IP addresses */
- sin.sin_addr.s_addr = addr;
- } else {
- hp = gethostbyname(*ahost);
- if (hp == 0) {
- fprintf(stderr, "%s: unknown host\n", *ahost);
- return (-1);
- }
-/* NOT NICE *ahost = hp->h_name; THIS IS NOT NICE */
- }
- ruserpass(*ahost, &name, &pass);
-
-retry:
- s = socket(AF_INET, SOCK_STREAM, 0);
- if (s < 0) {
-#if defined(IBM) || defined(_WIN32)
- tcperror("rexec: socket");
-#else
- perror("rexec: socket");
-#endif /* IBM */
- return (-1);
- }
- sin.sin_family = AF_INET;
- sin.sin_port = (short)rport;
- if (addr != -1) { /* Permit IP addresses */
- sin.sin_addr.s_addr = addr;
- } else {
- sin.sin_addr.s_addr =
- ((struct in_addr *)(hp->h_addr))->s_addr;
-/* bcopy(hp->h_addr, (caddr_t)&sin.sin_addr, hp->h_length); */
- }
- if (connect(s, &sin, sizeof(struct sockaddr_in)) == SOCKET_ERROR ) {
-#ifndef _WIN32
- if (errno == ECONNREFUSED && timo <= 16) {
- (void) close(s);
- sleep(timo);
- timo *= 2;
- goto retry;
- }
-#else
- if (WSAGetLastError() == WSAECONNREFUSED
- && timo <= 16) {
- (void) closesocket(s);
- sleep(timo);
- timo *= 2;
- goto retry;
- }
-#endif
-
-#if defined(IBM) || defined(_WIN32)
- tcperror("rexec: connect");
-#else
- perror("rexec: connect");
-#endif /* IBM */
- return (-1);
- }
- if (fd2p == 0) {
- (void) send(s, "", 1, 0);
- port = 0;
- } else {
- fprintf(stderr, "Control channel not implemented\n");
- goto bad;
- }
-#ifdef IBM
- CMXLATE(name,ebcdictoascii,strlen(name));
- CMXLATE(pass,ebcdictoascii,strlen(pass));
- CMXLATE(cmd,ebcdictoascii,strlen(cmd));
-#endif /* IBM */
- (void) send(s, name, strlen(name) + 1, 0);
- (void) send(s, pass, strlen(pass) + 1, 0);
- (void) send(s, cmd, strlen(cmd) + 1, 0);
- if (recv(s, &c, 1, 0) != 1) {
-#if defined(IBM) || defined(_WIN32)
- tcperror("rexec recv");
-#else
- perror("rexec recv");
-#endif /* IBM */
- goto bad;
- }
- if (c != 0) {
- fprintf(stderr,"c = ");
- while (recv(s, &c, 1, 0) == 1) {
-#ifdef IBM
- CMXLATE(&c,asciitoebcdic,1);
-#endif /* IBM */
- fprintf(stderr,"%c",c);
- (void) send(2, &c, 1, 0);
- if (c == '\n')
- break;
- }
- fprintf(stderr,"\n ended");
- goto bad;
- }
- return (s);
-bad:
- if (port)
- (void) close(*fd2p);
- (void) close(s);
- return (-1);
-}
-
-
-/******** INTERFACE ROUTINES TO HANDLE VARIOUS NAMING CONVENTIONS *********/
-
-/*** COMPATIBILITY-MODE: FULL-LENGTH NAMES AS USED IN EARLY "TCPAW" ***/
-
-#ifndef OSK
-#ifndef IBM
-int inetd_sock_setup(in, out)
-int *in, *out;
-{
- return(isetup(in, out));
-}
-
-int inetd_sock_close(sock)
-int *sock;
-{
- return(iclose(sock));
-}
-#endif /* ^IBM*/
-#endif /* OSK */
-
-int server_sock_setup(in, out)
-int *in, *out;
-{
- return(ssetup(in, out));
-}
-
-#ifdef VMS
-int client_sock_setup(sysdes, in, out, srvdes) /* VMS CASE... */
-struct dsc$descriptor_s *sysdes;
-int *in, *out;
-struct dsc$descriptor_s *srvdes;
-{
- return(csetup(sysdes, in, out, srvdes));
-}
-#else
-#ifdef APOFTN
-int client_sock_setup(system, in, out, srvc, s_ln, c_ln) /* APOLLO FTN CASE */
-char *system; /* (PRE-SR9 ONLY) */
-int *in, *out;
-char *srvc;
-short *s_ln, *c_ln; /* dummy arguments */
-{
- return(csetup(system, in, out, srvc, s_ln, c_ln));
-}
-#else
-int client_sock_setup(system, in, out, srvc) /* UNIX ETC... */
-char *system;
-int *in, *out;
-char *srvc;
-{
- return(csetup(system, in, out, srvc));
-}
-#endif /* APOFTN */
-#endif /* VMS */
-
-int sock_close(sock)
-int *sock;
-{
- return(sclose(sock));
-}
-
-#ifdef VMS
-int sock_sendstr(sock, bufdes, m) /* VMS CASE... */
-int *sock;
-struct dsc$descriptor_s *bufdes;
-int *m;
-{
- return(ssendstr(sock, bufdes, m));
-}
-#else
-int sock_sendstr(sock, buf, m)
-int *sock;
-char *buf;
-int *m;
-{
- return(ssendstr(sock, buf, m));
-}
-#endif /* VMS */
-
-#ifdef VMS
-int sock_recvstr(sock, bufdes, m) /* VMS CASE... */
-int *sock;
-struct dsc$descriptor_s *bufdes;
-int *m;
-{
- return(srecvstr(sock, bufdes, m));
-}
-#else
-int sock_recvstr(sock, buf, m)
-int *sock;
-char *buf;
-int *m;
-{
- return(srecvstr(sock, buf, m));
-}
-#endif /* VMS */
-
-int sock_send(sock, buf, m)
-int *sock;
-char *buf;
-int *m;
-{
- return(ssend(sock, buf, m));
-}
-
-int sock_recv(sock, buf, m)
-int *sock;
-char *buf;
-int *m;
-{
- return(srecv(sock, buf, m));
-}
-
-/* #ifndef apollo */
-#if !defined(apollo) || defined(APOLLO_F77)
-/*** UNIX routines f77 <-> C to handle underlines generated by FORTRAN ***/
-/*** CASE FOR SYSTEMS USING FULL-LENGTH NAMES (WITH UNDERLINES) IN F77 ***/
-
-int client_sock_setup_(system, in, out, srvc)
-char *system;
-int *in, *out;
-char *srvc;
-{
- return(csetup(system, in, out, srvc));
-}
-
-#ifndef OSK
-#ifndef IBM
-int inetd_sock_setup_(in, out)
-int *in, *out;
-{
- return(isetup(in, out));
-}
-
-int inetd_sock_close_(sock)
-int *sock;
-{
- return(iclose(sock));
-}
-#endif /* ^IBM*/
-#endif /* OSK */
-
-int server_sock_setup_(in, out)
-int *in, *out;
-{
- return(ssetup(in, out));
-}
-
-int sock_close_(sock)
-int *sock;
-{
- return(sclose(sock));
-}
-
-int sock_sendstr_(sock, buf, m)
-int *sock;
-char *buf;
-int *m;
-{
- return(ssendstr(sock, buf, m));
-}
-
-int sock_recvstr_(sock, buf, m)
-int *sock;
-char *buf;
-int *m;
-{
- return(srecvstr(sock, buf, m));
-}
-
-int sock_send_(sock, buf, m)
-int *sock;
-char *buf;
-int *m;
-{
- return(ssend(sock, buf, m));
-}
-
-int sock_recv_(sock, buf, m)
-int *sock;
-char *buf;
-int *m;
-{
- return(srecv(sock, buf, m));
-}
-
-/*** CASE FOR SYSTEMS USING SHORTENED NAMES (WITHOUT UNDERLINES) IN F77 ***/
-/*** (NEEDED FOR SOME ULTRIX VERSIONS....) ***/
-
-int csetup_(system, in, out, srvc)
-char *system;
-int *in, *out;
-char *srvc;
-{
- return(csetup(system, in, out, srvc));
-}
-#ifndef OSK
-#ifndef IBM
-
-int isetup_(in, out)
-int *in, *out;
-{
- return(isetup(in, out));
-}
-
-int iclose_(sock)
-int *sock;
-{
- return(iclose(sock));
-}
-#endif /* ^IBM*/
-#endif /* OSK */
-
-int ssetup_(in, out)
-int *in, *out;
-{
- return(ssetup(in, out));
-}
-
-int sclose_(sock)
-int *sock;
-{
- return(sclose(sock));
-}
-
-int ssendstr_(sock, buf, m)
-int *sock;
-char *buf;
-int *m;
-{
- return(ssendstr(sock, buf, m));
-}
-
-int srecvstr_(sock, buf, m)
-int *sock;
-char *buf;
-int *m;
-{
- return(srecvstr(sock, buf, m));
-}
-
-int ssend_(sock, buf, m)
-int *sock;
-char *buf;
-int *m;
-{
- return(ssend(sock, buf, m));
-}
-
-int srecv_(sock, buf, m)
-int *sock;
-char *buf;
-int *m;
-{
- return(srecv(sock, buf, m));
-}
-#endif /* apollo */
-
-#if defined(CRAYFTN)
-/**** SPECIAL VERSION FOR CRAY CFT77 */
-
-int CSETUP(system, in, out, srvc)
-_fcd system;
-int *in, *out;
-_fcd srvc;
-{
- return(csetup(system, in, out, srvc));
-}
-
-int type_of_call ISETUP(in, out)
-int *in, *out;
-{
- return(isetup(in, out));
-}
-
-int type_of_call ICLOSE(sock)
-SOCKET *sock;
-{
- return(iclose(sock));
-}
-
-int type_of_call SSETUP(in, out)
-int *in, *out;
-{
- return(ssetup(in, out));
-}
-
-int type_of_call SCLOSE(sock)
-int *sock;
-{
- return(sclose(sock));
-}
-
-int SSENDSTR(sock, buf, m)
-int *sock;
-_fcd buf;
-int *m;
-{
- return(ssendstr(sock, buf, m));
-}
-
-int SRECVSTR(sock, buf, m)
-int *sock;
-_fcd buf;
-int *m;
-{
- return(srecvstr(sock, buf, m));
-}
-
-int type_of_call SSEND(sock, buf, m)
-int *sock;
-char *buf;
-int *m;
-{
- return(ssend(sock, buf, m));
-}
-
-int type_of_call SRECV(sock, buf, m)
-int *sock;
-char *buf;
-int *m;
-{
- return(srecv(sock, buf, m));
-}
-#endif /* CRAYFTN */
-
-#ifdef CERNLIB_MSSTDCALL
-/**** SPECIAL VERSION FOR Microsoft Powerstation Fortran ***/
-
-int type_of_call CSETUP(system, lsys, in, out, srvc, lsrvc)
-char *system;
-int lsys, lsrvc;
-int *in, *out;
-char *srvc;
-{
- return(csetup(system, lsys, in, out, srvc,lsrvc));
-}
-
-int type_of_call ISETUP(in, out)
-int *in, *out;
-{
- return(isetup(in, out));
-}
-
-int type_of_call ICLOSE(sock)
-int *sock;
-{
- return(iclose(sock));
-}
-
-int type_of_call SSETUP(in, out,port)
-int *in, *out,*port;
-{
- return(ssetup(in, out, port));
-}
-
-int type_of_call SCLOSE(sock)
-int *sock;
-{
- return(sclose(sock));
-}
-
-int type_of_call SSENDSTR(sock, buf, lbuf, m)
-int *sock;
-char *buf;
-int lbuf;
-int *m;
-{
- return(ssendstr(sock, buf, lbuf, m));
-}
-
-int type_of_call SRECVSTR(sock, buf, lbuf, m)
-int *sock;
-char *buf;
-int lbuf;
-int *m;
-{
- return(srecvstr(sock, buf, lbuf, m));
-}
-
-int type_of_call SSEND(sock, buf, m)
-int *sock;
-char *buf;
-int *m;
-{
- return(ssend(sock, buf, m));
-}
-
-int type_of_call SRECV(sock, buf, m)
-int *sock;
-char *buf;
-int *m;
-{
- return(srecv(sock, buf, m));
-}
-#endif /* Microsoft Fortran */
-
-
-#ifdef OSK
-/**** SPECIAL VERSION FOR OS9 ONLY ***/
-
-char cserv[80],chost[80];
-
-int CLIENT_SOCK_SETUP(host,isock,osock,service)
-char *host, *service;
-int *isock;
-int *osock;
-{
- return(client_sock_setup(strfc(chost,host,80),isock,osock,
- strfc(cserv,service,80)));
-}
-
-int SERVER_SOCK_SETUP(isock,osock)
-int *isock;
-int *osock;
-{
- return(server_sock_setup(isock,osock));
-}
-
-int SOCK_CLOSE(sock)
-int *sock;
-
-{
- return(sock_close(sock));
-}
-
-int SOCK_SENDSTR(sock, buf, m)
-int *sock;
-char *buf;
-int *m;
-
-{
- return(sock_sendstr(sock, buf, m));
-}
-
-int SOCK_RECVSTR(sock, buf, m)
-int *sock;
-char *buf;
-int *m;
-
-{
- return(sock_recvstr(sock, buf, m));
-}
-
-int SOCK_SEND(sock, buf, m)
-int *sock;
-char *buf;
-int *m;
-
-{
- return(sock_send(sock, buf, m));
-}
-
-int SOCK_RECV(sock, buf, m)
-int *sock;
-char *buf;
-int *m;
-
-{
- return(sock_recv(sock, buf, m));
-}
-#endif /* OSK */
-
-#ifdef IBM
-int cinit(int dummy)
-{
-/* fprintf(stderr,"Initializing C environment...\n");*/
- return(0); /*to init the c environment*/
-}
-
-/* get length of a Fortran string given as argument */
-int gtlnfstr(plistaddr,argposition)
-void *plistaddr; /* &first_arg */
-int argposition; /* n for nth argument */
-{
- int **secplist;
- int *poffset;
- char *bzstr;
-
- poffset =(int *)plistaddr;
- poffset = poffset - 1;
- bzstr =(char *)(poffset -1);
- if (!strcmp(bzstr,"BZ")){
- secplist =(int **)((char *)plistaddr + *poffset);
- return( **(secplist + argposition - 1));
- }
- else{
- return(-1); /* no secondary plist when no character*n arg */
- }
-}
-#endif /* IBM */
-
-
-#ifdef IBMMVS
-
-/* systemf not found in cspack, so added for IBMMVS */
-
-int systemf(command)
-char *command;
-
-{
- char *c;
- int i, j, k;
-
-#ifdef DEBUG
- printf(" systemf: command = '%s' \n",command);
-#endif /* DEBUG */
-
- /*Terminate correctly the host & service strings passed by FTN..*/
- j = strlen(command);
- for (k=0; k<j; k++) if (command[k] == ' ') {command[k] = '\0'; break;}
- /* And map to lower case... */
- c = command; while (*c) { if (isupper(*c)) *c = tolower(*c); c++; }
-
-#ifdef DEBUG
- printf(" systemf: command = '%s' \n",command);
-#endif /* DEBUG */
-
-
- i = system(command);
-
- return(0);
-}
-
-#endif /* IBMMVS */
-/* client to connect to tsosubd on mvs */
-int
-tsosub(ahost, rport, name, pass, cmd, sport)
- char **ahost;
- int rport;
- char *name, *pass, *cmd;
- unsigned short *sport;
-{
-#ifdef IBM
- extern char asciitoebcdic[]; /* translation tables */
- extern char ebcdictoascii[];
-#endif /*TEST */
- int s, timo = 1;
- struct sockaddr_in sin;
- char c;
- short port;
- struct hostent *hp;
- unsigned long addr;
- char buf[80];
- char cmdbuf[80];
-
-/* This fails on the Sun
- char machine[80] = "machine";
- char user[80] = "user";
- char tty [80] = "tty"; */
- char machine[80];
- char user[80];
- char tty [80];
- char cmvs_sport[80];
- char servreply[80];
-
-/* but this is ok */
-
- sprintf(machine,"%s","machine");
- sprintf(user,"%s","user");
- sprintf(tty,"%s","tty");
-
- if ((addr = inet_addr(*ahost)) != -1) { /* Permit IP addresses */
- sin.sin_addr.s_addr = addr;
- } else {
- hp = gethostbyname(*ahost);
- if (hp == 0) {
- fprintf(stderr, "%s: unknown host\n", *ahost);
- return (-1);
- }
- }
-
- ruserpass(*ahost, &name, &pass);
-
-retry:
- s = socket(AF_INET, SOCK_STREAM, 0);
- if (s < 0) {
-#ifdef IBM
- tcperror("tsosub: socket");
-#else
- perror("tsosub: socket");
-#endif /* IBM */
- return (-1);
- }
- sin.sin_family = AF_INET;
- sin.sin_port = (short)rport;
- if (addr != -1) { /* Permit IP addresses */
- sin.sin_addr.s_addr = addr;
- } else {
- sin.sin_addr.s_addr =
- ((struct in_addr *)(hp->h_addr))->s_addr;
-/* bcopy(hp->h_addr, (caddr_t)&sin.sin_addr, hp->h_length); */
- }
- if (connect(s, &sin, sizeof(struct sockaddr_in)) == SOCKET_ERROR) {
-#ifndef WIN32
- if (errno == ECONNREFUSED && timo <= 16) {
- (void) close(s);
- sleep(timo);
- timo *= 2;
- goto retry;
- }
-#else
- if (WSAGetLastError() == WSAECONNREFUSED && timo <= 16) {
- (void) closesocket(s);
- sleep(1000*timo);
- timo *= 2;
- goto retry;
- }
-#endif
-
-#ifdef IBM
- tcperror("tsosub: connect");
-#else
- perror("tsosub: connect");
-#endif /* IBM */
- return (-1);
- }
- port = 0;
-#ifdef IBM
- CMXLATE(machine,ebcdictoascii,strlen(machine));
- CMXLATE(user,ebcdictoascii,strlen(user));
- CMXLATE(tty,ebcdictoascii,strlen(tty));
- CMXLATE(name,ebcdictoascii,strlen(name));
- CMXLATE(pass,ebcdictoascii,strlen(pass));
- CMXLATE(cmd,ebcdictoascii,strlen(cmd));
-#endif /* IBM */
-
- if ( send(s, machine, strlen(machine) + 1, 0) < 0) {
-#ifdef IBM
- tcperror("tsosub: send machine");
-#else
- perror("tsosub: send machine");
-#endif /* IBM */
- goto bad;
- }
-
- if ( send(s, user, strlen(user) + 1, 0) < 0) {
-#ifdef IBM
- tcperror("tsosub: send user");
-#else
- perror("tsosub: send user");
-#endif /* IBM */
- goto bad;
- }
-
- if ( send(s, tty, strlen(tty) + 1, 0) < 0) {
-#ifdef IBM
- tcperror("tsosub: send tty");
-#else
- perror("tsosub: send tty");
-#endif /* IBM */
- goto bad;
- }
-
- if ( send(s, name, strlen(name) + 1, 0) < 0) {
-#ifdef IBM
- tcperror("tsosub: send name");
-#else
- perror("tsosub: send name");
-#endif /* IBM */
- goto bad;
- }
-
- if ( send(s, pass, strlen(pass) + 1, 0) < 0) {
-#ifdef IBM
- tcperror("tsosub: send pass");
-#else
- perror("tsosub: send pass");
-#endif /* IBM */
- goto bad;
- }
-
- if ( send(s, cmd, strlen(cmd) + 1, 0) < 0) {
-#ifdef IBM
- tcperror("tsosub: send cmd");
-#else
- perror("tsosub: send cmd");
-#endif /* IBM */
- goto bad;
- }
-
- sprintf(buf,"%i",*sport);
-#ifdef IBM
- CMXLATE(buf,ebcdictoascii,strlen(buf));
-#endif /* IBM */
- if ( send(s, buf, strlen(buf) + 1, 0) < 0 ) {
-#ifdef IBM
- tcperror("tsosub: send sport");
-#else
- perror("tsosub: send sport");
-#endif /* IBM */
- goto bad;
- }
-
-
- if (getstr(s,cmvs_sport,sizeof(cmvs_sport),"mvs_sport") <= 0) {
- goto bad;
- }
-
-#ifdef IBM
- CMXLATE(cmvs_sport,asciitoebcdic,strlen(cmvs_sport));
-#endif /* IBM */
-
- *sport = atoi(cmvs_sport);
-
- if (getstr(s,servreply,sizeof(servreply),"servreply") <= 0) {
- goto bad;
- }
-
-#ifdef IBM
- CMXLATE(servreply,asciitoebcdic,strlen(servreply));
- CMXLATE(cmd,asciitoebcdic,strlen(cmd));
-#endif /* IBM */
-
- fprintf(stderr,"%s\n",servreply);
-
- close(s);
-
- return (1);
-bad:
-
- close(s);
-
- return (-1);
-}
-
-getstr(sock,buf, cnt, errmesg)
-int *sock;
-char *buf;
-int cnt; /* sizeof() the char array */
-char *errmesg; /* in case error message required */
-{
- char c;
- int k = 0;
-
- do {
- if ( read(sock, &c, 1) != 1) {
- printf("Error or EOF while reading %s from socket.\n",
- errmesg);
- return(-1); /* error or EOF */
- }
- *buf++ = c;
- k++;
- if (--cnt == 0) {
- printf("%s too long from socket.\n", errmesg);
- return(-1);
- }
- } while (c!= 0); /* null byte terminates the string */
-
- return(k-1);
-
-}
-#endif
diff --git a/src/packlib/cspack/tcpaw/tcpaw.c.orig b/src/packlib/cspack/tcpaw/tcpaw.c.orig
deleted file mode 100644
index 0366470..0000000
--- a/src/packlib/cspack/tcpaw/tcpaw.c.orig
+++ /dev/null
@@ -1,3511 +0,0 @@
-/*
- * $Id: tcpaw.c,v 1.8 2005/03/21 13:01:38 mclareni Exp $
- *
- * $Log: tcpaw.c,v $
- * Revision 1.8 2005/03/21 13:01:38 mclareni
- * Remove conflicting redefinitions of malloc, ioctl, etc. which fail with gcc 3.4.3.
- *
- * Revision 1.7 1999/09/15 16:19:46 mclareni
- * Remove index definition, most compilers have it now
- *
- * Revision 1.6 1998/02/19 15:05:40 gunter
- * Remove a NT mod in pure VMS code: _stat changed back to stat
- *
- * Revision 1.5 1997/10/23 13:26:19 mclareni
- * NT mods
- *
- * Revision 1.3 1997/09/02 08:46:21 mclareni
- * WINNT mods, mostly cpp defines
- *
- * Revision 1.2 1996/04/02 22:42:04 thakulin
- * Make rexec function definition match the Solaris headers.
- *
- * Revision 1.1.1.1 1996/03/08 15:44:27 mclareni
- * Cspack
- *
- */
-#include "cspack/pilot.h"
-#if !defined(CERNLIB_IBM)||defined(CERNLIB_TCPSOCK)
-/*N.B. Must define sequence TCPLOG if a log file is required, e.g.*/
-/*#define LOGFILE "disk$dd:-ben.socks-serv.log"*/ /* VMS */
-/*#define LOGFILE "/user/brun/ben/serv.log" */ /* Apollo */
-/*#define LOGFILE "/h0/psh/zs.log" */ /* OS9 */
-/*#define LOGFILE "/tmp/serv.log" */ /* example*/
-#if defined(CERNLIB_IBMMVS)
-#pragma nosequence
-#pragma options (ALIAS)
-#endif
-
-#if defined(CERNLIB__DOC)
-/* TCP/IP PACKAGE FOR REMOTE-PAW AND SIMILAR APPLICATIONS.
-
- Ben M. Segal / CERN-CN/SW
-
- ben at cernvax.cern.ch
-
- ------------------------------------------------------
- | Version of: Jun.08, 1997 (FOR CERN PROGRAM LIBRARY)|
- ------------------------------------------------------
-
-***** THIS VERSION: The Windows Socket implmetation has been introduced
- 08/06/97 Valery Fine (fine at mail.cern.ch, Dubna, JINR)
-
-***** THIS VERSION: SecurID/ACE ADDED (Unicos6.0 Version)
- Removed limit of 8-char passwords (from "getpass").
-
-***** LAST VERSION: VM/CMS CODE ADDED (Ignacio Reguero / CERN-CN/SW)
-
-***** Documentation: "Installation and Use of the TCPAW Package",
- Ben M. Segal / CERN-CN-SW March 1991.
-*/
-#endif
-/* SYSTEM DEFINITIONS: */
-
-/* (VM, VMS, Apollo, HPUX, SGI, IBMRT, Sun, Cray, Ultrix, OS9 supported) */
-
-/* CUSTOMIZATION DEFINITIONS: */
-#define DEBUG /* Can remove from production versions */
-#define AUTHENT /* INVOKES USER AUTHENTICATION CODE: BUT NOTE... */
- /* "AUTHENT" MUST MATCH IN CLIENTS AND SERVERS !! */
-#define APOPAL /* (use this to select OPAL OS-9 special login) */
-/*#define APOPWD */ /* (use if Unix password crypt fails on Apollos) */
-/*#define APOSR9 */ /* (used only for Apollo FTN linking pre-SR10) */
-/*#define SERVLOG*/ /* (use to get a server logfile: NOT IN CLIENT!! */
-/*#define SOCKETS*/ /* (optional: mainly for testing) */
-/*#define XDEBUG */ /* (optional: BUT DON'T USE FOR INETD SERVERS) */
-/*#define CRAYC */ /* (used only for testing from C on Crays) */
-/*#define RESOLVE_VIA_LOOKUP */ /* VM: to force use of a hosts table only */
-/*#define NORUSERPASS */ /* (only to force use of std "ruserpass/getpass") */
-/* END OF DEFINITIONS */
-
-#if defined(CERNLIB_QCDEC)
-
-/* TCPAW.C must be compiled with /NOPREFIX /STANDARD=VAXC
- to avoid picking up the UCX socket routines. The following
- defines are required to resolve the named routines from the
- DECC$SHR shareable library.
-
- .. unless you are using DEC C V4, in which case, use /PREFIX=ANSI
- */
-
-#define chdir DECC$CHDIR
-#define close DECC$CLOSE
-#define cuserid DECC$CUSERID
-#define getpid DECC$GETPID
-#define read DECC$READ
-#define sleep DECC$SLEEP
-
-#define atoi DECC$ATOI
-#define ctime DECC$CTIME
-#define exit DECC$EXIT
-#define fclose DECC$FCLOSE
-#define fflush DECC$FFLUSH
-#define fgets DECC$FGETS
-#define fopen DECC$FOPEN
-#define getenv DECC$GETENV
-#define memset DECC$MEMSET
-#define perror DECC$PERROR
-#define strcmp DECC$STRCMP
-#define strcpy DECC$STRCPY
-#define strlen DECC$STRLEN
-#define strncmp DECC$STRNCMP
-#define time DECC$TIME
-#define tolower DECC$TOLOWER
-
-#endif
-
-#if defined(CERNLIB_IBMRT)
-#define IBMRT
-#endif
-#if defined(CERNLIB_HPUX)
-#define HPUX
-#endif
-#if defined(CERNLIB_SUN4)
-#define sun4
-#endif
-#if defined(CERNLIB_OS9)
-#define OSK
-#endif
-#if defined(CERNLIB_SGI)||defined(CERNLIB_MIPS)
-#ifndef sgi
-#define sgi
-#endif /* sgi */
-#endif
-#if defined(CERNLIB_IBMVM)
-#define IBMVM
-#define IBM
-#endif
-#if defined(CERNLIB_IBMMVS)
-#define MVS
-#define IBMMVS
-#define IBM
-#endif
-#if (defined(CERNLIB_CRAY))&&(defined(CERNLIB_UNIX))&&(defined(CERNLIB_ACE))
-#define ACE
-#endif
-
-
-
-#if defined(CERNLIB_IBMVM)||defined(CERNLIB_IBMMVS)
-#include "cspack/tcpsock.h"
-#endif
-
-#if defined(CERNLIB_IBMMVS)
-
-#define ssendstr SSENSTR
-#define srecvstr SRECSTR
-
-#endif
-
-#if defined(CERNLIB_IBM)
-#pragma csect(CODE,"TCPAWC")
-#pragma linkage(cinit,FORTRAN)
-#pragma linkage(isetup,FORTRAN)
-#pragma linkage(iclose,FORTRAN)
-#pragma linkage(csetup,FORTRAN)
-#pragma linkage(ssetup,FORTRAN)
-#pragma linkage(sclose,FORTRAN)
-#pragma linkage(srecv,FORTRAN)
-#pragma linkage(ssend,FORTRAN)
-#pragma linkage(SSENSTR,FORTRAN)
-#pragma linkage(SRECSTR,FORTRAN)
-#pragma linkage(CMXLATE,OS)
-#ifdef IBMVM
-#pragma linkage(CHPAS,OS)
-#pragma linkage(LNRD,OS)
-#pragma linkage(LNRDPAS,OS)
-#pragma linkage(GETUSR,OS)
-#pragma linkage(GETUNIQ,OS)
-#endif /* IBMVM */
-#ifdef IBMMVS
-#pragma linkage(GETINH,OS)
-#pragma linkage(JOBNAM,OS)
-#pragma linkage(SYSTEMF,FORTRAN) /* Normally in KERNLIB */
-#endif /* IBMMVS */
-#endif /* IBM */
-
-#ifdef cray
-#ifndef CRAYC
-#define CRAYFTN
-#endif /* CRAYC */
-#ifdef ACE
-#include "/usr/include/ace.h"
-#endif /* ACE */
-#endif /* cray */
-
-#ifdef sgi
-#define NOINITGROUPS
-#endif /* sgi */
-
-#ifdef apollo
-#ifdef APOPWD
-#define APOPWD1
-#endif /* APOPWD */
-#ifdef APOPAL
-#define APOPAL1
-#endif /* APOPAL */
-#ifdef APOSR9
-#define APOFTN
-#endif /* APOSR9 */
-#endif /* apollo */
-
-#include <stdio.h>
-#include <errno.h>
-#include <signal.h>
-#include <ctype.h>
-
-#ifdef AUTHENT
-#ifndef OSK
-
-#ifndef IBM
-#ifdef vms
-#include "sysreq/pwd_vms.h"
-#elif !defined(WIN32)
-#include <pwd.h>
-#endif /* vms */
-#endif /* ^IBM */
-
-#endif /* OSK */
-#endif /* AUTHENT */
-
-#ifdef linux_softland
-#include <shadow.h>
-#endif /* linux_softland */
-
-#ifdef CRAYFTN
-#include <fortran.h>
-#endif /* CRAYFTN */
-
-#ifdef VMS
-#include <iodef.h>
-#include <ssdef.h>
-#include <climsgdef.h>
-#include <descrip.h>
-#include <types.h>
-#include <socket.h>
-#include <in.h>
-#else
-#if defined(sgi) && defined(irix3)
-#include <bsd/sys/types.h>
-#include <bsd/sys/socket.h>
-#include <bsd/netinet/in.h>
-#else
-#ifdef OSK
-#include <time.h>
-#include <types.h>
-#include <socket.h>
-#include <in.h>
-#else
-
-# ifdef IBM
-
-# ifdef IBMVM
- extern int CHPAS();
- extern char *LNRD();
- extern char *LNRDPAS();
- extern char *GETUSR();
-# define getlogin GETUSR
- extern int GETUNIQ();
-# define getpid GETUNIQ
-# endif /* IBMVM */
-
-# ifdef IBMMVS
- extern void GETINH();
- extern void JOBNAM();
-# endif /* IBMMVS */
-
-/* #include <bsdtime.h> */
-/* #include <netdb.h> */
-
-#define ENOENT 67
-#define ECONNREFUSED 61
-#include <manifest.h>
-#include <stdlib.h>
-#include <time.h>
-#include <bsdtypes.h>
-#include <socket.h>
-#include <in.h>
-#include <string.h>
-#else
-#ifdef _WIN32
-# include <io.h>
-# include <process.h>
-# include <winsock.h>
-#else
-#include <sys/types.h>
-#include <sys/socket.h>
-#include <netinet/in.h>
-#ifndef IBMRT
-/* this is a kludge, one ought to fix the "prototypes" in this file */
-#include <string.h>
-#endif /* IBMRT */
-#endif /* WIN32 */
-#endif /* IBM */
-#endif /* OSK */
-#endif /* sgi */
-#endif /* VMS */
-
-#if defined(sgi) && defined(irix3)
-#include <bsd/netdb.h>
-#else
-#ifndef _WIN32
-#include <netdb.h>
-#endif /* WIN32 */
-#endif /* sgi,irix3 */
-
-#if defined(__osf__) && defined(__alpha)
-#include <sys/ioctl.h>
-#endif
-
-#ifndef SOCKET
-#define SOCKET int
-#endif
-
-#ifndef SOCKET_ERROR
-#define SOCKET_ERROR -1
-#endif
-
-#ifndef INVALID_SOCKET
-#define INVALID_SOCKET -1
-#endif
-
-#ifdef NOMEMSET
-#define memset(a,b,c) bzero(a,c) /* in case "memset" unknown (BS) */
-#endif /* NOMEMSET */
-
-#ifdef DEBUG /* DEBUG IMPLIES SOCKETS SUPPORT... */
-#define SOCKETS
-static char *Prog_Name = "tcpaw"; /* CUSTOMIZE THIS.. */
-#endif /* DEBUG */
-
-#ifdef DEBUG
-#ifdef SERVLOG /* DEBUG PLUS SERVLOG --> LOGFILE .. */
-#ifdef VMS
-#include "cspack/tcplog.h"
-/*#define LOGFILE "disk$dd:[ben.socks]serv.log" */ /* CUSTOMIZE THIS.. */
-#endif /* VMS */
-#ifdef apollo
-#include "cspack/tcplog.h"
-/*#define LOGFILE "/user/brun/ben/serv.log" */ /* CUSTOMIZE THIS.. */
-#endif /* apollo */
-#ifdef OSK
-#include "cspack/tcplog.h"
-/*#define LOGFILE "/h0/psh/zs.log" */ /* CUSTOMIZE THIS.. */
-#endif /* OSK */
-#ifndef LOGFILE
-#include "cspack/tcplog.h"
-/*#define LOGFILE "/tmp/serv.log" */ /* CUSTOMIZE THIS.. */
-#endif /* LOGFILE */
-#endif /* SERVLOG */
-#endif /* DEBUG */
-
-#ifdef _WIN32
-#define LOGFILE "/tmp/PawServ.log"
-#endif
-
-#ifdef LOGFILE
-static FILE *logfile;
-#endif /* LOGFILE */
-
-#ifdef XDEBUG
-#ifdef LOGFILE
-#define STDERR logfile
-#else
-#define STDERR stderr
-#endif /* LOGFILE */
-#endif /* XDEBUG */
-
-/* One or two global variables...*/
-
- static char clnthost[30]; /* client remote host name string */
- static char servhost[30]; /* server remote host name string */
- static unsigned short clntpport; /* client local port number */
- static unsigned short servpport; /* server remote port number */
- static long timevar; /* contains time returned by timexx */
- static SOCKET ls = 0; /* The server listen socket descriptor */
-
-#ifndef _WIN32
- extern char *inet_ntoa();
-#ifndef IBM
- extern int errno;
-#endif /* ^IBM */
- extern char *getenv(), *cuserid();
- unsigned long inet_addr();
-#else
- void tcperror(char *comment)
- {
- LPVOID lpMsgBuf;
- int isockerr = WSAGetLastError();
- int iwinerr = GetLastError();
- WSASetLastError(0);
-
- FormatMessage(
- FORMAT_MESSAGE_ALLOCATE_BUFFER | FORMAT_MESSAGE_FROM_SYSTEM,
- NULL,
- isockerr,
- MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), // Default language
- (LPTSTR) &lpMsgBuf,
- 0,
- NULL
- );
- if (!lpMsgBuf)
- {
- FormatMessage(
- FORMAT_MESSAGE_ALLOCATE_BUFFER | FORMAT_MESSAGE_FROM_SYSTEM,
- NULL,
- iwinerr,
- MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), // Default language
- (LPTSTR) &lpMsgBuf,
- 0,
- NULL
- );
- if (!lpMsgBuf) lpMsgBuf = "No text explanation for this error";
- }
- fprintf(stderr," %s: sockerr=%d, winerror = %d \n \t - \t \"%s\" \n",
- comment, isockerr,iwinerr, lpMsgBuf);
- LocalFree(lpMsgBuf);
- }
- static int initwinsock= -1;
- static WSADATA WSAData;
-#endif /* WIN32 */
-
-#ifndef OSK
-#ifndef IBM
- extern char *ctime();
-#endif /* ^IBM */
-
-#ifndef IBM
-/* Note: INETD_SOCK_SETUP and INETD_SOCK_CLOSE are not needed for VM ****/
-
-/*
- * INETD_SOCK_SETUP (or: "ISETUP")
- *
- * This routine sets up the necessary stuff for a server program to be
- * started by a BSD-style inet-daemon (also found on WIN/TCP in VMS),
- * and returns a socket for network sends and receives.
- *
- * THE INTEGER RETURN VALUE, IF NEGATIVE, INDICATES AN ERROR !!!
- *
- * ** It also returns an input and output unit number as parameters **
- *
- * ** MULTI-USER VERSION **
- * ** WITH USER AUTHENTICATION **
- */
-
-#ifdef VMS
-struct netdisc {
- int size;
- char *ptr;
-} inetd = {10, "SYS$INPUT:"};
-
-#ifdef AUTHENT
- struct passwd *my_pw;
-#endif /* AUTHENT */
-#endif /* VMS */
-
-int isetup(in, out)
-int *in;
-int *out;
-{
- int s;
-
-#ifdef VMS
- int status;
- unsigned short Channel;
-#endif /* VMS */
-
-#ifdef AUTHENT
- unsigned char idbuf[100];
- char usbuf[20], pwbuf[20];
- char *user = usbuf, *passwd = pwbuf;
- register int i, len;
-#endif /* AUTHENT */
-
-#ifdef SOCKETS
- struct hostent *hp; /* host info for remote host */
- struct sockaddr_in peeraddr_in; /* for peer socket address */
- int peerlen;
-#endif /* SOCKETS */
-
-#ifdef WIN32
- if (initwinsock==-1)
- {
- if (initwinsock = WSAStartup(MAKEWORD(1,1),&WSAData))
- {
- printf(" WSASetup %d \n",initwinsock);
- return(-2);
- }
- }
-#endif /* WIN32 */
-
-#ifdef VMS
-/* Note: with newer VMS C compiler, cannot open LOGFILE before sys$assign! */
-
- status = sys$assign(&inetd, &Channel, 0,0); /* sys$input channel */
- if (status != SS$_NORMAL) {
- return(-2);
- }
- s = Channel;
-#else
- s = 0; /* STDIN for Unix servers started by inetd */
-#endif /* VMS */
-
-#ifdef LOGFILE
- logfile = fopen(LOGFILE, "a");
- while ((logfile = fopen(LOGFILE, "a")) == NULL) sleep(1);
-#endif /* LOGFILE */
-
-#ifdef SOCKETS
- memset ((char *)&peeraddr_in, 0, sizeof(struct sockaddr_in));
- peerlen = sizeof(peeraddr_in);
- if (getpeername(s, &peeraddr_in, &peerlen) == SOCKET_ERROR) {
-#ifdef LOGFILE
- fprintf(logfile, "%s: getpeername failed\n", Prog_Name);
-#endif /* LOGFILE */
- goto errout1;
- }
-
- hp = gethostbyaddr((char *) &peeraddr_in.sin_addr,
- sizeof (struct in_addr), peeraddr_in.sin_family);
- if (hp == NULL) {
- strcpy(clnthost, inet_ntoa(peeraddr_in.sin_addr));
- } else {
- strcpy(clnthost, hp->h_name); /* save remote host name */
- }
- clntpport = ntohs(peeraddr_in.sin_port);
-#endif /* SOCKETS */
-#ifdef LOGFILE
- /* Log a startup message. */
- time (&timevar);
- fprintf(logfile, "%s: Started from %s port %u at %s",
- Prog_Name, clnthost, clntpport, ctime(&timevar));
-#endif /* LOGFILE */
-
-#ifdef AUTHENT
- /* Read the first buffer from the client and check the
- user name and password (which we assume to be in the
- format %s %s). */
-
- len = recv(s, idbuf, sizeof(idbuf), 0);
- if (len <= 0) {
- reply("Bad id receive.\n", NULL);
- goto errout1;
- }
- idbuf[len-1]='\0'; /* SAFETY !! */
- if (--len > 0) for (i=0; i<len; i++) idbuf[i] = ~idbuf[i];
- if (sscanf((char *)idbuf, "%s %s", user, passwd) != 2) {
- reply("Bad id record '%s'\n", idbuf);
- goto errout1;
- }
-#ifdef VMS
- my_pw = getpwnam(cuserid(0));
- if (chpass(&s, user, passwd) <= 0) {
-#else
-# ifndef _WIN32
- if (chpass(user, passwd) <= 0) {
-# else
- if (chpass(&s, user, passwd) <= 0) {
-# endif /* WIN32 */
-#endif /* VMS */
- goto errout1;
- }
- /* Successful authentication....... */
- /* Note: logfile closed in chpass if successful */
-
-#else
-#ifdef LOGFILE
- fclose(logfile);
-#endif /* LOGFILE */
-#endif /* AUTHENT */
-
- *in = *out = s;
- return(s); /* return the user socket descriptor */
-
-errout1:
-
-#ifdef LOGFILE
- fclose(logfile);
-#endif /* LOGFILE */
- return(-1); /* return -1 in case of failure */
-}
-
-/*
- * INETD_SOCK_CLOSE (or: "ICLOSE")
- *
- * This routine closes down an inet-daemon server socket.
- *
- */
-
-int iclose(s)
-SOCKET *s;
-{
-
-#ifdef AUTHENT
-#ifndef VMS
-# ifdef HPUX
- setresuid(0,0,0); /* have to do this to allow an exit !!! */
-# elif !defined(_WIN32)
- seteuid(0); /* have to do this to allow an exit !!! */
-# endif /* HPUX */
-#else
- setuic(my_pw->pw_uic);
-#endif /* VMS */
-#endif /* AUTHENT */
-
-#ifdef LOGFILE
- time (&timevar);
- while ((logfile = fopen(LOGFILE, "a")) == NULL) sleep(1);
- fprintf(logfile, "%s: Finished from %s port %u at %s",
- Prog_Name, clnthost, clntpport, ctime(&timevar));
- fclose(logfile);
-#endif /* LOGFILE */
-
- if (*s != INVALID_SOCKET)
-#ifdef VMS
- sys$dassgn(*s);
-#else
-#ifdef _WIN32
- closesocket(*s);
-#else
- close(*s);
-#endif /* WIN32 */
-#endif /* VMS */
- return 1;
-}
-#endif /* IBM */
-#endif /* OSK */
-
-/*
- * SERVER_SOCK_SETUP (or: "SSETUP")
- *
- * This routine sets up the necessary stuff on a standalone server.
- * It sets up the listen socket, accepts a single-user connect,
- * and returns the user socket for network sends and receives.
- *
- * THE INTEGER RETURN VALUE, IF NEGATIVE, INDICATES AN ERROR !!!
- *
- * ** It also returns an input and output unit number as parameters **
- *
- * ** SINGLE-USER VERSION ONLY (AND CODE FOR SPECIFIED PORT FOR VM) **
- * ** ALSO OS9 VERSION (REALLY AN INETD_SERVER_SOCK_SETUP !) - PSH **
- */
-
-#ifdef OSK
-int ssetup(isock, osock) /* OS9 */
-SOCKET *isock, *osock;
-{
-#ifdef AUTHENT
- unsigned char idbuf[100];
- char usbuf[20], pwbuf[20];
- char *user = usbuf, *passwd = pwbuf;
- register int i, len;
-
- SOCKET s = 0;
-
-#ifdef LOGFILE
- while ((logfile = fopen(LOGFILE, "a")) == NULL) sleep(1);
-#endif /* LOGFILE */
- /* Read the first buffer from the client and check the
- user name and password (which we assume to be in the
- format %s %s). */
-
- len = recv(s, idbuf, sizeof(idbuf), 0);
- if (len == SOCKET_ERROR) {
- reply("Bad id receive.\n", NULL);
- goto errout1;
- }
- if (--len > 0) for (i=0; i<len; i++) idbuf[i] = ~idbuf[i];
- i = sscanf((char *)idbuf, "%s %s", user, passwd);
- if (i != 1 && i != 2) { /* Allow any password, even null for OS9 */
- reply("Bad id record '%s'\n", idbuf);
- goto errout1;
- }
- if (chpass(user, passwd) <= 0) {
- goto errout1;
- }
- /* Successful authentication....... */
- /* Note: logfile closed in chpass if successful */
- goto allok;
-
-errout1:
-
-#ifdef LOGFILE
- fclose(logfile);
-#endif /* LOGFILE */
- return(-1); /* return -1 in case of failure */
-
-allok:
-
-#endif /* AUTHENT */
-
- *isock = 0;
- *osock = 1;
- return(*isock);
-}
-#else /* OSK */
-
-/* The old-fashioned single-user server: NOTE "AUTHENT" NOT SUPPORTED !!! */
-/* (i.e. it will not talk correctly to a client with "AUTHENT" defined) */
-/*
- THIS IS ALSO USED FOR VM, INVOKED BY THE REXEC SERVER. IN THIS CASE,
- AUTHENTICATION IS DONE BY THE REXEC SERVER BEFORE THIS SERVER STARTS.
-*/
-int ssetup(in, out, port) /* VM */
-int *in, *out;
-int *port; /* VM */
-{
- struct hostent *hp; /* host info for remote host */
- struct servent *sp; /* pointer to service information */
-
- struct sockaddr_in myaddr_in; /* for local socket address */
- struct sockaddr_in peeraddr_in; /* for peer socket address */
-
- int s, addrlen;
- unsigned short sport = *port; /* VM */
-
-#if defined ( _WIN32) && defined (AUTHENT)
- unsigned char idbuf[100];
- char usbuf[20], pwbuf[20];
- char *user = usbuf, *passwd = pwbuf;
- register int i, len;
-#endif
-
-#ifdef _WIN32
-
- if (initwinsock==-1)
- {
- if (initwinsock = WSAStartup(MAKEWORD(1,1),&WSAData))
- {
- printf(" WSASetup %d \n",initwinsock);
- return(-2);
- }
- else
- {
- printf(" Maximum %d sockets are allowed \n", WSAData.iMaxSockets);}
-
- }
-#endif /* WIN32 */
-
-
- /* clear out address structures */
-
- memset ((char *)&myaddr_in, 0, sizeof(struct sockaddr_in));
- memset ((char *)&peeraddr_in, 0, sizeof(struct sockaddr_in));
-
- /* Set up address structure for the listen socket. */
- myaddr_in.sin_family = AF_INET;
- myaddr_in.sin_addr.s_addr = INADDR_ANY;
-
- /* Find the information for the "example" server
- * in order to get the needed port number.
- * ...UNLESS PASSED A +VE PORT NUMBER TO USE (VM).
- */
- if (port == NULL || *port <= 0) { /* VM */
- sp = getservbyname ("pawserv", "tcp");
-/* printf(" name = %s, port = %d \n",sp->s_name,sp->s_port); */
- if (sp == NULL) {
- fprintf(stderr, "%s: 'example' not in services file\n",
- "server_sock_setup");
- exit(1);
- }
- myaddr_in.sin_port = sp->s_port;
-
- } else myaddr_in.sin_port = htons(sport); /* VM */
-
- /* Create the listen socket. */
- ls = socket(AF_INET, SOCK_STREAM, 0);
- if (ls == INVALID_SOCKET) {
-#if defined(IBM) || defined(_WIN32)
- tcperror("server_sock_setup: ls = socket(AF_INET, ...)");
-#else
- perror("server_sock_setup");
-#endif /* IBM */
- fprintf(stderr, "%s: unable to create socket\n",
- "server_sock_setup");
- exit(1);
- }
-#ifdef _WIN32
- {
- int flag = 1;
- if(setsockopt(ls,SOL_SOCKET,SO_REUSEADDR,(char *)&flag,sizeof(int))
- == SOCKET_ERROR) {
- tcperror("server_sock_setup: setsockopt(ls,...)");
- fprintf(stderr, "%s: unable to setsockopt\n",
- "server_sock_setup");
- exit(1);
- }
- }
-#endif
- /* Bind the listen address to the socket. */
- if (bind(ls, &myaddr_in, sizeof(struct sockaddr_in)) == SOCKET_ERROR) {
-#if defined(IBM) || defined(_WIN32)
- tcperror("server_sock_setup: bind(ls,...)");
-#else
- perror("server_sock_setup");
-#endif /* IBM */
- fprintf(stderr, "%s: unable to bind address\n",
- "server_sock_setup");
- exit(1);
- }
- /* Initiate the listen on the socket so remote users
- * can connect. The listen backlog is set to 5, which
- * is the largest currently supported.
- */
-#ifdef _WIN32
- if (listen(ls, 1) == SOCKET_ERROR) {
-#else
- if (listen(ls, 5) == SOCKET_ERROR) {
-#endif
-#if defined(IBM) || defined(_WIN32)
- tcperror("server_sock_setup: listen(ls,5)");
-#else
- perror("server_sock_setup");
-#endif /* IBM */
- fprintf(stderr, "%s: unable to listen on socket\n",
- "server_sock_setup");
- exit(1);
- }
- addrlen = sizeof(struct sockaddr_in);
- s = accept(ls, &peeraddr_in, &addrlen);
- if ( s == INVALID_SOCKET) {
- fprintf(stderr, "%s: accept error\n", "server_sock_setup");
- return(-1);
- }
- hp = gethostbyaddr ((char *) &peeraddr_in.sin_addr,
- sizeof (struct in_addr), peeraddr_in.sin_family);
- if (hp == NULL) {
- strcpy(clnthost, inet_ntoa(peeraddr_in.sin_addr));
- } else {
- strcpy(clnthost, hp->h_name); /* save remote host name */
- }
- /* Log a startup message. */
- time(&timevar);
- clntpport = ntohs(peeraddr_in.sin_port);
- fprintf(stderr, "Started from %s port %u at %s",
- clnthost, clntpport, ctime(&timevar));
-
- *in = *out = s;
-#if defined (AUTHENT ) && defined(_WIN32)
- /* Read the first buffer from the client and check the
- user name and password (which we assume to be in the
- format %s %s). */
-
- len = recv(s, idbuf, sizeof(idbuf), 0);
- if (len == SOCKET_ERROR) {
- sock_reply(&s,"Bad id receive.\n", NULL);
- return -1;
- }
- if (--len > 0) for (i=0; i<len; i++) idbuf[i] = ~idbuf[i];
- i = sscanf((char *)idbuf, "%s %s", user, passwd);
- if (i != 1 && i != 2) { /* Allow any password, even null for OS9 */
- sock_reply(&s,"Bad id record '%s'\n", idbuf);
- return -1;
- }
- if (chpass(&s,user, passwd) <= 0) {
- return INVALID_SOCKET;
- }
- /* Successful authentication....... */
-
-#endif
-#ifdef _WIN32
- if (closesocket(ls) == SOCKET_ERROR) tcperror("server_sock_setup: closesocket(ls)");
-#if 0
- system("start /B pawserv.exe");
-#endif
-
- {
- STARTUPINFO startinfo;
- PROCESS_INFORMATION processinfo;
- ZeroMemory(&startinfo,sizeof(STARTUPINFO));
- startinfo.cb = sizeof(STARTUPINFO);
-
- if(CreateProcess(
- "PawServ.exe", // pointer to name of executable module
- NULL, // pointer to command line string
- NULL, // pointer to process security attributes
- NULL, // pointer to thread security attributes
- FALSE, // handle inheritance flag
- CREATE_DEFAULT_ERROR_MODE, // creation flags
- NULL, // pointer to new environment block
- NULL, // pointer to current directory name
- &startinfo, // pointer to STARTUPINFO
- &processinfo // pointer to PROCESS_INFORMATION
- ) == FALSE)
- {
- tcperror("CreateProcess");
- }
- else
- printf(" New Process has been create succefully \n");
- }
-#endif
- return(s); /* Return the user socket descriptor */
-}
-#endif /* OSK */
-
-/*
- * CLIENT_SOCK_SETUP (or: "CSETUP")
- *
- * This routine sets up the TCP client side so that it can use a remote
- * "srvc" server. It creates a connection and returns the socket.
- *
- * THE INTEGER RETURN VALUE, IF NEGATIVE, INDICATES AN ERROR !!!
- *
- * ** It also returns an input and output unit number as parameters **
- *
- * The name of the remote host to which the client will connect is given
- * as the first parameter to the routine.
- *
- */
-
-static int junk = 0;
-#define NSO 100 /* VM */
-static int svmode[NSO], sxsock[NSO]; /* VM */
-#define MAGIC 0x12345678 /* VM */
-#define VMTO 50 /* 50 sec timeout * VM */
-
-#ifdef VMS
-int csetup(sysdes, in, out, srvdes) /* VMS CASE... */
-struct dsc$descriptor_s *sysdes;
-int *in, *out;
-struct dsc$descriptor_s *srvdes;
-#else
-#ifdef CRAYFTN
-int csetup(sysdes, in, out, srvdes) /* CRAY CASE... */
-_fcd sysdes;
-int *in, *out;
-_fcd srvdes;
-#else
-#ifdef APOFTN
-int csetup(system, in, out, srvc, s_ln, c_ln) /* APOLLO (PRE-SR10) FTN... */
-char *system;
-int *in, *out;
-char *srvc;
-short *s_ln, *c_ln; /* dummy arguments */
-#else
-#ifdef CERNLIB_MSSTDCALL
-int csetup(system, lsys, in, out, srvc, lsrvc ) /* Microsoft Fortran */
-char *system;
-int lsys, lsrvc;
-int *in, *out;
-char *srvc;
-#else
-int csetup(system, in, out, srvc) /* UNIX ETC... */
-char *system;
-int *in, *out;
-char *srvc;
-#endif /* MS */
-#endif /* APOFTN */
-#endif /* CRAYFTN */
-#endif /* VMS */
-
-{
- struct hostent *hp; /* host info for remote host */
- struct servent *sp; /* pointer to service information */
- struct sockaddr_in myaddr_in; /* for local socket address */
- struct sockaddr_in peeraddr_in; /* for peer socket address */
-
- unsigned long addr;
- int s, addrlen;
- int sx, nn = 0; /* REXEC */
-#ifndef IBM
- char get[50], *getp = get; /* REXEC */
-#endif /*^IBM */
- char sys[30];
- register int i, j, k;
- register char *c;
-
- char portstr[20], *pt; /* IBM */
- int vmode = 0; /* IBM */
- unsigned short sport = 0, prt = 0; /* IBM */
- char uspass[50];
- char *user = NULL, *passwd = NULL;
- int port;
-#if defined(AUTHENT)
- unsigned char idbuf[100];
-#endif /* AUTHENT */
-
-#ifdef VMS
- char *system, *srvc;
- unsigned short s_ln, c_ln;
- struct dsc$descriptor_s sd, id; /* VM */
- unsigned long cliflags; /* VM */
- char command[200]; /* VM */
- int status, cstatus; /* VM */
-
- srvc = srvdes->dsc$a_pointer;
- c_ln = srvdes->dsc$w_length;
- system = sysdes->dsc$a_pointer;
- s_ln = sysdes->dsc$w_length;
- j = c_ln;
- i = s_ln;
-#else
-#ifdef CRAYFTN
- char *system, *srvc;
- unsigned s_ln, c_ln;
-
- srvc = _fcdtocp(srvdes);
- c_ln = _fcdlen(srvdes);
- system = _fcdtocp(sysdes);
- s_ln = _fcdlen(sysdes);
- j = c_ln;
- i = s_ln;
-#else
-#ifdef APOFTN
- j = *c_ln;
- i = *s_ln;
-#else
-#ifdef IBM
- extern char asciitoebcdic[]; /* translation tables */
- extern char ebcdictoascii[];
- char buff[100];
- char *get;
- char *getp;
- char getbuf[50]; /* REXEC */
- getp = getbuf; /* REXEC */
- get = getbuf; /* REXEC */
-/* j = 80; */ /* (crude kludge) length of srvc in Fortran */
-/* i = 80; */ /* ( ,, ,, ) length of system in Fortran */
- i = gtlnfstr(&system,1); /* length of 1st arg (srvc) */
- j = gtlnfstr(&system,4); /* length of 4th arg (system) */
-#else
-#ifdef WIN32
- if (initwinsock==-1)
- {
- if (initwinsock = WSAStartup(MAKEWORD(1,1),&WSAData))
- {
- printf(" WSASetup %d \n",initwinsock);
- return(-2);
- }
- }
- j = lsrvc;
- i = lsys;
-#else
- j = strlen(srvc);
- i = strlen(system);
-#endif /* WIN32 */
-#endif /* IBM */
-#endif /* APOFTN */
-#endif /* CRAYFTN */
-#endif /* VMS */
-
-
-
- /* Terminate correctly the host & service strings passed by FTN.. */
- for (k=0; k<j; k++) if (srvc[k] == ' ') { srvc[k] = '\0'; break;}
- for (k=0; k<i; k++) if (system[k] == ' ') { system[k] = '\0'; break;}
- /* And map to lower case... */
- c = srvc; while (*c) { if (isupper(*c)) *c = tolower(*c); c++; }
- c = system; while (*c) { if (isupper(*c)) *c = tolower(*c); c++; }
-
- /* fprintf(stderr, "system '%s' service '%s'\n", system, srvc); */
-
-/* changed TS 27.11.91 */
-/* ================================================================= */
-/* the original part (Version 1.21 of tcpaw can only connect
- to VM via rexec and inetd systems,
- in order to reach MVS something like this should be used.
-*/
- strcpy(servhost, system); /* Use our own storage when needed.... */
- *sys = '\0';
-
-/* Has the user specified the option -V or -M ? */
-
- if ( !strcmp((system + strlen(system) - 4),"(mvs") ){
- *(system + strlen(system) - 4) = '\0';
- strcpy(servhost, system);
- fprintf(stderr,"MVS system: '%s'\n",system);
- goto mvscase;
- }
-
- if ( !strcmp((system + strlen(system) - 3),"(vm") ){
- *(system + strlen(system) - 3) = '\0';
- strcpy(servhost, system);
- fprintf(stderr,"VM system: '%s'\n",system);
- goto vmcase;
- }
-
-/* NOTE THAT THE FOLLOWING TESTS ON MACHINE NAMES ARE CERN-SPECIFIC !! */
- if (!strncmp(system, "cernvm", 6) || !strncmp(system, "lepics", 6) ||
- !strncmp(system, "crnvm", 5))
- goto vmcase;
-/* NOTE THAT THE FOLLOWING TESTS ON MACHINE NAMES ARE GSI-SPECIFIC !! */
- if (!strncmp(system, "mvs", 3) || !strncmp(system, "MVS", 3) )
- goto mvscase;
- if ((addr = inet_addr(servhost)) != -1) { /* Permit IP addresses */
-
- /* my offer, because */
- /* i had problems in anderstanding all the stuff */
-
- fprintf(stderr,"\nWhich system is '%s' running?: (c)\n", system );
- fprintf(stderr," a VM\n");
- fprintf(stderr," b MVS\n");
- fprintf(stderr," c other System\n");
- fprintf(stderr,"\nEnter a, b or c:", system );
-
- if (fgets(get, 80, stdin) != NULL) {
- if (*get == 'a' || *get == 'A') goto vmcase;
- if (*get == 'b' || *get == 'B') goto mvscase;
- }
- }
-/* ================================================================= */
-
-#if defined(AUTHENT)
-/* Get the user name/password info from ~/.netrc file for authentication */
-
-#ifdef APOPAL1
-/*** DIRTY TEMPORARY FIX FOR APOLLO-TO-OS9 AUTHENTICATION FOR PSH ***/
- if (!strncmp(system, "o-o", 3)) user = passwd = "(any)"; else
-#endif /* APOPAL1 */
- ruserpass(servhost, &user, &passwd); /* get info from .netrc */
- sprintf(uspass, "%s %s", user, passwd);
-#endif /* AUTHENT */
- goto vmagain;
-
-vmcase:
-
-/* VM (rexec) MODE FOLLOWS: */
-
- vmode++;
-
- gethostname(portstr, sizeof(portstr));
- for (pt=portstr; *pt ; pt++) prt += *pt;
-#ifdef DEBUG
-/*
- fprintf(stderr, "localhost = %s\n", portstr);
- fprintf(stderr, "prt = %d prt<<5 = %d\n", prt, (prt<<5));
-*/
-#ifdef VMS
-/* fprintf(stderr, "time = %d\n", time(0)); */
-#endif /* VMS */
-#endif /* DEBUG */
-/* if (!sport) ** DEBUG **/
-
-#ifdef IBMMVS
- /* not the best way, but it works */
- sport = (prt << 5) | (1000 & 0x3e0) + junk++;
-#else
- sport = (prt << 5) | (getpid() & 0x3e0) + junk++;
-#endif /* IBMMVS */
-
-#ifdef VMS
- sport += (time(0) & 0xfff); /* Add 0-4095 as VMS pid may not change */
-#endif /* VMS */
- sprintf(portstr, "%d", sport);
- fprintf(stderr, "Remote host/port = %s/%s\n", system, portstr);
-
-/* Now it's time to give VM an "rexec" command to start the server.. */
-
- sp = getservbyname("exec", "tcp");
- if (sp == NULL) {
- fprintf(stderr, "'exec' not found in services file\n");
- return(-1);
- }
- strcpy(get, system); /* rexec modifies its host argument! */
- if (*sys == '\0') {
- register char *cs = sys;
-
- c = system; /* 'sys'= 'system' without domain extension */
- while ((*c) && (*c != '.')) {
- *cs++ = *c++;
- }
- *cs = '\0';
- }
- sprintf(uspass, "%s %s %s", srvc, portstr, sys);
-#ifdef DEBUG
-/*
- fprintf(stderr, "Rexec-ing %s cmd '%s'\n", system, uspass);
-*/
-#endif /* DEBUG */
-
-#ifdef linux_softland
- sx = _rexec(&getp, (int)sp->s_port, user, passwd, uspass, NULL);
-#else
- sx = rexec(&getp, (int)sp->s_port, user, passwd, uspass, NULL);
-#endif /* linux_softland */
- if (sx < 0) {
- fprintf(stderr, "Bad rexec return %d\n", sx);
- fprintf(stderr, "Probable cause:\n");
- fprintf(stderr, " a) You are logged on already \n");
- fprintf(stderr, " b) You are disconnected (e.g. GONE)\n");
- fprintf(stderr, " c) Bad VM username or password\n");
- return(-1);
- }
-/* fprintf(stderr, "Successfully rexec-ed %s cmd '%s'\n", system, uspass); */
-
- fprintf(stderr, "%s: loading %s exec (%d sec timeout)...\n\n",
- system, srvc, VMTO);
- goto vmagain;
-
-mvscase:
-
-/* MVS tsosub mode follows: */
-
- vmode++;
-
- sp = getservbyname ("tsosub", "tcp");
- if (sp == NULL) {
- fprintf(stderr, "%s: 'tsosub' not in services file\n",
- "tsosub");
- /* in etc.services is no tsosub service up to now */
- fprintf(stderr, "Use port 5001 for tsosub to connect to %s\n",system);
- port = 5001;
- /* return(-1); */
-
- }
- else
- port = (int) sp->s_port;
-
-
- sport = 0; /* MVS adds free portnumber to the srvc string */
- /* sport=0, the port number is choicen by MVS */
- sx = tsosub(&system, port, user, passwd, srvc, &sport);
- if (sx < 0) {
- /* fprintf(stderr, "Bad tsosub return %d\n", sx); */
- return(-1);
- }
-
- fprintf(stderr, "Remote host/port = %s/%d\n", system,sport);
- fprintf(stderr, "%s: loading %s (%d sec timeout)...\n\n",
- system, srvc, VMTO);
-
-/* now connect to server */
-
-
-vmagain:
- /* clear out address structures */
- memset ((char *)&myaddr_in, 0, sizeof(struct sockaddr_in));
- memset ((char *)&peeraddr_in, 0, sizeof(struct sockaddr_in));
-
- /* Set up the peer address to which we will connect. */
- peeraddr_in.sin_family = AF_INET;
- /* Get the host information for the hostname that the
- * user passed in.
- */
-
- if ((addr = inet_addr(servhost)) != -1) { /* Permit IP addresses */
- peeraddr_in.sin_addr.s_addr = addr;
- } else {
- hp = gethostbyname(servhost);
- if (hp == NULL) {
- fprintf(stderr, "%s: %s not found in hosts file\n",
- "client_sock_setup", servhost);
- return(-1);
- }
- peeraddr_in.sin_addr.s_addr =
- ((struct in_addr *)(hp->h_addr))->s_addr;
-/* bcopy(hp->h_addr, (caddr_t)&peeraddr_in.sin_addr, hp->h_length); */
- }
-
- if (!vmode) {
- /* Find the information for the requested server
- * in order to get the needed port number.
- */
- sp = getservbyname (srvc, "tcp");
- if (sp == NULL) {
- fprintf(stderr, "%s: '%s' not found in services file\n",
- "client_sock_setup", srvc);
- return(-1);
- }
- peeraddr_in.sin_port = sp->s_port;
- } else {
- peeraddr_in.sin_port = htons(sport); /* VM */
- }
-
- /* Create the socket. */
- s = socket(AF_INET, SOCK_STREAM, 0);
- if (s == INVALID_SOCKET) {
-#if defined(IBM) || defined(_WIN32)
- tcperror("client_sock_setup");
-#else
- perror("client_sock_setup");
-#endif /* IBM */
- fprintf(stderr, "%s: unable to create socket\n",
- "client_sock_setup");
- if (vmode) close(sx);
- return(-1);
- }
- /* Try to connect to the remote server at the address
- * which was just built into peeraddr.
- */
- if (connect(s, &peeraddr_in, sizeof(struct sockaddr_in)) == SOCKET_ERROR) {
-#ifndef _WIN32
- close(s);
-#else
- closesocket(s);
-#endif
- if (vmode) while (nn++ < VMTO) {
- /* fprintf(stderr, "Retry %d\n", nn); */
- sleep(1);
- goto vmagain;
- }
-#if defined(IBM) || defined(_WIN32)
- tcperror("client_sock_setup");
-#else
- perror("client_sock_setup");
-#endif /* IBM */
- fprintf(stderr, "%s: unable to connect to remote\n",
- "client_sock_setup");
- if (vmode) close(sx);
- return(-1);
- }
-
- addrlen = sizeof(struct sockaddr_in);
- if (getsockname(s, &myaddr_in, &addrlen) == SOCKET_ERROR) {
-#if defined(IBM) || defined(_WIN32)
- tcperror("client_sock_setup");
-#else
- perror("client_sock_setup");
-#endif /* IBM */
- fprintf(stderr, "%s: unable to read socket address\n",
- "client_sock_setup");
- clntpport = 0;
- } else
- clntpport = ntohs(myaddr_in.sin_port);
-
- /* Print out a startup message for the user. */
- time(&timevar);
- fprintf(stderr, "Connected to %s on TCP port %u at %s",
- servhost, clntpport, ctime(&timevar));
-
-#if defined(AUTHENT)
- if (!vmode) {
- /* Send out the user/password authentication record first... */
- j = strlen(uspass);
-#ifdef IBM
- CMXLATE(uspass,ebcdictoascii,j);
-#endif /* IBM */
- for (i=0; i<j; i++) uspass[i] = ~uspass[i];
- if (send(s, uspass, j+1, 0) <= 0) {
-#if defined(IBM) || defined(_WIN32)
- tcperror("Error sending authorization");
-#else
- perror("Error sending authorization");
-#endif /* IBM */
- goto badserv;
- }
- /* Read back a confirmation from server... */
- if ((i = recv(s, idbuf, sizeof(idbuf), 0)) <= 0) {
-#if defined(IBM) || defined(_WIN32)
- tcperror("Error receiving authorization");
-#else
- perror("Error receiving authorization");
-#endif /* IBM */
-badserv:
- fprintf(stderr,"%s: Service '%s' not set up OK on host %s.\n",
- "client_sock_setup", srvc, servhost);
-#ifndef _WIN32
- close(s);
-#else
- closesocket(s);
-#endif
- return(-1);
- }
- idbuf[i] = '\0';
-#ifdef IBM
- CMXLATE(idbuf,asciitoebcdic,i);
-#endif /* IBM */
- fprintf(stderr, "%s\n", idbuf);
-
-/* Check reply string and set return code as appropriate */
-
-if (!strncmp(idbuf,"Bad id record",13)) { return(-2); }
-
-if (!strncmp(idbuf,"Unknown user",12)) { return(-2); }
-
-if (!strncmp(idbuf,"Bad password",12)) { return(-3); }
-
-if (!strncmp(idbuf,"Can't setegid",13)) { return(-4); }
-
-if (!strncmp(idbuf,"Can't initgroups",16)) { return(-5); }
-
-if (!strncmp(idbuf,"Can't set home",14)) { return(-6); }
-
-if (!strncmp(idbuf,"Can't seteuid",13)) { return(-7); }
-
-if (!strncmp(idbuf,"Can't setuser",13)) { return(-8); }
-
-if (!strncmp(idbuf,"Can't setacct",13)) { return(-9); }
-
-if (!strncmp(idbuf,"Can't setpriv",13)) { return(-10);}
-
-if (!strncmp(idbuf,"Bad passcode",12)) { return(-11);}
-
-if (!strncmp(idbuf,"Can't setid",11)) { return(-12);}
-
- }
-#endif /* AUTHENT */
-
- /* Remember the sx sockets per VM socket (even for VMS!) */
- if (vmode) {
- svmode[s%NSO] = MAGIC;
- sxsock[s%NSO] = sx;
- } else
- svmode[s%NSO] = sxsock[s%NSO] = 0;
-
- *in = *out = s;
- return(s); /* return the socket descriptor to FTN */
-
-}
-
-/*
- * SOCK_CLOSE (or: "SCLOSE")
- *
- * This routine closes a client (or a single-client server) socket.
- *
- */
-
-int sclose(sock)
-SOCKET *sock;
-
-{
-#ifndef _WIN32
- close(*sock); /* close the user socket */
-#ifndef OSK
- if (ls > 0) close(ls); /* ..and the listen socket if an active server */
-#endif /* OSK */
-
- if (svmode[(*sock)%NSO] == MAGIC) {
- close(sxsock[(*sock)%NSO]); /* ..and the sx socket if appropriate */
- svmode[(*sock)%NSO] = sxsock[(*sock)%NSO] = 0;
- }
-#else
- closesocket(*sock); /* close the user socket */
- if (ls != INVALID_SOCKET) closesocket(ls); /* ..and the listen socket if an active server */
-
- if (svmode[(*sock)%NSO] == MAGIC) {
- closesocket(sxsock[(*sock)%NSO]); /* ..and the sx socket if appropriate */
- svmode[(*sock)%NSO] = sxsock[(*sock)%NSO] = 0;
- }
-#endif /* WIN32 */
- return 1;
-}
-
-/*
- * SOCK_SENDSTR (or: "SSENDSTR")
- *
- * This routine sends the contents of a character string down a socket.
- *
- * Args: socket, string address, string length.
- * NOTE: ROUTINE ATTEMPTS TO SEND EXACT INPUT LENGTH.
- *
- * Returns: Number of bytes sent/error (to be checked by user).
- */
-
-#ifdef VMS
-int ssendstr(sock, bufdes, m) /* VMS CASE... */
-int *sock;
-struct dsc$descriptor_s *bufdes;
-int *m;
-#else
-#ifdef CRAYFTN
-int ssendstr(sock, bufdes, m) /* CRAY CASE... */
-int *sock;
-_fcd bufdes;
-int *m;
-#else
-#ifdef CERNLIB_MSSTDCALL
-int ssendstr(sock, buf, lbuf, m) /* Microsoft case... */
-SOCKET *sock;
-char *buf;
-int lbuf;
-int *m;
-#else
-int ssendstr(sock, buf, m)
-int *sock;
-char *buf;
-int *m;
-#endif /* MS */
-#endif /* CRAYFTN */
-#endif /* VMS */
-
-{
-#ifdef IBM
- extern char asciitoebcdic[]; /* translation tables */
- extern char ebcdictoascii[];
-#endif /* IBM */
- int s = *sock, n = *m, i, j, k = 0;
-
-#ifdef VMS
- char *buf = bufdes->dsc$a_pointer;
-#endif /* VMS */
-#ifdef CRAYFTN
- char *buf = _fcdtocp(bufdes);
-#endif /* CRAYFTN */
-
-#ifdef IBM
-/* CMXLATE(buf,ebcdictoascii,strlen(buf));*/
- CMXLATE(buf,ebcdictoascii,*m);
-#endif /* IBM */
-retry:
- if ((i =send(s, buf+k, n-k, 0)) == SOCKET_ERROR) {
-#ifdef XDEBUG
- tcperror("send");
- fprintf(STDERR,
- "sock_sendstr: sock = %d ret = %d len = %d k = %d buf[0-7] = '",
- s, i, n, k);
- for (j=0; j<8; j++) fprintf(STDERR, "%c", buf[j]);
- fprintf(STDERR, "'\n");
- if (i = 0) { sleep(2); goto retry; }
-#endif /* XDEBUG */
- return(i);
- }
- if (i < (n-k)) { k += i; goto retry; }
- return(n);
-}
-
-/*
- * SOCK_RECVSTR (or: SRECVSTR")
- *
- * This routine receives the contents of a character string on a socket.
- *
- * Args: socket, string address, [maximum] string length.
- * NEW: IF INPUT LENGTH > 0 ROUTINE ATTEMPTS TO GET THIS LENGTH.
- * IF ,, ,, < 0 ROUTINE GETS WHAT IT CAN (OLD STYLE).
- *
- * Returns: Number of bytes received/error (to be checked by user).
- *
- */
-
-#ifdef VMS
-int srecvstr(sock, bufdes, m) /* VMS CASE... */
-int *sock;
-struct dsc$descriptor_s *bufdes;
-int *m;
-#else
-#ifdef CRAYFTN
-int srecvstr(sock, bufdes, m) /* CRAY CASE... */
-int *sock;
-_fcd bufdes;
-int *m;
-#else
-#ifdef CERNLIB_MSSTDCALL
-int srecvstr(sock, buf,lbuf, m) /* MS CASE... */
-SOCKET *sock;
-char *buf;
-int lbuf;
-int *m;
-#else
-int srecvstr(sock, buf, m)
-int *sock;
-char *buf;
-int *m;
-#endif /* MS */
-#endif /* CRAYFTN */
-#endif /* VMS */
-
-{
-#ifdef IBM
- extern char asciitoebcdic[]; /* translation tables */
- extern char ebcdictoascii[];
-#endif /* IBM */
- int s = *sock, n = *m, i, j, k = 0;
-
-#ifdef VMS
- char *buf = bufdes->dsc$a_pointer;
-#endif /* VMS */
-#ifdef CRAYFTN
- char *buf = _fcdtocp(bufdes);
-#endif /* CRAYFTN */
-
- if (n < 0) n = -n; /* Look for maximum number of bytes option... */
-
-retry:
- if ((i = recv(s, buf+k, n-k, 0)) == SOCKET_ERROR) {
-#ifdef IBM
-/* CMXLATE(buf+k,asciitoebcdic,i); Maybe not, with length <=0 JDS 251093*/
-#endif /* IBM */
-#ifdef XDEBUG
- tcperror("recv");
- fprintf(STDERR,
- "sock_recvstr: sock = %d ret = %d len = %d k = %d buf[0-15] = '",
- s, i, *m, k);
- for (j=0; j<16; j++) fprintf(STDERR, "%c", buf[j]);
- fprintf(STDERR, "'\n");
-#endif /* XDEBUG */
- return(i);
- }
-#ifdef IBM
- CMXLATE(buf+k,asciitoebcdic,i);
-#endif /* IBM */
- if (*m > 0) { /* look for exact number of bytes option... */
- if (i < (n-k)) { k += i; goto retry; }
- return(n);
- } else
- return(i);
-}
-
-/*
- * SOCK_SEND (or: "SSEND")
- *
- * This routine sends a binary block of data down a socket.
- *
- * Args: socket, block address, block length.
- * NOTE: ROUTINE ATTEMPTS TO SEND EXACT INPUT LENGTH.
- *
- * Returns: Number of bytes sent/error (to be checked by user).
- *
- */
-
-int ssend(sock, buf, m)
-int *sock;
-char *buf;
-int *m;
-{
- int s = *sock, n = *m, i, j, k = 0;
-
-retry:
- if ((i = send(s, buf+k, n-k, 0)) <= 0) {
-#ifdef XDEBUG
- fprintf(STDERR,
- "sock_send: sock = %d ret = %d len = %d k = %d buf[0-7] = '",
- s, i, n, k);
- for (j=0; j<8; j++) fprintf(STDERR, "%c", buf[j]);
- fprintf(STDERR, "'\n");
-#endif /* XDEBUG */
- return(i);
- }
- if (i < (n-k)) { k += i; goto retry; }
- return(n);
-}
-
-/*
- * SOCK_RECV (or: "SRECV")
- *
- * This routine receives a binary block of data from a socket.
- *
- * Args: socket, receive buffer address, [maximum] block length.
- * NEW: IF INPUT LENGTH > 0 ROUTINE ATTEMPTS TO GET THIS LENGTH.
- * IF ,, ,, < 0 ROUTINE GETS WHAT IT CAN (OLD STYLE).
- *
- * Returns: Number of bytes received/error (to be checked by user).
- *
- */
-
-int srecv(sock, buf, m)
-int *sock;
-char *buf;
-int *m;
-{
- int s = *sock, n = *m, i, j, k = 0;
-
- if (n < 0) n = -n; /* Look for maximum number of bytes option... */
-
-retry:
- if ((i = recv(s, buf+k, n-k, 0)) == SOCKET_ERROR) {
-#ifdef XDEBUG
- fprintf(STDERR,
- "sock_recv: sock = %d ret = %d len = %d k = %d buf[0-7] = '",
- s, i, *m, k);
- for (j=0; j<8; j++) fprintf(STDERR, "%c", buf[j]);
- fprintf(STDERR, "'\n");
-#endif /* XDEBUG */
- return(i);
- }
- if (*m > 0) { /* look for exact number of bytes option... */
- if (i < (n-k)) { k += i; goto retry; }
- return(n);
- } else
- return(i);
-}
-
-reply(s1, s2, s3)
- char *s1, *s2, *s3;
-{
-#ifdef OSK
- char buff[100];
- int osock = 1;
-
- sprintf(buff, s1, s2, s3);
- send(osock, buff, strlen(buff)+1, 0);
-#else
- printf(s1, s2, s3);
- fflush(stdout);
-#endif /* OSK */
-
-#ifdef LOGFILE
- fprintf(logfile, s1, s2, s3);
-#endif /* LOGFILE */
-}
-
-sock_reply(s, s1, s2, s3)
- int *s;
- char *s1, *s2, *s3;
-{
-
-/* As reply() but use socket rather than stdout */
-
- char buff[100];
- int osock = *s;
-
- sprintf(buff, s1, s2, s3);
- send(osock, buff, strlen(buff)+1, 0);
-
-#if defined(LOGFILE) && !defined(_WIN32)
- fprintf(logfile, s1, s2, s3);
-#endif /* LOGFILE */
-}
-
-#if defined(AUTHENT)
-/* Code derived from ftpd to do name/passwd checking.. */
-/* Note that printf's get pushed down the network to client... */
-#ifdef IBM
-int chpass(user, pass) /* For IBM */
- char *user, *pass;
-{
- char *topoint;
- topoint = user;
- while (*topoint != '\0'){
- toupper(*topoint);
- topoint++;
- }
- topoint = pass;
- while (*topoint != '\0'){
- toupper(*topoint);
- topoint++;
- }
- if (CHPAS(user,pass)){ /*if pw check no ok (done in assembler) */
- reply("Bad password for user %s.\n", user);
- return(-3);
- }
- reply("User %s accepted.\n", user);
-#ifdef LOGFILE
- fclose(logfile);
-#endif /* LOGFILE */
- return(1);
-}
-#ifdef IBMMVS
-int CHPAS(user, pass) /* For IBMMVS */
- char *user, *pass;
-{
- int i;
- char cmd??(80??);
-
- i = sprintf(cmd,"TSOEXEC PWDCHK2 %s,%s ",user,pass);
- i = system(cmd);
- /* i = 0 user,pass ok */
- /* i = 4 user,pass not ok */
- return(i);
-}
-#endif /* IBMMVS */
-
-#else /* ^IBM */
-#ifndef _WIN32
-#ifndef VMS
-int chpass(user, pass) /* For Unix and other "normal" people */
- char *user, *pass;
-{
-
-#ifndef OSK
-
- char buff[100];
-
-#ifdef AFS
-
-/* Use cc -I/usr/afsws/include to get appropriate AFS include files */
-
-#include <afs/stds.h>
-#include <afs/kautils.h>
-#include <errno.h>
-char *reason;
-
-#endif /* AFS */
-
-#ifdef APOPWD1
-/** TEMPORARY APOLLO KLUDGE WHILE "crypt" DOESN'T WORK.. **/
-#include <sys/wait.h>
-
- union wait ret;
-#endif /* APOPWD1 */
-
- char *xpasswd, *crypt();
- struct passwd *pw;
-
-#ifdef linux_softland
- struct spwd *spwd;
-#endif /* linux_softland */
-
-#ifdef ACE
- struct acmdata acmd; /* Unicos6.0 calling sequence used.. */
-
- acmd.acm_both = 0;
-#endif /* ACE */
-
- pw = getpwnam(user);
- if (pw == NULL) {
- reply("Unknown user %s.\n", user);
- return(-2);
- }
-
-#ifdef linux_softland
- spwd = getspnam(user);
- if (spwd == NULL) {
- reply("User %s has illegal shadow password\n",user);
- return(-2);
- }
-#endif /* linux_softland */
-
-#ifdef APOPWD1
-/** TEMPORARY APOLLO KLUDGE WHILE "crypt" DOESN'T WORK.. **/
-#define KLUDGE "-c /com/date >/dev/null 2>/dev/null"
-
- sprintf(buff, "%s %s %s %s %s","/com/login",user,"-lp", pass,KLUDGE);
- ret.w_status = system(buff);
- if (ret.w_Retcode) {
-#else
-#ifdef ACE
- acmd.acm_mode = CKUSR;
- acmd.acm_user = pw->pw_name;
- acmd.acm_clearpc = "";
- if (!acmlg(&acmd)) {
-/* The user has a SecurID card ...................... */
- int i;
-
- acmd.acm_clearpc = pass;
- if ((i = acmlg(&acmd))) {
- reply("Bad passcode for user %s: ACE error %d.\n",
- pw->pw_name, i);
- return(-11);
- }
- } else { /* apply the normal Unix password check ... */
-#endif /* ACE */
-
-#ifdef AFS
-
- irc=ka_UserAuthenticateGeneral(KA_USERAUTH_VERSION + KA_USERAUTH_DOSETPAG,
- user,
- (char *) 0,
- (char *) 0,
- pass,
- 0,
- 0, 0,
- &reason);
-
- if (irc!=0) printf("AFS authentication failed because %s\n", reason);
-
- if (irc) {
-
-#else
-
-#ifdef linux_softland
- xpasswd = pw_encrypt(pass,spwd->sp_pwdp);
-#else
- xpasswd = crypt(pass, pw->pw_passwd);
-#endif /* linux_softland */
- /* The strcmp does not catch null passwords! */
-#ifdef linux_softland
- if (spwd->sp_pwdp == '\0' || strcmp(xpasswd,spwd->sp_pwdp)) {
-#else
- if (*pw->pw_passwd == '\0' || strcmp(xpasswd,pw->pw_passwd)) {
-#endif /* linux_softland */
-
-#endif /* AFS */
-
-#endif /* APOPWD1 */
- reply("Bad password for user %s.\n", pw->pw_name);
- return(-3);
- }
-#ifdef ACE
- }
-#endif /* ACE */
-#ifdef HPUX
- if (setresgid(pw->pw_gid,pw->pw_gid,0)) {
-#else
-#ifdef IBMRT
- setgid(pw->pw_gid);
-#endif /* IBMRT */
- if (setegid(pw->pw_gid)) {
-#endif /* HPUX */
- reply("Can't setegid for user %s.\n", pw->pw_name);
- return(-4);
- }
-#ifndef NOINITGROUPS
- if (initgroups(pw->pw_name, pw->pw_gid)) {
- reply("Can't initgroups for user %s.\n", pw->pw_name);
- return(-5);
- }
-#endif /* NOINITGROUPS */
- if (chdir(pw->pw_dir)) {
-#ifdef HPUX
- setresuid(0,0,0);
-#else
- seteuid(0);
-#endif /* HPUX */
- reply("Can't set home directory '%s' for user %s.\n",
- pw->pw_dir, pw->pw_name);
- return(-6);
- }
-#endif /* OSK */
-
-/* SUCCESS.................................................. */
- reply("User %s accepted (in directory %s).\n",
- pw->pw_name, pw->pw_dir);
-#ifdef LOGFILE
- fclose(logfile); /* Do this while still root.. */
-#endif /* LOGFILE */
-#ifndef OSK
-#ifdef HPUX
- setresuid(pw->pw_uid,pw->pw_uid,0);
-#else
-#ifdef IBMRT
- setuid(pw->pw_uid);
-#endif /* IBMRT */
- seteuid(pw->pw_uid);
-#endif /* HPUX */
-#endif /* OSK */
- return(1);
-}
-
-#else /* VMS */
-
-int chpass(s, user, pass) /* For VMS only (yes, it's different) */
- int *s;
- char *user, *pass;
-{
- char *xpasswd, *crypt();
- struct passwd *pw;
-
- pw = getpwnam(user);
- if (pw == NULL) {
- sock_reply(s,"Unknown user %s.\n", user);
- return(-2);
- } else {
- xpasswd = vmscrypt(user, pass, pw->pw_encrypt, pw->pw_salt);
- /* The strcmp does not catch null passwords! */
- if (*pw->pw_passwd == '\0' || strcmp(xpasswd,pw->pw_passwd)) {
- sock_reply(s,"Bad password for user %s.\n", user);
- return(-3);
- }
- }
- if (setegid(pw->pw_gid) < 0) {
- sock_reply(s,"Can't setegid for user %s.\n", user);
- return(-4);
- }
-/*
- if (initgroups(pw->pw_name, pw->pw_gid) < 0) {
- sock_reply(s,"Can't initgroups for user %s.\n", user);
- return(-5);
- }
-*/
-
-/*
- * Beware: on VMS, chdir is effective only during image execution.
- * Otherwise, chdir is to be called in SUPER, EXEC or KERNEL mode.
- */
- if (chdir(pw->pw_dir)) {
- setuic(my_pw->pw_uic);
- sock_reply(s,"Can't set home directory for user %s.\n", user);
- return(-6);
- }
-
-/* Success.. */
- sock_reply(s,"User %s accepted.\n", user);
-#ifdef LOGFILE
- fclose(logfile); /* Do this while still root.. */
-#endif /* LOGFILE */
- if (seteuid(pw->pw_uid) < 0) {
- sock_reply(s,"Can't seteuid for user %s.\n", user);
- return(-7);
- }
-
-/* The following two routines to not currently work on the Alpha */
-#if !defined(CERNLIB_QMALPH)
-
- if (setuser(pw->pw_name) != 0) { /* Change user name */
- sock_reply(s,"Can't setuser for user %s.\n", user);
- return(-8);
- }
-
- if (setacct(pw->pw_account) != 0) { /* Change account */
- sock_reply(s,"Can't setacct for user %s.\n", user);
- return(-9);
- }
-
-#endif
-
- if (setid(pw->pw_uic) != 0) { /* Set rights identifiers */
- sock_reply(s,"Can't setid for user %s.\n", user);
- return(-12);
- }
-
- if (setpriv(pw->pw_priv) != 0) { /* Change privileges */
- sock_reply(s,"Can't setpriv for user %s.\n", user);
- return(-10);
- }
-
- return(1);
-}
-
-#endif /* VMS */
-#else
- int chpass(SOCKET *s,char *user, char *passwd){
- sock_reply(s,"User %s accepted.\n", user);
- printf(" logfile = %x \n",logfile);
-#ifdef LOGFILE
- if (logfile) fclose(logfile); /* Do this while still root.. */
- logfile = 0;
-#endif /* LOGFILE */
- return 1;
-#if 0
- HANDLE hToken;
- if (LogonUser(user,NULL,passwd,LOGON32_LOGON_BATCH,LOGON32_PROVIDER_DEFAULT, &hToken) == TRUE)
- {
- sock_reply(s,"User %s accepted.\n", user);
- CloseHandle(hToken);
- }
- else
- {
- sock_reply(s,"Bad password for user %s.\n", user);
- return -3;
- }
-
- return 1;
-#endif
- }
-
-#endif /* WIN32 */
-#endif /* IBM*/
-#endif /* AUTHENT */
-
-/* Provide all of ruserpass.c unless specifically omitted */
-
-#ifdef VMS
-/* Code from Unix RTL missing from VMS.... */
-/* "ruserpass.c" -- to obtain a user's remote name and password */
-/* Version hacked for VMS (and Wollongong) compatibility. (BS) */
-/* A VMS FTN calling program MUST call "vaxc$crtl_init" for getenv TO WORK */
-
-#include <stat.h>
-#include "sysreq/sgtty.h"
-
- static char usr[30], pss[30], myname[30];
-
-ruserpass(host, aname, apass)
- char *host, **aname, **apass;
-{
- struct sgttyb sgttyb_val;
-
- if (*aname == NULL || *apass == NULL)
- rnetrc(host, aname, apass);
- if (*aname == NULL) {
- char *c = myname;
- strcpy(myname, getenv("USER"));
- while (*c) { *c = tolower(*c); c++; }
- fprintf(stderr, "Name (%s:%s): ", host, myname);
- if (fgets(usr, sizeof(usr), stdin) == NULL) goto fatal;
- if (*usr == '\n') {
- strcpy(usr, myname);
- } else
- usr[strlen(usr)-1] = '\0'; /* convert newline */
- *aname = usr;
- }
- if (*aname && *apass == NULL) {
- /* FHE library needed for this echo-manipulation on VMS..... */
- if (gtty(0, &sgttyb_val)) {
- perror("gtty");
- goto fatal;
- }
- sgttyb_val.sg_flags |= TT$M_NOECHO; /* turn off echo */
- if (stty(0, &sgttyb_val)) {
- perror("stty(0)");
- goto fatal;
- }
- fprintf(stderr, "Password (%s:%s): ", host, *aname);
- if (fgets(pss, sizeof(pss), stdin) == NULL) goto fatal1;
- fprintf(stdout,"\n");
- sgttyb_val.sg_flags &= ~(TT$M_NOECHO); /* restore echo */
- if (stty(0, &sgttyb_val)) {
- perror("stty");
- goto fatal;
- }
- pss[strlen(pss)-1] = '\0'; /* convert newline */
- *apass = pss;
- }
- return;
-fatal1:
- sgttyb_val.sg_flags &= ~(TT$M_NOECHO); /* restore echo */
- stty(0, &sgttyb_val);
-fatal:
- fprintf(stderr, "Fatal input error.\n");
- exit(1);
-}
-
-rnetrc(host, aname, apass)
- char *host, **aname, **apass;
-{
-
- static FILE *cfile;
- char rcline[100];
- char *hdir, buf[100], mach[30];
- struct stat stb;
-
- hdir = getenv("HOME");
- if (hdir == NULL)
- hdir = ".";
- sprintf(buf, "%sftplogin.", hdir); /* Using the TWG FTPLOGIN file */
- cfile = fopen(buf, "r");
- if (cfile == NULL) {
- if (errno != ENOENT)
- perror(buf);
- return;
- }
-
-/* Note that the format of the TWG "ftplogin" file is simpler than .netrc */
-
- while (fgets(rcline, sizeof(rcline), cfile) != NULL) {
-
- if (sscanf(rcline, "%s %s %s", mach, usr, pss) != 3
- || strcmp(host, mach)) continue;
-
- *aname = usr; /* now we have a user on the right machine */
-
- if (!strcmp(pss, "-")) break;
-
-/* Have a hit and a "real" password: check mode/ownership & warn if bad.. */
-/* (No good on VMS as no bits for group/world r/w/x are provided........)
-#define RWXRWX 077
-
- if (fstat(fileno(cfile), &stb) >= 0
- && (stb.st_mode & RWXRWX) != 0) {
- fprintf(stderr,
- "WARNING - file: %s insufficiently protected.\n", buf);
- fprintf(stderr,
- " - Remove password or restrict its access.\n");
- break;
- }
- ..(No good on VMS as no bits for group/world r/w/x are provided........) */
-
- *apass = pss; /* all OK */
- break;
- }
- fclose(cfile);
-}
-#else /* ^VMS */
-
-#ifndef NORUSERPASS
-
-#define DEFAULT 1
-#define LOGIN 2
-#define PASSWD 3
-#define NOTIFY 4
-#define WRITE 5
-#define YES 6
-#define NO 7
-#define COMMAND 8
-#define FORCE 9
-#define ID 10
-#define MACHINE 11
-
-static char tokval[100];
-
-static struct toktab {
- char *tokstr;
- int tval;
-} toktab[]= {
- "default", DEFAULT,
- "login", LOGIN,
- "password", PASSWD,
- "notify", NOTIFY,
- "write", WRITE,
- "yes", YES,
- "y", YES,
- "no", NO,
- "n", NO,
- "command", COMMAND,
- "force", FORCE,
- "machine", MACHINE,
- 0, 0
-};
-
-#ifdef IBMMVS
-static FILE *cfile;
-
-ruserpass(host, aname, apass)
- char *host, **aname, **apass;
-{
- int i1,i2,i3;
- int i = 0,ch;
- char *myname;
- char buff[100];
- char buff1[10];
- char buff2[100];
- char buff3[100];
-
- if (*aname == 0 || *apass == 0)
- rnetrc(host, aname, apass);
-
- if (*aname == 0) {
- *aname = malloc(101);
- JOBNAM(buff1);
- buff1??(4??) = '\0';
- myname = buff1;
- sprintf(buff, "Name (%s:%s): ", host, myname);
- printf("%s",buff);
- /* ch=getchar(); */ /* first character after printf is \n */
- for(i=0;(i<99) && ((ch=getchar()) != EOF) &&(ch!='\n') ; i++)
- buff2??(i??) = ch;
- buff2??(i??) = '\0';
- if (i == 0 )
- strcpy(*aname, myname);
- else
- strcpy(*aname, buff2);
- }
-
- if ( *aname && *apass == 0 ) {
- *apass = malloc(101);
- sprintf(buff, "Password (%s:%s): ", host, *aname);
- i1 = strlen(buff);
- i2 = 99;
- i3 = 0;
- buff3??(0??) = '\0';
- while (strlen(buff3) == 0) {
- GETINH(buff,i1,buff3,i2,i3);
- for (i = 0 ; ((i < 99) && buff3??(i??) != ' ') ;i++);
- buff3??(i??) = '\0';
- }
- strcpy(*apass, buff3);
- }
-}
-#endif /* IBMMVS */
-
-#ifdef IBMVM
-static FILE *cfile;
-
-ruserpass(host, aname, apass)
- char *host, **aname, **apass;
-{
- char *myname;
- char buff[100];
-
- if (*aname == 0 || *apass == 0)
- rnetrc(host, aname, apass);
-/*rintf(stderr,"host = %s aname = %s apass = %s\n",host,*aname,*apass);*/
- if (*aname == 0) {
- myname = getlogin();
- sprintf(buff, "Name (%s:%s): ", host, myname);
- *aname = LNRD(buff);
- if ((*aname)[0] == '\0')
- *aname = myname;
- }
- if (*aname && *apass == 0) {
- sprintf(buff, "Password (%s:%s): ", host, *aname);
- *apass = LNRDPAS(buff);
- }
-}
-#endif /* IBMVM */
-
-#ifdef IBM
-
-static
-rnetrc(host, aname, apass)
- char *host, **aname, **apass;
-{
- char buf[BUFSIZ];
- int t;
-
-#ifdef IBMVM
- strcpy(buf, "DOT.NETRC.A0");
-#else
- strcpy(buf, "DOT.NETRC");
-#endif
-
- cfile = fopen(buf, "r");
- if (cfile == NULL) {
- if (errno != ENOENT)
- /* perror(buf); */
- return;
- }
-next:
- while ((t = token())) switch(t) {
-
- case DEFAULT:
- (void) token();
- continue;
-
- case MACHINE:
- if (token() != ID || strcmp(host, tokval))
- continue;
- while ((t = token()) && t != MACHINE) switch(t) {
-
- case LOGIN:
- if (token())
- if (*aname == 0) {
- *aname = malloc(strlen(tokval) + 1);
- strcpy(*aname, tokval);
- } else {
- if (strcmp(*aname, tokval))
- goto next;
- }
- break;
- case PASSWD:
- if (token() && *apass == 0) {
- *apass = malloc(strlen(tokval) + 1);
- strcpy(*apass, tokval);
- }
- break;
- case COMMAND:
- case NOTIFY:
- case WRITE:
- case FORCE:
- (void) token();
- break;
- default:
- fprintf(stderr, "Unknown .netrc option %s\n", tokval);
- break;
- }
- goto done;
- }
-done:
- fclose(cfile);
-}
-
-#else /* ^IBM */
-
-#if defined(CERNLIB_V93B)
-
-#include <sys/types.h>
-#include <sys/stat.h>
-#include <errno.h>
-
-char *malloc(), *index(), *getpass(), *getlogin();
-static FILE *cfile;
-
-ruserpass(host, aname, apass)
- char *host, **aname, **apass;
-{
-
- if (*aname == 0 || *apass == 0)
- rnetrc(host, aname, apass);
- if (*aname == 0) {
- char *myname = getlogin();
- *aname = malloc(16);
- printf("Name (%s:%s): ", host, myname);
- fflush(stdout);
- if (read(2, *aname, 16) <= 0)
- exit(1);
- if ((*aname)[0] == '\n')
- *aname = myname;
- else
- if (index(*aname, '\n'))
- *index(*aname, '\n') = 0;
- }
- if (*aname && *apass == 0) {
- printf("Password (%s:%s): ", host, *aname);
- fflush(stdout);
- *apass = getpass("");
- }
-}
-
-#endif
-
-#include <sys/types.h>
-#include <sys/stat.h>
-#if !defined(NEXT) && !defined(_WIN32)
-#include <pwd.h>
-#endif /* ^NEXT */
-#include <errno.h>
-
-char *ku_pros( /* char *prompt, char *default */ );
-char *ku_prop( /* char *prompt */ );
-
-/* Fails with gcc 3.4.3
-#ifndef _WIN32
- char *malloc(), *index(), *getpass(), *getuid();
-#endif
- */
-
-static FILE *cfile;
-
-ruserpass(host, aname, apass)
- char *host, **aname, **apass;
-{
-
- if (*aname == 0 || *apass == 0)
- rnetrc(host, aname, apass);
- if (*aname == 0) {
- char prompt[80];
- char *answ;
-#ifndef _WIN32
- char *myname;
- uid_t uid;
- struct passwd *pwd;
- uid = getuid();
- pwd = getpwuid(uid);
- myname = pwd->pw_name;
-#else
- char myname[30];
- int lmyname = sizeof(myname);
- GetUserName(myname,&lmyname);
-#endif
- sprintf(prompt, "Name (%s:%s):", host, myname);
- answ = ku_pros(prompt, NULL);
- if( answ != NULL ) {
- if( answ[0] == '\0' )
- answ = myname;
- *aname = strcpy( malloc(strlen(answ)+1), answ );
- }
- }
- if (*aname && *apass == 0) {
- char prompt[80];
- char *answ;
- sprintf(prompt, "Password (%s:%s):", host, *aname);
- answ = ku_prop(prompt);
- if( answ != NULL ) {
- *apass = strcpy( malloc(strlen(answ)+1), answ );
- }
- }
-}
-
-static
-rnetrc(host, aname, apass)
- char *host, **aname, **apass;
-{
- char *hdir, buf[BUFSIZ];
- int t;
-#ifndef _WIN32
- struct stat stb;
- extern int errno;
-#else
- struct _stat stb;
-#endif
- char *getenv();
-
- hdir = getenv("HOME");
- if (hdir == NULL)
- hdir = ".";
- sprintf(buf, "%s/.netrc", hdir);
- cfile = fopen(buf, "r");
- if (cfile == NULL) {
- if (errno != ENOENT)
- perror(buf);
- return;
- }
-next:
- while ((t = token())) switch(t) {
-
- case DEFAULT:
- (void) token();
- continue;
-
- case MACHINE:
- if (token() != ID || strcmp(host, tokval))
- continue;
- while ((t = token()) && t != MACHINE) switch(t) {
-
- case LOGIN:
- if (token())
- if (*aname == 0) {
- *aname = malloc(strlen(tokval) + 1);
- strcpy(*aname, tokval);
- } else {
- if (strcmp(*aname, tokval))
- goto next;
- }
- break;
- case PASSWD:
- if (fstat(fileno(cfile), &stb) >= 0
- && (stb.st_mode & 077) != 0) {
- fprintf(stderr, "Error - .netrc file not correct mode.\n");
- fprintf(stderr, "Remove password or correct mode.\n");
- exit(1);
- }
- if (token() && *apass == 0) {
- *apass = malloc(strlen(tokval) + 1);
- strcpy(*apass, tokval);
- }
- break;
- case COMMAND:
- case NOTIFY:
- case WRITE:
- case FORCE:
- (void) token();
- break;
- default:
- fprintf(stderr, "Unknown .netrc option %s\n", tokval);
- break;
- }
- goto done;
- }
-done:
- fclose(cfile);
-}
-
-#endif /* IBM*/
-
-#ifdef _WIN32
- static FILE *cfile;
-#endif
-
-static
-token()
-{
-
- char *cp;
- int c;
- struct toktab *t;
-
- if (feof(cfile))
- return (0);
- while ((c = getc(cfile)) != EOF &&
- (c == '\n' || c == '\t' || c == ' ' || c == ','))
- continue;
- if (c == EOF)
- return (0);
- cp = tokval;
- if (c == '"') {
- while ((c = getc(cfile)) != EOF && c != '"') {
- if (c == '\\')
- c = getc(cfile);
- *cp++ = c;
- }
- } else {
- *cp++ = c;
- while ((c = getc(cfile)) != EOF
- && c != '\n' && c != '\t' && c != ' ' && c != ',') {
- if (c == '\\')
- c = getc(cfile);
- *cp++ = c;
- }
- }
- *cp = 0;
- if (tokval[0] == 0)
- return (0);
- for (t = toktab; t->tokstr; t++)
- if (!strcmp(t->tokstr, tokval))
- return (t->tval);
- return (ID);
-}
-
-#if !defined(IBM) && !defined(_WIN32)
-/* I provide "getpass" myself as standard version truncates to 8 characters */
-#include <sys/ioctl.h>
-#ifdef CBREAK
-#define BSDTTY /* First find out if BSD or SYSV terminal handling.. */
-#endif
-
-#ifndef BSDTTY
-#include <termio.h>
-#else
-#include <sgtty.h>
-#endif
-
-/* Fails with gcc 3.4.3
-#ifndef __convexc__
-extern int kill(), ioctl(), getpid();
-#endif */ /* __convexc__ */
-static int intrupt;
-
-/*** NOTE MAXPASSWD IS DEFINED AS 8 IN ALL STANDARD UNIX SYSTEMS, BUT THIS
- *** GIVES US PROBLEMS INTERWORKING WITH VMS AND CRAY-SECURID SYSTEMS. ***/
-#define MAXPASSWD 20 /* max significant characters in password */
-
-char *
-getpass(prompt)
-char *prompt;
-{
-#ifndef BSDTTY
- struct termio ttyb;
- unsigned short flags;
-#else
- struct sgttyb ttyb;
- int flags;
-#endif
- register char *p;
- register int c;
- FILE *fi;
- static char pbuf[ MAXPASSWD + 1 ];
- void (*sig)(), catch();
-
- if((fi = fopen("/dev/tty", "r")) == NULL)
- return((char*)NULL);
- setbuf(fi, (char*)NULL);
- sig = signal(SIGINT, catch);
- intrupt = 0;
-#ifndef BSDTTY
- (void) ioctl(fileno(fi), TCGETA, &ttyb);
- flags = ttyb.c_lflag;
- ttyb.c_lflag &= ~(ECHO | ECHOE | ECHOK | ECHONL);
- (void) ioctl(fileno(fi), TCSETAF, &ttyb);
-#else
- gtty(fileno(fi), &ttyb);
- flags = ttyb.sg_flags;
- ttyb.sg_flags &= ~ECHO;
- stty(fileno(fi), &ttyb);
-#endif
- (void) fputs(prompt, stderr);
- p = pbuf;
- while( !intrupt &&
- (c = getc(fi)) != '\n' && c != '\r' && c != EOF ) {
- if(p < &pbuf[ MAXPASSWD ])
- *p++ = c;
- }
- *p = '\0';
-#ifndef BSDTTY
- ttyb.c_lflag = flags;
- (void) ioctl(fileno(fi), TCSETAW, &ttyb);
-#else
- ttyb.sg_flags = flags;
- stty(fileno(fi), &ttyb);
-#endif
- (void) putc('\n', stderr);
- (void) signal(SIGINT, sig);
- if(fi != stdin)
- (void) fclose(fi);
- if(intrupt)
- (void) kill(getpid(), SIGINT);
- return(pbuf);
-}
-
-static void
-catch()
-{
- ++intrupt;
-}
-#endif /* ^IBM*/
-#endif /* NORUSERPASS */
-#endif /* VMS */
-
-/* I provide "rexec" myself as standard version does not allow IP addresses */
-
-#if defined(CERNLIB_SOLARIS)
-/* Solaris headers clash with an old style definition */
-rexec(char **ahost, unsigned short rport, char *name,
- char *pass, char *cmd, int *fd2p)
-#else
-# ifdef linux
-_rexec(ahost, rport, name, pass, cmd, fd2p)
-# else
-rexec(ahost, rport, name, pass, cmd, fd2p)
-# endif /* linux */
-
- char **ahost;
- int rport;
- char *name, *pass, *cmd;
- int *fd2p;
-#endif
-{
-#ifdef IBM
- extern char asciitoebcdic[]; /* translation tables */
- extern char ebcdictoascii[];
-#endif /* IBM */
- int s, timo = 1;
- struct sockaddr_in sin;
- char c;
- short port;
- struct hostent *hp;
- unsigned long addr;
-
- if ((addr = inet_addr(*ahost)) != -1) { /* Permit IP addresses */
- sin.sin_addr.s_addr = addr;
- } else {
- hp = gethostbyname(*ahost);
- if (hp == 0) {
- fprintf(stderr, "%s: unknown host\n", *ahost);
- return (-1);
- }
-/* NOT NICE *ahost = hp->h_name; THIS IS NOT NICE */
- }
- ruserpass(*ahost, &name, &pass);
-
-retry:
- s = socket(AF_INET, SOCK_STREAM, 0);
- if (s < 0) {
-#if defined(IBM) || defined(_WIN32)
- tcperror("rexec: socket");
-#else
- perror("rexec: socket");
-#endif /* IBM */
- return (-1);
- }
- sin.sin_family = AF_INET;
- sin.sin_port = (short)rport;
- if (addr != -1) { /* Permit IP addresses */
- sin.sin_addr.s_addr = addr;
- } else {
- sin.sin_addr.s_addr =
- ((struct in_addr *)(hp->h_addr))->s_addr;
-/* bcopy(hp->h_addr, (caddr_t)&sin.sin_addr, hp->h_length); */
- }
- if (connect(s, &sin, sizeof(struct sockaddr_in)) == SOCKET_ERROR ) {
-#ifndef _WIN32
- if (errno == ECONNREFUSED && timo <= 16) {
- (void) close(s);
- sleep(timo);
- timo *= 2;
- goto retry;
- }
-#else
- if (WSAGetLastError() == WSAECONNREFUSED
- && timo <= 16) {
- (void) closesocket(s);
- sleep(timo);
- timo *= 2;
- goto retry;
- }
-#endif
-
-#if defined(IBM) || defined(_WIN32)
- tcperror("rexec: connect");
-#else
- perror("rexec: connect");
-#endif /* IBM */
- return (-1);
- }
- if (fd2p == 0) {
- (void) send(s, "", 1, 0);
- port = 0;
- } else {
- fprintf(stderr, "Control channel not implemented\n");
- goto bad;
- }
-#ifdef IBM
- CMXLATE(name,ebcdictoascii,strlen(name));
- CMXLATE(pass,ebcdictoascii,strlen(pass));
- CMXLATE(cmd,ebcdictoascii,strlen(cmd));
-#endif /* IBM */
- (void) send(s, name, strlen(name) + 1, 0);
- (void) send(s, pass, strlen(pass) + 1, 0);
- (void) send(s, cmd, strlen(cmd) + 1, 0);
- if (recv(s, &c, 1, 0) != 1) {
-#if defined(IBM) || defined(_WIN32)
- tcperror("rexec recv");
-#else
- perror("rexec recv");
-#endif /* IBM */
- goto bad;
- }
- if (c != 0) {
- fprintf(stderr,"c = ");
- while (recv(s, &c, 1, 0) == 1) {
-#ifdef IBM
- CMXLATE(&c,asciitoebcdic,1);
-#endif /* IBM */
- fprintf(stderr,"%c",c);
- (void) send(2, &c, 1, 0);
- if (c == '\n')
- break;
- }
- fprintf(stderr,"\n ended");
- goto bad;
- }
- return (s);
-bad:
- if (port)
- (void) close(*fd2p);
- (void) close(s);
- return (-1);
-}
-
-
-/******** INTERFACE ROUTINES TO HANDLE VARIOUS NAMING CONVENTIONS *********/
-
-/*** COMPATIBILITY-MODE: FULL-LENGTH NAMES AS USED IN EARLY "TCPAW" ***/
-
-#ifndef OSK
-#ifndef IBM
-int inetd_sock_setup(in, out)
-int *in, *out;
-{
- return(isetup(in, out));
-}
-
-int inetd_sock_close(sock)
-int *sock;
-{
- return(iclose(sock));
-}
-#endif /* ^IBM*/
-#endif /* OSK */
-
-int server_sock_setup(in, out)
-int *in, *out;
-{
- return(ssetup(in, out));
-}
-
-#ifdef VMS
-int client_sock_setup(sysdes, in, out, srvdes) /* VMS CASE... */
-struct dsc$descriptor_s *sysdes;
-int *in, *out;
-struct dsc$descriptor_s *srvdes;
-{
- return(csetup(sysdes, in, out, srvdes));
-}
-#else
-#ifdef APOFTN
-int client_sock_setup(system, in, out, srvc, s_ln, c_ln) /* APOLLO FTN CASE */
-char *system; /* (PRE-SR9 ONLY) */
-int *in, *out;
-char *srvc;
-short *s_ln, *c_ln; /* dummy arguments */
-{
- return(csetup(system, in, out, srvc, s_ln, c_ln));
-}
-#else
-int client_sock_setup(system, in, out, srvc) /* UNIX ETC... */
-char *system;
-int *in, *out;
-char *srvc;
-{
- return(csetup(system, in, out, srvc));
-}
-#endif /* APOFTN */
-#endif /* VMS */
-
-int sock_close(sock)
-int *sock;
-{
- return(sclose(sock));
-}
-
-#ifdef VMS
-int sock_sendstr(sock, bufdes, m) /* VMS CASE... */
-int *sock;
-struct dsc$descriptor_s *bufdes;
-int *m;
-{
- return(ssendstr(sock, bufdes, m));
-}
-#else
-int sock_sendstr(sock, buf, m)
-int *sock;
-char *buf;
-int *m;
-{
- return(ssendstr(sock, buf, m));
-}
-#endif /* VMS */
-
-#ifdef VMS
-int sock_recvstr(sock, bufdes, m) /* VMS CASE... */
-int *sock;
-struct dsc$descriptor_s *bufdes;
-int *m;
-{
- return(srecvstr(sock, bufdes, m));
-}
-#else
-int sock_recvstr(sock, buf, m)
-int *sock;
-char *buf;
-int *m;
-{
- return(srecvstr(sock, buf, m));
-}
-#endif /* VMS */
-
-int sock_send(sock, buf, m)
-int *sock;
-char *buf;
-int *m;
-{
- return(ssend(sock, buf, m));
-}
-
-int sock_recv(sock, buf, m)
-int *sock;
-char *buf;
-int *m;
-{
- return(srecv(sock, buf, m));
-}
-
-/* #ifndef apollo */
-#if !defined(apollo) || defined(APOLLO_F77)
-/*** UNIX routines f77 <-> C to handle underlines generated by FORTRAN ***/
-/*** CASE FOR SYSTEMS USING FULL-LENGTH NAMES (WITH UNDERLINES) IN F77 ***/
-
-int client_sock_setup_(system, in, out, srvc)
-char *system;
-int *in, *out;
-char *srvc;
-{
- return(csetup(system, in, out, srvc));
-}
-
-#ifndef OSK
-#ifndef IBM
-int inetd_sock_setup_(in, out)
-int *in, *out;
-{
- return(isetup(in, out));
-}
-
-int inetd_sock_close_(sock)
-int *sock;
-{
- return(iclose(sock));
-}
-#endif /* ^IBM*/
-#endif /* OSK */
-
-int server_sock_setup_(in, out)
-int *in, *out;
-{
- return(ssetup(in, out));
-}
-
-int sock_close_(sock)
-int *sock;
-{
- return(sclose(sock));
-}
-
-int sock_sendstr_(sock, buf, m)
-int *sock;
-char *buf;
-int *m;
-{
- return(ssendstr(sock, buf, m));
-}
-
-int sock_recvstr_(sock, buf, m)
-int *sock;
-char *buf;
-int *m;
-{
- return(srecvstr(sock, buf, m));
-}
-
-int sock_send_(sock, buf, m)
-int *sock;
-char *buf;
-int *m;
-{
- return(ssend(sock, buf, m));
-}
-
-int sock_recv_(sock, buf, m)
-int *sock;
-char *buf;
-int *m;
-{
- return(srecv(sock, buf, m));
-}
-
-/*** CASE FOR SYSTEMS USING SHORTENED NAMES (WITHOUT UNDERLINES) IN F77 ***/
-/*** (NEEDED FOR SOME ULTRIX VERSIONS....) ***/
-
-int csetup_(system, in, out, srvc)
-char *system;
-int *in, *out;
-char *srvc;
-{
- return(csetup(system, in, out, srvc));
-}
-#ifndef OSK
-#ifndef IBM
-
-int isetup_(in, out)
-int *in, *out;
-{
- return(isetup(in, out));
-}
-
-int iclose_(sock)
-int *sock;
-{
- return(iclose(sock));
-}
-#endif /* ^IBM*/
-#endif /* OSK */
-
-int ssetup_(in, out)
-int *in, *out;
-{
- return(ssetup(in, out));
-}
-
-int sclose_(sock)
-int *sock;
-{
- return(sclose(sock));
-}
-
-int ssendstr_(sock, buf, m)
-int *sock;
-char *buf;
-int *m;
-{
- return(ssendstr(sock, buf, m));
-}
-
-int srecvstr_(sock, buf, m)
-int *sock;
-char *buf;
-int *m;
-{
- return(srecvstr(sock, buf, m));
-}
-
-int ssend_(sock, buf, m)
-int *sock;
-char *buf;
-int *m;
-{
- return(ssend(sock, buf, m));
-}
-
-int srecv_(sock, buf, m)
-int *sock;
-char *buf;
-int *m;
-{
- return(srecv(sock, buf, m));
-}
-#endif /* apollo */
-
-#if defined(CRAYFTN)
-/**** SPECIAL VERSION FOR CRAY CFT77 */
-
-int CSETUP(system, in, out, srvc)
-_fcd system;
-int *in, *out;
-_fcd srvc;
-{
- return(csetup(system, in, out, srvc));
-}
-
-int type_of_call ISETUP(in, out)
-int *in, *out;
-{
- return(isetup(in, out));
-}
-
-int type_of_call ICLOSE(sock)
-SOCKET *sock;
-{
- return(iclose(sock));
-}
-
-int type_of_call SSETUP(in, out)
-int *in, *out;
-{
- return(ssetup(in, out));
-}
-
-int type_of_call SCLOSE(sock)
-int *sock;
-{
- return(sclose(sock));
-}
-
-int SSENDSTR(sock, buf, m)
-int *sock;
-_fcd buf;
-int *m;
-{
- return(ssendstr(sock, buf, m));
-}
-
-int SRECVSTR(sock, buf, m)
-int *sock;
-_fcd buf;
-int *m;
-{
- return(srecvstr(sock, buf, m));
-}
-
-int type_of_call SSEND(sock, buf, m)
-int *sock;
-char *buf;
-int *m;
-{
- return(ssend(sock, buf, m));
-}
-
-int type_of_call SRECV(sock, buf, m)
-int *sock;
-char *buf;
-int *m;
-{
- return(srecv(sock, buf, m));
-}
-#endif /* CRAYFTN */
-
-#ifdef CERNLIB_MSSTDCALL
-/**** SPECIAL VERSION FOR Microsoft Powerstation Fortran ***/
-
-int type_of_call CSETUP(system, lsys, in, out, srvc, lsrvc)
-char *system;
-int lsys, lsrvc;
-int *in, *out;
-char *srvc;
-{
- return(csetup(system, lsys, in, out, srvc,lsrvc));
-}
-
-int type_of_call ISETUP(in, out)
-int *in, *out;
-{
- return(isetup(in, out));
-}
-
-int type_of_call ICLOSE(sock)
-int *sock;
-{
- return(iclose(sock));
-}
-
-int type_of_call SSETUP(in, out,port)
-int *in, *out,*port;
-{
- return(ssetup(in, out, port));
-}
-
-int type_of_call SCLOSE(sock)
-int *sock;
-{
- return(sclose(sock));
-}
-
-int type_of_call SSENDSTR(sock, buf, lbuf, m)
-int *sock;
-char *buf;
-int lbuf;
-int *m;
-{
- return(ssendstr(sock, buf, lbuf, m));
-}
-
-int type_of_call SRECVSTR(sock, buf, lbuf, m)
-int *sock;
-char *buf;
-int lbuf;
-int *m;
-{
- return(srecvstr(sock, buf, lbuf, m));
-}
-
-int type_of_call SSEND(sock, buf, m)
-int *sock;
-char *buf;
-int *m;
-{
- return(ssend(sock, buf, m));
-}
-
-int type_of_call SRECV(sock, buf, m)
-int *sock;
-char *buf;
-int *m;
-{
- return(srecv(sock, buf, m));
-}
-#endif /* Microsoft Fortran */
-
-
-#ifdef OSK
-/**** SPECIAL VERSION FOR OS9 ONLY ***/
-
-char cserv[80],chost[80];
-
-int CLIENT_SOCK_SETUP(host,isock,osock,service)
-char *host, *service;
-int *isock;
-int *osock;
-{
- return(client_sock_setup(strfc(chost,host,80),isock,osock,
- strfc(cserv,service,80)));
-}
-
-int SERVER_SOCK_SETUP(isock,osock)
-int *isock;
-int *osock;
-{
- return(server_sock_setup(isock,osock));
-}
-
-int SOCK_CLOSE(sock)
-int *sock;
-
-{
- return(sock_close(sock));
-}
-
-int SOCK_SENDSTR(sock, buf, m)
-int *sock;
-char *buf;
-int *m;
-
-{
- return(sock_sendstr(sock, buf, m));
-}
-
-int SOCK_RECVSTR(sock, buf, m)
-int *sock;
-char *buf;
-int *m;
-
-{
- return(sock_recvstr(sock, buf, m));
-}
-
-int SOCK_SEND(sock, buf, m)
-int *sock;
-char *buf;
-int *m;
-
-{
- return(sock_send(sock, buf, m));
-}
-
-int SOCK_RECV(sock, buf, m)
-int *sock;
-char *buf;
-int *m;
-
-{
- return(sock_recv(sock, buf, m));
-}
-#endif /* OSK */
-
-#ifdef IBM
-int cinit(int dummy)
-{
-/* fprintf(stderr,"Initializing C environment...\n");*/
- return(0); /*to init the c environment*/
-}
-
-/* get length of a Fortran string given as argument */
-int gtlnfstr(plistaddr,argposition)
-void *plistaddr; /* &first_arg */
-int argposition; /* n for nth argument */
-{
- int **secplist;
- int *poffset;
- char *bzstr;
-
- poffset =(int *)plistaddr;
- poffset = poffset - 1;
- bzstr =(char *)(poffset -1);
- if (!strcmp(bzstr,"BZ")){
- secplist =(int **)((char *)plistaddr + *poffset);
- return( **(secplist + argposition - 1));
- }
- else{
- return(-1); /* no secondary plist when no character*n arg */
- }
-}
-#endif /* IBM */
-
-
-#ifdef IBMMVS
-
-/* systemf not found in cspack, so added for IBMMVS */
-
-int systemf(command)
-char *command;
-
-{
- char *c;
- int i, j, k;
-
-#ifdef DEBUG
- printf(" systemf: command = '%s' \n",command);
-#endif /* DEBUG */
-
- /*Terminate correctly the host & service strings passed by FTN..*/
- j = strlen(command);
- for (k=0; k<j; k++) if (command[k] == ' ') {command[k] = '\0'; break;}
- /* And map to lower case... */
- c = command; while (*c) { if (isupper(*c)) *c = tolower(*c); c++; }
-
-#ifdef DEBUG
- printf(" systemf: command = '%s' \n",command);
-#endif /* DEBUG */
-
-
- i = system(command);
-
- return(0);
-}
-
-#endif /* IBMMVS */
-/* client to connect to tsosubd on mvs */
-int
-tsosub(ahost, rport, name, pass, cmd, sport)
- char **ahost;
- int rport;
- char *name, *pass, *cmd;
- unsigned short *sport;
-{
-#ifdef IBM
- extern char asciitoebcdic[]; /* translation tables */
- extern char ebcdictoascii[];
-#endif /*TEST */
- int s, timo = 1;
- struct sockaddr_in sin;
- char c;
- short port;
- struct hostent *hp;
- unsigned long addr;
- char buf[80];
- char cmdbuf[80];
-
-/* This fails on the Sun
- char machine[80] = "machine";
- char user[80] = "user";
- char tty [80] = "tty"; */
- char machine[80];
- char user[80];
- char tty [80];
- char cmvs_sport[80];
- char servreply[80];
-
-/* but this is ok */
-
- sprintf(machine,"%s","machine");
- sprintf(user,"%s","user");
- sprintf(tty,"%s","tty");
-
- if ((addr = inet_addr(*ahost)) != -1) { /* Permit IP addresses */
- sin.sin_addr.s_addr = addr;
- } else {
- hp = gethostbyname(*ahost);
- if (hp == 0) {
- fprintf(stderr, "%s: unknown host\n", *ahost);
- return (-1);
- }
- }
-
- ruserpass(*ahost, &name, &pass);
-
-retry:
- s = socket(AF_INET, SOCK_STREAM, 0);
- if (s < 0) {
-#ifdef IBM
- tcperror("tsosub: socket");
-#else
- perror("tsosub: socket");
-#endif /* IBM */
- return (-1);
- }
- sin.sin_family = AF_INET;
- sin.sin_port = (short)rport;
- if (addr != -1) { /* Permit IP addresses */
- sin.sin_addr.s_addr = addr;
- } else {
- sin.sin_addr.s_addr =
- ((struct in_addr *)(hp->h_addr))->s_addr;
-/* bcopy(hp->h_addr, (caddr_t)&sin.sin_addr, hp->h_length); */
- }
- if (connect(s, &sin, sizeof(struct sockaddr_in)) == SOCKET_ERROR) {
-#ifndef WIN32
- if (errno == ECONNREFUSED && timo <= 16) {
- (void) close(s);
- sleep(timo);
- timo *= 2;
- goto retry;
- }
-#else
- if (WSAGetLastError() == WSAECONNREFUSED && timo <= 16) {
- (void) closesocket(s);
- sleep(1000*timo);
- timo *= 2;
- goto retry;
- }
-#endif
-
-#ifdef IBM
- tcperror("tsosub: connect");
-#else
- perror("tsosub: connect");
-#endif /* IBM */
- return (-1);
- }
- port = 0;
-#ifdef IBM
- CMXLATE(machine,ebcdictoascii,strlen(machine));
- CMXLATE(user,ebcdictoascii,strlen(user));
- CMXLATE(tty,ebcdictoascii,strlen(tty));
- CMXLATE(name,ebcdictoascii,strlen(name));
- CMXLATE(pass,ebcdictoascii,strlen(pass));
- CMXLATE(cmd,ebcdictoascii,strlen(cmd));
-#endif /* IBM */
-
- if ( send(s, machine, strlen(machine) + 1, 0) < 0) {
-#ifdef IBM
- tcperror("tsosub: send machine");
-#else
- perror("tsosub: send machine");
-#endif /* IBM */
- goto bad;
- }
-
- if ( send(s, user, strlen(user) + 1, 0) < 0) {
-#ifdef IBM
- tcperror("tsosub: send user");
-#else
- perror("tsosub: send user");
-#endif /* IBM */
- goto bad;
- }
-
- if ( send(s, tty, strlen(tty) + 1, 0) < 0) {
-#ifdef IBM
- tcperror("tsosub: send tty");
-#else
- perror("tsosub: send tty");
-#endif /* IBM */
- goto bad;
- }
-
- if ( send(s, name, strlen(name) + 1, 0) < 0) {
-#ifdef IBM
- tcperror("tsosub: send name");
-#else
- perror("tsosub: send name");
-#endif /* IBM */
- goto bad;
- }
-
- if ( send(s, pass, strlen(pass) + 1, 0) < 0) {
-#ifdef IBM
- tcperror("tsosub: send pass");
-#else
- perror("tsosub: send pass");
-#endif /* IBM */
- goto bad;
- }
-
- if ( send(s, cmd, strlen(cmd) + 1, 0) < 0) {
-#ifdef IBM
- tcperror("tsosub: send cmd");
-#else
- perror("tsosub: send cmd");
-#endif /* IBM */
- goto bad;
- }
-
- sprintf(buf,"%i",*sport);
-#ifdef IBM
- CMXLATE(buf,ebcdictoascii,strlen(buf));
-#endif /* IBM */
- if ( send(s, buf, strlen(buf) + 1, 0) < 0 ) {
-#ifdef IBM
- tcperror("tsosub: send sport");
-#else
- perror("tsosub: send sport");
-#endif /* IBM */
- goto bad;
- }
-
-
- if (getstr(s,cmvs_sport,sizeof(cmvs_sport),"mvs_sport") <= 0) {
- goto bad;
- }
-
-#ifdef IBM
- CMXLATE(cmvs_sport,asciitoebcdic,strlen(cmvs_sport));
-#endif /* IBM */
-
- *sport = atoi(cmvs_sport);
-
- if (getstr(s,servreply,sizeof(servreply),"servreply") <= 0) {
- goto bad;
- }
-
-#ifdef IBM
- CMXLATE(servreply,asciitoebcdic,strlen(servreply));
- CMXLATE(cmd,asciitoebcdic,strlen(cmd));
-#endif /* IBM */
-
- fprintf(stderr,"%s\n",servreply);
-
- close(s);
-
- return (1);
-bad:
-
- close(s);
-
- return (-1);
-}
-
-getstr(sock,buf, cnt, errmesg)
-int *sock;
-char *buf;
-int cnt; /* sizeof() the char array */
-char *errmesg; /* in case error message required */
-{
- char c;
- int k = 0;
-
- do {
- if ( read(sock, &c, 1) != 1) {
- printf("Error or EOF while reading %s from socket.\n",
- errmesg);
- return(-1); /* error or EOF */
- }
- *buf++ = c;
- k++;
- if (--cnt == 0) {
- printf("%s too long from socket.\n", errmesg);
- return(-1);
- }
- } while (c!= 0); /* null byte terminates the string */
-
- return(k-1);
-
-}
-#endif
diff --git a/src/packlib/cspack/tcpaw/tcpawibm.F b/src/packlib/cspack/tcpaw/tcpawibm.F
deleted file mode 100644
index 18c3c05..0000000
--- a/src/packlib/cspack/tcpaw/tcpawibm.F
+++ /dev/null
@@ -1,758 +0,0 @@
-*
-* $Id: tcpawibm.F,v 1.1.1.1 1996/03/08 15:44:27 mclareni Exp $
-*
-* $Log: tcpawibm.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:27 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
-#if (defined(CERNLIB_IBM))&&(!defined(CERNLIB_TCPSOCK))
-* For systems without SAA C compiler or TCP/IP V2.0
-#endif
-/**********************************************************************/
-/* */
-/* PASCAL TCP/IP PACKAGE FOR PAW */
-/* */
-/* C.Magnin / CERN DD SW VX / */
-/* */
-/* Modified 13-AUG-90 J.D. Shiers to call ReadNE (Read No Echo) to */
-/* get password. READNE uses LINERD macro with TYPE=INVISIBLE. */
-/* */
-/* Designed to be called from FORTRAN, once for SETUP and */
-/* once for each data transfer (send/receive). */
-/* At exit time, the CLOSE routine should be run. */
-/* */
-/* */
-/* */
-/**********************************************************************/
-
-segment IBMPAW;
-
-%include CMALLCL
-%include CMINTER
-%include CMRESGLB
-%include CMEBCASC
-%include CMS
-
-const
- BUFFERClength = 20480;
- BUFFERBlength = 2048;
- OPENtimeout = 120;
-/* OPENtimeout = 60;*/
-
-type
- String30 = Packed Array [1..30] Of Char;
- String80 = Packed Array [1..80] Of Char;
- Buffertc = Packed array [1..BUFFERClength] of char;
- Buffertb = Array [1..BUFFERBlength] of integer;
-
-#if defined(CERNLIB_IBMVM)
- Procedure ReadNE (var Password: String30;
- var lenp : integer);
- external;
-#endif
-
- procedure Restore ( const Message: string;
- const ReturnCode: integer );
- begin
- Write (Message);
- if ReturnCode <> OK then
- Write (SayCalRe(ReturnCode));
- WriteLn ('');
-
- EndTcpIp;
- Close (Input);
- Close (Output);
- end;
-
- procedure SASCIITOE
- (var Bufascii: buffertc;
- var Lbufasci: integer);
- VAR
- I: integer;
- C: char;
-
- begin
- for I := 1 to Lbufasci DO
- begin
- c := bufascii[I];
- bufascii[I] := Asciitoebcdic[c];
- end;
- end;
-
-
- procedure SEBCDICTOA
- (var Bufebcdic: buffertc;
- var Lbufebcdi: integer);
- VAR
- I: integer;
- c: char;
-
- begin
- for I := 1 to Lbufebcdi DO
- begin
- c := bufebcdic[I];
- bufebcdic[I] := chr(Ebcdictoascii[c]);
- end;
- end;
-
- /*******************************************/
- /* */
- /* CLIENT SET UP FUNCTION */
- /* */
- /*******************************************/
-
-
- Procedure CSETUP( var Host: String80;
- var Sock: integer;
- var Serv: String80);
-
- Main;
- Procedure CSETUP;
-
- const
-/* Userpassl = 65; */
- Userpassl = 85;
- Replylmax =120;
-
-
- type
-
- Byt = packed 0..255;
-
-
- Janus = record
- case integer of
- 0:(Byte: Byt);
- 1:(Ch:char);
- end;
-
- var
- ConnectionInfo : StatusInfoType;
- HostAddress : InternetAddressType;
- HostName : String(80);
- Username : Packed array [1..30] of char;
- Username2 : Packed array [1..30] of char;
- Usernames : String(30);
- Password : Packed Array [1..30] of char;
- ReturnCode : integer;
- Ret : integer;
- PORTnumber : integer;
- Replyl : integer;
- I : integer;
- J : integer;
- K : integer;
- L : integer;
- Lenp : integer;
- Temp : Janus;
- Mask : Byt;
- Userpass : Packed Array [1..Userpassl] of char;
- Reply : Packed Array [1..Replylmax] of char;
- ReplyA : Packed Array [1..20480] of char;
-#if !defined(CERNLIB_TCPIPV2)
- Userpassad : AddressType;
- Replyad : AddressType;
-#endif
-#if (defined(CERNLIB_TCPIPV2))&&(!defined(CERNLIB_QMIBMXA))
- Userpassad : Address24Type;
- Replyad : Address24Type;
-#endif
-#if (defined(CERNLIB_TCPIPV2))&&(defined(CERNLIB_QMIBMXA))
- Userpassad : Address31Type;
- Replyad : Address31Type;
-#endif
-#if defined(CERNLIB_IBMMVS)
-
- cuid : useridType;
- cprompt : packed array [1..80] of char;
- lin, lout, nn : integer;
-
- /* return jobname, first 4 characters are uid at GSI */
- procedure jobnam(var cuid : useridType);
- external;
- /* read password with no echo */
- Procedure getinh( var cbufin: string80;
- var lbufin: integer;
- var cbufout: string30;
- var lbufout: integer;
- var irc: integer );
- external;
-#endif
-
- begin
-
- TermOut (Output);
- TermIn (Input);
-
- /* Establish access to TCP/IP services */
-
-
- BeginTcpIp (ReturnCode);
- if ReturnCode <> OK then begin
- Sock := -1;
- WriteLn ('BeginTcpip: ', SayCalRe(ReturnCode));
- return;
- end;
-
-
- /* Inform TCPIP which notifications will be handled by the program */
-
- Handle ((.DATAdelivered, BUFFERspaceAVAILABLE,
- CONNECTIONstateCHANGED.), ReturnCode);
- if ReturnCode <> OK then begin
- Sock := -1;
- Restore ('Handle: ', ReturnCode);
- return;
- end;
-
- /* Convert Host name Packed Array into string */
-
- Hostname := STR(Host);
-
- /* Convert the Host name into an Internet address */
-
- GetHostResol (Hostname, HostAddress);
- if HostAddress = NOhost then begin
- Sock := -1;
- Restore ('GetHostResol failed', OK);
- return;
- end;
-
- /* Assign value to Portnumber depending on the input Serv */
-
- If Serv='example' then PORTnumber:=2345
- else
- If Serv='pawserv' then PORTnumber:=345
- else
- If Serv='zserv' then PORTnumber:=346
- else
-
- /* If serv is not one of the 3 previous values */
- /* it is assumed that Serv is the port number */
-
- READSTR(STR(Serv),PORTnumber);
-
- /* Open an active TCP connection in synchronous mode */
-
- with ConnectionInfo do begin
-
- Connection := UNSPECIFIEDconnection;
- OpenAttemptTimeout := OPENtimeout;
- Security := DEFAULTsecurity;
- Compartment := DEFAULTcompartment;
- Precedence := DEFAULTprecedence;
- ConnectionState := TRYINGtoOPEN;
- LocalSocket.Address := UNSPECIFIEDaddress;
- LocalSocket.Port := UNSPECIFIEDport;
- ForeignSocket.Address := HostAddress;
- ForeignSocket.Port := PORTnumber;
-
- end;
-
- TcpWaitOpen (ConnectionInfo, ReturnCode);
-
- if ReturnCode <> OK then begin
- Sock := -1;
- Restore ('TcpWaitOpen: ', ReturnCode);
- return;
- end;
-
- /* Open successful TCP has updated the Connection field */
-
- Sock := ConnectionInfo.Connection;
-
- /* Following code performs client user authentication */
-
- /* Get username and password to be sent to the server */
-
- For I := 1 to 30 DO Username[I]:=' ';
- For I := 1 to 30 DO Username2[I]:=' ';
- For I := 1 to 30 DO Password[I]:=' ';
-
-#if defined(CERNLIB_IBMVM)
- /* Get VM userid issuing the CMS command, to fill the prompt */
-
- CMS ('Q USERID(LIFO',Ret); /* Change to LIFO 22/02/91 JDS */
- ReadLn (Username);
- I:=1;
- repeat
- I:=I+1;
- until Username[I]=' ';
- repeat
- I:=I+1;
- Username[I]:=' ';
- until I=30;
- Usernames := STR(Username);
- LowCase(Usernames);
- For I:=1 TO 30 DO Username[I]:=Usernames[I];
-#endif
-#if defined(CERNLIB_IBMMVS)
- /* Get MVS userid by calling JBNAME Assembler Routine */
- jobnam(cuid);
- For I:=5 To 8 DO cuid[I] := ' '; /* only userid */
- Usernames := str(cuid);
- LowCase(Usernames);
- For I:=1 TO 8 DO Username[I]:=Usernames[I];
-#endif
- WriteLn('Username: ','(',MTRIM(MCOMPRESS(Hostname)),':',
- MTRIM(MCOMPRESS(SUBSTR(Usernames,1,8))),'):');
-
- ReadLn (Username2);
- If username2[1]<>' ' Then
- For I:=1 TO 30 DO Username[I]:=Username2[I];
-
- Usernames := STR(Username);
- LowCase(Usernames);
- WriteLn ('Password: ','(',MTRIM(MCOMPRESS(Hostname)),':',
- MTRIM(MCOMPRESS(SUBSTR(Usernames,1,15))),'):');
-#if defined(CERNLIB_IBMVM)
-/* ReadLn (Password);*/
- ReadNE (Password,lenp); /* Use modified version of VMRTNE */
-#endif
-#if defined(CERNLIB_IBMMVS)
- cprompt := ' ';
- lin := 1;
- lout := 30;
- nn := 0;
- getinh( cprompt, lin, Password, lout, nn );
-#endif
- If Password[1]=' ' Then
- For I:=1 To 30 DO Password[I]:=Username[I];
-
- /* writeln('Before encoding, we have: ',Username,password); */
-
- /* Encode user name and password by applying a bitwise complement */
- /* Tricky Janus type used since the NOT operator cannot directly */
- /* apply to a CHAR variable */
-
- Mask:=255;
- I:=0;
- repeat
- I:=I+1;
- Temp.Ch:=Chr(Ebcdictoascii[Username[I]]);
- Temp.Byte:= NOT(Temp.Byte) AND Mask;
- Userpass[I]:=Temp.Ch;
- until (Username[I]=' ') OR (I=30);
-
- K:=0;
- repeat
- I:=I+1;
- K:=K+1;
- Temp.Ch:=Chr(Ebcdictoascii[Password[K]]);
- Temp.Byte:= NOT(Temp.Byte) AND Mask;
- Userpass[I]:=Temp.Ch;
- until (Password[K]=' ') OR (K=30);
-
- /* Put a zero at the end of Userpass to keep C happy */
- Temp.Byte:=0;
- Userpass[I]:=Temp.Ch;
-
- /* The encoded user name and password are ready to be sent */
-
- Userpassad:=Addr(Userpass[1]);
-
- TcpWaitSend (Sock,Userpassad,I,True,False,ReturnCode);
-
- /* If sending authorization fails, then exit with error */
-
- If ReturnCode <> OK then
- begin
- WriteLn('Error sending authorization');
- TcpClose(Sock,Returncode);
- Sock:=-1;
- Return;
- end ;
-
- /* Read back an acknowledgement from the SERVER */
-
- Replyad:=Addr(Reply[1]);
- TcpWaitReceive(Sock,Replyad,Replylmax,Replyl);
-
- /* If no message is got, then exit with error */
-
- If replyl<=0 then
- begin
- Writeln('Error receiving authorization message from SERVER');
- TcpClose(Sock,Returncode);
- Sock:=-1;
- return;
- end
- else
- begin
- L:=Replyl-1;
- For I:=1 to Replyl DO ReplyA[I]:=Reply[I];
- SASCIITOE(ReplyA,L);
- ReplyA[Replyl]:=' ';
- For I:=1 to Replyl DO Reply[I]:=ReplyA[I];
- For I:=Replyl+1 to Replylmax DO Reply[I]:=' ';
- Writeln(Reply);
- end;
-
- /* The CLIENT is ready to send data to the SERVER */
-
- close (Input);
- close (Output);
- end;
-
- /*******************************************/
- /* */
- /* SERVER SET UP FUNCTION */
- /* */
- /*******************************************/
-
- Procedure SSETUP (var Sock: integer; var Port:integer);
- Main;
- Procedure SSETUP;
- var
- ConnectionInfo : StatusInfoType;
- HostAddress : InternetAddressType;
- HostName : String(80);
- ReturnCode : integer;
-
- begin
- if Port = 0 then Port := 2345;
-
- TermOut (Output);
- TermIn (Input);
-
- /* Establish access to TCP/IP services */
-
- BeginTcpIp (ReturnCode);
- if ReturnCode <> OK then begin
- WriteLn ('BeginTcpip: ', SayCalRe(ReturnCode));
- return;
- end;
-
- /* Inform TCPIP which notifications will be handled by the program */
-
- Handle ((.DATAdelivered, BUFFERspaceAVAILABLE,
- CONNECTIONstateCHANGED.), ReturnCode);
- if ReturnCode <> OK then begin
- Restore ('Handle: ', ReturnCode);
- return;
- end;
-
-
- /* Open a passive TCP connection in synchronous mode */
-
- with ConnectionInfo do begin
-
- Connection := UNSPECIFIEDconnection;
- OpenAttemptTimeout := OPENtimeout;
- Security := DEFAULTsecurity;
- Compartment := DEFAULTcompartment;
- Precedence := DEFAULTprecedence;
- ConnectionState := LISTENING;
- LocalSocket.Address := UNSPECIFIEDaddress;
- LocalSocket.Port := Port;
- ForeignSocket.Address := UNSPECIFIEDaddress;
- ForeignSocket.Port := UNSPECIFIEDport;
-
- end;
-
- TcpWaitOpen (ConnectionInfo, ReturnCode);
-
- if ReturnCode <> OK then begin
- Restore ('TcpWaitOpen: ', ReturnCode);
- return;
- end;
-
- /* Open successful TCP has updated the Connection field */
-
- Sock := ConnectionInfo.Connection;
-
- /* The SERVER is ready to receive data from the CLIENT */
-
- Close (Input);
- Close (Output);
- end;
-
- /*******************************************/
- /* */
- /* SRECV Procedure */
- /* */
- /* String receive */
- /* */
- /*******************************************/
-
- Procedure SRECV ( var sock1: integer;
- var buf1: Buffertc;
- var m1: integer;
- var numrec1: integer );
- Main;
-
- Procedure SRECV;
-
- VAR
-#if !defined(CERNLIB_TCPIPV2)
- Buffadd1: AddressType;
-#endif
-#if (defined(CERNLIB_TCPIPV2))&&(!defined(CERNLIB_QMIBMXA))
- Buffadd1: Address24Type;
-#endif
-#if (defined(CERNLIB_TCPIPV2))&&(defined(CERNLIB_QMIBMXA))
- Buffadd1: Address31Type;
-#endif
- RetCod1 : integer;
- Numbytes1 : integer;
- N1: integer;
- K: integer;
-
- begin
- Buffadd1 := Addr(buf1[1]);
- Numbytes1 := BUFFERClength;
-
- If m1<0 then
- /* m1<0 Routine gets what it can */
-
- Begin
- n1 := -m1;
- TcpWaitReceive (sock1, Buffadd1, n1, Numbytes1);
- /* Convert the received string from ASCII to EBCDIC */
- SASCIITOE(buf1,Numbytes1);
- Numrec1 := Numbytes1;
- End
- Else
-
- /* m1>0 Routine attempts to get this length */
-
- Begin
- k :=0;
- repeat
- TcpWaitReceive (sock1, Buffadd1+k, m1-k, Numbytes1);
- k:=k+Numbytes1;
- /* reissue TcpwaitReceive until expected number is reached */
- /* and exit if Numbytes1 <1 or >m1 */
- until (k>=m1) or (Numbytes1<1) or (Numbytes1>m1);
- if k>=m1 then
- begin
- SASCIITOE(buf1,k);
- Numrec1:=k;
- end
- else Numrec1:=0
- end
- end;
-
- /*******************************************/
- /* */
- /* BRECV Procedure */
- /* */
- /* Binary receive */
- /* */
- /*******************************************/
-
- Procedure BRECV ( var sock2: integer;
- var buf2: Buffertb;
- var m2: integer;
- var numrec2: integer );
- Main;
-
- Procedure BRECV;
-
- VAR
-#if !defined(CERNLIB_TCPIPV2)
- Buffadd2: AddressType;
-#endif
-#if (defined(CERNLIB_TCPIPV2))&&(!defined(CERNLIB_QMIBMXA))
- Buffadd2: Address24Type;
-#endif
-#if (defined(CERNLIB_TCPIPV2))&&(defined(CERNLIB_QMIBMXA))
- Buffadd2: Address31Type;
-#endif
- RetCod2 : integer;
- Numbytes2 : integer;
- N2: integer;
- K: integer;
-
- begin
- Numbytes2 := BUFFERClength;
- Buffadd2 := Addr(buf2[1]);
-
- If m2<0 then
- /* m2<0 Routine gets what it can */
-
- Begin
- n2 := -m2;
- TcpWaitReceive (sock2, Buffadd2, n2, Numbytes2);
- Numrec2 := Numbytes2;
- End
- Else
-
- /* m2>0 Routine attempts to get this length */
-
- Begin
- k :=0;
- repeat
- TcpWaitReceive (sock2, Buffadd2+k, m2-k, Numbytes2);
- k:=k+Numbytes2;
- /* reissue TcpwaitReceive until expected number is reached */
- /* and exit if Numbytes2 is zero */
- until (k>=m2) or (Numbytes2<1) or (Numbytes2>m2);
- if (k>=m2) then Numrec2:=k else Numrec2 :=0
- end
- end;
-
- /*******************************************/
- /* */
- /* SSEND PROCEDURE */
- /* */
- /* Sends a character string */
- /* */
- /*******************************************/
-
- Procedure SSEND ( var sock3: integer;
- var buf3: Buffertc;
- var m3: integer;
- var retcode3: integer);
-
- Main;
-
- Procedure SSEND;
- VAR
-#if !defined(CERNLIB_TCPIPV2)
- Buffadd3: AddressType;
-#endif
-#if (defined(CERNLIB_TCPIPV2))&&(!defined(CERNLIB_QMIBMXA))
- Buffadd3: Address24Type;
-#endif
-#if (defined(CERNLIB_TCPIPV2))&&(defined(CERNLIB_QMIBMXA))
- Buffadd3: Address31Type;
-#endif
- I3 : Integer;
- J3 : Integer;
- K3 : Integer;
-
-
- begin
- /* Convert string from EBCDIC to ASCII */
-
- SEBCDICTOA(buf3,m3);
-
- Buffadd3 := Addr(buf3[1]);
- /* The maximum length data buffer that can be sent to TCP is 8K */
-
- If m3 > 8192 Then
-
-
- Begin
-
- K3 := 8192;
- I3 := m3 DIV 8192 ;
- For J3 := 1 To I3 DO
- begin
- TcpWaitSend (sock3,Buffadd3,K3,TRUE,FALSE,RetCode3);
- Buffadd3 := Buffadd3 + 8192;
- end;
-
- K3 := m3 MOD 8192;
- TcpWaitSend (sock3,Buffadd3,K3,TRUE,FALSE,RetCode3);
- If Retcode3 <> OK Then Retcode3 := -1
- Else Retcode3 := m3;
- End
- ElSE
- TcpWaitSend (sock3,Buffadd3,m3,TRUE,FALSE,RetCode3);
-
- If Retcode3 <> OK Then Retcode3 := -1
- Else Retcode3 := m3;
- end;
-
-
- /*******************************************/
- /* */
- /* BSEND PROCEDURE */
- /* */
- /* Sends an array of integers */
- /* */
- /*******************************************/
-
- Procedure BSEND ( var sock4: integer;
- var buf4: Buffertb;
- var m4: integer;
- var retcode4: integer);
-
- Main;
-
- Procedure BSEND;
- VAR
-#if !defined(CERNLIB_TCPIPV2)
- Buffadd4: AddressType;
-#endif
-#if (defined(CERNLIB_TCPIPV2))&&(!defined(CERNLIB_QMIBMXA))
- Buffadd4: Address24Type;
-#endif
-#if (defined(CERNLIB_TCPIPV2))&&(defined(CERNLIB_QMIBMXA))
- Buffadd4: Address31Type;
-#endif
- I4 : Integer;
- J4 : Integer;
- K4 : Integer;
-
-
-
- begin
- Buffadd4 := Addr(buf4[1]);
-
-
- /* The maximum length data buffer that can be sent to TCP is 8K */
-
- If m4 > 8192 Then
-
-
- Begin
-
- K4 := 8192;
- I4 := m4 DIV 8192 ;
- For J4 := 1 To I4 DO
- begin
- TcpWaitSend (sock4,Buffadd4,K4,TRUE,FALSE,RetCode4);
- Buffadd4 := Buffadd4 + 8192;
- end;
-
- K4 := m4 MOD 8192;
- TcpWaitSend (sock4,Buffadd4,K4,TRUE,FALSE,RetCode4);
- If Retcode4 <> OK Then Retcode4 := -1
- Else Retcode4 := m4;
- End
- ElSE
- TcpWaitSend (sock4,Buffadd4,m4,TRUE,FALSE,RetCode4);
- If Retcode4 <> OK Then Retcode4 := -1
- Else Retcode4 := m4;
-
- end;
-
- /*******************************************/
- /* */
- /* SCLOSE PROCEDURE */
- /* */
- /*******************************************/
-
- procedure SCLOSE (var sock5: integer);
- Main;
-
- procedure SCLOSE;
-
- var
- ReturnCode5: integer;
- ReturnCode6: integer;
- Note : NotificationInfoType;
-
- begin
-
- /* Close TCP connection and wait till other end drops too */
-
- TcpClose (sock5, ReturnCode5);
-
-/* repeat
- GetNextNote (Note, True, ReturnCode6);
- if Returncode6 <> OK then begin
- Restore('GetNextNote: ', Returncode6);
- return;
- end;
-
- until (Note.NotificationTag = CONNECTIONstateCHANGED) &
- (Note.NewState = NONEXISTENT); */
-
- EndTcpIp
-
- end; .
diff --git a/src/packlib/cspack/tcpaw/tcpold.c b/src/packlib/cspack/tcpaw/tcpold.c
deleted file mode 100644
index 6dc9df3..0000000
--- a/src/packlib/cspack/tcpaw/tcpold.c
+++ /dev/null
@@ -1,2473 +0,0 @@
-/*
- * $Id: tcpold.c,v 1.2 2005/04/18 15:23:09 mclareni Exp $
- *
- * $Log: tcpold.c,v $
- * Revision 1.2 2005/04/18 15:23:09 mclareni
- * Mods submitted by Kevin B. McCarty to fix insecure Cernlib uses of /tmp.
- *
- * Revision 1.1.1.1 1996/03/08 15:44:28 mclareni
- * Cspack
- *
- */
-#include "cspack/pilot.h"
-#if defined(CERNLIB_OLD)
-/*N.B. Must define sequence TCPLOG if a log file is required, e.g.*/
-/*#define LOGFILE "disk$dd:-ben.socks-serv.log"*/ /* VMS */
-/*#define LOGFILE "/user/brun/ben/serv.log" */ /* Apollo */
-/*#define LOGFILE "/h0/psh/zs.log" */ /* OS9 */
-/*#define LOGFILE "/var/log/serv.log" */ /* example*/
-
-#if defined(CERNLIB__DOC)
-/* TCP/IP PACKAGE FOR REMOTE-PAW AND SIMILAR APPLICATIONS.
-
- Ben M. Segal / CERN-CN/SW
-
- ben at cernvax.cern.ch
-
- ------------------------------------------------------
- | Version of: Aug.30, 1991 (FOR CERN PROGRAM LIBRARY)|
- ------------------------------------------------------
-
-***** THIS VERSION: SecurID/ACE ADDED (Unicos6.0 Version)
- Removed limit of 8-char passwords (from "getpass").
-
-***** LAST VERSION: VM/CMS CODE ADDED (Ignacio Reguero / CERN-CN/SW)
-
-***** Documentation: "Installation and Use of the TCPAW Package",
- Ben M. Segal / CERN-CN-SW March 1991.
-*/
-#endif
-/* SYSTEM DEFINITIONS: */
-
-/* (VM, VMS, Apollo, HPUX, SGI, IBMRT, Sun, Cray, Ultrix, OS9 supported) */
-
-/* CUSTOMIZATION DEFINITIONS: */
-#define DEBUG /* Can remove from production versions */
-#define AUTHENT /* INVOKES USER AUTHENTICATION CODE: BUT NOTE... */
- /* "AUTHENT" MUST MATCH IN CLIENTS AND SERVERS !! */
-#define APOPAL /* (use this to select OPAL OS-9 special login) */
-/*#define APOPWD */ /* (use if Unix password crypt fails on Apollos) */
-/*#define APOSR9 */ /* (used only for Apollo FTN linking pre-SR10) */
-/*#define SERVLOG*/ /* (use to get a server logfile: NOT IN CLIENT!! */
-/*#define SOCKETS*/ /* (optional: mainly for testing) */
-/*#define XDEBUG */ /* (optional: BUT DON'T USE FOR INETD SERVERS) */
-/*#define CRAYC */ /* (used only for testing from C on Crays) */
-/*#define RESOLVE_VIA_LOOKUP */ /* VM: to force use of a hosts table only */
-/*#define NORUSERPASS */ /* (only to force use of std "ruserpass/getpass") */
-/* END OF DEFINITIONS */
-
-#if defined(CERNLIB_IBMRT)
-#define IBMRT
-#endif
-#if defined(CERNLIB_HPUX)
-#define HPUX
-#endif
-#if defined(CERNLIB_SUN4)
-#define sun4
-#endif
-#if defined(CERNLIB_OS9)
-#define OSK
-#endif
-#if defined(CERNLIB_SGI)||defined(CERNLIB_MIPS)
-#define sgi
-#endif
-#if defined(CERNLIB_IBMVM)
-#define VM
-#endif
-#if (defined(CERNLIB_CRAY))&&(defined(CERNLIB_UNIX))&&(defined(CERNLIB_ACE))
-#define ACE
-#endif
-
-#ifdef VM
-#include <tcpsock.h>
-#if defined(CERNLIB_IBMVM)
-#pragma csect(CODE,"TCPAWC")
-#pragma linkage(cinit,FORTRAN)
-#pragma linkage(isetup,FORTRAN)
-#pragma linkage(iclose,FORTRAN)
-#pragma linkage(csetup,FORTRAN)
-#pragma linkage(ssetup,FORTRAN)
-#pragma linkage(sclose,FORTRAN)
-#pragma linkage(srecv,FORTRAN)
-#pragma linkage(ssend,FORTRAN)
-#pragma linkage(SSENSTR,FORTRAN)
-#pragma linkage(SRECSTR,FORTRAN)
-#pragma linkage(CMXLATE,OS)
-#pragma linkage(CHPAS,OS)
-#pragma linkage(LNRD,OS)
-#pragma linkage(LNRDPAS,OS)
-#pragma linkage(GETUSR,OS)
-#pragma linkage(GETUNIQ,OS)
-#endif
-#endif /* VM */
-
-#ifdef cray
-#ifndef CRAYC
-#define CRAYFTN
-#endif /* CRAYC */
-#ifdef ACE
-#include "/usr/include/ace.h"
-#endif /* ACE */
-#endif /* cray */
-
-#ifdef sgi
-#define NOINITGROUPS
-#endif /* sgi */
-
-#ifdef apollo
-#ifdef APOPWD
-#define APOPWD1
-#endif /* APOPWD */
-#ifdef APOPAL
-#define APOPAL1
-#endif /* APOPAL */
-#ifdef APOSR9
-#define APOFTN
-#endif /* APOSR9 */
-#endif /* apollo */
-
-#include <stdio.h>
-#include <errno.h>
-#include <signal.h>
-#include <ctype.h>
-
-#ifdef AUTHENT
-#ifndef OSK
-#ifndef VM
-#include <pwd.h>
-#endif /* ^VM */
-#endif /* OSK */
-#endif /* AUTHENT */
-
-#ifdef CRAYFTN
-#include <fortran.h>
-#endif /* CRAYFTN */
-
-#ifdef VMS
-#include <iodef.h>
-#include <ssdef.h>
-#include <climsgdef.h>
-#include <descrip.h>
-#include <types.h>
-#include <socket.h>
-#include <in.h>
-#else
-#ifdef sgi
-#include <bsd/sys/types.h>
-#include <bsd/sys/socket.h>
-#include <bsd/netinet/in.h>
-#else
-#ifdef OSK
-#include <time.h>
-#include <types.h>
-#include <socket.h>
-#include <in.h>
-#else
-#ifdef VM
-extern int CHPAS();
-extern char *LNRD();
-extern char *LNRDPAS();
-extern char *GETUSR();
-#define getlogin GETUSR
-extern int GETUNIQ();
-#define getpid GETUNIQ
-#define index strchr
-#define ENOENT 67
-#define ECONNREFUSED 61
-#include <manifest.h>
-#include <stdlib.h>
-#include <time.h>
-#include <bsdtypes.h>
-#include <socket.h>
-#include <in.h>
-#include <string.h>
-#else
-#include <sys/types.h>
-#include <sys/socket.h>
-#include <netinet/in.h>
-#endif /* VM */
-#endif /* OSK */
-#endif /* sgi */
-#endif /* VMS */
-
-#ifdef sgi
-#include <bsd/netdb.h>
-#else
-#include <netdb.h>
-#endif /* sgi */
-
-#ifdef NOMEMSET
-#define memset(a,b,c) bzero(a,c) /* in case "memset" unknown (BS) */
-#endif /* NOMEMSET */
-
-#ifdef DEBUG /* DEBUG IMPLIES SOCKETS SUPPORT... */
-#define SOCKETS
-static char *Prog_Name = "tcpaw"; /* CUSTOMIZE THIS.. */
-#endif /* DEBUG */
-
-#ifdef DEBUG
-#ifdef SERVLOG /* DEBUG PLUS SERVLOG --> LOGFILE .. */
-#ifdef VMS
-#include "cspack/tcplog.h"
-/*#define LOGFILE "disk$dd:[ben.socks]serv.log" */ /* CUSTOMIZE THIS.. */
-#endif /* VMS */
-#ifdef apollo
-#include "cspack/tcplog.h"
-/*#define LOGFILE "/user/brun/ben/serv.log" */ /* CUSTOMIZE THIS.. */
-#endif /* apollo */
-#ifdef OSK
-#include "cspack/tcplog.h"
-/*#define LOGFILE "/h0/psh/zs.log" */ /* CUSTOMIZE THIS.. */
-#endif /* OSK */
-#ifndef LOGFILE
-#include "cspack/tcplog.h"
-/*#define LOGFILE "/var/log/serv.log" */ /* CUSTOMIZE THIS.. */
-#endif /* LOGFILE */
-#endif /* SERVLOG */
-#endif /* DEBUG */
-
-#ifdef LOGFILE
-static FILE *logfile;
-#endif /* LOGFILE */
-
-#ifdef XDEBUG
-#ifdef LOGFILE
-#define STDERR logfile
-#else
-#define STDERR stderr
-#endif /* LOGFILE */
-#endif /* XDEBUG */
-
-/* One or two global variables...*/
-
- static char clnthost[30]; /* client remote host name string */
- static char servhost[30]; /* server remote host name string */
- static unsigned short clntpport; /* client local port number */
- static unsigned short servpport; /* server remote port number */
- static long timevar; /* contains time returned by timexx */
- static int ls = 0; /* The server listen socket descriptor */
-
- extern char *inet_ntoa();
-#ifndef VM
- extern int errno;
-#endif /* ^VM */
- extern char *getenv(), *cuserid();
- unsigned long inet_addr();
-
-#ifndef OSK
-#ifndef VM
- extern char *ctime();
-#endif /* ^VM */
-
-#ifndef VM
-/* Note: INETD_SOCK_SETUP and INETD_SOCK_CLOSE are not needed for VM ****/
-
-/*
- * INETD_SOCK_SETUP (or: "ISETUP")
- *
- * This routine sets up the necessary stuff for a server program to be
- * started by a BSD-style inet-daemon (also found on WIN/TCP in VMS),
- * and returns a socket for network sends and receives.
- *
- * THE INTEGER RETURN VALUE, IF NEGATIVE, INDICATES AN ERROR !!!
- *
- * ** It also returns an input and output unit number as parameters **
- *
- * ** MULTI-USER VERSION **
- * ** WITH USER AUTHENTICATION **
- */
-
-#ifdef VMS
-struct netdisc {
- int size;
- char *ptr;
-} inetd = {10, "SYS$INPUT:"};
-
-#ifdef AUTHENT
- struct passwd *my_pw;
-#endif /* AUTHENT */
-#endif /* VMS */
-
-int isetup(in, out)
-int *in;
-int *out;
-{
- int s;
-
-#ifdef VMS
- int status;
- unsigned short Channel;
-#endif /* VMS */
-
-#ifdef AUTHENT
- unsigned char idbuf[100];
- char usbuf[20], pwbuf[20];
- char *user = usbuf, *passwd = pwbuf;
- register int i, len;
-#endif /* AUTHENT */
-
-#ifdef SOCKETS
- struct hostent *hp; /* host info for remote host */
- struct sockaddr_in peeraddr_in; /* for peer socket address */
- int peerlen;
-#endif /* SOCKETS */
-
-#ifdef VMS
-/* Note: with newer VMS C compiler, cannot open LOGFILE before sys$assign! */
-
- status = sys$assign(&inetd, &Channel, 0,0); /* sys$input channel */
- if (status != SS$_NORMAL) {
- return(-2);
- }
- s = Channel;
-#else
- s = 0; /* STDIN for Unix servers started by inetd */
-#endif /* VMS */
-
-#ifdef LOGFILE
- while ((logfile = fopen(LOGFILE, "a")) == NULL) sleep(1);
-#endif /* LOGFILE */
-
-#ifdef SOCKETS
- memset ((char *)&peeraddr_in, 0, sizeof(struct sockaddr_in));
- peerlen = sizeof(peeraddr_in);
- if (getpeername(s, &peeraddr_in, &peerlen) < 0) {
-#ifdef LOGFILE
- fprintf(logfile, "%s: getpeername failed\n", Prog_Name);
-#endif /* LOGFILE */
- goto errout1;
- }
-
- hp = gethostbyaddr((char *) &peeraddr_in.sin_addr,
- sizeof (struct in_addr), peeraddr_in.sin_family);
- if (hp == NULL) {
- strcpy(clnthost, inet_ntoa(peeraddr_in.sin_addr));
- } else {
- strcpy(clnthost, hp->h_name); /* save remote host name */
- }
- clntpport = ntohs(peeraddr_in.sin_port);
-#endif /* SOCKETS */
-#ifdef LOGFILE
- /* Log a startup message. */
- time (&timevar);
- fprintf(logfile, "%s: Started from %s port %u at %s",
- Prog_Name, clnthost, clntpport, ctime(&timevar));
-#endif /* LOGFILE */
-
-#ifdef AUTHENT
- /* Read the first buffer from the client and check the
- user name and password (which we assume to be in the
- format %s %s). */
-
- len = recv(s, idbuf, sizeof(idbuf), 0);
- if (len <= 0) {
- reply("Bad id receive.\n", NULL);
- goto errout1;
- }
- idbuf[len-1]='\0'; /* SAFETY !! */
- if (--len > 0) for (i=0; i<len; i++) idbuf[i] = ~idbuf[i];
- if (sscanf((char *)idbuf, "%s %s", user, passwd) != 2) {
- reply("Bad id record '%s'\n", idbuf);
- goto errout1;
- }
-#ifdef VMS
- my_pw = getpwnam(cuserid(0));
-#endif /* VMS */
- if (chpass(user, passwd) <= 0) {
- goto errout1;
- }
- /* Successful authentication....... */
- /* Note: logfile closed in chpass if successful */
-
-#else
-#ifdef LOGFILE
- fclose(logfile);
-#endif /* LOGFILE */
-#endif /* AUTHENT */
-
- *in = *out = s;
- return(s); /* return the user socket descriptor */
-
-errout1:
-
-#ifdef LOGFILE
- fclose(logfile);
-#endif /* LOGFILE */
- return(-1); /* return -1 in case of failure */
-}
-
-/*
- * INETD_SOCK_CLOSE (or: "ICLOSE")
- *
- * This routine closes down an inet-daemon server socket.
- *
- */
-
-int iclose(s)
-int *s;
-{
-
-#ifdef AUTHENT
-#ifndef VMS
-#ifdef HPUX
- setresuid(0,0,0); /* have to do this to allow an exit !!! */
-#else
- seteuid(0); /* have to do this to allow an exit !!! */
-#endif /* HPUX */
-#else
- setuic(my_pw->pw_uic);
-#endif /* VMS */
-#endif /* AUTHENT */
-
-#ifdef LOGFILE
- time (&timevar);
- while ((logfile = fopen(LOGFILE, "a")) == NULL) sleep(1);
- fprintf(logfile, "%s: Finished from %s port %u at %s",
- Prog_Name, clnthost, clntpport, ctime(&timevar));
- fclose(logfile);
-#endif /* LOGFILE */
-
- if (*s != -1)
-#ifdef VMS
- sys$dassgn(*s);
-#else
- close(*s);
-#endif /* VMS */
-}
-#endif /* OSK */
-#endif /* VM */
-
-/*
- * SERVER_SOCK_SETUP (or: "SSETUP")
- *
- * This routine sets up the necessary stuff on a standalone server.
- * It sets up the listen socket, accepts a single-user connect,
- * and returns the user socket for network sends and receives.
- *
- * THE INTEGER RETURN VALUE, IF NEGATIVE, INDICATES AN ERROR !!!
- *
- * ** It also returns an input and output unit number as parameters **
- *
- * ** SINGLE-USER VERSION ONLY (AND CODE FOR SPECIFIED PORT FOR VM) **
- * ** ALSO OS9 VERSION (REALLY AN INETD_SERVER_SOCK_SETUP !) - PSH **
- */
-
-#ifdef OSK
-int ssetup(isock, osock) /* OS9 */
-int *isock, *osock;
-{
-#ifdef AUTHENT
- unsigned char idbuf[100];
- char usbuf[20], pwbuf[20];
- char *user = usbuf, *passwd = pwbuf;
- register int i, len;
-
- int s = 0;
-
-#ifdef LOGFILE
- while ((logfile = fopen(LOGFILE, "a")) == NULL) sleep(1);
-#endif /* LOGFILE */
- /* Read the first buffer from the client and check the
- user name and password (which we assume to be in the
- format %s %s). */
-
- len = recv(s, idbuf, sizeof(idbuf), 0);
- if (len <= 0) {
- reply("Bad id receive.\n", NULL);
- goto errout1;
- }
- if (--len > 0) for (i=0; i<len; i++) idbuf[i] = ~idbuf[i];
- i = sscanf((char *)idbuf, "%s %s", user, passwd);
- if (i != 1 && i != 2) { /* Allow any password, even null for OS9 */
- reply("Bad id record '%s'\n", idbuf);
- goto errout1;
- }
- if (chpass(user, passwd) <= 0) {
- goto errout1;
- }
- /* Successful authentication....... */
- /* Note: logfile closed in chpass if successful */
- goto allok;
-
-errout1:
-
-#ifdef LOGFILE
- fclose(logfile);
-#endif /* LOGFILE */
- return(-1); /* return -1 in case of failure */
-
-allok:
-
-#endif /* AUTHENT */
-
- *isock = 0;
- *osock = 1;
- return(*isock);
-}
-#else /* OSK */
-
-/* The old-fashioned single-user server: NOTE "AUTHENT" NOT SUPPORTED !!! */
-/* (i.e. it will not talk correctly to a client with "AUTHENT" defined) */
-/*
- THIS IS ALSO USED FOR VM, INVOKED BY THE REXEC SERVER. IN THIS CASE,
- AUTHENTICATION IS DONE BY THE REXEC SERVER BEFORE THIS SERVER STARTS.
-*/
-int ssetup(in, out, port) /* VM */
-int *in, *out;
-int *port; /* VM */
-{
- struct hostent *hp; /* host info for remote host */
- struct servent *sp; /* pointer to service information */
-
- struct sockaddr_in myaddr_in; /* for local socket address */
- struct sockaddr_in peeraddr_in; /* for peer socket address */
-
- int s, addrlen;
- unsigned short sport = *port; /* VM */
-
- /* clear out address structures */
-
- memset ((char *)&myaddr_in, 0, sizeof(struct sockaddr_in));
- memset ((char *)&peeraddr_in, 0, sizeof(struct sockaddr_in));
-
- /* Set up address structure for the listen socket. */
- myaddr_in.sin_family = AF_INET;
- myaddr_in.sin_addr.s_addr = INADDR_ANY;
-
- /* Find the information for the "example" server
- * in order to get the needed port number.
- * ...UNLESS PASSED A +VE PORT NUMBER TO USE (VM).
- */
- if (port == NULL || *port <= 0) { /* VM */
- sp = getservbyname ("example", "tcp");
- if (sp == NULL) {
- fprintf(stderr, "%s: 'example' not in services file\n",
- "server_sock_setup");
- exit(1);
- }
- myaddr_in.sin_port = sp->s_port;
-
- } else myaddr_in.sin_port = htons(sport); /* VM */
-
- /* Create the listen socket. */
- ls = socket(AF_INET, SOCK_STREAM, 0);
- if (ls == -1) {
-#ifdef VM
- tcperror("server_sock_setup");
-#else
- perror("server_sock_setup");
-#endif /* VM */
- fprintf(stderr, "%s: unable to create socket\n",
- "server_sock_setup");
- exit(1);
- }
- /* Bind the listen address to the socket. */
- if (bind(ls, &myaddr_in, sizeof(struct sockaddr_in)) == -1) {
-#ifdef VM
- tcperror("server_sock_setup");
-#else
- perror("server_sock_setup");
-#endif /* VM */
- fprintf(stderr, "%s: unable to bind address\n",
- "server_sock_setup");
- exit(1);
- }
- /* Initiate the listen on the socket so remote users
- * can connect. The listen backlog is set to 5, which
- * is the largest currently supported.
- */
- if (listen(ls, 5) == -1) {
-#ifdef VM
- tcperror("server_sock_setup");
-#else
- perror("server_sock_setup");
-#endif /* VM */
- fprintf(stderr, "%s: unable to listen on socket\n",
- "server_sock_setup");
- exit(1);
- }
- addrlen = sizeof(struct sockaddr_in);
- s = accept(ls, &peeraddr_in, &addrlen);
- if ( s == -1) {
- fprintf(stderr, "%s: accept error\n", "server_sock_setup");
- return(-1);
- }
- hp = gethostbyaddr ((char *) &peeraddr_in.sin_addr,
- sizeof (struct in_addr), peeraddr_in.sin_family);
- if (hp == NULL) {
- strcpy(clnthost, inet_ntoa(peeraddr_in.sin_addr));
- } else {
- strcpy(clnthost, hp->h_name); /* save remote host name */
- }
- /* Log a startup message. */
- time(&timevar);
- clntpport = ntohs(peeraddr_in.sin_port);
- fprintf(stderr, "Started from %s port %u at %s",
- clnthost, clntpport, ctime(&timevar));
-
- *in = *out = s;
- return(s); /* Return the user socket descriptor */
-}
-#endif /* OSK */
-
-/*
- * CLIENT_SOCK_SETUP (or: "CSETUP")
- *
- * This routine sets up the TCP client side so that it can use a remote
- * "srvc" server. It creates a connection and returns the socket.
- *
- * THE INTEGER RETURN VALUE, IF NEGATIVE, INDICATES AN ERROR !!!
- *
- * ** It also returns an input and output unit number as parameters **
- *
- * The name of the remote host to which the client will connect is given
- * as the first parameter to the routine.
- *
- */
-
-static int junk = 0;
-#define NSO 100 /* VM */
-static int svmode[NSO], sxsock[NSO]; /* VM */
-#define MAGIC 0x12345678 /* VM */
-#define VMTO 30 /* 30 sec timeout * VM */
-
-#ifdef VMS
-int csetup(sysdes, in, out, srvdes) /* VMS CASE... */
-struct dsc$descriptor_s *sysdes;
-int *in, *out;
-struct dsc$descriptor_s *srvdes;
-#else
-#ifdef CRAYFTN
-int csetup(sysdes, in, out, srvdes) /* CRAY CASE... */
-_fcd sysdes;
-int *in, *out;
-_fcd srvdes;
-#else
-#ifdef APOFTN
-int csetup(system, in, out, srvc, s_ln, c_ln) /* APOLLO (PRE-SR10) FTN... */
-char *system;
-int *in, *out;
-char *srvc;
-short *s_ln, *c_ln; /* dummy arguments */
-#else
-int csetup(system, in, out, srvc) /* UNIX ETC... */
-char *system;
-int *in, *out;
-char *srvc;
-#endif /* APOFTN */
-#endif /* CRAYFTN */
-#endif /* VMS */
-
-{
- struct hostent *hp; /* host info for remote host */
- struct servent *sp; /* pointer to service information */
- struct sockaddr_in myaddr_in; /* for local socket address */
- struct sockaddr_in peeraddr_in; /* for peer socket address */
-
- unsigned long addr;
- int s, addrlen;
- int sx, nn = 0; /* REXEC */
-#ifndef VM
- char get[50], *getp = get; /* REXEC */
-#endif /* VM */
- char sys[30];
- register int i, j, k;
- register char *c;
-
- char portstr[20], *pt; /* VM */
- int vmode = 0; /* VM */
- unsigned short sport = 0, prt = 0; /* VM */
- char uspass[50];
- char *user = NULL, *passwd = NULL;
-#ifdef AUTHENT
- unsigned char idbuf[100];
-#endif /* AUTHENT */
-
-#ifdef VMS
- char *system, *srvc;
- unsigned short s_ln, c_ln;
- struct dsc$descriptor_s sd, id; /* VM */
- unsigned long cliflags; /* VM */
- char command[200]; /* VM */
- int status, cstatus; /* VM */
-
- srvc = srvdes->dsc$a_pointer;
- c_ln = srvdes->dsc$w_length;
- system = sysdes->dsc$a_pointer;
- s_ln = sysdes->dsc$w_length;
- j = c_ln;
- i = s_ln;
-#else
-#ifdef CRAYFTN
- char *system, *srvc;
- unsigned s_ln, c_ln;
-
- srvc = _fcdtocp(srvdes);
- c_ln = _fcdlen(srvdes);
- system = _fcdtocp(sysdes);
- s_ln = _fcdlen(sysdes);
- j = c_ln;
- i = s_ln;
-#else
-#ifdef APOFTN
- j = *c_ln;
- i = *s_ln;
-#else
-#ifdef VM
- extern char asciitoebcdic[]; /* translation tables */
- extern char ebcdictoascii[];
- char buff[100];
- char *get;
- char *getp;
- char getbuf[50]; /* REXEC */
- getp = getbuf; /* REXEC */
- get = getbuf; /* REXEC */
-/* j = 80; */ /* (crude kludge) length of srvc in Fortran */
-/* i = 80; */ /* ( ,, ,, ) length of system in Fortran */
- i = gtlnfstr(&system,1); /* length of 1st arg (srvc) */
- j = gtlnfstr(&system,4); /* length of 4th arg (system) */
-#else
- j = strlen(srvc);
- i = strlen(system);
-#endif /* VM */
-#endif /* APOFTN */
-#endif /* CRAYFTN */
-#endif /* VMS */
-
- /* Terminate correctly the host & service strings passed by FTN.. */
- for (k=0; k<j; k++) if (srvc[k] == ' ') { srvc[k] = '\0'; break;}
- for (k=0; k<i; k++) if (system[k] == ' ') { system[k] = '\0'; break;}
- /* And map to lower case... */
- c = srvc; while (*c) { if (isupper(*c)) *c = tolower(*c); c++; }
- c = system; while (*c) { if (isupper(*c)) *c = tolower(*c); c++; }
-
-/*DEBUG fprintf(stderr, "system '%s' service '%s'\n", system, srvc);*/
-
- if ( !strcmp((system + strlen(system) - 3),"(vm") ){
- *(system + strlen(system) - 3) = '\0';
- strcpy(servhost, system);
- fprintf(stderr,"VM system: '%s'\n",system);
- goto vmcase;
- }
-
-/*DEBUG fprintf(stderr, "system '%s' service '%s'\n", system, srvc);*/
-
- strcpy(servhost, system); /* Use our own storage when needed.... */
- *sys = '\0';
- if ((addr = inet_addr(servhost)) != -1) { /* Permit IP addresses */
-#ifdef VM
- sprintf(buff, "Is system '%s' running VM/CMS (y/n)? [n]: ",
- system);
- if (((get = LNRD(buff)) != NULL) && (*get == 'y' || *get == 'Y')) {
- sprintf(buff, "Give VM system name [CERNVM]: ");
- get = LNRD(buff);
- if (*get == '\0') strcpy(sys, "cernvm");
- else {
- strcpy(sys, get);
- }
- get = getp;
-#else
- fprintf(stderr, "Is system '%s' running VM/CMS (y/n)? [n]: ",
- system);
- if ((fgets(get, sizeof(get), stdin) != NULL) &&
- (*get == 'y' || *get == 'Y')) {
- fprintf(stderr, "Give VM system name [CERNVM]: ");
- fgets(get, sizeof(get), stdin);
- if (*get == '\n') strcpy(sys, "cernvm");
- else {
- get[strlen(get)-1] = '\0'; /* convert newline */
- strcpy(sys, get);
- }
-#endif /* VM */
- goto vmcase;
- }
- }
-/* NOTE THAT THE FOLLOWING TESTS ON MACHINE NAMES ARE CERN-SPECIFIC !! */
- if (!strncmp(system, "cernvm", 6) || !strncmp(system, "lepics", 6) ||
- !strncmp(system, "crnvm", 5))
- goto vmcase;
-/* NOTE THAT THE FOLLOWING TESTS ON MACHINE NAMES ARE CERN-SPECIFIC !! */
-/*
- if (!strncmp(system, "cernvm", 6) || !strncmp(system, "lepics", 6) ||
- !strncmp(system, "crnvm", 5))
- goto vmcase;
-*/
-#ifdef AUTHENT
-/* Get the user name/password info from ~/.netrc file for authentication */
-
-#ifdef APOPAL1
-/*** DIRTY TEMPORARY FIX FOR APOLLO-TO-OS9 AUTHENTICATION FOR PSH ***/
- if (!strncmp(system, "o-o", 3)) user = passwd = "(any)"; else
-#endif /* APOPAL1 */
-
- ruserpass(servhost, &user, &passwd); /* get info from .netrc */
- sprintf(uspass, "%s %s", user, passwd);
-#endif /* AUTHENT */
- goto vmagain;
-
-vmcase:
-
-/* VM (rexec) MODE FOLLOWS: */
-
- vmode++;
-
- gethostname(portstr, sizeof(portstr));
- for (pt=portstr; *pt ; pt++) prt += *pt;
-#ifdef DEBUG
-/*
- fprintf(stderr, "localhost = %s\n", portstr);
- fprintf(stderr, "prt = %d prt<<5 = %d\n", prt, (prt<<5));
- fprintf(stderr, "pid = %d (%x)\n", getpid(), getpid());
-*/
-#ifdef VMS
-/* fprintf(stderr, "time = %d\n", time(0)); */
-#endif /* VMS */
-#endif /* DEBUG */
-/* if (!sport) ** DEBUG **/
- sport = (prt << 5) | (getpid() & 0x3e0) + junk++;
-#ifdef VMS
- sport += (time(0) & 0xfff); /* Add 0-4095 as VMS pid may not change */
-#endif /* VMS */
- sprintf(portstr, "%d", sport);
- fprintf(stderr, "Remote host/port = %s/%s\n", system, portstr);
-
-/* Now it's time to give VM an "rexec" command to start the server.. */
-
- sp = getservbyname("exec", "tcp");
- if (sp == NULL) {
- fprintf(stderr, "'exec' not found in services file\n");
- return(-1);
- }
- strcpy(get, system); /* rexec modifies its host argument! */
- if (*sys == '\0') {
- register char *cs = sys;
-
- c = system; /* 'sys'= 'system' without domain extension */
- while ((*c) && (*c != '.')) {
- *cs++ = *c++;
- }
- *cs = '\0';
- }
- sprintf(uspass, "%s %s %s", srvc, portstr, sys);
-#ifdef DEBUG
-/*
- fprintf(stderr, "Rexec-ing %s cmd '%s'\n", system, uspass);
-*/
-#endif /* DEBUG */
-
- sx = rexec(&getp, (int)sp->s_port, user, passwd, uspass, NULL);
- if (sx < 0) {
- fprintf(stderr, "Bad rexec return %d\n", sx);
- fprintf(stderr, "Probable cause:\n");
- fprintf(stderr, " a) You are logged on already \n");
- fprintf(stderr, " b) You are disconnected (e.g. GONE)\n");
- fprintf(stderr, " c) Bad VM username or password\n");
- return(-1);
- }
-/* fprintf(stderr, "Successfully rexec-ed %s cmd '%s'\n", system, uspass); */
-
- fprintf(stderr, "%s: loading %s exec (%d sec timeout)...\n\n",
- system, srvc, VMTO);
-vmagain:
- /* clear out address structures */
- memset ((char *)&myaddr_in, 0, sizeof(struct sockaddr_in));
- memset ((char *)&peeraddr_in, 0, sizeof(struct sockaddr_in));
-
- /* Set up the peer address to which we will connect. */
- peeraddr_in.sin_family = AF_INET;
- /* Get the host information for the hostname that the
- * user passed in.
- */
-
- if ((addr = inet_addr(servhost)) != -1) { /* Permit IP addresses */
- peeraddr_in.sin_addr.s_addr = addr;
- } else {
- hp = gethostbyname(servhost);
- if (hp == NULL) {
- fprintf(stderr, "%s: %s not found in hosts file\n",
- "client_sock_setup", servhost);
- return(-1);
- }
- peeraddr_in.sin_addr.s_addr =
- ((struct in_addr *)(hp->h_addr))->s_addr;
-/* bcopy(hp->h_addr, (caddr_t)&peeraddr_in.sin_addr, hp->h_length); */
- }
-
- if (!vmode) {
- /* Find the information for the requested server
- * in order to get the needed port number.
- */
- sp = getservbyname (srvc, "tcp");
- if (sp == NULL) {
- fprintf(stderr, "%s: '%s' not found in services file\n",
- "client_sock_setup", srvc);
- return(-1);
- }
- peeraddr_in.sin_port = sp->s_port;
- } else {
- peeraddr_in.sin_port = htons(sport); /* VM */
- }
-
- /* Create the socket. */
- s = socket(AF_INET, SOCK_STREAM, 0);
- if (s == -1) {
-#ifdef VM
- tcperror("client_sock_setup");
-#else
- perror("client_sock_setup");
-#endif /* VM */
- fprintf(stderr, "%s: unable to create socket\n",
- "client_sock_setup");
- if (vmode) close(sx);
- return(-1);
- }
- /* Try to connect to the remote server at the address
- * which was just built into peeraddr.
- */
- if (connect(s, &peeraddr_in, sizeof(struct sockaddr_in)) == -1) {
- close(s);
- if (vmode) while (nn++ < VMTO) {
- /* fprintf(stderr, "Retry %d\n", nn); */
- sleep(1);
- goto vmagain;
- }
-#ifdef VM
- tcperror("client_sock_setup");
-#else
- perror("client_sock_setup");
-#endif /* VM */
- fprintf(stderr, "%s: unable to connect to remote\n",
- "client_sock_setup");
- if (vmode) close(sx);
- return(-1);
- }
-
- addrlen = sizeof(struct sockaddr_in);
- if (getsockname(s, &myaddr_in, &addrlen) == -1) {
-#ifdef VM
- tcperror("client_sock_setup");
-#else
- perror("client_sock_setup");
-#endif /* VM */
- fprintf(stderr, "%s: unable to read socket address\n",
- "client_sock_setup");
- clntpport = 0;
- } else
- clntpport = ntohs(myaddr_in.sin_port);
-
- /* Print out a startup message for the user. */
- time(&timevar);
- fprintf(stderr, "Connected to %s on TCP port %u at %s",
- servhost, clntpport, ctime(&timevar));
-
-#ifdef AUTHENT
- if (!vmode) {
- /* Send out the user/password authentication record first... */
- j = strlen(uspass);
-#ifdef VM
- CMXLATE(uspass,ebcdictoascii,j);
-#endif /* VM */
- for (i=0; i<j; i++) uspass[i] = ~uspass[i];
- if (send(s, uspass, j+1, 0) <= 0) {
-#ifdef VM
- tcperror("Error sending authorization");
-#else
- perror("Error sending authorization");
-#endif /* VM */
- goto badserv;
- }
- /* Read back a confirmation from server... */
- if ((i = recv(s, idbuf, sizeof(idbuf), 0)) <= 0) {
-#ifdef VM
- tcperror("Error receiving authorization");
-#else
- perror("Error receiving authorization");
-#endif /* VM */
-badserv:
- fprintf(stderr,"%s: Service '%s' not set up OK on host %s.\n",
- "client_sock_setup", srvc, servhost);
- close(s);
- return(-1);
- }
- idbuf[i] = '\0';
-#ifdef VM
- CMXLATE(idbuf,asciitoebcdic,i);
-#endif /* VM */
- fprintf(stderr, "%s\n", idbuf);
- }
-#endif /* AUTHENT */
-
- /* Remember the sx sockets per VM socket (even for VMS!) */
- if (vmode) {
- svmode[s%NSO] = MAGIC;
- sxsock[s%NSO] = sx;
- } else
- svmode[s%NSO] = sxsock[s%NSO] = 0;
-
- *in = *out = s;
- return(s); /* return the socket descriptor to FTN */
-
-}
-
-/*
- * SOCK_CLOSE (or: "SCLOSE")
- *
- * This routine closes a client (or a single-client server) socket.
- *
- */
-
-int sclose(sock)
-int *sock;
-
-{
- close(*sock); /* close the user socket */
-#ifndef OSK
- if (ls > 0) close(ls); /* ..and the listen socket if an active server */
-#endif /* OSK */
-
- if (svmode[(*sock)%NSO] == MAGIC) {
- close(sxsock[(*sock)%NSO]); /* ..and the sx socket if appropriate */
- svmode[(*sock)%NSO] = sxsock[(*sock)%NSO] = 0;
- }
-}
-
-/*
- * SOCK_SENDSTR (or: "SSENDSTR")
- *
- * This routine sends the contents of a character string down a socket.
- *
- * Args: socket, string address, string length.
- * NOTE: ROUTINE ATTEMPTS TO SEND EXACT INPUT LENGTH.
- *
- * Returns: Number of bytes sent/error (to be checked by user).
- */
-
-#ifdef VMS
-int ssendstr(sock, bufdes, m) /* VMS CASE... */
-int *sock;
-struct dsc$descriptor_s *bufdes;
-int *m;
-#else
-#ifdef CRAYFTN
-int ssendstr(sock, bufdes, m) /* CRAY CASE... */
-int *sock;
-_fcd bufdes;
-int *m;
-#else
-int ssendstr(sock, buf, m)
-int *sock;
-char *buf;
-int *m;
-#endif /* CRAYFTN */
-#endif /* VMS */
-
-{
-#ifdef VM
- extern char asciitoebcdic[]; /* translation tables */
- extern char ebcdictoascii[];
-#endif /* VM */
- int s = *sock, n = *m, i, j, k = 0;
-
-#ifdef VMS
- char *buf = bufdes->dsc$a_pointer;
-#endif /* VMS */
-#ifdef CRAYFTN
- char *buf = _fcdtocp(bufdes);
-#endif /* CRAYFTN */
-
-#ifdef VM
- CMXLATE(buf,ebcdictoascii,strlen(buf));
-#endif /* VM */
-retry:
- if ((i =send(s, buf+k, n-k, 0)) <= 0) {
-#ifdef XDEBUG
- tcperror("send");
- fprintf(STDERR,
- "sock_sendstr: sock = %d ret = %d len = %d k = %d buf[0-7] = '",
- s, i, n, k);
- for (j=0; j<8; j++) fprintf(STDERR, "%c", buf[j]);
- fprintf(STDERR, "'\n");
- if (i = 0) { sleep(2); goto retry; }
-#endif /* XDEBUG */
- return(i);
- }
- if (i < (n-k)) { k += i; goto retry; }
- return(n);
-}
-
-/*
- * SOCK_RECVSTR (or: SRECVSTR")
- *
- * This routine receives the contents of a character string on a socket.
- *
- * Args: socket, string address, [maximum] string length.
- * NEW: IF INPUT LENGTH > 0 ROUTINE ATTEMPTS TO GET THIS LENGTH.
- * IF ,, ,, < 0 ROUTINE GETS WHAT IT CAN (OLD STYLE).
- *
- * Returns: Number of bytes received/error (to be checked by user).
- *
- */
-
-#ifdef VMS
-int srecvstr(sock, bufdes, m) /* VMS CASE... */
-int *sock;
-struct dsc$descriptor_s *bufdes;
-int *m;
-#else
-#ifdef CRAYFTN
-int srecvstr(sock, bufdes, m) /* CRAY CASE... */
-int *sock;
-_fcd bufdes;
-int *m;
-#else
-int srecvstr(sock, buf, m)
-int *sock;
-char *buf;
-int *m;
-#endif /* CRAYFTN */
-#endif /* VMS */
-
-{
-#ifdef VM
- extern char asciitoebcdic[]; /* translation tables */
- extern char ebcdictoascii[];
-#endif /* VM */
- int s = *sock, n = *m, i, j, k = 0;
-
-#ifdef VMS
- char *buf = bufdes->dsc$a_pointer;
-#endif /* VMS */
-#ifdef CRAYFTN
- char *buf = _fcdtocp(bufdes);
-#endif /* CRAYFTN */
-
- if (n < 0) n = -n; /* Look for maximum number of bytes option... */
-
-retry:
- if ((i = recv(s, buf+k, n-k, 0)) <= 0) {
-#ifdef VM
- CMXLATE(buf+k,asciitoebcdic,i);
-#endif /* VM */
-#ifdef XDEBUG
- tcperror("recv");
- fprintf(STDERR,
- "sock_recvstr: sock = %d ret = %d len = %d k = %d buf[0-15] = '",
- s, i, *m, k);
- for (j=0; j<16; j++) fprintf(STDERR, "%c", buf[j]);
- fprintf(STDERR, "'\n");
-#endif /* XDEBUG */
- return(i);
- }
-#ifdef VM
- CMXLATE(buf+k,asciitoebcdic,i);
-#endif /* VM */
- if (*m > 0) { /* look for exact number of bytes option... */
- if (i < (n-k)) { k += i; goto retry; }
- return(n);
- } else
- return(i);
-}
-
-/*
- * SOCK_SEND (or: "SSEND")
- *
- * This routine sends a binary block of data down a socket.
- *
- * Args: socket, block address, block length.
- * NOTE: ROUTINE ATTEMPTS TO SEND EXACT INPUT LENGTH.
- *
- * Returns: Number of bytes sent/error (to be checked by user).
- *
- */
-
-int ssend(sock, buf, m)
-int *sock;
-char *buf;
-int *m;
-{
- int s = *sock, n = *m, i, j, k = 0;
-
-retry:
- if ((i = send(s, buf+k, n-k, 0)) <= 0) {
-#ifdef XDEBUG
- fprintf(STDERR,
- "sock_send: sock = %d ret = %d len = %d k = %d buf[0-7] = '",
- s, i, n, k);
- for (j=0; j<8; j++) fprintf(STDERR, "%c", buf[j]);
- fprintf(STDERR, "'\n");
-#endif /* XDEBUG */
- return(i);
- }
- if (i < (n-k)) { k += i; goto retry; }
- return(n);
-}
-
-/*
- * SOCK_RECV (or: "SRECV")
- *
- * This routine receives a binary block of data from a socket.
- *
- * Args: socket, receive buffer address, [maximum] block length.
- * NEW: IF INPUT LENGTH > 0 ROUTINE ATTEMPTS TO GET THIS LENGTH.
- * IF ,, ,, < 0 ROUTINE GETS WHAT IT CAN (OLD STYLE).
- *
- * Returns: Number of bytes received/error (to be checked by user).
- *
- */
-
-int srecv(sock, buf, m)
-int *sock;
-char *buf;
-int *m;
-{
- int s = *sock, n = *m, i, j, k = 0;
-
- if (n < 0) n = -n; /* Look for maximum number of bytes option... */
-
-retry:
- if ((i = recv(s, buf+k, n-k, 0)) <= 0) {
-#ifdef XDEBUG
- fprintf(STDERR,
- "sock_recv: sock = %d ret = %d len = %d k = %d buf[0-7] = '",
- s, i, *m, k);
- for (j=0; j<8; j++) fprintf(STDERR, "%c", buf[j]);
- fprintf(STDERR, "'\n");
-#endif /* XDEBUG */
- return(i);
- }
- if (*m > 0) { /* look for exact number of bytes option... */
- if (i < (n-k)) { k += i; goto retry; }
- return(n);
- } else
- return(i);
-}
-
-reply(s1, s2, s3)
- char *s1, *s2, *s3;
-{
-#ifdef OSK
- char buff[100];
- int osock = 1;
-
- sprintf(buff, s1, s2, s3);
- send(osock, buff, strlen(buff)+1, 0);
-#else
- printf(s1, s2, s3);
- fflush(stdout);
-#endif /* OSK */
-
-#ifdef LOGFILE
- fprintf(logfile, s1, s2, s3);
-#endif /* LOGFILE */
-}
-
-#ifdef AUTHENT
-/* Code derived from ftpd to do name/passwd checking.. */
-/* Note that printf's get pushed down the network to client... */
-#ifdef VM
-int chpass(user, pass) /* For VM */
- char *user, *pass;
-{
- char *topoint;
- topoint = user;
- while (*topoint != '\0'){
- toupper(*topoint);
- topoint++;
- }
- topoint = pass;
- while (*topoint != '\0'){
- toupper(*topoint);
- topoint++;
- }
- if (CHPAS(user,pass)){ /*if pw check no ok (done in assembler) */
- reply("Bad password for user %s.\n", user);
- return(-3);
- }
- reply("User %s accepted.\n", user);
-#ifdef LOGFILE
- fclose(logfile);
-#endif /* LOGFILE */
- return(1);
-}
-#else /* ^VM */
-#ifndef VMS
-int chpass(user, pass) /* For Unix and other "normal" people */
- char *user, *pass;
-{
-
-#ifndef OSK
-
- char buff[100];
-#ifdef APOPWD1
-/** TEMPORARY APOLLO KLUDGE WHILE "crypt" DOESN'T WORK.. **/
-#include <sys/wait.h>
-
- union wait ret;
-#endif /* APOPWD1 */
-
- char *xpasswd, *crypt();
- struct passwd *pw;
-#ifdef ACE
- struct acmdata acmd; /* Unicos6.0 calling sequence used.. */
-
- acmd.acm_both = 0;
-#endif /* ACE */
-
- pw = getpwnam(user);
- if (pw == NULL) {
- reply("User %s unknown.\n", user);
- return(-2);
- }
-
-#ifdef APOPWD1
-/** TEMPORARY APOLLO KLUDGE WHILE "crypt" DOESN'T WORK.. **/
-#define KLUDGE "-c /com/date >/dev/null 2>/dev/null"
-
- sprintf(buff, "%s %s %s %s %s","/com/login",user,"-lp", pass,KLUDGE);
- ret.w_status = system(buff);
- if (ret.w_Retcode) {
-#else
-#ifdef ACE
- acmd.acm_mode = CKUSR;
- acmd.acm_user = pw->pw_name;
- acmd.acm_clearpc = "";
- if (!acmlg(&acmd)) {
-/* The user has a SecurID card ...................... */
- int i;
-
- acmd.acm_clearpc = pass;
- if ((i = acmlg(&acmd))) {
- reply("Bad passcode for user %s: ACE error %d.\n",
- pw->pw_name, i);
- return(-7);
- }
- } else { /* apply the normal Unix password check ... */
-#endif /* ACE */
- xpasswd = crypt(pass, pw->pw_passwd);
- /* The strcmp does not catch null passwords! */
- if (*pw->pw_passwd == '\0' || strcmp(xpasswd,pw->pw_passwd)) {
-#endif /* APOPWD1 */
- reply("Bad password for user %s.\n", pw->pw_name);
- return(-3);
- }
-#ifdef ACE
- }
-#endif /* ACE */
-#ifdef HPUX
- if (setresgid(0,pw->pw_gid,0)) {
-#else
-#ifdef IBMRT
- setgid(pw->pw_gid);
-#endif /* IBMRT */
- if (setegid(pw->pw_gid)) {
-#endif /* HPUX */
- reply("Can't setegid for user %s.\n", pw->pw_name);
- return(-4);
- }
-#ifndef NOINITGROUPS
- if (initgroups(pw->pw_name, pw->pw_gid)) {
- reply("Can't initgroups for user %s.\n", pw->pw_name);
- return(-5);
- }
-#endif /* NOINITGROUPS */
- if (chdir(pw->pw_dir)) {
-#ifdef HPUX
- setresuid(0,0,0);
-#else
- seteuid(0);
-#endif /* HPUX */
- reply("Can't set home directory '%s' for user %s.\n",
- pw->pw_dir, pw->pw_name);
- return(-6);
- }
-#endif /* OSK */
-
-/* SUCCESS.................................................. */
- reply("User %s accepted (in directory %s).\n",
- pw->pw_name, pw->pw_dir);
-#ifdef LOGFILE
- fclose(logfile); /* Do this while still root.. */
-#endif /* LOGFILE */
-#ifndef OSK
-#ifdef HPUX
- setresuid(0,pw->pw_uid,0);
-#else
-#ifdef IBMRT
- setuid(pw->pw_uid);
-#endif /* IBMRT */
- seteuid(pw->pw_uid);
-#endif /* HPUX */
-#endif /* OSK */
- return(1);
-}
-
-#else /* VMS */
-
-int chpass(user, pass) /* For VMS only (yes, it's different) */
- char *user, *pass;
-{
- char *xpasswd, *crypt();
- struct passwd *pw;
-
- pw = getpwnam(user);
- if (pw == NULL) {
- reply("User %s unknown.\n", user);
- return(-2);
- } else {
- xpasswd = vmscrypt(user, pass, pw->pw_encrypt, pw->pw_salt);
- /* The strcmp does not catch null passwords! */
- if (*pw->pw_passwd == '\0' || strcmp(xpasswd,pw->pw_passwd)) {
- reply("Bad password for user %s.\n", user);
- return(-3);
- }
- }
- if (setegid(pw->pw_gid) < 0) {
- reply("Can't setegid for user %s.\n", user);
- return(-4);
- }
-/*
- if (initgroups(pw->pw_name, pw->pw_gid) < 0) {
- reply("Can't initgroups for user %s.\n", user);
- return(-5);
- }
-*/
-
-/*
- * Beware: on VMS, chdir is effective only during image execution.
- * Otherwise, chdir is to be called in SUPER, EXEC or KERNEL mode.
- */
- if (chdir(pw->pw_dir)) {
- setuic(my_pw->pw_uic);
- reply("Can't set home directory for user %s.\n", user);
- return(-6);
- }
-
-/* Success.. */
- reply("User %s accepted.\n", user);
-#ifdef LOGFILE
- fclose(logfile); /* Do this while still root.. */
-#endif /* LOGFILE */
- if (seteuid(pw->pw_uid) < 0) {
- printf("Can't seteuid for user %s.\n", user);
- fflush(stdout);
- return(-7);
- }
- if (setuser(pw->pw_name) != 0) { /* Change user name */
- printf("Can't setuser for user %s.\n", user);
- fflush(stdout);
- return(-8);
- }
- if (setacct(pw->pw_account) != 0) { /* Change account */
- printf("Can't setacct for user %s.\n", user);
- fflush(stdout);
- return(-9);
- }
- if (setpriv(pw->pw_priv) != 0) { /* Change privileges */
- printf("Can't setpriv for user %s.\n", user);
- fflush(stdout);
- return(-10);
- }
-
- return(1);
-}
-
-#endif /* VMS */
-#endif /* VM */
-#endif /* AUTHENT */
-
-/* Provide all of ruserpass.c unless specifically omitted */
-
-#ifdef VMS
-/* Code from Unix RTL missing from VMS.... */
-/* "ruserpass.c" -- to obtain a user's remote name and password */
-/* Version hacked for VMS (and Wollongong) compatibility. (BS) */
-/* A VMS FTN calling program MUST call "vaxc$crtl_init" for getenv TO WORK */
-
-#include <stat.h>
-#include "sysreq/sgtty.h"
-
- static char usr[30], pss[30], myname[30];
-
-ruserpass(host, aname, apass)
- char *host, **aname, **apass;
-{
- struct sgttyb sgttyb_val;
-
- if (*aname == NULL || *apass == NULL)
- rnetrc(host, aname, apass);
- if (*aname == NULL) {
- char *c = myname;
-
- strcpy(myname, getenv("USER"));
- while (*c) { *c = tolower(*c); c++; }
- fprintf(stderr, "Name (%s:%s): ", host, myname);
- if (fgets(usr, sizeof(usr), stdin) == NULL) goto fatal;
- if (*usr == '\n') {
- strcpy(usr, myname);
- } else
- usr[strlen(usr)-1] = '\0'; /* convert newline */
- *aname = usr;
- }
- if (*aname && *apass == NULL) {
- /* FHE library needed for this echo-manipulation on VMS..... */
- if (gtty(0, &sgttyb_val)) {
- perror("gtty");
- goto fatal;
- }
- sgttyb_val.sg_flags |= TT$M_NOECHO; /* turn off echo */
- if (stty(0, &sgttyb_val)) {
- perror("stty(0)");
- goto fatal;
- }
- fprintf(stderr, "Password (%s:%s): ", host, *aname);
- if (fgets(pss, sizeof(pss), stdin) == NULL) goto fatal1;
- fprintf(stdout,"\n");
- sgttyb_val.sg_flags &= ~(TT$M_NOECHO); /* restore echo */
- if (stty(0, &sgttyb_val)) {
- perror("stty");
- goto fatal;
- }
- pss[strlen(pss)-1] = '\0'; /* convert newline */
- *apass = pss;
- }
- return;
-fatal1:
- sgttyb_val.sg_flags &= ~(TT$M_NOECHO); /* restore echo */
- stty(0, &sgttyb_val);
-fatal:
- fprintf(stderr, "Fatal input error.\n");
- exit(1);
-}
-
-rnetrc(host, aname, apass)
- char *host, **aname, **apass;
-{
-
- static FILE *cfile;
- char rcline[100];
- char *hdir, buf[100], mach[30];
- struct stat stb;
-
- hdir = getenv("HOME");
- if (hdir == NULL)
- hdir = ".";
- sprintf(buf, "%sftplogin.", hdir); /* Using the TWG FTPLOGIN file */
- cfile = fopen(buf, "r");
- if (cfile == NULL) {
- if (errno != ENOENT)
- perror(buf);
- return;
- }
-
-/* Note that the format of the TWG "ftplogin" file is simpler than .netrc */
-
- while (fgets(rcline, sizeof(rcline), cfile) != NULL) {
-
- if (sscanf(rcline, "%s %s %s", mach, usr, pss) != 3
- || strcmp(host, mach)) continue;
-
- *aname = usr; /* now we have a user on the right machine */
-
- if (!strcmp(pss, "-")) break;
-
-/* Have a hit and a "real" password: check mode/ownership & warn if bad.. */
-/* (No good on VMS as no bits for group/world r/w/x are provided........)
-#define RWXRWX 077
-
- if (fstat(fileno(cfile), &stb) >= 0
- && (stb.st_mode & RWXRWX) != 0) {
- fprintf(stderr,
- "WARNING - file: %s insufficiently protected.\n", buf);
- fprintf(stderr,
- " - Remove password or restrict its access.\n");
- break;
- }
- ..(No good on VMS as no bits for group/world r/w/x are provided........) */
-
- *apass = pss; /* all OK */
- break;
- }
- fclose(cfile);
-}
-#else /* ^VMS */
-
-#ifndef NORUSERPASS
-
-#define DEFAULT 1
-#define LOGIN 2
-#define PASSWD 3
-#define NOTIFY 4
-#define WRITE 5
-#define YES 6
-#define NO 7
-#define COMMAND 8
-#define FORCE 9
-#define ID 10
-#define MACHINE 11
-
-static char tokval[100];
-
-static struct toktab {
- char *tokstr;
- int tval;
-} toktab[]= {
- "default", DEFAULT,
- "login", LOGIN,
- "password", PASSWD,
- "notify", NOTIFY,
- "write", WRITE,
- "yes", YES,
- "y", YES,
- "no", NO,
- "n", NO,
- "command", COMMAND,
- "force", FORCE,
- "machine", MACHINE,
- 0, 0
-};
-
-#ifdef VM
-static FILE *cfile;
-
-ruserpass(host, aname, apass)
- char *host, **aname, **apass;
-{
- char *myname;
- char buff[100];
-
- if (*aname == 0 || *apass == 0)
- rnetrc(host, aname, apass);
-/*rintf(stderr,"host = %s aname = %s apass = %s\n",host,*aname,*apass);*/
- if (*aname == 0) {
- myname = getlogin();
- sprintf(buff, "Name (%s:%s): ", host, myname);
- *aname = LNRD(buff);
- if ((*aname)[0] == '\0')
- *aname = myname;
- }
- if (*aname && *apass == 0) {
- sprintf(buff, "Password (%s:%s): ", host, *aname);
- *apass = LNRDPAS(buff);
- }
-}
-
-static
-rnetrc(host, aname, apass)
- char *host, **aname, **apass;
-{
- char buf[BUFSIZ];
- int t;
-
- strcpy(buf, "DOT.NETRC.A0");
- cfile = fopen(buf, "r");
- if (cfile == NULL) {
- if (errno != ENOENT)
- perror(buf);
- return;
- }
-next:
- while ((t = token())) switch(t) {
-
- case DEFAULT:
- (void) token();
- continue;
-
- case MACHINE:
- if (token() != ID || strcmp(host, tokval))
- continue;
- while ((t = token()) && t != MACHINE) switch(t) {
-
- case LOGIN:
- if (token())
- if (*aname == 0) {
- *aname = malloc(strlen(tokval) + 1);
- strcpy(*aname, tokval);
- } else {
- if (strcmp(*aname, tokval))
- goto next;
- }
- break;
- case PASSWD:
- if (token() && *apass == 0) {
- *apass = malloc(strlen(tokval) + 1);
- strcpy(*apass, tokval);
- }
- break;
- case COMMAND:
- case NOTIFY:
- case WRITE:
- case FORCE:
- (void) token();
- break;
- default:
- fprintf(stderr, "Unknown .netrc option %s\n", tokval);
- break;
- }
- goto done;
- }
-done:
- fclose(cfile);
-}
-
-#else /* ^VM */
-#include <sys/types.h>
-#include <sys/stat.h>
-#include <errno.h>
-
-char *malloc(), *index(), *getpass(), *getlogin();
-static FILE *cfile;
-
-ruserpass(host, aname, apass)
- char *host, **aname, **apass;
-{
-
- if (*aname == 0 || *apass == 0)
- rnetrc(host, aname, apass);
- if (*aname == 0) {
- char *myname = getlogin();
- *aname = malloc(16);
- printf("Name (%s:%s): ", host, myname);
- fflush(stdout);
- if (read(2, *aname, 16) <= 0)
- exit(1);
- if ((*aname)[0] == '\n')
- *aname = myname;
- else
- if (index(*aname, '\n'))
- *index(*aname, '\n') = 0;
- }
- if (*aname && *apass == 0) {
- printf("Password (%s:%s): ", host, *aname);
- fflush(stdout);
- *apass = getpass("");
- }
-}
-
-static
-rnetrc(host, aname, apass)
- char *host, **aname, **apass;
-{
- char *hdir, buf[BUFSIZ];
- int t;
- struct stat stb;
- extern int errno;
- char *getenv();
-
- hdir = getenv("HOME");
- if (hdir == NULL)
- hdir = ".";
- sprintf(buf, "%s/.netrc", hdir);
- cfile = fopen(buf, "r");
- if (cfile == NULL) {
- if (errno != ENOENT)
- perror(buf);
- return;
- }
-next:
- while ((t = token())) switch(t) {
-
- case DEFAULT:
- (void) token();
- continue;
-
- case MACHINE:
- if (token() != ID || strcmp(host, tokval))
- continue;
- while ((t = token()) && t != MACHINE) switch(t) {
-
- case LOGIN:
- if (token())
- if (*aname == 0) {
- *aname = malloc(strlen(tokval) + 1);
- strcpy(*aname, tokval);
- } else {
- if (strcmp(*aname, tokval))
- goto next;
- }
- break;
- case PASSWD:
- if (fstat(fileno(cfile), &stb) >= 0
- && (stb.st_mode & 077) != 0) {
- fprintf(stderr, "Error - .netrc file not correct mode.\n");
- fprintf(stderr, "Remove password or correct mode.\n");
- exit(1);
- }
- if (token() && *apass == 0) {
- *apass = malloc(strlen(tokval) + 1);
- strcpy(*apass, tokval);
- }
- break;
- case COMMAND:
- case NOTIFY:
- case WRITE:
- case FORCE:
- (void) token();
- break;
- default:
- fprintf(stderr, "Unknown .netrc option %s\n", tokval);
- break;
- }
- goto done;
- }
-done:
- fclose(cfile);
-}
-
-#endif /* VM */
-
-static
-token()
-{
- char *cp;
- int c;
- struct toktab *t;
-
- if (feof(cfile))
- return (0);
- while ((c = getc(cfile)) != EOF &&
- (c == '\n' || c == '\t' || c == ' ' || c == ','))
- continue;
- if (c == EOF)
- return (0);
- cp = tokval;
- if (c == '"') {
- while ((c = getc(cfile)) != EOF && c != '"') {
- if (c == '\\')
- c = getc(cfile);
- *cp++ = c;
- }
- } else {
- *cp++ = c;
- while ((c = getc(cfile)) != EOF
- && c != '\n' && c != '\t' && c != ' ' && c != ',') {
- if (c == '\\')
- c = getc(cfile);
- *cp++ = c;
- }
- }
- *cp = 0;
- if (tokval[0] == 0)
- return (0);
- for (t = toktab; t->tokstr; t++)
- if (!strcmp(t->tokstr, tokval))
- return (t->tval);
- return (ID);
-}
-
-#ifndef VM
-/* I provide "getpass" myself as standard version truncates to 8 characters */
-#include <sys/ioctl.h>
-#ifdef CBREAK
-#define BSDTTY /* First find out if BSD or SYSV terminal handling.. */
-#endif
-
-#ifndef BSDTTY
-#include <termio.h>
-#else
-#include <sgtty.h>
-#endif
-
-extern int kill(), ioctl(), getpid();
-static int intrupt;
-
-/*** NOTE MAXPASSWD IS DEFINED AS 8 IN ALL STANDARD UNIX SYSTEMS, BUT THIS
- *** GIVES US PROBLEMS INTERWORKING WITH VMS AND CRAY-SECURID SYSTEMS. ***/
-#define MAXPASSWD 20 /* max significant characters in password */
-
-char *
-getpass(prompt)
-char *prompt;
-{
-#ifndef BSDTTY
- struct termio ttyb;
- unsigned short flags;
-#else
- struct sgttyb ttyb;
- int flags;
-#endif
- register char *p;
- register int c;
- FILE *fi;
- static char pbuf[ MAXPASSWD + 1 ];
- void (*sig)(), catch();
-
- if((fi = fopen("/dev/tty", "r")) == NULL)
- return((char*)NULL);
- setbuf(fi, (char*)NULL);
- sig = signal(SIGINT, catch);
- intrupt = 0;
-#ifndef BSDTTY
- (void) ioctl(fileno(fi), TCGETA, &ttyb);
- flags = ttyb.c_lflag;
- ttyb.c_lflag &= ~(ECHO | ECHOE | ECHOK | ECHONL);
- (void) ioctl(fileno(fi), TCSETAF, &ttyb);
-#else
- gtty(fileno(fi), &ttyb);
- flags = ttyb.sg_flags;
- ttyb.sg_flags &= ~ECHO;
- stty(fileno(fi), &ttyb);
-#endif
- (void) fputs(prompt, stderr);
- p = pbuf;
- while( !intrupt &&
- (c = getc(fi)) != '\n' && c != '\r' && c != EOF ) {
- if(p < &pbuf[ MAXPASSWD ])
- *p++ = c;
- }
- *p = '\0';
-#ifndef BSDTTY
- ttyb.c_lflag = flags;
- (void) ioctl(fileno(fi), TCSETAW, &ttyb);
-#else
- ttyb.sg_flags = flags;
- stty(fileno(fi), &ttyb);
-#endif
- (void) putc('\n', stderr);
- (void) signal(SIGINT, sig);
- if(fi != stdin)
- (void) fclose(fi);
- if(intrupt)
- (void) kill(getpid(), SIGINT);
- return(pbuf);
-}
-
-static void
-catch()
-{
- ++intrupt;
-}
-#endif /* ^VM */
-#endif /* NORUSERPASS */
-#endif /* VMS */
-
-/* I provide "rexec" myself as standard version does not allow IP addresses */
-
-rexec(ahost, rport, name, pass, cmd, fd2p)
- char **ahost;
- int rport;
- char *name, *pass, *cmd;
- int *fd2p;
-{
-#ifdef VM
- extern char asciitoebcdic[]; /* translation tables */
- extern char ebcdictoascii[];
-#endif /* VM */
- int s, timo = 1;
- struct sockaddr_in sin;
- char c;
- short port;
- struct hostent *hp;
- unsigned long addr;
-
- if ((addr = inet_addr(*ahost)) != -1) { /* Permit IP addresses */
- sin.sin_addr.s_addr = addr;
- } else {
- hp = gethostbyname(*ahost);
- if (hp == 0) {
- fprintf(stderr, "%s: unknown host\n", *ahost);
- return (-1);
- }
-/* NOT NICE *ahost = hp->h_name; THIS IS NOT NICE */
- }
- ruserpass(*ahost, &name, &pass);
-
-retry:
- s = socket(AF_INET, SOCK_STREAM, 0);
- if (s < 0) {
-#ifdef VM
- tcperror("rexec: socket");
-#else
- perror("rexec: socket");
-#endif /* VM */
- return (-1);
- }
- sin.sin_family = AF_INET;
- sin.sin_port = (short)rport;
- if (addr != -1) { /* Permit IP addresses */
- sin.sin_addr.s_addr = addr;
- } else {
- sin.sin_addr.s_addr =
- ((struct in_addr *)(hp->h_addr))->s_addr;
-/* bcopy(hp->h_addr, (caddr_t)&sin.sin_addr, hp->h_length); */
- }
- if (connect(s, &sin, sizeof(struct sockaddr_in)) < 0) {
- if (errno == ECONNREFUSED && timo <= 16) {
- (void) close(s);
- sleep(timo);
- timo *= 2;
- goto retry;
- }
-#ifdef VM
- tcperror("rexec: connect");
-#else
- perror("rexec: connect");
-#endif /* VM */
- return (-1);
- }
- if (fd2p == 0) {
- (void) send(s, "", 1, 0);
- port = 0;
- } else {
- fprintf(stderr, "Control channel not implemented\n");
- goto bad;
- }
-#ifdef VM
- CMXLATE(name,ebcdictoascii,strlen(name));
- CMXLATE(pass,ebcdictoascii,strlen(pass));
- CMXLATE(cmd,ebcdictoascii,strlen(cmd));
-#endif /* VM */
- (void) send(s, name, strlen(name) + 1, 0);
- (void) send(s, pass, strlen(pass) + 1, 0);
- (void) send(s, cmd, strlen(cmd) + 1, 0);
- if (recv(s, &c, 1, 0) != 1) {
-#ifdef VM
- tcperror("rexec recv");
-#else
- perror("rexec recv");
-#endif /* VM */
- goto bad;
- }
- if (c != 0) {
- fprintf(stderr,"c = ");
- while (recv(s, &c, 1, 0) == 1) {
-#ifdef VM
- CMXLATE(&c,asciitoebcdic,1);
-#endif /* VM */
- fprintf(stderr,"%c",c);
- (void) send(2, &c, 1, 0);
- if (c == '\n')
- break;
- }
- fprintf(stderr,"\n ended");
- goto bad;
- }
- return (s);
-bad:
- if (port)
- (void) close(*fd2p);
- (void) close(s);
- return (-1);
-}
-
-
-/******** INTERFACE ROUTINES TO HANDLE VARIOUS NAMING CONVENTIONS *********/
-
-/*** COMPATIBILITY-MODE: FULL-LENGTH NAMES AS USED IN EARLY "TCPAW" ***/
-
-#ifndef OSK
-#ifndef VM
-int inetd_sock_setup(in, out)
-int *in, *out;
-{
- return(isetup(in, out));
-}
-
-int inetd_sock_close(sock)
-int *sock;
-{
- return(iclose(sock));
-}
-#endif /* ^VM */
-#endif /* OSK */
-
-int server_sock_setup(in, out)
-int *in, *out;
-{
- return(ssetup(in, out));
-}
-
-#ifdef VMS
-int client_sock_setup(sysdes, in, out, srvdes) /* VMS CASE... */
-struct dsc$descriptor_s *sysdes;
-int *in, *out;
-struct dsc$descriptor_s *srvdes;
-{
- return(csetup(sysdes, in, out, srvdes));
-}
-#else
-#ifdef APOFTN
-int client_sock_setup(system, in, out, srvc, s_ln, c_ln) /* APOLLO FTN CASE */
-char *system; /* (PRE-SR9 ONLY) */
-int *in, *out;
-char *srvc;
-short *s_ln, *c_ln; /* dummy arguments */
-{
- return(csetup(system, in, out, srvc, s_ln, c_ln));
-}
-#else
-int client_sock_setup(system, in, out, srvc) /* UNIX ETC... */
-char *system;
-int *in, *out;
-char *srvc;
-{
- return(csetup(system, in, out, srvc));
-}
-#endif /* APOFTN */
-#endif /* VMS */
-
-int sock_close(sock)
-int *sock;
-{
- return(sclose(sock));
-}
-
-#ifdef VMS
-int sock_sendstr(sock, bufdes, m) /* VMS CASE... */
-int *sock;
-struct dsc$descriptor_s *bufdes;
-int *m;
-{
- return(ssendstr(sock, bufdes, m));
-}
-#else
-int sock_sendstr(sock, buf, m)
-int *sock;
-char *buf;
-int *m;
-{
- return(ssendstr(sock, buf, m));
-}
-#endif /* VMS */
-
-#ifdef VMS
-int sock_recvstr(sock, bufdes, m) /* VMS CASE... */
-int *sock;
-struct dsc$descriptor_s *bufdes;
-int *m;
-{
- return(srecvstr(sock, bufdes, m));
-}
-#else
-int sock_recvstr(sock, buf, m)
-int *sock;
-char *buf;
-int *m;
-{
- return(srecvstr(sock, buf, m));
-}
-#endif /* VMS */
-
-int sock_send(sock, buf, m)
-int *sock;
-char *buf;
-int *m;
-{
- return(ssend(sock, buf, m));
-}
-
-int sock_recv(sock, buf, m)
-int *sock;
-char *buf;
-int *m;
-{
- return(srecv(sock, buf, m));
-}
-
-#ifndef apollo
-/*** UNIX routines f77 <-> C to handle underlines generated by FORTRAN ***/
-/*** CASE FOR SYSTEMS USING FULL-LENGTH NAMES (WITH UNDERLINES) IN F77 ***/
-
-int client_sock_setup_(system, in, out, srvc)
-char *system;
-int *in, *out;
-char *srvc;
-{
- return(csetup(system, in, out, srvc));
-}
-
-#ifndef OSK
-#ifndef VM
-int inetd_sock_setup_(in, out)
-int *in, *out;
-{
- return(isetup(in, out));
-}
-
-int inetd_sock_close_(sock)
-int *sock;
-{
- return(iclose(sock));
-}
-#endif /* ^VM */
-#endif /* OSK */
-
-int server_sock_setup_(in, out)
-int *in, *out;
-{
- return(ssetup(in, out));
-}
-
-int sock_close_(sock)
-int *sock;
-{
- return(sclose(sock));
-}
-
-int sock_sendstr_(sock, buf, m)
-int *sock;
-char *buf;
-int *m;
-{
- return(ssendstr(sock, buf, m));
-}
-
-int sock_recvstr_(sock, buf, m)
-int *sock;
-char *buf;
-int *m;
-{
- return(srecvstr(sock, buf, m));
-}
-
-int sock_send_(sock, buf, m)
-int *sock;
-char *buf;
-int *m;
-{
- return(ssend(sock, buf, m));
-}
-
-int sock_recv_(sock, buf, m)
-int *sock;
-char *buf;
-int *m;
-{
- return(srecv(sock, buf, m));
-}
-
-/*** CASE FOR SYSTEMS USING SHORTENED NAMES (WITHOUT UNDERLINES) IN F77 ***/
-/*** (NEEDED FOR SOME ULTRIX VERSIONS....) ***/
-
-int csetup_(system, in, out, srvc)
-char *system;
-int *in, *out;
-char *srvc;
-{
- return(csetup(system, in, out, srvc));
-}
-#ifndef OSK
-#ifndef VM
-
-int isetup_(in, out)
-int *in, *out;
-{
- return(isetup(in, out));
-}
-
-int iclose_(sock)
-int *sock;
-{
- return(iclose(sock));
-}
-#endif /* ^VM */
-#endif /* OSK */
-
-int ssetup_(in, out)
-int *in, *out;
-{
- return(ssetup(in, out));
-}
-
-int sclose_(sock)
-int *sock;
-{
- return(sclose(sock));
-}
-
-int ssendstr_(sock, buf, m)
-int *sock;
-char *buf;
-int *m;
-{
- return(ssendstr(sock, buf, m));
-}
-
-int srecvstr_(sock, buf, m)
-int *sock;
-char *buf;
-int *m;
-{
- return(srecvstr(sock, buf, m));
-}
-
-int ssend_(sock, buf, m)
-int *sock;
-char *buf;
-int *m;
-{
- return(ssend(sock, buf, m));
-}
-
-int srecv_(sock, buf, m)
-int *sock;
-char *buf;
-int *m;
-{
- return(srecv(sock, buf, m));
-}
-#endif /* apollo */
-
-#ifdef CRAYFTN
-/**** SPECIAL VERSION FOR CRAY CFT77 ***/
-
-int CSETUP(system, in, out, srvc)
-_fcd system;
-int *in, *out;
-_fcd srvc;
-{
- return(csetup(system, in, out, srvc));
-}
-
-int ISETUP(in, out)
-int *in, *out;
-{
- return(isetup(in, out));
-}
-
-int ICLOSE(sock)
-int *sock;
-{
- return(iclose(sock));
-}
-
-int SSETUP(in, out)
-int *in, *out;
-{
- return(ssetup(in, out));
-}
-
-int SCLOSE(sock)
-int *sock;
-{
- return(sclose(sock));
-}
-
-int SSENDSTR(sock, buf, m)
-int *sock;
-_fcd buf;
-int *m;
-{
- return(ssendstr(sock, buf, m));
-}
-
-int SRECVSTR(sock, buf, m)
-int *sock;
-_fcd buf;
-int *m;
-{
- return(srecvstr(sock, buf, m));
-}
-
-int SSEND(sock, buf, m)
-int *sock;
-char *buf;
-int *m;
-{
- return(ssend(sock, buf, m));
-}
-
-int SRECV(sock, buf, m)
-int *sock;
-char *buf;
-int *m;
-{
- return(srecv(sock, buf, m));
-}
-#endif /* CRAYFTN */
-
-#ifdef OSK
-/**** SPECIAL VERSION FOR OS9 ONLY ***/
-
-char cserv[80],chost[80];
-
-int CLIENT_SOCK_SETUP(host,isock,osock,service)
-char *host, *service;
-int *isock;
-int *osock;
-{
- return(client_sock_setup(strfc(chost,host,80),isock,osock,
- strfc(cserv,service,80)));
-}
-
-int SERVER_SOCK_SETUP(isock,osock)
-int *isock;
-int *osock;
-{
- return(server_sock_setup(isock,osock));
-}
-
-int SOCK_CLOSE(sock)
-int *sock;
-
-{
- return(sock_close(sock));
-}
-
-int SOCK_SENDSTR(sock, buf, m)
-int *sock;
-char *buf;
-int *m;
-
-{
- return(sock_sendstr(sock, buf, m));
-}
-
-int SOCK_RECVSTR(sock, buf, m)
-int *sock;
-char *buf;
-int *m;
-
-{
- return(sock_recvstr(sock, buf, m));
-}
-
-int SOCK_SEND(sock, buf, m)
-int *sock;
-char *buf;
-int *m;
-
-{
- return(sock_send(sock, buf, m));
-}
-
-int SOCK_RECV(sock, buf, m)
-int *sock;
-char *buf;
-int *m;
-
-{
- return(sock_recv(sock, buf, m));
-}
-#endif /* OSK */
-
-#ifdef VM
-int cinit(int dummy)
-{
-/* fprintf(stderr,"Initializing C environment...\n");*/
- return(0); /*to init the c environment*/
-}
-
-/* get length of a Fortran string given as argument */
-int gtlnfstr(plistaddr,argposition)
-void *plistaddr; /* &first_arg */
-int argposition; /* n for nth argument */
-{
- int **secplist;
- int *poffset;
- char *bzstr;
-
- poffset =(int *)plistaddr;
- poffset = poffset - 1;
- bzstr =(char *)(poffset -1);
- if (!strcmp(bzstr,"BZ")){
- secplist =(int **)((char *)plistaddr + *poffset);
- return( **(secplist + argposition - 1));
- }
- else{
- return(-1); /* no secondary plist when no character*n arg */
- }
-}
-#endif /* VM */
-
-
-#endif
diff --git a/src/packlib/cspack/xz/Imakefile b/src/packlib/cspack/xz/Imakefile
deleted file mode 100644
index 0755d6c..0000000
--- a/src/packlib/cspack/xz/Imakefile
+++ /dev/null
@@ -1,22 +0,0 @@
-SRCS_F= xzcd.F xzclos.F xzconv.F xzctof.F xzftoc.F \ @@\
- xzfzcp.F xzgeta.F xzgetb.F xzgetd.F xzgetf.F xzgetl.F xzgetp.F \ @@\
- xzgetr.F xzgetx.F xzhrop.F xzinit.F xzinqr.F xzitoc.F \ @@\
- xzlcd.F xzlls.F xzlmv.F xzlogl.F xzlrm.F xzls.F xzlsys.F \ @@\
- xzmv.F xzopen.F xzputa.F xzputb.F \ @@\
- xzputd.F xzputf.F xzputl.F xzputp.F xzputr.F xzputx.F xzpwd.F \ @@\
- xzread.F xzrewd.F xzrfrf.F xzrite.F xzrm.F xzrsys.F xzrtof.F \ @@\
- xzrzcp.F xzrzop.F xzsver.F xzvers.F xzwrtm.F
-
-#if defined(CERNLIB_VAXVMS)
-SRCS_F := $(SRCS_F) xzfinf.F xzprot.F
-#endif
-
-#if defined(CERNLIB_IBMMVS)
-SRCS_F := $(SRCS_F) xzlcat.F xzmvsd.F xzpref.F
-#endif
-
-#if defined(CERNLIB_IBM)
-SRCS_S= xzatoe.s xzetoa.s
-#endif
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/cspack/xz/xzatoe.s b/src/packlib/cspack/xz/xzatoe.s
deleted file mode 100644
index cd470ee..0000000
--- a/src/packlib/cspack/xz/xzatoe.s
+++ /dev/null
@@ -1,227 +0,0 @@
-*
-* $Id: xzatoe.s,v 1.1.1.1 1996/03/08 15:44:28 mclareni Exp $
-*
-* $Log: xzatoe.s,v $
-* Revision 1.1.1.1 1996/03/08 15:44:28 mclareni
-* Cspack
-*
-*
-#if defined(CERNLIB_IBM)
-#if defined(CERNLIB_IBM)
- MACRO
-&L A0E0
- SPACE
-&L DS 0C BYTE ALIGNMENT ONLY
- SPACE
-* THIS TRANSLATE TABLE CONVERTS CERN ASCII TO CERN EBCDIC
-*
-* IT IS BASED ON THE RUTHERFORD TABLE WITH THE FOLLOWING
-* MODIFICATIONS:-
-* ASCII 5E IS CONVERTED TO EBCDIC 6A (CIRCUMFLEX)
-* ILLEGAL CHARACTERS ARE CONVERTED TO 7B (HASH) RATHER THAN
-* 6C (PERCENT)
-*
-* Changed for new CERN character set/conversions
-* See below for details of change.
-* Tony Cass User Support CERN/DD 5th December 1989
-*
-*STANDARD CERN ASCII TO EBCDIC CONVERSION TABLE OBTAINED FROM
-*ROB WATTS ON APRIL 28TH 1981
-*
-* CODE 00,&OPT,00,N8 . NULL
-* CODE 01,&OPT,01,N8 . SOH
-* CODE 02,&OPT,02,N8 . STX
-* CODE 03,&OPT,03,N8 . ETX
-* CODE 04,&OPT,37,N8 . EOT
-* CODE 05,&OPT,2D,N8 . ENQ
-* CODE 06,&OPT,2E,N8 . ACK
-* CODE 07,&OPT,2F,N8 . BEL
-* CODE 08,&OPT,16,N8 . BACKSPACE
-* CODE 09,&OPT,05,N8 . HT
-* CODE 0A,&OPT,25,N8 . LF
-* CODE 0B,&OPT,0B,N8 . VT
-* CODE 0C,&OPT,0C,N8 . FF
-* CODE 0D,&OPT,0D,N8 . CR
-* CODE 0E,&OPT,0E,N8 . SO
-* CODE 0F,&OPT,0F,N8 . SI
-* CODE 10,&OPT,10,N8 . DLE
-* CODE 11,&OPT,11,N8 . DC1
-* CODE 12,&OPT,12,N8 . DC2
-* CODE 13,&OPT,13,N8 . DC3
-* CODE 14,&OPT,3C,N8 . DC4
-* CODE 15,&OPT,3D,N8 . NAK
-* CODE 16,&OPT,32,N8 . SYN
-* CODE 17,&OPT,26,N8 . ETB
-* CODE 18,&OPT,18,N8 . CAN
-* CODE 19,&OPT,19,N8 . EM
-* CODE 1A,&OPT,3F,N8 . SUB
-* CODE 1B,&OPT,27,N8 . ESC
-* CODE 1C,&OPT,1C,N8 . FS
-* CODE 1D,&OPT,1D,N8 . GS
-* CODE 1E,&OPT,1E,N8 . RS
-* CODE 1F,&OPT,1F,N8 . US
-* CODE 20,&OPT,40,N8 . SPACE
-* CODE 21,&OPT,5A,N8 . EXCLAMATION MARK
-* CODE 22,&OPT,7F,N8 . DOUBLE QUOTE
-* CODE 23,&OPT,7B,N8 . HASH SIGN
-* CODE 24,&OPT,5B,N8 . DOLLAR SIGN
-* CODE 25,&OPT,6C,N8 . PERCENT
-* CODE 26,&OPT,50,N8 . AMPERSAND
-* CODE 27,&OPT,7D,N8 . SINGLE QUOTE
-* CODE 28,&OPT,4D,N8 . LEFT BRACKET
-* CODE 29,&OPT,5D,N8 . RIGHT BRACKET
-* CODE 2A,&OPT,5C,N8 . ASTERISK
-* CODE 2B,&OPT,4E,N8 . PLUS
-* CODE 2C,&OPT,6B,N8 . COMMA
-* CODE 2D,&OPT,60,N8 . MINUS
-* CODE 2E,&OPT,4B,N8 . PERIOD (FULL STOP)
-* CODE 2F,&OPT,61,N8 . SLASH
-* CODE 30,&OPT,F0,N8 . ZERO
-* CODE 31,&OPT,F1,N8 . ONE
-* CODE 32,&OPT,F2,N8 . TWO
-* CODE 33,&OPT,F3,N8 . THREE
-* CODE 34,&OPT,F4,N8 . FOUR
-* CODE 35,&OPT,F5,N8 . FIVE
-* CODE 36,&OPT,F6,N8 . SIX
-* CODE 37,&OPT,F7,N8 . SEVEN
-* CODE 38,&OPT,F8,N8 . EIGHT
-* CODE 39,&OPT,F9,N8 . NINE
-* CODE 3A,&OPT,7A,N8 . COLON
-* CODE 3B,&OPT,5E,N8 . SEMI-COLON
-* CODE 3C,&OPT,4C,N8 . LESS THAN
-* CODE 3D,&OPT,7E,N8 . EQUALS
-* CODE 3E,&OPT,6E,N8 . GREATER THAN
-* CODE 3F,&OPT,6F,N8 . QUESTION MARK
-* CODE 40,&OPT,7C,N8 . AT SIGN
-* CODE 41,&OPT,C1,N8 . UPPER A
-* CODE 42,&OPT,C2,N8 . UPPER B
-* CODE 43,&OPT,C3,N8 . UPPER C
-* CODE 44,&OPT,C4,N8 . UPPER D
-* CODE 45,&OPT,C5,N8 . UPPER E
-* CODE 46,&OPT,C6,N8 . UPPER F
-* CODE 47,&OPT,C7,N8 . UPPER G
-* CODE 48,&OPT,C8,N8 . UPPER H
-* CODE 49,&OPT,C9,N8 . UPPER I
-* CODE 4A,&OPT,D1,N8 . UPPER J
-* CODE 4B,&OPT,D2,N8 . UPPER K
-* CODE 4C,&OPT,D3,N8 . UPPER L
-* CODE 4D,&OPT,D4,N8 . UPPER M
-* CODE 4E,&OPT,D5,N8 . UPPER N
-* CODE 4F,&OPT,D6,N8 . UPPER O
-* CODE 50,&OPT,D7,N8 . UPPER P
-* CODE 51,&OPT,D8,N8 . UPPER Q
-* CODE 52,&OPT,D9,N8 . UPPER R
-* CODE 53,&OPT,E2,N8 . UPPER S
-* CODE 54,&OPT,E3,N8 . UPPER T
-* CODE 55,&OPT,E4,N8 . UPPER U
-* CODE 56,&OPT,E5,N8 . UPPER V
-* CODE 57,&OPT,E6,N8 . UPPER W
-* CODE 58,&OPT,E7,N8 . UPPER X
-* CODE 59,&OPT,E8,N8 . UPPER Y
-* CODE 5A,&OPT,E9,N8 . UPPER Z
-* CODE 5B,&OPT,AD,N8 . LEFT SQUARE BRACKET
-* CODE 5C,&OPT,E0,N8 . BACK SLASH
-* CODE 5D,&OPT,BD,N8 . RIGHT SQUARE BRACKET
-* CODE 5E,&OPT,6A,N8 . CIRCUMFLEX
-* CODE 5F,&OPT,6D,N8 . UNDERSCORE
-* CODE 60,&OPT,79,N8 . GRAVE ACCENT
-* CODE 61,&OPT,81,N8 . LOWER A
-* CODE 62,&OPT,82,N8 . LOWER B
-* CODE 63,&OPT,83,N8 . LOWER C
-* CODE 64,&OPT,84,N8 . LOWER D
-* CODE 65,&OPT,85,N8 . LOWER E
-* CODE 66,&OPT,86,N8 . LOWER F
-* CODE 67,&OPT,87,N8 . LOWER G
-* CODE 68,&OPT,88,N8 . LOWER H
-* CODE 69,&OPT,89,N8 . LOWER I
-* CODE 6A,&OPT,91,N8 . LOWER J
-* CODE 6B,&OPT,92,N8 . LOWER K
-* CODE 6C,&OPT,93,N8 . LOWER L
-* CODE 6D,&OPT,94,N8 . LOWER M
-* CODE 6E,&OPT,95,N8 . LOWER N
-* CODE 6F,&OPT,96,N8 . LOWER O
-* CODE 70,&OPT,97,N8 . LOWER P
-* CODE 71,&OPT,98,N8 . LOWER Q
-* CODE 72,&OPT,99,N8 . LOWER R
-* CODE 73,&OPT,A2,N8 . LOWER S
-* CODE 74,&OPT,A3,N8 . LOWER T
-* CODE 75,&OPT,A4,N8 . LOWER U
-* CODE 76,&OPT,A5,N8 . LOWER V
-* CODE 77,&OPT,A6,N8 . LOWER W
-* CODE 78,&OPT,A7,N8 . LOWER X
-* CODE 79,&OPT,A8,N8 . LOWER Y
-* CODE 7A,&OPT,A9,N8 . LOWER Z
-* CODE 7B,&OPT,8B,N8 . LEFT BRACE
-* CODE 7C,&OPT,4F,N8 . VERTICAL BAR
-* CODE 7D,&OPT,9B,N8 . RIGHT BRACE
-* CODE 7E,&OPT,5F,N8 . LOGICAL NOT TO TILDE
-* CODE 7F,&OPT,07,N8 . DEL (RUBOUT)
-*
- SPACE
-TNT$A0E0 DC X'00010203372D2E2F1605250B0C0D0E0F'
- DC X'101112133C3D322618193F271C1D1E1F'
- DC X'405A7F7B5B6C507D4D5D5C4E6B604B61'
- DC X'F0F1F2F3F4F5F6F7F8F97A5E4C7E6E6F'
- DC X'7CC1C2C3C4C5C6C7C8C9D1D2D3D4D5D6'
- DC X'D7D8D9E2E3E4E5E6E7E8E9ADE0BD6A6D'
- DC X'79818283848586878889919293949596'
- DC X'979899A2A3A4A5A6A7A8A98B4F9B5F07'
- DC X'7B7B7B7B7B7B7B7B7B7B7B7B7B7B7B7B'
- DC X'7B7B7B7B7B7B7B7B7B7B7B7B7B7B7B7B'
- DC X'7B7B7B7B7B7B7B7B7B7B7B7B7B7B7B7B'
- DC X'7B7B7B7B7B7B7B7B7B7B7B7B7B7B7B7B'
- DC X'7B7B7B7B7B7B7B7B7B7B7B7B7B7B7B7B'
- DC X'7B7B7B7B7B7B7B7B7B7B7B7B7B7B7B7B'
- DC X'7B7B7B7B7B7B7B7B7B7B7B7B7B7B7B7B'
- DC X'7B7B7B7B7B7B7B7B7B7B7B7B7B7B7B7B'
- ORG TNT$A0E0+X'5E' TNT: Map ASCII caret/circumflex
- DC X'5F' to EBCDIC logical NOT
- ORG TNT$A0E0+X'7B' TNT: Map ASCII left curly bracket
- DC X'C0' to new CERN code
- ORG TNT$A0E0+X'7D' TNT: Map ASCII right curly bracket
- DC X'D0' to new CERN code
- ORG TNT$A0E0+X'7E' TNT: Map ASCII tilde
- DC X'A1' to EBCDIC tilde
- ORG , TNT: Reset Location counter
- SPACE
- MEND
-XZATOE CSECT
-#endif
-#if defined(CERNLIB_QMIBMXA)
-XZATOE AMODE ANY
-XZATOE RMODE ANY
-#endif
-#if defined(CERNLIB_IBM)
-*
-* CALL XZATOE(AREA,N)
-* TRANSLATES N BYTES IN AREA
-*
- B 12(15) BRANCH PAST NAME
- DC X'07',CL7'XZATOE '
-*
- STM 14,12,12(13)
- BALR 12,0
- USING *,12
- B START
-TAB A0E0
-START L 2,0(1) ADDRESS OF AREA
- L 3,4(1) ADDRESS OF N
- L 3,0(3) VALUE OF N
- LA 4,256(0) SET UP 256
-LOOP SR 3,4 SEE IF MORE THAN 256 LEFT
- BC 13,FINAL
- TR 0(256,2),TAB TRANSLATE 256 BYTE AT A TIME
- LA 2,256(2)
- B LOOP
-FINAL AR 3,4
- BC 8,RETURN IF ZERO LEFT RETURN
- BCTR 3,0
- EX 3,TRA TRANSLATE THE REST
-RETURN LM 2,12,28(13) RESTORE REGISTERS
-** MVI 12(13),X'FF'
- BR 14
-TRA TR 0(,2),TAB
-*
- END
-#endif
-#endif
diff --git a/src/packlib/cspack/xz/xzcd.F b/src/packlib/cspack/xz/xzcd.F
deleted file mode 100644
index aff2e72..0000000
--- a/src/packlib/cspack/xz/xzcd.F
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: xzcd.F,v 1.1.1.1 1996/03/08 15:44:29 mclareni Exp $
-*
-* $Log: xzcd.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:29 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE XZCD(PATH,IRC)
-#include "cspack/czsock.inc"
-#include "cspack/hcmail.inc"
-#include "cspack/quest.inc"
- CHARACTER*(*) PATH
-*
- IRC = 0
- LPATH = LENOCC(PATH)
-*
- CHMAIL = 'XZIO :CD '//PATH(1:LPATH)
- CALL CZPUTA(CHMAIL,ISTAT)
-#include "cspack/czmess.inc"
- 99 END
-
diff --git a/src/packlib/cspack/xz/xzclos.F b/src/packlib/cspack/xz/xzclos.F
deleted file mode 100644
index 9046af8..0000000
--- a/src/packlib/cspack/xz/xzclos.F
+++ /dev/null
@@ -1,39 +0,0 @@
-*
-* $Id: xzclos.F,v 1.1.1.1 1996/03/08 15:44:29 mclareni Exp $
-*
-* $Log: xzclos.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:29 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE XZCLOS(LUN,CHOPT,IRC)
-#include "cspack/czsock.inc"
-#include "cspack/hcmail.inc"
-#include "cspack/quest.inc"
- CHARACTER*1 CHOPTE
-#include "cspack/czopts.inc"
-*
-* Close remote unit. CHOPT=D -> STATUS='DELETE'
-*
- IRC = 0
- IF(IOPTC.NE.0) GOTO 20
- CALL CZSWAP(' ',LUN,ISTAT)
- CHOPTE = ' '
- IF(IOPTD.NE.0) CHOPTE = 'D'
- WRITE(CHMAIL,9001) LUN,CHOPTE
-9001 FORMAT('XZIO :CLOS',I3,'/',A8,'/')
- CALL CZPUTA(CHMAIL,ISTAT)
-#include "cspack/czmess.inc"
-*
-* Clear node, user name and socket numbers
-*
-20 CONTINUE
- CHNODE(LUN) = ' '
- CHUSER(LUN) = ' '
- JSKIN(LUN) = 0
- JSKOUT(LUN) = 0
- CALL CZSWAP(' ',0,ISTAT)
-
- END
-
diff --git a/src/packlib/cspack/xz/xzconv.F b/src/packlib/cspack/xz/xzconv.F
deleted file mode 100644
index 0274e88..0000000
--- a/src/packlib/cspack/xz/xzconv.F
+++ /dev/null
@@ -1,48 +0,0 @@
-*
-* $Id: xzconv.F,v 1.1.1.1 1996/03/08 15:44:29 mclareni Exp $
-*
-* $Log: xzconv.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:29 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE XZCONV(LUNIN,LUNOUT,BUFFER,NWORDS,CHOPT,IRC)
-
- DIMENSION BUFFER(NWORDS)
-
-#include "cspack/czunit.inc"
-#include "cspack/czopts.inc"
-
- IF(IOPTC.NE.0) THEN
-
- NREC = 0
-10 CONTINUE
- NREC = NREC + 1
- READ(LUNIN,ERR=99,END=99) BUFFER
- WRITE(LUNOUT,REC=NREC) BUFFER
- GOTO 10
-
- ELSEIF(IOPTF.NE.0) THEN
-
- NREC = 0
-20 CONTINUE
- NREC = NREC + 1
- READ(LUNIN,REC=NREC,ERR=99) BUFFER
- WRITE(LUNOUT) BUFFER
- GOTO 20
-
- ELSE
-*
-* Invalid mode
-*
- IRC = 99
-
- ENDIF
-
-99 CONTINUE
- IF(NREC.GT.0) NREC = NREC - 1
- IF(IDEBXZ.GE.0) PRINT *,'XZCONV. converted ',NREC,
- + ' records'
-
- END
diff --git a/src/packlib/cspack/xz/xzctof.F b/src/packlib/cspack/xz/xzctof.F
deleted file mode 100644
index 5ee74ee..0000000
--- a/src/packlib/cspack/xz/xzctof.F
+++ /dev/null
@@ -1,152 +0,0 @@
-*
-* $Id: xzctof.F,v 1.5 1998/09/25 09:24:32 mclareni Exp $
-*
-* $Log: xzctof.F,v $
-* Revision 1.5 1998/09/25 09:24:32 mclareni
-* Modifications for the Mklinux port flagged by CERNLIB_PPC
-*
-* Revision 1.4 1997/10/23 13:26:23 mclareni
-* NT mods
-*
-* Revision 1.3 1997/09/02 08:46:25 mclareni
-* WINNT mods, mostly cpp defines
-*
-* Revision 1.2 1997/01/17 08:56:15 gunter
-* call vxinvb for linux too.
-*
-* Revision 1.1.1.1 1996/03/08 15:44:30 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE XZCTOF(CHFIN,CHFOUT,LRECL,CHOPT,IRC)
-
- CHARACTER*(*) CHFIN,CHFOUT
- CHARACTER*4 CHOPI,CHOPO
-#include "cspack/hcmail.inc"
-#include "cspack/czunit.inc"
-#include "cspack/czsock.inc"
-#include "cspack/zmach.inc"
-#include "cspack/pawc.inc"
- DIMENSION IQ(2),Q(2),LQ(8000)
- EQUIVALENCE (LQ(1),LMAIN),(IQ(1),LQ(9)),(Q(1),IQ(1))
- DIMENSION ITEST(5)
- DIMENSION BUFFER(8192)
-#if defined(CERNLIB_IPSC)
- DATA IPATT/'0123CDEF'X/
-#elif defined(CERNLIB_WINNT)
- DATA IPATT/Z'0123CDEF'/
-#elif defined(CERNLIB_DECS) || defined(CERNLIB_LINUX)
- DATA IPATT/X'0123CDEF'/
-#elif defined(CERNLIB_VAX)
- DATA IPATT/Z0123CDEF/
-#endif
-#include "cspack/quest.inc"
-#include "cspack/czopts.inc"
-
- IRC = 0
- LCHFI = LENOCC(CHFIN)
- LCHFO = LENOCC(CHFOUT)
- LCHOPT = LENOCC(CHOPT)
-
- IF(IDEBXZ.GE.1) PRINT *,'XZCTOF. enter for ',
- + CHFIN(1:LCHFI),' ',CHFOUT(1:LCHFO),' ',
- + LRECL,' ',CHOPT
-
- IF(LCHFI.EQ.0.OR.LCHFO.EQ.0) THEN
- IF(IDEBXZ.GE.0) PRINT *,'XZCTOF. error - input or ',
- + 'output file name missing'
- IRC = -1
- GOTO 99
- ENDIF
-
- CHOPI = 'ID'
- IF(IOPTC.NE.0) CHOPI = 'CID'
- CHOPO = 'ON'
- IF(IOPTC.NE.0) CHOPO = 'CON'
-
- IF(IOPTR.NE.0) THEN
- LCHOPO = LENOCC(CHOPO)
- CHOPO(LCHOPO:LCHOPO) = ' '
- ENDIF
-
- IF(LRECL.LE.0) THEN
- IF(IOPTX.EQ.0) THEN
- IF(IDEBXZ.GE.-3) PRINT *,'XZCTOF. input record length ',
- + 'must be specified for non-Zebra exchange format files'
- IRC = -1
- RETURN
- ELSE
-*
-* Get record length from file
-*
- JRECL = 80
- IF(IDEBXZ.GE.3) PRINT *,'XZCTOF. call SZOPEN for ',
- + CHFIN(1:LCHFI),JRECL,CHOPI
- CALL SZOPEN(LUNXZI,CHFIN(1:LCHFI),JRECL,CHOPI,IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBXZ.GE.-3) PRINT *,'XZCTOF. error opening ',
- + 'input file, IRC = ',IRC
- GOTO 99
- ENDIF
-
- READ(LUNXZI,REC=1,IOSTAT=ISTAT) ITEST
- IF(ISTAT.NE.0) THEN
- PRINT *,'XZCTOF. error ',ISTAT,' reading input file'
- CLOSE(LUNXZI)
- GOTO 99
- ENDIF
-
-#if defined(CERNLIB_VAX)||defined(CERNLIB_DECS) || (defined(CERNLIB_LINUX) && !defined(CERNLIB_PPC)) || defined(CERNLIB_WINNT)
- IF(ITEST(1).NE.IPATT) CALL VXINVB(ITEST(5),1)
-#endif
-#if !defined(CERNLIB_CRAY)
- JRECL = JBYT(ITEST(5),1,24) * 4
-#endif
-#if defined(CERNLIB_CRAY)
- JRECL = JBYT(ITEST(3),1,24) * 4
-#endif
-*
-* Check if JRECL is reasonable
-*
- IF(JRECL.GT.32756.OR.JRECL.LT.0) THEN
- PRINT *,'XZCTOF. cannot determine record length of ',
- + 'input file. How was this file created?'
- IRC = JRECL
- CLOSE(LUNXZI)
- GOTO 99
- ENDIF
-
- IF(IDEBXZ.GE.2) PRINT *,'XZCTOF. record length of input ',
- + 'file is ',JRECL,' bytes'
-*
-* Close input file
-*
- CLOSE(LUNXZI)
- ENDIF
- ELSE
- JRECL = LRECL
- ENDIF
-
- CALL SZOPEN(LUNXZI,CHFIN(1:LCHFI),JRECL,CHOPI,IRC)
-
- IF(IDEBXZ.GE.3) PRINT *,'XZCTOF. call SZOPEN for ',
- + CHFOUT(1:LCHFO),JRECL,CHOPO
- CALL SZOPEN(LUNXZO,CHFOUT(1:LCHFO),JRECL,CHOPO,IRC)
-
- IF(IRC.EQ.28) THEN
- IF(IDEBXZ.GE.0) PRINT *,'XZCTOF. file ',CHFOUT(1:LCHFO),
- + ' already exists - specify R option to replace'
- CLOSE(LUNXZI)
- RETURN
- ENDIF
-
- NWORDS = JRECL / IQCHAW
-
- CALL XZCONV(LUNXZI,LUNXZO,BUFFER,NWORDS,'F',IRC)
-
- CLOSE(LUNXZI)
- CLOSE(LUNXZO)
-
-99 CONTINUE
- END
diff --git a/src/packlib/cspack/xz/xzetoa.s b/src/packlib/cspack/xz/xzetoa.s
deleted file mode 100644
index c25fe7f..0000000
--- a/src/packlib/cspack/xz/xzetoa.s
+++ /dev/null
@@ -1,102 +0,0 @@
-*
-* $Id: xzetoa.s,v 1.1.1.1 1996/03/08 15:44:30 mclareni Exp $
-*
-* $Log: xzetoa.s,v $
-* Revision 1.1.1.1 1996/03/08 15:44:30 mclareni
-* Cspack
-*
-*
-#if defined(CERNLIB_IBM)
-#if defined(CERNLIB_IBM)
- MACRO
-&L E0A0
- SPACE
-&L DS 0C BYTE ALIGNMENT ONLY
- SPACE
-* THIS TRANSLATE TABLE CONVERTS CERN EBCDIC TO CERN ASCII
-*
-* IT IS BASED ON THE RUTHERFORD TABLE WITH THE FOLLOWING
-* MODIFICATIONS:-
-* EBCDIC 6A IS CONVERTED TO ASCII 5E (CIRCUMFLEX)
-* EBCDIC 71 IS CONSIDERED ILLEGAL
-* ILLEGAL CHARACTERS ARE CONVERTED TO 23 (HASH) RATHER THAN
-* 25 (PERCENT)
-*
-* Changed for new CERN character set/conversions
-* See below for details of change.
-* Tony Cass User Support CERN/DD 5th December 1989
-*
- SPACE
-TNT$E0A0 DC X'000102032309237F2323230B0C0D0E0F'
- DC X'1011121323230823181923231C1D1E1F'
- DC X'23232323230A171B2323232323050607'
- DC X'2323162323232304232323231415231A'
- DC X'20232323232323232323232E3C282B7C'
- DC X'2623232323232323232321242A293B7E'
- DC X'2D2F23232323232323235E2C255F3E3F'
- DC X'232323232323232323603A2340273D22'
- DC X'23616263646566676869237B23232323'
- DC X'236A6B6C6D6E6F707172237D23232323'
- DC X'2323737475767778797A2323235B2323'
- DC X'232323232323232323232323235D2323'
- DC X'23414243444546474849232323232323'
- DC X'234A4B4C4D4E4F505152232323232323'
- DC X'5C23535455565758595A232323232323'
- DC X'30313233343536373839232323232323'
- ORG TNT$E0A0+X'5F' TNT: Map EBCDIC Logical NOT
- DC X'5E' to ASCII caret/circumflex
- ORG TNT$E0A0+X'6A' TNT: Map EBCDIC Split bar
- DC X'23' to ASCII default
- ORG TNT$E0A0+X'8B' TNT: Old CERN curly bracket (left)
- DC X'23' to ASCII default
- ORG TNT$E0A0+X'9B' TNT: Old CERN curly bracket (right)
- DC X'23' to ASCII default
- ORG TNT$E0A0+X'A1' TNT: Map EBCDIC tilde
- DC X'7E' to ASCII tilde
- ORG TNT$E0A0+X'C0' TNT: New CERN curly bracket (left)
- DC X'7B' to ASCII
- ORG TNT$E0A0+X'D0' TNT: New CERN curly bracket (right)
- DC X'7D' to ASCII
- ORG , TNT: Reset Location counter
- SPACE
- MEND
-XZETOA CSECT
-#endif
-#if defined(CERNLIB_QMIBMXA)
-XZETOA AMODE ANY
-XZETOA RMODE ANY
-#endif
-#if defined(CERNLIB_IBM)
-*
-* CALL XZETOA(AREA,N)
-* TRANSLATES N BYTES IN AREA
-*
- B 12(15) BRANCH PAST NAME
- DC X'07',CL7'XZETOA '
-*
- STM 14,12,12(13)
- BALR 12,0
- USING *,12
- B START
-TAB E0A0
-START L 2,0(1) ADDRESS OF AREA
- L 3,4(1) ADDRESS OF N
- L 3,0(3) VALUE OF N
- LA 4,256(0) SET UP 256
-LOOP SR 3,4 SEE IF MORE THAN 256 LEFT
- BC 13,FINAL
- TR 0(256,2),TAB TRANSLATE 256 BYTE AT A TIME
- LA 2,256(2)
- B LOOP
-FINAL AR 3,4
- BC 8,RETURN IF ZERO LEFT RETURN
- BCTR 3,0
- EX 3,TRA TRANSLATE THE REST
-RETURN LM 2,12,28(13) RESTORE REGISTERS
-** MVI 12(13),X'FF'
- BR 14
-TRA TR 0(,2),TAB
-*
- END
-#endif
-#endif
diff --git a/src/packlib/cspack/xz/xzfinf.F b/src/packlib/cspack/xz/xzfinf.F
deleted file mode 100644
index 493905c..0000000
--- a/src/packlib/cspack/xz/xzfinf.F
+++ /dev/null
@@ -1,163 +0,0 @@
-*
-* $Id: xzfinf.F,v 1.1.1.1 1996/03/08 15:44:30 mclareni Exp $
-*
-* $Log: xzfinf.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:30 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
-#if defined(CERNLIB_VAXVMS)
- integer function xzfinf(fab,rab,lun)
-*-- Author : Jamie Shiers 02/08/91
-#include "cspack/vmsinf.inc"
- character*30 spaces
- include '($fabdef)'
- include '($rabdef)'
- include '($xabdef)'
- include '($xabdatdef)'
- include '($xabprodef)'
-
- record /fabdef/ fab
- record /rabdef/ rab
-
- structure /xabdat/
- byte xab$b_cod
- byte xab$b_bln
- integer*2 %fill
- integer*4 xab$l_nxt
- integer*2 xab$w_rvn
- integer*2 %fill
- integer*4 xab$q_rdt(2)
- integer*4 xab$q_cdt(2)
- integer*4 xab$q_edt(2)
- integer*4 xab$q_bdt(2)
- end structure
-
- structure /xabpro/
- byte xab$b_cod
- byte xab$b_bln
- integer*2 %fill
- integer*4 %fill
- integer*2 xab$w_pro
- byte xab$b_mtacc
- byte xab$b_prot_opt
- union
- map
- integer*4 xab$l_uic ! UIC CODE
- end map
- map
- integer*2 xab$w_mbm ! MEMBER CODE
- integer*2 xab$w_grp ! GROUP CODE
- end map
- end union
- union
- map
- integer*4 xab$q_prot_mode(2)
- end map
- map
- byte xab$b_prot_mode
- end map
- end union
- integer*4 xab$l_aclbuf
- integer*2 xab$w_aclsiz
- integer*2 xab$w_acllen
- integer*4 xab$l_aclctx
- integer*4 xab$l_aclsts
- integer*4 %fill
- integer*4 %fill
- integer*4 %fill
- integer*4 %fill
- integer*4 %fill
- integer*4 %fill
- integer*4 %fill
- integer*4 %fill
- integer*4 %fill
- integer*4 %fill
- integer*4 %fill
- integer*4 %fill
- end structure
-
- record /xabdat/ xab
- record /xabpro/ xab1
- integer status,lun,sys$open,sys$close,recfm
-
- xab.xab$b_cod = xab$c_dat
- xab.xab$b_bln = xab$c_datlen
- fab.fab$l_xab = %loc(xab.xab$b_cod)
- xab.xab$l_nxt = %loc(xab1.xab$b_cod)
- xab1.xab$b_cod = xab$c_pro
- xab1.xab$b_bln = xab$c_prolen
-
- status = sys$open(fab)
-*
-* Blocks allocated
-*
- iblk = fab.fab$l_alq
-*
-* Dates & times
-*
- status = sys$asctim(,revdat,xab.xab$q_rdt,)
- status = sys$asctim(,credat,xab.xab$q_cdt,)
- status = sys$asctim(,bacdat,xab.xab$q_bdt,)
- status = sys$asctim(,expdat,xab.xab$q_edt,)
-*
-* File format
-*
- chtype = ' '
- recfm = fab.fab$b_rfm
- if(recfm.eq.fab$c_fix) chtype = 'FIXED'
- if(recfm.eq.fab$c_var) chtype = 'VARIABLE'
- if(recfm.eq.fab$c_stm) chtype = 'STREAM'
- if(recfm.eq.fab$c_stmcr) chtype = 'STREAM_CR'
- if(recfm.eq.fab$c_stmlf) chtype = 'STREAM_LF'
- if(recfm.eq.fab$c_udf) chtype = 'UNDEFINED'
- if(recfm.eq.fab$c_vfc) chtype = 'VFC'
-*
-* Check file protection mask
-* Bit is set to deny access of specified type
-*
- chprot = '('
- lprot = 1
- do 10 j=0,12,4
-
- if(.not.btest(xab1.xab$w_pro,j+xab$v_noread)) then
- lprot = lprot + 1
- chprot(lprot:lprot) = 'R'
- endif
-
- if(.not.btest(xab1.xab$w_pro,j+xab$v_nowrite)) then
- lprot = lprot + 1
- chprot(lprot:lprot) = 'W'
- endif
-
- if(.not.btest(xab1.xab$w_pro,j+xab$v_noexe)) then
- lprot = lprot + 1
- chprot(lprot:lprot) = 'E'
- endif
-
- if(.not.btest(xab1.xab$w_pro,j+xab$v_nodel)) then
- lprot = lprot + 1
- chprot(lprot:lprot) = 'D'
- endif
-
- lprot = lprot + 1
- chprot(lprot:lprot) = ','
-
-10 continue
- chprot(lprot:lprot) = ')'
-*
-* UIC
-*
- write (chuic,9001) xab1.xab$w_grp,xab1.xab$w_mbm
-9001 format('[',O5,',',O5,']')
-
- chuic = spaces(chuic,0)
-
- status = sys$close(fab)
-
- xzfinf = 1
-
- end
-
-#endif
diff --git a/src/packlib/cspack/xz/xzftoc.F b/src/packlib/cspack/xz/xzftoc.F
deleted file mode 100644
index c1e3211..0000000
--- a/src/packlib/cspack/xz/xzftoc.F
+++ /dev/null
@@ -1,153 +0,0 @@
-*
-* $Id: xzftoc.F,v 1.5 1998/09/25 09:24:57 mclareni Exp $
-*
-* $Log: xzftoc.F,v $
-* Revision 1.5 1998/09/25 09:24:57 mclareni
-* Modifications for the Mklinux port flagged by CERNLIB_PPC
-*
-* Revision 1.4 1997/10/23 13:26:24 mclareni
-* NT mods
-*
-* Revision 1.3 1997/09/02 08:46:26 mclareni
-* WINNT mods, mostly cpp defines
-*
-* Revision 1.2 1997/01/17 08:56:15 gunter
-* call vxinvb for linux too.
-*
-* Revision 1.1.1.1 1996/03/08 15:44:30 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE XZFTOC(CHFIN,CHFOUT,LRECL,CHOPT,IRC)
-
- CHARACTER*(*) CHFIN,CHFOUT
- CHARACTER*4 CHOPI,CHOPO
-#include "cspack/hcmail.inc"
-#include "cspack/czunit.inc"
-#include "cspack/czsock.inc"
-#include "cspack/zmach.inc"
-#include "cspack/pawc.inc"
- DIMENSION IQ(2),Q(2),LQ(8000)
- EQUIVALENCE (LQ(1),LMAIN),(IQ(1),LQ(9)),(Q(1),IQ(1))
- DIMENSION ITEST(5)
- DIMENSION BUFFER(8192)
-#if defined(CERNLIB_IPSC)
- DATA IPATT/'0123CDEF'X/
-#elif defined(CERNLIB_WINNT)
- DATA IPATT/Z'0123CDEF'/
-#elif defined(CERNLIB_DECS) || defined(CERNLIB_LINUX)
- DATA IPATT/X'0123CDEF'/
-#elif defined(CERNLIB_VAX)
- DATA IPATT/Z0123CDEF/
-#endif
-#include "cspack/quest.inc"
-#include "cspack/czopts.inc"
-
- IRC = 0
-
- LCHFI = LENOCC(CHFIN)
- LCHFO = LENOCC(CHFOUT)
- LCHOPT = LENOCC(CHOPT)
-
- IF(IDEBXZ.GE.1) PRINT *,'XZFTOC. enter for ',
- + CHFIN(1:LCHFI),' ',CHFOUT(1:LCHFO),' ',
- + LRECL,' ',CHOPT
-
- IF(LCHFI.EQ.0.OR.LCHFO.EQ.0) THEN
- IF(IDEBXZ.GE.0) PRINT *,'XZFTOC. error - input or ',
- + 'output file name missing'
- IRC = -1
- GOTO 99
- ENDIF
-
- CHOPI = 'I'
- IF(IOPTC.NE.0) CHOPI = 'CI'
- CHOPO = 'DON'
- IF(IOPTC.NE.0) CHOPO = 'CDON'
-
- IF(IOPTR.NE.0) THEN
- LCHOPO = LENOCC(CHOPO)
- CHOPO(LCHOPO:LCHOPO) = ' '
- ENDIF
-
- IF(LRECL.LE.0) THEN
- IF(IOPTX.EQ.0) THEN
- IF(IDEBXZ.GE.-3) PRINT *,'XZFTOC. input record length ',
- + 'must be specified for non-Zebra exchange format files'
- IRC = -1
- RETURN
- ELSE
-*
-* Get record length from file
-*
- JRECL = 80
- IF(IDEBXZ.GE.3) PRINT *,'XZFTOC. call SZOPEN for ',
- + CHFIN(1:LCHFI),JRECL,CHOPI
- CALL SZOPEN(LUNXZI,CHFIN(1:LCHFI),JRECL,CHOPI,IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBXZ.GE.-3) PRINT *,'XZFTOC. error opening ',
- + 'input file, IRC = ',IRC
- GOTO 99
- ENDIF
-
- READ(LUNXZI,IOSTAT=ISTAT) ITEST
- IF(ISTAT.NE.0) THEN
- PRINT *,'XZFTOC. error ',ISTAT,' reading input file'
- CLOSE(LUNXZI)
- GOTO 99
- ENDIF
-
-#if defined(CERNLIB_VAX)||defined(CERNLIB_DECS) || (defined(CERNLIB_LINUX) && !defined(CERNLIB_PPC)) || defined(CERNLIB_WINNT)
- IF(ITEST(1).NE.IPATT) CALL VXINVB(ITEST(5),1)
-#endif
-#if !defined(CERNLIB_CRAY)
- JRECL = JBYT(ITEST(5),1,24) * 4
-#endif
-#if defined(CERNLIB_CRAY)
- JRECL = JBYT(ITEST(3),1,24) * 4
-#endif
-*
-* Check if JRECL is reasonable
-*
- IF(JRECL.GT.32756.OR.JRECL.LT.0) THEN
- PRINT *,'XZFTOC. cannot determine record length of ',
- + 'input file. How was this file created?'
- IRC = JRECL
- CLOSE(LUNXZI)
- GOTO 99
- ENDIF
-
- IF(IDEBXZ.GE.2) PRINT *,'XZFTOC. record length of input ',
- + 'file is ',JRECL,' bytes'
-*
-* Close input file
-*
- CLOSE(LUNXZI)
- ENDIF
- ELSE
- JRECL = LRECL
- ENDIF
-
- CALL SZOPEN(LUNXZI,CHFIN(1:LCHFI),JRECL,CHOPI,IRC)
-
- IF(IDEBXZ.GE.3) PRINT *,'XZFTOC. call SZOPEN for ',
- + CHFOUT(1:LCHFO),JRECL,CHOPO
- CALL SZOPEN(LUNXZO,CHFOUT(1:LCHFO),JRECL,CHOPO,IRC)
-
- IF(IRC.EQ.28) THEN
- IF(IDEBXZ.GE.0) PRINT *,'XZFTOC. file ',CHFOUT(1:LCHFO),
- + ' already exists - specify R option to replace'
- CLOSE(LUNXZI)
- RETURN
- ENDIF
-
- NWORDS = JRECL / IQCHAW
-
- CALL XZCONV(LUNXZI,LUNXZO,BUFFER,NWORDS,'C',IRC)
-
- CLOSE(LUNXZI)
- CLOSE(LUNXZO)
-
-99 CONTINUE
- END
diff --git a/src/packlib/cspack/xz/xzfzcp.F b/src/packlib/cspack/xz/xzfzcp.F
deleted file mode 100644
index cefcc83..0000000
--- a/src/packlib/cspack/xz/xzfzcp.F
+++ /dev/null
@@ -1,335 +0,0 @@
-*
-* $Id: xzfzcp.F,v 1.5 1998/09/25 09:25:00 mclareni Exp $
-*
-* $Log: xzfzcp.F,v $
-* Revision 1.5 1998/09/25 09:25:00 mclareni
-* Modifications for the Mklinux port flagged by CERNLIB_PPC
-*
-* Revision 1.4 1997/10/23 13:26:25 mclareni
-* NT mods
-*
-* Revision 1.3 1997/09/02 08:46:26 mclareni
-* WINNT mods, mostly cpp defines
-*
-* Revision 1.2 1997/01/17 08:56:16 gunter
-* call vxinvb for linux too.
-*
-* Revision 1.1.1.1 1996/03/08 15:44:30 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE XZFZCP(CHFZIN,CHFZOU,IRECL,IFORM,ORECL,OFORM,CHOPT,IRC)
-
- CHARACTER*1 CHFZ
- CHARACTER*(*) CHFZIN,CHFZOU,IFORM,OFORM
- CHARACTER*4 CHOPE,CHOPF
- INTEGER IRECL,ORECL
-#include "cspack/hcmail.inc"
-#include "cspack/czunit.inc"
-#include "cspack/czsock.inc"
-#include "cspack/zmach.inc"
-#include "cspack/pawc.inc"
- DIMENSION IQ(2),Q(2),LQ(8000)
- EQUIVALENCE (LQ(1),LMAIN),(IQ(1),LQ(9)),(Q(1),IQ(1))
- DIMENSION IUHEAD(400)
- DIMENSION IOCR(100)
- PARAMETER (JBIAS=2)
- PARAMETER (MEGA=1024*1024)
- COMMON/FZSTAT/INFLUN,INFSTA,INFOFZ(40)
- INTEGER RRECL
- DIMENSION ITEST(5)
-#if defined(CERNLIB_IBMVM)
- CHARACTER*13 CHTIME
- CHARACTER*1 RECFM
- CHARACTER*255 CHFILE,CHTEMP
- CHARACTER*2 CHMODE
-#endif
-#if defined(CERNLIB_IPSC)
- DATA IPATT/'0123CDEF'X/
-#elif defined(CERNLIB_WINNT)
- DATA IPATT/Z'0123CDEF'/
-#elif defined(CERNLIB_DECS) || defined(CERNLIB_LINUX) || defined(CERNLIB_WINNT)
- DATA IPATT/X'0123CDEF'/
-#elif defined(CERNLIB_VAX)
- DATA IPATT/Z0123CDEF/
-#endif
-#include "cspack/quest.inc"
-#include "cspack/czopts.inc"
-
- IRC = 0
- LCHFZI = LENOCC(CHFZIN)
- LCHFZO = LENOCC(CHFZOU)
- LCHOPT = LENOCC(CHOPT)
-
- IF(IDEBXZ.GE.1) PRINT *,'XZFZCP. enter for ',
- + CHFZIN(1:LCHFZI),' ',CHFZOU(1:LCHFZO),' ',
- + IFORM,' ',OFORM,' ',CHOPT
-
- IF(LCHFZI.EQ.0.OR.LCHFZO.EQ.0) THEN
- IF(IDEBXZ.GE.0) PRINT *,'XZFZCP. error - input or ',
- + 'output file name missing'
- IRC = -1
- GOTO 99
- ENDIF
-*
-* Open input file
-*
- CHOPE = ' '
- CHOPF = 'XI'
- JRECL = 80
-
-#if defined(CERNLIB_UNIX)
- CHOPE = 'D'
- CHOPF = 'DI'
-#endif
-
- IF(INDEX(IFORM,'A').NE.0) THEN
-*
-* Alpha format?
-*
- CHOPE = 'F'
- CHOPF = 'AI'
-#if !defined(CERNLIB_UNIX)
- ELSEIF(INDEX(IFORM,'N').NE.0) THEN
- CHOPF = 'XNI'
- ELSEIF(INDEX(IFORM,'Z').NE.0) THEN
-*
-* Native file and data format?
-*
- CHOPF = 'I'
- IF(IRECL.LE.0) THEN
- IF(IDEBXZ.GE.-3) PRINT *,'XZFZCP. input record length ',
- + 'must be specified for native files'
- IRC = -1
- RETURN
- ENDIF
- JRECL = IRECL
-#endif
- ENDIF
-
- LCHOPE = LENOCC(CHOPE) + 1
- IF(IOPTC.NE.0) CHOPF(LCHOPE:LCHOPE) = 'C'
-
-#if defined(CERNLIB_IBMVM)
-*
-* Get input file information
-*
- CHTEMP = CHFZIN(1:LCHFZI)
- CALL CTRANS('.',' ',CHTEMP,1,LCHFZI)
- CALL VMQFIL(CHTEMP(1:NCHL),RECFM,LBLK,NRECS,
- + NBLOCKS,CHTIME,ISTAT,IRC)
-*
-* Get file mode
-*
- INQUIRE(FILE='/'//CHTEMP(1:LCHFZI),NAME=CHFILE)
- LCHF = LENOCC(CHFILE)
- CHMODE = CHFILE(LCHF-1:LCHF)
-*
-* OS simulation? Assume VBS...
-*
- IF(CHFILE(LCHF:LCHF).EQ.'4') THEN
- WRITE(CHFILE,9002) LUNXZI,CHTEMP(1:LCHFZI),LBLK
-9002 FORMAT('FILEDEF ',I2,' DISK ',A,
- + ' (RECFM VBS LRECL 32756 BLOCK ',I6)
- LCHF = LENOCC(CHFILE)
- CALL VMCMS(CHFILE(1:LCHF),IRC)
- IF(IDEBXZ.GE.3) PRINT *,'XZFZCP. rc from ',
- + CHFILE(1:LCHF),' = ',IRC
- OPEN(LUNXZI,STATUS='OLD',FORM='UNFORMATTED',IOSTAT=IRC)
- ELSE
- CALL SZOPEN(LUNXZI,CHFZIN(1:LCHFZI),JRECL,CHOPE,IRC)
- ENDIF
-
-#endif
-#if !defined(CERNLIB_IBMVM)
- IF(IDEBXZ.GE.3) PRINT *,'XZFZCP. call SZOPEN for ',
- + CHFZIN(1:LCHFZI),JRECL,CHOPE
- CALL SZOPEN(LUNXZI,CHFZIN(1:LCHFZI),JRECL,CHOPE,IRC)
-#endif
-*
-* For binary exchange file formats, get record length from file
-*
- IF(INDEX(IFORM,'A').EQ.0.AND.INDEX(IFORM,'Z').EQ.0) THEN
-
-#if !defined(CERNLIB_UNIX)
- READ(LUNXZI,IOSTAT=ISTAT) ITEST
- REWIND(LUNXZI)
-#endif
-#if defined(CERNLIB_UNIX)
- READ(LUNXZI,REC=1,IOSTAT=ISTAT) ITEST
-#endif
-
- IF(ISTAT.NE.0) THEN
- PRINT *,'XZFZCP. error ',ISTAT,' reading input file'
- CLOSE(LUNXZI)
- GOTO 99
- ENDIF
-
-#if defined(CERNLIB_VAX)||defined(CERNLIB_DECS) || (defined(CERNLIB_LINUX) && !defined(CERNLIB_PPC)) || defined(CERNLIB_WINNT)
- IF(ITEST(1).NE.IPATT) CALL VXINVB(ITEST(5),1)
-#endif
-#if !defined(CERNLIB_CRAY)
- JRECL = JBYT(ITEST(5),1,24) * 4
-#endif
-#if defined(CERNLIB_CRAY)
- JRECL = JBYT(ITEST(3),1,24) * 4
-#endif
-*
-* Check if JRECL is reasonable
-*
- IF(JRECL.GT.32756.OR.JRECL.LT.0) THEN
- PRINT *,'XZFZCP. cannot determine record length of ',
- + 'input file. How was this file created?'
- IRC = JRECL
- CLOSE(LUNXZI)
- GOTO 99
- ENDIF
-
- IF(IDEBXZ.GE.2) PRINT *,'XZFZCP. record length of input ',
- + 'file is ',JRECL,' bytes'
-*
-* Close and reopen file
-*
- CALL SZCLOS(LUNXZI,' ',IRC)
- IF(IDEBXZ.GE.3) PRINT *,'XZFZCP. call SZOPEN for ',
- + CHFZIN(1:LCHFZI),JRECL,CHOPE
- CALL SZOPEN(LUNXZI,CHFZIN(1:LCHFZI),JRECL,CHOPE,IRC)
-
- ENDIF
-
- IF(IDEBXZ.GE.2) PRINT *,'XZFZCP. call FZFILE for ',
- + 'JRECL = ',JRECL,' chopt = ',CHOPF
- CALL FZFILE(LUNXZI,JRECL/4,CHOPF)
- CALL FZLOGL(LUNXZI,IDEBXZ)
-
- LRECL = JRECL
-*
-* Now open the output file
-*
- CHOPE = 'ON'
- CHOPF = 'XO'
- JRECL = 80
-
-#if defined(CERNLIB_UNIX)
- CHOPE = 'DON'
- CHOPF = 'DO'
-#endif
-
- IF(INDEX(OFORM,'A').NE.0) THEN
-*
-* Alpha format?
-*
- CHOPE = 'FON'
- CHOPF = 'AO'
-#if !defined(CERNLIB_UNIX)
- ELSEIF(INDEX(OFORM,'N').NE.0) THEN
- CHOPF = 'XNO'
- ELSEIF(INDEX(OFORM,'Z').NE.0) THEN
-*
-* Native file and data format?
-*
- CHOPF = 'O'
- IF(ORECL.LE.0) THEN
- IF(IDEBXZ.GE.-3) PRINT *,'XZFZCP. output record length ',
- + 'will be taken from input file (',LRECL,')'
- JRECL = LRECL
- ENDIF
-#endif
- ENDIF
-
- LCHOPE = LENOCC(CHOPE)
- IF(IOPTR.NE.0) CHOPE(LCHOPE:LCHOPE) = ' '
- LCHOPE = LENOCC(CHOPF) + 1
- IF(IOPTC.NE.0) CHOPE(LCHOPE:LCHOPE) = 'C'
-
-#if !defined(CERNLIB_IBMVM)
- IF(IDEBXZ.GE.3) PRINT *,'XZFZCP. call SZOPEN for ',
- + CHFZOU(1:LCHFZO),JRECL,CHOPE
- CALL SZOPEN(LUNXZO,CHFZOU(1:LCHFZO),JRECL,CHOPE,IRC)
-#endif
-#if defined(CERNLIB_IBMVM)
- IF(INDEX(OFORM,'Z').EQ.0) THEN
- IF(IDEBXZ.GE.3) PRINT *,'XZFZCP. call SZOPEN for ',
- + CHFZOU(1:LCHFZO),JRECL,CHOPE
- CALL SZOPEN(LUNXZO,CHFZOU(1:LCHFZO),JRECL,CHOPE,IRC)
- ELSE
- CHTEMP = CHFZOU(1:LCHFZO)
- CALL CTRANS('.',' ',CHTEMP,1,LCHFOU)
- WRITE(CHFILE,9002) LUNXZI,CHTEMP(1:LCHFZI),LBLK
- LCHF = LENOCC(CHFILE)
-
- IF(INDEX(CHFILE(1:LCHF),' ').EQ.
- + INDEXB(CHFILE(1:LCHF),' ')) THEN
- LCHF = LCHF + 3
- CHFILE(LCHF-2:LCHF-2) = ' '
- CHFILE(LCHF-1:LCHF) = CHMODE
- CHFILE(LCHF:LCHF) = '4'
- ENDIF
-
- CALL VMCMS(CHFILE(1:LCHF),IRC)
- IF(IDEBXZ.GE.3) PRINT *,'XZFZCP. rc from ',
- + CHFILE(1:LCHF),' = ',IRC
- OPEN(LUNXZI,STATUS='NEW',FORM='UNFORMATTED',IOSTAT=IRC)
- ENDIF
-#endif
-#if defined(CERNLIB_IBMVM)
-#endif
-
- IF(IRC.EQ.28) THEN
- IF(IDEBXZ.GE.0) PRINT *,'XZFZCP. file ',CHFZOU(1:LCHFZO),
- + ' already exists - specify R option to replace'
- CALL FZENDI(LUNXZI,'TE')
- CLOSE(LUNXZI)
- RETURN
- ENDIF
-
- IF(IDEBXZ.GE.2) PRINT *,'XZFZCP. call FZFILE for ',
- + 'JRECL = ',JRECL,' chopt = ',CHOPF
-
- CALL FZFILE(LUNXZO,JRECL/4,CHOPF)
- CALL FZLOGL(LUNXZO,IDEBXZ)
-*
-* Perform the copy
-*
- 1 CONTINUE
- NUH = 400
- CALL FZIN(LUNXZI,IXDIV,LSUP,JBIAS,' ',NUH,IUHEAD)
- IF((IQUEST(1).LT.0).OR.(IQUEST(1).GE.4)) GOTO 2
- IF(IQUEST(1).EQ.0) IEVENT = IQUEST(11)
-*
-* start of run
-*
- IF(IQUEST(1).EQ.1) THEN
-* IF(IOPTR.NE.0) GOTO 1
- CALL FZRUN(LUNXZO,IQUEST(11),NUH,IUHEAD)
- GOTO 1
-*
-* end of run
-*
- ELSEIF(IQUEST(1).EQ.2) THEN
-* IF(IOPTR.NE.0) GOTO 1
- CALL FZRUN(LUNXZO,-1,NUH,IUHEAD)
- GOTO 1
-*
-* ZEBRA eof
-*
- ELSEIF(IQUEST(1).EQ.3) THEN
- ENDIF
-
- CALL UCOPY(IQUEST(21),IOCR,MIN(IQUEST(20),100))
- CHFZ = 'L'
- IF(IQUEST(14).EQ.0) CHFZ = 'Z'
- CALL FZOUT(LUNXZO,IXDIV,LSUP,IEVENT,CHFZ,IOCR,NUH,IUHEAD)
- GOTO 1
- 2 CONTINUE
-*
-* Close input and output files
-*
- CALL FZENDI(LUNXZI,'TE')
- CALL FZENDO(LUNXZO,'TE')
- CALL SZCLOS(LUNXZI,' ',IRC)
- CALL SZCLOS(LUNXZO,' ',IRC)
-
-99 CONTINUE
- END
diff --git a/src/packlib/cspack/xz/xzgeta.F b/src/packlib/cspack/xz/xzgeta.F
deleted file mode 100644
index f1deadc..0000000
--- a/src/packlib/cspack/xz/xzgeta.F
+++ /dev/null
@@ -1,210 +0,0 @@
-*
-* $Id: xzgeta.F,v 1.1.1.1 1996/03/08 15:44:30 mclareni Exp $
-*
-* $Log: xzgeta.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:30 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE XZGETA(LOCAL,REMOTE,CHOPT,IRC)
-*
-* Transfer the text file LOCAL to the remote node as REMOTE
-* CHOPT: V - remote file is created with V format (IBM)
-* S - statistics on the file transfer are printed
-* A - local file has already been opened
-*
-#include "cspack/czunit.inc"
-#include "cspack/hcmail.inc"
-#include "cspack/czsock.inc"
-#include "cspack/czbuff.inc"
-#include "cspack/quest.inc"
- CHARACTER*(*) REMOTE,LOCAL
-#if defined(CERNLIB_IBM)
- CHARACTER*80 CHFILE
-#endif
- CHARACTER*8 CHOPTT
- CHARACTER*8 DELTIM
- CHARACTER*3077 CHLEN
-* CHARACTER*2053 CHLEN
- INTEGER SRECVSTR
- DIMENSION NCC(1024)
-#include "cspack/czopts.inc"
-*
-#include "cspack/czopen.inc"
-*
-* Send message to remote machine to check if file exists
-* and get file parameters
-*
- IRC = 0
-
- NCHR=LENOCC(REMOTE)
- NCHO=LENOCC(CHOPT)
- CHOPTT = CHOPT
- IF(NCHO.EQ.0) THEN
- CHOPTT = ' '
- NCHO = 1
- ENDIF
-
- CHMAIL='GETA :'//REMOTE(1:NCHR)//' '//CHOPTT(1:NCHO)
- CALL CZPUTA(CHMAIL,ISTAT)
- IF(ISTAT.NE.0)GO TO 90
-*
- CALL CZGETA(CHMAIL,ISTAT)
- IF(ISTAT.NE.0)GO TO 90
- READ(CHMAIL,'(I10)')LRECL
- IF(LRECL.EQ.0)GO TO 90
-*
-* Create local file
-*
- ISTAT = 0
- IF(IOPTA.EQ.0) THEN
-#if defined(CERNLIB_UNIX)
- IF(IOPTC.EQ.0) CALL CUTOL(LOCAL)
-#endif
-#if (defined(CERNLIB_UNIX))&&(defined(CERNLIB_APOSR9)||defined(CERNLIB_OS9))
- OPEN(UNIT=LUNXZO,FILE=LOCAL,STATUS='UNKNOWN',RECL=LRECL,
- + IOSTAT=ISTAT)
-#endif
-#if (defined(CERNLIB_UNIX))&&(!defined(CERNLIB_APOSR9))&&(!defined(CERNLIB_OS9))
- OPEN(UNIT=LUNXZO,FILE=LOCAL,STATUS='UNKNOWN',IOSTAT=ISTAT)
-#endif
-#if defined(CERNLIB_VAXVMS)
- OPEN(UNIT=LUNXZO,FILE=LOCAL,STATUS='NEW',IOSTAT=ISTAT,
- + CARRIAGECONTROL='LIST')
-#endif
-#if defined(CERNLIB_IBMMVS)
- CALL KUOPEN(LUNXZO,LOCAL(1:LENOCC(LOCAL)),'UNKNOWN',ISTAT)
-#endif
-#if defined(CERNLIB_IBMVM)
- CHFILE='/'//LOCAL
- DO 2 I=7,64
- IF(CHFILE(I:I).EQ.'.')CHFILE(I:I)=' '
- 2 CONTINUE
-*
-* Create local file as V format if requested
-*
- IF(IOPTV.NE.0) THEN
- CALL FILEINF(LUNXZO,'RECFM','U')
- ENDIF
-
- OPEN(UNIT=LUNXZO,FILE=CHFILE,STATUS='UNKNOWN',IOSTAT=ISTAT)
-#endif
- ENDIF
-*
-* Inform server that local file has been created
-*
- IF(ISTAT.NE.0)THEN
- CHMAIL='KO'
- ELSE
- CHMAIL='OK'
- ENDIF
- CALL CZPUTA(CHMAIL,ISTAT)
- IF(ISTAT.NE.0) GO TO 95
- IF(CHMAIL(1:2).EQ.'KO') GOTO 95
-*
-* Start transfer
-*
- NR=0
- IF(IOPTS.NE.0) THEN
- CALL TIMED(T)
- CALL CZRTIM(DELTIM)
- ENDIF
-
- 20 CONTINUE
- NMAX=3077
-* NMAX=2053
-#if defined(CERNLIB_DECNET)
-*
-* DECnet...
-*
- IF(IPROT.EQ.1) THEN
- CALL CZDGTS(CHLEN,NMAX,ISTAT)
- IF(ISTAT.NE.0) GOTO 99
- ELSE
-#endif
-#if !defined(CERNLIB_IBM)||defined(CERNLIB_TCPSOCK)
-*
-* TCP/IP (with socket library)
-*
- NBYTES=SRECVSTR(ISKIN,CHLEN,NMAX)
-#endif
-#if (defined(CERNLIB_IBM))&&(!defined(CERNLIB_TCPSOCK))
-*
-* TCP/IP on IBM without socket library->PASCAL version of TCPAW
-*
- CALL SRECV(ISKIN,CHLEN,NMAX,NBYTES)
- IF(NBYTES.LT.NMAX)GO TO 99
-#endif
-#if defined(CERNLIB_DECNET)
- ENDIF
-#endif
-#if (!defined(CERNLIB_CRAY))&&(!defined(CERNLIB_CONVEX))
- READ(CHLEN,2000)NTOT,NCC
- 2000 FORMAT(I5,4I3,255I3,255I3,255I3,255I3)
-#endif
-#if defined(CERNLIB_CRAY)||defined(CERNLIB_CONVEX)
- READ (CHLEN(1:5),2000)NTOT
- 2000 FORMAT(I5)
- IOFF = 6
- JOFF = 1
- DO 11 II=1,8
- READ (CHLEN(IOFF:IOFF+95),'(32I3)') (NCC(JJ),JJ=JOFF,JOFF+31)
- IOFF = IOFF + 96
- JOFF = JOFF + 32
- 11 CONTINUE
-#endif
- IF(NTOT.LE.0)GO TO 40
-*
- CALL CZGETC(NTOT,ISTAT)
- IF(ISTAT.NE.0)GO TO 97
- NR=NR+NTOT
- I1=1
- DO 30 I=1,1024
- IF(NCC(I).LT.0)THEN
- IF(NCC(I).EQ.-2)GO TO 40
- GO TO 20
- ENDIF
- IF(NCC(I).EQ.0)THEN
- WRITE(LUNXZO,'(A)',ERR=97)' '
- ELSE
- I2=I1+NCC(I)-1
- WRITE(LUNXZO,'(A)',ERR=97)CHBUF(I1:I2)
- I1=I2+1
- ENDIF
- 30 CONTINUE
- GO TO 20
-*
- 40 CONTINUE
- CLOSE(LUNXZO)
- IF(IDEBXZ.GE.0) WRITE(IXPRNT,*) ' File transfer completed'
- NKILO = NR / 1024
-
- IF(IOPTS.NE.0)THEN
- CALL CZRTIM(DELTIM)
- CALL TIMED(T)
- READ(DELTIM,'(I2,1X,I2,1X,I2)') IHOUR,IMIN,ISEC
- NSECS = ISEC + IMIN*60 + IHOUR*3600
- IF(NSECS.LE.0) NSECS = 1
- RATE = FLOAT(NKILO)/FLOAT(NSECS)
-#include "cspack/xzstat.inc"
- WRITE(IXPRNT,*) ' Transferred ',NR,' bytes, transfer rate = ',
- + RATE,' KB/S'
- WRITE(IXPRNT,*) ' Elapsed time = ',DELTIM,' CP time = ',T,
- + ' sec.'
- ENDIF
- GO TO 99
-*
-* Error
-*
- 90 WRITE(IXPRNT,*) 'Cannot open remote file'
- IRC = 1
- GO TO 99
- 95 WRITE(IXPRNT,*) 'Cannot open local file'
- IRC = 2
- GO TO 99
- 97 WRITE(IXPRNT,*) 'Problem in transferring file'
- IRC = 3
- CLOSE(LUNXZO)
-*
- 99 END
diff --git a/src/packlib/cspack/xz/xzgetb.F b/src/packlib/cspack/xz/xzgetb.F
deleted file mode 100644
index c32dcc4..0000000
--- a/src/packlib/cspack/xz/xzgetb.F
+++ /dev/null
@@ -1,142 +0,0 @@
-*
-* $Id: xzgetb.F,v 1.1.1.1 1996/03/08 15:44:30 mclareni Exp $
-*
-* $Log: xzgetb.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:30 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE XZGETB(LOCAL,REMOTE,LRECL,CHOPT,IRC)
-*
-* Options:
-* A - local file has already been opened
-* R - replace local file if it already exists
-*
-#include "cspack/zmach.inc"
-#include "cspack/czunit.inc"
-#include "cspack/hcmail.inc"
-#include "cspack/czsock.inc"
-#include "cspack/czbuff.inc"
-#include "cspack/quest.inc"
- CHARACTER*(*) REMOTE,LOCAL
-#if defined(CERNLIB_IBM)
- CHARACTER*80 CHFILE
-#endif
- CHARACTER*12 NODE
- CHARACTER*8 DELTIM
- CHARACTER*4 CHOPI
- DIMENSION IBUFF(8192)
- PARAMETER (NREC=0)
-#include "cspack/czopts.inc"
-#include "cspack/czopen.inc"
- IRC = 0
- NCHL = LENOCC(LOCAL)
- NCHR = LENOCC(REMOTE)
-
- IF(IDEBXZ.GE.1) PRINT *,'XZGETB. enter for ',
- + 'LOCAL,REMOTE,LRECL,CHOPT = ',
- + LOCAL(1:NCHL),',',REMOTE(1:NCHR),',',LRECL,',',CHOPT
-
- IF(LRECL.EQ.0) THEN
- PRINT *,'XZGETB. the record length (in bytes) must be given'
- IRC = -1
- RETURN
- ENDIF
-*
-* Open local file, options Output
-*
- ISTAT = 0
- IF(IOPTA.EQ.0) THEN
-
- IF(IOPTR.EQ.0) THEN
- CHOPI = 'NO'
- IF(IOPTC.NE.0) CHOPI = 'NOC'
- ELSE
- CHOPI = 'O'
- IF(IOPTC.NE.0) CHOPI = 'OC'
- ENDIF
-
- CALL SZOPEN(LUNXZO,LOCAL(1:NCHL),LRECL,CHOPI,ISTAT)
- IF(ISTAT.EQ.28.AND.IDEBXZ.GE.-3) PRINT *,'XZGETB. ',
- + 'local file already exists. ',
- + 'Specify option R to replace'
- IF(IDEBXZ.GE.3) PRINT *,'XZGETB. return code ',ISTAT,
- + ' from SZOPEN for ',LOCAL(1:NCHL),' on unit ',LUNXZO
- IF(ISTAT.NE.0) GOTO 95
- ENDIF
-*
-* Check if remote file exists; try to get its record length
-*
- NODE = CUNODE
- CHNODE(LUNXZI) = NODE
- JSKIN(LUNXZI) = ISKIN
- JSKOUT(LUNXZI) = ISKOUT
- IF(IOPTC.EQ.0) THEN
- CALL XZOPEN(LUNXZI,REMOTE(1:NCHR),NODE,LRECL,'U',IRC)
- ELSE
- CALL XZOPEN(LUNXZI,REMOTE(1:NCHR),NODE,LRECL,'UC',IRC)
- ENDIF
- IF(IDEBXZ.GE.3) PRINT *,'XZGETB. return code ',IRC,
- + ' from XZOPEN for ',REMOTE(1:NCHR),' on unit ',LUNXZI
- IF(IRC.NE.0) GOTO 90
-*
-* Start transfer
-*
- NR=0
- NWANT=LRECL
-*
-* Start timer
-*
- IF(IOPTS.NE.0) THEN
- CALL CZRTIM(DELTIM)
- CALL TIMED(T)
- ENDIF
-
- 20 CALL XZREAD(LUNXZI,IBUFF,NREC,NWANT,NGOT,' ',IRC)
- IF(IRC.EQ.0) THEN
- NR = NR + 1
- CALL SZRITE(LUNXZO,IBUFF,0,NWANT,' ',IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBXZ.GE.0) PRINT *,'XZGETB. error ',IRC, ' from '
- + //'SZRITE'
- GOTO 97
- ENDIF
- GOTO 20
- ELSEIF(IRC.GT.0) THEN
- IF(IDEBXZ.GE.0) PRINT *,'XZGETB. error ',IRC,
- + ' from XZREAD'
- GOTO 97
- ENDIF
-
- CLOSE(LUNXZO)
- CALL XZCLOS(LUNXZI,' ',IRC)
- IF(IDEBXZ.GE.0) PRINT *,' File transfer completed'
- NKILO = NR*LRECL / 1024
- IF(IOPTS.NE.0)THEN
- CALL CZRTIM(DELTIM)
- CALL TIMED(T)
- READ(DELTIM,'(I2,1X,I2,1X,I2)') IHOUR,IMIN,ISEC
- NSECS = ISEC + IMIN*60 + IHOUR*3600
- IF(NSECS.LE.0) NSECS = 1
- RATE = FLOAT(NKILO)/FLOAT(NSECS)
-#include "cspack/xzstat.inc"
- PRINT *,' Transferred ',NR,' records, transfer rate = ',RATE,
- + ' KB/S'
- PRINT *,' Elapsed time = ',DELTIM,' CP time = ',T,' sec.'
- ENDIF
- GO TO 99
-*
-* Error
-*
- 90 PRINT *, 'Cannot open remote file'
- IRC = 1
- GO TO 99
- 95 PRINT *, 'Cannot open local file'
- IRC = 2
- GO TO 99
- 97 PRINT *, 'Problem in transferring file'
- IRC = 3
- CLOSE(LUNXZO)
-*
- 99 END
diff --git a/src/packlib/cspack/xz/xzgetd.F b/src/packlib/cspack/xz/xzgetd.F
deleted file mode 100644
index 4540ea6..0000000
--- a/src/packlib/cspack/xz/xzgetd.F
+++ /dev/null
@@ -1,134 +0,0 @@
-*
-* $Id: xzgetd.F,v 1.1.1.1 1996/03/08 15:44:30 mclareni Exp $
-*
-* $Log: xzgetd.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:30 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE XZGETD(LOCAL,REMOTE,LRECL,CHOPT,IRC)
-*
-* Options:
-* A - local file has already been opened
-* R - replace file if it already exists
-*
-#include "cspack/zmach.inc"
-#include "cspack/czunit.inc"
-#include "cspack/hcmail.inc"
-#include "cspack/czsock.inc"
-#include "cspack/czbuff.inc"
-#include "cspack/quest.inc"
- CHARACTER*(*) REMOTE,LOCAL
-#if defined(CERNLIB_IBM)
- CHARACTER*80 CHFILE
-#endif
- CHARACTER*12 NODE
- CHARACTER*8 DELTIM
- DIMENSION IBUFF(8192)
- CHARACTER*4 CHOPI
-#include "cspack/czopts.inc"
-#include "cspack/czopen.inc"
- IRC = 0
- IF(LRECL.EQ.0) THEN
- PRINT *,'XZGETD. the record length (in bytes) must be given'
- IRC = -1
- RETURN
- ENDIF
-*
-* Open local file, options Output
-*
- NCHL = LENOCC(LOCAL)
- NCHR = LENOCC(REMOTE)
- IF(IDEBXZ.GE.1)
- +PRINT *,'XZGETD. enter for Local = ',LOCAL(1:NCHL),
- + ' Remote = ',REMOTE(1:NCHR),' LRECL = ',LRECL,
- + ' CHOPT = ',CHOPT
- IF(IOPTA.EQ.0) THEN
- CHOPI = 'DNO'
- IF(IOPTR.NE.0) CHOPI = 'DO'
- IF(IOPTC.NE.0) THEN
- LCH = LENOCC(CHOPI) + 1
- CHOPI(LCH:LCH) = 'C'
- ENDIF
- CALL SZOPEN(LUNXZO,LOCAL(1:NCHL),LRECL,CHOPI,ISTAT)
- IF(ISTAT.EQ.28.AND.IDEBXZ.GE.-3) PRINT *,'XZGETD. ',
- + 'local file already exists. ',
- + 'Specify option R to replace'
-
- IF(ISTAT.NE.0) GOTO 95
- ENDIF
-*
-* Check if remote file exists; try to get its record length
-*
- NODE = CUNODE
- CHNODE(LUNXZI) = NODE
- JSKIN(LUNXZI) = ISKIN
- JSKOUT(LUNXZI) = ISKOUT
- IF(IOPTC.EQ.0) THEN
- CALL XZOPEN(LUNXZI,REMOTE(1:NCHR),NODE,LRECL,'DU',IRC)
- ELSE
- CALL XZOPEN(LUNXZI,REMOTE(1:NCHR),NODE,LRECL,'DUC',IRC)
- ENDIF
- IF(IRC.NE.0) GOTO 90
-*
-* Start transfer
-*
- NR=0
- NREC = 0
- NWANT=LRECL
-*
-* Start timer
-*
- IF(IOPTS.NE.0) THEN
- CALL CZRTIM(DELTIM)
- CALL TIMED(T)
- ENDIF
-
- 20 NREC = NREC + 1
- CALL XZREAD(LUNXZI,IBUFF,NREC,NWANT,NGOT,' ',IRC)
- IF(IRC.EQ.0) THEN
- NR = NR + 1
- NWR = NWANT/IQCHAW
- CALL SZRITE(LUNXZO,IBUFF,NREC,LRECL,' ',IRC)
- GOTO 20
- ELSEIF(IRC.GT.0) THEN
-*
-* For D/A files, cannot distinguish between read error
-* and EOF. Assume EOF if >0 records read.
-*
- IF(NR.EQ.0) GOTO 97
- ENDIF
-
- CLOSE(LUNXZO)
- CALL XZCLOS(LUNXZI,' ',IRC)
- IF(IDEBXZ.GE.0) PRINT *,' File transfer completed'
- NKILO = NR*LRECL / 1024
- IF(IOPTS.NE.0)THEN
- CALL CZRTIM(DELTIM)
- CALL TIMED(T)
- READ(DELTIM,'(I2,1X,I2,1X,I2)') IHOUR,IMIN,ISEC
- NSECS = ISEC + IMIN*60 + IHOUR*3600
- IF(NSECS.LE.0) NSECS = 1
- RATE = FLOAT(NKILO)/FLOAT(NSECS)
-#include "cspack/xzstat.inc"
- PRINT *,' Transferred ',NR,' records, transfer rate = ',RATE,
- + ' KB/S'
- PRINT *,' Elapsed time = ',DELTIM,' CP time = ',T,' sec.'
- ENDIF
- GO TO 99
-*
-* Error
-*
- 90 PRINT *, ' Cannot open remote file'
- IRC = 1
- GO TO 99
- 95 PRINT *, ' Cannot open local file'
- IRC = 2
- GO TO 99
- 97 PRINT *, 'Problem in transferring file'
- IRC = 3
- CLOSE(LUNXZO)
-*
- 99 END
-
diff --git a/src/packlib/cspack/xz/xzgetf.F b/src/packlib/cspack/xz/xzgetf.F
deleted file mode 100644
index 0468db4..0000000
--- a/src/packlib/cspack/xz/xzgetf.F
+++ /dev/null
@@ -1,244 +0,0 @@
-*
-* $Id: xzgetf.F,v 1.1.1.1 1996/03/08 15:44:30 mclareni Exp $
-*
-* $Log: xzgetf.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:30 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE XZGETF(LOCAL,REMOTE,LRECL,LFRM,RRECL,RFRM,CHOPT,IRC)
-* A - local file has already been opened
-#include "cspack/hcmail.inc"
-#include "cspack/czunit.inc"
-#include "cspack/czsock.inc"
-#include "cspack/zmach.inc"
- CHARACTER*(*) LOCAL,REMOTE,LFRM,RFRM
- CHARACTER*8 DELTIM
- CHARACTER*4 CHOPE,CHOPO,LFORM,RFORM
-#if defined(CERNLIB_IBMVM)
- CHARACTER*255 CHFILE,CHTEMP
- CHARACTER*2 CHMODE
-#endif
- CHARACTER*80 CARD
- DIMENSION IUHEAD(400)
- DIMENSION IOCR(100)
- PARAMETER (JBIAS=2)
- PARAMETER (MEGA=1024*1024)
- COMMON/FZSTAT/INFLUN,INFSTA,INFOFZ(40)
- INTEGER RRECL
-#include "cspack/quest.inc"
-#include "cspack/pawc.inc"
- DIMENSION IQ(2),Q(2),LQ(8000)
- EQUIVALENCE (LQ(1),LMAIN),(IQ(1),LQ(9)),(Q(1),IQ(1))
-#include "cspack/czopts.inc"
-#include "cspack/czopen.inc"
-#if defined(CERNLIB_IBMVM)
- LBLK = 16384
-#endif
- IRC = 0
- NCHL = LENOCC(LOCAL)
- NCHR = LENOCC(REMOTE)
- LFORM = LFRM
- RFORM = RFRM
- LENL = LENOCC(LFORM)
- LENR = LENOCC(RFORM)
-
- IF(LENR.EQ.0) THEN
- RFORM = 'Z'
- LENR = 1
- ENDIF
-
- IF(LENL.EQ.0) THEN
- LFORM = RFORM
- LENL = LENR
- ENDIF
-
- IF(IOPTC.NE.0) THEN
- LENR = LENR + 1
- RFORM(LENR:LENR) = 'C'
- ENDIF
-
- IF(IDEBXZ.GE.1)
- +PRINT *,'XZGETF. enter for ',LOCAL(1:NCHL),' ',REMOTE(1:NCHR),
- + LRECL,' ',LFORM,RRECL,' ',RFORM,CHOPT
-
- CHOPE = 'ON'
-
- IF(INDEX(RFORM(1:LENR),'A').NE.0) THEN
-*
-* Exchange file format, ASCII mapping
-*
- RRECL = 80
- CHOPE = 'FON'
-
- ELSEIF(INDEX(RFORM(1:LENR),'X').NE.0) THEN
-*
-* Binary exchange format
-*
- IF(INDEX(RFORM(1:LENR),'D').NE.0) CHOPE = 'DON'
- ELSEIF(INDEX(RFORM(1:LENR),'Z').NE.0) THEN
- CHOPE = 'VON'
- ELSE
-
- IF(RRECL.EQ.0) THEN
- IF(IDEBXZ.GE.-3) PRINT *,'XZPUTF. record length for ',
- + 'native FZ file defaulted to 3600 bytes'
- RRECL = 3600
-* PRINT *,'XZGETF. the record length (in bytes) must be '
-* + //'given for native mode files'
-* IRC = 1
-* RETURN
- ENDIF
-
- ENDIF
-
- WRITE(CARD,9001) REMOTE(1:NCHR),RRECL,RFORM(1:LENR)
- 9001 FORMAT('GETFZ:',A,' ',I6,A4)
- CALL CZPUTA(CARD,ISTAT)
-*
-* Get remote record length
-*
- CALL CZGETA(CHMAIL,ISTAT)
- IF(ISTAT.NE.0)GO TO 90
- READ(CHMAIL,'(I6)') JRECL
- IF(JRECL.LT.0)GO TO 90
-*
-* Take record length from remote file
-*
- IF(LRECL.EQ.0) LRECL = JRECL
-
- IF(IOPTA.EQ.0) THEN
-#if defined(CERNLIB_IBMVM)
- IF(LFORM(1:LENL).EQ.'Z') THEN
- CHTEMP = LOCAL(1:NCHL)
- CALL CTRANS('.',' ',CHTEMP,1,NCHL)
- LASTB = INDEXB(CHTEMP(1:NCHL),' ')
- IF(INDEX(CHTEMP(1:NCHL),' ').EQ.LASTB) THEN
- CHTEMP(NCHL+1:NCHL+3) = ' A4'
- NCHT = NCHL + 3
- ELSE
- CHTEMP(LASTB+2:LASTB+2) = '4'
- NCHT = LASTB + 2
- ENDIF
- WRITE(CHFILE,9002) LUNXZO,CHTEMP(1:NCHT),LBLK
-9002 FORMAT('FILEDEF ',I2,' DISK ',A,
- + ' (RECFM VBS LRECL 32756 BLOCK ',I6,' PERM)')
- LCHF = LENOCC(CHFILE)
- CALL VMCMS(CHFILE(1:LCHF),IRC)
- IF(IDEBXZ.GE.3) PRINT *,'XZGETF. rc from ',
- + CHFILE(1:LCHF),' = ',IRC
- OPEN(LUNXZO,STATUS='NEW',FORM='UNFORMATTED',IOSTAT=IRC)
- ELSE
- CALL SZOPEN(LUNXZO,LOCAL(1:NCHL),LRECL,CHOPE,IRC)
- ENDIF
-#endif
-#if !defined(CERNLIB_IBMVM)
- LCHOPE = LENOCC(CHOPE) + 1
- IF(IOPTC.NE.0) CHOPE(LCHOPE:LCHOPE) = 'C'
- CALL SZOPEN(LUNXZO,LOCAL(1:NCHL),LRECL,CHOPE,IRC)
-#endif
- IF(IRC.NE.0) THEN
- PRINT *,'XZGETF. cannot open local file'
- GOTO 95
- ENDIF
- ENDIF
-
- IF(LFORM(1:LENL).EQ.'Z') LFORM = ' '
- CALL FZFILE(LUNXZO,LRECL/4,'FO'//LFORM(1:LENL))
-
- CALL FZLOGL(LUNXZO,IDEBXZ)
- CALL FZLOGL(LUNFZI,IDEBXZ)
-*
-* Perform the transfer
-*
- CALL CZRTIM(DELTIM)
- CALL TIMED(T)
- NR = 0
- 1 CONTINUE
- NUH = 400
- CALL FZIN(LUNFZI,IHDIV,LSUP,JBIAS,' ',NUH,IUHEAD)
- IF((IQUEST(1).LT.0).OR.(IQUEST(1).GE.4)) GOTO 2
- NR = NR + 1
- IF(IQUEST(1).EQ.0) THEN
- IEVENT = IQUEST(11)
- IF((NUH.EQ.1).AND.(IUHEAD(1).EQ.999)
- + .AND.(IQUEST(14).EQ.0)) GOTO 2
- ENDIF
-*
-* start of run
-*
- IF(IQUEST(1).EQ.1) THEN
- IF(IDEBXZ.GE.3) PRINT *,'XZGETF. read start of run'
- IF(IOPTR.NE.0) GOTO 1
- CALL FZRUN(LUNXZO,IQUEST(11),NUH,IUHEAD)
- GOTO 1
-*
-* end of run
-*
- ELSEIF(IQUEST(1).EQ.2) THEN
- IF(IDEBXZ.GE.3) PRINT *,'XZGETF. read end of run'
- IF(IOPTR.NE.0) GOTO 1
- CALL FZRUN(LUNXZO,-1,NUH,IUHEAD)
- GOTO 1
-*
-* ZEBRA eof
-*
- ELSEIF(IQUEST(1).EQ.3) THEN
- IF(IDEBXZ.GE.3) PRINT *,'XZGETF. read end of file'
- IF(IOPTZ.NE.0) GOTO 1
- CALL FZENDO(LUNXZO,'E')
- GOTO 2
- ENDIF
-
- IF(IDEBXZ.GE.3) PRINT *,'XZGETF. read ',IQUEST(14),
- + ' data words + ',NUH,' words of user header'
- CALL UCOPY(IQUEST(21),IOCR,MIN(IQUEST(20),100))
- CHOPO = 'L'
- IF(IQUEST(14).EQ.0) CHOPO = 'Z'
- CALL FZOUT(LUNXZO,IHDIV,LSUP,IEVENT,CHOPO,IOCR,NUH,IUHEAD)
- IF(CHOPO.EQ.'L') CALL MZDROP(IHDIV,LSUP,' ')
- GOTO 1
- 2 CONTINUE
- IF(IDEBXZ.GE.0) PRINT 2000
- 2000 FORMAT(' File transfer completed')
-*
-* Call FZINFO to get NWORDS, NMEGA transferred
-*
- CALL FZINFO(LUNXZO)
- CALL FZENDO(LUNXZO,'T')
- IF(INFLUN.NE.LUNXZO) THEN
- PRINT *,'XZGETF. error obtaining FZINFO for LUN = ',LUNXZO
- MBYTES = 0
- ELSE
- MBYTES = (INFOFZ(19) + INFOFZ(20)/MEGA)*IQCHAW
- ENDIF
- CLOSE(LUNXZO)
-
- CALL CZRTIM(DELTIM)
- CALL TIMED(T)
-
- IF(INDEX(CHOPT,'S').NE.0) THEN
- READ(DELTIM,'(I2,1X,I2,1X,I2)') IHOUR,IMIN,ISEC
- NSECS = ISEC + IMIN*60 + IHOUR*3600
- IF(NSECS.LE.0) NSECS = 1
- NKILO = MBYTES/1024
- RATE = FLOAT(MBYTES)*1000./FLOAT(NSECS)
-#include "cspack/xzstat.inc"
- PRINT *,' Transferred ',NKILO,' KB, rate = ',RATE,' KB/S'
- PRINT *,' Elapsed time = ',DELTIM,' CP time = ',T,' sec.'
- ENDIF
-
-*
- 80 CLOSE(LUNXZO)
- GO TO 99
-*
- 95 PRINT *,' Cannot open local file'
- IRC = 2
- CALL FZENDI(LUNXZO,' ')
- GO TO 80
-*
- 90 PRINT *,' Cannot open remote file'
- IRC = 1
-*
- 99 END
diff --git a/src/packlib/cspack/xz/xzgetl.F b/src/packlib/cspack/xz/xzgetl.F
deleted file mode 100644
index b9b09e3..0000000
--- a/src/packlib/cspack/xz/xzgetl.F
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: xzgetl.F,v 1.1.1.1 1996/03/08 15:44:30 mclareni Exp $
-*
-* $Log: xzgetl.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:30 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE XZGETL(LUN,CHLINE,CHFORM,CHOPT,IRC)
- CHARACTER*(*) CHLINE,CHFORM
-#include "cspack/zmach.inc"
-#include "cspack/hcmail.inc"
-#include "cspack/quest.inc"
-#include "cspack/czsock.inc"
-#include "cspack/czopts.inc"
-*
- IRC = 0
-*
-* Instruct server to issue a read
-*
- CALL CZSWAP(' ',LUN,ISTAT)
- WRITE(CHMAIL,9001) LUN,CHFORM
-9001 FORMAT('XZIO :GETL',I3,A)
- CALL CZPUTA(CHMAIL,ISTAT)
-*
-* Get status information back from server
-*
-#include "cspack/czmess.inc"
- CHLINE = ' '
- IF(IRC.EQ.0) CALL CZGETA(CHLINE,IRC)
-
- END
diff --git a/src/packlib/cspack/xz/xzgetp.F b/src/packlib/cspack/xz/xzgetp.F
deleted file mode 100644
index c813eb7..0000000
--- a/src/packlib/cspack/xz/xzgetp.F
+++ /dev/null
@@ -1,168 +0,0 @@
-*
-* $Id: xzgetp.F,v 1.4 1998/09/25 09:25:02 mclareni Exp $
-*
-* $Log: xzgetp.F,v $
-* Revision 1.4 1998/09/25 09:25:02 mclareni
-* Modifications for the Mklinux port flagged by CERNLIB_PPC
-*
-* Revision 1.3 1997/09/02 08:46:27 mclareni
-* WINNT mods, mostly cpp defines
-*
-* Revision 1.2 1997/01/17 08:56:16 gunter
-* call vxinvb for linux too.
-*
-* Revision 1.1.1.1 1996/03/08 15:44:30 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE XZGETP(LOCAL,REMOTE,CHOPT,IRC)
-#include "cspack/zmach.inc"
-#include "cspack/hcmail.inc"
-#include "cspack/czsock.inc"
-#include "cspack/czbuff.inc"
-#include "cspack/czunit.inc"
-#include "cspack/quest.inc"
- CHARACTER*(*) LOCAL,REMOTE
-#if defined(CERNLIB_IBM)
- CHARACTER*80 CHFILE
-#endif
-#include "cspack/czoptd.inc"
- CHARACTER*12 NODE
- CHARACTER*8 DELTIM
- CHARACTER*8 CHOPTT
- CHARACTER*4 CHOPI
- DIMENSION IBUFF(8192)
- PARAMETER (NREC=0)
- DIMENSION IA(512)
- DIMENSION IB(2)
- DIMENSION ICONTR(2)
- DIMENSION IX(8)
- DIMENSION MPACK2(2),MPACK9(2)
- DATA MPACK2 / 2, 16 /
- DATA MPACK9 / 9, 3 /
-#include "cspack/czoptu.inc"
-#include "cspack/czopen.inc"
- IRC = 0
-*
-* Open local file, options Output
-*
- NCHL = LENOCC(LOCAL)
- NCHR = LENOCC(REMOTE)
- LRECL = 2048
- IF(IOPTA.EQ.0) THEN
- CHOPI = 'NOP'
- IF(IOPTR.NE.0) CHOPI = 'OP'
- LCH = LENOCC(CHOPI) + 1
- IF(IOPTC.NE.0) CHOPI(LCH:LCH) = 'C'
- CALL SZOPEN(1,LOCAL(1:NCHL),LRECL,CHOPI,ISTAT)
- IF(ISTAT.EQ.28.AND.IDEBXZ.GE.-3) PRINT *,'XZGETP. ',
- + 'local file already exists. ',
- + 'Specify option R to replace'
- IF(ISTAT.NE.0) GOTO 95
- ENDIF
-
- NCHO=LENOCC(CHOPT)
- CHOPTT = CHOPT
- IF(NCHO.EQ.0) THEN
- CHOPTT = ' '
- NCHO = 1
- ENDIF
-
- CHMAIL = 'GETP :'//REMOTE(1:NCHR)//' '//CHOPTT(1:NCHO)
-
- CALL CZPUTA(CHMAIL,ISTAT)
- IF(ISTAT.NE.0) GOTO 99
-*
- 50 CALL CZGETA(CHMAIL,ISTAT)
- IF(ISTAT.NE.0)GO TO 99
- IF(CHMAIL.EQ.'KO')GO TO 90
-*
-* Transfer data
-*
- NR = 0
- NW = 0
- IF(INDEX(CHOPT,'S').NE.0)THEN
- CALL CZRTIM(DELTIM)
- CALL TIMED(T)
- ENDIF
- 20 CONTINUE
- CALL CZGETA(CHMAIL,ISTAT)
- IF(ISTAT.NE.0) GOTO 97
-
- READ(CHMAIL,'(I3)') LBUF
- IF(LBUF.LT.0) GOTO 40
- NR = NR + 1
- NW = NW + LBUF
-
- ICONTR(1) = 0
- ICONTR(2) = LBUF
-
- CALL CZTCP(IA,ICONTR)
-#if defined(CERNLIB_IBM)
- CALL XZATOE(IA(1),8)
-#endif
-#if defined(CERNLIB_VAXVMS)||defined(CERNLIB_DECS) || (defined(CERNLIB_LINUX) && !defined(CERNLIB_PPC)) || defined(CERNLIB_WINNT)
- IB(1) = IA(3)
- IB(2) = IA(4)
- CALL VXINVB(IB(1),2)
- CALL UPKBYT(IB(1),1,IX(4),4,MPACK9)
- CALL UPKBYT(IB(1),1,IX,4,MPACK2)
- LENX = 1
- IF(IX(5).NE.0) LENX = IX(7) - 3
-*
-* Byte swap index vector
-*
- CALL VXINVB(IA(3),LENX)
-#endif
- CALL UPKBYT(IA(3),1,IX(4),4,MPACK9)
- CALL UPKBYT(IA(3),1,IX,4,MPACK2)
- I = 4
- IF(IX(5).NE.0) THEN
- I = IX(7)
- ENDIF
-#if defined(CERNLIB_IBM)
-*
-* Translate text
-*
- CALL XZATOE(IA(I),(LBUF-I+1)*4)
-#endif
- WRITE(1) LBUF,(IA(I),I=1,LBUF)
-
- GOTO 20
-*
- 40 CONTINUE
-*
- CLOSE(1)
- IF(IDEBXZ.GE.0) PRINT *,' File transfer completed'
- IF(INDEX(CHOPT,'S').NE.0)THEN
- CALL CZRTIM(DELTIM)
- CALL TIMED(T)
- READ(DELTIM,'(I2,1X,I2,1X,I2)') IHOUR,IMIN,ISEC
- NSECS = ISEC + IMIN*60 + IHOUR*3600
- IF(NSECS.LE.0) NSECS = 1
- NKILO = NW * IQCHAW / 1024
- RATE = FLOAT(NKILO)/FLOAT(NSECS)
-#include "cspack/xzstat.inc"
- PRINT *,' Transferred ',NR,' records, transfer rate = ',RATE,
- + ' KB/S'
- PRINT *,' Elapsed time = ',DELTIM,' CP time = ',T,' sec.'
- ENDIF
- GO TO 99
-*
-* Error
-*
- 90 PRINT *, ' Cannot open remote file'
- IRC = 1
- GO TO 99
- 95 PRINT *, ' Cannot open local file'
- IRC = 2
- GO TO 99
- 97 PRINT *, 'Problem in transferring file'
- IRC = 3
- CLOSE(1)
-*
- 99 LBUF = 270
- END
-
-
diff --git a/src/packlib/cspack/xz/xzgetr.F b/src/packlib/cspack/xz/xzgetr.F
deleted file mode 100644
index 302ca2b..0000000
--- a/src/packlib/cspack/xz/xzgetr.F
+++ /dev/null
@@ -1,171 +0,0 @@
-*
-* $Id: xzgetr.F,v 1.1.1.1 1996/03/08 15:44:30 mclareni Exp $
-*
-* $Log: xzgetr.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:30 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE XZGETR(LOCAL,REMOTE,CHOPT,IRC)
-* A - local file has already been opened
-#include "cspack/czunit.inc"
-#include "cspack/hcmail.inc"
-#include "cspack/czsock.inc"
-#include "cspack/zmach.inc"
-#include "cspack/quest.inc"
-#include "cspack/pawc.inc"
- DIMENSION IQ(2),Q(2),LQ(8000)
- EQUIVALENCE (LQ(1),LMAIN),(IQ(1),LQ(9)),(Q(1),IQ(1))
- COMMON /RZCL/ LTOP,LRZ0,LCDIR,LRIN,LROUT,LFREE,LUSED,LPURG
- +, LTEMP,LCORD,LFROM
-#include "cspack/rzclun.inc"
- PARAMETER (KUP=5,KPW1=7,KNCH=9,KDATEC=10,KDATEM=11,KQUOTA=12,
- + KRUSED=13,KWUSED=14,KMEGA=15,KIRIN=17,KIROUT=18,
- + KRLOUT=19,KIP1=20,KNFREE=22,KNSD=23,KLD=24,KLB=25,
- + KLS=26,KLK=27,KLF=28,KLC=29,KLE=30,KNKEYS=31,
- + KNWKEY=32,KKDES=33,KNSIZE=253,KEX=6,KNMAX=100)
-#if defined(CERNLIB_IBM)
- CHARACTER*80 CHFILE
-#endif
- CHARACTER*8 CHTAG(100)
- CHARACTER*90 CHFORM
- CHARACTER*8 DELTIM
- CHARACTER*(*) LOCAL,REMOTE
- CHARACTER*2 CHOPE
- CHARACTER*4 CHOPO
-#include "cspack/czopts.inc"
-#include "cspack/czopen.inc"
-*_______________________________________
-* Send message to remote machine to check if file exists
-* and get file parameters
-*
- IF(IDEBXZ.GE.1) PRINT *,'XZGETR. enter for ',
- + LOCAL,' ',REMOTE,' ',CHOPT
-
- IRC = 0
- CHOPE = ' '
- IF(IOPTN.NE.0) CHOPE = 'N'
- IF(IOPTX.NE.0) CHOPE = 'X'
- LCHOPE = LENOCC(CHOPE) + 1
- IF(IOPTC.NE.0) CHOPE(LCHOPE:LCHOPE) = 'C'
- IF(IOPTE.NE.0) CHOPE(LCHOPE+1:LCHOPE+1) = 'E'
- NCHR = LENOCC(REMOTE)
- CHMAIL='GETRZ:'//REMOTE(1:NCHR)//' '//CHOPE
- CALL CZPUTA(CHMAIL,ISTAT)
- IF(ISTAT.NE.0)GO TO 99
-*
- CALL CZGETA(CHMAIL,ISTAT)
- IF(ISTAT.NE.0)GO TO 99
- READ(CHMAIL,1000,ERR=90)NWKEY,NREC,LRECL,IDATEC,IDATEM
- 1000 FORMAT(5I10)
- IF(NWKEY.EQ.-1) THEN
-*
-* Exchange mode transfer - use XZGETD
-*
- CHOPE = ' '
- IF(INDEX(CHOPT,'S').NE.0) CHOPE = 'S'
- IF(IDEBXZ.GE.3)
- + PRINT *,'XZGETR. Remote file is in exchange format.',
- + ' Transfer will be performed via XZGETD.'
- CALL XZGETD(LOCAL,REMOTE,LRECL*4,CHOPE,IC)
- GOTO 99
- ENDIF
- CALL CZGETA(CHFORM,ISTAT)
- IF(ISTAT.NE.0)GO TO 99
- IF(NWKEY.EQ.0)GO TO 90
- DO 10 I=1,NWKEY
- CALL CZGETA(CHMAIL,ISTAT)
- IF(ISTAT.NE.0)GO TO 90
- CHTAG(I)=CHMAIL
- 10 CONTINUE
-*
-* Create local file
-*
- CHMAIL='OK'
-*
-* Open local file using RZOPEN
-*
- ISTAT = 0
- IF(IOPTA.EQ.0) THEN
- IF(INDEX(CHOPT,'R').NE.0) THEN
- CHOPO = 'LN'
- IF(IOPTC.NE.0) CHOPO = 'LNP'
- ELSE
- CHOPO = 'N'
- IF(IOPTC.NE.0) CHOPO = 'NP'
- ENDIF
- CALL RZOPEN(LUNXZO,'RZ',LOCAL,CHOPO,LRECL,ISTAT)
- ENDIF
- IF(ISTAT.NE.0) GOTO 95
- IF(INDEX(CHOPT,'X').NE.0) THEN
- CALL RZMAKE(LUNXZO,'RZ',NWKEY,CHFORM,CHTAG,MIN(NREC,65000),'X')
- ELSE
- CALL RZMAKE(LUNXZO,'RZ',NWKEY,CHFORM,CHTAG,MIN(NREC,65000),' ')
- ENDIF
- IF(IQUEST(1).NE.0)GO TO 95
-*
-* Inform server if file opened on local node
-*
- 50 CALL CZPUTA(CHMAIL,ISTAT)
- IF(ISTAT.NE.0)GO TO 99
- IF(CHMAIL.EQ.'KO')GO TO 99
- IF(INDEX(CHOPT,'S').NE.0) THEN
- CALL TIMED(T)
- CALL CZRTIM(DELTIM)
- ENDIF
-*
-* Transfer data in RZ file
-*
- CALL RZFRFZ(LUNFZI,' ')
- IF(IQUEST(1).NE.0) THEN
- IRC = 3
- PRINT 2001
- 2001 FORMAT(' Error transferring file')
- ELSE
-#if defined(CERNLIB_NEVER)
-*
-* Restore previous modification date
-*
- IQ(LTOP+KDATEC)=IDATEC
- IQ(LTOP+KDATEM)=IDATEM
- ISAVE = 2
- CALL SBIT1(IQ(LTOP),2)
-* CALL RZSAVE
-#endif
- CALL RZCDIR(' ',' ')
- IF(IDEBXZ.GE.0) PRINT 2000
- 2000 FORMAT(' File transfer completed')
- IF(INDEX(CHOPT,'S').NE.0) THEN
- CALL CZRTIM(DELTIM)
- CALL TIMED(T)
- CALL RZSTAT('//RZ',99,' ')
- NKILO = IQUEST(12)*IQCHAW/1024
- READ(DELTIM,'(I2,1X,I2,1X,I2)') IHOUR,IMIN,ISEC
- NSECS = ISEC + IMIN*60 + IHOUR*3600
- IF(NSECS.LE.0) NSECS = 1
- RATE = FLOAT(NKILO)/FLOAT(NSECS)
- NR = 0
-#include "cspack/xzstat.inc"
- PRINT *,' Transferred ',NKILO,' KB, rate = ',RATE,' KB/S'
- PRINT *,' Elapsed time = ',DELTIM,' CP time = ',T,' sec.'
- ENDIF
-
- ENDIF
-
- IF(INDEX(CHOPT,'L').NE.0) CALL RZLDIR(' ',CHOPT)
- CALL RZEND('RZ')
- CLOSE(LUNXZO)
- GO TO 99
-*
- 90 PRINT *,' Cannot open remote file'
- IRC = 1
- GO TO 99
-*
- 95 PRINT *,' Cannot open local file'
- IRC = 2
- CHMAIL='KO'
- GO TO 50
-*
- 99 END
-
diff --git a/src/packlib/cspack/xz/xzgetx.F b/src/packlib/cspack/xz/xzgetx.F
deleted file mode 100644
index a202469..0000000
--- a/src/packlib/cspack/xz/xzgetx.F
+++ /dev/null
@@ -1,179 +0,0 @@
-*
-* $Id: xzgetx.F,v 1.1.1.1 1996/03/08 15:44:30 mclareni Exp $
-*
-* $Log: xzgetx.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:30 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE XZGETX(LOCAL,REMOTE,LRECL,CHOPT,IRC)
-*
-* Options:
-* A - local file has already been opened
-* R - replace file if it already exists
-*
-#include "cspack/zmach.inc"
-#include "cspack/czunit.inc"
-#include "cspack/hcmail.inc"
-#include "cspack/czsock.inc"
-#include "cspack/czbuff.inc"
-#include "cspack/quest.inc"
- CHARACTER*(*) REMOTE,LOCAL
-#if defined(CERNLIB_IBM)
- CHARACTER*80 CHFILE
-#endif
- CHARACTER*12 NODE
- CHARACTER*8 DELTIM
- DIMENSION IBUFF(8192)
- LOGICAL LDIO,RDIO
- CHARACTER*4 CHOPL,CHOPR
-#include "cspack/czopts.inc"
-#include "cspack/czopen.inc"
- IRC = 0
- NCHL = LENOCC(LOCAL)
- NCHR = LENOCC(REMOTE)
-#if defined(CERNLIB_UNIX)
- LDIO = .TRUE.
- IF(IOPTR.NE.0) THEN
- CHOPL = 'OD'
- IF(IOPTC.NE.0) CHOPL = 'COD'
- ELSE
- CHOPL = 'NOD'
- IF(IOPTC.NE.0) CHOPL = 'NCOD'
- ENDIF
-#endif
-#if !defined(CERNLIB_UNIX)
- LDIO = .FALSE.
- CHOPL = 'NO'
- IF(IOPTR.NE.0) CHOPL = 'O'
-#endif
-
- IF(IDEBXZ.GE.1) PRINT *,'XZGETX. enter for ',
- + 'LOCAL,REMOTE,LRECL,CHOPT = ',
- + LOCAL(1:NCHL),',',REMOTE(1:NCHR),',',LRECL,',',CHOPT
-
- IF(LRECL.EQ.0) THEN
- PRINT *,'XZGETX. the record length (in bytes) must be given'
- IRC = -1
- RETURN
- ENDIF
-*
-* Open local file, options Output
-*
- ISTAT = 0
- IF(IOPTA.EQ.0) THEN
- CALL SZOPEN(LUNXZO,LOCAL(1:NCHL),LRECL,CHOPL,ISTAT)
- IF(ISTAT.EQ.28.AND.IDEBXZ.GE.-3) PRINT *,'XZGETX. ',
- + 'local file already exists. ',
- + 'Specify option R to replace'
- IF(IDEBXZ.GE.3) PRINT *,'XZGETX. return code ',ISTAT,
- + ' from SZOPEN for ',LOCAL(1:NCHL),' on unit ',LUNXZO
- IF(ISTAT.NE.0) GOTO 95
- ENDIF
-*
-* Ask remote server what type of system it is running
-*
- CHMAIL = 'XZIO :RSYS'
- CALL CZPUTA(CHMAIL,ISTAT)
- CALL CZGETA(CHMAIL,ISTAT)
- IF(INDEX(CHMAIL,'UNIX').NE.0) THEN
- RDIO = .TRUE.
- CHOPR = 'UD'
- IF(IOPTC.NE.0) CHOPR = 'CUD'
- ELSE
- RDIO = .FALSE.
- CHOPR = 'U'
- ENDIF
-
-*
-* Check if remote file exists; try to get its record length
-*
- NODE = CUNODE
- CHNODE(LUNXZI) = NODE
- JSKIN(LUNXZI) = ISKIN
- JSKOUT(LUNXZI) = ISKOUT
- CALL XZOPEN(LUNXZI,REMOTE(1:NCHR),NODE,LRECL,CHOPR,IRC)
- IF(IDEBXZ.GE.3) PRINT *,'XZGETX. return code ',ISTAT,
- + ' from XZOPEN for ',REMOTE(1:NCHR),' on unit ',LUNXZI
- IF(IRC.NE.0) GOTO 90
-*
-* Start transfer
-*
- NR=0
- NWANT=LRECL
-*
-* Start timer
-*
- IF(IOPTS.NE.0) THEN
- CALL CZRTIM(DELTIM)
- CALL TIMED(T)
- ENDIF
-
- NREC = 0
- 20 NREC = NREC + 1
-
- IF(RDIO) THEN
- IREC = NREC
- ELSE
- IREC = 0
- ENDIF
-
- CALL XZREAD(LUNXZI,IBUFF,IREC,NWANT,NGOT,' ',IRC)
- IF(IRC.EQ.0) THEN
- NR = NR + 1
- NWR = NWANT/IQCHAW
-
- IF(LDIO) THEN
- JREC = NREC
- ELSE
- JREC = 0
- ENDIF
-
- CALL SZRITE(LUNXZO,IBUFF,JREC,NWANT,' ',IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBXZ.GE.0) PRINT *,'XZGETX. error ',IRC, ' from '
- + //'SZRITE'
- GOTO 97
- ENDIF
- GOTO 20
- ELSEIF(IRC.GT.0) THEN
- IF((RDIO).AND.(NR.GT.0)) GOTO 98
- IF(IDEBXZ.GE.0) PRINT *,'XZGETX. error ',IRC,
- + ' from XZREAD'
- GOTO 97
- ENDIF
-
- 98 CONTINUE
-
- CLOSE(LUNXZO)
- CALL XZCLOS(LUNXZI,' ',IRC)
- IF(IDEBXZ.GE.0) PRINT *,' File transfer completed'
- NKILO = NR*LRECL / 1024
- IF(IOPTS.NE.0)THEN
- CALL CZRTIM(DELTIM)
- CALL TIMED(T)
- READ(DELTIM,'(I2,1X,I2,1X,I2)') IHOUR,IMIN,ISEC
- NSECS = ISEC + IMIN*60 + IHOUR*3600
- IF(NSECS.LE.0) NSECS = 1
- RATE = FLOAT(NKILO)/FLOAT(NSECS)
-#include "cspack/xzstat.inc"
- PRINT *,' Transferred ',NR,' records, transfer rate = ',RATE,
- + ' KB/S'
- PRINT *,' Elapsed time = ',DELTIM,' CP time = ',T,' sec.'
- ENDIF
- GO TO 99
-*
-* Error
-*
- 90 PRINT *, ' Cannot open remote file'
- IRC = 1
- GO TO 99
- 95 PRINT *, ' Cannot open local file'
- IRC = 2
- GO TO 99
- 97 PRINT *, 'Problem in transferring file'
- IRC = 3
- CLOSE(LUNXZO)
-*
- 99 END
diff --git a/src/packlib/cspack/xz/xzhrop.F b/src/packlib/cspack/xz/xzhrop.F
deleted file mode 100644
index 8272a08..0000000
--- a/src/packlib/cspack/xz/xzhrop.F
+++ /dev/null
@@ -1,70 +0,0 @@
-*
-* $Id: xzhrop.F,v 1.1.1.1 1996/03/08 15:44:32 mclareni Exp $
-*
-* $Log: xzhrop.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:32 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE XZHROP(LUN,NODE,CHFILE,CHOPT,LRECL,IRC)
- CHARACTER*(*) CHFILE,NODE
-
-#include "cspack/czsock.inc"
-#include "cspack/hcmail.inc"
-#include "cspack/quest.inc"
-#include "cspack/czunit.inc"
-#include "cspack/czopts.inc"
- IRC = 0
-*
-* Does a link already exist to node in question
-*
- LN = LENOCC(NODE)
- LF = LENOCC(CHFILE)
- INODE = ICNTH(NODE(1:LN),CHNODE,MAXSOC)
-*
-* Always fill in node name
-*
- CHNODE(LUN) = NODE(1:LN)
- IF(INODE.EQ.0) THEN
-*
-* Request OPEN
-*
- CALL CZOPEN('zserv',NODE(1:LN),IRC)
- IF(IRC.NE.0) THEN
- PRINT *,'XZHROP. cannot open communications with ',
- + NODE(1:LN)
- GOTO 99
- ENDIF
- JSKIN(LUN) = ISKIN
- JSKOUT(LUN) = ISKOUT
- ELSE
-*
-* Swap to current node
-*
- CALL CZSWAP(NODE(1:LN),0,ISTAT)
- IF(ISTAT.NE.0) THEN
- PRINT *,'XZOPEN. cannot swap to node ',NODE(1:LN)
- RETURN
- ENDIF
- JSKIN(LUN) = ISKIN
- JSKOUT(LUN) = ISKOUT
- ENDIF
- WRITE(CHMAIL,9001) CHFILE(1:LF)
-9001 FORMAT('XZIO :HROP',A64)
- CALL CZPUTA(CHMAIL,ISTAT)
- CHMAIL = ' '
- WRITE(CHMAIL,9002) LUN,LRECL,CHOPT
-9002 FORMAT('XZIO :OLUN',I3,I6,'/',A8,'/')
- CALL CZPUTA(CHMAIL,ISTAT)
-*
-* Get status and record length
-*
- CALL CZGETA(CHMAIL,ISTAT)
-
- READ(CHMAIL,9003) IRC,LRECL
-9003 FORMAT(10X,I3,I6)
-
- CALL CZSWAP(' ',0,ISTAT)
-99 CONTINUE
- END
diff --git a/src/packlib/cspack/xz/xzinit.F b/src/packlib/cspack/xz/xzinit.F
deleted file mode 100644
index 4f16179..0000000
--- a/src/packlib/cspack/xz/xzinit.F
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: xzinit.F,v 1.1.1.1 1996/03/08 15:44:30 mclareni Exp $
-*
-* $Log: xzinit.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:30 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE XZINIT(IPRINT,IDEBUG,LUNI,LUNO)
-#include "cspack/czunit.inc"
-*
-* Set parameters for XZ package: Log unit, log level, I/O units
-*
- IXPRNT = IPRINT
- IDEBXZ = IDEBUG
- LUNXZI = LUNI
- LUNXZO = LUNO
- END
-
diff --git a/src/packlib/cspack/xz/xzinqr.F b/src/packlib/cspack/xz/xzinqr.F
deleted file mode 100644
index 7948b77..0000000
--- a/src/packlib/cspack/xz/xzinqr.F
+++ /dev/null
@@ -1,30 +0,0 @@
-*
-* $Id: xzinqr.F,v 1.1.1.1 1996/03/08 15:44:30 mclareni Exp $
-*
-* $Log: xzinqr.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:30 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE XZINQR(LUN,FNAME,NODE,IEXIST,LRECL,IRC)
-#include "cspack/hcmail.inc"
-#include "cspack/czsock.inc"
-#include "cspack/quest.inc"
- CHARACTER*(*) FNAME,NODE
-*
-* Issue remote INQUIRE. Extra information may be returned via IQUEST
-*
- CALL CZSWAP(NODE,LUN,ISTAT)
- LF = LENOCC(FNAME)
- CHMAIL = 'XZIO :INQR'//FNAME(1:LF)
- CALL CZPUTA(CHMAIL,ISTAT)
-*
-* Read result
-*
-#include "cspack/czmess.inc"
- CALL CZSWAP(' ',0,ISTAT)
-
- IEXIST = IRC
-
- END
diff --git a/src/packlib/cspack/xz/xzitoc.F b/src/packlib/cspack/xz/xzitoc.F
deleted file mode 100644
index 75ebdae..0000000
--- a/src/packlib/cspack/xz/xzitoc.F
+++ /dev/null
@@ -1,39 +0,0 @@
-*
-* $Id: xzitoc.F,v 1.1.1.1 1996/03/08 15:44:32 mclareni Exp $
-*
-* $Log: xzitoc.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:32 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE XZITOC(NUM,STR,JS)
-*
-* Convert integer NUM into character string STR with JS non-blank
-* characters. JS = 1 ... 12
-* Examples: CALL PNVI( -1,STR,JS) -> STR='-1' ; JS = 2
-* CALL PNVI(317,STR,JS) -> STR='317' ; JS = 3
-*
- CHARACTER*(*) STR
- CHARACTER*12 DIG(0:9)*1
- INTEGER ND(12)
- DATA DIG/'0','1','2','3','4','5','6','7','8','9'/
- JS=0
-*
- K=IABS(NUM)
- DO 10 I=1,12
- ND(I)=MOD(K,10)
- K =K/10
- IF(K.EQ.0) GOTO 12
- 10 CONTINUE
- I=12
- 12 STR=' '
- IF(NUM.LT.0) THEN
- JS=JS+1
- STR(JS:JS)='-'
- END IF
- DO 14 J=I,1,-1
- JS=JS+1
- 14 STR(JS:JS)=DIG(ND(J))
- RETURN
- END
diff --git a/src/packlib/cspack/xz/xzlcat.F b/src/packlib/cspack/xz/xzlcat.F
deleted file mode 100644
index e22a626..0000000
--- a/src/packlib/cspack/xz/xzlcat.F
+++ /dev/null
@@ -1,47 +0,0 @@
-*
-* $Id: xzlcat.F,v 1.1.1.1 1996/03/08 15:44:30 mclareni Exp $
-*
-* $Log: xzlcat.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:30 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
-#if defined(CERNLIB_IBMMVS)
- SUBROUTINE XZLCAT(LEVEL,DSN,MAXDSN,FILLED,FLAG)
-* --- ------ ------ ----
-*
-* LEVEL - MVS catalogue level to be listed
-* DSN - character array of length MAXDSN filled up to FILLED
-* FLAG - 1 = more calls needed for full listing
-* - 0 = finished
-* (c) J.H.Peters, DESY, 8.3.1991
-************************************************************************
-
- CHARACTER*(*) LEVEL,DSN(MAXDSN)
- INTEGER MAXDSN,FILLED,FLAG
-
- CHARACTER OUTLINE*133,INLINE*80
- INTEGER RETC,OUTLGTH
-
- FLAG = 1
- INLINE = ' LISTCAT LEVEL('//LEVEL//') NONVSAM'
- FILLED = 0
-
- 1 CALL FORTIDC(INLINE,OUTLINE,OUTLGTH,RETC)
- IF (RETC.EQ.-9999) THEN
- FLAG = 0
- GOTO 99
- ENDIF
- IF (OUTLINE(1:8).EQ.'0NONVSAM') THEN
- FILLED = FILLED + 1
- IF (FILLED.LE.MAXDSN) THEN
- DSN(FILLED) = OUTLINE(18:OUTLGTH)
- IF (FILLED.EQ.MAXDSN) RETURN
- ENDIF
- ENDIF
- GOTO 1
-
- 99 RETURN
- END
-#endif
diff --git a/src/packlib/cspack/xz/xzlcd.F b/src/packlib/cspack/xz/xzlcd.F
deleted file mode 100644
index f5a6b8e..0000000
--- a/src/packlib/cspack/xz/xzlcd.F
+++ /dev/null
@@ -1,102 +0,0 @@
-*
-* $Id: xzlcd.F,v 1.1.1.1 1996/03/08 15:44:30 mclareni Exp $
-*
-* $Log: xzlcd.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:30 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE XZLCD(PATH,IRC)
- CHARACTER*(*) PATH
- CHARACTER*80 CHPATH
-#if defined(CERNLIB_IBMMVS)
- LPATH = LENOCC(PATH)
- CALL XZPREF(PATH(1:LPATH),IRC)
-#endif
-#if defined(CERNLIB_IBMVM)
- DATA NENTRY/0/
- CHARACTER*80 LINE
- CHARACTER*8 CHUSER
- INTEGER FMUSER
- NENTRY = 1
- LPATH = LENOCC(PATH)
- IF(LPATH.EQ.0) THEN
- IRC = 1
- RETURN
- ENDIF
- IDOT = INDEX(PATH(1:LPATH),'.')
- IF(IDOT.NE.0) PATH(IDOT:IDOT) = ' '
- CALL VMCMS('EXEC GIME '//PATH(1:LPATH)//' (STACK',IRC)
-*
-* Return code 4 is only a warning - existing link exists
-*
- IF(IRC.GT.4) THEN
- RETURN
- ELSE
- CALL VMRTRM(LINE,IRC)
- CALL VMCMS('EXEC SWAPMODE A '//LINE(1:1),IRC)
- PRINT *,'Local directory changed to ',PATH(1:LPATH)
- CHPATH = PATH(1:LPATH)
- ENDIF
- RETURN
-
-#endif
-#if defined(CERNLIB_VAXVMS)||defined(CERNLIB_UNIX)
- INTEGER SETDEF
- INTEGER CHDIR
- INTEGER CHDIRF
- COMMON/SLATE/IS(40)
- LPATH = LENOCC(PATH)
- CHPATH = PATH(1:LPATH)
-#endif
-#if defined(CERNLIB_UNIX)
- CALL CUTOL(CHPATH)
-#endif
-#if defined(CERNLIB_MIPS)
- LPATH = LPATH + 1
- CHPATH(LPATH:LPATH) = CHAR(0)
-#endif
-#if defined(CERNLIB_UNIX)
- IRC = CHDIRF(CHPATH(1:LPATH))
-#endif
-#if defined(CERNLIB_VAXVMS)
- IRC = SETDEF(CHPATH(1:LPATH))
-#endif
-#if defined(CERNLIB_VAXVMS)||defined(CERNLIB_UNIX)||defined(CERNLIB_IBMMVS)
- IF(IRC.EQ.0) THEN
- PRINT *,'Local directory changed to ',PATH(1:LPATH)
- ELSE
- Print *,'Error setting remote directory'
- ENDIF
- RETURN
-#endif
-
- ENTRY XZLPWD(PATH,IRC)
-#if defined(CERNLIB_IBMMVS)
- IF(NENTRY.EQ.0) PATH = ' '
- CALL XZRPRE(PATH,IRC)
-#endif
-#if defined(CERNLIB_IBMVM)
- IF(NENTRY.EQ.0) THEN
- CALL CFILL(' ',CHPATH,1,80)
- ISTAT = FMUSER(CHUSER)
- CHPATH = CHUSER
- LPATH = LENOCC(CHPATH)
- CHPATH(LPATH+2:LPATH+4) = '191'
- LPATH = LPATH + 4
- ENDIF
-#endif
-#if defined(CERNLIB_UNIX)
- CALL GETWDF(CHPATH)
- LPATH = IS(1)
-#endif
-#if defined(CERNLIB_VAXVMS)
- CHPATH = ' '
- CALL GETDEF(CHPATH)
- LPATH = LENOCC(CHPATH)
-#endif
- Print *,'Current working directory is ',CHPATH(1:LPATH)
- PATH = CHPATH(1:LPATH)
- END
-
diff --git a/src/packlib/cspack/xz/xzlls.F b/src/packlib/cspack/xz/xzlls.F
deleted file mode 100644
index c983b84..0000000
--- a/src/packlib/cspack/xz/xzlls.F
+++ /dev/null
@@ -1,220 +0,0 @@
-*
-* $Id: xzlls.F,v 1.1.1.1 1996/03/08 15:44:30 mclareni Exp $
-*
-* $Log: xzlls.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:30 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE XZLLS(CHPATT,FILES,NMAX,NFOUND,ICONT,CHOPT,IRC)
-#include "cspack/czsock.inc"
-#include "cspack/czunit.inc"
-#include "cspack/hcmail.inc"
-#include "cspack/quest.inc"
- CHARACTER*(*) FILES(NMAX)
- CHARACTER*(*) CHPATT
- CHARACTER*255 CHLIST
- CHARACTER*255 CHFILE,CHDEF
- CHARACTER*255 COMM
- CHARACTER*8 CHRAND
- CHARACTER*2 CHOPTT
- CHARACTER*255 CHLOG,CHERR
- CHARACTER*255 CHHOME
- COMMON/SLATE/IS(40)
- INTEGER SYSTEMF
- LOGICAL IEXIST
- SAVE NDONE
-*
-#if defined(CERNLIB_VAXVMS)
- INCLUDE '($RMSDEF)'
- INTEGER SYS$GETMSG
- CHARACTER*255 CHDIR
-#endif
-#include "cspack/czopts.inc"
-*
-* Return files matching pattern CHPATT
-*
- IRC = 0
- LPATT = LENOCC(CHPATT)
- IF(LPATT.EQ.0) THEN
-#if defined(CERNLIB_IBM)||defined(CERNLIB_UNIX)
- LPATT = 1
- CHLIST = ' '
- ELSE
- CHLIST = CHPATT(1:LPATT)
-#endif
-#if defined(CERNLIB_VAXVMS)
- LPATT = 3
- CHLIST = '*.*'
- ELSE
- CHLIST = CHPATT(1:LPATT)
- IF((CHPATT(LPATT:LPATT).EQ.':').OR.
- + (CHPATT(LPATT:LPATT).EQ.'>').OR.
- + (CHPATT(LPATT:LPATT).EQ.']')) THEN
- CHLIST(LPATT+1:LPATT+3) = '*.*'
- LPATT = LPATT + 3
- ENDIF
- IF(INDEX(CHPATT(1:LPATT),'.').EQ.0) THEN
- CHPATT(LPATT+1:LPATT+2) = '.*'
- LPATT = LPATT + 2
- ENDIF
-#endif
- ENDIF
-#if defined(CERNLIB_UNIX)
- CALL CUTOL(CHLIST)
-#endif
- IF(IDEBXZ.GE.1) PRINT *,'XZLLS. enter for path = ',
- + CHLIST(1:LPATT)
- NERR = 0
- NFOUND = 0
- CHOPTT = ' '
- COMM = ' '
- IF(IOPTL.NE.0) CHOPTT = '-l'
-#if defined(CERNLIB_UNIX)
- CALL GETENVF('HOME',CHHOME)
- LHOME = IS(1)
- CALL CZRAND(CHRAND)
- CHLOG = CHHOME(1:LHOME)//'/'//CHRAND//'zftp.tmp'
- CHERR = CHHOME(1:LHOME)//'/'//CHRAND//'zftp.err'
- LLOG = LENOCC(CHLOG)
- LERR = LLOG
- INQUIRE(FILE=CHLOG(1:LLOG),EXIST=IEXIST)
- IF(.NOT.IEXIST.OR.ICONT.EQ.0) THEN
- WRITE(COMM,9001) CHOPTT,CHLIST(1:LPATT),
- + CHLOG(1:LLOG),CHERR(1:LERR)
- 9001 FORMAT('ls ',A,' ',A,' >',A,' 2>',A)
- IC = SYSTEMF(COMM)
- NDONE = 0
- ENDIF
-
- OPEN(LUNXZI,FILE=CHLOG(1:LLOG),FORM='FORMATTED',
- + STATUS='OLD',IOSTAT=ISTAT)
- IF(ISTAT.NE.0) GOTO 99
- ISKIP = 0
-10 CONTINUE
- READ(LUNXZI,'(A)',END=98) CHFILE
- ISKIP = ISKIP + 1
- IF(ISKIP.LT.NDONE) THEN
- GOTO 10
- ENDIF
- NFOUND = NFOUND + 1
- IF(NFOUND.GT.NMAX) THEN
- NFOUND = NMAX
- IRC = -1
- ICONT = 1
- GOTO 98
- ENDIF
- NDONE = NDONE + 1
- FILES(NFOUND) = CHFILE(1:LENOCC(CHFILE))
- GOTO 10
-#endif
-#if (defined(CERNLIB_UNIX))&&(!defined(CERNLIB_APOLLO))
-98 CLOSE(LUNXZI,STATUS='DELETE')
-#endif
-#if (defined(CERNLIB_UNIX))&&(defined(CERNLIB_APOLLO))
-98 CLOSE(LUNXZI)
-#endif
-#if defined(CERNLIB_UNIX)
- IF(NFOUND.EQ.0) THEN
- IRC = 1
- OPEN(LUNXZI,FILE=CHERR(1:LERR),FORM='FORMATTED',
- + STATUS='OLD')
-11 CONTINUE
- READ(LUNXZI,'(A)',END=97) CHFILE
- NFOUND = NFOUND + 1
- NERR = NERR + 1
- FILES(NFOUND) = CHFILE(1:LENOCC(CHFILE))
- GOTO 11
-#endif
-#if (defined(CERNLIB_UNIX))&&(!defined(CERNLIB_APOLLO))
-97 CLOSE(LUNXZI,STATUS='DELETE')
-#endif
-#if (defined(CERNLIB_UNIX))&&(defined(CERNLIB_APOLLO))
-97 CLOSE(LUNXZI)
-#endif
-#if defined(CERNLIB_UNIX)
- IF(NERR.EQ.0) IRC = 0
- ELSE
-*
-* Remove error file
-*
- IC = UNLINKF(CHERR(1:LERR))
- ENDIF
-#endif
-#if defined(CERNLIB_VAXVMS)
- CHDEF = ' '
- CALL GETDEF(CHDEF)
- LDEF = LENOCC(CHDEF)
-10 CONTINUE
- CHFILE = ' '
- IF ((LDEF.NE.0) .AND.
- + (INDEX(CHPATT(1:LPATT),':').EQ.0).AND.
- + (INDEX(CHPATT(1:LPATT),'>').EQ.0).AND.
- + (INDEX(CHPATT(1:LPATT),'-').EQ.0)) THEN
- ISTAT = LIB$FIND_FILE(CHDEF(1:LDEF)//
- + CHLIST(1:LPATT),CHFILE,ICONT)
- ELSE
- ISTAT = LIB$FIND_FILE(CHLIST(1:LPATT),CHFILE,ICONT)
- ENDIF
-*
-* Check for RMS$_DNF - directory not found
-* RMS$_FNF - file not found
-* RMS$_NMF - no more files
-*
- IF(ISTAT.EQ.RMS$_DNF) THEN
- CALL LIB$FIND_FILE_END(ICONT)
- IRC = ISTAT
- GOTO 99
- ELSEIF(ISTAT.EQ.RMS$_FNF) THEN
- CALL LIB$FIND_FILE_END(ICONT)
- GOTO 99
- ELSEIF(ISTAT.EQ.RMS$_NMF) THEN
- CALL LIB$FIND_FILE_END(ICONT)
- GOTO 99
- ENDIF
-
- IF(.NOT.ISTAT) THEN
- IRC = SYS$GETMSG(%VAL(ISTAT),LFILE,CHFILE,,)
- PRINT *,'XZLLS. error from LIB$FIND_FILE = ',CHFILE(1:LFILE)
- IRC = ISTAT
- ISTAT = LIB$FIND_FILE_END(ICONT)
- GOTO 99
- ELSE
- NFOUND = NFOUND + 1
- IF(NFOUND.GT.NMAX) GOTO 99
- FILES(NFOUND) = CHFILE(1:LENOCC(CHFILE))
- GOTO 10
- ENDIF
-
-#endif
-#if defined(CERNLIB_IBMVM)
- IF(ICONT.EQ.0) NDONE = 0
- CALL CTRANS('.',' ',CHPATT,1,LPATT)
- IF(IOPTL.EQ.0) THEN
- CALL VMCMS('LISTFILE '//CHPATT(1:LPATT)//'(STACK',IRC)
- ELSE
- CALL VMCMS('LISTFILE '//CHPATT(1:LPATT)//'(STACK L',IRC)
- ENDIF
- CALL VMCMS('SENTRIES',NFOUND)
- DO 10 I=1,NFOUND
- CALL VMRTRM(CHFILE,LFILE)
- IF(I.LE.NDONE) GOTO 10
- IF(I.GT.NMAX) THEN
- IRC = -1
- ICONT = 1
- GOTO 99
- ENDIF
- FILES(I) = CHFILE(1:LFILE)
- NDONE = NDONE + 1
-10 CONTINUE
-#endif
-#if defined(CERNLIB_IBMMVS)
- CALL XZMVSD(CHPATT,CHLIST,LLIST,ICUT,IRC)
-
- IFLAG = 0
- IFILL = 0
-1 CONTINUE
- CALL XZLCAT(CHLIST(1:LLIST),FILES,NMAX,NDONE,ICONT)
-#endif
-99 END
diff --git a/src/packlib/cspack/xz/xzlmv.F b/src/packlib/cspack/xz/xzlmv.F
deleted file mode 100644
index 7d5cc06..0000000
--- a/src/packlib/cspack/xz/xzlmv.F
+++ /dev/null
@@ -1,92 +0,0 @@
-*
-* $Id: xzlmv.F,v 1.1.1.1 1996/03/08 15:44:30 mclareni Exp $
-*
-* $Log: xzlmv.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:30 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE XZLMV(LOCAL,REMOTE,CHOPT,IRC)
- CHARACTER*(*) LOCAL,REMOTE
- CHARACTER*255 CHSRC,CHDST
-#include "cspack/czunit.inc"
-#if defined(CERNLIB_VAXVMS)
- CHARACTER*255 CHMESS
-#endif
-#if defined(CERNLIB_UNIX)
- CHARACTER*255 CHCOMM,CHLOG,CHERR
- INTEGER SYSTEMF
-#include "cspack/slate.inc"
-#include "cspack/czhome.inc"
-#endif
-#include "cspack/czopts.inc"
-
- LSRC = LENOCC(LOCAL)
- LDST = LENOCC(REMOTE)
- CHSRC = LOCAL(1:LSRC)
- CHDST = REMOTE(1:LDST)
-#if defined(CERNLIB_IBMVM)
- CALL CTRANS('.',' ',CHSRC,1,LSRC)
- CALL CTRANS('.',' ',CHDST,1,LDST)
- CALL VMCMS('RENAME '//CHSRC(1:LSRC)//' '//CHDST(1:LDST),IRC)
-#endif
-#if defined(CERNLIB_VAXVMS)
- ISTAT = LIB$RENAME_FILE(CHSRC(1:LSRC),CHDST(1:LDST),,,,,,,,,,)
- IF(.NOT.ISTAT) THEN
- IC = SYS$GETMSG(%VAL(ISTAT),LMESS,CHMESS,,)
- PRINT *,'XZLMV. error from LIB$RENAME_FILE = ',
- + CHMESS(1:LMESS)
- IRC = ISTAT
- ELSE
- IRC = 0
- ENDIF
-#endif
-#if defined(CERNLIB_UNIX)
- IF(IOPTC.EQ.0) THEN
- CALL CUTOL(CHSRC(1:LSRC))
- CALL CUTOL(CHDST(1:LDST))
- ENDIF
- CALL GETENVF('HOME',CHHOME)
- LHOME = IS(1)
- CHLOG = CHHOME(1:LHOME)//'/zftp.tmp'
- CHERR = CHHOME(1:LHOME)//'/zftp.err'
- LLOG = LENOCC(CHLOG)
- LERR = LLOG
- WRITE(CHCOMM,9001) CHSRC(1:LSRC),CHDST(1:LDST),
- + CHLOG(1:LLOG),CHERR(1:LERR)
- 9001 FORMAT('mv ',A,' ',A,' >',A,' 2>',A)
- IC = SYSTEMF(CHCOMM)
- OPEN(LUNXZI,FILE=CHLOG(1:LLOG),FORM='FORMATTED',
- + STATUS='OLD')
- 10 CONTINUE
- READ(LUNXZI,'(A)',END=20) CHCOMM
- PRINT *,'XZLMV. error from mv = ',
- + CHCOMM(1:LENOCC(CHCOMM))
- GOTO 10
-#endif
-#if (defined(CERNLIB_UNIX))&&(!defined(CERNLIB_APOLLO))
- 20 CLOSE(LUNXZI,STATUS='DELETE')
-#endif
-#if (defined(CERNLIB_UNIX))&&(defined(CERNLIB_APOLLO))
- 20 CLOSE(LUNXZI)
-#endif
-#if defined(CERNLIB_UNIX)
- NERR = 0
- OPEN(LUNXZI,FILE=CHERR(1:LERR),FORM='FORMATTED',
- + STATUS='OLD')
- 30 CONTINUE
- READ(LUNXZI,'(A)',END=40) CHCOMM
- NERR = NERR + 1
- PRINT *,'XZLMV. error from mv = ',
- + CHCOMM(1:LENOCC(CHCOMM))
- GOTO 30
-#endif
-#if (defined(CERNLIB_UNIX))&&(!defined(CERNLIB_APOLLO))
- 40 CLOSE(LUNXZI,STATUS='DELETE')
-#endif
-#if (defined(CERNLIB_UNIX))&&(defined(CERNLIB_APOLLO))
- 40 CLOSE(LUNXZI)
- IRC = NERR
-#endif
- END
diff --git a/src/packlib/cspack/xz/xzlogl.F b/src/packlib/cspack/xz/xzlogl.F
deleted file mode 100644
index 572833d..0000000
--- a/src/packlib/cspack/xz/xzlogl.F
+++ /dev/null
@@ -1,14 +0,0 @@
-*
-* $Id: xzlogl.F,v 1.1.1.1 1996/03/08 15:44:31 mclareni Exp $
-*
-* $Log: xzlogl.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:31 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE XZLOGL(ILOG)
-#include "cspack/czunit.inc"
- IDEBXZ = ILOG
- IF(IDEBXZ.GE.-2) PRINT *,'XZLOGL. Setting log level to ',IDEBXZ
- END
diff --git a/src/packlib/cspack/xz/xzlrm.F b/src/packlib/cspack/xz/xzlrm.F
deleted file mode 100644
index 9b938ae..0000000
--- a/src/packlib/cspack/xz/xzlrm.F
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: xzlrm.F,v 1.1.1.1 1996/03/08 15:44:31 mclareni Exp $
-*
-* $Log: xzlrm.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:31 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE XZLRM(FNAME,IRC)
- CHARACTER*(*) FNAME
- CHARACTER*255 CHFORM
- LOGICAL IEXIST
-#include "cspack/czunit.inc"
-*
-* Check if file exists
-*
- LF=LENOCC(FNAME)
- INQUIRE(FILE=FNAME(1:LF),EXIST=IEXIST,
- + FORM=CHFORM)
- IF(.NOT.IEXIST) GOTO 99
-
- IF(INDEX(CHFORM,'FORMATTED').EQ.0) THEN
- OPEN(LUNXZI,FILE=FNAME,STATUS='OLD',ERR=99)
- ELSE
- OPEN(LUNXZI,FILE=FNAME,STATUS='OLD',FORM=CHFORM,ERR=99)
- ENDIF
- CLOSE(LUNXZI,STATUS='DELETE',ERR=99)
- IRC = 0
- RETURN
-99 IRC = 1
- END
-
diff --git a/src/packlib/cspack/xz/xzls.F b/src/packlib/cspack/xz/xzls.F
deleted file mode 100644
index 81503a0..0000000
--- a/src/packlib/cspack/xz/xzls.F
+++ /dev/null
@@ -1,80 +0,0 @@
-*
-* $Id: xzls.F,v 1.1.1.1 1996/03/08 15:44:31 mclareni Exp $
-*
-* $Log: xzls.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:31 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE XZLS(PATH,FILES,NMAX,NFILES,ICONT,CHOPT,IRC)
-#include "cspack/czsock.inc"
-#include "cspack/hcmail.inc"
-#include "cspack/quest.inc"
- CHARACTER*(*) PATH,FILES(NMAX)
- CHARACTER*255 CHPATH
- CHARACTER*8 CHOPTT
-*
-#include "cspack/czopts.inc"
-#include "cspack/czopen.inc"
- IRC = 0
- NFILES = 0
- IF(ICONT.NE.0) GOTO 10
- LPATH = LENOCC(PATH)
- NCH = LENOCC(CHOPT)
-
- IF(LPATH.EQ.0) THEN
- CHPATH = ' '
- LPATH = 1
- ELSE
- CHPATH = PATH(1:LPATH)
- ENDIF
-
- CHOPTT = CHOPT
- IF(NCH.EQ.0) THEN
- CHOPTT = ' '
- NCH = 1
- ENDIF
-*
- CHMAIL = 'XZIO :LS '//CHPATH(1:LPATH) // '('
- + // CHOPTT(1:NCH) // ')'
-
- CALL CZPUTA(CHMAIL,ISTAT)
-*
-* Process server messages
-*
- 10 CONTINUE
- CALL CZGETA(CHMAIL,ISTAT)
- IF(ISTAT.NE.0) THEN
- IRC = 99
- GOTO 99
- ENDIF
-
- LCH = LENOCC(CHMAIL)
- IF(CHMAIL(1:1).EQ.'0') THEN
-*
-* Nop
-*
- ELSEIF(CHMAIL(1:1).EQ.'1') THEN
- PRINT *,CHMAIL(2:LCH)
- ELSEIF(CHMAIL(1:1).EQ.'2') THEN
- NFILES = NFILES + 1
- IF(NFILES.LE.NMAX) THEN
- FILES(NFILES) = CHMAIL(2:LCH)
- ELSE
- IRC = -1
- ICONT = 1
- RETURN
- ENDIF
- GOTO 10
- ELSEIF(CHMAIL(1:1).EQ.'3') THEN
- PRINT *,CHMAIL(2:LCH)
- IQUEST(1) = 1
- IRC = 1
- ELSE
- PRINT *,'Unknown server message ',CHMAIL
- IQUEST(1) = 1
- IRC = 1
- ENDIF
-*
- 99 END
diff --git a/src/packlib/cspack/xz/xzlsys.F b/src/packlib/cspack/xz/xzlsys.F
deleted file mode 100644
index beda35b..0000000
--- a/src/packlib/cspack/xz/xzlsys.F
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: xzlsys.F,v 1.1.1.1 1996/03/08 15:44:31 mclareni Exp $
-*
-* $Log: xzlsys.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:31 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE XZLSYS
-*-- Author : Jamie Shiers 17/07/91
- PRINT *,'Local operating system:'
-#if defined(CERNLIB_IBMVM)
- PRINT *,'VM'
-#endif
-#if defined(CERNLIB_IBMMVS)
- PRINT *,'MVS'
-#endif
-#if defined(CERNLIB_VAXVMS)
- PRINT *,'VMS'
-#endif
-#if defined(CERNLIB_UNIX)
- PRINT *,'UNIX'
-#endif
- END
diff --git a/src/packlib/cspack/xz/xzmv.F b/src/packlib/cspack/xz/xzmv.F
deleted file mode 100644
index 8ce1166..0000000
--- a/src/packlib/cspack/xz/xzmv.F
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: xzmv.F,v 1.1.1.1 1996/03/08 15:44:31 mclareni Exp $
-*
-* $Log: xzmv.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:31 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE XZMV(CHSRC,CHTGT,CHOPT,IRC)
-#include "cspack/czsock.inc"
-#include "cspack/hcmail.inc"
-#include "cspack/quest.inc"
- CHARACTER*(*) CHSRC,CHTGT
- CHARACTER*8 CHOPTT
-*
-#include "cspack/czopts.inc"
-#include "cspack/czopen.inc"
- IRC = 0
- CHOPTT = ' '
- LOPT = LENOCC(CHOPT)
- IF(LOPT.GT.0) CHOPTT = CHOPT(1:LOPT)
-*
- CHMAIL = 'XZIO :MV /'//CHOPTT//'/'
- CALL CZPUTA(CHMAIL,ISTAT)
- LCHSRC = LENOCC(CHSRC)
- LCHTGT = LENOCC(CHTGT)
- CHMAIL = CHSRC(1:LCHSRC)
- CALL CZPUTA(CHMAIL,ISTAT)
- CHMAIL = CHTGT(1:LCHTGT)
- CALL CZPUTA(CHMAIL,ISTAT)
-#include "cspack/czmess.inc"
-*
- 99 END
diff --git a/src/packlib/cspack/xz/xzmvsd.F b/src/packlib/cspack/xz/xzmvsd.F
deleted file mode 100644
index 80f8bea..0000000
--- a/src/packlib/cspack/xz/xzmvsd.F
+++ /dev/null
@@ -1,72 +0,0 @@
-*
-* $Id: xzmvsd.F,v 1.1.1.1 1996/03/08 15:44:31 mclareni Exp $
-*
-* $Log: xzmvsd.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:31 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
-#if defined(CERNLIB_IBMMVS)
- SUBROUTINE XZMVSD(CDSNIN,CDSNOUT,LDSNOUT,ICUT,IRC)
-* **************************************************
-*
-* Returns dataset name with high level qualifier
-*
-* INPUT : CDSNIN , dataset name without high level qualifier
-* OUTPUT: CDSNOUT, dataset with high level qualifier and dot !!!
-* OUTPUT: ICUT , legth of the high level qualifier
-* OUTPUT: IRC , error return code
-*
- CHARACTER*(*) CDSNIN,CDSNOUT
- CHARACTER*80 RPREFI
-
- IRC = 0
- ICUT = 2
- LDSNOUT = LENOCC(CDSNIN)
- CALL CLTOU(CDSNIN(1:LDSNOUT))
- CALL CFILL(' ',CDSNOUT,1,LDSNOUT)
-*
-* Simple Error Checking
-* to overcome some problems with listc
-* cut ending with * or .
- 100 LDSNIN = LENOCC(CDSNIN)
- IF ((CDSNIN(LDSNIN:LDSNIN).EQ.'*')
- 1 .OR.(CDSNIN(LDSNIN:LDSNIN).EQ.'.')) THEN
- CDSNIN(LDSNIN:LDSNIN) = ' '
- LDSNIN = LDSNIN - 1
- ELSE
- GOTO 200
- ENDIF
- GOTO 100
-
- 200 CONTINUE
-
- IF(LDSNIN.EQ.0) THEN
-C -------------------------------- no dataset specification
-C -------------------------------- use XZRPRE
- CALL XZRPRE(RPREFI,LRPREFI)
- CDSNOUT = RPREFI(1:LRPREFI)
- LDSNOUT = LRPREFI - 1
- ICUT = LRPREFI
- ELSE
-C -------------------------------- dataset is specified
- IF (CDSNIN(1:1).EQ.'.') THEN
-C ------------------------------ dataset is full specified
- CDSNOUT = CDSNIN(1:LDSNIN)
- LDSNOUT = LDSNIN
- ICUT = 1
- ELSE
-C ------------------------------ dataset is not full
-C ------------------------------ specified add XZRPRE
- CALL XZRPRE(RPREFI,LRPREFI)
-
- CDSNOUT = RPREFI(1:LRPREFI) // CDSNIN(1:LDSNIN)
- LDSNOUT = LRPREFI+LDSNIN
- ICUT = LRPREFI
- ENDIF
- ENDIF
-
- RETURN
- END
-#endif
diff --git a/src/packlib/cspack/xz/xzopen.F b/src/packlib/cspack/xz/xzopen.F
deleted file mode 100644
index 134e7f8..0000000
--- a/src/packlib/cspack/xz/xzopen.F
+++ /dev/null
@@ -1,88 +0,0 @@
-*
-* $Id: xzopen.F,v 1.1.1.1 1996/03/08 15:44:31 mclareni Exp $
-*
-* $Log: xzopen.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:31 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE XZOPEN(LUN,FNAME,NODE,LRECL,CHOPT,IRC)
-#include "cspack/czsock.inc"
-#include "cspack/hcmail.inc"
-#include "cspack/quest.inc"
-#include "cspack/czunit.inc"
- CHARACTER*(*) FNAME,NODE
- CHARACTER*8 CHOPE
-*
-* Open file on unit LUN. If no connection exists to specified
-* node, start one using CZOPEN.
-* CHOPT: C - respect case
-* D - D/A file, LRECL must be specified if N is also given
-* F - formatted file (default=unformatted)
-* N - new file
-*
-#include "cspack/czopts.inc"
- IRC = 0
-*
-* Does a link already exist to node in question
-*
- LN = LENOCC(NODE)
- LF = LENOCC(FNAME)
- LC = LENOCC(CHOPT)
- INODE = ICNTH(NODE(1:LN),CHNODE,MAXSOC)
-*
-* Always fill in node name
-*
- CHNODE(LUN) = NODE(1:LN)
- IF(INODE.EQ.0) THEN
-*
-* Request OPEN
-*
- CALL CZOPEN('zserv',NODE(1:LN),IRC)
- IF(IRC.NE.0) THEN
- PRINT *,'XZOPEN. cannot open communications with ',
- + NODE(1:LN)
- GOTO 99
- ENDIF
- JSKIN(LUN) = ISKIN
- JSKOUT(LUN) = ISKOUT
- ELSE
-*
-* Swap to current node
-*
- CALL CZSWAP(NODE(1:LN),0,ISTAT)
- IF(ISTAT.NE.0) THEN
- PRINT *,'XZOPEN. cannot swap to node ',NODE(1:LN)
- RETURN
- ENDIF
- JSKIN(LUN) = ISKIN
- JSKOUT(LUN) = ISKOUT
- ENDIF
-*
-* Handle long file names...
-*
- IF(LF.LE.64) THEN
- WRITE(CHMAIL,9001) FNAME(1:LF)
-9001 FORMAT('XZIO :OPEN',A64)
- CALL CZPUTA(CHMAIL,ISTAT)
- ELSE
- WRITE(CHMAIL,9001) '_'
- CALL CZPUTA(CHMAIL,ISTAT)
- CALL CZPUTA(FNAME(1:LF),ISTAT)
- ENDIF
- CHOPE = ' '
- LCH = LENOCC(CHOPT)
- IF(LCH.GT.0) CHOPE = CHOPT(1:LCH)
- CALL CFILL(' ',CHMAIL,1,80)
- WRITE(CHMAIL,9002) LUN,LRECL,CHOPE
-9002 FORMAT('XZIO :OLUN',I3,I6,'/',A8,'/')
- CALL CZPUTA(CHMAIL,ISTAT)
-*
-* Check status
-*
-#include "cspack/czmess.inc"
-
- CALL CZSWAP(' ',0,ISTAT)
-99 CONTINUE
- END
diff --git a/src/packlib/cspack/xz/xzpref.F b/src/packlib/cspack/xz/xzpref.F
deleted file mode 100644
index 07c3428..0000000
--- a/src/packlib/cspack/xz/xzpref.F
+++ /dev/null
@@ -1,78 +0,0 @@
-*
-* $Id: xzpref.F,v 1.1.1.1 1996/03/08 15:44:31 mclareni Exp $
-*
-* $Log: xzpref.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:31 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
-#if defined(CERNLIB_IBMMVS)
- SUBROUTINE XZPREF(CPREFI,IRC)
-* ******************************
-*
-* change MVS prefix
-*
-*
- CHARACTER*(*) CPREFI
- CHARACTER*(*) RPREFI
- CHARACTER*80 SPREFI
-
- SAVE SPREFI
-
- IRC = 0
- LCPREFI = LENOCC(CPREFI)
-
-
- IF (SPREFI(1:1).NE.'.') THEN
-C ----------------------------- set to default
- CALL KPREFI(SPREFI,LSPREFI)
- SPREFI(1:(LSPREFI+1))= '.'//SPREFI(:LSPREFI)
- LSPREFI = LSPREFI + 1
- ENDIF
-
- IF (LCPREFI.EQ.0) GOTO 99
-C ----------------------------- nothing to change
-*
-* create new prefix
-*
- IF ( CPREFI(1:1) .EQ. '.' ) THEN
-C ----------------------------- new MVS high level qualifier
- IF (LCPREFI.LT.5) GOTO 99
-C ----------------------------- no MVS high level qualifier
- CALL CFILL(' ',SPREFI,1,80)
- SPREFI = CPREFI(1:LCPREFI)
- ELSE
-C ----------------------------- add sub structure
- SPREFI(1:(LSPREFI+LCPREFI))
- 1 = SPREFI(1:LSPREFI)//CPREFI(1:LCPREFI)
- ENDIF
-
- LSPREFI = LENOCC(SPREFI)
- IF (SPREFI(LSPREFI:LSPREFI).NE.'.') THEN
-C ----------------------------- add last dot
- LSPREFI=LSPREFI +1
- SPREFI(LSPREFI:LSPREFI) = '.'
- ENDIF
-
- 99 RETURN
-
-
- ENTRY XZRPRE(RPREFI,LRPREFI)
-* ****************************
-*
-* read prefix
-*
- IF (SPREFI(1:1).NE.'.') THEN
-C ----------------------------- set to default
- CALL KPREFI(SPREFI,LSPREFI)
- SPREFI(1:(LSPREFI+1))= '.'//SPREFI(:LSPREFI)
- LSPREFI = LSPREFI + 1
- ENDIF
-
- RPREFI = SPREFI
- LRPREFI = LENOCC(SPREFI)
-
- RETURN
- END
-#endif
diff --git a/src/packlib/cspack/xz/xzprot.F b/src/packlib/cspack/xz/xzprot.F
deleted file mode 100644
index 1dc0978..0000000
--- a/src/packlib/cspack/xz/xzprot.F
+++ /dev/null
@@ -1,118 +0,0 @@
-*
-* $Id: xzprot.F,v 1.1.1.1 1996/03/08 15:44:31 mclareni Exp $
-*
-* $Log: xzprot.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:31 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
-#if defined(CERNLIB_VAXVMS)
- integer function xzprot(fab,rab,lun)
-*-- Author : Jamie Shiers 02/08/91
-#include "cspack/vmsprot.inc"
- character*30 spaces
- include '($fabdef)'
- include '($rabdef)'
- include '($xabdef)'
- include '($xabdatdef)'
- include '($xabprodef)'
-
- record /fabdef/ fab
- record /rabdef/ rab
-
- structure /xabdat/
- byte xab$b_cod
- byte xab$b_bln
- integer*2 %fill
- integer*4 xab$l_nxt
- integer*2 xab$w_rvn
- integer*2 %fill
- integer*4 xab$q_rdt(2)
- integer*4 xab$q_cdt(2)
- integer*4 xab$q_edt(2)
- integer*4 xab$q_bdt(2)
- end structure
-
- structure /xabpro/
- byte xab$b_cod
- byte xab$b_bln
- integer*2 %fill
- integer*4 %fill
- integer*2 xab$w_pro
- byte xab$b_mtacc
- byte xab$b_prot_opt
- union
- map
- integer*4 xab$l_uic ! UIC CODE
- end map
- map
- integer*2 xab$w_mbm ! MEMBER CODE
- integer*2 xab$w_grp ! GROUP CODE
- end map
- end union
- union
- map
- integer*4 xab$q_prot_mode(2)
- end map
- map
- byte xab$b_prot_mode
- end map
- end union
- integer*4 xab$l_aclbuf
- integer*2 xab$w_aclsiz
- integer*2 xab$w_acllen
- integer*4 xab$l_aclctx
- integer*4 xab$l_aclsts
- integer*4 %fill
- integer*4 %fill
- integer*4 %fill
- integer*4 %fill
- integer*4 %fill
- integer*4 %fill
- integer*4 %fill
- integer*4 %fill
- integer*4 %fill
- integer*4 %fill
- integer*4 %fill
- integer*4 %fill
- end structure
-
- record /xabdat/ xab
- record /xabpro/ xab1
- integer status,lun,sys$open,sys$close,recfm
-
- xab.xab$b_cod = xab$c_dat
- xab.xab$b_bln = xab$c_datlen
- fab.fab$l_xab = %loc(xab.xab$b_cod)
- xab.xab$l_nxt = %loc(xab1.xab$b_cod)
- xab1.xab$b_cod = xab$c_pro
- xab1.xab$b_bln = xab$c_prolen
-*
-* Set file protection mask
-* Bit is set to deny access of specified type
-*
-* File protection mask is passed in IPROT(16)
-* system,owner,group,world
-* IPROT(J) = 0 for access, /= 0 for no access
-*
- lprot = 1
- do 10 j=0,12,4
-
- if(iprot(j+1).ne.0) xab1.xab$w_pro =
- + ibset(xab1.xab$w_pro,j+xab$v_noread)
- if(iprot(j+2).ne.0) xab1.xab$w_pro =
- + ibset(xab1.xab$w_pro,j+xab$v_nowrite)
- if(iprot(j+3).ne.0) xab1.xab$w_pro =
- + ibset(xab1.xab$w_pro,j+xab$v_noexe)
- if(iprot(j+4).ne.0) xab1.xab$w_pro =
- + ibset(xab1.xab$w_pro,j+xab$v_nodel)
-
-10 continue
-
- xzprot = sys$create(fab)
- if(xzprot) status = sys$connect(rab)
-
- end
-
-#endif
diff --git a/src/packlib/cspack/xz/xzputa.F b/src/packlib/cspack/xz/xzputa.F
deleted file mode 100644
index 0f83a78..0000000
--- a/src/packlib/cspack/xz/xzputa.F
+++ /dev/null
@@ -1,260 +0,0 @@
-*
-* $Id: xzputa.F,v 1.1.1.1 1996/03/08 15:44:31 mclareni Exp $
-*
-* $Log: xzputa.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:31 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE XZPUTA(LOCAL,REMOTE,CHOPT,IRC)
-*
-* Transfer the text file LOCAL to the remote node as REMOTE
-* CHOPT: V - remote file is created with V format (IBM)
-* S - statistics on the file transfer are printed
-* A - local file has already been opened
-*
-#include "cspack/czunit.inc"
-#include "cspack/hcmail.inc"
-#include "cspack/czsock.inc"
-#include "cspack/czbuff.inc"
-#include "cspack/quest.inc"
- INTEGER SSENDSTR
- CHARACTER*(*) REMOTE,LOCAL
- CHARACTER*8 CHOPTT
- CHARACTER*255 CHLINE
- CHARACTER*255 CHFILE
- CHARACTER*8 DELTIM
- CHARACTER*3077 CHLEN
- DIMENSION NCC(1024)
-#include "cspack/czoptd.inc"
- DATA NCC/1024*-1/
- DATA NENTRY/0/
-#include "cspack/czoptu.inc"
-#include "cspack/czopen.inc"
-#if defined(CERNLIB_IBM)
-*
-* Allow file transfer of RECFM V files
-*
- IF(NENTRY.EQ.0) THEN
- CALL ERRSET(212,256,-1,1,1)
- NENTRY = 1
- ENDIF
-#endif
-
- IRC = 0
-* IMAX = 16240
-* IF(IPROT.EQ.1) IMAX = 432
- IMAX = 16320
- IF(IPROT.EQ.1) IMAX = 512
-*
-* Open local text file
-*
- IOPTV=0
- CHFILE=LOCAL
- ISTAT = 0
- IF(IOPTA.EQ.0) THEN
-#if defined(CERNLIB_UNIX)
- IF(IOPTC.EQ.0) CALL CUTOL(CHFILE)
-#endif
-#if (defined(CERNLIB_UNIX))&&(!defined(CERNLIB_APOLLO))&&(!defined(CERNLIB_OS9))
- OPEN(UNIT=LUNXZI,FILE=CHFILE,FORM='FORMATTED',STATUS='OLD',
- + IOSTAT=ISTAT)
- IF(ISTAT.NE.0) GOTO 95
-#endif
-#if (defined(CERNLIB_UNIX))&&(defined(CERNLIB_APOLLO)||defined(CERNLIB_OS9))
- OPEN(UNIT=LUNXZI,FILE=CHFILE,STATUS='READONLY',IOSTAT=ISTAT)
- IF(ISTAT.NE.0) GOTO 95
-#endif
-#if defined(CERNLIB_VAXVMS)
- OPEN(UNIT=LUNXZI,FILE=CHFILE,STATUS='OLD',READONLY,IOSTAT=ISTAT)
- IF(ISTAT.NE.0) GOTO 95
-#endif
-#if defined(CERNLIB_IBMMVS)
- CALL KUOPEN(LUNXZI,CHFILE(1:LENOCC(CHFILE)),'OLD',ISTAT)
- IF(ISTAT.NE.0) GOTO 95
-#endif
-#if defined(CERNLIB_IBMVM)
- CHFILE='STATE '//LOCAL
- DO 2 I=7,64
- IF(CHFILE(I:I).EQ.'.')CHFILE(I:I)=' '
- 2 CONTINUE
- CALL VMCMS(CHFILE,ISTAT)
- IF(ISTAT.NE.0) GOTO 95
-C
- CHFILE='/'//LOCAL
- NCH=LENOCC(CHFILE)
- DO 5 I=1,NCH
- IF(CHFILE(I:I).EQ.'.')CHFILE(I:I)=' '
- 5 CONTINUE
- OPEN(UNIT=LUNXZI,FILE=CHFILE,STATUS='OLD',IOSTAT=ISTAT,
- + FORM='UNFORMATTED')
-
- IF(ISTAT.NE.0) GOTO 95
-#endif
- ENDIF
-*
-* Send message to remote machine with the file parameters
-*
- NCHR=LENOCC(REMOTE)
- NCHO=LENOCC(CHOPT)
- CHOPTT = CHOPT
- IF(NCHO.EQ.0) THEN
- CHOPTT = ' '
- NCHO = 1
- ENDIF
-
- CHMAIL='PUTA :'//REMOTE(1:NCHR)//' '//CHOPTT(1:NCHO)
- CALL CZPUTA(CHMAIL,IRC)
- IF(IRC.NE.0)GOTO 99
-*
-* Verify that text file has been opened by server
-*
- CALL CZGETA(CHMAIL,ISTAT)
- IF(ISTAT.NE.0)GOTO 90
- IF(CHMAIL(1:2).NE.'OK')GOTO 90
-*
-* Now transfer the file
-*
- NR = 0
- IF(IOPTS.NE.0) THEN
- CALL TIMED(T)
- CALL CZRTIM(DELTIM)
- ENDIF
-
- IEND = 0
- 10 NLINES = 1
- NTOT = 0
- I1 = 1
- ICONT = 0
- 20 CONTINUE
-#if defined(CERNLIB_IBMVM)
- READ(LUNXZI,NUM=NCH,END=50,ERR=50)CHLINE
-#endif
-#if !defined(CERNLIB_IBMVM)
- READ(LUNXZI,'(A)',END=50,ERR=50)CHLINE
- NCH=LENOCC(CHLINE)
-#endif
- NR = NR + NCH
-*
-* Do we have room for this record in the current buffer?
-*
- IF(I1+NCH-1.GT.IMAX) THEN
- ICONT = 1
- IF(NLINES.LE.1024)NCC(NLINES)=-1
- GOTO 30
- ENDIF
-
- IF(NCH.EQ.0)THEN
- NCC(NLINES)=0
- ELSE
- NCC(NLINES)=NCH
- I2=I1+NCH-1
- CHBUF(I1:I2)=CHLINE(1:NCH)
- I1=I2+1
- NTOT=NTOT+NCH
- ENDIF
- IF(I1+NCH-1.GT.IMAX)THEN
- IF(NLINES.LT.1024)NCC(NLINES+1)=-1
- GOTO 30
- ENDIF
- NLINES=NLINES+1
- IF(NLINES.LE.1024)GOTO 20
-*
- 30 CONTINUE
-#if (!defined(CERNLIB_CRAY))&&(!defined(CERNLIB_CONVEX))
- WRITE(CHLEN,1000)NTOT,NCC
- 1000 FORMAT(I5,4I3,255I3,255I3,255I3,255I3)
-#endif
-#if defined(CERNLIB_CRAY)||defined(CERNLIB_CONVEX)
- WRITE(CHLEN(1:5),1000)NTOT
- 1000 FORMAT(I5)
- IOFF = 6
- JOFF = 1
- DO 11 II=1,16
- WRITE(CHLEN(IOFF:IOFF+95),'(32I3)') (NCC(JJ),JJ=JOFF,JOFF+31)
- IOFF = IOFF + 96
- JOFF = JOFF + 32
-11 CONTINUE
-#endif
- NTOTAL = 3077
-#if defined(CERNLIB_DECNET)
-*
-* DECnet...
-*
- IF(IPROT.EQ.1) THEN
- CALL CZDPTS(CHLEN,NTOTAL,ISTAT)
- IF(ISTAT.NE.0) GOTO 97
- ELSE
-#endif
-#if !defined(CERNLIB_IBM)||defined(CERNLIB_TCPSOCK)
-*
-* TCP/IP (with socket library)
-*
- NBYTES=SSENDSTR(ISKOUT,CHLEN,NTOTAL)
-#endif
-#if (defined(CERNLIB_IBM))&&(!defined(CERNLIB_TCPSOCK))
-*
-* TCP/IP on IBM without socket library->PASCAL version of TCPAW
-*
- CALL SSEND(ISKOUT,CHLEN,NTOTAL,NBYTES)
- IF(NBYTES.LT.NTOTAL) GOTO 97
-#endif
-#if defined(CERNLIB_DECNET)
- ENDIF
-#endif
-
- CALL CZPUTC(NTOT,ISTAT)
- IF(ISTAT.NE.0)GOTO 97
-*
-* Still a record in the current buffer?
-*
- IF(ICONT.NE.0) THEN
- ICONT = 0
- NCC(1) = NCH
- CHBUF(1:NCH) = CHLINE(1:NCH)
- I1 = NCH + 1
- NTOT = NCH
- NLINES = 2
- GOTO 20
- ENDIF
-
- IF(IEND.EQ.0)GOTO 10
-*
- CLOSE(LUNXZI)
- IF(IDEBXZ.GE.0) PRINT 2000
- 2000 FORMAT(' File transfer completed')
- NKILO = NR / 1024
- IF(IOPTS.NE.0)THEN
- CALL CZRTIM(DELTIM)
- CALL TIMED(T)
- READ(DELTIM,'(I2,1X,I2,1X,I2)') IHOUR,IMIN,ISEC
- NSECS = ISEC + IMIN*60 + IHOUR*3600
- IF(NSECS.LE.0) NSECS = 1
- RATE = FLOAT(NKILO)/FLOAT(NSECS)
-#include "cspack/xzstat.inc"
- WRITE(IXPRNT,*) ' Transferred ',NR,' bytes, transfer rate = ',
- + RATE,' KB/S'
- WRITE(IXPRNT,*) ' Elapsed time = ',DELTIM,' CP time = ',T,
- + ' sec.'
- ENDIF
- GOTO 99
-*
- 50 IEND=1
- NCC(NLINES)=-2
- GOTO 30
-*
- 90 WRITE(IXPRNT,*) 'Cannot open remote file'
- IRC = 1
- CLOSE(LUNXZI)
- GOTO 99
-*
- 95 WRITE(IXPRNT,*) 'Cannot open local file'
- IRC = 2
- GOTO 99
-*
- 97 WRITE(IXPRNT,*) 'Problems in transferring file'
- IRC = 3
- CLOSE(LUNXZI)
-*
- 99 END
diff --git a/src/packlib/cspack/xz/xzputb.F b/src/packlib/cspack/xz/xzputb.F
deleted file mode 100644
index 6f09a02..0000000
--- a/src/packlib/cspack/xz/xzputb.F
+++ /dev/null
@@ -1,115 +0,0 @@
-*
-* $Id: xzputb.F,v 1.1.1.1 1996/03/08 15:44:31 mclareni Exp $
-*
-* $Log: xzputb.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:31 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE XZPUTB(LOCAL,REMOTE,LRECL,CHOPT,IRC)
-* A - local file has already been opened
-#include "cspack/zmach.inc"
-#include "cspack/hcmail.inc"
-#include "cspack/czsock.inc"
-#include "cspack/czunit.inc"
-#include "cspack/czbuff.inc"
-#include "cspack/quest.inc"
- CHARACTER*(*) LOCAL,REMOTE
- CHARACTER*12 NODE
- CHARACTER*8 DELTIM
- DIMENSION IBUFF(8192)
- PARAMETER (NREC=0)
- CHARACTER*4 CHOPR
-#include "cspack/czopts.inc"
-#include "cspack/czopen.inc"
- IRC = 0
- IF(LRECL.EQ.0) THEN
- IRC = -1
- PRINT *,'XZPUTB. the record length (in bytes) must be given'
- RETURN
- ENDIF
-*
-* Open local file, options Input
-*
- NCHL = LENOCC(LOCAL)
- NCHR = LENOCC(REMOTE)
- IF(IOPTA.EQ.0) THEN
- IF(IOPTC.EQ.0) THEN
- CALL SZOPEN(LUNXZI,LOCAL(1:NCHL),LRECL,'I',ISTAT)
- ELSE
- CALL SZOPEN(LUNXZI,LOCAL(1:NCHL),LRECL,'IC',ISTAT)
- ENDIF
- IF(ISTAT.NE.0) GOTO 95
- ENDIF
-*
-* Create remote file
-*
- NODE = CUNODE
- CHNODE(LUNXZO) = NODE
- JSKIN(LUNXZO) = ISKIN
- JSKOUT(LUNXZO) = ISKOUT
- CHOPR = 'ON'
- IF(IOPTR.NE.0) CHOPR = 'O'
- IF(IOPTC.NE.0) THEN
- LCH = LENOCC(CHOPR) + 1
- CHOPR(LCH:LCH) = 'C'
- ENDIF
- CALL XZOPEN(LUNXZO,REMOTE(1:NCHR),NODE,LRECL,CHOPR,IRC)
- IF(IRC.NE.0) GOTO 90
-*
-* Start transfer
-*
- NR=0
-*
-* Start timer
-*
- IF(IOPTS.NE.0) THEN
- CALL CZRTIM(DELTIM)
- CALL TIMED(T)
- ENDIF
-
- 20 NWORDS=LRECL/IQCHAW
- CALL XINBF(LUNXZI,IBUFF,NWORDS)
- IF(NWORDS.GT.0) THEN
- CALL XZRITE(LUNXZO,IBUFF,NREC,LRECL,' ',IRC)
- IF(IRC.EQ.0) THEN
- NR = NR + 1
- GOTO 20
- ELSEIF(IRC.GT.0) THEN
- GOTO 97
- ENDIF
- ENDIF
-
- CLOSE(LUNXZI)
- CALL XZCLOS(LUNXZO,' ',IRC)
- IF(IDEBXZ.GE.0) PRINT *,' File transfer completed'
- IF(IOPTS.NE.0)THEN
- CALL CZRTIM(DELTIM)
- CALL TIMED(T)
- READ(DELTIM,'(I2,1X,I2,1X,I2)') IHOUR,IMIN,ISEC
- NSECS = ISEC + IMIN*60 + IHOUR*3600
- IF(NSECS.LE.0) NSECS = 1
- NKILO = NR*LRECL / 1024
- RATE = FLOAT(NKILO)/FLOAT(NSECS)
-#include "cspack/xzstat.inc"
- PRINT *,' Transferred ',NR,' records, transfer rate = ',RATE,
- + ' KB/S'
- PRINT *,' Elapsed time = ',DELTIM,' CP time = ',T,' sec.'
- ENDIF
- GO TO 99
-*
-* Error
-*
- 90 PRINT *, ' Cannot open remote file'
- IRC = 1
- GO TO 99
- 95 PRINT *, ' Cannot open local file'
- IRC = 2
- GO TO 99
- 97 PRINT *, 'Problem in transferring file'
- IRC = 3
- CLOSE(LUNXZI)
-*
- 99 END
-
diff --git a/src/packlib/cspack/xz/xzputd.F b/src/packlib/cspack/xz/xzputd.F
deleted file mode 100644
index 9f29dc8..0000000
--- a/src/packlib/cspack/xz/xzputd.F
+++ /dev/null
@@ -1,122 +0,0 @@
-*
-* $Id: xzputd.F,v 1.1.1.1 1996/03/08 15:44:31 mclareni Exp $
-*
-* $Log: xzputd.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:31 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE XZPUTD(LOCAL,REMOTE,LRECL,CHOPT,IRC)
-* A - local file has already been opened
-#include "cspack/zmach.inc"
-#include "cspack/hcmail.inc"
-#include "cspack/czsock.inc"
-#include "cspack/czbuff.inc"
-#include "cspack/czunit.inc"
-#include "cspack/quest.inc"
- CHARACTER*(*) LOCAL,REMOTE
- CHARACTER*12 NODE
- CHARACTER*8 DELTIM
- CHARACTER*4 CHOPR
- DIMENSION IBUFF(8192)
-#include "cspack/czopts.inc"
-#include "cspack/czopen.inc"
- IRC = 0
- NREC = 0
- IF(LRECL.EQ.0) THEN
- IRC = -1
- PRINT *,'XZPUTD. the record length (in bytes) must be given'
- RETURN
- ENDIF
-*
-* Open local file, options Input
-*
- NCHL = LENOCC(LOCAL)
- NCHR = LENOCC(REMOTE)
- IF(IOPTA.EQ.0) THEN
- IF(IOPTC.EQ.0) THEN
- CALL SZOPEN(LUNXZI,LOCAL(1:NCHL),LRECL,'DI',ISTAT)
- ELSE
- CALL SZOPEN(LUNXZI,LOCAL(1:NCHL),LRECL,'CDI',ISTAT)
- ENDIF
-
- IF(ISTAT.NE.0) THEN
- IF(IDEBXZ.GE.1) PRINT *,'XZPUTD. iostat from OPEN = ',
- + IQUEST(1)
- GOTO 95
- ENDIF
- ENDIF
-*
-* Create remote file
-*
- NODE = CUNODE
- CHNODE(LUNXZO) = NODE
- JSKIN(LUNXZO) = ISKIN
- JSKOUT(LUNXZO) = ISKOUT
- CHOPR = 'DON'
- IF(IOPTR.NE.0) CHOPR = 'DO'
- IF(IOPTC.NE.0) THEN
- LCH = LENOCC(CHOPR) + 1
- CHOPR(LCH:LCH) = 'C'
- ENDIF
- CALL XZOPEN(LUNXZO,REMOTE(1:NCHR),NODE,LRECL,CHOPR,IRC)
- IF(IRC.NE.0) GOTO 90
-*
-* Start transfer
-*
- NR=0
-*
-* Start timer
-*
- IF(IOPTS.NE.0) THEN
- CALL CZRTIM(DELTIM)
- CALL TIMED(T)
- ENDIF
-
- 20 CONTINUE
- NREC = NREC + 1
- CALL SZREAD(LUNXZI,IBUFF,NREC,LRECL,NGOT,'D',IRC)
- IF(IRC.NE.0) GOTO 30
- CALL XZRITE(LUNXZO,IBUFF,NREC,LRECL,' ',IRC)
- IF(IRC.EQ.0) THEN
- GOTO 20
- ELSEIF(IRC.GT.0) THEN
- GOTO 97
- ENDIF
-
- 30 CONTINUE
- CLOSE(LUNXZI)
- CALL XZCLOS(LUNXZO,' ',IRC)
- IF(IDEBXZ.GE.0) PRINT *,' File transfer completed'
- IF(IOPTS.NE.0)THEN
- CALL CZRTIM(DELTIM)
- CALL TIMED(T)
- READ(DELTIM,'(I2,1X,I2,1X,I2)') IHOUR,IMIN,ISEC
- NSECS = ISEC + IMIN*60 + IHOUR*3600
- IF(NSECS.LE.0) NSECS = 1
- NREC = NREC - 1
- NKILO = NREC*LRECL / 1024
- NR = NREC
- RATE = FLOAT(NKILO)/FLOAT(NSECS)
-#include "cspack/xzstat.inc"
- PRINT *,' Transferred ',NREC,' records, transfer rate = ',RATE,
- + ' KB/S'
- PRINT *,' Elapsed time = ',DELTIM,' CP time = ',T,' sec.'
- ENDIF
- GO TO 99
-*
-* Error
-*
- 90 PRINT *, ' Cannot open remote file'
- IRC = 1
- GO TO 99
- 95 PRINT *, ' Cannot open local file'
- IRC = 2
- GO TO 99
- 97 PRINT *, 'Problem in transferring file'
- IRC = 3
- CLOSE(LUNXZI)
-*
- 99 END
-
diff --git a/src/packlib/cspack/xz/xzputf.F b/src/packlib/cspack/xz/xzputf.F
deleted file mode 100644
index 1cfa824..0000000
--- a/src/packlib/cspack/xz/xzputf.F
+++ /dev/null
@@ -1,285 +0,0 @@
-*
-* $Id: xzputf.F,v 1.5 1998/09/25 09:25:31 mclareni Exp $
-*
-* $Log: xzputf.F,v $
-* Revision 1.5 1998/09/25 09:25:31 mclareni
-* Modifications for the Mklinux port flagged by CERNLIB_PPC
-*
-* Revision 1.4 1997/10/23 13:26:27 mclareni
-* NT mods
-*
-* Revision 1.3 1997/09/02 08:46:27 mclareni
-* WINNT mods, mostly cpp defines
-*
-* Revision 1.2 1997/01/17 08:56:17 gunter
-* call vxinvb for linux too.
-*
-* Revision 1.1.1.1 1996/03/08 15:44:31 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE XZPUTF(LOCAL,REMOTE,LRECL,LFORM,RRECL,RFORM,CHOPT,IRC)
-* A - local file has already been opened
-#include "cspack/hcmail.inc"
-#include "cspack/czunit.inc"
-#include "cspack/czsock.inc"
-#include "cspack/zmach.inc"
-#include "cspack/pawc.inc"
-#if defined(CERNLIB_IBMVM)
- CHARACTER*13 CHTIME
- CHARACTER*1 RECFM
- CHARACTER*255 CHFILE,CHTEMP
-#endif
- CHARACTER*(*) LOCAL,REMOTE,LFORM,RFORM
- DIMENSION IQ(2),Q(2),LQ(8000)
- EQUIVALENCE (LQ(1),LMAIN),(IQ(1),LQ(9)),(Q(1),IQ(1))
-#include "cspack/quest.inc"
- CHARACTER*4 CHOPE,CHOPO
- CHARACTER*80 CARD
- CHARACTER*8 DELTIM
- DIMENSION IUHEAD(400)
- DIMENSION IOCR(100)
- PARAMETER (JBIAS=2)
- PARAMETER (MEGA=1024*1024)
- COMMON/FZSTAT/INFLUN,INFSTA,INFOFZ(40)
- INTEGER RRECL
- DIMENSION ITEST(5)
-#if defined(CERNLIB_IPSC)
- DATA IPATT/'0123CDEF'X/
-#elif defined(CERNLIB_WINNT)
- DATA IPATT/Z'0123CDEF'/
-#elif defined(CERNLIB_DECS) || defined(CERNLIB_LINUX)
- DATA IPATT/X'0123CDEF'/
-#elif defined(CERNLIB_VAX)
- DATA IPATT/Z0123CDEF/
-#endif
-#include "cspack/czopts.inc"
-#include "cspack/czopen.inc"
- IRC = 0
- NCHL = LENOCC(LOCAL)
- NCHR = LENOCC(REMOTE)
- LENL = LENOCC(LFORM)
- LENR = LENOCC(RFORM)
-
- IF(IOPTC.NE.0) THEN
- LENR = LENR + 1
- RFORM(LENR:LENR) = 'C'
- ENDIF
-
- IF(LENL.EQ.0) THEN
- LFORM = 'Z'
- LENL = 1
- ENDIF
-
- IF(LENR.EQ.0) THEN
- RFORM = LFORM
- LENR = LENL
- ENDIF
-
- IF(IDEBXZ.GE.3)
- +PRINT *,'XZPUTF. enter for ',LOCAL(1:NCHL),' ',REMOTE(1:NCHR),
- + LRECL,' ',LFORM,RRECL,' ',RFORM,CHOPT
-
- CHOPE = ' '
- IF(INDEX(LFORM(1:LENL),'A').NE.0) THEN
-*
-* Exchange file format, ASCII mapping
-*
- LRECL = 80
- CHOPE = 'F'
-
- ELSEIF(INDEX(LFORM(1:LENL),'X').NE.0) THEN
- IF(INDEX(LFORM(1:LENL),'D').NE.0) CHOPE = 'D'
- ELSEIF(INDEX(LFORM(1:LENL),'Z').NE.0) THEN
- CHOPE = 'V'
- ENDIF
-
- LOPT = LENOCC(CHOPE) + 1
- IF(IOPTC.NE.0) CHOPE(LOPT:LOPT) = 'C'
-
- IF(IOPTA.EQ.0) THEN
-#if defined(CERNLIB_IBMVM)
-*
-* Get file information
-*
- CHTEMP = LOCAL(1:NCHL)
- CALL CTRANS('.',' ',CHTEMP,1,NCHL)
- CALL VMQFIL(CHTEMP(1:NCHL),RECFM,LBLK,NRECS,
- + NBLOCKS,CHTIME,ISTAT,IRC)
-*
-* Get file mode
-*
- INQUIRE(FILE='/'//CHTEMP(1:NCHL),NAME=CHFILE)
- LCHF = LENOCC(CHFILE)
-*
-* OS simulation? Assume VBS...
-*
- IF(CHFILE(LCHF:LCHF).EQ.'4') THEN
- WRITE(CHFILE,9002) LUNXZI,CHTEMP(1:NCHL),LBLK
-9002 FORMAT('FILEDEF ',I2,' DISK ',A,
- + ' (RECFM VBS LRECL 32756 BLOCK ',I6)
- LCHF = LENOCC(CHFILE)
- CALL VMCMS(CHFILE(1:LCHF),IRC)
- IF(IDEBXZ.GE.3) PRINT *,'XZPUTF. rc from ',
- + CHFILE(1:LCHF),' = ',IRC
- OPEN(LUNXZI,STATUS='OLD',FORM='UNFORMATTED',IOSTAT=IRC)
- ELSE
- CALL SZOPEN(LUNXZI,LOCAL(1:NCHL),LRECL,CHOPE,IRC)
- ENDIF
-#endif
-#if !defined(CERNLIB_IBMVM)
- LCHOPE = LENOCC(CHOPE) + 1
- IF(IOPTC.NE.0) CHOPE(LCHOPE:LCHOPE) = 'C'
- CALL SZOPEN(LUNXZI,LOCAL(1:NCHL),LRECL,CHOPE,IRC)
-#endif
- IF(IRC.NE.0) THEN
- PRINT *,'XZPUTF. cannot open local file'
- GOTO 95
- ENDIF
- ENDIF
-
- IF((INDEX(LFORM(1:LENL),'X').NE.0).AND.(LRECL.EQ.0)) THEN
-*
-* Get record length from file
-*
- IF(INDEX(CHOPE,'D').EQ.0) THEN
- READ(LUNXZI) ITEST
- REWIND(LUNXZI)
- ELSE
- READ(LUNXZI,REC=1) ITEST
- ENDIF
-#if defined(CERNLIB_VAX)||defined(CERNLIB_DECS) || (defined(CERNLIB_LINUX) && !defined(CERNLIB_PPC)) || defined(CERNLIB_WINNT)
- IF(ITEST(1).NE.IPATT) CALL VXINVB(ITEST(5),1)
-#endif
-#if !defined(CERNLIB_CRAY)
- LRECL = JBYT(ITEST(5),1,24) * 4
-#endif
-#if defined(CERNLIB_CRAY)
- LRECL = JBYT(ITEST(3),1,24) * 4
-#endif
- ENDIF
-
- IF((INDEX(LFORM(1:LENL),'Z').NE.0).AND.(LRECL.EQ.0)) THEN
- IF(IDEBXZ.GE.-3) PRINT *,'XZPUTF. record length for ',
- + 'native FZ file defaulted to 3600 bytes'
- LRECL = 3600
- ENDIF
-
- IF(RRECL.EQ.0) RRECL = LRECL
- IF(LRECL.EQ.0) THEN
- PRINT *,'XZPUTF. the record length (in bytes) must be given'
- IRC = 1
- RETURN
- ENDIF
-
- CALL FZFILE(LUNXZI,LRECL/4,LFORM(1:LENL))
-
- CALL FZLOGL(LUNXZI,IDEBXZ)
- CALL FZLOGL(LUNFZO,IDEBXZ)
-
- WRITE(CARD,9001) REMOTE(1:NCHR),RRECL,RFORM(1:LENR)
- 9001 FORMAT('PUTFZ:',A,' ',I6,A4)
- CALL CZPUTA(CARD,ISTAT)
-*
-* Verify that FZ file has been opened by server
-*
- CALL CZGETA(CHMAIL,ISTAT)
- IF(ISTAT.NE.0)GO TO 90
- IF(CHMAIL(1:2).NE.'OK')GO TO 90
-*
-* Perform the transfer
-*
- CALL CZRTIM(DELTIM)
- CALL TIMED(T)
- NR = 0
- 1 CONTINUE
- NUH = 400
- CALL FZIN(LUNXZI,IHDIV,LSUP,JBIAS,' ',NUH,IUHEAD)
- IF((IQUEST(1).LT.0).OR.(IQUEST(1).GE.4)) GOTO 2
- IF(IQUEST(1).EQ.0) THEN
- IEVENT = IQUEST(11)
- ENDIF
-*
-* start of run
-*
- IF(IQUEST(1).EQ.1) THEN
- IF(IDEBXZ.GE.3) PRINT *,'XZPUTF. read start of run'
- IF(IOPTR.NE.0) GOTO 1
- CALL FZRUN(LUNFZO,IQUEST(11),NUH,IUHEAD)
- GOTO 1
-*
-* end of run
-*
- ELSEIF(IQUEST(1).EQ.2) THEN
- IF(IDEBXZ.GE.3) PRINT *,'XZPUTF. read end of run'
- IF(IOPTR.NE.0) GOTO 1
- CALL FZRUN(LUNFZO,-1,NUH,IUHEAD)
- GOTO 1
-*
-* ZEBRA eof
-*
- ELSEIF(IQUEST(1).EQ.3) THEN
- IF(IDEBXZ.GE.3) PRINT *,'XZPUTF. read end of file'
- IF(IOPTZ.NE.0) GOTO 1
- CALL FZENDO(LUNFZO,'E')
- GOTO 2
- ENDIF
-
- IF(IDEBXZ.GE.3) PRINT *,'XZPUTF. read ',IQUEST(14),
- + ' data words + ',NUH,' words of user header'
- CALL UCOPY(IQUEST(21),IOCR(1),MIN(IQUEST(20),100))
- CHOPO = 'L'
- IF(IQUEST(14).EQ.0) CHOPO = 'Z'
- CALL FZOUT(LUNFZO,IHDIV,LSUP,IEVENT,CHOPO,IOCR(1),NUH,IUHEAD)
- IF(CHOPO.EQ.'L') CALL MZDROP(IHDIV,LSUP,' ')
- GOTO 1
- 2 CONTINUE
- IUHEAD(1) = 999
- IEVENT = 1
- IOCR(1) = 2
- CALL FZOUT(LUNFZO,IHDIV,LSUP,IEVENT,'Z',IOCR(1),1,IUHEAD)
- CALL FZENDO(LUNFZO,'F')
- IF(IDEBXZ.GE.0) PRINT 2000
- 2000 FORMAT(' File transfer completed')
-*
-* Call FZINFO to get NWORDS, NMEGA transferred
-*
- CALL FZINFO(LUNXZI)
- CALL FZENDI(LUNXZI,'T')
- IF(INFLUN.NE.LUNXZI) THEN
- PRINT *,'XZPUTF. error obtaining FZINFO for LUN = ',LUNXZI
- MBYTES = 0
- ELSE
- MBYTES = (INFOFZ(19) + INFOFZ(20)/MEGA)*IQCHAW
- ENDIF
-
- CLOSE(LUNXZI)
-
- CALL CZRTIM(DELTIM)
- CALL TIMED(T)
-
- IF(INDEX(CHOPT,'S').NE.0) THEN
- READ(DELTIM,'(I2,1X,I2,1X,I2)') IHOUR,IMIN,ISEC
- NSECS = ISEC + IMIN*60 + IHOUR*3600
- IF(NSECS.LE.0) NSECS = 1
- RATE = FLOAT(MBYTES)*1000./FLOAT(NSECS)
- NKILO = MBYTES/1024
-#include "cspack/xzstat.inc"
- PRINT *,' Transferred ',NKILO,' KB, rate = ',RATE,' KB/S'
- PRINT *,' Elapsed time = ',DELTIM,' CP time = ',T,' sec.'
- ENDIF
-
-*
- 80 CLOSE(LUNXZI)
- GO TO 99
-*
- 90 PRINT *,' Cannot open remote file'
- IRC = 1
- CALL FZENDI(LUNXZI,'T')
- GO TO 80
-*
- 95 PRINT *,' Cannot open local file'
- IRC = 2
-*
- 99 END
diff --git a/src/packlib/cspack/xz/xzputl.F b/src/packlib/cspack/xz/xzputl.F
deleted file mode 100644
index 93ce194..0000000
--- a/src/packlib/cspack/xz/xzputl.F
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: xzputl.F,v 1.1.1.1 1996/03/08 15:44:31 mclareni Exp $
-*
-* $Log: xzputl.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:31 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE XZPUTL(LUN,CHLINE,CHFORM,CHOPT,IRC)
- CHARACTER*(*) CHLINE,CHFORM
-#include "cspack/zmach.inc"
-#include "cspack/hcmail.inc"
-#include "cspack/quest.inc"
-#include "cspack/czsock.inc"
-#include "cspack/czopts.inc"
-*
- IRC = 0
-*
-* Instruct server to issue a write
-*
- CALL CZSWAP(' ',LUN,ISTAT)
- WRITE(CHMAIL,9001) LUN,CHFORM
-9001 FORMAT('XZIO :PUTL',I3,A)
- CALL CZPUTA(CHMAIL,ISTAT)
- CALL CZPUTA(CHLINE,IRC)
-#include "cspack/czmess.inc"
-
- END
diff --git a/src/packlib/cspack/xz/xzputp.F b/src/packlib/cspack/xz/xzputp.F
deleted file mode 100644
index ab54c84..0000000
--- a/src/packlib/cspack/xz/xzputp.F
+++ /dev/null
@@ -1,190 +0,0 @@
-*
-* $Id: xzputp.F,v 1.4 1998/09/25 09:25:33 mclareni Exp $
-*
-* $Log: xzputp.F,v $
-* Revision 1.4 1998/09/25 09:25:33 mclareni
-* Modifications for the Mklinux port flagged by CERNLIB_PPC
-*
-* Revision 1.3 1997/09/02 08:46:28 mclareni
-* WINNT mods, mostly cpp defines
-*
-* Revision 1.2 1997/01/17 08:56:17 gunter
-* call vxinvb for linux too.
-*
-* Revision 1.1.1.1 1996/03/08 15:44:31 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE XZPUTP(LOCAL,REMOTE,CHOPT,IRC)
-#include "cspack/zmach.inc"
-#include "cspack/hcmail.inc"
-#include "cspack/czsock.inc"
-#include "cspack/czbuff.inc"
-#include "cspack/quest.inc"
-#if defined(CERNLIB_IBM)
- CHARACTER*80 CHFILE
-#endif
-#include "cspack/czoptd.inc"
- DIMENSION IA(512)
- DIMENSION IX(8)
- DIMENSION ICONTR(2)
- DIMENSION MPACK2(2),MPACK9(2)
- CHARACTER*12 NODE
- CHARACTER*8 DELTIM
- CHARACTER*8 CHOPTT
- CHARACTER*(*) LOCAL,REMOTE
-#include "cspack/czunit.inc"
- DATA MPACK2 / 2, 16 /
- DATA MPACK9 / 9, 3 /
-#include "cspack/czoptu.inc"
-#include "cspack/czopen.inc"
- IRC = 0
- NCHL = LENOCC(LOCAL)
- NCHR = LENOCC(REMOTE)
- IF(IDEBXZ.GE.1) PRINT *,'XZPUTP. enter for ',LOCAL,REMOTE,CHOPT
-*
-* Open local file, options Input
-*
- LRECL = 2048
- IF(IOPTA.EQ.0) THEN
- IF(IOPTC.EQ.0) THEN
- CALL SZOPEN(LUNXZI,LOCAL(1:NCHL),LRECL,'IP',ISTAT)
- ELSE
- CALL SZOPEN(LUNXZI,LOCAL(1:NCHL),LRECL,'IPC',ISTAT)
- ENDIF
- IF(ISTAT.NE.0) GOTO 95
- ENDIF
-*
-* Send OPEN request to server
-*
- NCHO=LENOCC(CHOPT)
- CHOPTT = CHOPT
- IF(NCHO.EQ.0) THEN
- CHOPTT = ' '
- NCHO = 1
- ENDIF
-
- CHMAIL = 'PUTP :'//REMOTE(1:NCHR)//' '//CHOPTT(1:NCHO)
- CALL CZPUTA(CHMAIL,ISTAT)
- IF(ISTAT.NE.0)GO TO 99
-*
-* Verify that PAM file has been opened by server
-*
- CALL CZGETA(CHMAIL,ISTAT)
- IF(ISTAT.NE.0)GO TO 90
- IF(CHMAIL(1:2).NE.'OK')GO TO 90
-*
-* Start timer
-*
- IF(INDEX(CHOPT,'S').NE.0) THEN
- CALL CZRTIM(DELTIM)
- CALL TIMED(T)
- ENDIF
-*
-* Start transfer
-*
- NR = 0
- NWOR = 0
-1 CALL VBLANK(IA,512)
- NUM = 512
- READ(LUNXZI,END=2) NUM,(IA(I),I=1,NUM)
- IF(NUM.EQ.0) GOTO 2
- NWOR = NWOR + NUM
- NR = NR + 1
-#if defined(CERNLIB_IBM)
-*
-* Translate look-ahead name
-*
- CALL XZETOA(IA(1),8)
-#endif
- CALL UPKBYT(IA(3),1,IX(4),4,MPACK9)
- CALL UPKBYT(IA(3),1,IX,4,MPACK2)
-*
-* Loop over body of this record, splitting into lines
-*
- I = 4
- LENX = 1
- IF(IX(5).NE.0) THEN
- I = IX(7)
- LENX = IX(7) - 3
- ENDIF
-#if defined(CERNLIB_VAX)||defined(CERNLIB_DECS) || (defined(CERNLIB_LINUX) && !defined(CERNLIB_PPC)) || defined(CERNLIB_WINNT)
-*
-* Byte swap index vector
-*
- CALL VXINVB(IA(3),LENX)
-#endif
-*
-* Send #words to read
-*
- WRITE(CHMAIL,'(I3)') NUM
- CALL CZPUTA(CHMAIL,ISTAT)
- IF(ISTAT.NE.0) GOTO 97
-#if defined(CERNLIB_IBM)
-*
-* Translate text
-*
- CALL XZETOA(IA(I),(NUM-I+1)*4)
-#endif
-*
-* Send data to server
-*
- LBUF = NUM
- ICONTR(1) = 1
- ICONTR(2) = LBUF
- CALL CZTCP(IA,ICONTR)
-
-10 CONTINUE
-*
-* Look for null byte in text
-*
- IF(IDEBXZ.LT.3) GOTO 1
- J = LOCBYT(0,IA(I),20,1,1,8)
- IF(J.EQ.0) J=20
- PRINT 9001,(IA(K),K=I,I+J-1)
-9001 FORMAT(1X,20A4/)
- I = I + J
- IF(I.LT.NUM) GOTO 10
- GOTO 1
-*
-2 CONTINUE
-
- NUM = -1
- WRITE(CHMAIL,'(I3)') NUM
- CALL CZPUTA(CHMAIL,ISTAT)
- IF(ISTAT.NE.0) GOTO 97
-
- CLOSE(LUNXZI)
- IF(IDEBXZ.GE.0) PRINT *,' File transfer completed '
- IF(INDEX(CHOPT,'S').NE.0)THEN
- CALL CZRTIM(DELTIM)
- CALL TIMED(T)
- READ(DELTIM,'(I2,1X,I2,1X,I2)') IHOUR,IMIN,ISEC
- NSECS = ISEC + IMIN*60 + IHOUR*3600
- IF(NSECS.LE.0) NSECS = 1
- NKILO = NWOR*IQCHAW / 1024
- RATE = FLOAT(NKILO)/FLOAT(NSECS)
-#include "cspack/xzstat.inc"
- PRINT *,' Transferred ',NR,' records, transfer rate = ',RATE,
- + ' KB/S'
- PRINT *,' Elapsed time = ',DELTIM,' CP time = ',T,' sec.'
- ENDIF
- GO TO 99
-*
-* Error
-*
- 90 PRINT *, ' Cannot open remote file'
- IRC = 1
- GO TO 99
- 95 PRINT *, ' Cannot open local file'
- IRC = 2
- GO TO 99
- 97 PRINT *, 'Problem in transferring file'
- IRC = 3
- CLOSE(1)
-*
- 99 LBUF = 270
- END
-
-
diff --git a/src/packlib/cspack/xz/xzputr.F b/src/packlib/cspack/xz/xzputr.F
deleted file mode 100644
index a1f5e72..0000000
--- a/src/packlib/cspack/xz/xzputr.F
+++ /dev/null
@@ -1,236 +0,0 @@
-*
-* $Id: xzputr.F,v 1.1.1.1 1996/03/08 15:44:31 mclareni Exp $
-*
-* $Log: xzputr.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:31 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE XZPUTR(LOCAL,REMOTE,CHOPT,IRC)
-#include "cspack/czunit.inc"
-#include "cspack/hcmail.inc"
-#include "cspack/czsock.inc"
-#include "cspack/zmach.inc"
-#include "cspack/pawc.inc"
- DIMENSION IQ(2),Q(2),LQ(8000)
- EQUIVALENCE (LQ(1),LMAIN),(IQ(1),LQ(9)),(Q(1),IQ(1))
-C
-#include "cspack/rzclun.inc"
- COMMON /RZCL/ LTOP,LRZ0,LCDIR,LRIN,LROUT,LFREE,LUSED,LPURG
- +, LTEMP,LCORD,LFROM
-#include "cspack/quest.inc"
- CHARACTER*8 CHTAG(100)
- CHARACTER*80 CHFILE
- CHARACTER*90 CHFORM
- CHARACTER*12 CHDATE
- CHARACTER*8 DELTIM
- CHARACTER*1 CHOPE
- CHARACTER*4 CHOPRZ
- DIMENSION IHTAG(2)
- PARAMETER (KUP=5,KPW1=7,KNCH=9,KDATEC=10,KDATEM=11,KQUOTA=12,
- + KRUSED=13,KWUSED=14,KMEGA=15,KIRIN=17,KIROUT=18,
- + KRLOUT=19,KIP1=20,KNFREE=22,KNSD=23,KLD=24,KLB=25,
- + KLS=26,KLK=27,KLF=28,KLC=29,KLE=30,KNKEYS=31,
- + KNWKEY=32,KKDES=33,KNSIZE=253,KEX=6,KNMAX=100)
- CHARACTER*(*) LOCAL,REMOTE
- DIMENSION ITEST(50)
-*
-*_______________________________________
-#include "cspack/czopts.inc"
-#include "cspack/czopen.inc"
- IRC = 0
-
- IF(IDEBXZ.GE.1) PRINT *,'XZPUTR. enter for ',
- + LOCAL,' ',REMOTE,' ',CHOPT
-*
-* Open local RZ file
-*
- IQUEST(1) = 0
- IOPEN = 0
- CHFILE = LOCAL
- NREC = 0
- NWKEY = 0
- CHFORM = ' '
- LRECL = 0
-
- IF(IOPTA.EQ.0) THEN
- CHOPRZ = ' '
- LCHPRZ = 0
- IF(IOPTE.NE.0) THEN
- CHOPRZ = 'X'
- LCHPRZ = 1
- ENDIF
-
- IF(IOPTC.NE.0) THEN
- LCHPRZ = LCHPRZ + 1
- CHOPRZ(LCHPRZ:LCHPRZ) = 'P'
- ENDIF
-
- CALL RZOPEN(LUNXZI,'RZ',LOCAL,CHOPRZ,LRECL,ISTAT)
- IF(ISTAT.NE.0) GOTO 50
- ENDIF
-
- CHOPRZ = ' '
- IF(IQUEST(12).NE.0) CHOPRZ = 'X'
-
- CALL RZFILE(LUNXZI,'RZ',CHOPRZ)
- IF(IQUEST(1).NE.0)THEN
- CLOSE(LUNXZI)
- GOTO 50
- ENDIF
-
- IF(INDEX(CHOPT,'S').NE.0) THEN
- CALL RZSTAT('//RZ',99,' ')
- NWORDS = IQUEST(12)
- ENDIF
-
- IF(INDEX(CHOPT,'L').NE.0) CALL RZLDIR(' ',CHOPT)
-*
-* Send message to remote machine with the file parameters
-*
- CHOPE = ' '
- IF(INDEX(CHOPT,'N').NE.0) CHOPE = 'N'
- IF(INDEX(CHOPT,'X').NE.0) CHOPE = 'X'
- LCHOPE = LENOCC(CHOPE)
- IF(IOPTC.NE.0) THEN
- CHOPE(LCHOPE+1:LCHOPE+1) = 'C'
- LCHOPE = LCHOPE + 1
- ENDIF
- IF(INDEX(CHOPT,'R').NE.0.OR.IRELAT.NE.0)
- + CHOPE(LCHOPE+1:LCHOPE+1) = 'L'
-
- NCHR = LENOCC(REMOTE)
- CHMAIL='PUTRZ:'//REMOTE(1:NCHR)//' '//CHOPE
-* IF((INDEX(CHOPT,'R').NE.0).OR.(IRELAT.NE.0))
-* + CHMAIL = CHMAIL(1:LENOCC(CHMAIL)) // 'R '
-
- CALL CZPUTA(CHMAIL,ISTAT)
- IF(ISTAT.NE.0)GOTO 99
-
- IOPEN = 1
- NREC = IQ(LCDIR+KQUOTA)
- NWKEY = IQ(LCDIR+KNWKEY)
- KTAGS = KKDES+(NWKEY-1)/10+1
- LB = IQ(LCDIR+KLB)
- LRECL = IQ(LCDIR+LB+1)
- IDATEC = IQ(LCDIR+KDATEC)
- IDATEM = IQ(LCDIR+KDATEM)
-*
-* Test if this file is in exchange mode
-*
-* CALL RZIODO(LUNXZI,50,2,ITEST,1)
-*SELF,IF=VAX,DECS.
-*
-* CALL VXINVB(ITEST(9),1)
-* IMODEX = JBIT(ITEST(9),12)
-* IMODEX = IOR(ITEST(6),0)
-*SELF,IF=-VAX,IF=-DECS.
-* IMODEX = ITEST(6)
-*SELF.
-*
-#if defined(CERNLIB_UNIX)
- IF(INDEX(CHOPT,'X').NE.0) THEN
-#endif
-#if !defined(CERNLIB_UNIX)
- IF((IMODEX.NE.0).AND.(INDEX(CHOPT,'N').EQ.0)) THEN
-#endif
-*
-* Set NWKEY to indicate that this is an exchange mode transfer
-*
- NWKEY = -1
- WRITE(CHMAIL,9002)NWKEY,NREC,LRECL,IDATEC,IDATEM
- CALL CZPUTA(CHMAIL,ISTAT)
- IF(ISTAT.NE.0)GOTO 40
-*
-* Now transfer the file using XZPUTD
-*
- CHOPE = ' '
- IF(INDEX(CHOPT,'S').NE.0) CHOPE = 'S'
- CALL XZPUTD(LOCAL,REMOTE,LRECL*4,CHOPE,IC)
- CALL RZEND('RZ')
- GOTO 99
- ELSE
- DO 10 I=1,NWKEY
- CALL ZITOH(IQ(LCDIR+KTAGS+2*I-2),IHTAG,2)
- CALL UHTOC(IHTAG,4,CHTAG(I),8)
- IKDES=(I-1)/10
- IKBIT1=3*I-30*IKDES-2
- IFORM=JBYT(IQ(LCDIR+KKDES+IKDES),IKBIT1,3)
- IF(IFORM.EQ.3)THEN
- CHFORM(I:I)='H'
- ELSEIF(IFORM.EQ.4) THEN
- CHFORM(I:I)='A'
- ELSEIF(IFORM.EQ.1) THEN
- CHFORM(I:I)='B'
- ELSE
- CHFORM(I:I)='I'
- ENDIF
- 10 CONTINUE
- CHMAIL=' '
- WRITE(CHMAIL,9002)NWKEY,NREC,LRECL,IDATEC,IDATEM
- 9002 FORMAT(5I10)
- CALL CZPUTA(CHMAIL,ISTAT)
- IF(ISTAT.NE.0)GOTO 40
- CALL CZPUTA(CHFORM,ISTAT)
- IF(NWKEY.EQ.0)GOTO 40
- DO 20 I=1,NWKEY
- CHMAIL=CHTAG(I)
- CALL CZPUTA(CHMAIL,ISTAT)
- IF(ISTAT.NE.0)GOTO 40
- 20 CONTINUE
-*
-* Verify that RZ file has been opened by server
-*
- CALL CZGETA(CHMAIL,ISTAT)
- IF(ISTAT.NE.0)GOTO 40
- IF(CHMAIL(1:2).NE.'OK')GOTO 40
-
- IF(INDEX(CHOPT,'S').NE.0) THEN
- CALL CZRTIM(DELTIM)
- CALL TIMED(T)
- ENDIF
-
-*
-* Now transfer the file
-*
- CALL RZTOFZ(LUNFZO,'C')
- IF(IQUEST(1).NE.0) THEN
- PRINT 9003
- 9003 FORMAT(' Error transferring file')
- IRC = 3
- ELSE
- IF(IDEBXZ.GE.0) PRINT 9004
- 9004 FORMAT(' File transfer completed')
- IF(INDEX(CHOPT,'S').NE.0) THEN
- CALL CZRTIM(DELTIM)
- CALL TIMED(T)
- READ(DELTIM,'(I2,1X,I2,1X,I2)') IHOUR,IMIN,ISEC
- NSECS = ISEC + IMIN*60 + IHOUR*3600
- IF(NSECS.LE.0) NSECS = 1
- NKILO = NWORDS*IQCHAW/1024
- RATE = FLOAT(NKILO)/FLOAT(NSECS)
- NR = 0
-#include "cspack/xzstat.inc"
- PRINT *,' Transferred ',NKILO,' KB, rate = ',RATE,' KB/'
- + //'S'
- PRINT *,' Elapsed time = ',DELTIM,' CP time = ',T,' '
- + //'sec.'
- ENDIF
-
- ENDIF
- ENDIF
-*
- 30 IF(IOPEN.EQ.0)GOTO 99
- CALL RZEND('RZ')
- CLOSE(LUNXZI)
- GOTO 99
-*
- 40 PRINT *,' Cannot open remote file'
- IRC = 1
- GOTO 30
-*
- 50 PRINT *,' Cannot open local file'
- IRC = 2
-*
- 99 END
diff --git a/src/packlib/cspack/xz/xzputx.F b/src/packlib/cspack/xz/xzputx.F
deleted file mode 100644
index ca7c2c8..0000000
--- a/src/packlib/cspack/xz/xzputx.F
+++ /dev/null
@@ -1,161 +0,0 @@
-*
-* $Id: xzputx.F,v 1.1.1.1 1996/03/08 15:44:31 mclareni Exp $
-*
-* $Log: xzputx.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:31 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE XZPUTX(LOCAL,REMOTE,LRECL,CHOPT,IRC)
-* A - local file has already been opened
-#include "cspack/zmach.inc"
-#include "cspack/hcmail.inc"
-#include "cspack/czsock.inc"
-#include "cspack/czunit.inc"
-#include "cspack/czbuff.inc"
-#include "cspack/quest.inc"
- CHARACTER*(*) LOCAL,REMOTE
- CHARACTER*12 NODE
- CHARACTER*8 DELTIM
- DIMENSION IBUFF(8192)
- CHARACTER*4 CHOPL,CHOPR
- LOGICAL LDIO,RDIO
-#include "cspack/czopts.inc"
-#include "cspack/czopen.inc"
- IRC = 0
- IF(LRECL.EQ.0) THEN
- IRC = -1
- PRINT *,'XZPUTX. the record length (in bytes) must be given'
- RETURN
- ENDIF
-
-#if defined(CERNLIB_UNIX)
- LDIO = .TRUE.
- CHOPL = 'ID'
- IF(IOPTC.NE.0) CHOPL = 'CID'
-#endif
-#if !defined(CERNLIB_UNIX)
- LDIO = .FALSE.
- CHOPL = 'I'
-#endif
-
-*
-* Open local file, options Input
-*
- NCHL = LENOCC(LOCAL)
- NCHR = LENOCC(REMOTE)
- IF(IOPTA.EQ.0) THEN
- IF(IDEBXZ.GE.3) PRINT *,'XZPUTX. open local file ',
- + LOCAL(1:NCHL),' with LRECL ',LRECL,' options ',CHOPL
- CALL SZOPEN(LUNXZI,LOCAL(1:NCHL),LRECL,CHOPL,ISTAT)
- IF(ISTAT.NE.0) GOTO 95
- ENDIF
-*
-* Ask remote server what type of system it is running
-*
- CHMAIL = 'XZIO :RSYS'
- CALL CZPUTA(CHMAIL,ISTAT)
- CALL CZGETA(CHMAIL,ISTAT)
- IF(INDEX(CHMAIL,'UNIX').NE.0) THEN
- RDIO = .TRUE.
- IF(IOPTR.NE.0) THEN
- CHOPR = 'OD'
- IF(IOPTC.NE.0) CHOPR = 'COD'
- ELSE
- CHOPR = 'NOD'
- IF(IOPTC.NE.0) CHOPR = 'NCOD'
- ENDIF
- ELSE
- RDIO = .FALSE.
- CHOPR = 'NO'
- IF(IOPTR.NE.0) CHOPR = 'O'
- ENDIF
-
-*
-* Create remote file
-*
- NODE = CUNODE
- CHNODE(LUNXZO) = NODE
- JSKIN(LUNXZO) = ISKIN
- JSKOUT(LUNXZO) = ISKOUT
- IF(IDEBXZ.GE.3) PRINT *,'XZPUTX. open remote file ',
- + REMOTE(1:NCHR),' with LRECL ',LRECL,' options ',CHOPR
- CALL XZOPEN(LUNXZO,REMOTE(1:NCHR),NODE,LRECL,CHOPR,IRC)
- IF(IRC.NE.0) GOTO 90
-*
-* Start transfer
-*
- NR=0
-*
-* Start timer
-*
- IF(IOPTS.NE.0) THEN
- CALL CZRTIM(DELTIM)
- CALL TIMED(T)
- ENDIF
-
- NREC = 0
- 20 CONTINUE
- NREC = NREC + 1
-
- IF(LDIO) THEN
- IREC = NREC
- ELSE
- IREC = 0
- ENDIF
-
- IF(RDIO) THEN
- JREC = NREC
- ELSE
- JREC = 0
- ENDIF
-
-
- CALL SZREAD(LUNXZI,IBUFF,IREC,LRECL,NGOT,' ',IRC)
- IF(IRC.EQ.0) THEN
- CALL XZRITE(LUNXZO,IBUFF,JREC,LRECL,' ',IRC)
- IF(IRC.EQ.0) THEN
- NR = NR + 1
- GOTO 20
- ELSEIF(IRC.GT.0) THEN
-*
-* If we are in D/A mode, assume EOF if NR > 0
-*
- IF((LDIO).AND.(NR.GT.0)) GOTO 98
- GOTO 97
- ENDIF
- ENDIF
-
- 98 CONTINUE
- CLOSE(LUNXZI)
- CALL XZCLOS(LUNXZO,' ',IRC)
- IF(IDEBXZ.GE.0) PRINT *,' File transfer completed'
- IF(IOPTS.NE.0)THEN
- CALL CZRTIM(DELTIM)
- CALL TIMED(T)
- READ(DELTIM,'(I2,1X,I2,1X,I2)') IHOUR,IMIN,ISEC
- NSECS = ISEC + IMIN*60 + IHOUR*3600
- IF(NSECS.LE.0) NSECS = 1
- NKILO = NR*LRECL / 1024
- RATE = FLOAT(NKILO)/FLOAT(NSECS)
-#include "cspack/xzstat.inc"
- PRINT *,' Transferred ',NR,' records, transfer rate = ',RATE,
- + ' KB/S'
- PRINT *,' Elapsed time = ',DELTIM,' CP time = ',T,' sec.'
- ENDIF
- GO TO 99
-*
-* Error
-*
- 90 PRINT *, ' Cannot open remote file'
- IRC = 1
- GO TO 99
- 95 PRINT *, ' Cannot open local file'
- IRC = 2
- GO TO 99
- 97 PRINT *, 'Problem in transferring file'
- IRC = 3
- CLOSE(LUNXZI)
-*
- 99 END
diff --git a/src/packlib/cspack/xz/xzpwd.F b/src/packlib/cspack/xz/xzpwd.F
deleted file mode 100644
index 81b6bb0..0000000
--- a/src/packlib/cspack/xz/xzpwd.F
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: xzpwd.F,v 1.1.1.1 1996/03/08 15:44:32 mclareni Exp $
-*
-* $Log: xzpwd.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:32 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE XZPWD(PATH,IRC)
- CHARACTER*(*) PATH
-#include "cspack/czsock.inc"
-#include "cspack/hcmail.inc"
-#include "cspack/quest.inc"
-*
-#include "cspack/czopen.inc"
- IRC = 0
- CHMAIL = 'XZIO :PWD '
- CALL CZPUTA(CHMAIL,ISTAT)
- CALL CZGETA(CHMAIL,ISTAT)
- LPATH = LENOCC(CHMAIL)
- IF(INDEX(CHMAIL,'Current working directory is').NE.0) THEN
- JPATH = 31
- PATH = CHMAIL(JPATH:LPATH)
- ELSE
- IRC = -1
- ENDIF
-#include "cspack/czmess.inc"
- 99 END
diff --git a/src/packlib/cspack/xz/xzread.F b/src/packlib/cspack/xz/xzread.F
deleted file mode 100644
index a50e7e4..0000000
--- a/src/packlib/cspack/xz/xzread.F
+++ /dev/null
@@ -1,45 +0,0 @@
-*
-* $Id: xzread.F,v 1.1.1.1 1996/03/08 15:44:32 mclareni Exp $
-*
-* $Log: xzread.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:32 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE XZREAD(LUN,IBUFF,NREC,NWANT,NGOT,CHOPT,IRC)
-#include "cspack/zmach.inc"
-#include "cspack/hcmail.inc"
-#include "cspack/quest.inc"
-#include "cspack/czsock.inc"
- INTEGER IBUFF(NWANT/IQCHAW)
- DIMENSION ICONT(2)
-#include "cspack/czopts.inc"
-*
- IRC = 0
- NGOT = 0
-*
-* Instruct server to issue a read
-*
- CALL CZSWAP(' ',LUN,ISTAT)
- WRITE(CHMAIL,9001) LUN,NREC,NWANT,CHOPT
-9001 FORMAT('XZIO :READ',I3,I6,I6,'/',A8,'/')
- CALL CZPUTA(CHMAIL,ISTAT)
-*
-* Get status information back from server
-*
-#include "cspack/czmess.inc"
-*
-* Read data and return to caller
-*
- IF(IRC.EQ.0) THEN
- ICONT(1) = 0
- LBUF = NWANT/4
- IF(NGOT.NE.0) LBUF = NGOT
- CALL CZTCP(IBUFF,ICONT)
- ENDIF
- CALL CZSWAP(' ',0,ISTAT)
- IRC = IQUEST(1)
-
- END
-
diff --git a/src/packlib/cspack/xz/xzrewd.F b/src/packlib/cspack/xz/xzrewd.F
deleted file mode 100644
index c6f1ab3..0000000
--- a/src/packlib/cspack/xz/xzrewd.F
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: xzrewd.F,v 1.1.1.1 1996/03/08 15:44:32 mclareni Exp $
-*
-* $Log: xzrewd.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:32 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE XZREWD(LUN,CHOPT,IRC)
-#include "cspack/hcmail.inc"
-#include "cspack/quest.inc"
-#include "cspack/czopts.inc"
- IRC = 0
-*
-* Request rewind of LUN
-*
- CALL CZSWAP(' ',LUN,ISTAT)
- WRITE(CHMAIL,9001) LUN
-9001 FORMAT('XZIO :REWD',I3)
- CALL CZPUTA(CHMAIL,ISTAT)
-* Sequence to process server messages
-#include "cspack/czmess.inc"
- CALL CZSWAP(' ',0,ISTAT)
-
- END
-
diff --git a/src/packlib/cspack/xz/xzrfrf.F b/src/packlib/cspack/xz/xzrfrf.F
deleted file mode 100644
index 4a1b963..0000000
--- a/src/packlib/cspack/xz/xzrfrf.F
+++ /dev/null
@@ -1,245 +0,0 @@
-*
-* $Id: xzrfrf.F,v 1.5 1998/09/25 09:25:36 mclareni Exp $
-*
-* $Log: xzrfrf.F,v $
-* Revision 1.5 1998/09/25 09:25:36 mclareni
-* Modifications for the Mklinux port flagged by CERNLIB_PPC
-*
-* Revision 1.4 1997/10/23 13:26:28 mclareni
-* NT mods
-*
-* Revision 1.3 1997/09/02 08:46:28 mclareni
-* WINNT mods, mostly cpp defines
-* call vxinvb for WINNT too.
-*
-* Revision 1.2 1997/01/17 08:56:18 gunter
-* call vxinvb for linux too.
-*
-* Revision 1.1.1.1 1996/03/08 15:44:32 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE XZRFRF(CHFZ,CHRZ,LRECL,CHOPT,IRC)
-
- CHARACTER*(*) CHRZ,CHFZ
- CHARACTER*4 CHOPE,CHOPF,CHOPR
-
-#include "cspack/hcmail.inc"
-#include "cspack/czunit.inc"
-#include "cspack/czsock.inc"
-#include "cspack/zmach.inc"
-#include "cspack/pawc.inc"
- DIMENSION IQ(2),Q(2),LQ(8000)
- EQUIVALENCE (LQ(1),LMAIN),(IQ(1),LQ(9)),(Q(1),IQ(1))
-#include "zebra/rzk.inc"
- COMMON /RZCL/ LTOP,LRZ0,LCDIR,LRIN,LROUT,LFREE,LUSED,LPURG
- +, LTEMP,LCORD,LFROM
- CHARACTER*8 CHTAG(100)
- CHARACTER*99 CHFORM
- CHARACTER*12 CHORG
- DIMENSION IHTAG(2),ICDIR(400),IHEAD(500)
- EQUIVALENCE (ICDIR(1),IHEAD(4))
-#include "cspack/quest.inc"
- CHARACTER*80 CARD
- CHARACTER*8 DELTIM
- DIMENSION IUHEAD(400)
- DIMENSION IOCR(100)
- PARAMETER (JBIAS=2)
- PARAMETER (MEGA=1024*1024)
- COMMON/FZSTAT/INFLUN,INFSTA,INFOFZ(40)
- INTEGER OURECL
- DIMENSION ITEST(5)
-#if defined(CERNLIB_IPSC)
- DATA IPATT/'0123CDEF'X/
-#elif defined(CERNLIB_WINNT)
- DATA IPATT/Z'0123CDEF'/
-#elif defined(CERNLIB_DECS) || defined(CERNLIB_LINUX)
- DATA IPATT/X'0123CDEF'/
-#elif defined(CERNLIB_VAX)
- DATA IPATT/Z0123CDEF/
-#endif
-#include "cspack/czopts.inc"
-
- IRC = 0
- LCHRZ = LENOCC(CHRZ)
- LCHFZ = LENOCC(CHFZ)
- LCHOPT = LENOCC(CHOPT)
- NRECQQ = IQUEST(10)
-
- IF(LCHRZ.EQ.0.OR.LCHFZ.EQ.0) THEN
- IF(IDEBXZ.GE.0) PRINT *,'XZRFRF. error - input or ',
- + 'output file name missing'
- IRC = -1
- GOTO 99
- ENDIF
-
- IF(IDEBXZ.GE.1) PRINT *,'XZRFRF. enter for ',CHFZ(1:LCHFZ),
- + ' ',CHRZ(1:LCHRZ),' ',CHOPT(1:LCHOPT)
-
- CHOPE = ' '
- CHOPF = 'XI'
- JRECL = 80
-
-#if defined(CERNLIB_UNIX)
- CHOPE = 'D'
- CHOPF = 'DI'
-#endif
-
- IF(IOPTA.NE.0) THEN
- CHOPE = 'F'
- CHOPF = 'AI'
- ELSE
-#if defined(CERNLIB_VAXVMS)
- INQUIRE(FILE=CHFZ(1:LCHFZ),RECL=JRECL)
-#endif
- ENDIF
-
- LCHOPE = LENOCC(CHOPE) + 1
- IF(IOPTC.NE.0) CHOPF(LCHOPE:LCHOPE) = 'C'
-
- CALL SZOPEN(LUNXZI,CHFZ(1:LCHFZ),JRECL,CHOPE,IRC)
- IF(IRC.NE.0) GOTO 99
-
- IF(IOPTA.EQ.0) THEN
-*
-* Get record length from file
-*
-#if !defined(CERNLIB_UNIX)
- READ(LUNXZI,IOSTAT=ISTAT) ITEST
- REWIND(LUNXZI)
-#endif
-#if defined(CERNLIB_UNIX)
- READ(LUNXZI,REC=1,IOSTAT=ISTAT) ITEST
-#endif
-
- IF(ISTAT.NE.0) THEN
- PRINT *,'XZRFRF. error ',ISTAT,' reading input file'
- CLOSE(LUNXZI)
- GOTO 99
- ENDIF
-
-#if defined(CERNLIB_VAX)||defined(CERNLIB_DECS) || (defined(CERNLIB_LINUX) && !defined(CERNLIB_PPC)) || defined(CERNLIB_WINNT)
- IF(ITEST(1).NE.IPATT) CALL VXINVB(ITEST(5),1)
-#endif
-#if !defined(CERNLIB_CRAY)
- JRECL = JBYT(ITEST(5),1,24) * 4
-#endif
-#if defined(CERNLIB_CRAY)
- JRECL = JBYT(ITEST(3),1,24) * 4
-#endif
-*
-* Check if JRECL is reasonable
-*
- IF(JRECL.GT.32756.OR.JRECL.LT.0) THEN
- PRINT *,'XZRFRF. cannot determine record length of ',
- + 'input file. How was this file created?'
- IRC = JRECL
- CLOSE(LUNXZI)
- GOTO 99
- ENDIF
-
- IF(IDEBXZ.GE.2) PRINT *,'XZRFRF. record length of input ',
- + 'file is ',JRECL,' bytes'
-*
-* Close and reopen file
-*
- CALL SZCLOS(LUNXZI,' ',IRC)
- CALL SZOPEN(LUNXZI,CHFZ(1:LCHFZ),JRECL,CHOPE,IRC)
-
- ENDIF
-
- IF(IDEBXZ.GE.2) PRINT *,'XZRFRF. call FZFILE for ',
- + 'JRECL = ',JRECL,' chopt = ',CHOPF
- CALL FZFILE(LUNXZI,JRECL/4,CHOPF)
- CALL FZLOGL(LUNXZI,IDEBXZ)
-
- 5 NH=KNSIZE
- CALL FZIN(LUNXZI,0,0,0,'S',NH,IHEAD)
- IRC = IQUEST(1)
- IF(IRC.NE.0) THEN
- IF(IDEBXZ.GE.0) PRINT *,'XZRFRF. error reading FZ file'
- GO TO 98
- ENDIF
- IF(NH.NE.2) GO TO 5
- IF(IHEAD(1).NE.12345) GO TO 5
- 7 NH=KNSIZE
- CALL FZIN(LUNXZI,0,0,0,'S',NH,IHEAD)
- IRC = IQUEST(1)
- IF(IRC.NE.0) THEN
- IF(IDEBXZ.GE.0) PRINT *,'XZRFRF. error reading FZ file'
- GO TO 98
- ENDIF
- IF(NH.NE.KNSIZE) GO TO 7
- IF(IHEAD(1).NE.1) GO TO 7
-C
- NREC = ICDIR(KQUOTA)
- IF(IOPTQ.NE.0) THEN
- IF(IDEBXZ.GE.0) WRITE(6,7001) NREC,NRECQQ
-7001 FORMAT(' XZRFRF. quota of output file will be changed from ',
- + I10,' to ',I10)
- NREC = NRECQQ
- ENDIF
- NWKEY = ICDIR(KNWKEY)
- KTAGS = KKDES+(NWKEY-1)/10+1
- CHFORM = ' '
- LB = ICDIR(KLB)
- OURECL = ICDIR(LB+1)
-
- DO 10 I=1,NWKEY
- CALL ZITOH(ICDIR(KTAGS+2*I-2),IHTAG,2)
- CALL UHTOC(IHTAG,4,CHTAG(I),8)
- IKDES=(I-1)/10
- IKBIT1=3*I-30*IKDES-2
- IFORM=JBYT(ICDIR(KKDES+IKDES),IKBIT1,3)
- IF(IFORM.EQ.3)THEN
- CHFORM(I:I)='H'
- ELSEIF(IFORM.EQ.4)THEN
- CHFORM(I:I)='A'
- ELSEIF(IFORM.EQ.1)THEN
- CHFORM(I:I)='B'
- ELSE
- CHFORM(I:I)='I'
- ENDIF
- 10 CONTINUE
-
- CALL FZENDI(LUNXZI,'IQ')
-*
-* Open output file
-*
- IF(LRECL.GT.0) OURECL = LRECL / IQCHAW
- CHOPR = 'N'
- IF(IOPTX.NE.0) CHOPR = 'XN'
- LCHOPR = LENOCC(CHOPR) + 1
- IF(IOPTC.NE.0) CHOPR(LCHOPR:LCHOPR) = 'P'
-
- IF(IDEBXZ.GE.1) PRINT 9001,CHRZ(1:LCHRZ),CHOPR,OURECL
-9001 FORMAT(' XZRFRF. calling RZOPEN for ',A,1X,A,1X,I6)
-
- CALL RZOPEN(LUNXZO,'RZ',CHRZ(1:LCHRZ),CHOPR,OURECL,IRC)
-
- CHOPR = ' '
- LCHOPR = 0
- IF(IOPTX.NE.0) THEN
- CHOPR = 'X'
- LCHOPR = 1
- ENDIF
- IF(IOPTN.NE.0) CHOPR(LCHOPR+1:) = 'N'
-
- IF(IDEBXZ.GE.1) PRINT 9002,CHOPR,NREC
-9002 FORMAT(' XZRFRF. calling RZMAKE for ',A,1X,I6)
-
- CALL RZMAKE(LUNXZO,'RZ',NWKEY,CHFORM,CHTAG,NREC,CHOPR)
- IQ(LTOP+KDATEC)=ICDIR(KDATEC)
- IQ(LTOP+KDATEM)=ICDIR(KDATEM)
- CALL RZFRFZ(LUNXZI,' ')
- IF(IOPTS.NE.0) CALL RZSTAT('//RZ',99,' ')
-
- CALL RZCLOS('RZ',' ')
-98 CONTINUE
- CALL FZENDI(LUNXZI,'TE')
- CALL SZCLOS(LUNXZI,' ',IRC)
-
-99 CONTINUE
-
- END
diff --git a/src/packlib/cspack/xz/xzrite.F b/src/packlib/cspack/xz/xzrite.F
deleted file mode 100644
index adf6e68..0000000
--- a/src/packlib/cspack/xz/xzrite.F
+++ /dev/null
@@ -1,42 +0,0 @@
-*
-* $Id: xzrite.F,v 1.1.1.1 1996/03/08 15:44:32 mclareni Exp $
-*
-* $Log: xzrite.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:32 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE XZRITE(LUN,IBUFF,NREC,NWRIT,CHOPT,IRC)
-#include "cspack/zmach.inc"
-#include "cspack/hcmail.inc"
-#include "cspack/quest.inc"
-#include "cspack/czsock.inc"
- DIMENSION ICONT(2)
- INTEGER IBUFF(NWRIT/IQCHAW)
-#include "cspack/czopts.inc"
-*
- IRC = 0
-*
-* Instruct server to get ready for a write
-*
- CALL CZSWAP(' ',LUN,ISTAT)
- WRITE(CHMAIL,9001) LUN,NREC,NWRIT,CHOPT
-9001 FORMAT('XZIO :RITE',I3,I6,I6,'/',A8,'/')
- CALL CZPUTA(CHMAIL,ISTAT)
-*
-* Send the data
-*
- ICONT(1) = 1
- LBUF = NWRIT/4
- CALL CZTCP(IBUFF,ICONT)
-*
-* Read the return code and return to caller
-*
-#include "cspack/czmess.inc"
-
- CALL CZSWAP(' ',0,ISTAT)
- IRC = IQUEST(1)
-
- END
-
diff --git a/src/packlib/cspack/xz/xzrm.F b/src/packlib/cspack/xz/xzrm.F
deleted file mode 100644
index f050af8..0000000
--- a/src/packlib/cspack/xz/xzrm.F
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: xzrm.F,v 1.1.1.1 1996/03/08 15:44:32 mclareni Exp $
-*
-* $Log: xzrm.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:32 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE XZRM(FILE,IRC)
-#include "cspack/czsock.inc"
-#include "cspack/hcmail.inc"
-#include "cspack/quest.inc"
- CHARACTER*80 CHMESS
- CHARACTER*(*) FILE
-*
-#include "cspack/czopen.inc"
- LF = LENOCC(FILE)
-*
- CHMAIL = 'XZIO :RM '//FILE(1:LF)
- CALL CZPUTA(CHMAIL,ISTAT)
-#include "cspack/czmess.inc"
- 99 END
-
diff --git a/src/packlib/cspack/xz/xzrsys.F b/src/packlib/cspack/xz/xzrsys.F
deleted file mode 100644
index caf97de..0000000
--- a/src/packlib/cspack/xz/xzrsys.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: xzrsys.F,v 1.1.1.1 1996/03/08 15:44:32 mclareni Exp $
-*
-* $Log: xzrsys.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:32 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE XZRSYS
-*-- Author : Jamie Shiers 17/07/91
-* Print remote O/S
-#include "cspack/czsock.inc"
-#include "cspack/hcmail.inc"
-#include "cspack/quest.inc"
-#include "cspack/czopen.inc"
- CHMAIL = 'XZIO :RSYS'
- PRINT *,'Remote operating system:'
- CALL CZPUTA(CHMAIL,ISTAT)
-#include "cspack/czmess.inc"
-99 END
diff --git a/src/packlib/cspack/xz/xzrtof.F b/src/packlib/cspack/xz/xzrtof.F
deleted file mode 100644
index 702724a..0000000
--- a/src/packlib/cspack/xz/xzrtof.F
+++ /dev/null
@@ -1,144 +0,0 @@
-*
-* $Id: xzrtof.F,v 1.2 1998/07/10 10:51:42 jamie Exp $
-*
-* $Log: xzrtof.F,v $
-* Revision 1.2 1998/07/10 10:51:42 jamie
-* LRECL undefined - problems transferring multiple files with different LRECL
-*
-* Revision 1.1.1.1 1996/03/08 15:44:32 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE XZRTOF(CHRZ,CHFZ,IRECL,CHOPT,IRC)
-
- CHARACTER*(*) CHRZ,CHFZ
- CHARACTER*4 CHOPO,CHOPF
-
-#include "cspack/hcmail.inc"
-#include "cspack/czunit.inc"
-#include "cspack/czsock.inc"
-#include "cspack/zmach.inc"
-#include "cspack/pawc.inc"
- CHARACTER*8 RZOPTS
- DIMENSION IQ(2),Q(2),LQ(8000)
- EQUIVALENCE (LQ(1),LMAIN),(IQ(1),LQ(9)),(Q(1),IQ(1))
-#include "cspack/quest.inc"
-#include "cspack/czopts.inc"
-
- IRC = 0
- LCHRZ = LENOCC(CHRZ)
- LCHFZ = LENOCC(CHFZ)
- LCHOPT = LENOCC(CHOPT)
-
- IF(LCHRZ.EQ.0.OR.LCHFZ.EQ.0) THEN
- IF(IDEBXZ.GE.0) PRINT *,'XZRTOF. error - input or ',
- + 'output file name missing'
- IRC = -1
- GOTO 99
- ENDIF
-
- IF(IDEBXZ.GE.1) PRINT *,'XZRTOF. enter for ',CHRZ(1:LCHRZ),
- + ' ',CHFZ(1:LCHFZ),' ',CHOPT(1:LCHOPT)
-*
-* Open input file
-*
- LOPTS = 0
- RZOPTS = ' '
- LRECL = 0
-
- IF(IOPTC.NE.0) THEN
- LOPTS = LOPTS + 1
- RZOPTS(LOPTS:LOPTS) = 'P'
- ENDIF
-
- IF(IOPTX.NE.0) THEN
- LOPTS = LOPTS + 1
- RZOPTS(LOPTS:LOPTS) = 'X'
- ENDIF
-
- CALL RZOPEN(LUNXZI,'RZ',CHRZ(1:LCHRZ),RZOPTS,LRECL,IRC)
-
- IF(IRC.NE.0) THEN
- IF(IDEBXZ.GE.0) PRINT *,'XZRTOF. error from RZOPEN = ',IRC
- GOTO 99
- ENDIF
-
- RZOPTS = ' '
- IF(IOPTX.NE.0) RZOPTS = 'X'
-
- CALL RZFILE(LUNXZI,'RZ',RZOPTS)
-
- IRC = IQUEST(1)
- IF(IRC.NE.0) THEN
- IF(IDEBXZ.GE.0) PRINT *,'XZRTOF. error from RZFILE = ',IRC
- CLOSE(LUNXZI)
- GOTO 99
- ENDIF
-
- IF(IOPTS.NE.0) CALL RZSTAT('//RZ',99,' ')
-*
-* Open the output file
-*
- JRECL = IRECL
-#if !defined(CERNLIB_UNIX)
- CHOPO = 'ON'
- CHOPF = 'XO'
-#endif
-#if defined(CERNLIB_UNIX)
- CHOPO = 'DON'
- CHOPF = 'DO'
-#endif
- IF(IOPTA.NE.0) THEN
- JRECL = 80
- CHOPO = 'FON'
- CHOPF = 'AO'
- ENDIF
-
- LCHOPO = LENOCC(CHOPO)
- IF(IOPTR.NE.0) CHOPO(LCHOPO:LCHOPO) = ' '
- LCHOPO = LENOCC(CHOPO) + 1
- IF(IOPTC.NE.0) CHOPO(LCHOPO:LCHOPO) = 'C'
-
- IF(IDEBXZ.GE.3) PRINT *,'XZRTOF. call SZOPEN for ',
- + LUNXZO,CHFZ(1:LCHFZ),JRECL,CHOPO
- CALL SZOPEN(LUNXZO,CHFZ(1:LCHFZ),JRECL,CHOPO,IRC)
-
- IF(IRC.EQ.28) THEN
- IF(IDEBXZ.GE.0) PRINT *,'XZRTOF. file ',CHFZ(1:LCHFZ),
- + ' already exists - specify R option to replace'
- CLOSE(LUNXZI)
- GOTO 98
- ENDIF
-
- IF(IRC.NE.0) THEN
- IF(IDEBXZ.GE.0) PRINT *,'XZRTOF. error from SZOPEN = ',IRC
- CLOSE(LUNXZI)
- GOTO 98
- ENDIF
-*
-* Issue FZFILE
-*
- CALL FZFILE(LUNXZO,JRECL/4,CHOPF)
- IRC = IQUEST(1)
- IF(IRC.NE.0) THEN
- IF(IDEBXZ.GE.0) PRINT *,'XZRTOF. error from FZFILE = ',IRC
- GOTO 98
- ENDIF
-
- CALL FZLOGL(LUNXZO,IDEBXZ)
-*
-* Convert the file
-*
- CALL RZTOFZ(LUNXZO,'C')
-*
-* Terminate and close
-*
- CALL FZENDO(LUNXZO,'TE')
-98 CONTINUE
- CLOSE(LUNXZO)
- CALL RZCLOS('RZ',' ')
-
-99 CONTINUE
-
- END
diff --git a/src/packlib/cspack/xz/xzrzcp.F b/src/packlib/cspack/xz/xzrzcp.F
deleted file mode 100644
index dd0978c..0000000
--- a/src/packlib/cspack/xz/xzrzcp.F
+++ /dev/null
@@ -1,170 +0,0 @@
-*
-* $Id: xzrzcp.F,v 1.1.1.1 1996/03/08 15:44:32 mclareni Exp $
-*
-* $Log: xzrzcp.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:32 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE XZRZCP(CHIN,CHOUT,IRECL,CHOPT,IRC)
-
- CHARACTER*(*) CHIN,CHOUT
- CHARACTER*4 CHOPO,CHOPM
-#include "cspack/slate.inc"
-#include "cspack/hcmail.inc"
-#include "cspack/czunit.inc"
-#include "cspack/czsock.inc"
-#include "cspack/zmach.inc"
-#include "cspack/pawc.inc"
- DIMENSION KEYI(100),KEYO(100)
- DIMENSION IQ(2),Q(2),LQ(8000)
- EQUIVALENCE (LQ(1),LMAIN),(IQ(1),LQ(9)),(Q(1),IQ(1))
- CHARACTER*8 CHTAG(100)
- CHARACTER*90 CHFORM
- DIMENSION IHTAG(2)
-#include "cspack/rzclun.inc"
- COMMON /RZCL/ LTOP,LRZ0,LCDIR,LRIN,LROUT,LFREE,LUSED,LPURG
- +, LTEMP,LCORD,LFROM
- PARAMETER (KUP=5,KPW1=7,KNCH=9,KDATEC=10,KDATEM=11,KQUOTA=12,
- + KRUSED=13,KWUSED=14,KMEGA=15,KIRIN=17,KIROUT=18,
- + KRLOUT=19,KIP1=20,KNFREE=22,KNSD=23,KLD=24,KLB=25,
- + KLS=26,KLK=27,KLF=28,KLC=29,KLE=30,KNKEYS=31,
- + KNWKEY=32,KKDES=33,KNSIZE=253,KEX=6,KNMAX=100)
-#include "cspack/quest.inc"
-#include "cspack/czopts.inc"
-
- IRC = 0
-
- WRITE(6,9001)
- 9001 FORMAT(' XZRZCP. this routine used the RZ routine RZCOPY.',/,
- + ' Unfortunately, permits neither data nor',
- + ' record length conversion.')
- WRITE(6,9002)
- 9002 FORMAT(' XZRZCP. data (e.g. native to exchange) and/or',
- + ' record length conversion can',/,8X,
- + ' be accomplished using the RTOF/RFRF ZFTP commands.')
- RETURN
-
-#if defined(CERNLIB_ONEDAY)
- NRECS = IS(1)
- LCHIN = LENOCC(CHIN)
- LCHOUT = LENOCC(CHOUT)
- LCHOPT = LENOCC(CHOPT)
-
- IF(IDEBXZ.GE.1) PRINT *,'XZRZCP. enter for ',
- + CHIN(1:LCHIN),' ',CHOUT(1:LCHOUT),' ',
- + IRECL,' ',CHOPT
-
- IF(LCHIN.EQ.0.OR.LCHOUT.EQ.0) THEN
- IF(IDEBXZ.GE.0) PRINT *,'XZRZCP. error - input or ',
- + 'output file name missing'
- IRC = -1
- GOTO 40
- ENDIF
-*
-* Open input file
-*
- IF(IOPTC.NE.0) THEN
- CALL RZOPEN(LUNXZI,'RZIN',CHIN(1:LCHIN),'P',JRECL,IRC)
- ELSE
- CALL RZOPEN(LUNXZI,'RZIN',CHIN(1:LCHIN),' ',JRECL,IRC)
- ENDIF
-
- IF(IRC.NE.0) THEN
- IF(IDEBXZ.GE.0) PRINT *,'XZRZCP. cannot open input file'
- GOTO 40
- ELSEIF(IDEBXZ.GE.0) THEN
- PRINT *,'XZRZCP. input file opened with LRECL = ',JRECL
- ENDIF
-
- CALL RZFILE(LUNXZI,'RZIN',' ')
- IF(IQUEST(1).NE.0) THEN
- IRC = IQUEST(1)
- CLOSE(LUNXZI)
- GO TO 40
- ENDIF
-
- NREC = IQ(LCDIR+KQUOTA)
- IF(NRECS.GT.0) NREC = NRECS
- NWKEY = IQ(LCDIR+KNWKEY)
- KTAGS = KKDES+(NWKEY-1)/10+1
- LB = IQ(LCDIR+KLB)
- LRECL = IQ(LCDIR+LB+1)
- IDATEC = IQ(LCDIR+KDATEC)
- IDATEM = IQ(LCDIR+KDATEM)
-
- DO 10 I=1,NWKEY
- CALL ZITOH(IQ(LCDIR+KTAGS+2*I-2),IHTAG,2)
- CALL UHTOC(IHTAG,4,CHTAG(I),8)
- IKDES=(I-1)/10
- IKBIT1=3*I-30*IKDES-2
- IFORM=JBYT(IQ(LCDIR+KKDES+IKDES),IKBIT1,3)
- IF(IFORM.EQ.3)THEN
- CHFORM(I:I)='H'
- ELSEIF(IFORM.EQ.4) THEN
- CHFORM(I:I)='A'
- ELSEIF(IFORM.EQ.1) THEN
- CHFORM(I:I)='B'
- ELSE
- CHFORM(I:I)='I'
- ENDIF
- 10 CONTINUE
-*
-* Open output file
-*
- IF(IRECL.NE.0) LRECL = IRECL
-
- IF(IOPTN.NE.0) THEN
- CHOPM = ' '
- CHOPO = 'N'
- ELSEIF(IOPTX.NE.0) THEN
- CHOPM = 'X'
- CHOPO = 'NX'
- ENDIF
-
- LCHOPO = LENOCC(CHOPO)
-
- IF(IOPTC.NE.0) THEN
- LCHOPO = LCHOPO + 1
- CHOPO(LCHOPO:LCHOPO) = 'P'
- ENDIF
-*
-* Create output file
-*
- IF(IDEBXZ.GE.0) PRINT *,'XZRZCP. opening output file, LRECL = ',
- + LRECL
- CALL RZOPEN(LUNXZO,'RZOUT',CHOUT(1:LCHOUT),CHOPO(1:LCHOPO),
- + LRECL,IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBXZ.GE.0) PRINT *,'XZRZCP. cannot open output file'
- GOTO 30
- ENDIF
-
- NQUO = MIN(NREC,65000)
-
- IF(IDEBXZ.GE.0) PRINT *,'XZRZCP. making output file, NQUO = ',
- + NQUO
-
- CALL RZMAKE(LUNXZO,'RZOUT',NWKEY,CHFORM,CHTAG,NQUO,CHOPM)
- IF(IQUEST(1).NE.0) THEN
- IRC = IQUEST(1)
- IF(IDEBXZ.GE.0) PRINT *,'XZRZCP. cannot make output file'
- CLOSE(LUNXZO)
- GOTO 30
- ENDIF
-*
-* Copy the data
-*
- CALL RZCOPY('//RZIN',KEYI,ICYCLE,KEYO,'CKT')
-
- 20 CONTINUE
- CALL RZCLOS('RZOUT',' ')
-
- 30 CONTINUE
- CALL RZCLOS('RZIN',' ')
-
- 40 CONTINUE
-#endif
-
- END
diff --git a/src/packlib/cspack/xz/xzrzop.F b/src/packlib/cspack/xz/xzrzop.F
deleted file mode 100644
index 4313a42..0000000
--- a/src/packlib/cspack/xz/xzrzop.F
+++ /dev/null
@@ -1,70 +0,0 @@
-*
-* $Id: xzrzop.F,v 1.1.1.1 1996/03/08 15:44:32 mclareni Exp $
-*
-* $Log: xzrzop.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:32 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE XZRZOP(LUN,NODE,CHFILE,CHOPT,LRECL,IRC)
- CHARACTER*(*) CHFILE,NODE
-
-#include "cspack/czsock.inc"
-#include "cspack/hcmail.inc"
-#include "cspack/quest.inc"
-#include "cspack/czunit.inc"
-#include "cspack/czopts.inc"
- IRC = 0
-*
-* Does a link already exist to node in question
-*
- LN = LENOCC(NODE)
- LF = LENOCC(CHFILE)
- INODE = ICNTH(NODE(1:LN),CHNODE,MAXSOC)
-*
-* Always fill in node name
-*
- CHNODE(LUN) = NODE(1:LN)
- IF(INODE.EQ.0) THEN
-*
-* Request OPEN
-*
- CALL CZOPEN('zserv',NODE(1:LN),IRC)
- IF(IRC.NE.0) THEN
- PRINT *,'XZRZOP. cannot open communications with ',
- + NODE(1:LN)
- GOTO 99
- ENDIF
- JSKIN(LUN) = ISKIN
- JSKOUT(LUN) = ISKOUT
- ELSE
-*
-* Swap to current node
-*
- CALL CZSWAP(NODE(1:LN),0,ISTAT)
- IF(ISTAT.NE.0) THEN
- PRINT *,'XZOPEN. cannot swap to node ',NODE(1:LN)
- RETURN
- ENDIF
- JSKIN(LUN) = ISKIN
- JSKOUT(LUN) = ISKOUT
- ENDIF
- WRITE(CHMAIL,9001) CHFILE(1:LF)
-9001 FORMAT('XZIO :RZOP',A64)
- CALL CZPUTA(CHMAIL,ISTAT)
- CHMAIL = ' '
- WRITE(CHMAIL,9002) LUN,LRECL,CHOPT
-9002 FORMAT('XZIO :OLUN',I3,I6,'/',A8,'/')
- CALL CZPUTA(CHMAIL,ISTAT)
-*
-* Get status and record length
-*
- CALL CZGETA(CHMAIL,ISTAT)
-
- READ(CHMAIL,9003) IRC,LRECL
-9003 FORMAT(10X,I3,I6)
-
- CALL CZSWAP(' ',0,ISTAT)
-99 CONTINUE
- END
diff --git a/src/packlib/cspack/xz/xzsver.F b/src/packlib/cspack/xz/xzsver.F
deleted file mode 100644
index 0058409..0000000
--- a/src/packlib/cspack/xz/xzsver.F
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: xzsver.F,v 1.1.1.1 1996/03/08 15:44:32 mclareni Exp $
-*
-* $Log: xzsver.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:32 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE XZSVER
-#include "cspack/czsock.inc"
-#include "cspack/hcmail.inc"
-#include "cspack/quest.inc"
-*
-#include "cspack/czopen.inc"
- CHMAIL = 'XZIO :VER'
- CALL CZPUTA(CHMAIL,ISTAT)
-#include "cspack/czmess.inc"
- 99 END
-
diff --git a/src/packlib/cspack/xz/xzvers.F b/src/packlib/cspack/xz/xzvers.F
deleted file mode 100644
index 4e25ab6..0000000
--- a/src/packlib/cspack/xz/xzvers.F
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: xzvers.F,v 1.5 1996/04/12 07:40:07 cernlib Exp $
-*
-* $Log: xzvers.F,v $
-* Revision 1.5 1996/04/12 07:40:07 cernlib
-* new handling of cspack title
-*
-* Revision 1.4 1996/03/29 11:33:55 jamie
-* qftitlch
-*
-* Revision 1.3 1996/03/29 10:59:28 jamie
-* print 'title' more like patchy
-*
-* Revision 1.2 1996/03/28 11:13:39 jamie
-* update idatqq/itimqq
-*
-* Revision 1.1.1.1 1996/03/08 15:44:32 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE XZVERS
- IDATQQ = 960329
- ITIMQQ = 1200
-#include "cspack/qftitlch.inc"
- PRINT *,
- + CspackTitleFortranString
- PRINT *,' This version created on ',IDATQQ,
- + ' at ',ITIMQQ
- END
-
diff --git a/src/packlib/cspack/xz/xzwrtm.F b/src/packlib/cspack/xz/xzwrtm.F
deleted file mode 100644
index 22d8a60..0000000
--- a/src/packlib/cspack/xz/xzwrtm.F
+++ /dev/null
@@ -1,55 +0,0 @@
-*
-* $Id: xzwrtm.F,v 1.1.1.1 1996/03/08 15:44:32 mclareni Exp $
-*
-* $Log: xzwrtm.F,v $
-* Revision 1.1.1.1 1996/03/08 15:44:32 mclareni
-* Cspack
-*
-*
-#include "cspack/pilot.h"
- SUBROUTINE XZWRTM(LUNI,LUNO,IBUFF,NDO,NSTAL,NSTAR,NWRIT,CHOPT,IRC)
-#include "cspack/zmach.inc"
-#include "cspack/hcmail.inc"
-#include "cspack/quest.inc"
-#include "cspack/czsock.inc"
- DIMENSION ICONT(2)
- INTEGER IBUFF(NWRIT/IQCHAW)
-#include "cspack/czopts.inc"
-*
- IRC = 0
-*
-* Instruct server to get ready for a write
-*
- CALL CZSWAP(' ',LUNO,ISTAT)
- WRITE(CHMAIL,8001) LUNO,NSTAR,NWRIT,NDO,CHOPT
- 8001 FORMAT('XZIO :RITM',I3,I6,I6,I6,'/',A8,'/')
- CALL CZPUTA(CHMAIL,ISTAT)
-
- NRECL = NSTAL
-
- DO 33 JJ=1,NDO
-
- IF(IOPTD.NE.0) THEN
- READ(LUNI,REC=NRECL) IBUFF
- ELSE
- READ(LUNI) IBUFF
- ENDIF
- NRECL = NRECL + 1
-*
-* Send the data
-*
- ICONT(1) = 1
- LBUF = NWRIT/4
- CALL CZTCP(IBUFF,ICONT)
-
- 33 CONTINUE
-*
-* Read the return code and return to caller
-*
-#include "cspack/czmess.inc"
-
- CALL CZSWAP(' ',0,ISTAT)
- IRC = IQUEST(1)
-
- END
-
diff --git a/src/packlib/epio/Imakefile b/src/packlib/epio/Imakefile
deleted file mode 100644
index f5bb465..0000000
--- a/src/packlib/epio/Imakefile
+++ /dev/null
@@ -1,16 +0,0 @@
-
-#define IHaveSubdirs
-#define PassCDebugFlags
-
-AllTarget(libraries)
-
-LIBDIRS= code util
-SUBDIRS= $(LIBDIRS) tests epio
-
-TopOfPackage(epio)
-
-SubdirLibraryTarget(epio,$(LIBDIRS))
-
-TestSubdirs(tests)
-
-InstallIncludeSubdirs(epio)
diff --git a/src/packlib/epio/code/Imakefile b/src/packlib/epio/code/Imakefile
deleted file mode 100644
index 8bbd6f7..0000000
--- a/src/packlib/epio/code/Imakefile
+++ /dev/null
@@ -1,13 +0,0 @@
-SRCS_F= epaddh.F epblin.F epbout.F epclos.F epdacr.F epdefu.F epdrop.F \ @@\
- epend.F epeof.F eperrh.F epfhdr.F epfrd.F epgeta.F epgetc.F \ @@\
- epgetw.F ephead.F epinit.F epiot.F epoutl.F \ @@\
- epouts.F epread.F eprwnd.F epseta.F epsetc.F epsetw.F \ @@\
- epstat.F epunit.F epupdh.F epuref.F
-
-#ifndef CERNLIB_VAX
-SRCS_F:=$(SRCS_F) epopestf.F
-#else
-SRCS_F:=$(SRCS_F) epopevax.F
-#endif
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/epio/code/epaddh.F b/src/packlib/epio/code/epaddh.F
deleted file mode 100644
index 4f4c44f..0000000
--- a/src/packlib/epio/code/epaddh.F
+++ /dev/null
@@ -1,70 +0,0 @@
-*
-* $Id: epaddh.F,v 1.1.1.1 1996/03/08 15:21:43 mclareni Exp $
-*
-* $Log: epaddh.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:43 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
- SUBROUTINE EPADDH(LUNIT,NH,IH,IBUF,IERR)
-C.
-C. ADDS A USER PORTION TO THE STANDARD PHYSICAL HEADER.THE CURRENT BLOCK
-C. IS WRITTEN OUT BEFOREHAND IF NOT EMPTY.
-C.
-C. THE PHYS. HEADER IS RESET TO THE STANDARD HEADER AFTER A REWIND.
-C.
-C. INPUT :
-C.
-C. LUNIT LOGICAL UNIT
-C.
-C. NH NO. OF 16 OR 32 BIT WORDS TO ADD ( 0 POSSIBLE - RESETS )
-C.
-C. IH USER P.H. WORDS TO ADD (16 OR 32 BIT, RIGHT ADJ, 0 FILLED)
-C.++++ important: 32 bit words have to be converted beforehand by user
-C.
-C. IBUF USER PROVIDED UNIT BUFFER. MUST NOT BE TOUCHED BY USER.
-C.
-C. IERR ERROR FLAG. SEE SEPARATE LIST.
-#include "epio/epiocom.inc"
- DIMENSION IH(2),IBUF(2)
-C--- CHECK WHETHER SAME USER UNIT AS LAST TIME
- IF(LASTUT.EQ.LUNIT) GOTO 1551
-C--- NEW UNIT - GET REF
- CALL EPUNIT(LUNIT,IERR)
- IF(IERR.EQ.0) GOTO 1552
- GOTO 77777
- 1551 IERR=0
- IF(LREF.NE.0) GOTO 1552
- IERR=13
- CALL EPERRH(LUNIT,IERR)
- GOTO 77777
- 1552 CONTINUE
-C--- ERROR IF NO OUTPUT UNIT
- IF(LIST(ISTART+16).EQ.2) GOTO 9901
-C--- CREATE HEADER IF NOT YET DONE
- IF(LIST(ISTART+14).EQ.0) CALL EPHEAD(IBUF)
-C--- CLOSE
- CALL EPBOUT(IBUF,IERR)
- IF(IERR.NE.0) GOTO 77777
- K=MAX0(0,NH)
-C--- SET NEW HEADER LENGTH
- IF(LIST(ISTART+29).EQ.0) THEN
- I=1
- ELSE
- I=2
- ENDIF
- LIST(ISTART+7)=I*(LIST(6)+K)
- LIST(ISTART+14)=LIST(ISTART+7)
- IF(LIST(ISTART+29).EQ.0) THEN
- CALL BUN16W(IH,1,IBUF,LIST(6)+1,K)
- ELSE
- CALL BUN32W(IH,1,IBUF,LIST(6)+1,K)
- ENDIF
-77777 RETURN
- 9901 CONTINUE
-C--- UNIT IS AN INPUT UNIT
- IERR=17
- CALL EPERRH(LUNIT,IERR)
- GOTO 77777
- END
diff --git a/src/packlib/epio/code/epblin.F b/src/packlib/epio/code/epblin.F
deleted file mode 100644
index 1ca1ec5..0000000
--- a/src/packlib/epio/code/epblin.F
+++ /dev/null
@@ -1,428 +0,0 @@
-*
-* $Id: epblin.F,v 1.1.1.1 1996/03/08 15:21:43 mclareni Exp $
-*
-* $Log: epblin.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:43 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
- SUBROUTINE EPBLIN(IBUF,IERR)
-CD COMMON/EPDBGC/DBUGFL
-CD LOGICAL DBUGFL
-#include "epio/epiocom.inc"
- DIMENSION ILBHD(16)
-#include "epio/wordsize.inc"
-#if defined(CERNLIB_CDC)||defined(CERNLIB_IBM)||defined(CERNLIB_UNIVAC)||defined(CERNLIB_NORD)||defined(CERNLIB_CRAY)||defined(CERNLIB_STF77)||defined(CERNLIB_STF77VX)
- DIMENSION IBUF(1)
-#endif
-#if defined(CERNLIB_VAX)
- INTEGER*2 IBUF(1)
- INTEGER*4 EPDKRECL
- INCLUDE 'SYS$LIBRARY:FORIOSDEF/NOLIST'
- EXTERNAL SS$_NORMAL,SS$_ENDOFFILE,SS$_ENDOFTAPE
- EXTERNAL SS$_PARITY,SS$_DATAOVERUN,EPDKRECL
-#endif
-#if defined(CERNLIB_APOLLO)
-%INCLUDE '/sys/ins/base.ins.ftn'
-%INCLUDE '/sys/ins/error.ins.ftn'
-%INCLUDE '/sys/ins/streams.ins.ftn'
- INTEGER*2 IBUF(1), ERROR_$RETURNED
- INTEGER STATUS_$RETURNED
-#endif
-#if defined(CERNLIB_UNIVAC)
- DIMENSION NACC(2)
- DATA IEOF/'EOFM'/,IEP/O000000105120/
-#endif
-#if (defined(CERNLIB_IBM))&&(!defined(CERNLIB_QMIBMFSI))
- CHARACTER*4 ULP
- DATA ULP/'ULP '/
-#endif
-#if defined(CERNLIB_QMIBMFSI)
- CHARACTER*4 ULP
- DATA ULP/ZE4D3D740/
-#endif
-CD LABEL=1001
-CD IF(DBUGFL) PRINT*,LABEL,ISTART
- LUN=LIST(ISTART+10)
-C--SET NP (PHYS BLOCK LENGTH) = 0 AND NEW FORMAT INDICATOR
- LIST(ISTART+14)=0
- IERR=0
-#if defined(CERNLIB_VAX)
- IF(LIST(ISTART+16).EQ.0)CALL EPOPEN_VAX(2,IERR)
-#endif
-#if defined(CERNLIB_APOLLO)
- IF(LIST(ISTART+16).EQ.0) CALL EPOPEN_APOLLO(2)
-#endif
-#if defined(CERNLIB_STF77)||defined(CERNLIB_STF77VX)
- IF(LIST(ISTART+16).EQ.0) CALL EPOPEN(2,IERR)
-#endif
- if(IERR.ne.0)goto 20
- LIST(ISTART+16)=2
- IF(LIST(ISTART+17).LT.2)LIST(ISTART+17)=0
- MAXWDS=LIST(ISTART+1)
-#if defined(CERNLIB_IBM)
- IF(LIST(ISTART+11).EQ.0.AND.LIST(ISTART+25).EQ.0)
- 1 CALL IOOPTN(LUN,ULP,IRETCD)
-#endif
-#if defined(CERNLIB_NORD)
- NB=MAXWDS*2
- CALL IOREAD(LUN,IBUF,NB,IRETCD)
- IF(IRETCD.EQ.0)GOTO 50
- IF(IRETCD.EQ.1)GOTO 10
- IF(IRETCD.EQ.2)GOTO 20
- IF(IRETCD.EQ.3)GOTO 40
- IF(IRETCD.EQ.4)GOTO 30
- IF(IRETCD.EQ.8)GOTO 20
-C--INVALID IOREAD ARGUMENT
- 10 IERR=11
- GOTO 9999
-#endif
-#if defined(CERNLIB_IBM)
- NB=MAXWDS*2
- IF(LIST(ISTART+32).EQ.0) THEN
- CALL IOREAD(LUN,IBUF,NB,IRETCD)
- IF(IRETCD.EQ.0)GOTO 50
- IF(IRETCD.EQ.1)GOTO 10
- IF(IRETCD.EQ.2)GOTO 20
- IF(IRETCD.EQ.3)GOTO 40
- IF(IRETCD.EQ.4)GOTO 30
- IF(IRETCD.EQ.8)GOTO 20
-C--INVALID IOREAD ARGUMENT
- 10 IERR=11
- GOTO 9999
- ELSE
-*--- random access HG march 17, 89
- NRACR=LIST(ISTART+11)+1
- NRACW=MAXWDS/2
- READ(LUN,IOSTAT=IOS,REC=NRACR) (IBUF(I),I=1,NRACW)
- IF(IOS.EQ.-1)GO TO 20
- NB=2*MAXWDS
- GOTO 50
- ENDIF
-#endif
-#if defined(CERNLIB_CDC)
- NB=(16*MAXWDS-1)/60+1
- BUFFER IN(LUN,1)(IBUF(1),IBUF(NB))
- IF(UNIT(LUN)) 5,20,40
- 5 NB= LENGTH(LUN)*8
- GOTO 50
-#endif
-#if defined(CERNLIB_CRAY)
- IF(LIST(ISTART+32).EQ.0) THEN
- NB=(16*MAXWDS-1)/LIST(4) + 1
- CALL READ (LUN,IBUF(1),NB,IRETCD,NUBC)
- GOTO (5,5,20,20,30,40), IRETCD+2
- 5 NB=(LIST(4)*NB - NUBC)/8
- GOTO 50
- ELSE
-*--- random access MJC Nov 23, 89
- NRACR=LIST(ISTART+11)+1
- NRACW=(16*MAXWDS-1)/LIST(4) + 1
- READ(LUN,IOSTAT=IOS,REC=NRACR)(IBUF(I),I=1,NRACW)
- IF(IOS.LT.0)GO TO 20
-C
-C this can happen if Cray tries to read a whole no. of 4K blocks,
-C whereas actual data terminates with a partial block which has
-C not been padded (eg after transfer from VM).
-C If so, can be avoided by OMITTING -s bin on the assign for the
-C random access file to be read.
- IF(IOS.EQ.122)GO TO 30
- IF(IOS.GT.0)GO TO 40
- NB=2*MAXWDS
- GOTO 50
- ENDIF
-C --- end MJC random access
-#endif
-#if defined(CERNLIB_VAX)
- IF(LIST(ISTART+25).NE.0)THEN
-C
-C SPECIAL READ FOR VARIABLE LENGTH RECORDS
-C
- NB=0
- IOS=0
- CALL EPMTREAD(IBUF,MAXWDS*2,NB,IOS)
- IF(IOS.EQ.%LOC(SS$_NORMAL))THEN
- GO TO 50
- ELSE
- IF(IOS.EQ.%LOC(SS$_ENDOFFILE))GO TO 20
- IF(IOS.EQ.%LOC(SS$_ENDOFTAPE))GO TO 30
- IF(IOS.EQ.%LOC(SS$_PARITY))GO TO 40
- IF(IOS.EQ.%LOC(SS$_DATAOVERUN))GO TO 9902
- GO TO 9901
- ENDIF
- ELSE
-C
-C THIS IS THE CASE OF DISK FILE
-C
- IF(LIST(ISTART+32).EQ.0) THEN
- READ(LUN,IOSTAT=IOS)(IBUF(I),I=1,MAXWDS)
- IF(IOS.EQ.-1)GO TO 20
- IF(IOS.EQ.FOR$IOS_INPRECTOO)GO TO 9902
- IF(IOS.EQ.FOR$IOS_ERRDURREA)GO TO 40
- NB=EPDKRECL(LUN)
- ELSE
-*--- random access HG march 17, 89
- NRACR=LIST(ISTART+11)+1
- NRACW=LIST(ISTART+1)
- READ(LUN,IOSTAT=IOS,REC=NRACR) (IBUF(I),I=1,NRACW)
- IF(IOS.EQ.-1)GO TO 20
- NB=2*LIST(ISTART+1)
- ENDIF
- ENDIF
- IF(NB.LE.0)GO TO 9901
- GO TO 50
-#endif
-#if defined(CERNLIB_APOLLO)
- IF(LIST(ISTART+25).NE.0)THEN
-C
-C IN THE APOLLO CASE THE READING ROUTINE IS THE SAME FOR
-C MAGTAPES AND FOR DISK FILES
-C
- IF(LIST(ISTART+32).EQ.0) THEN
- NB=0
- CALL READ_$STREAM(IBUF,MAXWDS*2,NB,STATUS_$RETURNED)
- IF(STATUS_$RETURNED.EQ.STATUS_$OK) GO TO 50
- IF(LSHFT(ERROR_$SUBSYS(STATUS_$RETURNED),8)
- + .NE.STREAM_$SUBS) THEN
- WRITE(NOUTUT,1000)
-1000 FORMAT(' +++ EPIO/DOMAIN: Not a stream I/O error ???')
- GO TO 9901
- END IF
- ERROR_$RETURNED=ERROR_$CODE(STATUS_$RETURNED)
- IF(ERROR_$RETURNED.EQ.STREAM_$END_OF_FILE) GO TO 20
- IF(ERROR_$RETURNED.EQ.STREAM_$BOF_ERR) GO TO 30
- IF(ERROR_$RETURNED.EQ.STREAM_$INTERNAL_MM_ERROR.OR.
- * ERROR_$RETURNED.EQ.STREAM_$INTERNAL_FATAL_ERROR) GO TO 40
- IF(ERROR_$RETURNED.EQ.STREAM_$INSUFF_MEMORY)GO TO 9902
-C--- random access M.Rumpf 01/91
- ELSE
- NRACR = LIST(ISTART+11) + 1
- NRACW = MAXWDS
- READ(LUN,IOSTAT=IOS,REC=NRACR)(IBUF(I),I=1,NRACW)
- IF (IOS.EQ.-1) GO TO 20
- IF (IOS.GT.0) GO TO 40
- IF(IOS.EQ.0) THEN
- NB = 2*MAXWDS
- GO TO 50
- ENDIF
- ENDIF
-C --- end random access M.R
- END IF
-C
-C HERE SIMPLY SOMETHING IS WRONG
-C
- GO TO 9901
-#endif
-#if defined(CERNLIB_UNIVAC)
-C--UNIT NUMBER IN FIELDATA CHARACTERS
- LUNFD=LIST(ISTART+24)
- NWDS=(MAXWDS*16+35)/36
-C--FILE ADDRESS. < 0 IF TAPE, >= 0 IF DISK
- IOAD=LIST(ISTART+25)
- IF(IOAD.GE.0) THEN
- NACC(1)=2**18+LOCF(NBLKSZ)
- NACC(2)=NWDS*2**18+LOCF(IBUF)
- CALL FIOSCR(LUNFD,NACC,2,IOAD,ISTAT)
- ELSE
- CALL TIOR(LUNFD,IBUF,NWDS,ISTAT,IAFH)
- NBLKSZ=IABS(ISTAT)
- ENDIF
- IF(ISTAT.EQ.-1.OR.ISTAT.EQ.-2) GOTO 20
- IF(IOAD.GE.0) THEN
-C--IF DISK, NBLKSZ MUST CONTAIN ('EP',BLOCK SIZE) FOR A NORMAL BLOCK,
-C-- OR 'EOFM' FOR END-OF-FILE BLOCK.
- IF(NBLKSZ.EQ.IEOF) GOTO 20
- IEPR=BITS(NBLKSZ,1,18)
- IF(IEPR.EQ.IEP) THEN
- NBLKSZ=BITS(NBLKSZ,19,18)
- ELSE
-C--DISK FILE IS NOT IN EP-FORMAT -> ERROR 19 (UNIVAC ONLY)
- IERR=19
- GOTO 9999
- ENDIF
- ENDIF
- IF(ISTAT.LE.-6) THEN
-C--IERR=2+100*IABS(UNIVAC ERROR CODE)
- IERR=2+IABS(ISTAT)*100
- LIST(ISTART+13)=LIST(ISTART+13)+1
- GOTO 9999
- ENDIF
- NB=(36*NBLKSZ)/8
- GOTO 50
-#endif
-#if defined(CERNLIB_STF77)||defined(CERNLIB_STF77VX)
- MAXWDS=MAXWDS/N16PW
- IF(LIST(ISTART+33).EQ.2)THEN
- NWDONE=MAXWDS
- IF(LIST(ISTART+32).EQ.1) THEN
- call cfseek(list(istart+25),0,MAXWDS,LIST(ISTART+11),ISTAT)
- IF(ISTAT.NE.0)goto 45
- ENDIF
- call cfget(list(istart+25),0,MAXWDS,NWDONE,IBUF,ISTAT)
- if(ISTAT.eq.-1)goto 20
- if(ISTAT.ne.0 )goto 40
- ELSE IF(LIST(ISTART+33).EQ.1)THEN
-C In random mode hitting EOF is return as an error.
-C As disk errors are rare, assume they are End of File
-#endif
-#if (defined(CERNLIB_STF77)||defined(CERNLIB_STF77VX))&&(!defined(CERNLIB_STF77IB))
- READ(LUN,ERR=20,IOSTAT=IOSEOF,REC=LIST(ISTART+11)+1)
- 1 (IBUF(IWRD),IWRD=1,MAXWDS)
- IF (IOSEOF.EQ.-1) GOTO 20
-#endif
-#if defined(CERNLIB_STF77IB)
- READ(LUN,NUM=NB,ERR=20,REC=LIST(ISTART+11)+1)
- 1 (IBUF(IWRD),IWRD=1,MAXWDS)
-#endif
-#if defined(CERNLIB_STF77)||defined(CERNLIB_STF77VX)
- ELSE
-#endif
-#if (defined(CERNLIB_STF77)||defined(CERNLIB_STF77VX))&&(!defined(CERNLIB_STF77IB))
- READ(LUN,ERR=40,END=20)(IBUF(IWRD),IWRD=1,MAXWDS)
-#endif
-#if defined(CERNLIB_STF77IB)
- READ(LUN,NUM=NB,ERR=40,END=20)(IBUF(IWRD),IWRD=1,MAXWDS)
-#endif
-#if defined(CERNLIB_STF77)||defined(CERNLIB_STF77VX)
- ENDIF
- NB=MAXWDS*N16PW*2
- GOTO 50
-#endif
-C--EOF or OPEN ERROR, CANNOT FIND FILE
- 20 IF(LIST(ISTART+19) .EQ. 1)GOTO 30
- LIST(ISTART+19)=1
- IERR=1
- GOTO 9999
-C EOI
- 30 IERR=3
- GOTO 9999
-C PARITY
- 40 LIST(ISTART+13)=LIST(ISTART+13)+1
- IERR=2
-#if defined(CERNLIB_CRAY)
- IF(LIST(ISTART+32).EQ.0) THEN
- CALL SKIPBAD(LUN,NBLOCK,IRETCD)
- PRINT *,' HARWARE ERROR ON READ ',NBLOCK,' BLOCKS SKIPPED'
- IF(IRETCD.EQ.0) PRINT *,
- & ' NONZERO RETURN CODE FROM SKIPBAD, SERIOUS PROBLEM?'
- ENDIF
-#endif
- GOTO 9999
-#if defined(CERNLIB_STF77)||defined(CERNLIB_STF77VX)
-C Error from cfseek
- 45 IERR=25
- GOTO 9999
-#endif
-C GOOD BLOCK
- 50 LIST(ISTART+11)=LIST(ISTART+11) +1
-CD LABEL=1050
-CD IF(DBUGFL)PRINT*,LABEL,ISTART,(LIST(ISTART+JJJ),JJJ=11,22)
-C RESET EOF FLAG
- LIST(ISTART+19)=0
-#if defined(CERNLIB_UNIVAC)
-C--UPDATE FILE ADDRESS IF DISK. WE ASSUME F-FORMAT WITH 28 WORDS/SECTOR
- IF(IOAD.GE.0) LIST(ISTART+25)=LIST(ISTART+25)+(NBLKSZ+28)/28
-#endif
- IF(LIST(ISTART+18) .EQ. 0)GOTO 70
-C--HEADERLESS BLOCK
-C--- IF CONTROL WORD 27 SET, SWAP BYTES IF DONE IN PREVIOUS BLOCK
- IF(LIST(ISTART+28).NE.0) CALL BTSWAP(IBUF,NB)
- LIST(ISTART+7)=0
- LIST(ISTART+15)=0
- LIST(ISTART+18)=LIST(ISTART+18) - 1
- LIST(ISTART+14)=NB/2
- GOTO 77777
-C--BLOCK WITH HEADER
- 70 CONTINUE
-*--- could be 32 bit header - blow 16 16-bit words to check
- CALL BLO16W(IBUF,1,ILBHD,1,16)
-*--- make sure it is not 16-bit
- LIST(ISTART+28)=0
- LIST(ISTART+29)=0
- IF(LIST(ISTART+27).EQ.0) GOTO 72
- IF(ILBHD(7).EQ.29954.AND.ILBHD(8).EQ.31280) GOTO 72
-*--- or byte swapped 16-bit
- IF(ILBHD(7).EQ. 629.AND.ILBHD(8).EQ.12410) GOTO 71
-*--- check for 32 bit - control words 7 and 8 (identical)
-* first number is 7967 = 1F1F hex and therefore invariant under
-* byte swapping, second is 19132 = 4ABC hex and is used to byte swap
- IF(ILBHD(13).EQ.7967.AND.ILBHD(15).EQ.7967) THEN
-*--- 32 bit header - byte swap ?
- IF(ILBHD(14).NE.19132) THEN
- CALL BTSWAP(IBUF,NB)
- CALL BLO16W(IBUF,1,ILBHD,1,16)
- LIST(ISTART+28)=1
- ENDIF
- IF(ILBHD(14).NE.19132.OR.ILBHD(16).NE.19132) THEN
-*--- looks like 32 bit, but is not
- IERR=22
- GOTO 9999
- ENDIF
-*--- definitly 32 bit physical header
- CALL BLO32W(IBUF,1,ILBHD,1,12)
- CALL CFRIBM(ILBHD,12,2)
-*--- set 32 bit ph. header
- LIST(ISTART+29)=1
- NP=ILBHD(1)
- IF(NP.LE.0) GOTO 9901
- IF(NP .GT. LIST(ISTART+1).OR.NP.GT.NB/2) GOTO 9902
- NPHL=ILBHD(2)
- IF(NPHL.LT.LIST(6).OR.NPHL.GT.NP) THEN
- IERR=7
- GOTO 9999
- ENDIF
- ENDIF
- IF(LIST(ISTART+29).EQ.1)GOTO 150
-*--- 16 bit physical header
-C--- SWAP BYTES IF CONTROL WORD 27 SET, AND IF 16-BIT WORDS 7 AND 8
-C IN THE BLOCK HEADER ARE WRONG FOR EP FORMAT.
- 71 CONTINUE
- CALL BTSWAP(IBUF,NB)
- CALL BLO16W(IBUF,1,ILBHD,1,12)
- LIST(ISTART+28)=1
- 72 CONTINUE
- NP=ILBHD(1)
-CD LABEL=1070
-CD IF(DBUGFL)PRINT*,LABEL,ISTART,(LIST(ISTART+JJJ),JJJ=11,22)
- IF(NP.LE.0) GOTO 9901
- IF(NP .GT. LIST(ISTART+1).OR.NP.GT.NB/2) GOTO 9902
- NPHL=ILBHD(2)
- IF (NPHL. LT. LIST(6) .OR. NPHL .GT. NP
- 1 .OR. (ILBHD(7).NE.29954) .OR. (ILBHD(8).NE.31280))
- 2 GO TO 110
-*--- set 16 bit header
- LIST(ISTART+29)=0
- GO TO 150
- 110 CONTINUE
- IF(LIST(ISTART+27).LT.2)GOTO 120
- IERR=7
- GOTO 9999
-C--OLD FORMAT
- 120 IF (NPHL .LT.5 .OR. NPHL.GT.NP)IERR=7
- IF (IERR .NE.0) GOTO 9999
- LIST(ISTART+17) =1
- LIST(ISTART+3)=16
-C--WE HAVE A GOOD HEADER - 16 bit or 32 bit (ILBHD(6) = 0 or 1)
- 150 CONTINUE
- IF(LIST(ISTART+17).EQ.1) GOTO 160
- LIST(ISTART+3)=ILBHD(11)
- LIST(ISTART+9)=ILBHD(6)
- LIST(ISTART+18)=ILBHD(9)
- 160 CONTINUE
- LIST(ISTART+14)=NP
- LIST(ISTART+15)=ILBHD(4)
- LIST(ISTART+7)=NPHL
- LIST(ISTART+4)=ILBHD(5)
-77777 RETURN
- 9901 CONTINUE
-C--- BLOCK LENGTH (IBUF(1)) LE 0 - PROBABLY NOT EP FORMAT
- IERR=4
- GOTO 9999
- 9902 CONTINUE
-C--- IBUF(1) GT REAL PRL OR UNIT BUFFER TOO SMALL
- IERR=5
- 9999 CONTINUE
- LIST(ISTART+14)=0
- GOTO 77777
- END
diff --git a/src/packlib/epio/code/epbout.F b/src/packlib/epio/code/epbout.F
deleted file mode 100644
index 5c77c67..0000000
--- a/src/packlib/epio/code/epbout.F
+++ /dev/null
@@ -1,256 +0,0 @@
-*
-* $Id: epbout.F,v 1.1.1.1 1996/03/08 15:21:43 mclareni Exp $
-*
-* $Log: epbout.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:43 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
- SUBROUTINE EPBOUT(IBUF,IERR)
-C. WRITES ONE PHYSICAL BLOCK
-C.
-C. INPUT:
-C.
-C. IBUF BUFFER CONTAINING OUTPUT
-C.
-C. OUTPUT:
-C.
-C. IERR =0 : SUCCESSFUL OPERATION
-C. =2 : WRITE PARITY ERROR
-C. =11 : UNIT NOT DEFINED (IBM)
-C. =12 : WRITE OPERATION FAILED (END OF VOLUME)
-#include "epio/epiocom.inc"
- DIMENSION IL(12),NZERO(2)
-#include "epio/wordsize.inc"
-#if defined(CERNLIB_IBM)||defined(CERNLIB_CDC)||defined(CERNLIB_UNIVAC)||defined(CERNLIB_NORD)||defined(CERNLIB_CRAY)||defined(CERNLIB_CONVEX)||defined(CERNLIB_STF77)||defined(CERNLIB_STF77VX)
- DIMENSION IBUF(2)
-#endif
-#if defined(CERNLIB_VAX)
- INTEGER*2 IBUF(1)
- INCLUDE 'SYS$LIBRARY:FORIOSDEF'
- EXTERNAL SS$_ENDOFTAPE
-#endif
-#if defined(CERNLIB_APOLLO)
-%INCLUDE '/sys/ins/base.ins.ftn'
-%INCLUDE '/sys/ins/error.ins.ftn'
-%INCLUDE '/sys/ins/streams.ins.ftn'
- INTEGER*2 ERROR_$RETURNED, IBUF(1)
- INTEGER STATUS_$RETURNED
-#endif
-#if defined(CERNLIB_UNIVAC)
- DIMENSION NACC(2)
- DATA NBLKSZ/'EP '/
-#endif
- DATA NZERO/2*0/,NEND/65535/
-#if (defined(CERNLIB_HLESS))&&(!defined(CERNLIB_ND100B16))
- NFLAG=IERR
-#endif
- IERR=0
- NW16=LIST(ISTART+14)
-C--- SKIP IF BLOCK IS EMPTY
- IF(NW16.EQ.LIST(ISTART+7)) GOTO 77777
-C--- PRESET NO. OF 16 BIT WORDS ACTUALLY WRITTEN
- N16OUT=NW16
-C--- GET PAD FLAG
- IPAD=MOD(LIST(ISTART+8),10)
- IF(IPAD.EQ.1) GOTO 10
- IF(IPAD.EQ.2) GOTO 20
- GOTO 30
- 10 CONTINUE
-C--- PAD TO FIXED BLOCK LENGTH
- N16OUT=LIST(ISTART+1)
- GOTO 21
- 20 CONTINUE
-C--- PAD TO NEXT MAGIC MULTIPLE
- N16OUT=((NW16-1)/LIST(5)+1)*LIST(5)
-C--- GET NUMBER OF MACHINE WORDS FOR OUTPUT
-#if defined(CERNLIB_STF77)||defined(CERNLIB_STF77VX)
- 21 NWMACH=(16*N16OUT-1)/LIST(4)+1
-#endif
-#if (!defined(CERNLIB_STF77))&&(!defined(CERNLIB_STF77VX))
- 21 NWMACH=16*N16OUT/LIST(4)
-#endif
- IF(N16OUT.EQ.NW16) GOTO 31
-C--- PAD - FIND FIRST MACHINE WORD TO BECOME ENTIRELY ZERO
- NSMACH=(16*NW16-1)/LIST(4)+2
-C--- GET NO. OF TRAILING 16 BIT WORDS IN FRONT OF NSMACH
-C--- (PARTIAL OVERLAP POSSIBLE)
-C--- 4 ARE SUFFICIENT (UP TO 64 BIT WORDS)
- NPAD=MIN0(4,N16OUT-NW16)
-C--- SET TO ZERO
- CALL W16MOV(NZERO,1,IBUF,NW16+1,NPAD)
- IF(NSMACH.LE.NWMACH) CALL UZERO(IBUF,NSMACH,NWMACH)
-C--- SET END OF DATA INDICATOR
- CALL BUN16W(NEND,1,IBUF,NW16+1,1)
-C--- SET POINTER TO E.O.D. WORD IF NO RECORD START IN THIS BLOCK
- IF(LIST(ISTART+15).EQ.0) LIST(ISTART+15)=NW16
- GOTO 31
- 30 CONTINUE
-C--- DO NOT PAD - GET NO. OF MACHINE WORDS
- NWMACH=(16*N16OUT-1)/LIST(4)+1
- 31 CONTINUE
-C--- INCREASE P.R. COUNT
- LIST(ISTART+11)=LIST(ISTART+11)+1
-C--- SPECIFY NECESSARY P.H. CONTROL WORDS
-#if (defined(CERNLIB_HLESS))&&(!defined(CERNLIB_ND100B16))
- IF(NFLAG.LT.0) GOTO 32
-#endif
- IF(LIST(ISTART+29).EQ.0) THEN
-*--- 16 bit physical header
- CALL BLO16W(IBUF,1,IL,1,12)
- ELSE
- CALL BLO32W(IBUF,1,IL,1,12)
- CALL CFRIBM(IL,12,2)
- ENDIF
- IL(1)=N16OUT
- IL(2)=LIST(ISTART+7)
- IL(3)=LIST(ISTART+11)
- IL(4)=LIST(ISTART+15)
- IL(5)=LIST(ISTART+4)
- IL(6)=LIST(ISTART+9)
- IL(11)=LIST(ISTART+3)
- IF(LIST(ISTART+29).EQ.0) THEN
- CALL BUN16W(IL,1,IBUF,1,12)
- ELSE
- CALL CTOIBM(IL,12,2)
- CALL BUN32W(IL,1,IBUF,1,12)
- ENDIF
-#if (defined(CERNLIB_HLESS))&&(!defined(CERNLIB_ND100B16))
- 32 CONTINUE
-#endif
- LUNIT=LIST(ISTART+10)
-#if defined(CERNLIB_CDC)
- BUFFER OUT(LUNIT,1) (IBUF(1),IBUF(NWMACH))
-C--- WAIT FOR END OF OPERATION
- IF(UNIT(LUNIT).GT.0.) IERR=2
-#endif
-#if defined(CERNLIB_CRAY)
-C FOR CRAY ONLY
- NWMACH=(16*N16OUT-1)/LIST(4)+1
- NUBC =NWMACH*LIST(4)-N16OUT*16
- CALL WRITE (LUNIT,IBUF(1),NWMACH,NUBC)
-#endif
-#if defined(CERNLIB_IBM)||defined(CERNLIB_NORD)
- NBYTES=2*N16OUT
- CALL IORITE(LUNIT,IBUF,NBYTES,IRETCD)
- IF(IRETCD.EQ.0) GOTO 77777
- IF(IRETCD.EQ.1) IERR=11
- IF(IRETCD.EQ.2.OR.IRETCD.EQ.4) IERR=12
- IF(IRETCD.EQ.3) IERR=2
- IF(IRETCD.EQ.8) IERR=1
-#endif
-#if defined(CERNLIB_VAX)
- IF(LIST(ISTART+25).NE.0)THEN
-C
-C MAGTAPE CASE USES QIO
-C
- CALL EPMTWRITE(IBUF,2*N16OUT,IOS)
- IF(IOS.EQ.1)GO TO 77777
- IF(IOS.EQ.%LOC(SS$_ENDOFTAPE))THEN
- IERR = 2
- GO TO 9901
- ELSE
- WRITE(NOUTUT,1001) IOS
-1001 FORMAT(/' +++ EP I/O PACKAGE VAX MAGTAPE ERROR ',Z10,' HEX')
- IERR = 12
- GO TO 9901
- ENDIF
- ELSE
- WRITE(LUNIT,IOSTAT=IOS)(IBUF(I),I=1,N16OUT)
- IF(IOS.NE.0) THEN
- IF(IOS.EQ.FOR$IOS_ERRDURWRI)THEN
- IERR= 0
- WRITE(NOUTUT,1002)
-1002 FORMAT(/' +++ EP I/O PACKAGE SPECIAL VAX WRITE ERROR +++'/
- 1 ' DISK SPACE RAN OUT, OR TAPE PARITY ERROR OR???')
-C
-C ERRDURWRI IS A VERY AMBIGUOUS MESSAGE. IT CAN BE DUE TO
-C WRITE PARITY ERROR
-C INSUFFICIENT SPACE ON DISK
-C INCORRECT BLOCK LENGTH ON WRITE
-C AND WHO KNOWS WHAT ELSE??
-C
- ELSE
- IERR = 12
- WRITE(NOUTUT,1000) IOS
- 1000 FORMAT(/' +++ EP I/O PACKAGE SPECIAL VAX ERROR NO.',I5)
- ENDIF
- ENDIF
- ENDIF
-#endif
-#if defined(CERNLIB_APOLLO)
- IF(LIST(ISTART+25).NE.0)THEN
-C
-C IN THE APOLLO CASE THE WRITING ROUTINE IS THE SAME FOR
-C MAGTAPE AND FOR DISK FILES
-C
- CALL WRITE_$STREAM(IBUF,2*N16OUT,STATUS_$RETURNED)
- IF(STATUS_$RETURNED.EQ.STATUS_$OK) GO TO 77777
- IF(LSHFT(ERROR_$SUBSYS(STATUS_$RETURNED),8)
- + .NE.STREAM_$SUBS) THEN
- WRITE(NOUTUT,1000)
-1000 FORMAT(' +++ EPIO/DOMAIN: Not a stream I/O error ???')
- GO TO 9901
- END IF
- ERROR_$RETURNED=ERROR_$CODE(STATUS_$RETURNED)
- IF(ERROR_$RETURNED.EQ.STREAM_$BOF_ERR) THEN
- IERR = 2
- GO TO 9901
- END IF
- WRITE(NOUTUT,1001) ERROR_$RETUNED
-1001 FORMAT(/' +++ EP I/O package stream error ',Z10,' hex')
- IERR = 12
- ELSE
-C
-C HERE SIMPLY SOMETHING IS WRONG
-C
- GO TO 9901
- END IF
-#endif
-#if defined(CERNLIB_UNIVAC)
-C--FILENAME IN FIELDATA CHARACTERS
- LUNFD=LIST(ISTART+24)
-C--FILE ADDRESS. < 0 IF TAPE, >= 0 IF DISK
- IOAD=LIST(ISTART+25)
- IF(IOAD.GE.0) THEN
-C--AN EP-FORMATTED BLOCK ON DISK IS PRECEEDED BY ONE WORD CONTAINING
-C-- ('EP',BLOCK SIZE) ON UNIVAC
- BITS(NBLKSZ,19,18)=NWMACH
- NACC(1)=2**18+LOCF(NBLKSZ)
- NACC(2)=NWMACH*2**18+LOCF(IBUF)
- CALL FIOGW(LUNFD,NACC,2,IOAD,ISTAT)
- ELSE
- CALL FIOW(LUNFD,IBUF,NWMACH,IOAD,ISTAT)
- ENDIF
- IF(ISTAT.LT.0) THEN
-C--IERR=2+100*IABS(UNIVAC ERROR CODE)
- IERR=2+IABS(ISTAT)*100
- LIST(ISTART+13)=LIST(ISTART+13)+1
- ELSE IF(IOAD.GE.0) THEN
-C--UPDATE ADDRESS IF DISK FILE. WE ASSUME F-FORMAT WITH 28 WORDS/SECTOR
- LIST(ISTART+25)=LIST(ISTART+25)+(NWMACH+28)/28
- ENDIF
-#endif
-#if defined(CERNLIB_STF77)||defined(CERNLIB_STF77VX)
- IF(LIST(ISTART+33).EQ.1)THEN
- WRITE(LUNIT,REC=LIST(ISTART+11),IOSTAT=IERR)
- 1 (IBUF(IWRD),IWRD=1,NWMACH)
- ELSE IF(LIST(ISTART+33).EQ.2)THEN
- call cfput(list(istart+25),0,NWMACH,IBUF,IERR)
- ELSE
- WRITE(LUNIT,IOSTAT=IERR)(IBUF(IWRD),IWRD=1,NWMACH)
- ENDIF
- IF(IERR.GT.0) IERR=2
-#endif
- IF(IERR.NE.0) GOTO 9901
-77777 CONTINUE
-C--- RESET CONTROL WORDS
- LIST(ISTART+14)=LIST(ISTART+7)
- LIST(ISTART+15)=0
- RETURN
- 9901 CONTINUE
-C--- ERROR HANDLING
- CALL EPERRH(LIST(ISTART+10),IERR)
- GOTO 77777
- END
diff --git a/src/packlib/epio/code/epclos.F b/src/packlib/epio/code/epclos.F
deleted file mode 100644
index d3e8206..0000000
--- a/src/packlib/epio/code/epclos.F
+++ /dev/null
@@ -1,46 +0,0 @@
-*
-* $Id: epclos.F,v 1.1.1.1 1996/03/08 15:21:43 mclareni Exp $
-*
-* $Log: epclos.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:43 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
- SUBROUTINE EPCLOS(LUNIT,IBUF,IERR)
-C. ROUTINE TO CLOSE OUTPUT UNITS (WRITE EXISTING PHYSICAL
-C. BUFFER OUT - WRITING MAY CONTINUE AFTERWARDS).
-C. CLOSING AN INPUT UNIT HAS NO EFFECT.
-C.
-C. +++ MANDATORY AT END OF JOB FOR ALL OUTPUT UNITS +++
-C. +++ OR A CALL TO EPEND (EOF IN ADDITION) +++
-C.
-C.
-C. INPUT:
-C.
-C. LUNIT LOGICAL UNIT NUMBER
-C.
-C. INPUT/OUTPUT:
-C.
-C. IBUF USER PROVIDED UNIT BUFFER. MUST NOT BE TOUCHED BY USER.
-C.
-C. OUTPUT:
-C.
-C. IERR ERROR FLAG. SEE SEPARATE LIST.
-C.
-#include "epio/epiocom.inc"
- DIMENSION IBUF(1)
- IERR = 0
-C--- GET UNIT NUMBER
- IF(LUNIT.NE.LASTUT) CALL EPUREF(LUNIT)
- IF(LREF.EQ.0) GOTO 9901
-C--- START-1 OF CONTROL WORDS
- IF(LIST(ISTART+14).EQ.0.OR.LIST(ISTART+16).NE.1) GOTO 77777
- CALL EPBOUT(IBUF,IERR)
-77777 RETURN
- 9901 CONTINUE
-C--- UNIT DOES NOT EXIST
- IERR=14
- CALL EPERRH(LUNIT,IERR)
- GOTO 77777
- END
diff --git a/src/packlib/epio/code/epdacr.F b/src/packlib/epio/code/epdacr.F
deleted file mode 100644
index c741d3a..0000000
--- a/src/packlib/epio/code/epdacr.F
+++ /dev/null
@@ -1,51 +0,0 @@
-*
-* $Id: epdacr.F,v 1.1.1.1 1996/03/08 15:21:43 mclareni Exp $
-*
-* $Log: epdacr.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:43 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
- SUBROUTINE EPDACR(LUNIT,IBLOCK,IRCOFF,IERR)
-C.
-C. prepares a unit for random access reading
-C.
-C. input :
-C.
-C. LUNIT logical unit
-C. IBLOCK no. of the block to be read next (READ(LUN,REC=IBLOCK)...)
-C. IRCOFF record off-set of first logical record in block (see
-C. remark below)
-C.
-C. output
-C. IERR ERROR FLAG. SEE SEPARATE LIST.
-C.
-C. Remark:
-C. The file has to be scanned in sequential mode beforehand,
-C. by calling EPREAD with MODE=20 (obligatory).
-C. After each such call the user keeps control words 11 (block
-C. number) and 31 (record off-set) for those records from
-C. where he wants to start.
-C. The unit must be opened for random access by the user.He may
-C. then read any number of records following the one given
-C. in the call to EPDACR.
-C. The example should be consulted.
-C.
-#include "epio/epiocom.inc"
-
- IF(LASTUT.NE.LUNIT) THEN
- CALL EPUNIT(LUNIT,IERR)
- IF(IERR.NE.0) GOTO 999
- ENDIF
-*--- set random access mode
- LIST(ISTART+32)=1
-*--- set flag for reading next buffer to "true"
- LIST(ISTART+14)=0
-*--- set pointer position flag to "start of header"
- LIST(ISTART+22)=0
-*--- set record off-set
- LIST(ISTART+23)=IRCOFF
-*--- set block number of last block "read"
- LIST(ISTART+11)=IBLOCK-1
- 999 END
diff --git a/src/packlib/epio/code/epdefu.F b/src/packlib/epio/code/epdefu.F
deleted file mode 100644
index 7082c87..0000000
--- a/src/packlib/epio/code/epdefu.F
+++ /dev/null
@@ -1,38 +0,0 @@
-*
-* $Id: epdefu.F,v 1.1.1.1 1996/03/08 15:21:43 mclareni Exp $
-*
-* $Log: epdefu.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:43 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
- SUBROUTINE EPDEFU(LUNIT,NAME,IERR)
-C.
-C. ************* VAX AND APOLLO *******************
-C.
-C. ALLOWS TO SPECIFY A FILE NAME OTHER THAN THE DEFAULT
-C. NAME FOR0$$.DAT ($$ FOR UNIT NUMBER)
-C.
-C. INPUT
-C. LUNIT LOGICAL UNIT NUMBER
-C. NAME FILE NAME, TYPE CHARACTER
-C.
-C. OUTPUT
-C. IERR ERROR FLAG. SEE SEPARATE LIST.
-C.
-C. THE NAME IS STORED IN EPVXUN, COMMON BLOCK EPVAXN, FOR THE VAX
-C.
-C. THE NAME IS STORED IN EPVXUN, COMMON BLOCK EPAPON, FOR THE APOLLO
-C.
-#include "epio/epiocom.inc"
-#if defined(CERNLIB_VAX)||defined(CERNLIB_STF77VX)
-#include "epio/epvaxcom.inc"
-#endif
-#if (!defined(CERNLIB_VAX))&&(!defined(CERNLIB_STF77VX))
-#include "epio/epapocom.inc"
-#endif
- CHARACTER NAME*(*)
- CALL EPUNIT(LUNIT,IERR)
- IF (IERR.EQ.0) EPVXUN(LREF)=NAME
- END
diff --git a/src/packlib/epio/code/epdrop.F b/src/packlib/epio/code/epdrop.F
deleted file mode 100644
index 5673918..0000000
--- a/src/packlib/epio/code/epdrop.F
+++ /dev/null
@@ -1,43 +0,0 @@
-*
-* $Id: epdrop.F,v 1.1.1.1 1996/03/08 15:21:43 mclareni Exp $
-*
-* $Log: epdrop.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:43 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
- SUBROUTINE EPDROP(LUNIT,IERR)
-C. DROPS AN ACTIVE UNIT, SETS THE SPACE FREE.
-C. INPUT
-C. LUNIT LOGICAL UNIT NUMBER
-C. OUTPUT
-C. IERR ERROR CONDITION
-#include "epio/epiocom.inc"
-#include "epio/epvaxcom.inc"
-* Ignoring t=pass
-#include "epio/epapocom.inc"
-* Ignoring t=pass
- IERR=0
- IF(LUNIT.NE.LASTUT) CALL EPUREF(LUNIT)
- IF(LREF.EQ.0) GOTO 9901
-C--- DROP INTERNAL UNIT LREF
- IF(LREF.EQ.LIST(1)) GOTO 3
- IL=NWUNIT*(LIST(1)-1)+NCONT+1
- CALL UCOPY(LIST(IL),LIST(NCONT+NWUNIT*(LREF-1)+1),NWUNIT)
- 3 LIST(1)=LIST(1)-1
-*
-*---- BLANK DEFAULT FILE NAMES FOR VAX, APOLLO and UNIX
-*
- DO 10 I=1,NMUNIT
- 10 EPVXUN(I)=' '
-C--- SET LAST USER UNIT FLAG TO ZERO TO FORCE EPUNIT CALL NEXT TIME
- LASTUT=0
- LREF=0
-77777 RETURN
- 9901 CONTINUE
-C--- UNIT DOES NOT EXIST
- IERR=14
- CALL EPERRH(LUNIT,IERR)
- GOTO 77777
- END
diff --git a/src/packlib/epio/code/epend.F b/src/packlib/epio/code/epend.F
deleted file mode 100644
index 17f9a5e..0000000
--- a/src/packlib/epio/code/epend.F
+++ /dev/null
@@ -1,46 +0,0 @@
-*
-* $Id: epend.F,v 1.1.1.1 1996/03/08 15:21:43 mclareni Exp $
-*
-* $Log: epend.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:43 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
- SUBROUTINE EPEND(LUNIT,IBUF,IERR)
-C. ROUTINE TO CLOSE OUTPUT UNIT AND TO WRITE END OF FILE MARK.
-C. WRITING MAY CONTINUE AFTERWARDS ON SAME UNIT.
-C. CLOSING AN INPUT UNIT HAS NO EFFECT.
-C.
-C. +++ MANDATORY AT END OF JOB FOR ALL OUTPUT UNITS +++
-C. +++ OR A CALL TO EPCLOS (NO EOF WRITTEN) +++
-C.
-C.
-C. INPUT:
-C.
-C. LUNIT LOGICAL UNIT NUMBER
-C.
-C. INPUT/OUTPUT:
-C.
-C. IBUF USER PROVIDED UNIT BUFFER. MUST NOT BE TOUCHED BY USER.
-C.
-C. OUTPUT:
-C.
-C. IERR ERROR FLAG. SEE SEPARATE LIST.
-C.
-#include "epio/epiocom.inc"
- DIMENSION IBUF(2)
-C--- GET UNIT NUMBER
- IF(LUNIT.NE.LASTUT) CALL EPUREF(LUNIT)
- IF(LREF.EQ.0) GOTO 9901
-C--- START-1 OF CONTROL WORDS
- IF(LIST(ISTART+14).EQ.0.OR.LIST(ISTART+16).NE.1) GOTO 77777
- CALL EPBOUT(IBUF,IERR)
- CALL EPEOF(LUNIT,IERR)
-77777 RETURN
- 9901 CONTINUE
-C--- UNIT DOES NOT EXIST
- IERR=14
- CALL EPERRH(LUNIT,IERR)
- GOTO 77777
- END
diff --git a/src/packlib/epio/code/epeof.F b/src/packlib/epio/code/epeof.F
deleted file mode 100644
index c6c4e2a..0000000
--- a/src/packlib/epio/code/epeof.F
+++ /dev/null
@@ -1,113 +0,0 @@
-*
-* $Id: epeof.F,v 1.1.1.1 1996/03/08 15:21:43 mclareni Exp $
-*
-* $Log: epeof.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:43 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
- SUBROUTINE EPEOF(LUNIT,IERR)
-C. WRITES EOF MARK ON OUTPUT UNIT LUNIT
-C A CALL WITH LUNIT = INPUT UNIT HAS NO EFFECT.
-#include "epio/epiocom.inc"
-#if defined(CERNLIB_UNIVAC)
- DATA IEOF/'EOFM'/
-#endif
-#if defined(CERNLIB_APOLLO)
-%INCLUDE '/sys/ins/base.ins.ftn'
-%INCLUDE '/sys/ins/error.ins.ftn'
-%INCLUDE '/sys/ins/streams.ins.ftn'
- INTEGER*2 STREAM_$ID
- INTEGER*4 STATUS_$RETURNED,ATT_$REC_4(16),ERROR_$MASK
- EQUIVALENCE (ATT_$REC_4(1),STREAM_$ID)
-#endif
-C--- CHECK WHETHER SAME USER UNIT AS LAST TIME
- IF(LASTUT.EQ.LUNIT) GOTO 1551
-C--- NEW UNIT - GET REF
- CALL EPUNIT(LUNIT,IERR)
- IF(IERR.EQ.0) GOTO 1552
- GOTO 77777
- 1551 IERR=0
- IF(LREF.NE.0) GOTO 1552
- IERR=13
- CALL EPERRH(LUNIT,IERR)
- GOTO 77777
- 1552 CONTINUE
- IF(LIST(ISTART+16).NE.1) GOTO 77777
-#if defined(CERNLIB_IBM)||defined(CERNLIB_NORD)
- CALL IOMARK(LUNIT,IRETCD)
- IF(IRETCD.NE.0) IERR=2
-#endif
-#if defined(CERNLIB_CDC)||defined(CERNLIB_CRAY)||defined(CERNLIB_STF77)||defined(CERNLIB_STF77VX)
- IF(LIST(ISTART+33).EQ.0)END FILE LUNIT
- IF(LIST(ISTART+33).EQ.2)call cfclos(list(istart+25),0)
-#endif
-#if defined(CERNLIB_UNIVAC)
-C--- WRITE EOF, SOFTWARE ON DISK, HARDWARE ON TAPE
- LUNFD=LIST(ISTART+24)
- IOAD=LIST(ISTART+25)
- IF(IOAD.GE.0) THEN
-C--- SOFTWARE EOF IS ONE WORD CONTAINING 'EOFM'
- CALL FIOW(LUNFD,IEOF,1,IOAD,ISTAT)
- LIST(ISTART+25)=LIST(ISTART+25)+1
- ELSE
-C--- FOR TAPE WRITE TWO EOF MARKS AND MOVE BACK OVER THE LAST ONE
- CALL TIOWEF(LUNFD,ISTAT)
- CALL TIOWEF(LUNFD,ISTAT)
- CALL TIOMVF(LUNFD,-1,ISTAT)
- ENDIF
-#endif
-#if defined(CERNLIB_VAX)
- IF(LIST(ISTART+25).EQ.0)GO TO 77777
- CALL EPMTEOF(IOS)
- IF(IOS.EQ.1)GO TO 77777
- WRITE(NOUTUT,1001) IOS
-1001 FORMAT(/' +++ EP I/O PACKAGE VAX MAGTAPE ERROR ',Z10,' HEX ')
- IERR = 12
- CALL EPERRH(LIST(ISTART+10),IERR)
- GO TO 77777
-#endif
-#if defined(CERNLIB_APOLLO)
- STREAM_$ID=INT2(LIST(ISTART+25))
-C
-C DO SOMETHING ONLY IF THE STREAM-ID IS NOT 0
-C
- IF(STREAM_$ID.NE.0) THEN
- LIST(ISTART+25)=0
- IF(LIST(ISTART+16).EQ.1) THEN
-C
-C IN CASE OF A WRITE UNIT, WRITE AN END OF FILE MARK
-C
-C
-C SEE WHETHER THIS IS A TAPE UNIT
-C
- CALL STREAM_$INQUIRE (
- 1 STREAM_$IRM_OTYPE,
- 2 STREAM_$USE_STRID,
- 3 STREAM_$ID,
- 4 ERROR_$MASK,
- 5 STATUS_$RETURNED)
- IF (STATUS_$RETURNED .NE. STATUS_$OK)
- 1 CALL ERROR_$PRINT(STATUS_$RETURNED)
- IF(ATT_$REC_4(14).NE.16#314) THEN
- CALL STREAM_$TRUNCATE(STREAM_$ID,STATUS_$RETURNED)
- IF(STATUS_$RETURNED.NE.STATUS_$OK) THEN
- CALL ERROR_$PRINT(STATUS_$RETURNED)
- END IF
- END IF
- END IF
-C
-C IN ANY CASE CLOSE THE STREAM
-C
- CALL STREAM_$CLOSE(STREAM_$ID,STATUS_$RETURNED)
- IF(STATUS_$RETURNED.EQ.STATUS_$OK) GO TO 77777
- IF(LSHFT(ERROR_$SUBSYS(STATUS_$RETURNED),8)
- + .EQ.STREAM_$SUBS) GO TO 100
- WRITE(NOUTUT,1001)
-1001 FORMAT(' +++ EPIO/DOMAIN: Not a stream I/O error ???')
- 100 CALL ERROR_$PRINT(STATUS_$RETURNED)
- END IF
-#endif
-77777 RETURN
- END
diff --git a/src/packlib/epio/code/eperrh.F b/src/packlib/epio/code/eperrh.F
deleted file mode 100644
index 593194f..0000000
--- a/src/packlib/epio/code/eperrh.F
+++ /dev/null
@@ -1,44 +0,0 @@
-*
-* $Id: eperrh.F,v 1.1.1.1 1996/03/08 15:21:43 mclareni Exp $
-*
-* $Log: eperrh.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:43 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
- SUBROUTINE EPERRH(LUNIT,IERR)
-C. PRINTS ERROR MESSAGES, UPDATES ERROR COUNTS
-C. INPUT
-C. LUNIT LOGICAL UNIT
-C. IERR ERROR NUMBER
-#include "epio/epiocom.inc"
- IF(LIST(3).GE.LIST(2)) GOTO 77777
- IF(IERR.EQ.1) GOTO 10
- IF(IERR.EQ.8.OR.IERR.EQ.9) GOTO 20
- IF(IERR.EQ.13.OR.IERR.EQ.14) GOTO 20
- IF(IERR.EQ.16.OR.IERR.EQ.17) GOTO 20
- WRITE(NOUTUT,2002) IERR,LUNIT,LIST(ISTART+11),LIST(ISTART+12)
- GOTO 100
- 10 WRITE(NOUTUT,2000) LUNIT,LIST(ISTART+11),LIST(ISTART+12)
- GOTO 100
- 20 WRITE(NOUTUT,2001) IERR,LUNIT
- 100 LIST(3)=LIST(3)+1
-77777 RETURN
-#if !defined(CERNLIB_CDC)
-2000 FORMAT(/,' +++ EP I/O PACKAGE - END OF FILE READ UNIT',
- 1 I5,' AFTER BLOCK ',I5,' AND ',I8,' RECORDS +++')
-2001 FORMAT(/,' +++ EP I/O PACKAGE ERROR NO.',I5,' ON UNIT',
- 1 I5,' +++')
-2002 FORMAT(/,' +++ EP I/O PACKAGE ERROR NO.',I5,' ON UNIT',
- 1 I5,' AT BLOCK ',I5,' RECORD ',I8,' +++')
-#endif
-#if defined(CERNLIB_CDC)
-2000 FORMAT(/," +++ EP I/O PACKAGE - END OF FILE READ UNIT",
- 1 I5," AFTER BLOCK ",I5," AND ",I8," RECORDS +++")
-2001 FORMAT(/," +++ EP I/O PACKAGE ERROR NO.",I5," ON UNIT",
- 1 I5," +++")
-2002 FORMAT(/," +++ EP I/O PACKAGE ERROR NO.",I5," ON UNIT",
- 1 I5," AT BLOCK ",I5," RECORD ",I8," +++")
-#endif
- END
diff --git a/src/packlib/epio/code/epfhdr.F b/src/packlib/epio/code/epfhdr.F
deleted file mode 100644
index 88fa610..0000000
--- a/src/packlib/epio/code/epfhdr.F
+++ /dev/null
@@ -1,125 +0,0 @@
-*
-* $Id: epfhdr.F,v 1.1.1.1 1996/03/08 15:21:43 mclareni Exp $
-*
-* $Log: epfhdr.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:43 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
- SUBROUTINE EPFHDR(LUNIT,MLUSER,IHEAD,IBUF,IERR)
-C. FAST LOGICAL RECORD HEADER READING ROUTINE.
-C.
-C. CONDITIONS FOR USE:
-C. 1. 16 BIT UNITS ONLY (I.E. L.R.H. CONSISTS OF 16 BIT WORDS)
-C. 2. NO SPANNED HEADERS
-C. 3. ALWAYS MLUSER WORDS TRANSFERRED TO USER (WORD 3 IS HEADER LENGTH)
-C. THIS MAY EXCEPTIONALLY LEAD TO A PROGRAM RANGE ERROR IF THE INPUT
-C. BUFFER IBUF COINCIDES WITH THE END OF THE USER PROGRAM.
-C. REMEDY: INCREASE SIZE OF IBUF BY 16*MLUSER/(NO. OF BITS PER WORD)
-C. 4. NO HEADERLESS BLOCKS
-C. 5. NO OLD EP FORMAT
-C. 6. NO UNKNOWN LENGTH RECORDS
-C.
-C. IN ADDITION, NO CHECKS PERFORMED WHETHER INPUT UNIT,
-C. OR WHETHER HEADER CUT
-C.
-C. CONDITIONS 2. TO 6. ARE ALWAYS FULFILLED WHEN WRITING WITH EPIO,
-C. CONDITION 1. IS DEFAULT WHEN WRITING WITH EPIO.
-C.
-C.--- INPUT
-C. LUNIT USER UNIT NUMBER
-C. MLUNIT NO. OF HEADER WORDS TRANSFERRED TO USER
-C.--- I/O
-C. IBUF USER BUFFER
-C.--- OUTPUT
-C. IHEAD MLUSER WORDS OF L.R.H. (REGARDLESS OF ACTUAL LENGTH OR
-C. OF STATUS WORD 26)
-C. IERR ERROR NUMBER
-C.
-C. CALLS TO THIS ROUTINE ARE ENTIRELY COMPATIBLE WITH EPREAD CALLS
-C.
-#include "epio/epiocom.inc"
-#if !defined(CERNLIB_F4)
- DIMENSION IHEAD(*)
-#endif
-#if defined(CERNLIB_F4)
- DIMENSION IHEAD(1)
-#endif
-#if defined(CERNLIB_VAX)||defined(CERNLIB_IBM)||defined(CERNLIB_APOLLO)
- INTEGER*2 IBUF(1),IW2(2)
- EQUIVALENCE (IW2(1),IW4)
-#endif
-#if defined(CERNLIB_CDC)||defined(CERNLIB_UNIVAC)||defined(CERNLIB_NORD)||defined(CERNLIB_CRAY)||defined(CERNLIB_STF77)||defined(CERNLIB_STF77VX)
- DIMENSION IBUF(1)
-#endif
- DATA NEND/65535/
-C--- CHECK WHETHER SAME USER UNIT AS LAST TIME
- IF(LASTUT.EQ.LUNIT) GOTO 1552
-C--- NEW UNIT - GET REF
- CALL EPUNIT(LUNIT,IERR)
- IF(IERR.NE.0) GOTO 77777
- 1552 IERR=0
- LPOS=LIST(ISTART+22)
-C--- FOLLOWING POSSIBILITIES:
-C IF LPOS=0 THEN LIST(ISTART+23) = LAST DATA WORD OF PREVIOUS REC.
-C IF LPOS=1 THEN - - HEADER - - -
-C IF LPOS=2 THEN LIST(ISTART+15) = OFFSET TO FIRST RECORD IN BLOCK
-C (WHICH MAY BE ZERO = NO RECORD STARTS IN THIS BLOCK)
-C--- IF AT END OF BLOCK LAST TIME ROUND, READ NEW BLOCK
- IF(LIST(ISTART+14).EQ.0) GOTO 20
- IP1=LIST(ISTART+23)
- IF(LPOS.NE.1) GOTO 10
-C--- IP1 POINTS TO END OF LAST HEADER - MOVE FORWARD (SKIP DATA)
- IP1=IP1+LIST(ISTART+20)-LIST(ISTART+21)
-C--- READ IF OUTSIDE CURRENT BLOCK
- IF(IP1.LT.LIST(ISTART+14)) GOTO 30
- GOTO 20
- 10 CONTINUE
-C--- USE OFFSET IF AFTER BLOCK SKIP
- IF(LPOS.EQ.2) IP1=LIST(ISTART+15)
- IF(IP1.NE.0) GOTO 30
- 20 CONTINUE
-C--- READ NEW BLOCK
- CALL EPBLIN(IBUF,IERR)
- IF(IERR.NE.0) GOTO 9999
-C--- CHECK WHETHER RECORD STARTS IN THIS BLOCK
- IP1=LIST(ISTART+15)
- IF(IP1.EQ.0) GOTO 20
- 30 CONTINUE
-C--- WORK DONE - IP1 POINTS TO HEADER-1
-#if defined(CERNLIB_CDC)||defined(CERNLIB_UNIVAC)||defined(CERNLIB_NORD)||defined(CERNLIB_CRAY)||defined(CERNLIB_STF77)||defined(CERNLIB_STF77VX)
- CALL BLO16W(IBUF,IP1+1,IHEAD,1,MLUSER)
-#endif
-#if defined(CERNLIB_IBM)||defined(CERNLIB_APOLLO)
- IW4=0
- DO 40 I=1,MLUSER
- IW2(2)=IBUF(IP1+I)
- 40 IHEAD(I)=IW4
-#endif
-#if defined(CERNLIB_VAX)
- IW4=0
- DO 40 I=1,MLUSER
- IW2(1)=IBUF(IP1+I)
- 40 IHEAD(I)=IW4
-#endif
-C--- CHECK WHETHER END-OF-DAT-IN-BLOCK INDICATOR RATHER THAN HEADER
- IF(IHEAD(1).EQ.NEND)GO TO 20
-C--- CHECK FOR END-OF-RUN INDICATOR (IHEAD(1)=0)
- IF(IHEAD(1).NE.0) GOTO 50
- LIST(ISTART+14)=0
- IERR=10
- GOTO 9999
- 50 CONTINUE
- IP1=IP1+IHEAD(3)
-C--- FILL STATUS WORDS
- LIST(ISTART+12)=LIST(ISTART+12)+1
- LIST(ISTART+20)=IHEAD(1)
- LIST(ISTART+21)=IHEAD(3)
- LIST(ISTART+22)=1
- LIST(ISTART+23)=IP1
- IF(IP1.EQ.LIST(ISTART+14)) LIST(ISTART+14)=0
-77777 RETURN
- 9999 CALL EPERRH(LUNIT,IERR)
- GOTO 77777
- END
diff --git a/src/packlib/epio/code/epfrd.F b/src/packlib/epio/code/epfrd.F
deleted file mode 100644
index c05f06b..0000000
--- a/src/packlib/epio/code/epfrd.F
+++ /dev/null
@@ -1,128 +0,0 @@
-*
-* $Id: epfrd.F,v 1.1.1.1 1996/03/08 15:21:43 mclareni Exp $
-*
-* $Log: epfrd.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:43 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
- SUBROUTINE EPFRD(LUNIT,MODE,NW,IREC,IBUF,IERR)
-C. FAST LOGICAL RECORD DATA READING ROUTINE.
-C.
-C. CONDITIONS FOR USE:
-C. 1. 16 BIT UNITS ONLY (I.E. L.R.H. CONSISTS OF 16 BIT WORDS)
-C. 2. NO HEADERLESS BLOCKS
-C. 3. NO OLD EP FORMAT
-C. 4. NO UNKNOWN LENGTH RECORDS
-C. 5. MODES 11, 12, 13 ONLY (OTHERWISE ERROR 8)
-C.
-C. IN ADDITION, NO CHECKS PERFORMED WHETHER INPUT UNIT
-C.
-C. CONDITIONS 2. TO 4. ARE ALWAYS FULFILLED WHEN WRITING WITH EPIO,
-C. CONDITION 1. IS DEFAULT WHEN WRITING WITH EPIO.
-C.
-C. USER DATA WILL BE TRUNCATED AT VALUE IN STATUS WORD 2, BUT NO ERROR
-C. WILL BE SIGNALLED.
-C.
-C.--- INPUT
-C. LUNIT USER UNIT NUMBER
-C. MODE ONE OF 11, 12, 13 (SEE EPREAD)
-C.--- I/O
-C. IBUF USER BUFFER
-C.--- OUTPUT
-C. NW NO. OF WORDS IN IREC
-C. IREC RECORD TRANSFERRED TO USER
-C. IERR ERROR NUMBER
-C.
-C. CALLS TO THIS ROUTINE ARE ENTIRELY COMPATIBLE WITH EPREAD CALLS
-C.
-#include "epio/epiocom.inc"
- DIMENSION IBUF(1),IREC(1)
-C--- CHECK WHETHER SAME USER UNIT AS LAST TIME
- IF(LASTUT.EQ.LUNIT) GOTO 1552
-C--- NEW UNIT - GET REF
- CALL EPUNIT(LUNIT,IERR)
- IF(IERR.NE.0) GOTO 77777
- 1552 IERR=0
- NW=0
- L32=0
- IF(MODE.LT.11.OR.MODE.GT.13) GOTO 9901
- ICOM=MODE-10
- LPOS=LIST(ISTART+22)
- IF(LPOS.NE.1) GOTO 9902
- IP1=LIST(ISTART+23)
-C-- MAX. NO OF 16 BIT WORDS TO USER RECORD
- MLUSER=LIST(ISTART+2)
- IF(ICOM.EQ.1) MLUSER=MLUSER*LIST(4)/16
- IF(ICOM.EQ.3) MLUSER=2*MLUSER
-C--- TOTAL NO. OF 16 BIT WORDS IN DATA PART
- NWDS=LIST(ISTART+20)-LIST(ISTART+21)
-C--- NO. OF 16 BIT WORDS IN BLOCK
- NP=LIST(ISTART+14)
- IF(NP.NE.0) GOTO 20
-C--- READ NEW BLOCK
- 10 CONTINUE
- CALL EPBLIN(IBUF,IERR)
- IF(IERR.NE.0) GOTO 9999
- IP1=LIST(ISTART+7)
- NP=LIST(ISTART+14)
- 20 CONTINUE
-C--- NO. OF 16 BIT WORDS OF DATA PART IN THIS BLOCK
- NLT=MIN0(NWDS,NP-IP1)
-C--- TOTAL NO. OF 16 BIT WORDS TO GO TO USER RECORD
- NUT=MIN0(NLT,MLUSER-NW)
- IF(NUT.LE.0) GOTO 40
-C--- TRANSFER ACCORDING TO MODE
- IF(MODE.EQ.13)GO TO 33
- IF(MODE.EQ.12)GO TO 32
-C--- BIT STRING
- CALL W16MOV(IBUF,IP1+1,IREC,NW+1,NUT)
- GOTO 35
- 32 CONTINUE
-C--- 16 BIT WORDS
- CALL BLO16W(IBUF,IP1+1,IREC,NW+1,NUT)
- GOTO 35
- 33 CONTINUE
-C--- 32 BIT WORDS
- IF(L32.EQ.0) GOTO 34
-C--- GET SECOND HALF OF SPLIT 32 BIT WORD
- CALL W16MOV(IBUF,IP1+1,KEEP,2,1)
- NW=NW+1
- CALL BLO32W(KEEP,1,IREC,NW,1)
- IP1=IP1+1
- NLT=NLT-1
- NWDS=NWDS-1
- L32=0
- 34 CONTINUE
-C--- 32 BIT WORDS
- NUT=MIN0(NLT/2,MLUSER-NW)
- IF(NWDS.LE.NLT)NUT=MIN0((NLT+1)/2,MLUSER-NW)
- CALL BLO32W(IBUF,IP1+1,IREC,NW+1,NUT)
- IF(MOD(NLT,2).EQ.0) GOTO 35
-C--- KEEP FIRST HALF OF SPLIT 32 BIT WORD
- L32=1
- CALL W16MOV(IBUF,NP,KEEP,1,1)
- 35 CONTINUE
-C--- UPDATE POINTER IN IREC
- NW=NW+NUT
- 40 CONTINUE
-C--- UPDATE POINTERS IN IBUF
- IP1=IP1+NLT
- NWDS=NWDS-NLT
- IF(NWDS.GT.0) GOTO 10
-C--- RECORD FINISHED - UPDATE STATUS WORDS
- IF(IP1.EQ.NP) LIST(ISTART+14)=0
- LIST(ISTART+22)=0
- LIST(ISTART+23)=IP1
-77777 RETURN
- 9901 CONTINUE
-C--- INVALID MODE IN CALL
- IERR=8
- GOTO 9999
- 9902 CONTINUE
-C--- ATTEMPT TO READ DATA BEFORE HEADER
- IERR=9
- 9999 CALL EPERRH(LUNIT,IERR)
- GOTO 77777
- END
diff --git a/src/packlib/epio/code/epgeta.F b/src/packlib/epio/code/epgeta.F
deleted file mode 100644
index 4d6b2e0..0000000
--- a/src/packlib/epio/code/epgeta.F
+++ /dev/null
@@ -1,48 +0,0 @@
-*
-* $Id: epgeta.F,v 1.1.1.1 1996/03/08 15:21:43 mclareni Exp $
-*
-* $Log: epgeta.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:43 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
- SUBROUTINE EPGETA(LUNIT,NW,IWS,IERR)
-C.
-C. INPUT:
-C.
-C. LUNIT LOGICAL UNIT.
-C.
-C. NW NUMBER OF STATUS WORDS ASKED FOR, ALWAYS STARTING
-C. AT WORD NO. 1.
-C.
-C. OUTPUT:
-C.
-C. IWS STATUS WORDS 1...NW.
-C.
-C. IERR ERROR FLAG. SEE SEPARATE LIST.
-C.
-#include "epio/epiocom.inc"
- DIMENSION IWS(2)
- IERR=0
- IF(NW.LE.0.OR.NW.GT.NWUNIT) GOTO 9901
-C--- CHECK WHETHER SAME USER UNIT AS LAST TIME
- IF(LASTUT.EQ.LUNIT) GOTO 1551
-C--- NEW UNIT - GET REF
- CALL EPUNIT(LUNIT,IERR)
- IF(IERR.EQ.0) GOTO 1552
- GOTO 77777
- 1551 IERR=0
- IF(LREF.NE.0) GOTO 1552
- IERR=13
- CALL EPERRH(LUNIT,IERR)
- GOTO 77777
- 1552 CONTINUE
- CALL UCOPY(LIST(ISTART+1),IWS,NW)
-77777 RETURN
- 9901 CONTINUE
-C--- STATUS WORD REQUEST OUT OF RANGE
- IERR=16
- CALL EPERRH(LUNIT,IERR)
- GOTO 77777
- END
diff --git a/src/packlib/epio/code/epgetc.F b/src/packlib/epio/code/epgetc.F
deleted file mode 100644
index 5a81b9e..0000000
--- a/src/packlib/epio/code/epgetc.F
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: epgetc.F,v 1.1.1.1 1996/03/08 15:21:44 mclareni Exp $
-*
-* $Log: epgetc.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:44 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
- SUBROUTINE EPGETC(NWCONT,IWCONT)
-C.
-C. OUTPUT:
-C.
-C. NWCONT NO. OF OVERALL CONTROL WORDS (WORD 3 OF COMMON /C/).
-C.
-C. IWCONT CONTROL WORDS (WORDS 1...NWCONT OF LIST OF COMMON /C/).
-C.
-#include "epio/epiocom.inc"
- DIMENSION IWCONT(2)
- NWCONT=NCONT
- CALL UCOPY(LIST,IWCONT,NCONT)
- RETURN
- END
diff --git a/src/packlib/epio/code/epgetw.F b/src/packlib/epio/code/epgetw.F
deleted file mode 100644
index 58866ed..0000000
--- a/src/packlib/epio/code/epgetw.F
+++ /dev/null
@@ -1,46 +0,0 @@
-*
-* $Id: epgetw.F,v 1.1.1.1 1996/03/08 15:21:44 mclareni Exp $
-*
-* $Log: epgetw.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:44 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
- SUBROUTINE EPGETW(LUNIT,NUMBER,IW,IERR)
-C.
-C. INPUT:
-C.
-C. LUNIT LOGICAL UNIT.
-C.
-C. NUMBER NO. OF STATUS WORD ASKED FOR (SEE LIST ABOVE).
-C.
-C. OUTPUT:
-C.
-C. IW VALUE OF STATUS WORD.
-C.
-C. IERR ERROR FLAG. SEE SEPARATE LIST.
-C.
-#include "epio/epiocom.inc"
- IERR=0
- IF(NUMBER.LE.0.OR.NUMBER.GT.NWUNIT) GOTO 9901
-C--- CHECK WHETHER SAME USER UNIT AS LAST TIME
- IF(LASTUT.EQ.LUNIT) GOTO 1551
-C--- NEW UNIT - GET REF
- CALL EPUNIT(LUNIT,IERR)
- IF(IERR.EQ.0) GOTO 1552
- GOTO 77777
- 1551 IERR=0
- IF(LREF.NE.0) GOTO 1552
- IERR=13
- CALL EPERRH(LUNIT,IERR)
- GOTO 77777
- 1552 CONTINUE
- IW=LIST(ISTART+NUMBER)
-77777 RETURN
- 9901 CONTINUE
-C--- STATUS WORD REQUEST OUT OF RANGE
- IERR=16
- CALL EPERRH(LUNIT,IERR)
- GOTO 77777
- END
diff --git a/src/packlib/epio/code/ephead.F b/src/packlib/epio/code/ephead.F
deleted file mode 100644
index f3fe929..0000000
--- a/src/packlib/epio/code/ephead.F
+++ /dev/null
@@ -1,84 +0,0 @@
-*
-* $Id: ephead.F,v 1.1.1.1 1996/03/08 15:21:44 mclareni Exp $
-*
-* $Log: ephead.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:44 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
- SUBROUTINE EPHEAD(IBUF)
-C. ROUTINE TO PRESET A PHYSICAL HEADER FOR AN OUTPUT UNIT, PLUS THE
-C. OUTPUT UNIT FLAG CONTROL WORD.
-C. INPUT/OUTPUT
-C. IBUF UNIT BUFFER
-C. FORMAT OF THE HEADER
-C. 1 PHYS. BLOCK LENGTH (IN 16 BIT WORDS)
-C. 2 PHYS. BLOCK HEADER LENGTH (IN 16 BIT WORDS)
-C. 3 PHYS. BLOCK NUMBER
-C. 4 POINTER TO FIRST LOG. RECORD START, OR ZERO IF NONE
-C. 5 RUN NUMBER
-C. 6 PHYS. BLOCK TYPE
-C. 7 CONTAINS 29954 if 16 bit word p.h., 522144444 (hex 1F1F4ABC)
-C. if 32 bit p.h.
-C. 8 CONTAINS 31280 if 16 word p.h., else as word 7
-C. 9 NUMBER OF HEADERLESS BLOCKS FOLLOWING
-C. 10 TAPE FORMAT VERSION NUMBER = 8012
-C. 11 LOGICAL RECORD WORD LENGTH IN BITS (16 AND 32 SUPPORTED)
-C. 12 LENGTH OF STANDARD PHYS. HEADER (in 16 bit words !)
-#include "epio/epiocom.inc"
- DIMENSION IBUF(20)
- K=LIST(6)
- IF(LIST(ISTART+29).EQ.0) THEN
-*--- 16 bit p.h.
- NSL=LIST(6)
- IBUF(K+1)=NSL
- IBUF(K+2)=NSL
- IBUF(K+3)=0
- IBUF(K+4)=0
- IBUF(K+5)=LIST(ISTART+4)
- IBUF(K+6)=LIST(ISTART+9)
- IBUF(K+7)=29954
- IBUF(K+8)=31280
- IBUF(K+9)=0
- IBUF(K+10)=8012
- IBUF(K+11)=LIST(ISTART+3)
- IBUF(K+12)=NSL
-C--- BUNCH INTO HEADER PORTION
- CALL BUN16W(IBUF,K+1,IBUF,1,K)
- ELSE
-*--- 32 bit p.h.
- NSL=2*LIST(6)
- IBUF(K+1)=NSL
- IBUF(K+2)=NSL
- IBUF(K+3)=0
- IBUF(K+4)=0
- IBUF(K+5)=LIST(ISTART+4)
- IBUF(K+6)=LIST(ISTART+9)
- IBUF(K+7)=522144444
- IBUF(K+8)=IBUF(K+7)
- IBUF(K+9)=0
- IBUF(K+10)=8012
- IBUF(K+11)=LIST(ISTART+3)
- IBUF(K+12)=NSL
-C--- BUNCH INTO HEADER PORTION
- CALL CTOIBM(IBUF(K+1),K,2)
- CALL BUN32W(IBUF,K+1,IBUF,1,K)
- ENDIF
- IF(LIST(ISTART+7).EQ.0) LIST(ISTART+7)=NSL
- LIST(ISTART+14)=NSL
-C--- OUTPUT UNIT FLAG
- IERR=0
-#if defined(CERNLIB_VAX)
- IF(LIST(ISTART+16).EQ.0)CALL EPOPEN_VAX(1,IERR)
-#endif
-#if defined(CERNLIB_APOLLO)
- IF(LIST(ISTART+16).EQ.0) CALL EPOPEN_APOLLO(1)
-#endif
-#if defined(CERNLIB_STF77)||defined(CERNLIB_STF77VX)
- IF(LIST(ISTART+16).EQ.0) CALL EPOPEN(1,IERR)
-#endif
- if(IERR.ne.0)CALL EPERRH(LIST(ISTART+10),IERR)
- LIST(ISTART+16)=1
- RETURN
- END
diff --git a/src/packlib/epio/code/epinit.F b/src/packlib/epio/code/epinit.F
deleted file mode 100644
index a347736..0000000
--- a/src/packlib/epio/code/epinit.F
+++ /dev/null
@@ -1,68 +0,0 @@
-*
-* $Id: epinit.F,v 1.1.1.1 1996/03/08 15:21:44 mclareni Exp $
-*
-* $Log: epinit.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:44 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
- SUBROUTINE EPINIT
-C. INITIALIZES EP FORMAT READ AND WRITE PACKAGE
-#include "epio/epiocom.inc"
-#if defined(CERNLIB_VAX)||defined(CERNLIB_STF77VX)
-#include "epio/epvaxcom.inc"
-#endif
-#if (!defined(CERNLIB_VAX))&&(!defined(CERNLIB_STF77VX))
-#include "epio/epapocom.inc"
-#endif
-C--- NO. OF BITS / MACHINE WORD , LOGICAL OUTPUT UNIT (PRINTER DEF)
-#if (defined(CERNLIB_CDC))&&(defined(CERNLIB_F4))
- DATA NBIT/60/ ,NOUT/6LOUTPUT/
-#endif
-#if (defined(CERNLIB_CDC))&&(!defined(CERNLIB_F4))
- DATA NBIT/60/ ,NOUT/L"OUTPUT"/
-#endif
-#if (defined(CERNLIB_SINGLE))&&(!defined(CERNLIB_CDC))
- DATA NBIT/64/,NOUT/6/
-#endif
-#if defined(CERNLIB_ND100B32)||defined(CERNLIB_ND50)||defined(CERNLIB_ND500)||defined(CERNLIB_DOUBLE)
- DATA NBIT/32/,NOUT/6/
-#endif
-#if defined(CERNLIB_ND100B16)
- DATA NBIT/16/,NOUT/6/
-#endif
-#if defined(CERNLIB_UNIVAC)
- DATA NBIT/36/,NOUT/2/
-#endif
- SAVE IFIRST
- DATA IFIRST/0/
- IF (IFIRST.NE.0) RETURN
- IFIRST=1
-C--- Monitor package usage.
- CALL UMLOG('EPIO','*')
-C--- MAX. NO. OF UNITS SUPPORTED SIMULTANEOUSLY
- NMUNIT=10
-C--- NO. OF CONTROL WORDS / UNIT
- NWUNIT=33
-C--- NO. OF OVERALL CONTROL WORDS
- NCONT=8
-C--- ZERO LAST USER UNIT AND LAST INTERNAL UNIT
- LASTUT=0
- LREF=0
-C--- SET DEFAULTS FOR OVERALL CONTROL WORDS
- LIST(1)=0
- LIST(2)=100
- LIST(3)=0
- LIST(4)=NBIT
- LIST(5)=180
- LIST(6)=12
- LIST(7)=9
- LIST(8)=NOUT
-*
-*---- BLANK DEFAULT FILE NAMES FOR VAX, APOLLO and UNIX
-*
- DO 10 I=1,NMUNIT
- 10 EPVXUN(I)=' '
- RETURN
- END
diff --git a/src/packlib/epio/code/epiot.F b/src/packlib/epio/code/epiot.F
deleted file mode 100644
index 223e5e5..0000000
--- a/src/packlib/epio/code/epiot.F
+++ /dev/null
@@ -1,37 +0,0 @@
-*
-* $Id: epiot.F,v 1.3 1996/11/27 18:00:44 cernlib Exp $
-*
-* $Log: epiot.F,v $
-* Revision 1.3 1996/11/27 18:00:44 cernlib
-* Update Version
-*
-* Revision 1.2 1996/05/03 16:20:10 mclareni
-* Set version stamp in epiot and history file for 1_76
-*
-* Revision 1.1.1.1 1996/03/08 15:21:43 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
- SUBROUTINE EPIOT ( LUN)
-C.
-C.
-C. ******************************************************************
-C. * *
-C. * *
-C. * PRINT PAM TITLE ON LUN *
-C. * *
-C. * *
-C. ******************************************************************
-C.
- WRITE (LUN,1000)
- RETURN
-#if defined(CERNLIB_F4)
- 1000 FORMAT (33H0PACKAGE COMPILED FROM PAM FILE= ,
-#endif
-#if !defined(CERNLIB_F4)
- 1000 FORMAT ('0PACKAGE COMPILED FROM PAM FILE= ',
-#endif
- + 40H EPIO 1_76_01 960411 I101
- +/)
- END
diff --git a/src/packlib/epio/code/epopestf.F b/src/packlib/epio/code/epopestf.F
deleted file mode 100644
index 3624ada..0000000
--- a/src/packlib/epio/code/epopestf.F
+++ /dev/null
@@ -1,150 +0,0 @@
-*
-* $Id: epopestf.F,v 1.1.1.1 1996/03/08 15:21:44 mclareni Exp $
-*
-* $Log: epopestf.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:44 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_STF77)||defined(CERNLIB_STF77VX)
- SUBROUTINE EPOPEN(MODE,IERR)
-*
-* STANDARD FORTRAN FILE OPEN
-*
-* INPUT:
-*
-* MODE =1 FOR WRITE, =2 FOR READ
-*
-#include "epio/epiocom.inc"
-#if defined(CERNLIB_STF77)
-#include "epio/epapocom.inc"
- CHARACTER*256 FLNAM
- PARAMETER (LFLNAM=256)
-#endif
-#if defined(CERNLIB_STF77VX)
-#include "epio/epvaxcom.inc"
- CHARACTER*255 FLNAM
- PARAMETER (LFLNAM=255)
-#endif
-#if defined(CERNLIB_STF77IB)
-C STR151 is used by ERRSAV to eliminate message AFB151
- CHARACTER*8 STR151
-#endif
- LOGICAL OPEND
-*
- LUN = LIST(ISTART+10)
- LREC = LIST(ISTART+1)*2
-*
-* FIRST OF ALL WE CHECK IF THE UNIT HAS BEEN OPEN BY
-* A FORTRAN OPEN STATEMENT
-*
- IF(LIST(ISTART+33).LT.2)THEN
- INQUIRE(UNIT=LUN,NAME=FLNAM,OPENED=OPEND,IOSTAT=IOS)
- IF(IOS.NE.0)GOTO 9901
- IF(OPEND) THEN
-*
-* THE UNIT IS ALREADY OPEN. WE JUST REGISTER THE NAME
-*
- EPVXUN(LREF) = FLNAM
- GOTO 77777
- END IF
- END IF
-*
-* USE USER SPECIFIED NAME, OR DEFAULT NAME 'for0nn',
-*
- IF (EPVXUN(LREF)(1:1).EQ.' ') THEN
-#if !defined(CERNLIB_STF77IB)
-*
-* On Unix, use for0nn for Fortran sequential and
-* epionn for Fortran direct access and C I/O names
-*
- IF(LIST(ISTART+33).LT.1)THEN
- WRITE(FLNAM,1000)LUN/10,MOD(LUN,10)
- 1000 FORMAT('for0',2I1)
- NSLNG = 6
- ELSE
- WRITE(FLNAM,1100)LUN/10,MOD(LUN,10)
- 1100 FORMAT('epio',2I1)
- NSLNG = 6
- ENDIF
-#endif
-#if defined(CERNLIB_STF77IB)
- 1000 FORMAT('/FOR0',2I1,' DAT ')
- NSLNG = 12
-*
-#endif
- EPVXUN(LREF)=FLNAM
- ELSE
- FLNAM = EPVXUN(LREF)
- DO 10 NSLNG=LFLNAM,1,-1
- IF(EPVXUN(LREF)(NSLNG:NSLNG).NE.' ') GO TO 82
- 10 CONTINUE
- 82 CONTINUE
- END IF
-C? LIST(ISTART+24) = 0
-*
- IF(MODE.EQ.2) THEN
-*
-* HERE WE OPEN FOR READING
-*
- IF(LIST(ISTART+33).EQ.1)THEN
-#if defined(CERNLIB_STF77IB)
- CALL FILEINF(IRC,'MAXREC',16777215)
-#endif
- OPEN(LUN,FILE=EPVXUN(LREF)(1:NSLNG),STATUS='OLD',
-#if defined(CERNLIB_STF77VX)
- 1 ACCESS='DIRECT',RECL=LIST(ISTART+1)/2,
-#endif
-#if defined(CERNLIB_STF77IB)||defined(CERNLIB_STF77)
- 1 ACCESS='DIRECT',RECL=LIST(ISTART+1)*2,
-#endif
- 1 FORM='UNFORMATTED',IOSTAT=IOS)
- ELSE IF(LIST(ISTART+33).EQ.0)THEN
- OPEN(LUN,FILE=EPVXUN(LREF)(1:NSLNG),STATUS='OLD',
- 1 FORM='UNFORMATTED',IOSTAT=IOS)
- ELSE IF(LIST(ISTART+33).EQ.2)THEN
- call cfopen(LIST(ISTART+25),0,LIST(ISTART+1)/2,'r',
- 1 0,EPVXUN(LREF)(1:NSLNG),IOS)
- ENDIF
- IF(IOS.NE.0)GOTO 9901
- ELSE
-*
-* HERE WE OPEN FOR WRITING
- IF(LIST(ISTART+33).EQ.1)THEN
-#if defined(CERNLIB_STF77IB)
- CALL ERRSET(151,256,-1,1,0,0)
- CALL ERRSAV(151,STR151)
- CALL FILEINF(IRC,'MAXREC',2)
- OPEN (UNIT=LUN,STATUS='UNKNOWN',ACCESS='DIRECT'
- 1 ,FORM='UNFORMATTED',RECL=LIST(ISTART+1)*2
- 2 ,FILE=EPVXUN(LREF)(1:NSLNG))
- CLOSE(LUN)
- CALL ERRSTR(151,STR151)
- CALL FILEINF(IRC,'MAXREC',16777215)
-#endif
- OPEN(LUN,FILE=EPVXUN(LREF)(1:NSLNG),STATUS='UNKNOWN',
-#if defined(CERNLIB_STF77VX)
- 1 ACCESS='DIRECT',RECL=LIST(ISTART+1)/2,
-#endif
-#if defined(CERNLIB_STF77IB)||defined(CERNLIB_STF77)
- 1 ACCESS='DIRECT',RECL=LIST(ISTART+1)*2,
-#endif
- 1 FORM='UNFORMATTED',IOSTAT=IOS)
- ELSE IF(LIST(ISTART+33).EQ.0)THEN
-*
- OPEN(LUN,FILE=EPVXUN(LREF)(1:NSLNG),STATUS='NEW',
- 1 FORM='UNFORMATTED',IOSTAT=IOS)
- ELSE IF(LIST(ISTART+33).EQ.2)THEN
- call cfopen(LIST(ISTART+25),0,LIST(ISTART+1)/2,'w+',
- 1 0,EPVXUN(LREF)(1:NSLNG),IOS)
- ENDIF
- IF(IOS.NE.0)GOTO 9901
- ENDIF
- GOTO 77777
-C ERROR TRYING TO OPEN
- 9901 CONTINUE
- IERR=1
-77777 RETURN
- END
-#endif
diff --git a/src/packlib/epio/code/epopevax.F b/src/packlib/epio/code/epopevax.F
deleted file mode 100644
index 56f4d0a..0000000
--- a/src/packlib/epio/code/epopevax.F
+++ /dev/null
@@ -1,144 +0,0 @@
-*
-* $Id: epopevax.F,v 1.1.1.1 1996/03/08 15:21:44 mclareni Exp $
-*
-* $Log: epopevax.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:44 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_VAX)
- SUBROUTINE EPOPEN_VAX(MODE,IERR)
- IMPLICIT INTEGER (A-Z)
- INCLUDE '($DCDEF)'
- INCLUDE '($SSDEF)'
- INCLUDE '($FORIOSDEF)'
-#include "epio/epiocom.inc"
-#include "epio/epvaxcom.inc"
- CHARACTER*6 STATUS
-C
-C Determines if file is on magtape or disk and opens it accordingly
-C
-C Input:
-C
-C MODE =1 for writing
-C =2 for reading
-C
-C Mods by Achille Petrilli, Federico Carminati
-C
- CHARACTER*10 RTYPE, CR
- INTEGER*2 IDESC2(8)
- INTEGER IDESC4(4)
- EQUIVALENCE (IDESC2,IDESC4)
- LOGICAL OPEN,EXI
- EXTERNAL EPOPENS_VAX,EPOPENV_VAX,EPOPENO_VAX,MT$K_NORMAL15
- EXTERNAL DVI$_DEVCLASS
-C
-C Fill the item list
-C
- IDESC2(1)=4
- IDESC2(2)=%LOC(DVI$_DEVCLASS)
- IDESC4(2)=%LOC(IDEVIC)
- IDESC4(3)=%LOC(DEVLEN)
- IDESC4(4)=0
-C
- LUN = LIST(ISTART+10)
- LREC = (LIST(ISTART+1)+1)/2
-C
-C USE USER SPECIFIED NAME, OR DEFAULT NAME 'FOR0NN'
-C
- IF (EPVXUN(LREF)(1:1).EQ.' ')
- + WRITE(EPVXUN(LREF),'(''FOR'',I3.3)') LUN
- NSLNG = LENOCC(EPVXUN(LREF))
-C
- INQUIRE(LUN,OPENED=OPEN)
- IF(OPEN) GO TO 999
- LIST(ISTART+24) = 0
- ISTAT=SYS$GETDVIW(,,EPVXUN(LREF)(1:NSLNG),IDESC4,,,,)
- IF (ISTAT.EQ.SS$_IVDEVNAM.OR.ISTAT.EQ.SS$_NOSUCHDEV
- + .OR.ISTAT.EQ.SS$_NONLOCAL.OR.(ISTAT.EQ.SS$_NORMAL.AND.
- + IDEVIC.EQ.DC$_DISK)) THEN
-C
-C The error codes SS$_IVDEVNAM & SS$_NOSUCHDEV & SS$_NONLOCAL
-C mean this is a DISK file because:
-C
-C SS$_IVDEVNAM is returned when the file name is like
-C ABC.DAT[;N] ("." & ";" are illegal in device names)
-C
-C SS$_NOSUCHDEV is returned when the file name is like
-C FOR010 (no assignment to FOR010, interpreted as
-C FOR010.DAT by FORTRAN, legal but inexistent device name)
-C
-C SS$_NONLOCAL is returned in case of a DECNET node. in this
-C case we always assume a disk device
-C
- IDEVIC=DC$_DISK
- IF (MODE.EQ.2) THEN
- INQUIRE(FILE=EPVXUN(LREF)(1:NSLNG),EXIST=EXI)
- IF (.NOT.EXI) GO TO 998
-C
- OPEN (UNIT=LUN,FILE=EPVXUN(LREF)(:NSLNG),STATUS='OLD',
- 1 READONLY,FORM='UNFORMATTED',SHARED)
- INQUIRE(UNIT=LUN,RECORDTYPE=RTYPE,CARRIAGECONTROL=CR)
- READ(LUN,IOSTAT=IOS)
- IF(IOS.EQ.FOR$IOS_SEGRECFOR) RTYPE='VARIABLE'
- CLOSE(LUN)
-C
-C AND A READ
-C
- OPEN (UNIT=LUN,FILE=EPVXUN(LREF)(:NSLNG),STATUS='OLD',
- 1 READONLY,FORM='UNFORMATTED',CARRIAGECONTROL=CR,
- 2 SHARED,RECORDTYPE=RTYPE,USEROPEN=EPOPENV_VAX)
- ELSE
-C
-C And a write
-C
- IF(LIST(ISTART+30).EQ.0) THEN
- STATUS = 'NEW'
- ELSEIF(LIST(ISTART+30).EQ.1) THEN
- STATUS='APPEND'
- END IF
- OPEN (UNIT=LUN,NAME=EPVXUN(LREF)(:NSLNG),TYPE=STATUS,
- 1 FORM='UNFORMATTED',RECORDTYPE='FIXED',RECL = LREC,
- 2 BLOCKSIZE = LREC*4,USEROPEN=EPOPENO_VAX)
- ENDIF
-C
- ELSEIF(IDEVIC.EQ.DC$_TAPE) THEN
-C
-C This is a magtape; the EPOPENS_VAX user open routine will
-C put the channel number into LIST(ISTART+25)
-C
- IF(MODE.EQ.2) THEN
-C
-C And a read
-C
- OPEN (UNIT=LUN,NAME=EPVXUN(LREF)(:NSLNG),TYPE='OLD',
- 1 FORM='UNFORMATTED', RECORDTYPE = 'FIXED',
- 3 USEROPEN = EPOPENS_VAX)
- ELSE
-C
-C And a write
-C
- OPEN (UNIT=LUN,NAME=EPVXUN(LREF)(:NSLNG),TYPE='NEW',
- 1 FORM='UNFORMATTED',RECORDTYPE='FIXED',
- 2 RECL = LREC, BLOCKSIZE = LREC*4,
- 3 USEROPEN = EPOPENS_VAX)
- ENDIF
-C
-C Set the swap mode: this routine switches the hardware
-C in the mag tape formatter and must be handled with care
-C for further information contact A.Rothenberg or M.Scire
-C
- IERR = MT_FORMAT(LIST(ISTART+25),MT$K_NORMAL15)
-C
- ELSE
-C
-C This is an illegal device !!!
-C
- GO TO 998
-C
- ENDIF
- GO TO 999
- 998 IERR=1
- 999 END
-#endif
diff --git a/src/packlib/epio/code/epoutl.F b/src/packlib/epio/code/epoutl.F
deleted file mode 100644
index 63181ee..0000000
--- a/src/packlib/epio/code/epoutl.F
+++ /dev/null
@@ -1,293 +0,0 @@
-*
-* $Id: epoutl.F,v 1.1.1.1 1996/03/08 15:21:44 mclareni Exp $
-*
-* $Log: epoutl.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:44 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
- SUBROUTINE EPOUTL(LUNIT,MODE,NH,IHEAD,NW,IREC,IBUF,IERR)
-C.
-C. THIS ROUTINE WRITES A USER SPECIFIED LOGICAL RECORD HEADER IN FRONT
-C. OF THE DATA, INSTEAD OF THE HEADER PRODUCED AUTOMATICALLY FROM THE
-C. STATUS WORDS.
-C.
-C. THE LOGICAL RECORD DATA ARE GIVEN IN THE SAME CALL.
-C.
-C.
-C. INPUT:
-C.
-C. LUNIT LOGICAL UNIT NUMBER
-C.
-C. MODE =1,2,3
-C. 1: TRANSFER DATA AS THEY ARE (BIT STRING)
-C. 2: PACK DATA BEFORE WRITING, GIVEN AS 16 BIT RIGHT ADJ.
-C. 3: PACK DATA BEFORE WRITING, GIVEN AS 32 BIT RIGHT ADJ.
-C.
-C. NH HEADER LENGTH IN WORDS .
-C.
-C. IHEAD ARRAY CONTAINING HEADER.
-C.
-C. NW NO. OF WORDS TO BE WRITTEN.
-C. FOR MODE=1 IN UNITS, FOR MODE=2 OR =3 IN 16 RESP. 32 BIT
-C. WORDS,I.E. THE NUMBER OF MACHINE WORDS OCCUPIED.
-C.
-C. IREC ARRAY CONTAINING THE USER DATA.
-C.
-C. INPUT/OUTPUT:
-C.
-C. IBUF USER PROVIDED UNIT BUFFER. MUST NOT BE TOUCHED BY USER.
-C.
-C. OUTPUT:
-C.
-C. IERR ERROR FLAG. SEE SEPARATE LIST.
-C.
-#include "epio/epiocom.inc"
-#if !defined(CERNLIB_F4)
- DIMENSION IREC(1),IBUF(1),IHEAD(*)
-#endif
-#if defined(CERNLIB_F4)
- DIMENSION IREC(1),IBUF(1),IHEAD(1)
-#endif
-#if (defined(CERNLIB_HLESS))&&(!defined(CERNLIB_ND100B16))
-C---
- DIMENSION LOCH(12)
-C---
-#endif
-C--- CHECK MODE VALIDITY
- IF(MODE.LE.0.OR.MODE.GT.3) GOTO 9901
-C--- CHECK VALIDITY OF NUMBER OF WORDS, AND HEADER WORDS
- IF(NW.LT.0.OR.NH.LE.0) GOTO 9904
-C--- GET UNIT NUMBER
-C--- CHECK WHETHER SAME USER UNIT AS LAST TIME
- IF(LASTUT.EQ.LUNIT) GOTO 1551
-C--- NEW UNIT - GET REF
- CALL EPUNIT(LUNIT,IERR)
- IF(IERR.EQ.0) GOTO 1552
- GOTO 77777
- 1551 IERR=0
- IF(LREF.NE.0) GOTO 1552
- IERR=13
- CALL EPERRH(LUNIT,IERR)
- GOTO 77777
- 1552 CONTINUE
-C--- START-1 OF CONTROL WORDS
-C--- ERROR IF UNIT IS INPUT UNIT
- IF(LIST(ISTART+16).EQ.2) GOTO 9903
-C--- INITIALIZE PHYS. HEADER, MARK UNIT FOR WRITING
- IF(LIST(ISTART+14).EQ.0) CALL EPHEAD(IBUF)
-C--- SET LOG. REC. DATA TYPE : 1 = 16 BIT, 2 = 32 BIT
- NTYPE=LIST(ISTART+3)/16
- IF(NTYPE.LE.0.OR.NTYPE.GT.2) NTYPE=1
-C--- LOGICAL RECORD HEADER LENGTH IN 16 BIT WORDS
- NHL=NTYPE*NH
-C--- SPAN (=0) OR NOSPAN(=1) FLAG
- NOSPAN=LIST(ISTART+8)/10
-C--- LOGICAL RECORD DATA LENGTH IN 16 BIT WORDS
- IF(MODE.EQ.1) NWD=NTYPE*NW
- IF(MODE.NE.1) NWD=(MODE-1)*NW
- IF(NTYPE.EQ.1 .AND. NWD+NHL.GT.65535)GOTO 9905
- IF(MODE.EQ.2.AND.NTYPE.EQ.2) NWD=2*((NW+1)/2)
-#if (defined(CERNLIB_HSPAN))&&(!defined(CERNLIB_ND100B16))
- IF(LIST(ISTART+14).GE.LIST(ISTART+1)) THEN
- CALL EPBOUT(IBUF,IERR)
- IF(IERR.NE.0) GOTO 77777
- ENDIF
-#endif
-#if !defined(CERNLIB_HSPAN)
-C--- WRITE BLOCK OUT IF L.H. DOES NOT FIT, OR ENTIRE REC.
-C IF IN NOSPAN MODE
- IF(LIST(ISTART+14)+NHL+NWD*NOSPAN.LE.LIST(ISTART+1)) GOTO 20
-C--- WRITE
- CALL EPBOUT(IBUF,IERR)
- IF(IERR.NE.0) GOTO 77777
-C--- CHECK WHETHER LOC.REC. HEADER (+POSSIBLY DATA)FITS AT ALL
- IF(LIST(ISTART+14)+NHL+NWD*NOSPAN.GT.LIST(ISTART+1)) GOTO 9902
- 20 CONTINUE
-#endif
-C--- INCREASE LOGICAL RECORD COUNT
- LIST(ISTART+12)=LIST(ISTART+12)+1
-#if (defined(CERNLIB_ULENG))&&(!defined(CERNLIB_ND100B16))
- IHEAD(1)=1
-#endif
-#if !defined(CERNLIB_ULENG)
- IHEAD(1)=NH+NWD/NTYPE
-#endif
- IF(LIST(ISTART+5).GE.0) IHEAD(2)=LIST(ISTART+5)
- IHEAD(3)=NH
- IF(LIST(ISTART+6).GE.0) IHEAD(4)=LIST(ISTART+12)
-C--- TRANSFER LOG. REC. HEADER
- NS=LIST(ISTART+14)
-C--- SET START OF FIRST LOG. REC. (P.H. WORD 4)
- IF(LIST(ISTART+15).EQ.0) LIST(ISTART+15)=NS
-#if (defined(CERNLIB_HSPAN))&&(!defined(CERNLIB_ND100B16))
- NPT=LIST(ISTART+1)-LIST(ISTART+14)
- IF(NHL.GT.NPT) THEN
-C--- SPLIT HEADER
- IF(NTYPE.EQ.1) THEN
-C--- 16 BIT HEADER
- CALL BUN16W(IHEAD,1,IBUF,NS+1,NPT)
- ELSE
-C--- 32 BIT HEADER
- IMD=MOD(NPT,2)
- NPT2=NPT/2
- CALL CTOIBM(IHEAD,NH,2)
- CALL BUN32W(IHEAD,1,IBUF,NS+1,NPT2)
- IF(IMD.NE.0) THEN
- CALL BUN32W(IHEAD,NPT2+1,KEEP,1,1)
- CALL W16MOV(KEEP,1,IBUF,NS+NPT,1)
- ENDIF
- ENDIF
- LIST(ISTART+14)=LIST(ISTART+1)
- CALL EPBOUT(IBUF,IERR)
- IF(IERR.NE.0) GOTO 77777
- NS=LIST(ISTART+14)
- IF(NTYPE.EQ.1) THEN
- CALL BUN16W(IHEAD,NPT+1,IBUF,NS+1,NHL-NPT)
- NS=NS+NHL-NPT
- ELSE
- IF(IMD.NE.0) THEN
- CALL W16MOV(KEEP,2,IBUF,NS+1,1)
- NS=NS+1
- NPT2=NPT2+1
- ENDIF
- CALL BUN32W(IHEAD,NPT2+1,IBUF,NS+1,NH-NPT2)
- NS=NS+2*(NH-NPT2)
- CALL CFRIBM(IHEAD,NH,2)
- ENDIF
- GOTO 30
- ENDIF
-#endif
- IF(NTYPE.EQ.1) THEN
- CALL BUN16W(IHEAD,1,IBUF,NS+1,NH)
- ELSE
- CALL CTOIBM(IHEAD,NH,2)
- CALL BUN32W(IHEAD,1,IBUF,NS+1,NH)
- CALL CFRIBM(IHEAD,NH,2)
- ENDIF
- NS=NS+NHL
-#if (defined(CERNLIB_HSPAN))&&(!defined(CERNLIB_ND100B16))
- 30 CONTINUE
-#endif
- LIST(ISTART+14)=NS
-C--- LOOP AND TRANSFER
- IPTUS=0
- LEFT16=NWD
-C--- FLAG FOR 32 BIT WORD SPLITTING
-#if (defined(CERNLIB_HLESS))&&(!defined(CERNLIB_ND100B16))
-C--- KEEP P.H.
- IF(LIST(ISTART+29).EQ.1) THEN
- CALL W16MOV(IBUF,1,LOCH,1,24)
- ELSE
- CALL W16MOV(IBUF,1,LOCH,1,12)
- ENDIF
-C--- GET NO. OF HEADERLESS BLOCKS FOLLOWING
- NHLESS=(NWD+NS)/LIST(ISTART+1)
-C--- INSERT IN CONTROL WORD
- IF(LIST(ISTART+29).EQ.1) THEN
- CALL CTOIBM(NHLESS,1,2)
- CALL BUN32W(NHLESS,1,IBUF,17,1)
- CALL CFRIBM(NHLESS,1,2)
- ELSE
- CALL BUN16W(NHLESS,1,IBUF,9,1)
- ENDIF
-C---
-#endif
- L32=0
- 100 CONTINUE
-C--- NO. OF 16 BIT STILL TO TRANSFER (UP TO BUFFER SIZE)
- NT16=MIN0(LEFT16,LIST(ISTART+1)-NS)
- GOTO (110,120,130),MODE
- 110 CONTINUE
-C--- MODE = 1 : TRANSFER PACKED STRING
- CALL W16MOV(IREC,IPTUS+1,IBUF,NS+1,NT16)
- IPTUS=IPTUS+NT16
- GOTO 200
- 120 CONTINUE
-C--- MODE = 2 : PACK 16 BIT WORDS
- CALL BUN16W(IREC,IPTUS+1,IBUF,NS+1,NT16)
- IPTUS=IPTUS+NT16
- GOTO 200
- 130 CONTINUE
-C--- MODE = 3 : PACK 32 BIT WORDS
-C--- CHECK WHETHER RIGHT HALF OF SPLIT WORD LEFT OVER
- IF(L32.EQ.0) GOTO 131
- CALL W16MOV(KEEP,2,IBUF,NS+1,1)
- NS=NS+1
- NT16=NT16-1
- LEFT16=LEFT16-1
- L32=0
- 131 CONTINUE
- NT=NT16/2
- CALL BUN32W(IREC,IPTUS+1,IBUF,NS+1,NT)
- IPTUS=IPTUS+NT
-C--- CHECK FOR SPLITTING
- IF(MOD(NT16,2).EQ.0) GOTO 200
- L32=1
- CALL BUN32W(IREC,IPTUS+1,KEEP,1,1)
- CALL W16MOV(KEEP,1,IBUF,NS+NT16,1)
- IPTUS=IPTUS+1
- 200 CONTINUE
- NS=NS+NT16
- LIST(ISTART+14)=NS
- LEFT16=LEFT16-NT16
-C--- CHECK WHETHER ALL DATA TRANSFERRED
-#if (defined(CERNLIB_HLESS))&&(!defined(CERNLIB_ND100B16))
- IF(LEFT16.EQ.0) GOTO 77776
-#endif
-#if !defined(CERNLIB_HLESS)
- IF(LEFT16.EQ.0) GOTO 77777
-#endif
-C--- NO - WRITE AND CONTINUE
- CALL EPBOUT(IBUF,IERR)
- IF(IERR.NE.0) GOTO 77777
-#if (defined(CERNLIB_HLESS))&&(!defined(CERNLIB_ND100B16))
- LIST(ISTART+14)=0
- LIST(ISTART+7)=0
- IERR=-1
-#endif
- NS=LIST(ISTART+14)
- GOTO 100
-#if (defined(CERNLIB_HLESS))&&(!defined(CERNLIB_ND100B16))
-77776 CONTINUE
-C--- RESET IF NECESSARY
- IF(NHLESS.EQ.0) GOTO 77777
- IERR=-1
- CALL EPBOUT(IBUF,IERR)
- IF(LIST(ISTART+29).EQ.1) THEN
- CALL W16MOV(LOCH,1,IBUF,1,24)
- LIST(ISTART+14)=24
- LIST(ISTART+7)=24
- ELSE
- CALL W16MOV(LOCH,1,IBUF,1,12)
- LIST(ISTART+14)=12
- LIST(ISTART+7)=12
- ENDIF
-#endif
-77777 RETURN
- 9901 CONTINUE
-C--- MODE ERROR
- IERR=8
- GOTO 599
-#if !defined(CERNLIB_HSPAN)
- 9902 CONTINUE
-C--- LOGICAL RECORD HEADER TOO LONG TO FIT IN ONE PHYS. BLOCK
- IERR=15
- GOTO 599
-#endif
- 9903 CONTINUE
-C--- UNIT IS INPUT UNIT
- IERR=17
- GOTO 599
- 9904 CONTINUE
-C--- NEGATIVE NUMBER OF WORDS, OR ZERO (NEG.) LENGTH HEADER GIVEN
- IERR=20
- GOTO 599
- 9905 CONTINUE
-C--- with 16 bit headers the record plus header length must be lt 65536
- IERR=24
- 599 CONTINUE
- CALL EPERRH(LUNIT,IERR)
- GOTO 77777
- END
diff --git a/src/packlib/epio/code/epouts.F b/src/packlib/epio/code/epouts.F
deleted file mode 100644
index e805134..0000000
--- a/src/packlib/epio/code/epouts.F
+++ /dev/null
@@ -1,68 +0,0 @@
-*
-* $Id: epouts.F,v 1.1.1.1 1996/03/08 15:21:44 mclareni Exp $
-*
-* $Log: epouts.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:44 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
- SUBROUTINE EPOUTS(LUNIT,MODE,NW,IREC,IBUF,IERR)
-C.
-C. THIS ROUTINE WRITES ONE LOGICAL RECORD WITH STANDARD LOGICAL RECORD
-C. HEADER.
-C.
-C. INPUT:
-C.
-C. LUNIT LOGICAL UNIT NUMBER
-C.
-C. MODE =1,2,3
-C. 1: TRANSFER DATA AS THEY ARE (BIT STRING)
-C. 2: PACK DATA BEFORE WRITING, GIVEN AS 16 BIT RIGHT ADJ.
-C. 3: PACK DATA BEFORE WRITING, GIVEN AS 32 BIT RIGHT ADJ.
-C.
-C. NW NO. OF WORDS TO BE WRITTEN.
-C. FOR MODE=1 IN UNITS, FOR MODE=2 OR =3 IN 16 RESP. 32 BIT
-C. WORDS,I.E. THE NUMBER OF MACHINE WORDS OCCUPIED.
-C.
-C. IREC ARRAY CONTAINING THE USER DATA. DUMMY ARGUMENT FOR MODE=0.
-C.
-C. INPUT/OUTPUT:
-C.
-C. IBUF USER PROVIDED UNIT BUFFER. MUST NOT BE TOUCHED BY USER.
-C.
-C. OUTPUT:
-C.
-C. IERR ERROR FLAG. SEE SEPARATE LIST.
-C.
-#include "epio/epiocom.inc"
- DIMENSION IREC(2),IBUF(2),IHEAD(4)
- DATA NH/4/
-C--- GET UNIT NUMBER
-C--- CHECK WHETHER SAME USER UNIT AS LAST TIME
- IF(LASTUT.EQ.LUNIT) GOTO 1551
-C--- NEW UNIT - GET REF
- CALL EPUNIT(LUNIT,IERR)
- IF(IERR.EQ.0) GOTO 1552
- GOTO 77777
- 1551 IERR=0
- IF(LREF.NE.0) GOTO 1552
- IERR=13
- CALL EPERRH(LUNIT,IERR)
- GOTO 77777
- 1552 CONTINUE
-C--- START-1 OF CONTROL WORDS
-C--- ERROR IF UNIT IS INPUT UNIT
- IF(LIST(ISTART+16).EQ.2) GOTO 9903
-C--- CONSTRUCT STANDARD HEADER
- IHEAD(2)=LIST(ISTART+5)
- IHEAD(4)=LIST(ISTART+12)+1
-C--- PROCESS
- CALL EPOUTL(LUNIT,MODE,NH,IHEAD,NW,IREC,IBUF,IERR)
-77777 RETURN
- 9903 CONTINUE
-C--- UNIT IS INPUT UNIT
- IERR=17
- CALL EPERRH(LUNIT,IERR)
- GOTO 77777
- END
diff --git a/src/packlib/epio/code/epread.F b/src/packlib/epio/code/epread.F
deleted file mode 100644
index 917187f..0000000
--- a/src/packlib/epio/code/epread.F
+++ /dev/null
@@ -1,362 +0,0 @@
-*
-* $Id: epread.F,v 1.1.1.1 1996/03/08 15:21:44 mclareni Exp $
-*
-* $Log: epread.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:44 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
- SUBROUTINE EPREAD(LUNIT,MODEX,NW,IREC,IBUF,IERR)
-CD COMMON/EPDBGC/DBUGFL
-CD LOGICAL DBUGFL
-C.
-C. INPUT:
-C.
-C. LUNIT LOGICAL UNIT NUMBER
-C.
-C. MODEX =J , J=1,2,3 : GET NEXT LOGICAL RECORD DATA
-C. J=1 : DATA TRANSFERRED IN PACKED FORM
-C. J=2 : DATA UNPACKED AS 16 BIT BYTES/WORD
-C. J=3 : DATA UNPACKED AS 32 BIT BYTES/WORD
-C.
-C. =10+J, J=1,2,3 AS ABOVE: GET DATA OF CURRENT LOGICAL RECORD
-C. (ONLY POSSIBLE AFTER A PREVIOUS CALL WITH J=20).
-C.
-C. =20 : GET HEADER OF NEXT LOGICAL RECORD. THE HEADER WILL
-C. ALWAYS BE UNPACKED IN UNITS (16 OR 32 BIT WORDS).
-C.
-C. =30 : GET NEXT PHYSICAL HEADER.
-C. THE HEADER WILL ALWAYS BE UNPACKED AS 16 BIT/WORD.
-C.
-C. INPUT/OUTPUT:
-C.
-C. IBUF USER PROVIDED UNIT BUFFER. MUST NOT BE TOUCHED BY USER.
-C.
-C. OUTPUT:
-C.
-C. NW NO. OF WORDS TRANSFERRED INTO IREC.
-C. FOR J=1 NO. OF UNITS, FOR J=2 OR J=3 NO. OF 16 OR 32 BIT
-C. WORDS, I.E. NUMBER OF MACHINE WORDS OCCUPIED IN IREC.
-C.
-C. IREC USER PROVIDED AREA TO STORE THE HEADER OR DATA REQUESTED.
-C.
-C. IERR ERROR FLAG. SEE SEPARATE LIST.
-C.
-C. REMARK:
-C. ------
-C. FOR READING THE OLD EP FORMAT, THE PREVIOUS CALL TO EVENT
-C. CALL EVENT(IARRAY,ISTAT)
-C. HAS TO BE REPLACED BY A CALL WITH J=1,2, OR 3. IN THIS CASE, AS FOR
-C. EVENT NOW, THE COMPLETE RECORD (INCLUDING THE HEADER) WILL BE
-C. TRANSFERRED. PLEASE NOTE THAT THE DATA NOW START IN IREC(1),
-C. INSTEAD OF IARRAY(2) BEFORE.
-#include "epio/epiocom.inc"
- DIMENSION IBUF(1),IHEAD(3),IREC(1)
- LOGICAL FLAG1,FLAG2,FLAG3
- DATA NEND/65535/
- MODE=MODEX
- FLAG1=MODE.EQ.1.OR.MODE.EQ.2.OR.MODE.EQ.3
- FLAG2=MODE.EQ.11.OR.MODE.EQ.12.OR.MODE.EQ.13
- IF(FLAG1.OR.FLAG2.OR.MODE.EQ.20.OR.MODE.EQ.30) GOTO 5
- IERR=8
- GOTO 9999
- 5 CONTINUE
-C--- CHECK WHETHER SAME USER UNIT AS LAST TIME
- IF(LASTUT.EQ.LUNIT) GOTO 1551
-C--- NEW UNIT - GET REF
- CALL EPUNIT(LUNIT,IERR)
- IF(IERR.EQ.0) GOTO 1552
- GOTO 77777
- 1551 IERR=0
- IF(LREF.NE.0) GOTO 1552
- IERR=13
- CALL EPERRH(LUNIT,IERR)
- GOTO 77777
- 1552 CONTINUE
-C--- ERROR IF UNIT IS OUTPUT UNIT
- IF(LIST(ISTART+16).EQ.1) GOTO 9901
-C--- SET UPPER LENGTH OF USER RECORD SPACE
- MLUSER=LIST(ISTART+2)
-C--- FOR HEADER, TAKE STATUS WORD 26
- IF(MODE.EQ.20 .OR. MODE.EQ.30) MLUSER=LIST(ISTART+26)
-C--- FOR BIT STRING, TAKE CORRECT LENGTH IN MACHINE WORDS
- IF(MODE.EQ.1 .OR. MODE.EQ.11)MLUSER=MLUSER*LIST(4)/16
- 10 LPOS=LIST(ISTART+22)
- IF(LPOS.EQ.4) GOTO 9905
- IF(FLAG2.AND.LPOS.NE.1) GOTO 9902
- IF(MODE .EQ. 30)GOTO 20
-C--CHECK FOR NEW BLOCK REQUIRED
- IF(LIST(ISTART+14).EQ.0)GOTO 20
- IP1=LIST(ISTART+23)
- IF(LPOS.EQ.2) IP1=LIST(ISTART+15)
- IF(IWD16(IBUF,IP1+1).NE.NEND.OR.LPOS.EQ.1)GOTO 30
-C-- READ NEW BLOCK
- 20 CALL EPBLIN(IBUF,IERR)
- IF(IERR.NE.0) GOTO 9999
- IF(LIST(ISTART+7).EQ.0)GOTO 20
-*--- take the 1st pointer from word(15) if sequential mode or next
-*--- record in direct access mode
- IF(LIST(ISTART+32).NE.1) THEN
- IP1=LIST(ISTART+15)
- ELSE
-*--- random access HG march 17, 89
-*--- take the 1st pointer from word(23) if direct access mode and
-*--- 1st record after a call to EPDACR.
- IP1=LIST(ISTART+23)
- LIST(ISTART+32)=2
- ENDIF
- IF(LPOS.EQ.1) IP1=LIST(ISTART+7)
- IF(MODE.NE.30)GOTO 30
-C--GET THE PHYSICAL HEADER
- LPH=LIST(ISTART+7)
- ML=MLUSER
- IF(LIST(ISTART+29).EQ.0) THEN
- NW=MIN(LPH,ML)
- CALL BLO16W(IBUF,1,IREC,1,NW)
- ELSE
- NW=MIN(LPH/2,ML)
- CALL BLO32W(IBUF,1,IREC,1,NW)
- CALL CFRIBM(IREC,NW,2)
- ENDIF
- LIST(ISTART+22)=2
- IF(LPH.GT.ML) GOTO 9903
- GOTO 77777
-C--SET UP POINTERS
- 30 CONTINUE
-C--- IF OLD FORMAT FORCE MODE=2
- LOLD=LIST(ISTART+17)
- IF(LOLD.EQ.1 .AND. MODE.GT.3)GOTO 9907
- IF(LOLD.EQ.1) MODE=2
- LPOS=LIST(ISTART+22)
- IF(LPOS.EQ.2)IP1=LIST(ISTART+15)
-C-- IP1=0 IMPLIES NO L.R. STARTING IN BLOCK
- IF(IP1.EQ.0)GOTO 20
-C--- NOW THERE IS A LOGICAL RECORD STARTING IN CURRENT BLOCK,
-C OR IP1 POINTS TO THE START OF DATA IN THIS BLOCK
-*--- new pointer to start of header (always) HG march 17, 89
- LIST(ISTART+31)=IP1
- NP=LIST(ISTART+14)
- IUNIT=LIST(ISTART+3)
- IF(.NOT.(IUNIT.EQ.16 .OR. IUNIT.EQ.32))GOTO 9908
- NFACT=IUNIT/16
- NHMIN=3*NFACT
- FLAG3=MODE.EQ.3.OR.MODE.EQ.13.OR.(MODE.EQ.20.AND.IUNIT.EQ.32)
- ML=MLUSER
-C--- SPECIAL HEADER TREATMENT FOR OLD FORMAT
- IF(LOLD.EQ.0) GOTO 40
- NL=IWD16(IBUF,IP1+1)
- IF(NL.EQ.0) GOTO 9904
- LHL=0
- NHMIN=0
- IUNIT=16
- NFACT=1
- GOTO 170
- 40 CONTINUE
-CD LABEL=30
-CD IF(DBUGFL)PRINT*,LABEL,LUNIT,IP1,NP,IUNIT,LPOS,MODE
- IF(LPOS.NE.1) GOTO 110
- NL=LIST(ISTART+20)
- LHL=LIST(ISTART+21)
- IF(FLAG2) GOTO 160
- LPOS=-1
- NWDS=NFACT*(NL-LHL)
- GOTO 210
-C--PUT LOGICAL HEADER INTO IHEAD
- 110 J=NP-IP1
- IF(J.LT.NHMIN)GOTO 120
-CD LABEL=110
-CD IF(DBUGFL)PRINT*,LABEL,LUNIT,IP1,NP,J
- CALL W16MOV(IBUF,IP1+1,IHEAD,1,NHMIN)
- IP1=IP1+NHMIN
- GOTO 140
-C-- LOGICAL HEADER IS SPLIT
- 120 CALL W16MOV(IBUF,IP1+1,IHEAD,1,J)
- IF(J.LT.NFACT) GOTO 121
- IF(NFACT.EQ.1) THEN
- NL=IWD16(IHEAD,1)
- ELSE
- CALL BLO32W(IHEAD,1,NL,1,1)
- CALL CFRIBM(NL,1,2)
- ENDIF
- IF(NL.EQ.0) GOTO 9904
- 121 CALL EPBLIN(IBUF,IERR)
- IF(IERR.NE.0) GOTO 9999
- NP=LIST(ISTART+14)
- IP1=LIST(ISTART+7)
- N3=NHMIN-J
- CALL W16MOV(IBUF,IP1+1,IHEAD,J+1,N3)
- IP1=IP1+N3
- 140 IF(IUNIT.EQ.32)GOTO 150
- NL=IWD16(IHEAD,1)
- LHL=IWD16(IHEAD,3)
- GOTO 160
- 150 CALL BLO32W(IHEAD,1,NL,1,1)
- CALL BLO32W(IHEAD,5,LHL,1,1)
- CALL CFRIBM(NL,1,2)
- CALL CFRIBM(LHL,1,2)
- 160 IF(NL.EQ.0) GOTO 9904
-C--SET UP LOOP LIMITS
- 170 NWDS=NFACT*(NL-LHL)
-C--- IF DATA REQUESTED, SHIFT POINTER TO START OF DATA
- IF(FLAG1) IP1=IP1+NFACT*LHL-NHMIN
- IF(IP1.LE.NP) GOTO 171
-C--- SKIP REST OF HEADER WHICH IS SPLIT - READ NEXT BLOCK
- CALL EPBLIN(IBUF,IERR)
- IF(IERR.NE.0) GOTO 9999
- IP1=LIST(ISTART+7)+IP1-NP
- NP=LIST(ISTART+14)
- 171 CONTINUE
-C--- FOR UNKNOWN LENGTH, GIVE DATA UNTIL END OF BLOCK
- IF(NL.EQ.1) NWDS=NP-IP1
-C--- GET UPPER SIZE OF USER RECORD LIMIT
- ML=MLUSER
- 180 IP2=0
- L32=0
- NW=0
- NTOT=0
-CD LABEL=180
-CD IF(DBUGFL)PRINT*,LABEL,LUNIT,NWDS,NL,LHL,IUNIT,ML,IP1
-C--IF MODE=20 FIRST MOVE IHEAD INTO IREC
- IF(MODE.NE.20)GOTO 210
- NTOT=NTOT+NHMIN
- IF(NFACT.EQ.1) CALL BLO16W(IHEAD,1,IREC,1,3)
- IF(NFACT.EQ.2) CALL BLO32W(IHEAD,1,IREC,1,3)
- IP2=IP2+3
- NW=NW+3
- NWDS=NFACT*(LHL-3)
-C--CALCULATE NO. OF WORDS TO MOVE
- 210 NMIN1=MIN0(NWDS,NP-IP1)
- N3=MIN0(NMIN1,ML-IP2)
- IF(LPOS.EQ.-1)N3=0
-CD LABEL=210
-CD IF(DBUGFL)PRINT*,LABEL,LUNIT,NMIN1,NWDS,NP,IP1,IP2,N3
- IF(N3.LE.0)GOTO 320
- IF(FLAG3) GOTO 230
-C-- 16 BIT CASES
- IF(MODE.EQ.1 .OR. MODE.EQ.11)GOTO 220
- CALL BLO16W(IBUF,IP1+1,IREC,IP2+1,N3)
- GOTO 310
- 220 CALL W16MOV(IBUF,IP1+1,IREC,IP2+1,N3)
- GOTO 310
- 230 IF(L32.EQ.0)GOTO 240
-C-- GET SECOND HALF OF SPLIT 32 BIT WORD
- CALL W16MOV(IBUF,IP1+1,KEEP,2,1)
- IP2=IP2+1
- CALL BLO32W(KEEP,1,IREC,IP2,1)
- NW=NW+1
- IP1=IP1+1
- NMIN1=NMIN1-1
- NWDS=NWDS-1
- NTOT=NTOT+1
- L32=0
- 240 N3=MIN0(NMIN1/2,ML-IP2)
- IF(NL.NE.1.AND. NWDS.LE.NMIN1)N3=MIN0((NMIN1+1)/2,ML-IP2)
- CALL BLO32W(IBUF,IP1+1,IREC,IP2+1,N3)
- IF(MOD(NMIN1,2) .EQ.0)GOTO 310
-C-- KEEP 1ST HALF OF SPLIT 32 BIT WORD
- L32=1
- CALL W16MOV(IBUF,NP,KEEP,1,1)
-C-- UPDATE POINTERS IN IREC
- 310 NW=NW+N3
- IP2=IP2+N3
-C-- UPDATE POINTERS IN IBUF
- 320 IP1=IP1+NMIN1
- NWDS=NWDS-NMIN1
- NTOT=NTOT+NMIN1
-CD LABEL=320
-CD IF(DBUGFL)PRINT*,LABEL,LUNIT,IP1,IP2,NW,N3,NMIN1,NWDS,LPOS
- IF(NL.EQ.1.AND.MODE.NE.20) GOTO 330
- IF(NWDS.NE.0)GOTO 330
-C-- THE LOGICAL RECORD IS FINISHED
- LIST(ISTART+20)=NL
-C--- NL=0 INDICATES HERE BLOCK WITH L.R. START FOUND
- IF(NL.EQ.0)LIST(ISTART+20)=NTOT+LHL
- LIST(ISTART+21)=LHL
- LIST(ISTART+23)=IP1
- LIST(ISTART+22)=0
- IF(MODE.EQ.20) THEN
- LIST(ISTART+22)=1
- IF(IUNIT.EQ.32) CALL CFRIBM(IREC,NW,2)
- ENDIF
- IF(LPOS.EQ.-1)LIST(ISTART+22)=0
- IF(NP.EQ.IP1)LIST(ISTART+14)=0
- IF(LPOS.EQ.-1)GOTO 10
- IF(IUNIT.EQ.32.AND.(MODE.EQ.1.OR.MODE.EQ.11)) NW=NW/2
- IF(MODE.EQ.20 .OR. MODE.LE.3)LIST(ISTART+12)=LIST(ISTART+12)+1
- IF(NL.NE.0.OR.IERR.NE.1) GOTO 321
-C--- E.O.F. AFTER UNKNOWN LENGTH RECORD - SPECIAL TREATMENT
- LIST(ISTART+22)=4
- IERR=0
-C-- TEST FOR TRUNCATED DATA
- 321 IF(FLAG3) ML=2*ML
- IF(NTOT.GT.ML) GOTO 9903
- GOTO 77777
-C-- READ NEXT BLOCK
- 330 CALL EPBLIN(IBUF,IERR)
-C--- CHECK FOR E.O.F. AFTER UNKNOWN LENGTH RECORD
- IF(IERR.EQ.1.AND.NL.EQ.1) GOTO 341
- IF(IERR.NE.0) GOTO 9999
- NP=LIST(ISTART+14)
- IP1=LIST(ISTART+7)
- IF(NL.EQ.1) GOTO 335
-C--- CHECK FOR INCONSISTENT LS FOR CURRENT L.R.
-C ( ESPECIALLY FOR OLD EP FORMAT )
- LS=LIST(ISTART+15)
- IF(LS.EQ.0) GOTO 210
- NNWDS=NWDS
- IF(MODE.EQ.20.AND.LPOS.NE.(-1)) NNWDS=NWDS+NFACT*(NL-LHL)
- IF(LS.EQ.NNWDS+LIST(ISTART+7)) GOTO 210
- LIST(ISTART+22)=0
- LIST(ISTART+23)=LS
- GOTO 9906
- 335 CONTINUE
- IF(LIST(ISTART+15).EQ.0)GOTO 340
- NL=0
- NWDS=LIST(ISTART+15)-IP1
- GOTO 210
- 340 NWDS=NP-IP1
- GOTO 210
-C--- E.O.F. AFTER UNKNOWN LENGTH RECORD
- 341 NWDS=0
- IP1=0
- NL=0
- GOTO 210
-77777 RETURN
- 9901 CONTINUE
-C--- UNIT IS OUTPUT UNIT
- IERR=17
- GOTO 9999
- 9902 CONTINUE
-C--- MODE 11,12,13 WITHOUT 20
- IERR=9
- GOTO 9999
- 9903 CONTINUE
-C--- DATA TRUNCATED
- IERR=6
- GOTO 9999
- 9904 CONTINUE
-C--NL=0 IMPLIES END OF RUN
- IERR=10
- LIST(ISTART+14)=0
- GOTO 9999
- 9905 CONTINUE
-C--- E.O.F. CONDITION TO USER AFTER UNKNOWN LENGTH RECORD
- IERR=1
- LIST(ISTART+22)=0
- GOTO 9999
- 9906 CONTINUE
-C--- LS (OFF-SET IN BLOCK) AND L.R. LENGTH DO NOT CHECK
- IERR=18
- GOTO 9999
- 9907 CONTINUE
-C--- OLD FORMAT AND MODE GT 3
- IERR=21
- GOTO 9999
- 9908 CONTINUE
-C--- LOGICAL RECORD UNIT (LIST(ISTART+3)) NE 16 OR 32
- LIST(ISTART+14)=0
- IERR=23
- 9999 CALL EPERRH(LUNIT,IERR)
- GOTO 77777
- END
diff --git a/src/packlib/epio/code/eprwnd.F b/src/packlib/epio/code/eprwnd.F
deleted file mode 100644
index cc13759..0000000
--- a/src/packlib/epio/code/eprwnd.F
+++ /dev/null
@@ -1,157 +0,0 @@
-*
-* $Id: eprwnd.F,v 1.2 1996/04/11 12:34:10 mclareni Exp $
-*
-* $Log: eprwnd.F,v $
-* Revision 1.2 1996/04/11 12:34:10 mclareni
-* F. Ranjard's protection for rewinding with a wrong file descriptor
-*
-* Revision 1.1.1.1 1996/03/08 15:21:44 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
- SUBROUTINE EPRWND(LUNIT,IBUF,IERR)
-C.
-C. REWINDING AN OUTPUT UNIT CLOSES THE UNIT AND WRITES AN END OF FILE
-C. MARK (ROUTINE EPEOF). AFTER A REWIND OPERATION (AND ONLY IN THAT
-C. CASE) THE USER MAY SWITCH FROM READING TO WRITING OR VICE VERSA.
-C.
-C. THE PHYS. HEADER IS RESET TO THE STANDARD HEADER AFTER A REWIND.
-C. THE BLOCK AND RECORD COUNTS ARE RESET TO ZERO.
-C.
-C. INPUT:
-C.
-C. LUNIT LOGICAL UNIT
-C.
-C. IBUF USER PROVIDED UNIT BUFFER. MUST NOT BE TOUCHED BY USER.
-C.
-C. OUTPUT:
-C.
-C. IERR ERROR FLAG. SEE SEPARATE LIST.
-#if defined(CERNLIB_APOLLO)
-%INCLUDE '/sys/ins/base.ins.ftn'
-%INCLUDE '/sys/ins/error.ins.ftn'
-%INCLUDE '/sys/ins/streams.ins.ftn'
- INTEGER*2 STREAM_$ID,ERROR_$RETURNED
- INTEGER STATUS_$RETURNED,ATT_$REC_4(16)
- EQUIVALENCE (ATT_$REC_4,STREAM_$ID)
-#endif
-#include "epio/epiocom.inc"
- DIMENSION IBUF(2)
-C--- CHECK WHETHER SAME USER UNIT AS LAST TIME
- IF(LASTUT.EQ.LUNIT) GOTO 1551
-C--- NEW UNIT - GET REF
- CALL EPUNIT(LUNIT,IERR)
- IF(IERR.EQ.0) GOTO 1552
- GOTO 77777
- 1551 IERR=0
- IF(LREF.NE.0) GOTO 1552
- IERR=13
- CALL EPERRH(LUNIT,IERR)
- GOTO 77777
- 1552 CONTINUE
-C--- CLOSE IF OUTPUT UNIT
- IF(LIST(ISTART+16).NE.1) GOTO 10
- CALL EPCLOS(LUNIT,IBUF,IERR)
- IF(IERR.NE.0) GOTO 77777
- IF(LIST(ISTART+33).NE.2)CALL EPEOF(LUNIT,IERR)
- 10 CONTINUE
- IF(IERR.NE.0) GOTO 77777
-#if defined(CERNLIB_IBM)||defined(CERNLIB_NORD)
- CALL IORWND(LUNIT,IRETCD)
- IF(IRETCD.EQ.0) GOTO 11
- IERR=11
- CALL EPERRH(LUNIT,IERR)
- GOTO 77777
- 11 CONTINUE
-#endif
-#if defined(CERNLIB_CDC)||defined(CERNLIB_CRAY)||defined(CERNLIB_STF77)||defined(CERNLIB_STF77VX)
- IF(LIST(ISTART+33).EQ.0)REWIND LUNIT
- IF(LIST(ISTART+33).EQ.2 .AND. LIST(ISTART+25).NE.0)
- 1 call cfrew(LIST(ISTART+25),0)
-#endif
-#if defined(CERNLIB_VAX)
- IF(LIST(ISTART+25).NE.0)THEN
-C
-C REWIND QIO MAGTAPE HERE
-C
- CALL EPMTREW(IERR)
- IF(IERR.NE.1)THEN
- WRITE(NOUTUT,1001) IERR
-1001 FORMAT(/' +++ EP I/O PACKAGE VAX MAGTAPE ERROR ',Z10,' HEX ')
- IERR = 12
- CALL EPERRH(LIST(ISTART+10),IERR)
- ELSE
- IERR = 0
- ENDIF
-C
- ELSE
- REWIND LUNIT
- ENDIF
-#endif
-#if defined(CERNLIB_APOLLO)
-C
-C SEE WETHER THE UNIT HAS BEEN OPEN AT ALL,
-C OTHERWISE DO NOTHING
-C
- IF(LIST(ISTART+25).NE.0) THEN
- STREAM_$ID=INT2(LIST(ISTART+25))
-C
-C SEE WHETHER THIS IS A TAPE UNIT
-C
- CALL STREAM_$INQUIRE (
- 1 STREAM_$IRM_OTYPE,
- 2 STREAM_$USE_STRID,
- 3 STREAM_$ID,
- 4 ERROR_$MASK,
- 5 STATUS_$RETURNED)
- IF (STATUS_$RETURNED .NE. STATUS_$OK)
- 1 CALL ERROR_$PRINT(STATUS_$RETURNED)
- IF(ATT_$REC_4(14).NE.16#314) THEN
-*
-* THIS IS A DISK FILE, JUST REWIND
-*
- CALL STREAM_$SEEK(
- 1 STREAM_$ID,
- 2 STREAM_$REC,
- 3 STREAM_$ABSOLUTE,
- 4 1,
- 5 STATUS_$RETURNED)
- IF(STATUS_$RETURNED.NE.STATUS_$OK) THEN
- SUBS_$RETURNED=ERROR_$SUBSYS(STATUS_$RETURNED)
- IF(LSHFT(ERROR_$SUBSYS(STATUS_$RETURNED),8)
- + .NE.STREAM_$SUBS) WRITE(NOUTUT,1000)
-1000 FORMAT(' +++ EPIO/DOMAIN: Not a stream I/O error ???')
- CALL ERROR_$PRINT(STATUS_$RETURNED)
- END IF
- ELSE
-*
-* THIS IS A MAG TAPE, AND WE WANT TO CLOSE THE STREAM
-*
- CALL STREAM_$CLOSE(STREAM_$ID,STATUS_$RETURNED)
- LIST(ISTART+25)=0
- IF(STATUS_$RETURNED.NE.STATUS_$OK) THEN
- SUBS_$RETURNED=ERROR_$SUBSYS(STATUS_$RETURNED)
- IF(LSHFT(ERROR_$SUBSYS(STATUS_$RETURNED),8)
- + .NE.STREAM_$SUBS) WRITE(NOUTUT,1000)
- CALL ERROR_$PRINT(STATUS_$RETURNED)
- END IF
- END IF
- END IF
-#endif
-#if defined(CERNLIB_UNIVAC)
- LUNFD=LIST(ISTART+24)
- IOAD=LIST(ISTART+25)
- IF(IOAD.GE.0) LIST(ISTART+25)=0
- IF(IOAD.LT.0) CALL TIOREW(LUNFD,ISTAT)
-#endif
-C--- RESET STATUS WORDS AS NECESSARY
- LIST(ISTART+11)=0
- LIST(ISTART+12)=0
-C
-C THE CHANNEL NUMBER AND RAB ADDRESS FOR THE VAX MUST BE REMEMBERED
-C THEREFORE WE DONT ZERO ALL THE WAY TO NWUNIT
-C THE SAME HOLDS FOR UNIVAC, AND ALSO FOR THE APOLLO STREAM_$ID
- CALL UZERO(LIST,ISTART+14,ISTART+23)
-77777 RETURN
- END
diff --git a/src/packlib/epio/code/epseta.F b/src/packlib/epio/code/epseta.F
deleted file mode 100644
index 31bea7f..0000000
--- a/src/packlib/epio/code/epseta.F
+++ /dev/null
@@ -1,48 +0,0 @@
-*
-* $Id: epseta.F,v 1.1.1.1 1996/03/08 15:21:44 mclareni Exp $
-*
-* $Log: epseta.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:44 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
- SUBROUTINE EPSETA(LUNIT,NW,IWS,IERR)
-C.
-C. INPUT:
-C.
-C. LUNIT LOGICAL UNIT.
-C.
-C. NW NUMBER OF STATUS WORDS TO BE CHANGED, ALWAYS STARTING
-C. AT WORD NO. 1.
-C.
-C. IW NEW STATUS WORDS 1...NW.
-C.
-C. OUTPUT:
-C.
-C. IERR ERROR FLAG. SEE SEPARATE LIST.
-C.
-#include "epio/epiocom.inc"
- DIMENSION IWS(2)
- IERR=0
- IF((NW.LE.0.OR.NW.GT.LIST(7)).AND.NW.NE.26) GOTO 9901
-C--- CHECK WHETHER SAME USER UNIT AS LAST TIME
- IF(LASTUT.EQ.LUNIT) GOTO 1551
-C--- NEW UNIT - GET REF
- CALL EPUNIT(LUNIT,IERR)
- IF(IERR.EQ.0) GOTO 1552
- GOTO 77777
- 1551 IERR=0
- IF(LREF.NE.0) GOTO 1552
- IERR=13
- CALL EPERRH(LUNIT,IERR)
- GOTO 77777
- 1552 CONTINUE
- CALL UCOPY(IWS,LIST(ISTART+1),NW)
-77777 RETURN
- 9901 CONTINUE
-C--- STATUS WORD REQUEST OUT OF RANGE
- IERR=16
- CALL EPERRH(LUNIT,IERR)
- GOTO 77777
- END
diff --git a/src/packlib/epio/code/epsetc.F b/src/packlib/epio/code/epsetc.F
deleted file mode 100644
index 05daf0c..0000000
--- a/src/packlib/epio/code/epsetc.F
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: epsetc.F,v 1.1.1.1 1996/03/08 15:21:44 mclareni Exp $
-*
-* $Log: epsetc.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:44 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
- SUBROUTINE EPSETC(NWCONT,IWCONT)
-C.
-C. INPUT:
-C.
-C. NWCONT NO. OF OVERALL CONTROL WORDS TO SET (LIMITED TO NCONT)
-C.
-C. IWCONT NEW OVERALL CONTROL WORDS.
-C.
-C. REMARK: HANDLE WITH CARE.
-C.
-#include "epio/epiocom.inc"
- DIMENSION IWCONT(2)
- N=MAX0(0,MIN0(NCONT,NWCONT))
- CALL UCOPY(IWCONT,LIST,N)
- RETURN
- END
diff --git a/src/packlib/epio/code/epsetw.F b/src/packlib/epio/code/epsetw.F
deleted file mode 100644
index a03fbd6..0000000
--- a/src/packlib/epio/code/epsetw.F
+++ /dev/null
@@ -1,45 +0,0 @@
-*
-* $Id: epsetw.F,v 1.1.1.1 1996/03/08 15:21:44 mclareni Exp $
-*
-* $Log: epsetw.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:44 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
- SUBROUTINE EPSETW(LUNIT,NUMBER,IW,IERR)
-C.
-C. INPUT:
-C.
-C. LUNIT LOGICAL UNIT.
-C.
-C. NUMBER NO. OF STATUS WORD TO BE CHANGED (SEE LIST ABOVE).
-C.
-C. IW NEW VALUE OF STATUS WORD.
-C.
-C. OUTPUT:
-C.
-C. IERR ERROR FLAG. SEE SEPARATE LIST.
-C.
-#include "epio/epiocom.inc"
- IF(NUMBER.LE.0.OR.NUMBER.GT.LIST(7).AND.NUMBER.LT.25) GOTO 9901
-C--- CHECK WHETHER SAME USER UNIT AS LAST TIME
- IF(LASTUT.EQ.LUNIT) GOTO 1551
-C--- NEW UNIT - GET REF
- CALL EPUNIT(LUNIT,IERR)
- IF(IERR.EQ.0) GOTO 1552
- GOTO 77777
- 1551 IERR=0
- IF(LREF.NE.0) GOTO 1552
- IERR=13
- CALL EPERRH(LUNIT,IERR)
- GOTO 77777
- 1552 CONTINUE
- LIST(ISTART+NUMBER)=IW
-77777 RETURN
- 9901 CONTINUE
-C--- STATUS WORD REQUEST OUT OF RANGE
- IERR=16
- CALL EPERRH(LUNIT,IERR)
- GOTO 77777
- END
diff --git a/src/packlib/epio/code/epstat.F b/src/packlib/epio/code/epstat.F
deleted file mode 100644
index 97c6863..0000000
--- a/src/packlib/epio/code/epstat.F
+++ /dev/null
@@ -1,64 +0,0 @@
-*
-* $Id: epstat.F,v 1.2 1996/09/20 14:05:27 cernlib Exp $
-*
-* $Log: epstat.F,v $
-* Revision 1.2 1996/09/20 14:05:27 cernlib
-* clean up selection of format 2004
-*
-* Revision 1.1.1.1 1996/03/08 15:21:44 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
- SUBROUTINE EPSTAT
-C. PRINTS ALL ACTUAL CONTROL WORDS.
-#include "epio/epiocom.inc"
- WRITE(NOUTUT,2001) NMUNIT,NWUNIT,NCONT
- WRITE(NOUTUT,2002) (LIST(I),I=1,NCONT)
- N=LIST(1)
- IF(N.LE.0) GOTO 77777
- N=MIN0(NMUNIT,N)
- DO 1 I=1,N
- WRITE(NOUTUT,2003) I
- K=NCONT+NWUNIT*(I-1)
- WRITE(NOUTUT,2004) (LIST(K+J),J=1,NWUNIT)
- 1 CONTINUE
-77777 RETURN
-#if !defined(CERNLIB_CDC)
-2001 FORMAT(//,' ++++++++ EP FORMAT STATUS ROUTINE ++++++++',//,
- 1 ' MAX. NO. OF UNITS =',I8,/,
- 2 ' NO. OF CONTROL WORDS/UNIT =',I8,/,
- 3 ' NO. OF OVERALL CONTROL WORDS =',I8)
-2002 FORMAT(/ ,' OVERALL CONTROL WORDS ARE',//,
- 1 ' NO. OF ACTIVE UNITS =',I8,/,
- 2 ' MAX. NO. OF ERROR PRINTS =',I8,/,
- 3 ' ACTUAL NO. OF ERROR PRINTS =',I8,/,
- 4 ' BITS / MACHINE WORD =',I8,/,
- 5 ' NO. OF 16 BIT WORDS TO PAD TO=',I8,/,
- 6 ' STANDARD P.H. LENGTH =',I8,/,
- 7 ' NO. OF ACCESSIBLE CONTR.W. =',I8,/,
- 8 ' LOGICAL OUTPUT UNIT =',I8)
-2003 FORMAT(/ ,' CONTROL WORDS OF INTERNAL UNIT',I8,/)
-#endif
-#if defined(CERNLIB_CDC)
-2001 FORMAT(//," ++++++++ EP FORMAT STATUS ROUTINE ++++++++",//,
- 1 " MAX. NO. OF UNITS =",I8,/,
- 2 " NO. OF CONTROL WORDS/UNIT =",I8,/,
- 3 " NO. OF OVERALL CONTROL WORDS =",I8)
-2002 FORMAT(/ ," OVERALL CONTROL WORDS ARE",//,
- 1 " NO. OF ACTIVE UNITS =",I8,/,
- 2 " MAX. NO. OF ERROR PRINTS =",I8,/,
- 3 " ACTUAL NO. OF ERROR PRINTS =",I8,/,
- 4 " BITS / MACHINE WORD =",I8,/,
- 5 " NO. OF 16 BIT WORDS TO PAD TO=",I8,/,
- 6 " STANDARD P.H. LENGTH =",I8,/,
- 7 " NO. OF ACCESSIBLE CONTR.W. =",I8,/,
- 8 " LOGICAL OUTPUT UNIT =",I8)
-2003 FORMAT(/ ," CONTROL WORDS OF INTERNAL UNIT",I8,/)
-#endif
-#if defined(CERNLIB_UNIVAC)
-2004 FORMAT(1X,10I8,/,1X,10I8,/,1X,3I8,O16,I8)
-#else
-2004 FORMAT(1X,10I8)
-#endif
- END
diff --git a/src/packlib/epio/code/epunit.F b/src/packlib/epio/code/epunit.F
deleted file mode 100644
index 2fb726c..0000000
--- a/src/packlib/epio/code/epunit.F
+++ /dev/null
@@ -1,124 +0,0 @@
-*
-* $Id: epunit.F,v 1.1.1.1 1996/03/08 15:21:44 mclareni Exp $
-*
-* $Log: epunit.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:44 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
- SUBROUTINE EPUNIT(LUNIT,IERR)
-C. RETURNS THE INTERNAL UNIT NUMBER, INITIALIZES NEW UNITS
-C. INPUT
-C. LUNIT LOGICAL UNIT NUMBER
-C. OUTPUT
-C. LREF INTERNAL UNIT NUMBER (1,2,3...)
-C. IERR ERROR CONDITION
-C.-- OUTPUT IN COMMON BLOCK :
-C LREF INTERNAL UNIT NUMBER
-C ISTART START OF UNIT DESCRIPTOR IN LIST
-#include "epio/epiocom.inc"
-#if defined(CERNLIB_UNIVAC)
- CHARACTER*3 CYC
- CHARACTER*6 NFUNIT,REELNO
- CHARACTER*12 QUAL,FILE
- CHARACTER*30 FTEMP
- INTEGER PKT(0:12)
- DATA PKT(1)/' 'F/
-#endif
-#if defined(CERNLIB_ND100B16)
- DATA INFINI/ 9999 /
-#endif
-#if !defined(CERNLIB_ND100B16)
- DATA INFINI/ 999999 /
-#endif
- IERR=0
- IF(LUNIT.NE.LASTUT) CALL EPUREF(LUNIT)
- IF(LREF.GT.0) GOTO 77777
- IF(LIST(1).EQ.NMUNIT) GOTO 9901
-C--- OPEN NEW UNIT
- LIST(1)=LIST(1)+1
- LREF=LIST(1)
- K=NCONT+NWUNIT*(LREF-1)
- CALL UZERO(LIST,K+1,K+NWUNIT)
- LIST(K+1)=1800
- LIST(K+2)=INFINI
- LIST(K+3)=16
- LIST(K+4)=10101
- LIST(K+8)=1
- LIST(K+10)=LUNIT
- LIST(K+26)=INFINI
- LIST(K+27)=1
-#if defined(CERNLIB_UNIX)
- LIST(K+33)=2
-#endif
-#if defined(CERNLIB_UNIVAC)
-C--- CONVERT FILE NAME TO CHARACTERS
- IF(LUNIT.LT.10) ENCODE(6,10,NFUNIT) LUNIT
- IF(LUNIT.GE.10) ENCODE(6,11,NFUNIT) LUNIT
-C--- CONVERT ASCII FILE NAME TO FIELDATA
- N=2
- CALL FASCFD(N,NFUNIT,LIST(K+24))
-C--- FIND DEVICE TYPE (TAPE/DISK), FILENAME & REELNO IF TAPE
- PKT(0)=LIST(K+24)
- CALL FITEM(PKT)
- IO=BITS(PKT(6),1,6)
- IF(IO.LE.0) THEN
-C--- UNIT NOT ASSIGNED. TRY TO ASSIGN A TEMPORARY DISKFILE.
- IERR=11
- CALL EPERRH(LUNIT,IERR)
- IO=1
- IF(LUNIT.GE.10) IO=2
- IERR=FACSF('@ASG,T '//NFUNIT(1:IO)//'.,F4///800 . ')
- WRITE(6,12) IERR,NFUNIT
- IF(IERR.LT.0) THEN
- IERR=IABS(IERR)
- GOTO 77777
- ENDIF
- IO=16
- IERR=0
- ELSE
- N=2
- CALL FFDASC(N,PKT(2),FILE)
- NFL=INDEX(FILE,' ')-1
- IF(NFL.LE.0) NFL=12
- IF(IO.LT.16) THEN
-C--- PRINT OPENING MESSAGE FOR TAPE
- N=1
- CALL FFDASC(N,PKT(11),REELNO)
- FTEMP=FILE(1:NFL)//'. REELNO: '//REELNO
- WRITE(6,13) LUNIT,FTEMP
- ELSE
-C--- PRINT OPENING MESSAGE FOR DISK-FILE
- N=2
- CALL FFDASC(N,PKT(4),QUAL)
- NQL=INDEX(QUAL,' ')-1
- IF(NQL.LE.0) NQL=12
- ICYCL=BITS(PKT(6),25,12)
- ENCODE(3,14,CYC) ICYCL
- NCL=1
- IF(ICYCL.GE.10) NCL=2
- IF(ICYCL.GE.100) NCL=3
- FTEMP=QUAL(1:NQL)//'*'//FILE(1:NFL)//'('//CYC(4-NCL:3)//')'
- WRITE(6,15) LUNIT,FTEMP
- ENDIF
- ENDIF
-C--- SET ADDRESS = 0 FOR DISK, = -1 FOR TAPE
- LIST(K+25)=0
- IF(IO.LT.16) LIST(K+25)=-1
- 10 FORMAT(I1,5X)
- 11 FORMAT(I2,4X)
- 12 FORMAT('0 STATUS',O14,' WHEN ASSIGNING TEMPORARY FILE ',A6)
- 13 FORMAT('0LOGICAL UNIT',I3,' OPENED BY EP PACKAGE IS TAPE ',A30)
- 14 FORMAT(I3)
- 15 FORMAT('0LOGICAL UNIT',I3,' OPENED BY EP PACKAGE IS FILE ',A30)
-#endif
- ISTART=K
-77777 RETURN
- 9901 CONTINUE
-C--- MAX. NO. OF UNITS REACHED
- LREF=0
- IERR=13
- CALL EPERRH(LUNIT,IERR)
- GOTO 77777
- END
diff --git a/src/packlib/epio/code/epupdh.F b/src/packlib/epio/code/epupdh.F
deleted file mode 100644
index ebc8575..0000000
--- a/src/packlib/epio/code/epupdh.F
+++ /dev/null
@@ -1,64 +0,0 @@
-*
-* $Id: epupdh.F,v 1.1.1.1 1996/03/08 15:21:44 mclareni Exp $
-*
-* $Log: epupdh.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:44 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
- SUBROUTINE EPUPDH(LUNIT,NH,IH,IBUF,IERR)
-C.
-C. UPDATES THE (OPTIONAL) USER PORTION OF THE PHYSICAL
-C. BLOCK HEADER.
-C. THE NECESSARY SPACE FOR THIS OPTIONAL PORTION MUST HAVE
-C. BEEN RESERVED BY THE USER THROUGH A FOREGOING CALL
-C. TO EPADDH (TYPICALLY ONCE AT THE START OF THE JOB).
-C. WHEREAS A CALL TO EPADDH CAUSES THE EXISTING (IF
-C. ANY) BLOCK TO BE WRITTEN OUT, EPUPDH DOES NOT HAVE THIS
-C. EFFECT.
-C.
-C. INPUT:
-C
-C. LUNIT LOGICAL UNIT
-C.
-C. NH NO. OF USER WORDS IN HEADER TO BE UPDATED.
-C. NH IS CUT AT THE ACTUAL NO. OF EXTRA USER WORDS
-C. AVAILABLE IN THE PHYSICAL BLOCK HEADER.
-C.
-C. IH ARRAY CONTAINING THE NEW VALUES.
-C. WORDS 1..NH OF IH WILL REPLACE THE CURRENT WORDS
-C. 1..NH OF THE USER PORTION IN THE HEADER.
-C. Important: if in 32 p.h. mode, user words must be converted
-C. to IBM format (integer or floating) by the user beforehand
-C.
-C. IBUF UNIT BUFFER
-C.
-C. IERR ERROR CONDITION - SEE SEPERATE LIST
-C.
-#include "epio/epiocom.inc"
- DIMENSION IH(2),IBUF(2)
-C--- CHECK WHETHER SAME USER UNIT AS LAST TIME
- IF(LASTUT.EQ.LUNIT) GOTO 1551
-C--- NEW UNIT - GET REF
- CALL EPUNIT(LUNIT,IERR)
- IF(IERR.EQ.0) GOTO 1552
- GOTO 77777
- 1551 IERR=0
- IF(LREF.NE.0) GOTO 1552
- IERR=13
- CALL EPERRH(LUNIT,IERR)
- GOTO 77777
- 1552 CONTINUE
-C--- IGNORE IF NO OUTPUT UNIT, OR UNIT NOT YET USED
- IF(LIST(ISTART+16).EQ.2.OR.LIST(ISTART+14).EQ.0) GOTO 77777
- IF(LIST(ISTART+29).EQ.0) THEN
-*--- 16 bit p.h.
- K=MIN(LIST(ISTART+7)-LIST(6),NH)
- CALL BUN16W(IH,1,IBUF,LIST(6)+1,K)
- ELSE
- K=MIN(LIST(ISTART+7)/2-LIST(6),NH)
- CALL BUN32W(IH,1,IBUF,LIST(6)+1,K)
- ENDIF
-77777 RETURN
- END
diff --git a/src/packlib/epio/code/epuref.F b/src/packlib/epio/code/epuref.F
deleted file mode 100644
index 55c503a..0000000
--- a/src/packlib/epio/code/epuref.F
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: epuref.F,v 1.1.1.1 1996/03/08 15:21:44 mclareni Exp $
-*
-* $Log: epuref.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:44 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
- SUBROUTINE EPUREF(LUNIT)
-C. RETURNS INTERNAL REFERENCE NUMBER FOR LOGICAL UNIT.
-C.
-C. INPUT
-C. LUNIT LOGICAL UNIT NUMBER
-C.-- OUTPUT IN COMMON BLOCK :
-C LREF INTERNAL UNIT NUMBER
-C ISTART START OF UNIT DESCRIPTOR IN LIST
-#include "epio/epiocom.inc"
- LASTUT=LUNIT
- NC=0
- N=LIST(1)
- IF(N.EQ.0) GOTO 77777
- K=NCONT+10
- DO 1 NC=1,N
- IF(LUNIT.EQ.LIST(K)) GOTO 77777
- K=K+NWUNIT
- 1 CONTINUE
- NC=0
-77777 LREF=NC
- ISTART=NCONT+(NC-1)*NWUNIT
- RETURN
- END
diff --git a/src/packlib/epio/epio/Imakefile b/src/packlib/epio/epio/Imakefile
deleted file mode 100644
index 7f8df0e..0000000
--- a/src/packlib/epio/epio/Imakefile
+++ /dev/null
@@ -1,4 +0,0 @@
-INCLUDES= epapocom.inc epiocom.inc epvaxcom.inc wordsize.inc \ @@\
- pilot.h
-
-InstallIncludes($(INCLUDES),$(CERN_INCLUDEDIR),epio)
diff --git a/src/packlib/epio/epio/epapocom.inc b/src/packlib/epio/epio/epapocom.inc
deleted file mode 100644
index 0da5da7..0000000
--- a/src/packlib/epio/epio/epapocom.inc
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: epapocom.inc,v 1.1.1.1 1996/03/08 15:21:47 mclareni Exp $
-*
-* $Log: epapocom.inc,v $
-* Revision 1.1.1.1 1996/03/08 15:21:47 mclareni
-* Epio
-*
-*
-#ifndef CERNLIB_EPIO_EPAPOCOM_INC
-#define CERNLIB_EPIO_EPAPOCOM_INC
-*
-*
-* epapocom.inc
-*
-#if (!defined(CERNLIB_VAX))&&(!defined(CERNLIB_STF77VX))
- COMMON/EPAPON/EPVXUN(10)
- CHARACTER*256 EPVXUN
-#endif
-
-#endif
diff --git a/src/packlib/epio/epio/epiocom.inc b/src/packlib/epio/epio/epiocom.inc
deleted file mode 100644
index 8e5084b..0000000
--- a/src/packlib/epio/epio/epiocom.inc
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: epiocom.inc,v 1.1.1.1 1996/03/08 15:21:47 mclareni Exp $
-*
-* $Log: epiocom.inc,v $
-* Revision 1.1.1.1 1996/03/08 15:21:47 mclareni
-* Epio
-*
-*
-#ifndef CERNLIB_EPIO_EPIOCOM_INC
-#define CERNLIB_EPIO_EPIOCOM_INC
-*
-*
-* epiocom.inc
-*
- COMMON/EPCOMM/NMUNIT,NWUNIT,NCONT,ISTART,LASTUT,LREF,LIST(350)
- EQUIVALENCE (NOUTUT,LIST(8))
-
-#endif
diff --git a/src/packlib/epio/epio/epvaxcom.inc b/src/packlib/epio/epio/epvaxcom.inc
deleted file mode 100644
index c1656a0..0000000
--- a/src/packlib/epio/epio/epvaxcom.inc
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: epvaxcom.inc,v 1.1.1.1 1996/03/08 15:21:47 mclareni Exp $
-*
-* $Log: epvaxcom.inc,v $
-* Revision 1.1.1.1 1996/03/08 15:21:47 mclareni
-* Epio
-*
-*
-#ifndef CERNLIB_EPIO_EPVAXCOM_INC
-#define CERNLIB_EPIO_EPVAXCOM_INC
-*
-*
-* epvaxcom.inc
-*
-#if defined(CERNLIB_VAX)||defined(CERNLIB_STF77VX)
- COMMON/EPVAXN/EPVXUN(10)
- CHARACTER*255 EPVXUN
-#endif
-
-#endif
diff --git a/src/packlib/epio/epio/pilot.h b/src/packlib/epio/epio/pilot.h
deleted file mode 100644
index 02c2677..0000000
--- a/src/packlib/epio/epio/pilot.h
+++ /dev/null
@@ -1,42 +0,0 @@
-*
-* $Id: pilot.h,v 1.4 1998/09/25 09:25:42 mclareni Exp $
-*
-* $Log: pilot.h,v $
-* Revision 1.4 1998/09/25 09:25:42 mclareni
-* Modifications for the Mklinux port flagged by CERNLIB_PPC
-*
-* Revision 1.3 1997/09/02 12:45:55 mclareni
-* WINNT needs byte swapping
-*
-* Revision 1.2 1996/09/20 14:07:07 cernlib
-* for LINUX select STF77VX
-*
-* Revision 1.1.1.1 1996/03/08 15:21:47 mclareni
-* Epio
-*
-*
-#if defined(CERNLIB_VAXVMS)||defined(CERNLIB_VAXULX)
-#ifndef CERNLIB_VAX
-#define CERNLIB_VAX
-#endif
-#endif
-#if defined(CERNLIB_IBM)||defined(CERNLIB_VAX)||defined(CERNLIB_NORD)
-#ifndef CERNLIB_DOUBLE
-#define CERNLIB_DOUBLE
-#endif
-#endif
-#if (defined(CERNLIB_UNIX))&&(!defined(CERNLIB_SINGLE))
-#ifndef CERNLIB_DOUBLE
-#define CERNLIB_DOUBLE
-#endif
-#endif
-#if (defined(CERNLIB_UNIX))&&(!defined(CERNLIB_DECS))&&(!(defined(CERNLIB_LINUX) && !defined(CERNLIB_PPC)))&&(!defined(CERNLIB_WINNT))
-#ifndef CERNLIB_STF77
-#define CERNLIB_STF77
-#endif
-#endif
-#if defined(CERNLIB_DECS) || (defined(CERNLIB_LINUX) && !defined(CERNLIB_PPC)) || defined(CERNLIB_WINNT)
-#ifndef CERNLIB_STF77VX
-#define CERNLIB_STF77VX
-#endif
-#endif
diff --git a/src/packlib/epio/epio/wordsize.inc b/src/packlib/epio/epio/wordsize.inc
deleted file mode 100644
index 538b23f..0000000
--- a/src/packlib/epio/epio/wordsize.inc
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: wordsize.inc,v 1.1.1.1 1996/03/08 15:21:47 mclareni Exp $
-*
-* $Log: wordsize.inc,v $
-* Revision 1.1.1.1 1996/03/08 15:21:47 mclareni
-* Epio
-*
-*
-#ifndef CERNLIB_EPIO_WORDSIZE_INC
-#define CERNLIB_EPIO_WORDSIZE_INC
-*
-*
-* wordsize.inc
-*
-C number of bits/word
- INTEGER NBITPW, NCHAPW, NBITPC, N16PW
-#if defined(CERNLIB_CDC)
- PARAMETER (NBITPW=60, NCHAPW=10, NBITPC=6)
-#elif defined(CERNLIB_CRAY)
- PARAMETER (NBITPW=64, NCHAPW= 8, NBITPC=8, N16PW=4)
-#elif (defined(CERNLIB_CONVEX))&&(defined(CERNLIB_SINGLE))
- PARAMETER (NBITPW=64, NCHAPW= 8, NBITPC=8, N16PW=4)
-#elif 1
- PARAMETER (NBITPW=32, NCHAPW=4, NBITPC=8, N16PW=2)
-#endif
-
-#endif
diff --git a/src/packlib/epio/examples/epcopy/epcopy.F b/src/packlib/epio/examples/epcopy/epcopy.F
deleted file mode 100644
index eb46b1a..0000000
--- a/src/packlib/epio/examples/epcopy/epcopy.F
+++ /dev/null
@@ -1,87 +0,0 @@
-*
-* $Id: epcopy.F,v 1.1.1.1 1996/03/08 15:22:00 mclareni Exp $
-*
-* $Log: epcopy.F,v $
-* Revision 1.1.1.1 1996/03/08 15:22:00 mclareni
-* Epio
-*
-*
- IMPLICIT INTEGER(A-Z)
-* GENERAL EPCOPY JOB
-* LIN - INPUT LOGICAL UNIT
-* LOU - OUTPUT LOGICAL UNIT
-* MAXREC - MAXIMUM NUMBER OF LOGICAL RECORDS (EVENTS) TO COPY
-* E.G TO GET A SAMPLE OR AVOID PROBLEM AREAS
-* INBLK - MAXIMUM INPUT BLOCK SIZE 32768 BYTES
-* OUTBLK - MAXIMUM OUTPUT BLOCK SIZE E.G. 3600 BYTES
-* RECSIZ - MAXIMUM RECORD (EVENT) SIZE 32768 16 BIT WORDS
-*
-*
- DIMENSION IRECI(32760),IBUFI( 8190),IBUFO( 8190),IH(200)
- PARAMETER (MAXREC=99999)
- PARAMETER (LIN=11, LOU=12, LPRINT=6)
- PARAMETER (OUTBLK=1800, INBLK=16380, RECSIZ=16380, MAXERR=10)
- DATA NERR/0/, NREC/0/, OREC/0/
- CALL EPINIT
- CALL EPSETW(LIN,1, INBLK, IERR)
- CALL EPSETW(LIN, 2, RECSIZ, IERR)
- CALL EPSETW(LIN, 27, -1, IERR)
- CALL EPSETW(LOU, 1,OUTBLK, IERR)
- CALL EPSETW(LOU, 5, -1, IERR)
- CALL EPSETW(LOU, 6, -1, IERR)
-C-- READ 1ST BLOCK TO GET ENVIRONMENT
- 10 CONTINUE
- CALL EPREAD(LIN,30,NW,IRECI,IBUFI,IERR)
- IF(IERR.EQ.3)GOTO 500
- IF(IERR.EQ.0)THEN
- CALL EPGETW(LIN, 4, NW ,IERR)
- CALL EPSETW(LOU, 4, NW ,IERR)
- CALL EPGETW(LIN, 3, NW ,IERR)
- CALL EPSETW(LOU, 3, NW ,IERR)
- IF(NW.EQ.16) THEN
- MODEIN=12
- MODOUT=2
- ELSE IF(NW.EQ.32)THEN
- MODEIN=13
- MODOUT=3
- ENDIF
- ELSE
- NERR=NERR+1
- IF(NERR.GT.MAXERR)STOP 8
- GOTO 10
- ENDIF
- CALL EPSTAT
-50 CONTINUE
- CALL EPREAD(LIN,20,NH,IH,IBUFI,IERR)
- IF(IERR.EQ.3)GOTO 500
- IF(IERR.NE.0)GOTO 400
- IF(IERR.EQ.0)THEN
-C-- GOOD HEADER
- NREC=NREC+1
- IF(NH.LT.4) THEN
- NH=4
- IH(4)=NREC
- ENDIF
- ENDIF
- CALL EPREAD(LIN,MODEIN,NW,IRECI,IBUFI,IERR)
- IF(IERR.EQ.3)GOTO 500
- IF(IERR.NE.0)GOTO 400
- IF(IERR.EQ.0)THEN
- CALL EPOUTL(LOU,MODOUT,NH,IH,NW,IRECI,IBUFO,IERR)
- IF(IERR.NE.0)GOTO 500
- OREC=OREC+1
- IF(OREC.EQ.MAXREC)GOTO 500
- GOTO 50
- ENDIF
- 400 CONTINUE
- CALL EPSTAT
- IF(IERR.NE.1)NERR=NERR+1
- IF(NERR.GT.MAXERR)GOTO 500
- GOTO 50
-500 CALL EPCLOS(LOU,IBUFO,IERR)
- CALL EPSTAT
- CALL EPEND(LOU,IBUFO,IERR)
- PRINT 901,NREC ,OREC, NERR
-901 FORMAT('0+++ COPY ENDED',I10,' RECORDS IN',I10,
- 1 ' RECORDS OUT',I10,' ERRORS')
- END
diff --git a/src/packlib/epio/examples/epdump/Imakefile b/src/packlib/epio/examples/epdump/Imakefile
deleted file mode 100644
index caae91f..0000000
--- a/src/packlib/epio/examples/epdump/Imakefile
+++ /dev/null
@@ -1,4 +0,0 @@
-SRCS_F= \ @@\
- epdump.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/epio/examples/epdump/epdump.F b/src/packlib/epio/examples/epdump/epdump.F
deleted file mode 100644
index 0602c69..0000000
--- a/src/packlib/epio/examples/epdump/epdump.F
+++ /dev/null
@@ -1,148 +0,0 @@
-*
-* $Id: epdump.F,v 1.1.1.1 1996/03/08 15:22:01 mclareni Exp $
-*
-* $Log: epdump.F,v $
-* Revision 1.1.1.1 1996/03/08 15:22:01 mclareni
-* Epio
-*
-*
-C PROGRAM EPTEST(TAPE10,TAPE5,OUTPUT)
-* EPIO dump program
-* Inputs are LUN Logical input unit for epio file
-* Words/record and no. of records to print but the whole file is
-* always read
-* No. of blocks to skip before starting to dump (normally 0)
-*
- LOGICAL LHEAD, INTRAC
- DIMENSION IBUF(8190),IREC(16000)
-#include "epio/epiocom.inc"
- DATA LBUF/16380/, LREC/32000/
- DATA MINDAT/999999/, MINHEA/999999/, MAXDAT/0/, MAXHEA/0/
- DATA NREC/0/, LHEAD/.FALSE./, MAXERR/5 /, NERR/0/,
- 1 LUN/1/, MAXNW/100/, MAXLOG/10/, NSKIPB/0/
-C READ DATA CARDS
- IF(INTRAC(D))THEN
- PRINT *,' TYPE LUN, WORDS/REC, NO. OF RECORDS, BLOCKS TO SKIP,
- 1 EG 1 10 5 0'
- READ (5,*,END=5)LUN,MAXNW,MAXLOG,NSKIPB
- ENDIF
- 5 PRINT 901
- 901 FORMAT(' +++ EP DUMP REQUESTED')
- IF(MAXNW.GT.LREC )THEN
- PRINT 902
- 902 FORMAT(' ',22X,'OF ALL WORDS')
- MAXNW=LREC
- ELSE
- PRINT 903,MAXNW
- 903 FORMAT(' ',22X,'OF THE FIRST',I6,' WORDS')
- END IF
- PRINT 904,MAXLOG
- 904 FORMAT(23X,'OF THE FIRST',I6,' LOGICAL RECORDS')
- IF(NSKIPB.GT.0)PRINT 905,NSKIPB
- 905 FORMAT(23X,'AFTER SKIPPING',I6,' BLOCKS')
-C-- INITIALISE
- CALL EPIOT(6)
- CALL EPINIT
- CALL EPSETW(LUN,1,LBUF,IERR)
- CALL EPSETW(LUN,2,LREC,IERR)
- CALL EPSETW(LUN,27,1,IERR)
-C CALL EPSETW(LUN,25,1,IERR)
- CALL EPSTAT
-C-- SKIP BLOCKS
- DO 10 I=1,NSKIPB
- CALL EPREAD(LUN,30,NW,IREC,IBUF,IERR)
- PRINT*, ' BLOCK NO ', I, ' SKIPPED'
- IF(IERR.EQ.0)GOTO 10
- IF(IERR.EQ.3)GOTO 500
- NERR=NERR+1
- CALL EPSTAT
- IF(NERR.GT.MAXERR)THEN
- PRINT 910
- GOTO 500
- ENDIF
- 10 CONTINUE
- IF(NSKIPB.GT.0)THEN
- PRINT 906,NSKIPB,NW
- 906 FORMAT(/,' +++ PHYSICAL HEADER OF BLOCK NUMBER',I6,' LENGTH=',I6,
- 1 ' 16-BIT WORDS')
- WRITE(*,'(6Z10)')(IBUF(I),I=1,24)
- CALL PRTDMP(NW,IREC)
-CDEB CALL EPSTAT
- ENDIF
- MAXBLS=LIST(ISTART+14)
- MINBLS=LIST(ISTART+14)
- 100 CONTINUE
- IF(LIST(ISTART+17).EQ.1)THEN
- MODE=2
- LHEAD=.FALSE.
- ELSE
- LHEAD=.NOT.LHEAD
- IF(LHEAD)MODE=20
- IF(.NOT.LHEAD)MODE=12
- IF(NREC.GT.MAXLOG)MODE=2
- ENDIF
- CALL EPREAD(LUN,MODE,NW,IREC,IBUF,IERR)
- IF(IERR.NE.0) THEN
- IF(IERR.EQ.3)GOTO 500
- NERR=NERR+1
- CALL EPSTAT
- WRITE(*,'(6Z10)')(IBUF(I),I=1,24)
- IF(NERR.GT.MAXERR)THEN
- PRINT 910
- GOTO 500
- ENDIF
- GOTO 100
- ENDIF
- IF(MODE.NE.12)NREC=NREC+1
- MINHEA=MIN(MINHEA,LIST(ISTART+21))
- MAXHEA=MAX(MAXHEA,LIST(ISTART+21))
- MINDAT=MIN(MINDAT,LIST(ISTART+20),NW)
- MAXDAT=MAX(MAXDAT,LIST(ISTART+20))
- IF(LIST(ISTART+14).GT.0)MINBLS=MIN(MINBLS,LIST(ISTART+14))
- MAXBLS=MAX(MAXBLS,LIST(ISTART+14))
-CDEB PRINT*,MAXBLS,MINBLS,LIST(ISTART+14)
- IF(NREC.LE.MAXLOG)THEN
- IF(LHEAD)PRINT 907,NREC,NW
- 907 FORMAT(/,' +++ HEADER OF LOGICAL RECORD NO.',I6,' LENGTH=',I6,/)
- IF(.NOT.LHEAD)PRINT 908,NREC,NW
- 908 FORMAT(/,' +++ DATA OF LOGICAL RECORD NO. ',I6,' LENGTH=',I6,/)
- NW=MIN(NW,MAXNW)
- IF(NW.GT.0 .AND. NREC.LE.MAXLOG)CALL PRTDMP(NW,IREC)
- ENDIF
- GOTO 100
- 500 CONTINUE
- NBLK=LIST(ISTART+11)-NSKIPB +1
- CALL EPSTAT
- PRINT 909,NREC,NBLK,MINHEA,MAXHEA,MINDAT,MAXDAT,MINBLS,MAXBLS
- 909 FORMAT(/,' +++ NO. OF LOGICAL RECORDS =',I7,
- 1 /,' +++ NO. OF BLOCKS =',I7,
- 1 /,' +++ MINIMUM LOGICAL HEADER LENGTH =',I7,
- 1 /,' +++ MAXIMUM LOGICAL HEADER LENGTH =',I7,
- 1 /,' +++ MINIMUM LOGICAL DATA LENGTH =',I7,
- 1 /,' +++ MAXIMUM LOGICAL DATA LENGTH =',I7,
- 1 /,' +++ MINIMUM BLOCK LENGTH (SAMPLE) =',I7,
- 1 /,' +++ MAXIMUM BLOCK LENGTH (SAMPLE) =',I7)
- 910 FORMAT(/,' +++ MAXIMUM NUMBER OF ERROR MESSAGES EXCEEDED')
- STOP
- END
- SUBROUTINE PRTDMP(NW,IREC)
- DIMENSION IREC(1)
- DATA NWPERL/10/
- 901 FORMAT(1X,I5,'- ',5I7,2X,5I7)
- 902 FORMAT(/,28X,'DUMP IN 16-BIT INTEGERS',/)
- IF(NW.LE.0)RETURN
- PRINT 902
- J=1
- IW=0
- NLINES=NW/NWPERL
- DO 10 II=1,NLINES
- K=J+NWPERL-1
- PRINT 901,IW,(IREC(I),I=J,K)
- J=J+NWPERL
- IW=IW+NWPERL
- 10 CONTINUE
- NLEFT=NW-NLINES*NWPERL
- K=J+NLEFT-1
- IF(NLEFT.GT.0)PRINT 901,IW,(IREC(I),I=J,K)
- RETURN
- END
diff --git a/src/packlib/epio/history/inform.dat b/src/packlib/epio/history/inform.dat
deleted file mode 100644
index 1a8e29d..0000000
--- a/src/packlib/epio/history/inform.dat
+++ /dev/null
@@ -1,134 +0,0 @@
-*
-* $Id: inform.dat,v 1.1.1.1 1996/03/08 15:21:47 mclareni Exp $
-*
-* $Log: inform.dat,v $
-* Revision 1.1.1.1 1996/03/08 15:21:47 mclareni
-* Epio
-*
-*
-C--
-C-- CERN PROGRAM LIBRARY EPIO (I101) EP STANDARD FORMAT INPUT/OUTPUT PACKAGE
-C-- FORTRAN/ASSEMBLER PACKAGE FOR IBM,CDC,NORD,VAX,UNIVAC,APOLLO,
-C-- CRAY AND CONVEX COMPUTERS.
-C--
-C--
-C-- AUTHORS H.GROTE,I.MCLAREN DD CERN GENEVA
-C--
-C-- PAM CONTENTS
-C-- ------------
-C--
-C-- P=DEPIO , DOCUMENTATION + VERSION UPDATES ON EPIO SOFTWARE
-C--
-C-- P=TEST, CERN TEST JOBS OF EPIO PACKAGE.
-C-- T=DATA. +USE,P=TEST,CDC. WILL EXTRACT CERN CDC 7600 JOBS.
-C-- +USE,P=TEST,CDC,NOSBE. WILL EXTRACT CERN CDC NOSBE JOB.
-C-- +USE,P=TEST,IBM. WILL EXTRACT CERN IBM JOBS.
-C-- +USE,P=TEST,VAX. WILL EXTRACT CERN VAX JOBS.
-C-- THE FLAGS VAXLONG AND VAXMAG ALLOW
-C-- FURTHER TESTS.
-C-- +USE,P=TEST,UNIVAC. WILL EXTRACT UNIVAC JOB.
-C-- +USE,P=TEST,APOLLO. WILL EXTRACT APOLLO SCRIPT.
-C-- AFTER EXTRACTION CHANGE '&' TO '+' IN THE PATCHY INPUT.
-C--
-C-- TEST JOBS
-C-- ---------
-C-- P=PTEST1,PTEST2,PTEST3. FORTRAN SOURCE USED BY THE TEST JOBS.
-C--
-C-- P=T1FAST CONTAINS PATCHY MODS TO PTEST1 PATCH TO GENERATE
-C-- AN EXTRA TEST JOB FOR EPFHDR AND EPFRD
-C--
-C-- FLAGS HLESS, ULENG MODIFY THE EPIO PATCH TO GENERATE
-C-- SOME EXTRA TEST JOBS WITH PTEST2 ONLY.
-C--
-C-- FLAG PH32BIT RUNS THE BASIC TESTS WITH 32 BIT PHYSICAL HEADERS
-C-- FLAG HSPAN RUNS THE BASIC TESTS WITH SPANNED LOGICAL HEADERS
-C-- FLAGS MAKEXT11 AND READXT11 CAN BE USED TO CREATE AND THEN
-C-- READ BACK A FILE AFTER A NETWORK TRANSFER, MAINLY TO
-C-- TEST THE BYTE SWAPPING EFFECTIVENESS. IN PTEST3 ONLY.
-C--
-C-- P=PTEST4. FORTRAN SOURCE FOR THE RANDOM ACCESS FEATURE ON
-C-- IBM, VAX AND CRAY ONLY.
-C-- WARNING: THIS FEATURE IS HIGHLY SYSTEM DEPENDENT
-C-- AND MAY NOT BE PORTABLE TO ALL SYSTEMS.
-C--
-C-- P=EPIO. SOURCE OF BASIC EPIO ROUTINES.
-C--
-C-- P=IBMASSL. SOURCE OF IBM ASSEMBLER ROUTINES, NEEDS T=DIVERT.
-C--
-C-- P=UTIL. SOURCE OF THE UTILITY ROUTINES USED BY EPIO.
-C--
-C-- P=TAPECOPY, UNIVAC PROGRAM FOR DISK TO TAPE EP FILE COPIES
-C-- IF=UNIVAC.
-C--
-C-- P=UNIASM, UNIVAC ASSEMBLER ROUTINES
-C-- IF=UNIVAC.
-C--
-C-- VAXMACR VAX ASSEMBLER ROUTINES
-C--
-C-- VAXMTFORM VAX ASSEMBLER AND FORTRAN ROUTINES TO GIVE CONTROL
-C-- OF THE HARDWARE BYTE SWAPPING MECHANISM.
-C-- D=TAPEHELP IS PART OF A HELP FILE USED AT CERN
-C-- THE SYSTEM MANAGER INSTALLING THEM SHOULD BE CONCIOUS
-C-- OF THE IMPLICATIONS OF USING THIS FACILITY
-C--
-C--
-C-- In addition to the general machine flags (see P=FEPIO), this pam
-C-- contains the following flags:
-C-- ND50,ND500,ND100B16,ND100B32
-C-- VAXS,VAXMAG,VAXLONG
-C-- APOMAG
-C-- FOR DIFFERENT MACHINE VERSIONS AND FLAG F4 FOR (CDC) FORTRAN 77.
-C-- THERE ARE FOUR DIFFERENT NORD VERSIONS IN THIS PAM, SELECTED BY:
-C-- ND100B16 NORD10/100 16 BIT VERSION
-C-- ND100B32 NORD10/100 32 BIT VERSION
-C-- ND50 NORD50 VERSION
-C-- ND500 NORD500 VERSION (WAITING FOR MAGTPZ ROUTINE)
-C--
-C-- EXTERNAL REFERENCES
-C-- -------------------
-C--
-C-- V300 UZERO(A,I,J) . ZEROS FULL WORDS A(I) TO A(J)
-C--
-C-- M219 CVT360(A(J1),A(J2),MODE) (CDC VERSION ONLY). CONVERT A(J1) TILL
-C-- A(J2) FROM IBM TO CDC NUMBER FORMAT, MODE=0 FOR REAL, 1 FOR INTEGER
-C--
-C-- M430 FTO360(A,N,MODE) (CDC VERSION ONLY). CONVERT N WORDS IN A FROM CDC
-C-- TO IBM NUMBER FORMAT, MODE=0 FOR REAL, 1 FOR INTEGER
-C--
-C-- V301 UCOPY(A,X,N) . COPY N FULL WORDS FROM ARRAY A INTO ARRAY X
-C--
-C-- Z300 IOPACK (IBM VERSION ONLY). THE CERN IBM DEPENDENT INPUT/OUTPUT
-C-- PACKAGE FOR IBM OS.
-C--
-C-- Installation on Vax/VMS
-C--
-C-- The following are the two installation cradles to extract the code
-C-- on the Vax via the MAKEPACK utility (see INSTALL.PAM):
-C--
-C +EXE.
-C +OPT,MAPASM.
-C +ASM,22.
-C +ASM,31,T=A.epio12.for
-C +USE,*EPIO,VAX.
-C +DIV,P=UTIL,D=BUN16WIB.
-C +DIV,P=UTIL,D=BUN8WIB.
-C +PAM,11,T=A.CERN_ROOT:[pam]epio
-C +QUIT.
-C
-C +EXE.
-C +OPT,MAPASM.
-C +ASM,21. trnlog,cleard routines
-C +ASM,22. vaxibm : IBM-VAX Floating point conversion routin
-C .ASM,31,T=A.epio22.for tapeform: to allow changing the status of tape uni
-C +ASM,32,T=A.epio22a.mar mtformat: routine to set the byte swap switch
-C +USE,*EPIO,VAXS.
-C +DIV,P=SVAXS,D=MTFORMAT.
-C . --------------------------------------------------------------------------
-C . the tapeform program may then also have to be made to allow changing
-C . the status of tape units. the symbol tapeformat ought to be defined by
-C . the system manager and the help tapeformat message should be
-C . installed (located in P=DEPIO,D=TAPEHELP)
-C . --------------------------------------------------------------------------
-C .USE,P=SVAXS,D=TAPEFORM,T=EXE,DIV. Activate to get the tapeform program
-C +PAM,11,T=A.CERN_ROOT:[pam]epio
-C +QUIT.
diff --git a/src/packlib/epio/history/pilot.tests b/src/packlib/epio/history/pilot.tests
deleted file mode 100644
index 10c0ae3..0000000
--- a/src/packlib/epio/history/pilot.tests
+++ /dev/null
@@ -1,47 +0,0 @@
-#if 0
-* This pilot patch was created from epio.car patch _epio
-#endif
-#if 0
-* Pilot patch
-#endif
-#if !defined(CERNLIB_TEST)
-#ifndef CERNLIB_SEPIO
-#define CERNLIB_SEPIO
-#endif
-#endif
-#if (defined(CERNLIB_TEST))&&(defined(CERNLIB_1S)||defined(CERNLIB_1L))
-#ifndef CERNLIB_PTEST1
-#define CERNLIB_PTEST1
-#endif
-#endif
-#if (defined(CERNLIB_TEST))&&(defined(CERNLIB_2S)||defined(CERNLIB_2L))
-#ifndef CERNLIB_PTEST2
-#define CERNLIB_PTEST2
-#endif
-#endif
-#if (defined(CERNLIB_TEST))&&(defined(CERNLIB_3S)||defined(CERNLIB_3L))
-#ifndef CERNLIB_PTEST3
-#define CERNLIB_PTEST3
-#endif
-#endif
-#if (defined(CERNLIB_TEST))&&(defined(CERNLIB_4S))
-#ifndef CERNLIB_PTEST4
-#define CERNLIB_PTEST4
-#endif
-#endif
-#if (defined(CERNLIB_TEST))&&(defined(CERNLIB_1L)||defined(CERNLIB_2L)||defined(CERNLIB_3L))
-#ifndef CERNLIB_PH32BIT
-#define CERNLIB_PH32BIT
-#endif
-#endif
-#ifndef CERNLIB_FEPIO
-#define CERNLIB_FEPIO
-#endif
-#if (defined(CERNLIB_TEST))&&(defined(CERNLIB_HLESS)||defined(CERNLIB_HSPAN)||defined(CERNLIB_ULENG))
-#ifndef CERNLIB_EPIO_EPBOUT
-#define CERNLIB_EPIO_EPBOUT
-#endif
-#ifndef CERNLIB_EPIO_EPOUTL
-#define CERNLIB_EPIO_EPOUTL
-#endif
-#endif
diff --git a/src/packlib/epio/history/tapehelp.dat b/src/packlib/epio/history/tapehelp.dat
deleted file mode 100644
index 4474cf5..0000000
--- a/src/packlib/epio/history/tapehelp.dat
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: tapehelp.dat,v 1.1.1.1 1996/03/08 15:21:47 mclareni Exp $
-*
-* $Log: tapehelp.dat,v $
-* Revision 1.1.1.1 1996/03/08 15:21:47 mclareni
-* Epio
-*
-*
-#if (defined(CERNLIB_TAPEFORM))&&(defined(CERNLIB_VAX))
-1 TAPEFORMAT
-WARNING TO MAGTAPE USERS: In our data acquisition programs, we make use
-of the byte-swap option in the magtape driver. See IBM VAX News 67 for
-details. People who use magtape for other purposes should make sure that
-the unit is in NOSWAP mode.
- Users who wish to put
-the magtape into byte-swap mode must remember to MOUNT the tape before
-issuing the TAPEFORMAT SWAP command
-and they should do a TAPEFORMAT NOSWAP command
-before DISMounting the tape.
-#endif
diff --git a/src/packlib/epio/history/v100159.dat b/src/packlib/epio/history/v100159.dat
deleted file mode 100644
index cdef0f5..0000000
--- a/src/packlib/epio/history/v100159.dat
+++ /dev/null
@@ -1,239 +0,0 @@
-*
-* $Id: v100159.dat,v 1.1.1.1 1996/03/08 15:21:47 mclareni Exp $
-*
-* $Log: v100159.dat,v $
-* Revision 1.1.1.1 1996/03/08 15:21:47 mclareni
-* Epio
-*
-*
-C. VERSION 1.00 : FIRST SEMI-OFFICIAL, RUN UNDER DL.HGR.EPIOPAC
-C. VERSION 1.10 : CORRECTED UNIVAC MODS, VAX NOT QUITE COMPLETE,
-C. NEW ROUTINES CFRASC, CTOASC ON IBM AND CDC,
-C. NEW RT.S BLO8W AND BUN8W ON IBM, CDC, VAX, UNIVAC.
-C. DATE : 31.8.1981
-C. IMPLEMENTED UNDER DL.PUB.EPIO.LIB, RESP.
-C. EPIOLIB, ID=DE100
-C. VERSION 1.20 : ADOPTION BY CERN PROGRAM LIBRARY AS EPIO (I101)
-C.
-C. VERSION 1.30 : COMPLETION OF VAX SECTION
-C.
-C. VERSION 1.31 : ADD STATUS WORD 26 FOR USER HEADER BUFFER LENGTH
-C.
-C. VERSION 1.32 : CORRECT BUG IN EPREAD FOR SPANNED HEADERS
-C.
-C. VERSION 1.33 : UNIVAC MODS IN EPUNIT, DUMMY ROUTINES CFRASC, CTOASC
-C.
-C. VERSION 1.34 : ADDITION OF NORD SECTION
-C. USE UZERO EVERYWHERE
-C. ADDITION OF UNIVAC INSTALLATION AND TEST PROCEDURE
-C. REMOVE REF.S TO OUTOCT FROM BLOBYT, BUNBYT (CDC)
-C.
-C. VERSION 1.36 : MINOR VAX CORRECTIONS
-C. SPEED-UP OF UNIT REFERENCE INSIDE EPIO
-C. MINOR (COMPATIBLE) CHANGE IN EPBLIN
-C. ADDITION OF NEW ROUTINES EPFHDR, EPFRD
-C. FAST CDC VERSIONS (COMPASS) OF BLO16W, BLO32W
-C. ADDITION OF NEW TEST PATCH T1FAST
-C. END-OF-RUN CHECK IN EPFHDR
-C. IMPROVED ERROR MESSAGE PRINT-OUT
-C.
-C. VERSION 1.37 : FLAG F4 ADDED AROUND SOME CDC-ONLY CODE TO MAKE
-C. A FORTRAN 77 (FTN5) COMPATIBLE VERSION FOR CDC.
-C.
-C. VERSION 1.38 : BUG FIXED IN VAX VERSION (MISTYPE)
-C. VAX DIAGNOSTICS FOR DISK SPACE OVERFLOW ADDED
-C.
-C. VERSION 1.39 : BUGS FIXED IN VAX VERSION:
-C. INSERT CORRECT COMMON BLOCK LENGTH IN EPIOVAX
-C. ( RE- )CORRECT ROUTINES CFRIBM AND CTOIBM
-C. CORRECT A PATCHY CONTROL CARD IN VAX INSTAL.
-C.
-C. VERSION 1.40 : IMPROVEMENTS TO UNIVAC VERSION:
-C. REPLACE "LOC" BY "LOCF" IN EPBLIN, EPBOUT
-C. REPLACE DECKS EPFRTAPE, ERBLOBYN,TAPEIO
-C. ADD NEW DECK FITEM
-C.
-C. VERSION 1.41 : INTRODUCE CFRIBM AND CTOIBM MODE 6 FOR UNSIGNED
-C. 32 BIT INTEGERS ( DUMMY EXCEPT ON VAX )
-C. INSERT TWO MISSING NORD FLAGS
-C.
-C. VERSION 1.42 : FIX TWO VAX BUGS ( CONCERNING READ/WRITE TAPES)
-C. IN ROUTINES EPBLIN AND EPBOUT
-C.
-C. VERSION 1.43 : INTRODUCE THE NORD100 16 BIT VERSION
-C. ADD ROUTINES FOR THE NORD50 VERSION
-C. REPLACE THE UNIVAC INSTALLATION DECK
-C. INTRODUCE SPECIFIC CDC FORMATS (" INSTEAD OF ')
-C.
-C. VERSION 1.44 : FIX A BUG IN THE VAX ROUTINE MT_FORMAT
-C.
-C. VERSION 1.45 : ADD ERROR 20 FOR WRITING NEG. LENGTH RECORDS
-C. CORRECT BUG IN IBM ASCII CONVERSION ROUTINE
-C. PROVIDE NEW ROUTINES FOR ASCII/EBCDIC STRING CONVERSION.
-C. NEW ROUTINE -EPIOT- TO PRINT PAM FILE TITLE.
-C. ROUTINES MODIFIED: EPOUTL, CFRASC AND CTOASC (IBM,CDC).
-C. ROUTINES ADDED: SFRASC, STOASC (IBM,CDC,VAX),EPIOT.
-C.
-C. VERSION 1.46 : CORRECT ERROR CHECK IN TEST1 (PTEST1,PTEST3)
-C. CORRECT BUG IN TEST JOB MODIFICATION PATCHES (V. 1.45)
-C. INTRODUCE OUTPUT UNIT TO BE SET BY USER
-C. INTRODUCE IBM ASSEMBLER VERSION OF W16MOV
-C. DECKS AFFECTED: EPBOUT,EPEOF,EPERRH,EPINIT,EPRWND,
-C. EPSTAT,W16MOV (IBM ONLY), CERNIBM (IBM INSTAL EXAMPLE)
-C.
-C. VERSION 1.47 : CORRECT BUGS IN VAX AND CDC.VERSIONS OF EPBLIN
-C. CHANGE NAMES: BTMOVE TO BTMVEP, SHLONG TO SHLGEP
-C. DECKS AFFECTED : EPBLIN
-C. BTMOVE + SHLONG (CDC,UNIVAC ONLY)
-C.
-C. VERSION 1.48 : VAX ONLY MODS : INTRODUCE ROUTINE EPDEFU ALLOWING
-C. TO OPEN A UNIT WITH A USER SPECIFIED NAME VIA CALL.
-C. CORRECT POSSIBLE ARGUMENT CHANGE IN EPREAD
-C. ROUTINES AFFECTED : EPINIT, EPOPEN, EPDEFU, EPREAD
-C. NEW COMMON BLOCK EPVAXN
-C.
-C. VERSION 1.49 : IBM ONLY MODS : MAKE CHANGES NECESSARY FOR CORRECT
-C. COMPILATION UNDER RELEASE 3 OF THE IBM VS-FORTRAN
-C. COMPILER.
-C. ROUTINES AFFECTED : BLO8WIB, BUN8WIB, CFRASCIB, CTOASCIB
-C. SFRASCIB, STOASCIB
-C.
-C. VERSION 1.50 : CORRECT BUG IN EPREAD AND EPFRD READING RECORDS WITH
-C. AN ODD NUMBER OF 16-BIT WORDS IN 32-BIT MODE (3)
-C. VAX ONLY MODS -
-C. EPOPEN_VAX ROUTINE REPLACED
-C. W16MOV MACRO VERSION ADDED
-C. BTSWAP ROUTINE ADDED (MACRO)
-C. EPBLIN TO TREATE HEADERLESS BLOCKS ON DISK
-C. BY USING THE PREVIOUS BLOCK LENGTH
-C.
-C. VERSION 1.51 : ADDITION OF BTSWAP (BYTE SWAPPING ROUTINE) FOR CDC,
-C. IBM, AND NORD 100/500.
-C. ADDITION OF TWO UNIT CONTROL WORDS, NO. 27 AND 28, TO
-C. ALLOW AUTOMATIC BYTE SWAPPING BY SETTING WORD 27 TO 1
-C. (DEFAULT 0). IF THEN THE EP IDENTIFIER WORDS 7 AND 8
-C. ARE WRONG ON READING, THE PHYSICAL RECORD WILL BE BYTE
-C. SWAPPED ON CDC, IBM, NORD, AND VAX.
-C. TO SET UNIT CONTROL WORD 27, CALL EPSETW.
-C.
-C. VERSION 1.52 : CORRECT MESSAGES FOR ERRORS 4 AND 5 IN EPBLIN
-C. VAX ONLY MODS -
-C. IN EPOPEN_VAX, ASSIGN CORRECT UNIT "FOR00N" IF N IS LT 10.
-C. IN EPOPEN_VAX, EPBLIN - CORRECT BUG TO READ MAG TAPES
-C. CORRECTLY. BUG INTRODUCED AT VERSION 1.50
-C. VARIABLE LENGTH BLOCKS (INCLUDING HEADERLESS) NOW
-C. READABLE FROM DISK.
-C. MACRO ROUTINE EPOPENV_VAX ADDED FOR VARIABLE DISK RECS.
-C.
-C. VERSION 1.53 : APOLLO VERSION ADDED.
-C PATCHY FLAG APOLLO AND RELATED INSTALLATION DECKS
-C INTRODUCED. (FEDERICO CARMINATI, CERN/DD)
-C CRAY VERSION ADDED.
-C PATCHY FLAG CRAY AND RELATED INSTALLATION DECKS
-C INTRODUCED. CHANGES TO EPBLIN, EPINIT
-C VAX INSTALLATION DECK REWRITTEN USING AKMULT
-C EPPAC REMOVED EVERYWHERE AND SUBSTITUTED WITH EPIO
-C EPREAD GIVES NEW ERROR (IERR=21) WHEN TRYING TO
-C READ OLD FORMAT DATA WITH MODE.GT.3
-C EPGETW, EPGETA NO LONGER RETURN ERROR 14. INSTEAD
-C A NEW UNIT IS CREATED AND THE DEFAULTS RETURNED.
-C
-C. VERSION 1.54 : CRAY PATCHY FLAGS CORRECTED AND BTSWAP INTRODUCED.
-C
-C DIMENSION IARR(NW) CHANGED TO IARR(1) IN CFRASC,
-C CTOASC, CFRIBM, CTOIBM MAINLY FOR VS FORTRAN.
-C
-C CHANGES MADE IN THE VAX MACRO ROUTINES TO MAKE THE
-C RESULTING CODE POSITION INDEPENDENT
-C (FEDERICO CARMINATI, CERN/DD).
-C VAX VERSIONS OF BLO8W AND BUN8W CORRECTED.
-C
-C EPBLIN CHANGED TO ALLOW USERS TO FORCE TREATMENT
-C OF THEIR DATA AS NEW 16-BIT FORMAT BY SETTING
-C STATUS WORD 27 TO 2. SOME TYPES OF INVALID DATA
-C MAY THEN RESULT IN ERROR 7 MEANING THAT THE
-C PHYSICAL HEADER WORDS ARE INCORRECT.
-C THE VAX VERSION CORRECTED TO BYTE SWAP CORRECTLY
-C ON DISK FILES
-C
-C. VERSION 1.55 : CFRASC DUMMY ROUTINE ADDED FOR APOLLO, NORD.
-C CTOASC DUMMY ROUTINE ADDED FOR APOLLO, NORD.
-C
-C CFRIBM CDC AND UNIVAC VERSIONS PROTECTED FOR NW=0
-C CTOIBM CDC AND UNIVAC VERSIONS PROTECTED FOR NW=0
-C
-C UTILITY PATCHES EPCOPY AND EPDUMP ADDED.
-C
-C CHANGES IN EPOPEN_VAX TO BE ABLE TO RETRIEVE
-C THE LENGTH OF THE RECORD OF A DISK FILE
-C
-C. VERSION 1.56 : 32 bit words for physical header introduced as
-C second possibilty.
-C
-C Default for simultaneously open units increased
-C to 10.
-C
-C ************* Default of flag 27 set to 1 (byte swapping). Users of
-C ************* the old EP format should set this flag to 0.
-C
-C New control word 29:
-C If = 0 (default), ph. header written in 16 bit words
-C If = 1 , ph. header written in 32 bit words.
-C Reading is automatic.
-C
-C The test jobs have been modified accordingly. A new flag
-C PH32BIT has been introduced. This flag can be switched
-C on with ANY test job, and forces the usage of 32 bit
-C physical headers.
-C
-C VAX EPIO_MACRO changed to allow status word 1 to be
-C set > 62535.
-C EPOPENS_VAX allows Decnet access for fixed block
-C files, and common EPVAXCOM allows filenames up to
-C 255 (from 63).
-C
-C CRAY flag in EPFHDR corrected.
-C CRAY versions of BLO16W, BUN16W, BLO32W, BUN32W
-C corrected and faster.
-C
-C Apollo versions of CFRIBM and CTOIBM corrected.
-C
-C. VERSION 1.57 : The physical header tests have been reordered
-C to recognize definite 16-bit headers first in
-C subroutine EPBLIN. This also required a correction
-C to PTEST3 with 32-bit headers.
-C
-C Attempting to write a logical record greater than
-C 65535 words with a 16-bit logical record header
-C gives error 24 in subroutine EPOUTL and no data
-C is written.
-C
-C EPREAD gives error 23 if the logical record
-C unit is neither 16 nor 32 and is positioned
-C to read the next physical record.
-C
-C The patch INSTAL has been removed. Please see
-C the INSTALL PAM.
-C
-C. VERSION 1.58 : The CRAY versions of EPBLIN, EPBOUT now use the
-C CRAY reading and writing routines.
-C Bug fix in the CRAY version of BUN32W.
-C APPEND option allowed in VAX open for
-C output files via status word 30 set to 1
-C TEST PATCH removed. See the INSTALL PAM file.
-C
-C. VERSION 1.59 : The CRAY version of EPBLIN has been
-C corrected for a misplaced modification.
-C The CRAY and CDC versions of EPBOUT have been
-C corrected for a misplaced modification.
-C
-C The test for trying to write too large a logical
-C record with a 16-bit header has been improved in
-C EPOUTL.
-C
-C The tests for invalid data in physical records
-C with 32-bit headers have been improved in EPBLIN.
-C
-C Keyword SHARED added in the VAX OPEN for reading
-C disk files
-C
diff --git a/src/packlib/epio/history/v160.dat b/src/packlib/epio/history/v160.dat
deleted file mode 100644
index 259c6c4..0000000
--- a/src/packlib/epio/history/v160.dat
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: v160.dat,v 1.1.1.1 1996/03/08 15:21:47 mclareni Exp $
-*
-* $Log: v160.dat,v $
-* Revision 1.1.1.1 1996/03/08 15:21:47 mclareni
-* Epio
-*
-*
-* Version 1.60
-C Correction in EPOPEN_VAX to treat correctly network files
-C Correction for BUN16W and BUN32W, Cray version for CFT77 3.0
-C
diff --git a/src/packlib/epio/history/v161.dat b/src/packlib/epio/history/v161.dat
deleted file mode 100644
index f179424..0000000
--- a/src/packlib/epio/history/v161.dat
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: v161.dat,v 1.1.1.1 1996/03/08 15:21:47 mclareni Exp $
-*
-* $Log: v161.dat,v $
-* Revision 1.1.1.1 1996/03/08 15:21:47 mclareni
-* Epio
-*
-*
-* Version 1.61
-C IBM flag now implies IBMVM; Flag IBMMVS added
-C For IBM, ULP in EPBLIN is now CHARACTER*4
-C Add AMODE/RMODE qualifiers with flag QMIBMXA to W16MOV
-C EPBLIN and EPBOUT changed to allow for new RC=8 from IOPACK routines
-C Minor changes to test jobs for IBM
-C
-C Introductory changes for the CONVEX version.
-C
-C Changes in EPOPEN_VAX to treat correctly files
-C written by plain FORTRAN write.
-C
diff --git a/src/packlib/epio/history/v162.dat b/src/packlib/epio/history/v162.dat
deleted file mode 100644
index d36bbad..0000000
--- a/src/packlib/epio/history/v162.dat
+++ /dev/null
@@ -1,15 +0,0 @@
-*
-* $Id: v162.dat,v 1.1.1.1 1996/03/08 15:21:47 mclareni Exp $
-*
-* $Log: v162.dat,v $
-* Revision 1.1.1.1 1996/03/08 15:21:47 mclareni
-* Epio
-*
-*
-* Version 1.62
-C Bug corrected in EPOPEN_VAX
-C Variable record length disk files treated correctly
-C This bug was affecting Interlink-transferred files.
-C Bug corrected in EPMTEOF, back space over last
-C written EOF did not always occur
-C
diff --git a/src/packlib/epio/history/v163.dat b/src/packlib/epio/history/v163.dat
deleted file mode 100644
index b740328..0000000
--- a/src/packlib/epio/history/v163.dat
+++ /dev/null
@@ -1,14 +0,0 @@
-*
-* $Id: v163.dat,v 1.1.1.1 1996/03/08 15:21:47 mclareni Exp $
-*
-* $Log: v163.dat,v $
-* Revision 1.1.1.1 1996/03/08 15:21:47 mclareni
-* Epio
-*
-*
-* Version 1.63
-C Random access to standard input files added (only IBM/VM and Vax/VMS)
-C The examples in the new PATCH PTEST4 must be
-C studied as the user must store the indices in his own array.
-C NWUNIT increased to 32.
-C Routines affected - EPBLIN, EPINIT, EPREAD
diff --git a/src/packlib/epio/history/v164.dat b/src/packlib/epio/history/v164.dat
deleted file mode 100644
index 35a11b4..0000000
--- a/src/packlib/epio/history/v164.dat
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: v164.dat,v 1.1.1.1 1996/03/08 15:21:47 mclareni Exp $
-*
-* $Log: v164.dat,v $
-* Revision 1.1.1.1 1996/03/08 15:21:47 mclareni
-* Epio
-*
-*
-* Version 1.64
-C Random access to standard input files extended to Cray (courtesy of
-C M. Corden).
-C IMPORTANT: the binary file type on the Cray must be -s sbin
-C as in the example in the PATCH PTEST4.
-C Routines affected - EPBLIN, EPREAD
-C Introduction of pilot patch *EPIO
-C Vectorized version of BTSWAP for IBM-3090 VF
-C Turn F77 into -F4.
-C Put IBMASSL into ASMA.
-C
diff --git a/src/packlib/epio/history/v165.dat b/src/packlib/epio/history/v165.dat
deleted file mode 100644
index 3b571e4..0000000
--- a/src/packlib/epio/history/v165.dat
+++ /dev/null
@@ -1,53 +0,0 @@
-*
-* $Id: v165.dat,v 1.1.1.1 1996/03/08 15:21:47 mclareni Exp $
-*
-* $Log: v165.dat,v $
-* Revision 1.1.1.1 1996/03/08 15:21:47 mclareni
-* Epio
-*
-*
-* Version 1.65 900510 02.45
-C- Standard Fortran version with flag STF77 in patches EPIO,UTIL,PTEST1
-C This is a very preliminary version and will change.
-C
-C- To aid maintenance, the test patches HLESS, HSPAN, ULENG have been
-C removed and the code inserted inline in EPOUTL and EPBOUT with the
-C same flags.
-C
-C- To aid maintenance, the VAXS code has been grouped together under
-C the patch P=SVAXS. See installation cradles in P=TZBOOK.
-C
-C- Remove call to VMCMS in P=PTEST4,D=RATEST. OPEN is enough on IBM
-C
-C- DIMENSION IHEAD(*) in EPFHDR,EPOUTL IF=-F4.
-C
-C- New patches/flags:
-C SEPIO: Source patch
-C FEPIO: Flags patch
-C DEPIO: Documentation patch (originally in P=HISTORY + P=INFORM)
-C segmenting version updates in decks
-C SVAXS: Source patch for Vax ("Special code")
-C
-C- Reorganization of the pam structure
-C > Rename P=TAPECOPY to P=SUNIVAC, absorbing P=UNIASM.
-C > Rename P=CCVX to P=SCONVEX.
-C > Rename P=NORDASSL to P=SNORD .
-C > Rename P=CRAYASSL to P=SCRAY .
-C > Rename P=VAXMACR to P=SVAX .
-C > Rename P=UTIL ,D=BTSWAPIBV to P=UTIL ,D=BTSWAPIV.
-C > Rename P=UTIL ,D=BTSWAPIBN to P=UTIL ,D=BTSWAPIB.
-C > Rename P=UTIL ,D=BTSWAPCDC to P=UTIL ,D=BTSWAPCD.
-C > Move P=SCRAY ,D=BTSWAPCRA to P=UTIL ,D=BTSWAPCR.
-C > Move P=VAXMACR,D=BTSWAP to P=UTIL ,D=BTSWAPVX.
-C > Rename P=UTIL ,D=W16MOVIB to P=UTIL ,D=W16MOVAP.
-C > Move P=VAXMACR,D=W16MOV to P=UTIL ,D=W16MOVVX.
-C > Move P=VAXMACR,D=W16MOV to P=UTIL ,D=W16MOVVX.
-C > Move P=SNORD ,D=W16MOVN5 to P=UTIL ,D=W16MOVN5.
-C > Move P=IBMASSL to P=UTIL ,D=W16MOVIB,IF=IBM,IBMMVS.
-C > Move P=EPIO ,D=CLEARD to P=SVAXS,D=CLEARD.
-C > Move P=EPIO ,D=TRNLOG to P=SVAXS,D=TRNLOG.
-C > Move P=VAXMACR,D=VAXIBM to P=SVAXS,D=VAXIBM.
-C > Move P=VAXMTFOR,D=MTFORMAT to P=SVAXS,D=MTFORMAT.
-C > Move P=VAXMTFOR,D=TAPEFORM to P=SVAXS,D=TAPEFORM.
-C > Move P=VAXMTFOR,D=TAPEHELP to P=DEPIO,D=TAPEHELP.
-C
diff --git a/src/packlib/epio/history/v166.dat b/src/packlib/epio/history/v166.dat
deleted file mode 100644
index 9989bb4..0000000
--- a/src/packlib/epio/history/v166.dat
+++ /dev/null
@@ -1,38 +0,0 @@
-*
-* $Id: v166.dat,v 1.1.1.1 1996/03/08 15:21:47 mclareni Exp $
-*
-* $Log: v166.dat,v $
-* Revision 1.1.1.1 1996/03/08 15:21:47 mclareni
-* Epio
-*
-*
-* Version 1.66 910404 9.10
-C
-C- P=FEPIO : add HPUX, MIPS, IBMVM, VAXVMS, VAXULX flags
-C- everywhere : Make IBM=IBMVM or IBMMVS
-C- P=EPIO ,D=EPUNIT : set INFINI=999999 for all machines -ND100B16
-C- P=UTIL ,D=CFRIBMCR : new version for CRAY (by M.J.Corden)
-C- P=UTIL ,D=BLO32WCR : "
-C- P=UTIL ,D=BUN32WCR : "
-C
-C- Add STF77, STF77VX flags to EPDEFU. Tidy the associated common
-C blocks to make the pam cleaner.
-C- Add STF77, STF77VX flags to EPINIT for epdefu.
-C Add call UMLOG for monitoring to EPINIT.
-C- Add STF77, STF77VX flags to CFRASCUN, CTOASCUN.
-C- Add STF77, -STF77VX flags to SFRASCAP, STOASCAP.
-C- SFRASCVX, STOASCVX standardised and flags -STF77 and STF77VX added.
-C- STF77, STF77VX versions of BLO8W
-C- STF77, STF77VX versions of BUN8W
-C- Correct calls to ishftc in CONVEX CTOIBM, CFRIBM.
-C
-C- Tidy parameter statement in EPBLIN.
-C- Random access feature for Apollo in EPBLIN.
-C- Add HSPAN flag in EPOUTL to correct compiler warning.
-C
-C- PTEST1, PTEST2, PTEST3 modified to test STF77 and STF77VX
-C versions with the restrictions of fixed length blocks,
-C no change of block size and only for full padding.
-C T1FAST updated accordingly.
-C- *EPIO corrected.
-C
diff --git a/src/packlib/epio/history/v167.dat b/src/packlib/epio/history/v167.dat
deleted file mode 100644
index ea39ec8..0000000
--- a/src/packlib/epio/history/v167.dat
+++ /dev/null
@@ -1,14 +0,0 @@
-*
-* $Id: v167.dat,v 1.1.1.1 1996/03/08 15:21:47 mclareni Exp $
-*
-* $Log: v167.dat,v $
-* Revision 1.1.1.1 1996/03/08 15:21:47 mclareni
-* Epio
-*
-*
-* Version 1.67 920306 9.00
-C
-C- P=EPIO ,D=EPBLIN : make EBCDIC declaration of ULP only for the
-C Siemens compiler.
-C- P=FEPIO : trigger STF77VX for DEC in source+test
-C
diff --git a/src/packlib/epio/history/v168.dat b/src/packlib/epio/history/v168.dat
deleted file mode 100644
index c0d5a3b..0000000
--- a/src/packlib/epio/history/v168.dat
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: v168.dat,v 1.1.1.1 1996/03/08 15:21:47 mclareni Exp $
-*
-* $Log: v168.dat,v $
-* Revision 1.1.1.1 1996/03/08 15:21:47 mclareni
-* Epio
-*
-*
-* Version 1.68 920715 9.00
-C
-C- The machine flags have been removed from some routines to help
-C users who would like to implement the standard Fortran version.
-C Although they will compile they are not guaranteed to work
-C on the older systems (e.g. epdefu may not work on VM).
-C The common epvxun has been included everywhere for epdefu but
-C also may not be used in this version.
-C
-C- P=EPIO ,D=EPBLIN : In random access mode treat read errors as
-C end of file.
-C- P=EPIO ,D=EPDACR : Remove machine flags.
-C Status word 33 set to 1 but only used by
-C standard Fortran version.
-C- P=EPIO ,D=EPDEFU : Remove machine flags.
-C- P=EPIO ,D=EPINIT : Return if epinit has already been called.
-C Reset EPVXUN for EPDEFU
-C- P=UTIL ,D=SFRASC : Replace character*1 with logical*1.
-C- P=UTIL ,D=STOASC : Replace character*1 with logical*1.
-C
diff --git a/src/packlib/epio/history/v169.dat b/src/packlib/epio/history/v169.dat
deleted file mode 100644
index fdffba4..0000000
--- a/src/packlib/epio/history/v169.dat
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: v169.dat,v 1.1.1.1 1996/03/08 15:21:47 mclareni Exp $
-*
-* $Log: v169.dat,v $
-* Revision 1.1.1.1 1996/03/08 15:21:47 mclareni
-* Epio
-*
-*
-* Version 1.69 930524 9.00
-C- Introduce CFIO for the Unix versions controlled by status word 33,
-C which is set by the user as follows;
-C Value Type of I/O Default filename (lun=nn)
-C 0 Fortran sequential for0nn
-C 1 Fortran direct access epionn
-C 2 C using CFIO epionn
-C
-C Although it is the old default, Value 0 is not portable and seems
-C to give more problems.
-C Values 1 and 2 give identical formats on most systems and are
-C portable.
-C With this version Status Word 33 will be set to 2 by default, but
-C it is user settable.
-C
-C Routines modified;
-C P=EPIO ,D=EPBLIN
-C ,D=EPBOUT
-C ,D=EPEOF
-C ,D=EPOPESTF
-C ,D=EPRWND
-C ,D=EPUNIT
-C
diff --git a/src/packlib/epio/history/v170.dat b/src/packlib/epio/history/v170.dat
deleted file mode 100644
index c9f2e43..0000000
--- a/src/packlib/epio/history/v170.dat
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: v170.dat,v 1.1.1.1 1996/03/08 15:21:47 mclareni Exp $
-*
-* $Log: v170.dat,v $
-* Revision 1.1.1.1 1996/03/08 15:21:47 mclareni
-* Epio
-*
-*
-* Version 1.70 930624 9.00
-C- Use cfio for real random access using EPDACR
-C Routines modified;
-C P=EPIO ,EPBLIN to call cfseek and return IERR=25 if trouble.
-C ,EPDACR not to set status word 33.
-C
-C- Disable bad block test for UNIX in test 3
-C
diff --git a/src/packlib/epio/history/v171.dat b/src/packlib/epio/history/v171.dat
deleted file mode 100644
index 69d5ef8..0000000
--- a/src/packlib/epio/history/v171.dat
+++ /dev/null
@@ -1,14 +0,0 @@
-*
-* $Id: v171.dat,v 1.1.1.1 1996/03/08 15:21:46 mclareni Exp $
-*
-* $Log: v171.dat,v $
-* Revision 1.1.1.1 1996/03/08 15:21:46 mclareni
-* Epio
-*
-*
-* Version 1.71 930902 9.00
-C- Correct problem with EPDROP for Vax, Apollo and Unix when EPDEFU is
-C is not called by the user.
-C
-C- Add flag NEXT.
-C
diff --git a/src/packlib/epio/history/v172.dat b/src/packlib/epio/history/v172.dat
deleted file mode 100644
index 043eb59..0000000
--- a/src/packlib/epio/history/v172.dat
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: v172.dat,v 1.1.1.1 1996/03/08 15:21:46 mclareni Exp $
-*
-* $Log: v172.dat,v $
-* Revision 1.1.1.1 1996/03/08 15:21:46 mclareni
-* Epio
-*
-*
-* Version 1.72 931022 9.00
-C- A PAM cleanup for the VAX/VMS version
-C Move decks VAXIBM and MTFORMAT from patch SVAXS to UTIL.
-C Add deck card for EPIOVAX2, correct pilot patch
-C
-C Correct EPBOUT, Unix version, for writing odd length blocks.
-C Now they will be padded to an integral number of machine words.
-C But the correct blocksize will have to be given when reading back
-C these files. To avoid complications do not write blocks with an
-C odd number of 16-bit words.
-C
-C Detect EOF when reading with Fortran with status word 33 set to 1
-C in EPBLIN for Unix version.
-C
-C Replace calls to JSHFTC with ISHFTC for Ultrix and Alpha/OSF1 as it
-C now looks like ISHFTC is fixed. DECS routines BTSWAP, JSHFTC and
-C CFRIBM.
-C
-C Correct VMS/DEC version of STOASC
-C Modifications for Alpha/VMS in macro decks MTFORMAT and EPIOVAX2
-C
-C Major tidy for CONVEX.
-C
diff --git a/src/packlib/epio/history/v173.dat b/src/packlib/epio/history/v173.dat
deleted file mode 100644
index 162ef65..0000000
--- a/src/packlib/epio/history/v173.dat
+++ /dev/null
@@ -1,11 +0,0 @@
-*
-* $Id: v173.dat,v 1.1.1.1 1996/03/08 15:21:46 mclareni Exp $
-*
-* $Log: v173.dat,v $
-* Revision 1.1.1.1 1996/03/08 15:21:46 mclareni
-* Epio
-*
-*
-* Version 1.73 940421 9.00
-C- Correct VMS deck EPIOVAX to remove linker warning.
-C
diff --git a/src/packlib/epio/history/v174.dat b/src/packlib/epio/history/v174.dat
deleted file mode 100644
index 34d0e49..0000000
--- a/src/packlib/epio/history/v174.dat
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: v174.dat,v 1.1.1.1 1996/03/08 15:21:46 mclareni Exp $
-*
-* $Log: v174.dat,v $
-* Revision 1.1.1.1 1996/03/08 15:21:46 mclareni
-* Epio
-*
-*
-* Version 1.74 941020 10.00
-C- Correct VMS deck EPIOVAX. (Previous correction in 1.73 was only valid
-C for AXP).
-C- Add flags WINNT and LINUX for Windows/NT and Linux.
-C
-C- Add LOGICAL BTEST in decks CFRIBMSF, CFRIBMSV, CTOIBSTF, CTOIBSTV.
-C
-C- Return ierr=1 from EPOPEN when cfopen returns negative status.
-C Extend this functionality to the VMS version in EPOPEN_VAX.
-C Typically, this occurs when the input file does not exist, but
-C recovery from any errors on opening files on reading and writing
-C is now possible.
-C Warning, one more argument for EPOPEN and EPOPEN_VAX,
-C but they should not normally be user callable.
-C Related mods to EPBLIN, EPHEAD and EPTEST.
-C
-C The Apollo version also suffers from this but the error handling
-C is a bit special, so more work is involved. Wait for a request.
-C
diff --git a/src/packlib/epio/history/v175.dat b/src/packlib/epio/history/v175.dat
deleted file mode 100644
index da492d8..0000000
--- a/src/packlib/epio/history/v175.dat
+++ /dev/null
@@ -1,15 +0,0 @@
-*
-* $Id: v175.dat,v 1.1.1.1 1996/03/08 15:21:46 mclareni Exp $
-*
-* $Log: v175.dat,v $
-* Revision 1.1.1.1 1996/03/08 15:21:46 mclareni
-* Epio
-*
-*
-* Version 1.75 9412?? 10.00
-C- Remove unused flag AOSF64 in Patch *EPIO.
-C
-C- The Ultrix ISHFTC problem is still there, so use the faster Aleph
-C versions of CFRIBMSV, CTOIBSTV and BTSWPSTV for STF77VX.
-C The ishftc versions are kept in CFRIBMSH, CTOIBSHF, BTSWPSHF.
-C
diff --git a/src/packlib/epio/history/v176.dat b/src/packlib/epio/history/v176.dat
deleted file mode 100644
index e9359cb..0000000
--- a/src/packlib/epio/history/v176.dat
+++ /dev/null
@@ -1,3 +0,0 @@
-Version 1_76 11/04/96
-
-eprwnd F. Ranjard's protection for rewinding with a wrong file descriptor
diff --git a/src/packlib/epio/history/v176_1.dat b/src/packlib/epio/history/v176_1.dat
deleted file mode 100644
index 17b6257..0000000
--- a/src/packlib/epio/history/v176_1.dat
+++ /dev/null
@@ -1,3 +0,0 @@
-Version 1_76_01 20/09/96
-
-epstat Clean up selection of format statement 2004
diff --git a/src/packlib/epio/obsolete/apollo/blo16wap.F b/src/packlib/epio/obsolete/apollo/blo16wap.F
deleted file mode 100644
index b3767c1..0000000
--- a/src/packlib/epio/obsolete/apollo/blo16wap.F
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: blo16wap.F,v 1.1.1.1 1996/03/08 15:21:50 mclareni Exp $
-*
-* $Log: blo16wap.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:50 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_APOLLO)
- SUBROUTINE BLO16W(SOURCE,N1,TARGET,N2,N3)
-C.+++++++ APOLLO VERSION ++++++++++
-C. BLOWS (UNPACKS) 16 BIT WORDS INTO MACHINE WORDS(32 BIT).
-C.
-C. INPUT
-C. SOURCE ARRAY CONTAINING 16 BIT WORDS IN PACKED FORM
-C. N1 FIRST 16 BIT WORD IN SOURCE TO BLOW
-C. TARGET TARGET ARRAY FOR UNPACKED 16 BIT WORDS
-C. N2 TARGET(N2) WILL CONTAIN FIRST UNPACKED WORD
-C. N3 NO. OF 16 BIT WORDS TO UNPACK
- INTEGER*2 SOURCE(2),IW2(2)
- INTEGER TARGET(2)
- EQUIVALENCE (IW2(1),IW4)
- IF(N3.LE.0) GOTO 77777
- I1=N1-1
- I2=N2-1
- IW4=0
- DO 1 I=1,N3
- IW2(2)=SOURCE(I1+I)
- 1 TARGET(I2+I)=IW4
-77777 RETURN
- END
-#endif
diff --git a/src/packlib/epio/obsolete/apollo/cfribmap.F b/src/packlib/epio/obsolete/apollo/cfribmap.F
deleted file mode 100644
index 99fe7e9..0000000
--- a/src/packlib/epio/obsolete/apollo/cfribmap.F
+++ /dev/null
@@ -1,79 +0,0 @@
-*
-* $Id: cfribmap.F,v 1.1.1.1 1996/03/08 15:21:50 mclareni Exp $
-*
-* $Log: cfribmap.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:50 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_APOLLO)
- SUBROUTINE CFRIBM(IARRAY,NW,MODE)
-C +++++++++++++ APOLLO VERSION ++++++++++++++++++
-C The numbers must be right adj., zero filled.
-C MODE = 1 : convert 16-bit integers
-C = 2 : convert 32-bit integers (Dummy)
-C = 3 : convert 32-bit floating
- DIMENSION IARRAY(*)
- LOGICAL BTEST
- INTEGER*2 IW2(2)
- EQUIVALENCE (IW2(1),IW4)
- PARAMETER (IBIG=16#7FFF FFFF,ISMA=16#0080 0000)
- BTEST(J,N) = RSHFT(LSHFT(J,31-N),31).EQ.1
- IBSET(J,N) = OR(J,LSHFT(1,N))
-C
- IF(NW.LE.0) GO TO 999
- IF(MODE.EQ.1) THEN
-C
-C 16-bit integers
-C
- DO 110,I=1,NW
- IW4 = IARRAY(I)
- IARRAY(I) = IW2(2)
- 110 CONTINUE
- ELSEIF(MODE.EQ.2) THEN
-C
-C 32-bit integers (no conversion)
-C
- ELSE IF(MODE.EQ.3) THEN
-C
-C Convert the first NW words of IARRAY from
-C IBM 32-bit floating point representation to
-C APOLLO single-precision (32-bit) floating point
-C representation
- DO 2 J=1,NW
-C
-C Check for exact 0
- IF(IARRAY(J).EQ.0) GO TO 2
-C
-C Get exponent
-C Make sure ILEFT gets defined to something!
- ILEFT = 0
-C
- IEXPO = RSHFT(LSHFT(IARRAY(J),1),25)
- IF(BTEST(IARRAY(J),23)) THEN
- ILEFT = 0
- ELSEIF(BTEST(IARRAY(J),22)) THEN
- ILEFT = 1
- ELSEIF(BTEST(IARRAY(J),21)) THEN
- ILEFT = 2
- ELSEIF(BTEST(IARRAY(J),20)) THEN
- ILEFT = 3
- END IF
- IEXPO = IEXPO * 4 - ILEFT - 130
- IF(IEXPO.LE.0) THEN
- IDUMMY = ISMA
- GO TO 1
- ELSEIF(IEXPO.GT.255) THEN
- IDUMMY = IBIG
- GO TO 1
- END IF
- IDUMMY = LSHFT(IARRAY(J),ILEFT)
- IDUMMY = OR(AND(IDUMMY,2**23-1),LSHFT(IEXPO,23))
- 1 IF(BTEST(IARRAY(J),31)) IDUMMY = IBSET(IDUMMY,31)
- IARRAY(J) = IDUMMY
- 2 CONTINUE
- END IF
-C
- 999 END
-#endif
diff --git a/src/packlib/epio/obsolete/apollo/ctoibmap.F b/src/packlib/epio/obsolete/apollo/ctoibmap.F
deleted file mode 100644
index 4236b58..0000000
--- a/src/packlib/epio/obsolete/apollo/ctoibmap.F
+++ /dev/null
@@ -1,71 +0,0 @@
-*
-* $Id: ctoibmap.F,v 1.1.1.1 1996/03/08 15:21:50 mclareni Exp $
-*
-* $Log: ctoibmap.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:50 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_APOLLO)
- SUBROUTINE CTOIBM(IARRAY,NW,MODE)
-C +++++++++++++ APOLLO VERSION ++++++++++++++++++
-C The numbers must be right adj., zero filled.
-C MODE = 1 : convert 16-bit integers
-C = 2 : convert 32-bit integers (Dummy)
-C = 3 : convert 32-bit floating
- DIMENSION IARRAY(*)
- INTEGER*2 IW2(2)
- LOGICAL BTEST
- EQUIVALENCE (IW2(1),IW4)
- BTEST(J,N) = RSHFT(LSHFT(J,31-N),31).EQ.1
- IBSET(J,N) = OR(J,LSHFT(1,N))
-C
- IF(NW.LE.0) GO TO 999
- IF(MODE.EQ.1) THEN
-C
-C 16-bit integers
-C
- IW2(1) = 0
- DO 110,I=1,NW
- IW2(2) = IARRAY(I)
- IARRAY(I) = IW4
- 110 CONTINUE
- ELSE IF(MODE.EQ.2) THEN
-C
-C 32-bit integers (no conversion)
-C
- ELSE IF(MODE.EQ.3) THEN
-C
-C Convert the first NW words of IARRAY from APOLLO
-C single-precision (32-bit) floating point representation
-C to IBM 32-bit floating point representation
- DO 10,I=1,NW
-C
-C Check for exact 0
- IF(IARRAY(I).EQ.0) GO TO 10
-C
-C Get exponent
- IEXPO = RSHFT(LSHFT(IARRAY(I),1),24)
-C
-C APOLLO EXP + APOLLO BIAS + IBM BIAS
-C IEXPO = IEXPO - 128 + 260
- IEXPO = IEXPO + 134
- IEX16 = IEXPO/4
- ILEFT = 4 - MOD(IEXPO,4)
- IF(ILEFT.EQ.4) THEN
- ILEFT = 0
- IEX16 = IEX16 - 1
- END IF
- IDUMMY = AND(IARRAY(I),2**23-1)
- IDUMMY = IBSET(IDUMMY,23)
- IDUMMY = IDUMMY + 2**(ILEFT-1)
- IDUMMY = RSHFT(IDUMMY,ILEFT)
- IDUMMY = OR(IDUMMY,LSHFT(IEX16,24))
- IF(BTEST(IARRAY(I),31)) IDUMMY = IBSET(IDUMMY,31)
- IARRAY(I) = IDUMMY
- 10 CONTINUE
- END IF
-C
- 999 END
-#endif
diff --git a/src/packlib/epio/obsolete/apollo/epopeapo.F b/src/packlib/epio/obsolete/apollo/epopeapo.F
deleted file mode 100644
index 6cf54ba..0000000
--- a/src/packlib/epio/obsolete/apollo/epopeapo.F
+++ /dev/null
@@ -1,238 +0,0 @@
-*
-* $Id: epopeapo.F,v 1.1.1.1 1996/03/08 15:21:50 mclareni Exp $
-*
-* $Log: epopeapo.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:50 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_APOLLO)
- SUBROUTINE EPOPEN_APOLLO(MODE)
-%INCLUDE '/sys/ins/base.ins.ftn'
-%INCLUDE '/sys/ins/error.ins.ftn'
-%INCLUDE '/sys/ins/streams.ins.ftn'
-#include "epio/epiocom.inc"
-#include "epio/epapocom.inc"
-*
-* DOES FILE OPEN FOR APOLLO, VARIABLE RECORD LENGTH FILES
-*
-* INPUT:
-*
-* MODE =1 FOR WRITE, =2 FOR READ
-*
- CHARACTER*256 FLNAM
- INTEGER*2 STREAM_$ID,ATT_$REC(1)
- INTEGER*4 STATUS_$RETURNED,ATT_$REC_4(16),ERROR_$MASK
- EQUIVALENCE (ATT_$REC,ATT_$REC_4)
- LOGICAL OPEND
-*
- LUN = LIST(ISTART+10)
- LREC = LIST(ISTART+1)*2
- STREAM_$ID = 0
- CALL VEC_$IINIT(ATT_$REC_4,16,0)
-*
-* FIRST OF ALL WE CHECK IF THE UNIT HAS BEEN OPEN BY
-* A FORTRAN OPEN STATEMENT
-*
- INQUIRE(UNIT=LUN,STRID=STREAM_$ID,NAME=FLNAM,OPENED=OPEND)
- IF(OPEND) THEN
-*
-* THE UNIT IS ALREADY OPEN. WE JUST REGISTER THE NAME
-*
- EPVXUN(LREF) = FLNAM
- ELSE
- STREAM_$ID = 0
- IF(LIST(ISTART+25).NE.0) THEN
-*
-* MAYBE THE STREAM HAS BEEN OPENED AND CLOSED BUT THE
-* STREAM_$ID NOT ZEROED
-*
- ATT_$REC(1) = INT2(LIST(ISTART+25))
- CALL STREAM_$INQUIRE(
- 1 STREAM_$IRM_OTYPE,
- 2 STREAM_$USE_STRID,
- 3 ATT_$REC,
- 4 ERROR_$MASK,
- 5 STATUS_$RETURNED)
- IF (ERROR_$CODE(STATUS_$RETURNED).NE.STREAM_$NOT_OPEN.AND.
- + ERROR_$CODE(STATUS_$RETURNED).NE.STREAM_$STREAM_NOT_FOUND)
- + THEN
- IF(STATUS_$RETURNED.EQ.STATUS_$OK) THEN
-*
-* HERE THE STREAM WAS OPEN BUT NOT BY A FORTRAN OPEN:
-* NOT ALLOWED, WE JUST CLOSE THE STREAM
-*
- CALL STREAM_$CLOSE(ATT_$REC,STATUS_$RETURNED)
- IF(STATUS_$RETURNED.NE.STATUS_$OK)
- + CALL ERROR_$PRINT(STATUS_$RETURNED)
- ELSE
-*
-* HERE SOMETHING ELSE IS WRONG
-*
- CALL ERROR_$PRINT(STATUS_$RETURNED)
- END IF
- END IF
- END IF
-*
-* USE USER SPECIFIED NAME, OR DEFAULT NAME 'FOR0NN.DAT',
-* ALSO FOR THE MAGTAPE DESCRIPTOR FILE
-*
- IF (EPVXUN(LREF)(1:1).EQ.' ') THEN
- WRITE(FLNAM,1000)LUN/10,MOD(LUN,10)
- 1000 FORMAT('FOR0',2I1,'.DAT')
- EPVXUN(LREF)=FLNAM
- NSLNG = 10
- ELSE
- FLNAM = EPVXUN(LREF)
- DO NSLNG=256,1,-1
- IF(EPVXUN(LREF)(NSLNG:NSLNG).NE.' ') GO TO 82
- END DO
- 82 CONTINUE
- END IF
- ENDIF
- LIST(ISTART+24) = 0
-*
- IF(MODE.NE.1) THEN
-*
-* HERE WE OPEN FOR READING
-*
- IF(STREAM_$ID.EQ.0) THEN
- CALL STREAM_$OPEN (
- 1 FLNAM,
- 2 INT2(NSLNG),
- 3 STREAM_$READ,
- 4 STREAM_$NO_CONC_WRITE,
- 5 STREAM_$ID,
- 6 STATUS_$RETURNED )
- IF (STATUS_$RETURNED .NE. STATUS_$OK)
- 1 CALL ERROR_$PRINT(STATUS_$RETURNED)
- END IF
-C
-C SEE WHETHER THIS IS A TAPE UNIT
-C
- ATT_$REC(1)=STREAM_$ID
- CALL STREAM_$INQUIRE (
- 1 STREAM_$IRM_OTYPE,
- 2 STREAM_$USE_STRID,
- 3 ATT_$REC,
- 4 ERROR_$MASK,
- 5 STATUS_$RETURNED)
- IF (STATUS_$RETURNED .NE. STATUS_$OK)
- 1 CALL ERROR_$PRINT(STATUS_$RETURNED)
- IF(ATT_$REC_4(14).NE.16#314) CONTINUE
-C
-C NOW REDEFINE MOVE MODE
-C
- ATT_$REC(5)=16#1000
- CALL STREAM_$REDEFINE(
- 1 STREAM_$ID,
- 2 STREAM_$IRM_EXPLICIT_ML,
- 3 ATT_$REC,
- 4 ERROR_$MASK,
- 5 STATUS_$RETURNED)
- IF (STATUS_$RETURNED .NE. STATUS_$OK)
- 1 CALL ERROR_$PRINT(STATUS_$RETURNED)
- ELSE
-*
-* HERE WE OPEN FOR WRITING
-*
- IF(STREAM_$ID.EQ.0) THEN
- CALL STREAM_$OPEN (
- 1 FLNAM,
- 2 INT2(NSLNG),
- 3 STREAM_$WRITE,
- 4 STREAM_$NO_CONC_WRITE,
- 5 STREAM_$ID,
- 6 STATUS_$RETURNED )
- IF (STATUS_$RETURNED .NE. STATUS_$OK.AND.
- 1 ERROR_$CODE(STATUS_$RETURNED).NE.STREAM_$NAME_NOT_FOUND)
- 2 CALL ERROR_$PRINT(STATUS_$RETURNED)
- END IF
- IF(STREAM_$ID.NE.0) THEN
-*
-* SEE WHETHER THIS IS A TAPE UNIT
-*
- ATT_$REC(1)=STREAM_$ID
- CALL STREAM_$INQUIRE (
- 1 STREAM_$IRM_OTYPE,
- 2 STREAM_$USE_STRID,
- 3 ATT_$REC,
- 4 ERROR_$MASK,
- 5 STATUS_$RETURNED)
- IF (STATUS_$RETURNED .NE. STATUS_$OK)
- 1 CALL ERROR_$PRINT(STATUS_$RETURNED)
- IF(ATT_$REC_4(14).EQ.16#314) GO TO 100
- ELSE
-*
-* HERE THE STREAM NEEDS TO BE CREATED
-*
- CALL STREAM_$CREATE_BIN(
- 1 FLNAM,
- 2 INT2(NSLNG),
- 3 STREAM_$APPEND,
- 4 STREAM_$NO_CONC_WRITE,
- 5 STREAM_$ID,
- 6 STATUS_$RETURNED)
- IF (STATUS_$RETURNED .NE. STATUS_$OK)
- 1 CALL ERROR_$PRINT(STATUS_$RETURNED)
- END IF
-*
-* THIS IS A DISK FILE
-*
-* ASK FOR APPEND ACCESS
-*
- ATT_$REC(6)=16#200
- CALL STREAM_$REDEFINE(
- 1 STREAM_$ID,
- 2 STREAM_$IRM_OPOS,
- 3 ATT_$REC,
- 4 ERROR_$MASK,
- 5 STATUS_$RETURNED)
- IF (STATUS_$RETURNED .NE. STATUS_$OK)
- 1 CALL ERROR_$PRINT(STATUS_$RETURNED)
-C
-C NOW REDEFINE NON BINARY
-C
- ATT_$REC(5)=0
- CALL STREAM_$REDEFINE(
- 1 STREAM_$ID,
- 2 STREAM_$IRM_AB_FLAG,
- 3 ATT_$REC,
- 4 ERROR_$MASK,
- 5 STATUS_$RETURNED)
- IF (STATUS_$RETURNED .NE. STATUS_$OK)
- 1 CALL ERROR_$PRINT(STATUS_$RETURNED)
-C
-C NOW REDEFINE IT AS VARIABLE RECORD LENGTH
-C
- ATT_$REC(5)=16#0
- CALL STREAM_$REDEFINE(
- 1 STREAM_$ID,
- 2 STREAM_$IRM_EXPLICIT_TYPE,
- 3 ATT_$REC,
- 4 ERROR_$MASK,
- 5 STATUS_$RETURNED)
- IF (STATUS_$RETURNED .NE. STATUS_$OK)
- 1 CALL ERROR_$PRINT(STATUS_$RETURNED)
-C
-C WE WANT TO REDEFINE IT AS MOVE MODE
-C
- ATT_$REC(5)=16#1000
- CALL STREAM_$REDEFINE(
- 1 STREAM_$ID,
- 2 STREAM_$IRM_EXPLICIT_ML,
- 3 ATT_$REC,
- 4 ERROR_$MASK,
- 5 STATUS_$RETURNED)
- IF (STATUS_$RETURNED .NE. STATUS_$OK)
- 1 CALL ERROR_$PRINT(STATUS_$RETURNED)
- ENDIF
- 100 CONTINUE
-C
-C NOW STORE THE STREAM-ID
-C
- LIST(ISTART+25) = INT(STREAM_$ID)
- RETURN
- END
-#endif
diff --git a/src/packlib/epio/obsolete/apollo/streamr.F b/src/packlib/epio/obsolete/apollo/streamr.F
deleted file mode 100644
index 9b818c8..0000000
--- a/src/packlib/epio/obsolete/apollo/streamr.F
+++ /dev/null
@@ -1,36 +0,0 @@
-*
-* $Id: streamr.F,v 1.1.1.1 1996/03/08 15:21:50 mclareni Exp $
-*
-* $Log: streamr.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:50 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_APOLLO)
- SUBROUTINE READ_$STREAM(BUFFER,MAX,RET,STATUS_$RETURNED)
-%INCLUDE '/sys/ins/base.ins.ftn'
-%INCLUDE '/sys/ins/error.ins.ftn'
-%INCLUDE '/sys/ins/streams.ins.ftn'
- INTEGER*4 RET,POINT,STATUS_$RETURNED,KEY(3)
- INTEGER*2 STREAM_$ID,BUFFER(1)
-#include "epio/epiocom.inc"
-C
-C HERE WE ACTUALLY DO THE READ
-C
-C--- GET THE STREAM_$ID
- STREAM_$ID = INT2(LIST(ISTART+25))
-C--- GO AND READ
- CALL STREAM_$GET_BUF(
- 1 STREAM_$ID,
- 2 IADDR(BUFFER),
- 3 MAX,
- 4 IPOINT,
- 5 RET,
- 6 KEY,
- 7 STATUS_$RETURNED)
- IF(STATUS_$RETURNED.NE.STATUS_$OK.AND.
- +ERROR_$CODE(STATUS_$RETURNED).NE.STREAM_$END_OF_FILE)
- +CALL ERROR_$PRINT(STATUS_$RETURNED)
- END
-#endif
diff --git a/src/packlib/epio/obsolete/apollo/streamw.F b/src/packlib/epio/obsolete/apollo/streamw.F
deleted file mode 100644
index badeb76..0000000
--- a/src/packlib/epio/obsolete/apollo/streamw.F
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: streamw.F,v 1.1.1.1 1996/03/08 15:21:50 mclareni Exp $
-*
-* $Log: streamw.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:50 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_APOLLO)
- SUBROUTINE WRITE_$STREAM(BUFFER,RET,STATUS_$RETURNED)
-%INCLUDE '/sys/ins/base.ins.ftn'
-%INCLUDE '/sys/ins/error.ins.ftn'
-%INCLUDE '/sys/ins/streams.ins.ftn'
- INTEGER*4 RET,STATUS_$RETURNED,BUFFER(1),KEY(3)
- INTEGER*2 STREAM_$ID
-#include "epio/epiocom.inc"
-C
-C HERE WE ACTUALLY DO THE WRITE
-C
-C--- GET THE STREAM_$ID
- STREAM_$ID = INT2(LIST(ISTART+25))
-C--- GO AND WRITE
- CALL STREAM_$PUT_REC(
- 1 STREAM_$ID,
- 2 IADDR(BUFFER),
- 3 RET,
- 6 KEY,
- 7 STATUS_$RETURNED)
- IF(STATUS_$RETURNED.NE.STATUS_$OK)
- +CALL ERROR_$PRINT(STATUS_$RETURNED)
- END
-#endif
diff --git a/src/packlib/epio/obsolete/apollo/w16movap.F b/src/packlib/epio/obsolete/apollo/w16movap.F
deleted file mode 100644
index 8557dd0..0000000
--- a/src/packlib/epio/obsolete/apollo/w16movap.F
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: w16movap.F,v 1.1.1.1 1996/03/08 15:21:50 mclareni Exp $
-*
-* $Log: w16movap.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:50 mclareni
-* Epio
-*
-*
-* IBM version working on Apollo
-#include "epio/pilot.h"
-#if defined(CERNLIB_APOLLO)
- SUBROUTINE W16MOV(SOURCE,N1,TARGET,N2,N3)
-C.+++++++ IBM VERSION ++++++++++
-C. MOVES 16 BIT WORDS IN PACKED FORM.
-C.
-C. INPUT
-C. SOURCE SOURCE ARRAY
-C. N1 STARTING 16 BIT WORD IN SOURCE
-C. TARGET TARGET ARRAY
-C. N2 STARTING 16 BIT WORD IN TARGET
-C. N3 NO. OF 16 BIT WORDS TO MOVE
-C.
- INTEGER*2 SOURCE(2),TARGET(2)
- IF(N3.LE.0) GOTO 77777
- I1=N1-1
- I2=N2-1
- DO 1 I=1,N3
- 1 TARGET(I2+I)=SOURCE(I1+I)
-77777 RETURN
- END
-#endif
diff --git a/src/packlib/epio/obsolete/cdc/asciicdc.inc b/src/packlib/epio/obsolete/cdc/asciicdc.inc
deleted file mode 100644
index 738c62b..0000000
--- a/src/packlib/epio/obsolete/cdc/asciicdc.inc
+++ /dev/null
@@ -1,14 +0,0 @@
-*
-* $Id: asciicdc.inc,v 1.1.1.1 1996/03/08 15:21:52 mclareni Exp $
-*
-* $Log: asciicdc.inc,v $
-* Revision 1.1.1.1 1996/03/08 15:21:52 mclareni
-* Epio
-*
-*
-*
-* asciicdc.inc
-*
-#if defined(CERNLIB_CDC)
- COMMON/ASCIIC/ITASC(8),ITCDC(16)
-#endif
diff --git a/src/packlib/epio/obsolete/cdc/blo16wcd.F b/src/packlib/epio/obsolete/cdc/blo16wcd.F
deleted file mode 100644
index 4ba0da8..0000000
--- a/src/packlib/epio/obsolete/cdc/blo16wcd.F
+++ /dev/null
@@ -1,100 +0,0 @@
-*
-* $Id: blo16wcd.F,v 1.1.1.1 1996/03/08 15:21:52 mclareni Exp $
-*
-* $Log: blo16wcd.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:52 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_CDC)
- IDENT BLO16W
- ENTRY BLO16W
-* SUBROUTINE BLO16W(SOURCE,N1,TARGET,N2,N3)
-*
-* THIS IS AN ADAPTION OF ROUTINE -BLOW- IN CERN LIBRARY
-* AUTHOR H. GROTE CERN DD
-*
-* BLOWS (UNPACKS) 16 BIT WORDS INTO MACHINE WORDS.
-*
-* INPUT
-* SOURCE ARRAY CONTAINING 16 BIT WORDS IN PACKED FORM
-* N1 FIRST 16 BIT WORD IN SOURCE TO BLOW
-* TARGET TARGET ARRAY FOR UNPACKED 16 BIT WORDS
-* N2 TARGET(N2) WILL CONTAIN FIRST UNPACKED WORD
-* N3 NO. OF 16 BIT WORDS TO UNPACK
-*
- TRACE VFD 42/0LBLO16W,18/BLO16W
- BLOWA0 BSSZ 1
- F60 DATA 17257400000000000000B
- BLO16W JP 400000B+*
- SX6 A0
- SA6 BLOWA0 SAVE OLD A0
- SB1 1 CONSTANT B1=1
- SA0 A1
- SB2 2
- SA5 A0+1 N1 = 1ST 16 BIT WORD ADDRESS
- SB3 4
- SX4 1
- SA2 X5 N1 TO X2
- SA1 F60 60. TO X1
- IX0 X2-X4 N1-1 TO X0
- SB6 60
- LX2 B3,X0 X2 = 16*(N1-1)
- PX5 B0,X2
- FX4 X5/X1
- SX3 B6
- UX5 B3,X4
- LX6 B3,X5 16*(N1-1)/60 IN INTEGER
- SB7 X6 ADDRESS OF FIRST WORD IN SOURCE
- DX5 X3*X6
- IX4 X2-X5 STARTING BIT-1 IN WORD
- SB3 X4
- SA1 A0 X1 = SOURCE ADDRESS
- SA2 A1+B2 X2 = TARGET ADDRESS
- SA3 A2+B1 X3 = ADDRESS OF FIRST REL. TARGET WORD
- SA4 A3+B1 X4 = ADDR. OF NO. OF BYTES
- SA5 X1+B7 READ FIRST SOURCE WORD
- SA1 X3 FIRST TARGET WORD COUNT TO X1
- SB5 X1-1 REL. ADDRESS OF FIRST TARGET WORD
- LX5 B3,X5 LEFT SHIFT BYTE TO BOUNDARY
- SB4 X2+B5 FIRST TARGET WORD ADDRESS
- SA3 X4 X3 = NO. OF BYTES TO TRANSFER
- ZR X3,BLOW2 EXIT IF NUMBER OF BYTES=0
- NG X3,BLOW2 EXIT IF NUMBER OF BYTES LT 0
- SB5 X3+B4 B5 = TARGET WORD LIMIT +1
- SB2 16 NO. OF BITS/BYTE
- SB7 B6-B2 B7=REMAINING BIT COUNT IN WORD
- MX4 1
- SB7 B7-B1
- AX7 B7,X4 X7=BYTE MASK
- SB3 B6-B3 SET REMAINING BIT COUNT
- SB5 B5-B1 B5=LAST TARGET WORD ADDRESS
- EQ BLOW6
-*
-* MAIN LOOP - ONCE PER BYTE
-*
- BLOW1 SA6 B4 STORE BYTE
- EQ B4,B5,BLOW2 JUMP IF LAST BYTE
- SB3 B3-B2 DECREMENT REMAINING BIT COUNT
- SB4 B4+B1 INCREMENT TARGET ADDRESS
- BLOW6 LX5 B2,X5 SHIFT SOURCE WORD
- BX6 -X7*X5 MASK OUT BYTE
- LT B2,B3,BLOW1 LOOP UNLESS AT SOURCE WORD BOUND
- SA5 A5+B1 READ NEXT SOURCE WORD
- AX4 B3,X7 CONSTRUCT PARTIAL BYTE MASK
- BX2 X4*X6 MASK OUT LEFT PARTIAL BYTE
- SB7 B2-B3 NUMBER OF BITS FROM NEW WORD
- LX5 B7,X5 SHIFT NEW SOURCE WORD
- BX3 -X4*X5 MASK OUT RIGTH PARTIAL BYTE
- BX6 X2+X3 MERGE PARTIAL BYTES
- SB3 B6+B3 RESET REMAINING BIT COUNT
- EQ BLOW1
-*
-* NORMAL EXIT
-*
- BLOW2 SA4 BLOWA0
- SA0 X4 RESTORE OLD AO
- EQ BLO16W EXIT
- END
-#endif
diff --git a/src/packlib/epio/obsolete/cdc/blo32wcd.F b/src/packlib/epio/obsolete/cdc/blo32wcd.F
deleted file mode 100644
index 8c83d8c..0000000
--- a/src/packlib/epio/obsolete/cdc/blo32wcd.F
+++ /dev/null
@@ -1,103 +0,0 @@
-*
-* $Id: blo32wcd.F,v 1.1.1.1 1996/03/08 15:21:52 mclareni Exp $
-*
-* $Log: blo32wcd.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:52 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_CDC)
- IDENT BLO32W
- ENTRY BLO32W
-* SUBROUTINE BLO32W(SOURCE,N1,TARGET,N2,N3)
-*
-* THIS IS AN ADAPTION OF ROUTINE -BLOW- IN CERN LIBRARY
-* AUTHOR H. GROTE CERN DD
-*
-* BLOWS (UNPACKS) 32 BIT WORDS INTO MACHINE WORDS.
-*
-*
-* +++ IMPORTANT +++ COUNTS PARTLY IN 16 BIT WORDS
-*
-* INPUT
-* SOURCE ARRAY CONTAINING 32 BIT WORDS IN PACKED FORM
-* N1 FIRST 16 BIT WORD IN SOURCE TO BLOW
-* TARGET TARGET ARRAY FOR UNPACKED 32 BIT WORDS
-* N2 TARGET(N2) WILL CONTAIN FIRST UNPACKED WORD
-* N3 NO. OF 32 BIT WORDS TO UNPACK
-*
- TRACE VFD 42/0LBLO32W,18/BLO32W
- BLOWA0 BSSZ 1
- F60 DATA 17257400000000000000B
- BLO32W JP 400000B+*
- SX6 A0
- SA6 BLOWA0 SAVE OLD A0
- SB1 1 CONSTANT B1=1
- SA0 A1
- SB2 2
- SA5 A0+1 N1 = 1ST 16 BIT WORD ADDRESS
- SB3 4
- SX4 1
- SA2 X5 N1 TO X2
- SA1 F60 60. TO X1
- IX0 X2-X4 N1-1 TO X0
- SB6 60
- LX2 B3,X0 X2 = 16*(N1-1)
- PX5 B0,X2
- FX4 X5/X1
- SX3 B6
- UX5 B3,X4
- LX6 B3,X5 16*(N1-1)/60 IN INTEGER
- SB7 X6 ADDRESS OF FIRST WORD IN SOURCE
- DX5 X3*X6
- IX4 X2-X5 STARTING BIT-1 IN WORD
- SB3 X4
- SA1 A0 X1 = SOURCE ADDRESS
- SA2 A1+B2 X2 = TARGET ADDRESS
- SA3 A2+B1 X3 = ADDRESS OF FIRST REL. TARGET WORD
- SA4 A3+B1 X4 = ADDR. OF NO. OF BYTES
- SA5 X1+B7 READ FIRST SOURCE WORD
- SA1 X3 FIRST TARGET WORD COUNT TO X1
- SB5 X1-1 REL. ADDRESS OF FIRST TARGET WORD
- LX5 B3,X5 LEFT SHIFT BYTE TO BOUNDARY
- SB4 X2+B5 FIRST TARGET WORD ADDRESS
- SA3 X4 X3 = NO. OF BYTES TO TRANSFER
- ZR X3,BLOW2 EXIT IF NUMBER OF BYTES=0
- NG X3,BLOW2 EXIT IF NUMBER OF BYTES LT 0
- SB5 X3+B4 B5 = TARGET WORD LIMIT +1
- SB2 32 NO. OF BITS/BYTE
- SB7 B6-B2 B7=REMAINING BIT COUNT IN WORD
- MX4 1
- SB7 B7-B1
- AX7 B7,X4 X7=BYTE MASK
- SB3 B6-B3 SET REMAINING BIT COUNT
- SB5 B5-B1 B5=LAST TARGET WORD ADDRESS
- EQ BLOW6
-*
-* MAIN LOOP - ONCE PER BYTE
-*
- BLOW1 SA6 B4 STORE BYTE
- EQ B4,B5,BLOW2 JUMP IF LAST BYTE
- SB3 B3-B2 DECREMENT REMAINING BIT COUNT
- SB4 B4+B1 INCREMENT TARGET ADDRESS
- BLOW6 LX5 B2,X5 SHIFT SOURCE WORD
- BX6 -X7*X5 MASK OUT BYTE
- LT B2,B3,BLOW1 LOOP UNLESS AT SOURCE WORD BOUND
- SA5 A5+B1 READ NEXT SOURCE WORD
- AX4 B3,X7 CONSTRUCT PARTIAL BYTE MASK
- BX2 X4*X6 MASK OUT LEFT PARTIAL BYTE
- SB7 B2-B3 NUMBER OF BITS FROM NEW WORD
- LX5 B7,X5 SHIFT NEW SOURCE WORD
- BX3 -X4*X5 MASK OUT RIGTH PARTIAL BYTE
- BX6 X2+X3 MERGE PARTIAL BYTES
- SB3 B6+B3 RESET REMAINING BIT COUNT
- EQ BLOW1
-*
-* NORMAL EXIT
-*
- BLOW2 SA4 BLOWA0
- SA0 X4 RESTORE OLD AO
- EQ BLO32W EXIT
- END
-#endif
diff --git a/src/packlib/epio/obsolete/cdc/blo8wcd.F b/src/packlib/epio/obsolete/cdc/blo8wcd.F
deleted file mode 100644
index f64bb53..0000000
--- a/src/packlib/epio/obsolete/cdc/blo8wcd.F
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: blo8wcd.F,v 1.1.1.1 1996/03/08 15:21:52 mclareni Exp $
-*
-* $Log: blo8wcd.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:52 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_CDC)||defined(CERNLIB_UNIVAC)
- SUBROUTINE BLO8W(SOURCE,N1,TARGET,N2,N3)
-C.+++++++ CDC AND UNIVAC VERSION ++++++++++
-C. BLOWS (UNPACKS) 8 BIT BYTES INTO MACHINE WORDS.
-C.
-C. INPUT
-C. SOURCE ARRAY CONTAINING 8 BIT BYTES IN PACKED FORM
-C. N1 FIRST 8 BIT BYTE IN SOURCE TO BLOW
-C. TARGET TARGET ARRAY FOR UNPACKED 8 BIT BYTES
-C. N2 TARGET(N2) WILL CONTAIN FIRST UNPACKED WORD
-C. N3 NO. OF 8 BIT BYTES TO UNPACK
- INTEGER SOURCE(2),TARGET(2)
- CALL BLOBYT(SOURCE,TARGET(N2),N3,8,8*(N1-1)+1)
- RETURN
- END
-#endif
diff --git a/src/packlib/epio/obsolete/cdc/blobycdc.F b/src/packlib/epio/obsolete/cdc/blobycdc.F
deleted file mode 100644
index dd9145b..0000000
--- a/src/packlib/epio/obsolete/cdc/blobycdc.F
+++ /dev/null
@@ -1,99 +0,0 @@
-*
-* $Id: blobycdc.F,v 1.1.1.1 1996/03/08 15:21:53 mclareni Exp $
-*
-* $Log: blobycdc.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:53 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_CDC)
- IDENT BLOBYT
- ENTRY BLOBYT
-* SUBROUTINE BLOBYT(SOURCE,TARGET,MBYTES,NBITS,NSTART)
-*
-* THE ROUTINE CONVERTS A SOURCE ARRAY CONTAINING A RECORD
-* OF NBYTES WITH NBITS IN A 60 BITS WORD TARGET ARRAY
-*
-* THIS IS AN ADAPTION OF ROUTINE -BLOW- IN CERN LIBRARY
-* AUTHOR H. GROTE CERN DD
-*
-* THE SUBROUTINE EXPECTS FIVE PARAMETER
-* SOURCE- GIVES THE ADDRESS OF A SOURCE ARRAY
-* TARGET- GIVES THE ADDRESS OF A TARGET ARRAY
-* NBYTES- NUMBER OF BYTES IN THE SOURCE RECORD
-* NBITS- NUMBER OF BITS PER BYTE
-* NSTART- POSITION OF FIRST BIT OF FIRST BYTE IN SOURCE
-* ( COUNT STARTS WITH 1 AT LEFT )
-*
- TRACE VFD 42/0LBLOBYT,18/BLOBYT
- BLOWA0 BSSZ 1
- BLOBYT JP 400000B+*
- SX6 A0
- SA6 BLOWA0 SAVE OLD A0
- SB1 1 CONSTANT B1=1
- SB6 60 CONSTANT B6=60
- SA0 A1 A0=PARAMETER LIST ADDRESS
- SA5 A0+4 NSTART=STARTING BIT POSITION
- SA5 X5
- SX3 B6
- PX0 B0,X3
- NX6 B0,X0 60. IN FLOATING
- SX4 1
- IX0 X5-X4
- PX5 B0,X0 NSTART -1 IN FLOATING
- FX4 X5/X6
- UX5 B2,X4
- LX6 B2,X5 (NSTART - 1 )/60 IN INTEGER
- SB7 X6 ADDRESS OF FIRST WORD REL. TO SOURCE
- DX5 X3*X6
- IX4 X0-X5 STARTING BIT -1 IN WORD
- SB3 X4
- SA1 A1 READ SOURCE ADDRESS
- SA2 A1+B1 READ TARGET ADDRESS
- SA3 A2+B1 READ ADDRESS OF NUMBER OF BYTES
- SA4 A3+B1 READ ADDRESS OF NUMBER OF BITS
- SA5 X1+B7 READ FIRST SOURCE WORD
- LX5 B3,X5 LEFT SHIFT BYTE TO LEFT BOUNDARY
- SB4 X2 B4=TARGET WORD ADDRESS
- SA3 X3 READ NUMBER OF BYTES
- SA4 X4 READ NUMBER OF BITS PER BYTE
- SB5 X3+B4 B5=TARGET WORD LIMIT(LWA+1)
- SB2 X4 B2=NUMBER OF BITS PER BYTE
- GE B4,B5,BLOW2 RETURN IF NUMBER OF BYTES .LE.0
- GE B0,B2,BLOW2 ERROR IF NUMBER OF BITS.LE.0
- GE B2,B6,BLOW2 ERROR IF NUMBER OF BITS.GE.60
- SB7 B6-B2 B7=REMAINING BIT COUNT IN WORD
- MX4 1
- SB7 B7-B1
- AX7 B7,X4 X7=BYTE MASK
- SB3 B6-B3 SET REMAINING BIT COUNT
- SB5 B5-B1 B5=LAST TARGET WORD ADDRESS
- EQ BLOW6
-*
-* MAIN LOOP - ONCE PER BYTE
-*
- BLOW1 SA6 B4 STORE BYTE
- EQ B4,B5,BLOW2 JUMP IF LAST BYTE
- SB3 B3-B2 DECREMENT REMAINING BIT COUNT
- SB4 B4+B1 INCREMENT TARGET ADDRESS
- BLOW6 LX5 B2,X5 SHIFT SOURCE WORD
- BX6 -X7*X5 MASK OUT BYTE
- LT B2,B3,BLOW1 LOOP UNLESS AT SOURCE WORD BOUND
- SA5 A5+B1 READ NEXT SOURCE WORD
- AX4 B3,X7 CONSTRUCT PARTIAL BYTE MASK
- BX2 X4*X6 MASK OUT LEFT PARTIAL BYTE
- SB7 B2-B3 NUMBER OF BITS FROM NEW WORD
- LX5 B7,X5 SHIFT NEW SOURCE WORD
- BX3 -X4*X5 MASK OUT RIGTH PARTIAL BYTE
- BX6 X2+X3 MERGE PARTIAL BYTES
- SB3 B6+B3 RESET REMAINING BIT COUNT
- EQ BLOW1
-*
-* NORMAL EXIT
-*
- BLOW2 SA4 BLOWA0
- SA0 X4 RESTORE OLD AO
- EQ BLOBYT EXIT
- END
-#endif
diff --git a/src/packlib/epio/obsolete/cdc/btmvepcd.F b/src/packlib/epio/obsolete/cdc/btmvepcd.F
deleted file mode 100644
index 8f72e43..0000000
--- a/src/packlib/epio/obsolete/cdc/btmvepcd.F
+++ /dev/null
@@ -1,52 +0,0 @@
-*
-* $Id: btmvepcd.F,v 1.1.1.1 1996/03/08 15:21:52 mclareni Exp $
-*
-* $Log: btmvepcd.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:52 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_CDC)
- SUBROUTINE BTMVEP(IS,ISBIT,IT,ITBIT,NBIT)
-C--- BIT MOVE ROUTINE, CDC VERSION
-C--- AUTHOR H. GROTE / CERN-DD 13.10.80
-C--- ROUTINE MOVES -NBIT- BITS FROM ARRAY IS TO ARRAY IT,
-C--- STARTING AT BITS ISBIT IN IS, AND ITBIT IN IT.
-C--- BITS ARE COUNTED FROM LEFT TO RIGHT, 1 TO INFINITY.
-C--- FOR NBIT LE 0, NO TRANSFER.
- DIMENSION IS(2),IT(2)
-C--- MBIT IS THE NUMBER OF BITS / WORD
- DATA MBIT/ 60 /
- IF(NBIT.LE.0) GOTO 500
-C--- FIRST AND LAST WORD IN ARRAY IS
- KSW1=(ISBIT-1)/MBIT+1
- KSW2=(ISBIT+NBIT-2)/MBIT+1
-C--- FIRST BIT IN IS(KSW1) AND LAST IN IS(KSW2)
- IBS1=ISBIT-MBIT*(KSW1-1)
- IBS2=ISBIT+NBIT-1-MBIT*(KSW2-1)
-C--- FIRST AND LAST WORD IN ARRAY IT
- KTW1=(ITBIT-1)/MBIT+1
- KTW2=(ITBIT+NBIT-2)/MBIT+1
-C--- FIRST BIT IN IT(KTW1), LAST IN IT(KTW2)
- IBT1=ITBIT-MBIT*(KTW1-1)
- IBT2=ITBIT+NBIT-1-MBIT*(KTW2-1)
-C--- NO. OF WORDS TO SHIFT
- NW=MAX0(KTW2-KTW1,KSW2-KSW1)+1
-C--- KEEP FIRST AND LAST TWO WORD OF IT
- KEEP1=IT(KTW1)
- KEEP2=IT(KTW2)
-C--- SHIFT IN SOURCE ARRAY
- CALL SHLGEP(IS(KSW1),NW,IBS1-IBT1)
-C--- MOVE WORDS INTO IT
- CALL UCOPY(IS(KSW1),IT(KTW1),KTW2+1-KTW1)
-C--- SHIFT BACK
- CALL SHLGEP(IS(KSW1),NW,IBT1-IBS1)
-C--- CORRECT FIRST AND LAST (ONE OR TWO) WORDS
- MASK1=MASK(IBT1-1)
- MASK2=MASK(IBT2)
- IT(KTW1)=OR(AND(MASK1,KEEP1),AND(COMPL(MASK1),IT(KTW1)))
- IT(KTW2)=OR(AND(MASK2,IT(KTW2)),AND(COMPL(MASK2),KEEP2))
- 500 RETURN
- END
-#endif
diff --git a/src/packlib/epio/obsolete/cdc/btswapcd.F b/src/packlib/epio/obsolete/cdc/btswapcd.F
deleted file mode 100644
index 23e05d7..0000000
--- a/src/packlib/epio/obsolete/cdc/btswapcd.F
+++ /dev/null
@@ -1,130 +0,0 @@
-*
-* $Id: btswapcd.F,v 1.1.1.1 1996/03/08 15:21:52 mclareni Exp $
-*
-* $Log: btswapcd.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:52 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_CDC)
- IDENT BTSWAP
- ENTRY BTSWAP
-*-----------------------------------------------------------
-*
-* SUBROUTINE BTSWAP(IARRAY,NBYTES)
-*
-* MOVES 16 BIT WORDS IN PACKED FORM.
-*
-* ARGUMENTS
-* IARRAY SOURCE ARRAY
-* NBYTES NO. OF BYTES TO SWAP, STARTING AT THE LEFTMOST
-* POSITION IN IARRAY. IF LE 1, NO ACTION. IF ODD,
-* NBYTES-1 IS USED INSTEAD.
-*
-* AUTHOR H. GROTE CERN/DD 5.11.84
-*
-*-----------------------------------------------------------
- TRACE VFD 42/0LBTSWAP,18/BTSWAP
-*--- MASK FOR 6 BYTES = 8*0, 8*1, 8*0, 8*1, 8*0, 8*1, 12*0
- MASK DATA 00177400776003770000B
- STOA0 BSS 1
- BTSWAP JP 400000B+*
- SX6 A0
- SA6 STOA0 STORE A0
- SA3 A1
- SA4 A1+1
- SA1 X4 NBYTES INTO X1
- AX1 1 DIVIDE BY 2
- SB1 X1 NO. OF SWAPS TO PERFORM
- SA0 X3 ADDRESS OF FIRST WORD
- SB6 60
- SB2 B6
- SA1 MASK
- BX0 X1 MASK INTO X0
-*
-* USE OF REGISTERS
-*
-* B1 NO. OF SWAPS = LOOP INDEX
-* B2 NO. OF BITS LEFT IN CURRENT WORD
-* B3 NO. OF WORDS TO TAKE FROM NEXT WORD
-* B4 NO. OF BITS TO TREAT IN ONE LOOP CYCLE (NORMALLY 48)
-* B5 NO. OF BITS TO TREAT IN CURRENT WORD
-* B6 =60
-* B7 NO. OF BITS TAKEN FROM FIRST WORD
-*
-* X0 MASK FOR BYTE SWAPPING
-* X7 MASK FOR RESTORING INTO SECOND WORD
-*
-* A0 ADDRESS OF CURRENT WORD
-* A2 ADDRESS OF FIRST WORD
-*
- LOOP LE B1,B0,EXIT LOOP TERMINATION
- SA2 A0 LOAD WORD IN X2
- SB3 3 MAX. NO. OF SWAPS/CYCLE
- GE B1,B3,CONT1
- SB3 B1 LESS THAN 3 LEFT
- CONT1 SB1 B1-B3 REDUCE LOOP COUNTER
- SX6 B3
- LX6 4 MULTIPLY BY 16 TO GET NO. OF BITS
- SB4 X6 NO. OF BITS THIS CYCLE
- SB5 B6-B2
- LX3 B5,X2 LEFT ADJUST BYTES TO SWAP
- SB5 B4
- GE B2,B4,CONT2
- SB5 B2 B5 = MIN(B2,B4)
- CONT2 SX4 1
- SB7 B5-1
- LX4 -1
- AX5 B7,X4 MASK OF B5 BITS LEFT ADJ.
- BX3 X3*X5
- SB7 B2 KEEP B2 IN B7
- SB2 B2-B4
- SB3 B0
- GT B2,B0,SWAP
- EQ B2,B0,CONT3
- SB3 -B2 NO. OF BITS TO TAKE FROM NEXT WORD
- CONT3 SB2 B2+B6 INCREASE NO. OF BITS BY NEW WORD
- SA0 A0+1 INCREASE ADDRESS
- EQ B3,B0,SWAP JUMP IF NOTHING TAKEN FROM NEW WORD
- SA1 A0 NEW WORD INTO X1
- SX4 1
- SB4 B3-1
- LX4 -1
- AX7 B4,X4 MASK OF B3 LEFT-ADJ. BITS
- BX2 X1*X7
- SB4 B6-B7
- LX2 B4,X2 RIGHT SHIFT BITS FROM NEW WORD BY B7
- BX3 X2+X3
-*--- NOW 6 (OR LESS) 8-BIT BYTES LEFT ADJUSTED IN X3
- SWAP BX4 X0*X3 MASK EVEN BYTES
- LX4 8 MAKE ODD
- LX3 -8 MAKE ODD BYTES EVEN
- BX3 X0*X3 MASK
- BX5 X3+X4 BYTES ARE SWAPPED IN X4
-*--- RESTORE IN FIRST (AND POSSIBLY SECOND) WORD
- SA1 A2 GET FIRST WORD IN X1
- SB4 B6-B7 NO. OF UNCHANGED BITS, WORD 1
- LX2 B4,X1 RIGHT-ADJ. UNCHANGED BITS
- SX3 1
- SB4 B5-1
- LX3 -1
- AX3 B4 MASK OF 1-BITS FOR BITS TO CHANGE
- BX4 -X3*X2 UNCHANGED PART
- BX1 X3*X5 NEW (SWAPPED) BITS
- BX6 X1+X4 JOIN
- LX6 B7,X6 SHIFT INTO ORIGINAL POSITION
- SA6 A2 RESTORE FIRST WORD
- EQ B3,B0,LOOP JUMP IF SECOND WORD UNUSED
- SA1 A0 SECOND WORD INTO X1
- BX3 -X7*X1 UNCHANGED PART
- LX4 B7,X5 LEFT-ADJ. CHANGED PART IN RESULT
- BX5 X7*X4
- BX6 X3+X5 JOIN
- SA6 A0 RESTORE
- EQ LOOP
- EXIT SA1 STOA0
- SA0 X1 RESTORE A0
- EQ BTSWAP
- END
-#endif
diff --git a/src/packlib/epio/obsolete/cdc/bun16wcd.F b/src/packlib/epio/obsolete/cdc/bun16wcd.F
deleted file mode 100644
index 441463f..0000000
--- a/src/packlib/epio/obsolete/cdc/bun16wcd.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: bun16wcd.F,v 1.1.1.1 1996/03/08 15:21:52 mclareni Exp $
-*
-* $Log: bun16wcd.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:52 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_CDC)||defined(CERNLIB_UNIVAC)
- SUBROUTINE BUN16W(SOURCE,N1,TARGET,N2,N3)
-C.+++++++ CDC AND UNIVAC VERSION ++++++++++
-C. BUNCHES (PACKS) 16 BIT WORDS (RIGHT ADJ., ZERO FILLED)
-C. INTO A CONTIGUOUS BIT STRING.
-C.
-C. INPUT
-C. SOURCE ARRAY CONTAINING 16 BIT WORDS IN UNPACKED FORM
-C. N1 FIRST 16 BIT WORD IN SOURCE TO BE PACKED
-C. TARGET TARGET ARRAY FOR PACKED 16 BIT WORDS
-C. N2 FIRST 16 BIT WORD IN TARGET TO PACK TO
-C. N3 NO. OF 16 BIT WORDS TO PACK
- INTEGER SOURCE(2),TARGET(2)
- CALL BUNBYT(SOURCE(N1),TARGET,N3,16,16*(N2-1)+1)
- RETURN
- END
-#endif
diff --git a/src/packlib/epio/obsolete/cdc/bun32wcd.F b/src/packlib/epio/obsolete/cdc/bun32wcd.F
deleted file mode 100644
index c2e7d7f..0000000
--- a/src/packlib/epio/obsolete/cdc/bun32wcd.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: bun32wcd.F,v 1.1.1.1 1996/03/08 15:21:52 mclareni Exp $
-*
-* $Log: bun32wcd.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:52 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_CDC)||defined(CERNLIB_UNIVAC)
- SUBROUTINE BUN32W(SOURCE,N1,TARGET,N2,N3)
-C.+++++++ CDC AND UNIVAC VERSION ++++++++++
-C. BUNCHES (PACKS) 32 BIT WORDS (RIGHT ADJ., ZERO FILLED)
-C. INTO A CONTIGUOUS BIT STRING.
-C.
-C. +++ IMPORTANT +++ COUNTS PARTLY IN 16 BIT WORDS
-C.
-C. INPUT
-C. SOURCE ARRAY CONTAINING 32 BIT WORDS IN UNPACKED FORM
-C. N1 FIRST 32 BIT WORD IN SOURCE TO BE PACKED
-C. TARGET TARGET ARRAY FOR PACKED 32 BIT WORDS
-C. N2 FIRST 16 BIT WORD IN TARGET TO PACK TO
-C. N3 NO. OF 32 BIT WORDS TO PACK
- INTEGER SOURCE(2),TARGET(2)
- CALL BUNBYT(SOURCE(N1),TARGET,N3,32,16*(N2-1)+1)
- RETURN
- END
-#endif
diff --git a/src/packlib/epio/obsolete/cdc/bun8wcd.F b/src/packlib/epio/obsolete/cdc/bun8wcd.F
deleted file mode 100644
index 61c77c0..0000000
--- a/src/packlib/epio/obsolete/cdc/bun8wcd.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: bun8wcd.F,v 1.1.1.1 1996/03/08 15:21:52 mclareni Exp $
-*
-* $Log: bun8wcd.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:52 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_CDC)||defined(CERNLIB_UNIVAC)
- SUBROUTINE BUN8W(SOURCE,N1,TARGET,N2,N3)
-C.+++++++ CDC AND UNIVAC VERSION ++++++++++
-C. BUNCHES (PACKS) 8 BIT BYTES (RIGHT ADJ., ZERO FILLED)
-C. INTO A CONTIGUOUS BIT STRING.
-C.
-C. INPUT
-C. SOURCE ARRAY CONTAINING 8 BIT BYTES IN UNPACKED FORM
-C. N1 FIRST 8 BIT BYTE IN SOURCE TO BE PACKED
-C. TARGET TARGET ARRAY FOR PACKED 8 BIT BYTES
-C. N2 FIRST 8 BIT BYTE IN TARGET TO PACK TO
-C. N3 NO. OF 8 BIT BYTES TO PACK
- INTEGER SOURCE(2),TARGET(2)
- CALL BUNBYT(SOURCE(N1),TARGET,N3,8,8*(N2-1)+1)
- RETURN
- END
-#endif
diff --git a/src/packlib/epio/obsolete/cdc/bunbycdc.F b/src/packlib/epio/obsolete/cdc/bunbycdc.F
deleted file mode 100644
index 28de5bf..0000000
--- a/src/packlib/epio/obsolete/cdc/bunbycdc.F
+++ /dev/null
@@ -1,142 +0,0 @@
-*
-* $Id: bunbycdc.F,v 1.1.1.1 1996/03/08 15:21:53 mclareni Exp $
-*
-* $Log: bunbycdc.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:53 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_CDC)
- IDENT BUNBYT
- SPACE 2
-*** SUBROUTINE BUNBYT(SOURCE,TARGET,NBYTES,NBITS,NSTART)
-*
-* BUNBYT CONVERTS AN ARRAY OF BYTES, STORED ONE PER 60-BIT
-* WORD, RIGHT JUSTIFIED, INTO A CONTIGUOUS BIT STRING, STARTING
-* AT BIT POSITION NSTART IN TARGET ARRAY (COUNT STARTS WITH 1
-* AT LEFT )
-*
-* ON ENTRY
-* SOURCE IS THE SOURCE ARRAY
-* NBYTES IS THE NUMBER OF BYTES IN THE SOURCE ARRAY
-* NBITS IS THE NUMBER OF BITS PER BYTE
-* NSTART IS THE STARTING BIT POSITION FOR THE FIRST BYTE
-* TO BE STORED IN TARGET.
-*
-* ON EXIT
-* TARGET IS THE TARGET ARRAY. BIT POSITIONS IN TARGET NOT
-* CONCERNED BY THE MOVE REMAIN UNTOUCHED.
-*
-* ERROR CONDITIONS
-* NBITS.LE.0 OR NBITS.GE.60
-*
-* THIS VERSION FOR FORTRAN EXTENDED (FORTRAN COMMON LIBRARY)
-* UNDER 6000 SCOPE 3.4 OR 7000 SCOPE 2.0.
-*
-* THIS ROUTINE IS A MODIFIED VERSION OF ROUTINE -BUNCH-
-* IN THE CERN LIBRARY.
-*
-* H. GROTE/CERN 3 JUNE 1980
- SPACE 3
- ENTRY BUNBYT
- SPACE 1
- LIST G
- SPACE 2
- BUNCHTR VFD 42/0LBUNBYT,18/BUNBYT
- BUNCHA0 DATA 0
- BUNBYT JP 400000B+*
- SX6 A0
- SA0 A1 A0=PARAMETER LIST ADDRESS
- SA6 BUNCHA0 SAVE OLD A0
- SB1 1 CONSTANT B1=1
- SB2 60 CONSTANT B2=60
- SA5 A0+4 NSTART=STARTING BIT POSITION
- SA5 X5
- SX3 B2
- PX0 B0,X3
- NX6 B0,X0 60. IN FLOATING
- SX4 1
- IX0 X5-X4
- PX5 B0,X0 NSTART -1 IN FLOATING
- FX4 X5/X6
- UX5 B6,X4
- LX6 B6,X5 (NSTART - 1 )/60 IN INTEGER
- SB7 X6 ADDRESS OF FIRST WORD REL. TO SOURCE
- DX5 X3*X6
- IX4 X0-X5 STARTING BIT -1 IN WORD
- SB5 X4
- SA1 A1 READ SOURCE ADDRESS
- SA2 A1+B1 READ TARGET ADDRESS
- SA3 A2+B1 READ ADDRESS OF NUMBER OF BYTES
- SA4 A3+B1 READ ADDRESS OF NUMBER OF BITS
- SA5 X1-1 READ WORD BEFORE FIRST SOURCE WORD
- SB6 X2+B7 B6=TARGET WORD ADDRESS
- SA3 X3 READ NUMBER OF BYTES
- SA4 X4 READ NUMBER OF BITS PER BYTE
- SB3 X3 B3=BYTE COUNTER
- SB4 X4 B4=NUMBER OF BITS PER BYTE
- LE B3,B0,BUNCH4 RETURN IF NUMBER OF BYTES.LE.0
- LE B4,B0,BUNCH4 ERROR IF NUMBER OF BITS.LE.0
- GE B4,B2,BUNCH4 ERROR IF NUMBER OF BITS.GE.60
- EQ B5,B0,BUNCH7
- SA2 B6 FIRST TARGET WORD
- MX7 1
- SB7 B5-1
- AX0 B7,X7 MASK
- BX6 X0*X2 MASK FIRST TARGET WORD
- EQ BUNCH8
- BUNCH7 SX6 B0 CLEAR TARGET WORD IF AT LEFT BOUNDARY
- BUNCH8 SB5 B2-B5 B5=BIT POSITION IN TARGET WORD
- MX7 1
- SB7 B4-59
- LX0 B7,X7 X0=BYTE MASK
- SPACE 2
-** MAIN LOOP - ONCE PER BYTE
-*
-* REGISTER CONVENTIONS
-* A5,X5 SOURCE WORD
-* A6,B6,X6 TARGET WORD
-* X0 BYTE MASK (COMPLEMENT)
-* B1 1
-* B2 60
-* B3 BYTE COUNTER (=NBYTES INITIALLY, =0 FINALLY)
-* B4 BYTE LENGTH
-* B5 BIT POSITION IN TARGET WORD
- SPACE 2
- BUNCH1 SA5 A5+B1 READ NEXT SOURCE WORD
- SB5 B5-B4 DECREMENT BIT POSITION
- LE B3,B0,BUNCH3 JUMP IF LAST BYTE HAS BEEN MOVED
- BUNCH2 BX2 -X0*X5 EXTRACT SOURCE BYTE
- LX3 B5,X2 POSITION SOURCE BYTE (END-OFF)
- SB3 B3-B1 DECREMENT BYTE COUNTER
- BX6 X6+X3 ADD SOURCE BYTE TO TARGET WORD
- GT B5,B0,BUNCH1 LOOP UNLESS TARGET WORD IS FULL
- SA6 B6 STORE TARGET WORD
- SB5 B5+B2 RESET BIT POSITION (ADD 60)
- SB6 B6+B1 INCREMENT TARGET ADDRESS
- LX4 B5,X2 POSITION SOURCE BYTE (CIRCULARLY)
- SA5 A5+B1 READ NEXT SOURCE WORD
- SB5 B5-B4 DECREMENT BIT POSITION
- BX6 X4-X3 STORE BOTTOM OF SOURCE BYTE IN TARGET
- GT B3,B0,BUNCH2 LOOP UNLESS LAST BYTE HAS BEEN MOVED
- SPACE 2
-** END OF LOOP - STORE INCOMPLETE TARGET WORD, IF ANY,
-* AND RETURN
- SPACE 2
- BUNCH3 SB7 B5+B4 BIT POSITION OF LAST BYTE
- EQ B7,B2,BUNCH4 RETURN IF TARGET WORD IS EMPTY
- SB3 B2-B7
- SB7 B3-B1
- MX7 1
- AX7 B7,X7 MASK FOR LAST TARGET WORD
- SA2 B6 GET LAST TARGET WORD
- BX3 -X7*X2
- BX6 X6+X3 JOIN TARGET WORD WITH REST OF BYTE
- SA6 B6 STORE LAST TARGET WORD
- BUNCH4 SA4 BUNCHA0
- SA0 X4 RESTORE OLD A0
- EQ BUNBYT RETURN
- SPACE 2
- END
-#endif
diff --git a/src/packlib/epio/obsolete/cdc/cfrasccd.F b/src/packlib/epio/obsolete/cdc/cfrasccd.F
deleted file mode 100644
index b6eae51..0000000
--- a/src/packlib/epio/obsolete/cdc/cfrasccd.F
+++ /dev/null
@@ -1,99 +0,0 @@
-*
-* $Id: cfrasccd.F,v 1.1.1.1 1996/03/08 15:21:52 mclareni Exp $
-*
-* $Log: cfrasccd.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:52 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_CDC)
- SUBROUTINE CFRASC(IARR,NW)
-C.+++++++ CDC VERSION +++++++
-C. ASCII TO INTERNAL CDC ( =DISPLAY ) CODE CONVERSION.
-C. INPUT
-C. NW NO. OF CHARACTERS TO CONVERT
-C. I/O
-C. IARR CONTAINS CHARACTERS UNPACKED, RIGHT ADJ., ZERO FILLED
-C. BEFORE AND AFTER CONVERSION IN PLACE.
-#include "epio/asciicdc.inc"
- DIMENSION IARR( 1)
-C--- IN ITASC 7 BITS / ASCII CHARACTER, 8 / WORD
-C--- IN ITCDC 6 BITS / DISPLAY CH., 8 / WORD
-C DATA ITCDC/ 4*8H ,
-C 1 8H!"#$ &'(, 8H)*+,-./0, 8H12345678, 8H9:;<=>?@,
-C 2 8HABCDEFGH, 8HIJKLMNOP, 8HQRSTUVWX, 8HYZ[ ]^ ,
-C 3 8HABCDEFGH, 8HIJKLMNOP, 8HQRSTUVWX, 8HYZ /
-#if defined(CERNLIB_F4)
- DATA ITCDC/ 4*8H ,
- *66646053556770515555B,52474556465750335555B,34353637404142435555B,
- *44637772547371745555B,01020304050607105555B,11121314151617205555B,
- *21222324252627305555B,31326155627665555555B,01020304050607105555B,
- *11121314151617205555B,21222324252627305555B,31325555555555555555B/
-#endif
-#if !defined(CERNLIB_F4)
- DATA ITCDC/ 4*8H ,
- *O"66646053556770515555",O"52474556465750335555",
- *O"34353637404142435555",O"44637772547371745555",
- *O"01020304050607105555",O"11121314151617205555",
- *O"21222324252627305555",O"31326155627665555555",
- *O"01020304050607105555",O"11121314151617205555"
- *O"21222324252627305555",O"31325555555555555555"/
-#endif
- DATA IFI/0/, NBASC/32/
- IF(IFI.NE.0) GOTO 10
-C--- INITIALIZE
-C PRESET TO ASCII BLANK
- M=0
- DO 1 I=1,8
- 1 M=OR(SHIFT(M,7),NBASC)
- M=SHIFT(M,4)
- DO 2 I=1,8
- 2 ITASC(I)=M
- DO 3 I=33,122
- NP=(I-1)/8
- NB=I-8*NP
-#if defined(CERNLIB_F4)
- K=AND(SHIFT(ITCDC(NP+1),6*NB),77B)
-C--- DO NOT SET BLANK CORR.
- IF(K.EQ.55B) GOTO 3
-#endif
-#if !defined(CERNLIB_F4)
- K=AND(SHIFT(ITCDC(NP+1),6*NB),O"77")
-C--- DO NOT SET BLANK CORR.
- IF(K.EQ.O"55") GOTO 3
-#endif
- NP=(K-1)/8
- NB=K-8*NP
- KW=SHIFT(ITASC(NP+1),7*NB)
-C--- SET ONLY IF NOT YET SET
-#if defined(CERNLIB_F4)
- IF(AND(KW,177B).EQ.NBASC)
- 1 ITASC(NP+1)=SHIFT(OR(AND(KW,MASK(53)),I),7*(8-NB)+4)
-#endif
-#if !defined(CERNLIB_F4)
- IF(AND(KW,O"177").EQ.NBASC)
- 1 ITASC(NP+1)=SHIFT(OR(AND(KW,MASK(53)),I),7*(8-NB)+4)
-#endif
- 3 CONTINUE
- IFI=1
- 10 CONTINUE
- IF(NW.LE.0) GOTO 77777
- DO 11 I=1,NW
-#if defined(CERNLIB_F4)
- K=AND(IARR(I),177B)
-#endif
-#if !defined(CERNLIB_F4)
- K=AND(IARR(I),O"177")
-#endif
- NP=(K-1)/8
- NB=K-8*NP
-#if defined(CERNLIB_F4)
- 11 IARR(I)=AND(SHIFT(ITCDC(NP+1),6*NB),77B)
-#endif
-#if !defined(CERNLIB_F4)
- 11 IARR(I)=AND(SHIFT(ITCDC(NP+1),6*NB),O"77")
-#endif
-77777 RETURN
- END
-#endif
diff --git a/src/packlib/epio/obsolete/cdc/cfribmcd.F b/src/packlib/epio/obsolete/cdc/cfribmcd.F
deleted file mode 100644
index e5d0939..0000000
--- a/src/packlib/epio/obsolete/cdc/cfribmcd.F
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: cfribmcd.F,v 1.1.1.1 1996/03/08 15:21:52 mclareni Exp $
-*
-* $Log: cfribmcd.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:52 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_CDC)||defined(CERNLIB_UNIVAC)
- SUBROUTINE CFRIBM(ARRAY,NW,MODE)
-C.+++++++ CDC AND UNIVAC VERSION ++++++++++
-C. CONVERTS THE FIRST NW WORDS OF ARRAY FROM IBM TO MACHINE FORMAT.
-C. THE NUMBERS MUST BE RIGHT ADJ., ZERO FILLED.
-C. MODE = 1 : CONVERT 16 BIT INTEGERS
-C. = 2 : CONVERT 32 BIT INTEGERS
-C. = 3 : CONVERT 32 BIT FLOATING
- DIMENSION ARRAY( 1)
-C
- IF(NW.LE.0) RETURN
-C
- IF(MODE.EQ.1) CALL I16ITC(ARRAY,NW)
- IF(MODE.EQ.2) CALL CVT360(ARRAY(1),ARRAY(NW),1)
- IF(MODE.EQ.3) CALL CVT360(ARRAY(1),ARRAY(NW),0)
- RETURN
- END
-#endif
diff --git a/src/packlib/epio/obsolete/cdc/ctoasccd.F b/src/packlib/epio/obsolete/cdc/ctoasccd.F
deleted file mode 100644
index 3e57458..0000000
--- a/src/packlib/epio/obsolete/cdc/ctoasccd.F
+++ /dev/null
@@ -1,45 +0,0 @@
-*
-* $Id: ctoasccd.F,v 1.1.1.1 1996/03/08 15:21:52 mclareni Exp $
-*
-* $Log: ctoasccd.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:52 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_CDC)
- SUBROUTINE CTOASC(IARR,NW)
-C.+++++++ CDC VERSION +++++++
-C. CDC INTERNAL ( =DISPLAY ) TO ASCII CODE CONVERSION
-C. INPUT
-C. NW NO. OF CHARACTERS TO CONVERT
-C. I/O
-C. IARR CONTAINS CHARACTERS UNPACKED, RIGHT ADJ., ZERO FILLED
-C. BEFORE AND AFTER CONVERSION IN PLACE.
-#include "epio/asciicdc.inc"
- DIMENSION IARR( 1)
- DATA IFI/0/
- IF(IFI.NE.0) GOTO 10
-C--- INITIALIZE
- CALL CFRASC(IFI,0)
- IFI=1
- 10 CONTINUE
- IF(NW.LE.0) GOTO 77777
- DO 11 I=1,NW
-#if defined(CERNLIB_F4)
- K=AND(IARR(I),77B)
-#endif
-#if !defined(CERNLIB_F4)
- K=AND(IARR(I),O"77")
-#endif
- NP=(K-1)/8
- NB=K-8*NP
-#if defined(CERNLIB_F4)
- 11 IARR(I)=AND(SHIFT(ITASC(NP+1),7*NB),177B)
-#endif
-#if !defined(CERNLIB_F4)
- 11 IARR(I)=AND(SHIFT(ITASC(NP+1),7*NB),O"177")
-#endif
-77777 RETURN
- END
-#endif
diff --git a/src/packlib/epio/obsolete/cdc/ctoibmcd.F b/src/packlib/epio/obsolete/cdc/ctoibmcd.F
deleted file mode 100644
index 0cbaf2c..0000000
--- a/src/packlib/epio/obsolete/cdc/ctoibmcd.F
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: ctoibmcd.F,v 1.1.1.1 1996/03/08 15:21:52 mclareni Exp $
-*
-* $Log: ctoibmcd.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:52 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_CDC)||defined(CERNLIB_UNIVAC)
- SUBROUTINE CTOIBM(ARRAY,NW,MODE)
-C.+++++++ CDC AND UNIVAC VERSION ++++++++++
-C. CONVERTS THE FIRST NW WORDS OF ARRAY INTO IBM FORMAT.
-C. MODE = 1 : CONVERT TO 16 BIT INTEGERS
-C. = 2 : CONVERT TO 32 BIT INTEGERS
-C. = 3 : CONVERT TO 32 BIT FLOATING
-C. ON RETURN,THE CONVERTED NUMBERS ARE IN ARRAY, RIGHT ADJ., ZERO FILLED
- DIMENSION ARRAY( 1)
-C
- IF(NW.LE.0) RETURN
-C
- IF(MODE.EQ.1) CALL I16CTI(ARRAY,NW)
- IF(MODE.EQ.2) CALL FTO360(ARRAY,NW,1)
- IF(MODE.EQ.3) CALL FTO360(ARRAY,NW,0)
- RETURN
- END
-#endif
diff --git a/src/packlib/epio/obsolete/cdc/i16cti.s b/src/packlib/epio/obsolete/cdc/i16cti.s
deleted file mode 100644
index 6d5a184..0000000
--- a/src/packlib/epio/obsolete/cdc/i16cti.s
+++ /dev/null
@@ -1,53 +0,0 @@
-*
-* $Id: i16cti.s,v 1.1.1.1 1996/03/08 15:21:53 mclareni Exp $
-*
-* $Log: i16cti.s,v $
-* Revision 1.1.1.1 1996/03/08 15:21:53 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_CDC)
- IDENT I16CTI
- ENTRY I16CTI
-* SUBROUTINE I16CTI(ARRAY,NWORDS)
-*
-* THE ROUTINE CONVERTS 16 BIT INTEGERS (INCLUDING SIGN) FROM
-* CDC TO IBM FORMAT ( FFFF=-1 ON IBM, 77...77 = -0 ON CDC )
-* AUTHOR H. GROTE CERN DD
-*
-* THE SUBROUTINE EXPECTS TWO PARAMETERS
-* ARRAY- GIVES THE ADDRESS OF THE INPUT/ OUTPUT ARRAY
-* NW - THE NUMBER OF WORDS TO BE CONVERTED
-* A WORD COUNT LE ZERO ACTS AS DO NOTHING.
-*
- TRACE VFD 42/0LI16CTI,18/I16CTI
- STOA0 BSS 1
- I16CTI JP 400000B+*
- SX6 A0
- SA6 STOA0 STORE A0
- SA3 A1 ADDRESS OF FIRST ARGUMENT
- SA4 A1+1 ADDRESS OF SECOND ARGUMENT
- SB1 1
- SA1 X4 SECOND ARGUMENT = NW INTO X1
- IX5 X3+X1
- SB2 X3 ADDRESS OF FIRST WORD
- SB3 X5 ADDRESS OF LAST WORD + 1
- SB4 44 SHIFT CONSTANT
- MX5 44 MASK
- EXS0 GE B2,B3,EXIT EXIT JUMP
- SA1 B2 GET A WORD
- PL X1,CNT JUMP IF POSITIVE ( SIGN BIT TEST)
- NZ X1,EXS1 JUMP IF NOT ZERO (LEAVES -0 )
- SX6 B0 SET -0 TO 0
- EQ STORE
- EXS1 BX4 -X5*X1 MASK
- SX6 X4+B1 DIFFERENT NEG. REP.
- STORE SA6 B2 STORE
- CNT SB2 B2+B1 INCREASE COUNT
- EQ EXS0 LOOP
- EXIT SA1 STOA0
- SA0 X1 RESTORE A0
- EQ I16CTI
- END
-#endif
diff --git a/src/packlib/epio/obsolete/cdc/i16itc.s b/src/packlib/epio/obsolete/cdc/i16itc.s
deleted file mode 100644
index a4afae0..0000000
--- a/src/packlib/epio/obsolete/cdc/i16itc.s
+++ /dev/null
@@ -1,50 +0,0 @@
-*
-* $Id: i16itc.s,v 1.1.1.1 1996/03/08 15:21:53 mclareni Exp $
-*
-* $Log: i16itc.s,v $
-* Revision 1.1.1.1 1996/03/08 15:21:53 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_CDC)
- IDENT I16ITC
- ENTRY I16ITC
-* SUBROUTINE I16ITC(ARRAY,NWORDS)
-*
-* THE ROUTINE CONVERTS 16 BIT INTEGERS (INCLUDING SIGN) FROM
-* IBM TO CDC FORMAT ( FFFF=-1 ON IBM, 77...77 = -0 ON CDC )
-* AUTHOR H. GROTE CERN DD
-*
-* THE SUBROUTINE EXPECTS TWO PARAMETERS
-* ARRAY- GIVES THE ADDRESS OF THE INPUT/ OUTPUT ARRAY
-* NW - THE NUMBER OF WORDS TO BE CONVERTED
-* A WORD COUNT LE ZERO ACTS AS DO NOTHING.
-*
- TRACE VFD 42/0LI16ITC,18/I16ITC
- STOA0 BSS 1
- I16ITC JP 400000B+*
- SX6 A0
- SA6 STOA0 STORE A0
- SA3 A1 ADDRESS OF FIRST ARGUMENT
- SA4 A1+1 ADDRESS OF SECOND ARGUMENT
- SB1 1
- SA1 X4 SECOND ARGUMENT = NW INTO X1
- IX5 X3+X1
- SB2 X3 ADDRESS OF FIRST WORD
- SB3 X5 ADDRESS OF LAST WORD + 1
- SB4 44 SHIFT CONSTANT
- EXS0 GE B2,B3,EXIT EXIT JUMP
- SA1 B2 GET A WORD
- LX3 B4,X1 LEFT SHIFT 44 POS.
- PL X3,CNT JUMP IF POSITIVE
- AX4 B4,X3 RIGHT SHIFT AND SIGN EXT. 44 POS.
- SX6 X4-1 BECAUSE OF DIFF. NEG. REP.
- SA6 B2 STORE
- CNT SB2 B2+B1 INCREASE COUNT
- EQ EXS0 LOOP
- EXIT SA1 STOA0
- SA0 X1 RESTORE A0
- EQ I16ITC
- END
-#endif
diff --git a/src/packlib/epio/obsolete/cdc/iwd16cdc.F b/src/packlib/epio/obsolete/cdc/iwd16cdc.F
deleted file mode 100644
index a0b6cbf..0000000
--- a/src/packlib/epio/obsolete/cdc/iwd16cdc.F
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: iwd16cdc.F,v 1.1.1.1 1996/03/08 15:21:53 mclareni Exp $
-*
-* $Log: iwd16cdc.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:53 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_CDC)
- FUNCTION IWD16(A,N)
-C. ++++++ CDC VERSION +++++
-C. FUNCTION RETURNS THE 16 BIT WORD NO. N OF STRING A.
-C. THE FIRST 16 BIT WORD COINCIDES WITH THE START OF A.
- DIMENSION A(N)
- DATA IMWD/60/
- DATA IUSWD/16/
-C--- MACHINE WORD WHERE USER WORD STARTS
- NW=(IUSWD*(N-1))/IMWD+1
-C--- LEFT SHIFT IN ORDER TO GET USER WORD RIGHT ADJUSTED
-C--- ( NEGATIVE LEFT SHIFT MEANS RIGHT SHIFT )
- KL=N*IUSWD-NW*IMWD
- M=SHIFT(A(NW),KL)
- IF(KL.LE.0) GOTO 1
-C--- STILL KL BITS IN NEXT MACHINE WORD
- M=OR(AND(MASK(IMWD-KL),M),SHIFT(AND(MASK(KL),A(NW+1)),KL))
- 1 CONTINUE
- IWD16=AND(COMPL(MASK(IMWD-IUSWD)),M)
- RETURN
- END
-#endif
diff --git a/src/packlib/epio/obsolete/cdc/sfrasccd.F b/src/packlib/epio/obsolete/cdc/sfrasccd.F
deleted file mode 100644
index 75875fe..0000000
--- a/src/packlib/epio/obsolete/cdc/sfrasccd.F
+++ /dev/null
@@ -1,209 +0,0 @@
-*
-* $Id: sfrasccd.F,v 1.1.1.1 1996/03/08 15:21:52 mclareni Exp $
-*
-* $Log: sfrasccd.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:52 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_CDC)
- IDENT SFRASC
- SPACE 2
-*** SUBROUTINE SFRASC(SOURCE,N1,TARGET,N2,NCH)
-*
-* SFRASC CONVERTS A STRING OF 8-BIT ASCII CHARACTERS
-* INTO A STRING OF 6-BIT DISPLAY CHARACTERS.
-*
-* PARAMETERS
-* SOURCE SOURCE ARRAY
-* N1 FIRST CHARACTER IN SOURCE TO CONVERT
-* TARGET TARGET ARRAY
-* N2 FIRST 6-BIT BYTE IN TARGET TO STORE IN
-* NCH NO. OF CHARACTERS TO CONVERT
-*
-*
-*
-*
-* H. GROTE/CERN 14 MARCH 1983
- SPACE 3
- ENTRY SFRASC
- SPACE 1
- LIST G
- SPACE 2
- SFRCHTR VFD 42/0LSFRASC,18/SFRASC
- SFRCHA0 BSS 1
- SFRCHA1 BSS 1
- FIRST DATA 0
- ZERO DATA 0
- ARG BSS 2
- USE /ASCIIC/
- ITASC BSS 8
- ITCDC BSS 16
- USE CODE.
- EXT CFRASC
- SFRASC JP 400000B+*
- SX6 A0
- SA0 A1 A0=PARAMETER LIST ADDRESS
- SA6 SFRCHA0 SAVE OLD A0
-*
-* CALL CFRASC FOR COMMON BLOCK INIT. FIRST TIME
-*
- SA1 FIRST
- SB1 X1
- GT B1,B0,START SKIP IF NOT FIRST TIME
- SX6 1
- SA6 FIRST
- SA1 ZERO
- SX6 A1
- SA6 ARG
- SA6 ARG+1B
- SA1 ARG
- SX6 A0
- SA6 SFRCHA1
- RJ CFRASC
- SA1 SFRCHA1
- SA0 X1
-START SB1 1 CONSTANT B1=1
- SB2 60 CONSTANT B2=60
- SA5 A0+B1 N1 = STARTING BYTE IN SOURCE
- SA5 X5
- SX3 B2
- SB3 3
- PX0 B0,X3
- NX6 B0,X0 60. IN FLOATING
- BX1 X6 KEEP IN X1
- SX4 1
- IX0 X5-X4 N1-1
- LX0 B3,X0 8*(N1-1)
- PX5 B0,X0 8*(N1-1) IN FLOATING
- FX4 X5/X6
- UX5 B6,X4
- LX6 B6,X5 8*(N1-1)/60 IN INTEGER
- SB7 X6 ADDRESS OF FIRST WORD REL. TO SOURCE
- DX5 X3*X6
- IX4 X0-X5 STARTING BIT -1 IN WORD
- SB5 X4 KEEP STARTING BIT IN SOURCE WORD
- SA5 A0+B3 N2 = FIRST CH. IN TARGET
- SB3 2
- SA5 X5
- SX4 1
- IX0 X5-X4 N2-1
- LX4 B3,X0
- LX0 B1,X0
- IX0 X0+X4 6*(N2-1)
- PX5 B0,X0
- FX4 X5/X1
- UX5 B6,X4
- LX6 B6,X5
- SB2 X6 FIRST WORD IN TARGET
- DX5 X3*X6
- IX7 X0-X5 STARTING BIT IN TARGET
- SB6 X7 STORE IN B6
- SA1 A0 READ SOURCE ADDRESS
- SA2 A1+B3 READ TARGET ADDRESS
- SA3 A2+B3 READ ADDRESS OF NUMBER OF BYTES
- SA5 X1+B7 FIRST SOURCE WORD
- SA0 X2+B2 A0=TARGET WORD ADDRESS
- SB2 60
- SA3 X3 READ NUMBER OF BYTES
- SB3 X3 B3=BYTE COUNTER
- SB4 6 B4=NUMBER OF BITS PER BYTE IN TARGET
- LE B3,B0,SFRCH4 RETURN IF NUMBER OF BYTES.LE.0
- EQ B6,B0,SFRCH7
- SA2 A0 FIRST TARGET WORD
- MX7 1
- SB7 B6-1
- AX0 B7,X7 MASK
- BX6 X0*X2 MASK FIRST TARGET WORD
- EQ SFRCH8
- SFRCH7 SX6 B0 CLEAR TARGET WORD IF AT LEFT BOUNDARY
- SFRCH8 SB6 B2-B6 B6 = # BITS LEFT TO FILL IN TARGET WORD
- SX1 77B CHARACTER MASK
- SX7 177B ASCII CHARACTER MASK
- SB7 8 CHARACTER LENGTH IN SOURCE
- LX5 B5,X5 FIRST CHARACTER TO LEFT BOUNDARY IN X5
- SPACE 2
-** MAIN LOOP - ONCE PER BYTE
-*
-* REGISTER CONVENTIONS
-* X1 DISPLAY CHARACTER MASK
-* X5 SOURCE WORD
-* X6 TARGET WORD
-* X7 ASCII CHARACTER MASK
-*
-* A0 TARGET WORD ADDRESS
-* A5 SOURCE WORD ADDRESS
-*
-* B1 1
-* B2 60
-* B3 BYTE COUNTER
-* B4 6
-* B5 BIT POSITION IN SOURCE WORD
-* B6 BIT POSITION IN TARGET WORD
-* B7 8
-*
- SPACE 2
- SFRCH1 SB6 B6-B4 DECREMENT # BITS LEFT TO FILL
- LE B3,B0,SFRCH3 JUMP IF LAST BYTE HAS BEEN MOVED
- LX5 B7,X5 NEXT CHARACTER RIGHT ADJUSTED
- SB5 B5+B7 COUNT BITS IN SOURCE WORD
- BX2 X7*X5 MASK CHARACTER INTO X2 RIGHT ADJ.
- GT B2,B5,SFRCH2 JUMP IF SOURCE WORD NOT COMPLETED
- SB5 B5-B2 RESET SOURCE WORD BIT COUNTER
- SA5 A5+B1 LOAD NEXT SOURCE WORD
- EQ B5,B0,SFRCH2 JUMP IF PREVIOUS BYTE COMPLETE
- SB4 4
- LX5 B4,X5 LEFT ADJUST NEXT BYTE
- SX0 17B MASK FOR HALF BYTE
- BX2 -X0*X2
- BX0 X0*X5
- BX2 X2+X0 ADD TO FIRST PART OF BYTE
- SB4 6
-*
-* FOR CONVERSION, SEE ROUTINES CTOASC, CFRASC
-*
- SFRCH2 SB2 X2-1
- SX3 B2
- SB2 3
- AX3 B2,X3 (K-1)/8
- SB1 X3
- LX3 B2,X3
- IX3 X2-X3
- SX4 B4 = 6
- DX3 X4*X3
- SB2 X3
- SA4 ITCDC+B1
- LX4 B2,X4
- BX2 X4*X1
- SB1 1
- SB2 60
- LX3 B6,X2 POSITION SOURCE BYTE
- SB3 B3-B1 DECREMENT BYTE COUNTER
- BX6 X6+X3 ADD SOURCE BYTE TO TARGET WORD
- GT B6,B0,SFRCH1 LOOP UNLESS TARGET WORD IS FULL
- SA6 A0 STORE TARGET WORD
- SB6 B2 RESET BIT POSITION
- SA0 A0+B1 INCREMENT TARGET ADDRESS
- SX6 B0 RESET X6 FOR NEXT TARGET WORD ASSEMBLY
- EQ SFRCH1 LOOP
- SPACE 2
-** END OF LOOP - STORE INCOMPLETE TARGET WORD, IF ANY,
-* AND RETURN
- SPACE 2
- SFRCH3 SB7 B6+B4 BIT POSITION OF LAST BYTE
- EQ B7,B2,SFRCH4 RETURN IF TARGET WORD IS EMPTY
- SB3 B2-B7
- SB7 B3-B1
- MX7 1
- AX7 B7,X7 MASK FOR LAST TARGET WORD
- SA2 A0 GET LAST TARGET WORD
- BX3 -X7*X2
- BX6 X6+X3 JOIN TARGET WORD WITH REST OF BYTE
- SA6 A0 STORE LAST TARGET WORD
- SFRCH4 SA4 SFRCHA0
- SA0 X4 RESTORE OLD A0
- EQ SFRASC RETURN
- SPACE 2
- END
-#endif
diff --git a/src/packlib/epio/obsolete/cdc/shlgepcd.F b/src/packlib/epio/obsolete/cdc/shlgepcd.F
deleted file mode 100644
index d1a180f..0000000
--- a/src/packlib/epio/obsolete/cdc/shlgepcd.F
+++ /dev/null
@@ -1,83 +0,0 @@
-*
-* $Id: shlgepcd.F,v 1.1.1.1 1996/03/08 15:21:52 mclareni Exp $
-*
-* $Log: shlgepcd.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:52 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_CDC)
- IDENT SHLGEP
- ENTRY SHLGEP
-* SUBROUTINE SHLGEP(IA,NW,NBIT)
-* PERFORMS A LONG LEFT SHIFT (NBIT GT 0) OR RIGHT SHIFT
-* ( NB LT 0 ) CIRCULAR ON IA(1)...IA(NW)
-*
- TRACE VFD 42/0LSHLGEP,18/SHLGEP
- SHA0 DATA 0
- SHLGEP JP 400000B+*
- SX6 A0
- SA0 A1
- SA6 SHA0 SAVE A0
- SB1 1
- SA2 A0+1 ADDRESS OF NW TO X2
- SB2 59
- SA3 A0+2 ADDRESS OF NBIT TO X3
- SA2 X2 NW TO X2
- SA3 X3 NBIT TO X3
- SB3 X2-1 NW-1 TO B3
- LT B3,B0,RETURN RETURN IF NW LE 0
- SB4 X3 NBIT TO B4
- SB5 B4
- GE B4,B0,CONT1 JUMP IF B4 GE 0
- SB5 B0-B4 IABS(NBIT) TO B5
- CONT1 EQ B5,B0,RETURN RETURN IF NBIT EQ 0
- GT B5,B2,RETURN RETURN IF NBIT GE 60
- GE B4,B0,POSIT JUMP IF NBIT GT 0
-* RIGHT CIRCULAR SHIFT
- SB4 B4+B2 NO. OF MASK BITS -1
- MX7 1
- AX0 B4,X7 MASK1 TO X0
- SB4 B4+B1 SHIFT COUNT IN BITS
- SA1 A0 ADDRESS OF IA(1) TO X1
- SA4 X1+B3 KEEP LAST WORD IN X4
- SB6 X1 ADDRESS IA(1)
- SB7 A4 ADDRESS IA(NW)
- NLOOP LT B7,B6,RETURN END LOOP
- SA2 B7 ADDR.(IA(I2)) TO A2, IA(I2) TO X2
- SB7 B7-B1 ADDR.(IA(I1))
- BX3 X4 LAST WORD IF AT END OF LOOP
- LT B7,B6,NLOOP1
- SA3 B7 REPLACE LAST WORD BY IA(I1) IN X3
- NLOOP1 BX5 X0*X2 AND(MASK1,IA(I2))
- BX6 -X0*X3 AND(MASK2,IA(I1))
- BX7 X5+X6 OR
- LX6 B4,X7 LEFT SHIFT
- SA6 A2 STORE IN IA(I2)
- EQ NLOOP LOOP
-* LEFT SHIFT
- POSIT SB5 B4-B1
- MX7 1
- AX0 B5,X7 MASK1 TO X0
- SA1 A0 ADDR.(IA(1)) TO X1
- SA4 X1 KEEP FIRST WORD IN X4
- SB6 X1 ADDR. IA(1)
- SB7 X1+B3 ADDR. IA(NW)
- PLOOP GT B6,B7,RETURN
- SA2 B6 ADDR.(IA(I2)) TO A2, IA(I2) TO X2
- SB6 B6+B1 ADDR(IA(I1))
- BX3 X4 TAKE LAST WORD AT END OF LOOP
- GT B6,B7,PLOOP1
- SA3 B6 IA(I1) TO X3
- PLOOP1 BX5 -X0*X2 AND(MASK2,IA(I2))
- BX6 X0*X3 AND(MASK1,IA(I1))
- BX7 X5+X6 OR
- LX6 B4,X7 LEFT SHIFT
- SA6 A2 STORE IN IA(I2)
- EQ PLOOP
- RETURN SA1 SHA0
- SA0 X1 RESTORE A0
- EQ SHLGEP RETURN
- END
-#endif
diff --git a/src/packlib/epio/obsolete/cdc/stoasccd.F b/src/packlib/epio/obsolete/cdc/stoasccd.F
deleted file mode 100644
index 9435f40..0000000
--- a/src/packlib/epio/obsolete/cdc/stoasccd.F
+++ /dev/null
@@ -1,202 +0,0 @@
-*
-* $Id: stoasccd.F,v 1.1.1.1 1996/03/08 15:21:52 mclareni Exp $
-*
-* $Log: stoasccd.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:52 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_CDC)
- IDENT STOASC
- SPACE 2
-*** SUBROUTINE STOASC(SOURCE,N1,TARGET,N2,NCH)
-*
-* STOASC CONVERTS A STRING OF CDC DISPLAY CHARACTERS
-* INTO A STRING OF 8-BIT ASCII CHARACTERS.
-*
-* PARAMETERS
-* SOURCE SOURCE ARRAY
-* N1 FIRST CHARACTER IN SOURCE TO CONVERT
-* TARGET TARGET ARRAY
-* N2 FIRST 8-BIT BYTE IN TARGET TO STORE IN
-* NCH NO. OF CHARACTERS TO CONVERT
-*
-*
-*
-*
-* H. GROTE/CERN 14 MARCH 1983
- SPACE 3
- ENTRY STOASC
- SPACE 1
- LIST G
- SPACE 2
- STOCHTR VFD 42/0LSTOASC,18/STOASC
- STOCHA0 BSS 1
- STOCHA1 BSS 1
- FIRST DATA 0
- ZERO DATA 0
- ARG BSS 2
- USE /ASCIIC/
- ITASC BSS 8
- ITCDC BSS 16
- USE CODE.
- EXT CFRASC
- STOASC JP 400000B+*
- SX6 A0
- SA0 A1 A0=PARAMETER LIST ADDRESS
- SA6 STOCHA0 SAVE OLD A0
-*
-* CALL CFRASC FOR COMMON BLOCK INIT. FIRST TIME
-*
- SA1 FIRST
- SB1 X1
- GT B1,B0,START SKIP IF NOT FIRST TIME
- SX6 1
- SA6 FIRST
- SA1 ZERO
- SX6 A1
- SA6 ARG
- SA6 ARG+1B
- SA1 ARG
- SX6 A0
- SA6 STOCHA1
- RJ CFRASC
- SA1 STOCHA1
- SA0 X1
-START SB1 1 CONSTANT B1=1
- SB2 60 CONSTANT B2=60
- SA5 A0+3 N2 = STARTING BYTE IN TARGET
- SA5 X5
- SX3 B2
- SB3 3
- PX0 B0,X3
- NX6 B0,X0 60. IN FLOATING
- BX1 X6 KEEP IN X1
- SX4 1
- IX0 X5-X4 N2-1
- LX0 B3,X0 8*(N2-1)
- PX5 B0,X0 8*(N2-1) IN FLOATING
- FX4 X5/X6
- UX5 B6,X4
- LX6 B6,X5 8*(N2-1)/60 IN INTEGER
- SB7 X6 ADDRESS OF FIRST WORD REL. TO TARGET
- DX5 X3*X6
- IX4 X0-X5 STARTING BIT -1 IN WORD
- SB5 X4 KEEP STARTING BIT IN TARGET WORD
- SB3 2
- SA5 A0+1 N1 = FIRST CH. IN SOURCE
- SA5 X5
- SX4 1
- IX0 X5-X4 N1-1
- LX4 B3,X0
- LX0 B1,X0
- IX0 X0+X4 6*(N1-1)
- PX5 B0,X0
- FX4 X5/X1
- UX5 B6,X4
- LX6 B6,X5
- SB2 X6 FIRST WORD IN SOURCE
- DX5 X3*X6
- IX7 X0-X5 STARTING BIT IN SOURCE
- SB6 X7 STORE IN B6
- SA1 A0 READ SOURCE ADDRESS
- SA2 A1+B3 READ TARGET ADDRESS
- SA3 A2+B3 READ ADDRESS OF NUMBER OF BYTES
- SA5 X1+B2 FIRST SOURCE WORD
- SB2 60
- SA0 X2+B7 A0=TARGET WORD ADDRESS
- SA3 X3 READ NUMBER OF BYTES
- SB3 X3 B3=BYTE COUNTER
- SB4 8 B4=NUMBER OF BITS PER BYTE
- LE B3,B0,STOCH4 RETURN IF NUMBER OF BYTES.LE.0
- EQ B5,B0,STOCH7
- SA2 A0 FIRST TARGET WORD
- MX7 1
- SB7 B5-1
- AX0 B7,X7 MASK
- BX6 X0*X2 MASK FIRST TARGET WORD
- EQ STOCH8
- STOCH7 SX6 B0 CLEAR TARGET WORD IF AT LEFT BOUNDARY
- STOCH8 SB5 B2-B5 B5=BIT POSITION IN TARGET WORD
- SX7 77B CHARACTER MASK
- SX1 177B ASCII CHARACTER MASK
- SB7 6 CHARACTER LENGTH
- LX5 B6,X5 FIRST CHARACTER TO LEFT BOUNDARY IN X5
- SPACE 2
-** MAIN LOOP - ONCE PER BYTE
-*
-* REGISTER CONVENTIONS
-* X1 ASCII CHARACTER MASK
-* X5 SOURCE WORD
-* X6 TARGET WORD
-* X7 DISPLAY CHARACTER MASK
-*
-* A0 TARGET WORD ADDRESS
-* A5 SOURCE WORD ADDRESS
-*
-* B1 1
-* B2 60
-* B3 BYTE COUNTER
-* B4 8
-* B5 BIT POSITION IN TARGET WORD
-* B6 BIT POSITION IN SOURCE WORD
-* B7 6
-*
- SPACE 2
- STOCH1 SB5 B5-B4 DECREMENT BIT POSITION
- LE B3,B0,STOCH3 JUMP IF LAST BYTE HAS BEEN MOVED
- LX5 B7,X5 NEXT CHARACTER RIGHT ADJUSTED
- SB6 B6+B7 COUNT BITS
- BX2 X7*X5 MASK CHARACTER INTO X2 RIGHT ADJ.
- GT B2,B6,STOCH2 JUMP IF SOURCE WORD NOT COMPLETED
- SB6 B0 RESET SOURCE WORD BIT COUNTER
- SA5 A5+B1 LOAD NEXT SOURCE WORD
-*
-* FOR CONVERSION, SEE ROUTINES CTOASC, CFRASC
-*
- STOCH2 SB2 X2-1
- SX3 B2
- SB2 3
- AX3 B2,X3 (K-1)/8
- SB1 X3
- LX3 B2,X3
- IX3 X2-X3
- SX4 7
- DX3 X4*X3
- SB2 X3
- SA4 ITASC+B1
- LX4 B2,X4
- BX2 X4*X1
- SB1 1
- SB2 60
- LX3 B5,X2 POSITION SOURCE BYTE (END-OFF)
- SB3 B3-B1 DECREMENT BYTE COUNTER
- BX6 X6+X3 ADD SOURCE BYTE TO TARGET WORD
- GT B5,B0,STOCH1 LOOP UNLESS TARGET WORD IS FULL
- SA6 A0 STORE TARGET WORD
- SB5 B5+B2 RESET BIT POSITION (ADD 60)
- SA0 A0+B1 INCREMENT TARGET ADDRESS
- LX4 B5,X2 POSITION SOURCE BYTE (CIRCULARLY)
- BX6 X4-X3 STORE BOTTOM OF SOURCE BYTE IN TARGET
- EQ STOCH1 LOOP
- SPACE 2
-** END OF LOOP - STORE INCOMPLETE TARGET WORD, IF ANY,
-* AND RETURN
- SPACE 2
- STOCH3 SB7 B5+B4 BIT POSITION OF LAST BYTE
- EQ B7,B2,STOCH4 RETURN IF TARGET WORD IS EMPTY
- SB3 B2-B7
- SB7 B3-B1
- MX7 1
- AX7 B7,X7 MASK FOR LAST TARGET WORD
- SA2 A0 GET LAST TARGET WORD
- BX3 -X7*X2
- BX6 X6+X3 JOIN TARGET WORD WITH REST OF BYTE
- SA6 A0 STORE LAST TARGET WORD
- STOCH4 SA4 STOCHA0
- SA0 X4 RESTORE OLD A0
- EQ STOASC RETURN
- SPACE 2
- END
-#endif
diff --git a/src/packlib/epio/obsolete/cdc/w16movcd.F b/src/packlib/epio/obsolete/cdc/w16movcd.F
deleted file mode 100644
index 3227a7d..0000000
--- a/src/packlib/epio/obsolete/cdc/w16movcd.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: w16movcd.F,v 1.1.1.1 1996/03/08 15:21:52 mclareni Exp $
-*
-* $Log: w16movcd.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:52 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_CDC)||defined(CERNLIB_UNIVAC)
- SUBROUTINE W16MOV(SOURCE,N1,TARGET,N2,N3)
-C.+++++++ CDC AND UNIVAC VERSION ++++++++++
-C. MOVES 16 BIT WORDS IN PACKED FORM.
-C.
-C. INPUT
-C. SOURCE SOURCE ARRAY
-C. N1 STARTING 16 BIT WORD IN SOURCE
-C. TARGET TARGET ARRAY
-C. N2 STARTING 16 BIT WORD IN TARGET
-C. N3 NO. OF 16 BIT WORDS TO MOVE
-C.
- INTEGER SOURCE(2),TARGET(2)
- CALL BTMVEP(SOURCE,16*(N1-1)+1,TARGET,16*(N2-1)+1,16*N3)
- RETURN
- END
-#endif
diff --git a/src/packlib/epio/obsolete/convex/cfribmcv.F b/src/packlib/epio/obsolete/convex/cfribmcv.F
deleted file mode 100644
index f462174..0000000
--- a/src/packlib/epio/obsolete/convex/cfribmcv.F
+++ /dev/null
@@ -1,70 +0,0 @@
-*
-* $Id: cfribmcv.F,v 1.1.1.1 1996/03/08 15:21:53 mclareni Exp $
-*
-* $Log: cfribmcv.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:53 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if (defined(CERNLIB_CONVEX))&&(!defined(CERNLIB_DOUBLE))
-#ifdef CERNLIB_UTIL_CFRIBMSF
-#undef CERNLIB_UTIL_CFRIBMSF
-#endif
- SUBROUTINE CFRIBM(A,NW,MODE)
- DIMENSION A(2)
-C W.W. 17/04/84 SACLAY/DPHPE
-C
- EQUIVALENCE (AMM,MM)
- DATA ANORM / 0. /
- DATA NBDCON / 0 /
-C
- IF(NW.LE.0) RETURN
-C
- DO 49 JV = 1, NW
- AMM = A(JV)
-C
- IF(MODE.EQ.1) GO TO 11
- IF(MODE.EQ.2) GO TO 21
- IF(MODE.EQ.3) GO TO 31
- GO TO 49
-C
-C-- IF INTEGER 16 BIT
-C
- 11 JSIGN = JBIT(MM,16)
- IF(JSIGN.EQ.1) MM = MM .OR. MASK(48)
- GO TO 48
-C
-C-- IF INTEGER 32 BIT
-C
- 21 JSIGN = JBIT(MM,32)
- IF(JSIGN.EQ.1) MM = MM .OR. MASK(32)
- GO TO 48
-C
-C-- IF FLOATING
-C-- ALGORITHM TAKEN FROM HYDRA 3.43/2
-C
- 31 IF(MM .EQ. MASK(128-31)) GO TO 44
- JSIGN = JBIT(MM,32)
- JEXP = (JBYT(MM,25,7)-64) * 4
- JMAN = ISHFT(MM,40)
- MM = JMAN .OR. (JEXP + '40000'O)
- MM = ISHFTC(MM,49,64) .OR. JSIGN
- MM = ISHFTC(MM,63,64)
-C
-C-- ADD ZERO TO NORMALIZE
-C
- AMM = AMM + ANORM
- GO TO 48
-C
-C---- BAD CONVERSION
-C
- 44 MM = '70000 77000000 37000000'O
- NBDCON = NBDCON + 1
-C
- 48 A(JV) = AMM
- 49 CONTINUE
-C
- RETURN
- END
-#endif
diff --git a/src/packlib/epio/obsolete/convex/ctoibcvx.F b/src/packlib/epio/obsolete/convex/ctoibcvx.F
deleted file mode 100644
index cbfa618..0000000
--- a/src/packlib/epio/obsolete/convex/ctoibcvx.F
+++ /dev/null
@@ -1,93 +0,0 @@
-*
-* $Id: ctoibcvx.F,v 1.1.1.1 1996/03/08 15:21:53 mclareni Exp $
-*
-* $Log: ctoibcvx.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:53 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if (defined(CERNLIB_CONVEX))&&(!defined(CERNLIB_DOUBLE))
-#ifdef CERNLIB_UTIL_CTOIBSTF
-#undef CERNLIB_UTIL_CTOIBSTF
-#endif
- SUBROUTINE CTOIBM(A,NW,MODE)
- DIMENSION A(2)
-C W.W. 17/04/84 SACLAY/DPHPE
-C
- EQUIVALENCE (AMM,MM)
- DATA NBDCON / 0 /
-C
- IF(NW.LE.0) RETURN
-C
- DO 49 JV = 1, NW
- AMM = A(JV)
-C
- IF(MODE.EQ.1) GO TO 11
- IF(MODE.EQ.2) GO TO 21
- IF(MODE.EQ.3) GO TO 31
- GO TO 49
-C
-C-- IF INTEGER 16 BIT
-C
- 11 MM = MM .AND. MASK(128-16)
- GO TO 48
-C
-C-- IF INTEGER 32 BIT
-C
- 21 MM = MM .AND. MASK(128-32)
- GO TO 48
-C
-C-- IF FLOATING
-C-- ALGORITHM TAKEN FROM HYDRA 3.43/2
-C
- 31 JSIGN = ISHFT(MM,-63)
- JEXP = JBYT(MM,49,15)
- IF(JEXP.EQ.0) GO TO 48
- IF(JEXP.LT.'20000'O) GO TO 37
- IF(JEXP.GE.'60000'O) GO TO 37
-C
- J = (JEXP+3) / 4
- JSH = 4*J - JEXP
- JEXP= J - '10000'O
-C
-C-- 25-BIT MANTISSA, ROUND IF LAST BIT IS 1
-C
- JMAN = ISHFT (MM,16)
- JMAN = ISHFT (JMAN,-39-JSH)
- JRND = ISHFT (JMAN,63)
- JRND = ISHFTC(JRND,1,64)
- JMAN = JMAN + JRND
- IF(ISHFT (JMAN,-25).EQ.0) GO TO 33
-C
-C-- ROUNDING WITH CARRY INTO EXPONENT FIELD
-C
- JEXP = JEXP + 1
- JMAN = ISHFT (JMAN,-4)
- JRND = ISHFT (JMAN,63)
- JRND = ISHFTC(JRND,1,64)
- JMAN = JMAN + JRND
-C
- 33 IF(JEXP.LT.-63) GO TO 35
- IF(JEXP.GE. 64) GO TO 37
- MM = ISHFT (JMAN,32) .OR. JSIGN
- MM = ISHFTC(MM,7,64) .OR. (JEXP+64)
- MM = ISHFTC(MM,24,64)
- GO TO 48
-C
-C-- UNDERFLOW
-C
- 35 MM = 0
- GO TO 48
-C
-C-- OVERFLOW
-C
- 37 MM = MASK(128-31)
- NBDCON = NBDCON + 1
-C
- 48 A(JV) = AMM
- 49 CONTINUE
-C
- RETURN
- END
-#endif
diff --git a/src/packlib/epio/obsolete/cray/blo16cra.F b/src/packlib/epio/obsolete/cray/blo16cra.F
deleted file mode 100644
index 0b733d7..0000000
--- a/src/packlib/epio/obsolete/cray/blo16cra.F
+++ /dev/null
@@ -1,60 +0,0 @@
-*
-* $Id: blo16cra.F,v 1.1.1.1 1996/03/08 15:21:54 mclareni Exp $
-*
-* $Log: blo16cra.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:54 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_CRAY)
-CDECK,BLO16CRA,IF=CRAY,CONVEX.
- SUBROUTINE BLO16W(SOURCE,N1,TARGET,N2,N3)
- INTEGER SOURCE(*),TARGET(*)
-C
-C CRAY version to do BLO16W with NO external calls.
-C
-C N.McCubbin 17-Mar-87
-C Revised F.Carminati 23-Jun-87
-C F.Carminati 02-Jun-89
-C
-C Input SOURCE array is a CONTIGUOUS bit string N3*16 bits long
-C starting at 16-BIT POSITION N1 in the array SOURCE.
-C This bit string is BLOWN (unpacked) into N3 computer words
-C starting at TARGET(N2). Each word of TARGET then contains
-C 16 bits, right justified.
-C
-C 16-bit word number within Computer word increases
-C as one goes from Most Significant Bit (MSB) to LSB.
-C i.e.
-C 63 48 47 32 31 16 15 0
-C -----------------------------------------------
-C | 1 | 2 | 3 | 4 |
-C -----------------------------------------------
-C
- IF(N3 .LE. 0) GO TO 999
-C
-C SOURCE word
- IWSRC = (N1-1)/4
- I16SRC = N1-IWSRC*4
- IWSRC = IWSRC+1
- NBITR = (4-I16SRC)*16
-C
- DO 10 IWTGT=N2,N2+N3-1
-C
-C Extract 16-bit word from source
- JWD16 = ISHFT(SOURCE(IWSRC),-NBITR)
- TARGET(IWTGT) = IAND(JWD16,65535)
-C
-C
- IF(NBITR.EQ.0) THEN
- NBITR = 48
- IWSRC = IWSRC + 1
- ELSE
- NBITR = NBITR - 16
- ENDIF
-C
- 10 CONTINUE
-C
- 999 END
-#endif
diff --git a/src/packlib/epio/obsolete/cray/blo32old.F b/src/packlib/epio/obsolete/cray/blo32old.F
deleted file mode 100644
index c18defc..0000000
--- a/src/packlib/epio/obsolete/cray/blo32old.F
+++ /dev/null
@@ -1,70 +0,0 @@
-*
-* $Id: blo32old.F,v 1.1.1.1 1996/03/08 15:21:55 mclareni Exp $
-*
-* $Log: blo32old.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:55 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if (defined(CERNLIB_CRAY))&&(defined(CERNLIB_NEVER))
-CDECK,BLO32CRA,IF=CRAY,CONVEX
- SUBROUTINE BLO32W(SOURCE,N1,TARGET,N2,N3)
- INTEGER SOURCE(*),TARGET(*)
-C
-C CRAY version to do BLO32W with NO external calls.
-C
-C N.McCubbin 17-Mar-87
-C Revised F.Carminati 23-Jun-87
-C F.Carminati 02-Jun-89
-C
-C Input SOURCE array is a CONTIGUOUS bit string N3*32 bits long
-C starting at 16-BIT POSITION N1 in the array SOURCE.
-C This bit string is BLOWN (unpacked) into N3 computer words
-C starting at TARGET(N2). Each word of TARGET then contains
-C 32 bits, right justified.
-C
-C 16-bit word number within Computer word increases
-C as one goes from Most Significant Bit (MSB) to LSB.
-C i.e.
-C 63 48 47 32 31 16 15 0
-C -----------------------------------------------
-C | 1 | 2 | 3 | 4 |
-C -----------------------------------------------
-C
- IF(N3 .LE. 0) GO TO 999
-C
-C SOURCE word and 16-bit within word
- IWSRC = (N1-1)/4
- I16SRC = N1-IWSRC*4
- IWSRC = IWSRC+1
- NBITR = (4-I16SRC)*16
-C
- DO 10 IWTGT = N2,N2+N3-1
-C
-C Extract 16-bit word from source
- TARGET(IWTGT) = ISHFT(SOURCE(IWSRC),-NBITR)
- TARGET(IWTGT) = ISHFT(IAND(TARGET(IWTGT),65535),16)
-C
- IF(NBITR.EQ.0) THEN
- NBITR = 48
- IWSRC = IWSRC+1
- ELSE
- NBITR = NBITR-16
- ENDIF
-C
-C Extract 16-bit word from source
- JWD16 = ISHFT(SOURCE(IWSRC),-NBITR)
- TARGET(IWTGT) = IOR(IAND(JWD16,65535),TARGET(IWTGT))
-C
- IF(NBITR.EQ.0) THEN
- NBITR = 48
- IWSRC = IWSRC+1
- ELSE
- NBITR = NBITR-16
- ENDIF
-C
- 10 CONTINUE
-C
- 999 END
-#endif
diff --git a/src/packlib/epio/obsolete/cray/blo32wcr.F b/src/packlib/epio/obsolete/cray/blo32wcr.F
deleted file mode 100644
index c249d90..0000000
--- a/src/packlib/epio/obsolete/cray/blo32wcr.F
+++ /dev/null
@@ -1,71 +0,0 @@
-*
-* $Id: blo32wcr.F,v 1.1.1.1 1996/03/08 15:21:54 mclareni Exp $
-*
-* $Log: blo32wcr.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:54 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_CRAY)
- SUBROUTINE BLO32W(SOURCE,N1,TARGET,N2,N3)
-C
-C CRAY version to do BLO32W with NO external calls.
-C
-C N.McCubbin 17-Mar-87
-C Revised F.Carminati 23-Jun-87
-C F.Carminati 02-Jun-89
-C M.J.Corden 30-Jan-91
-C H. Grote 04-Apr-91
-C
-C Input SOURCE array is a CONTIGUOUS bit string N3*32 bits long
-C starting at 16-BIT POSITION N1 in the array SOURCE.
-C This bit string is BLOWN (unpacked) into N3 computer words
-C starting at TARGET(N2). Each word of TARGET then contains
-C 32 bits, right justified.
-C
-C 16-bit word number within Computer word increases
-C as one goes from Most Significant Bit (MSB) to LSB.
-C i.e.
-C 63 48 47 32 31 16 15 0
-C -----------------------------------------------
-C | 1 | 2 | 3 | 4 |
-C -----------------------------------------------
-C
- INTEGER SOURCE(1),TARGET(1)
- DIMENSION MBIT(4),MASTGT(2)
- DATA MBIT /16,32,48,0/
-C masks for the two halves of the target word
- DATA MASTGT /X'00000000FFFF0000',X'000000000000FFFF'/
- SAVE MBIT,MASTGT
-C
- IF(N3 .LE. 0) GO TO 999
-C
-C there are 4 possible byte locations in a source word
-C IWSRC+I is source word #, NBIT is distance to shift bits
-C
- IWSRC = (N1+3)/4
- NBIT = MBIT(MOD(N1+3,4)+1)+16
- DO 1 I=0,(N3-1)/2
- TARGET(N2+2*I) = SHIFT(SOURCE(IWSRC+I),NBIT) .AND. MASTGT(1)
- 1 CONTINUE
-C
- IWSRC = (N1+4)/4
- NBIT = MBIT(MOD(N1 ,4)+1)
- DO 2 I=0,(N3-1)/2
- 2 TARGET(N2+2*I) = TARGET(N2+2*I) .OR.
- & (SHIFT(SOURCE(IWSRC+I),NBIT) .AND. MASTGT(2))
-C
- IWSRC = (N1+1)/4
- NBIT = MBIT(MOD(N1+1,4)+1)+16
- DO 3 I=1,N3/2
- 3 TARGET(N2-1+2*I) = SHIFT(SOURCE(IWSRC+I),NBIT) .AND. MASTGT(1)
-C
- IWSRC = (N1+2)/4
- NBIT = MBIT(MOD(N1+2,4)+1)
- DO 4 I=1,N3/2
- 4 TARGET(N2-1+2*I) = TARGET(N2-1+2*I) .OR.
- & (SHIFT(SOURCE(IWSRC+I),NBIT) .AND. MASTGT(2))
-C
- 999 END
-#endif
diff --git a/src/packlib/epio/obsolete/cray/blo8wcra.F b/src/packlib/epio/obsolete/cray/blo8wcra.F
deleted file mode 100644
index d018124..0000000
--- a/src/packlib/epio/obsolete/cray/blo8wcra.F
+++ /dev/null
@@ -1,45 +0,0 @@
-*
-* $Id: blo8wcra.F,v 1.1.1.1 1996/03/08 15:21:54 mclareni Exp $
-*
-* $Log: blo8wcra.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:54 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_CRAY)
-CDECK,BLO8WCRA,IF=CRAY,CONVEX.
- SUBROUTINE BLO8W(SOURCE,N1,TARGET,N2,N3)
-C
-C BLOWS (UNPACKS) 8 BIT WORDS INTO MACHINE WORDS.
-C
-C W.W. 17/04/84 SACLAY/DPHPE
-C
- INTEGER SOURCE(2),TARGET(2)
-C
-#include "epio/paramcra.inc"
-C
- IF(N3.LE.0) RETURN
-C
- NN1 = (LBT8*N1-1)/NBW + 1
- NN2 = N2
- NN3 = N3
- NPS = MOD(N1-1,NF8) + 1
-C
- IF(NPS.EQ.1) GO TO 21
-C
- NPP = NF8 - NPS
-C
- DO 11 I=NPP,0,-1
- TARGET(NN2)=JBYT(SOURCE(NN1),I*LBT8+1,LBT8)
- NN2 = NN2 + 1
- NN3 = NN3 - 1
- IF(NN3.EQ.0) GO TO 999
- 11 CONTINUE
-C
- NN1 = NN1 + 1
- 21 CALL BLOW(SOURCE(NN1),TARGET(NN2),NN3,LBT8)
-C
- 999 RETURN
- END
-#endif
diff --git a/src/packlib/epio/obsolete/cray/btswapcr.s b/src/packlib/epio/obsolete/cray/btswapcr.s
deleted file mode 100644
index 7f81d17..0000000
--- a/src/packlib/epio/obsolete/cray/btswapcr.s
+++ /dev/null
@@ -1,101 +0,0 @@
-*
-* $Id: btswapcr.s,v 1.1.1.1 1996/03/08 15:21:54 mclareni Exp $
-*
-* $Log: btswapcr.s,v $
-* Revision 1.1.1.1 1996/03/08 15:21:54 mclareni
-* Epio
-*
-*
-#if defined(CERNLIB_CRAY)
-* SUBROUTINE BTSWAP(A,N)
-*
-* The subroutine expects N 8-bit bytes in array A, stored
-* contiguously from left to right, 8 bytes per 64-bit word.
-* If N<2, the subroutine returns control without action.
-* If N>1, N'=N/2 pairs of bytes will be transposed.
-* If N' is not a multiple of 4, the unused field to the
-* right of the last word will be unchanged.
-*
-* H. Lipps, CERN, 12.6.1986.
-*
- MACRO
- RESIDUE N,L,W S.L=MOD(N-1,64)+1
-*
- S.W -S.N S.W=-N
- S.L <6 S.L=0...077
- S.L #S.W&S.L S.L=MOD(N-1,64)
- S.W <1 S.W=1
- S.L S.L+S.W S.L=MOD(N-1,64)+1
-RESIDUE ENDM
-*
- IDENT BTSWAP
-ARRAY DEFARG SYNONYM FOR A
-BYTES DEFARG SYNONYM FOR N
-BTSWAP ENTER NP=2 (A,N)
-*
- ARGADD A1,ARRAY A1=(A(1))
- ARGADD A2,BYTES A2=(N)
- S1 A1 S1=(A(1))
- S2 ,A2 S2=N
- S3 2 S3=2
- S4 MASK,0 S4=FF00FF00FF00FF00
- A3 64 A3=64
- A6 3 A6=3
- S0 S2-S3 S0=N-2
- JSM %3 IF(N .LT. 2) GOTO 3
-*
- S6 S2,S6>A6 S6=MOD(N,8)*2**61+JUNK
- S2 S2>3 S2=N/8=M (FULL WORDS)
- S6 S6>62 S6=MOD(N,8)/2=NP
- A7 S2 A7=M
- S0 S6 S0=NP
- S6 S6<4 S6=16*NP (=FIELD SIZE)
- JSZ %1 IF NO PARTIAL WORD GOTO 1
-*
- A7 A1+A7 A7=(A(M+1))
- S7 ,A7 S7=A(M+1)
- A6 S6 A6=16*NP
- A6 A3-A6 A6=NUMBER OF BITS SAVED
- S6 S7,S6>A6 S6=UNUSED FIELD
- S7 S0,S7>A6 S7=ABCDEFGH, WHERE
-* UPPER FIELD IS JUNK
- S5 S7&S4 S5=A0C0E0G0
- S7 S7<8 S7=BCDEFGH0
- S5 S5>8 S5=0A0C0E0G
- S7 S7&S4 S7=B0D0F0H0
- S7 S7!S5 S7=BADCFEHG
- S7 S7,S6<A6 RESTORE UNUSED FIELD
- ,A7 S7 STORE PARTIAL WORD
-*
-%1 S0 S2 S0=M
- JSZ %3 IF(M .EQ. 0) GOTO 3
-*
- VL A3 VL=64
- S5 -1 S5=FF...FF
- VM S5 VM=TRUE
- A2 8 A2=8 (BYTE SIZE)
- V0 S4!V7&VM V0=$(FF00FF00F...),...
- V1 V0>A2 V1=$(00FF00FF0...),...
- RESIDUE 2,3,4 S3=MOD(M-1,64)+1=L
-*
-%2 A3 S3 A3=L
- VL A3 VL=L
- S2 S2-S3 S2=M-L
- A0 S1 A0=(A(*))
- V2 ,A0,1 V2=$(ABCDEFGH),...
- V3 V2&V0 V3=$(A0C0E0G0),...
- V4 V3>A2 V4=$(0A0C0E0G),...
- V5 V2&V1 V5=$(0B0D0F0H),...
- V6 V5<A2 V6=$(B0D0F0H0),...
- V7 V4!V6 V7=$(BADCFEHG),...
- ,A0,1 V7 STORE A(*),A(*+1),...,A(*+L-1)
- S1 S1+S3 S1=(A(*+L))
- S0 S2 S0=M-L
- S3 64 S3=L=64
- JSN %2 IF(M .NE. 0) GOTO 2
-*
-%3 EXIT RETURN
-*
-MASK CON X'FF00FF00FF00FF00
- END
-#endif
diff --git a/src/packlib/epio/obsolete/cray/bun16cra.F b/src/packlib/epio/obsolete/cray/bun16cra.F
deleted file mode 100644
index 71820af..0000000
--- a/src/packlib/epio/obsolete/cray/bun16cra.F
+++ /dev/null
@@ -1,66 +0,0 @@
-*
-* $Id: bun16cra.F,v 1.1.1.1 1996/03/08 15:21:54 mclareni Exp $
-*
-* $Log: bun16cra.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:54 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_CRAY)
-CDECK,BUN16CRA,IF=CRAY,CONVEX.
- SUBROUTINE BUN16W(SOURCE,N1,TARGET,N2,N3)
- INTEGER SOURCE(*),TARGET(*)
-C
-C CRAY version to do BUN16W with NO external calls.
-C
-C N.McCubbin 18-Feb-87
-C Revised F.Carminati 23-Jan-89
-C F.Carminati 06-Jun-89
-C
-C Input SOURCE array is N3 computer words starting in
-C SOURCE(N1). The rightmost 16 bits of these N3 words
-C are BUNCHED (packed) into a CONTIGUOUS bit string
-C starting at 16-BIT POSITION N2 in the array TARGET.
-C
-C 16-bit word number within Computer word increases
-C as one goes from Most Significant Bit (MSB) to LSB.
-C i.e.
-C 63 48 47 32 31 16 15 0
-C -----------------------------------------------
-C | 1 | 2 | 3 | 4 |
-C -----------------------------------------------
-C
- IF(N3 .LE. 0) GO TO 999
-C
-C And same for TARGET:
- IWTGT = (N2-1)/4
- I16TGT = N2-IWTGT*4
- IWTGT = IWTGT+1
- NBITL = (4-I16TGT)*16
-C
- DO 10 IWSRC=N1,N1+N3-1
-C
-C Extract 16-bit word from source
- JWD16 = IAND(SOURCE(IWSRC),65535)
-C
-C Shift to correct position for insertion into TARGET
- JWD16 = ISHFT(JWD16,NBITL)
-C
-C Clear TARGET position
- TARGET(IWTGT) = IAND(TARGET(IWTGT),NOT(ISHFT(65535,NBITL)))
-C
-C Insert:
- TARGET(IWTGT) = IOR(TARGET(IWTGT),JWD16)
-C
- IF(NBITL.EQ.0) THEN
- NBITL = 48
- IWTGT = IWTGT + 1
- ELSE
- NBITL = NBITL - 16
- ENDIF
-C
- 10 CONTINUE
-C
- 999 END
-#endif
diff --git a/src/packlib/epio/obsolete/cray/bun32old.F b/src/packlib/epio/obsolete/cray/bun32old.F
deleted file mode 100644
index f45c565..0000000
--- a/src/packlib/epio/obsolete/cray/bun32old.F
+++ /dev/null
@@ -1,84 +0,0 @@
-*
-* $Id: bun32old.F,v 1.1.1.1 1996/03/08 15:21:55 mclareni Exp $
-*
-* $Log: bun32old.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:55 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if (defined(CERNLIB_CRAY))&&(defined(CERNLIB_NEVER))
-CDECK,BUN32CRA,IF=CRAY,CONVEX
- SUBROUTINE BUN32W(SOURCE,N1,TARGET,N2,N3)
- INTEGER SOURCE(*),TARGET(*)
-C
-C CRAY version to do BUN32W with NO external calls.
-C
-C N.McCubbin 18-Feb-87
-C Revised F.Carminati 23-Jan-89
-C F.Carminati 02-Jun-89
-C
-C Input SOURCE array is N3 computer words starting in
-C SOURCE(N1). The rightmost 32 bits of these N3 words
-C are BUNCHED (packed) into a CONTIGUOUS bit string
-C starting at 16-BIT POSITION N2 in the array TARGET.
-C
-C 16-bit word number within Computer word increases
-C as one goes from Most Significant Bit (MSB) to LSB.
-C i.e.
-C 63 48 47 32 31 16 15 0
-C -----------------------------------------------
-C | 1 | 2 | 3 | 4 |
-C -----------------------------------------------
-C
- IF(N3 .LE. 0) GO TO 999
-C
-C TARGET word and 16-bit within word
- IWTGT = (N2-1)/4
- I16TGT = N2-IWTGT*4
- IWTGT = IWTGT+1
- NBITL = (4-I16TGT)*16
-C
- DO 10 IWSRC=N1,N1+N3-1
-C
-C Extract 16-bit word from source
- JWD16 = IAND(SOURCE(IWSRC),ISHFT(65535,16))
-C
-C Shift to correct position for insertion into TARGET
-C
- JWD16 = ISHFT(JWD16,NBITL-16)
-C Clear TARGET position
- TARGET(IWTGT) = IAND(TARGET(IWTGT),NOT(ISHFT(65535,NBITL)))
-C
-C Insert:
- TARGET(IWTGT) = IOR(TARGET(IWTGT),JWD16)
-C
- IF(NBITL.EQ.0) THEN
- NBITL = 48
- IWTGT = IWTGT + 1
- ELSE
- NBITL = NBITL - 16
- END IF
-C
-C Extract 16-bit word from source
- JWD16 = IAND(SOURCE(IWSRC),65535)
-C
-C Shift to correct position for insertion into TARGET
- JWD16 = ISHFT(JWD16, NBITL)
-C
-C Clear TARGET position
- TARGET(IWTGT) = IAND(TARGET(IWTGT),NOT(ISHFT(65535,NBITL)))
-C
-C Insert:
- TARGET(IWTGT) = IOR(TARGET(IWTGT),JWD16)
-C
- IF(NBITL.EQ.0) THEN
- NBITL = 48
- IWTGT = IWTGT + 1
- ELSE
- NBITL = NBITL - 16
- END IF
-C
- 10 CONTINUE
- 999 END
-#endif
diff --git a/src/packlib/epio/obsolete/cray/bun32wcr.F b/src/packlib/epio/obsolete/cray/bun32wcr.F
deleted file mode 100644
index bda9214..0000000
--- a/src/packlib/epio/obsolete/cray/bun32wcr.F
+++ /dev/null
@@ -1,65 +0,0 @@
-*
-* $Id: bun32wcr.F,v 1.1.1.1 1996/03/08 15:21:54 mclareni Exp $
-*
-* $Log: bun32wcr.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:54 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_CRAY)
- SUBROUTINE BUN32W(SOURCE,N1,TARGET,N2,N3)
- INTEGER SOURCE(*),TARGET(*)
-C
-C
-C CRAY version to do BUN32W with NO external calls.
-C
-C N.McCubbin 18-Feb-87
-C Revised F.Carminati 23-Jan-89
-C F.Carminati 02-Jun-89
-C M.J.Corden 30-Jan-91
-C
-C Input SOURCE array is N3 computer words starting in
-C SOURCE(N1). The rightmost 32 bits of these N3 words
-C are BUNCHED (packed) into a CONTIGUOUS bit string
-C starting at 16-BIT POSITION N2 in the array TARGET.
-C
-C 16-bit word number within Computer word increases
-C as one goes from Most Significant Bit (MSB) to LSB.
-C i.e.
-C 63 48 47 32 31 16 15 0
-C -----------------------------------------------
-C | 1 | 2 | 3 | 4 |
-C -----------------------------------------------
-C
- DIMENSION MBITL(4),NBITL(4),IWSRC(4),IWTGT(4),N3J(4)
- DIMENSION MASSRC(4),MASTGT(4)
- DATA MBITL /48,32,16,0/
-
- DATA MASSRC /X'00000000FFFF0000',X'000000000000FFFF',
- & X'00000000FFFF0000',X'000000000000FFFF'/
- SAVE MBITL,MASSRC
-C
- IF(N3 .LE. 0) GO TO 999
-C
- DO 1 JS = 1,4
- N3J(JS) = (JS-1)/2
- IWSRC(JS) = N1+N3J(JS)
- IWTGT(JS) = (N2+JS+2)/4
- ILR = 16*MOD(JS,2)
- NBITL(JS) = MBITL(MOD(N2+JS+2,4)+1) - ILR
- N3J(JS) = (N3+1-N3J(JS))/2 - 1
- MASTGT(JS)= .NOT.(ISHFT(MASSRC(JS),NBITL(JS)))
- 1 CONTINUE
-C
- DO 2 JS = 1,4
- DO 3 I = 0,N3J(JS)
- IEXT = SOURCE(IWSRC(JS)+2*I) .AND. MASSRC(JS)
- IEXT = ISHFT(IEXT,NBITL(JS))
- TARGET(IWTGT(JS)+I) = TARGET(IWTGT(JS)+I) .AND. MASTGT(JS)
- TARGET(IWTGT(JS)+I) = TARGET(IWTGT(JS)+I) .OR. IEXT
- 3 CONTINUE
- 2 CONTINUE
-C
- 999 END
-#endif
diff --git a/src/packlib/epio/obsolete/cray/bun8wcra.F b/src/packlib/epio/obsolete/cray/bun8wcra.F
deleted file mode 100644
index f454a18..0000000
--- a/src/packlib/epio/obsolete/cray/bun8wcra.F
+++ /dev/null
@@ -1,46 +0,0 @@
-*
-* $Id: bun8wcra.F,v 1.1.1.1 1996/03/08 15:21:54 mclareni Exp $
-*
-* $Log: bun8wcra.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:54 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_CRAY)
-CDECK,BUN8WCRA,IF=CRAY,CONVEX.
- SUBROUTINE BUN8W(SOURCE,N1,TARGET,N2,N3)
-C
-C BUNCHES (PACKS) 8 BIT WORDS (RIGHT ADJ., ZERO FILLED)
-C INTO CONTIGUOUS BIT STRING.
-C
-C W.W. 17/04/84 SACLAY/DPHPE
-C
- INTEGER SOURCE(2),TARGET(2)
-C
-#include "epio/paramcra.inc"
-C
- IF(N3.LE.0) RETURN
-C
- NN1 = N1
- NN2 = (LBT8*N2-1)/NBW + 1
- NN3 = N3
- NPS = MOD(N2-1,NF8) + 1
-C
- IF(NPS.EQ.1) GO TO 21
-C
- NPP = NF8 - NPS
-C
- DO 11 I=NPP,0,-1
- CALL SBYT(SOURCE(NN1),TARGET(NN2),I*LBT8+1,LBT8)
- NN1 = NN1 + 1
- NN3 = NN3 - 1
- IF(NN3.EQ.0) GO TO 999
- 11 CONTINUE
-C
- NN2 = NN2 + 1
- 21 CALL BUNCH(SOURCE(NN1),TARGET(NN2),NN3,LBT8)
-C
- 999 RETURN
- END
-#endif
diff --git a/src/packlib/epio/obsolete/cray/cfribmcr.F b/src/packlib/epio/obsolete/cray/cfribmcr.F
deleted file mode 100644
index cd37bcf..0000000
--- a/src/packlib/epio/obsolete/cray/cfribmcr.F
+++ /dev/null
@@ -1,73 +0,0 @@
-*
-* $Id: cfribmcr.F,v 1.1.1.1 1996/03/08 15:21:54 mclareni Exp $
-*
-* $Log: cfribmcr.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:54 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_CRAY)
- SUBROUTINE CFRIBM(A,NW,MODE)
- DIMENSION A(*)
-C
-C W.W. 17/04/84 SACLAY/DPHPE
-C modified for Cray MJC 30/1/91
- EQUIVALENCE (BAD,IBAD),(BAD31,IBAD31)
-C
- DATA ANORM / 0. /
- DATA IBAD /70000 77000000 37000000B/
- DATA IBAD31 /X'00000000 7FFFFFFF'/
-C
- SAVE IBAD,IBAD31,ANORM
-C
- JBIT (ZW,IZP) = SHIFTR(ZW,IZP-1) .AND. MASK(127)
- JBYT (ZW,IZP,NZB) = SHIFTR(ZW,IZP-1) .AND. MASK(128-NZB)
-C
- IF(NW.LE.0) RETURN
-C
- IF (MODE.EQ.1) THEN
-C
-C-- IF INTEGER 16 BIT
-C
- DO 1 JV = 1,NW
- JSIGN = JBIT(A(JV),16)
- IF(JSIGN.EQ.1) A(JV)=A(JV) .OR. MASK(48)
- 1 CONTINUE
- ELSEIF (MODE.EQ.2) THEN
-C
-C-- IF INTEGER 32 BIT
-C
- DO 2 JV = 1,NW
- JSIGN = JBIT(A(JV),32)
- IF(JSIGN.EQ.1) A(JV)=A(JV) .OR. MASK(32)
- 2 CONTINUE
- ELSEIF (MODE.EQ.3) THEN
-C
-C-- IF FLOATING
-C-- ALGORITHM TAKEN FROM HYDRA 3.43/2
-C
- DO 3 JV = 1,NW
- IF(A(JV) .EQ. BAD31) THEN
-C
-C---- BAD CONVERSION
-C
- A(JV) = BAD
- ELSE
- JSIGN = JBIT(A(JV),32)
- JEXP = (JBYT(A(JV),25,7)-64) * 4
- JMAN = SHIFTL(A(JV),40)
- A(JV) = JMAN .OR. (JEXP + 40000B)
- A(JV) = SHIFT(A(JV),49) .OR. JSIGN
- A(JV) = SHIFT(A(JV),63)
-C
-C-- ADD ZERO TO NORMALIZE
-C
- A(JV) = A(JV) + ANORM
- ENDIF
- 3 CONTINUE
- ENDIF
-C
- RETURN
- END
-#endif
diff --git a/src/packlib/epio/obsolete/cray/cfroldcr.F b/src/packlib/epio/obsolete/cray/cfroldcr.F
deleted file mode 100644
index b48507c..0000000
--- a/src/packlib/epio/obsolete/cray/cfroldcr.F
+++ /dev/null
@@ -1,67 +0,0 @@
-*
-* $Id: cfroldcr.F,v 1.1.1.1 1996/03/08 15:21:54 mclareni Exp $
-*
-* $Log: cfroldcr.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:54 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if (defined(CERNLIB_CRAY))&&(defined(CERNLIB_NEVER))
- SUBROUTINE CFRIBM(A,NW,MODE)
- DIMENSION A(2)
-C W.W. 17/04/84 SACLAY/DPHPE
-C
- EQUIVALENCE (AMM,MM)
- DATA ANORM / 0. /
- DATA NBDCON / 0 /
-C
- IF(NW.LE.0) RETURN
-C
- DO 49 JV = 1, NW
- AMM = A(JV)
-C
- IF(MODE.EQ.1) GO TO 11
- IF(MODE.EQ.2) GO TO 21
- IF(MODE.EQ.3) GO TO 31
- GO TO 49
-C
-C-- IF INTEGER 16 BIT
-C
- 11 JSIGN = JBIT(MM,16)
- IF(JSIGN.EQ.1) MM = MM .OR. MASK(48)
- GO TO 48
-C
-C-- IF INTEGER 32 BIT
-C
- 21 JSIGN = JBIT(MM,32)
- IF(JSIGN.EQ.1) MM = MM .OR. MASK(32)
- GO TO 48
-C
-C-- IF FLOATING
-C-- ALGORITHM TAKEN FROM HYDRA 3.43/2
-C
- 31 IF(MM .EQ. MASK(128-31)) GO TO 44
- JSIGN = JBIT(MM,32)
- JEXP = (JBYT(MM,25,7)-64) * 4
- JMAN = SHIFTL(MM,40)
- MM = JMAN .OR. (JEXP + 40000B)
- MM = SHIFT(MM,49) .OR. JSIGN
- MM = SHIFT(MM,63)
-C
-C-- ADD ZERO TO NORMALIZE
-C
- AMM = AMM + ANORM
- GO TO 48
-C
-C---- BAD CONVERSION
-C
- 44 MM = 70000 77000000 37000000 B
- NBDCON = NBDCON + 1
-C
- 48 A(JV) = AMM
- 49 CONTINUE
-C
- RETURN
- END
-#endif
diff --git a/src/packlib/epio/obsolete/cray/ctoibcra.F b/src/packlib/epio/obsolete/cray/ctoibcra.F
deleted file mode 100644
index bd8e158..0000000
--- a/src/packlib/epio/obsolete/cray/ctoibcra.F
+++ /dev/null
@@ -1,90 +0,0 @@
-*
-* $Id: ctoibcra.F,v 1.1.1.1 1996/03/08 15:21:54 mclareni Exp $
-*
-* $Log: ctoibcra.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:54 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_CRAY)
- SUBROUTINE CTOIBM(A,NW,MODE)
- DIMENSION A(2)
-C W.W. 17/04/84 SACLAY/DPHPE
-C
- EQUIVALENCE (AMM,MM)
- DATA NBDCON / 0 /
-C
- IF(NW.LE.0) RETURN
-C
- DO 49 JV = 1, NW
- AMM = A(JV)
-C
- IF(MODE.EQ.1) GO TO 11
- IF(MODE.EQ.2) GO TO 21
- IF(MODE.EQ.3) GO TO 31
- GO TO 49
-C
-C-- IF INTEGER 16 BIT
-C
- 11 MM = MM .AND. MASK(128-16)
- GO TO 48
-C
-C-- IF INTEGER 32 BIT
-C
- 21 MM = MM .AND. MASK(128-32)
- GO TO 48
-C
-C-- IF FLOATING
-C-- ALGORITHM TAKEN FROM HYDRA 3.43/2
-C
- 31 JSIGN = SHIFTR(MM,63)
- JEXP = JBYT(MM,49,15)
- IF(JEXP.EQ.0) GO TO 48
- IF(JEXP.LT.20000B) GO TO 37
- IF(JEXP.GE.60000B) GO TO 37
-C
- J = (JEXP+3) / 4
- JSH = 4*J - JEXP
- JEXP= J - 10000B
-C
-C-- 25-BIT MANTISSA, ROUND IF LAST BIT IS 1
-C
- JMAN = SHIFTL(MM,16)
- JMAN = SHIFTR(JMAN,39+JSH)
- JRND = SHIFTL(JMAN,63)
- JRND = SHIFT (JRND,1)
- JMAN = JMAN + JRND
- IF(SHIFTR(JMAN,25).EQ.0) GO TO 33
-C
-C-- ROUNDING WITH CARRY INTO EXPONENT FIELD
-C
- JEXP = JEXP + 1
- JMAN = SHIFTR(JMAN,4)
- JRND = SHIFTL(JMAN,63)
- JRND = SHIFT (JRND,1)
- JMAN = JMAN + JRND
-C
- 33 IF(JEXP.LT.-63) GO TO 35
- IF(JEXP.GE. 64) GO TO 37
- MM = SHIFTL(JMAN,32) .OR. JSIGN
- MM = SHIFT (MM,7) .OR. (JEXP+64)
- MM = SHIFT (MM,24)
- GO TO 48
-C
-C-- UNDERFLOW
-C
- 35 MM = 0
- GO TO 48
-C
-C-- OVERFLOW
-C
- 37 MM = MASK(128-31)
- NBDCON = NBDCON + 1
-C
- 48 A(JV) = AMM
- 49 CONTINUE
-C
- RETURN
- END
-#endif
diff --git a/src/packlib/epio/obsolete/cray/iwd16cra.F b/src/packlib/epio/obsolete/cray/iwd16cra.F
deleted file mode 100644
index d1bf4b0..0000000
--- a/src/packlib/epio/obsolete/cray/iwd16cra.F
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: iwd16cra.F,v 1.1.1.1 1996/03/08 15:21:55 mclareni Exp $
-*
-* $Log: iwd16cra.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:55 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_CRAY)
-CDECK,IWD16CRA,IF=CRAY,CONVEX
- FUNCTION IWD16(A,N)
-C
-C FUNCTION RETURNS THE 16 BIT WORD NO. N OF STRING A.
-C
-C W.W. 17/04/84 SACLAY/DPHPE
-C
- DIMENSION A(2)
-C
-#include "epio/paramcra.inc"
-C
- NN = (LBT16*N-1)/NBW + 1
- NS = MOD(N-1,NF16) + 1
- NP = NF16 - NS
-C
- II = JBYT(A(NN),NP*LBT16+1,LBT16)
-C
- IWD16 = II
-C
- RETURN
- END
-#endif
diff --git a/src/packlib/epio/obsolete/cray/paramcra.inc b/src/packlib/epio/obsolete/cray/paramcra.inc
deleted file mode 100644
index d523f0c..0000000
--- a/src/packlib/epio/obsolete/cray/paramcra.inc
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: paramcra.inc,v 1.1.1.1 1996/03/08 15:21:55 mclareni Exp $
-*
-* $Log: paramcra.inc,v $
-* Revision 1.1.1.1 1996/03/08 15:21:55 mclareni
-* Epio
-*
-*
-*
-* paramcra.inc
-*
-#if defined(CERNLIB_CRAY)
- PARAMETER (LBT8=8,LBT16=16,LBT32=32,NBW=64)
- PARAMETER (NF8 =NBW/LBT8 )
- PARAMETER (NF16=NBW/LBT16)
- PARAMETER (NF32=NBW/LBT32)
-#endif
diff --git a/src/packlib/epio/obsolete/cray/sfrascra.F b/src/packlib/epio/obsolete/cray/sfrascra.F
deleted file mode 100644
index 07bcd4c..0000000
--- a/src/packlib/epio/obsolete/cray/sfrascra.F
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: sfrascra.F,v 1.1.1.1 1996/03/08 15:21:55 mclareni Exp $
-*
-* $Log: sfrascra.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:55 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_CRAY)
-CDECK,SFRASCRA,IF=CRAY,CONVEX
- SUBROUTINE SFRASC(SOURCE,N1,TARGET,N2,N3)
- CHARACTER SOURCE*(*),TARGET*(*)
-C
-C W.W. 17/04/84 SACLAY/DPHPE
-C
- IF(N3.LE.0) RETURN
-C
- TARGET(N2:N2+N3-1) = SOURCE(N1:N1+N3-1)
-C
- RETURN
- END
-#endif
diff --git a/src/packlib/epio/obsolete/cray/stoascra.F b/src/packlib/epio/obsolete/cray/stoascra.F
deleted file mode 100644
index bd1d30c..0000000
--- a/src/packlib/epio/obsolete/cray/stoascra.F
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: stoascra.F,v 1.1.1.1 1996/03/08 15:21:55 mclareni Exp $
-*
-* $Log: stoascra.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:55 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_CRAY)
-CDECK,STOASCRA,IF=CRAY,CONVEX
- SUBROUTINE STOASC(SOURCE,N1,TARGET,N2,N3)
- CHARACTER SOURCE*(*),TARGET*(*)
-C
-C W.W. 17/04/84 SACLAY/DPHPE
-C
- IF(N3.LE.0) RETURN
-C
- TARGET(N2:N2+N3-1) = SOURCE(N1:N1+N3-1)
-C
- RETURN
- END
-#endif
diff --git a/src/packlib/epio/obsolete/cray/w16mvcra.F b/src/packlib/epio/obsolete/cray/w16mvcra.F
deleted file mode 100644
index 3baa726..0000000
--- a/src/packlib/epio/obsolete/cray/w16mvcra.F
+++ /dev/null
@@ -1,42 +0,0 @@
-*
-* $Id: w16mvcra.F,v 1.1.1.1 1996/03/08 15:21:55 mclareni Exp $
-*
-* $Log: w16mvcra.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:55 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_CRAY)
-CDECK,W16MVCRA,IF=CRAY,CONVEX
- SUBROUTINE W16MOV(SOURCE,N1,TARGET,N2,N3)
- INTEGER SOURCE(2),TARGET(2)
-C
-C W.W. 17/04/84 SACLAY/DPHPE
-C
-#include "epio/paramcra.inc"
-C
- IF(N3.LE.0) RETURN
-C
- NN1 = (LBT16*N1 - 1) / NBW + 1
- NN2 = (LBT16*N2 - 1) / NBW + 1
- NN3 = N3
- NP1 = MOD(N1-1,NF16) + 1
- NP2 = MOD(N2-1,NF16) + 1
- NS1 = NF16 - NP1
- NS2 = NF16 - NP2
-C
- DO 11 I = 1, NN3
- II = JBYT(SOURCE(NN1),NS1*LBT16+1,LBT16)
- CALL SBYT(II,TARGET(NN2),NS2*LBT16+1,LBT16)
- IF(NS1.EQ.0) NN1 = NN1 + 1
- IF(NS1.EQ.0) NS1 = NS1 + NF16
- IF(NS2.EQ.0) NN2 = NN2 + 1
- IF(NS2.EQ.0) NS2 = NS2 + NF16
- NS1 = NS1 - 1
- NS2 = NS2 - 1
- 11 CONTINUE
-C
- RETURN
- END
-#endif
diff --git a/src/packlib/epio/obsolete/dec/btswpshf.F b/src/packlib/epio/obsolete/dec/btswpshf.F
deleted file mode 100644
index 9a9c246..0000000
--- a/src/packlib/epio/obsolete/dec/btswpshf.F
+++ /dev/null
@@ -1,56 +0,0 @@
-*
-* $Id: btswpshf.F,v 1.1.1.1 1996/03/08 15:21:53 mclareni Exp $
-*
-* $Log: btswpshf.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:53 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if (!defined(CERNLIB_STF77))&&(defined(CERNLIB_STF77VX))&&(defined(CERNLIB_NEVER))
- SUBROUTINE BTSWAP(SOURCE,NBYTES)
- INTEGER SOURCE(*)
-C
-C STF77 VAX version to do BTSWAP with NO external calls.
-C
-C. SOURCE SOURCE ARRAY
-C. NBYTES Number of bytes to swap
-C
-C 16-bit word number within Computer word increases
-C as one goes from Most Significant Bit (MSB) to LSB.
-C i.e.
-C 63 48 47 32 31 16 15 0
-C -----------------------------------------------
-C | 1 | 2 | 3 | 4 |
-C -----------------------------------------------
-C
-* # of bits/word
-#endif
- PARAMETER (NBITPW=32, NCHAPW=4, NBITPC=8, N16PW=2)
-C
- IF(NBYTES .LE. 1) GO TO 999
-C
-C
-C SOURCE word
- IWSRC = 1
- NBITR = 0
-C
-C
- DO 10 IW16=1,NBYTES/2
-C
-C Shift bytes and then 16 bit word
- SOURCE(IWSRC) = ISHFTC(ISHFTC(SOURCE(IWSRC),8,16),-16,NBITPW)
-C Update indices
- IF(NBITR.EQ.NBITPW-16) THEN
- NBITR = 0
- IWSRC = IWSRC + 1
- ELSE
- NBITR = NBITR + 16
- ENDIF
-C
-C
- 10 CONTINUE
-C Shift last word if necessary
- SOURCE(IWSRC) = ISHFTC(SOURCE(IWSRC),NBITR,NBITPW)
-C
- 999 END
diff --git a/src/packlib/epio/obsolete/dec/cfribmsh.F b/src/packlib/epio/obsolete/dec/cfribmsh.F
deleted file mode 100644
index 5730f6b..0000000
--- a/src/packlib/epio/obsolete/dec/cfribmsh.F
+++ /dev/null
@@ -1,79 +0,0 @@
-*
-* $Id: cfribmsh.F,v 1.1.1.1 1996/03/08 15:21:53 mclareni Exp $
-*
-* $Log: cfribmsh.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:53 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if (defined(CERNLIB_STF77VX))&&(defined(CERNLIB_NEVER))
- SUBROUTINE CFRIBM(IARRAY,NW,MODE)
-C +++++++ STANDARD FORTRAN VAX VERSION +++++++
-C The numbers must be right adj., zero filled.
-C MODE = 1 : convert 16-bit integers
-C = 2 : convert 32-bit integers (Dummy)
-C = 3 : convert 32-bit floating
- LOGICAL BTEST
- DIMENSION IARRAY(*)
-C PARAMETER (IBIG=16#7FFF FFFF,ISMA=16#0080 0000)
- PARAMETER (IBIG=2147483647,ISMA=8388608)
-C
- IF(NW.LE.0) GO TO 999
- IF(MODE.EQ.1) THEN
-C
-C 16-bit integers
-C
- DO 110,I=1,NW
- IARRAY(I) = IAND(IARRAY(I),65535)
- 110 CONTINUE
- ELSEIF(MODE.EQ.2) THEN
-C
-C Swap 16-bit integers
- DO 120,I=1,NW
- IARRAY(I) = ISHFTC(IARRAY(I),16,32)
- 120 CONTINUE
-C
- ELSE IF(MODE.EQ.3) THEN
-C
-C Convert the first NW words of IARRAY from
-C IBM 32-bit floating point representation to
-C APOLLO single-precision (32-bit) floating point
-C representation
- DO 2 J=1,NW
-C
-C Check for exact 0
- IF(IARRAY(J).EQ.0) GO TO 2
-C
-C Make sure ILEFT gets defined to something!
- ILEFT = 0
-C
-C Get exponent
-CI IEXPO = RSHFT(LSHFT(IARRAY(J),1),25)
- IEXPO = ISHFT(ISHFT(IARRAY(J),1),-25)
- IF(BTEST(IARRAY(J),23)) THEN
- ILEFT = 0
- ELSEIF(BTEST(IARRAY(J),22)) THEN
- ILEFT = 1
- ELSEIF(BTEST(IARRAY(J),21)) THEN
- ILEFT = 2
- ELSEIF(BTEST(IARRAY(J),20)) THEN
- ILEFT = 3
- END IF
- IEXPO = IEXPO * 4 - ILEFT - 130
- IF(IEXPO.LE.0) THEN
- IDUMMY = ISMA
- GO TO 1
- ELSEIF(IEXPO.GT.255) THEN
- IDUMMY = IBIG
- GO TO 1
- END IF
- IDUMMY = ISHFT(IARRAY(J),ILEFT)
- IDUMMY = IOR(IAND(IDUMMY,2**23-1),ISHFT(IEXPO,23))
- 1 IF(BTEST(IARRAY(J),31)) IDUMMY = IBSET(IDUMMY,31)
- IARRAY(J) = IDUMMY
- 2 CONTINUE
- END IF
-C
- 999 END
-#endif
diff --git a/src/packlib/epio/obsolete/dec/ctoibshf.F b/src/packlib/epio/obsolete/dec/ctoibshf.F
deleted file mode 100644
index 40680a6..0000000
--- a/src/packlib/epio/obsolete/dec/ctoibshf.F
+++ /dev/null
@@ -1,68 +0,0 @@
-*
-* $Id: ctoibshf.F,v 1.1.1.1 1996/03/08 15:21:53 mclareni Exp $
-*
-* $Log: ctoibshf.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:53 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if (defined(CERNLIB_STF77VX))&&(defined(CERNLIB_NEVER))
- SUBROUTINE CTOIBM(IARRAY,NW,MODE)
-C +++++++ STANDARD FORTRAN VAX VERSION +++++++
-C The numbers must be right adj., zero filled.
-C MODE = 1 : convert 16-bit integers
-C = 2 : convert 32-bit integers
-C = 3 : convert 32-bit floating
- LOGICAL BTEST
- DIMENSION IARRAY(*)
-C
- IF(NW.LE.0) GO TO 999
- IF(MODE.EQ.1) THEN
-C
-C 16-bit integers
-C
- DO 110,I=1,NW
- IARRAY(I) = IAND(IARRAY(I),65535)
- 110 CONTINUE
- ELSE IF(MODE.EQ.2) THEN
-C
-C Swap 16-bit integers
- DO 120,I=1,NW
- IARRAY(I) = ISHFTC(IARRAY(I),16,32)
- 120 CONTINUE
-C
- ELSE IF(MODE.EQ.3) THEN
-C
-C Convert the first NW words of IARRAY from IEEE
-C single-precision (32-bit) floating point representation
-C to IBM 32-bit floating point representation
- DO 10,I=1,NW
-C
-C Check for exact 0
- IF(IARRAY(I).EQ.0) GO TO 10
-C
-C Get exponent
- IEXPO = ISHFT(ISHFT(IARRAY(I),1),-24)
-C
-C IEEE EXP + IEEE BIAS + IBM BIAS
-C IEXPO = IEXPO - 128 + 260
- IEXPO = IEXPO + 134
- IEX16 = IEXPO/4
- ILEFT = 4 - MOD(IEXPO,4)
- IF(ILEFT.EQ.4) THEN
- ILEFT = 0
- IEX16 = IEX16 - 1
- END IF
- IDUMMY = IAND(IARRAY(I),2**23-1)
- IDUMMY = IBSET(IDUMMY,23)
- IDUMMY = IDUMMY + 2**(ILEFT-1)
- IDUMMY = ISHFT(IDUMMY,-ILEFT)
- IDUMMY = IOR(IDUMMY,ISHFT(IEX16,24))
- IF(BTEST(IARRAY(I),31)) IDUMMY = IBSET(IDUMMY,31)
- IARRAY(I) = IDUMMY
- 10 CONTINUE
- END IF
-C
- 999 END
-#endif
diff --git a/src/packlib/epio/obsolete/dec/jshftdec.F b/src/packlib/epio/obsolete/dec/jshftdec.F
deleted file mode 100644
index daea079..0000000
--- a/src/packlib/epio/obsolete/dec/jshftdec.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: jshftdec.F,v 1.1.1.1 1996/03/08 15:21:53 mclareni Exp $
-*
-* $Log: jshftdec.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:53 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if (defined(CERNLIB_DECS))&&(defined(CERNLIB_NEVER))
- INTEGER FUNCTION JSHFTC(IW,M1,M2)
-C Hopefully temporary fix for the Decstation where ISHFTC extends the
-C sign bit for ishftc(iw,16,32)
- INTEGER IW,M1,M2
- IF(ABS(M1).EQ.16)THEN
- JSHFTC=IOR(ISHFT(IW,-16) , ISHFT(IW,16))
- ELSE
- JSHFTC=ISHFTC(IW,M1,M2)
- ENDIF
- END
-#endif
diff --git a/src/packlib/epio/obsolete/eppac/eppaccom.inc b/src/packlib/epio/obsolete/eppac/eppaccom.inc
deleted file mode 100644
index 5494474..0000000
--- a/src/packlib/epio/obsolete/eppac/eppaccom.inc
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: eppaccom.inc,v 1.1.1.1 1996/03/08 15:21:54 mclareni Exp $
-*
-* $Log: eppaccom.inc,v $
-* Revision 1.1.1.1 1996/03/08 15:21:54 mclareni
-* Epio
-*
-*
-* COPY OF EPIOCOM KEEP SEQUENCE FOR BACK COMPATIBILTY.
-*
-* eppaccom.inc
-*
-#if defined(CERNLIB_ND50)||defined(CERNLIB_ND500)
- COMMON/EPCOMM/NMUNIT,NWUNIT,NCONT,ISTART,LASTUT,LREF,LIST(350)
- EQUIVALENCE (NOUTUT,LIST(8))
-#endif
diff --git a/src/packlib/epio/obsolete/ibm/asciiibm.inc b/src/packlib/epio/obsolete/ibm/asciiibm.inc
deleted file mode 100644
index cd9afe0..0000000
--- a/src/packlib/epio/obsolete/ibm/asciiibm.inc
+++ /dev/null
@@ -1,14 +0,0 @@
-*
-* $Id: asciiibm.inc,v 1.1.1.1 1996/03/08 15:21:51 mclareni Exp $
-*
-* $Log: asciiibm.inc,v $
-* Revision 1.1.1.1 1996/03/08 15:21:51 mclareni
-* Epio
-*
-*
-*
-* asciiibm.inc
-*
-#if defined(CERNLIB_IBM)
- COMMON/ASCIIC/ITASC4(64),IFASC4(64)
-#endif
diff --git a/src/packlib/epio/obsolete/ibm/blo16wib.F b/src/packlib/epio/obsolete/ibm/blo16wib.F
deleted file mode 100644
index 93ebb6d..0000000
--- a/src/packlib/epio/obsolete/ibm/blo16wib.F
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: blo16wib.F,v 1.1.1.1 1996/03/08 15:21:50 mclareni Exp $
-*
-* $Log: blo16wib.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:50 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_IBM)
- SUBROUTINE BLO16W(SOURCE,N1,TARGET,N2,N3)
-C.+++++++ IBM VERSION ++++++++++
-C. BLOWS (UNPACKS) 16 BIT WORDS INTO MACHINE WORDS(32 BIT).
-C.
-C. INPUT
-C. SOURCE ARRAY CONTAINING 16 BIT WORDS IN PACKED FORM
-C. N1 FIRST 16 BIT WORD IN SOURCE TO BLOW
-C. TARGET TARGET ARRAY FOR UNPACKED 16 BIT WORDS
-C. N2 TARGET(N2) WILL CONTAIN FIRST UNPACKED WORD
-C. N3 NO. OF 16 BIT WORDS TO UNPACK
- INTEGER*2 SOURCE(2),IW2(2)
- INTEGER TARGET(2)
- EQUIVALENCE (IW2(1),IW4)
- IF(N3.LE.0) GOTO 77777
- I1=N1-1
- I2=N2-1
- IW4=0
- DO 1 I=1,N3
- IW2(2)=SOURCE(I1+I)
- 1 TARGET(I2+I)=IW4
-77777 RETURN
- END
-#endif
diff --git a/src/packlib/epio/obsolete/ibm/blo32wib.F b/src/packlib/epio/obsolete/ibm/blo32wib.F
deleted file mode 100644
index 1c66ecd..0000000
--- a/src/packlib/epio/obsolete/ibm/blo32wib.F
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: blo32wib.F,v 1.1.1.1 1996/03/08 15:21:51 mclareni Exp $
-*
-* $Log: blo32wib.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:51 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_IBM)||defined(CERNLIB_ND100B32)
- SUBROUTINE BLO32W(SOURCE,N1,TARGET,N2,N3)
-C.+++++++ IBM, NORD 100 32-BIT VERSION ++++++++++
-C. MOVES 32 BIT WORDS INTO 32 BIT WORDS. STARTS ON ANY
-C. 16 BIT WORD IN SOURCE.
-C.
-C. +++ IMPORTANT +++ COUNTS PARTLY IN 16 BIT WORDS
-C.
-C. INPUT
-C. SOURCE SOURCE ARRAY
-C. N1 FIRST 16 BIT WORD IN SOURCE
-C. TARGET TARGET ARRAY
-C. N2 FIRST COPIED WORD IS TARGET(N2)
-C. N3 NO. OF WORDS TO COPY
-#if defined(CERNLIB_IBM)
- INTEGER SOURCE(2),TARGET(2)
-#endif
-#if defined(CERNLIB_NORD)
- INTEGER*4 N1,N2,N3,SOURCE(2),TARGET(2)
-#endif
- CALL W16MOV(SOURCE,N1,TARGET,2*N2-1,2*N3)
- RETURN
- END
-#endif
diff --git a/src/packlib/epio/obsolete/ibm/btswapib.F b/src/packlib/epio/obsolete/ibm/btswapib.F
deleted file mode 100644
index 53c66c2..0000000
--- a/src/packlib/epio/obsolete/ibm/btswapib.F
+++ /dev/null
@@ -1,37 +0,0 @@
-*
-* $Id: btswapib.F,v 1.1.1.1 1996/03/08 15:21:51 mclareni Exp $
-*
-* $Log: btswapib.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:51 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if (defined(CERNLIB_IBM)||defined(CERNLIB_NORD)||defined(CERNLIB_APOLLO))&&(!defined(CERNLIB_QMIBMVF))
- SUBROUTINE BTSWAP(IARRAY,NBYTES)
-C.+++++++ IBM NORD100/500 AND APOLLO VERSION ++++++++++
-C. MOVES 16 BIT WORDS IN PACKED FORM.
-C.
-C. ARGUMENTS
-C. IARRAY SOURCE ARRAY
-C. NBYTES NO. OF BYTES TO SWAP, STARTING AT THE LEFTMOST
-C. POSITION IN IARRAY. IF LE 1, NO ACTION. IF ODD,
-C. NBYTES-1 IS USED INSTEAD.
-C.
- INTEGER*2 IARRAY(2),I2(2)
- INTEGER*4 I4,IACC
- EQUIVALENCE (I2(1),I4)
- N=NBYTES/2
- IF(N.LE.0) GOTO 999
- DO 1 I=1,N
- I4=0
- I2(2)=IARRAY(I)
- I4=256*I4
- IACC=I2(1)
- I2(1)=0
- I4=I4+IACC
- IARRAY(I)=I2(2)
- 1 CONTINUE
- 999 RETURN
- END
-#endif
diff --git a/src/packlib/epio/obsolete/ibm/btswapiv.s b/src/packlib/epio/obsolete/ibm/btswapiv.s
deleted file mode 100644
index 42c7a5b..0000000
--- a/src/packlib/epio/obsolete/ibm/btswapiv.s
+++ /dev/null
@@ -1,93 +0,0 @@
-*
-* $Id: btswapiv.s,v 1.1.1.1 1996/03/08 15:21:51 mclareni Exp $
-*
-* $Log: btswapiv.s,v $
-* Revision 1.1.1.1 1996/03/08 15:21:51 mclareni
-* Epio
-*
-*
-#if defined(CERNLIB_QMIBMVF)
-BTSWAP CSECT
-* CERN PROGLIB# FXXX BTSWAP .VERSION EPIO 1.64 900509
-* ORIG. 13/03/90 C.GUERIN, IBM
-*
-#if defined(CERNLIB_QMIBMXA)
-BTSWAP AMODE ANY
-BTSWAP RMODE ANY
-#endif
-**+++++++ ibm nord100/500 and apollo version ++++++++++
-** moves 16 bit words in packed form.
-**
-** arguments
-** iarray source array
-** nbytes no. of bytes to swap, starting at the leftmost
-** position in iarray. if le 1, no action. if odd ,
-** nbytes-1 is used instead.
-**
- USING *,15
- STM 14,12,12(13)
-*****************************************************************
- LM G5,G6,0(G1) get addresses
- LR G8,G5 copy vector address
- LR G4,G5 copy vector address
- L G6,0(G6) get count
- SR G7,G7 zero G7
- SRDL G6,2 multiply cunt by 4
-** SRL G7,30
- LM G9,G10,MASK0 load masks into G9 G10
-VLOOP EQU *
- VLVCU G6 set vector loop
- VNS V1,G9,G5 load v1 & and with x'00FF00FF'
- VSLL V1,V1,8 shift left V1 one byte
- VNS V2,G10,G4 load v2 & and with x'FF00FF00'
- VSRL V2,V2,8 shift right V2 one byte
- VOR V3,V1,V2 OR V1 V2 into V3
- VST V3,G8 store V3 in result area
- BC 2,VLOOP loop on vector
- LTR G7,G7 test remaining halfword
- BNZ REM if some go to REM
-* END SUBROUTINE ************
-RETURN2 LM 2,12,28(13) RETURN
- BR 14
-* CONSTANTS *****************************************************
-REM LH G11,0(G5) load remaining halfword in G11
- LH G12,0(G5) load remaining halfword in G12
- N G11,MASK3
- SLL G11,8
- N G12,MASK4
- SRL G12,8
- OR G11,G12
- STH G11,0(G8)
- B RETURN2
- DS 0D
-MASK0 DC X'00FF00FF'
-MASK1 DC X'FF00FF00'
-MASK3 DC X'000000FF'
-MASK4 DC X'0000FF00'
-G0 EQU 0
-G1 EQU 1
-G2 EQU 2
-G3 EQU 3
-G4 EQU 4
-G5 EQU 5
-G6 EQU 6
-G7 EQU 7
-G8 EQU 8
-G9 EQU 9
-G10 EQU 10
-G11 EQU 11
-G12 EQU 12
-G13 EQU 13
-G14 EQU 14
-G15 EQU 15
-F0 EQU 0
-F2 EQU 2
-F4 EQU 4
-F6 EQU 6
-V0 EQU 0
-V1 EQU 1
-V2 EQU 2
-V3 EQU 3
-V4 EQU 4
- END
-#endif
diff --git a/src/packlib/epio/obsolete/ibm/bun32wib.F b/src/packlib/epio/obsolete/ibm/bun32wib.F
deleted file mode 100644
index addb586..0000000
--- a/src/packlib/epio/obsolete/ibm/bun32wib.F
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: bun32wib.F,v 1.1.1.1 1996/03/08 15:21:51 mclareni Exp $
-*
-* $Log: bun32wib.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:51 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_IBM)||defined(CERNLIB_ND100B32)
- SUBROUTINE BUN32W(SOURCE,N1,TARGET,N2,N3)
-C.+++++++ IBM, NORD 100 32-BIT VERSION ++++++++++
-C. MOVES 32 BIT WORDS INTO 32 BIT WORDS. STARTS ON ANY
-C. 16 BIT WORD IN TARGET.
-C.
-C. +++ IMPORTANT +++ COUNTS PARTLY IN 16 BIT WORDS
-C.
-C. INPUT
-C. SOURCE SOURCE ARRAY
-C. N1 FIRST WORD TO COPY IS SOURCE(N1)
-C. TARGET TARGET ARRAY
-C. N2 FIRST 16 BIT WORD IN TARGET
-C. N3 NO. OF WORDS TO COPY
-#if defined(CERNLIB_IBM)
- INTEGER SOURCE(2),TARGET(2)
-#endif
-#if defined(CERNLIB_NORD)
- INTEGER*4 N1,N2,N3,SOURCE(2),TARGET(2)
-#endif
- CALL W16MOV(SOURCE,2*N1-1,TARGET,N2,2*N3)
- RETURN
- END
-#endif
diff --git a/src/packlib/epio/obsolete/ibm/cfrascib.F b/src/packlib/epio/obsolete/ibm/cfrascib.F
deleted file mode 100644
index 6a25cc7..0000000
--- a/src/packlib/epio/obsolete/ibm/cfrascib.F
+++ /dev/null
@@ -1,58 +0,0 @@
-*
-* $Id: cfrascib.F,v 1.1.1.1 1996/03/08 15:21:51 mclareni Exp $
-*
-* $Log: cfrascib.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:51 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_IBM)
- SUBROUTINE CFRASC(IARR,NW)
-C.+++++++ IBM VERSION +++++++
-C. ASCII TO INTERNAL IBM ( = EBCDIC ) CODE CONVERSION.
-C. INPUT
-C. NW NO. OF CHARACTERS TO CONVERT
-C. I/O
-C. IARR CONTAINS CHARACTERS UNPACKED, RIGHT ADJ., ZERO FILLED
-C. BEFORE AND AFTER CONVERSION IN PLACE.
- DIMENSION IARR( 1)
-#include "epio/asciiibm.inc"
- LOGICAL*1 ITASC1(256),LNBASC(4),LK(4),LI(4)
- EQUIVALENCE (K,LK(1)),(II,LI(1)),(NBASC,LNBASC(1))
- EQUIVALENCE (ITASC1(1),ITASC4(1))
- DIMENSION ITIBM4(64)
- LOGICAL*1 ITIBM1(256)
- EQUIVALENCE (ITIBM1(1),ITIBM4(1))
- DATA ITIBM4/
- 1 Z40404040, Z40404040, Z40404040, Z40404040,
- 2 Z40404040, Z40404040, Z40404040, Z40404040,
- 3 Z5A7F7B5B, Z6C507D4D, Z5D5C4E6B, Z604B61F0,
- 4 ZF1F2F3F4, ZF5F6F7F8, ZF97A5E4C, Z7E6E6F7C,
- 5 ZC1C2C3C4, ZC5C6C7C8, ZC9D1D2D3, ZD4D5D6D7,
- 6 ZD8D9E2E3, ZE4E5E6E7, ZE8E9ADE0, ZBD6A6D79,
- 7 Z81828384, Z85868788, Z89919293, Z94959697,
- 8 Z9899A2A3, ZA4A5A6A7, ZA8A98B4F, Z9B5F4040,
- 9 32*Z40404040/
- DATA IFI /0/, NBASC /32/, K/0/
- IF(IFI.NE.0) GOTO 10
-C--- INITIALIZE
- CALL UCOPY(ITIBM4,IFASC4,64)
-C PRESET TO ASCII BLANK
- DO 1 I=1,256
- 1 ITASC1(I)= LNBASC(4)
-C--- FILL
- DO 2 I=33,126
- LK(4)= ITIBM1(I)
- II= I
- 2 ITASC1(K)= LI(4)
- IFI=1
- 10 CONTINUE
- IF(NW.LE.0) GOTO 77777
- DO 11 J=1,NW
- I= MIN0 (256,MAX0(1,IARR(J)))
- LK(4)= ITIBM1(I)
- 11 IARR(J)= K
-77777 RETURN
- END
-#endif
diff --git a/src/packlib/epio/obsolete/ibm/cfribmib.F b/src/packlib/epio/obsolete/ibm/cfribmib.F
deleted file mode 100644
index 8b39899..0000000
--- a/src/packlib/epio/obsolete/ibm/cfribmib.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: cfribmib.F,v 1.1.1.1 1996/03/08 15:21:51 mclareni Exp $
-*
-* $Log: cfribmib.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:51 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_IBM)
- SUBROUTINE CFRIBM(IARRAY,NW,MODE)
-C.+++++++ IBM VERSION ++++++++++
-C. CONVERTS THE FIRST NW WORDS OF IARRAY FROM IBM TO MACHINE FORMAT.
-C. THE NUMBERS MUST BE RIGHT ADJ., ZERO FILLED.
-C. MODE = 1 : CONVERT 16 BIT INTEGERS
-C. = 2 : CONVERT 32 BIT INTEGERS (DUMMY IN IBM VERSION)
-C. = 3 : CONVERT 32 BIT FLOATING (DUMMY IN IBM VERSION)
- DIMENSION IARRAY( 1)
- INTEGER*2 IW2(2)
- EQUIVALENCE (IW2(1),IW4)
- IF(MODE.NE.1) GOTO 77777
- IF(NW.LE.0) GOTO 77777
- DO 1 I=1,NW
- IW4=IARRAY(I)
- 1 IARRAY(I)=IW2(2)
-77777 RETURN
- END
-#endif
diff --git a/src/packlib/epio/obsolete/ibm/ctoascib.F b/src/packlib/epio/obsolete/ibm/ctoascib.F
deleted file mode 100644
index 96eaf40..0000000
--- a/src/packlib/epio/obsolete/ibm/ctoascib.F
+++ /dev/null
@@ -1,37 +0,0 @@
-*
-* $Id: ctoascib.F,v 1.1.1.1 1996/03/08 15:21:52 mclareni Exp $
-*
-* $Log: ctoascib.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:52 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_IBM)
- SUBROUTINE CTOASC(IARR,NW)
-C.+++++++ IBM VERSION +++++++
-C. IBM INTERNAL ( = EBCDIC ) TO ASCII CODE CONVERSION
-C. INPUT
-C. NW NO. OF CHARACTERS TO CONVERT
-C. I/O
-C. IARR CONTAINS CHARACTERS UNPACKED, RIGHT ADJ., ZERO FILLED
-C. BEFORE AND AFTER CONVERSION IN PLACE.
- DIMENSION IARR( 1)
-#include "epio/asciiibm.inc"
- LOGICAL*1 ITASC1(256),LK(4)
- EQUIVALENCE (K,LK(1))
- EQUIVALENCE (ITASC1(1),ITASC4(1))
- DATA IFI /0/, K/0/
- IF(IFI.NE.0) GOTO 1
-C--- INITIALIZE
- CALL CFRASC(IFI,0)
- IFI=1
- 1 CONTINUE
- IF(NW.LE.0) GOTO 77777
- DO 11 J=1,NW
- I= MIN0 (256,MAX0(1,IARR(J)))
- LK(4)= ITASC1(I)
- 11 IARR(J)= K
-77777 RETURN
- END
-#endif
diff --git a/src/packlib/epio/obsolete/ibm/ctoibmib.F b/src/packlib/epio/obsolete/ibm/ctoibmib.F
deleted file mode 100644
index c1761c2..0000000
--- a/src/packlib/epio/obsolete/ibm/ctoibmib.F
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: ctoibmib.F,v 1.1.1.1 1996/03/08 15:21:51 mclareni Exp $
-*
-* $Log: ctoibmib.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:51 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_IBM)
- SUBROUTINE CTOIBM(IARRAY,NW,MODE)
-C.+++++++ IBM VERSION ++++++++++
-C. CONVERTS THE FIRST NW WORDS OF IARRAY INTO IBM FORMAT.
-C. MODE = 1 : CONVERT TO 16 BIT INTEGERS (RIGHT ADJ. ZERO FILLED)
-C. = 2 : CONVERT TO 32 BIT INTEGERS (DUMMY IB IBM VERSION)
-C. = 3 : CONVERT TO 32 BIT FLOATING (DUMMY IN IBM VERSION)
-C. ON RETURN,THE CONVERTED NUMBERS ARE IN IARRAY,RIGHT ADJ., ZERO FILLED
- DIMENSION IARRAY( 1)
- INTEGER*2 IW2(2)
- EQUIVALENCE (IW2(1),IW4)
- IF(MODE.NE.1) GOTO 77777
- IF(NW.LE.0) GOTO 77777
- IW4=0
- DO 1 I=1,NW
- IW2(2)=IARRAY(I)
- 1 IARRAY(I)=IW4
-77777 RETURN
- END
-#endif
diff --git a/src/packlib/epio/obsolete/ibm/iwd16ibm.F b/src/packlib/epio/obsolete/ibm/iwd16ibm.F
deleted file mode 100644
index 28c2ab7..0000000
--- a/src/packlib/epio/obsolete/ibm/iwd16ibm.F
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: iwd16ibm.F,v 1.1.1.1 1996/03/08 15:21:51 mclareni Exp $
-*
-* $Log: iwd16ibm.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:51 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_IBM)||defined(CERNLIB_ND100B32)
- FUNCTION IWD16(M,N)
-C--- FUNCTION RETURNS 16 BIT WORD NO. N OUT OF
-C--- 32 BIT WORD ARRAY M.
-#if defined(CERNLIB_NORD)
- INTEGER*4 IWD16,N,IOUT
-#endif
- INTEGER*2 M(2),I16O(2)
- EQUIVALENCE (IOUT,I16O(1))
- I16O(1)=0
- I16O(2)=M(N)
- IWD16=IOUT
- RETURN
- END
-#endif
diff --git a/src/packlib/epio/obsolete/ibm/sfrascib.F b/src/packlib/epio/obsolete/ibm/sfrascib.F
deleted file mode 100644
index 3521611..0000000
--- a/src/packlib/epio/obsolete/ibm/sfrascib.F
+++ /dev/null
@@ -1,48 +0,0 @@
-*
-* $Id: sfrascib.F,v 1.1.1.1 1996/03/08 15:21:51 mclareni Exp $
-*
-* $Log: sfrascib.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:51 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_IBM)
- SUBROUTINE SFRASC(SOURCE,N1,TARGET,N2,NCH)
-C.+++++++ IBM VERSION ++++++++++
-C. CONVERTS A HOLLERITH STRING FROM ASCII TO EBCDIC (IBM INTERNAL)
-C.
-C. PARAMETERS
-C.
-C. SOURCE ARRAY CONTAINING THE ASCII STRING
-C. N1 FIRST CHARACTER IN SOURCE TO CONVERT
-C. TARGET ARRAY RECEIVING THE EBCDIC STRING
-C. N2 FIRST CHARACTER POSITION OF CONVERTED STRING IN TARGET
-C. NCH NUMBER OF CHARACTERS TO CONVERT
-C.
-C. THE ROUTINE ALLOWS THE SIMULTANEOUS CONVERSION AND CONCATENATION
-C. OF A STRING. ON VAX, IBM ( NOT CDC ! ), SOURCE AND TARGET MAY OVERLAP
-C. AS LONG AS N2.LE.N1 .
-C.
- LOGICAL*1 SOURCE(NCH),TARGET(NCH)
-#include "epio/asciiibm.inc"
- LOGICAL*1 IFASC1(256)
- EQUIVALENCE (IFASC1(1),IFASC4(1))
- LOGICAL*1 LK(4)
- EQUIVALENCE (K,LK(1))
- DATA IFI /0/, K/0/
- IF(IFI.NE.0) GOTO 10
-C--- INITIALIZE
- CALL CFRASC(IFI,0)
- IFI=1
- 10 CONTINUE
- IF(NCH.LE.0) GOTO 77777
- NS1=N1-1
- NS2=N2-1
- DO 20 I=1,NCH
- LK(4)= SOURCE(NS1+I)
- K=MAX0(K,1)
- 20 TARGET(NS2+I)=IFASC1(K)
-77777 RETURN
- END
-#endif
diff --git a/src/packlib/epio/obsolete/ibm/stoascib.F b/src/packlib/epio/obsolete/ibm/stoascib.F
deleted file mode 100644
index f8cf38c..0000000
--- a/src/packlib/epio/obsolete/ibm/stoascib.F
+++ /dev/null
@@ -1,48 +0,0 @@
-*
-* $Id: stoascib.F,v 1.1.1.1 1996/03/08 15:21:51 mclareni Exp $
-*
-* $Log: stoascib.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:51 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_IBM)
- SUBROUTINE STOASC(SOURCE,N1,TARGET,N2,NCH)
-C.+++++++ IBM VERSION ++++++++++
-C. CONVERTS A HOLLERITH STRING FROM EBCDIC (IBM INTERNAL) TO ASCII
-C.
-C. PARAMETERS
-C.
-C. SOURCE ARRAY CONTAINING THE EBCDIC STRING
-C. N1 FIRST CHARACTER IN SOURCE TO CONVERT
-C. TARGET ARRAY RECEIVING THE ASCII STRING
-C. N2 FIRST CHARACTER POSITION OF CONVERTED STRING IN TARGET
-C. NCH NUMBER OF CHARACTERS TO CONVERT
-C.
-C. THE ROUTINE ALLOWS THE SIMULTANEOUS CONVERSION AND CONCATENATION
-C. OF A STRING. ON VAX, IBM ( NOT CDC ! ), SOURCE AND TARGET MAY OVERLAP
-C. AS LONG AS N2.LE.N1 .
-C.
- LOGICAL*1 SOURCE(NCH),TARGET(NCH)
-#include "epio/asciiibm.inc"
- LOGICAL*1 ITASC1(256)
- EQUIVALENCE (ITASC1(1),ITASC4(1))
- LOGICAL*1 LK(4)
- EQUIVALENCE (K,LK(1))
- DATA IFI /0/, K/0/
- IF(IFI.NE.0) GOTO 10
-C--- INITIALIZE
- CALL CFRASC(IFI,0)
- IFI=1
- 10 CONTINUE
- IF(NCH.LE.0) GOTO 77777
- NS1=N1-1
- NS2=N2-1
- DO 20 I=1,NCH
- LK(4)= SOURCE(NS1+I)
- K=MAX0(K,1)
- 20 TARGET(NS2+I)=ITASC1(K)
-77777 RETURN
- END
-#endif
diff --git a/src/packlib/epio/obsolete/ibm/w16movib.s b/src/packlib/epio/obsolete/ibm/w16movib.s
deleted file mode 100644
index 2dbb37c..0000000
--- a/src/packlib/epio/obsolete/ibm/w16movib.s
+++ /dev/null
@@ -1,115 +0,0 @@
-*
-* $Id: w16movib.s,v 1.1.1.1 1996/03/08 15:21:51 mclareni Exp $
-*
-* $Log: w16movib.s,v $
-* Revision 1.1.1.1 1996/03/08 15:21:51 mclareni
-* Epio
-*
-*
-* IBM ASSEMBLER CODE
-#if defined(CERNLIB_IBM)
- TITLE 'W16MOV'
- PRINT NOGEN
-W16MOV CSECT
-#if defined(CERNLIB_QMIBMXA)
-W16MOV AMODE ANY
-W16MOV RMODE ANY
-#endif
-***********************************************************************
-* *
-* W 1 6 M O V *
-* =========== *
-* *
-***********************************************************************
-* *
-* FUNCTION: MOVE HALFWORDS *
-* *
-* CALLING SEQUENCE: CALL W16MOV(SOURCE,N1,TARGET,N2,N3) *
-* *
-* ARGUMENTS: SOURCE - SOURCE OF HALFWORDS TO BE MOVED *
-* N1 - FIRST HALFWORD TO BE MOVED FROM SOURCE *
-* TARGET - TARGET FOR THE MOVED HALFWORDS *
-* N2 - FIRST HALFWORD TO BE USED IN TARGET *
-* N3 - NUMBER OF HALFWORDS TO BE MOVED *
-* *
-***********************************************************************
- EJECT
-***********************************************************************
-* *
-* M O D I F I C A T I O N L O G *
-* =============================== *
-* *
-***********************************************************************
-* *
-* 1 . 0 0 *
-* ======= *
-* *
-* ORIGINAL VERSION. *
-* *
-* R. MATTHEWS, CERN/DD, SEPTEMBER 1983. *
-* *
-***********************************************************************
- EJECT
-R0 EQU 0
-R1 EQU 1
-R2 EQU 2
-R3 EQU 3
-R4 EQU 4
-R5 EQU 5
-R6 EQU 6
-R7 EQU 7
-R8 EQU 8
-R9 EQU 9
-R10 EQU 10
-R11 EQU 11
-R12 EQU 12
-R13 EQU 13
-R14 EQU 14
-R15 EQU 15
- EJECT
-* P R O L O G U E
- SPACE
- USING W16MOV,R15
- B SAVEREGS
- DC AL1(7),CL7'W16MOV' IDENTIFIER
- DC C'1.00' VERSION.MODIFICATION LEVEL
-SAVEREGS STM R14,R12,12(R13)
- LR R4,R13
- CNOP 0,4
- BAL R13,AROUNDSA
-SAVEAREA DC A(EPILOGUE),17F'0'
- DROP R15
- USING SAVEAREA,R13
-AROUNDSA ST R13,8(0,R4)
- ST R4,4(0,R13)
- XC 8(4,R13),8(R13)
- SPACE 2
- LM R2,R6,0(R1) R2 -> SOURCE; R3 -> STARTING LOCATION
-* R4 -> TARGET; R5 -> STARTING LOCATION
-* R6 -> NUMBER OF HALFWORDS TO MOVE
- L R6,0(0,R6) R6 := NUMBER OF HALFWORDS TO MOVE
- LTR R6,R6 IS IT GREATER THAN ZERO ?
- BNP EPILOGUE NO, BRANCH
- L R3,0(0,R3) R3 := STARTING LOCATION IN SOURCE
- BCTR R3,0 SUBTRACT 1
- SLL R3,1 MULTIPLY BY 2
- AR R2,R3 R2 -> STARTING LOCATION IN SOURCE
- L R5,0(0,R5) R5 := STARTING LOCATION IN TARGET
- BCTR R5,0 SUBTRACT 1
- SLL R5,1 MULTIPLY BY 2
- AR R4,R5 R4 -> STARTING LOCATION IN SOURCE
- SLL R6,1 R6 := NUMBER OF BYTES TO MOVE
- LR R3,R6 R3 := NUMBER OF BYTES TO MOVE
- LR R5,R6 R5 := NUMBER OF BYTES TO MOVE
- MVCL R4,R2 PERFORM THE MOVE
- SPACE 2
-* E P I L O G U E
- SPACE
-EPILOGUE EQU *
- L R13,4(0,R13)
- LM R14,R12,12(R13)
- MVI 12(R13),X'FF'
- BR R14
- SPACE 2
- END
-#endif
diff --git a/src/packlib/epio/obsolete/nord/blo16n16.F b/src/packlib/epio/obsolete/nord/blo16n16.F
deleted file mode 100644
index e183505..0000000
--- a/src/packlib/epio/obsolete/nord/blo16n16.F
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: blo16n16.F,v 1.1.1.1 1996/03/08 15:21:57 mclareni Exp $
-*
-* $Log: blo16n16.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:57 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_ND100B16)
- SUBROUTINE BLO16W(SOURCE,N1,TARGET,N2,N3)
-C.+++++++ NORD 10/100 VERSION ++++++++++
-C. BLOWS (UNPACKS) 16 BIT WORDS INTO MACHINE WORDS
-C. N10/100 : COPY WITH NO OVERLAP
-C.
-C. INPUT
-C. SOURCE ARRAY CONTAINING 16 BIT WORDS IN PACKED FORM
-C. N1 FIRST 16 BIT WORD IN SOURCE TO BLOW
-C. TARGET TARGET ARRAY FOR UNPACKED 16 BIT WORDS
-C. N2 TARGET(N2) WILL CONTAIN FIRST UNPACKED WORD
-C. N3 NO. OF 16 BIT WORDS TO UNPACK
- INTEGER*2 N1,N2,N3,TARGET(2),ZERO
- INTEGER*2 SOURCE(2)
- DATA ZERO/0/
- IF(N3.LE.ZERO) GOTO 77777
- I1=N1-1
- I2=N2-1
- DO 1 I=1,N3
- 1 TARGET(I2+I)=SOURCE(I1+I)
-77777 RETURN
- END
-#endif
diff --git a/src/packlib/epio/obsolete/nord/blo16wno.F b/src/packlib/epio/obsolete/nord/blo16wno.F
deleted file mode 100644
index 184bf68..0000000
--- a/src/packlib/epio/obsolete/nord/blo16wno.F
+++ /dev/null
@@ -1,35 +0,0 @@
-*
-* $Id: blo16wno.F,v 1.1.1.1 1996/03/08 15:21:59 mclareni Exp $
-*
-* $Log: blo16wno.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:59 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_ND100B32)
- SUBROUTINE BLO16W(SOURCE,N1,TARGET,N2,N3)
-C.+++++++ NORD 100 32-BIT VERSION ++++++++++
-C. BLOWS (UNPACKS) 16 BIT WORDS INTO MACHINE WORDS(32 BIT).
-C.
-C. INPUT
-C. SOURCE ARRAY CONTAINING 16 BIT WORDS IN PACKED FORM
-C. N1 FIRST 16 BIT WORD IN SOURCE TO BLOW
-C. TARGET TARGET ARRAY FOR UNPACKED 16 BIT WORDS
-C. N2 TARGET(N2) WILL CONTAIN FIRST UNPACKED WORD
-C. N3 NO. OF 16 BIT WORDS TO UNPACK
- INTEGER*4 N1,N2,N3,TARGET(2),IW4,ZERO
- INTEGER*2 SOURCE(2),IW2(2)
- EQUIVALENCE (IW2(1),IW4)
- DATA ZERO/0/
- IF(N3.LE.ZERO) GOTO 77777
- I1=N1-1
- I2=N2-1
- IW4=0
- I3=N3
- DO 1 I=1,I3
- IW2(2)=SOURCE(I1+I)
- 1 TARGET(I2+I)=IW4
-77777 RETURN
- END
-#endif
diff --git a/src/packlib/epio/obsolete/nord/blo32n16.F b/src/packlib/epio/obsolete/nord/blo32n16.F
deleted file mode 100644
index 7f05cb0..0000000
--- a/src/packlib/epio/obsolete/nord/blo32n16.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: blo32n16.F,v 1.1.1.1 1996/03/08 15:21:57 mclareni Exp $
-*
-* $Log: blo32n16.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:57 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_ND100B16)
- SUBROUTINE BLO32W(SOURCE,N1,TARGET,N2,N3)
-C.+++++++ NORD 10/100 16-BIT VERSION ++++++++++
-C. MOVES 32 BIT WORDS INTO 32 BIT WORDS. STARTS ON ANY
-C. 16 BIT WORD IN SOURCE.
-C.
-C. +++ IMPORTANT +++ COUNTS PARTLY IN 16 BIT WORDS
-C.
-C. INPUT
-C. SOURCE SOURCE ARRAY
-C. N1 FIRST 16 BIT WORD IN SOURCE
-C. TARGET TARGET ARRAY
-C. N2 FIRST COPIED WORD IS TARGET(N2)
-C. N3 NO. OF 32 BIT WORDS TO COPY
- INTEGER*2 N1,N2,N3,SOURCE(2),TARGET(2)
- CALL W16MOV(SOURCE,N1,TARGET,2*N2-1,2*N3)
- RETURN
- END
-#endif
diff --git a/src/packlib/epio/obsolete/nord/blo8wn16.F b/src/packlib/epio/obsolete/nord/blo8wn16.F
deleted file mode 100644
index e631115..0000000
--- a/src/packlib/epio/obsolete/nord/blo8wn16.F
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: blo8wn16.F,v 1.1.1.1 1996/03/08 15:21:57 mclareni Exp $
-*
-* $Log: blo8wn16.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:57 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_ND100B16)
- SUBROUTINE BLO8W(SOURCE,N1,TARGET,N2,N3)
-C +++++++++NORD 10/100 16-BIT VERSION++++++++++++
-C VERSION 82-05-06
-C BLOWS(UNPACKS) 8 BIT BYTES INTO MACHINE WORDS
-C
-C. INPUT
-C. SOURCE ARRAY COTAINING 8 BIT BYTES IN PACKED FORM
-C. N1 FIRST 8 BIT BYTE IN SOURCE TO BLOW(NUMBERING FROM 1)
-C. TARGET TARGET ARRAY FOR UNPACKED BYTES
-C. TARGET(N2) WILL CONTAIN FIRST UNPACKED BYTE
-C. N3 NO. OF BYTES TO UNPACK
- INTEGER*2 N1,N2,N3
- INTEGER*2 SOURCE(2)
- INTEGER*2 TARGET(2)
- IF(N3.LE.0) RETURN
- I1=N1-2
- I2=N2-1
- DO FOR J=1,N3
- TARGET(I2+J)=JLBYT(SOURCE,I1+J)
- ENDDO
- RETURN
- END
-#endif
diff --git a/src/packlib/epio/obsolete/nord/blo8wno.F b/src/packlib/epio/obsolete/nord/blo8wno.F
deleted file mode 100644
index d367c1b..0000000
--- a/src/packlib/epio/obsolete/nord/blo8wno.F
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: blo8wno.F,v 1.1.1.1 1996/03/08 15:21:59 mclareni Exp $
-*
-* $Log: blo8wno.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:59 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_ND100B32)
- SUBROUTINE BLO8W(SOURCE,N1,TARGET,N2,N3)
-C.+++++++ NORD 100 32-BIT VERSION ++++++++++
-C. BLOWS (UNPACKS) 8 BIT BYTES INTO MACHINE WORDS(32 BIT).
-C.
-C. INPUT
-C. SOURCE ARRAY CONTAINING 8 BIT BYTES IN PACKED FORM
-C. N1 FIRST 8 BIT BYTE IN SOURCE TO BLOW
-C. TARGET TARGET ARRAY FOR UNPACKED 8 BIT BYTES
-C. N2 TARGET(N2) WILL CONTAIN FIRST UNPACKED WORD
-C. N3 NO. OF 8 BIT BYTES TO UNPACK
- INTEGER*4 N1,N2,N3,ZERO
- INTEGER*4 SOURCE(2),TARGET(2)
- DATA ZERO/0/
- IF(N3.LE.ZERO) GOTO 77777
- I1=N1-2
- I2=N2-1
- JMAX=N3
- DO 1 J=1,JMAX
- 1 TARGET(I2+J)=JLBYT(SOURCE,I1+J)
-77777 RETURN
- END
-#endif
diff --git a/src/packlib/epio/obsolete/nord/blobun16.s b/src/packlib/epio/obsolete/nord/blobun16.s
deleted file mode 100644
index efd43ee..0000000
--- a/src/packlib/epio/obsolete/nord/blobun16.s
+++ /dev/null
@@ -1,60 +0,0 @@
-*
-* $Id: blobun16.s,v 1.1.1.1 1996/03/08 15:21:55 mclareni Exp $
-*
-* $Log: blobun16.s,v $
-* Revision 1.1.1.1 1996/03/08 15:21:55 mclareni
-* Epio
-*
-*
-#if defined(CERNLIB_ND50)||defined(CERNLIB_ND500)
- MODULE M_BLOBUN16W
-% SOURCE AND TARGET MAY BE THE SAME, BUT NOT OVERLAP PARTIALLY
-% CALL BLO16W(SOURCE,N1,TARGET,N2,N3)
-% UNPACKS 16 BIT WORDS INTO 32 BIT WORDS WITHOUT SIGN EXTENSION
-% CALL BUN16W(SOURCE,N1,TARGET,N2,N3)
-% PACKS RIGHT HALF OF 32 BITS WORDS INTO A CONTIGUOUS STRING OF 16 BIT WORDS
-% VERSION 811001
- EXPORT BLO16W,BUN16W
- ROUTINE BLO16W,BUN16W
- LIB BLO16W,BUN16W
-VBAS: STACK FIXED
-PAR: W BLOCK 5
-SRCE: W BLOCK 1
-TRGT: W BLOCK 1
- ENDSTACK
-BLO16W: ENTF VBAS
- W1 CLR
- W2:=IND(B.PAR+16)
- IF <= GO BACK
- W2-1
- W3:=IND(B.PAR+4)
- W3-1
- W3 MULAD 2,B.PAR
- W3=:B.SRCE
- W4:=IND(B.PAR+12)
- W4-1
- W4 MULAD 4,B.PAR+8
- W4=:B.TRGT
-LOOP1: H3:=IND(B.SRCE)(R2)
- W3=:IND(B.TRGT)(R2)
- W LOOPD R2,R1,LOOP1
- RET
-BUN16W: ENTF VBAS
- W1 CLR
- W2:=IND(B.PAR+16)
- IF <= GO BACK
- W2-1
- W3:=IND(B.PAR+4)
- W3-1
- W3 MULAD 4,B.PAR
- W3=:B.SRCE
- W4:=IND(B.PAR+12)
- W4-1
- W4 MULAD 2,B.PAR+8
- W4=:B.TRGT
-LOOP2: W HCONV IND(B.SRCE)(R1),IND(B.TRGT)(R1)
- W LOOPI R1,R2,LOOP2
-BACK: RET
- ENDROUTINE
- ENDMODULE
-#endif
diff --git a/src/packlib/epio/obsolete/nord/blobun32.s b/src/packlib/epio/obsolete/nord/blobun32.s
deleted file mode 100644
index 868852f..0000000
--- a/src/packlib/epio/obsolete/nord/blobun32.s
+++ /dev/null
@@ -1,44 +0,0 @@
-*
-* $Id: blobun32.s,v 1.1.1.1 1996/03/08 15:21:55 mclareni Exp $
-*
-* $Log: blobun32.s,v $
-* Revision 1.1.1.1 1996/03/08 15:21:55 mclareni
-* Epio
-*
-*
-#if defined(CERNLIB_ND50)||defined(CERNLIB_ND500)
- MODULE M_BLOBUN32W
-% CALL BLO32W(SOURCE,N1,TARGET,N2,N3)
-% MOVES 32 BIT WORDS INTO 32 BIT WORDS. CAN START ON 16 BIT BOUNDARY IN SOURCE
-% CALL BUN32W(SOURCE,N1,TARGET,N2,N3)
-% MOVES 32 BIT WORDS INTO 32 BIT WORDS. CAN START ON 16 BIT BOUNDARY IN TARGET
-% VERSION 811002
- EXPORT BLO32W,BUN32W
- ROUTINE BLO32W,BUN32W
- LIB BLO32W,BUN32W
-VBAS: STACK FIXED
-PAR: W BLOCK 5
- ENDSTACK
-BLO32W: ENTF VBAS
- W4:=IND(B.PAR+16)
- IF <= GO BACK
- W1:=IND(B.PAR+4)
- W1-1
- W1 MULAD 2,B.PAR
- W2:=IND(B.PAR+12)
- W2-1
- W BMOVE R1.0,IND(B.PAR+8)(R2),R4
- RET
-BUN32W: ENTF VBAS
- W4:=IND(B.PAR+16)
- IF <= GO BACK
- W1:=IND(B.PAR+4)
- W1-1
- W2:=IND(B.PAR+12)
- W2-1
- W2 MULAD 2,B.PAR+8
- W BMOVE IND(B.PAR)(R1),R2.0,R4
-BACK: RET
- ENDROUTINE
- ENDMODULE
-#endif
diff --git a/src/packlib/epio/obsolete/nord/blobun8.s b/src/packlib/epio/obsolete/nord/blobun8.s
deleted file mode 100644
index cd7a06e..0000000
--- a/src/packlib/epio/obsolete/nord/blobun8.s
+++ /dev/null
@@ -1,60 +0,0 @@
-*
-* $Id: blobun8.s,v 1.1.1.1 1996/03/08 15:21:55 mclareni Exp $
-*
-* $Log: blobun8.s,v $
-* Revision 1.1.1.1 1996/03/08 15:21:55 mclareni
-* Epio
-*
-*
-#if defined(CERNLIB_ND50)||defined(CERNLIB_ND500)
- MODULE M_BLOBUN8W
-% SOURCE AND TARGET MAY BE THE SAME, BUT NOT OVERLAP PARTIALLY
-% CALL BLO8W(SOURCE,N1,TARGET,N2,N3)
-% UNPACKS 8 BIT WORDS INTO 32 BIT WORDS WITHOUT SIGN EXTENSION
-% CALL BUN8W(SOURCE,N1,TARGET,N2,N3)
-% PACKS RIGHT BYTE OF 32 BIT WORDS INTO A CONTIGUOUS STRING OF 8 BIT BYTES
-% VERSION 811001
- EXPORT BLO8W,BUN8W
- ROUTINE BLO8W,BUN8W
- LIB BLO8W,BUN8W
-VBAS: STACK FIXED
-PAR: W BLOCK 5
-SRCE: W BLOCK 1
-TRGT: W BLOCK 1
- ENDSTACK
-BLO8W: ENTF VBAS
- W1 CLR
- W2:=IND(B.PAR+16)
- IF <= GO BACK
- W2-1
- W3:=IND(B.PAR+4)
- W3-1
- W3+B.PAR
- W3=:B.SRCE
- W4:=IND(B.PAR+12)
- W4-1
- W4 MULAD 4,B.PAR+8
- W4=:B.TRGT
-LOOP1: BY3:=IND(B.SRCE)(R2)
- W3=:IND(B.TRGT)(R2)
- W LOOPD R2,R1,LOOP1
- RET
-BUN8W: ENTF VBAS
- W1 CLR
- W2:=IND(B.PAR+16)
- IF <= GO BACK
- W2-1
- W3:=IND(B.PAR+4)
- W3-1
- W3 MULAD 4,B.PAR
- W3=:B.SRCE
- W4:=IND(B.PAR+12)
- W4-1
- W4+B.PAR+8
- W4=:B.TRGT
-LOOP2: W BYCONV IND(B.SRCE)(R1),IND(B.TRGT)(R1)
- W LOOPI R1,R2,LOOP2
-BACK: RET
- ENDROUTINE
- ENDMODULE
-#endif
diff --git a/src/packlib/epio/obsolete/nord/bun16n16.F b/src/packlib/epio/obsolete/nord/bun16n16.F
deleted file mode 100644
index 7e2eeaa..0000000
--- a/src/packlib/epio/obsolete/nord/bun16n16.F
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: bun16n16.F,v 1.1.1.1 1996/03/08 15:21:57 mclareni Exp $
-*
-* $Log: bun16n16.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:57 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_ND100B16)
- SUBROUTINE BUN16W(SOURCE,N1,TARGET,N2,N3)
-C.+++++++ NORD 10/100 16-BIT VERSION ++++++++++
-C. BUNCHES (PACKS) 16 BIT WORDS (RIGHT ADJ., ZERO FILLED)
-C. INTO A CONTIGUOUS BIT STRING.
-C. COPY WITH NO OVERLAP !
-C.
-C. INPUT
-C. SOURCE ARRAY CONTAINING 16 BIT WORDS IN UNPACKED FORM
-C. N1 FIRST 16 BIT WORD IN SOURCE TO BE PACKED
-C. TARGET TARGET ARRAY FOR PACKED 16 BIT WORDS
-C. N2 FIRST 16 BIT WORD IN TARGET TO PACK TO
-C. N3 NO. OF 16 BIT WORDS TO PACK
- INTEGER*2 N1,N2,N3,SOURCE(2),ZERO
- INTEGER*2 TARGET(2)
- DATA ZERO/0/
- IF(N3.LE.ZERO) GOTO 77777
- I1=N1-1
- I2=N2-1
- DO 1 I=1,N3
- 1 TARGET(I2+I)=SOURCE(I1+I)
-77777 RETURN
- END
-#endif
diff --git a/src/packlib/epio/obsolete/nord/bun16wno.F b/src/packlib/epio/obsolete/nord/bun16wno.F
deleted file mode 100644
index 490fd89..0000000
--- a/src/packlib/epio/obsolete/nord/bun16wno.F
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: bun16wno.F,v 1.1.1.1 1996/03/08 15:21:59 mclareni Exp $
-*
-* $Log: bun16wno.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:59 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_ND100B32)
- SUBROUTINE BUN16W(SOURCE,N1,TARGET,N2,N3)
-C.+++++++ NORD 100 32-BIT VERSION ++++++++++
-C. BUNCHES (PACKS) 16 BIT WORDS (RIGHT ADJ., ZERO FILLED)
-C. INTO A CONTIGUOUS BIT STRING.
-C.
-C. INPUT
-C. SOURCE ARRAY CONTAINING 16 BIT WORDS IN UNPACKED FORM
-C. N1 FIRST 16 BIT WORD IN SOURCE TO BE PACKED
-C. TARGET TARGET ARRAY FOR PACKED 16 BIT WORDS
-C. N2 FIRST 16 BIT WORD IN TARGET TO PACK TO
-C. N3 NO. OF 16 BIT WORDS TO PACK
- INTEGER*4 N1,N2,N3,SOURCE(2),ZERO
- INTEGER*2 TARGET(2)
- DATA ZERO/0/
- IF(N3.LE.ZERO) GOTO 77777
- I1=N1-1
- I2=N2-1
- I3=N3
- DO 1 I=1,I3
- 1 TARGET(I2+I)=SOURCE(I1+I)
-77777 RETURN
- END
-#endif
diff --git a/src/packlib/epio/obsolete/nord/bun32n16.F b/src/packlib/epio/obsolete/nord/bun32n16.F
deleted file mode 100644
index 6b5345b..0000000
--- a/src/packlib/epio/obsolete/nord/bun32n16.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: bun32n16.F,v 1.1.1.1 1996/03/08 15:21:57 mclareni Exp $
-*
-* $Log: bun32n16.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:57 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_ND100B16)
- SUBROUTINE BUN32W(SOURCE,N1,TARGET,N2,N3)
-C.+++++++ NORD 100 16-BIT VERSION ++++++++++
-C. MOVES 32 BIT WORDS INTO 32 BIT WORDS. STARTS ON ANY
-C. 16 BIT WORD IN TARGET.
-C.
-C. +++ IMPORTANT +++ COUNTS PARTLY IN 16 BIT WORDS
-C.
-C. INPUT
-C. SOURCE SOURCE ARRAY
-C. N1 FIRST WORD TO COPY IS SOURCE(N1)
-C. TARGET TARGET ARRAY
-C. N2 FIRST 16 BIT WORD IN TARGET
-C. N3 NO. OF 32 BIT WORDS TO COPY
- INTEGER*2 N1,N2,N3,SOURCE(2),TARGET(2)
- CALL W16MOV(SOURCE,2*N1-1,TARGET,N2,2*N3)
- RETURN
- END
-#endif
diff --git a/src/packlib/epio/obsolete/nord/bun8wn16.F b/src/packlib/epio/obsolete/nord/bun8wn16.F
deleted file mode 100644
index 8a83e3e..0000000
--- a/src/packlib/epio/obsolete/nord/bun8wn16.F
+++ /dev/null
@@ -1,35 +0,0 @@
-*
-* $Id: bun8wn16.F,v 1.1.1.1 1996/03/08 15:21:57 mclareni Exp $
-*
-* $Log: bun8wn16.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:57 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_ND100B16)
- SUBROUTINE BUN8W(SOURCE,N1,TARGET,N2,N3)
-C ++++++++NORD 10/100 VERSION+++++++++
-C VERSION 82-05-06
-C BUNCHES(PACKS) B BIT BYTES(RIGHT ADJUSTED ZERO FILLED)
-C INTO CONTIGUOS BIT STRING.
-C
-C. INPUT
-C SOURCE ARRAY CONTAINING 8 BIT BYTES IN UNPACKED FORM
-C N1 FIRST 8 BIT BYTE(RIGHT ADJUSTED IE FIRST WORD) IN SOURCE TO BE PACK
-C TARGET TARGET ARRAY FOR PACKED BYTES
-C N2 FIRST 8 BIT BYTE IN TARGET TO PACK TO
-C N3 NO. OF BYTES TO BE PACKED
- INTEGER*2 N1,N2,N3
- INTEGER*2 SOURCE(2)
- INTEGER*2 TARGET(2)
- IF(N3.LE.0)RETURN
- I1=N1-1
- I2=N2-2
- DO FOR J=1,N3
- IBYTE=SOURCE(I1+J)
- CALL ZSBYT(IBYTE,TARGET,I2+J)
- ENDDO
- RETURN
- END
-#endif
diff --git a/src/packlib/epio/obsolete/nord/bun8wno.F b/src/packlib/epio/obsolete/nord/bun8wno.F
deleted file mode 100644
index 3e6d743..0000000
--- a/src/packlib/epio/obsolete/nord/bun8wno.F
+++ /dev/null
@@ -1,35 +0,0 @@
-*
-* $Id: bun8wno.F,v 1.1.1.1 1996/03/08 15:21:59 mclareni Exp $
-*
-* $Log: bun8wno.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:59 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_ND100B32)
- SUBROUTINE BUN8W(SOURCE,N1,TARGET,N2,N3)
-C.+++++++ NORD 100 32-BIT VERSION+++++++
-C. BUNCHES (PACKS) 8 BIT BYTES (RIGHT ADJ., ZERO FILLED)
-C. INTO A CONTIGUOUS BIT STRING.
-C.
-C.
-C. INPUT
-C. SOURCE ARRAY CONTAINING 8 BIT BYTES IN UNPACKED FORM
-C. N1 FIRST 8 BIT BYTE IN SOURCE TO BE PACKED
-C. TARGET TARGET ARRAY FOR PACKED 8 BIT BYTES
-C. N2 FIRST 8 BIT BYTE IN TARGET TO PACK TO
-C. N3 NO. OF 8 BIT BYTES TO PACK
- INTEGER*4 N1,N2,N3,ZERO
- INTEGER*4 SOURCE(2),TARGET(2)
- DATA ZERO/0/
- IF(N3.LE.ZERO)GO TO 77777
- I1=N1-1
- I2=N2-2
- JMAX=N3
- DO 1 J=1,JMAX
- IBYTE=SOURCE(I1+J)
- 1 CALL ZSBYT(IBYTE,TARGET,I2+J)
-77777 RETURN
- END
-#endif
diff --git a/src/packlib/epio/obsolete/nord/cfribm16.F b/src/packlib/epio/obsolete/nord/cfribm16.F
deleted file mode 100644
index 6cd3740..0000000
--- a/src/packlib/epio/obsolete/nord/cfribm16.F
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: cfribm16.F,v 1.1.1.1 1996/03/08 15:21:57 mclareni Exp $
-*
-* $Log: cfribm16.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:57 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_ND100B16)
- SUBROUTINE CFRIBM(ARRAY,NW,MODE)
-C +++++++NORD10/100 VERSION++++++++++
-C VERSION 82-05-06
-C
-C CONVERT FIRST NW WORDS OF ARRAY FROM IBM TO NORD FORMAT.
-C MODE = 1 CONVERT TO 16 BIT INTEGER(DUMMY)
-C 2 CONVERT TO 32 BIT INTEGER(DUMMY)
-C 3 CONVERT TO 32 BIT FLOATING
-C ON RETURN,ARRAY CONTAINS CONVERTED VALUES.
- INTEGER *4 ARRAY(2)
- IF(NW.LE.0)RETURN
- IF(MODE.EQ.3)THEN
- CALL CFRIB(ARRAY,NW)
- ENDIF
-C ELSE DUMMY
- END
-#endif
diff --git a/src/packlib/epio/obsolete/nord/cfribm50.F b/src/packlib/epio/obsolete/nord/cfribm50.F
deleted file mode 100644
index 3912292..0000000
--- a/src/packlib/epio/obsolete/nord/cfribm50.F
+++ /dev/null
@@ -1,92 +0,0 @@
-*
-* $Id: cfribm50.F,v 1.1.1.1 1996/03/08 15:21:59 mclareni Exp $
-*
-* $Log: cfribm50.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:59 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_ND50)
- SUBROUTINE CFRIBM(A,N,MODE)
-C.
-C.
-C. ******************************************************************
-C. * *
-C. * *
-C. * CONVERT N WORDS OF ARRAY A FROM IBM FORMAT TO NORD *
-C. * *
-C. * MODE=1 16 BIT SIGNED INTEGER *
-C. * =2 32 BIT SIGNED INTEGER *
-C. * =3 FLOATING POINT *
-C. * *
-C. * *
-C. ******************************************************************
-C.
- DIMENSION A(1)
- EQUIVALENCE (TEMP,JTEMP)
-C.
-C.
-C. ------------------------------------------------------------------
-C.
-C.
- IF (N.LE.0) GO TO 99
- IF (MODE.NE.3) GO TO 60
-C
-C=====> CONVERT FROM IBM F.P TO NORD F.P
-C
- DO 50 I = 1,N
- TEMP = A(I)
- IF(TEMP.EQ.0.) GO TO 50
- NSIGN = IAND(JTEMP,20000000000B)
- NCHIBM = IAND(ISHFT(JTEMP,-24),177B)
- NMAIBM = IAND(JTEMP,77777777B)
- NCHND = 4 * NCHIBM - 3
-C
-C NORMALIZE
-C
- IF (IAND(NMAIBM,40000000B).NE.0) GO TO 40
- IF (IAND(NMAIBM,20000000B).NE.0) GO TO 30
- IF (IAND(NMAIBM,10000000B).NE.0) GO TO 20
- IF (IAND(NMAIBM, 4000000B).NE.0) GO TO 10
-C
-C BAD MANTISSA
-C
- GO TO 50
-C
- 10 NSH = 2
- GO TO 45
- 20 NSH = 1
- GO TO 45
- 30 NSH = 0
- GO TO 45
- 40 NSH = - 1
-C
- 45 NCHND = NCHND + (2 - NSH)
- NMAND = ISHFT(NMAIBM,NSH)
-C
-C STORE
-C
- CALL SBYT(NMAND,TEMP,1,22)
- CALL SBYT(NCHND,TEMP,23,9)
- CALL SBIT(NSIGN,TEMP,32)
- A(I) = TEMP
- 50 CONTINUE
- GO TO 99
-C
-C=====> CONVERT 32 BIT SIGNED INTEGER
-C
- 60 IF (MODE.NE.2) GO TO 70
- GO TO 99
-C
-C=====> CONVERT 16 BIT SIGNED INTEGER
-C
- 70 IF(MODE.NE.1) GO TO 99
- DO 80 I = 1,N
- TEMP=A(I)
- IF(IAND(JTEMP,100000B).NE.0) CALL SBYT(177777B,A(I),17,16)
- 80 CONTINUE
-C
- 99 RETURN
- END
-#endif
diff --git a/src/packlib/epio/obsolete/nord/cfribmn1.s b/src/packlib/epio/obsolete/nord/cfribmn1.s
deleted file mode 100644
index 64bd136..0000000
--- a/src/packlib/epio/obsolete/nord/cfribmn1.s
+++ /dev/null
@@ -1,40 +0,0 @@
-*
-* $Id: cfribmn1.s,v 1.1.1.1 1996/03/08 15:21:55 mclareni Exp $
-*
-* $Log: cfribmn1.s,v $
-* Revision 1.1.1.1 1996/03/08 15:21:55 mclareni
-* Epio
-*
-*
-#if defined(CERNLIB_ND100B32)
-% SUBROUTINE CFRIB(ARRAY,NW)
-% +++++++NORD10/100 VERSION++++++++++
-% VERSION 1-12-81
-%
-% CONVERT FIRST NW WORDS OF ARRAY FROM IBM TO NORD FORMAT.
-% ON RETURN,ARRAY CONTAINS CONVERTED VALUES.
-)9BEG;)9LIB CFRIB;)9ENT CFRIB;
-%
-%
-%
-%
-CFRIB,SWAP SA DB;COPY SL DD;STD SAVEB;
-LDX I 1,B;RADD SX DX;LDA 0,B;RADD SX DA;COPY SA DB;COPY CM2 SX DX;
-LOOP=*;
-LDD 0,B,X;COPY SA DL;BSET ZRO 170 DA;COPY SA DT;
-SHT ZIN SHR 10;SHT ZIN 2;AAT -1;
-BIT24,BSKP ONE 70 DL;JMP BIT23;AAT 1;SAD ZIN SHR 1;JMP NEXT;
-BIT23,BSKP ZRO 60 DL;JMP NEXT;
-BIT22,BSKP ONE 50 DL;JMP BIT21;AAT -1;SAD ZIN 1;JMP NEXT;
-BIT21,BSKP ONE 40 DL;JMP ERROR;AAT -2;SAD ZIN 2;JMP NEXT;
-ERROR,SAA 0;COPY SA DD;JMP ENDR;
-NEXT,BSKP ONE 110 DT;JMP OK;LDD MAXND;JMP ENDR;
-SKP IF 0 LSS ST;JMP ERROR;
-OK,SHT ZIN 6;AND (77;RADD ST DA;
-ENDR,BSKP ZRO 170 DL;BSET ONE 170 DA;
-STD 0,B,X;RINC DX;JNC LOOP;
-XFRIB,LDD SAVEB;COPY SA DB;COPY SD DP;
-SAVEB,0;0;
-MAXND,77777;177777;
-)FILL;)9END;
-#endif
diff --git a/src/packlib/epio/obsolete/nord/cfribmn5.s b/src/packlib/epio/obsolete/nord/cfribmn5.s
deleted file mode 100644
index 2bcf714..0000000
--- a/src/packlib/epio/obsolete/nord/cfribmn5.s
+++ /dev/null
@@ -1,73 +0,0 @@
-*
-* $Id: cfribmn5.s,v 1.1.1.1 1996/03/08 15:21:55 mclareni Exp $
-*
-* $Log: cfribmn5.s,v $
-* Revision 1.1.1.1 1996/03/08 15:21:55 mclareni
-* Epio
-*
-*
-#if defined(CERNLIB_ND50)||defined(CERNLIB_ND500)
- MODULE M_CFRIBM
-% CALL CFRIBM(ARRAY,NW,MODE)
-% CONVERTS 32 BIT WORDS IN ARRAY FROM IBM FORMATS:
-% NW: NUMBER OF WORDS TO BE CONVERTED
-% MODE=1: SIGN EXTENSION IS DONE INTO LEFT HALF
-% MODE=2: NOTHING IS DONE
-% MODE=3: CONVERTS REALS FROM IBM TO ND FORMAT
-% VERSION 811113
- EXPORT CFRIBM
- ROUTINE CFRIBM
- LIB CFRIBM
-VBAS: STACK FIXED
-PAR: W BLOCK 3
-MAX: W BLOCK 1
- ENDSTACK
-CFRIBM: ENTF VBAS
- W1:=IND(B.PAR+4)
- IF <= GO BACK
- W1-1
- W1=:B.MAX
- W1:=IND(B.PAR+8)
- W1 COMP 1
- IF = GO HALF
- W1 COMP 3
- IF = GO REAL
- RET
-HALF: W4 CLR
- W3:=1
-LOOP1: H WCONV IND(B.PAR)(R3),IND(B.PAR)(R4)
- W3+2
- W LOOPI R4,B.MAX,LOOP1
- RET
-REAL: W4 CLR
-LOOP2: W3:=IND(B.PAR)(R4)
- W1 GETBF R3,24,7 %EXPIBM
- IF >< GO ON
-% TRUE FLOATING ND ZERO FORCED WHEN EXPIBM=0:
- W3 CLR
- GO STORE
-% EXPIBM CANNOT BE TOO BIG FOR EXPND!
-ON: W1*4
- W2 GETBF R3,0,24 %FRACIBM
- W SHL R2,8 %LEFT JUSTIFY
-% REMOVE LEADING ZEROS IN FRACIBM:
- IF < GO MRG1
- W1-1
- W SHL R2,1
- IF < GO MRG1
- W1-1
- W SHL R2,1
- IF < GO MRG1
- W1-1
- W SHL R2,1
- IF < GO MRG1
- GO BACK
-MRG1: W SHL R2,-9
- W2 PUTBF R3,0,22 %FRACND, EXTRA BIT REMOVED
- W1 PUTBF R3,22,9 %EXPND IN PLACE
-STORE: W3=:IND(B.PAR)(R4) %STORE CONVERTED WRD
- W LOOPI R4,B.MAX,LOOP2
-BACK: RET
- ENDROUTINE
- ENDMODULE
-#endif
diff --git a/src/packlib/epio/obsolete/nord/ctoibm50.F b/src/packlib/epio/obsolete/nord/ctoibm50.F
deleted file mode 100644
index 3889196..0000000
--- a/src/packlib/epio/obsolete/nord/ctoibm50.F
+++ /dev/null
@@ -1,79 +0,0 @@
-*
-* $Id: ctoibm50.F,v 1.1.1.1 1996/03/08 15:21:59 mclareni Exp $
-*
-* $Log: ctoibm50.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:59 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_ND50)
- SUBROUTINE CTOIBM(A,N,MODE)
-C.
-C.
-C. ******************************************************************
-C. * *
-C. * *
-C. * CONVERT N WORDS OF ARRAY A FROM NORD FORMAT TO IBM *
-C. * *
-C. * MODE=1 16 BIT SIGNED INTEGER *
-C. * =2 32 BIT SIGNED INTEGER *
-C. * =3 FLOATING POINT *
-C. * *
-C. * *
-C. ******************************************************************
-C.
- DIMENSION A(1)
- EQUIVALENCE (TEMP,JTEMP)
-C.
-C.
-C. ------------------------------------------------------------------
-C.
-C.
- IF (N.LE.0) GO TO 99
- IF (MODE.NE.3) GO TO 60
-C
-C=====> CONVERT FROM NORD F.P TO IBM F.P
-C
- DO 50 I = 1,N
- TEMP = A(I)
- IF(TEMP.EQ.0.) GO TO 50
- NCH = IAND(ISHFT(JTEMP,-22),777B)
- NSIGN = IAND(JTEMP,20000000000B)
-C
-C GET MANTISSA,ADD IN THE 23RD BIT (NORMALIZE)
-C
- NMAND = IAND(JTEMP,17777777B) + 20000000B
-C
-C CALCULATE CHARACTERISTIC FOR IBM
-C
- NCHIBM = (NCH + 3) / 4
-C
-C AND SHIFT COUNT FOR MANTISSA
-C
- NSHMAN = MOD(NCH + 3,4) - 2
-C
-C MAKE UP IBM F.P NUMBER
-C
- JTEMP = ISHFT(NMAND,NSHMAN)
- IF (NSIGN.NE.0)NCHIBM = NCHIBM + 200B
- CALL SBYT(NCHIBM,JTEMP,25,8)
- A(I) = TEMP
- 50 CONTINUE
- GO TO 99
-C
-C=====> CONVERT 32 BIT SIGNED INTEGER
-C
- 60 IF (MODE.NE.2) GO TO 70
- GO TO 99
-C
-C=====> CONVERT 16 BIT SIGNED INTEGER
-C
- 70 IF(MODE.NE.1) GO TO 99
- DO 80 I = 1,N
- CALL SBYT(0,A(I),17,16)
- 80 CONTINUE
-C
- 99 RETURN
- END
-#endif
diff --git a/src/packlib/epio/obsolete/nord/ctoibmn1.s b/src/packlib/epio/obsolete/nord/ctoibmn1.s
deleted file mode 100644
index 21c0ab8..0000000
--- a/src/packlib/epio/obsolete/nord/ctoibmn1.s
+++ /dev/null
@@ -1,38 +0,0 @@
-*
-* $Id: ctoibmn1.s,v 1.1.1.1 1996/03/08 15:21:55 mclareni Exp $
-*
-* $Log: ctoibmn1.s,v $
-* Revision 1.1.1.1 1996/03/08 15:21:55 mclareni
-* Epio
-*
-*
-#if defined(CERNLIB_ND100B32)
-% SUBROUTINE CTOIB(ARRAY,NW)
-% +++++++NORD10/100 VERSION++++++++++
-% VERSION 1-12-81
-% CONVERT FIRST NW WORDS OF ARRAY INTO IBM FORMAT
-% ON RETURN,ARRAY CONTAINS CONVERTED VALUES.
-)9BEG;)9LIB CTOIB;)9ENT CTOIB;
-CTOIB,SWAP SA DB;COPY SL DD;STD SAVEB;
-LDX I 1,B;RADD SX DX;LDA 0,B;RADD SX DA;COPY SA DB;COPY CM2 SX DX;
-LOOP=*;
-LDD 0,B,X;COPY SA DL;BSET ZRO 170 DA;COPY SA DT;
-SHA ZIN SHR 6;AAA 3;STA SAVE;SHA ZIN SHR 2;STA CHIBM;SHA ZIN 2;STA MEM;
-LDA SAVE;SUB MEM;AAA -2;AND (77;ADD INSTR;STA CODE;
-LDA CHIBM;JAF CONT1;SAA 0;COPY SA DD;JMP ENDR;
-CONT1=*;
-BSKP ONE 70 DA;JMP CONT2;LDD MAXND;JMP ENDR;
-CONT2=*;
-SHA ZIN 10;STA CHIBM;
-COPY ST DA;AND (77;BSET ONE 60 DA;
-CODE,SAD ZIN 0;ADD CHIBM;ENDR,BSKP ZRO 170 DL;BSET ONE 170 DA;
-STD 0,B,X;RINC DX;JNC LOOP;
-XTOIB,LDD SAVEB;COPY SA DB;COPY SD DP;
-SAVEB,0;0;
-SAVE,0;
-CHIBM,0;
-MEM,0;
-INSTR,SAD ZIN 0;
-MAXND,77777;177777;
-)FILL;)9END;
-#endif
diff --git a/src/packlib/epio/obsolete/nord/ctoibmn5.s b/src/packlib/epio/obsolete/nord/ctoibmn5.s
deleted file mode 100644
index b4ac43d..0000000
--- a/src/packlib/epio/obsolete/nord/ctoibmn5.s
+++ /dev/null
@@ -1,67 +0,0 @@
-*
-* $Id: ctoibmn5.s,v 1.1.1.1 1996/03/08 15:21:56 mclareni Exp $
-*
-* $Log: ctoibmn5.s,v $
-* Revision 1.1.1.1 1996/03/08 15:21:56 mclareni
-* Epio
-*
-*
-#if defined(CERNLIB_ND50)||defined(CERNLIB_ND500)
- MODULE M_CTOIBM
-% CALL CTOIBM(ARRAY,NW,MODE)
-% CONVERTS 32 BIT WORDS IN ARRAY TO IBM FORMATS:
-% NW: NUMBER OF WORDS TO BE CONVERTED
-% MODE=1: ZEROES THE LEFT HALF OF EACH WORD
-% MODE=2: DOES NOTHING TO THE WORDS
-% MODE=3: CONVERTS REALS FROM ND TO IBM FORMAT
-% VERSION 811016
- EXPORT CTOIBM
- ROUTINE CTOIBM
- LIB CTOIBM
-VBAS: STACK FIXED
-PAR: W BLOCK 3
-MAX: W BLOCK 1
- ENDSTACK
-CTOIBM: ENTF VBAS
- W1:=IND(B.PAR+4)
- IF <= GO BACK
- W1-1
- W1=:B.MAX
- W1:=IND(B.PAR+8)
- W1 COMP 1
- IF = GO HALF
- W1 COMP 3
- IF = GO REAL
- RET
-HALF: W4 CLR
- W3 CLR
-LOOP1: H STZ IND(B.PAR)(R3)
- W3+2
- W LOOPI R4,B.MAX,LOOP1
- RET
-REAL: W4 CLR
-LOOP2: W3:=IND(B.PAR)(R4)
- W1 GETBF R3,22,9 %EXPND
- IF >< GO ON1
-% TRUE FLOATING IBM ZERO FORCED WHEN EXPND=0:
- W3 CLR
- GO STORE
-ON1: W1 COMP 509
- IF < GO ON2
-% MAX IBM FLOATING FORCED WHEN EXPND TOO BIG:
- W3 OR 17777777777B
- GO STORE
-ON2: W1+3
- W2 DIV4 R1,4,R1
- W1 PUTBF R3,24,7 %EXPIBM
- W1 GETBF R3,0,22 %FRACND
- W1+20000000B %EXTRA BIT
- W2-2
- W SHL R1,BY2
- W1 PUTBF R3,0,24 %FRACIBM
-STORE: W3=:IND(B.PAR)(R4)
- W LOOPI R4,B.MAX,LOOP2
-BACK: RET
- ENDROUTINE
- ENDMODULE
-#endif
diff --git a/src/packlib/epio/obsolete/nord/ctoibn16.F b/src/packlib/epio/obsolete/nord/ctoibn16.F
deleted file mode 100644
index de3334b..0000000
--- a/src/packlib/epio/obsolete/nord/ctoibn16.F
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: ctoibn16.F,v 1.1.1.1 1996/03/08 15:21:57 mclareni Exp $
-*
-* $Log: ctoibn16.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:57 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_ND100B16)
- SUBROUTINE CTOIBM(ARRAY,NW,MODE)
-C +++++++NORD10/100 VERSION++++++++++
-C VERSION 82-05-06
-C CONVERT FIRST NW WORDS OF ARRAY INTO IBM FORMAT
-C MODE = 1 CONVERT TO 16 BIT INTEGER(RIGHT ADJ. ZERO FILLED)
-C 2 CONVERT TO 32 BIT INTEGER(DUMMY)
-C 3 CONVERT TO 32 BIT IBM FLOATING
-C ON RETURN,ARRAY CONTAINS CONVERTED VALUES.
- INTEGER *4 ARRAY(2)
- IF(NW.LE.0)RETURN
- IF(MODE.EQ.1)THEN
- DO FOR J=1,NW
- ARRAY(J)=IAND(ARRAY(J),0177777B)
- ENDDO
- ENDIF
- IF(MODE.EQ.3)THEN
- CALL CTOIB(ARRAY,NW)
- ENDIF
-C OTHERWISE DO NOTHING
- RETURN
- END
-#endif
diff --git a/src/packlib/epio/obsolete/nord/iomar32b.F b/src/packlib/epio/obsolete/nord/iomar32b.F
deleted file mode 100644
index ff2260f..0000000
--- a/src/packlib/epio/obsolete/nord/iomar32b.F
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: iomar32b.F,v 1.1.1.1 1996/03/08 15:21:59 mclareni Exp $
-*
-* $Log: iomar32b.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:59 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_ND100B32)
- SUBROUTINE IOMARK(LUNIT,IRET)
-C *****************************
-C-- NORD 100 32-BIT VERSION
-C 82-07-15 USE STANDARD FORTRAN ENDFILE JOP
-C WRITE EOF
-C LUNIT = LOGICAL DEVICE NUMBER
-C IRET = RETURN STATUS
- INTEGER*4 LUNIT,IRET,ZERO,IORCNV
- DATA ZERO/0/
-C-- CONVERT TO LOCAL MACHINE WORD SIZE
- LUN=LUNIT
- ENDFILE LUN
-C-- GET FILE SYSTEM ERROR CODE
- IRET=ERRCODE
- IF(IRET.EQ.ZERO)GO TO 77777
-C-- WAIT FOR FORTRAN 77 !!
-CCCCC IRET=IORCNV(IRET)
- IRET=0
-77777 RETURN
- END
-#endif
diff --git a/src/packlib/epio/obsolete/nord/iomarn16.F b/src/packlib/epio/obsolete/nord/iomarn16.F
deleted file mode 100644
index 228e1d7..0000000
--- a/src/packlib/epio/obsolete/nord/iomarn16.F
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: iomarn16.F,v 1.1.1.1 1996/03/08 15:21:57 mclareni Exp $
-*
-* $Log: iomarn16.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:57 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_ND100B16)
- SUBROUTINE IOMARK(LUNIT,IRET)
-C *****************************
-C 82-04-19 USE STANDARD FORTRAN ENDFILE J.O.PETERSEN
-C WRITE EOF
-C LUNIT = LOGICAL DEVICE NUMBER
-C IRET = RETURN STATUS
- INTEGER*2 LUNIT,IRET,ZERO,IORCNV
- DATA ZERO/0/
- ENDFILE LUNIT
-C-- ERRCODE NO GOOD WITH NORD-FORTRAN REW/ENDFILE
-C-- WAIT FOR FTN77
-C-- GET FILE SYSTEM ERROR CODE
- IRET=ERRCODE
- IF(IRET.EQ.ZERO)GO TO 77777
-CCCCCC IRET=IORCNV(IRET)
- IRET=0
-77777 RETURN
- END
-#endif
diff --git a/src/packlib/epio/obsolete/nord/iomarn32.F b/src/packlib/epio/obsolete/nord/iomarn32.F
deleted file mode 100644
index 7137f9e..0000000
--- a/src/packlib/epio/obsolete/nord/iomarn32.F
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: iomarn32.F,v 1.1.1.1 1996/03/08 15:21:58 mclareni Exp $
-*
-* $Log: iomarn32.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:58 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_ND50)||defined(CERNLIB_ND500)
- SUBROUTINE IOMARK(LUNIT,IRET)
-C *****************************
-C WRITE EOF
-C LUNIT = LOGICAL DEVICE NUMBER
-C IRET = RETURN STATUS
- INTEGER*4 LUNIT,IRET,ZERO
- INTEGER*4 MFUNC,MAGTPZ,DUM,MSTAT,IORCNV
- DATA ZERO/0/
- MFUNC=12B
- IRET=MAGTPZ(MFUNC,DUM,LUNIT,DUM,DUM,MSTAT)
- IF(IRET.EQ.ZERO) GOTO 77777
- IRET=IORCNV(IRET)
-77777 RETURN
- END
-#endif
diff --git a/src/packlib/epio/obsolete/nord/iorcn32b.F b/src/packlib/epio/obsolete/nord/iorcn32b.F
deleted file mode 100644
index 77102a6..0000000
--- a/src/packlib/epio/obsolete/nord/iorcn32b.F
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: iorcn32b.F,v 1.1.1.1 1996/03/08 15:21:59 mclareni Exp $
-*
-* $Log: iorcn32b.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:59 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_ND100B32)
- FUNCTION IORCNV(NERR)
-C *********************
-C-- NORD 100 32-BIT VERSION
-C CONVERTS FROM NORD FILE ERROR TO EP PACKET FORMAT (IBM)
-C NERR = NORD FILE ERROR
-C IORCNV = EP FILE ERROR
-C SIMPLIFY ERROR SYSTEM : EOF,EOT DETECTED OK
-C ALL OTHER ERRORS TREATED LIKE ILLEGAL ARGUMENT
-C 82/06/03 JOP
- INTEGER*4 IORCNV,NERR
- DIMENSION NFE(2),NEP(2)
- DATA NFE/3,102/
- DATA NEP/2, 4/
- NER1=NERR
- DO 10 I=1,2
- 10 IF(NER1.EQ.NFE(I)) GOTO 20
- IORCNV=1
-77777 RETURN
- 20 IORCNV=NEP(I)
- GOTO 77777
- END
-#endif
diff --git a/src/packlib/epio/obsolete/nord/iorcnn16.F b/src/packlib/epio/obsolete/nord/iorcnn16.F
deleted file mode 100644
index 546ada2..0000000
--- a/src/packlib/epio/obsolete/nord/iorcnn16.F
+++ /dev/null
@@ -1,30 +0,0 @@
-*
-* $Id: iorcnn16.F,v 1.1.1.1 1996/03/08 15:21:57 mclareni Exp $
-*
-* $Log: iorcnn16.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:57 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_ND100B16)
- FUNCTION IORCNV(NERR)
-C *********************
-C CONVERTS FROM NORD FILE ERROR TO EP PACKET FORMAT (IBM)
-C NERR = NORD FILE ERROR
-C IORCNV = EP FILE ERROR
-C SIMPLIFY ERROR SYSTEM : EOF,EOT DETECTED OK
-C ALL OTHER ERRORS TREATED LIKE ILLEGAL ARGUMENT
-C 82/06/03 JOP
- DIMENSION NFE(2),NEP(2)
- DATA NFE/3,102/
- DATA NEP/2, 4/
- NER1=NERR
- DO 10 I=1,2
- 10 IF(NER1.EQ.NFE(I)) GOTO 20
- IORCNV=1
-77777 RETURN
- 20 IORCNV=NEP(I)
- GOTO 77777
- END
-#endif
diff --git a/src/packlib/epio/obsolete/nord/iorcnn32.F b/src/packlib/epio/obsolete/nord/iorcnn32.F
deleted file mode 100644
index 7cd2bc9..0000000
--- a/src/packlib/epio/obsolete/nord/iorcnn32.F
+++ /dev/null
@@ -1,30 +0,0 @@
-*
-* $Id: iorcnn32.F,v 1.1.1.1 1996/03/08 15:21:58 mclareni Exp $
-*
-* $Log: iorcnn32.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:58 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_ND50)||defined(CERNLIB_ND500)
- FUNCTION IORCNV(NERR)
-C *********************
-C CONVERTS FROM NORD FILE ERROR TO EP PACKET FORMAT (IBM)
-C NERR = NORD FILE ERROR
-C IORCNV = EP FILE ERROR
- INTEGER*4 IORCNV,NERR
- DIMENSION NFE(15),NEP(15)
- DATA NFE/3,102,107,115,116,117,118,121,122,123,124,125,
- + 130,132,133/
- DATA NEP/2, 4, 1, 3, 3, 3, 1, 1, 1, 1, 1, 1,
- + 1, 1, 1/
- NER1=NERR
- DO 10 I=1,15
- 10 IF(NER1.EQ.NFE(I)) GOTO 20
- IORCNV=1
-77777 RETURN
- 20 IORCNV=NEP(I)
- GOTO 77777
- END
-#endif
diff --git a/src/packlib/epio/obsolete/nord/iored32b.F b/src/packlib/epio/obsolete/nord/iored32b.F
deleted file mode 100644
index f36de36..0000000
--- a/src/packlib/epio/obsolete/nord/iored32b.F
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: iored32b.F,v 1.1.1.1 1996/03/08 15:21:59 mclareni Exp $
-*
-* $Log: iored32b.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:59 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_ND100B32)
- SUBROUTINE IOREAD(LUNIT,IARR,NBYTE,IRET)
-C ****************************************
-C-- NORD 100 32-BIT VERSION
-C-- 82-04-19 MODIFY JOP
-C-- GENERALISE TO MT+DISK: REPLACE MAGTPZ BY MAGTP
-C READ RECORD FROM FILE
-C LUNIT = LOGICAL DEVICE NUMBER
-C IARR = BUFFER ARRAY
-C NBYTE : ON INPUT, MAX. NO OF BYTES TO READ (ALWAYS EVEN !!)
-C ON RETURN: NO. OF BYTES ACTUALLY READ
-C IRET = RETURN STATUS
- INTEGER*4 LUNIT,IARR(2),NBYTE,IRET,ZERO,IORCNV
- INTEGER*4 NOBYT
- DATA ZERO/0/
-C-- NO.BYTES / N100 MACHINE WORD
- NBW=2
- LUN=LUNIT
-C-- MAX NO OF WORDS TO READ
- NWMAX=NBYTE/NBW
- MFUNC=0B
-C-- IERR = FILE SYSTEM ERROR = ERRCODE
- IERR=MAGTP(MFUNC,IARR,LUN,NWMAX,NWRD)
-C-- ' NO SUCH PAGE' = EOF 82/06/04 JOP
- IF(IERR.EQ.18)IERR=3
- NBYTE=NBW*NWRD
- IRET=IERR
- IF(IRET.EQ.ZERO) GOTO 77777
- IRET=IORCNV(IRET)
-77777 RETURN
- END
-#endif
diff --git a/src/packlib/epio/obsolete/nord/ioredn16.F b/src/packlib/epio/obsolete/nord/ioredn16.F
deleted file mode 100644
index 85de5b6..0000000
--- a/src/packlib/epio/obsolete/nord/ioredn16.F
+++ /dev/null
@@ -1,39 +0,0 @@
-*
-* $Id: ioredn16.F,v 1.1.1.1 1996/03/08 15:21:58 mclareni Exp $
-*
-* $Log: ioredn16.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:58 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_ND100B16)
- SUBROUTINE IOREAD(LUNIT,IARR,NBYTE,IRET)
-C ****************************************
-C-- 82-04-19 MODIFY JOP
-C-- GENERALISE TO MT+DISK: REPLACE MAGTPZ BY MAGTP
-C READ RECORD FROM FILE
-C LUNIT = LOGICAL DEVICE NUMBER
-C IARR = BUFFER ARRAY
-C NBYTE : ON INPUT, MAX. NO OF BYTES TO READ (ALWAYS EVEN !!)
-C ON RETURN: NO. OF BYTES ACTUALLY READ
-C IRET = RETURN STATUS
- INTEGER*2 LUNIT,IARR(2),NBYTE,IRET,ZERO
- INTEGER*4 NOBYT
- DATA ZERO/0/
-C-- NO.BYTES / MACHINE WORD
- NBW=2
-C-- MAX NO OF WORDS TO READ
- NWMAX=NBYTE/NBW
- MFUNC=0B
-C-- IERR = FILE SYSTEM ERROR = ERRCODE
- IERR=MAGTP(MFUNC,IARR,LUNIT,NWMAX,NWRD)
-C-- ' NO SUCH PAGE' = EOF 82/06/04 JOP
- IF(IERR.EQ.18)IERR=3
- NBYTE=NBW*NWRD
- IRET=IERR
- IF(IRET.EQ.ZERO) GOTO 77777
- IRET=IORCNV(IRET)
-77777 RETURN
- END
-#endif
diff --git a/src/packlib/epio/obsolete/nord/ioredn32.F b/src/packlib/epio/obsolete/nord/ioredn32.F
deleted file mode 100644
index 316f422..0000000
--- a/src/packlib/epio/obsolete/nord/ioredn32.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: ioredn32.F,v 1.1.1.1 1996/03/08 15:21:58 mclareni Exp $
-*
-* $Log: ioredn32.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:58 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_ND50)||defined(CERNLIB_ND500)
- SUBROUTINE IOREAD(LUNIT,IARR,NBYTE,IRET)
-C ****************************************
-C READ RECORD FROM FILE
-C LUNIT = LOGICAL DEVICE NUMBER
-C IARR = BUFFER ARRAY
-C NBYTE = RECORD LENGTH IN BYTES / BYTES READ RETURN VALUE
-C IRET = RETURN STATUS
- INTEGER*4 LUNIT,IARR(2),NBYTE,IRET,ZERO
- INTEGER*4 MFUNC,MAGTPZ,NBYTR,MSTAT,IORCNV
- DATA ZERO/0/
- MFUNC=26B
- IRET=MAGTPZ(MFUNC,IARR,LUNIT,NBYTE,NBYTR,MSTAT)
- NBYTE=NBYTR
- IF(IRET.EQ.ZERO) GOTO 77777
- IRET=IORCNV(IRET)
-77777 RETURN
- END
-#endif
diff --git a/src/packlib/epio/obsolete/nord/iorit32b.F b/src/packlib/epio/obsolete/nord/iorit32b.F
deleted file mode 100644
index bf9c21a..0000000
--- a/src/packlib/epio/obsolete/nord/iorit32b.F
+++ /dev/null
@@ -1,36 +0,0 @@
-*
-* $Id: iorit32b.F,v 1.1.1.1 1996/03/08 15:21:59 mclareni Exp $
-*
-* $Log: iorit32b.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:59 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_ND100B32)
- SUBROUTINE IORITE(LUNIT,IARR,NBYTE,IRET)
-C ****************************************
-C-- NORD 100 32-BIT VERSION
-C-- 82-04-19 MODIFY JOP
-C-- GENERALISE TO MT+DISK: REPLACE MAGTPZ BY MAGTP
-C WRITE RECORD ONTO FILE
-C LUNIT = LOGICAL DEVICE NUMBER
-C IARR = BUFFER ARRAY
-C NBYTE = NO OF BYTES TO BE WRITTEN (ALWAYS EVEN !)
-C IRET = RETURN STATUS
- INTEGER*4 LUNIT,IARR(2),NBYTE,IRET,ZERO,IORCNV
- DATA ZERO/0/
-C-- NO.BYTES / N100 MACHINE WORD
- NBW=2
- LUN=LUNIT
-C-- NO WORDS TO WRITE
- NWMAX=NBYTE/NBW
- MFUNC=1B
-C-- IERR = FILE SYSTEM ERROR = ERRCODE
- IERR=MAGTP(MFUNC,IARR,LUN,NWMAX,IDUM)
- IRET=IERR
- IF(IRET.EQ.ZERO) GOTO 77777
- IRET=IORCNV(IRET)
-77777 RETURN
- END
-#endif
diff --git a/src/packlib/epio/obsolete/nord/ioritn16.F b/src/packlib/epio/obsolete/nord/ioritn16.F
deleted file mode 100644
index 10e2399..0000000
--- a/src/packlib/epio/obsolete/nord/ioritn16.F
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: ioritn16.F,v 1.1.1.1 1996/03/08 15:21:58 mclareni Exp $
-*
-* $Log: ioritn16.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:58 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_ND100B16)
- SUBROUTINE IORITE(LUNIT,IARR,NBYTE,IRET)
-C ****************************************
-C-- 82-04-19 MODIFY JOP
-C-- GENERALISE TO MT+DISK: REPLACE MAGTPZ BY MAGTP
-C WRITE RECORD ONTO FILE
-C LUNIT = LOGICAL DEVICE NUMBER
-C IARR = BUFFER ARRAY
-C NBYTE = NO OF BYTES TO BE WRITTEN (ALWAYS EVEN !)
-C IRET = RETURN STATUS
- INTEGER*2 LUNIT,IARR(2),NBYTE,IRET,ZERO
- DATA ZERO/0/
-C-- NO.BYTES / MACHINE WORD (N100)
- NBW=2
-C-- NO WORDS TO WRITE
- NWMAX=NBYTE/NBW
- MFUNC=1B
-C-- IERR = FILE SYSTEM ERROR = ERRCODE
- IERR=MAGTP(MFUNC,IARR,LUNIT,NWMAX,IDUM)
- IRET=IERR
- IF(IRET.EQ.ZERO) GOTO 77777
- IRET=IORCNV(IRET)
-77777 RETURN
- END
-#endif
diff --git a/src/packlib/epio/obsolete/nord/ioritn32.F b/src/packlib/epio/obsolete/nord/ioritn32.F
deleted file mode 100644
index accf2e3..0000000
--- a/src/packlib/epio/obsolete/nord/ioritn32.F
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: ioritn32.F,v 1.1.1.1 1996/03/08 15:21:58 mclareni Exp $
-*
-* $Log: ioritn32.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:58 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_ND50)||defined(CERNLIB_ND500)
- SUBROUTINE IORITE(LUNIT,IARR,NBYTE,IRET)
-C ****************************************
-C WRITE RECORD ONTO FILE
-C LUNIT = LOGICAL DEVICE NUMBER
-C IARR = BUFFER ARRAY
-C NBYTE = NO OF BYTES TO BE WRITTEN
-C IRET = RETURN STATUS
- INTEGER*4 LUNIT,IARR(2),NBYTE,IRET,ZERO
- INTEGER*4 MFUNC,MAGTPZ,NBYTR,MSTAT,IORCNV
- DATA ZERO/0/
- MFUNC=27B
- IRET=MAGTPZ(MFUNC,IARR,LUNIT,NBYTE,NBYTR,MSTAT)
- IF(IRET.EQ.ZERO) GOTO 77777
- IRET=IORCNV(IRET)
-77777 RETURN
- END
-#endif
diff --git a/src/packlib/epio/obsolete/nord/iorwd32b.F b/src/packlib/epio/obsolete/nord/iorwd32b.F
deleted file mode 100644
index 438f635..0000000
--- a/src/packlib/epio/obsolete/nord/iorwd32b.F
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: iorwd32b.F,v 1.1.1.1 1996/03/08 15:21:59 mclareni Exp $
-*
-* $Log: iorwd32b.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:59 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_ND100B32)
- SUBROUTINE IORWND(LUNIT,IRET)
-C *****************************
-C-- NORD 100 32-BIT VERSION
-C-- 82-07-15 USE STANDARD FORTRAN REWIND
-C-- JOP
-C REWIND
-C LUNIT = LOGICAL DEVICE NUMBER
-C IRET = RETURN STATUS
- INTEGER*4 LUNIT,IRET,ZERO,IORCNV
- DATA ZERO/0/
-C-- CONVERT TO LOCAL MACHINE WORD SIZE
- LUN=LUNIT
- REWIND LUN
-C-- GET FILE SYSTEM ERROR CODE
- IRET=ERRCODE
-C-- WAIT FOR FTN77 !!
-CCCC IF(IRET.NE.ZERO)IRET=1
- IRET=0
- 77777 RETURN
- END
-77777 RETURN
- END
-#endif
diff --git a/src/packlib/epio/obsolete/nord/iorwdn16.F b/src/packlib/epio/obsolete/nord/iorwdn16.F
deleted file mode 100644
index 5baf8e4..0000000
--- a/src/packlib/epio/obsolete/nord/iorwdn16.F
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: iorwdn16.F,v 1.1.1.1 1996/03/08 15:21:58 mclareni Exp $
-*
-* $Log: iorwdn16.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:58 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_ND100B16)
- SUBROUTINE IORWND(LUNIT,IRET)
-C *****************************
-C CHANGE TO STANDARD FORTRAN REWIND
-C 82-04-19 J.O.PETERSEN
-C REWIND
-C LUNIT = LOGICAL DEVICE NUMBER
-C IRET = RETURN STATUS
- INTEGER*2 LUNIT,IRET,ZERO,IORCNV
- DATA ZERO/0/
- REWIND LUNIT
-C-- ERRCODE NO GOOD WITH NORD-FORTRAN REW/ENDFILE
-C-- WAIT FOR FTN77
-C-- GET FILE SYSTEM ERROR CODE
- IRET=ERRCODE
-CCCCC IF(IRET.NE.ZERO) IRET=1
- IRET=0
-77777 RETURN
- END
-#endif
diff --git a/src/packlib/epio/obsolete/nord/iorwdn32.F b/src/packlib/epio/obsolete/nord/iorwdn32.F
deleted file mode 100644
index d48e5b9..0000000
--- a/src/packlib/epio/obsolete/nord/iorwdn32.F
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: iorwdn32.F,v 1.1.1.1 1996/03/08 15:21:58 mclareni Exp $
-*
-* $Log: iorwdn32.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:58 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_ND50)||defined(CERNLIB_ND500)
- SUBROUTINE IORWND(LUNIT,IRET)
-C *****************************
-C REWIND
-C LUNIT = LOGICAL DEVICE NUMBER
-C IRET = RETURN STATUS
- INTEGER*4 LUNIT,IRET,ZERO
- INTEGER*4 MFUNC,MAGTPZ,DUM,MSTAT,IORCNV
- DATA ZERO/0/
- MFUNC=13B
- IRET=MAGTPZ(MFUNC,DUM,LUNIT,DUM,DUM,MSTAT)
- IF(IRET.NE.ZERO) IRET=1
-77777 RETURN
- END
-#endif
diff --git a/src/packlib/epio/obsolete/nord/iwd16n16.F b/src/packlib/epio/obsolete/nord/iwd16n16.F
deleted file mode 100644
index 5a6ab81..0000000
--- a/src/packlib/epio/obsolete/nord/iwd16n16.F
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: iwd16n16.F,v 1.1.1.1 1996/03/08 15:21:58 mclareni Exp $
-*
-* $Log: iwd16n16.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:58 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_ND100B16)
- FUNCTION IWD16(M,N)
-C.+++++++ NORD 10/100 VERSION ++++++++++
-C--- FUNCTION RETURNS 16 BIT WORD NO. N OUT OF
-C--- 32 BIT WORD ARRAY M.
- INTEGER*2 M(2)
- IWD16=M(N)
- RETURN
- END
-#endif
diff --git a/src/packlib/epio/obsolete/nord/iwd16n5.s b/src/packlib/epio/obsolete/nord/iwd16n5.s
deleted file mode 100644
index 452ba2c..0000000
--- a/src/packlib/epio/obsolete/nord/iwd16n5.s
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: iwd16n5.s,v 1.1.1.1 1996/03/08 15:21:56 mclareni Exp $
-*
-* $Log: iwd16n5.s,v $
-* Revision 1.1.1.1 1996/03/08 15:21:56 mclareni
-* Epio
-*
-*
-#if defined(CERNLIB_ND50)||defined(CERNLIB_ND500)
- MODULE M_IWD16
-% I*4=IWD16(A,N)
-% RETURNS THE PACKED 16 BIT WORD NUMBER N OF STRING A
-% VERSION 811002
- EXPORT IWD16
- ROUTINE IWD16
- LIB IWD16
-VBAS: STACK FIXED
-PAR: W BLOCK 2
- ENDSTACK
-IWD16: ENTF VBAS
- W2:=IND(B.PAR+4)
- W2-1
- H1:=IND(B.PAR)(R2)
- RET
- ENDROUTINE
- ENDMODULE
-#endif
diff --git a/src/packlib/epio/obsolete/nord/jlbyt.s b/src/packlib/epio/obsolete/nord/jlbyt.s
deleted file mode 100644
index 1b265ae..0000000
--- a/src/packlib/epio/obsolete/nord/jlbyt.s
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: jlbyt.s,v 1.1.1.1 1996/03/08 15:21:56 mclareni Exp $
-*
-* $Log: jlbyt.s,v $
-* Revision 1.1.1.1 1996/03/08 15:21:56 mclareni
-* Epio
-*
-*
-#if defined(CERNLIB_ND100B32)
-% VERSION 770414. SOURCE & BRF OK FOR N-10 2+3W
-% INTEGER FUNCTION JLBYT(XFR,NB)
-% RETURNS (RIGHT JUSTIFIED WITH ZERO FILL) THE 8-BIT BYTE NB,
-% COUNTED FROM LEFT TO RIGHT WITH THE LEFTMOST BYTE OF XFR AS BYTE 0
-)9BEG
-)9LIB JLBYT
-)9ENT JLBYT
-JLBYT, COPY SB DD
- COPY SA DB
- LDT ,B 0
- LDX I ,B 1
- LBYT
- COPY SD DB
- EXIT
-)9END
-#endif
diff --git a/src/packlib/epio/obsolete/nord/magtpz.F b/src/packlib/epio/obsolete/nord/magtpz.F
deleted file mode 100644
index 72edf6a..0000000
--- a/src/packlib/epio/obsolete/nord/magtpz.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: magtpz.F,v 1.1.1.1 1996/03/08 15:21:59 mclareni Exp $
-*
-* $Log: magtpz.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:59 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_ND50)
- INTEGER FUNCTION MAGTPZ(MFUNC,IARR,LUNIT,NBYTE,NBYTR,MSTAT)
- DIMENSION IARR(1)
- LENBUF=NBYTE/4
- MF=MFUNC
- IF(MF.EQ.27B)MF=1
- IF(MF.EQ.26B)MF=0
- MAGTPZ=MAGTP(MF,IARR,LUNIT,LENBUF,L)
- NBYTR=L*4
- RETURN
- END
-#endif
diff --git a/src/packlib/epio/obsolete/nord/ucopn32.F b/src/packlib/epio/obsolete/nord/ucopn32.F
deleted file mode 100644
index 39383dd..0000000
--- a/src/packlib/epio/obsolete/nord/ucopn32.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: ucopn32.F,v 1.1.1.1 1996/03/08 15:21:58 mclareni Exp $
-*
-* $Log: ucopn32.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:58 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_ND100B32)||defined(CERNLIB_ND500)
- SUBROUTINE UCOPY(SOURCE,TARGET,NA)
-C. COPY NA WORDS FROM SOURCE TO TARGET ARRAY
- INTEGER*4 SOURCE(2),TARGET(2),NA,ZERO
- DATA ZERO/0/
- IF(NA.LE.ZERO) GOTO 77777
- IA=NA
- DO 1 I=1,IA
- 1 TARGET(I)=SOURCE(I)
-77777 RETURN
- END
-#endif
diff --git a/src/packlib/epio/obsolete/nord/ucopyn16.F b/src/packlib/epio/obsolete/nord/ucopyn16.F
deleted file mode 100644
index 064cefe..0000000
--- a/src/packlib/epio/obsolete/nord/ucopyn16.F
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: ucopyn16.F,v 1.1.1.1 1996/03/08 15:21:58 mclareni Exp $
-*
-* $Log: ucopyn16.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:58 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_ND100B16)
- SUBROUTINE UCOPY(SOURCE,TARGET,NA)
-C. COPY NA WORDS FROM SOURCE TO TARGET ARRAY
- INTEGER*2 SOURCE(2),TARGET(2),NA,ZERO
- DATA ZERO/0/
- IF(NA.LE.ZERO) GOTO 77777
- DO 1 I=1,NA
- 1 TARGET(I)=SOURCE(I)
-77777 RETURN
- END
-#endif
diff --git a/src/packlib/epio/obsolete/nord/uzeron16.F b/src/packlib/epio/obsolete/nord/uzeron16.F
deleted file mode 100644
index 21e93f0..0000000
--- a/src/packlib/epio/obsolete/nord/uzeron16.F
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: uzeron16.F,v 1.1.1.1 1996/03/08 15:21:58 mclareni Exp $
-*
-* $Log: uzeron16.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:58 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_ND100B16)
- SUBROUTINE UZERO(IARR,N1,N2)
-C. ZERO ARRAY FROM N1 TO N2
- INTEGER*2 IARR(2),N1,N2,ZERO
- DATA ZERO/0/
- IF(N1.LE.ZERO .OR. N1.GT.N2) GOTO 77777
- DO 1 I=N1,N2
- 1 IARR(I)=0
-77777 RETURN
- END
-#endif
diff --git a/src/packlib/epio/obsolete/nord/uzeron32.F b/src/packlib/epio/obsolete/nord/uzeron32.F
deleted file mode 100644
index 6ec84df..0000000
--- a/src/packlib/epio/obsolete/nord/uzeron32.F
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: uzeron32.F,v 1.1.1.1 1996/03/08 15:21:58 mclareni Exp $
-*
-* $Log: uzeron32.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:58 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_ND100B32)||defined(CERNLIB_ND500)
- SUBROUTINE UZERO(IARR,N1,N2)
-C. ZERO ARRAY FROM N1 TO N2
- INTEGER*4 IARR(2),N1,N2,ZERO
- DATA ZERO/0/
- IF(N1.LE.ZERO .OR. N1.GT.N2) GOTO 77777
- I1=N1
- I2=N2
- DO 1 I=I1,I2
- 1 IARR(I)=0
-77777 RETURN
- END
-#endif
diff --git a/src/packlib/epio/obsolete/nord/vfilln16.F b/src/packlib/epio/obsolete/nord/vfilln16.F
deleted file mode 100644
index 72099c9..0000000
--- a/src/packlib/epio/obsolete/nord/vfilln16.F
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: vfilln16.F,v 1.1.1.1 1996/03/08 15:21:58 mclareni Exp $
-*
-* $Log: vfilln16.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:58 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_ND100B16)
- SUBROUTINE VFILL(IARR,NA,NC)
-C. FILL INTEGER ARRAY
- INTEGER*2 IARR(2),NA,NC,ZERO
- DATA ZERO/0/
- IF(NA.LE.ZERO) GOTO 77777
- DO 1 I=1,NA
- 1 IARR(I)=NC
-77777 RETURN
- END
-#endif
diff --git a/src/packlib/epio/obsolete/nord/vfilln32.F b/src/packlib/epio/obsolete/nord/vfilln32.F
deleted file mode 100644
index 751873f..0000000
--- a/src/packlib/epio/obsolete/nord/vfilln32.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: vfilln32.F,v 1.1.1.1 1996/03/08 15:21:58 mclareni Exp $
-*
-* $Log: vfilln32.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:58 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_ND100B32)||defined(CERNLIB_ND500)
- SUBROUTINE VFILL(IARR,NA,NC)
-C. FILL INTEGER ARRAY
- INTEGER*4 IARR(2),NA,NC,ZERO
- DATA ZERO/0/
- IF(NA.LE.ZERO) GOTO 77777
- IA=NA
- DO 1 I=1,IA
- 1 IARR(I)=NC
-77777 RETURN
- END
-#endif
diff --git a/src/packlib/epio/obsolete/nord/vzeron16.F b/src/packlib/epio/obsolete/nord/vzeron16.F
deleted file mode 100644
index 246f20c..0000000
--- a/src/packlib/epio/obsolete/nord/vzeron16.F
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: vzeron16.F,v 1.1.1.1 1996/03/08 15:21:58 mclareni Exp $
-*
-* $Log: vzeron16.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:58 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_ND100B16)
- SUBROUTINE VZERO(IARR,NA)
-C. ZERO INTEGER ARRAY
- INTEGER*2 IARR(2),NA,ZERO
- DATA ZERO/0/
- IF(NA.LE.ZERO) GOTO 77777
- DO 1 I=1,NA
- 1 IARR(I)=0
-77777 RETURN
- END
-#endif
diff --git a/src/packlib/epio/obsolete/nord/vzeron32.F b/src/packlib/epio/obsolete/nord/vzeron32.F
deleted file mode 100644
index 008c752..0000000
--- a/src/packlib/epio/obsolete/nord/vzeron32.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: vzeron32.F,v 1.1.1.1 1996/03/08 15:21:58 mclareni Exp $
-*
-* $Log: vzeron32.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:58 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_ND100B32)||defined(CERNLIB_ND500)
- SUBROUTINE VZERO(IARR,NA)
-C. ZERO INTEGER ARRAY
- INTEGER*4 IARR(2),NA,ZERO
- DATA ZERO/0/
- IF(NA.LE.ZERO) GOTO 77777
- IA=NA
- DO 1 I=1,IA
- 1 IARR(I)=0
-77777 RETURN
- END
-#endif
diff --git a/src/packlib/epio/obsolete/nord/w16movn5.s b/src/packlib/epio/obsolete/nord/w16movn5.s
deleted file mode 100644
index 493ae2b..0000000
--- a/src/packlib/epio/obsolete/nord/w16movn5.s
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: w16movn5.s,v 1.1.1.1 1996/03/08 15:21:59 mclareni Exp $
-*
-* $Log: w16movn5.s,v $
-* Revision 1.1.1.1 1996/03/08 15:21:59 mclareni
-* Epio
-*
-*
-#if defined(CERNLIB_ND50)||defined(CERNLIB_ND500)
- MODULE M_W16MOV
-% CALL W16MOV(SOURCE,N1,TARGET,N2,N3)
-% MOVES 16 BIT WORDS IN PACKED FORM. OVERLAP ALLOWED.
-% VERSION 811001
- EXPORT W16MOV
- ROUTINE W16MOV
- LIB W16MOV
-VBAS: STACK FIXED
-PAR: W BLOCK 5
- ENDSTACK
-W16MOV: ENTF VBAS
- W4:=IND(B.PAR+16)
- IF <= GO BACK
- W1:=IND(B.PAR+4)
- W1-1
- W2:=IND(B.PAR+12)
- W2-1
- H BMOVE IND(B.PAR)(R1),IND(B.PAR+8)(R2),IND(B.PAR+16)
-BACK: RET
- ENDROUTINE
- ENDMODULE
-#endif
diff --git a/src/packlib/epio/obsolete/nord/w16movno.F b/src/packlib/epio/obsolete/nord/w16movno.F
deleted file mode 100644
index 5203bd7..0000000
--- a/src/packlib/epio/obsolete/nord/w16movno.F
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: w16movno.F,v 1.1.1.1 1996/03/08 15:21:59 mclareni Exp $
-*
-* $Log: w16movno.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:59 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_ND100B32)
- SUBROUTINE W16MOV(SOURCE,N1,TARGET,N2,N3)
-C.+++++++ NORD 100 32-BIT VERSION ++++++++++
-C. MOVES 16 BIT WORDS IN PACKED FORM.
-C.
-C. INPUT
-C. SOURCE SOURCE ARRAY
-C. N1 STARTING 16 BIT WORD IN SOURCE
-C. TARGET TARGET ARRAY
-C. N2 STARTING 16 BIT WORD IN TARGET
-C. N3 NO. OF 16 BIT WORDS TO MOVE
-C.
- INTEGER*4 N1,N2,N3,ZERO
- INTEGER*2 SOURCE(2),TARGET(2)
- DATA ZERO/0/
- IF(N3.LE.ZERO) GOTO 77777
- I1=N1-1
- I2=N2-1
- I3=N3
- DO 1 I=1,I3
- 1 TARGET(I2+I)=SOURCE(I1+I)
-77777 RETURN
- END
-#endif
diff --git a/src/packlib/epio/obsolete/nord/w16mvn16.F b/src/packlib/epio/obsolete/nord/w16mvn16.F
deleted file mode 100644
index 6263028..0000000
--- a/src/packlib/epio/obsolete/nord/w16mvn16.F
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: w16mvn16.F,v 1.1.1.1 1996/03/08 15:21:58 mclareni Exp $
-*
-* $Log: w16mvn16.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:58 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_ND100B16)
- SUBROUTINE W16MOV(SOURCE,N1,TARGET,N2,N3)
-C.+++++++ NORD10/100 VERSION ++++++++++
-C. MOVES 16 BIT WORDS IN PACKED FORM.
-C.
-C. INPUT
-C. SOURCE SOURCE ARRAY
-C. N1 STARTING 16 BIT WORD IN SOURCE
-C. TARGET TARGET ARRAY
-C. N2 STARTING 16 BIT WORD IN TARGET
-C. N3 NO. OF 16 BIT WORDS TO MOVE
-C.
- INTEGER*2 N1,N2,N3,ZERO
- INTEGER*2 SOURCE(2),TARGET(2)
- DATA ZERO/0/
- IF(N3.LE.ZERO) GOTO 77777
- I1=N1-1
- I2=N2-1
- I3=N3
- DO 1 I=1,I3
- 1 TARGET(I2+I)=SOURCE(I1+I)
-77777 RETURN
- END
-#endif
diff --git a/src/packlib/epio/obsolete/nord/zsbyt.s b/src/packlib/epio/obsolete/nord/zsbyt.s
deleted file mode 100644
index ec5b1b8..0000000
--- a/src/packlib/epio/obsolete/nord/zsbyt.s
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: zsbyt.s,v 1.1.1.1 1996/03/08 15:21:56 mclareni Exp $
-*
-* $Log: zsbyt.s,v $
-* Revision 1.1.1.1 1996/03/08 15:21:56 mclareni
-* Epio
-*
-*
-#if defined(CERNLIB_ND100B32)
-% VERSION 770414. SOURCE & BRF OK FOR N-10 2+3W.
-% SUBROUTINE ZSBYT(IFR,XTO,NB)
-% COPIES THE RIGHTMOST 8-BIT BYTE OF IFR INTO THE BYTE NB,
-% COUNTED FROM LEFT TO RIGHT WITH THE LEFTMOST BYTE OF XTO AS BYTE 0.
-)9BEG
-)9LIB ZSBYT
-)9ENT ZSBYT
-ZSBYT,COPY SB DD
- COPY SA DB
- LDA I ,B 0
- LDT ,B 1
- LDX I ,B 2
- SBYT
- COPY SD DB
- EXIT
-)9END;)9EOF;)9TSS
-#endif
diff --git a/src/packlib/epio/obsolete/svaxs/cleard.F b/src/packlib/epio/obsolete/svaxs/cleard.F
deleted file mode 100644
index 6959869..0000000
--- a/src/packlib/epio/obsolete/svaxs/cleard.F
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: cleard.F,v 1.1.1.1 1996/03/08 15:21:53 mclareni Exp $
-*
-* $Log: cleard.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:53 mclareni
-* Epio
-*
-*
-#if defined(CERNLIB_VAXS)
-#include "sys/CERNLIB_machine.h"
-#include "_epio/pilot.h"
- SUBROUTINE CLEARD(I,J)
-C
-C A.F.R. 2-9-80 VERSION 0
-C
-C UTILITY ROUTINE TO CHANGE THE LENGTH OF A DESCRIPTOR
-C
- INTEGER*2 I
- I=J
- RETURN
- END
-#endif
diff --git a/src/packlib/epio/obsolete/svaxs/tapeform.F b/src/packlib/epio/obsolete/svaxs/tapeform.F
deleted file mode 100644
index 0f5fa3c..0000000
--- a/src/packlib/epio/obsolete/svaxs/tapeform.F
+++ /dev/null
@@ -1,93 +0,0 @@
-*
-* $Id: tapeform.F,v 1.1.1.1 1996/03/08 15:21:54 mclareni Exp $
-*
-* $Log: tapeform.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:54 mclareni
-* Epio
-*
-*
-#if defined(CERNLIB_VAXS)
-#include "sys/CERNLIB_machine.h"
-#include "_epio/pilot.h"
-#if defined(CERNLIB_TAPEFORM)
-C THIS IS THE SOURCE FOR THE PROGRAM CALLED BY THE TAPEFORMAT
-C COMMAND DESCRIBED IN THE NEXT DECK
-C
-C PLEASE NOTE THAT YOU MAY HAVE TO REDEFINE KEY3-KEY6 FOR YOUR INSTALLATION
- IMPLICIT INTEGER(A-Z)
- BYTE KEY1(5),KEY2(7),KEY3(6),KEY4(6),KEY5(6),KEY6(6)
- DATA KEY1 /4,1HS,1HW,1HA,1HP/
- DATA KEY2 /6,1HN,1HO,1HS,1HW,1HA,1HP/
- DATA KEY3 /5,1HM,1HT,1HA,1H0,1H:/
- DATA KEY4 /5,1HM,1HT,1HA,1H1,1H:/
- DATA KEY5 /5,1HM,1HT,1HA,1H2,1H:/
- DATA KEY6 /5,1HM,1HT,1HA,1H3,1H:/
- INTEGER*4 KEYVECT(5),KEYVECT2(9)
- DATA KEYVECT(1) /4/, KEYVECT2(1) /8/
- INTEGER*4 GETLINE(2),MAGTAP(2),MODE(2)
- BYTE RECBUF(80)
- EXTERNAL SS$_NORMAL,MT$K_NORMAL11,MT$K_NORMAL15
- EXTERNAL LIB$_SYNTAXERR
- KEYVECT(2)=%LOC(KEY1)
- KEYVECT(3)=1
- KEYVECT(4)=%LOC(KEY2)
- KEYVECT(5)=2
- KEYVECT2(2)=%LOC(KEY3)
- KEYVECT2(4)=%LOC(KEY4)
- KEYVECT2(6)=%LOC(KEY5)
- KEYVECT2(8)=%LOC(KEY6)
- GETLINE(1)=80
- GETLINE(2)=%LOC(RECBUF)
- CALL LIB$GET_FOREIGN(GETLINE,,GETLINE(1))
- IF(GETLINE(1) .NE. 0) THEN
- NCH=GETLINE(1)
- DO 10 I=1,NCH
- IF(RECBUF(I) .NE. 1H ) GOTO 11
- 0010 CONTINUE
- GETLINE(1)=0
- GOTO 99
- 0011 MAGTAP(2)=%LOC(RECBUF(I))
- MAGTAP(1)=I
- DO 12 I=MAGTAP(1),NCH
- IF(RECBUF(I) .EQ. 1H ) GOTO 14
- 0012 CONTINUE
- 0013 STATUS=%LOC(LIB$_SYNTAXERR)
- GOTO 9000
- 0014 MAGTAP(1)=I-MAGTAP(1)
- K=I
- DO 15 I=K,NCH
- IF(RECBUF(I) .NE. 1H ) GOTO 16
- 0015 CONTINUE
- 0016 MODE(1)=NCH-I+1
- MODE(2)=%LOC(RECBUF(I))
- ENDIF
- 0099 IF(GETLINE(1) .EQ. 0) THEN
- 0100 MAGTAP(1)=80
- MAGTAP(2)=GETLINE(2)
- STATUS=LIB$GET_INPUT(MAGTAP,'Device name:',MAGTAP(1))
- IF(STATUS .NE. %LOC(SS$_NORMAL)) GOTO 9000
- IF(MAGTAP(1) .EQ. 0) GOTO 100
- ENDIF
- STATUS = LIB$LOOKUP_KEY (MAGTAP,KEYVECT2,,,)
- IF(STATUS .NE. %LOC(SS$_NORMAL)) GOTO 9000
- STATUS = SYS$ASSIGN(MAGTAP,ICHN,,)
- IF(STATUS .NE. %LOC(SS$_NORMAL)) GOTO 9000
- IF(GETLINE(1) .EQ. 0) THEN
- 0200 MODE(1)=80
- MODE(2)=GETLINE(2)
- STATUS=LIB$GET_INPUT(MODE,'Tape mode :',MODE(1))
- IF(STATUS .NE. %LOC(SS$_NORMAL)) GOTO 9000
- IF(MODE(1) .EQ. 0) GOTO 200
- ENDIF
- STATUS = LIB$LOOKUP_KEY (MODE,KEYVECT,KEYVAL,,)
- IF(STATUS .NE. %LOC(SS$_NORMAL)) GOTO 9000
- IF(KEYVAL .EQ. 1) THEN
- STATUS=MT_FORMAT(ICHN,MT$K_NORMAL15)
- ENDIF
- IF(KEYVAL .EQ. 2) THEN
- STATUS=MT_FORMAT(ICHN,MT$K_NORMAL11)
- ENDIF
- 9000 CALL SYS$EXIT(%VAL(STATUS))
- END
-#endif
-#endif
diff --git a/src/packlib/epio/obsolete/svaxs/trnlog.F b/src/packlib/epio/obsolete/svaxs/trnlog.F
deleted file mode 100644
index b291fd9..0000000
--- a/src/packlib/epio/obsolete/svaxs/trnlog.F
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: trnlog.F,v 1.1.1.1 1996/03/08 15:21:53 mclareni Exp $
-*
-* $Log: trnlog.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:53 mclareni
-* Epio
-*
-*
-#if defined(CERNLIB_VAXS)
-#include "sys/CERNLIB_machine.h"
-#include "_epio/pilot.h"
- SUBROUTINE TRNLOG(OLDNAM,NEWNAM)
-C
-C A.F.R. 2-9-80 FIRST VERSION
-C
-C TRANSLATION WITH ITERATION OF LOGICAL NAMES
-C IT WONT STOP TILL ITS DONE
-C NOTE: YOU STILL HAVE TO BE CAREFUL ABOUT DESCRIPTOR LENGTHS
-C
- CHARACTER*(*) OLDNAM,NEWNAM
- CHARACTER*63 NEWER
- INTEGER SYS$TRNLOG
- ISTAT = SYS$TRNLOG(OLDNAM,%DESCR(NEWNAM),NEWNAM,,,)
- 10 CONTINUE
- IF(ISTAT.NE.1)GO TO 100
- CALL CLEARD(%DESCR(NEWER),63)
- ISTAT=SYS$TRNLOG(NEWNAM,%DESCR(NEWER),NEWER,,,)
- CALL CLEARD(%DESCR(NEWNAM),63)
- ISTAT=SYS$TRNLOG(NEWER,%DESCR(NEWNAM),NEWNAM,,,)
- GO TO 10
- 100 CONTINUE
- RETURN
- END
-#endif
diff --git a/src/packlib/epio/obsolete/univac/blo16wun.F b/src/packlib/epio/obsolete/univac/blo16wun.F
deleted file mode 100644
index 883ca45..0000000
--- a/src/packlib/epio/obsolete/univac/blo16wun.F
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: blo16wun.F,v 1.1.1.1 1996/03/08 15:22:00 mclareni Exp $
-*
-* $Log: blo16wun.F,v $
-* Revision 1.1.1.1 1996/03/08 15:22:00 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_UNIVAC)
- SUBROUTINE BLO16W(SOURCE,N1,TARGET,N2,N3)
-C.+++++++ UNIVAC VERSION ++++++++++
-C. BLOWS (UNPACKS) 16 BIT WORDS INTO MACHINE WORDS.
-C.
-C. INPUT
-C. SOURCE ARRAY CONTAINING 16 BIT WORDS IN PACKED FORM
-C. N1 FIRST 16 BIT WORD IN SOURCE TO BLOW
-C. TARGET TARGET ARRAY FOR UNPACKED 16 BIT WORDS
-C. N2 TARGET(N2) WILL CONTAIN FIRST UNPACKED WORD
-C. N3 NO. OF 16 BIT WORDS TO UNPACK
- INTEGER SOURCE(2),TARGET(2)
- CALL BLOBYT(SOURCE,TARGET(N2),N3,16,16*(N1-1)+1)
- RETURN
- END
-#endif
diff --git a/src/packlib/epio/obsolete/univac/blo32wun.F b/src/packlib/epio/obsolete/univac/blo32wun.F
deleted file mode 100644
index 8ed5d22..0000000
--- a/src/packlib/epio/obsolete/univac/blo32wun.F
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: blo32wun.F,v 1.1.1.1 1996/03/08 15:22:00 mclareni Exp $
-*
-* $Log: blo32wun.F,v $
-* Revision 1.1.1.1 1996/03/08 15:22:00 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_UNIVAC)
- SUBROUTINE BLO32W(SOURCE,N1,TARGET,N2,N3)
-C.+++++++ UNIVAC VERSION ++++++++++
-C. BLOWS (UNPACKS) 32 BIT WORDS INTO MACHINE WORDS.
-C.
-C. +++ IMPORTANT +++ COUNTS PARTLY IN 16 BIT WORDS
-C.
-C. INPUT
-C. SOURCE ARRAY CONTAINING 32 BIT WORDS IN PACKED FORM
-C. N1 FIRST 16 BIT WORD IN SOURCE TO BLOW
-C. TARGET TARGET ARRAY FOR UNPACKED 32 BIT WORDS
-C. N2 TARGET(N2) WILL CONTAIN FIRST UNPACKED WORD
-C. N3 NO. OF 32 BIT WORDS TO UNPACK
- INTEGER SOURCE(2),TARGET(2)
- CALL BLOBYT(SOURCE,TARGET(N2),N3,32,16*(N1-1)+1)
- RETURN
- END
-#endif
diff --git a/src/packlib/epio/obsolete/univac/blobyt.s b/src/packlib/epio/obsolete/univac/blobyt.s
deleted file mode 100644
index c37e749..0000000
--- a/src/packlib/epio/obsolete/univac/blobyt.s
+++ /dev/null
@@ -1,55 +0,0 @@
-*
-* $Id: blobyt.s,v 1.1.1.1 1996/03/08 15:21:59 mclareni Exp $
-*
-* $Log: blobyt.s,v $
-* Revision 1.1.1.1 1996/03/08 15:21:59 mclareni
-* Epio
-*
-*
-#if defined(CERNLIB_UNIVAC)
- . EP UTILITY PROGRAM
- . SUBROUTINE BLOBYT(SOURCE,TARGET,NBYTES,NBITS,NSTART) CONVERTS THE
- . NBYTES NBITS/BYTE STRING STARTING IN THE NSTART:TH BIT OF
- . SOURCE INTO RIGHT-ADJUSTED, ZERO-FILLED FULL WORDS OF TARGET
- . WITH ONE BYTE PER WORD.
- . UNIVAC F T N VERSION BY B.S.NILSSON, NBI, MAY 1981
- .
- AXR$ .
-$(1),BLOBYT* .
- DL A1,2,A0 .
- LA A4,0,A1 . NBYTES
- JZ A4,0,X11 . = 0 ?
- JN A4,0,X11 . < 0 ?
- LA A5,0,A2 . NBITS
- TG,U A5,37 . > 36 ?
- J ERRBLO . YES
- TLE,U A5,1 . < 1 ?
- J ERRBLO . YES
- ANA,U A4,1 .
- LR R1,A4 . REPEAT COUNT
- LR R2,A5 . NBITS
- LA A1,4,A0 .
- LA A5,0,A1 . NSTART
- JGD A5,$+2 . < 1 ?
- J ERRBLO . YES
- SZ A4 .
- DI,U A4,36 .
- DL A0,0,A0 .
- AA A0,A4 . START SOURCE WORD
- LXI,U A1,1 . TARGET ADDRESS
- LA A2,A5 . LEFT SHIFT
- LA,U A3,36 .
- ANA A3,R2 . 36-NBITS, I.E. RIGHT SHIFT
-BLOW DL A4,0,A0 . LOAD A DOUBLE WORD
- LDSL A4,0,A2 . SHIFT IN POSITION
- SSL A4,0,A3 .
- SA A4,0,*A1 . STORE ONE WORD = ONE BYTE
- AA A2,R2 . CALCULATE SHIFTS FOR NEXT WORD
- TLE,U A2,37 . IS START IN A NEW WORD ?
- JGD R1,BLOW . NO, REPEAT
- AA,U A0,1 . YES, UPDATE A0 AND A2
- ANA,U A2,36 .
- JGD R1,BLOW . END OF LOOP
- J 0,X11 . RETURN
- END .
-#endif
diff --git a/src/packlib/epio/obsolete/univac/btmvep.s b/src/packlib/epio/obsolete/univac/btmvep.s
deleted file mode 100644
index e8c37fb..0000000
--- a/src/packlib/epio/obsolete/univac/btmvep.s
+++ /dev/null
@@ -1,87 +0,0 @@
-*
-* $Id: btmvep.s,v 1.1.1.1 1996/03/08 15:21:59 mclareni Exp $
-*
-* $Log: btmvep.s,v $
-* Revision 1.1.1.1 1996/03/08 15:21:59 mclareni
-* Epio
-*
-*
-#if defined(CERNLIB_UNIVAC)
- . EP UTILITY PROGRAM
- . SUBROUTINE BTMVEP(IS,ISBIT,IT,ITBIT,NBITS) MOVES A STRING OF NBITS
- . BITS FROM STRING IS (STARTING ON BIT ISBIT) INTO STRING IT (STARTING
- . ON BIT ITBIT).
- . UNIVAC F T N VERSION BY B.S.NILSSON, NBI, MAY 1981
- .
- AXR$ .
-$(0),SAVE RES 4 . A-REG SAVE AREA
-$(1),BTMVEP* .
- LA,U A2,SAVE . SAVE A6-A9
- DS A6,0,A2 .
- DS A8,2,A2 .
- LA A3,4,A0 .
- LA A6,0,A3 . NBITS
- TLE,U A6,1 . < 1 ?
- J RET .
- DL A2,2,A0 .
- LA A4,0,A3 . ITBIT
- JGD A4,$+2 . > 0 ?
- J RET .
- DSL A4,36 .
- DI,U A4,36 . START WORD # OF IT
- AU A2,A4 . TARGET ADDR IN A3, REM BIT COUNT IN A5
- DL A0,0,A0 .
- LA A2,0,A1 . ISBIT
- JGD A2,$+2 . > 0 ?
- J RET .
- SZ A1 .
- DI,U A1,36 . START WORD # OF IS
- AA A0,A1 . SOURCE ADDR IN A0, REM BIT COUNT IN A2
- LXI,U A3,1 .
- LA A7,0,A3 . FIRST WORD OF IT
- LA A4,A2 .
- DL A8,0,A0 . FIRST TWO WORDS OF IS
- LA,U A2,36 .
- ANA A2,A5 . 36 - # BITS FROM FIRST WORD OF IT
- LA A1,A4 .
- SSC A7,0,A2 . SHIFT FIRST WORDS INTO POSITION
- LDSL A8,0,A1 .
- LA A1,A2 .
- TG A1,A6 . MIN(A2,A6)
- LA A1,A6 .
- LDSL A7,0,A1 . SHIFT IN BITS
- ANA A2,A1 .
- JZ A2,$+2 .
- LSSC A7,0,A2 . SHIFT IF NOT ON RIGHT BOUNDARY
- SA A7,0,*A3 . STORE FIRST WORD
- ANA A6,A1 . # OF BITS LEFT
- JZ A6,RET . RETURN IF DONE
- AA A4,A1 . NEXT PART FROM IS
- TLE,U A4,37 . NEW WORD ?
- J $+3 .
- ANA,U A4,36 .
- AA,U A0,1 .
- LA A1,A4 . LEFT SHIFT FOR IS IN LOOP
- LXI,U A0,1 .
- SZ A5 .
- DI,U A5,36 . FIND LOOP COUNT
- JGD A5,$+2 . ANYTHING TO BE DONE IN LOOP ?
- J FINAL .
-LOOP DL A7,0,*A0 . LOOP FOR TRANSFER OF FULL WORDS
- LDSL A7,0,A1 .
- SA A7,0,*A3 .
- JGD A5,LOOP .
-FINAL JZ A6,RET .
- DL A8,0,A0 . FIX UP ON LAST WORD
- LA A7,0,A3 .
- LA A2,A6 .
- LDSL A8,0,A1 .
- LDSL A7,0,A2 .
- SSC A7,0,A2 .
- SA A7,0,A3 .
-RET LA,U A2,SAVE . RESTORE REGISTERS
- DL A6,0,A2 .
- DL A8,2,A2 .
- J 0,X11 . RETURN
- END .
-#endif
diff --git a/src/packlib/epio/obsolete/univac/bunbyt.s b/src/packlib/epio/obsolete/univac/bunbyt.s
deleted file mode 100644
index 763495f..0000000
--- a/src/packlib/epio/obsolete/univac/bunbyt.s
+++ /dev/null
@@ -1,61 +0,0 @@
-*
-* $Id: bunbyt.s,v 1.1.1.1 1996/03/08 15:21:59 mclareni Exp $
-*
-* $Log: bunbyt.s,v $
-* Revision 1.1.1.1 1996/03/08 15:21:59 mclareni
-* Epio
-*
-*
-#if defined(CERNLIB_UNIVAC)
- . EP UTILITY PROGRAM
- . SUBROUTINE BUNBYT(SOURCE,TARGET,NBYTES,NBITS,NSTART) MERGES THE
- . RIGHTMOST NBITS BITS OF EACH OF THE NBYTES WORDS OF SOURCE INTO
- . A CONTINUOUS BITSTRING STARTING AT BIT NSTART IN TARGET.
- . UNIVAC F T N VERSION BY B.S.NILSSON, NBI, MAY 1981
- .
- AXR$ .
-$(0),SAVE + 0 . A6 SAVE AREA
-$(1),BUNBYT* .
- DL A1,2,A0 .
- LA A4,0,A1 . NBYTES
- TLE,U A4,1 . > 0 ?
- J 0,X11 .
- LA A5,0,A2 . NBITS
- TG,U A5,37 . > 36 ?
- J ERRBUN .
- TLE,U A5,1 . < 1 ?
- J ERRBUN .
- ANA,U A4,1 .
- LR R1,A4 . REPEAT COUNT
- LR R2,A5 . NBITS
- LA A1,4,A0 .
- LA A5,0,A1 . NSTART
- JGD A5,$+2 . < 1 ?
- J ERRBUN .
- SZ A4 .
- DI,U A4,36 .
- DL A0,0,A0 .
- AA A1,A4 . START WORD OF TARGET
- LXI,U A0,1 .
- LA,U A2,SAVE .
- SA A6,0,A2 . SAVE A6
- LA A2,A5 . LEFT/RIGHT SHIFT
- LA A3,R2 . NBITS
-LOOP DL A5,0,A1 . LOOP, ONE PASS PER BYTE
- LA A4,0,*A0 .
- LDSC A5,0,A2 . SHIFT THE PIECES TOGETHER
- LSSL A5,0,A3 .
- DSL A4,0,A3 .
- DSC A5,0,A2 .
- DS A5,0,A1 . STORE BACK
- AA A2,R2 . CALCULATE SHIFTS FOR NEXT BYTE
- TLE,U A2,37 . NEW WORD ?
- JGD R1,LOOP . NO, REPEAT LOOP
- AA,U A1,1 . YES, UPDATE A1 AND A2
- ANA,U A2,36 .
- JGD R1,LOOP . END OF LOOP
-RET LA,U A2,SAVE . RESTORE A6
- LA A6,0,A2 .
- J 0,X11 . RETURN
- END .
-#endif
diff --git a/src/packlib/epio/obsolete/univac/cvt360.s b/src/packlib/epio/obsolete/univac/cvt360.s
deleted file mode 100644
index bff24a1..0000000
--- a/src/packlib/epio/obsolete/univac/cvt360.s
+++ /dev/null
@@ -1,52 +0,0 @@
-*
-* $Id: cvt360.s,v 1.1.1.1 1996/03/08 15:21:59 mclareni Exp $
-*
-* $Log: cvt360.s,v $
-* Revision 1.1.1.1 1996/03/08 15:21:59 mclareni
-* Epio
-*
-*
-* ROUTINE CHANGED FOR FTN COMPILER LEVEL 10 EP-PACKAGE
-#if defined(CERNLIB_UNIVAC)
- . CERN LIBRARY INDEX: M 219
- . SUBROUTINE CVT360(A(I),A(J),MODE) CONVERTS THE RIGHT-ADJUSTED,
- . ZERO-FILLED IBM NUMBERS A(I)...A(J) TO UNIVAC 1100 NUMBERS.
- . MODE = 0 FOR FLOATING POINT CONVERSION, MODE = 1 FOR INTEGER.
- . IF MODE IS NOT SPECIFIED, MODE = 0 IS ASSUMED.
- . UNIVAC F T N VERSION BY B.S.NILSSON, NBI, APRIL 1981
- .
- AXR$ .
-$(1),CVT360*
- DL A1,0,A0 .
- ANA A2,A1 . REPEAT COUNT
- LXI,U A1,1 . (1,ADDR(A(I))
- LA A5,A0 .
- LSSL A5,9 . # OF ARGUMENTS
- SSL A5,27 .
- LA A3,2,A0 .
- SZ A4 .
- TE,U A5,2 . TWO ARGUMENTS ?
- LA A4,0,A3 . NO, LOAD A4=MODE
- JZ A4,FLOAT . FLOATING IF MODE=0
-INTEG LA A4,0,A1 .
- LSSL A4,4 . SHIFT TO INCLUDE SIGN-BIT
- SSA A4,4 .
- JP A4,$+2 . POSITIVE ?
- ANA,U A4,1 . SUBTRACT ONE FOR TWOS COMPLEMENT
- SA A4,0,*A1 . STORE INTEGER IN UNIVAC FORMAT
- JGD A2,INTEG .
- J 0,X11 . RETURN
-FLOAT LA A4,0,A1 .
- LDSL A3,5 . SIGN IN A3
- DSL A4,29 . SHIFT MANTISSA TO A5
- SSL A5,8 . MANTISSA
- LSSL A4,2 .
- ANA,U A4,129 . EXPONENT
- LCF A4,A5 . CONVERT TO FLOATING
- JNB A3,$+2 . POSITIVE ?
- LNA A5,A5 . NO, NEGATIVE
- SA A5,0,*A1 . STORE UNIVAC FLOATING NUMBER
- JGD A2,FLOAT . END OF LOOP
- J 0,X11 . RETURN
- END .
-#endif
diff --git a/src/packlib/epio/obsolete/univac/demand.s b/src/packlib/epio/obsolete/univac/demand.s
deleted file mode 100644
index 97a6d0c..0000000
--- a/src/packlib/epio/obsolete/univac/demand.s
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: demand.s,v 1.1.1.1 1996/03/08 15:22:00 mclareni Exp $
-*
-* $Log: demand.s,v $
-* Revision 1.1.1.1 1996/03/08 15:22:00 mclareni
-* Epio
-*
-*
-#if defined(CERNLIB_UNIVAC)
- . LOGICAL FUNCTION DEMAND(IDUMMY)
- . FUNCTION VALUE IS .TRUE. IF RUN IS IN DEMAND
- . CODED BY B.S.NILSSON, NBI, COPENHAGEN
- . THIS IS A F T N VERSION FROM 1979-04-24
- .
- AXR$ .
-$(1),DEMAND* LXI,U A1,PCTBD$ . BDI OF PCT
- LA,U A2,RPCTA$ .
- LDJ A1,$+1 . SWITCH TO PCT
- LA,S2 A3,030,A2 . WORD 030 FROM PCT
- LDJ A1,$+1 . SWITCH BANK BACK
- LA,U A0,1 . SET .TRUE. IN A0
- TE,U A3,4 . IS VALUE 4?
- SZ A0 . NO, NOT DEMAND
- J 0,X11 . RETURN
- END .
-#endif
diff --git a/src/packlib/epio/obsolete/univac/epfrtape.F b/src/packlib/epio/obsolete/univac/epfrtape.F
deleted file mode 100644
index 70bff2f..0000000
--- a/src/packlib/epio/obsolete/univac/epfrtape.F
+++ /dev/null
@@ -1,174 +0,0 @@
-*
-* $Id: epfrtape.F,v 1.1.1.1 1996/03/08 15:21:59 mclareni Exp $
-*
-* $Log: epfrtape.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:59 mclareni
-* Epio
-*
-*
-* PROGRAM FOR COPYING EP-FILES TO DISK FROM TAPE
-#if defined(CERNLIB_UNIVAC)
-#include "sys/CERNLIB_machine.h"
-#include "_epio/pilot.h"
-C PROGRAM EPFRTAPE COPIES TAPE FILES IN EP-FORMAT TO DISK BLOCK
-C BY BLOCK. THE PROGRAM PREFIXES EACH BLOCK BY ONE WORD CONTAINING
-C ('EP',BLOCK LENGTH), THUS GIVING THE DISK FILE THE SAME STRUCTURE
-C AS THE TAPEFILE. A DISK BLOCK ALWAYS STARTS ON A SECTOR BOUNDARY.
-C WHEN THE PROGRAM ENCOUNTERS A TAPE EOF, A ONE WORD BLOCK CONTAIN-
-C ING THE WORD 'EOFM' IS WRITTEN TO THE DISK FILE.
-C THE PROGRAM WILL, IF RUN IN DEMAND, QUERY FOR THE OUTPUT FILE NAMES.
-C IF OPTION('R') THE PROGRAM COPIES ONLY THE FIRST NFBLK BLOCKS FROM
-C THE INPUT TAPE. NFBLK IS READ FOR EACH FILE BEFORE THE FILENAME.
-C
-C THE INPUT TAPE MUST BE ASSIGNED USING THE NAME EPTAPE.
-C
- PARAMETER (NBUF=5000)
- IMPLICIT INTEGER (A-Z)
- LOGICAL DEMAND,DEM,OPTION,OPTR,IFMOVE
- CHARACTER*48 UDFILE
- CHARACTER*1 UDFILC(48)
- DIMENSION BUF(NBUF)
- DATA DFIL/'EP$UD 'F/,TFIL/'EP$TP 'F/,IEOF/'EOFM'/
- DATA BUF(1)/'EP '/
-C
-C DUMMY READ FOR ENABLING PROCESSOR CALL
-C
- READ(5,17)
-C
-C DEMAND RUN ?
-C
- DEM=DEMAND(IDUM)
-C
-C CHECK TAPE FILE ASSIGNMENT
-C
- ISTAT=FACSF2('@USE EP$TP,EPTAPE . ')
- IOD=IODEV('EP$TP')
- IF(IOD.LE.0) THEN
- WRITE(6,*) ' NO TAPE NAMED EPTAPE IS ASSIGNED'
- STOP 'PROGRAM TERMINATED'
- ELSE IF(IOD.GE.16) THEN
- WRITE(6,*) ' EPTAPE IS A DISK FILE, NOT TAPE'
- STOP 'PROGRAM TERMINATED'
- ENDIF
- NFITOT=0
- NBLTOT=0
- IQUE=0
- OPTR=OPTION('R')
- IFMOVE=.FALSE.
- NFBLK=-1
- 100 CONTINUE
- IF(OPTR) THEN
- IF(DEM) WRITE(6,*) ' HOW MANY BLOCKS SHOULD BE COPIED ?'
- READ(5,*,END=400) NFBLK
- IF(IFMOVE) CALL TIOMVF(TFIL,1,ISTAT)
- IFMOVE=.FALSE.
- ENDIF
- IF(DEM) WRITE(6,*) ' ENTER FILENAME OR @EOF'
- READ(5,'(A48)',END=400) UDFILE
- DO 110 I=1,48
- 110 UDFILC(I)=UDFILE(I:I)
- IQUE=IQUE+1
- I1=1
- DO 120 I=1,48
- IF(UDFILC(I).NE.' ') GOTO 130
- 120 I1=I+1
- 130 CONTINUE
- I2=48
- DO 140 I=48,1,-1
- IF(UDFILC(I).NE.' ') GOTO 150
- 140 I2=I-1
- 150 CONTINUE
- IF(I1.GT.I2) THEN
- WRITE(6,10) UDFILE
- GOTO 180
- ENDIF
- ISTAT=FACSF2('@USE EP$UD.,'//UDFILE(I1:I2)//' . ')
- IF(ISTAT.NE.0) THEN
- WRITE(6,11) (UDFILC(I),I=I1,I2)
- GOTO 180
- ENDIF
-C
-C CHECK DEVICE
-C
- IOD=IODEV('EP$UD')
- IF(IOD.LE.0) THEN
- ISTAT=FACSF2('@ASG,A EP$UD . ')
- IOD=IODEV('EP$UD')
- ENDIF
- IF(IOD.LE.0) THEN
- WRITE(6,12) (UDFILC(I),I=I1,I2)
- GOTO 180
- ENDIF
- IF(IOD.LT.16) THEN
- WRITE(6,13) (UDFILC(I),I=I1,I2)
- GOTO 180
- ENDIF
- GOTO 190
-C
-C ERROR. ABORT IF BATCH, OTHERWISE TRY AGAIN BUT AT MOST THREE TIMES
-C
- 180 IF(.NOT.DEM) CALL FABORT
- IF(IQUE.LT.3) GOTO 100
- STOP 'ABNORMAL TERMINATION'
-C
-C ALL CHECKS DONE. START TO COPY.
-C
- 190 NBLOCK=0
- IADD=0
- IQUE=0
-C
-C GET A BLOCK
-C
- 200 CALL TIOR(TFIL,BUF(2),NBUF,ISTAT,IAFH)
- IF(ISTAT.LT.-4) THEN
-C
-C I/O ERROR
-C
- WRITE(6,15) NBLOCK,NFITOT
- IF(DEM) STOP
- CALL FABORT
- ENDIF
- 210 CONTINUE
- IF(ISTAT.EQ.-1) THEN
-C
-C END-OF-FILE ON INPUT TAPE
-C
- IF(NBLOCK.EQ.0) GOTO 400
- NBLTOT=NBLTOT+NBLOCK
- NFITOT=NFITOT+1
- WRITE(6,16) NBLOCK,NFITOT,(UDFILC(I),I=I1,I2)
- CALL FIOW(DFIL,IEOF,1,IADD,ISTAT)
- GOTO 100
- ENDIF
- NW=ISTAT
- BITS(BUF(1),19,18)=NW
- CALL FIOW(DFIL,BUF,NW+1,IADD,ISTAT)
- IF(ISTAT.LT.0) THEN
- WRITE(6,14) ISTAT,IADD,(UDFILC(I),I=I1,I2)
- IF(DEM) STOP
- CALL FABORT
- ENDIF
- IADD=IADD+(NW+28)/28
- NBLOCK=NBLOCK+1
- IF(NBLOCK.EQ.NFBLK) THEN
- ISTAT=-1
- IFMOVE=.TRUE.
- GOTO 210
- ELSE
- GOTO 200
- ENDIF
- 400 WRITE(6,17) NFITOT,NBLTOT
- WRITE(6,18)
- STOP
- 10 FORMAT(' INCORRECT FILENAME READ: ',A48)
- 11 FORMAT(' STATUS',O14,' FOR @USE EP$UD.,',48A1)
- 12 FORMAT(' FILE IS NOT CATALOGUED OR ASSIGNED: ',48A1)
- 13 FORMAT(' OUTPUT FILE IS A TAPEFILE. COPY BY OTHER MEANS !')
- 14 FORMAT(' STATUS',O14,' RETURNED FOR IADD=',I8,' ON FILE ',48A1)
- 15 FORMAT(' STATUS',O14,' RETURNED FOR BLOCK ',I4,' , FILE NO ',
- 1 I3,' ON INPUT TAPE')
- 16 FORMAT(I6,' BLOCKS COPIED FROM FILE NO',I3,' TO ',48A1)
- 17 FORMAT(I5,' FILES COPIED, TOTALLY ',I8,' BLOCKS')
- 18 FORMAT(' NORMAL PROGRAM TERMINATION')
- END
-#endif
diff --git a/src/packlib/epio/obsolete/univac/eptotape.F b/src/packlib/epio/obsolete/univac/eptotape.F
deleted file mode 100644
index 13771cc..0000000
--- a/src/packlib/epio/obsolete/univac/eptotape.F
+++ /dev/null
@@ -1,169 +0,0 @@
-*
-* $Id: eptotape.F,v 1.1.1.1 1996/03/08 15:21:59 mclareni Exp $
-*
-* $Log: eptotape.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:59 mclareni
-* Epio
-*
-*
-* PROGRAM FOR COPYING EP-FILES FROM DISK TO TAPE
-#if defined(CERNLIB_UNIVAC)
-#include "sys/CERNLIB_machine.h"
-#include "_epio/pilot.h"
-C PROGRAM EPTOTAPE COPIES EP-FORMATTED UNIVAC DISK FILES TO TAPE
-C BLOCK BY BLOCK. IN EACH BLOCK, THE FIRST WORD CONTAINING
-C ('EP',BLOCK LENGTH) IS THUS STRIPPED OFF AND THE REST MAKES ONE
-C TAPEBLOCK.
-C THE PROGRAM WILL, IF RUN IN DEMAND, QUERY FOR THE INPUT FILE NAMES.
-C THE OUTPUT TAPE MUST BE ASSIGNED USING THE NAME EPTAPE.
-C
- PARAMETER NBUF=5000
- IMPLICIT INTEGER (A-Z)
- LOGICAL DEMAND,DEM
- CHARACTER*48 INFILE
- CHARACTER*1 INFILC(48)
- DIMENSION BUF(NBUF)
- DATA DFIL/'EP$IN 'F/,TFIL/'EP$TP 'F/,IEOF/'EOFM'/
- DATA EP/O000000105120/
-C
-C DUMMY READ FOR ENABLING PROCESSOR CALL
-C
- READ(5,17)
-C
-C DEMAND RUN ?
-C
- DEM=DEMAND(IDUM)
-C
-C CHECK TAPE FILE ASSIGNMENT
-C
- ISTAT=FACSF2('@USE EP$TP,EPTAPE . ')
- IOD=IODEV('EP$TP')
- IF(IOD.LE.0) THEN
- WRITE(6,*) ' NO TAPE NAMED EPTAPE IS ASSIGNED'
- STOP 'PROGRAM TERMINATED'
- ELSE IF(IOD.GE.16) THEN
- WRITE(6,*) ' EPTAPE IS A DISK FILE, NOT TAPE'
- STOP 'PROGRAM TERMINATED'
- ENDIF
- NFITOT=0
- NBLTOT=0
- IQUE=0
- 100 CONTINUE
- IF(DEM) WRITE(6,*) ' ENTER FILENAME OR @EOF'
- READ(5,'(A48)',END=400) INFILE
- DO 110 I=1,48
- 110 INFILC(I)=INFILE(I:I)
- IQUE=IQUE+1
- I1=1
- DO 120 I=1,48
- IF(INFILC(I).NE.' ') GOTO 130
- 120 I1=I+1
- 130 CONTINUE
- I2=48
- DO 140 I=48,1,-1
- IF(INFILC(I).NE.' ') GOTO 150
- 140 I2=I-1
- 150 CONTINUE
- IF(I1.GT.I2) THEN
- WRITE(6,10) INFILE
- GOTO 180
- ENDIF
- ISTAT=FACSF2('@USE EP$IN.,'//INFILE(I1:I2)//' . ')
- IF(ISTAT.NE.0) THEN
- WRITE(6,11) (INFILC(I),I=I1,I2)
- GOTO 180
- ENDIF
-C
-C CHECK DEVICE
-C
- IOD=IODEV('EP$IN')
- IF(IOD.LE.0) THEN
- ISTAT=FACSF2('@ASG,A EP$IN . ')
- IOD=IODEV('EP$IN')
- ENDIF
- IF(IOD.LE.0) THEN
- WRITE(6,12) (INFILC(I),I=I1,I2)
- GOTO 180
- ENDIF
- IF(IOD.LT.16) THEN
- WRITE(6,13) (INFILC(I),I=I1,I2)
- GOTO 180
- ENDIF
- GOTO 190
-C
-C ERROR. ABORT IF BATCH, OTHERWISE TRY AGAIN BUT AT MOST THREE TIMES
-C
- 180 IF(.NOT.DEM) CALL FABORT
- IF(IQUE.LT.3) GOTO 100
- STOP 'ABNORMAL TERMINATION'
-C
-C ALL CHECKS DONE. START TO COPY.
-C
- 190 NBLOCK=0
- IADD=0
- IQUE=0
-C
-C GET NEW FULL BUFFER
-C
- 200 CALL FIOR(DFIL,BUF,NBUF,IADD,ISTAT)
- IF(ISTAT.NE.-5.AND.ISTAT.LT.0) THEN
-C
-C I/O ERROR
-C
- WRITE(6,14) ISTAT,IADD,(INFILC(I),I=I1,I2)
- GOTO 300
- ENDIF
- J1=1
- 210 IF(BUF(J1).EQ.IEOF) GOTO 300
- EPR=BITS(BUF(J1),1,18)
- IF(EPR.NE.EP) THEN
-C
-C LEFT HALF OF BUF(J1) DOES NOT CONTAIN 'EP'. NO FIXUP POSSIBLE
-C
- WRITE(6,19) BUF(J1),NBLOCK,J1,(INFILC(I),I=I1,I2)
- STOP 'ABNORMAL TERMINATION'
- ENDIF
- NW=BITS(BUF(J1),19,18)
- J2=J1+NW
- IF(J2.GT.NBUF) GOTO 200
- CALL TIOW(TFIL,BUF(J1+1),NW,ISTAT)
- IF(ISTAT.NE.NW) THEN
-C
-C I/O ERROR ON OUTPUT TAPE
-C
- WRITE(6,15) ISTAT,NBLOCK,NFITOT
- IF(DEM) STOP
- CALL FABORT
- ENDIF
- ISEC=(NW+28)/28
- IADD=IADD+ISEC
- J1=J1+ISEC*28
- NBLOCK=NBLOCK+1
- GOTO 210
-C
-C WRITE EOF ON OUTPUT TAPE
-C
- 300 CALL TIOWEF(TFIL,ISTAT)
- CALL TIOWEF(TFIL,ISTAT)
- CALL TIOMVF(TFIL,-1,ISTAT)
- NBLTOT=NBLTOT+NBLOCK
- IF(NBLOCK.GT.0) NFITOT=NFITOT+1
- WRITE(6,16) NBLOCK,NFITOT,(INFILC(I),I=I1,I2)
- GOTO 100
- 400 WRITE(6,17) NFITOT,NBLTOT
- WRITE(6,18)
- STOP
- 10 FORMAT(' INCORRECT FILENAME READ: ',A48)
- 11 FORMAT(' STATUS',O14,' FOR @USE EP$IN.,',48A1)
- 12 FORMAT(' FILE IS NOT CATALOGUED OR ASSIGNED: ',48A1)
- 13 FORMAT(' INPUT FILE IS A TAPEFILE. COPY BY OTHER MEANS !')
- 14 FORMAT(' STATUS',O14,' RETURNED FOR IADD=',I8,' ON FILE ',48A1)
- 15 FORMAT(' STATUS',O14,' RETURNED FOR BLOCK ',I4,' , FILE NO ',
- 1 I3,' ON OUTPUT TAPE')
- 16 FORMAT(I6,' BLOCKS COPIED TO FILE NO',I3,' FROM ',48A1)
- 17 FORMAT(I5,' FILES COPIED, TOTALLY ',I8,' BLOCKS')
- 18 FORMAT(' NORMAL PROGRAM TERMINATION')
- 19 FORMAT(' INCORRECT CONTROL WORD',O14,'. NBLOCK=',I3,' J1=',I5,
- 1 /,' ON FILE ',48A1)
- END
-#endif
diff --git a/src/packlib/epio/obsolete/univac/erblobyn.s b/src/packlib/epio/obsolete/univac/erblobyn.s
deleted file mode 100644
index 7f86b05..0000000
--- a/src/packlib/epio/obsolete/univac/erblobyn.s
+++ /dev/null
@@ -1,84 +0,0 @@
-*
-* $Id: erblobyn.s,v 1.1.1.1 1996/03/08 15:22:00 mclareni Exp $
-*
-* $Log: erblobyn.s,v $
-* Revision 1.1.1.1 1996/03/08 15:22:00 mclareni
-* Epio
-*
-*
-#if defined(CERNLIB_UNIVAC)
- . EP UTILITY PROGRAM
- . ERROR HANDLER FOR BLOBYT AND BUNBYT
- .
- . ERROR PRINTOUT WHEN NBITS > 36, NBITS < 1 OR NSTART < 1.
- .
- . UNIVAC F T N VERSION BY B.S.NILSSON, NBI, MAY 1981
- .
- AXR$ .
-$(0),A0SAVE RES 6 . SCRATCH AREA
-ERRTEX1 ' *** ERROR IN BLOBYT *** ' .
-ERRTEX2 ' *** ERROR IN BUNBYT *** ' .
-ERRTEX3 ' A0 + X11 +' .
-ERRTEX4 ' NBYTES=+ NBITS=+ NSTART=+' .
-ERRTEX5 ' *** NO ACTION TAKEN ***' .
-PKT E$PKT 8,LINE . PRINT PACKET FOR ERROR MESSAGE
-LINE RES 8 .
-$(1),ERRBLO* LA,U A1,A0SAVE . ENTRY FROM BLOBYT
- SA A0,0,A1 . SAVE A0
- LXM,U A0,ERRTEX1 . FIRST LINE OF ERROR TEXT
- J ERRPR .
-ERRBUN* LA,U A1,A0SAVE . ENTRY FROM BUNBYT
- SA A0,0,A1 . SAVE A0
- LXM,U A0,ERRTEX2 . FIRST LINE OF ERROR TEXT
-ERRPR LXI,U A0,0205 .
- ER PRINT$ . PRINT FIRST ERROR LINE
- SX X5,5,A1 . STORE X5
- LX X5,A1 . ADDR(A0SAVE) IN X5
- SX X11,1,A1 . STORE X11
- LA A0,0,A1 . COPY ARGUMENT VALUES
- DL A2,2,A0 .
- LA A4,0,A2 .
- LA A5,0,A3 .
- DS A4,2,A1 .
- LA A2,4,A0 .
- LA A4,0,A2 .
- SA A4,4,A1 .
- LA,U A0,PKT . START EDITED PRINT
- LMJ X11,EDIT$ .
- LA,U A0,ERRTEX3 .
- LMJ X11,EMSG$ .
- LA,U A1,12 .
- LA A0,0,X5 .
- LMJ X11,EOCTF$ .
- LMJ X11,EMSGR$ .
- LA,U A1,12 .
- LA A0,1,X5 .
- LMJ X11,EOCTF$ .
- LMJ X11,EDITX$ .
- LXI,U A0,0107 .
- LXM,U A0,LINE .
- ER PRINT$ . 2ND LINE
- LA,U A0,PKT . START NEXT LINE
- LMJ X11,EDIT$ .
- LA,U A0,ERRTEX4 .
- LMJ X11,EMSG$ .
- LA A0,2,X5 .
- LMJ X11,EDECV$ .
- LMJ X11,EMSGR$ .
- LA A0,3,X5 .
- LMJ X11,EDECV$ .
- LMJ X11,EMSGR$ .
- LA A0,4,X5 .
- LMJ X11,EDECV$ .
- LMJ X11,EDITX$ .
- LXI,U A0,0110 .
- LXM,U A0,LINE .
- ER PRINT$ . 3RD LINE
- LXI,U A0,0105 .
- LXM,U A0,ERRTEX5 .
- ER PRINT$ . 4TH LINE
- LX X11,1,X5 . RESTORE X5 AND X11
- LX X5,5,X5 .
- J 0,X11 . RETURN
- END .
-#endif
diff --git a/src/packlib/epio/obsolete/univac/fastio.s b/src/packlib/epio/obsolete/univac/fastio.s
deleted file mode 100644
index fb5e3d7..0000000
--- a/src/packlib/epio/obsolete/univac/fastio.s
+++ /dev/null
@@ -1,57 +0,0 @@
-*
-* $Id: fastio.s,v 1.1.1.1 1996/03/08 15:22:00 mclareni Exp $
-*
-* $Log: fastio.s,v $
-* Revision 1.1.1.1 1996/03/08 15:22:00 mclareni
-* Epio
-*
-*
-#if defined(CERNLIB_UNIVAC)
- . SUBROUTINE FIOR/W/SCR/GW('FILENAME',BUFFERADR,NWORDS,STARTADR,STATUS)
- . CODED BY B.S.NILSSON, NBI, COPENHAGEN 1977-05-13
- . THOROUGH REVISION MADE ON 1980-03-12
- . THIS IS A F T N VERSION REQUIRING FILENAME IN FIELDATA CODE
- .
- AXR$ .
-$(0),IOPKT I$OD ' ',0 0,0 0 . I/O PACKET
-$(1),FIOSCR* LA,U A3,SCR$ . SCATTER READ ENTRY
- J ALL .
-FIOGW* LA,U A3,GW$ . GATHER WRITE ENTRY
- J ALL .
-FIOR* LA,U A3,R$ . READ ENTRY
- J ALL .
-FIOW* LA,U A3,W$ . WRITE ENTRY
-ALL LA,U A2,IOPKT . (IOPKT) IN A2
- SA,S2 A3,3,A2 .
- LA A3,A0 . SAVE A0 IN A3
- LA A1,0,A0 .
- SFS 1,A2 . SET BLANKS IN 2ND HALF OF FILENAME
- DL A4,0,A1 .
- SA A4,0,A2 . FILENAME FIRST WORD
- LA,S6 A4,0,A2 . CHECK FOR BLANK IN 6TH CHAR
- TNE,U A4,05 .
- J CONT .
- LA A4,A5 .
- SSL A4,30 . CHECK FOR 7TH CHARACTER BLANK
- TNE,U A4,05 .
- J CONT .
- TE,U A4,077 . CHECK 7TH CHARACTER FOR STOPCODE
- SA A5,1,A2 . NO, STORE FILENAME SECOND WORD
-CONT LA A1,1,A0 .
- SA,H2 A1,4,A2 . BUFFER ADDRESS
- LA A1,2,A0 .
- LA A4,0,A1 .
- SA,H1 A4,4,A2 . NUMBER OF WORDS
- LA A1,3,A0 .
- LA A4,0,A1 .
- SA A4,5,A2 . START ADDRESS
- LA A0,A2 . MAKE I/O ER
- ER IOW$ .
- LNA,S1 A4,3,A2 . GET STATUS
- JNZ A4,$+2 . EVERYTHING OK ?
- LA,H2 A4,3,A2 . YES, STATUS = # OF WORDS
- LA A0,4,A3 .
- SA A4,0,A0 .
- J 0,X11 . RETURN
- END .
-#endif
diff --git a/src/packlib/epio/obsolete/univac/fitem.s b/src/packlib/epio/obsolete/univac/fitem.s
deleted file mode 100644
index 1caa55d..0000000
--- a/src/packlib/epio/obsolete/univac/fitem.s
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: fitem.s,v 1.1.1.1 1996/03/08 15:22:00 mclareni Exp $
-*
-* $Log: fitem.s,v $
-* Revision 1.1.1.1 1996/03/08 15:22:00 mclareni
-* Epio
-*
-*
-#if defined(CERNLIB_UNIVAC)
- . SUBROUTINE FITEM(PACKET) CALLS ER FITEM$ WITH PACKET 'PACKET'.
- . THE PACKET MUST BE AT LEAST 13 WORDS LONG
- . THIS IS A F T N VERSION FROM 1981-07-01.
- AXR$ .
-$(1),FITEM* LA A0,0,A0 .
- LXI,U A0,13 .
- ER FITEM$ .
- J 0,X11 .
- END .
-#endif
diff --git a/src/packlib/epio/obsolete/univac/fto360.s b/src/packlib/epio/obsolete/univac/fto360.s
deleted file mode 100644
index 686c4b4..0000000
--- a/src/packlib/epio/obsolete/univac/fto360.s
+++ /dev/null
@@ -1,70 +0,0 @@
-*
-* $Id: fto360.s,v 1.1.1.1 1996/03/08 15:22:00 mclareni Exp $
-*
-* $Log: fto360.s,v $
-* Revision 1.1.1.1 1996/03/08 15:22:00 mclareni
-* Epio
-*
-*
-* ROUTINE CHANGED FOR FTN COMPILER LEVEL 10 EP-PACKAGE
-#if defined(CERNLIB_UNIVAC)
- . CERN LIBRARY INDEX: M 430
- . SUBROUTINE FTO360(A,N,MODE) CONVERTS THE N UNIVAC NUMBERS
- . STARTING AT A TO RIGHT-ADJUSTED, ZERO-FILLED IBM NUMBERS.
- . MODE = 0 FOR FLOATING POINT CONVERSION, MODE = 1 OR 'I' FOR INTEGER.
- . ALTERNATIVE ENTRYPOINT FOR INTEGER CONVERSION: ITO360(A,N).
- . IF MODE IS NOT SPECIFIED, MODE = 0 IS ASSUMED.
- . UNIVAC F T N VERSION BY B.S.NILSSON, NBI, MAY 1981
- .
- AXR$ .
-$(1),ITO360* . ITO360 ENTRY
- SZ A5 .
- J $+2 .
-FTO360* LA,U A5,1 . FTO360 ENTRY
- DL A1,0,A0 .
- LXI,U A1,1 . (1,ADDR(A))
- LA A2,0,A2 .
- ANA,U A2,1 .
- LR R1,A2 . REPEAT COUNT
- JZ A5,INTEG .
- LA A3,2,A0 .
- LSSL A0,9 . # OF ARGUMENTS
- SSL A0,27 .
- SZ A4 .
- TE,U A0,2 .
- LA A4,0,A3 . FLOATING OR INTEGER CONVERSION ?
- JZ A4,FLOAT .
- SSL A4,27 .
- TNE,U A4,0106 . MODE='F' ?
- J FLOAT .
- TNE,U A4,0146 . MODE='F' (LOWER CASE) ?
- J FLOAT .
-INTEG LA A3,0,A1 . CONVERSION OF INTEGERS
- JP A3,$+4 . POSITIVE ?
- LSSL A3,4 . NO, ADD 1
- AA,U A3,020 .
- SSL A3,4 .
- SA A3,0,*A1 . STORE BACK
- JGD R1,INTEG . END OF LOOP
- J 0,X11 . RETURN
-FLOAT LUF A2,0,A1 . FLOATING POINT CONVERSION
- LMA A4,A3 . EXP IN A2, ABS IN A4, # IN A5
- LA A5,A3 .
- DSL A2,2 . EXP IS POWER OF 16
- SSL A3,34 .
- JZ A3,$+4 .
- AA,U A2,1 . MAKE SHIFTS IF MOD(EXP,4).NE.0
- LNA A0,A3 .
- SSA A4,4,A0 .
- AA,U A2,32 . UNIVAC EXP IS BIASED 0200, IBM IS 64
- JN A5,$+3 . INSERT SIGN BIT
- AND,U A2,0177 .
- J $+2 .
- OR,U A2,0200 .
- LSSL A4,9 . SHIFT PARTS TOGETHER
- LDSL A3,24 .
- SA A3,0,*A1 . STORE BACK IN IBM-FORMAT
- JGD R1,FLOAT . END OF LOOP
- J 0,X11 . RETURN
- END .
-#endif
diff --git a/src/packlib/epio/obsolete/univac/i16cti.s b/src/packlib/epio/obsolete/univac/i16cti.s
deleted file mode 100644
index a2f7867..0000000
--- a/src/packlib/epio/obsolete/univac/i16cti.s
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: i16cti.s,v 1.1.1.1 1996/03/08 15:22:00 mclareni Exp $
-*
-* $Log: i16cti.s,v $
-* Revision 1.1.1.1 1996/03/08 15:22:00 mclareni
-* Epio
-*
-*
-#if defined(CERNLIB_UNIVAC)
- . EP UTILITY PROGRAM
- . SUBROUTINE I16CTI(A,NW) CONVERTS 16 BIT UNIVAC INTEGERS (INCLUDING
- . SIGN) TO IBM INTEGERS.
- . UNIVAC F T N VERSION BY B.S.NILSSON, NBI, MAY 1981
- .
- AXR$ .
-$(1),I16CTI* LA A1,1,A0 . ADDR(NW)
- LR R1,0,A1 . NW
- JGD R1,$+2 . NW > 0 ?
- J 0,X11 . NO, RETURN
- LA A2,0,A0 . ADDR(A)
- LXI,U A2,1 . INCREMENT
- LA,U A5,1 .
- LSSL A5,20 . 1 BIT FOR CONVERSION OF NEGATIVE NUMBERS
-LOOP LA A0,0,A2 . GET A WORD IN A
- LSSL A0,20 . SHIFT TO LEFT OF A0
- JP A0,$+2 . POSITIVE ?
- AA A0,A5 . ADD 1 TO LOWEST BIT WHEN NEGATIVE
- SSA A0,20 . SHIFT INTO POSITION
- SA A0,0,*A2 . STORE BACK
- JGD R1,LOOP . REPEAT
- J 0,X11 . RETURN
- END .
-#endif
diff --git a/src/packlib/epio/obsolete/univac/i16itc.s b/src/packlib/epio/obsolete/univac/i16itc.s
deleted file mode 100644
index b141c95..0000000
--- a/src/packlib/epio/obsolete/univac/i16itc.s
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: i16itc.s,v 1.1.1.1 1996/03/08 15:22:00 mclareni Exp $
-*
-* $Log: i16itc.s,v $
-* Revision 1.1.1.1 1996/03/08 15:22:00 mclareni
-* Epio
-*
-*
-#if defined(CERNLIB_UNIVAC)
- . EP UTILITY PROGRAM
- . SUBROUTINE I16ITC(A,NW) CONVERTS NW 16 BIT IBM INTEGERS RIGHT ADJUSTED
- . IN A TO UNIVAC INTEGERS (INCLUDING SIGN).
- . UNIVAC F T N VERSION BY B.S.NILSSON, NBI, MAY 1981
- .
- AXR$ .
-$(1),I16ITC* LA A1,1,A0 . ADDR(NW)
- LR R1,0,A1 . NW
- JGD R1,$+2 . NW > 0 ?
- J 0,X11 . NO, RETURN
- LA A2,0,A0 . ADDR(A)
- LXI,U A2,1 . INCREMENT
-LOOP LA A0,0,A2 . GET A WORD IN A
- LSSL A0,20 . SHIFT IN POSITION WITH SIGN
- SSA A0,20 .
- JP A0,$+2 . POSITIVE ?
- ANA,U A0,1 .
- SA A0,0,*A2 . STORE BACK
- JGD R1,LOOP . REPEAT
- J 0,X11 . RETURN
- END .
-#endif
diff --git a/src/packlib/epio/obsolete/univac/iodev.s b/src/packlib/epio/obsolete/univac/iodev.s
deleted file mode 100644
index a80f586..0000000
--- a/src/packlib/epio/obsolete/univac/iodev.s
+++ /dev/null
@@ -1,76 +0,0 @@
-*
-* $Id: iodev.s,v 1.1.1.1 1996/03/08 15:22:00 mclareni Exp $
-*
-* $Log: iodev.s,v $
-* Revision 1.1.1.1 1996/03/08 15:22:00 mclareni
-* Epio
-*
-*
-* ROUTINE CHANGED FOR FTN COMPILER LEVEL 10 EP-PACKAGE
-#if defined(CERNLIB_UNIVAC)
- . INTEGER FUNCTION IODEV('FILENAME') RETURNS DEVICE EQUIPMENT CODE.
- . SEE PRM (UP-4144) 2.7-12
- . CODED BY B.S.NILSSON, NBI, COPENHAGEN, AUG 1980.
- . THIS IS A F T N VERSION REQUIRING FILENAME OF TYPE CHARACTER
- . IN ASCII CODE.
- .
- AXR$ .
-$(0),PKT ' ' . FITEM$-PACKET.
- RES 11 .
-RSAVE RES 2 . SAVE AREA FOR X11 AND # OF CHAR:S
-FITA0 + 13,PKT .
-$(1),IODEV* LA,U A2,PKT . (PKT) IN A2
- SX X11,14,A2 . SAVE X11
- LA A1,A0 . CHECK IF ARGUMENT IS TYPE CHARACTER
- SSL A1,30 .
- ANA,U A1,1 .
- JZ A1,$+3 .
- SN1 A0 .
- J 0,X11 . RETURN
- LA,Q2 A3,1,A0 . OK, # OF CHARACTERS
- SA A3,13,A2 .
- AA,U A3,3 .
- DSL A3,38 .
- LA,H2 A1,0,A0 . ADDRESS OF FILENAME
- LA,Q1 A3,1,A0 . FIND OFFSET
- LA A0,A4 .
- JZ A3,OFF .
- MSI,U A3,9 .
- DL A4,0,A1 .
- LDSL A4,0,A3 .
- SA A4,2,A2 .
- DL A4,1,A1 .
- LDSL A4,0,A3 .
- SA A4,3,A2 .
- DL A4,2,A1 .
- LDSL A4,0,A3 .
- SA A4,4,A2 .
- LA,U A1,PKT+2 .
-OFF LXI,U X11,PIRCB$ .
- LIJ X11,BASCFD$ . TRANSLATE FILENAME TO FIELDATA
- LA,U A2,PKT .
- LA A1,13,A2 . # OF CHAR:S
- TG,U A1,7 .
- J TWO .
-ONE SFS 1,A2 . ONE WORD
- SFS A3 .
- LA A4,0,A2 .
- MSI,U A1,6 .
- LDSL A3,0,A1 . SHIFT IN FD BLANKS
- SSC A3,0,A1 .
- SA A3,0,A2 .
- J CONT .
-TWO SFS A3 . TWO WORDS
- ANA,U A1,6 .
- LA A4,1,A2 .
- MSI,U A1,6 .
- LDSL A3,0,A1 . SHIFT IN FD BLANKS
- SSC A3,0,A1 .
- SA A3,1,A2 .
-CONT LA A0,15,A2 . PREPARE A0
- ER FITEM$ .
- LA,S1 A0,6,A2 . RETURN EQUIPMENT CODE
- LX X11,14,A2 . RESTORE X11
- J 0,X11 . RETURN
- END .
-#endif
diff --git a/src/packlib/epio/obsolete/univac/iwd16.s b/src/packlib/epio/obsolete/univac/iwd16.s
deleted file mode 100644
index f92eba1..0000000
--- a/src/packlib/epio/obsolete/univac/iwd16.s
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: iwd16.s,v 1.1.1.1 1996/03/08 15:22:00 mclareni Exp $
-*
-* $Log: iwd16.s,v $
-* Revision 1.1.1.1 1996/03/08 15:22:00 mclareni
-* Epio
-*
-*
-#if defined(CERNLIB_UNIVAC)
- . EP UTILITY PROGRAM
- . FUNCTION IWD16(M,N) RETURNS THE N-TH 16 BIT WORD OF STRING M AS A
- . POSITIVE INTEGER.
- . UNIVAC F T N VERSION BY B.S.NILSSON, NBI, MAY 1981
- .
- AXR$ .
-$(1),IWD16* LA A2,1,A0 . ADDR(N)
- LA A3,0,A2 . N
- ANA,U A3,1 . N-1
- LSSL A3,4 . (N-1)*16
- SZ A2 .
- DI,U A2,36 .
- AA A2,0,A0 . WORD ADDRESS
- DL A0,0,A2 . LOAD 2 WORDS
- LDSL A0,0,A3 . SHIFT LEFT
- SSL A0,20 . SHIFT BACK TO RIGHT BOUNDARY
- J 0,X11 . RETURN
- END .
-#endif
diff --git a/src/packlib/epio/obsolete/univac/tapeio.s b/src/packlib/epio/obsolete/univac/tapeio.s
deleted file mode 100644
index eb38250..0000000
--- a/src/packlib/epio/obsolete/univac/tapeio.s
+++ /dev/null
@@ -1,139 +0,0 @@
-*
-* $Id: tapeio.s,v 1.1.1.1 1996/03/08 15:22:00 mclareni Exp $
-*
-* $Log: tapeio.s,v $
-* Revision 1.1.1.1 1996/03/08 15:22:00 mclareni
-* Epio
-*
-*
-#if defined(CERNLIB_UNIVAC)
- . SUBROUTINE TAPEIO MAKES VARIOUS I/O OPERATIONS ON TAPE.
- . THIS IS A F T N VERSION REQUIRING FILENAME IN FIELDATA CODE.
- . CODED BY B.S.NILSSON, NBI, COPENHAGEN, 1979-03-16, REVISED 1981-06-30.
- .
- AXR$ .
-$(0),IOPKT I$OT ' ',0 0,0 . I/O PACKET
- .
- . SUBROUTINE TIOWEF('FILENAME',STATUS) WRITE EOF
-$(1),TIOWEF* LA,U A3,WEF$ . WRITE EOF CODE
- J ARG2 .
- .
- . SUBROUTINE TIOREW('FILENAME',STATUS) REWIND
-TIOREW* LA,U A3,REW$ . REWIND CODE
-ARG2 LA,U A2,IOPKT . ADDR(IOPKT)
- SA,S2 A3,3,A2 . STORE I/O CODE ON PACKET
- LMJ A1,FILENAME . FILENAME HANDLER
- LA A0,A2 . SET UP I/O
- ER IOW$ .
- LNA,S1 A4,3,A2 . STATUS
- LA A0,1,A3 .
- JNZ A4,$+2 . EVERYTHING OK ?
- SZ A4 . YES, SET STATUS TO ZERO
- SA A4,0,A0 . STORE STATUS
- J 0,X11 . RETURN FROM 2-ARG ENTRIES
- .
- . SUBROUTINE TIOMVB('FILENAME',NBLOCKS,STATUS) MOVE BLOCK
-TIOMVB* LA,U A3,MF$ . MOVE BLOCK FORWARD CODE
- LR,U R1,01 . EOF CODE IN R1
- J ARG3 .
- .
- . SUBROUTINE TIOMVF('FILENAME',NFILES,STATUS) MOVE FILE
-TIOMVF* LA,U A3,FSF$ . MOVE FILE FORWARD CODE
- LR,U R1,1943 . NOTHING FUNNY IN R1
-ARG3 LA,U A2,IOPKT . ADDR(IOPKT)
- LA A1,1,A0 .
- LA A5,0,A1 . NBLOCKS/NFILES
- JZ A5,0,X11 . RETURN IF ZERO
- JP A5,$+2 .
- AA,U A3,1 . BACKWARDS MOVE
- SA,S2 A3,3,A2 . STORE I/O CODE
- LMA A5,A5 .
- ANA,U A5,1 .
- LR R2,A5 . LOOP COUNT
- LMJ A1,FILENAME . FILENAME HANDLER
- LA A1,R1 .
- LA A0,A2 . SET UP I/O
-LOOP3 ER IOW$ . MAKE I/O
- TE,S1 A1,3,A2 . EOF FOR MOVE BLOCK ?
- JGD R2,LOOP3 . END OF LOOP
- LNA,S1 A4,3,A2 . GET STATUS
- LA A0,2,A3 . ADDR(STATUS)
- JNZ A4,$+2 .
- SZ A4 .
- SA A4,0,A0 . STORE STATUS
- J 0,X11 . RETURN FROM 3-ARG ENTRIES
- .
- . SUBROUTINE TIOGW('FILENAME',ACCESSWDS,NWORDS,STATUS) GATHER WRITE TAPE
-TIOGW* LA,U A3,GW$ . GATHER WRITE CODE
- SZ R1 .
- J ARG4 .
- .
- . SUBROUTINE TIOW('FILENAME',BUFFERADR,NWORDS,STATUS) WRITE TAPE
-TIOW* LA,U A3,W$ . WRITE CODE
- SZ R1 .
- J ARG4 .
- .
- . SUBROUTINE TIOSCR('FILENAME',ACCESSWDS,NWORDS,STATUS,AFC) SCATTER READ
-TIOSCR* LA,U A3,SCR$ . SCATTER READ CODE
- LR,U R1,1 .
- J ARG4 .
- .
- . SUBROUTINE TIOR('FILENAME',BUFFERADR,NWORDS,STATUS,AFC) READ TAPE
-TIOR* LA,U A3,R$ . READ CODE
- LR,U R1,1 .
-ARG4 LA,U A2,IOPKT . A2=ADDR(IOPKT)
- SA,S2 A3,3,A2 . STORE I/O CODE ON PACKET
- LMJ A1,FILENAME . FILENAME HANDLER
- LA A1,1,A3 . BUFFER ADDRESS
- SA,H2 A1,4,A2 .
- LA A1,2,A3 .
- LA A0,0,A1 . # OF WORDS TO TRANSFER
- SA,H1 A0,4,A2 .
- LA A0,A2 . SET UP I/O
- ER IOW$ .
- LA A5,R1 .
- LNA,S1 A4,3,A2 . GET STATUS
- JNZ A5,READ . READ ?
- JNZ A4,$+2 . OK ?
- LA,H2 A4,3,A2 . YES, STATUS=(# OF WORDS)
- LA A1,3,A3 .
- SA A4,0,A1 . STORE STATUS
- J 0,X11 . RETURN FROM WRITE
-READ AU,U A4,04 .
- JZ A5,AFC . ABNORMAL FRAME COUNT ?
- LA A1,4,A3 .
- SZ 0,A1 . SET AFC=0
- JNZ A4,$+2 . OK ?
- LA,H2 A4,3,A2 . YES, STATUS=(# OF WORDS)
- LA A1,3,A3 .
- SA A4,0,A1 . STORE STATUS
- SZ 3,A2 .
- J 0,X11 . RETURN FROM READ, AFC=0
-AFC LA,H2 A4,3,A2 . AFC.NE.0
- LA A1,3,A3 .
- SA A4,0,A1 . STORE STATUS
- LA,S3 A4,3,A2 . GET AFC
- LA A1,4,A3 .
- SA A4,0,A1 . STORE AFC
- SZ 3,A2 .
- J 0,X11 . RETURN FROM READ, AFC.NE.0
- .
- . HANDLER FOR FILENAME.
- . ASSUMES A2=ADDR(IOPKT), SAVES A0 IN A3 AND STORES FILENAME ON PACKET
- . INTERFACES BY LMJ A1,FILENAME
- .
-FILENAME LA A3,A0 . SAVE A0 IN A3
- LA A0,0,A0 .
- SFS 1,A2 . SET BLANKS IN 2ND HALF OF FILENAME
- DL A4,0,A0 .
- SA A4,0,A2 . FILENAME, FIRST WORD
- LA,S6 A4,0,A2 . CHECK FOR BLANK IN 6TH CHARACTER
- TNE,U A4,05 .
- J CONT .
- LA A4,A5 .
- SSL A4,30 . CHECK IF 7TH CHARACTER BLANK
- TE,U A4,05 .
- SA A5,1,A2 . NO, STORE FILENAME SECOND WORD
-CONT J 0,A1 . RETURN TO CALLER
- END .
-#endif
diff --git a/src/packlib/epio/tests/Imakefile b/src/packlib/epio/tests/Imakefile
deleted file mode 100644
index 8bdd713..0000000
--- a/src/packlib/epio/tests/Imakefile
+++ /dev/null
@@ -1,10 +0,0 @@
-
-#define IHaveSubdirs
-#define PassCDebugFlags
-
-SUBDIRS= ptest1 ptest2 ptest3
-
-MakeSubdirs($(SUBDIRS))
-
-TestSubdirs($(SUBDIRS))
-
diff --git a/src/packlib/epio/tests/ptest1/Imakefile b/src/packlib/epio/tests/ptest1/Imakefile
deleted file mode 100644
index bcf2f33..0000000
--- a/src/packlib/epio/tests/ptest1/Imakefile
+++ /dev/null
@@ -1,20 +0,0 @@
-SRCS_F= main.F test2.F errex.F rwr123.F test1.F wr11.F
-
-/* Handle Objects ourselves */
-OBJS_CO= errex.o rwr123.o test1.o wr11.o
-OBJS_16= main.o test2.o
-OBJS_32= main_32.o test2_32.o
-
-
-SpecialFortranObjectRule(main_32,main,NullParameter,-DCERNLIB_PH32BIT)
-SpecialFortranObjectRule(test2_32,test2,NullParameter,-DCERNLIB_PH32BIT)
-
-DefinePackageLibrary(NullParameter)
-
-CernlibFortranProgramTarget(ptest1_16,$(OBJS_16) $(OBJS_CO),$(PACKAGE_LIB),$(PACKAGE_LIB),kernlib)
-
-CernlibFortranProgramTarget(ptest1_32,$(OBJS_32) $(OBJS_CO),$(PACKAGE_LIB),$(PACKAGE_LIB),kernlib)
-
-TestTarget(ptest1_32,NullParameter,NullParameter)
-
-TestTarget(ptest1_16,NullParameter,NullParameter)
diff --git a/src/packlib/epio/tests/ptest1/errex.F b/src/packlib/epio/tests/ptest1/errex.F
deleted file mode 100644
index e6377d6..0000000
--- a/src/packlib/epio/tests/ptest1/errex.F
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: errex.F,v 1.1.1.1 1996/03/08 15:21:44 mclareni Exp $
-*
-* $Log: errex.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:44 mclareni
-* Epio
-*
-*
-#include "pilot.h"
- SUBROUTINE ERREX(N)
-C--- ALL ERROR EXITS
-#include "testc.inc"
- PRINT 3001,N,NREC,IERR,NH,NPASS,ILWORD,ISPAN,IPAD,
- 1 JREC,JWORD,ICALL
- STOP
-#if !defined(CERNLIB_CDC)
-3001 FORMAT(/,' + + + + + ERROR CONDITION + + + + +',//,
- 1' N NREC IERR NH NPASS',
- 2' ILWORD ISPAN IPAD JREC JWORD',/,
- 3 1X,10I10,//,
- 4' ICALL',/,
- 5 1X,10I10)
-#endif
-#if defined(CERNLIB_CDC)
-3001 FORMAT(/," + + + + + ERROR CONDITION + + + + +",//,
- 1" N NREC IERR NH NPASS",
- 2" ILWORD ISPAN IPAD JREC JWORD",/,
- 3 1X,10I10,//,
- 4" ICALL",/,
- 5 1X,10I10)
-#endif
- END
diff --git a/src/packlib/epio/tests/ptest1/main.F b/src/packlib/epio/tests/ptest1/main.F
deleted file mode 100644
index 75a0243..0000000
--- a/src/packlib/epio/tests/ptest1/main.F
+++ /dev/null
@@ -1,107 +0,0 @@
-*
-* $Id: main.F,v 1.1.1.1 1996/03/08 15:21:44 mclareni Exp $
-*
-* $Log: main.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:44 mclareni
-* Epio
-*
-*
-#include "pilot.h"
-#if defined(CERNLIB_CDC)
- PROGRAM PTEST(OUTPUT,TAPE11,TAPE12,TAPE13)
-#endif
-#include "testc.inc"
-C--- RESET DEBUG FLAG
- DBUGFL=.FALSE.
-C--- NWOUT = NO. OF WORDS / RECORD
- NWOUT=500
-C--- NREC = NO. OF IDENTICAL RECORDS WRITTEN EACH TIME
- NREC=3
- NH=9
- PRINT 2001
- CALL EPINIT
-#if defined(CERNLIB_IBM)
- CALL VMCMS(
- -'FILEDEF IOFILE11 DISK EPIOT1 DATA A (RECFM U BLOCK 3600',IVMERR)
- CALL VMCMS(
- -'FILEDEF IOFILE12 DISK EPIOT2 DATA A (RECFM U BLOCK 3600',IVMERR)
- CALL VMCMS(
- -'FILEDEF IOFILE13 DISK EPIOT3 DATA A (RECFM U BLOCK 3600',IVMERR)
-#endif
-#if (!defined(CERNLIB_VAXLONG))&&(!defined(CERNLIB_STRA))&&(!defined(CERNLIB_UNIX))
-C--- WRITE WRONG BLOCK, REWIND + TEST
- CALL TEST1
- PRINT 2003
-#endif
-#if defined(CERNLIB_IBM)
- CALL VMCMS('ERASE EPIOT1 DATA A',IVMERR)
-#endif
-C--- DEFINE HEADER
- DO 1 I=1,NH
- 1 IH(I)=100+I
-C--- WRITE TEST DATA ONTO UNIT 11
- NPASS=1
-#if defined(CERNLIB_VAXLONG)
- CALL EPSETW(11,1,NVAXLONG*2,IERR)
-* TEST 32 BIT PHYSICAL HEADERS
-#endif
-#if defined(CERNLIB_PH32BIT)
- CALL EPSETW(11,29,1,IERR)
-#endif
-* TEST standard fortran random access
-#if defined(CERNLIB_STRA)
- CALL EPSETW(11,33,1,IERR)
- CALL EPSETW(12,33,1,IERR)
- CALL EPSETW(13,33,1,IERR)
-#endif
- CALL WR11
- PRINT 2004,NPASS
- NPASS=2
-C--- SET NEW BLOCK SIZE
-* Restrict to fixed length for Unix
-#if (!defined(CERNLIB_STF77))&&(!defined(CERNLIB_STF77VX))
- CALL EPSETW(11,1,1440,IERR)
- IF(IERR.NE.0) CALL ERREX(1)
-#endif
-C--- WRITE AGAIN
- CALL WR11
- PRINT 2004,NPASS
-C--- RESET BLOCK SIZE
-#if (!defined(CERNLIB_STF77))&&(!defined(CERNLIB_STF77VX))
- CALL EPSETW(11,1,1800,IERR)
- IF(IERR.NE.0) CALL ERREX(2)
-#endif
- CALL EPRWND(11,IBUF11,IERR)
- IF(IERR.NE.0) CALL ERREX(36)
-C--- READ 11, WRITE 12 + 13
-#if defined(CERNLIB_VAXLONG)
- CALL EPSETW(11,1,NVAXLONG*2,IERR)
-#endif
- CALL RWR123
- N=2*ICALL
- PRINT 2005,N
-C--- REWIND ALL THREE, READ BACK AND CHECK WITH
-C HEADER BUFFER CUT, DATA BUFFER CUT, NORMAL BUFFER
- CALL TEST2
-C--- TERMINATE
- PRINT 3001
- STOP
-#if !defined(CERNLIB_CDC)
-2001 FORMAT('1 ++++++++++ EPTEST1 - START OF EXECUTION ++++++++')
-2003 FORMAT(/,' ROUTINE TEST1 SUCCESSFUL')
-2004 FORMAT(/,' ROUTINE WR11 SUCCESSFUL, PASS =',I5)
-2005 FORMAT(/,' ROUTINE RWR123 SUCCESSFUL - NO. OF REC.S =',I10,//)
-3001 FORMAT(///,1X,10(10H++++++++++),//,
- 1 ' EPTEST1 - NORMAL TERMINATION, ALL TESTS DONE',
- 2 //, 1X,10(10H++++++++++),/////)
-#endif
-#if defined(CERNLIB_CDC)
-2001 FORMAT("1 ++++++++++ EPTEST1 - START OF EXECUTION ++++++++")
-2003 FORMAT(/," ROUTINE TEST1 SUCCESSFUL")
-2004 FORMAT(/," ROUTINE WR11 SUCCESSFUL, PASS =",I5)
-2005 FORMAT(/," ROUTINE RWR123 SUCCESSFUL - NO. OF REC.S =",I10,//)
-3001 FORMAT(///,1X,10(10H++++++++++),//,
- 1 " EPTEST1 - NORMAL TERMINATION, ALL TESTS DONE",
- 2 //, 1X,10(10H++++++++++),/////)
-#endif
- END
diff --git a/src/packlib/epio/tests/ptest1/pilot.h b/src/packlib/epio/tests/ptest1/pilot.h
deleted file mode 100644
index ab27465..0000000
--- a/src/packlib/epio/tests/ptest1/pilot.h
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: pilot.h,v 1.1.1.1 1996/03/08 15:21:45 mclareni Exp $
-*
-* $Log: pilot.h,v $
-* Revision 1.1.1.1 1996/03/08 15:21:45 mclareni
-* Epio
-*
-*
-#if defined(CERNLIB_VAXVMS)||defined(CERNLIB_VAXULX)
-#ifndef CERNLIB_VAX
-#define CERNLIB_VAX
-#endif
-#endif
-#if (defined(CERNLIB_UNIX))&&(!defined(CERNLIB_DECS))
-#ifndef CERNLIB_STF77
-#define CERNLIB_STF77
-#endif
-#endif
-#if defined(CERNLIB_DECS)
-#ifndef CERNLIB_STF77VX
-#define CERNLIB_STF77VX
-#endif
-#endif
diff --git a/src/packlib/epio/tests/ptest1/rwr123.F b/src/packlib/epio/tests/ptest1/rwr123.F
deleted file mode 100644
index f7639d9..0000000
--- a/src/packlib/epio/tests/ptest1/rwr123.F
+++ /dev/null
@@ -1,82 +0,0 @@
-*
-* $Id: rwr123.F,v 1.1.1.1 1996/03/08 15:21:44 mclareni Exp $
-*
-* $Log: rwr123.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:44 mclareni
-* Epio
-*
-*
-#include "pilot.h"
- SUBROUTINE RWR123
-C--- READS + CHECKS 11, WRITES 12+13
-#include "testc.inc"
- DIMENSION IADDH(10)
- CALL UZERO(IADDH,1,10)
- CALL EPADDH(13,10,IADDH,IBUF13,IERR)
- IF(IERR.NE.0) CALL ERREX(101)
- DO 1 ITIMES=1,2
- ICALL=0
-#if defined(CERNLIB_ND100B16)||defined(CERNLIB_ND100B32)
- DO 10 ILWORD=16,16,16
-#endif
-#if (!defined(CERNLIB_ND100B16))&&(!defined(CERNLIB_ND100B32))
- DO 10 ILWORD=16,32,16
-#endif
- CALL EPSETW(12,3,ILWORD,IERR)
- IF(IERR.NE.0) CALL ERREX(25)
- CALL EPSETW(13,3,ILWORD,IERR)
- IF(IERR.NE.0) CALL ERREX(26)
- DO 11 ISPAN=1,2
- DO 12 IPAD=1,3
-#if defined(CERNLIB_ND100B16)||defined(CERNLIB_ND100B32)||defined(CERNLIB_STF77)||defined(CERNLIB_STF77VX)
- CALL EPSETW(12,8,10*(ISPAN-1)+ 1 ,IERR)
-#endif
-#if (!defined(CERNLIB_ND100B16))&&(!defined(CERNLIB_ND100B32))&&(!defined(CERNLIB_STF77))&&(!defined(CERNLIB_STF77VX))
- CALL EPSETW(12,8,10*(ISPAN-1)+IPAD,IERR)
-#endif
- IF(IERR.NE.0) CALL ERREX(27)
-#if defined(CERNLIB_ND100B16)||defined(CERNLIB_ND100B32)||defined(CERNLIB_STF77)||defined(CERNLIB_STF77VX)
- CALL EPSETW(13,8,10*(ISPAN-1)+ 1 ,IERR)
-#endif
-#if (!defined(CERNLIB_ND100B16))&&(!defined(CERNLIB_ND100B32))&&(!defined(CERNLIB_STF77))&&(!defined(CERNLIB_STF77VX))
- CALL EPSETW(13,8,10*(ISPAN-1)+IPAD,IERR)
-#endif
- IF(IERR.NE.0) CALL ERREX(28)
- DO 13 MODE=1,3
- N=NWOUT
- IF(MODE.EQ.1.AND.ILWORD.EQ.16) N=2*NWOUT
- DO 14 JREC=1,NREC
- CALL EPREAD(11,MODE,NWR,IPAC,IBUF11,IERR)
- IF(IERR.NE.0) CALL ERREX(29)
- ICALL=ICALL+1
- CALL VFILL(IADDH,10,ICALL)
- IF(ICALL.EQ.1) CALL EPADDH(11,10,IH,IBUF11,IERR)
- IF(ICALL.EQ.1.AND.IERR.NE.17) CALL ERREX(13)
- IF(MODE.EQ.1) CALL BLO32W(IPAC,1,IDAT,1,NWOUT)
- IF(MODE.NE.1) CALL UCOPY(IPAC,IDAT,NWOUT)
- DO 15 JWORD=1,NWOUT
- IF(IDAT(JWORD).NE.ICALL) CALL ERREX(30)
- 15 CONTINUE
- CALL EPOUTL(12,MODE,NH,IH,N,IPAC,IBUF12,IERR)
- IF(IERR.NE.0) CALL ERREX(31)
- CALL EPUPDH(13,20,IADDH,IBUF13,IERR)
- IF(IERR.NE.0) CALL ERREX(102)
- CALL EPOUTS(13,MODE,N,IPAC,IBUF13,IERR)
- IF(IERR.NE.0) CALL ERREX(32)
- 14 CONTINUE
- 13 CONTINUE
- 12 CONTINUE
- 11 CONTINUE
- CALL EPCLOS(12,IBUF12,IERR)
- CALL EPCLOS(13,IBUF13,IERR)
- 10 CONTINUE
- CALL EPSTAT
- 1 CONTINUE
- CALL EPRWND(11,IBUF11,IERR)
- IF(IERR.NE.0) CALL ERREX(33)
- CALL EPRWND(12,IBUF12,IERR)
- IF(IERR.NE.0) CALL ERREX(34)
- CALL EPRWND(13,IBUF13,IERR)
- IF(IERR.NE.0) CALL ERREX(35)
- RETURN
- END
diff --git a/src/packlib/epio/tests/ptest1/test1.F b/src/packlib/epio/tests/ptest1/test1.F
deleted file mode 100644
index 7026f5f..0000000
--- a/src/packlib/epio/tests/ptest1/test1.F
+++ /dev/null
@@ -1,149 +0,0 @@
-*
-* $Id: test1.F,v 1.1.1.1 1996/03/08 15:21:44 mclareni Exp $
-*
-* $Log: test1.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:44 mclareni
-* Epio
-*
-*
-#include "pilot.h"
- SUBROUTINE TEST1
-C--- WRITE A WRONG BLOCK, READ AND CHECK ERRORS
-#include "testc.inc"
-#if defined(CERNLIB_UNIVAC)
- DIMENSION NACC(2)
- DATA IUN11/'11 'F/,IEOF/'EOFM'/,IEP/'EP '/
-#endif
-#if defined(CERNLIB_APOLLO)
-%INCLUDE '/sys/ins/base.ins.ftn'
-%INCLUDE '/sys/ins/error.ins.ftn'
-%INCLUDE '/sys/ins/streams.ins.ftn'
- INTEGER*4 STATUS_$RETURNED
- INTEGER*2 ATT_$REC(39)
- CHARACTER*10 FILNAM
- DATA FILNAM/'FOR011.DAT'/
- DATA (ATT_$REC(J),J=35,39)/'FO','R0','11','.D','AT'/
- DATA ATT_$REC(2)/10/
-#endif
- NPW=12345
- N16=360
- CALL VFILL(IDAT,N16,NPW)
- CALL BUN16W(IDAT,1,IPAC,1,N16)
-C--- NO. OF BITS
- CALL EPGETC(N,IDAT)
- NBIT=IDAT(4)
- NW=(N16*16)/NBIT
-#if defined(CERNLIB_CDC)||defined(CERNLIB_CRAY)
- BUFFER OUT (11,1) (IPAC(1),IPAC(NW))
- IF(UNIT(11).GT.0.) STOP 10
- REWIND 11
-#endif
-#if defined(CERNLIB_IBM)||defined(CERNLIB_NORD)
- CALL IORITE(11,IPAC,4*NW,IRET)
- IF(IRET.NE.0) CALL ERREX(16)
- CALL IOMARK(11,IRET)
- IF(IRET.NE.0) CALL ERREX(99)
- CALL IORWND(11,IRET)
- IF(IRET.NE.0) CALL ERREX(17)
-#endif
-#if defined(CERNLIB_UNIVAC)
- IOD=IODEV('11 ')
- IF(IOD.GE.16) THEN
- BITS(IEP,19,18)=NW
- NACC(1)=2**18+LOC(IEP)
- NACC(2)=NW*2**18+LOC(IPAC)
- CALL FIOGW(IUN11,NACC,2,0,ISTAT)
- IAD=(NW+28)/28
- CALL FIOW(IUN11,IEOF,1,IAD,ISTAT)
- ELSE
- CALL FIOW(IUN11,IPAC,NW,0,ISTAT)
- CALL TIOWEF(IUN11,ISTAT)
- CALL TIOREW(IUN11,ISTAT)
- ENDIF
-#endif
-#if defined(CERNLIB_VAX)
- OPEN(11,NAME='FOR011',TYPE='NEW',FORM='UNFORMATTED',
- 1 RECORDTYPE='FIXED',RECL=900,BLOCKSIZE=3600)
- WRITE(11) (IPAC(I),I=1,NW)
- CLOSE(11)
-#endif
-#if defined(CERNLIB_APOLLO)
- OPEN(
- 1 UNIT=11,
- 2 FILE='FOR011.DAT',
- 3 FORM='UNFORMATTED',
-#endif
-#if (defined(CERNLIB_APOLLO))&&(defined(CERNLIB_APOMAG))
- 4 STATUS='WRITE')
-#endif
-#if (defined(CERNLIB_APOLLO))&&(!defined(CERNLIB_APOMAG))
- 4 STATUS='NEW',
- 5 RECL=900)
-#endif
-#if defined(CERNLIB_APOLLO)
- WRITE(11) (IPAC(I),I=1,NW)
- CLOSE(11)
-#endif
-#if defined(CERNLIB_STF77)||defined(CERNLIB_STF77VX)
-C For Unix use Fortran open in EPOPEN to avoid portability problems
-C and set same blocksize for epread.
- CALL EPSETW(11,1,N16,IERR)
- CALL EPOPEN(1,IERR)
- WRITE(11) (IPAC(I),I=1,NW)
- CLOSE(11)
-#endif
-#if defined(CERNLIB_VAXMAG)
- CALL EPREAD(11,1,NW,IDAT,IBUF11,IERR)
- CALL EPMTREW(IERR)
-#endif
- CALL EPREAD(11,1,NW,IDAT,IBUF11,IERR)
- IF(IERR.NE.4.AND.IERR.NE.5) CALL ERREX(18)
- CALL EPREAD(11,1,NW,IDAT,IBUF11,IERR)
- IF(IERR.NE.1) CALL ERREX(19)
- CALL EPRWND(11,IBUF11,IERR)
- IF(IERR.NE.0) CALL ERREX(20)
-#if (defined(CERNLIB_VAX))&&(!defined(CERNLIB_VAXMAG))
- CLOSE (11)
-#endif
-#if defined(CERNLIB_STF77VX)
- CLOSE (11)
-#endif
-#if defined(CERNLIB_STF77)
- CLOSE (11,STATUS='DELETE')
-#endif
-#if (defined(CERNLIB_APOLLO))&&(!defined(CERNLIB_APOMAG))
-C
-C FOR THE APOLLO THE STORY IS DIFFERENT. WE NEED TO CLOSE
-C THE STREAM ASSOCIATED WITH 'FOR011', AND THEN TO DELETE
-C THE FILE.
-C
- CALL STREAM_$INQUIRE(
- 1 STREAM_$IRM_STRID,
- 2 STREAM_$NAME_UNCONDITIONAL,
- 3 ATT_$REC,
- 4 ERROR_$MASK,
- 6 STATUS_$RETURNED)
- IF(STATUS_$RETURNED.NE.STATUS_$OK)
- 1 CALL PFM_$SIGNAL(STATUS_$RETURNED)
-C
-C THE FILE IS THERE
-C
- CALL STREAM_$CLOSE(ATT_$REC,STATUS_$RETURNED)
- IF(STATUS_$RETURNED.NE.STATUS_$OK)
- 1 CALL PFM_$SIGNAL(STATUS_$RETURNED)
-C
-C THE STREAM HAS BEEN CLOSED
-C
- CALL NAME_$DELETE_FILE(FILNAM,INT2(10),STATUS_$RETURNED)
- IF(STATUS_$RETURNED.NE.STATUS_$OK)
- 1 CALL PFM_$SIGNAL(STATUS_$RETURNED)
-C
-C THE FILE HAS BEEN DELETED
-C
-#endif
-#if defined(CERNLIB_STF77)||defined(CERNLIB_STF77VX)
-C Reset the blocksize for the main tests.
- CALL EPSETW(11,1,1800,IERR)
-#endif
- RETURN
- END
diff --git a/src/packlib/epio/tests/ptest1/test2.F b/src/packlib/epio/tests/ptest1/test2.F
deleted file mode 100644
index e21fb41..0000000
--- a/src/packlib/epio/tests/ptest1/test2.F
+++ /dev/null
@@ -1,120 +0,0 @@
-*
-* $Id: test2.F,v 1.1.1.1 1996/03/08 15:21:44 mclareni Exp $
-*
-* $Log: test2.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:44 mclareni
-* Epio
-*
-*
-#include "pilot.h"
- SUBROUTINE TEST2
-C--- READS AND CHECKS 11, 12, 13,
-C--- 11 WITH TOO SHORT BUFFER FOR P.H. AND L.H.,
-C--- 12 WITH TOO SHORT DATA BUFFER
-#include "testc.inc"
- NCUTH=8
- NCUTD=100
- DO 101 I=1,10
- CALL EPREAD(11,30,NWR,IPAC,IBUF11,IERR)
- IF(IERR.NE.0) CALL ERREX(39)
-#if defined(CERNLIB_PH32BIT)
- IF(2*NWR.NE.IPAC(12)) CALL ERREX(40)
-#endif
-#if !defined(CERNLIB_PH32BIT)
- IF(NWR.NE.IPAC(12)) CALL ERREX(40)
-#endif
- PRINT 2001,NWR,(IPAC(JJ),JJ=1,NWR)
- 101 CONTINUE
- DO 103 I=1,10
- CALL EPREAD(11,20,NWR,IPAC,IBUF11,IERR)
- IF(IERR.NE.0) CALL ERREX(41)
- ICALL=IPAC(8)
- MODE=IPAC(9)
- CALL EPREAD(11,10+MODE,NWR,IPAC,IBUF11,IERR)
- IF(IERR.NE.0) CALL ERREX(42)
- CALL EPGETW(11,3,J,IERR)
- IF(MODE.EQ.1) NWR=(NWR*J)/32
- IF(NWR.NE.NWOUT) CALL ERREX(43)
- IF(MODE.EQ.1) CALL BLO32W(IPAC,1,IDAT,1,NWR)
- IF(MODE.NE.1) CALL UCOPY(IPAC,IDAT,NWR)
- DO 102 JWORD=1,NWR
- IF(IDAT(JWORD).NE.ICALL) CALL ERREX(44)
- 102 CONTINUE
- 103 CONTINUE
- CALL EPSETW(11,26,NCUTH,IERR)
- IF(IERR.NE.0) CALL ERREX(37)
- CALL EPSETW(12,2,NCUTD,IERR)
- IF(IERR.NE.0) CALL ERREX(38)
- DO 104 I=1,10
- CALL EPREAD(11,30,NWR,IPAC,IBUF11,IERR)
- IF(IERR.NE.6) CALL ERREX(45)
- IF(NWR.NE.NCUTH) CALL ERREX(46)
- PRINT 2001,NWR,(IPAC(JJ),JJ=1,NWR)
- 104 CONTINUE
- CALL EPRWND(11,IBUF11,IERR)
- IF(IERR.NE.0) CALL ERREX(47)
- ICALL2=0
- DO 1 ITIMES=1,2
- ICALL=0
-#if defined(CERNLIB_ND100B16)||defined(CERNLIB_ND100B32)
- DO 10 ILWORD=16,16,16
-#endif
-#if (!defined(CERNLIB_ND100B16))&&(!defined(CERNLIB_ND100B32))
- DO 10 ILWORD=16,32,16
-#endif
- DO 11 ISPAN=1,2
- DO 12 IPAD=1,3
- DO 13 MODE=1,3
- DO 14 JREC=1,NREC
- CALL EPSETW(11,26,NCUTH,IERR)
- CALL EPREAD(11,20,NWR,IPAC,IBUF11,IERR)
- ICALL=ICALL+1
- ICALL2=ICALL2+1
- IF(IERR.NE.6) CALL ERREX(48)
- IF(IPAC(4).NE.ICALL2) CALL ERREX(49)
- CALL EPSETW(11,2,9999,IERR)
- CALL EPREAD(11,10+MODE,NWR,IPAC,IBUF11,IERR)
- IF(IERR.NE.0) CALL ERREX(50)
- IF(DBUGFL) CALL EPSTAT
- CALL EPGETW(11,3,J,IERR)
- IF(MODE.EQ.1) NWR=(NWR*J)/32
- IF(NWR.NE.NWOUT) CALL ERREX(51)
- IF(MODE.EQ.1) CALL BLO32W(IPAC,1,IDAT,1,NWOUT)
- IF(MODE.NE.1) CALL UCOPY(IPAC,IDAT,NWOUT)
- DO 15 JWORD=1,NWOUT
- IF(IDAT(JWORD).NE.ICALL) CALL ERREX(58)
- 15 CONTINUE
- CALL EPREAD(12,MODE,NWR,IPAC,IBUF12,IERR)
- IF(IERR.NE.6) CALL ERREX(52)
- CALL EPGETW(12,3,J,IERR)
- IF(MODE.EQ.1) NWR=(NWR*J)/32
- IF(MODE.EQ.1) CALL BLO32W(IPAC,1,IDAT,1,NWR)
- IF(MODE.NE.1) CALL UCOPY(IPAC,IDAT,NWR)
- DO 17 JWORD=1,NWR
- IF(IDAT(JWORD).NE.ICALL) CALL ERREX(54)
- 17 CONTINUE
- CALL EPREAD(13,MODE,NWR,IPAC,IBUF13,IERR)
- IF(IERR.NE.0) CALL ERREX(55)
- CALL EPGETW(13,3,J,IERR)
- IF(MODE.EQ.1) NWR=(NWR*J)/32
- IF(NWR.NE.NWOUT) CALL ERREX(56)
- IF(MODE.EQ.1) CALL BLO32W(IPAC,1,IDAT,1,NWR)
- IF(MODE.NE.1) CALL UCOPY(IPAC,IDAT,NWR)
- DO 18 JWORD=1,NWR
- IF(IDAT(JWORD).NE.ICALL) CALL ERREX(57)
- 18 CONTINUE
- 14 CONTINUE
- 13 CONTINUE
- 12 CONTINUE
- 11 CONTINUE
- 10 CONTINUE
- CALL EPSTAT
- 1 CONTINUE
- RETURN
-#if !defined(CERNLIB_CDC)
-2001 FORMAT(' HEADER, NW AND CONTENTS =',7I7,2I12,4I7)
-#endif
-#if defined(CERNLIB_CDC)
-2001 FORMAT(" HEADER, NW AND CONTENTS =",7I7,2I12,4I7)
-#endif
- END
diff --git a/src/packlib/epio/tests/ptest1/testc.inc b/src/packlib/epio/tests/ptest1/testc.inc
deleted file mode 100644
index d1fc6e9..0000000
--- a/src/packlib/epio/tests/ptest1/testc.inc
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: testc.inc,v 1.1.1.1 1996/03/08 15:21:44 mclareni Exp $
-*
-* $Log: testc.inc,v $
-* Revision 1.1.1.1 1996/03/08 15:21:44 mclareni
-* Epio
-*
-*
-*
-* testc.inc
-*
-#if (!defined(CERNLIB_VAXLONG))&&(!defined(CERNLIB_ND100B16))
- COMMON//NWOUT,NREC,IERR,NH,NPASS,ILWORD,ISPAN,IPAD,JREC,
- 1 NBIT,ICALL,JWORD,IBUF11(1000),IBUF12(1000),IBUF13(1000),
- 2 IDAT(500),IPAC(500),IH(10)
- COMMON/EPDBGC/DBUGFL
- LOGICAL DBUGFL
-#endif
-#if defined(CERNLIB_ND100B16)
- COMMON//NWOUT,NREC,IERR,NH,NPASS,ILWORD,ISPAN,IPAD,JREC,
- 1 NBIT,ICALL,JWORD,IBUF11(2000),IBUF12(2000),IBUF13(2000),
- 2 IDAT(1000),IPAC(1000),IH(20)
- COMMON/EPDBGC/DBUGFL
- LOGICAL DBUGFL
-#endif
-#if defined(CERNLIB_VAXLONG)
- PARAMETER (NVAXLONG = 3060)
- COMMON//NWOUT,NREC,IERR,NH,NPASS,ILWORD,ISPAN,IPAD,JREC,
- 1 NBIT,ICALL,JWORD,IBUF11(NVAXLONG),IBUF12(1000),IBUF13(1000),
- 2 IDAT(500),IPAC(500),IH(10)
- COMMON/EPDBGC/DBUGFL
- LOGICAL DBUGFL
-#endif
diff --git a/src/packlib/epio/tests/ptest1/wr11.F b/src/packlib/epio/tests/ptest1/wr11.F
deleted file mode 100644
index 0c5538c..0000000
--- a/src/packlib/epio/tests/ptest1/wr11.F
+++ /dev/null
@@ -1,56 +0,0 @@
-*
-* $Id: wr11.F,v 1.1.1.1 1996/03/08 15:21:45 mclareni Exp $
-*
-* $Log: wr11.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:45 mclareni
-* Epio
-*
-*
-#include "pilot.h"
- SUBROUTINE WR11
-C--- WRITES TEST DATA
-#include "testc.inc"
- ICALL=0
- LUNIT=11
- CALL EPSTAT
-#if defined(CERNLIB_ND100B16)||defined(CERNLIB_ND100B32)
- DO 10 ILWORD=16,16,16
-#endif
-#if (!defined(CERNLIB_ND100B16))&&(!defined(CERNLIB_ND100B32))
- DO 10 ILWORD=16,32,16
-#endif
- CALL EPSETW(LUNIT,3,ILWORD,IERR)
- IF(IERR.NE.0) CALL ERREX(21)
- DO 11 ISPAN=1,2
- DO 12 IPAD=1,3
-#if defined(CERNLIB_ND100B16)||defined(CERNLIB_ND100B32)||defined(CERNLIB_STF77)||defined(CERNLIB_STF77VX)
- CALL EPSETW(LUNIT,8,10*(ISPAN-1)+ 1 ,IERR)
-#endif
-#if (!defined(CERNLIB_ND100B16))&&(!defined(CERNLIB_ND100B32))&&(!defined(CERNLIB_STF77))&&(!defined(CERNLIB_STF77VX))
- CALL EPSETW(LUNIT,8,10*(ISPAN-1)+IPAD,IERR)
-#endif
- IF(IERR.NE.0) CALL ERREX(22)
- DO 13 MODE=1,3
- N=NWOUT
- IF(MODE.EQ.1.AND.ILWORD.EQ.16) N=2*NWOUT
- DO 14 JREC=1,NREC
- IH(9)=MODE
- ICALL=ICALL+1
- IH(8)=ICALL
- CALL VFILL(IDAT,NWOUT,ICALL)
- IF(MODE.EQ.1) CALL BUN32W(IDAT,1,IPAC,1,NWOUT)
- IF(MODE.NE.1) CALL UCOPY(IDAT,IPAC,NWOUT)
- CALL EPOUTL(LUNIT,MODE,NH,IH,N,IPAC,IBUF11,IERR)
- IF(IERR.NE.0) CALL ERREX(23)
- 14 CONTINUE
- 13 CONTINUE
- CALL EPCLOS(LUNIT,IBUF11,IERR)
- IF(IERR.NE.0) CALL ERREX(24)
- 12 CONTINUE
- 11 CONTINUE
- 10 CONTINUE
-C--- DUMMY CALL FOR TEST
- CALL EPCLOS(LUNIT,IBUF11,IERR)
- CALL EPSTAT
- RETURN
- END
diff --git a/src/packlib/epio/tests/ptest2/Imakefile b/src/packlib/epio/tests/ptest2/Imakefile
deleted file mode 100644
index 8285697..0000000
--- a/src/packlib/epio/tests/ptest2/Imakefile
+++ /dev/null
@@ -1,21 +0,0 @@
-SRCS_F= errex.F main.F rwr123.F test2.F wr11.F
-
-/* Handle Objects ourselves */
-OBJS_CO= errex.o rwr123.o wr11.o
-OBJS_16= main.o test2.o
-OBJS_32= main_32.o test2_32.o
-
-DefinePackageLibrary(NullParameter)
-
-SpecialFortranObjectRule(main_32,main,NullParameter,-DCERNLIB_PH32BIT)
-SpecialFortranObjectRule(test2_32,test2,NullParameter,-DCERNLIB_PH32BIT)
-
-CernlibFortranProgramTarget(ptest2_16,$(OBJS_16) $(OBJS_CO),$(PACKAGE_LIB),$(PACKAGE_LIB),kernlib)
-
-CernlibFortranProgramTarget(ptest2_32,$(OBJS_32) $(OBJS_CO),$(PACKAGE_LIB),$(PACKAGE_LIB),kernlib)
-
-TestTarget(ptest2_32,NullParameter,NullParameter)
-
-TestTarget(ptest2_16,NullParameter,NullParameter)
-
-
diff --git a/src/packlib/epio/tests/ptest2/errex.F b/src/packlib/epio/tests/ptest2/errex.F
deleted file mode 100644
index 81f55de..0000000
--- a/src/packlib/epio/tests/ptest2/errex.F
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: errex.F,v 1.1.1.1 1996/03/08 15:21:45 mclareni Exp $
-*
-* $Log: errex.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:45 mclareni
-* Epio
-*
-*
-#if !defined(CERNLIB_ND100B16)
-#include "pilot.h"
- SUBROUTINE ERREX(N)
-C--- ALL ERROR EXITS
-#include "testc.inc"
- PRINT 3001,N,NREC,IERR,NH,NPASS,ILWORD,ISPAN,IPAD,
- 1 JREC,JWORD,ICALL,NWR
- STOP
-#if !defined(CERNLIB_CDC)
-3001 FORMAT(/,' + + + + + ERROR CONDITION + + + + +',//,
- 1' N NREC IERR NH NPASS',
- 2' ILWORD ISPAN IPAD JREC JWORD',/,
- 3 1X,10I10,//,
- 4' ICALL NWR',/,
- 5 1X,10I10)
-#endif
-#if defined(CERNLIB_CDC)
-3001 FORMAT(/," + + + + + ERROR CONDITION + + + + +",//,
- 1" N NREC IERR NH NPASS",
- 2" ILWORD ISPAN IPAD JREC JWORD",/,
- 3 1X,10I10,//,
- 4" ICALL NWR",/,
- 5 1X,10I10)
-#endif
- END
-#endif
diff --git a/src/packlib/epio/tests/ptest2/main.F b/src/packlib/epio/tests/ptest2/main.F
deleted file mode 100644
index e423db9..0000000
--- a/src/packlib/epio/tests/ptest2/main.F
+++ /dev/null
@@ -1,83 +0,0 @@
-*
-* $Id: main.F,v 1.1.1.1 1996/03/08 15:21:45 mclareni Exp $
-*
-* $Log: main.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:45 mclareni
-* Epio
-*
-*
-#if !defined(CERNLIB_ND100B16)
-#include "pilot.h"
-#if defined(CERNLIB_CDC)
- PROGRAM PTEST(OUTPUT,TAPE11,TAPE12,TAPE13)
-#endif
-#include "testc.inc"
- IPADUL=3
-#if defined(CERNLIB_HLESS)
-C--- SUPPRESS UNPADDED HEADERLESS BLOCKS
- IPADUL=2
-#endif
-C--- RESET DEBUG FLAG
- DBUGFL=.FALSE.
-C--- NWOUT = NO. OF WORDS / RECORD
- NWOUT=5000
-C--- NREC = NO. OF IDENTICAL RECORDS WRITTEN EACH TIME
- NREC=1
- NH=9
- PRINT 2001
- CALL EPINIT
-C--- DEFINE HEADER
- DO 1 I=1,NH
- 1 IH(I)=100+I
-C--- WRITE TEST DATA ONTO UNIT 11
- NPASS=1
-* TEST 32 BIT PHYSICAL HEADERS
-#if defined(CERNLIB_PH32BIT)
- CALL EPSETW(11,29,1,IERR)
-#endif
-#if defined(CERNLIB_IBM)
- CALL VMCMS(
- -'FILEDEF IOFILE11 DISK EPIOT1 DATA A (RECFM U BLOCK 3600',IVMERR)
- CALL VMCMS(
- -'FILEDEF IOFILE12 DISK EPIOT2 DATA A (RECFM U BLOCK 3600',IVMERR)
- CALL VMCMS(
- -'FILEDEF IOFILE13 DISK EPIOT3 DATA A (RECFM U BLOCK 3600',IVMERR)
-#endif
- CALL WR11
- PRINT 2004,NPASS
- CALL EPRWND(11,IBUF11,IERR)
- IF(IERR.NE.0) CALL ERREX(36)
-#if (defined(CERNLIB_VAX))&&(defined(CERNLIB_HLESS))
- CLOSE(11)
-#endif
-C--- READ 11, WRITE 12 + 13
- CALL RWR123
-#if (defined(CERNLIB_VAX))&&(defined(CERNLIB_HLESS))
- CLOSE(12)
- CLOSE(13)
-#endif
- PRINT 2005,ICALL
-C--- REWIND ALL THREE, READ BACK AND CHECK WITH
-C HEADER BUFFER CUT, DATA BUFFER CUT, NORMAL BUFFER
- CALL TEST2
-C--- TERMINATE
- PRINT 3001
- STOP
-#if !defined(CERNLIB_CDC)
-2001 FORMAT('1 ++++++++++ EPTEST2 - START OF EXECUTION ++++++++')
-2004 FORMAT(/,' ROUTINE WR11 SUCCESSFUL, PASS =',I5)
-2005 FORMAT(/,' ROUTINE RWR123 SUCCESSFUL - NO. OF REC.S =',I10,//)
-3001 FORMAT(///,1X,10(10H++++++++++),//,
- 1 ' EPTEST2 - NORMAL TERMINATION, ALL TESTS DONE',
- 2 //, 1X,10(10H++++++++++),/////)
-#endif
-#if defined(CERNLIB_CDC)
-2001 FORMAT("1 ++++++++++ EPTEST2 - START OF EXECUTION ++++++++")
-2004 FORMAT(/," ROUTINE WR11 SUCCESSFUL, PASS =",I5)
-2005 FORMAT(/," ROUTINE RWR123 SUCCESSFUL - NO. OF REC.S =",I10,//)
-3001 FORMAT(///,1X,10(10H++++++++++),//,
- 1 " EPTEST2 - NORMAL TERMINATION, ALL TESTS DONE",
- 2 //, 1X,10(10H++++++++++),/////)
-#endif
- END
-#endif
diff --git a/src/packlib/epio/tests/ptest2/pilot.h b/src/packlib/epio/tests/ptest2/pilot.h
deleted file mode 100644
index ab27465..0000000
--- a/src/packlib/epio/tests/ptest2/pilot.h
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: pilot.h,v 1.1.1.1 1996/03/08 15:21:45 mclareni Exp $
-*
-* $Log: pilot.h,v $
-* Revision 1.1.1.1 1996/03/08 15:21:45 mclareni
-* Epio
-*
-*
-#if defined(CERNLIB_VAXVMS)||defined(CERNLIB_VAXULX)
-#ifndef CERNLIB_VAX
-#define CERNLIB_VAX
-#endif
-#endif
-#if (defined(CERNLIB_UNIX))&&(!defined(CERNLIB_DECS))
-#ifndef CERNLIB_STF77
-#define CERNLIB_STF77
-#endif
-#endif
-#if defined(CERNLIB_DECS)
-#ifndef CERNLIB_STF77VX
-#define CERNLIB_STF77VX
-#endif
-#endif
diff --git a/src/packlib/epio/tests/ptest2/rwr123.F b/src/packlib/epio/tests/ptest2/rwr123.F
deleted file mode 100644
index 74ed81b..0000000
--- a/src/packlib/epio/tests/ptest2/rwr123.F
+++ /dev/null
@@ -1,93 +0,0 @@
-*
-* $Id: rwr123.F,v 1.1.1.1 1996/03/08 15:21:45 mclareni Exp $
-*
-* $Log: rwr123.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:45 mclareni
-* Epio
-*
-*
-#if !defined(CERNLIB_ND100B16)
-#include "pilot.h"
- SUBROUTINE RWR123
-C--- READS + CHECKS 11, WRITES 12+13
-#include "testc.inc"
- DO 1 I=1,2
- CALL EPREAD(11,20,NWR,IPAC,IBUF11,IERR)
- IF(IERR.NE.0) CALL ERREX(3)
- IF(IPAC(8).NE.2*I-1) CALL ERREX(4)
- MODE=3-I
- CALL EPREAD(11,MODE,NWR,IPAC,IBUF11,IERR)
- IF(IERR.NE.0) CALL ERREX(5)
- N=NWOUT
- IF(MODE.EQ.1) N=2*NWOUT
- IF(N.NE.NWR) CALL ERREX(6)
- ICALL=2*I
- IF(MODE.EQ.1) CALL BLO32W(IPAC,1,IDAT,1,NWOUT)
- IF(MODE.NE.1) CALL UCOPY(IPAC,IDAT,NWOUT)
- DO 2 JWORD=1,NWOUT
- IF(IDAT(JWORD).NE.ICALL) CALL ERREX(7)
- 2 CONTINUE
- 1 CONTINUE
- CALL EPRWND(11,IBUF11,IERR)
- IF(IERR.NE.0) CALL ERREX(8)
- ICALL=0
- DO 10 ILWORD=16,32,16
- CALL EPSETW(12,3,ILWORD,IERR)
- IF(IERR.NE.0) CALL ERREX(25)
- CALL EPSETW(13,3,ILWORD,IERR)
- IF(IERR.NE.0) CALL ERREX(26)
- DO 11 ISPAN=1,1
- DO 12 IPAD=1,IPADUL
-#if (!defined(CERNLIB_STF77))&&(!defined(CERNLIB_STF77VX))
- CALL EPSETW(12,8,10*(ISPAN-1)+IPAD,IERR)
-#endif
-#if defined(CERNLIB_STF77)||defined(CERNLIB_STF77VX)
- CALL EPSETW(12,8,10*(ISPAN-1)+ 1 ,IERR)
-#endif
- IF(IERR.NE.0) CALL ERREX(27)
-#if (!defined(CERNLIB_STF77))&&(!defined(CERNLIB_STF77VX))
- CALL EPSETW(13,8,10*(ISPAN-1)+IPAD,IERR)
-#endif
-#if defined(CERNLIB_STF77)||defined(CERNLIB_STF77VX)
- CALL EPSETW(13,8,10*(ISPAN-1)+ 1 ,IERR)
-#endif
- IF(IERR.NE.0) CALL ERREX(28)
- DO 13 MODE=1,3
- N=NWOUT
- IF(MODE.EQ.1.AND.ILWORD.EQ.16) N=2*NWOUT
- DO 14 JREC=1,NREC
- CALL EPREAD(11,MODE,NWR,IPAC,IBUF11,IERR)
- IF(IERR.NE.0) CALL ERREX(29)
- ICALL=ICALL+1
- IF(NWR.NE.N) CALL ERREX(20)
- IF(ICALL.EQ.1) CALL EPADDH(11,10,IH,IBUF11,IERR)
- IF(ICALL.EQ.1.AND.IERR.NE.17) CALL ERREX(13)
- IF(MODE.EQ.1) CALL BLO32W(IPAC,1,IDAT,1,NWOUT)
- IF(MODE.NE.1) CALL UCOPY(IPAC,IDAT,NWOUT)
- DO 15 JWORD=1,NWOUT
- IF(IDAT(JWORD).NE.ICALL) CALL ERREX(30)
- 15 CONTINUE
- CALL EPOUTL(12,MODE,NH,IH,N,IPAC,IBUF12,IERR)
- IF(IERR.NE.0) CALL ERREX(31)
- CALL EPOUTS(13,MODE,N,IPAC,IBUF13,IERR)
- IF(IERR.NE.0) CALL ERREX(32)
- 14 CONTINUE
- 13 CONTINUE
- 12 CONTINUE
- 11 CONTINUE
- CALL EPCLOS(12,IBUF12,IERR)
- CALL EPCLOS(13,IBUF13,IERR)
- 10 CONTINUE
- CALL EPSTAT
-C--- E.O.F. CHECK ON 11
- CALL EPREAD(11,1,NWR,IPAC,IBUF11,IERR)
- IF(IERR.NE.1) CALL ERREX(2)
- CALL EPRWND(11,IBUF11,IERR)
- IF(IERR.NE.0) CALL ERREX(33)
- CALL EPRWND(12,IBUF12,IERR)
- IF(IERR.NE.0) CALL ERREX(34)
- CALL EPRWND(13,IBUF13,IERR)
- IF(IERR.NE.0) CALL ERREX(35)
- RETURN
- END
-#endif
diff --git a/src/packlib/epio/tests/ptest2/test2.F b/src/packlib/epio/tests/ptest2/test2.F
deleted file mode 100644
index 4c42cf4..0000000
--- a/src/packlib/epio/tests/ptest2/test2.F
+++ /dev/null
@@ -1,116 +0,0 @@
-*
-* $Id: test2.F,v 1.1.1.1 1996/03/08 15:21:45 mclareni Exp $
-*
-* $Log: test2.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:45 mclareni
-* Epio
-*
-*
-#if !defined(CERNLIB_ND100B16)
-#include "pilot.h"
- SUBROUTINE TEST2
-C--- READS AND CHECKS 11, 12, 13,
-C--- 11 WITH TOO SHORT BUFFER FOR P.H. AND L.H.,
-C--- 12 WITH TOO SHORT DATA BUFFER
-#include "testc.inc"
- NCUTH=8
- NCUTD=100
- DO 101 I=1,2
- CALL EPREAD(11,30,NWR,IPAC,IBUF11,IERR)
- IF(IERR.NE.0) CALL ERREX(39)
-#if defined(CERNLIB_PH32BIT)
- IF(2*NWR.NE.IPAC(12)) CALL ERREX(40)
-#endif
-#if !defined(CERNLIB_PH32BIT)
- IF(NWR.NE.IPAC(12)) CALL ERREX(40)
-#endif
- PRINT 2001,NWR,(IPAC(JJ),JJ=1,NWR)
- 101 CONTINUE
- DO 103 I=1,3
- CALL EPREAD(11,20,NWR,IPAC,IBUF11,IERR)
- IF(IERR.NE.0) CALL ERREX(41)
- ICALL=IPAC(8)
- MODE=IPAC(9)
- CALL EPREAD(11,10+MODE,NWR,IPAC,IBUF11,IERR)
- IF(IERR.NE.0) CALL ERREX(42)
- CALL EPGETW(11,3,J,IERR)
- IF(MODE.EQ.1) NWR=(NWR*J)/32
- IF(NWR.NE.NWOUT) CALL ERREX(43)
- IF(MODE.EQ.1) CALL BLO32W(IPAC,1,IDAT,1,NWR)
- IF(MODE.NE.1) CALL UCOPY(IPAC,IDAT,NWR)
- DO 102 JWORD=1,NWR
- IF(IDAT(JWORD).NE.ICALL) CALL ERREX(44)
- 102 CONTINUE
- 103 CONTINUE
- CALL EPSETW(11,26,NCUTH,IERR)
- IF(IERR.NE.0) CALL ERREX(37)
- CALL EPSETW(12,2,NCUTD,IERR)
- IF(IERR.NE.0) CALL ERREX(38)
- DO 104 I=1,5
- CALL EPREAD(11,30,NWR,IPAC,IBUF11,IERR)
- IF(IERR.NE.6) CALL ERREX(45)
- IF(NWR.NE.NCUTH) CALL ERREX(46)
- PRINT 2001,NWR,(IPAC(JJ),JJ=1,NWR)
- 104 CONTINUE
- CALL EPRWND(11,IBUF11,IERR)
- IF(IERR.NE.0) CALL ERREX(47)
- ICALL2=0
- ICALL=0
- DO 10 ILWORD=16,32,16
- DO 11 ISPAN=1,1
- DO 12 IPAD=1,IPADUL
- DO 13 MODE=1,3
- DO 14 JREC=1,NREC
- CALL EPSETW(11,26,NCUTH,IERR)
- CALL EPREAD(11,20,NWR,IPAC,IBUF11,IERR)
- ICALL=ICALL+1
- ICALL2=ICALL2+1
- IF(IERR.NE.6) CALL ERREX(48)
- IF(IPAC(4).NE.ICALL2) CALL ERREX(49)
- CALL EPSETW(11,2,9999,IERR)
- CALL EPREAD(11,10+MODE,NWR,IPAC,IBUF11,IERR)
- IF(IERR.NE.0) CALL ERREX(50)
- IF(DBUGFL) CALL EPSTAT
- CALL EPGETW(11,3,J,IERR)
- IF(MODE.EQ.1) NWR=(NWR*J)/32
- IF(NWR.NE.NWOUT) CALL ERREX(51)
- IF(MODE.EQ.1) CALL BLO32W(IPAC,1,IDAT,1,NWOUT)
- IF(MODE.NE.1) CALL UCOPY(IPAC,IDAT,NWOUT)
- DO 15 JWORD=1,NWOUT
- IF(IDAT(JWORD).NE.ICALL) CALL ERREX(58)
- 15 CONTINUE
- CALL EPREAD(12,MODE,NWR,IPAC,IBUF12,IERR)
- IF(IERR.NE.6) CALL ERREX(52)
- CALL EPGETW(12,3,J,IERR)
- IF(MODE.EQ.1) NWR=(NWR*J)/32
- IF(MODE.EQ.1) CALL BLO32W(IPAC,1,IDAT,1,NWR)
- IF(MODE.NE.1) CALL UCOPY(IPAC,IDAT,NWR)
- DO 17 JWORD=1,NWR
- IF(IDAT(JWORD).NE.ICALL) CALL ERREX(54)
- 17 CONTINUE
- CALL EPREAD(13,MODE,NWR,IPAC,IBUF13,IERR)
- IF(IERR.NE.0) CALL ERREX(55)
- CALL EPGETW(13,3,J,IERR)
- IF(MODE.EQ.1) NWR=(NWR*J)/32
- IF(NWR.NE.NWOUT) CALL ERREX(56)
- IF(MODE.EQ.1) CALL BLO32W(IPAC,1,IDAT,1,NWR)
- IF(MODE.NE.1) CALL UCOPY(IPAC,IDAT,NWR)
- DO 18 JWORD=1,NWR
- IF(IDAT(JWORD).NE.ICALL) CALL ERREX(57)
- 18 CONTINUE
- 14 CONTINUE
- 13 CONTINUE
- 12 CONTINUE
- 11 CONTINUE
- 10 CONTINUE
- CALL EPSTAT
- 1 CONTINUE
- RETURN
-#if !defined(CERNLIB_CDC)
-2001 FORMAT(' HEADER, NW AND CONTENTS =',7I7,2I12,4I7)
-#endif
-#if defined(CERNLIB_CDC)
-2001 FORMAT(" HEADER, NW AND CONTENTS =",7I7,2I12,4I7)
-#endif
- END
-#endif
diff --git a/src/packlib/epio/tests/ptest2/testc.inc b/src/packlib/epio/tests/ptest2/testc.inc
deleted file mode 100644
index bb83705..0000000
--- a/src/packlib/epio/tests/ptest2/testc.inc
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: testc.inc,v 1.1.1.1 1996/03/08 15:21:45 mclareni Exp $
-*
-* $Log: testc.inc,v $
-* Revision 1.1.1.1 1996/03/08 15:21:45 mclareni
-* Epio
-*
-*
-*
-* testc.inc
-*
-#if !defined(CERNLIB_ND100B16)
- COMMON//NWOUT,NREC,IERR,NH,NPASS,ILWORD,ISPAN,IPAD,JREC,
- 1 NBIT,ICALL,JWORD,IBUF11(1000),IBUF12(1000),IBUF13(1000),
- 2 NWR,IDAT(5000),IPAC(5000),IH(10),IPADUL
- COMMON/EPDBGC/DBUGFL
- LOGICAL DBUGFL
-#endif
diff --git a/src/packlib/epio/tests/ptest2/wr11.F b/src/packlib/epio/tests/ptest2/wr11.F
deleted file mode 100644
index 59de8a7..0000000
--- a/src/packlib/epio/tests/ptest2/wr11.F
+++ /dev/null
@@ -1,51 +0,0 @@
-*
-* $Id: wr11.F,v 1.1.1.1 1996/03/08 15:21:45 mclareni Exp $
-*
-* $Log: wr11.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:45 mclareni
-* Epio
-*
-*
-#if !defined(CERNLIB_ND100B16)
-#include "pilot.h"
- SUBROUTINE WR11
-C--- WRITES TEST DATA
-#include "testc.inc"
- ICALL=0
- LUNIT=11
- CALL EPSTAT
- DO 10 ILWORD=16,32,16
- CALL EPSETW(LUNIT,3,ILWORD,IERR)
- IF(IERR.NE.0) CALL ERREX(21)
- DO 11 ISPAN=1,1
- DO 12 IPAD=1,IPADUL
-#if (!defined(CERNLIB_STF77))&&(!defined(CERNLIB_STF77VX))
- CALL EPSETW(LUNIT,8,10*(ISPAN-1)+IPAD,IERR)
-#endif
-#if defined(CERNLIB_STF77)||defined(CERNLIB_STF77VX)
- CALL EPSETW(LUNIT,8,10*(ISPAN-1)+ 1 ,IERR)
-#endif
- IF(IERR.NE.0) CALL ERREX(22)
- DO 13 MODE=1,3
- N=NWOUT
- IF(MODE.EQ.1.AND.ILWORD.EQ.16) N=2*NWOUT
- DO 14 JREC=1,NREC
- IH(9)=MODE
- ICALL=ICALL+1
- IH(8)=ICALL
- CALL VFILL(IDAT,NWOUT,ICALL)
- IF(MODE.EQ.1) CALL BUN32W(IDAT,1,IPAC,1,NWOUT)
- IF(MODE.NE.1) CALL UCOPY(IDAT,IPAC,NWOUT)
- CALL EPOUTL(LUNIT,MODE,NH,IH,N,IPAC,IBUF11,IERR)
- IF(IERR.NE.0) CALL ERREX(23)
- 14 CONTINUE
- 13 CONTINUE
- CALL EPCLOS(LUNIT,IBUF11,IERR)
- IF(IERR.NE.0) CALL ERREX(24)
- 12 CONTINUE
- 11 CONTINUE
- 10 CONTINUE
- CALL EPSTAT
- RETURN
- END
-#endif
diff --git a/src/packlib/epio/tests/ptest3/Imakefile b/src/packlib/epio/tests/ptest3/Imakefile
deleted file mode 100644
index 0a99cb8..0000000
--- a/src/packlib/epio/tests/ptest3/Imakefile
+++ /dev/null
@@ -1,21 +0,0 @@
-SRCS_F= errex.F main.F rwr123.F split1.F test1.F test2.F wr11.F
-
-
-/* Handle Objects ourselves */
-OBJS_CO= errex.o rwr123.o split1.o test1.o wr11.o
-OBJS_16= main.o test2.o
-OBJS_32= main_32.o test2_32.o
-
-
-SpecialFortranObjectRule(main_32,main,NullParameter,-DCERNLIB_PH32BIT)
-SpecialFortranObjectRule(test2_32,test2,NullParameter,-DCERNLIB_PH32BIT)
-
-DefinePackageLibrary(NullParameter)
-
-CernlibFortranProgramTarget(ptest3_16,$(OBJS_16) $(OBJS_CO),$(PACKAGE_LIB),$(PACKAGE_LIB),kernlib)
-
-CernlibFortranProgramTarget(ptest3_32,$(OBJS_32) $(OBJS_CO),$(PACKAGE_LIB),$(PACKAGE_LIB),kernlib)
-
-TestTarget(ptest3_32,NullParameter,NullParameter)
-
-TestTarget(ptest3_16,NullParameter,NullParameter)
diff --git a/src/packlib/epio/tests/ptest3/errex.F b/src/packlib/epio/tests/ptest3/errex.F
deleted file mode 100644
index 3034d51..0000000
--- a/src/packlib/epio/tests/ptest3/errex.F
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: errex.F,v 1.1.1.1 1996/03/08 15:21:46 mclareni Exp $
-*
-* $Log: errex.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:46 mclareni
-* Epio
-*
-*
-#if !defined(CERNLIB_ND100B16)
-#include "pilot.h"
- SUBROUTINE ERREX(N)
-C--- ALL ERROR EXITS
-#include "testc.inc"
- PRINT 3001,N,NREC,IERR,NH,NPASS,ILWORD,ISPAN,IPAD,
- 1 JREC,JWORD,ICALL
- STOP
-#if !defined(CERNLIB_CDC)
-3001 FORMAT(/,' + + + + + ERROR CONDITION + + + + +',//,
- 1' N NREC IERR NH NPASS',
- 2' ILWORD ISPAN IPAD JREC JWORD',/,
- 3 1X,10I10,//,
- 4' ICALL',/,
- 5 1X,10I10)
-#endif
-#if defined(CERNLIB_CDC)
-3001 FORMAT(/," + + + + + ERROR CONDITION + + + + +",//,
- 1" N NREC IERR NH NPASS",
- 2" ILWORD ISPAN IPAD JREC JWORD",/,
- 3 1X,10I10,//,
- 4" ICALL",/,
- 5 1X,10I10)
-#endif
- END
-#endif
diff --git a/src/packlib/epio/tests/ptest3/main.F b/src/packlib/epio/tests/ptest3/main.F
deleted file mode 100644
index f078546..0000000
--- a/src/packlib/epio/tests/ptest3/main.F
+++ /dev/null
@@ -1,194 +0,0 @@
-*
-* $Id: main.F,v 1.1.1.1 1996/03/08 15:21:46 mclareni Exp $
-*
-* $Log: main.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:46 mclareni
-* Epio
-*
-*
-#if !defined(CERNLIB_ND100B16)
-#include "pilot.h"
-#if defined(CERNLIB_CDC)
- PROGRAM PTEST(OUTPUT,TAPE11,TAPE12,TAPE13)
-#endif
-#include "testc.inc"
-#if defined(CERNLIB_APOLLO)
-%INCLUDE '/sys/ins/base.ins.ftn'
-%INCLUDE '/sys/ins/error.ins.ftn'
-%INCLUDE '/sys/ins/streams.ins.ftn'
- INTEGER*4 STATUS_$RETURNED
- INTEGER*2 ATT_$REC(39)
- CHARACTER*10 FILNAM
- DATA FILNAM/'FOR011.DAT'/
- DATA (ATT_$REC(J),J=35,39)/'FO','R0','11','.D','AT'/
- DATA ATT_$REC(2)/10/
-#endif
-C--- RESET DEBUG FLAG
- DBUGFL=.FALSE.
-C--- NWOUT = NO. OF WORDS / RECORD
- NWOUT=500
-C--- NREC = NO. OF IDENTICAL RECORDS WRITTEN EACH TIME
- NREC=3
- NH=9
- PRINT 2001
- CALL EPINIT
-#if defined(CERNLIB_PH32BIT)
- NWPR1=1024
- NWPR2=1768
- NWPR3=1774
- NWPR4=883
- CALL EPSETW(11,29,1,IERR)
-#endif
-#if !defined(CERNLIB_PH32BIT)
- NWPR1=1036
- NWPR2=1780
- NWPR3=1786
- NWPR4=889
-#endif
-#if defined(CERNLIB_IBM)
- CALL VMCMS(
- -'FILEDEF IOFILE11 DISK EPIOT1 DATA A (RECFM U BLOCK 3600',IVMERR)
- CALL VMCMS(
- -'FILEDEF IOFILE12 DISK EPIOT2 DATA A (RECFM U BLOCK 3600',IVMERR)
- CALL VMCMS(
- -'FILEDEF IOFILE13 DISK EPIOT3 DATA A (RECFM U BLOCK 3600',IVMERR)
-#endif
-C--- TEST L.R.H. SPLITTING IN SOME DETAIL
- CALL SPLIT1
- PRINT 2002
-#if defined(CERNLIB_IBM)
- CALL VMCMS('ERASE EPIOT1 DATA A',IVMERR)
-#endif
-#if defined(CERNLIB_MAKEXT11)||defined(CERNLIB_READXT11)
- IF(.TRUE.) GOTO 200
-#endif
-#if defined(CERNLIB_VAXMAG)
- CLOSE (11)
-#endif
-#if (defined(CERNLIB_APOLLO))&&(!defined(CERNLIB_APOMAG))
-C
-C FOR THE APOLLO THE STORY IS DIFFERENT. WE NEED TO CLOSE
-C THE STREAM ASSOCIATED WITH 'FOR011', AND THEN TO DELETE
-C THE FILE.
-C
- CALL STREAM_$INQUIRE(
- 1 STREAM_$IRM_STRID,
- 2 STREAM_$NAME_UNCONDITIONAL,
- 3 ATT_$REC,
- 4 ERROR_$MASK,
- 6 STATUS_$RETURNED)
- IF(STATUS_$RETURNED.NE.STATUS_$OK)
- 1 CALL PFM_$SIGNAL(STATUS_$RETURNED)
-C
-C THE FILE IS THERE
-C
- CALL STREAM_$CLOSE(ATT_$REC,STATUS_$RETURNED)
- IF(STATUS_$RETURNED.NE.STATUS_$OK)
- 1 CALL PFM_$SIGNAL(STATUS_$RETURNED)
-C
-C THE STREAM HAS BEEN CLOSED
-C
- CALL NAME_$DELETE_FILE(FILNAM,INT2(10),STATUS_$RETURNED)
- IF(STATUS_$RETURNED.NE.STATUS_$OK)
- 1 CALL PFM_$SIGNAL(STATUS_$RETURNED)
-C
-C THE FILE HAS BEEN DELETED
-C
-#endif
-#if (!defined(CERNLIB_VAXLONG))&&(!defined(CERNLIB_STRA))&&(!defined(CERNLIB_UNIX))
-C--- WRITE WRONG BLOCK, REWIND + TEST
- CALL TEST1
- PRINT 2003
-#endif
-#if defined(CERNLIB_IBM)
- CALL VMCMS('ERASE EPIOT1 DATA A',IVMERR)
-#endif
-#if (defined(CERNLIB_APOLLO))&&(!defined(CERNLIB_APOMAG))
-C
-C FOR THE APOLLO THE STORY IS DIFFERENT. WE NEED TO CLOSE
-C THE STREAM ASSOCIATED WITH 'FOR011', AND THEN TO DELETE
-C THE FILE.
-C
- CALL STREAM_$INQUIRE(
- 1 STREAM_$IRM_STRID,
- 2 STREAM_$NAME_UNCONDITIONAL,
- 3 ATT_$REC,
- 4 ERROR_$MASK,
- 6 STATUS_$RETURNED)
- IF(STATUS_$RETURNED.NE.STATUS_$OK)
- 1 CALL PFM_$SIGNAL(STATUS_$RETURNED)
-C
-C THE FILE IS THERE
-C
- CALL STREAM_$CLOSE(ATT_$REC,STATUS_$RETURNED)
- IF(STATUS_$RETURNED.NE.STATUS_$OK)
- 1 CALL PFM_$SIGNAL(STATUS_$RETURNED)
-C
-C THE STREAM HAS BEEN CLOSED
-C
- CALL NAME_$DELETE_FILE(FILNAM,INT2(10),STATUS_$RETURNED)
- IF(STATUS_$RETURNED.NE.STATUS_$OK)
- 1 CALL PFM_$SIGNAL(STATUS_$RETURNED)
-C
-C THE FILE HAS BEEN DELETED
-C
-#endif
-C--- DEFINE HEADER
- DO 1 I=1,NH
- 1 IH(I)=100+I
-C--- WRITE TEST DATA ONTO UNIT 11
- NPASS=1
-#if defined(CERNLIB_PH32BIT)
- CALL EPSETW(11,29,1,IERR)
-#endif
- CALL WR11
- PRINT 2004,NPASS
- NPASS=2
-C--- SET NEW BLOCK SIZE
-#if (!defined(CERNLIB_STF77))&&(!defined(CERNLIB_STF77VX))
- CALL EPSETW(11,1,1440,IERR)
- IF(IERR.NE.0) CALL ERREX(1)
-#endif
-C--- WRITE AGAIN
- CALL WR11
- PRINT 2004,NPASS
-C--- RESET BLOCK SIZE
-#if (!defined(CERNLIB_STF77))&&(!defined(CERNLIB_STF77VX))
- CALL EPSETW(11,1,1800,IERR)
- IF(IERR.NE.0) CALL ERREX(2)
-#endif
- CALL EPRWND(11,IBUF11,IERR)
- IF(IERR.NE.0) CALL ERREX(36)
-C--- READ 11, WRITE 12 + 13
- CALL RWR123
- N=2*ICALL
- PRINT 2005,N
-C--- REWIND ALL THREE, READ BACK AND CHECK WITH
-C HEADER BUFFER CUT, DATA BUFFER CUT, NORMAL BUFFER
- CALL TEST2
- 200 CONTINUE
-C--- TERMINATE
- PRINT 3001
- STOP
-#if !defined(CERNLIB_CDC)
-2001 FORMAT('1 ++++++++++ EPTEST3 - START OF EXECUTION ++++++++')
-2002 FORMAT(/,' ROUTINE SPLIT1 SUCCESSFUL',//)
-2003 FORMAT(/,' ROUTINE TEST1 SUCCESSFUL')
-2004 FORMAT(/,' ROUTINE WR11 SUCCESSFUL, PASS =',I5)
-2005 FORMAT(/,' ROUTINE RWR123 SUCCESSFUL - NO. OF REC.S =',I10,//)
-3001 FORMAT(///,1X,10(10H++++++++++),//,
- 1 ' EPTEST3 - NORMAL TERMINATION, ALL TESTS DONE',
- 2 //, 1X,10(10H++++++++++),/////)
-#endif
-#if defined(CERNLIB_CDC)
-2001 FORMAT("1 ++++++++++ EPTEST3 - START OF EXECUTION ++++++++")
-2002 FORMAT(/," ROUTINE SPLIT1 SUCCESSFUL",//)
-2003 FORMAT(/," ROUTINE TEST1 SUCCESSFUL")
-2004 FORMAT(/," ROUTINE WR11 SUCCESSFUL, PASS =",I5)
-2005 FORMAT(/," ROUTINE RWR123 SUCCESSFUL - NO. OF REC.S =",I10,//)
-3001 FORMAT(///,1X,10(10H++++++++++),//,
- 1 " EPTEST3 - NORMAL TERMINATION, ALL TESTS DONE",
- 2 //, 1X,10(10H++++++++++),/////)
-#endif
- END
-#endif
diff --git a/src/packlib/epio/tests/ptest3/pilot.h b/src/packlib/epio/tests/ptest3/pilot.h
deleted file mode 100644
index e2590e8..0000000
--- a/src/packlib/epio/tests/ptest3/pilot.h
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: pilot.h,v 1.1.1.1 1996/03/08 15:21:46 mclareni Exp $
-*
-* $Log: pilot.h,v $
-* Revision 1.1.1.1 1996/03/08 15:21:46 mclareni
-* Epio
-*
-*
-#if defined(CERNLIB_VAXVMS)||defined(CERNLIB_VAXULX)
-#ifndef CERNLIB_VAX
-#define CERNLIB_VAX
-#endif
-#endif
-#if (defined(CERNLIB_UNIX))&&(!defined(CERNLIB_DECS))
-#ifndef CERNLIB_STF77
-#define CERNLIB_STF77
-#endif
-#endif
-#if defined(CERNLIB_DECS)
-#ifndef CERNLIB_STF77VX
-#define CERNLIB_STF77VX
-#endif
-#endif
diff --git a/src/packlib/epio/tests/ptest3/rwr123.F b/src/packlib/epio/tests/ptest3/rwr123.F
deleted file mode 100644
index ad282d1..0000000
--- a/src/packlib/epio/tests/ptest3/rwr123.F
+++ /dev/null
@@ -1,72 +0,0 @@
-*
-* $Id: rwr123.F,v 1.1.1.1 1996/03/08 15:21:46 mclareni Exp $
-*
-* $Log: rwr123.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:46 mclareni
-* Epio
-*
-*
-#if !defined(CERNLIB_ND100B16)
-#include "pilot.h"
- SUBROUTINE RWR123
-C--- READS + CHECKS 11, WRITES 12+13
-#include "testc.inc"
- DO 1 ITIMES=1,2
- ICALL=0
- DO 10 ILWORD=16,32,16
- CALL EPSETW(12,3,ILWORD,IERR)
- IF(IERR.NE.0) CALL ERREX(25)
- CALL EPSETW(13,3,ILWORD,IERR)
- IF(IERR.NE.0) CALL ERREX(26)
- DO 11 ISPAN=1,1
- DO 12 IPAD=1,3
-#if (!defined(CERNLIB_STF77))&&(!defined(CERNLIB_STF77VX))
- CALL EPSETW(12,8,10*(ISPAN-1)+IPAD,IERR)
-#endif
-#if defined(CERNLIB_STF77)||defined(CERNLIB_STF77VX)
- CALL EPSETW(12,8,10*(ISPAN-1)+ 1 ,IERR)
-#endif
- IF(IERR.NE.0) CALL ERREX(27)
-#if (!defined(CERNLIB_STF77))&&(!defined(CERNLIB_STF77VX))
- CALL EPSETW(13,8,10*(ISPAN-1)+IPAD,IERR)
-#endif
-#if defined(CERNLIB_STF77)||defined(CERNLIB_STF77VX)
- CALL EPSETW(13,8,10*(ISPAN-1)+ 1 ,IERR)
-#endif
- IF(IERR.NE.0) CALL ERREX(28)
- DO 13 MODE=1,3
- N=NWOUT
- IF(MODE.EQ.1.AND.ILWORD.EQ.16) N=2*NWOUT
- DO 14 JREC=1,NREC
- CALL EPREAD(11,MODE,NWR,IPAC,IBUF11,IERR)
- IF(IERR.NE.0) CALL ERREX(29)
- ICALL=ICALL+1
- IF(ICALL.EQ.1) CALL EPADDH(11,10,IH,IBUF11,IERR)
- IF(ICALL.EQ.1.AND.IERR.NE.17) CALL ERREX(13)
- IF(MODE.EQ.1) CALL BLO32W(IPAC,1,IDAT,1,NWOUT)
- IF(MODE.NE.1) CALL UCOPY(IPAC,IDAT,NWOUT)
- DO 15 JWORD=1,NWOUT
- IF(IDAT(JWORD).NE.ICALL) CALL ERREX(30)
- 15 CONTINUE
- CALL EPOUTL(12,MODE,NH,IH,N,IPAC,IBUF12,IERR)
- IF(IERR.NE.0) CALL ERREX(31)
- CALL EPOUTS(13,MODE,N,IPAC,IBUF13,IERR)
- IF(IERR.NE.0) CALL ERREX(32)
- 14 CONTINUE
- 13 CONTINUE
- 12 CONTINUE
- 11 CONTINUE
- CALL EPCLOS(12,IBUF12,IERR)
- CALL EPCLOS(13,IBUF13,IERR)
- 10 CONTINUE
- CALL EPSTAT
- 1 CONTINUE
- CALL EPRWND(11,IBUF11,IERR)
- IF(IERR.NE.0) CALL ERREX(33)
- CALL EPRWND(12,IBUF12,IERR)
- IF(IERR.NE.0) CALL ERREX(34)
- CALL EPRWND(13,IBUF13,IERR)
- IF(IERR.NE.0) CALL ERREX(35)
- RETURN
- END
-#endif
diff --git a/src/packlib/epio/tests/ptest3/split1.F b/src/packlib/epio/tests/ptest3/split1.F
deleted file mode 100644
index f9db434..0000000
--- a/src/packlib/epio/tests/ptest3/split1.F
+++ /dev/null
@@ -1,356 +0,0 @@
-*
-* $Id: split1.F,v 1.1.1.1 1996/03/08 15:21:46 mclareni Exp $
-*
-* $Log: split1.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:46 mclareni
-* Epio
-*
-*
-#if !defined(CERNLIB_ND100B16)
-#include "pilot.h"
- SUBROUTINE SPLIT1
-C--- TESTS L.R.H. SPLITTING
-#include "testc.inc"
-#if defined(CERNLIB_READXT11)
- IF(.TRUE.) GOTO 200
-#endif
- NWSS=500
- ICALL=1
- CALL VFILL(IDAT,NWSS,ICALL)
- CALL CTOIBM(IDAT,NWSS,2)
- IH(8)=ICALL
- CALL BUN32W(IDAT,1,IPAC,1,NWSS)
- CALL EPOUTL(11,1,NH,IH,2*NWSS,IPAC,IBUF11,IERR)
- IF(IERR.NE.0) CALL ERREX(3)
- ICALL=2
- CALL VFILL(IDAT,NWSS,ICALL)
- IH(8)=ICALL
- CALL EPOUTL(11,2,NH,IH,NWSS,IDAT,IBUF11,IERR)
- IF(IERR.NE.0) CALL ERREX(4)
- ICALL=3
- CALL VFILL(IDAT,NWSS,ICALL)
- CALL CTOIBM(IDAT,NWSS,2)
- IH(8)=ICALL
- CALL EPOUTL(11,3,NH,IH,NWSS,IDAT,IBUF11,IERR)
- IF(IERR.NE.0) CALL ERREX(5)
- NWSS=NWPR1
- ICALL=4
- CALL VFILL(IDAT,NWSS,ICALL)
- IH(8)=ICALL
- CALL EPOUTL(11,2,NH,IH,NWSS,IDAT,IBUF11,IERR)
- IF(IERR.NE.0) CALL ERREX(6)
- NH=3
- ICALL=5
- CALL EPOUTL(11,2,NH,IH,1,ICALL,IBUF11,IERR)
- IF(IERR.NE.0) CALL ERREX(7)
- NH=9
- ICALL=6
- NWSS=NWPR2
- CALL VFILL(IDAT,NWSS,ICALL)
- CALL EPOUTS(11,2,NWSS,IDAT,IBUF11,IERR)
- IF(IERR.NE.0) CALL ERREX(8)
- ICALL=7
- NWSS=NWPR3
- CALL VFILL(IDAT,NWSS,ICALL)
- CALL EPOUTS(11,2,NWSS,IDAT,IBUF11,IERR)
- IF(IERR.NE.0) CALL ERREX(9)
- ICALL=8
- NH=10
- NWSS=1000
- IH(8)=ICALL
- CALL VFILL(IDAT,NWSS,ICALL)
- CALL EPOUTL(11,2,NH,IH,NWSS,IDAT,IBUF11,IERR)
- IF(IERR.NE.0) CALL ERREX(10)
- CALL EPCLOS(11,IBUF11,IERR)
- IF(IERR.NE.0) CALL ERREX(11)
- CALL EPSETW(11,3,32,IERR)
- IF(IERR.NE.0) CALL ERREX(12)
- NH=9
- NWSS=NWPR4
- ICALL=9
- CALL VFILL(IDAT,NWSS,ICALL)
- CALL CTOIBM(IDAT,NWSS,2)
- CALL EPOUTS(11,3,NWSS,IDAT,IBUF11,IERR)
- IF(IERR.NE.0) CALL ERREX(13)
- NWSS=100
- ICALL=10
- CALL VFILL(IDAT,NWSS,ICALL)
- CALL CTOIBM(IDAT,NWSS,2)
- CALL EPOUTS(11,3,NWSS,IDAT,IBUF11,IERR)
- IF(IERR.NE.0) CALL ERREX(13)
- CALL EPRWND(11,IBUF11,IERR)
- IF(IERR.NE.0) CALL ERREX(14)
- 200 CONTINUE
- NWSS=500
- ICALL=1
- CALL EPREAD(11,20,NWR,IPAC,IBUF11,IERR)
- IF(IERR.NE.0) CALL ERREX(151)
- IF(NWR.NE.9) CALL ERREX(152)
- IF(IPAC(8).NE.ICALL) CALL ERREX(153)
- CALL EPREAD(11,11,NWR,IPAC,IBUF11,IERR)
- IF(IERR.NE.0) CALL ERREX(154)
- NWR=NWR/2
- IF(NWR.NE.NWSS) CALL ERREX(155)
- CALL BLO32W(IPAC,1,IDAT,1,NWR)
- CALL CFRIBM(IDAT,NWR,2)
- DO 11 JWORD=1,NWR
- IF(IDAT(JWORD).NE.ICALL) CALL ERREX(156)
- 11 CONTINUE
- ICALL=2
- CALL EPREAD(11,20,NWR,IPAC,IBUF11,IERR)
- IF(IERR.NE.0) CALL ERREX(157)
- IF(NWR.NE.9) CALL ERREX(158)
- IF(IPAC(8).NE.ICALL) CALL ERREX(159)
- CALL EPREAD(11,12,NWR,IPAC,IBUF11,IERR)
- IF(IERR.NE.0) CALL ERREX(160)
- IF(NWR.NE.NWSS) CALL ERREX(161)
- DO 12 JWORD=1,NWR
- IF(IPAC(JWORD).NE.ICALL) CALL ERREX(162)
- 12 CONTINUE
- ICALL=3
- CALL EPREAD(11,20,NWR,IPAC,IBUF11,IERR)
- IF(IERR.NE.0) CALL ERREX(163)
- IF(NWR.NE.9) CALL ERREX(164)
- IF(IPAC(8).NE.ICALL) CALL ERREX(165)
- CALL EPREAD(11,13,NWR,IPAC,IBUF11,IERR)
- IF(IERR.NE.0) CALL ERREX(166)
- IF(NWR.NE.NWSS) CALL ERREX(167)
- CALL CFRIBM(IPAC,NWR,2)
- DO 13 JWORD=1,NWR
- IF(IPAC(JWORD).NE.ICALL) CALL ERREX(168)
- 13 CONTINUE
- ICALL=4
- NWSS=NWPR1
- CALL EPREAD(11,20,NWR,IPAC,IBUF11,IERR)
- IF(IERR.NE.0) CALL ERREX(169)
- IF(NWR.NE.9) CALL ERREX(170)
- IF(IPAC(8).NE.ICALL) CALL ERREX(171)
- CALL EPREAD(11,12,NWR,IPAC,IBUF11,IERR)
- IF(IERR.NE.0) CALL ERREX(172)
- IF(NWR.NE.NWSS) CALL ERREX(173)
- DO 14 JWORD=1,NWR
- IF(IPAC(JWORD).NE.ICALL) CALL ERREX(174)
- 14 CONTINUE
- ICALL=5
- NWSS=1
- CALL EPREAD(11,20,NWR,IPAC,IBUF11,IERR)
- IF(IERR.NE.0) CALL ERREX(175)
- IF(NWR.NE.3) CALL ERREX(176)
- CALL EPREAD(11,12,NWR,IPAC,IBUF11,IERR)
- IF(IERR.NE.0) CALL ERREX(177)
- IF(NWR.NE.1) CALL ERREX(178)
- IF(IPAC(1).NE.ICALL) CALL ERREX(179)
- ICALL=6
- NWSS=NWPR2
- CALL EPREAD(11,20,NWR,IPAC,IBUF11,IERR)
- IF(IERR.NE.0) CALL ERREX(180)
- IF(NWR.NE.4) CALL ERREX(181)
- CALL EPREAD(11,12,NWR,IPAC,IBUF11,IERR)
- IF(IERR.NE.0) CALL ERREX(182)
- IF(NWR.NE.NWSS) CALL ERREX(183)
- DO 15 JWORD=1,NWR
- IF(IPAC(JWORD).NE.ICALL) CALL ERREX(184)
- 15 CONTINUE
- ICALL=7
- NWSS=NWPR3
- CALL EPREAD(11,20,NWR,IPAC,IBUF11,IERR)
- IF(IERR.NE.0) CALL ERREX(185)
- IF(NWR.NE.4) CALL ERREX(186)
- CALL EPREAD(11,12,NWR,IPAC,IBUF11,IERR)
- IF(IERR.NE.0) CALL ERREX(187)
- IF(NWR.NE.NWSS) CALL ERREX(188)
- DO 16 JWORD=1,NWR
- IF(IPAC(JWORD).NE.ICALL) CALL ERREX(189)
- 16 CONTINUE
- ICALL=8
- NWSS=1000
- CALL EPREAD(11,20,NWR,IPAC,IBUF11,IERR)
- IF(IERR.NE.0) CALL ERREX(190)
- IF(NWR.NE.10) CALL ERREX(191)
- IF(IPAC(8).NE.ICALL) CALL ERREX(192)
- CALL EPREAD(11,12,NWR,IPAC,IBUF11,IERR)
- IF(IERR.NE.0) CALL ERREX(193)
- IF(NWR.NE.NWSS) CALL ERREX(194)
- DO 17 JWORD=1,NWR
- IF(IPAC(JWORD).NE.ICALL) CALL ERREX(195)
- 17 CONTINUE
- ICALL=9
- NWSS=NWPR4
- CALL EPREAD(11,20,NWR,IPAC,IBUF11,IERR)
- IF(IERR.NE.0) CALL ERREX(196)
- IF(NWR.NE.4) CALL ERREX(197)
- CALL EPREAD(11,13,NWR,IPAC,IBUF11,IERR)
- IF(IERR.NE.0) CALL ERREX(198)
- IF(NWR.NE.NWSS) CALL ERREX(199)
- CALL CFRIBM(IPAC,NWR,2)
- DO 18 JWORD=1,NWR
- IF(IPAC(JWORD).NE.ICALL) CALL ERREX(140)
- 18 CONTINUE
- NWSS=100
- ICALL=10
- CALL EPREAD(11,20,NWR,IPAC,IBUF11,IERR)
- IF(IERR.NE.0) CALL ERREX(141)
- IF(NWR.NE.4) CALL ERREX(142)
- CALL EPREAD(11,13,NWR,IPAC,IBUF11,IERR)
- IF(IERR.NE.0) CALL ERREX(143)
- IF(NWR.NE.NWSS) CALL ERREX(144)
- CALL CFRIBM(IPAC,NWR,2)
- DO 19 JWORD=1,NWR
- IF(IPAC(JWORD).NE.ICALL) CALL ERREX(145)
- 19 CONTINUE
- CALL EPREAD(11,20,NWR,IPAC,IBUF11,IERR)
- IF(IERR.NE.1) CALL ERREX(146)
- CALL EPRWND(11,IBUF11,IERR)
- IF(IERR.NE.0) CALL ERREX(147)
- NWSS=500
- ICALL=1
- CALL EPREAD(11,1,NWR,IPAC,IBUF11,IERR)
- IF(IERR.NE.0) CALL ERREX(254)
- NWR=NWR/2
- IF(NWR.NE.NWSS) CALL ERREX(255)
- CALL BLO32W(IPAC,1,IDAT,1,NWR)
- CALL CFRIBM(IDAT,NWR,2)
- DO 21 JWORD=1,NWR
- IF(IDAT(JWORD).NE.ICALL) CALL ERREX(256)
- 21 CONTINUE
- ICALL=2
- CALL EPREAD(11,2,NWR,IPAC,IBUF11,IERR)
- IF(IERR.NE.0) CALL ERREX(260)
- IF(NWR.NE.NWSS) CALL ERREX(261)
- DO 22 JWORD=1,NWR
- IF(IPAC(JWORD).NE.ICALL) CALL ERREX(262)
- 22 CONTINUE
- ICALL=3
- CALL EPREAD(11,3,NWR,IPAC,IBUF11,IERR)
- IF(IERR.NE.0) CALL ERREX(266)
- IF(NWR.NE.NWSS) CALL ERREX(267)
- CALL CFRIBM(IPAC,NWR,2)
- DO 23 JWORD=1,NWR
- IF(IPAC(JWORD).NE.ICALL) CALL ERREX(268)
- 23 CONTINUE
- ICALL=4
- NWSS=NWPR1
- CALL EPREAD(11,2,NWR,IPAC,IBUF11,IERR)
- IF(IERR.NE.0) CALL ERREX(272)
- IF(NWR.NE.NWSS) CALL ERREX(273)
- DO 24 JWORD=1,NWR
- IF(IPAC(JWORD).NE.ICALL) CALL ERREX(274)
- 24 CONTINUE
- ICALL=5
- NWSS=1
- CALL EPREAD(11,2,NWR,IPAC,IBUF11,IERR)
- IF(IERR.NE.0) CALL ERREX(277)
- IF(NWR.NE.1) CALL ERREX(278)
- IF(IPAC(1).NE.ICALL) CALL ERREX(279)
- ICALL=6
- NWSS=NWPR2
- CALL EPREAD(11,2,NWR,IPAC,IBUF11,IERR)
- IF(IERR.NE.0) CALL ERREX(282)
- IF(NWR.NE.NWSS) CALL ERREX(283)
- DO 25 JWORD=1,NWR
- IF(IPAC(JWORD).NE.ICALL) CALL ERREX(284)
- 25 CONTINUE
- ICALL=7
- NWSS=NWPR3
- CALL EPREAD(11,2,NWR,IPAC,IBUF11,IERR)
- IF(IERR.NE.0) CALL ERREX(287)
- IF(NWR.NE.NWSS) CALL ERREX(288)
- DO 26 JWORD=1,NWR
- IF(IPAC(JWORD).NE.ICALL) CALL ERREX(289)
- 26 CONTINUE
- ICALL=8
- NWSS=1000
- CALL EPREAD(11,2,NWR,IPAC,IBUF11,IERR)
- IF(IERR.NE.0) CALL ERREX(293)
- IF(NWR.NE.NWSS) CALL ERREX(294)
- DO 27 JWORD=1,NWR
- IF(IPAC(JWORD).NE.ICALL) CALL ERREX(295)
- 27 CONTINUE
- ICALL=9
- NWSS=NWPR4
- CALL EPREAD(11,3,NWR,IPAC,IBUF11,IERR)
- IF(IERR.NE.0) CALL ERREX(298)
- IF(NWR.NE.NWSS) CALL ERREX(299)
- CALL CFRIBM(IPAC,NWR,2)
- DO 28 JWORD=1,NWR
- IF(IPAC(JWORD).NE.ICALL) CALL ERREX(240)
- 28 CONTINUE
- NWSS=100
- ICALL=10
- CALL EPREAD(11,3,NWR,IPAC,IBUF11,IERR)
- IF(IERR.NE.0) CALL ERREX(243)
- IF(NWR.NE.NWSS) CALL ERREX(244)
- CALL CFRIBM(IPAC,NWR,2)
- DO 29 JWORD=1,NWR
- IF(IPAC(JWORD).NE.ICALL) CALL ERREX(245)
- 29 CONTINUE
- CALL EPREAD(11,1,NWR,IPAC,IBUF11,IERR)
- IF(IERR.NE.1) CALL ERREX(246)
- CALL EPRWND(11,IBUF11,IERR)
- IF(IERR.NE.0) CALL ERREX(247)
- ICALL=1
- CALL EPREAD(11,20,NWR,IPAC,IBUF11,IERR)
- IF(IERR.NE.0) CALL ERREX(351)
- IF(NWR.NE.9) CALL ERREX(352)
- IF(IPAC(8).NE.ICALL) CALL ERREX(353)
- ICALL=2
- CALL EPREAD(11,20,NWR,IPAC,IBUF11,IERR)
- IF(IERR.NE.0) CALL ERREX(357)
- IF(NWR.NE.9) CALL ERREX(358)
- IF(IPAC(8).NE.ICALL) CALL ERREX(359)
- ICALL=3
- CALL EPREAD(11,20,NWR,IPAC,IBUF11,IERR)
- IF(IERR.NE.0) CALL ERREX(363)
- IF(NWR.NE.9) CALL ERREX(364)
- IF(IPAC(8).NE.ICALL) CALL ERREX(365)
- ICALL=4
- NWSS=NWPR1
- CALL EPREAD(11,20,NWR,IPAC,IBUF11,IERR)
- IF(IERR.NE.0) CALL ERREX(369)
- IF(NWR.NE.9) CALL ERREX(370)
- IF(IPAC(8).NE.ICALL) CALL ERREX(371)
- ICALL=5
- NWSS=1
- CALL EPREAD(11,2,NWR,IPAC,IBUF11,IERR)
- IF(IERR.NE.0) CALL ERREX(377)
- IF(NWR.NE.1) CALL ERREX(378)
- IF(IPAC(1).NE.ICALL) CALL ERREX(379)
- ICALL=6
- NWSS=NWPR2
- CALL EPREAD(11,20,NWR,IPAC,IBUF11,IERR)
- IF(IERR.NE.0) CALL ERREX(380)
- IF(NWR.NE.4) CALL ERREX(381)
- ICALL=7
- NWSS=NWPR3
- CALL EPREAD(11,20,NWR,IPAC,IBUF11,IERR)
- IF(IERR.NE.0) CALL ERREX(385)
- IF(NWR.NE.4) CALL ERREX(386)
- ICALL=8
- NWSS=1000
- CALL EPREAD(11,2,NWR,IPAC,IBUF11,IERR)
- IF(IERR.NE.0) CALL ERREX(393)
- IF(NWR.NE.NWSS) CALL ERREX(394)
- DO 37 JWORD=1,NWR
- IF(IPAC(JWORD).NE.ICALL) CALL ERREX(395)
- 37 CONTINUE
- ICALL=9
- NWSS=NWPR4
- CALL EPREAD(11,20,NWR,IPAC,IBUF11,IERR)
- IF(IERR.NE.0) CALL ERREX(396)
- IF(NWR.NE.4) CALL ERREX(397)
- NWSS=100
- ICALL=10
- CALL EPREAD(11,3,NWR,IPAC,IBUF11,IERR)
- IF(IERR.NE.0) CALL ERREX(343)
- IF(NWR.NE.NWSS) CALL ERREX(344)
- CALL CFRIBM(IPAC,NWR,2)
- DO 39 JWORD=1,NWR
- IF(IPAC(JWORD).NE.ICALL) CALL ERREX(345)
- 39 CONTINUE
- CALL EPREAD(11,20,NWR,IPAC,IBUF11,IERR)
- IF(IERR.NE.1) CALL ERREX(346)
- CALL EPRWND(11,IBUF11,IERR)
- IF(IERR.NE.0) CALL ERREX(347)
- RETURN
- END
-#endif
diff --git a/src/packlib/epio/tests/ptest3/test1.F b/src/packlib/epio/tests/ptest3/test1.F
deleted file mode 100644
index c36146e..0000000
--- a/src/packlib/epio/tests/ptest3/test1.F
+++ /dev/null
@@ -1,102 +0,0 @@
-*
-* $Id: test1.F,v 1.1.1.1 1996/03/08 15:21:46 mclareni Exp $
-*
-* $Log: test1.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:46 mclareni
-* Epio
-*
-*
-#if !defined(CERNLIB_ND100B16)
-#include "pilot.h"
- SUBROUTINE TEST1
-C--- WRITE A WRONG BLOCK, READ AND CHECK ERRORS
-#include "testc.inc"
-#if defined(CERNLIB_UNIVAC)
- DIMENSION NACC(2)
- DATA IUN11/'11 'F/,IEOF/'EOFM'/,IEP/'EP '/
-#endif
- NPW=2**16-1
- N16=360
- CALL VFILL(IDAT,N16,NPW)
- CALL BUN16W(IDAT,1,IPAC,1,N16)
-C--- NO. OF BITS
- CALL EPGETC(N,IDAT)
- NBIT=IDAT(4)
- NW=(N16*16)/NBIT
-#if defined(CERNLIB_CDC)||defined(CERNLIB_CRAY)
- BUFFER OUT (11,1) (IPAC(1),IPAC(NW))
- IF(UNIT(11).GT.0.) STOP 20
- REWIND 11
-#endif
-#if defined(CERNLIB_IBM)||defined(CERNLIB_NORD)
- CALL IORITE(11,IPAC,4*NW,IRET)
- IF(IRET.NE.0) CALL ERREX(16)
- CALL IORWND(11,IRET)
- IF(IRET.NE.0) CALL ERREX(17)
-#endif
-#if defined(CERNLIB_VAX)
- OPEN(11,NAME='FOR011',TYPE='NEW',FORM='UNFORMATTED',
- 1 RECORDTYPE='FIXED',RECL=900,BLOCKSIZE=3600)
- WRITE(11) (IPAC(I),I=1,NW)
- CLOSE(11)
-#endif
-#if defined(CERNLIB_APOLLO)
- OPEN(
- 1 UNIT=11,
- 2 FILE='FOR011.DAT',
- 3 FORM='UNFORMATTED',
-#endif
-#if (defined(CERNLIB_APOLLO))&&(defined(CERNLIB_APOMAG))
- 4 STATUS='WRITE')
-#endif
-#if (defined(CERNLIB_APOLLO))&&(!defined(CERNLIB_APOMAG))
- 4 STATUS='NEW',
- 5 RECL=900)
-#endif
-#if defined(CERNLIB_APOLLO)
- WRITE(11) (IPAC(I),I=1,NW)
- CLOSE(11)
-#endif
-#if defined(CERNLIB_STF77)||defined(CERNLIB_STF77VX)
-C For Unix use Fortran open in EPOPEN to avoid portability problems
-C and set same blocksize for epread.
- CALL EPSETW(11,1,N16,IERR)
- CALL EPOPEN(1,IERR)
- WRITE(11) (IPAC(I),I=1,NW)
- CLOSE(11)
-#endif
-#if defined(CERNLIB_VAXMAG)
- CALL EPREAD(11,1,NW,IDAT,IBUF11,IERR)
- CALL EPMTREW(IERR)
-#endif
-#if defined(CERNLIB_UNIVAC)
- IOD=IODEV('11 ')
- IF(IOD.GE.16) THEN
- BITS(IEP,19,18)=NW
- NACC(1)=2**18+LOC(IEP)
- NACC(2)=NW*2**18+LOC(IPAC)
- CALL FIOGW(IUN11,NACC,2,0,ISTAT)
- IAD=(NW+28)/28
- CALL FIOW(IUN11,IEOF,1,IAD,ISTAT)
- ELSE
- CALL FIOW(IUN11,IPAC,NW,0,ISTAT)
- CALL TIOWEF(IUN11,ISTAT)
- CALL TIOREW(IUN11,ISTAT)
- ENDIF
-#endif
- CALL EPREAD(11,1,NW,IDAT,IBUF11,IERR)
- IF(IERR.NE.4.AND.IERR.NE.5) CALL ERREX(18)
- CALL EPREAD(11,1,NW,IDAT,IBUF11,IERR)
- IF(IERR.NE.1) CALL ERREX(19)
- CALL EPRWND(11,IBUF11,IERR)
- IF(IERR.NE.0) CALL ERREX(20)
-#if (defined(CERNLIB_VAX)||defined(CERNLIB_APOLLO))&&(!defined(CERNLIB_VAXMAG))
- CLOSE (11)
-#endif
-#if defined(CERNLIB_STF77)||defined(CERNLIB_STF77VX)
-C Reset the blocksize for the main tests.
- CALL EPSETW(11,1,1800,IERR)
-#endif
- RETURN
- END
-#endif
diff --git a/src/packlib/epio/tests/ptest3/test2.F b/src/packlib/epio/tests/ptest3/test2.F
deleted file mode 100644
index 52c52d7..0000000
--- a/src/packlib/epio/tests/ptest3/test2.F
+++ /dev/null
@@ -1,117 +0,0 @@
-*
-* $Id: test2.F,v 1.1.1.1 1996/03/08 15:21:46 mclareni Exp $
-*
-* $Log: test2.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:46 mclareni
-* Epio
-*
-*
-#if !defined(CERNLIB_ND100B16)
-#include "pilot.h"
- SUBROUTINE TEST2
-C--- READS AND CHECKS 11, 12, 13,
-C--- 11 WITH TOO SHORT BUFFER FOR P.H. AND L.H.,
-C--- 12 WITH TOO SHORT DATA BUFFER
-#include "testc.inc"
- NCUTH=8
- NCUTD=100
- DO 101 I=1,10
- CALL EPREAD(11,30,NWR,IPAC,IBUF11,IERR)
- IF(IERR.NE.0) CALL ERREX(39)
-#if defined(CERNLIB_PH32BIT)
- IF(2*NWR.NE.IPAC(12)) CALL ERREX(40)
-#endif
-#if !defined(CERNLIB_PH32BIT)
- IF(NWR.NE.IPAC(12)) CALL ERREX(40)
-#endif
- PRINT 2001,NWR,(IPAC(JJ),JJ=1,NWR)
- 101 CONTINUE
- DO 103 I=1,10
- CALL EPREAD(11,20,NWR,IPAC,IBUF11,IERR)
- IF(IERR.NE.0) CALL ERREX(41)
- ICALL=IPAC(8)
- MODE=IPAC(9)
- CALL EPREAD(11,10+MODE,NWR,IPAC,IBUF11,IERR)
- IF(IERR.NE.0) CALL ERREX(42)
- CALL EPGETW(11,3,J,IERR)
- IF(MODE.EQ.1) NWR=(NWR*J)/32
- IF(NWR.NE.NWOUT) CALL ERREX(43)
- IF(MODE.EQ.1) CALL BLO32W(IPAC,1,IDAT,1,NWR)
- IF(MODE.NE.1) CALL UCOPY(IPAC,IDAT,NWR)
- DO 102 JWORD=1,NWR
- IF(IDAT(JWORD).NE.ICALL) CALL ERREX(44)
- 102 CONTINUE
- 103 CONTINUE
- CALL EPSETW(11,26,NCUTH,IERR)
- IF(IERR.NE.0) CALL ERREX(37)
- CALL EPSETW(12,2,NCUTD,IERR)
- IF(IERR.NE.0) CALL ERREX(38)
- DO 104 I=1,10
- CALL EPREAD(11,30,NWR,IPAC,IBUF11,IERR)
- IF(IERR.NE.6) CALL ERREX(45)
- IF(NWR.NE.NCUTH) CALL ERREX(46)
- PRINT 2001,NWR,(IPAC(JJ),JJ=1,NWR)
- 104 CONTINUE
- CALL EPRWND(11,IBUF11,IERR)
- IF(IERR.NE.0) CALL ERREX(47)
- ICALL2=0
- DO 1 ITIMES=1,2
- ICALL=0
- DO 10 ILWORD=16,32,16
- DO 11 ISPAN=1,1
- DO 12 IPAD=1,3
- DO 13 MODE=1,3
- DO 14 JREC=1,NREC
- CALL EPSETW(11,26,NCUTH,IERR)
- CALL EPREAD(11,20,NWR,IPAC,IBUF11,IERR)
- ICALL=ICALL+1
- ICALL2=ICALL2+1
- IF(IERR.NE.6) CALL ERREX(48)
- IF(IPAC(4).NE.ICALL2) CALL ERREX(49)
- CALL EPSETW(11,2,9999,IERR)
- CALL EPREAD(11,10+MODE,NWR,IPAC,IBUF11,IERR)
- IF(IERR.NE.0) CALL ERREX(50)
- IF(DBUGFL) CALL EPSTAT
- CALL EPGETW(11,3,J,IERR)
- IF(MODE.EQ.1) NWR=(NWR*J)/32
- IF(NWR.NE.NWOUT) CALL ERREX(51)
- IF(MODE.EQ.1) CALL BLO32W(IPAC,1,IDAT,1,NWOUT)
- IF(MODE.NE.1) CALL UCOPY(IPAC,IDAT,NWOUT)
- DO 15 JWORD=1,NWOUT
- IF(IDAT(JWORD).NE.ICALL) CALL ERREX(58)
- 15 CONTINUE
- CALL EPREAD(12,MODE,NWR,IPAC,IBUF12,IERR)
- IF(IERR.NE.6) CALL ERREX(52)
- CALL EPGETW(12,3,J,IERR)
- IF(MODE.EQ.1) NWR=(NWR*J)/32
- IF(MODE.EQ.1) CALL BLO32W(IPAC,1,IDAT,1,NWR)
- IF(MODE.NE.1) CALL UCOPY(IPAC,IDAT,NWR)
- DO 17 JWORD=1,NWR
- IF(IDAT(JWORD).NE.ICALL) CALL ERREX(54)
- 17 CONTINUE
- CALL EPREAD(13,MODE,NWR,IPAC,IBUF13,IERR)
- IF(IERR.NE.0) CALL ERREX(55)
- CALL EPGETW(13,3,J,IERR)
- IF(MODE.EQ.1) NWR=(NWR*J)/32
- IF(NWR.NE.NWOUT) CALL ERREX(56)
- IF(MODE.EQ.1) CALL BLO32W(IPAC,1,IDAT,1,NWR)
- IF(MODE.NE.1) CALL UCOPY(IPAC,IDAT,NWR)
- DO 18 JWORD=1,NWR
- IF(IDAT(JWORD).NE.ICALL) CALL ERREX(57)
- 18 CONTINUE
- 14 CONTINUE
- 13 CONTINUE
- 12 CONTINUE
- 11 CONTINUE
- 10 CONTINUE
- CALL EPSTAT
- 1 CONTINUE
- RETURN
-#if !defined(CERNLIB_CDC)
-2001 FORMAT(' HEADER, NW AND CONTENTS =',7I7,2I12,4I7)
-#endif
-#if defined(CERNLIB_CDC)
-2001 FORMAT(" HEADER, NW AND CONTENTS =",7I7,2I12,4I7)
-#endif
- END
-#endif
diff --git a/src/packlib/epio/tests/ptest3/testc.inc b/src/packlib/epio/tests/ptest3/testc.inc
deleted file mode 100644
index 1b7e24b..0000000
--- a/src/packlib/epio/tests/ptest3/testc.inc
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: testc.inc,v 1.1.1.1 1996/03/08 15:21:46 mclareni Exp $
-*
-* $Log: testc.inc,v $
-* Revision 1.1.1.1 1996/03/08 15:21:46 mclareni
-* Epio
-*
-*
-*
-* testc.inc
-*
-#if !defined(CERNLIB_ND100B16)
- COMMON//NWOUT,NREC,IERR,NH,NPASS,ILWORD,ISPAN,IPAD,JREC,
- + NWPR1,NWPR2,NWPR3,NWPR4,
- 1 NBIT,ICALL,JWORD,IBUF11(1000),IBUF12(1000),IBUF13(1000),
- 2 IDAT(2000),IPAC(2000),IH(10)
- COMMON/EPDBGC/DBUGFL
- LOGICAL DBUGFL
-#endif
diff --git a/src/packlib/epio/tests/ptest3/wr11.F b/src/packlib/epio/tests/ptest3/wr11.F
deleted file mode 100644
index 410614b..0000000
--- a/src/packlib/epio/tests/ptest3/wr11.F
+++ /dev/null
@@ -1,53 +0,0 @@
-*
-* $Id: wr11.F,v 1.1.1.1 1996/03/08 15:21:46 mclareni Exp $
-*
-* $Log: wr11.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:46 mclareni
-* Epio
-*
-*
-#if !defined(CERNLIB_ND100B16)
-#include "pilot.h"
- SUBROUTINE WR11
-C--- WRITES TEST DATA
-#include "testc.inc"
- ICALL=0
- LUNIT=11
- CALL EPSTAT
- DO 10 ILWORD=16,32,16
- CALL EPSETW(LUNIT,3,ILWORD,IERR)
- IF(IERR.NE.0) CALL ERREX(21)
- DO 11 ISPAN=1,1
- DO 12 IPAD=1,3
-#if (!defined(CERNLIB_STF77))&&(!defined(CERNLIB_STF77VX))
- CALL EPSETW(LUNIT,8,10*(ISPAN-1)+IPAD,IERR)
-#endif
-#if defined(CERNLIB_STF77)||defined(CERNLIB_STF77VX)
- CALL EPSETW(LUNIT,8,10*(ISPAN-1)+ 1 ,IERR)
-#endif
- IF(IERR.NE.0) CALL ERREX(22)
- DO 13 MODE=1,3
- N=NWOUT
- IF(MODE.EQ.1.AND.ILWORD.EQ.16) N=2*NWOUT
- DO 14 JREC=1,NREC
- IH(9)=MODE
- ICALL=ICALL+1
- IH(8)=ICALL
- CALL VFILL(IDAT,NWOUT,ICALL)
- IF(MODE.EQ.1) CALL BUN32W(IDAT,1,IPAC,1,NWOUT)
- IF(MODE.NE.1) CALL UCOPY(IDAT,IPAC,NWOUT)
- CALL EPOUTL(LUNIT,MODE,NH,IH,N,IPAC,IBUF11,IERR)
- IF(IERR.NE.0) CALL ERREX(23)
- 14 CONTINUE
- 13 CONTINUE
- CALL EPCLOS(LUNIT,IBUF11,IERR)
- IF(IERR.NE.0) CALL ERREX(24)
- 12 CONTINUE
- 11 CONTINUE
- 10 CONTINUE
-C--- DUMMY CALL FOR TEST
- CALL EPCLOS(LUNIT,IBUF11,IERR)
- CALL EPSTAT
- RETURN
- END
-#endif
diff --git a/src/packlib/epio/tests/ptest4/Imakefile b/src/packlib/epio/tests/ptest4/Imakefile
deleted file mode 100644
index 121dfae..0000000
--- a/src/packlib/epio/tests/ptest4/Imakefile
+++ /dev/null
@@ -1,2 +0,0 @@
-SRCS_F= ratest.F rdtest.F wrtest.F
-
diff --git a/src/packlib/epio/tests/ptest4/craytest.jcl b/src/packlib/epio/tests/ptest4/craytest.jcl
deleted file mode 100644
index eebca81..0000000
--- a/src/packlib/epio/tests/ptest4/craytest.jcl
+++ /dev/null
@@ -1,50 +0,0 @@
-*
-* $Id: craytest.jcl,v 1.1.1.1 1996/03/08 15:21:46 mclareni Exp $
-*
-* $Log: craytest.jcl,v $
-* Revision 1.1.1.1 1996/03/08 15:21:46 mclareni
-* Epio
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_epio/pilot.h"
-#if defined(CERNLIB_NEVER)
-# USER=..... PW=.
-# QSUB-r rftest
-#
-set -xS
-CHARON=/u/v6/charon
-cat > rftst1.f <<\EOF
-#
-# implement WRTEST here
-#
-EOF
-cft77 -eh -b rftst1.o rftst1.f
-cernlib
-segldr -o rftst1.a rftst1.o LIB$
-#
-# !!! very important - make binary file type 'sbin' via -s sbin !!!
-#
-assign -a rftest.data -s sbin fort.11
-rftst1.a
-cat > rftst2.f <<\EOF
-#
-# implement RDTEST here
-#
-EOF
-cft77 -eh -b rftst2.o rftst2.f
-segldr -o rftst2.a rftst2.o LIB$
-assign -a rftest.data -s sbin fort.11
-assign -a rftest.sqnm fort.22
-rftst2.a
-cat > rftst3.f <<\EOF
-#
-# implement RATEST here
-#
-EOF
-cft77 -eh -b rftst3.o rftst3.f
-segldr -o rftst3.a rftst3.o LIB$
-assign -a rftest.data -s sbin fort.11
-assign -a rftest.sqnm fort.22
-rftst3.a
-#endif
diff --git a/src/packlib/epio/tests/ptest4/mvstest.jcl b/src/packlib/epio/tests/ptest4/mvstest.jcl
deleted file mode 100644
index f22d571..0000000
--- a/src/packlib/epio/tests/ptest4/mvstest.jcl
+++ /dev/null
@@ -1,57 +0,0 @@
-*
-* $Id: mvstest.jcl,v 1.1.1.1 1996/03/08 15:21:46 mclareni Exp $
-*
-* $Log: mvstest.jcl,v $
-* Revision 1.1.1.1 1996/03/08 15:21:46 mclareni
-* Epio
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_epio/pilot.h"
-#if defined(CERNLIB_NEVER)
-// JOB
-//
-// first job
-//
-// EXEC JFORTCG
-//C.SYSIN DD *
-//
-// implement WRTEST here
-//
-//G.IOFILE11 DD DSN=gg.uuu.TESTDFIX,DISP=(NEW,CATLG,DELETE),
-// SPACE=(TRK,(20,20),RLSE),DCB=(RECFM=F,BLKSIZE=3600,LRECL=3600),
-// UNIT=SYSDA
-//
-// end of first job
-//
-// JOB
-//
-// second job
-//
-// EXEC JFORTCG
-//C.SYSIN DD *
-//
-// implement RDTEST here
-//
-//G.IOFILE11 DD DSN=gg.uuu.TESTDFIX,DISP=SHR
-//G.FT22F001 DD DSN=gg.uuu.TESTLIST,
-// DISP=(NEW,CATLG,DELETE),
-// DCB=(RECFM=FB,LRECL=80,BLKSIZE=6000),
-// SPACE=(TRK,(10,10),RLSE),UNIT=SYSDA
-//
-// end of second job
-//
-// JOB
-//
-// third job
-//
-// EXEC JFORTCG
-//C.SYSIN DD *
-//
-// implement RATEST here
-//
-//G.FT22F001 DD DSN=gg.uuu.TESTLIST,DISP=SHR
-//
-// end of third job
-//
-#endif
diff --git a/src/packlib/epio/tests/ptest4/ratest.F b/src/packlib/epio/tests/ptest4/ratest.F
deleted file mode 100644
index ba7330d..0000000
--- a/src/packlib/epio/tests/ptest4/ratest.F
+++ /dev/null
@@ -1,89 +0,0 @@
-*
-* $Id: ratest.F,v 1.1.1.1 1996/03/08 15:21:46 mclareni Exp $
-*
-* $Log: ratest.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:46 mclareni
-* Epio
-*
-*
- PROGRAM RATEST
-*
-*--- Step 3: read in random access
-*
- DIMENSION IHEAD(4),IW(31),IOUT(3000),IBUF(5000)
- DIMENSION IB(100),IP(100)
- DATA LUN/11/,MODE/3/,MULT/100/,MB/0/
-
- PRINT 10000
-10000 FORMAT(//' ++++++++++++ EPIO random access test',
- + ' ++++++++++++'//
- + ' pass 3 starting execution'/)
-
- CALL EPINIT
- NR=0
-#if defined(CERNLIB_IBMMVS)
- OPEN(LUN,FILE='gg.uuu.TESTDFIX',
- +STATUS='OLD',ACCESS='DIRECT',RECL=3600)
-#endif
-#if defined(CERNLIB_IBM)
-C CALL VMCMS('FI RNDFILE DISK RANTEST DATA A (RECFM F '//
-C +'BLKSIZE 3600 XTENT 99999',IVMERR)
- OPEN(LUN,FILE='/RANTEST DATA A',STATUS='OLD',ACCESS='DIRECT',
- +RECL=3600)
-#endif
-#if defined(CERNLIB_CRAY)
- OPEN(LUN,FILE='rftest.data',STATUS='OLD',ACCESS='DIRECT',
- +RECL=3600,IOSTAT=IOS)
-#endif
-#if defined(CERNLIB_VAX)
- OPEN(LUN,FILE='TEST.DATA',STATUS='OLD',ACCESS='DIRECT',
- +RECL=900)
-#endif
-*--- read block numbers and off-sets from file created in step 2
- READ(22,*) MB,(IB(I),IP(I),I=1,MB)
-*--- first read (in inverse order) five records (except from the last
-* block) starting from the record the off-set of which has been kept
-* (I.e. to read one record one needs first a call to EPDACR and then
-* a call to EPREAD, as below).
- DO 10 I=MB,1,-1
- CALL EPDACR(LUN,IB(I),IP(I),IERR)
- IF(IERR.NE.0) THEN
- PRINT *,' EPDACR error'
- GOTO 100
- ENDIF
- IF(I.EQ.MB) THEN
- NUP=1
- ELSE
- NUP=5
- ENDIF
- DO 20 J=1,NUP
- CALL EPREAD(LUN,MODE,NW,IOUT,IBUF,IERR)
- IF(IERR.NE.0) GOTO 100
- NR=5*(I-1)+J
-*
-*--- the code following below only checks the record contents
-*
- PRINT *,' NR, NW, 5 words: ',NR,NW,(IOUT(K),K=1,5)
- IF(NW.NE.NR*MULT) THEN
- PRINT *,' wrong length: ',NW,' at record: ',NR
- GOTO 100
- ENDIF
- DO 30 K=1,NW
- IF(IOUT(K).NE.NR) THEN
- PRINT *,' wrong contents: ',IOUT(K),' record: ',NR,
- + ' word: ',K
- GOTO 100
- ENDIF
- 30 CONTINUE
- 20 CONTINUE
- 10 CONTINUE
- 100 CONTINUE
- IF(IERR.LE.1) THEN
- PRINT 10010
-10010 FORMAT(//' ------------ EPIO random access test',
- + ' ------------'//
- + ' pass 3 terminating - all done'/)
- ELSE
- PRINT *,' ********** STOP because of EPIO error.'
- ENDIF
- END
diff --git a/src/packlib/epio/tests/ptest4/rdtest.F b/src/packlib/epio/tests/ptest4/rdtest.F
deleted file mode 100644
index 9de5046..0000000
--- a/src/packlib/epio/tests/ptest4/rdtest.F
+++ /dev/null
@@ -1,56 +0,0 @@
-*
-* $Id: rdtest.F,v 1.1.1.1 1996/03/08 15:21:46 mclareni Exp $
-*
-* $Log: rdtest.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:46 mclareni
-* Epio
-*
-*
- PROGRAM RDTEST
-*
-*--- Step 2: scan for block count and off-set, write onto unit 22
-*
- DIMENSION IHEAD(4),IW(31),IOUT(3000),IBUF(5000)
- DIMENSION IB(100),IP(100)
- DATA LUN/11/,MODE/20/,MULT/100/,MB/0/
-
- PRINT 10000
-10000 FORMAT(//' ++++++++++++ EPIO random access test',
- + ' ++++++++++++'//
- + ' pass 2 starting execution'/)
-
- CALL EPINIT
- NR=0
-#if defined(CERNLIB_VAX)
- CALL EPDEFU(LUN,'TEST.DATA',IERR)
-#endif
- 10 CONTINUE
- CALL EPREAD(LUN,MODE,NW,IOUT,IBUF,IERR)
- IF(IERR.NE.0) GOTO 100
- NR=NR+1
- 20 CONTINUE
- CALL EPGETA(LUN,31,IW,IERR)
- PRINT *,(IOUT(J),J=1,NW)
- IF(IOUT(2).EQ.1) THEN
- MB=MB+1
-*--- get block count
- IB(MB)=IW(11)
-*--- get record off-set in block
- IP(MB)=IW(31)
- ENDIF
- PRINT *,NR,IW(11),IW(12),IW(22),IW(23),IW(31)
- GOTO 10
- 100 CONTINUE
- IF(IERR.EQ.1) THEN
- PRINT 10010
-10010 FORMAT(//' ------------ EPIO random access test',
- + ' ------------'//
- + ' pass 2 terminates.'/)
-*
-*--- write block numbers and off-sets on a temporary file
-*
- WRITE(22,*) MB,(IB(I),IP(I),I=1,MB)
- ELSE
- PRINT *,' ********** STOP because of EPIO error.'
- ENDIF
- END
diff --git a/src/packlib/epio/tests/ptest4/vaxtest.jcl b/src/packlib/epio/tests/ptest4/vaxtest.jcl
deleted file mode 100644
index c6f9423..0000000
--- a/src/packlib/epio/tests/ptest4/vaxtest.jcl
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: vaxtest.jcl,v 1.1.1.1 1996/03/08 15:21:46 mclareni Exp $
-*
-* $Log: vaxtest.jcl,v $
-* Revision 1.1.1.1 1996/03/08 15:21:46 mclareni
-* Epio
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_epio/pilot.h"
-#if defined(CERNLIB_NEVER)
-*
-* Most easy - just compile, link, and execute WRTEST, RDTEST,
-* and RATEST below, in this order.
-*
-#endif
diff --git a/src/packlib/epio/tests/ptest4/vmtest.jcl b/src/packlib/epio/tests/ptest4/vmtest.jcl
deleted file mode 100644
index 0cc46be..0000000
--- a/src/packlib/epio/tests/ptest4/vmtest.jcl
+++ /dev/null
@@ -1,39 +0,0 @@
-*
-* $Id: vmtest.jcl,v 1.1.1.1 1996/03/08 15:21:46 mclareni Exp $
-*
-* $Log: vmtest.jcl,v $
-* Revision 1.1.1.1 1996/03/08 15:21:46 mclareni
-* Epio
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_epio/pilot.h"
-#if defined(CERNLIB_NEVER)
-/* EXEC file to test EPIO random access reading of records */
-
-/* Compile the 3 parts */
-'VFORT EPWRTEST (NOPRINT'
-'VFORT EPRDTEST (NOPRINT'
-'VFORT EPRATEST (NOPRINT'
-
-/* Remove previous files */
-
-ERASE RANTEST DATA A
-ERASE RANTEST REFTABLE A
-
-/* part 1: create a binary EPIO output file */
-
-'FI IOFILE11 DISK RANTEST DATA A (BLKSIZE 3600 RECFM F'
-'LOAD EPWRTEST EPIONEW (START NOAUTO'
-
-/* part 2: read file back, write record/block reference table */
-
-FI 22 DISK RANTEST REFTABLE A
-'LOAD EPRDTEST EPIONEW (START NOAUTO'
-
-/* part 3: read in random acces, check */
-
-'LOAD EPRATEST EPIONEW (START NOAUTO'
-
-EXIT
-#endif
diff --git a/src/packlib/epio/tests/ptest4/wrtest.F b/src/packlib/epio/tests/ptest4/wrtest.F
deleted file mode 100644
index 53d224e..0000000
--- a/src/packlib/epio/tests/ptest4/wrtest.F
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: wrtest.F,v 1.1.1.1 1996/03/08 15:21:46 mclareni Exp $
-*
-* $Log: wrtest.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:46 mclareni
-* Epio
-*
-*
- PROGRAM WRTEST
-*
-*--- Step 1: create EPIO file
-*
- DIMENSION IHEAD(4),IOUT(3000),IBUF(5000)
- DATA LUN/11/
-
- PRINT 10000
-10000 FORMAT(//' ++++++++++++ EPIO random access test',
- + ' ++++++++++++'//
- + ' pass 1 starting execution'/)
- CALL EPINIT
- CALL EPSETW(LUN,3,32,IERR)
- CALL EPSETW(LUN,5,-1,IERR)
-#if defined(CERNLIB_VAX)
- CALL EPDEFU(LUN,'TEST.DATA',IERR)
-#endif
- DO 10 I=1,21
- NW=100*I
- CALL VFILL(IOUT,NW,I)
- IF(MOD(I,5).EQ.1) THEN
- IHEAD(2)=1
- ELSE
- IHEAD(2)=0
- ENDIF
- CALL EPOUTL(LUN,3,4,IHEAD,NW,IOUT,IBUF,IERR)
- 10 CONTINUE
- CALL EPCLOS(LUN,IBUF,IERR)
- PRINT 10010
-10010 FORMAT(//' ------------ EPIO random access test',
- + ' ------------'//
- + ' pass 1 terminates.'/)
- END
diff --git a/src/packlib/epio/tests/t1fast/ptest1.mods b/src/packlib/epio/tests/t1fast/ptest1.mods
deleted file mode 100644
index 12644f0..0000000
--- a/src/packlib/epio/tests/t1fast/ptest1.mods
+++ /dev/null
@@ -1,37 +0,0 @@
-*
-* $Id: ptest1.mods,v 1.1.1.1 1996/03/08 15:21:46 mclareni Exp $
-*
-* $Log: ptest1.mods,v $
-* Revision 1.1.1.1 1996/03/08 15:21:46 mclareni
-* Epio
-*
-*
-* TEST ROUTINES EPFHDR AND EPFRD IN TEST 1
-* This directory was created from epio.car patch t1fast
-+ADD,PTEST1,TEST2,5
- RNDM(J)=ZSRAN(J)
-+REP,PTEST1,TEST2,19
- CALL EPFHDR(11,9,IPAC,IBUF11,IERR)
-+ADD,PTEST1,TEST2,57
- IF(ILWORD.EQ.32) GOTO 501
- XRNDM=1.
- IF(ITIMES.EQ.2) XRNDM=RNDM(J)
- IF(XRNDM.LE..5) GOTO 501
- CALL EPFHDR(11,9,IPAC,IBUF11,IERR)
- ICALL=ICALL+1
- ICALL2=ICALL2+1
- IF(IERR.NE.0) CALL ERREX(48)
- GOTO 502
- 501 CONTINUE
-+ADD,PTEST1,TEST2,62
- 502 CONTINUE
-+ADD,PTEST1,TEST2,64
- IF(ILWORD.EQ.32) GOTO 601
- XRNDM=1.
- IF(ITIMES.EQ.2) XRNDM=RNDM(J)
- IF(XRNDM.LE..5) GOTO 601
- CALL EPFRD(11,10+MODE,NWR,IPAC,IBUF11,IERR)
- GOTO 602
- 601 CONTINUE
-+ADD,PTEST1,TEST2,65
- 602 CONTINUE
diff --git a/src/packlib/epio/util/Imakefile b/src/packlib/epio/util/Imakefile
deleted file mode 100644
index 038d400..0000000
--- a/src/packlib/epio/util/Imakefile
+++ /dev/null
@@ -1,35 +0,0 @@
-
-#ifdef CERNLIB_UNIX
-#if defined(CERNLIB_DECS) || (defined(CERNLIB_LINUX) && !defined(CERNLIB_PPC)) || defined(CERNLIB_WINNT)
-F_ARCHITECTURE= blo16stv.F blo32wsv.F blo8stv.F btswpstv.F bun16stv.F \ @@\
- bun32wsv.F bun8stv.F cfribmsv.F ctoibstv.F iwd16stv.F \ @@\
- sfrascvx.F stoascvx.F w16mvstv.F
-#else
-F_ARCHITECTURE= blo16stf.F blo32wsf.F blo8stf.F btswpstf.F bun16stf.F \ @@\
- bun32wsf.F bun8stf.F cfribmsf.F ctoibstf.F iwd16stf.F \ @@\
- sfrascap.F stoascap.F w16mvstf.F
-#endif
-#endif
-#ifdef CERNLIB_VAX
-F_ARCHITECTURE= blo16wva.F blo32wva.F blo8wib.F bun16wib.F bun32wva.F \ @@\
- bun8wib.F cfribmva.F ctoibmva.F iwd16vax.F sfrascvx.F \ @@\
- stoascvx.F
-
-SRCS_S = btswapvx.s epiovax2.s mtformat.s vaxibm.s w16movvx.s
-
-#ifdef CERNLIB_QMALPH
-SRCS_S := $(SRCS_S) epioaxp.s
-#else
-SRCS_S := $(SRCS_S) epiovax.s
-#endif
-
-
-#endif
-
-SRCS_F= cfrascun.F ctoascun.F $(F_ARCHITECTURE)
-
-SubdirLibraryTarget(NullParameter,NullParameter)
-
-
-
-
diff --git a/src/packlib/epio/util/blo16stf.F b/src/packlib/epio/util/blo16stf.F
deleted file mode 100644
index ab6adec..0000000
--- a/src/packlib/epio/util/blo16stf.F
+++ /dev/null
@@ -1,56 +0,0 @@
-*
-* $Id: blo16stf.F,v 1.1.1.1 1996/03/08 15:21:47 mclareni Exp $
-*
-* $Log: blo16stf.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:47 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if (defined(CERNLIB_STF77))&&(!defined(CERNLIB_STF77VX))
- SUBROUTINE BLO16W(SOURCE,N1,TARGET,N2,N3)
- INTEGER SOURCE(*),TARGET(*)
-C
-C STANDARD FORTRAN version to do BLO16W with NO external calls.
-C
-C Input SOURCE array is a CONTIGUOUS bit string N3*16 bits long
-C starting at 16-BIT POSITION N1 in the array SOURCE.
-C This bit string is BLOWN (unpacked) into N3 computer words
-C starting at TARGET(N2). Each word of TARGET then contains
-C 16 bits, right justified.
-C
-C 16-bit word number within Computer word increases
-C as one goes from Most Significant Bit (MSB) to LSB.
-C i.e.
-C 63 48 47 32 31 16 15 0
-C -----------------------------------------------
-C | 1 | 2 | 3 | 4 |
-C -----------------------------------------------
-C
-#include "epio/wordsize.inc"
- IF(N3 .LE. 0) GO TO 999
-C
-C SOURCE word
- IWSRC = (N1-1)/N16PW
- I16SRC = N1-IWSRC*N16PW
- IWSRC = IWSRC+1
- NBITR = (N16PW-I16SRC)*16
-C
- DO 10 IWTGT=N2,N2+N3-1
-C
-C Extract 16-bit word from source
- JWD16 = ISHFT(SOURCE(IWSRC),-NBITR)
- TARGET(IWTGT) = IAND(JWD16,65535)
-C
-C
- IF(NBITR.EQ.0) THEN
- NBITR = NBITPW - 16
- IWSRC = IWSRC + 1
- ELSE
- NBITR = NBITR - 16
- ENDIF
-C
- 10 CONTINUE
-C
- 999 END
-#endif
diff --git a/src/packlib/epio/util/blo16stv.F b/src/packlib/epio/util/blo16stv.F
deleted file mode 100644
index 73121c8..0000000
--- a/src/packlib/epio/util/blo16stv.F
+++ /dev/null
@@ -1,56 +0,0 @@
-*
-* $Id: blo16stv.F,v 1.1.1.1 1996/03/08 15:21:47 mclareni Exp $
-*
-* $Log: blo16stv.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:47 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if (defined(CERNLIB_STF77VX))&&(!defined(CERNLIB_STF77))
- SUBROUTINE BLO16W(SOURCE,N1,TARGET,N2,N3)
- INTEGER SOURCE(*),TARGET(*)
-C
-C STANDARD FORTRAN Vax version to do BLO16W with NO external calls.
-C
-C Input SOURCE array is a CONTIGUOUS bit string N3*16 bits long
-C starting at 16-BIT POSITION N1 in the array SOURCE.
-C This bit string is BLOWN (unpacked) into N3 computer words
-C starting at TARGET(N2). Each word of TARGET then contains
-C 16 bits, left justified.
-C
-C 16-bit word number within Computer word increases
-C as one goes from Least Significant Bit (LSB) to MSB.
-C i.e.
-C 63 48 47 32 31 16 15 0
-C -----------------------------------------------
-C | 4 | 3 | 2 | 1 |
-C -----------------------------------------------
-C
-#include "epio/wordsize.inc"
- IF(N3 .LE. 0) GO TO 999
-C
-C SOURCE word
- IWSRC = (N1-1)/N16PW
- I16SRC = N1-IWSRC*N16PW
- IWSRC = IWSRC+1
- NBITR = (I16SRC-1)*16
-C
- DO 10 IWTGT=N2,N2+N3-1
-C
-C Extract 16-bit word from source
- JWD16 = ISHFT(SOURCE(IWSRC),-NBITR)
- TARGET(IWTGT) = IAND(JWD16,65535)
-C
-C
- IF(NBITR.EQ.NBITPW-16) THEN
- NBITR = 0
- IWSRC = IWSRC + 1
- ELSE
- NBITR = NBITR + 16
- ENDIF
-C
- 10 CONTINUE
-C
- 999 END
-#endif
diff --git a/src/packlib/epio/util/blo16wva.F b/src/packlib/epio/util/blo16wva.F
deleted file mode 100644
index 2b219f9..0000000
--- a/src/packlib/epio/util/blo16wva.F
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: blo16wva.F,v 1.1.1.1 1996/03/08 15:21:48 mclareni Exp $
-*
-* $Log: blo16wva.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:48 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_VAX)
- SUBROUTINE BLO16W(SOURCE,N1,TARGET,N2,N3)
-C.+++++++ VAX VERSION ++++++++++
-C. BLOWS (UNPACKS) 16 BIT WORDS INTO MACHINE WORDS(32 BIT).
-C.
-C. INPUT
-C. SOURCE ARRAY CONTAINING 16 BIT WORDS IN PACKED FORM
-C. N1 FIRST 16 BIT WORD IN SOURCE TO BLOW
-C. TARGET TARGET ARRAY FOR UNPACKED 16 BIT WORDS
-C. N2 TARGET(N2) WILL CONTAIN FIRST UNPACKED WORD
-C. N3 NO. OF 16 BIT WORDS TO UNPACK
- INTEGER*2 SOURCE(2),IW2(2)
- INTEGER TARGET(2)
- EQUIVALENCE (IW2(1),IW4)
- IF(N3.LE.0) GOTO 77777
- I1=N1-1
- I2=N2-1
- IW4=0
- DO 1 I=1,N3
- IW2(1)=SOURCE(I1+I)
- 1 TARGET(I2+I)=IW4
-77777 RETURN
- END
-#endif
diff --git a/src/packlib/epio/util/blo32wsf.F b/src/packlib/epio/util/blo32wsf.F
deleted file mode 100644
index e07c740..0000000
--- a/src/packlib/epio/util/blo32wsf.F
+++ /dev/null
@@ -1,66 +0,0 @@
-*
-* $Id: blo32wsf.F,v 1.1.1.1 1996/03/08 15:21:47 mclareni Exp $
-*
-* $Log: blo32wsf.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:47 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if (defined(CERNLIB_STF77))&&(!defined(CERNLIB_STF77VX))
- SUBROUTINE BLO32W(SOURCE,N1,TARGET,N2,N3)
- INTEGER SOURCE(*),TARGET(*)
-C
-C STANDARD FORTRAN version to do BLO32W with NO external calls.
-C
-C Input SOURCE array is a CONTIGUOUS bit string N3*32 bits long
-C starting at 16-BIT POSITION N1 in the array SOURCE.
-C This bit string is BLOWN (unpacked) into N3 computer words
-C starting at TARGET(N2). Each word of TARGET then contains
-C 32 bits, right justified.
-C
-C 16-bit word number within Computer word increases
-C as one goes from Most Significant Bit (MSB) to LSB.
-C i.e.
-C 63 48 47 32 31 16 15 0
-C -----------------------------------------------
-C | 1 | 2 | 3 | 4 |
-C -----------------------------------------------
-C
-#include "epio/wordsize.inc"
- IF(N3 .LE. 0) GO TO 999
-C
-C SOURCE word and 16-bit within word
- IWSRC = (N1-1)/N16PW
- I16SRC = N1-IWSRC*N16PW
- IWSRC = IWSRC+1
- NBITR = (N16PW-I16SRC)*16
-C
- DO 10 IWTGT = N2,N2+N3-1
-C
-C Extract 16-bit word from source
- TARGET(IWTGT) = ISHFT(SOURCE(IWSRC),-NBITR)
- TARGET(IWTGT) = ISHFT(IAND(TARGET(IWTGT),65535),16)
-C
- IF(NBITR.EQ.0) THEN
- NBITR = NBITPW-16
- IWSRC = IWSRC+1
- ELSE
- NBITR = NBITR-16
- ENDIF
-C
-C Extract 16-bit word from source
- JWD16 = ISHFT(SOURCE(IWSRC),-NBITR)
- TARGET(IWTGT) = IOR(IAND(JWD16,65535),TARGET(IWTGT))
-C
- IF(NBITR.EQ.0) THEN
- NBITR = NBITPW-16
- IWSRC = IWSRC+1
- ELSE
- NBITR = NBITR-16
- ENDIF
-C
- 10 CONTINUE
-C
- 999 END
-#endif
diff --git a/src/packlib/epio/util/blo32wsv.F b/src/packlib/epio/util/blo32wsv.F
deleted file mode 100644
index 55e66b1..0000000
--- a/src/packlib/epio/util/blo32wsv.F
+++ /dev/null
@@ -1,66 +0,0 @@
-*
-* $Id: blo32wsv.F,v 1.1.1.1 1996/03/08 15:21:47 mclareni Exp $
-*
-* $Log: blo32wsv.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:47 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if (defined(CERNLIB_STF77VX))&&(!defined(CERNLIB_STF77))
- SUBROUTINE BLO32W(SOURCE,N1,TARGET,N2,N3)
- INTEGER SOURCE(*),TARGET(*)
-C
-C STANDARD FORTRAN Vax version to do BLO32W with NO external calls.
-C
-C Input SOURCE array is a CONTIGUOUS bit string N3*32 bits long
-C starting at 16-BIT POSITION N1 in the array SOURCE.
-C This bit string is BLOWN (unpacked) into N3 computer words
-C starting at TARGET(N2). Each word of TARGET then contains
-C 32 bits, left justified.
-C
-C 16-bit word number within Computer word increases
-C as one goes from Least Significant Bit (LSB) to MSB.
-C i.e.
-C 63 48 47 32 31 16 15 0
-C -----------------------------------------------
-C | 4 | 3 | 2 | 1 |
-C -----------------------------------------------
-C
-#include "epio/wordsize.inc"
- IF(N3 .LE. 0) GO TO 999
-C
-C SOURCE word and 16-bit within word
- IWSRC = (N1-1)/N16PW
- I16SRC = N1-IWSRC*N16PW
- IWSRC = IWSRC+1
- NBITR = (I16SRC-1)*16
-C
- DO 10 IWTGT = N2,N2+N3-1
-C
-C Extract 16-bit word from source
- TARGET(IWTGT) = ISHFT(SOURCE(IWSRC),-NBITR)
- TARGET(IWTGT) = IAND(TARGET(IWTGT),65535)
-C
- IF(NBITR.EQ.NBITPW-16) THEN
- NBITR = 0
- IWSRC = IWSRC+1
- ELSE
- NBITR = NBITR+16
- ENDIF
-C
-C Extract 16-bit word from source
- JWD16 = ISHFT(SOURCE(IWSRC),-NBITR)
- TARGET(IWTGT) = IOR(ISHFT(IAND(JWD16,65535),16),TARGET(IWTGT))
-C
- IF(NBITR.EQ.NBITPW-16) THEN
- NBITR = 0
- IWSRC = IWSRC+1
- ELSE
- NBITR = NBITR+16
- ENDIF
-C
- 10 CONTINUE
-C
- 999 END
-#endif
diff --git a/src/packlib/epio/util/blo32wva.F b/src/packlib/epio/util/blo32wva.F
deleted file mode 100644
index 81d6154..0000000
--- a/src/packlib/epio/util/blo32wva.F
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: blo32wva.F,v 1.1.1.1 1996/03/08 15:21:48 mclareni Exp $
-*
-* $Log: blo32wva.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:48 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_VAX)||defined(CERNLIB_APOLLO)
- SUBROUTINE BLO32W(SOURCE,N1,TARGET,N2,N3)
-C.+++++++ VAX AND APOLLO VERSION ++++++++++
-C. NO SWAPPING IS DONE HERE
-C. MOVES 32 BIT WORDS INTO 32 BIT WORDS. STARTS ON ANY
-C. 16 BIT WORD IN SOURCE.
-C.
-C. +++ IMPORTANT +++ COUNTS PARTLY IN 16 BIT WORDS
-C.
-C. INPUT
-C. SOURCE SOURCE ARRAY
-C. N1 FIRST 16 BIT WORD IN SOURCE
-C. TARGET TARGET ARRAY
-C. N2 FIRST COPIED WORD IS TARGET(N2)
-C. N3 NO. OF WORDS TO COPY
- INTEGER*2 SOURCE(1),TARGET(1)
- DO 10 I=1,N3
- TARGET(2*N2-3+2*I) = SOURCE(N1+2*I-2)
- TARGET(2*N2-2+2*I) = SOURCE(N1+2*I-1)
- 10 CONTINUE
- RETURN
- END
-#endif
diff --git a/src/packlib/epio/util/blo8stf.F b/src/packlib/epio/util/blo8stf.F
deleted file mode 100644
index 2e1ac36..0000000
--- a/src/packlib/epio/util/blo8stf.F
+++ /dev/null
@@ -1,57 +0,0 @@
-*
-* $Id: blo8stf.F,v 1.1.1.1 1996/03/08 15:21:48 mclareni Exp $
-*
-* $Log: blo8stf.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:48 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if (defined(CERNLIB_STF77))&&(!defined(CERNLIB_STF77VX))
- SUBROUTINE BLO8W(SOURCE,N1,TARGET,N2,N3)
- INTEGER SOURCE(*),TARGET(*)
-C
-C STANDARD FORTRAN version to do BLO8W with NO external calls.
-C
-C Input SOURCE array is a CONTIGUOUS bit string N3*8 bits long
-C starting at 8-BIT POSITION N1 in the array SOURCE.
-C This bit string is BLOWN (unpacked) into N3 computer words
-C starting at TARGET(N2). Each word of TARGET then contains
-C 8 bits, right justified.
-C
-C 8-bit word number within Computer word increases
-C as one goes from Most Significant Bit (MSB) to LSB.
-C i.e.
-C 63 48 47 32 31 16 15 0
-C -----------------------------------------------
-C | 1 | 2 | 3 | 4 |
-C -----------------------------------------------
-C
-#include "epio/wordsize.inc"
- IF(N3 .LE. 0) GO TO 999
-C
- N8PW = N16PW*2
-C SOURCE word
- IWSRC = (N1-1)/N8PW
- I8SRC = N1-IWSRC*N8PW
- IWSRC = IWSRC+1
- NBITR = (N8PW-I8SRC)*8
-C
- DO 10 IWTGT=N2,N2+N3-1
-C
-C Extract 8-bit word from source
- JWD8 = ISHFT(SOURCE(IWSRC),-NBITR)
- TARGET(IWTGT) = IAND(JWD8,255)
-C
-C
- IF(NBITR.EQ.0) THEN
- NBITR = NBITPW - 8
- IWSRC = IWSRC + 1
- ELSE
- NBITR = NBITR - 8
- ENDIF
-C
- 10 CONTINUE
-C
- 999 END
-#endif
diff --git a/src/packlib/epio/util/blo8stv.F b/src/packlib/epio/util/blo8stv.F
deleted file mode 100644
index 63a3ae7..0000000
--- a/src/packlib/epio/util/blo8stv.F
+++ /dev/null
@@ -1,57 +0,0 @@
-*
-* $Id: blo8stv.F,v 1.1.1.1 1996/03/08 15:21:48 mclareni Exp $
-*
-* $Log: blo8stv.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:48 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if (defined(CERNLIB_STF77VX))&&(!defined(CERNLIB_STF77))
- SUBROUTINE BLO8W(SOURCE,N1,TARGET,N2,N3)
- INTEGER SOURCE(*),TARGET(*)
-C
-C STANDARD FORTRAN Vax version to do BLO8W with NO external calls.
-C
-C Input SOURCE array is a CONTIGUOUS bit string N3*8 bits long
-C starting at 8-BIT POSITION N1 in the array SOURCE.
-C This bit string is BLOWN (unpacked) into N3 computer words
-C starting at TARGET(N2). Each word of TARGET then contains
-C 8 bits, left justified.
-C
-C 8-bit word number within Computer word increases
-C as one goes from Least Significant Bit (LSB) to MSB.
-C i.e.
-C 63 48 47 32 31 16 15 0
-C -----------------------------------------------
-C | 4 | 3 | 2 | 1 |
-C -----------------------------------------------
-C
-#include "epio/wordsize.inc"
- IF(N3 .LE. 0) GO TO 999
- N8PW = N16PW * 2
-C
-C SOURCE word
- IWSRC = (N1-1)/N8PW
- I8SRC = N1-IWSRC*N8PW
- IWSRC = IWSRC+1
- NBITR = (I8SRC-1)*8
-C
- DO 10 IWTGT=N2,N2+N3-1
-C
-C Extract 8-bit word from source
- JWD8 = ISHFT(SOURCE(IWSRC),-NBITR)
- TARGET(IWTGT) = IAND(JWD8,255)
-C
-C
- IF(NBITR.EQ.NBITPW-8) THEN
- NBITR = 0
- IWSRC = IWSRC + 1
- ELSE
- NBITR = NBITR + 8
- ENDIF
-C
- 10 CONTINUE
-C
- 999 END
-#endif
diff --git a/src/packlib/epio/util/blo8wib.F b/src/packlib/epio/util/blo8wib.F
deleted file mode 100644
index 7f12cb4..0000000
--- a/src/packlib/epio/util/blo8wib.F
+++ /dev/null
@@ -1,43 +0,0 @@
-*
-* $Id: blo8wib.F,v 1.1.1.1 1996/03/08 15:21:48 mclareni Exp $
-*
-* $Log: blo8wib.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:48 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_IBM)||defined(CERNLIB_VAX)||defined(CERNLIB_APOLLO)
- SUBROUTINE BLO8W(SOURCE,N1,TARGET,N2,N3)
-C.+++++++ IBM VAX AND APOLLO VERSION ++++++++++
-C. BLOWS (UNPACKS) 8 BIT BYTES INTO MACHINE WORDS(32 BIT).
-C.
-C. INPUT
-C. SOURCE ARRAY CONTAINING 8 BIT BYTES IN PACKED FORM
-C. N1 FIRST 8 BIT BYTE IN SOURCE TO BLOW
-C. TARGET TARGET ARRAY FOR UNPACKED 8 BIT BYTES
-C. N2 TARGET(N2) WILL CONTAIN FIRST UNPACKED WORD
-C. N3 NO. OF 8 BIT BYTES TO UNPACK
- INTEGER TARGET(2),ITEMP
-#if defined(CERNLIB_IBM)||defined(CERNLIB_VAX)
- LOGICAL*1 SOURCE(2),LTEMP(4)
-#endif
-#if defined(CERNLIB_APOLLO)
- CHARACTER*1 SOURCE(2),LTEMP(4)
-#endif
- EQUIVALENCE (ITEMP,LTEMP(1))
- DATA ITEMP / 0/
- IF(N3.LE.0) GOTO 77777
- I1=N1-1
- I2=N2-1
- DO 1 I=1,N3
-#if defined(CERNLIB_VAX)
- LTEMP(1)= SOURCE(I1+I)
-#endif
-#if !defined(CERNLIB_VAX)
- LTEMP(4)= SOURCE(I1+I)
-#endif
- 1 TARGET(I2+I)= ITEMP
-77777 RETURN
- END
-#endif
diff --git a/src/packlib/epio/util/btswapvx.s b/src/packlib/epio/util/btswapvx.s
deleted file mode 100644
index 45b91a0..0000000
--- a/src/packlib/epio/util/btswapvx.s
+++ /dev/null
@@ -1,67 +0,0 @@
- .TITLE BTSWAP
-;
-; CALL BTSWAP(IARRAY,NBYTES)
-;
-; PURPOSE: TO SWAP NBYTES OF THE ARRAY IARRAY.
-; IF NBYTES IS ODD JUST (NBYTES-1) BYTES WILL BE SWAPPED.
-; CAN BE CALLED FROM FORTRAN, MACRO, PASCAL, PLI, BASIC,
-; COBOL (MAY BE ALSO BLISS) WITHOUT MODS.
-;
-; IF NBYTES IS ODD THEN ONLY (NBYTES-1) BYTES WILL BE SWAPPED.
-; IF NBYTES IS LESS THAN OR EQUAL TO ZERO NOTHING IS DONE.
-;
-; RESTRICTIONS: NONE
-;
-; AUTHOR: A. PETRILLI/DD 8 JUNE 1984
-;
-; REVISIONS: F. CARMINATI/DD 25 APRIL 1986
-; .WORD CHANGED TO .ENTRY
-;
-;
-; DECLARATIONS:
-;
-IARRAY = 4 ; THESE ARE THE OFFSETS OF ADDRESSES OF
-NBYTES = 8 ; VARIABLES IN THE ARGUMENT LIST WITH
- ; RESPECT TO THE ARGUMENT POINTER
-;
-; EXTERNAL ENTRY POINT:
-;
- .ENTRY BTSWAP, ^M<R2,R3,R4,R5> ; REGISTERS TO BE SAVED
- ;
- MOVAL @IARRAY(AP), R0 ; GET ADDRESS OF THE ARRAY
- ASHL #-1, @NBYTES(AP), R1 ; GET NBYTES AND TRANSFORM IT IN A
- ; WORD COUNT
- ;
- BLEQ JOB_DONE ; PROTECT AGAINST USER MISTAKES
- ;
- ASHL #-1, R1, R2 ; GET THE LONG WORD COUNT IN R2
- ;
- BLEQ SKIP_LOOP ; SKIP THE LOOP IF THERE ARE NOT LONG
- ; WORDS TO BE SWAPPED
- ;
-INIT_LOOP: ; INITIALIZE LOOP CONTROL VARIABLE
- CLRL R3 ; SET R3 TO 0 BEFORE START LOOP
- ;
-LOOP: ; START OF LOOP
- ;
- ROTL #8, (R0), R4 ; GET NEXT LONG WORD TO BE PROCESSED
- ; AND ROTATE IT OF 1 BYTE TO THE LEFT
- ROTL #16, R4, R5 ; GET IT IN THE RIGHT POSITION FOR
- BICL2 #^X00FF00FF, R4 ; NEXT MASKING THE BYTES OF R4 ARE ZEROED
- BICL2 #^XFF00FF00, R5 ; THE BYTES OF R5 CORRESPONDING TO 'FF'
- ; ARE ZEROED
- BISL3 R4, R5, (R0)+ ; R4 & R5 ARE ORED TOGETHER AND STORED
- ; IN ARRAY
- AOBLSS R2, R3, LOOP ; LOOP ON ALL LONG WORDS OF ARRAY
- ;
-SKIP_LOOP: ; LOOP TERMINATED
- BLBC R1, JOB_DONE ; SKIP THIS SECTION IF NBYTES WAS A WHOLE
- ; NUMBER OF LONG WORDS
- MOVB (R0)+, R4 ; GET FIRST BYTE OF LAST WORD
- MOVB (R0), B^-1(R0) ; GET LAST BYTE AND PUT IT INTO THE LAST
- ; BUT ONE
- MOVB R4, (R0) ; PUT THE LAST BYTE IN PLACE
- ;
-JOB_DONE:
- RET ; END OF BTSWAP
- .END
diff --git a/src/packlib/epio/util/btswpstf.F b/src/packlib/epio/util/btswpstf.F
deleted file mode 100644
index 8d994df..0000000
--- a/src/packlib/epio/util/btswpstf.F
+++ /dev/null
@@ -1,54 +0,0 @@
-*
-* $Id: btswpstf.F,v 1.1.1.1 1996/03/08 15:21:48 mclareni Exp $
-*
-* $Log: btswpstf.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:48 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if (defined(CERNLIB_STF77))&&(!defined(CERNLIB_STF77VX))
- SUBROUTINE BTSWAP(SOURCE,NBYTES)
- INTEGER SOURCE(*)
-C
-C STF77 version to do BTSWAP with NO external calls.
-C
-C. SOURCE SOURCE ARRAY
-C. NBYTES Number of bytes to swap
-C
-C 16-bit word number within Computer word increases
-C as one goes from Most Significant Bit (MSB) to LSB.
-C i.e.
-C 63 48 47 32 31 16 15 0
-C -----------------------------------------------
-C | 1 | 2 | 3 | 4 |
-C -----------------------------------------------
-C
-#include "epio/wordsize.inc"
-C
- IF(NBYTES .LE. 1) GO TO 999
-C
-C
-C SOURCE word
- IWSRC = 0
- NBITS = NBITPW-16
- NBITR = 0
-C
- DO 10 IW16=1,NBYTES/2
-C Update indices
- IF(NBITR.EQ.0) THEN
- NBITR = NBITPW - 16
- IWSRC = IWSRC + 1
- ELSE
- NBITR = NBITR - 16
- ENDIF
-C
-C Shift 1st 16 bit word to the right and then bytes within
- SOURCE(IWSRC) = ISHFTC(ISHFTC(SOURCE(IWSRC),NBITS,NBITPW),8,16)
-C
- 10 CONTINUE
-C Shift last word if necessary
- SOURCE(IWSRC) = ISHFTC(SOURCE(IWSRC),NBITPW-NBITR,NBITPW)
-C
- 999 END
-#endif
diff --git a/src/packlib/epio/util/btswpstv.F b/src/packlib/epio/util/btswpstv.F
deleted file mode 100644
index f0de142..0000000
--- a/src/packlib/epio/util/btswpstv.F
+++ /dev/null
@@ -1,35 +0,0 @@
-*
-* $Id: btswpstv.F,v 1.1.1.1 1996/03/08 15:21:48 mclareni Exp $
-*
-* $Log: btswpstv.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:48 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if (!defined(CERNLIB_STF77))&&(defined(CERNLIB_STF77VX))
- SUBROUTINE BTSWAP(SOURCE,NBYTES)
-CLatB Aleph version
- implicit none
- integer*2 source(*)
- integer nbytes
-
- integer*2 word0
- integer*1 byte0(2)
- equivalence(byte0,word0)
- integer*2 word1
- integer*1 byte1(2)
- equivalence(byte1,word1)
- integer i
-
- if (nbytes.eq.0) return
- do i=1,nbytes/2
- word0=source(i)
- byte1(1)=byte0(2)
- byte1(2)=byte0(1)
- source(i)=word1
- end do
-
- return
- end
-#endif
diff --git a/src/packlib/epio/util/bun16stf.F b/src/packlib/epio/util/bun16stf.F
deleted file mode 100644
index f0c8611..0000000
--- a/src/packlib/epio/util/bun16stf.F
+++ /dev/null
@@ -1,63 +0,0 @@
-*
-* $Id: bun16stf.F,v 1.1.1.1 1996/03/08 15:21:48 mclareni Exp $
-*
-* $Log: bun16stf.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:48 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if (defined(CERNLIB_STF77))&&(!defined(CERNLIB_STF77VX))
- SUBROUTINE BUN16W(SOURCE,N1,TARGET,N2,N3)
- INTEGER SOURCE(*),TARGET(*)
-C
-C STF77 version to do BUN16W with NO external calls.
-C
-C Input SOURCE array is N3 computer words starting in
-C SOURCE(N1). The rightmost 16 bits of these N3 words
-C are BUNCHED (packed) into a CONTIGUOUS bit string
-C starting at 16-BIT POSITION N2 in the array TARGET.
-C
-C 16-bit word number within Computer word increases
-C as one goes from Most Significant Bit (MSB) to LSB.
-C i.e.
-C 63 48 47 32 31 16 15 0
-C -----------------------------------------------
-C | 1 | 2 | 3 | 4 |
-C -----------------------------------------------
-C
-#include "epio/wordsize.inc"
-C
- IF(N3 .LE. 0) GO TO 999
-C
-C And same for TARGET:
- IWTGT = (N2-1)/N16PW
- I16TGT = N2-IWTGT*N16PW
- IWTGT = IWTGT+1
- NBITL = (N16PW-I16TGT)*16
-C
- DO 10 IWSRC=N1,N1+N3-1
-C
-C Extract 16-bit word from source
- JWD16 = IAND(SOURCE(IWSRC),65535)
-C
-C Shift to correct position for insertion into TARGET
- JWD16 = ISHFT(JWD16,NBITL)
-C
-C Clear TARGET position
- TARGET(IWTGT) = IAND(TARGET(IWTGT),NOT(ISHFT(65535,NBITL)))
-C
-C Insert:
- TARGET(IWTGT) = IOR(TARGET(IWTGT),JWD16)
-C
- IF(NBITL.EQ.0) THEN
- NBITL = NBITPW - 16
- IWTGT = IWTGT + 1
- ELSE
- NBITL = NBITL - 16
- ENDIF
-C
- 10 CONTINUE
-C
- 999 END
-#endif
diff --git a/src/packlib/epio/util/bun16stv.F b/src/packlib/epio/util/bun16stv.F
deleted file mode 100644
index d0aa688..0000000
--- a/src/packlib/epio/util/bun16stv.F
+++ /dev/null
@@ -1,63 +0,0 @@
-*
-* $Id: bun16stv.F,v 1.1.1.1 1996/03/08 15:21:48 mclareni Exp $
-*
-* $Log: bun16stv.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:48 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if (!defined(CERNLIB_STF77))&&(defined(CERNLIB_STF77VX))
- SUBROUTINE BUN16W(SOURCE,N1,TARGET,N2,N3)
- INTEGER SOURCE(*),TARGET(*)
-C
-C STF77 Vax version to do BUN16W with NO external calls.
-C
-C Input SOURCE array is N3 computer words starting in
-C SOURCE(N1). The leftmost 16 bits of these N3 words
-C are BUNCHED (packed) into a CONTIGUOUS bit string
-C starting at 16-BIT POSITION N2 in the array TARGET.
-C
-C 16-bit word number within Computer word increases
-C as one goes from Least Significant Bit (LSB) to MSB.
-C i.e.
-C 63 48 47 32 31 16 15 0
-C -----------------------------------------------
-C | 4 | 3 | 2 | 1 |
-C -----------------------------------------------
-C
-#include "epio/wordsize.inc"
-C
- IF(N3 .LE. 0) GO TO 999
-C
-C TARGET:
- IWTGT = (N2-1)/N16PW
- I16TGT = N2-IWTGT*N16PW
- IWTGT = IWTGT+1
- NBITL = (I16TGT-1)*16
-C
- DO 10 IWSRC=N1,N1+N3-1
-C
-C Extract 16-bit word from source
- JWD16 = IAND(SOURCE(IWSRC),65535)
-C
-C Shift to correct position for insertion into TARGET
- JWD16 = ISHFT(JWD16,NBITL)
-C
-C Clear TARGET position
- TARGET(IWTGT) = IAND(TARGET(IWTGT),NOT(ISHFT(65535,NBITL)))
-C
-C Insert:
- TARGET(IWTGT) = IOR(TARGET(IWTGT),JWD16)
-C
- IF(NBITL.EQ.NBITPW-16) THEN
- NBITL = 0
- IWTGT = IWTGT + 1
- ELSE
- NBITL = NBITL + 16
- ENDIF
-C
- 10 CONTINUE
-C
- 999 END
-#endif
diff --git a/src/packlib/epio/util/bun16wib.F b/src/packlib/epio/util/bun16wib.F
deleted file mode 100644
index 62a6bd1..0000000
--- a/src/packlib/epio/util/bun16wib.F
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: bun16wib.F,v 1.1.1.1 1996/03/08 15:21:49 mclareni Exp $
-*
-* $Log: bun16wib.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:49 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_IBM)||defined(CERNLIB_VAX)||defined(CERNLIB_APOLLO)
- SUBROUTINE BUN16W(SOURCE,N1,TARGET,N2,N3)
-C.+++++++ IBM, VAX AND APOLLO VERSION ++++++++++
-C. BUNCHES (PACKS) 16 BIT WORDS (RIGHT ADJ., ZERO FILLED)
-C. INTO A CONTIGUOUS BIT STRING.
-C.
-C. FOR VAX THIS ROUTINE SHOULD BE COMPILED WITH NOCHECK
-C.
-C. INPUT
-C. SOURCE ARRAY CONTAINING 16 BIT WORDS IN UNPACKED FORM
-C. N1 FIRST 16 BIT WORD IN SOURCE TO BE PACKED
-C. TARGET TARGET ARRAY FOR PACKED 16 BIT WORDS
-C. N2 FIRST 16 BIT WORD IN TARGET TO PACK TO
-C. N3 NO. OF 16 BIT WORDS TO PACK
- INTEGER SOURCE(2)
- INTEGER*2 TARGET(2)
- IF(N3.LE.0) GOTO 77777
- I1=N1-1
- I2=N2-1
- DO 1 I=1,N3
- 1 TARGET(I2+I)=SOURCE(I1+I)
-77777 RETURN
- END
-#endif
diff --git a/src/packlib/epio/util/bun32wsf.F b/src/packlib/epio/util/bun32wsf.F
deleted file mode 100644
index e811dc8..0000000
--- a/src/packlib/epio/util/bun32wsf.F
+++ /dev/null
@@ -1,81 +0,0 @@
-*
-* $Id: bun32wsf.F,v 1.1.1.1 1996/03/08 15:21:48 mclareni Exp $
-*
-* $Log: bun32wsf.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:48 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if (defined(CERNLIB_STF77))&&(!defined(CERNLIB_STF77VX))
- SUBROUTINE BUN32W(SOURCE,N1,TARGET,N2,N3)
- INTEGER SOURCE(*),TARGET(*)
-C
-C STF77 version to do BUN32W with NO external calls.
-C
-C Input SOURCE array is N3 computer words starting in
-C SOURCE(N1). The rightmost 32 bits of these N3 words
-C are BUNCHED (packed) into a CONTIGUOUS bit string
-C starting at 16-BIT POSITION N2 in the array TARGET.
-C
-C 16-bit word number within Computer word increases
-C as one goes from Most Significant Bit (MSB) to LSB.
-C i.e.
-C 63 48 47 32 31 16 15 0
-C -----------------------------------------------
-C | 1 | 2 | 3 | 4 |
-C -----------------------------------------------
-C
-#include "epio/wordsize.inc"
-C
- IF(N3 .LE. 0) GO TO 999
-C
-C TARGET word and 16-bit within word
- IWTGT = (N2-1)/N16PW
- I16TGT = N2-IWTGT*N16PW
- IWTGT = IWTGT+1
- NBITL = (N16PW-I16TGT)*16
-C
- DO 10 IWSRC=N1,N1+N3-1
-C
-C Extract 16-bit word from source
- JWD16 = IAND(SOURCE(IWSRC),ISHFT(65535,16))
-C
-C Shift to correct position for insertion into TARGET
-C
- JWD16 = ISHFT(JWD16,NBITL-16)
-C Clear TARGET position
- TARGET(IWTGT) = IAND(TARGET(IWTGT),NOT(ISHFT(65535,NBITL)))
-C
-C Insert:
- TARGET(IWTGT) = IOR(TARGET(IWTGT),JWD16)
-C
- IF(NBITL.EQ.0) THEN
- NBITL = NBITPW - 16
- IWTGT = IWTGT + 1
- ELSE
- NBITL = NBITL - 16
- END IF
-C
-C Extract 16-bit word from source
- JWD16 = IAND(SOURCE(IWSRC),65535)
-C
-C Shift to correct position for insertion into TARGET
- JWD16 = ISHFT(JWD16, NBITL)
-C
-C Clear TARGET position
- TARGET(IWTGT) = IAND(TARGET(IWTGT),NOT(ISHFT(65535,NBITL)))
-C
-C Insert:
- TARGET(IWTGT) = IOR(TARGET(IWTGT),JWD16)
-C
- IF(NBITL.EQ.0) THEN
- NBITL = NBITPW - 16
- IWTGT = IWTGT + 1
- ELSE
- NBITL = NBITL - 16
- END IF
-C
- 10 CONTINUE
- 999 END
-#endif
diff --git a/src/packlib/epio/util/bun32wsv.F b/src/packlib/epio/util/bun32wsv.F
deleted file mode 100644
index a7f3209..0000000
--- a/src/packlib/epio/util/bun32wsv.F
+++ /dev/null
@@ -1,74 +0,0 @@
-*
-* $Id: bun32wsv.F,v 1.1.1.1 1996/03/08 15:21:48 mclareni Exp $
-*
-* $Log: bun32wsv.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:48 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if (!defined(CERNLIB_STF77))&&(defined(CERNLIB_STF77VX))
- SUBROUTINE BUN32W(SOURCE,N1,TARGET,N2,N3)
- INTEGER SOURCE(*),TARGET(*)
-C
-C F77 VAX version to do BUN32W with NO external calls.
-C
-C Input SOURCE array is N3 computer words starting in
-C SOURCE(N1). The rightmost 32 bits of these N3 words
-C are BUNCHED (packed) into a CONTIGUOUS bit string
-C starting at 16-BIT POSITION N2 in the array TARGET.
-C
-C
-#include "epio/wordsize.inc"
-C
- IF(N3 .LE. 0) GO TO 999
-C
-C TARGET word and 16-bit within word
- IWTGT = (N2-1)/N16PW
- I16TGT = N2-IWTGT*N16PW
- IWTGT = IWTGT+1
- NBITL = (I16TGT-1)*16
-C
- DO 10 IWSRC=N1,N1+N3-1
-C
-C Extract 1st 16-bit word from source
- JWD16 = IAND(SOURCE(IWSRC),65535)
-C
-C Shift to correct position for insertion into TARGET
-C
- JWD16 = ISHFT(JWD16,NBITL)
-C Clear TARGET position
- TARGET(IWTGT) = IAND(TARGET(IWTGT),NOT(ISHFT(65535,NBITL)))
-C
-C Insert:
- TARGET(IWTGT) = IOR(TARGET(IWTGT),JWD16)
-C
- IF(NBITL.EQ.NBITPW-16) THEN
- NBITL = 0
- IWTGT = IWTGT + 1
- ELSE
- NBITL = NBITL + 16
- END IF
-C
-C Extract 2nd 16-bit word from source
- JWD16 = IAND(ISHFT(SOURCE(IWSRC),-16),65535)
-C
-C Shift to correct position for insertion into TARGET
- JWD16 = ISHFT(JWD16, NBITL)
-C
-C Clear TARGET position
- TARGET(IWTGT) = IAND(TARGET(IWTGT),NOT(ISHFT(65535,NBITL)))
-C
-C Insert:
- TARGET(IWTGT) = IOR(TARGET(IWTGT),JWD16)
-C
- IF(NBITL.EQ.NBITPW-16) THEN
- NBITL = 0
- IWTGT = IWTGT + 1
- ELSE
- NBITL = NBITL + 16
- END IF
-C
- 10 CONTINUE
- 999 END
-#endif
diff --git a/src/packlib/epio/util/bun32wva.F b/src/packlib/epio/util/bun32wva.F
deleted file mode 100644
index 62993fc..0000000
--- a/src/packlib/epio/util/bun32wva.F
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: bun32wva.F,v 1.1.1.1 1996/03/08 15:21:49 mclareni Exp $
-*
-* $Log: bun32wva.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:49 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_VAX)||defined(CERNLIB_APOLLO)
- SUBROUTINE BUN32W(SOURCE,N1,TARGET,N2,N3)
-C.+++++++ VAX AND APOLLO VERSION ++++++++++
-C. NO SWAPPING IS DONE HERE
-C. MOVES 32 BIT WORDS INTO 32 BIT WORDS. STARTS ON ANY
-C. 16 BIT WORD IN TARGET.
-C.
-C. +++ IMPORTANT +++ COUNTS PARTLY IN 16 BIT WORDS
-C.
-C. INPUT
-C. SOURCE SOURCE ARRAY
-C. N1 FIRST WORD TO COPY IS SOURCE(N1)
-C. TARGET TARGET ARRAY
-C. N2 FIRST 16 BIT WORD IN TARGET
-C. N3 NO. OF WORDS TO COPY
- INTEGER*2 SOURCE(1),TARGET(1)
- DO 10 I=1,N3
- TARGET(N2+2*I-2) = SOURCE(2*N1-3+2*I)
- TARGET(N2+2*I-1) = SOURCE(2*N1-2+2*I)
- 10 CONTINUE
- RETURN
- END
-#endif
diff --git a/src/packlib/epio/util/bun8stf.F b/src/packlib/epio/util/bun8stf.F
deleted file mode 100644
index 59c7f1f..0000000
--- a/src/packlib/epio/util/bun8stf.F
+++ /dev/null
@@ -1,64 +0,0 @@
-*
-* $Id: bun8stf.F,v 1.1.1.1 1996/03/08 15:21:48 mclareni Exp $
-*
-* $Log: bun8stf.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:48 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if (defined(CERNLIB_STF77))&&(!defined(CERNLIB_STF77VX))
- SUBROUTINE BUN8W(SOURCE,N1,TARGET,N2,N3)
- INTEGER SOURCE(*),TARGET(*)
-C
-C STF77 version to do BUN8W with NO external calls.
-C
-C Input SOURCE array is N3 computer words starting in
-C SOURCE(N1). The rightmost 8 bits of these N3 words
-C are BUNCHED (packed) into a CONTIGUOUS bit string
-C starting at 8-BIT POSITION N2 in the array TARGET.
-C
-C 8-bit word number within Computer word increases
-C as one goes from Most Significant Bit (MSB) to LSB.
-C i.e.
-C 63 48 47 32 31 16 15 0
-C -----------------------------------------------
-C | 1 | 2 | 3 | 4 |
-C -----------------------------------------------
-C
-#include "epio/wordsize.inc"
-C
- IF(N3 .LE. 0) GO TO 999
-C
- N8PW = N16PW*2
-C And same for TARGET:
- IWTGT = (N2-1)/N8PW
- I8TGT = N2-IWTGT*N8PW
- IWTGT = IWTGT+1
- NBITL = (N8PW-I8TGT)*8
-C
- DO 10 IWSRC=N1,N1+N3-1
-C
-C Extract 8-bit word from source
- JWD8 = IAND(SOURCE(IWSRC),255)
-C
-C Shift to correct position for insertion into TARGET
- JWD8 = ISHFT(JWD8,NBITL)
-C
-C Clear TARGET position
- TARGET(IWTGT) = IAND(TARGET(IWTGT),NOT(ISHFT(255,NBITL)))
-C
-C Insert:
- TARGET(IWTGT) = IOR(TARGET(IWTGT),JWD8)
-C
- IF(NBITL.EQ.0) THEN
- NBITL = NBITPW - 8
- IWTGT = IWTGT + 1
- ELSE
- NBITL = NBITL - 8
- ENDIF
-C
- 10 CONTINUE
-C
- 999 END
-#endif
diff --git a/src/packlib/epio/util/bun8stv.F b/src/packlib/epio/util/bun8stv.F
deleted file mode 100644
index 6056d4a..0000000
--- a/src/packlib/epio/util/bun8stv.F
+++ /dev/null
@@ -1,64 +0,0 @@
-*
-* $Id: bun8stv.F,v 1.1.1.1 1996/03/08 15:21:48 mclareni Exp $
-*
-* $Log: bun8stv.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:48 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if (!defined(CERNLIB_STF77))&&(defined(CERNLIB_STF77VX))
- SUBROUTINE BUN8W(SOURCE,N1,TARGET,N2,N3)
- INTEGER SOURCE(*),TARGET(*)
-C
-C STF77 Vax version to do BUN8W with NO external calls.
-C
-C Input SOURCE array is N3 computer words starting in
-C SOURCE(N1). The leftmost 8 bits of these N3 words
-C are BUNCHED (packed) into a CONTIGUOUS bit string
-C starting at 8-BIT POSITION N2 in the array TARGET.
-C
-C 8-bit word number within Computer word increases
-C as one goes from Least Significant Bit (LSB) to MSB.
-C i.e.
-C 63 48 47 32 31 16 15 0
-C -----------------------------------------------
-C | 4 | 3 | 2 | 1 |
-C -----------------------------------------------
-C
-#include "epio/wordsize.inc"
-C
- IF(N3 .LE. 0) GO TO 999
- N8PW = N16PW * 2
-C
-C TARGET:
- IWTGT = (N2-1)/N8PW
- I8TGT = N2-IWTGT*N8PW
- IWTGT = IWTGT+1
- NBITL = (I8TGT-1)*8
-C
- DO 10 IWSRC=N1,N1+N3-1
-C
-C Extract 8-bit word from source
- JWD8 = IAND(SOURCE(IWSRC),255)
-C
-C Shift to correct position for insertion into TARGET
- JWD8 = ISHFT(JWD8,NBITL)
-C
-C Clear TARGET position
- TARGET(IWTGT) = IAND(TARGET(IWTGT),NOT(ISHFT(255,NBITL)))
-C
-C Insert:
- TARGET(IWTGT) = IOR(TARGET(IWTGT),JWD8)
-C
- IF(NBITL.EQ.NBITPW-8) THEN
- NBITL = 0
- IWTGT = IWTGT + 1
- ELSE
- NBITL = NBITL + 8
- ENDIF
-C
- 10 CONTINUE
-C
- 999 END
-#endif
diff --git a/src/packlib/epio/util/bun8wib.F b/src/packlib/epio/util/bun8wib.F
deleted file mode 100644
index 28c888e..0000000
--- a/src/packlib/epio/util/bun8wib.F
+++ /dev/null
@@ -1,45 +0,0 @@
-*
-* $Id: bun8wib.F,v 1.1.1.1 1996/03/08 15:21:49 mclareni Exp $
-*
-* $Log: bun8wib.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:49 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_IBM)||defined(CERNLIB_VAX)||defined(CERNLIB_APOLLO)
- SUBROUTINE BUN8W(SOURCE,N1,TARGET,N2,N3)
-C.+++++++ IBM, VAX AND APOLLO VERSION ++++++++++
-C. BUNCHES (PACKS) 8 BIT BYTES (RIGHT ADJ., ZERO FILLED)
-C. INTO A CONTIGUOUS BIT STRING.
-C.
-C. FOR VAX THIS ROUTINE SHOULD BE COMPILED WITH NOCHECK
-C.
-C. INPUT
-C. SOURCE ARRAY CONTAINING 8 BIT BYTES IN UNPACKED FORM
-C. N1 FIRST 8 BIT BYTE IN SOURCE TO BE PACKED
-C. TARGET TARGET ARRAY FOR PACKED 8 BIT BYTES
-C. N2 FIRST 8 BIT BYTE IN TARGET TO PACK TO
-C. N3 NO. OF 8 BIT BYTES TO PACK
- INTEGER SOURCE(2),ITEMP
-#if defined(CERNLIB_IBM)||defined(CERNLIB_VAX)
- LOGICAL*1 TARGET(2),LTEMP(4)
-#endif
-#if defined(CERNLIB_APOLLO)
- CHARACTER*1 TARGET(2),LTEMP(4)
-#endif
- EQUIVALENCE (ITEMP,LTEMP(1))
- IF(N3.LE.0) GOTO 77777
- I1=N1-1
- I2=N2-1
- DO 1 I=1,N3
- ITEMP= SOURCE(I1+I)
-#if defined(CERNLIB_VAX)
- 1 TARGET(I2+I)=LTEMP(1)
-#endif
-#if !defined(CERNLIB_VAX)
- 1 TARGET(I2+I)=LTEMP(4)
-#endif
-77777 RETURN
- END
-#endif
diff --git a/src/packlib/epio/util/cfrascun.F b/src/packlib/epio/util/cfrascun.F
deleted file mode 100644
index 54eed44..0000000
--- a/src/packlib/epio/util/cfrascun.F
+++ /dev/null
@@ -1,15 +0,0 @@
-*
-* $Id: cfrascun.F,v 1.1.1.1 1996/03/08 15:21:49 mclareni Exp $
-*
-* $Log: cfrascun.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:49 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_APOLLO)||defined(CERNLIB_CRAY)||defined(CERNLIB_NORD)||defined(CERNLIB_UNIVAC)||defined(CERNLIB_VAX)||defined(CERNLIB_STF77)||defined(CERNLIB_STF77VX)
- SUBROUTINE CFRASC(IARR,NW)
-C DUMMY FOR ASCII MACHINES
- RETURN
- END
-#endif
diff --git a/src/packlib/epio/util/cfribmsf.F b/src/packlib/epio/util/cfribmsf.F
deleted file mode 100644
index ef6e477..0000000
--- a/src/packlib/epio/util/cfribmsf.F
+++ /dev/null
@@ -1,75 +0,0 @@
-*
-* $Id: cfribmsf.F,v 1.1.1.1 1996/03/08 15:21:49 mclareni Exp $
-*
-* $Log: cfribmsf.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:49 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_STF77)
- SUBROUTINE CFRIBM(IARRAY,NW,MODE)
-C ++++++++ STANDARD FORTRAN VERSION +++++++++++
-C The numbers must be right adj., zero filled.
-C MODE = 1 : convert 16-bit integers
-C = 2 : convert 32-bit integers (Dummy)
-C = 3 : convert 32-bit floating
- LOGICAL BTEST
- DIMENSION IARRAY(*)
-C PARAMETER (IBIG=16#7FFF FFFF,ISMA=16#0080 0000)
- PARAMETER (IBIG=2147483647,ISMA=8388608)
-C
- IF(NW.LE.0) GO TO 999
- IF(MODE.EQ.1) THEN
-C
-C 16-bit integers
-C
- DO 110,I=1,NW
- IARRAY(I) = IAND(IARRAY(I),65535)
- 110 CONTINUE
- ELSEIF(MODE.EQ.2) THEN
-C
-C 32-bit integers (no conversion)
-C
- ELSE IF(MODE.EQ.3) THEN
-C
-C Convert the first NW words of IARRAY from
-C IBM 32-bit floating point representation to
-C IEEE single-precision (32-bit) floating point
-C representation
- DO 2 J=1,NW
-C
-C Check for exact 0
- IF(IARRAY(J).EQ.0) GO TO 2
-C
-C Make sure ILEFT gets defined to something!
- ILEFT = 0
-C
-C Get exponent
- IEXPO = ISHFT(ISHFT(IARRAY(J),1),-25)
- IF(BTEST(IARRAY(J),23)) THEN
- ILEFT = 0
- ELSEIF(BTEST(IARRAY(J),22)) THEN
- ILEFT = 1
- ELSEIF(BTEST(IARRAY(J),21)) THEN
- ILEFT = 2
- ELSEIF(BTEST(IARRAY(J),20)) THEN
- ILEFT = 3
- END IF
- IEXPO = IEXPO * 4 - ILEFT - 130
- IF(IEXPO.LE.0) THEN
- IDUMMY = ISMA
- GO TO 1
- ELSEIF(IEXPO.GT.255) THEN
- IDUMMY = IBIG
- GO TO 1
- END IF
- IDUMMY = ISHFT(IARRAY(J),ILEFT)
- IDUMMY = IOR(IAND(IDUMMY,2**23-1),ISHFT(IEXPO,23))
- 1 IF(BTEST(IARRAY(J),31)) IDUMMY = IBSET(IDUMMY,31)
- IARRAY(J) = IDUMMY
- 2 CONTINUE
- END IF
-C
- 999 END
-#endif
diff --git a/src/packlib/epio/util/cfribmsv.F b/src/packlib/epio/util/cfribmsv.F
deleted file mode 100644
index 9071ae1..0000000
--- a/src/packlib/epio/util/cfribmsv.F
+++ /dev/null
@@ -1,95 +0,0 @@
-*
-* $Id: cfribmsv.F,v 1.1.1.1 1996/03/08 15:21:49 mclareni Exp $
-*
-* $Log: cfribmsv.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:49 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_STF77VX)
- SUBROUTINE CFRIBM(IARRAY,NW,MODE)
-C Aleph version
-C ++++++++ STANDARD FORTRAN VERSION +++++++++++
-C The numbers must be right adj., zero filled.
-C MODE = 1 : convert 16-bit integers
-C = 2 : convert 32-bit integers (Dummy)
-C = 3 : convert 32-bit floating
- LOGICAL BTEST
- DIMENSION IARRAY(*)
-C PARAMETER (IBIG=16#7FFF FFFF,ISMA=16#0080 0000)
- PARAMETER (IBIG=2147483647,ISMA=8388608)
-CLatB
- integer*2 sw0(2), sw1(2)
- integer lw0, lw1
- equivalence (sw0,lw0)
- equivalence (sw1,lw1)
-C
- IF(NW.LE.0) GO TO 999
- IF(MODE.EQ.1) THEN
-C
-C 16-bit integers
-C
- DO 110,I=1,NW
- IARRAY(I) = IAND(IARRAY(I),65535)
- 110 CONTINUE
- ELSEIF(MODE.EQ.2) THEN
-C
-C 32-bit integers (word swap)
-C
- do 120 i=1, nw
- lw0 = iarray(i)
- sw1(2) = sw0(1)
- sw1(1) = sw0(2)
- iarray(i) = lw1
- 120 continue
-
- ELSE IF(MODE.EQ.3) THEN
-C
-C Convert the first NW words of IARRAY from
-C IBM 32-bit floating point representation to
-C IEEE single-precision (32-bit) floating point
-C representation
- do 130 i=1, nw
- lw0 = iarray(i)
- sw1(2) = sw0(1)
- sw1(1) = sw0(2)
- iarray(i) = lw1
- 130 continue
- DO 2 J=1,NW
-C
-C Check for exact 0
- IF(IARRAY(J).EQ.0) GO TO 2
-C
-C Make sure ILEFT gets defined to something!
- ILEFT = 0
-C
-C Get exponent
- IEXPO = ISHFT(ISHFT(IARRAY(J),1),-25)
- IF(BTEST(IARRAY(J),23)) THEN
- ILEFT = 0
- ELSEIF(BTEST(IARRAY(J),22)) THEN
- ILEFT = 1
- ELSEIF(BTEST(IARRAY(J),21)) THEN
- ILEFT = 2
- ELSEIF(BTEST(IARRAY(J),20)) THEN
- ILEFT = 3
- END IF
- IEXPO = IEXPO * 4 - ILEFT - 130
- IF(IEXPO.LE.0) THEN
- IDUMMY = ISMA
- GO TO 1
- ELSEIF(IEXPO.GT.255) THEN
- IDUMMY = IBIG
- GO TO 1
- END IF
- IDUMMY = ISHFT(IARRAY(J),ILEFT)
- IDUMMY = IOR(IAND(IDUMMY,2**23-1),ISHFT(IEXPO,23))
- 1 IF(BTEST(IARRAY(J),31)) IDUMMY = IBSET(IDUMMY,31)
- IARRAY(J) = IDUMMY
- 2 CONTINUE
- END IF
-C
- 999 continue
- END
-#endif
diff --git a/src/packlib/epio/util/cfribmva.F b/src/packlib/epio/util/cfribmva.F
deleted file mode 100644
index e75ba0d..0000000
--- a/src/packlib/epio/util/cfribmva.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: cfribmva.F,v 1.1.1.1 1996/03/08 15:21:49 mclareni Exp $
-*
-* $Log: cfribmva.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:49 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_VAX)
- SUBROUTINE CFRIBM(IARRAY,NW,MODE)
-C.+++++++ VAX VERSION ++++++++++
-C. CONVERTS THE FIRST NW WORDS OF IARRAY FROM IBM TO MACHINE FORMAT.
-C. THE NUMBERS MUST BE RIGHT ADJ., ZERO FILLED.
-C. MODE = 1 : CONVERT 16 BIT INTEGERS
-C. = 2 : CONVERT 32 BIT INTEGERS
-C. = 3 : CONVERT 32 BIT FLOATING
-C. MODE = 6 : CONVERT 32 BIT UNSIGNED INTEGERS
- DIMENSION IARRAY(1)
- IF(NW.LE.0) GOTO 77777
- MMODE=MODE
- IF(MODE.EQ.6) MMODE=2
- CALL CVT360(IARRAY(1),IARRAY(NW),3-MMODE)
-77777 RETURN
- END
-#endif
diff --git a/src/packlib/epio/util/ctoascun.F b/src/packlib/epio/util/ctoascun.F
deleted file mode 100644
index 5879da5..0000000
--- a/src/packlib/epio/util/ctoascun.F
+++ /dev/null
@@ -1,15 +0,0 @@
-*
-* $Id: ctoascun.F,v 1.1.1.1 1996/03/08 15:21:49 mclareni Exp $
-*
-* $Log: ctoascun.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:49 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_APOLLO)||defined(CERNLIB_CRAY)||defined(CERNLIB_NORD)||defined(CERNLIB_UNIVAC)||defined(CERNLIB_VAX)||defined(CERNLIB_STF77)||defined(CERNLIB_STF77VX)
- SUBROUTINE CTOASC(IARR,NW)
-C DUMMY FOR ASCII MACHINES
- RETURN
- END
-#endif
diff --git a/src/packlib/epio/util/ctoibmva.F b/src/packlib/epio/util/ctoibmva.F
deleted file mode 100644
index 61188b2..0000000
--- a/src/packlib/epio/util/ctoibmva.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: ctoibmva.F,v 1.1.1.1 1996/03/08 15:21:49 mclareni Exp $
-*
-* $Log: ctoibmva.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:49 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_VAX)
- SUBROUTINE CTOIBM(IARRAY,NW,MODE)
-C.+++++++ VAX VERSION ++++++++++
-C. CONVERTS THE FIRST NW WORDS OF IARRAY INTO IBM FORMAT.
-C. MODE = 1 : CONVERT TO 16 BIT INTEGERS (RIGHT ADJ. ZERO FILLED)
-C. = 2 : CONVERT TO 32 BIT INTEGERS
-C. = 3 : CONVERT TO 32 BIT FLOATING
-C. = 6 : CONVERT TO 32 BIT UNSIGNED INTEGER
-C. ON RETURN,THE CONVERTED NUMBERS ARE IN IARRAY,RIGHT ADJ., ZERO FILLED
- DIMENSION IARRAY(1)
- IF(NW.LE.0) GOTO 77777
- MMODE=MODE
- IF(MODE.EQ.6) MMODE=2
- CALL FTO360(IARRAY(1),IARRAY(NW),3-MMODE)
-77777 RETURN
- END
-#endif
diff --git a/src/packlib/epio/util/ctoibstf.F b/src/packlib/epio/util/ctoibstf.F
deleted file mode 100644
index 8ae20c3..0000000
--- a/src/packlib/epio/util/ctoibstf.F
+++ /dev/null
@@ -1,65 +0,0 @@
-*
-* $Id: ctoibstf.F,v 1.1.1.1 1996/03/08 15:21:49 mclareni Exp $
-*
-* $Log: ctoibstf.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:49 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if (defined(CERNLIB_STF77))&&(!defined(CERNLIB_STF77VX))
- SUBROUTINE CTOIBM(IARRAY,NW,MODE)
-C +++++++ STANDARD FORTRAN VERSION +++++++
-C The numbers must be right adj., zero filled.
-C MODE = 1 : convert 16-bit integers
-C = 2 : convert 32-bit integers (Dummy)
-C = 3 : convert 32-bit floating
- LOGICAL BTEST
- DIMENSION IARRAY(*)
-C
- IF(NW.LE.0) GO TO 999
- IF(MODE.EQ.1) THEN
-C
-C 16-bit integers
-C
- DO 110,I=1,NW
- IARRAY(I) = IAND(IARRAY(I),65535)
- 110 CONTINUE
- ELSE IF(MODE.EQ.2) THEN
-C
-C 32-bit integers (no conversion)
-C
- ELSE IF(MODE.EQ.3) THEN
-C
-C Convert the first NW words of IARRAY from IEEE
-C single-precision (32-bit) floating point representation
-C to IBM 32-bit floating point representation
- DO 10,I=1,NW
-C
-C Check for exact 0
- IF(IARRAY(I).EQ.0) GO TO 10
-C
-C Get exponent
- IEXPO = ISHFT(ISHFT(IARRAY(I),1),-24)
-C
-C IEEE EXP + IEEE BIAS + IBM BIAS
-C IEXPO = IEXPO - 128 + 260
- IEXPO = IEXPO + 134
- IEX16 = IEXPO/4
- ILEFT = 4 - MOD(IEXPO,4)
- IF(ILEFT.EQ.4) THEN
- ILEFT = 0
- IEX16 = IEX16 - 1
- END IF
- IDUMMY = IAND(IARRAY(I),2**23-1)
- IDUMMY = IBSET(IDUMMY,23)
- IDUMMY = IDUMMY + 2**(ILEFT-1)
- IDUMMY = ISHFT(IDUMMY,-ILEFT)
- IDUMMY = IOR(IDUMMY,ISHFT(IEX16,24))
- IF(BTEST(IARRAY(I),31)) IDUMMY = IBSET(IDUMMY,31)
- IARRAY(I) = IDUMMY
- 10 CONTINUE
- END IF
-C
- 999 END
-#endif
diff --git a/src/packlib/epio/util/ctoibstv.F b/src/packlib/epio/util/ctoibstv.F
deleted file mode 100644
index 9b84998..0000000
--- a/src/packlib/epio/util/ctoibstv.F
+++ /dev/null
@@ -1,84 +0,0 @@
-*
-* $Id: ctoibstv.F,v 1.1.1.1 1996/03/08 15:21:49 mclareni Exp $
-*
-* $Log: ctoibstv.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:49 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_STF77VX)
- SUBROUTINE CTOIBM(IARRAY,NW,MODE)
-C Aleph version
-C +++++++ STANDARD FORTRAN VERSION +++++++
-C The numbers must be right adj., zero filled.
-C MODE = 1 : convert 16-bit integers
-C = 2 : convert 32-bit integers (Dummy)
-C = 3 : convert 32-bit floating
- LOGICAL BTEST
- DIMENSION IARRAY(*)
-CLatB
- integer*2 sw0(2), sw1(2)
- integer lw0, lw1
- equivalence (sw0,lw0)
- equivalence (sw1,lw1)
-C
- IF(NW.LE.0) GO TO 999
- IF(MODE.EQ.1) THEN
-C
-C 16-bit integers
-C
- DO 110,I=1,NW
- IARRAY(I) = IAND(IARRAY(I),65535)
- 110 CONTINUE
- ELSE IF(MODE.EQ.2) THEN
-C
-C 32-bit integers (word swap)
-C
- do 120 i=1, nw
- lw0 = iarray(i)
- sw1(2) = sw0(1)
- sw1(1) = sw0(2)
- iarray(i) = lw1
- 120 continue
- ELSE IF(MODE.EQ.3) THEN
-C
-C Convert the first NW words of IARRAY from IEEE
-C single-precision (32-bit) floating point representation
-C to IBM 32-bit floating point representation
- DO 10,I=1,NW
-C
-C Check for exact 0
- IF(IARRAY(I).EQ.0) GO TO 10
-C
-C Get exponent
- IEXPO = ISHFT(ISHFT(IARRAY(I),1),-24)
-C
-C IEEE EXP + IEEE BIAS + IBM BIAS
-C IEXPO = IEXPO - 128 + 260
- IEXPO = IEXPO + 134
- IEX16 = IEXPO/4
- ILEFT = 4 - MOD(IEXPO,4)
- IF(ILEFT.EQ.4) THEN
- ILEFT = 0
- IEX16 = IEX16 - 1
- END IF
- IDUMMY = IAND(IARRAY(I),2**23-1)
- IDUMMY = IBSET(IDUMMY,23)
- IDUMMY = IDUMMY + 2**(ILEFT-1)
- IDUMMY = ISHFT(IDUMMY,-ILEFT)
- IDUMMY = IOR(IDUMMY,ISHFT(IEX16,24))
- IF(BTEST(IARRAY(I),31)) IDUMMY = IBSET(IDUMMY,31)
- IARRAY(I) = IDUMMY
- 10 CONTINUE
- do 130 i=1, nw
- lw0 = iarray(i)
- sw1(2) = sw0(1)
- sw1(1) = sw0(2)
- iarray(i) = lw1
- 130 continue
- END IF
-C
- 999 continue
- END
-#endif
diff --git a/src/packlib/epio/util/epioaxp.s b/src/packlib/epio/util/epioaxp.s
deleted file mode 100644
index 80a2c8e..0000000
--- a/src/packlib/epio/util/epioaxp.s
+++ /dev/null
@@ -1,150 +0,0 @@
- .TITLE EPIO_MACRO
-;
-; MAGTAPE ROUTINES FOR EPIO I/O PACKAGE
-;
-; F.C. VERSION 3.3 24-2-87 CHECK FOR INVALID BUFFER SIZE
-; F.C. VERSION 3.2 2-6-86 CHANGE L^LIST(R1) --> LIST[R1]
-; A.F.R. VERSION 3.1 2-6-82 ADD 2 WORDS IN EPCOMM
-; A.F.R. VERSION 3 9-9-81 ADD EPMTEOF
-; A.R.R. VERSION 2 1-6-81 CHANGE TO QIO READ
-; A.F.R. VERSION 1.1 4-5-81 FIX LIST(R1) --> L^LIST(R1)
-; A.F.R. VERSION 1 20-3-81
-;
-;
-; CALL EPOPENS_VAX
-; CALL EPMTREAD(BUF,MAXLEN,NB,IERR)
-; CALL EPMTREW(IERR)
-; CALL EPMTEOF(IERR)
-; CALL EPMTWRITE(BUF,NB,IERR)
-;
-IOSB: .BLKW 4
-FIB_D:
- .LONG ENDFIB-FIB
- .ADDRESS FIB
-FIB: .LONG 0
- .WORD 0,0,0,0,0,0
- .LONG 0
- .WORD 0,0
-ENDFIB:
- .PSECT EPCOMM,NOPIC,REL,OVR,NOEXE,GBL,WRT,NOSHR,3
-; THIS IS THE EPCOMM COMMON BLOCK
-NMUNIT: .BLKL 1
-NWUNIT: .BLKL 1
-NCONT: .BLKL 1
-ISTART: .BLKL 1
-LASTUT: .BLKL 1
-LREF: .BLKL 1
-LIST:
- .PSECT $CODE,PIC,CON,REL,LCL,SHR,EXE,RD,NOWRT,LONG
- $FABDEF
- $IODEF
-ICHAN = 24 ;DISPLACEMENT TO 25TH WORD OF UNIT GROUP
-MODE = 15 ;DISPLACEMENT TO 16TH WORD
- .ENTRY EPOPENS_VAX,^M<R2,R3>
-;
-; CALL EPOPENS_VAX IS A USER_OPEN ROUTINE THAT
-; REMEMBERS THE CHANNEL NUMBER AT LIST(ISTART+25)
-;
-;
- MOVL 4(AP),R3 ; MOVE FAB ADDRESS TO R3
- $FAB_STORE FAB=R3,FOP=UFO
- $OPEN FAB=R3
- BLBC R0,105$ ; CHECK ERROR
- MOVL FAB$L_STV(R3),R2 ; GET CHANNEL NUMBER
- $QIOW_S CHAN=R2,FUNC=#IO$_ACCESS!IO$M_ACCESS,-
- IOSB = IOSB,P1=FIB_D ; RETURNS 64 FOR FOREIGN TAPE
- CMPL #SS$_DEVFOREIGN,R0
- BEQL 110$
- RET
-110$:
- MOVL #1,R0 ; PUT IN RETURN CODE SUCCESS
- MOVL ISTART,R1 ; ADDRESS OF ARRAY ISTART OF
- ; EPIOCOM
- ADDL2 #<ICHAN>,R1 ; DISPLACEMENT OF CHANNEL
- ; LOCATION IN LIS
- MOVL R2,LIST[R1] ; STORE CHANNEL NUMBER
-105$:
- RET
-;
- .ENTRY EPMTREAD,^M<R2>
-;
-; CALL EPMTREAD(BUF,MAXLEN,NB,IERR) GETS THE NEXT RECORD FROM TAPE
-; BUF(MAXLEN) IS THE BYTE ARRAY NB IS THE NUMBER OF BYTES READ
-; IERR IS THE ERROR CODE
-;
- MOVL ISTART,R1 ; ADDRESS OF ARRAY ISTART OF
- ; EPIOCOM
- ADDL2 #<ICHAN>,R1 ; CHANNEL NUMBER FOR THIS UNIT
- MULW2 #2,R1 ; GO TO WORDS
- MOVL @8(AP),R2 ; THIS IS THE BUFFER SIZE
- CMPL R2,#^XFFFE ; CHECK AGAINST THE MAX
- BLEQU 110$ ; OK, BRANCH
- MOVZWL #^XFFFE,R2 ; SET IT TO THE MAX
-110$: $QIOW_S CHAN=LIST[R1],FUNC=#IO$_READVBLK,-
- P1=@4(AP),P2=R2,IOSB=IOSB ; READ THE NEXT BLOCK
- BLBC R0,120$ ; THIS SHOULD NOT HAPPEN
- MOVW IOSB, at 16(AP) ; THIS IS THE ERROR CODE
- MOVW IOSB+2, at 12(AP) ; THIS IS THE BYTE COUNT
- RET
-120$:
- MOVW R0, at 16(AP) ; HERE IS THE BAD ERROR
- CLRW @12(AP) ; BYTE COUNT IS 0
- RET
- .ENTRY EPMTWRITE,^M<>
-;
-; CALL EPMTWRITE(BUF,NB,IERR) WRITES THE NEXT RECORD
-; STARTING AT BUF(1) FOR NB BYTES AND RETURNING ERROR IERR
-;
- MOVL ISTART,R1 ; ADDRESS OF ARRAY ISTART OF
- ; EPIOCOM
- ADDL2 #<ICHAN>,R1 ; CHANNEL NUMBER FOR THIS UNIT
- MULW2 #2,R1 ; GO TO WORDS
- $QIOW_S CHAN=LIST[R1],FUNC=#IO$_WRITEVBLK,-
- P1=@4(AP),P2=@8(AP),IOSB=IOSB ; READ THE NEXT BLOCK
- BLBC R0,125$ ; THIS SHOULD NOT HAPPEN
- MOVW IOSB, at 12(AP) ; THIS IS THE ERROR CODE
- RET
-125$:
- MOVW R0, at 12(AP) ; HERE IS THE BAD ERROR
- RET
- .ENTRY EPMTREW,^M<R2,R3>
-;
-; CALL EPMTREW(IERR) ADDS DOUBLE EOF IF WRITE AND THEN REWINDS THE UNIT
-;
- MOVL #1, at 4(AP) ; SUCCESS RETURN
- MOVL ISTART,R3
- ADDL2 #<ICHAN>,R3
- MULW2 #2,R3 ; GO TO WORDS
- MOVL ISTART,R2
- ADDL2 #<MODE>,R2
- CMPL #1,LIST[R2] ; MODE IS 1 FOR WRITE
- BNEQU 130$
- $QIOW_S CHAN=LIST[R3],FUNC=#IO$_WRITEOF,IOSB=IOSB ;WRITE EOF
- BLBS IOSB,127$ ; SKIP IF NO TROUBLE
- MOVW IOSB, at 4(AP) ; RETURN CODE IF TROUBLE
-127$:
- $QIOW_S CHAN=LIST[R3],FUNC=#IO$_WRITEOF,IOSB=IOSB ;WRITE EOF
-130$:
- $QIOW_S CHAN=LIST[R3],FUNC=#IO$_REWIND
- RET
- .ENTRY EPMTEOF,^M<R2,R3>
-;
-; CALL EPMTEOF(IERR) ADDS DOUBLE EOF AND BACKSPACES OVER LAST ONE
-;
- MOVL #1, at 4(AP) ; SUCCESS RETURN
- MOVL ISTART,R3
- ADDL2 #<ICHAN>,R3
- MULW2 #2,R3 ; GO TO WORDS
- MOVL ISTART,R2
- ADDL2 #<MODE>,R2
- CMPL #1,LIST[R2] ; MODE IS 1 FOR WRITE
- BNEQU 230$
- $QIOW_S CHAN=LIST[R3],FUNC=#IO$_WRITEOF,IOSB=IOSB ;WRITE EOF
- BLBS IOSB,227$ ; SKIP IF NO TROUBLE
- MOVW IOSB, at 4(AP) ; RETURN CODE IF TROUBLE
-227$:
- $QIOW_S CHAN=LIST[R3],FUNC=#IO$_WRITEOF,IOSB=IOSB ;WRITE EOF
-230$:
- $QIOW_S CHAN=LIST[R3],FUNC=#IO$_SKIPRECORD,IOSB=IOSB,P1=-1
- RET
- .END
diff --git a/src/packlib/epio/util/epiovax.s b/src/packlib/epio/util/epiovax.s
deleted file mode 100644
index ebf440a..0000000
--- a/src/packlib/epio/util/epiovax.s
+++ /dev/null
@@ -1,150 +0,0 @@
- .TITLE EPIO_MACRO
-;
-; MAGTAPE ROUTINES FOR EPIO I/O PACKAGE
-;
-; F.C. VERSION 3.3 24-2-87 CHECK FOR INVALID BUFFER SIZE
-; F.C. VERSION 3.2 2-6-86 CHANGE L^LIST(R1) --> LIST[R1]
-; A.F.R. VERSION 3.1 2-6-82 ADD 2 WORDS IN EPCOMM
-; A.F.R. VERSION 3 9-9-81 ADD EPMTEOF
-; A.R.R. VERSION 2 1-6-81 CHANGE TO QIO READ
-; A.F.R. VERSION 1.1 4-5-81 FIX LIST(R1) --> L^LIST(R1)
-; A.F.R. VERSION 1 20-3-81
-;
-;
-; CALL EPOPENS_VAX
-; CALL EPMTREAD(BUF,MAXLEN,NB,IERR)
-; CALL EPMTREW(IERR)
-; CALL EPMTEOF(IERR)
-; CALL EPMTWRITE(BUF,NB,IERR)
-;
-IOSB: .BLKW 4
-FIB_D:
- .LONG ENDFIB-FIB
- .ADDRESS FIB
-FIB: .LONG 0
- .WORD 0,0,0,0,0,0
- .LONG 0
- .WORD 0,0
-ENDFIB:
- .PSECT EPCOMM,PIC,REL,OVR,NOEXE,GBL,WRT,SHR,LONG
-; THIS IS THE EPCOMM COMMON BLOCK
-NMUNIT: .BLKL 1
-NWUNIT: .BLKL 1
-NCONT: .BLKL 1
-ISTART: .BLKL 1
-LASTUT: .BLKL 1
-LREF: .BLKL 1
-LIST:
- .PSECT $CODE,PIC,CON,REL,LCL,SHR,EXE,RD,NOWRT,LONG
- $FABDEF
- $IODEF
-ICHAN = 24 ;DISPLACEMENT TO 25TH WORD OF UNIT GROUP
-MODE = 15 ;DISPLACEMENT TO 16TH WORD
- .ENTRY EPOPENS_VAX,^M<R2,R3>
-;
-; CALL EPOPENS_VAX IS A USER_OPEN ROUTINE THAT
-; REMEMBERS THE CHANNEL NUMBER AT LIST(ISTART+25)
-;
-;
- MOVL 4(AP),R3 ; MOVE FAB ADDRESS TO R3
- $FAB_STORE FAB=R3,FOP=UFO
- $OPEN FAB=R3
- BLBC R0,105$ ; CHECK ERROR
- MOVL FAB$L_STV(R3),R2 ; GET CHANNEL NUMBER
- $QIOW_S CHAN=R2,FUNC=#IO$_ACCESS!IO$M_ACCESS,-
- IOSB = IOSB,P1=FIB_D ; RETURNS 64 FOR FOREIGN TAPE
- CMPL #SS$_DEVFOREIGN,R0
- BEQL 110$
- RET
-110$:
- MOVL #1,R0 ; PUT IN RETURN CODE SUCCESS
- MOVL ISTART,R1 ; ADDRESS OF ARRAY ISTART OF
- ; EPIOCOM
- ADDL2 #<ICHAN>,R1 ; DISPLACEMENT OF CHANNEL
- ; LOCATION IN LIS
- MOVL R2,LIST[R1] ; STORE CHANNEL NUMBER
-105$:
- RET
-;
- .ENTRY EPMTREAD,^M<R2>
-;
-; CALL EPMTREAD(BUF,MAXLEN,NB,IERR) GETS THE NEXT RECORD FROM TAPE
-; BUF(MAXLEN) IS THE BYTE ARRAY NB IS THE NUMBER OF BYTES READ
-; IERR IS THE ERROR CODE
-;
- MOVL ISTART,R1 ; ADDRESS OF ARRAY ISTART OF
- ; EPIOCOM
- ADDL2 #<ICHAN>,R1 ; CHANNEL NUMBER FOR THIS UNIT
- MULW2 #2,R1 ; GO TO WORDS
- MOVL @8(AP),R2 ; THIS IS THE BUFFER SIZE
- CMPL R2,#^XFFFE ; CHECK AGAINST THE MAX
- BLEQU 110$ ; OK, BRANCH
- MOVZWL #^XFFFE,R2 ; SET IT TO THE MAX
-110$: $QIOW_S CHAN=LIST[R1],FUNC=#IO$_READVBLK,-
- P1=@4(AP),P2=R2,IOSB=IOSB ; READ THE NEXT BLOCK
- BLBC R0,120$ ; THIS SHOULD NOT HAPPEN
- MOVW IOSB, at 16(AP) ; THIS IS THE ERROR CODE
- MOVW IOSB+2, at 12(AP) ; THIS IS THE BYTE COUNT
- RET
-120$:
- MOVW R0, at 16(AP) ; HERE IS THE BAD ERROR
- CLRW @12(AP) ; BYTE COUNT IS 0
- RET
- .ENTRY EPMTWRITE,^M<>
-;
-; CALL EPMTWRITE(BUF,NB,IERR) WRITES THE NEXT RECORD
-; STARTING AT BUF(1) FOR NB BYTES AND RETURNING ERROR IERR
-;
- MOVL ISTART,R1 ; ADDRESS OF ARRAY ISTART OF
- ; EPIOCOM
- ADDL2 #<ICHAN>,R1 ; CHANNEL NUMBER FOR THIS UNIT
- MULW2 #2,R1 ; GO TO WORDS
- $QIOW_S CHAN=LIST[R1],FUNC=#IO$_WRITEVBLK,-
- P1=@4(AP),P2=@8(AP),IOSB=IOSB ; READ THE NEXT BLOCK
- BLBC R0,125$ ; THIS SHOULD NOT HAPPEN
- MOVW IOSB, at 12(AP) ; THIS IS THE ERROR CODE
- RET
-125$:
- MOVW R0, at 12(AP) ; HERE IS THE BAD ERROR
- RET
- .ENTRY EPMTREW,^M<R2,R3>
-;
-; CALL EPMTREW(IERR) ADDS DOUBLE EOF IF WRITE AND THEN REWINDS THE UNIT
-;
- MOVL #1, at 4(AP) ; SUCCESS RETURN
- MOVL ISTART,R3
- ADDL2 #<ICHAN>,R3
- MULW2 #2,R3 ; GO TO WORDS
- MOVL ISTART,R2
- ADDL2 #<MODE>,R2
- CMPL #1,LIST[R2] ; MODE IS 1 FOR WRITE
- BNEQU 130$
- $QIOW_S CHAN=LIST[R3],FUNC=#IO$_WRITEOF,IOSB=IOSB ;WRITE EOF
- BLBS IOSB,127$ ; SKIP IF NO TROUBLE
- MOVW IOSB, at 4(AP) ; RETURN CODE IF TROUBLE
-127$:
- $QIOW_S CHAN=LIST[R3],FUNC=#IO$_WRITEOF,IOSB=IOSB ;WRITE EOF
-130$:
- $QIOW_S CHAN=LIST[R3],FUNC=#IO$_REWIND
- RET
- .ENTRY EPMTEOF,^M<R2,R3>
-;
-; CALL EPMTEOF(IERR) ADDS DOUBLE EOF AND BACKSPACES OVER LAST ONE
-;
- MOVL #1, at 4(AP) ; SUCCESS RETURN
- MOVL ISTART,R3
- ADDL2 #<ICHAN>,R3
- MULW2 #2,R3 ; GO TO WORDS
- MOVL ISTART,R2
- ADDL2 #<MODE>,R2
- CMPL #1,LIST[R2] ; MODE IS 1 FOR WRITE
- BNEQU 230$
- $QIOW_S CHAN=LIST[R3],FUNC=#IO$_WRITEOF,IOSB=IOSB ;WRITE EOF
- BLBS IOSB,227$ ; SKIP IF NO TROUBLE
- MOVW IOSB, at 4(AP) ; RETURN CODE IF TROUBLE
-227$:
- $QIOW_S CHAN=LIST[R3],FUNC=#IO$_WRITEOF,IOSB=IOSB ;WRITE EOF
-230$:
- $QIOW_S CHAN=LIST[R3],FUNC=#IO$_SKIPRECORD,IOSB=IOSB,P1=-1
- RET
- .END
diff --git a/src/packlib/epio/util/epiovax2.s b/src/packlib/epio/util/epiovax2.s
deleted file mode 100644
index 2c2af10..0000000
--- a/src/packlib/epio/util/epiovax2.s
+++ /dev/null
@@ -1,30 +0,0 @@
- .TITLE EPIO2_MACRO
-;
-; DISK ROUTINES FOR EPIO I/O PACKAGE
-;
- $RABDEF
-;
-DKRECL: .BLKL 100
-ADKREC: .ADDRESS DKRECL
-;
- .PSECT $CODE,PIC,CON,REL,LCL,SHR,EXE,RD,NOWRT,LONG
- .ENTRY EPOPENV_VAX,^M<>
- $OPEN FAB=@4(AP)
- BRB CONNECT
- .ENTRY EPOPENO_VAX,^M<>
- $CREATE FAB=@4(AP)
-CONNECT: BLBC R0,300$
- $CONNECT RAB=@8(AP)
- SUBL3 #1, at 12(AP),R1
- ADDL3 8(AP),#RAB$W_RSZ, at ADKREC[R1]
-300$: RET
-;
- .ENTRY EPDKRECL,^M<>
- SUBL3 #1, at 4(AP),R1
- ASHL #2,R1,R1
- ADDL2 ADKREC,R1
- MOVZWL @(R1),R0
- RET
-;
- .END
-
diff --git a/src/packlib/epio/util/iwd16stf.F b/src/packlib/epio/util/iwd16stf.F
deleted file mode 100644
index 296f802..0000000
--- a/src/packlib/epio/util/iwd16stf.F
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: iwd16stf.F,v 1.1.1.1 1996/03/08 15:21:48 mclareni Exp $
-*
-* $Log: iwd16stf.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:48 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if (defined(CERNLIB_STF77))&&(!defined(CERNLIB_STF77VX))
- FUNCTION IWD16(SOURCE,N1)
-C
-C FUNCTION RETURNS THE 16 BIT WORD NO. N1 OF STRING SOURCE.
-C
-C I.MCLAREN 14/06/90
-C
- INTEGER SOURCE(*)
-C
-#include "epio/wordsize.inc"
-C
-C SOURCE word
- IWSRC = (N1-1)/N16PW
- I16SRC = N1-IWSRC*N16PW
- IWSRC = IWSRC+1
- NBITR = (N16PW-I16SRC)*16
-C
-C Extract 16-bit word from source
- IWD16 = IAND(ISHFT(SOURCE(IWSRC),-NBITR),65535)
-C
- RETURN
- END
-#endif
diff --git a/src/packlib/epio/util/iwd16stv.F b/src/packlib/epio/util/iwd16stv.F
deleted file mode 100644
index 3177885..0000000
--- a/src/packlib/epio/util/iwd16stv.F
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: iwd16stv.F,v 1.1.1.1 1996/03/08 15:21:48 mclareni Exp $
-*
-* $Log: iwd16stv.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:48 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if (!defined(CERNLIB_STF77))&&(defined(CERNLIB_STF77VX))
- FUNCTION IWD16(SOURCE,N1)
-C
-C FUNCTION RETURNS THE 16 BIT WORD NO. N1 OF STRING SOURCE.
-C
-C I.MCLAREN 14/06/90
-C
- INTEGER SOURCE(*)
-C
-#include "epio/wordsize.inc"
-C
-C SOURCE word
- IWSRC = (N1-1)/N16PW
- I16SRC = N1-IWSRC*N16PW
- IWSRC = IWSRC+1
- NBITR = (I16SRC-1)*16
-C
-C Extract 16-bit word from source
- IWD16 = IAND(ISHFT(SOURCE(IWSRC),-NBITR),65535)
-C
- RETURN
- END
-#endif
diff --git a/src/packlib/epio/util/iwd16vax.F b/src/packlib/epio/util/iwd16vax.F
deleted file mode 100644
index ea3372f..0000000
--- a/src/packlib/epio/util/iwd16vax.F
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: iwd16vax.F,v 1.1.1.1 1996/03/08 15:21:49 mclareni Exp $
-*
-* $Log: iwd16vax.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:49 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_VAX)||defined(CERNLIB_APOLLO)
- FUNCTION IWD16(M,N)
-C--- FUNCTION RETURNS 16 BIT WORD NO. N OUT OF
-C--- 32 BIT WORD ARRAY M.
- INTEGER*2 M(2)
- IWD16= M(N)
-#if defined(CERNLIB_VAX)
- IWD16 = IWD16.AND.'FFFF'X
-#endif
-#if defined(CERNLIB_APOLLO)
- IWD16 = AND(IWD16,16#FFFF)
-#endif
- RETURN
- END
-#endif
diff --git a/src/packlib/epio/util/mtformat.s b/src/packlib/epio/util/mtformat.s
deleted file mode 100644
index 4b838dc..0000000
--- a/src/packlib/epio/util/mtformat.s
+++ /dev/null
@@ -1,83 +0,0 @@
- .TITLE MT_FORMAT
- .IDENT /FGV02.01/
-
- ; MT_FORMAT
- ; ---------
- ;
- ; The MT_FORMAT routine allows a process to set the format in which
- ; data are written/read to/from an already assigned tape.
- ;
- ; High-level Language format:
- ;
- ; CALL MT_FORMAT(CHAN,DENSITY)
- ;
- ; CHAN Address of a word containing the number of the
- ; I/O channel assigned to the magnetic tape
- ; device.
- ;
- ; DENSITY Format value.
- ; Possible format values:
- ;
- ; MT$K_NORMAL11 Normal PDP-11 format.Data bytes are
- ; recorded sequentially on tape with
- ; byte 0 of each word read/written
- ; before byte 1.
- ;
- ; MT$K_NORMAL15 16-bits word mode.Data byte 1 of each word
- ; is read/written before data byte 0.
- ;
- ; Return status:
- ;
- ; Normal VMS status.
- ;
- ;
- ; Author:
- ; M.Scire'
- ; CERN
- ; 1211 Geneve 23
- ;
- ; Update history:
- ; MSV01.01 14JAN81 MS - Original version.
- ;
- ; FGV02.01 19NOV82 F.Gagliardi - Fix bug:
- ; the first long word of the quadword characteristics buffer
- ; used as P1 argument for IO$_SETMODE QIO, was overwritten
- ; by the content of DIB$L_DEVCHAR longword of the DIB block.
- ;
- ;
- .LIBRARY /SYS$LIBRARY:LIB.MLB/
- $DIBDEF ;DEVICE CHAR BUFFER OFFSETS
- $IODEF ;I/O FUNCTION CODES
- $MTDEF GLOBAL ;MAG TAPE SYMBOLIC
-
- IOSTATUS: .BLKQ 1
-
- DEV_BUFFER: .LONG DEV_BUFFER_E-DEV_BUFFER_S ;LENGTH OF BUFFER
- .ADDRESS DEV_BUFFER_S ;ADDRESS OF BUFFER
- DEV_BUFFER_S:.BLKB DIB$K_LENGTH ;
- DEV_BUFFER_E: ;
- .PSECT $CODE,PIC,CON,REL,LCL,SHR,EXE,RD,NOWRT,LONG
- CHANNEL = 4 ;ARG1 ADDRESS
- FORMAT = 8 ;ARG2
-
- .ENTRY MT_FORMAT,^M<R2,R3,R4,R5>
-
- $GETCHN_S CHAN=@CHANNEL(AP),- ;MAGTAPE CHANNEL
- PRIBUF=DEV_BUFFER ;DEVICE BUFFER
- BLBC R0,1000$
-
- INSV FORMAT(AP),#MT$V_FORMAT,- ;
- #MT$S_FORMAT,- ;
- DEV_BUFFER_S+DIB$L_DEVDEPEND ;Insert new format
- $QIOW_S EFN=#0,- ; EVENT FLAG
- CHAN=@CHANNEL(AP),- ;CHANNEL
- FUNC=#IO$_SETMODE,- ;FUNCTION SET MODE
- IOSB=IOSTATUS,- ;ADDRESS OF I/O STATUS
- P1=DEV_BUFFER_S+DIB$B_DEVCLASS
-
- BLBC R0,1000$ ; OK ?
- MOVZWL IOSTATUS,R0 ;
-
- 1000$:RET ;
- .END
-
diff --git a/src/packlib/epio/util/sfrascap.F b/src/packlib/epio/util/sfrascap.F
deleted file mode 100644
index f78ef28..0000000
--- a/src/packlib/epio/util/sfrascap.F
+++ /dev/null
@@ -1,36 +0,0 @@
-*
-* $Id: sfrascap.F,v 1.1.1.1 1996/03/08 15:21:50 mclareni Exp $
-*
-* $Log: sfrascap.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:50 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if (defined(CERNLIB_APOLLO)||defined(CERNLIB_STF77))&&(!defined(CERNLIB_STF77VX))
- SUBROUTINE SFRASC(SOURCE,N1,TARGET,N2,NCH)
-C.+++++++ APOLLO VERSION ++++++++++
-C. CONVERTS A HOLLERITH STRING FROM INTERNAL ASCII TO
-C. EXTERNAL ASCII, I.E. DOES A COPY.
-C.
-C. THE APOLLO VERSION IS IDENTICAL TO THE APOLLO VERSION OF STOASC .
-C.
-C. PARAMETERS
-C.
-C. SOURCE ARRAY CONTAINING THE INPUT ASCII STRING
-C. N1 FIRST CHARACTER IN SOURCE TO CONVERT
-C. TARGET ARRAY RECEIVING THE OUTPUT ASCII STRING
-C. N2 FIRST CHARACTER POSITION OF CONVERTED STRING IN TARGET
-C. NCH NUMBER OF CHARACTERS TO CONVERT
-C.
-C. THE ROUTINE ALLOWS THE SIMULTANEOUS CONVERSION AND CONCATENATION
-C. OF A STRING. ON VAX, IBM ( NOT CDC ! ), SOURCE AND TARGET MAY OVERLAP
-C. AS LONG AS N2.LE.N1 .
-C.
- CHARACTER*1 SOURCE(NCH),TARGET(NCH)
- IF(NCH.LE.0) GOTO 77777
- DO 20 I=1,NCH
- 20 TARGET(N2+I-1)=SOURCE(N1+I-1)
-77777 RETURN
- END
-#endif
diff --git a/src/packlib/epio/util/sfrascvx.F b/src/packlib/epio/util/sfrascvx.F
deleted file mode 100644
index 3d2a9b1..0000000
--- a/src/packlib/epio/util/sfrascvx.F
+++ /dev/null
@@ -1,42 +0,0 @@
-*
-* $Id: sfrascvx.F,v 1.1.1.1 1996/03/08 15:21:49 mclareni Exp $
-*
-* $Log: sfrascvx.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:49 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if (defined(CERNLIB_VAX)||defined(CERNLIB_STF77VX))&&(!defined(CERNLIB_STF77))
- SUBROUTINE SFRASC(SOURCE,N1,TARGET,N2,NCH)
-C.+++++++ VAX VERSION ++++++++++
-C. CONVERTS A HOLLERITH STRING FROM INTERNAL ASCII TO
-C. EXTERNAL ASCII, I.E. ON VAX PERFORMS BYTE SWAPPING ONLY.
-C. BY MAKING SOURCE AND TARGET, AND N1 AND N2 IDENTICAL, THE ROUTINE CAN
-C. BE USED FOR BYTE SWAPPING ONLY.
-C.
-C. THE VAX VERSION IS IDENTICAL TO THE VAX VERSION OF STOASC .
-C.
-C. PARAMETERS
-C.
-C. SOURCE ARRAY CONTAINING THE INPUT ASCII STRING
-C. N1 FIRST CHARACTER IN SOURCE TO CONVERT
-C. TARGET ARRAY RECEIVING THE OUTPUT ASCII STRING (SWAPPED BYTES)
-C. N2 FIRST CHARACTER POSITION OF CONVERTED STRING IN TARGET
-C. NCH NUMBER OF CHARACTERS TO CONVERT
-C.
-C. THE ROUTINE ALLOWS THE SIMULTANEOUS CONVERSION AND CONCATENATION
-C. OF A STRING. ON VAX, IBM ( NOT CDC ! ), SOURCE AND TARGET MAY OVERLAP
-C. AS LONG AS N2.LE.N1 .
-C.
- LOGICAL*1 K1,K2,SOURCE(NCH),TARGET(NCH)
-CFLR CHARACTER*1 K1,K2,SOURCE(NCH),TARGET(NCH)
- IF(NCH.LE.0) GOTO 77777
- DO 20 I=1,NCH,2
- K1=SOURCE(N1+I-1)
- K2=SOURCE(N1+I)
- TARGET(N2+I-1)=K2
- 20 TARGET(N2+I)=K1
-77777 RETURN
- END
-#endif
diff --git a/src/packlib/epio/util/stoascap.F b/src/packlib/epio/util/stoascap.F
deleted file mode 100644
index 5edae2d..0000000
--- a/src/packlib/epio/util/stoascap.F
+++ /dev/null
@@ -1,37 +0,0 @@
-*
-* $Id: stoascap.F,v 1.1.1.1 1996/03/08 15:21:50 mclareni Exp $
-*
-* $Log: stoascap.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:50 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if (defined(CERNLIB_APOLLO)||defined(CERNLIB_STF77))&&(!defined(CERNLIB_STF77VX))
- SUBROUTINE STOASC(SOURCE,N1,TARGET,N2,NCH)
-C.+++++++ APOLLO VERSION ++++++++++
-C. CONVERTS A HOLLERITH STRING FROM INTERNAL ASCII TO
-C. EXTERNAL ASCII, I.E. DOES A COPY.
-C.
-C. THE APOLLO VERSION IS IDENTICAL TO THE APOLLO VERSION OF SFRASC .
-C.
-C. PARAMETERS
-C.
-C. SOURCE ARRAY CONTAINING THE INPUT ASCII STRING
-C. N1 FIRST CHARACTER IN SOURCE TO CONVERT
-C. TARGET ARRAY RECEIVING THE OUTPUT ASCII STRING
-C. N2 FIRST CHARACTER POSITION OF CONVERTED STRING IN TARGET
-C. NCH NUMBER OF CHARACTERS TO CONVERT
-C.
-C. THE ROUTINE ALLOWS THE SIMULTANEOUS CONVERSION AND CONCATENATION
-C. OF A STRING. ON VAX, IBM ( NOT CDC ! ), SOURCE AND TARGET MAY OVERLAP
-C. AS LONG AS N2.LE.N1 .
-C.
- LOGICAL*1 K1,K2,SOURCE(NCH),TARGET(NCH)
-CFLR CHARACTER*1 K1,K2,SOURCE(NCH),TARGET(NCH)
- IF(NCH.LE.0) GOTO 77777
- DO 20 I=1,NCH
- 20 TARGET(N2+I-1)=SOURCE(N1+I-1)
-77777 RETURN
- END
-#endif
diff --git a/src/packlib/epio/util/stoascvx.F b/src/packlib/epio/util/stoascvx.F
deleted file mode 100644
index f2514d3..0000000
--- a/src/packlib/epio/util/stoascvx.F
+++ /dev/null
@@ -1,42 +0,0 @@
-*
-* $Id: stoascvx.F,v 1.1.1.1 1996/03/08 15:21:50 mclareni Exp $
-*
-* $Log: stoascvx.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:50 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if (defined(CERNLIB_VAX)||defined(CERNLIB_STF77VX))&&(!defined(CERNLIB_STF77))
- SUBROUTINE STOASC(SOURCE,N1,TARGET,N2,NCH)
-C.+++++++ VAX VERSION ++++++++++
-C. CONVERTS A HOLLERITH STRING FROM INTERNAL ASCII TO
-C. EXTERNAL ASCII, I.E. ON VAX PERFORMS BYTE SWAPPING ONLY.
-C. BY MAKING SOURCE AND TARGET, AND N1 AND N2 IDENTICAL, THE ROUTINE CAN
-C. BE USED FOR BYTE SWAPPING ONLY.
-C.
-C. THE VAX VERSION IS IDENTICAL TO THE VAX VERSION OF SFRASC .
-C.
-C. PARAMETERS
-C.
-C. SOURCE ARRAY CONTAINING THE INPUT ASCII STRING
-C. N1 FIRST CHARACTER IN SOURCE TO CONVERT
-C. TARGET ARRAY RECEIVING THE OUTPUT ASCII STRING (SWAPPED BYTES)
-C. N2 FIRST CHARACTER POSITION OF CONVERTED STRING IN TARGET
-C. NCH NUMBER OF CHARACTERS TO CONVERT
-C.
-C. THE ROUTINE ALLOWS THE SIMULTANEOUS CONVERSION AND CONCATENATION
-C. OF A STRING. ON VAX, IBM ( NOT CDC ! ), SOURCE AND TARGET MAY OVERLAP
-C. AS LONG AS N2.LE.N1 .
-C.
- LOGICAL*1 K1,K2,SOURCE(NCH),TARGET(NCH)
-C CHARACTER*1 K1,K2,SOURCE(NCH),TARGET(NCH)
- IF(NCH.LE.0) GOTO 77777
- DO 20 I=1,NCH,2
- K1=SOURCE(N1+I-1)
- K2=SOURCE(N1+I)
- TARGET(N2+I-1)=K2
- 20 TARGET(N2+I)=K1
-77777 RETURN
- END
-#endif
diff --git a/src/packlib/epio/util/vaxibm.s b/src/packlib/epio/util/vaxibm.s
deleted file mode 100644
index 686b100..0000000
--- a/src/packlib/epio/util/vaxibm.s
+++ /dev/null
@@ -1,118 +0,0 @@
- .TITLE VAX_IBMCONV
-;
-; IBM TO VAX IN PLACE CONVERSION FOR FLOATING POINT R*4
-;
-; CALL CVT360(A(I),A(J),MODE) CONVERTS R*4 WORDS A(I) THROUGH A(J)
-; FROM IBM TO VAX FORMAT
-;
-; CALL FTO360(A(I),A(J),MODE) CONVERTS FROM VAX TO IBM FORMAT
-;
-; MODE SPECIFIES TYPE OF CONVERSION
-; = 0 OR MISSING FLOATING POINT
-; = 1 I*4 (16-16 BIT SWAP IS PERFORMED)
-; = 2 I*2 (WITH SIGN EXTENSION)
-;
-; J >= I IS A REQUIREMENT.
-;
-; THE ARRAY A MUST BE CORRECTLY ALIGNED ON A R*4 BOUNDARY
-;
-; BYTE SWAPPING IS PERFORMED BY THIS ROUTINE
-;
-; A.F.R. VERSION 2 9-9-81 SWAP DONE HERE, THREE MODES INTRODUCED
-; A.F.R. VERSION 1 20-3-81 FLOATING WITH NO BYTE SWAP
-;
- .PSECT $CODE,PIC,CON,REL,LCL,SHR,EXE,RD,NOWRT,LONG
- .ENTRY FTO360,^M<R2,R3,R4,R5,R6>
- MOVL 4(AP),R2 ;R2 = FIRST BYTE OF CURRENT R*4 WORD
- MOVL (AP),R1 ;THIS IS THE NUMBER OF ARGUMENTS
- CMPL R1,#3 ;IF 3 THEN MODE IS SENT
- BNEQ 100$ ;DEFAULT IS FLOATING
- CASEL @12(AP),#0,#2 ;HERE ARE THE THREE CASES
-10$: .WORD 100$-10$ ;FLOATING
- .WORD 200$-10$ ;I*4 INTEGERS
- .WORD 300$-10$ ;I*2 INTEGERS
-100$:
- CMPL R2,8(AP) ;CHECK FOR END OF ARRAY
- BLEQU 105$
- RET
-105$:
- ROTL #16,(R2),R3 ;GET NEXT WORD ALIGNED NICELY
- BEQL 115$ ;SKIP IF IT IS ZERO
- EXTZV #0,#23,R3,R4 ;EXTRACT MANTISSA
- BISL2 #^X00800000,R4 ;SET THE HIDDEN LEADING BIT
- EXTZV #23,#8,R3,R5 ;EXTRACT EXPONENT
- SUBL2 #129,R5 ;TAKE AWAY EXCESS
- EXTZV #0,#2,R5,R6 ;GET REMAINDER
- ASHL #-2,R5,R5 ;POWERS OF 64
- ADDL2 #^X41,R5 ;ADD EXCESS 64 FOR EXPONENT
- BICB2 #^X80,R5
- BBC #31,R3,110$ ;CHECK FOR NEGATIVE DATA
- BISB2 #^X80,R5
-110$:
- SUBL2 #3,R6 ;SET MANTISSA SHIFT
- ASHL R6,R4,R3 ;MANTISSA TO IBM STANDARD
- INSV R5,#24,#8,R3 ;NOW HAVE IT ALL IN R3
-115$:
- ROTL #16,R3,(R2)+ ;HERE IS THE SWAP
- BRW 100$
-200$:
- CMPL R2,8(AP) ;CHECK FOR END OF ARRAY
- BLEQU 205$
- RET
-205$:
- ROTL #16,(R2),(R2)+ ;DO 16-16 SWAP
- BRW 200$
-300$:
- CMPL R2,8(AP) ;CHECK FOR END OF ARRAY
- BLEQU 305$
- RET
-305$:
- CVTWL (R2),(R2)+ ;SIGN EXTEND THE HIGH 16 BITS
- BRW 300$
-;
-;
- .ENTRY CVT360,^M<R2,R3,R4,R5>
- MOVL 4(AP),R2 ;MOVE WORD POINTER TO R2
- MOVL (AP),R1 ;THIS IS THE NUMBER OF ARGUMENTS
- CMPL R1,#3 ;IF 3 THEN MODE IS SENT
- BNEQ 1100$ ;DEFAULT IS FLOATING
- CASEL @12(AP),#0,#2 ;HERE ARE THE THREE CASES
-1010$: .WORD 1100$-1010$ ;FLOATING
- .WORD 1200$-1010$ ;I*4 INTEGERS
- .WORD 1300$-1010$ ;I*2 INTEGERS
-1100$:
- CMPL R2,8(AP) ;ARE WE DONE?
- BLEQU 1105$
- RET
-1105$:
- ROTL #16,(R2),R3 ;MOVE NEXT WORD TO R3
- BEQL 1110$ ;BRANCH IF ZERO, NO CONVERSION
- BICL3 #^XFF000000,R3,R5 ;EXTRACT MANTISSA
- EXTZV #24,#7,R3,R4 ;EXTRACT EXPONENT
- SUBL2 #^X41,R4 ;TAKE AWAY EXCESS
- ASHL #2,R4,R4 ;POWERS OF TWO
- CVTLF R5,R3 ;MANTISSA TO VAX FLOATING
- EXTZV #7,#5,R3,R5 ;GET NORMALIZATION SHIFT
- ADDL2 R5,R4 ;NEW EXPONENT
- ADDL2 #^X6C,R4 ;ADD 128 EXCESS AND ADJUST
- INSV R4,#7,#8,R3 ;PACK EXPONENT INTO R3
- BBC #15,(R2),1110$ ;WAS INPUT NEGATIVE
- BISL2 #^X00008000,R3 ;YES, SET SIGN
-1110$:
- MOVL R3,(R2)+ ;STORE IT
- BRW 1100$
-1200$:
- CMPL R2,8(AP) ;CHECK FOR END OF ARRAY
- BLEQU 1205$
- RET
-1205$:
- ROTL #16,(R2),(R2)+ ;DO 16-16 SWAP
- BRW 1200$
-1300$:
- CMPL R2,8(AP) ;CHECK FOR END OF ARRAY
- BLEQU 1305$
- RET
-1305$:
- CVTWL (R2),(R2)+ ;SIGN EXTEND THE HIGH 16 BITS
- BRW 1300$
- .END
diff --git a/src/packlib/epio/util/w16movvx.s b/src/packlib/epio/util/w16movvx.s
deleted file mode 100644
index ec49067..0000000
--- a/src/packlib/epio/util/w16movvx.s
+++ /dev/null
@@ -1,47 +0,0 @@
- .TITLE W16MOV
-;
-; CALL W16MOV(SOURCE,N1,TARGET,N2,N3)
-;
-; PURPOSE: TO MOVE N3 16 BITS WORDS FROM SOURCE(N1) TO TARGET(N2)
-; CAN BE CALLED FROM FORTRAN, MACRO, PASCAL, PLI, BASIC,
-; COBOL (MAY BE ALSO BLISS) WITHOUT MODS
-;
-; RESTRICTIONS: N3 MUST BE .LE. 2**31-1 (2*10**9)
-;
-; AUTHOR: A. PETRILLI/DD 29 MARCH 1984
-;
-;
-;
-; DECLARATIONS:
-SOURCE = 4 ; THESE ARE THE OFFSETS OF
-N1 = 8 ; ADDRESSES OF VARIABLES IN
-TARGET = 12 ; THE ARGUMENT LIST WITH
-N2 = 16 ; RESPECT TO THE
-N3 = 20 ; ARGUMENT POINTER
-;
-;
-; ENTRY POINT:
- .ENTRY W16MOV,^M<R2,R3,R4,R5> ; R3,R4,R5 NEED TO BE SAVED BECAUSE
- ; THEY ARE USED BY MOVC3
- ;
- SUBL3 #1, @N1(AP), R0 ; PUT N1-1 INTO R0 AND
- ASHL #1, R0, R0 ; CONVERT THE WORD OFFSET OF SOURCE
- ; TO A BYTE OFFSET
- ;
- SUBL3 #1, @N2(AP), R1 ; PUT N2-1 INTO R1 AND
- ASHL #1, R1, R1 ; CONVERT THE WORD OFFSET OF TARGET
- ; TO A BYTE OFFSET
- ;
- ASHL #1, @N3(AP), R2 ; PUT N3*2 INTO R2 SO THE WORD COUNT
- ; IS NOW A BYTE COUNT
- ;
- BLEQ JOB_DONE ; PROTECT AGAINST USER MISTAKES
- ;
- MOVC3 R2, @SOURCE(AP)[R0], @TARGET(AP)[R1]
- ; HERE WE REALLY DO THE JOB:
- ; R2 BYTES ARE COPIED FROM
- ; SOURCE(R0) TO TARGET(R1)
- ;
-JOB_DONE:
- RET ; END OF W16MOV
- .END
diff --git a/src/packlib/epio/util/w16mvstf.F b/src/packlib/epio/util/w16mvstf.F
deleted file mode 100644
index e475d76..0000000
--- a/src/packlib/epio/util/w16mvstf.F
+++ /dev/null
@@ -1,82 +0,0 @@
-*
-* $Id: w16mvstf.F,v 1.1.1.1 1996/03/08 15:21:48 mclareni Exp $
-*
-* $Log: w16mvstf.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:48 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_STF77)
- SUBROUTINE W16MOV(SOURCE,N1,TARGET,N2,N3)
- INTEGER SOURCE(*),TARGET(*)
-C
-C STF77 version to do W16MOV with NO external calls.
-C
-C. MOVES 16 BIT WORDS IN PACKED FORM.
-C.
-C. SOURCE SOURCE ARRAY
-C. N1 STARTING 16 BIT WORD IN SOURCE
-C. TARGET TARGET ARRAY
-C. N2 STARTING 16 BIT WORD IN TARGET
-C. N3 NO. OF 16 BIT WORDS TO MOVE
-C
-C 16-bit word number within Computer word increases
-C as one goes from Most Significant Bit (MSB) to LSB.
-C i.e.
-C 63 48 47 32 31 16 15 0
-C -----------------------------------------------
-C | 1 | 2 | 3 | 4 |
-C -----------------------------------------------
-C
-#include "epio/wordsize.inc"
-C
- IF(N3 .LE. 0) GO TO 999
-C
-C
-C SOURCE word
- IWSRC = (N1-1)/N16PW
- I16SRC = N1-IWSRC*N16PW
- IWSRC = IWSRC+1
- NBITR = (N16PW-I16SRC)*16
-C
-C And same for TARGET:
- IWTGT = (N2-1)/N16PW
- I16TGT = N2-IWTGT*N16PW
- IWTGT = IWTGT+1
- NBITL = (N16PW-I16TGT)*16
-C
- DO 10 IW16=1,N3
-C
-C
-C Extract 16-bit word from source
- JWD16 = ISHFT(SOURCE(IWSRC),-NBITR)
-C
-C Shift to correct position for insertion into TARGET
- JWD16 = ISHFT(JWD16,NBITL)
-C
-C Clear TARGET position
- TARGET(IWTGT) = IAND(TARGET(IWTGT),NOT(ISHFT(65535,NBITL)))
-C
-C Insert:
- TARGET(IWTGT) = IOR(TARGET(IWTGT),JWD16)
-C
-C Update indices
- IF(NBITR.EQ.0) THEN
- NBITR = NBITPW - 16
- IWSRC = IWSRC + 1
- ELSE
- NBITR = NBITR - 16
- ENDIF
-C
- IF(NBITL.EQ.0) THEN
- NBITL = NBITPW - 16
- IWTGT = IWTGT + 1
- ELSE
- NBITL = NBITL - 16
- ENDIF
-C
- 10 CONTINUE
-C
- 999 END
-#endif
diff --git a/src/packlib/epio/util/w16mvstv.F b/src/packlib/epio/util/w16mvstv.F
deleted file mode 100644
index 315b8b6..0000000
--- a/src/packlib/epio/util/w16mvstv.F
+++ /dev/null
@@ -1,82 +0,0 @@
-*
-* $Id: w16mvstv.F,v 1.1.1.1 1996/03/08 15:21:48 mclareni Exp $
-*
-* $Log: w16mvstv.F,v $
-* Revision 1.1.1.1 1996/03/08 15:21:48 mclareni
-* Epio
-*
-*
-#include "epio/pilot.h"
-#if defined(CERNLIB_STF77VX)
- SUBROUTINE W16MOV(SOURCE,N1,TARGET,N2,N3)
- INTEGER SOURCE(*),TARGET(*)
-C
-C F77 VAX version to do W16MOV with NO external calls.
-C
-C. MOVES 16 BIT WORDS IN PACKED FORM.
-C.
-C. SOURCE SOURCE ARRAY
-C. N1 STARTING 16 BIT WORD IN SOURCE
-C. TARGET TARGET ARRAY
-C. N2 STARTING 16 BIT WORD IN TARGET
-C. N3 NO. OF 16 BIT WORDS TO MOVE
-C
-C 16-bit word number within Computer word increases
-C as one goes from Most Significant Bit (MSB) to LSB.
-C i.e.
-C 63 48 47 32 31 16 15 0
-C -----------------------------------------------
-C | 1 | 2 | 3 | 4 |
-C -----------------------------------------------
-C
-#include "epio/wordsize.inc"
-C
- IF(N3 .LE. 0) GO TO 999
-C
-C
-C SOURCE word
- IWSRC = (N1-1)/N16PW
- I16SRC = N1-IWSRC*N16PW
- IWSRC = IWSRC+1
- NBITR = (I16SRC-1)*16
-C
-C And same for TARGET:
- IWTGT = (N2-1)/N16PW
- I16TGT = N2-IWTGT*N16PW
- IWTGT = IWTGT+1
- NBITL = (I16TGT-1)*16
-C
- DO 10 IW16=1,N3
-C
-C
-C Extract 16-bit word from source
- JWD16 = ISHFT(SOURCE(IWSRC),-NBITR)
-C
-C Shift to correct position for insertion into TARGET
- JWD16 = ISHFT(JWD16,NBITL)
-C
-C Clear TARGET position
- TARGET(IWTGT) = IAND(TARGET(IWTGT),NOT(ISHFT(65535,NBITL)))
-C
-C Insert:
- TARGET(IWTGT) = IOR(TARGET(IWTGT),JWD16)
-C
-C Update indices
- IF(NBITR.EQ.NBITPW-16) THEN
- NBITR = 0
- IWSRC = IWSRC + 1
- ELSE
- NBITR = NBITR + 16
- ENDIF
-C
- IF(NBITL.EQ.NBITPW-16) THEN
- NBITL = 0
- IWTGT = IWTGT + 1
- ELSE
- NBITL = NBITL + 16
- ENDIF
-C
- 10 CONTINUE
-C
- 999 END
-#endif
diff --git a/src/packlib/fatmen/Imakefile b/src/packlib/fatmen/Imakefile
deleted file mode 100644
index f74743f..0000000
--- a/src/packlib/fatmen/Imakefile
+++ /dev/null
@@ -1,30 +0,0 @@
-DoIncludePackage(fatmen)
-
-#define IHaveSubdirs
-#define PassCDebugFlags
-
-LIBDIRS=fatbody fatuous fatuser fatutil fmint fmtms fmutil l3util
-
-#if defined(CERNLIB_UNIX)
-LIBDIRS:= $(LIBDIRS) fmc
-#endif
-
-#if defined(CERNLIB_VAXVMS)
-LIBDIRS:= $(LIBDIRS) fmvax
-#endif
-
-PROGRAMDIRS= programs
-
-SUBDIRS= $(LIBDIRS) $(PROGRAMDIRS) fatmen
-
-TopOfPackage(fatmen)
-
-SubdirLibraryTarget(fatlib,$(LIBDIRS))
-
-InstallBinSubdirs($(PROGRAMDIRS))
-
-test::
-
-DoIncludePackage(fatmen)
-
-InstallIncludeSubdirs(fatmen)
diff --git a/src/packlib/fatmen/doc/fatbank%.inc b/src/packlib/fatmen/doc/fatbank%.inc
deleted file mode 100644
index da64b0c..0000000
--- a/src/packlib/fatmen/doc/fatbank%.inc
+++ /dev/null
@@ -1,52 +0,0 @@
-*
-* $Id: fatbank%.inc,v 1.1.1.1 1996/03/07 15:17:35 mclareni Exp $
-*
-* $Log: fatbank%.inc,v $
-* Revision 1.1.1.1 1996/03/07 15:17:35 mclareni
-* Fatmen
-*
-*
-#ifndef CERNLIB_FATMEN_FATBANK%_INC
-#define CERNLIB_FATMEN_FATBANK%_INC
-*
-*
-* fatbank%.inc
-*
-#if defined(CERNLIB__DOC)
-#include "fatmen/fatbank.inc"
-
- fan-out bank offsets
-
- MNOPFA Number of open files belonging to such "data base"
- MLUNFA logical unit of the RZ-file
- MFLGFA
- MTOTFA
- MCRDFA
- MINPFA
- MOUTFA
- MTOPFA
- MNCHFA number of character of the top directory name
- MCHRFA top directory name
-
- NDUPFA total number of word in the top directory
-
- NSLUFA Number of "system links in "UPFA" bank
-
-
- Book-keeping bank "BKFA"
- KLBKFA link offset in UPFA
- NWBKFA number of word for each "file"
-
- MSTAFA file status
- MPNTFA pointer in the generic names bank
- MCGNFA number of characters used by the gen.name
-
- Generic names bank "GNFA"
- KLGNFA link offset in UPFA
-
- -5 number of word used
-
-
-#endif
-
-#endif
diff --git a/src/packlib/fatmen/doc/fatflags b/src/packlib/fatmen/doc/fatflags
deleted file mode 100644
index 5500e19..0000000
--- a/src/packlib/fatmen/doc/fatflags
+++ /dev/null
@@ -1,63 +0,0 @@
-*
-* $Id: fatflags,v 1.1.1.1 1996/03/07 15:17:35 mclareni Exp $
-*
-* $Log: fatflags,v $
-* Revision 1.1.1.1 1996/03/07 15:17:35 mclareni
-* Fatmen
-*
-*
-* EXPLANATION OF SOME OF THE PATCHY FLAGS
-* This directory was created from fatmen.car patch fatflags
-* To activate 'STRONG TYPING' for patchy sequences
-#ifndef CERNLIB_TYPE
-#define CERNLIB_TYPE
-#endif
-* For systems running the HEPVM Tape Management System (TMS)
-#ifndef CERNLIB_TMS
-#define CERNLIB_TMS
-#endif
-* Use defaults for tapes unknown to TMS
-#ifndef CERNLIB_TMSTEST
-#define CERNLIB_TMSTEST
-#endif
-* For systems supporting VID prefices (FRCPN11)
-#ifndef CERNLIB_PREFIX
-#define CERNLIB_PREFIX
-#endif
-* For systems without the QVOL command (FRCPN11)
-#ifndef CERNLIB_QVID
-#define CERNLIB_QVID
-#endif
-* To activate HEPVM specific code (SETUP, STAGE etc.) (default)
-#ifndef CERNLIB_HEPVM
-#define CERNLIB_HEPVM
-#endif
-* To force tape access via SETUP
-#ifndef CERNLIB_SETUP
-#define CERNLIB_SETUP
-#endif
-* To force tape access via STAGE
-#ifndef CERNLIB_STAGE
-#define CERNLIB_STAGE
-#endif
-* To activate the SQL code (only in server)
-#ifndef CERNLIB_SQL
-#define CERNLIB_SQL
-#endif
-* If you are running VMBATCH from Systems Center
-#ifndef CERNLIB_VMBATCH
-#define CERNLIB_VMBATCH
-#endif
-* If you are running VMTAPE from Systems Center
-#ifndef CERNLIB_VMTAPE
-#define CERNLIB_VMTAPE
-#endif
-* If user tapes are catalogue in the VMTAPE TMC
-#ifndef CERNLIB_VMTMC
-#define CERNLIB_VMTMC
-#endif
-#if (defined(CERNLIB_CERN))&&(defined(CERNLIB_IBMVM))
-#ifndef CERNLIB_CERNVM
-#define CERNLIB_CERNVM
-#endif
-#endif
diff --git a/src/packlib/fatmen/doc/fatpara b/src/packlib/fatmen/doc/fatpara
deleted file mode 100644
index bf09e62..0000000
--- a/src/packlib/fatmen/doc/fatpara
+++ /dev/null
@@ -1,11 +0,0 @@
-*
-* $Id: fatpara,v 1.1.1.1 1996/03/07 15:17:35 mclareni Exp $
-*
-* $Log: fatpara,v $
-* Revision 1.1.1.1 1996/03/07 15:17:35 mclareni
-* Fatmen
-*
-*
-* This directory was created from fatmen.car patch fatpara
-* To extract sequence FATPARA
-#include "fatpara.inc"
diff --git a/src/packlib/fatmen/doc/fatpara%.inc b/src/packlib/fatmen/doc/fatpara%.inc
deleted file mode 100644
index e4761e0..0000000
--- a/src/packlib/fatmen/doc/fatpara%.inc
+++ /dev/null
@@ -1,132 +0,0 @@
-*
-* $Id: fatpara%.inc,v 1.1.1.1 1996/03/07 15:17:35 mclareni Exp $
-*
-* $Log: fatpara%.inc,v $
-* Revision 1.1.1.1 1996/03/07 15:17:35 mclareni
-* Fatmen
-*
-*
-#ifndef CERNLIB_FATMEN_FATPARA%_INC
-#define CERNLIB_FATMEN_FATPARA%_INC
-*
-*
-* fatpara%.inc
-*
-#if defined(CERNLIB__DOC)
-#include "fatmen/fatpara.inc"
-
- K E Y S
-
- MKSRFA Key serial number
- MKFNFA File name
- MKCLFA Copy level
- MKMTFA Medium type
- MKLCFA Location type
- MKNBFA Number of bank in the data set linear chain
-
- NKDSFA Number of keys
-
-
- B A N K
-
-words field type length description
- (in words)
-
- --------- generic description -------------
-
-(* = NOT NULL in ORACLE or SQL/DS tables - filled in by FMLIFT)
-
-1-64 * fully qual. name H 64 in case of instance the generi
- name of the corresponding data
- set
- dataset name has format
- <user.addr>fn.ft on VM,
- where '.addr' may be omitted.
-65-66 * host name H 2 in case of tape the nearest
- host to its physical
- location
- (maybe more words to clearly
- state the location (lab.
- bld. etc) would be needed)
-67 * copy level I 1 0 master 1 duplicate
- 2 duplicate from a duplicate etc
-68 * location code I 1 to find the nearest (FATMEN code
-69 * medium type I 1 3=tape, 2=cartridge,
- 4=exabyte, 1=disk
- ...................
- 0=instance
-
-
-
-
- --------- disk description -------------
-
-70-73 host type H 4 only for disk files
-74-76 operating syst. H 3 "
-
- --------- tape description -------------
-
-77-78 * VSN H 2 only for tapes
-79-80 * VID H 2 "
-81 VID prefix I 1 "
-82 Density I 1 "
-83 vol. seq. numb. I 1 "
-84 * file seq. numb. I 1 "
-
- --------- file description -------------
-
-85 start record # I 1
-86 end record # I 1
-87 start block # I 1
-88 end block # I 1
-
- --------- physical description -------------
-
-89 record format H 1
-90 record length I 1 (in words!)
-91 block length I 1 "
-106 file size I 1 (in Megabytes, rounded up
- = SYSWD0 to next integer)
-
- --------- logical description -------------
-
-92 * file format H 1 FATMEN oriented
- FZ=zebra native
- FA=zebra ascii
- FX=zebra exchange
- RZ=zebra RZ
- EP=EPIO
- AS=normal Ascii
- UN=unknown to FATMEN
- ...............
-93 file user type H 1 user oriented and user defined
-
- --------- dates and times -------------
-
-94 creation date I 1
-95 catalog. date I 1
-96 last acc.date I 1
-
- --------- creator identier -------------
-
-97-98 user name creat. H 2 "creator" user name
-99-100 user id. " H 2 user id. UUUGG/UUU$GG
- or NFSID
-101-102 node id. " H 2 node id.
-103-104 job id. " H 2 job id.
- (user defined)
-
- --------- protections -------------
-
-105 file protect. I 1 (maybe just a pointer in a
- ACL definition bank)
-
- --------- user area -------------
-
-106-115 system words I 10 (reserved)
-116-125 user words I 10 (user defined)
-126-145 comment H 20
-
-#endif
-
-#endif
diff --git a/src/packlib/fatmen/doc/ffatmen b/src/packlib/fatmen/doc/ffatmen
deleted file mode 100644
index b18659e..0000000
--- a/src/packlib/fatmen/doc/ffatmen
+++ /dev/null
@@ -1,137 +0,0 @@
-*
-* $Id: ffatmen,v 1.1.1.1 1996/03/07 15:17:35 mclareni Exp $
-*
-* $Log: ffatmen,v $
-* Revision 1.1.1.1 1996/03/07 15:17:35 mclareni
-* Fatmen
-*
-*
-* This directory was created from fatmen.car patch ffatmen
-#if defined(CERNLIB_IBMMVS)||defined(CERNLIB_IBMVM)
-#ifndef CERNLIB_IBM
-#define CERNLIB_IBM
-#endif
-#endif
-#if defined(CERNLIB_ALLIANT)||defined(CERNLIB_APOLLO)||defined(CERNLIB_CONVEX)||defined(CERNLIB_CRAY)||defined(CERNLIB_IBMAIX)||defined(CERNLIB_UNISYS)
-#ifndef CERNLIB_UNIX
-#define CERNLIB_UNIX
-#endif
-#endif
-#if defined(CERNLIB_DECS)||defined(CERNLIB_GOULD)||defined(CERNLIB_HPUX)||defined(CERNLIB_IBMRT)||defined(CERNLIB_MACMPW)||defined(CERNLIB_MIPS)||defined(CERNLIB_SGI)||defined(CERNLIB_SUN)
-#ifndef CERNLIB_UNIX
-#define CERNLIB_UNIX
-#endif
-#endif
-#if defined(CERNLIB_NEXT)||defined(CERNLIB_QMVAOS)
-#ifndef CERNLIB_UNIX
-#define CERNLIB_UNIX
-#endif
-#endif
-#if defined(CERNLIB_APOLLO)
-#ifndef CERNLIB_APOL3
-#define CERNLIB_APOL3
-#endif
-#endif
-#if (defined(CERNLIB_UNIX))&&(defined(CERNLIB__FATLIB))
-#ifndef CERNLIB_FMC
-#define CERNLIB_FMC
-#endif
-#endif
-#if (defined(CERNLIB_UNIX))&&(defined(CERNLIB__FATLIB))
-#ifndef CERNLIB_FMH
-#define CERNLIB_FMH
-#endif
-#endif
-#if (defined(CERNLIB_IBMMVS))&&(defined(CERNLIB__FATLIB))
-#ifndef CERNLIB_FATASM
-#define CERNLIB_FATASM
-#endif
-#endif
-#if defined(CERNLIB_VAXVMS)||defined(CERNLIB_VAXULX)
-#ifndef CERNLIB_VAX
-#define CERNLIB_VAX
-#endif
-#endif
-#if defined(CERNLIB_IBM)||defined(CERNLIB_VAX)||defined(CERNLIB_NORD)
-#ifndef CERNLIB_DOUBLE
-#define CERNLIB_DOUBLE
-#endif
-#endif
-#if (defined(CERNLIB_UNIX))&&(!defined(CERNLIB_SINGLE))
-#ifndef CERNLIB_DOUBLE
-#define CERNLIB_DOUBLE
-#endif
-#endif
-#if defined(CERNLIB_IBM)
-#ifndef CERNLIB_QMIBMXA
-#define CERNLIB_QMIBMXA
-#endif
-#endif
-#if (defined(CERNLIB_FERMI))&&(defined(CERNLIB_IBMVM))
-#ifndef CERNLIB_VMCENTER
-#define CERNLIB_VMCENTER
-#endif
-#endif
-#if defined(CERNLIB_VMCENTER)
-#ifndef CERNLIB_VMBATCH
-#define CERNLIB_VMBATCH
-#endif
-#ifndef CERNLIB_VMTAPE
-#define CERNLIB_VMTAPE
-#endif
-#endif
-#if (defined(CERNLIB_IBMVM))&&(!defined(CERNLIB_VMTAPE))&&(!defined(CERNLIB_VMBATCH))
-#ifndef CERNLIB_HEPVM
-#define CERNLIB_HEPVM
-#endif
-#endif
-#if defined(CERNLIB_VAXVMS)
-#ifndef CERNLIB_VAXTAP
-#define CERNLIB_VAXTAP
-#endif
-#endif
-#if defined(CERNLIB_CRAY)
-#ifndef CERNLIB_QXCAPT
-#define CERNLIB_QXCAPT
-#endif
-#endif
-#if defined(CERNLIB_SUN)||defined(CERNLIB_SGI)||defined(CERNLIB_DECS)||defined(CERNLIB_CONVEX)||defined(CERNLIB_IBMRT)||defined(CERNLIB_HPUX)||defined(CERNLIB_AIX370)||defined(CERNLIB_APOF77)
-#ifndef CERNLIB_QX_SC
-#define CERNLIB_QX_SC
-#endif
-#endif
-#if defined(CERNLIB_NEXT)||defined(CERNLIB_QMVAOS)
-#ifndef CERNLIB_QX_SC
-#define CERNLIB_QX_SC
-#endif
-#endif
-#if (defined(CERNLIB_APOLLO))&&(!defined(CERNLIB_APOF77))
-#ifndef CERNLIB_QXNO_SC
-#define CERNLIB_QXNO_SC
-#endif
-#endif
-#if defined(CERNLIB_APOLLO)||defined(CERNLIB_SGI)||defined(CERNLIB_SUN)
-#ifndef CERNLIB_BSD
-#define CERNLIB_BSD
-#endif
-#endif
-#if defined(CERNLIB_IBMRT)||defined(CERNLIB_DECS)||defined(CERNLIB_HPUX)
-#ifndef CERNLIB_SYS5
-#define CERNLIB_SYS5
-#endif
-#endif
-#if (defined(CERNLIB_VAXVMS))&&(defined(CERNLIB__FATLIB))
-#ifndef CERNLIB_DCL
-#define CERNLIB_DCL
-#endif
-#endif
-#if (defined(CERNLIB_UNIX))&&(defined(CERNLIB__FATLIB))
-#ifndef CERNLIB_SCRIPT
-#define CERNLIB_SCRIPT
-#endif
-#endif
-#if (defined(CERNLIB_IBMVM))&&(defined(CERNLIB__FATLIB))
-#ifndef CERNLIB_REXX
-#define CERNLIB_REXX
-#endif
-#endif
diff --git a/src/packlib/fatmen/doc/history b/src/packlib/fatmen/doc/history
deleted file mode 100644
index fedf351..0000000
--- a/src/packlib/fatmen/doc/history
+++ /dev/null
@@ -1,1128 +0,0 @@
-*
-* $Id: history,v 1.1.1.1 1996/03/07 15:17:35 mclareni Exp $
-*
-* $Log: history,v $
-* Revision 1.1.1.1 1996/03/07 15:17:35 mclareni
-* Fatmen
-*
-*
-* This directory was created from fatmen.car patch history
-Version 1.92=Make help for MODIFY command correspond to code (-K)
- For import into CVS.
-Version 1.91=FMCLOS: add extra debug
- FMLOOP, FMBACK: correct save statement
- FMKADT, FMADDT: safer handling of VID prefixes
- FATCDES: add definitions for DAT120, NTP
- FMOPEN/FMTAPE: IOPTI - disable -G in calls to SHIFT s/w
- Z=FATGET: ISFGET
- FMTAPE: only specify -U for shift stagein if DDNAME looks like
- a Fortran unit
- FATLOG: log files (FATLOG.yymmdd) now written to fatlogs subdir
- FATSEND: only wait if no files were transferred
- FAINQR,FMVERI,FMURL: fix check on URL
- FMTAPE: impose MAXSTG only on IBM (mainframe) systems
- FATUTIL: save DIRNAM variable (problems diagnosed by Olof Barring)
-Version 1.90=FATSEND: tidy printout, improve time stamping of log messages
- FMRZIN: print IQUEST(1) in case of RZIN errors
- FMRSTG: tidy retry handling
- FAERAS, FAINQR: initialise LCHNFS
- FMCLOS: fix bug in stageclr
- FMINIT, FMTAPE: call sfget only if in current path
- New versions of FATCHK and FMMEDT from FNAL
- - FATCHK increase width in the FORMAT statement
- - FMMEDT move zeroing of NFMTYP and NUMMTP after check that
- FATMEN.MEDTYPES exists;
- FATSEND: skip remote nodes if protocol is afs
- FMFZO: save FILEN. FATSRV: skip kumac files
- FMSSND, FATSEND: increase nodenames and queues to 80 characters
- FMMEDT: mods from D0 - set also NFMTYP, permit also negative
- media types. (This results in a medium of type iabs(itype)
- being defined but not selected).
- FMMEDT: set media types (definitions of characteristics AND
- selection vector) using fatmen.medtypes file.
- FMPKTM: year 99 was not allowed!
- FMDISK/FMTAPE: print warning message concerning conflicting
- logical names on multiple lines (D0)
- FMFIXF: strip trailing / from pathname (if any)
- FMCLOS: update MSRDFA/MERDFA from FZINO
- FMCLASS: define LDEF, FMURL: add Z=FATPARA.
- FMSREQ: improve handling of bad sysreq.conf config file
- FMSHO2: large directories - use I6 for ksn
- Start support for mss commands (e.g. Lachman interface)
- Files stored in Lachman have a URL like:
- osm://[server-node:][/store-name][/storage-group]/bitfileID
- fatmen.storage-classes:
-
- path storage-class [store-name] [storage-server]
- DELPHI DELPHI-conservator at domain
- osm://delphi-conservator@cern.ch/delphi/rawdata/bfid
-
- storage-classes should be experiment independent (e.g. rawdata)
- store-names are experiment specific (e.g. L3DSTS, ALEPHRAW)
-
- mods to: FATCDES,FMDISK,FAINQR,FMVERI,FADARE,FMRZIN
- mssget mssinq ??
- new routines: FMURL, FMCLASS, FMMSS, FMRSLV
-Version 1.89=FMUTIL: add FMETOA/FMATOE (from RB's RZHto/frA) for ebcdic/ascii
- conversion
- FMFIXF: handle multiple .. in path name correctly
- FMATCH: handle *pattern correctly
- FMKMOD: zero NMATCH before FMSELK
- Add DLT definitions (as from TMS), include in CERN selection
- Add RWN/CWN as allowable file formats
- Add fatzero script to check for zero length files in /todo
- Add fatdf script to check /fatmen not too full
- FMSREQ: retry on all errors (after existing error handling)
- FMPSTG: split FATOPTS into FATOPT0/1
- FMPSTG: bug fix for VMS, fix typos
- FMEDIA: debug printout added.
- FMPSTG: new routine to prestage files (from suggestion by
- Guenter Duckeck/OPAL)
- FATCDES: new media type definitions for DESY
- FATSEND: include CZDUMM for VMS
- FMQTMS: protect against invalid media type (-TMS option)
- FMINIT: sleep and retry if catalogue not found
- FMOPEN: option Q for disk files - just return (rather than ignore)
-Version 1.88=FATSRV: protect against input files with no updates!
- FMSTGQ: protect against tape not staged on VM (answer not
- stacked).
- FMRZIN: correct bug in call to FMSTGC
- FMRZIN: accept tape file if already staged (VMS)
- TMS VOLINFO tag: use SYSTEM tag IF=IN2P3
- FMHOST: declare FMHSTC as integer
- FMCLOS: format error
- FMGET(module): change to FMGET GENAM [KSN] [CHOPT] [FILE]
- FMINIT: define 2 DATs for call to FMSETM
- FMCLOS: Return IRC to user in case of problems with STAGE PUT.
- 25/05/94
-Version 1.87=FMCLOS: support options C (clear), D (remove links) and
- P (stageput) for new SHIFT stager
- FMINIT: initialise also DAT tapes (2 varieties)
- FATSCAN2: remove existing log file
- FATCAT: correct bug in handling of # RDR files
- FMTAPE: add NOWAIT option for SHIFT
- FMTAPE: don't call FMFGET(sfget) for new SHIFT stager
- FMFGET: print command if idebfa>=1
- FAFILE: open NEW files CARRIAGECONTROL='LIST' on VMS
- Add FMRKEY: replace existing key vector. Used from FMFZI
- to update existing object in place with new loc.code etc.
- FATBACK: create link to latest good backup file
- Drop bank at end of FMTOUC
- SEARCH/SCAN commands: fix bug for date/time ranges when
- only pathname specified.
- FMTAPE: put filename at end of call to stagein script
- SCRIPT: add fatchk to look for servers that are stopped
- Post 94A
-Version 1.86=Mods from Torbjorn Moa
- FMLCOP: fix bug - eliminate call to FMGTLG before FMXDSK
- FMRZIN: try DECnet access in case of $env/filename syntax
- and file not found.
- Protection in FMFZCP against FZOUT/FZRUN problems.
- Add P=FATLOOP - example 'fast' listing program
- CONVEX flag (FMOPEN)
- FMOPEN:fix bug introduced by C I/O support on Unix w/o SHIFT
- FMKUIP: add dummies to avoid linking FATMEN module with SHIFT
- VIDQQ identification
- FMPUTC: correct check on JL/JR
- Add FMGETA: get first entry matching specific generic name
- FMSTGP: treat group PUBXX like DELPHI (VXCERN reconfig)
- FMDISK, FMTAPE: delete conflicting logical names from LNM$PROCESS
- FATMDI: use RZCDIR rather than FACDIR
- FMDISK: fix faulty call to FMXDSK, set lognam in JOB table (D0)
- FMRSTG, FMRQUI: bug fixes from D0.
- mod fmrqui and fmrstg to avoid waiting for a job to complete
- when the file is already staged and to avoid running out of
- 'lun's (By Steve Glenn)
- Unix systems: exchange mode catalogues only supported
- FMSHOW: show also VOLINFO tag if IOPTQ
- P=FMUTIL,D=FMLTON,FMNTOL, correct filename
- New CMZ file - previous version archived in ADSM
-Version 1.85=Correct IRC in P=FATCAT after rename of remote file
- Reorder statements in FATLIB to satisfy FLOPPY check 39
- FMOPEN: CFOPEN also for non-SHIFT Unix machines
- FMQTMS/FMQVOL: add (GENERIC SHIFT) IF=CERN,IF=SHIFT
- FMVERS: add IF=CERN
- Add P=FMUTIL,D=FMLTON,D=FMNTOL to process locations code file
- Extra protection in FATCAT against network problems
- Print user words also in decimal (FMSHOW)
- V93D 20/10/94 16:20
- Fix backslash problem for QMALPH.
-Version 1.84=TMS return codes: 312-315 all mean roughly the same
- 312 - volume not mountable on system issuing QVOL command
- 313 - if an unknown generic system name is given as a QVOL option
- 314 - if an unknown specific system name is given as a QVOL option
- 315 - if the volume is unmountable on ANY defined operating systems
- FATMEN: reduce PAWC to 1M words
- FMLD: more logical handling of NLEVEL and -R
- FMOPEN: bug fix in options for XYOPEN (Alfonso Lopez)
- FATSEND: protect against NFOUND>MAXFIL
- Check status of LIB$GET_LUNs
- Add STATUS on OPEN in FAFNDF
- Print IOSTAT in FMRZIN if open of TPSERV.CONF file fails
- Rework lib$find_file logic in fatsrv for vms systems
- Add P=FATLOG to process *FATLOG* lines in FATSERV log
- Add P=FATSREQ, to issue SYSREQ command with retry
- Z=FATSYS: add IFMODX to flag exchange mode catalogue
- (mods to FAOPEN, FARINI, FATSRV).
- Add FATBACK to convert RZ file to FZ file.
- ADD FMFIND to issue FIND in one-line. Add FATBACK script
- Add program FATCHK to read all entries from catalogue
- FMFZI: return GENEN correctly also for LOG records
- GENEN is e.g. //CERN/DELPHI/FATLOG (to work with existing names
- files)
- V93C 08/06/93 12:40
-Version 1.83=FMXDSK: perform various checks on each element of search
- list as recommended by Keith Chadwick, FNAL
- Add FMLCOD to load location code definitions from user file
- ADD/DISK|TAPE: support user words
- CLIO support: look for 'vmstage' in current path
- (still needs mods to FMTAPE/FMCLOS)
- FATSRV: add FATLOG to write logging records to FZFILE,IF=FATLOG
- FMFZO: lower FZLOGL for journal file
- FMALLO: use ICDECI to interpret density field
- FMPEEK: add option D to drop bank after unpacking
- Add FMPLOG to print log records
- FMFZI: chvsn & chvid = char*8
- FMCOPY: add DSN to STAGE CHANGE command. STAGE CHANGE uses
- dsn STAGEOUT if the input file was staged without specifying
- the dsn.
- Add FMDDIR: delete directories even with entries
- FMCLOS: Correct handling of IOPTP in case of LBANK=0
- Add Z=FAUST for user statistics
- FMTAPE: treat RECFM=U like RECFM=F for Shift
-Version 1.82=FATKEOPS: use XZMV to rename request file
- FMKMOD: comment field was never updated.
- FMTMS: bug fixes from Steve O'Neale (FMGVID,FMGETP,FMSREQ)
- FATSRV: names file is in DEFAULT(1:LDEF)
- Protection in FMRQUI against network write errors.
- Display error code in FASTGQ in case of unexpected errors.
- Skip active files in FATSEND
- TMS library SMCF_1 changed to 3495_2
- Modify FATSEND to handle multiple groups; add protection
- against errors.
- Mods to FMLOOK, FMCSTG and FMRSTG from D0 (Krzysztof Genser)
- Protection in FMTAPE against unexpected replies from STAGE Q
- Add NeXT flag in FFATMEN and FMHSTC
- 25/02/93 10:20
-Version 1.81=FAFNDF: get short/long wait intervals and retry count from
- logical names (FATMEN_SNETWT etc.) Call FAFNDF from FMQSTG.
- FMTAPE: use FAFNDF to look for existing STAGE Q file
- FATSERV.EXEC: exit 99 if timer expires and we are FMFATCAT
- FMSELK, FMRZIN: protect against wild-cards in generic name
- FAFNDF(VAX). Add longwait interval. Add FMWTO
- FMRACK: protect against network problems.
- FMTAPE, FMRZIN: correct problems reported by DESY.
- FMTAPE: write temp file (IOPTY) in /tmp/<user>.fmstage,
- sys$login:, MAXDSK
- FMSEND: change mv to /bin/mv for Aegis users.
- FMLN: warning message if entry for target already exists
- FMINIT: set media type search order to 1,6,2,3,4,5 IF=CERN
- FATCDES: add definitions for 3490s (media type 6).
- FASEAC: FMISET is an integer function
- FMFILL: blank fields prior to filling also for option O
- FMTAPE: correct call to FMBQUE. FATNEW: clear FATNOD
- FMALLO: retry only if there are more tapes in the current
- library.
- FMFZO: correct CHFNFA handling in journal file header
- Fix warnings from Ruby compilation
- Verify CDF options against code
- Correct handling of status code in FMSEND (VAX)
- Bug fixes to FMVINF (TMS VOLINFO tag manipulation)
- wHole input staging on VM/CMS - take size from VOLINFO
- tag or media capacity.
- Bug fixes in FASEAR/FASEAC: check if any user word selection
- has been made
- Save current directory correctly in LD(FMLD)
-Version 1.80=FX=FFX in FMOPEN (removed in 1.73 for some unknown reason)
- Add +SELF,IF=CSPACK to FMSEND to avoid pulling in
- TCP/IP code unless CSPACK is selected.
- V93A 15/01/93 13:30
-Version 1.78=More mods to CDF for new KUIP (options etc.)
- Add call to INITC in FATMEN
- Modify CDF for use with new KUIP.
- KUIP style -U no longer needed with latest KUIP
- Add KSN parameter to LS command
- 14/12/92 13:20
-Version 1.77=FMFZO, FMSEND, FMUPDT: handle remote updates via CSPACK.
- Program lifetime: modules over 1 year old will print warning
- Add ABEND routine to FATSRV. ABEND prints server statistics
- and then executes fatabend script/command file/exec
- Counters in FATSRV.
- Try to clear out RDR in FATCAT - don't look on remote system
- if there are more than 10 pending files
- Handle remote catalogues correctly on VMS systems
- Bug fix to FATSRV for zz files on Unix
- Correct call to FAOPEN in FARINI
- Bug fix in FMSREQ for return buffer length handling
- Call lib$find_file_end before waiting in FATSRV.
- Option N in rm command. Don't turn on I automatically for
- option A. Reset reply buffer upon retry in FMSREQ.
- Add STRING parameter to SCAN command - options for RM
- Copy NAMEFD to FMNAMF for CSPACK access to remote files
- Wait option in FMSMCF for FMCOPY. Do not add entry to
- catalogue if FMCLOS fails.
- Remote catalogue access via CSPACK
- - FMLOCC, FMNICK, FMACCT, FMACL (use XZOPEN, XZGETL)
- - FMINIT (not yet for VM) , FAOPEN, FARINI
- 01/12/92 12:00
-Version 1.76=Use of VOLINFO TMS tag field for multi-file handling
- (routines FMGVOL, FMGVID and FMVINF)
- Bug fix in FMTOVM for new journal file names
- FMFZI: in case of warning from RZDELK, rebuild bit map
- Speed up FMSELK by only comparing required fields and
- only converting matching keys. (FNAME is converted to Z format)
- Remote access to catalogue via CSPACK, e.g. for group L3:
- FML3=/fatmen/fml3 = local/nfs access
- FML3=fatcat:/fatmen/fml3 = CSPACK access
- .netrc file should contain
- machine fatcat login fml3 password xxxxxx
- Update files are written locally and then transferred with
- XZPUTA. Configuration files (FATMEN.NAMES, .ACCOUNTS, .ACL
- and .UPDATES) read using XZGETL.
- ==> Needs CSPACK 1.28/02 921124 10:30
- Performance improvements in FASEAC, FALS (from FASEAR)
- Bug fix in FMFZO for VM - only open LUFZFA if not already open.
- Add command SCAN. Bug fix in FMRM (FMACNT never called).
- Change FMACL to support ACL files (option A) and UPDATE files
- (option U). Allows FMOPEN style updates to be controlled at
- the path/user/node level without recompiling/linking
- Don't check RC from FMLOCC in FMINIT
- Interface to DESY MVS staging system (input only)
-Version 1.75=Bug fix in FASEAC/FMFILS for re-entry with non-zero context
- pointer.
- Better protection against errors in FATCAT.
- Bug fix to FMSHOW. Print status in FMSEAR.
- Bug fixes to FMKADD (KUGETS rather than KUGETC), FMRAND and
- FMFGET (length for character strings) for DESY
- Process each update directory in turn on fatcat
- FATCAT: drop /* from XZLS call (avoid problem with globbing)
- Define MINBLK in FATSRV - minimum number of blocks left
- before cleanup is triggered (VMS)
- Correct FAFNDF handling on Unix systems
- Revise update handling in FATSRV for VMS systems
- - RMS$_FNF = wait
- - RMS$_NMF = reset context pointer and loop
- - ZZ*.* = loop
- Exploit new RZOUT option 'R' in FATSRV
- - use in case bank & keys match and entry already exists
- - if bank matches but not keys, use old method
- !!! N.B. this requires RZ version 2.00/05 or higher !!!
- RZEBRA 2.00/05 921104 17:30 THE ZEBRA RZ PACKAGE
- 28/10/92 10:00 <<<<<< Install new RZ with this version >>>>>>
- Bug fixes for IBMMVS (FMRZIN,FMCOPQ,FADARE,FMNICK,FMFPAK,FMOPEN).
- FMUSER for non-HEPVM, non-VMBATCH sites (just use IDENTIFY)
- Use RZVERI (FATSRV) to rebuild bit map of used records
- from the file itself if required
-Version 1.74=Blank search strings in FMSEAR before UHTOC calls.
- Fix error return in FMOPEN after reworking of monitoring info.
- Call stageput only for tape datasets
- Prepend CHEOPS error messages with CHEOPS error:
- Save and reset CD in TOUCH. Restore CD also in mv if rm
- failed.
- APOF77 flag: double \ in FMCD, QX_SC selection
- CHEOPSIF: call XYOPEN/CLOS only for disk files.
- Send fatal messages from PROGRAM FATCAT to FATONE
- 14/10/92 16:00
-Version 1.73=Remove treatment of FX like FFX in FMOPEN
- FMOPEN/FMCLOS etc. for links. New routine FMGETL.
- Extra monitoring information - IHOWFA, ITIMFA & CHFNFA
- Support CSPACK access to FX and FFX files, IF=CSPACK.
- Remote files may reside on VMS or Unix systems
- (VM not currently supported)
- Move FMRCOP from FMKUIP to FMINT. +USE,CSPACK to get
- functional version.
- Protect against SS$_UNREACHABLE in LIB$FIND_FILE calls
- Escape characters in 'ls': % for nicknames,
- $ for environment variables
- Server mode VMS staging - see P=REQUIRES
- Use parameters in unpacking MFQNFA
- Nickname processing via the shell
- Add FMRMLN/'rmln' command to remove/find dangling links
- Add routine FMLN and 'ln' command.
- Add routine FMNICK a la DELPHI
- Add routine FMRANK to rank CHFILES by VID & FSEQ
- Use CFIO (via CHANNEL mode) on VAX/VMS systems for FZ files
- Alpha port, bugs in FMCOPC
-Version 1.72=Require at least 2 update tokens left for mv, FMMV
- Support FATMEN.LOCCODES file for location code definitions
- Add SHOW/LOCCODES command
- FMCDF: add R='x,y,z' for all cases of CHOPT for new KUIP
- FMRZIN: check modification date and time of directory
- on entry and exit. If directory has been modified, sleep
- and retry. Add example program using FMPOKE (for SMC)
- FMTAPE: do not issue FMFGET(sfget) in case of IOPTU
- Support for /afs files in FMRZIN
- Ensure LUFZFA is set before calling FMUPDT. Bug fix in FMSTGI/O
- Return stageout return code in FMCLOS chopt=P
- Support UPDATE/FMUPDT on non-VM systems !!! N.B. the server
- must be at level V1.65 or higher !!!
- Extra debug in FMRZIN - print out RZ info for object retrieved
- FMDD2L: handle character lun, e.g. '12'
- Fix bugs in FMCLOS, FMSTGO for CHEOPSIF
- 11/09/92 16:00
-Version 1.71=FMPUTC: blank padding from LEN(STRIM) up to field width
- Option C in TOUCH: clear comment field
- Set LFMODE in FMSTGO before call to FMCLOS
- Add option A in TOUCH: set account field
- FMVERI: check also MHSNFA for disk files
- FMRZIN, FMDISK, FAINQR: DECnet access
- FMTAPE: permit staging of files > max. media capacity
- STAGE PUT support for Shift & VMS (local only) in FMCLOS
- Extra debug in FATCAT
- Use new journal file names in FMTOVM
- Check stage group in FMSTGC only on first entry
- Time FMOPEN/FMDISK/FMTAPE if IDEBFA>=1
- Add user exit FMUVER to FMVERI.
- FMTAPE: check if batch queue STAGE_xxxxS exists - if so,
- perform stage request in batch. Add routine FMBQUE.
-Version 1.70=Improve diagnostics in FMVERI for blanks/unseen characters
- in generic name. Bug fix in FMRMDR in call to FMVERI.
- Bug fix in FMSTGI/O - ensure IRC always returned
- NOWAIT option in FMOPEN - return after call to FMTAPE
- Fix for Cray compiler in FMOPEN (LCHF = 1)
- FMMVC - perform DEL then PUT
- Bug fix in FMOPEN - FX treated as FFX (as in old FMOPEN)
- V92B 20/07/92 10:30
-Version 1.69=Last minute fixes for V92B: move maximum recl and blksize
- to Z=FATFORM.
-Version 1.68=Fix bug in FMTOUC. Use option U in FACDIR call in FMSELK.
- 15/07/92 13:30
- pre-release of V92B(?)
-Version 1.67=Fix bug in FATARE for VAX/VMS systems or -TMS
- Rename *CHEOPS -> *CHEOPS2F etc.
- Support tag :queue in FATSEND - queue directory on remote node
- for current server. If not defined, use subdirectory todo.
- Check that RECFM is entirely alphabetic
- Bug fix in FMCOPY - reset IRC after FMCOMP
- MODIFY command : check that media type does not change
- New Shift Disk Pool Manager (DPM) - do not provide shift
- user or pool name. Old behaviour IF=OLDDPM.
- Protection in FMTAPE against STAGE_RC undefined or in invalid
- format. Add LOCCOD to ADD/DISK, ADD/TAPE
- Bug fix in FMRSTG (check on whether file was already staged)
- Check DCB information for output staging (VM)
- Missing FATBUG in FMFGET, IMODE in FMDISK
- Better processing of >MAXFIL files in FALS.
- Fix bugs in HP/UX version
- 03/07/92 08:45
-Version 1.66=Add location code, media type and copy level to COPY command
- Call FMVERI in FMSTGI/O. Write extra information in FMCOPQ.
- Put density on stage command IF=SHIFT,IF=-TMS
- Add protections in FMCOPY, FMTAPE for CHEOPS
- Add program FATLOOP2 in P=EXAMPLE to FMGETK every entry in the
- catalogue: ZFATAL = problems.
- Permit useful options on shell FIND command.
- Add program FATHEAD to print headers of journal file on unit 1,
- or the file name passed on the command line.
- Add option Y in FMOPEN: write stage command to file on LUN
- but do not execute. Increase size of PAWC in FM shell.
- No check on Zebra e-o-r in VM servers
- Preliminary interface to TAPESYS (UVVM)
-Version 1.65=Modify FATSEND & FATSRV/FMSEND to use new naming convention
- Ditto for program FATCAT
- Increase size of Zebra store in FATSRV
- Protection in directory scan routines against RZPAFF problems
- (!!! mods to RZPAFF - ZEBRA/RZ must be reinstalled !!!)
- Mods to FMFIXF to handle directory names beginning /
- Call FMVERI in case of directory add/remove operations
- Add CHEOPSIF patch. Routines to stage in or out.
- Bank information is passed as arguments to the routines to
- simplify C/Fortran interface
- Use command file SETUP_EXE:STAGE to submit stage command
- in FMTAPE. #bytes read (COPY_FILE only) returned in logical
- names STAGE_filename. (Not yet used)
- Change naming convention for journal files:
- zz92061118040500000499024164.user_node
- Renamed to aa... when update complete
- APOLLO: use WHICHF to determine if 'l3stage' exists in
- current path. If so, activate l3stage specific code (was IF=APOL3)
- (!!! requires WHICHF KERNLIB (kernbit) routine !!!)
- 19/06/92 09:30
-Version 1.64=Mods from KLG for FMRSTG, FMCSTG, STGSERV.
- Bug fix in FATSEND for ICONT/=0
- Modify STGSERV to send jobname ('LOOK')
- Incorporate mods from D0. to FMRSTG, FMCSTG etc.
- FMRSTG/FMCSTG. check before each job inquiry whether file
- is already on disk (and of the correct size - to be done)
- FMCSTG: wait if tape is already in use
- Job inquiry by FMLOOK (from Krzysztof Genser/D0)
- Support usernames up to 12 characters. Look for signal.stop
- files in FATSEND.
- Add option J to FMSHOW. Just the files that are accessible.
- Add MODIFY command
- Extend CP and MV commands to allow keys, fileid, host, vsn,
- vid and fseq to be changed for output file. XVID syntax supported
- Change copy level to data representation. Add new parameter
- offsets. Permit comments in acl/accounts files
- Add option R to LS : show where the data Reside. (need STAGE Q
- for Shift/Cray)
- For disk files: accessible: Y/N method: Y/N
- For tape files: active library: Y/N device: e.g. local staged: Y/N
- Add option E to RM to erase disk file. !! to be tested on SHIFT !!
- Change MV and CP commands to accept input key
- Support search lists in FMRZIN for DFS devices
- 11/05/92 13:00
-Version 1.63=Fix bug in FALS - don't print blank line in case of option V/W
- and no files found in CWD.
- Don't drop disk of server if mode A. (VM)
- Search list handling in FMLCOP.
- FALS: protection for no files found. Bug fixes from D0.
- Correct calls to VAX RTL routines (irc/istat handling).
- Bug fix in FMPEEK for 'A', 'N' options.
- Modify FMSHOW to accept LBANK=-1 (use LADDBK, e.g. from
- novice i/f).
- Protection in FMFZI - require ZEBRA end of run record in
- input file.
- Fix bug in FMTAPE - FSEQ missing from LABELDEF.
- Add program CHEOPS - read .rqid and .rep files generated
- by CHEOPS server and update FATMEN catalogue(s) accordingly
-Version 1.62=Retry 5 times in FMRZIN if keys vector has been given but
- entry not found. (concurrent update problem).
- Add routine FMACCT to check for account aliases.
- Warning messages if SYSREQ is incorrectly installed.
- Use SHIFT RFIO also for tape files (use sfget after stage
- request). Save pathname across FMLDIR calls.
- Add program FATKEOPS, to send updates from VM to
- cheops directory on fatcat.
- CHEOPS interface - routine FMBTOA to write bank in
- ascii format, write update to /fatmen/fmcheops
- or as variable FMCHEOPS. On VM, use gateway machine FMCHEOPS.
- Fix bug in FMCOPC - set media type in keys vector
- Add patch FATRZCHK to protect against corrupt RZ files.
- Add routine FMACL to provide protection on FATMEN paths
- Correct calls to FMCLOS from FMCOPY.
-Version 1.61=Use exchange mode and C I/O on DECS, if the RZ file is
- kept in a directory starting /fatmen (e.g. on fatcat)
- Support search lists in FMSTGP.
- Rewrite FMCFGL using CIGET routines (for character data)
- Print host type and OS for disk files in FMSHOW
- Add support for Physical copy in FMCOPY. This is the
- default. (Use cp/COPY/VMIO to perform the copy)
- Split FMOPEN into separate routines: FMDISK/FMTAPE/FMFOPN
- FPACK files are handled in FMFPAK.
-Version 1.60=v92a March 1992
- Fix bug in FMSELM when CHOPT=' '
- Bug fix in FMOPEN - save IQUEST(10) & (11) over call
- to FMGET
-Version 1.59=Bug fix in FMSTGP. Network retries in FMRSTG.
- Check that SETUP_EXE:TPSERV.CONF exists in FMOPEN, FMRZIN.
- More bug fixes in remote staging.
- Massaging in VAX Stage handling. Add NRFMFA
- Add Motif version, restructuring of CDF file,
- SHOW/CATALOGUES command.
-Version 1.58=Print stage log in FMCSTG, FMRSTG.
- Correct tag definitions for FATMEN directories.
- (loc.code and med.type were swapped).
- Default catalogue name is DESY,IF=DESY, FNAL,IF=FNAL in
- FATMEN shell only. Fix bug in FATSRV, FMOPEN for VMS.
- Move FAFNDF,IF=APOLLO to patch UNREF.
- Bug fixes in remote VAX staging.
- Deassign channel in FMQUOT. Use FORTRAN I/O when reading
- SETUP_EXE:TPSERV.CONF
- Add debug printout for remote staging.
-Version 1.57=Print dsn, host or vsn,vid,fseq if logl>=1 in FMFZI
- Print user & host of originator of update in FMFZI.
- Protect FMQUOT against disks with quotas disabled.
- Bug fix in FMLDIR for [] support.
- Add routines FMRSTG, FMCSTG, FASTGS, FASTGQ for remote
- VAX staging. (Across or within clusters)
- Bug fix in FMLFIL.
- Add support for remote tapes in VMS:
- tpserv device-group host1 [host2]
- Add support for RMS files (RECFM RMS, /RMS on STAGE command,
- use COPY to copy data)
- Permit creation for exchange mode files, via FATMODE in
- FATNEW (setenv FATMODE X or XC)
-Version 1.56=Debug printout in FACOPY.
- Open journal files as recordtype=stream_lf if writing
- over NFS from VMS->Unix.
- Fix bug in FMGLUN.
- Print date and time before going to sleep
- Fix warnings from VSFORT 2.5 compiler (unreachable code
- in routines FMCOPC and FMRZIN. See warnings in these routines)
- Fix bug in FMTAGS (undefined variable)
- Friday, 13th December
- Fix bugs in FMSEND
-Version 1.55=mods to FAINQR and FMRZIN for FPACK files
- If host is not local, then search in .netrc file for nodename
- IBMMVS: userid.PER.NETRC
- VAXVMS: netrc.;
- VM/CMS: DOT NETRC A0
- Unix : $HOME/.netrc
- Update FATNEW for MVS. Resync copy level with FPACK
- FPACK interface: in case of FPACK files, routine FPARM
- is called in FMOPEN & FMCLOS. FPARM handles file open and
- starts server etc as necessary.
- OPEN: CALL FPARM('OPEN logical-name UNIT=lun FILE="fn"'
- CLOSE: CALL FPARM('CLOSE logical-name')
-Version 1.54=Support NFS mounted files (FMRZIN, FAINQR) VAX/VMS, Unix
- Use sequence QFTITLCH to get pam title rather than QFTITLE
- Fix bug in FATSRV for check on /done directory (Unix systems)
- Handle .. characters in FMPAFF and FMFIXF
- Fast match in FALS, FMLOOP (file='*')
- Add ACTION=read/readwrite on OPENs. Modify FMHOST for CMS 7.
- Fix bug in CP command - cwd was not correctly restored.
- Add FATOUCH example program, to touch files or directories.
- Fast count in FMFC, if filename=*. (Uses 1/3 of CP time)
- Changes in FMOPEN for shift - call CFOPEN for
- full shift file name, not fort.n
- Use C I/O and exchange mode for RZ file if
- STREAM_LF (VAX) or in /fatmen (CERN Cray)
- Call FMVERI from FMRM, FMRMC
- Use configuration files to determine device access.
- VAX/VMS,IF=VAXTAP: logical names SETUP_modelS
- IBMVM, IF=HEPVM : nodename RESOURCE P
- SHIFT : /etc/shift.conf, /etc/TPCONFIG
- CRAY : /etc/shift.conf
-Version 1.53=Add routine FMQUOT to P=FMVAX - get current disk quota
- information (from SPACE by JJB). Perform cleanup in FATSRV
- Perform automatic cleanup in FATSERV EXEC
- Update return codes in FMATCH. Return location of
- mismatches in IQUEST. Modify FMSCAN to treat wild-carded
- and non-wild-carded pathnames alike.
- Add routine FMHUNT - hunt for (wild-carded) generic name
- Set IQUEST(10) to number of levels in initial path in FMLOOP
- Common version for CERNVM, CERNVMB & LEPICS
-Version 1.52=Access to SMCF now based on sequence FASMCF.
- Access enabled, however, for SHIFT, CSF, VXCERN, APOL3
- Fixes for CERNVMB
- More examples in P=EXAMPLE.
- Extra protection in VAX, Unix versions if FM symbols
- not defined.
- Rewrite FMLDIR using FMSCAN
- Add support for [] wild-cards.
- Given the following subdirectories:
- Y91V02
- Y91V03
- Y91V04
- Y90V06
- Y91V05
- ld y(90:91)v> will follow Y90V06, but ld y[90:91]v> will
- follow both Y90V06 and Y91V05.
- Call FMACNT on each entry to FMRMC, in case user has reset acct
- Fix bug in FMPOOL when TO specified
- User meeting of 16/10/91 (ship command not yet implemented)
-Version 1.51=Add routine FMSETK - set keys matrix for d/s selection
- Add commands SET/SHOW userwords.
- Add routine FAINQR - inquire with GIME/sfget/env. variable
- expansion.
- Add FMSELM routine - select by keys matrix.
- Add ZOOM command to zoom down directory tree to first
- directory with no subdirectories & at least one file
- FMSCAN now descends specified number of levels below
- wild-carded pathname, and not below path up to last wild-card
- Add option V in FMOPEN - as S but even if file size is ^0
- Fix bugs in FMMANY, FASELP for <> matching.
- Fix bugs in FAT2VM.COM, FMTOVM to not send files back to origin
- Add FACDIR interface routine - reset top directory
- if naming directory is not TOPDIR
- Fix bug in FAEXTR
- Fix bug in FMALLO - use separate buffer for QUERY CONTENTS
- Modify FMLD to use FALD - remove limitations on
- numbers of directories that can be displayed.
-Version 1.50=CNL 204 - 12/09/91 09:00
- Add FMLOOP. As for FMSCAN but for file names
- Add FMMODU - modify user fields
- Use FMSCAN from FC, LS commands and routines
- Add routine FMSCAN & FASELP. FMSCAN provides FMLDIR
- like functionality but avoids the use of local arrays
- by calling user exit. <> are also supported.
- Option Q in FMSHOW also shows TMS tags
- Extra protections in FMINIT
- Add options Q, S, T (A) in CD to list RZ quota, statistics,
- dates & times etc. Add command DIR to issue RZLDIR.
- Add option Y in FMLSC - verify bank contents
- Permit reinit if user typed a bad FM group
- Add utility routine FAEXST
- Add command ALLOCATE to add tape file with volume
- allocated from named pool in specified library.
- Add TREE command to print directory tree
- Use FMOPTC rather than UOPTC - checks on CHOPT case insensitive
- Treat <> like * in FMATCH (with warning if LOGL>=3)
- Change flags for routine names (Lowercase, Underscore etc.)
- Fix bug in FATMDI introduced by move to FATLIB.
- Purge CON files in FATSERV on VM
- Fix bugs in FMXDSK. Add warning in FMOPEN if size > MAXSTG
- Add command MEDIA to set/show media attributes
- Command files for VAX servers - scripts for FATCAT
- Add patch FATSEND to send FATMEN updates to remote
- servers, according to NAMES file. Current version
- is for Unix and VMS systems only.
-Version 1.49=Interface to VMTAPE (FMOPEN/FMFIND/FMMAKE) & FMALLO
- Interface to VMBATCH (for FMUSER, FMACNT, FMJOB)
- Add routine FMEDIA to set default media attributes.
- Call FMUTMS (user exit) from FMQTMS IF=-TMS to allow
- user to override these values for individual volumes.
- Add option G to RM command, to change protection
- group on a volume. Defaults to *None.
- Add routine FMPROT.
- Add command RMTREE, to delete a complete directory tree.
- Modify FMATCH & FMMANY. Pointer now reset after a *
- by looking for a substring, rather than single character
- Only check TMS information in FMVERI if Q option present.
- Add routine FMTAGS, to get, set or delete TMS tags.
- Change default shift staging pool from PUBLIC to shift1
- Add program FAT2SQL - convert entire RZ file to SQL
- Add routine FMVMIO - user hook routine for FZ D/A
- for binary exchange format files on IBMVM.
- Protect against error opening input file in FMFZI
- Option D in SEARCH (FMSHOW really): write KUMAC file
- to remove matching entries
- Use FORTRAN I/O by default for FX, FXN files.
- This is default for Zebra 3.67 and above, unless Y
- specified on FZFILE.
- Fix bugs in FMOPEN for SHIFT. N.B. must use -lsun for
- XY routines. To get debug from XY routines:
- setenv RFIO_TRACE 3
-Version 1.48=Issue QUERY LIBRARY in FMQTMS IF=QVID to determine if
- library is active or not. Libraries beginning with a '*'
- are apparently inactive by definition.
- Issue option X on FZENDx in FMCLOS if C I/O selected in FMOPEN
- Return true RC from SYSREQ in IQUEST(1) (FMQMED)
- 312 = volume unavailable only fatal in FMRZIN when key not
- specified.
- Allow staging disks upto 210 MB IF=CERNVM. Default to
- sequential access for FZ files on disk.
- Support date & time ranges in SEARCH
- Mods for DESY.
-Version 1.47=Add FATPURGE.COM to delete old files in [.DONE]
- Add FATRL.COM - modified RDRLIST.COM to copy files send to
- VAX via SENDFILE to [.TODO] directory
- Add FAT2VAX exec to send updates via Interlink
- Support MVS in FATSRV.
- Add FMUSER for MVS systems (adapted from KPREFI)
- Add /*DECK, $!DECK lines to REXX/DCL patches
-Version 1.46=Fix PREFIX support in FMOPEN, FMFIND, FMMAKE
- Support range of Copy Levels, Media types in FMRZIN, FMLS(C)
-Version 1.45=Fix bug in FATCAT - reset IC after call to XZLS
- Fix bug in RM command for freeing volumes
- Permit use of FMGETV/C/I, FMPUTV/C/I from novice interface
- (LBANK=-1)
- Add example pgm using novice interface in patch EXAMPLE.
- Add example installation procedures
- Perform checks on input parameters in FMINIT, FMSTRT
- Set location code to the value given by a call to FMSETL
- (or set/loc) in FMKADD, FMKADT, FMADDD, FMADDT
-Version 1.44=Add commands SET/COPYLEVEL, MEDIATYPE and SHOW commands
- FZFILE options: T only if read directly from tape.
- Add command SET/LOC
- Check that location code of each candidate is found
- in location code vector specified by user (FMRZIN)
- Modify for use with ORACLE on FATCAT(IBMRT).
- Oracle RTL compiled without -qextname
- Requires trailing _ on ORACLE interface routines,
- Common/FOFILE/ and CLTOU.
-Version 1.43=Check status from stage -o in FMCLOS (APOL3)
- VID prefix support for all calls to FMQTMS.
- Change key allocation in FMALLK: now use maxkey+1
- Change FMACNT to check env variable FMACNT
- FMQTMS, FMGTMS: iquest(1) = -1 if -TMS
- Add routine FMQMED to return media type and mount flag
- Add options AFIU to FMRMC (All,Free,Interactive and Unlock)
- Support search options as for FMSEAR.
- Use C I/O for Zebra FZ if IQUEST(10) = 1
- Look at environmental variable FMHOST (Unix, VAXVMS)
- Use this as nodename, if set.
-Version 1.42=Bug fix in FMNODE for VAXclusters
- Fix bugs in FMTMS patch for SYSREQ retry
- Revert to CART for APOL3 - old stage still on LEPICS
- Fix bugs in FMCOPC, FMRCOP.
- Fix bug in FMFZI - return code from VMCMS undefined.
- Add example EXEC/COM/SCRIPT for running pgm FATNEW.
- Fix INQUIRE bug in FMKUIP routines for VM.
- Fix typo in FMOPEN. Add -h in fmld, fmseac, fmlsc, fmfc.
- Support options -V,-W in FMLD
- IBMMVS version. Current implementation assumes that all files
- are catalogued.
-Version 1.41=Add stage -o for APOL3 in FMCLOS. Reinstall and test on Apollo
- Support non-CERN catalogues: variable FATSYS (server, pgms),
- INIT //fatsys/group (KUIP)
- Modify FC command to support CHOPT: count #file/dir,
- #subdirs/dir.
- Use FMLFIL in FMLSC, FMSEAC
- Fix bugs in FMLDIR. Restore code for NLEVEL in FMTREE, support
- in LD command. Fix bug in SEARCH for NMATCH=n.
- Change CART to CT1 in FMMAKE (this is now returned by the TMS
- for manual 3480s)
- Retry in FMALLO if first tape from Q CONTENTS has been
- allocated away from under us...
- Add protection in FMOTOZ for bad ORACLE information.
- Fix bugs in FMATCH, FMOTOZ, FMLD.
-Version 1.40=CNL201
-Version 1.39=Fix bugs in FMLDIR. Add FMLFIL, FMFILS.
- Add return codes for SYSREQ(TCP)
- Use FMSREQ to perform call to sysreq with retry
- Add calls to L3 stage script in FMOPEN, FMFIND, FMMAKE
- Add FMFILC - like FC in FM shell.
- New calling sequences for GETENVF, SLEEPF.
- Fix bugs in SHIFT version
- Add IBM MACROS (needed for MVS version) to FATCDES.
- Add program FATCAT to send updates to FATCAT upon
- arrival in RDR and poll for new updates at wakeup
- interval.
-Version 1.38=SHIFT code for sfget (DSN is [pool.user]/unix-dsn)
- Add MVS routines from DESY
- Split FMOPEN, FMFIND, FMMAKE
- Add routine FMFNME to generate extended unique file name -
- not suitable for VM systems.
-Version 1.37=Add Patch FATULOK. Example program to unlock FATMEN RZ file.
- Current version will unlock 'CERN.FATRZ' in current directory
- Put large arrays in FMALLK, FMLIST, FMLDIR into commons.
- Add options K (keep) and P (autoput) to FMOPEN
- Modify FMQTMS so that the correct media type (taken from
- bank) is returned if volume unknown or TMS option not
- installed. Media type is passed to FMQTMS via IQUEST(11).
-Version 1.36=Add patches DCL, SCRIPT to contain sample command files/
- scripts to start FATMEN server.
- Add variable FMWAKEUP (FATMEN$WAKEUP on VAX) to define
- FATSRV wakeup interval
- Fix all warnings reported by Apollo compiler.
- Return in FMOPEN for Unix systems without tape support
- (currently only Cray, Shift)
- Extra protection in FMINIT if logical name/env. variable
- pointing to FATMEN catalogue is not defined.
- Fix bug in FMLD for bad pathnames
-Version 1.35=Fix bug in FMRM if non-existant key is specified
- Use XYOPN in FMOPEN for SHIFT disk files
- Add WRTAPE support in FMCOPY for VAX
- Add option MEDIA in ADD/TAPE and FMADDT. (For NA44)
-Version 1.34=Fix bug in FMALLK, extra debug in FMFZI.
- Use stagewrt in FMCOPY for Cray
- Add SHIFT support: use stagein/stageout scripts in FMOPEN.
- All SHIFT files are assumed to be accessed via RFAS routines.
- Current support only for FZ binary files...
- Add routines FMULOK, FMPOOL to unlock (enable write) and
- transfer a tape from one pool to another. Modify FMSHOW
- to display the host on which a disk file resides, rather
- than that from which it was catalogued.
- Add DCB/Generic device support in VAX version
- Move 'fix' for check on robot/manual to FMQTMS
- Add extra print out in FMFZI.
- Fix bug in FMQTMS introduced by VID prefix support.
- Add command SEARCH to allow searches on DSN, HOST, VID and
- USER. Output is piped to FMSHOW.
- Add option Z in FMCOPY - use STAGE OUT for output file
- Add routine FMGBYK (get by key-serial-number).
- Modify FMLS to support options I (sort in Increasing order)
- and 1 (display only one entry per generic name).
- Option W in FMLS - multi-column output
- Modify FMSHOW to call FMSHO2 in case of options B (brief=80 cols.)
- or E (extended=132 cols.) listing. Modify FMOPEN to take
- file size for STAGE request from IQUEST(11) if option O(verride)
- is specified. Fix bug in FMLD for output redirection.
-Version 1.33=Add routines FMSETL, M, C, U to set the list of (<100)
- location codes, media types, copy levels and logical units
- for use in FATMEN selection and for use by FMCOPY etc.
- Add routine FMPUSE to print usage information.
- Add routine FMUNIQ to return a unique list of file names
- in specified directory. Selection may be made under normal
- keys mask, as for FMSELK.
- Add routines FMJULI/FMDATE/FMDAYS to provide conversion to
- and from julian date and delta time.
- New entry point FMDCB - provide DCB or take from 'model DCB'
- Add routine FMFZCP to copy an FZ file from LUNI to LUNO.
- Called by FMCOPY. Logical units required by FMCOPY may
- be set in IQUEST(11-12).
- Change size of RZ file to 65000 records (new protection in RZ)
- Fix bug in FMKEYS/FMSELK.
- Close and reopen RZ file in FATSRV on return from FMFZI.
- This ensures that updates are seen by clients.
-Version 1.32=FMPEEK/FMPOKE routines - return information from FATMEN bank
- in vector/ copy vector to FATMEN bank with optional catalogue
- update.
- Rename FMADDT/FMADDD to FMKADT, FMKADD. Add routines FMADDT,
- FMADDD in patch FATUOUS. Add routine FMSTRT -
- "Novice" initialisation routine which also initialises Zebra
- Suppress call to RZDELK in FMFZI for MOD operations
- Add option L in FMOPEN - override Label information with
- DCB from catalogue or user-supplied bank
- Add routine FMLDIR - provide <> wild-card support plus
- context pointer.
- Support wild-cards in any location in LD command.
- Add routine FMCOPC - command line copy routine. Permit copy
- to named VID, tape allocated from pool, remote copy (via
- CSPACK) or copy according to two existing catalogue entries.
- Add entry point FMGTMS to obtain FATMEN oriented details from TMS
- Change calling sequence of FATUOUS interface to match CERNLIB
- standard. Fix bug in FMLD for -R option, VID-prefix handling
- in FMADDT.
-Version 1.31=Add 2MB to file size on VMSTAGE request, if < 200 MB
- Modify FMPUTC/FMGETC to support VID prefix field
- VMSTAK now also for HPO. Use KERNLIB version of GETENV
- Add ZABEND routine for FATMEN shell - avoid ZPOSTM
- Support VMIO in FMOPEN for DDNAMEs like VM%%F%%%
- Update mode corresponds to FMOPEN option X
- Add pilot patches for CERNVM, LEPICS and FRCPN11 (ugh)
- Add routine FMMANY - match many files, selecting
- according to < or >.
- Add routine FMCHOP - check options against allowed values
- Output to search list on VAX: use disk with most space
- Add routine FMKEYS. As RZKEYS, but with IFIRST,ILAST
- to avoid the use of large arrays.
- Use QUERY VID instead of QVOL (IN2P3 only, temporary!)
- Return immediately after STAGE command in FMOPEN if NOWAIT
- Support output redirection in LS, LD
- Add patch FATUOUS - novice interface
- Add routine FMFILE - as FMOPEN but no LBANK
- Add routine FMPREF to convert VID prefices to/from
- CHARACTER/INTEGER
- Support STRONG TYPING IF=TYPE in PATCHY sequences
- Add call to FMUPRT in FMSHOW, FMUSEL in FMRZIN
- Add PATCH FMTMS for TMS interface routines (FMALLO,
- FMQTMS and FMLOCK)
- Add entry point FMSCAN - FMLIST + FMSORT + FMGET
- Add DA as valid file format: open ACCESS='DIRECT'
- in FMOPEN for format DA or it option X is given.
- Support full wild carding of generic name in FMLS
- Support RZOPEN in FMOPEN, RZEND in FMCLOS
- Provide interface to DUMPTAPE (IBM, Cray)
- Extend FATOPTS to numeric options
-Version 1.30=CNL 200
-Version 1.25=Fix bug in FMCOPY - close both input & output files
- if an error occurs opening the output file
- Fix bug in tape allocation in FMOPEN
- Free tape unit correctly in FMCLOS for output volumes
- Lift bank in FMADDD/T only on first entry. Add FFX
- as valid file format.
- Use FMBOOK in FMSMCF - save address in link area
- FORTRAN version of FAFNDF based on SZLS from CSPACK.
- Use RZOPEN from FAOPEN
- Extend IFLAG in FOPUT: add only if not already present
-Version 1.24=Move FMALLK to patch FATSRV.
- Fix bug in FMCOPY when called from FMSMCF (infinite loop)
- Treat characters following a blank in DSN as a comment.
- Correct FMQTMS, FMALLO for VAX.
- Print DSN stacked in FMOPEN if LOGL >= 0
-Version 1.23=Extra protection in FMFZI for file deletion.
- Fix bug in FMCOPY for VBS files. Remove unecessary
- protection in FMSMCF for unknown VIDs.
- Add TESTFAT KUMAC - example test macro in PATCH FATTEST
-Version 1.22=Try to reduce size of program. Limit number of directories
- that can be displayed in FMLD to 10000, number of
- copies of a file to 1000 (parameter MAXCOP).
-Version 1.21=Ensure that VMOPEN error codes are passed back to user
- Force updating of KEYS vectors from BANKS in FMCOPY
- Option C in FMCOPY - use STAGE CHANGE, option S, using
- STAGE for input file (C implies STAGE for input and output)
- No FORTRAN open in FMOPEN if using IOPACK.
- Add sequence FATPARA in FMEXST.
- Add flag NOSMCF for LEPICS - no TMS or robot access
- Fix bug in FMLIST for call to FMFNMS (no wild cards)
- Increase FORMAT statement for key serial number and loc.code
- Set MAXKEY to 10000. Always put DCB on Cray STAGE
- Use -S sbin option on Cray
-Version 1.20=CNL 199
-Version 1.18=For input tapes, must use 'EXEC STAGE CLEAR' in FMCLOS
- CTRANS, CSQMCH now in KERNFOR.
- Add parameter lengths of character fields
- Fix conversion of LUN to DDNAME in FMOPEN for IOFILEnn
- Attempt reconnect to ORACLE if IRC=3114 or 6065
- Erase FATMEN RDRFILE after successful processing.
- Fast exit in FATSERV EXEC in case unprocessed file exists
- Increase working space to 200K words in FATSRV.
- Save current directory in FMLS for restore at end
- Add routine VMSTAK. Print shortest/longest record in FMCOPY
-Version 1.17=Fix bug in FMSMCF for check on robot/manual.
- Convert TMS density to SETUP/STAGE format
-Version 1.16=Check bank address in FMVERI using MZCHLS
- Add routines FMGETV, FMPUTV, FMGETC and FMPUTC to get and
- put information to/from FATMEN bank.
- Add FATSTACK exec for LABELDEF FID ? in FMOPEN.
- Add routine FMFILL to fill FATMEN bank with default
- values according to CHOPT. Old FMFILL renamed to FAFILL.
- Set MNTTYP to 'R' if TMS unavailable and vid = Innnnn
- Add routine FMEXST to check if entry already exists.
- Ensure that Media type is set (keys and bank) in FMFILL,
- FMALLO, FMCOPY.
- Call EXEC FATSTACK to stack FID for FMOPEN option T
- Fix bug in FMFZI for call to FMCOMP, default density
- in FMQTMS=38K (not 38000).
- Use VMCLOS in FMCLOS for DDNAMEs like VM%%F%%%.
- If STAGE fails, retry using larger disk size up to max.
- CP DETACH tape unit (option D in FMCLOS)
- Use new version of SYSREQ (one line per CHARACTER element)
- Protect in FMVERI against blanks, unseen chars in GENAM.
- Update use count in FMOPEN only for input datasets
- Output datasets require U option in FMCLOS
- Add option E to FMOPEN - issue SETUP (END
- Save vaddr of tape unit used in FMOPEN, free in FMCLOS.
- Save and reset current directory in FMCPC, FMMVC.
- Extend FMCOPY - disk-disk, disk-tape, tape-disk, tape-tape
- via VMIO. Fix bug in FMALLO for curious length TMS replies
- Rewrite FMRM. If more than one match is found, key serial
- number must be specified.
-Version 1.15=Fix bug in FMFZI in call to FMCOMP.
- Set date/time of cataloging, last access and use count
- in FMSMCF. Add -K option on stagein (Cray)
- Add Apollo version of GETENV (FMGENV)
- RC=3 from TMS, use defaults IF=TMSTEST, ELSE sleep
- for 1 minute and then retry.
- Option G in FMALLO - change control group to *None
- to allow GROUP access to the tape allocated.
- FMLIST calls FMFNMS if PATH contains no wildcards
- Labeltype in lower case on Cray
- Add routine FMSMCF to make automatic copy into SMCF
- (FMOPEN option D, CERN specific routine!)
- Add flag TMSTEST (for CERN until all tapes in TMS)
- Modify FATSERV to support FATOWNERS and FATOPERATORS
- lists from NAMES file. Apollo version with local catalogue
-Version 1.14=Add routine FMCOPY - copy dataset from GENAM1 to GENAM2
- using STAGE CHANGE, COPYTAPE, DISKTAPE, TAPEDISK or ZFTP.
- Add option S in FMOPEN - update bank with file size from
- VMSTAGE. Add option N in FMOPEN - do not specify DSN on
- STAGE/LABELDEF command. Stop in FAOPEN if RZ file not found.
-Version 1.13=Add shell command MAKE. Add print out to FMCLOS.
- Add DCB to FILEDEF for VM/CMS disk files. Print use count
- in FMLS/FMSHOW (option P).
- Add OPEN to FMOPEN routine, unless option U(seropen)
- Support C(lear), D(rop), E(nd), F(zstat), P(ut), U(pdate)
- options in FMCLOS. Add routines FML2DD, FMDD2L to convert
- FORTRAN logical unit to corresponding DDNAME.
- Add call to FZFILE in FMOPEN, if option F is chosen.
- Add optional parameters RECFM, LRECL, BLOCK, FSIZE in
- FMADDT/D. Add support for 3420s (media type 3) in FMRZIN
- Use mode 4 for VM VBS disk files.
- Support remote non-Bitnet servers. Pull updates over
- using ZFTP based utility. Polling interval defined by
- remote installation.
-Version 1.12=Fix bug in FMSHOW for user supplied bank.
- Add flags SETUP and STAGE to allow sites to enforce tape
- processing style.
- Add entry FMOPEN - just options RTUW for now
- Use TMS to allocate tapes in FMALLO
- TMS QUERY CONTENTS LIBRARY <lib> user <pool> slot 1
- TMS GETPOOL VID <vid> FROM <pool>
-Version 1.11=Add C routines for Cray to find next file in a directory
- (from Phil Defert). Fix bug in FAT4WARD when no remote
- servers are specified.
- Add exec FAT2CERN to forward updates to CERNVM, unless
- they originated there.
- Activate FAT4WARD if on CERNVM (forward last update to
- remote servers)
- Add routine FMBOOK - create bank with FATMEN format at
- L, LSUP and JBIAS specified by user.
- Fix bug in FMMV - protect bank address in LTDSFA
- Add command VIEW, to edit a local disk file, using KUEDIT.
- Use TMS to determine MNTTYP in FMRZIN. Get labeltype,
- generic device from TMS (FMFIND/MAKE)
- Add interface to TMS (FMLS/FMSHOW) + patchy flag TMS.
- Set warning in FMVERI if VID unknown to TMS.
- Update use count (MUSCFA) and last access date in
- FMFIND/MAKE. Increment in FMFIND, set to 1 in FMMAKE.
- Modify FMTOVM to issue dispose from Cray to CERNVM
- VM: Nick names FATSYS, FATGRP, fatgrp
- VMS: Logical names FATMEN$SYSTEM, FATMEN$GROUP, DISK$fatgrp
- Unix: Variables FATSYS, FATGRP, fatgrp
- Send logging message to server only on CERNVM
- Add interface to TMS via routine FMQTMS. Use flag TMS
- to allow sites without TMS to continue.
- Use variables for UNIX systems to determine location of
- FATMEN RZ file (FMgroup=/u/mf/fml3, for ex.) and
- group for which this server is running (FATMEN)
- Use count stored in MSYWFA+1(=MUSCFA)
-Version 1.10=Enable CONVEX flag. Introduce FFATMEN patch
-Version 1.08=Fix bug in FMALLK when directory is empty.
- Allow VAX server to run under any account.
-Version 1.07=Fix bug in FMVERI for check on user words.
- Fix bugs in 1.06. Bad +SELF in FATMDI. Fix bugs in VAXVMS
- version. FATMEN logical names now in GROUP table.
- Add patch FATNEW (to create new RZ file)
- Ensure that directory is reset in FMFNDC
-Version 1.06=Fix bug in FMVERI - copy level may be 0. Add EXECs to PAM
- Calls to FMONIT in FMFIND/MAKE rather than FMGET
- Add routine FMVERI, return extra information via IQUEST
- in FMLIFT, FMKDIR. Extend FMOPEN/FMCLOS.
- IQUEST(11) = 1 : generic name already exists
- IQUEST(12) = 0 : path name already exists
- IQUEST(12) = 1 : path name does not exist
- Numeric ranges (m:n) supported in FMLIST
-Version 1.05=Add routine FMSORT - call SORTCH (modified from SORTZV)
- Fix problem in FMFZI - allocate next key using FMALLK
- In case of MOD or REP operation, re-use old key.
- Add DCB on STAGE OUT /FILEDEF commands (VM only)
- Add routines FMUPTM/FMPKTM - as DBxxx but with return code
- Use mode 6 for RZ files on VM (unless mode=*)
- Fix bugs in FMATCH. Add routine CSQMCH (squeeze multiple
- characters) Add FMSHOW example print out routine.
- Use DEVTYP SMCF for robot, if VID =Innnnn and MMTPFA=2
- Introduce flag DECS for DEC MIPS. Modify C code to
- use +SELF rather than #IFDEF.
- Add journaling of FZ files. Use AUTOPUT option on
- STAGE OUT command. Tidy LOGL.
-Version 1.04=Retry connect to ORACLE up to 5 times. Reinit RZ if
- error from RZFILE. Add FMALLO on VM systems
- New versions of SQL/DS compatible FOxxx routines.
- Cleanup pilot patches. Modify for AIX. Default for CD is PWD
- Find KEYS(1) using FMSELK,FMCOMP in FMFZI (for
- remote delete to work).
- Allow NOWAIT option in FMFIND, if CHLUN=NOWAIT
- Add routine FMCOMP to compare banks pointed to
- by two generic names.
- Add routine FMLIST - combine FMTREE with FMFNMS and wild
- card support for directory names.
- Add G option to FMLS - list full generic name
- Support VAXclusters and DFS in FATMEN selection.
- VAXclusters treated as a single node, DFS disk
- taken after local disk but before local tape.
- (DFS logical name must be in LNM$SYSTEM_TABLE).
- New routine FMSELB to allow user to perform select on
- contents of FATMEN bank.
-Version 1.03=Fix bug in call to RZIN - don't use 'S' option.
- Server now uses FATLIB.
- Rewrite FMATCH subroutine. Add LOGLEVEL to FMLS
- Bugs fixes and enhancements from DELPHI installation.
- Add debug print to FOPUT. Add patch TAPELOAD.
- Add PROGRAM FATO2F - recover from ORACLE /SQL and send to
- server as FZ file(s).
- Add DSN to STAGE command. Add UPDATE command to CDF.
- Bugs in FMLIFT/FMLINK fixed (IQUEST/IRC uninitialised)
- Fix bug in FMFILL for user-allocated tapes
- Error message in FMRM if key vector cannot be found
- Add routines FMMOD and FMUPDT
- Examine REXX variable FREE_BLOCKS to determine number
- of records to preformat in RZ file (for FATMEN server)
- Modify FMFZI, FMZTOR and FOPUT to support equivalent
- of DISP=NEW, OLD, MOD.
- Add routine FMSELK to allow selection of files on
- basis of keys vector (e.g. media type, copy level etc.)
- Add SIZE qualifier on input STAGE requests. Sizes are
- based on current VMSTAGE disk sizes.
- Selection of best copy (local_disk>robot_tape>manual_tape)
- Improved logging: Level -3 Suppress all log messages
- -2 Error messages
- -1 Terse logging
- 0 Normal (FMINIT, FMEND etc.)
- 1 Log to watch FM calls
- 2 Log to monitor FM decisions
- 3 Debug messages
- Add PATCH FATSTAT, to print statistics on usage
- of FATMEN RZ database. Current version VM only.
-Version 1.02=Bugs reported by CHARM2.
- Conform to CERN Program Library convention for flags
- Preformat RZ file before call to RZMAKE by writing
- 2500 records (fills 85% of a 20 cylinder disk)
-Version 1.01=Coincide with version 1.00 of documentation
- Add IRC to all FM calls, make FMATCH a subroutine
- Use KIPRMT to set KUIP prompt, rather than KUEXEC
-Version 1.00=Meddle meeting of 19/10/89
- and CERN Library release of CNL196
-File and Tape Management Package
- Requires:
- CERN libraries,
- HEPVM (VM/CMS systems),
- VMS 4.6 or greater (VAX/VMS systems),
- Apollo SR10 (Apollo systems),
- Unicos (Cray systems).
-
- Enhancements to external packages:
- Requests from LFATMEN list:
- <> wild-card support (Daniel Lellouch) (done, FMLDIR)
- <n1-n2> in FATMEN selection (fmnext)
- Wild card support in LS, LD (done)
- Output to disk files for LS, LD (done)
- COPY command in FM shell (done for local files)
- Select disk with max. space for output to search lists (VAX) (done)
- To be clarified:
- For FORTRAN 90:
- Hollerith (FMSTRT, FMINIT, FMVERS)
- UCOPY (FMMODU)
diff --git a/src/packlib/fatmen/doc/requires b/src/packlib/fatmen/doc/requires
deleted file mode 100644
index c6d85c0..0000000
--- a/src/packlib/fatmen/doc/requires
+++ /dev/null
@@ -1,56 +0,0 @@
-*
-* $Id: requires,v 1.1.1.1 1996/03/07 15:17:35 mclareni Exp $
-*
-* $Log: requires,v $
-* Revision 1.1.1.1 1996/03/07 15:17:35 mclareni
-* Fatmen
-*
-*
-* This directory was created from fatmen.car patch requires
-
-The FATMEN package requires the following other packages to run:
-
-- ZEBRA, KUIP, CSPACK (from CERN Program Library PACKLIB)
-
-- KERNLIB
-
-- FPACK (if the flag FPACK is +USEd)
-
-In addition, the following system specific software is required:
-
-VM/CMS systems
---------------
-
-HEPVM software (EXECs, tape handling software, Tape Management System IF=TMS)
-
-(An interface to VMTAPE and VMBATCH is also provided)
-
-VAX/VMS systems
----------------
-
-- VAXTAP (CERN Program Library) for tape handling
-
-N.B. for server mode staging, a logical name STAGE_QUEUE must be
-defined in the system table. This directory must be world writable.
-The current recommended practice is:
-
-a) Define STAGE_QUEUE to point to the same directory on all nodes
-b) Use batch mode staging on all nodes.
- Batch mode staging is used by default if a batch queue STAGE_xxxxS
- exists, e.g. STAGE_8200S
-
-Unix systems
-------------
-
-SHIFT/CORE software for tape handling, IF=SHIFT
-
-L3 Apollo tape staging, IF=APOLLO and the file l3stage is found
-in the current path.
-
-System dependant information
--=-=-=-=-=-=-=-=-=-=-=-=-=-=
-
-RS6000:
-To compile the CDF file, use the following options on the XLF command:
-
--q ST_SIZE=5000 -q TKQ_SIZE=20000 -q charlen=32000 -q extname
diff --git a/src/packlib/fatmen/doc/tapeload b/src/packlib/fatmen/doc/tapeload
deleted file mode 100644
index 27d365e..0000000
--- a/src/packlib/fatmen/doc/tapeload
+++ /dev/null
@@ -1,984 +0,0 @@
-*
-* $Id: tapeload,v 1.1.1.1 1996/03/07 15:17:35 mclareni Exp $
-*
-* $Log: tapeload,v $
-* Revision 1.1.1.1 1996/03/07 15:17:35 mclareni
-* Fatmen
-*
-*
-* This directory was created from fatmen.car patch tapeload
- PROGRAM TAPELOAD
-*...TAPELOAD
-*. FATMEN utility program to read tape details from a number of files
-*. ,extracting and processing the relevant information,before storing
-*. it within the FATMEN file catalogue.The 3 types of file that must
-*. be made available to the program are as follows:
-*. 1. A file of tape Volume Serial Numbers,identifying each tape
-*. file to be processed - these having already been staged as
-*. seperate disk files of the same name.
-*. 2. A number of tape files staged onto disk,each containing the
-*. compulsory header and data components,and optionally a
-*. trailer component.
-*. 3. A file containing run information for a number of tapes,this
-*. being inclusive of a generic name,a list of detectors not in
-*. use during the run,various other tape information and
-*. possibly a user comment.
-*. Only the information required for each catalogue entry is
-*. extracted from the above.Where an entry cannot be made the FATMEN
-*. default is allowed to take effect.
-*.
-*. COMMON :
-*. SEQUENCE :
-*. CALLS : ERRSET MZEBRA MZSTOR MZLOGL MZLINK FMINIT FMLIFT
-*. FMLINK UCTOH DBPKTM DZSHOW FMPUT
-*. HDRTRL BINTCM GETTAP CONCAT FATDAT
-*. CALLED :
-*.
-*. BANKS L :
-*. BANKS U :
-*. BANKS M :
-*. BANKS D :
-*.
-*. REPORT CONDITIONS
-*.
-*. AUTHOR : G.J.Barlow
-*. VERSION :
-*. CREATED : 02-Nov-89
-*. LAST MOD :
-*.
-*. Modification Log.
-*.
-*.**********************************************************************
-*.
-*--- Assign data set mnemonics for bank keys.
-*
-#include "fatpara.inc"
-*
- PARAMETER (LURCOR=200000)
- COMMON /CRZT/ IXSTOR,IXDIV,IFENCE(2),LEV,LEVIN,BLVECT(LURCOR)
- DIMENSION LQ(999),IQ(999),Q(999)
- EQUIVALENCE (IQ(1),Q(1),LQ(9)),(LQ(1),LEV)
-*
- COMMON /USRLNK/ LUSRK1,LUSRBK,LUSRLS
- COMMON /QUEST/ IQUEST(100)
- PARAMETER (LKEYFA=10)
- DIMENSION KEYS(LKEYFA)
-*
- INTEGER ICTRX,IPTRG,IUNITA,IUNITB,IUNITC,IRC,IOSTAT
- PARAMETER (IUNITA=3,IUNITB=9,IUNITC=8)
- INTEGER NRECS
- INTEGER IOFILE,NBYTES
- PARAMETER (IOFILE = 1)
-*
- INTEGER IDATE,ITIME,IPACK
- INTEGER IBLKLN(2),IRECLN(2),ITAPDV(2),ITAPDN(7)
- INTEGER IVLSQN(2),IDSSQN(2),ICRDAT(2),IBLKCT(2)
- INTEGER ICPLVL,ILOCCD,IMEDTP,ISTREC,IENREC,ISTBLK
- INTEGER IFLSIZ,IDUMMY
-*
- CHARACTER*80 CBUFF
- CHARACTER*54 CGNAME
- CHARACTER*7 CBDISP
- CHARACTER*17 CDATID(2)
- CHARACTER*4 CFATFM,CLABEL,CDSSQN,CLABRQ(2,2)
- CHARACTER*6 CINVSN,CVLSLN,CVISID
- CHARACTER*1 CRECFT(2)
- CHARACTER*80 CDETOT,CCOM1,CCOM2,COMMNT
-*
- LOGICAL BERROR,BDIFF
- LOGICAL BINTCM
- DATA NSHOWN/0/
-*
-*--- Declare common blocks,containing the arrays responsible for storing
-*--- the Header and Trailer fields from the staged TAPE files.
-*
- COMMON /TAPDL1/ CDATID,CRECFT
- COMMON /TAPDL2/ IBLKLN,IRECLN,ITAPDV,IVLSQN,IDSSQN,ICRDAT,IBLKCT
-*
-*--- Assign defaults to the file catalogue fields,for which values are
-*--- not supplied in either the Tape file or the Run Information file.
-*--- Additionally,set values within a number of arrays,to be used for
-*--- reference during processing.
-*
- DATA ICPLVL,ILOCCD,IMEDTP /0,1,2/
- + ISTREC,IENREC,ISTBLK,IFLSIZ /0,0,0,0/
- + ITIME /0/
- + ITAPDN /200,556,800,1600,6250,0,38000/
- + CFATFM /'FX'/
- + CLABRQ(1,1),CLABRQ(1,2) /'HDR1','HDR2'/
- + CLABRQ(2,1),CLABRQ(2,2) /'EOF1','EOF2'/
-*
-*--- Surpress error messages for error 219.
-*
- CALL ERRSET(219,0,-1,1,1)
-*
-*--- Initialise Zebra,create short term divisions and set the log level.
-*
- CALL MZEBRA(-3)
- CALL MZSTOR(IXSTOR,'/CRZT/','Q',IFENCE,LEV,BLVECT(1),BLVECT(1),
- + BLVECT(5000),BLVECT(LURCOR))
- CALL MZLOGL(IXSTOR,IXDIN,'USERS',50000,LURCOR,'L')
-*
-*--- Define user link area.
-*
- CALL MZLINK(IXSTOR,'/USRLNK/',LUSRK1,LUSRLS,LUSRK1)
-*
-*--- Set unit numbers for the RZ database.
-*
- LUNRZ = 1
- LUNFZ = 2
-*
-*--- Initialise FATMEN for OPAL.
-*
- CALL FMINIT(IXSTOR,LUNRZ,LUNFZ,'//CERN/OPAL',IRC)
-*
-*--- Read bank display option from the Tape VSN file,specifying whether
-*--- each bank is to be displayed on the terminal for validation before
-*--- committing it to FATMEN.
-*
-* Modified 6/2/90 JDS
-* READ(IUNITC,FMT='(A7)',END=80) CBDISP
- READ(IUNITC,*,END=80) NDISP
-*
-*--- If an invalid value has been supplied for the bank display option,
-*--- then issue an error message and branch to terminate program
-*--- execution.
-*
-* IF (CBDISP.NE.'DISPLAY'.AND.CBDISP.NE.'NO DISP') THEN
-* PRINT*,' Invalid bank display option in tape VSN file.'
-* PRINT*,' '
-* PRINT*,' EXECUTION COMPLETED - NO PROCESSING HAS TAKEN PLACE.'
-* GO TO 90
-* ENDIF
-*
-*--- Loop to repeatedly read the filename of the next staged tape file
-*--- from the file of Volume Serial Numbers and open it for subsequent
-*--- processing.
-*
-10 CONTINUE
- READ(IUNITC,FMT='(A6)',END=80) CINVSN
- PRINT*,' PROCESSING TAPE FILE: ',CINVSN
- OPEN(IUNITA,FILE='/'//CINVSN//' FATINFO *')
- BERROR = .FALSE.
- BDIFF = .FALSE.
- NRECS = 0
-*
-*--- Loop to read and process successive labels(records) from the
-*--- current tape file's header.
-*
-20 CONTINUE
- NRECS = NRECS + 1
-*
-*--- If an error has occured in reading the header labels or all labels
-*--- have been read,then exit the loop.
-*
- IF (BERROR.OR.NRECS.GT.3) GO TO 30
-*
-*--- Read a label or if the end of file is reached,branch to cease
-*--- processing the current tape file.
-*
- READ(IUNITA,FMT='(A)',END=70,IOSTAT=IOSTAT) CBUFF
-*
-*--- Store the label identifier.
-*
- CLABEL = CBUFF(1:4)
-*
-*--- If the first label is being processed then test the label
-*--- identifier for being that of the VOL1 label,storing the labels
-*--- details or flaging an error accordingly.If the first label is not
-*--- being processed then call HDRTRL to extract and store HDR1/HDR2
-*--- details.
-*
- IF (NRECS.EQ.1) THEN
-*
- IF (CLABEL.EQ.'VOL1') THEN
- CVLSLN = CBUFF(5:10)
- ELSE
- BERROR = .TRUE.
- ENDIF
-*
- ELSE
- CALL HDRTRL(CBUFF,CLABEL,CLABRQ(1,NRECS-1),NRECS-1,1,
- + BERROR)
- ENDIF
-*
-*--- If an error has occured in processing the header labels then issue
-*--- the appropriate error message.
-*
- IF (BERROR) THEN
- PRINT*,' Error in processing HEADER'
- PRINT*,' - missing or unexpected additional record.'
- ENDIF
-
-*
-*--- Loop back to read and process the next header label.
-*
- GO TO 20
-30 CONTINUE
-*
-*--- If an error occured in processing the header labels then branch to
-*--- cease processing the current tape file.
-*
- IF (BERROR) GO TO 70
-*
-*--- Loop to repeatedly read Tape file data records,until encountering
-*--- the first trailer label or end of file marker.In the latter case
-*--- the program branches to the data processing section and does not
-*--- attempt to read and store trailer label fields.
-*
-35 CONTINUE
- READ(IUNITA,FMT='(A)',END=65) CBUFF
- IF (CBUFF(1:4).EQ.'EOF1') GO TO 40
- GO TO 35
-40 CONTINUE
-*
-*--- Loop to read and process successive labels from the Tape file's
-*--- trailer.This procedure is almost identical to that employed to
-*--- read header labels,except that a VOL1 label is not expected.
-*
- NRECS = 1
-50 CONTINUE
- CLABEL = CBUFF(1:4)
- CALL HDRTRL(CBUFF,CLABEL,CLABRQ(2,NRECS),NRECS,2,BERROR)
-*
- IF (BERROR) THEN
- PRINT*,' Error in proecssing TRAILER'
- PRINT*,' - missing or unexpected additional record.'
- GO TO 60
- ENDIF
-*
- READ(IUNITA,FMT='(A)',END=60) CBUFF
- NRECS = NRECS + 1
- IF (NRECS.GT.2.OR.BERROR) GO TO 60
- GO TO 50
-60 CONTINUE
-*
-*--- If an error occured in processing the trailer labels then branch
-*--- to cease processing the current tape file.
-*
- IF (BERROR) GO TO 70
-*
-*--- Call function BINTCM for each array containing 2 corresponding
-*--- integer fields,taken from the HDR1 and EOF1(if it existed,
-*--- otherwise 0's are contained in the appropriate positions) labels.
-*--- The function returns a boolean value,depicting whether the 2 fields
-*--- differ or not.
-*
- BDIFF = BINTCM(IVLSQN,BDIFF)
- BDIFF = BINTCM(IDSSQN,BDIFF)
- BDIFF = BINTCM(ICRDAT,BDIFF)
- BDIFF = BINTCM(IBLKCT,BDIFF)
-*
-*--- Perform the same test as BINTCM on the character array CRECFT.
-*
- IF (CRECFT(1).EQ.' ') THEN
- IF (CRECFT(2).NE.' ') CRECFT(1) = CRECFT(2)
- ELSE
- IF (CRECFT(1).NE.CRECFT(2).AND.CRECFT(2).NE.' ') BDIFF = .TRUE.
- ENDIF
-*
-*--- If an EOF2 label existed then perform similar comparisons between
-*--- the corresponding fields of the HDR2 and EOF2 labels,setting a flag
-*--- if they differ.
-*
- IF (NRECS.EQ.2) THEN
- IF (CDATID(1).NE.CDATID(2)) BDIFF = .TRUE.
- IF (IBLKLN(1).NE.IBLKLN(2)) BDIFF = .TRUE.
- IF (IRECLN(1).NE.IRECLN(2)) BDIFF = .TRUE.
- IF (ITAPDV(1).NE.ITAPDV(2)) BDIFF = .TRUE.
- ENDIF
-*
-*--- If the information extracted from the header and trailer is
-*--- inconsistant,then issue an error message and branch to cease
-*--- processing the current tape file.
-*
- IF (BDIFF) THEN
- PRINT*,' HEADER-TRAILER information not consistant'
- PRINT*,' - details have not been stored.'
- GO TO 70
- ENDIF
-*
-65 CONTINUE
-*
-*--- Call subroutine GETTAP to locate and read the relevent details from
-*--- the appropriate entry in the Run Information file.The identifier
-*--- for such details being the Tape file's Volume Serial Number.A flag
-*--- is returned to indicate the success of GETTAP's search.
-*
- CALL GETTAP(IUNITB,CVLSLN,CVISID,CGNAME,IDUMMY,CDETOT,CCOM1,
- + CCOM2,BERROR)
-*
-*--- If an entry has not been located then branch to cease processing
-*--- the current tape(an error message having already been issued by
-*--- GETTAP).
-*
- BERROR = .NOT.BERROR
- IF (BERROR) GO TO 70
-*
-*--- Call subroutine CONCAT to pack the 3 comment fields returned by
-*--- GETTAP into a single field,for insertion into the FATMEN file
-*--- catalogue.
-*
- CALL CONCAT(CDETOT,CCOM1,CCOM2,COMMNT)
-*
-*--- Set a pointer to the end of the Generic filename returned by GETTAP
-*
- IPTRG = INDEX(CGNAME,' ')
- IF (IPTRG.EQ.0) IPTRG = 55
-*
-*--- Create a new ZEBRA bank for the current tapes' data set,with a
-*--- Generic name consisting of the concatenation of the string
-*--- '//CERN/OPAL' and the Generic file name returned by GETTAP.
-*
- CALL FMLIFT('//CERN/OPAL/'//CGNAME(1:IPTRG-1),KEYS,'3480','U'
- + ,IRC)
-*
-*--- Derive the address of the bank and associate it with the Generic
-*--- name.
-*
- CALL FMLINK('//CERN/OPAL/'//CGNAME(1:IPTRG-1),LFAT,IRC)
-*
-*--- Fill some fields of the bank with the values held for them in the
-*--- the tape data set variables/arrays,with the aid of the previously
-*--- defined bank offsets and the subroutine UCTOH(for char/hollerith
-*--- variables).Those fields not corresponding to tape data set
-*--- variables/arrays are left holding the defaults assigned by
-*--- FMLIFT.
-*
- CALL UCTOH(CDATID(1),IQ(LFAT+MFQNFA),4,17)
- IQ(LFAT+MCPLFA) = ICPLVL
- IQ(LFAT+MLOCFA) = ILOCCD
- IQ(LFAT+MMTPFA) = IMEDTP
- CALL UCTOH(CVLSLN,IQ(LFAT+MVSNFA),4,6)
- CALL UCTOH(CVISID,IQ(LFAT+MVIDFA),4,6)
- IQ(LFAT+MDENFA) = ITAPDN(ITAPDV(1)+1)
- IQ(LFAT+MVSQFA) = IVLSQN(1)
- IQ(LFAT+MFSQFA) = IDSSQN(1)
- IQ(LFAT+MSRDFA) = ISTREC
- IQ(LFAT+MERDFA) = IENREC
- IQ(LFAT+MSBLFA) = ISTBLK
- IQ(LFAT+MEBLFA) = IBLKCT(1)
- CALL UCTOH(CRECFT(1),IQ(LFAT+MRFMFA),4,1)
- IQ(LFAT+MRLNFA) = IRECLN(1)
- IQ(LFAT+MBLNFA) = IBLKLN(1)
- IQ(LFAT+MFSZFA) = IFLSIZ
- CALL UCTOH(CFATFM,IQ(LFAT+MFLFFA),4,4)
- CALL FATDAT(ICRDAT(1),IDATE)
- CALL FMPKTM(IDATE,ITIME,IPACK,IRC)
- IQ(LFAT+MCRTFA) = IPACK
- CALL UCTOH(COMMNT,IQ(LFAT+MUCMFA),4,80)
-*
-*--- Consider the bank display option and either display or don't
-*--- display the new ZEBRA bank accordingly.
-*
-* IF (CBDISP.EQ.'DISPLAY') THEN
- IF (NSHOWN.LT.NDISP) THEN
- CALL DZSHOW('ZEBRA BANK',IXSTOR,LFAT,'B',0,0,0,0)
- PRINT*,' '
- NSHOWN = NSHOWN + 1
- ENDIF
-*
-*--- Commit the bank to FATMEN as a new file catalogue entry.
-*
- CALL FMPUT('//CERN/OPAL/'//CGNAME(1:IPTRG-1),LFAT,IRC)
-*
-*--- Rewind the Run Information file and close the current Tape file,
-*--- before returning to read and process the next Tape file.
-*
- REWIND IUNITB
- CLOSE(IUNITA)
- GO TO 10
-*
-*--- If an error occurred during the processing of the current tape,then
-*--- this piece of code is branched to,in order to issue an error
-*--- message before preparing and returning to read the next Tape file.
-*
-70 CONTINUE
- IF (IOSTAT.LT.0) THEN
- PRINT*,' Error in commencing procesing'
- PRINT*,' - file is either empty or non-existant.'
- ENDIF
- PRINT*,' ATTEMPTING TO CONTINUE.....'
- PRINT*,' '
- REWIND IUNITB
- CLOSE(IUNITA)
- GO TO 10
-80 CONTINUE
-*
-*--- Termination sequence
-*
- PRINT*,' PROCESSING COMPLETED'
-90 CONTINUE
- STOP
- END
-*
-*
- BLOCK DATA TAPEVR
-*...TAPEVR
-*. Block data subprogram to initialise the named common blocks of
-*. TAPDL1 and TAPDL2.
-*.
-*. REPORT CONDITIONS
-*.
-*. AUTHOR : G.J.Barlow
-*. VERSION :
-*. CREATED : 02-Nov-89
-*. LAST MOD :
-*.
-*. Modification Log
-*.
-*.**********************************************************************
-*.
- INTEGER IBLKLN(2),IRECLN(2),ITAPDV(2)
- INTEGER IVLSQN(2),IDSSQN(2),ICRDAT(2),IBLKCT(2)
- CHARACTER*17 CDATID(2)
- CHARACTER*1 CRECFT(2)
-*
- COMMON /TAPDL1/ CDATID,CRECFT
- COMMON /TAPDL2/ IBLKLN,IRECLN,ITAPDV,IVLSQN,IDSSQN,ICRDAT,IBLKCT
-*
-*--- Initialise the array elements intended to hold the EOF1 tape
-*--- details and assign defaults to those intended to hold the HDR2 and
-*--- EOF2 details.
-*
- DATA CDATID(2) /' '/
- + IVLSQN(2),IDSSQN(2),ICRDAT(2),IBLKCT(2) /0,0,0,0/
- + CRECFT /'U','U'/
- + IBLKLN /3600,3600/
- + IRECLN /3600,3600/
- + ITAPDV /6,6/
-*
- END
-*
-*
- SUBROUTINE GETTAP(IUNITB,REFTAP,TAPNUM,GENAME,DATE,DETOUT,COM1,
- + COM2,BOOL)
-*...GETTAP
-*. This subroutine processes the Run Information file, extracting
-*. the generic name and attributing the additional information to
-*. the relevant variable names.
-*.
-*. COMMON :
-*. SEQUENCE :
-*. CALLS :
-*. CALLED : TAPELOAD
-*.
-*. BANKS L :
-*. BANKS U :
-*. BANKS M :
-*. BANKS D :
-*.
-*. REPORT CONDITIONS
-*.
-*. AUTHOR : P.A.Eccles
-*. VERSION :
-*. CREATED : 26-Oct-89
-*. LAST MOD :
-*.
-*. Modification Log.
-*.
-*.**********************************************************************
-*.
- IMPLICIT NONE
- CHARACTER*80 LINE,DETOUT,COM1,COM2
- CHARACTER*54 GENAME
- CHARACTER*6 TAPNUM,REFTAP
- CHARACTER FLAG,MARKER
- INTEGER IUNITB,DATE,UWORDS,NOCOM
- LOGICAL BOOL
-
-************************************************************************
-*
-* VARIABLE DESCRIPTIONS::-
-*
-* CHARACTER:-
-* LINE = File record
-* DETOUT = Comment on the detectors not working
-* when the tape was taken
-* COM1,COM2 = User comments on the tapes contents
-* GENAME = Generic tape name
-* TAPNUM = Tape number from the label
-* REFTAP = Tape number being requested
-* FLAG = Symbol of a comment being of type DETOUT
-* MARKER = Tempory store to hold a records first
-* character to see if it matches to the FLAG
-* BOOL = Boolian marker for a tapes presence
-* within the input file
-*
-* INTEGER:-
-* IUNITB = Unit number associated with the input file
-* DATE = Tapes creation date
-* UWORDS = Number of comment records following
-* NOCOM = Integer boolian for a comments presence
-*
-* LOGICAL:-
-* BOOL = Boolian marker for a tapes presence
-* within the input file
-*
-************************************************************************
-
-* --- Initalise the data names
- LINE = ' '
- DETOUT = ' '
- COM1 = ' '
- COM2 = ' '
- GENAME = ' '
- TAPNUM = ' '
- MARKER = ' '
- FLAG = '@'
- UWORDS = 0
- DATE = 0
- NOCOM = 0
- BOOL = .FALSE.
-
-* --- Format definitions
-90 FORMAT (A80)
-100 FORMAT (A6,4X,A54,16X)
-110 FORMAT (10X,I1,11X,I6,52X)
-
-* --- Main program
-120 CONTINUE
- READ (IUNITB,FMT = 90,END=150) LINE
- READ (LINE,FMT = '(A6)') TAPNUM
- IF (TAPNUM.EQ.REFTAP) THEN
- BOOL = .TRUE.
- READ (LINE,FMT = '(10X,A54)') GENAME
- READ (IUNITB,FMT = 110,END=140) UWORDS, DATE
- IF (UWORDS.EQ.0) THEN
- DETOUT = 'No detectors out.'
- COM1 = 'No comments.'
- COM2 = ' '
- GO TO 150
- ENDIF
- IF (UWORDS.EQ.1) THEN
- READ (IUNITB,FMT= 90,END=140) LINE
- READ (LINE,FMT='(A1)') MARKER
- IF (MARKER.EQ.FLAG) THEN
- WRITE (DETOUT,FMT='(A79)') LINE(2:80)
- COM1 = 'No comments.'
- COM2 = ' '
- ELSE
- IF ((LINE(11:14).EQ.'LEPD').OR.(LINE(11:14).EQ.'COSM')
- + .OR.(LINE(11:14).EQ.'SIMD')) THEN
- NOCOM = 1
- GO TO 130
- ELSE
- DETOUT = 'No detectors out.'
- WRITE (COM1,FMT=90) LINE
- COM2 = ' '
- ENDIF
- ENDIF
- ENDIF
- IF (UWORDS.EQ.2) THEN
- READ (IUNITB,FMT= 90,END=140) LINE
- READ (LINE,FMT='(A1)') MARKER
- IF (MARKER.EQ.FLAG) THEN
- WRITE (DETOUT,FMT='(A79)') LINE(2:80)
- READ (IUNITB,FMT=90,END=140) LINE
- IF ((LINE(11:14).EQ.'LEPD').OR.(LINE(11:14).EQ.'COSM')
- + .OR.(LINE(11:14).EQ.'SIMD')) THEN
- NOCOM = 1
- GO TO 130
- ELSE
- WRITE (COM1,FMT=90) LINE
- COM2 = ' '
- ENDIF
- ELSE
- IF ((LINE(11:14).EQ.'LEPD').OR.(LINE(11:14).EQ.'COSM')
- + .OR.(LINE(11:14).EQ.'SIMD')) THEN
- NOCOM = 1
- GO TO 130
- ELSE
- DETOUT = 'No detectors out.'
- WRITE (COM1,FMT= 90) LINE
- ENDIF
- READ (IUNITB,FMT= 90,END=140) LINE
- IF ((LINE(11:14).EQ.'LEPD').OR.(LINE(11:14).EQ.'COSM')
- + .OR.(LINE(11:14).EQ.'SIMD')) THEN
- NOCOM = 1
- GO TO 130
- ELSE
- WRITE (COM2,FMT= 90) LINE
- ENDIF
- ENDIF
- ENDIF
- IF (UWORDS.EQ.3) THEN
- READ (IUNITB,FMT= 90,END=140) LINE
- IF ((LINE(11:14).EQ.'LEPD').OR.(LINE(11:14).EQ.'COSM')
- + .OR.(LINE(11:14).EQ.'SIMD')) THEN
- NOCOM = 1
- GO TO 130
- ELSE
- WRITE (DETOUT,FMT='(A79)') LINE(2:80)
- ENDIF
- READ (IUNITB,FMT= 90,END=140) LINE
- IF ((LINE(11:14).EQ.'LEPD').OR.(LINE(11:14).EQ.'COSM')
- + .OR.(LINE(11:14).EQ.'SIMD')) THEN
- NOCOM = 1
- GO TO 130
- ELSE
- WRITE (COM1,FMT= 90) LINE
- ENDIF
- READ (IUNITB,FMT= 90,END=140) LINE
- IF ((LINE(11:14).EQ.'LEPD').OR.(LINE(11:14).EQ.'COSM')
- + .OR.(LINE(11:14).EQ.'SIMD')) THEN
- NOCOM = 1
- GO TO 130
- ELSE
- WRITE (COM2,FMT= 90) LINE
- ENDIF
- ENDIF
- ELSE
- GO TO 120
- ENDIF
-
-* --- Error message when a comment isn't found when UWORDS > 0
-130 CONTINUE
- IF (NOCOM.EQ.1) PRINT*,' Comment not found when expected tape ',
- + REFTAP
-
-* --- Error message when a comment isn't found when UWORDS > 0 at EOF
-140 CONTINUE
- IF (LINE.EQ.' ') PRINT*,' Comment not found when expected tape ',
- + REFTAP
-
-150 CONTINUE
- END
-*
-*
- SUBROUTINE HDRTRL(CBUFF,CLABEL,CLABRQ,NRECS,ISUB,BERROR)
-*...HDRTRL
-*. Subroutine to extract and store the relevant details from either
-*. of the 2 header labels,HDR1 and HDR2,or either of the 2 trailer
-*. labels,EOF1 and EOF2.The label itself is supplied as a parameter,
-*. along with the identifier of the label type expected.If the
-*. expected label is not discovered then no tape details will be
-*. extracted and in the case of a HDR1 label,an error message given.
-*. Note that the HDR1 and EOF1,HDR2 and EOF2 labels should contain
-*. the same information and this is duplicated in storage for later
-*. consistancy comparisons.
-*.
-*. COMMON :
-*. SEQUENCE :
-*. CALLS :
-*. CALLED : TAPELOAD
-*.
-*. BANKS L :
-*. BANKS U :
-*. BANKS M :
-*. BANKS D :
-*.
-*. REPORT CONDITIONS
-*.
-*. AUTHOR : G.J.Barlow
-*. VERSION :
-*. CREATED : 02-Nov-89
-*. LAST MOD :
-*.
-*. Modification Log.
-*.
-*.**********************************************************************
-*.
- INTEGER NRECS,ISUB
- CHARACTER*80 CBUFF
- CHARACTER*4 CLABEL,CLABRQ
- LOGICAL BERROR
-*
- INTEGER IBLKLN(2),IRECLN(2),ITAPDV(2)
- INTEGER IVLSQN(2),IDSSQN(2),ICRDAT(2),IBLKCT(2)
- CHARACTER*17 CDATID(2)
- CHARACTER*1 CRECFT(2)
- REAL RRECLN,RBLKLN
-*
- COMMON /TAPDL1/ CDATID,CRECFT
- COMMON /TAPDL2/ IBLKLN,IRECLN,ITAPDV,IVLSQN,IDSSQN,ICRDAT,IBLKCT
-*
-*--- If the first header/trailer label is being processed,check for the
-*--- derived and expected label identifiers matching.If so,the approp-
-*--- riate label character positions are read from and stored.Otherwise
-*--- an error is flaged.
-*
- IF (NRECS.EQ.1) THEN
-*
- IF (CLABEL.EQ.CLABRQ) THEN
- CDATID(ISUB) = CBUFF(5:21)
- READ(CBUFF(28:31),FMT='(I4)') IVLSQN(ISUB)
- READ(CBUFF(32:35),FMT='(I4)') IDSSQN(ISUB)
- READ(CBUFF(42:47),FMT='(I6)') ICRDAT(ISUB)
- READ(CBUFF(55:60),FMT='(I6)') IBLKCT(ISUB)
- ELSE
- BERROR = .TRUE.
- ENDIF
-*
-*--- The same procedure is adopted for the second header/trailer label,
-*--- except that no error is registered for missing labels(the HDR2 and
-*--- EOF2 labels are permitted not to exist).
-*
- ELSE IF (NRECS.EQ.2.AND.CLABEL.EQ.CLABRQ) THEN
- CRECFT(ISUB) = CBUFF(5:5)
- READ(CBUFF(6:10),FMT='(F5.0)') RBLKLN
- IBLKLN(ISUB) = INT(RBLKLN/4)
- READ(CBUFF(11:15),FMT='(F5.0)') RRECLN
- IRECLN(ISUB) = INT(RRECLN/4)
- READ(CBUFF(16:16),FMT='(I1)') ITAPDV(ISUB)
- ENDIF
-*
- END
-*
-*
- SUBROUTINE CONCAT(CDETOT,CCOM1,CCOM2,COMMNT)
-*...CONCAT
-*. Subroutine to pack as many characters as possible from 3 comment
-*. fields of 80 bytes in length,into a single 80 byte FATMEN comment
-*. field.This involves regarding comment fields 1-3 as having
-*. descending priority,removing the trailing spaces from each comment
-*. field and inserting a seperating character string to distinguish
-*. the 3 original comment fields.
-*.
-*. COMMON :
-*. SEQUENCE :
-*. CALLS : IPOINT
-*. CALLED : TAPELOAD
-*.
-*. BANKS L :
-*. BANKS U :
-*. BANKS M :
-*. BANKS D :
-*.
-*. REPORT CONDITIONS
-*.
-*. AUTHOR : G.J.Barlow
-*. VERSION :
-*. CREATED : 02-Nov-89
-*. LAST MOD :
-*.
-*. Modification Log.
-*.
-*.**********************************************************************
-*.
- CHARACTER*80 CDETOT,CCOM1,CCOM2,COMMNT
- INTEGER IPTR1,IPTR2,IPTR3,ICPTR
-*
-*--- Set pointers to the end of the 3 comment fields,by identifying the
-*--- position of the terminating string,' ',within them.
-*
- IPTR1 = INDEX(CDETOT,' ')
- IPTR2 = INDEX(CCOM1,' ')
- IPTR3 = INDEX(CCOM2,' ')
-*
- ICPTR = 1
- COMMNT = ' '
-*
-*--- If the 1st comment field contains a value then store it within the
-*--- packed comment field and set a pointer to it's last character
-*--- position.The function IPOINT is called if the 1st comment fields
-*--- end pointer is set to 0(ie it could be either 79 or 80 chars in
-*--- length),to derive the correct end pointer value.
-*
- IF (IPTR1.NE.1) THEN
- IF (IPTR1.EQ.0) IPTR1 = IPOINT(IPTR1,CDETOT)
- COMMNT(ICPTR:IPTR1-1) = CDETOT(1:IPTR1-1)
- ICPTR = IPTR1
- ENDIF
-*
-*--- Repeat testing and storage procedure for 2nd comment field,
-*--- inserting a seperating string into the packed comment field if a
-*--- 1st comment field existed.
-*
- IF (IPTR2.NE.1.AND.ICPTR.LT.81) THEN
- IF (IPTR2.EQ.0) IPTR2 = IPOINT(IPTR2,CCOM1)
- IF (IPTR1.NE.1) COMMNT(ICPTR:ICPTR+2) = ' - '
- ICPTR = ICPTR + 3
-*
- IF (IPTR2-1.GT.(81-ICPTR)) THEN
- COMMNT(ICPTR:80) = CCOM1(1:(81-ICPTR))
- ICPTR = 81
- ELSE
- COMMNT(ICPTR:(ICPTR+IPTR2-2)) = CCOM1(1:IPTR2-1)
- ICPTR = IPTR2
-*
-*--- Repeat testing and storage procedure for the 3rd comment field but
-*--- only if a 2nd comment field existed.
-*
- IF (IPTR3.NE.1.AND.ICPTR.LT.81) THEN
- IF (IPTR2.EQ.0) IPTR3 = IPOINT(IPTR3,CCOM2)
- COMMNT(ICPTR:ICPTR+2) = ' - '
- ICPTR = ICPTR + 3
-*
- IF (IPTR3-1.GT.(81-ICPTR)) THEN
- COMMNT(ICPTR:80) = CCOM2(1:(81-ICPTR))
- ELSE
- COMMNT(ICPTR:(ICPTR+IPTR3-2)) = CCOM2(1:IPTR3-1)
- ENDIF
-*
- ENDIF
-*
- ENDIF
-*
- ENDIF
-*
- END
-*
-*
- SUBROUTINE FATDAT(JDATE,IDATE)
-*...FATDAT
-*. Subroutine to accept a Julian date of the form YYDDD and convert
-*. it to the more conventional YYMMDD format.The latter format is the
-*. one expected by the DBPKTM subroutine,used to produce a packed
-*. date and time value for the Creation Date field of the file
-*. catalogue.The Julian date format is supplied by the HDR1 label of
-*. each files header.
-*.
-*. COMMON :
-*. SEQUENCE :
-*. CALLS : UCOPY
-*. CALLED : TAPELOAD
-*.
-*. BANKS L :
-*. BANKS U :
-*. BANKS M :
-*. BANKS D :
-*.
-*. REPORT CONDITIONS
-*.
-*. AUTHOR : J.D.Shiers
-*. VERSION :
-*. CREATED :
-*. LAST MOD :
-*.
-*. Modification Log.
-*.
-*.**********************************************************************
-*.
- INTEGER NDAYS(12),NLEAP(12)
- CHARACTER*36 MONTHS
-*
- DATA MONTHS/'JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC'/
- DATA NDAYS/00,31,59,90,120,151,181,212,243,273,304,334/
- DATA NLEAP/00,31,60,91,121,152,182,213,244,274,305,335/
-*
-*--- Seperate and store the year and day components of the Julian date.
-*
- IYEAR = JDATE / 1000
- IDAY = JDATE - (IYEAR * 1000)
-*
-*--- Test for the year being one of the 4 recognised leap years and if
-*--- so,call the subroutine UCOPY to copy the cumulative day totals from
-*--- the leap year 'month' array,into the non-leap year 'month' array.
-*
- IF (IYEAR .EQ. 84 .OR. IYEAR .EQ. 88 .OR.
- + IYEAR .EQ. 92 .OR. IYEAR .EQ. 96) CALL UCOPY(NLEAP,NDAYS,12)
- IMON = 12
-*
-*--- Loop to identify the month in which the Julian day lies.
-*
- DO 160 I=1,11
-*
-*--- If the Julian day lies between the current and the next months
-*--- cumulative day limits,then store the current month and calculate
-*--- and store the correct day of the month.
-*
- IF ( IDAY .GT. NDAYS(I) .AND. IDAY .LE. NDAYS(I+1) ) THEN
- IMON = I
- IDAY = IDAY - NDAYS(I)
- ENDIF
-*
-160 CONTINUE
-*
-*--- Assemble and store the calculated components of the conventional
-*--- date.
-*
- IF ( IMON .EQ. 12) IDAY = IDAY - NDAYS(12)
- IDATE = IYEAR*10000 + IMON * 100 + IDAY
- RETURN
-
- END
-*
-*
- LOGICAL FUNCTION BINTCM(IARRAY,BDIFF)
-*...BINTCM
-*. Function to compare corresponding integer fields from the HDR1
-*. and EOF1 labels of a staged tape file.The comparison will only be
-*. made if the 2 fields both hold non-zero values(ie both labels have
-*. been supplied and values for both fields supplied).If the above is
-*. true and the values differ then a flag is set to indicate this.If
-*. however,the HDR1 field is 0 and the EOF1 field contains a value,
-*. the value is copied into the HDR1 field,for later insertion into
-*. the FATMEN file catalogue.
-*.
-*. COMMON :
-*. SEQUENCE :
-*. CALLS :
-*. CALLED : TAPELOAD
-*.
-*. BANKS L :
-*. BANKS U :
-*. BANKS M :
-*. BANKS D :
-*.
-*. REPORT CONDITIONS
-*.
-*. AUTHOR : G.J.Barlow
-*. VERSION :
-*. CREATED : 02-Nov-89
-*. LAST MOD :
-*.
-*. Modification Log.
-*.
-*.**********************************************************************
-*.
- INTEGER IARRAY(2)
- LOGICAL BDIFF
-
- BINTCM = BDIFF
-*
- IF (IARRAY(1).EQ.0) THEN
- IF (IARRAY(2).NE.0) IARRAY(1) = IARRAY(2)
- ELSE
- IF (IARRAY(1).NE.IARRAY(2).AND.IARRAY(2).NE.0) BINTCM = .TRUE.
- ENDIF
-
- END
-*
-*
- INTEGER FUNCTION IPOINT(IPTRN,CSTRNG)
-*...IPOINT
-*. Function to accept a comment character string,which may be a
-*. maximum of N bytes in length,identify it as being of N or N-1
-*. bytes in length and set a length pointer accordingly.The pointer
-*. is set to N+1 in the first instance and N-1 in the second,before
-*. being returned as the functions value.This function is necessary
-*. as the string length will register zero,in both of the above cases
-*. ,when the terminating sting,' ',is searched for.
-*.
-*. COMMON :
-*. SEQUENCE :
-*. CALLS :
-*. CALLED : CONCAT
-*.
-*. BANKS L :
-*. BANKS U :
-*. BANKS M :
-*. BANKS D :
-*.
-*. REPORT CONDITIONS
-*.
-*. AUTHOR : G.J.Barlow
-*. VERSION :
-*. CREATED : 02-Nov-89
-*. LAST MOD :
-*.
-*. Modification Log.
-*.
-*.**********************************************************************
-*.
- INTEGER IPTRN
- CHARACTER*80 CSTRNG
-
- IF (CSTRNG(80:80).EQ.' ') THEN
- IPOINT = IPTRN - 1
- ELSE
- IPOINT = 81
- ENDIF
-
- END
diff --git a/src/packlib/fatmen/examples/Imakefile b/src/packlib/fatmen/examples/Imakefile
deleted file mode 100644
index ff65f5e..0000000
--- a/src/packlib/fatmen/examples/Imakefile
+++ /dev/null
@@ -1,8 +0,0 @@
-SRCS_F= addfat.F fatcomm.F fatcount.F fatdelph.F fatexam1.F \ @@\
- fathunt.F fatindx.F fatldir.F fatlfil.F fatlist.F fatloop.F \ @@\
- fatloop2.F fatls.F fatlton.F fatmod.F fatnick.F fatntol.F \ @@\
- fatopen.F fatouch.F fatpeek.F fatplot.F fatpoke.F fatrrob.F \ @@\
- fatscan.F fatscan2.F fatselk.F fatselm.F fatsetup.F fatshow.F \ @@\
- fattags.F fatuniq.F modfpack.F rzddir.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/fatmen/examples/addfat.F b/src/packlib/fatmen/examples/addfat.F
deleted file mode 100644
index fd697d9..0000000
--- a/src/packlib/fatmen/examples/addfat.F
+++ /dev/null
@@ -1,85 +0,0 @@
-*
-* $Id: addfat.F,v 1.1.1.1 1996/03/07 15:17:59 mclareni Exp $
-*
-* $Log: addfat.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:59 mclareni
-* Fatmen
-*
-*
- PROGRAM ADDTEST
- CHARACTER*256 GENAME,DSN
- CHARACTER*80 COMM
- CHARACTER*8 HOST
- CHARACTER*4 FFORM,RECFM,CHOPT
- CHARACTER*6 VSN,VID
-#include "fatmen/fatpara.inc"
- DIMENSION MYVECT(NWDSFA),IVECT(10)
-*
-* Initialise FATMEN using novice interface
-*
- LUNRZ = 1
- LUNFZ = 2
- CALL FMSTRT(LUNRZ,LUNFZ,'//CERN/CNDIV',IRC)
-*
-* Set maximum log level
-*
- CALL FMLOGL(3)
-*
-* Set location code (to be used for adding following entries)
-*
- MYLOC = 99
- NUMLOC = 1
- CALL FMSETL(MYLOC,NUMLOC,IC)
-*
-* Add a tape entry
-*
- GENAME = '//CERN/CNDIV/JAMIE/TEST'
- VSN = 'I29021'
- VID = 'I29021'
- ISEQ = 1
- DSN = 'MINIDST'
- FFORM = 'FX'
- HOST = 'ZFATAL'
- RECFM = 'U'
- COMM = 'ADDED VIA ADDTEST.F'
- CHOPT = ' '
-
- CALL FMADDT(GENAME,VSN,VID,ISEQ,
- + DSN,FFORM,0,HOST,RECFM,80,11,483,2,COMM,
- + IVECT,CHOPT,IRC)
-*
-* Add a disk entry. Here we first fill the bank and
-* then add supplementary information using FMPEEK/FMPOKE
-*
- GENAME = '//CERN/CNDIV/JAMIE/TEST'
- DSN = '<JAMIE.192>BOX.SET'
- FFORM = 'AS'
- HOST = 'CERNVM'
- RECFM = 'V'
- COMM = 'ADDED VIA ADDTEST.F'
- CHOPT = 'N'
-
- CALL FMADDD(GENAME,DSN,FFORM,0,HOST,RECFM,80,11,483,COMM,
- + IVECT,CHOPT,IRC)
-*
-* Copy contents of bank created by last FMADDx call into MYVECT
-*
- CALL FMPEEK(GENAME,MYVECT,' ',IRC)
-*
-* Change some fields...
-* Set use count to 3
-* Change account of creator
-*
- MYVECT(MUSCFA) = 3
- CALL UCTOH('JDS$CT',MYVECT(MCIDFA),4,6)
-*
-* Add send the update
-*
- CALL FMPOKE(GENAME,MYVECT,'P',IRC)
-*
-* Terminate cleanly
-*
- CALL FMEND(IRC)
- PRINT *,'Return code ',IRC,' from FMEND'
-*
- END
diff --git a/src/packlib/fatmen/examples/book.dat b/src/packlib/fatmen/examples/book.dat
deleted file mode 100644
index c049eef..0000000
--- a/src/packlib/fatmen/examples/book.dat
+++ /dev/null
@@ -1,81 +0,0 @@
-*
-* $Id: book.dat,v 1.1.1.1 1996/03/07 15:18:00 mclareni Exp $
-*
-* $Log: book.dat,v $
-* Revision 1.1.1.1 1996/03/07 15:18:00 mclareni
-* Fatmen
-*
-*
- TAP1 1317 8-AUG-1992 18:17:48.34 8-AUG-1992 19:02:18.95 MJ0225 1 77777 51218 1 5595 11
- TAP1 1318 8-AUG-1992 19:29:47.60 8-AUG-1992 21:43:06.66 MJ0225 2 77777 12527 1 1236 2
- TAP1 1319 8-AUG-1992 21:44:25.59 8-AUG-1992 22:24:52.11 MJ0225 3 77777 50106 1 5613 11
- TAP1 1320 8-AUG-1992 22:24:58.94 8-AUG-1992 23:03:01.65 MJ0225 4 77777 49412 1 5618 11
- TAP1 1321 8-AUG-1992 23:03:09.39 8-AUG-1992 23:54:51.96 MJ0225 5 77777 51666 1 5584 11
- TAP1 1322 8-AUG-1992 23:54:58.97 9-AUG-1992 00:35:39.91 MJ0225 6 77777 49561 1 5595 11
- TAP1 1323 9-AUG-1992 00:35:47.83 9-AUG-1992 04:55:05.83 MJ0225 7 77777 51910 1 5696 11
- TAP1 1324 9-AUG-1992 04:55:13.70 9-AUG-1992 07:27:43.84 MJ0225 8 77777 50069 1 5655 11
- TAP1 1325 9-AUG-1992 07:27:51.74 9-AUG-1992 08:09:58.15 MJ0225 9 77777 50689 1 5600 11
- TAP1 1326 9-AUG-1992 08:10:04.98 9-AUG-1992 08:48:50.88 MJ0225 10 77777 49993 1 5607 11
- TAP1 1327 9-AUG-1992 08:48:58.94 9-AUG-1992 09:31:19.59 MJ0225 11 77777 50201 1 5619 11
- TAP1 1328 9-AUG-1992 09:31:27.51 9-AUG-1992 10:13:19.50 MJ0225 12 77777 49917 1 5587 11
- TAP1 1329 9-AUG-1992 10:13:27.33 9-AUG-1992 10:53:53.02 MJ0225 13 77777 50131 1 5615 11
- TAP1 1330 9-AUG-1992 10:54:00.84 9-AUG-1992 11:34:40.93 MJ0225 14 77777 50104 1 5616 11
- TAP1 1331 9-AUG-1992 11:52:48.62 9-AUG-1992 12:32:45.61 MJ0225 15 77777 49815 1 5624 11
- TAP1 1332 9-AUG-1992 12:33:36.84 9-AUG-1992 13:12:50.36 MJ0225 16 77777 49152 1 5594 11
- TAP1 1333 9-AUG-1992 13:12:57.37 9-AUG-1992 13:51:57.45 MJ0225 17 77777 49294 1 5595 11
- TAP1 1334 9-AUG-1992 13:52:04.60 9-AUG-1992 14:38:02.18 MJ0225 18 77777 50088 1 5600 11
- TAP1 1335 9-AUG-1992 14:38:09.29 9-AUG-1992 15:16:26.10 MJ0225 19 77777 49351 1 5606 11
- TAP1 1336 9-AUG-1992 15:16:33.95 9-AUG-1992 15:55:47.64 MJ0225 20 77777 49281 1 5593 11
- TAP1 1337 9-AUG-1992 16:02:57.51 9-AUG-1992 16:32:16.38 MJ0226 1 77777 53026 1 5035 10
- TAP1 1338 9-AUG-1992 16:53:51.93 9-AUG-1992 17:11:09.12 MJ0226 2 77777 49593 1 5618 11
- TAP1 1339 9-AUG-1992 17:11:36.89 9-AUG-1992 22:20:30.07 MJ0226 3 77777 43102 1 4624 8
- TAP1 1340 10-AUG-1992 13:35:18.24 10-AUG-1992 14:22:23.32 MJ0227 1 77777 50872 1 5597 11
- TAP1 1341 10-AUG-1992 14:22:30.44 10-AUG-1992 15:07:59.22 MJ0227 2 77777 50936 1 5597 11
- TAP1 1342 10-AUG-1992 15:17:27.61 10-AUG-1992 16:07:01.51 MJ0227 3 77777 51508 1 5602 11
- TAP1 1343 10-AUG-1992 16:08:48.26 10-AUG-1992 16:51:54.19 MJ0227 4 77777 51142 1 5602 11
- TAP1 1344 10-AUG-1992 16:52:02.02 10-AUG-1992 17:41:35.01 MJ0227 5 77777 52291 1 5615 11
- TAP1 1345 10-AUG-1992 17:41:42.11 10-AUG-1992 18:23:06.02 MJ0227 6 77777 51013 1 5608 11
- TAP1 1346 10-AUG-1992 18:23:13.82 10-AUG-1992 19:03:39.60 MJ0227 7 77777 51150 1 5604 11
- TAP1 1347 10-AUG-1992 19:03:47.16 10-AUG-1992 19:57:39.53 MJ0227 8 77777 52070 1 5594 11
- TAP1 1348 10-AUG-1992 19:57:47.13 10-AUG-1992 20:42:32.16 MJ0227 9 77777 51091 1 5612 11
- TAP1 1349 10-AUG-1992 20:42:39.99 10-AUG-1992 21:22:51.31 MJ0227 10 77777 50290 1 5615 11
- TAP1 1350 10-AUG-1992 21:22:59.13 10-AUG-1992 22:02:56.01 MJ0227 11 77777 50576 1 5601 11
- TAP1 1351 10-AUG-1992 22:03:03.10 10-AUG-1992 22:43:58.31 MJ0227 12 77777 50727 1 5612 11
- TAP1 1352 10-AUG-1992 22:44:05.51 10-AUG-1992 23:24:46.22 MJ0227 13 77777 50747 1 5577 11
- TAP1 1353 10-AUG-1992 23:24:51.67 11-AUG-1992 00:07:29.45 MJ0227 14 77777 50946 1 5589 11
- TAP1 1354 11-AUG-1992 00:07:36.98 11-AUG-1992 00:46:50.89 MJ0227 15 77777 50693 1 5612 11
- TAP1 1355 11-AUG-1992 00:46:58.79 11-AUG-1992 01:26:41.22 MJ0227 16 77777 50997 1 5592 11
- TAP1 1356 11-AUG-1992 01:26:49.20 11-AUG-1992 02:04:36.33 MJ0227 17 77777 50570 1 5595 11
- TAP1 1357 11-AUG-1992 02:04:44.15 11-AUG-1992 02:44:12.27 MJ0227 18 77777 50653 1 5588 11
- TAP1 1358 11-AUG-1992 02:44:20.13 11-AUG-1992 03:22:36.15 MJ0227 19 77777 50511 1 5581 11
- TAP1 1359 11-AUG-1992 03:22:44.13 11-AUG-1992 04:02:55.29 MJ0227 20 77777 50708 1 5617 11
- TAP1 1360 11-AUG-1992 04:03:16.80 11-AUG-1992 04:44:12.02 MJ0228 1 77777 50650 1 5589 11
- TAP1 1361 11-AUG-1992 04:44:19.77 11-AUG-1992 05:23:19.17 MJ0228 2 77777 50420 1 5585 11
- TAP1 1362 11-AUG-1992 05:23:26.41 11-AUG-1992 06:01:57.50 MJ0228 3 77777 50680 1 5599 11
- TAP1 1363 11-AUG-1992 06:02:05.46 11-AUG-1992 06:41:18.98 MJ0228 4 77777 50897 1 5612 11
- TAP1 1364 11-AUG-1992 06:41:26.68 11-AUG-1992 07:21:38.11 MJ0228 5 77777 50720 1 5601 11
- TAP1 1365 11-AUG-1992 07:21:45.94 11-AUG-1992 08:18:16.41 MJ0228 6 77777 52004 1 5615 11
- TAP1 1366 11-AUG-1992 08:18:23.61 11-AUG-1992 09:01:28.33 MJ0228 7 77777 51142 1 5595 11
- TAP1 1367 11-AUG-1992 09:16:27.73 11-AUG-1992 10:00:01.80 MJ0228 8 77777 51197 1 5589 11
- TAP1 1368 11-AUG-1992 10:00:09.71 11-AUG-1992 10:46:20.95 MJ0228 9 77777 51561 1 5588 11
- TAP1 1369 11-AUG-1992 10:55:35.54 11-AUG-1992 12:09:08.76 MJ0228 10 77777 47292 1 4830 9
- TAP1 1370 11-AUG-1992 12:17:40.03 11-AUG-1992 12:59:47.06 MJ0228 11 77777 51191 1 5622 11
- TAP1 1371 11-AUG-1992 12:59:53.94 11-AUG-1992 13:43:42.16 MJ0228 12 77777 50792 1 5593 11
- TAP1 1372 11-AUG-1992 13:49:49.42 11-AUG-1992 14:33:08.48 MJ0228 13 77777 50403 1 5591 11
- TAP1 1373 11-AUG-1992 14:34:41.95 11-AUG-1992 15:19:27.58 MJ0228 14 77777 50626 1 5614 11
- TAP1 1374 11-AUG-1992 18:55:25.42 11-AUG-1992 19:39:07.86 MJ0229 1 77777 49742 1 5605 11
- TAP1 1375 11-AUG-1992 19:40:56.46 11-AUG-1992 20:21:51.04 MJ0229 2 77777 50078 1 5598 11
- TAP1 1376 11-AUG-1992 20:21:59.01 11-AUG-1992 21:21:50.83 MJ0229 3 77777 50160 1 5612 11
- TAP1 1377 11-AUG-1992 21:21:57.80 11-AUG-1992 22:04:48.39 MJ0229 4 77777 50494 1 5580 11
- TAP1 1378 11-AUG-1992 22:04:55.60 11-AUG-1992 22:43:41.05 MJ0229 5 77777 49786 1 5591 11
- TAP1 1379 11-AUG-1992 22:43:49.12 11-AUG-1992 23:23:31.41 MJ0229 6 77777 50059 1 5615 11
- TAP1 1380 11-AUG-1992 23:23:39.21 12-AUG-1992 00:03:07.32 MJ0229 7 77777 49878 1 5585 11
- TAP1 1381 12-AUG-1992 00:17:38.18 12-AUG-1992 00:57:36.01 MJ0229 8 77777 50199 1 5611 11
- TAP1 1382 12-AUG-1992 00:57:44.02 12-AUG-1992 01:38:38.33 MJ0229 9 77777 50468 1 5596 11
- TAP1 1383 12-AUG-1992 01:38:45.37 12-AUG-1992 02:20:23.81 MJ0229 10 77777 50230 1 5604 11
- TAP1 1384 12-AUG-1992 02:20:31.66 12-AUG-1992 03:20:23.86 MJ0229 11 77777 50944 1 5611 11
- TAP1 1385 12-AUG-1992 03:20:31.55 12-AUG-1992 03:58:18.83 MJ0229 12 77777 49815 1 5591 11
- TAP1 1386 12-AUG-1992 03:58:26.80 12-AUG-1992 04:40:18.75 MJ0229 13 77777 50401 1 5600 11
- TAP1 1387 12-AUG-1992 04:40:26.50 12-AUG-1992 05:21:06.68 MJ0229 14 77777 50336 1 5592 11
- TAP1 1388 12-AUG-1992 05:21:13.81 12-AUG-1992 06:02:09.00 MJ0229 15 77777 50223 1 5591 11
- TAP1 1389 12-AUG-1992 06:02:16.84 12-AUG-1992 06:48:13.75 MJ0229 16 77777 43471 1 4710 9
diff --git a/src/packlib/fatmen/examples/fatcomm.F b/src/packlib/fatmen/examples/fatcomm.F
deleted file mode 100644
index b3e2271..0000000
--- a/src/packlib/fatmen/examples/fatcomm.F
+++ /dev/null
@@ -1,184 +0,0 @@
-*
-* $Id: fatcomm.F,v 1.1.1.1 1996/03/07 15:18:00 mclareni Exp $
-*
-* $Log: fatcomm.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:00 mclareni
-* Fatmen
-*
-*
-*
-* Look through catalogue looking for generic names
-* which have more than one entry. For each of these
-* cases, update the comment string using the comment
-* string from the first entry with a non-blank comment
-*
-* Illustrates the use of:
-* FMSCAN to loop over directories
-* FMUNIQ to return a list of unique names in a directory
-* FMEXST to count the number of entries of a given generic name
-* FMFILS to retrieve the keys vectors for given generic name
-* FMGETK to get the bank corresponding to a given generic name &
-* keys vector combination
-* FMGETC to read a string from a bank
-* FMPUTC to put a string into a bank
-* FMMOD to update the catalogue
-*
- PARAMETER (LURCOR=200000)
- COMMON/CRZT/IXSTOR,IXDIV,IFENCE(2),LEV,LEVIN,BLVECT(LURCOR)
- DIMENSION LQ(999),IQ(999),Q(999)
- EQUIVALENCE (IQ(1),Q(1),LQ(9)),(LQ(1),LEV)
-*
- COMMON /USRLNK/LUSRK1,LUSRBK,LUSRLS
-*
- COMMON /QUEST/IQUEST(100)
- PARAMETER (MAXDIR=100)
- CHARACTER*255 CHDIR(MAXDIR)
-*
-* Start of FATMEN sequence FATPARA
-*
-** *** Data set bank mnemonics
-*
-* Keys
- PARAMETER ( MKSRFA= 1, MKFNFA= 2, MKCLFA=7, MKMTFA=8
- 1 ,MKLCFA= 9, MKNBFA=10, NKDSFA=10 )
-*
-** *** Bank offsets
-*
- PARAMETER ( MFQNFA= 1, MHSNFA= 65, MCPLFA= 67, MMTPFA= 68
- 1 ,MLOCFA= 69, MHSTFA= 70, MHOSFA= 74
- 2 ,MVSNFA= 77, MVIDFA= 79, MVIPFA= 81, MDENFA= 82
- 3 ,MVSQFA= 83, MFSQFA= 84, MSRDFA= 85, MERDFA= 86
- 4 ,MSBLFA= 87, MEBLFA= 88, MRFMFA= 89, MRLNFA= 90
- 5 ,MBLNFA= 91, MFLFFA= 92, MFUTFA= 93, MCRTFA= 94
- 6 ,MCTTFA= 95, MLATFA= 96, MCURFA= 97, MCIDFA= 99
- 7 ,MCNIFA=101, MCJIFA=103, MFPRFA=105, MSYWFA=106
- 8 ,MUSWFA=116, MUCMFA=126, NWDSFA=145
- 9 ,MFSZFA=MSYWFA,MUSCFA=MSYWFA+1)
-
-* End of FATMEN sequence FATPARA
-*KEEP,FATBUG.
- COMMON /FATUSE/ IDEBFA, IDIVFA, IKDRFA, KOFSFA, KOFUFA, LBFXFA
- + , LSAVFA, LTOPFA, LBBKFA, LBGNFA, LTDSFA, LBDSFA
- + , LPRTFA, NTOPFA, LUFZFA, IOUPFA, IOBKFA, IODSFA
- + , LLNLFA, LLNHFA
-*KEND.
- CHARACTER*8 DSN
- EXTERNAL UROUT
-*
-*
-* Initialise ZEBRA
-*
- CALL MZEBRA(-3)
- CALL MZSTOR(IXSTOR,'/CRZT/','Q',IFENCE,LEV,BLVECT(1),BLVECT(1),
- + BLVECT(5000),BLVECT(LURCOR))
- CALL MZLOGL(IXSTOR,-3)
-
-*
-* *** Define user division and link area like:
-*
- CALL MZDIV (IXSTOR, IXDIV, 'USERS', 50000, LURCOR, 'L')
- CALL MZLINK (IXSTOR, '/USRLNK/', LUSRK1, LUSRLS, LUSRK1)
-*
-* Units for FATMEN RZ/FZ files
-*
- LUNRZ = 1
- LUNFZ = 2
-*
-* Initialise FATMEN
-*
- CALL FMINIT(IXSTOR,LUNRZ,LUNFZ,'//CERN/NA44',IRC)
- CALL FMLOGL(0)
-
- CALL FMSCAN('//CERN/NA44/*',-1,UROUT,IRC)
- END
-
- SUBROUTINE UROUT(PATH,IRC)
- CHARACTER*(*) PATH
- PARAMETER (MAXFIL=1000)
- PARAMETER (MAXCOP=10)
- CHARACTER*255 FILES(MAXFIL),COPIES(MAXCOP),COMM,CHCOMM
- PARAMETER (LKEYFA=10)
- DIMENSION KEYSIN(LKEYFA),KEYS(LKEYFA,MAXCOP)
- PARAMETER (LURCOR=200000)
- COMMON/CRZT/IXSTOR,IXDIV,IFENCE(2),LEV,LEVIN,BLVECT(LURCOR)
- DIMENSION LQ(999),IQ(999),Q(999)
- EQUIVALENCE (IQ(1),Q(1),LQ(9)),(LQ(1),LEV)
- COMMON/QUEST/IQUEST(100)
- PARAMETER ( MFQNFA= 1, MHSNFA= 65, MCPLFA= 67, MMTPFA= 68
- 1 ,MLOCFA= 69, MHSTFA= 70, MHOSFA= 74
- 2 ,MVSNFA= 77, MVIDFA= 79, MVIPFA= 81, MDENFA= 82
- 3 ,MVSQFA= 83, MFSQFA= 84, MSRDFA= 85, MERDFA= 86
- 4 ,MSBLFA= 87, MEBLFA= 88, MRFMFA= 89, MRLNFA= 90
- 5 ,MBLNFA= 91, MFLFFA= 92, MFUTFA= 93, MCRTFA= 94
- 6 ,MCTTFA= 95, MLATFA= 96, MCURFA= 97, MCIDFA= 99
- 7 ,MCNIFA=101, MCJIFA=103, MFPRFA=105, MSYWFA=106
- 8 ,MUSWFA=116, MUCMFA=126, NWDSFA=145
- 9 ,MFSZFA=MSYWFA,MUSCFA=MSYWFA+1)
-
- PARAMETER (NUCMFA = (NWDSFA-MUCMFA)*4)
-
- PARAMETER ( MKSRFA= 1, MKFNFA= 2, MKCLFA=7, MKMTFA=8
- 1 ,MKLCFA= 9, MKNBFA=10, NKDSFA=10 )
- LP = LENOCC(PATH)
- PRINT *,'Processing ',PATH(1:LENOCC(PATH))
- IRC = 0
-*
-* Any files in this directory?
-*
- IF(IQUEST(14).EQ.0) RETURN
-*
-* Get list of unique file names in this directory
-*
- KEYSIN(MKMTFA) = -1
- KEYSIN(MKLCFA) = -1
- KEYSIN(MKCLFA) = -1
- CALL FMUNIQ(PATH(1:LP),KEYSIN,FILES,MAXFIL,NFILES,' ',IRC)
- PRINT *,NFILES,' files found in ',PATH(1:LP)
- DO 10 I=1,NFILES
-*
-* Find those files for which more than one entry exists
-*
- CALL FMEXST(FILES(I),NCOPIES)
- IF(NCOPIES.LT.2) GOTO 10
- LENF = LENOCC(FILES(I))
- PRINT *,NCOPIES,' copies found for ',
- + FILES(I)(1:LENF)
-*
-* Now get the comment (if any)
-*
- COMM = ' '
- CALL FMFILS(FILES(I)(1:LENF),COPIES,KEYS,NCOPY,MAXCOP,
- + ICONT,IRC)
- LC = 0
- DO 20 J=1,NCOPY
- CALL FMGETK(COPIES,LBANK,KEYS(1,J),IRC)
- IF(LC.EQ.0) THEN
- CALL FMGETC(LBANK,COMM,MUCMFA,NUCMFA,IRC)
- LC = LENOCC(COMM)
- IF(LC.GT.0) THEN
- PRINT *,'Comment found for ',FILES(I)(1:LENF),
- + ' copy # ',J
- PRINT *,COMM(1:LC)
- IF(J.GT.1) PRINT *,'*** WARNING *** comment ',
- + 'field not updated for previous copies!'
- ENDIF
- ELSE
-*
-* Check that a comment does not already exist for this copy...
-*
- CALL FMGETC(LBANK,CHCOMM,MUCMFA,NUCMFA,IRC)
- LCH = LENOCC(CHCOMM)
- IF(LCH.EQ.0) THEN
-*
-* Set the comment and update...
-*
- CALL FMPUTC(LBANK,COMM,MUCMFA,LC,IRC)
- CALL FMSHOW(FILES(I)(1:LENF),LBANK,KEYS(1,J),
- + 'CG',IRC)
- CALL FMMOD(FILES(I)(1:LENF),LBANK,1,IRC)
- ENDIF
- ENDIF
- CALL MZDROP(IXSTOR,LBANK,' ')
-20 CONTINUE
-10 CONTINUE
- END
diff --git a/src/packlib/fatmen/examples/fatcount.F b/src/packlib/fatmen/examples/fatcount.F
deleted file mode 100644
index 0b5a91e..0000000
--- a/src/packlib/fatmen/examples/fatcount.F
+++ /dev/null
@@ -1,84 +0,0 @@
-*
-* $Id: fatcount.F,v 1.1.1.1 1996/03/07 15:18:01 mclareni Exp $
-*
-* $Log: fatcount.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:01 mclareni
-* Fatmen
-*
-*
- PROGRAM FATCOUNT
-*------------------------------------------------------------------------
-* Count files & directories
-*------------------------------------------------------------------------
- PARAMETER (LURCOR=200000)
- COMMON/CRZT/IXSTOR,IXDIV,IFENCE(2),LEV,LEVIN,BLVECT(LURCOR)
- DIMENSION LQ(999),IQ(999),Q(999)
- EQUIVALENCE (IQ(1),Q(1),LQ(9)),(LQ(1),LEV)
-*
- COMMON /USRLNK/LUSRK1,LUSRBK,LUSRLS
-*
-#include "fatmen/quest.inc"
-#include "fatmen/fatpara.inc"
-#include "fatmen/fatbug.inc"
-#include "fatmen/slate.inc"
-*
- PARAMETER (MAXDIR=100)
- CHARACTER*255 CHDIR(MAXDIR)
- CHARACTER*8 DSN
- CHARACTER*16 CHSYS,CHGRP
- EXTERNAL UROUT
-*
-*
-* Initialise ZEBRA
-*
- CALL MZEBRA(-3)
- CALL MZSTOR(IXSTOR,'/CRZT/','Q',IFENCE,LEV,BLVECT(1),BLVECT(1),
- + BLVECT(5000),BLVECT(LURCOR))
- CALL MZLOGL(IXSTOR,-3)
-
-*
-* *** Define user division and link area like:
-*
- CALL MZDIV (IXSTOR, IXDIV, 'USERS', 50000, LURCOR, 'L')
- CALL MZLINK (IXSTOR, '/USRLNK/', LUSRK1, LUSRLS, LUSRK1)
-*
-* Units for FATMEN RZ/FZ files
-*
- LUNRZ = 1
- LUNFZ = 2
-*
-* Get FATMEN system & group names
-*
- CALL GETENVF('FATSYS',CHSYS)
- IF(IS(1).EQ.0) THEN
- PRINT *,'FATMEN system defaulted to CERN'
- CHSYS = 'CERN'
- LSYS = 4
- ELSE
- LSYS = IS(1)
- PRINT *,'FATMEN system: ',CHSYS(1:LSYS)
- ENDIF
-
- CALL GETENVF('FATGRP',CHGRP)
- IF(IS(1).EQ.0) THEN
- PRINT *,'FATMEN group not defined'
- STOP
- ELSE
- LGRP = IS(1)
- PRINT *,'FATMEN group: ',CHGRP(1:LGRP)
- ENDIF
-*
-* Initialise FATMEN
-*
- CALL FMINIT(IXSTOR,LUNRZ,LUNFZ,
- + '//'//CHSYS(1:LSYS)//'/'//CHGRP(1:LGRP),IRC)
-
- CALL FMFILC('//'//CHSYS(1:LSYS)//'/'//CHGRP(1:LGRP)//'*/',
- + NFILES,IRC)
-
- WRITE(6,9001) IQUEST(12),IQUEST(13),
- + '//'//CHSYS(1:LSYS)//'/'//CHGRP(1:LGRP)
-
-9001 FORMAT(' FATCOUNT. total of ',I6,' files in ',I6,
- + ' directories for ',A)
- END
diff --git a/src/packlib/fatmen/examples/fatdelph.F b/src/packlib/fatmen/examples/fatdelph.F
deleted file mode 100644
index 54aff8b..0000000
--- a/src/packlib/fatmen/examples/fatdelph.F
+++ /dev/null
@@ -1,258 +0,0 @@
-*
-* $Id: fatdelph.F,v 1.1.1.1 1996/03/07 15:18:00 mclareni Exp $
-*
-* $Log: fatdelph.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:00 mclareni
-* Fatmen
-*
-*
-*=======================================================================
-*
-* Program to copy DELPHI FATMEN catalogue, suppressing L0nnn level
-* This level, indicating the LEP fill number, is stored in user word 5
-*
-*=======================================================================
- PARAMETER (LURCOR=200000)
- COMMON/CRZT/IXSTOR,IXDIV,IFENCE(2),LEV,LEVIN,BLVECT(LURCOR)
- DIMENSION LQ(999),IQ(999),Q(999)
- EQUIVALENCE (IQ(1),Q(1),LQ(9)),(LQ(1),LEV)
-*
- COMMON /USRLNK/LUSRK1,LUSRBK,LUSRLS
-*
- COMMON /QUEST/IQUEST(100)
- PARAMETER (MAXDIR=100)
- CHARACTER*255 CHDIR(MAXDIR),CHSAVE,CHOLD
- CHARACTER*20 FNAME
-*
-* Start of FATMEN sequence FATPARA
-*
-** *** Data set bank mnemonics
-*
-* Keys
- PARAMETER ( MKSRFA= 1, MKFNFA= 2, MKCLFA=7, MKMTFA=8
- 1 ,MKLCFA= 9, MKNBFA=10, NKDSFA=10 )
-*
-** *** Bank offsets
-*
- PARAMETER ( MFQNFA= 1, MHSNFA= 65, MCPLFA= 67, MMTPFA= 68
- 1 ,MLOCFA= 69, MHSTFA= 70, MHOSFA= 74
- 2 ,MVSNFA= 77, MVIDFA= 79, MVIPFA= 81, MDENFA= 82
- 3 ,MVSQFA= 83, MFSQFA= 84, MSRDFA= 85, MERDFA= 86
- 4 ,MSBLFA= 87, MEBLFA= 88, MRFMFA= 89, MRLNFA= 90
- 5 ,MBLNFA= 91, MFLFFA= 92, MFUTFA= 93, MCRTFA= 94
- 6 ,MCTTFA= 95, MLATFA= 96, MCURFA= 97, MCIDFA= 99
- 7 ,MCNIFA=101, MCJIFA=103, MFPRFA=105, MSYWFA=106
- 8 ,MUSWFA=116, MUCMFA=126, NWDSFA=145
- 9 ,MFSZFA=MSYWFA,MUSCFA=MSYWFA+1)
-
-* End of FATMEN sequence FATPARA
-*KEEP,FATBUG.
- COMMON /FATUSE/ IDEBFA, IDIVFA, IKDRFA, KOFSFA, KOFUFA, LBFXFA
- + , LSAVFA, LTOPFA, LBBKFA, LBGNFA, LTDSFA, LBDSFA
- + , LPRTFA, NTOPFA, LUFZFA, IOUPFA, IOBKFA, IODSFA
- + , LLNLFA, LLNHFA
-*KEND.
- COMMON /MZCC/ LQPSTO,NQPFEN,NQPSTR,NQPREF,NQPLK,NQPMIN,LQP2E
- +, JQPDVL,JQPDVS,NQPLOG,NQPNAM(6)
- +, LQSYSS(10), LQSYSR(10), IQTDUM(22)
- +, LQSTA(21), LQEND(20), NQDMAX(20),IQMODE(20)
- +, IQKIND(20),IQRTO(20), IQRNO(20), NQDINI(20)
- +, NQDWIP(20),NQDGAU(20),NQDGAF(20),NQDPSH(20)
- +, NQDRED(20),NQDSIZ(20),IQDN1(20), IQDN2(20)
- +, KQFT, LQFSTA(21)
- DIMENSION IQTABV(16)
- EQUIVALENCE (IQTABV(1),LQPSTO)
-C
- COMMON /RZCL/ LTOP,LRZ0,LCDIR,LRIN,LROUT,LFREE,LUSED,LPURG
- +, LTEMP,LCORD,LFROM
- EQUIVALENCE (LQRS,LQSYSS(7))
-C
- PARAMETER (NLPATM=100)
- COMMON /RZDIRN/NLCDIR,NLNDIR,NLPAT
- COMMON /RZDIRC/CHCDIR(NLPATM),CHNDIR(NLPATM),CHPAT(NLPATM)
- CHARACTER*16 CHNDIR, CHCDIR, CHPAT
-C
- COMMON /RZCH/ CHWOLD,CHL
- CHARACTER*128 CHWOLD,CHL
-C
- PARAMETER (KUP=5,KPW1=7,KNCH=9,KDATEC=10,KDATEM=11,KQUOTA=12,
- + KRUSED=13,KWUSED=14,KMEGA=15,KIRIN=17,KIROUT=18,
- + KRLOUT=19,KIP1=20,KNFREE=22,KNSD=23,KLD=24,KLB=25,
- + KLS=26,KLK=27,KLF=28,KLC=29,KLE=30,KNKEYS=31,
- + KNWKEY=32,KKDES=33,KNSIZE=253,KEX=6,KNMAX=100)
-
- PARAMETER (JBIAS=2)
- PARAMETER (ICYCLE=999)
- PARAMETER (LKEYFA=10)
- DIMENSION KEYS(LKEYFA)
- CHARACTER*8 CHTAG(LKEYFA)
- CHARACTER*10 CHFOR
- DATA CHTAG/'Num.Id.',5*'Fname'
- + ,'cp.level','loc.code','medium','nm.banks'/
- DATA CHFOR/'IHHHHHIIII'/
-*
-*
-* Initialise ZEBRA
-*
- CALL MZEBRA(-3)
- CALL MZSTOR(IXSTOR,'/CRZT/','Q',IFENCE,LEV,BLVECT(1),BLVECT(1),
- + BLVECT(5000),BLVECT(LURCOR))
- CALL MZLOGL(IXSTOR,-3)
-
-*
-* *** Define user division and link area like:
-*
- CALL MZDIV (IXSTOR, IXDIV, 'USERS', 50000, LURCOR, 'L')
- CALL MZLINK (IXSTOR, '/USRLNK/', LUSRK1, LUSRLS, LUSRK1)
-*
-* Units for FATMEN RZ/FZ files
-*
- LUNRZ = 1
- LUNFZ = 2
-*
-* Initialise FATMEN
-*
- CALL FMINIT(IXSTOR,LUNRZ,LUNFZ,'//CERN/DELPHI',IRC)
-*
-* Set log level
-*
- CALL FMLOGL(1)
-*
-* Create output RZ file
-*
- CALL RZOPEN(20,'//KERN','/fatmen/fmdelphi/delphi.fatrz',
- + 'N1',1024,IRC)
- CALL RZMAKE (20,'KERN',LKEYFA,CHFOR,CHTAG,65000,' ')
- CALL RZMDIR('DELPHI',LKEYFA,CHFOR,CHTAG)
-*
-* Get list of directories in input file
-*
- NTOTAL = 0
- K = 0
- NOBJ = 0
- ICONT = 0
-
-10 CONTINUE
-
- CALL FMLDIR('//CERN/DELPHI/*',
- +CHDIR,NFOUND,MAXDIR,ICONT,IRC)
- IF(IDEBFA.GE.3) PRINT *,NFOUND,' directories found'
- IF(IRC.NE.0.AND.IDEBFA.GT.0)
- + PRINT *,'return code ',IRC,' from FMLDIR'
-
- CALL RZCDIR(CHOLD,'R')
- LOLD = LENOCC(CHOLD)
-
- NTOTAL = NTOTAL + NFOUND
-
- DO 20 J=1,NFOUND
- LEND = LENOCC(CHDIR(J))
- IF(IDEBFA.GE.3) PRINT *,'Processing ',CHDIR(J)(1:LEND)
-*
-* Exclusion list:
-*
- IF(INDEX(CHDIR(J)(1:LEND),
- + '//CERN/DELPHI/P01_ALLD/CDST/LEPT/Y91V02').NE.0) GOTO 20
- IF(INDEX(CHDIR(J)(1:LEND),
- + '//CERN/DELPHI/P01_ALLD/CDST/LEPT/Y91V03').NE.0) GOTO 20
- IF(INDEX(CHDIR(J)(1:LEND),
- + '//CERN/DELPHI/P01_ALLD/CDST/LEPT/Y91V04').NE.0) GOTO 20
- IF(INDEX(CHDIR(J)(1:LEND),
- + '//CERN/DELPHI/P01_ALLD/CDST/S2PR/Y91V02').NE.0) GOTO 20
- IF(INDEX(CHDIR(J)(1:LEND),
- + '//CERN/DELPHI/P01_ALLD/CDST/S2PR/Y91V03').NE.0) GOTO 20
- IF(INDEX(CHDIR(J)(1:LEND),
- + '//CERN/DELPHI/P01_ALLD/CDST/S2PR/Y91V04').NE.0) GOTO 20
- IF(INDEX(CHDIR(J)(1:LEND),
- + '//CERN/DELPHI/P01_ALLD/DSTO/LEPT/Y91V03').NE.0) GOTO 20
- IF(INDEX(CHDIR(J)(1:LEND),
- + '//CERN/DELPHI/P01_ALLD/DSTO/PHYS/Y91V02').NE.0) GOTO 20
- IF(INDEX(CHDIR(J)(1:LEND),
- + '//CERN/DELPHI/P01_ALLD/DSTO/PHYS/Y91V04').NE.0) GOTO 20
-*
- CALL RZCDIR(CHSAVE,'R')
- LSAVE = LENOCC(CHSAVE)
-*
-* Skip all L0* directories
-*
- LSLASH = INDEXB(CHDIR(J)(1:LEND),'/')
- IF(CHDIR(J)(LSLASH:LSLASH+2).EQ.'/L0') GOTO 30
- K = K + 1
-*
-* Convert CDST to MDST
-*
- LDST = INDEX(CHDIR(J)(1:LEND),'CDST')
- IF(LDST.NE.0) CHDIR(J)(LDST:LDST) = 'M'
- IF(IDEBFA.GE.2) PRINT *,'Creating directory # ',K,CHDIR(J)(1:LEND)
- CHDIR(J)(1:6) = '//KERN'
-
- CALL RZCDIR(CHDIR(J)(1:LSLASH-1),' ')
- CALL RZMDIR(CHDIR(J)(LSLASH+1:LEND),LKEYFA,CHFOR,CHTAG)
- CALL RZCDIR(CHSAVE(1:LSAVE),' ')
- GOTO 20
-30 CONTINUE
-*
-* Process all files in this directory - copy to output file
-*
- IF(CHDIR(J)(LSLASH:LSLASH+2).EQ.'/L0') THEN
- READ(CHDIR(J)(LSLASH+1:LEND),'(1X,I4)') LEVEL
- ELSE
- LEVEL = -1
- ENDIF
-
- IF(IDEBFA.GE.3) PRINT *,'Processing data directory ',
- + CHDIR(J)(1:LEND)
- CALL RZCDIR(CHDIR(J)(1:LEND),' ')
- NWK = IQ(KQSP+LCDIR+KNWKEY)
- NKEYS = IQ(KQSP+LCDIR+KNKEYS)
- LK = IQ(KQSP+LCDIR+KLK)
-
- DO 40 I=1,NKEYS
-*
-* Number of this key vector
-*
- KK=LK+(NWK+1)*(I-1)
- DO 50 JJ=1,NWK
- IKDES=(JJ-1)/10
- IKBIT1=3*JJ-30*IKDES-2
- IF(JBYT(IQ(KQSP+LCDIR+KKDES+IKDES),IKBIT1,3).LT.3)THEN
- KEYS(JJ)=IQ(KQSP+LCDIR+KK+JJ)
- ELSE
- CALL ZITOH(IQ(KQSP+LCDIR+KK+JJ),KEYS(JJ),1)
- ENDIF
- 50 CONTINUE
- CALL UHTOC(KEYS(MKFNFA),4,FNAME,20)
- LF = LENOCC(FNAME)
- CALL RZIN(IXDIV,LUSRLS,JBIAS,KEYS,ICYCLE,'D')
- IF(IQUEST(1).NE.0) THEN
- IF(IDEBFA.GE.0) PRINT *,'return code from RZIN = ',IQUEST(1)
- GOTO 40
- ENDIF
- IF(LEVEL.GT.0) IQ(LUSRLS+MUSWFA+4) = LEVEL
- CHDIR(J)(1:6) = '//KERN'
- LDST = INDEX(CHDIR(J)(1:LEND),'CDST')
- IF(LDST.NE.0) CHDIR(J)(LDST:LDST) = 'M'
- CALL RZCDIR(CHDIR(J)(1:LSLASH-1),' ')
- CALL RZOUT(IXDIV,LUSRLS,KEYS,ICYC,'SW')
- CHDIR(J)(1:6) = '//CERN'
- IF(LDST.NE.0) CHDIR(J)(LDST:LDST) = 'C'
- CALL RZCDIR(CHDIR(J)(1:LEND),' ')
- NOBJ = NOBJ + 1
- IF(MOD(NOBJ,100).EQ.0.AND.IDEBFA.GE.2)
- + PRINT *,'Processed ',NOBJ,' objects ,cwd = ',
- + CHDIR(J)(1:LEND)
-40 CONTINUE
-20 CONTINUE
- IF(IRC.EQ.-1) THEN
- ICONT = 1
- CALL RZCDIR(CHOLD(1:LOLD),' ')
- GOTO 10
- ENDIF
-
- CALL RZEND('KERN')
- CALL FMEND(IRC)
- PRINT *,'Total of ',NTOTAL,' directories found in input file'
- PRINT *,'Total of ',K,' directories created in output file'
-
- END
-
diff --git a/src/packlib/fatmen/examples/fatexam1.F b/src/packlib/fatmen/examples/fatexam1.F
deleted file mode 100644
index 6efd3cb..0000000
--- a/src/packlib/fatmen/examples/fatexam1.F
+++ /dev/null
@@ -1,114 +0,0 @@
-*
-* $Id: fatexam1.F,v 1.1.1.1 1996/03/07 15:18:00 mclareni Exp $
-*
-* $Log: fatexam1.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:00 mclareni
-* Fatmen
-*
-*
-*======================================================================
-*
-* Example FATMEN Program
-*======================================================================
-*
-* KEYS vector
-*
- PARAMETER (LKEYFA=10)
- DIMENSION KEYS(LKEYFA)
- COMMON/QUEST/IQUEST(100)
-*
-* Generic name
-*
- CHARACTER*255 GENAME
-*
-* Units on which FATMEN will be read (LUNRZ) and
-* on which updates, if any, will be written (LUNFZ)
-*
- LUNRZ = 73
- LUNFZ = 12
-*
-* Initialise FATMEN and Zebra the easy way...
-*
- CALL FMSTRT(LUNRZ,LUNFZ,'//CERN/OPAL',IRC)
-
- GENAME = '//CERN/OPAL/DDST/PASS3/FYZ1/P18R1929/C01'
- LG = LENOCC(GENAME)
-*
-* Get this entry from the catalogue
-*
- LBANK = 0
- CALL FMGET(GENAME(1:LG),LBANK,KEYS,IRC)
-*
-* and display it using FMSHOW...
-* just the KEYS vector (option K)
-*
- CALL FMSHOW(GENAME(1:LG),LBANK,KEYS,'K',IRC)
-*
-* Comment field (C) full generic name (G) and TMS info (Q)
-*
- CALL FMSHOW(GENAME(1:LG),LBANK,KEYS,'CGQ',IRC)
-*
-* everything... (except options Q & Z)
-*
- CALL FMSHOW(GENAME(1:LG),LBANK,KEYS,'A',IRC)
-*
-* now we want to try and read the file...
-* open for read (R) and issue FZFILE (F) on unit 11
-* Put LBANK to 0 first. This will cause FMOPEN to
-* re-retrieve the information from the catalogue.
-* (We should really save LBANK in a ZEBRA link area)
-*
- LBANK = 0
- IQUEST(10) = 0
- CALL FMOPEN(GENAME(1:LG),
- +'11',LBANK,'RF',IRC)
- IF(IRC.NE.0) THEN
- PRINT *,'Return code ',IRC,' from FMOPEN'
- GOTO 10
- ELSE
- CALL READFZ(11)
- ENDIF
-*
-* Now clsoe the file. E=call FZENDx, D=Drop staging disk,
-* dismount tape, deassign logical name etc. as appropriate
-* Z=drop bank at LBANK
-*
- CALL FMCLOS(GENAME,
- + '11',LBANK,'EDZ',IRC)
- IF(IRC.NE.0) PRINT *,'Return code ',IRC,' from FMCLOS'
-1 CONTINUE
-10 CONTINUE
-*
- END
-
- SUBROUTINE READFZ(LUN)
- PARAMETER (LURCOR=200000)
- COMMON/CRZT/IXSTOR,IXDIV,IFENCE(2),LEV,LEVIN,BLVECT(LURCOR)
- DIMENSION LQ(999),IQ(999),Q(999)
- EQUIVALENCE (IQ(1),Q(1),LQ(9)),(LQ(1),LEV)
- COMMON/QUEST/IQUEST(100)
- CHARACTER*8 DELTIM
- DIMENSION IUHEAD(400)
- DIMENSION IOCR(100)
- PARAMETER (JBIAS=2)
- PARAMETER (IEVENT=0)
-
- NREC = 0
- CALL FMRTIM(DELTIM)
- CALL TIMED(T)
- 1 CONTINUE
- NHEAD = 400
- IXDIV = 0
- CALL FZIN(LUN,IXDIV,LSUP,JBIAS,'S',NHEAD,IUHEAD)
- IF(IQUEST(1).LT.4) THEN
- NREC = NREC + 1
- GOTO 1
- ENDIF
-
- PRINT *,'READFZ. end after ',NREC,' records, IQUEST(1) = ',
- + IQUEST(1)
- CALL FMRTIM(DELTIM)
- CALL TIMED(T)
- PRINT *,'READFZ. Elapsed time = ',DELTIM,
- + ' CP time = ',T,' sec.'
- END
diff --git a/src/packlib/fatmen/examples/fathunt.F b/src/packlib/fatmen/examples/fathunt.F
deleted file mode 100644
index f798576..0000000
--- a/src/packlib/fatmen/examples/fathunt.F
+++ /dev/null
@@ -1,89 +0,0 @@
-*
-* $Id: fathunt.F,v 1.1.1.1 1996/03/07 15:18:00 mclareni Exp $
-*
-* $Log: fathunt.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:00 mclareni
-* Fatmen
-*
-*
-*=======================================================================
-*
-* Example of using the FMHUNT routine.
-* FMHUNT is the FORTRAN equivalent of FMZOOM, i.e. in hunts for the
-* first directory in the specified pathname that contains one or more
-* files.
-*=======================================================================
- PARAMETER (LURCOR=200000)
- COMMON/CRZT/IXSTOR,IXDIV,IFENCE(2),LEV,LEVIN,BLVECT(LURCOR)
- DIMENSION LQ(999),IQ(999),Q(999)
- EQUIVALENCE (IQ(1),Q(1),LQ(9)),(LQ(1),LEV)
-*
- COMMON /USRLNK/LUSRK1,LUSRBK,LUSRLS
-*
- COMMON /QUEST/IQUEST(100)
-*
-* Start of FATMEN sequence FATPARA
-*
-** *** Data set bank mnemonics
-*
-* Keys
- PARAMETER ( MKSRFA= 1, MKFNFA= 2, MKCLFA=7, MKMTFA=8
- 1 ,MKLCFA= 9, MKNBFA=10, NKDSFA=10 )
-*
-** *** Bank offsets
-*
- PARAMETER ( MFQNFA= 1, MHSNFA= 65, MCPLFA= 67, MMTPFA= 68
- 1 ,MLOCFA= 69, MHSTFA= 70, MHOSFA= 74
- 2 ,MVSNFA= 77, MVIDFA= 79, MVIPFA= 81, MDENFA= 82
- 3 ,MVSQFA= 83, MFSQFA= 84, MSRDFA= 85, MERDFA= 86
- 4 ,MSBLFA= 87, MEBLFA= 88, MRFMFA= 89, MRLNFA= 90
- 5 ,MBLNFA= 91, MFLFFA= 92, MFUTFA= 93, MCRTFA= 94
- 6 ,MCTTFA= 95, MLATFA= 96, MCURFA= 97, MCIDFA= 99
- 7 ,MCNIFA=101, MCJIFA=103, MFPRFA=105, MSYWFA=106
- 8 ,MUSWFA=116, MUCMFA=126, NWDSFA=145
- 9 ,MFSZFA=MSYWFA,MUSCFA=MSYWFA+1)
-
-* End of FATMEN sequence FATPARA
-*KEEP,FATBUG.
- COMMON /FATUSE/ IDEBFA, IDIVFA, IKDRFA, KOFSFA, KOFUFA, LBFXFA
- + , LSAVFA, LTOPFA, LBBKFA, LBGNFA, LTDSFA, LBDSFA
- + , LPRTFA, NTOPFA, LUFZFA, IOUPFA, IOBKFA, IODSFA
- + , LLNLFA, LLNHFA
-*KEND.
- CHARACTER*255 FILE
- DIMENSION KEYS(10)
-*
-*
-* Initialise ZEBRA
-*
- CALL MZEBRA(-3)
- CALL MZSTOR(IXSTOR,'/CRZT/','Q',IFENCE,LEV,BLVECT(1),BLVECT(1),
- + BLVECT(5000),BLVECT(LURCOR))
- CALL MZLOGL(IXSTOR,-3)
-
-*
-* *** Define user division and link area like:
-*
- CALL MZDIV (IXSTOR, IXDIV, 'USERS', 50000, LURCOR, 'L')
- CALL MZLINK (IXSTOR, '/USRLNK/', LUSRK1, LUSRLS, LUSRK1)
-*
-* Units for FATMEN RZ/FZ files
-*
- LUNRZ = 1
- LUNFZ = 2
-*
-* Initialise FATMEN
-*
- CALL FMINIT(IXSTOR,LUNRZ,LUNFZ,'//CERN/DELPHI',IRC)
- CALL FMLOGL(3)
-
- CALL FMHUNT('//CERN/DELPHI/*/*',FILE,KEYS,' ',IRC)
- PRINT *,FILE(1:LENOCC(FILE)),IRC
- PRINT *,'Number of subdirectories = ',IQUEST(12)
- PRINT *,'Number of elements in initial path name = ',IQUEST(10)
- PRINT *,'Number of elements in path name = ',IQUEST(13)
- PRINT *,'Number of files = ',IQUEST(14)
- PRINT *,'Number of elements per key = ',IQUEST(15)
- PRINT *,'Number of this file (KSN) = ',IQUEST(17)
- END
-
diff --git a/src/packlib/fatmen/examples/fatindx.F b/src/packlib/fatmen/examples/fatindx.F
deleted file mode 100644
index a9b62d3..0000000
--- a/src/packlib/fatmen/examples/fatindx.F
+++ /dev/null
@@ -1,91 +0,0 @@
-*
-* $Id: fatindx.F,v 1.1.1.1 1996/03/07 15:18:01 mclareni Exp $
-*
-* $Log: fatindx.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:01 mclareni
-* Fatmen
-*
-*
- PARAMETER (LURCOR=200000)
- COMMON/CRZT/IXSTOR,IXDIV,IFENCE(2),LEV,LEVIN,BLVECT(LURCOR)
- DIMENSION LQ(999),IQ(999),Q(999)
- EQUIVALENCE (IQ(1),Q(1),LQ(9)),(LQ(1),LEV)
-*
- COMMON /USRLNK/LUSRK1,LUSRBK,LUSRLS
-*
-#include "fatmen/quest.inc"
-#include "fatmen/fatpara.inc"
- CHARACTER*6 DENS
- CHARACTER*8 LIB
- CHARACTER*4 LABTYP
- CHARACTER*1 MNTTYP
- CHARACTER*8 MODEL
- CHARACTER*7 ROBMAN(2)
- DATA ROBMAN(1)/'-Robot '/,ROBMAN(2)/'-Manual'/
- PARAMETER (LKEYFA=10)
- PARAMETER (MAXFIL=100)
- DIMENSION KEYS(LKEYFA,MAXFIL)
- CHARACTER*255 FILES(MAXFIL)
- DIMENSION JSORT(MAXFIL)
- CHARACTER*8 THRONG
- CHARACTER*255 TOPDIR
- CHARACTER*26 CHOPT
- CHARACTER*8 DSN
-*
-*
-* Initialise ZEBRA
-*
- CALL MZEBRA(-3)
- CALL MZSTOR(IXSTOR,'/CRZT/','Q',IFENCE,LEV,BLVECT(1),BLVECT(1),
- + BLVECT(5000),BLVECT(LURCOR))
- CALL MZLOGL(IXSTOR,-3)
-
-*
-* *** Define user division and link area like:
-*
- CALL MZDIV (IXSTOR, IXDIV, 'USERS', 50000, LURCOR, 'L')
- CALL MZLINK (IXSTOR, '/USRLNK/', LUSRK1, LUSRLS, LUSRK1)
-*
-* Units for FATMEN RZ/FZ files
-*
- LUNRZ = 1
- LUNFZ = 2
-*
-* Initialise FATMEN
-*
- CALL FMINIT(IXSTOR,LUNRZ,LUNFZ,'//CERN/CNDIV',IRC)
-*
-* Get list of file names
-*
- JCONT = 0
- NTOTAL = 0
-10 CONTINUE
- CALL FMLFIL('//CERN/CNDIV/JAMIE/DD/*',
- +FILES,KEYS,NFOUND,MAXFIL,JCONT,IRC)
- NTOTAL = NTOTAL + NFOUND
-*
-* Now sort this list by VID & FSEQ
-*
- CALL FMINDX(FILES,KEYS,NFOUND,JSORT,' ',IRC)
-
- DO 20 J=1,NFOUND
-
- LBANK = 0
- CALL FMSHOW(FILES(JSORT(J))(1:LENOCC(FILES(JSORT(J)))),
- + LBANK,KEYS(1,JSORT(J)),'GM',IRC)
-
-20 CONTINUE
-
- IF(IRC.NE.0) THEN
- JCONT = 1
- GOTO 10
- ENDIF
-30 CONTINUE
- PRINT *,'Total of ',NTOTAL,' files found'
-*
-* Terminate cleanly
-*
- CALL FMEND(IRC)
-
- END
-
diff --git a/src/packlib/fatmen/examples/fatldir.F b/src/packlib/fatmen/examples/fatldir.F
deleted file mode 100644
index 2693db0..0000000
--- a/src/packlib/fatmen/examples/fatldir.F
+++ /dev/null
@@ -1,105 +0,0 @@
-*
-* $Id: fatldir.F,v 1.1.1.1 1996/03/07 15:17:59 mclareni Exp $
-*
-* $Log: fatldir.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:59 mclareni
-* Fatmen
-*
-*
- PARAMETER (LURCOR=200000)
- COMMON/CRZT/IXSTOR,IXDIV,IFENCE(2),LEV,LEVIN,BLVECT(LURCOR)
- DIMENSION LQ(999),IQ(999),Q(999)
- EQUIVALENCE (IQ(1),Q(1),LQ(9)),(LQ(1),LEV)
-*
- COMMON /USRLNK/LUSRK1,LUSRBK,LUSRLS
-*
- COMMON /QUEST/IQUEST(100)
-*
-* Start of FATMEN sequence FATPARA
-*
-** *** Data set bank mnemonics
-*
-* Keys
- PARAMETER ( MKSRFA= 1, MKFNFA= 2, MKCLFA=7, MKMTFA=8
- 1 ,MKLCFA= 9, MKNBFA=10, NKDSFA=10 )
-*
-** *** Bank offsets
-*
- PARAMETER ( MFQNFA= 1, MHSNFA= 65, MCPLFA= 67, MMTPFA= 68
- 1 ,MLOCFA= 69, MHSTFA= 70, MHOSFA= 74
- 2 ,MVSNFA= 77, MVIDFA= 79, MVIPFA= 81, MDENFA= 82
- 3 ,MVSQFA= 83, MFSQFA= 84, MSRDFA= 85, MERDFA= 86
- 4 ,MSBLFA= 87, MEBLFA= 88, MRFMFA= 89, MRLNFA= 90
- 5 ,MBLNFA= 91, MFLFFA= 92, MFUTFA= 93, MCRTFA= 94
- 6 ,MCTTFA= 95, MLATFA= 96, MCURFA= 97, MCIDFA= 99
- 7 ,MCNIFA=101, MCJIFA=103, MFPRFA=105, MSYWFA=106
- 8 ,MUSWFA=116, MUCMFA=126, NWDSFA=145
- 9 ,MFSZFA=MSYWFA,MUSCFA=MSYWFA+1)
-
-* End of FATMEN sequence FATPARA
- CHARACTER*6 DENS
- CHARACTER*8 LIB
- CHARACTER*4 LABTYP
- CHARACTER*1 MNTTYP
- CHARACTER*8 MODEL
- CHARACTER*7 ROBMAN(2)
- DATA ROBMAN(1)/'-Robot '/,ROBMAN(2)/'-Manual'/
- PARAMETER (LKEYFA=10)
- PARAMETER (MAXKEY=5000)
- PARAMETER (MAXDIR=500)
- DIMENSION KEYS(LKEYFA,MAXDIR)
- CHARACTER*255 CHDIR(MAXDIR)
- CHARACTER*255 CHFILE(MAXKEY)
- CHARACTER*8 THRONG
- CHARACTER*255 TOPDIR
- CHARACTER*26 CHOPT
- CHARACTER*8 DSN
-*
-*
-* Initialise ZEBRA
-*
- CALL MZEBRA(-3)
- CALL MZSTOR(IXSTOR,'/CRZT/','Q',IFENCE,LEV,BLVECT(1),BLVECT(1),
- + BLVECT(5000),BLVECT(LURCOR))
- CALL MZLOGL(IXSTOR,-3)
-
-*
-* *** Define user division and link area like:
-*
- CALL MZDIV (IXSTOR, IXDIV, 'USERS', 50000, LURCOR, 'L')
- CALL MZLINK (IXSTOR, '/USRLNK/', LUSRK1, LUSRLS, LUSRK1)
-*
-* Units for FATMEN RZ/FZ files
-*
- LUNRZ = 1
- LUNFZ = 2
-*
-* Initialise FATMEN
-*
- CALL FMINIT(IXSTOR,LUNRZ,LUNFZ,'//CERN/DELPHI',IRC)
- CALL FMLOGL(0)
-*
-* Get list of file names
-*
- CALL FMLDIR('//CERN/DELPHI/*',
- +CHDIR,NFOUND,MAXDIR,ICONT,IRC)
- PRINT *,NFOUND,' directories found'
-
- NFILES = 0
- DO 10 I=1,NFOUND
- LEND = LENOCC(CHDIR(I))
- PRINT *,'Directory ',CHDIR(I)(1:LEND)
- CALL FMFNMS(CHDIR(I)(1:LEND),CHFILE,KEYS,NKEYS,MAXKEY,IRC)
- NFILES = NFILES + NKEYS
- DO 20 J=1,NKEYS
- PRINT *,CHFILE(J)(1:LENOCC(CHFILE(J)))
-20 CONTINUE
-10 CONTINUE
- PRINT *,'Total of ',NFILES,' files in ',NFOUND,' directories'
-*
-* Terminate cleanly
-*
- CALL FMEND(IRC)
-
- END
-
diff --git a/src/packlib/fatmen/examples/fatlfil.F b/src/packlib/fatmen/examples/fatlfil.F
deleted file mode 100644
index 5422b82..0000000
--- a/src/packlib/fatmen/examples/fatlfil.F
+++ /dev/null
@@ -1,100 +0,0 @@
-*
-* $Id: fatlfil.F,v 1.1.1.1 1996/03/07 15:17:59 mclareni Exp $
-*
-* $Log: fatlfil.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:59 mclareni
-* Fatmen
-*
-*
- PARAMETER (LURCOR=200000) FAT00010
- COMMON/CRZT/IXSTOR,IXDIV,IFENCE(2),LEV,LEVIN,BLVECT(LURCOR) FAT00020
- DIMENSION LQ(999),IQ(999),Q(999) FAT00030
- EQUIVALENCE (IQ(1),Q(1),LQ(9)),(LQ(1),LEV) FAT00040
-* FAT00050
- COMMON /USRLNK/LUSRK1,LUSRBK,LUSRLS FAT00060
-* FAT00070
- COMMON /QUEST/IQUEST(100) FAT00080
-* FAT00090
-* Start of FATMEN sequence FATPARA FAT00100
-* FAT00110
-** *** Data set bank mnemonics FAT00120
-* FAT00130
-* Keys FAT00140
- PARAMETER ( MKSRFA= 1, MKFNFA= 2, MKCLFA=7, MKMTFA=8 FAT00150
- 1 ,MKLCFA= 9, MKNBFA=10, NKDSFA=10 ) FAT00160
-* FAT00170
-** *** Bank offsets FAT00180
-* FAT00190
- PARAMETER ( MFQNFA= 1, MHSNFA= 65, MCPLFA= 67, MMTPFA= 68 FAT00200
- 1 ,MLOCFA= 69, MHSTFA= 70, MHOSFA= 74 FAT00210
- 2 ,MVSNFA= 77, MVIDFA= 79, MVIPFA= 81, MDENFA= 82 FAT00220
- 3 ,MVSQFA= 83, MFSQFA= 84, MSRDFA= 85, MERDFA= 86 FAT00230
- 4 ,MSBLFA= 87, MEBLFA= 88, MRFMFA= 89, MRLNFA= 90 FAT00240
- 5 ,MBLNFA= 91, MFLFFA= 92, MFUTFA= 93, MCRTFA= 94 FAT00250
- 6 ,MCTTFA= 95, MLATFA= 96, MCURFA= 97, MCIDFA= 99 FAT00260
- 7 ,MCNIFA=101, MCJIFA=103, MFPRFA=105, MSYWFA=106 FAT00270
- 8 ,MUSWFA=116, MUCMFA=126, NWDSFA=145 FAT00280
- 9 ,MFSZFA=MSYWFA,MUSCFA=MSYWFA+1) FAT00290
- FAT00300
-* End of FATMEN sequence FATPARA FAT00310
- CHARACTER*6 DENS FAT00320
- CHARACTER*8 LIB FAT00330
- CHARACTER*4 LABTYP FAT00340
- CHARACTER*1 MNTTYP FAT00350
- CHARACTER*8 MODEL FAT00360
- CHARACTER*7 ROBMAN(2) FAT00370
- DATA ROBMAN(1)/'-Robot '/,ROBMAN(2)/'-Manual'/ FAT00380
- PARAMETER (LKEYFA=10) FAT00390
- PARAMETER (MAXFIL=2000) FAT00400
- DIMENSION KEYS(LKEYFA,MAXFIL) FAT00410
- CHARACTER*255 FILES(MAXFIL) FAT00420
- CHARACTER*8 THRONG FAT00430
- CHARACTER*255 TOPDIR FAT00440
- CHARACTER*26 CHOPT FAT00450
- CHARACTER*8 DSN FAT00460
-* FAT00470
-* FAT00480
-* Initialise ZEBRA FAT00490
-* FAT00500
- CALL MZEBRA(-3) FAT00510
- CALL MZSTOR(IXSTOR,'/CRZT/','Q',IFENCE,LEV,BLVECT(1),BLVECT(1), FAT00520
- + BLVECT(5000),BLVECT(LURCOR)) FAT00530
- CALL MZLOGL(IXSTOR,-3) FAT00540
- FAT00550
-* FAT00560
-* *** Define user division and link area like: FAT00570
-* FAT00580
- CALL MZDIV (IXSTOR, IXDIV, 'USERS', 50000, LURCOR, 'L') FAT00590
- CALL MZLINK (IXSTOR, '/USRLNK/', LUSRK1, LUSRLS, LUSRK1) FAT00600
-* FAT00610
-* Units for FATMEN RZ/FZ files FAT00620
-* FAT00630
- LUNRZ = 1 FAT00640
- LUNFZ = 2 FAT00650
-* FAT00660
-* Initialise FATMEN FAT00670
-* FAT00680
- CALL FMINIT(IXSTOR,LUNRZ,LUNFZ,'//CERN/DELPHI',IRC) FAT00690
- CALL FMLOGL(0) FAT00700
-* FAT00710
-* Get list of file names FAT00720
-* FAT00730
- ICONT = 0 FAT00740
-20 CONTINUE FAT00750
- CALL FMLFIL( FAT00760
- +'//CERN/DELPHI/P01_ALLD/CDST/LEPT/Y91V04/E089.5/L0819/*', FAT00770
- +FILES,KEYS,NFOUND,MAXFIL,ICONT,IRC) FAT00780
- FAT00790
- DO 10 I=1,NFOUND FAT00800
- LENF = LENOCC(FILES(I)) FAT00810
- PRINT 9001,FILES(I)(1:LENF),KEYS(1,I) FAT00820
-9001 FORMAT(1X,A,I10) FAT00830
-10 CONTINUE FAT00840
- IF(ICONT.NE.0) GOTO 20 FAT00850
-* FAT00860
-* Terminate cleanly FAT00870
-* FAT00880
- CALL FMEND(IRC) FAT00890
- FAT00900
- END FAT00910
- FAT00920
diff --git a/src/packlib/fatmen/examples/fatlist.F b/src/packlib/fatmen/examples/fatlist.F
deleted file mode 100644
index 7c3c89a..0000000
--- a/src/packlib/fatmen/examples/fatlist.F
+++ /dev/null
@@ -1,97 +0,0 @@
-*
-* $Id: fatlist.F,v 1.1.1.1 1996/03/07 15:17:59 mclareni Exp $
-*
-* $Log: fatlist.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:59 mclareni
-* Fatmen
-*
-*
- PARAMETER (LURCOR=200000)
- COMMON/CRZT/IXSTOR,IXDIV,IFENCE(2),LEV,LEVIN,BLVECT(LURCOR)
- DIMENSION LQ(999),IQ(999),Q(999)
- EQUIVALENCE (IQ(1),Q(1),LQ(9)),(LQ(1),LEV)
-*
- COMMON /USRLNK/LUSRK1,LUSRBK,LUSRLS
-*
- COMMON /QUEST/IQUEST(100)
-*
-* Start of FATMEN sequence FATPARA
-*
-** *** Data set bank mnemonics
-*
-* Keys
- PARAMETER ( MKSRFA= 1, MKFNFA= 2, MKCLFA=7, MKMTFA=8
- 1 ,MKLCFA= 9, MKNBFA=10, NKDSFA=10 )
-*
-** *** Bank offsets
-*
- PARAMETER ( MFQNFA= 1, MHSNFA= 65, MCPLFA= 67, MMTPFA= 68
- 1 ,MLOCFA= 69, MHSTFA= 70, MHOSFA= 74
- 2 ,MVSNFA= 77, MVIDFA= 79, MVIPFA= 81, MDENFA= 82
- 3 ,MVSQFA= 83, MFSQFA= 84, MSRDFA= 85, MERDFA= 86
- 4 ,MSBLFA= 87, MEBLFA= 88, MRFMFA= 89, MRLNFA= 90
- 5 ,MBLNFA= 91, MFLFFA= 92, MFUTFA= 93, MCRTFA= 94
- 6 ,MCTTFA= 95, MLATFA= 96, MCURFA= 97, MCIDFA= 99
- 7 ,MCNIFA=101, MCJIFA=103, MFPRFA=105, MSYWFA=106
- 8 ,MUSWFA=116, MUCMFA=126, NWDSFA=145
- 9 ,MFSZFA=MSYWFA,MUSCFA=MSYWFA+1)
-
-* End of FATMEN sequence FATPARA
- CHARACTER*6 DENS
- CHARACTER*8 LIB
- CHARACTER*4 LABTYP
- CHARACTER*1 MNTTYP
- CHARACTER*8 MODEL
- CHARACTER*7 ROBMAN(2)
- DATA ROBMAN(1)/'-Robot '/,ROBMAN(2)/'-Manual'/
- PARAMETER (LKEYFA=10)
- PARAMETER (MAXFIL=12000)
- DIMENSION KEYS(LKEYFA,MAXFIL)
- CHARACTER*255 FILES(MAXFIL)
- CHARACTER*8 THRONG
- CHARACTER*255 TOPDIR
- CHARACTER*26 CHOPT
- CHARACTER*8 DSN
-*
-*
-* Initialise ZEBRA
-*
- CALL MZEBRA(-3)
- CALL MZSTOR(IXSTOR,'/CRZT/','Q',IFENCE,LEV,BLVECT(1),BLVECT(1),
- + BLVECT(5000),BLVECT(LURCOR))
- CALL MZLOGL(IXSTOR,-3)
-
-*
-* *** Define user division and link area like:
-*
- CALL MZDIV (IXSTOR, IXDIV, 'USERS', 50000, LURCOR, 'L')
- CALL MZLINK (IXSTOR, '/USRLNK/', LUSRK1, LUSRLS, LUSRK1)
-*
-* Units for FATMEN RZ/FZ files
-*
- LUNRZ = 1
- LUNFZ = 2
-*
-* Initialise FATMEN
-*
- CALL FMINIT(IXSTOR,LUNRZ,LUNFZ,'//CERN/OPAL',IRC)
- CALL FMLOGL(0)
-*
-* Get list of file names
-*
- CALL FMLIST('//CERN/OPAL/*',
- +FILES,KEYS,NFOUND,MAXFIL,IRC)
- PRINT *,NFOUND,' files found'
-
- DO 10 I=1,NFOUND
- LENF = LENOCC(FILES(I))
- PRINT *,FILES(I)(1:LENF)
-10 CONTINUE
-20 CONTINUE
-*
-* Terminate cleanly
-*
- CALL FMEND(IRC)
-
- END
-
diff --git a/src/packlib/fatmen/examples/fatloop.F b/src/packlib/fatmen/examples/fatloop.F
deleted file mode 100644
index d620d21..0000000
--- a/src/packlib/fatmen/examples/fatloop.F
+++ /dev/null
@@ -1,85 +0,0 @@
-*
-* $Id: fatloop.F,v 1.1.1.1 1996/03/07 15:17:59 mclareni Exp $
-*
-* $Log: fatloop.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:59 mclareni
-* Fatmen
-*
-*
- PARAMETER (LURCOR=200000)
- COMMON/CRZT/IXSTOR,IXDIV,IFENCE(2),LEV,LEVIN,BLVECT(LURCOR)
- DIMENSION LQ(999),IQ(999),Q(999)
- EQUIVALENCE (IQ(1),Q(1),LQ(9)),(LQ(1),LEV)
-*
- COMMON /USRLNK/LUSRK1,LUSRBK,LUSRLS
-*
- COMMON /QUEST/IQUEST(100)
- PARAMETER (MAXDIR=100)
- CHARACTER*255 CHDIR(MAXDIR)
-*
-* Start of FATMEN sequence FATPARA
-*
-** *** Data set bank mnemonics
-*
-* Keys
- PARAMETER ( MKSRFA= 1, MKFNFA= 2, MKCLFA=7, MKMTFA=8
- 1 ,MKLCFA= 9, MKNBFA=10, NKDSFA=10 )
-*
-** *** Bank offsets
-*
- PARAMETER ( MFQNFA= 1, MHSNFA= 65, MCPLFA= 67, MMTPFA= 68
- 1 ,MLOCFA= 69, MHSTFA= 70, MHOSFA= 74
- 2 ,MVSNFA= 77, MVIDFA= 79, MVIPFA= 81, MDENFA= 82
- 3 ,MVSQFA= 83, MFSQFA= 84, MSRDFA= 85, MERDFA= 86
- 4 ,MSBLFA= 87, MEBLFA= 88, MRFMFA= 89, MRLNFA= 90
- 5 ,MBLNFA= 91, MFLFFA= 92, MFUTFA= 93, MCRTFA= 94
- 6 ,MCTTFA= 95, MLATFA= 96, MCURFA= 97, MCIDFA= 99
- 7 ,MCNIFA=101, MCJIFA=103, MFPRFA=105, MSYWFA=106
- 8 ,MUSWFA=116, MUCMFA=126, NWDSFA=145
- 9 ,MFSZFA=MSYWFA,MUSCFA=MSYWFA+1)
-
-* End of FATMEN sequence FATPARA
-*KEEP,FATBUG.
- COMMON /FATUSE/ IDEBFA, IDIVFA, IKDRFA, KOFSFA, KOFUFA, LBFXFA
- + , LSAVFA, LTOPFA, LBBKFA, LBGNFA, LTDSFA, LBDSFA
- + , LPRTFA, NTOPFA, LUFZFA, IOUPFA, IOBKFA, IODSFA
- + , LLNLFA, LLNHFA
-*KEND.
- CHARACTER*8 DSN
- EXTERNAL UROUT
-*
-*
-* Initialise ZEBRA
-*
- CALL MZEBRA(-3)
- CALL MZSTOR(IXSTOR,'/CRZT/','Q',IFENCE,LEV,BLVECT(1),BLVECT(1),
- + BLVECT(5000),BLVECT(LURCOR))
- CALL MZLOGL(IXSTOR,-3)
-
-*
-* *** Define user division and link area like:
-*
- CALL MZDIV (IXSTOR, IXDIV, 'USERS', 50000, LURCOR, 'L')
- CALL MZLINK (IXSTOR, '/USRLNK/', LUSRK1, LUSRLS, LUSRK1)
-*
-* Units for FATMEN RZ/FZ files
-*
- LUNRZ = 1
- LUNFZ = 2
-*
-* Initialise FATMEN
-*
- CALL FMINIT(IXSTOR,LUNRZ,LUNFZ,'//CERN/DELPHI',IRC)
- CALL FMLOGL(0)
-
- CALL FMLOOP('//CERN/DELPHI/*/*',-1,UROUT,IRC)
- END
-
- SUBROUTINE UROUT(GENAM,KEYS,IRC)
- CHARACTER*(*) GENAM
- PARAMETER (LKEYFA=10)
- DIMENSION KEYS(LKEYFA)
- COMMON/QUEST/IQUEST(100)
- IRC = 0
- PRINT *,GENAM(1:LENOCC(PATH))
- END
diff --git a/src/packlib/fatmen/examples/fatloop2.F b/src/packlib/fatmen/examples/fatloop2.F
deleted file mode 100644
index 1c07c5a..0000000
--- a/src/packlib/fatmen/examples/fatloop2.F
+++ /dev/null
@@ -1,109 +0,0 @@
-*
-* $Id: fatloop2.F,v 1.1.1.1 1996/03/07 15:18:00 mclareni Exp $
-*
-* $Log: fatloop2.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:00 mclareni
-* Fatmen
-*
-*
- PROGRAM FATLOOP2
- PARAMETER (LURCOR=200000)
- COMMON/CRZT/IXSTOR,IXDIV,IFENCE(2),LEV,LEVIN,BLVECT(LURCOR)
- DIMENSION LQ(999),IQ(999),Q(999)
- EQUIVALENCE (IQ(1),Q(1),LQ(9)),(LQ(1),LEV)
-*
- COMMON/USRLNK/LUSRK1,LUSRBK,LUSRLS
- COMMON/FLOOP2/NFILES
-*
-#include "fatmen/quest.inc"
- PARAMETER (MAXDIR=100)
- CHARACTER*255 CHDIR(MAXDIR)
-#include "fatmen/fatpara.inc"
-#include "fatmen/fatbug.inc"
- CHARACTER*16 CHSYS,CHGRP
- CHARACTER*8 CHLOG
-#include "fatmen/slate.inc"
- EXTERNAL UROUT
-*
-*
-* Initialise ZEBRA
-*
- CALL MZEBRA(-3)
- CALL MZSTOR(IXSTOR,'/CRZT/','Q',IFENCE,LEV,BLVECT(1),BLVECT(1),
- + BLVECT(5000),BLVECT(LURCOR))
- CALL MZLOGL(IXSTOR,-3)
-
-*
-* *** Define user division and link area like:
-*
- CALL MZDIV (IXSTOR, IXDIV, 'USERS', 50000, LURCOR, 'L')
- CALL MZLINK (IXSTOR, '/USRLNK/', LUSRK1, LUSRLS, LUSRK1)
-
- NFILES = 0
-*
-* Units for FATMEN RZ/FZ files
-*
- LUNRZ = 1
- LUNFZ = 2
-
- CALL GETENVF('FATSYS',CHSYS)
- IF(IS(1).EQ.0) THEN
- PRINT *,'FATMEN system defaulted to CERN'
- CHSYS = 'CERN'
- LSYS = 4
- ELSE
- LSYS = IS(1)
- PRINT *,'FATMEN system: ',CHSYS(1:LSYS)
- ENDIF
-
- CALL GETENVF('FATGRP',CHGRP)
- IF(IS(1).EQ.0) THEN
- PRINT *,'FATMEN group not defined'
- STOP
- ELSE
- LGRP = IS(1)
- PRINT *,'FATMEN group: ',CHGRP(1:LGRP)
- ENDIF
-
- CALL GETENVF('FMLOGL',CHLOG)
- IF(IS(1).EQ.0) THEN
- LOGLV = 0
- ELSE
- LOGLV = ICDECI(CHLOG,1,IS(1))
- ENDIF
-*
-* Initialise FATMEN
-*
- CALL FMINIT(IXSTOR,LUNRZ,LUNFZ,
- + '//'//CHSYS(1:LSYS)//'/'//CHGRP(1:LGRP),IRC)
-
- CALL FMLOGL(LOGLV)
-
- CALL FMLOOP('//'//CHSYS(1:LSYS)//'/'//CHGRP(1:LGRP)//'*/*',
- + -1,UROUT,IRC)
-
- IF(IDEBFA.GE.0) PRINT *,'FATLOOP2. # files = ',NFILES
-
- END
-
- SUBROUTINE UROUT(GENAM,KEYS,IRC)
- CHARACTER*(*) GENAM
- PARAMETER (LURCOR=200000)
- COMMON/CRZT/IXSTOR,IXDIV,IFENCE(2),LEV,LEVIN,BLVECT(LURCOR)
- DIMENSION LQ(999),IQ(999),Q(999)
- EQUIVALENCE (IQ(1),Q(1),LQ(9)),(LQ(1),LEV)
- PARAMETER (LKEYFA=10)
- DIMENSION KEYS(LKEYFA)
-#include "fatmen/fatbug.inc"
-#include "fatmen/quest.inc"
- COMMON/FLOOP2/NFILES
- IRC = 0
- LGN = LENOCC(GENAM)
- LBANK = 0
- IF(IDEBFA.GT.0) PRINT *,'Get: ',GENAM(1:LGN)
- CALL FMGETK(GENAM(1:LGN),LBANK,KEYS,IRC)
- IF(IRC.EQ.0) THEN
- NFILES = NFILES + 1
- CALL MZDROP(IXSTOR,LBANK,' ')
- ENDIF
- END
diff --git a/src/packlib/fatmen/examples/fatls.F b/src/packlib/fatmen/examples/fatls.F
deleted file mode 100644
index a51936b..0000000
--- a/src/packlib/fatmen/examples/fatls.F
+++ /dev/null
@@ -1,60 +0,0 @@
-*
-* $Id: fatls.F,v 1.1.1.1 1996/03/07 15:17:59 mclareni Exp $
-*
-* $Log: fatls.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:59 mclareni
-* Fatmen
-*
-*
- PROGRAM FATLS
-*----------------------------------------------------------------------*
-* *
-* Example of use of the FMLS subroutine *
-* *
-*----------------------------------------------------------------------*
- PARAMETER (LURCOR=200000)
- COMMON/CRZT/IXSTOR,IXDIV,IFENCE(2),LEV,LEVIN,BLVECT(LURCOR)
- DIMENSION LQ(999),IQ(999),Q(999)
- EQUIVALENCE (IQ(1),Q(1),LQ(9)),(LQ(1),LEV)
-*
- COMMON /USRLNK/LUSRK1,LUSRBK,LUSRLS
-*
- COMMON /QUEST/IQUEST(100)
-*
- CHARACTER*4 CHOPT
- CHARACTER*4 KOPT(5)
- PARAMETER (LKEYFA=10)
- DIMENSION KEY(LKEYFA)
-*
-*
-* Initialise ZEBRA
-*
- CALL MZEBRA(-3)
- CALL MZSTOR(IXSTOR,'/CRZT/','Q',IFENCE,LEV,BLVECT(1),BLVECT(1),
- + BLVECT(5000),BLVECT(LURCOR))
- CALL MZLOGL(IXSTOR,-3)
-
-*
-* *** Define user division and link area like:
-*
- CALL MZDIV (IXSTOR, IXDIV, 'USERS', 50000, LURCOR, 'L')
- CALL MZLINK (IXSTOR, '/USRLNK/', LUSRK1, LUSRLS, LUSRK1)
-*
-* Unit for RZ database
-*
- LUNRZ = 1
- LUNFZ = 2
-
-* read mode
- CALL FMINIT(IXSTOR,LUNRZ,LUNFZ,'//CERN/NA31',IRC)
- CALL FMLOGL(0)
- kopt(3) = 'I'
- kopt(4) = 'W'
- kopt(5) = 'X'
- do 10 i=3,5
- chopt = kopt(i)
- call fmlogl(3)
- CALL FMLS('//CERN/NA31/88/MIN8/*',CHOPT,IC)
-10 continue
- END
-
diff --git a/src/packlib/fatmen/examples/fatlton.F b/src/packlib/fatmen/examples/fatlton.F
deleted file mode 100644
index bd60f64..0000000
--- a/src/packlib/fatmen/examples/fatlton.F
+++ /dev/null
@@ -1,58 +0,0 @@
-*
-* $Id: fatlton.F,v 1.1.1.1 1996/03/07 15:18:01 mclareni Exp $
-*
-* $Log: fatlton.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:01 mclareni
-* Fatmen
-*
-*
- PROGRAM FATLTON
-*----------------------------------------------------------------------*
-* *
-* Test FMLTON *
-* *
-*----------------------------------------------------------------------*
- PARAMETER (LURCOR=200000)
- COMMON/CRZT/IXSTOR,IXDIV,IFENCE(2),LEV,LEVIN,BLVECT(LURCOR)
- DIMENSION LQ(999),IQ(999),Q(999)
- EQUIVALENCE (IQ(1),Q(1),LQ(9)),(LQ(1),LEV)
-*
- COMMON /USRLNK/LUSRK1,LUSRBK,LUSRLS
-*
- COMMON /QUEST/IQUEST(100)
-*
- PARAMETER (LKEYFA=10)
- DIMENSION KEYS(LKEYFA)
- PARAMETER (MAXNOD=3)
- CHARACTER*8 CHNODE(MAXNOD)
-*
-*
-* Initialise ZEBRA
-*
- CALL MZEBRA(-3)
- CALL MZSTOR(IXSTOR,'/CRZT/','Q',IFENCE,LEV,BLVECT(1),BLVECT(1),
- + BLVECT(5000),BLVECT(LURCOR))
- CALL MZLOGL(IXSTOR,-3)
-
-*
-* *** Define user division and link area like:
-*
- CALL MZDIV (IXSTOR, IXDIV, 'USERS', 50000, LURCOR, 'L')
- CALL MZLINK (IXSTOR, '/USRLNK/', LUSRK1, LUSRLS, LUSRK1)
-*
-* Unit for RZ database
-*
- LUNRZ = 1
- LUNFZ = 2
-
-* read mode
- CALL FMINIT(IXSTOR,LUNRZ,LUNFZ,'//CERN/CNDIV',IRC)
- CALL FMLOGL(3)
-
- LOCCOD = 33
- CALL FMLTON(LOCCOD,MAXNOD,CHNODE,NNODES,' ',IRC)
- PRINT 9001,LOCCOD,NNODES,IRC
-9001 FORMAT(' FATNTOL. location code: ',I5,' NNODES: ',I5,
- + ' IRC = ',I10)
- PRINT *,(CHNODE(I),I=1,MIN(MAXNOD,NNODES))
- END
diff --git a/src/packlib/fatmen/examples/fatmod.F b/src/packlib/fatmen/examples/fatmod.F
deleted file mode 100644
index f8b5b0f..0000000
--- a/src/packlib/fatmen/examples/fatmod.F
+++ /dev/null
@@ -1,58 +0,0 @@
-*
-* $Id: fatmod.F,v 1.1.1.1 1996/03/07 15:17:59 mclareni Exp $
-*
-* $Log: fatmod.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:59 mclareni
-* Fatmen
-*
-*
- PROGRAM FATMOD
- PARAMETER (LURCOR=200000)
- COMMON/CRZT/IXSTOR,IXDIV,IFENCE(2),LEV,LEVIN,BLVECT(LURCOR)
- DIMENSION LQ(999),IQ(999),Q(999)
- EQUIVALENCE (IQ(1),Q(1),LQ(9)),(LQ(1),LEV)
-#include "fatmen/fatpara.inc"
-*
- COMMON /USRLNK/LUSRK1,LUSRBK,LUSRLS
-*
- COMMON /QUEST/IQUEST(100)
-*
- PARAMETER (LKEYFA=10)
- DIMENSION KEY(LKEYFA)
-*
-*
-* Initialise ZEBRA
-*
- CALL MZEBRA(-3)
- CALL MZSTOR(IXSTOR,'/CRZT/','Q',IFENCE,LEV,BLVECT(1),BLVECT(1),
- + BLVECT(5000),BLVECT(LURCOR))
- CALL MZLOGL(IXSTOR,-3)
-
-*
-* *** Define user division and link area like:
-*
- CALL MZDIV (IXSTOR, IXDIV, 'USERS', 50000, LURCOR, 'L')
- CALL MZLINK (IXSTOR, '/USRLNK/', LUSRK1, LUSRLS, LUSRK1)
-*
-* Unit for RZ database
-*
- LUNRZ = 1
- LUNFZ = 2
-
-* read mode
- CALL FMINIT(IXSTOR,LUNRZ,LUNFZ,'//CERN/CNDIV',IRC)
- CALL FMLOGL(3)
- PRINT *,' now FMGET'
- CALL FMGET('//CERN/CNDIV/JAMIE/IN',LBANK,KEYS,IRC)
- PRINT *,' now FMPUTC, FMGET RC=',IRC
- CALL FMPUTI(LBANK,133,MUSWFA,IRC)
- CALL FMPUTI(LBANK,256,MUSWFA+5,IRC)
- CALL FMPUTI(LBANK,3,MUSWFA+7,IRC)
- CALL FMPUTI(LBANK,13,MUSWFA+9,IRC)
- PRINT *,' now FMSHOW, FMPUT RC=',IRC
- CALL FMSHOW('//CERN/CNDIV/JAMIE/IN',LBANK,
- +KEYS,'A',IRC)
- PRINT *,' now FMMOD , FMSHOW RC=',IRC
- CALL FMMOD('//CERN/CNDIV/JAMIE/IN',LBANK,0,IRC)
- PRINT *,' FMMOD RC=',IRC
- END
diff --git a/src/packlib/fatmen/examples/fatnick.F b/src/packlib/fatmen/examples/fatnick.F
deleted file mode 100644
index 7495a68..0000000
--- a/src/packlib/fatmen/examples/fatnick.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: fatnick.F,v 1.1.1.1 1996/03/07 15:18:01 mclareni Exp $
-*
-* $Log: fatnick.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:01 mclareni
-* Fatmen
-*
-*
- character*80 chname,chdesc
-
- call fmnick(1,'fmdelphi.names','RAWD91',chname,chdesc,' ',irc)
-
- print *,chname(1:lenocc(chname))
- print *,chdesc(1:lenocc(chdesc))
-
- call fmnick(1,'fmdelphi.names','LEPT92/(10:20)',
- + chname,chdesc,' ',irc)
-
- print *,chname(1:lenocc(chname))
- print *,chdesc(1:lenocc(chdesc))
-
- call fmnick(1,'fmdelphi.names','RAWD91/17-77',
- + chname,chdesc,' ',irc)
-
- print *,chname(1:lenocc(chname))
- print *,chdesc(1:lenocc(chdesc))
-
- end
diff --git a/src/packlib/fatmen/examples/fatntol.F b/src/packlib/fatmen/examples/fatntol.F
deleted file mode 100644
index 49fd32b..0000000
--- a/src/packlib/fatmen/examples/fatntol.F
+++ /dev/null
@@ -1,56 +0,0 @@
-*
-* $Id: fatntol.F,v 1.1.1.1 1996/03/07 15:18:01 mclareni Exp $
-*
-* $Log: fatntol.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:01 mclareni
-* Fatmen
-*
-*
- PROGRAM FATNTOL
-*----------------------------------------------------------------------*
-* *
-* Test FMNTOL *
-* *
-*----------------------------------------------------------------------*
- PARAMETER (LURCOR=200000)
- COMMON/CRZT/IXSTOR,IXDIV,IFENCE(2),LEV,LEVIN,BLVECT(LURCOR)
- DIMENSION LQ(999),IQ(999),Q(999)
- EQUIVALENCE (IQ(1),Q(1),LQ(9)),(LQ(1),LEV)
-*
- COMMON /USRLNK/LUSRK1,LUSRBK,LUSRLS
-*
- COMMON /QUEST/IQUEST(100)
-*
- PARAMETER (LKEYFA=10)
- DIMENSION KEYS(LKEYFA)
- CHARACTER*8 CHNODE
-*
-*
-* Initialise ZEBRA
-*
- CALL MZEBRA(-3)
- CALL MZSTOR(IXSTOR,'/CRZT/','Q',IFENCE,LEV,BLVECT(1),BLVECT(1),
- + BLVECT(5000),BLVECT(LURCOR))
- CALL MZLOGL(IXSTOR,-3)
-
-*
-* *** Define user division and link area like:
-*
- CALL MZDIV (IXSTOR, IXDIV, 'USERS', 50000, LURCOR, 'L')
- CALL MZLINK (IXSTOR, '/USRLNK/', LUSRK1, LUSRLS, LUSRK1)
-*
-* Unit for RZ database
-*
- LUNRZ = 1
- LUNFZ = 2
-
-* read mode
- CALL FMINIT(IXSTOR,LUNRZ,LUNFZ,'//CERN/CNDIV',IRC)
- CALL FMLOGL(3)
-
- CHNODE = 'zfatal'
- CALL FMNTOL(CHNODE,LOCCOD,' ',IRC)
- PRINT 9001,CHNODE,LOCCOD,IRC
-9001 FORMAT(' FATNTOL. location code for ',A,' is ',I10,
- + ' IRC = ',I10)
- END
diff --git a/src/packlib/fatmen/examples/fatopen.F b/src/packlib/fatmen/examples/fatopen.F
deleted file mode 100644
index 082b24f..0000000
--- a/src/packlib/fatmen/examples/fatopen.F
+++ /dev/null
@@ -1,111 +0,0 @@
-*
-* $Id: fatopen.F,v 1.1.1.1 1996/03/07 15:17:59 mclareni Exp $
-*
-* $Log: fatopen.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:59 mclareni
-* Fatmen
-*
-*
- PROGRAM FATOPEN
- PARAMETER (LURCOR=200000)
- COMMON/CRZT/IXSTOR,IXDIV,IFENCE(2),LEV,LEVIN,BLVECT(LURCOR)
- DIMENSION LQ(999),IQ(999),Q(999)
- EQUIVALENCE (IQ(1),Q(1),LQ(9)),(LQ(1),LEV)
-*
- COMMON /USRLNK/LUSRK1,LUSRBK,LUSRLS
-*
- COMMON /QUEST/IQUEST(100)
-*
- PARAMETER (LKEYFA=10)
- DIMENSION KEY(LKEYFA)
-*
-*
-* Initialise ZEBRA
-*
- CALL MZEBRA(0)
- CALL MZSTOR(IXSTOR,'/CRZT/','Q',IFENCE,LEV,BLVECT(1),BLVECT(1),
- + BLVECT(5000),BLVECT(LURCOR))
- CALL MZLOGL(IXSTOR,-3)
-
-*
-* *** Define user division and link area like:
-*
- CALL MZDIV (IXSTOR, IXDIV, 'USERS', 50000, LURCOR, 'L')
- CALL MZLINK (IXSTOR, '/USRLNK/', LUSRK1, LUSRLS, LUSRK1)
-*
-* Unit for RZ database
-*
- LUNRZ = 1
- LUNFZ = 2
-
-* read mode
- CALL FMINIT(IXSTOR,LUNRZ,LUNFZ,'//CERN/OPAL',IRC)
- CALL FMLOGL(3)
- CALL FUOPEN
- END
-
- SUBROUTINE FUOPEN
-*
-** *** Data set bank mnemonics
-*
-* Keys
- PARAMETER ( MKSRFA= 1, MKFNFA= 2, MKCLFA=7, MKMTFA=8
- 1 ,MKLCFA= 9, MKNBFA=10, NKDSFA=10 )
-*
-** *** Bank offsets
-*
- PARAMETER ( MFQNFA= 1, MHSNFA= 65, MCPLFA= 67, MMTPFA= 68
- 1 ,MLOCFA= 69, MHSTFA= 70, MHOSFA= 74
- 2 ,MVSNFA= 77, MVIDFA= 79, MVIPFA= 81, MDENFA= 82
- 3 ,MVSQFA= 83, MFSQFA= 84, MSRDFA= 85, MERDFA= 86
- 4 ,MSBLFA= 87, MEBLFA= 88, MRFMFA= 89, MRLNFA= 90
- 5 ,MBLNFA= 91, MFLFFA= 92, MFUTFA= 93, MCRTFA= 94
- 6 ,MCTTFA= 95, MLATFA= 96, MCURFA= 97, MCIDFA= 99
- 7 ,MCNIFA=101, MCJIFA=103, MFPRFA=105, MSYWFA=106
- 8 ,MUSWFA=116, MUCMFA=126, NWDSFA=145
- 9 ,MFSZFA=MSYWFA)
-
-
- PARAMETER (LURCOR=200000)
- COMMON/CRZT/IXSTOR,IXDIV,IFENCE(2),LEV,LEVIN,BLVECT(LURCOR)
- DIMENSION LQ(999),IQ(999),Q(999)
- EQUIVALENCE (IQ(1),Q(1),LQ(9)),(LQ(1),LEV)
- PARAMETER (LKEYFA=10)
- DIMENSION KEYS(LKEYFA)
-*
- COMMON /USRLNK/LUSRK1,LUSRBK,LUSRLS
-*
- COMMON /QUEST/IQUEST(100)
- CHARACTER*8 DDNAME/'FT11F000'/
- CHARACTER*80 GENAME/
- +'//CERN/OPAL/DDST/PASS1/FYZ1/P25/R02354C01'/
- CHARACTER*4 CHOPT
-
- DIMENSION IUHEAD(1000)
- CALL FMLOGL(3)
- LG = LENOCC(GENAME)
-*
-* Open options: R - read
-* N - don't put DSN on stage command
-* V - verify file size (catalogue versus staged file)
-*
- CALL FMOPEN(GENAME(1:LG),
- +'11',LBANK,'RNV',IRC)
- PRINT *,LBANK
- IF(IRC.NE.0) THEN
- PRINT *,'Return code ',IRC,' from FMOPEN'
- GOTO 10
- ENDIF
-*
-* Close options: D - drop staging disk (or dismount tape, drop
-* mini-disk, deassign logical name etc.)
-* Z - MZDROP bank at LBANK
-*
- CALL FMCLOS(GENAME,
- + '11',LBANK,'DZ',IRC)
- IF(IRC.NE.0) PRINT *,'Return code ',IRC,' from FMCLOS'
-1 CONTINUE
-10 CONTINUE
-*
- END
-
diff --git a/src/packlib/fatmen/examples/fatouch.F b/src/packlib/fatmen/examples/fatouch.F
deleted file mode 100644
index 088ab92..0000000
--- a/src/packlib/fatmen/examples/fatouch.F
+++ /dev/null
@@ -1,131 +0,0 @@
-*
-* $Id: fatouch.F,v 1.1.1.1 1996/03/07 15:18:00 mclareni Exp $
-*
-* $Log: fatouch.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:00 mclareni
-* Fatmen
-*
-*
-*------------------------------------------------------------------------
-*
-* Program FATOUCH - 'touch' all files in all directories in file
-* read from unit 3.
-* FATMEN is initialised automatically after the
-* first name is read in.
-* +USE,TOUCHF. if the names read in a full generic names
-* Default is to assume directory names, in which case all files
-* in the specified directories are touched.
-*------------------------------------------------------------------------
- PARAMETER (LURCOR=200000)
- COMMON/CRZT/IXSTOR,IXDIV,IFENCE(2),LEV,LEVIN,BLVECT(LURCOR)
- DIMENSION LQ(999),IQ(999),Q(999)
- EQUIVALENCE (IQ(1),Q(1),LQ(9)),(LQ(1),LEV)
-*
- COMMON /USRLNK/LUSRK1,LUSRBK,LUSRLS
-*
-#include "fatmen/quest.inc"
-#include "fatmen/fatpara.inc"
-#include "fatmen/fmnkeys.inc"
-*
- PARAMETER (MAXFIL=2000)
- DIMENSION KEYS(LKEYFA,MAXFIL)
- CHARACTER*255 FILES(MAXFIL)
- CHARACTER*80 GENAM
-*
-*
-* Initialise ZEBRA
-*
- CALL MZEBRA(-3)
- CALL MZSTOR(IXSTOR,'/CRZT/','Q',IFENCE,LEV,BLVECT(1),BLVECT(1),
- + BLVECT(5000),BLVECT(LURCOR))
- CALL MZLOGL(IXSTOR,-3)
-
-*
-* *** Define user division and link area like:
-*
- CALL MZDIV (IXSTOR, IXDIV, 'USERS', 50000, LURCOR, 'L')
- CALL MZLINK (IXSTOR, '/USRLNK/', LUSRK1, LUSRLS, LUSRK1)
-*
-* Units for FATMEN RZ/FZ files
-*
- LUNRZ = 1
- LUNFZ = 2
-*
-* Open input file
-*
- NDIRS = 0
- NFILS = 0
-#if defined(CERNLIB_IBM)
- OPEN(3,FORM='UNFORMATTED',STATUS='OLD')
-#endif
-#if !defined(CERNLIB_IBM)
- OPEN(3,FORM='FORMATTED',STATUS='OLD')
-#endif
-1 CONTINUE
-#if defined(CERNLIB_IBM)
- READ(3,NUM=LGN,END=99) GENAM
-#endif
-#if !defined(CERNLIB_IBM)
- READ(3,'(A)',END=99) GENAM
- LGN = LENOCC(GENAM)
-#endif
- IF(NDIRS.EQ.0) THEN
-*
-* Initialise FATMEN
-*
- LEND = INDEX(GENAM(3:LGN),'/') + 2
- LEND = LEND + INDEX(GENAM(LEND+1:LGN),'/') -1
- CALL FMINIT(IXSTOR,LUNRZ,LUNFZ,GENAM(1:LEND),IRC)
- CALL FMLOGL(0)
- ENDIF
- NDIRS = NDIRS + 1
- PRINT *,'Processing ',GENAM(1:LGN)
-*
-* Get list of file names
-*
- ICONT = 0
-20 CONTINUE
-#if defined(CERNLIB_TOUCHF)
-*
-* To touch individual files
-*
- CALL FMLFIL(GENAM(1:LGN),
-#endif
-#if !defined(CERNLIB_TOUCHF)
-*
-* To touch directories (i.e. all files in the specified dirs)
-*
- CALL FMLFIL(GENAM(1:LGN)//'/*',
-#endif
- +FILES,KEYS,NFOUND,MAXFIL,ICONT,IRC)
-
- NFILS = NFILS + NFOUND
- DO 10 I=1,NFOUND
- LENF = LENOCC(FILES(I))
- LBANK1 = 0
- PRINT 9001,FILES(I)(1:LENF),KEYS(1,I)
- CALL FMGETK(FILES(I)(1:LENF),LBANK,KEYS(1,I),IRC)
- CALL FMMOD(FILES(I)(1:LENF),LBANK,0,IRC)
- CALL MZDROP(IXSTOR,LBANK,' ')
-9001 FORMAT(1X,A,I10)
-10 CONTINUE
- IF(ICONT.NE.0) GOTO 20
-*
-* Any more directories?
-*
- GOTO 1
-99 CLOSE(3)
-#if defined(CERNLIB_TOUCHF)
- PRINT *,'Processed ',NDIRS,' generic names and ',
- + NFILS,' FATMEN entries'
-#endif
-#if !defined(CERNLIB_TOUCHF)
- PRINT *,'Processed ',NDIRS,' directory names and ',
- + NFILS,' file names'
-#endif
-*
-* Terminate cleanly
-*
- CALL FMEND(IRC)
-
- END
diff --git a/src/packlib/fatmen/examples/fatpeek.F b/src/packlib/fatmen/examples/fatpeek.F
deleted file mode 100644
index 51d421f..0000000
--- a/src/packlib/fatmen/examples/fatpeek.F
+++ /dev/null
@@ -1,38 +0,0 @@
-*
-* $Id: fatpeek.F,v 1.1.1.1 1996/03/07 15:18:00 mclareni Exp $
-*
-* $Log: fatpeek.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:00 mclareni
-* Fatmen
-*
-*
- PROGRAM FATPEEK
-*
- CHARACTER*255 GENAME
-#include "fatmen/fatpara.inc"
-#include "fatmen/fmnkeys.inc"
- COMMON /USRLNK/LUSRK1,LUSRBK,LADDBK,LUSRLS
- DIMENSION KEYS(LKEYFA)
- DIMENSION NFAT(NWDSFA)
-*
-* Initialise FATMEN & Zebra...
-*
- CALL FMSTRT(1,2,'//CERN/CNDIV',IRC)
- CALL FMLOGL(0)
-*
- GENAME = '//CERN/CNDIV/JAMIE/ZFATAL/IN'
- DO 10 I = 1,3
- CALL FMPEEK(GENAME,NFAT,'N',IRC)
- PRINT *,'Return code from FMPEEK = ',IRC
-*
-* Necessary with some compilers, otherwise loop is executed
-* only once!
-*
- KEYS(1) = I
- CALL FMSHOW(GENAME,-1,KEYS,'A',IRC)
-10 CONTINUE
-*
- CALL FMEND(IRC)
- PRINT *,'Return code ',IRC,' from FMEND'
-*
- END
diff --git a/src/packlib/fatmen/examples/fatplot.F b/src/packlib/fatmen/examples/fatplot.F
deleted file mode 100644
index 39e52d0..0000000
--- a/src/packlib/fatmen/examples/fatplot.F
+++ /dev/null
@@ -1,132 +0,0 @@
-*
-* $Id: fatplot.F,v 1.1.1.1 1996/03/07 15:18:00 mclareni Exp $
-*
-* $Log: fatplot.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:00 mclareni
-* Fatmen
-*
-*
-*=======================================================================
-*
-* Example of using HBOOK to plot various FATMEN catalogue values.
-* This program histograms the file size, number of days since last
-* access, medium type etc.
-*=======================================================================
- PARAMETER (LURCOR=200000)
- COMMON/CRZT/IXSTOR,IXDIV,IFENCE(2),LEV,LEVIN,BLVECT(LURCOR)
- DIMENSION LQ(999),IQ(999),Q(999)
- EQUIVALENCE (IQ(1),Q(1),LQ(9)),(LQ(1),LEV)
-*
- COMMON /USRLNK/LUSRK1,LUSRBK,LUSRLS
-*
- COMMON /QUEST/IQUEST(100)
- CHARACTER*8 THRONG
-#include "fatmen/fatpara.inc"
-#include "fatmen/fatbug.inc"
- EXTERNAL UROUT
-*
-*
-* Initialise ZEBRA
-*
- CALL MZEBRA(-3)
- CALL MZSTOR(IXSTOR,'/CRZT/','Q',IFENCE,LEV,BLVECT(1),BLVECT(1),
- + BLVECT(5000),BLVECT(LURCOR))
- CALL MZLOGL(IXSTOR,-3)
-
-*
-* *** Define user division and link area like:
-*
- CALL MZDIV (IXSTOR, IXDIV, 'USERS', 50000, LURCOR, 'L')
- CALL MZLINK (IXSTOR, '/USRLNK/', LUSRK1, LUSRLS, LUSRK1)
-*
-* Units for FATMEN RZ/FZ files
-*
- LUNRZ = 1
- LUNFZ = 2
- CALL GETENVF('THRONG',THRONG)
- LTH = LENOCC(THRONG)
-*
-* Initialise FATMEN
-*
- CALL FMINIT(IXSTOR,LUNRZ,LUNFZ,'//CERN/'//THRONG(1:LTH),IRC)
- CALL FMLOGL(0)
-*
-* Initialise HBOOK
-*
- CALL HLIMIT(-20000)
-*
-* Book histograms
-*
- CALL HBOOK1(1,'File Size (MB)',50,0.,200.,0.)
- CALL HBOOK1(2,'Number of accesses',50,0.,50.,0.)
- CALL HBOOK1(3,'Number days since last access',50,0.,300.,0.)
- CALL HBOOK1(4,'Number days since catalogued',50,0.,300.,0.)
- CALL HBOOK1(5,'Number days since created',50,0.,300.,0.)
- CALL HBOOK1(6,'Medium',5,0.,5.,0.)
- CALL HIDOPT(0,'BLAC')
-*
-* Loop over all files
-*
- CALL FMLOOP('//CERN/*/*',-1,UROUT,IRC)
-*
-* Print and store the histograms
-*
- CALL HPRINT(0)
- CALL HRPUT(0,'FATTUPLE.'//THRONG(1:LTH),'N')
-*
-* Terminate cleanly
-*
- CALL FMEND(IRC)
- END
-
- SUBROUTINE UROUT(PATH,KEYS,IRC)
-*
-* Start of FATMEN sequence FATPARA
-*
-** *** Data set bank mnemonics
-*
-* Keys
- PARAMETER ( MKSRFA= 1, MKFNFA= 2, MKCLFA=7, MKMTFA=8
- 1 ,MKLCFA= 9, MKNBFA=10, NKDSFA=10 )
-*
-** *** Bank offsets
-*
- PARAMETER ( MFQNFA= 1, MHSNFA= 65, MCPLFA= 67, MMTPFA= 68
- 1 ,MLOCFA= 69, MHSTFA= 70, MHOSFA= 74
- 2 ,MVSNFA= 77, MVIDFA= 79, MVIPFA= 81, MDENFA= 82
- 3 ,MVSQFA= 83, MFSQFA= 84, MSRDFA= 85, MERDFA= 86
- 4 ,MSBLFA= 87, MEBLFA= 88, MRFMFA= 89, MRLNFA= 90
- 5 ,MBLNFA= 91, MFLFFA= 92, MFUTFA= 93, MCRTFA= 94
- 6 ,MCTTFA= 95, MLATFA= 96, MCURFA= 97, MCIDFA= 99
- 7 ,MCNIFA=101, MCJIFA=103, MFPRFA=105, MSYWFA=106
- 8 ,MUSWFA=116, MUCMFA=126, NWDSFA=145
- 9 ,MFSZFA=MSYWFA,MUSCFA=MSYWFA+1)
-
-* End of FATMEN sequence FATPARA
- PARAMETER (LURCOR=200000)
- COMMON/CRZT/IXSTOR,IXDIV,IFENCE(2),LEV,LEVIN,BLVECT(LURCOR)
- DIMENSION LQ(999),IQ(999),Q(999)
- EQUIVALENCE (IQ(1),Q(1),LQ(9)),(LQ(1),LEV)
- CHARACTER*(*) PATH
- PARAMETER (LKEYFA=10)
- DIMENSION KEYS(LKEYFA)
- DIMENSION NDAYS(3)
- COMMON/QUEST/IQUEST(100)
- IRC = 0
- LBANK = 0
- LP = LENOCC(PATH)
- CALL FMGETK(PATH(1:LP),LBANK,KEYS,IRC)
-*
-* Fill histograms
-*
- IF(IQ(LBANK+MFSZFA).NE.0)
- +CALL HFILL(1,FLOAT(IQ(LBANK+MFSZFA)),0.,1.)
- IF(IQ(LBANK+MUSCFA).NE.0)
- +CALL HFILL(2,FLOAT(IQ(LBANK+MUSCFA)),0.,1.)
- CALL FMDAYS(PATH(1:LP),LBANK,KEYS,NDAYS,' ',IRC)
- CALL HFILL(3,FLOAT(NDAYS(3)),0.,1.)
- CALL HFILL(4,FLOAT(NDAYS(2)),0.,1.)
- CALL HFILL(5,FLOAT(NDAYS(1)),0.,1.)
- CALL HFILL(6,FLOAT(IQ(LBANK+MMTPFA)),0.,1.)
- CALL MZDROP(IXSTOR,LBANK,' ')
- END
diff --git a/src/packlib/fatmen/examples/fatpoke.F b/src/packlib/fatmen/examples/fatpoke.F
deleted file mode 100644
index 6371fbc..0000000
--- a/src/packlib/fatmen/examples/fatpoke.F
+++ /dev/null
@@ -1,80 +0,0 @@
-*
-* $Id: fatpoke.F,v 1.1.1.1 1996/03/07 15:18:00 mclareni Exp $
-*
-* $Log: fatpoke.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:00 mclareni
-* Fatmen
-*
-*
-*
-* Example program to update the file creation time
-*
-* The book-keeping file is included in DECK=BOOK,T=DATA.
-*
- CHARACTER*133 CHLINE
- CHARACTER*255 GENAM,CHFILS
- CHARACTER*23 CHDATE
- CHARACTER*4 CHRUN
- PARAMETER (LKEYFA=10)
- DIMENSION KEYS(LKEYFA)
- PARAMETER (NWDSFA=145)
- DIMENSION IVECT(NWDSFA)
- PARAMETER (MCRTFA=94)
- LUNRZ = 1
- LUNFZ = 2
-*
-* Initialise FATMEN
-*
- CALL FMSTRT(LUNRZ,LUNFZ,'//CERN/SMC',IRC)
-*
-* Open book-keeping file
-*
- OPEN(10,ACCESS='SEQUENTIAL',FORM='FORMATTED',STATUS='OLD')
-*
-* Process each record in the book-keeping file
-*
-10 CONTINUE
- READ(10,'(A)',END=99) CHLINE
-
- CHRUN = CHLINE(8:11)
- CHDATE = CHLINE(13:35)
- CALL FMPKVX(CHDATE,ID,IT,IP,IRC)
-*
-* Find entries corresponding to this run
-*
- GENAM = '//CERN/SMC/P2D92/*/R' // CHRUN
-*
-* Assume that there will only be one match
-*
- MAXFIL = 1
- JCONT = 0
-
- CALL FMLFIL(GENAM,CHFILS,KEYS,NFOUND,MAXFIL,JCONT,IRC)
-*
-* Get the entry for this file
-*
- CALL FMPEEK(CHFILS,IVECT,'A',IRC)
-*
-* Display the entry
-*
- CALL FMSHOW(CHFILS,-1,KEYS,'GT',IRC)
-*
-* Update the creation time
-*
- CALL FMPUTI(-1,IP,MCRTFA,IRC)
-*
-* Display the entry
-*
- CALL FMSHOW(CHFILS,-1,KEYS,'GT',IRC)
-*
-* and stuff it back
-*
-*-----CALL FMPOKE(CHFILS,IVECT,'NR',IRC)
-
- GOTO 10
-
-99 CONTINUE
-
- CLOSE(10)
-
- END
diff --git a/src/packlib/fatmen/examples/fatrrob.F b/src/packlib/fatmen/examples/fatrrob.F
deleted file mode 100644
index 5bbb1d9..0000000
--- a/src/packlib/fatmen/examples/fatrrob.F
+++ /dev/null
@@ -1,141 +0,0 @@
-*
-* $Id: fatrrob.F,v 1.1.1.1 1996/03/07 15:18:00 mclareni Exp $
-*
-* $Log: fatrrob.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:00 mclareni
-* Fatmen
-*
-*
-*=======================================================================
-* Delete all entries in a subtree for DELPHI
-* which point to a tape in the robot.
-* The entries are deleted, whereas the tapes themselves
-* are software write-enabled and moved to a pool XX_FREE
-*=======================================================================
- PARAMETER (LURCOR=200000)
- COMMON/CRZT/IXSTOR,IXDIV,IFENCE(2),LEV,LEVIN,BLVECT(LURCOR)
- DIMENSION LQ(999),IQ(999),Q(999)
- EQUIVALENCE (IQ(1),Q(1),LQ(9)),(LQ(1),LEV)
-*
- COMMON /USRLNK/LUSRK1,LUSRBK,LUSRLS
-*
- COMMON /QUEST/IQUEST(100)
-*
-* Start of FATMEN sequence FATPARA
-*
-** *** Data set bank mnemonics
-*
-* Keys
- PARAMETER ( MKSRFA= 1, MKFNFA= 2, MKCLFA=7, MKMTFA=8
- 1 ,MKLCFA= 9, MKNBFA=10, NKDSFA=10 )
-*
-** *** Bank offsets
-*
- PARAMETER ( MFQNFA= 1, MHSNFA= 65, MCPLFA= 67, MMTPFA= 68
- 1 ,MLOCFA= 69, MHSTFA= 70, MHOSFA= 74
- 2 ,MVSNFA= 77, MVIDFA= 79, MVIPFA= 81, MDENFA= 82
- 3 ,MVSQFA= 83, MFSQFA= 84, MSRDFA= 85, MERDFA= 86
- 4 ,MSBLFA= 87, MEBLFA= 88, MRFMFA= 89, MRLNFA= 90
- 5 ,MBLNFA= 91, MFLFFA= 92, MFUTFA= 93, MCRTFA= 94
- 6 ,MCTTFA= 95, MLATFA= 96, MCURFA= 97, MCIDFA= 99
- 7 ,MCNIFA=101, MCJIFA=103, MFPRFA=105, MSYWFA=106
- 8 ,MUSWFA=116, MUCMFA=126, NWDSFA=145
- 9 ,MFSZFA=MSYWFA,MUSCFA=MSYWFA+1)
-
-* End of FATMEN sequence FATPARA
- CHARACTER*6 DENS
- CHARACTER*8 LIB
- CHARACTER*4 LABTYP
- CHARACTER*1 MNTTYP
- CHARACTER*8 MODEL
- CHARACTER*7 ROBMAN(2)
- DATA ROBMAN(1)/'-Robot '/,ROBMAN(2)/'-Manual'/
- PARAMETER (LKEYFA=10)
- PARAMETER (MAXFIL=3000)
- DIMENSION KEYS(LKEYFA,MAXFIL)
- CHARACTER*255 FILES(MAXFIL)
- CHARACTER*8 THRONG
- CHARACTER*255 TOPDIR
- CHARACTER*26 CHOPT
- CHARACTER*8 DSN
-*
-*
-* Initialise ZEBRA
-*
- CALL MZEBRA(-3)
- CALL MZSTOR(IXSTOR,'/CRZT/','Q',IFENCE,LEV,BLVECT(1),BLVECT(1),
- + BLVECT(5000),BLVECT(LURCOR))
- CALL MZLOGL(IXSTOR,-3)
-
-*
-* *** Define user division and link area like:
-*
- CALL MZDIV (IXSTOR, IXDIV, 'USERS', 50000, LURCOR, 'L')
- CALL MZLINK (IXSTOR, '/USRLNK/', LUSRK1, LUSRLS, LUSRK1)
-*
-* Units for FATMEN RZ/FZ files
-*
- LUNRZ = 1
- LUNFZ = 2
-*
-* Initialise FATMEN
-*
- CALL FMINIT(IXSTOR,LUNRZ,LUNFZ,'//CERN/delphi',IRC)
- CALL FMLOGL(1)
-*
- DATA MAXUPD,NGROUP / 2000,25 /
- CALL FMUPDT(MAXUPD,NGROUP,0,IRC)
- IF (IRC.NE.0) STOP 9
-*
-* Get list of file names
-*
- JCONT = 0
-1 CONTINUE
- CALL FMLFIL('//CERN/DELPHI/P01_*/RAWD/NONE/Y90V00/E*/L*/*',
- +FILES,KEYS,NFOUND,MAXFIL,JCONT,IRC)
- IF(IRC.EQ.-1) THEN
- JCONT = 1
- ELSE
- JCONT = 0
- ENDIF
-
- PRINT *,NFOUND,' files found'
-
- DO 10 I=1,NFOUND
- LENF = LENOCC(FILES(I))
- PRINT *,'Processing ',FILES(I)(1:LENF)
- LBANK = 0
- CALL FMQMED(FILES(I)(1:LENF),LBANK,KEYS(1,I),IMEDIA,IROBOT,IRC)
- IF(IROBOT.NE.1) GOTO 10
- CALL FMSHOW(FILES(I)(1:LENF),LBANK,KEYS(1,I),'MG',IRC)
- GOTO 10
- CALL FMULOK(FILES(I)(1:LENF),LBANK,KEYS(1,I),' ',IRC)
- IF(IRC.NE.0) THEN
- PRINT *,'Return code ',IRC,' from FMULOK for ',
- + FILES(I)(1:LENF)
- GOTO 10
- ENDIF
- CALL FMPOOL(FILES(I)(1:LENF),LBANK,KEYS(1,I),
- + 'XX_FREE',' ',IRC)
- IF(IRC.NE.0) THEN
- PRINT *,'Return code ',IRC,' from FMPOOL for ',
- + FILES(I)(1:LENF)
- GOTO 10
- ENDIF
- CALL FMRM(FILES(I)(1:LENF),LBANK,KEYS(1,I),IRC)
- IF(IRC.NE.0) THEN
- PRINT *,'Return code ',IRC,' from FMRM for ',
- + FILES(I)(1:LENF)
- GOTO 10
- ENDIF
-10 CONTINUE
- IF(JCONT.NE.0) GOTO 1
-*
- CALL FMUPDT(MAXUPD,NGROUP,1,IRC)
-*
-* Terminate cleanly
-*
- CALL FMEND(IRC)
-
- END
-
diff --git a/src/packlib/fatmen/examples/fatscan.F b/src/packlib/fatmen/examples/fatscan.F
deleted file mode 100644
index 3329094..0000000
--- a/src/packlib/fatmen/examples/fatscan.F
+++ /dev/null
@@ -1,97 +0,0 @@
-*
-* $Id: fatscan.F,v 1.1.1.1 1996/03/07 15:17:59 mclareni Exp $
-*
-* $Log: fatscan.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:59 mclareni
-* Fatmen
-*
-*
- PARAMETER (LURCOR=200000)
- COMMON/CRZT/IXSTOR,IXDIV,IFENCE(2),LEV,LEVIN,BLVECT(LURCOR)
- DIMENSION LQ(999),IQ(999),Q(999)
- EQUIVALENCE (IQ(1),Q(1),LQ(9)),(LQ(1),LEV)
-*
- COMMON /USRLNK/LUSRK1,LUSRBK,LUSRLS
-*
- COMMON /QUEST/IQUEST(100)
- PARAMETER (MAXDIR=100)
- CHARACTER*255 CHDIR(MAXDIR)
-*
-* Start of FATMEN sequence FATPARA
-*
-** *** Data set bank mnemonics
-*
-* Keys
- PARAMETER ( MKSRFA= 1, MKFNFA= 2, MKCLFA=7, MKMTFA=8
- 1 ,MKLCFA= 9, MKNBFA=10, NKDSFA=10 )
-*
-** *** Bank offsets
-*
- PARAMETER ( MFQNFA= 1, MHSNFA= 65, MCPLFA= 67, MMTPFA= 68
- 1 ,MLOCFA= 69, MHSTFA= 70, MHOSFA= 74
- 2 ,MVSNFA= 77, MVIDFA= 79, MVIPFA= 81, MDENFA= 82
- 3 ,MVSQFA= 83, MFSQFA= 84, MSRDFA= 85, MERDFA= 86
- 4 ,MSBLFA= 87, MEBLFA= 88, MRFMFA= 89, MRLNFA= 90
- 5 ,MBLNFA= 91, MFLFFA= 92, MFUTFA= 93, MCRTFA= 94
- 6 ,MCTTFA= 95, MLATFA= 96, MCURFA= 97, MCIDFA= 99
- 7 ,MCNIFA=101, MCJIFA=103, MFPRFA=105, MSYWFA=106
- 8 ,MUSWFA=116, MUCMFA=126, NWDSFA=145
- 9 ,MFSZFA=MSYWFA,MUSCFA=MSYWFA+1)
-
-* End of FATMEN sequence FATPARA
-*KEEP,FATBUG.
- COMMON /FATUSE/ IDEBFA, IDIVFA, IKDRFA, KOFSFA, KOFUFA, LBFXFA
- + , LSAVFA, LTOPFA, LBBKFA, LBGNFA, LTDSFA, LBDSFA
- + , LPRTFA, NTOPFA, LUFZFA, IOUPFA, IOBKFA, IODSFA
- + , LLNLFA, LLNHFA
-*KEND.
- CHARACTER*8 DSN
- EXTERNAL UROUT
-*
-*
-* Initialise ZEBRA
-*
- CALL MZEBRA(-3)
- CALL MZSTOR(IXSTOR,'/CRZT/','Q',IFENCE,LEV,BLVECT(1),BLVECT(1),
- + BLVECT(5000),BLVECT(LURCOR))
- CALL MZLOGL(IXSTOR,-3)
-
-*
-* *** Define user division and link area like:
-*
- CALL MZDIV (IXSTOR, IXDIV, 'USERS', 50000, LURCOR, 'L')
- CALL MZLINK (IXSTOR, '/USRLNK/', LUSRK1, LUSRLS, LUSRK1)
-*
-* Units for FATMEN RZ/FZ files
-*
- LUNRZ = 1
- LUNFZ = 2
-*
-* Initialise FATMEN
-*
- CALL FMINIT(IXSTOR,LUNRZ,LUNFZ,'//CERN/CNDIV',IRC)
- CALL FMLOGL(3)
-
- CALL FMSCAN('//CERN/CNDIV/*',1,UROUT,IRC)
- END
-
- SUBROUTINE UROUT(PATH,IRC)
- CHARACTER*(*) PATH
- COMMON/QUEST/IQUEST(100)
- PRINT *,'<< ',PATH(1:LENOCC(PATH))
- CALL RZCDIR(' ','P')
- IRC = 0
- PRINT *,'Number of subdirectories = ',IQUEST(12)
- PRINT *,'Number of elements in initial path name = ',IQUEST(10)
- PRINT *,'Number of elements in path name = ',IQUEST(13)
- PRINT *,'Number of keys = ',IQUEST(14)
- PRINT *,'Number of elements per key = ',IQUEST(15)
-
-*
-* Skip directories at same level as initial path
-*
- if(iquest(13).le.iquest(10)) return
-*
-* Process current directory...
-*
- END
diff --git a/src/packlib/fatmen/examples/fatscan2.F b/src/packlib/fatmen/examples/fatscan2.F
deleted file mode 100644
index 30952d7..0000000
--- a/src/packlib/fatmen/examples/fatscan2.F
+++ /dev/null
@@ -1,117 +0,0 @@
-*
-* $Id: fatscan2.F,v 1.1.1.1 1996/03/07 15:18:00 mclareni Exp $
-*
-* $Log: fatscan2.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:00 mclareni
-* Fatmen
-*
-*
-*------------------------------------------------------------------------
-*
-* Print all directory names & # files in each directory
-* Useful for comparing two FATMEN catalogues for missing
-* entries. The missing entries can be added using the
-* FATOUCH program.
-*------------------------------------------------------------------------
- PARAMETER (LURCOR=200000)
- COMMON/CRZT/IXSTOR,IXDIV,IFENCE(2),LEV,LEVIN,BLVECT(LURCOR)
- DIMENSION LQ(999),IQ(999),Q(999)
- EQUIVALENCE (IQ(1),Q(1),LQ(9)),(LQ(1),LEV)
-*
- COMMON /USRLNK/LUSRK1,LUSRBK,LUSRLS
-
- CHARACTER*255 CHFILE
-*
-#include "fatmen/quest.inc"
-#include "fatmen/fatpara.inc"
-#include "fatmen/fatbug.inc"
-#include "fatmen/slate.inc"
-*
- PARAMETER (MAXDIR=100)
- CHARACTER*255 CHDIR(MAXDIR)
- CHARACTER*8 DSN
- CHARACTER*16 CHSYS,CHGRP
- EXTERNAL UROUT
-*
-*
-* Initialise ZEBRA
-*
- CALL MZEBRA(-3)
- CALL MZSTOR(IXSTOR,'/CRZT/','Q',IFENCE,LEV,BLVECT(1),BLVECT(1),
- + BLVECT(5000),BLVECT(LURCOR))
- CALL MZLOGL(IXSTOR,-3)
-
-*
-* *** Define user division and link area like:
-*
- CALL MZDIV (IXSTOR, IXDIV, 'USERS', 50000, LURCOR, 'L')
- CALL MZLINK (IXSTOR, '/USRLNK/', LUSRK1, LUSRLS, LUSRK1)
-*
-* Units for FATMEN RZ/FZ files
-*
- LUNRZ = 1
- LUNFZ = 2
-*
-* Get FATMEN system & group names
-*
- CALL GETENVF('FATSYS',CHSYS)
- IF(IS(1).EQ.0) THEN
- PRINT *,'FATMEN system defaulted to CERN'
- CHSYS = 'CERN'
- LSYS = 4
- ELSE
- LSYS = IS(1)
- PRINT *,'FATMEN system: ',CHSYS(1:LSYS)
- ENDIF
-
- CALL GETENVF('FATGRP',CHGRP)
- IF(IS(1).EQ.0) THEN
- PRINT *,'FATMEN group not defined'
- STOP
- ELSE
- LGRP = IS(1)
- PRINT *,'FATMEN group: ',CHGRP(1:LGRP)
- ENDIF
-*
-* Initialise FATMEN
-*
- CALL FMINIT(IXSTOR,LUNRZ,LUNFZ,
- + '//'//CHSYS(1:LSYS)//'/'//CHGRP(1:LGRP),IRC)
-*
-* Log file
-*
- CHFILE = CHGRP(1:LGRP)//'.SCANLOG'
-
- LFILE = LGRP + 8
-
- CALL CUTOL(CHFILE(1:LFILE))
-*
-* Remove existing log file, if any
-*
- CALL UNLINKF(CHFILE(1:LFILE))
-*
-* Open log file
-*
- CALL FAFILE(3,CHFILE(1:LFILE),IRC)
- IF(IRC.NE.0) THEN
- PRINT *,'Cannot open log file'
- STOP
- ELSE
- PRINT *,'Logfile is ',CHGRP(1:LGRP)//'.SCANLOG'
- ENDIF
-
- CALL FMSCAN('//'//CHSYS(1:LSYS)//'/'//CHGRP(1:LGRP)//'/*',
- + 99,UROUT,IRC)
-*
-* Close log file
-*
- CLOSE(3)
- END
-
- SUBROUTINE UROUT(PATH,IRC)
- CHARACTER*(*) PATH
- COMMON/QUEST/IQUEST(100)
- WRITE(3,9001) PATH(1:LENOCC(PATH)),IQUEST(14)
-9001 FORMAT(A64,I5)
- IRC = 0
- END
diff --git a/src/packlib/fatmen/examples/fatselk.F b/src/packlib/fatmen/examples/fatselk.F
deleted file mode 100644
index a8c4051..0000000
--- a/src/packlib/fatmen/examples/fatselk.F
+++ /dev/null
@@ -1,106 +0,0 @@
-*
-* $Id: fatselk.F,v 1.1.1.1 1996/03/07 15:18:00 mclareni Exp $
-*
-* $Log: fatselk.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:00 mclareni
-* Fatmen
-*
-*
- PARAMETER (LURCOR=200000)
- COMMON/CRZT/IXSTOR,IXDIV,IFENCE(2),LEV,LEVIN,BLVECT(LURCOR)
- DIMENSION LQ(999),IQ(999),Q(999)
- EQUIVALENCE (IQ(1),Q(1),LQ(9)),(LQ(1),LEV)
-*
- COMMON /USRLNK/LUSRK1,LUSRBK,LUSRLS
-*
- COMMON /QUEST/IQUEST(100)
-*
-* Start of FATMEN sequence FATPARA
-*
-** *** Data set bank mnemonics
-*
-* Keys
- PARAMETER ( MKSRFA= 1, MKFNFA= 2, MKCLFA=7, MKMTFA=8
- 1 ,MKLCFA= 9, MKNBFA=10, NKDSFA=10 )
-*
-** *** Bank offsets
-*
- PARAMETER ( MFQNFA= 1, MHSNFA= 65, MCPLFA= 67, MMTPFA= 68
- 1 ,MLOCFA= 69, MHSTFA= 70, MHOSFA= 74
- 2 ,MVSNFA= 77, MVIDFA= 79, MVIPFA= 81, MDENFA= 82
- 3 ,MVSQFA= 83, MFSQFA= 84, MSRDFA= 85, MERDFA= 86
- 4 ,MSBLFA= 87, MEBLFA= 88, MRFMFA= 89, MRLNFA= 90
- 5 ,MBLNFA= 91, MFLFFA= 92, MFUTFA= 93, MCRTFA= 94
- 6 ,MCTTFA= 95, MLATFA= 96, MCURFA= 97, MCIDFA= 99
- 7 ,MCNIFA=101, MCJIFA=103, MFPRFA=105, MSYWFA=106
- 8 ,MUSWFA=116, MUCMFA=126, NWDSFA=145
- 9 ,MFSZFA=MSYWFA,MUSCFA=MSYWFA+1)
-
-* End of FATMEN sequence FATPARA
- CHARACTER*4 FFORM
- CHARACTER*6 VID
- CHARACTER*6 DENS
- CHARACTER*8 LIB
- CHARACTER*4 LABTYP
- CHARACTER*1 MNTTYP
- CHARACTER*8 MODEL
- CHARACTER*7 ROBMAN(2)
- DATA ROBMAN(1)/'-Robot '/,ROBMAN(2)/'-Manual'/
- PARAMETER (LKEYFA=10)
- PARAMETER (MAXFIL=10)
- DIMENSION KEYS(LKEYFA,MAXFIL)
- DIMENSION KEYSIN(LKEYFA),KEYSOU(LKEYFA,MAXFIL)
- CHARACTER*80 GENAM
- CHARACTER*8 THRONG
- CHARACTER*255 TOPDIR
- CHARACTER*26 CHOPT
- CHARACTER*8 DSN
-*
-*
-* Initialise ZEBRA
-*
- CALL MZEBRA(-3)
- CALL MZSTOR(IXSTOR,'/CRZT/','Q',IFENCE,LEV,BLVECT(1),BLVECT(1),
- + BLVECT(5000),BLVECT(LURCOR))
- CALL MZLOGL(IXSTOR,-3)
-
-*
-* *** Define user division and link area like:
-*
- CALL MZDIV (IXSTOR, IXDIV, 'USERS', 50000, LURCOR, 'L')
- CALL MZLINK (IXSTOR, '/USRLNK/', LUSRK1, LUSRLS, LUSRK1)
-*
-* Units for FATMEN RZ/FZ files
-*
- LUNRZ = 1
- LUNFZ = 2
-*
-* Initialise FATMEN
-*
- CALL FMINIT(IXSTOR,LUNRZ,LUNFZ,'//CERN/OPAL',IRC)
- CALL FMLOGL(3)
-*
-* Get list of file names
-*
- KEYSIN(MKMTFA) = -1
- KEYSIN(MKLCFA) = -1
- KEYSIN(MKCLFA) = -1
- GENAM = '//CERN/OPAL/DDST/PASS1/FYZ1/P25/R02354C01'
- LG = LENOCC(GENAM)
- CALL FMSELK(GENAM(1:LG),KEYSIN,KEYSOU,NFOUND,MAXFIL,IRC)
- PRINT *,NFOUND,IRC,IQUEST(11),IQUEST(12)
- DO 10 I=1,NFOUND
- CALL FMGETK(GENAM(1:LG),LBANK,KEYSOU(1,I),IC)
- CALL FMGETC(LBANK,FFORM,MFLFFA,4,IC)
- CALL FMGETC(LBANK,VID ,MVIDFA,6,IC)
- CALL FMQTMS(VID,LIB,MODEL,DENS,MNTTYP,LABTYP,IC)
- PRINT *,'Candidate # ',I,' format ',FFORM,
- + ' VID ',VID,' robot/manual ',MNTTYP
-10 CONTINUE
-*
-* Terminate cleanly
-*
- CALL FMEND(IRC)
-
- END
-
diff --git a/src/packlib/fatmen/examples/fatselm.F b/src/packlib/fatmen/examples/fatselm.F
deleted file mode 100644
index 734d47a..0000000
--- a/src/packlib/fatmen/examples/fatselm.F
+++ /dev/null
@@ -1,99 +0,0 @@
-*
-* $Id: fatselm.F,v 1.1.1.1 1996/03/07 15:17:59 mclareni Exp $
-*
-* $Log: fatselm.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:59 mclareni
-* Fatmen
-*
-*
-*=======================================================================
-*
-* Example of using the FMSELM routine.
-* This routine performs selection according to a user specified
-* selection matrix.
-*=======================================================================
- PARAMETER (LURCOR=200000)
- COMMON/CRZT/IXSTOR,IXDIV,IFENCE(2),LEV,LEVIN,BLVECT(LURCOR)
- DIMENSION LQ(999),IQ(999),Q(999)
- EQUIVALENCE (IQ(1),Q(1),LQ(9)),(LQ(1),LEV)
-*
- COMMON /USRLNK/LUSRK1,LUSRBK,LUSRLS
-*
- COMMON /QUEST/IQUEST(100)
- PARAMETER (MAXDIR=100)
- CHARACTER*255 CHDIR(MAXDIR)
-*
-* Start of FATMEN sequence FATPARA
-*
-** *** Data set bank mnemonics
-*
-* Keys
- PARAMETER ( MKSRFA= 1, MKFNFA= 2, MKCLFA=7, MKMTFA=8
- 1 ,MKLCFA= 9, MKNBFA=10, NKDSFA=10 )
-*
-** *** Bank offsets
-*
- PARAMETER ( MFQNFA= 1, MHSNFA= 65, MCPLFA= 67, MMTPFA= 68
- 1 ,MLOCFA= 69, MHSTFA= 70, MHOSFA= 74
- 2 ,MVSNFA= 77, MVIDFA= 79, MVIPFA= 81, MDENFA= 82
- 3 ,MVSQFA= 83, MFSQFA= 84, MSRDFA= 85, MERDFA= 86
- 4 ,MSBLFA= 87, MEBLFA= 88, MRFMFA= 89, MRLNFA= 90
- 5 ,MBLNFA= 91, MFLFFA= 92, MFUTFA= 93, MCRTFA= 94
- 6 ,MCTTFA= 95, MLATFA= 96, MCURFA= 97, MCIDFA= 99
- 7 ,MCNIFA=101, MCJIFA=103, MFPRFA=105, MSYWFA=106
- 8 ,MUSWFA=116, MUCMFA=126, NWDSFA=145
- 9 ,MFSZFA=MSYWFA,MUSCFA=MSYWFA+1)
-
-* End of FATMEN sequence FATPARA
-*KEEP,FATBUG.
- COMMON /FATUSE/ IDEBFA, IDIVFA, IKDRFA, KOFSFA, KOFUFA, LBFXFA
- + , LSAVFA, LTOPFA, LBBKFA, LBGNFA, LTDSFA, LBDSFA
- + , LPRTFA, NTOPFA, LUFZFA, IOUPFA, IOBKFA, IODSFA
- + , LLNLFA, LLNHFA
-*KEND.
- PARAMETER (LKEYFA=10)
- DIMENSION KEYS(LKEYFA),KEYM(LKEYFA,2)
-*
-* Initialise ZEBRA
-*
- CALL MZEBRA(-3)
- CALL MZSTOR(IXSTOR,'/CRZT/','Q',IFENCE,LEV,BLVECT(1),BLVECT(1),
- + BLVECT(5000),BLVECT(LURCOR))
- CALL MZLOGL(IXSTOR,-3)
-
-*
-* *** Define user division and link area like:
-*
- CALL MZDIV (IXSTOR, IXDIV, 'USERS', 50000, LURCOR, 'L')
- CALL MZLINK (IXSTOR, '/USRLNK/', LUSRK1, LUSRLS, LUSRK1)
-*
-* Units for FATMEN RZ/FZ files
-*
- LUNRZ = 1
- LUNFZ = 2
-*
-* Initialise FATMEN
-*
- CALL FMINIT(IXSTOR,LUNRZ,LUNFZ,'//CERN/OPAL',IRC)
- CALL FMLOGL(3)
-
- KEYM(MKMTFA,1) = 1
- KEYM(MKCLFA,1) = -1
- KEYM(MKLCFA,1) = 31
- KEYM(MKMTFA,2) = 2
- KEYM(MKCLFA,2) = -1
- KEYM(MKLCFA,2) = 1
-
- NK = 2
-
- CALL FMSELM('//CERN/OPAL/DDST/PASS3/FYZ1/P20/R02222C01',
- + LBANK,KEYS,KEYM,NK,'NM',IRC)
-
- PRINT *,'Return code from FMSELM = ',IRC
-
- IF(IRC.EQ.0)
- + CALL FMSHOW('//CERN/OPAL/DDST/PASS3/FYZ1/P20/R02222C01',
- + LBANK,KEYS,'A',IRC)
-
- END
-
diff --git a/src/packlib/fatmen/examples/fatsetup.F b/src/packlib/fatmen/examples/fatsetup.F
deleted file mode 100644
index b026ecc..0000000
--- a/src/packlib/fatmen/examples/fatsetup.F
+++ /dev/null
@@ -1,49 +0,0 @@
-*
-* $Id: fatsetup.F,v 1.1.1.1 1996/03/07 15:18:00 mclareni Exp $
-*
-* $Log: fatsetup.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:00 mclareni
-* Fatmen
-*
-*
- PARAMETER (LURCOR=200000) FAT00010
- COMMON/CRZT/IXSTOR,IXDIV,IFENCE(2),LEV,LEVIN,BLVECT(LURCOR) FAT00020
- DIMENSION LQ(999),IQ(999),Q(999) FAT00030
- EQUIVALENCE (IQ(1),Q(1),LQ(9)),(LQ(1),LEV) FAT00040
-* FAT00050
- COMMON /USRLNK/LUSRK1,LUSRBK,LUSRLS FAT00060
-* FAT00070
- COMMON /QUEST/IQUEST(100) FAT00080
-* FAT00090
- PARAMETER (LKEYFA=10) FAT00100
- DIMENSION KEYS(LKEYFA) FAT00110
-* FAT00120
-* FAT00130
-* Initialise ZEBRA FAT00140
-* FAT00150
- CALL MZEBRA(-3) FAT00160
- CALL MZSTOR(IXSTOR,'/CRZT/','Q',IFENCE,LEV,BLVECT(1),BLVECT(1), FAT00170
- + BLVECT(5000),BLVECT(LURCOR)) FAT00180
- CALL MZLOGL(IXSTOR,-3) FAT00190
- FAT00200
-* FAT00210
-* *** Define user division and link area like: FAT00220
-* FAT00230
- CALL MZDIV (IXSTOR, IXDIV, 'USERS', 50000, LURCOR, 'L') FAT00240
- CALL MZLINK (IXSTOR, '/USRLNK/', LUSRK1, LUSRLS, LUSRK1) FAT00250
-* FAT00260
-* Unit for RZ database FAT00270
-* FAT00280
- LUNRZ = 1 FAT00290
- LUNFZ = 2 FAT00300
- FAT00310
-* read mode FAT00320
- CALL FMINIT(IXSTOR,LUNRZ,LUNFZ,'//CERN/CNDIV',IRC) FAT00330
- CALL FMLOGL(3) FAT00340
-*
-* Use Tape directly (i.e. issue SETUP rather than STAGE)
-*
- CALL FMOPEN('//CERN/CNDIV/JAMIE/TEST2','10',LBANK,'RTU',IRC) FAT00350
- PRINT *,'Return code from FMOPEN = ',IRC FAT00360
- END FAT00380
- FAT00390
diff --git a/src/packlib/fatmen/examples/fatshow.F b/src/packlib/fatmen/examples/fatshow.F
deleted file mode 100644
index 8d4b579..0000000
--- a/src/packlib/fatmen/examples/fatshow.F
+++ /dev/null
@@ -1,55 +0,0 @@
-*
-* $Id: fatshow.F,v 1.1.1.1 1996/03/07 15:17:59 mclareni Exp $
-*
-* $Log: fatshow.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:59 mclareni
-* Fatmen
-*
-*
- PROGRAM FATUSER
-*----------------------------------------------------------------------*
-* *
-* Example FATUSER program. Just initialise ZEBRA, then FATMEN *
-* and call a couple of routines... *
-* *
-*----------------------------------------------------------------------*
- PARAMETER (LURCOR=200000)
- COMMON/CRZT/IXSTOR,IXDIV,IFENCE(2),LEV,LEVIN,BLVECT(LURCOR)
- DIMENSION LQ(999),IQ(999),Q(999)
- EQUIVALENCE (IQ(1),Q(1),LQ(9)),(LQ(1),LEV)
-*
- COMMON /USRLNK/LUSRK1,LUSRBK,LUSRLS
-*
- COMMON /QUEST/IQUEST(100)
- COMMON /FATUSE/ IDEBFA, IDIVFA, IKDRFA, KOFSFA, KOFUFA, LBFXFA
- + , LSAVFA, LTOPFA, LBBKFA, LBGNFA, LTDSFA, LBDSFA
- + , LPRTFA, NTOPFA, LUFZFA, IOUPFA, IOBKFA, IODSFA
- + , LLNLFA, LLNHFA
-*
- PARAMETER (LKEYFA=10)
- DIMENSION KEYS(LKEYFA)
-*
-*
-* Initialise ZEBRA
-*
- CALL MZEBRA(-3)
- CALL MZSTOR(IXSTOR,'/CRZT/','Q',IFENCE,LEV,BLVECT(1),BLVECT(1),
- + BLVECT(5000),BLVECT(LURCOR))
- CALL MZLOGL(IXSTOR,-3)
-
-*
-* *** Define user division and link area like:
-*
- CALL MZDIV (IXSTOR, IXDIV, 'USERS', 50000, LURCOR, 'L')
- CALL MZLINK (IXSTOR, '/USRLNK/', LUSRK1, LUSRLS, LUSRK1)
-*
-* Unit for RZ database
-*
- LUNRZ = 1
- LUNFZ = 2
-
-* read mode
- CALL FMINIT(IXSTOR,LUNRZ,LUNFZ,'//CERN/CNDIV',IRC)
- CALL FMSHOW('//CERN/CNDIV/JAMIE/FATCAT',LFAT,KEYS,'A',IRC)
- END
-
diff --git a/src/packlib/fatmen/examples/fattags.F b/src/packlib/fatmen/examples/fattags.F
deleted file mode 100644
index 5fc5abd..0000000
--- a/src/packlib/fatmen/examples/fattags.F
+++ /dev/null
@@ -1,86 +0,0 @@
-*
-* $Id: fattags.F,v 1.1.1.1 1996/03/07 15:17:59 mclareni Exp $
-*
-* $Log: fattags.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:59 mclareni
-* Fatmen
-*
-*
-*=======================================================================
-* Example of using the TMS tags
-*=======================================================================
- PARAMETER (LURCOR=200000)
- COMMON/CRZT/IXSTOR,IXDIV,IFENCE(2),LEV,LEVIN,BLVECT(LURCOR)
- DIMENSION LQ(999),IQ(999),Q(999)
- EQUIVALENCE (IQ(1),Q(1),LQ(9)),(LQ(1),LEV)
-*
- COMMON /USRLNK/LUSRK1,LUSRBK,LUSRLS
-*
- COMMON /QUEST/IQUEST(100)
-*
-* Start of FATMEN sequence FATPARA
-*
-** *** Data set bank mnemonics
-*
-* Keys
- PARAMETER ( MKSRFA= 1, MKFNFA= 2, MKCLFA=7, MKMTFA=8
- 1 ,MKLCFA= 9, MKNBFA=10, NKDSFA=10 )
-*
-** *** Bank offsets
-*
- PARAMETER ( MFQNFA= 1, MHSNFA= 65, MCPLFA= 67, MMTPFA= 68
- 1 ,MLOCFA= 69, MHSTFA= 70, MHOSFA= 74
- 2 ,MVSNFA= 77, MVIDFA= 79, MVIPFA= 81, MDENFA= 82
- 3 ,MVSQFA= 83, MFSQFA= 84, MSRDFA= 85, MERDFA= 86
- 4 ,MSBLFA= 87, MEBLFA= 88, MRFMFA= 89, MRLNFA= 90
- 5 ,MBLNFA= 91, MFLFFA= 92, MFUTFA= 93, MCRTFA= 94
- 6 ,MCTTFA= 95, MLATFA= 96, MCURFA= 97, MCIDFA= 99
- 7 ,MCNIFA=101, MCJIFA=103, MFPRFA=105, MSYWFA=106
- 8 ,MUSWFA=116, MUCMFA=126, NWDSFA=145
- 9 ,MFSZFA=MSYWFA,MUSCFA=MSYWFA+1)
-
-* End of FATMEN sequence FATPARA
- PARAMETER (LKEYFA=10)
- DIMENSION KEYS(LKEYFA)
- CHARACTER*80 GENAM
- CHARACTER*255 CHTAGS
-*
-*
-* Initialise ZEBRA
-*
- CALL MZEBRA(-3)
- CALL MZSTOR(IXSTOR,'/CRZT/','Q',IFENCE,LEV,BLVECT(1),BLVECT(1),
- + BLVECT(5000),BLVECT(LURCOR))
- CALL MZLOGL(IXSTOR,-3)
-
-*
-* *** Define user division and link area like:
-*
- CALL MZDIV (IXSTOR, IXDIV, 'USERS', 50000, LURCOR, 'L')
- CALL MZLINK (IXSTOR, '/USRLNK/', LUSRK1, LUSRLS, LUSRK1)
-*
-* Units for FATMEN RZ/FZ files
-*
- LUNRZ = 1
- LUNFZ = 2
-*
-* Initialise FATMEN
-*
- CALL FMINIT(IXSTOR,LUNRZ,LUNFZ,'//CERN/CNDIV',IRC)
- CALL FMLOGL(0)
-*
-* Get list of file names
-*
- GENAM = '//CERN/CNDIV/JAMIE/OUT'
- LG = LENOCC(GENAM)
- CHTAGS = 'Archive tape for FATMEN source'
- CALL FMTAGS(GENAM(1:LG),LBANK,KEYS,CHTAGS,'S',IRC)
- CALL FMTAGS(GENAM(1:LG),LBANK,KEYS,CHTAGS,'G',IRC)
- PRINT *,IRC,CHTAGS(1:LENOCC(CHTAGS))
-*
-* Terminate cleanly
-*
- CALL FMEND(IRC)
-
- END
-
diff --git a/src/packlib/fatmen/examples/fatuniq.F b/src/packlib/fatmen/examples/fatuniq.F
deleted file mode 100644
index 90de65c..0000000
--- a/src/packlib/fatmen/examples/fatuniq.F
+++ /dev/null
@@ -1,95 +0,0 @@
-*
-* $Id: fatuniq.F,v 1.1.1.1 1996/03/07 15:18:00 mclareni Exp $
-*
-* $Log: fatuniq.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:00 mclareni
-* Fatmen
-*
-*
- PARAMETER (LURCOR=200000) FAT00010
- COMMON/CRZT/IXSTOR,IXDIV,IFENCE(2),LEV,LEVIN,BLVECT(LURCOR) FAT00020
- DIMENSION LQ(999),IQ(999),Q(999) FAT00030
- EQUIVALENCE (IQ(1),Q(1),LQ(9)),(LQ(1),LEV) FAT00040
-* FAT00050
- COMMON /USRLNK/LUSRK1,LUSRBK,LUSRLS FAT00060
-* FAT00070
- COMMON /QUEST/IQUEST(100) FAT00080
-* FAT00090
-* Start of FATMEN sequence FATPARA FAT00100
-* FAT00110
-** *** Data set bank mnemonics FAT00120
-* FAT00130
-* Keys FAT00140
- PARAMETER ( MKSRFA= 1, MKFNFA= 2, MKCLFA=7, MKMTFA=8 FAT00150
- 1 ,MKLCFA= 9, MKNBFA=10, NKDSFA=10 ) FAT00160
-* FAT00170
-** *** Bank offsets FAT00180
-* FAT00190
- PARAMETER ( MFQNFA= 1, MHSNFA= 65, MCPLFA= 67, MMTPFA= 68 FAT00200
- 1 ,MLOCFA= 69, MHSTFA= 70, MHOSFA= 74 FAT00210
- 2 ,MVSNFA= 77, MVIDFA= 79, MVIPFA= 81, MDENFA= 82 FAT00220
- 3 ,MVSQFA= 83, MFSQFA= 84, MSRDFA= 85, MERDFA= 86 FAT00230
- 4 ,MSBLFA= 87, MEBLFA= 88, MRFMFA= 89, MRLNFA= 90 FAT00240
- 5 ,MBLNFA= 91, MFLFFA= 92, MFUTFA= 93, MCRTFA= 94 FAT00250
- 6 ,MCTTFA= 95, MLATFA= 96, MCURFA= 97, MCIDFA= 99 FAT00260
- 7 ,MCNIFA=101, MCJIFA=103, MFPRFA=105, MSYWFA=106 FAT00270
- 8 ,MUSWFA=116, MUCMFA=126, NWDSFA=145 FAT00280
- 9 ,MFSZFA=MSYWFA,MUSCFA=MSYWFA+1) FAT00290
- FAT00300
-* End of FATMEN sequence FATPARA FAT00310
- CHARACTER*6 DENS FAT00320
- CHARACTER*8 LIB FAT00330
- CHARACTER*4 LABTYP FAT00340
- CHARACTER*1 MNTTYP FAT00350
- CHARACTER*8 MODEL FAT00360
- CHARACTER*7 ROBMAN(2) FAT00370
- DATA ROBMAN(1)/'-Robot '/,ROBMAN(2)/'-Manual'/ FAT00380
- PARAMETER (LKEYFA=10) FAT00390
- PARAMETER (MAXFIL=1000) FAT00400
- DIMENSION KEYSIN(LKEYFA) FAT00410
- CHARACTER*255 FILES(MAXFIL) FAT00420
- CHARACTER*8 THRONG FAT00430
- CHARACTER*26 CHOPT FAT00440
-* FAT00450
-* FAT00460
-* Initialise ZEBRA FAT00470
-* FAT00480
- CALL MZEBRA(-3) FAT00490
- CALL MZSTOR(IXSTOR,'/CRZT/','Q',IFENCE,LEV,BLVECT(1),BLVECT(1), FAT00500
- + BLVECT(5000),BLVECT(LURCOR)) FAT00510
- CALL MZLOGL(IXSTOR,-3) FAT00520
- FAT00530
-* FAT00540
-* *** Define user division and link area like: FAT00550
-* FAT00560
- CALL MZDIV (IXSTOR, IXDIV, 'USERS', 50000, LURCOR, 'L') FAT00570
- CALL MZLINK (IXSTOR, '/USRLNK/', LUSRK1, LUSRLS, LUSRK1) FAT00580
-* FAT00590
-* Units for FATMEN RZ/FZ files FAT00600
-* FAT00610
- LUNRZ = 1 FAT00620
- LUNFZ = 2 FAT00630
-* FAT00640
-* Initialise FATMEN FAT00650
-* FAT00660
- CALL FMINIT(IXSTOR,LUNRZ,LUNFZ,'//CERN/NA31',IRC) FAT00670
- CALL FMLOGL(3) FAT00680
-* FAT00690
-* Get list of unique file names FAT00700
-* FAT00710
- KEYSIN(MKMTFA) = -1 FAT00720
- KEYSIN(MKCLFA) = -1 FAT00730
- KEYSIN(MKLCFA) = -1 FAT00740
- CALL FMUNIQ('//CERN/NA31/883/MIN8',KEYSIN,FILES,MAXFIL,NMATCH, FAT00750
- + ' ',IC) FAT00760
- IF(IC.NE.0) PRINT *,'Return code ',IC,' from FMUNIQ' FAT00770
- DO 10 I=1,NMATCH FAT00780
- PRINT *,FILES(I)(1:LENOCC(FILES(I))) FAT00790
-10 CONTINUE FAT00800
-* FAT00810
-* Terminate cleanly FAT00820
-* FAT00830
- CALL FMEND(IRC) FAT00840
- FAT00850
- END FAT00860
- FAT00870
diff --git a/src/packlib/fatmen/examples/modfpack.F b/src/packlib/fatmen/examples/modfpack.F
deleted file mode 100644
index a2efbaf..0000000
--- a/src/packlib/fatmen/examples/modfpack.F
+++ /dev/null
@@ -1,65 +0,0 @@
-*
-* $Id: modfpack.F,v 1.1.1.1 1996/03/07 15:18:00 mclareni Exp $
-*
-* $Log: modfpack.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:00 mclareni
-* Fatmen
-*
-*
- PROGRAM FATMOD
- PARAMETER (LURCOR=200000)
- COMMON/CRZT/IXSTOR,IXDIV,IFENCE(2),LEV,LEVIN,BLVECT(LURCOR)
- DIMENSION LQ(999),IQ(999),Q(999)
- EQUIVALENCE (IQ(1),Q(1),LQ(9)),(LQ(1),LEV)
-#include "fatmen/fatpara.inc"
-*
- COMMON /USRLNK/LUSRK1,LUSRBK,LUSRLS
-*
- COMMON /QUEST/IQUEST(100)
-*
- PARAMETER (LKEYFA=10)
- DIMENSION KEY(LKEYFA)
- PARAMETER (MAXCOP=1)
- CHARACTER*255 CHFILE
-*
-*
-* Initialise ZEBRA
-*
- CALL MZEBRA(-3)
- CALL MZSTOR(IXSTOR,'/CRZT/','Q',IFENCE,LEV,BLVECT(1),BLVECT(1),
- + BLVECT(5000),BLVECT(LURCOR))
- CALL MZLOGL(IXSTOR,-3)
-
-*
-* *** Define user division and link area like:
-*
- CALL MZDIV (IXSTOR, IXDIV, 'USERS', 50000, LURCOR, 'L')
- CALL MZLINK (IXSTOR, '/USRLNK/', LUSRK1, LUSRLS, LUSRK1)
-*
-* Unit for RZ database
-*
- LUNRZ = 1
- LUNFZ = 2
-
-* read mode
- CALL FMINIT(IXSTOR,LUNRZ,LUNFZ,'//CERN/CNDIV',IRC)
- CALL FMLOGL(3)
- ICONT = 0
- LBANK = 0
- CALL FMFILS('//CERN/CNDIV/PAVEL/FPACK/TEST1',CHFILE,
- + KEYS,NCOPY,MAXCOP,ICONT,IRC)
- CALL FMGETK('//CERN/CNDIV/PAVEL/FPACK/TEST1',LBANK,KEYS,IRC)
- CALL FMPUTI(LBANK,5850,MRLNFA,IRC)
- CALL FMPUTI(LBANK,5850,MBLNFA,IRC)
-* Change user name of creator
- CALL FMPUTC(LBANK,'BINKO',MCURFA,5,IRC)
-* Put CERN account
- CALL FMPUTC(LBANK,'BPL$CP',MCIDFA,6,IRC)
-* Change jobname
- CALL FMPUTC(LBANK,'BATCH_32',MCJIFA,8,IRC)
- CALL FMSHOW('//CERN/CNDIV/PAVEL/FPACK/TEST1',LBANK,
- +KEYS,'A',IRC)
- PRINT *,' now FMMOD !!! with a NEW name !!!, FMSHOW RC=',IRC
- CALL FMMOD('//CERN/CNDIV/PAVEL/FPACK/TEST2',LBANK,0,IRC)
- PRINT *,' FMMOD RC=',IRC
- END
diff --git a/src/packlib/fatmen/examples/rzddir.F b/src/packlib/fatmen/examples/rzddir.F
deleted file mode 100644
index 04a0f1a..0000000
--- a/src/packlib/fatmen/examples/rzddir.F
+++ /dev/null
@@ -1,40 +0,0 @@
-*
-* $Id: rzddir.F,v 1.1.1.1 1996/03/07 15:18:00 mclareni Exp $
-*
-* $Log: rzddir.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:00 mclareni
-* Fatmen
-*
-*
- DIMENSION IQ(2),Q(2),LQ(8000)
- COMMON/PAWC/NWPAW,IXPAWC,IHDIV,IXHIGZ,IXKU,FENC(5),LMAIN,
- + HCV(499989)
- EQUIVALENCE (LQ(1),LMAIN),(IQ(1),LQ(9)),(Q(1),IQ(1))
- COMMON/QUEST/IQUEST(100)
- COMMON/FATUSE/IDEBFA,IDIVFA,IKDRFA,KOFSFA,KOFUFA,LBFXFA,
- + LSAVFA,LTOPFA,LBBKFA,LBGNFA,LTDSFA,LBDSFA,
- + LPRTFA
-
- DIMENSION KEYZ(10,100)
- DIMENSION KEYS(10)
- CHARACTER*1 CHQUOT
- CALL HLIMIT(50000)
-*
-* Delete bad directories
-*
- LPRTFA = 6
-
- CHQUOT = ''''
-
- CALL RZOPEN(1,'//CERN','/fatmen/fmopal/CERN.FATRZ',' ',1024,irc)
-
- CALL RZFILE(1,'CERN','U')
-
- CALL RZCDIR('//CERN/OPAL/DDST/PASS4/FYZ1',' ')
- CALL RZCDIR(' ','P')
-
- CALL RZDELT('P09')
- PRINT *,'Return code ',IQUEST(1),' from RZDELT'
-
- CALL RZEND('CERN')
- END
diff --git a/src/packlib/fatmen/fatbody/Imakefile b/src/packlib/fatmen/fatbody/Imakefile
deleted file mode 100644
index bc06f45..0000000
--- a/src/packlib/fatmen/fatbody/Imakefile
+++ /dev/null
@@ -1,8 +0,0 @@
-SRCS_F= fafill.F farini.F fatini.F fatmdi.F fmbook.F fmexst.F \ @@\
- fmlift.F fmlogl.F fmrzin.F ftrend.F
-
-#ifdef CERNLIB_SHIFT
-CERNDEFINES:= $(CERNDEFINES) -DCERNLIB_SHIFT
-#endif
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/fatmen/fatbody/fafill.F b/src/packlib/fatmen/fatbody/fafill.F
deleted file mode 100644
index 060f58e..0000000
--- a/src/packlib/fatmen/fatbody/fafill.F
+++ /dev/null
@@ -1,139 +0,0 @@
-*
-* $Id: fafill.F,v 1.1.1.1 1996/03/07 15:18:01 mclareni Exp $
-*
-* $Log: fafill.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:01 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FAFILL (LADDR, PATHN, FNAME, KEYS, MEDIA, CHOPT)
-*
-************************************************************************
-* Borrowed from JDS by JJG on 7-18-89
-* SUBR. FAFILL (LADDR, PATHN, FNAME, *KEYS*, MEDIA, CHOPT)
-*
-* Fill the data set data bank(s)
-*
-* Arguments :
-*
-* LADDR Bank Address
-* GENEN File generic name
-* KEYS Keys vector
-* MEDIA Media type
-* CHOPT Character option - U = user will provide media
-*
-* Called by FMLIFT
-*
-* Error Condition :
-*
-* IQUEST(1) = 0 : No error
-*
-************************************************************************
-*
-*
-*
-#include "fatmen/fatbank.inc"
-#include "fatmen/fatpara.inc"
- CHARACTER DSN*256, COMM*80
- CHARACTER*(*) FNAME,PATHN,MEDIA,CHOPT
-*
-* Fill in as much information automatically
-* In particular, ensure that all mandatory information is present
-*
- CHARACTER*8 CNAME,CTYPE,CSYS,CUSER,CJOB,CACCT
- CHARACTER*6 VSN,VID
- INTEGER FMTIME,FMUSER,FMHOST,FMJOB,FMACNT
- PARAMETER (LKEYFA=10)
- DIMENSION KEYS(LKEYFA)
-*
-* Bank has already been preset to zeroes - fill hollerith
-* fields with blanks
-*
- CALL VBLANK(IQ(LADDR+MFQNFA),MCPLFA-MFQNFA)
- CALL VBLANK(IQ(LADDR+MHSTFA),MVIPFA-MHSTFA)
- CALL VBLANK(IQ(LADDR+MRFMFA),MRLNFA-MRFMFA)
- CALL VBLANK(IQ(LADDR+MFLFFA),MCRTFA-MFLFFA)
- CALL VBLANK(IQ(LADDR+MCURFA),MFPRFA-MCURFA)
- CALL VBLANK(IQ(LADDR+MUCMFA),NWDSFA-MUCMFA+1)
-
- IC = FMTIME(IDATE,ITIME)
-* PACK TIME INTO ONE WORD
- CALL FMPKTM(IDATE,ITIME,IDATM,IRC)
-*
- IC = FMHOST(CNAME,CTYPE,CSYS)
- IC = FMJOB(CJOB)
- IC = FMUSER(CUSER)
- IC = FMACNT(CACCT)
-*
-* Fill KEYS vector
-*
- CALL VBLANK(KEYS(2),5)
- LF = LENOCC(FNAME)
- CALL UCTOH(FNAME(1:LF),KEYS(2),4,LF)
- KEYS(MKSRFA) = 0
- KEYS(MKCLFA) = 0
- KEYS(MKLCFA) = 1
- KEYS(MKMTFA) = 1
- KEYS(MKNBFA) = MKNBFA
-*
-* fill data
-*
- IQ(LADDR+MCPLFA) = 0
- IQ(LADDR+MLOCFA) = 1
- DSN = ' '
- CALL FMFNM(DSN)
-*
-* Default media is disk
-*
- IF (MEDIA(1:4) .NE. 'DISK') THEN
-*
-* Update to indicate a tape file...
-*
- KEYS(MKMTFA) = 2
- IQ(LADDR+MMTPFA) = 2
-
- CALL UCTOH(VSN,IQ(LADDR+MVSNFA),4,6)
- CALL UCTOH(VID,IQ(LADDR+MVIDFA),4,6)
- IQ(LADDR+MDENFA) = 38000
- IQ(LADDR+MFSQFA) = 1
- IQ(LADDR+MVSQFA) = 1
-
- ELSE
-
- IQ(LADDR+MMTPFA) = 1
-
- ENDIF
-
- CALL UCTOH(DSN,IQ(LADDR+MFQNFA),4,LENOCC(DSN))
-* .....
- CALL UCTOH('UN ',IQ(LADDR+MFLFFA),4,4)
- COMM = 'Added via FORTRAN interface'
- LENCOM = LENOCC(COMM)
- CALL UCTOH(COMM,IQ(LADDR+MUCMFA),4,LENCOM)
-*
- CALL VBLANK(IQ(LADDR+MHSNFA),NHSNFA/4)
- CALL VBLANK(IQ(LADDR+MHSTFA),NHSTFA/4)
- CALL VBLANK(IQ(LADDR+MHOSFA),NHOSFA/4)
-
- CALL UCTOH(CNAME,IQ(LADDR+MHSNFA),4,LENOCC(CNAME))
- CALL UCTOH(CTYPE,IQ(LADDR+MHSTFA),4,LENOCC(CTYPE))
- CALL UCTOH(CSYS, IQ(LADDR+MHOSFA),4,LENOCC(CSYS))
-*
- IQ(LADDR+MCRTFA) = IDATM
- IQ(LADDR+MCTTFA) = IDATM
-*
- CALL VBLANK(IQ(LADDR+MCURFA),NCURFA/4)
- CALL VBLANK(IQ(LADDR+MCNIFA),NCNIFA/4)
- CALL VBLANK(IQ(LADDR+MCIDFA),NCIDFA/4)
- CALL VBLANK(IQ(LADDR+MCJIFA),NCJIFA/4)
-
- CALL UCTOH(CUSER,IQ(LADDR+MCURFA),4,LENOCC(CUSER))
- CALL UCTOH(CNAME,IQ(LADDR+MCNIFA),4,LENOCC(CNAME))
- CALL UCTOH(CACCT,IQ(LADDR+MCIDFA),4,LENOCC(CACCT))
- CALL UCTOH(CJOB, IQ(LADDR+MCJIFA),4,LENOCC(CJOB))
-
-*
-* END FAFILL
- 999 END
-
diff --git a/src/packlib/fatmen/fatbody/farini.F b/src/packlib/fatmen/fatbody/farini.F
deleted file mode 100644
index e3cfe6c..0000000
--- a/src/packlib/fatmen/fatbody/farini.F
+++ /dev/null
@@ -1,396 +0,0 @@
-*
-* $Id: farini.F,v 1.1.1.1 1996/03/07 15:18:01 mclareni Exp $
-*
-* $Log: farini.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:01 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FARINI (LUNRZ, PATH, NWKEY, CHFOR, CHTAG,
- + NRECS, CHOPT)
-*
-************************************************************************
-*
-* SUBR. FARINI (LUNRZ, PATH, NWKEY, CHFOR, CHTAG,
-* NRECS, CHOPT)
-*
-* Initializes of the Random Access Event file (for each path)
-*
-* Arguments :
-*
-* LUNRZ RZ file unit
-* PATH Complete path name
-* NWKEY Number of words associated to the keys at the lowest
-* level (If some directory in the pathname at a higher
-* level does not exist, it is created with 1 dummy key)
-* CHFOR Character variable describing each element of the key
-* vector at the lowest level
-* CHTAG Character array defined as CHARACTER*8 (NWKEY)
-* NRECS Number of records for primary allocation (for RZMAKE)
-* If less than or equal to 0 use existing RZ file (RZFILE)
-* CHOPT Character Option : Same as in RZFILE / RZMAKE
-* Z Random access file does not exist (use RZMAKE)
-*
-* Called by User ( Not exactly )
-*
-* Error Condition :
-*
-* IQUEST(1) = 0 : No error
-* = -1 : Invalid Path name
-* = -2 : The file is already open with correct LUNRZ and
-* PATHN
-* = -3 : The file is already open with wrong LUNRZ or
-* PATHN
-*
-************************************************************************
-*
- PARAMETER (MNSYS = 10000, MXSYS = 100000)
-*
-* ZEBRA system common blocks
-*
-#include "zebra/mzcb.inc"
- COMMON /ZEBQ/ IQFENC(4), LQZEB(100)
-*
-#include "fatmen/fatbank.inc"
-#include "fatmen/fatpara.inc"
-#include "fatmen/fatsys.inc"
- PARAMETER (NOPRZ=8)
- CHARACTER CHOPT*(*), PATH*(*), CHFOR*(*), TOP*16, TOPN*16
- CHARACTER COPRZ(NOPRZ)*1, CHOP*8, PATHX*255, CHOPE*4
- CHARACTER FNAME*80
- CHARACTER*(*) CHTAG(*)
- CHARACTER*6 CHFREE
-#if defined(CERNLIB_VAXVMS)
- CHARACTER*16 RECTYP
-#endif
-#if defined(CERNLIB_CSPACK)
- EXTERNAL FMXZIO
-#endif
- INTEGER IOPRZ(NOPRZ)
- DIMENSION IBUF(1024)
- SAVE NTOPM
-*
- DATA NTOPM /0/
- DATA COPRZ /'1', 'D', 'L', 'M', 'S', 'U', 'X', 'C'/
-*
-* ------------------------------------------------------------------
-*
-* CALL UOPTC (CHOPT, 'Z', IOPTZ)
- IOPTZ = INDEX(CHOPT,'Z')
- IOPTO = 0
- IF (IOPTZ.NE.0.AND.NRECS.GT.0) THEN
- NREC = NRECS
- IOPTN = 1
- ELSE
- IOPTN = 0
- NREC = 0
- ENDIF
- DO 10 I = 1, NOPRZ
- IF (I.EQ.1) THEN
- CHOP = COPRZ(I)
- ELSE
- CHOP = CHOP(1:I-1)//COPRZ(I)
- ENDIF
- 10 CONTINUE
- CALL UOPTC (CHOPT, CHOP(1:NOPRZ), IOPRZ)
-* IF (IOPRZ(1).NE.0.OR.IOPRZ(6).NE.0) IOPTO = 1
- IF (IOPRZ(6).NE.0) IOPTO = 1
-*
-* *** Find number of characters in the path name
-*
- MAX = LENOCC (PATH)
- IF (MAX.LT.3.OR.PATH(1:2).NE.'//') THEN
- IQUEST(1) = -1
- IF(IDEBFA.GE.-3) WRITE (LPRTFA, 9003) PATH
- GO TO 999
- ENDIF
- II = INDEX (PATH(3:MAX), '/') - 1
- IF (II.LE.0) THEN
- II = MAX
- ELSE
- II = II + 2
- ENDIF
- IF (II.EQ.MAX) THEN
- ITOP = 1
- ELSE
- ITOP = 0
- ENDIF
- TOPN = PATH(3:II)
-*
-* *** First pass initialization
-*
- IF (NTOPM.EQ.0) THEN
- ENDIF
-*
-* *** Construct the character option
-*
- NTOPM = NTOPM + 1
- CHOP = ' '
- II = 0
- DO 20 I = 1, NOPRZ
- IF (IOPRZ(I).NE.0) THEN
- IF (II.EQ.0) THEN
- CHOP = COPRZ(I)
- ELSE
- CHOP = CHOP(1:II)//COPRZ(I)
- ENDIF
- II = II + 1
- ENDIF
- 20 CONTINUE
- IFLG = 0
- IF (IOPTO.NE.0.OR.IOPTN.NE.0) IFLG = 1
-*
-* ** Check whether the RZ file has been already initialized
-*
- IROPN = 0
- IF (LTOPFA.NE.0) THEN
- LSAVFA = LTOPFA
- 30 LUN = IQ(KOFUFA+LSAVFA+MLUNFA)
- NCH = IQ(KOFUFA+LSAVFA+MNCHFA)
- CALL UHTOC (IQ(KOFUFA+LSAVFA+MCHRFA), 4, PATHX, NCH)
- PATHX = PATHX(1:NCH)
- IF (PATHX.EQ.PATH.AND.LUN.EQ.LUNRZ) THEN
- IQUEST(1) = -2
- LSAVFA = 0
- IF(IDEBFA.GE.-3) WRITE (LPRTFA, 9004) PATH(1:MAX), LUNRZ
- GO TO 999
- ENDIF
-*
- II = INDEX (PATHX(3:NCH), '/') - 1
- IF (II.LE.0) THEN
- II = NCH
- ELSE
- II = II + 2
- ENDIF
- TOP = PATHX(3:II)
- IF (TOPN.NE.TOP.AND.LUN.EQ.LUNRZ) THEN
- IQUEST(1) = -3
- LSAVFA = 0
- WRITE (LPRTFA, 9005) PATHX(1:NCH), LUN, PATH(1:MAX), LUNRZ
- GO TO 999
- ELSE IF (TOPN.EQ.TOP.AND.LUN.NE.LUNRZ) THEN
- IQUEST(1) = -3
- LSAVFA = 0
- WRITE (LPRTFA, 9005) PATHX(1:NCH), LUN, PATH(1:MAX), LUNRZ
- GO TO 999
- ENDIF
- IF (LUN.EQ.LUNRZ) THEN
- IROPN = 1
- IFLG = IQ(KOFUFA+LSAVFA+MFLGFA)
- ENDIF
-*
- LSUP = LSAVFA
- LSAVFA = LQ(KOFUFA+LSUP)
- IF (LSAVFA.NE.0) GO TO 30
-*
-* ** Create linear structure of the top-directories
-*
- NS = NSLUFA + 10
- CALL MZBOOK (IDIVFA, LSAVFA, LSUP, 0, 'UPFA', NS, NS, NDUPFA,
- + IOUPFA, 0)
- ELSE
- NS = NSLUFA + 10
- CALL MZBOOK (IDIVFA, LTOPFA, LTOPFA, 1, 'UPFA', NS, NS,
- + NDUPFA, IOUPFA, 0)
- LSAVFA = LTOPFA
- ENDIF
-*
-** Create the book-keeping bank
-*
- CALL MZBOOK (IDIVFA, LBBKFA, LSAVFA, -KLBKFA, 'BKFA', 0, 0,
- +10*NWBKFA, IOBKFA, 0)
-*
-** Create the "generic names bank"
-*
- CALL MZBOOK (IDIVFA, LBGNFA, LSAVFA, -KLGNFA, 'GNFA', 0, 0,
- +800, 5, 0)
-*
-* ** Fill up the top directory bank with user data
-*
- NTOPFA = NTOPFA + 1
- IQ(KOFUFA+LSAVFA+MLUNFA) = LUNRZ
- IQ(KOFUFA+LSAVFA+MFLGFA) = IFLG
- IQ(KOFUFA+LSAVFA+MTOPFA) = NTOPFA
- IQ(KOFUFA+LSAVFA+MNCHFA) = MAX
- CALL UCTOH (PATH, IQ(KOFUFA+LSAVFA+MCHRFA), 4, MAX)
- IQ(KOFUFA+LBBKFA-5) = 0
- IQ(KOFUFA+LBGNFA-5) = 0
-*
- IQUEST(1) = 0
-#if !defined(CERNLIB_CZ)
- IF (IROPN.NE.0) GO TO 70
-*
-* ** Open the file
-*
- FNAME = TOPN(1:LENOCC(TOPN))//'.FATRZ'
- LDEF = LENOCC(DEFAULT)
-#endif
-#if defined(CERNLIB_CSPACK)
- IF(FATNOD.NE.' ') THEN
- LRECL = 0
- CHOP = 'X'
- CALL FAOPEN('FARZ',LUNRZ,CHOPE,FNAME,LRECL,5000)
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9001) LUNRZ,TOPN,LRECL,CHOP
- 9001 FORMAT(' FARINI. call RZHOOK for LUN ',I3,' TOPN ',A,
- + ' LRECL ',I6,' CHOP ',A)
- CALL RZHOOK (LUNRZ, TOPN, FMXZIO, LRECL, CHOP)
- GOTO 999
- ENDIF
-#endif
-#if (defined(CERNLIB_FATSRV))&&(!defined(CERNLIB_CZ))
- FNAME = TOPN(1:LENOCC(TOPN))//'.FATRZ.A6'
-#endif
-#if (defined(CERNLIB_FMOTOZ))&&(!defined(CERNLIB_CZ))
- FNAME = TOPN(1:LENOCC(TOPN))//'.FATRZ.A6'
-#endif
-#if !defined(CERNLIB_CZ)
-*
-* New CHOPT for use with RZOPEN
-*
-#endif
-#if defined(CERNLIB_VAXVMS)
- CHOPE = 'S'
- IF (INDEX(CHOPT,'1').NE.0) CHOPE = 'SU'
-*
-* Check if file is STREAM_LF
-* If so, assume exchange mode, C I/O, shared access
-*
- INQUIRE(FILE=DEFAULT(1:LDEF)//FNAME,RECORDTYPE=RECTYP)
- IF(INDEX(RECTYP,'STREAM_LF').NE.0) THEN
- CHOPE = 'SXC'
- CHOP = 'SXC'
- STRMLF = .TRUE.
- ELSE
- STRMLF = .FALSE.
- ENDIF
-#endif
-#if !defined(CERNLIB_VAXVMS)
- CHOPE = ' '
- IF (INDEX(CHOPT,'1').NE.0) CHOPE = 'U'
-#endif
-#if defined(CERNLIB_UNIX)
- CHOPE = 'X'
- CHOP = 'X'
- IF (INDEX(CHOPT,'1').NE.0) THEN
- CHOPE = 'XU'
- CHOP = 'XU'
- ENDIF
-* Nasty hack for fatcat:/fatmen
-#endif
-#if (defined(CERNLIB_CRAY)||defined(CERNLIB_DECS))&&(defined(CERNLIB_CERN))
-*
-* Assume that files in /fatmen are exchange mode, C I/O
-*
- IF(DEFAULT(1:7).EQ.'/fatmen') THEN
- CHOPE = 'XC'
- CHOP = 'XC'
- IF (INDEX(CHOPT,'1').NE.0) THEN
- CHOPE = 'XUC'
- CHOP = 'XUC'
- ENDIF
- ENDIF
-#endif
-*
-* New files...
-*
- IF (INDEX(CHOPT,'Z').NE.0) THEN
- CHOPE = 'UN'
- IF(INDEX(CHOPT,'C').NE.0.AND.INDEX(CHOPT,'X').NE.0)
- + CHOPE = 'CUNX'
- IF(INDEX(CHOPT,'C').EQ.0.AND.INDEX(CHOPT,'X').NE.0)
- + CHOPE = 'UNX'
- ENDIF
-
- LRECL = 4096
- CALL FAOPEN('FARZ',LUNRZ,CHOPE,FNAME,LRECL,5000)
-*
- IF (IOPTN.NE.0) THEN
-*
-* ** Create file on mass storage and create the 1st pass directories
-*
-#if defined(CERNLIB_IBMVM)
-*
-* Get number of free blocks on A disk
-*
- NPRE = 2500
- CALL VMREXX('F','FREE_BLOCKS',CHFREE,IRC)
- IF (IRC .NE. 0) THEN
- PRINT *, 'FARINI. Error ',IRC,' obtaining number of free '
- + //'blocks'
- PRINT *, ' Ensure that REXX variable FREE_BLOCKS is '
- + //'set'
- PRINT *, ' in exec which calls this program'
- PRINT *, ' (FREE_BLOCKS=QDISK("191","BLKLEFT")'
- ELSE
- READ(CHFREE,*) NPRE
- NPRE = (NPRE*85)/100
- ENDIF
-
- PRINT *,'FARINI. Preformatting ',NPRE,' records on unit ',
- + LUNRZ
-
- DO 40 IREC=1,NPRE
- WRITE(UNIT=LUNRZ,REC=IREC,ERR=50)IBUF
- 40 CONTINUE
- GOTO 60
- 50 PRINT *,'FARINI - Error at record ',IREC, ' LUN=',LUNRZ
- 60 CONTINUE
-#endif
- IF (NWKEY.GT.0.AND.ITOP.NE.0) THEN
-*
-* New 'feature' of RZ calls ZFATAL for NREC > max
-*
- NREC = MIN(65000,NREC)
- CALL RZMAKE (LUNRZ, TOPN, NWKEY, CHFOR, CHTAG, NREC, CHOP)
- ELSE
- CHTAG(1) = 'DUMMY '
- CALL RZMAKE (LUNRZ, TOPN, 1, 'I', CHTAG, NREC, CHOP)
- ENDIF
-*
- ELSE
-*
-* ** Reopen the RZ-file on the mass storage for read and write
-*
- IF(IFMODX.NE.0) THEN
- LCHOP = LENOCC(CHOP)
- IF(LCHOP.EQ.0) THEN
- LCHOP = 1
- CHOP = 'X'
- ELSE
- IF(INDEX(CHOP(1:LCHOP),'X').EQ.0)
- + CHOP(LCHOP+1:LCHOP+1) = 'X'
- ENDIF
- ENDIF
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9002) LUNRZ,TOPN,LRECL,CHOP
- 9002 FORMAT(' FARINI. call RZFILE for LUN: ',I3,' TOPN: ',A,
- + ' LRECL ',I6,' CHOP ',A)
- CALL RZFILE (LUNRZ, TOPN, CHOP)
- IF(IQUEST(1).NE.0) THEN
- PRINT *, 'FARINI. Error ',IQUEST(1),' from RZFILE, will '
- + //'reinitialise'
- CALL RZEND(TOPN)
- CALL RZFILE(LUNRZ,TOPN,CHOP)
- ENDIF
-*
- ENDIF
-*
- IF (IQUEST(1).NE.0) THEN
- IQUEST(1) = -2
- WRITE (LPRTFA, 9004) PATH, LUNRZ
- GO TO 999
- ENDIF
-*
-* *** Create the directory in up-date mode (if not yet created)
-*
- 70 IF (IFLG.NE.0.AND.NWKEY.GT.0) THEN
-* CALL FATMDI (PATH, NWKEY, CHFOR, CHTAG)
- IF (IQUEST(1).EQ.25) IQUEST(1) = 0
- ENDIF
-*
- 9003 FORMAT (/,' FARINI : Illegal Path Name ',A)
- 9004 FORMAT (/,' FARINI : Path name ',A,' is already open on unit ',I4)
- 9005 FORMAT (/,' FARINI : Path name ',A,' open on unit ',I4
- +,' is in conflict with'/,' Requested Path name ',A,' on unit ',I4)
-* END FARINI
- 999 END
diff --git a/src/packlib/fatmen/fatbody/fatini.F b/src/packlib/fatmen/fatbody/fatini.F
deleted file mode 100644
index 8363be1..0000000
--- a/src/packlib/fatmen/fatbody/fatini.F
+++ /dev/null
@@ -1,93 +0,0 @@
-*
-* $Id: fatini.F,v 1.1.1.1 1996/03/07 15:18:01 mclareni Exp $
-*
-* $Log: fatini.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:01 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FATINI(ISTOR,LUNRZ,LUNFZ,CHTOP,CHOPT)
-*
-************************************************************************
-*
-* SUBROUTINE FATINI(ISTOR,LUNRZ,LUNFZ,CHTOP,CHOPT)
-*
-*
-* initialize the FATMEN - user interface package -
-*
-* ISTOR User store index
-*
-* LUNRZ unit for the RZ database
-* LUNFZ unit for the FZ files
-*
-* CHOPT Character Option (to be defined)
-*
-************************************************************************
-*
- PARAMETER (MNSYS = 10000, MXSYS = 100000)
-*
-* ZEBRA system common blocks
-*
-#include "zebra/mzcb.inc"
- COMMON /ZEBQ/ IQFENC(4), LQZEB(100)
-*
-#include "fatmen/fatbank.inc"
-#include "fatmen/fatpara.inc"
-#include "fatmen/fatlnk.inc"
-*
- CHARACTER CHTOP*(*)
- CHARACTER*(*) CHOPT
- PARAMETER (LKEYFA=10)
- CHARACTER*8 CHTAG(LKEYFA)
- CHARACTER*10 CHFOR
- COMMON /PAWC/ NWPAW,IXPAWC,IHBOOK,IXHIGZ,IXKUIP,IFENCE(5)
- DATA CHTAG/'Num.Id.',5*'Fname'
- + ,'cp.level','loc.code','medium','nm.banks'/
- DATA CHFOR/'IHHHHHIIII'/
-*_______________________________________________________________________
-*
-*
-*
-** initialize some variables
-*
- LPRTFA = 6
- LUFZFA = LUNFZ
-*
-* ** DB System initialization
-*
- IF(ISTOR.GE.0) THEN
- CALL MZDIV (ISTOR, IDIVFA, 'FAT-SYSTM', MNSYS, MXSYS, 'P')
- LQST = LOCF(LQ(1)) - 1
- LQZB = LQST + 1 - LOCF(LQZEB(1))
- CALL MZSDIV (0, -1)
- KOFSFA = KQS - LQZB
- CALL MZSDIV (IDIVFA, -1)
- KOFUFA = KQS - LQZB
- CALL MZLINK (IDIVFA, '/FATUSE/', LBFXFA, LBDSFA, LBFXFA)
- CALL MZLINK ( 0, '/FATSTO/', LDIRFA, LBOUT , LJNKFA)
- CALL MZLINK (IDIVFA, '/FATSER/', LNEWFA, LBANKR, LNEWFA)
- CALL MZLINK (IDIVFA, '/FATBNK/', LBKLUN(1), LBKLUN(99),
- + LBKLUN(1))
- CALL MZLINK (IDIVFA, '/FATLNK/', LOPNBK, LCP2BK, LOPNBK)
-
- CALL MZFORM ('UPFA', '10I -H', IOUPFA)
- CALL MZFORM ('BKFA', '-I', IOBKFA)
- CALL MZFORM ('DSFA', '66H 3I 11H 8I 1H 2I 2H 3I 8H 21I 20H'
- + ,IODSFA)
- NTOPFA = 0
- ENDIF
-#if !defined(CERNLIB_CZ)
-*
-** Initialize the RZ - db
-*
-#endif
- NRECS = 65000
- IF(IDEBFA.GE.2) PRINT *,'FATINI. call FARINI for ',
- + LUNRZ,CHTOP,LKEYFA,CHFOR,CHTAG,NRECS,CHOPT
- CALL FARINI (LUNRZ,CHTOP,LKEYFA,CHFOR,CHTAG,NRECS,CHOPT)
-
-* END FATINI
- END
-
-
diff --git a/src/packlib/fatmen/fatbody/fatmdi.F b/src/packlib/fatmen/fatbody/fatmdi.F
deleted file mode 100644
index 53e7a75..0000000
--- a/src/packlib/fatmen/fatbody/fatmdi.F
+++ /dev/null
@@ -1,182 +0,0 @@
-*
-* $Id: fatmdi.F,v 1.1.1.1 1996/03/07 15:18:02 mclareni Exp $
-*
-* $Log: fatmdi.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:02 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FATMDI (PATH, NWKEY, CHFOR, CHTAG)
-*
-************************************************************************
-*
-* SUBR. FATMDI (PATH, NWKEY, CHFOR, CHTAG)
-*
-* Creates Directories with the conventions of FAT package
-*
-* Arguments :
-*
-* PATH Path name of the directory
-* NWKEY Number of words associated to the keys at the lowest
-* level (If some directory in the pathname at a higher
-* level does not exist, it is created with same keys )
-* CHFOR Character variable describing each element of the key
-* vector at the lowest level
-* CHTAG Character array defined as CHARACTER*8 (NWKEY)
-*
-* Called by FATINI
-*
-* Error Condition :
-*
-* IQUEST(1) = 0 : No error
-* = 21 : Too many key elements
-* = 22 : Illegal Path name
-* = 23 : RZ file is opened with no write access
-* = 24 : Path name cannot be found in the list of those
-* initialized
-* = 25 : The Directory already exists
-* = 26 : Error in directory creation (RZMDIR)
-*
-************************************************************************
-*
-#include "fatmen/fatbank.inc"
- CHARACTER CHFOR*(*), PATH*(*)
- CHARACTER PATHX*255, TOPN*16, TOP*16
- CHARACTER*(*) CHTAG(*)
-*
-* ------------------------------------------------------------------
-*
-* *** Check on number of keys
-*
- IF (NWKEY.GT.MXDMFA) THEN
- IQUEST(1) = 21
- IQUEST(11)= NWKEY
- IQUEST(12)= MXDMFA
- IF (IDEBFA.GE.-3) WRITE (LPRTFA, 9003) IQUEST(11), IQUEST(12)
- GO TO 999
- ENDIF
-*
-* *** Find number of characters in the path name
-*
- NCH = LENOCC (PATH)
- IF (NCH.LT.3.OR.PATH(1:2).NE.'//') THEN
- IQUEST(1) = 22
- IF (IDEBFA.GE.-3) WRITE (LPRTFA, 9004) PATH
- GO TO 999
- ENDIF
- II = INDEX (PATH(3:NCH), '/') - 1
- IF (II.LE.0) THEN
- II = NCH
- ELSE
- II = II + 2
- ENDIF
- TOPN = PATH(3:II)
-*SELF,IF=-*FATSRV.
-* What is this for?
-#if defined(CERNLIB_NEVER)
-*
-* *** Check if the Path name matches
-*
- LSAVFA = LTOPFA
- IFND = 0
- 10 IF (LSAVFA.NE.0) THEN
- NCHR = IQ(KOFUFA+LSAVFA+MNCHFA)
- CALL UHTOC (IQ(KOFUFA+LSAVFA+MCHRFA), 4, PATHX, NCHR)
- II = INDEX (PATHX(3:NCHR), '/') - 1
- IF (II.LE.0) THEN
- II = NCHR
- ELSE
- II = II + 2
- ENDIF
- TOP = PATHX(3:II)
- IF (TOPN.NE.TOP) THEN
- LSAVFA = LQ(KOFUFA+LSAVFA)
- GO TO 10
- ENDIF
- IFND = IFND + 1
- IFLG = IQ(KOFUFA+LSAVFA+MFLGFA)
- IF (IFLG.NE.0) GO TO 20
- LSAVFA = LQ(KOFUFA+LSAVFA)
- GO TO 10
- ELSE IF (IFND.EQ.0) THEN
- IQUEST(1) = 23
- IF (IDEBFA.GE.-3) WRITE (LPRTFA, 9005) PATH(1:NCH)
- GO TO 999
- ELSE
- IQUEST(1) = 24
- IF (IDEBFA.GE.-3) WRITE (LPRTFA, 9006) PATH(1:NCH)
- GO TO 999
- ENDIF
-#endif
-*
-* *** Create a new (tree of) director(ies) - from the first non-existing
-* *** name. Go down to the lowest existing directory in PATH
-*
- 20 ICH = 2
- ISTCH = ICH + 1
- 30 ICH = ICH + 1
- IF (PATH(ICH:ICH).EQ.'/'.OR.ICH.GT.NCH) THEN
- CALL RZCDIR (PATH(1:ICH-1), ' ')
- IF (IQUEST(1).EQ.0) THEN
- IF (ICH.GT.NCH) THEN
- IQUEST(1) = 25
- IF (IDEBFA.GE.-3) WRITE (LPRTFA, 9007) PATH(1:NCH)
- GO TO 999
- ELSE
- IF(IDEBFA.GE.3) WRITE (LPRTFA, 9001) PATH(1:ICH-1)
- 9001 FORMAT(' FATMDI. directory ',A,' exists (OK)')
- ISTCH = ICH + 1
- GO TO 30
- ENDIF
- ELSE
-*
-* ** Create new directories
-*
- PATHX = PATH(ISTCH:ICH-1)
-C IF (ICH.GT.NCH) THEN
- IF(IDEBFA.GE.3) THEN
- CALL RZCDIR(' ','P')
- PRINT 9002,PATHX(1:LENOCC(PATHX))
- 9002 FORMAT(' FATMDI. attempting creation of subdirectory ',A)
- ENDIF
- CALL RZMDIR (PATHX, NWKEY, CHFOR, CHTAG)
-C ELSE
-C CALL RZMDIR (PATHX, 1, 'I', 'DUMMY ')
-C ENDIF
- ICHR = ICH - ISTCH
- IF (IQUEST(1).NE.0) THEN
- IQUEST(1) = 26
- IF (IDEBFA.GE.-3) WRITE (LPRTFA, 9008) PATHX(1:ICHR),
- + PATH(1:NCH)
- GO TO 999
- ELSE
- IF (IDEBFA.GE.-3) WRITE (LPRTFA, 9009) PATHX(1:ICHR),
- + PATH(1:NCH)
- ENDIF
- IF (ICH.GT.NCH) GO TO 999
- CALL RZCDIR (PATH(1:ICH-1), ' ')
- IF (IQUEST(1).NE.0) THEN
- IQUEST(1) = 26
- ICHR = ICH - ISTCH
- IF (IDEBFA.GE.-3) WRITE (LPRTFA, 9008) PATHX(1:ICHR),
- + PATH(1:NCH)
- GO TO 999
- ENDIF
- ISTCH = ICH + 1
- GO TO 30
- ENDIF
- ELSE
- GO TO 30
- ENDIF
-*
- 9003 FORMAT (/,' FATMDI : Too many key elements requested = ',I6
- +,' maximum permitted ',I5)
- 9004 FORMAT (/,' FATMDI : Illegal path name ',A)
- 9005 FORMAT (/,' FATMDI : RZ file opened with no write access for ',A)
- 9006 FORMAT (/,' FATMDI : RZ file is not initialized for ',A)
- 9007 FORMAT (/,' FATMDI : Directory ',A,' already exists')
- 9008 FORMAT (/,' FATMDI : Error creating part ',A,' of path ',A)
- 9009 FORMAT (/,' FATMDI : Part ',A,' of path ',A,' created.')
-* END FATMDI
- 999 END
diff --git a/src/packlib/fatmen/fatbody/fmbook.F b/src/packlib/fatmen/fatbody/fmbook.F
deleted file mode 100644
index 8396ef4..0000000
--- a/src/packlib/fatmen/fatbody/fmbook.F
+++ /dev/null
@@ -1,64 +0,0 @@
-*
-* $Id: fmbook.F,v 1.1.1.1 1996/03/07 15:18:01 mclareni Exp $
-*
-* $Log: fmbook.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:01 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMBOOK (GENEN, KEYS, LADDR, LSUP, JBIAS, IRC)
-*
-************************************************************************
-*
-* SUBR. FMBOOK (GENEN, KEYS, LADDR*,*LSUP*, JBIAS, IRC*)
-*
-*
-#include "fatmen/fatbank.inc"
-#include "fatmen/fatpara.inc"
-*
- CHARACTER GENEN*(*)
- DIMENSION LSUP(9)
-*
- PARAMETER (LKEYFA=10)
- DIMENSION INKEYS(LKEYFA),KEYS(LKEYFA)
- CHARACTER*8 CHTAG(LKEYFA)
- CHARACTER*10 CHFOR
- DATA CHTAG/'Num.Id.',5*'Fname'
- + ,'cp.level','loc.code','medium','nm.banks'/
- DATA CHFOR/'IHHHHHIIII'/
-*
-*______________________________________________________________________
- IRC = 0
- NCH = LENOCC(GENEN)
- NCHD = INDEXB(GENEN(1:NCH),'/') -1
-*
-* *** Create the bank
-*
- CALL MZBOOK (IDIVFA, LADDR, LSUP, JBIAS, 'DSFA', 0, 0, NWDSFA,
- + IODSFA, 0)
-*
-* Zero/blank it according to I/O characteristic
-*
- CALL DZZERO(IDIVFA,LADDR)
- IQUEST(1) = 0
-*
-* and fill it in ...
-*
- CALL FAFILL(LADDR+KOFUFA,GENEN(1:NCHD),GENEN(NCHD+2:NCH),
- +KEYS,'DISK','U')
-*
-* Check if this generic name already exists in RZ file
-*
- CALL FMEXST(GENEN(1:NCH),IRET)
- IQUEST(11) = IRET
-*
-* Check if this directory already exists
-*
- CALL FACDIR(GENEN(1:NCHD),' ')
- IF((IQUEST(1).NE.0).AND.(IDEBFA.GE.1)) PRINT *,
- + 'FMBOOK. directories will be automatically created by server'
- IQUEST(12) = IQUEST(1)
-
- END
-
diff --git a/src/packlib/fatmen/fatbody/fmexst.F b/src/packlib/fatmen/fatbody/fmexst.F
deleted file mode 100644
index f396553..0000000
--- a/src/packlib/fatmen/fatbody/fmexst.F
+++ /dev/null
@@ -1,43 +0,0 @@
-*
-* $Id: fmexst.F,v 1.1.1.1 1996/03/07 15:18:01 mclareni Exp $
-*
-* $Log: fmexst.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:01 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMEXST(GENEN,IRC)
-*
-* Routine to check whether specified generic name
-* already exists on RZ file. Does not attempt to
-* read in data structure - just uses keys
-* N.B. the maximum number of copies of a file is limited to MAXCOP
-*
- CHARACTER*(*) GENEN
-#include "fatmen/fmaxcop.inc"
- PARAMETER (LKEYFA=10)
- DIMENSION KEYSIN(LKEYFA),KEYSOU(LKEYFA,MAXCOP)
-#include "fatmen/fatpara.inc"
- IRC = 0
- NFOUND = 0
- NCH = LENOCC(GENEN)
- LCH = INDEXB(GENEN(1:NCH),'/') + 1
-
- CALL VBLANK(KEYSIN(2),5)
- CALL UCTOH(GENEN(LCH:NCH),KEYSIN(2),4,MIN(NCH-LCH+1,20))
-*
-* Don't compare copy level, location code or media type
-*
- KEYSIN(MKCLFA) = -1
- KEYSIN(MKLCFA) = -1
- KEYSIN(MKMTFA) = -1
- KEYSIN(1) = 0
- KEYSIN(10) = 10
-
- CALL FMSELK(GENEN(1:NCH),KEYSIN,KEYSOU,NFOUND,MAXCOP,IRC)
-
- IRC = NFOUND
-
- END
-
diff --git a/src/packlib/fatmen/fatbody/fmlift.F b/src/packlib/fatmen/fatbody/fmlift.F
deleted file mode 100644
index e9dfb11..0000000
--- a/src/packlib/fatmen/fatbody/fmlift.F
+++ /dev/null
@@ -1,194 +0,0 @@
-*
-* $Id: fmlift.F,v 1.1.1.1 1996/03/07 15:18:01 mclareni Exp $
-*
-* $Log: fmlift.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:01 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMLIFT (GENEN, KEYS, MEDIA, CHOPT, IRC)
-*
-************************************************************************
-*
-* SUBR. FMLIFT (GENEN, *KEYS*, MEDIA, CHOPT ,IRC)
-*
-* Create a new entry into the data set data base
-*
-* Arguments :
-*
-* GENEN File generic name
-* KEYS Keys vector
-* MEDIA Media type
-* CHOPT Character option - U = user will allocate media
-*
-* Called by User
-*
-* Error Condition :
-*
-* IQUEST(1) = 0 : No error
-* = 51 : Illegal Path name
-* = 52 : Illegal file name
-* = 53 : Path name cannot be found in the list of those
-* initialized
-* = 54 : File already "opened"
-*
-************************************************************************
-*
-#include "fatmen/fatbank.inc"
-#include "fatmen/fatpara.inc"
-*
- CHARACTER GENEN*(*), PATHN*255, PATH*255,
- + PATHX*255, FNAME*20, MEDIA*(*)
- DIMENSION LSUP(9), KEYS(*)
-*
- PARAMETER (LKEYFA=10)
- DIMENSION INKEYS(LKEYFA)
- CHARACTER*8 CHTAG(LKEYFA)
- CHARACTER*10 CHFOR
- CHARACTER*(*) CHOPT
- DATA CHTAG/'Num.Id.',5*'Fname'
- + ,'cp.level','loc.code','medium','nm.banks'/
- DATA CHFOR/'IHHHHHIIII'/
-*
-*______________________________________________________________________
- IRC = 0
- IQUEST(1) = 0
-*
-* *** Find number of characters in the path name
-*
- NCH = LENOCC (GENEN)
- CALL CLTOU(GENEN)
- IF (NCH.LT.3.OR.GENEN(1:2).NE.'//'.OR.GENEN(NCH:NCH).EQ.'/') THEN
- IQUEST(1) = 51
- IF (IDEBFA.GE.-3) WRITE (LPRTFA, 1001) GENEN(1:NCH)
- GO TO 999
- ENDIF
-*
-* *** Find file name
-*
- ICH = INDEXB(GENEN(1:NCH-1),'/')
- IF (ICH.LE.3.OR. NCH-ICH.GT.20) THEN
- IQUEST(1) = 52
- IF (IDEBFA.GE.-3) WRITE (LPRTFA, 1002) GENEN(1:NCH)
- GO TO 999
- ENDIF
- PATHN = GENEN(1:ICH-1)
- FNAME = GENEN(ICH+1:NCH)
- CALL VBLANK(KEYS(2),5)
- CALL UCTOH(FNAME,KEYS(2),4,NCH-ICH)
-*------ These lines not really useful in client. Remove 23/01/90 -------
-CSELF,IF=-CZ.
-*
-*
-* *** Set the current directory (or create a new one)
-*
-C CALL FACDIR (PATHN, ' ')
-C IF (IQUEST(1).NE.0) CALL FATMDI (PATHN, LKEYFA, CHFOR, CHTAG)
-C CALL FACDIR (PATH, 'R')
-
-C NCHD = INDEX (PATH, ' ') - 1
-C IF (NCHD.LE.0) NCHD = MAXLFA
-*------ These lines not really useful in client. Remove 23/01/90 -------
-CSELF,IF=CZ.
- PATH = PATHN
- NCHD = LENOCC(PATHN)
-CSELF.
-*
-* Check if this generic name already exists in RZ file
-*
- CALL FMEXST(GENEN(1:NCH),IGET)
- IQUEST(11) = IGET
-*
-* Check if this directory already exists
-*
- CALL FACDIR(PATHN(1:NCHD),' ')
- IF((IQUEST(1).NE.0).AND.(IDEBFA.GE.1)) PRINT *,
- + 'FMLIFT. directories will be automatically created by server'
- IQUEST(12) = IQUEST(1)
-
-*
-* *** Check if the Path name matches
-*
- LSAVFA = LTOPFA
- 10 IF (LSAVFA.NE.0) THEN
- NCHR = IQ(KOFUFA+LSAVFA+MNCHFA)
- CALL UHTOC (IQ(KOFUFA+LSAVFA+MCHRFA), 4, PATHX, NCHR)
- IF (PATH(1:NCHR).NE.PATHX(1:NCHR)) THEN
- LSAVFA = LQ(KOFUFA+LSAVFA)
- GO TO 10
- ENDIF
- ELSE
- IQUEST(1) = 53
- IF (IDEBFA.GE.-3) WRITE (LPRTFA, 1003) PATH(1:NCHD)
- GO TO 999
- ENDIF
-*
-* *** Book-keeping
-*
- LBBKFA = LQ(KOFUFA+LSAVFA-KLBKFA)
- LBGNFA = LQ(KOFUFA+LSAVFA-KLGNFA)
-* check that this file is not already used
- NOPF = IQ(KOFUFA+LSAVFA+MNOPFA)
- IF (NOPF.NE.0) THEN
- LB = KOFUFA+LBBKFA
- DO 20 I=1,NOPF
- NCHR = IQ(LB+MCGNFA)
- IF (NCHR.NE.NCH) GO TO 21
- IPT = IQ(LB+MPNTFA)
- CALL UHTOC (IQ(KOFUFA+LBGNFA+IPT), 4, PATHX, NCHR)
- IF (GENEN(1:NCHR).EQ.PATHX(1:NCHR)) THEN
-* file already opened
- IQUEST(1) = 54
- IF (IDEBFA.GE.-3) WRITE (LPRTFA, 1004) GENEN(1:NCH)
- GO TO 999
- ENDIF
-21 LB = LB + NWBKFA
-20 CONTINUE
- ENDIF
-* create a new entry
- NOPF = NOPF + 1
- IQ(KOFUFA+LSAVFA+MNOPFA) = NOPF
- IF (NOPF.GT.IQ(KOFUFA+LSAVFA-2)-NSLUFA) THEN
- CALL MZPUSH(IDIVFA,LSAVFA,10,0,' ')
- CALL MZPUSH(IDIVFA,LBBKFA,0,10*NWBKFA,' ')
- ENDIF
- NWUD = IQ(KOFUFA+LBGNFA-5)
- NNW = (NCH+3)/4
- IF (NWUD+NNW.GT.IQ(KOFUFA+LBGNFA-1)) THEN
- CALL MZPUSH(IDIVFA,LBGNFA,0,800,' ')
- ENDIF
- LB = KOFUFA+LBBKFA+NWBKFA*(NOPF-1)
- IQ(LB+MSTAFA) = 0
- IQ(LB+MPNTFA) = NWUD+1
- IQ(LB+MCGNFA) = NCH
- IQ(KOFUFA+LBGNFA-5) = NWUD+NNW
- CALL UCTOH(GENEN,IQ(KOFUFA+LBGNFA+NWUD+1),4,NCH)
-*
-* *** Create the bank structure ...
-*
- JB = -(NOPF+NSLUFA)
- CALL MZBOOK (IDIVFA, LTDSFA, LSAVFA, JB, 'DSFA', 0, 0, NWDSFA,
- + IODSFA, 0)
- LBDSFA = LTDSFA
-*
-* Zero/blank it according to I/O characteristic
-*
- CALL DZZERO(IDIVFA,LTDSFA)
- IQUEST(1) = 0
-*
-* *** ... and fill it in
-*
- CALL FAFILL(LTDSFA+KOFUFA,PATHN,FNAME,KEYS,MEDIA,CHOPT)
-
-
- 1001 FORMAT (' FMLIFT. Illegal path name ',A)
- 1002 FORMAT (' FMLIFT. Illegal file name ',A)
- 1003 FORMAT (' FMLIFT. RZ file is not initialized for ',A)
- 1004 FORMAT (' FMLIFT. File already opened for ',A)
-* END FMLIFT
- 999 IF(IQUEST(1) .NE. 0) IRC = 1
- IQUEST(11) = 0
- IF(IGET.EQ.0) IQUEST(11) = 1
- END
-
diff --git a/src/packlib/fatmen/fatbody/fmlogl.F b/src/packlib/fatmen/fatbody/fmlogl.F
deleted file mode 100644
index ce13319..0000000
--- a/src/packlib/fatmen/fatbody/fmlogl.F
+++ /dev/null
@@ -1,43 +0,0 @@
-*
-* $Id: fmlogl.F,v 1.1.1.1 1996/03/07 15:18:01 mclareni Exp $
-*
-* $Log: fmlogl.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:01 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMLOGL (LOGL)
-*
-************************************************************************
-*
-* SUBR. FMLOGL (LOGL)
-*
-* Sets the logging level inside FAZ
-*
-* Arguments :
-*
-* LOGL Logging level
-*
-* Called by user
-*
-************************************************************************
-*
-#include "fatmen/fatbank.inc"
- SAVE NENTRY
- DATA NENTRY/0/
-
- IF(LOGL.EQ.999.AND.NENTRY.NE.0) RETURN
- IF(NENTRY.EQ.0) NENTRY = 1
- IF(LOGL.EQ.999) THEN
- IDEBFA = 0
- ELSE
- IDEBFA = LOGL
- IF(IDEBFA.GE.0) PRINT *,'FMLOGL. setting log level to ',IDEBFA
-#if defined(CERNLIB_CSPACK)
- CALL XZLOGL(IDEBFA)
-#endif
- ENDIF
-* END FMLOGL
- END
-
diff --git a/src/packlib/fatmen/fatbody/fmrzin.F b/src/packlib/fatmen/fatbody/fmrzin.F
deleted file mode 100644
index fc450c2..0000000
--- a/src/packlib/fatmen/fatbody/fmrzin.F
+++ /dev/null
@@ -1,1088 +0,0 @@
-*
-* $Id: fmrzin.F,v 1.1.1.1 1996/03/07 15:18:01 mclareni Exp $
-*
-* $Log: fmrzin.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:01 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMRZIN (CHNAME,IUDIV,LSUP,JBIAS,NWKEY,KEYS,IFLAG)
-*
-************************************************************************
-*
-*
-* Inputs one data structure from the Random Access file
-*
-* Arguments :
-*
-* GENAME Generic name
-* IUDIV Division index where the data structure exists
-* LSUP Address supporting the data structure
-* JBIAS < 1 : LSUP is the supporting bank and JBIAS is the link
-* bias specifying where the data structure has to
-* be introduced
-* = 1 : LSUP is the supporting link
-* = 2 : Stand alone data structure with address at LSUP
-* NWKEY Maximum size available for KEYS vector
-* On return it carries the actual size of the KEYS
-* KEYS Key vector
-* IFLAG = 0 Input key vector ignored - select 'best' copy
-* = 1 Input key vector used to select
-*
-* Called by User
-*
-* Error Condition :
-*
-* IQUEST(1) = 0 : No error
-* = 10 : Path name contains wild-cards
-* = 11 : Illegal Path name
-* = 12 : Path name cannot be found in the list of those
-* initialized
-* = 13 : Error in RZ for retrieving the data structure
-* = 14 : File not found
-* = 15 : File rejected by KEYS selection
-* = 16 : Volume not known
-* = 17 : Volume unavailable
-* = 42 : RZ file inaccessible
-*
-* Selection is performed as follows:
-*
-* If IFLAG=1, input key vector is used
-* =0, First available of
-* {local disk|local robot|local tape} is taken
-*
-************************************************************************
-*
-#include "fatmen/faust.inc"
-#include "fatmen/fatapol3.inc"
-#include "fatmen/fatclio.inc"
-#if defined(CERNLIB_SHIFT)
-#include "fatmen/fatshift.inc"
-#endif
-#include "fatmen/slate.inc"
-#include "fatmen/fatbank.inc"
-#include "fatmen/fatpara.inc"
-#include "fatmen/fatsys.inc"
-#include "fatmen/fatsel.inc"
-#include "fatmen/fatloc.inc"
-#include "fatmen/fatmtp.inc"
-#include "fatmen/fatcpl.inc"
-#if defined(CERNLIB_CRAY)
- PARAMETER (IQCHAW=8)
-#endif
-#if !defined(CERNLIB_CRAY)
- PARAMETER (IQCHAW=4)
-#endif
- CHARACTER*15 XVID
- CHARACTER*8 VIP
- CHARACTER*(*) CHNAME
- CHARACTER PATH*255, PATHN*255,
- + PATHX*255, FNAME*20
- CHARACTER*255 GENAME
-* DIMENSION LSUP(9), KEYS(*)
- PARAMETER (LKEYFA=10)
-* DIMENSION LSUP(9), KEYS(LKEYFA)
- DIMENSION KEYS(LKEYFA)
-#include "fatmen/fmaxcop.inc"
- DIMENSION KEYSOU(LKEYFA,MAXCOP),KEYSIN(LKEYFA)
- CHARACTER*8 HOST1,HOST2,HTYPE,HSYS
- CHARACTER*12 FSEQ
- CHARACTER*6 VID,VSN
- CHARACTER*4 FFORM
- CHARACTER*8 CLUNAM,CLUNOD
- CHARACTER*255 CHDSN,DFSNAM
- CHARACTER*256 DSN
-* Save 'best' copy of each media type
- DIMENSION IFOUND(KMXMTP)
- INTEGER FMHOST
-#if defined(CERNLIB_VAXVMS)
- INTEGER SYS$GETSYIW,SYS$GETMSG
- INTEGER FAFNDF
- INCLUDE '($RMSDEF)'
- INCLUDE '($SSDEF)'
- STRUCTURE /ITMLST/
- UNION
- MAP
- INTEGER*2 BUFFER_LENGTH
- INTEGER*2 ITEM_CODE
- INTEGER*4 BUFFER_ADDRESS
- INTEGER*4 RETURN_LENGTH_ADDRESS
- ENDMAP
- MAP
- INTEGER*4 END_LIST /0/
- ENDMAP
- END UNION
- END STRUCTURE
-
- RECORD /ITMLST/ SYI_LIST(2)
-
- INCLUDE '($SYIDEF)'
- CHARACTER*255 EQUNAM
- CHARACTER*255 CHMESS
- CHARACTER*255 CHFILE
-#endif
-#if defined(CERNLIB_VAXVMS)||defined(CERNLIB_UNIX)||defined(CERNLIB_IBMMVS)
- CHARACTER*255 CHNFS
- LOGICAL IEXIST
-#endif
- CHARACTER*80 CHLINE
- PARAMETER (MAXTRY=100)
- PARAMETER (NSECS=10)
-#include "fatmen/tmsdef.inc"
-*
-* ------------------------------------------------------------------
-*
-* *** Find number of characters in the path name
-*
- LGN = LENOCC(CHNAME)
- GENAME = CHNAME(1:LGN)
- CALL CLTOU(GENAME(1:LGN))
-
-* Check for wild-cards in generic-name
-*
- IWILD = ICFMUL('*%(<>[]',GENAME,1,LGN)
- IF(IWILD.LE.LGN) THEN
- PATH = ' '
- PATH(IWILD:IWILD+3) = '^---'
- WRITE(LPRTFA,9001) GENAME(1:LGN),PATH(1:IWILD+3)
- 9001 FORMAT(' FMRZIN. wild-cards not permitted in generic name',/,
- + 1X,A,/,1X,A)
- IQUEST(1) = 10
- GOTO 999
- ENDIF
-
- ICH = INDEXB(GENAME(1:LGN),'/')
- PATHN = GENAME(1:ICH-1)
- FNAME = GENAME(ICH+1:LGN)
- NCH = ICH-1
- NCHN = LGN-ICH
- IF (NCH.LT.3.OR.PATHN(1:2).NE.'//') THEN
- IQUEST(1) = 11
- IF (IDEBFA.GE.-3) WRITE (LPRTFA, 9054) PATHN(1:NCH)
- GOTO 999
- ENDIF
-*
-* Retry loop
-*
- NTRY = 0
- 10 CONTINUE
- ICODE = 0
-*
-* *** Set the current directory
-*
- CALL FACDIR (PATHN, 'U')
-* CALL FACDIR (PATHN, ' ')
- IF (IQUEST(1).NE.0) THEN
- IQUEST(1) = 11
- IF (IDEBFA.GE.-3) WRITE (LPRTFA, 9055) PATHN(1:NCH)
- GOTO 999
- ENDIF
-*
-* Get modification date of the directory
-*
- IDATEM = IQUEST(16)
- ITIMEM = IQUEST(17)
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9062) IDATEM,ITIMEM
-
- NKEYFA = IQUEST(7)
- NWKYFA = IQUEST(8)
- LDIRFA = IQUEST(11)
- IKDRFA = IQUEST(13)
- CALL FACDIR (PATH, 'R')
-* NCH = INDEX (PATH, ' ') - 1
- NCH = LENOCC(PATH)
- IF (NCH.LE.0) NCH = MAXLFA
-*
-* *** Check if the Path name matches
-*
- LSAVFA = LTOPFA
- 20 IF (LSAVFA.NE.0) THEN
- NCHR = IQ(KOFUFA+LSAVFA+MNCHFA)
- CALL UHTOC (IQ(KOFUFA+LSAVFA+MCHRFA), 4, PATHX, NCHR)
- IF (PATHN(1:NCHR).NE.PATHX(1:NCHR)) THEN
- LSAVFA = LQ(KOFUFA+LSAVFA)
- GOTO 20
- ENDIF
- ELSE
- IQUEST(1) = 12
- IF (IDEBFA.GE.-3) WRITE (LPRTFA, 9055) PATHN(1:NCH)
- GOTO 999
- ENDIF
- IQ(KOFUFA+LSAVFA+MTOTFA) = NKEYFA
-
-*------------------ new FATMEN selection -------------------------------
- IF(IFLAG.EQ.0) THEN
-
- CALL VBLANK(KEYSIN(2),5)
- KEYSIN(1) = 0
- KEYSIN(10) = 10
- CALL UCTOH(FNAME,KEYSIN(2),4,MIN(NCHN,20))
- CALL VZERO(IFOUND,KMXMTP)
-*
-* Don't compare copy level
-*
- KEYSIN(MKCLFA) = -1
-*
-* Don't compare location code (for the time being)
-*
- KEYSIN(MKLCFA) = -1
-*
-* Get current host
-*
- IC = FMHOST(HOST1,HTYPE,HSYS)
- CALL CLTOU(HOST1)
- LH1 = LENOCC(HOST1)
-*
-* Pointer for manually mounted tape
-*
- ISAVE = 0
-*
-* Pointer for 'served' dataset (e.g. NFS/DFS/FPACK)
-*
- JSAVE = 0
-*
-* N.B. see warning below (locate !!!!)
-*
-*
-* Range of media types
-*
- ILOW = MRMTFA(1)
- IHIGH = MRMTFA(2)
-
- IMEDIA = ILOW
- ICOUNT = 1
- IF(NUMMTP.GT.0) IMEDIA = MFMMTP(ICOUNT)
- 30 CONTINUE
-
-* DO 100 IMEDIA = ILOW,IHIGH
-*
-* For each media type, look for 'best' copy. For tapes,
-* a robotically mounted tape is always taken over a manually
-* mounted one.
-* If the user has defined a list of media, process in order
-*
- KEYSIN(MKMTFA) = IMEDIA
-
- CALL FMSELK(PATHN(1:NCH)//'/'//FNAME(1:NCHN),
- + KEYSIN,KEYSOU,NMATCH,MAXCOP,IRC)
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9002) NMATCH,IMEDIA
- 9002 FORMAT(' FMRZIN. found ',I6,' matches for media type ',I6)
-*
-* See if any of these copies are directly accessible
-*
- DO 130 I=1,NMATCH
-*
-* Check that keys match those selected
-* Location code:
-*
- IF(NUMLOC.GT.0) THEN
- IF(IUCOMP(KEYSOU(MKLCFA,I),MFMLOC,NUMLOC).EQ.0) THEN
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9003) I
- 9003 FORMAT(' FMRZIN. candidate # ',I6,' fails location code check')
- ICODE = 15
- GOTO 130
- ENDIF
- ENDIF
-*
-* Copy level:
-*
- IF(NUMCPL.GT.0) THEN
- IF(IUCOMP(KEYSOU(MKCLFA,I),MFMCPL,NUMCPL).EQ.0) THEN
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9004) I
- 9004 FORMAT(' FMRZIN. candidate # ',I6,' fails copy level check')
- ICODE = 15
- GOTO 130
- ENDIF
- ENDIF
-*
-* If IMEDIA=1, check that host name matches
-* else, use VID to check whether in a robot or manual library
-*
- ICYCL = 9999
- JBIAS = 2
- CALL RZIN(IUDIV,LFAT,JBIAS,KEYSOU(1,I),ICYCL,' ')
- NFBANK = NFBANK + 1
- IF (IQUEST(1).NE.0) THEN
- IF (IDEBFA.GE.-3) THEN
- WRITE (LPRTFA, 9056) IQUEST(1),PATHN(1:NCH)
- CALL FMSHOK('Object: ',KEYSOU(1,I),LKEYFA)
- ENDIF
- IQUEST(1) = 13
- ENDIF
-
- IF(IMEDIA.EQ.1) THEN
-*
-* Check that host name matches. If not, reject
-*
- CALL UHTOC(IQ(LFAT+KOFUFA+MHSNFA),4,HOST2,8)
- LH2 = LENOCC(HOST2)
- CALL CLTOU(HOST2)
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9005) HOST1(1:LH1),
- + HOST2(1:LH2)
- 9005 FORMAT(' FMRZIN. Checking hostname: local host/ catalogue = ',
- + A8,' / ',A8)
- IF(HOST1(1:LH1).EQ.HOST2(1:LH2)) THEN
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9006)
- 9006 FORMAT(' FMRZIN. found matching dataset on a disk')
- CALL FMUSEL(GENAME,LBANK,KEYSOU(1,I),ISEL)
- IF(ISEL.EQ.0) THEN
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9007)
- 9007 FORMAT(' FMRZIN. user selection passed')
- GOTO 140
- ELSE
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9008)
- 9008 FORMAT(' FMRZIN. user selection failed')
- ENDIF
- ELSE
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9009)
- 9009 FORMAT(' FMRZIN. check on host name failed')
- ENDIF
-#if defined(CERNLIB_FPACK)
-*
-* Check .netrc file for host name
-*
- CALL UHTOC(IQ(LFAT+KOFUFA+MFLFFA),4,FFORM,4)
- IF(FFORM(1:2).EQ.'FP') THEN
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9010)
- 9010 FORMAT(' FMRZIN. checking FPACK server access (.netrc file)')
- CALL FMNTRC(HOST2(1:LH2),FFORM,IRC)
- IF(IRC.EQ.0) THEN
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9011)
- 9011 FORMAT(' FMRZIN. found matching dataset accessible through ',
- + 'FPACK server')
- CALL FMUSEL(GENAME,LBANK,KEYSOU(1,I),ISEL)
- IF(ISEL.EQ.0) THEN
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9007)
- IF(JSAVE.EQ.0) THEN
- JSAVE = I
- IFOUND(IMEDIA) = I
- ENDIF
- ELSE
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9008)
- ENDIF
- ELSE
- IF(IDEBFA.GE.3) WRITE(LPRTFA,9012) HOST2(1:LH2)
- 9012 FORMAT(' FMRZIN. host ',A8,' not accessible via FPACK server')
- ENDIF
- ENDIF
-#endif
-#if defined(CERNLIB_UNIX)
-*
-* Check for AFS mounted files
-*
- DSN = ' '
- CALL UHTOC(IQ(LFAT+KOFUFA+MFQNFA),4,DSN,NFQNFA)
- LDSN = LENOCC(DSN)
- CALL CUTOL(DSN(1:LDSN))
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9013) DSN(1:LDSN)
- 9013 FORMAT(' FMRZIN. checking AFS access to ',A)
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9014) DSN(1:LDSN)
- 9014 FORMAT(' FMRZIN. looking for file ',A)
- INQUIRE(FILE=DSN(1:LDSN),EXIST=IEXIST)
- IF(IEXIST) THEN
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9015)
- 9015 FORMAT(' FMRZIN. found matching dataset accessible via AFS')
- CALL FMUSEL(GENAME,LBANK,KEYSOU(1,I),ISEL)
- IF(ISEL.EQ.0) THEN
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9007)
- IF(JSAVE.EQ.0) THEN
- JSAVE = I
- IFOUND(IMEDIA) = I
- ENDIF
- ELSE
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9008)
- ENDIF
- ELSE
- IF(IDEBFA.GE.3) WRITE(LPRTFA,9016)
- 9016 FORMAT(' FMRZIN. file not found via AFS')
- ENDIF
-#endif
-#if defined(CERNLIB_UNIX)||defined(CERNLIB_VAXVMS)
-*
-* Check for NFS mounted files
-*
- DSN = ' '
- CALL UHTOC(IQ(LFAT+KOFUFA+MFQNFA),4,DSN,NFQNFA)
- LDSN = LENOCC(DSN)
- IF(DSN(1:1).EQ.'$') THEN
- LSLASH = INDEX(DSN(1:LDSN),'/')
- IF(LSLASH.NE.0) THEN
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9017) DSN(1:LSLASH-1)
- 9017 FORMAT(' FMRZIN. found environmental variable/logical',
- + ' name in DSN - ',A)
-#endif
-#if defined(CERNLIB_UNIX)
- CALL GETENVF(DSN(2:LSLASH-1),CHNFS)
- LCHNFS = IS(1)
-#endif
-#if defined(CERNLIB_VAXVMS)
- CALL FMGTLG(DSN(2:LSLASH-1),CHNFS,'LNM$SYSTEM',ILOGRC)
-*
-* Logical name not defined: convert to VMS format
-* $ENV/filename -> ENV:filename
-*
- IF(ILOGRC.NE.0) THEN
- CHNFS = DSN(2:LSLASH-1)//':'//DSN(LSLASH+1:LDSN)
- LCHNFS = LDSN - 1
- ELSE
- LCHNFS = IS(1)
- ENDIF
-#endif
-#if defined(CERNLIB_VAXVMS)||defined(CERNLIB_UNIX)
- IF(LCHNFS.GT.0) THEN
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9018) CHNFS(1:LCHNFS)
- 9018 FORMAT(' FMRZIN. value = ',A)
-*
-* Now build file name
-*
-#endif
-#if defined(CERNLIB_UNIX)
- CHNFS(LCHNFS+1:) = DSN(LSLASH:LDSN)
- LCHNFS = LCHNFS + LDSN - LSLASH + 1
- CALL CUTOL(CHNFS(1:LCHNFS))
-#endif
-#if defined(CERNLIB_VAXVMS)
-*
-* If there is more than one slash in file name
-* assume that the intervening elements are directory names
-*
- IF(ILOGRC.EQ.0) THEN
- JSLASH = INDEXB(DSN(1:LDSN),'/')
- IF(JSLASH.EQ.LSLASH) THEN
- CHNFS(LCHNFS+1:) = DSN(LSLASH+1:LDSN)
- LCHNFS = LCHNFS + LDSN - LSLASH
- ELSE
- CHNFS(LCHNFS+1:) = '[' // DSN(LSLASH+1:JSLASH-1)
- + // ']' // DSN(JSLASH+1:LDSN)
- LCHNFS = LCHNFS + LDSN - LSLASH + 1
- CALL CTRANS('/','.',CHNFS,1,LCHNFS)
- ENDIF
- ENDIF
-#endif
-#if defined(CERNLIB_VAXVMS)||defined(CERNLIB_UNIX)
-*
-* Does file exist? (This will also work for the same VAXcluster)
-*
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9019) CHNFS(1:LCHNFS)
- 9019 FORMAT(' FMRZIN. checking NFS access to ',A)
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9020) CHNFS(1:LCHNFS)
- 9020 FORMAT(' FMRZIN. looking for file ',A)
- INQUIRE(FILE=CHNFS(1:LCHNFS),EXIST=IEXIST)
- IF(IEXIST) THEN
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9021)
- 9021 FORMAT(' FMRZIN. found matching dataset on a disk mounted ',
- + 'by NFS')
- CALL FMUSEL(GENAME,LBANK,KEYSOU(1,I),ISEL)
- IF(ISEL.EQ.0) THEN
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9007)
- IF(JSAVE.EQ.0) THEN
- JSAVE = I
- IFOUND(IMEDIA) = I
- ENDIF
- ELSE
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9008)
- ENDIF
- ELSE
- IF(IDEBFA.GE.3) WRITE(LPRTFA,9022)
- 9022 FORMAT(' FMRZIN. file not found via NFS')
- ENDIF
-#endif
-#if defined(CERNLIB_VAXVMS)
-*
-* File not found, try DECnet access
-*
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9023)
- + HOST2(1:LH2)//'::'//CHNFS(1:LCHNFS)
- 9023 FORMAT(' FMRZIN. checking DECnet access to ',A)
- INQUIRE(FILE=HOST2(1:LH2)//'::'//CHNFS(1:LCHNFS),
- + EXIST=IEXIST)
- IF(IEXIST) THEN
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9024)
- 9024 FORMAT(' FMRZIN. found matching ',
- + 'dataset on a disk accessible via DECnet')
- CALL FMUSEL(GENAME,LBANK,KEYSOU(1,I),ISEL)
- IF(ISEL.EQ.0) THEN
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9007)
- IF(JSAVE.EQ.0) THEN
- JSAVE = I
- IFOUND(IMEDIA) = I
- ENDIF
- ELSE
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9008)
- ENDIF
- ELSE
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9025)
- 9025 FORMAT(' FMRZIN. file not found via DECnet')
- ENDIF
-#endif
-#if defined(CERNLIB_VAXVMS)||defined(CERNLIB_UNIX)
- ENDIF
- ENDIF
- ENDIF
-#endif
-#if defined(CERNLIB_VAXVMS)
-*
-* Check whether the node in the catalogue is the VAXcluster alias
-*
- CALL FMGTLG('SYS$CLUSTER_NODE',CLUNAM,'LNM$SYSTEM',IRC)
- LC = INDEX(CLUNAM,':') -1
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9026) HOST2,CLUNAM(1:LC)
- 9026 FORMAT(' FMRZIN. host/cluster-alias = ',A,' ',A)
- IF(HOST2(1:LH2).EQ.CLUNAM(1:LC))THEN
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9027)
- 9027 FORMAT(' FMRZIN. found matching dataset on a disk in this ',
- + 'VAXcluster')
- CALL FMUSEL(GENAME,LBANK,KEYSOU(1,I),ISEL)
- IF(ISEL.EQ.0) THEN
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9007)
- GOTO 140
- ELSE
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9008)
- ENDIF
- ENDIF
-*
-* Check whether the node in the catalogue is in
-* the same VAXcluster as us
-*
- SYI_LIST(1).BUFFER_LENGTH = 1
- SYI_LIST(1).ITEM_CODE = SYI$_CLUSTER_MEMBER
- SYI_LIST(1).BUFFER_ADDRESS = %LOC(IMEMB)
- SYI_LIST(1).RETURN_LENGTH_ADDRESS = %LOC(LTEMP)
- SYI_LIST(2).END_LIST = 0
-
- ISTAT = SYS$GETSYIW(,,HOST2(1:LH2),SYI_LIST,,,)
-
-* IF (ISTAT .NE. SS$_NOSUCHNODE) THEN
- IF (IMEMB.NE.0) THEN
- IF(IDEBFA.GE.3) WRITE(LPRTFA,9028) HOST2,ISTAT
- 9028 FORMAT(' FMRZIN. status from check on ',A,
- + ' for VAXcluster membership = ',I10)
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9029)
- 9029 FORMAT(' FMRZIN. found matching dataset on a disk in this',
- + ' VAXcluster')
- CALL FMUSEL(GENAME,LBANK,KEYSOU(1,I),ISEL)
- IF(ISEL.EQ.0) THEN
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9007)
- GOTO 140
- ELSE
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9008)
- ENDIF
-
- ELSE
-*
-* No, check whether the disk in question is known
-* on this system and mounted via DFS
-* (Set JSAVE)
-*
- CALL UHTOC(IQ(LFAT+KOFUFA+MFQNFA),4,DSN,NFQNFA)
- LDSN = LENOCC(DSN)
-*
-* First, get full file name
-*
- ICONT = 0
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9030) DSN(1:LDSN)
- 9030 FORMAT(' FMRZIN. issuing LIB$FIND_FILE for ',A)
- IFIND = FAFNDF(DSN(1:LDSN),CHDSN,ICONT)
- IEND = LIB$FIND_FILE_END(ICONT)
- IF(IFIND.EQ.RMS$_SUC) THEN
- IF(IDEBFA.GE.2) THEN
- WRITE(LPRTFA,9031) DSN(1:LDSN),CHDSN(1:LENOCC(CHDSN))
- 9031 FORMAT(' FMRZIN. file ',A,' exists, full name = ',A)
- WRITE(LPRTFA,9032)
- 9032 FORMAT(' FMRZIN. checking for DFS access...')
- ENDIF
-
- LCHDSN = INDEX(CHDSN,':') - 1
- IF(LCHDSN.GT.0) THEN
- CALL FMGTLG(CHDSN(1:LCHDSN),DFSNAM,'LNM$SYSTEM',JRC)
- IF((JRC.EQ.0).AND.(INDEX(DFSNAM,'DFSC').NE.0)) THEN
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9033)
- 9033 FORMAT(' FMRZIN. found matching dataset on a disk mounted by DFS')
- CALL FMUSEL(GENAME,LBANK,KEYSOU(1,I),ISEL)
- IF(ISEL.EQ.0) THEN
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9007)
- IF(JSAVE.EQ.0) THEN
- JSAVE = I
- IFOUND(IMEDIA) = I
- ENDIF
- ELSE
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9008)
- ENDIF
- ENDIF
- ENDIF
- ELSE
-*
-* Show error message
-*
- IF(IDEBFA.GE.2) THEN
- WRITE(LPRTFA,9034)
- 9034 FORMAT(' FMRZIN. file not found via DFS')
- IC = SYS$GETMSG(%VAL(IFIND),LMESS,CHMESS,,)
- PRINT 9063,DSN(1:LDSN),IFIND,CHMESS(1:LMESS)
- ENDIF
-*
-* File not found, try DECnet access
-*
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9023)
- + HOST2(1:LH2)//'::'//DSN(1:LDSN)
- INQUIRE(FILE=HOST2(1:LH2)//'::'//DSN(1:LDSN),EXIST=IEXIST)
- IF(IEXIST) THEN
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9035)
- 9035 FORMAT(' FMRZIN. found matching dataset on a disk accessible',
- + ' via DECnet')
- CALL FMUSEL(GENAME,LBANK,KEYSOU(1,I),ISEL)
- IF(ISEL.EQ.0) THEN
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9007)
- IF(JSAVE.EQ.0) THEN
- JSAVE = I
- IFOUND(IMEDIA) = I
- ENDIF
- ELSE
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9008)
- ENDIF
- ELSE
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9036)
- 9036 FORMAT(' FMRZIN. file not found via DECnet')
- ENDIF
- ENDIF
- ENDIF
-
-#endif
-#if defined(CERNLIB_CSPACK)
-*
-* For ZEBRA FZ files in binary exchange mode, see if remote node
-* is accessible via CSPACK (check .netrc file)
-*
- CALL UHTOC(IQ(LFAT+KOFUFA+MFLFFA),4,FFORM,4)
- IF(FFORM(1:3).NE.'FXN'.AND.INDEX(FFORM,'FX').NE.0) THEN
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9037)
- 9037 FORMAT(' FMRZIN. checking CSPACK server access (.netrc file)')
- CALL FMNTRC(HOST2(1:LH2),FFORM,IRC)
- IF(IRC.EQ.0) THEN
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9038)
- 9038 FORMAT(' FMRZIN. found matching dataset accessible through ',
- + 'CSPACK server')
- CALL FMUSEL(GENAME,LBANK,KEYSOU(1,I),ISEL)
- IF(ISEL.EQ.0) THEN
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9007)
- IF(JSAVE.EQ.0) THEN
- JSAVE = I
- IFOUND(IMEDIA) = I
- ENDIF
- ELSE
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9008)
- ENDIF
- ELSE
- IF(IDEBFA.GE.3) WRITE(LPRTFA,9039) HOST2(1:LH2)
- 9039 FORMAT(' FMRZIN. host ',A,' not accessible via CSPACK server')
- ENDIF
- ENDIF
-
-#endif
- ELSE
-*
-* Check that tape is in an active library (when TMS is available)
-*
-* Choose robot over manual
-*
- CALL UHTOC(IQ(LFAT+KOFUFA+MVIDFA),4,VID,6)
- LVID = LENOCC(VID)
- CALL UHTOC(IQ(LFAT+KOFUFA+MVSNFA),4,VSN,6)
- LVSN = LENOCC(VSN)
-*
-* Set IQUEST(11) to media type in case volume unknown or
-* TMS option not installed.
-*
- IQUEST(11) = IQ(LFAT+KOFUFA+MMTPFA)
-#if defined(CERNLIB_PREFIX)
- CALL FMXVID(VID,IQ(LFAT+KOFUFA+MVIPFA),XVID,VIP,'C',IC)
- LXVID = LENOCC(XVID)
- CALL FMQTMS(XVID(1:LXVID),LIB,MODEL,DENS,MNTTYP,LABTYP,IC)
-#endif
-#if !defined(CERNLIB_PREFIX)
- CALL FMQTMS(VID(1:LVID),LIB,MODEL,DENS,MNTTYP,LABTYP,IC)
-#endif
- IF(IC.EQ.100) THEN
- ICODE = 16
- IF(IDEBFA.GE.0) WRITE(LPRTFA,9040) VID
- 9040 FORMAT(' FMRZIN. Volume ',A8,' unknown to TMS')
- GOTO 120
- ENDIF
-
- IF(IC.EQ.312.OR.IC.EQ.315) THEN
- ICODE = 17
- IF(IDEBFA.GE.0) WRITE(LPRTFA,9041) VID
- 9041 FORMAT(' FMRZIN. Volume ',A8,' unavailable')
- GOTO 120
- ENDIF
-*
-* Check whether required device exists on this node
-*
- LM = LENOCC(MODEL)
- IDEV = 1
-#if (defined(CERNLIB_IBMMVS))&&(!defined(CERNLIB_DSYIBM))
-*
-* Assume all devices are available
-*
- IDEV = 0
-#endif
-#if (defined(CERNLIB_IBMMVS))&&(defined(CERNLIB_DSYIBM))
-*
-* Assume available if file is catalogued
-*
- DSN = ' '
- CALL UHTOC(IQ(LFAT+KOFUFA+MFQNFA),4,DSN,NFQNFA)
- LDSN = LENOCC(DSN)
- CALL CUTOL(DSN(1:LDSN))
- INQUIRE(FILE='/'//DSN(1:LDSN),EXIST=IEXIST)
- IF(IEXIST) IDEV = 0
-#endif
-#if (defined(CERNLIB_VAXVMS))&&(defined(CERNLIB_VAXTAP))
-*
-* Check if this file is already staged ...
-*
- CALL FMITOC(IQ(LFAT+KOFUFA+MFSQFA),FSEQ,LFSEQ)
- CHFILE = VSN(1:LVSN)//'_'//VID(1:LVID)//'.'//
- + FSEQ(1:LFSEQ)//'_'//LABTYP(1:LENOCC(LABTYP))
- LFILE = LENOCC(CHFILE)
- ISIZE = IQ(LFAT+KOFUFA+MFSZFA)
- CALL FMSTGC(CHFILE(1:LFILE),ISIZE,JSIZE,ISTAGE)
- IF(ISTAGE.NE.0) THEN
- CALL FMGTLG('SETUP_'//MODEL(1:LM)//'S',EQUNAM,
- + 'LNM$SYSTEM',IDEV)
-*
-* If logical name does not exist, or in the case of remote
-* libraries, read also setup configuration file
-*
- INQUIRE(FILE='SETUP_EXE:TPSERV.CONF',EXIST=IEXIST)
- IF(IDEV.NE.0.AND.IEXIST) THEN
-
- ISTAT = LIB$GET_LUN(LUNTAP)
-#include "fatmen/fatvaxrc.inc"
- OPEN(LUNTAP,FILE='SETUP_EXE:TPSERV.CONF',
- + FORM='FORMATTED',STATUS='OLD',
- + READONLY,SHARED,IOSTAT=ISTAT)
-
- IF(ISTAT.NE.0) THEN
- IF(IDEBFA.GE.0) PRINT 9042,ISTAT
- 9042 FORMAT(' FMRZIN. cannot open TPSERV configuration file',
- + ' (SETUP_EXE:TPSERV.CONF), IOSTAT = ',I6)
-
- ELSE
-
- 40 CONTINUE
- READ(LUNTAP,'(A)',END=50) CHLINE
- LLINE = LENOCC(CHLINE)
- IF(ISTAT.NE.0) GOTO 50
-
- IF(INDEX(CHLINE(1:LLINE),'TPSERV').NE.0.AND.
- + INDEX(CHLINE(1:LLINE),MODEL(1:LM)).NE.0) THEN
- IDEV = 0
- GOTO 50
- ENDIF
-
- GOTO 40
- 50 CONTINUE
- CLOSE(LUNTAP)
- ENDIF
-
- ISTAT = LIB$FREE_LUN(LUNTAP)
-#include "fatmen/fatvaxrc.inc"
-
- ENDIF
- ENDIF
-#endif
-#if defined(CERNLIB_IBMVM)
-*
-* Node specific restrictions - hard coded until NAMES file
-* exists.
-*
- IF(HOST1(1:LH1).EQ.'CERNVMB'.AND.MODEL(1:LM)
- + .EQ.'SMCF') THEN
- IDEV = 1
- ELSE
- IDEV = 0
- ENDIF
-#endif
-#if (defined(CERNLIB_IBMVM))&&(defined(CERNLIB_SOMETIME))
-*
-* Read BATCH resource file
-*
- OPEN(LUFZFA,FORM='FORMATTED',ACCESS='SEQUENTIAL',
- + STATUS='OLD',IOSTAT=ISTAT,
- + FILE='/'//HOST1(1:LH1)// ' BATRES *')
- IF(ISTAT.NE.0) THEN
- IF(IDEBFA.GE.1) WRITE(LPRTFA,9043) HOST1(1:LH1)
- 9043 FORMAT(' FMRZIN. cannot open batch resource file ',A,
- + ' BATRES *')
- ELSE
- 60 CONTINUE
- CHLINE = ' '
- READ(LUFZFA,'(A)',END=70) CHLINE
- IF(INDEX(CHLINE(1:LENOCC(CHLINE)),MODEL(1:LM)).EQ.0)
- + GOTO 60
- IDEV = 0
- 70 CLOSE(LUFZFA)
- ENDIF
-#endif
-#if defined(CERNLIB_SHIFT)||defined(CERNLIB_CRAY)
-*
-* Read /etc/shift.conf file
-*
- INQUIRE(FILE=SHCONF(1:LSHCONF),EXIST=IEXIST)
- IF(IEXIST) THEN
- CALL CIOPEN(LUNPTR,'r',SHCONF(1:LSHCONF),ISTAT)
- IF(ISTAT.NE.0) THEN
- IF(IDEBFA.GE.0) WRITE(LPRTFA,9044) SHCONF(1:LSHCONF)
- 9044 FORMAT(' FMRZIN. cannot open SHIFT configuration file: ',A)
- ELSE
- 80 CONTINUE
- CALL FMCFGL(LUNPTR,CHLINE,LLINE,' ',ISTAT)
- IF(ISTAT.NE.0) GOTO 90
- IF(IDEBFA.GE.3) WRITE(LPRTFA,9045) CHLINE(1:LLINE),
- + SHCONF(1:LSHCONF)
- 9045 FORMAT(' FMRZIN. read line ',A,' from ',A)
- IF(INDEX(CHLINE(1:LLINE),'TPSERV').NE.0.AND.
- + INDEX(CHLINE(1:LLINE),MODEL(1:LM)).NE.0) THEN
- IDEV = 0
- GOTO 90
- ENDIF
- GOTO 80
- 90 CONTINUE
- CALL FMCFGL(LUNPTR,CHLINE,LLINE,'F',ISTAT)
- CALL CICLOS(LUNPTR)
- ENDIF
- ENDIF
-
-#endif
-#if defined(CERNLIB_SHIFT)
-*
-* If device type not found, check in local TPCONFIG file
-*
- IF(IDEV.NE.0) THEN
- INQUIRE(FILE=TPCONF(1:LTPCONF),EXIST=IEXIST)
- IF(IEXIST) THEN
- CALL CIOPEN(LUNPTR,'r',TPCONF(1:LTPCONF),ISTAT)
- IF(ISTAT.NE.0) THEN
- IF(IDEBFA.GE.0) WRITE(LPRTFA,9046) TPCONF(1:LTPCONF)
- 9046 FORMAT(' FMRZIN. cannot open tape daemon configuration file ',A)
- ELSE
- 100 CONTINUE
- CALL FMCFGL(LUNPTR,CHLINE,LLINE,' ',ISTAT)
- IF(ISTAT.NE.0) GOTO 110
- IF(IDEBFA.GE.3) WRITE(LPRTFA,9047) CHLINE(1:LLINE),
- + TPCONF(1:LTPCONF)
- 9047 FORMAT(' FMRZIN. read line ',A,' from ',A)
- IF(INDEX(CHLINE(1:LLINE),MODEL(1:LM)).NE.0) THEN
- IDEV = 0
- GOTO 110
- ENDIF
- GOTO 100
- 110 CONTINUE
- CALL FMCFGL(LUNPTR,CHLINE,LLINE,'F',ISTAT)
- CALL CICLOS(LUNPTR)
- ENDIF
- ENDIF
- ENDIF
-#endif
-#if defined(CERNLIB_UNIX)
-*
-* Assume all devices are available
-*
- IF(ICLIO.NE.0) IDEV = 0
-#endif
-#if defined(CERNLIB_APOLLO)
-*
-* Assume all devices are available
-*
- IF(IAPOL3.NE.0) IDEV = 0
-#endif
- IF(IDEV.NE.0) THEN
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9048) MODEL(1:LM)
- 9048 FORMAT(' FMRZIN. device type ',A,' not available on this node')
- GOTO 120
- ENDIF
-
- IF(MNTTYP.EQ.'R') THEN
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9049)
- 9049 FORMAT(' FMRZIN. found matching dataset on a robot tape')
- CALL FMUSEL(GENAME,LBANK,KEYSOU(1,I),ISEL)
- IF(ISEL.EQ.0) THEN
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9007)
- GOTO 140
- ELSE
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9008)
- ENDIF
- ENDIF
-*
-* Here we have a manually mounted tape
-* Save counter in case no robot tape found
-*
- CALL FMUSEL(GENAME,LBANK,KEYSOU(1,I),ISEL)
- IF(ISEL.EQ.0) THEN
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9007)
- IF(ISAVE.EQ.0) THEN
- ISAVE = I
- IFOUND(IMEDIA) = I
- ENDIF
- ELSE
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9008)
- ENDIF
- ENDIF
-
- 120 CONTINUE
-
- CALL MZDROP(IUDIV,LFAT,'L')
- LFAT = 0
-
- 130 CONTINUE
-*
-* Found a match for this media (manual tape or network disk)
-* - use it
-*
- IF(IFOUND(IMEDIA).NE.0) THEN
- I = IFOUND(IMEDIA)
- GOTO 140
- ENDIF
-
- IF(NUMMTP.EQ.0) THEN
- IMEDIA = IMEDIA + 1
- IF(IMEDIA.LE.IHIGH) GOTO 30
- ELSE
- ICOUNT = ICOUNT + 1
- IF(ICOUNT.LE.NUMMTP) THEN
- IMEDIA = MFMMTP(ICOUNT)
- GOTO 30
- ENDIF
- ENDIF
-*100 CONTINUE
-
- IF(JSAVE.NE.0) THEN
-*!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-*
-* The following +SELF is ONLY to avoid compiler warnings on IBM systems
-* running VS FORTRAN 2.5 (or above, presumably) and MUST BE DELETED
-* when an appropriate client is available (e.g. FPACK, NFS, etc.)
-*
-*!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-#if !defined(CERNLIB_IBM)||defined(CERNLIB_FPACK)
- I = JSAVE
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9050)
- 9050 FORMAT(' FMRZIN. found matching dataset on served disk')
- CALL FMUSEL(GENAME,LBANK,KEYSOU(1,I),ISEL)
- IF(ISEL.EQ.0) THEN
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9007)
- GOTO 140
- ELSE
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9008)
- ENDIF
-*
-*!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-*
-#endif
- ELSEIF(ISAVE.NE.0) THEN
- I = ISAVE
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9051)
- 9051 FORMAT(' FMRZIN. found matching dataset on a manual tape')
- GOTO 140
-
- ELSE
-*
-* No match, error
-*
- IQUEST(1) = 14
- IF(ICODE.NE.0) IQUEST(1) = ICODE
- IF (IDEBFA.GE.-3) WRITE (LPRTFA, 9057)
- + PATHN(1:NCH)//'/'//FNAME(1:NCHN)
- GOTO 999
- ENDIF
-*
-* Have got a matching data set, ok
-
- 140 CONTINUE
- CALL MZDROP(IUDIV,LFAT,'L')
- LFAT = 0
- CALL UCOPY(KEYSOU(1,I),KEYS,10)
-
- ENDIF
-
- ICYCL = 9999
- IF(IDEBFA.GE.3) THEN
- WRITE(LPRTFA,9052)
- 9052 FORMAT(' FMRZIN. attempting retrieval of entry with following',
- + ' KEYS vector')
- CALL FMPKEY(KEYS,LKEYFA)
- ENDIF
- NRETRY = 0
- 150 CONTINUE
- CALL RZIN(IUDIV, LSUP, JBIAS, KEYS, ICYCL, ' ')
- NFBANK = NFBANK + 1
- IF(IQUEST(1).NE.0) THEN
-
- IF(IDEBFA.GE.-3) THEN
- WRITE (LPRTFA, 9056) IQUEST(1),PATHN(1:NCH)
- CALL FMSHOK('Object: ',KEYS,LKEYFA)
- ENDIF
-
- IQUEST(1) = 13
-*
-* If full keys vector was specified, retry up to 5 times
-*
- IF(IFLAG.EQ.1.AND.NRETRY.LT.5) THEN
- NRETRY = NRETRY + 1
- CALL SLEEPF(1)
- CALL RZCDIR(PATHN(1:NCH),'U')
- IF(IDEBFA.GE.0) WRITE(LPRTFA,9053) NRETRY
- 9053 FORMAT(' FMRZIN. retry # ',I10)
- GOTO 150
- ENDIF
- ELSE
- IF(IDEBFA.GE.2) THEN
- CALL RZDATE(IQUEST(14),IDATE,ITIME,1)
- PRINT 9058,(IQUEST(I),I=2,4)
- PRINT 9059,(IQUEST(I),I=5,8)
- PRINT 9060,IQUEST(12),IDATE,ITIME,IQUEST(20)
- ENDIF
- ENDIF
-
- NTRY = NTRY + 1
- IF(NTRY.LE.MAXTRY) THEN
-*
-* Check that directory has not been modified
-*
- CALL FACDIR (PATHN, 'U')
- IF(IQUEST(16).GT.IDATEM) THEN
- IF(IDEBFA.GE.1) WRITE(LPRTFA,9061) PATHN(1:NCH),NTRY,NSECS
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9062) IDATEM,ITIMEM
- CALL SLEEPF(NSECS)
- GOTO 10
- ENDIF
-
- IF(IQUEST(16).EQ.IDATEM.AND.IQUEST(17).GT.ITIMEM) THEN
- IF(IDEBFA.GE.1) WRITE(LPRTFA,9061) PATHN(1:NCH),NTRY,NSECS
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9062) IDATEM,ITIMEM
- CALL SLEEPF(NSECS)
- GOTO 10
- ENDIF
- ENDIF
-*
- 9054 FORMAT (' FMRZIN. Illegal path name ',A)
- 9055 FORMAT (' FMRZIN. RZ file is not initialized for ',A)
- 9056 FORMAT (' FMRZIN. Error ',I10,' in RZIN for directory ',A)
- 9057 FORMAT (' FMRZIN. No match for ',A,
- + ' found with current selection')
- 9058 FORMAT (' FMRZIN. # records read = ',I3,' rec1 = ',I5,
- + ' offset = ',I4)
- 9059 FORMAT (' FMRZIN. rec2 = ',I5,' icycle = ',I6,' nkeys = ',
- + I4,' nwkey = ',I3)
- 9060 FORMAT (' FMRZIN. nwbk = ',I3,' date/time = ',
- + I6,1X,I4,' ksn = ',I6)
- 9061 FORMAT (' FMRZIN. directory ',A,' modified during processing ',
- + '- retry # ',I3,' in ',I3,' seconds')
- 9062 FORMAT (' FMRZIN. modification date/time = ',I6.6,1X,I4.4)
- 9063 FORMAT (' FMRZIN. LIB$FIND_FILE for ',A,
- + ' failed with status ',Z8/,' error message ',A)
-* END FMRZIN
- 999 END
-
diff --git a/src/packlib/fatmen/fatbody/ftrend.F b/src/packlib/fatmen/fatbody/ftrend.F
deleted file mode 100644
index a3fd4ed..0000000
--- a/src/packlib/fatmen/fatbody/ftrend.F
+++ /dev/null
@@ -1,108 +0,0 @@
-*
-* $Id: ftrend.F,v 1.1.1.1 1996/03/07 15:18:01 mclareni Exp $
-*
-* $Log: ftrend.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:01 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FTREND (PATH)
-*
-************************************************************************
-*
-* SUBR. FTREND (PATH)
-*
-* Closes one output stream
-*
-* Arguments :
-*
-* PATH Path name of the directory
-*
-* Called by User
-*
-* Error Condition :
-*
-* IQUEST(1) = 0 : No error
-* = 31 : Illegal Path name
-* = 32 : Path name cannot be found in the list of those
-* initialized
-*
-************************************************************************
-*
-#include "fatmen/fatbank.inc"
- CHARACTER PATH*(*), PATHX*80, TOPN*16
-*
-* ------------------------------------------------------------------
-*
-* *** Find number of characters in the path name
-*
- NCH = LENOCC (PATH)
- IF (PATH(1:1).NE.'*') THEN
- IF (NCH.LT.3.OR.PATH(1:2).NE.'//') THEN
- IQUEST(1) = 31
- IF (IDEBFA.GE.-3) WRITE (LPRTFA, 1001) PATH(1:NCH)
- GO TO 999
- ENDIF
- ENDIF
-*
-* *** Check if the Path name matches
-*
- 5 LSAVFA = LTOPFA
- 10 IF (LSAVFA.NE.0) THEN
- NCHR = IQ(KOFUFA+LSAVFA+MNCHFA)
- CALL UHTOC (IQ(KOFUFA+LSAVFA+MCHRFA), 4, PATHX, NCHR)
- IF (PATH(1:1).EQ.'*') GO TO 15
- IF (PATH(1:NCH).NE.PATHX(1:NCHR)) THEN
- LSAVFA = LQ(KOFUFA+LSAVFA)
- GO TO 10
- ENDIF
- ELSE
- IQUEST(1) = 32
- IF (IDEBFA.GE.-3) WRITE (LPRTFA, 1002) PATH(1:NCH)
- GO TO 999
- ENDIF
-*
-* *** See if any other stream open with the same RZ file
-*
- 15 LUNRZ = IQ(KOFUFA+LSAVFA+MLUNFA)
- IROPN = 0
- LBFXFA = LTOPFA
- 20 IF (LBFXFA.NE.0) THEN
- IF (LBFXFA.NE.LSAVFA) THEN
- IF (IQ(KOFUFA+LBFXFA+MLUNFA).EQ.LUNRZ) THEN
- IROPN = 1
- GO TO 30
- ENDIF
- ENDIF
- LBFXFA = LQ(KOFUFA+LBFXFA)
- GO TO 20
- ENDIF
-*
-* *** Print out summary
-*
- 30 WRITE (LPRTFA,1000) PATHX(1:NCHR), LUNRZ, IQ(KOFUFA+LSAVFA+MTOTFA)
- + , IQ(KOFUFA+LSAVFA+MINPFA), IQ(KOFUFA+LSAVFA+MOUTFA)
- IF (IROPN.EQ.0) THEN
- II = INDEX (PATHX(3:NCHR), '/') - 1
- IF (II.LE.0) THEN
- II = NCHR
- ELSE
- II = II + 2
- ENDIF
- TOPN = PATHX(3:II)
- CALL RZEND (TOPN)
- ENDIF
- CALL MZDROP (IDIVFA, LSAVFA, ' ')
- LSAVFA = 0
- IF (LTOPFA.NE.0.AND.PATH(1:1).EQ.'*') GO TO 5
-*
- 1000 FORMAT (/,' FTREND : Close stream for ',A,' on unit ',I4,
- + /,' Total number of data structures ',I10,
- + /,' Number of data structures read ',I10,
- + /,' Number of data structures written ',I10)
- 1001 FORMAT (/,' FTREND : Illegal path name ',A)
- 1002 FORMAT (/,' FTREND : RZ file is not initialized for ',A)
-* END FTREND
- 999 END
-
diff --git a/src/packlib/fatmen/fatmen/Imakefile b/src/packlib/fatmen/fatmen/Imakefile
deleted file mode 100644
index 1e75742..0000000
--- a/src/packlib/fatmen/fatmen/Imakefile
+++ /dev/null
@@ -1,23 +0,0 @@
-INCLUDES= cheops.inc czsock.inc dtmpak.inc errcray.inc errno.inc \ @@\
- errsgi.inc fabalq.inc facard.inc faexcm.inc fafccm.inc \ @@\
- fahucm.inc falncm.inc falscm.inc famucm.inc farnge.inc \ @@\
- farstg.inc fasecm.inc faspac.inc fat.inc fatanf.inc \ @@\
- fatapol3.inc fatbank.inc fatbeg.inc fatbug.inc fatcdes.inc \ @@\
- fatchar.inc fatclio.inc fatcpl.inc fatdcb.inc fatdummy.inc \ @@\
- fatform.inc fatform0.inc fatform1.inc fatget.inc fatinfo.inc \ @@\
- fatinit.inc fatkey.inc fatlab.inc fatlab0.inc fatlab1.inc \ @@\
- fatlcc.inc fatlnk.inc fatloc.inc fatlun.inc fatmed.inc \ @@\
- fatmed0.inc fatmed1.inc fatmon.inc fatmss.inc fatmtp.inc \ @@\
- fatnet.inc fatopt0.inc fatopt1.inc fatoptc.inc fatoptd.inc \ @@\
- fatopts.inc fatoset.inc fatout.inc fatpara.inc fatran.inc \ @@\
- fatran0.inc fatran1.inc fatreg.inc fatron.inc fatsat.inc \ @@\
- fatsat0.inc fatsat1.inc fatschl.inc fatsea.inc fatsel.inc \ @@\
- fatshift.inc fatsho.inc fatstat.inc fatstg.inc fatstruct.inc \ @@\
- fatsys.inc fattyp.inc fatupd.inc fatuse.inc fatusr.inc \ @@\
- fatuwd.inc fatvaxrc.inc fatveri.inc fatvid0.inc fatvid1.inc fatvidp.inc \ @@\
- faust.inc fausto.inc fmaxcop.inc fmdrep.inc fmnkeys.inc \ @@\
- fmpath.inc fmqued.inc fmshft.inc fstate.inc fttbug.inc \ @@\
- fttpara.inc qftitlch.inc slate.inc slatex.inc tmsdef.inc \ @@\
- tmsdef0.inc tmsdef1.inc tmsrep.inc pilot.h
-
-InstallIncludes($(INCLUDES),$(CERN_INCLUDEDIR),fatmen)
diff --git a/src/packlib/fatmen/fatmen/cheops.inc b/src/packlib/fatmen/fatmen/cheops.inc
deleted file mode 100644
index 83e08d4..0000000
--- a/src/packlib/fatmen/fatmen/cheops.inc
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: cheops.inc,v 1.1.1.1 1996/03/07 15:17:52 mclareni Exp $
-*
-* $Log: cheops.inc,v $
-* Revision 1.1.1.1 1996/03/07 15:17:52 mclareni
-* Fatmen
-*
-*
-#ifndef CERNLIB_FATMEN_CHEOPS_INC
-#define CERNLIB_FATMEN_CHEOPS_INC
-*
-*
-* cheops.inc
-*
-*
-* CHEOPS error messages
-*
- PARAMETER (NKEOPS=5)
- CHARACTER*80 MKEOPS(NKEOPS)
- DATA MKEOPS(1)/'Inquire on dataset failed'/,
- + MKEOPS(2)/'Dataset not regular'/,
- + MKEOPS(3)/'Cannot open dataset'/,
- + MKEOPS(4)/'Cannot close dataset'/,
- + MKEOPS(5)/'Transaction expired'/
-*define CC_OK 0
-*define CC_STATONDATASETFAILS 1
-*define CC_DATASETNOTREGULAR 2
-*define CC_CANNOTOPENDATASET 3
-*define CC_CANNOTCLOSEDATASET 4
-*define CC_TRANSACTIONEXPIRED 5
-
-#endif
diff --git a/src/packlib/fatmen/fatmen/czsock.inc b/src/packlib/fatmen/fatmen/czsock.inc
deleted file mode 100644
index 80f276e..0000000
--- a/src/packlib/fatmen/fatmen/czsock.inc
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: czsock.inc,v 1.1.1.1 1996/03/07 15:17:53 mclareni Exp $
-*
-* $Log: czsock.inc,v $
-* Revision 1.1.1.1 1996/03/07 15:17:53 mclareni
-* Fatmen
-*
-*
-#ifndef CERNLIB_FATMEN_CZSOCK_INC
-#define CERNLIB_FATMEN_CZSOCK_INC
-*
-*
-* czsock.inc
-*
- COMMON/CZSOCK/LUNCZ,IADTCP,LBUF,ISKIN,ISKOUT,IPROT,
- + JUNIT(99),JSKIN(99),JSKOUT(99),CUNODE,
- + CHNODE(99),CHUSER(99)
- CHARACTER*12 CHNODE,CUNODE,CHUSER
- PARAMETER (LNODE=12)
- PARAMETER (LUSER=12)
- PARAMETER (MAXSOC=99)
-*
-* IPROT: 0 - TCP/IP (TCPAW)
-* 1 - DECnet (included in CZ)
-* CHNODE & CHUSER store the node and user names that correspond
-* to JUNIT
-*
-
-#endif
diff --git a/src/packlib/fatmen/fatmen/dtmpak.inc b/src/packlib/fatmen/fatmen/dtmpak.inc
deleted file mode 100644
index 7275e5a..0000000
--- a/src/packlib/fatmen/fatmen/dtmpak.inc
+++ /dev/null
@@ -1,20 +0,0 @@
-#ifndef CERNLIB_FATMEN_DTMPAK_INC
-#define CERNLIB_FATMEN_DTMPAK_INC
-*
-* dtmpak.inc
-*
- PARAMETER (MXSEC=61, MXMIN=61, MXHOU=25, MXDAY=32, MXMON=13)
-* From 1980 to 2010 ==> 31 Years
- PARAMETER (MXYER=31, ITPLY=1)
- INTEGER IDAYY(MXYER), IDAYM(12,2)
- SAVE IDAYY, IDAYM
- DATA IDAYY / 366, 731, 1096, 1461, 1827, 2192, 2557,
- 1 2922, 3288, 3653, 4018, 4383, 4749, 5114,
- 2 5479, 5844, 6210, 6575, 6940, 7305, 7671,
- 3 8036, 8401, 8766, 9132, 9497, 9682,10227,
- 4 10593,10958,11323/
- DATA IDAYM / 0, 31, 59, 90, 120, 151, 181, 212, 243,
- 1 273, 304, 334, 0, 31, 60, 91, 121, 152,
- 2 182, 213, 244, 274, 305, 335/
-*
-#endif
diff --git a/src/packlib/fatmen/fatmen/errcray.inc b/src/packlib/fatmen/fatmen/errcray.inc
deleted file mode 100644
index 7ceefd8..0000000
--- a/src/packlib/fatmen/fatmen/errcray.inc
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: errcray.inc,v 1.1.1.1 1996/03/07 15:17:54 mclareni Exp $
-*
-* $Log: errcray.inc,v $
-* Revision 1.1.1.1 1996/03/07 15:17:54 mclareni
-* Fatmen
-*
-*
-#ifndef CERNLIB_FATMEN_ERRCRAY_INC
-#define CERNLIB_FATMEN_ERRCRAY_INC
-*
-*
-* errcray.inc
-*
-*define ECONNRESET 145 /* Connection reset by peer */
-*define ETIMEDOUT 151 /* Connection timed out */
-*define ECONNREFUSED 152 /* Connection refused */
- IFATRC(1)=145
- IFATRC(2)=151
- IFATRC(3)=152
- IFATRC(4)=3
- IRETRY(1)=60
- IRETRY(2)=5
- IRETRY(3)=5
- IRETRY(4)=60
-
-#endif
diff --git a/src/packlib/fatmen/fatmen/errno.inc b/src/packlib/fatmen/fatmen/errno.inc
deleted file mode 100644
index 973d00e..0000000
--- a/src/packlib/fatmen/fatmen/errno.inc
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: errno.inc,v 1.1.1.1 1996/03/07 15:17:53 mclareni Exp $
-*
-* $Log: errno.inc,v $
-* Revision 1.1.1.1 1996/03/07 15:17:53 mclareni
-* Fatmen
-*
-*
-#ifndef CERNLIB_FATMEN_ERRNO_INC
-#define CERNLIB_FATMEN_ERRNO_INC
-*
-*
-* errno.inc
-*
-*
-* Extract from /usr/include/sys/errno.h
-* or sys$library:errno.h
-*
-*define ECONNRESET 54 /* Connection reset by peer */
-*define ETIMEDOUT 60 /* Connection timed out */
-*define ECONNREFUSED 61 /* Connection refused */
- IFATRC(1)=54
- IFATRC(2)=60
- IFATRC(3)=61
- IFATRC(4)=3
- IRETRY(1)=60
- IRETRY(2)=5
- IRETRY(3)=5
- IRETRY(4)=60
-
-#endif
diff --git a/src/packlib/fatmen/fatmen/errsgi.inc b/src/packlib/fatmen/fatmen/errsgi.inc
deleted file mode 100644
index 4fd10dd..0000000
--- a/src/packlib/fatmen/fatmen/errsgi.inc
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: errsgi.inc,v 1.1.1.1 1996/03/07 15:17:54 mclareni Exp $
-*
-* $Log: errsgi.inc,v $
-* Revision 1.1.1.1 1996/03/07 15:17:54 mclareni
-* Fatmen
-*
-*
-#ifndef CERNLIB_FATMEN_ERRSGI_INC
-#define CERNLIB_FATMEN_ERRSGI_INC
-*
-*
-* errsgi.inc
-*
-*define ECONNRESET 120 /* Connection reset by peer */
-*define ETIMEDOUT 126 /* Connection timed out */
-*define ECONNREFUSED 127 /* Connection refused */
- IFATRC(1)=120
- IFATRC(2)=126
- IFATRC(3)=127
- IFATRC(4)=3
- IRETRY(1)=60
- IRETRY(2)=5
- IRETRY(3)=5
- IRETRY(4)=60
-
-#endif
diff --git a/src/packlib/fatmen/fatmen/fabalq.inc b/src/packlib/fatmen/fatmen/fabalq.inc
deleted file mode 100644
index d3fd4af..0000000
--- a/src/packlib/fatmen/fatmen/fabalq.inc
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: fabalq.inc,v 1.1.1.1 1996/03/07 15:17:59 mclareni Exp $
-*
-* $Log: fabalq.inc,v $
-* Revision 1.1.1.1 1996/03/07 15:17:59 mclareni
-* Fatmen
-*
-*
-#ifndef CERNLIB_FATMEN_FABALQ_INC
-#define CERNLIB_FATMEN_FABALQ_INC
-*
-*
-* fabalq.inc
-*
- COMMON/FABALQ/NBLOKS
-
-#endif
diff --git a/src/packlib/fatmen/fatmen/facard.inc b/src/packlib/fatmen/fatmen/facard.inc
deleted file mode 100644
index 52e7618..0000000
--- a/src/packlib/fatmen/fatmen/facard.inc
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: facard.inc,v 1.1.1.1 1996/03/07 15:17:52 mclareni Exp $
-*
-* $Log: facard.inc,v $
-* Revision 1.1.1.1 1996/03/07 15:17:52 mclareni
-* Fatmen
-*
-*
-#ifndef CERNLIB_FATMEN_FACARD_INC
-#define CERNLIB_FATMEN_FACARD_INC
-*
-*
-* facard.inc
-*
- COMMON/FACARD/IWIDTH,CARD
- CHARACTER*132 CARD
-
-#endif
diff --git a/src/packlib/fatmen/fatmen/faexcm.inc b/src/packlib/fatmen/fatmen/faexcm.inc
deleted file mode 100644
index 64d1a32..0000000
--- a/src/packlib/fatmen/fatmen/faexcm.inc
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: faexcm.inc,v 1.1.1.1 1996/03/07 15:17:54 mclareni Exp $
-*
-* $Log: faexcm.inc,v $
-* Revision 1.1.1.1 1996/03/07 15:17:54 mclareni
-* Fatmen
-*
-*
-#ifndef CERNLIB_FATMEN_FAEXCM_INC
-#define CERNLIB_FATMEN_FAEXCM_INC
-*
-* For FMEXTR
-*
-* faexcm.inc
-*
- COMMON/FAEXCM/NFILES,NBAD
-#include "fatmen/fatoptd.inc"
-
-#endif
diff --git a/src/packlib/fatmen/fatmen/fafccm.inc b/src/packlib/fatmen/fatmen/fafccm.inc
deleted file mode 100644
index 783c831..0000000
--- a/src/packlib/fatmen/fatmen/fafccm.inc
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: fafccm.inc,v 1.1.1.1 1996/03/07 15:17:55 mclareni Exp $
-*
-* $Log: fafccm.inc,v $
-* Revision 1.1.1.1 1996/03/07 15:17:55 mclareni
-* Fatmen
-*
-*
-#ifndef CERNLIB_FATMEN_FAFCCM_INC
-#define CERNLIB_FATMEN_FAFCCM_INC
-*
-* For FMFC
-*
-* fafccm.inc
-*
- COMMON/FAFCCM/LWRITE,IOPTD,IOPTF,IOPTL,IOPTZ,
- + NFOUND,NMATCH,NDIRT,CHFILE
- CHARACTER*20 CHFILE
-
-#endif
diff --git a/src/packlib/fatmen/fatmen/fahucm.inc b/src/packlib/fatmen/fatmen/fahucm.inc
deleted file mode 100644
index 2e7f094..0000000
--- a/src/packlib/fatmen/fatmen/fahucm.inc
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: fahucm.inc,v 1.1.1.1 1996/03/07 15:17:54 mclareni Exp $
-*
-* $Log: fahucm.inc,v $
-* Revision 1.1.1.1 1996/03/07 15:17:54 mclareni
-* Fatmen
-*
-*
-#ifndef CERNLIB_FATMEN_FAHUCM_INC
-#define CERNLIB_FATMEN_FAHUCM_INC
-*
-* For FMHUNT
-*
-* fahucm.inc
-*
-#include "fatmen/fmnkeys.inc"
- COMMON/FAHUCM/KEYH(LKEYFA),CHFILE
- CHARACTER*255 CHFILE
-
-#endif
diff --git a/src/packlib/fatmen/fatmen/falncm.inc b/src/packlib/fatmen/fatmen/falncm.inc
deleted file mode 100644
index f2ac698..0000000
--- a/src/packlib/fatmen/fatmen/falncm.inc
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: falncm.inc,v 1.1.1.1 1996/03/07 15:17:54 mclareni Exp $
-*
-* $Log: falncm.inc,v $
-* Revision 1.1.1.1 1996/03/07 15:17:54 mclareni
-* Fatmen
-*
-*
-#ifndef CERNLIB_FATMEN_FALNCM_INC
-#define CERNLIB_FATMEN_FALNCM_INC
-*
-* For FMRMLN/FALN
-*
-* falncm.inc
-*
- COMMON/FALNCM/LWRITE,NLINKS,NFILES,IOPTTD,IOPTTF,IOPTTP,IOPTTR
-
-#endif
diff --git a/src/packlib/fatmen/fatmen/falscm.inc b/src/packlib/fatmen/fatmen/falscm.inc
deleted file mode 100644
index b05dbea..0000000
--- a/src/packlib/fatmen/fatmen/falscm.inc
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: falscm.inc,v 1.1.1.1 1996/03/07 15:17:55 mclareni Exp $
-*
-* $Log: falscm.inc,v $
-* Revision 1.1.1.1 1996/03/07 15:17:55 mclareni
-* Fatmen
-*
-*
-#ifndef CERNLIB_FATMEN_FALSCM_INC
-#define CERNLIB_FATMEN_FALSCM_INC
-*
-* For FMLS(C)
-*
-* falscm.inc
-*
- COMMON/FALSCM/LWRITE,NFILES,NFILT,NDIRT,IOPT,CHFILE
- CHARACTER*20 CHFILE
-#include "fatmen/fatoptd.inc"
-
-#endif
diff --git a/src/packlib/fatmen/fatmen/famucm.inc b/src/packlib/fatmen/fatmen/famucm.inc
deleted file mode 100644
index 2b9af5c..0000000
--- a/src/packlib/fatmen/fatmen/famucm.inc
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: famucm.inc,v 1.1.1.1 1996/03/07 15:17:54 mclareni Exp $
-*
-* $Log: famucm.inc,v $
-* Revision 1.1.1.1 1996/03/07 15:17:54 mclareni
-* Fatmen
-*
-*
-#ifndef CERNLIB_FATMEN_FAMUCM_INC
-#define CERNLIB_FATMEN_FAMUCM_INC
-*
-* For FMMODU
-*
-* famucm.inc
-*
- COMMON/FAMUCM/IOPT,IWORDS(10),CHUCOM,CHUFRM,CHFILE
- CHARACTER*80 CHUCOM
- CHARACTER*4 CHUFRM
- CHARACTER*20 CHFILE
-#include "fatmen/fatoptd.inc"
-
-#endif
diff --git a/src/packlib/fatmen/fatmen/farnge.inc b/src/packlib/fatmen/fatmen/farnge.inc
deleted file mode 100644
index 2aee495..0000000
--- a/src/packlib/fatmen/fatmen/farnge.inc
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: farnge.inc,v 1.1.1.1 1996/03/07 15:17:54 mclareni Exp $
-*
-* $Log: farnge.inc,v $
-* Revision 1.1.1.1 1996/03/07 15:17:54 mclareni
-* Fatmen
-*
-*
-#ifndef CERNLIB_FATMEN_FARNGE_INC
-#define CERNLIB_FATMEN_FARNGE_INC
-*
-*
-* farnge.inc
-*
-* NFRNGE - range count (e.g. [8:10] = 3)
-* IFRNGE - 8,9,10 (in previous example)
- COMMON/FARNGE/NFRNGE(20),IFRNGE(100,20),
- + IFELEM(100,20),IFVAL(100,20)
-
-#endif
diff --git a/src/packlib/fatmen/fatmen/farstg.inc b/src/packlib/fatmen/fatmen/farstg.inc
deleted file mode 100644
index 2f0d2ac..0000000
--- a/src/packlib/fatmen/fatmen/farstg.inc
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: farstg.inc,v 1.1.1.1 1996/03/07 15:17:53 mclareni Exp $
-*
-* $Log: farstg.inc,v $
-* Revision 1.1.1.1 1996/03/07 15:17:53 mclareni
-* Fatmen
-*
-*
-#ifndef CERNLIB_FATMEN_FARSTG_INC
-#define CERNLIB_FATMEN_FARSTG_INC
-*
-*
-* farstg.inc
-*
-*
-* Wait time for remote job:
-* IWTNET - time to wait if network is down
-* IWTACK - time for acknowledgement
-* IWTPND - time when entry is pending
-* IWTEXE - time when entry is executing
-*
- COMMON/FARSTG/IWTNET,IWTACK,IWTPND,IWTEXE,MAXNET,MAXACK
-
-#endif
diff --git a/src/packlib/fatmen/fatmen/fasecm.inc b/src/packlib/fatmen/fatmen/fasecm.inc
deleted file mode 100644
index 525778e..0000000
--- a/src/packlib/fatmen/fatmen/fasecm.inc
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: fasecm.inc,v 1.1.1.1 1996/03/07 15:17:55 mclareni Exp $
-*
-* $Log: fasecm.inc,v $
-* Revision 1.1.1.1 1996/03/07 15:17:55 mclareni
-* Fatmen
-*
-*
-#ifndef CERNLIB_FATMEN_FASECM_INC
-#define CERNLIB_FATMEN_FASECM_INC
-*
-* For FMSEAC
-*
-* fasecm.inc
-*
- COMMON/FASECM/LWRITE,NFILES,NDIRS,NMATCH,IOPT,
- + LDSN,LHOST,LVID,LUSER,LFORM,LCOMM,LSTR,
- + DSN,HOST,VID,USER,CHFILE,UFORM,COMM,CHSTR
- CHARACTER*255 CHFILE,CHSTR
- CHARACTER*255 HOST,VID,USER
- CHARACTER*255 DSN,UFORM,COMM
-#include "fatmen/fatoptd.inc"
-
-#endif
diff --git a/src/packlib/fatmen/fatmen/faspac.inc b/src/packlib/fatmen/fatmen/faspac.inc
deleted file mode 100644
index 1099cfe..0000000
--- a/src/packlib/fatmen/fatmen/faspac.inc
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: faspac.inc,v 1.1.1.1 1996/03/07 15:17:53 mclareni Exp $
-*
-* $Log: faspac.inc,v $
-* Revision 1.1.1.1 1996/03/07 15:17:53 mclareni
-* Fatmen
-*
-*
-#ifndef CERNLIB_FATMEN_FASPAC_INC
-#define CERNLIB_FATMEN_FASPAC_INC
-*
-*
-* faspac.inc
-*
- COMMON/FASPAC/NPRIFA,NSECFA
-
-#endif
diff --git a/src/packlib/fatmen/fatmen/fat.inc b/src/packlib/fatmen/fatmen/fat.inc
deleted file mode 100644
index b50c93c..0000000
--- a/src/packlib/fatmen/fatmen/fat.inc
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: fat.inc,v 1.1.1.1 1996/03/07 15:17:54 mclareni Exp $
-*
-* $Log: fat.inc,v $
-* Revision 1.1.1.1 1996/03/07 15:17:54 mclareni
-* Fatmen
-*
-*
-#ifndef CERNLIB_FATMEN_FAT_INC
-#define CERNLIB_FATMEN_FAT_INC
-*
-*
-* fat.inc
-*
- PARAMETER (LURCOR=200000)
- COMMON/FAT/IXSTOR,IXDIV,IFENCE(2),LEV,LEVIN,BLVECT(LURCOR)
- DIMENSION LQ(999),IQ(999),Q(999)
- EQUIVALENCE (IQ(1),Q(1),LQ(9)),(LQ(1),LEV)
-
-#endif
diff --git a/src/packlib/fatmen/fatmen/fatanf.inc b/src/packlib/fatmen/fatmen/fatanf.inc
deleted file mode 100644
index 5e7b651..0000000
--- a/src/packlib/fatmen/fatmen/fatanf.inc
+++ /dev/null
@@ -1,157 +0,0 @@
-*
-* $Id: fatanf.inc,v 1.1.1.1 1996/03/07 15:17:59 mclareni Exp $
-*
-* $Log: fatanf.inc,v $
-* Revision 1.1.1.1 1996/03/07 15:17:59 mclareni
-* Fatmen
-*
-*
-#ifndef CERNLIB_FATMEN_FATANF_INC
-#define CERNLIB_FATMEN_FATANF_INC
-*
-*
-* fatanf.inc
-*
-#if defined(CERNLIB_IBMMVS)
- MACRO
-&NAME ANF &ID,&MODE=REUS,&WKSIZE=0,&SP=0,&BASE=12
- GBLC &DY0ID,&MD
- LCLA &A,&B,&D
- LCLC &E,&F
-&F SETC '&SYSNDX'
-&MD SETC '&MODE'
-* ANF VERSION 2.4 (SUPPORTS PRNT MACRO AND EQUATED WORKSIZE)
-.* DIE VORIGE VERSION HEISST ANF8
- AIF ((T'&WKSIZE NE 'N') AND (T'&WKSIZE NE 'U')).ERROR4
- AIF (T'&SP NE 'N').ERROR5
- AIF (&SP GT 255).ERROR6
- AIF (T'&BASE NE 'N').ERROR7
- AIF ((&BASE GT 12) OR (&BASE LT 4)).ERROR8
- AIF ('&MODE' NE 'REUS').RENT
- AIF ('&ID' EQ '').NULLID
- AIF ('&ID' EQ '*').SPECID
-&D SETA K'&ID
- AIF (&D GT 8).ERROR1
-&A SETA ((K'&ID+4)/4)*4+80
-&E SETC '&ID'
- CNOP 0,4
-&NAME B &A.(0,15) BRANCH AROUND ID AND SA
- DC AL1(&D) LENGTH OF ID
- DC CL&D'&E'
- AGO .CONTA
-.NULLID ANOP
- CNOP 0,4
-&NAME B 80(0,15) BRANCH AROUND SA
- AGO .CONTA
-.SPECID AIF ('&NAME' EQ '').CSECTN
-&E SETC '&NAME'
-&A SETA 1
-.CONTB AIF ('&E'(1,&A) EQ '&E').CONTC
-&A SETA &A+1
- AGO .CONTB
-.CONTC ANOP
- AIF ('&MODE' EQ 'RENT').CONTE
-&B SETA ((&A+4)/4)*4+80
- CNOP 0,4
-&NAME B &B.(0,15) BRANCH AROUND ID AND SA
- DC AL1(&A) LENGTH OF ID
- DC CL&A'&E'
- AGO .CONTA
-.CSECTN AIF ('&SYSECT' EQ '').ERROR2
-&E SETC '&SYSECT'
-&A SETA 1
- AGO .CONTB
-.ERROR2 MNOTE 12,'CSECT NAME NOT SPECIFIED'
- AGO .NULLID
-.CONTA ANOP
-&DY0ID SETC '&SYSNDX'
-SAVE&F DC 19F'0' SAVE AREA
- STM 14,12,12(13) SAVE CALLER'S REGISTER
- LR &BASE,15 LOAD BASE
- LA 3,SAVE&F ADDRESS OF NEW SAVE AREA
- ST 3,8(13) FORWARD CHAIN
- L 3,32(13) RESTORE REG 3
- ST 13,SAVE&F.+4 BACKWARD CHAIN
- LA 13,SAVE&F LOAD SAVE AREA REG
- MEXIT
-.ERROR1 MNOTE 12,'IDENTIFICATION FIELD TOO LONG'
- MEXIT
-.RENT ANOP
- AIF ('&MODE' NE 'RENT').ERROR3
- AIF ('&ID' EQ '').RNULL
- AIF ('&ID' EQ '*').SPECID
-&D SETA K'&ID
- AIF (&D GT 8).ERROR1
-&A SETA ((&D+2)/2)*2+4
-&E SETC '&ID'
-&NAME B &A.(0,15) BRANCH AROUND ID
- DC AL1(&D) LENGTH OF ID
- DC CL&D'&E'
- STM 14,12,12(13) SAVE CALLER'S REGISTER
- AGO .CONTD
-.RNULL ANOP
-&NAME STM 14,12,12(13) SAVE CALLER'S REGISTER
- AGO .CONTD
-.CONTE ANOP
-&B SETA ((&A+2)/2)*2+4
-&NAME B &B.(0,15) BRANCH AROUND ID
- DC AL1(&A) LENGTH OF ID
- DC CL&A'&E'
- STM 14,12,12(13) SAVE CALLER'S REGISTER
-.CONTD ANOP
- LR &BASE,15 LOAD BASE
- CNOP 0,4 ALIGN ON FULL WORD BOUNDARY
- BAL 1,*+8 BRANCH AROUND SUBPOOL AND LENGTH
- DC AL1(&SP) SUBPOOL ID
- DC AL3(&WKSIZE+88) LENGTH VALUE
- L 0,0(0,1) LOAD SP AND LENGTH
- SVC 10 ISSUE GETMAIN SVC
- XC 0(88,1),0(1) CLEAR CHAIN FIELDS AND SAVE AREA
- MVI 8(1),X'FF' INDICATE LAST ON CHAIN
- MVC 12(4,1),*-20 SAVE LENGTH AN SUBPOOL
- MVC 0(4,1),12(13)
- LA 15,FR&F
- ST 15,12(13)
- ST 13,20(1) BACKWARD CHAIN
- LR 15,13 SAVE OLD SAVE AREA POINTER
- LA 13,16(1) LOAD NEW SA REGISTER
- ST 13,8(15) FORWARD CHAIN
- LM 15,1,16(15) RESTORE ALL REGISTER
- B FO&F
-FR&F ST 15,16(13) SAVE RETURN CODE
- LA 0,16 LENGTH OF PREFIX
- L 1,8(13) SAVE OLD SA POINTER
- SR 1,0 POINT TO PREFIX
- MVC 12(4,13),0(1)
- L 14,8(1) LOAD 1-ST CHAIN POINTER
- L 0,12(1) LOAD 1-ST SUBPOOL AND LENGTH
- BALR 10,0
- B 12(10)
- L 14,0(1) LOAD CHAIN POINTER
- L 0,4(1) LOAD SUBPOOL AND LENGTH
- LA 1,0(1) CLEAR HIGH ORDER BYTE
- SVC 10 ISSUE FREEMAIN SVC
- LA 1,0(14) GET CHAIN POINTER
- C 14,36(10) LAST IN CHAIN
- BNZ 4(10) NO, BRANCH
- LM 14,12,12(13) RESTORE REGISTERS AFTER FREEMAIN
- BR 14
- DC X'FF000000'
-FO&F EQU *
- MEXIT
-.ERROR3 MNOTE 12,'MODE=&MODE INVALID'
- MEXIT
-.ERROR4 MNOTE 12,'WKSIZE=&WKSIZE SHOULD BE SELF-DEFINING TERM OR NAME *
- FIELD OF AN ''EQU'''
- MEXIT
-.ERROR5 MNOTE 12,'SP=&SP SHOULD BE A SELF DEFINING TERM'
- MEXIT
-.ERROR6 MNOTE 12,'SP=&SP GREATER 255 SPECIFIED'
- MEXIT
-.ERROR7 MNOTE 12,'BASE=&BASE SHOULD BE A SELF DEFINING TERM'
- MEXIT
-.ERROR8 MNOTE 12,'BASE CAN BE ONLY 4 TO 12'
- MEND
-#endif
-
-#endif
diff --git a/src/packlib/fatmen/fatmen/fatapol3.inc b/src/packlib/fatmen/fatmen/fatapol3.inc
deleted file mode 100644
index b150c15..0000000
--- a/src/packlib/fatmen/fatmen/fatapol3.inc
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: fatapol3.inc,v 1.1.1.1 1996/03/07 15:17:52 mclareni Exp $
-*
-* $Log: fatapol3.inc,v $
-* Revision 1.1.1.1 1996/03/07 15:17:52 mclareni
-* Fatmen
-*
-*
-#ifndef CERNLIB_FATMEN_FATAPOL3_INC
-#define CERNLIB_FATMEN_FATAPOL3_INC
-*
-*
-* fatapol3.inc
-*
- COMMON/FMAPOL3/IAPOL3
-
-#endif
diff --git a/src/packlib/fatmen/fatmen/fatbank.inc b/src/packlib/fatmen/fatmen/fatbank.inc
deleted file mode 100644
index 39c48c8..0000000
--- a/src/packlib/fatmen/fatmen/fatbank.inc
+++ /dev/null
@@ -1,47 +0,0 @@
-*
-* $Id: fatbank.inc,v 1.1.1.1 1996/03/07 15:17:58 mclareni Exp $
-*
-* $Log: fatbank.inc,v $
-* Revision 1.1.1.1 1996/03/07 15:17:58 mclareni
-* Fatmen
-*
-*
-#ifndef CERNLIB_FATMEN_FATBANK_INC
-#define CERNLIB_FATMEN_FATBANK_INC
-*
-*
-* fatbank.inc
-*
- COMMON /FABANK/FATFEN(22),LQ(9)
- DIMENSION IQ(2), Q(2)
- EQUIVALENCE (IQ(1),Q(1),LQ(9))
-*
- COMMON /QUEST/ IQUEST(100)
-*
- PARAMETER (IKTYFA=33, KNSDFA=23, KLSDFA=26, MAXLFA=128)
-* top directory fan-out bank "UPFA"
- PARAMETER (MNOPFA=1, MLUNFA=2, MFLGFA=3, MTOTFA=4)
- PARAMETER (MCRDFA=5, MINPFA=6, MOUTFA=7, MTOPFA=8)
- PARAMETER (MNCHFA=9, MCHRFA=10, NDUPFA=MCHRFA+31)
- PARAMETER (NSLUFA=2)
-* Book keeping "BKFA"
- PARAMETER (KLBKFA=1)
- PARAMETER (MSTAFA=1,MPNTFA=2,MCGNFA=3)
- PARAMETER (NWBKFA=3)
-* Generic names bank
- PARAMETER (KLGNFA=2)
-*
- COMMON /FATSTO/ LDIRFA, LBOUT, LJNKFA
- COMMON /FATUSE/ IDEBFA, IDIVFA, IKDRFA, KOFSFA, KOFUFA, LBFXFA
- + , LSAVFA, LTOPFA, LBBKFA, LBGNFA, LTDSFA, LBDSFA
- + , LPRTFA, NTOPFA, LUFZFA, IOUPFA, IOBKFA, IODSFA
- + , LLNLFA, LLNHFA
- COMMON /FATSER/ LNEWFA, LOLDFA, LCOMP1, LCOMP2, LBANKR
- COMMON /FATBNK/ LBKLUN(99)
-*
- PARAMETER (MXDMFA=100)
-* COMMON /FATKYS/ IOTYFA(MXDMFA), KEYVFA(MXDMFA), NKEYFA, NWKYFA
- COMMON /FATKYS/ IOTYFA(MXDMFA), KEYVFA(MXDMFA), NWKYFA
-*
-
-#endif
diff --git a/src/packlib/fatmen/fatmen/fatbeg.inc b/src/packlib/fatmen/fatmen/fatbeg.inc
deleted file mode 100644
index 9fa7f00..0000000
--- a/src/packlib/fatmen/fatmen/fatbeg.inc
+++ /dev/null
@@ -1,30 +0,0 @@
-*
-* $Id: fatbeg.inc,v 1.1.1.1 1996/03/07 15:17:59 mclareni Exp $
-*
-* $Log: fatbeg.inc,v $
-* Revision 1.1.1.1 1996/03/07 15:17:59 mclareni
-* Fatmen
-*
-*
-#ifndef CERNLIB_FATMEN_FATBEG_INC
-#define CERNLIB_FATMEN_FATBEG_INC
-*
-*
-* fatbeg.inc
-*
-#if defined(CERNLIB_IBMMVS)
- MACRO
-&NAME BEG &ID,&MODE=REUS,&WKSIZE=0,&SP=0,&BASE=12,&RMODE=24
- GBLC &RMD
-&RMD SETC '&RMODE'
-&NAME CSECT
- AIF ('&RMODE' EQ '24').NOT311
-&NAME RMODE ANY
-&NAME AMODE ANY
-.NOT311 ENTRY &NAME
- USING *,&BASE
- ANF &ID,MODE=&MODE,WKSIZE=&WKSIZE,SP=&SP,BASE=&BASE
- MEND
-#endif
-
-#endif
diff --git a/src/packlib/fatmen/fatmen/fatbug.inc b/src/packlib/fatmen/fatmen/fatbug.inc
deleted file mode 100644
index 1934251..0000000
--- a/src/packlib/fatmen/fatmen/fatbug.inc
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: fatbug.inc,v 1.1.1.1 1996/03/07 15:17:58 mclareni Exp $
-*
-* $Log: fatbug.inc,v $
-* Revision 1.1.1.1 1996/03/07 15:17:58 mclareni
-* Fatmen
-*
-*
-#ifndef CERNLIB_FATMEN_FATBUG_INC
-#define CERNLIB_FATMEN_FATBUG_INC
-*
-*
-* fatbug.inc
-*
-#if defined(CERNLIB_TYPE)
-#include "fatmen/fttbug.inc"
-#endif
- COMMON /FATUSE/ IDEBFA, IDIVFA, IKDRFA, KOFSFA, KOFUFA, LBFXFA
- + , LSAVFA, LTOPFA, LBBKFA, LBGNFA, LTDSFA, LBDSFA
- + , LPRTFA, NTOPFA, LUFZFA, IOUPFA, IOBKFA, IODSFA
- + , LLNLFA, LLNHFA
-
-#endif
diff --git a/src/packlib/fatmen/fatmen/fatcdes.inc b/src/packlib/fatmen/fatmen/fatcdes.inc
deleted file mode 100644
index f7c7040..0000000
--- a/src/packlib/fatmen/fatmen/fatcdes.inc
+++ /dev/null
@@ -1,13 +0,0 @@
-*
-* $Id: fatcdes.inc,v 1.1.1.1 1996/03/07 15:17:52 mclareni Exp $
-*
-* $Log: fatcdes.inc,v $
-* Revision 1.1.1.1 1996/03/07 15:17:52 mclareni
-* Fatmen
-*
-*
-#ifndef CERNLIB_FATMEN_FATCDES_INC
-#define CERNLIB_FATMEN_FATCDES_INC
-*
-
-#endif
diff --git a/src/packlib/fatmen/fatmen/fatchar.inc b/src/packlib/fatmen/fatmen/fatchar.inc
deleted file mode 100644
index 21a226b..0000000
--- a/src/packlib/fatmen/fatmen/fatchar.inc
+++ /dev/null
@@ -1,168 +0,0 @@
-*
-* $Id: fatchar.inc,v 1.1.1.1 1996/03/07 15:17:58 mclareni Exp $
-*
-* $Log: fatchar.inc,v $
-* Revision 1.1.1.1 1996/03/07 15:17:58 mclareni
-* Fatmen
-*
-*
-#ifndef CERNLIB_FATMEN_FATCHAR_INC
-#define CERNLIB_FATMEN_FATCHAR_INC
-*
-*
-* fatchar.inc
-*
-*
-** *** Types (1 = integer, 2 = character, 3 = time)
-*
- IBTYPE( 1)=2
- IBTYPE( 2)=2
- IBTYPE( 3)=1
- IBTYPE( 4)=1
- IBTYPE( 5)=1
- IBTYPE( 6)=2
- IBTYPE( 7)=2
- IBTYPE( 8)=2
- IBTYPE( 9)=2
- IBTYPE(10)=1
- IBTYPE(11)=1
- IBTYPE(12)=1
- IBTYPE(13)=1
- IBTYPE(14)=1
- IBTYPE(15)=1
- IBTYPE(16)=1
- IBTYPE(17)=1
- IBTYPE(18)=2
- IBTYPE(19)=1
- IBTYPE(20)=1
- IBTYPE(21)=2
- IBTYPE(22)=2
- IBTYPE(23)=3
- IBTYPE(24)=3
- IBTYPE(25)=3
- IBTYPE(26)=2
- IBTYPE(27)=2
- IBTYPE(28)=2
- IBTYPE(29)=2
- IBTYPE(30)=1
- IBTYPE(31)=1
- IBTYPE(32)=1
- IBTYPE(33)=2
- IBTYPE(34)=1
- IBTYPE(35)=1
-*
-** *** Offsets
-*
- IBOFFS( 1)=MFQNFA
- IBOFFS( 2)=MHSNFA
- IBOFFS( 3)=MCPLFA
- IBOFFS( 4)=MMTPFA
- IBOFFS( 5)=MLOCFA
- IBOFFS( 6)=MHSTFA
- IBOFFS( 7)=MHOSFA
- IBOFFS( 8)=MVSNFA
- IBOFFS( 9)=MVIDFA
- IBOFFS(10)=MVIPFA
- IBOFFS(11)=MDENFA
- IBOFFS(12)=MVSQFA
- IBOFFS(13)=MFSQFA
- IBOFFS(14)=MSRDFA
- IBOFFS(15)=MERDFA
- IBOFFS(16)=MSBLFA
- IBOFFS(17)=MEBLFA
- IBOFFS(18)=MRFMFA
- IBOFFS(19)=MRLNFA
- IBOFFS(20)=MBLNFA
- IBOFFS(21)=MFLFFA
- IBOFFS(22)=MFUTFA
- IBOFFS(23)=MCRTFA
- IBOFFS(24)=MCTTFA
- IBOFFS(25)=MLATFA
- IBOFFS(26)=MCURFA
- IBOFFS(27)=MCIDFA
- IBOFFS(28)=MCNIFA
- IBOFFS(29)=MCJIFA
- IBOFFS(30)=MFPRFA
- IBOFFS(31)=MSYWFA
- IBOFFS(32)=MUSWFA
- IBOFFS(33)=MUCMFA
- IBOFFS(34)=MFSZFA
- IBOFFS(35)=MUSCFA
-*
-** *** Lengths
-*
- IBLENG( 1)=NFQNFA
- IBLENG( 2)=NHSNFA
- IBLENG( 3)=NCPLFA
- IBLENG( 4)=NMTPFA
- IBLENG( 5)=NLOCFA
- IBLENG( 6)=NHSTFA
- IBLENG( 7)=NHOSFA
- IBLENG( 8)=NVSNFA
- IBLENG( 9)=NVIDFA
- IBLENG(10)=NVIPFA
- IBLENG(11)=NDENFA
- IBLENG(12)=NVSQFA
- IBLENG(13)=NFSQFA
- IBLENG(14)=NSRDFA
- IBLENG(15)=NERDFA
- IBLENG(16)=NSBLFA
- IBLENG(17)=NEBLFA
- IBLENG(18)=NRFMFA
- IBLENG(19)=NRLNFA
- IBLENG(20)=NBLNFA
- IBLENG(21)=NFLFFA
- IBLENG(22)=NFUTFA
- IBLENG(23)=NCRTFA
- IBLENG(24)=NCTTFA
- IBLENG(25)=NLATFA
- IBLENG(26)=NCURFA
- IBLENG(27)=NCIDFA
- IBLENG(28)=NCNIFA
- IBLENG(29)=NCJIFA
- IBLENG(30)=NFPRFA
- IBLENG(31)=NSYWFA
- IBLENG(32)=NUSWFA
- IBLENG(33)=NUCMFA
- IBLENG(34)=NFSZFA
- IBLENG(35)=NUSCFA
-*
-** *** Character names of offsets
-*
- CHBANK( 1)='MFQNFA'
- CHBANK( 2)='MHSNFA'
- CHBANK( 3)='MCPLFA'
- CHBANK( 4)='MMTPFA'
- CHBANK( 5)='MLOCFA'
- CHBANK( 6)='MHSTFA'
- CHBANK( 7)='MHOSFA'
- CHBANK( 8)='MVSNFA'
- CHBANK( 9)='MVIDFA'
- CHBANK(10)='MVIPFA'
- CHBANK(11)='MDENFA'
- CHBANK(12)='MVSQFA'
- CHBANK(13)='MFSQFA'
- CHBANK(14)='MSRDFA'
- CHBANK(15)='MERDFA'
- CHBANK(16)='MSBLFA'
- CHBANK(17)='MEBLFA'
- CHBANK(18)='MRFMFA'
- CHBANK(19)='MRLNFA'
- CHBANK(20)='MBLNFA'
- CHBANK(21)='MFLFFA'
- CHBANK(22)='MFUTFA'
- CHBANK(23)='MCRTFA'
- CHBANK(24)='MCTTFA'
- CHBANK(25)='MLATFA'
- CHBANK(26)='MCURFA'
- CHBANK(27)='MCIDFA'
- CHBANK(28)='MCNIFA'
- CHBANK(29)='MCJIFA'
- CHBANK(30)='MFPRFA'
- CHBANK(31)='MSYWFA'
- CHBANK(32)='MUSWFA'
- CHBANK(33)='MUCMFA'
- CHBANK(34)='MFSZFA'
- CHBANK(35)='MUSCFA'
-
-#endif
diff --git a/src/packlib/fatmen/fatmen/fatclio.inc b/src/packlib/fatmen/fatmen/fatclio.inc
deleted file mode 100644
index aa4c17b..0000000
--- a/src/packlib/fatmen/fatmen/fatclio.inc
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: fatclio.inc,v 1.1.1.1 1996/03/07 15:17:52 mclareni Exp $
-*
-* $Log: fatclio.inc,v $
-* Revision 1.1.1.1 1996/03/07 15:17:52 mclareni
-* Fatmen
-*
-*
-#ifndef CERNLIB_FATMEN_FATCLIO_INC
-#define CERNLIB_FATMEN_FATCLIO_INC
-*
-*
-* fatclio.inc
-*
- COMMON/FMCLIO/ICLIO
-
-#endif
diff --git a/src/packlib/fatmen/fatmen/fatcpl.inc b/src/packlib/fatmen/fatmen/fatcpl.inc
deleted file mode 100644
index 813ca32..0000000
--- a/src/packlib/fatmen/fatmen/fatcpl.inc
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: fatcpl.inc,v 1.1.1.1 1996/03/07 15:17:55 mclareni Exp $
-*
-* $Log: fatcpl.inc,v $
-* Revision 1.1.1.1 1996/03/07 15:17:55 mclareni
-* Fatmen
-*
-*
-#ifndef CERNLIB_FATMEN_FATCPL_INC
-#define CERNLIB_FATMEN_FATCPL_INC
-*
-*
-* fatcpl.inc
-*
- COMMON/FATCPL/NUMCPL,MFMCPL(KMXCPL)
-
-#endif
diff --git a/src/packlib/fatmen/fatmen/fatdcb.inc b/src/packlib/fatmen/fatmen/fatdcb.inc
deleted file mode 100644
index f2e4dc6..0000000
--- a/src/packlib/fatmen/fatmen/fatdcb.inc
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: fatdcb.inc,v 1.1.1.1 1996/03/07 15:17:54 mclareni Exp $
-*
-* $Log: fatdcb.inc,v $
-* Revision 1.1.1.1 1996/03/07 15:17:54 mclareni
-* Fatmen
-*
-*
-#ifndef CERNLIB_FATMEN_FATDCB_INC
-#define CERNLIB_FATMEN_FATDCB_INC
-*
-*
-* fatdcb.inc
-*
- COMMON/FATDCB/TYPE,HDSN,DISP,VOL,LABEL,IDCB,
- + UNIT,ISPACE,IUSED
- INTEGER TYPE,HDSN(14),DISP(3),VOL(2),LABEL(3),IDCB(4),
- + UNIT(2),ISPACE(4),IUSED(5)
- COMMON/FATSPA/CHSPAC
- CHARACTER*4 CHSPAC
-
-#endif
diff --git a/src/packlib/fatmen/fatmen/fatdummy.inc b/src/packlib/fatmen/fatmen/fatdummy.inc
deleted file mode 100644
index 9358a9e..0000000
--- a/src/packlib/fatmen/fatmen/fatdummy.inc
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: fatdummy.inc,v 1.1.1.1 1996/03/07 15:17:52 mclareni Exp $
-*
-* $Log: fatdummy.inc,v $
-* Revision 1.1.1.1 1996/03/07 15:17:52 mclareni
-* Fatmen
-*
-*
-#ifndef CERNLIB_FATMEN_FATDUMMY_INC
-#define CERNLIB_FATMEN_FATDUMMY_INC
-*
-*
-* fatdummy.inc
-*
- IF(IDEBFA.GE.2) PRINT *,CHROUT,'dummy user exit called'
-
-#endif
diff --git a/src/packlib/fatmen/fatmen/fatform.inc b/src/packlib/fatmen/fatmen/fatform.inc
deleted file mode 100644
index cd9daed..0000000
--- a/src/packlib/fatmen/fatmen/fatform.inc
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: fatform.inc,v 1.1.1.1 1996/03/07 15:17:57 mclareni Exp $
-*
-* $Log: fatform.inc,v $
-* Revision 1.1.1.1 1996/03/07 15:17:57 mclareni
-* Fatmen
-*
-*
-#ifndef CERNLIB_FATMEN_FATFORM_INC
-#define CERNLIB_FATMEN_FATFORM_INC
-*
-*
-* fatform.inc
-*
-#include "fatmen/fatform0.inc"
-#include "fatmen/fatform1.inc"
-
-
-#endif
diff --git a/src/packlib/fatmen/fatmen/fatform0.inc b/src/packlib/fatmen/fatmen/fatform0.inc
deleted file mode 100644
index 69dbadf..0000000
--- a/src/packlib/fatmen/fatmen/fatform0.inc
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: fatform0.inc,v 1.3 1997/06/03 07:49:42 jamie Exp $
-*
-* $Log: fatform0.inc,v $
-* Revision 1.3 1997/06/03 07:49:42 jamie
-* Support long blocks for new tapes
-*
-* Revision 1.2 1996/09/23 14:23:56 jamie
-* Add EBCD (EBCDIC) format
-*
-* Revision 1.1.1.1 1996/03/07 15:17:57 mclareni
-* Fatmen
-*
-*
-#ifndef CERNLIB_FATMEN_FATFORM0_INC
-#define CERNLIB_FATMEN_FATFORM0_INC
-*
-*
-* fatform0.inc
-*
-*
-* Sequence FATFORM. File format (MFLFFA) and record format (MRFMFA)
-* definitions
-*
- PARAMETER (NFATFM=21)
- CHARACTER*4 FATFRM(NFATFM)
-
- PARAMETER (NRECFM=8)
- CHARACTER*4 FRCFM(NRECFM)
-
- INTEGER FMXBLK,FMXREC
-*
-* New tapes support block lengths 8 times ANSI standard
-*
- PARAMETER (FMXBLK=65536)
- PARAMETER (FMXREC=65536)
-* PARAMETER (FMXBLK=8192)
-* PARAMETER (FMXREC=8192)
-
-
-#endif
diff --git a/src/packlib/fatmen/fatmen/fatform1.inc b/src/packlib/fatmen/fatmen/fatform1.inc
deleted file mode 100644
index 0d1dd3c..0000000
--- a/src/packlib/fatmen/fatmen/fatform1.inc
+++ /dev/null
@@ -1,50 +0,0 @@
-*
-* $Id: fatform1.inc,v 1.2 1996/09/23 14:23:58 jamie Exp $
-*
-* $Log: fatform1.inc,v $
-* Revision 1.2 1996/09/23 14:23:58 jamie
-* Add EBCD (EBCDIC) format
-*
-* Revision 1.1.1.1 1996/03/07 15:17:57 mclareni
-* Fatmen
-*
-*
-#ifndef CERNLIB_FATMEN_FATFORM1_INC
-#define CERNLIB_FATMEN_FATFORM1_INC
-*
-*
-* fatform1.inc
-*
- DATA FATFRM(1)/'FZ '/,
- + FATFRM(2)/'FA ' /,
- + FATFRM(3)/'FX ' /,
- + FATFRM(4)/'FFX ' /,
- + FATFRM(5)/'RZ ' /,
- + FATFRM(6)/'RX ' /,
- + FATFRM(7)/'EP ' /,
- + FATFRM(8)/'AS ' /,
- + FATFRM(9)/'UN ' /,
- + FATFRM(10)/'DA ' /,
- + FATFRM(11)/'FXN ' /,
- + FATFRM(12)/'FPT ' /,
- + FATFRM(13)/'FPS ' /,
- + FATFRM(14)/'FPD ' /,
- + FATFRM(15)/'FPK ' /,
- + FATFRM(16)/'FPO ' /,
- + FATFRM(17)/'YBB ' /,
- + FATFRM(18)/'YBD ' /,
- + FATFRM(19)/'RWN ' /,
- + FATFRM(20)/'CWN ' /,
- + FATFRM(21)/'EBCD' /
-
- DATA FRCFM(1)/'F '/,
- + FRCFM(2)/'FB '/,
- + FRCFM(3)/'V '/,
- + FRCFM(4)/'VB '/,
- + FRCFM(5)/'VBS '/,
- + FRCFM(6)/'VS '/,
- + FRCFM(7)/'U '/,
- + FRCFM(8)/'RMS '/
-
-
-#endif
diff --git a/src/packlib/fatmen/fatmen/fatget.inc b/src/packlib/fatmen/fatmen/fatget.inc
deleted file mode 100644
index 094c39d..0000000
--- a/src/packlib/fatmen/fatmen/fatget.inc
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: fatget.inc,v 1.1.1.1 1996/03/07 15:17:52 mclareni Exp $
-*
-* $Log: fatget.inc,v $
-* Revision 1.1.1.1 1996/03/07 15:17:52 mclareni
-* Fatmen
-*
-*
-#ifndef CERNLIB_FATMEN_FATGET_INC
-#define CERNLIB_FATMEN_FATGET_INC
-*
-*
-* fatget.inc
-*
- COMMON/FATGET/ISFGET
-
-#endif
diff --git a/src/packlib/fatmen/fatmen/fatinfo.inc b/src/packlib/fatmen/fatmen/fatinfo.inc
deleted file mode 100644
index 09b6cb3..0000000
--- a/src/packlib/fatmen/fatmen/fatinfo.inc
+++ /dev/null
@@ -1,30 +0,0 @@
-*
-* $Id: fatinfo.inc,v 1.1.1.1 1996/03/07 15:17:55 mclareni Exp $
-*
-* $Log: fatinfo.inc,v $
-* Revision 1.1.1.1 1996/03/07 15:17:55 mclareni
-* Fatmen
-*
-*
-#ifndef CERNLIB_FATMEN_FATINFO_INC
-#define CERNLIB_FATMEN_FATINFO_INC
-*
-*
-* fatinfo.inc
-*
-*
-* Common to store FATMEN information per LUN
-* Access method (disk, stage, setup) and filemode (CMS only)
-* Virtual address for tape drive
-* This information is set by FMOPEN/FIND/MAKE and subsequently
-* used by FMCLOS.
-*
-* IFMODE: 0: FZin, 1: FZout, 2: RZ
-* JFMODE: ICFOP from FMOPEN (Fortran, C, package I/O)
-* LFMODE: 1=disk, 2=stage, 3=tape
-*
- COMMON/FATINF/IVADDR(99),IDEV(99), IFMODE(99),
- + JFMODE(99),LFMODE(99),IFPNTR(99),CHMODE(99)
- CHARACTER*1 CHMODE
-
-#endif
diff --git a/src/packlib/fatmen/fatmen/fatinit.inc b/src/packlib/fatmen/fatmen/fatinit.inc
deleted file mode 100644
index b9636b8..0000000
--- a/src/packlib/fatmen/fatmen/fatinit.inc
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: fatinit.inc,v 1.1.1.1 1996/03/07 15:17:54 mclareni Exp $
-*
-* $Log: fatinit.inc,v $
-* Revision 1.1.1.1 1996/03/07 15:17:54 mclareni
-* Fatmen
-*
-*
-#ifndef CERNLIB_FATMEN_FATINIT_INC
-#define CERNLIB_FATMEN_FATINIT_INC
-*
-*
-* fatinit.inc
-*
- IF(SERNAM(1:4).EQ.'INIT') THEN
- PRINT *,'Error - FATMEN has not been initialised'
- RETURN
- ENDIF
-
-#endif
diff --git a/src/packlib/fatmen/fatmen/fatkey.inc b/src/packlib/fatmen/fatmen/fatkey.inc
deleted file mode 100644
index 5c9400b..0000000
--- a/src/packlib/fatmen/fatmen/fatkey.inc
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: fatkey.inc,v 1.2 1996/06/19 06:59:16 jamie Exp $
-*
-* $Log: fatkey.inc,v $
-* Revision 1.2 1996/06/19 06:59:16 jamie
-* correct mfmkey
-*
-* Revision 1.1.1.1 1996/03/07 15:17:55 mclareni
-* Fatmen
-*
-*
-#ifndef CERNLIB_FATMEN_FATKEY_INC
-#define CERNLIB_FATMEN_FATKEY_INC
-*
-*
-* fatkey.inc
-*
-#include "fatmen/fmnkeys.inc"
- COMMON/FATKEY/NUMKEY,MFMKEY(LKEYFA,KMXKEY),CHKEY
- CHARACTER*8 CHKEY
-
-#endif
diff --git a/src/packlib/fatmen/fatmen/fatlab.inc b/src/packlib/fatmen/fatmen/fatlab.inc
deleted file mode 100644
index 06ae808..0000000
--- a/src/packlib/fatmen/fatmen/fatlab.inc
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: fatlab.inc,v 1.1.1.1 1996/03/07 15:17:52 mclareni Exp $
-*
-* $Log: fatlab.inc,v $
-* Revision 1.1.1.1 1996/03/07 15:17:52 mclareni
-* Fatmen
-*
-*
-#ifndef CERNLIB_FATMEN_FATLAB_INC
-#define CERNLIB_FATMEN_FATLAB_INC
-*
-*
-* fatlab.inc
-*
-#include "fatmen/fatlab0.inc"
-#include "fatmen/fatlab1.inc"
-
-
-#endif
diff --git a/src/packlib/fatmen/fatmen/fatlab0.inc b/src/packlib/fatmen/fatmen/fatlab0.inc
deleted file mode 100644
index 4168256..0000000
--- a/src/packlib/fatmen/fatmen/fatlab0.inc
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: fatlab0.inc,v 1.1.1.1 1996/03/07 15:17:52 mclareni Exp $
-*
-* $Log: fatlab0.inc,v $
-* Revision 1.1.1.1 1996/03/07 15:17:52 mclareni
-* Fatmen
-*
-*
-#ifndef CERNLIB_FATMEN_FATLAB0_INC
-#define CERNLIB_FATMEN_FATLAB0_INC
-*
-*
-* fatlab0.inc
-*
- CHARACTER*6 VAXLAB(3)
- CHARACTER*2 IBMLAB(3)
-
-#endif
diff --git a/src/packlib/fatmen/fatmen/fatlab1.inc b/src/packlib/fatmen/fatmen/fatlab1.inc
deleted file mode 100644
index 19ff4db..0000000
--- a/src/packlib/fatmen/fatmen/fatlab1.inc
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: fatlab1.inc,v 1.1.1.1 1996/03/07 15:17:52 mclareni Exp $
-*
-* $Log: fatlab1.inc,v $
-* Revision 1.1.1.1 1996/03/07 15:17:52 mclareni
-* Fatmen
-*
-*
-#ifndef CERNLIB_FATMEN_FATLAB1_INC
-#define CERNLIB_FATMEN_FATLAB1_INC
-*
-*
-* fatlab1.inc
-*
- DATA IBMLAB(1)/'SL'/,IBMLAB(2)/'NL'/IBMLAB(3)/'AL'/
- DATA VAXLAB(1)/'EBCDIC'/,
- + VAXLAB(2)/'NONE '/,
- + VAXLAB(3)/'ASCII '/
-
-#endif
diff --git a/src/packlib/fatmen/fatmen/fatlcc.inc b/src/packlib/fatmen/fatmen/fatlcc.inc
deleted file mode 100644
index a026695..0000000
--- a/src/packlib/fatmen/fatmen/fatlcc.inc
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: fatlcc.inc,v 1.1.1.1 1996/03/07 15:17:55 mclareni Exp $
-*
-* $Log: fatlcc.inc,v $
-* Revision 1.1.1.1 1996/03/07 15:17:55 mclareni
-* Fatmen
-*
-*
-#ifndef CERNLIB_FATMEN_FATLCC_INC
-#define CERNLIB_FATMEN_FATLCC_INC
-*
-*
-* fatlcc.inc
-*
-*
-* Location code definitions (from FATMEN.LOCCODES)
-*
- PARAMETER (MXLCFA=99)
- CHARACTER*255 CHLOCF
- COMMON/FATLCC/NKLCFA,NLCCFA(MXLCFA),CHLOCF(MXLCFA)
-
-#endif
diff --git a/src/packlib/fatmen/fatmen/fatlnk.inc b/src/packlib/fatmen/fatmen/fatlnk.inc
deleted file mode 100644
index 82e52d0..0000000
--- a/src/packlib/fatmen/fatmen/fatlnk.inc
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: fatlnk.inc,v 1.1.1.1 1996/03/07 15:17:54 mclareni Exp $
-*
-* $Log: fatlnk.inc,v $
-* Revision 1.1.1.1 1996/03/07 15:17:54 mclareni
-* Fatmen
-*
-*
-#ifndef CERNLIB_FATMEN_FATLNK_INC
-#define CERNLIB_FATMEN_FATLNK_INC
-*
-*
-* fatlnk.inc
-*
-*
- COMMON/FATLNK/LOPNBK,LCLSBK,LCP1BK,LCP2BK
-
-#endif
diff --git a/src/packlib/fatmen/fatmen/fatloc.inc b/src/packlib/fatmen/fatmen/fatloc.inc
deleted file mode 100644
index eb81243..0000000
--- a/src/packlib/fatmen/fatmen/fatloc.inc
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: fatloc.inc,v 1.1.1.1 1996/03/07 15:17:55 mclareni Exp $
-*
-* $Log: fatloc.inc,v $
-* Revision 1.1.1.1 1996/03/07 15:17:55 mclareni
-* Fatmen
-*
-*
-#ifndef CERNLIB_FATMEN_FATLOC_INC
-#define CERNLIB_FATMEN_FATLOC_INC
-*
-*
-* fatloc.inc
-*
- COMMON/FATLOC/NUMLOC,MFMLOC(KMXLOC)
-
-#endif
diff --git a/src/packlib/fatmen/fatmen/fatlun.inc b/src/packlib/fatmen/fatmen/fatlun.inc
deleted file mode 100644
index 762f1bd..0000000
--- a/src/packlib/fatmen/fatmen/fatlun.inc
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: fatlun.inc,v 1.1.1.1 1996/03/07 15:17:55 mclareni Exp $
-*
-* $Log: fatlun.inc,v $
-* Revision 1.1.1.1 1996/03/07 15:17:55 mclareni
-* Fatmen
-*
-*
-#ifndef CERNLIB_FATMEN_FATLUN_INC
-#define CERNLIB_FATMEN_FATLUN_INC
-*
-*
-* fatlun.inc
-*
- COMMON/FATLUN/NUMLUN,MFMLUN(KMXLUN),MFMLUA(KMXLUN)
-
-#endif
diff --git a/src/packlib/fatmen/fatmen/fatmed.inc b/src/packlib/fatmen/fatmen/fatmed.inc
deleted file mode 100644
index 8a4135c..0000000
--- a/src/packlib/fatmen/fatmen/fatmed.inc
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: fatmed.inc,v 1.1.1.1 1996/03/07 15:17:57 mclareni Exp $
-*
-* $Log: fatmed.inc,v $
-* Revision 1.1.1.1 1996/03/07 15:17:57 mclareni
-* Fatmen
-*
-*
-#ifndef CERNLIB_FATMEN_FATMED_INC
-#define CERNLIB_FATMEN_FATMED_INC
-*
-*
-* fatmed.inc
-*
-#include "fatmen/fatmed0.inc"
-#include "fatmen/fatmed1.inc"
-
-
-#endif
diff --git a/src/packlib/fatmen/fatmen/fatmed0.inc b/src/packlib/fatmen/fatmen/fatmed0.inc
deleted file mode 100644
index 7f09107..0000000
--- a/src/packlib/fatmen/fatmen/fatmed0.inc
+++ /dev/null
@@ -1,47 +0,0 @@
-*
-* $Id: fatmed0.inc,v 1.1.1.1 1996/03/07 15:17:57 mclareni Exp $
-*
-* $Log: fatmed0.inc,v $
-* Revision 1.1.1.1 1996/03/07 15:17:57 mclareni
-* Fatmen
-*
-*
-#ifndef CERNLIB_FATMEN_FATMED0_INC
-#define CERNLIB_FATMEN_FATMED0_INC
-*
-* Default media attributes
-*
-* fatmed0.inc
-*
- PARAMETER (NMEDIA=14)
-*
-* FATMEN media type
-*
- DIMENSION MFMMED(NMEDIA)
-*
-* Generic device type
-*
- CHARACTER*8 MFMGEN(NMEDIA)
-*
-* Physical device type
-*
- CHARACTER*8 MFMTYP(NMEDIA)
-*
-* Default density
-*
- CHARACTER*8 MFMDEN(NMEDIA)
-*
-* Media size in Megabytes
-*
- CHARACTER*8 MFMSIZ(NMEDIA)
-*
-* Default mount type
-*
- CHARACTER*1 MFMMNT(NMEDIA)
-*
-* Default label type
-*
- CHARACTER*2 MFMLAB(NMEDIA)
-
-
-#endif
diff --git a/src/packlib/fatmen/fatmen/fatmed1.inc b/src/packlib/fatmen/fatmen/fatmed1.inc
deleted file mode 100644
index 365d611..0000000
--- a/src/packlib/fatmen/fatmen/fatmed1.inc
+++ /dev/null
@@ -1,89 +0,0 @@
-*
-* $Id: fatmed1.inc,v 1.1.1.1 1996/03/07 15:17:57 mclareni Exp $
-*
-* $Log: fatmed1.inc,v $
-* Revision 1.1.1.1 1996/03/07 15:17:57 mclareni
-* Fatmen
-*
-*
-#ifndef CERNLIB_FATMEN_FATMED1_INC
-#define CERNLIB_FATMEN_FATMED1_INC
-*
-*
-* fatmed1.inc
-*
-* SYSREQ TMS Q DEVTYPES
-* TMS Model
- DATA MFMTYP(1)/'DISK'/,MFMTYP(2)/'3480'/,
- + MFMTYP(3)/'3420'/,MFMTYP(4)/'8200'/,
- + MFMTYP(5)/'8500'/,MFMTYP(6)/'3490'/,
- + MFMTYP(7)/'DAT60'/,MFMTYP(8)/'DAT90'/,
- + MFMTYP(9)/'3490E'/,MFMTYP(10)/'AMPEX'/,
- + MFMTYP(11)/'REDWOOD'/,MFMTYP(12)/'DLT2'/,
- + MFMTYP(13)/'DAT120'/,MFMTYP(14)/'3590'/
-
-* TMS Sort
- DATA MFMGEN(1)/'DISK'/,MFMGEN(2)/'CT1 '/,
- + MFMGEN(3)/'TAPE'/,MFMGEN(4)/'8MM '/,
- + MFMGEN(5)/'8MM '/,MFMGEN(6)/'CT2 '/,
- + MFMGEN(7)/'DAT '/,MFMGEN(8)/'DAT '/,
- + MFMGEN(9)/'CT2E'/,MFMGEN(10)/'DD2 '/,
- + MFMGEN(11)/'DD3 '/,MFMGEN(12)/'DLT '/,
- + MFMGEN(13)/'DAT '/,MFMGEN(14)/'NTP '/
-
-* TMS density code
- DATA MFMDEN(1)/'N/A '/,MFMDEN(2)/'38K '/,
- + MFMDEN(3)/'6250'/,MFMDEN(4)/'43200'/
- + MFMDEN(5)/'86400'/,MFMDEN(6)/'38KDC'/,
- + MFMDEN(7)/'DDSC'/,MFMDEN(8)/'DDSC'/,
- + MFMDEN(9)/'....'/,MFMDEN(10)/'....'/,
- + MFMDEN(11)/'....'/,MFMDEN(12)/'10GC'/,
- + MFMDEN(13)/'DDSC'/,MFMDEN(14)/'10GC'/
-
-* Maximum capacity
- DATA MFMSIZ(1)/'N/A'/, MFMSIZ(2)/'200'/,
- + MFMSIZ(3)/'200'/, MFMSIZ(4)/'2300'/,
- + MFMSIZ(5)/'5000'/,MFMSIZ(6)/'1000'/,
- + MFMSIZ(7)/'2000'/,MFMSIZ(8)/'5000'/,
- + MFMSIZ(9)/'2000'/,MFMSIZ(10)/'25000'/,
- + MFMSIZ(11)/'40000'/,MFMSIZ(12)/'10000'/,
- + MFMSIZ(13)/'4000'/,MFMSIZ(14)/'10000'/
-
-* Default mount type
- DATA MFMMNT(1)/'M'/, MFMMNT(2)/'M'/,
- + MFMMNT(3)/'M'/, MFMMNT(4)/'M'/,
- + MFMMNT(5)/'M'/, MFMMNT(6)/'M'/,
- + MFMMNT(7)/'M'/, MFMMNT(8)/'M'/,
- + MFMMNT(9)/'M'/, MFMMNT(10)/'M'/,
- + MFMMNT(11)/'M'/, MFMMNT(12)/'M'/,
- + MFMMNT(13)/'M'/, MFMMNT(14)/'M'/
-
-* Default label type
- DATA MFMLAB(1)/' '/, MFMLAB(2)/'SL'/,
- + MFMLAB(3)/'SL'/, MFMLAB(4)/'SL'/,
- + MFMLAB(5)/'SL'/, MFMLAB(6)/'SL'/,
- + MFMLAB(7)/'SL'/, MFMLAB(8)/'SL'/,
- + MFMLAB(9)/'SL'/, MFMLAB(10)/'SL'/,
- + MFMLAB(11)/'SL'/, MFMLAB(12)/'SL'/,
- + MFMLAB(13)/'SL'/, MFMLAB(14)/'SL'/
-*
-* Number of media types defined
-*
- DATA NFTYPS/14/
-*
-* TMS density codes
-*
-* Model Density Code P
-* ------ -------- -------- -
-* 3420 1600 1600 Y
-* 3420 6250 6250 Y
-* 3480 38KC 15 Y
-* 3480 38KD 20 Y
-* 3480 38K 38000 N
-* 3480 38000 38000 Y
-* 3490 38KCD 10 N
-* 3490 38KDC 10 Y
-* 8200 8200 8200 Y
-* 8200 8500 8500 Y
-
-#endif
diff --git a/src/packlib/fatmen/fatmen/fatmon.inc b/src/packlib/fatmen/fatmen/fatmon.inc
deleted file mode 100644
index 7a471a9..0000000
--- a/src/packlib/fatmen/fatmen/fatmon.inc
+++ /dev/null
@@ -1,58 +0,0 @@
-*
-* $Id: fatmon.inc,v 1.1.1.1 1996/03/07 15:17:52 mclareni Exp $
-*
-* $Log: fatmon.inc,v $
-* Revision 1.1.1.1 1996/03/07 15:17:52 mclareni
-* Fatmen
-*
-*
-#ifndef CERNLIB_FATMEN_FATMON_INC
-#define CERNLIB_FATMEN_FATMON_INC
-*
-*
-* fatmon.inc
-*
-*
-* Fatmen monitoring information
-* IHOWFA: how was file accessed?
-* ITIMFA: elapsed time in FMOPEN (in seconds)
-* CHFNFA: fully qualified file name, except VM
-*
- CHARACTER*255 CHFNFA
- COMMON/FATMON/IHOWFA,ITIMFA,CHFNFA
-* Local disk (standard file system)
- PARAMETER (JLOCFA=1)
-* VM shared file system
- PARAMETER (JSFSFA=2)
-* MSCP (VAXcluster)
- PARAMETER (JMSCFA=3)
-* Andrew file system
- PARAMETER (JAFSFA=4)
-* OSF distributed file system
- PARAMETER (JOSFFA=5)
-* DEC DFS
- PARAMETER (JDFSFA=6)
-* Sun NFS
- PARAMETER (JNFSFA=7)
-* DECnet
- PARAMETER (JDECFA=8)
-* CSPACK server
- PARAMETER (JCSPFA=9)
-* FPACK server
- PARAMETER (JFPKFA=10)
-* RFIO
- PARAMETER (JRFIFA=11)
-* Lachman OSM
- PARAMETER (JOSMFA=12)
-* Unitree
- PARAMETER (JUNIFA=13)
-* Adstar ADSM
- PARAMETER (JDSMFA=14)
-* E-MASS
- PARAMETER (JEMSFA=15)
-* Stage required
- PARAMETER (JSTGFA=31)
-* TPMNT (=not staged)
- PARAMETER (JTPMFA=32)
-
-#endif
diff --git a/src/packlib/fatmen/fatmen/fatmss.inc b/src/packlib/fatmen/fatmen/fatmss.inc
deleted file mode 100644
index 35b09e7..0000000
--- a/src/packlib/fatmen/fatmen/fatmss.inc
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: fatmss.inc,v 1.1.1.1 1996/03/07 15:17:52 mclareni Exp $
-*
-* $Log: fatmss.inc,v $
-* Revision 1.1.1.1 1996/03/07 15:17:52 mclareni
-* Fatmen
-*
-*
-#ifndef CERNLIB_FATMEN_FATMSS_INC
-#define CERNLIB_FATMEN_FATMSS_INC
-*
-*
-* fatmss.inc
-*
- COMMON/FATMSS/IFMMSS
-
-#endif
diff --git a/src/packlib/fatmen/fatmen/fatmtp.inc b/src/packlib/fatmen/fatmen/fatmtp.inc
deleted file mode 100644
index 39551f7..0000000
--- a/src/packlib/fatmen/fatmen/fatmtp.inc
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: fatmtp.inc,v 1.1.1.1 1996/03/07 15:17:55 mclareni Exp $
-*
-* $Log: fatmtp.inc,v $
-* Revision 1.1.1.1 1996/03/07 15:17:55 mclareni
-* Fatmen
-*
-*
-#ifndef CERNLIB_FATMEN_FATMTP_INC
-#define CERNLIB_FATMEN_FATMTP_INC
-*
-*
-* fatmtp.inc
-*
- COMMON/FATMTP/NUMMTP,MFMMTP(KMXMTP)
-
-#endif
diff --git a/src/packlib/fatmen/fatmen/fatnet.inc b/src/packlib/fatmen/fatmen/fatnet.inc
deleted file mode 100644
index cee359b..0000000
--- a/src/packlib/fatmen/fatmen/fatnet.inc
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: fatnet.inc,v 1.1.1.1 1996/03/07 15:17:54 mclareni Exp $
-*
-* $Log: fatnet.inc,v $
-* Revision 1.1.1.1 1996/03/07 15:17:54 mclareni
-* Fatmen
-*
-*
-#ifndef CERNLIB_FATMEN_FATNET_INC
-#define CERNLIB_FATMEN_FATNET_INC
-*
-*
-* fatnet.inc
-*
- PARAMETER (NERRS=4)
- DIMENSION IFATRC(NERRS),IRETRY(NERRS)
-
-#endif
diff --git a/src/packlib/fatmen/fatmen/fatopt0.inc b/src/packlib/fatmen/fatmen/fatopt0.inc
deleted file mode 100644
index c049144..0000000
--- a/src/packlib/fatmen/fatmen/fatopt0.inc
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: fatopt0.inc,v 1.1.1.1 1996/03/07 15:17:55 mclareni Exp $
-*
-* $Log: fatopt0.inc,v $
-* Revision 1.1.1.1 1996/03/07 15:17:55 mclareni
-* Fatmen
-*
-*
-#ifndef CERNLIB_FATMEN_FATOPT0_INC
-#define CERNLIB_FATMEN_FATOPT0_INC
-*
-*
-* fatopt0.inc
-*
- DIMENSION IOPT(36)
- EQUIVALENCE (IOPT(1),IOPTA),(IOPT(2),IOPTB),(IOPT(3),IOPTC),
- + (IOPT(4),IOPTD),(IOPT(5),IOPTE),(IOPT(6),IOPTF),
- + (IOPT(7),IOPTG),(IOPT(8),IOPTH),(IOPT(9),IOPTI),
- + (IOPT(10),IOPTJ),(IOPT(11),IOPTK),(IOPT(12),IOPTL),
- + (IOPT(13),IOPTM),(IOPT(14),IOPTN),(IOPT(15),IOPTO),
- + (IOPT(16),IOPTP),(IOPT(17),IOPTQ),(IOPT(18),IOPTR),
- + (IOPT(19),IOPTS),(IOPT(20),IOPTT),(IOPT(21),IOPTU),
- + (IOPT(22),IOPTV),(IOPT(23),IOPTW),(IOPT(24),IOPTX),
- + (IOPT(25),IOPTY),(IOPT(26),IOPTZ),(IOPT(27),IOPT1),
- + (IOPT(28),IOPT2),(IOPT(29),IOPT3),(IOPT(30),IOPT4),
- + (IOPT(31),IOPT5),(IOPT(32),IOPT6),(IOPT(33),IOPT7),
- + (IOPT(31),IOPT5),(IOPT(32),IOPT6),(IOPT(33),IOPT7),
- + (IOPT(34),IOPT8),(IOPT(35),IOPT9),(IOPT(36),IOPT0)
- CHARACTER*36 ALFNUM
-
-#endif
diff --git a/src/packlib/fatmen/fatmen/fatopt1.inc b/src/packlib/fatmen/fatmen/fatopt1.inc
deleted file mode 100644
index daa2f27..0000000
--- a/src/packlib/fatmen/fatmen/fatopt1.inc
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: fatopt1.inc,v 1.1.1.1 1996/03/07 15:17:55 mclareni Exp $
-*
-* $Log: fatopt1.inc,v $
-* Revision 1.1.1.1 1996/03/07 15:17:55 mclareni
-* Fatmen
-*
-*
-#ifndef CERNLIB_FATMEN_FATOPT1_INC
-#define CERNLIB_FATMEN_FATOPT1_INC
-*
-*
-* fatopt1.inc
-*
- DATA ALFNUM/'ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890'/
-
-
-#endif
diff --git a/src/packlib/fatmen/fatmen/fatoptc.inc b/src/packlib/fatmen/fatmen/fatoptc.inc
deleted file mode 100644
index 92711d5..0000000
--- a/src/packlib/fatmen/fatmen/fatoptc.inc
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: fatoptc.inc,v 1.1.1.1 1996/03/07 15:17:56 mclareni Exp $
-*
-* $Log: fatoptc.inc,v $
-* Revision 1.1.1.1 1996/03/07 15:17:56 mclareni
-* Fatmen
-*
-*
-#ifndef CERNLIB_FATMEN_FATOPTC_INC
-#define CERNLIB_FATMEN_FATOPTC_INC
-*
-*
-* fatoptc.inc
-*
- CALL FMOPTC(CHOPT,ALFNUM,IOPT)
-
-#endif
diff --git a/src/packlib/fatmen/fatmen/fatoptd.inc b/src/packlib/fatmen/fatmen/fatoptd.inc
deleted file mode 100644
index 1893ce7..0000000
--- a/src/packlib/fatmen/fatmen/fatoptd.inc
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: fatoptd.inc,v 1.1.1.1 1996/03/07 15:17:56 mclareni Exp $
-*
-* $Log: fatoptd.inc,v $
-* Revision 1.1.1.1 1996/03/07 15:17:56 mclareni
-* Fatmen
-*
-*
-#ifndef CERNLIB_FATMEN_FATOPTD_INC
-#define CERNLIB_FATMEN_FATOPTD_INC
-*
-*
-* fatoptd.inc
-*
-#include "fatmen/fatopt0.inc"
-#include "fatmen/fatopt1.inc"
-
-
-#endif
diff --git a/src/packlib/fatmen/fatmen/fatopts.inc b/src/packlib/fatmen/fatmen/fatopts.inc
deleted file mode 100644
index 66e21d5..0000000
--- a/src/packlib/fatmen/fatmen/fatopts.inc
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: fatopts.inc,v 1.1.1.1 1996/03/07 15:17:56 mclareni Exp $
-*
-* $Log: fatopts.inc,v $
-* Revision 1.1.1.1 1996/03/07 15:17:56 mclareni
-* Fatmen
-*
-*
-#ifndef CERNLIB_FATMEN_FATOPTS_INC
-#define CERNLIB_FATMEN_FATOPTS_INC
-*
-*
-* fatopts.inc
-*
- CHARACTER*(*) CHOPT
-#include "fatmen/fatoptd.inc"
- CALL FMOPTC(CHOPT,ALFNUM,IOPT)
-* CALL UOPTC(CHOPT,ALFNUM,IOPT)
-
-#endif
diff --git a/src/packlib/fatmen/fatmen/fatoset.inc b/src/packlib/fatmen/fatmen/fatoset.inc
deleted file mode 100644
index 6f4a8a2..0000000
--- a/src/packlib/fatmen/fatmen/fatoset.inc
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: fatoset.inc,v 1.1.1.1 1996/03/07 15:17:55 mclareni Exp $
-*
-* $Log: fatoset.inc,v $
-* Revision 1.1.1.1 1996/03/07 15:17:55 mclareni
-* Fatmen
-*
-*
-#ifndef CERNLIB_FATMEN_FATOSET_INC
-#define CERNLIB_FATMEN_FATOSET_INC
-*
-*
-* fatoset.inc
-*
- DO 9999 I=1,36
-9999 IOPT(I) = 1
-
-#endif
diff --git a/src/packlib/fatmen/fatmen/fatout.inc b/src/packlib/fatmen/fatmen/fatout.inc
deleted file mode 100644
index 14b3f97..0000000
--- a/src/packlib/fatmen/fatmen/fatout.inc
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: fatout.inc,v 1.1.1.1 1996/03/07 15:17:54 mclareni Exp $
-*
-* $Log: fatout.inc,v $
-* Revision 1.1.1.1 1996/03/07 15:17:54 mclareni
-* Fatmen
-*
-*
-#ifndef CERNLIB_FATMEN_FATOUT_INC
-#define CERNLIB_FATMEN_FATOUT_INC
-*
-*
-* fatout.inc
-*
- COMMON/FATOUT/OUTPUT,LPIPE
- CHARACTER*80 OUTPUT
-
-#endif
diff --git a/src/packlib/fatmen/fatmen/fatpara.inc b/src/packlib/fatmen/fatmen/fatpara.inc
deleted file mode 100644
index 19a5fe7..0000000
--- a/src/packlib/fatmen/fatmen/fatpara.inc
+++ /dev/null
@@ -1,98 +0,0 @@
-*
-* $Id: fatpara.inc,v 1.1.1.1 1996/03/07 15:17:58 mclareni Exp $
-*
-* $Log: fatpara.inc,v $
-* Revision 1.1.1.1 1996/03/07 15:17:58 mclareni
-* Fatmen
-*
-*
-#ifndef CERNLIB_FATMEN_FATPARA_INC
-#define CERNLIB_FATMEN_FATPARA_INC
-*
-*
-* fatpara.inc
-*
-* Start of FATMEN sequence FATPARA
-#include "fatmen/fttpara.inc"
-*
-** *** Data set bank mnemonics
-*
-* Keys
- PARAMETER ( MKSRFA= 1, MKFNFA= 2, MKCLFA=7, MKMTFA=8
- 1 ,MKLCFA= 9, MKNBFA=10, NKDSFA=10,MKDRFA=2)
-*
-** *** Bank offsets
-*
- PARAMETER ( MFQNFA= 1, MHSNFA= 65, MCPLFA= 67, MDRPFA= 67
- 1 ,MMTPFA= 68, MLOCFA= 69, MHSTFA= 70, MHOSFA= 74
- 2 ,MVSNFA= 77, MVIDFA= 79, MVIPFA= 81, MDENFA= 82
- 3 ,MVSQFA= 83, MFSQFA= 84, MSRDFA= 85, MERDFA= 86
- 4 ,MSBLFA= 87, MEBLFA= 88, MRFMFA= 89, MRLNFA= 90
- 5 ,MBLNFA= 91, MFLFFA= 92, MFUTFA= 93, MCRTFA= 94
- 6 ,MCTTFA= 95, MLATFA= 96, MCURFA= 97, MCIDFA= 99
- 7 ,MCNIFA=101, MCJIFA=103, MFPRFA=105, MSYWFA=106
- 8 ,MUSWFA=116, MUCMFA=126, NWDSFA=145
- 9 ,MFSZFA=MSYWFA,MUSCFA=MSYWFA+1)
-
-*
-** *** Lengths of character fields in bytes
-*
- PARAMETER ( NFQNFA = (MHSNFA-MFQNFA)*4,
- + NHSNFA = (MCPLFA-MHSNFA)*4,
- + NHSTFA = (MHOSFA-MHSTFA)*4,
- + NHOSFA = (MVSNFA-MHOSFA)*4,
- + NVSNFA = (MVIDFA-MVSNFA)*4,
- + NVIDFA = (MVIPFA-MVIDFA)*4,
- + NRFMFA = (MRLNFA-MRFMFA)*4,
- + NFLFFA = (MFUTFA-MFLFFA)*4,
- + NFUTFA = (MCRTFA-MFUTFA)*4,
- + NCURFA = (MCIDFA-MCURFA)*4,
- + NCIDFA = (MCNIFA-MCIDFA)*4,
- + NCNIFA = (MCJIFA-MCNIFA)*4,
- + NCJIFA = (MFPRFA-MCJIFA)*4,
- + NUCMFA = (NWDSFA-MUCMFA)*4)
-*
-** *** Lengths of integer fields in words
-*
- PARAMETER ( NCPLFA = 1 )
- PARAMETER ( NMTPFA = 1 )
- PARAMETER ( NLOCFA = 1 )
- PARAMETER ( NVIPFA = 1 )
- PARAMETER ( NDENFA = 1 )
- PARAMETER ( NVSQFA = 1 )
- PARAMETER ( NFSQFA = 1 )
- PARAMETER ( NSRDFA = 1 )
- PARAMETER ( NERDFA = 1 )
- PARAMETER ( NSBLFA = 1 )
- PARAMETER ( NEBLFA = 1 )
- PARAMETER ( NRLNFA = 1 )
- PARAMETER ( NBLNFA = 1 )
- PARAMETER ( NCRTFA = 1 )
- PARAMETER ( NCTTFA = 1 )
- PARAMETER ( NLATFA = 1 )
- PARAMETER ( NFPRFA = 1 )
- PARAMETER ( NFSZFA = 1 )
- PARAMETER ( NUSCFA = 1 )
- PARAMETER ( NUSWFA = 10 )
- PARAMETER ( NSYWFA = 10 )
-*
-* Definitions of 'Copy Level' (i.e. Data representation)
-* These definitions adhere to those used in FPACK
-*
-* PARAMETER (MFIEEE= 1, MFEEEI= 5, MFIBM =2, MFCRAY= 4,
- PARAMETER (MFIEEE= 1, MFEEEI= 4, MFIBM =2, MFCRAY= 5,
- + MFVAX = 3)
-
-*
-* Maximum # of location codes, copy levels, media types and luns
-*
- PARAMETER (KMXLOC=99, KMXCPL=99, KMXMTP=99, KMXLUN=99)
- PARAMETER (KMXKEY=99)
-
- INTEGER IBTYPE(35)
- INTEGER IBOFFS(35)
- INTEGER IBLENG(35)
- CHARACTER*6 CHBANK(35)
-* End of FATMEN sequence FATPARA
-
-#endif
diff --git a/src/packlib/fatmen/fatmen/fatran.inc b/src/packlib/fatmen/fatmen/fatran.inc
deleted file mode 100644
index f5e7a94..0000000
--- a/src/packlib/fatmen/fatmen/fatran.inc
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: fatran.inc,v 1.1.1.1 1996/03/07 15:17:53 mclareni Exp $
-*
-* $Log: fatran.inc,v $
-* Revision 1.1.1.1 1996/03/07 15:17:53 mclareni
-* Fatmen
-*
-*
-#ifndef CERNLIB_FATMEN_FATRAN_INC
-#define CERNLIB_FATMEN_FATRAN_INC
-*
-*
-* fatran.inc
-*
-#include "fatmen/fatran0.inc"
-#include "fatmen/fatran1.inc"
-
-#endif
diff --git a/src/packlib/fatmen/fatmen/fatran0.inc b/src/packlib/fatmen/fatmen/fatran0.inc
deleted file mode 100644
index 9e0e6bf..0000000
--- a/src/packlib/fatmen/fatmen/fatran0.inc
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: fatran0.inc,v 1.1.1.1 1996/03/07 15:17:53 mclareni Exp $
-*
-* $Log: fatran0.inc,v $
-* Revision 1.1.1.1 1996/03/07 15:17:53 mclareni
-* Fatmen
-*
-*
-#ifndef CERNLIB_FATMEN_FATRAN0_INC
-#define CERNLIB_FATMEN_FATRAN0_INC
-*
-*
-* fatran0.inc
-*
- PARAMETER (NTRANS=3)
- COMMON/FATRAN/ITRANS
- CHARACTER*8 CHTRNS(NTRANS),TRANSP(NTRANS)
-
-#endif
diff --git a/src/packlib/fatmen/fatmen/fatran1.inc b/src/packlib/fatmen/fatmen/fatran1.inc
deleted file mode 100644
index 8cd5d8c..0000000
--- a/src/packlib/fatmen/fatmen/fatran1.inc
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: fatran1.inc,v 1.1.1.1 1996/03/07 15:17:53 mclareni Exp $
-*
-* $Log: fatran1.inc,v $
-* Revision 1.1.1.1 1996/03/07 15:17:53 mclareni
-* Fatmen
-*
-*
-#ifndef CERNLIB_FATMEN_FATRAN1_INC
-#define CERNLIB_FATMEN_FATRAN1_INC
-*
-*
-* fatran1.inc
-*
- DATA CHTRNS/'T*CPIP','D*ECNET','C*HEOPS'/
- DATA TRANSP/'TCPIP ','DECNET','CHEOPS '/
-
-#endif
diff --git a/src/packlib/fatmen/fatmen/fatreg.inc b/src/packlib/fatmen/fatmen/fatreg.inc
deleted file mode 100644
index 2e89e22..0000000
--- a/src/packlib/fatmen/fatmen/fatreg.inc
+++ /dev/null
@@ -1,37 +0,0 @@
-*
-* $Id: fatreg.inc,v 1.1.1.1 1996/03/07 15:17:59 mclareni Exp $
-*
-* $Log: fatreg.inc,v $
-* Revision 1.1.1.1 1996/03/07 15:17:59 mclareni
-* Fatmen
-*
-*
-#ifndef CERNLIB_FATMEN_FATREG_INC
-#define CERNLIB_FATMEN_FATREG_INC
-*
-*
-* fatreg.inc
-*
-#if defined(CERNLIB_IBMMVS)
- MACRO
- REGISTER
-R0 EQU 0
-R1 EQU 1
-R2 EQU 2
-R3 EQU 3
-R4 EQU 4
-R5 EQU 5
-R6 EQU 6
-R7 EQU 7
-R8 EQU 8
-R9 EQU 9
-R10 EQU 10
-R11 EQU 11
-R12 EQU 12
-R13 EQU 13
-R14 EQU 14
-R15 EQU 15
- MEND
-#endif
-
-#endif
diff --git a/src/packlib/fatmen/fatmen/fatron.inc b/src/packlib/fatmen/fatmen/fatron.inc
deleted file mode 100644
index df3f100..0000000
--- a/src/packlib/fatmen/fatmen/fatron.inc
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: fatron.inc,v 1.1.1.1 1996/03/07 15:17:53 mclareni Exp $
-*
-* $Log: fatron.inc,v $
-* Revision 1.1.1.1 1996/03/07 15:17:53 mclareni
-* Fatmen
-*
-*
-#ifndef CERNLIB_FATMEN_FATRON_INC
-#define CERNLIB_FATMEN_FATRON_INC
-*
-*
-* fatron.inc
-*
- COMMON/FATRON/LTHR,THRONG
- CHARACTER*8 THRONG
-
-#endif
diff --git a/src/packlib/fatmen/fatmen/fatsat.inc b/src/packlib/fatmen/fatmen/fatsat.inc
deleted file mode 100644
index db231f7..0000000
--- a/src/packlib/fatmen/fatmen/fatsat.inc
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: fatsat.inc,v 1.1.1.1 1996/03/07 15:17:53 mclareni Exp $
-*
-* $Log: fatsat.inc,v $
-* Revision 1.1.1.1 1996/03/07 15:17:53 mclareni
-* Fatmen
-*
-*
-#ifndef CERNLIB_FATMEN_FATSAT_INC
-#define CERNLIB_FATMEN_FATSAT_INC
-*
-*
-* fatsat.inc
-*
-#include "fatmen/fatsat0.inc"
-#include "fatmen/fatsat1.inc"
-
-*
-
-#endif
diff --git a/src/packlib/fatmen/fatmen/fatsat0.inc b/src/packlib/fatmen/fatmen/fatsat0.inc
deleted file mode 100644
index bf604cf..0000000
--- a/src/packlib/fatmen/fatmen/fatsat0.inc
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: fatsat0.inc,v 1.1.1.1 1996/03/07 15:17:53 mclareni Exp $
-*
-* $Log: fatsat0.inc,v $
-* Revision 1.1.1.1 1996/03/07 15:17:53 mclareni
-* Fatmen
-*
-*
-#ifndef CERNLIB_FATMEN_FATSAT0_INC
-#define CERNLIB_FATMEN_FATSAT0_INC
-*
-*
-* fatsat0.inc
-*
- COMMON/FATSAT/LSRCST,LDSTST,CHSRCE,CHDEST
- CHARACTER*40 CHSRCE,CHDEST
-*
-* CHEOPS sites
-*
- PARAMETER (NSITES=5)
- CHARACTER*8 CHSITE(NSITES)
-
-#endif
diff --git a/src/packlib/fatmen/fatmen/fatsat1.inc b/src/packlib/fatmen/fatmen/fatsat1.inc
deleted file mode 100644
index 6b311d0..0000000
--- a/src/packlib/fatmen/fatmen/fatsat1.inc
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: fatsat1.inc,v 1.1.1.1 1996/03/07 15:17:53 mclareni Exp $
-*
-* $Log: fatsat1.inc,v $
-* Revision 1.1.1.1 1996/03/07 15:17:53 mclareni
-* Fatmen
-*
-*
-#ifndef CERNLIB_FATMEN_FATSAT1_INC
-#define CERNLIB_FATMEN_FATSAT1_INC
-*
-*
-* fatsat1.inc
-*
- DATA CHSITE(1)/'CERN '/,
- + CHSITE(2)/'HELSINKI'/,
- + CHSITE(3)/'LISBON '/,
- + CHSITE(4)/'SARDINIA'/,
- + CHSITE(5)/'ATHENS '/
-
-#endif
diff --git a/src/packlib/fatmen/fatmen/fatschl.inc b/src/packlib/fatmen/fatmen/fatschl.inc
deleted file mode 100644
index 6c6ab95..0000000
--- a/src/packlib/fatmen/fatmen/fatschl.inc
+++ /dev/null
@@ -1,37 +0,0 @@
-*
-* $Id: fatschl.inc,v 1.1.1.1 1996/03/07 15:17:59 mclareni Exp $
-*
-* $Log: fatschl.inc,v $
-* Revision 1.1.1.1 1996/03/07 15:17:59 mclareni
-* Fatmen
-*
-*
-#ifndef CERNLIB_FATMEN_FATSCHL_INC
-#define CERNLIB_FATMEN_FATSCHL_INC
-*
-*
-* fatschl.inc
-*
-#if defined(CERNLIB_IBMMVS)
- MACRO
-&NAME SCHL &RET=,&MODE=
-&NAME L 13,4(13) RELOAD SA-REG
- AIF ('&RET' NE '').RETCODE
- LM 14,12,12(13) RELOAD REGISTERS
- BR 14 RETURN TO CALLER
- MEXIT
-.RETCODE AIF ('&RET'(1,1) EQ '(').REGIST
- AIF (T'&RET NE 'N').ADDRESS
- LA 15,&RET LOAD REG 15 WITH RET CODE
- AGO .FURTHER
-.REGIST AIF ('&RET(1)' EQ '15').FURTHER
- LR 15,&RET(1) LOAD REG 15 WITH SPECIF. REGISTER
- AGO .FURTHER
-.ADDRESS L 15,&RET LOAD REG 15 FROM STORAGE
-.FURTHER LM 0,12,20(13) RESTORE REG 0 TO 12
- L 14,12(13) RESTORE REG 14
- BR 14 RETURN TO CALLER
- MEND
-#endif
-
-#endif
diff --git a/src/packlib/fatmen/fatmen/fatsea.inc b/src/packlib/fatmen/fatmen/fatsea.inc
deleted file mode 100644
index db91609..0000000
--- a/src/packlib/fatmen/fatmen/fatsea.inc
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: fatsea.inc,v 1.1.1.1 1996/03/07 15:17:55 mclareni Exp $
-*
-* $Log: fatsea.inc,v $
-* Revision 1.1.1.1 1996/03/07 15:17:55 mclareni
-* Fatmen
-*
-*
-#ifndef CERNLIB_FATMEN_FATSEA_INC
-#define CERNLIB_FATMEN_FATSEA_INC
-*
-*
-* fatsea.inc
-*
- COMMON/FATSEA/IDCREA,ITCREA,JDCREA,JTCREA,
- + IDCATA,ITCATA,JDCATA,JTCATA,
- + IDLAST,ITLAST,JDLAST,JTLAST,
- + IUSER(2,10)
-
-#endif
diff --git a/src/packlib/fatmen/fatmen/fatsel.inc b/src/packlib/fatmen/fatmen/fatsel.inc
deleted file mode 100644
index 830e5d5..0000000
--- a/src/packlib/fatmen/fatmen/fatsel.inc
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: fatsel.inc,v 1.1.1.1 1996/03/07 15:17:55 mclareni Exp $
-*
-* $Log: fatsel.inc,v $
-* Revision 1.1.1.1 1996/03/07 15:17:55 mclareni
-* Fatmen
-*
-*
-#ifndef CERNLIB_FATMEN_FATSEL_INC
-#define CERNLIB_FATMEN_FATSEL_INC
-*
-*
-* fatsel.inc
-*
-*
-* Common to store ranges for KEYS (for FATMEN selection)
-*
- COMMON/FATSEL/MRMTFA(2),MRCLFA(2),MRLCFA(2)
-
-#endif
diff --git a/src/packlib/fatmen/fatmen/fatshift.inc b/src/packlib/fatmen/fatmen/fatshift.inc
deleted file mode 100644
index 6652094..0000000
--- a/src/packlib/fatmen/fatmen/fatshift.inc
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: fatshift.inc,v 1.1.1.1 1996/03/07 15:17:52 mclareni Exp $
-*
-* $Log: fatshift.inc,v $
-* Revision 1.1.1.1 1996/03/07 15:17:52 mclareni
-* Fatmen
-*
-*
-#ifndef CERNLIB_FATMEN_FATSHIFT_INC
-#define CERNLIB_FATMEN_FATSHIFT_INC
-*
-*
-* fatshift.inc
-*
-*
-* Shift configuration file
-*
- COMMON/FMSHIFT/LSHCONF,LTPCONF,SHCONF,TPCONF
- CHARACTER*255 SHCONF,TPCONF
-
-#endif
diff --git a/src/packlib/fatmen/fatmen/fatsho.inc b/src/packlib/fatmen/fatmen/fatsho.inc
deleted file mode 100644
index f466f54..0000000
--- a/src/packlib/fatmen/fatmen/fatsho.inc
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: fatsho.inc,v 1.1.1.1 1996/03/07 15:17:58 mclareni Exp $
-*
-* $Log: fatsho.inc,v $
-* Revision 1.1.1.1 1996/03/07 15:17:58 mclareni
-* Fatmen
-*
-*
-#ifndef CERNLIB_FATMEN_FATSHO_INC
-#define CERNLIB_FATMEN_FATSHO_INC
-*
-*
-* fatsho.inc
-*
- COMMON/FATSHO/CWDSHO
- CHARACTER*255 CWDSHO
-
-#endif
diff --git a/src/packlib/fatmen/fatmen/fatstat.inc b/src/packlib/fatmen/fatmen/fatstat.inc
deleted file mode 100644
index 2f334d1..0000000
--- a/src/packlib/fatmen/fatmen/fatstat.inc
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: fatstat.inc,v 1.1.1.1 1996/03/07 15:17:52 mclareni Exp $
-*
-* $Log: fatstat.inc,v $
-* Revision 1.1.1.1 1996/03/07 15:17:52 mclareni
-* Fatmen
-*
-*
-#ifndef CERNLIB_FATMEN_FATSTAT_INC
-#define CERNLIB_FATMEN_FATSTAT_INC
-*
-*
-* fatstat.inc
-*
-*
-* Count number of server operations:
-* Number of different users, nodes, files, commands,
-* PUTs, MODs, DELs, MKDIRs, RMDIRs, OPENs and CLOSEs.
-* NFMUSR and NMFNOD not currently counted
-* Problems:
-* Number of warnings from RZDELK
-* Number of PUTs for existing entries
-* Number of REPs for non-existing entries
-* Number of DELs for non-existing entries
-* Number of BAD (unrecognised) commands
-* Number of logging records
-*
- COMMON/FATSTAT/NFMUSR,NFMNOD,NFMFIL,NFMCOM,NFMPUT,
- + NFMMOD,NFMDEL,NFMMDR,NFMRMD,NFMOPN,
- + NFMCLS,NFMPDK,NFMPRP,NFMPDL,NFMBAD,
- + NFMLOG
-
-#endif
diff --git a/src/packlib/fatmen/fatmen/fatstg.inc b/src/packlib/fatmen/fatmen/fatstg.inc
deleted file mode 100644
index be1dfd1..0000000
--- a/src/packlib/fatmen/fatmen/fatstg.inc
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: fatstg.inc,v 1.1.1.1 1996/03/07 15:17:57 mclareni Exp $
-*
-* $Log: fatstg.inc,v $
-* Revision 1.1.1.1 1996/03/07 15:17:57 mclareni
-* Fatmen
-*
-*
-#ifndef CERNLIB_FATMEN_FATSTG_INC
-#define CERNLIB_FATMEN_FATSTG_INC
-*
-*
-* fatstg.inc
-*
-*
-* Sequence FATSTG. Media size and density definitions
-* plus stage path name (first for L3)
-*
- COMMON/FATSTG/ISIZSG,STGPTH
- CHARACTER*255 STGPTH
-
-
-#endif
diff --git a/src/packlib/fatmen/fatmen/fatstruct.inc b/src/packlib/fatmen/fatmen/fatstruct.inc
deleted file mode 100644
index 013b9f0..0000000
--- a/src/packlib/fatmen/fatmen/fatstruct.inc
+++ /dev/null
@@ -1,91 +0,0 @@
-*
-* $Id: fatstruct.inc,v 1.1.1.1 1996/03/07 15:17:52 mclareni Exp $
-*
-* $Log: fatstruct.inc,v $
-* Revision 1.1.1.1 1996/03/07 15:17:52 mclareni
-* Fatmen
-*
-*
-#ifndef CERNLIB_FATMEN_FATSTRUCT_INC
-#define CERNLIB_FATMEN_FATSTRUCT_INC
-*
-*
-* fatstruct.inc
-*
-#if defined(CERNLIB_F90)
-*
-* Draft F90 derived data type for mapping to FATMEN bank
-*
- TYPE FATBANK
-*
-* Generic file description
-*
- CHARACTER*256 FILE_NAME
- CHARACTER*8 HOST_NAME
- INTEGER COPY_LEVEL
- INTEGER MEDIA_TYPE
- INTEGER LOCATION_CODE
-*
-* Disk description
-*
- CHARACTER*16 HOST_TYPE
- CHARACTER*12 HOST_SYSTEM
-*
-* Tape description
-*
- CHARACTER*8 VSN
- CHARACTER*8 VID
- INTEGER VID_PREFIX
- INTEGER DENSITY
- INTEGER VOLUME_SEQUENCE_NUMBER
- INTEGER FILE_SEQUENCE_NUMBER
-*
-* File description
-*
- INTEGER START_RECORD
- INTEGER END_RECORD
- INTEGER START_BLOCK
- INTEGER END_BLOCK
-*
-* Physical description
-*
- CHARACTER*4 RECORD_FORMAT
- INTEGER RECORD_LENGTH
- INTEGER BLOCK_LENGTH
- INTEGER FILE_SIZE
- INTEGER USE_COUNT
-*
-* Logical description
-*
- CHARACTER*4 LOGICAL_FORMAT
- CHARACTER*4 USER_FORMAT
-*
-* Dates and times
-*
- INTEGER DATE_CREATED
- INTEGER DATE_CATALOGUED
- INTEGER DATE_ACCESSED
-*
-* Creation information
-*
- CHARACTER*8 CREATED_BY_OWNER
- CHARACTER*8 CREATED_BY_ACCOUNT
- CHARACTER*8 CREATED_ON_NODE
- CHARACTER*8 CREATED_BY_JOB
-*
-* File protection
-*
- INTEGER FILE_PROTECTION_MASK
-*
-* User words
-*
- INTEGER USER_WORDS(10)
-*
-* System words
-*
- INTEGER SYSTEM_WORDS(10)
- END TYPE FATBANK
-#endif
-
-
-#endif
diff --git a/src/packlib/fatmen/fatmen/fatsys.inc b/src/packlib/fatmen/fatmen/fatsys.inc
deleted file mode 100644
index 44963db..0000000
--- a/src/packlib/fatmen/fatmen/fatsys.inc
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: fatsys.inc,v 1.1.1.1 1996/03/07 15:17:58 mclareni Exp $
-*
-* $Log: fatsys.inc,v $
-* Revision 1.1.1.1 1996/03/07 15:17:58 mclareni
-* Fatmen
-*
-*
-#ifndef CERNLIB_FATMEN_FATSYS_INC
-#define CERNLIB_FATMEN_FATSYS_INC
-*
-*
-* fatsys.inc
-*
-*
-* Common to store name of service machine (IBM)
-* or default directory (VAX, Unix)
-*
- COMMON/FATSYS/STRMLF,IFMODX,SERNAM,SERMOD,FATNOD,DEFAULT,
- + FATTOP,TOPDIR,LOCALQ
-* Mode at which server disk is accessed (VM)
- CHARACTER*1 SERMOD
-* Name of service machine
- CHARACTER*20 SERNAM
- CHARACTER*64 FATTOP
- CHARACTER*16 TOPDIR
- CHARACTER*80 FATNOD
- CHARACTER*132 LOCALQ
- CHARACTER*132 DEFAULT
- LOGICAL STRMLF
-
-#endif
diff --git a/src/packlib/fatmen/fatmen/fattyp.inc b/src/packlib/fatmen/fatmen/fattyp.inc
deleted file mode 100644
index abb5cdc..0000000
--- a/src/packlib/fatmen/fatmen/fattyp.inc
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: fattyp.inc,v 1.1.1.1 1996/03/07 15:17:57 mclareni Exp $
-*
-* $Log: fattyp.inc,v $
-* Revision 1.1.1.1 1996/03/07 15:17:57 mclareni
-* Fatmen
-*
-*
-#ifndef CERNLIB_FATMEN_FATTYP_INC
-#define CERNLIB_FATMEN_FATTYP_INC
-*
-* Media type definitions
-*
-* fattyp.inc
-*
- PARAMETER (NMTYP=100)
- COMMON/FATTYP/NFMTYP,CHMTYP,CHMGEN,CHMSIZ,
- + CHMDEN,CHMMNT,CHMLAB,MEDSIZ,
- + MEDDEN,MEDHWM,MEDMFL,MEDMFS
- INTEGER NFMTYP
- INTEGER MEDSIZ(NMTYP),MEDDEN(NMTYP),
- + MEDHWM(NMTYP),MEDMFL(NMTYP),
- + MEDMFS(NMTYP)
- CHARACTER*8 CHMTYP(NMTYP),CHMGEN(NMTYP),
- + CHMSIZ(NMTYP),CHMDEN(NMTYP),
- + CHMMNT(NMTYP),CHMLAB(NMTYP)
-
-
-#endif
diff --git a/src/packlib/fatmen/fatmen/fatupd.inc b/src/packlib/fatmen/fatmen/fatupd.inc
deleted file mode 100644
index cc599dc..0000000
--- a/src/packlib/fatmen/fatmen/fatupd.inc
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: fatupd.inc,v 1.1.1.1 1996/03/07 15:17:58 mclareni Exp $
-*
-* $Log: fatupd.inc,v $
-* Revision 1.1.1.1 1996/03/07 15:17:58 mclareni
-* Fatmen
-*
-*
-#ifndef CERNLIB_FATMEN_FATUPD_INC
-#define CERNLIB_FATMEN_FATUPD_INC
-*
-*
-* fatupd.inc
-*
- COMMON/FATUPD/MAXDEF,NGRDEF,NUPDT,MAXUPD,NGROUP,MAXVIO,NVIOL
-
-#endif
diff --git a/src/packlib/fatmen/fatmen/fatuse.inc b/src/packlib/fatmen/fatmen/fatuse.inc
deleted file mode 100644
index f0cfb78..0000000
--- a/src/packlib/fatmen/fatmen/fatuse.inc
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: fatuse.inc,v 1.1.1.1 1996/03/07 15:17:58 mclareni Exp $
-*
-* $Log: fatuse.inc,v $
-* Revision 1.1.1.1 1996/03/07 15:17:58 mclareni
-* Fatmen
-*
-*
-#ifndef CERNLIB_FATMEN_FATUSE_INC
-#define CERNLIB_FATMEN_FATUSE_INC
-*
-*
-* fatuse.inc
-*
-#if defined(CERNLIB_TYPE)
-#include "fatmen/fttbug.inc"
-#endif
- COMMON /FATUSE/ IDEBFA, IDIVFA, IKDRFA, KOFSFA, KOFUFA, LBFXFA
- + , LSAVFA, LTOPFA, LBBKFA, LBGNFA, LTDSFA, LBDSFA
- + , LPRTFA, NTOPFA, LUFZFA, IOUPFA, IOBKFA, IODSFA
- + , LLNLFA, LLNHFA
-
-#endif
diff --git a/src/packlib/fatmen/fatmen/fatusr.inc b/src/packlib/fatmen/fatmen/fatusr.inc
deleted file mode 100644
index b560c02..0000000
--- a/src/packlib/fatmen/fatmen/fatusr.inc
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: fatusr.inc,v 1.1.1.1 1996/03/07 15:17:54 mclareni Exp $
-*
-* $Log: fatusr.inc,v $
-* Revision 1.1.1.1 1996/03/07 15:17:54 mclareni
-* Fatmen
-*
-*
-#ifndef CERNLIB_FATMEN_FATUSR_INC
-#define CERNLIB_FATMEN_FATUSR_INC
-*
-*
-* fatusr.inc
-*
-*
- COMMON /USRLNK/LUSRK1,LUSRBK,LADDBK,LUSRLS
-
-#endif
diff --git a/src/packlib/fatmen/fatmen/fatuwd.inc b/src/packlib/fatmen/fatmen/fatuwd.inc
deleted file mode 100644
index b326caa..0000000
--- a/src/packlib/fatmen/fatmen/fatuwd.inc
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: fatuwd.inc,v 1.1.1.1 1996/03/07 15:17:55 mclareni Exp $
-*
-* $Log: fatuwd.inc,v $
-* Revision 1.1.1.1 1996/03/07 15:17:55 mclareni
-* Fatmen
-*
-*
-#ifndef CERNLIB_FATMEN_FATUWD_INC
-#define CERNLIB_FATMEN_FATUWD_INC
-*
-*
-* fatuwd.inc
-*
- COMMON/FATUWD/IFUSER(2,10)
-
-#endif
diff --git a/src/packlib/fatmen/fatmen/fatvaxrc.inc b/src/packlib/fatmen/fatmen/fatvaxrc.inc
deleted file mode 100644
index 83636bd..0000000
--- a/src/packlib/fatmen/fatmen/fatvaxrc.inc
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: fatvaxrc.inc,v 1.1.1.1 1996/03/07 15:17:52 mclareni Exp $
-*
-* $Log: fatvaxrc.inc,v $
-* Revision 1.1.1.1 1996/03/07 15:17:52 mclareni
-* Fatmen
-*
-*
-#ifndef CERNLIB_FATMEN_FATVAXRC_INC
-#define CERNLIB_FATMEN_FATVAXRC_INC
-*
-*
-* fatvaxrc.inc
-*
-* sequence FATVAXRC
- IF(.NOT.ISTAT) THEN
- CALL LIB$SIGNAL(%VAL(ISTAT))
- IRC = 42
- ENDIF
-
-#endif
diff --git a/src/packlib/fatmen/fatmen/fatveri.inc b/src/packlib/fatmen/fatmen/fatveri.inc
deleted file mode 100644
index 60d9460..0000000
--- a/src/packlib/fatmen/fatmen/fatveri.inc
+++ /dev/null
@@ -1,10 +0,0 @@
-#ifndef CERNLIB_FATMEN_FATVERI_INC
-#define CERNLIB_FATMEN_FATVERI_INC
-*
-*
-* fatlab.inc
-*
- COMMON/FATVERI/IFMVER
- INTEGER IFMVER
-
-#endif
diff --git a/src/packlib/fatmen/fatmen/fatvid0.inc b/src/packlib/fatmen/fatmen/fatvid0.inc
deleted file mode 100644
index ff5a3ca..0000000
--- a/src/packlib/fatmen/fatmen/fatvid0.inc
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: fatvid0.inc,v 1.1.1.1 1996/03/07 15:17:56 mclareni Exp $
-*
-* $Log: fatvid0.inc,v $
-* Revision 1.1.1.1 1996/03/07 15:17:56 mclareni
-* Fatmen
-*
-*
-#ifndef CERNLIB_FATMEN_FATVID0_INC
-#define CERNLIB_FATMEN_FATVID0_INC
-*
-*
-* fatvid0.inc
-*
-*
-* Sequence FATVIDP - table of VID prefices
-*
- CHARACTER*8 PREVID(6)
- INTEGER NTMS
- PARAMETER (NTMS=6)
-
-#endif
diff --git a/src/packlib/fatmen/fatmen/fatvid1.inc b/src/packlib/fatmen/fatmen/fatvid1.inc
deleted file mode 100644
index 8776ad3..0000000
--- a/src/packlib/fatmen/fatmen/fatvid1.inc
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: fatvid1.inc,v 1.1.1.1 1996/03/07 15:17:57 mclareni Exp $
-*
-* $Log: fatvid1.inc,v $
-* Revision 1.1.1.1 1996/03/07 15:17:57 mclareni
-* Fatmen
-*
-*
-#ifndef CERNLIB_FATMEN_FATVID1_INC
-#define CERNLIB_FATMEN_FATVID1_INC
-*
-*
-* fatvid1.inc
-*
- DATA PREVID(1) /'CERN '/,PREVID(2) /'IN2P3 '/,
- + PREVID(3) /'SACLAY '/,PREVID(4) /'DESY '/,
- + PREVID(5) /'RAL '/,PREVID(6) /'SEFT '/
-
-
-#endif
diff --git a/src/packlib/fatmen/fatmen/fatvidp.inc b/src/packlib/fatmen/fatmen/fatvidp.inc
deleted file mode 100644
index 596b979..0000000
--- a/src/packlib/fatmen/fatmen/fatvidp.inc
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: fatvidp.inc,v 1.1.1.1 1996/03/07 15:17:57 mclareni Exp $
-*
-* $Log: fatvidp.inc,v $
-* Revision 1.1.1.1 1996/03/07 15:17:57 mclareni
-* Fatmen
-*
-*
-#ifndef CERNLIB_FATMEN_FATVIDP_INC
-#define CERNLIB_FATMEN_FATVIDP_INC
-*
-*
-* fatvidp.inc
-*
-#include "fatmen/fatvid0.inc"
-#include "fatmen/fatvid1.inc"
-
-
-#endif
diff --git a/src/packlib/fatmen/fatmen/faust.inc b/src/packlib/fatmen/fatmen/faust.inc
deleted file mode 100644
index 2b64f9d..0000000
--- a/src/packlib/fatmen/fatmen/faust.inc
+++ /dev/null
@@ -1,55 +0,0 @@
-*
-* $Id: faust.inc,v 1.1.1.1 1996/03/07 15:17:52 mclareni Exp $
-*
-* $Log: faust.inc,v $
-* Revision 1.1.1.1 1996/03/07 15:17:52 mclareni
-* Fatmen
-*
-*
-#ifndef CERNLIB_FATMEN_FAUST_INC
-#define CERNLIB_FATMEN_FAUST_INC
-*
-*
-* faust.inc
-*
-*
-* FATMEN USer STatistics
-*
-* Adds, MKDIRS, RMDIRS etc.
-*
- INTEGER NFADDD,NFADDL,NFADDT,NFMDIR,NFRDIR,NFRLNK,NFRTRE,
- + NFRMFL,NFCPFL,NFMVFL,NFMODI,NFTOUC
-*
-* OPENs, CLOSEs, COPYs etc.
-*
- INTEGER NFOPEN,NFCLOS,NFCOPY,NFCOPR,NFCOPQ
-*
-* TMS operations
-*
- INTEGER NFSREQ,NFQVOL,NFAVOL,NFASPC,NFPOOL,NFLOCK,NFULOK,
- + NFDTAG,NFGTAG,NFSTAG
-*
-* Catalogue operations
-*
- INTEGER NFBANK,NFGET, NFGETK,NFSHOW,NFSCAN,NFLOOP,NFLDIR,
- + NFLFIL,NFSORT,NFRANK,NFSELK,NFMTCH
-*
-* # MB read/written
-*
- REAL FATMBR,FATMBW,FATMZR,FATMZW,FATMBC,FATMBQ,FATMBN
-*
-* Stuff
-*
- INTEGER NFSTAD,NFSTAT
-
- COMMON/FAUST/NFADDD,NFADDL,NFADDT,NFMDIR,NFRDIR,NFRLNK,NFRTRE,
- + NFRMFL,NFCPFL,NFMVFL,NFMODI,NFTOUC,
- + NFOPEN,NFCLOS,NFCOPY,NFCOPR,NFCOPQ,
- + NFSREQ,NFQVOL,NFAVOL,NFASPC,NFPOOL,NFLOCK,NFULOK,
- + NFDTAG,NFGTAG,NFSTAG,
- + NFBANK,NFGET, NFGETK,NFSHOW,NFSCAN,NFLOOP,NFLDIR,
- + NFLFIL,NFSORT,NFRANK,NFSELK,NFMTCH,
- + NFSTAD,NFSTAT,
- + FATMBR,FATMBW,FATMZR,FATMZW,FATMBC,FATMBQ,FATMBN
-
-#endif
diff --git a/src/packlib/fatmen/fatmen/fausto.inc b/src/packlib/fatmen/fatmen/fausto.inc
deleted file mode 100644
index 51ccd5e..0000000
--- a/src/packlib/fatmen/fatmen/fausto.inc
+++ /dev/null
@@ -1,116 +0,0 @@
-*
-* $Id: fausto.inc,v 1.1.1.1 1996/03/07 15:17:52 mclareni Exp $
-*
-* $Log: fausto.inc,v $
-* Revision 1.1.1.1 1996/03/07 15:17:52 mclareni
-* Fatmen
-*
-*
-#ifndef CERNLIB_FATMEN_FAUSTO_INC
-#define CERNLIB_FATMEN_FAUSTO_INC
-*
-*
-* fausto.inc
-*
- PARAMETER (KOHOLL=0)
- PARAMETER (KLHOLL=70)
-
- PARAMETER (KOREAL=KOHOLL+KLHOLL)
- PARAMETER (KLREAL=20)
-
- PARAMETER (KODATE=KOREAL+KLREAL)
- PARAMETER (KLDATE=10)
-
- PARAMETER (KOCMOD=KODATE+KLDATE)
- PARAMETER (KLCMOD=20)
-
- PARAMETER (KOFILE=KOCMOD+KLCMOD)
- PARAMETER (KLFILE=10)
-
- PARAMETER (KOTMS =KOFILE+KLFILE)
- PARAMETER (KLTMS =20)
-
- PARAMETER (KOCFAT=KOTMS +KLTMS )
- PARAMETER (KLCFAT=20)
-
- PARAMETER (KLINT = KLDATE+KLCMOD+KLFILE+KLTMS+KLCFAT)
-*
-* Hollerith block
-*
- PARAMETER (KFMSYS=KOHOLL+2)
- PARAMETER (KFMGRP=KOHOLL+7)
- PARAMETER (KFMTIT=KOHOLL+12)
- PARAMETER (KFMUSR=KOHOLL+31)
- PARAMETER (KFMHST=KOHOLL+41)
- PARAMETER (KFMTYP=KOHOLL+51)
- PARAMETER (KFMOS =KOHOLL+61)
-*
-* MB counts
-*
- PARAMETER (KFMMBR=KOREAL+1)
- PARAMETER (KFMMBW=KOREAL+2)
- PARAMETER (KFZMBR=KOREAL+3)
- PARAMETER (KFZMBW=KOREAL+4)
- PARAMETER (KFMMBC=KOREAL+5)
- PARAMETER (KFMMBN=KOREAL+6)
- PARAMETER (KFMMBQ=KOREAL+7)
-*
-* Dates and times
-*
- PARAMETER (KFMIDQ=KODATE+1)
- PARAMETER (KFMIDS=KODATE+2)
- PARAMETER (KFMIDE=KODATE+3)
-*
-* Catalogue modifications
-*
- PARAMETER (KFMADD=KOCMOD+1)
- PARAMETER (KFMADL=KOCMOD+2)
- PARAMETER (KFMADT=KOCMOD+3)
- PARAMETER (KFMMDR=KOCMOD+4)
- PARAMETER (KFMRDR=KOCMOD+5)
- PARAMETER (KFMRLN=KOCMOD+6)
- PARAMETER (KFMRTR=KOCMOD+7)
- PARAMETER (KFMRMF=KOCMOD+8)
- PARAMETER (KFMCPF=KOCMOD+9)
- PARAMETER (KFMMVF=KOCMOD+10)
- PARAMETER (KFMMOD=KOCMOD+11)
- PARAMETER (KFMTCH=KOCMOD+12)
-*
-* File accesses (OPENs, CLOSEs, COPYs)
-*
- PARAMETER (KFMOPN=KOFILE+1)
- PARAMETER (KFMCLS=KOFILE+2)
- PARAMETER (KFMCPY=KOFILE+3)
- PARAMETER (KFMCPQ=KOFILE+5)
- PARAMETER (KFMCPN=KOFILE+5)
-*
-* SYSREQ and TMS operations
-*
- PARAMETER (KFMSRQ=KOTMS+1)
- PARAMETER (KFMQVL=KOTMS+2)
- PARAMETER (KFMAVL=KOTMS+3)
- PARAMETER (KFMASP=KOTMS+4)
- PARAMETER (KFMPOL=KOTMS+5)
- PARAMETER (KFMLCK=KOTMS+6)
- PARAMETER (KFMULK=KOTMS+7)
- PARAMETER (KFMDTG=KOTMS+8)
- PARAMETER (KFMGTG=KOTMS+9)
- PARAMETER (KFMSTG=KOTMS+10)
-*
-* Catalogue processing
-*
- PARAMETER (KFMBNK=KOCFAT+1)
- PARAMETER (KFMGET=KOCFAT+2)
- PARAMETER (KFMGTK=KOCFAT+3)
- PARAMETER (KFMSHW=KOCFAT+4)
- PARAMETER (KFMSCN=KOCFAT+5)
- PARAMETER (KFMLOP=KOCFAT+6)
- PARAMETER (KFMLDR=KOCFAT+7)
- PARAMETER (KFMLFL=KOCFAT+8)
- PARAMETER (KFMSRT=KOCFAT+9)
- PARAMETER (KFMRNK=KOCFAT+10)
- PARAMETER (KFMSLK=KOCFAT+11)
- PARAMETER (KFMMTC=KOCFAT+12)
-
-
-#endif
diff --git a/src/packlib/fatmen/fatmen/fmaxcop.inc b/src/packlib/fatmen/fatmen/fmaxcop.inc
deleted file mode 100644
index 1da6300..0000000
--- a/src/packlib/fatmen/fatmen/fmaxcop.inc
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: fmaxcop.inc,v 1.1.1.1 1996/03/07 15:17:54 mclareni Exp $
-*
-* $Log: fmaxcop.inc,v $
-* Revision 1.1.1.1 1996/03/07 15:17:54 mclareni
-* Fatmen
-*
-*
-#ifndef CERNLIB_FATMEN_FMAXCOP_INC
-#define CERNLIB_FATMEN_FMAXCOP_INC
-*
-*
-* fmaxcop.inc
-*
-*
-* The following statement limits the maximum number of copies
-* of a file that can exist, i.e. the maximum number of entries
-* with the same generic name
-*
- PARAMETER (MAXCOP=100)
-
-#endif
diff --git a/src/packlib/fatmen/fatmen/fmdrep.inc b/src/packlib/fatmen/fatmen/fmdrep.inc
deleted file mode 100644
index b2d1af2..0000000
--- a/src/packlib/fatmen/fatmen/fmdrep.inc
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: fmdrep.inc,v 1.1.1.1 1996/03/07 15:17:58 mclareni Exp $
-*
-* $Log: fmdrep.inc,v $
-* Revision 1.1.1.1 1996/03/07 15:17:58 mclareni
-* Fatmen
-*
-*
-#ifndef CERNLIB_FATMEN_FMDREP_INC
-#define CERNLIB_FATMEN_FMDREP_INC
-*
-*
-* fmdrep.inc
-*
- PARAMETER (NWFFAT=5)
- COMMON/FMDREP/CHDREP
- CHARACTER*30 CHDREP(NWFFAT)
-
-#endif
diff --git a/src/packlib/fatmen/fatmen/fmnkeys.inc b/src/packlib/fatmen/fatmen/fmnkeys.inc
deleted file mode 100644
index 4d15ce4..0000000
--- a/src/packlib/fatmen/fatmen/fmnkeys.inc
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: fmnkeys.inc,v 1.1.1.1 1996/03/07 15:17:54 mclareni Exp $
-*
-* $Log: fmnkeys.inc,v $
-* Revision 1.1.1.1 1996/03/07 15:17:54 mclareni
-* Fatmen
-*
-*
-#ifndef CERNLIB_FATMEN_FMNKEYS_INC
-#define CERNLIB_FATMEN_FMNKEYS_INC
-*
-*
-* fmnkeys.inc
-*
- PARAMETER (LKEYFA=10)
-
-#endif
diff --git a/src/packlib/fatmen/fatmen/fmpath.inc b/src/packlib/fatmen/fatmen/fmpath.inc
deleted file mode 100644
index 00a16b2..0000000
--- a/src/packlib/fatmen/fatmen/fmpath.inc
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: fmpath.inc,v 1.1.1.1 1996/03/07 15:17:58 mclareni Exp $
-*
-* $Log: fmpath.inc,v $
-* Revision 1.1.1.1 1996/03/07 15:17:58 mclareni
-* Fatmen
-*
-*
-#ifndef CERNLIB_FATMEN_FMPATH_INC
-#define CERNLIB_FATMEN_FMPATH_INC
-*
-*
-* fmpath.inc
-*
- CHARACTER*255 PATH,FILE1,FILE2,CDIR
- COMMON/FMKCOM/LCDIR,CDIR
-*
-
-#endif
diff --git a/src/packlib/fatmen/fatmen/fmqued.inc b/src/packlib/fatmen/fatmen/fmqued.inc
deleted file mode 100644
index 32c5fa1..0000000
--- a/src/packlib/fatmen/fatmen/fmqued.inc
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: fmqued.inc,v 1.1.1.1 1996/03/07 15:17:52 mclareni Exp $
-*
-* $Log: fmqued.inc,v $
-* Revision 1.1.1.1 1996/03/07 15:17:52 mclareni
-* Fatmen
-*
-*
-#ifndef CERNLIB_FATMEN_FMQUED_INC
-#define CERNLIB_FATMEN_FMQUED_INC
-*
-*
-* fmqued.inc
-*
- COMMON/FMQUED/LQUED,CHQUED
- CHARACTER*255 CHQUED
-
-#endif
diff --git a/src/packlib/fatmen/fatmen/fmshft.inc b/src/packlib/fatmen/fatmen/fmshft.inc
deleted file mode 100644
index d3e1002..0000000
--- a/src/packlib/fatmen/fatmen/fmshft.inc
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: fmshft.inc,v 1.1.1.1 1996/03/07 15:17:52 mclareni Exp $
-*
-* $Log: fmshft.inc,v $
-* Revision 1.1.1.1 1996/03/07 15:17:52 mclareni
-* Fatmen
-*
-*
-#ifndef CERNLIB_FATMEN_FMSHFT_INC
-#define CERNLIB_FATMEN_FMSHFT_INC
-*
-*
-* fmshft.inc
-*
- COMMON/FMSHFT/SHFNAM,SHUNAM,SHPOOL,SHUSER
- CHARACTER*255 SHFNAM,SHUNAM
- CHARACTER*16 SHPOOL,SHUSER
-
-
-#endif
diff --git a/src/packlib/fatmen/fatmen/fstate.inc b/src/packlib/fatmen/fatmen/fstate.inc
deleted file mode 100644
index 3f0f77a..0000000
--- a/src/packlib/fatmen/fatmen/fstate.inc
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: fstate.inc,v 1.1.1.1 1996/03/07 15:17:53 mclareni Exp $
-*
-* $Log: fstate.inc,v $
-* Revision 1.1.1.1 1996/03/07 15:17:53 mclareni
-* Fatmen
-*
-*
-#ifndef CERNLIB_FATMEN_FSTATE_INC
-#define CERNLIB_FATMEN_FSTATE_INC
-*
-*
-* fstate.inc
-*
- COMMON/FSTATE/MFPHAS
-
-#endif
diff --git a/src/packlib/fatmen/fatmen/fttbug.inc b/src/packlib/fatmen/fatmen/fttbug.inc
deleted file mode 100644
index 9c4b94f..0000000
--- a/src/packlib/fatmen/fatmen/fttbug.inc
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: fttbug.inc,v 1.1.1.1 1996/03/07 15:17:58 mclareni Exp $
-*
-* $Log: fttbug.inc,v $
-* Revision 1.1.1.1 1996/03/07 15:17:58 mclareni
-* Fatmen
-*
-*
-#ifndef CERNLIB_FATMEN_FTTBUG_INC
-#define CERNLIB_FATMEN_FTTBUG_INC
-*
-*
-* fttbug.inc
-*
- INTEGER IDEBFA, IDIVFA, IKDRFA, KOFSFA, KOFUFA, LBFXFA
- + , LSAVFA, LTOPFA, LBBKFA, LBGNFA, LTDSFA, LBDSFA
- + , LPRTFA, NTOPFA, LUFZFA, IOUPFA, IOBKFA, IODSFA
- + , LLNLFA, LLNHFA
-
-#endif
diff --git a/src/packlib/fatmen/fatmen/fttpara.inc b/src/packlib/fatmen/fatmen/fttpara.inc
deleted file mode 100644
index fb0a817..0000000
--- a/src/packlib/fatmen/fatmen/fttpara.inc
+++ /dev/null
@@ -1,55 +0,0 @@
-*
-* $Id: fttpara.inc,v 1.1.1.1 1996/03/07 15:17:58 mclareni Exp $
-*
-* $Log: fttpara.inc,v $
-* Revision 1.1.1.1 1996/03/07 15:17:58 mclareni
-* Fatmen
-*
-*
-#ifndef CERNLIB_FATMEN_FTTPARA_INC
-#define CERNLIB_FATMEN_FTTPARA_INC
-*
-*
-* fttpara.inc
-*
- INTEGER MKSRFA,MKFNFA,MKCLFA,MKMTFA,MKLCFA,MKNBFA,NKDSFA
- INTEGER MFQNFA,MHSNFA,MCPLFA,MMTPFA,MLOCFA,MHSTFA,MHOSFA,
- + MVSNFA,MVIDFA,MVIPFA,MDENFA,MVSQFA,MFSQFA,MSRDFA,
- + MERDFA,MSBLFA,MEBLFA,MRFMFA,MRLNFA,MBLNFA,MFLFFA,
- + MFUTFA,MCRTFA,MCTTFA,MLATFA,MCURFA,MCIDFA,MCNIFA,
- + MCJIFA,MFPRFA,MSYWFA,MUSWFA,MUCMFA,NWDSFA,MFSZFA,
- + MUSCFA,MDRPFA,MKDRFA
-
- INTEGER NFQNFA,NHSNFA,NHSTFA,NHOSFA,NVSNFA,NVIDFA,NFLFFA,
- + NRFMFA,NFUTFA,NCURFA,NCIDFA,NCNIFA,NCJIFA,NUCMFA
-
- INTEGER MFIEEE,MFEEEI,MFIBM, MFCRAY,MFVAX ,MFUNIX,MFULTR
-
- INTEGER KMXLOC,KMXCPL,KMXMTP,KMXLUN
- INTEGER MFMLOC,MFMCPL,MFMMTP,MFMLUN
- INTEGER KMXKEY
-
- INTEGER NCPLFA
- INTEGER NMTPFA
- INTEGER NLOCFA
- INTEGER NVIPFA
- INTEGER NDENFA
- INTEGER NVSQFA
- INTEGER NFSQFA
- INTEGER NSRDFA
- INTEGER NERDFA
- INTEGER NSBLFA
- INTEGER NEBLFA
- INTEGER NRLNFA
- INTEGER NBLNFA
- INTEGER NCRTFA
- INTEGER NCTTFA
- INTEGER NLATFA
- INTEGER NFPRFA
- INTEGER NFSZFA
- INTEGER NUSCFA
- INTEGER NUSWFA
- INTEGER NSYWFA
-
-
-#endif
diff --git a/src/packlib/fatmen/fatmen/pilot.h b/src/packlib/fatmen/fatmen/pilot.h
deleted file mode 100644
index 2ede6fe..0000000
--- a/src/packlib/fatmen/fatmen/pilot.h
+++ /dev/null
@@ -1,38 +0,0 @@
-#if (!defined(CERNLIB_FNAL))&&(!defined(CERNLIB_DESY))
-#define CERNLIB_CERN
-#endif
-
-#if defined(CERNLIB_WINNT)
-# ifdef CERNLIB_MSSTDCALL
-# define CERNLIB_QXCAPT
-# endif
-#if !defined(CERNLIB_UNIX)
-# define CERNLIB_UNIX
-#endif
-#endif
-
-
-#if defined(CERNLIB_UNIX)
-#if !defined(CERNLIB_SINGLE)
-#define CERNLIB_DOUBLE
-#endif
-
-#define CERNLIB_EQUHOLCH
-#define CERNLIB_QHOLL
-#define CERNLIB_QTRHOLL
-#ifndef CERNLIB_QXCAPT
-# define CERNLIB_QX_SC
-#endif
-#endif
-
-#if defined(CERNLIB_VAXVMS)
-#define CERNLIB_DOUBLE
-
-#ifndef CERNLIB_VAX
-#define CERNLIB_VAX
-#endif
-
-#define CERNLIB_EQUHOLCH
-#define CERNLIB_QHOLL
-#define CERNLIB_QTRHOLL
-#endif
diff --git a/src/packlib/fatmen/fatmen/qftitlch.inc b/src/packlib/fatmen/fatmen/qftitlch.inc
deleted file mode 100644
index 7718bfa..0000000
--- a/src/packlib/fatmen/fatmen/qftitlch.inc
+++ /dev/null
@@ -1,10 +0,0 @@
-*
-#ifndef CERNLIB_FATMEN_QFTITLCH_INC
-#define CERNLIB_FATMEN_QFTITLCH_INC
-*
-*
-* qftitlch.inc
-*
-#define FatmenTitleFortranString \
-'FATMEN 1.92/05 991225 09:30 CERN PROGRAM LIBRARY FATMEN=Q123'
-#endif
diff --git a/src/packlib/fatmen/fatmen/slate.inc b/src/packlib/fatmen/fatmen/slate.inc
deleted file mode 100644
index 9176952..0000000
--- a/src/packlib/fatmen/fatmen/slate.inc
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: slate.inc,v 1.1.1.1 1996/03/07 15:17:54 mclareni Exp $
-*
-* $Log: slate.inc,v $
-* Revision 1.1.1.1 1996/03/07 15:17:54 mclareni
-* Fatmen
-*
-*
-#ifndef CERNLIB_FATMEN_SLATE_INC
-#define CERNLIB_FATMEN_SLATE_INC
-*
-*
-* slate.inc
-*
- COMMON/SLATE/IS(40)
- INTEGER IS
-
-#endif
diff --git a/src/packlib/fatmen/fatmen/slatex.inc b/src/packlib/fatmen/fatmen/slatex.inc
deleted file mode 100644
index 1d5212a..0000000
--- a/src/packlib/fatmen/fatmen/slatex.inc
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: slatex.inc,v 1.1.1.1 1996/03/07 15:17:54 mclareni Exp $
-*
-* $Log: slatex.inc,v $
-* Revision 1.1.1.1 1996/03/07 15:17:54 mclareni
-* Fatmen
-*
-*
-#ifndef CERNLIB_FATMEN_SLATEX_INC
-#define CERNLIB_FATMEN_SLATEX_INC
-*
-*
-* slatex.inc
-*
- COMMON/SLATEX_/IS(40)
- INTEGER IS
-
-#endif
diff --git a/src/packlib/fatmen/fatmen/tmsdef.inc b/src/packlib/fatmen/fatmen/tmsdef.inc
deleted file mode 100644
index 1cf48f1..0000000
--- a/src/packlib/fatmen/fatmen/tmsdef.inc
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: tmsdef.inc,v 1.1.1.1 1996/03/07 15:17:56 mclareni Exp $
-*
-* $Log: tmsdef.inc,v $
-* Revision 1.1.1.1 1996/03/07 15:17:56 mclareni
-* Fatmen
-*
-*
-#ifndef CERNLIB_FATMEN_TMSDEF_INC
-#define CERNLIB_FATMEN_TMSDEF_INC
-*
-*
-* tmsdef.inc
-*
-#include "fatmen/tmsdef0.inc"
-#include "fatmen/tmsdef1.inc"
-
-
-#endif
diff --git a/src/packlib/fatmen/fatmen/tmsdef0.inc b/src/packlib/fatmen/fatmen/tmsdef0.inc
deleted file mode 100644
index d97ca88..0000000
--- a/src/packlib/fatmen/fatmen/tmsdef0.inc
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: tmsdef0.inc,v 1.1.1.1 1996/03/07 15:17:56 mclareni Exp $
-*
-* $Log: tmsdef0.inc,v $
-* Revision 1.1.1.1 1996/03/07 15:17:56 mclareni
-* Fatmen
-*
-*
-#ifndef CERNLIB_FATMEN_TMSDEF0_INC
-#define CERNLIB_FATMEN_TMSDEF0_INC
-*
-*
-* tmsdef0.inc
-*
- CHARACTER*6 DENS
- CHARACTER*8 LIB
- CHARACTER*4 LABTYP
- CHARACTER*1 MNTTYP
- CHARACTER*8 MODEL
- CHARACTER*7 ROBMAN(2)
-
-#endif
diff --git a/src/packlib/fatmen/fatmen/tmsdef1.inc b/src/packlib/fatmen/fatmen/tmsdef1.inc
deleted file mode 100644
index 9518a05..0000000
--- a/src/packlib/fatmen/fatmen/tmsdef1.inc
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: tmsdef1.inc,v 1.1.1.1 1996/03/07 15:17:56 mclareni Exp $
-*
-* $Log: tmsdef1.inc,v $
-* Revision 1.1.1.1 1996/03/07 15:17:56 mclareni
-* Fatmen
-*
-*
-#ifndef CERNLIB_FATMEN_TMSDEF1_INC
-#define CERNLIB_FATMEN_TMSDEF1_INC
-*
-*
-* tmsdef1.inc
-*
- DATA ROBMAN(1)/'-Robot '/,ROBMAN(2)/'-Manual'/
-
-#endif
diff --git a/src/packlib/fatmen/fatmen/tmsrep.inc b/src/packlib/fatmen/fatmen/tmsrep.inc
deleted file mode 100644
index 1a3f563..0000000
--- a/src/packlib/fatmen/fatmen/tmsrep.inc
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: tmsrep.inc,v 1.1.1.1 1996/03/07 15:17:56 mclareni Exp $
-*
-* $Log: tmsrep.inc,v $
-* Revision 1.1.1.1 1996/03/07 15:17:56 mclareni
-* Fatmen
-*
-*
-#ifndef CERNLIB_FATMEN_TMSREP_INC
-#define CERNLIB_FATMEN_TMSREP_INC
-*
-*
-* tmsrep.inc
-*
- PARAMETER (LENREP=20)
- CHARACTER*132 TMSREP(LENREP)
-
-#endif
diff --git a/src/packlib/fatmen/fattest/addfat.dat b/src/packlib/fatmen/fattest/addfat.dat
deleted file mode 100644
index f6c0ef2..0000000
--- a/src/packlib/fatmen/fattest/addfat.dat
+++ /dev/null
@@ -1,62 +0,0 @@
-*
-* $Id: addfat.dat,v 1.1.1.1 1996/03/07 15:18:02 mclareni Exp $
-*
-* $Log: addfat.dat,v $
-* Revision 1.1.1.1 1996/03/07 15:18:02 mclareni
-* Fatmen
-*
-*
- PROGRAM ADDTEST
- CHARACTER*80 GENAM
- CHARACTER*80 DSN,COMM
- CHARACTER*8 HOST
- CHARACTER*4 FFORM,RECFM,CHOPT
-*
-* User words
-*
- DIMENSION IVECT(10)
-*
-* Initialise FATMEN. Read catalogue on unit 1, updates on unit 2
-*
- CALL FMSTRT(1,2,'//CERN/CNDIV',IRC)
-*
-* Maximum (documented) log level
-*
- CALL FMLOGL(3)
-*
-* Add a disk file
-*
-* Generic name...
- GENAM = '//CERN/CNDIV/JAMIE/TESTING'
-* File name...
- DSN = 'DISK$CD:[JAMIE.FATMEN]FXFILE.DAT'
-* File format (FZ binary exchange)...
- FFORM = 'FX'
-* Data type or copy level... (none)
- IDAT = 0
-* Host name...
- HOST = 'CERNVM'
-* Record format (fixed length records)...
- RECFM = 'F'
-* Record length in bytes...
- LRECL = 32400
-* Block length in bytes...
- LBLCK = 32400
-* File size in MB...
- ISIZE = 1
-* Comment...
- COMM = 'Sample FZ file'
-* Options:
- CHOPT = ' '
-* User words...
-
- DO 10 I=1,10
-10 IVECT(I) = IRNDM(DUMMY)
-
- CALL FMADDD(GENAM,DSN,FFORM,IDAT,HOST,RECFM,LRECL,LBLCK,ISIZE,
- + COMM,IVECT,CHOPT,IRC)
-
- CALL FMEND(IRC)
- PRINT *,'Return code ',IRC,' from FMEND'
-*
- END
diff --git a/src/packlib/fatmen/fattest/addfpack.dat b/src/packlib/fatmen/fattest/addfpack.dat
deleted file mode 100644
index 79e62f3..0000000
--- a/src/packlib/fatmen/fattest/addfpack.dat
+++ /dev/null
@@ -1,62 +0,0 @@
-*
-* $Id: addfpack.dat,v 1.1.1.1 1996/03/07 15:18:03 mclareni Exp $
-*
-* $Log: addfpack.dat,v $
-* Revision 1.1.1.1 1996/03/07 15:18:03 mclareni
-* Fatmen
-*
-*
- PROGRAM ADDTEST
- CHARACTER*80 GENAM
- CHARACTER*80 DSN,COMM
- CHARACTER*8 HOST
- CHARACTER*4 FFORM,RECFM,CHOPT
-*
-* User words
-*
- DIMENSION IVECT(10)
-*
-* Initialise FATMEN. Read catalogue on unit 1, updates on unit 2
-*
- CALL FMSTRT(1,2,'//CERN/CNDIV',IRC)
-*
-* Maximum (documented) log level
-*
- CALL FMLOGL(3)
-*
-* Add a disk file
-*
-* Generic name...
- GENAM = '//CERN/CNDIV/PAVEL/FPACK/TEST1'
-* File name...
- DSN = 'R00PAV.FPACK.DATA'
-* File format (FP binary sequential)...
- FFORM = 'FPS'
-* Data type or copy level... (IBM)
- IDAT = 2
-* Host name...
- HOST = 'DHHDESY3'
-* Record format (fixed length records)...
- RECFM = 'F'
-* Record length in bytes...
- LRECL = 23400
-* Block length in bytes...
- LBLCK = 23400
-* File size in MB...
- ISIZE = 3
-* Comment...
- COMM = 'Sample FPACK file'
-* Options:
- CHOPT = ' '
-* User words...
-
- DO 10 I=1,10
-10 IVECT(I) = IRNDM(DUMMY)
-
- CALL FMADDD(GENAM,DSN,FFORM,IDAT,HOST,RECFM,LRECL,LBLCK,ISIZE,
- + COMM,IVECT,CHOPT,IRC)
-
- CALL FMEND(IRC)
- PRINT *,'Return code ',IRC,' from FMEND'
-*
- END
diff --git a/src/packlib/fatmen/fattest/fatnov.dat b/src/packlib/fatmen/fattest/fatnov.dat
deleted file mode 100644
index 4c8148c..0000000
--- a/src/packlib/fatmen/fattest/fatnov.dat
+++ /dev/null
@@ -1,58 +0,0 @@
-*
-* $Id: fatnov.dat,v 1.1.1.1 1996/03/07 15:18:02 mclareni Exp $
-*
-* $Log: fatnov.dat,v $
-* Revision 1.1.1.1 1996/03/07 15:18:02 mclareni
-* Fatmen
-*
-*
-* *
-* Test of novice interface *
-************************************************************************
- COMMON /QUEST/IQUEST(100)
- PARAMETER (LKEYFA=10)
- DIMENSION KEY(LKEYFA)
- EXTERNAL UROUT
-*
-* Define logical units to access the catalogue (LUNRZ)
-* and for writing updates to the server (LUNFZ)
-*
- LUNRZ = 1
- LUNFZ = 2
-*
-* Initialise FATMEN. ZEBRA will be initialised if required
-*
- CALL FMSTRT(LUNRZ,LUNFZ,'//CLASSICAL/MUSIC',IRC)
-*
-* Create a few directories
-*
- CALL FMKDIR('//CLASSICAL/MUSIC/BERLIOZ',IRC)
-*
-* If IQUEST(1) is set, then the directory already existed
-* This is just information and not really novice level...
-*
- CALL FMKDIR('//CLASSICAL/MUSIC/FAURE',IRC)
-*
-* Now, scan directory structure. This will look for
-* all directories down 3 levels. For each matching
-* directory, the routine UROUT will be called.
-*
- CALL FMSCAN('//CLASSICAL/MUSIC/*',3,UROUT,IRC)
-
- END
-
- SUBROUTINE UROUT(PATH,IRC)
- CHARACTER*(*) PATH
- COMMON/QUEST/IQUEST(100)
-*
-* If we set a non-zero return code, then FMSCAN will stop
-* the directory scan
-*
- IRC = 0
- PRINT *,'<< ',PATH(1:LENOCC(PATH))
- PRINT *,'Number of subdirectories = ',IQUEST(12)
- PRINT *,'Number of elements in initial path name = ',IQUEST(10)
- PRINT *,'Number of elements in path name = ',IQUEST(13)
- PRINT *,'Number of keys = ',IQUEST(14)
- PRINT *,'Number of elements per key = ',IQUEST(15)
- END
diff --git a/src/packlib/fatmen/fattest/fatwrite.dat b/src/packlib/fatmen/fattest/fatwrite.dat
deleted file mode 100644
index 8539fbb..0000000
--- a/src/packlib/fatmen/fattest/fatwrite.dat
+++ /dev/null
@@ -1,132 +0,0 @@
-*
-* $Id: fatwrite.dat,v 1.1.1.1 1996/03/07 15:18:03 mclareni Exp $
-*
-* $Log: fatwrite.dat,v $
-* Revision 1.1.1.1 1996/03/07 15:18:03 mclareni
-* Fatmen
-*
-*
- PROGRAM FATWRT
- PARAMETER (LURCOR=200000)
- COMMON/CRZT/IXSTOR,IXDIV,IFENCE(2),LEV,LEVIN,BLVECT(LURCOR)
- DIMENSION LQ(999),IQ(999),Q(999)
- EQUIVALENCE (IQ(1),Q(1),LQ(9)),(LQ(1),LEV)
-#include "fatpara.inc"
-*
- COMMON /USRLNK/LUSRK1,LUSRBK,LUSRLS
-*
- COMMON /QUEST/IQUEST(100)
-*
- PARAMETER (LKEYFA=10)
- DIMENSION KEYS(LKEYFA)
-*
-*
-* Initialise ZEBRA
-*
- CALL MZEBRA(0)
- CALL MZSTOR(IXSTOR,'/CRZT/','Q',IFENCE,LEV,BLVECT(1),BLVECT(1),
- + BLVECT(5000),BLVECT(LURCOR))
- CALL MZLOGL(IXSTOR,-3)
-
-*
-* *** Define user division and link area like:
-*
- CALL MZDIV (IXSTOR, IXDIV, 'USERS', 50000, LURCOR, 'L')
- CALL MZLINK (IXSTOR, '/USRLNK/', LUSRK1, LUSRLS, LUSRK1)
-*
-* Unit for RZ database
-*
- LUNRZ = 1
- LUNFZ = 2
-
-* read mode
- CALL FMLOGL(3)
- CALL FMINIT(IXSTOR,LUNRZ,LUNFZ,'//CERN/CNDIV',IRC)
-*
-* Book a new FATMEN bank: JBIAS = 2: s/a bank at LUSRBK
-*
- JBIAS = 2
- CALL FMBOOK('//CERN/CNDIV/JAMIE/WRITETEST',
- + KEYS,LUSRBK,LSUP,JBIAS,IRC)
- IF(IRC.NE.0) PRINT *,'RETURN CODE ',IRC,' FROM FMBOOK'
-*
-* Fill in the fields we want...
-*
-* File name...
- NCH = 23
- CALL FMPUTC(LUSRBK,'$HOME/fatmen/fxfile.dat',
- + MFQNFA,NCH,IRC)
-* File format (FZ binary exchange)...
- CALL FMPUTC(LUSRBK,'FX ',MFLFFA,4,IRC)
-* Data type or copy level... (none)
- IQ(LUSRBK+MCPLFA) = 0
-* Host name...
- CALL FMPUTC(LUSRBK,'CERNVM',MHSNFA,6,IRC)
-* Record format (fixed length records)...
- CALL FMPUTC(LUSRBK,'F ',MRFMFA,4,IRC)
-* Record length in bytes...
- IQ(LUSRBK+MRLNFA) = 34200
-* Block length in bytes...
- IQ(LUSRBK+MBLNFA) = 34200
-* File size in MB...
- IQ(LUSRBK+MFSZFA) = 1
-* Comment...
- CALL FMPUTC(LUSRBK,'Sample FZ file',MUCMFA,14,IRC)
-* User words...
-
- DO 10 I=1,10
-10 IQ(LUSRBK+MUSWFA+I-1) = IRNDM(DUMMY)
-
-*
-* Print bank contents
-*
- CALL FMSHOW('//CERN/CNDIV/JAMIE/WRITETEST',LUSRBK,KEYS,'A',IRC)
-*
-* Check bank contents
-*
- CALL FMVERI('//CERN/CNDIV/JAMIE/WRITETEST',LUSRBK,KEYS,' ',IRC)
- IF(IRC.NE.0) PRINT *,'Return code ',IRC,' from FMVERI'
-*
-* Open the file...
-*
- CALL FMOPEN('//CERN/CNDIV/JAMIE/WRITETEST','22',LUSRBK,'WF',IRC)
-*
-* and write some data...
-*
- CALL WRITFZ(22)
-*
-* close the file...
-* Options: Update bank with file size from FZINFO
-* Call FZENDx
-* Update catalogue and drop bank
-*
- CALL FMCLOS('//CERN/CNDIV/JAMIE/WRITETEST','22',LUSRBK,'EFUZ',IRC)
-
- CALL FMEND(IRC)
- PRINT *,'Return code ',IRC,' from FMEND'
-*
- END
-
- SUBROUTINE WRITFZ(LUN)
- PARAMETER (LURCOR=200000)
- COMMON/CRZT/IXSTOR,IXDIV,IFENCE(2),LEV,LEVIN,BLVECT(LURCOR)
- DIMENSION LQ(999),IQ(999),Q(999)
- EQUIVALENCE (IQ(1),Q(1),LQ(9)),(LQ(1),LEV)
- COMMON/QUEST/IQUEST(100)
- DIMENSION IUHEAD(400)
- DIMENSION IOCR(100)
- PARAMETER (JBIAS=2)
- PARAMETER (IEVENT=0)
-
- DO 30 K=1,2
- DO 20 I=1,3
- CALL FZRUN(LUN,0,10,IUHEAD)
- DO 10 J=1,10
- NUH = 400
- CALL FZOUT(LUN,IXDIV,LENTRY,1,'Z',2,400,IUHEAD)
- 10 CONTINUE
- CALL FZRUN(LUN,-1,10,IUHEAD)
- 20 CONTINUE
- 30 CONTINUE
-*
- 999 END
diff --git a/src/packlib/fatmen/fattest/writefz.dat b/src/packlib/fatmen/fattest/writefz.dat
deleted file mode 100644
index f73584e..0000000
--- a/src/packlib/fatmen/fattest/writefz.dat
+++ /dev/null
@@ -1,47 +0,0 @@
-*
-* $Id: writefz.dat,v 1.1.1.1 1996/03/07 15:18:02 mclareni Exp $
-*
-* $Log: writefz.dat,v $
-* Revision 1.1.1.1 1996/03/07 15:18:02 mclareni
-* Fatmen
-*
-*
-************************************************************************
-*
-* Create a dummy FZ file for testing purposes
-*
-************************************************************************
- PROGRAM WRITEFZ
- DIMENSION IQ(2),Q(2),LQ(8000)
- COMMON/PAWC/PAW(50000)
- EQUIVALENCE (LQ(1),LMAIN),(IQ(1),LQ(9)),(Q(1),IQ(1))
- COMMON/QUEST/IQUEST(100)
- CHARACTER*80 CARD
- CHARACTER*8 DELTIM
- DIMENSION IUHEAD(400)
- DIMENSION IOCR(100)
- PARAMETER (JBIAS=2)
- PARAMETER (IEVENT=0)
- CALL HLIMIT(50000)
-*
-* Create an eXchange mode file, record length = 32400 bytes
-* Open statement should be modified for VM/CMS or MVS
-* (FILE=/fname)
-*
- CALL FZFILE(1,8100,'OX')
- OPEN(1,FILE='fxfile.dat',ACCESS='SEQUENTIAL',FORM='UNFORMATTED',
- + STATUS='NEW')
- DO 30 K=1,2
- DO 20 I=1,3
- CALL FZRUN(1,0,10,IUHEAD)
- DO 10 J=1,10
- NUH = 400
- CALL FZOUT(1,IXDIV,LENTRY,1,'Z',2,400,IUHEAD)
- 10 CONTINUE
- CALL FZRUN(1,-1,10,IUHEAD)
- 20 CONTINUE
- PRINT *,'CALLING FZENDO'
- CALL FZENDO(1,'E')
- 30 CONTINUE
-*
- 999 END
diff --git a/src/packlib/fatmen/fatuous/Imakefile b/src/packlib/fatmen/fatuous/Imakefile
deleted file mode 100644
index cb01e15..0000000
--- a/src/packlib/fatmen/fatuous/Imakefile
+++ /dev/null
@@ -1,4 +0,0 @@
-SRCS_F= fmaddd.F fmaddt.F fmfend.F fmfile.F fmpeek.F fmpoke.F \ @@\
- fmstrt.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/fatmen/fatuous/fmaddd.F b/src/packlib/fatmen/fatuous/fmaddd.F
deleted file mode 100644
index 3c16218..0000000
--- a/src/packlib/fatmen/fatuous/fmaddd.F
+++ /dev/null
@@ -1,168 +0,0 @@
-*
-* $Id: fmaddd.F,v 1.1.1.1 1996/03/07 15:18:03 mclareni Exp $
-*
-* $Log: fmaddd.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:03 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMADDD(GNAME,DSN,FFORM,CPLEV,HOSTN,
- + RECFM,LRECL,BLOCK,FSIZE,
- + COMM,IVECT,CHOPT,IRC)
-#include "fatmen/faust.inc"
-#include "fatmen/fatpara.inc"
-#include "fatmen/fatbug.inc"
-#include "fatmen/fatusr.inc"
-#include "fatmen/fatloc.inc"
-#include "fatmen/fat.inc"
- COMMON/TRON/ LTHR,THRONG
-#include "zebra/quest.inc"
- CHARACTER*8 THRONG
- CHARACTER*(*) GNAME,DSN,CHOPT
- CHARACTER*255 PATHN
- CHARACTER*20 FNAME
- CHARACTER*(*) FFORM
- CHARACTER*(*) HOSTN
- INTEGER CPLEV,FSEQ
- CHARACTER*255 PREDIR
- CHARACTER*(*) RECFM
- INTEGER LRECL,BLOCK,FSIZE
- CHARACTER*(*) COMM
-#include "fatmen/fmnkeys.inc"
- DIMENSION KEYSI(LKEYFA)
- DIMENSION KEYSO(LKEYFA,1)
- DIMENSION KEYS(LKEYFA)
- DIMENSION IVECT(10)
- SAVE NENTRY
-#include "fatmen/fatvid0.inc"
-#include "fatmen/fatoptd.inc"
-#include "fatmen/fatvid1.inc"
- DATA NENTRY/0/
-#include "fatmen/fatoptc.inc"
-
- NFADDD = NFADDD + 1
-*
-* Add a new file to the FATMEN file catalogue
-*
- IRC = 0
- LGNAME = LENOCC(GNAME)
- LDSN = LENOCC(DSN)
- LFFORM = LENOCC(FFORM)
- LHOSTN = LENOCC(HOSTN)
- LCOMM = LENOCC(COMM)
- LRECFM = LENOCC(RECFM)
-*
- CALL VBLANK(KEYS(2),5)
- FNAME = GNAME(INDEXB(GNAME(1:LGNAME),'/')+1:LGNAME)
- LF = LENOCC(FNAME)
- CALL UCTOH(FNAME,KEYS(2),4,LF)
-*
-* Save current directory
-*
- CALL FACDIR(PREDIR,'R')
-
- IF(NENTRY.EQ.0) THEN
- JBIAS = 2
- CALL FMBOOK(GNAME,KEYS,LADDBK,LSUP,JBIAS,IRC)
- NENTRY = 1
- ELSE
- CALL FMFILL(GNAME,LADDBK,KEYS,'A',IRC)
- ENDIF
-
- IF(IOPTE.NE.0) THEN
- CALL FMSELK(GNAME,KEYSI,KEYSO,NKEYS,1,IRET)
- IF(IRET.NE.0) THEN
- PRINT *,'FMADDD. Error from FMSELK for ',
- + GNAME(1:LGNAME)
- IRC = IRET
- GOTO 99
- ENDIF
- CALL FMGETK(GNAME,LADDBK,KEYSO(1,1),IRET)
- IF(IRET.NE.0) THEN
- PRINT *,'FMADDD. Error from FMGETK for ',
- + GNAME(1:LGNAME)
- IRC = IRET
- GOTO 99
- ENDIF
- ENDIF
-*
-* Override various fields as required
-*
- IF ((DSN(1:4) .NE. 'NONE') .AND. (LDSN.NE.0)) THEN
- IF(IDEBFA.GE.3) PRINT *,'FMADDD. setting DSN to ',
- + DSN(1:LDSN)
- CALL VBLANK(IQ(LADDBK+MFQNFA),NFQNFA/4)
- CALL UCTOH(DSN,IQ(LADDBK+MFQNFA),4,LDSN)
- ENDIF
- IF(IDEBFA.GE.3) CALL FMSHOW(GNAME,LADDBK,KEYS,'A',IRC)
-
- IF ((HOSTN(1:8) .NE. 'THISNODE') .AND. (LHOSTN.NE.0)) THEN
- IF(IDEBFA.GE.3) PRINT *,'FMADDD. setting host name to ',
- + HOSTN(1:LHOSTN)
- CALL CLTOU(HOSTN(1:LHOSTN))
- CALL VBLANK(IQ(LADDBK+MHSNFA),MCPLFA-MHSNFA)
- CALL UCTOH(HOSTN,IQ(LADDBK+MHSNFA),4,LHOSTN)
- ENDIF
-
- IF(LFFORM.NE.0) THEN
- IF(IDEBFA.GE.3) PRINT *,'FMADDD. setting file format to ',
- + FFORM(1:LFFORM)
- CALL CLTOU(FFORM(1:LFFORM))
- CALL UCTOH(FFORM,IQ(LADDBK+MFLFFA),4,LFFORM)
- ENDIF
- IQ(LADDBK+MCPLFA) = CPLEV
- IQ(LADDBK+MMTPFA) = 1
- IQ(LADDBK+MLOCFA) = 1
- KEYS(MKCLFA) = CPLEV
-
- IF(NUMLOC.EQ.1) THEN
- IQ(LADDBK+MLOCFA) = MFMLOC(1)
- KEYS(MKLCFA) = MFMLOC(1)
- ENDIF
-
- IF(LCOMM.NE.0) THEN
- IF(IDEBFA.GE.3) PRINT *,'FMADDD. setting comment to ',
- + COMM(1:LCOMM)
- CALL VBLANK(IQ(LADDBK+MUCMFA),NWDSFA-MUCMFA+1)
- CALL UCTOH(COMM,IQ(LADDBK+MUCMFA),4,LCOMM)
- ENDIF
-
- IF(LRECFM.NE.0) THEN
- IF(IDEBFA.GE.3) PRINT *,'FMADDD. setting RECFM to ',
- + RECFM(1:LRECFM)
- CALL CLTOU(RECFM(1:LRECFM))
- CALL UCTOH(RECFM,IQ(LADDBK+MRFMFA),4,LRECFM)
- ENDIF
- IF(LRECL.NE.0) IQ(LADDBK+MRLNFA) = LRECL
- IF(BLOCK.NE.0) IQ(LADDBK+MBLNFA) = BLOCK
- IF(FSIZE.NE.0) IQ(LADDBK+MFSZFA) = FSIZE
-*
-* User words
-*
- DO 20 I=1,10
- IF(IVECT(I).NE.0) IQ(LADDBK+MUSWFA-1+I) = IVECT(I)
- 20 CONTINUE
-*
-* Display entry
-*
- IF(IDEBFA.GE.3) CALL FMSHOW(GNAME,LADDBK,KEYS,'A',IRC)
-*
-* Output this entry
-*
- IF(IOPTN.EQ.0) THEN
- IF((IOPTM.EQ.0).AND.(IOPTR.EQ.0)) THEN
- CALL FMPUT(GNAME,LADDBK,IRC)
- ELSEIF(IOPTM.NE.0) THEN
- CALL FMMOD(GNAME,LADDBK,0,IRC)
- ELSEIF(IOPTR.NE.0) THEN
- CALL FMMOD(GNAME,LADDBK,1,IRC)
- ENDIF
- ENDIF
-
-*
-* Reset current directory
-*
- CALL FACDIR(PREDIR(1:LENOCC(PREDIR)),' ')
-
- 99 END
diff --git a/src/packlib/fatmen/fatuous/fmaddt.F b/src/packlib/fatmen/fatuous/fmaddt.F
deleted file mode 100644
index 4be6a39..0000000
--- a/src/packlib/fatmen/fatuous/fmaddt.F
+++ /dev/null
@@ -1,188 +0,0 @@
-*
-* $Id: fmaddt.F,v 1.1.1.1 1996/03/07 15:18:03 mclareni Exp $
-*
-* $Log: fmaddt.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:03 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMADDT(GNAME,VSN,VID,FSEQ,DSN,FFORM,CPLEV,HOSTN,
- + RECFM,LRECL,BLOCK,FSIZE,MEDIA,
- + COMM,IVECT,CHOPT,IRC)
-#include "fatmen/faust.inc"
-#include "fatmen/fatpara.inc"
-#include "fatmen/fatbug.inc"
-#include "fatmen/fatusr.inc"
-#include "fatmen/fatloc.inc"
-#include "fatmen/fat.inc"
- COMMON/TRON/ LTHR,THRONG
- COMMON /QUEST/IQUEST(100)
- CHARACTER*8 THRONG
- CHARACTER*(*) GNAME,DSN,CHOPT
- CHARACTER*255 PATHN
- CHARACTER*20 FNAME
- CHARACTER*(*) FFORM
- CHARACTER*(*) HOSTN
- INTEGER CPLEV,FSEQ
- CHARACTER*(*) VSN
- CHARACTER*(*) VID
- CHARACTER*8 VIP
- CHARACTER*255 PREDIR
- CHARACTER*(*) RECFM
- INTEGER LRECL,BLOCK,FSIZE
- CHARACTER*(*) COMM
-#include "fatmen/fmnkeys.inc"
- DIMENSION KEYSI(LKEYFA)
- DIMENSION KEYSO(LKEYFA,1)
-*
- DIMENSION KEYS(LKEYFA)
- DIMENSION IVECT(10)
- SAVE NENTRY
-#include "fatmen/fatvid0.inc"
-#include "fatmen/fatoptd.inc"
-#include "fatmen/fatvid1.inc"
- DATA NENTRY/0/
-#include "fatmen/fatoptc.inc"
-
- NFADDT = NFADDT + 1
-
- IRC = 0
- LVSN = LENOCC(VSN)
- LVID = LENOCC(VID)
- LGNAME = LENOCC(GNAME)
- LDSN = LENOCC(DSN)
- LFFORM = LENOCC(FFORM)
- LHOSTN = LENOCC(HOSTN)
- LRECFM = LENOCC(RECFM)
- LCOMM = LENOCC(COMM)
-*
-* Has a VID prefix been given?
-*
- JVIDP = INDEX(VID(1:LVID),'.')
- IF(JVIDP.NE.0) THEN
- VIP = VID(1:JVIDP-1)
- LVIP = JVIDP - 1
- VID = VID(JVIDP+1:LVID)
- LVID = LVID-JVIDP
- CALL CLTOU(VIP(1:LVIP))
- JP = ICNTH(VIP(1:LVIP),PREVID,NTMS)
- ELSE
- JP = 0
- ENDIF
-
-
- CALL VBLANK(KEYS(2),5)
- FNAME = GNAME(INDEXB(GNAME(1:LGNAME),'/')+1:LGNAME)
- LF = LENOCC(FNAME)
- CALL UCTOH(FNAME,KEYS(2),4,LF)
-*
-* Save current directory
-*
- CALL FACDIR(PREDIR,'R')
-
- IF(NENTRY.EQ.0) THEN
- JBIAS = 2
- CALL FMBOOK(GNAME,KEYS,LADDBK,LSUP,JBIAS,IRC)
- NENTRY = 1
- ELSE
- CALL FMFILL(GNAME,LADDBK,KEYS,'A',IRC)
- ENDIF
-
- IF(IOPTE.NE.0) THEN
- CALL FMSELK(GNAME,KEYSI,KEYSO,NKEYS,1,IRET)
- IF(IRET.NE.0) THEN
- PRINT *,'FMADDT. Error from FMSELK for ',
- + GNAME(1:LGNAME)
- IRC = IRET
- GOTO 99
- ENDIF
- CALL FMGETK(GNAME,LADDBK,KEYSO(1,1),IRET)
- IF(IRET.NE.0) THEN
- PRINT *,'FMADDT. Error from FMGETK for ',
- + GNAME(1:LGNAME)
- IRC = IRET
- GOTO 99
- ENDIF
- IF(IDEBFA.GE.3)
- + CALL FMSHOW(GNAME,LADDBK,KEYS,'A',IRC)
- ENDIF
-*
-* Override various fields as required
-*
- IF ((DSN(1:4) .NE. 'NONE') .AND. (LDSN.NE.0)) THEN
- CALL VBLANK(IQ(LADDBK+MFQNFA),MHSNFA-MFQNFA)
- CALL UCTOH(DSN,IQ(LADDBK+MFQNFA),4,LDSN)
- ENDIF
-
- IF ((HOSTN(1:8) .NE. 'THISNODE') .AND. (LHOSTN.NE.0)) THEN
- CALL CLTOU(HOSTN(1:LHOSTN))
- CALL VBLANK(IQ(LADDBK+MHSNFA),MCPLFA-MHSNFA)
- CALL UCTOH(HOSTN,IQ(LADDBK+MHSNFA),4,LHOSTN)
- ENDIF
-
- IF(LFFORM.NE.0) THEN
- CALL CLTOU(FFORM(1:LFFORM))
- CALL UCTOH(FFORM,IQ(LADDBK+MFLFFA),4,LFFORM)
- ENDIF
- IQ(LADDBK+MCPLFA) = CPLEV
- IQ(LADDBK+MMTPFA) = 1
- IQ(LADDBK+MLOCFA) = 1
- KEYS(MKCLFA) = CPLEV
-
- IF(NUMLOC.EQ.1) THEN
- IQ(LADDBK+MLOCFA) = MFMLOC(1)
- KEYS(MKLCFA) = MFMLOC(1)
- ENDIF
-
-
- IF(LCOMM.NE.0) THEN
- CALL VBLANK(IQ(LADDBK+MUCMFA),NWDSFA-MUCMFA+1)
- CALL UCTOH(COMM,IQ(LADDBK+MUCMFA),4,LCOMM)
- ENDIF
-
- IF(LRECFM.NE.0) THEN
- CALL CLTOU(RECFM(1:LRECFM))
- CALL UCTOH(RECFM,IQ(LADDBK+MRFMFA),4,LRECFM)
- ENDIF
- IF(LRECL.NE.0) IQ(LADDBK+MRLNFA) = LRECL
- IF(BLOCK.NE.0) IQ(LADDBK+MBLNFA) = BLOCK
- IF(FSIZE.NE.0) IQ(LADDBK+MFSZFA) = FSIZE
-
- IF(LVSN.NE.0)
- +CALL UCTOH(VSN,IQ(LADDBK+MVSNFA),4,LVSN)
- IF(LVID.NE.0)
- +CALL UCTOH(VID,IQ(LADDBK+MVIDFA),4,LVID)
- IF(JP.NE.0) IQ(LADDBK+MVIPFA) = JP
- IF(FSEQ.NE.0) IQ(LADDBK+MFSQFA) = FSEQ
- IQ(LADDBK+MMTPFA) = MEDIA
-
-* Set user words
-*
- DO 20 I=1,10
- IF(IVECT(I).NE.0) IQ(LADDBK+MUSWFA+I-1) = IVECT(I)
- 20 CONTINUE
-*
-* Display entry
-*
- IF((IDEBFA.GE.3).OR.(IOPTS.NE.0))
- + CALL FMSHOW(GNAME,LADDBK,KEYS,'A',IRC)
-*
-* Output this entry
-*
- IF(IOPTN.EQ.0) THEN
- IF((IOPTM.EQ.0).AND.(IOPTR.EQ.0)) THEN
- CALL FMPUT(GNAME,LADDBK,IRC)
- ELSEIF(IOPTM.NE.0) THEN
- CALL FMMOD(GNAME,LADDBK,0,IRC)
- ELSEIF(IOPTR.NE.0) THEN
- CALL FMMOD(GNAME,LADDBK,1,IRC)
- ENDIF
- ENDIF
-
-*
-* Reset current directory
-*
- CALL FACDIR(PREDIR(1:LENOCC(PREDIR)),' ')
-
- 99 END
diff --git a/src/packlib/fatmen/fatuous/fmfend.F b/src/packlib/fatmen/fatuous/fmfend.F
deleted file mode 100644
index 5088082..0000000
--- a/src/packlib/fatmen/fatuous/fmfend.F
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: fmfend.F,v 1.1.1.1 1996/03/07 15:18:03 mclareni Exp $
-*
-* $Log: fmfend.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:03 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMFEND(LUN,GENAM,CHOPT,IRC)
- CHARACTER*(*) CHOPT,GENAM
- CHARACTER*2 CHLUN
- LENTRY = 0
- WRITE(CHLUN,'(I2)') LUN
- CALL FMCLOS(GENAM,CHLUN,LENTRY,CHOPT,IRC)
- END
-
diff --git a/src/packlib/fatmen/fatuous/fmfile.F b/src/packlib/fatmen/fatuous/fmfile.F
deleted file mode 100644
index 251548b..0000000
--- a/src/packlib/fatmen/fatuous/fmfile.F
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: fmfile.F,v 1.1.1.1 1996/03/07 15:18:04 mclareni Exp $
-*
-* $Log: fmfile.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:04 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMFILE(LUN,GENAM,CHOPT,IRC)
- CHARACTER*(*) CHOPT,GENAM
- CHARACTER*2 CHLUN
- LENTRY = 0
- WRITE(CHLUN,'(I2)') LUN
- CALL FMOPEN(GENAM,CHLUN,LENTRY,CHOPT,IRC)
- END
-
diff --git a/src/packlib/fatmen/fatuous/fmpeek.F b/src/packlib/fatmen/fatuous/fmpeek.F
deleted file mode 100644
index 82e27b7..0000000
--- a/src/packlib/fatmen/fatuous/fmpeek.F
+++ /dev/null
@@ -1,116 +0,0 @@
-*
-* $Id: fmpeek.F,v 1.1.1.1 1996/03/07 15:18:04 mclareni Exp $
-*
-* $Log: fmpeek.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:04 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMPEEK(GENAME,IVECT,CHOPT,IRC)
-*CMZ : 11/12/90 15.28.48 by Jamie Shiers
-*-- Author : Jamie Shiers 11/12/90
- CHARACTER*(*) GENAME,CHOPT
- CHARACTER*255 GENOLD
-#include "fatmen/fat.inc"
-#include "fatmen/fatbug.inc"
-#include "fatmen/fatpara.inc"
-#include "fatmen/fatusr.inc"
- DIMENSION IVECT(NWDSFA)
-#include "fatmen/fmnkeys.inc"
-#include "fatmen/fmaxcop.inc"
- DIMENSION KEYSI(LKEYFA)
- DIMENSION KEYSO(LKEYFA,MAXCOP)
- SAVE NKEYS,JKEY,LGNOLD,GENOLD
-#include "fatmen/fatoptd.inc"
- DATA LGNOLD/1/,GENOLD/'.'/
-#include "fatmen/fatoptc.inc"
-* CHOPT:
-* Default: return in IVECT the FATMEN bank at the
-* current LADDBK address (created by FMADDD/T, for example)
- IRC = 0
- LGN = LENOCC(GENAME)
- IF(GENOLD(1:LGNOLD).NE.GENAME(1:LGN)) JKEY = 0
- LGNOLD = LGN
- GENOLD = GENAME(1:LGN)
-
- IF((IOPTG.EQ.0).AND.(IOPTA.EQ.0).AND.(IOPTN.EQ.0)) THEN
- IF(IDEBFA.GE.3) THEN
- PRINT *,'FMPEEK. Copying ',NWDSFA,' words from FATMEN bank',
- + ' at address ',LADDBK,' into user vector'
- ENDIF
- IF(IDEBFA.GE.3)
- + CALL FMSHOW(GENAME(1:LGN),LADDBK,KEYSO,'A',IRC)
- CALL UCOPY(IQ(LADDBK+1),IVECT,NWDSFA)
- NKEYS = 0
- JKEY = 0
-*
-* G : Get information from FATMEN catalogue
-*
- ELSEIF(IOPTG.NE.0) THEN
- CALL FMGET(GENAME,LADDBK,KEYSO,IRET)
- IF(IRET.NE.0) THEN
- PRINT *,'FMPEEK. Error from FMGET for ',GENAME(1:LGN)
- IRC = IRET
- GOTO 99
- ENDIF
- IF(IDEBFA.GE.3)
- + CALL FMSHOW(GENAME(1:LGN),LADDBK,KEYSO,'A',IRC)
- CALL UCOPY(IQ(LADDBK+1),IVECT,NWDSFA)
-*
-* A : Get any matching entry from catalogue
-*
- ELSEIF(IOPTA.NE.0) THEN
- KEYSI(MKMTFA) = -1
- KEYSI(MKLCFA) = -1
- KEYSI(MKCLFA) = -1
- CALL FMSELK(GENAME,KEYSI,KEYSO,NKEYS,MAXCOP,IRET)
- IF(IRET.NE.0) THEN
- PRINT *,'FMPEEK. Error from FMSELK for ',GENAME(1:LGN)
- IRC = IRET
- GOTO 99
- ENDIF
- CALL FMGETK(GENAME,LADDBK,KEYSO(1,1),IRET)
- IF(IRET.NE.0) THEN
- PRINT *,'FMPEEK. Error from FMGETK for ',GENAME(1:LGN)
- IRC = IRET
- GOTO 99
- ENDIF
- IF(IDEBFA.GE.3)
- + CALL FMSHOW(GENAME(1:LGN),LADDBK,KEYSO,'A',IRC)
- CALL UCOPY(IQ(LADDBK+1),IVECT,NWDSFA)
-*
-* N : Get next matching entry from catalogue
-*
- ELSEIF(IOPTN.NE.0) THEN
- KEYSI(MKMTFA) = -1
- KEYSI(MKLCFA) = -1
- KEYSI(MKCLFA) = -1
- CALL FMSELK(GENAME,KEYSI,KEYSO,NKEYS,MAXCOP,IRET)
- IF(IRET.NE.0) THEN
- PRINT *,'FMPEEK. Error from FMSELK for ',GENAME(1:LGN)
- IRC = IRET
- GOTO 99
- ENDIF
- JKEY = JKEY + 1
- IF(JKEY.GT.NKEYS) THEN
- PRINT *,'FMPEEK. No more entries match ',GENAME(1:LGN)
- PRINT *,' # entries found = ',NKEYS
- IRC = -1
- GOTO 99
- ENDIF
- CALL FMGETK(GENAME,LADDBK,KEYSO(1,JKEY),IRET)
- IF(IRET.NE.0) THEN
- PRINT *,'FMPEEK. Error from FMGETK for ',GENAME(1:LGN)
- IRC = IRET
- GOTO 99
- ENDIF
- IF(IDEBFA.GE.3)
- + CALL FMSHOW(GENAME(1:LGN),LADDBK,KEYSO(1,JKEY),'A',IRC)
- CALL UCOPY(IQ(LADDBK+1),IVECT,NWDSFA)
- ENDIF
-
- IF(IOPTD.NE.0) THEN
- CALL MZDROP(IXSTOR,LADDBK,' ')
- ENDIF
- 99 END
diff --git a/src/packlib/fatmen/fatuous/fmpoke.F b/src/packlib/fatmen/fatuous/fmpoke.F
deleted file mode 100644
index 16ac88d..0000000
--- a/src/packlib/fatmen/fatuous/fmpoke.F
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: fmpoke.F,v 1.1.1.1 1996/03/07 15:18:04 mclareni Exp $
-*
-* $Log: fmpoke.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:04 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMPOKE(GENAME,IVECT,CHOPT,IRC)
-*CMZ : 11/12/90 15.28.48 by Jamie Shiers
-*-- Author : Jamie Shiers 11/12/90
- CHARACTER*(*) GENAME
-#include "fatmen/fatbug.inc"
-#include "fatmen/fat.inc"
-#include "fatmen/fatpara.inc"
-#include "fatmen/fatusr.inc"
- DIMENSION IVECT(NWDSFA)
-#include "fatmen/fmnkeys.inc"
- DIMENSION KEYS(LKEYFA)
-#include "fatmen/fatopts.inc"
- IRC = 0
- LGN = LENOCC(GENAME)
- IF(IOPTN.EQ.0) CALL UCOPY(IVECT(1),IQ(LADDBK+1),NWDSFA)
- IF(IOPTP.NE.0) THEN
- CALL FMPUT(GENAME(1:LGN),LADDBK,IRC)
- ELSEIF(IOPTM.NE.0) THEN
- CALL FMMOD(GENAME(1:LGN),LADDBK,0,IRC)
- ELSEIF(IOPTR.NE.0) THEN
- CALL FMMOD(GENAME(1:LGN),LADDBK,1,IRC)
- ENDIF
- 99 END
diff --git a/src/packlib/fatmen/fatuous/fmstrt.F b/src/packlib/fatmen/fatuous/fmstrt.F
deleted file mode 100644
index f8708e6..0000000
--- a/src/packlib/fatmen/fatuous/fmstrt.F
+++ /dev/null
@@ -1,90 +0,0 @@
-*
-* $Id: fmstrt.F,v 1.1.1.1 1996/03/07 15:18:04 mclareni Exp $
-*
-* $Log: fmstrt.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:04 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMSTRT(LUNRZ,LUNFZ,CHFAT,IRC)
-*CMZ : 11/12/90 15.35.08 by Jamie Shiers
-*-- Author :
-
- CHARACTER*(*) CHFAT
-
-#include "fatmen/fat.inc"
-#include "fatmen/fatusr.inc"
-#include "fatmen/fatbug.inc"
-#include "zebra/mzca.inc"
-*
- COMMON /QUEST/IQUEST(100)
-*
-#include "fatmen/fmnkeys.inc"
- DIMENSION KEY(LKEYFA)
- DIMENSION IZKEYS(3)
- SAVE NENTRY
-#if defined(CERNLIB_F77)
- DATA IZKEYS(1)/4HEBRA/,IZKEYS(2)/4HINIT/,IZKEYS(3)/4HDONE/
-#endif
- DATA NENTRY/0/
-*
-* Fix for F90 compiler. Zebra will have to be changed anyway...
-*
- CALL UCTOH('EBRA',IZKEYS(1),4,4)
- CALL UCTOH('INIT',IZKEYS(2),4,4)
- CALL UCTOH('DONE',IZKEYS(3),4,4)
-*
-* Check on input parameters
-*
- IF(LUNRZ.LE.0) THEN
- PRINT *,'FMSTRT. invalid logical unit specified for ',
- + 'reading FATMEN RZ file - ',LUNRZ
- CALL FMSTOP
- ENDIF
-
- IF(LUNFZ.LT.0) THEN
- PRINT *,'FMSTRT. invalid logical unit specified for ',
- + 'writing FATMEN updates - ',LUNFZ
- CALL FMSTOP
- ENDIF
-
- LCHFAT = LENOCC(CHFAT)
- IF(LCHFAT.EQ.0) THEN
- PRINT *,'FMSTRT. invalid FATMEN database specified'
- CALL FMSTOP
- ENDIF
-*
-* Has ZEBRA already been initialised?
-*
- DO 10 J=1,3
- IF (MQKEYS(J).NE.IZKEYS(J)) GO TO 20
- 10 CONTINUE
- IF(IDEBFA.GE.-3) PRINT *,'FMSTRT. info - ZEBRA has already ',
- + 'been initialised'
- GOTO 30
- 20 CONTINUE
-*
-* Initialise ZEBRA
-*
- CALL MZEBRA(-3)
- 30 CONTINUE
-*
-* Initialise store and link areas
-*
- IF(NENTRY.NE.0) GOTO 40
- NENTRY = 1
- CALL MZSTOR(IXSTOR,'/FAT/','Q',IFENCE,LEV,BLVECT(1),BLVECT(1),
- + BLVECT(5000),BLVECT(LURCOR))
- CALL MZLOGL(IXSTOR,-3)
-*
-* *** Define user division and link area like:
-*
- CALL MZDIV (IXSTOR, IXDIV, 'USERS', 50000, LURCOR, 'L')
- CALL MZLINK (IXSTOR, '/USRLNK/', LUSRK1, LUSRLS, LUSRK1)
-
-40 CONTINUE
-* read mode
- IRC = 0
- CALL FMINIT(IXSTOR,LUNRZ,LUNFZ,CHFAT(1:LCHFAT),IRC)
- END
diff --git a/src/packlib/fatmen/fatuser/Imakefile b/src/packlib/fatmen/fatuser/Imakefile
deleted file mode 100644
index a691fdd..0000000
--- a/src/packlib/fatmen/fatuser/Imakefile
+++ /dev/null
@@ -1,3 +0,0 @@
-SRCS_F= fmusel.F fuscan.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/fatmen/fatuser/fmusel.F b/src/packlib/fatmen/fatuser/fmusel.F
deleted file mode 100644
index 7604f0c..0000000
--- a/src/packlib/fatmen/fatuser/fmusel.F
+++ /dev/null
@@ -1,15 +0,0 @@
-*
-* $Id: fmusel.F,v 1.1.1.1 1996/03/07 15:18:04 mclareni Exp $
-*
-* $Log: fmusel.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:04 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMUSEL(GENAM,LBANK,KEYS,ISEL)
- CHARACTER*(*) GENAM
- DIMENSION KEYS(10)
-* Dummy FMUSEL routine
- ISEL = 0
- END
diff --git a/src/packlib/fatmen/fatuser/fuscan.F b/src/packlib/fatmen/fatuser/fuscan.F
deleted file mode 100644
index 4e2af9e..0000000
--- a/src/packlib/fatmen/fatuser/fuscan.F
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: fuscan.F,v 1.1.1.1 1996/03/07 15:18:04 mclareni Exp $
-*
-* $Log: fuscan.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:04 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FUSCAN(GENAM,LBANK,KEYS,ISEL)
-*CMZ : 22/01/91 13.20.09 by Jamie Shiers
-*-- Author : Jamie Shiers 22/01/91
- CHARACTER*(*) GENAM
- DIMENSION KEYS(10)
-* Dummy FUSCAN routine
- ISEL = 0
- END
-
diff --git a/src/packlib/fatmen/fatutil/Imakefile b/src/packlib/fatmen/fatutil/Imakefile
deleted file mode 100644
index 0042fde..0000000
--- a/src/packlib/fatmen/fatutil/Imakefile
+++ /dev/null
@@ -1,42 +0,0 @@
-DoIncludePackage(fatmen)
-#include "pilot.h"
-
-SRCS_F= facdir.F fadare.F faeras.F faexst.F faextr.F fafc.F \ @@\
- fahunt.F fainqr.F fald.F falink.F faln.F fals.F \ @@\
- famodu.F fantrc.F faopen.F faseac.F fasear.F faselp.F fastat.F \ @@\
- fatare.F fatrek.F fazoom.F fmback.F fmchop.F fmcopq.F \ @@\
- fmdate.F fmdays.F fmdump.F fmfzo.F fmhunt.F fmiset.F fmjuli.F \ @@\
- fmkeys.F fmlcop.F fmldir.F fmlink.F fmlist.F fmloop.F fmnode.F \ @@\
- fmpaff.F fmpstg.F fmpurg.F fmrank.F fmrkey.F fmscan.F fmsend.F \ @@\
- fmsetc.F fmsetk.F fmsetl.F fmsetm.F fmsetu.F fmsetv.F \ @@\
- fmsort.F fmstgq.F \ @@\
- fmtree.F fmuver.F fmveri.F sortch.F
-
-#if defined(CERNLIB_UNIX)
-SRCS_F := $(SRCS_F) fafndf.F
-#endif
-
-#if defined(CERNLIB_VAXVMS)
-SRCS_F := $(SRCS_F) fmcfio.F
-#endif
-
-#if defined(CERNLIB_SHIFT)
-SRCS_F := $(SRCS_F) fmxyio.F
-CERNDEFINES:= $(CERNDEFINES) -DCERNLIB_SHIFT
-#endif
-
-#if defined(CERNLIB_cspack)
-SRCS_F := $(SRCS_F) fmxzio.F
-#endif
-
-
-#if defined(CERNLIB_IBMVM)
-SRCS_F := $(SRCS_F) fmvmio.F
-#endif
-
-#ifdef CERNLIB_HPUX
-SpecialFortranLibObjectRule(fantrc,fantrc,'-WF,-P',NullParameter)
-FORTRANSAVEOPTION = FortranSaveFlags
-#endif
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/fatmen/fatutil/facdir.F b/src/packlib/fatmen/fatutil/facdir.F
deleted file mode 100644
index 19e7e0e..0000000
--- a/src/packlib/fatmen/fatutil/facdir.F
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: facdir.F,v 1.1.1.1 1996/03/07 15:18:07 mclareni Exp $
-*
-* $Log: facdir.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:07 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FACDIR(CHPATH,CHOPT)
-*CMZ : 23/09/91 14.01.52 by Jamie Shiers
-*-- Author : Jamie Shiers 23/09/91
-*
-* Interface routine to RZCDIR to protect against
-* problems with multiple RZ files
-*
- CHARACTER*(*) CHPATH
-#include "fatmen/fatsys.inc"
-#include "zebra/rzdir.inc"
-#include "fatmen/fatopts.inc"
-
- IF(IOPTR+IOPTP.EQ.0) THEN
- LTOP = LENOCC(TOPDIR)
- LCWD = LENOCC(CHCDIR(1))
-
- IF(TOPDIR(3:LTOP).NE.CHCDIR(1)(1:LCWD)) THEN
- CALL RZCDIR(TOPDIR,' ')
- ENDIF
- ENDIF
-
- CALL RZCDIR(CHPATH,CHOPT)
-
- END
diff --git a/src/packlib/fatmen/fatutil/fadare.F b/src/packlib/fatmen/fatutil/fadare.F
deleted file mode 100644
index 1c05d4a..0000000
--- a/src/packlib/fatmen/fatutil/fadare.F
+++ /dev/null
@@ -1,119 +0,0 @@
-*
-* $Id: fadare.F,v 1.1.1.1 1996/03/07 15:18:07 mclareni Exp $
-*
-* $Log: fadare.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:07 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FADARE(GENAM,LFAT,KEYS,CHLINE,CHOPT,IRC)
-#include "fatmen/fatbank.inc"
-#include "fatmen/fatpara.inc"
- CHARACTER*(*) GENAM,CHLINE,CHOPT
-#include "fatmen/fmnkeys.inc"
- DIMENSION KEYS(LKEYFA)
- CHARACTER*255 DSN
- CHARACTER*8 NODE
- CHARACTER*4 CHFORM
- CHARACTER*1 CHACC
- CHARACTER*20 CHMETH
- CHARACTER*255 CHFILE
- INTEGER FMNODE
-*
-* 1 : VM/CMS mini-disk
-* 2 : VM/CMS SFS
-* 11 : VAX/VMS disk
-* 12 : VAXcluster disk
-* 13 : DFS (DECnet)
-* 14 : DECnet
-* 15 : CSPACK (zserv)
-* 16 : FPACK
-* 21 : Unix disk
-* 22 : NFS (e.g. $VARIABLE/file)
-* 23 : AFS
-* 24 : Shift pool file
-* 25 : Shift private file
-* 31 : Lachman OSM file
-* 32 : Unitree file
-* 33 : ADSM file
-* 34 : E-MASS file
-*
- LBANK = LFAT + KOFUFA
- DSN = ' '
- NODE = ' '
- CALL UHTOC(IQ(LBANK+MFQNFA),4,DSN,NFQNFA)
- CALL UHTOC(IQ(LBANK+MHSNFA),4,NODE,NHSNFA)
- CALL UHTOC(IQ(LBANK+MFLFFA),4,CHFORM,NFLFFA)
- LDSN = LENOCC(DSN)
- CALL FAINQR(DSN(1:LDSN),NODE,CHFILE,IRC)
-#if defined(CERNLIB_FPACK)
-*
-* FPACK files
-*
- IF(IRC.NE.0.AND.FMNODE(NODE).NE.0.AND.
- + CHFORM(1:2).EQ.'FP') THEN
- CALL FMNTRC(NODE,CHFORM,IRC)
- IF(IRC.EQ.0) IQUEST(1) = 16
- ENDIF
-#endif
-#if defined(CERNLIB_CSPACK)
-*
-* ZEBRA exchange format files
-*
- IF(IRC.NE.0.AND.FMNODE(NODE).NE.0.AND.
- + (CHFORM(1:2).EQ.'FX'.OR.CHFORM(1:3).EQ.'FFX')) THEN
- CALL FMNTRC(NODE,CHFORM,IRC)
- IF(IRC.EQ.0) IQUEST(1) = 15
- ENDIF
-#endif
-
- IACC = IQUEST(1)
- IF(IRC.EQ.0) THEN
- CHACC = 'Y'
- IF(IACC.EQ.1) THEN
- CHMETH = 'VM/CMS mini-disk'
- ELSEIF(IACC.EQ.2) THEN
- CHMETH = 'VM/CMS SFS'
- ELSEIF(IACC.EQ.11) THEN
- CHMETH = 'VAX/VMS disk'
- ELSEIF(IACC.EQ.12) THEN
- CHMETH = 'VAXcluster disk'
- ELSEIF(IACC.EQ.13) THEN
- CHMETH = 'VAX DFS'
- ELSEIF(IACC.EQ.14) THEN
- CHMETH = 'DECnet'
- ELSEIF(IACC.EQ.15) THEN
- CHMETH = 'CSPACK'
- ELSEIF(IACC.EQ.16) THEN
- CHMETH = 'FPACK'
- ELSEIF(IACC.EQ.21) THEN
- CHMETH = 'Unix disk'
- ELSEIF(IACC.EQ.22) THEN
- CHMETH = 'NFS'
- ELSEIF(IACC.EQ.23) THEN
- CHMETH = 'AFS'
- ELSEIF(IACC.EQ.24) THEN
- CHMETH = 'Shift pool file'
- ELSEIF(IACC.EQ.23) THEN
- CHMETH = 'Shift private file'
- ELSEIF(IACC.EQ.31) THEN
- CHMETH = 'Lachman OSM file'
- ELSEIF(IACC.EQ.32) THEN
- CHMETH = 'Unitree file'
- ELSEIF(IACC.EQ.33) THEN
- CHMETH = 'Adstar ADSM file'
- ELSEIF(IACC.EQ.34) THEN
- CHMETH = 'E-MASS file'
- ELSE
- CHMETH = 'unknown'
- ENDIF
- ELSE
- CHACC = 'N'
- CHMETH = 'unknown'
- ENDIF
-
- WRITE(CHLINE,9001) CHACC,CHMETH
-9001 FORMAT('Accessible: ',A1,' via: ',A)
-
- END
diff --git a/src/packlib/fatmen/fatutil/faeras.F b/src/packlib/fatmen/fatutil/faeras.F
deleted file mode 100644
index b1cae66..0000000
--- a/src/packlib/fatmen/fatutil/faeras.F
+++ /dev/null
@@ -1,252 +0,0 @@
-*
-* $Id: faeras.F,v 1.1.1.1 1996/03/07 15:18:07 mclareni Exp $
-*
-* $Log: faeras.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:07 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FAERAS(DSNAME,IRC)
-*CMZ : 17/10/91 15.00.35 by Jamie Shiers
-*-- Author : Jamie Shiers 17/10/91
- CHARACTER*(*) DSNAME
- CHARACTER*255 DSN,CHFILE
- INTEGER SYSTEMF
-#include "fatmen/fatbug.inc"
-#include "fatmen/slate.inc"
-#if defined(CERNLIB_UNIX)||defined(CERNLIB_VAXVMS)
- CHARACTER*255 CHNFS
-#endif
-#if defined(CERNLIB_IBMVM)
- CHARACTER*8 USER,ADDR
- CHARACTER*16 CHSFS
- CHARACTER*80 CHGIME,CHLINE
- CHARACTER*1 MODE
-#endif
-#if defined(CERNLIB_SHIFT)
- CHARACTER*16 SHPOOL,SHUSER
- CHARACTER*11 SHLINK
- CHARACTER*255 CHDSN
-#endif
- LOGICAL IEXIST
-
- IRC = 0
-
- LDSN = LENOCC(DSNAME)
- DSN = DSNAME(1:LDSN)
-
-#if defined(CERNLIB_IBMVM)
-*
-* Get disk name and link to it
-*
- LSTA = INDEX(DSN,'<')
- IF(LSTA.NE.0) THEN
-*
-* Format of DSN is <user.address>filename.filetype on VM
-* address defaults to 191. If field <> missing, defaults to
-* current userid.
-*
-* Valid filenames:
-* FN.FT
-* <JAMIE>FN.FT
-* <JAMIE.191>FN.FT
-* SFS POOL:<JAMIE.A191>FN.FT
-*
- CALL CTRANS('[','<',DSN,1,LDSN)
- CALL CTRANS(']','>',DSN,1,LDSN)
- LDOT = INDEX(DSN,'.')
- LBRA = INDEX(DSN,'>')
-
- IF((LDOT.NE.0).AND.(LDOT.LE.LBRA)) THEN
- LEND = LDOT
- ELSE
- LEND = LBRA
- ENDIF
-
- USER = DSN(LSTA+1:LEND-1)
- LUSR = LEND - LSTA - 1
- ADDR = ' '
-
- IF((LDOT.NE.0).AND.(LDOT.LE.LBRA)) THEN
- ADDR= DSN(LDOT+1:LBRA-1)
- ENDIF
-
- LCHSFS = INDEX(DSN(1:LDSN),':')
- IF(LCHSFS.NE.0) THEN
- CHSFS = DSN(1:LCHSFS)
- IF(IDEBFA.GE.2) PRINT *,'FAERAS. SFS pool = ',
- + CHSFS(1:LCHSFS)
- ENDIF
-
- IF(LCHSFS.EQ.0) THEN
-
- CHGIME = 'EXEC GIME '//USER(1:LUSR)//' '//ADDR//
- + '(QUIET NONOTICE STACK)'
- ELSE
- CHGIME = 'EXEC GIME '//
- + CHSFS(1:LCHSFS)//USER(1:LUSR)//'.'//ADDR//
- + '(QUIET NONOTICE STACK)'
- ENDIF
-
- CALL CSQMBL(CHGIME,1,80)
- LCHG = LENOCC(CHGIME)
-
- IF(IDEBFA.GE.0) PRINT *,'FAERAS. executing ',
- + CHGIME(1:LCHG)
- CALL VMCMS(CHGIME(1:LCHG),IRC)
-
- IF(IRC.GT.4) THEN
- IF(IDEBFA.GE.0)
- + PRINT *,'FAERAS return code from GIME = ',IRC
- RETURN
- ENDIF
-
- CALL VMRTRM(CHLINE,LENGTH)
- MODE = CHLINE(1:1)
-
- CHFILE = '/' // DSN(LBRA+1:LDSN) // ' ' // MODE
- LDSN = LDSN + 3 - LBRA
-
- ENDIF
-
- CALL CTRANS('.',' ',CHFILE,1,LDSN)
-
-#endif
-#if defined(CERNLIB_IBMMVS)
- CHFILE = '/'//DSN(1:LDSN)
- LDSN = LDSN + 1
-#endif
-#if defined(CERNLIB_SHIFT)
-*
-* Check if link already exists...
-*
- CHDSN = DSN(1:LDSN)
- SHLINK = 'FATMEN_LINK'
- INQUIRE(FILE=SHLINK,EXIST=IEXIST)
- IF(IEXIST) THEN
- IF(IDEBFA.GE.0)
- + PRINT *,'FAERAS. removing existing symbolic link...'
- IRC = SYSTEMF('rm '//SHLINK)
- ENDIF
-
- CALL CTRANS('<','[',DSN,1,LDSN)
- CALL CTRANS('>',']',DSN,1,LDSN)
- ILSQB = INDEX(DSN(1:LDSN),'[')
- IRSQB = INDEX(DSN(1:LDSN),']')
-
- IF(ILSQB.NE.0) THEN
-
- IF(IDEBFA.GE.1) PRINT *,'FAERAS. SHIFT POOL file...'
-
- IDOT = INDEX(DSN(1:IRSQB),'.')
- SHPOOL = DSN(2:IDOT-1)
- SHUSER = DSN(IDOT+1:IRSQB-1)
- ISTART = IRSQB+1
- IEND = LDSN
- IF (IDEBFA.GE.0) PRINT *,'FAERAS. Assign for logical unit ',
- + SHLINK,' pool = ',SHPOOL,
- + ' user = ',SHUSER,' dsn = ',DSN(ISTART:IEND)
- IRC = SYSTEMF('assign ` sfget -k -p '//SHPOOL//
- + ' -u '//SHUSER// ' '//CHDSN(ISTART:IEND)//' `
- + '//SHLINK//' ')
- IF(IRC.NE.0) THEN
- PRINT *,'FAERAS. return code ',IRC,' from SFGET'
- RETURN
- ENDIF
- ELSE
-
- IF(IDEBFA.GE.1) PRINT *,'FAERAS. SHIFT private file...'
- IRC = SYSTEMF('assign '//CHDSN(1:LDSN)//' '//
- + SHLINK)
- IF(IRC.NE.0) THEN
- PRINT *,'FAERAS. return code ',IRC,' from SFGET'
- RETURN
- ENDIF
- ENDIF
-
- DSN = SHLINK
- LDSN = 11
-#endif
-#if (defined(CERNLIB_UNIX)||defined(CERNLIB_VAXVMS))&&(!defined(CERNLIB_SHIFT))
-*
-* Expand any environmental variable
-*
- IF(DSN(1:1).EQ.'$') THEN
- LEND = INDEX(DSN,'/')
-#endif
-#if (defined(CERNLIB_UNIX))&&(!defined(CERNLIB_SHIFT))
- CALL GETENVF(DSN(2:LEND-1),CHNFS)
-#endif
-#if (defined(CERNLIB_VAXVMS))&&(!defined(CERNLIB_SHIFT))
- CALL FMGTLG(DSN(2:LEND-1),CHNFS,'LNM$SYSTEM',IRC)
-#endif
-#if (defined(CERNLIB_UNIX)||defined(CERNLIB_VAXVMS))&&(!defined(CERNLIB_SHIFT))
- IF(IS(1).EQ.0) THEN
- IF(IDEBFA.GE.3) PRINT *,'FAERAS. cannot expand ',
- + 'environmental variable/logical name ',DSN(2:LEND-1)
- IRC = 1
- RETURN
- ENDIF
- LCHNFS = IS(1)
-#endif
-#if (defined(CERNLIB_UNIX))&&(!defined(CERNLIB_SHIFT))
- CHFILE = CHNFS(1:IS(1)) // DSN(LEND:LDSN)
- LDSN = IS(1) + LDSN - LEND + 1
-#endif
-#if (defined(CERNLIB_VAXVMS))&&(!defined(CERNLIB_SHIFT))
-*
-* If there is more than one slash in file name
-* assume that the intervening elements are directory names
-*
- JSLASH = INDEXB(DSN(1:LDSN),'/')
- IF(JSLASH.EQ.LEND) THEN
- CHNFS(LCHNFS+1:) = DSN(LEND+1:LDSN)
- LCHNFS = LCHNFS + LDSN - LEND
- ELSE
- CHNFS(LCHNFS+1:) = '[' // DSN(LEND+1:JSLASH-1)
- + // ']' // DSN(JSLASH+1:LDSN)
- LCHNFS = LCHNFS + LDSN - LEND + 1
- CALL CTRANS('/','.',CHNFS,1,LCHNFS)
- ENDIF
- CHFILE = CHNFS(1:LCHNFS)
-#endif
-#if (defined(CERNLIB_UNIX)||defined(CERNLIB_VAXVMS))&&(!defined(CERNLIB_SHIFT))
- ELSE
- CHFILE = DSN
- ENDIF
-
-#endif
-#if (defined(CERNLIB_UNIX))&&(!defined(CERNLIB_SHIFT))
- CALL CUTOL(CHFILE)
-#endif
- INQUIRE(FILE=CHFILE(1:LDSN),EXIST=IEXIST)
- IF(.NOT.IEXIST) THEN
- IRC = 1
- IF(IDEBFA.GE.-3) PRINT *,'FAERAS. file ',
- + CHFILE(1:LDSN),' does not exist'
- ELSE
- IF(IDEBFA.GE.1) PRINT *,'FAERAS. removing disk file ',
- + CHFILE(1:LDSN)
-#if defined(CERNLIB_IBMVM)
- CALL VMCMS('ERASE '//CHFILE(2:LDSN),IRC)
- IF(IRC.NE.0) PRINT *,'FAERAS. return code ',IRC,
- + ' from ERASE command'
-#endif
-#if defined(CERNLIB_IBMMVS)
-#endif
-#if defined(CERNLIB_VAXVMS)
- ISTAT = LIB$DELETE_FILE(CHFILE(1:LDSN),,,,,,,,)
-#include "fatmen/fatvaxrc.inc"
-#endif
-#if defined(CERNLIB_UNIX)
- IRC = SYSTEMF('rm '//CHFILE(1:LDSN))
- IF(IRC.NE.0) PRINT *,'FAERAS. return code ',IRC,
- + ' from rm command'
-#endif
- ENDIF
-
-#if defined(CERNLIB_IBMVM)
- IF(MODE.NE.'A') CALL VMCMS('EXEC DROP '//MODE,IRET)
-#endif
- END
diff --git a/src/packlib/fatmen/fatutil/faexst.F b/src/packlib/fatmen/fatutil/faexst.F
deleted file mode 100644
index bbabe1b..0000000
--- a/src/packlib/fatmen/fatutil/faexst.F
+++ /dev/null
@@ -1,71 +0,0 @@
-*
-* $Id: faexst.F,v 1.1.1.1 1996/03/07 15:18:06 mclareni Exp $
-*
-* $Log: faexst.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:06 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FAEXST(IRC)
-*
-* Check if FATMEN catalogue exists
-*
- CHARACTER*255 CHFILE
-#include "fatmen/fatbug.inc"
-#include "fatmen/fatsys.inc"
-#if defined(CERNLIB_IBMVM)
- CHARACTER*20 FILE
-#endif
- LOGICAL EXIST
-
- IRC = 0
-
- LDEF = LENOCC(DEFAULT)
- LTOP = LENOCC(TOPDIR)
-#if defined(CERNLIB_VAXVMS)
-*
-* File CHFILE is in default directory of server
-*
- IF(LDEF.GT.0) THEN
- CHFILE = DEFAULT(1:LDEF)
- + // TOPDIR(3:LTOP) // '.FATRZ'
- ELSE
- CHFILE = TOPDIR(3:LTOP) // '.FATRZ'
- ENDIF
-#endif
-#if defined(CERNLIB_UNIX)
-*
-* File CHFILE is in default directory of server
-*
- IF(LDEF.GT.0) THEN
- CHFILE = DEFAULT(1:LDEF) // '/'
- + // TOPDIR(3:LTOP) // '.FATRZ'
- ELSE
- CHFILE = TOPDIR(3:LTOP) // '.FATRZ'
- ENDIF
-*
-* *** Check if the file exists
-*
-#endif
-#if defined(CERNLIB_IBMVM)
- CHFILE = '/' // TOPDIR(3:LTOP) // ' FATRZ '//SERMOD
-#endif
-#if defined(CERNLIB_IBMMVS)
- CHFILE = '/'//DEFAULT(1:LDEF)//'.'
- + // TOPDIR(3:LTOP) // '.FATRZ'
-#endif
- LCHF = LENOCC(CHFILE)
-#if defined(CERNLIB_UNIX)
- CALL CUTOL(CHFILE)
-#endif
- IF(IDEBFA.GE.1) PRINT *,'FAEXST. looking for FATMEN catalogue ',
- + 'file = ',CHFILE(1:LCHF)
- INQUIRE(FILE=CHFILE(1:LCHF),EXIST=EXIST,IOSTAT=ISTAT)
- IF(.NOT.EXIST) THEN
- IRC = 28
- IF(IDEBFA.GE.-3) PRINT *,'FAEXST. FORTRAN INQUIRE ',
- + 'for FATMEN catalogue failed - ',
- + 'file = ',CHFILE(1:LCHF)
- ENDIF
- END
diff --git a/src/packlib/fatmen/fatutil/faextr.F b/src/packlib/fatmen/fatutil/faextr.F
deleted file mode 100644
index a6ad041..0000000
--- a/src/packlib/fatmen/fatutil/faextr.F
+++ /dev/null
@@ -1,78 +0,0 @@
-*
-* $Id: faextr.F,v 1.1.1.1 1996/03/07 15:18:06 mclareni Exp $
-*
-* $Log: faextr.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:06 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FAEXTR(GENAM,KEYS,IRC)
- CHARACTER*(*) GENAM
-*CMZ : 03/09/91 17.30.54 by Jamie Shiers
-*-- Author : Jamie Shiers 03/09/91
-#include "fatmen/fmnkeys.inc"
- DIMENSION KEYS(LKEYFA)
- DIMENSION IOCH(80),IUHEAD(80)
- CHARACTER*20 FNAME
- PARAMETER (NW=80)
-#include "fatmen/fatbank.inc"
-#include "fatmen/fatpara.inc"
- SAVE NENTRY,IOCH
-#include "fatmen/faexcm.inc"
-
- DATA NENTRY/0/
-
- IF(NENTRY.EQ.0) THEN
-*
-* Set up descriptor of header vector
-*
- CALL MZIOCH(IOCH,NW,'70H 10I')
- NENTRY = 1
- ENDIF
-
- IRC = 0
- LGN = LENOCC(GENAM)
-
- IF(IDEBFA.GE.2) PRINT *,'FAEXTR. processing ',
- + GENAM(1:LGN)
- NFILES = NFILES + 1
-
- CALL FMGETK(GENAM(1:LGN),LBANK,KEYS,IRC)
- IF(IRC.EQ.0) THEN
-*
-* Fill with blanks for safety
-*
- CALL VBLANK(IUHEAD,70)
-*
-* Fill header vector
-*
- CALL UCTOH('MOD ',IUHEAD,4,4)
-
- CALL UCTOH(GENAM,IUHEAD(2),4,LGN)
-*
-* Keys
-*
- LEND = INDEXB(GENAM,'/') + 1
- FNAME = GENAM(LEND:LGN)
- IUHEAD(71) = KEYS(1)
- IUHEAD(77) = IQ(LBANK+MCPLFA+KOFUFA)
- IUHEAD(78) = IQ(LBANK+MMTPFA+KOFUFA)
- IUHEAD(79) = IQ(LBANK+MLOCFA+KOFUFA)
- IUHEAD(80) = LKEYFA
- LENFN = LGN-LEND+1
-*
-* IUHEAD 71-80 contains the keys, which includes the filename
-*
- DO 2 I=LENFN+1,20
- 2 FNAME(I:I) = ' '
- CALL UCTOH(FNAME,IUHEAD(72),4,20)
- CALL FZOUT(LUFZFA,IDIVFA,LBANK,1,'S',IOCH,NW,IUHEAD)
- CALL MZDROP(IDIVFA,LBANK,' ')
- LBANK = 0
- ELSE
- IRC = 0
- NBAD = NBAD + 1
- ENDIF
-
- END
diff --git a/src/packlib/fatmen/fatutil/fafc.F b/src/packlib/fatmen/fatutil/fafc.F
deleted file mode 100644
index df9af0b..0000000
--- a/src/packlib/fatmen/fatutil/fafc.F
+++ /dev/null
@@ -1,108 +0,0 @@
-*
-* $Id: fafc.F,v 1.1.1.1 1996/03/07 15:18:05 mclareni Exp $
-*
-* $Log: fafc.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:05 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FAFC(PATH,IRC)
-*CMZ : 30/08/91 09.35.24 by Jamie Shiers
-*-- Author : Jamie Shiers 30/08/91
-*
-* Slave routine to FMFC. This routine is called by
-* FMSCAN for all directories that match the input
-* pattern to the FC command.
-*
- CHARACTER*(*) PATH
- PARAMETER (MAXFIL=100)
- PARAMETER (LKEYFA=10)
- DIMENSION MYKEYS(LKEYFA,MAXFIL)
- CHARACTER*20 FNAME,CHTEMP
-#include "fatmen/fatpara.inc"
-#include "fatmen/fafccm.inc"
-#include "zebra/quest.inc"
-#include "fatmen/fatbug.inc"
- LPATH = LENOCC(PATH)
- LF = LENOCC(CHFILE)
- IF(IDEBFA.GE.3) PRINT *,'FAFC. enter for path = ',
- + PATH(1:LPATH)
-*
-* Bump directory count
-*
- NDIRT = NDIRT + 1
- IFIRST = 1
- ILAST = MAXFIL
- NMAT = 0
- NFIL = 0
- IRC = 0
-*
-* Get number of directories below CWD (filled by FMSCAN)
-*
- NDIR = IQUEST(12)
-*
-* Fast count - if CHFILE = *, just count number of files
-*
- IF(CHFILE(1:LF).EQ.'*') THEN
- NFIL = IQUEST(14)
- NMAT = NFIL
- GOTO 40
- ELSE
-
- 10 CONTINUE
- CALL FMKEYS(LKEYFA,MAXFIL,IFIRST,ILAST,MYKEYS,NFILES,IRET)
- NFIL = IQUEST(11)
- IF(IQUEST(1) .NE. 0) THEN
- IF(IDEBFA.GE.2) PRINT *,'FMFC. More than ',MAXFIL,' files '
- + //'in ',PATH(1:LPATH)
- IF(IDEBFA.GE.2) PRINT *,'FMFC. IQUEST(11-12) = ',IQUEST(11)
- + ,IQUEST(12)
- ENDIF
-*
-* Process all keys returned and move those that match to KEYS
-*
- NRET = IQUEST(13)
- IF(NRET.EQ.0) GOTO 40
- 20 CONTINUE
- DO 30 J=1,NRET
- CALL UHTOC(MYKEYS(2,J),4,FNAME,(MKCLFA-MKFNFA)*4)
- CALL FMATCH(FNAME(1:LENOCC(FNAME)),CHFILE(1:LF),IMAT)
- IF(IMAT.NE.0) GOTO 30
- NMAT = NMAT + 1
-
- 30 CONTINUE
- IF(ILAST.LT.NFIL) THEN
- IFIRST = IFIRST + MAXFIL
- ILAST = MIN(NFIL,IFIRST+MAXFIL-1)
- GOTO 10
- ENDIF
-
- ENDIF
-
- 40 CONTINUE
- NFOUND = NFOUND + NFIL
- NMATCH = NMATCH + NMAT
-*
-* Display only empty (zero files) directories
-*
- IF((IOPTZ.NE.0).AND.(NFIL.NE.0)) GOTO 50
-*
-* Display only lowest level directories
-*
- IF((IOPTL.NE.0).AND.(NDIR.NE.0)) GOTO 50
-
- IF((IOPTD.NE.0).OR.(IOPTF.NE.0)) THEN
- WRITE(LWRITE,*)
- WRITE(LWRITE,*) 'Directory: ',PATH(1:LPATH)
- ENDIF
-
- IF(IOPTD.NE.0) WRITE(LWRITE,*) ' subdirectories: ',NDIR
-*
-* Number of files, matches
-*
- IF(IOPTF.NE.0) WRITE(LWRITE,*) ' files: ',NFIL, ' matches: ',
- +NMAT
-
- 50 CONTINUE
- END
diff --git a/src/packlib/fatmen/fatutil/fafndf.F b/src/packlib/fatmen/fatutil/fafndf.F
deleted file mode 100644
index e08e34d..0000000
--- a/src/packlib/fatmen/fatutil/fafndf.F
+++ /dev/null
@@ -1,55 +0,0 @@
-*
-* $Id: fafndf.F,v 1.1.1.1 1996/03/07 15:18:07 mclareni Exp $
-*
-* $Log: fafndf.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:07 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
-#if defined(CERNLIB_UNIX)
- INTEGER FUNCTION FAFNDF(CHPATH,CHFILE,ICONT)
-*
-* FORTRAN version of FAFNDF - rough equivalent of LIB$FIND_FILE
-*
- CHARACTER*(*) CHPATH,CHFILE
- CHARACTER*255 CHDIR
- CHARACTER*80 PATH,CHTEMP
- INTEGER SYSTEMF
-#include "fatmen/fatsys.inc"
-#include "fatmen/fatbug.inc"
-#include "fatmen/slate.inc"
- LOGICAL IOPEN
-
- FAFNDF = 0
-*
- LPATH = LENOCC(CHPATH)
- PATH = CHPATH
-
- LDEF = LENOCC(DEFAULT)
- CHTEMP = DEFAULT(1:LDEF)//'/'//'fafndf.tmp'
- LTEMP = LDEF + 11
-
- IF(IDEBFA.GE.2) PRINT *,'FAFNDF. temporary file is ',
- + CHTEMP(1:LTEMP)
-
- IF(ICONT.EQ.0) THEN
- INQUIRE(99,OPENED=IOPEN)
- IF(IOPEN) CLOSE(99,STATUS='DELETE')
-
- IC = SYSTEMF('ls '//PATH(1:LPATH)//' > '
- + //CHTEMP(1:LTEMP)//' 2>&1')
-
- IF(IC.NE.0) GOTO 99
- OPEN(99,FILE=CHTEMP(1:LTEMP),FORM='FORMATTED',
- + STATUS='UNKNOWN')
- ENDIF
-
- CHFILE = ' '
- READ(99,'(A)',END=99,ERR=99) CHFILE
- RETURN
-
- 99 FAFNDF = 1
- CLOSE(99,STATUS='DELETE')
- END
-#endif
diff --git a/src/packlib/fatmen/fatutil/fahunt.F b/src/packlib/fatmen/fatutil/fahunt.F
deleted file mode 100644
index 7fea32c..0000000
--- a/src/packlib/fatmen/fatutil/fahunt.F
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: fahunt.F,v 1.1.1.1 1996/03/07 15:18:07 mclareni Exp $
-*
-* $Log: fahunt.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:07 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FAHUNT(GENAM,KEYS,IRC)
-*CMZ : 12/11/91 08.58.44 by Jamie Shiers
-*-- Author : Jamie Shiers 12/11/91
- CHARACTER*(*) GENAM
-#include "fatmen/fahucm.inc"
- DIMENSION KEYS(LKEYFA)
-
- LGN = LENOCC(GENAM)
- CHFILE = GENAM(1:LGN)
- CALL UCOPY(KEYS,KEYH,LKEYFA)
-
- IRC = 1
-
- END
diff --git a/src/packlib/fatmen/fatutil/fainqr.F b/src/packlib/fatmen/fatutil/fainqr.F
deleted file mode 100644
index e2bb26f..0000000
--- a/src/packlib/fatmen/fatutil/fainqr.F
+++ /dev/null
@@ -1,339 +0,0 @@
-*
-* $Id: fainqr.F,v 1.1.1.1 1996/03/07 15:18:07 mclareni Exp $
-*
-* $Log: fainqr.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:07 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FAINQR(DSNAME,CHHOST,CHNAME,IRC)
-*CMZ : 17/10/91 15.00.35 by Jamie Shiers
-*-- Author : Jamie Shiers 17/10/91
- CHARACTER*(*) DSNAME,CHHOST,CHNAME
- CHARACTER*255 DSN,CHFILE
-#include "fatmen/fatbug.inc"
-#include "fatmen/slate.inc"
-#include "zebra/quest.inc"
-
- PARAMETER (NPOSS=4)
- CHARACTER*8 CHPOSS(NPOSS)
-#if defined(CERNLIB_VAXVMS)
- CHARACTER*255 CHDFS,DFSNAM
- INCLUDE '($RMSDEF)'
- INTEGER FAFNDF
-#endif
-#if defined(CERNLIB_UNIX)||defined(CERNLIB_VAXVMS)
- CHARACTER*255 CHNFS
-#endif
-#if defined(CERNLIB_IBMVM)
- CHARACTER*8 USER,ADDR
- CHARACTER*16 CHSFS
- CHARACTER*80 CHGIME,CHLINE
- CHARACTER*1 MODE
-#endif
-#if defined(CERNLIB_SHIFT)
- CHARACTER*16 SHPOOL,SHUSER
- CHARACTER*11 SHLINK
- CHARACTER*255 CHDSN
-#endif
- LOGICAL IEXIST
- SAVE CHPOSS
-
- DATA CHPOSS(1)/'OSM'/,
- + CHPOSS(2)/'UNITREE'/,
- + CHPOSS(3)/'ADSM'/,
- + CHPOSS(4)/'EMASS'/
-*
-* Return access method in IQUEST(1)
-* IQUEST(1) = 0 : unknown
-* 1 : VM/CMS mini-disk
-* 2 : VM/CMS SFS
-* 11 : VAX/VMS disk
-* 12 : VAXcluster disk
-* 13 : DFS (DECnet)
-* 14 : DECnet
-* 15 : CSPACK (zserv)
-* 16 : FPACK
-* 21 : Unix disk
-* 22 : NFS (e.g. $VARIABLE/file)
-* 23 : AFS
-* 24 : Shift pool file
-* 25 : Shift private file
-* 31 : Lachman OSM file
-* 32 : Unitree file
-* 33 : ADSM file
-* 34 : E-MASS file
-*
-* CHFILE contains on exit the fully qualified filename (VMS, Unix)
-*
- IRC = 0
- IACC = 0
-
- LDSN = LENOCC(DSNAME)
- DSN = DSNAME(1:LDSN)
- LHOST = LENOCC(CHHOST)
-*
-* URL?
-*
- IURL = INDEX(DSN(1:LDSN),'://')
- ISLASH = INDEX(DSN(1:LDSN),'/')
- IF(IURL.NE.0.AND.IURL.EQ.ISLASH-1) THEN
- IT = ICNTHU(DSN(1:IURL-1),CHPOSS,NPOSS)
- IF(IT.NE.0) IACC=30+IT
-#if defined(CERNLIB_UNIX)
-*
-* ... issue mssquery ...
-*
-#endif
-#if !defined(CERNLIB_UNIX)
- IRC = -1
-#endif
- GOTO 99
- ENDIF
-
-#if defined(CERNLIB_IBMVM)
-*
-* Get disk name and link to it
-*
- MODE = ' '
- LSTA = INDEX(DSN,'<')
- IF(LSTA.NE.0) THEN
-*
-* Format of DSN is <user.address>filename.filetype on VM
-* address defaults to 191. If field <> missing, defaults to
-* current userid.
-*
-* Valid filenames:
-* FN.FT
-* <JAMIE>FN.FT
-* <JAMIE.191>FN.FT
-* SFS POOL:<JAMIE.A191>FN.FT
-*
- CALL CTRANS('[','<',DSN,1,LDSN)
- CALL CTRANS(']','>',DSN,1,LDSN)
- LDOT = INDEX(DSN,'.')
- LBRA = INDEX(DSN,'>')
-
- IF((LDOT.NE.0).AND.(LDOT.LE.LBRA)) THEN
- LEND = LDOT
- ELSE
- LEND = LBRA
- ENDIF
-
- USER = DSN(LSTA+1:LEND-1)
- LUSR = LEND - LSTA - 1
- ADDR = ' '
-
- IF((LDOT.NE.0).AND.(LDOT.LE.LBRA)) THEN
- ADDR= DSN(LDOT+1:LBRA-1)
- ENDIF
-
- LCHSFS = INDEX(DSN(1:LDSN),':')
- IF(LCHSFS.NE.0) THEN
- CHSFS = DSN(1:LCHSFS)
- IF(IDEBFA.GE.2) PRINT *,'FAINQR. SFS pool = ',
- + CHSFS(1:LCHSFS)
- ENDIF
-
- IF(LCHSFS.EQ.0) THEN
- IACC = 1
- CHGIME = 'EXEC GIME '//USER(1:LUSR)//' '//ADDR//
- + '(QUIET NONOTICE STACK)'
- ELSE
- IACC = 2
- CHGIME = 'EXEC GIME '//
- + CHSFS(1:LCHSFS)//USER(1:LUSR)//'.'//ADDR//
- + '(QUIET NONOTICE STACK)'
- ENDIF
-
- CALL CSQMBL(CHGIME,1,80)
- LCHG = LENOCC(CHGIME)
-
- IF(IDEBFA.GE.1) PRINT *,'FAINQR. executing ',
- + CHGIME(1:LCHG)
- CALL VMCMS(CHGIME(1:LCHG),IGIME)
-
- IF(IGIME.GT.4) THEN
- IF(IDEBFA.GE.0)
- + PRINT *,'FAINQR return code from GIME = ',IGIME
- GOTO 99
- ENDIF
-
- CALL VMRTRM(CHLINE,LENGTH)
- MODE = CHLINE(1:1)
-
- CHFILE = '/' // DSN(LBRA+1:LDSN) // ' ' // MODE
- LDSN = LDSN + 3 - LBRA
-
- ENDIF
-
- CALL CTRANS('.',' ',CHFILE,1,LDSN)
-
-#endif
-#if defined(CERNLIB_IBMMVS)
- CHFILE = '/'//DSN(1:LDSN)
- LDSN = LDSN + 1
-#endif
-#if defined(CERNLIB_VAXVMS)
-*
-* Check hostname
-*
- IACC = 11
- IF(LHOST.GT.0) THEN
- CALL FMVAXC(CHHOST(1:LHOST),ICODE)
- IACC = 11 + ICODE
- ENDIF
-*
-* Check DFS access
-*
- IF(ICODE.EQ.2) THEN
-*
-* First, get full file name
-*
- ICONT = 0
-* IFIND = LIB$FIND_FILE(DSN(1:LDSN),CHDFS,ICONT)
- IFIND = FAFNDF(DSN(1:LDSN),CHDFS,ICONT)
- IEND = LIB$FIND_FILE_END(ICONT)
- IF(IFIND.EQ.RMS$_SUC) THEN
- LCHDSN = INDEX(CHDFS,':') - 1
- IF(LCHDSN.GT.0) THEN
- CALL FMGTLG(CHDFS(1:LCHDSN),DFSNAM,'LNM$SYSTEM',JRC)
- IF((JRC.EQ.0).AND.(INDEX(DFSNAM,'DFSC').NE.0)) IACC = 13
- ENDIF
- ELSE
- INQUIRE(FILE=CHHOST(1:LHOST)//'::'//DSN(1:LDSN),
- + EXIST=IEXIST)
- IF(IEXIST) THEN
- IACC = 14
- CHFILE = CHHOST(1:LHOST)//'::'//DSN(1:LDSN)
- ENDIF
- ENDIF
- ENDIF
-#endif
-#if defined(CERNLIB_UNIX)
- IACC = 21
- IF(DSN(1:5).EQ.'/afs/') IACC = 23
-#endif
-#if defined(CERNLIB_SHIFT)
-*
-* Check if link already exists...
-*
- CHDSN = DSN(1:LDSN)
- SHLINK = 'FATMEN_LINK'
- INQUIRE(FILE=SHLINK,EXIST=IEXIST)
- IF(IEXIST) THEN
- IF(IDEBFA.GE.0)
- + PRINT *,'FAINQR. removing existing symbolic link...'
- IRC = SYSTEMF('rm '//SHLINK)
- ENDIF
-
- CALL CTRANS('<','[',DSN,1,LDSN)
- CALL CTRANS('>',']',DSN,1,LDSN)
- ILSQB = INDEX(DSN(1:LDSN),'[')
- IRSQB = INDEX(DSN(1:LDSN),']')
-
- IF(ILSQB.NE.0) THEN
-
- IF(IDEBFA.GE.1) PRINT *,'FAINQR. SHIFT POOL file...'
-
- IACC = 24
- IDOT = INDEX(DSN(1:IRSQB),'.')
- SHPOOL = DSN(2:IDOT-1)
- SHUSER = DSN(IDOT+1:IRSQB-1)
- ISTART = IRSQB+1
- IEND = LDSN
- IF (IDEBFA.GE.0) PRINT *,'FAINQR. Assign for logical unit ',
- + SHLINK,' pool = ',SHPOOL,
- + ' user = ',SHUSER,' dsn = ',DSN(ISTART:IEND)
- IRC = SYSTEMF('assign ` sfget -k -p '//SHPOOL//
- + ' -u '//SHUSER// ' '//CHDSN(ISTART:IEND)//' `
- + '//SHLINK//' ')
- IF(IRC.NE.0) THEN
- PRINT *,'FAINQR. return code ',IRC,' from SFGET'
- GOTO 99
- ENDIF
- ELSE
-
- IF(IDEBFA.GE.1) PRINT *,'FAINQR. SHIFT private file...'
- IACC = 25
- IRC = SYSTEMF('assign '//CHDSN(1:LDSN)//' '//
- + SHLINK)
- IF(IRC.NE.0) THEN
- PRINT *,'FAINQR. return code ',IRC,' from SFGET'
- GOTO 99
- ENDIF
- ENDIF
-
- DSN = SHLINK
- LDSN = 11
-#endif
-#if (defined(CERNLIB_UNIX)||defined(CERNLIB_VAXVMS))&&(!defined(CERNLIB_SHIFT))
-*
-* Expand any environmental variable
-*
- IF(DSN(1:1).EQ.'$') THEN
- IACC = 22
- LEND = INDEX(DSN,'/')
-#endif
-#if (defined(CERNLIB_UNIX))&&(!defined(CERNLIB_SHIFT))
- CALL GETENVF(DSN(2:LEND-1),CHNFS)
-#endif
-#if (defined(CERNLIB_VAXVMS))&&(!defined(CERNLIB_SHIFT))
- CALL FMGTLG(DSN(2:LEND-1),CHNFS,'LNM$SYSTEM',IRC)
-#endif
-#if (defined(CERNLIB_UNIX)||defined(CERNLIB_VAXVMS))&&(!defined(CERNLIB_SHIFT))
- IF(IS(1).EQ.0) THEN
- IF(IDEBFA.GE.3) PRINT *,'FAINQR. cannot expand ',
- + 'environmental variable/logical name ',DSN(2:LEND-1)
- IRC = 1
- GOTO 99
- ENDIF
- LCHNFS = IS(1)
-#endif
-#if (defined(CERNLIB_UNIX))&&(!defined(CERNLIB_SHIFT))
- CHFILE = CHNFS(1:IS(1)) // DSN(LEND:LDSN)
- LDSN = IS(1) + LDSN - LEND + 1
-#endif
-#if (defined(CERNLIB_VAXVMS))&&(!defined(CERNLIB_SHIFT))
-*
-* If there is more than one slash in file name
-* assume that the intervening elements are directory names
-*
- JSLASH = INDEXB(DSN(1:LDSN),'/')
- IF(JSLASH.EQ.LEND) THEN
- CHNFS(LCHNFS+1:) = DSN(LEND+1:LDSN)
- LCHNFS = LCHNFS + LDSN - LEND
- ELSE
- CHNFS(LCHNFS+1:) = '[' // DSN(LEND+1:JSLASH-1)
- + // ']' // DSN(JSLASH+1:LDSN)
- LCHNFS = LCHNFS + LDSN - LEND + 1
- CALL CTRANS('/','.',CHNFS,1,LCHNFS)
- ENDIF
- CHFILE = CHNFS(1:LCHNFS)
-#endif
-#if (defined(CERNLIB_UNIX)||defined(CERNLIB_VAXVMS))&&(!defined(CERNLIB_SHIFT))
- ELSE
- IF(IACC.NE.14) CHFILE = DSN
- ENDIF
-
-#endif
-#if (defined(CERNLIB_UNIX))&&(!defined(CERNLIB_SHIFT))
- CALL CUTOL(CHFILE)
-#endif
- LFILE = LENOCC(CHFILE)
- IF(IDEBFA.GE.2) PRINT *,'FAINQR. issuing inquire for ',
- + CHFILE(1:LFILE)
- INQUIRE(FILE=CHFILE(1:LFILE),EXIST=IEXIST,NAME=CHNAME)
- IF(.NOT.IEXIST) IRC = 1
-
-#if defined(CERNLIB_IBMVM)
-*
-* Don't drop disks that were already accessed, our A disk etc.
-*
- IF(IGIME.NE.4.AND.MODE.NE.'A'.AND.MODE.NE.' ')
- + CALL VMCMS('EXEC DROP '//MODE//' (QUIET',IRT)
-#endif
-99 CONTINUE
- IQUEST(1) = IACC
- END
diff --git a/src/packlib/fatmen/fatutil/fald.F b/src/packlib/fatmen/fatutil/fald.F
deleted file mode 100644
index 1061c08..0000000
--- a/src/packlib/fatmen/fatutil/fald.F
+++ /dev/null
@@ -1,324 +0,0 @@
-*
-* $Id: fald.F,v 1.1.1.1 1996/03/07 15:18:06 mclareni Exp $
-*
-* $Log: fald.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:06 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FALD(PATH,NLEVEL,LWRITE,CHOPT,IRC)
-*
-************************************************************************
-*
-* To traverse the FATMEN directory tree starting from
-* the specified pathname.
-* Modified from the RZ routine RZSTAT / RZSCAN
-*
-* ==> To be modified to support wild-cards in path name, including
-* ==> <>
-*
-* Input:
-* CHPATH The pathname of the starting directory
-* NLEVEL Number of levels below CHPATH to descend
-*
-* Output:
-* IQUEST(11) = number of directories found
-* IQUEST(12) = number of directories that match
-*
-* Called by FMLD
-*
-*
-************************************************************************
-#include "zebra/rzcl.inc"
-#include "zebra/rzdir.inc"
-#include "zebra/rzch.inc"
-#include "zebra/rzk.inc"
- CHARACTER*(*) PATH
- CHARACTER*255 CHPATH
- CHARACTER*255 OLDDIR
- CHARACTER*132 CHLINE
- PARAMETER (MAXLEV=20)
- CHARACTER*16 DIRNAM(MAXLEV),CHDIR
- DIMENSION ISD(MAXLEV),NSD(MAXLEV),IHDIR(4)
-#include "fatmen/slate.inc"
-#include "fatmen/fatbug.inc"
-#include "fatmen/farnge.inc"
- SAVE DIRNAM
-#include "fatmen/fatopts.inc"
-*
-*-----------------------------------------------------------------------
-*
-*
- IRC=0
- IQUEST(1) = 0
- IQUEST(11) = 0
- IWIDTH = 0
- JWIDTH = 78
- IF(IOPTV.NE.0) JWIDTH = 132
- LPATH = LENOCC(PATH)
- LPATHI = LPATH
- CHPATH = PATH(1:LPATH)
- CALL CLTOU(CHPATH(1:LPATH))
-*
-* Split input path name into its component pieces
-* (this is the opposite of RZPAFF which glues them together)
-*
- CALL FMPAFF(CHPATH(1:LPATH),DIRNAM,MAXLEV,IRET)
-*
-* Find first wild card in generic name
-*
- IF(IDEBFA.GE.3)
- +PRINT *,'FALD. enter for PATH = ',CHPATH(1:LPATH),' nlevel = ',
- + NLEVEL,' chopt = ',CHOPT
- IWILD = ICFMUL('*%(<>[]',CHPATH,1,LPATH)
- IF(IWILD.LE.LPATH) THEN
- LPATH = INDEXB(CHPATH(1:IWILD),'/') - 1
- ENDIF
-*
- ITIME=0
- NLEV=NLEVEL
- IF(NLEV.LE.0)NLEV=99
- NFOUND = 0
- NMATCH = 0
- ITEMP = 0
- CALL FACDIR(CHWOLD,'R')
- OLDDIR = ' '
- LOLD = 1
-*
-* Set CWD to the current level
-*
- 10 CONTINUE
- IF(ITIME.NE.0)THEN
- CALL RZPAFF(CHPAT,NLPAT,CHL)
- IF(IQUEST(1).NE.0) THEN
- NLPAT = NLPAT - 1
- GOTO 60
- ENDIF
- CALL FACDIR(CHL,' ')
- ELSE
- CALL FACDIR(CHPATH(1:LPATH),' ')
- IF(IQUEST(1).NE.0)GO TO 80
- NLPAT0=NLPAT
- CHL = CHPATH(1:LPATH)
- ENDIF
- IF(IQUEST(1).NE.0) THEN
- NLPAT = NLPAT - 1
- GOTO 60
- ENDIF
-*
-* Set IQUEST
-*
- IQUEST(12) = IQ(KQSP+LCDIR+KNSD)
- IQUEST(13) = NLPAT
- IQUEST(14) = IQ(KQSP+LCDIR+KNKEYS)
- IQUEST(15) = IQ(KQSP+LCDIR+KNWKEY)
-*
-* Ensure that entire path name matches before printing
-*
- IRC = 0
-
- IF(ITIME.NE.0) THEN
- NFOUND = NFOUND + 1
- CALL FMATCH(CHL,CHPATH(1:LPATHI),IRC)
- IF(IRC.EQ.0) NMATCH = NMATCH + 1
- ENDIF
-
- IF(IRC.EQ.0) THEN
- LCHL = LENOCC(CHL)
- ISLASH = INDEXB(CHL(1:LCHL),'/')
-
- IF(IOPTV+IOPTW.EQ.0) THEN
- WRITE(LWRITE,*) CHL(1:LCHL)
- ELSE
- IF(CHL(1:ISLASH-1).NE.OLDDIR(1:LOLD)) THEN
-* flush current buffer
- IF(IWIDTH.NE.0) THEN
- WRITE(LWRITE,'(1X,A)') CHLINE(1:IWIDTH)
- IWIDTH = 0
- ENDIF
-
- WRITE(LWRITE,*)
- WRITE(LWRITE,'(1X,A,A)') 'Directory: ',CHL(1:ISLASH-1)
- WRITE(LWRITE,*)
- LOLD = ISLASH - 1
- OLDDIR = CHL(1:LOLD)
-
- ENDIF
-
- LF = LCHL - ISLASH
- IF(IWIDTH+LF.GE.JWIDTH) THEN
-* flush current buffer
- WRITE(LWRITE,'(1X,A)') CHLINE(1:IWIDTH)
- IWIDTH = 0
- ENDIF
- IF(IWIDTH.EQ.0) THEN
- CHLINE = CHL(ISLASH+1:LCHL) // ' '
- ELSE
- CHLINE = CHLINE(1:IWIDTH) // CHL(ISLASH+1:LCHL) // ' '
- ENDIF
- IWIDTH = IWIDTH + LF + 1
- ENDIF
- ENDIF
-
- ISD(NLPAT)=0
- NSD(NLPAT)=IQ(KQSP+LCDIR+KNSD)
-*
-* If there is a <> at this level, perform matching
-* and follow only that path
-*
- ILT = INDEX(DIRNAM(NLPAT+1),'<')
- IGT = INDEX(DIRNAM(NLPAT+1),'>')
- NFRNGE(NLPAT+1) = 0
-
- IF((ILT.NE.0).AND.(IGT.NE.0)) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FALD. invalid wild-carding ',
- + 'at level ',NLPAT,' in pathname - ',DIRNAM(NLPAT+1)
- IF(IDEBFA.GE.-3) PRINT *,'FALD. only one of < or > ',
- + 'may be specified'
- IQUEST(1) = -1
- GOTO 70
- ENDIF
-
- IF(ILT+IGT.NE.0) THEN
-*
-* Is there a [mm:nn] syle range?
-*
- JR = LENOCC(DIRNAM(NLPAT+1))
- ISQ = INDEX(DIRNAM(NLPAT+1)(1:JR),'[')
- IF(ISQ.NE.0) THEN
- ILOW = ICDECI(DIRNAM(NLPAT+1),ISQ+1,JR)
- IF(IS(1).EQ.0) THEN
- IRC = -1
- IF(IDEBFA.GE.-3) PRINT *,'FALD. error reading ',
- + 'decimal value from ',DIRNAM(NLPAT+1)(ISQ:JR)
- IF(IDEBFA.GE.-3) PRINT *,' Only integer ranges ',
- + 'are supported between [] characters, e.g. [10:20]'
- GOTO 80
- ENDIF
- IHIGH = ICDECI(DIRNAM(NLPAT+1),
- + INDEX(DIRNAM(NLPAT+1),':') + 1,JR)
- IF(IS(1).EQ.0) THEN
- IRC = -1
- IF(IDEBFA.GE.-3) PRINT *,'FALD. error reading ',
- + 'decimal value from ',DIRNAM(NLPAT+1)(ISQ:JR)
- IF(IDEBFA.GE.-3) PRINT *,' Only integer ranges ',
- + 'are supported between [] characters, e.g. [10:20]'
- GOTO 80
- ENDIF
- IF(IDEBFA.GE.3) PRINT *,'FALD. ilow/ihigh = ',ILOW,IHIGH
- NFRNGE(NLPAT+1) = 0
- IF(IHIGH-ILOW+1.GT.100) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FALD. maximum range is 100',
- + ' - excess elements will be ignored'
- IHIGH = ILOW + 99
- ENDIF
- DO 20 JJ=ILOW,IHIGH
- NFRNGE(NLPAT+1) = NFRNGE(NLPAT+1) + 1
- IFRNGE(NFRNGE(NLPAT+1),NLPAT+1) = JJ
- IFELEM(NFRNGE(NLPAT+1),NLPAT+1) = -1
- IF(ILT.NE.0) THEN
- IFVAL(NFRNGE(NLPAT+1),NLPAT+1) = 999999
- ELSE
- IFVAL(NFRNGE(NLPAT+1),NLPAT+1) = -1
- ENDIF
- 20 CONTINUE
- ENDIF
-*
-* Loop over all subdirectories at this level
-*
- DO 40 JJ=1,NSD(NLPAT)
- LS=IQ(KQSP+LCDIR+KLS)
- IH=LS+7*(JJ-1)
- CALL ZITOH(IQ(KQSP+LCDIR+IH),IHDIR,4)
- CALL UHTOC(IHDIR,4,CHDIR,16)
- CALL FASELP(CHDIR,DIRNAM(NLPAT+1),JJ,NSD(NLPAT),JINDEX,IRC)
- 40 CONTINUE
- IF(JINDEX.GT.0) THEN
- IF(NFRNGE(NLPAT+1).EQ.0) THEN
- IF(IDEBFA.GE.3) THEN
- LS=IQ(KQSP+LCDIR+KLS)
- IH=LS+7*(JINDEX-1)
- CALL ZITOH(IQ(KQSP+LCDIR+IH),IHDIR,4)
- CALL UHTOC(IHDIR,4,CHDIR,16)
- PRINT *,'FALD. selected subdirectory ',CHDIR
- ENDIF
- NSD(NLPAT) = JINDEX
- ISD(NLPAT) = JINDEX - 1
- ELSE
- LS=IQ(KQSP+LCDIR+KLS)
- IF(IDEBFA.GE.3)
- + PRINT *,'FALD. selected following subdirectories...'
- JMIN = 999999
- JMAX = 0
- DO 50 II=1,NFRNGE(NLPAT+1)
- JJ=IFELEM(II,NLPAT+1)
- IF(JJ.LE.0) GOTO 50
- IF(JJ.LT.JMIN) JMIN = JJ
- IF(JJ.GT.JMAX) JMAX = JJ
- IF(IDEBFA.GE.3) THEN
- IH=LS+7*(JJ-1)
- CALL ZITOH(IQ(KQSP+LCDIR+IH),IHDIR,4)
- CALL UHTOC(IHDIR,4,CHDIR,16)
- PRINT *,CHDIR
- ENDIF
- 50 CONTINUE
- NSD(NLPAT) = JMAX
- ISD(NLPAT) = JMIN - 1
- ENDIF
- ELSE
- IF(IDEBFA.GE.2)
- + PRINT *,'FALD. no subdirectory matches'
- NSD(NLPAT) = 0
- ENDIF
- ELSE
- JINDEX = -1
- ENDIF
-*
-* Process possible down directories
-*
- 60 ISD(NLPAT)=ISD(NLPAT)+1
-
- IF((ISD(NLPAT).LE.NSD(NLPAT)).AND.
- + (NLPAT.LT.(NLPAT0+NLEV))) THEN
- IF(NFRNGE(NLPAT+1).NE.0
- + .AND.IUFIND(ISD(NLPAT),
- + IFELEM(1,NLPAT+1),1,NFRNGE(NLPAT+1)).GT.
- + NFRNGE(NLPAT+1)) GOTO 60
- NLPAT=NLPAT+1
- LS=IQ(KQSP+LCDIR+KLS)
- IH=LS+7*(ISD(NLPAT-1)-1)
- CALL ZITOH(IQ(KQSP+LCDIR+IH),IHDIR,4)
- CALL UHTOC(IHDIR,4,CHPAT(NLPAT),16)
- ITIME=ITIME+1
- GO TO 10
- ELSE
-*
-* Write information on current directory
-*
- CALL RZPAFF(CHPAT,NLPAT,CHL)
-* IF(NLPAT.LE.(NLPAT0+NLEV))THEN
-* ENDIF
- NLPAT=NLPAT-1
- IF(NLPAT.GE.NLPAT0)THEN
- LUP=LQ(KQSP+LCDIR+1)
- CALL MZDROP(JQPDVS,LCDIR,' ')
- LCDIR=LUP
- GO TO 60
- ENDIF
- ENDIF
-*
-* Reset CWD
-*
- 70 CALL FACDIR(CHWOLD,' ')
-
- IF((IWIDTH.NE.0).AND.(IOPTV+IOPTW.NE.0)) THEN
- WRITE(LWRITE,'(1X,A)') CHLINE(1:IWIDTH)
- ENDIF
-*
- 80 CONTINUE
- IRC = IQUEST(1)
- IQUEST(11) = NFOUND
- IQUEST(12) = NMATCH
- RETURN
- END
diff --git a/src/packlib/fatmen/fatutil/falink.F b/src/packlib/fatmen/fatutil/falink.F
deleted file mode 100644
index b4d8511..0000000
--- a/src/packlib/fatmen/fatutil/falink.F
+++ /dev/null
@@ -1,371 +0,0 @@
-*
-* $Id: falink.F,v 1.1.1.1 1996/03/07 15:18:07 mclareni Exp $
-*
-* $Log: falink.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:07 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FALINK(PATH,NLEVEL,UROUT,IRC)
-*
-************************************************************************
-*
-* To traverse the FATMEN directory tree starting from
-* the specified pathname.
-* Modified from the RZ routine RZSTAT / RZSCAN
-*
-* This routine behaves like FMSCAN, but for files, rather than
-* directories.
-*
-* Input:
-* CHPATH The pathname of the starting directory
-* NLEVEL Number of levels below CHPATH about which space information
-* has to be accumulated.
-* UROUT External user routine to be called for each pathname
-*
-* Output:
-* IQUEST(10) = number levels in initial path
-* IQUEST(11) = number of directories found
-*
-* IQUEST(12) = number of subdirectories at this level
-* IQUEST(13) = number of elements in path name
-* IQUEST(14) = number of keys
-* IQUEST(15) = number of words per key
-* IQUEST(16) = incremental count of #keys selected
-* IQUEST(17) = number of this key vector
-*
-* Called by <USER>
-*
-*
-************************************************************************
-#include "fatmen/slate.inc"
-#include "zebra/rzcl.inc"
-#include "zebra/rzdir.inc"
-#include "zebra/rzch.inc"
-#include "zebra/rzk.inc"
- CHARACTER*(*) PATH
- CHARACTER*255 CHPATH
- CHARACTER*20 CHFILE,FNAME
- PARAMETER (MAXLEV=20)
- CHARACTER*16 DIRNAM(MAXLEV),CHDIR
- DIMENSION ISD(15),NSD(15),IHDIR(4)
- DIMENSION IOPTV(2)
- EQUIVALENCE (IOPTQ,IOPTV(1)), (IOPTX,IOPTV(2))
- EXTERNAL UROUT
-#include "fatmen/fmnkeys.inc"
- DIMENSION KEYS(LKEYFA)
-#include "fatmen/fatpara.inc"
-#include "fatmen/fatloc.inc"
-#include "fatmen/fatmtp.inc"
-#include "fatmen/fatcpl.inc"
-#include "fatmen/farnge.inc"
-#include "fatmen/fatbug.inc"
- SAVE DIRNAM
-*
-*-----------------------------------------------------------------------
-*
-*
- IRC=0
- IQUEST(1) = 0
- IQUEST(11) = 0
- LPATH = LENOCC(PATH)
- CHPATH = PATH(1:LPATH)
- CALL CLTOU(CHPATH(1:LPATH))
-*
-* Find file name
-*
- LSLASH = INDEXB(CHPATH(1:LPATH),'/')
- CHFILE = CHPATH(LSLASH+1:LPATH)
- LFILE = LPATH - LSLASH
- LPATH = LSLASH - 1
- LPATHI = LPATH
-*
-* Get number of levels in initial path
-*
- CALL FMNWRD('/',CHPATH(3:LPATHI),NLEV0)
-*
-* Split input path name into its component pieces
-* (this is the opposite of RZPAFF which glues them together)
-*
- CALL FMPAFF(CHPATH(1:LPATH),DIRNAM,MAXLEV,IRET)
-*
-* Find first wild card in generic name
-*
- IF(IDEBFA.GE.3)
- +PRINT *,'FALINK. enter for PATH = ',CHPATH(1:LPATH),
- + ' file = ',CHFILE(1:LFILE)
- IWILD = ICFMUL('*%(<>',CHPATH,1,LPATH)
- IF(IWILD.LE.LPATH) THEN
- LPATH = INDEXB(CHPATH(1:IWILD),'/') - 1
- ENDIF
-*
- ITIME=0
- NLEV=NLEVEL
- IF(NLEV.LE.0)NLEV=99
- NFOUND = 0
- ITEMP = 0
- CALL FACDIR(CHWOLD,'R')
-*
-* Set CWD to the current level
-*
- 10 CONTINUE
- IF(ITIME.NE.0)THEN
- CALL RZPAFF(CHPAT,NLPAT,CHL)
- IF(IQUEST(1).NE.0) THEN
- NLPAT = NLPAT - 1
- GOTO 60
- ENDIF
- CALL FACDIR(CHL,' ')
- ELSE
- CALL FACDIR(CHPATH(1:LPATH),' ')
- IF(IQUEST(1).NE.0)GO TO 80
- NLPAT0=NLPAT
- CHL = CHPATH(1:LPATH)
- ENDIF
- IF(IQUEST(1).NE.0) THEN
- NLPAT = NLPAT - 1
- GOTO 60
- ENDIF
-*
-* Set IQUEST
-*
- IQUEST(10) = NLEV0
- IQUEST(12) = IQ(KQSP+LCDIR+KNSD)
- IQUEST(13) = NLPAT
- IQUEST(14) = IQ(KQSP+LCDIR+KNKEYS)
- IQUEST(15) = IQ(KQSP+LCDIR+KNWKEY)
- NWK = IQ(KQSP+LCDIR+KNWKEY)
- NKEYS = IQ(KQSP+LCDIR+KNKEYS)
- LK = IQ(KQSP+LCDIR+KLK)
-*
-* Ensure that entire path name matches before calling UROUT
-*
- CALL FMATCH(CHL,CHPATH(1:LPATHI),IRC)
-*
-* Trailing unmatched characters in CHPATH
-* Accept if first character is a / and total length
-* of pathname is ok
-*
- IF(IRC.EQ.2.AND.CHL(IQUEST(1):IQUEST(1)).EQ.'/'
- + .AND.NLPAT.LE.NLEV0+NLEV) IRC = 0
-
- IF(IRC.EQ.0) THEN
-*
-* Get the keys
-*
- NDONE = 0
- DO 30 I=1,NKEYS
-*
-* Number of this key vector
-*
- IQUEST(17) = I
- K=LK+(NWK+1)*(I-1)
- DO 20 J=1,NWK
- IKDES=(J-1)/10
- IKBIT1=3*J-30*IKDES-2
- IF(JBYT(IQ(KQSP+LCDIR+KKDES+IKDES),IKBIT1,3).LT.3)THEN
- KEYS(J)=IQ(KQSP+LCDIR+K+J)
- ELSE
- CALL ZITOH(IQ(KQSP+LCDIR+K+J),KEYS(J),1)
- ENDIF
- 20 CONTINUE
- CALL UHTOC(KEYS(MKFNFA),4,FNAME,20)
- LF = LENOCC(FNAME)
-*
-* Location code = 0 for links
-*
- IF(KEYS(MKLCFA).NE.0) GOTO 30
-*
-* File name:
-*
- LF = LENOCC(FNAME)
-*
-* Fast check: CHFILE = '*'
-*
- IF(CHFILE(1:LFILE).EQ.'*.') THEN
- IMAT = 0
- ELSE
- CALL FMATCH(FNAME(1:LF),CHFILE(1:LFILE),IMAT)
- ENDIF
-
- IF(IMAT.NE.0) THEN
- IF(IDEBFA.GE.3) PRINT *,'FALINK. candidate # ',I,
- + ' fails filename check'
- GOTO 30
- ENDIF
-*
-* Now call user routine
-*
- NDONE = NDONE + 1
- IQUEST(16) = NDONE
- CALL UROUT(CHL(1:LENOCC(CHL))//'/'
- + //FNAME(1:LF),KEYS,IURC)
-*
-* Skip rest of this directory?
-*
- IF(IURC.LT.0) GOTO 40
-*
-* Finish now?
-*
- IF(IURC.GT.0) RETURN
- 30 CONTINUE
- 40 CONTINUE
- ENDIF
-
- ISD(NLPAT)=0
- NSD(NLPAT)=IQ(KQSP+LCDIR+KNSD)
-*
-* If there is a <> at this level, perform matching
-* and follow only that path
-*
- ILT = INDEX(DIRNAM(NLPAT+1),'<')
- IGT = INDEX(DIRNAM(NLPAT+1),'>')
- NFRNGE(NLPAT+1) = 0
-
- IF((ILT.NE.0).AND.(IGT.NE.0)) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FALINK. invalid wild-carding ',
- + 'at level ',NLPAT,' in pathname - ',DIRNAM(NLPAT+1)
- IF(IDEBFA.GE.-3) PRINT *,'FALINK. only one of < or > ',
- + 'may be specified'
- IQUEST(1) = -1
- GOTO 70
- ENDIF
-
- IF(ILT+IGT.NE.0) THEN
-*
-* Is there a [mm:nn] syle range?
-*
- JR = LENOCC(DIRNAM(NLPAT+1))
- ISQ = INDEX(DIRNAM(NLPAT+1)(1:JR),'[')
- IF(ISQ.NE.0) THEN
- ILOW = ICDECI(DIRNAM(NLPAT+1),ISQ+1,JR)
- IF(IS(1).EQ.0) THEN
- IRC = -1
- IF(IDEBFA.GE.-3) PRINT *,'FALINK. error reading ',
- + 'decimal value from ',DIRNAM(NLPAT+1)(ISQ:JR)
- IF(IDEBFA.GE.-3) PRINT *,' Only integer ranges ',
- + 'are supported between [] characters, e.g. [10:20]'
- GOTO 80
- ENDIF
- IHIGH = ICDECI(DIRNAM(NLPAT+1),
- + INDEX(DIRNAM(NLPAT+1),':') + 1,JR)
- IF(IS(1).EQ.0) THEN
- IRC = -1
- IF(IDEBFA.GE.-3) PRINT *,'FALINK. error reading ',
- + 'decimal value from ',DIRNAM(NLPAT+1)(ISQ:JR)
- IF(IDEBFA.GE.-3) PRINT *,' Only integer ranges ',
- + 'are supported between [] characters, e.g. [10:20]'
- GOTO 80
- ENDIF
- IF(IDEBFA.GE.3) PRINT *,'FALINK. ilow/ihigh = ',ILOW,IHIGH
- NFRNGE(NLPAT+1) = 0
- IF(IHIGH-ILOW+1.GT.100) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FALINK. maximum range is 100',
- + ' - excess elements will be ignored'
- IHIGH = ILOW + 99
- ENDIF
- DO 22 JJ=ILOW,IHIGH
- NFRNGE(NLPAT+1) = NFRNGE(NLPAT+1) + 1
- IFRNGE(NFRNGE(NLPAT+1),NLPAT+1) = JJ
- IFELEM(NFRNGE(NLPAT+1),NLPAT+1) = -1
- IF(ILT.NE.0) THEN
- IFVAL(NFRNGE(NLPAT+1),NLPAT+1) = 999999
- ELSE
- IFVAL(NFRNGE(NLPAT+1),NLPAT+1) = -1
- ENDIF
- 22 CONTINUE
- ENDIF
-*
-* Loop over all subdirectories at this level
-*
- DO 44 JJ=1,NSD(NLPAT)
- LS=IQ(KQSP+LCDIR+KLS)
- IH=LS+7*(JJ-1)
- CALL ZITOH(IQ(KQSP+LCDIR+IH),IHDIR,4)
- CALL UHTOC(IHDIR,4,CHDIR,16)
- CALL FASELP(CHDIR,DIRNAM(NLPAT+1),JJ,NSD(NLPAT),JINDEX,IRC)
- 44 CONTINUE
- IF(JINDEX.GT.0) THEN
- IF(NFRNGE(NLPAT+1).EQ.0) THEN
- IF(IDEBFA.GE.3) THEN
- LS=IQ(KQSP+LCDIR+KLS)
- IH=LS+7*(JINDEX-1)
- CALL ZITOH(IQ(KQSP+LCDIR+IH),IHDIR,4)
- CALL UHTOC(IHDIR,4,CHDIR,16)
- PRINT *,'FALINK. selected subdirectory ',CHDIR
- ENDIF
- NSD(NLPAT) = JINDEX
- ISD(NLPAT) = JINDEX - 1
- ELSE
- LS=IQ(KQSP+LCDIR+KLS)
- IF(IDEBFA.GE.3)
- + PRINT *,'FALINK. selected following subdirectories...'
- JMIN = 999999
- JMAX = 0
- DO 50 II=1,NFRNGE(NLPAT+1)
- JJ=IFELEM(II,NLPAT+1)
- IF(JJ.LE.0) GOTO 50
- IF(JJ.LT.JMIN) JMIN = JJ
- IF(JJ.GT.JMAX) JMAX = JJ
- IF(IDEBFA.GE.3) THEN
- IH=LS+7*(JJ-1)
- CALL ZITOH(IQ(KQSP+LCDIR+IH),IHDIR,4)
- CALL UHTOC(IHDIR,4,CHDIR,16)
- PRINT *,CHDIR
- ENDIF
- 50 CONTINUE
- NSD(NLPAT) = JMAX
- ISD(NLPAT) = JMIN - 1
- ENDIF
- ELSE
- IF(IDEBFA.GE.2)
- + PRINT *,'FALINK. no subdirectory matches'
- NSD(NLPAT) = 0
- ENDIF
- ELSE
- JINDEX = -1
- ENDIF
-*
-* Process possible down directories
-*
- 60 ISD(NLPAT)=ISD(NLPAT)+1
- IF((ISD(NLPAT).LE.NSD(NLPAT)).AND.
- + (NLPAT.LT.(NLPAT0+NLEV))) THEN
- IF(NFRNGE(NLPAT+1).NE.0
- + .AND.IUFIND(ISD(NLPAT),
- + IFELEM(1,NLPAT+1),1,NFRNGE(NLPAT+1)).GT.
- + NFRNGE(NLPAT+1)) GOTO 60
- NLPAT=NLPAT+1
- LS=IQ(KQSP+LCDIR+KLS)
- IH=LS+7*(ISD(NLPAT-1)-1)
- CALL ZITOH(IQ(KQSP+LCDIR+IH),IHDIR,4)
- CALL UHTOC(IHDIR,4,CHPAT(NLPAT),16)
- ITIME=ITIME+1
- GO TO 10
- ELSE
-*
-* Write information on current directory
-*
- CALL RZPAFF(CHPAT,NLPAT,CHL)
- IF(NLPAT.LE.(NLPAT0+NLEV))THEN
- NFOUND = NFOUND + 1
- ENDIF
- NLPAT=NLPAT-1
- IF(NLPAT.GE.NLPAT0)THEN
- LUP=LQ(KQSP+LCDIR+1)
- CALL MZDROP(JQPDVS,LCDIR,' ')
- LCDIR=LUP
- GO TO 60
- ENDIF
- ENDIF
-*
-* Reset CWD
-*
- 70 CALL FACDIR(CHWOLD,' ')
-*
- 80 CONTINUE
- IRC = IQUEST(1)
- IQUEST(11) = NFOUND
- RETURN
- END
diff --git a/src/packlib/fatmen/fatutil/faln.F b/src/packlib/fatmen/fatutil/faln.F
deleted file mode 100644
index 41f35a2..0000000
--- a/src/packlib/fatmen/fatutil/faln.F
+++ /dev/null
@@ -1,65 +0,0 @@
-*
-* $Id: faln.F,v 1.1.1.1 1996/03/07 15:18:07 mclareni Exp $
-*
-* $Log: faln.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:07 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FALN(GENAM,KEYS,IRC)
- CHARACTER*(*) GENAM
-*CMZ : 03/09/91 17.30.54 by Jamie Shiers
-*-- Author : Jamie Shiers 03/09/91
-#include "fatmen/fmnkeys.inc"
- DIMENSION KEYS(LKEYFA)
- CHARACTER*255 CHLINK
-#include "fatmen/fatbank.inc"
-#include "fatmen/fatpara.inc"
-#include "fatmen/falncm.inc"
-*
-* Options: P - print names of dangling links
-* D - write names of dangling links in 'rm ksn' format
-* R - remove dangling links
-* F - redirect output to CHFILE on LWRITE
-*
- IRC = 0
- LGN = LENOCC(GENAM)
-
- IF(IDEBFA.GE.2) PRINT *,'FALN. processing ',
- + GENAM(1:LGN)
- NFILES = NFILES + 1
-
- CALL FMGETK(GENAM(1:LGN),LTDSFA,KEYS,IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.0) PRINT *,'FALN. error ',IRC,
- + ' retrieving catalogue entry for ',GENAM(1:LGN)
- ELSE
- CALL UHTOC(IQ(LTDSFA+KOFUFA+MFQNFA),4,CHLINK,NFQNFA)
- LLINK = LENOCC(CHLINK)
-*
-* Does an entry exist for this name?
-*
- CALL FMEXST(CHLINK(1:LLINK),IEXIST)
- IF(IEXIST.EQ.0) THEN
- NLINKS = NLINKS + 1
- LUN = LPRTFA
- IF(IOPTTF.NE.0) LUN = LWRITE
- IF(IOPTTD.NE.0) THEN
- WRITE(LUN,9001) GENAM(1:LGN),KEYS(MKSRFA)
- ELSEIF(IOPTTP.NE.0) THEN
- WRITE(LUN,9002) GENAM(1:LGN)
- ENDIF
- IF(IOPTTR.NE.0) THEN
- CALL FMRM(GENAM(1:LGN),LTDSFA,KEYS,IRC)
- ENDIF
- ENDIF
-
- CALL MZDROP(IXSTOR,LTDSFA,' ')
- LTDSFA = 0
- ENDIF
-
- 9001 FORMAT(' rm ',A,1X,I10)
- 9002 FORMAT('FALN. ',A)
-
- END
diff --git a/src/packlib/fatmen/fatutil/fals.F b/src/packlib/fatmen/fatutil/fals.F
deleted file mode 100644
index 1cda49b..0000000
--- a/src/packlib/fatmen/fatutil/fals.F
+++ /dev/null
@@ -1,264 +0,0 @@
-*
-* $Id: fals.F,v 1.1.1.1 1996/03/07 15:18:06 mclareni Exp $
-*
-* $Log: fals.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:06 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FALS(PATH,IRC)
- CHARACTER*(*) PATH
- CHARACTER*255 CHPATH
- PARAMETER (MAXFIL=1000)
- PARAMETER (LKEYFA=10)
- DIMENSION KEYS(LKEYFA,MAXFIL),JSORT(MAXFIL)
- DIMENSION KEYSAV(LKEYFA)
- CHARACTER*255 FILES(MAXFIL),GENAM,OLDNAM
- COMMON/FALSC/KEYS,JSORT,FILES
- CHARACTER*255 FNAME
- CHARACTER*36 CHOPT
- INTEGER FMISET
-#include "fatmen/fatpara.inc"
-#include "fatmen/fatloc.inc"
-#include "fatmen/fatmtp.inc"
-#include "fatmen/fatcpl.inc"
-#include "fatmen/fatsys.inc"
-#include "fatmen/fatout.inc"
-#include "fatmen/fatsho.inc"
-#include "fatmen/fatbank.inc"
- CHARACTER*132 CARD
-#include "fatmen/falscm.inc"
-#include "fatmen/fatinit.inc"
-*
-* Look for some files and show the bank and key content:
-*
- NDIRT = NDIRT + 1
- NFILES = 0
- IRC = 0
- ITIME = 0
- LPATH = LENOCC(PATH)
- LCHF = LENOCC(CHFILE)
- CHPATH = PATH(1:LPATH)
-
- IF(IDEBFA.GE.2) PRINT *,'FALS. enter for ',PATH(1:LPATH),
- + ' match = ',CHFILE(1:LCHF)
-*
-* Reconstruct character option
-*
- LCH = 0
- CHOPT = ' '
-
- DO 10 J=1,36
- IF(IOPT(J).NE.0) THEN
- LCH = LCH + 1
- CHOPT(LCH:LCH) = ALFNUM(J:J)
- ENDIF
- 10 CONTINUE
-*
-* Do we need to call FMSHOW?
-*
- IF(LCH.EQ.0) THEN
- LCH = 1
- ISHOW = 0
- ELSE
- ISHOW = FMISET(CHOPT(1:LCH),'DGK')
- ENDIF
-
- JSHOW = 0
- ICONT = 0
- JCONT = 0
- 20 CONTINUE
-*
-* Only process one directory at a time, otherwise use FMLFIL
-*
- ITIME = ITIME + 1
- CALL FMFILS(CHPATH(1:LPATH)//'/'//CHFILE(1:LCHF),
- + FILES,KEYS,NFOUND,MAXFIL,JCONT,IRC)
- IF(IRC.EQ.-1) THEN
- JCONT = 1
- IF(ITIME.EQ.1.AND.IDEBFA.GE.0.AND.IOPTI+IOPTX.GT.0) THEN
- PRINT 9001,MAXFIL
- PRINT 9002,MAXFIL
- 9001 FORMAT(' FALS. directory contains more than ',I5,' entries.')
- 9002 FORMAT(' FALS. files will be processed in batches of ',I5,
- + ' (for options I/X etc.)')
- ICONT = 1
- ENDIF
- ELSE
- JCONT = 0
- ENDIF
-
- OLDNAM = ' '
- LOLD = 1
-
- IF(NFOUND.GT.0.AND.(IOPTI.NE.0.OR.IOPTX.NE.0)) THEN
- IF(IDEBFA.EQ.3) PRINT *,'FALS. sorting file names...'
- CALL FMSORT(FILES,KEYS,NFOUND,JSORT,IC)
- ENDIF
- IWIDTH = 0
- JWIDTH = 78
- IF(IOPTV.NE.0) JWIDTH = 132
- DO 30 I=1,NFOUND
- IF((IOPTI.NE.0).OR.(IOPTX.NE.0)) THEN
- J = JSORT(I)
- ELSE
- J = I
- ENDIF
- GENAM = FILES(J)
- LFILE = LENOCC(GENAM)
- IF(IDEBFA.GE.3) PRINT *,'FALS. GENAM = ',GENAM(1:LFILE)
- IF(IDEBFA.GE.3) PRINT *,'FALS. OLDNAM = ',OLDNAM(1:LOLD)
- IF(IOPTX.NE.0) THEN
- IF(GENAM.EQ.OLDNAM) GOTO 30
- ENDIF
- ISLASH = INDEXB(OLDNAM(1:LOLD),'/')
- JSLASH = INDEXB(GENAM(1:LFILE),'/')
- FNAME = GENAM(JSLASH+1:LFILE)
- LF = LENOCC(FNAME)
-*
-* Fast check: CHFILE = '*'
-*
- IF(CHFILE(1:LCHF).EQ.'*') THEN
- IMAT = 0
- ELSE
- CALL FMATCH(FNAME(1:LF),CHFILE(1:LCHF),IMAT)
- ENDIF
- IF(IMAT.NE.0) GOTO 30
-*
-* Check that keys match those selected
-* Location code:
-*
- IF(NUMLOC.GT.0) THEN
- IF(IUCOMP(KEYS(MKLCFA,J),MFMLOC,NUMLOC).EQ.0) THEN
- IF(IDEBFA.GE.3) PRINT *,'FALS. candidate # ',J, ' fails '
- + //'location code check'
- GOTO 30
- ENDIF
- ENDIF
-*
-* Copy level:
-*
- IF(NUMCPL.GT.0) THEN
- IF(IUCOMP(KEYS(MKCLFA,J),MFMCPL,NUMCPL).EQ.0) THEN
- IF(IDEBFA.GE.3) PRINT *,'FALS. candidate # ',J, ' fails '
- + //'copy level check'
- GOTO 30
- ENDIF
- ENDIF
-*
-* Media type:
-*
- IF(NUMMTP.GT.0) THEN
- IF(IUCOMP(KEYS(MKMTFA,J),MFMMTP,NUMMTP).EQ.0) THEN
- IF(IDEBFA.GE.3) PRINT *,'FALS. candidate # ',J, ' fails '
- + //'media type check'
- GOTO 30
- ENDIF
- ENDIF
-
- NFILES = NFILES + 1
- LBANK=0
- IF(IOPTX.NE.0) THEN
-*
-* Option X - display each entry only once
-* Display entry chosen by current selection unless not found
-*
- CALL UCOPY(KEYS(1,J),KEYSAV,10)
- CALL FMGET(GENAM,LBANK,KEYS(1,J),IC)
- IF(IC.NE.0) THEN
- IF(IDEBFA.GE.0) PRINT *,'FALS. ** Warning. ** ',
- + 'No match with current selection criteria for ',
- + FNAME(1:LF)
- CALL UCOPY(KEYSAV,KEYS(1,J),10)
- ENDIF
- LBANK=0
- ENDIF
- IF(IOPTW.NE.0.OR.IOPTV.NE.0) THEN
- IF(OLDNAM(1:JSLASH-1).NE.GENAM(1:ISLASH-1)) THEN
- IF(IWIDTH.GT.0) THEN
- WRITE(LWRITE,'(1X,A)') CARD(1:IWIDTH)
- IWIDTH = 0
- ENDIF
- IF(ICONT.EQ.0) THEN
- IF(ITIME.EQ.1) THEN
- WRITE(LWRITE,*)
- WRITE(LWRITE,9003) GENAM(1:JSLASH-1)
- WRITE(LWRITE,*)
- ENDIF
- ELSE
- WRITE(LWRITE,*)
- WRITE(LWRITE,9004) GENAM(1:JSLASH-1),ITIME
- WRITE(LWRITE,*)
- ENDIF
- 9003 FORMAT(' Directory :',A)
- 9004 FORMAT(' Directory :',A,' Batch :',I3)
- ENDIF
-*
-* Just display file names across the terminal...
-*
- IF(IWIDTH+LF.GE.JWIDTH) THEN
-* flush current buffer
- WRITE(LWRITE,'(1X,A)') CARD(1:IWIDTH)
- IWIDTH = 0
- ENDIF
- IF(IWIDTH.EQ.0) THEN
- CARD = FNAME(1:LF) // ' '
- ELSE
- CARD = CARD(1:IWIDTH) // FNAME(1:LF) // ' '
- ENDIF
- IWIDTH = IWIDTH + LF + 1
- ELSEIF(ISHOW.EQ.0) THEN
- IF(IOPTG.NE.0) THEN
- WRITE(LWRITE,9005) GENAM(1:LFILE)
- 9005 FORMAT(' Generic filename: ',A)
- ELSEIF(IOPTD.NE.0) THEN
- WRITE(LWRITE,9006) GENAM(1:LFILE),KEYS(1,J)
- 9006 FORMAT(' rm ',A,1X,I10)
- ELSEIF(IOPTK.NE.0) THEN
- WRITE(LWRITE,9007) (KEYS(K,J),K=1,LKEYFA-1)
- 9007 FORMAT(' Key serial number = ',I6,' filename = ',5A4,
- +' data repr. = ',I3,' media type = ',I2,' location code = ',I6)
- ELSE
- WRITE(LWRITE,9008) FNAME(1:LF)
- 9008 FORMAT(' ',A)
- ENDIF
-
- ELSE
-
- IF(IOPTB+IOPTE+IOPTG+JSHOW.EQ.0) THEN
- WRITE(LWRITE,*)
- WRITE(LWRITE,*) 'Directory: ',CHPATH(1:LPATH)
- WRITE(LWRITE,*)
- ENDIF
-
- JSHOW = 1
- CALL FMSHOW(GENAM,LBANK,KEYS(1,J),CHOPT,IRC)
- CALL MZDROP(IXSTOR,LBANK,' ')
- LBANK = 0
- ENDIF
- OLDNAM = GENAM
- LOLD = LFILE
- 30 CONTINUE
- IF((IOPTW.NE.0.OR.IOPTV.NE.0).AND.IWIDTH.GT.0)
- + WRITE(LWRITE,'(1X,A)') CARD(1:IWIDTH)
-
- IF(JCONT.NE.0) GOTO 20
-
- IF (IDEBFA.GE.-2) THEN
- IF(JSHOW.NE.0) THEN
- WRITE(LWRITE,*)
- WRITE(LWRITE,9009) NFILES
- 9009 FORMAT(' Files:',I5)
- ELSE
- IF(IDEBFA.GE.1) THEN
- WRITE(LWRITE,*)
- WRITE(LWRITE,*) 'No files found in directory: ',
- + CHPATH(1:LPATH)
- ENDIF
- ENDIF
- ENDIF
-
- NFILT = NFILT + NFILES
-
- END
diff --git a/src/packlib/fatmen/fatutil/famodu.F b/src/packlib/fatmen/fatutil/famodu.F
deleted file mode 100644
index 4027c8e..0000000
--- a/src/packlib/fatmen/fatutil/famodu.F
+++ /dev/null
@@ -1,101 +0,0 @@
-*
-* $Id: famodu.F,v 1.1.1.1 1996/03/07 15:18:06 mclareni Exp $
-*
-* $Log: famodu.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:06 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FAMODU(PATH,IRC)
- CHARACTER*(*) PATH
- CHARACTER*255 CHPATH
- PARAMETER (MAXFIL=100)
- PARAMETER (LKEYFA=10)
- DIMENSION KEYS(LKEYFA,MAXFIL)
- CHARACTER*255 FILES(MAXFIL),GENAM
- CHARACTER*20 FNAME
-#include "fatmen/fatpara.inc"
-#include "fatmen/fatloc.inc"
-#include "fatmen/fatmtp.inc"
-#include "fatmen/fatcpl.inc"
-#include "fatmen/fatsys.inc"
-#include "fatmen/fatout.inc"
-#include "fatmen/fatsho.inc"
-#include "fatmen/fatbank.inc"
-#include "fatmen/famucm.inc"
-#include "fatmen/fatinit.inc"
-*
- IRC = 0
- LPATH = LENOCC(PATH)
- LF = LENOCC(CHFILE)
- CHPATH = PATH(1:LPATH)
-
- IF(IDEBFA.GE.2) PRINT *,'FAMODU. enter for ',PATH(1:LPATH),
- + ' match = ',CHFILE(1:LF)
-
- JCONT = 0
- 1 CONTINUE
-*
- CALL FMFILS(CHPATH(1:LPATH)//'/'//CHFILE(1:LF),
- + FILES,KEYS,NFOUND,MAXFIL,JCONT,IRC)
- IF(IRC.EQ.-1) THEN
- JCONT = 1
- ELSE
- JCONT = 0
- ENDIF
-
- DO 200 I=1,NFOUND
- GENAM = FILES(I)
- LFILE = LENOCC(GENAM)
- JSLASH = INDEXB(GENAM(1:LFILE),'/')
- FNAME = GENAM(JSLASH+1:LFILE)
- LF = LENOCC(FNAME)
- CALL FMATCH(FNAME(1:LF),CHFILE(1:LF),IMAT)
- IF(IMAT.NE.0) GOTO 200
-*
-* Check that keys match those selected
-* Location code:
-*
- IF(NUMLOC.GT.0) THEN
- IF(IUCOMP(KEYS(MKLCFA,I),MFMLOC,NUMLOC).EQ.0) THEN
- IF(IDEBFA.GE.3) PRINT *,'FAMODU. candidate # ',I,
- + ' fails location code check'
- GOTO 200
- ENDIF
- ENDIF
-*
-* Copy level:
-*
- IF(NUMCPL.GT.0) THEN
- IF(IUCOMP(KEYS(MKCLFA,I),MFMCPL,NUMCPL).EQ.0) THEN
- IF(IDEBFA.GE.3) PRINT *,'FAMODU. candidate # ',I,
- + ' fails copy level check'
- GOTO 200
- ENDIF
- ENDIF
-*
-* Media type:
-*
- IF(NUMMTP.GT.0) THEN
- IF(IUCOMP(KEYS(MKMTFA,I),MFMMTP,NUMMTP).EQ.0) THEN
- IF(IDEBFA.GE.3) PRINT *,'FAMODU. candidate # ',I,
- + ' fails media type check'
- GOTO 200
- ENDIF
- ENDIF
-
- LBANK=0
- CALL FMGETK(GENAM,LBANK,KEYS(1,I),IRC)
- IF(IRC.EQ.0) THEN
- IF(IOPTF.NE.0) CALL FMPUTC(LBANK,CHUFRM,MFUTFA,NFUTFA,IRC)
- IF(IOPTW.NE.0) CALL FMPUTV(LBANK,IWORDS,MUSWFA,NUSWFA,IRC)
- IF(IOPTC.NE.0) CALL FMPUTC(LBANK,CHUCOM,MUSCFA,NUSCFA,IRC)
- CALL FMMOD(GENAM,LBANK,0,IRC)
- CALL MZDROP(IXSTOR,LBANK,' ')
- LBANK = 0
- ENDIF
- 200 CONTINUE
-
- RETURN
- END
diff --git a/src/packlib/fatmen/fatutil/fantrc.F b/src/packlib/fatmen/fatutil/fantrc.F
deleted file mode 100644
index 7bc391a..0000000
--- a/src/packlib/fatmen/fatutil/fantrc.F
+++ /dev/null
@@ -1,139 +0,0 @@
-*
-* $Id: fantrc.F,v 1.1.1.1 1996/03/07 15:18:07 mclareni Exp $
-*
-* $Log: fantrc.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:07 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FANTRC(LUN,CHHOST,CHUSER,CHPASS,CHOPT,IRC)
-*
-* Check out .netrc file
-*
- CHARACTER*(*) CHHOST,CHUSER,CHPASS
- CHARACTER*255 CHFILE,CHBACK
- CHARACTER*20 CHGRP, FMGRP, FMHST, USER
- CHARACTER*80 LINE
- LOGICAL IEXIST
-#if defined(CERNLIB_UNIX)
- INTEGER SYSTEMF
-#endif
-#include "fatmen/slate.inc"
-#include "fatmen/fatbug.inc"
-#include "fatmen/fatopts.inc"
-*
-* The .netrc file is in SYS$LOGIN:FTPLOGIN.; (VMS)
-* userid.PER.NETRC (MVS)
-* $HOME/.netrc (Unix)
-* DOT NETRC A0 (VM)
-*
-
- LUSER = LENOCC(CHUSER)
- FMGRP = CHUSER(1:LUSER)
- CALL CUTOL(FMGRP(1:LUSER))
-
- LHOST = LENOCC(CHHOST)
- FMHST = CHHOST(1:LHOST)
- CALL CUTOL(FMHST(1:LHOST))
-
-#if defined(CERNLIB_IBMMVS)
- CALL KPREFI(USER,LUSER)
- CHFILE = '/'//USER(1:LUSER) // '.PER.NETRC'
-#endif
-#if defined(CERNLIB_IBMVM)
- CHFILE = '/DOT NETRC A0'
-#endif
-#if defined(CERNLIB_VAXVMS)
- CHFILE = 'SYS$LOGIN:FTPLOGIN.;'
-#endif
-#if defined(CERNLIB_UNIX)
- CALL GETENVF('HOME',CHFILE)
- CHFILE(IS(1)+1:IS(1)+7) = '/.netrc'
-#endif
- LFILE = LENOCC(CHFILE)
-*
-* Does file exist?
-*
- INQUIRE(FILE=CHFILE(1:LFILE),EXIST=IEXIST)
- IF(.NOT.IEXIST) THEN
- PRINT *,'FANTRC. netrc file (',CHFILE(1:LFILE),
- + ') does not exist'
- IRC = 28
- ENDIF
-*
-* Open the file and look for HOST
-*
- OPEN(LUN,FILE=CHFILE(1:LFILE),FORM='FORMATTED',
-#if defined(CERNLIB_IBMVM)||defined(CERNLIB_IBMMVS)
- + ACTION='READ',
-#endif
-#if defined(CERNLIB_VAXVMS)
- + READONLY,
-#endif
- + ACCESS='SEQUENTIAL',STATUS='OLD',IOSTAT=IRC)
- IF(IRC.NE.0) THEN
- PRINT *,'FANTRC. cannot open netrc file ',CHFILE(1:LFILE)
- RETURN
- ENDIF
-*
-* Code for not found
-*
- IRC = 4
-
- 10 CONTINUE
- READ(LUN,'(A)',END=20) LINE
- CALL CUTOL(LINE)
- IF(INDEX(LINE,FMHST(1:LHOST)).NE.0) THEN
- IRC = 0
- GOTO 30
- ENDIF
- GOTO 10
-
- 20 CONTINUE
- CLOSE(LUN)
- PRINT *,'FANTRC. .netrc file not setup for use with ', FMHST(1:
- +LHOST)
- GOTO 40
- 30 CONTINUE
-*
-* Found a 'host' line
-*
- LLINE = LENOCC(LINE)
- CALL CSQMBL(LINE,1,LLINE)
- LLINE = IS(1)
-#if defined(CERNLIB_VAXVMS)
-*
-* Syntax: host user password
-*
- LBLANK = INDEX(LINE,' ')
- JBLANK = INDEXB(LINE(1:LLINE),' ')
- CHGRP = LINE(LBLANK+1:JBLANK-1)
- CHPASS = LINE(JBLANK+1:LLINE)
- LGRP = JBLANK - LBLANK - 1
-#endif
-#if !defined(CERNLIB_VAXVMS)
-*
-* Syntax: machine host login username password password
-*
- LBLANK = INDEX(LINE,' login ') + 7
- KBLANK = INDEX(LINE,' password ') -1
- JBLANK = INDEXB(LINE(1:LLINE),' ')
- CHGRP = LINE(LBLANK:KBLANK)
- CHPASS = LINE(JBLANK+1:LLINE)
- LGRP = KBLANK - LBLANK + 1
-#endif
-
- 40 CONTINUE
-*
-* Check if user name matches
-*
- IF(FMGRP(1:LUSER).NE.CHGRP(1:LGRP)) THEN
- IRC = -1
- IF(IDEBFA.GE.-3) PRINT *,'FANTRC. username in netrc file ('//
- + CHGRP(1:LGRP)//') does not match the FATMEN group ('//
- + FMGRP(1:LUSER)//')'
- ENDIF
-
- END
-
diff --git a/src/packlib/fatmen/fatutil/faopen.F b/src/packlib/fatmen/fatutil/faopen.F
deleted file mode 100644
index 3872d8a..0000000
--- a/src/packlib/fatmen/fatutil/faopen.F
+++ /dev/null
@@ -1,161 +0,0 @@
-*
-* $Id: faopen.F,v 1.1.1.1 1996/03/07 15:18:05 mclareni Exp $
-*
-* $Log: faopen.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:05 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FAOPEN (TYPE, LUN, CHOPT, NAME, LRECL, MEXTN)
-*
-************************************************************************
-*
-* SUBR. UTOPEN (TYPE, LUN, CHOPT, NAME, LRECL, MEXTN)
-*
-* Decodes the File name and does the Fortran OPEN
-*
-* TYPE IOPA type, e.g. SAVG,GETX...
-* LUN logical unit number
-* CHOPT Character Option for RZOPEN
-* NAME File name
-* LRECL Record length
-* MEXTN Number of records in file (relevant for mode R on IBM)
-* (default 5000)
-*
-*
-************************************************************************
-*
-#include "fatmen/fatbank.inc"
-#include "fatmen/fatsys.inc"
-*
- DIMENSION IOPT(8)
- CHARACTER LFNAM*255
- CHARACTER TYPE*(*), CHOPT*(*), NAME*(*), STATE*8
- CHARACTER FORMT*12
- EQUIVALENCE (IOPTA, IOPT(1)), (IOPTF, IOPT(2))
- + , (IOPTO, IOPT(3)), (IOPTR, IOPT(4))
- + , (IOPTX, IOPT(5)), (IOPTP, IOPT(6))
- + , (IOPTN, IOPT(7)), (IOPTZ, IOPT(8))
-*
-#if defined(CERNLIB_IBMVM)
- CHARACTER FILE*96
-#endif
- LOGICAL OPEN
- LDEF = LENOCC(DEFAULT)
-#if defined(CERNLIB_CSPACK)
- IF(FATNOD.NE.' ') THEN
- IF(LDEF.GT.0) THEN
- LFNAM = DEFAULT(1:LDEF) // '/' // NAME(1:LENOCC(NAME))
- ELSE
- LFNAM = NAME(1:LENOCC(NAME))
- ENDIF
-
- LCH = LENOCC(LFNAM)
- NAME = LFNAM
-
- ELSE
-#endif
-#if defined(CERNLIB_VAXVMS)
-*
-* File name is in default directory of server
-*
- LFNAM = DEFAULT(1:LDEF) // NAME(1:LENOCC(NAME))
- LCH = LENOCC(LFNAM)
- NAME = LFNAM
-#endif
-#if defined(CERNLIB_UNIX)
-*
-* File name is in default directory of server
-*
- IF(LDEF.GT.0) THEN
- LFNAM = DEFAULT(1:LDEF) // '/' // NAME(1:LENOCC(NAME))
- ELSE
- LFNAM = NAME(1:LENOCC(NAME))
- ENDIF
-
- LCH = LENOCC(LFNAM)
- NAME = LFNAM
-#endif
-#if defined(CERNLIB_IBMVM)
-*
-* Allow RZ file to be on any disk
-*
- LCH = LENOCC(NAME)
- CALL CTRANS('.',' ',NAME,1,LCH)
- IF(INDEX(CHOPT,'N').NE.0) THEN
- LFNAM = NAME(1:LCH) // ' A6'
- LCH = LCH + 3
- ELSEIF(INDEX(NAME(1:LCH),' ').EQ.INDEXB(NAME(1:LCH),' '))
- + THEN
- LFNAM = NAME(1:LCH)//' *'
- LCH = LCH + 2
- ENDIF
-#endif
-#if defined(CERNLIB_IBMMVS)
- LFNAM = '.'//DEFAULT(1:LDEF)//'.'//NAME
- LCH = LENOCC(LFNAM)
-#endif
-#if defined(CERNLIB_CSPACK)
- ENDIF
-#endif
- IF(INDEX(CHOPT,'N').NE.0) THEN
- LRECL = 1024
- ELSE
- LRECL = 0
- ENDIF
-
-#if defined(CERNLIB_CSPACK)
- IF(FATNOD.EQ.' ') THEN
-#endif
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9001) LFNAM(1:LCH),CHOPT,LRECL
- 9001 FORMAT(' FAOPEN. calling RZOPEN for file ',A,' CHOPT ',A,
- + ' LRECL ',I6)
-*
-* Check that file is not already open. Close if this is the case
-*
- INQUIRE(LUN,OPENED=OPEN)
- IF(OPEN) THEN
- IF(IDEBFA.GE.1) WRITE(LPRTFA,9002) LUN
- 9002 FORMAT(' FAOPEN. file already open on ',I3,
- + ' - closing before call to RZOPEN')
- CLOSE(LUN)
- ENDIF
-
- CALL RZOPEN(LUN,TOPDIR(1:LENOCC(TOPDIR)), LFNAM(1:LCH),CHOPT,
- + LRECL,ISTAT)
- IF((ISTAT.NE.0).OR.(IDEBFA.GE.2)) WRITE(LPRTFA,9003) LRECL,
- + ISTAT
- 9003 FORMAT(' FAOPEN. return from RZOPEN with LRECL = ',I6,
- + ' ISTAT = ',I6)
-#if defined(CERNLIB_CSPACK)
- ELSE
- LFATND = LENOCC(FATNOD)
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9004) LFNAM(1:LCH),CHOPT,LRECL,
- + FATNOD(1:LFATND)
- 9004 FORMAT(' FAOPEN. calling XZRZOP for file ',A,' CHOPT ',A,
- + ' LRECL ',I6,' node ',A)
- CALL XZRZOP(LUN,FATNOD(1:LFATND),LFNAM(1:LCH),
- + CHOPT,LRECL,ISTAT)
- IF((ISTAT.NE.0).OR.(IDEBFA.GE.2)) WRITE(LPRTFA,9005) LRECL,
- + ISTAT
- 9005 FORMAT(' FAOPEN. return from XZRZOP with LRECL = ',I6,
- + ' ISTAT = ',I6)
- ENDIF
-#endif
- IFMODX = IQUEST(12)
- IF(ISTAT.NE.0) THEN
- PRINT *,'FAOPEN. stopping due to fatal error opening RZ file'
- STOP 16
- ENDIF
-*
-* Exchange mode flag
-*
-#if !defined(CERNLIB_UNIX)
- IFMODX = IQUEST(12)
-#endif
-#if defined(CERNLIB_UNIX)
- IFMODX = 1
-#endif
- END
-
diff --git a/src/packlib/fatmen/fatutil/faseac.F b/src/packlib/fatmen/fatutil/faseac.F
deleted file mode 100644
index a3decb1..0000000
--- a/src/packlib/fatmen/fatutil/faseac.F
+++ /dev/null
@@ -1,270 +0,0 @@
-*
-* $Id: faseac.F,v 1.1.1.1 1996/03/07 15:18:06 mclareni Exp $
-*
-* $Log: faseac.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:06 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FASEAC(PATH,IRC)
- CHARACTER*(*) PATH
- CHARACTER*255 CHPATH
- PARAMETER (MAXFIL=1000)
- PARAMETER (LKEYFA=10)
- DIMENSION KEYS(LKEYFA,MAXFIL),JSORT(MAXFIL)
- DIMENSION KEYSAV(LKEYFA)
- CHARACTER*255 FILES,GENAM,OLDNAM,
- + CWD,OLDWD
- CHARACTER*20 FNAME
-#include "fatmen/fatsea.inc"
-#include "fatmen/fatpara.inc"
-#include "fatmen/fatloc.inc"
-#include "fatmen/fatmtp.inc"
-#include "fatmen/fatcpl.inc"
-#include "fatmen/fatsys.inc"
-#include "fatmen/fatout.inc"
- CHARACTER*36 CHOPT
-#include "fatmen/fatbank.inc"
- COMMON /MYWKSP/ FILES(MAXFIL)
- CHARACTER*132 CARD
- INTEGER FMISET
-#include "fatmen/fasecm.inc"
-*
- LPATH = LENOCC(PATH)
- LF = LENOCC(CHFILE)
- CHPATH = PATH(1:LPATH)
- OLDWD = ' '
- LOLDWD = 1
- IRC = 0
- JFILES = 0
- JCONT = 0
- NDIRS = NDIRS + 1
-*
-* Reconstruct character option
-*
- LCH = 0
- CHOPT = ' '
-
- DO 10 J=1,36
- IF(IOPT(J).NE.0) THEN
- LCH = LCH + 1
- CHOPT(LCH:LCH) = ALFNUM(J:J)
- ENDIF
- 10 CONTINUE
-*
-* Do we need to call FMSHOW?
-*
- IF(LCH.EQ.0) THEN
- LCH = 1
- ISHOW = 0
- ELSE
- ISHOW = FMISET(CHOPT(1:LCH),'DGK')
- ENDIF
-*
-* Now check for selection on user words
-*
- IUWORD = 0
- DO 20 I=1,10
- IF(IUSER(1,I).EQ.-1) GOTO 20
- IUWORD = I
- GOTO 30
- 20 CONTINUE
- 30 CONTINUE
-*
-* Look for some files and show the bank and key content:
-*
- IF(IDEBFA.GE.2) PRINT *,'FASEAC. enter for ',PATH(1:LPATH),
- + CHOPT
- IF(IDEBFA.GE.0)
- + PRINT *,'Searching directory: ',PATH(1:LPATH)
- IF((IDEBFA.GE.0).AND.(LWRITE.NE.LPRTFA).AND.IOPTD.EQ.0)
- + WRITE(LWRITE,*) 'Directory: ',PATH(1:LPATH)
- 40 CONTINUE
- CALL FMFILS(CHPATH(1:LPATH)//'/'//CHFILE(1:LF),
- + FILES,KEYS,NFOUND,MAXFIL,JCONT,IRC)
- IF(IDEBFA.GE.2) PRINT *,'FASEAC. found ',NFOUND,
- + ' files in FMFILS'
- IF(IRC.EQ.-1) THEN
- JCONT = 1
- ELSE
- JCONT = 0
- ENDIF
-
- OLDNAM = ' '
- LOLD = 1
- IF(IOPTI.NE.0) THEN
- IF(IDEBFA.EQ.3) PRINT *,'FASEAC. sorting file names...'
- CALL FMSORT(FILES,KEYS,NFOUND,JSORT,IC)
- ENDIF
- IWIDTH = 0
- JWIDTH = 78
- IF(IOPTV.NE.0) JWIDTH = 132
- DO 50 I=1,NFOUND
- IF(IOPTI.NE.0) THEN
- J = JSORT(I)
- ELSE
- J = I
- ENDIF
- GENAM = FILES(J)
- LFILE = LENOCC(GENAM)
- IF(IOPTX.NE.0) THEN
- IF(IDEBFA.GE.3) PRINT *,'FASEAC. GENAM = ',GENAM(1:LFILE)
- IF(IDEBFA.GE.3) PRINT *,'FASEAC. OLDNAM = ',OLDNAM(1:LOLD)
- IF(GENAM.EQ.OLDNAM) GOTO 50
- ENDIF
- ISLASH = INDEXB(OLDNAM(1:LOLD),'/')
- JSLASH = INDEXB(GENAM(1:LFILE),'/')
- FNAME = GENAM(JSLASH+1:LFILE)
- LFNAME = LENOCC(FNAME)
-
- CALL FMATCH(FNAME(1:LFNAME),CHFILE(1:LF),IMAT)
- IF(IMAT.NE.0) GOTO 50
-*
-* Check that keys match those selected
-* Location code:
-*
- IF(NUMLOC.GT.0) THEN
- IF(IUCOMP(KEYS(MKLCFA,J),MFMLOC,NUMLOC).EQ.0) THEN
- IF(IDEBFA.GE.3) PRINT *,'FASEAC. candidate # ',J,
- + ' fails location code check'
- GOTO 50
- ENDIF
- ENDIF
-*
-* Copy level:
-*
- IF(NUMCPL.GT.0) THEN
- IF(IUCOMP(KEYS(MKCLFA,J),MFMCPL,NUMCPL).EQ.0) THEN
- IF(IDEBFA.GE.3) PRINT *,'FASEAC. candidate # ',J,
- + ' fails copy level check'
- GOTO 50
- ENDIF
- ENDIF
-*
-* Media type:
-*
- IF(NUMMTP.GT.0) THEN
- IF(IUCOMP(KEYS(MKMTFA,J),MFMMTP,NUMMTP).EQ.0) THEN
- IF(IDEBFA.GE.3) PRINT *,'FASEAC. candidate # ',J,
- + ' fails media type check'
- GOTO 50
- ENDIF
- ENDIF
-
- LBANK=0
- IF(IOPTX.NE.0) THEN
-*
-* Option X - display each entry only once
-* Display entry chosen by current selection unless not found
-*
- CALL UCOPY(KEYS(1,J),KEYSAV,10)
- CALL FMGET(GENAM,LBANK,KEYS(1,J),IC)
- IF(IC.NE.0) THEN
- IF(IDEBFA.GE.0) PRINT *,'FASEAC. ** Warning. ** ',
- + 'No match with current selection criteria for ',
- + FNAME(1:LFNAME)
- CALL UCOPY(KEYSAV,KEYS(1,J),10)
- ENDIF
- LBANK=0
- ENDIF
-* Do we have to search the catalogue entry?
-*
- LBANK = 0
- IDTIME = 0
- IF(IDCATA.GE.0.OR.IDCREA.GE.0.OR.IDLAST.GE.0) IDTIME = 1
- IF(LDSN+LHOST+LVID+LUSER+LFORM+LCOMM+IUWORD+IDTIME.GT.0) THEN
-*
-* Now check if this entry matches
-*
- CALL FMSEAR(GENAM,LBANK,KEYS(1,J),DSN,HOST,VID, USER,UFORM,
- + COMM,IRET)
- IF(IRET.NE.0) THEN
- CALL MZDROP(IXSTOR,LBANK,' ')
- LBANK = 0
- GOTO 50
- ENDIF
- ENDIF
- NFILES = NFILES + 1
- JFILES = JFILES + 1
-
- IF(IOPTW.NE.0.OR.IOPTV.NE.0) THEN
- IF(OLDNAM(1:JSLASH-1).NE.GENAM(1:ISLASH-1)) THEN
- IF(IWIDTH.GT.0) THEN
- WRITE(LWRITE,'(1X,A)') CARD(1:IWIDTH)
- IWIDTH = 0
- ENDIF
- WRITE(LWRITE,*)
- WRITE(LWRITE,9001) GENAM(1:JSLASH-1)
- WRITE(LWRITE,*)
- 9001 FORMAT(' Directory :',A)
- ENDIF
-*
-* Just display file names across the terminal...
-*
- IF(IWIDTH+LF.GE.JWIDTH) THEN
-* flush current buffer
- WRITE(LWRITE,'(1X,A)') CARD(1:IWIDTH)
- IWIDTH = 0
- ENDIF
- IF(IWIDTH.EQ.0) THEN
- CARD = FNAME(1:LFNAME) // ' '
- ELSE
- CARD = CARD(1:IWIDTH) // FNAME(1:LFNAME) // ' '
- ENDIF
- IWIDTH = IWIDTH + LF + 1
- ELSEIF(ISHOW.EQ.0) THEN
- IF(IOPTG.NE.0) THEN
- WRITE(LWRITE,9002) GENAM(1:LFILE)
- 9002 FORMAT(' Generic filename: ',A)
- ELSEIF(IOPTD.NE.0) THEN
- WRITE(LWRITE,9003) GENAM(1:LFILE),KEYS(1,J)
- 9003 FORMAT(' rm ',A,1X,I10)
- ELSEIF(IOPTK.NE.0) THEN
- WRITE(LWRITE,9004) (KEYS(K,J),K=1,LKEYFA-1)
- 9004 FORMAT(' Key serial number = ',I6,' filename = ',5A4,
- +' data repr. = ',I3,' media type = ',I2,' location code = ',I6)
- ELSE
- WRITE(LWRITE,9005) FNAME(1:LFNAME)
- 9005 FORMAT(' ',A)
- ENDIF
- ELSE
- CALL FMSHOW(GENAM,LBANK,KEYS(1,J),CHOPT(1:LCH),IRC)
- CALL MZDROP(IXSTOR,LBANK,' ')
- LBANK = 0
- ENDIF
- OLDNAM = GENAM
- LOLD = LFILE
- IF((NFILES.EQ.NMATCH).AND.(NMATCH.NE.0)) THEN
- IF(IOPTW.NE.0.OR.IOPTV.NE.0)
- + WRITE(LWRITE,'(1X,A)') CARD(1:IWIDTH)
- IF(IDEBFA.GE.-3) PRINT *,'FASEAC. stopping after ',
- + NFILES,' matches'
- IRC = NFILES
- GOTO 60
- ENDIF
- 50 CONTINUE
- IF((IOPTW.NE.0.OR.IOPTV.NE.0).AND.IWIDTH.GT.0)
- + WRITE(LWRITE,'(1X,A)') CARD(1:IWIDTH)
-
- IF(JCONT.NE.0) GOTO 40
-
- 60 CONTINUE
-
- IF(IOPTD.NE.0) THEN
- WRITE(LPRTFA,*) JFILES,' candidates for deletion'
- ELSE
- IF(IDEBFA.GE.0) THEN
-
- WRITE(LWRITE,'(A)') ' '
- IF(JFILES .EQ. 0) THEN
- WRITE(LWRITE,9006)
- 9006 FORMAT(' No matches found')
- ELSE
- WRITE(LWRITE,9007) JFILES
- 9007 FORMAT(' Matches:',I5)
- ENDIF
- ENDIF
- ENDIF
-
- END
diff --git a/src/packlib/fatmen/fatutil/fasear.F b/src/packlib/fatmen/fatutil/fasear.F
deleted file mode 100644
index c956789..0000000
--- a/src/packlib/fatmen/fatutil/fasear.F
+++ /dev/null
@@ -1,190 +0,0 @@
-*
-* $Id: fasear.F,v 1.1.1.1 1996/03/07 15:18:07 mclareni Exp $
-*
-* $Log: fasear.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:07 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FASEAR(PATH,KEYS,IRC)
- CHARACTER*(*) PATH
- PARAMETER (LKEYFA=10)
- DIMENSION KEYS(LKEYFA)
- CHARACTER*255 OLDNAM
- CHARACTER*20 FNAME
-#include "fatmen/facard.inc"
-#include "fatmen/fatsea.inc"
-#include "fatmen/fatpara.inc"
-#include "fatmen/fatloc.inc"
-#include "fatmen/fatmtp.inc"
-#include "fatmen/fatcpl.inc"
-#include "fatmen/fatsys.inc"
-#include "fatmen/fatout.inc"
- INTEGER FMISET
- CHARACTER*36 CHOPT
-#include "fatmen/fatbank.inc"
- SAVE JFILES
-#include "fatmen/fasecm.inc"
-*
- LPATH = LENOCC(PATH)
- ISLASH = INDEXB(PATH(1:LPATH),'/')
- FNAME = PATH(ISLASH+1:LPATH)
- LF = LPATH - ISLASH
- IRC = 0
-
- IF(NDIRS.EQ.0) THEN
- JSLASH = 1
- IWIDTH = 0
- ENDIF
-*
-* Reconstruct character option
-*
- LCH = 0
- CHOPT = ' '
-
- DO 10 J=1,36
- IF(IOPT(J).NE.0) THEN
- LCH = LCH + 1
- CHOPT(LCH:LCH) = ALFNUM(J:J)
- ENDIF
- 10 CONTINUE
-*
-* Do we need to call FMSHOW?
-*
- IF(LCH.EQ.0) THEN
- LCH = 1
- ISHOW = 0
- ELSE
- ISHOW = FMISET(CHOPT(1:LCH),'DGK')
- ENDIF
-*
-* Now check for selection on user words
-*
- IUWORD = 0
- DO 20 I=1,10
- IF(IUSER(1,I).EQ.-1) GOTO 20
- IUWORD = I
- GOTO 30
- 20 CONTINUE
- 30 CONTINUE
-
- JWIDTH = 78
- IF(IOPTV.NE.0) JWIDTH = 132
-*
-* Look for some files and show the bank and key content:
-*
- IF(IDEBFA.GE.2) PRINT *,'FASEAR. enter for ',PATH(1:LPATH),
- + CHOPT
-*
-* Do we have to search the catalogue entry?
-*
- LBANK = 0
- IDTIME = 0
- IF(IDCATA.GE.0.OR.IDLAST.GE.0.OR.IDCREA.GE.0) IDTIME = 1
- IF(LDSN+LHOST+LVID+LUSER+LFORM+LCOMM+IUWORD+IDTIME.GT.0) THEN
-*
-* Now check if this entry matches
-*
- CALL FMSEAR(PATH,LBANK,KEYS,DSN,HOST,VID, USER,UFORM,COMM,
- + IRET)
- IF(IRET.NE.0) THEN
- CALL MZDROP(IXSTOR,LBANK,' ')
- LBANK = 0
- GOTO 40
- ENDIF
-
- ENDIF
-
- IF(OLDNAM(1:JSLASH-1).NE.PATH(1:ISLASH-1)) THEN
- IF(NDIRS.GT.0) THEN
- IF(IOPTW.NE.0.OR.IOPTV.NE.0) THEN
- WRITE(LWRITE,'(1X,A)') CARD(1:IWIDTH)
- IWIDTH = 0
- ENDIF
- IF(IOPTD.NE.0) THEN
- WRITE(LPRTFA,*) JFILES,' candidates for deletion'
- ELSE
- IF(IDEBFA.GE.0) THEN
-
- WRITE(LWRITE,'(A)') ' '
- IF(JFILES .EQ. 0) THEN
- WRITE(LWRITE,9001)
- 9001 FORMAT(' No matches found')
- ELSE
- WRITE(LWRITE,9002) JFILES
- 9002 FORMAT(' Matches:',I5)
- ENDIF
- ENDIF
- ENDIF
- ENDIF
- IF(IDEBFA.GE.0) THEN
- PRINT *
- PRINT *,'Searching directory: ', PATH(1:ISLASH-1)
- PRINT *
- ENDIF
- IF(IOPTW.NE.0.OR.IOPTV.NE.0) THEN
- WRITE(LWRITE,*)
- WRITE(LWRITE,9003) PATH(1:ISLASH-1)
- WRITE(LWRITE,*)
- 9003 FORMAT(' Directory :',A)
- ELSEIF(LWRITE.NE.LPRTFA.AND.IOPTD.EQ.0) THEN
- WRITE(LWRITE,*) 'Directory: ',PATH(1:ISLASH-1)
- ENDIF
- OLDNAM = PATH(1:ISLASH)
- JSLASH = ISLASH
- NDIRS = NDIRS + 1
- JFILES = 0
- ENDIF
-
- NFILES = NFILES + 1
- JFILES = JFILES + 1
-
- IF(IOPTW.NE.0.OR.IOPTV.NE.0) THEN
-*
-* Just display file names across the terminal...
-*
- IF(IWIDTH+LF.GE.JWIDTH) THEN
-* flush current buffer
- WRITE(LWRITE,'(1X,A)') CARD(1:IWIDTH)
- IWIDTH = 0
- ENDIF
- IF(IWIDTH.EQ.0) THEN
- CARD = FNAME(1:LF) // ' '
- ELSE
- CARD = CARD(1:IWIDTH) // FNAME(1:LF) // ' '
- ENDIF
- IWIDTH = IWIDTH + LF + 1
- ELSEIF(ISHOW.EQ.0) THEN
- IF(IOPTG.NE.0) THEN
- WRITE(LWRITE,9004) PATH(1:LPATH)
- 9004 FORMAT(' Generic filename: ',A)
- ELSEIF(IOPTD.NE.0) THEN
- WRITE(LWRITE,9005) PATH(1:LPATH),KEYS(1),CHSTR(1:LSTR)
- 9005 FORMAT(' rm ',A,1X,I10,1X,A)
- ELSEIF(IOPTK.NE.0) THEN
- WRITE(LWRITE,9006) (KEYS(I),I=1,LKEYFA-1)
- 9006 FORMAT(' Key serial number = ',I6,' filename = ',5A4,
- +' data repr. = ',I3,' media type = ',I2,' location code = ',I6)
- ELSE
- WRITE(LWRITE,9007) FNAME(1:LF)
- 9007 FORMAT(' ',A)
- ENDIF
- ELSE
- CALL FMSHOW(PATH,LBANK,KEYS,CHOPT(1:LCH),IRC)
- CALL MZDROP(IXSTOR,LBANK,' ')
- LBANK = 0
- ENDIF
- LOLD = LF
- IF((NFILES.EQ.NMATCH).AND.(NMATCH.NE.0)) THEN
- IF(IOPTW.NE.0.OR.IOPTV.NE.0)
- + WRITE(LWRITE,'(1X,A)') CARD(1:IWIDTH)
- IF(IDEBFA.GE.-3) PRINT *,'FASEAR. stopping after ', NFILES,' '
- + //'matches'
- IRC = NFILES
- RETURN
- ENDIF
- 40 CONTINUE
-
- END
-
diff --git a/src/packlib/fatmen/fatutil/faselp.F b/src/packlib/fatmen/fatutil/faselp.F
deleted file mode 100644
index 6d0a76d..0000000
--- a/src/packlib/fatmen/fatutil/faselp.F
+++ /dev/null
@@ -1,311 +0,0 @@
-*
-* $Id: faselp.F,v 1.1.1.1 1996/03/07 15:18:06 mclareni Exp $
-*
-* $Log: faselp.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:06 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FASELP(CHFILE,CHMTCH,IFILE,NFILES,NMATCH,IRC)
-*
-* This routine performs wild card file name matching
-* a la VM/CMS (FILELIST/LISTFILE) and VAX/VMS (DIRECTORY)
-* Thus: % corresponds to a single arbitrary character,
-* * corresponds to n (n>=0) arbitrary characters
-* Numeric ranges are also supported, thus (9:12) will
-* match strings 09,10,11,12.
-*
-#include "fatmen/fatbank.inc"
-#include "fatmen/farnge.inc"
-*
- COMMON /SLATE/ NDSLAT,NESLAT, DUMMY(38)
- CHARACTER*(*) CHFILE,CHMTCH
- CHARACTER*255 FILE,MATCH
- CHARACTER*10 CHLOW,CHHIGH,CHMAT,CHPASS,CHPLOW,CHPHI
- CHARACTER*5 WILD
- CHARACTER*27 HUNT
- SAVE CHPLOW,CHPHI,JMATCH
- DATA WILD/'%*(<>'/
- DATA HUNT/'ABCDEFGHIJKLMNOPQRSTUVWXYZ/'/
-
-*
-* Reset if this is a new call
-*
- IF(IFILE.EQ.1) THEN
- CHPLOW = '9999999999'
- CHPHI = ' '
- JFOUND = 0
- JMATCH = 0
- NMATCH = 0
- ENDIF
-
- ISTART = 0
- JSTART = 0
- IRC = 0
- IFOUND = 0
- JELEM = 0
- IEND = LENOCC(CHMTCH)
- JEND = LENOCC(CHFILE)
- MATCH = CHMTCH(1:IEND)
- FILE = CHFILE(1:JEND)
-*
- ISQ = INDEX(MATCH(1:IEND),'[')
- ILOW = INDEX(MATCH(1:IEND),'<')
- IHIGH = INDEX(MATCH(1:IEND),'>')
-*
-* Convert [] to ()
-*
- CALL CTRANS('[','(',MATCH,1,IEND)
- CALL CTRANS(']',')',MATCH,1,IEND)
- NLPAT = IQUEST(13) + 1
-*
-* Remove multiple *'s
-*
- NESLAT = IEND
- CALL CSQMCH(MATCH,'*',1,IEND)
- IF(NESLAT.LT.IEND) IEND = NESLAT
- IF(IDEBFA.GT.2) PRINT *,'FASELP. Compare ',MATCH(1:IEND),
- + ' against ',FILE(1:JEND),
- + ' (candidate # ',IFILE,' of ',NFILES,')'
-*
-* Process all characters in FILE
-*
-10 CONTINUE
-*
-* Have reached the end of both match and file and all is ok
-*
- IF((ISTART.EQ.IEND).AND.(JSTART.EQ.JEND)) GOTO 1
-
- ISTART = ISTART + 1
- JSTART = JSTART + 1
-*
-* Have processed all characters in MATCH and all compare
-*
- IF(ISTART.GT.IEND) THEN
-*
-* but FILE is longer than MATCH...
-*
- IF(ISTART.LE.JEND) IRC = 1
- GOTO 1
- ENDIF
-*
-* Look down MATCH for a * or %
-*
- IX = ICFMUL(WILD,MATCH,ISTART,IEND)
-*
-* Match any characters up until first wild card
-*
- IF(IX.GT.ISTART) THEN
- LWORD = IX-ISTART-1
- IF(FILE(JSTART:JSTART+LWORD).NE.MATCH(ISTART:ISTART+LWORD))
- + GOTO 99
- ISTART = ISTART + LWORD
- JSTART = JSTART + LWORD
- GOTO 10
- ENDIF
-
- IF(MATCH(IX:IX).EQ.'*') THEN
-*
-* Current character is a *
-* Find first non-wild character in MATCH and find
-* in FILE.
-*
- IF(IX.EQ.IEND) GOTO 1
- DO 20 I=ISTART+1,IEND
- IF((MATCH(I:I).NE.'*').AND.(MATCH(I:I).NE.'%') .AND.
- + (MATCH(I:I).NE.'(')) GOTO 30
-20 CONTINUE
-*
-* MATCH only contains * followed by other wild-cards - ok
-*
- IF(IDEBFA.GT.2)
- + PRINT *,'FASELP. Match pattern contains only wild-cards'
- GOTO 1
-30 CONTINUE
-*
-* Look for current word in FILE and reset JSTART
-* Word is delimited by two wild-chars or end of string.
-*
- IWILD = ICFMUL(WILD,MATCH,I,IEND)
- IF(IWILD.LE.IEND) THEN
- II = IWILD - 1
- ELSE
- II = IEND
- ENDIF
-* II = MIN(IEND,ICFMUL(WILD,MATCH,I,IEND))
- JFIND = INDEX(FILE(JSTART:JEND),MATCH(I:II))
- IF(JFIND.EQ.0) GOTO 99
- ISTART = I
- JSTART = JSTART+JFIND-1
- GOTO 10
-
- ELSEIF(MATCH(IX:IX).EQ.'%') THEN
-*
-* Current character is a <
-*
- ELSEIF((MATCH(IX:IX).EQ.'<').OR.(MATCH(IX:IX).EQ.'>')) THEN
-*
-* Current character is a < or >
-* Look for a /, an alphabetic character or the end of the string
-*
- IF(IDEBFA.GT.2)
- + PRINT *,'FASELP. Found a < or > character'
- JX = ICFMUL(HUNT,FILE,JSTART,JEND)
- IF(JX.GT.JEND) THEN
- JX = JEND
- ELSE
- JX = JX - 1
- ENDIF
-
- CHPASS = FILE(JSTART:JX)
-
- IF(MATCH(IX:IX).EQ.'<') THEN
-
- IF(LLT(CHPASS,CHPLOW)) THEN
- CHPLOW = CHPASS
- JFOUND = IFILE
- IFOUND = IFILE
-* IF(ISQ.NE.0.AND.JELEM.NE.0)
-* + IFELEM(JELEM,NLPAT) = IFILE
- ENDIF
-
- ELSE
-
- IF(LGT(CHPASS,CHPHI)) THEN
- CHPHI = CHPASS
- JFOUND = IFILE
- IFOUND = IFILE
-* IF(ISQ.NE.0.AND.JELEM.NE.0)
-* + IFELEM(JELEM,NLPAT) = IFILE
- ENDIF
-
- ENDIF
-
- IF(IDEBFA.GT.2)
- + PRINT 9001,CHPASS, CHPLOW, CHPHI
-9001 FORMAT(' FASELP. CHPASS, CHPLOW, CHPHI = ',3A20)
- JSTART = JX
- GOTO 10
-*
-* Current character is a %
-*
- ELSEIF(MATCH(IX:IX).EQ.'(') THEN
-*
-* Found a range delimiter
-*
- IF(IDEBFA.GT.2)
- + PRINT *,'FASELP. range encountered in MATCH pattern'
- IBRA = INDEX(MATCH(IX:IEND),')')
- ICOL = INDEX(MATCH(IX:IEND),':')
- IF(IBRA.EQ.0) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FASELP. no trailing delimiter',
- + ' for range pattern'
- IRC = -4
- RETURN
- ENDIF
-
- IF(IX+IBRA.LT.IEND) THEN
- IF(IDEBFA.GE.4)
- + PRINT *,'Looking for ',MATCH(IX+IBRA:IX+IBRA),' in ',
- + FILE(JSTART:JEND)
- LNMAT = INDEX(FILE(JSTART:JEND),
- + MATCH(IX+IBRA:IX+IBRA))
- IF(LNMAT.EQ.0) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FASELP. no match after',
- + ' range pattern'
- IRC = -4
- RETURN
- ENDIF
- LNMAT = LNMAT - 1
- ELSE
- LNMAT = IEND + 1
- ENDIF
-
- IF(ICOL.EQ.0) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FASELP. missing colon in ',
- + 'range pattern'
- IRC = -4
- RETURN
- ENDIF
-
- CHLOW = MATCH(IX+1:IX+ICOL-2)
- CHHIGH = MATCH(IX+ICOL:IX+IBRA-2)
- LNHIGH = LENOCC(CHHIGH)
-*
-* Extend CHLOW on the left with blanks
-*
- CALL CRIGHT(CHLOW,1,LNHIGH)
-*
-* And convert to zeroes
-*
- CALL CTRANS(' ','0',CHLOW,1,LNHIGH)
- IF(IDEBFA.GT.2)
- + PRINT *,'FASELP. range = ',CHLOW,' to ',CHHIGH
- CHMAT = FILE(JSTART:JSTART+LNMAT-1)
-*
-* Extend CHMAT on the left with blanks
-*
- CALL CRIGHT(CHMAT,1,LNHIGH)
-*
-* And convert to zeroes
-*
- CALL CTRANS(' ','0',CHMAT,1,LNHIGH)
- IF(ISQ.NE.0) THEN
- IELEM = ICDECI(CHMAT,1,LNHIGH)
- IF(IDEBFA.GE.3) PRINT *,'FASELP. IELEM = ',IELEM
- IF(IELEM.NE.0) THEN
- JELEM = IUFIND(IELEM,IFRNGE(1,NLPAT),1,
- + NFRNGE(NLPAT))
- IF(JELEM.GT.NFRNGE(NLPAT)) JELEM = 0
- ELSE
- JELEM = 0
- ENDIF
- IF(IDEBFA.GE.3) PRINT *,'FASELP. JELEM = ',JELEM
- ENDIF
- IF(IDEBFA.GT.2)
- + PRINT *,'FASELP. match = ',CHMAT
- IF(LLT(CHMAT(1:LNHIGH),CHLOW(1:LNHIGH)) .OR.
- + LGT(CHMAT(1:LNHIGH),CHHIGH(1:LNHIGH))) GOTO 99
- ISTART = ISTART + IBRA - 1
-* JSTART = JSTART + LNHIGH - 1
- JSTART = JSTART + LNMAT - 1
- GOTO 10
-
- ELSE
-*
-* Current character is a not a wild card
-*
- IF(FILE(JSTART:JSTART).NE.MATCH(ISTART:ISTART)) GOTO 99
-
- ENDIF
-
- GOTO 10
-
-99 CONTINUE
- IRC = 2
-1 CONTINUE
- IF(IRC.EQ.0) JMATCH = JFOUND
- IF(IFILE.EQ.NFILES) NMATCH = JMATCH
- IF(JELEM.NE.0) THEN
- IVALUE = ICDECI(CHPASS,1,LEN(CHPASS))
- IF(ILOW.NE.0) THEN
- IF(IDEBFA.GE.3) PRINT *,'FASELP. looking for ',
- + 'lowest value. Current value = ',IFVAL(JELEM,NLPAT)
- IF(IVALUE.LT.IFVAL(JELEM,NLPAT)) THEN
- IFVAL(JELEM,NLPAT) = IVALUE
- IFELEM(JELEM,NLPAT) = IFILE
- ENDIF
- ELSEIF(IHIGH.NE.0) THEN
- IF(IDEBFA.GE.3) PRINT *,'FASELP. looking for ',
- + 'highest value. Current value = ',IFVAL(JELEM,NLPAT)
- IF(IVALUE.GT.IFVAL(JELEM,NLPAT)) THEN
- IFVAL(JELEM,NLPAT) = IVALUE
- IFELEM(JELEM,NLPAT) = IFILE
- ENDIF
- ENDIF
- ENDIF
- IF(IDEBFA.GE.2) PRINT *,'FASELP. best candidate so far = ',
- + JMATCH,' return code from this pass = ',IRC
- END
-
diff --git a/src/packlib/fatmen/fatutil/fastat.F b/src/packlib/fatmen/fatutil/fastat.F
deleted file mode 100644
index 093cff7..0000000
--- a/src/packlib/fatmen/fatutil/fastat.F
+++ /dev/null
@@ -1,74 +0,0 @@
-*
-* $Id: fastat.F,v 1.1.1.1 1996/03/07 15:18:05 mclareni Exp $
-*
-* $Log: fastat.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:05 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FASTAT(LUNI)
-*
-************************************************************************
-*
-* SUBR. FASTAT(LUNI)
-*
-* print a summary of the status of the files managed by FATMEN
-*
-* LUNI output unit
-*
-*
-************************************************************************
-*
-#include "fatmen/fatbank.inc"
-#include "fatmen/fatpara.inc"
-*
- CHARACTER GENEN*255, PATHN*255, PATH*255,
- + PATHX*255, FNAME*20
- DIMENSION KEYS(10)
-*
-*
-*______________________________________________________________________
-*
-*
-* *** Loop over top directories
-*
- WRITE(LUNI,'(//,'' FATMEN status '',//)')
- LSAVFA = LTOPFA
- IF (LSAVFA.EQ.0) THEN
- WRITE(LUNI,'('' No Database open '',//)')
- GO TO 999
- ENDIF
- 10 CONTINUE
- NCHR = IQ(KOFUFA+LSAVFA+MNCHFA)
- CALL UHTOC (IQ(KOFUFA+LSAVFA+MCHRFA), 4, PATHX, NCHR)
- WRITE(LUNI,'('' Database '',A,'' open '',/)') PATHX(1:NCHR)
-*
- LBBKFA = LQ(KOFUFA+LSAVFA-KLBKFA)
- LBGNFA = LQ(KOFUFA+LSAVFA-KLGNFA)
-* Loop over open files
- NOPF = IQ(KOFUFA+LSAVFA+MNOPFA)
- IF (NOPF.EQ.0) THEN
- WRITE(LUNI,'('' No open files'',//)')
- GO TO 11
- ELSE
- WRITE(LUNI,'(1X,I5,'' open files'',/)')
- ENDIF
- LB = KOFUFA+LBBKFA
- DO 20 I=1,NOPF
- NCH = IQ(LB+MCGNFA)
- IPT = IQ(LB+MPNTFA)
- IST = IQ(LB+MSTAFA)
- CALL UHTOC (IQ(KOFUFA+LBGNFA+IPT), 4, GENEN, NCH)
- ICH = INDEXB(GENEN(1:NCH-1),'/')
- PATHN = GENEN(1:ICH-1)
- FNAME = GENEN(ICH+1:NCH)
- WRITE(LUNI,'(1X,A)') GENEN(1:NCH)
- WRITE(LUNI,'('' status'',I10)') IST
- LB = LB + NWBKFA
-20 CONTINUE
-11 LSAVFA = LQ(KOFUFA+LSAVFA)
- IF (LSAVFA.NE.0) GO TO 10
-* END FASTAT
- 999 END
-
diff --git a/src/packlib/fatmen/fatutil/fatare.F b/src/packlib/fatmen/fatutil/fatare.F
deleted file mode 100644
index a811698..0000000
--- a/src/packlib/fatmen/fatutil/fatare.F
+++ /dev/null
@@ -1,206 +0,0 @@
-*
-* $Id: fatare.F,v 1.1.1.1 1996/03/07 15:18:07 mclareni Exp $
-*
-* $Log: fatare.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:07 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FATARE(GENAM,LFAT,KEYS,CHLINE,CHOPT,IRC)
-#include "fatmen/fatpara.inc"
-#include "fatmen/fatbank.inc"
-#include "fatmen/fmnkeys.inc"
- CHARACTER*(*) GENAM,CHLINE,CHOPT
- DIMENSION KEYS(LKEYFA)
- CHARACTER*1 CHACT,CHSTG
- CHARACTER*6 VSN,VID
- CHARACTER*20 CHDEV
- CHARACTER*15 XVID
- CHARACTER*80 CARD
- CHARACTER*255 EQUNAM
- LOGICAL IEXIST
-#if defined(CERNLIB_SHIFT)
-#include "fatmen/fatshift.inc"
-#endif
-#include "fatmen/tmsdef0.inc"
-#include "fatmen/fatmed.inc"
-#include "fatmen/tmsdef1.inc"
-
- IRC = 0
- LBANK = LFAT + KOFUFA
-*
-* Query TMS for this VID - if TMS option is not installed
-* FMQTMS will return defaults.
-*
- CALL UHTOC(IQ(LBANK+MVSNFA),4,VSN,6)
- CALL UHTOC(IQ(LBANK+MVIDFA),4,VID,6)
- IQUEST(11) = IQ(LBANK+MMTPFA)
- IFILE = IQ(LBANK+MFSQFA)
-#if defined(CERNLIB_PREFIX)
- CALL FMXVID(VID,IQ(LBANK+MVIPFA),XVID,VIP,'C',ITMS)
- LXVID = LENOCC(XVID)
- CALL FMQTMS(XVID(1:LXVID),LIB,MODEL,DENS,MNTTYP,LABTYP,ITMS)
-#endif
-#if !defined(CERNLIB_PREFIX)
- CALL FMQTMS(VID,LIB,MODEL,DENS,MNTTYP,LABTYP,ITMS)
-#endif
-#if !defined(CERNLIB_TMS)
- IF(ITMS.EQ.99) ITMS = 0
-#endif
- IF(ITMS.EQ.100) THEN
- CHACT = '?'
- ELSEIF(ITMS.EQ.312.OR.ITMS.EQ.315) THEN
- CHACT = 'N'
- ELSE
- CHACT = 'Y'
- ENDIF
-
- CHSTG = 'N'
-*
-* Check whether required device exists on this node
-*
- LM = LENOCC(MODEL)
- IDEV = 1
- IF(ITMS.EQ.100) THEN
- CHDEV = 'unknown'
- ELSE
-#if (defined(CERNLIB_VAXVMS))&&(defined(CERNLIB_VAXTAP))
- CALL FMGTLG('SETUP_'//MODEL(1:LM)//'S',EQUNAM, 'LNM$SYSTEM',
- + IDEV)
- IF(IDEV.EQ.0) CHDEV = 'local'
-*
-* If logical name does not exist, or in the case of remote
-* libraries, read also setup configuration file
-*
- INQUIRE(FILE='SETUP_EXE:TPSERV.CONF',EXIST=IEXIST)
- IF(IDEV.NE.0.AND.IEXIST) THEN
-
- ISTAT = LIB$GET_LUN(LUNTAP)
-#include "fatmen/fatvaxrc.inc"
- OPEN(LUNTAP,FILE='SETUP_EXE:TPSERV.CONF', FORM='FORMATTED',
- + STATUS='OLD', READONLY,SHARED,IOSTAT=ISTAT)
- IF(ISTAT.NE.0) THEN
- IF(IDEBFA.GE.0) PRINT *,'FATARE. cannot open TPSERV',
- + ' configuration file (SETUP_EXE:TPSERV.CONF)'
- ELSE
- 10 CONTINUE
- READ(LUNTAP,'(A)',END=20) CARD
- LCARD = LENOCC(CARD)
- IF(INDEX(CARD(1:LCARD),'TPSERV').NE.0.AND.
- + INDEX(CARD(1:LCARD),MODEL(1:LM)).NE.0) THEN
- IF(IDEBFA.GE.1) PRINT *,'FATARE. ',CARD(1:LCARD)
- CHDEV = 'served'
- IDEV = 0
- GOTO 20
- ENDIF
- GOTO 10
- 20 CONTINUE
- CLOSE(LUNTAP)
- ENDIF
- ISTAT = LIB$FREE_LUN(LUNTAP)
-#include "fatmen/fatvaxrc.inc"
-
- ENDIF
-#endif
-#if defined(CERNLIB_IBMVM)
-*
-* Node specific restrictions - just check for defined media types
-*
- JDEV = ICNTH(MODEL(1:LM),MFMGEN,NMEDIA)
- IF(JDEV.EQ.0) THEN
- IDEV = 1
- CHDEV = 'unavailable'
- ELSE
- IDEV = 0
- CHDEV = 'local'
- ENDIF
-#endif
-#if (defined(CERNLIB_IBMVM))&&(defined(CERNLIB_CERN))
-*
-* SMCF, SMCG
-*
- IF(MODEL(1:3).EQ.'SMC') THEN
- IDEV = 0
- CHDEV = 'local'
- ENDIF
-#endif
-#if defined(CERNLIB_SHIFT)||defined(CERNLIB_CRAY)
-*
-* Read /etc/shift.conf file
-*
- INQUIRE(FILE=SHCONF(1:LSHCONF),EXIST=IEXIST)
- IF(IEXIST) THEN
- CALL CIOPEN(LUNPTR,'r',SHCONF(1:LSHCONF),ISTAT)
- IF(ISTAT.NE.0) THEN
- IF(IDEBFA.GE.0) PRINT *,'FATARE. cannot open SHIFT ',
- + 'configuration file: ',SHCONF(1:LSHCONF)
- ELSE
- 30 CONTINUE
- CALL FMCFGL(LUNPTR,CARD,LCARD,' ',ISTAT)
- IF(ISTAT.NE.0) GOTO 40
- IF(IDEBFA.GE.3) PRINT *,'FATARE. read line ', CARD(1:
- + LCARD),' from: ',SHCONF(1:LSHCONF)
- IF(INDEX(CARD(1:LCARD),'TPSERV').NE.0.AND.
- + INDEX(CARD(1 :LCARD),MODEL(1:LM)).NE.0) THEN
- IF(IDEBFA.GE.1) PRINT *,'FATARE. ',CARD(1:LCARD)
- IDEV = 0
- CHDEV = 'served'
- GOTO 40
- ENDIF
- GOTO 30
- 40 CONTINUE
- CALL FMCFGL(LUNPTR,CARD,LCARD,'F',ISTAT)
- CALL CICLOS(LUNPTR)
- ENDIF
- ENDIF
-
-#endif
-#if defined(CERNLIB_SHIFT)
-*
-* If device type not found, check in local TPCONFIG file
-*
- IF(IDEV.NE.0) THEN
- INQUIRE(FILE='/etc/TPCONFIG',EXIST=IEXIST)
- IF(IEXIST) THEN
- CALL CIOPEN(LUNPTR,'r','/etc/TPCONFIG',ISTAT)
- IF(ISTAT.NE.0) THEN
- IF(IDEBFA.GE.0) PRINT *,'FATARE. cannot open tape ',
- + 'daemon configuration file (/etc/TPCONFIG)'
- ELSE
- 50 CONTINUE
- CALL FMCFGL(LUNPTR,CARD,LCARD,' ',ISTAT)
- IF(ISTAT.NE.0) GOTO 60
- IF(IDEBFA.GE.3) PRINT *,'FATARE. read line ',
- + CARD(1: LCARD),' from /etc/TPCONFIG'
- IF(INDEX(CARD(1:LCARD),MODEL(1:LM)).NE.0) THEN
- CHDEV = 'local'
- IDEV = 0
- GOTO 60
- ENDIF
- GOTO 50
- 60 CONTINUE
- CALL FMCFGL(LUNPTR,CARD,LCARD,'F',ISTAT)
- CALL CICLOS(LUNPTR)
- ENDIF
- ENDIF
- ENDIF
-#endif
- IF(IDEV.EQ.1) CHDEV = 'unavailable'
- ENDIF
-*
-* For volumes in active libraries, check if staged
-*
- CHSTG = 'N'
- ISTG = 1
-
- IF(CHACT.EQ.'Y') THEN
- CALL FMSTGQ(VSN,VID,IFILE,LABTYP,ISTG)
- IF(ISTG.EQ.0) CHSTG = 'Y'
- ENDIF
-
- WRITE(CHLINE,9001) CHACT,CHSTG,CHDEV
-9001 FORMAT('Active: ',A1,' staged: ',A1,' device: ',A)
-
- IRC = IABS(ITMS) + IABS(IDEV) + IABS(ISTG)
- END
diff --git a/src/packlib/fatmen/fatutil/fatrek.F b/src/packlib/fatmen/fatutil/fatrek.F
deleted file mode 100644
index 5f5c6c0..0000000
--- a/src/packlib/fatmen/fatutil/fatrek.F
+++ /dev/null
@@ -1,123 +0,0 @@
-*
-* $Id: fatrek.F,v 1.1.1.1 1996/03/07 15:18:06 mclareni Exp $
-*
-* $Log: fatrek.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:06 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FATREK(CHPATH,NLEVEL,LWRITE,IRC)
-*
-************************************************************************
-*
-* To traverse the FATMEN directory tree starting from
-* the specified pathname.
-* Modified from the RZ routine RZSTAT / RZSCAN
-* Input:
-* CHPATH The pathname of the starting directory
-* NLEVEL Number of levels below CHPATH about which space information
-* has to be accumulated.
-* UROUT External user routine to be called for each pathname
-*
-* Output:
-* IQUEST(11) = number of directories found
-*
-* Called by <USER>
-*
-*
-************************************************************************
-#include "zebra/rzcl.inc"
-#include "zebra/rzdir.inc"
-#include "zebra/rzch.inc"
-#include "zebra/rzk.inc"
- CHARACTER*(*) CHPATH
- DIMENSION ISD(15),NSD(15),IHDIR(4)
-* DIMENSION IOPTV(2)
-* EQUIVALENCE (IOPTQ,IOPTV(1)), (IOPTX,IOPTV(2))
-*
-*-----------------------------------------------------------------------
-*
-*
- IRC=0
- IQUEST(1) = 0
- IQUEST(11) = 0
-*
- ITIME=0
- NLEV=NLEVEL
- IF(NLEV.LE.0)NLEV=99
- NFOUND = 0
- ITEMP = 0
- CALL FACDIR(CHWOLD,'R')
-*
-* Set CWD to the current level
-*
- 10 CONTINUE
- IF(ITIME.NE.0)THEN
- CALL RZPAFF(CHPAT,NLPAT,CHL)
- IF(IQUEST(1).NE.0) THEN
- NLPAT = NLPAT - 1
- GOTO 20
- ENDIF
- CALL FACDIR(CHL,' ')
- ELSE
- CALL FACDIR(CHPATH,' ')
- IF(IQUEST(1).NE.0)GO TO 99
- NLPAT0=NLPAT
- CHL = CHPATH
- ENDIF
- IF(IQUEST(1).NE.0) THEN
- NLPAT = NLPAT - 1
- GOTO 20
- ENDIF
-*
-* Print current directory
-*
- LCHL = LENOCC(CHL)
- IF(ITIME.NE.0) THEN
- ISTART = INDEXB(CHL(1:LCHL),'/')-1
- CALL CFILL(' ',CHL,1,ISTART)
- ENDIF
- WRITE (LWRITE,*) CHL(1:LCHL)
- ISD(NLPAT)=0
- NSD(NLPAT)=IQ(KQSP+LCDIR+KNSD)
-*
-* Process possible down directories
-*
- 20 ISD(NLPAT)=ISD(NLPAT)+1
- IF((ISD(NLPAT).LE.NSD(NLPAT)).AND.
- + (NLPAT.LT.(NLPAT0+NLEV))) THEN
- NLPAT=NLPAT+1
- LS=IQ(KQSP+LCDIR+KLS)
- IH=LS+7*(ISD(NLPAT-1)-1)
- CALL ZITOH(IQ(KQSP+LCDIR+IH),IHDIR,4)
- CALL UHTOC(IHDIR,4,CHPAT(NLPAT),16)
- ITIME=ITIME+1
- GO TO 10
- ELSE
-*
-* Write information on current directory
-*
- CALL RZPAFF(CHPAT,NLPAT,CHL)
- IF(NLPAT.LE.(NLPAT0+NLEV))THEN
- NFOUND = NFOUND + 1
- ENDIF
- 30 CONTINUE
- NLPAT=NLPAT-1
- IF(NLPAT.GE.NLPAT0)THEN
- LUP=LQ(KQSP+LCDIR+1)
- CALL MZDROP(JQPDVS,LCDIR,' ')
- LCDIR=LUP
- GO TO 20
- ENDIF
- ENDIF
-*
-* Reset CWD
-*
- 90 CALL FACDIR(CHWOLD,' ')
-*
- 99 CONTINUE
- IRC = IQUEST(1)
- IQUEST(11) = NFOUND
- RETURN
- END
diff --git a/src/packlib/fatmen/fatutil/fazoom.F b/src/packlib/fatmen/fatutil/fazoom.F
deleted file mode 100644
index 023f1f1..0000000
--- a/src/packlib/fatmen/fatutil/fazoom.F
+++ /dev/null
@@ -1,209 +0,0 @@
-*
-* $Id: fazoom.F,v 1.1.1.1 1996/03/07 15:18:07 mclareni Exp $
-*
-* $Log: fazoom.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:07 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FAZOOM(PATH,IRC)
-*
-* To zoom down the FATMEN directory tree starting from
-* the specified pathname.
-*
-#include "zebra/rzcl.inc"
-#include "zebra/rzdir.inc"
-#include "zebra/rzch.inc"
-#include "zebra/rzk.inc"
- CHARACTER*(*) PATH
- CHARACTER*255 CHPATH
- PARAMETER (MAXLEV=20)
- CHARACTER*16 DIRNAM(MAXLEV),CHDIR
- DIMENSION ISD(15),NSD(15),IHDIR(4)
- DIMENSION IOPTV(2)
- EQUIVALENCE (IOPTQ,IOPTV(1)), (IOPTX,IOPTV(2))
-#include "fatmen/fatbug.inc"
- SAVE DIRNAM
-*
-*-----------------------------------------------------------------------
-*
-*
- IRC=0
- IQUEST(1) = 0
- IQUEST(11) = 0
- LPATH = LENOCC(PATH)
- LPATHI = LPATH
- CHPATH = PATH(1:LPATH)
- CALL CLTOU(CHPATH(1:LPATH))
-*
- ITIME = 0
-* NLEV = NLEVEL
-* IF(NLEV.LE.0) NLEV=99
- NLEV = 99
- NFOUND = 0
- ITEMP = 0
- CALL FACDIR(CHWOLD,'R')
- LOLD = LENOCC(CHWOLD)
-*
-* Split input path name into its component pieces
-* (this is the opposite of RZPAFF which glues them together)
-*
- CALL FMPAFF(CHPATH(1:LPATH),DIRNAM,MAXLEV,IRET)
-*
-* Find first wild card in generic name
-*
- IF(IDEBFA.GE.3)
- +PRINT *,'FAZOOM. enter for PATH = ',CHPATH(1:LPATH)
- IWILD = ICFMUL('*%(<>',CHPATH,1,LPATH)
- IF(IWILD.LE.LPATH) THEN
- LPATH = INDEXB(CHPATH(1:IWILD),'/') - 1
- CALL FMNWRD('/',CHPATH(LPATH+2:LPATHI),NLEV0)
- NLEV = MIN(99,NLEV+NLEV0)
-* ELSE
-* LPATHI = LPATHI + 2
-* CHPATH(LPATHI-1:LPATHI) = '/*'
- ENDIF
-
- IF(IDEBFA.GE.3) PRINT *,'FAZOOM. zoom down ',
- + CHPATH(1:LPATH)
-*
-* Set CWD to the current level
-*
- 10 CONTINUE
- IF(ITIME.NE.0)THEN
- CALL RZPAFF(CHPAT,NLPAT,CHL)
- IF(IQUEST(1).NE.0) THEN
- NLPAT = NLPAT - 1
- GOTO 20
- ENDIF
- CALL FACDIR(CHL,' ')
- ELSE
- CALL FACDIR(CHPATH(1:LPATH),' ')
- IF(IQUEST(1).NE.0)GO TO 99
- NLPAT0=NLPAT
- CHL = CHPATH(1:LPATH)
- ENDIF
- IF(IQUEST(1).NE.0) THEN
- NLPAT = NLPAT - 1
- GOTO 20
- ENDIF
-*
-* Set IQUEST
-*
- IQUEST(12) = IQ(KQSP+LCDIR+KNSD)
- IQUEST(13) = NLPAT
- IQUEST(14) = IQ(KQSP+LCDIR+KNKEYS)
- IQUEST(15) = IQ(KQSP+LCDIR+KNWKEY)
-
- IF(IDEBFA.GE.3) PRINT *,'FAZOOM. directory ',CHL,
- + ' subdirectories: ',IQUEST(12),' files ',IQUEST(14)
-*
-* Ensure that entire path name matches ...
-*
- CALL FMATCH(CHL,CHPATH(1:LPATHI),IRC)
-*
-* Trailing unmatched characters in CHPATH
-* Accept if first character is a / and total length
-* of pathname is ok
-*
- IF(IRC.EQ.2.AND.CHL(IQUEST(1):IQUEST(1)).EQ.'/'
- + .AND.NLPAT.LE.NLEV0+NLEV) IRC = 0
-
- IF(IRC.EQ.0) THEN
-*
-* If we have found a lowest level directory with 1 or more
-* files, then return
-*
- IF(IQUEST(12).EQ.0.AND.IQUEST(14).GT.0) RETURN
- ENDIF
-
- ISD(NLPAT)=0
- NSD(NLPAT)=IQ(KQSP+LCDIR+KNSD)
-*
-* If there is a <> at this level, perform matching
-* and follow only that path
-*
- ILT = INDEX(DIRNAM(NLPAT+1),'<')
- IGT = INDEX(DIRNAM(NLPAT+1),'>')
-
- IF((ILT.NE.0).AND.(IGT.NE.0)) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FAZOOM. invalid wild-carding ',
- + 'at level ',NLPAT,' in pathname - ',DIRNAM(NLPAT+1)
- IF(IDEBFA.GE.-3) PRINT *,'FAZOOM. only one of < or > ',
- + 'may be specified'
- IQUEST(1) = -1
- GOTO 90
- ENDIF
-
- IF(ILT+IGT.NE.0) THEN
-*
-* Loop over all subdirectories at this level
-*
- DO 5 JJ=1,NSD(NLPAT)
- LS=IQ(KQSP+LCDIR+KLS)
- IH=LS+7*(JJ-1)
- CALL ZITOH(IQ(KQSP+LCDIR+IH),IHDIR,4)
- CALL UHTOC(IHDIR,4,CHDIR,16)
- CALL FASELP(CHDIR,DIRNAM(NLPAT+1),JJ,NSD(NLPAT),JINDEX,IRC)
- 5 CONTINUE
- IF(JINDEX.GT.0) THEN
- IF(IDEBFA.GE.3) THEN
- LS=IQ(KQSP+LCDIR+KLS)
- IH=LS+7*(JINDEX-1)
- CALL ZITOH(IQ(KQSP+LCDIR+IH),IHDIR,4)
- CALL UHTOC(IHDIR,4,CHDIR,16)
- IF(IDEBFA.GE.2)
- + PRINT *,'FAZOOM. selected subdirectory ',CHDIR
- ENDIF
- NSD(NLPAT) = JINDEX
- ISD(NLPAT) = JINDEX - 1
- ELSE
- IF(IDEBFA.GE.2) PRINT *,'FAZOOM. no subdirectory matches'
- NSD(NLPAT) = 0
- ENDIF
- ELSE
- JINDEX = -1
- ENDIF
-*
-* Process possible down directories
-*
- 20 ISD(NLPAT)=ISD(NLPAT)+1
- IF((ISD(NLPAT).LE.NSD(NLPAT)).AND.
- + (NLPAT.LT.(NLPAT0+NLEV))) THEN
- NLPAT=NLPAT+1
- LS=IQ(KQSP+LCDIR+KLS)
- IH=LS+7*(ISD(NLPAT-1)-1)
- CALL ZITOH(IQ(KQSP+LCDIR+IH),IHDIR,4)
- CALL UHTOC(IHDIR,4,CHPAT(NLPAT),16)
- ITIME=ITIME+1
- GO TO 10
- ELSE
-*
-* Write information on current directory
-*
- CALL RZPAFF(CHPAT,NLPAT,CHL)
- IF(NLPAT.LE.(NLPAT0+NLEV))THEN
- NFOUND = NFOUND + 1
- ENDIF
- 30 CONTINUE
- NLPAT=NLPAT-1
- IF(NLPAT.GE.NLPAT0)THEN
- LUP=LQ(KQSP+LCDIR+1)
- CALL MZDROP(JQPDVS,LCDIR,' ')
- LCDIR=LUP
- GO TO 20
- ENDIF
- ENDIF
-*
-* Reset CWD
-*
- 90 CALL FACDIR(CHWOLD(1:LOLD),' ')
-*
- 99 CONTINUE
-*
-* No match
-*
- IRC = 1
- RETURN
- END
diff --git a/src/packlib/fatmen/fatutil/fmback.F b/src/packlib/fatmen/fatutil/fmback.F
deleted file mode 100644
index 22e30da..0000000
--- a/src/packlib/fatmen/fatutil/fmback.F
+++ /dev/null
@@ -1,399 +0,0 @@
-*
-* $Id: fmback.F,v 1.1.1.1 1996/03/07 15:18:07 mclareni Exp $
-*
-* $Log: fmback.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:07 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMBACK(PATH,NLEVEL,UROUT,IRC)
-*
-************************************************************************
-*
-* To traverse the FATMEN directory tree starting from
-* the specified pathname.
-* Modified from the RZ routine RZSTAT / RZSCAN
-*
-* This routine behaves like FMSCAN, but for files, rather than
-* directories.
-* FMBACK processes each entry in a directory from last to first
-*
-* Input:
-* CHPATH The pathname of the starting directory
-* NLEVEL Number of levels below CHPATH about which space information
-* has to be accumulated.
-* UROUT External user routine to be called for each pathname
-*
-* Output:
-* IQUEST(10) = number levels in initial path
-* IQUEST(11) = number of directories found
-*
-* IQUEST(12) = number of subdirectories at this level
-* IQUEST(13) = number of elements in path name
-* IQUEST(14) = number of keys
-* IQUEST(15) = number of words per key
-* IQUEST(16) = incremental count of #keys selected
-* IQUEST(17) = number of this key vector
-*
-* Called by <USER>
-*
-*
-************************************************************************
-#include "fatmen/slate.inc"
-#include "zebra/rzcl.inc"
-#include "zebra/rzdir.inc"
-#include "zebra/rzch.inc"
-#include "zebra/rzk.inc"
- CHARACTER*(*) PATH
- CHARACTER*255 CHPATH
- CHARACTER*20 CHFILE,FNAME
- PARAMETER (MAXLEV=20)
- CHARACTER*16 DIRNAM(MAXLEV),CHDIR
- DIMENSION ISD(15),NSD(15),IHDIR(4)
- DIMENSION IOPTV(2)
- EQUIVALENCE (IOPTQ,IOPTV(1)), (IOPTX,IOPTV(2))
- EXTERNAL UROUT
-#include "fatmen/fmnkeys.inc"
- DIMENSION KEYS(LKEYFA)
-#include "fatmen/fatpara.inc"
-#include "fatmen/fatloc.inc"
-#include "fatmen/fatmtp.inc"
-#include "fatmen/fatcpl.inc"
-#include "fatmen/farnge.inc"
-#include "fatmen/fatbug.inc"
- SAVE DIRNAM
-*
-*-----------------------------------------------------------------------
-*
-*
- IRC=0
- IQUEST(1) = 0
- IQUEST(11) = 0
- LPATH = LENOCC(PATH)
- CHPATH = PATH(1:LPATH)
- CALL CLTOU(CHPATH(1:LPATH))
-*
-* Find file name
-*
- LSLASH = INDEXB(CHPATH(1:LPATH),'/')
- CHFILE = CHPATH(LSLASH+1:LPATH)
- LFILE = LPATH - LSLASH
- LPATH = LSLASH - 1
- LPATHI = LPATH
-*
-* Get number of levels in initial path
-*
- CALL FMNWRD('/',CHPATH(3:LPATHI),NLEV0)
-*
-* Split input path name into its component pieces
-* (this is the opposite of RZPAFF which glues them together)
-*
- CALL FMPAFF(CHPATH(1:LPATH),DIRNAM,MAXLEV,IRET)
-*
-* Find first wild card in generic name
-*
- IF(IDEBFA.GE.3)
- +PRINT *,'FMBACK. enter for PATH = ',CHPATH(1:LPATH),
- + ' file = ',CHFILE(1:LFILE)
- IWILD = ICFMUL('*%(<>',CHPATH,1,LPATH)
- IF(IWILD.LE.LPATH) THEN
- LPATH = INDEXB(CHPATH(1:IWILD),'/') - 1
- ENDIF
-*
- ITIME=0
- NLEV=NLEVEL
- IF(NLEV.LE.0)NLEV=99
- NFOUND = 0
- ITEMP = 0
- CALL FACDIR(CHWOLD,'R')
-*
-* Set CWD to the current level
-*
- 10 CONTINUE
- IF(ITIME.NE.0)THEN
- CALL RZPAFF(CHPAT,NLPAT,CHL)
- IF(IQUEST(1).NE.0) THEN
- NLPAT = NLPAT - 1
- GOTO 60
- ENDIF
- CALL FACDIR(CHL,' ')
- ELSE
- CALL FACDIR(CHPATH(1:LPATH),' ')
- IF(IQUEST(1).NE.0)GO TO 80
- NLPAT0=NLPAT
- CHL = CHPATH(1:LPATH)
- ENDIF
- IF(IQUEST(1).NE.0) THEN
- NLPAT = NLPAT - 1
- GOTO 60
- ENDIF
-*
-* Set IQUEST
-*
- IQUEST(10) = NLEV0
- IQUEST(12) = IQ(KQSP+LCDIR+KNSD)
- IQUEST(13) = NLPAT
- IQUEST(14) = IQ(KQSP+LCDIR+KNKEYS)
- IQUEST(15) = IQ(KQSP+LCDIR+KNWKEY)
- NWK = IQ(KQSP+LCDIR+KNWKEY)
- NKEYS = IQ(KQSP+LCDIR+KNKEYS)
- LK = IQ(KQSP+LCDIR+KLK)
-*
-* Ensure that entire path name matches before calling UROUT
-*
- CALL FMATCH(CHL,CHPATH(1:LPATHI),IRC)
-*
-* Trailing unmatched characters in CHPATH
-* Accept if first character is a / and total length
-* of pathname is ok
-*
- IF(IRC.EQ.2.AND.CHL(IQUEST(1):IQUEST(1)).EQ.'/'
- + .AND.NLPAT.LE.NLEV0+NLEV) IRC = 0
-
- IF(IRC.EQ.0) THEN
-*
-* Get the keys
-*
- NDONE = 0
- DO 30 I=NKEYS,1,-1
-*
-* Number of this key vector
-*
- IQUEST(17) = I
- K=LK+(NWK+1)*(I-1)
- DO 20 J=1,NWK
- IKDES=(J-1)/10
- IKBIT1=3*J-30*IKDES-2
- IF(JBYT(IQ(KQSP+LCDIR+KKDES+IKDES),IKBIT1,3).LT.3)THEN
- KEYS(J)=IQ(KQSP+LCDIR+K+J)
- ELSE
- CALL ZITOH(IQ(KQSP+LCDIR+K+J),KEYS(J),1)
- ENDIF
- 20 CONTINUE
- CALL UHTOC(KEYS(MKFNFA),4,FNAME,20)
- LF = LENOCC(FNAME)
-*
-* Check that keys match those selected
-* Location code:
-*
- IF(NUMLOC.GT.0) THEN
- IF(IUCOMP(KEYS(MKLCFA),MFMLOC,NUMLOC).EQ.0) THEN
- IF(IDEBFA.GE.3) PRINT *,'FMBACK. candidate # ',I,
- + ' fails location code check'
- GOTO 30
- ENDIF
- ENDIF
-*
-* Copy level:
-*
- IF(NUMCPL.GT.0) THEN
- IF(IUCOMP(KEYS(MKCLFA),MFMCPL,NUMCPL).EQ.0) THEN
- IF(IDEBFA.GE.3) PRINT *,'FMBACK. candidate # ',I,
- + ' fails copy level check'
- GOTO 30
- ENDIF
- ENDIF
-*
-* Media type:
-*
- IF(NUMMTP.GT.0) THEN
- IF(IUCOMP(KEYS(MKMTFA),MFMMTP,NUMMTP).EQ.0) THEN
- IF(IDEBFA.GE.3) PRINT *,'FMBACK. candidate # ',I,
- + ' fails media type check'
- GOTO 30
- ENDIF
- ENDIF
-*
-* File name:
-*
- LF = LENOCC(FNAME)
-*
-* Fast check: CHFILE = '*'
-*
- IF(CHFILE(1:LFILE).EQ.'*.') THEN
- IMAT = 0
- ELSE
- CALL FMATCH(FNAME(1:LF),CHFILE(1:LFILE),IMAT)
- ENDIF
-
- IF(IMAT.NE.0) THEN
- IF(IDEBFA.GE.3) PRINT *,'FMBACK. candidate # ',I,
- + ' fails filename check'
- GOTO 30
- ENDIF
-*
-* Now call user routine
-*
- NDONE = NDONE + 1
- IQUEST(16) = NDONE
- CALL UROUT(CHL(1:LENOCC(CHL))//'/'
- + //FNAME(1:LF),KEYS,IURC)
-*
-* Skip rest of this directory?
-*
- IF(IURC.LT.0) GOTO 40
-*
-* Finish now?
-*
- IF(IURC.GT.0) RETURN
- 30 CONTINUE
- 40 CONTINUE
- ENDIF
-
- ISD(NLPAT)=0
- NSD(NLPAT)=IQ(KQSP+LCDIR+KNSD)
-*
-* If there is a <> at this level, perform matching
-* and follow only that path
-*
- ILT = INDEX(DIRNAM(NLPAT+1),'<')
- IGT = INDEX(DIRNAM(NLPAT+1),'>')
- NFRNGE(NLPAT+1) = 0
-
- IF((ILT.NE.0).AND.(IGT.NE.0)) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMBACK. invalid wild-carding ',
- + 'at level ',NLPAT,' in pathname - ',DIRNAM(NLPAT+1)
- IF(IDEBFA.GE.-3) PRINT *,'FMBACK. only one of < or > ',
- + 'may be specified'
- IQUEST(1) = -1
- GOTO 70
- ENDIF
-
- IF(ILT+IGT.NE.0) THEN
-*
-* Is there a [mm:nn] syle range?
-*
- JR = LENOCC(DIRNAM(NLPAT+1))
- ISQ = INDEX(DIRNAM(NLPAT+1)(1:JR),'[')
- IF(ISQ.NE.0) THEN
- ILOW = ICDECI(DIRNAM(NLPAT+1),ISQ+1,JR)
- IF(IS(1).EQ.0) THEN
- IRC = -1
- IF(IDEBFA.GE.-3) PRINT *,'FMBACK. error reading ',
- + 'decimal value from ',DIRNAM(NLPAT+1)(ISQ:JR)
- IF(IDEBFA.GE.-3) PRINT *,' Only integer ranges ',
- + 'are supported between [] characters, e.g. [10:20]'
- GOTO 80
- ENDIF
- IHIGH = ICDECI(DIRNAM(NLPAT+1),
- + INDEX(DIRNAM(NLPAT+1),':') + 1,JR)
- IF(IS(1).EQ.0) THEN
- IRC = -1
- IF(IDEBFA.GE.-3) PRINT *,'FMBACK. error reading ',
- + 'decimal value from ',DIRNAM(NLPAT+1)(ISQ:JR)
- IF(IDEBFA.GE.-3) PRINT *,' Only integer ranges ',
- + 'are supported between [] characters, e.g. [10:20]'
- GOTO 80
- ENDIF
- IF(IDEBFA.GE.3) PRINT *,'FMBACK. ilow/ihigh = ',ILOW,IHIGH
- NFRNGE(NLPAT+1) = 0
- IF(IHIGH-ILOW+1.GT.100) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMBACK. maximum range is 100',
- + ' - excess elements will be ignored'
- IHIGH = ILOW + 99
- ENDIF
- DO 22 JJ=ILOW,IHIGH
- NFRNGE(NLPAT+1) = NFRNGE(NLPAT+1) + 1
- IFRNGE(NFRNGE(NLPAT+1),NLPAT+1) = JJ
- IFELEM(NFRNGE(NLPAT+1),NLPAT+1) = -1
- IF(ILT.NE.0) THEN
- IFVAL(NFRNGE(NLPAT+1),NLPAT+1) = 999999
- ELSE
- IFVAL(NFRNGE(NLPAT+1),NLPAT+1) = -1
- ENDIF
- 22 CONTINUE
- ENDIF
-*
-* Loop over all subdirectories at this level
-*
- DO 44 JJ=1,NSD(NLPAT)
- LS=IQ(KQSP+LCDIR+KLS)
- IH=LS+7*(JJ-1)
- CALL ZITOH(IQ(KQSP+LCDIR+IH),IHDIR,4)
- CALL UHTOC(IHDIR,4,CHDIR,16)
- CALL FASELP(CHDIR,DIRNAM(NLPAT+1),JJ,NSD(NLPAT),JINDEX,IRC)
- 44 CONTINUE
- IF(JINDEX.GT.0) THEN
- IF(NFRNGE(NLPAT+1).EQ.0) THEN
- IF(IDEBFA.GE.3) THEN
- LS=IQ(KQSP+LCDIR+KLS)
- IH=LS+7*(JINDEX-1)
- CALL ZITOH(IQ(KQSP+LCDIR+IH),IHDIR,4)
- CALL UHTOC(IHDIR,4,CHDIR,16)
- PRINT *,'FMBACK. selected subdirectory ',CHDIR
- ENDIF
- NSD(NLPAT) = JINDEX
- ISD(NLPAT) = JINDEX - 1
- ELSE
- LS=IQ(KQSP+LCDIR+KLS)
- IF(IDEBFA.GE.3)
- + PRINT *,'FMBACK. selected following subdirectories...'
- JMIN = 999999
- JMAX = 0
- DO 50 II=1,NFRNGE(NLPAT+1)
- JJ=IFELEM(II,NLPAT+1)
- IF(JJ.LE.0) GOTO 50
- IF(JJ.LT.JMIN) JMIN = JJ
- IF(JJ.GT.JMAX) JMAX = JJ
- IF(IDEBFA.GE.3) THEN
- IH=LS+7*(JJ-1)
- CALL ZITOH(IQ(KQSP+LCDIR+IH),IHDIR,4)
- CALL UHTOC(IHDIR,4,CHDIR,16)
- PRINT *,CHDIR
- ENDIF
- 50 CONTINUE
- NSD(NLPAT) = JMAX
- ISD(NLPAT) = JMIN - 1
- ENDIF
- ELSE
- IF(IDEBFA.GE.2)
- + PRINT *,'FMBACK. no subdirectory matches'
- NSD(NLPAT) = 0
- ENDIF
- ELSE
- JINDEX = -1
- ENDIF
-*
-* Process possible down directories
-*
- 60 ISD(NLPAT)=ISD(NLPAT)+1
- IF((ISD(NLPAT).LE.NSD(NLPAT)).AND.
- + (NLPAT.LT.(NLPAT0+NLEV))) THEN
- IF(NFRNGE(NLPAT+1).NE.0
- + .AND.IUFIND(ISD(NLPAT),
- + IFELEM(1,NLPAT+1),1,NFRNGE(NLPAT+1)).GT.
- + NFRNGE(NLPAT+1)) GOTO 60
- NLPAT=NLPAT+1
- LS=IQ(KQSP+LCDIR+KLS)
- IH=LS+7*(ISD(NLPAT-1)-1)
- CALL ZITOH(IQ(KQSP+LCDIR+IH),IHDIR,4)
- CALL UHTOC(IHDIR,4,CHPAT(NLPAT),16)
- ITIME=ITIME+1
- GO TO 10
- ELSE
-*
-* Write information on current directory
-*
- CALL RZPAFF(CHPAT,NLPAT,CHL)
- IF(NLPAT.LE.(NLPAT0+NLEV))THEN
- NFOUND = NFOUND + 1
- ENDIF
- NLPAT=NLPAT-1
- IF(NLPAT.GE.NLPAT0)THEN
- LUP=LQ(KQSP+LCDIR+1)
- CALL MZDROP(JQPDVS,LCDIR,' ')
- LCDIR=LUP
- GO TO 60
- ENDIF
- ENDIF
-*
-* Reset CWD
-*
- 70 CALL FACDIR(CHWOLD,' ')
-*
- 80 CONTINUE
- IRC = IQUEST(1)
- IQUEST(11) = NFOUND
- RETURN
- END
diff --git a/src/packlib/fatmen/fatutil/fmcfio.F b/src/packlib/fatmen/fatutil/fmcfio.F
deleted file mode 100644
index b208ab4..0000000
--- a/src/packlib/fatmen/fatutil/fmcfio.F
+++ /dev/null
@@ -1,67 +0,0 @@
-*
-* $Id: fmcfio.F,v 1.1.1.1 1996/03/07 15:18:07 mclareni Exp $
-*
-* $Log: fmcfio.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:07 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
-#if defined(CERNLIB_VAXVMS)
- SUBROUTINE FMCFIO(IBUF,IOWAY)
- DIMENSION IBUF(8192)
-#include "zebra/zmach.inc"
-#include "zebra/quest.inc"
-#include "fatmen/fatbug.inc"
-#include "fatmen/fatinfo.inc"
- CHARACTER*6 CHWAY
-
- IRC = 0
- IF(IDEBFA.GE.3) PRINT *,'FMCFIO. IQUEST(1-6) = ',
- + (IQUEST(J),J=1,6)
- LUN = IQUEST(1)
- NREC = IQUEST(4)
-*
-* Medium
-*
- IF(LFMODE(LUN).EQ.3) THEN
- MEDIUM = 1
- ELSE
- MEDIUM = 0
- ENDIF
-*
-* File pointer
-*
- LUNDES = IFPNTR(LUN)
-
- IF(IOWAY.EQ.0) THEN
- IF(NREC.GT.0) THEN
- CALL CFSEEK(LUNDES,MEDIUM,IQUEST(2),NREC-1,IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMCFIO. return code ',IRC,
- + ' from CFSEEK.'
- GOTO 99
- ENDIF
- ENDIF
- CALL CFGET(LUNDES,MEDIUM,IQUEST(2),IQUEST(2),IBUF,IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMCFIO. return code ',IRC,
- + ' from CFGET.'
- ENDIF
- ELSEIF(IOWAY.EQ.1) THEN
- CALL CFPUT(LUNDES,MEDIUM,IQUEST(2),IBUF,IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMCFIO. return code ',IRC,
- + ' from CFPUT.'
- ENDIF
- ELSE
- WRITE(CHWAY,'(I6)') IOWAY
- CALL ZFATAM('Invalid value for IOWAY in FMCFIO - '//CHWAY)
- ENDIF
-
-99 CONTINUE
-
- IQUEST(1) = IRC
-
- END
-#endif
diff --git a/src/packlib/fatmen/fatutil/fmchop.F b/src/packlib/fatmen/fatutil/fmchop.F
deleted file mode 100644
index d663e03..0000000
--- a/src/packlib/fatmen/fatutil/fmchop.F
+++ /dev/null
@@ -1,30 +0,0 @@
-*
-* $Id: fmchop.F,v 1.1.1.1 1996/03/07 15:18:05 mclareni Exp $
-*
-* $Log: fmchop.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:05 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMCHOP(ROUTIN,CHOPT,ALLOWD,IRC)
- CHARACTER*(*) ROUTIN,CHOPT,ALLOWD
-#include "fatmen/fatbank.inc"
-#include "fatmen/fatpara.inc"
- IRC = 0
-*
-* This routine checks each character of CHOPT against ALLOWD
-* Invalid characters are flagged
-*
- LCHOPT = LENOCC(CHOPT)
- LALLOW = LENOCC(ALLOWD)
- DO 10 I=1,LCHOPT
- IF(INDEX(ALLOWD(1:LALLOW),CHOPT(I:I)).EQ.0) THEN
- IF(IDEBFA.GE.0) PRINT *,'Invalid option ',CHOPT(I:I),
- + ' for routine ',ROUTIN,' ignored'
- IRC = 1
- ENDIF
-
-10 CONTINUE
- END
-
diff --git a/src/packlib/fatmen/fatutil/fmcopq.F b/src/packlib/fatmen/fatutil/fmcopq.F
deleted file mode 100644
index 26f5869..0000000
--- a/src/packlib/fatmen/fatutil/fmcopq.F
+++ /dev/null
@@ -1,298 +0,0 @@
-*
-* $Id: fmcopq.F,v 1.1.1.1 1996/03/07 15:18:07 mclareni Exp $
-*
-* $Log: fmcopq.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:07 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMCOPQ(GENAM1,LBANK1,KEYS1,GENAM2,LBANK2,KEYS2,
- +CHOPT,IRC)
-*
-* Generate update file for COPY command
-*
-#include "fatmen/faust.inc"
-#include "fatmen/fausto.inc"
-#include "fatmen/fatsys.inc"
-#include "fatmen/fatbank.inc"
-#include "fatmen/fatpara.inc"
-#include "fatmen/fmnkeys.inc"
-#include "fatmen/slate.inc"
- CHARACTER*(*) GENAM1,GENAM2,CHOPT
- DIMENSION KEYS1(LKEYFA),KEYS2(LKEYFA)
- CHARACTER*255 CHEOPS,CHFILE,CHFOUT
- CHARACTER*80 COMM
-#if defined(CERNLIB_IBMVM)
- CHARACTER*1 CMXDSK,DISK
-#endif
-#if defined(CERNLIB_VAXVMS)
- CHARACTER*255 CHTEMP
- INCLUDE '($RMSDEF)'
-#endif
-#if defined(CERNLIB_UNIX)
- INTEGER SYSTEMF
-#endif
- PARAMETER (IFLAG=0)
- LOGICAL IEXIST
-#if defined(CERNLIB_VAXVMS)
- INTEGER FMHOST,FMVUSR,FMACNT
- CHARACTER*12 CHUSER
- CHARACTER*8 CHACNT,CHHOST,CHTYPE,CHSYS
-#endif
-#if !defined(CERNLIB_VAXVMS)
- INTEGER FMHOST,FMUSER,FMACNT
- CHARACTER*8 CHUSER,CHACNT,CHHOST,CHTYPE,CHSYS
-#endif
- SAVE NENTRY,LCHOPS,CHEOPS
-#include "fatmen/fatran0.inc"
-#include "fatmen/fatsat0.inc"
-#include "fatmen/fatoptd.inc"
-#include "fatmen/fatran1.inc"
-#include "fatmen/fatsat1.inc"
-
- DATA NENTRY /0/
-
-#include "fatmen/fatoptc.inc"
-
-
-#if defined(CERNLIB_IBMMVS)
- RETURN
-#endif
-
-
- NFCOPQ = NFCOPQ + 1
- FATMBQ = FATMBQ + Q(LBANK1+KOFUFA+MFSZFA)
-
- IF(NENTRY.EQ.0) THEN
-*
-* Check if CHEOPS directory is accessible
-*
-#if defined(CERNLIB_IBMVM)
-*
-* Try to link to FMCHEOPS
-*
- CALL VMCMS('EXEC GIME FMCHEOPS (QUIET NONOTICE STACK)',IRC)
- IF (IRC .LE. 4) THEN
- CALL VMRTRM(CHEOPS,LCHOPS)
- CALL VMCMS('EXEC DROP '//CHEOPS(1:1),IRC)
- ELSEIF(IRC.EQ.104) THEN
- IF(IDEBFA.GT.-3) PRINT *,'FMCOPQ. FMCHEOPS does not ',
- + 'exist - cannot queue updates to CHEOPS server'
- LCHOPS = -1
- RETURN
- ENDIF
-
-#endif
-#if defined(CERNLIB_VAXVMS)||defined(CERNLIB_UNIX)
-*
-* Is CHEOPS directory defined
-*
- CALL GETENVF('FMCHEOPS',CHEOPS)
- IF(IS(1).EQ.0) THEN
- IF(IDEBFA.EQ.0) PRINT *,'FMCOPQ. cheops queue directory ',
- + 'not defined - using default'
-#endif
-#if defined(CERNLIB_UNIX)
- CHEOPS = '/fatmen/fmcheops'
- LCHOPS = 16
-#endif
-#if defined(CERNLIB_VAXVMS)
- CHEOPS = 'fatmen:[fmcheops]'
- LCHOPS = 17
-#endif
-#if defined(CERNLIB_VAXVMS)||defined(CERNLIB_UNIX)
- ELSE
- LCHOPS = IS(1)
- ENDIF
-#endif
-#if defined(CERNLIB_VAXVMS)
- IRC = LIB$FIND_FILE(CHEOPS(1:LCHOPS)//'*.*',CHTEMP,ICONT)
- IC = LIB$FIND_FILE_END(ICONT)
- IF(IRC.EQ.RMS$_DNF) THEN
- IF(IDEBFA.GT.-3) PRINT *,'FMCOPQ. directory ',
- + CHEOPS(1:LCHOPS),' does not exist - ',
- + 'cannot queue updates to CHEOPS server'
- LCHOPS = -1
- RETURN
- ENDIF
-#endif
-#if defined(CERNLIB_UNIX)
- INQUIRE(FILE=CHEOPS(1:LCHOPS),EXIST=IEXIST)
- IF(.NOT.IEXIST) THEN
- IF(IDEBFA.GT.-3) PRINT *,'FMCOPQ. directory ',
- + CHEOPS(1:LCHOPS),' does not exist - ',
- + 'cannot queue updates to CHEOPS server'
- IRC = 28
- LCHOPS = -1
- RETURN
- ENDIF
-#endif
- ENDIF
-
- IRC = 0
-
- IF(LCHOPS.LE.0) THEN
- IRC = -99
- RETURN
- ENDIF
-*
-* Are source and destination sites defined?
-*
- IF(LDSTST.EQ.0.OR.LSRCST.EQ.0) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMCOPQ. both source and destination',
- + ' sites must be defined'
- IRC = -98
- RETURN
- ENDIF
-*
-* Are they the same?
-*
- IF(CHSRCE(1:LSRCST).EQ.CHDEST(1:LDSTST)) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMCOPQ. error - source and ',
- + 'destination are the same'
- IRC = -97
- RETURN
- ENDIF
-
-
- LOLDFA = LBANK1
- LNEWFA = LBANK2
-*
-* Generate file name
-*
-#if defined(CERNLIB_IBMVM)
- CALL FMFNM(CHFILE)
- LFILE = LENOCC(CHFILE) + 3
- DISK = CMXDSK()
- CHFILE(LFILE-2:LFILE) = ' ' // DISK // '3'
- LDOT = INDEX(CHFILE(1:LFILE),'.')
- IF(LDOT.NE.0) CHFILE(LDOT:LDOT) = ' '
-#endif
-#if defined(CERNLIB_VAXVMS)||defined(CERNLIB_UNIX)
- CALL FMFNME(CHFILE)
- LFILE = LENOCC(CHFILE)
-#endif
-
- IF(IDEBFA.GE.3) PRINT *,'FMCOPQ. queue file is ',
- + CHFILE(1:LFILE)
-*
-* Open output file
-*
-#if defined(CERNLIB_IBMVM)
- OPEN(LUFZFA,FILE='/'//CHFILE(1:LFILE),STATUS='NEW',
- + ACCESS='SEQUENTIAL',ACTION='WRITE',FORM='FORMATTED',
- + IOSTAT=IRC)
-#endif
-#if defined(CERNLIB_VAXVMS)
- OPEN(LUFZFA,FILE=CHEOPS(1:LCHOPS)//CHFILE(1:LFILE),
-#endif
-#if defined(CERNLIB_UNIX)
- OPEN(LUFZFA,FILE=CHEOPS(1:LCHOPS)//'/'//CHFILE(1:LFILE),
-#endif
-#if defined(CERNLIB_VAXVMS)||defined(CERNLIB_UNIX)
- + STATUS='NEW',ACCESS='SEQUENTIAL',
- + FORM='FORMATTED',IOSTAT=IRC)
-#endif
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMCOPQ. cannot open output file'
- RETURN
- ENDIF
-*
-* Write header
-*
-* TRANS_TYPE=REQUEST
-* RQ_SRC_SITE=CERN
-* SRC_SITE=CERN
-* DST_SITE=LISBOA
-* DATASET_SIZE=10000
-* RQID=ID234567
-* EXPIR_DAT=unknown
-* COMPL_CODE=0
-* COMPL_DATE=unknown
-* COMPL_STR=unknown
-* LOCAL_FNAME=unknown
-
- LEND = LENOCC(FATTOP)
- LSTA = INDEXB(FATTOP(1:LEND),'/') + 1
-
- IC = FMHOST(CHHOST,CHTYPE,CHSYS)
- IC = FMACNT(CHACNT)
-#if !defined(CERNLIB_VAXVMS)
- IC = FMUSER(CHUSER)
-#endif
-#if defined(CERNLIB_VAXVMS)
- IC = FMVUSR(CHUSER)
-#endif
-
- WRITE(LUFZFA,9001) 'TRANS_TYPE=REQUEST'
- WRITE(LUFZFA,9001) 'RQ_SRC_SITE=CERN'
- WRITE(LUFZFA,9001) 'SRC_SITE='//CHSRCE(1:LSRCST)
- WRITE(LUFZFA,9001) 'DST_SITE='//CHDEST(1:LDSTST)
- WRITE(LUFZFA,9001) 'DATASET_SIZE=10000'
- WRITE(LUFZFA,9001) 'RQID=ID234567'
- WRITE(LUFZFA,9001) 'EXPIR_DAT=unknown'
- WRITE(LUFZFA,9001) 'COMPL_CODE=0'
- WRITE(LUFZFA,9001) 'COMPL_DATE=unknown'
- WRITE(LUFZFA,9001) 'COMPL_STR=unknown'
- WRITE(LUFZFA,9001) 'LOCAL_FNAME=unknown'
- WRITE(LUFZFA,9001) 'USER='//CHUSER
- WRITE(LUFZFA,9001) 'HOST='//CHHOST
- WRITE(LUFZFA,9001) 'ACCOUNT='//CHACNT
- WRITE(LUFZFA,9001) 'GROUP='//FATTOP(LSTA:LEND)
- WRITE(LUFZFA,9001) 'ORIGIN=FATMEN'
- WRITE(LUFZFA,9001) 'LOCATION=unknown'
- WRITE(LUFZFA,9001) 'INT_PARAM=unknown'
-*
-* Write bank information
-*
- CALL FMBTOA(GENAM1,LBANK1,KEYS1,'S',IRC)
- CALL FMBTOA(GENAM2,LBANK2,KEYS2,'D',IRC)
-*
-* Close and rename/send
-*
- CLOSE(LUFZFA)
-*
-* Update user comment field
-*
- CALL DATIME(IDATE,ITIME)
- WRITE(COMM,'(A33,I6,A4,I4)')
- + 'Copy request queued to CHEOPS on ',IDATE,' at ',ITIME
- CALL UCTOH(COMM,IQ(LBANK2+KOFUFA+MUCMFA),4,80)
-*
-* Update catalogue with output file
-*
- CALL FMMOD(GENAM2,LBANK2,IFLAG,IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMCOPQ. error updating ',
- + 'catalogue with output file information'
- RETURN
- ENDIF
-#if defined(CERNLIB_IBMVM)
-*
-* Sendfile to server
-*
- CALL VMCMS('EXEC SENDFILE '//CHFILE(1:LFILE)//' TO FMCHEOPS',IRC)
-#endif
-#if defined(CERNLIB_VAXVMS)||defined(CERNLIB_UNIX)
-*
-* Rename file
-*
- LDOT = INDEX(CHFILE(1:LFILE),'.')
- CHFOUT = CHFILE(1:LFILE)
- CHFOUT(LDOT:LDOT) = '_'
- CHFOUT(LFILE-3:LFILE) = '.req'
-#endif
-#if defined(CERNLIB_VAXVMS)
- ISTAT = LIB$RENAME_FILE(CHEOPS(1:LCHOPS)//CHFILE(1:LFILE),
- + CHEOPS(1:LCHOPS)//CHFOUT(1:LFILE),,,,,,,,,,)
-#include "fatmen/fatvaxrc.inc"
-#endif
-#if defined(CERNLIB_UNIX)
- IRC = SYSTEMF('mv '//CHEOPS(1:LCHOPS)//'/'//CHFILE(1:LFILE)//
- + ' ' //CHEOPS(1:LCHOPS)//'/'//CHFOUT(1:LFILE))
-#endif
-
-9001 FORMAT(A)
-
- END
diff --git a/src/packlib/fatmen/fatutil/fmdate.F b/src/packlib/fatmen/fatutil/fmdate.F
deleted file mode 100644
index 5710bfe..0000000
--- a/src/packlib/fatmen/fatutil/fmdate.F
+++ /dev/null
@@ -1,51 +0,0 @@
-*
-* $Id: fmdate.F,v 1.1.1.1 1996/03/07 15:18:05 mclareni Exp $
-*
-* $Log: fmdate.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:05 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- INTEGER FUNCTION FMDATE(JULIAN)
-*CMZ : 22/01/91 13.35.07 by Jamie Shiers
-*-- Author : Jamie Shiers 22/01/91
-*
-* Function to convert julian date to YYMMDD form
-*
- INTEGER NDAYS(12),NLEAP(12)
-
- DATA NDAYS/00,31,59,90,120,151,181,212,243,273,304,334/
- DATA NLEAP/00,31,60,91,121,152,182,213,244,274,305,335/
-*
- FMDATE = 0
-
- IYEA = JULIAN/1000
- ITMP = JULIAN - IYEA * 1000
-
- IF(MOD(IYEA,4).EQ.0) THEN
- DO 10 I=1,11
- IF(ITMP.LT.NLEAP(I+1)) GOTO 20
- 10 CONTINUE
- I = 12
- 20 CONTINUE
- IMON = I
- IF(IMON.GT.1) THEN
- IDAY = ITMP - NLEAP(I-1)
- ELSE
- IDAY = ITMP
- ENDIF
- ELSE
- DO 30 I=1,11
- IF(ITMP.LT.NDAYS(I+1)) GOTO 40
- 30 CONTINUE
- I = 12
- 40 CONTINUE
- IMON = I
- IF(IMON.GT.1) THEN
- IDAY = ITMP - NDAYS(I-1)
- ELSE
- IDAY = ITMP
- ENDIF
- ENDIF
- END
diff --git a/src/packlib/fatmen/fatutil/fmdays.F b/src/packlib/fatmen/fatutil/fmdays.F
deleted file mode 100644
index f99bbd5..0000000
--- a/src/packlib/fatmen/fatutil/fmdays.F
+++ /dev/null
@@ -1,78 +0,0 @@
-*
-* $Id: fmdays.F,v 1.2 1998/02/13 14:01:20 jamie Exp $
-*
-* $Log: fmdays.F,v $
-* Revision 1.2 1998/02/13 14:01:20 jamie
-* Y2k mods
-*
-* Revision 1.1.1.1 1996/03/07 15:18:05 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMDAYS(GENAME,LBANK,KEYS,NDAYS,CHOPT,IRC)
-*CMZ : 22/01/91 14.11.49 by Jamie Shiers
-*-- Author : Jamie Shiers 22/01/91
- CHARACTER*(*) GENAME
- DIMENSION NDAYS(3),NPACK(3)
-*
-* On return, NDAYS(1) = number of days since creation date
-* NDAYS(2) = number of days since date catalogued
-* (added to FATMEN catalogue)
-* NDAYS(3) = number of days since last used
-*
-* IYEAR = YY; IYEARC = CCYY
-*
-#include "fatmen/slate.inc"
-#include "fatmen/fmnkeys.inc"
- DIMENSION KEYS(LKEYFA)
- INTEGER FMJULI
-#include "fatmen/fatbank.inc"
-#include "fatmen/fatpara.inc"
-#include "fatmen/fatopts.inc"
- IRC = 0
- LGN = LENOCC(GENAME)
- CALL DATIME(ID,IT)
- IYEARC = IS(1)
- IJ = FMJULI(ID)
- ICENT = IS(1)/100
- IF(LBANK.EQ.0) THEN
- CALL FMGETK(GENAME(1:LGN),LBANK,KEYS,IC)
- ENDIF
- CALL VZERO(IQUEST(11),3)
- CALL UCOPY(IQ(LBANK+KOFUFA+MCRTFA),NPACK,3)
- DO 10 I=1,3
- IF(NPACK(I).EQ.0) THEN
- NDAYS(I) = -1
- IQUEST(10+I) = -1
- GOTO 10
- ENDIF
- IC = 0
- CALL FMUPTM(IDATE,ITIME,NPACK(I),IC)
- IF(IC.NE.0) THEN
- NDAYS(I) = -2
- IQUEST(10+I) = -2
- GOTO 10
- ENDIF
- JDATE = FMJULI(IDATE)
- IYEAR = IJ/1000
- ITEMP = IJ - IYEAR*1000
- JYEAR = JDATE/1000
- JTEMP = JDATE - JYEAR*1000
- IF(IYEAR.EQ.JYEAR) THEN
- NDAYS(I) = ITEMP - JTEMP
- ELSE
- NLEAP = 0
- IF(JYEAR.LE.50) THEN
- JYEARC = 2000 + JYEAR
- ELSE
- JYEARC = 1900 + JYEAR
- ENDIF
-
- DO 20 J=IYEARC,JYEARC
- IF(MOD(J,4).EQ.0) NLEAP = NLEAP + 1
-20 CONTINUE
- NDAYS(I) = ITEMP + (IYEARC-JYEARC-1)*365 + 365-JTEMP + NLEAP
- ENDIF
-10 CONTINUE
- END
diff --git a/src/packlib/fatmen/fatutil/fmdump.F b/src/packlib/fatmen/fatutil/fmdump.F
deleted file mode 100644
index 28c5ea7..0000000
--- a/src/packlib/fatmen/fatutil/fmdump.F
+++ /dev/null
@@ -1,95 +0,0 @@
-*
-* $Id: fmdump.F,v 1.1.1.1 1996/03/07 15:18:05 mclareni Exp $
-*
-* $Log: fmdump.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:05 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMDUMP(GENAME,KEYS,NBYTES,NBLOCKS,NFILES,CODE,IRC)
-*
-* Request tape dump of VID corresponding to specified generic name
-*
-#include "fatmen/fmpath.inc"
-#include "fatmen/fatpara.inc"
-#include "fatmen/fatsel.inc"
-#include "fatmen/fatbank.inc"
- PARAMETER (LKEYFA=10)
- DIMENSION KEYS(LKEYFA)
- CHARACTER*(*) GENAME
- CHARACTER*(*) CODE
- CHARACTER*6 VID
- CHARACTER*15 XVID
- CHARACTER*8 VIP
- CHARACTER*255 COMAND
- INTEGER SYSTEMF
-#include "fatmen/tmsdef.inc"
- IRC = 0
-#if (!defined(CERNLIB_IBMVM))&&(!defined(CERNLIB_CRAY))
- PRINT *,'This routine is currently only available on VM/CMS and',
- + ' CRAY/Unicos systems'
- IRC = 99
- RETURN
-#endif
-#if defined(CERNLIB_IBMVM)||defined(CERNLIB_CRAY)
-*
-* Set media type range from 3480 to 3420
-*
- MRMTFA(1) = 2
- MRMTFA(2) = 3
- LGN = LENOCC(GENAME)
- CALL FMGETK(GENAME(1:LGN),LBANK,KEYS,IRC)
-*
-* Restore default FATMEN media type range
-*
- MRMTFA(1) = 1
- MRMTFA(2) = 3
- IF(IRC.NE.0) THEN
- PRINT *,'Return code ',IRC,' from FMGETK'
- RETURN
- ENDIF
-
- CALL FMGETC(LBANK,VID,MVIDFA,6,IRC)
- LVID = LENOCC(VID)
-*
-* Set IQUEST(11) to media type in case volume unknown or
-* TMS option not installed.
-*
- IQUEST(11) = IQ(LBANK+MMTPFA)
-#endif
-#if defined(CERNLIB_PREFIX)
- CALL FMXVID(VID,IQ(LBANK+MVIPFA),XVID,VIP,'C',IC)
- LXVID = LENOCC(XVID)
- CALL FMQTMS(XVID(1:LXVID),LIB,MODEL,DENS,MNTTYP,LABTYP,IC)
- IF(IC.EQ.100) THEN
- IF(IDEBFA.GE.0) PRINT *,'Volume ',XVID,' unknown to TMS'
- ENDIF
-#endif
-#if (!defined(CERNLIB_PREFIX))&&(defined(CERNLIB_IBMVM)||defined(CERNLIB_CRAY))
- CALL FMQTMS(VID(1:LVID),LIB,MODEL,DENS,MNTTYP,LABTYP,IC)
- IF(IC.EQ.100) THEN
- IF(IDEBFA.GE.0) PRINT *,'Volume ',VID,' unknown to TMS'
- ENDIF
-#endif
-#if defined(CERNLIB_IBMVM)||defined(CERNLIB_CRAY)
- LC = LENOCC(CODE)
- WRITE(COMAND,9001) VID,MODEL,NBYTES,NBLOCKS,NFILES,CODE(1:LC)
-#endif
-#if defined(CERNLIB_CRAY)
-9001 FORMAT('dumptape -V ',A6,' -g ',A8,' -B ',I6,' - N 1,',I6,
- + ' -F ',I6,' -C ',A6)
- IF(IDEBFA.GE.0)
- +PRINT *,'FMDUMP. executing ',COMAND(1:LENOCC(COMAND))
- IRC = SYSTEMF(COMAND(1:LENOCC(COMAND)))
-#endif
-#if defined(CERNLIB_IBMVM)
-9001 FORMAT('EXEC DUMPTAPE VID ',A6,' DEVTYP ',A8,' BYTES ',I6,
- + ' BLOCKS ',I6,' FILES ',I6,' CODE ',A6)
- IF(IDEBFA.GE.0)
- +PRINT *,'FMDUMP. executing ',COMAND(1:LENOCC(COMAND))
- CALL VMCMS(COMAND(1:LENOCC(COMAND)),IRC)
-#endif
-
- END
-
diff --git a/src/packlib/fatmen/fatutil/fmfzo.F b/src/packlib/fatmen/fatutil/fmfzo.F
deleted file mode 100644
index db02a0a..0000000
--- a/src/packlib/fatmen/fatutil/fmfzo.F
+++ /dev/null
@@ -1,496 +0,0 @@
-*
-* $Id: fmfzo.F,v 1.5 1996/06/26 12:34:40 jamie Exp $
-*
-* $Log: fmfzo.F,v $
-* Revision 1.5 1996/06/26 12:34:40 jamie
-* save lenf
-*
-* Revision 1.4 1996/04/12 07:55:40 cernlib
-* new handling of title string
-*
-* Revision 1.3 1996/03/29 11:29:53 jamie
-* qftitlch
-*
-* Revision 1.2 1996/03/28 10:28:53 jamie
-* update idatqq/itimqq and remove check on old version in fminit
-*
-* Revision 1.1.1.1 1996/03/07 15:18:04 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMFZO(COMM,GNAME,LENTRY,KEYS,IRC)
-*
-* Send update via FZOUT to local database server
-* Input is unit for FZ file, Command, Generic name and bank address
-* Command can be 'PUT, DEL, MDIR or DDIR'
-* LENTRY must be non zero for all operations except MDIR/DDIR
-*
-* User header of FZ file:
-* IUHEAD(1) = command
-* IUHEAD(2-70) = generic name
-* IUHEAD(71-80) = keys vector
-*
-* Monitoring information:
-* IUHEAD(81) = IHOWFA
-* IUHEAD(82) = ITIMFA
-*
-* IUHEAD(91-155) = CHFNFA
-*
-#include "fatmen/faust.inc"
-#include "fatmen/fausto.inc"
-#include "fatmen/fatmon.inc"
-#include "fatmen/fatbank.inc"
-#include "fatmen/fatpara.inc"
-#include "fatmen/fatsys.inc"
-#include "fatmen/fatupd.inc"
- DIMENSION LENTRY(1)
- CHARACTER*80 CHFORM
-#if defined(CERNLIB_IBMMVS)
- DIMENSION DISP(3)
- DIMENSION SPACE(4)
-#include "fatmen/fattyp.inc"
-#endif
- CHARACTER*(*) COMM, GNAME
- CHARACTER*20 FNAME
- CHARACTER*64 FUNAM
- CHARACTER*80 FILEDEF
- CHARACTER*132 FILEN,FILEM
- CHARACTER*1 OPT
- CHARACTER*2 FMODE
- CHARACTER*8 CHHOST,CHTYPE,CHSYS
-#if defined(CERNLIB_UNIX)
- INTEGER SYSTEMF
-#endif
-#if defined(CERNLIB_VAXVMS)
- CHARACTER*12 CHUSER
- INTEGER FMVUSR
-#endif
-#if !defined(CERNLIB_VAXVMS)
- CHARACTER*8 CHUSER
-#endif
- PARAMETER (NW=80)
- PARAMETER (MHEAD=200)
- INTEGER FMHOST,FMUSER
- PARAMETER (LKEYFA=10)
- DIMENSION KEYS(LKEYFA)
- DIMENSION IUHEAD(MHEAD),HEAD(MHEAD),IOCH(NW)
- DIMENSION IQSAVE(100)
- LOGICAL IEXIST,IOPEN
- EQUIVALENCE (IUHEAD(1),HEAD(1))
- SAVE NENTRY,NSEND,NBATCH,CHHOST,CHTYPE,CHSYS,CHUSER
- SAVE FILEN,LENF
- DATA IEV/1/
- DATA NSEND/0/
- DATA NBATCH/0/
- DATA NENTRY/0/
-
- IF(NENTRY.EQ.0) THEN
- NENTRY = 1
- IC = FMHOST(CHHOST,CHTYPE,CHSYS)
-#if defined(CERNLIB_VAXVMS)
- IC = FMVUSR(CHUSER)
-#endif
-#if !defined(CERNLIB_VAXVMS)
- IC = FMUSER(CHUSER)
-#endif
- CALL CLTOU(CHHOST)
- CALL CLTOU(CHUSER)
- ENDIF
-
- IF(LUFZFA.EQ.0)
- + CALL ZFATAM('FATMEN database is R/O - check call to FMINIT')
-
- NCH = LENOCC(GNAME)
-*
-* Replace operation from FMOPEN or FMCLOS?
-*
- IOPTC = 0
- IOPTO = 0
- IF(COMM(1:3).EQ.'MOD') THEN
- IF(COMM(4:4).EQ.'O') THEN
- IOPTO = 1
- CALL FMACL(CHUSER,CHHOST,GNAME(1:NCH),COMM,'U',IUP)
- IF(IUP.NE.0) THEN
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9001) GNAME(1:NCH)
- 9001 FORMAT(' FMFZO. updates turned off for path ',A)
- GOTO 999
- ENDIF
- ENDIF
- IF(COMM(4:4).EQ.'C') IOPTC = 1
- COMM(4:4) = ' '
- ENDIF
- IF(IDEBFA.GE.1) WRITE(LPRTFA,9002) COMM,GNAME(1:NCH)
- 9002 FORMAT(' FMFZO. enter for ',A,1X,A)
- IF(IDEBFA.GE.3.AND.COMM.NE.'LOG'.AND.
- + INDEX(COMM,'DIR').EQ.0) THEN
- WRITE(LPRTFA,9003)
- 9003 FORMAT(' FMFZO. output bank...')
- CALL FMSHOW(GNAME,LENTRY,KEYS,'A',IRC)
- ENDIF
-*
-* Security
-*
- IF(IOPTC+IOPTO.EQ.0.AND.COMM.NE.'LOG') THEN
- CALL FMACL(CHUSER,CHHOST,GNAME(1:NCH),COMM,'A',IRC)
- IF(IRC.NE.0) THEN
- NVIOL = NVIOL + 1
- IF(NVIOL.GT.MAXVIO) CALL ZFATAM
- + ('Maximum number of security violations exceeded')
- WRITE(LPRTFA,9004) COMM,GNAME(1:NCH)
- 9004 FORMAT(' FMFZO. you are not authorised to issue ',A,1X,A)
- GOTO 999
- ENDIF
- ENDIF
-*
-* Update protection
-*
- NUPDT = NUPDT + 1
- IF(NUPDT.EQ.MAXUPD) THEN
- IF(IDEBFA.GE.0) WRITE(LPRTFA,9005)
- 9005 FORMAT(' FMFZO. !!! warning - program will ',
- + 'crash if another FATMEN update is made !!!')
- ENDIF
-
- IF(NUPDT.GT.MAXUPD) CALL ZFATAM
- + ('Maximum number of updates exceeded')
-*
-* Header or header + bank?
-*
- OPT = 'S'
- IF(COMM.EQ.'LOG'.OR.INDEX(COMM,'DIR').NE.0) OPT = 'Z'
-*
-* Check generic name and build id of local service machine
-*
- IF((NCH.LT.3).OR.(GNAME(1:2).NE.'//').OR.
- + (GNAME(NCH:NCH).EQ.'/')) THEN
- WRITE (6, 9007) GNAME(1:NCH)
- IRC = 1
- GOTO 999
- ENDIF
-
- IFIRST = INDEX(GNAME(3:NCH),'/')
- IF(IFIRST.EQ.0) THEN
- WRITE(6,9007)GNAME(1:NCH)
- IRC = 1
- GOTO 999
- ENDIF
-
- IF(COMM.NE.'LOG') THEN
- ISEC = INDEX(GNAME(3+IFIRST:NCH),'/')
- IF (ISEC.EQ.0) THEN
- WRITE (6,9007) GNAME(1:NCH)
- IRC = 1
- GOTO 999
- ENDIF
-
- SERNAM = 'FM'//GNAME(3+IFIRST:1+IFIRST+ISEC)
-
- ELSE
-
- SERNAM = 'FM'//GNAME(3+IFIRST:)
-
- ENDIF
-
- LSN = LENOCC(SERNAM)
-*
-* Fill header vector
-*
- CALL UCTOH(COMM,IUHEAD,4,4)
-*
-* Logging
-*
- IF(COMM.EQ.'LOG') THEN
-*
-* Set I/O characteristic of header and fill
-*
- NHEAD = KLHOLL + KLREAL + KLDATE + KLCMOD +
- + KLFILE + KLTMS + KLCFAT
- WRITE(CHFORM,8001) KLHOLL,KLREAL,KLINT
-8001 FORMAT(I2,'H',1X,I2,'F',1X,I3,'I')
- CALL MZIOCH(IOCH,NW,CHFORM)
- CALL VBLANK(IUHEAD(2),KLHOLL-1)
- CALL VZERO(IUHEAD(KOREAL),KLREAL+KLINT)
-*
-* FATMEN system and group
-*
- CALL UCTOH(GNAME(3:),IUHEAD(KFMSYS),4,IFIRST-1)
- CALL UCTOH(GNAME(3+IFIRST:),IUHEAD(KFMGRP),4,NCH-IFIRST-2)
-*
-* PAM file title
-*
-#include "fatmen/qftitlch.inc"
- CALL UCTOH(
- + FatmenTitleFortranString
- + ,IUHEAD(KFMTIT),4,62)
-*
-* Username, node, type, OS
-*
- CALL UCTOH(CHUSER,IUHEAD(KFMUSR),4,LENOCC(CHUSER))
- CALL UCTOH(CHHOST,IUHEAD(KFMHST),4,LENOCC(CHHOST))
- CALL UCTOH(CHTYPE,IUHEAD(KFMTYP),4,LENOCC(CHTYPE))
- CALL UCTOH(CHSYS ,IUHEAD(KFMOS ),4,LENOCC(CHSYS ))
-*
-* MB read/written
-*
- HEAD(KFMMBR) = FATMBR
- HEAD(KFMMBW) = FATMBW
- HEAD(KFZMBR) = FATMZR
- HEAD(KFZMBW) = FATMZW
-*
-* MB copied
-*
- HEAD(KFMMBC) = FATMBC
- HEAD(KFMMBN) = FATMBN
- HEAD(KFMMBQ) = FATMBQ
-*
-* Time stamps
-*
- IDATQQ = 960328
- ITIMQQ = 1100
- CALL FMPKTM(IDATQQ,ITIMQQ,IUHEAD(KFMIDQ),IRC)
- CALL DATIME(IDEND,ITEND)
- CALL FMPKTM(NFSTAD,NFSTAT,IUHEAD(KFMIDS),IRC)
- CALL FMPKTM(IDEND ,ITEND ,IUHEAD(KFMIDE),IRC)
-*
-* All the other stuff
-*
- IUHEAD(KFMADD) = NFADDD
- IUHEAD(KFMADL) = NFADDL
- IUHEAD(KFMADT) = NFADDT
- IUHEAD(KFMMDR) = NFMDIR
- IUHEAD(KFMRDR) = NFRDIR
- IUHEAD(KFMRLN) = NFRLNK
- IUHEAD(KFMRTR) = NFRTRE
- IUHEAD(KFMRMF) = NFRMFL
- IUHEAD(KFMCPF) = NFCPFL
- IUHEAD(KFMMVF) = NFMVFL
- IUHEAD(KFMMOD) = NFMODI
- IUHEAD(KFMTCH) = NFTOUC
- IUHEAD(KFMOPN) = NFOPEN
- IUHEAD(KFMCLS) = NFCLOS
- IUHEAD(KFMCPY) = NFCOPY
- IUHEAD(KFMCPQ) = NFCOPQ
- IUHEAD(KFMCPN) = NFCOPR
- IUHEAD(KFMSRQ) = NFSREQ
- IUHEAD(KFMQVL) = NFQVOL
- IUHEAD(KFMAVL) = NFAVOL
- IUHEAD(KFMASP) = NFASPC
- IUHEAD(KFMPOL) = NFPOOL
- IUHEAD(KFMLCK) = NFLOCK
- IUHEAD(KFMULK) = NFULOK
- IUHEAD(KFMDTG) = NFDTAG
- IUHEAD(KFMGTG) = NFGTAG
- IUHEAD(KFMSTG) = NFSTAG
- IUHEAD(KFMBNK) = NFBANK
- IUHEAD(KFMGET) = NFGET
- IUHEAD(KFMGTK) = NFGETK
- IUHEAD(KFMSHW) = NFSHOW
- IUHEAD(KFMSCN) = NFSCAN
- IUHEAD(KFMLOP) = NFLOOP
- IUHEAD(KFMLDR) = NFLDIR
- IUHEAD(KFMLFL) = NFLFIL
- IUHEAD(KFMSRT) = NFSORT
- IUHEAD(KFMRNK) = NFRANK
- IUHEAD(KFMSLK) = NFSELK
- IUHEAD(KFMMTC) = NFMTCH
-
- IF(IDEBFA.GE.3) CALL FMPLOG(LPRTFA,IUHEAD,NHEAD,IRC)
-
- ELSE
-*
-* Fill with blanks for safety
-*
- CALL VBLANK(IUHEAD(2),69)
-
- CALL UCTOH(GNAME,IUHEAD(2),4,NCH)
-*
-* Keys
-*
- LEND = INDEXB(GNAME,'/') + 1
- FNAME = GNAME(LEND:NCH)
- IUHEAD(71) = KEYS(1)
- IUHEAD(77) = IQ(LENTRY(1)+MCPLFA+KOFUFA)
- IUHEAD(78) = IQ(LENTRY(1)+MMTPFA+KOFUFA)
- IUHEAD(79) = IQ(LENTRY(1)+MLOCFA+KOFUFA)
- IUHEAD(80) = LKEYFA
- LENFN = NCH-LEND+1
-*
-* IUHEAD 71-80 contains the keys, which includes the filename
-*
- FNAME(LENFN+1:) = ' '
- CALL UCTOH(FNAME,IUHEAD(72),4,20)
-*
-* Set up descriptor of header vector
-*
- IF(IOPTO.EQ.0) THEN
- CALL MZIOCH(IOCH,NW,'70H 1I 5H 4I')
- NHEAD = 80
- ELSE
- CALL MZIOCH(IOCH,NW,'70H 1I 5H 4I 1B 9I 64H')
-*
-* Monitoring information
-*
- NHEAD = 155
- IUHEAD(81) = IHOWFA
- IUHEAD(82) = ITIMFA
- CALL VZERO(IUHEAD(83),8)
- CALL VBLANK(IUHEAD(91),64)
- LNFNFA = LENOCC(CHFNFA)
- CHFNFA(LNFNFA+1:) = ' '
- CALL UCTOH(CHFNFA,IUHEAD(91),4,LNFNFA)
- IF(IDEBFA.GE.3) WRITE(LPRTFA,9006) IHOWFA,ITIMFA,
- + CHFNFA(1:LNFNFA)
- 9006 FORMAT(' FMFZO. IHOWFA: ',Z8,' ITIMFA: ',I6,' CHFNFA: ',A)
- ENDIF
-
- ENDIF
-
- 9007 FORMAT(' FMFZO - illegal generic name ',A)
-#if defined(CERNLIB_CZ)
- GOTO 20
-#endif
-*
-* Is the output file already open?
-*
- LUNFZ = IABS(LUFZFA)
-
- INQUIRE(LUNFZ,OPENED=IOPEN)
-
- IF(.NOT.IOPEN) THEN
-*
-* Get a unique file name
-*
- 10 CONTINUE
-#if defined(CERNLIB_IBMVM)
- IF(FATNOD.EQ.' '.AND.LUFZFA.GT.0) THEN
-*
-* Use spool
-*
- IF(INDEX(CHHOST,'CERNVMB').EQ.0) THEN
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9008) SERNAM(1:LSN)
- 9008 FORMAT(' FMFZO. issuing CP SPOOL PUNCH TO ',A)
- CALL VMCMS('CP SPOOL PUNCH TO '//SERNAM(1:LSN),IRC)
- ELSE
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9008) 'RSCS'
- CALL VMCMS('CP SPOOL PUNCH TO RSCS',IRC)
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9009) SERNAM(1:LSN)
- 9009 FORMAT(' FMFZO. issuing CP TAG DEV PUNCH CERNVM ',A)
- CALL VMCMS('CP TAG DEV PUNCH CERNVM ' //SERNAM(1:LSN),
- + IRC)
- ENDIF
-
- IF(IRC.NE.0) THEN
- WRITE(LPRTFA,*) 'FMFZO - Error from VMCMS, RC=',IRC
- GOTO 999
- ENDIF
-
- WRITE(FILEDEF,9010) LUFZFA
- 9010 FORMAT('FILEDEF ',I3,' PUNCH')
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9011) FILEDEF
- 9011 FORMAT(' FMFZO. issuing ',A)
- CALL VMCMS(FILEDEF,IRC)
- OPEN(LUFZFA,STATUS='NEW')
- GOTO 20
- ENDIF
-
- CALL FMFNME(FUNAM)
- FILEN = FUNAM // ' ' // LOCALQ(1:1)
- IDOT = INDEX(FILEN,'.')
- IF(IDOT.NE.0) FILEN(IDOT:IDOT) = ' '
-#endif
-#if !defined(CERNLIB_IBMVM)
- CALL FMJOUR(FUNAM)
- FILEN = LOCALQ(1:LENOCC(LOCALQ)) // FUNAM
- LENF = LENOCC(FILEN)
-#endif
-#if defined(CERNLIB_UNIX)
- CALL CUTOL(FILEN(1:LENF))
-#endif
-*
-* Does file already exist?
-*
-#if !defined(CERNLIB_IBM)
- INQUIRE(FILE=FILEN(1:LENF),EXIST=IEXIST)
-#endif
-#if defined(CERNLIB_IBM)
- INQUIRE(FILE='/'//FILEN(1:LENF),EXIST=IEXIST)
-#endif
- IF(IEXIST) THEN
- CALL SLEEPF(1)
- GOTO 10
- ENDIF
-*
-* Open output file
-*
-#if defined(CERNLIB_IBMMVS)
-*
-* Create new CARD file
-*
- LUNIT = LENOCC(CHMGEN(1))
- CALL FILEINF(ISTAT,'DEVICE',CHMGEN(1)(1:LUNIT),'TRK',1,
- + 'SECOND',1,'DIR',0, 'RECFM','FB','LRECL',80,'BLKSIZE',9040)
-#endif
-#if defined(CERNLIB_IBM)
- OPEN(LUNFZ,ERR=30 ,STATUS='NEW',ACCESS='SEQUENTIAL', FILE='/'
- + //FILEN(1:LENF), FORM='FORMATTED',ACTION='READWRITE')
-#endif
-#if defined(CERNLIB_VAXVMS)
- IF(STRMLF) THEN
-*
-* Required to write over NFS from VMS to Unix systems
-*
- OPEN(LUNFZ,STATUS='NEW',FILE=FILEN(1:LENF),ERR=30 ,
- + RECORDTYPE='STREAM_LF', FORM='FORMATTED')
- ELSE
- OPEN(LUNFZ,STATUS='NEW',FILE=FILEN(1:LENF),ERR=30 )
- ENDIF
-#endif
-#if defined(CERNLIB_UNIX)
- OPEN(LUNFZ,STATUS='NEW',FILE=FILEN(1:LENF),ERR=30 )
-#endif
- ENDIF
- NSEND = NSEND + 1
- 20 CONTINUE
-*
-* Write update
-*
-#if !defined(CERNLIB_CZ)
- CALL FZFILE(LUNFZ,0,'AO')
- CALL FZLOGL(LUNFZ,MAX(IDEBFA-2,-3))
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9012) COMM,OPT
- 9012 FORMAT(' FMFZO. call FZOUT for ',A,' opt ',A)
- CALL FZOUT(LUNFZ,IDIVFA,LENTRY(1),IEV,OPT,IOCH,NHEAD,IUHEAD)
- CALL FZENDO(LUNFZ,'T')
-#endif
-#if defined(CERNLIB_CZ)
-*
-* Send command to remote server
-*
- CALL CZPUTA('MESS :OU',ISTAT)
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9012) COMM,OPT
- CALL FZOUT(998,IDIVFA,LENTRY(1),IEV,OPT,IOCH,NHEAD,IUHEAD)
- GOTO 999
-#endif
-*
-* Send file?
-*
- IF(IDEBFA.GE.0) WRITE(LPRTFA,9013) COMM,GNAME(1:NCH)
- 9013 FORMAT(' FMFZO - update queued for processing (',A,1X,A,')')
- IF(NSEND.EQ.NGROUP.OR.NGROUP.EQ.0) THEN
- CLOSE(LUFZFA)
- NSEND = 0
- NBATCH = NBATCH + 1
- IF(IDEBFA.GE.0.AND.NGROUP.GT.1) WRITE(LPRTFA,9014) NBATCH
- 9014 FORMAT(' FMFZO. sending batch ',I6,' of updates to server')
-*
-* Send/rename/mv/XZPUTA,XZMV,XZLRM
-*
- CALL FMSEND(FILEN(1:LENF),IRC)
- ENDIF
- GOTO 999
- 30 CONTINUE
- WRITE(LPRTFA,9015) FILEN(1:LENF)
- 9015 FORMAT(' FMFZO - error opening temporary file, name=',A)
- 999 END
-
diff --git a/src/packlib/fatmen/fatutil/fmhunt.F b/src/packlib/fatmen/fatutil/fmhunt.F
deleted file mode 100644
index 6911103..0000000
--- a/src/packlib/fatmen/fatutil/fmhunt.F
+++ /dev/null
@@ -1,66 +0,0 @@
-*
-* $Id: fmhunt.F,v 1.2 1996/04/02 12:04:16 jamie Exp $
-*
-* $Log: fmhunt.F,v $
-* Revision 1.2 1996/04/02 12:04:16 jamie
-* save IQSAVE (for HP)
-*
-* Revision 1.1.1.1 1996/03/07 15:18:07 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMHUNT(GENAM,FILE,KEYS,CHOPT,IRC)
-*CMZ : 12/11/91 08.46.38 by Jamie Shiers
-*-- Author : Jamie Shiers 12/11/91
-*
-* Input:
-* GENAM The (wild-carded) generic name to hunt for
-* CHOPT Options
-*
-* Output:
-*
-* FILE Full generic name of matching file (if any)
-* KEYS KEYS vector of matching file
-*
-* IQUEST(10) = number levels in initial path
-* IQUEST(12) = number of subdirectories at this level
-* IQUEST(13) = number of elements selected pathname
-* IQUEST(14) = number of files in selected directory
-* IQUEST(15) = number of words per key
-* IQUEST(17) = number of this key vector
-*
- CHARACTER*(*) GENAM,FILE
- CHARACTER*255 CHCWD
- DIMENSION IQSAVE(10)
- SAVE IQSAVE
-#include "zebra/quest.inc"
-#include "fatmen/fahucm.inc"
-#include "fatmen/fatbug.inc"
- DIMENSION KEYS(LKEYFA)
- EXTERNAL FAHUNT
-#include "fatmen/fatopts.inc"
-
- IRC = 0
- LGN = LENOCC(GENAM)
- CALL FACDIR(CHCWD,'R')
- LCD = LENOCC(CHCWD)
- CHFILE = ' '
- IF(IDEBFA.GE.1) PRINT *,'FMHUNT. enter for ',GENAM(1:LGN)
-
- CALL FMLOOP(GENAM(1:LGN),-1,FAHUNT,IRC)
- CALL UCOPY(IQUEST(10),IQSAVE(10),10)
-
- CALL FACDIR(CHCWD(1:LCD),' ')
-
- LFI = LENOCC(CHFILE)
- IF(LFI.GT.0) THEN
- FILE = CHFILE(1:LFI)
- CALL UCOPY(IQSAVE(10),IQUEST(10),10)
- CALL UCOPY(KEYH,KEYS,LKEYFA)
- IRC = 0
- ELSE
- IRC = 1
- ENDIF
-
- END
diff --git a/src/packlib/fatmen/fatutil/fmiset.F b/src/packlib/fatmen/fatutil/fmiset.F
deleted file mode 100644
index bfac6b5..0000000
--- a/src/packlib/fatmen/fatutil/fmiset.F
+++ /dev/null
@@ -1,35 +0,0 @@
-*
-* $Id: fmiset.F,v 1.1.1.1 1996/03/07 15:18:05 mclareni Exp $
-*
-* $Log: fmiset.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:05 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- INTEGER FUNCTION FMISET(CHOPT,CHSET)
-*CMZ : 30/01/91 16.44.16 by Jamie Shiers
-*-- Author : Jamie Shiers 30/01/91
- CHARACTER*(*) CHOPT,CHSET
-#include "fatmen/fatbug.inc"
- FMISET = 0
-*
-* Check whether all characters in CHOPT are in CHSET
-*
- LCHOPT = LENOCC(CHOPT)
- LCHSET = LENOCC(CHSET)
-
- IF(IDEBFA.GE.4) PRINT *,'FMISET. checking that all characters ',
- + 'in ',CHOPT(1:LCHOPT),' are in ',CHSET(1:LCHSET)
-
- DO 10 I=1,LCHOPT
- IF(INDEX(CHSET(1:LCHSET),
- + CHOPT(I:I)).EQ.0) GOTO 20
-10 CONTINUE
-
- RETURN
-
-20 FMISET = I
- IF(IDEBFA.GE.4) PRINT *,'FMISET. first char. not in set = ',
- + CHOPT(I:I)
- END
diff --git a/src/packlib/fatmen/fatutil/fmjuli.F b/src/packlib/fatmen/fatutil/fmjuli.F
deleted file mode 100644
index cbfe4f7..0000000
--- a/src/packlib/fatmen/fatutil/fmjuli.F
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: fmjuli.F,v 1.1.1.1 1996/03/07 15:18:05 mclareni Exp $
-*
-* $Log: fmjuli.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:05 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- INTEGER FUNCTION FMJULI(IDATE)
-*CMZ : 22/01/91 13.35.07 by Jamie Shiers
-*-- Author : Jamie Shiers 22/01/91
-*
-* Function to convert date in form YYMMDD to julian format (YYDDD)
-*
- INTEGER NDAYS(12),NLEAP(12)
-
- DATA NDAYS/00,31,59,90,120,151,181,212,243,273,304,334/
- DATA NLEAP/00,31,60,91,121,152,182,213,244,274,305,335/
-*
- FMJULI = 0
- IDAY = MOD(IDATE,100)
- IYEA = IDATE/100
- IMON = MOD(IYEA,100)
- IYEA = IYEA/100
-
- IF(MOD(IYEA,4).EQ.0) THEN
- FMJULI = IYEA * 1000 + NLEAP(IMON) + IDAY
- ELSE
- FMJULI = IYEA * 1000 + NDAYS(IMON) + IDAY
- ENDIF
-
- END
diff --git a/src/packlib/fatmen/fatutil/fmkeys.F b/src/packlib/fatmen/fatutil/fmkeys.F
deleted file mode 100644
index d125c2e..0000000
--- a/src/packlib/fatmen/fatutil/fmkeys.F
+++ /dev/null
@@ -1,87 +0,0 @@
-*
-* $Id: fmkeys.F,v 1.1.1.1 1996/03/07 15:18:05 mclareni Exp $
-*
-* $Log: fmkeys.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:05 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMKEYS(MAXDIM,MAXKEY,IFIRST,ILAST,KEYS,NKEYS,IRC)
-*
-************************************************************************
-*
-* Returns the list of keys currently in the CWD
-* Input:
-* MAXDIM The actual first dimension of output array KEYS. It should
-* in principle be at least equal to the number of key elements
-* NWKEY as declared to RZMDIR.
-* MAXKEY The actual second dimension of output array KEYS
-* IFIRST The first key vector that should be returned in KEYS
-* ILAST The last key vector that should be returned in KEYS
-* Output:
-* KEYS* A 2-dimensional array dimensioned KEYS(MAXDIM,MAXKEY). It
-* will contain the key vectors associated with the CWD.
-* Its first index runs over the key elements for a given key,
-* while its second index runs over the different keys.
-* NKEYS* Actual number of keys present for the CWD.
-*
-* Called by <USER>
-*
-* Author : R.Brun DD/US/PD
-* Written : 05.04.86
-* Last mod: 29.10.90 Allow user to specify first and last key number
-* to avoid the use of massive matrices.
-*
-************************************************************************
-#include "zebra/rzcl.inc"
-#include "zebra/rzk.inc"
- DIMENSION KEYS(MAXDIM,MAXKEY)
-*
-*-----------------------------------------------------------------------
-*
- IRC = 0
- IQUEST(1) = 0
- NKEYS = 0
- IF(LQRS.EQ.0)GO TO 30
- IF(LCDIR.EQ.0)GO TO 30
- LS = IQ(KQSP+LCDIR+KLS)
- LK = IQ(KQSP+LCDIR+KLK)
- NK = IQ(KQSP+LCDIR+KNKEYS)
- NWK= IQ(KQSP+LCDIR+KNWKEY)
- NKEYS=NK
- IQUEST(11)=NK
- IQUEST(12)=NWK
- NWKEY=NWK
- IF(NWK.GT.MAXDIM)THEN
- IQUEST(1)=1
- IQUEST(11)=NKEYS
- IQUEST(12)=NWK
- NWKEY=MAXDIM
- ENDIF
-*
- NDONE = 0
- DO 20 I=IFIRST,MIN(ILAST,NKEYS)
-
- NDONE = NDONE + 1
- K=LK+(NWK+1)*(I-1)
- DO 10 J=1,NWK
- IKDES=(J-1)/10
- IKBIT1=3*J-30*IKDES-2
- IF(JBYT(IQ(KQSP+LCDIR+KKDES+IKDES),IKBIT1,3).LT.3)THEN
- KEYS(J,NDONE)=IQ(KQSP+LCDIR+K+J)
- ELSE
- CALL ZITOH(IQ(KQSP+LCDIR+K+J),KEYS(J,NDONE),1)
- ENDIF
- 10 CONTINUE
-
- IF(NDONE.EQ.MAXKEY) THEN
- IRC = 1
- GOTO 30
- ENDIF
-
- 20 CONTINUE
-*
- 30 IQUEST(13) = NDONE
- END
-
diff --git a/src/packlib/fatmen/fatutil/fmlcop.F b/src/packlib/fatmen/fatutil/fmlcop.F
deleted file mode 100644
index 75614d4..0000000
--- a/src/packlib/fatmen/fatutil/fmlcop.F
+++ /dev/null
@@ -1,61 +0,0 @@
-*
-* $Id: fmlcop.F,v 1.1.1.1 1996/03/07 15:18:07 mclareni Exp $
-*
-* $Log: fmlcop.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:07 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMLCOP(DSN1,DSN2,CHOPT,IRC)
-
- CHARACTER*(*) DSN1
- CHARACTER*(*) DSN2
- CHARACTER*255 CHDSN1,CHDSN2
-#include "fatmen/fatbug.inc"
- INTEGER SYSTEMF
-#if defined(CERNLIB_UNIX)
- CHARACTER*3 CHCOPY
-#endif
-#if defined(CERNLIB_VAXVMS)
-#include "fatmen/slate.inc"
- CHARACTER*255 CHFILE
- CHARACTER*18 CHCOPY
-#endif
-
-#include "fatmen/fatopts.inc"
-#if defined(CERNLIB_UNIX)
- CHCOPY = 'cp '
-#endif
-#if defined(CERNLIB_VAXVMS)
- CHCOPY = 'COPY/LOG/NOCONFIRM'
-#endif
-
- IRC = 0
-
- LDSN1 = LENOCC(DSN1)
- LDSN2 = LENOCC(DSN2)
- CHDSN1 = DSN1(1:LDSN1)
- CHDSN2 = DSN2(1:LDSN2)
-
-#if defined(CERNLIB_UNIX)
- IF(IOPTC.EQ.0) THEN
- CALL CUTOL(CHDSN1(1:LDSN1))
- CALL CUTOL(CHDSN2(1:LDSN2))
- ENDIF
-#endif
-#if defined(CERNLIB_VAXVMS)
-*
-* Search list handling...
-*
- CHFILE = CHDSN2(1:LDSN2)
- CALL FMXDSK(CHFILE(1:LDSN2),CHDSN2,IRC)
- LDSN2 = IS(1)
-#endif
-#if !defined(CERNLIB_IBM)
- IF(IDEBFA.GE.0) PRINT *,'FMLCOP. executing ',
- + CHCOPY//' '//CHDSN1(1:LDSN1)//' '//CHDSN2(1:LDSN2)
- IRC = SYSTEMF(CHCOPY//' '//CHDSN1(1:LDSN1)//' '//CHDSN2(1:LDSN2))
-#endif
-
- END
diff --git a/src/packlib/fatmen/fatutil/fmldir.F b/src/packlib/fatmen/fatutil/fmldir.F
deleted file mode 100644
index b7c3628..0000000
--- a/src/packlib/fatmen/fatutil/fmldir.F
+++ /dev/null
@@ -1,285 +0,0 @@
-*
-* $Id: fmldir.F,v 1.2 1996/04/02 09:52:57 jamie Exp $
-*
-* $Log: fmldir.F,v $
-* Revision 1.2 1996/04/02 09:52:57 jamie
-* save LOLD - crash on HP
-*
-* Revision 1.1.1.1 1996/03/07 15:18:05 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMLDIR(PATH,FILES,NFOUND,MAXFIL,ICONT,IRC)
-*
-************************************************************************
-*
-* To traverse the FATMEN directory tree starting from
-* the specified pathname.
-* Modified from the RZ routine RZSTAT / RZSCAN
-*
-************************************************************************
-#include "fatmen/faust.inc"
-#include "fatmen/slate.inc"
-#include "zebra/rzcl.inc"
-#include "zebra/rzdir.inc"
-#include "zebra/rzch.inc"
-#include "zebra/rzk.inc"
- CHARACTER*(*) PATH,FILES(MAXFIL)
- CHARACTER*255 CHPATH
- PARAMETER (MAXLEV=20)
- CHARACTER*16 DIRNAM(MAXLEV),CHDIR
- DIMENSION ISD(MAXLEV),NSD(MAXLEV),IHDIR(4)
- DIMENSION IOPTV(2)
- EQUIVALENCE (IOPTQ,IOPTV(1)), (IOPTX,IOPTV(2))
-#include "fatmen/farnge.inc"
-#include "fatmen/fatbug.inc"
- SAVE CHPATH,LPATH,LPATHI,DIRNAM,ISD,NSD,ITIME,LOLD
-*
-*-----------------------------------------------------------------------
-*
-*
- NFLDIR = NFLDIR + 1
- IRC = 0
- IQUEST(1) = 0
- IQUEST(11) = 0
- LPATH = LENOCC(PATH)
- LPATHI = LPATH
-
- NLEV = 99
- NFOUND = 0
- IF(ICONT.NE.0) GOTO 10
-
- CHPATH = PATH(1:LPATH)
- CALL CLTOU(CHPATH(1:LPATH))
-*
- ITEMP = 0
- CALL FACDIR(CHWOLD,'R')
- LOLD = LENOCC(CHWOLD)
- ITIME = 0
-*
-* Split input path name into its component pieces
-* (this is the opposite of RZPAFF which glues them together)
-*
- CALL FMPAFF(CHPATH(1:LPATH),DIRNAM,MAXLEV,IRET)
-*
-* Find first wild card in generic name
-*
- IF(IDEBFA.GE.3)
- +PRINT *,'FMLDIR. enter for PATH = ',CHPATH(1:LPATH)
- CALL FMNWRD('/',CHPATH(3:LPATHI),NLEV0)
- IWILD = ICFMUL('*%(<>',CHPATH,1,LPATH)
- IF(IWILD.LE.LPATH) THEN
- LPATH = INDEXB(CHPATH(1:IWILD),'/') - 1
- CALL FMNWRD('/',CHPATH(LPATH+2:LPATHI),NLEV1)
- NLEV = MIN(99,NLEV+NLEV1)
- ELSE
- LPATHI = LPATHI + 2
-* G.Folger "/*" would fool the cpp, so split it...
- CHPATH(LPATHI-1:LPATHI-1) = '/'
- CHPATH(LPATHI:LPATHI) = '*'
- ENDIF
-
- IF(IDEBFA.GE.3) PRINT *,'FMLDIR. show directories ',
- + 'below ',CHPATH(1:LPATH),' down ',NLEV,' levels'
-*
-* Set CWD to the current level
-*
- 10 CONTINUE
- IF(ITIME.NE.0)THEN
- CALL RZPAFF(CHPAT,NLPAT,CHL)
- IF(IQUEST(1).NE.0) THEN
- NLPAT = NLPAT -1
- GOTO 50
- ENDIF
- CALL FACDIR(CHL,' ')
- ELSE
- CALL FACDIR(CHPATH(1:LPATH),' ')
- IF(IQUEST(1).NE.0) THEN
- IRC = 1
- GOTO 80
- ENDIF
- NLPAT0=NLPAT
- CHL = CHPATH(1:LPATH)
- ENDIF
- IF(IQUEST(1).NE.0) THEN
- NLPAT = NLPAT -1
- GOTO 50
- ENDIF
-*
-* Ensure that entire path name matches before calling UROUT
-*
- CALL FMATCH(CHL,CHPATH(1:LPATHI),IRC)
- IF(IRC.EQ.0) THEN
- NFOUND = NFOUND + 1
- IF(NFOUND.LE.MAXFIL) THEN
- FILES(NFOUND) = CHL
- ELSE
- IRC = -1
- ICOUNT = 0
- NFOUND = MAXFIL
- RETURN
- ENDIF
- ENDIF
-
- ISD(NLPAT)=0
- NSD(NLPAT)=IQ(KQSP+LCDIR+KNSD)
-*
-* If there is a <> at this level, perform matching
-* and follow only that path
-*
- ILT = INDEX(DIRNAM(NLPAT+1),'<')
- IGT = INDEX(DIRNAM(NLPAT+1),'>')
- NFRNGE(NLPAT+1) = 0
-
- IF((ILT.NE.0).AND.(IGT.NE.0)) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMLDIR. invalid wild-carding ',
- + 'at level ',NLPAT,' in pathname - ',DIRNAM(NLPAT+1)
- IF(IDEBFA.GE.-3) PRINT *,'FMLDIR. only one of < or > ',
- + 'may be specified'
- IQUEST(1) = -1
- GOTO 60
- ENDIF
-
- IF(ILT+IGT.NE.0) THEN
-*
-* Is there a [mm:nn] syle range?
-*
- JR = LENOCC(DIRNAM(NLPAT+1))
- ISQ = INDEX(DIRNAM(NLPAT+1)(1:JR),'[')
- IF(ISQ.NE.0) THEN
- ILOW = ICDECI(DIRNAM(NLPAT+1),ISQ+1,JR)
- IF(IS(1).EQ.0) THEN
- IRC = 2
- IF(IDEBFA.GE.-3) PRINT *,'FMLDIR. error reading ',
- + 'decimal value from ',DIRNAM(NLPAT+1)(ISQ:JR)
- IF(IDEBFA.GE.-3) PRINT *,' Only integer ranges ',
- + 'are supported between [] characters, e.g. [10:20]'
- GOTO 80
- ENDIF
- IHIGH = ICDECI(DIRNAM(NLPAT+1),
- + INDEX(DIRNAM(NLPAT+1),':') + 1,JR)
- IF(IS(1).EQ.0) THEN
- IRC = 3
- IF(IDEBFA.GE.-3) PRINT *,'FMLDIR. error reading ',
- + 'decimal value from ',DIRNAM(NLPAT+1)(ISQ:JR)
- IF(IDEBFA.GE.-3) PRINT *,' Only integer ranges ',
- + 'are supported between [] characters, e.g. [10:20]'
- GOTO 80
- ENDIF
- IF(IDEBFA.GE.3) PRINT *,'FMLDIR. ilow/ihigh = ',ILOW,IHIGH
- NFRNGE(NLPAT+1) = 0
- IF(IHIGH-ILOW+1.GT.100) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMLDIR. maximum range is 100',
- + ' - excess elements will be ignored'
- IHIGH = ILOW + 99
- ENDIF
- DO 20 JJ=ILOW,IHIGH
- NFRNGE(NLPAT+1) = NFRNGE(NLPAT+1) + 1
- IFRNGE(NFRNGE(NLPAT+1),NLPAT+1) = JJ
- IFELEM(NFRNGE(NLPAT+1),NLPAT+1) = -1
- IF(ILT.NE.0) THEN
- IFVAL(NFRNGE(NLPAT+1),NLPAT+1) = 999999
- ELSE
- IFVAL(NFRNGE(NLPAT+1),NLPAT+1) = -1
- ENDIF
- 20 CONTINUE
- ENDIF
-*
-* Loop over all subdirectories at this level
-*
- DO 30 JJ=1,NSD(NLPAT)
- LS=IQ(KQSP+LCDIR+KLS)
- IH=LS+7*(JJ-1)
- CALL ZITOH(IQ(KQSP+LCDIR+IH),IHDIR,4)
- CALL UHTOC(IHDIR,4,CHDIR,16)
-*
-* Set IQUEST(13) to number of elements in directory name
-*
- IQUEST(13) = NLPAT
- CALL FASELP(CHDIR,DIRNAM(NLPAT+1),JJ,NSD(NLPAT),JINDEX,IRC)
- 30 CONTINUE
- IF(JINDEX.GT.0) THEN
- IF(NFRNGE(NLPAT+1).EQ.0) THEN
- IF(IDEBFA.GE.3) THEN
- LS=IQ(KQSP+LCDIR+KLS)
- IH=LS+7*(JINDEX-1)
- CALL ZITOH(IQ(KQSP+LCDIR+IH),IHDIR,4)
- CALL UHTOC(IHDIR,4,CHDIR,16)
- PRINT *,'FMLDIR. selected subdirectory ',CHDIR
- ENDIF
- NSD(NLPAT) = JINDEX
- ISD(NLPAT) = JINDEX - 1
- ELSE
- LS=IQ(KQSP+LCDIR+KLS)
- IF(IDEBFA.GE.3)
- + PRINT *,'FMLDIR. selected following subdirectories...'
- JMIN = 999999
- JMAX = 0
- DO 40 II=1,NFRNGE(NLPAT+1)
- JJ=IFELEM(II,NLPAT+1)
- IF(JJ.LE.0) GOTO 40
- IF(JJ.LT.JMIN) JMIN = JJ
- IF(JJ.GT.JMAX) JMAX = JJ
- IF(IDEBFA.GE.3) THEN
- IH=LS+7*(JJ-1)
- CALL ZITOH(IQ(KQSP+LCDIR+IH),IHDIR,4)
- CALL UHTOC(IHDIR,4,CHDIR,16)
- PRINT *,CHDIR
- ENDIF
- 40 CONTINUE
- NSD(NLPAT) = JMAX
- ISD(NLPAT) = JMIN - 1
- ENDIF
- ELSE
- IF(IDEBFA.GE.2)
- + PRINT *,'FMLDIR. no subdirectory matches'
- NSD(NLPAT) = 0
- ENDIF
- ELSE
- JINDEX = -1
- ENDIF
-*
-* Process possible down directories
-*
- 50 ISD(NLPAT)=ISD(NLPAT)+1
- IF((ISD(NLPAT).LE.NSD(NLPAT)).AND.
- + (NLPAT.LT.(NLPAT0+NLEV))) THEN
- IF(NFRNGE(NLPAT+1).NE.0
- + .AND.IUFIND(ISD(NLPAT),
- + IFELEM(1,NLPAT+1),1,NFRNGE(NLPAT+1)).GT.
- + NFRNGE(NLPAT+1)) GOTO 50
- NLPAT=NLPAT+1
- LS=IQ(KQSP+LCDIR+KLS)
- IH=LS+7*(ISD(NLPAT-1)-1)
- CALL ZITOH(IQ(KQSP+LCDIR+IH),IHDIR,4)
- CALL UHTOC(IHDIR,4,CHPAT(NLPAT),16)
- ITIME=ITIME+1
- GO TO 10
- ELSE
-*
-* Write information on current directory
-*
- CALL RZPAFF(CHPAT,NLPAT,CHL)
-* IF(NLPAT.LE.(NLPAT0+NLEV))THEN
-* NFOUND = NFOUND + 1
-* ENDIF
- NLPAT=NLPAT-1
- IF(NLPAT.GE.NLPAT0)THEN
- LUP=LQ(KQSP+LCDIR+1)
- CALL MZDROP(JQPDVS,LCDIR,' ')
- LCDIR=LUP
- GO TO 50
- ENDIF
- ENDIF
-*
-* Reset CWD
-*
- 60 CALL FACDIR(CHWOLD(1:LOLD),' ')
-*
- 70 CONTINUE
- IRC = 0
- 80 CONTINUE
- IQUEST(11) = NFOUND
- RETURN
- END
diff --git a/src/packlib/fatmen/fatutil/fmlink.F b/src/packlib/fatmen/fatutil/fmlink.F
deleted file mode 100644
index 4897126..0000000
--- a/src/packlib/fatmen/fatutil/fmlink.F
+++ /dev/null
@@ -1,136 +0,0 @@
-*
-* $Id: fmlink.F,v 1.1.1.1 1996/03/07 15:18:05 mclareni Exp $
-*
-* $Log: fmlink.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:05 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMLINK(GENEN,LBANK,CHOPT,IRC)
-*
-************************************************************************
-*
-* SUBR. FMLINK(GENEN,LBANK*,CHOPT,IRC)
-*
-* Return the address of the bank corresponding to GENEN
-*
-* GENEN generic file name
-*
-* LBANK bank address
-*
-* CHOPT character option: Q = 'QUIET'
-*
-* Called by User
-*
-* Error Condition :
-*
-* IQUEST(1) = 0 : No error
-* = 55 : Illegal Path name
-* = 56 : Illegal file name
-* = 57 : Path name cannot be found in the list of those
-* initialized
-* = 58 : File not "opened"
-*
-************************************************************************
-*
-#include "fatmen/fatbank.inc"
-#include "fatmen/fatpara.inc"
-*
- CHARACTER*(*) CHOPT
- CHARACTER GENEN*(*), PATHN*255, PATH*255,
- + PATHX*255, FNAME*20
- DIMENSION LBANK(9)
-*
-*______________________________________________________________________
-*
- LBANK(1) = 0
- IQUEST(1) = 0
- IRC = 0
-*
-* *** Find number of characters in the path name
-*
- NCH = LENOCC (GENEN)
- CALL CLTOU(GENEN)
- IF (NCH.LT.3.OR.GENEN(1:2).NE.'//'.OR.GENEN(NCH:NCH).EQ.'/') THEN
- IQUEST(1) = 55
- IF ((CHOPT(1:1) .NE. 'Q') .AND. (IDEBFA.GT.-3))
- + WRITE (LPRTFA, 1001) GENEN
- GO TO 999
- ENDIF
-*
-* *** Find file name
-*
- ICH = INDEXB(GENEN(1:NCH-1),'/')
- IF (ICH.LE.3.OR. NCH-ICH.GT.20) THEN
- IQUEST(1) = 56
- IF ((CHOPT(1:1) .NE. 'Q') .AND. (IDEBFA.GT.-3))
- + WRITE (LPRTFA, 1002) GENEN
- GO TO 999
- ENDIF
- PATHN = GENEN(1:ICH-1)
-CSELF,IF=-CZ.
-*
-*
-* *** Set the current directory (or create a new one)
-*
-C CALL FACDIR (PATHN, ' ')
-C IF (IQUEST(1).NE.0) CALL FATMDI (PATHN, LKEYFA, CHFOR, CHTAG)
-C CALL FACDIR (PATH, 'R')
-CSELF,IF=CZ.
- PATH=PATHN
-CSELF.
- NCHD = INDEX (PATH, ' ') - 1
- IF (NCHD.LE.0) NCHD = MAXLFA
-*
-* *** Check if the Path name matches
-*
- LSAVFA = LTOPFA
- 10 IF (LSAVFA.NE.0) THEN
- NCHR = IQ(KOFUFA+LSAVFA+MNCHFA)
- CALL UHTOC (IQ(KOFUFA+LSAVFA+MCHRFA), 4, PATHX, NCHR)
- IF (PATH(1:NCHR).NE.PATHX(1:NCHR)) THEN
- LSAVFA = LQ(KOFUFA+LSAVFA)
- GO TO 10
- ENDIF
- ELSE
- IQUEST(1) = 57
- IF ((CHOPT(1:1) .NE. 'Q') .AND. (IDEBFA.GT.-3))
- + WRITE (LPRTFA, 1003) PATH(1:NCHD)
- GO TO 999
- ENDIF
-*
-* *** Book-keeping
-*
- LBBKFA = LQ(KOFUFA+LSAVFA-KLBKFA)
- LBGNFA = LQ(KOFUFA+LSAVFA-KLGNFA)
-* find the bank adress
- NOPF = IQ(KOFUFA+LSAVFA+MNOPFA)
- IF (NOPF.NE.0) THEN
- LB = KOFUFA+LBBKFA
- DO 20 I=1,NOPF
- NCHR = IQ(LB+MCGNFA)
- IF (NCHR.NE.NCH) GO TO 21
- IPT = IQ(LB+MPNTFA)
- CALL UHTOC (IQ(KOFUFA+LBGNFA+IPT), 4, PATHX, NCHR)
- IF (GENEN(1:NCHR).EQ.PATHX(1:NCHR)) THEN
-* file found
- LBANK(1) = LQ(KOFUFA+LSAVFA-NSLUFA-I)
- GO TO 999
- ENDIF
-21 LB = LB + NWBKFA
-20 CONTINUE
- ENDIF
- IQUEST(1) = 58
- IF ((CHOPT(1:1) .NE. 'Q') .AND. (IDEBFA.GT.-3))
- + WRITE (LPRTFA, 1004) GENEN
-
-*
- 1001 FORMAT (/,' FMLINK : Illegal path name ',A)
- 1002 FORMAT (/,' FMLINK : Illegal file name ',A)
- 1003 FORMAT (/,' FMLINK : RZ file is not initialized for ',A)
- 1004 FORMAT (/,' FMLINK : File not opened for ',A)
-* END FMLINK
- 999 IF(IQUEST(1).NE.0) IRC = 1
- END
-
diff --git a/src/packlib/fatmen/fatutil/fmlist.F b/src/packlib/fatmen/fatutil/fmlist.F
deleted file mode 100644
index 0101e0f..0000000
--- a/src/packlib/fatmen/fatutil/fmlist.F
+++ /dev/null
@@ -1,89 +0,0 @@
-*
-* $Id: fmlist.F,v 1.1.1.1 1996/03/07 15:18:05 mclareni Exp $
-*
-* $Log: fmlist.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:05 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMLIST(CHPATH,FILES,KEYS,NFOUND,MAXFIL,IRC)
-*
-* Subroutine to return all generic names matching input
-* generic name pattern, which may include wild cards.
-* N.B. CHPATH is a pathname not a file name!
-*
-#include "fatmen/fatbank.inc"
- PARAMETER (LKEYFA=10)
- PARAMETER (NLEVEL=100)
- PARAMETER (MAXDIR=1000)
- CHARACTER*(*) CHPATH,FILES(MAXFIL)
- COMMON/FALIST/FNAMES,SUBDIR
- CHARACTER*20 FNAMES(MAXDIR),FNAME
- CHARACTER*255 SUBDIR(MAXDIR)
- DIMENSION KEYS(LKEYFA,MAXFIL)
-*
- NFOUND = 0
- IRC = 0
-*
-* Find first wild card in generic name
-*
- LPATH = LENOCC(CHPATH)
- IF(IDEBFA.GE.3)
- +PRINT *,'FMLIST. enter for PATH = ',CHPATH(1:LPATH)
- IWILD = ICFMUL('*%(',CHPATH,1,LPATH)
-
- IF(IWILD.GT.LPATH) THEN
- CALL FMFNMS(CHPATH(1:LPATH),FILES,KEYS,NFOUND,MAXFIL,IRC)
- IF(IRC.NE.0.AND.IDEBFA.GT.-3)
- + PRINT *,'FMLIST. Return code ',IRC,' from FMFNMS'
- DO 1 I=1,NFOUND
- FNAME = FILES(I)(1:LENOCC(FILES(I)))
-1 FILES(I) = CHPATH(1:LPATH)//'/'//FNAME(1:LENOCC(FNAME))
- RETURN
- ENDIF
-
- ISLASH = INDEXB(CHPATH(1:IWILD),'/')
-*
-* Find subdirectories below first branch
-*
- CALL FMTREE(CHPATH(1:ISLASH-1),SUBDIR,NLEVEL,NDIR,MAXDIR,IRC)
- IF(IRC.NE.0.AND.IDEBFA.GT.-3)
- +PRINT *,'FMLIST. Return code ',IRC,' from FMTREE'
- IF(IRC.EQ.0.AND.IDEBFA.GE.3)
- +PRINT *,'FMLIST. ',NDIR,' directories found below ',
- +CHPATH(1:ISLASH-1)
-*
-* Process each subdirectory in turn
-*
- NFOUND = 0
- DO 10 I=1,NDIR
-*
-* Match against input pattern
-*
- LDIR = LENOCC(SUBDIR(I))
- CALL FMATCH(SUBDIR(I)(1:LDIR),CHPATH(1:LPATH),IMAT)
- IF(IMAT.NE.0) GOTO 10
-*
-* Get files in current directory
-*
- NFILES = 0
- IF(NFOUND.LT.MAXFIL) THEN
- CALL FMFNMS(SUBDIR(I)(1:LDIR),FNAMES,KEYS(1,NFOUND+1),NFILES,
- + MAXFIL-NFOUND,IRC)
- IF(IRC.NE.0.AND.IDEBFA.GT.-3)
- +PRINT *,'FMLIST. Return code ',IRC,' from FMFNMS'
-
- IF(IDEBFA.GE.3) PRINT *,'FMLIST. ',NFILES,' files found in ',
- + SUBDIR(I)(1:LDIR)
- DO 20 J=1,NFILES
-20 FILES(NFOUND+J) = SUBDIR(I)(1:LDIR)//'/'//FNAMES(J)
- NFOUND = NFOUND + NFILES
- ELSE
- IF(IDEBFA.GE.1) PRINT *,'FMLIST. maximum number of files reached'
- IRC = -1
- RETURN
- ENDIF
-10 CONTINUE
- END
-
diff --git a/src/packlib/fatmen/fatutil/fmloop.F b/src/packlib/fatmen/fatutil/fmloop.F
deleted file mode 100644
index 6deba26..0000000
--- a/src/packlib/fatmen/fatutil/fmloop.F
+++ /dev/null
@@ -1,401 +0,0 @@
-*
-* $Id: fmloop.F,v 1.1.1.1 1996/03/07 15:18:06 mclareni Exp $
-*
-* $Log: fmloop.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:06 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMLOOP(PATH,NLEVEL,UROUT,IRC)
-*
-************************************************************************
-*
-* To traverse the FATMEN directory tree starting from
-* the specified pathname.
-* Modified from the RZ routine RZSTAT / RZSCAN
-*
-* This routine behaves like FMSCAN, but for files, rather than
-* directories.
-*
-* Input:
-* CHPATH The pathname of the starting directory
-* NLEVEL Number of levels below CHPATH about which space information
-* has to be accumulated.
-* UROUT External user routine to be called for each pathname
-*
-* Output:
-* IQUEST(10) = number levels in initial path
-* IQUEST(11) = number of directories found
-*
-* IQUEST(12) = number of subdirectories at this level
-* IQUEST(13) = number of elements in path name
-* IQUEST(14) = number of keys
-* IQUEST(15) = number of words per key
-* IQUEST(16) = incremental count of #keys selected
-* IQUEST(17) = number of this key vector
-*
-* Called by <USER>
-*
-*
-************************************************************************
-#include "fatmen/faust.inc"
-#include "fatmen/slate.inc"
-#include "zebra/rzcl.inc"
-#include "zebra/rzdir.inc"
-#include "zebra/rzch.inc"
-#include "zebra/rzk.inc"
- CHARACTER*(*) PATH
- CHARACTER*255 CHPATH
- CHARACTER*20 CHFILE,FNAME
- PARAMETER (MAXLEV=20)
- CHARACTER*16 DIRNAM(MAXLEV),CHDIR
- DIMENSION ISD(15),NSD(15),IHDIR(4)
- DIMENSION IOPTV(2)
- EQUIVALENCE (IOPTQ,IOPTV(1)), (IOPTX,IOPTV(2))
- EXTERNAL UROUT
-#include "fatmen/fmnkeys.inc"
- DIMENSION KEYS(LKEYFA)
-#include "fatmen/fatpara.inc"
-#include "fatmen/fatloc.inc"
-#include "fatmen/fatmtp.inc"
-#include "fatmen/fatcpl.inc"
-#include "fatmen/farnge.inc"
-#include "fatmen/fatbug.inc"
- SAVE DIRNAM
-*
-*-----------------------------------------------------------------------
-*
-*
-
- NFLOOP = NFLOOP + 1
- IRC = 0
- IQUEST(1) = 0
- IQUEST(11) = 0
- LPATH = LENOCC(PATH)
- CHPATH = PATH(1:LPATH)
- CALL CLTOU(CHPATH(1:LPATH))
-*
-* Find file name
-*
- LSLASH = INDEXB(CHPATH(1:LPATH),'/')
- CHFILE = CHPATH(LSLASH+1:LPATH)
- LFILE = LPATH - LSLASH
- LPATH = LSLASH - 1
- LPATHI = LPATH
-*
-* Get number of levels in initial path
-*
- CALL FMNWRD('/',CHPATH(3:LPATHI),NLEV0)
-*
-* Split input path name into its component pieces
-* (this is the opposite of RZPAFF which glues them together)
-*
- CALL FMPAFF(CHPATH(1:LPATH),DIRNAM,MAXLEV,IRET)
-*
-* Find first wild card in generic name
-*
- IF(IDEBFA.GE.3)
- +PRINT *,'FMLOOP. enter for PATH = ',CHPATH(1:LPATH),
- + ' file = ',CHFILE(1:LFILE)
- IWILD = ICFMUL('*%(<>',CHPATH,1,LPATH)
- IF(IWILD.LE.LPATH) THEN
- LPATH = INDEXB(CHPATH(1:IWILD),'/') - 1
- ENDIF
-*
- ITIME=0
- NLEV=NLEVEL
- IF(NLEV.LE.0)NLEV=99
- NFOUND = 0
- ITEMP = 0
- CALL FACDIR(CHWOLD,'R')
-*
-* Set CWD to the current level
-*
- 10 CONTINUE
- IF(ITIME.NE.0)THEN
- CALL RZPAFF(CHPAT,NLPAT,CHL)
- IF(IQUEST(1).NE.0) THEN
- NLPAT = NLPAT - 1
- GOTO 60
- ENDIF
- CALL FACDIR(CHL,' ')
- ELSE
- CALL FACDIR(CHPATH(1:LPATH),' ')
- IF(IQUEST(1).NE.0)GO TO 80
- NLPAT0=NLPAT
- CHL = CHPATH(1:LPATH)
- ENDIF
- IF(IQUEST(1).NE.0) THEN
- NLPAT = NLPAT - 1
- GOTO 60
- ENDIF
-*
-* Set IQUEST
-*
- IQUEST(10) = NLEV0
- IQUEST(12) = IQ(KQSP+LCDIR+KNSD)
- IQUEST(13) = NLPAT
- IQUEST(14) = IQ(KQSP+LCDIR+KNKEYS)
- IQUEST(15) = IQ(KQSP+LCDIR+KNWKEY)
- NWK = IQ(KQSP+LCDIR+KNWKEY)
- NKEYS = IQ(KQSP+LCDIR+KNKEYS)
- LK = IQ(KQSP+LCDIR+KLK)
-*
-* Ensure that entire path name matches before calling UROUT
-*
- CALL FMATCH(CHL,CHPATH(1:LPATHI),IRC)
-*
-* Trailing unmatched characters in CHPATH
-* Accept if first character is a / and total length
-* of pathname is ok
-*
- IF(IRC.EQ.2.AND.CHL(IQUEST(1):IQUEST(1)).EQ.'/'
- + .AND.NLPAT.LE.NLEV0+NLEV) IRC = 0
-
- IF(IRC.EQ.0) THEN
-*
-* Get the keys
-*
- NDONE = 0
- DO 30 I=1,NKEYS
-*
-* Number of this key vector
-*
- IQUEST(17) = I
- K=LK+(NWK+1)*(I-1)
- DO 20 J=1,NWK
- IKDES=(J-1)/10
- IKBIT1=3*J-30*IKDES-2
- IF(JBYT(IQ(KQSP+LCDIR+KKDES+IKDES),IKBIT1,3).LT.3)THEN
- KEYS(J)=IQ(KQSP+LCDIR+K+J)
- ELSE
- CALL ZITOH(IQ(KQSP+LCDIR+K+J),KEYS(J),1)
- ENDIF
- 20 CONTINUE
- CALL UHTOC(KEYS(MKFNFA),4,FNAME,20)
- LF = LENOCC(FNAME)
-*
-* Check that keys match those selected
-* Location code:
-*
- IF(NUMLOC.GT.0) THEN
- IF(IUCOMP(KEYS(MKLCFA),MFMLOC,NUMLOC).EQ.0) THEN
- IF(IDEBFA.GE.3) PRINT *,'FMLOOP. candidate # ',I,
- + ' fails location code check'
- GOTO 30
- ENDIF
- ENDIF
-*
-* Copy level:
-*
- IF(NUMCPL.GT.0) THEN
- IF(IUCOMP(KEYS(MKCLFA),MFMCPL,NUMCPL).EQ.0) THEN
- IF(IDEBFA.GE.3) PRINT *,'FMLOOP. candidate # ',I,
- + ' fails copy level check'
- GOTO 30
- ENDIF
- ENDIF
-*
-* Media type:
-*
- IF(NUMMTP.GT.0) THEN
- IF(IUCOMP(KEYS(MKMTFA),MFMMTP,NUMMTP).EQ.0) THEN
- IF(IDEBFA.GE.3) PRINT *,'FMLOOP. candidate # ',I,
- + ' fails media type check'
- GOTO 30
- ENDIF
- ENDIF
-*
-* File name:
-*
- LF = LENOCC(FNAME)
-*
-* Fast check: CHFILE = '*'
-*
- IF(CHFILE(1:LFILE).EQ.'*.') THEN
- IMAT = 0
- ELSE
- CALL FMATCH(FNAME(1:LF),CHFILE(1:LFILE),IMAT)
- ENDIF
-
- IF(IMAT.NE.0) THEN
- IF(IDEBFA.GE.3) PRINT *,'FMLOOP. candidate # ',I,
- + ' fails filename check'
- GOTO 30
- ENDIF
-*
-* Now call user routine
-*
- NDONE = NDONE + 1
- IQUEST(16) = NDONE
- CALL UROUT(CHL(1:LENOCC(CHL))//'/'
- + //FNAME(1:LF),KEYS,IURC)
-*
-* Skip rest of this directory?
-*
- IF(IURC.LT.0) GOTO 40
-*
-* Finish now?
-*
- IF(IURC.GT.0) RETURN
- 30 CONTINUE
- 40 CONTINUE
- ENDIF
-
- ISD(NLPAT)=0
- NSD(NLPAT)=IQ(KQSP+LCDIR+KNSD)
-*
-* If there is a <> at this level, perform matching
-* and follow only that path
-*
- ILT = INDEX(DIRNAM(NLPAT+1),'<')
- IGT = INDEX(DIRNAM(NLPAT+1),'>')
- NFRNGE(NLPAT+1) = 0
-
- IF((ILT.NE.0).AND.(IGT.NE.0)) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMLOOP. invalid wild-carding ',
- + 'at level ',NLPAT,' in pathname - ',DIRNAM(NLPAT+1)
- IF(IDEBFA.GE.-3) PRINT *,'FMLOOP. only one of < or > ',
- + 'may be specified'
- IQUEST(1) = -1
- GOTO 70
- ENDIF
-
- IF(ILT+IGT.NE.0) THEN
-*
-* Is there a [mm:nn] syle range?
-*
- JR = LENOCC(DIRNAM(NLPAT+1))
- ISQ = INDEX(DIRNAM(NLPAT+1)(1:JR),'[')
- IF(ISQ.NE.0) THEN
- ILOW = ICDECI(DIRNAM(NLPAT+1),ISQ+1,JR)
- IF(IS(1).EQ.0) THEN
- IRC = -1
- IF(IDEBFA.GE.-3) PRINT *,'FMLOOP. error reading ',
- + 'decimal value from ',DIRNAM(NLPAT+1)(ISQ:JR)
- IF(IDEBFA.GE.-3) PRINT *,' Only integer ranges ',
- + 'are supported between [] characters, e.g. [10:20]'
- GOTO 80
- ENDIF
- IHIGH = ICDECI(DIRNAM(NLPAT+1),
- + INDEX(DIRNAM(NLPAT+1),':') + 1,JR)
- IF(IS(1).EQ.0) THEN
- IRC = -1
- IF(IDEBFA.GE.-3) PRINT *,'FMLOOP. error reading ',
- + 'decimal value from ',DIRNAM(NLPAT+1)(ISQ:JR)
- IF(IDEBFA.GE.-3) PRINT *,' Only integer ranges ',
- + 'are supported between [] characters, e.g. [10:20]'
- GOTO 80
- ENDIF
- IF(IDEBFA.GE.3) PRINT *,'FMLOOP. ilow/ihigh = ',ILOW,IHIGH
- NFRNGE(NLPAT+1) = 0
- IF(IHIGH-ILOW+1.GT.100) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMLOOP. maximum range is 100',
- + ' - excess elements will be ignored'
- IHIGH = ILOW + 99
- ENDIF
- DO 22 JJ=ILOW,IHIGH
- NFRNGE(NLPAT+1) = NFRNGE(NLPAT+1) + 1
- IFRNGE(NFRNGE(NLPAT+1),NLPAT+1) = JJ
- IFELEM(NFRNGE(NLPAT+1),NLPAT+1) = -1
- IF(ILT.NE.0) THEN
- IFVAL(NFRNGE(NLPAT+1),NLPAT+1) = 999999
- ELSE
- IFVAL(NFRNGE(NLPAT+1),NLPAT+1) = -1
- ENDIF
- 22 CONTINUE
- ENDIF
-*
-* Loop over all subdirectories at this level
-*
- DO 44 JJ=1,NSD(NLPAT)
- LS=IQ(KQSP+LCDIR+KLS)
- IH=LS+7*(JJ-1)
- CALL ZITOH(IQ(KQSP+LCDIR+IH),IHDIR,4)
- CALL UHTOC(IHDIR,4,CHDIR,16)
- CALL FASELP(CHDIR,DIRNAM(NLPAT+1),JJ,NSD(NLPAT),JINDEX,IRC)
- 44 CONTINUE
- IF(JINDEX.GT.0) THEN
- IF(NFRNGE(NLPAT+1).EQ.0) THEN
- IF(IDEBFA.GE.3) THEN
- LS=IQ(KQSP+LCDIR+KLS)
- IH=LS+7*(JINDEX-1)
- CALL ZITOH(IQ(KQSP+LCDIR+IH),IHDIR,4)
- CALL UHTOC(IHDIR,4,CHDIR,16)
- PRINT *,'FMLOOP. selected subdirectory ',CHDIR
- ENDIF
- NSD(NLPAT) = JINDEX
- ISD(NLPAT) = JINDEX - 1
- ELSE
- LS=IQ(KQSP+LCDIR+KLS)
- IF(IDEBFA.GE.3)
- + PRINT *,'FMLOOP. selected following subdirectories...'
- JMIN = 999999
- JMAX = 0
- DO 50 II=1,NFRNGE(NLPAT+1)
- JJ=IFELEM(II,NLPAT+1)
- IF(JJ.LE.0) GOTO 50
- IF(JJ.LT.JMIN) JMIN = JJ
- IF(JJ.GT.JMAX) JMAX = JJ
- IF(IDEBFA.GE.3) THEN
- IH=LS+7*(JJ-1)
- CALL ZITOH(IQ(KQSP+LCDIR+IH),IHDIR,4)
- CALL UHTOC(IHDIR,4,CHDIR,16)
- PRINT *,CHDIR
- ENDIF
- 50 CONTINUE
- NSD(NLPAT) = JMAX
- ISD(NLPAT) = JMIN - 1
- ENDIF
- ELSE
- IF(IDEBFA.GE.2)
- + PRINT *,'FMLOOP. no subdirectory matches'
- NSD(NLPAT) = 0
- ENDIF
- ELSE
- JINDEX = -1
- ENDIF
-*
-* Process possible down directories
-*
- 60 ISD(NLPAT)=ISD(NLPAT)+1
- IF((ISD(NLPAT).LE.NSD(NLPAT)).AND.
- + (NLPAT.LT.(NLPAT0+NLEV))) THEN
- IF(NFRNGE(NLPAT+1).NE.0
- + .AND.IUFIND(ISD(NLPAT),
- + IFELEM(1,NLPAT+1),1,NFRNGE(NLPAT+1)).GT.
- + NFRNGE(NLPAT+1)) GOTO 60
- NLPAT=NLPAT+1
- LS=IQ(KQSP+LCDIR+KLS)
- IH=LS+7*(ISD(NLPAT-1)-1)
- CALL ZITOH(IQ(KQSP+LCDIR+IH),IHDIR,4)
- CALL UHTOC(IHDIR,4,CHPAT(NLPAT),16)
- ITIME=ITIME+1
- GO TO 10
- ELSE
-*
-* Write information on current directory
-*
- CALL RZPAFF(CHPAT,NLPAT,CHL)
- IF(NLPAT.LE.(NLPAT0+NLEV))THEN
- NFOUND = NFOUND + 1
- ENDIF
- NLPAT=NLPAT-1
- IF(NLPAT.GE.NLPAT0)THEN
- LUP=LQ(KQSP+LCDIR+1)
- CALL MZDROP(JQPDVS,LCDIR,' ')
- LCDIR=LUP
- GO TO 60
- ENDIF
- ENDIF
-*
-* Reset CWD
-*
- 70 CALL FACDIR(CHWOLD,' ')
-*
- 80 CONTINUE
- IRC = IQUEST(1)
- IQUEST(11) = NFOUND
- RETURN
- END
diff --git a/src/packlib/fatmen/fatutil/fmnode.F b/src/packlib/fatmen/fatutil/fmnode.F
deleted file mode 100644
index 29f7bc6..0000000
--- a/src/packlib/fatmen/fatutil/fmnode.F
+++ /dev/null
@@ -1,85 +0,0 @@
-*
-* $Id: fmnode.F,v 1.1.1.1 1996/03/07 15:18:05 mclareni Exp $
-*
-* $Log: fmnode.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:05 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- INTEGER FUNCTION FMNODE(NODE)
-*CMZ : 26/11/90 16.11.50 by Jamie Shiers
-*-- Author : Jamie Shiers 26/11/90
- CHARACTER*(*) NODE
- CHARACTER*8 TNODE
- INTEGER FMHOST
- CHARACTER*8 CHNODE,CHTYPE,CHSYS,CLUNAM,CLUNOD
-#include "fatmen/fatbug.inc"
-#if defined(CERNLIB_VAXVMS)
- INTEGER SYS$GETSYIW
- INCLUDE '($SSDEF)'
- STRUCTURE /ITMLST/
- UNION
- MAP
- INTEGER*2 BUFFER_LENGTH
- INTEGER*2 ITEM_CODE
- INTEGER*4 BUFFER_ADDRESS
- INTEGER*4 RETURN_LENGTH_ADDRESS
- ENDMAP
- MAP
- INTEGER*4 END_LIST /0/
- ENDMAP
- END UNION
- END STRUCTURE
-
- RECORD /ITMLST/ SYI_LIST(2)
-
- INCLUDE '($SYIDEF)'
-#endif
- FMNODE = 0
- LN = LENOCC(NODE)
- IF(IDEBFA.GE.2) PRINT *,'FMNODE. enter for ',NODE(1:LN)
- TNODE = NODE
- IC = FMHOST(CHNODE,CHTYPE,CHSYS)
- LCHN = LENOCC(CHNODE)
- IF(IDEBFA.GE.2) PRINT *,'FMNODE. current node is ',
- + CHNODE(1:LCHN)
-
- CALL CLTOU(TNODE)
- CALL CLTOU(CHNODE)
-*
-* Node names match...
-*
- IF(TNODE(1:LN).EQ.CHNODE(1:LCHN)) RETURN
-#if defined(CERNLIB_VAXVMS)
-*
-* Nodename specified is the VAXcluster alias
-*
- CALL FMGTLG('SYS$CLUSTER_NODE',CLUNAM,'LNM$SYSTEM',IRC)
- IF(IRC.EQ.0) THEN
- LENCLU = INDEX(CLUNAM,':') -1
- IF(IDEBFA.GE.2) PRINT *,'FMNODE. cluster alias is ',
- + CLUNAM(1:LENCLU)
- IF(TNODE(1:LN).EQ.CLUNAM(1:LENCLU)) RETURN
- ENDIF
-*
-* Check whether the node is in the same VAXcluster as us
-*
- MEMBER = 0
- SYI_LIST(1).BUFFER_LENGTH = 1
- SYI_LIST(1).ITEM_CODE = SYI$_CLUSTER_MEMBER
- SYI_LIST(1).BUFFER_ADDRESS = %LOC(MEMBER)
- SYI_LIST(1).RETURN_LENGTH_ADDRESS = %LOC(LENGTH)
- SYI_LIST(2).END_LIST = 0
-
- ISTAT = SYS$GETSYIW(,,TNODE(1:LN),SYI_LIST,,,)
-
-* IF (ISTAT .NE. SS$_NOSUCHNODE) GOTO 99
- IF(MEMBER.EQ.0) GOTO 99
- IF(IDEBFA.GE.2) PRINT *,'FMNODE. ',TNODE(1:LN),
- + ' is a VAXcluster member'
- RETURN
-#endif
-99 FMNODE = 1
- END
-
diff --git a/src/packlib/fatmen/fatutil/fmpaff.F b/src/packlib/fatmen/fatutil/fmpaff.F
deleted file mode 100644
index 4ea2f5e..0000000
--- a/src/packlib/fatmen/fatutil/fmpaff.F
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: fmpaff.F,v 1.1.1.1 1996/03/07 15:18:05 mclareni Exp $
-*
-* $Log: fmpaff.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:05 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMPAFF(CHPATH,CHPAFF,NLEVEL,IRC)
-*
-* Split the pathname in CHPATH into an array of component names
-* in CHPAFF
-*
- CHARACTER*20 PATH
- CHARACTER*(*) CHPATH,CHPAFF(NLEVEL)
-
-#include "fatmen/fatbug.inc"
- IRC = 0
-
- LPATH = LENOCC(CHPATH)
- CALL FMNWRD('/',CHPATH(3:LPATH),NWORDS)
- IF(NWORDS.GT.NLEVEL) IRET = -1
- IF(IDEBFA.GE.3) PRINT *,'FMPAFF. ',NWORDS,' words found in ',
- + CHPATH(3:LPATH)
-
- J = 0
- DO 10 I=1,MIN(NLEVEL,NWORDS)
- PATH = ' '
- CALL FMWORD(PATH,I-1,'/',CHPATH(3:LPATH),IC)
- IF(PATH.NE.'..') THEN
- J = J + 1
- CHPAFF(J) = PATH
- IF(IDEBFA.GE.3) PRINT *,'FMPAFF. word ',J,' = ',CHPAFF(J)
- ELSE
- IF(IDEBFA.GE.3) PRINT *,'FMPAFF. word .. discarded'
- J = J - 1
- ENDIF
-10 CONTINUE
-
- END
diff --git a/src/packlib/fatmen/fatutil/fmpstg.F b/src/packlib/fatmen/fatutil/fmpstg.F
deleted file mode 100644
index 21a8e88..0000000
--- a/src/packlib/fatmen/fatutil/fmpstg.F
+++ /dev/null
@@ -1,288 +0,0 @@
-*
-* $Id: fmpstg.F,v 1.1.1.1 1996/03/07 15:18:08 mclareni Exp $
-*
-* $Log: fmpstg.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:08 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMPSTG(GNAME,NNAMES,NFILES,NTAPES,CHOPT,IRC)
-*
-* CHOPT: F - stage only first tape
-* H - wHole volume staging, as for FMOPEN
-* L - override label with DCB information in catalogue
-*
- CHARACTER*(*) GNAME(NNAMES),CHOPT
- CHARACTER*255 GENAM,FSQSTR,CHCOMM
-
-#if defined(CERNLIB_UNIX)
- INTEGER SYSTEMF
-#endif
-
- CHARACTER*6 VID,VSN,VIDOLD,VSNOLD,FSEQ
-
- CHARACTER*40 DCB,DCBOLD
- CHARACTER*4 RECFM,RECFMO,LABOLD
-
- CHARACTER*8 CHOPTX,MODOLD
-
-#include "fatmen/fmnkeys.inc"
- DIMENSION KEYS(LKEYFA)
-#include "fatmen/fatpara.inc"
-#include "fatmen/fatbank.inc"
-#include "fatmen/fatopt0.inc"
-#include "fatmen/tmsdef.inc"
-#include "fatmen/fatopt1.inc"
-
- IRC = 0
- NDONE = 0
- NFILES = 0
- NTAPES = 0
- VIDOLD = ' '
- RECFMO = ' '
- LFLSTR = 0
- LMXSTR = LEN(FSQSTR)
-
- IF(IDEBFA.GE.1) WRITE(LPRTFA,9001) NNAMES,CHOPT
- 9001 FORMAT(' FMPSTG. enter for ',I6,' generic names, CHOPT = ',A)
-
-#if defined(CERNLIB_UNIX)
- IF(IOPTL.EQ.0) THEN
- IF(IDEBFA.GE.0) WRITE(LPRTFA,9002)
- 9002 FORMAT(' FMPSTG. option L turned on for Unix systems')
- IOPTL = 1
- ENDIF
-#endif
-#if defined(CERNLIB_VAXVMS)
- IF(IOPTL.NE.0) THEN
- IF(IDEBFA.GE.0) WRITE(LPRTFA,9003)
- 9003 FORMAT(' FMPSTG. option L not currently supported on VMS systems')
- IOPTL = 0
- ENDIF
-#endif
-
- DO 20 I=1,NNAMES
-
- LGN = LENOCC(GNAME(I))
- GENAM = GNAME(I)(1:LGN)
- CALL CLTOU(GENAM(1:LGN))
-
- IF(IDEBFA.GE.1) WRITE(LPRTFA,9004) I,GENAM(1:LGN)
- 9004 FORMAT(' FMPSTG. processing generic name # ',I6,/,
- + ' (',A,')')
-
- LBANK = 0
- CALL FMGET(GENAM,LBANK,KEYS,IRC)
- IF (IRC.NE.0) GOTO 999
-*
-* Is this entry a link?
-*
- IF(KEYS(MKLCFA).EQ.0) THEN
- CALL UHTOC(IQ(LBANK+KOFUFA+MFQNFA),4,GENAM,NFQNFA)
- NCH = LENOCC(GENAM)
- IF(IDEBFA.GE.0) WRITE(LPRTFA,9005) GNAME(I)(1:LGN),
- + GENAM(1:NCH)
- 9005 FORMAT(' FMPSTG. ',A,' --> ',A)
- NCH = LGN
- CALL VZERO(KEYS,LKEYFA)
- CALL MZDROP(IDIVFA,LBANK,'B')
- LBANK = 0
- CALL FMGET(GENAM,LBANK,KEYS,IRC)
- IF (IRC.NE.0) GOTO 999
- ENDIF
-*
-* Ignore disk files
-*
- IF(KEYS(MKMTFA).EQ.1) THEN
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9006) I
- 9006 FORMAT(' FMPSTG. generic name # ',I6,' points to a disk file',
- + ' - ignored')
- GOTO 10
- ENDIF
-
- NFILES = NFILES + 1
-
- CALL UHTOC(IQ(LBANK+KOFUFA+MVIDFA),4,VID,6)
- LVID = LENOCC(VID)
- CALL CLTOU(VID(1:LVID))
-
- CALL UHTOC(IQ(LBANK+KOFUFA+MVSNFA),4,VSN,6)
- LVSN = LENOCC(VSN)
- CALL CLTOU(VID(1:LVSN))
-
- CALL FMITOC(IQ(LBANK+KOFUFA+MFSQFA),FSEQ,LFSEQ)
-
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9007) VID(1:LVID),VSN(1:LVSN),
- + FSEQ(1:LFSEQ)
- 9007 FORMAT(' FMPSTG. processing VID: ',A,' VSN: ',A,' FSEQ: ',A)
-*
-* Option H - ignore if we have already seen this volume
-*
- IF(IOPTH.NE.0.AND.VID.NE.VIDOLD.AND.VSN.NE.VSNOLD) GOTO 10
-
-*
-* Set IQUEST(11) to media type in case volume unknown or
-* TMS option not installed.
-*
- IQUEST(11) = IQ(LBANK+KOFUFA+MMTPFA)
- CALL FMQTMS(VID(1:LVID),LIB,MODEL,DENS,MNTTYP,LABTYP,IC)
- IF(IDEBFA.GE.3) THEN
- PRINT *,'FMPSTG. return from FMQTMS with ', VID,'/',LIB,'/'
- + ,MODEL,'/',DENS,'/',MNTTYP,'/', LABTYP,'/',IC
- ENDIF
-
- LLAB = LENOCC(LABTYP)
-*
-* Get DCB information
-*
- CALL UHTOC(IQ(LBANK+KOFUFA+MRFMFA),4,RECFM,4)
- LRECL = IQ(LBANK+KOFUFA+MRLNFA)*4
- LBLOCK = IQ(LBANK+KOFUFA+MBLNFA)*4
-#if (defined(CERNLIB_UNIX))&&(defined(CERNLIB_SHIFT))
- IF(RECFM.EQ.'U') RECFM = 'F'
-#endif
-*
-* Issue stage request is this is the last generic name or if
-* we have switched to a new volume
-*
- IF(I.EQ.NNAMES.OR.
- + (VIDOLD.NE.' '.AND.VID.NE.VIDOLD.AND.VSN.NE.VSNOLD)) THEN
-
- NTAPES = NTAPES + 1
-
- IF(IOPTL.NE.0) THEN
-*
-* Add DCB information
-*
-#if !defined(CERNLIB_VAXVMS)
- WRITE(DCB,9008) RECFM,LRECL,LBLOCK
-#endif
-#if defined(CERNLIB_UNIX)
- 9008 FORMAT(' -F ',A,' -L ',I5,' -b ',I5)
-#endif
-#if defined(CERNLIB_IBMVM)
- 9008 FORMAT(' RECFM ',A,' LRECL ',I5,' BLKSIZE ',I5)
-#endif
- ENDIF
-*
-* Issue stage request for the previous volume
-*
-#if defined(CERNLIB_IBMVM)
- IF(IOPTH.NE.0) THEN
- FSQSTR = '1-E'
- LFLSTR = 3
- ENDIF
-
- CHCOMM = 'EXEC STAGE IN FT00F001 '//VSNOLD(1:LVSNO)//
- + '.'//FSQSTR(1:LFLSTR)//'.'//LABOLD(1:LLABO)//
- + '.'//VIDOLD(1:LVIDO)//' (NOWAIT)'
- LCOMM = LENOCC(CHCOMM)
-
- IF(IDEBFA.GE.0) WRITE(LPRTFA,9011) CHCOMM(1:LCOMM)
-
- CALL VMCMS(CHCOMM(1:LCOMM),IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.0) WRITE(LPRTFA,9009) CHCOMM(1:LCOMM)
- 9009 FORMAT(' FMPSTG. return code ',I6,' from VMCMS for ',A)
- GOTO 10
- ENDIF
-#endif
-#if defined(CERNLIB_UNIX)
- IF(IOPTH.NE.0) THEN
- FSQSTR = '1-'
- LFLSTR = 2
- ENDIF
-
- CHCOMM = 'stagein -G -v '//VSNOLD(1:LVSNO) // ' -q ' //
- + FSQSTR(1:LFLSTR) //' -V '//VIDOLD(1:LVIDO)//
-#endif
-#if (defined(CERNLIB_UNIX))&&(!defined(CERNLIB_TMS))
- + ' -l '//LABOLD(1:LLABO) // ' -g '//MODOLD(1:LMODO)//
-#endif
-#if defined(CERNLIB_UNIX)
- + DCBOLD(1:LDCBO) // ' -w T'//VIDOLD(1:LVIDO)//' &'
- LCOMM = LENOCC(CHCOMM)
-
- IF(IDEBFA.GE.0) PRINT 9010,CHCOMM(1:LCOMM)
- 9010 FORMAT(' FMPSTG. executing ',A)
-
- IRC = SYSTEMF(CHCOMM(1:LCOMM))
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.0) WRITE(LPRTFA,9009) CHCOMM(1:LCOMM)
- 9009 FORMAT(' FMPSTG. return code ',I6,' from SYSTEMF for ',A)
- GOTO 10
- ENDIF
-
-#endif
-#if defined(CERNLIB_VAXVMS)
- IF(IOPTH.EQ.0) THEN
- CHOPTX = 'Q'
- ELSE
- CHOPTX = 'HQ'
- ENDIF
-*
-* call FMOPEN with option Q (assume VAXTAP in server mode)
-*
- CALL FMOPEN(GENAM(1:LGN),'FMPSTG',LBANK,CHOPTX,IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.0) WRITE(LPRTFA,9009) GENAM(1:LGN)
- 9009 FORMAT(' FMPSTG. return code ',I6,' from FMOPEN for ',A)
- GOTO 10
- ENDIF
-#endif
- 9011 FORMAT(' FMPSTG. executing ',A)
-*
-* IOPTF: just first volume
-*
- IF(IOPTF.NE.0) THEN
- GOTO 10
- ENDIF
-
- NDONE = 0
-
- ENDIF
-*
-* Build file sequence string
-*
- IF(IOPTH.EQ.0) THEN
- IF(NDONE.EQ.0) THEN
- FSQSTR = FSEQ(1:LFSEQ)
- LFLSTR = LFSEQ
- ELSE
- IF(LFLSTR+1+LFSEQ.GT.LMXSTR) THEN
- IF(IDEBFA.GE.-3) WRITE(LPRTFA,9012) LMXSTR
- 9012 FORMAT(' FMPSTG. error - list of files cannot exceed ',I6,
- + ' characters')
- IRC = -1
- GOTO 10
- ENDIF
- FSQSTR(LFLSTR+1:) = ','//FSEQ(1:LFSEQ)
- LFLSTR = LFLSTR + LFSEQ + 1
- ENDIF
- ENDIF
-
- VIDOLD = VID(1:LVID)
- VSNOLD = VSN(1:LVSN)
- RECFMO = RECFM
- JRECL = LRECL
- JBLOCK = LBLOCK
- LABOLD = LABTYP(1:LLAB)
- MODOLD = MODEL
-#if !defined(CERNLIB_VAXVMS)
- DCBOLD = DCB
-#endif
- LVIDO = LVID
- LVSNO = LVSN
- LLABO = LLAB
- LMODO = LENOCC(MODOLD)
- LDCBO = LENOCC(DCBOLD)
-
- 10 CONTINUE
-
- CALL MZDROP(IDIVFA,LBANK,'B')
- LBANK = 0
-
- 20 CONTINUE
-
- 999 END
diff --git a/src/packlib/fatmen/fatutil/fmpurg.F b/src/packlib/fatmen/fatutil/fmpurg.F
deleted file mode 100644
index a173f48..0000000
--- a/src/packlib/fatmen/fatutil/fmpurg.F
+++ /dev/null
@@ -1,190 +0,0 @@
-*
-* $Id: fmpurg.F,v 1.1.1.1 1996/03/07 15:18:05 mclareni Exp $
-*
-* $Log: fmpurg.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:05 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMPURG(PATH,KEYSEL,MINSIZ,MINACC,MAXDYS,
- + MINCPS,LUNPUR,CHOPT,IRC)
-*CMZ : 25/01/91 14.15.46 by Jamie Shiers
-*-- Author : Jamie Shiers 25/01/91
-* Purge entries in PATH according to key selection in KEYSEL.
-* Files above escape deletion if their size is <= MINSIZ,
-* have been accessed at least MINACC times,
-* the last access being <= MAXDYS ago
-* and for which at least MINCPS copies exist.
-* Any check can be bypassed by coding a -1.
-*
-* CHOPT: P - simply print the usage statistics on these files
-* K - write a FATMEN KUMAC on LUNPUR for these files
-* R - remove these entries
-*
-#include "fatmen/fmnkeys.inc"
-#include "fatmen/fatbank.inc"
-#include "fatmen/fatpara.inc"
- DIMENSION KEYS(LKEYFA),KEYSEL(LKEYFA)
- DIMENSION NDAYS(3)
- CHARACTER*4 CHOPP
- CHARACTER*3 CHSTAT
- CHARACTER*12 KUMAC
- LOGICAL IEXIST
- CHARACTER*(*) PATH
-*
-* Maximum # of directories that can be processed per pass
-*
- PARAMETER (NMAX=100)
-*
-* Maximum # of files that can be processed per directory
-*
- PARAMETER (MAXFIL=1000)
- COMMON/FAPURG/PATHS,FILES
- CHARACTER*255 PATHS(NMAX),FILES(MAXFIL)
-#include "fatmen/fatopts.inc"
- IRC = 0
- ICONT = 0
- NPURG = 0
- LCH = LENOCC(CHOPT)
- CALL FMCHOP('FMPURG',CHOPT(1:LCH),'KPR',IC)
-*
-* Get list of directory names using FMLDIR...
-*
- 1 CONTINUE
- CALL FMLDIR(PATH,PATHS,NFOUND,NMAX,ICONT,IC)
- IF(IC.EQ.-1) THEN
- ICONT = 1
- IC = 0
- ELSE
- ICONT = 0
- ENDIF
- IF(IC.NE.0) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMPURG. return code ',IC,
- + ' from FMLDIR'
- GOTO 99
- ENDIF
- DO 10 I=1,NFOUND
- LP = LENOCC(PATHS(I))
- CALL FMUNIQ(PATHS(I)(1:LP),KEYSEL,FILES,MAXFIL,NMATCH,' ',IC)
- IF(IC.NE.0) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMPURG. return code ',IC, ' from '
- + //'FMUNIQ'
- GOTO 10
- ENDIF
-*
-* Process files in this directory
-*
- CHOPP = 'H'
- DO 20 J=1,NMATCH
- LF = LENOCC(FILES(J))
- CALL FMGET(FILES(J)(1:LF),LBANK,KEYS,IRC)
- IF(IRC.NE.0) THEN
- PRINT *,'FMPURG. error in FMGET for ',FILES(J)(1:LF)
- GOTO 99
- ENDIF
- IF(IOPTP.NE.0) THEN
- CALL FMPUSE(FILES(J)(1:LF),LBANK,KEYS,CHOPP,IC)
- CHOPP = ' '
- ENDIF
- ISIZE = IQ(LBANK+KOFUFA+MFSZFA)
- IUSE = IQ(LBANK+KOFUFA+MUSCFA)
- IF((ISIZE.LE.MINSIZ).OR.(MINSIZ.EQ.-1)) THEN
- IF(IDEBFA.GE.3) PRINT *,'FMPURG. File ',FILES(J)(1:LF),
- + ' passes file size cut. SIZE/CUT = ',ISIZE,'/',MINSIZ
- GOTO 30
- ELSE
- IF(IDEBFA.GE.3) PRINT *,'FMPURG. File ',FILES(J)(1:LF),
- + ' fails file size cut. SIZE/CUT = ',ISIZE,'/',MINSIZ
- ENDIF
-
- IF((IUSE .GE.MINACC).OR.(MINACC.EQ.-1)) THEN
- IF(IDEBFA.GE.3) PRINT *,'FMPURG. File ',FILES(J)(1:LF),
- + ' passes use count cut. NUSE/CUT = ',IUSE,'/',MINACC
- GOTO 30
- ELSE
- IF(IDEBFA.GE.3) PRINT *,'FMPURG. File ',FILES(J)(1:LF),
- + ' fails use count cut. NUSE/CUT = ',IUSE,'/',MINACC
- ENDIF
- CALL FMDAYS(FILES(J)(1:LF),LBANK,KEYS,NDAYS,' ',IRC)
- IF(IRC.NE.0) THEN
- PRINT *,'FMPURG. error in FMDAYS for ',FILES(J)(1:LF)
- GOTO 99
- ENDIF
-* Has file ever been accessed?
- IF(NDAYS(3).LT.0) THEN
- IF(IDEBFA.GE.3) PRINT *,'FMPURG. File ',FILES(J)(1:LF),
- + ' never used or last access date invalid - ',NDAYS(3)
- NDAYS(3) = 999
- ENDIF
- IF((NDAYS(3).LE.MAXDYS).OR.(MAXDYS.EQ.-1)) THEN
- IF(IDEBFA.GE.3) PRINT *,'FMPURG. File ',FILES(J)(1:LF),
- + ' passes last access cut. NDAYS/CUT = ',NDAYS(3),'/',
- + MAXDYS
- GOTO 30
- ELSE
- IF(IDEBFA.GE.3) PRINT *,'FMPURG. File ',FILES(J)(1:LF),
- + ' fails last access cut. NDAYS/CUT = ',NDAYS(3),'/',
- + MAXDYS
- ENDIF
- CALL FMEXST(FILES(J)(1:LF),NCOP)
- IF(NCOP.LE.MINCPS) THEN
- IF(IDEBFA.GE.3) PRINT *,'FMPURG. File ',FILES(J)(1:LF),
- + ' passes min. # copies cut. NCOP/CUT = ',NCOP,'/',
- + MINCPS
- GOTO 30
- ELSE
- IF(IDEBFA.GE.3) PRINT *,'FMPURG. File ',FILES(J)(1:LF),
- + ' fails min. # copies cut. NCOP/CUT = ',NCOP,'/',MINCPS
- ENDIF
-*
-* Candidate for removal...
-*
- IF(IOPTK.NE.0) THEN
- IF(NPURG.EQ.0) THEN
- KUMAC = 'FATPUR.KUMAC'
- LMAC = 12
-#if defined(CERNLIB_UNIX)
- CALL CUTOL(KUMAC)
-#endif
- INQUIRE(FILE=KUMAC(1:LMAC),EXIST=IEXIST)
- IF(IEXIST) THEN
- CHSTAT = 'OLD'
- ELSE
- CHSTAT = 'NEW'
- ENDIF
-#if defined(CERNLIB_IBMVM)
- CALL CTRANS('.',' ',KUMAC,1,LMAC)
- OPEN(LUNPUR,FILE='/'//KUMAC(1:LMAC),ACCESS='SEQUENTIAL',
-#endif
-#if !defined(CERNLIB_IBMVM)
- OPEN(LUNPUR,FILE=KUMAC(1:LMAC),ACCESS='SEQUENTIAL',
-#endif
- + STATUS=CHSTAT,FORM='FORMATTED',IOSTAT=IRC)
- IF(IRC.NE.0) THEN
- PRINT *,'FMPURG. return code ',IRC,' from OPEN'
- CALL MZDROP(IDIVFA,LBANK,' ')
- LBANK = 0
- GOTO 99
- ENDIF
- ENDIF
- WRITE(LUNPUR,'(1X,A,A,I6)') 'rm ',FILES(J)(1:LF),
- + KEYS(MKSRFA)
- ENDIF
- IF(IOPTR.NE.0) THEN
- CALL FMRM(FILES(J)(1:LF),LBANK,KEYS,IRC)
- IF(IRC.NE.0) THEN
- PRINT *,'FMPURG. return code ',IRC,' from FMRM'
- ENDIF
- ENDIF
- NPURG = NPURG + 1
-
- 30 CONTINUE
- CALL MZDROP(IDIVFA,LBANK,' ')
- LBANK = 0
- 20 CONTINUE
- 10 CONTINUE
- IF(ICONT.NE.0) GOTO 1
- 99 CONTINUE
- IF(IOPTK.NE.0) CLOSE(LUNPUR)
- END
diff --git a/src/packlib/fatmen/fatutil/fmrank.F b/src/packlib/fatmen/fatutil/fmrank.F
deleted file mode 100644
index 8b07baf..0000000
--- a/src/packlib/fatmen/fatutil/fmrank.F
+++ /dev/null
@@ -1,43 +0,0 @@
-*
-* $Id: fmrank.F,v 1.1.1.1 1996/03/07 15:18:07 mclareni Exp $
-*
-* $Log: fmrank.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:07 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMRANK(CHFILES,KEYS,NFILES,JSORT,CHOPT,IRC)
-#include "fatmen/faust.inc"
- CHARACTER*(*) CHFILES(NFILES)
- PARAMETER (MAXFIL=100)
- CHARACTER*12 CHVID(MAXFIL)
-#include "fatmen/fmnkeys.inc"
- DIMENSION KEYS(LKEYFA,NFILES)
- DIMENSION JSORT(NFILES)
-#include "fatmen/fatbank.inc"
-#include "fatmen/fatpara.inc"
-#include "fatmen/fatopts.inc"
-
- IRC = 0
-
- NFRANK = NFRANK + 1
-*
-* First loop over all files extracting the VID and FSEQ
-*
- DO 10 I=1,MIN(NFILES,MAXFIL)
-
- CALL FMGETK(CHFILES(I),LTDSFA,KEYS(1,I),IRC)
- IF(IRC.NE.0) GOTO 10
- CALL UHTOC(IQ(LTDSFA+KOFUFA+MVIDFA),4,CHVID(I),NVIDFA)
- WRITE(CHVID(I)(7:12),'(I6.6)') IQ(LTDSFA+KOFUFA+MFSQFA)
- CALL MZDROP(IXSTOR,LTDSFA,' ')
- LTDSFA = 0
-
-10 CONTINUE
-*
-* Now rank by VID/FSEQ combination
-*
- CALL SORTCH(CHVID,JSORT,MIN(NFILES,MAXFIL))
-
- END
diff --git a/src/packlib/fatmen/fatutil/fmrkey.F b/src/packlib/fatmen/fatutil/fmrkey.F
deleted file mode 100644
index 66ca23e..0000000
--- a/src/packlib/fatmen/fatutil/fmrkey.F
+++ /dev/null
@@ -1,69 +0,0 @@
-*
-* $Id: fmrkey.F,v 1.1.1.1 1996/03/07 15:18:08 mclareni Exp $
-*
-* $Log: fmrkey.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:08 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMRKEY(KEYO,KEYN,IRC)
-*
-#include "fatmen/fmnkeys.inc"
-#include "fatmen/fatbug.inc"
-#include "zebra/rzcl.inc"
-#include "zebra/rzk.inc"
- DIMENSION KEYO(LKEYFA),KEYN(LKEYFA)
-*
-*-----------------------------------------------------------------------
-*
- IRC = 0
- IFOUND = 0
- IF(LQRS.EQ.0) GOTO 40
- IF(LCDIR.EQ.0) GOTO 40
- LS = IQ(KQSP+LCDIR+KLS)
- LK = IQ(KQSP+LCDIR+KLK)
- NK = IQ(KQSP+LCDIR+KNKEYS)
- NWK= IQ(KQSP+LCDIR+KNWKEY)
-*
- DO 30 I=1,NK
-
- K=LK+(NWK+1)*(I-1)
- DO 10 J=1,NWK
- IKDES=(J-1)/10
- IKBIT1=3*J-30*IKDES-2
- IF(JBYT(IQ(KQSP+LCDIR+KKDES+IKDES),IKBIT1,3).LT.3)THEN
- IF(KEYO(J).NE.IQ(KQSP+LCDIR+K+J)) GOTO 30
- ELSE
- CALL ZITOH(IQ(KQSP+LCDIR+K+J),ITEMP,1)
- IF(KEYO(J).NE.ITEMP) GOTO 30
- ENDIF
- 10 CONTINUE
-*
-* Found matching key vector - update
-*
- IF(IDEBFA.GE.0) THEN
- PRINT 9001
-9001 FORMAT(' FMRKEY. updating key vector: OLD/NEW')
- CALL FMPKEY(KEYO,LKEYFA)
- CALL FMPKEY(KEYN,LKEYFA)
- ENDIF
-
- DO 20 J=1,NWK
- IKDES=(J-1)/10
- IKBIT1=3*J-30*IKDES-2
- IF(JBYT(IQ(KQSP+LCDIR+KKDES+IKDES),IKBIT1,3).LT.3)THEN
- IQ(KQSP+LCDIR+K+J) = KEYN(J)
- ELSE
- CALL ZHTOI(KEYN(J),IQ(KQSP+LCDIR+K+J),1)
- ENDIF
- 20 CONTINUE
-
- 30 CONTINUE
-
- 40 CONTINUE
-
- IF(IFOUND.EQ.0) IRC = 1
-*
- END
-
diff --git a/src/packlib/fatmen/fatutil/fmscan.F b/src/packlib/fatmen/fatutil/fmscan.F
deleted file mode 100644
index 42ed15f..0000000
--- a/src/packlib/fatmen/fatutil/fmscan.F
+++ /dev/null
@@ -1,299 +0,0 @@
-*
-* $Id: fmscan.F,v 1.1.1.1 1996/03/07 15:18:06 mclareni Exp $
-*
-* $Log: fmscan.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:06 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMSCAN(PATH,NLEVEL,UROUT,IRC)
-*
-************************************************************************
-*
-* To traverse the FATMEN directory tree starting from
-* the specified pathname.
-* Modified from the RZ routine RZSTAT / RZSCAN
-*
-*
-* Input:
-* CHPATH The pathname of the starting directory
-* NLEVEL Number of levels below CHPATH to descend
-* UROUT External user routine to be called for each pathname
-*
-* Output:
-* IQUEST(10) = number of elements in initial path
-* IQUEST(11) = number of directories found
-*
-* IQUEST(12) = number of subdirectories at this level
-* IQUEST(13) = number of elements in path name
-* IQUEST(14) = number of keys
-* IQUEST(15) = number of words per key
-*
-* Called by <USER>
-*
-*
-************************************************************************
-#include "fatmen/faust.inc"
-#include "fatmen/slate.inc"
-#include "zebra/rzcl.inc"
-#include "zebra/rzdir.inc"
-#include "zebra/rzch.inc"
-#include "zebra/rzk.inc"
- CHARACTER*(*) PATH
- CHARACTER*255 CHPATH
- PARAMETER (MAXLEV=20)
- CHARACTER*16 DIRNAM(MAXLEV),CHDIR
- DIMENSION ISD(MAXLEV),NSD(MAXLEV),IHDIR(4)
- DIMENSION IOPTV(2)
- EQUIVALENCE (IOPTQ,IOPTV(1)), (IOPTX,IOPTV(2))
- EXTERNAL UROUT
-#include "fatmen/farnge.inc"
-#include "fatmen/fatbug.inc"
- SAVE DIRNAM
-*
-*-----------------------------------------------------------------------
-*
-*
- NFSCAN = NFSCAN + 1
-
- IRC=0
- IQUEST(1) = 0
- IQUEST(11) = 0
- LPATH = LENOCC(PATH)
- LPATHI = LPATH
- CHPATH = PATH(1:LPATH)
- CALL CLTOU(CHPATH(1:LPATH))
-*
- ITIME = 0
- NLEV = NLEVEL
- IF(NLEV.LE.0) NLEV=99
- NFOUND = 0
- ITEMP = 0
- CALL FACDIR(CHWOLD,'R')
- LOLD = LENOCC(CHWOLD)
-*
-* Split input path name into its component pieces
-* (this is the opposite of RZPAFF which glues them together)
-*
- CALL FMPAFF(CHPATH(1:LPATH),DIRNAM,MAXLEV,IRET)
-*
-* Find first wild card in generic name
-*
- IF(IDEBFA.GE.3)
- +PRINT *,'FMSCAN. enter for PATH = ',CHPATH(1:LPATH)
- CALL FMNWRD('/',CHPATH(3:LPATHI),NLEV0)
- IWILD = ICFMUL('*%(<>',CHPATH,1,LPATH)
- IF(IWILD.LE.LPATH) THEN
- LPATH = INDEXB(CHPATH(1:IWILD),'/') - 1
- CALL FMNWRD('/',CHPATH(LPATH+2:LPATHI),NLEV1)
- NLEV = MIN(99,NLEV+NLEV1)
-* ELSE
-* LPATHI = LPATHI + 2
-* CHPATH(LPATHI-1:LPATHI) = '/*'
- ENDIF
-
- IF(IDEBFA.GE.3) PRINT *,'FMSCAN. show directories ',
- + 'below ',CHPATH(1:LPATH),' down ',NLEV,' levels'
-*
-* Set CWD to the current level
-*
- 10 CONTINUE
- IF(ITIME.NE.0)THEN
- CALL RZPAFF(CHPAT,NLPAT,CHL)
- IF(IQUEST(1).NE.0) THEN
- NLPAT = NLPAT - 1
- GOTO 50
- ENDIF
- CALL FACDIR(CHL,' ')
- ELSE
- CALL FACDIR(CHPATH(1:LPATH),' ')
- IF(IQUEST(1).NE.0)GO TO 70
- NLPAT0=NLPAT
- CHL = CHPATH(1:LPATH)
- ENDIF
- IF(IQUEST(1).NE.0) THEN
- NLPAT = NLPAT - 1
- GOTO 50
- ENDIF
-*
-* Set IQUEST
-*
- IQUEST(10) = NLEV0
- IQUEST(12) = IQ(KQSP+LCDIR+KNSD)
- IQUEST(13) = NLPAT
- IQUEST(14) = IQ(KQSP+LCDIR+KNKEYS)
- IQUEST(15) = IQ(KQSP+LCDIR+KNWKEY)
-*
-* Ensure that entire path name matches before calling UROUT
-*
- CALL FMATCH(CHL,CHPATH(1:LPATHI),IRC)
-*
-* Trailing unmatched characters in CHPATH
-* Accept if first character is a / and total length
-* of pathname is ok
-*
- IF(IRC.EQ.2.AND.CHL(IQUEST(1):IQUEST(1)).EQ.'/'
- + .AND.NLPAT.LE.NLEV0+NLEV) IRC = 0
-
- IF(IRC.EQ.0) THEN
- CALL UROUT(CHL,IURC)
- IF(IURC.NE.0) RETURN
- ENDIF
-
- ISD(NLPAT)=0
- NSD(NLPAT)=IQ(KQSP+LCDIR+KNSD)
-*
-* If there is a <> at this level, perform matching
-* and follow only that path
-*
- ILT = INDEX(DIRNAM(NLPAT+1),'<')
- IGT = INDEX(DIRNAM(NLPAT+1),'>')
- NFRNGE(NLPAT+1) = 0
-
- IF((ILT.NE.0).AND.(IGT.NE.0)) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMSCAN. invalid wild-carding ',
- + 'at level ',NLPAT,' in pathname - ',DIRNAM(NLPAT+1)
- IF(IDEBFA.GE.-3) PRINT *,'FMSCAN. only one of < or > ',
- + 'may be specified'
- IQUEST(1) = -1
- GOTO 60
- ENDIF
-
- IF(ILT+IGT.NE.0) THEN
-*
-* Is there a [mm:nn] syle range?
-*
- JR = LENOCC(DIRNAM(NLPAT+1))
- ISQ = INDEX(DIRNAM(NLPAT+1)(1:JR),'[')
- IF(ISQ.NE.0) THEN
- ILOW = ICDECI(DIRNAM(NLPAT+1),ISQ+1,JR)
- IF(IS(1).EQ.0) THEN
- IRC = -1
- IF(IDEBFA.GE.-3) PRINT *,'FMSCAN. error reading ',
- + 'decimal value from ',DIRNAM(NLPAT+1)(ISQ:JR)
- IF(IDEBFA.GE.-3) PRINT *,' Only integer ranges ',
- + 'are supported between [] characters, e.g. [10:20]'
- GOTO 70
- ENDIF
- IHIGH = ICDECI(DIRNAM(NLPAT+1),
- + INDEX(DIRNAM(NLPAT+1),':') + 1,JR)
- IF(IS(1).EQ.0) THEN
- IRC = -1
- IF(IDEBFA.GE.-3) PRINT *,'FMSCAN. error reading ',
- + 'decimal value from ',DIRNAM(NLPAT+1)(ISQ:JR)
- IF(IDEBFA.GE.-3) PRINT *,' Only integer ranges ',
- + 'are supported between [] characters, e.g. [10:20]'
- GOTO 70
- ENDIF
- IF(IDEBFA.GE.3) PRINT *,'FMSCAN. ilow/ihigh = ',ILOW,IHIGH
- NFRNGE(NLPAT+1) = 0
- IF(IHIGH-ILOW+1.GT.100) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMSCAN. maximum range is 100',
- + ' - excess elements will be ignored'
- IHIGH = ILOW + 99
- ENDIF
- DO 20 JJ=ILOW,IHIGH
- NFRNGE(NLPAT+1) = NFRNGE(NLPAT+1) + 1
- IFRNGE(NFRNGE(NLPAT+1),NLPAT+1) = JJ
- IFELEM(NFRNGE(NLPAT+1),NLPAT+1) = -1
- IF(ILT.NE.0) THEN
- IFVAL(NFRNGE(NLPAT+1),NLPAT+1) = 999999
- ELSE
- IFVAL(NFRNGE(NLPAT+1),NLPAT+1) = -1
- ENDIF
- 20 CONTINUE
- ENDIF
-*
-* Loop over all subdirectories at this level
-*
- DO 30 JJ=1,NSD(NLPAT)
- LS=IQ(KQSP+LCDIR+KLS)
- IH=LS+7*(JJ-1)
- CALL ZITOH(IQ(KQSP+LCDIR+IH),IHDIR,4)
- CALL UHTOC(IHDIR,4,CHDIR,16)
- CALL FASELP(CHDIR,DIRNAM(NLPAT+1),JJ,NSD(NLPAT),JINDEX,IRC)
- 30 CONTINUE
- IF(JINDEX.GT.0) THEN
- IF(NFRNGE(NLPAT+1).EQ.0) THEN
- IF(IDEBFA.GE.3) THEN
- LS=IQ(KQSP+LCDIR+KLS)
- IH=LS+7*(JINDEX-1)
- CALL ZITOH(IQ(KQSP+LCDIR+IH),IHDIR,4)
- CALL UHTOC(IHDIR,4,CHDIR,16)
- PRINT *,'FMSCAN. selected subdirectory ',CHDIR
- ENDIF
- NSD(NLPAT) = JINDEX
- ISD(NLPAT) = JINDEX - 1
- ELSE
- LS=IQ(KQSP+LCDIR+KLS)
- IF(IDEBFA.GE.3)
- + PRINT *,'FMSCAN. selected following subdirectories...'
- JMIN = 999999
- JMAX = 0
- DO 40 II=1,NFRNGE(NLPAT+1)
- JJ=IFELEM(II,NLPAT+1)
- IF(JJ.LE.0) GOTO 40
- IF(JJ.LT.JMIN) JMIN = JJ
- IF(JJ.GT.JMAX) JMAX = JJ
- IF(IDEBFA.GE.3) THEN
- IH=LS+7*(JJ-1)
- CALL ZITOH(IQ(KQSP+LCDIR+IH),IHDIR,4)
- CALL UHTOC(IHDIR,4,CHDIR,16)
- PRINT *,CHDIR
- ENDIF
- 40 CONTINUE
- NSD(NLPAT) = JMAX
- ISD(NLPAT) = JMIN - 1
- ENDIF
- ELSE
- IF(IDEBFA.GE.2)
- + PRINT *,'FMSCAN. no subdirectory matches'
- NSD(NLPAT) = 0
- ENDIF
- ELSE
- JINDEX = -1
- ENDIF
-*
-* Process possible down directories
-*
- 50 ISD(NLPAT)=ISD(NLPAT)+1
- IF((ISD(NLPAT).LE.NSD(NLPAT)).AND.
- + (NLPAT.LT.(NLPAT0+NLEV))) THEN
- IF(NFRNGE(NLPAT+1).NE.0
- + .AND.IUFIND(ISD(NLPAT),
- + IFELEM(1,NLPAT+1),1,NFRNGE(NLPAT+1)).GT.
- + NFRNGE(NLPAT+1)) GOTO 50
- NLPAT=NLPAT+1
- LS=IQ(KQSP+LCDIR+KLS)
- IH=LS+7*(ISD(NLPAT-1)-1)
- CALL ZITOH(IQ(KQSP+LCDIR+IH),IHDIR,4)
- CALL UHTOC(IHDIR,4,CHPAT(NLPAT),16)
- ITIME=ITIME+1
- GO TO 10
- ELSE
-*
-* Write information on current directory
-*
- CALL RZPAFF(CHPAT,NLPAT,CHL)
- IF(NLPAT.LE.(NLPAT0+NLEV))THEN
- NFOUND = NFOUND + 1
- ENDIF
- NLPAT=NLPAT-1
- IF(NLPAT.GE.NLPAT0)THEN
- LUP=LQ(KQSP+LCDIR+1)
- CALL MZDROP(JQPDVS,LCDIR,' ')
- LCDIR=LUP
- GO TO 50
- ENDIF
- ENDIF
-*
-* Reset CWD
-*
- 60 CALL FACDIR(CHWOLD(1:LOLD),' ')
-*
- 70 CONTINUE
- IRC = IQUEST(1)
- IQUEST(11) = NFOUND
- RETURN
- END
diff --git a/src/packlib/fatmen/fatutil/fmsend.F b/src/packlib/fatmen/fatutil/fmsend.F
deleted file mode 100644
index 2b63f07..0000000
--- a/src/packlib/fatmen/fatutil/fmsend.F
+++ /dev/null
@@ -1,157 +0,0 @@
-*
-* $Id: fmsend.F,v 1.1.1.1 1996/03/07 15:18:07 mclareni Exp $
-*
-* $Log: fmsend.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:07 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMSEND(FILEN,IRC)
- CHARACTER*(*) FILEN
- CHARACTER*255 CHFILE,CHDEST,CHTEMP
- CHARACTER*80 CHLINE
- INTEGER SYSTEMF
-#include "zebra/quest.inc"
-#include "fatmen/fatsys.inc"
-#include "fatmen/fatbug.inc"
-*
-* Send file 'CHFILE' to server
-*
- IRC = 0
- LFILE = LENOCC(FILEN)
- CHFILE = FILEN(1:LFILE)
- CALL FMJOUR(CHTEMP)
- LTEMP = LENOCC(CHTEMP)
- LDEF = LENOCC(DEFAULT)
-
- IF(FATNOD.EQ.' ') THEN
-*
-* 'Local' mode
-*
-#if defined(CERNLIB_VAXVMS)
-*
-* Now rename the file
-*
- CHDEST = DEFAULT(1:LDEF-1)//'.TODO'//DEFAULT(LDEF:LDEF)//
- + 'AA'//CHTEMP(3:LTEMP)
- LDEST = LDEF + LTEMP + 5
- IF(IDEBFA.GE.1) THEN
- WRITE(LPRTFA,9005)
- WRITE(LPRTFA,9006) CHFILE(1:LFILE)
- WRITE(LPRTFA,9007) CHDEST(1:LDEST)
- ENDIF
-
- ISTAT = LIB$RENAME_FILE(CHFILE(1:LFILE),
- + CHDEST(1:LDEST),,,,,,,,,,)
-#include "fatmen/fatvaxrc.inc"
-
-#endif
-#if defined(CERNLIB_UNIX)
-*
-* Now rename the file
-*
- CHDEST = DEFAULT(1:LDEF)//'/todo/aa'//CHTEMP(3:LTEMP)
- LDEST = LDEF + LTEMP + 6
- IF(IDEBFA.GE.1) THEN
- WRITE(LPRTFA,9005)
- WRITE(LPRTFA,9006) CHFILE(1:LFILE)
- WRITE(LPRTFA,9007) CHDEST(1:LDEST)
- ENDIF
- IRC = SYSTEMF('/bin/mv '//CHFILE(1:LFILE)
- + //' '//CHDEST(1:LDEST))
-#endif
-#if defined(CERNLIB_IBMVM)
- IF(LUFZFA.LT.0) THEN
-*
-* Send temporary file
-*
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9001) CHFILE(1:LFILE),SERNAM
- 9001 FORMAT(' FMSEND. issuing SENDFILE ',A,' to ',A)
- CALL VMCMS('EXEC SENDFILE '//CHFILE(1:LFILE)//
- + ' TO '//SERNAM,IRC)
- ELSE
-*
-* Spool file to server
-*
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9002)
- 9002 FORMAT(' FMSEND. issuing CP SPOOL PUNCH CLOSE')
- CALL VMCMS('CP SPOOL PUNCH CLOSE',IRC)
-
- ENDIF
-#endif
-#if defined(CERNLIB_IBMMVS)
-#endif
- ELSE
-*
-* 'CSPACK' mode
-*
-#if !defined(CERNLIB_CSPACK)
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9003)
- 9003 FORMAT(' FMSEND. error - CSPACK option has not been selected',
- + ' at installation time.')
- IRC = 99
- GOTO 30
-#endif
-#if defined(CERNLIB_CSPACK)
-*
-* Transfer update file
-*
- CHDEST = DEFAULT(1:LDEF)//'/todo/'//CHTEMP(1:LTEMP)
- LDEST = LDEF + LTEMP + 6
- IF(IDEBFA.GE.1) WRITE(LPRTFA,9004) CHFILE(1:LFILE),
- + CHDEST(1:LDEST)
- 9004 FORMAT(' FMSEND. transferring ',A,' to ',A)
-* CALL XZPUTA(CHFILE(1:LFILE),CHDEST(1:LDEST),' ',IRC)
-* IF(IRC.NE.0) GOTO 99
- LRECL = 80
- CALL SZOPEN(LUFZFA,CHFILE(1:LFILE),LRECL,'F',IRC)
- CALL XZOPEN(LUFZFA,CHDEST(1:LDEST),FATNOD,LRECL,'NOF',IRC)
- 10 CONTINUE
- READ(LUFZFA,'(A)',END=20) CHLINE
- LLINE = LENOCC(CHLINE)
- CALL XZPUTL(LUFZFA,CHLINE(1:LLINE),'(A)',' ',IRC)
- GOTO 10
- 20 CALL XZCLOS(LUFZFA,' ',IRC)
- CLOSE(LUFZFA)
-*
-* Rename update on remote node
-*
- IF(IDEBFA.GE.1) THEN
- WRITE(LPRTFA,9005)
- WRITE(LPRTFA,9006) CHDEST(1:LDEST)
- WRITE(LPRTFA,9007) CHTEMP(1:LDEST)
- ENDIF
- CHFILE = DEFAULT(1:LDEF)//'/todo/aa'//CHTEMP(3:LTEMP)
- CALL XZMV(CHDEST(1:LDEST),CHFILE(1:LDEST),' ',IRC)
- IF(IRC.NE.0) GOTO 30
-*
-* Remove local file
-*
- CHFILE = FILEN(1:LFILE)
-#endif
-#if (defined(CERNLIB_IBMVM))&&(defined(CERNLIB_CSPACK))
- CHTEMP = CHFILE(1:LFILE)
- CALL CTRANS('.',' ',CHTEMP,1,LFILE)
- CALL VMCMS('ERASE '//CHTEMP(1:LFILE),IRC)
-#endif
-#if (defined(CERNLIB_IBMMVS))&&(defined(CERNLIB_CSPACK))
- OPEN(LUFZFA,FILE='/'//CHFILE(1:LFILE),ACTION='READWRITE',
- + STATUS='OLD',FORM='FORMATTED')
- CLOSE(LUFZFA,STATUS='DELETE')
-#endif
-#if (defined(CERNLIB_VAXVMS))&&(defined(CERNLIB_CSPACK))
- ISTAT = LIB$DELETE_FILE(CHFILE(1:LFILE),,,,,,,,)
-#include "fatmen/fatvaxrc.inc"
-#endif
-#if (defined(CERNLIB_UNIX))&&(defined(CERNLIB_CSPACK))
- IRC = SYSTEMF('rm '//CHFILE(1:LFILE))
-#endif
- ENDIF
-
- 9005 FORMAT(' FMSEND. renaming update file')
- 9006 FORMAT(' FMSEND. old name = ',A)
- 9007 FORMAT(' FMSEND. new name = ',A)
- 30 CONTINUE
- IQUEST(1) = 0
- END
diff --git a/src/packlib/fatmen/fatutil/fmsetc.F b/src/packlib/fatmen/fatutil/fmsetc.F
deleted file mode 100644
index 3785156..0000000
--- a/src/packlib/fatmen/fatutil/fmsetc.F
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: fmsetc.F,v 1.1.1.1 1996/03/07 15:18:05 mclareni Exp $
-*
-* $Log: fmsetc.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:05 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMSETC(CPL,NCPL,IC)
-*CMZ : 22/01/91 16.33.20 by Jamie Shiers
-*-- Author : Jamie Shiers 22/01/91
-* Routine to set the copy level vector
-*
- INTEGER CPL(NCPL)
-#include "fatmen/fatpara.inc"
-#include "fatmen/fatbank.inc"
-#include "fatmen/fatcpl.inc"
- IC = 0
- NUMCPL = 0
- IF(NCPL.GT.KMXCPL) IC = 1
- DO 10 I=1,MIN(NCPL,KMXCPL)
- IF(CPL(I).LE.0) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMSETC. Invalid copy level ',CPL(I),
- + ' ignored. Location codes must be positive integers'
- IC = 2
- GOTO 10
- ENDIF
- NUMCPL = NUMCPL + 1
- MFMCPL(NUMCPL) = CPL(I)
-10 CONTINUE
- END
diff --git a/src/packlib/fatmen/fatutil/fmsetk.F b/src/packlib/fatmen/fatutil/fmsetk.F
deleted file mode 100644
index 99ccd22..0000000
--- a/src/packlib/fatmen/fatutil/fmsetk.F
+++ /dev/null
@@ -1,35 +0,0 @@
-*
-* $Id: fmsetk.F,v 1.1.1.1 1996/03/07 15:18:07 mclareni Exp $
-*
-* $Log: fmsetk.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:07 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMSETK(KEYM,NK,CHOPT,IRC)
-*CMZ : 18/10/91 10.54.50 by Jamie Shiers
-*-- Author : Jamie Shiers 18/10/91
-#include "fatmen/fatpara.inc"
-#include "fatmen/fatbank.inc"
-#include "fatmen/fmnkeys.inc"
- CHARACTER*(*) CHOPT
- DIMENSION KEYM(LKEYFA,NK)
-#include "fatmen/fatkey.inc"
-
- IRC = 0
- LCH = LENOCC(CHOPT)
-
- IF(LCH.GT.0) CHKEY = CHOPT(1:LCH)
-
- IF(NK.GT.KMXKEY) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMSETK. key matrix limited to ',
- + '99 rows - excess values discarded'
- IRC = 4
- ENDIF
-
- NUMKEY = MIN(KMXKEY,NK)
-
- CALL UCOPY(KEYM,MFMKEY,LKEYFA*NUMKEY)
-
- END
diff --git a/src/packlib/fatmen/fatutil/fmsetl.F b/src/packlib/fatmen/fatutil/fmsetl.F
deleted file mode 100644
index 17d5edd..0000000
--- a/src/packlib/fatmen/fatutil/fmsetl.F
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: fmsetl.F,v 1.1.1.1 1996/03/07 15:18:05 mclareni Exp $
-*
-* $Log: fmsetl.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:05 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMSETL(LOC,NLOC,IC)
-*CMZ : 22/01/91 16.33.20 by Jamie Shiers
-*-- Author : Jamie Shiers 22/01/91
-* Routine to set the location code vector
-*
- DIMENSION LOC(NLOC)
-#include "fatmen/fatpara.inc"
-#include "fatmen/fatbank.inc"
-#include "fatmen/fatloc.inc"
- IC = 0
- IF(NLOC.GT.KMXLOC) IC = 1
- NUMLOC = 0
- DO 10 I=1,MIN(NLOC,KMXLOC)
- IF(LOC(I).LE.0) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMSETL. Invalid location code ',
- + LOC(I),' ignored. Location codes must be positive integers'
- IC = 2
- GOTO 10
- ENDIF
- NUMLOC = NUMLOC + 1
- MFMLOC(NUMLOC) = LOC(I)
-10 CONTINUE
- END
diff --git a/src/packlib/fatmen/fatutil/fmsetm.F b/src/packlib/fatmen/fatutil/fmsetm.F
deleted file mode 100644
index 9742d43..0000000
--- a/src/packlib/fatmen/fatutil/fmsetm.F
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: fmsetm.F,v 1.1.1.1 1996/03/07 15:18:05 mclareni Exp $
-*
-* $Log: fmsetm.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:05 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMSETM(MTP,NMTP,IC)
-*CMZ : 22/01/91 16.33.20 by Jamie Shiers
-*-- Author : Jamie Shiers 22/01/91
-* Routine to set the media type vector
-*
- DIMENSION MTP(NMTP)
-#include "fatmen/fatpara.inc"
-#include "fatmen/fatbank.inc"
-#include "fatmen/fatmtp.inc"
- IC = 0
- NUMMTP = 0
- IF(NMTP.GT.KMXMTP) IC = 1
- DO 10 I=1,MIN(NMTP,KMXMTP)
- IF(MTP(I).LE.0) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMSETM. Invalid media type ',MTP(I),
- + ' ignored. Media types must be positive integers'
- IC = 2
- GOTO 10
- ENDIF
- NUMMTP = NUMMTP + 1
- MFMMTP(NUMMTP) = MTP(I)
-10 CONTINUE
- END
diff --git a/src/packlib/fatmen/fatutil/fmsetu.F b/src/packlib/fatmen/fatutil/fmsetu.F
deleted file mode 100644
index d0c1417..0000000
--- a/src/packlib/fatmen/fatutil/fmsetu.F
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: fmsetu.F,v 1.1.1.1 1996/03/07 15:18:05 mclareni Exp $
-*
-* $Log: fmsetu.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:05 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMSETU(LUN,NLUN,IC)
-*CMZ : 22/01/91 16.33.20 by Jamie Shiers
-*-- Author : Jamie Shiers 22/01/91
-* Routine to set the logical units that may be used by FATMEN
-*
- DIMENSION LUN(NLUN)
-#include "fatmen/fatpara.inc"
-#include "fatmen/fatbank.inc"
-#include "fatmen/fatlun.inc"
- IC = 0
- NUMLUN = 0
- IF(NLUN.GT.KMXLUN) IC = 1
- DO 10 I=1,MIN(NLUN,KMXLUN)
- IF((LUN(I).LE.0).OR.(LUN(I).GT.99)) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMSETU. Invalid logical unit ',LUN(I),
- + ' ignored. Logical units must be between 1-99'
- IC = 2
- GOTO 10
- ENDIF
- NUMLUN = NUMLUN + 1
- MFMLUN(NUMLUN) = LUN(I)
-10 CONTINUE
- END
diff --git a/src/packlib/fatmen/fatutil/fmsetv.F b/src/packlib/fatmen/fatutil/fmsetv.F
deleted file mode 100644
index 323508c..0000000
--- a/src/packlib/fatmen/fatutil/fmsetv.F
+++ /dev/null
@@ -1,21 +0,0 @@
-#include "fatmen/pilot.h"
- SUBROUTINE FMSETV(ICODE,IRC)
-#include "fatmen/fatveri.inc"
-#include "fatmen/fatbug.inc"
-
- IRC = 0
-
- IF(ICODE.NE.0.AND.ICODE.NE.1) THEN
-
- IF(IDEBFA.GE.0) WRITE(LPRTFA,9001) ICODE
-9001 FORMAT(' FMSETV. Error - ICODE must be 0',
- + ' or 1 (verification off/on) - ICODE = ',I6)
-
- IRC = 1
- RETURN
-
- ENDIF
-
- IFMVER = ICODE
-
- END
diff --git a/src/packlib/fatmen/fatutil/fmsort.F b/src/packlib/fatmen/fatutil/fmsort.F
deleted file mode 100644
index fb6ce86..0000000
--- a/src/packlib/fatmen/fatutil/fmsort.F
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: fmsort.F,v 1.1.1.1 1996/03/07 15:18:05 mclareni Exp $
-*
-* $Log: fmsort.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:05 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMSORT(FILES,KEYS,NFILES,JSORT,IRC)
-#include "fatmen/faust.inc"
-*
-* Subroutine to return in the array JSORT the indices
-* of FILES(I) and KEYS(LKEYFA,I) sorted in ascending order
-* according to contents of character array FILES
-*
- CHARACTER*(*) FILES(NFILES)
- PARAMETER (LKEYFA=10)
- DIMENSION KEYS(LKEYFA,NFILES)
- DIMENSION JSORT(NFILES)
-
- IRC = 0
- NFSORT = NFSORT + 1
- CALL SORTCH(FILES,JSORT,NFILES)
-
- END
-
diff --git a/src/packlib/fatmen/fatutil/fmstgq.F b/src/packlib/fatmen/fatutil/fmstgq.F
deleted file mode 100644
index 042281c..0000000
--- a/src/packlib/fatmen/fatutil/fmstgq.F
+++ /dev/null
@@ -1,113 +0,0 @@
-*
-* $Id: fmstgq.F,v 1.1.1.1 1996/03/07 15:18:07 mclareni Exp $
-*
-* $Log: fmstgq.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:07 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMSTGQ(VSN,VID,IFILE,LAB,IRC)
-*CMZ : 20/05/92 10.57.25 by Jamie Shiers
-*-- Author : Jamie Shiers 20/05/92
- CHARACTER*(*) VSN,VID,LAB
- CHARACTER*255 COMAND,CHLINE
-#if defined(CERNLIB_VAXVMS)||defined(CERNLIB_UNIX)
- CHARACTER*255 CHSTFL
- LOGICAL IEXIST
-#endif
-#if (defined(CERNLIB_VAXVMS))&&(defined(CERNLIB_VAXTAP))
- CHARACTER*255 CHGRP
-#include "fatmen/fatlab.inc"
-#endif
-#if defined(CERNLIB_PREFIX)
- CHARACTER*6 CHVSN,CHLAB,CHSEQ
- CHARACTER*15 CHVID,XVID,XVIP
-#endif
-#if !defined(CERNLIB_PREFIX)
- CHARACTER*6 CHVSN,CHVID,CHLAB,CHSEQ
-#endif
-#include "fatmen/fatbug.inc"
-
- IRC = 99
-*
-* Issue STAGE QUERY for specified volume and file
-*
- LVSN = LENOCC(VSN)
- LVID = LENOCC(VID)
- LLAB = LENOCC(LAB)
-
- CHVSN = VSN(1:LVSN)
- CHVID = VID(1:LVID)
- CHLAB = LAB(1:LLAB)
-
- CALL FMITOC(IFILE,CHSEQ,LFSEQ)
-
-#if defined(CERNLIB_PREFIX)
-*
-* Swap vid & prefix
-*
- LDOT = INDEX(VID(1:LVID),'.')
- XVIP = VID(LDOT+1:LVID)
- XVID = VID(1:LDOT-1)
- CHVID = XVID(1:LDOT-1) // '.' // XVIP(1:LVID-LDOT)
-#endif
-
-#if (defined(CERNLIB_IBMVM))&&(defined(CERNLIB_HEPVM))
-*
-* Build STAGE Query command
-*
- COMAND = 'EXEC STAGE QUERY ' // CHVSN(1:LVSN) // '.' //
- + CHSEQ(1:LFSEQ) // '.' // CHLAB(1:LLAB) // '.'
- + // CHVID(1:LVID) // ' (LIFO'
- LC = LENOCC(COMAND)
- IF(IDEBFA.GE.2) PRINT *,'FMSTGQ. running ', COMAND(1:LC)
- CALL VMCMS(COMAND(1:LC),IRC)
-
- IF(IRC.EQ.0) THEN
-*
-* Get answer and extract file size
-*
- CALL VMRTRM(CHLINE,LLINE)
-
- IF(IDEBFA.GE.1) PRINT *,'FMSTGQ. ',CHLINE(1:LLINE)
-
- IF(INDEX(CHLINE(1:LLINE),'unknown to VMSTAGE').NE.0) THEN
- IRC = -1
- ELSE
- IRC = 0
- ENDIF
- ENDIF
-#endif
-#if (defined(CERNLIB_VAXVMS))&&(defined(CERNLIB_VAXTAP))
-*
-* Find staging group
-*
- CALL FMSTGP(CHGRP,IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMSTGQ. error checking STAGE',
- + ' IRC = ',IRC
- IRC = -2
- RETURN
- ENDIF
-
- JL = ICNTH(CHLAB,IBMLAB,3)
- LCHGRP = LENOCC(CHGRP)
- CHSTFL = CHGRP(1:LCHGRP)//CHVSN(1:LVSN)//'_'//CHVID(1:LVID)
- + //'.'//CHSEQ(1:LFSEQ)//'_'//VAXLAB(JL)
- LCHST = LENOCC(CHSTFL)
-*
-* Does this file exist?
-*
- INQUIRE(FILE=CHSTFL(1:LCHST),EXIST=IEXIST)
-
- IF(IEXIST) THEN
- IRC = 0
- ELSE
- IRC = -1
- ENDIF
-
-#endif
-#if (defined(CERNLIB_UNIX))&&(defined(CERNLIB_SHIFT))
-#endif
- END
diff --git a/src/packlib/fatmen/fatutil/fmtree.F b/src/packlib/fatmen/fatutil/fmtree.F
deleted file mode 100644
index 37df85a..0000000
--- a/src/packlib/fatmen/fatutil/fmtree.F
+++ /dev/null
@@ -1,123 +0,0 @@
-*
-* $Id: fmtree.F,v 1.1.1.1 1996/03/07 15:18:05 mclareni Exp $
-*
-* $Log: fmtree.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:05 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMTREE(CHPATH,SUBDIR,NLEVEL,NFOUND,MAXFIL,IRC)
-*
-************************************************************************
-*
-* To traverse the FATMEN directory tree starting from
-* the specified pathname.
-* Modified from the RZ routine RZSTAT
-* Input:
-* CHPATH The pathname of the starting directory
-* NLEVEL Number of levels below CHPATH about which space information
-* has to be accumulated.
-* MAXFIL Maximum number of files which the user can accept
-*
-* Called by <USER>
-*
-* Error condition: IQUEST(1) = -1 # files > MAXFIL
-* IQUEST(11) = number of files found
-*
-************************************************************************
-#include "zebra/rzcl.inc"
-#include "zebra/rzdir.inc"
-#include "zebra/rzch.inc"
-#include "zebra/rzk.inc"
- CHARACTER*(*) SUBDIR(MAXFIL)
- CHARACTER*(*) CHPATH
- DIMENSION ISD(15),NSD(15),IHDIR(4)
- DIMENSION NRUSED(15),NWUSED(15)
- DIMENSION IOPTV(2)
- EQUIVALENCE (IOPTQ,IOPTV(1)), (IOPTX,IOPTV(2))
-*
-*-----------------------------------------------------------------------
-*
-*
- IRC=0
- IQUEST(1)=0
-*
- ITIME=0
- NLEV=NLEVEL
- IF(NLEV.LE.0)NLEV=99
- NFOUND = 0
- ITEMP = 0
- CALL FACDIR(CHWOLD,'R')
-*
-* Set CWD to the current level
-*
- 10 CONTINUE
- IF(ITIME.NE.0)THEN
- CALL RZPAFF(CHPAT,NLPAT,CHL)
- IF(IQUEST(1).NE.0) THEN
- NLPAT = NLPAT - 1
- GOTO 20
- ENDIF
- CALL FACDIR(CHL,' ')
- ELSE
- CALL FACDIR(CHPATH,' ')
- IF(IQUEST(1).NE.0)GO TO 99
- NLPAT0=NLPAT
- CALL VZERO(NRUSED,15)
- CALL VZERO(NWUSED,15)
- ENDIF
- IF(IQUEST(1).NE.0) THEN
- NLPAT = NLPAT - 1
- GOTO 20
- ENDIF
- ISD(NLPAT)=0
- NSD(NLPAT)=IQ(KQSP+LCDIR+KNSD)
-*
-* Process possible down directories
-*
- 20 ISD(NLPAT)=ISD(NLPAT)+1
- IF(ISD(NLPAT).LE.NSD(NLPAT))THEN
- NLPAT=NLPAT+1
- LS=IQ(KQSP+LCDIR+KLS)
- IH=LS+7*(ISD(NLPAT-1)-1)
- CALL ZITOH(IQ(KQSP+LCDIR+IH),IHDIR,4)
- CALL UHTOC(IHDIR,4,CHPAT(NLPAT),16)
- ITIME=ITIME+1
- GO TO 10
- ELSE
-*
-* Write information on current directory
-*
- CALL RZPAFF(CHPAT,NLPAT,CHL)
- IF(NLPAT.LE.(NLPAT0+NLEV))THEN
- NFOUND = NFOUND + 1
- IF(NFOUND.LE.MAXFIL) THEN
- SUBDIR(NFOUND) = CHL(1:LENOCC(CHL))
- ELSE
- ITEMP = NFOUND
- ENDIF
- ENDIF
- NLPAT=NLPAT-1
- IF(NLPAT.GE.NLPAT0)THEN
- LUP=LQ(KQSP+LCDIR+1)
- CALL MZDROP(JQPDVS,LCDIR,' ')
- LCDIR=LUP
- GO TO 20
- ENDIF
- ENDIF
-*
-* Reset CWD
-*
- 90 CALL FACDIR(CHWOLD,' ')
-*
- 99 CONTINUE
- IF(ITEMP .GT. MAXFIL) THEN
- IQUEST(1) = -1
- IQUEST(11) = ITEMP
- ELSE
- IQUEST(11) = 0
- ENDIF
- IRC = IQUEST(1)
- RETURN
- END
diff --git a/src/packlib/fatmen/fatutil/fmuver.F b/src/packlib/fatmen/fatutil/fmuver.F
deleted file mode 100644
index 87a2576..0000000
--- a/src/packlib/fatmen/fatutil/fmuver.F
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: fmuver.F,v 1.1.1.1 1996/03/07 15:18:07 mclareni Exp $
-*
-* $Log: fmuver.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:07 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMUVER(GENAM,LBANK,KEYS,IRC)
- CHARACTER*(*) GENAM
-#include "fatmen/fmnkeys.inc"
- DIMENSION KEYS(LKEYFA)
- CHARACTER*8 CHROUT
-#include "fatmen/fatbug.inc"
-#include "fatmen/fatpara.inc"
-
- IRC = 0
- CHROUT = 'FMUVER. '
-#include "fatmen/fatdummy.inc"
-
- END
diff --git a/src/packlib/fatmen/fatutil/fmveri.F b/src/packlib/fatmen/fatutil/fmveri.F
deleted file mode 100644
index 12d6fb4..0000000
--- a/src/packlib/fatmen/fatutil/fmveri.F
+++ /dev/null
@@ -1,686 +0,0 @@
-*
-* $Id: fmveri.F,v 1.4 1998/02/13 14:01:21 jamie Exp $
-*
-* $Log: fmveri.F,v $
-* Revision 1.4 1998/02/13 14:01:21 jamie
-* dont check bank address is 0
-*
-* Revision 1.3 1997/10/23 13:39:36 mclareni
-* NT mods
-*
-* Revision 1.2 1996/08/01 11:10:27 jamie
-* Changes to support FMVERI On/Off
-*
-* Revision 1.1.1.1 1996/03/07 15:18:05 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMVERI(GENAM,LBANK,KEYS,CHOPT,IRC)
-*
-* Verify the bank at address LBANK with generic name GENAM
-*
-#include "fatmen/fatveri.inc"
-#include "fatmen/fatout.inc"
-#include "fatmen/fatbank.inc"
-#include "fatmen/fatpara.inc"
-#include "fatmen/fattyp.inc"
-#include "zebra/mzcn.inc"
-** V.Fine This VIP variable is required to call
-** CALL FMXVID(VID,JP,XVID,VIP,'C',IRC)
-** (see source below)
- CHARACTER*8 VIP
-*
- CHARACTER*(*) GENAM,CHOPT
- PARAMETER (LKEYFA=10)
- DIMENSION KEYS(LKEYFA)
- CHARACTER*20 FNAME
- CHARACTER*80 COMM
- CHARACTER*4 FFORM,FLFRM,UFORM
- CHARACTER*256 DSN
- CHARACTER*6 VSN,VID
- CHARACTER*15 XVID
- CHARACTER*8 OWNER,ACCT,JOB,HOST,NODE,OS
- LOGICAL IVERI,JVERI
- PARAMETER (NPOSS=4)
- CHARACTER*8 CHPOSS(NPOSS)
-
-#include "fatmen/tmsdef0.inc"
-#include "fatmen/fatform0.inc"
-#include "fatmen/fatoptd.inc"
-#include "fatmen/tmsdef1.inc"
-#include "fatmen/fatform1.inc"
- SAVE CHPOSS
-
- DATA CHPOSS(1)/'OSM'/,
- + CHPOSS(2)/'UNITREE'/,
- + CHPOSS(3)/'ADSM'/,
- + CHPOSS(4)/'EMASS'/
-
-#include "fatmen/fatoptc.inc"
-
- LWRITE = LPRTFA
-
- IF((CHOPT(1:1) .EQ. ' ') .OR. (IOPTA.NE.0)) THEN
- DO 10 I=1,26
- 10 IOPT(I) = 1
- ENDIF
-*
-* Only check TMS if explicitly requested
-*
- IF(INDEX(CHOPT,'Q').EQ.0) IOPTQ = 0
-*
-* Re-direct output?
-*
- IF(INDEX(CHOPT,'R').NE.0) LWRITE = 3
-
- IRC = 0
- LADDR = LBANK + KOFUFA
- CALL VZERO(IQUEST,26)
- NCH = LENOCC(GENAM)
-*
-* For warnings...
-*
- IVERI = IDEBFA.GT.0
-*
-* For errors...
-*
- JVERI = IDEBFA.GE.-3
-
- IF(IVERI) WRITE(LWRITE,*) 'FMVERI. enter for ',GENAM(1:NCH),
- + ' at address ',LBANK
-
- IF (IOPTZ .NE. 0. AND. LBANK .NE. 0) THEN
-*
-* Check bank status word is valid
-*
- CALL MZCHLS(IDIVFA,LBANK)
- IF(IQFOUL.NE.0) THEN
- IF(JVERI) THEN
- WRITE(LWRITE,*) 'FMVERI. bank status word is invalid'
- WRITE(LWRITE,*) 'FMVERI. Check for overwriting:'
- WRITE(LWRITE,*) ' e.g. IQ(L+iundef) = n'
- ENDIF
- IQUEST(26) = IQFOUL
- IRC = IQFOUL
- ENDIF
- ENDIF
-
- IF (IOPTG .NE. 0) THEN
-*
-* Check that the generic name does not contain a blank
-* or other strange characters
-*
- LBLANK = INDEX(GENAM(1:NCH),' ')
-
- IF(LBLANK.NE.0) THEN
- IF(JVERI) THEN
- WRITE(LWRITE,*)
- + 'FMVERI. Error - generic name contains a blank'
- DSN = ' '
- DSN(LBLANK:LBLANK+7) = '^- blank'
- WRITE(LWRITE,*) GENAM(1:NCH)
- WRITE(LWRITE,*) DSN(1:LBLANK+7)
- ENDIF
- IRC = 1
- ENDIF
-
- LUNSCH = ICLUNS(GENAM,1,NCH)
- IF(LUNSCH.NE.0) THEN
- IF(JVERI) THEN
- WRITE(LWRITE,*)
- + 'FMVERI. Error - generic name contains an '//
- + 'unseen character'
- DSN = ' '
- DSN(LUNSCH:LUNSCH+8) = '^- unseen'
- WRITE(LWRITE,*) GENAM(1:NCH)
- WRITE(LWRITE,*) DSN(1:LUNSCH+8)
- ENDIF
- IRC = 1
- ENDIF
-*
-* Check against double // in generic name
-*
- ISLASH = INDEXB(GENAM(1:NCH),'//')
- IF(ISLASH.GT.1) THEN
- IF(JVERI) THEN
- WRITE(LWRITE,*)
- + 'FMVERI. Error - invalid generic name: ',
- + GENAM(1:NCH)
- ISLASH = ISLASH + 38
- DSN = ' '
- DSN(ISLASH:ISLASH+9) = '^- invalid'
- WRITE(LWRITE,*) DSN(1:ISLASH+9)
- ENDIF
- IRC = 1
- ENDIF
- ENDIF
-
- IF (IOPTC .NE. 0) THEN
-*
-* Comment field - anything goes?
-*
- CALL CFILL(' ',COMM,1,80)
- CALL UHTOC(IQ(LADDR+MUCMFA),4,COMM,80)
- LCOMM = LENOCC(COMM)
- IF(LCOMM.EQ.0) THEN
- IF(IVERI) WRITE(LWRITE,*)
- + 'FMVERI. Warning - comment string is blank'
- IQUEST(3) = 1
- ENDIF
- IF(ICLUNS(COMM,1,LCOMM).NE.0) THEN
- IF(IVERI) WRITE(LWRITE,*) 'FMVERI. Warning - ',
- + 'comment string contains "UNSEEN" characters'
- IQUEST(3) = 2
- ENDIF
- ENDIF
-
- IF (IOPTE .NE. 0) THEN
-*
-* User exit
-*
- CALL FMUVER(GENAM(1:NCH),LBANK,KEYS,IRC)
- IF(IRC.NE.0) THEN
- IF(JVERI) WRITE(LWRITE,*) 'FMVERI. Error - return code ',
- + IRC,' from user exit'
- IQUEST(5) = 1
- ENDIF
- ENDIF
-
- IF (IOPTF .NE. 0) THEN
-*
-* File attributes
-*
- IF((IQ(LADDR+MSRDFA).LT.0) .OR. (IQ(LADDR+MERDFA).LT.0) .OR.
- + (IQ(LADDR+MSBLFA).LT.0) .OR. (IQ(LADDR+MEBLFA).LT.0)) THEN
-
- IQUEST(6) = 1
- IRC = 1
- IF(JVERI) WRITE(LWRITE,*)
- + 'FMVERI. Error in file description',
- + IQ(LADDR+MSRDFA),IQ(LADDR+MERDFA),
- + IQ(LADDR+MSBLFA),IQ(LADDR+MEBLFA)
- ENDIF
-
- ENDIF
-
- IF (IOPTK .NE. 0) THEN
-*
-* Keys - check that KEYS(1), KEYS(7-10) are positive
-* KEYS(2-6) must match last part of generic name
-*
- FNAME = ' '
- CALL UHTOC(KEYS(2),4,FNAME,20)
- ICH = INDEXB(GENAM(1:NCH),'/')
- JCH = LENOCC(FNAME)
-
- IF(GENAM(ICH+1:NCH).NE.FNAME(1:JCH)) THEN
- IQUEST(11) = 1
- IRC = 1
- IF(JVERI)
- + WRITE(LWRITE,*) 'FMVERI. Error - file name mismatch ',
- + GENAM(ICH+1:NCH),'/',FNAME(1:JCH),' (GENAM/KEYS)'
- WRITE(LWRITE,*) 'length = ',NCH-ICH,JCH,' (GENAM/KEYS)'
- ENDIF
-*
-* Check that rest of keys vector is ok
-*
- IF((KEYS(MKSRFA).LT.0) .OR. (KEYS(MKCLFA).LT.0) .OR.
- + (KEYS(MKLCFA).LT.0) .OR. (KEYS(MKMTFA).LE.0)) THEN
- IQUEST(11) = 2
- IRC = 1
- IF(JVERI) THEN
- WRITE(LWRITE,*) 'FMVERI. Error in keys vector'
- CALL FMPKEY(KEYS,10)
- ENDIF
-
- ENDIF
-*
-* Check that keys match bank contents
-*
- IF((KEYS(MKCLFA).NE.IQ(LADDR+MCPLFA)) .OR.
- + (KEYS(MKLCFA).NE.IQ(LADDR+MLOCFA)) .OR.
- + (KEYS(MKMTFA).NE.IQ(LADDR+MMTPFA))) THEN
-
- IQUEST(11) = 3
- IF(JVERI) THEN
- WRITE(LWRITE,*)
- + 'FMVERI. Error - Keys / bank mismatch'
- WRITE(LWRITE,*)
- + KEYS(MKCLFA),IQ(LADDR+MCPLFA),' (copy level)'
- WRITE(LWRITE,*)
- + KEYS(MKLCFA),IQ(LADDR+MLOCFA),' (location code)'
- WRITE(LWRITE,*) KEYS(MKMTFA),IQ(LADDR+MMTPFA),
- + ' (media type)'
- ENDIF
-
- ENDIF
-
- ENDIF
-
- IF (IOPTL .NE. 0) THEN
-*
-* Logical attributes
-*
- FFORM = ' '
- CALL UHTOC(IQ(LADDR+MFLFFA),4,FFORM,4)
- CALL UHTOC(IQ(LADDR+MFUTFA),4,UFORM,4)
- LFF = LENOCC(FFORM)
- IF((LFF.EQ.0) .OR. (ICNTH(FFORM,FATFRM,NFATFM).EQ.0)) THEN
- IQUEST(12) = 1
- IRC = 1
- IF(JVERI) THEN
- WRITE(LWRITE,*) 'FMVERI. Error in logical attributes'
- WRITE(LWRITE,*) ' File format = ',FFORM
- WRITE(LWRITE,*) ' File format must be one of ',FATFRM
- ENDIF
- ENDIF
- IF(FFORM(1:LFF).EQ.'RMS') THEN
- IQUEST(12) = 2
- IF(IVERI) THEN
- WRITE(LWRITE,*) 'FMVERI. warning - ',FFORM,
- + ' is a deprecated file format'
- ENDIF
- ENDIF
-
- ENDIF
-
- IF (IOPTM .NE. 0) THEN
-*
-* Media attributes
-*
- IF (IQ(LADDR+MMTPFA) .EQ. 1) THEN
-*
-* Disk dataset, check host type and O/S
-*
- CALL UHTOC(IQ(LADDR+MHSNFA),4,HOST,8)
- CALL UHTOC(IQ(LADDR+MHSTFA),4,NODE,8)
- CALL UHTOC(IQ(LADDR+MHOSFA),4,OS,8)
- LHOST = LENOCC(HOST)
- LNODE = LENOCC(NODE)
- LOS = LENOCC(OS)
- IF(LHOST.EQ.0.OR.LNODE.EQ.0.OR.LOS.EQ.0) THEN
- IQUEST(13) = 1
- IRC = 1
- IF(JVERI) THEN
- WRITE(LWRITE,*)
- + 'FMVERI. Error - Host name, type or O/S missing'
- WRITE(LWRITE,*) 'FMVERI. host name: ',HOST(1:LHOST)
- WRITE(LWRITE,*) 'FMVERI. host type: ',NODE(1:LNODE)
- WRITE(LWRITE,*) 'FMVERI. host OS : ',OS(1:LOS)
- ENDIF
- ENDIF
-
- ELSE
-*
-* Tape dataset, check VSN/VID, FSEQ
-*
- CALL UHTOC(IQ(LADDR+MVSNFA),4,VSN,6)
- CALL UHTOC(IQ(LADDR+MVIDFA),4,VID,6)
- LVSN = LENOCC(VSN)
- JVSN = ICNUMA(VSN,1,6)
- JVID = ICNUMA(VID,1,6)
- LVID = LENOCC(VID)
- IF((LVSN.EQ.0).OR.(LVID.EQ.0).OR.
- + (JVSN.LT.7).OR.(JVID.LT.7)) THEN
- IQUEST(13) = 1
- IRC = 1
- IF(JVERI)
- + WRITE(LWRITE,*) 'FMVERI. Error - VSN or VID ',
- + 'invalid ',
- + VSN(1:LVSN),' ',VID(1:LVID),' (VSN/VID)'
- ENDIF
-*
-* New: check that FSEQ < 1000000. This is the limit (I6) in FMSHOW
-*
- IF((IQ(LADDR+MFSQFA).LE.0).OR.
- + (IQ(LADDR+MFSQFA).GT.9999)) THEN
- IQUEST(13) = 1
- IRC = 1
- IF (JVERI)
- + WRITE(LWRITE,*) 'FMVERI. Error - FSEQ must be a ',
- + 'positive integer between 1 and 9999 - ',
- + IQ(LADDR+MFSQFA)
- ENDIF
-*
-* Check file size
-*
- IF(IQ(LADDR+MFSZFA).GT.MEDSIZ(IQ(LADDR+MMTPFA))) THEN
- IQUEST(13) = 2
- IRC = 1
- IF (JVERI) WRITE(LWRITE,*)
- + 'FMVERI. Error - file size exceeds',
- + ' media capacity. File size = ',IQ(LADDR+MFSZFA),
- + ' media capacity = ',MEDSIZ(IQ(LADDR+MMTPFA))
- ENDIF
-
- IF(IQ(LADDR+MFSZFA).LT.0) THEN
- IQUEST(13) = 3
- IRC = 1
- IF (JVERI) WRITE(LWRITE,9001)
- 9001 FORMAT(' FMVERI. Error - file size must be 0 or positive')
- ENDIF
- ENDIF
-
- ENDIF
-
- IF (IOPTN .NE. 0) THEN
-*
-* Name attributes (DSN on disk/tape)
-*
- CALL UHTOC(IQ(LADDR+MFQNFA),4,DSN,NFQNFA)
- LDSN = LENOCC(DSN)
-
- IF(LDSN.EQ.0) THEN
- IQUEST(14) = 1
- IRC = 1
- IF(JVERI) WRITE(LWRITE,*) 'FMVERI. Error - DSN is missing'
- ELSE
-*
-* Link (ln) handling
-*
- IF(KEYS(MKLCFA).EQ.0) THEN
- IF(DSN(1:2).NE.'//') THEN
- IRC = 1
- IQUEST(14) = 2
- IF(IVERI) THEN
- WRITE(LWRITE,*) 'FMVERI. Error - DSN for a link',
- + ' must begin with a //'
- ENDIF
- ENDIF
- ENDIF
-
- LBLANK = INDEX(DSN(1:LDSN),' ')
- IF(LBLANK.NE.0) THEN
- IQUEST(14) = 3
- IF(IVERI) THEN
- WRITE(LWRITE,*) 'FMVERI. Warning - DSN contains '
- + //'a blank - trailing characters ignored. '
- + //'You may have problems accessing this file!'
- ENDIF
- ENDIF
-
-*
-* URL syntax: protocol://host[:port]/store/class/id
-*
- ISLASH = INDEX(DSN(1:LDSN),'/')
- IURL = INDEX(DSN(1:LDSN),'://')
- IF(IURL.NE.0.AND.IURL.EQ.ISLASH-1) THEN
-*
-* check if this system supported (on this node)
-*
- CALL FMMSS(GENAM(1:NCH),DSN(1:LDSN),' ',ITEST)
- IF(ITEST.NE.0) THEN
- IQUEST(14) = 4
- IF(IVERI) THEN
- WRITE(LWRITE,9002) GENAM(1:NCH),DSN(1:LDSN)
- 9002 FORMAT(' FMVERI. Warning - generic name ',A,' URL ',A,
- + ' not accessible on this node')
- ENDIF
- ENDIF
-*
-* check media type
-*
- IF(KEYS(MKMTFA).NE.1) THEN
- IRC = 1
- IQUEST(14) = 5
- IF(JVERI) THEN
- WRITE(LWRITE,*) 'FMVERI. Error - media type must',
- + ' be 1 if DSN contains a URL'
- ENDIF
- ENDIF
-*
-* check protocol
-*
- IPROT = ICNTHU(DSN(1:IURL-1),CHPOSS,NPOSS)
- IF(IPROT.EQ.0) THEN
- IRC = 1
- IQUEST(14) = 6
- IF(JVERI) THEN
- WRITE(LWRITE,9003)
- 9003 FORMAT(' FMVERI. Error in protocol ',A)
- WRITE(LPRTFA,9004) CHPOSS
- 9004 FORMAT(' FMVERI. following protocols currently permitted: ',
- + /,(1X,A))
-
- ENDIF
- ENDIF
-*
-* check that URL contains all components
-* protocol://server-node/store-name/storage-class/bfid
-*
- LSLASH = INDEXB(DSN(1:LDSN),'/')
- IF(LSLASH.EQ.0) GOTO 20
-*
-* BitfileID
-*
-* CHBFID = DSN(LSLASH+1:LDSN)
- LDSN = LSLASH-1
-
- LSLASH = INDEXB(DSN(1:LDSN),'/')
- IF(LSLASH.EQ.0) GOTO 20
-*
-* Storage-class
-*
-* CHSGRP = DSN(LSLASH+1:LDSN)
- LDSN = LSLASH-1
-
- LSLASH = INDEXB(DSN(1:LDSN),'/')
- IF(LSLASH.EQ.0) GOTO 20
-*
-* Store-name
-*
-* CHNAME = DSN(LSLASH+1:LDSN)
- LDSN = LSLASH-1
-
- LSLASH = INDEXB(DSN(1:LDSN),'/')
- IF(LSLASH.EQ.0) GOTO 20
-*
-* Server-node
-*
-* CHSERV = DSN(LSLASH+1:LDSN)
- LDSN = LSLASH-1
-
- IF(INDEX (DSN(1:LDSN),'/').NE.
- + INDEXB(DSN(1:LDSN),'/')) GOTO 20
-*
-* All fields exist
-*
- GOTO 30
-
- 20 CONTINUE
- IRC = 1
- IQUEST(14) = 7
- IF(JVERI) THEN
- WRITE(LWRITE,*) 'FMVERI. Error - invalid URL'
- ENDIF
- 30 CONTINUE
- ENDIF
- ENDIF
- ENDIF
-
- IF (IOPTO .NE. 0) THEN
-*
-* Owner attributes
-*
- CALL CFILL(' ',OWNER,1,8)
- CALL UHTOC(IQ(LADDR+MCURFA),4,OWNER,8)
- CALL CFILL(' ',ACCT,1,8)
- CALL UHTOC(IQ(LADDR+MCIDFA),4,ACCT,8)
- CALL CFILL(' ',NODE,1,8)
- CALL UHTOC(IQ(LADDR+MCNIFA),4,NODE,8)
- CALL CFILL(' ',JOB,1,8)
- CALL UHTOC(IQ(LADDR+MCJIFA),4,JOB,8)
-
- IF((LENOCC(OWNER).EQ.0) .OR.
- + (LENOCC(NODE).EQ.0) .OR.
- + (LENOCC(ACCT).EQ.0) .OR.
- + (LENOCC(JOB).EQ.0)) THEN
- IQUEST(15) = 1
- IRC = 1
- IF(JVERI) WRITE(LWRITE,*)
- + 'FMVERI. Error - owner, account, node or job name missing',
- + OWNER,'/',ACCT,'/',NODE,'/',JOB,' (OWNER/ACCT/NODE/JOB)'
- ENDIF
-
- ENDIF
-
- IF (IOPTP .NE. 0) THEN
-*
-* Physical attributes
-*
- CALL UHTOC(IQ(LADDR+MRFMFA),4,FLFRM,4)
- LFLFRM = LENOCC(FLFRM)
- IF(LFLFRM.GT.0) THEN
- CALL CLTOU(FLFRM(1:LFLFRM))
- DO 40 I=1,LFLFRM
- IF(INDEX(ALFNUM(1:26),FLFRM(I:I)).EQ.0) THEN
- IF(JVERI) WRITE(LWRITE,*) 'FMVERI. error - ',
- + ' record format contains non alphabetic character '
- + ,FLFRM(I:I)
- IQUEST(16) = 1
- IRC = 1
- ENDIF
- 40 CONTINUE
- ENDIF
- IF((LFLFRM.EQ.0).OR.
- + (ICNTH(FLFRM(1:LFLFRM),FRCFM,NRECFM).EQ.0)) THEN
- IQUEST(16) = 1
- IF(IVERI) WRITE(LWRITE,*)
- + 'FMVERI. Warning - record format missing or invalid - ',
- + FLFRM
- ENDIF
- IF((IQ(LADDR+MRLNFA).LE.0).OR.(IQ(LADDR+MBLNFA).LE.0).OR.
- + (IQ(LADDR+MFSZFA).LE.0)) THEN
- IQUEST(16) = 1
- IF(IVERI) THEN
- WRITE(LWRITE,*)
- + 'FMVERI. Warning - ',
- + 'record/block size or file size missing or invalid'
- WRITE(LWRITE,*)
- + IQ(LADDR+MRLNFA),IQ(LADDR+MBLNFA),IQ(LADDR+MFSZFA)
- + ,' (LRECL,BLOCKSIZE,FILESIZE)'
- ENDIF
- ENDIF
- IF(IQ(LADDR+MRLNFA).GT.FMXREC) THEN
- IRC = 1
- IQUEST(16) = 1
- IF(JVERI) WRITE(LWRITE,*) 'FMVERI. error - record length ',
- + 'exceeds maximum of ',FMXREC,' 32bit words: ',
- + IQ(LADDR+MRLNFA)
- ENDIF
- IF(IQ(LADDR+MBLNFA).GT.FMXBLK) THEN
- IRC = 1
- IQUEST(16) = 1
- IF(JVERI) WRITE(LWRITE,*) 'FMVERI. error - block length ',
- + 'exceeds maximum of ',FMXBLK,' 32bit words: ',
- + IQ(LADDR+MBLNFA)
- ENDIF
- ENDIF
-#if defined(CERNLIB_TMS)
-
- IF ((IOPTQ .NE. 0) .AND. (IQ(LADDR+MMTPFA) .GT. 1)) THEN
-*
-* Set IQUEST(11) to media type in case volume unknown or
-* TMS option not installed.
-*
- IQUEST(11) = IQ(LADDR+MMTPFA)
- JP = IQ(LADDR+MVIPFA)
-*
-* Convert VID & integer prefix to eXtended VID
-*
-*
-** V.Fine 19.09.97 this call contained nowhere defined variable 'VIP'
-** I had no idea and define it somehow as CHARACTER*8 VIP
-** Don't ask me why it is *8
-*
- CALL FMXVID(VID,JP,XVID,VIP,'C',IRC)
- LXVID = LENOCC(XVID)
- CALL FMQTMS(XVID(1:LXVID),LIB,MODEL,DENS,MNTTYP,LABTYP,IC)
- IF(IC.EQ.100) THEN
- IQUEST(13) = 100
-#endif
-#if (!defined(CERNLIB_TMSTEST))&&(defined(CERNLIB_TMS))
- IRC = 1
- IF (JVERI)
- + WRITE(LWRITE,*) 'FMVERI. Error - VID unknown to TMS'
- ENDIF
-#endif
-#if (defined(CERNLIB_TMS))&&(defined(CERNLIB_TMSTEST))
- IF (IVERI)
- + WRITE(LWRITE,*) 'FMVERI. Warning - VID unknown to TMS'
- ENDIF
-
-#endif
-#if defined(CERNLIB_TMS)
- ENDIF
-#endif
-
- IF (IOPTS .NE. 0) THEN
-*
-* Security attributes
-*
- ENDIF
-
- IF (IOPTT .NE. 0) THEN
-*
-* Time attributes
-*
- CALL FMUPTM(IDATE,ITIME,IQ(LADDR+MCRTFA),IRET)
- IF(IRET.NE.0) THEN
- IQUEST(20) = 1
- IRC = 1
- IF(JVERI) WRITE(LWRITE,*)
- + 'FMVERI. Error in date/time created',
- + IDATE,ITIME,IQ(LADDR+MCRTFA)
- ENDIF
-
- CALL FMUPTM(IDATE,ITIME,IQ(LADDR+MCTTFA),IRET)
- IF(IRET.NE.0) THEN
- IQUEST(20) = 1
- IRC = 1
- IF(JVERI) WRITE(LWRITE,*)
- + 'FMVERI. Error in date/time cataloged ',
- + IDATE,ITIME,IQ(LADDR+MCTTFA)
- ENDIF
-
- CALL FMUPTM(IDATE,ITIME,IQ(LADDR+MLATFA),IRET)
- IF(IRET.NE.0) THEN
- IQUEST(20) = 1
- IRC = 1
- IF(JVERI) WRITE(LWRITE,*)
- + 'FMVERI. Error in date/time of last access',
- + IDATE,ITIME,IQ(LADDR+MLATFA)
- ENDIF
-
- ENDIF
-
- IF (IOPTU .NE. 0) THEN
-*
-* User attributes
-*
- IQUEST(21) = 1
- DO 50 I=0,9
- IF(IQ(LADDR+MUSWFA+I).EQ.0) GOTO 50
- IQUEST(21) = 0
- 50 CONTINUE
- IF((IQUEST(21).NE.0).AND.(IVERI))
- + WRITE(LWRITE,*) 'FMVERI. Warning - user words are all zero'
-
- ENDIF
-
- IF(IDEBFA.GE.2) WRITE(LWRITE,9005) (IQUEST(I),I=1,26),(I,I=1,26)
- 9005 FORMAT(' IQUEST:',/,1X,26I3,/1X,26I3)
-
- IF(IFMVER.EQ.0.AND.IRC.NE.0) THEN
-
- WRITE(LWRITE,9006)
-
- 9006 FORMAT(' FMVERI. *** WARNING *** ERRORS DETECTED BUT',
- + ' VERIFICATION HAS BEEN SUPPRESSED',/,
- + ' FMVERI. *** RETURN CODE WILL SET TO ZERO')
- IRC = 0
-
- ENDIF
-
- END
diff --git a/src/packlib/fatmen/fatutil/fmvmio.F b/src/packlib/fatmen/fatutil/fmvmio.F
deleted file mode 100644
index b2d24a9..0000000
--- a/src/packlib/fatmen/fatutil/fmvmio.F
+++ /dev/null
@@ -1,43 +0,0 @@
-*
-* $Id: fmvmio.F,v 1.1.1.1 1996/03/07 15:18:06 mclareni Exp $
-*
-* $Log: fmvmio.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:06 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
-#if defined(CERNLIB_IBMVM)
- SUBROUTINE FMVMIO(IBUF,IOWAY)
- DIMENSION IBUF(8192)
-#include "zebra/zmach.inc"
-#include "zebra/quest.inc"
-#include "fatmen/fatbug.inc"
- CHARACTER*6 CHWAY
-
- IRC = 0
- IF(IDEBFA.GE.3) PRINT *,'FMVMIO. IQUEST(1-6) = ',
- + (IQUEST(J),J=1,6)
- LUN = IQUEST(1)
- NREC = IQUEST(4)
- IF(IOWAY.EQ.0) THEN
- CALL VMRNDM(LUN,IBUF,IQUEST(2)*IQCHAW,LENDAT,NREC,IRC,INFO)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMVMIO. return code ',IRC,
- + ' from VMRNDM. Info = ',INFO
- ENDIF
- ELSEIF(IOWAY.EQ.1) THEN
- CALL VMRITE(LUN,IBUF,IQUEST(2)*IQCHAW,IRC,INFO)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMVMIO. return code ',IRC,
- + ' from VMRITE. Info = ',INFO
- ENDIF
- ELSE
- WRITE(CHWAY,'(I6)') IOWAY
- CALL ZFATAM('Invalid value for IOWAY in FMVMIO - '//CHWAY)
- ENDIF
-
- IQUEST(1) = IRC
-
- END
-#endif
diff --git a/src/packlib/fatmen/fatutil/fmxyio.F b/src/packlib/fatmen/fatutil/fmxyio.F
deleted file mode 100644
index bd39200..0000000
--- a/src/packlib/fatmen/fatutil/fmxyio.F
+++ /dev/null
@@ -1,35 +0,0 @@
-*
-* $Id: fmxyio.F,v 1.1.1.1 1996/03/07 15:18:07 mclareni Exp $
-*
-* $Log: fmxyio.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:07 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
-#if defined(CERNLIB_SHIFT)
- SUBROUTINE FMXYIO(IBUF,IOWAY)
- DIMENSION IBUF(8192)
-#include "zebra/zmach.inc"
-#include "zebra/quest.inc"
-#include "fatmen/fatbug.inc"
- CHARACTER*6 CHWAY
-
- IRC = 0
- IF(IDEBFA.GE.3) PRINT *,'FMXYIO. IQUEST(1-6) = ',
- + (IQUEST(J),J=1,6)
- LUN = IQUEST(1)
- NREC = IQUEST(4)
- IF(IOWAY.EQ.0) THEN
- CALL XYREAD(LUN,IBUF,NREC,IQUEST(2)*IQCHAW,NGOT,' ',IRC)
- ELSEIF(IOWAY.EQ.1) THEN
- CALL XYWRIT(LUN,IBUF,NREC,IQUEST(2)*IQCHAW,' ',IRC)
- ELSE
- WRITE(CHWAY,'(I6)') IOWAY
- CALL ZFATAM('Invalid value for IOWAY in FMXYIO - '//CHWAY)
- ENDIF
-
- IQUEST(1) = IRC
-
- END
-#endif
diff --git a/src/packlib/fatmen/fatutil/fmxzio.F b/src/packlib/fatmen/fatutil/fmxzio.F
deleted file mode 100644
index f9f6ff2..0000000
--- a/src/packlib/fatmen/fatutil/fmxzio.F
+++ /dev/null
@@ -1,35 +0,0 @@
-*
-* $Id: fmxzio.F,v 1.1.1.1 1996/03/07 15:18:07 mclareni Exp $
-*
-* $Log: fmxzio.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:07 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
-#if defined(CERNLIB_CSPACK)
- SUBROUTINE FMXZIO(IBUF,IOWAY)
- DIMENSION IBUF(8192)
-#include "zebra/zmach.inc"
-#include "zebra/quest.inc"
-#include "fatmen/fatbug.inc"
- CHARACTER*6 CHWAY
-
- IRC = 0
- IF(IDEBFA.GE.3) PRINT *,'FMXZIO. IQUEST(1-6) = ',
- + (IQUEST(J),J=1,6)
- LUN = IQUEST(1)
- NREC = IQUEST(4)
- IF(IOWAY.EQ.0) THEN
- CALL XZREAD(LUN,IBUF,NREC,IQUEST(2)*IQCHAW,NGOT,' ',IRC)
- ELSEIF(IOWAY.EQ.1) THEN
- CALL XZRITE(LUN,IBUF,NREC,IQUEST(2)*IQCHAW,' ',IRC)
- ELSE
- WRITE(CHWAY,'(I6)') IOWAY
- CALL ZFATAM('Invalid value for IOWAY in FMXZIO - '//CHWAY)
- ENDIF
-
- IQUEST(1) = IRC
-
- END
-#endif
diff --git a/src/packlib/fatmen/fatutil/sortch.F b/src/packlib/fatmen/fatutil/sortch.F
deleted file mode 100644
index e059127..0000000
--- a/src/packlib/fatmen/fatutil/sortch.F
+++ /dev/null
@@ -1,62 +0,0 @@
-*
-* $Id: sortch.F,v 1.1.1.1 1996/03/07 15:18:06 mclareni Exp $
-*
-* $Log: sortch.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:06 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE SORTCH (CHTB,JSORT,NELEM)
-*
- CHARACTER*(*) CHTB(NELEM)
- CHARACTER*255 WORK
- DIMENSION JSORT(NELEM)
-*
- NC = MIN(LEN (CHTB(1)),255)
- DO 10 I=1,NELEM
- 10 JSORT(I) = I
-
- N = NELEM
- DO 50 I1=2,N
- I3 = I1
- I33 = JSORT(I3)
- WORK(1:NC) = CHTB(I33)(1:NC)
- 20 I2 = I3/2
-* IF (I2) 50,50,30
- IF (I2.LE.0) GOTO 50
- 30 I22 = JSORT(I2)
- IF(LLE(WORK(1:NC),CHTB(I22)(1:NC))) GOTO 50
- 40 JSORT (I3) = I22
- I3 = I2
- GOTO 20
- 50 JSORT (I3) = I33
- 60 I3 = JSORT (N)
- JSORT (N) = JSORT (1)
- WORK(1:NC) = CHTB(I3)(1:NC)
- N = N-1
-* IF (N-1) 140,140,70
- IF (N-1.LE.0) GOTO 140
- 70 I1 = 1
- 80 I2 = I1 + I1
- IF (I2.LE.N) I22= JSORT(I2)
-* IF (I2-N) 90,110,130
- IF (I2.EQ.N) THEN
- GOTO 110
- ELSEIF(I2.GT.N) THEN
- GOTO 130
- ENDIF
- 90 I222 = JSORT (I2+1)
- IF (LGE(CHTB(I22)(1:NC),CHTB(I222)(1:NC))) GOTO 110
- 100 I2 = I2+1
- I22 = I222
- 110 IF (LGE(WORK(1:NC),CHTB(I22)(1:NC))) GOTO 130
- 120 JSORT(I1) = I22
- I1 = I2
- GOTO 80
- 130 JSORT (I1) = I3
- GOTO 60
- 140 JSORT (1) = I3
- RETURN
- END
-
diff --git a/src/packlib/fatmen/fmc/Imakefile b/src/packlib/fatmen/fmc/Imakefile
deleted file mode 100644
index 76a597d..0000000
--- a/src/packlib/fatmen/fmc/Imakefile
+++ /dev/null
@@ -1,3 +0,0 @@
-SRCS_C= faexit.c fmactc.c fmhstc.c fmjob.c fmuser.c
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/fatmen/fmc/faexit.c b/src/packlib/fatmen/fmc/faexit.c
deleted file mode 100644
index f65be80..0000000
--- a/src/packlib/fatmen/fmc/faexit.c
+++ /dev/null
@@ -1,35 +0,0 @@
-/*
- * $Id: faexit.c,v 1.3 1997/09/02 12:56:52 mclareni Exp $
- *
- * $Log: faexit.c,v $
- * Revision 1.3 1997/09/02 12:56:52 mclareni
- * WINNT correction
- *
- * Revision 1.2 1997/03/14 17:01:23 mclareni
- * WNT mods
- *
- * Revision 1.1.1.1.2.1 1997/01/21 11:27:23 mclareni
- * All mods for Winnt 96a on winnt branch
- *
- * Revision 1.1.1.1 1996/03/07 15:18:09 mclareni
- * Fatmen
- *
- */
-#include "fatmen/pilot.h"
-#if defined(CERNLIB_QXCAPT)
-#ifndef CERNLIB_MSSTDCALL
- void FAEXIT(icode)
-#else
- void _stdcall FAEXIT(icode)
-#endif
-#endif
-#if defined(CERNLIB_QXNO_SC)
-void faexit(icode)
-#endif
-#if defined(CERNLIB_QX_SC)
-void faexit_(icode)
-#endif
-int *icode;
-{
- exit(*icode);
-}
diff --git a/src/packlib/fatmen/fmc/fmactc.c b/src/packlib/fatmen/fmc/fmactc.c
deleted file mode 100644
index 5d3c2f8..0000000
--- a/src/packlib/fatmen/fmc/fmactc.c
+++ /dev/null
@@ -1,58 +0,0 @@
-/*
- * $Id: fmactc.c,v 1.3 1997/09/02 12:56:53 mclareni Exp $
- *
- * $Log: fmactc.c,v $
- * Revision 1.3 1997/09/02 12:56:53 mclareni
- * WINNT correction
- *
- * Revision 1.2 1997/03/14 17:01:23 mclareni
- * WNT mods
- *
- * Revision 1.1.1.1.2.1 1997/01/21 11:27:28 mclareni
- * All mods for Winnt 96a on winnt branch
- *
- * Revision 1.1.1.1 1996/03/07 15:18:09 mclareni
- * Fatmen
- *
- */
-#include "fatmen/pilot.h"
-#include <stdio.h>
-#include <string.h>
-
-#ifndef WIN32
-# include <pwd.h>
-#endif
-
-#include "fmh.h"
-
-#if defined(CERNLIB_QXCAPT)
-#ifndef CERNLIB_MSSTDCALL
- int FMACTC(sf)
-#else
- int _stdcall FMACTC(sf,len_sf)
-#endif
-#endif
-#if defined(CERNLIB_QXNO_SC)
-int fmactc(sf)
-#endif
-#if defined(CERNLIB_QX_SC)
-int fmactc_(sf)
-#endif
-char *sf;
-#ifdef CERNLIB_MSSTDCALL
- int len_sf;
-#endif
-
-{
- char p[MAXNAME+1];
- int ruid;
-
-#ifndef WIN32
- ruid = getuid();
-#else
- ruid = 0;
-#endif
- sprintf(p,"%-8i",ruid);
- strncpy(sf,p,MAXNAME);
- return(ruid);
-}
diff --git a/src/packlib/fatmen/fmc/fmh.h b/src/packlib/fatmen/fmc/fmh.h
deleted file mode 100644
index a95bde6..0000000
--- a/src/packlib/fatmen/fmc/fmh.h
+++ /dev/null
@@ -1,12 +0,0 @@
-/*
- * $Id: fmh.h,v 1.1.1.1 1996/03/07 15:18:09 mclareni Exp $
- *
- * $Log: fmh.h,v $
- * Revision 1.1.1.1 1996/03/07 15:18:09 mclareni
- * Fatmen
- *
- */
-#define MAXNAME 8
-#define MAXJOBN 8 /* Was 16 */
-#define MAXHOST 8
-#define MAXINFO 8 /* Was 16 */
diff --git a/src/packlib/fatmen/fmc/fmhstc.c b/src/packlib/fatmen/fmc/fmhstc.c
deleted file mode 100644
index cbb6a75..0000000
--- a/src/packlib/fatmen/fmc/fmhstc.c
+++ /dev/null
@@ -1,133 +0,0 @@
-/*
- * $Id: fmhstc.c,v 1.5 1997/10/23 13:39:38 mclareni Exp $
- *
- * $Log: fmhstc.c,v $
- * Revision 1.5 1997/10/23 13:39:38 mclareni
- * NT mods
- *
- * Revision 1.4 1997/09/02 12:56:53 mclareni
- * WINNT correction
- *
- * Revision 1.3 1997/04/17 10:28:44 mclareni
- * cc on OSF1 does not accept cpp directives starting in col 2
- *
- * Revision 1.2 1997/03/14 17:01:24 mclareni
- * WNT mods
- *
- * Revision 1.1.1.1.2.1 1997/01/21 11:27:29 mclareni
- * All mods for Winnt 96a on winnt branch
- *
- * Revision 1.1.1.1 1996/03/07 15:18:09 mclareni
- * Fatmen
- *
- */
-#include "fatmen/pilot.h"
-#include <stdio.h>
-#include <string.h>
-#if !defined(CERNLIB_NEXT) && !defined(WIN32)
-#include <sys/utsname.h>
-#endif
-
-#ifdef WIN32
-#include <windows.h>
-#endif
-
-#if defined(CERNLIB_NEXT)
-struct utsname{
- char sysname[9];
- char nodename[9];
- char nodeext[65-9];
- char release[9];
- char version[9];
- char machine[9];
- };
-#endif
-
-#include "fmh.h"
-
-#if defined(CERNLIB_QXCAPT)
-#ifndef CERNLIB_MSSTDCALL
- int FMHSTC(hnf,htf,osf)
-#else
- int _stdcall FMHSTC(hnf,len_hnt, htf,len_htf, osf,len_osf)
-#endif
-#endif
-#if defined(CERNLIB_QXNO_SC)
-int fmhstc(hnf,htf,osf)
-#endif
-#if defined(CERNLIB_QX_SC)
-int fmhstc_(hnf,htf,osf)
-#endif
-char *hnf;
-char *htf;
-char *osf;
-#ifdef CERNLIB_MSSTDCALL
- int len_hnt;
- int len_htf;
- int len_osf;
-#endif
-
-{
- char p[64];
- char q[MAXHOST+1];
- char r[MAXINFO+1];
-#ifndef WIN32
- struct utsname u;
- int i;
- if (uname(&u)) return(-1);
- sprintf(q,"%-*s",MAXHOST,u.nodename);
- strncpy(hnf,q,MAXHOST);
- sprintf(r,"%-*s",MAXINFO,u.machine);
- strncpy(htf,r,MAXINFO);
- sprintf(p,"%s %s %s",u.sysname,u.release,u.version);
-#else
- OSVERSIONINFO OsVersion;
- int i = MAX_COMPUTERNAME_LENGTH+1;
- char qc[MAX_COMPUTERNAME_LENGTH+1];
-
- OsVersion.dwOSVersionInfoSize=sizeof(OSVERSIONINFO);
-
- GetVersionEx(&OsVersion);
-/****************************************************************/
-/* DWORD dwMajorVersion; */
-/* DWORD dwMinorVersion; */
-/* DWORD dwBuildNumber; */
-/* DWORD dwPlatformId; - Identifies the platform supported */
-/* by the operating system. *********/
-/* VER_PLATFORM_WIN32s Win32s on Windows 3.1 */
-/* VER_PLATFORM_WIN32_WINDOWS Win32 on Windows 95 */
-/* VER_PLATFORM_WIN32_NT Windows NT */
-/************************************************************************/
-
- switch (OsVersion.dwPlatformId) {
- case VER_PLATFORM_WIN32s:
- sprintf(p,"%s %s %s","MS Windows",OsVersion.dwMajorVersion,
- OsVersion.dwMinorVersion);
- break;
- case VER_PLATFORM_WIN32_WINDOWS:
- sprintf(p,"%s %d %d","Windows 95",OsVersion.dwMajorVersion,
- OsVersion.dwMinorVersion);
- break;
- case VER_PLATFORM_WIN32_NT:
- sprintf(p,"%s %d %d","Windows NT",OsVersion.dwMajorVersion,
- OsVersion.dwMinorVersion);
- break;
- default:
- break;
- }
-
- GetComputerName(q,&i);
- sprintf(q,"%-*s",MAX_COMPUTERNAME_LENGTH,qc);
- strncpy(hnf,q,MAX_COMPUTERNAME_LENGTH);
- strncpy(htf,q,MAX_COMPUTERNAME_LENGTH);
-
-#endif
- i = strlen(p);
- if (i > MAXINFO)
- i = MAXINFO;
- strncpy(osf,p,i);
-
- for (; i < MAXINFO; i++)
- *(osf+i) = ' ';
- return(0);
-}
diff --git a/src/packlib/fatmen/fmc/fmjob.c b/src/packlib/fatmen/fmc/fmjob.c
deleted file mode 100644
index 0dea62f..0000000
--- a/src/packlib/fatmen/fmc/fmjob.c
+++ /dev/null
@@ -1,71 +0,0 @@
-/*
- * $Id: fmjob.c,v 1.3 1997/09/02 12:56:54 mclareni Exp $
- *
- * $Log: fmjob.c,v $
- * Revision 1.3 1997/09/02 12:56:54 mclareni
- * WINNT correction
- *
- * Revision 1.2 1997/03/14 17:01:24 mclareni
- * WNT mods
- *
- * Revision 1.1.1.1.2.1 1997/01/21 11:27:29 mclareni
- * All mods for Winnt 96a on winnt branch
- *
- * Revision 1.1.1.1 1996/03/07 15:18:09 mclareni
- * Fatmen
- *
- */
-#include "fatmen/pilot.h"
-#include <stdio.h>
-#include <string.h>
-#ifndef WIN32
-#include <pwd.h>
-#else
-#include <windows.h>
-#endif
-
-#include "fmh.h"
-
-#if defined(CERNLIB_QXCAPT)
-#ifndef CERNLIB_MSSTDCALL
- int FMJOB(sf)
-#else
- int _stdcall FMJOB(sf, len_sf)
-#endif
-#endif
-
-#if defined(CERNLIB_QXNO_SC)
-int fmjob(sf)
-#endif
-#if defined(CERNLIB_QX_SC)
-int fmjob_(sf)
-#endif
-char *sf;
-#ifdef CERNLIB_MSSTDCALL
- int len_sf;
-#endif
-{
- int ruid;
-#ifndef WIN32
- struct passwd *pw;
-#endif
- int lname;
- int i;
-#ifndef WIN32
- ruid = getuid();
- pw = getpwuid(ruid);
- lname = strlen(pw->pw_name);
- if (lname > MAXNAME)
- lname = MAXNAME;
- strncpy(sf,pw->pw_name,lname);
-#else
- i = 0;
- GetUserName(sf,&lname);
-#endif
- *(sf+lname++) = '-';
- sprintf(sf+lname,"%-d",getpid());
-
- for (lname = i = strlen(sf); i < MAXJOBN; i++)
- *(sf+i) = ' ';
- return(lname);
-}
diff --git a/src/packlib/fatmen/fmc/fmuser.c b/src/packlib/fatmen/fmc/fmuser.c
deleted file mode 100644
index 181adc8..0000000
--- a/src/packlib/fatmen/fmc/fmuser.c
+++ /dev/null
@@ -1,61 +0,0 @@
-/*
- * $Id: fmuser.c,v 1.3 1997/09/02 12:56:55 mclareni Exp $
- *
- * $Log: fmuser.c,v $
- * Revision 1.3 1997/09/02 12:56:55 mclareni
- * WINNT correction
- *
- * Revision 1.2 1997/03/14 17:01:25 mclareni
- * WNT mods
- *
- * Revision 1.1.1.1.2.1 1997/01/21 11:27:30 mclareni
- * All mods for Winnt 96a on winnt branch
- *
- * Revision 1.1.1.1 1996/03/07 15:18:09 mclareni
- * Fatmen
- *
- */
-#include "fatmen/pilot.h"
-#include <stdio.h>
-#include <string.h>
-#ifndef WIN32
-#include <pwd.h>
-#endif
-
-#include "fmh.h"
-
-#if defined(CERNLIB_QXCAPT)
-# ifdef CERNLIB_MSSTDCALL
- int _stdcall FMUSER(sf,len_sf)
-#else
- int FMUSER(sf)
-#endif
-#endif
-#if defined(CERNLIB_QXNO_SC)
-int fmuser(sf)
-#endif
-#if defined(CERNLIB_QX_SC)
-int fmuser_(sf)
-#endif
-char *sf;
-#ifdef CERNLIB_MSSTDCALL
- int len_sf;
-#endif
-{
- char *p;
- int ruid;
- struct passwd *pw;
- int lname;
- int i;
-#ifndef WIN32
- ruid = getuid();
- pw = getpwuid(ruid);
- lname = strlen(pw->pw_name);
- if (lname > MAXNAME)
- lname = MAXNAME;
- strncpy(sf,pw->pw_name,lname);
- for (i=lname; i < MAXNAME; i++)
- *(sf+i) = ' ';
-#endif
- return(lname);
-}
diff --git a/src/packlib/fatmen/fmint/Imakefile b/src/packlib/fatmen/fmint/Imakefile
deleted file mode 100644
index b69954e..0000000
--- a/src/packlib/fatmen/fmint/Imakefile
+++ /dev/null
@@ -1,27 +0,0 @@
-DoIncludePackage(fatmen)
-#include "pilot.h"
-
-SRCS_F= fmclos.F fmcomp.F fmcopy.F fmcp.F fmdcb.F fmddir.F \ @@\
- fmdisk.F fmfilc.F fmfill.F fmfils.F fmfind.F fmfnms.F \ @@\
- fmfzcp.F fmgbyk.F fmgdsn.F fmget.F fmgeta.F fmgetc.F fmgeti.F \ @@\
- fmgetk.F fmgetl.F fmgetv.F fminit.F fmkdir.F fmlfil.F fmln.F \ @@\
- fmls.F fmmake.F fmmod.F fmmodu.F fmmv.F fmopen.F fmpuse.F \ @@\
- fmput.F fmputc.F fmputi.F fmputv.F fmrcop.F fmrepl.F \ @@\
- fmrm.F fmrmdr.F fmrmln.F fmsear.F fmselb.F fmselk.F fmselm.F \ @@\
- fmsho2.F fmshow.F fmsmcf.F fmspac.F fmtape.F fmtouc.F fmuniq.F \ @@\
- fmupdt.F fmupky.F fmuprt.F fmvers.F
-
-#if defined(CERNLIB_CZ)
-SRCS_F := $(SRCS_F) fmrin.F
-#endif
-
-#if defined(CERNLIB_FPACK)
-SRCS_F := $(SRCS_F) fmfpak.F
-#endif
-
-#ifdef CERNLIB_SHIFT
-CERNDEFINES:= $(CERNDEFINES) -DCERNLIB_SHIFT
-#endif
-
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/fatmen/fmint/fmclos.F b/src/packlib/fatmen/fmint/fmclos.F
deleted file mode 100644
index a9cd166..0000000
--- a/src/packlib/fatmen/fmint/fmclos.F
+++ /dev/null
@@ -1,909 +0,0 @@
-*
-* $Id: fmclos.F,v 1.1.1.1 1996/03/07 15:18:10 mclareni Exp $
-*
-* $Log: fmclos.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:10 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMCLOS(GNAME,CHLUN,LBANK,CHOPT,IRC)
-*
-* Close logical unit opened by FMOPEN and optionally
-* write updates to Zebra bank associated with this file.
-*
-#include "fatmen/faust.inc"
-#if defined(CERNLIB_VAXVMS)
- CHARACTER*16 RECTYP
-#endif
-#if defined(CERNLIB_APOLLO)
-#include "fatmen/fatapol3.inc"
-#endif
-#include "fatmen/fatstg.inc"
-#include "fatmen/fattyp.inc"
-#include "fatmen/fatbank.inc"
-#include "fatmen/fatpara.inc"
-#include "fatmen/fatinfo.inc"
-#include "fatmen/fatmon.inc"
-#include "fatmen/fmnkeys.inc"
- DIMENSION KEYS(LKEYFA)
- CHARACTER*80 STGCOM,CHLINE
- CHARACTER*255 GENAM,COMAND,CHFILE
- CHARACTER*(*) CHLUN,GNAME,CHOPT
- CHARACTER*4 FZOPT
- CHARACTER*8 DDNAME
- CHARACTER*6 CDEN
- CHARACTER*6 CHREC,CHBLK
- CHARACTER*4 RECFM
- CHARACTER*40 DCB
- CHARACTER*256 DSN
-#if defined(CERNLIB_IBMMVS)
- CHARACTER*8 CHFUNC
- CHARACTER*255 CHPARM
- CHARACTER*20 CHLEVL
-#endif
-#if !defined(CERNLIB_CRAY)
- PARAMETER (IQCHAW=4)
-#endif
-#if defined(CERNLIB_CRAY)
- PARAMETER (IQCHAW=8)
-#endif
- PARAMETER (MEGA=1024*1024)
- CHARACTER*6 VSN,VID,FSEQ
- CHARACTER*15 XVID
- CHARACTER*8 VIP
- CHARACTER*2 LABEL
- COMMON/FZSTAT/INFLUN,INFSTA,INFOFZ(40)
- CHARACTER*4 FFORM,FTEMP
- CHARACTER*12 CHDIR
- LOGICAL IOPEN
-#if defined(CERNLIB_UNIX)
- INTEGER SYSTEMF
-#endif
-#include "fatmen/tmsdef0.inc"
-#include "fatmen/fatlab0.inc"
-#include "fatmen/fatoptd.inc"
-#include "fatmen/tmsdef1.inc"
-#include "fatmen/fatlab1.inc"
-#include "fatmen/fatoptc.inc"
-
- NFCLOS = NFCLOS + 1
-*
-* Check options
-*
- LGN = LENOCC(GNAME)
- GENAM = GNAME(1:LGN)
- IF(IDEBFA.GE.3) WRITE(LPRTFA,9001) GENAM(1:LGN),CHLUN,LBANK,CHOPT
- 9001 FORMAT(' FMCLOS. enter for ',A,1X,A,1X,I10,1X,A)
-*
-* Is this entry a link?
-*
- IF(LBANK.NE.0.AND.IQ(LBANK+KOFUFA+MLOCFA).EQ.0) THEN
- CALL UHTOC(IQ(LBANK+KOFUFA+MFQNFA),4,GENAM,NFQNFA)
- NCH = LENOCC(GENAM)
- IF(IDEBFA.GE.0) WRITE(LPRTFA,9002) GNAME(1:LGN),GENAM(1:NCH)
- 9002 FORMAT(' FMCLOS. ',A,' --> ',A)
- LGN = NCH
- CALL VZERO(KEYS,LKEYFA)
- CALL FMGET(GENAM,LADDR,KEYS,IRC)
- IF (IRC.NE.0) GOTO 999
- ELSE
- LADDR = LBANK
- ENDIF
-*
-* CHOPT: C - issue STAGE CLEAR
-* D - issue STAGE DROP / EXEC DROP / DEASSIGN / DISMOUNT
-* E - call FZENDx
-* F - call FZINFO
-* N - do not issue FORTRAN or other close statement
-* P - issue STAGE PUT
-* U - update FATMEN catalogue with bank at LADDR
-* W - wait for the STAGE PUT to complete
-* Z - call MZDROP
-*
- CALL FMCHOP('FMCLOS. ',CHOPT,'CDEFNPUWZ',IC)
-
- IF(LBANK.EQ.0) IOPTP = 0
-*
-* Monitoring information
-*
- IHOWFA = 0
- ITIMFA = 0
- CHFNFA = ' '
- IRC = 0
- ICLOSE = IOPTN
- IUNIT = 0
- LCH = LENOCC(CHLUN)
- IF(LCH.LE.2) THEN
- IF (LCH .EQ. 1) THEN
- READ(CHLUN,9003) IUNIT
- ELSEIF(LCH .EQ. 2) THEN
- READ(CHLUN,9004) IUNIT
- ENDIF
-
- 9003 FORMAT(I1)
- 9004 FORMAT(I2)
- CALL FML2DD(IUNIT,DDNAME,IRC)
-*
-* FATMEN file format
-*
- IF(LADDR.NE.0) THEN
- CALL UHTOC(IQ(LADDR+KOFUFA+MFLFFA),4,FFORM,4)
- LFORM = LENOCC(FFORM)
-#if defined(CERNLIB_FPACK)
-*
-* FPACK
-*
- IF(FFORM(1:2).EQ.'FP') THEN
- CHFILE = CHLUN
- IF(IDEBFA.GE.0) WRITE(LPRTFA,9005) CHFILE(1:LCH)
- 9005 FORMAT(' FMCLOS. call FPARM for CLOSE ',A)
- CALL FPARM('CLOSE '//CHFILE(1:LCH))
- CALL FERMES(COMAND,1)
- IRC = LENOCC(COMAND)
- IF(IRC.NE.0.AND.IDEBFA.GE.-3) WRITE(LPRTFA,9006)
- + COMMAND(1:IRC)
- 9006 FORMAT(' FMOPEN. error from FPARM = ',A)
- RETURN
- ENDIF
-
-*
-* New Zebra uses FORTRAN I/O as default
-*
-#endif
-#if defined(CERNLIB_IBMVM)
- IF((FFORM(1:2).EQ.'FX').AND.
- + ((IUNIT.NE.0).AND.(JFMODE(IUNIT).EQ.2))) THEN
- DDNAME = 'VM00F001'
- WRITE(DDNAME(3:4),'(I2.2)') IUNIT
- ENDIF
-#endif
-
- IF((INDEX(CHLUN(1:LCH),'IOFILE').EQ.0).AND.
- + ((IUNIT.NE.0).AND.(JFMODE(IUNIT).NE.3))) THEN
- IF(FFORM(1:2).EQ.'FX') THEN
- FTEMP = FFORM
- FFORM = 'F'//FTEMP(1:LFORM)
- ENDIF
- ENDIF
-
- IF((FFORM(1:2).EQ.'FX').OR.(FFORM(1:2).EQ.'EP')) THEN
- DDNAME = 'IOFILE00'
- WRITE(DDNAME(7:8),'(I2.2)') IUNIT
- ENDIF
- ENDIF
-
- ELSE
- DDNAME = CHLUN
- ENDIF
-
- LDD = LENOCC(DDNAME)
-*
-* Get logical unit from DDNAME
-*
- IF(DDNAME(1:2).EQ.'FT') THEN
-*
-* IBM FORTRAN
-*
- READ(DDNAME(3:4),'(I2)') LUN
- ELSEIF(DDNAME(1:6).EQ.'IOFILE') THEN
-*
-* IOPACK
-*
- READ(DDNAME(7:8),'(I2)') LUN
- ELSEIF(DDNAME(1:2).EQ.'VM') THEN
-*
-* VMIO
-*
- READ(DDNAME(3:4),'(I2)') LUN
- ELSEIF(DDNAME(1:3).EQ.'FOR') THEN
-*
-* VAX FORTRAN
-*
- READ(DDNAME(4:6),'(I3)') LUN
- ELSEIF(DDNAME(1:5).EQ.'fort.') THEN
-*
-* Unix FORTRAN
-*
- IF(LDD.EQ.6) THEN
- READ(DDNAME(6:6),'(I1)') LUN
- ELSE
- READ(DDNAME(6:7),'(I2)') LUN
- ENDIF
- ENDIF
-
- IF(JFMODE(LUN).EQ.1) ICLOSE = 1
-
- IF(IOPTF.NE.0) THEN
-*
-* Get Zebra FZ information
-*
- CALL FZINFO(LUN)
- IF(INFLUN.NE.LUN) THEN
- IF(IDEBFA.GE.0) WRITE(LPRTFA,9007) LUN
- 9007 FORMAT(' FMCLOS. Error obtaining call FZINFO for LUN = ',I10)
- MBYTES = 0
- JSRDFA = 0
- JERDFA = 0
- JSBLFA = 0
- JEBLFA = 0
- ELSE
-*
-* FZ defines a MB as a million bytes...
-*
- MBYTES = (INFOFZ(19) + INFOFZ(20)/MEGA)*IQCHAW
- MBYTES = MBYTES * 1000000 / MEGA
- JSRDFA = 1
- JERDFA = INFOFZ(21)
- JSBLFA = 1
- JEBLFA = INFOFZ(22)
-
- ENDIF
-
- IF(IFMODE(LUN).EQ.0) THEN
- FATMZR = FATMZR + MBYTES
- ELSE
- FATMZW = FATMZW + MBYTES
- ENDIF
-
- ENDIF
-
- IF(IOPTE.NE.0) THEN
-*
-* Terminate option for FZ. For C I/O, use X option for CFCLOS
-*
- FZOPT = 'T'
-
- IF(JFMODE(LUN).EQ.1) THEN
- FZOPT = 'TX'
- ENDIF
-
- IF(IFMODE(LUN).EQ.0) THEN
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9008) LUN,FZOPT
- 9008 FORMAT(' FMCLOS. call FZENDI for LUN=',I6,' CHOPT = ',A)
- CALL FZENDI(LUN,FZOPT)
- ELSEIF(IFMODE(LUN).EQ.1) THEN
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9009) LUN,FZOPT
- 9009 FORMAT(' FMCLOS. call FZENDO for LUN=',I6,' CHOPT = ',A)
- CALL FZENDO(LUN,FZOPT)
- ELSEIF(IFMODE(LUN).EQ.2) THEN
- IF(LUN.LT.10)WRITE(CHDIR,9010)LUN
- IF(LUN.GE.10)WRITE(CHDIR,9011)LUN
- 9010 FORMAT('LUN',I1,' ')
- 9011 FORMAT('LUN',I2,' ')
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9012) LUN,CHDIR
- 9012 FORMAT(' FMCLOS. call RZEND for LUN=',I6,' CHDIR=',A)
- CALL RZEND(CHDIR)
- ENDIF
- ENDIF
-
- IF(ICLOSE.EQ.0) THEN
-
- IF(IDEBFA.GE.0) WRITE(LPRTFA,9013) LUN
- 9013 FORMAT(' FMCLOS. closing file on unit ',I5)
-*
-* Issue VMCLOS if CHLUN has a VMIO like pattern
-*
- IF(DDNAME(1:2).EQ.'VM') THEN
-#if defined(CERNLIB_IBMVM)
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9014)
- 9014 FORMAT(' FMCLOS. issuing VMCLOS')
- CALL VMCLOS(LUN,IRC,NBLOCK)
- IF(IRC.NE.0) WRITE(LPRTFA,9015) IRC
- 9015 FORMAT(' FMCLOS. return code ',I6,' from VMCLOS')
-*
-* Issue IOCLOS if CHLUN has a IOPACK like pattern
-*
- ELSEIF(DDNAME(1:6).EQ.'IOFILE') THEN
- CALL IOCLOS(LUN,IRC)
-#endif
- ELSE
-#if defined(CERNLIB_VAXVMS)
-*
-* Check if we are using C I/O
-*
- CALL FMGDSN(LADDR,DSN,LDSN,IRC)
- INQUIRE(FILE=DSN(1:LDSN),RECORDTYPE=RECTYP)
- IF(INDEX(RECTYP,'STREAM_LF').EQ.0.AND.
- + INDEX(FFORM,'FX').NE.0) THEN
-*
-* Medium
-*
- IF(LFMODE(LUN).EQ.3) THEN
- MEDIUM = 1
- ELSE
- MEDIUM = 0
- ENDIF
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9016)
- 9016 FORMAT(' FMCLOS. issuing CFCLOS')
- CALL CFCLOS(IFPNTR(LUN),MEDIUM)
- ELSE
- INQUIRE(LUN,OPENED=IOPEN)
- IF(IOPEN) THEN
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9017)
- 9017 FORMAT(' FMCLOS. issuing FORTRAN close')
- CLOSE(UNIT=LUN)
-#endif
-#if (defined(CERNLIB_VAXVMS))&&(defined(CERNLIB_CSPACK))
- ELSE
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9018)
- 9018 FORMAT(' FMCLOS. issuing XZCLOS')
- CALL XZCLOS(LUN,' ',IRC)
-#endif
-#if defined(CERNLIB_VAXVMS)
- ENDIF
- ENDIF
-#endif
-#if (!defined(CERNLIB_SHIFT))&&(!defined(CERNLIB_VAXVMS))
- INQUIRE(LUN,OPENED=IOPEN)
- IF(IOPEN) THEN
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9019)
- 9019 FORMAT(' FMCLOS. issuing FORTRAN close')
- CLOSE(UNIT=LUN)
-#endif
-#if (defined(CERNLIB_CSPACK))&&(!defined(CERNLIB_SHIFT))&&(!defined(CERNLIB_VAXVMS))
- ELSE
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9020)
- 9020 FORMAT(' FMCLOS. issuing XZCLOS')
- CALL XZCLOS(LUN,' ',IRC)
-#endif
-#if (!defined(CERNLIB_SHIFT))&&(!defined(CERNLIB_VAXVMS))
- ENDIF
-#endif
-#if defined(CERNLIB_SHIFT)
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9021)
- 9021 FORMAT(' FMCLOS. issuing XYCLOS')
- CALL XYCLOS(LUN,' ',IRC)
- IF(IDEBFA.GE.0) WRITE(LPRTFA,9022) IRC
- 9022 FORMAT(' FMCLOS. return code ',I6,' from XYCLOS')
-#endif
- ENDIF
-
- ENDIF
-
-*
-* IOPTC
-*
- IF(IOPTC.NE.0) THEN
- IF(LFMODE(LUN).EQ.2) THEN
-#if (defined(CERNLIB_UNIX))&&(defined(CERNLIB_SHIFT))
- WRITE(COMAND,9023) DDNAME
- 9023 FORMAT(' stageclr -P ',A)
- LCOMM = LENOCC(COMAND)
- IF(IDEBFA.GE.0) WRITE(LPRTFA,9024) COMAND(1:LCOMM)
- 9024 FORMAT(' FMCLOS. executing ',A)
- IRC = SYSTEMF(COMAND(1:LCOMM))
- IF(IRC.NE.0) GOTO 999
-#endif
-#if defined(CERNLIB_IBMVM)
- IF(IDEBFA.GE.0) PRINT *,
- + 'FMCLOS. Executing EXEC STAGE DROP '//DDNAME//' CLEAR'
- CALL VMCMS('EXEC STAGE DROP '//DDNAME//' (CLEAR',IRC)
-*
-* For input tapes, we have to say STAGE CLEAR as well
-*
- IF((IFMODE(LUN).EQ.0).AND.(LADDR.NE.0)) THEN
- CALL UHTOC(IQ(LADDR+KOFUFA+MVSNFA),4,VSN,6)
- LVSN = LENOCC(VSN)
- CALL CLTOU(VSN)
- CALL UHTOC(IQ(LADDR+KOFUFA+MVIDFA),4,VID,6)
- LVID = LENOCC(VID)
- CALL CLTOU(VID)
- CALL FMITOC(IQ(LADDR+KOFUFA+MFSQFA),FSEQ,LFSEQ)
-*
-* Set IQUEST(11) to media type in case volume unknown or
-* TMS option not installed.
-*
- IQUEST(11) = IQ(LADDR+KOFUFA+MMTPFA)
-#endif
-#if (defined(CERNLIB_PREFIX))&&(defined(CERNLIB_IBMVM))
- CALL FMXVID(VID,IQ(LADDR+KOFUFA+MVIPFA),XVID,VIP,'C',IC)
- LXVID = LENOCC(XVID)
- CALL FMQTMS(XVID(1:LXVID),
- + LIB,MODEL,DENS,MNTTYP,LABTYP,IC)
-#endif
-#if (!defined(CERNLIB_PREFIX))&&(defined(CERNLIB_IBMVM))
- CALL FMQTMS(VID(1:LVID),LIB,MODEL,DENS,MNTTYP,LABTYP,IC)
-#endif
-#if defined(CERNLIB_IBMVM)
- CALL CLTOU(LABTYP)
- LLAB = LENOCC(LABTYP)
- CALL VMCMS('EXEC STAGE CLEAR '//VSN(1:LVSN) // '.'
- + // FSEQ(1:LFSEQ)
-#endif
-#if (defined(CERNLIB_PREFIX))&&(defined(CERNLIB_IBMVM))
- + // '.' // LABTYP(1:LLAB) // '.' // VID(1:LVID)
- + // '.' // VIP(1:LENOCC(VIP)),IRC)
-#endif
-#if (!defined(CERNLIB_PREFIX))&&(defined(CERNLIB_IBMVM))
- + // '.' // LABTYP(1:LLAB) // '.' // VID(1:LVID),IRC)
-#endif
-#if defined(CERNLIB_IBMVM)
- ENDIF
-#endif
-#if defined(CERNLIB_VAXVMS)
-
- IF(IDEBFA.GE.0) PRINT *,
- + 'FMCLOS. Executing LIB$DELETE_FILE of '//DDNAME(1:LDD)
- ISTAT = LIB$DELETE_FILE(DDNAME(1:LDD))
-#include "fatmen/fatvaxrc.inc"
-#endif
-#if (defined(CERNLIB_IBMMVS))&&(defined(CERNLIB_DSYIBM))
-*
-* Issue STAGE DELETE call
-*
- CHFUNC = 'DELETE '
- CALL UHTOC(IQ(LADDR+KOFUFA+MFQNFA),4,DSN,NFQNFA)
- LDSN = LENOCC(DSN)
- LBLANK = INDEX(DSN,' ')
- IF(LBLANK.NE.0) LDSN = LBLANK
-
- IF(IDEBFA.GE.3) THEN
- CHLEVL = 'PRINTLEV=ALL ;'
- ELSEIF(IDEBFA.EQ.2) THEN
- CHLEVL = 'PRINTLEV=TRACE ;'
- ELSEIF(IDEBFA.EQ.1) THEN
- CHLEVL = 'PRINTLEV=WARNING ;'
- ELSEIF(IDEBFA.LE.-3) THEN
- CHLEVL = 'PRINTLEV=NOMESSAGE ;'
- ELSE
- CHLEVL = 'PRINTLEV=ERROR ;'
- ENDIF
-
- CHPARM(LPARM:LPARM) = ';'
-
- CALL STAGE(CHFUNC,IRC,ICODE,
- + 'DSN='//DSN(1:LDSN)//' ;',CHLEVL)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMCLOS. return code ',IRC,
- + ' from STAGE, reason code = ',ICODE
- ENDIF
-
-#endif
- ELSEIF(LFMODE(LUN).EQ.3) THEN
-#if defined(CERNLIB_IBMVM)
- IF(IDEBFA.GE.0) PRINT *,'FMCLOS. Detaching tape unit'
- ITAPE = 179 + IVADDR(LUN)
- IF(IVADDR(LUN).GT.8) ITAPE = 287 + IVADDR(LUN)
- CALL CFILL(' ',STGCOM,1,80)
- WRITE(STGCOM,'(A,I3)') 'CP DETACH ',ITAPE
- CALL VMCMS(STGCOM,IRC)
-*
-* Flag tape unit as no longer used
-*
- IDEV(IVADDR(LUN)) = 0
-#endif
-#if (defined(CERNLIB_IBMVM))&&(defined(CERNLIB_TAPESYS))
- IF(LADDR.NE.0) THEN
- CALL UHTOC(IQ(LADDR+KOFUFA+MVSNFA),4,VSN,6)
- LVSN = LENOCC(VSN)
- CALL CLTOU(VSN)
- CALL UHTOC(IQ(LADDR+KOFUFA+MVIDFA),4,VID,6)
- LVID = LENOCC(VID)
- STGCOM = 'EXEC TAPESYS CANCEL '//VID(1:LVID)
- IF(VSN(1:LVSN).NE.VID(1:LVID)) THEN
- LCOM = LENOCC(STGCOM)
- STGCOM = STGCOM(1:LCOM) // ' ( EXTID'
- ENDIF
-
- LCOM = LENOCC(STGCOM)
-
- IF(IDEBFA.GE.0) PRINT *,'FMCLOS. executing ',
- + STGCOM(1:LCOM)
- CALL VMCMS(STGCOM(1:LCOM),IRC)
- ENDIF
-#endif
-#if (defined(CERNLIB_IBMVM))&&(defined(CERNLIB_SETUP))
- IF(IDEBFA.GE.0) PRINT *,'FMCLOS. executing SETUP CLEAR'
- CALL VMCMS('SETUP CLEAR',IRC)
-#endif
- ELSE
- IF(IDEBFA.GE.0)
- + PRINT *,'FMCLOS. Clear option not valid for disk datasets'
- ENDIF
-
- ENDIF
-*
-* IOPTP
-*
- IF(IOPTP.NE.0.AND.IQ(LADDR+KOFUFA+MMTPFA).GT.1) THEN
- IF(LFMODE(LUN).EQ.2) THEN
-#if (defined(CERNLIB_UNIX))&&(defined(CERNLIB_SHIFT))
- WRITE(COMAND,9025) IUNIT
- 9025 FORMAT(' stageput -G -U ',I2)
- LCOMM = LENOCC(COMAND)
- IF(IDEBFA.GE.0) WRITE(LPRTFA,9026) COMAND(1:LCOMM)
- 9026 FORMAT(' FMCLOS. executing ',A)
- IRC = SYSTEMF(COMAND(1:LCOMM))
- IF(IRC.NE.0) GOTO 999
-#endif
-#if (defined(CERNLIB_VAXVMS))&&(defined(CERNLIB_VAXTAP))
- CALL UHTOC(IQ(LADDR+KOFUFA+MFQNFA),4,DSN,NFQNFA)
- LDSN = LENOCC(DSN)
- LBLANK = INDEX(DSN,' ')
- IF(LBLANK.NE.0) LDSN = LBLANK
- CALL UHTOC(IQ(LADDR+KOFUFA+MVSNFA),4,VSN,6)
- LVSN = LENOCC(VSN)
- CALL CLTOU(VSN)
- CALL UHTOC(IQ(LADDR+KOFUFA+MVIDFA),4,VID,6)
- LVID = LENOCC(VID)
- CALL CLTOU(VID)
- CALL FMITOC(IQ(LADDR+KOFUFA+MFSQFA),FSEQ,LFSEQ)
-*
-* Get DCB information
-*
- CALL UHTOC(IQ(LADDR+KOFUFA+MRFMFA),4,RECFM,4)
- LRECL = IQ(LADDR+KOFUFA+MRLNFA)*4
- LBLOCK = IQ(LADDR+KOFUFA+MBLNFA)*4
-*
-* Set IQUEST(11) to media type in case volume unknown or
-* TMS option not installed.
-*
- IQUEST(11) = IQ(LADDR+KOFUFA+MMTPFA)
-#endif
-#if (defined(CERNLIB_PREFIX))&&(defined(CERNLIB_VAXVMS))&&(defined(CERNLIB_VAXTAP))
- CALL FMXVID(VID,IQ(LADDR+KOFUFA+MVIPFA),XVID,VIP,'C',IC)
- LXVID = LENOCC(XVID)
- CALL FMQTMS(XVID(1:LXVID),LIB,MODEL,DENS,MNTTYP,LABTYP,
- + IC)
- IF(IDEBFA.GE.3) THEN
- PRINT *,'FMCLOS. return from FMQTMS with ', XVID,'/',
- + LIB,'/',MODEL,'/',DENS,'/',MNTTYP,'/', LABTYP,'/',IC
- ENDIF
-#endif
-#if (!defined(CERNLIB_PREFIX))&&(defined(CERNLIB_VAXVMS))&&(defined(CERNLIB_VAXTAP))
- CALL FMQTMS(VID(1:LVID),LIB,MODEL,DENS,MNTTYP,LABTYP,IC)
- IF(IDEBFA.GE.3) THEN
- PRINT *,'FMCLOS. return from FMQTMS with ', VID,'/',
- + LIB,'/',MODEL,'/',DENS,'/',MNTTYP,'/', LABTYP,'/',IC
- ENDIF
-#endif
-#if (defined(CERNLIB_VAXVMS))&&(defined(CERNLIB_VAXTAP))
-
- CDEN = CHMDEN(IQ(LADDR+KOFUFA+MMTPFA))
- IF(IC.EQ.0) CDEN = DENS
- CALL CLTOU(LABTYP)
-*
-* Translate IBM to VAX labels (SL->EBCDIC etc.)
-*
- JL = ICNTH(LABTYP,IBMLAB,3)
- STGCOM = '$STAGE/WRITE ' // VSN(1:LVSN) // ' '
- + // VID(1:LVID) // ' '
- + // '/NAME=' // DSN(1:LDSN)
- + // '/NUMBER=' // FSEQ(1:LFSEQ)
- + // '/GENERIC='// MODEL
- + // '/LABEL='// VAXLAB(JL)
- IF(INDEX(RECFM,'F').NE.0) THEN
- STGCOM = STGCOM(1:LENOCC(STGCOM)) // '/FIXED'
- ELSEIF(INDEX(RECFM,'V').NE.0) THEN
- STGCOM = STGCOM(1:LENOCC(STGCOM)) // '/VARIABLE'
- ENDIF
- WRITE(CHREC,'(I6.6)') LRECL
- WRITE(CHBLK, '(I6.6)') LBLOCK
- IF(LRECL.GT.0) STGCOM = STGCOM(1:LENOCC(STGCOM)) //
- + '/RECORDSIZE='//CHREC
- IF(LBLOCK.GT.0) STGCOM = STGCOM(1:LENOCC(STGCOM)) //
- + '/BLOCKSIZE='//CHBLK
-*
- LENCOM = LENOCC(STGCOM)
-*
-
-#endif
-#if (defined(CERNLIB_VAXVMS))&&(defined(CERNLIB_VAXTAP))&&(!defined(CERNLIB_TMS))
-*
-* Add density
-*
- STGCOM = STGCOM(1:LENCOM) // '/DENSITY=' // DENS
- LENCOM = LENOCC(STGCOM)
-#endif
-#if (defined(CERNLIB_VAXVMS))&&(defined(CERNLIB_VAXTAP))
- CALL CSQMBL(COMAND,1,LENCOM)
- LENCOM = LENOCC(COMAND)
- IF(IDEBFA.GE.0) PRINT *,'FMCLOS. executing ',
- + COMAND(1:LENCOM)
-*
- IC = SYSTEMF(COMAND(1:LENCOM))
-
-#endif
-#if defined(CERNLIB_SHIFT)
- CALL UHTOC(IQ(LADDR+KOFUFA+MFQNFA),4,DSN,NFQNFA)
- LDSN = LENOCC(DSN)
- LBLANK = INDEX(DSN,' ')
- IF(LBLANK.NE.0) LDSN = LBLANK
- CALL UHTOC(IQ(LADDR+KOFUFA+MVSNFA),4,VSN,6)
- LVSN = LENOCC(VSN)
- CALL CLTOU(VSN)
- CALL UHTOC(IQ(LADDR+KOFUFA+MVIDFA),4,VID,6)
- LVID = LENOCC(VID)
- CALL CLTOU(VID)
-*
-* Get DCB information
-*
- CALL UHTOC(IQ(LADDR+KOFUFA+MRFMFA),4,RECFM,4)
- LRECL = IQ(LADDR+KOFUFA+MRLNFA)*4
- LBLOCK = IQ(LADDR+KOFUFA+MBLNFA)*4
-*
-* Set IQUEST(11) to media type in case volume unknown or
-* TMS option not installed.
-*
- IQUEST(11) = IQ(LADDR+KOFUFA+MMTPFA)
-#endif
-#if (defined(CERNLIB_PREFIX))&&(defined(CERNLIB_SHIFT))
- CALL FMXVID(VID,IQ(LADDR+KOFUFA+MVIPFA),XVID,VIP,'C',IC)
- LXVID = LENOCC(XVID)
- CALL FMQTMS(XVID(1:LXVID),LIB,MODEL,DENS,MNTTYP,LABTYP,
- + IC)
- IF(IDEBFA.GE.3) THEN
- PRINT *,'FMCLOS. return from FMQTMS with ', XVID,'/',
- + LIB,'/',MODEL,'/',DENS,'/',MNTTYP,'/', LABTYP,'/',IC
- ENDIF
-#endif
-#if (!defined(CERNLIB_PREFIX))&&(defined(CERNLIB_SHIFT))
- CALL FMQTMS(VID(1:LVID),LIB,MODEL,DENS,MNTTYP,LABTYP,IC)
- IF(IDEBFA.GE.3) THEN
- PRINT *,'FMCLOS. return from FMQTMS with ', VID,'/',
- + LIB,'/',MODEL,'/',DENS,'/',MNTTYP,'/', LABTYP,'/',IC
- ENDIF
-#endif
-#if defined(CERNLIB_SHIFT)
-
- CALL CUTOL(LABTYP)
- CDEN = CHMDEN(IQ(LADDR+KOFUFA+MMTPFA))
- IF(IC.EQ.0) CDEN = DENS
- CALL FMITOC(IQ(LADDR+KOFUFA+MFSQFA),FSEQ,LFSEQ)
- COMAND = 'stageout -G -U '//CHLUN(1:LCH)
- + // ' -v '//VSN(1:LVSN)// ' -V '
- + //VID(1:LVID)//' -l '//LABTYP//' -g '//MODEL
- + // ' -q ' //FSEQ(1:LFSEQ) // ' -f '//DSN(1:LDSN)
- LENCOM = LENOCC(COMAND)
- WRITE(DCB,9027) RECFM,LRECL,LBLOCK
- 9027 FORMAT(' -F ',A,' -L ',I5,' -b ',I5)
- COMAND = COMAND(1:LENOCC(COMAND)) // DCB
- LENCOM = LENOCC(COMAND)
-
-#endif
-#if (defined(CERNLIB_SHIFT))&&(!defined(CERNLIB_TMS))
-*
-* Add density
-*
- COMAND = COMAND(1:LENCOM) // ' -d ' // DENS
- LENCOM = LENOCC(COMAND)
-#endif
-#if defined(CERNLIB_SHIFT)
- CALL CSQMBL(COMAND,1,LENCOM)
- LENCOM = LENOCC(COMAND)
- IF(IDEBFA.GE.0) PRINT *,'FMCLOS. executing ',
- + COMAND(1:LENCOM)
-*
- IRC = SYSTEMF(COMAND(1:LENCOM))
-
-#endif
-#if defined(CERNLIB_IBMVM)
- IF(IOPTW.NE.0) THEN
- IF(IDEBFA.GE.0) PRINT *, 'FMCLOS. Executing EXEC STAGE PUT '
- + // DDNAME,' (WAIT)'
- CALL VMCMS('EXEC STAGE PUT '//DDNAME//' (WAIT)',IRC)
- ELSE
- IF(IDEBFA.GE.0) PRINT *, 'FMCLOS. Executing EXEC STAGE PUT '
- + // DDNAME
- CALL VMCMS('EXEC STAGE PUT '//DDNAME,IRC)
- ENDIF
-
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.-3) WRITE(LPRTFA,9028) IRC
- 9028 FORMAT(' FMCLOS. return code ',I10,' from STAGE PUT')
- GOTO 999
- ENDIF
-*
-* STAGE PUT does a drop
-*
- IOPTD = 0
-#endif
-#if defined(CERNLIB_CRAY)
-
- IF(IDEBFA.GE.0) PRINT *, 'FMCLOS. Executing stageput '//
- + DDNAME
- IC = SYSTEMF('stageput '//DDNAME)
-#endif
-#if defined(CERNLIB_APOLLO)
- IF(IAPOL3.NE.0) THEN
- CALL UHTOC(IQ(LADDR+KOFUFA+MFQNFA),4,DSN,NFQNFA)
- LDSN = LENOCC(DSN)
- LBLANK = INDEX(DSN,' ')
- IF(LBLANK.NE.0) LDSN = LBLANK
- CALL UHTOC(IQ(LADDR+KOFUFA+MVSNFA),4,VSN,6)
- LVSN = LENOCC(VSN)
- CALL CLTOU(VSN)
- CALL UHTOC(IQ(LADDR+KOFUFA+MVIDFA),4,VID,6)
- LVID = LENOCC(VID)
- CALL CLTOU(VID)
- CALL FMITOC(IQ(LADDR+KOFUFA+MFSQFA),FSEQ,LFSEQ)
-*
-* Get DCB information
-*
- CALL UHTOC(IQ(LADDR+KOFUFA+MRFMFA),4,RECFM,4)
- LRECL = IQ(LADDR+KOFUFA+MRLNFA)*4
- LBLOCK = IQ(LADDR+KOFUFA+MBLNFA)*4
-*
-* Set IQUEST(11) to media type in case volume unknown or
-* TMS option not installed.
-*
- IQUEST(11) = IQ(LADDR+KOFUFA+MMTPFA)
-#endif
-#if (defined(CERNLIB_PREFIX))&&(defined(CERNLIB_APOLLO))
- CALL FMXVID(VID,IQ(LADDR+KOFUFA+MVIPFA),XVID,VIP,'C',IC)
- LXVID = LENOCC(XVID)
- CALL FMQTMS(XVID(1:LXVID),LIB,MODEL,DENS,MNTTYP,LABTYP,IC)
- IF(IDEBFA.GE.3) THEN
- PRINT *,'FMCLOS. return from FMQTMS with ', XVID,'/',LIB,
- + '/',MODEL,'/',DENS,'/',MNTTYP,'/', LABTYP,'/',IC
- ENDIF
-#endif
-#if (!defined(CERNLIB_PREFIX))&&(defined(CERNLIB_APOLLO))
- CALL FMQTMS(VID(1:LVID),LIB,MODEL,DENS,MNTTYP,LABTYP,IC)
- IF(IDEBFA.GE.3) THEN
- PRINT *,'FMCLOS. return from FMQTMS with ', VID,'/',LIB,
- + '/',MODEL,'/',DENS,'/',MNTTYP,'/', LABTYP,'/',IC
- ENDIF
-#endif
-#if defined(CERNLIB_APOLLO)
-
- CDEN = CHMDEN(IQ(LADDR+KOFUFA+MMTPFA))
- IF(IC.EQ.0) CDEN = DENS
- CALL CLTOU(LABTYP)
- STGCOM = 'l3stage -o '
- + // ' -v '
- + //VID(1:LVID)//' -l '//LABTYP//' -t '//MODEL
- + // ' -f ' //FSEQ(1:LFSEQ)// ' -d '//CDEN
- + // ' -n ' //DSN(1:LDSN)
- LENSTG = LENOCC(STGCOM)
- LENPTH = LENOCC(STGPTH)
- WRITE(DCB,9029) RECFM,LRECL,LBLOCK
- 9029 FORMAT(' -r ',A,' -c ',I5,' -b ',I5)
- CALL FMFNME(CHFILE)
- LCHF = LENOCC(CHFILE)
- IF(IDEBFA.GE.3) PRINT *,'FMCLOS. output of STAGE command ',
- + 'will be sent to /tmp/'//CHFILE(1:LCHF)
- COMAND =
- + STGCOM(1:LENSTG)//DCB//STGPTH(1:LENPTH)
- + // ' > /tmp/'//CHFILE(1:LCHF)
- LENCOM = LENOCC(COMAND)
-
- CALL CSQMBL(COMAND,1,LENCOM)
- LENCOM = LENOCC(COMAND)
- IF(IDEBFA.GE.0) PRINT *,'FMCLOS. executing ',
- + COMAND(1:LENCOM)
- ISTAT = 0
- 10 CONTINUE
-*
- IC = SYSTEMF(COMAND(1:LENCOM))
-
-* Check output of stage command
-*
- OPEN(LUN,FILE='/tmp/'//CHFILE(1:LCHF),STATUS='OLD',
- + FORM='FORMATTED')
- 20 READ(LUN,'(A)',END=30 ) CHLINE
- LCHL = LENOCC(CHLINE)
- IF(IDEBFA.GE.0) PRINT *,'FMCLOS. ',CHLINE(1:LCHL)
- IF(INDEX(CHLINE(1:LCHL),'path : ').NE.0) THEN
- ISTART = INDEX(CHLINE(1:LCHL),'/')
- STGPTH = CHLINE(ISTART:)
- ELSEIF(INDEX(CHLINE(1:LCHL),'stat : ').NE.0) THEN
- ISTAT = 1
- IF(INDEX(CHLINE(1:LCHL),'ABORTED').NE.0) THEN
- IRC = -1
- RETURN
- ELSEIF(INDEX(CHLINE(1:LCHL),'ENDED_OK').NE.0) THEN
- GOTO 30
- ENDIF
- ENDIF
- GOTO 20
- 30 CLOSE(LUN)
- IF(ISTAT.EQ.0) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMCLOS. no status return ',
- + 'from stage. Will retry in 60 seconds'
- CALL SLEEPF(60)
- GOTO 10
- ENDIF
-
- ENDIF
-#endif
- ENDIF
- ENDIF
-*
-* IOPTD
-*
- IF(IOPTD.NE.0) THEN
- IF(LFMODE(LUN).EQ.1) THEN
-#if defined(CERNLIB_IBMVM)
- IF(INDEX(CHMODE(LUN),'A').NE.0) THEN
- IF(IDEBFA.GE.0) PRINT *,
- + 'FMCLOS. DROP ignored for mode '//CHMODE(LUN)
- ELSE
- IF(IDEBFA.GE.0) PRINT *,
- + 'FMCLOS. Executing DROP '//CHMODE(LUN)
- CALL VMCMS('EXEC DROP '//CHMODE(LUN),IRC)
- ENDIF
-#endif
-#if defined(CERNLIB_VAXVMS)
- IF(IDEBFA.GE.0) PRINT *,
- + 'FMCLOS. Executing $DEASSIGN '//DDNAME(1:LDD)
- ISTAT = LIB$SPAWN('$DEASSIGN '//DDNAME(1:LDD))
-#include "fatmen/fatvaxrc.inc"
-#endif
- ELSEIF(LFMODE(LUN).EQ.2) THEN
-#if (defined(CERNLIB_SHIFT))&&(defined(CERNLIB_UNIX))
- IF(IDEBFA.GE.0) PRINT 9030
- 9030 FORMAT(' FMCLOS. removing symbolic link(s)')
- CALL UNLINKF(DDNAME)
- IF(LADDR.NE.0) THEN
- CALL UHTOC(IQ(LADDR+KOFUFA+MVIDFA),4,VID,6)
- LVID = LENOCC(VID)
- CALL CLTOU(VID)
- CALL FMITOC(IQ(LADDR+KOFUFA+MFSQFA),FSEQ,LFSEQ)
- CALL UNLINKF('T'//VID(1:LVID)//'.FSEQ'//FSEQ(1:LFSEQ))
- ENDIF
-#endif
-#if defined(CERNLIB_IBMVM)
- IF(IDEBFA.GE.0) PRINT *, 'FMCLOS. Executing STAGE DROP '//
- + DDNAME
- CALL VMCMS('EXEC STAGE DROP '//DDNAME,IRC)
-#endif
- ELSEIF(LFMODE(LUN).EQ.3) THEN
-#if defined(CERNLIB_IBMVM)
- IF(IDEBFA.GE.0) PRINT *,'FMCLOS. Detaching tape unit'
- ITAPE = 179 + IVADDR(LUN)
- IF(IVADDR(LUN).GT.8) ITAPE = 287 + IVADDR(LUN)
- CALL CFILL(' ',STGCOM,1,80)
- WRITE(STGCOM,'(A,I3)') 'CP DETACH ',ITAPE
- CALL VMCMS(STGCOM,IRC)
-*
-* Flag tape unit as no longer used
-*
- IDEV(IVADDR(LUN)) = 0
- IF(IDEBFA.GE.0) PRINT *,'FMCLOS. executing SETUP CLEAR'
- CALL VMCMS('SETUP CLEAR',IRC)
-#endif
-#if defined(CERNLIB_VAXVMS)
- ISTAT = LIB$SPAWN('$DISMOUNT '//DDNAME(1:LDD))
-#include "fatmen/fatvaxrc.inc"
-#endif
- ENDIF
-
- ENDIF
-*
-* IOPTU
-*
- IF(IOPTU.NE.0) THEN
-
- IF (LADDR.NE.0) THEN
- IF(IOPTF.NE.0) THEN
- IQ(LADDR+KOFUFA+MFSZFA) = MBYTES
- IQ(LADDR+KOFUFA+MSRDFA) = JSRDFA
- IQ(LADDR+KOFUFA+MERDFA) = JERDFA
- IQ(LADDR+KOFUFA+MSBLFA) = JSBLFA
- IQ(LADDR+KOFUFA+MEBLFA) = JEBLFA
- ENDIF
- CALL FMREPL(GENAM,LADDR,'C',IRC)
- ELSE
- IF(IDEBFA.GE.0) PRINT *,
- + 'FMCLOS. Bank address is zero, update request ignored'
- ENDIF
-
- ENDIF
-
- IF(IOPTZ.NE.0) THEN
-
- IF (LADDR.NE.0) THEN
- IF(IDEBFA.GE.0) PRINT *,
- + 'FMCLOS. dropping bank at address ',LBANK
- CALL MZDROP(IDIVFA,LBANK,' ')
- LADDR = 0
- ELSE
- IF(IDEBFA.GE.0) PRINT *,
- + 'FMCLOS. Bank address is zero, MZDROP request ignored'
- ENDIF
-
- ENDIF
-
- 999 END
diff --git a/src/packlib/fatmen/fmint/fmcomp.F b/src/packlib/fatmen/fmint/fmcomp.F
deleted file mode 100644
index 5720116..0000000
--- a/src/packlib/fatmen/fmint/fmcomp.F
+++ /dev/null
@@ -1,105 +0,0 @@
-*
-* $Id: fmcomp.F,v 1.1.1.1 1996/03/07 15:18:10 mclareni Exp $
-*
-* $Log: fmcomp.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:10 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMCOMP(GENAM1,LBANK1,KEYS1,GENAM2,LBANK2,KEYS2,IRC)
-*
-* Subroutine to compare the FATMEN banks pointed to by
-* input generic names/keys/bank address
-* If LBANKn not zero, GENAMn is not used.
-* Otherwise the bank is fetched from the RZ file using FMGETK
-*
-#include "fatmen/fatpara.inc"
-#include "fatmen/fatbank.inc"
- CHARACTER*(*) GENAM1,GENAM2
- PARAMETER (LKEYFA=10)
- DIMENSION KEYS1(LKEYFA),KEYS2(LKEYFA)
-
- IRC = 0
-
- IF(LBANK1.EQ.0) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMCOMP. get bank for GENAM1'
- CALL FMGETK(GENAM1,LBANK1,KEYS1,IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.0)
- + PRINT *,'FMCOMP. Return code ',IRC,' from FMGETK'
- IRC = 1
- RETURN
- ENDIF
- ELSE
- IF(IDEBFA.GE.0)
- + PRINT *,'FMCOMP. user supplied bank for GENAM1'
- ENDIF
-
- IF(LBANK2.EQ.0) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMCOMP. get bank for GENAM2'
- CALL FMGETK(GENAM2,LBANK2,KEYS2,IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.0)
- + PRINT *,'FMCOMP. Return code ',IRC,' from FMGETK'
- IRC = 1
- RETURN
- ENDIF
- ELSE
- IF(IDEBFA.GE.0)
- + PRINT *,'FMCOMP. user supplied bank for GENAM2'
- ENDIF
-
-
- IF(KEYS1(MKMTFA).NE.KEYS2(MKMTFA)) THEN
- IF(IDEBFA.GE.2) PRINT *,'FMCOMP. conflicting media types:',
- + KEYS1(MKMTFA),KEYS2(MKMTFA)
- IRC = 3
- RETURN
- ENDIF
-
- IF(KEYS1(MKMTFA) .EQ. 1) THEN
-*
-* Disk data set, match MFQNFA, MHSNFA
-*
- DO 10 IOFF=MFQNFA+KOFUFA,MCPLFA+KOFUFA
- IF(IQ(LBANK1+IOFF).NE.IQ(LBANK2+IOFF)) THEN
- IF(IDEBFA.GE.2) PRINT 8001,IOFF-KOFUFA, IQ(LBANK1+IOFF),
- + IQ(LBANK2+IOFF)
- 8001 FORMAT(' FMCOMP. Comparison failed at ',I5,1X,
- + A4,1X,A4,' (old/new)')
- IRC = 4
- RETURN
- ENDIF
-
- 10 CONTINUE
-
- ELSE
-*
-* Tape data set, match MVSNFA, MVIDFA, MFSQFA
-*
- DO 20 IOFF=MVSNFA+KOFUFA,MVIPFA-1+KOFUFA
- IF(IQ(LBANK1+IOFF).NE.IQ(LBANK2+IOFF)) THEN
- IF(IDEBFA.GE.2) PRINT 8001,IOFF-KOFUFA, IQ(LBANK1+IOFF),
- + IQ(LBANK2+IOFF)
- IRC = 5
- RETURN
- ENDIF
-
- 20 CONTINUE
-
- IF(IQ(LBANK1+MFSQFA+KOFUFA).NE. IQ(LBANK2+MFSQFA+KOFUFA))
- + THEN
- IF(IDEBFA.GE.2) PRINT 8002,MFSQFA, IQ(LBANK1+MFSQFA+KOFUFA)
- + ,IQ(LBANK2+MFSQFA+KOFUFA)
- 8002 FORMAT(' FMCOMP. Comparison failed at ',I5,I4,1X,I4)
- IRC = 5
- RETURN
- ENDIF
-
- ENDIF
-*
-* Found a matching bank
-*
- IF(IDEBFA.GE.2) PRINT *,'FMCOMP. match succeeded '
- END
diff --git a/src/packlib/fatmen/fmint/fmcopy.F b/src/packlib/fatmen/fmint/fmcopy.F
deleted file mode 100644
index d1f5e25..0000000
--- a/src/packlib/fatmen/fmint/fmcopy.F
+++ /dev/null
@@ -1,863 +0,0 @@
-*
-* $Id: fmcopy.F,v 1.1.1.1 1996/03/07 15:18:10 mclareni Exp $
-*
-* $Log: fmcopy.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:10 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMCOPY(GENAM1,LBANK1,KEYS1,GENAM2,LBANK2,KEYS2,
- +CHOPT,IRC)
-*
-* Subroutine to copy the dataset referenced by GENAM1 to GENAM2.
-* If LBANKn not zero, GENAMn is not used.
-* Otherwise the bank is fetched from the RZ file using FMGETK
-*
-* Options:
-* A - input already staged (i.e. from FMSMCF)
-* if IOPTA.NE.0 cannot call FMOPEN!
-* C - use STAGE CHANGE, implies S
-* K - queue to CHEOPS
-* S - STAGE the input file
-* W - with option Z - WAIT for output stage to complete
-* Z - STAGE the output file
-* F - use FZIN/FZOUT to permit conversion of FZ formats
-* (triggered automatically if file format is F*
-* but different in input/output banks)
-* R - skip Zebra start-of-run/end-of-run records
-* U - update catalogue with bank at LBANK2
-* P - physical copy - this is the default
-*
-#include "fatmen/faust.inc"
-#include "fatmen/fatupd.inc"
-#include "fatmen/fatpara.inc"
-#include "fatmen/fatbank.inc"
-#include "fatmen/fatstg.inc"
-#include "fatmen/fattyp.inc"
-#if defined(CERNLIB_CRAY)
- CHARACTER*255 CHFIN,CHFOUT
-#endif
- CHARACTER*(*) CHOPT
- INTEGER SYSTEMF,FMNODE,FMHOST,FMUSER
- CHARACTER*8 DDNAM1,DDNAM2
- CHARACTER*4 CHOPE,CHOPI,CHOPO,CHOPTF
- CHARACTER*20 FN1,FN2
- CHARACTER*(*) GENAM1,GENAM2
- CHARACTER*80 COMAND
- CHARACTER*6 VSN1,VID1,FSEQ1,VSN2,VID2,FSEQ2
- CHARACTER*15 XVID1,XVID2
- CHARACTER*8 VIP1,VIP2
- CHARACTER*6 VAXLAB,CHRECL,CHBLK
- CHARACTER*256 DSN1,DSN2
- CHARACTER*4 DEV1,DEV2,LAB1,LAB2
- CHARACTER*8 USER1,ADDR1,USER2,ADDR2
- CHARACTER*8 HOST1,HOST2
- CHARACTER*40 DCB1,DCB2
- CHARACTER*4 RECFM1,RECFM2
- CHARACTER*4 FFORM1,FFORM2
- CHARACTER*6 CDEN1,CDEN2
- CHARACTER*8 LIB1,LIB2
- CHARACTER*8 CHUSER,CHHOST,CHTYPE,CHSYS
- DIMENSION BUFFER(8172)
- PARAMETER (LKEYFA=10)
- DIMENSION KEYS1(LKEYFA),KEYS2(LKEYFA)
-#include "fatmen/tmsdef0.inc"
-#include "fatmen/fatvid0.inc"
-#include "fatmen/fatoptd.inc"
-#include "fatmen/fatvid1.inc"
-#include "fatmen/tmsdef1.inc"
-#include "fatmen/fatoptc.inc"
-
- NFCOPY = NFCOPY + 1
- IRC = 0
- LGN1 = LENOCC(GENAM1)
- LGN2 = LENOCC(GENAM2)
- IF(IDEBFA.GE.0) THEN
- PRINT *,'FMCOPY. enter for ',GENAM1(1:LGN1),
- + ' options = ',CHOPT
- IF(GENAM2(1:LGN2).NE.GENAM1(1:LGN1)) PRINT *,'FMCOPY. ',
- + 'output generic name is ',GENAM2(1:LGN2)
- IF(LBANK1.NE.0) PRINT *,'FMCOPY. user-supplied bank for ',
- + 'input generic name'
- IF(LBANK2.NE.0) PRINT *,'FMCOPY. user-supplied bank for ',
- + 'output generic name'
- ENDIF
-*
-* Check authorisation
-*
- IC = FMUSER(CHUSER)
- IC = FMHOST(CHHOST,CHTYPE,CHSYS)
- CALL CLTOU(CHUSER)
- CALL CLTOU(CHHOST)
- CALL FMACL(CHUSER,CHHOST,GENAM2(1:LGN2),'COPY','A',IRC)
- IF(IRC.NE.0) THEN
- NVIOL = NVIOL + 1
- IF(NVIOL.GT.MAXVIO) CALL ZFATAM
- + ('Maximum number of security violations exceeded')
- PRINT *,'FMCOPY. you are not authorised to copy to ',
- + GENAM2(1:LGN2)
- RETURN
- ENDIF
-
- IF(IOPTC.NE.0) IOPTS = 1
-*
-* Save bank addresses in link area
-*
- IF(LBANK1.NE.0) LOLDFA = LBANK1
- IF(LBANK2.NE.0) LNEWFA = LBANK2
- LTDSFA = 0
-
- IRC = 0
-
- IF(LBANK1.EQ.0) THEN
- CALL FMGETK(GENAM1,LBANK1,KEYS1,IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.2)
- + PRINT *,'FMCOPY. Return code ',IRC,' from FMGETK'
- IRC = 1
- RETURN
- ELSE
- LOLDFA = LBANK1
- LTDSFA = 0
- ENDIF
- ENDIF
-
- IF(LBANK2.EQ.0) THEN
- CALL FMGETK(GENAM2,LBANK2,KEYS2,IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.2)
- + PRINT *,'FMCOPY. Return code ',IRC,' from FMGETK'
- IRC = 1
- RETURN
- ELSE
- LNEWFA = LBANK2
- ENDIF
- ENDIF
-
- LBANK1 = LOLDFA
-*
-* Update KEYS vectors from BANKs
-*
- CALL FMUPKY(GENAM1,LBANK1,KEYS1,IRC)
- CALL FMUPKY(GENAM2,LBANK2,KEYS2,IRC)
-*
-* Check that TARGET ^= SOURCE
-*
- CALL FMCOMP(GENAM1,LBANK1,KEYS1,GENAM2,LBANK2,KEYS2,IRC)
- IF(IRC.EQ.0) THEN
- IF(IDEBFA.GT.-3)
- + PRINT *,'FMCOPY. Error - output and input are identical'
- IRC = 1
- RETURN
- ELSE
- IRC = 0
- ENDIF
-*
- IF(IDEBFA.GE.0) THEN
- CALL FMSHOW(GENAM1,LBANK1,KEYS1,'A',IRET)
- CALL FMSHOW(GENAM2,LBANK2,KEYS2,'A',IRET)
- ENDIF
-
- FATMBC = FATMBC + Q(LBANK1+KOFUFA+MFSZFA)
-*
-* Queue to CHEOPS?
-*
- IF(IOPTK.NE.0) THEN
-*
-* File size and DCB must be specified
-*
- CALL UHTOC(IQ(LBANK1+KOFUFA+MRFMFA),4,RECFM1,4)
- CALL UHTOC(IQ(LBANK2+KOFUFA+MRFMFA),4,RECFM2,4)
-
- IF(IQ(LBANK1+KOFUFA+MFSZFA).LE.0) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMCOPY. the input file size',
- + ' must be set to perform a copy via CHEOPS'
- IRC = -1
- ENDIF
-
- IF(IQ(LBANK1+KOFUFA+MRLNFA).LE.0) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMCOPY. the input record length',
- + ' must be set to perform a copy via CHEOPS'
- IRC = -1
- ENDIF
-
- IF(IQ(LBANK1+KOFUFA+MBLNFA).LE.0) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMCOPY. the input block length',
- + ' must be set to perform a copy via CHEOPS'
- IRC = -1
- ENDIF
-
- IF(RECFM1(1:1).EQ.' ') THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMCOPY. the input record format',
- + ' must be set to perform a copy via CHEOPS'
- IRC = -1
- ENDIF
-
- IF(IQ(LBANK2+KOFUFA+MFSZFA).LE.0) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMCOPY. the output file size',
- + ' must be set to perform a copy via CHEOPS'
- IRC = -2
- ENDIF
-
- IF(IQ(LBANK2+KOFUFA+MRLNFA).LE.0) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMCOPY. the output record length',
- + ' must be set to perform a copy via CHEOPS'
- IRC = -2
- ENDIF
-
- IF(IQ(LBANK2+KOFUFA+MBLNFA).LE.0) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMCOPY. the output block length',
- + ' must be set to perform a copy via CHEOPS'
- IRC = -2
- ENDIF
-
- IF(RECFM2(1:1).EQ.' ') THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMCOPY. the output record format',
- + ' must be set to perform a copy via CHEOPS'
- IRC = -2
- ENDIF
-
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMCOPY. please correct the above',
- + ' problems, e.g. using the shell MODIFY command'
- RETURN
- ENDIF
-
- IF(IDEBFA.GE.0) PRINT *,'FMCOPY. your request will be ',
- + 'queued to CHEOPS'
- CALL FMCOPQ(GENAM1,LBANK1,KEYS1,GENAM2,LBANK2,KEYS2,
- + CHOPT,IRC)
- RETURN
- ENDIF
-*
-* Get host information
-*
- CALL UHTOC(IQ(LBANK1+KOFUFA+MHSNFA),4,HOST1,8)
- CALL UHTOC(IQ(LBANK2+KOFUFA+MHSNFA),4,HOST2,8)
- LHOST1 = LENOCC(HOST1)
- LHOST2 = LENOCC(HOST2)
- CALL CLTOU(HOST1(1:LHOST1))
- CALL CLTOU(HOST2(1:LHOST2))
-*
-* Get input and output DSNs
-*
- CALL FMGDSN(LBANK1,DSN1,LDSN1,IRC)
- CALL FMGDSN(LBANK2,DSN2,LDSN2,IRC)
-*
-* Do we need to perform a remote copy?
-*
- IF(KEYS1(MKMTFA).EQ.1.AND.KEYS2(MKMTFA).EQ.1) THEN
- IF(FMNODE(HOST1(1:LHOST1))+FMNODE(HOST2(1:LHOST2)).NE.0) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMCOPY. a remote copy is required'
- CALL FMRCOP(GENAM1,LBANK1,KEYS1,GENAM2,LBANK2,KEYS2,CHOPT,
- + IRC)
- IF(IRC.NE.0) GOTO 40
- GOTO 30
-#if defined(CERNLIB_UNIX)||defined(CERNLIB_VAXVMS)
- ELSEIF(IOPTF.EQ.0) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMCOPY. a local disk copy is '
- + //'required'
- CALL FMLCOP(DSN1(1:LDSN1),DSN2(1:LDSN2),' ',IRC)
- IF(IRC.NE.0) GOTO 40
- GOTO 30
-#endif
- ENDIF
- ENDIF
-*
-* Determine whether IOPTF (FMFZCP) should be turned on
-* N.B. This will not work when FPACK files are supported!
-*
- CALL UHTOC(IQ(LBANK1+KOFUFA+MFLFFA),4,FFORM1,4)
- CALL UHTOC(IQ(LBANK2+KOFUFA+MFLFFA),4,FFORM2,4)
- IF((FFORM1.NE.FFORM2).AND.(FFORM1(1:1).EQ.'F')
- + .AND.(FFORM2(1:1).EQ.'F')) THEN
- IOPTF = 1
- ENDIF
-*
-* Copy using STAGE CHANGE (stagewrt, WRTAPE)
-*
- IF((IOPTC.NE.0).AND.
- + (KEYS1(MKMTFA).GT.1).AND.(KEYS2(MKMTFA).GT.1)) THEN
-#if defined(CERNLIB_IBMVM)
- IF(IDEBFA.GE.0) PRINT *,'FMCOPY. copy will be performed using '
- + //'STAGE CHANGE'
-#endif
-#if defined(CERNLIB_CRAY)
- IF(IDEBFA.GE.0) PRINT *,'FMCOPY. copy will be performed using '
- + //'stagewrt'
-#endif
-#if defined(CERNLIB_VAXVMS)
- IF(IDEBFA.GE.0) PRINT *,'FMCOPY. copy will be performed using '
- + //'WRTAPE'
-#endif
-*
-* Get DCB information
-*
- CALL UHTOC(IQ(LBANK1+KOFUFA+MRFMFA),4,RECFM1,4)
- LRECL1 = IQ(LBANK1+KOFUFA+MRLNFA)*4
- LBLCK1 = IQ(LBANK1+KOFUFA+MBLNFA)*4
- WRITE(DCB1,9001) RECFM1,LRECL1,LBLCK1
- CALL UHTOC(IQ(LBANK2+KOFUFA+MRFMFA),4,RECFM2,4)
- LRECL2 = IQ(LBANK2+KOFUFA+MRLNFA)*4
- LBLCK2 = IQ(LBANK2+KOFUFA+MBLNFA)*4
- WRITE(DCB2,9001) RECFM2,LRECL2,LBLCK2
- 9001 FORMAT(' RECFM ',A4,' LRECL ',I5,' BLOCK ',I5)
- CALL UHTOC(IQ(LBANK1+KOFUFA+MVSNFA),4,VSN1,6)
- LVSN1 = LENOCC(VSN1)
- CALL CLTOU(VSN1)
- CALL UHTOC(IQ(LBANK1+KOFUFA+MVIDFA),4,VID1,6)
- LVID1 = LENOCC(VID1)
- CALL CLTOU(VID1)
- WRITE(FSEQ1,9002) IQ(LBANK1+KOFUFA+MFSQFA)
- 9002 FORMAT(I6)
- JFSEQ1 = INDEXB(FSEQ1,' ') + 1
- CDEN1 = CHMDEN(IQ(LBANK1+KOFUFA+MMTPFA))
-*
-* Generate eXtended VID - with VID prefix
-*
- JP = IQ(LBANK1+KOFUFA+MVIPFA)
- IF(JP.NE.0) THEN
- LVIP1 = LENOCC(PREVID(JP))
- VIP1 = PREVID(JP)(1:LVIP1)
- XVID1 = PREVID(JP)(1:LENOCC(PREVID(JP))) // '.' // VID1(1:
- + LVID1)
- LXVID1 = LENOCC(XVID1)
-
- ELSE
- XVID1 = VID1
- LXVID1 = LVID1
- LVIP1 = 0
- ENDIF
-
-#if defined(CERNLIB_PREFIX)
- VID1 = XVID1
- LVID1 = LXVID1
-#endif
-*
-* Set IQUEST(11) to media type in case volume unknown or
-* TMS option not installed.
-*
- IQUEST(11) = IQ(LBANK1+KOFUFA+MMTPFA)
- CALL FMQTMS(VID1(1:LVID1),LIB1,MODEL,DENS,MNTTYP,LAB1,IC)
-*
-* Believe density from TMS if tape is known
-*
- IF(IC.NE.0) CDEN1 = DENS
- CALL CLTOU(LAB1)
- LLAB1 = LENOCC(LAB1)
-
- CALL UHTOC(IQ(LBANK2+KOFUFA+MVSNFA),4,VSN2,6)
- LVSN2 = LENOCC(VSN2)
- CALL CLTOU(VSN2)
- CALL UHTOC(IQ(LBANK2+KOFUFA+MVIDFA),4,VID2,6)
- LVID2 = LENOCC(VID2)
- CALL CLTOU(VID2)
- WRITE(FSEQ2,9002) IQ(LBANK2+KOFUFA+MFSQFA)
- JFSEQ2 = INDEXB(FSEQ2,' ') + 1
- CDEN2 = CHMDEN(IQ(LBANK2+KOFUFA+MMTPFA))
-*
-* Generate eXtended VID - with VID prefix
-*
- JP = IQ(LBANK2+KOFUFA+MVIPFA)
- IF(JP.NE.0) THEN
- LVIP2 = LENOCC(PREVID(JP))
- VIP2 = PREVID(JP)(1:LVIP2)
- XVID2 = PREVID(JP)(1:LENOCC(PREVID(JP))) // '.' // VID2(1:
- + LVID2)
- LXVID2 = LENOCC(XVID2)
-
- ELSE
- XVID2 = VID2
- LXVID2 = LVID2
- LVIP2 = 0
- ENDIF
-
-#if defined(CERNLIB_PREFIX)
- VID2 = XVID2
- LVID2 = LXVID2
-#endif
-*
-* Set IQUEST(11) to media type in case volume unknown or
-* TMS option not installed.
-*
- IQUEST(11) = IQ(LBANK2+KOFUFA+MMTPFA)
- CALL FMQTMS(VID2(1:LVID2),LIB2,MODEL,DENS,MNTTYP,LAB2,IC)
-*
-* Believe density from TMS if tape is known
-*
- IF(IC.NE.0) CDEN2 = DENS
- CALL CLTOU(LAB2)
- LLAB2 = LENOCC(LAB2)
-*
-* Ensure that input file is STAGEd
-*
- IF(IOPTA.EQ.0) THEN
- CHOPE = 'RU'
-#if defined(CERNLIB_IBMVM)
- LURZFA = IQ(LTOPFA+KOFUFA+MLUNFA)
- WRITE(DDNAM1,9004) LURZFA
- IF(DDNAM1(3:3).EQ.' ') DDNAM1(3:3) = '0'
- CALL FMOPEN(GENAM1,DDNAM1,LBANK1,CHOPE,IRC)
-#endif
-#if defined(CERNLIB_CRAY)||defined(CERNLIB_VAXVMS)
- WRITE(DDNAM1,'(I2.2)') LUFZFA
- CALL FMOPEN(GENAM1,DDNAM1,LBANK1,CHOPE,IRC)
-#endif
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMCOPY. Return code ',IRC,' '
- + //'from FMOPEN for GENAM1'
- GOTO 40
- ENDIF
- ENDIF
-*
-* Build STAGE Change command
-*
-#if defined(CERNLIB_PREFIX)
- IF(LVIP1.NE.0) THEN
- VID1 = VID1(1:LVID1) // '.' // VIP1(1:LVIP1)
- LVID1 = LVID1 + LVIP1 + 1
- ENDIF
- IF(LVIP2.NE.0) THEN
- VID2 = VID2(1:LVID2) // '.' // VIP2(1:LVIP2)
- LVID2 = LVID2 + LVIP2 + 1
- ENDIF
-#endif
-#if defined(CERNLIB_CRAY)
-*
-* Set IQUEST(11) to media type in case volume unknown or
-* TMS option not installed.
-*
- IQUEST(11) = IQ(LBANK2+KOFUFA+MMTPFA)
- CALL FMQTMS(VID2(1:LVID2),LIB,MODEL,DENS,MNTTYP,LABTYP,IC)
- IF(IDEBFA.GE.3) THEN
- PRINT *,'FMCOPY. return from FMQTMS with ',
- + VID2,'/',LIB,'/',MODEL,'/',DENS,'/',MNTTYP,'/',
- + LABTYP,'/',IC
- ENDIF
-*
-* Believe density from TMS if tape is known
-*
- IF(IC.NE.0) CDEN2 = DENS
- CALL CUTOL(LABTYP)
- LLAB = LENOCC(LABTYP)
-
- DDNAM2 = 'fort. '
- IF(LUFZFA.LT.10) THEN
- WRITE(DDNAM2(6:6),'(I1)') LUFZFA
- ELSE
- WRITE(DDNAM2(6:7),'(I2)') LUFZFA
- ENDIF
-
- WRITE(FSEQ2,9002) IQ(LBANK2+KOFUFA+MFSQFA)
-
-* "stagein fort.lun -v vsn -V vid -l sl|nl|al|blp
-* -g TAPE|CART|SMCF -d 6250|1600"
- COMAND = 'stagewrt '//DDNAM2 // ' -v '//VSN2(1:LVSN2)// ' -V '
- + //VID2(1:LVID2)//' -l '//LABTYP//' -g '//MODEL // ' -q ' //
- + FSEQ2 // ' -K -S sbin'
-
- LENCOM = LENOCC(COMAND)
-*
-* Add DSN if IOPTN not specified
-*
- IF(IOPTN.EQ.0) THEN
- COMAND = COMAND(1:LENCOM) // ' -f '//DSN2(1:LDSN2)
- LENCOM = LENOCC(COMAND)
- ENDIF
-
-*
-* Add DCB information
-*
- WRITE(DCB2,9003) RECFM2(1:1),LRECL2,LBLCK2
- 9003 FORMAT(' -F ',A1,' -L ',I5,' -b ',I5)
- COMAND = COMAND(1:LENOCC(COMAND)) // DCB2
- LENCOM = LENOCC(COMAND)
-
- IF(IDEBFA.GE.0) PRINT *,COMAND(1:LENCOM)
- IC = SYSTEMF(COMAND(1:LENCOM))
-
-#endif
-#if defined(CERNLIB_IBMVM)
- CALL FMGDSN(LBANK2,DSN2,LDSN2,IRC)
- COMAND = ' '
- COMAND = 'EXEC STAGE CHANGE '
- + // VSN1(1:LVSN1) // '.'
- + // FSEQ1(JFSEQ1:LEN(FSEQ1))
- + // '.' // LAB1(1:LLAB1) // '.' // VID1(1:LVID1) // ' '
- + // VSN2(1:LVSN2) // '.'
- + // FSEQ2(JFSEQ2:LEN(FSEQ2))
- + // '.' // LAB2(1:LLAB2) // '.' // VID2(1:LVID2)
- + // ' (STAGEOUT DSN ' // DSN2(1:LDSN2)
-
- IF(IOPTW.NE.0) THEN
- COMAND = COMAND(1:LENOCC(COMAND)) // ' WAIT'
- ENDIF
-
-#endif
-#if (defined(CERNLIB_IBMVM))&&(!defined(CERNLIB_TMS))
- COMAND = COMAND(1:LENOCC(COMAND)) // ' DEVTYPE '//MODEL
-#endif
-#if (defined(CERNLIB_IBMVM))&&(!defined(CERNLIB_CERN))&&(defined(CERNLIB_TMS))
- COMAND = COMAND(1:LENOCC(COMAND)) // ' DEVTYPE '//MODEL
-#endif
-#if defined(CERNLIB_IBMVM)
-
- LENCOM = LENOCC(COMAND)
-
- IF(IDEBFA.GE.0) PRINT *,'FMCOPY. running ',COMAND(1:LENCOM)
-
- CALL VMCMS(COMAND(1:LENCOM),IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.0)
- + PRINT *,'FMCOPY. Return code ',IRC,' from STAGE'
- RETURN
- ENDIF
-
-#endif
-#if defined(CERNLIB_VAXVMS)
- VAXLAB = 'EBCDIC'
- IF(LAB2(1:LLAB2).EQ.'AL') THEN
- VAXLAB = 'ASCII'
- ELSEIF(LAB2(1:LLAB2).EQ.'NL') THEN
- VAXLAB = 'NONE'
- ENDIF
- COMAND = ' '
- WRITE(CHRECL,'(I6.6)') LRECL2
- WRITE(CHBLK, '(I6.6)') LBLCK2
- COMAND = '$WRTAPE '//VSN2(1:LVSN2)//' '//VID2(1:LVID2)//
- + ' /NAME='//DSN2(1:LDSN2)//'/NUMBER='//
- + FSEQ2(JFSEQ2:LEN(FSEQ2))//'/INFILE='//DDNAM1
- + //'/LABEL='//VAXLAB
- + //'/GENERIC='//MODEL
- IF(LRECL2.GT.0) COMAND = COMAND(1:LENOCC(COMAND)) //
- + '/RECORDSIZE='//CHRECL
- IF(LBLCK2.GT.0) COMAND = COMAND(1:LENOCC(COMAND)) //
- + '/BLOCKSIZE='//CHBLK
-
- IF(INDEX(RECFM2,'F').NE.0) THEN
- COMAND = COMAND(1:LENOCC(COMAND)) // '/FIXED'
- ELSEIF(INDEX(RECFM2,'V').NE.0) THEN
- COMAND = COMAND(1:LENOCC(COMAND)) // '/VARIABLE'
- ENDIF
-*
- LENCOM = LENOCC(COMAND)
-
- IF(IDEBFA.GE.0) PRINT *,COMAND(1:LENCOM)
-
- ISTAT = LIB$SPAWN(COMAND(1:LENCOM))
-#include "fatmen/fatvaxrc.inc"
-
-#endif
-
- ELSEIF(IOPTF.NE.0) THEN
-*
-* Perform copy using FZIN/FZOUT
-*
- CALL FMGLUN(LUNI,IRC)
- IF(IRC.NE.0) THEN
- PRINT *,'FMCOPY. unable to allocate input unit for copy'
- GOTO 40
- ENDIF
- CALL FMGLUN(LUNO,IRC)
- IF(IRC.NE.0) THEN
- PRINT *,'FMCOPY. unable to allocate input unit for copy'
- GOTO 40
- ENDIF
-
- CALL FMDDNM(LUNI,DDNAM1,IRC)
- CALL FMDDNM(LUNO,DDNAM2,IRC)
-
- CHOPI = 'FR'
- IF(KEYS1(MKMTFA).GT.1) THEN
- IF(KEYS2(MKMTFA).GT.1) THEN
- CHOPI = 'FRT'
- ELSE
- CHOPI = 'FRTE'
- ENDIF
- ELSE
- CHOPI = 'RU'
- ENDIF
- CALL FMOPEN(GENAM1,DDNAM1,LBANK1,CHOPI,IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.0)
- + PRINT *,'FMCOPY. Return code ',IRC,' from FMOPEN for GENAM1'
- GOTO 40
- ENDIF
- CHOPO = 'FW'
- IF(KEYS2(MKMTFA).GT.1) CHOPO = 'TFWE'
- CALL FMOPEN(GENAM2,DDNAM2,LBANK2,CHOPO,IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.0)
- + PRINT *,'FMCOPY. Return code ',IRC,' from FMOPEN for GENAM2'
- GOTO 40
- ENDIF
- CHOPTF = ' '
- IF(IOPTR.NE.0) CHOPTF = 'R'
- CALL FMFZCP(LUNI,LUNO,CHOPTF,IRC)
- CALL FMFLUN(LUNI,IC)
- CALL FMFLUN(LUNO,IC)
- CHOPI = 'E'
- CALL FMCLOS(GENAM1,DDNAM1,LBANK1,CHOPI,IC)
- CHOPO = 'EFP'
- CALL FMCLOS(GENAM2,DDNAM2,LBANK2,CHOPO,IC)
-
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMCOPY. Return code ',IRC,' from '
- + //'FMFZCP'
- GOTO 40
- ENDIF
- ELSE
-
-#if !defined(CERNLIB_IBMVM)
-*
-* Perform physical copy - switch IOPTS & IOPTZ on
-*
- IOPTS = 1
- IOPTZ = 1
-
- CALL FMGLUN(LUNI,IRC)
- IF(IRC.NE.0) THEN
- PRINT *,'FMCOPY. unable to allocate input unit for copy'
- GOTO 40
- ENDIF
- CALL FMGLUN(LUNO,IRC)
- IF(IRC.NE.0) THEN
- PRINT *,'FMCOPY. unable to allocate input unit for copy'
- GOTO 40
- ENDIF
-
- CALL FMDDNM(LUNI,DDNAM1,IRC)
- CALL FMDDNM(LUNO,DDNAM2,IRC)
-*
-* Set FMOPEN options
-*
- CHOPI = 'RU'
- IF(IOPTS.EQ.0.AND.KEYS1(MKMTFA).GT.1) THEN
- IF(KEYS2(MKMTFA).GT.1) THEN
- CHOPI = 'RTU'
- ELSE
- CHOPI = 'RTEU'
- ENDIF
- ELSE
- CHOPI = 'RU'
- ENDIF
-
- IF(IDEBFA.GE.3) PRINT *,'FMCOPY. call FMOPEN for input'
- CALL FMOPEN(GENAM1,DDNAM1,LBANK1,CHOPI,IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.0)
- + PRINT *,'FMCOPY. Return code ',IRC,' from FMOPEN for GENAM1'
- GOTO 40
- ENDIF
-
- CHOPO = 'WU'
- IF(IOPTZ.EQ.0.AND.KEYS2(MKMTFA).GT.1) CHOPO = 'WTEU'
- IF(IDEBFA.GE.3) PRINT *,'FMCOPY. call FMOPEN for output'
- CALL FMOPEN(GENAM2,DDNAM2,LBANK2,CHOPO,IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.0)
- + PRINT *,'FMCOPY. Return code ',IRC,' from FMOPEN for GENAM2'
- GOTO 40
- ENDIF
-
-#endif
-#if (!defined(CERNLIB_IBMVM))&&(defined(CERNLIB_CRAY))
-*
-* Find the real file name(s)
-*
- CALL FMASSN(DDNAM1,CHFIN,'G',IRC)
- CALL FMASSN(DDNAM2,CHFOUT,'G',IRC)
- LCHFIN = LENOCC(CHFIN)
- LCHFOU = LENOCC(CHFOUT)
-*
-* Now do the copy
-*
- CALL FMLCOP(CHFIN(1:LCHFIN),CHFOUT(1:LCHFOU),'C',IRC)
-#endif
-#if (!defined(CERNLIB_IBMVM))&&(!defined(CERNLIB_CRAY))
-*
-* Now do the copy
-*
- CALL FMLCOP(DDNAM1,DDNAM2,' ',IRC)
-#endif
-#if !defined(CERNLIB_IBMVM)
-*
-* Free logical units
-*
- CALL FMFLUN(LUNI,IC)
- CALL FMFLUN(LUNO,IC)
-
- CHOPI = 'N'
- CALL FMCLOS(GENAM1,DDNAM1,LBANK1,CHOPI,IC)
-
- CHOPO = 'N'
- IF(KEYS2(MKMTFA).GT.1) CHOPO = 'NP'
- CALL FMCLOS(GENAM2,DDNAM2,LBANK2,CHOPO,IC)
-
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMCOPY. Return code ',IRC,' from '
- + //'FMLCOP'
- GOTO 40
- ENDIF
-
-#endif
-#if defined(CERNLIB_IBMVM)
-
- CHOPE = 'RU'
- IF((KEYS1(MKMTFA).GT.1).AND.(IOPTS.EQ.0)) THEN
- IF(KEYS2(MKMTFA).GT.1) THEN
- CHOPE = 'RTU'
- ELSE
- CHOPE = 'RTUE'
- ENDIF
- ELSE
- CHOPE = 'RU'
- ENDIF
- LURZFA = IQ(LTOPFA+KOFUFA+MLUNFA)
- WRITE(DDNAM1,9004) LURZFA
- 9004 FORMAT('VM',I2,'F001')
- IF(DDNAM1(3:3).EQ.' ') DDNAM1(3:3) = '0'
- CALL FMOPEN(GENAM1,DDNAM1,LBANK1,CHOPE,IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMCOPY. Return code ',IRC,' from '
- + //'FMOPEN for GENAM1'
- GOTO 40
- ENDIF
-
- CHOPE = 'UW'
- IF(KEYS2(MKMTFA).GT.1) CHOPE = 'TUWE'
- IF(IOPTZ.NE.0) CHOPE = 'UW'
- WRITE(DDNAM2,9004) LUFZFA
- IF(DDNAM2(3:3).EQ.' ') DDNAM2(3:3) = '0'
- CALL FMOPEN(GENAM2,DDNAM2,LBANK2,CHOPE,IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMCOPY. Return code ',IRC,' from '
- + //'FMOPEN for GENAM2'
- GOTO 40
- ENDIF
-*
-* Get DCB information
-*
- CALL UHTOC(IQ(LBANK1+KOFUFA+MRFMFA),4,RECFM1,4)
- LRECL1 = IQ(LBANK1+KOFUFA+MRLNFA)*4
- LBLCK1 = IQ(LBANK1+KOFUFA+MBLNFA)*4
- CALL UHTOC(IQ(LBANK2+KOFUFA+MRFMFA),4,RECFM2,4)
- LRECL2 = IQ(LBANK2+KOFUFA+MRLNFA)*4
- LBLCK2 = IQ(LBANK2+KOFUFA+MBLNFA)*4
-
- CALL VMINIT
- FN1 = ' '
- LREC1 = LRECL1
- LBLK1 = LBLCK1
- IF(IDEBFA.GE.2) PRINT *,
- + 'FMCOPY. call VMOPEN for input dataset on unit ',LURZFA,
- + ' with DCB ',RECFM1,LREC1,LBLK1
- CALL VMOPEN(LURZFA,FN1,'R',RECFM1,LREC1,LBLK1,IRC,INFO)
- IF(IDEBFA.GE.2) PRINT *,
- + 'FMCOPY. return from VMOPEN ',
- + ' with DCB ',RECFM1,LREC1,LBLK1
- IF(IABS(IRC).GT.1) THEN
- PRINT *,'FMCOPY. return code ',IRC,
- + ' from VMOPEN for input file, INFO = ',INFO
- CALL VMEND
- CALL FMCLOS(GENAM1,DDNAM1,LBANK1,'C',IRET)
- GOTO 40
- ENDIF
-
- IF(IDEBFA.GE.0) PRINT *,'FMCOPY. Opened input unit'
- FN2 = ' '
- LREC2 = LRECL2
- LBLK2 = LBLCK2
- IF(IDEBFA.GE.2) PRINT *,
- + 'FMCOPY. call VMOPEN for output dataset on unit ',LUFZFA,
- + ' with DCB ',RECFM2,LREC2,LBLK2
- CALL VMOPEN(LUFZFA,FN2,'W',RECFM2,LREC2,LBLK2,IRC,INFO)
- IF(IDEBFA.GE.2) PRINT *,
- + 'FMCOPY. return from VMOPEN ',
- + ' with DCB ',RECFM2,LREC2,LBLK2
- IF(IABS(IRC).GT.1) THEN
- PRINT *,'FMCOPY. return code ',IRC,
- + ' from VMOPEN for output file, INFO = ',INFO
- CALL VMEND
- CALL FMCLOS(GENAM1,DDNAM1,LBANK1,'C',IRET)
- CALL FMCLOS(GENAM2,DDNAM2,LBANK2,'C',IRET)
- GOTO 40
- ENDIF
- IF(IDEBFA.GE.0) PRINT *,'FMCOPY. Opened output unit'
- NRECS = 0
- NLONG = 0
- NSHORT = 32768
- NREAD = LREC1
- IF(LREC1.EQ.0) NREAD = LBLK1
- IF(NREAD.EQ.0) THEN
- IF(IDEBFA.GT.-3) PRINT *,
- + 'FMCOPY. record length and blocksize of input dataset are ',
- + 'both zero - cannot perform copy'
- CALL VMEND
- IRC = 1
- GOTO 40
- ENDIF
-
- 10 CONTINUE
- LDAT = 32768
- CALL VMREAD(LURZFA,BUFFER,NREAD,LDAT,IRC,INFO)
- IF(IABS(IRC).EQ.1) GOTO 20
- IF(IABS(IRC).GT.1) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMCOPY. return code ',IRC,
- + ' from VMREAD'
- IF(IABS(IRC).GT.4) THEN
- CALL VMEND
- GOTO 40
- ENDIF
- ENDIF
- IF(LDAT.GT.NLONG) NLONG = LDAT
- IF(LDAT.LT.NSHORT) NSHORT = LDAT
- CALL VMRITE(LUFZFA,BUFFER,LDAT,IRC,INFO)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMCOPY. return code ',IRC,
- + ' from VMRITE'
- CALL VMEND
- GOTO 40
- ENDIF
- NRECS = NRECS + 1
- GOTO 10
- 20 CONTINUE
- IF(IDEBFA.GE.0) PRINT *,'FMCOPY. ',NRECS,
- + ' records written, shortest/longest = ',NSHORT,NLONG
-*
-* Options for FMCLOS
-*
- IF(IOPTS.NE.0) THEN
- CHOPE = 'D'
- ELSE
- CHOPE = ' '
- ENDIF
-
- CALL FMCLOS(GENAM1,DDNAM1,LBANK1,CHOPE,IRC)
-
- CHOPE = 'DU'
-
- IF(IOPTZ.NE.0) THEN
- IF(IOPTW.EQ.0) THEN
- CHOPE = 'DUP'
- ELSE
- CHOPE = 'DUPW'
- ENDIF
- ENDIF
-
- CALL FMCLOS(GENAM2,DDNAM2,LBANK2,CHOPE,IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMCOPY. return code ',IRC,
- + ' from FMCLOS. Entry will not be added to catalogue'
- GOTO 40
- ENDIF
-
- CALL VMEND
-
-#endif
- ENDIF
-
- 30 CALL FMPUT(GENAM2,LBANK2,IRC)
- 40 RETURN
- END
diff --git a/src/packlib/fatmen/fmint/fmcp.F b/src/packlib/fatmen/fmint/fmcp.F
deleted file mode 100644
index 46e387e..0000000
--- a/src/packlib/fatmen/fmint/fmcp.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: fmcp.F,v 1.1.1.1 1996/03/07 15:18:11 mclareni Exp $
-*
-* $Log: fmcp.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:11 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMCP(GENAMA,GENAMB,IRC)
- CHARACTER*(*) GENAMA,GENAMB
-#include "fatmen/faust.inc"
- PARAMETER (LKEYFA=10)
- DIMENSION KEYS(LKEYFA)
- CALL FMGET(GENAMA,L,KEYS,IRC)
- IF(IRC.NE.0) RETURN
- CALL FMPUT(GENAMB,L,IRC)
- IF(IRC.NE.0) RETURN
- NFCPFL = NFCPFL + 1
- END
-
diff --git a/src/packlib/fatmen/fmint/fmdcb.F b/src/packlib/fatmen/fmint/fmdcb.F
deleted file mode 100644
index 48f01e8..0000000
--- a/src/packlib/fatmen/fmint/fmdcb.F
+++ /dev/null
@@ -1,76 +0,0 @@
-*
-* $Id: fmdcb.F,v 1.1.1.1 1996/03/07 15:18:11 mclareni Exp $
-*
-* $Log: fmdcb.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:11 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMDCB(GENAME,LBANK,DSN,RECFM,LRECL,BLOCK,SPACE,
- + CHOPT,IRC)
-*CMZ : 21/01/91 16.46.13 by Jamie Shiers
-*-- Author : Jamie Shiers 21/01/91
-*
-* Set DCB parameters for GENAME.
-* DCB parameters may be given as parameters, or should
-* be taken from the model DCB specified by DSN
-*
- CHARACTER*(*) GENAME,DSN,RECFM
- INTEGER LBANK,LRECL,BLOCK,SPACE(3),IRC
-#if defined(CERNLIB_IBMMVS)
-#include "fatmen/fatdcb.inc"
-#endif
-#include "fatmen/fatbank.inc"
-#include "fatmen/fatpara.inc"
-*
-* CHOPT: B - space is given in BLOCKS
-* C - space is given in CYLS
-* T - space is given in TRKS
-*
-#include "fatmen/fatopts.inc"
- LDSN = LENOCC(DSN)
- IF(LDSN.NE.0) THEN
-#if defined(CERNLIB_IBMMVS)
-*
-* Connect catalogue entry containing model DCB to LUFZFA
-*
- MODE = 0
- CALL FTDD(LUFZFA,MODE,DSN(1:LDSN),IC)
-*
-* Obtain DCB information
-*
- CALL FTINFO(LUFZFA,TYPE,HDSN,DISP,VOL,LABEL,IDCB,UNIT,ISPACE,
- + IUSED,IC)
- IQ(LBANK+KOFUFA+MRFMFA) = IDCB(1)
- IQ(LBANK+KOFUFA+MRLNFA) = IDCB(2)
- IQ(LBANK+KOFUFA+MBLNFA) = IDCB(3)
-#endif
- ELSE
-*
-* Use DCB parameters supplied in argument list
-*
- IQ(LBANK+KOFUFA+MRLNFA) = LRECL
- IQ(LBANK+KOFUFA+MBLNFA) = BLOCK
- CALL UCTOH(RECFM,IQ(LBANK+KOFUFA+MRFMFA),4,4)
- ENDIF
-#if defined(CERNLIB_IBMMVS)
-*
-* SPACE only meaningful on IBM/MVS systems
-*
- IF(IOPTB.NE.0) THEN
- CALL UCTOH('BLK ',ISPACE(1),4,4)
- CHSPAC = 'BLK '
- ELSEIF(IOPTC.NE.0) THEN
- CALL UCTOH('CYL ',ISPACE(1),4,4)
- CHSPAC = 'CYL '
- ELSEIF(IOPTT.NE.0) THEN
- CALL UCTOH('TRK ',ISPACE(1),4,4)
- CHSPAC = 'TRK '
- ELSE
- CALL UCTOH('BLK ',ISPACE(1),4,4)
- CHSPAC = 'BLK '
- ENDIF
- CALL UCOPY(SPACE,ISPACE(2),3)
-#endif
- END
diff --git a/src/packlib/fatmen/fmint/fmddir.F b/src/packlib/fatmen/fmint/fmddir.F
deleted file mode 100644
index a333c56..0000000
--- a/src/packlib/fatmen/fmint/fmddir.F
+++ /dev/null
@@ -1,69 +0,0 @@
-*
-* $Id: fmddir.F,v 1.1.1.1 1996/03/07 15:18:14 mclareni Exp $
-*
-* $Log: fmddir.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:14 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMDDIR(GENAME,CHOPT,IRC)
-#include "fatmen/faust.inc"
-#include "fatmen/fatpara.inc"
-#include "fatmen/fatbank.inc"
- CHARACTER*4 COMM
- CHARACTER*(*) GENAME
- CHARACTER*20 SUBDIR
- PARAMETER (LKEYFA=10)
- DIMENSION KEYS(LKEYFA)
-
-#include "fatmen/fatopts.inc"
-
- NFRDIR = NFRDIR + 1
-
- IRC = 0
-*
-* Set current directory to the one to be deleted
-*
- LGN = LENOCC(GENAME)
- CALL FACDIR(GENAME(1:LGN),' ')
-*
-* Check that directory is empty
-*
- CALL RZRDIR(1,SUBDIR,NDIR)
- IF (NDIR .GT. 0.AND.IOPTD.EQ.0) THEN
- WRITE(LPRTFA,9001) GENAME(1:LGN),IQUEST(11)
-9001 FORMAT(' FMDDIR. Cannot delete directory ',A,' - it contains ',
- + I10,' subdirectories')
- IRC = 99
- GOTO 99
- ENDIF
-*
-* Get keys from current directory
-*
- CALL RZKEYS(LKEYFA,1,KEYS,NKEYS)
- IF (NKEYS .GT. 0.AND.IOPTF.EQ.0) THEN
- WRITE(LPRTFA,9002) GENAME(1:LGN),NKEYS
-9002 FORMAT(' FMDDIR. Cannot delete directory ',A,' - it contains ',
- + I10,' files')
- IRC = 99
- GOTO 99
- ENDIF
- L = 0
- CALL FMVERI(GENAME(1:LGN),L,KEYS,'G',IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GT.-3) PRINT *,'FMDDIR. errors detected by FMVERI - '
- + ,'update will not be processed'
- RETURN
- ENDIF
-
- COMM = 'DDIR'
- CALL FMFZO(COMM,GENAME,L,KEYS,IRC)
- 99 CONTINUE
-*
-* Reset current directory
-*
- CALL FACDIR(GENAME(1:LGN),' ')
-
- RETURN
- END
diff --git a/src/packlib/fatmen/fmint/fmdisk.F b/src/packlib/fatmen/fmint/fmdisk.F
deleted file mode 100644
index bbeb50d..0000000
--- a/src/packlib/fatmen/fmint/fmdisk.F
+++ /dev/null
@@ -1,471 +0,0 @@
-*
-* $Id: fmdisk.F,v 1.1.1.1 1996/03/07 15:18:12 mclareni Exp $
-*
-* $Log: fmdisk.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:12 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMDISK(GENAM,LBANK,KEYS,CHLUN,CHOPT,IRC)
-
- CHARACTER*(*) GENAM,CHLUN
-#include "fatmen/fatmon.inc"
-#include "fatmen/fatbank.inc"
-#include "fatmen/fatpara.inc"
-#include "fatmen/fatinfo.inc"
-#include "fatmen/slate.inc"
-#if defined(CERNLIB_IBMVM)
- CHARACTER*2 CHLETT
- CHARACTER*4 CHFORM,RECFM
- CHARACTER*8 CHACC,DDNAME,USER,ADDR
- CHARACTER*16 CHSFS
- CHARACTER*40 CHDCB
- CHARACTER*80 CHGIME,CHLINE
- CHARACTER*255 CHCOMM
-#endif
-#if defined(CERNLIB_VAXVMS)
- CHARACTER*255 CHFILE
- CHARACTER*255 EQUNAM
- CHARACTER*8 CHHOST
-#endif
-#if defined(CERNLIB_VAXVMS)||defined(CERNLIB_UNIX)
- CHARACTER*8 FORLUN
-#endif
-#if defined(CERNLIB_UNIX)
- LOGICAL IEXIST
- INTEGER UNLINKF
-#endif
-#if defined(CERNLIB_SHIFT)
-#include "fatmen/fmshft.inc"
-#endif
-#include "fatmen/fmnkeys.inc"
- INTEGER SYSTEMF
- DIMENSION KEYS(LKEYFA)
- CHARACTER*256 CHDSN
-
-#include "fatmen/fatopts.inc"
-
- IF(IDEBFA.GE.1) THEN
- CALL DATIME(ID,IT)
- PRINT 9001,ID,IT,IS(6)
- 9001 FORMAT(' FMDISK. enter at ',I6.6,1X,I4.4,I2.2)
- ENDIF
-
- IRC = 0
- LUN = 0
- IMODE = IOPTW
- LCHLUN = LENOCC(CHLUN)
-
- IF (LCHLUN.EQ.1) THEN
- READ(CHLUN,'(I1)') LUN
- ELSEIF(LCHLUN.EQ.2) THEN
- READ(CHLUN,'(I2)') LUN
- ENDIF
-*
-* Get LUN from CHLUN (DDNAME) if necessary
-*
- IF(LUN.EQ.0) CALL FMDD2L(CHLUN(1:LCHLUN),LUN,IRC)
-*
-* Get CHDSN
-*
- CALL FMGDSN(LBANK,CHDSN,LDSN,IRC)
- CHFNFA = CHDSN(1:LDSN)
-*
-* URL
-*
- IURL = INDEX(CHDSN(1:LDSN),'://')
- ISLASH = INDEX(CHDSN(1:LDSN),'/')
- IF(IURL.NE.0.AND.IURL.EQ.ISLASH-1) THEN
-#if defined(CERNLIB_UNIX)
- CALL FMMSS(GENAM,CHDSN(1:LDSN),' ',IRC)
- IF(IRC.NE.0) GOTO 20
-*
-* ... call mssget here ...
-*
- IF(IDEBFA.GE.0) WRITE(LPRTFA,9006) CHDSN(1:LDSN)
- 9006 FORMAT(' FMDISK. invoking "mssget" for ',A)
- GOTO 20
-#endif
-#if !defined(CERNLIB_UNIX)
- IF(IDEBFA.GE.0) WRITE(LPRTFA,9007) CHDSN(1:LDSN)
- 9007 FORMAT(' FMDISK. URL support only available on Unix systems')
- IRC = 99
- GOTO 20
-#endif
- ENDIF
-
-#if defined(CERNLIB_IBMVM)
-*
-* FATMEN file format (for call to FZFILE,RZFILE)
-*
- CALL UHTOC(IQ(LBANK+KOFUFA+MFLFFA),4,CHFORM,4)
-
- ICFOP = 0
- IF(INDEX(CHFORM,'FP').EQ.0.AND.IOPTF.NE.0) THEN
- ICFOP = IQUEST(10)
- IF(ICFOP.EQ.2) IOPTX = 1
- ENDIF
-
- CHCOMM = 'FILEDEF FTnnF001 DISK '
- DDNAME = 'FT00F001'
-
- IF((INDEX(CHFORM,'FX').NE.0).AND.(IOPTX.NE.0)) THEN
- CHCOMM = 'FILEDEF VMnnF001 DISK '
- DDNAME = 'VM00F001'
- ENDIF
-
- WRITE(CHCOMM(17:18),9008) LUN
- 9008 FORMAT(I2.2)
- WRITE(DDNAME(3:4),'(I2.2)') LUN
-
- IF((CHFORM(1:2).EQ.'FX'.AND.IOPTX.EQ.0.AND.ICFOP.EQ.3)
- + .OR.(CHFORM(1:2).EQ.'EP')) THEN
- CHCOMM = 'FILEDEF IOFILEnn DISK '
- WRITE(CHCOMM(21:22),9008) LUN
- DDNAME = 'IOFILE00'
- WRITE(DDNAME(7:8),'(I2.2)') LUN
- ENDIF
-
- IF(LCHLUN.GT.2) CHCOMM(15:22) = CHLUN
-*
-* Get disk name and link to it
-*
- LSTA = INDEX(CHDSN,'<')
- IF(LSTA.NE.0) THEN
-*
-* Format of CHDSN is <user.address>filename.filetype on VM
-* address defaults to 191. If field <> missing, defaults to
-* current userid.
-*
-* Valid filenames:
-* FN.FT
-* <JAMIE>FN.FT
-* <JAMIE.191>FN.FT
-* SFS POOL:<JAMIE.A191>FN.FT
-*
- CALL CTRANS('[','<',CHDSN,1,LDSN)
- CALL CTRANS(']','>',CHDSN,1,LDSN)
- LDOT = INDEX(CHDSN,'.')
- LBRA = INDEX(CHDSN,'>')
-
- IF((LDOT.NE.0).AND.(LDOT.LE.LBRA)) THEN
- LEND = LDOT
- ELSE
- LEND = LBRA
- ENDIF
-
- USER = CHDSN(LSTA+1:LEND-1)
- LUSR = LEND - LSTA - 1
- ADDR = ' '
-
- IF ((LDOT.NE.0).AND.(LDOT.LE.LBRA)) THEN
- ADDR= CHDSN(LDOT+1:LBRA-1)
- ENDIF
-
- LCHSFS = INDEX(CHDSN(1:LDSN),':')
- IF(LCHSFS.NE.0) THEN
- CHSFS = CHDSN(1:LCHSFS)
- IF(IDEBFA.GE.2) PRINT *,'FMDISK. SFS pool = ', CHSFS(1:
- + LCHSFS)
- ENDIF
-
- IF(IOPTW.NE.0) THEN
- CHACC = ' ( MR ) '
- ELSE
- CHACC = ' ( RR ) '
- ENDIF
-*
-* Check if user name is numeric
-*
- IC = ICNUM(USER(1:LUSR),1,LUSR)
-
- IF(IC.GT.LUSR) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMDISK. username is numeric.',
- + ' Cannot link to this userid using GIME'
- IF(IDEBFA.GE.0) PRINT *,'FMDISK. executing ', 'EXEC '
- + //'FATGIME '//USER(1:LUSR)//' '//ADDR//CHACC
- CALL VMCMS('EXEC FATGIME '//USER(1:LUSR)//' '
- + //ADDR// CHACC,IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMDISK. return code from '
- + //'FATGIME = ',IRC
- GOTO 20
- ENDIF
-
- ELSE
-
- IF(LCHSFS.EQ.0) THEN
-
- CHGIME = 'EXEC GIME '//USER(1:LUSR)//' '
- + //ADDR// '(QUIET NONOTICE STACK)'
- CALL SBIT1(IHOWFA,JLOCFA)
- ELSE
- CHGIME = 'EXEC GIME '// CHSFS(1:LCHSFS)//USER(1:LUSR)//
- + '.'//ADDR// '(QUIET NONOTICE STACK)'
- CALL SBIT1(IHOWFA,JSFSFA)
- ENDIF
-
- CALL CSQMBL(CHGIME,1,80)
- LCHG = LENOCC(CHGIME)
-
- IF(IDEBFA.GE.0) PRINT *,'FMDISK. executing ', CHGIME(1:
- + LCHG)
- CALL VMCMS(CHGIME(1:LCHG),IRC)
-
- IF(IRC.GT.4) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMDISK. return code from GIME ='
- + //' ',IRC
- GOTO 20
- ENDIF
-
- ENDIF
-
- CALL VMRTRM(CHLINE,LENGTH)
- CHLETT = CHLINE(1:1)
-*
-* Use mode 4 for all CMS files, except RECFM F
-* N.B. files in CMS format V will be incorrectly handled!
-* To be read correctly, RECFM=U
-*
- IF(CHFORM(1:2).EQ.'RZ') THEN
- CHLETT(2:2) = '6'
- ELSE
- CHLETT(2:2) = '4'
- ENDIF
-
- IF(RECFM(1:1).EQ.'U') CHLETT(2:2) = '1'
- IF(IDEBFA.GE.0) WRITE(LPRTFA,9009) USER,ADDR,CHLETT
- 9009 FORMAT('FMDISK. linked to ',A8,' address ',A3,' mode ',A4)
- ELSE
- CHLETT = '*'
- ENDIF
-
- LDOT = INDEXB(CHDSN,'.')
- CHDSN(LDOT:LDOT) = ' '
- CHCOMM = CHCOMM(1:30) // CHDSN(LBRA+1:LDSN) // ' ' // CHLETT
- LENCOM = LENOCC(CHCOMM)
-*
-* Don't add DCB if it is missing...
-*
- WRITE(CHDCB,9010) RECFM,LRECL,LBLOCK
- 9010 FORMAT(' RECFM ',A4,' LRECL ',I5,' BLOCK ',I5)
- IF((LENOCC(RECFM).GT.0).AND. (LRECL.NE.0.OR.LBLOCK.NE.0)) THEN
-* IF(IMODE.NE.0) THEN
- CHCOMM = CHCOMM(1:LENOCC(CHCOMM)) // ' ( ' // CHDCB
- ENDIF
-
- LENCOM = LENOCC(CHCOMM)
- IF(IDEBFA.GE.0) PRINT *,'FMDISK. running ',CHCOMM(1:LENCOM)
-
- CALL VMCMS(CHCOMM(1:LENCOM),IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMDISK. return code ',IRC, ' from '
- + //'FILEDEF'
- GOTO 20
- ENDIF
-*
-* Set the disk and access modes (for FMCLOS)
-*
- CHMODE(LUN) = CHLETT(1:1)
-#endif
-#if defined(CERNLIB_VAXVMS)
-*
-* Find disk with most space
-*
- IF(IMODE.NE.0) THEN
- CALL FMXDSK(CHFNFA,CHDSN,IRC)
- LDSN = LENOCC(CHDSN)
- ELSE
- CALL UHTOC(IQ(LBANK+KOFUFA+MHSNFA),4,CHHOST,NHSNFA)
- LHOST = LENOCC(CHHOST)
-*
-* Call FAINQR to build full DSN
-*
- CALL FAINQR(CHDSN,CHHOST(1:LHOST),CHFILE,IRC)
- IF(IRC.EQ.0) THEN
- CHDSN = CHFILE
- LDSN = LENOCC(CHFILE)
- CHFNFA = ' '
- CHFNFA = CHDSN(1:LDSN)
-*
-* Monitoring
-*
- IF(IQUEST(1).EQ.1) THEN
- CALL SBIT1(IHOWFA,JLOCFA)
- ELSEIF(IQUEST(1).EQ.12) THEN
- CALL SBIT1(IHOWFA,JMSCFA)
- ELSEIF(IQUEST(1).EQ.13) THEN
- CALL SBIT1(IHOWFA,JDFSFA)
- ELSEIF(IQUEST(1).EQ.14) THEN
- CALL SBIT1(IHOWFA,JDECFA)
- ELSEIF(IQUEST(1).EQ.15) THEN
- CALL SBIT1(IHOWFA,JCSPFA)
- ELSEIF(IQUEST(1).EQ.16) THEN
- CALL SBIT1(IHOWFA,JFPKFA)
- ELSEIF(IQUEST(1).EQ.22) THEN
- CALL SBIT1(IHOWFA,JNFSFA)
- ENDIF
- ENDIF
- ENDIF
-*
-* Just assign the relevant logical name...
-*
- FORLUN = 'FOR00N'
- WRITE(FORLUN(4:6),'(I3.3)') LUN
- IF (LUN .EQ. 0) FORLUN = CHLUN
- LFLUN = LENOCC(FORLUN)
- ISTAT = LIB$SET_LOGICAL(FORLUN(1:LFLUN),
- + CHDSN(1:LDSN),'LNM$JOB',,)
-#include "fatmen/fatvaxrc.inc"
- IF(IDEBFA.GE.2) WRITE(LPRTFA,*) 'Assign ',
- + CHDSN(1:LDSN),' ',FORLUN(1:LFLUN)
-*
-* Protect against logical names in the process table
-*
- CALL FMGTLG(FORLUN(1:LFLUN),EQUNAM,'LNM$PROCESS',IC)
- IF(IC.EQ.0) THEN
- IF(IDEBFA.GE.0) PRINT 9011,FORLUN(1:LFLUN),EQUNAM(1:IS(1))
- 9011 FORMAT(' FMDISK. warning - conflicting logical name for ',A,/,
- + ' = ',A,/,
- + ' - deleted from process table')
- ISTAT = LIB$DELETE_LOGICAL(FORLUN(1:LFLUN),'LNM$PROCESS')
- ENDIF
-#endif
-#if defined(CERNLIB_UNIX)
-*
-* Just issue the assign...
-*
- FORLUN = 'fort. '
- IF(LUN.LT.10) THEN
- WRITE(FORLUN(6:6),'(I1)') LUN
- ELSE
- WRITE(FORLUN(6:7),'(I2)') LUN
- ENDIF
-
- IF (LUN .EQ. 0) FORLUN = CHLUN
- LFLUN = LENOCC(FORLUN)
-*
-* Fold to lower case
-*
- CALL CUTOL(FORLUN(1:LFLUN))
-*
-* Remove existing link, if any
-*
- ILINK = UNLINKF(FORLUN(1:LFLUN))
-#endif
-#if (defined(CERNLIB_UNIX))&&(!defined(CERNLIB_SHIFT))
- CALL CUTOL(CHDSN)
-#endif
-#if (defined(CERNLIB_UNIX))&&(!defined(CERNLIB_CRAY))&&(!defined(CERNLIB_SHIFT))&&(!defined(CERNLIB_APOLLO))
- IF (IDEBFA .GE. 2) WRITE(LPRTFA,*) 'ln for logical unit ',
- + FORLUN(1:LFLUN),' CHDSN = ',CHDSN(1:LDSN)
- IRC = SYSTEMF('ln -sf '//CHDSN(1:LDSN)//' '
- + //FORLUN(1:LFLUN))
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.-3) WRITE(LPRTFA,9012) IRC
- 9012 FORMAT(' FMDISK. return code ',I6,' from ln')
- GOTO 20
- ENDIF
- IF(CHDSN(1:4).EQ.'/afs') CALL SBIT1(IHOWFA,JAFSFA)
-#endif
-#if defined(CERNLIB_APOLLO)
- IC = SYSTEMF('ln -sf '//CHDSN(1:LDSN)//' '
- + //FORLUN(1:LFLUN))
- IF (IDEBFA .GE. 2) WRITE(LPRTFA,*) 'ln for logical unit ',
- + FORLUN(1:LFLUN),' CHDSN = ',CHDSN(1:LDSN)
-#endif
-#if (defined(CERNLIB_UNIX))&&(defined(CERNLIB_CRAY))
- IC = SYSTEMF('assign -a '//CHDSN(1:LDSN)//' '
- + //FORLUN(1:LFLUN))
- IF (IDEBFA .GE. 2) WRITE(LPRTFA,*) 'Assign for logical unit ',
- + FORLUN(1:LFLUN),' CHDSN = ',CHDSN(1:LDSN)
-#endif
-#if (defined(CERNLIB_UNIX))&&(defined(CERNLIB_SHIFT))
-*
-* Remove existing link, if any
-*
- ILINK = UNLINKF(FORLUN(1:LFLUN))
-
- IF(LUN.LT.10) THEN
- WRITE(FORLUN,'(I1)') LUN
- ELSE
- WRITE(FORLUN,'(I2)') LUN
- ENDIF
-
- LFLUN = LENOCC(FORLUN)
-
- CALL CTRANS('<','[',CHDSN,1,LDSN)
- CALL CTRANS('>',']',CHDSN,1,LDSN)
- ILSQB = INDEX(CHDSN(1:LDSN),'[')
- IRSQB = INDEX(CHDSN(1:LDSN),']')
-
- IF(ILSQB.NE.0) THEN
-
- IF(IDEBFA.GE.0) PRINT *,'FMDISK. SHIFT POOL file...'
-
- IDOT = INDEX(CHDSN(1:IRSQB),'.')
- SHPOOL = CHDSN(2:IDOT-1)
- SHUSER = CHDSN(IDOT+1:IRSQB-1)
- ISTART = IRSQB+1
- IEND = LDSN
- IF (IDEBFA.GE.0) WRITE(LPRTFA,*) 'Assign for logical unit ',
- + FORLUN(1:LFLUN),' pool = ',SHPOOL, ' user = ',SHUSER,' CHDSN ='
- + //' ',CHDSN(ISTART:IEND)
-*
-* Get temporary file name
-*
- 10 CONTINUE
- CALL FMFNME(SHUNAM)
- LUNAM = LENOCC(SHUNAM)
- INQUIRE(FILE=SHUNAM(1:LUNAM),EXIST=IEXIST)
- IF(IEXIST) THEN
- IC = SLEEPF(1)
- GO TO 10
- ENDIF
-
- IF(IDEBFA.GE.1) PRINT *,'FMDISK. using temporary file ',
- + SHUNAM(1:LUNAM)
-*
-* Issue SFGET to obtain full shift pathname
-*
- CALL FMFGET(SHPOOL,SHUSER,CHDSN(ISTART:IEND),SHFNAM,IMODE,'D',
- + IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMDISK. return code ',IRC,
- + ' from FMFGET'
- GOTO 20
- ENDIF
- LFNAM = IS(1)
-*
-* Perform assign
-*
- IF(IDEBFA.GE.0) PRINT *,'FMDISK. issuing ',
- + 'assign '//SHFNAM(1:LFNAM)//' '//FORLUN(1:LFLUN)//' '
- IRC = SYSTEMF('assign '//SHFNAM(1:LFNAM)//' '
- + //FORLUN(1:LFLUN)//' ')
-
- ELSE
-
- IF(IDEBFA.GE.0) PRINT *,'FMDISK. SHIFT private file...'
- IF (IDEBFA.GE.0) WRITE(LPRTFA,*) 'Assign for logical unit ',
- + FORLUN(1:LFLUN),' CHDSN = ',CHDSN(1:LDSN)
- IC = SYSTEMF('assign '//CHDSN(1:LDSN)//' '//
- + FORLUN(1:LFLUN))
- SHFNAM = CHDSN(1:LDSN)
- LFNAM = LDSN
- IF(IC.NE.0) THEN
- PRINT *,'FMDISK. return code ',IC,' from SFGET'
- GOTO 20
- ENDIF
- ENDIF
-#endif
- 20 CONTINUE
-
- IF(IDEBFA.GE.1) THEN
- CALL DATIME(ID,IT)
- PRINT 9013,ID,IT,IS(6)
- 9013 FORMAT(' FMDISK. exit at ',I6.6,1X,I4.4,I2.2)
- ENDIF
-
- END
diff --git a/src/packlib/fatmen/fmint/fmfilc.F b/src/packlib/fatmen/fmint/fmfilc.F
deleted file mode 100644
index 0c31f10..0000000
--- a/src/packlib/fatmen/fmint/fmfilc.F
+++ /dev/null
@@ -1,60 +0,0 @@
-*
-* $Id: fmfilc.F,v 1.1.1.1 1996/03/07 15:18:12 mclareni Exp $
-*
-* $Log: fmfilc.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:12 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMFILC(PATH,NFILES,IRC)
- CHARACTER*(*) PATH
- CHARACTER*255 CHPATH
-#include "fatmen/fatsys.inc"
-#include "fatmen/fatbank.inc"
-#include "fatmen/fatpara.inc"
- LOGICAL IEXIST,IOPEN
-#include "fatmen/fafccm.inc"
- EXTERNAL FAFC
-#include "fatmen/fatinit.inc"
-*
-* IQUEST(11) = NMATCH
-* IQUEST(12) = NFOUND
-* IQUEST(13) = NDIRT
-*
- LPATH = LENOCC(PATH)
-*
- IOPTD = 0
- IOPTF = 0
- IOPTL = 0
- IOPTZ = 0
-*
- NFOUND = 0
- NMATCH = 0
- NDIRT = 0
-*
- LWRITE = LPRTFA
-*
-* Count number of files matching pattern
-*
- LSLASH = INDEXB(PATH(1:LPATH),'/')
- CHPATH = PATH(1:LSLASH-1)
- CHFILE = PATH(LSLASH+1:LPATH)
- LP = LENOCC(CHPATH)
- LF = LENOCC(CHFILE)
- IF(IDEBFA.GE.2) PRINT *,'FMFILC. enter for ',PATH(1:LPATH)
-
- IF(ICFMUL('*%(<>',CHPATH,1,LP).GT.LP) THEN
- CALL FACDIR(CHPATH(1:LP),' ')
- CALL FAFC(CHPATH(1:LP),IRC)
- ELSE
- CALL FMSCAN(CHPATH(1:LPATH),99,FAFC,IRC)
- ENDIF
-
- IQUEST(11) = NMATCH
- IQUEST(12) = NFOUND
- IQUEST(13) = NDIRT
- NFILES = NMATCH
-
- RETURN
- END
diff --git a/src/packlib/fatmen/fmint/fmfill.F b/src/packlib/fatmen/fmint/fmfill.F
deleted file mode 100644
index a92911d..0000000
--- a/src/packlib/fatmen/fmint/fmfill.F
+++ /dev/null
@@ -1,223 +0,0 @@
-*
-* $Id: fmfill.F,v 1.1.1.1 1996/03/07 15:18:09 mclareni Exp $
-*
-* $Log: fmfill.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:09 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMFILL(GENAM,LFAT,KEYS,CHOPT,IRC)
-#include "fatmen/fmpath.inc"
-#include "fatmen/fatpara.inc"
-#include "fatmen/fatbank.inc"
- INTEGER FMUSER,FMHOST,FMJOB,FMACNT
- CHARACTER*(*) GENAM,CHOPT
- PARAMETER (LKEYFA=10)
- DIMENSION KEYS(LKEYFA)
- CHARACTER*20 FILE
- CHARACTER*80 COMM
- CHARACTER*4 FFORM,FLFRM,UFORM
- CHARACTER*256 DSN
- CHARACTER*6 VSN,VID
- CHARACTER*8 CNAME,CTYPE,CSYS,CUSER,CJOB,CACCT
-#include "fatmen/tmsdef0.inc"
-#include "fatmen/fatoptd.inc"
-#include "fatmen/tmsdef1.inc"
-#include "fatmen/fatoptc.inc"
- IF(IOPTA.NE.0) THEN
-#include "fatmen/fatoset.inc"
- ENDIF
- IF(INDEX(CHOPT,'Z').EQ.0) IOPTZ = 0
-*
-* Fill the bank entry corresponding to the input generic name
-*
- IRC = 0
- LGEN = LENOCC(GENAM)
- IF(LFAT.EQ.0) THEN
- CALL FMGETK(GENAM(1:LGEN),LBANK,KEYS,IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.2)
- + PRINT *,'FMFILL. Return code ',IRC,' from FMGETK'
- RETURN
- ENDIF
- ELSE
- IF(IDEBFA.GE.1)
- + PRINT *,'FMFILL. Enter for user-supplied bank at address ',LFAT
- LBANK = LFAT + KOFUFA
- ENDIF
-
- ICH = INDEXB(GENAM(1:LGEN),'/')
- FILE = GENAM(ICH+1:LGEN)
- LFILE = LENOCC(FILE)
-*
- IC = FMHOST(CNAME,CTYPE,CSYS)
- IC = FMJOB(CJOB)
- IC = FMUSER(CUSER)
- IC = FMACNT(CACCT)
-*
-* Keys
-*
- IF (IOPTK.NE.0) THEN
-*
-* Fill KEYS vector
-*
- CALL VBLANK(KEYS(2),5)
- CALL UCTOH(FILE(1:LFILE),KEYS(2),4,LFILE)
- KEYS(MKSRFA) = 0
- KEYS(MKCLFA) = 0
- KEYS(MKLCFA) = 1
- KEYS(MKMTFA) = 1
- KEYS(MKNBFA) = MKNBFA
- IF(IDEBFA.GE.2)
- + PRINT *,'FMFILL. Setting KEYS vector to default values'
- IF(IDEBFA.GE.2) CALL FMPKEY(KEYS,10)
- ENDIF
-
- IF (IOPTC .NE. 0) THEN
-*
-* Comment field
-*
- IF(IDEBFA.GE.2)
- + PRINT *,'FMFILL. comment field will be set to blanks'
- CALL CFILL(' ',COMM,1,80)
- CALL UCTOH(COMM,IQ(LBANK+MUCMFA),4,80)
- ENDIF
-
- IF (IOPTF.NE.0) THEN
-*
-* File attributes
-*
- IQ(LBANK+MSRDFA) = 0
- IQ(LBANK+MERDFA) = 0
- IQ(LBANK+MSBLFA) = 0
- IQ(LBANK+MEBLFA) = 0
- ENDIF
-
- IF (IOPTL.NE.0) THEN
-*
-* Logical attributes
-*
- CALL UCTOH('UN ',IQ(LBANK+MFLFFA),4,4)
- CALL UCTOH(' ',IQ(LBANK+MFUTFA),4,4)
- IF(IDEBFA.GE.2)
- + PRINT *,'FMFILL. Setting logical attributes to default values'
- ENDIF
-
- IF (IOPTM.NE.0) THEN
-*
-* Media attributes
-*
- IF (IQ(LBANK+MMTPFA) .EQ. 1) THEN
-*
-* Disk dataset, set host type and O/S
-*
-*
- CALL VBLANK(IQ(LBANK+MHSNFA),NHSNFA/4)
- CALL VBLANK(IQ(LBANK+MHSTFA),NHSTFA/4)
- CALL VBLANK(IQ(LBANK+MHOSFA),NHOSFA/4)
- CALL UCTOH(CNAME,IQ(LBANK+MHSNFA),4,LENOCC(CNAME))
- CALL UCTOH(CTYPE,IQ(LBANK+MHSTFA),4,LENOCC(CTYPE))
- CALL UCTOH(CSYS ,IQ(LBANK+MHOSFA),4,LENOCC(CSYS))
- ELSE
-*
-* Tape dataset
-*
-*
-* Update to indicate a tape file...
-*
- KEYS(MKMTFA) = 2
- IQ(LBANK+MMTPFA) = 2
-
- CALL UCTOH(' ',IQ(LBANK+MVSNFA),4,8)
- CALL UCTOH(' ',IQ(LBANK+MVIDFA),4,8)
- IQ(LBANK+MDENFA) = 38000
- IQ(LBANK+MFSQFA) = 1
- IQ(LBANK+MVSQFA) = 1
- IQ(LBANK+MVIPFA) = 0
- ENDIF
- ENDIF
-
- IF (IOPTN.NE.0) THEN
-*
-* Name attributes (DSN on disk/tape)
-*
- CALL VBLANK(IQ(LBANK+MFQNFA),NFQNFA/4)
- ENDIF
-
- IF (IOPTO.NE.0) THEN
-*
-* Owner attributes
-*
- IF(IDEBFA.GE.2)
- + PRINT *,'FMFILL. Setting owner attributes'
- IF(IDEBFA.GE.3)
- + PRINT *,'FMFILL. Owner will be set to ',
- + CUSER(1:LENOCC(CUSER))
- CALL VBLANK(IQ(LBANK+MCURFA),NCURFA/4)
- CALL UCTOH(CUSER,IQ(LBANK+MCURFA),4,LENOCC(CUSER))
- IF(IDEBFA.GE.3)
- + PRINT *,'FMFILL. Current node will be set to ',
- + CNAME(1:LENOCC(CNAME))
- CALL VBLANK(IQ(LBANK+MCNIFA),NCNIFA/4)
- CALL UCTOH(CNAME,IQ(LBANK+MCNIFA),4,LENOCC(CNAME))
- IF(IDEBFA.GE.3)
- + PRINT *,'FMFILL. Account will be set to ',
- + CACCT(1:LENOCC(CACCT))
- CALL VBLANK(IQ(LBANK+MCIDFA),NCIDFA/4)
- CALL UCTOH(CACCT,IQ(LBANK+MCIDFA),4,LENOCC(CACCT))
- IF(IDEBFA.GE.3)
- + PRINT *,'FMFILL. Job will be set to ',
- + CJOB(1:LENOCC(CJOB))
- CALL VBLANK(IQ(LBANK+MCJIFA),NCJIFA/4)
- CALL UCTOH(CJOB, IQ(LBANK+MCJIFA),4,LENOCC(CJOB))
- ENDIF
-
- IF (IOPTP.NE.0) THEN
-*
-* Physical attributes
-*
- IF(IDEBFA.GE.2)
- + PRINT *,'FMFILL. Setting physical attributes to zero/blank'
- CALL UCTOH(' ',IQ(LBANK+MRFMFA),4,4)
- IQ(LBANK+MRLNFA) = 0
- IQ(LBANK+MBLNFA) = 0
- IQ(LBANK+MFSZFA) = 0
- IQ(LBANK+MUSCFA) = 0
- ENDIF
-
- IF (IOPTS.NE.0) THEN
-*
-* Security attributes
-*
- IF(IDEBFA.GE.2) PRINT *,'FMFILL. security word will be zeroed'
- IQ(LBANK+MFPRFA) = 0
- ENDIF
-
- IF (IOPTT.NE.0) THEN
-*
-* Time attributes
-*
- CALL DATIME(IDATE,ITIME)
- CALL FMPKTM(IDATE,ITIME,IPACK,IRC)
- IF(IDEBFA.GE.2)
- + PRINT *,'FMFILL. date & time fields will be set to ',
- + IDATE,ITIME
- IQ(LBANK+MCRTFA) = IPACK
- IQ(LBANK+MCTTFA) = IPACK
- IQ(LBANK+MLATFA) = IPACK
- ENDIF
-
- IF (IOPTU.NE.0) THEN
-*
-* User words
-*
- IF(IDEBFA.GE.2) PRINT *,'FMFILL. User words will be zeroed'
- CALL VZERO(IQ(LBANK+MUSWFA),10)
- ENDIF
-*
-* Display bank if option Z specfied
-*
- IF(IOPTZ.NE.0) CALL FMSHOW(GENAM,LBANK-KOFUFA,KEYS,'A',IRC)
-
- END
diff --git a/src/packlib/fatmen/fmint/fmfils.F b/src/packlib/fatmen/fmint/fmfils.F
deleted file mode 100644
index 728f701..0000000
--- a/src/packlib/fatmen/fmint/fmfils.F
+++ /dev/null
@@ -1,109 +0,0 @@
-*
-* $Id: fmfils.F,v 1.2 1997/07/04 13:36:31 jamie Exp $
-*
-* $Log: fmfils.F,v $
-* Revision 1.2 1997/07/04 13:36:31 jamie
-* save patho
-*
-* Revision 1.1.1.1 1996/03/07 15:18:12 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMFILS(PATH,FILES,KEYS,NDONE,MAXKEY,ICONT,IRC)
-#include "fatmen/fatpara.inc"
-#include "fatmen/fatbank.inc"
-#include "fatmen/fmnkeys.inc"
- CHARACTER*(*) PATH
- CHARACTER*255 PATHO
- CHARACTER*(*) FILES(MAXKEY)
- CHARACTER*20 FNAME,MATCH
- DIMENSION KEYS(LKEYFA,MAXKEY)
-*
-* NMAX limits the maximum number of keys that can be processed
-* in a single call to FMKEYS
-*
- PARAMETER (NMAX=100)
- DIMENSION MYKEYS(LKEYFA,NMAX)
- SAVE ISTART,NKEYS,NRET,IFIRST,ILAST,MYKEYS,PATHO
-
- IRC = 0
- LPATH = LENOCC(PATH)
- LP = INDEXB(PATH(1:LPATH),'/')-1
- MATCH = PATH(LP+2:LPATH)
- LM = LENOCC(MATCH)
- IF(IDEBFA.GE.2) THEN
- PRINT *,'FMFILS. enter for path = ',PATH(1:LP),' match = ',
- + MATCH(1:LM)
- PRINT *,'FMFILS. icont = ',ICONT,' istart = ',ISTART
- ENDIF
-
- NDONE = 0
- IF(ICONT.NE.0) THEN
- IF(IDEBFA.GE.2) PRINT *,'FMFILS. continue at offset ',
- + ISTART,' in range ',IFIRST,ILAST
- GOTO 20
- ENDIF
-
- ISTART = 1
-*
-* Save current directory
-*
- CALL FACDIR(PATHO,'R')
-*
-* Reset current directory
-*
- CALL FACDIR(PATH(1:LP),' ')
-
- IF(IQUEST(1) .NE. 0) THEN
- IRC = -1
- GOTO 40
- ENDIF
-
- IFIRST = 1
- ILAST = NMAX
-
- 10 CONTINUE
- CALL FMKEYS(LKEYFA,NMAX,IFIRST,ILAST,MYKEYS,NFILES,IRET)
- NKEYS = IQUEST(11)
- IF(IQUEST(1) .NE. 0) THEN
- IF(IDEBFA.GE.2)
- + PRINT *,'FMFILS. More than ',NMAX,' files in ',PATH(1:LP)
- IF(IDEBFA.GE.2)
- + PRINT *,'FMFILS. IQUEST(11-12) = ',IQUEST(11),IQUEST(12)
- ENDIF
-*
-* Process all keys returned and move those that match to KEYS
-*
- NRET = IQUEST(13)
- IF(NRET.EQ.0) GOTO 40
- 20 CONTINUE
- DO 30 I=ISTART,NRET
-*
-* Can we accept any more keys?
-*
- IF(NDONE .LT. MAXKEY) THEN
- CALL UHTOC(MYKEYS(2,I),4,FNAME,(MKCLFA-MKFNFA)*4)
- CALL FMATCH(FNAME,MATCH(1:LM),IRET)
- IF(IRET.EQ.0) THEN
- NDONE = NDONE + 1
- FILES(NDONE) = PATH(1:LP)//'/'//FNAME
- CALL UCOPY(MYKEYS(1,I),KEYS(1,NDONE),LKEYFA)
- ENDIF
- ELSE
- IRC = -1
- ICONT = 1
- ISTART = I
- RETURN
- ENDIF
-
- 30 CONTINUE
- IF(ILAST.LT.NKEYS) THEN
- IFIRST = IFIRST + NMAX
- ILAST = MIN(NKEYS,ILAST+NMAX)
- ISTART = 1
- GOTO 10
- ENDIF
-
- 40 CALL FACDIR(PATHO(1:LENOCC(PATHO)),' ')
- END
diff --git a/src/packlib/fatmen/fmint/fmfind.F b/src/packlib/fatmen/fmint/fmfind.F
deleted file mode 100644
index d428149..0000000
--- a/src/packlib/fatmen/fmint/fmfind.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: fmfind.F,v 1.1.1.1 1996/03/07 15:18:11 mclareni Exp $
-*
-* $Log: fmfind.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:11 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMFIND(GENAME,CHLUN,LENTRY,IRC)
-*
-* New FMFIND - just interface to FMOPEN
-*
-#include "fatmen/fatbug.inc"
- CHARACTER*(*) GENAME,CHLUN
- CHARACTER*4 CHOPT
-
- IRC = 0
- LGN = LENOCC(GENAME)
-
- IF(IDEBFA.GE.2) PRINT *,'FMFIND. enter for ',
- + GENAME(1:LGN),' ',CHLUN,' LBANK = ',LENTRY
-
- CHOPT = 'RU'
-
- CALL FMOPEN(GENAME(1:LGN),CHLUN,LENTRY,CHOPT,IRC)
-
- END
diff --git a/src/packlib/fatmen/fmint/fmfnms.F b/src/packlib/fatmen/fmint/fmfnms.F
deleted file mode 100644
index 1d84832..0000000
--- a/src/packlib/fatmen/fmint/fmfnms.F
+++ /dev/null
@@ -1,85 +0,0 @@
-*
-* $Id: fmfnms.F,v 1.1.1.1 1996/03/07 15:18:10 mclareni Exp $
-*
-* $Log: fmfnms.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:10 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMFNMS(PATH,FILES,KEYS,NKEYS,MAXKEY,IRC)
-*
-* Return file names and keys vector for named directory
-*
-#include "fatmen/fatpara.inc"
-#include "fatmen/fatbug.inc"
- CHARACTER*(*) PATH
- CHARACTER*255 CHPATH
- CHARACTER FILES(MAXKEY)*(*)
- PARAMETER (LURCOR=200000)
- COMMON/CRZT/IXSTOR,IXDIV,IFENCE(2),LEV,LEVIN,BLVECT(LURCOR)
- DIMENSION LQ(999),IQ(999),Q(999)
- EQUIVALENCE (IQ(1),Q(1),LQ(9)),(LQ(1),LEV)
-*
-#include "fatmen/fatusr.inc"
-#include "zebra/quest.inc"
- DIMENSION IQSAVE(100)
-#include "fatmen/fmnkeys.inc"
- DIMENSION KEYS(LKEYFA,MAXKEY)
- CHARACTER*255 LINE
-*
-* Set current directory
-*
- LPATH = LENOCC(PATH)
- NKEYS = 0
- IF(IDEBFA.GE.3) PRINT *,'FMFNMS. enter for path = ',
- + PATH(1:LPATH)
- CHPATH = PATH(1:LPATH)
- CALL CLTOU(CHPATH(1:LPATH))
-#if !defined(CERNLIB_CZ)
- CALL FACDIR(CHPATH(1:LPATH),' ')
- IF(IQUEST(1).NE.0) THEN
- IRC = -1
- RETURN
- ENDIF
-#endif
-#if defined(CERNLIB_CZ)
- CALL CZPUTA('MESS :CD '//CHPATH(1:LPATH)),ISTAT)
-#endif
-*
-* Get keys from current directory and match against current file
-*
-#if !defined(CERNLIB_CZ)
- CALL RZKEYS(LKEYFA,MAXKEY,KEYS,NKEYS)
-#endif
-#if defined(CERNLIB_CZ)
-*
-* Get keys from remote server
-*
- CALL CZPUTA('MESS :KE',ISTAT)
-1 CONTINUE
-
- CALL CZGETA(LINE,ISTAT)
-*
- IF (LINE(1:1) .EQ. '0') GOTO 2
- IF (INDEX(LINE,'No files found') .NE. 0) THEN
- ELSE
- NKEYS = NKEYS + 1
- READ(LINE,9001) (KEYS(J,NKEYS),J=1,10)
- ENDIF
-
-9001 FORMAT(2X,I5,5A4,4I5)
- IF (LINE(1:1) .EQ. '2') GOTO 1
-2 CONTINUE
-#endif
-*
-* Loop over keys returned
-*
- IRC = 0
- IF(NKEYS.GT.MAXKEY) IRC = 1
- DO 10 I=1,MIN(NKEYS,MAXKEY)
- CALL CFILL(' ',FILES(I),1,LENOCC(FILES(I)))
- CALL UHTOC(KEYS(MKFNFA,I),4,FILES(I),(MKCLFA-MKFNFA)*4)
-10 CONTINUE
-
- END
diff --git a/src/packlib/fatmen/fmint/fmfpak.F b/src/packlib/fatmen/fmint/fmfpak.F
deleted file mode 100644
index 1470eda..0000000
--- a/src/packlib/fatmen/fmint/fmfpak.F
+++ /dev/null
@@ -1,234 +0,0 @@
-*
-* $Id: fmfpak.F,v 1.1.1.1 1996/03/07 15:18:12 mclareni Exp $
-*
-* $Log: fmfpak.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:12 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
-#if defined(CERNLIB_FPACK)
- SUBROUTINE FMFPAK(GENAM,LBANK,KEYS,CHSYMB,CHOPT,IRC)
-
- CHARACTER*(*) GENAM,CHSYMB
-#include "fatmen/fatbank.inc"
-#include "fatmen/fatpara.inc"
-#include "fatmen/faspac.inc"
-#include "fatmen/fmnkeys.inc"
- DIMENSION KEYS(LKEYFA)
- CHARACTER*255 CHCOMM,CHFILE
- CHARACTER*12 CHNREC,CHNRC2,CHRECL,CHBLF
- CHARACTER*9 CHACT
- CHARACTER*256 CHDSN
- CHARACTER*8 CHHOST
- CHARACTER*4 CHFORM
-#include "fatmen/fatopts.inc"
-
- IRC = 0
-
- LGN = LENOCC(GENAM)
- LSM = LENOCC(CHSYMB)
-*
-* Get file name
-*
- CALL FMGDSN(LBANK,CHDSN,LDSN,IRC)
-*
-* Get host name
-*
- CALL UHTOC(IQ(LBANK+KOFUFA+MHSNFA),4,CHHOST,8)
- LHOST = LENOCC(CHHOST)
-*
-* Get package format
-*
- CALL UHTOC(IQ(LBANK+KOFUFA+MFLFFA),4,CHFORM,4)
- LFORM = LENOCC(CHFORM)
-*
-* Action
-*
- IF((IOPTR.EQ.0).AND.(IOPTW.EQ.0)) IOPTR = 1
-
- IF(IOPTR.EQ.0.AND.IOPTW.NE.0) THEN
- CHACT = 'WRITE'
- LCHACT = 5
- ELSEIF(IOPTR.NE.0.AND.IOPTW.NE.0) THEN
- CHACT = 'READWRITE'
- LCHACT = 9
- ELSE
- CHACT = 'READ'
- LCHACT = 4
- ENDIF
-*
-* build CHCOMM string for FPACK interpreter
-* OPEN symbolic-name FILE=filename HOST=hostname [options...]
-* options: RECL, BLFACTOR, NREC, NREC2, ACTION, ACCESS,
-* STATUS, FORM, WORDFMT, RECSEP, NOOPEN
-*
-* ACCESS = sequential (FPT, FPS), direct (FPD), keyed (FPK),
-* ordered (FPO)
-* FORM = FPT = text, binary otherwise
-* NOOPEN = IOPTU
-* WORDFMT = MCPLFA
-* ACTION = IOPTR & IOPTW (modify not supported)
-* STATUS = OLD, unless action=write
-* NREC = number of records, primary allocation
-* NREC2 = number of records, secondary allocation
-* RECSEP = (not yet implemented)
-* RECL = MRLNFA*4
-* BLFACTOR = MBLNFA/MRLNFA
-*
- CHFILE = CHSYMB(1:LSM)
- LCHLUN = LSM
- CHCOMM = 'OPEN '//CHFILE(1:LCHLUN)//' FILE="'
- + //CHDSN(1:LDSN)//'"'
- + //' HOST='//CHHOST(1:LHOST)//' ACTION='
- + //CHACT(1:LCHACT)
- LCOM = LENOCC(CHCOMM)
-*
-* RECL BLFACTOR
-*
- IF(IQ(LBANK+KOFUFA+MRLNFA).GT.0) THEN
- CALL FMITOC(IQ(LBANK+KOFUFA+MRLNFA)*4,CHRECL,JS)
- CHCOMM(LCOM+1:LCOM+JS+6) = ' RECL='//CHRECL(1:JS)
- LCOM = LCOM + JS + 6
- IF(IQ(LBANK+KOFUFA+MBLNFA).GT.0) THEN
- CALL FMITOC(IQ(LBANK+KOFUFA+MBLNFA)/
- + IQ(LBANK+KOFUFA+MRLNFA),CHBLF,JS)
- CHCOMM(LCOM+1:LCOM+JS+10) = ' BLFACTOR='//CHBLF(1:JS)
- LCOM = LCOM + JS + 10
- ENDIF
- ENDIF
-*
-* Status: NEW enforced for ACTION=WRITE
-*
- IF(IOPTW.NE.1.AND.IOPTR.EQ.0) THEN
- CHCOMM(LCOM+1:LCOM+11) = ' STATUS=NEW'
-*
-* Allocation
-*
- IF(NPRIFA.GT.0) THEN
-*
-* Primary...
-*
- CALL FMITOC(NPRIFA,CHNREC,JS)
- CHCOMM(LCOM+1:LCOM+JS+6) = ' NREC='//CHNREC(1:JS)
- LCOM = LCOM + JS + 6
- IF(IQUEST(13).GT.0) THEN
-*
-* Secondary...
-*
- CALL FMITOC(NSECFA,CHNREC,JS)
- CHCOMM(LCOM+1:LCOM+JS+7) = ' NREC2='//CHNRC2(1:JS)
- LCOM = LCOM + JS + 7
- ENDIF
- ENDIF
- ELSE
- CHCOMM(LCOM+1:LCOM+11) = ' STATUS=OLD'
- ENDIF
- LCOM = LCOM + 11
-*
-* Space: in case of new files, primary/secondary allocations
-* are taken from IQUEST(12-13), if non-zero
-*
-
- IF(IOPTU.NE.0) THEN
- CHCOMM(LCOM+1:LCOM+7) = ' NOOPEN'
- LCOM = LCOM + 7
- ENDIF
-*
-* WORDFMT...
-*
- IF(IQ(LBANK+KOFUFA+MCPLFA).EQ.0) THEN
-*
-* 'local' i.e. native
-*
- CHCOMM(LCOM+1:LCOM+16) = ' WORDFMT=WFLOCAL'
- LCOM = LCOM + 16
-
- ELSEIF(IQ(LBANK+KOFUFA+MCPLFA).EQ.1) THEN
-*
-* IEEE big endian
-*
- CHCOMM(LCOM+1:LCOM+15) = ' WORDFMT=WFIEEE'
- LCOM = LCOM + 15
-
- ELSEIF(IQ(LBANK+KOFUFA+MCPLFA).EQ.2) THEN
-*
-* IBM
-*
- CHCOMM(LCOM+1:LCOM+14) = ' WORDFMT=WFIBM'
- LCOM = LCOM + 14
-
- ELSEIF(IQ(LBANK+KOFUFA+MCPLFA).EQ.3) THEN
-*
-* VAX
-*
- CHCOMM(LCOM+1:LCOM+14) = ' WORDFMT=WFVAX'
- LCOM = LCOM + 14
-
- ELSEIF(IQ(LBANK+KOFUFA+MCPLFA).EQ.4) THEN
-*
-* DECstation (IEEE little endian)
-*
- CHCOMM(LCOM+1:LCOM+14) = ' WORDFMT=WFDEC'
- LCOM = LCOM + 14
-
- ELSEIF(IQ(LBANK+KOFUFA+MCPLFA).EQ.5) THEN
-*
-* CRAY
-*
- CHCOMM(LCOM+1:LCOM+15) = ' WORDFMT=WFCRAY'
- LCOM = LCOM + 15
-
- ENDIF
-
-*
-* FPACK FORM and ACCESS parameters...
-*
- IF(CHFORM(1:3).EQ.'FPT') THEN
-*
-* text files
-*
- CHCOMM(LCOM+1:LCOM+28) = ' ACCESS=SEQUENTIAL FORM=TEXT'
- LCOM = LCOM + 28
-
- ELSEIF(CHFORM(1:3).EQ.'FPS') THEN
-*
-* binary sequential files
-*
- CHCOMM(LCOM+1:LCOM+30) = ' ACCESS=SEQUENTIAL FORM=BINARY'
- LCOM = LCOM + 30
-
- ELSEIF(CHFORM(1:3).EQ.'FPD') THEN
-*
-* binary direct access files
-*
- CHCOMM(LCOM+1:LCOM+26) = ' ACCESS=DIRECT FORM=BINARY'
- LCOM = LCOM + 26
-
- ELSEIF(CHFORM(1:3).EQ.'FPK') THEN
-*
-* binary keyed access files
-*
- CHCOMM(LCOM+1:LCOM+25) = ' ACCESS=KEYED FORM=BINARY'
- LCOM = LCOM + 25
-
- ELSEIF(CHFORM(1:3).EQ.'FPO') THEN
-*
-* binary ordered access files
-*
- CHCOMM(LCOM+1:LCOM+27) = ' ACCESS=ORDERED FORM=BINARY'
- LCOM = LCOM + 27
-
- ENDIF
-
- IF(IDEBFA.GE.0) PRINT *,'FMOPEN. call FPARM for ',
- + CHCOMM(1:LCOM)
- CALL FPARM(CHCOMM(1:LCOM))
- CALL FERMES(CHCOMM,1)
- IRC = LENOCC(CHCOMM)
- IF(IRC.NE.0.AND.IDEBFA.GE.-3) PRINT *,'FMOPEN. error ',
- + 'from FPARM = ',CHCOMM(1:IRC)
- RETURN
-
- END
-#endif
diff --git a/src/packlib/fatmen/fmint/fmfzcp.F b/src/packlib/fatmen/fmint/fmfzcp.F
deleted file mode 100644
index 4defb84..0000000
--- a/src/packlib/fatmen/fmint/fmfzcp.F
+++ /dev/null
@@ -1,65 +0,0 @@
-*
-* $Id: fmfzcp.F,v 1.1.1.1 1996/03/07 15:18:11 mclareni Exp $
-*
-* $Log: fmfzcp.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:11 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMFZCP(LUNI,LUNO,CHOPT,IRC)
-*CMZ : 21/01/91 15.22.25 by Jamie Shiers
-*-- Author : Jamie Shiers 21/01/91
-* Routine to copy a complete FZ file from LUNI to LUNO
-* Files have already been opened, e.g. by FMOPEN.
-* Upon completion, FMCLOS should be called to close input
-* and output streams.
-*
- DIMENSION IOCR(100)
- DIMENSION IUHEAD(400)
- CHARACTER*1 CHFZ
-#include "fatmen/fatbank.inc"
-#include "fatmen/fatpara.inc"
-#include "fatmen/fatopts.inc"
-*
-* Perform the copy
-*
- 10 CONTINUE
- NUH = 400
- CALL FZIN(LUNI,IXDIV,LSUP,JBIAS,' ',NUH,IUHEAD)
- IF(IQUEST(1).LT.0) GOTO 30
- IF(IQUEST(1).GE.4) GOTO 20
- IF(IQUEST(1).EQ.0) IEVENT = IQUEST(11)
-*
-* start of run
-*
- IF(IQUEST(1).EQ.1) THEN
- IF(IOPTR.NE.0) GOTO 10
- CALL FZRUN(LUNO,IQUEST(11),NUH,IUHEAD)
- IF(IQUEST(1).NE.0) GOTO 30
- GOTO 10
-*
-* end of run
-*
- ELSEIF(IQUEST(1).EQ.2) THEN
- IF(IOPTR.NE.0) GOTO 10
- CALL FZRUN(LUNO,-1,NUH,IUHEAD)
- IF(IQUEST(1).NE.0) GOTO 30
- GOTO 10
-*
-* ZEBRA eof
-*
- ELSEIF(IQUEST(1).EQ.3) THEN
- ENDIF
-
- CALL UCOPY(IQUEST(21),IOCR,MIN(IQUEST(20),100))
- CHFZ = 'L'
- IF(IQUEST(14).EQ.0) CHFZ = 'Z'
- CALL FZOUT(LUNO,IXDIV,LSUP,IEVENT,CHFZ,IOCR,NUH,IUHEAD)
- IF(IQUEST(1).NE.0) GOTO 30
- GOTO 10
- 20 CONTINUE
- RETURN
- 30 IRC = IQUEST(1)
-
- END
diff --git a/src/packlib/fatmen/fmint/fmgbyk.F b/src/packlib/fatmen/fmint/fmgbyk.F
deleted file mode 100644
index e13434d..0000000
--- a/src/packlib/fatmen/fmint/fmgbyk.F
+++ /dev/null
@@ -1,115 +0,0 @@
-*
-* $Id: fmgbyk.F,v 1.1.1.1 1996/03/07 15:18:11 mclareni Exp $
-*
-* $Log: fmgbyk.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:11 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMGBYK(GENAM,LBANK,KEYS,IC)
-*CMZ : 25/01/91 14.36.59 by Jamie Shiers
-*-- Author : Jamie Shiers 25/01/91
-#include "fatmen/fatbank.inc"
-#include "fatmen/fatpara.inc"
-#include "fatmen/fmnkeys.inc"
- PARAMETER (NMAX=100)
- DIMENSION KEYS(LKEYFA)
- DIMENSION MYKEYS(LKEYFA,NMAX)
- CHARACTER*(*) GENAM
- CHARACTER*255 PATH
- CHARACTER*20 FNAME
-
- IRC = 0
-*
-* Save current directory
-*
- CALL FACDIR(PATH,'R')
-*
-* Reset current directory
-*
- LGEN = INDEXB(GENAM,'/')
- CALL FACDIR(GENAM(1:LGEN-1),' ')
-
- IF(IQUEST(1) .NE. 0) THEN
- IRC = -1
- GOTO 999
- ENDIF
-*
-* Build compare vector
-*
- IFIRST = 1
- ILAST = NMAX
- NDONE = 0
- NMATCH = 0
- IMATCH = 0
-*
-* *** Find file name
-*
- NCH = LENOCC(GENAM)
- FNAME = GENAM(LGEN+1:NCH)
- IF(IDEBFA.GE.3) PRINT *,'FMGBYK. Enter for ',GENAM(1:NCH),
- + ' key serial number = ',KEYS(1)
- CALL VBLANK(KEYS(2),5)
- CALL UCTOH(FNAME,KEYS(2),4,MIN(NCH-LGEN,20))
-
- IF(KEYS(1).EQ.0) THEN
- IMATCH = 1
- GOTO 100
- ENDIF
-
- IF(IDEBFA.GE.4) THEN
- PRINT *,'FMGBYK. compare vector ...'
- CALL FMPKEY(KEYS,LKEYFA)
- ENDIF
-
- 1 CONTINUE
- CALL FMKEYS(LKEYFA,NMAX,IFIRST,ILAST,MYKEYS,NFILES,IRET)
- NKEYS = IQUEST(11)
- IF(IQUEST(1) .NE. 0) THEN
- IF(IDEBFA.GE.2)
- + PRINT *,'FMGBYK. More than ',NMAX,' files in ',GENAM(1:LGEN-1)
- IF(IDEBFA.GE.2)
- + PRINT *,'FMGBYK. IQUEST(11-12) = ',IQUEST(11),IQUEST(12)
- ENDIF
-*
-* Process all keys returned and move the match to KEYS
-*
- NRET = IQUEST(13)
- DO 10 I=1,NRET
-*
-* Check Key serial number and file name
-*
- IF(IDEBFA.GE.4) THEN
- PRINT *,'FMGBYK. candidate # ',I,'...'
- CALL FMPKEY(MYKEYS(1,I),LKEYFA)
- ENDIF
-
- DO 20 J=MKSRFA,MKCLFA-1
- IF(KEYS(J) .NE. MYKEYS(J,I)) GOTO 10
- 20 CONTINUE
- CALL UCOPY(MYKEYS(1,I),KEYS(1),LKEYFA)
- IF(IDEBFA.GE.3) THEN
- PRINT *,'FMGBYK. found match...'
- CALL FMPKEY(KEYS,LKEYFA)
- ENDIF
- IMATCH = 1
- GOTO 100
-
- 10 CONTINUE
- IF(ILAST.LT.NKEYS) THEN
- IFIRST = IFIRST + NMAX
- ILAST = MIN(NKEYS,ILAST+NMAX)
- GOTO 1
- ENDIF
- 100 CONTINUE
- IF(IMATCH.EQ.0) THEN
- IC = 13
- IF(IDEBFA.GE.0) PRINT *,'FMGBYK. no match for ',GENAM(1:NCH),
- + ' key serial number = ',KEYS(1),' found'
- ELSE
- CALL FMGETK(GENAM(1:NCH),LBANK,KEYS,IC)
- ENDIF
-
- 999 CALL FACDIR(PATH(1:LENOCC(PATH)),' ')
- END
diff --git a/src/packlib/fatmen/fmint/fmgdsn.F b/src/packlib/fatmen/fmint/fmgdsn.F
deleted file mode 100644
index 4b70b9a..0000000
--- a/src/packlib/fatmen/fmint/fmgdsn.F
+++ /dev/null
@@ -1,76 +0,0 @@
-*
-* $Id: fmgdsn.F,v 1.1.1.1 1996/03/07 15:18:12 mclareni Exp $
-*
-* $Log: fmgdsn.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:12 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMGDSN(LBANK,CHDSN,LDSN,IRC)
-
- CHARACTER*(*) CHDSN
- CHARACTER*255 CHNFS
-
-#include "fatmen/fatmon.inc"
-#include "fatmen/fatbank.inc"
-#include "fatmen/fatpara.inc"
-#include "fatmen/slate.inc"
-
- IRC = 0
-
- CALL UHTOC(IQ(LBANK+KOFUFA+MFQNFA),4,CHDSN,NFQNFA)
- LDSN = LENOCC(CHDSN)
- LBLANK = INDEX(CHDSN,' ')
- IF(LBLANK.NE.0) LDSN = LBLANK - 1
-#if defined(CERNLIB_UNIX)
-*
-* If CHDSN starts with a $, assume that it is an environmental
-* variable.
-*
- IF(CHDSN(1:1).EQ.'$') THEN
- LENV = INDEX(CHDSN(1:LDSN),'/')
- CALL GETENVF(CHDSN(2:LENV-1),CHNFS)
- IF(IS(1).GT.0) THEN
- CHDSN = CHNFS(1:IS(1)) // CHDSN(LENV:LDSN)
- LDSN = LENOCC(CHDSN)
- CALL SBIT1(IHOWFA,JNFSFA)
- ELSE
- IF(IDEBFA.GE.-3) PRINT *,'FMGDSN. cannot translate ',
- + ' environmental variable ',CHDSN(1:LENV-1)
- ENDIF
- ENDIF
-#endif
-#if defined(CERNLIB_VAXVMS)
-*
-* If CHDSN starts with a $, assume that it is an environmental
-* variable.
-*
- IF(CHDSN(1:1).EQ.'$') THEN
- LENV = INDEX(CHDSN(1:LDSN),'/')
- CALL FMGTLG(CHDSN(2:LENV-1),CHNFS,'LNM$SYSTEM',IRC)
- LCHNFS = IS(1)
- IF(LCHNFS.GT.0) THEN
- CALL SBIT1(IHOWFA,JNFSFA)
-*
-* If there is more than one slash in file name
-* assume that the intervening elements are directory names
-*
- JSLASH = INDEXB(CHDSN(1:LDSN),'/')
- IF(JSLASH.EQ.LENV) THEN
- CHNFS(LCHNFS+1:) = CHDSN(LENV+1:LDSN)
- LCHNFS = LCHNFS + LDSN - LENV
- ELSE
- CHNFS(LCHNFS+1:) = '[' // CHDSN(LENV+1:JSLASH-1)
- + // ']' // CHDSN(JSLASH+1:LDSN)
- LCHNFS = LCHNFS + LDSN - LENV + 1
- CALL CTRANS('/','.',CHNFS,1,LCHNFS)
- ENDIF
- CHDSN = CHNFS(1:LCHNFS)
- LDSN = LCHNFS
-
- ENDIF
- ENDIF
-#endif
-
- END
diff --git a/src/packlib/fatmen/fmint/fmget.F b/src/packlib/fatmen/fmint/fmget.F
deleted file mode 100644
index 84c8488..0000000
--- a/src/packlib/fatmen/fmint/fmget.F
+++ /dev/null
@@ -1,73 +0,0 @@
-*
-* $Id: fmget.F,v 1.2 1996/09/11 16:08:53 jamie Exp $
-*
-* $Log: fmget.F,v $
-* Revision 1.2 1996/09/11 16:08:53 jamie
-* remote duplicate parameter lkeyfa
-*
-* Revision 1.1.1.1 1996/03/07 15:18:10 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMGET(GENAME,L,KEYS,IRC)
- CHARACTER*(*) GENAME
-#include "fatmen/faust.inc"
-#include "fatmen/fatbank.inc"
-#include "fatmen/fatpara.inc"
-#include "fatmen/fatkey.inc"
- DIMENSION KEYS(LKEYFA)
-
- NCH=LENOCC(GENAME)
- CALL CLTOU(GENAME)
-
- NFGET = NFGET + 1
-
- L = 0
- IRC = 0
-
- IF(IDEBFA.GE.2) PRINT *,'FMGET. enter for ',GENAME(1:NCH)
-
- IF(NCH.LT.3.OR.GENAME(1:2).NE.'//'.OR.GENAME(NCH:NCH).EQ.'/')THEN
- IQUEST(1) = 61
- IRC = 61
- RETURN
- ENDIF
-
- ICH=INDEXB(GENAME(1:NCH-1),'/')
- IF(ICH.LE.3.OR.NCH-ICH.GT.20) THEN
- IQUEST(1) = 62
- IRC = 62
- RETURN
- ENDIF
-
- IF(LTDSFA.NE.0) THEN
- CALL MZDROP(IDIVFA,LTDSFA,'L')
- LTDSFA = 0
- ENDIF
-
- CALL VZERO(KEYS,LKEYFA)
-*
-* Has a keys matrix been supplied?
-*
- IF(NUMKEY.EQ.0) THEN
-
- NWORDS = NKDSFA
-
- IFLAG = 0
- JBIAS = 1
- CALL FMRZIN(GENAME(1:NCH),IDIVFA,LTDSFA,JBIAS,
- + NWORDS,KEYS,IFLAG)
- L = LTDSFA
- IRC = IQUEST(1)
-*
-* Return a zero bank address if not found
-*
- IF(IRC.NE.0) L=0
- RETURN
- ELSE
- CALL FMSELM(GENAME(1:NCH),L,KEYS,MFMKEY,NUMKEY,CHKEY,IRC)
- ENDIF
-
- END
-
diff --git a/src/packlib/fatmen/fmint/fmgeta.F b/src/packlib/fatmen/fmint/fmgeta.F
deleted file mode 100644
index 4431d39..0000000
--- a/src/packlib/fatmen/fmint/fmgeta.F
+++ /dev/null
@@ -1,69 +0,0 @@
-*
-* $Id: fmgeta.F,v 1.1.1.1 1996/03/07 15:18:14 mclareni Exp $
-*
-* $Log: fmgeta.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:14 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMGETA(GENAME,LBANK,KEYS,IRC)
-#include "fatmen/faust.inc"
-#include "fatmen/fatpara.inc"
-#include "fatmen/fatbank.inc"
-#include "fatmen/fmpath.inc"
-*
-* If key serial number is non-zero, use that
-*
- CHARACTER*(*) GENAME
- PARAMETER (LKEYFA=10)
-#include "fatmen/fmaxcop.inc"
- DIMENSION KEYS(LKEYFA)
- DIMENSION KEYSIN(LKEYFA)
- DIMENSION KEYSOU(LKEYFA,MAXCOP)
-
- IRC = 0
- NCH = LENOCC(GENAME)
-
- IF(LTDSFA.NE.0) THEN
- CALL MZDROP(IDIVFA,LTDSFA,'L')
- LTDSFA = 0
- ENDIF
-
- LFILE = INDEXB(GENAME(1:NCH),'/') -1
- FILE1 = GENAME(LFILE+2:NCH)
- CALL FACDIR(GENAME(1:LFILE),'U')
- LFILE = LENOCC(FILE1)
-*
-* Check how many copies of this dataset exist
-*
- CALL UCOPY(KEYS,KEYSIN,10)
-*
-* Don't compare media type, copy level or location code
-*
- KEYSIN(MKMTFA) = -1
- KEYSIN(MKCLFA) = -1
- KEYSIN(MKLCFA) = -1
- CALL FMSELK(GENAME(1:NCH),KEYSIN,KEYSOU,NMATCH,MAXCOP,IRC)
- IF(NMATCH.EQ.0) THEN
- IF(IDEBFA.GE.0)
- + PRINT *,'FMGETA. found 0 matches for ',GENAME(1:NCH)
- IRC = 1
- GOTO 99
- ELSE
- LTDSFA = 0
- CALL FMGETK(GENAME(1:NCH),LTDSFA,KEYSOU(1,1),IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMGETA. Return code ',IRC,' from '
- + //'FMGETK'
- GOTO 99
- ENDIF
- CALL UCOPY(KEYSOU(1,1),KEYS,10)
- ENDIF
-
- LBANK = LTDSFA
- RETURN
-
- 99 CONTINUE
- LBANK = 0
- END
diff --git a/src/packlib/fatmen/fmint/fmgetc.F b/src/packlib/fatmen/fmint/fmgetc.F
deleted file mode 100644
index a6ce3c1..0000000
--- a/src/packlib/fatmen/fmint/fmgetc.F
+++ /dev/null
@@ -1,57 +0,0 @@
-*
-* $Id: fmgetc.F,v 1.1.1.1 1996/03/07 15:18:09 mclareni Exp $
-*
-* $Log: fmgetc.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:09 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMGETC(LBANK,STRING,ISTART,NCH,IRC)
-*
-* Routine to get a STRING from the bank at LBANK
-*
-#include "fatmen/fatbank.inc"
-#include "fatmen/fatpara.inc"
-#include "fatmen/fatusr.inc"
- CHARACTER*(*) STRING
- JL = ISTART
- JR = ISTART -1 + (NCH+3)/4
- IRC = 0
-*
-* Check that JL:JR is a valid range
-*
- IF(JR.LT.JL) THEN
- IF(IDEBFA.GE.0) THEN
- PRINT *,'FMGETC. invalid range, end < start'
- PRINT *,'FMGETC. ISTART/IEND = ',JL,JR
- ENDIF
- IRC = 1
- RETURN
- ENDIF
-
-*
-* Check that we are not outside the bank
-*
- IF((JL.LE.0).OR.(JR.GT.NWDSFA)) THEN
- IF(IDEBFA.GE.0) THEN
- PRINT *,'FMGETC. attempt to read outside bank boundaries'
- PRINT *,'FMGETC. ISTART/IEND = ',JL,JR
- ENDIF
- IRC = 1
- RETURN
- ENDIF
-
-
- LADDR = LBANK+KOFUFA
- IF(LBANK.EQ.-1) LADDR = LADDBK+KOFUFA
-*
-* Special case: VID prefix
-*
- IF(ISTART.EQ.MVIPFA) THEN
- CALL FMPREF(STRING,IQ(LADDR+JL),'I',IRC)
- ELSE
- CALL UHTOC(IQ(LADDR+JL),4,STRING,NCH)
- ENDIF
- END
-
diff --git a/src/packlib/fatmen/fmint/fmgeti.F b/src/packlib/fatmen/fmint/fmgeti.F
deleted file mode 100644
index 580cda2..0000000
--- a/src/packlib/fatmen/fmint/fmgeti.F
+++ /dev/null
@@ -1,36 +0,0 @@
-*
-* $Id: fmgeti.F,v 1.1.1.1 1996/03/07 15:18:14 mclareni Exp $
-*
-* $Log: fmgeti.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:14 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMGETI(LBANK,IVECT,IOFF,IRC)
-*
-* Routine to get an INTEGER from the bank at LBANK
-*
-#include "fatmen/fatbank.inc"
-#include "fatmen/fatpara.inc"
-#include "fatmen/fatusr.inc"
- IRC = 0
-*
-* Check that we are not outside the bank
-*
- IF(IOFF.LE.0.OR.IOFF.GT.NWDSFA) THEN
- IF(IDEBFA.GE.0) THEN
- PRINT *,'FMGETI. attempt to read outside bank boundaries'
- PRINT *,'FMGETI. IOFF = ',IOFF
- ENDIF
- IRC = 1
- RETURN
- ENDIF
-
- LADDR = LBANK+KOFUFA
- IF(LBANK.EQ.-1) LADDR = LADDBK + KOFUFA
-
- IVECT = IQ(LADDR+IOFF)
-
- END
-
diff --git a/src/packlib/fatmen/fmint/fmgetk.F b/src/packlib/fatmen/fmint/fmgetk.F
deleted file mode 100644
index 03cb1ee..0000000
--- a/src/packlib/fatmen/fmint/fmgetk.F
+++ /dev/null
@@ -1,81 +0,0 @@
-*
-* $Id: fmgetk.F,v 1.1.1.1 1996/03/07 15:18:12 mclareni Exp $
-*
-* $Log: fmgetk.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:12 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMGETK(GENAME,L,KEYS,IRC)
-#include "fatmen/faust.inc"
- CHARACTER*(*) GENAME
- CHARACTER*20 FNAME1,FNAME2
-#include "fatmen/fatbank.inc"
-#include "fatmen/fatpara.inc"
- PARAMETER (LKEYFA=10)
- DIMENSION KEYS(LKEYFA)
-
- NCH=LENOCC(GENAME)
- CALL CLTOU(GENAME)
-
- NFGETK = NFGETK + 1
-
- L = 0
- IRC = 0
-
- IF(IDEBFA.GE.2) THEN
- PRINT *,'FMGETK. enter for ',GENAME(1:NCH)
- CALL FMPKEY(KEYS,LKEYFA)
- ENDIF
-
- IF(NCH.LT.3.OR.GENAME(1:2).NE.'//'.OR.GENAME(NCH:NCH).EQ.'/')THEN
- IQUEST(1)=61
- GO TO 999
- ENDIF
-
- ICH=INDEXB(GENAME(1:NCH-1),'/')
- IF(ICH.LE.3.OR.NCH-ICH.GT.20) THEN
- IQUEST(1)=62
- GO TO 999
- ENDIF
-
- IF(LTDSFA.NE.0) THEN
- CALL MZDROP(IDIVFA,LTDSFA,'L')
- LTDSFA = 0
- ENDIF
-
- NWORDS = NKDSFA
- IFLAG = 1
- JBIAS = 1
-
- IF(KEYS(1).EQ.0) THEN
- IFLAG = 0
- CALL VZERO(KEYS,LKEYFA)
- ELSE
-*
-* Check if file name in keys vector matches that in generic name
-*
- FNAME1 = GENAME(ICH+1:NCH)
- LFN1 = NCH - ICH
- CALL UHTOC(KEYS(MKFNFA),4,FNAME2,(MKCLFA-MKFNFA)*4)
- LFN2 = LENOCC(FNAME2)
- IF(FNAME1(1:LFN1).NE.FNAME2(1:LFN2)) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMGETK. file name in ',
- + 'keys vector (',FNAME2(1:LFN2),') does not ',
- + 'match that in generic name (',FNAME1(1:LFN1),')'
- IQUEST(1) = -1
- GOTO 999
- ENDIF
- ENDIF
-
- CALL FMRZIN(GENAME(1:NCH),IDIVFA,LTDSFA,JBIAS,NWORDS,KEYS,IFLAG)
- L = LTDSFA
- 999 IRC = IQUEST(1)
-*
-* Return a zero bank address if not found
-*
- IF(IRC.NE.0) L=0
- RETURN
- END
-
diff --git a/src/packlib/fatmen/fmint/fmgetl.F b/src/packlib/fatmen/fmint/fmgetl.F
deleted file mode 100644
index a2f9ea4..0000000
--- a/src/packlib/fatmen/fmint/fmgetl.F
+++ /dev/null
@@ -1,98 +0,0 @@
-*
-* $Id: fmgetl.F,v 1.1.1.1 1996/03/07 15:18:14 mclareni Exp $
-*
-* $Log: fmgetl.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:14 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMGETL(GENAME,CHLINK,L,KEYS,CHOPT,IRC)
- CHARACTER*(*) GENAME,CHLINK
-*
-* As FMGETK, but with link handling
-*
- CHARACTER*20 FNAME1,FNAME2
-#include "fatmen/fatbank.inc"
-#include "fatmen/fatpara.inc"
-#include "fatmen/fmnkeys.inc"
- DIMENSION KEYS(LKEYFA)
-
- NCH=LENOCC(GENAME)
- CALL CLTOU(GENAME)
-
- L = 0
- IRC = 0
-
- IF(IDEBFA.GE.2) THEN
- PRINT *,'FMGETL. enter for ',GENAME(1:NCH)
- CALL FMPKEY(KEYS,LKEYFA)
- ENDIF
-
- IF(NCH.LT.3.OR.GENAME(1:2).NE.'//'.OR.GENAME(NCH:NCH).EQ.'/')THEN
- IQUEST(1)=61
- GO TO 999
- ENDIF
-
- ICH=INDEXB(GENAME(1:NCH-1),'/')
- IF(ICH.LE.3.OR.NCH-ICH.GT.20) THEN
- IQUEST(1)=62
- GO TO 999
- ENDIF
-
- IF(LTDSFA.NE.0) THEN
- CALL MZDROP(IDIVFA,LTDSFA,'L')
- LTDSFA = 0
- ENDIF
-
- NWORDS = NKDSFA
- IFLAG = 1
- JBIAS = 1
-
- IF(KEYS(1).EQ.0) THEN
- IFLAG = 0
- CALL VZERO(KEYS,LKEYFA)
- ELSE
-*
-* Check if file name in keys vector matches that in generic name
-*
- FNAME1 = GENAME(ICH+1:NCH)
- LFN1 = NCH - ICH
- CALL UHTOC(KEYS(MKFNFA),4,FNAME2,(MKCLFA-MKFNFA)*4)
- LFN2 = LENOCC(FNAME2)
- IF(FNAME1(1:LFN1).NE.FNAME2(1:LFN2)) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMGETL. file name in ',
- + 'keys vector (',FNAME2(1:LFN2),') does not ',
- + 'match that in generic name (',FNAME1(1:LFN1),')'
- IQUEST(1) = -1
- GOTO 999
- ENDIF
- ENDIF
-
- CALL FMRZIN(GENAME(1:NCH),IDIVFA,LTDSFA,JBIAS,NWORDS,KEYS,IFLAG)
- IF(IQUEST(1).NE.0) GOTO 999
- L = LTDSFA
-*
-* Is this entry a link?
-*
- IF(KEYS(MKLCFA).EQ.0) THEN
- CALL UHTOC(IQ(LTDSFA+KOFUFA+MFQNFA),4,CHLINK,NFQNFA)
- LCH = LENOCC(CHLINK)
- IF(IDEBFA.GE.0) PRINT *,'FMGETL. ',GENAME(1:NCH),
- + '--> ',CHLINK(1:LCH)
- NCH = LCH
- CALL MZDROP(IDIVFA,LTDSFA,'L')
- LTDSFA = 0
- CALL VZERO(KEYS,LKEYFA)
- CALL FMRZIN(CHLINK(1:NCH),IDIVFA,LTDSFA,JBIAS,NWORDS,KEYS,
- + IFLAG)
- IF(IQUEST(1).NE.0) GOTO 999
- ENDIF
- 999 IRC = IQUEST(1)
-*
-* Return a zero bank address if not found
-*
- IF(IRC.NE.0) L=0
- RETURN
- END
-
diff --git a/src/packlib/fatmen/fmint/fmgetv.F b/src/packlib/fatmen/fmint/fmgetv.F
deleted file mode 100644
index 221dad7..0000000
--- a/src/packlib/fatmen/fmint/fmgetv.F
+++ /dev/null
@@ -1,49 +0,0 @@
-*
-* $Id: fmgetv.F,v 1.1.1.1 1996/03/07 15:18:09 mclareni Exp $
-*
-* $Log: fmgetv.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:09 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMGETV(LBANK,IVECT,ISTART,NWORDS,IRC)
-*
-* Routine to get an INTEGER vector from the bank at LBANK
-*
- DIMENSION IVECT(NWORDS)
-#include "fatmen/fatbank.inc"
-#include "fatmen/fatpara.inc"
-#include "fatmen/fatusr.inc"
- JL = ISTART
- JR = ISTART + NWORDS - 1
- IRC = 0
-*
-* Check that JL:JR is a valid range
-*
- IF(JR.LT.JL) THEN
- IF(IDEBFA.GE.0) THEN
- PRINT *,'FMGETV. invalid range, end < start'
- PRINT *,'FMGETV. ISTART/IEND = ',JL,JR
- ENDIF
- IRC = 1
- RETURN
- ENDIF
-
-*
-* Check that we are not outside the bank
-*
- IF((JL.LE.0).OR.(JR.GT.NWDSFA)) THEN
- IF(IDEBFA.GE.0) THEN
- PRINT *,'FMGETV. attempt to read outside bank boundaries'
- PRINT *,'FMGETV. ISTART/IEND = ',JL,JR
- ENDIF
- IRC = 1
- RETURN
- ENDIF
-
- LADDR = LBANK+KOFUFA
- IF(LBANK.EQ.-1) LADDR = LADDBK + KOFUFA
-
- CALL UCOPY(IQ(LADDR+JL),IVECT,JR-JL+1)
- END
diff --git a/src/packlib/fatmen/fmint/fminit.F b/src/packlib/fatmen/fmint/fminit.F
deleted file mode 100644
index 50a3938..0000000
--- a/src/packlib/fatmen/fmint/fminit.F
+++ /dev/null
@@ -1,813 +0,0 @@
-*
-* $Id: fminit.F,v 1.9 2000/01/19 19:32:35 cernsoft Exp $
-*
-* $Log: fminit.F,v $
-* Revision 1.9 2000/01/19 19:32:35 cernsoft
-* Identify fatmen with y2k treatment
-*
-* Revision 1.8 1998/12/01 07:44:19 jamie
-* bug in debug printout for unimplemented features
-*
-* Revision 1.7 1996/08/01 11:10:05 jamie
-* Changes to support FMVERI On/Off
-*
-* Revision 1.6 1996/06/19 06:58:42 jamie
-* nunlun->numlun
-*
-* Revision 1.5 1996/04/12 07:55:47 cernlib
-* new handling of title string
-*
-* Revision 1.4 1996/03/29 11:29:56 jamie
-* qftitlch
-*
-* Revision 1.3 1996/03/29 10:56:05 jamie
-* print 'title' more like good-old patchy
-*
-* Revision 1.2 1996/03/28 10:28:57 jamie
-* update idatqq/itimqq and remove check on old version in fminit
-*
-* Revision 1.1.1.1 1996/03/07 15:18:10 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMINIT(IUSTOR,LNRZ,LNFZ,PATH,IRC)
-#if defined(CERNLIB_CZ)
- COMMON/CZSOCK/LUNCZ,IADTCP,LBUF,ISKIN,ISKOUT
-#endif
-#include "fatmen/fatveri.inc"
-#include "fatmen/faust.inc"
-#include "fatmen/fstate.inc"
-#include "fatmen/fatbank.inc"
-#include "fatmen/fatpara.inc"
-#include "fatmen/fatsys.inc"
-#include "fatmen/fatinfo.inc"
-#include "fatmen/fatsel.inc"
-#include "fatmen/fatout.inc"
-#include "fatmen/fatuwd.inc"
-#include "fatmen/fatkey.inc"
-#include "fatmen/fatloc.inc"
-#include "fatmen/fatcpl.inc"
-#include "fatmen/fatmtp.inc"
-#include "fatmen/fatlun.inc"
-#include "fatmen/fattyp.inc"
-#include "fatmen/slate.inc"
-#include "fatmen/farnge.inc"
-#include "fatmen/farstg.inc"
-#include "fatmen/fatupd.inc"
-#include "fatmen/fmdrep.inc"
-#if defined(CERNLIB_CERN)
- DIMENSION MTP(99)
-#endif
-#if !defined(CERNLIB_CRAY)
- PARAMETER (IQCHAW=4)
-#endif
-#if defined(CERNLIB_CRAY)
- PARAMETER (IQCHAW=8)
-#endif
-#if defined(CERNLIB_IBMMVS)
- CHARACTER*8 CHDD
- DIMENSION DDNAME(2)
- DIMENSION FATCAT(20)
-#endif
-#if defined(CERNLIB_IBMVM)
- CHARACTER*80 CHFILE
-#endif
-#if defined(CERNLIB_APOLLO)
-#include "fatmen/fatapol3.inc"
-#endif
-#if defined(CERNLIB_UNIX)
-#include "fatmen/fatclio.inc"
-#include "fatmen/fatmss.inc"
-#include "fatmen/fatget.inc"
-#if defined(CERNLIB_SHIFT)
-#include "fatmen/fatshift.inc"
-#endif
- CHARACTER*255 CHPATH,CHPROG
-#endif
- PARAMETER (ISLEEP=60)
- PARAMETER (MAXLEV=20)
- CHARACTER*(*) PATH
- CHARACTER*16 CHTOP
- CHARACTER*80 LINE
- CHARACTER*8 CHHOST,CHTYPE,CHSYS
- CHARACTER*255 CHTEMP
- INTEGER FMHOST
- SAVE NENTRY
-#include "fatmen/fatsat0.inc"
-#include "fatmen/fatmed.inc"
-#include "fatmen/fatsat1.inc"
- DATA NENTRY/0/
- IDATQQ = 991225
- ITIMQQ = 1200
-*
-* Set (FM)VERIfication on (0=off)
-*
- IFMVER = 1
-*
-* Get host information
-*
- IF(NENTRY.EQ.0) IC = FMHOST(CHHOST,CHTYPE,CHSYS)
-*
-* Allow reentry only if FMEND has been called
-*
- IF((MFPHAS.NE.3).AND.(NENTRY.NE.0)) THEN
- PRINT *,'FMINIT. Error - FATMEN has already been initialised'
- RETURN
- ENDIF
-*
-* Check on input parameters
-*
- IF(LNRZ.LE.0) THEN
- PRINT *,'FMINIT. invalid logical unit specified for ',
- + 'reading FATMEN RZ file - ',LNRZ
- CALL FMSTOP
- ENDIF
-
-
- LEND = LENOCC(PATH)
- IF(LEND.EQ.0) THEN
- PRINT *,'FMINIT. invalid FATMEN database specified'
- CALL FMSTOP
- ENDIF
-*
-* Zero counters
-*
- NFADDD = 0
- NFADDL = 0
- NFADDT = 0
- NFMDIR = 0
- NFRDIR = 0
- NFRLNK = 0
- NFRTRE = 0
- NFRMFL = 0
- NFCPFL = 0
- NFMVFL = 0
- NFMODI = 0
- NFTOUC = 0
- NFOPEN = 0
- NFCLOS = 0
- NFCOPY = 0
- NFCOPR = 0
- NFCOPQ = 0
- NFSREQ = 0
- NFQVOL = 0
- NFAVOL = 0
- NFASPC = 0
- NFPOOL = 0
- NFLOCK = 0
- NFULOK = 0
- NFDTAG = 0
- NFGTAG = 0
- NFSTAG = 0
- NFBANK = 0
- NFGET = 0
- NFGETK = 0
- NFSHOW = 0
- NFSCAN = 0
- NFLOOP = 0
- NFLDIR = 0
- NFLFIL = 0
- NFSORT = 0
- NFRANK = 0
- NFSELK = 0
- NFMTCH = 0
- FATMBR = 0.
- FATMBW = 0.
- FATMZR = 0.
- FATMZW = 0.
- FATMBC = 0.
- FATMBN = 0.
- FATMBQ = 0.
-
- CALL DATIME(NFSTAD,NFSTAT)
-
- LENV = 0
- NRETRY = 0
-*
-* Set range count to zero (for [mm:nn] ranges in LD etc.)
-*
- DO 10 I=1,MAXLEV
- NFRNGE(I) = 0
- 10 CONTINUE
-*
-* Clear user words
-*
- DO 30 I=1,2
- DO 20 J=1,10
- IFUSER(I,J) = -1
- 20 CONTINUE
- 30 CONTINUE
-*
-* Clear keys matrix and option
-*
- CHKEY = ' '
- NUMKEY = 0
-*
-*
-* Clear location code, copy level, media type and lun vectors
-*
- NUMLOC = 0
- NUMCPL = 0
- NUMMTP = 0
- NUMLUN = 0
-
- DO 40 I=1,KMXLOC
- MFMLOC(I) = -1
- 40 CONTINUE
-
- DO 50 I=1,KMXCPL
- MFMCPL(I) = -1
- 50 CONTINUE
-
- DO 60 I=1,KMXMTP
- MFMMTP(I) = -1
- 60 CONTINUE
-
- DO 70 I=1,KMXLUN
- MFMLUN(I) = -1
- MFMLUA(I) = -1
- 70 CONTINUE
-*
-* Set default media attributes
-*
- DO 80 I=1,NMEDIA
- MFMMED(I) = I
- 80 CONTINUE
-
- DO 90 I=1,NMTYP
- MEDSIZ(I) = -1
- 90 CONTINUE
-
- LUNRZ = LNRZ
- LUNFZ = LNFZ
-#if !defined(CERNLIB_IBMVM)
- LUNFZ = IABS(LNFZ)
-#endif
- LPRTFA = 6
- OUTPUT = 'TTY'
-*
-* Set default ranges of KEYS
-* Media type runs from disk to 3490
-*
- MRMTFA(1) = 1
- MRMTFA(2) = 6
-*
- MRCLFA(1) = -1
- MRCLFA(2) = -1
-*
- MRLCFA(1) = -1
- MRLCFA(2) = -1
-*
-* Set default updating parameters
-*
- LUFZFA = LNFZ
- CALL FMUPDT(MAX,NGROUP,-1,IRC)
-*
-* Set default times for stage server
-*
- IWTNET = 60
- IWTACK = 10
- IWTPND = 600
- IWTEXE = 120
-*
-* Maximum number of loops for network retries
-*
- MAXNET = 60
-*
-* Maximum number of loops for acknowledgement
-*
- MAXACK = 100
-*
-* Security
-*
- MAXVIO = 10
- NVIOL = 0
-*
-* Set number of updates
-*
- NUPDT = 0
-*
-* CHEOPS
-*
- LSRCST = 0
- LDSTST = 0
-*
-* Data representations
-*
- CHDREP(1) = 'IEEE fp, big endian, ascii'
- CHDREP(2) = 'IBM fp, big endian, ebcdic'
- CHDREP(3) = 'VAX fp, little endian, ascii'
- CHDREP(4) = 'IEEE fp, little endian, ascii'
- CHDREP(5) = 'CRAY fp, big endian, ascii'
-
- LPATH = 0
-#if defined(CERNLIB_APOLLO)||defined(CERNLIB_UNIX)
- CALL GETENVF('PATH',CHPATH)
- LPATH = IS(1)
-#endif
-
- IAPOL3 = 0
-#if defined(CERNLIB_APOLLO)
-*
-* Determine if we are in the L3 Apollo environment (L3STAGE)
-*
- IF(LPATH.GT.0) THEN
-*
-* Look for 'l3stage' in the current path
-*
- CALL WHICHF(CHPATH(1:LPATH),'l3stage',CHPROG)
- IAPOL3 = IS(1)
- IF(IDEBFA.GE.1.AND.IAPOL3.GT.0)
- + PRINT *,'FMINIT. l3stage found: ',CHPROG(1:IS(1))
- ENDIF
-
-#endif
- ICLIO = 0
-#if defined(CERNLIB_UNIX)
-*
-* Determine if we are have the VMSTAGE/CLIO interface
-*
- IF(LPATH.GT.0) THEN
-*
-* Look for 'vmstage' in the current path
-*
- CALL WHICHF(CHPATH(1:LPATH),'vmstage',CHPROG)
- ICLIO = IS(1)
- IF(IDEBFA.GE.1.AND.ICLIO.GT.0)
- + PRINT *,'FMINIT. vmstage found: ',CHPROG(1:IS(1))
- ENDIF
-
-#endif
- IFMMSS = 0
-#if defined(CERNLIB_UNIX)
-*
-* Determine if we are have the mssget/put interface
-*
- IF(LPATH.GT.0) THEN
-*
-* Look for 'mssget' in the current path
-*
- CALL WHICHF(CHPATH(1:LPATH),'mssget',CHPROG)
- IFMMSS = IS(1)
- IF(IDEBFA.GE.1.AND.IFMMSS.GT.0)
- + PRINT *,'FMINIT. mssget found: ',CHPROG(1:IS(1))
- ENDIF
-
-#endif
- ISFGET = 0
-#if defined(CERNLIB_UNIX)
-*
-* Determine if we should use "SFGET"
-*
- IF(LPATH.GT.0) THEN
-*
-* Look for 'sfget' in the current path
-*
- CALL WHICHF(CHPATH(1:LPATH),'sfget',CHPROG)
- ISFGET = IS(1)
- IF(IDEBFA.GE.1.AND.ISFGET.GT.0)
- + PRINT *,'FMINIT. sfget found: ',CHPROG(1:IS(1))
- ENDIF
-
-#endif
-
-#if defined(CERNLIB_SHIFT)
-*
-* Location of shift configuration file
-*
- CALL GETENVF('PATH_CONFIG',CHPATH)
- LPATH = IS(1)
-
- IF(LPATH.EQ.0) THEN
- SHCONF = '/etc/shift.conf'
- LSHCONF = 15
- TPCONF = '/etc/TPCONFIG'
- LTPCONF = 13
- ELSE
- SHCONF = CHPATH(1:LPATH) // '/etc/shift.conf'
- LSHCONF = LPATH + 17
- TPCONF = CHPATH(1:LPATH) // '/etc/TPCONFIG'
- LTPCONF = LPATH + 13
- ENDIF
-#endif
-
-*
-* For each media type (1,2,3,...) set
-* physical device type (disk, 3480, 3420,...) CHMTYP
-* generic device type (disk, ct1, tape,...) CHMGEN
-* capacity (MB) (?, 200, 150,...) CHMSIZ
-* density (?, 38K, 6250,...) CHMDEN
-* mount type (manual/robotic) CHMMNT
-* label type (SL/NL/AL) CHMLAB
-*
-#if defined(CERNLIB_FNAL)
-*
-* Include 8500s
-*
- MRMTFA(2) = 7
-*
-* Media definitions for FNAL...
-*
- MFMLAB(2) = 'AL'
- MFMLAB(3) = 'AL'
- MFMLAB(4) = 'AL'
- MFMLAB(5) = 'AL'
- MFMLAB(6) = 'AL'
- MFMLAB(7) = 'AL'
-
- MFMGEN(2) = 'CTR '
- MFMGEN(3) = '9TRK'
- MFMGEN(4) = '8200'
- MFMGEN(5) = '8500'
- MFMGEN(6) = '820R'
- MFMGEN(7) = '850R'
-
- MFMMNT(6) = 'R'
- MFMMNT(7) = 'R'
-
- MFMTYP(6) = '8200'
- MFMTYP(7) = '8200'
-
- MFMDEN(6) = '43200'
- MFMDEN(7) = '86400'
-
- NFTYPS = 7
-
-#endif
-#if defined(CERNLIB_VMTAPE)
-*
-* Generic names for VMTAPE...
-*
- MFMGEN(2) = '18TR'
- MFMGEN(3) = '9TR '
-#endif
-#if defined(CERNLIB_GSI)
-*
-* Generic names for GSI...
-*
- MFMGEN(1) = 'SYSDA'
- MFMGEN(2) = 'T3480'
- MFMGEN(3) = 'T6250'
-#endif
-#if defined(CERNLIB_NEWLIB)
-*
-* Generic names for DESY...
-*
- MFMGEN(1) = 'FAST'
-#endif
-#if defined(CERNLIB_IBMMVS)
- MFMDEN(3) = '4'
-#endif
-#if defined(CERNLIB_FPACK)
-*
-* Set default space allocation to zero
-*
- CALL FMSPAC(0,0,IRC)
-#endif
- CALL FMEDIA(MFMMED,MFMTYP,MFMGEN,MFMSIZ,MFMDEN,
- + MFMMNT,MFMLAB,NFTYPS,IRC)
-*
-* Set additional media attributes
-*
- DO 100 I=1,NMEDIA
-*
-* Maximum number of files
-*
- MEDMFL(I) = 999
-*
-* High water mark
-*
- MEDHWM(I) = MEDSIZ(I) - 20
-*
-* Maximum file size
-*
- MEDMFS(I) = MEDHWM(I)
- 100 CONTINUE
-*
-* Get name of server
-*
- LSTA = INDEXB(PATH,'/') + 1
- SERNAM = 'FM'//PATH(LSTA:LEND)
- CALL CLTOU(SERNAM)
- LSN = LENOCC(SERNAM)
- TOPDIR = PATH(1:LSTA-2)
- CHTOP = TOPDIR
- FATTOP = PATH(1:LEND)
-
- NENTRY = 1
-
- FATNOD = ' '
-
- CALL VZERO(IDEV,16)
-
- CALL FMLOGL(999)
- IF(IDEBFA.GE.0) THEN
- PRINT *
- PRINT *,'FMINIT. Initialisation of FATMEN package'
-#include "fatmen/qftitlch.inc"
- PRINT *,
- + FatmenTitleFortranString
- PRINT *,' This version created on ',IDATQQ,
- + ' at ',ITIMQQ
-#if defined(CERNLIB_CZ)
- PRINT *,' Compiled with Zebra Server switch'
-#endif
-*
-* Check creation date
-*
- CALL DATIME(ID,IT)
-
-* IF(ID.GT.IDATQQ+10000) THEN
-* PRINT *
-* PRINT *,'FMINIT. program is more than one year old'
-* PRINT *,'Please contact the CERN Program Librarian'//
-* + ' for a new version'
-* ENDIF
- ENDIF
-#if defined(CERNLIB_CZ)
- CALL CZOPEN('zserv','cernvm',ISTAT)
- IF (ISTAT .NE. 0) THEN
- IF(IDEBFA.GT.-3)
- + PRINT *,'Error starting remote server, code = ',ISTAT
- STOP
- ENDIF
- CALL CZPUTA('MESS : EXEC GIME '//SERNAM(1:LSN)
- +//' 191 F ',ISTAT)
- 110 CONTINUE
- CALL CZGETA(LINE,ISTAT)
- PRINT *,LINE(3:80)
- IF (LINE(1:1) .EQ. '2') GOTO 110
- CALL CZPUTA('MESS :FILE CERN.FATRZ.F',ISTAT)
- 120 CONTINUE
- CALL CZGETA(LINE,ISTAT)
- PRINT *,LINE(3:80)
- IF (LINE(1:1) .EQ. '2') GOTO 120
-#endif
-#if (defined(CERNLIB_IBMMVS))&&(!defined(CERNLIB_CSPACK))
-*
-* Get pathname from DDNAME
-*
- WRITE(CHDD,9001) LUNRZ
- 9001 FORMAT('FT',I2.2,'F001')
- CALL UCTOH(CHDD,DDNAME,4,8)
- CALL VBLANK(FATCAT,20)
- CALL FTINFO(DDNAME,-1,FATCAT,IRC)
- CALL UHTOC(FATCAT,4,DEFAULT,80)
- IF(IRC.EQ.0) THEN
- LDEF = INDEXB(DEFAULT,'.') -1
- LDEF = INDEXB(DEFAULT(1:LDEF),'.') -1
- DEFAULT(LDEF+1:) = ' '
- ELSE
- PRINT *,'FMINIT. ddname FATMEN not set. '
- PRINT *,' FATMEN catalogue will be inaccessible '
- IRC = 28
- RETURN
- ENDIF
-#endif
-#if (defined(CERNLIB_IBMMVS))&&(defined(CERNLIB_CSPACK))
-*
-* DEFAULT, FATNOD are hard-coded
-*
-#endif
-#if (defined(CERNLIB_IBMMVS))&&(defined(CERNLIB_CSPACK))&&(defined(CERNLIB_DSYIBM))
-*
-* Catalogue server is FATmen for HERa (father)
-*
- FATNOD = 'father'
- LFATND = 6
- DEFAULT = '/fatmen/'//SERNAM(1:LSN)
- LDEF = LSN + 8
-#endif
-#if (defined(CERNLIB_VAXVMS))&&(!defined(CERNLIB_CZ))
- IF(IDEBFA.GE.2) PRINT *,'FMINIT. getting value of symbol ',
- + SERNAM(1:LSN)
-#endif
-#if (defined(CERNLIB_UNIX))&&(!defined(CERNLIB_CZ))
- IF(IDEBFA.GE.2) PRINT *,'FMINIT. getting value of variable ',
- + SERNAM(1:LSN)
-#endif
-#if (defined(CERNLIB_UNIX)||defined(CERNLIB_VAXVMS))&&(!defined(CERNLIB_CZ))
- DEFAULT = ' '
- CALL GETENVF(SERNAM(1:LSN),DEFAULT)
- LDEF = IS(1)
- LENV = IS(1)
- IF(LDEF.EQ.0) THEN
-#endif
-#if (defined(CERNLIB_UNIX))&&(!defined(CERNLIB_CZ))
- PRINT *,'FMINIT. warning - environmental variable ',
-#endif
-#if (defined(CERNLIB_VAXVMS))&&(!defined(CERNLIB_CZ))
- PRINT *,'FMINIT. warning - symbol ',
-#endif
-#if (defined(CERNLIB_VAXVMS)||defined(CERNLIB_UNIX))&&(!defined(CERNLIB_CZ))
- + SERNAM(1:LSN),' not set. '
- PRINT *,' FATMEN catalogue will be inaccessible '
-#endif
-#if (defined(CERNLIB_VAXVMS)||defined(CERNLIB_UNIX))&&(!defined(CERNLIB_CZ))
- + ,'unless in current directory'
- CALL GETWDF(DEFAULT)
- LDEF = IS(1)
- ELSE
-*
-* Handle node:path case
-*
- ICOLON = INDEX(DEFAULT(1:LDEF),':')
- IF(ICOLON.NE.0) THEN
- IF(DEFAULT(ICOLON:ICOLON+1).NE.'::'.AND.
- + DEFAULT(ICOLON:ICOLON+1).NE.':[') THEN
-#endif
-#if (defined(CERNLIB_VAXVMS)||defined(CERNLIB_UNIX))&&(!defined(CERNLIB_CZ))&&(!defined(CERNLIB_CSPACK))
- WRITE(LPRTFA,9002) SERNAM(1:LSN),DEFAULT(1:LDEF)
- 9002 FORMAT(' FMINIT. ',A,' points to ',A)
- WRITE(LPRTFA,9003)
- 9003 FORMAT(' FMINIT. FATMEN has not been built with the CSPACK ',
- + 'option. Program stopped')
- STOP 16
-#endif
-#if (defined(CERNLIB_VAXVMS)||defined(CERNLIB_UNIX))&&(!defined(CERNLIB_CZ))&&(defined(CERNLIB_CSPACK))
- FATNOD = DEFAULT(1:ICOLON-1)
- LFATND = ICOLON - 1
- CHTEMP = DEFAULT(ICOLON+1:LDEF)
- DEFAULT = CHTEMP(1:LDEF-ICOLON)
- LDEF = LDEF - ICOLON
- IF(IDEBFA.GE.1) WRITE(LPRTFA,9004) SERNAM(1:LSN),
- + DEFAULT(1:LDEF),FATNOD(1:LFATND)
- 9004 FORMAT(' FMINIT. ',A,' points to directory ',A,' on node ',A)
- CALL XZINIT(LPRTFA,IDEBFA,LUNFZ,LUNFZ)
-#endif
-#if (defined(CERNLIB_VAXVMS)||defined(CERNLIB_UNIX))&&(!defined(CERNLIB_CZ))
- ENDIF
- ELSE
- IF(IDEBFA.GE.1) PRINT *,'FMINIT. ',SERNAM(1:LSN),
- + ' points to directory ',DEFAULT(1:LDEF)
- ENDIF
- ENDIF
-#endif
-#if (defined(CERNLIB_IBMVM))&&(!defined(CERNLIB_CZ))
-*
-* Link to disk of specified service machine
-*
- SERMOD = '?'
- CALL VMCMS('EXEC GIME '//SERNAM//
- +'(QUIET NONOTICE STACK)',IRC)
- IF (IRC .LE. 4) THEN
- CALL VMRTRM(LINE,LEN)
- SERMOD = LINE(1:1)
- IF(IDEBFA.GE.0)
- + PRINT *,'Linked to ',SERNAM,' mode ',SERMOD
- ELSEIF(IRC.EQ.104) THEN
- IF(IDEBFA.GT.-3)
- + PRINT *,'FMINIT. Invalid userid. Check call to FMINIT'
- NENTRY = 0
- RETURN
- ELSE
- IF(IDEBFA.GT.-3)
- + PRINT *,'FMINIT. Error code ',IRC,' from EXEC GIME',
- + ' type FIND GIME for a list of return codes'
- NENTRY = 0
- RETURN
- ENDIF
-
- CALL FMONIT('Init FATMEN')
-#endif
-
-#if !defined(CERNLIB_CSPACK)
-*
-* Check if the catalogue exists. If not, give the user
-* another chance.
-*
- 130 CONTINUE
- CALL FAEXST(IRC)
- IF(IRC.NE.0.AND.LENV.EQ.0) THEN
- PRINT *,'FMINIT. FATMEN catalogue does not exist. ',
- + 'Check call to FMINIT.'
- NENTRY = 0
- RETURN
- ELSEIF(IRC.NE.0.AND.LENV.NE.0) THEN
- NRETRY = NRETRY + 1
- IF(IDEBFA.GE.1) THEN
- IF(NRETRY.EQ.1) THEN
- WRITE(LPRTFA,9005) DEFAULT(1:LDEF),NRETRY,ISLEEP
- ELSE
- WRITE(LPRTFA,9006) NRETRY,ISLEEP
- ENDIF
- ENDIF
- 9005 FORMAT(' FMINIT. catalogue not found in ',A,'.',/,
- + ' Retry number ',I10,' in ',I3,' seconds')
- 9006 FORMAT(' FMINIT. Retry number ',I10,' in ',I3,' seconds')
- CALL SLEEPF(ISLEEP)
- GOTO 130
- ENDIF
-#endif
-*
-* Find place to write update files
-*
- LOCALQ = ' '
-#if defined(CERNLIB_VAXVMS)||defined(CERNLIB_UNIX)
-*
-* Write directly to server directly unless
-* access remote catalogue using CSPACK
-*
- IF(FATNOD.NE.' ') THEN
- CALL GETENVF('FATQUEUE',LOCALQ)
- ELSE
- LOCALQ = DEFAULT
- IS(1) = LDEF
- ENDIF
- IF(IS(1).EQ.0) THEN
-#endif
-#if defined(CERNLIB_UNIX)
- CALL GETENVF('HOME',LOCALQ)
- LOCALQ(IS(1)+1:) = '/'
-#endif
-#if defined(CERNLIB_VAXVMS)
- LOCALQ = 'SYS$LOGIN:'
-#endif
-#if defined(CERNLIB_VAXVMS)||defined(CERNLIB_UNIX)
- ELSE
-#endif
-#if defined(CERNLIB_VAXVMS)
- LOCALQ = DEFAULT(1:LDEF-1) // '.TODO' // DEFAULT(LDEF:LDEF)
-#endif
-#if defined(CERNLIB_UNIX)
- LOCALQ = DEFAULT(1:LDEF) // '/todo/'
-#endif
-#if defined(CERNLIB_VAXVMS)||defined(CERNLIB_UNIX)
- ENDIF
-#endif
-#if defined(CERNLIB_IBMVM)
- CALL MAXDSK(LOCALQ,NFREE,IRC)
-#endif
-#if defined(CERNLIB_IBMMVS)
- CALL KPREFI(LOCALQ,LQUEUE)
- LOCALQ(LQUEUE+1:) = '.FATMEN'
-#endif
-
- IF(MFPHAS.EQ.3) THEN
- IJSTOR = -1
- ELSE
- IJSTOR = IUSTOR
- ENDIF
-
- CALL FATINI(IJSTOR,LUNRZ,LUNFZ,CHTOP,' ')
- IRC=IQUEST(1)
-#if (defined(CERNLIB_IBMVM))&&(!defined(CERNLIB_CSPACK))
- IF(IRC.EQ.0) THEN
- INQUIRE(LUNRZ,NAME=CHFILE)
- LCH = LENOCC(CHFILE)
- LBL = INDEXB(CHFILE(1:LCH),' ') + 1
-*
-* Check that catalogue is on disk linked to by GIME
-*
- IF(CHFILE(LBL:LBL).NE.SERMOD) THEN
- IF(IDEBFA.GE.-3) THEN
- PRINT *,'FMINIT. !!!!!!!!!! warning - ',
- + 'using FATMEN catalogue ',CHFILE(2:LCH),
- + ' Disk mode returned by GIME = ',SERMOD
- ENDIF
- ENDIF
-*
-* Check mode - should be 6 = update in place
-*
- IF(CHFILE(LCH:LCH).NE.'6') THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMINIT. warning - ',
- + 'FATMEN catalogue is not mode 6. Mode = ',
- + CHFILE(LBL:LCH)
- IF(IDEBFA.GE.-3) PRINT *,
- + ' Updates may not be visible !!!'
- ENDIF
- ENDIF
-#endif
-#if defined(CERNLIB_CERN)
-*
-* Fill media type vector (for selection)
-* The order is:
-* DISK, 3490, 3480, 3420, 8200, 8500, DAT60, DAT90, DLT2
-* 1 , 6 , 2 , 3 , 4 , 5 , 7 , 8 , 12
-*
- NMTP = 9
- MTP(1) = 1
- MTP(2) = 6
- MTP(3) = 2
- MTP(4) = 3
- MTP(5) = 4
- MTP(6) = 5
- MTP(7) = 7
- MTP(8) = 8
- MTP(9) = 12
- CALL FMSETM(MTP,NMTP,ICODE)
-#endif
-*
-* Load location code definitions
-*
- CALL FMLOCC(IRCODE)
-*
-* and media type definitions
-*
- CALL FMMEDT(IRCODE)
-*
-* Set program phase
-*
- MFPHAS = 1
- END
diff --git a/src/packlib/fatmen/fmint/fmkdir.F b/src/packlib/fatmen/fmint/fmkdir.F
deleted file mode 100644
index d71a593..0000000
--- a/src/packlib/fatmen/fmint/fmkdir.F
+++ /dev/null
@@ -1,43 +0,0 @@
-*
-* $Id: fmkdir.F,v 1.2 1998/02/13 13:59:33 jamie Exp $
-*
-* $Log: fmkdir.F,v $
-* Revision 1.2 1998/02/13 13:59:33 jamie
-* set lbank to 0 - no bank involved
-*
-* Revision 1.1.1.1 1996/03/07 15:18:11 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMKDIR(GENAM,IRC)
-#include "fatmen/faust.inc"
-#include "zebra/quest.inc"
- CHARACTER*(*) GENAM
- CHARACTER*4 COMM
-#include "fatmen/fatbug.inc"
- PARAMETER (LKEYFA=10)
- DIMENSION KEYS(10)
-
- NFMDIR = NFMDIR + 1
-
- COMM = 'MDIR'
- LGN = LENOCC(GENAM)
- IRC = 0
- LBANK= 0
- CALL FMVERI(GENAM,LBANK,KEYS,'G',IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GT.-3) PRINT *,'FMKDIR. errors detected by FMVERI - '
- + ,'entry will not be added to catalogue'
- RETURN
- ENDIF
-
- CALL FMFZO(COMM,GENAM(1:LGN),0,KEYS,IRC)
-*
-* Check if this directory already exists
-*
- CALL FACDIR(GENAM(1:LGN),' ')
- IQUEST(12) = IQUEST(1)
-
- RETURN
- END
diff --git a/src/packlib/fatmen/fmint/fmlfil.F b/src/packlib/fatmen/fmint/fmlfil.F
deleted file mode 100644
index 0c952d8..0000000
--- a/src/packlib/fatmen/fmint/fmlfil.F
+++ /dev/null
@@ -1,171 +0,0 @@
-*
-* $Id: fmlfil.F,v 1.2 1996/04/02 22:42:57 thakulin Exp $
-*
-* $Log: fmlfil.F,v $
-* Revision 1.2 1996/04/02 22:42:57 thakulin
-* Workaround for an Apogee Fortran compiler bug.
-*
-* Revision 1.1.1.1 1996/03/07 15:18:12 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMLFIL(CHPATH,CHFILE,KEYS,NFOUND,MAXKEY,JCONT,IRC)
-#include "fatmen/faust.inc"
-#include "fatmen/fatbank.inc"
-#include "fatmen/fatpara.inc"
-#include "fatmen/fmnkeys.inc"
- PARAMETER (MAXDIR=500)
- PARAMETER (NMAX=100)
- CHARACTER*20 FNAME
- DIMENSION MYKEYS(LKEYFA,NMAX)
- DIMENSION KEYS(LKEYFA,MAXKEY)
- CHARACTER*255 CHDIR(MAXDIR),PATHO
- CHARACTER*(*) CHFILE(MAXKEY)
- CHARACTER*20 CHPATT
- CHARACTER*(*) CHPATH
- SAVE CHDIR,NDIRS,IFIRST,ILAST,NRET,ISTART
-
-#if defined(CERNLIB_QFAPOGEE)
-* workaround for a compiler bug in APOGEE F77 3.0/3.1 (12 Mar 96)
- INEG1 = -1
-#endif
- NFLFIL = NFLFIL + 1
-
- LCH = LENOCC(CHPATH)
- LPA = INDEXB(CHPATH(1:LCH),'/') - 1
- CHPATT = CHPATH(LPA+2:LCH)
- LCHP = LENOCC(CHPATT)
- IRC = 0
- NFOUND = 0
- NFILES = 0
- IF(IDEBFA.GE.2) PRINT *,'FMLFIL. enter for path/file = ',
- + CHPATH(1:LPA),',',CHPATT(1:LCHP),' JCONT = ',JCONT
- CALL FACDIR(PATHO,'R')
- IF(JCONT.NE.0) GOTO 20
- ICONT = 0
-*
-* Are there any wild-cards in directory name?
-*
- IWILD = ICFMUL('*%()<>',CHPATH,1,LPA)
- IF(IWILD.LE.LPA) THEN
- GOTO 10
- ELSE
- ISTART = 1
- NDIRS = 1
- IFIRST = 1
- ILAST = NMAX
- CHDIR(1) = CHPATH(1:LPA)
- GOTO 20
- ENDIF
-*
-* Get list of file names
-*
- 10 CONTINUE
- CALL FMLDIR(CHPATH(1:LPA),
- +CHDIR,NDIRS,MAXDIR,ICONT,IRC)
- IF(IDEBFA.GE.2) PRINT *,'FMLFIL. ',NDIRS,' directories found'
- IF((IRC.NE.0).AND.(IRC.NE.-1)) PRINT *,'FMLFIL. return code ',
- + IRC,' from FMLDIR'
- IF(IRC.EQ.-1) THEN
- ICONT = 1
- ELSE
- ICONT = 0
- ENDIF
-
- ISTART = 1
- IFIRST = 1
- ILAST = NMAX
-*
-* Branch here on re-entry on file names
-*
- 20 CONTINUE
- IF((IDEBFA.GE.2).AND.(JCONT.NE.0))
- + PRINT *,'FMLFIL. - reenter for directory ',
- + CHDIR(ISTART)
- JCONT = 0
- DO 60 I=ISTART,NDIRS
-*
-* Process next directory
-*
- LEND = LENOCC(CHDIR(I))
- CALL FACDIR(CHDIR(I)(1:LEND),' ')
- IF(IQUEST(1).NE.0) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMLFIL. error ',IQUEST(1),
- + ' setting directory ',CHDIR(I)(1:LEND)
- IRC = IQUEST(1)
- GOTO 70
- ENDIF
- IF(IDEBFA.GE.3) PRINT *,'FMLFIL. processing directory ',
- + CHDIR(I)(1:LEND)
-
- 30 CONTINUE
- CALL FMKEYS(LKEYFA,NMAX,IFIRST,ILAST,MYKEYS,NFILES,IRET)
- NKEYS = IQUEST(11)
- IF(IDEBFA.GE.2) PRINT *,'FMLFIL. ',NKEYS,' files found in ',
- + CHDIR(I)(1:LEND)
- IF(IQUEST(1) .NE. 0) THEN
- IF(IDEBFA.GE.2) PRINT *,'FMLFIL. More than ',NMAX,' files '
- + //'in ',CHDIR(I)(1:LEND)
- IF(IDEBFA.GE.2) PRINT *,'FMLFIL. IQUEST(11-12) = ',
- + IQUEST(11),IQUEST(12)
- ENDIF
-*
-* Process all keys returned and move those that match to KEYS
-*
- NRET = IQUEST(13)
- IF(NRET.EQ.0) GOTO 60
- 40 CONTINUE
- DO 50 J=1,NRET
- CALL UHTOC(MYKEYS(2,J),4,FNAME,(MKCLFA-MKFNFA)*4)
- LF = LENOCC(FNAME)
- CALL FMATCH(FNAME(1:LF),CHPATT(1:LCHP),IMAT)
- IF(IMAT.EQ.0) THEN
- IF(NFOUND.GE.MAXKEY) THEN
-#if defined(CERNLIB_QFAPOGEE)
- IRC = INEG1
-#else
- IRC = -1
-#endif
- JCONT = 1
- IFIRST = IFIRST + J -1
- ISTART = I
- IF(IDEBFA.GE.3) THEN
- PRINT *,'FMLFIL. cannot accept any more files. ',
- + 'Last file accepted:'
- PRINT *,CHFILE(NFOUND)(1:LENOCC(CHFILE(NFOUND)))
- PRINT *,'Current file/directory:'
- PRINT *,FNAME(1:LF),' - ',CHDIR(I)(1:LEND)
- PRINT *,'First file to be retrieved in next ',
- + 'batch = ',IFIRST,' start directory = ',
- + ISTART
- ENDIF
- ILAST = MIN(NKEYS,IFIRST+NMAX-1)
- GOTO 70
- ELSE
- NFOUND = NFOUND + 1
- CHFILE(NFOUND) = CHDIR(I)(1:LEND)//'/'//FNAME
- CALL UCOPY(MYKEYS(1,J),KEYS(1,NFOUND),LKEYFA)
- ENDIF
- ENDIF
-
- 50 CONTINUE
- IF(ILAST.LT.NKEYS) THEN
- IFIRST = IFIRST + NMAX
- ILAST = MIN(NKEYS,ILAST+NMAX)
- GOTO 30
- ENDIF
-*-
- IFIRST = 1
- ILAST = NMAX
- 60 CONTINUE
- IF(ICONT.NE.0) GOTO 10
-
- 70 CONTINUE
- LPATHO = LENOCC(PATHO)
- CALL FACDIR(PATHO(1:LPATHO),' ')
- IF(IQUEST(1).NE.0) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMLFIL. error ',
- + 'resetting directory to ',PATHO(1:LPATHO)
- ENDIF
- END
diff --git a/src/packlib/fatmen/fmint/fmln.F b/src/packlib/fatmen/fmint/fmln.F
deleted file mode 100644
index 6518325..0000000
--- a/src/packlib/fatmen/fmint/fmln.F
+++ /dev/null
@@ -1,122 +0,0 @@
-*
-* $Id: fmln.F,v 1.1.1.1 1996/03/07 15:18:13 mclareni Exp $
-*
-* $Log: fmln.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:13 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMLN(CHSRCE,CHTRGT,CHCOMM,IVECT,CHOPT,IRC)
-*
-* Make a link to an existing entry. If the existing entry
-* is itself a link, the link points to the target of that
-* link.
-*
-#include "fatmen/faust.inc"
- CHARACTER*(*) CHSRCE,CHTRGT
- CHARACTER*(*) CHCOMM
- CHARACTER*255 CHFILE
- DIMENSION IVECT(10)
-#include "fatmen/fmnkeys.inc"
- DIMENSION KEYS(LKEYFA),KEYSIN(LKEYFA),KEYSOU(LKEYFA)
- PARAMETER (MAXCOP=1)
- PARAMETER (JBIAS=2)
-#include "fatmen/fatpara.inc"
-#include "fatmen/fatbank.inc"
-#include "fatmen/fatopts.inc"
-
- NFADDL = NFADDL + 1
- IRC = 0
- LSRCE = LENOCC(CHSRCE)
- LTRGT = LENOCC(CHTRGT)
- LCOMM = LENOCC(CHCOMM)
-
- IF(IOPTC.NE.0.AND.LCOMM.EQ.0) THEN
- CHCOMM = ' '
- LCOMM = 80
- ENDIF
-
- IF(IDEBFA.GE.1) PRINT *,'FMLN. source: ',CHSRCE(1:LSRCE),
- + ' target: ',CHTRGT(1:LTRGT)
-*
-* Check if target file already exists
-* (A link must differ from an existing generic name)
-*
- CALL FMEXST(CHTRGT(1:LTRGT),IRC)
- IF(IRC.NE.0) THEN
- IF(IOPTF.EQ.0) THEN
- IF(IDEBFA.GE.-1) WRITE(LPRTFA,9001) IRC
- 9001 FORMAT(' FMLN. ',I6,' entries already exist. Link refused')
- ELSE
- IF(IDEBFA.GE.-1) WRITE(LPRTFA,9002) IRC
- 9002 FORMAT(' FMLN. adding link even though ',I6,
- + ' entries already exist.')
- ENDIF
- ENDIF
-*
-* Check if source and target are the same
-*
- IF(CHSRCE(1:LSRCE).EQ.CHTRGT(1:LTRGT)) THEN
- IRC = -1
- IF(IDEBFA.GE.-3) PRINT *,'FMLN. error - source and target ',
- + 'are the same'
- GOTO 999
- ENDIF
-*
-* Check if source file is a link
-* (location code 0 = link)
-*
- KEYSIN(MKSRFA) = -1
- KEYSIN(MKMTFA) = -1
- KEYSIN(MKLCFA) = 0
- KEYSIN(MKCLFA) = -1
- CALL FMSELK(CHSRCE(1:LSRCE),KEYSIN,KEYSOU,NFOUND,MAXCOP,IRC)
-*
-* Did we find a link?
-*
- IF(NFOUND.NE.0) THEN
- CALL FMGETK(CHSRCE(1:LSRCE),LTDSFA,KEYSOU,IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMLN. error ',IRC,
- + ' from FMGETK for ',CHSRCE(1:LSRCE)
- GOTO 999
- ENDIF
-*
-* Get target of existing link
-*
- CALL UHTOC(IQ(LTDSFA+KOFUFA+MFQNFA),4,CHFILE,NFQNFA)
- LFILE = LENOCC(CHFILE)
- CALL MZDROP(IDIVFA,LTDSFA,' ')
- LTDSFA = 0
- ELSE
- CHFILE = CHSRCE(1:LSRCE)
- LFILE = LSRCE
- ENDIF
-*
-* Now lift bank for new entry
-*
- CALL FMBOOK(CHTRGT(1:LTRGT),KEYS,LTDSFA,LSUP,JBIAS,IRC)
- KEYS(MKLCFA) = 0
- IQ(LTDSFA+KOFUFA+MLOCFA) = 0
- CALL FMPUTC(LTDSFA,CHFILE,MFQNFA,LFILE,IRC)
- IF(IRC.NE.0) GOTO 999
-*
-* Update comment and user words if requested
-*
- IF(IOPTC.NE.0.AND.LCOMM.GT.0) THEN
- CALL FMPUTC(LTDSFA,CHCOMM,MUCMFA,LCOMM,IRC)
- IF(IRC.NE.0) GOTO 999
- ENDIF
-
- IF(IOPTU.NE.0) THEN
- CALL UCOPY(IVECT,IQ(LTDSFA+KOFUFA+MUSWFA),10)
- ENDIF
-*
-* Now add the entry
-*
- CALL FMPUT(CHTRGT(1:LTRGT),LTDSFA,IRC)
- CALL MZDROP(IDIVFA,LTDSFA,' ')
- LTDSFA = 0
-
- 999 END
diff --git a/src/packlib/fatmen/fmint/fmls.F b/src/packlib/fatmen/fmint/fmls.F
deleted file mode 100644
index 4bb3969..0000000
--- a/src/packlib/fatmen/fmint/fmls.F
+++ /dev/null
@@ -1,70 +0,0 @@
-*
-* $Id: fmls.F,v 1.1.1.1 1996/03/07 15:18:09 mclareni Exp $
-*
-* $Log: fmls.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:09 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMLS(PATH,CHOPT,IRC)
- CHARACTER*(*) CHOPT,PATH
- CHARACTER*255 CHPATH
-#include "fatmen/fatpara.inc"
-#include "fatmen/fatloc.inc"
-#include "fatmen/fatmtp.inc"
-#include "fatmen/fatcpl.inc"
-#include "fatmen/fatsys.inc"
-#include "fatmen/fatout.inc"
-#include "fatmen/fatsho.inc"
- DIMENSION JOPT(36)
-#include "fatmen/fatbank.inc"
- EXTERNAL FALS
-#include "fatmen/falscm.inc"
-*
- LWRITE = LPRTFA
-
- NFILES = 0
- NDIRT = 0
- NFILT = 0
-
- CWDSHO = ' '
-
- LCHOPT = LENOCC(CHOPT)
- LPATH = LENOCC(PATH)
-
- IF(LCHOPT.EQ.0) THEN
- CHOPT = ' '
- LCHOPT = 1
- ENDIF
-
- CALL FMOPTC(CHOPT,ALFNUM,JOPT)
- CALL UCOPY(JOPT,IOPT,36)
-
- NFILES = 0
-*
-* Look for some files and show the bank and key content:
-*
- LSLASH = INDEXB(PATH(1:LPATH),'/')
- CHPATH = PATH(1:LSLASH-1)
- CHFILE = PATH(LSLASH+1:LPATH)
- LP = LENOCC(CHPATH)
- LF = LENOCC(CHFILE)
-
- CALL CLTOU(CHPATH(1:LP))
- CALL CLTOU(CHFILE(1:LF))
-
- IF(IDEBFA.GE.2) PRINT *,'FMLS. enter for ',PATH(1:LPATH),
- + ',',CHOPT
-*
- IF(ICFMUL('*%(<>',CHPATH,1,LP).GT.LP) THEN
- CALL FACDIR(CHPATH(1:LP),' ')
- CALL FALS(CHPATH(1:LP),IRC)
- ELSE
- CALL FMSCAN(CHPATH(1:LP),99,FALS,IRC)
- ENDIF
-
- IQUEST(11) = NFILT
- IQUEST(12) = NDIRT
-
- END
diff --git a/src/packlib/fatmen/fmint/fmmake.F b/src/packlib/fatmen/fmint/fmmake.F
deleted file mode 100644
index 648d462..0000000
--- a/src/packlib/fatmen/fmint/fmmake.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: fmmake.F,v 1.1.1.1 1996/03/07 15:18:11 mclareni Exp $
-*
-* $Log: fmmake.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:11 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMMAKE(GENAME,CHLUN,LENTRY,IRC)
-*
-* New FMMAKE - just interface to FMOPEN
-*
-#include "fatmen/fatbug.inc"
- CHARACTER*(*) GENAME,CHLUN
- CHARACTER*4 CHOPT
-
- IRC = 0
- LGN = LENOCC(GENAME)
-
- IF(IDEBFA.GE.2) PRINT *,'FMMAKE. enter for ',
- + GENAME(1:LGN),' ',CHLUN,' LBANK = ',LENTRY
-
- CHOPT = 'WU'
-
- CALL FMOPEN(GENAME(1:LGN),CHLUN,LENTRY,CHOPT,IRC)
-
- END
diff --git a/src/packlib/fatmen/fmint/fmmod.F b/src/packlib/fatmen/fmint/fmmod.F
deleted file mode 100644
index b3ca9de..0000000
--- a/src/packlib/fatmen/fmint/fmmod.F
+++ /dev/null
@@ -1,53 +0,0 @@
-*
-* $Id: fmmod.F,v 1.1.1.1 1996/03/07 15:18:10 mclareni Exp $
-*
-* $Log: fmmod.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:10 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMMOD(GENAME,LENTRY,IFLAG,IRC)
- CHARACTER*(*) GENAME
- CHARACTER*4 COMM
- PARAMETER (LKEYFA=10)
- DIMENSION KEYS(LKEYFA)
- DIMENSION LENTRY(1)
-#include "fatmen/fatbank.inc"
-#include "fatmen/fatpara.inc"
-*
-* Add entry to catalogue, as FMPUT but
-* IF IFLAG = 0, replace entry, add if non-existant
-* IFLAG = 1, replace entry, error if non-existant
-* Checks are performed by the server and hence IRC
-* does not indicate that the action has been taken.
-*
- IRC = 0
- COMM='MOD '
- IF(IFLAG.EQ.1) COMM='REP '
- LGN = LENOCC(GENAME)
- IF(IDEBFA.GE.1) WRITE(LPRTFA,9001) COMM,GENAME(1:LGN)
-9001 FORMAT(' FMMOD. ',A4,1X,A)
-*
-* Fill KEYS vector for call to FMVERI
-*
- LPATH = INDEXB(GENAME(1:LGN),'/')
- CALL VBLANK(KEYS(2),5)
- CALL UCTOH(GENAME(LPATH+1:LGN),KEYS(2),4,LGN-LPATH)
- KEYS(MKSRFA) = 0
- KEYS(MKCLFA) = IQ(LENTRY(1)+KOFUFA+MCPLFA)
- KEYS(MKLCFA) = IQ(LENTRY(1)+KOFUFA+MLOCFA)
- KEYS(MKMTFA) = IQ(LENTRY(1)+KOFUFA+MMTPFA)
- KEYS(MKNBFA) = MKNBFA
-
- CALL FMVERI(GENAME,LENTRY(1),KEYS,'A',IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GT.-3) PRINT *,'FMMOD. errors detected by FMVERI - ',
- + 'entry will not be added to catalogue'
- RETURN
- ENDIF
-
- CALL FMFZO(COMM,GENAME,LENTRY(1),KEYS,IRC)
-
- END
-
diff --git a/src/packlib/fatmen/fmint/fmmodu.F b/src/packlib/fatmen/fmint/fmmodu.F
deleted file mode 100644
index 13d48e3..0000000
--- a/src/packlib/fatmen/fmint/fmmodu.F
+++ /dev/null
@@ -1,59 +0,0 @@
-*
-* $Id: fmmodu.F,v 1.1.1.1 1996/03/07 15:18:12 mclareni Exp $
-*
-* $Log: fmmodu.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:12 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMMODU(PATH,UFORM,IVECT,UCOMM,CHOPT,IRC)
- CHARACTER*(*) CHOPT,PATH,UFORM,UCOMM
- DIMENSION IVECT(10)
- CHARACTER*255 CHPATH
-#include "fatmen/fatpara.inc"
-#include "fatmen/fatsys.inc"
- DIMENSION JOPT(36)
-#include "fatmen/fatbank.inc"
- EXTERNAL FAMODU
-#include "fatmen/famucm.inc"
-*
- LCHOPT = LENOCC(CHOPT)
- LPATH = LENOCC(PATH)
-
- IF(LCHOPT.EQ.0) THEN
- CHOPT = ' '
- LCHOPT = 1
- ENDIF
-
- CALL FMOPTC(CHOPT,ALFNUM,JOPT)
- CALL UCOPY(JOPT,IOPT,36)
-*
- IF(IOPTC+IOPTF+IOPTV.EQ.0) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMMODU. error - please specify',
- + ' at least one of the options C,F,V'
- IRC = -1
- RETURN
- ENDIF
-
- IF(IOPTF.NE.0) CHUFRM = UFORM(1:LENOCC(UFORM))
- IF(IOPTV.NE.0) CALL UCOPY(IVECT,IWORDS,NUSWFA)
- IF(IOPTC.NE.0) CHUCOM = UCOMM(1:LENOCC(UCOMM))
-*
- LSLASH = INDEXB(PATH(1:LPATH),'/')
- CHPATH = PATH(1:LSLASH-1)
- CHFILE = PATH(LSLASH+1:LPATH)
- LP = LENOCC(CHPATH)
- LF = LENOCC(CHFILE)
-
- IF(IDEBFA.GE.2) PRINT *,'FMMODU. enter for ',PATH(1:LPATH),
- + ',',CHOPT
-*
- IF(ICFMUL('*%(<>',CHPATH,1,LP).GT.LP) THEN
- CALL FACDIR(CHPATH(1:LP),' ')
- CALL FAMODU(CHPATH(1:LP),IRC)
- ELSE
- CALL FMSCAN(CHPATH(1:LP),99,FAMODU,IRC)
- ENDIF
-
- END
diff --git a/src/packlib/fatmen/fmint/fmmv.F b/src/packlib/fatmen/fmint/fmmv.F
deleted file mode 100644
index 6725e45..0000000
--- a/src/packlib/fatmen/fmint/fmmv.F
+++ /dev/null
@@ -1,35 +0,0 @@
-*
-* $Id: fmmv.F,v 1.1.1.1 1996/03/07 15:18:11 mclareni Exp $
-*
-* $Log: fmmv.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:11 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMMV(GENAMA,GENAMB,IRC)
- CHARACTER*(*) GENAMA,GENAMB
- PARAMETER (LKEYFA=10)
- DIMENSION KEYS(LKEYFA)
-#include "fatmen/faust.inc"
-#include "fatmen/fatupd.inc"
-#include "fatmen/fatbank.inc"
-*
-* Check that we have enough update tokens left
-*
- IF(MAXUPD-NUPDT.LT.2) THEN
- IF(IDEBFA.GE.0) PRINT 9001,NUPDT,MAXUPD
-9001 FORMAT(' FMMVC. A "mv" operation requires two updates'/,
- + ' You have made ',I10,' updates out of ',I10,
- + ' maximum')
- RETURN
- ENDIF
-
- CALL FMGET(GENAMA,LTDSFA,KEYS,IRC)
- IF(IRC.EQ.0) THEN
- CALL FMRM(GENAMA,LTDSFA,KEYS,JRC)
- CALL FMPUT(GENAMB,LTDSFA,JRC)
- NFMVFL = NFMVFL + 1
- ENDIF
- END
-
diff --git a/src/packlib/fatmen/fmint/fmopen.F b/src/packlib/fatmen/fmint/fmopen.F
deleted file mode 100644
index fe9470d..0000000
--- a/src/packlib/fatmen/fmint/fmopen.F
+++ /dev/null
@@ -1,1072 +0,0 @@
-*
-* $Id: fmopen.F,v 1.1.1.1 1996/03/07 15:18:12 mclareni Exp $
-*
-* $Log: fmopen.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:12 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMOPEN(GNAME,CHLUN,LENTRY,CHOPT,IRC)
-*
-*
-* Return codes: 1-10 : FMOPEN (to be implemented)
-* 11-20 : FMDISK
-* 21-30 : FMTAPE
-* 31-40 : FMFPAK
-* Information: -1 : invalid option in CHOPT ignored
-*
-* Options:
-*
-* a - append
-* b - *free*
-* c - concatenate (for M)
-* D - make duplicate into robot
-* E - when used with T, issue SETUP END
-* F - issue FZFILE or FPARM as appropriate
-* g - *free* >>> Use to select G option for SHIFT ???
-* H - stage wHole tape
-* I - deselect -G option for SHIFT s/w
-* j - *free*
-* K - KEEP option on STAGE OUT
-* L - override tape label information with DCB from catalogue
-* m - multi-file?
-* N - don't use DSN on STAGE
-* O - override size with IQUEST(11)
-* P - autoput on STAGE OUT
-* Q - queue stage request (nowait)
-* R - read
-* S - update catalogue with size returned from STAGE IN
-* T - use tape directly (i.e. not stage)
-* U - user will issue open
-* V - as S, but even if file size is non-zero
-* W - write
-* Y - write stage command into file on unit FORLUN, but do not execute
-* X - D/A
-* Z - issue RZFILE
-*
- CHARACTER*(*) GNAME,CHLUN
- CHARACTER*255 GENAM
-#include "fatmen/faust.inc"
-#include "fatmen/fattyp.inc"
-#include "fatmen/fatmon.inc"
-#include "fatmen/fatbank.inc"
-#include "fatmen/fatapol3.inc"
-#include "fatmen/fatpara.inc"
-#include "fatmen/fatstg.inc"
-#include "fatmen/fatinfo.inc"
-#include "zebra/zmach.inc"
-#include "fatmen/slate.inc"
- PARAMETER (LKEYFA=10)
- DIMENSION KEYS(LKEYFA)
-#if defined(CERNLIB_SHIFT)
-#include "fatmen/fmshft.inc"
-#endif
-#if defined(CERNLIB_VAXVMS)
- CHARACTER*16 RECTYP
-#endif
-#if defined(CERNLIB_IBMMVS)
-#include "fatmen/fatdcb.inc"
-#endif
- CHARACTER*8 MODEL
- CHARACTER*9 CHACT
- CHARACTER*8 CHSTAT
- CHARACTER*12 CHFRMT
- CHARACTER*256 DSN
- CHARACTER*255 CHFILE
- CHARACTER*2 MODE
- CHARACTER*4 CFMODE
- CHARACTER*8 FORLUN
- CHARACTER*4 CHFORM,CHTEMP
- CHARACTER*4 FZOPT,RZOPT,SHOPT
- CHARACTER*1 VMOPT
- CHARACTER*40 DCB
- CHARACTER*20 FNAME
- CHARACTER*4 RECFM1
- CHARACTER*4 RECFM
- CHARACTER*8 DDNAME
- CHARACTER*12 CHDIR
- LOGICAL IEXIST,IVMIO
-#if defined(CERNLIB_VAXVMS)
- EXTERNAL FMCFIO
-#endif
-#if defined(CERNLIB_IBMVM)
- EXTERNAL FMVMIO
-#endif
-#if defined(CERNLIB_SHIFT)
- EXTERNAL FMXYIO
-#endif
-#if defined(CERNLIB_CSPACK)
- CHARACTER*8 KOPT
- CHARACTER*8 CHHOST
- EXTERNAL FMXZIO
- LOGICAL ICSPAK
-#endif
-* DIMENSION LENTRY(1)
- INTEGER FMJDAT
-#include "fatmen/fatopts.inc"
-
- NCH = LENOCC(GNAME)
- GENAM = GNAME(1:NCH)
- CALL CLTOU(GENAM)
- IRC = 0
- INFO = 0
-
-#if defined(CERNLIB_IBMVM)
- CALL FMONIT('FMOPEN. '//GENAM(1:NCH)//' CHOPT '//CHOPT)
-#endif
-#if !defined(CERNLIB_APOLLO)
- IAPOL3 = 0
-#endif
-*
-* Monitoring information
-*
- NFOPEN = NFOPEN + 1
- IHOWFA = 0
- ITIMFA = 0
- CHFNFA = ' '
-*
-* Check options
-*
- CALL FMCHOP('FMOPEN',CHOPT,'CDEFHIKLMONPQRSTUVWXYZ',IC)
- IF(IC.NE.0) INFO = -1
-*
-* Default is read
-*
- IF(IOPTR.EQ.0.AND.IOPTW.EQ.0) IOPTR = 1
-
-*
-* Take file size from IQUEST vector, if option O is specified
-*
- ISIZSG = 0
- IF(IOPTO.NE.0) ISIZSG = IQUEST(11)
-*
-* FZ I/O options
-*
- ICFOP = 0
- IF(IOPTF.NE.0) ICFOP = IQUEST(10)
-
- CALL DATIME(ID,IT)
- IDATE = FMJDAT(IS(1),IS(2),IS(3))
- ISECS = (IS(4)*60 + IS(5))*60 + IS(6)
-
- LCH = LENOCC(CHOPT)
-
- IF (LENTRY .EQ. 0) THEN
- IF(IDEBFA.GE.1) WRITE(LPRTFA,9001) GENAM(1:NCH),CHOPT(1:LCH),
- + ID,IT,IS(6)
- 9001 FORMAT(' FMOPEN. enter for ',A,/,' options: ',A,' at ',
- + I6.6,1X,I4.4,I2.2)
- CALL FMGET(GENAM,LENTRY,KEYS,IRC)
- IF (IRC.NE.0) GOTO 999
- ELSE
- IF(IDEBFA.GE.1) WRITE(LPRTFA,9002) GENAM(1:NCH),LENTRY,
- + CHOPT(1:LCH),ID,IT,IS(6)
- 9002 FORMAT(' FMOPEN. enter for ',A,/,' using user supplied bank at ',
- + I8,' options: ',A,' at ',I6.6,1X,I4.4,I2.2)
-*
-* Update keys from bank
-*
- CALL FMUPKY(GENAM(1:NCH),LENTRY,KEYS,IRC)
- ENDIF
-*
-* Is this entry a link?
-*
- IF(KEYS(MKLCFA).EQ.0) THEN
- CALL UHTOC(IQ(LENTRY+KOFUFA+MFQNFA),4,GENAM,NFQNFA)
- LGN = LENOCC(GENAM)
- IF(IDEBFA.GE.0) WRITE(LPRTFA,9003) GNAME(1:NCH),GENAM(1:LGN)
- 9003 FORMAT(' FMOPEN. ',A,' --> ',A)
- NCH = LGN
- CALL VZERO(KEYS,LKEYFA)
- CALL FMGET(GENAM,L,KEYS,IRC)
- IF (IRC.NE.0) GOTO 999
- ELSE
- L = LENTRY
- ENDIF
-*
-* MB read/written
-*
- IF(IQ(L+KOFUFA+MFSZFA).EQ.0) THEN
- IF(IOPTR.NE.0) THEN
- FATMBR = FATMBR + IQ(L+KOFUFA+MFSZFA)
- ELSEIF(IOPTW.NE.0) THEN
- FATMBW = FATMBW + IQ(L+KOFUFA+MFSZFA)
- ENDIF
- ENDIF
-*
-* FATMEN file format (for call to FZFILE,RZFILE)
-*
- CALL UHTOC(IQ(L+KOFUFA+MFLFFA),4,CHFORM,4)
- ISIZE = 0
-*
-* Get LUN
-*
- LUN = 0
- LCHLUN = LENOCC(CHLUN)
-
- IF(CHLUN(1:LCHLUN).EQ.'NOWAIT') IOPTQ = 1
-
- IF (LCHLUN.EQ.1) THEN
- READ(CHLUN,'(I1)') LUN
- ELSEIF(LCHLUN.EQ.2) THEN
- READ(CHLUN,'(I2)') LUN
- ENDIF
-
-*
-* Get LUN from CHLUN (DDNAME) if necessary
-*
- IF(LUN.EQ.0) CALL FMDD2L(CHLUN(1:LCHLUN),LUN,IRC)
-
-*
-* New Zebra uses FORTRAN I/O as default...
-*
- LFORM = LENOCC(CHFORM)
-
-#if !defined(CERNLIB_IBMVM)
- IF((CHFORM(1:2).EQ.'FX').AND.(ICFOP.LE.1)) THEN
-#endif
-#if defined(CERNLIB_IBMVM)
- IF((CHFORM(1:2).EQ.'FX').AND.(ICFOP.NE.1).AND.(ICFOP.NE.3)) THEN
-#endif
- CHTEMP = CHFORM
- CHFORM = 'F'//CHTEMP(1:LFORM)
- ENDIF
-
-#if defined(CERNLIB_FPACK)
- IF(INDEX(CHFORM,'FP').NE.0) THEN
-
- CALL FMFPAK(GENAM(1:NCH),LENTRY,KEYS,CHLUN,CHOPT,IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.-3) WRITE(LPRTFA,9004) IRC
- 9004 FORMAT(' FMOPEN. return code ',I6,' from FMFPAK')
- GOTO 999
- ENDIF
-
- ELSE
-#endif
-*
-* Media dependant handling
-*
- IF(KEYS(MKMTFA).EQ.1) THEN
-
- IF(IOPTQ.NE.0) THEN
-* IOPTQ = 0
-* IF(IDEBFA.GE.0) WRITE(LPRTFA,9005)
-*9005 FORMAT(' FMOPEN. option Q ignored for disk files')
-*
-* NOWAIT option - update use count and return as for tapes
-*
- IF(IDEBFA.GE.1) WRITE(LPRTFA,9005)
- 9005 FORMAT(' FMOPEN. option Q for disk files = just return')
- GOTO 10
- ENDIF
-
- CALL FMDISK(GENAM(1:NCH),L,KEYS,CHLUN,CHOPT,IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.-3) WRITE(LPRTFA,9006) IRC
- 9006 FORMAT(' FMOPEN. return code ',I6,' from FMDISK')
- GOTO 999
- ENDIF
-*
-* Information for FMCLOS
-*
- LFMODE(LUN) = 1
-
- ELSE
-
- IQUEST(10) = ICFOP
- CALL FMTAPE(GENAM(1:NCH),L,KEYS,CHLUN,CHOPT,IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.-3) WRITE(LPRTFA,9007) IRC
- 9007 FORMAT(' FMOPEN. return code ',I6,' from FMTAPE')
- GOTO 999
- ENDIF
-*
-* NOWAIT option
-*
- IF(IOPTQ.NE.0) GOTO 10
- IF(CHLUN(1:LCHLUN).EQ.'NOWAIT') GOTO 10
-*
-* Option Y
-*
- IF(IOPTY.NE.0) GOTO 10
-*
-* Information for FMCLOS
-*
-#if defined(CERNLIB_DSYIBM)
-*
-* Input staging only available
-*
- IF(IOPTW.NE.0) IOPTT = 1
-#endif
- IF(IOPTT.EQ.0) THEN
- LFMODE(LUN) = 2
- ELSE
- LFMODE(LUN) = 3
- ENDIF
-
- ENDIF
-*
-* Get DSN
-*
- CALL FMGDSN(L,DSN,LDSN,IRC)
-*
-* Package setup
-*
-#if defined(CERNLIB_IBMVM)
- IVMIO = .FALSE.
-*
-* Suppress user open for FX, FXN files
-*
- IF(ICFOP.EQ.2) THEN
- IVMIO = .TRUE.
- IF(IOPTU.NE.0) THEN
- IF(IDEBFA.GE.-3) WRITE(LPRTFA,9008)
- 9008 FORMAT(' FMOPEN. user open not allowed for direct-access',
- + ' I/O with Zebra FZ')
- ENDIF
- IOPTU = 0
- ENDIF
-#endif
-
-#if defined(CERNLIB_IBM)
- IF(IOPTR.EQ.0.AND.IOPTW.NE.0) THEN
- CHACT = 'WRITE'
- LCHACT = 5
- ELSEIF(IOPTR.NE.0.AND.IOPTW.NE.0) THEN
- CHACT = 'READWRITE'
- LCHACT = 9
- ELSE
- CHACT = 'READ'
- LCHACT = 4
- ENDIF
-#endif
-*
-* I/O options for FZ:
-* IQUEST(10) = 1 - Use C I/O in FZ
-* IQUEST(10) = 2 - Use FORTRAN D/A I/O
-* IQUEST(10) = 3 - Use 'package' I/O in FZ (e.g. IOPACK)
-*
- IF(ICFOP.EQ.2) IOPTX = 1
-
- IF((IOPTX.NE.0).AND.(IOPTT.NE.0)) THEN
- IF(IDEBFA.GE.-3) WRITE(LPRTFA,9009)
- 9009 FORMAT(' FMOPEN. FORTRAN direct-access ',
- + 'not valid for tape files - ignored')
- IOPTX = 0
- ENDIF
-
- IF(ICFOP.EQ.1) THEN
- IF(IOPTU.NE.0) THEN
- IF(IDEBFA.GE.-3) WRITE(LPRTFA,9010)
- 9010 FORMAT(' FMOPEN. user open not allowed',
- + ' for C I/O with Zebra FZ')
- ENDIF
- IOPTU = 0
- ENDIF
-*
-* Set mode (read/write)
-*
- IMODE = IOPTW
-*
-* CHLUN can have the following formats:
-* nn, FTnnFlll, VMnnFlll, IOFILEnn, FORnnn, fort.nn
-* Other formats may be used with FPACK, for example BOSINPUT
-*
- LUN = 0
- LCHLUN = LENOCC(CHLUN)
-
- IF (LCHLUN .EQ. 1) THEN
- READ(CHLUN,'(I1)') LUN
- ELSEIF(LCHLUN .EQ. 2) THEN
- READ(CHLUN,'(I2)') LUN
- ENDIF
-*
-* Get LUN from CHLUN (DDNAME) if necessary
-*
- IF(LUN.EQ.0) CALL FMDD2L(CHLUN(1:LCHLUN),LUN,IRC)
-*
-* Set FZFILE options: C I/O, FORTRAN I/O, package etc.
-*
- JFMODE(LUN) = ICFOP
-*
-* Mode for FZENDx (In or Out)
-*
- IFMODE(LUN) = IMODE
-*
-* Issue FZFILE and do the OPEN
-*
- IF(IOPTF.NE.0) THEN
-*
-* Build FZ options
-* Direction...
-*
- FZOPT = 'I'
- IF(IOPTW.NE.0) FZOPT = 'O'
- LFZOPT = 1
-*
-* Medium...
-*
-#if !defined(CERNLIB_SETUP)
-
- IF((IQ(L+KOFUFA+MMTPFA).GT.1).AND.(IOPTT.NE.0)) THEN
- LFZOPT = LFZOPT + 1
- FZOPT(LFZOPT:LFZOPT) = 'T'
-#endif
-#if (!defined(CERNLIB_SETUP))&&(!defined(CERNLIB_IBMVM))
-*SELF,IF=-SETUP. !! When FZHOOK -> FMVMIO -> VMIO working
- ELSEIF(IOPTX.NE.0) THEN
- LFZOPT = LFZOPT + 1
- FZOPT(LFZOPT:LFZOPT) = 'D'
-#endif
-#if !defined(CERNLIB_SETUP)
- ENDIF
-#endif
-#if defined(CERNLIB_SETUP)
- IF((IQ(L+KOFUFA+MMTPFA).EQ.1).AND.(IOPTX.NE.0)) THEN
-#endif
-#if (defined(CERNLIB_SETUP))&&(!defined(CERNLIB_IBMVM))
- LFZOPT = LFZOPT + 1
- FZOPT(LFZOPT:LFZOPT) = 'D'
-#endif
-#if defined(CERNLIB_SETUP)
- ELSE
- LFZOPT = LFZOPT + 1
- FZOPT(LFZOPT:LFZOPT) = 'T'
- ENDIF
-#endif
-*
-* Data Format...
-*
- IF(INDEX(CHFORM,'A').NE.0) THEN
- LFZOPT = LFZOPT + 1
- FZOPT(LFZOPT:LFZOPT) = 'A'
- ELSEIF(INDEX(CHFORM,'X').NE.0) THEN
- LFZOPT = LFZOPT + 1
- FZOPT(LFZOPT:LFZOPT) = 'X'
- ENDIF
-*
-* FORTRAN I/O...
-*
- IF((INDEX(CHFORM,'FFX').NE.0).AND.(ICFOP.EQ.0)) THEN
- LFZOPT = LFZOPT + 1
- FZOPT(LFZOPT:LFZOPT) = 'F'
- ENDIF
-*
-* Package I/O... (e.g. IOPACK, MAGTAP)
-*
- IF((INDEX(CHFORM,'FX').NE.0).AND.(ICFOP.EQ.3)) THEN
- LFZOPT = LFZOPT + 1
- FZOPT(LFZOPT:LFZOPT) = 'Y'
- ENDIF
-*
-* File format X, but native data...
-*
- IF(INDEX(CHFORM,'FXN').NE.0) THEN
- LFZOPT = LFZOPT + 1
- FZOPT(LFZOPT:LFZOPT) = 'N'
- ENDIF
-#if defined(CERNLIB_CSPACK)
-*
-* File does not exist but we can access remote node
-*
- INQUIRE(FILE=DSN(1:LDSN),EXIST=IEXIST)
- ICSPAK = .FALSE.
- IF(.NOT.IEXIST.AND.
- + (CHFORM(1:3).NE.'FXN'.AND.INDEX(CHFORM,'FX').NE.0)) THEN
- CALL UHTOC(IQ(L+KOFUFA+MHSNFA),4,CHHOST,NHSNFA)
- LHOST = LENOCC(CHHOST)
- CALL FMNTRC(CHHOST(1:LHOST),CHFORM,IRC)
- IF(IRC.EQ.0) THEN
- LFZOPT = LFZOPT + 1
- FZOPT(LFZOPT:LFZOPT) = 'C'
- IF(CHFORM(1:2).EQ.'FX') THEN
- LFZOPT = LFZOPT + 1
- FZOPT(LFZOPT:LFZOPT) = 'D'
- KOPT = 'D'
- ELSE
- KOPT = ' '
- ENDIF
- ICSPAK = .TRUE.
- IOPTU = 1
- CALL SBIT1(IHOWFA,JCSPFA)
- IF(IDEBFA.GE.0) WRITE(LPRTFA,9011) CHHOST(1:LHOST),
- + DSN(1:LDSN),KOPT
- 9011 FORMAT(' FMOPEN. call XZOPEN for host = ',A,' file = ',A,
- + ' options = ',A)
- CALL XZOPEN(LUN,DSN(1:LDSN),CHHOST(1:LHOST),
- + IQ(L+KOFUFA+MRLNFA)*4,KOPT,IRC)
- ENDIF
- ENDIF
-#endif
-#if defined(CERNLIB_IBMVM)
-*
-* File format X, direct access
-*
- IF((INDEX(CHFORM,'FX').NE.0).AND.(IOPTX.NE.0)) THEN
- LFZOPT = LFZOPT + 1
- FZOPT(LFZOPT:LFZOPT) = 'C'
- ENDIF
-#endif
-
- LRECL = IQ(L+KOFUFA+MRLNFA)
-#if defined(CERNLIB_VAXVMS)
-*
-* Activate channel mode--> FMCFIO if STREAM_LF
-*
- INQUIRE(FILE=DSN(1:LDSN),RECORDTYPE=RECTYP,EXIST=IEXIST)
- IF(INDEX(RECTYP,'STREAM_LF').NE.0) THEN
- LFZOPT = LFZOPT + 1
- FZOPT(LFZOPT:LFZOPT) = 'C'
- IF(IOPTR.NE.0) CFMODE = 'r'
- IF(IOPTW.NE.0) CFMODE = 'w'
-*
-* Medium
-*
- IF(LFMODE(LUN).EQ.3) THEN
- MEDIUM = 1
- ELSE
- MEDIUM = 0
- ENDIF
- NBUF = 0
- IF(IDEBFA.GE.0) WRITE(LPRTFA,9012) DSN(1:LDSN),
- + MEDIUM,LRECL,CFMODE,NBUF
- 9012 FORMAT(' FMOPEN. call CFOPEN for ',A,' medium = ',A,
- + ' LRECL = ',I6,' mode = ',A,
- + ' NBUF = ',I6)
- CALL CFOPEN(LUNPTR,MEDIUM,LRECL,CFMODE,NBUF,
- + DSN(1:LDSN),IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.-3) WRITE(LPRTFA,9013) IRC,DSN(1:LDSN)
- 9013 FORMAT(' FMOPEN. return code ',I6,
- + ' from CFOPEN for ',A)
- GOTO 999
- ENDIF
- IFPNTR(LUN) = LUNPTR
- IOPTU = 1
- ENDIF
-
-#endif
-#if defined(CERNLIB_UNIX)
- IF(ICFOP.EQ.0) THEN
- LFZOPT = LFZOPT + 1
- FZOPT(LFZOPT:LFZOPT) = 'C'
- ELSE
- LFZOPT = LFZOPT + 1
- FZOPT(LFZOPT:LFZOPT) = 'L'
- IF(IOPTR.NE.0) CFMODE = 'r'
- IF(IOPTW.NE.0) CFMODE = 'w'
-
- MEDIUM = 0
- NBUF = 1
-
- IF(LUN.LT.10) THEN
- WRITE(FORLUN,'(I1)') LUN
- LFLUN = 1
- ELSE
- WRITE(FORLUN,'(I2)') LUN
- LFLUN = 2
- ENDIF
-#endif
-#if (defined(CERNLIB_UNIX))&&(defined(CERNLIB_SHIFT))
-*
-* Use full file name to activate SHIFT RFIO
-*
- LDSN = LENOCC(SHFNAM)
- DSN = SHFNAM(1:LDSN)
-#endif
-#if defined(CERNLIB_UNIX)
- IF(IDEBFA.GE.0) WRITE(LPRTFA,9014) DSN(1:LDSN),
- + MEDIUM,LRECL,CFMODE,NBUF
- 9014 FORMAT(' FMOPEN. call CFOPEN for ',A,' medium = ',A,
- + ' LRECL = ',I6,' mode = ',A,
- + ' NBUF = ',I6)
- CALL CFOPEN(LUNPTR,MEDIUM,LRECL,CFMODE,NBUF,
- + DSN(1:LDSN),IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.-3) WRITE(LPRTFA,9015) IRC,DSN(1:LDSN)
- 9015 FORMAT(' FMOPEN. return code ',I6,' from CFOPEN for ',A)
- GOTO 999
- ENDIF
-
- IQUEST(1) = LUNPTR
-
- IOPTU = 1
-
- ENDIF
-#endif
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9016) LRECL,FZOPT(1:LFZOPT)
- 9016 FORMAT(' FMOPEN. call FZFILE with LRECL = ',I6,
- + ' CHOPT = ',A)
- CALL FZFILE(LUN,LRECL,FZOPT(1:LFZOPT))
- CALL FZLOGL(LUN,IDEBFA)
-#if defined(CERNLIB_VAXVMS)
- IF(INDEX(RECTYP,'STREAM_LF').NE.0) THEN
- IF(IDEBFA.GE.0) WRITE(LPRTFA,9017) LUN
- 9017 FORMAT(' FMOPEN. call FZHOOK for LUN = ',I6)
- CALL FZHOOK(LUN,FMCFIO,DBUF)
- ENDIF
-#endif
-#if defined(CERNLIB_CSPACK)
- IF(ICSPAK) THEN
- IF(IDEBFA.GE.0) WRITE(LPRTFA,9018) LUN
- 9018 FORMAT(' FMOPEN. call FZHOOK for LUN = ',I6)
- CALL FZHOOK(LUN,FMXZIO,DBUF)
- ENDIF
-#endif
-#if defined(CERNLIB_IBMVM)
- IF((IOPTF.NE.0).AND.(IOPTX.NE.0).AND.
- + (INDEX(CHFORM,'FX').NE.0)) THEN
- IF(IDEBFA.GE.0) WRITE(LPRTFA,9019) LUN
- 9019 FORMAT(' FMOPEN. call FZHOOK for LUN = ',I6)
- CALL FZHOOK(LUN,FMVMIO,DBUF)
- ENDIF
-#endif
-
- ENDIF
-
- IF(IOPTU.EQ.0) THEN
-*
-* Decide on file format
-*
- IF((INDEX(CHFORM,'AS').NE.0).OR.(INDEX(CHFORM,'FA').NE.0)) THEN
- CHFRMT = 'FORMATTED'
- ELSE
- CHFRMT = 'UNFORMATTED'
- ENDIF
-*
-* Decide on file status
-*
- IF(IOPTW.NE.0) THEN
- CHSTAT = 'NEW'
- ELSE
- CHSTAT = 'OLD'
- ENDIF
-*
-* For disk files, check if file already exists
-*
- IF(IQ(L+KOFUFA+MMTPFA).EQ.1) THEN
-#if defined(CERNLIB_IBMMVS)
- INQUIRE(FILE='/'//DSN(1:LDSN),EXIST=IEXIST)
-#endif
-#if defined(CERNLIB_IBMVM)
- INQUIRE(FILE=DDNAME,EXIST=IEXIST)
-#endif
-#if (!defined(CERNLIB_IBMMVS))&&(!defined(CERNLIB_IBMVM))
- INQUIRE(FILE=DSN(1:LDSN),EXIST=IEXIST)
-#endif
- IF(IEXIST) CHSTAT = 'OLD'
- ELSE
-#if defined(CERNLIB_VAXVMS)
- FORLUN = 'FOR00N'
- WRITE(FORLUN(4:6),'(I3.3)') LUN
- INQUIRE(FILE=FORLUN,EXIST=IEXIST)
- IF(IEXIST) CHSTAT = 'OLD'
-#endif
- ENDIF
-
-#if defined(CERNLIB_IBMMVS)
-*
-* Only FORTRAN I/O currently supported...
-*
- IF(IQ(L+KOFUFA+MMTPFA).EQ.1) THEN
-*
-* Check if file exists...
-*
- INQUIRE(FILE='/'//DSN(1:LDSN),EXIST=IEXIST)
- IF(.NOT.IEXIST) THEN
-*
-* Issue FILEINF for DCB and SPACE information
-*
- IF(INDEX('TRK/BLK/CYL',CHSPAC(1:3)).EQ.0) THEN
- IF(IDEBFA.GE.-1) WRITE(LPRTFA,9020) CHSPAC
- 9020 FORMAT(' FMOPEN. invalid value (',A,
- + ') given for SPACE parameter. TRK will be used')
- CHSPAC = 'TRK '
- ENDIF
-
- MODEL = CHMGEN(1)
- LMOD = LENOCC(MODEL)
-
- CALL FILEINF(IRC,'DEVICE',MODEL(1:LMOD),CHSPAC(1:3),
- + ISPACE(2),'SECOND',ISPACE(3),'DIR',ISPACE(4),
- + 'RECFM',RECFM,'LRECL',IQ(L+KOFUFA+MRLNFA)*4,
- + 'BLKSIZE',IQ(L+KOFUFA+MBLNFA)*4)
- ENDIF
- ENDIF
-
- IF((CHFORM(1:2).EQ.'FX'.AND.ICFOP.EQ.3)
- + .OR.(CHFORM(1:2).EQ.'EP').OR.
- + (INDEX(CHLUN,'IOFILE').NE.0)) THEN
-*
-* IOPACK (implied or explicit)
-*
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9021)
- 9021 FORMAT(' FMOPEN. FORTRAN open suppressed',
- + ' (IOPACK implied or explicit)')
-*
-* FORTRAN direct access
-*
- ELSEIF((CHFORM(1:2).EQ.'DA').OR.(IOPTX.NE.0)
- + .AND.(CHLUN(1:2).NE.'VM')) THEN
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9022)
- 9022 FORMAT(' FMOPEN. FORTRAN D/A open...')
- OPEN(UNIT=LUN,
- + FILE='/'//DSN(1:LDSN),ACTION=CHACT(1:LCHACT),
- + ACCESS='DIRECT',STATUS=CHSTAT,RECL=LRECL*4,
- + IOSTAT=IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.-3) WRITE(LPRTFA,9023) IRC,DSN(1:LDSN)
- 9023 FORMAT(' FMOPEN. IOSTAT ',I6,' from OPEN for ',A)
- GOTO 999
- ENDIF
- ELSE
-*
-* FORTRAN sequential I/O
-*
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9024)
- 9024 FORMAT(' FMOPEN. FORTRAN sequential open...')
- OPEN(UNIT=LUN,
- + FILE='/'//DSN(1:LDSN),ACTION=CHACT(1:LCHACT),
- + FORM=CHFRMT,STATUS=CHSTAT,
- + IOSTAT=IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.-3) WRITE(LPRTFA,9023) IRC,DSN(1:LDSN)
- GOTO 999
- ENDIF
- ENDIF
-#endif
-#if defined(CERNLIB_IBMVM)
- IF((CHLUN(1:2).EQ.'VM').OR.(IVMIO)) THEN
-*
-* VMIO
-*
- FNAME = ' '
- LREC1 = LRECL*4
- LBLK1 = LBLOCK*4
- RECFM1 = RECFM
- IF(IOPTR.NE.0) VMOPT = 'R'
- IF(IOPTW.NE.0) VMOPT = 'W'
-*
-* VMOPT = U requires VMUPDT to write the data
-*
-* IF((IOPTX.NE.0).AND.(IOPTW.NE.0)) VMOPT = 'U'
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9025) LUN,RECFM1,LREC1,
- + LBLK1,VMOPT
- 9025 FORMAT(' FMOPEN. call VMOPEN for input dataset on unit ',I6,
- + ' with DCB ',A,1X,I6,1X,I6,' VMOPT ',A)
- CALL VMOPEN(LUN,FNAME,VMOPT,RECFM1,LREC1,LBLK1,IRC,INFO)
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9026) LUN,RECFM1,LREC1,
- + LBLK1,VMOPT
- 9026 FORMAT(' FMOPEN. return from VMOPEN for unit ',I6,
- + ' with DCB ',A,1X,I6,1X,I6,' VMOPT ',A)
- IF(IABS(IRC).GT.1) THEN
- IF(IDEBFA.GT.-3)
- + WRITE(LPRTFA,9027) IRC,INFO
- 9027 FORMAT(' FMOPEN. return code ',I6,
- + ' from VMOPEN for input file, INFO = ',I6)
- GOTO 999
- ELSE
- IRC = 0
- ENDIF
-#endif
-#if defined(CERNLIB_IBMVM)
- ELSEIF((CHFORM(1:2).EQ.'FX').OR.(CHFORM(1:2).EQ.'EP').OR.
- + (INDEX(CHLUN,'IOFILE').NE.0)) THEN
-*
-* IOPACK (implied or explicit)
-*
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9028)
- 9028 FORMAT(' FMOPEN. FORTRAN open supressed -',
- + ' (IOPACK explicit or implied)')
-*
-* FORTRAN direct access
-*
- ELSEIF((CHFORM(1:2).EQ.'DA').OR.(IOPTX.NE.0)
- + .AND.(CHLUN(1:2).NE.'VM')) THEN
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9029)
- 9029 FORMAT(' FMOPEN. FORTRAN D/A open...')
- OPEN (UNIT=LUN,ACCESS='DIRECT',STATUS=CHSTAT,RECL=LRECL*4,
- + ACTION=CHACT(1:LCHACT),IOSTAT=IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.-3) WRITE(LPRTFA,9030) IRC
- 9030 FORMAT(' FMOPEN. IOSTAT ',I6,' from OPEN')
- GOTO 999
- ENDIF
- ELSE
-*
-* FORTRAN sequential I/O
-*
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9031)
- 9031 FORMAT(' FMOPEN. FORTRAN sequential open...')
- OPEN (UNIT=LUN,FORM=CHFRMT,STATUS=CHSTAT,
- + ACTION=CHACT(1:LCHACT),IOSTAT=IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.-3) WRITE(LPRTFA,9030) IRC
- GOTO 999
- ENDIF
- ENDIF
-#endif
-#if defined(CERNLIB_APOLLO)
- IF(IAPOL3.NE.0) THEN
- IF((IQ(L+KOFUFA+MMTPFA).EQ.1).OR.(IMODE.NE.0)) THEN
- CHFILE = DSN(1:LDSN)
- LCHF = LDSN
- ELSEIF((IQ(L+KOFUFA+MMTPFA).GT.1).AND.(IMODE.EQ.0)) THEN
- CHFILE = STGPTH
- LCHF = LENOCC(CHFILE)
- ENDIF
- IF(IDEBFA.GE.0) WRITE(LPRTFA,9032) CHFILE(1:LCHF)
- 9032 FORMAT(' FMOPEN. open file ',A)
- ENDIF
-#endif
-#if (defined(CERNLIB_UNIX))&&(!defined(CERNLIB_APOLLO))
-*
-* Fix for compiler warnings on HP/UX, Cray etc.
-*
- CHFILE = ' '
- LCHF = 1
-#endif
-#if defined(CERNLIB_UNIX)
- IF((CHFORM(1:2).EQ.'DA').OR.(IOPTX.NE.0)) THEN
-*SELF,IF=APOLLO,NORD,SUN,IBMRT,MACMPW,AIX370,IF=UNIX.
-#endif
-#if (!defined(CERNLIB_CONVEX))&&(!defined(CERNLIB_DECS))&&(!defined(CERNLIB_SGI))&&(defined(CERNLIB_UNIX))
- LREC=LRECL*4
-#endif
-#if (defined(CERNLIB_CONVEX)||defined(CERNLIB_DECS)||defined(CERNLIB_SGI))&&(defined(CERNLIB_UNIX))
- LREC=LRECL
-#endif
-#if (defined(CERNLIB_CRAY)||defined(CERNLIB_CONVEX))&&(defined(CERNLIB_UNIX))&&(!defined(CERNLIB_DOUBLE))
- LREC=LRECL*8
-
-#endif
-#if (defined(CERNLIB_UNIX))&&(!defined(CERNLIB_SHIFT))
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9033)
- 9033 FORMAT(' FMOPEN. FORTRAN D/A open...')
- IF(IAPOL3.EQ.0) THEN
- OPEN (UNIT=LUN,ACCESS='DIRECT',STATUS=CHSTAT,RECL=LREC,
- + IOSTAT=IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.-3) WRITE(LPRTFA,9034) IRC
- 9034 FORMAT(' FMOPEN. IOSTAT ',I6,' from OPEN')
- GOTO 999
- ENDIF
- ELSE
- OPEN (UNIT=LUN,FILE=CHFILE(1:LCHF),
- + ACCESS='DIRECT',STATUS=CHSTAT,RECL=LREC,
- + IOSTAT=IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.-3) WRITE(LPRTFA,9034) IRC
- GOTO 999
- ENDIF
- ENDIF
- ELSE
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9035)
- 9035 FORMAT(' FMOPEN. FORTRAN sequential open...')
- IF(IAPOL3.EQ.0) THEN
- OPEN (UNIT=LUN,FORM=CHFRMT,STATUS=CHSTAT,
- + IOSTAT=IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.-3) WRITE(LPRTFA,9034) IRC
- GOTO 999
- ENDIF
- ELSE
- OPEN (UNIT=LUN,FILE=CHFILE(1:LCHF),
- + FORM=CHFRMT,STATUS=CHSTAT,
- + IOSTAT=IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.-3) WRITE(LPRTFA,9034) IRC
- GOTO 999
- ENDIF
- ENDIF
- ENDIF
-
-#endif
-#if (defined(CERNLIB_UNIX))&&(defined(CERNLIB_SHIFT))
-*
-* LRECL in bytes for SHIFT...
-*
- LREC = LRECL*4
- SHOPT = 'D'
- ELSE
- LREC = LRECL*4
- SHOPT = ' '
- ENDIF
-
- IF(ICFOP.EQ.0) THEN
- CALL SBIT1(IHOWFA,JRFIFA)
- IF(IDEBFA.GE.0) WRITE(LPRTFA,9036) LUN,LRECL,SHOPT
- 9036 FORMAT(' FMOPEN. calling XYOPEN with LUN - ',I6,
- + ' LRECL = ',I6,' CHOPT = ',A)
- CALL XYOPEN(LUN,LREC,SHOPT,IRC)
- IF(IRC.NE.0) THEN
- WRITE(LPRTFA,9037) IRC
- 9037 FORMAT(' FMOPEN. return code ',I6,' from XYOPEN')
- GOTO 999
- ENDIF
-
- IF(IOPTF.NE.0) THEN
- IF(IDEBFA.GE.0) WRITE(LPRTFA,9038) LUN
- 9038 FORMAT(' FMOPEN. call FZHOOK for LUN = ',I6)
- CALL FZHOOK(LUN,FMXYIO,DBUF)
- ENDIF
-
- ENDIF
-
-#endif
-#if defined(CERNLIB_VAXVMS)
- IF(INDEX(RECTYP,'STREAM_LF').EQ.0.AND.
- + INDEX(CHFORM,'FX').NE.0) THEN
-*
-* Always open VAX files SHARED
-*
- IF(IOPTR.NE.0) THEN
- IF((CHFORM(1:2).EQ.'DA').OR.(IOPTX.NE.0)) THEN
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9039)
- 9039 FORMAT(' FMOPEN. FORTRAN D/A open...')
- OPEN (UNIT=LUN,STATUS=CHSTAT,
- + ACCESS='DIRECT',RECL=LRECL,
- + SHARED, READONLY,
- + IOSTAT=IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.-3) WRITE(LPRTFA,9040)
- 9040 FORMAT(' FMOPEN. IOSTAT ',I6,' from OPEN')
- GOTO 999
- ENDIF
- ELSE
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9041)
- 9041 FORMAT(' FMOPEN. FORTRAN sequential open...')
- OPEN (UNIT=LUN, FORM=CHFRMT, STATUS=CHSTAT,
- + SHARED, READONLY,
- + IOSTAT=IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.-3) WRITE(LPRTFA,9040)
- GOTO 999
- ENDIF
- ENDIF
-
- ELSE
- IF((CHFORM(1:2).EQ.'DA').OR.(IOPTX.NE.0)) THEN
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9039)
- OPEN (UNIT=LUN,STATUS=CHSTAT,
- + ACCESS='DIRECT',RECL=LRECL,
- + SHARED,
- + IOSTAT=IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.-3) WRITE(LPRTFA,9040)
- GOTO 999
- ENDIF
- ELSE
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9041)
- OPEN (UNIT=LUN, FORM=CHFRMT, STATUS=CHSTAT,
- + SHARED,
- + IOSTAT=IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.-3) WRITE(LPRTFA,9040)
- GOTO 999
- ENDIF
- ENDIF
- ENDIF
- ELSE
- IF(IDEBFA.GE.1) WRITE(LPRTFA,9042)
- 9042 FORMAT(' FMOPEN. Fortran OPEN supressed for STREAM_LF files')
- ENDIF
-#endif
- ENDIF
-*
-*
-* Issue RZOPEN and RZFILE
-*
- IF(IOPTZ.NE.0) THEN
-*
-* Mode for FMCLOS
-*
- IFMODE(LUN) = 2
-*
-* Build RZ options
-*
- LRECL = IQ(L+KOFUFA+MRLNFA)
- LRECL = LRECL*4/IQCHAW
- RZOPT = 'W'
- IF(IOPTW.NE.0) RZOPT = 'UW'
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9043) LUN,CHDIR,
- + DSN(1:LDSN),RZOPT,LRECL
- 9043 FORMAT(' FMOPEN. call RZOPEN with LUN = ',I6,
- + ' CHDIR = ',A,' DSN = ',A,' RZOPT = ',A,' LRECL = ',I6)
- CALL RZOPEN(LUN,CHDIR,DSN(1:LDSN),RZOPT,LRECL,IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.0) PRINT 9044,IRC
- 9044 FORMAT(' FMOPEN. return code ',I6,' from RZOPEN')
- GOTO 999
- ENDIF
-
- RZOPT = ' '
- IF(IOPTW.NE.0) RZOPT = 'ULD'
- IF(IOPT1.NE.0) RZOPT = '1ULD'
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9045) LUN,CHDIR,RZOPT
- 9045 FORMAT(' FMOPEN. call RZFILE with LUN = ',I6,
- + ' CHDIR = ',A,' RZOPT = ',A)
- CALL RZFILE(LUN,CHDIR,RZOPT)
- IRC = IQUEST(1)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.0) WRITE(LPRTFA,9046) IRC
- 9046 FORMAT(' FMOPEN. return code ',I6,' from RZFILE')
- GOTO 999
- ENDIF
- ENDIF
-
-#if defined(CERNLIB_FPACK)
- ENDIF
-#endif
-
- 10 CONTINUE
-*
-* Now compute elapsed time in seconds
-*
- CALL DATIME(ID,IT)
- JDATE = FMJDAT(IS(1),IS(2),IS(3))
- JSECS = (IS(4)*60 + IS(5))*60 + IS(6)
-
- IF(IDATE.EQ.JDATE) THEN
- JTIME = JSECS - ISECS
- ELSE
- JTIME = (JDATE - IDATE)*86400 + JSECS
- ENDIF
-*
-* Record last access date and use count in bank send to server
-*
- CALL FMPKTM(ID,IT,IP,IRC)
- IQ(L+KOFUFA+MLATFA) = IP
- IF(IMODE.EQ.1) THEN
- IQ(L+KOFUFA+MUSCFA) = 1
- ELSE
- IQ(L+KOFUFA+MUSCFA) = IQ(L+KOFUFA+MUSCFA) + 1
- ENDIF
- IF(LUFZFA.GT.0.AND.IOPTQ.EQ.0) THEN
- IF(IDEBFA.GE.0.AND.IMODE.EQ.0) WRITE(LPRTFA,9047)
- 9047 FORMAT(' FMOPEN. - updating last access date and use count')
- IF(IDEBFA.GE.3)
- + CALL FMSHOW(GENAM(1:NCH),L,KEYS,'A',IRC)
-*
-* Monitoring information
-*
- ITIMFA = JTIME
- CALL FMREPL(GENAM(1:NCH),L,'O',IRC)
- IF((IRC.NE.0).AND.(IDEBFA.GE.0)) THEN
- WRITE(LPRTFA,9048) IRC
- 9048 FORMAT(' FMOPEN. error updating usage information -',
- + ' Return code from FMREPL = ',I6)
- ENDIF
- ENDIF
- IF(IDEBFA.GE.1) THEN
- CALL DATIME(ID,IT)
- WRITE(LPRTFA,9049) GENAM(1:NCH),CHOPT(1:LCH),ID,IT,IS(6)
- 9049 FORMAT(' FMOPEN. exit for ',A,' options: ',A,' at ',
- + I6.6,1X,I4.4,I2.2)
- WRITE(LPRTFA,9050) JTIME
- 9050 FORMAT(' FMOPEN. elapsed time since entry = ',I6,' seconds')
- ENDIF
-
- 999 END
diff --git a/src/packlib/fatmen/fmint/fmpuse.F b/src/packlib/fatmen/fmint/fmpuse.F
deleted file mode 100644
index 3603413..0000000
--- a/src/packlib/fatmen/fmint/fmpuse.F
+++ /dev/null
@@ -1,43 +0,0 @@
-*
-* $Id: fmpuse.F,v 1.1.1.1 1996/03/07 15:18:11 mclareni Exp $
-*
-* $Log: fmpuse.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:11 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMPUSE(GNAME,LBANK,KEYS,CHOPT,IRC)
-*CMZ : 23/01/91 13.28.01 by Jamie Shiers
-*-- Author : Jamie Shiers 23/01/91
- CHARACTER*(*) GNAME
- CHARACTER*256 DSN
-#include "fatmen/fmnkeys.inc"
- DIMENSION KEYS(LKEYFA)
- DIMENSION NDAYS(3)
-#include "fatmen/fatbank.inc"
-#include "fatmen/fatpara.inc"
-#include "fatmen/fatopts.inc"
- IRC = 0
- LGN = LENOCC(GNAME)
- ISIZE = IQ(LBANK+KOFUFA+MFSZFA)
- IUSE = IQ(LBANK+KOFUFA+MUSCFA)
-* Number of days since last access = NDAYS(3)
- CALL FMDAYS(GNAME(1:LGN),LBANK,KEYS,NDAYS,' ',IC)
-*
- DSN = ' '
- IF(KEYS(MKMTFA).EQ.1) THEN
- CALL UHTOC(IQ(LBANK+KOFUFA+MFQNFA),4,DSN,NFQNFA)
- ELSE
- CALL UHTOC(IQ(LBANK+KOFUFA+MVIDFA),4,DSN,6)
- ENDIF
- LDSN = LENOCC(DSN)
- CALL FMEXST(GNAME(1:LGN),NCOP)
- IF(IOPTH.NE.0) PRINT 9000,
- +'+++ Generic name +++ Generic name +++ Generic name +++ ','KSN',
- + 'Datasetname/VID','#MB','#ACC','L/A','Copies'
-9000 FORMAT(1X,A80,1X,A5,1X,A20,1X,A4,1X,A4,1X,A4,1X,A6)
- PRINT 9001,GNAME(1:MIN(80,LGN)),KEYS(1),DSN(1:MIN(20,LDSN)),
- + ISIZE,IUSE,NDAYS(3),NCOP
-9001 FORMAT(1X,A80,1X,I5,1X,A20,1X,I4,1X,I4,1X,I4,1X,I4)
- END
diff --git a/src/packlib/fatmen/fmint/fmput.F b/src/packlib/fatmen/fmint/fmput.F
deleted file mode 100644
index da4de7c..0000000
--- a/src/packlib/fatmen/fmint/fmput.F
+++ /dev/null
@@ -1,44 +0,0 @@
-*
-* $Id: fmput.F,v 1.1.1.1 1996/03/07 15:18:10 mclareni Exp $
-*
-* $Log: fmput.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:10 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMPUT(GENAME,LENTRY,IRC)
- CHARACTER*(*) GENAME
- CHARACTER*4 COMM
- PARAMETER (LKEYFA=10)
- DIMENSION KEYS(LKEYFA)
- DIMENSION LENTRY(1)
-#include "fatmen/fatpara.inc"
-#include "fatmen/fatbank.inc"
- IRC = 0
- COMM='PUT '
- LGN = LENOCC(GENAME)
- IF(IDEBFA.GE.1) WRITE(LPRTFA,9001) COMM,GENAME(1:LGN)
-9001 FORMAT(' FMPUT. ',A4,1X,A)
-*
-* Fill KEYS vector for call to FMVERI
-*
- LPATH = INDEXB(GENAME(1:LGN),'/')
- CALL VBLANK(KEYS(2),5)
- CALL UCTOH(GENAME(LPATH+1:LGN),KEYS(2),4,LGN-LPATH)
- KEYS(MKSRFA) = 0
- KEYS(MKCLFA) = IQ(LENTRY(1)+KOFUFA+MCPLFA)
- KEYS(MKLCFA) = IQ(LENTRY(1)+KOFUFA+MLOCFA)
- KEYS(MKMTFA) = IQ(LENTRY(1)+KOFUFA+MMTPFA)
- KEYS(MKNBFA) = MKNBFA
-
- CALL FMVERI(GENAME,LENTRY(1),KEYS,'A',IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GT.-3) PRINT *,'FMPUT. errors detected by FMVERI - ',
- + 'entry will not be added to catalogue'
- RETURN
- ENDIF
-
- CALL FMFZO(COMM,GENAME,LENTRY(1),KEYS,IRC)
- END
-
diff --git a/src/packlib/fatmen/fmint/fmputc.F b/src/packlib/fatmen/fmint/fmputc.F
deleted file mode 100644
index f3468ad..0000000
--- a/src/packlib/fatmen/fmint/fmputc.F
+++ /dev/null
@@ -1,63 +0,0 @@
-*
-* $Id: fmputc.F,v 1.1.1.1 1996/03/07 15:18:09 mclareni Exp $
-*
-* $Log: fmputc.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:09 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMPUTC(LBANK,STRING,ISTART,NCH,IRC)
-*
-* Routine to write a STRING into the bank at LBANK
-*
-#include "fatmen/fatbank.inc"
-#include "fatmen/fatpara.inc"
-#include "fatmen/fatusr.inc"
- CHARACTER*(*) STRING
- CHARACTER*255 CHSTR,CHBLA
- JL = ISTART
- JR = ISTART - 1 + (NCH+3)/4
- IRC = 0
- IF(NCH.EQ.0) RETURN
- LCH = LEN(STRING)
- CHSTR = STRING(1:LCH)
- CHBLA = ' '
-*
-* Check that JL:JR is a valid range
-*
- IF(JR.LT.JL) THEN
- IF(IDEBFA.GE.0) THEN
- PRINT *,'FMPUTC. invalid range, end < start'
- PRINT *,'FMPUTC. ISTART/IEND = ',JL,JR
- ENDIF
- IRC = 1
- RETURN
- ENDIF
-
-*
-* Check that we are not outside the bank
-*
- IF((JL.LE.0).OR.(JR.GT.NWDSFA)) THEN
- IF(IDEBFA.GE.0) THEN
- PRINT *,'FMPUTC. attempt to write outside bank boundaries'
- PRINT *,'FMPUTC. ISTART/IEND = ',JL,JR
- ENDIF
- IRC = 1
- RETURN
- ENDIF
-
- LADDR = LBANK+KOFUFA
- IF(LBANK.EQ.-1) LADDR = LADDBK+KOFUFA
-*
-* Special case: VID prefix - first translate from CHARACTER to
-* integer.
-*
- IF(ISTART.EQ.MVIPFA) THEN
- CALL FMPREF(STRING,JP,'C',IRC)
- IQ(LADDR+JL) = JP
- ELSE
- CALL UCTOH(CHSTR(1:LCH)//CHBLA,IQ(LADDR+JL),4,NCH)
- ENDIF
-
- END
diff --git a/src/packlib/fatmen/fmint/fmputi.F b/src/packlib/fatmen/fmint/fmputi.F
deleted file mode 100644
index 19db5d7..0000000
--- a/src/packlib/fatmen/fmint/fmputi.F
+++ /dev/null
@@ -1,35 +0,0 @@
-*
-* $Id: fmputi.F,v 1.1.1.1 1996/03/07 15:18:14 mclareni Exp $
-*
-* $Log: fmputi.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:14 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMPUTI(LBANK,IVAL,IOFF,IRC)
-*
-* Routine to put an INTEGER into the bank at LBANK
-*
-#include "fatmen/fatbank.inc"
-#include "fatmen/fatpara.inc"
-#include "fatmen/fatusr.inc"
- IRC = 0
-*
-* Check that IOFF is valid
-*
- IF(IOFF.LE.0.OR.IOFF.GT.NWDSFA) THEN
- IF(IDEBFA.GE.0) THEN
- PRINT *,'FMPUTI. attempt to write outside bank boundaries'
- PRINT *,'FMPUTI. IOFF = ',IOFF
- ENDIF
- IRC = 1
- RETURN
- ENDIF
-
- LADDR = LBANK+KOFUFA
- IF(LBANK.EQ.-1) LADDR = LADDBK + KOFUFA
-
- IQ(LADDR+IOFF) = IVAL
-
- END
diff --git a/src/packlib/fatmen/fmint/fmputv.F b/src/packlib/fatmen/fmint/fmputv.F
deleted file mode 100644
index fd1091b..0000000
--- a/src/packlib/fatmen/fmint/fmputv.F
+++ /dev/null
@@ -1,49 +0,0 @@
-*
-* $Id: fmputv.F,v 1.1.1.1 1996/03/07 15:18:09 mclareni Exp $
-*
-* $Log: fmputv.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:09 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMPUTV(LBANK,IVECT,ISTART,NWORDS,IRC)
-*
-* Routine to put an INTEGER vector into the bank at LBANK
-*
- DIMENSION IVECT(NWORDS)
-#include "fatmen/fatbank.inc"
-#include "fatmen/fatpara.inc"
-#include "fatmen/fatusr.inc"
- JL = ISTART
- JR = ISTART + NWORDS - 1
- IRC = 0
-*
-* Check that JL:JR is a valid range
-*
- IF(JR.LT.JL) THEN
- IF(IDEBFA.GE.0) THEN
- PRINT *,'FMPUTV. invalid range, end < start'
- PRINT *,'FMPUTV. ISTART/IEND = ',JL,JR
- ENDIF
- IRC = 1
- RETURN
- ENDIF
-
-*
-* Check that we are not outside the bank
-*
- IF((JL.LE.0).OR.(JR.GT.NWDSFA)) THEN
- IF(IDEBFA.GE.0) THEN
- PRINT *,'FMPUTV. attempt to write outside bank boundaries'
- PRINT *,'FMPUTV. ISTART/IEND = ',JL,JR
- ENDIF
- IRC = 1
- RETURN
- ENDIF
-
- LADDR = LBANK+KOFUFA
- IF(LBANK.EQ.-1) LADDR = LADDBK + KOFUFA
-
- CALL UCOPY(IVECT,IQ(LADDR+JL),JR-JL+1)
- END
diff --git a/src/packlib/fatmen/fmint/fmrcop.F b/src/packlib/fatmen/fmint/fmrcop.F
deleted file mode 100644
index 36fa93e..0000000
--- a/src/packlib/fatmen/fmint/fmrcop.F
+++ /dev/null
@@ -1,360 +0,0 @@
-*
-* $Id: fmrcop.F,v 1.2 1997/10/23 13:39:40 mclareni Exp $
-*
-* $Log: fmrcop.F,v $
-* Revision 1.2 1997/10/23 13:39:40 mclareni
-* NT mods
-*
-* Revision 1.1.1.1 1996/03/07 15:18:11 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMRCOP(GENAM1,LBANK1,KEYS1,GENAM2,LBANK2,KEYS2,
- +CHOPT,IRC)
- CHARACTER*(*) CHOPT
-#include "fatmen/faust.inc"
-#include "fatmen/fatpara.inc"
-#include "fatmen/fatbank.inc"
-#include "fatmen/fatstg.inc"
-#include "fatmen/fattyp.inc"
-#include "fatmen/czsock.inc"
- CHARACTER*8 DDNAM1,DDNAM2
- CHARACTER*4 CHOPE
- CHARACTER*20 FN1,FN2
- CHARACTER*(*) GENAM1,GENAM2
- CHARACTER*256 DSN1,DSN2,LOCAL,REMOTE
- CHARACTER*8 USER1,ADDR1,USER2,ADDR2
- CHARACTER*8 NODE1,NODE2
- CHARACTER*40 DCB1,DCB2
- CHARACTER*4 RECFM1,RECFM2
- CHARACTER*4 FFORM1,FFORM2
- DIMENSION BUFFER(8172)
- PARAMETER (LKEYFA=10)
- DIMENSION KEYS1(LKEYFA),KEYS2(LKEYFA)
- INTEGER FMNODE
-#if defined(CERNLIB_VAXVMS)
- INCLUDE '($SSDEF)'
- STRUCTURE /ITMLST/
- UNION
- MAP
- INTEGER*2 BUFFER_LENGTH
- INTEGER*2 ITEM_CODE
- INTEGER*4 BUFFER_ADDRESS
- INTEGER*4 RETURN_LENGTH_ADDRESS
- ENDMAP
- MAP
- INTEGER*4 END_LIST /0/
- ENDMAP
- END UNION
- END STRUCTURE
-
- RECORD /ITMLST/ SYI_LIST(2)
-
- INCLUDE '($SYIDEF)'
-#endif
-#include "fatmen/fatran0.inc"
-#include "fatmen/tmsdef0.inc"
-#include "fatmen/fatvid0.inc"
-#include "fatmen/fatopt0.inc"
-#include "fatmen/fatform.inc"
-#include "fatmen/fatopt1.inc"
-#include "fatmen/fatran1.inc"
-#include "fatmen/tmsdef1.inc"
-#include "fatmen/fatvid1.inc"
-#include "fatmen/fatoptc.inc"
-#if !defined(CERNLIB_CSPACK)
- IF(IDEBFA.GE.0) THEN
- PRINT *,'FMRCOP. dummy version of FMRCOP installed.'
- PRINT *,'FMRCOP. +USE,CSPACK to get a functional version.'
- ENDIF
- IRC = 99
-
-#endif
-#if defined(CERNLIB_CSPACK)
- IRC = 0
- NFMCOPR = NFMCOPR + 1
- LG1 = LENOCC(GENAM1)
- LG2 = LENOCC(GENAM2)
- FATMBN = FATMBN + Q(LBANK1+KOFUFA+MFSZFA)
-*
-* Set log level if XZ package to the same as FATMEN
-*
- CALL XZLOGL(IDEBFA)
-*
-* Set protocol
-*
- IPROT = ITRANS
-
- IF(IDEBFA.GE.0) PRINT *,'FMRCOP. enter for',
- + ' GENAM1 = ',GENAM1(1:LG1),
- + ' GENAM2 = ',GENAM2(1:LG2)
-*
-* Determine whether to do a GET or a PUT...
-*
- CALL FMGETC(LBANK1,NODE1,MHSNFA,NHSNFA,IC)
- CALL FMGETC(LBANK2,NODE2,MHSNFA,NHSNFA,IC)
- LNODE1 = LENOCC(NODE1)
- LNODE2 = LENOCC(NODE2)
- IPUT = FMNODE(NODE1(1:LNODE1))
- IGET = FMNODE(NODE2(1:LNODE2))
-
- IF(IDEBFA.GE.0) PRINT *,'FMRCOP. NODE1/2 = ',NODE1,NODE2
-*
-* Get input and output dsn
-*
- CALL FMGETC(LBANK1,DSN1,MFQNFA,NFQNFA,IC)
- CALL FMGETC(LBANK2,DSN2,MFQNFA,NFQNFA,IC)
- LDSN1 = LENOCC(DSN1)
- LDSN2 = LENOCC(DSN2)
-
- IF((IPUT.NE.0).AND.(IGET.NE.0)) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMRCOP. Error - both nodes are remote'
- IRC = 1
- RETURN
- ENDIF
-
- IF((IPUT.EQ.0).AND.(IGET.EQ.0)) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMRCOP. Both nodes are local'
- IRC = -1
- RETURN
- ENDIF
-*
-* Get LRECL
-*
- IF(IPUT.EQ.0) THEN
- LRECL = IQ(LBANK1+KOFUFA+MRLNFA) * 4
- ELSE
- LRECL = IQ(LBANK2+KOFUFA+MRLNFA) * 4
- ENDIF
-*
-* Determine operation: GET/PUTA, B, FZ, P, RZ
-*
- CALL FMGETC(LBANK1,FFORM1,MFLFFA,NFLFFA,IC)
- CALL FMGETC(LBANK2,FFORM2,MFLFFA,NFLFFA,IC)
- LFORM1 = LENOCC(FFORM1)
- LFORM2 = LENOCC(FFORM2)
-
- IF(IDEBFA.GE.0) PRINT *,'FMRCOP. FFORM1/2 = ',FFORM1,FFORM2
-
- IFORM1 = ICNTH(FFORM1(1:LFORM1),FATFRM,NFATFM)
- IFORM2 = ICNTH(FFORM2(1:LFORM2),FATFRM,NFATFM)
- IF((IFORM1.NE.IFORM2).AND.(IDEBFA.GE.0)) THEN
-*
-* This test may lose validity ...
-*
- IF(FFORM1(1:1).NE.FFORM2(1:1)) THEN
- IF(IDEBFA.GE.-3)
- + PRINT *,'FMRCOP. Error - input and output files have ',
- + ' conflicting formats: ',
- + ' Input: ',FFORM1(1:LFORM1),' output: ',FFORM2(1:LFORM2)
- IRC = 1
- RETURN
- ELSE
- IF(IDEBFA.GE.0)
- + PRINT *,'FMRCOP. Warning - input and output files have ',
- + ' different formats: ',
- + ' Input: ',FFORM1(1:LFORM1),' output: ',FFORM2(1:LFORM2)
- ENDIF
- ENDIF
-*
-* Ensure that a connection exists to the remote node
-*
- IF(IPUT.EQ.0) THEN
- LOCAL = DSN1
- REMOTE = DSN2
- LENLOC = LDSN1
- LENREM = LDSN2
- CALL CZSWAP(NODE2(1:LNODE2),-1,IOPEN)
- IF(IOPEN.EQ.-1) THEN
- CALL CZOPEN('zserv',NODE2(1:LNODE2),IC)
- IF(IC.NE.0) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMRCOP. cannot open ', 'commun'
- + //'ication with ',NODE2(1:LNODE2)
- IRC = IC
- RETURN
- ENDIF
- ENDIF
- ELSE
- LOCAL = DSN2
- REMOTE = DSN1
- LENREM = LDSN1
- LENLOC = LDSN2
- CALL CZSWAP(NODE1(1:LNODE1),-1,IOPEN)
- IF(IOPEN.EQ.-1) THEN
- CALL CZOPEN('zserv',NODE1(1:LNODE1),IC)
- IF(IC.NE.0) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMRCOP. cannot open ', 'commun'
- + //'ication with ',NODE1(1:LNODE1)
- IRC = IC
- RETURN
- ENDIF
- ENDIF
- ENDIF
-*
-* Now try to transfer the file...
-*
-* FZ: XZGET/PUTF
-* FA: XZGET/PUTA
-* FX: XZGET/PUTB
-* FFX: XZGET/PUTB
-* RZ: XZGET/PUTR
-* EP: XZGET/PUTB
-* AS: XZGET/PUTA
-* UN: - no can do -
-* DA: XZGET/PUTD
-*
- IRET = 0
-
-
- IF(IDEBFA.GE.3) PRINT *,'FMRCOP. local file = ',
- + LOCAL(1:LENLOC),' remote file = ',
- + REMOTE(1:LENREM)
-
- IF(FFORM1(1:1).EQ.'R') THEN
-*
-* Transfer an RZ file
-*
- IF(IPUT.EQ.0) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMRCOP. transferring ',
- + 'file using XZPUTR'
- CALL XZPUTR(LOCAL(1:LENLOC),REMOTE(1:LENREM),'QS',IRET)
- ELSE
- IF(IDEBFA.GE.0) PRINT *,'FMRCOP. transferring ',
- + 'file using XZGETR'
- CALL XZGETR(LOCAL(1:LENLOC),REMOTE(1:LENREM),'QS',IRET)
- ENDIF
- ELSEIF(FFORM1(1:2).EQ.'DA') THEN
-*
-* Transfer a direct access file
-*
- IF(IPUT.EQ.0) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMRCOP. transferring ',
- + 'file using XZPUTD'
- CALL XZPUTD(LOCAL(1:LENLOC),REMOTE(1:LENREM),
- + LRECL,'QS',IRET)
- ELSE
- IF(IDEBFA.GE.0) PRINT *,'FMRCOP. transferring ',
- + 'file using XZGETD'
- CALL XZGETD(LOCAL(1:LENLOC),REMOTE(1:LENREM),
- + LRECL,'QS',IRET)
- ENDIF
- ELSEIF(FFORM1(1:2).EQ.'EP') THEN
-*
-* Transfer an EPIO file
-*
- IF(IPUT.EQ.0) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMRCOP. transferring ',
- + 'file using XZPUTB'
- CALL XZPUTB(LOCAL(1:LENLOC),REMOTE(1:LENREM),
- + LRECL,'QS',IRET)
- ELSE
- IF(IDEBFA.GE.0) PRINT *,'FMRCOP. transferring ',
- + 'file using XZGETB'
- CALL XZGETB(LOCAL(1:LENLOC),REMOTE(1:LENREM),
- + LRECL,'QS',IRET)
- ENDIF
- ELSEIF((FFORM1(1:1).EQ.'A').OR.(FFORM1(1:2).EQ.'FA')) THEN
-*
-* Transfer a text file
-*
- IF(IPUT.EQ.0) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMRCOP. transferring ',
- + 'file using XZPUTA'
- CALL XZPUTA(LOCAL(1:LENLOC),REMOTE(1:LENREM),'QS',IRET)
- ELSE
- IF(IDEBFA.GE.0) PRINT *,'FMRCOP. transferring ',
- + 'file using XZGETA'
- CALL XZGETA(LOCAL(1:LENLOC),REMOTE(1:LENREM),'QS',IRET)
- ENDIF
- ELSEIF(FFORM1(1:1).EQ.'F') THEN
-*
-* Transfer an FZ file:
-*
- IF((INDEX(FFORM1(1:LFORM1),'FX').NE.0).AND. (INDEX(FFORM1(1:
- + LFORM1),'FX').NE.0)) THEN
-*
-* Exchange format, binary mapping
-*
- IF(IPUT.EQ.0) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMRCOP. transferring ', 'file '
- + //'using XZPUTB'
- CALL XZPUTB(LOCAL(1:LENLOC),REMOTE(1:LENREM),
- + LRECL,'QS',IRET)
- ELSE
- IF(IDEBFA.GE.0) PRINT *,'FMRCOP. transferring ', 'file '
- + //'using XZGETB'
- CALL XZGETB(LOCAL(1:LENLOC),REMOTE(1:LENREM),
- + LRECL,'QS',IRET)
- ENDIF
- ELSEIF((INDEX(FFORM1(1:LFORM1),'FA').NE.0).AND. (INDEX(FFORM1(
- + 1:LFORM1),'FA').NE.0)) THEN
-*
-* Exchange format, ASCII mapping
-*
- IF(IPUT.EQ.0) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMRCOP. transferring ', 'file '
- + //'using XZPUTA'
- CALL XZPUTA(LOCAL(1:LENLOC),REMOTE(1:LENREM),'QS',IRET)
- ELSE
- IF(IDEBFA.GE.0) PRINT *,'FMRCOP. transferring ', 'file '
- + //'using XZGETA'
- CALL XZGETA(LOCAL(1:LENLOC),REMOTE(1:LENREM),'QS',IRET)
- ENDIF
- ELSE
-*
-* Any other FZ formats/combinations
-*
- IF(IPUT.EQ.0) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMRCOP. transferring ', 'file '
- + //'using XZPUTF'
- CALL XZPUTF(LOCAL(1:LENLOC),REMOTE(1:LENREM),
- + LRECL,LFORM,RFORM,'QS',IRET)
- ELSE
- IF(IDEBFA.GE.0) PRINT *,'FMRCOP. transferring ', 'file '
- + //'using XZGETF'
- CALL XZGETF(LOCAL(1:LENLOC),REMOTE(1:LENREM),
- + LRECL,LFORM,RFORM,'QS',IRET)
- ENDIF
- ENDIF
- ELSE
- PRINT *,'FMRCOP. Cannot process requested formats - ', ' '
- + //'Input: ',FFORM1(1:LFORM1),' output: ',FFORM2(1:LFORM2)
- IRC = 1
- RETURN
- ENDIF
-*
-* Close connection to remode node
-*
- IF(IOPEN.EQ.-1) THEN
- IF(IOPTK.EQ.0) CALL CZCLOS(ISTAT)
- ELSE
- CALL CZSWAP(' ',-1,ISTAT)
- ENDIF
-*
-* Now update catalogue if transfer successful
-*
- IF(IRET.EQ.0) THEN
-*
-* Get file size transferred
-*
-* IQUEST(11) = NR
-* IQUEST(12) = NKILO
-* IQUEST(13) = RATE
-* IQUEST(14) = IHOUR
-* IQUEST(15) = IMIN
-* IQUEST(16) = ISEC
-* IQUEST(17) = T
-*
- IF(IOPTU.NE.0) THEN
- IQ(LBANK2+KOFUFA+MFSZFA) = IQUEST(12) / 1024
- ENDIF
-
- ELSE
- PRINT *,'FMRCOP. Return code ',IRET,' from file transfer'
- PRINT *,'FMRCOP. Catalogue will not be updated'
- IRC = IRET
- RETURN
- ENDIF
-#endif
- END
diff --git a/src/packlib/fatmen/fmint/fmrepl.F b/src/packlib/fatmen/fmint/fmrepl.F
deleted file mode 100644
index ee2b0a9..0000000
--- a/src/packlib/fatmen/fmint/fmrepl.F
+++ /dev/null
@@ -1,50 +0,0 @@
-*
-* $Id: fmrepl.F,v 1.1.1.1 1996/03/07 15:18:13 mclareni Exp $
-*
-* $Log: fmrepl.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:13 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMREPL(GENAME,LENTRY,CHOPT,IRC)
- CHARACTER*(*) GENAME
- CHARACTER*4 COMM
- CHARACTER*1 CHOPT
- PARAMETER (LKEYFA=10)
- DIMENSION KEYS(LKEYFA)
- DIMENSION LENTRY(1)
-#include "fatmen/fatbank.inc"
-#include "fatmen/fatpara.inc"
-*
-* Replace catalogue entry
-*
- IRC = 0
- COMM='MOD '
- LGN = LENOCC(GENAME)
- IF(IDEBFA.GE.1) WRITE(LPRTFA,9001) COMM,GENAME(1:LGN)
-9001 FORMAT(' FMREPL. ',A4,1X,A)
- COMM(4:4) = CHOPT
-*
-* Fill KEYS vector for call to FMVERI
-*
- LPATH = INDEXB(GENAME(1:LGN),'/')
- CALL VBLANK(KEYS(2),5)
- CALL UCTOH(GENAME(LPATH+1:LGN),KEYS(2),4,LGN-LPATH)
- KEYS(MKSRFA) = 0
- KEYS(MKCLFA) = IQ(LENTRY(1)+KOFUFA+MCPLFA)
- KEYS(MKLCFA) = IQ(LENTRY(1)+KOFUFA+MLOCFA)
- KEYS(MKMTFA) = IQ(LENTRY(1)+KOFUFA+MMTPFA)
- KEYS(MKNBFA) = MKNBFA
-
- CALL FMVERI(GENAME,LENTRY(1),KEYS,'A',IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GT.-3) PRINT *,'FMREPL. errors detected by FMVERI - '
- + ,'entry will not be added to catalogue'
- RETURN
- ENDIF
-
- CALL FMFZO(COMM,GENAME,LENTRY(1),KEYS,IRC)
-
- END
-
diff --git a/src/packlib/fatmen/fmint/fmrin.F b/src/packlib/fatmen/fmint/fmrin.F
deleted file mode 100644
index 2acc5a6..0000000
--- a/src/packlib/fatmen/fmint/fmrin.F
+++ /dev/null
@@ -1,118 +0,0 @@
-*
-* $Id: fmrin.F,v 1.1.1.1 1996/03/07 15:18:10 mclareni Exp $
-*
-* $Log: fmrin.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:10 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
-#if defined(CERNLIB_CZ)
- SUBROUTINE FMRIN (PATHN, FNAME, IUDIV, LSUP, JBIAS, NWKEY, KEYS)
-*
-************************************************************************
-*
-* SUBR. FMRIN (PATHN, FNAME, IUDIV, *LSUP*, JBIAS, *NWKEY*, KEYS*)
-*
-* Inputs one data structure from remote Zebra server
-*
-* Arguments :
-*
-* PATHN Path name of the directory
-* FNAME file name (character*20)
-* IUDIV Division index where the data structure exists
-* LSUP Address supporting the data structure
-* JBIAS < 1 : LSUP is the supporting bank and JBIAS is the link
-* bias specifying where the data structure has to
-* be introduced
-* = 1 : LSUP is the supporting link
-* = 2 : Stand alone data structure with address at LSUP
-* NWKEY Maximum size available for KEYS vector
-* On return it carries the actual size of the KEYS
-* KEYS Key vector
-*
-* Called by User
-*
-* Error Condition :
-*
-* IQUEST(1) = 0 : No error
-* = 11 : Illegal Path name
-*
-************************************************************************
-*
-#include "fatmen/fmpath.inc"
-#include "fatmen/fatbank.inc"
-#include "fatmen/fatpara.inc"
-#include "fatmen/fatsys.inc"
- DIMENSION IQSAVE(100)
- CHARACTER*80 LINE
- CHARACTER PATHN*255, FNAME*20
- DIMENSION LSUP(9), KEYS(*)
- PARAMETER (MAXKEY=500)
- PARAMETER (LKEYFA=10)
- DIMENSION KEYV(LKEYFA,MAXKEY)
-*
-* ------------------------------------------------------------------
-*
-* *** Find number of characters in the path name
-*
- NCH = LENOCC (PATHN)
- IF (NCH.LT.3.OR.PATHN(1:2).NE.'//') THEN
- IQUEST(1) = 11
- IF (IDEBFA.GT.-3) WRITE (LPRTFA, 1001) PATHN(1:NCH)
- GO TO 999
- ENDIF
- LFILE = LENOCC(FNAME)
-*
-* Get keys from remote server
-*
- CALL CZPUTA('MESS :KE',ISTAT)
- NKEYS = 0
- IFOUND = 1
-1 CONTINUE
-
- CALL CZGETA(LINE,ISTAT)
-*
- IF (LINE(1:1) .EQ. '0') GOTO 2
- IF (INDEX(LINE,'No files found') .NE. 0) THEN
- IFOUND = 0
- ELSE
- NKEYS = NKEYS + 1
- READ(LINE,9001) (KEYV(J,NKEYS),J=1,10)
- ENDIF
-
-9001 FORMAT(2X,I5,5A4,4I5)
- IF (LINE(1:1) .EQ. '2') GOTO 1
-2 CONTINUE
- IF (IFOUND .EQ. 0) GOTO 20
-*
-* Loop over keys returned
-*
- IFOUND = 0
- DO 10 I=1,NKEYS
- CALL UHTOC(KEYV(MKFNFA,I),4,FILE2,(MKCLFA-MKFNFA)*4)
- LFILE2 = MIN(LENOCC(FILE2),20)
-
- IF ((FILE2(1:1) .EQ. ' ') .OR.
- + (FILE2(1:LFILE2) .NE. FNAME(1:LFILE))) GOTO 10
-*
-* Get banks from remote server
-*
- WRITE(LINE,9011) (KEYV(J,I),J=1,10)
-9011 FORMAT(' XX',I5,5A4,4I5)
- CALL CZPUTA('MESS :IN'//LINE,ISTAT)
- NH = 100
- CALL FZIN(999,IUDIV,LSUP,JBIAS,' ',NH,IQSAVE)
- CALL DZSHOW('FMRIN.',IUDIV,LSUP,'B',0,0,0,0)
- CALL UCOPY(IQSAVE,IQUEST,100)
- CALL UCOPY(KEYV(I,1),KEYS,10)
-10 CONTINUE
-20 CONTINUE
-
- 1001 FORMAT (/,' FMRIN : Illegal path name ',A)
- 1003 FORMAT (/,' FMRIN : Error in RZIN for ',A)
- 1004 FORMAT (/,' FMRIN : File ',A,' not found')
-* END FMRIN
-999 END
-
-#endif
diff --git a/src/packlib/fatmen/fmint/fmrm.F b/src/packlib/fatmen/fmint/fmrm.F
deleted file mode 100644
index 5ba151d..0000000
--- a/src/packlib/fatmen/fmint/fmrm.F
+++ /dev/null
@@ -1,116 +0,0 @@
-*
-* $Id: fmrm.F,v 1.1.1.1 1996/03/07 15:18:11 mclareni Exp $
-*
-* $Log: fmrm.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:11 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMRM(GENAME,L,KEYS,IRC)
-#include "fatmen/faust.inc"
-#include "fatmen/fatpara.inc"
-#include "fatmen/fatbank.inc"
-#include "fatmen/fmpath.inc"
-*
-* If key serial number is non-zero, use that
-*
- CHARACTER*(*) GENAME
- CHARACTER*4 COMM
- CHARACTER*8 ACCT,ACNT
- PARAMETER (LKEYFA=10)
-#include "fatmen/fmaxcop.inc"
- DIMENSION KEYS(LKEYFA)
- DIMENSION KEYSIN(LKEYFA)
- DIMENSION KEYSOU(LKEYFA,MAXCOP)
- INTEGER FMACNT
-
- IRC = 0
- COMM = 'DEL '
- NCH = LENOCC(GENAME)
-*
-* Save current directory
-*
- CALL FACDIR(CDIR,'R')
- LCDIR = LENOCC(CDIR)
-
- LFILE = INDEXB(GENAME(1:NCH),'/') -1
- FILE1 = GENAME(LFILE+2:NCH)
- CALL FACDIR(GENAME(1:LFILE),'U')
- LFILE = LENOCC(FILE1)
-*
-* Check how many copies of this dataset exist
-*
- CALL UCOPY(KEYS,KEYSIN,10)
-*
-* Don't compare media type, copy level or location code
-*
- KEYSIN(MKMTFA) = -1
- KEYSIN(MKCLFA) = -1
- KEYSIN(MKLCFA) = -1
- CALL FMSELK(GENAME(1:NCH),KEYSIN,KEYSOU,NMATCH,MAXCOP,IRC)
- IF(NMATCH.EQ.0) THEN
- IF(IDEBFA.GE.0)
- + PRINT *,'FMRM. found 0 matches for ',GENAME(1:NCH)
- IRC = 1
- GOTO 99
- ELSEIF((NMATCH.GT.1).AND.(KEYS(1).EQ.0)) THEN
- IF(IDEBFA.GE.0) THEN
- PRINT *,'FMRM. found ',NMATCH,' matches for ',GENAME(1:NCH)
- PRINT *,'FMRM. Please specify which copy is to be deleted'
- ENDIF
- IRC = 1
- GOTO 99
- ELSE
- DO 10 I=1,NMATCH
- IF((NMATCH.EQ.1).AND.(KEYS(1).EQ.0)) THEN
- CALL UCOPY(KEYSOU(1,1),KEYS,10)
- GOTO 20
- ENDIF
- IF(KEYS(1).EQ.KEYSOU(1,I)) GOTO 20
- 10 CONTINUE
- PRINT *,'FMRM. no match for key specified'
- IRC = -1
- GOTO 99
- 20 CONTINUE
- LTDSFA = 0
- CALL FMGETK(GENAME(1:NCH),LTDSFA,KEYSOU(1,I),IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMRM. Return code ',IRC,' from '
- + //'FMGETK'
- GOTO 99
- ENDIF
- ENDIF
-*
-* Check account against that of creator, permitting account aliases
-*
- CALL UHTOC(IQ(LTDSFA+KOFUFA+MCIDFA),4,ACNT,8)
- IC = FMACNT(ACCT)
- CALL FMACCT(ACCT,ACNT,IRC)
-* IF (ACNT .NE. ACCT) THEN
- IF(IRC.NE.0) THEN
-
- WRITE(LPRTFA,*) 'You cannot delete this file'
- WRITE(LPRTFA,*) 'File is owned by ',ACNT,' current account = '
- + , ACCT
- IRC = 1
- GOTO 99
- ENDIF
-
- CALL FMVERI(GENAME,LTDSFA,KEYS,'A',IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMRM. error(s) detected ',
- + 'by FMVERI. Cannot perform deletion.'
- GOTO 99
- ENDIF
-
- NFRMFL = NFRMFL + 1
- CALL FMFZO(COMM,GENAME,LTDSFA,KEYS,IRC)
-
- 99 CONTINUE
-*
-* Reset current directory
-*
- CALL FACDIR(CDIR(1:LCDIR),' ')
- RETURN
- END
diff --git a/src/packlib/fatmen/fmint/fmrmdr.F b/src/packlib/fatmen/fmint/fmrmdr.F
deleted file mode 100644
index 862bca6..0000000
--- a/src/packlib/fatmen/fmint/fmrmdr.F
+++ /dev/null
@@ -1,68 +0,0 @@
-*
-* $Id: fmrmdr.F,v 1.1.1.1 1996/03/07 15:18:11 mclareni Exp $
-*
-* $Log: fmrmdr.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:11 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMRMDR(GENAME,IRC)
-#include "fatmen/faust.inc"
-#include "fatmen/fatpara.inc"
-#include "fatmen/fatbank.inc"
- CHARACTER*4 COMM
- CHARACTER*(*) GENAME
- CHARACTER*20 SUBDIR
- PARAMETER (LKEYFA=10)
- DIMENSION KEYS(LKEYFA)
-
- NFRDIR = NFRDIR + 1
-
- IRC = 0
-*
-* Set current directory to the one to be deleted
-*
- LGN = LENOCC(GENAME)
- CALL FACDIR(GENAME(1:LGN),' ')
-*
-* Check that directory is empty
-*
- CALL RZRDIR(1,SUBDIR,NDIR)
- IF (NDIR .GT. 0) THEN
- WRITE(LPRTFA,9001) GENAME(1:LGN),IQUEST(11)
-9001 FORMAT(' FMRMDR. Cannot delete directory ',A,' - ',
- + ' # of subdirectories = ',I10)
- IRC = 99
- GOTO 99
- ENDIF
-*
-* Get keys from current directory
-*
- CALL RZKEYS(LKEYFA,1,KEYS,NKEYS)
- IF (NKEYS .GT. 0) THEN
- WRITE(LPRTFA,9002) GENAME(1:LGN),NKEYS
-9002 FORMAT(' FMRMDR. Cannot delete directory ',A,' - ',
- + ' # of files = ',I10)
- IRC = 99
- GOTO 99
- ENDIF
- L = 0
- CALL FMVERI(GENAME(1:LGN),L,KEYS,'G',IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GT.-3) PRINT 9003
-9003 FORMAT(' FMRMDR. errors detected by FMVERI -',
- + ' update will not be processed')
- RETURN
- ENDIF
-
- COMM = 'DDIR'
- CALL FMFZO(COMM,GENAME,L,KEYS,IRC)
- 99 CONTINUE
-*
-* Reset current directory
-*
- CALL FACDIR(GENAME(1:LGN),' ')
-
- RETURN
- END
diff --git a/src/packlib/fatmen/fmint/fmrmln.F b/src/packlib/fatmen/fmint/fmrmln.F
deleted file mode 100644
index d9e0381..0000000
--- a/src/packlib/fatmen/fmint/fmrmln.F
+++ /dev/null
@@ -1,74 +0,0 @@
-*
-* $Id: fmrmln.F,v 1.1.1.1 1996/03/07 15:18:13 mclareni Exp $
-*
-* $Log: fmrmln.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:13 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMRMLN(CHLINK,LUN,CHFILE,CHOPT,IRC)
-*
-* Remove links, links and source files, find dangling links
-* etc.
-*
-#include "fatmen/faust.inc"
- CHARACTER*(*) CHLINK,CHFILE
- LOGICAL IOPEN
- EXTERNAL FALN
-#include "fatmen/falncm.inc"
-#include "fatmen/fmnkeys.inc"
-#include "fatmen/fatbank.inc"
-#include "fatmen/fatpara.inc"
-#include "fatmen/fatopts.inc"
-*
-* Options: P - print names of dangling links
-* D - write names of dangling links in 'rm ksn' format
-* R - remove dangling links
-* F - redirect output to CHFILE on LWRITE
-*
- NFRLNK = NFRLNK + 1
- IOPTTD = IOPTD
- IOPTTF = IOPTF
- IOPTTP = IOPTP
- IOPTTR = IOPTR
- IRC = 0
- NFILES = 0
- NLINKS = 0
- LLINK = LENOCC(CHLINK)
- LFILE = LENOCC(CHFILE)
- IF(IDEBFA.GE.1) PRINT *,'FMRMLN. enter for ',CHLINK(1:LLINK)
- IF(LUN.EQ.0) THEN
- LWRITE = LPRTFA
- ELSE
- LWRITE = LUN
- ENDIF
-*
-* Open output file if requested
-*
- IF(IOPTF.NE.0) THEN
- INQUIRE(LWRITE,OPENED=IOPEN)
- IF(.NOT.IOPEN) THEN
- CALL FAFILE(LWRITE,CHFILE,IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.-3) PRINT 9001,CHFILE(1:LFILE),LWRITE
- GOTO 999
- ENDIF
- ENDIF
- ENDIF
-*
-* scan for links
-*
- CALL FALINK(CHLINK(1:LLINK),99,FALN,IRC)
-*
-* Close the output file if we opened it
-*
- IF(IOPTF.NE.0.AND..NOT.IOPEN) CLOSE(LWRITE)
-
- 9001 FORMAT(' FMRMLN. error ',I6,' opening output file ',A,
- + ' on unit ',I2)
- WRITE(LPRTFA,9002) NLINKS,NFILES
- 9002 FORMAT(' FMRMLN. total of ',I6,' dangling links found, ',I6,
- + ' files processed')
-
- 999 END
diff --git a/src/packlib/fatmen/fmint/fmsear.F b/src/packlib/fatmen/fmint/fmsear.F
deleted file mode 100644
index 331db27..0000000
--- a/src/packlib/fatmen/fmint/fmsear.F
+++ /dev/null
@@ -1,214 +0,0 @@
-*
-* $Id: fmsear.F,v 1.1.1.1 1996/03/07 15:18:11 mclareni Exp $
-*
-* $Log: fmsear.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:11 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMSEAR(GENAM,LFAT,KEYS,DSN,HOST,VID,
- + USER,UFORM,COMM,IRC)
-#include "fatmen/fmpath.inc"
-#include "fatmen/fatpara.inc"
-#include "fatmen/fatbank.inc"
-#include "fatmen/fatout.inc"
-#include "fatmen/fatsea.inc"
- CHARACTER*(*) GENAM,DSN,HOST,VID,USER,UFORM,COMM
- CHARACTER*256 CHDSN
- CHARACTER*8 CHHOST
- CHARACTER*8 CHUSER
- CHARACTER*8 CHVID
- CHARACTER*4 CHFORM
- CHARACTER*80 CHCOMM
-#include "fatmen/fmnkeys.inc"
- DIMENSION KEYS(LKEYFA)
-*
-* Check bank for DSN/HOST/VID/USER
-*
- IRC = 0
- LGEN = LENOCC(GENAM)
-
- IF(IDEBFA.GE.1) PRINT *,'FMSEAR. enter for ',GENAM(1:LGEN)
-
- IF(LENOCC(OUTPUT).EQ.0) THEN
- LWRITE = LPRTFA
- ELSE
- LWRITE = 3
- ENDIF
- IF(LFAT.EQ.0) THEN
- CALL FMGETK(GENAM(1:LGEN),LBANK,KEYS,IRC)
- IF(IRC.NE.0) THEN
- WRITE (LWRITE,*) 'FMSEAR. Return code ',IRC,' from FMGETK'
- RETURN
- ENDIF
- LBANK = LBANK + KOFUFA
- ELSE
- IF(IDEBFA.GE.1)
- + WRITE(LWRITE,* )
- + 'FMSEAR. Enter for user-supplied bank at address ',LFAT
- LBANK = LFAT + KOFUFA
- ENDIF
-
- CHDSN = ' '
- CALL UHTOC(IQ(LBANK+MFQNFA),4,CHDSN,NFQNFA)
- CALL CLTOU(CHDSN)
- CHHOST = ' '
- CALL UHTOC(IQ(LBANK+MHSNFA),4,CHHOST,NHSNFA)
- CALL CLTOU(CHHOST)
- CHVID = ' '
- CALL UHTOC(IQ(LBANK+MVIDFA),4,CHVID,NVIDFA)
- CALL CLTOU(CHVID)
- CHUSER = ' '
- CALL UHTOC(IQ(LBANK+MCURFA),4,CHUSER,NCURFA)
- CALL CLTOU(CHUSER)
- CALL UHTOC(IQ(LBANK+MFUTFA),4,CHFORM,NFUTFA)
- CALL CLTOU(CHFORM)
- CHCOMM = ' '
- CALL UHTOC(IQ(LBANK+MUCMFA),4,CHCOMM,NUCMFA)
- CALL CLTOU(CHCOMM)
-
- JDSN = LENOCC(CHDSN)
- JHOST = LENOCC(CHHOST)
- JVID = LENOCC(CHVID)
- JUSER = LENOCC(CHUSER)
- JFORM = LENOCC(CHFORM)
- JCOMM = LENOCC(CHCOMM)
-
- LDSN = LENOCC(DSN)
- LHOST = LENOCC(HOST)
- LVID = LENOCC(VID)
- LUSER = LENOCC(USER)
- LFORM = LENOCC(UFORM)
- LCOMM = LENOCC(COMM)
-
- IF(LDSN.NE.0) THEN
- IF(IDEBFA.GE.2) PRINT *,'FMSEAR. comparing DSN'
- CALL FMATCH(CHDSN(1:JDSN),DSN(1:LDSN),IRC)
- IF(IRC.NE.0) THEN
- IRC = -1
- GOTO 99
- ENDIF
- ENDIF
-
- IF(LHOST.NE.0) THEN
- IF(IDEBFA.GE.2) PRINT *,'FMSEAR. comparing HOST'
- CALL FMATCH(CHHOST(1:JHOST),HOST(1:LHOST),IRC)
- IF(IRC.NE.0) THEN
- IRC = -2
- GOTO 99
- ENDIF
- ENDIF
-
- IF(LVID.NE.0) THEN
- IF(IDEBFA.GE.2) PRINT *,'FMSEAR. comparing VID'
- CALL FMATCH(CHVID(1:JVID),VID(1:LVID),IRC)
- IF(IRC.NE.0) THEN
- IRC = -3
- GOTO 99
- ENDIF
- ENDIF
-
- IF(LUSER.NE.0) THEN
- IF(IDEBFA.GE.2) PRINT *,'FMSEAR. comparing USERNAME'
- CALL FMATCH(CHUSER(1:JUSER),USER(1:LUSER),IRC)
- IF(IRC.NE.0) THEN
- IRC = -4
- GOTO 99
- ENDIF
- ENDIF
-
- IF(LFORM.NE.0) THEN
- IF(IDEBFA.GE.2) PRINT *,'FMSEAR. comparing USER file format'
- CALL FMATCH(CHFORM(1:JFORM),UFORM(1:LFORM),IRC)
- IF(IRC.NE.0) THEN
- IRC = -5
- GOTO 99
- ENDIF
- ENDIF
-
- IF(LCOMM.NE.0) THEN
- IF(IDEBFA.GE.2) PRINT *,'FMSEAR. comparing USER comment'
- CALL FMATCH(CHCOMM(1:JCOMM),COMM(1:LCOMM),IRC)
- IF(IRC.NE.0) THEN
- IRC = -6
- GOTO 99
- ENDIF
- ENDIF
-
- IF(IDCREA.GE.0) THEN
- IF(IDEBFA.GE.2) PRINT *,'FMSEAR. comparing creation date'
- CALL FMUPTM(LDCREA,LTCREA,IQ(LBANK+MCRTFA),IC)
-
- IF((LDCREA.LT.IDCREA).OR. (LDCREA.GT.JDCREA)) THEN
- IRC = -7
- GOTO 99
- ENDIF
- IF((LDCREA.EQ.IDCREA).AND.(LTCREA.LT.ITCREA)) THEN
- IRC = -7
- GOTO 99
- ENDIF
- IF((LDCREA.EQ.JDCREA).AND.(LTCREA.GT.JTCREA)) THEN
- IRC = -7
- GOTO 99
- ENDIF
-
- ENDIF
-
- IF(IDCATA.GE.0) THEN
- IF(IDEBFA.GE.2) PRINT *,'FMSEAR. comparing date catalogued'
- CALL FMUPTM(LDCATA,LTCATA,IQ(LBANK+MCTTFA),IC)
-
- IF((LDCATA.LT.IDCATA).OR. (LDCATA.GT.JDCATA)) THEN
- IRC = -8
- GOTO 99
- ENDIF
- IF((LDCATA.EQ.IDCATA).AND.(LTCATA.LT.ITCATA)) THEN
- IRC = -8
- GOTO 99
- ENDIF
- IF((LDCATA.EQ.JDCATA).AND.(LTCATA.GT.JTCATA)) THEN
- IRC = -8
- GOTO 99
- ENDIF
-
- ENDIF
-
- IF(IDLAST.GE.0) THEN
- IF(IDEBFA.GE.2) PRINT *,'FMSEAR. comparing date last accessed'
- CALL FMUPTM(LDLAST,LTLAST,IQ(LBANK+MLATFA),IC)
-
- IF((LDLAST.LT.IDLAST).OR. (LDLAST.GT.JDLAST)) THEN
- IRC = -9
- GOTO 99
- ENDIF
- IF((LDLAST.EQ.IDLAST).AND.(LTLAST.LT.ITLAST)) THEN
- IRC = -9
- GOTO 99
- ENDIF
- IF((LDLAST.EQ.JDLAST).AND.(LTLAST.GT.JTLAST)) THEN
- IRC = -9
- GOTO 99
- ENDIF
-
- ENDIF
-*
-* Compare user words
-*
- IF(IDEBFA.GE.2) PRINT *,'FMSEAR. comparing user words'
- DO 10 I=1,10
- IF(IUSER(1,I).EQ.-1) GOTO 10
- IF((IQ(LBANK+MUSWFA+I-1).LT.IUSER(1,I)).OR.
- + (IQ(LBANK+MUSWFA+I-1).GT.IUSER(2,I))) THEN
- IRC = -9
- GOTO 99
- ENDIF
- 10 CONTINUE
-
- RETURN
-
- 99 CONTINUE
- IF((IDEBFA.GE.1).AND.(IRC.NE.0))
- + PRINT *,'FMSEAR. comparison failed - status = ',IRc
-
- END
diff --git a/src/packlib/fatmen/fmint/fmselb.F b/src/packlib/fatmen/fmint/fmselb.F
deleted file mode 100644
index 29b4e37..0000000
--- a/src/packlib/fatmen/fmint/fmselb.F
+++ /dev/null
@@ -1,57 +0,0 @@
-*
-* $Id: fmselb.F,v 1.1.1.1 1996/03/07 15:18:09 mclareni Exp $
-*
-* $Log: fmselb.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:09 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMSELB(GENAM,KEYSIN,NKEYS,UEXIT,ISEL,IRC)
-*
-* This routine allows the user to select a copy of a dataset
-* based upon the information in the FATMEN bank
-*
-* Input:
-* GENAM - the generic name in question
-* KEYSIN - the result of a call to FMSELK
-* For each file FMSELB will obtain the corresponding FATMEN
-* bank and pass it to the user-exit routine as follows:
-* CALL USER-EXIT(GENAM,LBANK,KEYS,NKEYS,N,ISEL,IRC)
-* NKEYS = number of candidates
-* N = number of this candidate
-* ISEL = index of candidate selected
-* On the last call to USER-EXIT it should return
-* the index of the candidate selected, or zero.
-#include "fatmen/fatbank.inc"
- EXTERNAL UEXIT
- CHARACTER*(*) GENAM
- PARAMETER (LKEYFA=10)
- DIMENSION KEYSIN(LKEYFA,NKEYS)
- IRC = 0
- ISEL = 0
-*
-* Loop over all candidates
-*
- DO 10 I=1,NKEYS
- CALL FMGETK(GENAM,LBANK,KEYSIN(1,I),IRC)
-
- IF((IRC.NE.0) .AND. (IDEBFA.GT.-3)) THEN
- PRINT *,'FMSELB. Return code ',IRC,' from FMGETK.'
- GOTO 10
- ENDIF
-
- CALL UEXIT(GENAM,LBANK,KEYS,NKEYS,I,ISEL,IRC)
- IF((IRC.NE.0) .AND. (IDEBFA.GT.-3)) THEN
- PRINT *,'FMSELB. Return code ',IRC,' from user exit routine'
- GOTO 10
- ENDIF
-
-10 CONTINUE
-*
-* Have we got a selection?
-*
- IF(ISEL.EQ.0) IRC = -1
-
- END
-
diff --git a/src/packlib/fatmen/fmint/fmselk.F b/src/packlib/fatmen/fmint/fmselk.F
deleted file mode 100644
index 1c10128..0000000
--- a/src/packlib/fatmen/fmint/fmselk.F
+++ /dev/null
@@ -1,161 +0,0 @@
-*
-* $Id: fmselk.F,v 1.1.1.1 1996/03/07 15:18:09 mclareni Exp $
-*
-* $Log: fmselk.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:09 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMSELK(GENAM,KEYSIN,KEYSOU,NDONE,MAXKEY,IRC)
-*
-* This subroutine matches the input key vector KEYSIN
-* against the keys in the directory specified by the
-* the generic name GENAM. A maximum of MAXKEY key vectors
-* are returned in the arrary KEYSOU. NDONE returns the
-* actual number of vectors returned.
-* IRC =-1 invalid pathname
-* = 0 success
-* = 1 more than NMAX files in CWD
-* IQUEST(11) = number of matching files in CWD
-* IQUEST(12) = total number of files in CWD
-*
-#include "fatmen/faust.inc"
-#include "fatmen/fatbug.inc"
-#include "fatmen/fatpara.inc"
-#include "zebra/rzcl.inc"
-#include "zebra/rzk.inc"
- CHARACTER*(*) GENAM
- CHARACTER*255 PATH
- CHARACTER*20 FNAME
- PARAMETER (LKEYFA=10)
-*
-* NMAX limits the maximum number of keys that can be processed
-* in a single call to FMKEYS
-*
- PARAMETER (NMAX=100)
- DIMENSION KEYS(LKEYFA),MYVECT(LKEYFA)
- DIMENSION KEYSIN(LKEYFA),KEYSOU(LKEYFA,MAXKEY)
- DIMENSION MYKEYS(LKEYFA,NMAX),KEYTMP(LKEYFA)
-
- IRC = 0
-
- NFSELK = NFSELK + 1
-*
-* Check for wild-cards in generic-name
-*
- LGN = LENOCC(GENAM)
- IWILD = ICFMUL('*%(<>[]',GENAM,1,LGN)
- IF(IWILD.LE.LGN) THEN
- PATH = ' '
- PATH(IWILD:IWILD+3) = '^---'
- WRITE(LPRTFA,9001) GENAM(1:LGN),PATH(1:IWILD+3)
-9001 FORMAT(' FMSELK. wild-cards not permitted in generic name',/,
- + 1X,A,/,1X,A)
- IRC = 13
- RETURN
- ENDIF
-
-*
-* Convert generic name to upper case
-*
- CALL CLTOU(GENAM)
-*
-* Save current directory
-*
- CALL FACDIR(PATH,'R')
-*
-* Reset current directory
-*
- LGEN = INDEXB(GENAM,'/')
- CALL FACDIR(GENAM(1:LGEN-1),'U')
- IF(IQUEST(1).NE.0) GOTO 80
-
- IF(LQRS.EQ.0) GOTO 80
- IF(LCDIR.EQ.0) GOTO 80
- LS = IQ(KQSP+LCDIR+KLS)
- LK = IQ(KQSP+LCDIR+KLK)
- NK = IQ(KQSP+LCDIR+KNKEYS)
- NWK = IQ(KQSP+LCDIR+KNWKEY)
- NKEYS = NK
- NWKEY = NWK
-*
-* Build compare vector
-*
- CALL VZERO(MYVECT,LKEYFA)
- CALL UCOPY(KEYSIN(MKCLFA),MYVECT(MKCLFA),LKEYFA-MKCLFA+1)
- IFIRST = 1
- ILAST = NMAX
- NDONE = 0
-*
-* *** Find file name
-*
- NCH = LENOCC(GENAM)
- FNAME = GENAM(LGEN+1:NCH)
- CALL VBLANK(MYVECT(2),5)
- CALL UCTOH(FNAME,MYVECT(2),4,MIN(NCH-LGEN,20))
-
- IF(IDEBFA.GE.3) PRINT *,'FMSELK. enter for ',GENAM(1:NCH)
- IF(IDEBFA.GE.3) CALL FMPKEY(MYVECT,LKEYFA)
-*
-* Convert file name to Z format
-*
- CALL ZHTOI(MYVECT(MKFNFA),MYVECT(MKFNFA),MKCLFA-MKFNFA)
- 10 CONTINUE
-*
-* Process all keys returned and move those that match to KEYSOU
-*
- NDONE = 0
- DO 60 I=1,NKEYS
-
- IF(NDONE.GE.MAXKEY) THEN
- IRC = 1
- GOTO 80
- ENDIF
-
- NDONE = NDONE + 1
- K = LK+(NWK+1)*(I-1)
-*
-* Find end of range
-*
- DO 20 J=NWK-1,MKCLFA,-1
- IF(MYVECT(J).NE.-1) GOTO 30
- 20 CONTINUE
- 30 JEND = MIN(MKLCFA,J)
-*
-* Check file name, media type, copy level and location code
-* (essentially just keys(2-9)
-*
- DO 40 J=MKFNFA,JEND
-*
-* Don't compare negative fields
-*
- IF(MYVECT(J).LT.0.AND.J.GE.MKCLFA) GOTO 40
- IF(MYVECT(J).NE.IQ(KQSP+LCDIR+K+J)) THEN
- NDONE = NDONE - 1
- GOTO 60
- ENDIF
- 40 CONTINUE
-
- DO 50 J=1,NWK
- IKDES=(J-1)/10
- IKBIT1=3*J-30*IKDES-2
- IF(JBYT(IQ(KQSP+LCDIR+KKDES+IKDES),IKBIT1,3).LT.3)THEN
- KEYSOU(J,NDONE)=IQ(KQSP+LCDIR+K+J)
- ELSE
- CALL ZITOH(IQ(KQSP+LCDIR+K+J),KEYSOU(J,NDONE),1)
- ENDIF
- 50 CONTINUE
-
- IF(IDEBFA.GE.3) THEN
- PRINT *,'FMSELK. match # ',NDONE
- CALL FMPKEY(KEYSOU(1,NDONE),LKEYFA)
- ENDIF
- 60 CONTINUE
-
- 70 CALL FACDIR(PATH(1:LENOCC(PATH)),' ')
- IQUEST(11) = NDONE
- IQUEST(12) = NKEYS
- RETURN
- 80 IRC = -1
- END
diff --git a/src/packlib/fatmen/fmint/fmselm.F b/src/packlib/fatmen/fmint/fmselm.F
deleted file mode 100644
index d760244..0000000
--- a/src/packlib/fatmen/fmint/fmselm.F
+++ /dev/null
@@ -1,203 +0,0 @@
-*
-* $Id: fmselm.F,v 1.3 1996/06/18 15:57:37 jamie Exp $
-*
-* $Log: fmselm.F,v $
-* Revision 1.3 1996/06/18 15:57:37 jamie
-* revert
-*
-* Revision 1.2 1996/06/18 15:03:13 jamie
-* ensure IWANT is set
-*
-* Revision 1.1.1.1 1996/03/07 15:18:12 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMSELM(GENAM,LBANK,KEYS,KEYM,NK,CHOPT,IRC)
-*CMZ : 16/10/91 17.14.49 by Jamie Shiers
-*-- Author : Jamie Shiers 16/10/91
-#include "fatmen/fatbank.inc"
-#include "fatmen/fatpara.inc"
-#include "fatmen/fmnkeys.inc"
- CHARACTER*(*) GENAM
- CHARACTER*8 HOST,FFORM
- CHARACTER*255 DSN,CHFILE
- PARAMETER (MAXKEY=100)
- DIMENSION KEYS(LKEYFA),KEYM(LKEYFA,NK)
- DIMENSION KEYZ(LKEYFA,MAXKEY)
- INTEGER FMNODE
-#include "fatmen/fatopts.inc"
-
- LGN = LENOCC(GENAM)
- LCH = LENOCC(CHOPT)
- IRC = 0
- LBANK = 0
-
- IF(IDEBFA.GE.1) PRINT *,'FMSELM. enter for generic-name ',
- + ' / chopt = ',GENAM(1:LGN),' / ',CHOPT
-
- IF(IOPTM.NE.0.AND.IOPTR.NE.0) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMSELM. error - both options ',
- + 'R and M must not be set'
- IRC = 1
- RETURN
- ENDIF
-
- IF(IOPTR.NE.0) IWANT = 1
- IF(IOPTM.NE.0) IWANT = 0
-*
-* Count number of files that match input generic name
-*
- CALL FMFILC(GENAM(1:LGN),NFILES,IRC)
- IF(IDEBFA.GE.1) PRINT *,'FMSELM. found ',NFILES,' entries ',
- + 'for specified generic-name'
-*
-* Can only accept 100
- DO 10 I=1,NK
- CALL FMSELK(GENAM(1:LGN),KEYM(1,I),KEYZ,NKEYZ,MAXKEY,IRC)
- IF(IDEBFA.GE.1) PRINT *,'FMSELM. found ',NKEYZ,' matches',
- + ' for selection # ',I
- JROBOT = 0
- JHUMAN = 0
- DO 20 J=1,NKEYZ
- CALL FMGETK(GENAM(1:LGN),LBANK,KEYZ(1,J),IRC)
- IF(IRC.EQ.0) THEN
-*
-* Check on robot/manual (if requested)
-*
- IF(KEYZ(MKMTFA,J).GT.1) THEN
- CALL FMQMED(GENAM,LBANK,KEYZ(1,J),IMEDIA,IROBOT,IRC)
- IF(IRC.NE.99.AND.IRC.NE.0) GOTO 40
- IF(LCH.GT.0) THEN
- IF(IROBOT.EQ.IWANT) THEN
- IRC = 0
- CALL UCOPY(KEYZ(1,J),KEYS,LKEYFA)
- GOTO 30
- ELSE
- IF(IDEBFA.GE.3) PRINT *,'FMSELM. candidate # ',
- + J, ' rejected on manual/robot check'
- ENDIF
- ELSE
- IF(JROBOT.EQ.0.AND.IROBOT.NE.0) JROBOT = J
- IF(JHUMAN.EQ.0.AND.IROBOT.EQ.0) JHUMAN = J
-* IRC = 0
-* CALL UCOPY(KEYZ(1,J),KEYS,LKEYFA)
-* GOTO 30
- ENDIF
- ELSE
-*
-* Check node name if option N
-*
- IF(IOPTN.NE.0) THEN
- CALL FMGETC(LBANK,HOST,MHSNFA,NHSNFA,IRC)
- IF(FMNODE(HOST).NE.0) GOTO 40
- ENDIF
-*
-* INQUIRE if dataset exists if option I
-*
- IF(IOPTI.NE.0) THEN
- CALL FMGETC(LBANK,DSN,MFQNFA,NFQNFA,IRC)
-#if defined(CERNLIB_CSPACK)
-*
-* ZEBRA exchange format files
-*
- IF(IOPTN.EQ.0)
- + CALL FMGETC(LBANK,HOST,MHSNFA,NHSNFA,IRC)
-*
-* Does node name match?
-*
- IF(FMNODE(HOST).EQ.0) THEN
-*
-* Yes, just issue inquire
-*
- CALL FAINQR(DSN,' ',CHFILE,IRC)
- IF(IRC.NE.0) GOTO 40
- ELSE
-*
-* No, if ZEBRA exchange format file, see if we could reach
-* remote node using CSPACK
-*
- CALL FMGETC(LBANK,FFORM,MFLFFA,NFLFFA,IRC)
- IF(FFORM(1:3).NE.'FXN'.AND.
- + INDEX(FFORM,'FX').NE.0) THEN
- CALL FMNTRC(HOST,FFORM,IRC)
- IF(IRC.NE.0) GOTO 40
- ELSE
- GOTO 40
- ENDIF
- ENDIF
-#endif
-#if defined(CERNLIB_FPACK)
-*
-* If node name does not match, then check .netrc file for host name
-*
- IF(IOPTN.EQ.0)
- + CALL FMGETC(LBANK,HOST,MHSNFA,NHSNFA,IRC)
- IF(FMNODE(HOST).NE.0) THEN
- CALL FMGETC(LBANK,FFORM,MFLFFA,NFLFFA,IRC)
-*
-* FPACK files...
-*
- IF(FFORM(1:2).EQ.'FP') THEN
- CALL FMNTRC(HOST,'FP',IRC)
- IF(IRC.NE.0) GOTO 40
- ELSE
- CALL FAINQR(DSN,' ',CHFILE,IRC)
- IF(IRC.NE.0) GOTO 40
- ENDIF
- ELSE
-*
-* Other files, or local FPACK files...
-*
- CALL FAINQR(DSN,' ',CHFILE,IRC)
- IF(IRC.NE.0) GOTO 40
- ENDIF
-#endif
-#if (!defined(CERNLIB_FPACK))&&(!defined(CERNLIB_CSPACK))
- CALL FAINQR(DSN,' ',CHFILE,IRC)
- IF(IRC.NE.0) GOTO 40
-#endif
- ENDIF
-
- CALL UCOPY(KEYZ(1,J),KEYS,LKEYFA)
- GOTO 30
- ENDIF
- ELSE
- IF(IDEBFA.GE.1) PRINT *,'FMSELM. return code ',
- + IRC,' from FMGETK for candidate # ',I
- ENDIF
-
- 40 CONTINUE
-
- CALL MZDROP(IDIVFA,LBANK,'L')
- LBANK = 0
-
- 20 CONTINUE
-
- IF(JROBOT.NE.0) THEN
- IF(IDEBFA.GE.3) PRINT *,'FMSELM. candidate # ',
- + JROBOT, ' selected as best of the bunch'
- IRC = 0
- CALL UCOPY(KEYZ(1,JROBOT),KEYS,LKEYFA)
- CALL FMGETK(GENAM(1:LGN),LBANK,KEYS,IRC)
- GOTO 30
- ELSEIF(JHUMAN.NE.0) THEN
- IF(IDEBFA.GE.3) PRINT *,'FMSELM. candidate # ',
- + JHUMAN, ' selected as best of the bunch'
- IRC = 0
- CALL UCOPY(KEYZ(1,JHUMAN),KEYS,LKEYFA)
- CALL FMGETK(GENAM(1:LGN),LBANK,KEYS,IRC)
- GOTO 30
- ENDIF
-
- 10 CONTINUE
-
- IF(NFILES.EQ.0) THEN
- IRC = 14
- ELSE
- IRC = 15
- ENDIF
-
- 30 IQUEST(11) = NFILES
-
- END
diff --git a/src/packlib/fatmen/fmint/fmsho2.F b/src/packlib/fatmen/fmint/fmsho2.F
deleted file mode 100644
index 189fd69..0000000
--- a/src/packlib/fatmen/fmint/fmsho2.F
+++ /dev/null
@@ -1,168 +0,0 @@
-*
-* $Id: fmsho2.F,v 1.1.1.1 1996/03/07 15:18:11 mclareni Exp $
-*
-* $Log: fmsho2.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:11 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMSHO2(GNAME,LBANK,KEYS,CHOPT,IRC)
-*CMZ : 23/01/91 13.28.01 by Jamie Shiers
-*-- Author : Jamie Shiers 23/01/91
-*
-* Print alternative listing. Either 80 or 132 column format with
-* following details:
-*
-* Trimmed generic name, VID/Hostname, FFORM, DCB, FSIZE, NACCESS,
-* NDAYS since last access, NCOPIES, Type of this entry (D/R/M)
-*
-* Extended listing also includes Owner and DSN
-*
-#include "fatmen/fatsho.inc"
- CHARACTER*(*) GNAME,CHOPT
- CHARACTER*256 DSN
- CHARACTER*8 OWNER
- CHARACTER*4 RECFM,FFORM
- CHARACTER*3 FSIZE
- CHARACTER*1 FTYPE
- CHARACTER*6 VID
- CHARACTER*15 XVID
- CHARACTER*8 VIP
- CHARACTER*8 HOST
- CHARACTER*3 CHFSEQ
-#include "fatmen/fmnkeys.inc"
- DIMENSION KEYS(LKEYFA)
- DIMENSION NDAYS(3)
- LOGICAL IOPEN
-#include "fatmen/fatout.inc"
-#include "fatmen/fatbank.inc"
-#include "fatmen/fatpara.inc"
-#include "fatmen/tmsdef0.inc"
-#include "fatmen/fatoptd.inc"
-#include "fatmen/tmsdef1.inc"
-#include "fatmen/fatoptc.inc"
- IRC = 0
- LGN = LENOCC(GNAME)
- LCH = INDEXB(GNAME(1:LGN),'/') + 1
-
- INQUIRE(3,OPENED=IOPEN)
- IF((OUTPUT(1:3).EQ.'TTY').OR.
- + (LENOCC(OUTPUT).EQ.0) .OR.
- + (.NOT.IOPEN)) THEN
- LWRITE = LPRTFA
- ELSE
- LWRITE = 3
- ENDIF
-
- IF(GNAME(1:LCH-2).NE.CWDSHO) THEN
- IF(IDEBFA.GE.0) THEN
- WRITE(LWRITE ,*)
- WRITE(LWRITE,*) 'Directory: ',GNAME(1:LCH-2)
- WRITE(LWRITE,*)
- IF(IOPTB.NE.0) WRITE(LWRITE,9007)
- + 'Generic name','KSN','Host/VID','FSQ','FORM',
- + 'RECF','LRECL','LBLCK','#MB','#AC','L/A',
- + '#GN','T'
- IF(IOPTE.NE.0) WRITE(LWRITE,9008)
- + 'Generic name','KSN','Host/VID','FORM',
- + 'RECF','LRECL','LBLCK','#MB','#AC','L/A',
- + '#GN','T','Owner','FSQ','DSN'
- WRITE(LWRITE,*)
- ENDIF
- ENDIF
- CWDSHO = GNAME(1:LCH-2)
- ISIZE = IQ(LBANK+KOFUFA+MFSZFA)
- IUSE = IQ(LBANK+KOFUFA+MUSCFA)
- CALL UHTOC(IQ(LBANK+KOFUFA+MCURFA),4,OWNER,8)
- CALL UHTOC(IQ(LBANK+KOFUFA+MFLFFA),4,FFORM,4)
- CALL UHTOC(IQ(LBANK+KOFUFA+MRFMFA),4,RECFM,4)
- IF(IQ(LBANK+KOFUFA+MMTPFA).EQ.1) THEN
- FTYPE = 'D'
- CHFSEQ = ' '
- CALL UHTOC(IQ(LBANK+KOFUFA+MHSNFA),4,HOST,8)
- ELSE
- CALL UHTOC(IQ(LBANK+KOFUFA+MVIDFA),4,VID,6)
- HOST = VID
- FTYPE = 'M'
- IF(IQ(LBANK+KOFUFA+MFSQFA).GT.999) THEN
- CHFSEQ = '***'
- ELSE
- WRITE(CHFSEQ,'(I3.3)') IQ(LBANK+KOFUFA+MFSQFA)
- ENDIF
-*
-* Query TMS for this VID
-* Set IQUEST(11) to media type in case volume unknown or
-* TMS option not installed.
-*
- IQUEST(11) = IQ(LBANK+KOFUFA+MMTPFA)
-#if defined(CERNLIB_PREFIX)
- CALL FMXVID(VID,IQ(LBANK+KOFUFA+MVIPFA),XVID,VIP,'C',IC)
- LXVID = LENOCC(XVID)
- CALL FMQTMS(XVID(1:LXVID),LIB,MODEL,DENS,MNTTYP,LABTYP,IC)
-#endif
-#if !defined(CERNLIB_PREFIX)
- CALL FMQTMS(VID,LIB,MODEL,DENS,MNTTYP,LABTYP,IC)
-#endif
- IF(IC.EQ.0) THEN
- FTYPE = MNTTYP
- ENDIF
- ENDIF
-* Number of days since last access = NDAYS(3)
- CALL FMDAYS(GNAME(1:LGN),LBANK,KEYS,NDAYS,' ',IC)
-*
- DSN = ' '
- CALL UHTOC(IQ(LBANK+KOFUFA+MFQNFA),4,DSN,NFQNFA)
- LDSN = MIN(LENOCC(DSN),40)
- CALL FMEXST(GNAME(1:LGN),NCOP)
- IFILE = IQ(LBANK+KOFUFA+MFSQFA)
-*
-* File size
-*
- IF(ISIZE.LE.999) THEN
- WRITE(FSIZE,9001) ISIZE
- ELSE
- WRITE(FSIZE,9002) ISIZE/1000
- ENDIF
- 9001 FORMAT(I3)
- 9002 FORMAT(I1,'GB')
-*
-* Option B: Brief listing
-*
- IF(IOPTB.NE.0) THEN
- IF(KEYS(1).LE.9999) THEN
- WRITE(LWRITE,9003) GNAME(LCH:LGN),KEYS(1),HOST,CHFSEQ,
- + FFORM, RECFM,IQ(LBANK+KOFUFA+MRLNFA),IQ(LBANK+KOFUFA+
- + MBLNFA), FSIZE,IUSE,NDAYS(3),NCOP,FTYPE
- ELSE
- WRITE(LWRITE,9003) GNAME(LCH:LGN),KEYS(1),HOST,CHFSEQ,
- + FFORM, RECFM,IQ(LBANK+KOFUFA+MRLNFA),IQ(LBANK+KOFUFA+
- + MBLNFA), FSIZE,IUSE,NDAYS(3),NCOP,FTYPE
- ENDIF
-*
-* Option E: Extended listing
-*
- ELSEIF(IOPTE.NE.0) THEN
- IF(KEYS(1).LE.9999) THEN
- WRITE(LWRITE,9005) GNAME(LCH:LGN),KEYS(1),HOST,FFORM,
- + RECFM, IQ(LBANK+KOFUFA+MRLNFA),IQ(LBANK+KOFUFA+MBLNFA),
- + FSIZE,IUSE,NDAYS(3),NCOP,FTYPE,OWNER,IFILE,DSN(1:LDSN)
- ELSE
- WRITE(LWRITE,9006) GNAME(LCH:LGN),KEYS(1),HOST,FFORM,
- + RECFM, IQ(LBANK+KOFUFA+MRLNFA),IQ(LBANK+KOFUFA+MBLNFA),
- + FSIZE,IUSE,NDAYS(3),NCOP,FTYPE,OWNER,IFILE,DSN(1:LDSN)
- ENDIF
- ENDIF
- 9003 FORMAT(1X,A20,1X,I4,1X,A8,1X,A3,1X,A4,1X,A4,1X,I5,1X,I5,1X,A3,1X,
- + I3,1X,I3,1X,I3,1X,A1)
- 9004 FORMAT(1X,A20,1X,I6,1X,A8,1X,A3,1X,A4,1X,A4,1X,I5,1X,I5,1X,A3,1X,
- + I3,1X,I3,1X,I3,1X,A1)
- 9005 FORMAT(1X,A20,1X,I4,1X,A8,1X,A4,1X,A4,1X,I5,1X,I5,1X,A3,1X,
- + I3,1X,I3,1X,I3,1X,A1,1X,A8,1X,I3,1X,A40)
- 9006 FORMAT(1X,A20,1X,I6,1X,A8,1X,A4,1X,A4,1X,I5,1X,I5,1X,A3,1X,
- + I3,1X,I3,1X,I3,1X,A1,1X,A8,1X,I3,1X,A40)
- 9007 FORMAT(1X,A20,1X,A4,1X,A8,1X,A3,1X,A4,1X,A4,1X,A5,1X,A5,1X,A3,1X,
- + A3,1X,A3,1X,A3,1X,A1)
- 9008 FORMAT(1X,A20,1X,A4,1X,A8,1X,A4,1X,A4,1X,A5,1X,A5,1X,A3,1X,
- + A3,1X,A3,1X,A3,1X,A1,1X,A8,1X,A3,1X,A40)
- END
diff --git a/src/packlib/fatmen/fmint/fmshow.F b/src/packlib/fatmen/fmint/fmshow.F
deleted file mode 100644
index f157156..0000000
--- a/src/packlib/fatmen/fmint/fmshow.F
+++ /dev/null
@@ -1,445 +0,0 @@
-*
-* $Id: fmshow.F,v 1.2 1999/08/11 13:06:49 jamie Exp $
-*
-* $Log: fmshow.F,v $
-* Revision 1.2 1999/08/11 13:06:49 jamie
-* print date in I6.6 for y2k
-*
-* Revision 1.1.1.1 1996/03/07 15:18:10 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMSHOW(GNAME,LFAT,KEYS,CHOPT,IRC)
-#include "fatmen/faust.inc"
-#include "fatmen/fattyp.inc"
-#include "fatmen/fmdrep.inc"
-#include "fatmen/fatlcc.inc"
-#include "fatmen/fmpath.inc"
-#include "fatmen/fatpara.inc"
-#include "fatmen/fatbank.inc"
-#include "fatmen/fatout.inc"
-#include "zebra/zunit.inc"
-#include "fatmen/fatusr.inc"
- CHARACTER*(*) GNAME,CHOPT
- CHARACTER*255 GENAM
- CHARACTER*255 CHTAG
- PARAMETER (LKEYFA=10)
- DIMENSION KEYS(LKEYFA)
- CHARACTER*20 FILE
- CHARACTER*80 COMM
- CHARACTER*4 FFORM,FLFRM,UFORM
- CHARACTER*256 DSN
- CHARACTER*6 VSN,VID
- CHARACTER*8 VIP
- CHARACTER*15 XVID
- CHARACTER*8 OWNER,ACCT,JOB,NODE
- CHARACTER*16 TYPE
- CHARACTER*12 CHOS
- CHARACTER*80 CHLINE
- DIMENSION IUSER(10)
- INTEGER FMISET
- LOGICAL IOPEN
-
-#include "fatmen/tmsdef0.inc"
-#include "fatmen/fatmed0.inc"
-#include "fatmen/fatvid0.inc"
-#include "fatmen/fatoptd.inc"
-#include "fatmen/tmsdef1.inc"
-#include "fatmen/fatmed1.inc"
-#include "fatmen/fatvid1.inc"
-#include "fatmen/fatoptc.inc"
-
- NFSHOW = NFSHOW + 1
-
- LCHOPT = LENOCC(CHOPT)
- IF(IOPTA.NE.0) THEN
-#include "fatmen/fatoset.inc"
- IF(INDEX(CHOPT,'B').EQ.0) IOPTB = 0
- IF(INDEX(CHOPT,'D').EQ.0) IOPTD = 0
- IF(INDEX(CHOPT,'E').EQ.0) IOPTE = 0
- IF(INDEX(CHOPT,'G').EQ.0) IOPTG = 0
- IF(INDEX(CHOPT,'Q').EQ.0) IOPTQ = 0
- IF(INDEX(CHOPT,'J').EQ.0) IOPTJ = 0
- IF(INDEX(CHOPT,'R').EQ.0) IOPTR = 0
- IF(INDEX(CHOPT,'Y').EQ.0) IOPTY = 0
- IF(INDEX(CHOPT,'Z').EQ.0) IOPTZ = 0
- ENDIF
-*
-* Print the bank entry corresponding to the input generic name
-*
- IRC = 0
- LGEN = LENOCC(GNAME)
- GENAM = GNAME(1:LGEN)
- CALL CLTOU(GENAM(1:LGEN))
-
- INQUIRE(3,OPENED=IOPEN)
- IF((OUTPUT(1:3).EQ.'TTY').OR.
- + (LENOCC(OUTPUT).EQ.0) .OR.
- + (.NOT.IOPEN)) THEN
- LWRITE = LPRTFA
- ELSE
- LWRITE = 3
- IF(IDEBFA.GE.3) PRINT *,'FMSHOW. output will be ',
- + 'redirected to ',OUTPUT
- ENDIF
-
- IF(LFAT.EQ.0) THEN
- CALL FMGETK(GENAM(1:LGEN),LBANK,KEYS,IRC)
- IF(IRC.NE.0) THEN
- WRITE (LWRITE,*) 'FMSHOW. Return code ',IRC,' from FMGETK'
- RETURN
- ENDIF
- LBANK = LBANK + KOFUFA
- ELSEIF(LFAT.EQ.-1) THEN
- CALL FMUPKY(GENAM(1:LGEN),LADDBK,KEYS,IRC)
- LBANK = LADDBK + KOFUFA
- ELSE
- CALL FMUPKY(GENAM(1:LGEN),LFAT,KEYS,IRC)
- IF(IDEBFA.GE.1)
- + WRITE(LWRITE,* )
- + 'FMSHOW. Enter for user-supplied bank at address ',LFAT
- LBANK = LFAT + KOFUFA
- ENDIF
-
- ICH = INDEXB(GENAM(1:LGEN),'/')
- FILE = GENAM(ICH+1:LGEN)
- LFILE = LENOCC(FILE)
-*
-* Option J : just files that are accessible
-*
- IF(IOPTJ.NE.0.OR.IOPTR.NE.0) THEN
-*
-* Show where the data Reside
-*
- CHLINE = ' '
-
- IF(IQ(LBANK+MMTPFA).EQ.1) THEN
-*
-* Disk files: show how the data would be accessed
-* (direct, VAXcluster, DFS, NFS, RFIO, FPACK, AFS, SFS, GIME)
-*
- CALL FADARE(GENAM(1:LGEN),LBANK-KOFUFA,KEYS,CHLINE,CHOPT,
- + IRC)
- ELSE
-*
-* Tape files: is volume in an active library?
-* does a device of the required type exist on this node?
-* a served device?
-* is it staged?
-*
- CALL FATARE(GENAM(1:LGEN),LBANK-KOFUFA,KEYS,CHLINE,CHOPT,
- + IRC)
- ENDIF
-
- IF(IOPTJ.NE.0.AND.IRC.NE.0) GOTO 10
-
- ENDIF
-*
-* Check whether we have any options for FMSHOW...
-*
- ISHOW = FMISET(CHOPT,'BDEIX')
-*
-* Unpack user comment for call to FMUPRT
-*
- COMM = ' '
- CALL UHTOC(IQ(LBANK+MUCMFA),4,COMM,80)
-*
-* Options B(rief) for 80 column listing, E(xtended) for 132 column listing
-*
- IF((IOPTB.NE.0).OR.(IOPTE.NE.0)) THEN
- CALL FMSHO2(GENAM,LBANK-KOFUFA,KEYS,CHOPT,IC)
- ELSEIF(IOPTD.NE.0) THEN
- WRITE(LWRITE,9001) GENAM(1:LGEN),KEYS(1)
- 9001 FORMAT(' rm ',A,1X,I10)
- ELSE
- IF(ISHOW.NE.0) THEN
- IF(CHOPT(1:LCHOPT).NE.'G') WRITE(LWRITE,'(A)') ' '
-
- IF(IOPTG.NE.0) THEN
- WRITE(LWRITE,9002) GENAM(1:LGEN)
- ELSE
- WRITE(LWRITE,9003) FILE(1:LFILE)
- ENDIF
- ELSE
- WRITE(LWRITE,9002) FILE(1:LFILE)
- ENDIF
-
- 9002 FORMAT(' ',A)
- 9003 FORMAT(' Generic filename: ',A)
- ENDIF
-
- IF(ISHOW.EQ.0) GOTO 10
-
- LDSN = 0
-*
-* Keys
-*
- IF (IOPTK .NE. 0) THEN
-*
-* Integer representation
-*
- WRITE (LWRITE,9004)
- + KEYS(MKCLFA),KEYS(MKMTFA),KEYS(MKLCFA),
- + KEYS(MKSRFA)
- 9004 FORMAT(' Data repr.: ',I2,' Media type: ',I2,
- + ' Location code: ',I6,' File serial number: ',I6)
-*
-* Character representation
-*
- IF(KEYS(MKCLFA).GT.0.AND.KEYS(MKCLFA).LE.NWFFAT)
- + WRITE (LWRITE,9005) CHDREP(KEYS(MKCLFA))
- 9005 FORMAT(' Word format : ',A)
- IF(KEYS(MKMTFA).GT.0.AND.KEYS(MKMTFA).LE.NMTYP)
- + WRITE(LWRITE,9006) CHMGEN(KEYS(MKMTFA))
- 9006 FORMAT(' Device group: ',A8)
- IF(KEYS(MKLCFA).EQ.0) THEN
- CALL UHTOC(IQ(LBANK+MFQNFA),4,DSN,NFQNFA)
- LDSN = LENOCC(DSN)
- WRITE(LWRITE,9007) DSN(1:LDSN)
- 9007 FORMAT(' Link--> : ',A)
- ELSE
- JKEY = IUFIND(KEYS(MKLCFA),NLCCFA,1,NKLCFA)
- IF(JKEY.LE.NKLCFA) THEN
- LLOC = LENOCC(CHLOCF(JKEY))
- WRITE(LWRITE,9008)
- + CHLOCF(JKEY)(1:LENOCC(CHLOCF(JKEY)))
- ENDIF
- 9008 FORMAT(' Location : ',A)
- ENDIF
- IF (LCHOPT.EQ.1.AND.CHOPT(1:1).NE.'A') GOTO 10
- ENDIF
-*
-* Display specified fields
-*
- IF (IOPTC .NE. 0) THEN
-*
-* Comment field
-*
- LCOMM = LENOCC(COMM)
- IF(LCOMM.EQ.0) THEN
- COMM = '(no comment)'
- LCOMM = LENOCC(COMM)
- ENDIF
- WRITE (LWRITE,9009) COMM(1:LCOMM)
- 9009 FORMAT(' Comment: ',A)
- ENDIF
-
- IF (IOPTF .NE. 0) THEN
-*
-* File attributes
-*
- WRITE (LWRITE,9010) IQ(LBANK+MSRDFA),IQ(LBANK+MERDFA)
- WRITE (LWRITE,9011) IQ(LBANK+MSBLFA),IQ(LBANK+MEBLFA)
- 9010 FORMAT(' Start record: ',I10,' End record: ',I10)
- 9011 FORMAT(' Start block : ',I10,' End block : ',I10)
- ENDIF
-
- IF (IOPTL .NE. 0) THEN
-*
-* Logical attributes
-*
- CALL UHTOC(IQ(LBANK+MFLFFA),4,FFORM,4)
- CALL UHTOC(IQ(LBANK+MFUTFA),4,UFORM,4)
- WRITE(LWRITE,9012) FFORM,UFORM
- 9012 FORMAT(' File format: ',A4,' user format: ',A4)
- ENDIF
-
- IF (IOPTM .NE. 0) THEN
-*
-* Media attributes
-*
- IF (IQ(LBANK+MMTPFA) .EQ. 1) THEN
-*
-* Disk dataset, show MHSNFA, MHSTFA, MHOSFA
-*
- CALL UHTOC(IQ(LBANK+MHSNFA),4,NODE,NHSNFA)
- CALL UHTOC(IQ(LBANK+MHSTFA),4,TYPE,NHSTFA)
- CALL UHTOC(IQ(LBANK+MHOSFA),4,CHOS,NHOSFA)
- WRITE (LWRITE,9013) NODE,TYPE,CHOS
- 9013 FORMAT(' Host name: ',A8,' host type: ',A8,
- + ' host OS: ',A12,' (Disk dataset)')
- ELSE
-*
-* Tape dataset, show VSN/VID, FSEQ
-*
- CALL UHTOC(IQ(LBANK+MVSNFA),4,VSN,6)
- CALL UHTOC(IQ(LBANK+MVIDFA),4,VID,6)
- JPRE = IQ(LBANK+MVIPFA)
- IF(JPRE.EQ.0) THEN
- WRITE (LWRITE,9014) VSN,VID,IQ(LBANK+MFSQFA)
- ELSE
- WRITE (LWRITE,9015) VSN,VID,PREVID(JPRE),IQ(LBANK+MFSQFA)
- ENDIF
- 9014 FORMAT(' VSN: ',A6,' VID: ',A6,' FSEQ: ',I4)
- 9015 FORMAT(' VSN: ',A6,' VID: ',A6,' VID-prefix: ',A8,
- + ' FSEQ: ',I4)
- ENDIF
- ENDIF
-
- IF (IOPTN .NE. 0) THEN
-*
-* Name attributes (DSN on disk/tape)
-*
- IF(LDSN.EQ.0) THEN
- CALL UHTOC(IQ(LBANK+MFQNFA),4,DSN,NFQNFA)
- LDSN = LENOCC(DSN)
- ENDIF
- WRITE (LWRITE,9016) DSN(1:LDSN)
- 9016 FORMAT(' Fileid: ',5X,A)
- ENDIF
-
- IF (IOPTO .NE. 0) THEN
-*
-* Owner attributes
-*
- CALL CFILL(' ',OWNER,1,8)
- CALL UHTOC(IQ(LBANK+MCURFA),4,OWNER,8)
- CALL CFILL(' ',ACCT,1,8)
- CALL UHTOC(IQ(LBANK+MCIDFA),4,ACCT,8)
- CALL CFILL(' ',NODE,1,8)
- CALL UHTOC(IQ(LBANK+MCNIFA),4,NODE,8)
- CALL CFILL(' ',JOB,1,8)
- CALL UHTOC(IQ(LBANK+MCJIFA),4,JOB,8)
- WRITE (LWRITE,9017) OWNER,ACCT,NODE,JOB
- 9017 FORMAT(' Created by: ',A8,' ACCT: ',A8,' on node: ',A8,
- + ' by job: ',A8)
- ENDIF
-
- IF (IOPTP .NE. 0) THEN
-*
-* Physical attributes
-*
- CALL UHTOC(IQ(LBANK+MRFMFA),4,FLFRM,4)
- WRITE(LWRITE,9018)
- + FLFRM,IQ(LBANK+MRLNFA),IQ(LBANK+MBLNFA),IQ(LBANK+MFSZFA),
- + IQ(LBANK+MUSCFA)
- 9018 FORMAT(' RECFM: ',A5,' LRECL: ',I5,' BLKSIZE: ',I5,
- + ' Filesize: ',I5,' Use count: ',I5)
- ENDIF
-
- IF((IOPTQ .NE. 0).AND.(IQ(LBANK+MMTPFA).GT.1)) THEN
-*
-* Query TMS for this VID - if TMS option is not installed
-* FMQTMS will return defaults.
-* Set IQUEST(11) to media type in case volume unknown or
-* TMS option not installed.
-*
- IF(IOPTM.EQ.0) THEN
- CALL UHTOC(IQ(LBANK+MVSNFA),4,VSN,6)
- CALL UHTOC(IQ(LBANK+MVIDFA),4,VID,6)
- ENDIF
- IQUEST(11) = IQ(LBANK+MMTPFA)
-#if defined(CERNLIB_PREFIX)
- CALL FMXVID(VID,IQ(LBANK+MVIPFA),XVID,VIP,'C',IC)
- LXVID = LENOCC(XVID)
- CALL FMQTMS(XVID(1:LXVID),LIB,MODEL,DENS,MNTTYP,LABTYP,IC)
-#endif
-#if !defined(CERNLIB_PREFIX)
- CALL FMQTMS(VID,LIB,MODEL,DENS,MNTTYP,LABTYP,IC)
-#endif
- IF(IC.EQ.100) THEN
- WRITE(LWRITE,*) 'Volume unknown to TMS'
- ELSE
- ITYPE = 1
- IF(MNTTYP.EQ.'M') ITYPE = 2
- WRITE(LWRITE,* ) 'Library = ',LIB,' model = ',MODEL//
- + ROBMAN(ITYPE) ,' density = ',DENS,' label type = ',
- + LABTYP
-*
-* If tape volume found, display TMS tag fields
-*
- CALL FMTAGS(GENAM(1:LGEN),LBANK-KOFUFA,KEYS,
- + CHTAG,'GT',IRC)
- IF(IRC.EQ.0) THEN
- LTG = LENOCC(CHTAG)
- IF(LTG.NE.0) WRITE (LWRITE,*) 'TMS text tag = ',
- + CHTAG(1:LTG)
- ENDIF
- CALL FMTAGS(GENAM(1:LGEN),LBANK-KOFUFA,KEYS,
- + CHTAG,'GB',IRC)
- IF(IRC.EQ.0) THEN
- LTG = LENOCC(CHTAG)
- IF(LTG.NE.0) WRITE (LWRITE,*) 'TMS binary tag = ',
- + CHTAG(1:LTG)
- ENDIF
- CALL FMTAGS(GENAM(1:LGEN),LBANK-KOFUFA,KEYS,
- + CHTAG,'GV',IRC)
- IF(IRC.EQ.0) THEN
- LTG = LENOCC(CHTAG)
- IF(LTG.NE.0) WRITE (LWRITE,*) 'TMS volinfo tag = ',
- + CHTAG(1:LTG)
- ENDIF
- ENDIF
- ENDIF
-
- IF (IOPTR .NE. 0) THEN
- LLINE = LENOCC(CHLINE)
- WRITE(LWRITE,*) CHLINE(1:LLINE)
- ENDIF
-
- IF (IOPTS .NE. 0) THEN
-*
-* Security attributes
-*
- WRITE(LWRITE,9019) IQ(LBANK+MFPRFA)
- 9019 FORMAT(' File protection mask: ',9X,Z8)
- ENDIF
-
- IF (IOPTT .NE. 0) THEN
-*
-* Time attributes
-*
- CALL FMUPTM(IDATE,ITIME,IQ(LBANK+MCRTFA),IRC)
- WRITE(LWRITE,9020) IDATE,ITIME
- 9020 FORMAT(' Date and time of creation: ',I6.6,1X,I4)
- CALL FMUPTM(IDATE,ITIME,IQ(LBANK+MCTTFA),IRC)
- WRITE(LWRITE,9021) IDATE,ITIME
- 9021 FORMAT(' Date and time catalogued: ',I6.6,1X,I4)
- CALL FMUPTM(IDATE,ITIME,IQ(LBANK+MLATFA),IRC)
- WRITE(LWRITE,9022) IDATE,ITIME
- 9022 FORMAT(' Date and time last accessed: ',I6.6,1X,I4)
- ENDIF
-
- IF (IOPTU .NE. 0) THEN
-*
-* User attributes
-*
- WRITE (LWRITE,9023) (IQ(LBANK+MUSWFA+J),J=0,9)
- 9023 FORMAT(' User words (HEX): ',5(2X,Z8,1X),/,20X,5(2X,Z8,1X))
-
- WRITE (LWRITE,9024) (IQ(LBANK+MUSWFA+J),J=0,9)
- 9024 FORMAT(' User words (DEC): ',5(I10,1X),/,20X,5(I10,1X))
- ENDIF
-
- IF (IOPTY .NE. 0) THEN
-*
-* Verify bank contents
-*
- IF(LWRITE.EQ.LPRTFA) THEN
- CALL FMVERI(GENAM(1:LGEN),LBANK-KOFUFA,KEYS,'A',IRC)
- ELSE
-*
-* redirect output
-*
- CALL FMVERI(GENAM(1:LGEN),LBANK-KOFUFA,KEYS,'AR',IRC)
- ENDIF
-
- ENDIF
-
- IF (IOPTZ .NE. 0) THEN
-*
-* DZSHOW of bank
-*
- IQPSAV = IQPRNT
- IQPRNT = LWRITE
- CALL DZSHOW('Contents of FATMEN bank',IDIVFA,LBANK-KOFUFA,
- + 'L',0,0,0,0)
- IQPRNT = IQPSAV
- ENDIF
-
- 10 CALL UCOPY(IQ(LBANK+MUSWFA),IUSER,10)
- IF(IOPTU.NE.0)
- +CALL FMUPRT(GENAM,LBANK-KOFUFA,KEYS,IUSER,COMM,IRC)
-
- END
diff --git a/src/packlib/fatmen/fmint/fmsmcf.F b/src/packlib/fatmen/fmint/fmsmcf.F
deleted file mode 100644
index bf933c7..0000000
--- a/src/packlib/fatmen/fmint/fmsmcf.F
+++ /dev/null
@@ -1,141 +0,0 @@
-*
-* $Id: fmsmcf.F,v 1.1.1.1 1996/03/07 15:18:10 mclareni Exp $
-*
-* $Log: fmsmcf.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:10 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMSMCF(GENAME,LBANK,IRC)
-*
-* Routine to make a copy of the dataset STAGEd in into the robot
-* using FMCOPY option 'S' (STAGE CHANGE)
-*
-#include "fatmen/fatbank.inc"
-#include "fatmen/fatpara.inc"
- CHARACTER*(*) GENAME
- CHARACTER*6 VSN,VID
- CHARACTER*15 XVID
- CHARACTER*8 VIP
- CHARACTER*8 CHACC
- PARAMETER (LKEYFA=10)
- DIMENSION KEYS(LKEYFA),KEYSR(LKEYFA)
-#include "fatmen/fmaxcop.inc"
- DIMENSION KEYSOU(LKEYFA,MAXCOP),KEYSIN(LKEYFA)
- INTEGER FMACNT
-#include "fatmen/tmsdef.inc"
-*
- LGN = LENOCC(GENAME)
- IRC = 0
- IF(IDEBFA.GE.3) THEN
- PRINT *,'FMSMCF. input bank...'
- CALL FMSHOW(GENAME(1:LGN),LBANK,KEYS,'A',IC)
- ENDIF
-*
-* Save old bank address
-*
- LOLDFA = LBANK
- LTDSFA = 0
-*
-* First, check that a robot copy does not already exist
-*
- CALL UCOPY(KEYS,KEYSIN,10)
-*
-* Don't compare copy level or location code
-*
- KEYSIN(MKCLFA) = -1
- KEYSIN(MKLCFA) = -1
-*
-* Restrict search to 3480s
-*
- KEYSIN(MKMTFA) = 2
- CALL FMSELK(GENAME(1:LGN),KEYSIN,KEYSOU,NMATCH,MAXCOP,IRET)
-* IF(IDEBFA.GE.2)
- IF(IDEBFA.GE.0)
- +PRINT *,'FMSMCF. found ',nmatch,' matches for media type 2'
- DO 10 I=1,NMATCH
- CALL FMGETK(GENAME(1:LGN),LBANKR,KEYSOU(1,I),IC)
- IF(IC.NE.0) THEN
- PRINT *,'FMSMCF. error in FMGETK for candidate # ',I
- GOTO 10
- ENDIF
- PRINT *,'FMSMCF. candidate # ',I
- IF(IDEBFA.GE.3) THEN
- PRINT *,'FMSMCF. candidate # ',I
- CALL FMSHOW(GENAME(1:LGN),LBANKR,KEYS,'A',IC)
- ENDIF
- CALL UHTOC(IQ(LBANKR+KOFUFA+MVIDFA),4,VID,6)
- LVID = LENOCC(VID)
- IF(IDEBFA.GE.0) PRINT *,'FMSMCF. candidate # ',I,' VID = ',
- + VID(1:LVID)
-#if defined(CERNLIB_PREFIX)
- CALL FMXVID(VID,IQ(LBANKR+KOFUFA+MVIPFA),XVID,VIP,'C',IC)
- LXVID = LENOCC(XVID)
- CALL FMQTMS(XVID(1:LXVID),LIB,MODEL,DENS,MNTTYP,LABTYP,IC)
-#endif
-#if !defined(CERNLIB_PREFIX)
- CALL FMQTMS(VID(1:LVID),LIB,MODEL,DENS,MNTTYP,LABTYP,IC)
-#endif
- IF(IDEBFA.GE.0) PRINT *,'FMSMCF. candidate # ',I,' MNTTYP = ',
- + MNTTYP
-
- IF(MNTTYP.EQ.'R') THEN
- IF(IDEBFA.GE.0) PRINT *,'FMSMCF. robot copy already '
- + //'exists'
- IRC = 1
- RETURN
- ENDIF
-
- 10 CONTINUE
-*
-* Lift new bank for the robot copy
-*
-* CALL FMLIFT(GENAME(1:LGN),KEYSR,'DISK',' ',IRC)
-* CALL FMLINK(GENAME(1:LGN),LBANKR,' ',IRC)
- JBIAS = 2
- LSUP = 0
- CALL FMBOOK(GENAME(1:LGN),KEYSR,LBANKR,LSUP,JBIAS,IRC)
-*
-* Blindly copy old bank into new...
-*
- CALL UCOPY(IQ(LOLDFA+KOFUFA+MFQNFA),IQ(LBANKR+KOFUFA+MFQNFA),
- + NWDSFA)
-*
-* and the keys...
-*
- CALL UCOPY(KEYS,KEYSR,10)
-*
-* Set last access date, date of cataloging and use count
-*
- CALL DATIME(IDATE,ITIME)
- CALL FMPKTM(IDATE,ITIME,IPACK,IRC)
- IQ(LBANKR+KOFUFA+MCTTFA) = IPACK
- IQ(LBANKR+KOFUFA+MLATFA) = IPACK
- IQ(LBANKR+KOFUFA+MUSCFA) = 1
-*
-* Now, allocate new tape
-*
- IC = FMACNT(CHACC)
-*
-* SMCF_1 changed to 3495_2 March 1993
-*
- CALL FMALLO('3480','38K',' ','3495_2',CHACC(5:6)//'_FAT1',
- +LBANKR,' ',VSN,VID,IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMSMCF. Cannot allocate robot tape'
- RETURN
- ELSE
- IF(IDEBFA.GE.0) PRINT *,'FMSMCF. allocated ',VSN,' ',VID,
- + ' (VSN/VID)'
- ENDIF
-*
-* Do the copy
-*
- CALL FMCOPY(GENAME,LOLDFA,KEYS,GENAME,LBANKR,KEYSR,'ACSW',IRC)
- IF(IRC.NE.0) PRINT *,'FMSMCF. return code ',IRC,' from FMCOPY'
-*
-* Restore bank address
-*
- LBANK = LOLDFA
- END
diff --git a/src/packlib/fatmen/fmint/fmspac.F b/src/packlib/fatmen/fmint/fmspac.F
deleted file mode 100644
index f79e8d7..0000000
--- a/src/packlib/fatmen/fmint/fmspac.F
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: fmspac.F,v 1.1.1.1 1996/03/07 15:18:12 mclareni Exp $
-*
-* $Log: fmspac.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:12 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMSPAC(IPRIM,ISEC,IRC)
-#include "fatmen/faspac.inc"
-*
-* Set primary and secondary space allocation
-*
- IRC = 0
- IF(IPRIM.LE.0.OR.ISEC.LT.0) IRC = -1
- IF(IPRIM.GT.1000000.OR.ISEC.GT.1000000) IRC = -2
-
- NPRIFA = IPRIM
- NSECFA = ISEC
-
- END
diff --git a/src/packlib/fatmen/fmint/fmtape.F b/src/packlib/fatmen/fmint/fmtape.F
deleted file mode 100644
index 36d87e0..0000000
--- a/src/packlib/fatmen/fmint/fmtape.F
+++ /dev/null
@@ -1,1587 +0,0 @@
-*
-* $Id: fmtape.F,v 1.3 1997/05/28 16:24:33 jamie Exp $
-*
-* $Log: fmtape.F,v $
-* Revision 1.3 1997/05/28 16:24:33 jamie
-* use I6 for lrecl and lblk
-*
-* Revision 1.2 1997/01/07 16:06:32 jamie
-* raise 200MB stage limit to 2GB
-*
-* Revision 1.1.1.1 1996/03/07 15:18:12 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMTAPE(GENAM,LBANK,KEYS,CHLUN,CHOPT,IRC)
-*
- CHARACTER*(*) GENAM,CHLUN,CHOPT
-#include "fatmen/fatget.inc"
-#include "fatmen/fatmon.inc"
-#include "fatmen/fmshft.inc"
-#include "fatmen/fatbank.inc"
-#include "fatmen/fatpara.inc"
-#include "fatmen/fatstg.inc"
-#include "fatmen/fattyp.inc"
-#include "fatmen/fatinfo.inc"
-#include "zebra/zmach.inc"
-#include "fatmen/slate.inc"
-#include "fatmen/fabalq.inc"
- PARAMETER (MEGA=1024*1024)
- PARAMETER (LKEYFA=10)
-#if defined(CERNLIB_CERNVM)
- PARAMETER (MAXSTG=210)
-#endif
-#if defined(CERNLIB_DSYIBM)
- PARAMETER (MAXSTG=250)
-#endif
-#if (!defined(CERNLIB_CERNVM))&&(!defined(CERNLIB_DSYIBM))
- PARAMETER (MAXSTG=2048)
-#endif
-#if defined(CERNLIB_IBMMVS)
- CHARACTER*8 CHFUNC,DDNAME
- CHARACTER*20 CHLEVL
- PARAMETER (MODEFT=1)
-#endif
- DIMENSION KEYS(LKEYFA)
-#if defined(CERNLIB_APOLLO)
-#include "fatmen/fatapol3.inc"
-#endif
-#if defined(CERNLIB_VAXVMS)
- CHARACTER*10 CHCODE
- CHARACTER*8 CHSERV
- CHARACTER*255 EQUNAM
- CHARACTER*255 CHGRP,CHSTFL
- INCLUDE '($DVIDEF)'
- INCLUDE '($RMSDEF)'
- INTEGER FAFNDF
-#include "fatmen/fmqued.inc"
-#endif
-#if defined(CERNLIB_IBMMVS)
-*
-* For tape files, a DD statement of the form
-* //FTnnFffff DD UNIT(=model,,DEFER),VOL=PRIVATE
-* is required.
-*
- DIMENSION HDISP(3),HVOL(2),HLAB(3),HDCB(4),HUNIT(2)
-#endif
-#if defined(CERNLIB_IBMMVS)
-#include "fatmen/fatdcb.inc"
-#endif
- CHARACTER*64 CHOPEN
- CHARACTER*8 CHUSER,CHPOOL
- CHARACTER*255 CHCOMM,SETUP,LABELDEF,FILEDEF,CHFILE,L3PATH
- CHARACTER*255 CHDSN
- CHARACTER*4 DEVTYP
- CHARACTER*6 VSN,VID,FSEQ
- CHARACTER*15 XVID
- CHARACTER*8 VIP
- CHARACTER*6 CHREC,CHBLK
- CHARACTER*80 CHLINE
- CHARACTER*8 FORLUN
- INTEGER FMUSER,FMNODE
- CHARACTER*5 IOMODE
- CHARACTER*4 FFORM,FTEMP
- CHARACTER*6 CDEN
- CHARACTER*4 CSIZE
- CHARACTER*20 STGOPT
- CHARACTER*40 DCB
- CHARACTER*20 FNAME
- CHARACTER*4 RECFM1
- CHARACTER*4 RECFM
- CHARACTER*1 DEVNAM
- CHARACTER*3 DEVNUM
- LOGICAL IWAIT,ILINK,IEXIST
- INTEGER SYSTEMF
-#if defined(CERNLIB_IBMVM)
- CHARACTER*8 RING,DDNAME
- CHARACTER*8 CHACC
- CHARACTER*2 CHUNIT
- CHARACTER*1 CHDISK,CMXDSK
-#endif
- CHARACTER*8 CHHOST,CHTYPE,CHSYS
- INTEGER FMHOST
-#if defined(CERNLIB_VAXVMS)
- EXTERNAL FMBALQ
-#endif
-#if defined(CERNLIB_VAXVMS)
-#include "fatmen/fatlab0.inc"
-#endif
-#include "fatmen/tmsdef0.inc"
-#include "fatmen/fatopt0.inc"
-#include "fatmen/fatvidp.inc"
-#if defined(CERNLIB_VAXVMS)
-#include "fatmen/fatlab1.inc"
-#endif
-#include "fatmen/tmsdef1.inc"
-#include "fatmen/fatopt1.inc"
-#if defined(CERNLIB_IBMMVS)
- DATA HDISP(2)/4HKEEP/,HDISP(3)/4HKEEP/
-#endif
- DATA NENTRY/0/
-#include "fatmen/fatoptc.inc"
-
- IF(IDEBFA.GE.1) THEN
- CALL DATIME(ID,IT)
- PRINT 9001,ID,IT,IS(6)
- 9001 FORMAT(' FMTAPE. enter at ',I6.6,1X,I4.4,I2.2)
- ENDIF
-
- IRC = 0
- NCH = LENOCC(GENAM)
-
- ICODE = FMHOST(CHHOST,CHTYPE,CHSYS)
-
-#if (defined(CERNLIB_SHIFT))&&(defined(CERNLIB_OLDDPM))
- CHPOOL = 'shift1'
-#endif
-#if (defined(CERNLIB_SHIFT))&&(!defined(CERNLIB_OLDDPM))
- CHPOOL = ' '
-#endif
-*
-* Take file size from IQUEST vector, if option O is specified
-*
- IF(IOPTO.NE.0) ISIZE = ISIZSG
-*
-* Set mode (read/write)
-*
- IMODE = IOPTW
- IOMODE = '/IN '
- IF(IMODE.NE.0) IOMODE = '/OUT '
-
- LUN = 0
- LCHLUN = LENOCC(CHLUN)
-
- LUN = ICDECI(CHLUN,1,LCHLUN)
-*
-* Get LUN from CHLUN (DDNAME) if necessary
-*
- IF(LUN.EQ.0) CALL FMDD2L(CHLUN(1:LCHLUN),LUN,IRC)
-*
-* Get CHDSN
-*
- CALL FMGDSN(LBANK,CHDSN,LDSN,IRC)
-
- IC = FMUSER(CHUSER)
- LUSER = LENOCC(CHUSER)
-
-#if defined(CERNLIB_VAXVMS)
-*
-* Get directory for writing stage requests
-*
- IF(NENTRY.EQ.0) THEN
- CALL FMGTLG('STAGE_QUEUE',CHQUED,
- + 'LNM$SYSTEM',ISTAT)
- LQUED = IS(1)
- IF(IDEBFA.GE.0) THEN
- IF(LQUED.EQ.0) THEN
- WRITE(LPRTFA,9002)
- 9002 FORMAT(' FMTAPE. directory for queuing stage requests is',
- + ' not defined.')
- IF(IOPTQ.NE.0) PRINT *,'FMTAPE. option Q ignored.'
- ELSE
- WRITE(LPRTFA,9003) CHQUED(1:LQUED)
- 9003 FORMAT(' FMTAPE. directory for queuing stage requests is ',A)
- ENDIF
- ENDIF
- ENDIF
-
-#endif
-#if defined(CERNLIB_SETUP)||defined(CERNLIB_TAPESYS)
- IF((IOPTT.EQ.0).AND.(IDEBFA.GE.0).AND.(NENTRY.EQ.0))
- +PRINT *,'FMTAPE. Tape staging has been disabled at this location'
- NENTRY = 1
- IOPTT = 1
-#endif
-#if defined(CERNLIB_STAGE)
- IF((IOPTT.NE.0).AND.(IDEBFA.GE.0).AND.(NENTRY.EQ.0))
- +PRINT *,'FMTAPE. Tape staging is enforced at this location'
- NENTRY = 1
- IOPTT = 0
-#endif
-
- IF(IOPTT.NE.0) CALL SBIT1(IHOWFA,JTPMFA)
-*
-* I/O options for FZ:
-* IQUEST(10) = 1 - Use C I/O in FZ
-* IQUEST(10) = 2 - Use FORTRAN D/A I/O
-* IQUEST(10) = 3 - Use 'package' I/O in FZ (e.g. IOPACK)
-*
- ICFOP = 0
- IF(INDEX(FFORM,'FP').EQ.0.AND.IOPTF.NE.0) THEN
- ICFOP = IQUEST(10)
- IF(ICFOP.EQ.2) IOPTX = 1
- ENDIF
-*
-* RZ files: create staged file with ACCESS=DIRECT
-*
- CALL UHTOC(IQ(LBANK+KOFUFA+MFLFFA),4,FFORM,4)
- IF(INDEX(FFORM,'RZ').NE.0.OR.INDEX(FFORM,'RX').NE.0) THEN
- IOPTX = 1
- ENDIF
-*
-* Get DCB information
-*
- CALL UHTOC(IQ(LBANK+KOFUFA+MRFMFA),4,RECFM,4)
- LRECL = IQ(LBANK+KOFUFA+MRLNFA)*4
- LBLOCK = IQ(LBANK+KOFUFA+MBLNFA)*4
-*
-* Find file and STAGE if necessary
-*
-
- CDEN = CHMDEN(IQ(LBANK+KOFUFA+MMTPFA))
-*
-* "EXEC STAGE IN ddname vsn.fseq.label.vid" (IBM)
-* "STAGE/IN vsn vid /NAME=/NUMB=/GENERIC=/LABEL= ddname" (VAX)
-* "stagein fort.lun -v vsn -V vid -l sl|nl|al|blp
-* -g TAPE|CART|SMCF -d 6250|1600" (CRAY)
-* "stagein -U unit -v vsn -V vid -l sl|nl|al|blp
-* -g TAPE|CART|SMCF -d 6250|1600" (SHIFT)
-*
- CALL UHTOC(IQ(LBANK+KOFUFA+MVSNFA),4,VSN,6)
- LVSN = LENOCC(VSN)
- CALL CLTOU(VSN)
- CALL UHTOC(IQ(LBANK+KOFUFA+MVIDFA),4,VID,6)
- LVID = LENOCC(VID)
- CALL CLTOU(VID)
-*
-* Generate eXtended VID - with VID prefix
-*
- JP = IQ(LBANK+KOFUFA+MVIPFA)
- IF(JP.NE.0) THEN
- LVIP = LENOCC(PREVID(JP))
- VIP = PREVID(JP)(1:LVIP)
- XVID = PREVID(JP)(1:LENOCC(PREVID(JP)))
- + // '.' // VID(1:LVID)
- LXVID = LENOCC(XVID)
-
- ELSE
- XVID = VID
- LXVID = LVID
- LVIP = 0
- ENDIF
-
- CALL FMITOC(IQ(LBANK+KOFUFA+MFSQFA),FSEQ,LFSEQ)
-*
-* File size, if zero take default size for current medium
-*
- IF(IOPTO.EQ.0) ISIZE = IQ(LBANK+KOFUFA+MFSZFA)
- IF(ISIZE.NE.0) THEN
- IF(ISIZE.GT.MAXSTG) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMTAPE. Warning - ',
- + 'staging disks are limited to ',MAXSTG,
- + ' MB on this system'
- ENDIF
-#if defined(CERNLIB_IBM)
-*
-* May need slightly more space on disk, due to VBS format!
-*
- IFUDGE = MAX(2,ISIZE/15)
-#endif
-#if !defined(CERNLIB_IBM)
- IFUDGE = 0
-#endif
- CALL FMITOC(MIN(ISIZE+IFUDGE,MAXSTG),CSIZE,LCSIZE)
- ELSE
- CALL FMITOC(MIN(MEDSIZ(IQ(LBANK+KOFUFA+MMTPFA)),MAXSTG),
- + CSIZE,LCSIZE)
- ENDIF
-
- IF(CHLUN(1:LCHLUN).EQ.'NOWAIT'.OR.IOPTQ.NE.0) THEN
- STGOPT = 'NOWAIT'
- IWAIT = .FALSE.
- ELSE
- STGOPT = 'WAIT'
- IWAIT = .TRUE.
- ENDIF
-
-#if defined(CERNLIB_IBMMVS)
-*=======================================================================
-* I B M M V S
-*=======================================================================
-*
-* Build arguments for call to FTDD...
-*
-*
- CALL UCTOH(CHDSN(1:LDSN)//' ',HDSN(1),4,LDSN+1)
-*
-* Check if file is catalogued
-*
- INQUIRE(FILE='/'//CHDSN(1:LDSN),EXIST=IEXIST)
- IF(.NOT.IEXIST) THEN
-*
-* Get media details
-*
- CALL FMQVOL(GENAM(1:NCH),L,KEYS,
- + LIB,MODEL,DENS,MNTTYP,LABTYP,IC)
- CALL UHTOC(IQ(LBANK+KOFUFA+MVSNFA),4,VSN,6)
- LVSN = LENOCC(VSN)
- CALL CLTOU(VSN)
-
- IF(IDEBFA.GE.3) THEN
- PRINT *,'FMTAPE. return from FMQVOL with ',
- + LIB,'/',MODEL,'/',DENS,'/',MNTTYP,'/',
- + LABTYP,'/',IC
- ENDIF
- LLAB = LENOCC(LABTYP)
- LMOD = LENOCC(MODEL)
- CALL UCTOH('NEW ',HDISP(1),4,4)
- CALL UCTOH(VSN(1:LVSN),HVOL,4,LVSN)
- CALL UCTOH(MODEL,HUNIT(1),4,LMOD)
- HLAB(1) = IQ(LBANK+KOFUFA+MFSQFA)
- CALL UCTOH(LABTYP,HLAB(2),4,LLAB)
- IF(IOPTW.NE.0) THEN
- CALL UCTOH('OUT ',HLAB(3),4,4)
- ELSE
- CALL UCTOH('IN ',HLAB(3),4,4)
- ENDIF
- HDCB(2) = IQ(LBANK+KOFUFA+MRLNFA)*4
- HDCB(3) = IQ(LBANK+KOFUFA+MBLNFA)*4
- HDCB(4) = MEDDEN(IQ(LBANK+KOFUFA+MMTPFA))
- CALL FTDD(LUN,MODEFT,HDSN,HDISP,HVOL,HLAB,HDCB,HUNIT,IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMTAPE. return code ',IRC,
- + ' from FTDD'
- GOTO 80
- ENDIF
- ELSE
-*
-* Stage?
-*
- IF(IOPTT.EQ.0) THEN
-*
-* Build parameter list
-*
- DDNAME = CHLUN(1:LCHLUN)
- LDD = LCHLUN
-
- IF(IDEBFA.GE.3) THEN
- CHLEVL = 'PRINTLEV=ALL ;'
- ELSEIF(IDEBFA.EQ.2) THEN
- CHLEVL = 'PRINTLEV=TRACE ;'
- ELSEIF(IDEBFA.EQ.1) THEN
- CHLEVL = 'PRINTLEV=WARNING ;'
- ELSEIF(IDEBFA.LE.-3) THEN
- CHLEVL = 'PRINTLEV=NOMESSAGE ;'
- ELSE
- CHLEVL = 'PRINTLEV=ERROR ;'
- ENDIF
-
- CHFUNC = 'INPUT '
- CALL STAGE(CHFUNC,IRC,ICODE,
- + 'DSN='//CHDSN(1:LDSN)//' ;',
- + 'DDNAME='//DDNAME(1:LDD)//' ;',
- + CHLEVL,
- + 'SPACE='//CSIZE(1:LCSIZE)//' ;')
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMTAPE. return code ',IRC,
- + ' from STAGE, reason code = ',ICODE
- GOTO 80
- ENDIF
- ELSE
-*
-* Just set DISP=OLD
-*
- CALL UCTOH('OLD ',HDISP(1),4,4)
- CALL FTDD(LUN,MODEFT,HDSN,HDISP,IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMTAPE. return code ',IRC,
- + ' from FTDD'
- GOTO 80
- ENDIF
- ENDIF
- ENDIF
-*=======================================================================
-* end I B M M V S
-*=======================================================================
-#endif
-#if (defined(CERNLIB_IBMVM))&&(defined(CERNLIB_NEEDFILE))
-*=======================================================================
-* I B M V M
-*=======================================================================
-*
-* Interface to FNAL NEEDFILE exec
-*
- CALL FMQTMS(VID(1:LVID),LIB,MODEL,DENS,MNTTYP,LABTYP,IC)
- IF(IDEBFA.GE.3) PRINT *,'FMTAPE. return from FMQTMS with ',
- + VID,'/',LIB,'/',MODEL,'/',DENS,'/',MNTTYP,'/',
- + LABTYP,'/',IC
-*
- IF(CHLUN(1:LCHLUN) .EQ. 'NOWAIT'.OR.IOPTQ.NE.0) THEN
- STGOPT = 'NOREPLY'
- IWAIT = .FALSE.
- ELSE
- STGOPT = 'WAIT'
- IWAIT = .TRUE.
- WRITE(CHUNIT,'(I2.2)') LUN
- ENDIF
-
- CHCOMM = 'EXEC NEEDFILE '//VSN(1:LVSN) //
- + ' ( UNIT '//CHUNIT//' '//MODEL//' '//STGOPT
-#endif
-#if (defined(CERNLIB_IBMVM))&&(!defined(CERNLIB_NEEDFILE))
-
- IF((FFORM(1:2).EQ.'FX'.AND.IOPTX.EQ.0.AND.ICFOP.EQ.3)
- + .OR.(FFORM(1:2).EQ.'EP')) THEN
- CHCOMM = 'EXEC STAGE IN IOFILEnn '
- WRITE(CHCOMM(21:22),'(I2.2)') LUN
- ELSEIF((FFORM(1:2).EQ.'FX').AND.(IOPTX.NE.0))THEN
- CHCOMM = 'EXEC STAGE IN VMnnF001 '
- WRITE(CHCOMM(17:18),'(I2.2)') LUN
- ELSE
- CHCOMM = 'EXEC STAGE IN FTnnF001 '
- WRITE(CHCOMM(17:18),'(I2.2)') LUN
- ENDIF
-
- IF(LCHLUN.GT.2) CHCOMM(15:22) = CHLUN
-*
-* Output staging?
-*
- IF(IMODE.NE.0) THEN
- CHCOMM(12:13) = 'OU'
-*
-* Check DCB information
-*
- IF(LRECL.EQ.0.OR.LBLOCK.EQ.0.OR.RECFM(1:1).EQ.' ') THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMTAPE. DCB information ',
- + 'missing or invalid'
- IF(IDEBFA.GE.-3) PRINT *,'FMTAPE. lrecl = ',LRECL,
- + ' blocksize = ',LBLOCK,' recfm = ',RECFM
- IRC = 27
- GOTO 80
- ENDIF
-
- ENDIF
-
- IF(.NOT.IWAIT) CHCOMM(15:22) = 'FT00F001'
-*
-* Set IQUEST(11) to media type in case volume unknown or
-* TMS option not installed.
-*
- IQUEST(11) = IQ(LBANK+KOFUFA+MMTPFA)
-#endif
-#if (!defined(CERNLIB_PREFIX))&&(defined(CERNLIB_IBMVM))
- CALL FMQTMS(VID(1:LVID),LIB,MODEL,DENS,MNTTYP,LABTYP,IC)
-#endif
-#if (defined(CERNLIB_PREFIX))&&(defined(CERNLIB_IBMVM))
- CALL FMQTMS(XVID(1:LXVID),LIB,MODEL,DENS,MNTTYP,LABTYP,IC)
-#endif
-#if defined(CERNLIB_IBMVM)
- IF(IDEBFA.GE.3) THEN
- PRINT *,'FMTAPE. return from FMQTMS with ',
- + VID,'/',LIB,'/',MODEL,'/',DENS,'/',MNTTYP,'/',
- + LABTYP,'/',IC
- ENDIF
-*
-* Believe density from TMS if tape is known
-*
- IF(IC.EQ.0) CDEN = DENS
- CALL CLTOU(LABTYP)
- LLAB = LENOCC(LABTYP)
-*
-* Input wHole tape staging
-*
- IF(IMODE.EQ.0.AND.IOPTH.NE.0) THEN
- FSEQ = '1-E'
- LFSEQ = 3
- STGOPT = 'ONEDISK'
-*
-* Get volinfo information
-*
- CALL FMVINF(VID(1:LVID),MB,NFILES,'G',ICODE)
- IF(MB.EQ.0) THEN
- CALL FMITOC(MIN(MEDSIZ(IQ(LBANK+KOFUFA+MMTPFA)),MAXSTG),
- + CSIZE,LCSIZE)
- ELSE
- CALL FMITOC(MB,CSIZE,LCSIZE)
- ENDIF
- ENDIF
-
- IF(IMODE.EQ.1) STGOPT = 'AUTOPUT DELAY'
- CHCOMM = CHCOMM(1:25) // VSN(1:LVSN) // '.'
- + // FSEQ(1:LFSEQ)
- + // '.' // LABTYP(1:LLAB) // '.' // VID(1:LVID)
-
-#endif
-#if (defined(CERNLIB_PREFIX))&&(defined(CERNLIB_IBMVM))
- IF(LVIP.NE.0) CHCOMM = CHCOMM(1:LENOCC(CHCOMM))
- + // '.' // VIP(1:LVIP)
-#endif
-#if defined(CERNLIB_IBMVM)
- CHCOMM = CHCOMM(1:LENOCC(CHCOMM))
- + // ' (' //STGOPT//' SIZE '//CSIZE // ' DEN '//CDEN
-*
-* Specify dataset name only if option N not specified
-*
- IF(LDSN.NE.0.AND.IOPTN.EQ.0)
- + CHCOMM = CHCOMM(1:LENOCC(CHCOMM)) // ' DSN ' //CHDSN(1:LDSN)
-
-#endif
-#if (defined(CERNLIB_IBMVM))&&(!defined(CERNLIB_TMS))
- CHCOMM = CHCOMM(1:LENOCC(CHCOMM)) // ' DEVTYPE '//MODEL
-#endif
-#if (defined(CERNLIB_IBMVM))&&(!defined(CERNLIB_CERN))&&(defined(CERNLIB_TMS))
- CHCOMM = CHCOMM(1:LENOCC(CHCOMM)) // ' DEVTYPE '//MODEL
-#endif
-#if defined(CERNLIB_IBMVM)
-*
-* Output STAGing only - add DCB information (also NL tapes)
-*
- IF(IMODE.NE.0.OR.LABTYP(1:2).EQ.'NL'.OR.IOPTL.NE.0) THEN
- WRITE(DCB,9004) RECFM,LRECL,LBLOCK
- 9004 FORMAT(' RECFM ',A4,' LRECL ',I5,' BLOCK ',I5)
- CHCOMM = CHCOMM(1:LENOCC(CHCOMM)) // DCB
- ENDIF
-*
-* Output STAGing only - options Keep, autoPut
-*
- IF(IMODE.NE.0) THEN
- IF(IOPTK.NE.0) CHCOMM = CHCOMM(1:LENOCC(CHCOMM)) // ' KEEP'
- IF(IOPTP.NE.0) CHCOMM = CHCOMM(1:LENOCC(CHCOMM)) // ' AUTOPUT'
- ENDIF
-
- LENCOM = LENOCC(CHCOMM)
-
- CALL CSQMBL(CHCOMM,1,LENCOM)
- LENCOM = IS(1)
-
- IF(IOPTT.EQ.0) THEN
-*
-* Use STAGE
-*
- IF(IOPTY.NE.0) THEN
- CHDISK = CMXDSK()
- CHOPEN = '/'//CHUSER(1:LUSER) // ' FMSTAGE ' // CHDISK
- LOPEN = LUSER + 11
- IF(IDEBFA.GE.1) PRINT *,'FMTAPE. writing STAGE command to ',
- + CHOPEN(1:LOPEN)
- OPEN(LUN,STATUS='UNKNOWN',ACCESS='SEQUENTIAL',IOSTAT=IRC,
- + FILE=CHOPEN(1:LOPEN),
- + ACTION='READWRITE',FORM='FORMATTED')
- IF(IRC.NE.0) GOTO 80
- WRITE(LUN,'(A)',IOSTAT=IRC) CHCOMM(1:LENCOM)
- IF(IRC.NE.0) GOTO 80
- CLOSE(LUN)
- GOTO 80
- ENDIF
- 10 CONTINUE
- IF(IDEBFA.GE.0) PRINT *,'FMTAPE. running ',CHCOMM(1:LENCOM)
-
- CALL VMCMS(CHCOMM(1:LENCOM),IRC)
-*
-* NOWAIT specified - just return
-*
- IF(.NOT.IWAIT) GOTO 80
-
-*
-* If option S specified and file size currently zero OR
-* option V AND
-* read mode and data base opened for write...
-*
- IF(IRC.EQ.0) THEN
- IF(((IOPTS.NE.0.AND.IQ(LBANK+KOFUFA+MFSZFA).EQ.0)
- + .OR.IOPTV.NE.0)
- + .AND.(LUFZFA.GT.0.AND.IMODE.EQ.0)) THEN
-*
-* Build STAGE Query command
-*
- CHCOMM = 'EXEC STAGE QUERY ' // VSN(1:LVSN) // '.'
- + // FSEQ(1:LFSEQ) // '.' // LABTYP(1:LLAB)
- + // '.' // VID(1:LVID) // ' (LIFO'
- LC = LENOCC(CHCOMM)
- IF(IDEBFA.GE.2) PRINT *,'FMTAPE. running ',
- + CHCOMM(1:LC)
- CALL VMCMS(CHCOMM(1:LC),IRC)
-*
-* Get answer and extract file size
-*
- CALL VMRTRM(CHLINE,LENGTH)
- IF(IDEBFA.GE.2) PRINT *,'FMTAPE. reply from VMSTAGE: ',
- + CHLINE(1:LENGTH)
- ISLASH = INDEX(CHLINE(1:LENGTH),'/')
- IF(ISLASH.EQ.0) GOTO 20
- IDOT = INDEXB(CHLINE(1:ISLASH),'.')
- IBLANK = INDEXB(CHLINE(1:IDOT),' ')
- READ(CHLINE(IBLANK+1:IDOT-1),*) ISIZE
-*
-* Add 1 MB to file size as we ignore the fraction...
-*
- ISIZE = ISIZE + 1
-
- IF(IDEBFA.GE.0.AND.IOPTV.NE.0.AND.
- + IABS(IQ(LBANK+KOFUFA+MFSZFA)-ISIZE).GT.1)
- + PRINT *,'FMTAPE. file size in catalogue ',
- + '(',IQ(LBANK+KOFUFA+MFSZFA),
- + ') disagress with that returned by ',
- + 'VMSTAGE (',ISIZE,')'
-
- IQ(LBANK+KOFUFA+MFSZFA) = ISIZE
-
- IF(IDEBFA.GE.0) THEN
- PRINT *,'FMTAPE. updating file size from STAGE ',
- + 'information'
- PRINT *,'FMTAPE. '//CHLINE(1:LENGTH)
- ENDIF
- 20 CONTINUE
- ENDIF
-*
-* Option D - make a duplicate copy into the robot
-*
- IF(IOPTD.NE.0.AND.IMODE.EQ.0) THEN
- CALL FMSMCF(GENAM,L,IC)
- IF(IC.NE.0) THEN
- PRINT *,'FMTAPE - return code ',IC,' from FMSMCF'
- ENDIF
- ENDIF
-
- ELSEIF(IRC.EQ.400) THEN
-*
-* STAGE failed - cannot allocate disk size of size requested
-*
- READ(CSIZE,'(I4)') ISIZE
- IF(ISIZE.LT.MEDSIZ(IQ(LBANK+KOFUFA+MMTPFA))) THEN
- IF(IDEBFA.GE.0)
- + PRINT *,'FMTAPE. unable to allocate staging disk for',
- + ' size ',CSIZE,' - will try larger disk'
-*
-* Increase size of staging disk requested up to the maximum of
-* - medium capacity
-* - maximum staging disk
-* The increase is done in units of 20 MB or the file size
-*
-* ISIZE = MIN(ISIZE+MAX(20,IQ(LBANK+KOFUFA+MFSZFA)),
-* + MAXSTG,MEDSIZ(IQ(LBANK+KOFUFA+MMTPFA)))
- WRITE(CSIZE,'(I4)') ISIZE
- ISTART = INDEX(CHCOMM,'SIZE ') + 5
- CHCOMM(ISTART:ISTART+3) = CSIZE
- GOTO 10
- ELSE
- IF(IDEBFA.GE.0)
- + PRINT *,'FMTAPE. return code from STAGE = ',IRC
- GOTO 80
- ENDIF
-
- ELSEIF(IRC.GE.20) THEN
- IF(IDEBFA.GE.0)
- + PRINT *,'FMTAPE. return code from STAGE = ',IRC
- GOTO 80
- ENDIF
-
- ELSE
-*
-* Use SETUP
-*
- IF(IOPTW.EQ.0) THEN
- RING = ' NORING '
- ELSE
- RING = ' RING '
- ENDIF
-
- CALL FMWORD(DDNAME,3,' ',CHCOMM,IRC)
- LDD = LENOCC(DDNAME)
- IF(LDD.LE.2) THEN
- READ(DDNAME(1:LDD),*) LUN
- DDNAME = 'FT00F001'
- WRITE(DDNAME(3:4),'(I2.2)') LUN
- ENDIF
-*
-* Find first free tape drive
-*
- ITAPE = IUCOMP(0,IDEV,16)
- IF(ITAPE.EQ.17) THEN
- IF(IDEBFA.GE.-2) PRINT *,'FMTAPE. no free ',
- + 'virtual address for tape unit'
- IRC = 1
- GOTO 80
- ENDIF
-
- ITEMP = 179 + ITAPE
- IF(ITAPE.GT.8) ITEMP = 277 + ITAPE
- WRITE(DEVNUM,'(I3)') ITEMP
- WRITE(DEVNAM,'(Z1)') ITAPE-1
-*
-* Store address of tape unit
-*
- IVADDR(LUN) = ITAPE
- IDEV(ITAPE) = IVADDR(LUN)
-
-#endif
-#if (defined(CERNLIB_IBMVM))&&(defined(CERNLIB_HEPVM))
- SETUP = 'SETUP '//MODEL//' '//DEVNUM//' '
- + //VSN(1:LVSN)//' VID '//XVID//' '
- + //LABTYP//CDEN//RING
-
- IF(IOPTE.NE.0) THEN
- LENS = LENOCC(SETUP)
- SETUP = SETUP(1:LENS)//' (END'
- ENDIF
-
- LENS = LENOCC(SETUP)
- IF(IDEBFA.GE.0) PRINT *,'FMTAPE. running ',SETUP(1:LENS)
- CALL VMCMS(SETUP(1:LENS),IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMTAPE. return code ',IRC,
- + ' from SETUP'
- GOTO 80
- ENDIF
-#endif
-#if (defined(CERNLIB_IBMVM))&&(defined(CERNLIB_TAPESYS))
- SETUP = 'EXEC TAPESYS MOUNT '//VID(1:LVID)
- + // ' ( ' // DEVNAM
-
- IF(VSN(1:LVSN).NE.VID(1:LVID)) THEN
- LENS = LENOCC(SETUP)
- SETUP = SETUP(1:LENS) // ' EXTID '
- ENDIF
-
- IF(IOPTW.NE.0) THEN
- LENS = LENOCC(SETUP)
- SETUP = SETUP(1:LENS) // ' RW '
- ENDIF
-
- IF(IOPTE.NE.0) THEN
- LENS = LENOCC(SETUP)
- SETUP = SETUP(1:LENS) // ' WAIT '
- ENDIF
-
- LENS = LENOCC(SETUP)
- IF(IDEBFA.GE.0) PRINT *,'FMTAPE. running ',SETUP(1:LENS)
- CALL VMCMS(SETUP(1:LENS),IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMTAPE. return code ',IRC,
- + ' from TAPESYS'
- GOTO 80
- ENDIF
-#endif
-#if (defined(CERNLIB_IBMVM))&&(defined(CERNLIB_VMTAPE))
-
- IF(IOPTW.EQ.0) THEN
- RING = ' READ '
- ELSE
- RING = ' WRITE '
- ENDIF
-
- SETUP = 'VMTAPE MOUNT '//VSN(1:LVSN)//DEVNAM
- + //' DSN ? (DEN '//CDEN//' LABEL '//LABTYP
- + //RING//' WAIT UNIT '//MODEL
- LENS = LENOCC(SETUP)
- IF(IDEBFA.GE.0) PRINT *,'FMTAPE. running ',SETUP(1:LENS)
- CALL VMCMS(SETUP(1:LENS),IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMTAPE. return code ',IRC,
- + ' from VMTAPE'
- GOTO 80
- ENDIF
- CALL VMSTAK(CHDSN(1:LDSN),'L',IRC)
-#endif
-#if defined(CERNLIB_IBMVM)
-
- FILEDEF = 'FILEDEF '//DDNAME//' TAP'
- + //DEVNAM//' '//LABTYP//' ' //FSEQ(1:LFSEQ)
- + //' (DEN '//CDEN
- LENF = LENOCC(FILEDEF)
-
- IF(IOPTW.NE.0) THEN
- FILEDEF = FILEDEF(1:LENF) // DCB
- LENF = LENOCC(FILEDEF)
- ENDIF
-
- IF(IDEBFA.GE.0) PRINT *,'FMTAPE. running ',FILEDEF(1:LENF)
- CALL VMCMS(FILEDEF(1:LENF),IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMTAPE. return code ',IRC,
- + ' from FILEDEF'
- GOTO 80
- ENDIF
-
- IF((LDSN.GT.0).AND.(IOPTN.EQ.0)) THEN
- LABELDEF = 'LABELDEF '//DDNAME//' FID ? FSEQ '
- + //FSEQ(1:LFSEQ)
- LENL = LENOCC(LABELDEF)
-
- IF(IDEBFA.GE.0) PRINT *,'FMTAPE. running ',LABELDEF(1:LENL)
-*
-* Put DSN on program STACK for LABELDEF
-*
- IF(IDEBFA.GE.0) PRINT *,'FMTAPE. DSN is ',CHDSN(1:LDSN)
- CALL VMSTAK(CHDSN(1:LDSN),'L',IRC)
- CALL VMCMS(LABELDEF(1:LENL),IRC)
- ENDIF
-
- ENDIF
-
-*=======================================================================
-* end I B M V M
-*=======================================================================
-#endif
-#if defined(CERNLIB_VAXVMS)
-*
-* Build the relevant logical name for STAGE
-*
- FORLUN = 'FOR00N'
- WRITE(FORLUN(4:6),'(I3.3)') LUN
- IF(LUN.EQ.0) FORLUN = CHLUN
- LFLUN = LENOCC(FORLUN)
-*
-* Protect against logical names in the process table
-*
- CALL FMGTLG(FORLUN(1:LFLUN),EQUNAM,'LNM$PROCESS',IC)
- IF(IC.EQ.0) THEN
- IF(IDEBFA.GE.0) PRINT 9005,FORLUN(1:LFLUN),EQUNAM(1:IS(1))
- 9005 FORMAT(' FMTAPE. warning - conflicting logical name for ',A,/,
- + ' = ',A,/,
- + ' - deleted from process table')
- ISTAT = LIB$DELETE_LOGICAL(FORLUN(1:LFLUN),'LNM$PROCESS')
- ENDIF
-
- JX = ICFNBL(CSIZE,1,4)
-*
-* Set IQUEST(11) to media type in case volume unknown or
-* TMS option not installed.
-*
- IQUEST(11) = IQ(LBANK+KOFUFA+MMTPFA)
-#endif
-#if (defined(CERNLIB_VAXVMS))&&(!defined(CERNLIB_PREFIX))
- CALL FMQTMS(VID(1:LVID),LIB,MODEL,DENS,MNTTYP,LABTYP,IC)
-#endif
-#if (defined(CERNLIB_VAXVMS))&&(defined(CERNLIB_PREFIX))
- CALL FMQTMS(XVID(1:LXVID),LIB,MODEL,DENS,MNTTYP,LABTYP,IC)
-#endif
-#if defined(CERNLIB_VAXVMS)
- IF(IDEBFA.GE.3) THEN
- PRINT *,'FMTAPE. return from FMQTMS with ',
- + VID,'/',LIB,'/',MODEL,'/',DENS,'/',MNTTYP,'/',
- + LABTYP,'/',IC
- ENDIF
-
-*
-* Translate IBM to VAX labels (SL->EBCDIC etc.)
-*
- JL = ICNTH(LABTYP,IBMLAB,3)
- CHCOMM = '$STAGE ' // VSN(1:LVSN) // ' ' // VID(1:LVID) // ' '
- + // FORLUN(1:LFLUN) // IOMODE
- + // '/NAME=' // CHDSN(1:LDSN)
- + // '/NUMBER=' // FSEQ(1:LFSEQ)
- + // '/SIZE=' // CSIZE(JX:4)
- + // '/GENERIC='// MODEL
- + // '/LABEL='// VAXLAB(JL)
-*
-* Output STAGing only - add DCB information (also NL tapes)
-*
- IF((IMODE.NE.0).OR.(LABTYP(1:2).EQ.'NL')
- + .OR.(IOPTL.NE.0)) THEN
- IF(INDEX(RECFM,'F').NE.0) THEN
- CHCOMM = CHCOMM(1:LENOCC(CHCOMM)) // '/FIXED'
- ELSEIF(INDEX(RECFM,'V').NE.0) THEN
- CHCOMM = CHCOMM(1:LENOCC(CHCOMM)) // '/VARIABLE'
- ENDIF
- WRITE(CHREC,'(I6.6)') LRECL
- WRITE(CHBLK, '(I6.6)') LBLOCK
- IF(LRECL.GT.0) CHCOMM = CHCOMM(1:LENOCC(CHCOMM)) //
- + '/RECORDSIZE='//CHREC
- IF(LBLOCK.GT.0) CHCOMM = CHCOMM(1:LENOCC(CHCOMM)) //
- + '/BLOCKSIZE='//CHBLK
- ENDIF
-*
- LENCOM = LENOCC(CHCOMM)
-*
-* RMS format
-*
- IF(RECFM(1:3).EQ.'RMS') THEN
- CHCOMM(LENCOM+1:LENCOM+4) = '/RMS'
- LENCOM = LENCOM + 4
- ENDIF
-*
-* Full tape option
-*
- IF(IOPTH.NE.0) THEN
- CHCOMM = CHCOMM(1:LENCOM) // '/FULLTAPE'
- LENCOM = LENCOM + 9
- ENDIF
-*
-* 'T' option - read directly from tape
-*
- IF(IOPTT.NE.0) THEN
- CHCOMM = CHCOMM(1:LENCOM) // '/DIRECT'
- LENCOM = LENCOM + 7
- ENDIF
-*
-* 'X' option - create direct access file on disk
-*
- IF(IOPTX.NE.0) THEN
- CHCOMM = CHCOMM(1:LENCOM) // '/ACCESS=DIRECT'
- LENCOM = LENCOM + 14
- ENDIF
-
- IF(IOPTY.NE.0) THEN
- CHOPEN = 'SYS$LOGIN:'//CHUSER(1:LUSER)//'.FMSTAGE'
- LOPEN = LUSER + 18
- IF(IDEBFA.GE.1) PRINT *,'FMTAPE. writing STAGE command to ',
- + CHOPEN(1:LOPEN)
- OPEN(LUN,STATUS='NEW',FORM='FORMATTED',ACCESS='SEQUENTIAL',
- + FILE=CHOPEN(1:LOPEN),
- + IOSTAT=IRC)
- IF(IRC.NE.0) GOTO 80
- WRITE(LUN,'(A)',IOSTAT=IRC) CHCOMM(1:LENCOM)
- IF(IRC.NE.0) GOTO 80
- CLOSE(LUN)
- GOTO 80
- ENDIF
-*
-* Check that we can use STAGE, before doing LIB$SPAWN...
-*
- CALL FMSTGP(CHGRP,IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMTAPE. error checking STAGE',
- + ' IRC = ',IRC
- GOTO 80
- ENDIF
-
- LCHGRP = LENOCC(CHGRP)
- CHSTFL = CHGRP(1:LCHGRP)//VSN(1:LVSN)//'_'//VID(1:LVID)
- + //'.'//FSEQ(1:LFSEQ)//'_'//VAXLAB(JL)
- LCHST = LENOCC(CHSTFL)
-*
-* Output staging: define logical name and continue
-*
- IF(IMODE.NE.0.AND.IOPTT.EQ.0) THEN
-*
-* Set logical name
-*
- IF(IDEBFA.GE.0) PRINT *,'FMTAPE. defining logical name ',
- + FORLUN(1:LFLUN),' to point to ',CHSTFL(1:LCHST)
- ISTAT = LIB$SET_LOGICAL(FORLUN(1:LFLUN),
- + CHSTFL(1:LCHST),'LNM$JOB',,)
-#include "fatmen/fatvaxrc.inc"
-
- ENDIF
-
- IF(IMODE.EQ.0.AND.IOPTT.EQ.0) THEN
-*
-* Check whether file is already on disk
-*
- INQUIRE(FILE=CHSTFL(1:LCHST),EXIST=IEXIST)
- IF(IEXIST) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMTAPE. requested file ',
- + 'already on disk - checking file size...'
- OPEN(LUN,FILE=CHSTFL(1:LCHST),STATUS='OLD',
- + FORM='UNFORMATTED',READONLY,SHARED,
- + USEROPEN=FMBALQ,IOSTAT=ISTAT)
- ISIZE = (NBLOKS*512 + .9999*MEGA)/MEGA
- IF(IDEBFA.GE.0) PRINT *,'FMTAPE. size allocated = ',
- + NBLOKS,' disk blocks = ',ISIZE,' MB'
-*
-* If file already on disk, accept and set logical name
-*
- IF(IABS(IQ(LBANK+KOFUFA+MFSZFA)-ISIZE).LT.2) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMTAPE. defining logical name ',
- + FORLUN(1:LFLUN),' to point to ',CHSTFL(1:LCHST)
- ISTAT = LIB$SET_LOGICAL(FORLUN(1:LFLUN),
- + CHSTFL(1:LCHST),'LNM$JOB',,)
-#include "fatmen/fatvaxrc.inc"
- GOTO 50
- ENDIF
- ENDIF
- ENDIF
-*
-* Stage operation required
-*
- CALL SBIT1(IHOWFA,JSTGFA)
-*
-* Check if we should issue a local or remote stage...
-*
- LM = LENOCC(MODEL)
- INQUIRE(FILE='SETUP_EXE:TPSERV.CONF',EXIST=IEXIST)
-*
-* Does a STAGE batch queue exist?
-*
- CALL FMBQUE('STAGE_'//MODEL(1:LM)//'S',LBQ)
-
- IF(LBQ.GT.0.AND.IEXIST) THEN
- IF(IDEBFA.GE.1) PRINT *,'FMTAPE. stage batch queue exists '//
- + '- stage request will be performed in batch'
- ELSE
- CALL FMGTLG('SETUP_'//MODEL(1:LM)//'S',EQUNAM,
- + 'LNM$SYSTEM',ILOCAL)
- IF(ILOCAL.NE.0.AND.IEXIST) THEN
- IF(IDEBFA.GE.1) PRINT *,'FMTAPE. generic device type ',
- + MODEL(1:LM),' not found on this node - checking ',
- + 'served devices'
- ENDIF
- ENDIF
-
- IF(ILOCAL+LBQ.NE.0.AND.IEXIST) THEN
- ISTAT = LIB$GET_LUN(LUNTAP)
-#include "fatmen/fatvaxrc.inc"
- OPEN(LUNTAP,FILE='SETUP_EXE:TPSERV.CONF',
- + FORM='FORMATTED',STATUS='OLD',
- + READONLY,SHARED,IOSTAT=IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMTAPE. cannot open TPSERV ',
- + 'configuration file (SETUP_EXE:TPSERV.CONF)'
- ELSE
- 30 CONTINUE
- READ(LUNTAP,'(A)',END=40) CHLINE
- LLINE = LENOCC(CHLINE)
- IF(IDEBFA.GE.2) PRINT *,'FMTAPE. tpserv line : ',
- + CHLINE(1:LLINE)
- IF(INDEX(CHLINE(1:LLINE),'TPSERV').NE.0.AND.
- + INDEX(CHLINE(1:LLINE),MODEL(1:LM)).NE.0) THEN
-*
-* Get remote host name
-*
- LBLNK = INDEXB(CHLINE(1:LLINE),' ')
- CHSERV = CHLINE(LBLNK+1:LLINE)
- LSERV = LLINE - LBLNK
- IF(IDEBFA.GE.0) PRINT *,'FMTAPE. served ',MODEL(1:LM),
- + ' found on node ',CHSERV(1:LSERV)
- GOTO 40
- ENDIF
- GOTO 30
- 40 CONTINUE
- CLOSE(LUNTAP)
- ENDIF
-
- ISTAT = LIB$FREE_LUN(LUNTAP)
-#include "fatmen/fatvaxrc.inc"
-
- LSTA = INDEX(CHSTFL,']') + 1
-*
-* Are we in server mode?
-*
- IF(LQUED.GT.0) THEN
-*
-* Look for an existing request for this file
-*
-* INQUIRE(FILE=CHQUED(1:LQUED)//CHSTFL(LSTA:LCHST),
-* + EXIST=IEXIST)
-* IF(IEXIST.AND.IOPTQ.NE.0) RETURN
- ICONT = 0
- IEXIST = FAFNDF(CHQUED(1:LQUED)//CHSTFL(LSTA:LCHST),
- + CHFILE,ICONT)
- IF(IEXIST.EQ.RMS$_SUC.AND.IOPTQ.NE.0) RETURN
- ENDIF
-*
-* Now submit remote job and wait for completion
-*
- IF(FMNODE(CHSERV(1:LSERV)).EQ.0) THEN
-*
-* Node is in the same cluster. (Can talk to job controller directly)
-*
- IF(IDEBFA.GE.1) PRINT *,'FMTAPE. node ',CHSERV(1:LSERV),
- + ' is in this VAXcluster - can talk to job controller'
- CALL FMCSTG(CHSTFL(LSTA:LCHST),MODEL(1:LM),CHCOMM(1:LENCOM),
- + IQ(LBANK+KOFUFA+MFSZFA),CHOPT,IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMTAPE. return code ',
- + IRC,' from FMCSTG'
- GOTO 80
- ENDIF
- IF(IOPTQ.NE.0) GOTO 80
-
- ELSE
-*
-* Node is remote
-*
- IF(IDEBFA.GE.0) PRINT *,'FMTAPE. node ',CHSERV(1:LSERV),
- + ' is outside this VAXcluster - submitting job via DECnet'
- CALL FMRSTG(CHSERV(1:LSERV),CHSTFL(LSTA:LCHST),
- + MODEL(1:LM),CHCOMM(1:LENCOM),IQ(LBANK+KOFUFA+MFSZFA),
- + CHOPT,IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMTAPE. return code ',
- + IRC,' from FMRSTG'
- GOTO 80
- ENDIF
- IF(IOPTQ.NE.0) GOTO 80
- ENDIF
-*
-* Set logical name
-*
- IF(IRC.EQ.0) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMTAPE. defining logical name ',
- + FORLUN(1:LFLUN),' to point to ',CHSTFL(1:LCHST)
- ISTAT = LIB$SET_LOGICAL(FORLUN(1:LFLUN),
- + CHSTFL(1:LCHST),'LNM$JOB',,)
-#include "fatmen/fatvaxrc.inc"
- ENDIF
-
- ELSE
-
- IF(IDEBFA.GE.0) PRINT *,'FMTAPE. running ',CHCOMM(1:LENCOM)
- ISTAT = LIB$SPAWN('@SETUP_EXE:STAGE "'//CHCOMM(1:LENCOM)//'"')
-#include "fatmen/fatvaxrc.inc"
-*
-* Get return code
-*
- CALL FMGTLG('STAGE_RC',CHCODE,'LNM$JOB',IRC)
- IF(IRC.EQ.0.AND.CHCODE(1:2).EQ.'%X') THEN
- READ(CHCODE,'(2X,Z8)') ISTAT
- IF (.NOT.ISTAT) IRC = 42
- ENDIF
-
- ENDIF
-
- 50 CONTINUE
-
- IF(IRC.EQ.0.AND.IMODE.EQ.0.AND.IOPTT.EQ.0) THEN
-*
-* Check file size on disk
-*
- IF(((IOPTS.NE.0.AND.IQ(LBANK+KOFUFA+MFSZFA).EQ.0)
- + .OR.IOPTV.NE.0)
- + .AND.(LUFZFA.GT.0.AND.IMODE.EQ.0)) THEN
- OPEN(LUN,FILE=CHSTFL(1:LCHST),STATUS='OLD',
- + FORM='UNFORMATTED',READONLY,SHARED,
- + USEROPEN=FMBALQ,IOSTAT=ISTAT)
- ISIZE = (NBLOKS*512+.9999*MEGA)/MEGA
- IF(IDEBFA.GE.1) PRINT *,'FMTAPE. size allocated = ',
- + NBLOKS,' disk blocks = ',ISIZE,' MB'
-
- IF(IDEBFA.GE.0.AND.IOPTV.NE.0.AND.
- + IABS(IQ(LBANK+KOFUFA+MFSZFA)-ISIZE).GT.1)
- + PRINT *,'FMTAPE. file size in ',
- + 'catalogue (',IQ(LBANK+KOFUFA+MFSZFA),
- + ') disagress with that returned by STAGE (',
- + ISIZE,')'
-
- IQ(LBANK+KOFUFA+MFSZFA) = ISIZE
-*
-* Get fully qualified file name
-* INQUIRE(FILE=CHSTFL(1:LCHST),NAME=CHFNFA)
-
- LNFNFA = LENOCC(CHFNFA)
-*
-* How is this disk accessed? (DFS, VAXcluster)
-*
- LCOLON = INDEX(CHFNFA(1:LNFNFA),':')
- IF(LCOLON.GT.0) THEN
- CALL FMGTLG(CHFNFA(1:LCOLON-1),EQUNAM,
- + 'LNM$SYSTEM',ICODE)
- IF(ICODE.EQ.0.AND.EQUNAM(1:4).EQ.'DFSC') THEN
- CALL SBIT1(IHOWFA,JDFSFA)
- ELSE
-*
-* Get host name
-*
- ICODE = LIB$GETDVI(DVI$_HOST_NAME,,CHFNFA(1:LCOLON),
- + ,EQUNAM,LNAME)
- IF(EQUNAM(1:LNAME).EQ.CHHOST(1:LENOCC(CHHOST))) THEN
- CALL SBIT1(IHOWFA,JLOCFA)
- ELSE
- CALL SBIT1(IHOWFA,JMSCFA)
- ENDIF
- ENDIF
- ENDIF
-
- ENDIF
-
- ENDIF
-
-#endif
-#if (defined(CERNLIB_IBMVM))&&(!defined(CERNLIB_HEPVM))&&(!defined(CERNLIB_VMTAPE))&&(!defined(CERNLIB_NEEDFILE))&&(!defined(CERNLIB_TAPESYS))
- PRINT *,'FMTAPE. Tape support is not available for this ',
- + 'system'
- IRC = 999
- GOTO 80
-
-#endif
-#if (defined(CERNLIB_VAXVMS))&&(!defined(CERNLIB_VAXTAP))
- PRINT *,'FMTAPE. Tape support is not available for this ',
- + 'system'
- IRC = 999
- GOTO 80
-
-#endif
-#if (defined(CERNLIB_UNIX))&&(!defined(CERNLIB_CRAY))&&(!defined(CERNLIB_SHIFT))&&(!defined(CERNLIB_APOLLO))
- PRINT *,'FMTAPE. Tape support is not available for this ',
- + 'system'
- IRC = 999
- GOTO 80
-
-#endif
-#if defined(CERNLIB_APOLLO)
- IF(IAPOL3.EQ.0) THEN
- PRINT *,'FMTAPE. Tape support is not available for this ',
- + 'system'
- IRC = 999
- GOTO 80
- ENDIF
-
-#endif
-#if defined(CERNLIB_CRAY)||defined(CERNLIB_SHIFT)||defined(CERNLIB_APOLLO)
-*
-* Set IQUEST(11) to media type in case volume unknown or
-* TMS option not installed.
-*
- IQUEST(11) = IQ(LBANK+KOFUFA+MMTPFA)
-#endif
-#if (defined(CERNLIB_CRAY)||defined(CERNLIB_SHIFT)||defined(CERNLIB_APOLLO))&&(!defined(CERNLIB_PREFIX))
- CALL FMQTMS(VID(1:LVID),LIB,MODEL,DENS,MNTTYP,LABTYP,IC)
-#endif
-#if (defined(CERNLIB_CRAY)||defined(CERNLIB_SHIFT)||defined(CERNLIB_APOLLO))&&(defined(CERNLIB_PREFIX))
- CALL FMQTMS(XVID(1:LXVID),LIB,MODEL,DENS,MNTTYP,LABTYP,IC)
-#endif
-#if defined(CERNLIB_CRAY)||defined(CERNLIB_SHIFT)||defined(CERNLIB_APOLLO)
- IF(IDEBFA.GE.3) THEN
- PRINT *,'FMTAPE. return from FMQTMS with ',
- + VID,'/',LIB,'/',MODEL,'/',DENS,'/',MNTTYP,'/',
- + LABTYP,'/',IC
- ENDIF
-*
-* Believe density from TMS if tape is known
-*
- IF(IC.NE.0) CDEN = DENS
- CALL CUTOL(LABTYP)
- LLAB = LENOCC(LABTYP)
-
-#endif
-#if defined(CERNLIB_CRAY)
- FORLUN = 'fort. '
- IF(LUN.LT.10) THEN
- WRITE(FORLUN(6:6),'(I1)') LUN
- ELSE
- WRITE(FORLUN(6:7),'(I2)') LUN
- ENDIF
-
-#endif
-#if defined(CERNLIB_SHIFT)
- IF(LUN.LT.10) THEN
- WRITE(FORLUN,'(I1)') LUN
- ELSE
- WRITE(FORLUN,'(I2)') LUN
- ENDIF
-
-#endif
-#if defined(CERNLIB_CRAY)||defined(CERNLIB_SHIFT)||defined(CERNLIB_APOLLO)
-
- CALL FMITOC(IQ(LBANK+KOFUFA+MFSQFA),FSEQ,LFSEQ)
-
- IF(LUN.EQ.0) FORLUN = CHLUN
-* "stagein fort.lun -v vsn -V vid -l sl|nl|al|blp
-* -g TAPE|CART|SMCF -d 6250|1600"
-#endif
-#if defined(CERNLIB_APOLLO)
- IF(IMODE.EQ.0) THEN
- CHCOMM = 'l3stage -i '
- ELSEIF(IMODE.EQ.1) THEN
-*
-* Output staging on Apollo:
-* Use temporary file in current directory
-* or in directory specified by L3STAGE
-*
- CALL GETENVF('L3STAGE',L3PATH)
- IF(IS(1).EQ.0) THEN
- STGPTH = CHDSN(1:LDSN)
- ELSE
- STGPTH = L3PATH(1:IS(1)) // CHDSN(1:LDSN)
- LSTG = IS(1) + LDSN
- ENDIF
- LSTG = IS(1) + LDSN
- CHFNFA = STGPTH(1:LSTG)
- LNFNFA = LSTG
- IF(IDEBFA.GE.0) PRINT *,'FMTAPE. stage out file is ',
- + STGPTH(1:LSTG)
- GOTO 80
- ENDIF
-
- CHCOMM = CHCOMM(1:LENOCC(CHCOMM))
- + // ' -v '
- + //VID(1:LVID)//' -l '//LABTYP//' -t '//MODEL
- + // ' -f ' //FSEQ(1:LFSEQ) // ' -d '//CDEN
- + // ' -s '//CSIZE
- IF(IWAIT) CHCOMM = CHCOMM(1:LENOCC(CHCOMM)) // ' -w '
-#endif
-#if defined(CERNLIB_CRAY)
- CHCOMM = 'stagein '//FORLUN
-#endif
-#if defined(CERNLIB_SHIFT)
- LFLUN = LENOCC(FORLUN)
- CHFILE = 'T'//VID(1:LVID)//'.FSEQ'//FSEQ(1:LFSEQ)
- LFILE = LENOCC(CHFILE)
-*
-* Remove existing link (if any)
-*
- CALL UNLINKF(CHFILE(1:LFILE))
-*
-* Only specify -U option of FORLUN looks like a Fortran unit...
-*
- IF(FORLUN(1:3).EQ.'ftn') THEN
- IFLUN = 4
- ELSEIF(FORLUN(1:5).EQ.'fort.') THEN
- IFLUN = 6
- ELSE
- IFLUN = 1
- ENDIF
-
- IF(ICNUM(FORLUN,IFLUN,LFLUN).EQ.LFLUN+1) THEN
- CHCOMM = 'stagein -G -U '//FORLUN(1:LFLUN)
- LENCOM = 15 + LFLUN
- ELSE
- CHCOMM = 'stagein -G '
- LENCOM = 12
- CHFILE = FORLUN(1:LFLUN)
- ENDIF
-*
-* Option I - disable -G option 'individual'
-* -G Specifies that the tape copy operations should be
-* issued on the tape server by the 'group user'. A
-* 'group user' may be defined for each group in
-* /etc/shift.conf.
-* For example:
-* GRPUSER ws opalprod
-*
- IF(IOPTI.NE.0) CHCOMM(10:11) = ' '
-
-* + // ' '//CHFILE(1:LFILE)
-
- CHCOMM = CHCOMM(1:LENCOM)
-#endif
-#if defined(CERNLIB_CRAY)||defined(CERNLIB_SHIFT)
- + // ' -v '//VSN(1:LVSN)// ' -V '
- + //VID(1:LVID)//' -l '//LABTYP//' -g '//MODEL
- + // ' -q ' //FSEQ(1:LFSEQ)
-#endif
-#if defined(CERNLIB_SHIFT)
- + // ' -s '//CSIZE
-#endif
-#if (defined(CERNLIB_SHIFT))&&(defined(CERNLIB_OLDDPM))
- + // ' -u '//CHUSER(1:LUSER)
- + // ' -p '//CHPOOL
-#endif
-#if defined(CERNLIB_CRAY)
- + // ' -K -S sbin'
-#endif
-#if defined(CERNLIB_CRAY)||defined(CERNLIB_SHIFT)
-
- IF(IMODE.NE.0) CHCOMM(1:8) = 'stageout'
-#endif
-#if defined(CERNLIB_CRAY)||defined(CERNLIB_SHIFT)||defined(CERNLIB_APOLLO)
- LENCOM = LENOCC(CHCOMM)
-#endif
-#if defined(CERNLIB_CRAY)||defined(CERNLIB_SHIFT)
-*
-* Add DSN if IOPTN not specified
-*
- IF(IOPTN.EQ.0) THEN
- CHCOMM = CHCOMM(1:LENCOM) // ' -f '//CHDSN(1:LDSN)
- LENCOM = LENOCC(CHCOMM)
- ENDIF
-
-#endif
-#if defined(CERNLIB_APOLLO)
-*
-* Add DSN if IOPTN not specified
-*
- IF(IOPTN.EQ.0) THEN
- CHCOMM = CHCOMM(1:LENCOM) // ' -n '//CHDSN(1:LDSN)
- LENCOM = LENOCC(CHCOMM)
- ENDIF
-
-#endif
-#if defined(CERNLIB_CRAY)||defined(CERNLIB_SHIFT)
-*
-* Option T - direct access to tapes
-*
- IF(IOPTT.NE.0) THEN
- CHCOMM(1:8) = 'setup '
-*
-* Option W - write access
-*
- IF(IOPTW.NE.0) THEN
- CHCOMM = CHCOMM(1:LENCOM) // '-r in'
- LENCOM = LENCOM + 5
- ENDIF
-
- ENDIF
-*
-* Add DCB information
-*
- IF(LRECL.EQ.0.OR.LBLOCK.EQ.0.OR.RECFM(1:1).EQ.' ') THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMTAPE. DCB information ',
- + 'missing or invalid'
- IF(IDEBFA.GE.-3) PRINT *,'FMTAPE. lrecl = ',LRECL,
- + ' blocksize = ',LBLOCK,' recfm = ',RECFM
- IRC = 27
- GOTO 80
- ENDIF
-
-#endif
-#if defined(CERNLIB_SHIFT)
- IF(RECFM.EQ.'U') RECFM = 'F'
-#endif
-#if defined(CERNLIB_CRAY)||defined(CERNLIB_SHIFT)
-
- WRITE(DCB,9006) RECFM,LRECL,LBLOCK
- 9006 FORMAT(' -F ',A,' -L ',I6,' -b ',I6)
- CHCOMM = CHCOMM(1:LENOCC(CHCOMM)) // DCB
- LENCOM = LENOCC(CHCOMM)
-
-#endif
-#if (defined(CERNLIB_SHIFT))&&(!defined(CERNLIB_TMS))
-*
-* Add density
-*
- CHCOMM = CHCOMM(1:LENCOM) // ' -d ' // DENS
- LENCOM = LENOCC(CHCOMM)
-#endif
-#if defined(CERNLIB_SHIFT)
- CHCOMM = CHCOMM(1:LENCOM) // ' '//CHFILE(1:LFILE)
- LENCOM = LENCOM + LFILE + 1
-*
-* NOWAIT option
-*
- IF(.NOT.IWAIT) THEN
- LENCOM = LENCOM + 1
- CHCOMM(LENCOM:LENCOM) = '&'
- ENDIF
-#endif
-#if defined(CERNLIB_APOLLO)
-*
-* Add DCB information, direct output to temporary file
-*
- CALL FMFNME(CHFILE)
- LCHF = LENOCC(CHFILE)
- IF(IDEBFA.GE.2.AND.IOPTY.EQ.0)
- + PRINT *,'FMTAPE. output of STAGE command ',
- + 'will be sent to /tmp/'//CHFILE(1:LCHF)
- WRITE(DCB,9006) RECFM,LRECL,LBLOCK
- 9006 FORMAT(' -r ',A,' -c ',I5,' -b ',I5)
- CHCOMM = CHCOMM(1:LENOCC(CHCOMM)) // DCB
- + // ' ' // VSN(1:LVSN)
- + // ' > /tmp/'//CHFILE(1:LCHF)
- LENCOM = LENOCC(CHCOMM)
-
-#endif
-#if defined(CERNLIB_CRAY)||defined(CERNLIB_SHIFT)||defined(CERNLIB_APOLLO)
-
- CALL CSQMBL(CHCOMM,1,LENCOM)
- LENCOM = IS(1)
-*
-* Write command to file and return
-*
- IF(IOPTY.NE.0) THEN
- CHOPEN = '/tmp/'//CHUSER(1:LUSER)//'.fmstage'
- LOPEN = LUSER + 12
- CALL CUTOL(CHOPEN(1:LOPEN))
- IF(IDEBFA.GE.1) PRINT *,'FMTAPE. writing STAGE command to ',
- + CHOPEN(1:LOPEN)
- OPEN(LUN,STATUS='UNKNOWN',ACCESS='SEQUENTIAL',
- + FORM='FORMATTED',
- + FILE=CHOPEN(1:LOPEN),
- + IOSTAT=IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMTAPE. iostat ',IRC,
- + ' from open of temporary file (option Y)'
- GOTO 80
- ENDIF
-#endif
-#if defined(CERNLIB_APOLLO)
- LENCOM = INDEX(CHCOMM,'>') - 1
-#endif
-#if defined(CERNLIB_CRAY)||defined(CERNLIB_SHIFT)||defined(CERNLIB_APOLLO)
- WRITE(LUN,'(A)',IOSTAT=IRC) CHCOMM(1:LENCOM)
- IF(IRC.NE.0) GOTO 80
- CLOSE(LUN)
- GOTO 80
- ENDIF
- IF(IDEBFA.GE.0) PRINT *,'FMTAPE. executing ',CHCOMM(1:LENCOM)
-#endif
-#if defined(CERNLIB_APOLLO)
- ISTAT = 0
- 60 CONTINUE
- IC = SYSTEMF(CHCOMM(1:LENCOM))
-*
-* Check output of stage command
-*
- OPEN(LUN,FILE='/tmp/'//CHFILE(1:LCHF),STATUS='OLD',
- + FORM='FORMATTED')
- 70 READ(LUN,'(A)',END=30 ) CHLINE
- LCHL = LENOCC(CHLINE)
- IF(IDEBFA.GE.0) PRINT *,'FMTAPE. ',CHLINE(1:LCHL)
- IF(INDEX(CHLINE(1:LCHL),'path : ').NE.0) THEN
- ISTART = INDEX(CHLINE(1:LCHL),'/')
- STGPTH = CHLINE(ISTART:)
- CHFNFA = STGPTH
- LNFNFA = LENOCC(CHFNFA)
- ELSEIF(INDEX(CHLINE(1:LCHL),'stat : ').NE.0) THEN
- ISTAT = 1
- IF(INDEX(CHLINE(1:LCHL),'ABORTED').NE.0) THEN
- IRC = -1
- GOTO 80
- ELSEIF(INDEX(CHLINE(1:LCHL),'ENDED_OK').NE.0) THEN
- GOTO 30
- ENDIF
- ENDIF
- GOTO 70
- 30 CLOSE(LUN)
- IF(ISTAT.EQ.0) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMTAPE. no status return ',
- + 'from stage. Will retry in 60 seconds'
- CALL SLEEPF(60)
- GOTO 60
- ENDIF
-#endif
-#if defined(CERNLIB_SHIFT)
- IRC = SYSTEMF(CHCOMM(1:LENCOM))
- IF(IRC.NE.0) THEN
- PRINT *,'FMTAPE. return code ',IRC,' from stage command'
- GOTO 80
- ENDIF
-
- IF(.NOT.IWAIT) GOTO 80
-
- IF(IOPTU.EQ.0) THEN
-*
-* New stager?
-*
- INQUIRE(FILE=CHFILE(1:LFILE),EXIST=IEXIST)
-
- IF(IEXIST) THEN
- IF(IDEBFA.GE.1) WRITE(LPRTFA,9005)
- 9005 FORMAT(' FMTAPE. new stager detected')
-
- SHFNAM = CHFILE(1:LFILE)
- ISTAT = READLNF(CHFILE(1:LFILE),CHFNFA)
- LNFNFA = IS(1)
- ELSE
- IF(IDEBFA.GE.1) WRITE(LPRTFA,9007)
- 9007 FORMAT(' FMTAPE. old stager detected')
-
- IF(ISFGET.NE.0) THEN
-*
-* Issue SFGET to resolve link and hence activate RFIO
-* (not necessary with latest SHIFT s/w)
-*
- CALL FMFGET(CHPOOL,CHUSER,CHFILE,SHFNAM,IMODE,'T',IRC)
- IF(IRC.NE.0) THEN
- PRINT *,'FMTAPE. return code ',IRC,' from sfget'
- GOTO 80
- ELSE
-*
-* Fully qualified file name
-*
- CHFNFA = SHFNAM(1:IS(1))
- LNFNFA = IS(1)
- ENDIF
- ELSE
- SHFNAM = CHFILE(1:LFILE)
- ISTAT = READLNF(CHFILE(1:LFILE),CHFNFA)
- LNFNFA = IS(1)
- ENDIF
- ENDIF
- ENDIF
-#endif
-#if defined(CERNLIB_CRAY)
- IRC = SYSTEMF(CHCOMM(1:LENCOM))
- CALL FMASSN(FORLUN,CHFNFA,'G',ICODE)
- LNFNFA = LENOCC(CHFNFA)
-#endif
- 80 CONTINUE
- IF(IDEBFA.GE.1) THEN
- CALL DATIME(ID,IT)
- PRINT 9008,ID,IT,IS(6)
- 9008 FORMAT(' FMTAPE. exit at ',I6.6,1X,I4.4,I2.2)
- ENDIF
-
- END
diff --git a/src/packlib/fatmen/fmint/fmtouc.F b/src/packlib/fatmen/fmint/fmtouc.F
deleted file mode 100644
index ba4e02f..0000000
--- a/src/packlib/fatmen/fmint/fmtouc.F
+++ /dev/null
@@ -1,139 +0,0 @@
-*
-* $Id: fmtouc.F,v 1.1.1.1 1996/03/07 15:18:09 mclareni Exp $
-*
-* $Log: fmtouc.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:09 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMTOUC(GENAM,KEYS,CHOPT,IRC)
- CHARACTER*(*) GENAM
- PARAMETER (LKEYFA=10)
-#include "fatmen/faust.inc"
-#include "fatmen/fmaxcop.inc"
- DIMENSION KEYS(LKEYFA)
- DIMENSION KEYSIN(LKEYFA),KEYSOU(LKEYFA,MAXCOP)
- INTEGER FMUSER,FMHOST,FMJOB,FMACNT
- CHARACTER*8 CNAME,CTYPE,CSYS,CUSER,CACCT
- CHARACTER*16 CJOB
-
-#include "fatmen/fatbank.inc"
-#include "fatmen/fatpara.inc"
-#include "fatmen/fatopts.inc"
-*
-* Options: O - set owner information
-* T - set last access time to now
-* U - zero use count
-* A - set account field
-* C - clear comment field
-*
- IRC = 0
- LG = LENOCC(GENAM)
- IF(IDEBFA.GT.0) PRINT *,'FMTOUC. updating ',GENAM(1:LG)
-*
- IC = FMUSER(CUSER)
- IC = FMHOST(CNAME,CTYPE,CSYS)
- IC = FMACNT(CACCT)
- IC = FMJOB(CJOB)
-*
- IF(KEYS(1).GT.0) CALL FMPKEY(KEYS,LKEYFA)
- KEYSIN(MKSRFA) = -1
- KEYSIN(MKMTFA) = -1
- KEYSIN(MKLCFA) = -1
- KEYSIN(MKCLFA) = -1
- CALL FMSELK(GENAM(1:LG),KEYSIN,KEYSOU,NFOUND,MAXCOP,IRC)
- IF(IDEBFA.GT.0) PRINT *,'FMTOUC. ',NFOUND,
- + ' entries for ',GENAM(1:LG),' found '
-
- DO 10 I=1,NFOUND
- IF((KEYS(1).GT.0).AND.(KEYSOU(1,I).NE.KEYS(1))) GOTO 10
- LTDSFA = 0
- CALL FMGETK(GENAM(1:LG),LTDSFA,KEYSOU(1,I),IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.0)
- + PRINT *,'FMTOUC. return code ',IRC,' from FMGETK'
- GOTO 10
- ENDIF
-
- IF (IOPTA.NE.0) THEN
-*
-* Account field
-*
- IF(IDEBFA.GE.0)
- + PRINT *,'FMTOUC. Setting account field'
- CALL FMPUTC(LTDSFA,CACCT,MCIDFA,NCIDFA,IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMTOUC. error setting account'
- GOTO 10
- ENDIF
-
- ENDIF
-
- IF (IOPTC.NE.0) THEN
-*
-* Comment field
-*
- IF(IDEBFA.GE.0)
- + PRINT *,'FMTOUC. clearing comment field'
- CALL VBLANK(IQ(LTDSFA+KOFUFA+MUCMFA),NUCMFA)
-
- ENDIF
-
-
- IF (IOPTO.NE.0) THEN
-*
-* Owner attributes
-*
- IF(IDEBFA.GE.0)
- + PRINT *,'FMTOUC. Setting owner attributes'
- CALL FMPUTC(LTDSFA,CUSER,MCURFA,NCURFA,IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMTOUC. error setting user name'
- GOTO 10
- ENDIF
- CALL FMPUTC(LTDSFA,CNAME,MCNIFA,NCNIFA,IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMTOUC. error setting node name'
- GOTO 10
- ENDIF
- CALL FMPUTC(LTDSFA,CACCT,MCIDFA,NCIDFA,IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMTOUC. error setting account'
- GOTO 10
- ENDIF
- CALL FMPUTC(LTDSFA,CJOB ,MCJIFA,NCJIFA,IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMTOUC. error setting job name'
- GOTO 10
- ENDIF
- ENDIF
-
- IF (IOPTT.NE.0) THEN
-*
-* Time attributes
-*
- CALL DATIME(IDATE,ITIME)
- CALL FMPKTM(IDATE,ITIME,IPACK,IRC)
- IF(IDEBFA.GE.0)
- + PRINT *,'FMTOUC. date & time of last access ',
- + 'will be set to ',IDATE,ITIME
- IQ(LTDSFA+KOFUFA+MLATFA) = IPACK
- ENDIF
-
- IF (IOPTU.NE.0) THEN
-*
-* Use count
-*
- IF(IDEBFA.GE.0) PRINT *,'FMTOUC. use count will be zeroed'
- IQ(LTDSFA+KOFUFA+MUSCFA) = 0
- ENDIF
-
- NFTOUC = NFTOUC + 1
- CALL FMMOD(GENAM(1:LG),LTDSFA,0,IRC)
- CALL MZDROP(IDIVFA,LTDSFA,' ')
- LTDSFA = 0
-10 CONTINUE
-
- END
-
diff --git a/src/packlib/fatmen/fmint/fmuniq.F b/src/packlib/fatmen/fmint/fmuniq.F
deleted file mode 100644
index d430b58..0000000
--- a/src/packlib/fatmen/fmint/fmuniq.F
+++ /dev/null
@@ -1,109 +0,0 @@
-*
-* $Id: fmuniq.F,v 1.1.1.1 1996/03/07 15:18:11 mclareni Exp $
-*
-* $Log: fmuniq.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:11 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMUNIQ(PATH,KEYSIN,FILES,MAXFIL,NMATCH,CHOPT,IRC)
-*CMZ : 23/01/91 10.44.19 by Jamie Shiers
-*-- Author : Jamie Shiers 23/01/91
-* Routine to return a list of unique file names in the
-* specified directory.
-*
-#include "fatmen/fatbank.inc"
-#include "fatmen/fatpara.inc"
- CHARACTER*(*) PATH,FILES(MAXFIL)
- CHARACTER*20 FNAME
- CHARACTER*255 CWD,PATHN
-#include "fatmen/fmnkeys.inc"
- PARAMETER (NMAX=100)
- DIMENSION MYVECT(LKEYFA)
- DIMENSION KEYSIN(LKEYFA)
- DIMENSION MYKEYS(LKEYFA,NMAX)
-#include "fatmen/fatopts.inc"
-*
-* NMAX limits the maximum number of keys that can be processed
-* in a single call to FMKEYS
-*
- IRC = 0
-*
-* Save current directory
-*
- CALL FACDIR(CWD,'R')
-*
-* Reset current directory
-*
- LPATH = LENOCC(PATH)
- PATHN = PATH
- CALL FACDIR(PATH(1:LPATH),' ')
-
- IF(IQUEST(1) .NE. 0) THEN
- IRC = -1
- GOTO 999
- ENDIF
-*
-* Build compare vector
-*
- CALL VZERO(MYVECT,LKEYFA)
- CALL UCOPY(KEYSIN(MKCLFA),MYVECT(MKCLFA),LKEYFA-MKCLFA+1)
- IFIRST = 1
- ILAST = NMAX
- NDONE = 0
- NMATCH = 0
-1 CONTINUE
- CALL FMKEYS(LKEYFA,NMAX,IFIRST,ILAST,MYKEYS,NFILES,IRET)
- NKEYS = IQUEST(11)
- IF(IQUEST(1) .NE. 0) THEN
- IF(IDEBFA.GE.2)
- + PRINT *,'FMUNIQ. More than ',NMAX,' files in ',PATH(1:LPATH)
- IF(IDEBFA.GE.2)
- + PRINT *,'FMUNIQ. IQUEST(11-12) = ',IQUEST(11),IQUEST(12)
- ENDIF
-*
-* Process all keys returned and move those that match to KEYSOU
-*
- NRET = IQUEST(13)
- DO 10 I=1,NRET
-*
-* Check media type, copy level and location code
-* (essentially just keys(7-9)
-*
- DO 20 J=MKMTFA,MKLCFA
-*
-* Don't compare negative fields
-*
- IF((MYVECT(J) .LT. 0) .AND. (J.GE.MKCLFA)) GOTO 20
- IF(MYVECT(J) .NE. MYKEYS(J,I)) GOTO 10
-20 CONTINUE
- FNAME = ' '
- CALL UHTOC(MYKEYS(MKFNFA,I),4,FNAME,(MKCLFA-MKFNFA)*4)
-*
-* Have we already got this file name?
-*
- JX = ICNTH(PATHN(1:LPATH)//'/'//FNAME,FILES,NDONE)
- IF(JX.NE.0) GOTO 10
-*
-* Can we accept any more keys?
-*
- NMATCH = NMATCH + 1
- IF(NDONE .LT. MAXFIL) THEN
- NDONE = NDONE + 1
- FILES(NDONE) = PATHN(1:LPATH)//'/'//FNAME
- ELSE
- IRC = 1
- ENDIF
-
-10 CONTINUE
- IF(ILAST.LT.NKEYS) THEN
- IFIRST = IFIRST + NMAX
- ILAST = MIN(NKEYS,ILAST+NMAX)
- GOTO 1
- ENDIF
-
-999 CALL FACDIR(CWD(1:LENOCC(CWD)),' ')
- IQUEST(11) = NMATCH
- IQUEST(12) = NKEYS
- END
diff --git a/src/packlib/fatmen/fmint/fmupdt.F b/src/packlib/fatmen/fmint/fmupdt.F
deleted file mode 100644
index ff7a594..0000000
--- a/src/packlib/fatmen/fmint/fmupdt.F
+++ /dev/null
@@ -1,116 +0,0 @@
-*
-* $Id: fmupdt.F,v 1.2 1996/10/29 10:08:22 jamie Exp $
-*
-* $Log: fmupdt.F,v $
-* Revision 1.2 1996/10/29 10:08:22 jamie
-* Protect against unit 0
-*
-* Revision 1.1.1.1 1996/03/07 15:18:11 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMUPDT(MAX,NBATCH,IFLAG,IRC)
-*
-* Subroutine to control how updates are sent.
-* Defaults are MAX=999, NGROUP=0
-* IFLAG=-1 = reset to system defaults
-* 0 = reset as per MAX and NGROUP sending outstanding updates
-* +1 = reset as per MAX and NGROUP purging outstanding updates
-*
-#include "fatmen/fatsys.inc"
-#include "fatmen/fatupd.inc"
-#include "fatmen/fatbank.inc"
- CHARACTER*255 CHFILE
- LOGICAL IOPEN
-
- MAXDEF = 999
- NGRDEF = 0
- IRC = 0
-
- LUNFZ = IABS(LUFZFA)
- IF(LUNFZ.EQ.0) THEN
- IOPEN = .FALSE.
- ELSE
- INQUIRE(LUNFZ,OPENED=IOPEN,NAME=CHFILE)
- ENDIF
-
- IF(IOPEN) LFILE = LENOCC(CHFILE)
-#if defined(CERNLIB_IBM)
- ISTART = 2
-#endif
-#if !defined(CERNLIB_IBM)
- ISTART = 1
-#endif
-*
-* Branch according to IFLAG
-*
- IF(IFLAG.LT.0) THEN
-*
- MAXUPD = MAXDEF
- NGROUP = NGRDEF
-#if defined(CERNLIB_IBMVM)
- IF(LUFZFA.GT.0.AND.FATNOD.EQ.' ') THEN
- IF(IOPEN) CLOSE(LUNFZ)
- CALL VMCMS('CP SPOOL PUNCH NOCONT CLOSE',IRC)
- ELSE
-#endif
- IF(IOPEN) THEN
- CLOSE(LUNFZ)
- CALL FMSEND(CHFILE(ISTART:LFILE),IRC)
- ENDIF
-#if defined(CERNLIB_IBMVM)
- ENDIF
-#endif
- IF(IDEBFA .GE. 2) WRITE(LPRTFA,9001) MAXUPD,NGROUP
- 9001 FORMAT(' FMUPDT. FATMEN updating parameters reset to defaults',/,
- + ' FMUPDT. MAX = ',I10,' NGROUP = ',I10)
-*
- ELSEIF(IFLAG.EQ.0) THEN
- MAXUPD = MAX
- NGROUP = NBATCH
-#if defined(CERNLIB_IBMVM)
- IF(LUFZFA.GT.0.AND.FATNOD.EQ.' ') THEN
- IF(IOPEN) CLOSE(LUNFZ)
- CALL VMCMS('CP SPOOL PUNCH NOCONT CLOSE',IRC)
- IF(NGROUP.GT.0) CALL VMCMS('CP SPOOL PUNCH CONT',IRC)
- ELSE
-#endif
- IF(IOPEN) THEN
- CLOSE(LUNFZ)
- CALL FMSEND(CHFILE(ISTART:LFILE),IRC)
- ENDIF
-#if defined(CERNLIB_IBMVM)
- ENDIF
-#endif
- IF(IDEBFA .GE. 2) WRITE(LPRTFA,9002) MAXUPD,NGROUP
- 9002 FORMAT(' FMUPDT. FATMEN updating parameters reset as follows',/,
- + ' FMUPDT. MAX = ',I10,' NGROUP = ',I10,/,
- + ' FMUPDT. Any outstanding updates have been sent')
- ELSE
- MAXUPD = MAX
- NGROUP = NBATCH
-#if defined(CERNLIB_IBMVM)
- IF(IOPEN) CLOSE(LUNFZ)
- IF(LUFZFA.GT.0.AND.FATNOD.EQ.' ') THEN
- CALL VMCMS('CP SPOOL PUNCH NOCONT PURGE',IRC)
- IF(NGROUP.GT.0) CALL VMCMS('CP SPOOL PUNCH CONT',IRC)
- ELSE
-#endif
- IF(IOPEN) THEN
- CLOSE(LUNFZ,STATUS='DELETE')
- IF(IDEBFA.GE.1) PRINT *,'FMUPDT. purging update file ',
- + CHFILE(ISTART:LFILE)
- ENDIF
-#if defined(CERNLIB_IBMVM)
- ENDIF
-#endif
- IF(IDEBFA .GE. 2) WRITE(LPRTFA,9003) MAXUPD,NGROUP
- 9003 FORMAT(' FMUPDT. FATMEN updating parameters reset as follows',/,
- + ' FMUPDT. MAX = ',I10,' NGROUP = ',I10,/,
- + ' FMUPDT. Any outstanding updates have been purged')
-
- ENDIF
-*
-
- END
diff --git a/src/packlib/fatmen/fmint/fmupky.F b/src/packlib/fatmen/fmint/fmupky.F
deleted file mode 100644
index b098c04..0000000
--- a/src/packlib/fatmen/fmint/fmupky.F
+++ /dev/null
@@ -1,30 +0,0 @@
-*
-* $Id: fmupky.F,v 1.1.1.1 1996/03/07 15:18:10 mclareni Exp $
-*
-* $Log: fmupky.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:10 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMUPKY(GENAME,LBANK,KEYS,IRC)
- CHARACTER*(*) GENAME
- PARAMETER (LKEYFA=10)
- DIMENSION KEYS(LKEYFA)
-#include "fatmen/fatbank.inc"
-#include "fatmen/fatpara.inc"
- LGN = LENOCC(GENAME)
-*
-* Fill KEYS vector from bank
-*
- IRC = 0
- LPATH = INDEXB(GENAME(1:LGN),'/')
- CALL VBLANK(KEYS(2),5)
- CALL UCTOH(GENAME(LPATH+1:LGN),KEYS(2),4,LGN-LPATH)
- KEYS(MKSRFA) = 0
- KEYS(MKCLFA) = IQ(LBANK+KOFUFA+MCPLFA)
- KEYS(MKLCFA) = IQ(LBANK+KOFUFA+MLOCFA)
- KEYS(MKMTFA) = IQ(LBANK+KOFUFA+MMTPFA)
- KEYS(MKNBFA) = MKNBFA
- END
-
diff --git a/src/packlib/fatmen/fmint/fmuprt.F b/src/packlib/fatmen/fmint/fmuprt.F
deleted file mode 100644
index 3221d3f..0000000
--- a/src/packlib/fatmen/fmint/fmuprt.F
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: fmuprt.F,v 1.1.1.1 1996/03/07 15:18:10 mclareni Exp $
-*
-* $Log: fmuprt.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:10 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMUPRT(GENAM,LBANK,KEYS,IUSER,COMM,IRC)
- CHARACTER*(*) GENAM,COMM
- DIMENSION KEYS(10),IUSER(10)
-* Dummy FMUPRT routine
- IRC = 0
- END
-
diff --git a/src/packlib/fatmen/fmint/fmvers.F b/src/packlib/fatmen/fmint/fmvers.F
deleted file mode 100644
index f81bf5c..0000000
--- a/src/packlib/fatmen/fmint/fmvers.F
+++ /dev/null
@@ -1,123 +0,0 @@
-*
-* $Id: fmvers.F,v 1.5 1996/04/12 07:16:31 cernlib Exp $
-*
-* $Log: fmvers.F,v $
-* Revision 1.5 1996/04/12 07:16:31 cernlib
-* new handling of qftitle
-*
-* Revision 1.4 1996/03/29 11:29:57 jamie
-* qftitlch
-*
-* Revision 1.3 1996/03/29 10:56:06 jamie
-* print 'title' more like good-old patchy
-*
-* Revision 1.2 1996/03/28 10:28:59 jamie
-* update idatqq/itimqq and remove check on old version in fminit
-*
-* Revision 1.1.1.1 1996/03/07 15:18:11 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMVERS
-#include "fatmen/fatapol3.inc"
-#include "fatmen/fatclio.inc"
-#include "fatmen/fatmss.inc"
-#include "fatmen/fatpara.inc"
-#include "zebra/quest.inc"
-#if !defined(CERNLIB_CRAY)
- PARAMETER (IQCHAW=4)
-#endif
-#if defined(CERNLIB_CRAY)
- PARAMETER (IQCHAW=8)
-#endif
-#include "fatmen/qftitlch.inc"
- CHARACTER VIDQQ*(*)
- PARAMETER (VIDQQ = '@(#)' //
- + FatmenTitleFortranString
- + // '>')
- CALL CLEFT (VIDQQ,1,0)
-
- IDATQQ = 960329
- ITIMQQ = 1200
- PRINT *,
- + FatmenTitleFortranString
- PRINT *,' This version created on ',IDATQQ,
- + ' at ',ITIMQQ
- PRINT *
- PRINT *,'Main flags selected:'
-#if defined(CERNLIB_CERN)
- PRINT *,' CERN'
- PRINT *,' to activate CERN specific features'
- PRINT *,' (e.g. list of accessible media types)'
-#endif
-#if defined(CERNLIB_CSPACK)
- PRINT *,' CSPACK'
- PRINT *,' for CSPACK access to remote catalogue and data'
-#endif
-#if defined(CERNLIB_IBMVM)
- PRINT *,' IBMVM'
-#endif
-#if defined(CERNLIB_IBMMVS)
- PRINT *,' IBMMVS'
-#endif
-#if defined(CERNLIB_VAXVMS)
- PRINT *,' VAXVMS'
-#endif
-#if defined(CERNLIB_UNIX)
- PRINT *,' UNIX'
-#endif
-#if defined(CERNLIB_SHIFT)
- PRINT *,' SHIFT'
- PRINT *,' interface to SHIFT software'
-#endif
-#if defined(CERNLIB_VAXTAP)
- PRINT *,' VAXTAP'
- PRINT *,' use VAXTAP package for tape handling'
-#endif
-#if defined(CERNLIB_HEPVM)
- PRINT *,' HEPVM'
- PRINT *,' use HEPVM STAGE and SETUP for tape handling'
-#endif
-#if defined(CERNLIB_TMS)
- PRINT *,' TMS'
- PRINT *,' interface to HEPVM Tape Management System'
-#endif
-#if defined(CERNLIB_NOSMCF)
- PRINT *,' NOSMCF'
- PRINT *,' no access to SMCF robot'
-#endif
-#if defined(CERNLIB_PREFIX)
- PRINT *,' PREFIX'
- PRINT *,' provide VID prefix support'
-#endif
-#if defined(CERNLIB_VMBATCH)
- PRINT *,' VMBATCH'
- PRINT *,' interface to VMBATCH system'
-#endif
-#if defined(CERNLIB_VMTAPE)
- PRINT *,' VMTAPE'
- PRINT *,' interface to VMTAPE system'
-#endif
-#if defined(CERNLIB_NEEDFILE)
- PRINT *,' NEEDFILE'
- PRINT *,' interface to NEEDFILE command'
-#endif
-#if defined(CERNLIB_APOLLO)
- IF(IAPOL3.NE.0) THEN
- PRINT *,' L3STAGE (run-time option)'
- PRINT *,' interface to L3STAGE command'
- ENDIF
-#endif
-#if defined(CERNLIB_UNIX)
- IF(ICLIO.NE.0) THEN
- PRINT *,' VMSTAGE (run-time option)'
- PRINT *,' interface to VMSTAGE command via CLIO'
- ENDIF
- IF(IFMMSS.NE.0) THEN
- PRINT *,' MSS (run-time option)'
- PRINT *,' interface to "mssget" (Lachman OSM etc.)'
- ENDIF
-#endif
- END
-
diff --git a/src/packlib/fatmen/fmtms/Imakefile b/src/packlib/fatmen/fmtms/Imakefile
deleted file mode 100644
index 0e6916d..0000000
--- a/src/packlib/fatmen/fmtms/Imakefile
+++ /dev/null
@@ -1,15 +0,0 @@
-SRCS_F= fmallo.F fmamed.F fmedia.F fmgetp.F fmgtms.F fmgvid.F \ @@\
- fmgvol.F fmlock.F fmpool.F fmpref.F fmprot.F fmqmed.F fmqtms.F \ @@\
- fmqvol.F fmsreq.F fmtags.F fmuall.F fmulok.F fmutms.F fmuvol.F \ @@\
- fmvinf.F fmxvid.F
-
-#ifdef CERNLIB_HPUX
-SpecialFortranLibObjectRule(fmqtms,fmqtms,'-WF,-P',NullParameter)
-SpecialFortranLibObjectRule(fmqvol,fmqvol,'-WF,-P',NullParameter)
-#endif
-
-#ifdef CERNLIB_SHIFT
-CERNDEFINES:= $(CERNDEFINES) -DCERNLIB_SHIFT
-#endif
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/fatmen/fmtms/fmallo.F b/src/packlib/fatmen/fmtms/fmallo.F
deleted file mode 100644
index 2e4fe7e..0000000
--- a/src/packlib/fatmen/fmtms/fmallo.F
+++ /dev/null
@@ -1,192 +0,0 @@
-*
-* $Id: fmallo.F,v 1.1.1.1 1996/03/07 15:18:14 mclareni Exp $
-*
-* $Log: fmallo.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:14 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMALLO(MEDIA,CDENS,COMP,LIBRARY,POOL,LBANK,CHOPT,
- +VSN,VID,IRC)
-*
-* Routine to allocate next free piece of media from TMS
-* MEDIA is the medium type, e.g. 3480, 8200 etc.
-* CDENS is the density, e.g. 38K, 76K etc.
-* COMP is the compression type (to be defined).
-* LIBRARY is the two letter experimental series followed by location
-* e.g. PD_DPVAULT
-* POOL is a named pool within this library, e.g. MDST
-* LBANK is the address of the FATMEN bank to be updated
-* CHOPT M - write multi-file tape until tape is full
-* C - write single file tape until full (maybe one day)
-*
-* Return codes: IRC = 0 - success
-* -1 - media type conflict
-* >0 - return code from TMS
-*
-#include "fatmen/slate.inc"
-#include "fatmen/faust.inc"
-#include "fatmen/fatbank.inc"
-#include "fatmen/fatpara.inc"
-#include "fatmen/fattyp.inc"
- CHARACTER*(*) MEDIA,LIBRARY,POOL,VSN,VID,CDENS,COMP
- CHARACTER*80 COMAND,RETCOM
-#include "fatmen/tmsrep.inc"
- PARAMETER (LENTAP=100)
- CHARACTER*132 TAPREP(LENTAP)
- CHARACTER*8 GROUP
-#include "fatmen/fatopts.inc"
-
- NFAVOL = NFAVOL + 1
-#if (!defined(CERNLIB_TMS))&&(defined(CERNLIB_VMTAPE))
-*
-* Allocation is not actually performed until we do the mount...
-*
-#endif
-#if (!defined(CERNLIB_TMS))&&(!defined(CERNLIB_VMTAPE))
-*
-* Call user exit
-*
- CALL FMUALL(MEDIA,CDENS,COMP,LIBRARY,POOL,LBANK,CHOPT,
- +VSN,VID,IRC)
-#endif
-#if defined(CERNLIB_TMS)
- IRC = 0
- NRETRY = 0
-*
-* Get list of free tapes in requested pool & library
-*
- COMAND = ' '
- WRITE(COMAND,9001) LIBRARY,POOL
- 9001 FORMAT('QUERY CONTENTS LIBRARY ',A,' USER ',A,' SLOT 1')
- 10 CONTINUE
- LC = LENOCC(COMAND)
- IF(IDEBFA.GT.0)
- +PRINT *,'FMALLO. Issuing TMS command ',COMAND(1:LC)
- I = LENTAP
- CALL FMSREQ('TMS ',COMAND(1:LC),
- + IRC,TAPREP,I)
-
- IF((IDEBFA.GE.0).AND.(IRC.GT.2)) THEN
- PRINT *,'FMALLO. Return code ',IRC,' from FMSREQ'
- PRINT *,TAPREP(1)
- RETURN
- ENDIF
-*
-* Are there any more tapes in this library for eventual retry?
-*
- IF(IRC.EQ.2) THEN
- IRETRY = 1
- RETCOM = TAPREP(I)
- JREP = I - 1
- ELSE
- IRETRY = 0
- JREP = I
- ENDIF
-
- IF((TAPREP(1)(1:7).NE.'Library').OR.
- + (TAPREP(2)(1:7).NE.'-------')) THEN
- PRINT *,'FMALLO. Cannot interpret reply from FMSREQ'
- PRINT *,TAPREP(1)
- PRINT *,TAPREP(2)
- IRC = 1
- RETURN
- ENDIF
-*
-* Attempt to allocate the first free tape
-* Should loop over all tapes in list until one with matching
-* characteristics is found.
-*
- JVOL = 3
- 20 CONTINUE
- VID = TAPREP(JVOL)(24:29)
- LMEDIA = LENOCC(MEDIA)
- IF(MEDIA(1:LMEDIA).NE.TAPREP(JVOL)(31:30+LMEDIA)) THEN
- IF(IDEBFA.GE.0) THEN
- PRINT *,'FMALLO. library/pool is not of type ',
- + MEDIA(1:LMEDIA)
- PRINT *,TAPREP(JVOL)
- ENDIF
-
- JVOL = JVOL + 1
- IF(JVOL.LE.JREP) GOTO 20
- IF(IRETRY.NE.0) THEN
- COMAND = RETCOM
- GOTO 10
- ENDIF
- IRC = 2
- RETURN
- ENDIF
-*
-* Get VSN, VID, Density and Group
-*
- COMAND = ' '
- WRITE(COMAND,9002) VID
- 9002 FORMAT('QUERY VID ',A,' (VSN DENSITY GROUP')
- LC = LENOCC(COMAND)
- IF(IDEBFA.GT.0)
- +PRINT *,'FMALLO. Issuing TMS command ',COMAND(1:LC)
- I = LENREP
- CALL FMSREQ('TMS ',COMAND(1:LC),
- + IRC,TMSREP,I)
- IF((IDEBFA.GE.0).AND.(IRC.NE.0)) THEN
- PRINT *,'FMALLO. Return code ',IRC,' from FMSREQ'
- PRINT *,TMSREP(1)
- RETURN
- ENDIF
-
- VSN = TMSREP(1)(8:13)
-* READ(TMSREP(1)(17:22),'(I6)') IDENS
- IDENS = ICDECI(TMSREP(1),17,22)
- IF(IS(2).LE.22.AND.TMSREP(1)(IS(2):IS(2)).EQ.'K') IDENS =
- + IDENS * 1000
- IF(IOPTG.NE.0) THEN
- IF(IDEBFA.GT.2)
- + PRINT *,'FMALLO. Option G specified: group set to *None'
- GROUP = '*None '
- ELSE
- GROUP = TMSREP(1)(24:31)
- IF(IDEBFA.GT.2)
- + PRINT *,'FMALLO. Group will remain ',GROUP
- ENDIF
-
- COMAND = ' '
- WRITE(COMAND,9003) VID,POOL,GROUP
- 9003 FORMAT('GETPOOL VID ',A,' FROM ',A,' NEWGROUP ',A)
- LC = LENOCC(COMAND)
- IF(IDEBFA.GT.0)
- +PRINT *,'FMALLO. Issuing TMS command ',COMAND(1:LC)
- I = LENREP
- CALL FMSREQ('TMS ',COMAND(1:LC),
- + IRC,TMSREP,I)
- IF((IDEBFA.GE.0).AND.(IRC.NE.0)) THEN
- PRINT *,'FMALLO. Return code ',IRC,' from FMSREQ'
- PRINT *,TMSREP(1)
- JVOL = JVOL + 1
-*
-* Retry using next volume from the last batch returned
-*
- IF(JVOL.LE.JREP) GOTO 20
-*
-* If batch is exhausted, go and get a new batch (if available)
-*
- IF(IRETRY.NE.0) THEN
- COMAND = RETCOM
- GOTO 10
- ENDIF
- RETURN
- ENDIF
-
- IF(LBANK.NE.0) THEN
- CALL UCTOH(VSN,IQ(LBANK+KOFUFA+MVSNFA),4,6)
- CALL UCTOH(VID,IQ(LBANK+KOFUFA+MVIDFA),4,6)
- IQ(LBANK+KOFUFA+MDENFA) = IDENS
- IQ(LBANK+KOFUFA+MFSQFA) = 1
- IQ(LBANK+KOFUFA+MVSQFA) = 1
-
- IQ(LBANK+KOFUFA+MMTPFA) = ICNTH(MEDIA,CHMTYP,NMTYP)
- ENDIF
-#endif
- END
-
diff --git a/src/packlib/fatmen/fmtms/fmamed.F b/src/packlib/fatmen/fmtms/fmamed.F
deleted file mode 100644
index 744c084..0000000
--- a/src/packlib/fatmen/fmtms/fmamed.F
+++ /dev/null
@@ -1,60 +0,0 @@
-*
-* $Id: fmamed.F,v 1.1.1.1 1996/03/07 15:18:15 mclareni Exp $
-*
-* $Log: fmamed.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:15 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMAMED(MFMMED,MFMTYP,MFMGEN,MFMSIZ,MFMDEN,
- + MFMMNT,MFMLAB,NMEDIA,IRC)
-#include "fatmen/fattyp.inc"
-#include "fatmen/fatbug.inc"
-*
- DIMENSION MFMMED(NMEDIA)
- CHARACTER*(*) MFMTYP(NMEDIA),MFMGEN(NMEDIA),MFMSIZ(NMEDIA),
- + MFMDEN(NMEDIA),MFMMNT(NMEDIA),MFMLAB(NMEDIA)
-*CMZ : 01/07/91 12.33.12 by Jamie Shiers
-*-- Author : Jamie Shiers 01/07/91
- IRC = 0
- DO 10 I=1,NMEDIA
- J = MFMMED(I)
- IF(J.GT.NMTYP) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMEDIA. media type ',J,
- + ' outside range. Maximum allowed value = ',NMTYP
- GOTO 10
- ENDIF
-
- NFMTYP = NFMTYP + 1
-*
-* Physical device type
-*
- CHMTYP(NFMTYP) = MFMTYP(J)
-*
-* Generic device type
-*
- CHMGEN(NFMTYP) = MFMGEN(J)
-*
-* Capacity
-*
- CHMSIZ(NFMTYP) = MFMSIZ(J)
- MEDSIZ(NFMTYP) = ICDECI(MFMSIZ(J),1,LENOCC(MFMSIZ(J)))
-*
-* Density
-*
- CHMDEN(NFMTYP) = MFMDEN(J)
- MEDDEN(NFMTYP) = ICDECI(MFMDEN(J),1,LENOCC(MFMDEN(J)))
- IF(INDEX(MFMDEN(NFMTYP),'K').NE.0)
- + MEDDEN(NFMTYP) = MEDDEN(NFMTYP) * 1000
-*
-* Label type
-*
- CHMLAB(NFMTYP) = MFMLAB(J)
-*
-* Mount type
-*
- CHMMNT(NFMTYP) = MFMMNT(J)
-*
-10 CONTINUE
- END
diff --git a/src/packlib/fatmen/fmtms/fmedia.F b/src/packlib/fatmen/fmtms/fmedia.F
deleted file mode 100644
index fb877c1..0000000
--- a/src/packlib/fatmen/fmtms/fmedia.F
+++ /dev/null
@@ -1,71 +0,0 @@
-*
-* $Id: fmedia.F,v 1.1.1.1 1996/03/07 15:18:15 mclareni Exp $
-*
-* $Log: fmedia.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:15 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMEDIA(MFMMED,MFMTYP,MFMGEN,MFMSIZ,MFMDEN,
- + MFMMNT,MFMLAB,NMEDIA,IRC)
-#include "fatmen/fattyp.inc"
-#include "fatmen/fatbug.inc"
-*
- DIMENSION MFMMED(NMEDIA)
- CHARACTER*(*) MFMTYP(NMEDIA),MFMGEN(NMEDIA),MFMSIZ(NMEDIA),
- + MFMDEN(NMEDIA),MFMMNT(NMEDIA),MFMLAB(NMEDIA)
-*CMZ : 01/07/91 12.33.12 by Jamie Shiers
-*-- Author : Jamie Shiers 01/07/91
- IRC = 0
- NFMTYP = NMEDIA
- DO 10 I=1,NMEDIA
- J = MFMMED(I)
- IF(J.GT.NMTYP) THEN
- IF(IDEBFA.GE.-3) PRINT 9001,J,NMTYP
- 9001 FORMAT(' FMEDIA. media type ',I10,
- + ' outside range. Maximum allowed value = ',I10)
- GOTO 10
- ENDIF
-*
-* Physical device type
-*
- CHMTYP(J) = MFMTYP(I)
- IF(IDEBFA.GE.3) WRITE(LPRTFA,9002) J,MFMTYP(I)
- 9002 FORMAT(' FMEDIA. setting physical device type ',I6,' to ',A)
-*
-* Generic device type
-*
- CHMGEN(J) = MFMGEN(I)
- IF(IDEBFA.GE.3) WRITE(LPRTFA,9003) J,MFMGEN(I)
- 9003 FORMAT(' FMEDIA. setting generic device type ',I6,' to ',A)
-*
-* Capacity
-*
- CHMSIZ(J) = MFMSIZ(I)
- MEDSIZ(J) = ICDECI(MFMSIZ(I),1,LENOCC(MFMSIZ(I)))
- IF(IDEBFA.GE.3) WRITE(LPRTFA,9004) J,MFMSIZ(I)
- 9004 FORMAT(' FMEDIA. setting capacity of type ',I6,' to ',A)
-*
-* Density
-*
- CHMDEN(J) = MFMDEN(I)
- MEDDEN(J) = ICDECI(MFMDEN(I),1,LENOCC(MFMDEN(I)))
- IF(INDEX(MFMDEN(I),'K').NE.0) MEDDEN(J) = MEDDEN(J) * 1000
- IF(IDEBFA.GE.3) WRITE(LPRTFA,9005) J,MFMDEN(I)
- 9005 FORMAT(' FMEDIA. setting density of type ',I6,' to ',A)
-*
-* Label type
-*
- CHMLAB(J) = MFMLAB(I)
- IF(IDEBFA.GE.3) WRITE(LPRTFA,9006) J,MFMLAB(I)
- 9006 FORMAT(' FMEDIA. setting label type of type ',I6,' to ',A)
-*
-* Mount type
-*
- CHMMNT(J) = MFMMNT(I)
- IF(IDEBFA.GE.3) WRITE(LPRTFA,9007) J,MFMMNT(I)
- 9007 FORMAT(' FMEDIA. setting mount type of type ',I6,' to ',A)
-*
- 10 CONTINUE
- END
diff --git a/src/packlib/fatmen/fmtms/fmgetp.F b/src/packlib/fatmen/fmtms/fmgetp.F
deleted file mode 100644
index 850a21f..0000000
--- a/src/packlib/fatmen/fmtms/fmgetp.F
+++ /dev/null
@@ -1,71 +0,0 @@
-*
-* $Id: fmgetp.F,v 1.1.1.1 1996/03/07 15:18:15 mclareni Exp $
-*
-* $Log: fmgetp.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:15 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMGETP(VID,POOL,CHOPT,IRC)
-#include "fatmen/fatbank.inc"
-#include "fatmen/fatpara.inc"
-#include "fatmen/fattyp.inc"
- CHARACTER*(*) POOL,VID
- CHARACTER*6 VSN
- CHARACTER*80 COMAND
-#include "fatmen/tmsrep.inc"
- PARAMETER (LENTAP=100)
- CHARACTER*132 TAPREP(LENTAP)
- CHARACTER*8 GROUP
- PARAMETER (MAXRET=1)
-#include "fatmen/fatopts.inc"
-
- IRC = 0
-*
-* Get VSN, VID, Density and Group
-*
- COMAND = ' '
- WRITE(COMAND,9002) VID
- 9002 FORMAT('QUERY VID ',A,' (VSN DENSITY GROUP')
- LC = LENOCC(COMAND)
- IF(IDEBFA.GT.0)
- +PRINT *,'FMGETP. Issuing TMS command ',COMAND(1:LC)
- I = LENREP
- CALL FMSREQ('TMS ',COMAND(1:LC),
- + IRC,TMSREP,I)
- IF((IDEBFA.GE.0).AND.(IRC.NE.0)) THEN
- PRINT *,'FMGETP. Return code ',IRC,' from FMSREQ'
- PRINT *,TMSREP(1)
- RETURN
- ENDIF
-
- VSN = TMSREP(1)(8:13)
- READ(TMSREP(1)(17:22),'(I6)') IDENS
- IF(IOPTG.NE.0) THEN
- IF(IDEBFA.GT.2)
- + PRINT *,'FMGETP. Option G specified: group set to *None'
- GROUP = '*None '
- ELSE
- GROUP = TMSREP(1)(24:31)
- IF(IDEBFA.GT.2)
- + PRINT *,'FMGETP. Group will remain ',GROUP
- ENDIF
-
- COMAND = ' '
- WRITE(COMAND,9003) VID,POOL,GROUP
- 9003 FORMAT('GETPOOL VID ',A,' FROM ',A,' NEWGROUP ',A)
- LC = LENOCC(COMAND)
- IF(IDEBFA.GT.0)
- +PRINT *,'FMGETP. Issuing TMS command ',COMAND(1:LC)
- I = LENREP
- CALL FMSREQ('TMS ',COMAND(1:LC),
- + IRC,TMSREP,I)
-
- IF((IDEBFA.GE.0).AND.(IRC.NE.0)) THEN
- PRINT *,'FMGETP. Return code ',IRC,' from FMSREQ'
- PRINT *,TMSREP(1)
- RETURN
- ENDIF
-
- END
diff --git a/src/packlib/fatmen/fmtms/fmgtms.F b/src/packlib/fatmen/fmtms/fmgtms.F
deleted file mode 100644
index 224001d..0000000
--- a/src/packlib/fatmen/fmtms/fmgtms.F
+++ /dev/null
@@ -1,83 +0,0 @@
-*
-* $Id: fmgtms.F,v 1.1.1.1 1996/03/07 15:18:14 mclareni Exp $
-*
-* $Log: fmgtms.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:14 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMGTMS(XVID,LBANK,VSN,IDENS,IMEDIA,IRC)
-* SUBROUTINE FMGTMS(XVID,LBANK,VSN*,IDENS*,IMEDIA*,IRC*)
-*
-* Fill bank at LBANK with VID, (XVID?), VSN, DENSITY and MEDIATYPE
-*
-* Return codes: 0 ok
-* 12 Access denied
-* 100 Volume does not exist
-*
-#include "fatmen/fattyp.inc"
-#include "fatmen/fatbank.inc"
-#include "fatmen/fatpara.inc"
- CHARACTER*15 XVID
- CHARACTER*8 PREFIX
- CHARACTER*6 VSN,VID
-#include "fatmen/tmsrep.inc"
- CHARACTER*132 LINE
- CHARACTER*8 MODEL,DENS
-#include "fatmen/fatvidp.inc"
- IMEDIA = 2
- IDENS = 38000
- JP = INDEX(XVID,'.')
- IF(JP.NE.0) THEN
- PREFIX = XVID(1:JP-1)
- VID = XVID(JP+1:)
- JP = ICNTH(PREFIX(1:LENOCC(PREFIX)),PREVID,NTMS)
- ELSE
- VID = XVID
- ENDIF
-
- IQUEST(1) = 0
-
-#if !defined(CERNLIB_TMS)
- IQUEST(1) = -1
- GOTO 99
-#endif
-#if defined(CERNLIB_TMS)
- IRC = 0
- 10 CONTINUE
-*
- I = LENREP
-*
- CALL FMSREQ('TMS ',
- + 'Q VID '//VID//' (VSN MODEL DENSITY',
- + IRC,TMSREP,I)
-
-#endif
-#if (defined(CERNLIB_TMS))&&(defined(CERNLIB_TMSTEST))
- IF(IRC.EQ.100) GOTO 99
-#endif
-#if defined(CERNLIB_TMS)
- LINE = TMSREP(1)
- IF(IDEBFA.GE.3) PRINT *,'FMGTMS. reply from TMS = ',LINE
- CALL CSQMBL(LINE ,1,LENOCC(LINE))
- CALL FMWORD(VSN ,1,' ',LINE,IRC)
- CALL FMWORD(MODEL ,2,' ',LINE,IRC)
- CALL FMWORD(DENS ,3,' ',LINE,IRC)
- IMEDIA = ICNTH(MODEL(1:LENOCC(MODEL)),CHMTYP,NMTYP)
- IDENS = ICDECI(DENS,1,LEN(DENS))
- IF(INDEX(DENS,'K').NE.0) IDENS = IDENS * 1000
-*
-#endif
- 99 CONTINUE
-*
-* Get here if -TMS or IF=TMSTEST & RC=100
-*
- IF(LBANK.NE.0) THEN
- IQ(LBANK+KOFUFA+MMTPFA) = IMEDIA
- IQ(LBANK+KOFUFA+MDENFA) = IDENS
- IQ(LBANK+KOFUFA+MVIPFA) = JP
- CALL UCTOH(VID,IQ(LBANK+KOFUFA+MVSNFA),4,6)
- ENDIF
-
- END
diff --git a/src/packlib/fatmen/fmtms/fmgvid.F b/src/packlib/fatmen/fmtms/fmgvid.F
deleted file mode 100644
index 1a77fe0..0000000
--- a/src/packlib/fatmen/fmtms/fmgvid.F
+++ /dev/null
@@ -1,313 +0,0 @@
-*
-* $Id: fmgvid.F,v 1.1.1.1 1996/03/07 15:18:15 mclareni Exp $
-*
-* $Log: fmgvid.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:15 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMGVID(IFREE,IMEDIA,CHLIB,CHPOOL,CHFREE,CHVSN,CHVID,
- + IFILE,CHOPT,IRC)
-#include "fatmen/faust.inc"
- CHARACTER*(*) CHLIB,CHFREE,CHPOOL,CHVSN,CHVID
- CHARACTER*80 COMAND
-#include "fatmen/tmsrep.inc"
- PARAMETER (LENTAP=100)
- CHARACTER*132 TAPREP(LENTAP)
- CHARACTER*255 CHTAG(2)
- CHARACTER*6 VID
-#include "fatmen/fattyp.inc"
-#include "fatmen/fatbug.inc"
-#include "fatmen/fatopts.inc"
-
- NFASPC = NFASPC + 1
-
- IRC = 0
-
- LLIB = LENOCC(CHLIB)
- LPOOL = LENOCC(CHPOOL)
- LFREE = LENOCC(CHFREE)
-*
-* First look through pool CHPOOL for a volume with the desired
-* characteristics
-*
- COMAND = ' '
- WRITE(COMAND,9001) CHLIB(1:LLIB),CHPOOL(1:LPOOL)
- 9001 FORMAT('QUERY CONTENTS LIBRARY ',A,' USER ',A,' SLOT 0')
- LC = LENOCC(COMAND)
- ITMSHD=1
- ITMSFU=0
-*
-* Retry loop
-*
- 10 CONTINUE
- ICONT = 0
- IF(IDEBFA.GT.0)
- +PRINT *,'FMGVID. Issuing TMS command ',COMAND(1:LC)
- I = LENTAP
- CALL FMSREQ('TMS ',COMAND(1:LC),
- + IRC,TAPREP,I)
-
- IF((IDEBFA.GE.0).AND.(IRC.GT.2)) THEN
- PRINT *,'FMGVID. Return code ',IRC,' from FMSREQ'
- PRINT *,TAPREP(1)
- RETURN
- ENDIF
-
- IF(ITMSHD.EQ.1) THEN
- IF((TAPREP(1)(1:7).NE.'Library').OR.
- + (TAPREP(2)(1:7).NE.'-------')) THEN
- PRINT *,'FMGVID. Cannot interpret reply from FMSREQ'
- PRINT *,TAPREP(1)
- PRINT *,TAPREP(2)
- IRC = 1
- RETURN
- ENDIF
- ITMSHD=0
- ILINES=3
- ELSE
- ILINES=1
- ENDIF
-*
-* continuation command
-*
- IF(IRC.EQ.2) THEN
- IF(I.GT.0) THEN
- COMAND = TAPREP(I)
- LC = LENOCC(TAPREP(I))
- ICONT = 1
- NLINES = I-1
- ELSE
- ICONT = 0
- NLINES = LENTAP
- ITMSFU = LENTAP
- ENDIF
- ELSE
- NLINES = 1
- ENDIF
-
- DO 30 J=ILINES,NLINES
- LLINE = LENOCC(TAPREP(J))
- IF(IDEBFA.GE.1) PRINT *,'FMGVID. processing ',
- + TAPREP(J)(1:LLINE)
-*
-* Get VID
-*
- CHVID = ' '
- CHVID = TAPREP(J)(24:29)
- LVID = LENOCC(CHVID)
- VID = CHVID(1:LVID)
-*
-* Decode VOLINFO tag for this volume
-*
- I = 2
- CALL FMSREQ('TMS ', 'TAG VID '//VID(1:LVID)
- + //' GET VOLINFO ', IRC,CHTAG,I)
- CALL FM0TOB(CHTAG(1))
- LTAG = LENOCC(CHTAG(1))
- IF(LTAG.EQ.0) GOTO 20
-*
-* Look for MB field
-*
- IF(CHTAG(1)(1:3).EQ.'MB=') THEN
- IFIRST = 4
- ELSE
- IFIRST = INDEX(CHTAG(1)(1:LTAG),' MB=')
- IF(IFIRST.EQ.0) GOTO 20
- IFIRST = IFIRST + 4
- ENDIF
-
- NUSED = ICDECI(CHTAG(1),IFIRST,LTAG)
-
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9006) CHVID(1:LVID),NUSED
-*
-* Calculate remaining space up to high water mark
-*
- JFREE = MEDHWM(IMEDIA) - NUSED
-*
-* Try next volume if insufficient space
-*
- IF(IFREE.GT.JFREE) GOTO 30
-
- IF(IDEBFA.GE.0) WRITE(LPRTFA,9002) CHVID(1:LVID),JFREE
- 9002 FORMAT(' FMGVID. volume ',A,' has ',I6,' MB free')
-*
-* Get file number
-*
- IF(CHTAG(1)(1:7).EQ.'NFILES=') THEN
- IFIRST = 8
- ELSE
- IFIRST = INDEX(CHTAG(1)(1:LTAG),' NFILES=')
- IF(IFIRST.EQ.0) GOTO 20
- IFIRST = IFIRST + 8
- ENDIF
-
- IFILE = ICDECI(CHTAG(1),IFIRST,LTAG) + 1
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9007) CHVID(1:LVID),IFILE
-*
-* Issue GETPOOL on this volume
-*
- CALL FMGETP(CHVID(1:LVID),CHPOOL(1:LPOOL),CHOPT,IRC)
- IF((IDEBFA.GE.0).AND.(IRC.NE.0)) THEN
- PRINT *,'FMGVID. Return code ',IRC,' from FMGETP'
- ENDIF
-*
-* Try next volume if getpool fails
-*
- IF(IRC.NE.0) GOTO 30
-
-*
-* Update the VOLINFO tag (size should be updated at end of job)
-*
- CALL FMVINF(CHVID(1:LVID),IFREE,IFILE,'I',IRC)
- GOTO 70
-
- 20 CONTINUE
- IF(IDEBFA.GE.-3) THEN
- IF(LTAG.EQ.0) THEN
- WRITE(LPRTFA,9003) CHVID(1:LVID)
- ELSE
- WRITE(LPRTFA,9004) CHVID(1:LVID)
- WRITE(LPRTFA,9005) CHTAG(1)(1:LTAG)
- ENDIF
- ENDIF
-
- 9003 FORMAT(' FMGVID. volume ',A,' has an empty VOLINFO tag')
- 9004 FORMAT(' FMGVID. volume ',A,' has an invalid VOLINFO tag')
- 9005 FORMAT(' FMGVID. No MB or NFILES field in VOLINFO tag "',
- + 33A1,:,/(9X,71A1))
- 9006 FORMAT(' FMGVID. volume ',A,' has ',I6,' MB used.')
- 9007 FORMAT(' FMGVID. volume ',A,' has ',I6,' files.')
- 9008 FORMAT(' FMGVID. Increase the number of lines given to SYSREQ',
- + ' (from',I4,') to allow',/,
- + ' the FMSREQ continuation mode to be used and',
- + ' therefore more volumes to be inspected.')
-
- 30 CONTINUE
-*
-* Have another bash
-*
- IF(ICONT.NE.0) GOTO 10
-
-*
-* Report implementation detail if more buffers may have been useful.
-*
- IF(ITMSFU.GT.0) WRITE(LPRTFA,9008) ITMSFU
-
- 40 CONTINUE
-*
-* Try FREE pool
-*
- COMAND = ' '
- WRITE(COMAND,9001) CHLIB(1:LLIB),CHFREE(1:LFREE)
- LC = LENOCC(COMAND)
- ITMSHD=1
- ITMSFU=0
-*
-* Retry loop
-*
- 50 CONTINUE
- ICONT = 0
- IF(IDEBFA.GT.0)
- +PRINT *,'FMGVID. Issuing TMS command ',COMAND(1:LC)
- I = LENTAP
- CALL FMSREQ('TMS ',COMAND(1:LC),
- + IRC,TAPREP,I)
-
- IF((IDEBFA.GE.0).AND.(IRC.GT.2)) THEN
- PRINT *,'FMGVID. Return code ',IRC,' from FMSREQ'
- PRINT *,TAPREP(1)
- RETURN
- ENDIF
-
- IF(ITMSHD.EQ.1) THEN
- IF((TAPREP(1)(1:7).NE.'Library').OR.
- + (TAPREP(2)(1:7).NE.'-------')) THEN
- PRINT *,'FMGVID. Cannot interpret reply from FMSREQ'
- PRINT *,TAPREP(1)
- PRINT *,TAPREP(2)
- IRC = 1
- RETURN
- ENDIF
- ITMSHD=0
- ILINES=3
- ELSE
- ILINES=1
- ENDIF
-*
-* continuation command
-*
- IF(IRC.EQ.2) THEN
- IF(I.GT.0) THEN
- COMAND = TAPREP(I)
- LC = LENOCC(TAPREP(I))
- ICONT = 1
- NLINES = I-1
- ELSE
- ICONT = 0
- NLINES = LENTAP
- ITMSFU = LENTAP
- ENDIF
- ELSE
- NLINES = 1
- ENDIF
-
- DO 60 J=ILINES,NLINES
- LLINE = LENOCC(TAPREP(J))
- IF(IDEBFA.GE.1) PRINT *,'FMGVID. processing ',
- + TAPREP(J)(1:LLINE)
-*
-* Get VID
-*
- CHVID = ' '
- CHVID = TAPREP(J)(24:29)
- LVID = LENOCC(CHVID)
-*
-* Try GETPOOL on this volume
-*
- CALL FMGETP(CHVID(1:LVID),CHFREE(1:LFREE),CHOPT,IRC)
- IF(IRC.EQ.0) THEN
- IFILE = 1
-*
-* Set VOLINFO tag (size should be updated at end of job)
-*
- CALL FMVINF(CHVID(1:LVID),IFREE,IFILE,'S',IRC)
- GOTO 70
- ENDIF
-
- 60 CONTINUE
- IF(ICONT.NE.0) GOTO 50
-
-*
-* Report implementation detail if more buffers may have been useful.
-*
- IF(ITMSFU.GT.0) WRITE(LPRTFA,9008) ITMSFU
-
-*
-* Exhausted all Pool and Free Libraries without technical errors.
-* Set a return code for failure to find a VID.
-*
- IRC = 1
- CHVID=' '
- CHVSN=' '
- 70 CONTINUE
- IRC = 0
-*
-* Get VSN from the VID.
-*
- COMAND = 'QUERY VID '//VID//' (VSN '
- LC = LENOCC(COMAND)
- IF(IDEBFA.GT.0)
- +PRINT *,'FMGVID. Issuing TMS command ',COMAND(1:LC)
- I = LENREP
- CALL FMSREQ('TMS ',COMAND(1:LC),
- + IRC,TMSREP,I)
- IF((IDEBFA.GE.0).AND.(IRC.NE.0)) THEN
- PRINT *,'FMGVID. Return code ',IRC,' from FMSREQ'
- PRINT *,TMSREP(1)
- RETURN
- ENDIF
- CHVSN = TMSREP(1)(8:13)
-
- END
diff --git a/src/packlib/fatmen/fmtms/fmgvol.F b/src/packlib/fatmen/fmtms/fmgvol.F
deleted file mode 100644
index be07856..0000000
--- a/src/packlib/fatmen/fmtms/fmgvol.F
+++ /dev/null
@@ -1,73 +0,0 @@
-*
-* $Id: fmgvol.F,v 1.1.1.1 1996/03/07 15:18:15 mclareni Exp $
-*
-* $Log: fmgvol.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:15 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMGVOL(GENAM,LFAT,KEYS,CHLIB,CHPOOL,CHFREE,CHOPT,IRC)
- CHARACTER*(*) GENAM
- CHARACTER*(*) CHLIB, CHPOOL, CHFREE
- CHARACTER*6 CHVSN, CHVID
-#include "fatmen/fmnkeys.inc"
- DIMENSION KEYS(LKEYFA)
-#include "fatmen/fatbank.inc"
-#include "fatmen/fatpara.inc"
-#include "fatmen/fatopts.inc"
-*
-* Get a tape volume that has at least NFREE megabytes from pool
-* CHPOOL. If no volume exists in this pool with enough space, a
-* volume is allocated from the pool CHFREE.
-*
- IRC = 0
-
- LGN = LENOCC(GENAM)
-
- IF(LFAT.EQ.0) THEN
- CALL FMGETK(GENAM(1:LGN),LBANK,KEYS,IRC)
- IF(IRC.NE.0) THEN
- WRITE (LPRTFA,*) 'FMGVOL. Return code ',IRC,' from FMGETK'
- RETURN
- ENDIF
- LBANK = LBANK + KOFUFA
- ELSEIF(LFAT.EQ.-1) THEN
- CALL FMUPKY(GENAM(1:LGN),LADDBK,KEYS,IRC)
- LBANK = LADDBK + KOFUFA
- ELSE
- IF(IDEBFA.GE.0) WRITE(LPRTFA,* )
- + 'FMGVOL. Enter for user-supplied bank at address ',LFAT
- LBANK = LFAT + KOFUFA
- ENDIF
-
- NFREE = IQ(LBANK+MFSZFA)
-
- IMEDIA = IQ(LBANK+MMTPFA)
-
- IF(NFREE.LE.0) THEN
- IRC = 4
- IF(IDEBFA.GE.-3) PRINT *,'FMGVOL. error - file size must '//
- + 'be set to a positive integer before calling this routine'
- GOTO 99
- ENDIF
-*
-* Now try to get volume
-*
- CALL FMGVID(NFREE,IMEDIA,CHLIB,CHPOOL,CHFREE,CHVSN,CHVID,IFILE,
- + CHOPT,IRC)
-*
-* Update bank with volume information if successful
-*
- CALL VBLANK(IQ(LBANK+MVSNFA),2)
- CALL VBLANK(IQ(LBANK+MVIDFA),2)
-
- IF(IRC.EQ.0) THEN
- IQ(LBANK+MFSQFA) = IFILE
- CALL UCTOH(CHVSN,IQ(LBANK+MVSNFA),4,NVSNFA)
- CALL UCTOH(CHVID,IQ(LBANK+MVIDFA),4,NVIDFA)
- ENDIF
-
-99 CONTINUE
-
- END
diff --git a/src/packlib/fatmen/fmtms/fmlock.F b/src/packlib/fatmen/fmtms/fmlock.F
deleted file mode 100644
index d71b723..0000000
--- a/src/packlib/fatmen/fmtms/fmlock.F
+++ /dev/null
@@ -1,94 +0,0 @@
-*
-* $Id: fmlock.F,v 1.1.1.1 1996/03/07 15:18:14 mclareni Exp $
-*
-* $Log: fmlock.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:14 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMLOCK(GENAM,LBANK,KEYS,CHOPT,IRC)
-*
-* routine to lock a VID in the TMS according to CHOPT
-* Current function is to disable Write (independant of CHOPT)
-*
-#include "fatmen/faust.inc"
- CHARACTER*(*) GENAM,CHOPT
- PARAMETER (LKEYFA=10)
- DIMENSION KEYS(LKEYFA)
- CHARACTER*80 COMAND
- CHARACTER*15 VID
-#include "fatmen/tmsrep.inc"
- CHARACTER*15 XVID
- CHARACTER*8 VIP
-#include "fatmen/fatpara.inc"
-#include "fatmen/fatbank.inc"
-#include "fatmen/fatvid0.inc"
-#include "fatmen/fatoptd.inc"
-#include "fatmen/fatvid1.inc"
-#include "fatmen/fatoptc.inc"
-
- NFLOCK = NFLOCK + 1
-
- IRC = 0
- LGN = LENOCC(GENAM)
-#if !defined(CERNLIB_TMS)
- IF(IDEBFA.GE.0) PRINT *,
- + 'FMLOCK. TMS option not installed on this node'
-#endif
-#if defined(CERNLIB_TMS)
- IF(LBANK.EQ.0) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMLOCK. get bank for ',GENAM(1:LGN)
- CALL FMGETK(GENAM(1:LGN),LBANK,KEYS,IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.0)
- + PRINT *,'FMLOCK. Return code ',IRC,' from FMGETK'
- IRC = 1
- RETURN
- ENDIF
- ELSE
- IF(IDEBFA.GE.0)
- + PRINT *,'FMLOCK. enter for user supplied bank for ',
- + GENAM(1:LGN)
- ENDIF
-
- IF(KEYS(MKMTFA).LT.2) THEN
- IF(IDEBFA.GE.-1) PRINT *,'FMLOCK. request ignored for ',
- + 'media type ',KEYS(MKMTFA)
- RETURN
- ENDIF
-
- CALL FMGETC(LBANK,VID,MVIDFA,6,IRC)
- LVID = LENOCC(VID)
-#endif
-#if (defined(CERNLIB_PREFIX))&&(defined(CERNLIB_TMS))
-*
-* Generate eXtended VID - with VID prefix
-*
- JP = IQ(LBANK+KOFUFA+MVIPFA)
- IF(JP.NE.0) THEN
- LVIP = LENOCC(PREVID(JP))
- VIP = PREVID(JP)(1:LVIP)
- XVID = PREVID(JP)(1:LVIP) // '.' // VID(1:LVID)
- LXVID = LENOCC(XVID )
-
- ELSE
- XVID = VID
- LXVID = LVID
- LVIP = 0
- ENDIF
-
- VID = XVID
- LVID = LXVID
-#endif
-#if defined(CERNLIB_TMS)
-
- 10 CONTINUE
- I = LENREP
-*
- IF(IDEBFA.GE.1) PRINT *,'FMLOCK. disable write access to ',VID
- CALL FMSREQ('TMS ',
- + 'LOCK DISABLE WRITE VID '//VID(1:LVID),
- + IRC,TMSREP,I)
-#endif
- END
diff --git a/src/packlib/fatmen/fmtms/fmpool.F b/src/packlib/fatmen/fmtms/fmpool.F
deleted file mode 100644
index 89a08f4..0000000
--- a/src/packlib/fatmen/fmtms/fmpool.F
+++ /dev/null
@@ -1,160 +0,0 @@
-*
-* $Id: fmpool.F,v 1.1.1.1 1996/03/07 15:18:14 mclareni Exp $
-*
-* $Log: fmpool.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:14 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMPOOL(GENAM,LBANK,KEYS,CHPOOL,CHOPT,IRC)
-*
-* Routine to move a tape from one pool to another
-*
-#include "fatmen/faust.inc"
- CHARACTER*(*) GENAM,CHOPT
- PARAMETER (LKEYFA=10)
- DIMENSION KEYS(LKEYFA)
- CHARACTER*80 COMAND
- CHARACTER*15 VID
-#include "fatmen/tmsrep.inc"
- CHARACTER*15 XVID
- CHARACTER*8 VIP,POOL,USER
- CHARACTER*(*) CHPOOL
-#include "fatmen/fatpara.inc"
-#include "fatmen/fatbank.inc"
-#include "fatmen/fatvid0.inc"
-#include "fatmen/fatoptd.inc"
-#include "fatmen/fatvid1.inc"
-#include "fatmen/fatoptc.inc"
-*
-* Options: L - write lock
-* U - unlock (write enable)
-* P - permissive - transfer even if not owner
-* D - delete the TMS tag
-* S - set the TMS tag to the generic name
-* B - binary tag
-* T - text tag
-*
- NFPOOL = NFPOOL + 1
- IRC = 0
- LGN = LENOCC(GENAM)
-#if !defined(CERNLIB_TMS)
- IF(IDEBFA.GE.0) PRINT *,
- + 'FMPOOL. TMS option not installed on this node'
-#endif
-#if defined(CERNLIB_TMS)
- IF((IOPTT.EQ.0).AND.(IOPTB.EQ.0)) IOPTT = 1
- IF(LBANK.EQ.0) THEN
- IF(IDEBFA.GE.1) PRINT *,'FMPOOL. get bank for ',GENAM(1:LGN)
- CALL FMGETK(GENAM(1:LGN),LBANK,KEYS,IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.0)
- + PRINT *,'FMPOOL. Return code ',IRC,' from FMGETK'
- IRC = 1
- RETURN
- ENDIF
- ELSE
- IF(IDEBFA.GE.1)
- + PRINT *,'FMPOOL. enter for user supplied bank for ',
- + GENAM(1:LGN)
- ENDIF
-
- VID = ' '
- CALL FMGETC(LBANK,VID,MVIDFA,6,IRC)
- LVID = LENOCC(VID)
-#endif
-#if (defined(CERNLIB_PREFIX))&&(defined(CERNLIB_TMS))
-*
-* Generate eXtended VID - with VID prefix
-*
- JP = IQ(LBANK+KOFUFA+MVIPFA)
- IF(JP.NE.0) THEN
- LVIP = LENOCC(PREVID(JP))
- VIP = PREVID(JP)(1:LVIP )
- XVID = PREVID(JP)(1:LVIP) // '.' // VID(1:LVID)
- LXVID = LENOCC(XVID )
-
- ELSE
- XVID = VID
- LXVID = LVID
- LVIP = 0
- ENDIF
-
- VID = XVID
- LVID = LXVID
-
-#endif
-#if defined(CERNLIB_TMS)
- IF(LVID.EQ.0) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMPOOL. something is wrong - '//
- + 'VID has zero length'
- IRC = -1
- RETURN
- ENDIF
-*
-* Set or delete TMS tags?
-*
- IF(IOPTS.NE.0) THEN
- IF(IOPTB.NE.0)
- + CALL FMTAGS(GENAM(1:LGN),LBANL,KEYS,GENAM(1:LGN),'SB',IRC)
- IF(IOPTT.NE.0)
- + CALL FMTAGS(GENAM(1:LGN),LBANL,KEYS,GENAM(1:LGN),'ST',IRC)
- ENDIF
-
- IF(IOPTD.NE.0) THEN
- IF(IOPTB.NE.0)
- + CALL FMTAGS(GENAM(1:LGN),LBANL,KEYS,' ','DB',IRC)
- IF(IOPTT.NE.0)
- + CALL FMTAGS(GENAM(1:LGN),LBANL,KEYS,' ','DT',IRC)
- ENDIF
-
- LPOOL = LENOCC(CHPOOL)
- POOL = CHPOOL(1:LPOOL)
-
- 10 CONTINUE
-*
- IF(IDEBFA.GE.0) PRINT *,'FMPOOL. Move ',
- + VID(1:LVID),' to pool ',POOL(1:LPOOL)
-
- IF(IOPTP.NE.0) THEN
-*
-* Get the current owner...
-*
- I = LENREP
- CALL FMSREQ('TMS ',
- + 'QUERY VID '//VID(1:LVID)//' (OWNER',
- + IRC,TMSREP,I)
-
- ISTART = INDEX(TMSREP(1),' ')+1
- IEND = LENOCC(TMSREP(1))
- USER = TMSREP(1)(ISTART:IEND)
- LUSER = LENOCC(USER)
-
- I = LENREP
- CALL FMSREQ('TMS ',
- + 'TRANSFER VID '//VID(1:LVID)//
- + ' FROM '//USER(1:LUSER)//
- + ' TO USER '//POOL(1:LPOOL),
- + IRC,TMSREP,I)
-
- ELSE
-
- I = LENREP
- CALL FMSREQ('TMS ',
- + 'TRANSFER VID '//VID(1:LVID)//
- + ' TO USER '//POOL(1:LPOOL),
- + IRC,TMSREP,I)
- ENDIF
-
- IF(IRC.NE.0) RETURN
- IF(IOPTL.NE.0) THEN
- IF(IDEBFA.GE.3) PRINT *,'Calling FMLOCK to write lock ',VID
- CALL FMLOCK(GENAM(1:LGN),LBANK,KEYS,'L',IRC)
- ENDIF
- IF(IOPTU.NE.0) THEN
- IF(IDEBFA.GE.3) PRINT *,'Calling FMULOK to write enable ',VID
- CALL FMULOK(GENAM(1:LGN),LBANK,KEYS,'U',IRC)
- ENDIF
-#endif
- END
diff --git a/src/packlib/fatmen/fmtms/fmpref.F b/src/packlib/fatmen/fmtms/fmpref.F
deleted file mode 100644
index c19fa27..0000000
--- a/src/packlib/fatmen/fmtms/fmpref.F
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: fmpref.F,v 1.1.1.1 1996/03/07 15:18:15 mclareni Exp $
-*
-* $Log: fmpref.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:15 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMPREF(VIP,JP,CHOPT,IRC)
-*
-* Convert CHARACTER VID prefix to its INTEGER value
-* or vice-versa depending on CHOPT
-*
- CHARACTER*(*) VIP,CHOPT
-#include "fatmen/fatvid0.inc"
-#include "fatmen/fatoptd.inc"
-#include "fatmen/fatvid1.inc"
-#include "fatmen/fatoptc.inc"
- IRC = 0
- IF(IOPTC.NE.0) THEN
- IF((JP.LE.0).OR.(JP.GT.NTMS)) THEN
- IRC = -1
- ELSE
- VIP = PREVID(JP)
- ENDIF
- ELSEIF(IOPTI.NE.0) THEN
- JP = ICNTH(VIP,PREVID,NTMS)
- IF(JP.EQ.0) IRC = -1
- ENDIF
-
- END
diff --git a/src/packlib/fatmen/fmtms/fmprot.F b/src/packlib/fatmen/fmtms/fmprot.F
deleted file mode 100644
index f37b3a2..0000000
--- a/src/packlib/fatmen/fmtms/fmprot.F
+++ /dev/null
@@ -1,109 +0,0 @@
-*
-* $Id: fmprot.F,v 1.1.1.1 1996/03/07 15:18:15 mclareni Exp $
-*
-* $Log: fmprot.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:15 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMPROT(GENAM,LBANK,KEYS,CHPROT,CHOPT,IRC)
-*
-* Routine to set the protection group on a volume
-*
- CHARACTER*(*) GENAM,CHOPT
- PARAMETER (LKEYFA=10)
- DIMENSION KEYS(LKEYFA)
- CHARACTER*80 COMAND
- CHARACTER*15 VID
-#include "fatmen/tmsrep.inc"
- CHARACTER*15 XVID
- CHARACTER*8 VIP,PROT,CHACCT
- CHARACTER*(*) CHPROT
-#include "fatmen/fatpara.inc"
-#include "fatmen/fatbank.inc"
-#include "fatmen/fatvid0.inc"
-#include "fatmen/fatoptd.inc"
-#include "fatmen/fatvid1.inc"
-#include "fatmen/fatoptc.inc"
-*
-* Options:
-*
- IRC = 0
- LGN = LENOCC(GENAM)
-#if !defined(CERNLIB_TMS)
- IF(IDEBFA.GE.0) PRINT *,
- + 'FMPROT. TMS option not installed on this node'
-#endif
-#if defined(CERNLIB_TMS)
- IF(LBANK.EQ.0) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMPROT. get bank for ',GENAM(1:LGN)
- CALL FMGETK(GENAM(1:LGN),LBANK,KEYS,IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.0)
- + PRINT *,'FMPROT. Return code ',IRC,' from FMGETK'
- IRC = 1
- RETURN
- ENDIF
- ELSE
- IF(IDEBFA.GE.0)
- + PRINT *,'FMPROT. enter for user supplied bank for ',
- + GENAM(1:LGN)
- ENDIF
-
- VID = ' '
- CALL FMGETC(LBANK,VID,MVIDFA,6,IRC)
- LVID = LENOCC(VID)
-#endif
-#if (defined(CERNLIB_PREFIX))&&(defined(CERNLIB_TMS))
-*
-* Generate eXtended VID - with VID prefix
-*
- JP = IQ(LBANK+KOFUFA+MVIPFA)
- IF(JP.NE.0) THEN
- LVIP = LENOCC(PREVID(JP))
- VIP = PREVID(JP)(1:LVIP )
- XVID = PREVID(JP)(1:LVIP) // '.' // VID(1:LVID)
- LXVID = LENOCC(XVID )
-
- ELSE
- XVID = VID
- LXVID = LVID
- LVIP = 0
- ENDIF
-
- VID = XVID
- LVID = LXVID
-#endif
-#if defined(CERNLIB_TMS)
- LPROT = LENOCC(CHPROT)
- PROT = CHPROT(1:LPROT)
-
- 10 CONTINUE
-*
- IF(IDEBFA.GE.0) PRINT *,'FMPROT. apply protection ',
- + PROT(1:LPROT),' to VID ',VID(1:LVID)
-*
-* Get the current account...
-*
- I = LENREP
- CALL FMSREQ('TMS ',
- + 'QUERY VID '//VID(1:LVID)//' (ACCOUNT',
- + IRC,TMSREP,I)
-
- ISTART = INDEX(TMSREP(1),' ')+1
- IEND = LENOCC(TMSREP(1))
- CHACCT = TMSREP(1)(ISTART:IEND)
- LACCT = LENOCC(CHACCT)
-*
-* Now set the protection group...
-*
- I = LENREP
- CALL FMSREQ('TMS ',
- + 'PROTECT '//PROT(1:LPROT)//' '//
- + 'ACCOUNT '//CHACCT(1:LACCT)//' '//
- + 'APPLY SET '//VID(1:LVID),
- + IRC,TMSREP,I)
-
-#endif
- END
diff --git a/src/packlib/fatmen/fmtms/fmqmed.F b/src/packlib/fatmen/fmtms/fmqmed.F
deleted file mode 100644
index aeef55e..0000000
--- a/src/packlib/fatmen/fmtms/fmqmed.F
+++ /dev/null
@@ -1,82 +0,0 @@
-*
-* $Id: fmqmed.F,v 1.1.1.1 1996/03/07 15:18:15 mclareni Exp $
-*
-* $Log: fmqmed.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:15 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMQMED(GENAM,LBANK,KEYS,IMEDIA,IROBOT,IRC)
-*CMZ : 22/04/91 12.02.04 by Jamie Shiers
-*-- Author : Jamie Shiers 22/04/91
-#include "fatmen/fatbank.inc"
-#include "fatmen/fatpara.inc"
-#include "fatmen/fmnkeys.inc"
- DIMENSION KEYS(LKEYFA)
- CHARACTER*(*) GENAM
- CHARACTER*6 VID
- CHARACTER*15 XVID
- CHARACTER*8 VIP
-#include "fatmen/tmsdef.inc"
-
- IRC = 0
- IMEDIA = -1
- IROBOT = -1
- LGN = LENOCC(GENAM)
-
- IF(LBANK.EQ.0) THEN
- CALL FMGETK(GENAM(1:LGN),LBANK,KEYS,IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMQMED. return code ',
- + IRC,' from FMGETK'
- RETURN
- ENDIF
- ENDIF
-
- IMEDIA = IQ(LBANK+KOFUFA+MMTPFA)
-
- IF(IMEDIA.EQ.1) THEN
- IROBOT = 0
- RETURN
- ENDIF
-
- CALL UHTOC(IQ(LBANK+KOFUFA+MVIDFA),4,VID,6)
-
- MNTTYP = ' '
-
-#if defined(CERNLIB_PREFIX)
- CALL FMXVID(VID,IQ(LBANK+KOFUFA+MVIPFA),XVID,VIP,'C',IC)
- LXVID = LENOCC(XVID)
- CALL FMQTMS(XVID(1:LXVID),LIB,MODEL,DENS,MNTTYP,LABTYP,IC)
-#endif
-#if !defined(CERNLIB_PREFIX)
- CALL FMQTMS(VID,LIB,MODEL,DENS,MNTTYP,LABTYP,IRC)
-#endif
- IQUEST(1) = IRC
-
- IF(IRC.EQ.312) THEN
- IRC = 0
- IF(IDEBFA.GE.3) PRINT *,'FMQMED. volume ',
-#if !defined(CERNLIB_PREFIX)
- + VID,
-#endif
-#if defined(CERNLIB_PREFIX)
- + XVID,
-#endif
- + ' unavailable'
- ENDIF
-
- IF(MNTTYP.EQ.'R') THEN
- IROBOT = 1
- ELSE
- IROBOT = 0
- ENDIF
-
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMQMED. return code ',
- + IRC,' from FMQTMS'
- RETURN
- ENDIF
-
- END
diff --git a/src/packlib/fatmen/fmtms/fmqtms.F b/src/packlib/fatmen/fmtms/fmqtms.F
deleted file mode 100644
index 6ad7f1d..0000000
--- a/src/packlib/fatmen/fmtms/fmqtms.F
+++ /dev/null
@@ -1,220 +0,0 @@
-*
-* $Id: fmqtms.F,v 1.1.1.1 1996/03/07 15:18:14 mclareni Exp $
-*
-* $Log: fmqtms.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:14 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMQTMS(VID,LIB,MODEL,DENS,MNTTYP,LABTYP,IRC)
-* SUBROUTINE FMQTMS(VID,LIB*,MODEL*,DENS*,MNTTYP*,LABTYP*,IRC*)
-*
-* Routine to interface to the TMS. Check if:
-* 1) Volume is available (F)
-* 2) Volume is in manual/robot library
-* 3) Volume is readable/writable by current account
-*
-* Return codes: 0 ok
-* 8 Syntax error
-* 12 Access denied
-* 100 Volume does not exist
-* 312 Volume unavailable on system issuing QVOL
-* 315 Volume unavailable on any system
-*
-#include "fatmen/faust.inc"
-#include "fatmen/fatbug.inc"
- CHARACTER*(*) VID
-#include "zebra/quest.inc"
-#include "fatmen/fattyp.inc"
-#include "fatmen/tmsrep.inc"
- CHARACTER*132 LINE,CHLINE
- CHARACTER*15 CHVID
-#include "fatmen/tmsdef.inc"
-
- NFQVOL = NFQVOL + 1
-
- IF(IDEBFA.GE.3) PRINT *,'FMQTMS. enter for VID = ',VID
- LVID = LENOCC(VID)
- CHVID = VID(1:LVID)
- JMEDIA = IQUEST(11)
- IQUEST(1) = 0
-#if !defined(CERNLIB_TMS)
- IF(IDEBFA.GE.3) PRINT *,'FMQTMS. TMS option not installed.',
- + ' Default values for LIB/MODEL/DENS/LABTYP/MNTTYP taken'
- IRC = 0
- IQUEST(1) = -1
- LIB = '*Unknown'
- MODEL = 'CT1 '
- DENS = '38K'
- LABTYP = 'SL'
- MNTTYP = 'M'
-*
-* Take values from sequence FATTYP is media type is known
-*
- IF(JMEDIA.NE.0.AND.JMEDIA.LE.NFMTYP) THEN
- IF(IDEBFA.GE.3) PRINT *,'FMQTMS. using information in ',
- + 'FATMEN catalogue for MODEL/DENS/LABTYP/MNTTYP'
- MODEL = CHMGEN(JMEDIA)
- DENS = CHMDEN(JMEDIA)
- LABTYP = CHMLAB(JMEDIA)
- MNTTYP = CHMMNT(JMEDIA)
-#endif
-#if (defined(CERNLIB_CERN))&&(!defined(CERNLIB_TMS))
-*
-* The following test is CERN specific!!!
-*
- IF(JMEDIA.EQ.2.AND.
- + (VID(1:1).EQ.'I').AND.(ICNUM(VID,2,6).EQ.7)) THEN
- LIB = '3485_2'
- MODEL = 'SMCF'
- MNTTYP= 'R'
- ENDIF
-#endif
-#if !defined(CERNLIB_TMS)
- ELSE
- IF(IDEBFA.GE.-3) WRITE(LPRTFA,9001) JMEDIA,JMEDIA
- 9001 FORMAT(' FMQTMS. invalid media type specified via IQUEST(11)',
- + ' - ',I10,' (',Z8,'). See documentation.')
- IRC = 3
- GOTO 999
- ENDIF
-#endif
-#if (!defined(CERNLIB_TMS))&&(defined(CERNLIB_VMTAPE))&&(defined(CERNLIB_VMTMC))
-*
-* Check and see if this tape is in the VMTAPE catalogue
-*
- CALL VMCMS('VMTAPE LIST '//CHVID(1:LVID)
- + //' (SHORT STACK LIFO',IRC))
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMQTMS. error ',IRC,' from VMTAPE '
- + 'command.'
- ELSE
- CALL VMRTRM(CHLINE,LLINE)
- IF(IDEBFA.GE.0) PRINT *,'FMQTMS. reply from VMTAPE = ',
- + CHLINE(1:LLINE)
- ENDIF
-#endif
-#if !defined(CERNLIB_TMS)
-*
-* Now call user exit to allow user to override these values
-*
- CALL FMUTMS(VID,LIB,MODEL,DENS,MNTTYP,LABTYP,IRC)
- RETURN
-#endif
-#if defined(CERNLIB_TMS)
- IRC = 0
-*
-*VID Library Slot Model Dens R R R R A A csn sstr estr labtyp
-* i o e a v l
-* n b a c a l
-* g o l k i o
-* ? t ? e l w
-* ? d ? ?
-* W M L U U D
-*28901 3485_2 00000000 3480 38000 W R R U A A 00000000 00000 00000 SL
- 10 CONTINUE
-*
- I = LENREP
-*
- CALL FMSREQ('TMS ',
-#endif
-#if (defined(CERNLIB_TMS))&&(!defined(CERNLIB_QVID))
- + 'QVOL '//CHVID(1:LVID)
-#endif
-#if (defined(CERNLIB_TMS))&&(defined(CERNLIB_SHIFT))&&(defined(CERNLIB_CERN))
- + //' (GENERIC SHIFT'
-#endif
-#if (defined(CERNLIB_TMS))&&(defined(CERNLIB_QVID))
- + 'Q VID '//CHVID(1:LVID)
-#endif
-#if defined(CERNLIB_TMS)
- + ,IRC,TMSREP,I)
-
-#endif
-#if (defined(CERNLIB_TMS))&&(!defined(CERNLIB_TMSTEST))
- IF(IRC.EQ.100) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMQTMS. volume ',VID,
- + ' unknown to TMS'
-#endif
-#if (defined(CERNLIB_TMS))&&(defined(CERNLIB_TMSTEST))
- IF(IRC.EQ.100) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMQTMS. volume ',VID,
- + ' unknown to TMS - defaults assumed'
- LIB = '*Unknown'
- MODEL = 'CT1 '
- IF(JMEDIA.NE.0) MODEL = CHMGEN(JMEDIA)
- DENS = '38K'
- LABTYP = 'SL'
- MNTTYP = 'M'
- IF((VID(1:1).EQ.'I').AND.(ICNUM(VID,2,6).EQ.7)) THEN
- LIB = 'SMCF'
- MNTTYP= 'R'
- ENDIF
- IRC = 0
-#endif
-#if defined(CERNLIB_TMS)
- RETURN
- ELSE
-#endif
-#if (defined(CERNLIB_TMS))&&(!defined(CERNLIB_QVID))
- LIB = TMSREP(1)(8:15)
- MODEL = TMSREP(1)(26:33)
- DENS = TMSREP(1)(35:40)
- LABTYP = TMSREP(1)(75:76)
- MNTTYP = TMSREP(1)(44:44)
-#endif
-#if (defined(CERNLIB_TMS))&&(defined(CERNLIB_QVID))
- LINE = TMSREP(1)
- CALL CSQMBL(LINE ,1,LENOCC(LINE))
- CALL FMWORD(LIB ,5,' ',LINE,IRC)
- CALL FMWORD(MODEL ,2,' ',LINE,IRC)
- CALL FMWORD(DENS ,3,' ',LINE,IRC)
- CALL FMWORD(LABTYP,4,' ',LINE,IRC)
- MNTTYP = 'M'
- IF(LIB(1:2).EQ.'CR') MNTTYP = 'R'
-*
-* Libraries beginning * are by definition unavailable (apparently)
-*
- IF(LIB(1:1).EQ.'*') THEN
- IRC = 312
- RETURN
- ENDIF
-#endif
-#if (defined(CERNLIB_TMS))&&(defined(CERNLIB_QVID))&&(defined(CERNLIB_DESPARATE))
-*
-* To determine if volume is available, must issue TMS Q LIBRARY...
-* e.g.
-*
-*SYSREQ TMS Q LIBRARY HP_LPOOL
-*Library Czar Group R A L S M Target Retain Racks Slots Spare
-*-------- -------- -------- - - - - - -------- ------ ------ -------- --------
-*HP_LPOOL *None *None N N N N N *None 0 0 10000 9521
-*123456789_123456789_123456789_123456789_123456789_123456789_123456789_123456789
-*CP Lear Production Data at Liverpool
-
- I = LENREP
-*
- CALL FMSREQ('TMS ',
- + 'Q LIBRARY '//LIB
- + IRC,TMSREP,I)
- IF(I.NE.3) THEN
- PRINT *,'FMQTMS. unexpected reply from TMS QUERY LIBRARY'
- DO 20 J=1,I
- PRINT *,'FMQTMS. ',TMSREP(J)(1:LENOCC(TMSREP(J)))
- 20 CONTINUE
- ELSE
-*
-* Look for ACTIVE:N
-*
- IF(TMSREP(3)(30:30).EQ.'N') IRC = 312
-
- ENDIF
-#endif
-#if defined(CERNLIB_TMS)
- IF(INDEX(DENS,'38000').NE.0) DENS = '38K'
- ENDIF
-*
-#endif
- 999 END
-
diff --git a/src/packlib/fatmen/fmtms/fmqvol.F b/src/packlib/fatmen/fmtms/fmqvol.F
deleted file mode 100644
index d9eb877..0000000
--- a/src/packlib/fatmen/fmtms/fmqvol.F
+++ /dev/null
@@ -1,255 +0,0 @@
-*
-* $Id: fmqvol.F,v 1.1.1.1 1996/03/07 15:18:15 mclareni Exp $
-*
-* $Log: fmqvol.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:15 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMQVOL(GENAM,LBANK,KEYS,LIB,MODEL,DENS,MNTTYP,LABTYP,
- + IRC)
-*
-* Routine to interface to the TMS. Check if:
-* 1) Volume is available (F)
-* 2) Volume is in manual/robot library
-* 3) Volume is readable/writable by current account
-*
-* Return codes: 0 ok
-* 8 Syntax error
-* 12 Access denied
-* 100 Volume does not exist
-* 312 Volume unavailable on current system
-* 315 Volume unavailable on any system
-*
-#include "fatmen/faust.inc"
- CHARACTER*(*) GENAM
- PARAMETER (LKEYFA=10)
- DIMENSION KEYS(LKEYFA)
-#include "fatmen/fatbank.inc"
-#include "fatmen/fatpara.inc"
- CHARACTER*15 VID,XVID
- CHARACTER*8 VIP
-#include "fatmen/fattyp.inc"
-#include "fatmen/tmsrep.inc"
- CHARACTER*132 LINE,CHLINE
-#include "fatmen/tmsdef0.inc"
-#include "fatmen/fatvidp.inc"
-#include "fatmen/tmsdef1.inc"
-
- NFQVOL = NFQVOL + 1
-
- LGN = LENOCC(GENAM)
-
- IQUEST(1) = 0
- JMEDIA = KEYS(MKMTFA)
-#if defined(CERNLIB_TMS)
- IF(LBANK.EQ.0) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMQVOL. get bank for ',GENAM(1:LGN)
- CALL FMGETK(GENAM(1:LGN),LBANK,KEYS,IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.0)
- + PRINT *,'FMQVOL. Return code ',IRC,' from FMGETK'
- IRC = 1
- RETURN
- ENDIF
- ELSE
- IF(IDEBFA.GE.0)
- + PRINT *,'FMQVOL. enter for user supplied bank for ',
- + GENAM(1:LGN)
- ENDIF
-
- VID = ' '
- CALL FMGETC(LBANK,VID,MVIDFA,6,IRC)
- LVID = LENOCC(VID)
-#endif
-#if (defined(CERNLIB_PREFIX))&&(defined(CERNLIB_TMS))
-*
-* Generate eXtended VID - with VID prefix
-*
- JP = IQ(LBANK+KOFUFA+MVIPFA)
- IF(JP.NE.0) THEN
- LVIP = LENOCC(PREVID(JP))
- VIP = PREVID(JP)(1:LVIP)
- XVID = PREVID(JP)(1:LVIP) // '.' // VID(1:LVID)
- LXVID = LENOCC(XVID)
-
- ELSE
- XVID = VID
- LXVID = LVID
- LVIP = 0
- ENDIF
-
- VID = XVID
- LVID = LXVID
-#endif
-#if !defined(CERNLIB_TMS)
- IF(IDEBFA.GE.3) PRINT *,'FMQVOL. TMS option not installed.',
- + ' Default values for LIB/MODEL/DENS/LABTYP/MNTTYP taken'
- IRC = 0
- IQUEST(1) = -1
- LIB = '*Unknown'
- MODEL = 'CT1 '
- DENS = '38K'
- LABTYP = 'SL'
- MNTTYP = 'M'
-*
-* Take values from sequence FATTYP is media type is known
-*
- IF(JMEDIA.NE.0) THEN
- MODEL = CHMGEN(JMEDIA)
- DENS = CHMDEN(JMEDIA)
- LABTYP = CHMLAB(JMEDIA)
- MNTTYP = CHMMNT(JMEDIA)
-#endif
-#if (defined(CERNLIB_CERN))&&(!defined(CERNLIB_TMS))
-*
-* The following test is CERN specific!!!
-*
- IF(JMEDIA.EQ.2.AND.
- + (VID(1:1).EQ.'I').AND.(ICNUM(VID,2,6).EQ.7)) THEN
- LIB = '3485_2'
- MODEL = 'SMCF'
- MNTTYP= 'R'
- ENDIF
-#endif
-#if !defined(CERNLIB_TMS)
- ENDIF
-#endif
-#if (!defined(CERNLIB_TMS))&&(defined(CERNLIB_VMTAPE))&&(defined(CERNLIB_VMTMC))
-*
-* Check and see if this tape is in the VMTAPE catalogue
-*
- CALL VMCMS('VMTAPE LIST '//VID(1:LVID)
- + //' (SHORT STACK LIFO',IRC))
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMQVOL. error ',IRC,' from VMTAPE '
- + 'command.'
- ELSE
- CALL VMRTRM(CHLINE,LLINE)
- IF(IDEBFA.GE.0) PRINT *,'FMQVOL. reply from VMTAPE = ',
- + CHLINE(1:LLINE)
- ENDIF
-#endif
-#if !defined(CERNLIB_TMS)
-*
-* Now call user exit to allow user to override these values
-*
- CALL FMUVOL(GENAM,LBANK,KEYS,LIB,MODEL,DENS,MNTTYP,LABTYP,IRC)
- RETURN
-#endif
-#if defined(CERNLIB_TMS)
- IRC = 0
-*
-*VID Library Slot Model Dens R R R R A A csn sstr estr labtyp
-* i o e a v l
-* n b a c a l
-* g o l k i o
-* ? t ? e l w
-* ? d ? ?
-* W M L U U D
-*28901 3485_2 00000000 3480 38000 W R R U A A 00000000 00000 00000 SL
-10 CONTINUE
-*
- I = LENREP
-*
- CALL FMSREQ('TMS ',
-#endif
-#if (defined(CERNLIB_TMS))&&(!defined(CERNLIB_QVID))
- + 'QVOL '//VID(1:LVID)
-#endif
-#if (defined(CERNLIB_TMS))&&(defined(CERNLIB_SHIFT))&&(defined(CERNLIB_CERN))
- + //' (GENERIC SHIFT'
-#endif
-#if (defined(CERNLIB_TMS))&&(defined(CERNLIB_QVID))
- + 'Q VID '//VID(1:LVID)
-#endif
-#if defined(CERNLIB_TMS)
- + ,IRC,TMSREP,I)
-#endif
-#if (defined(CERNLIB_TMS))&&(!defined(CERNLIB_TMSTEST))
- IF(IRC.EQ.100) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMQVOL. volume ',VID,
- + ' unknown to TMS'
-#endif
-#if (defined(CERNLIB_TMS))&&(defined(CERNLIB_TMSTEST))
- IF(IRC.EQ.100) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMQVOL. volume ',VID,
- + ' unknown to TMS - defaults assumed'
- LIB = '*Unknown'
- MODEL = 'CT1 '
- IF(JMEDIA.NE.0) MODEL = CHMGEN(JMEDIA)
- DENS = '38K'
- LABTYP = 'SL'
- MNTTYP = 'M'
- IF((VID(1:1).EQ.'I').AND.(ICNUM(VID,2,6).EQ.7)) THEN
- LIB = 'SMCF'
- MNTTYP= 'R'
- ENDIF
- IRC = 0
-#endif
-#if defined(CERNLIB_TMS)
- RETURN
- ELSE
-#endif
-#if (defined(CERNLIB_TMS))&&(!defined(CERNLIB_QVID))
- LIB = TMSREP(1)(8:15)
- MODEL = TMSREP(1)(26:33)
- DENS = TMSREP(1)(35:40)
- LABTYP = TMSREP(1)(75:76)
- MNTTYP = TMSREP(1)(44:44)
-#endif
-#if (defined(CERNLIB_TMS))&&(defined(CERNLIB_QVID))
- LINE = TMSREP(1)
- CALL CSQMBL(LINE ,1,LENOCC(LINE))
- CALL FMWORD(LIB ,5,' ',LINE,IRC)
- CALL FMWORD(MODEL ,2,' ',LINE,IRC)
- CALL FMWORD(DENS ,3,' ',LINE,IRC)
- CALL FMWORD(LABTYP,4,' ',LINE,IRC)
- MNTTYP = 'M'
- IF(LIB(1:2).EQ.'CR') MNTTYP = 'R'
-*
-* Libraries beginning * are by definition unavailable (apparently)
-*
- IF(LIB(1:1).EQ.'*') THEN
- IRC = 312
- RETURN
- ENDIF
-#endif
-#if (defined(CERNLIB_TMS))&&(defined(CERNLIB_QVID))&&(defined(CERNLIB_DESPARATE))
-*
-* To determine if volume is available, must issue TMS Q LIBRARY...
-* e.g.
-*
-*SYSREQ TMS Q LIBRARY HP_LPOOL
-*Library Czar Group R A L S M Target Retain Racks Slots Spare
-*-------- -------- -------- - - - - - -------- ------ ------ -------- --------
-*HP_LPOOL *None *None N N N N N *None 0 0 10000 9521
-*123456789_123456789_123456789_123456789_123456789_123456789_123456789_123456789
-*CP Lear Production Data at Liverpool
-
- I = LENREP
-*
- CALL FMSREQ('TMS ',
- + 'Q LIBRARY '//LIB
- + IRC,TMSREP,I)
- IF(I.NE.3) THEN
- PRINT *,'FMQVOL. unexpected reply from TMS QUERY LIBRARY'
- DO 11 J=1,I
- PRINT *,'FMQVOL. ',TMSREP(J)(1:LENOCC(TMSREP(J)))
-11 CONTINUE
- ELSE
-*
-* Look for ACTIVE:N
-*
- IF(TMSREP(3)(30:30).EQ.'N') IRC = 312
-
- ENDIF
-#endif
-#if defined(CERNLIB_TMS)
- IF(INDEX(DENS,'38000').NE.0) DENS = '38K'
- ENDIF
-*
-#endif
- END
-
diff --git a/src/packlib/fatmen/fmtms/fmsreq.F b/src/packlib/fatmen/fmtms/fmsreq.F
deleted file mode 100644
index 6bc0e45..0000000
--- a/src/packlib/fatmen/fmtms/fmsreq.F
+++ /dev/null
@@ -1,179 +0,0 @@
-*
-* $Id: fmsreq.F,v 1.1.1.1 1996/03/07 15:18:14 mclareni Exp $
-*
-* $Log: fmsreq.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:14 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMSREQ(CHSERV,CHCOMM,IRC,CHREP,L)
-#include "fatmen/faust.inc"
-#include "fatmen/fatnet.inc"
- CHARACTER*(*) CHSERV,CHCOMM,CHREP(L)
- CHARACTER*240 COMAND
- CHARACTER*20 LINE
- PARAMETER (ISLEEP=60)
- PARAMETER (MAXTRY=1000)
-#include "fatmen/fatbug.inc"
- SAVE NENTRY
- DATA NENTRY/0/
-
-#if (!defined(CERNLIB_CRAY))&&(!defined(CERNLIB_SGI))
-#include "fatmen/errno.inc"
-#endif
-#if defined(CERNLIB_CRAY)
-#include "fatmen/errcray.inc"
-#endif
-#if defined(CERNLIB_SGI)
-#include "fatmen/errsgi.inc"
-#endif
-
- LCHSRV = LENOCC(CHSERV)
- LCHCMM = LENOCC(CHCOMM)
-
- IRC = 0
- NENTRY = NENTRY + 1
- NRETRY = 0
- NFSREQ = NFSREQ + 1
-
- IF(IDEBFA.GE.3) PRINT *,'FMSREQ. enter for service ',
- + CHSERV(1:LCHSRV),' command ',CHCOMM(1:LCHCMM)
-
- COMAND = CHCOMM(1:LCHCMM)
-
- LBUF = L
- 10 CONTINUE
-#if defined(CERNLIB_TMS)
- LENBUF = LBUF
- CALL SYSREQ(CHSERV(1:LCHSRV),COMAND,
- + IRC,CHREP,LENBUF)
-*
-* Service (temporarily) unavailable)
-*
- IF(IRC.EQ.3) THEN
- CALL SLEEPF(ISLEEP)
- GOTO 10
- ENDIF
-*
-* Volume in use (actually, volume not Free or Held)
-*
- IF(IRC.EQ.260) THEN
- IF(IDEBFA.GE.0) WRITE(LPRTFA,9001) IRC,ISLEEP
- 9001 FORMAT(' FMSREQ. return code ',I5,
- + ' from TMS. Waiting ',I5,' seconds before retry')
- CALL SLEEPF(ISLEEP)
- GOTO 10
- ENDIF
-*
-* Network errors
-*
- IFIND = IUFIND(IABS(IRC),IFATRC,1,NERRS)
- IF(IFIND.LE.NERRS) THEN
-*
-* Found a return code for which we retry
-*
- NSECS = IRETRY(IFIND)
- IF(IDEBFA.GE.0) WRITE(LPRTFA,9001) IRC,NSECS
- CALL SLEEPF(NSECS)
- GOTO 10
- ENDIF
-*
-* Continuation message: was the buffer big enough to
-* fit the continuation command?
-*
- IF(IRC.EQ.2.AND.LENBUF.GT.0) L = LENBUF
-
- IF(IRC.NE.2) L = LENBUF
-*
-* 'Safe' error messages (continuation, volume unknown, unavailable)
-*
- IF(IRC.EQ.2.OR.IRC.EQ.8.OR.IRC.EQ.100.OR.
- + (IRC.GE.312.AND.IRC.LE.315)) GOTO 30
-*
-* Bad configuration file
-*
- IF(IRC.EQ.-1009) THEN
- IF(NENTRY.EQ.1.AND.IDEBFA.GE.-3) THEN
- WRITE(LPRTFA,9002)
- 9002 FORMAT(///,' FMSREQ. *** alarm *** ',//,
- + ' ## # ## ##### # #',/,
- + ' # # # # # # # ## ##',/,
- + ' # # # # # # # # ## #',/,
- + ' ###### # ###### ##### # #',/,
- + ' # # # # # # # # #',/,
- + ' # # ###### # # # # # #',//,
- + ' FMSREQ. *** alarm *** ',///)
- WRITE(LPRTFA,9003)
- 9003 FORMAT(' FMSREQ. !!! SYSREQ is not correctly installed on',
- + ' this machine.',/,
- + ' FMSREQ. Check P=SYSREQ,D=GETCONFE in CSPACK')
-#endif
-#if (defined(CERNLIB_VAXVMS)||defined(CERNLIB_UNIX))&&(defined(CERNLIB_TMS))
- WRITE(LPRTFA,9004)
- 9004 FORMAT(' FMSREQ. the configuration file should be: ')
-#endif
-#if (defined(CERNLIB_VAXVMS))&&(defined(CERNLIB_TMS))
- WRITE(LPRTFA,9005)
- 9005 FORMAT(' --> SYS$MANAGER:SYSREQ.CONF')
-#endif
-#if (defined(CERNLIB_UNIX))&&(defined(CERNLIB_TMS))
- WRITE(LPRTFA,9006)
- 9006 FORMAT(' --> /etc/shift.conf (if the SHIFT s/w is installed)')
-#endif
-#if (defined(CERNLIB_UNIX))&&(defined(CERNLIB_TMS))&&(defined(CERNLIB_SHIFT))
- WRITE(LPRTFA,9007)
- 9007 FORMAT(' (FATMEN has been installed with the SHIFT flag)')
-#endif
-#if (defined(CERNLIB_UNIX))&&(defined(CERNLIB_TMS))
- WRITE(LPRTFA,9008)
- 9008 FORMAT(' --> /etc/sysreq.conf (otherwise)')
-#endif
-#if (defined(CERNLIB_UNIX))&&(defined(CERNLIB_TMS))&&(!defined(CERNLIB_SHIFT))
- WRITE(LPRTFA,9009)
- 9009 FORMAT(' (FATMEN has been installed without the SHIFT flag)')
-#endif
-#if defined(CERNLIB_TMS)
- WRITE(LPRTFA,9002)
- ENDIF
- GOTO 30
- ENDIF
-*
-* Other errors
-*
- IF(IRC.NE.0) THEN
- IF(NRETRY.GT.MAXTRY) THEN
- IF(IDEBFA.GE.-3) WRITE(LPRTFA,9010) IRC,NRETRY
- 9010 FORMAT(' FMSREQ. return code ',I5,' from TMS.',
- + ' Giving up after ',I6,' retries')
- GOTO 30
- ENDIF
-
- IF(IDEBFA.GE.-3.AND.NRETRY.EQ.0) THEN
-*
-* Display messages from TMS
-*
- WRITE(LPRTFA,9011) IRC
- 9011 FORMAT(' FMSREQ. return code ',I5,' from SYSREQ.')
- WRITE(LPRTFA,9012) CHCOMM(1:LCHCMM),CHSERV(1:LCHSRV)
- 9012 FORMAT(' Command was ',A,' for service ',A)
-
- DO 20 ILOOP=1,LENBUF
- PRINT *,'FMSREQ. ',CHREP(ILOOP)(1:LENOCC(CHREP(ILOOP)))
- 20 CONTINUE
- ENDIF
-
- IF(IDEBFA.GE.0) WRITE(LPRTFA,9001) IRC,ISLEEP
- CALL SLEEPF(ISLEEP)
- NRETRY = NRETRY + 1
- GOTO 10
- ENDIF
-
-#endif
-#if !defined(CERNLIB_TMS)
- IRC = 999
-#endif
-
- 30 CONTINUE
-
- END
diff --git a/src/packlib/fatmen/fmtms/fmtags.F b/src/packlib/fatmen/fmtms/fmtags.F
deleted file mode 100644
index 944bdf6..0000000
--- a/src/packlib/fatmen/fmtms/fmtags.F
+++ /dev/null
@@ -1,175 +0,0 @@
-*
-* $Id: fmtags.F,v 1.1.1.1 1996/03/07 15:18:15 mclareni Exp $
-*
-* $Log: fmtags.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:15 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMTAGS(GENAM,LBANK,KEYS,TAG,CHOPT,IRC)
-*
-* Routine to get, set or delete TMS Tags
-*
-#include "fatmen/faust.inc"
- CHARACTER*(*) GENAM,TAG,CHOPT
- CHARACTER*255 CHTAG
- PARAMETER (LKEYFA=10)
- DIMENSION KEYS(LKEYFA)
- CHARACTER*6 COMAND
- CHARACTER*7 CHTYPE
- CHARACTER*15 VID
-#include "fatmen/tmsrep.inc"
- CHARACTER*15 XVID
- CHARACTER*8 VIP
-#include "fatmen/fatpara.inc"
-#include "fatmen/fatbank.inc"
-#include "fatmen/fatvid0.inc"
-#include "fatmen/fatoptd.inc"
-#include "fatmen/fatvid1.inc"
-#include "fatmen/fatoptc.inc"
-*
-* Options: D - delete tag
-* G - get tag
-* S - set tag
-* B - binary tag
-* T - text tag (D)
-* V - volinfo tag
-*
- IF(IOPTD.NE.0) NFDTAG = NFDTAG + 1
- IF(IOPTG.NE.0) NFGTAG = NFGTAG + 1
- IF(IOPTS.NE.0) NFSTAG = NFSTAG + 1
-
- IRC = 0
- LGN = LENOCC(GENAM)
- LTG = LENOCC(TAG)
- CHTAG = TAG(1:LTG)
-
- LCH = LENOCC(CHOPT)
-
- IF(IDEBFA.GE.3) PRINT *,'FMTAGS. enter for ',
- + GENAM(1:LGN),' options ',CHOPT(1:LCH),' tag ',
- + CHTAG(1:LTG)
-
- IF(IOPTB.EQ.0.AND.IOPTT.EQ.0.AND.IOPTV.EQ.0) THEN
- IF(IDEBFA.GE.1) PRINT *,'FMTAGS. tag typed defaulted to TEXT'
- IOPTT = 1
- ENDIF
-
- IF(IOPTD.NE.0) THEN
- COMAND = 'DELETE'
- ELSEIF(IOPTG.NE.0) THEN
- COMAND = 'GET '
- ELSEIF(IOPTS.NE.0) THEN
- COMAND = 'SET '
- IF(LTG.EQ.0) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMTAGS. tag text has zero length'
- IRC = 8
- RETURN
- ENDIF
- ENDIF
-
- IF((IOPTD.EQ.0).AND.(IOPTG.EQ.0).AND.(IOPTS.EQ.0)) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMTAGS. please specify one of ',
- + 'D, G or S'
- IRC = 8
- RETURN
- ENDIF
-
- IF(IOPTB.NE.0) THEN
- CHTYPE = 'BINARY '
- ELSEIF(IOPTT.NE.0) THEN
- CHTYPE = 'TEXT '
- ELSEIF(IOPTV.NE.0) THEN
-#if defined(CERNLIB_IN2P3)
- CHTYPE = 'SYSTEM'
-#endif
-#if !defined(CERNLIB_IN2P3)
- CHTYPE = 'VOLINFO'
-#endif
- ENDIF
-
-#if !defined(CERNLIB_TMS)
- IF(IDEBFA.GE.0) PRINT *,
- + 'FMTAGS. TMS option not installed on this node'
- CHTAG = ' '
- IRC = 99
-#endif
-#if defined(CERNLIB_TMS)
- IF(LBANK.EQ.0) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMTAGS. get bank for ',GENAM(1:LGN)
- CALL FMGETK(GENAM(1:LGN),LBANK,KEYS,IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.0)
- + PRINT *,'FMTAGS. Return code ',IRC,' from FMGETK'
- IRC = 1
- RETURN
- ENDIF
- ELSE
- IF(IDEBFA.GE.1)
- + PRINT *,'FMTAGS. enter for user supplied bank for ',
- + GENAM(1:LGN)
- ENDIF
-
- VID = ' '
- CALL FMGETC(LBANK,VID,MVIDFA,6,IRC)
- LVID = LENOCC(VID)
-#endif
-#if (defined(CERNLIB_PREFIX))&&(defined(CERNLIB_TMS))
-*
-* Generate eXtended VID - with VID prefix
-*
- JP = IQ(LBANK+KOFUFA+MVIPFA)
- IF(JP.NE.0) THEN
- LVIP = LENOCC(PREVID(JP))
- VIP = PREVID(JP)(1:LVIP )
- XVID = PREVID(JP)(1:LVIP) // '.' // VID(1:LVID)
- LXVID = LENOCC(XVID )
-
- ELSE
- XVID = VID
- LXVID = LVID
- LVIP = 0
- ENDIF
-
- VID = XVID
- LVID = LXVID
-#endif
-#if defined(CERNLIB_TMS)
-
- IF(LVID.EQ.0) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMTAGS. something is wrong - '//
- + 'VID has zero length'
- IRC = -1
- RETURN
- ENDIF
-
- I = LENREP
- DO 1 JJ=1,LENREP
- 1 TMSREP(JJ) = ' '
-
- IF(IDEBFA.GE.3) PRINT *,'FMTAGS. issuing ', 'TMS TAG VID '//
- +VID(1:LVID)//' '//COMAND//' '//CHTYPE
-
- IF(IOPTS.NE.0) THEN
-
- IF(IDEBFA.GE.3) PRINT *,' for ',CHTAG(1:LTG)
-
- CALL FMSREQ('TMS ', 'TAG VID '//VID(1:LVID) //' '//COMAND/
- + /' '//CHTYPE //' '//CHTAG(1:LTG) ,IRC,TMSREP,I)
-
- ELSE
- CALL FMSREQ('TMS ', 'TAG VID '//VID(1:LVID)//' ' //COMAND/
- + /' '//CHTYPE ,IRC,TMSREP,I)
-
- IF(IOPTG.NE.0) THEN
- TAG = ' '
- LTAG = LENOCC(TMSREP(1))
- IF(IRC.EQ.0.AND.LTAG.GT.0) TAG = TMSREP(1)(1:LTAG)
- ENDIF
-
- ENDIF
-
-#endif
- END
-
diff --git a/src/packlib/fatmen/fmtms/fmuall.F b/src/packlib/fatmen/fmtms/fmuall.F
deleted file mode 100644
index 4c73e01..0000000
--- a/src/packlib/fatmen/fmtms/fmuall.F
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: fmuall.F,v 1.1.1.1 1996/03/07 15:18:15 mclareni Exp $
-*
-* $Log: fmuall.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:15 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMUALL(MEDIA,CDENS,COMP,LIBRARY,POOL,LBANK,CHOPT,
- +VSN,VID,IRC)
-#include "fatmen/fattyp.inc"
- CHARACTER*(*) MEDIA,LIBRARY,POOL,VSN,VID,CDENS,COMP,CHOPT
- CHARACTER*8 CHROUT
-#include "fatmen/fatbug.inc"
-*
-* Dummy routine
-*
- IRC = 99
- CHROUT = 'FMUALL. '
-#include "fatmen/fatdummy.inc"
- END
diff --git a/src/packlib/fatmen/fmtms/fmulok.F b/src/packlib/fatmen/fmtms/fmulok.F
deleted file mode 100644
index 4be9f98..0000000
--- a/src/packlib/fatmen/fmtms/fmulok.F
+++ /dev/null
@@ -1,97 +0,0 @@
-*
-* $Id: fmulok.F,v 1.1.1.1 1996/03/07 15:18:14 mclareni Exp $
-*
-* $Log: fmulok.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:14 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMULOK(GENAM,LBANK,KEYS,CHOPT,IRC)
-*
-* routine to unlock a VID in the TMS according to CHOPT
-* Current function is to enable Write (independant of CHOPT)
-*
-#include "fatmen/faust.inc"
- CHARACTER*(*) GENAM,CHOPT
- PARAMETER (LKEYFA=10)
- DIMENSION KEYS(LKEYFA)
- CHARACTER*80 COMAND
- CHARACTER*15 VID
-#include "fatmen/tmsrep.inc"
- CHARACTER*15 XVID
- CHARACTER*8 VIP
-#include "fatmen/fatpara.inc"
-#include "fatmen/fatbank.inc"
-#include "fatmen/fatvid0.inc"
-#include "fatmen/fatoptd.inc"
-#include "fatmen/fatvid1.inc"
-#include "fatmen/fatoptc.inc"
-
- NFULOK = NFULOK + 1
- IRC = 0
- LGN = LENOCC(GENAM)
-#if !defined(CERNLIB_TMS)
- IF(IDEBFA.GE.0) PRINT *,
- + 'FMULOK. TMS option not installed on this node'
-#endif
-#if defined(CERNLIB_TMS)
- IF(LBANK.EQ.0) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMULOK. get bank for ',GENAM(1:LGN)
- CALL FMGETK(GENAM(1:LGN),LBANK,KEYS,IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.0)
- + PRINT *,'FMULOK. Return code ',IRC,' from FMGETK'
- IRC = 1
- RETURN
- ENDIF
- ELSE
- IF(IDEBFA.GE.0)
- + PRINT *,'FMULOK. enter for user supplied bank for ',
- + GENAM(1:LGN)
- ENDIF
-
- IF(KEYS(MKMTFA).LT.2) THEN
- IF(IDEBFA.GE.-1) PRINT *,'FMULOK. request ignored for ',
- + 'media type ',KEYS(MKMTFA)
- RETURN
- ENDIF
-
- VID = ' '
- CALL FMGETC(LBANK,VID,MVIDFA,6,IRC)
- LVID = LENOCC(VID)
-#endif
-#if (defined(CERNLIB_PREFIX))&&(defined(CERNLIB_TMS))
-*
-* Generate eXtended VID - with VID prefix
-*
- JP = IQ(LBANK+KOFUFA+MVIPFA)
- IF(JP.NE.0) THEN
- LVIP = LENOCC(PREVID(JP))
- VIP = PREVID(JP)(1:LVIP)
- XVID = PREVID(JP)(1:LVIP) // '.' // VID(1:LVID)
- LXVID = LENOCC(XVID)
-
- ELSE
- XVID = VID
- LXVID = LVID
- LVIP = 0
- ENDIF
-
- VID = XVID
- LVID = LXVID
-#endif
-#if defined(CERNLIB_TMS)
-
-10 CONTINUE
- I = LENREP
-*
- IF(IDEBFA.GE.0) PRINT *,'FMULOK. enable write access to ',
- + VID(1:LVID)
- CALL FMSREQ('TMS ',
- + 'LOCK ENABLE WRITE VID '//VID(1:LVID),
- + IRC,TMSREP,I)
-
-#endif
- END
-
diff --git a/src/packlib/fatmen/fmtms/fmutms.F b/src/packlib/fatmen/fmtms/fmutms.F
deleted file mode 100644
index e2ef125..0000000
--- a/src/packlib/fatmen/fmtms/fmutms.F
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: fmutms.F,v 1.1.1.1 1996/03/07 15:18:15 mclareni Exp $
-*
-* $Log: fmutms.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:15 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMUTMS(VID,LIB,MODEL,DENS,MNTTYP,LABTYP,IRC)
- CHARACTER*(*) VID
-#include "fatmen/fattyp.inc"
-#include "fatmen/tmsdef.inc"
-*
-* Dummy user exit routine
-*
- IRC = 99
- END
diff --git a/src/packlib/fatmen/fmtms/fmuvol.F b/src/packlib/fatmen/fmtms/fmuvol.F
deleted file mode 100644
index 6df3d71..0000000
--- a/src/packlib/fatmen/fmtms/fmuvol.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: fmuvol.F,v 1.1.1.1 1996/03/07 15:18:15 mclareni Exp $
-*
-* $Log: fmuvol.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:15 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMUVOL(GENAM,LBANK,KEYS,LIB,MODEL,DENS,MNTTYP,LABTYP,
- + IRC)
- CHARACTER*(*) GENAM
-#include "fatmen/fmnkeys.inc"
- DIMENSION KEYS(LKEYFA)
-#include "fatmen/fattyp.inc"
-#include "fatmen/tmsdef.inc"
-*
-* Dummy user exit routine
-*
- IRC = 99
- END
diff --git a/src/packlib/fatmen/fmtms/fmvinf.F b/src/packlib/fatmen/fmtms/fmvinf.F
deleted file mode 100644
index 3507e6f..0000000
--- a/src/packlib/fatmen/fmtms/fmvinf.F
+++ /dev/null
@@ -1,171 +0,0 @@
-*
-* $Id: fmvinf.F,v 1.1.1.1 1996/03/07 15:18:15 mclareni Exp $
-*
-* $Log: fmvinf.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:15 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMVINF(CHVID,MB,NFILES,CHOPT,IRC)
- CHARACTER*(*) CHVID
- CHARACTER*6 VID
- CHARACTER*255 CHTAG,CHOLD
- CHARACTER*6 COMAND
- CHARACTER*7 CHTYPE
- CHARACTER*6 CFILES,CHUSED
-#include "fatmen/slate.inc"
-#include "fatmen/tmsrep.inc"
-#include "fatmen/fatbug.inc"
-#include "fatmen/fatopts.inc"
-*
-* Options: S - set
-* G - get
-* I - increment (JFILES=JFILES+1, NUSED=NUSED+MB)
-*
- IRC = 0
- LVID = LENOCC(CHVID)
- VID = CHVID(1:LVID)
- NUSED = MB
- JFILES = NFILES
-
- IF(IOPTI.NE.0) IOPTS = 1
-
-#if !defined(CERNLIB_TMS)
- IF(IDEBFA.GE.0) PRINT *,
- + 'FMVINF. TMS option not installed on this node'
- IRC = 99
-#endif
-#if defined(CERNLIB_TMS)
-*
-* In all cases, GET VOLINFO tag
-*
- I = LENREP
- DO 1 JJ=1,LENREP
- 1 TMSREP(JJ) = ' '
-
-#endif
-#if (defined(CERNLIB_TMS))&&(defined(CERNLIB_IN2P3))
- IF(IDEBFA.GE.3) PRINT *,'FMVINF. issuing ', 'TMS TAG VID '//
- +VID(1:LVID)//' GET SYSTEM '
-
- CALL FMSREQ('TMS ', 'TAG VID '//VID(1:LVID) //' GET SYSTEM '
- +,IRC,TMSREP,I)
-#endif
-#if (defined(CERNLIB_TMS))&&(!defined(CERNLIB_IN2P3))
- IF(IDEBFA.GE.3) PRINT *,'FMVINF. issuing ', 'TMS TAG VID '//
- +VID(1:LVID)//' GET VOLINFO '
-
- CALL FMSREQ('TMS ', 'TAG VID '//VID(1:LVID) //' GET VOLINFO '
- +,IRC,TMSREP,I)
-#endif
-#if defined(CERNLIB_TMS)
-
- LTAG = LENOCC(TMSREP(1))
- IF(IRC.NE.0) RETURN
- IF(LTAG.GT.0) THEN
- CHTAG = TMSREP(1)(1:LTAG)
- CALL CLTOU(CHTAG(1:LTAG))
- IF(IDEBFA.GE.3) PRINT *,'FMVINF. volinfo tag: ',
- + CHTAG(1:LTAG)
- ELSE
- CHTAG = ' '
- IF(IDEBFA.GE.3) PRINT *,'FMVINF. volinfo tag is empty'
- ENDIF
-*
-* Get the current values of MB and NFILES
-*
- IF(IOPTG.NE.0.OR.IOPTI.NE.0) THEN
- NFOUND = 1
- IF(CHTAG(1:3).EQ.'MB=') THEN
- IFIRST = 4
- ELSE
- IFIRST = INDEX(CHTAG(1:LTAG),' MB=')
- IF(IFIRST.EQ.0) GOTO 20
- IFIRST = IFIRST + 4
- ENDIF
-
- NUSED = ICDECI(CHTAG,IFIRST,LTAG)
-
- IF(CHTAG(1:7).EQ.'NFILES=') THEN
- IFIRST = 8
- ELSE
- IFIRST = INDEX(CHTAG(1:LTAG),' NFILES=')
- IF(IFIRST.EQ.0) GOTO 20
- IFIRST = IFIRST + 8
- ENDIF
-
- JFILES = ICDECI(CHTAG,IFIRST,LTAG)
- IF(IOPTG.NE.0) THEN
- MB = NUSED
- NFILES = JFILES
- NFOUND = 0
- ENDIF
-
- 20 CONTINUE
-
- IF(IOPTG.NE.0) IRC = NFOUND
-
- IF(IOPTI.EQ.0) RETURN
- NUSED = NUSED + MB
- JFILES = JFILES + 1
- ENDIF
-
- IF(IOPTS.NE.0) THEN
-*
-* Empty tag?
-*
- IF(LTAG.EQ.0) THEN
- CALL FMITOC(JFILES,CFILES,LFILES)
- CALL FMITOC(NUSED,CHUSED,LUSED)
- CHTAG = 'NFILES='//CFILES(1:LFILES)//' MB='//CHUSED(1:LUSED)
- LTAG = LFILES + LUSED + 11
-
- ELSE
-*
-* Update MB and NFILES fields, leaving everything else alone
-*
- CHOLD = CHTAG
- JL = 1
- JR = LTAG
- CHTAG = ' '
- LTAG = 1
- 10 CONTINUE
- ILEFT = ICNEXT(CHOLD,JL,JR)
- IF(ILEFT.LT.JR) THEN
- JL = IS(2)
-*
-* Word is now in CHOLD(ILEFT:JL)
-*
- IF(INDEX(CHOLD(ILEFT:JL),'MB=').EQ.1) THEN
- CALL FMITOC(NUSED,CHUSED,LUSED)
- CHTAG(LTAG:LTAG+LUSED+3) = 'MB='//CHUSED(1:LUSED)
- LTAG = LTAG + LUSED + 4
- ELSEIF(INDEX(CHOLD(ILEFT:JL),'NFILES=').EQ.1) THEN
- CALL FMITOC(JFILES,CFILES,LFILES)
- CHTAG(LTAG:LTAG+LFILES+7) = 'NFILES='//
- + CFILES(1:LFILES)
- LTAG = LTAG + LFILES + 8
- ELSE
-*
-* Copy asis
-*
- CHTAG(LTAG:LTAG+IS(1)) = CHOLD(ILEFT:IS(2))
- LTAG = LTAG + IS(1) + 1
- ENDIF
-
- GOTO 10
-
- ENDIF
- ENDIF
-*
-* Now set the new tag
-*
- IF(IDEBFA.GE.3) PRINT *,'FMVINF. new volinfo tag: ',
- + CHTAG(1:LTAG)
- I = LENREP
- CALL FMSREQ('TMS ', 'TAG VID '//VID(1:LVID) //' SET '
- + //'VOLINFO ' //CHTAG(1:LTAG),IRC,TMSREP,I)
- ENDIF
-#endif
- END
diff --git a/src/packlib/fatmen/fmtms/fmxvid.F b/src/packlib/fatmen/fmtms/fmxvid.F
deleted file mode 100644
index 486a757..0000000
--- a/src/packlib/fatmen/fmtms/fmxvid.F
+++ /dev/null
@@ -1,61 +0,0 @@
-*
-* $Id: fmxvid.F,v 1.1.1.1 1996/03/07 15:18:15 mclareni Exp $
-*
-* $Log: fmxvid.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:15 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMXVID(VID,JP,XVID,VIP,CHOPT,IRC)
-*CMZ : 25/04/91 08.14.14 by Jamie Shiers
-*-- Author : Jamie Shiers 25/04/91
-*
-* Convert eXtended VID to VID & integer prefix and vice versa
-*
-* CHOPT: I - convert XVID to VID and integer prefix
-* C - convert VID and integer prefix to XVID
-* (return character prefix in VIP)
-*
- CHARACTER*(*) VID,XVID,VIP,CHOPT
-#include "fatmen/fatbug.inc"
-#include "fatmen/fatvid0.inc"
-#include "fatmen/fatoptd.inc"
-#include "fatmen/fatvid1.inc"
-#include "fatmen/fatoptc.inc"
- IRC = 0
-
- IF(IDEBFA.GE.3) PRINT *,'FMXVID. enter for ',
- + 'VID, JP, XVID, VIP, CHOPT = ',
- + VID, JP, XVID, VIP, CHOPT
-
- IF(IOPTC.NE.0) THEN
- IF((JP.LT.0).OR.(JP.GT.NTMS)) THEN
- IRC = -1
- ELSEIF(JP.EQ.0) THEN
- XVID = VID
- ELSE
- LVID = LENOCC(VID)
- VIP = PREVID(JP)
- LVIP = LENOCC(VIP)
- XVID = VIP(1:LVIP) // '.' // VID(1:LVID)
- ENDIF
-
- ELSEIF(IOPTI.NE.0) THEN
- LXVID = LENOCC(XVID)
- IDOT = INDEX(XVID(1:LXVID),'.')
- IF(IDOT.EQ.0) THEN
- VID = XVID(1:LXVID)
- JP = 0
- IRC = -1
- RETURN
- ELSE
- VIP = XVID(1:IDOT-1)
- LVIP = LENOCC(VIP)
- VID = XVID(IDOT+1:LXVID)
- JP = ICNTH(VIP(1:LVIP),PREVID,NTMS)
- IF(JP.EQ.0) IRC = -1
- ENDIF
- ENDIF
-
- END
diff --git a/src/packlib/fatmen/fmutil/Imakefile b/src/packlib/fatmen/fmutil/Imakefile
deleted file mode 100644
index 4fd0658..0000000
--- a/src/packlib/fatmen/fmutil/Imakefile
+++ /dev/null
@@ -1,46 +0,0 @@
-DoIncludePackage(fatmen)
-#include "pilot.h"
-
-SRCS_F= fabnet.F fafilb.F fafile.F fm0tob.F fmacct.F fmacl.F \ @@\
- fmacnt.F fmatch.F fmatob.F fmatoe.F fmbtoa.F fmclass.F \ @@\
- fmdd2l.F fmddnm.F fmdtrn.F fmend.F fmetoa.F fmexpo.F \ @@\
- fmfixf.F fmflun.F fmfnm.F fmfnme.F fmglun.F fmitoc.F \ @@\
- fmjdat.F fmjour.F fml2dd.F fmlcod.F fmlocc.F fmloco.F \ @@\
- fmlton.F fmmedt.F fmmss.F fmnick.F fmntol.F fmnwrd.F \ @@\
- fmodat.F fmoptc.F fmpkey.F fmpktm.F fmpkvx.F fmplog.F \ @@\
- fmpurl.F fmqfat.F fmrand.F fmrslv.F fmrtim.F fmshok.F \ @@\
- fmstop.F fmtdpk.F fmtime.F fmtovm.F fmuptm.F fmupvx.F \ @@\
- fmurl.F fmword.F
-
-#if defined(CERNLIB_IBMVM)
-SRCS_F := $(SRCS_F) fmonit.F
-#else
-SRCS_F := $(SRCS_F) fmhost.F
-#endif
-
-#if defined(CERNLIB_UNIX)
-SRCS_F := $(SRCS_F) fmassn.F fmrsln.F
-#else
-SRCS_F := $(SRCS_F) fmjob.F fmuser.F
-#endif
-
-#if defined(CERNLIB_SHIFT)
-SRCS_F := $(SRCS_F) fmfget.F
-CERNDEFINES:= $(CERNDEFINES) -DCERNLIB_SHIFT
-#endif
-
-#if ( defined(CERNLIB_UNIX) || defined(CERNLIB_VAXVMS) ) \
- && !defined(CERNLIB_NOCIO)
-SRCS_F := $(SRCS_F) fmcfgl.F
-#endif
-
-#if defined(CERNLIB_FPACK) || defined(CERNLIB_CSPACK)
-SRCS_F := $(SRCS_F) fmntrc.F
-#endif
-
-#if defined(CERNLIB_CSPACK)
-SRCS_F := $(SRCS_F) fmnamf.F
-#endif
-
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/fatmen/fmutil/fabnet.F b/src/packlib/fatmen/fmutil/fabnet.F
deleted file mode 100644
index 6660f24..0000000
--- a/src/packlib/fatmen/fmutil/fabnet.F
+++ /dev/null
@@ -1,81 +0,0 @@
-*
-* $Id: fabnet.F,v 1.1.1.1 1996/03/07 15:18:18 mclareni Exp $
-*
-* $Log: fabnet.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:18 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FABNET(FNAME,CHUSER,CHNODE,IFLAG,IRC)
-#include "fatmen/fatsys.inc"
-*
-* IFLAG = -1 : sendfile
-* -2 : mvs job (vm machines only)
-*
- CHARACTER*(*) CHUSER,CHNODE,FNAME
-#if defined(CERNLIB_VAXVMS)
-*
-* Copy file to RDR of specified machine
-*
-#include "fatmen/fatbank.inc"
-#include "fatmen/fatpara.inc"
- CHARACTER*80 CARD
- CHARACTER*128 FILEN
- INTEGER SYSTEMF
-
- LFN = LENOCC(FNAME)
- IF(IFLAG.LT.-1) THEN
- IRC = IFLAG
- RETURN
- ENDIF
-
- LUS = LENOCC(CHUSER)
- LNO = LENOCC(CHNODE)
-
- FILEN = CHNODE(1:LNO)//'::"RDR:<'//
- + CHUSER(1:LUS)//'>FATMEN.RDRFILE/CARD/CR"'
- IF(IDEBFA.GE.2) PRINT *,'FABNET. sending file ',
- + ' to ',FILEN
- OPEN(LUFZFA,FILE=FNAME(1:LFN),STATUS='OLD',
- + FORM='FORMATTED',ACCESS='SEQUENTIAL')
- OPEN(UNIT=99,NAME=FILEN(1:LENOCC(FILEN)),STATUS='NEW',ERR=98)
- IRC = 0
-1 CONTINUE
- READ(LUFZFA,'(A)',END=99) CARD
- WRITE(99,'(A)') CARD
- GOTO 1
-98 IRC = 1
-99 CLOSE (LUFZFA)
- CLOSE (99)
- IF ((IRC.EQ.0) .AND.(IDEBFA.GE.-3))
- + WRITE(LPRTFA,*) 'Sent file to ',CHUSER(1:LUS),' at ',
- + CHNODE(1:LNO)
-#endif
-#if defined(CERNLIB_IBMMVS)
- LFN = LENOCC(FNAME)
- LUS = LENOCC(CHUSER)
- LNO = LENOCC(CHNODE)
-
- IF(IFLAG.LT.-1) THEN
- IRC = IFLAG
- RETURN
- ENDIF
-
- CALL TSOLNK('TRANSMIT '//CHNODE(1:LNO)//'.'//
- + CHUSER(1:LUS)//' DSN('//FNAME(1:LFN)//')')
-#endif
-#if defined(CERNLIB_IBMVM)
- LFN = LENOCC(FNAME)
- LUS = LENOCC(CHUSER)
- LNO = LENOCC(CHNODE)
-
- IF(IFLAG.EQ.-1) THEN
- CALL VMCMS('EXEC SENDFILE '//FNAME(1:LFN)//' '//
- + CHUSER(1:LUS)//' AT '//CHNODE(1:LNO),IRC)
- ELSE
- CALL VMCMS('EXEC FATSUB '//FNAME(1:LFN)//' '//
- + CHUSER(1:LUS)//' AT '//CHNODE(1:LNO),IRC)
- ENDIF
-#endif
- END
diff --git a/src/packlib/fatmen/fmutil/fafilb.F b/src/packlib/fatmen/fmutil/fafilb.F
deleted file mode 100644
index de7f7fe..0000000
--- a/src/packlib/fatmen/fmutil/fafilb.F
+++ /dev/null
@@ -1,65 +0,0 @@
-*
-* $Id: fafilb.F,v 1.1.1.1 1996/03/07 15:18:19 mclareni Exp $
-*
-* $Log: fafilb.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:19 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FAFILB(LUN,FILE,LRECL,IRC)
-*CMZ : 21/08/91 15.13.43 by Jamie Shiers
-*-- Author : Jamie Shiers 21/08/91
-#if defined(CERNLIB_IBMMVS)
- DIMENSION DISP(3)
- DIMENSION SPACE(4)
-#include "fatmen/fattyp.inc"
-#endif
- CHARACTER*(*) FILE
- CHARACTER*80 OUTPUT
-
- CHARACTER*3 CHSTAT
-
- LOGICAL IEXIST
-
- LOUT = LENOCC(FILE)
- OUTPUT = FILE
-
- IRC = 0
-
-#if defined(CERNLIB_UNIX)
- CALL CUTOL(OUTPUT(1:LOUT))
-#endif
-#if defined(CERNLIB_IBMVM)
- CALL CTRANS('.',' ',OUTPUT,1,LOUT)
-#endif
-#if defined(CERNLIB_IBMVM)||defined(CERNLIB_IBMMVS)
- INQUIRE(FILE='/'//OUTPUT(1:LOUT),EXIST=IEXIST)
-#endif
-#if (!defined(CERNLIB_IBMVM))&&(!defined(CERNLIB_IBMMVS))
- INQUIRE(FILE=OUTPUT(1:LOUT),EXIST=IEXIST)
-#endif
- IF(IEXIST) THEN
- CHSTAT = 'OLD'
- ELSE
- CHSTAT = 'NEW'
- ENDIF
-#if defined(CERNLIB_IBMVM)
- CALL FILEINF(ISTAT,'RECFM','F','LRECL',LRECL)
- CALL CTRANS('.',' ',OUTPUT,1,LOUT)
- OPEN(LUN,FILE='/'//OUTPUT(1:LOUT),ACCESS='SEQUENTIAL',
-#endif
-#if defined(CERNLIB_IBMMVS)
- LUNIT = LENOCC(CHMGEN(1))
- CALL FILEINF(ISTAT,'DEVICE',CHMGEN(1)(1:LUNIT),'TRK',1,
- + 'SECOND',1,'DIR',0,
- + 'RECFM','F','LRECL',LRECL)
- OPEN(LUN,FILE='/'//OUTPUT(1:LOUT),ACCESS='SEQUENTIAL',
- + ACTION='READWRITE',
-#endif
-#if (!defined(CERNLIB_IBMVM))&&(!defined(CERNLIB_IBMMVS))
- OPEN(LUN,FILE=OUTPUT(1:LOUT),ACCESS='SEQUENTIAL',
-#endif
- + STATUS=CHSTAT,FORM='UNFORMATTED',IOSTAT=IRC)
-
- END
diff --git a/src/packlib/fatmen/fmutil/fafile.F b/src/packlib/fatmen/fmutil/fafile.F
deleted file mode 100644
index 16aec12..0000000
--- a/src/packlib/fatmen/fmutil/fafile.F
+++ /dev/null
@@ -1,76 +0,0 @@
-*
-* $Id: fafile.F,v 1.1.1.1 1996/03/07 15:18:18 mclareni Exp $
-*
-* $Log: fafile.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:18 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FAFILE(LUN,FILE,IRC)
-*CMZ : 21/08/91 15.13.43 by Jamie Shiers
-*-- Author : Jamie Shiers 21/08/91
-#if defined(CERNLIB_IBMMVS)
- DIMENSION DISP(3)
- DIMENSION SPACE(4)
-#include "fatmen/fattyp.inc"
-#endif
- CHARACTER*(*) FILE
- CHARACTER*80 OUTPUT
-
- CHARACTER*3 CHSTAT
-
- LOGICAL IEXIST
-
- LOUT = LENOCC(FILE)
- OUTPUT = FILE
-
- IRC = 0
-
-#if defined(CERNLIB_UNIX)
- CALL CUTOL(OUTPUT(1:LOUT))
-#endif
-#if defined(CERNLIB_IBMVM)
- CALL CTRANS('.',' ',OUTPUT,1,LOUT)
-#endif
-#if defined(CERNLIB_IBMVM)||defined(CERNLIB_IBMMVS)
- INQUIRE(FILE='/'//OUTPUT(1:LOUT),EXIST=IEXIST)
-#endif
-#if (!defined(CERNLIB_IBMVM))&&(!defined(CERNLIB_IBMMVS))
- INQUIRE(FILE=OUTPUT(1:LOUT),EXIST=IEXIST)
-#endif
- IF(IEXIST) THEN
- CHSTAT = 'OLD'
- ELSE
- CHSTAT = 'NEW'
- ENDIF
-#if defined(CERNLIB_IBMVM)
- CALL CTRANS('.',' ',OUTPUT,1,LOUT)
- CALL FILEINF(ISTAT,'LRECL',133,'RECFM','V')
- OPEN(LUN,FILE='/'//OUTPUT(1:LOUT),ACCESS='SEQUENTIAL',
- + STATUS=CHSTAT,FORM='FORMATTED',IOSTAT=IRC)
-#endif
-#if defined(CERNLIB_IBMMVS)
- LUNIT = LENOCC(CHMGEN(1))
- CALL FILEINF(ISTAT,'DEVICE',CHMGEN(1)(1:LUNIT),'TRK',1, 'SECOND',
- +1,'DIR',0, 'RECFM','VBA','LRECL',137,'BLKSIZE',6233)
- OPEN(LUN,FILE='/'//OUTPUT(1:LOUT),ACCESS='SEQUENTIAL', ACTION=
- +'READWRITE',
- + STATUS=CHSTAT,FORM='FORMATTED',IOSTAT=IRC)
-#endif
-#if defined(CERNLIB_VAXVMS)
- IF(IEXIST) THEN
- OPEN(LUN,FILE=OUTPUT(1:LOUT),ACCESS='SEQUENTIAL',
- + STATUS=CHSTAT,FORM='FORMATTED',IOSTAT=IRC)
- ELSE
- OPEN(LUN,FILE=OUTPUT(1:LOUT),ACCESS='SEQUENTIAL',
- + CARRIAGECONTROL='LIST',
- + STATUS=CHSTAT,FORM='FORMATTED',IOSTAT=IRC)
- ENDIF
-#endif
-#if defined(CERNLIB_UNIX)
- OPEN(LUN,FILE=OUTPUT(1:LOUT),ACCESS='SEQUENTIAL',
- + STATUS=CHSTAT,FORM='FORMATTED',IOSTAT=IRC)
-#endif
-
- END
diff --git a/src/packlib/fatmen/fmutil/fm0tob.F b/src/packlib/fatmen/fmutil/fm0tob.F
deleted file mode 100644
index 22d1104..0000000
--- a/src/packlib/fatmen/fmutil/fm0tob.F
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: fm0tob.F,v 1.1.1.1 1996/03/07 15:18:20 mclareni Exp $
-*
-* $Log: fm0tob.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:20 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FM0TOB(STRING)
-*
-* Convert zero bytes in a character string to character blanks
-*
-*
- CHARACTER*(*) STRING
-
- DO 10 J=1,LEN(STRING)
- IF ( ICHAR(STRING(J:J)) .EQ. 0 ) STRING(J:J)=' '
- 10 CONTINUE
- END
diff --git a/src/packlib/fatmen/fmutil/fmacct.F b/src/packlib/fatmen/fmutil/fmacct.F
deleted file mode 100644
index 39d01a9..0000000
--- a/src/packlib/fatmen/fmutil/fmacct.F
+++ /dev/null
@@ -1,233 +0,0 @@
-*
-* $Id: fmacct.F,v 1.1.1.1 1996/03/07 15:18:19 mclareni Exp $
-*
-* $Log: fmacct.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:19 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMACCT(CHACCT,CHACNT,IRC)
-*
-* Check if CHACCT is a valid alias for CHACNT
-*
-* CHACCT is typically the current account and CHACNT
-* the account in the catalogue
-*
-* Accounts file has the format
-*
-* emc$xv=cca$xv,rid$xv,rcl$xv
-*
-* where any of the accounts in the list cca$xv,rid$xv,rcl$xv
-* are treated as emc$xv
-*
- CHARACTER*(*) CHACCT,CHACNT
- CHARACTER*8 ACCOUN
- CHARACTER*255 CHFILE,CHLINE,ALIAS
- LOGICAL IEXIST
-
-#include "fatmen/fatsys.inc"
-#include "fatmen/fatbug.inc"
-#include "fatmen/slate.inc"
-
- IRC = 0
-
- LACCT = LENOCC(CHACCT)
- LACNT = LENOCC(CHACNT)
- LDEF = LENOCC(DEFAULT)
-
- IF(IDEBFA.GE.3) PRINT *,'FMACCT. enter for ',CHACCT(1:LACCT),' ',
- + CHACNT(1:LACNT)
-*
-* If accounts match, simply return
-*
- IF(CHACCT(1:LACCT).EQ.CHACNT(1:LACNT)) RETURN
-
-#if defined(CERNLIB_CSPACK)
- IF(FATNOD.NE.' ') THEN
-*
-* Open remote file. Here we are assuming that the remote
-* server is a Unix system
-*
- CHFILE = DEFAULT(1:LDEF)//'/FATMEN.ACCOUNTS'
- LFILE = LENOCC(CHFILE)
- CALL CUTOL(CHFILE(1:LFILE))
-*
-* Does file exist?
-*
- CALL XZINQR(LUFZFA,CHFILE(1:LFILE),FATNOD,ICODE,LRECL,IRC)
- IF(ICODE.NE.0) THEN
- IF(IDEBFA.GE.2) PRINT *,'FMLOCC. FATMEN.ACCOUNTS file ',
- + 'does not exist (',CHFILE(1:LFILE),')'
- GOTO 98
- ENDIF
- LRECL = 80
- CALL XZOPEN(LUFZFA,CHFILE(1:LFILE),FATNOD,LRECL,'F',IRC)
-
- ELSE
-
-#endif
-#if defined(CERNLIB_UNIX)
- CHFILE = DEFAULT(1:LDEF)//'/FATMEN.ACCOUNTS'
- CALL CUTOL(CHFILE)
-#endif
-#if defined(CERNLIB_VAXVMS)
- CHFILE = DEFAULT(1:LDEF)//'FATMEN.ACCOUNTS'
-#endif
-#if defined(CERNLIB_IBMVM)
- CHFILE = '/FATMEN ACCOUNTS '//SERMOD
-#endif
-#if defined(CERNLIB_IBMMVS)
- CHFILE = '/'//DEFAULT(1:LDEF)//'FATMEN.ACCOUNTS'
-#endif
- LFILE = LENOCC(CHFILE)
-*
-* Does file exist?
-*
- INQUIRE(FILE=CHFILE(1:LFILE),EXIST=IEXIST)
-
- IF(.NOT.IEXIST) THEN
- IF(IDEBFA.GE.2) PRINT *,'FMACCT. FATMEN.ACCOUNTS file ',
- + 'does not exist (',CHFILE(1:LFILE),')'
- GOTO 98
- ENDIF
-*
-* Open and read the file
-*
-#if defined(CERNLIB_IBMVM)
- OPEN(LUFZFA,FILE=CHFILE(1:LFILE),ACTION='READ',
- + ACCESS='SEQUENTIAL',FORM='UNFORMATTED',
- + STATUS='OLD',IOSTAT=IRC)
-#endif
-#if defined(CERNLIB_IBMMVS)
- CALL KUOPEN(LUFZFA,CHFILE(1:LFILE),'OLD',IRC)
-#endif
-#if defined(CERNLIB_VAXVMS)
- ISTAT = LIB$GET_LUN(LUNACC)
- IF(.NOT.ISTAT) THEN
- IRC = 42
- IF(IDEBFA.GE.-3) PRINT *,'FMACCT. could not assign logical ',
- + 'unit to read accounts file'
- GOTO 98
- ENDIF
-
- OPEN(LUNACC,FILE=CHFILE(1:LFILE),READONLY,ACCESS='SEQUENTIAL',
- + STATUS='OLD',FORM='FORMATTED',IOSTAT=IRC)
-
-#endif
-#if defined(CERNLIB_UNIX)
- CALL CIOPEN(LUNACC,'r',CHFILE(1:LFILE),IRC)
-#endif
-#if defined(CERNLIB_CSPACK)
- ENDIF
-#endif
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMACCT. error ',IRC,' opening ',
- + CHFILE(1:LFILE)
- GOTO 98
- ENDIF
-
-10 CONTINUE
-#if defined(CERNLIB_CSPACK)
- IF(FATNOD.NE.' ') THEN
- CALL XZGETL(LUFZFA,CHLINE,'(A)',' ',IRC)
- IF(IRC.NE.0) GOTO 30
- LLINE = LENOCC(CHLINE)
- ELSE
-#endif
-#if defined(CERNLIB_IBMVM)
- READ(LUFZFA,NUM=LLINE,END=30) CHLINE
-#endif
-#if defined(CERNLIB_IBMMVS)
- READ(LUFZFA,'(A)',END=30) CHLINE
- LLINE = LENOCC(CHLINE)
-#endif
-#if defined(CERNLIB_VAXVMS)
- READ(LUNACC,'(A)',END=30) CHLINE
- LLINE = LENOCC(CHLINE)
-#endif
-#if defined(CERNLIB_UNIX)
- CALL FMCFGL(LUNACC,CHLINE,LLINE,' ',ISTAT)
- IF(ISTAT.NE.0) GOTO 30
-#endif
-#if defined(CERNLIB_CSPACK)
- ENDIF
-#endif
-
- IF(LLINE.EQ.0) GOTO 10
- IF(IDEBFA.GE.3) PRINT *,'FMACCT. read ',CHLINE(1:LLINE)
-*
-* Comments...
-*
- IF(CHLINE(1:1).EQ.'!') GOTO 10
- IF(CHLINE(1:1).EQ.'*') GOTO 10
- IF(CHLINE(1:1).EQ.'#') GOTO 10
-* G.Folger "/*" is bad for cpp, so split it
- IF(CHLINE(1:1).EQ.'/' .AND. CHLINE(2:2).EQ.'*' ) GOTO 10
-
- CALL CLTOU(CHLINE(1:LLINE))
-*
-* Split line into account and alias
-*
- LEQUAL = INDEX(CHLINE(1:LLINE),'=')
- IF(LEQUAL.EQ.0) GOTO 10
- ACCOUN = CHLINE(1:LEQUAL-1)
- LACC = LEQUAL - 1
-*
-* Does account match?
-*
- CALL CLTOU(ACCOUN(1:LACC))
-
- IF(IDEBFA.GE.3) PRINT *,'FMACCT. account = ',ACCOUN(1:LACC)
-
- IF(ACCOUN(1:LACC).NE.CHACNT(1:LACNT)) GOTO 10
- ALIAS = CHLINE(LEQUAL+1:LLINE)
- LALIAS = LLINE - LEQUAL
- CALL CLTOU(ALIAS(1:LALIAS))
-
- IF(IDEBFA.GE.3) PRINT *,'FMACCT. alias = ',ALIAS(1:LALIAS)
-*
-* Look in list of aliases
-*
- ISTART = INDEX(ALIAS(1:LALIAS),CHACCT(1:LACCT))
- IF(ISTART.EQ.0) GOTO 10
- IEND = INDEX(ALIAS(ISTART:LALIAS),',')
- IF(IEND.EQ.0) THEN
- IEND = LALIAS
- ELSE
- IEND = IEND + ISTART - 2
- ENDIF
- IF(ALIAS(ISTART:IEND).EQ.CHACCT(1:LACCT)) GOTO 20
- GOTO 10
-*
-* EOF with no match
-*
-30 CONTINUE
- IRC = 1
-20 CONTINUE
-
-#if defined(CERNLIB_CSPACK)
- IF(FATNOD.NE.' ') THEN
- CALL XZCLOS(LUFZFA,' ',ISTAT)
- ELSE
-#endif
-#if defined(CERNLIB_IBM)
- CLOSE(LUFZFA)
-#endif
-#if defined(CERNLIB_VAXVMS)
- CLOSE(LUNACC)
- CALL LIB$FREE_LUN(LUNACC)
-#endif
-#if defined(CERNLIB_UNIX)
- CALL FMCFGL(LUNACC,CHLINE,LLINE,'F',ISTAT)
- CALL CICLOS(LUNACC)
-#endif
-#if defined(CERNLIB_CSPACK)
- ENDIF
-#endif
-
- RETURN
-
-98 CONTINUE
- IRC = 1
- END
diff --git a/src/packlib/fatmen/fmutil/fmacl.F b/src/packlib/fatmen/fmutil/fmacl.F
deleted file mode 100644
index e1dd8dd..0000000
--- a/src/packlib/fatmen/fmutil/fmacl.F
+++ /dev/null
@@ -1,247 +0,0 @@
-*
-* $Id: fmacl.F,v 1.1.1.1 1996/03/07 15:18:19 mclareni Exp $
-*
-* $Log: fmacl.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:19 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMACL(CHUSER,CHNODE,CHPATH,CHACT,CHOPT,IRC)
-*
-* Check that user at node has access to CHPATH for CHACT
-* (CHACT currently not checked)
-*
- CHARACTER*(*) CHUSER,CHNODE,CHPATH,CHACT
- CHARACTER*255 CHFILE,CHLINE,PATH
- CHARACTER*20 USER,NODE
- CHARACTER*8 CHNAME
- LOGICAL IEXIST
-
-#include "fatmen/fatsys.inc"
-#include "fatmen/fatbug.inc"
-#include "fatmen/slate.inc"
-#include "fatmen/fatopts.inc"
-
- IRC = 0
-
- LUSER = LENOCC(CHUSER)
- LNODE = LENOCC(CHNODE)
- LPATH = LENOCC(CHPATH)
- LACT = LENOCC(CHACT)
- LDEF = LENOCC(DEFAULT)
-
- IF(IDEBFA.GE.3) PRINT *,'FMACL. enter for ',CHUSER(1:LUSER),' ',
- + CHNODE(1:LNODE),' ',CHPATH(1:LPATH),' ',CHACT(1:LACT),' ',
- + CHOPT
-
- CHNAME = ' '
- IF(IOPTU.NE.0) THEN
- CHNAME = 'UPDATES'
- LNAME = 7
- ENDIF
- IF(IOPTA.NE.0) THEN
- CHNAME = 'ACL'
- LNAME = 3
- ENDIF
-
-#if defined(CERNLIB_CSPACK)
- IF(FATNOD.NE.' ') THEN
-*
-* Open remote file. Here we are assuming that the remote
-* server is a Unix system
-*
- CHFILE = DEFAULT(1:LDEF)//'/FATMEN.'//CHNAME(1:LNAME)
- LFILE = LENOCC(CHFILE)
- CALL CUTOL(CHFILE(1:LFILE))
-*
-* Does file exist?
-*
- CALL XZINQR(LUFZFA,CHFILE(1:LFILE),FATNOD,ICODE,LRECL,IRC)
- IF(ICODE.NE.0) THEN
- IF(IDEBFA.GE.2) PRINT *,'FMACL. FATMEN acl file does not ',
- + 'exist (',CHFILE(1:LFILE),')'
- GOTO 99
- ENDIF
- LRECL = 80
- CALL XZOPEN(LUFZFA,CHFILE(1:LFILE),FATNOD,LRECL,'F',IRC)
-
- ELSE
-#endif
-#if defined(CERNLIB_UNIX)
- CHFILE = DEFAULT(1:LDEF)//'/FATMEN.'//CHNAME(1:LNAME)
- CALL CUTOL(CHFILE)
-#endif
-#if defined(CERNLIB_VAXVMS)
- CHFILE = DEFAULT(1:LDEF)//'FATMEN.'//CHNAME(1:LNAME)
-#endif
-#if defined(CERNLIB_IBMVM)
- CHFILE = '/FATMEN '//CHNAME(1:LNAME)//' '//SERMOD
-#endif
-#if defined(CERNLIB_IBMMVS)
- CHFILE = '/'//DEFAULT(1:LDEF)//'FATMEN.'//CHNAME(1:LNAME)
-#endif
- LFILE = LENOCC(CHFILE)
-*
-* Does file exist?
-*
- INQUIRE(FILE=CHFILE(1:LFILE),EXIST=IEXIST)
-
- IF(.NOT.IEXIST) THEN
- IF(IDEBFA.GE.2) PRINT *,'FMACL. FATMEN acl file does not ',
- + 'exist (',CHFILE(1:LFILE),')'
- GOTO 99
- ENDIF
-*
-* Open and read the file
-*
-#if defined(CERNLIB_IBMVM)
- OPEN(LUFZFA,FILE=CHFILE(1:LFILE),ACTION='READ',
- + ACCESS='SEQUENTIAL',FORM='UNFORMATTED',
- + STATUS='OLD',IOSTAT=IRC)
-#endif
-#if defined(CERNLIB_IBMMVS)
- CALL KUOPEN(LUFZFA,CHFILE(1:LFILE),'OLD',IRC)
-#endif
-#if defined(CERNLIB_VAXVMS)
- ISTAT = LIB$GET_LUN(LUNACL)
- IF(.NOT.ISTAT) THEN
- IRC = 42
- IF(IDEBFA.GE.-3) PRINT *,'FMACL. could not assign logical ',
- + 'unit to read acl file'
- GOTO 98
- ENDIF
-
- OPEN(LUNACL,FILE=CHFILE(1:LFILE),READONLY,ACCESS='SEQUENTIAL',
- + STATUS='OLD',FORM='FORMATTED',IOSTAT=IRC)
-
-#endif
-#if defined(CERNLIB_UNIX)
- CALL CIOPEN(LUNACL,'r',CHFILE(1:LFILE),IRC)
-#endif
-#if defined(CERNLIB_CSPACK)
- ENDIF
-#endif
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMACL. error ',IRC,' opening ',
- + CHFILE(1:LFILE)
- GOTO 98
- ENDIF
-
-10 CONTINUE
-#if defined(CERNLIB_CSPACK)
- IF(FATNOD.NE.' ') THEN
- CALL XZGETL(LUFZFA,CHLINE,'(A)',' ',IRC)
- IF(IRC.NE.0) GOTO 30
- LLINE = LENOCC(CHLINE)
- ELSE
-#endif
-#if defined(CERNLIB_IBMVM)
- READ(LUFZFA,NUM=LLINE,END=30) CHLINE
-#endif
-#if defined(CERNLIB_IBMMVS)
- READ(LUFZFA,'(A)',END=30) CHLINE
- LLINE = LENOCC(CHLINE)
-#endif
-#if defined(CERNLIB_VAXVMS)
- READ(LUNACL,'(A)',END=30) CHLINE
- LLINE = LENOCC(CHLINE)
-#endif
-#if defined(CERNLIB_UNIX)
- CALL FMCFGL(LUNACL,CHLINE,LLINE,' ',ISTAT)
- IF(ISTAT.NE.0) GOTO 30
-#endif
-#if defined(CERNLIB_CSPACK)
- ENDIF
-#endif
-
- IF(LLINE.EQ.0) GOTO 10
-
- IF(IDEBFA.GE.3) PRINT *,'FMACL. read ',CHLINE(1:LLINE)
-*
-* Comments...
-*
- IF(CHLINE(1:1).EQ.'!') GOTO 10
- IF(CHLINE(1:1).EQ.'*') GOTO 10
- IF(CHLINE(1:1).EQ.'#') GOTO 10
-* G.Folger "/*" is bad for cpp, so split it ...
- IF(CHLINE(1:1).EQ.'/' .AND. CHLINE(2:2).EQ.'*' ) GOTO 10
-
- CALL CLTOU(CHLINE(1:LLINE))
-*
-* Split input line up into its component pieces
-*
- IBLANK = INDEX(CHLINE(1:LLINE),' ')
- JBLANK = INDEXB(CHLINE(1:LLINE),' ')
- USER = CHLINE(1:IBLANK-1)
- JUSER = IBLANK - 1
- NODE = CHLINE(IBLANK+1:JBLANK-1)
- CALL CLEFT(NODE,1,8)
- JNODE = IS(1)
- PATH = CHLINE(JBLANK+1:LLINE)
- JPATH = LLINE - JBLANK
-*
-* Is there a <user> in the path?
-*
- LLEFT = INDEX(PATH(1:JPATH),'<USER>')
- IF(LLEFT.NE.0) THEN
- CHLINE = PATH(1:LLEFT-1) // CHUSER(1:LUSER)
- IF(JPATH.GE.LLEFT+6) THEN
- CHLINE = PATH(1:LLEFT-1) // CHUSER(1:LUSER) //
- + PATH(LLEFT+6:JPATH)
- PATH = CHLINE
- JPATH = LENOCC(PATH)
- ELSE
- PATH = PATH(1:LLEFT-1) // CHUSER(1:LUSER)
- JPATH = LLEFT - 1 + LUSER
- ENDIF
- ENDIF
-*
-* Now match
-*
- IF(USER(1:JUSER).NE.'<USER>') THEN
- CALL FMATCH(CHUSER(1:LUSER),USER(1:JUSER),IRU)
- ELSE
- IRU = 0
- ENDIF
-
- CALL FMATCH(CHNODE(1:LNODE),NODE(1:JNODE),IRN)
- CALL FMATCH(CHPATH(1:LPATH),PATH(1:JPATH)//'*',IRP)
- IF(IRU+IRN+IRP.EQ.0) GOTO 20
- GOTO 10
-*
-* EOF with no match
-*
-30 CONTINUE
- IRC = 1
-20 CONTINUE
-
-#if defined(CERNLIB_CSPACK)
- IF(FATNOD.NE.' ') THEN
- CALL XZCLOS(LUFZFA,' ',ISTAT)
- ELSE
-#endif
-#if defined(CERNLIB_IBM)
- CLOSE(LUFZFA)
-#endif
-#if defined(CERNLIB_VAXVMS)
- CLOSE(LUNACL)
- CALL LIB$FREE_LUN(LUNACL)
-#endif
-#if defined(CERNLIB_UNIX)
- CALL FMCFGL(LUNACL,CHLINE,LLINE,'F',ISTAT)
- CALL CICLOS(LUNACL)
-#endif
-#if defined(CERNLIB_CSPACK)
- ENDIF
-#endif
-
- RETURN
-
-99 CONTINUE
- IRC = 0
- RETURN
-
-98 CONTINUE
- IRC = 1
- END
diff --git a/src/packlib/fatmen/fmutil/fmacnt.F b/src/packlib/fatmen/fmutil/fmacnt.F
deleted file mode 100644
index 8575454..0000000
--- a/src/packlib/fatmen/fmutil/fmacnt.F
+++ /dev/null
@@ -1,126 +0,0 @@
-*
-* $Id: fmacnt.F,v 1.1.1.1 1996/03/07 15:18:16 mclareni Exp $
-*
-* $Log: fmacnt.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:16 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- INTEGER FUNCTION FMACNT(HACNT)
-#if defined(CERNLIB_VAXVMS)
- IMPLICIT INTEGER (S)
-#endif
- CHARACTER*8 HACNT,CHACNT
-#include "fatmen/fatbug.inc"
-#include "fatmen/slate.inc"
-#if defined(CERNLIB_IBMVM)
- CHARACTER*80 CHLINE
-#endif
-#if (defined(CERNLIB_IBMVM))&&(!defined(CERNLIB_HEPVM))
- CALL VMCMS('QUERY ACCOUNT (STACK LIFO',IND)
-#endif
-#if (defined(CERNLIB_IBMVM))&&(defined(CERNLIB_HEPVM))
- CALL VMCMS('EXECIO 1 CP (LIFO STRING EXTRACT ACCOUNT . ',IND)
-#endif
-#if defined(CERNLIB_IBMVM)
- IF(IND.EQ.0) THEN
- CALL VMRTRM(CHLINE,LLINE)
- READ (CHLINE,'(8X,A8)') HACNT
- ELSE
- IF(IDEBFA.GE.-3) PRINT *,'FMACNT. cannot determine ',
- + 'account. Set to *UNKNOWN'
- HACNT = '*UNKNOWN'
- FMACNT=1
- RETURN
- ENDIF
-#endif
-#if (defined(CERNLIB_IBMVM))&&(defined(CERNLIB_VMBATCH))
-*
-* Are we in batch?
-*
- CALL VMCMS('IDENTIFY (STACK LIFO',IRC)
- CALL VMRTRM(CHLINE,LLINE)
- IF(CHLINE(1:5).EQ.'VMBAT') THEN
- CALL VMCMS('VMBATCH SERVICE STACK ACCOUNT',IRC)
- IF(IRC.EQ.0) THEN
- CALL VMRTRM(CHLINE,LLINE)
- HACNT = CHLINE(1:LLINE)
- ELSE
- IF(IDEBFA.GE.-3) PRINT *,'FMACNT. cannot determine ',
- + 'account. Set to *UNKNOWN'
- HACNT = '*UNKNOWN'
- ENDIF
- ENDIF
-#endif
-#if defined(CERNLIB_VAXVMS)
-
- CHARACTER*9 ACCOUNT
- CHARACTER*12 USER
-
-
- INCLUDE '($UAIDEF)'
- INCLUDE '($JPIDEF)'
- INCLUDE '($SSDEF)'
-
- STRUCTURE /ITMLST/
- UNION
- MAP
- INTEGER*2 BUFFER_LENGTH
- INTEGER*2 ITEM_CODE
- INTEGER*4 BUFFER_ADDRESS
- INTEGER*4 RETURN_LENGTH_ADDRESS
- ENDMAP
- MAP
- INTEGER*4 END_LIST /0/
- ENDMAP
- END UNION
- END STRUCTURE
-
- RECORD /ITMLST/ JPI_LIST(2)
- RECORD /ITMLST/ UAI_LIST(2)
-
-
- JPI_LIST(1).BUFFER_LENGTH = 12
- JPI_LIST(1).ITEM_CODE = JPI$_USERNAME
- JPI_LIST(1).BUFFER_ADDRESS = %LOC(USER)
- JPI_LIST(1).RETURN_LENGTH_ADDRESS = %LOC(LENU)
-
- JPI_LIST(2).END_LIST = 0
-
- STATUS = SYS$GETJPIW(,,,JPI_LIST,,,)
- IF (.NOT. STATUS) CALL LIB$SIGNAL(%VAL(STATUS))
-
- UAI_LIST(1).BUFFER_LENGTH = 9
- UAI_LIST(1).ITEM_CODE = UAI$_ACCOUNT
- UAI_LIST(1).BUFFER_ADDRESS = %LOC(ACCOUNT)
- UAI_LIST(1).RETURN_LENGTH_ADDRESS = %LOC(LENA)
-
- UAI_LIST(2).END_LIST = 0
-
- STATUS = SYS$GETUAI(,,USER(1:LENU),UAI_LIST,,,)
- IF (.NOT. STATUS) CALL LIB$SIGNAL(%VAL(STATUS))
-
- READ(ACCOUNT,'(A8)') HACNT
-
-#endif
-#if (defined(CERNLIB_IBMMVS))&&(defined(CERNLIB_NEWLIB))
-* Routine from DESYLIB
- CALL ACCTNR(HACNT)
-#endif
-#if defined(CERNLIB_UNIX)
- FMACNT = FMACTC(HACNT)
-#endif
-#if defined(CERNLIB_VAXVMS)||defined(CERNLIB_UNIX)
-*
-* Use value of environmental variable FMACNT if set
-*
- CALL GETENVF('FMACNT',CHACNT)
- IF(IS(1).GT.0) HACNT = CHACNT
-C
-#endif
- IF(IDEBFA.GE.3) PRINT *,'FMACNT. account set to ',
- + HACNT
- FMACNT=0
- RETURN
- END
diff --git a/src/packlib/fatmen/fmutil/fmassn.F b/src/packlib/fatmen/fmutil/fmassn.F
deleted file mode 100644
index 7d3a13c..0000000
--- a/src/packlib/fatmen/fmutil/fmassn.F
+++ /dev/null
@@ -1,132 +0,0 @@
-*
-* $Id: fmassn.F,v 1.1.1.1 1996/03/07 15:18:19 mclareni Exp $
-*
-* $Log: fmassn.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:19 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
-#if defined(CERNLIB_UNIX)
- SUBROUTINE FMASSN(DDNAME,CHFILE,CHOPT,IRC)
-
- CHARACTER*(*) DDNAME,CHFILE
- CHARACTER*255 CHHOME,CHTEMP,CHDDNM,CHNAME,CHLINE
- INTEGER SYSTEMF
-#include "fatmen/slate.inc"
-#include "fatmen/fatbug.inc"
-*
-*
-* Get, Set or Print a file assignment (Cray only?)
-#include "fatmen/fatopts.inc"
-
- IRC = 0
-
- LDD = LENOCC(DDNAME)
- LCH = LENOCC(CHFILE)
-
- CHDDNM = DDNAME(1:LDD)
-
- IF(IDEBFA.GE.1) PRINT *,'FMASSN. enter for ',
- + DDNAME(1:LDD),' ',CHFILE(1:LCH),' ',CHOPT
-
- IF(IOPTP.NE.0) THEN
-*
-* Print
-*
- IRC = SYSTEMF('assign -V | grep '//CHDDNM(1:LCH))
-
- ELSEIF(IOPTG.NE.0) THEN
-*
-* Get (translate)
-*
- CHFILE = ' '
-*
-* Get a unique filename
-*
- CALL FMFNME(CHTEMP)
- LTEMP = LENOCC(CHTEMP)
-*
-* Get home directory
-*
- CALL GETENVF('HOME',CHHOME)
- LHOME = IS(1)
-*
-* Issue assign command
-*
- IF(IDEBFA.GE.3) PRINT *,'FMASSN. issuing ',
- + 'assign -V | grep '//CHDDNM(1:LDD)
- + //' > '//CHHOME(1:LHOME)//'/'//CHTEMP(1:LTEMP)
-
- IRC = SYSTEMF('assign -V | grep '//CHDDNM(1:LDD)
- + //' > '//CHHOME(1:LHOME)//'/'//CHTEMP(1:LTEMP))
-*
-* Read output file
-*
-#if defined(CERNLIB_NOCIO)
- CALL FMGLUN(LUNASS,IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMASSN. cannot assign ',
- + 'logical unit'
- RETURN
- ENDIF
-
- CALL FAFILE(LUNASS,
- + CHHOME(1:LHOME)//'/'//CHTEMP(1:LTEMP)
- + ,ISTAT)
-#endif
-#if !defined(CERNLIB_NOCIO)
- CALL CIOPEN(LUNASS,'r',
- + CHHOME(1:LHOME)//'/'//CHTEMP(1:LTEMP)
- + ,ISTAT)
-#endif
- 10 CONTINUE
-#if defined(CERNLIB_NOCIO)
- READ(LUNASS,'(A)',END=20) CHLINE
- LLINE = LENOCC(CHLINE)
-#endif
-#if !defined(CERNLIB_NOCIO)
- CALL FMCFGL(LUNASS,CHLINE,LLINE,' ',IRC)
- IF(IRC.NE.0) GOTO 20
-#endif
- IF(IDEBFA.GE.3) PRINT *,'FMASSN. read ',CHLINE(1:LLINE)
-*
-* Get actual file name
-*
- IFOUND = INDEX(CHLINE(1:LLINE),' -a ')
- IF(IFOUND.EQ.0) GOTO 10
- LEND = INDEX(CHLINE(IFOUND+4:LLINE),' ')
- IF(LEND.EQ.0) THEN
- LEND = LLINE
- ELSE
- LEND = LEND + IFOUND + 3
- ENDIF
- IF(IDEBFA.GE.3) PRINT *,'FMASSN. actual file is ',
- + CHLINE(IFOUND+4:LEND)
- CHFILE = CHLINE(IFOUND+4:LEND)
- GOTO 20
- 20 CONTINUE
-#if defined(CERNLIB_NOCIO)
- CLOSE(LUNASS)
- CALL FMFLUN(LUNASS,IRC)
-#endif
-#if !defined(CERNLIB_NOCIO)
- CALL FMCFGL(LUNASS,CHLINE,LLINE,'F',IRC)
- CALL CICLOS(LUNASS)
-#endif
- IF(IFOUND.EQ.0) IRC = -1
-
- IC = SYSTEMF('rm '//CHHOME(1:LHOME)//'/'//CHTEMP(1:LTEMP))
-
- ELSEIF(IOPTS.NE.0) THEN
-*
-* Set
-*
- CHNAME = CHFILE(1:LCH)
- IRC = SYSTEMF('assign -a '//CHNAME(1:LCH)//' '
- + //CHDDNM(1:LCH))
-
- ENDIF
-
- END
-#endif
diff --git a/src/packlib/fatmen/fmutil/fmatch.F b/src/packlib/fatmen/fmutil/fmatch.F
deleted file mode 100644
index 630e9a8..0000000
--- a/src/packlib/fatmen/fmutil/fmatch.F
+++ /dev/null
@@ -1,318 +0,0 @@
-*
-* $Id: fmatch.F,v 1.2 1996/04/18 07:31:16 jamie Exp $
-*
-* $Log: fmatch.F,v $
-* Revision 1.2 1996/04/18 07:31:16 jamie
-* more debug in fmatch, save match and file variables
-*
-* Revision 1.1.1.1 1996/03/07 15:18:16 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMATCH(CHFILE,CHMTCH,IRC)
-*
-* This routine performs wild card file name matching
-* a la VM/CMS (FILELIST/LISTFILE) and VAX/VMS (DIRECTORY)
-* Thus: % corresponds to a single arbitrary character,
-* * corresponds to n (n>=0) arbitrary characters
-* Numeric ranges are also supported, thus (9:12) will
-* match strings 09,10,11,12.
-*
-* IRC = 1 - trailing unmatched characters in MATCH
-* IQUEST(1)-IQUEST(2) first/last unmatched characters
-* 2 - trailing unmatched characters in FILE
-* IQUEST(1)-IQUEST(2) first/last unmatched characters
-* 3 - substring mismatch
-* IQUEST(1)-IQUEST(2) first/last characters of substring in FILE
-* IQUEST(3)-IQUEST(4) first/last characters of substring in MATCH
-* 4 - cannot find character
-* IQUEST(1)-IQUEST(2) character in MATCH
-* IQUEST(3)-IQUEST(4) substring of FILE being searched
-* 5 - range mismatch
-* 6 - character mismatch
-* IQUEST(1) - character in FILE
-* IQUEST(2) - character in MATCH
-*
-#include "fatmen/faust.inc"
-#include "fatmen/fatbank.inc"
-*
- COMMON /SLATE/ NDSLAT,NESLAT, DUMMY(38)
- CHARACTER*(*) CHFILE,CHMTCH
- CHARACTER*255 FILE,MATCH
- SAVE FILE,MATCH
- CHARACTER*10 CHLOW,CHHIGH,CHMAT
- CHARACTER*3 WILD
- DATA WILD/'%*('/
-
- NFMTCH = NFMTCH + 1
- ILOW = 0
- IHIGH = 0
- ISTART = 0
- JSTART = 0
- IRC = 0
- MATCH = ' '
- FILE = ' '
- IEND = LENOCC(CHMTCH)
- JEND = LENOCC(CHFILE)
- MATCH = CHMTCH(1:IEND)
- FILE = CHFILE(1:JEND)
-*
-* Convert <> characters to *
-*
- IF(ICFMUL('<>',MATCH,1,IEND).LE.IEND) THEN
- IF(IDEBFA.GE.3) PRINT *,
- + 'FMATCH. translating <> characters to *'
- CALL CTRANS('<','*',MATCH,1,IEND)
- CALL CTRANS('>','*',MATCH,1,IEND)
- ENDIF
-*
-* Convert [] to ()
-*
- CALL CTRANS('[','(',MATCH,1,IEND)
- CALL CTRANS(']',')',MATCH,1,IEND)
-*
-* Remove multiple *'s
-*
- NESLAT = IEND
- CALL CSQMCH(MATCH,'*',1,IEND)
- IF(NESLAT.LT.IEND) IEND = NESLAT
- IF(IDEBFA.GE.3) PRINT *,'FMATCH. Compare ',MATCH(1:IEND),
- + ' against ',FILE(1:JEND)
-
- IF(MATCH(1:IEND).EQ.FILE(1:JEND)) GOTO 99
-*
-* Process all characters in FILE
-*
-10 CONTINUE
-*
-* Have reached the end of both match and file and all is ok
-*
- IF((ISTART.EQ.IEND).AND.(JSTART.EQ.JEND)) GOTO 99
- ISTART = ISTART + 1
- JSTART = JSTART + 1
-*
-* Have processed all characters in FILE...
-*
- IF(JSTART.GT.JEND) THEN
-*
-* but there are unmatched characters in MATCH...
-*
- IF(ISTART.LE.IEND) THEN
- IF(IDEBFA.GE.3) PRINT *,'FMATCH. MATCH contains ',
- + 'trailing unmatched characters - ',MATCH(ISTART:IEND)
- IRC = 1
- IQUEST(1) = ISTART
- IQUEST(2) = IEND
- GOTO 99
- ENDIF
- ENDIF
-*
-* Have processed all characters in MATCH and all compare
-*
- IF(ISTART.GT.IEND) THEN
-*
-* but FILE is longer than MATCH...
-*
- IF(ISTART.LE.JEND) THEN
- IF(IDEBFA.GE.3) PRINT *,'FMATCH. FILE contains ',
- + 'trailing unmatched characters - ',FILE(JSTART:JEND)
- IRC = 2
- IQUEST(1) = JSTART
- IQUEST(2) = JEND
- GOTO 99
- ENDIF
- ENDIF
-*
-* Look down MATCH for a * or %
-*
- IX = ICFMUL(WILD,MATCH,ISTART,IEND)
- IF(IX.GT.IEND) IX = 0
-*
-* Match any characters up until first wild card
-*
- IF(IX.GT.ISTART) THEN
- LWORD = IX - ISTART - 1
- IF(FILE(JSTART:JSTART+LWORD).NE.
- + MATCH(ISTART:ISTART+LWORD)) THEN
- IF(IDEBFA.GE.4) PRINT *,'FMATCH. substring mismatch ',
- + FILE(JSTART:JSTART+LWORD),' ',
- + MATCH(ISTART:ISTART+LWORD)
- IRC = 3
- IQUEST(1) = JSTART
- IQUEST(2) = JSTART + LWORD
- IQUEST(3) = ISTART
- IQUEST(4) = ISTART + LWORD
- GOTO 99
- ENDIF
- ISTART = ISTART + LWORD
- JSTART = JSTART + LWORD
- GOTO 10
- ENDIF
-
- IF(MATCH(IX:IX).EQ.'*') THEN
-*
-* Current character is a *
-* Are we at the end of MATCH?
-*
- IF(IX.EQ.IEND) GOTO 99
-*
-* If remaining match pattern contains no wild
-* cards, match against end of FILE
-*
- IWILD = ICFMUL(WILD,MATCH,IX+1,IEND)
- IF(IWILD.GT.IEND) THEN
- IF(MATCH(IX+1:IEND).EQ.FILE(JEND-IEND+IX+1:JEND)) GOTO 99
- ENDIF
-*
-* Find first non-wild character in MATCH and find
-* in FILE.
-*
- DO 20 I=ISTART+1,IEND
- IF((MATCH(I:I).NE.'*').AND.(MATCH(I:I).NE.'%') .AND.
- + (MATCH(I:I).NE.'(')) GOTO 30
-20 CONTINUE
-*
-* MATCH only contains * followed by other wild-cards - ok
-*
- IF(IDEBFA.GT.3)
- + PRINT *,'FMATCH. Match pattern contains only wild-cards'
- GOTO 99
-30 CONTINUE
-*
-* Look for current word in FILE and reset JSTART
-* Word is delimited by two wild-chars or end of string.
-*
- IWILD = ICFMUL(WILD,MATCH,I,IEND)
- IF(IWILD.LE.IEND) THEN
- II = IWILD - 1
- ELSE
- II = IEND
- ENDIF
-* II = MIN(IEND,ICFMUL(WILD,MATCH,I,IEND))
-* JFIND = INDEX(FILE(JSTART:JEND),MATCH(I:I))
- JFIND = INDEX(FILE(JSTART:JEND),MATCH(I:II))
- IF(JFIND.EQ.0) THEN
-* IF(IDEBFA.GE.4) PRINT *,'FMATCH. cannot find ',MATCH(I:I),
- IF(IDEBFA.GE.4) PRINT *,'FMATCH. cannot find ',MATCH(I:II),
- + ' in ',FILE(JSTART:JEND)
- IRC = 4
- IQUEST(1) = I
- IQUEST(2) = II
- IQUEST(3) = JSTART
- IQUEST(4) = JEND
- GOTO 99
- ENDIF
-
- ISTART = I
- JSTART = JSTART+JFIND-1
- GOTO 10
-
- ELSEIF(MATCH(IX:IX).EQ.'%') THEN
-*
-* Current character is a %
-*
- ELSEIF(MATCH(IX:IX).EQ.'(') THEN
-*
-* Found a range delimiter
-*
- IF(IDEBFA.GT.3)
- + PRINT *,'FMATCH. range encountered in MATCH pattern'
- IBRA = INDEX(MATCH(IX:IEND),')')
- IF(IBRA.EQ.0) THEN
-
- IF(IDEBFA.GE.-3) THEN
- PRINT *,'FMATCH. no trailing delimiter',
- + ' for range pattern'
- PRINT *,'FMATCH. range starts at ',IX,' in ',
- + MATCH(IX:IEND),' match length ',IEND
- ENDIF
-
- IRC = -4
- GOTO 99
- ENDIF
-
- ICOL = INDEX(MATCH(IX:IEND),':')
- IF(ICOL.EQ.0) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMATCH. missing colon in ',
- + 'range pattern'
- IRC = -4
- GOTO 99
- ENDIF
-
- CHLOW = MATCH(IX+1:IX+ICOL-2)
- CHHIGH = MATCH(IX+ICOL:IX+IBRA-2)
- LNHIGH = LENOCC(CHHIGH)
-
- IF(IX+IBRA.LT.IEND) THEN
- IF(IDEBFA.GE.4)
- + PRINT *,'Looking for ',MATCH(IX+IBRA:IX+IBRA),' in ',
- + FILE(JSTART:JEND)
- LNMAT = INDEX(FILE(JSTART:JEND),
- + MATCH(IX+IBRA:IX+IBRA))
- IF(LNMAT.EQ.0) THEN
- IF(IDEBFA.GE.3) PRINT *,'FMATCH. no match after',
- + ' range pattern'
- IRC = -4
- GOTO 99
- ENDIF
- LNMAT = LNMAT - 1
- ELSE
- LNMAT = LNHIGH
- ENDIF
-*
-* Extend CHLOW on the left with blanks
-*
- CALL CRIGHT(CHLOW,1,LNHIGH)
-*
-* And convert to zeroes
-*
- CALL CTRANS(' ','0',CHLOW,1,LNHIGH)
- LNLOW = LNHIGH
- IF(IDEBFA.GT.3)
- + PRINT *,'FMATCH. range = ',CHLOW,' to ',CHHIGH
- CHMAT = FILE(JSTART:JSTART+LNMAT-1)
-*
-* Extend CHMAT on the left with blanks
-*
- CALL CRIGHT(CHMAT,1,LNHIGH)
-*
-* And convert to zeroes
-*
- CALL CTRANS(' ','0',CHMAT,1,LNHIGH)
- IF(IDEBFA.GT.3)
- + PRINT *,'FMATCH. match = ',CHMAT
- IF(LLT(CHMAT(1:LNHIGH),CHLOW(1:LNLOW)) .OR.
- + LGT(CHMAT(1:LNHIGH),CHHIGH(1:LNHIGH))) THEN
- IF(IDEBFA.GE.4) PRINT *,'FMATCH. range mismatch ',
- + 'CHLOW/CHHIGH/CHMAT = ',CHLOW(1:LNLOW),
- + ' ',CHHIGH(1:LNHIGH),' ',CHMAT(1:LNHIGH)
- IRC = 5
- GOTO 99
- ENDIF
-
- ISTART = ISTART + IBRA - 1
-* JSTART = JSTART + LNHIGH - 1
- JSTART = JSTART + LNMAT - 1
- GOTO 10
-
- ELSE
-*
-* Current character is a not a wild card
-*
- IF(FILE(JSTART:JSTART).NE.MATCH(ISTART:ISTART)) THEN
- IF(IDEBFA.GT.3) PRINT *,'FMATCH. mismatch at ',
- + FILE(JSTART:JSTART),JSTART,MATCH(ISTART:ISTART),ISTART
- IRC = 6
- IQUEST(1) = ISTART
- IQUEST(2) = JSTART
- GOTO 99
- ENDIF
-
- ENDIF
-
- GOTO 10
-
-99 CONTINUE
- END
-
diff --git a/src/packlib/fatmen/fmutil/fmatob.F b/src/packlib/fatmen/fmutil/fmatob.F
deleted file mode 100644
index 746bb2c..0000000
--- a/src/packlib/fatmen/fmutil/fmatob.F
+++ /dev/null
@@ -1,61 +0,0 @@
-*
-* $Id: fmatob.F,v 1.1.1.1 1996/03/07 15:18:19 mclareni Exp $
-*
-* $Log: fmatob.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:19 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMATOB(GENAME,LBANK,CHLINE,IRC)
-
- CHARACTER*(*) GENAME,CHLINE
- CHARACTER*6 CHTYPE
-#include "fatmen/fatbank.inc"
-#include "fatmen/slate.inc"
-#include "fatmen/fatpara.inc"
-#include "fatmen/fatchar.inc"
-
- IRC = 0
-
- LLINE = LENOCC(CHLINE)
- CHTYPE = CHLINE(3:8)
-
- IF(IDEBFA.GE.3) PRINT *,'FMATOB. enter for ',CHLINE(1:LLINE),
- + ' type = ',CHTYPE
-*
-* Generic name
-*
- IF(CHTYPE.EQ.'GENAME') THEN
- GENAME = CHLINE(10:)
- RETURN
- ENDIF
-*
-* Find field
-*
- DO 10 I=1,35
- IF(CHTYPE.NE.CHBANK(I)) GOTO 10
- ITYPE = IBTYPE(I)
- ILENG = IBLENG(I)
-
- IF(IBTYPE(I).EQ.2) THEN
-*
-* Character fields
-*
- CALL UCTOH(CHLINE(10:),IQ(LBANK+KOFUFA+IBOFFS(I)),
- + 4,LLINE-10+1)
-
- ELSE
-*
-* Integer fields
-*
- JL = 10
- JR = LLINE
- DO 20 J=1,IBLENG(I)
- IQ(LBANK+KOFUFA+IBOFFS(I)+J-1) = ICDECI(CHLINE,JL,JR)
- JL = JL + IS(1) + 1
-20 CONTINUE
- ENDIF
-10 CONTINUE
-
- END
diff --git a/src/packlib/fatmen/fmutil/fmatoe.F b/src/packlib/fatmen/fmutil/fmatoe.F
deleted file mode 100644
index 55f4ff8..0000000
--- a/src/packlib/fatmen/fmutil/fmatoe.F
+++ /dev/null
@@ -1,38 +0,0 @@
-*
-* $Id: fmatoe.F,v 1.1.1.1 1996/03/07 15:18:20 mclareni Exp $
-*
-* $Log: fmatoe.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:20 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMATOE(CHTEXT,IRC)
-*
-***********************************************************************
-*
-* Converts ASCII character string to EBCDIC in place
-*
-***********************************************************************
- CHARACTER*(*) CHTEXT
- PARAMETER (NCHAR = 127)
- INTEGER EBCDIC
- DIMENSION EBCDIC(NCHAR)
- DATA EBCDIC /8*0,5,22*0,
- + 64, 90,127,123, 91,108, 80,125, 77, 93, 92, 78,107, 96, 75, 97,
- +240,241,242,243,244,245,246,247,248,249,122, 94, 76,126,110,111,
- +124,193,194,195,196,197,198,199,200,201,209,210,211,212,213,214,
- +215,216,217,226,227,228,229,230,231,232,233,173,224,189, 95,109,
- +121,129,130,131,132,133,134,135,136,137,145,146,147,148,149,150,
- +151,152,153,162,163,164,165,166,167,168,169,192, 79,208,161,7/
-*-----------------------------------
-*
- LTEXT = LENOCC(CHTEXT)
- IRC = 0
-
- DO 10 I=1,LTEXT
- CHTEXT(I:I) = CHAR(EBCDIC(ICHAR(CHTEXT(I:I))))
- 10 CONTINUE
-
- END
-
diff --git a/src/packlib/fatmen/fmutil/fmbtoa.F b/src/packlib/fatmen/fmutil/fmbtoa.F
deleted file mode 100644
index 762fadd..0000000
--- a/src/packlib/fatmen/fmutil/fmbtoa.F
+++ /dev/null
@@ -1,82 +0,0 @@
-*
-* $Id: fmbtoa.F,v 1.1.1.1 1996/03/07 15:18:19 mclareni Exp $
-*
-* $Log: fmbtoa.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:19 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMBTOA(GENAME,LBANK,KEYS,CHOPT,IRC)
-*
-* Convert bank to ASCII format
-*
- CHARACTER*(*) GENAME
- CHARACTER*255 CHTEXT
- CHARACTER*255 CHLINE,SPACES
- CHARACTER*2 CHIDNT
-#include "fatmen/fmnkeys.inc"
- DIMENSION KEYS(LKEYFA)
-#include "fatmen/fatpara.inc"
-#include "fatmen/fatbank.inc"
-#include "fatmen/fatopts.inc"
-
-#include "fatmen/fatchar.inc"
-
- IF(IOPTS.NE.0) THEN
- CHIDNT = 'S_'
- ELSEIF(IOPTD.NE.0) THEN
- CHIDNT = 'D_'
- ENDIF
-
- IRC = 0
- IF(LBANK.EQ.0) THEN
- CALL FMGETK(GENAME,LBANK,KEYS,IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.-3)
- + PRINT *,'FMBTOA. Return code ',IRC,' from FMGETK'
- IRC = 1
- RETURN
- ENDIF
- ENDIF
-
- LGN = LENOCC(GENAME)
-
- CHLINE = ' '
- WRITE(CHLINE,9001) CHIDNT,'GENAME=',GENAME(1:LGN)
- 9001 FORMAT(A2,A7,A)
- WRITE(LUFZFA,9004) CHLINE(1:LENOCC(CHLINE))
-
- DO 10 I=1,35
- IF(IBTYPE(I).EQ.2) THEN
-*
-* Character fields
-*
- CHTEXT = ' '
- CALL UHTOC(IQ(LBANK+KOFUFA+IBOFFS(I)),4,CHTEXT,IBLENG(I))
- LTEXT = LENOCC(CHTEXT)
- IF(LTEXT.GT.0) THEN
- CHLINE = ' '
- WRITE(CHLINE,9002) CHIDNT,CHBANK(I),'=',CHTEXT(1:LTEXT)
- 9002 FORMAT(A2,A6,A1,A)
- WRITE(LUFZFA,9004) CHLINE(1:LENOCC(CHLINE))
- ENDIF
-
- ELSE
-*
-* Integer fields
-*
- WRITE(CHLINE,9003) CHIDNT,CHBANK(I),
- + (IQ(LBANK+KOFUFA+IBOFFS(I)-1+J),J=1,IBLENG(I))
- 9003 FORMAT(A2,A6,'=',10(I10,','))
- CHLINE = SPACES(CHLINE,0)
- LLINE = LENOCC(CHLINE) - 1
- WRITE(LUFZFA,9004) CHLINE(1:LLINE)
-
- ENDIF
-
- 10 CONTINUE
-
- 9004 FORMAT(A)
-
- END
diff --git a/src/packlib/fatmen/fmutil/fmcfgl.F b/src/packlib/fatmen/fmutil/fmcfgl.F
deleted file mode 100644
index f3f2ea3..0000000
--- a/src/packlib/fatmen/fmutil/fmcfgl.F
+++ /dev/null
@@ -1,79 +0,0 @@
-*
-* $Id: fmcfgl.F,v 1.1.1.1 1996/03/07 15:18:19 mclareni Exp $
-*
-* $Log: fmcfgl.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:19 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
-#if (defined(CERNLIB_UNIX)||defined(CERNLIB_VAXVMS))&&(!defined(CERNLIB_NOCIO))
- SUBROUTINE FMCFGL(LUNPTR,LINE,LLINE,CHOPT,IRC)
-*CMZ : 14/11/91 15.21.53 by Jamie Shiers
-*-- Author : Jamie Shiers 14/11/91
-*
-* Get a line from a Unix file using C I/O
-*
- CHARACTER*(*) LINE,CHOPT
- CHARACTER*80 BUFF
- CHARACTER*1 NL
-
-#include "fatmen/fatbug.inc"
-
- SAVE NL,BUFF,ISTART,INL,JSTART,JEND,JCONT,NREAD,NENTRY
-
-#include "fatmen/fatoptd.inc"
-
- DATA NENTRY/0/,JCONT/0/
-
- CALL FMOPTC(CHOPT,ALFNUM,IOPT)
-
- IF(NENTRY.EQ.0) THEN
- NL = CHAR(10)
- NENTRY = 1
- ELSE
- IF(IOPTF.NE.0) THEN
- JCONT = 0
- RETURN
- ENDIF
- ENDIF
-
- IRC = 0
- IF(JCONT.NE.0) GOTO 20
-
- JSTART = 1
- JEND = 0
-10 CONTINUE
- ISTART = 1
- CALL CIGET(LUNPTR,BUFF,80,NREAD,IRC)
- IF(IRC.LT.0) RETURN
- IF(IDEBFA.GE.4) PRINT *,'FMCFGL. read ',BUFF(1:NREAD)
-*
-* Look for a \n character
-*
-20 CONTINUE
- INL = INDEX(BUFF(ISTART:NREAD),NL)
- IF(INL.NE.0) THEN
- JEND = JEND + INL - 1
- INL = INL + ISTART -1
-
- LINE(JSTART:) = BUFF(ISTART:INL-1)
-
- LLINE = JEND
- JSTART = 1
- JEND = 0
- JCONT = 1
- ISTART = INL + 1
- RETURN
-
- ELSE
- LINE(JSTART:) = BUFF(ISTART:NREAD)
- JSTART = JSTART + NREAD - ISTART + 1
- JEND = JSTART - 1
- ENDIF
-
- JCONT = 0
- GOTO 10
-
- END
-#endif
diff --git a/src/packlib/fatmen/fmutil/fmclass.F b/src/packlib/fatmen/fmutil/fmclass.F
deleted file mode 100644
index e58144e..0000000
--- a/src/packlib/fatmen/fmutil/fmclass.F
+++ /dev/null
@@ -1,249 +0,0 @@
-*
-* $Id: fmclass.F,v 1.1.1.1 1996/03/07 15:18:20 mclareni Exp $
-*
-* $Log: fmclass.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:20 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMCLASS(GNAME,CHSGRP,CHNAME,CHSERV,CHOPT,IRC)
-*
-* Get storage class and related info for generic name
-*
-* Storage class file has following syntax:
-*
-* generic-name storage-class store-name storage-server
-*
- CHARACTER*(*) GNAME,CHSGRP,CHNAME,CHSERV
- CHARACTER*255 GENAM,CHFILE,CHLINE,PATH
- LOGICAL IEXIST
-
-#include "fatmen/fatsys.inc"
-#include "fatmen/fatbug.inc"
-#include "fatmen/slate.inc"
-#include "fatmen/fatopts.inc"
-
- IRC = 0
- CHSGRP = ' '
- CHNAME = ' '
- CHSERV = ' '
-
- LGN = LENOCC(GNAME)
- GENAM = GNAME(1:LGN)
- CALL CLTOU(GENAM(1:LGN))
-
- IF(IDEBFA.GE.3) WRITE(LPRTFA,9001) GENAM(1:LGN),CHOPT
-
- LDEF = LENOCC(DEFAULT)
-
-#if defined(CERNLIB_CSPACK)
- IF(FATNOD.NE.' ') THEN
-*
-* Open remote file. Here we are assuming that the remote
-* server is a Unix system
-*
- CHFILE = DEFAULT(1:LDEF)//'/FATMEN.STORAGE-CLASSES'
- LFILE = LENOCC(CHFILE)
- CALL CUTOL(CHFILE(1:LFILE))
-*
-* Does file exist?
-*
- CALL XZINQR(LUFZFA,CHFILE(1:LFILE),FATNOD,ICODE,LRECL,IRC)
- IF(ICODE.NE.0) THEN
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9002) CHFILE(1:LFILE)
- GOTO 99
- ENDIF
- LRECL = 80
- CALL XZOPEN(LUFZFA,CHFILE(1:LFILE),FATNOD,LRECL,'F',IRC)
-
- ELSE
-#endif
-#if defined(CERNLIB_UNIX)
- CHFILE = DEFAULT(1:LDEF)//'/FATMEN.STORAGE-CLASSES'
- CALL CUTOL(CHFILE)
-#endif
-#if defined(CERNLIB_VAXVMS)
- CHFILE = DEFAULT(1:LDEF)//'FATMEN.STORAGE-CLASSES'
-#endif
-#if defined(CERNLIB_IBMVM)
- CHFILE = '/FATMEN CLASSES '//SERMOD
-#endif
-#if defined(CERNLIB_IBMMVS)
- CHFILE = '/'//DEFAULT(1:LDEF)//'FATMEN.STORAGE.CLASSES'
-#endif
- LFILE = LENOCC(CHFILE)
-*
-* Does file exist?
-*
- INQUIRE(FILE=CHFILE(1:LFILE),EXIST=IEXIST)
-
- IF(.NOT.IEXIST) THEN
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9002) CHFILE(1:LFILE)
- GOTO 99
- ENDIF
-*
-* Open and read the file
-*
-#if defined(CERNLIB_IBMVM)
- OPEN(LUFZFA,FILE=CHFILE(1:LFILE),ACTION='READ',
- + ACCESS='SEQUENTIAL',FORM='UNFORMATTED',
- + STATUS='OLD',IOSTAT=IRC)
-#endif
-#if defined(CERNLIB_IBMMVS)
- CALL KUOPEN(LUFZFA,CHFILE(1:LFILE),'OLD',IRC)
-#endif
-#if defined(CERNLIB_VAXVMS)
- ISTAT = LIB$GET_LUN(LUNSCL)
- IF(.NOT.ISTAT) THEN
- IRC = 42
- IF(IDEBFA.GE.-3) WRITE(LPRTFA,9003)
- GOTO 98
- ENDIF
-
- OPEN(LUNSCL,FILE=CHFILE(1:LFILE),READONLY,ACCESS='SEQUENTIAL',
- + STATUS='OLD',FORM='FORMATTED',IOSTAT=IRC)
-
-#endif
-#if defined(CERNLIB_UNIX)
- CALL CIOPEN(LUNSCL,'r',CHFILE(1:LFILE),IRC)
-#endif
-#if defined(CERNLIB_CSPACK)
- ENDIF
-#endif
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.-3) WRITE(LPRTFA,9004) IRC,CHFILE(1:LFILE)
- GOTO 98
- ENDIF
-
-10 CONTINUE
-#if defined(CERNLIB_CSPACK)
- IF(FATNOD.NE.' ') THEN
- CALL XZGETL(LUFZFA,CHLINE,'(A)',' ',IRC)
- IF(IRC.NE.0) GOTO 30
- LLINE = LENOCC(CHLINE)
- ELSE
-#endif
-#if defined(CERNLIB_IBMVM)
- READ(LUFZFA,NUM=LLINE,END=30) CHLINE
-#endif
-#if defined(CERNLIB_IBMMVS)
- READ(LUFZFA,'(A)',END=30) CHLINE
- LLINE = LENOCC(CHLINE)
-#endif
-#if defined(CERNLIB_VAXVMS)
- READ(LUNSCL,'(A)',END=30) CHLINE
- LLINE = LENOCC(CHLINE)
-#endif
-#if defined(CERNLIB_UNIX)
- CALL FMCFGL(LUNSCL,CHLINE,LLINE,' ',ISTAT)
- IF(ISTAT.NE.0) GOTO 30
-#endif
-#if defined(CERNLIB_CSPACK)
- ENDIF
-#endif
-
- IF(LLINE.EQ.0) GOTO 10
-
- IF(IDEBFA.GE.3) WRITE(LPRTFA,9005) CHLINE(1:LLINE)
-*
-* Comments...
-*
- IF(CHLINE(1:1).EQ.'!') GOTO 10
- IF(CHLINE(1:1).EQ.'*') GOTO 10
- IF(CHLINE(1:1).EQ.'#') GOTO 10
-* G.Folger "/*" is bad for cpp, so split it
- IF(CHLINE(1:1).EQ.'/' .AND. CHLINE(2:2).EQ.'*' ) GOTO 10
-
- CALL CLTOU(CHLINE(1:LLINE))
-
- LBLANK = INDEX(CHLINE(1:LLINE),' ')
- IF(LBLANK.EQ.0) THEN
- IF(IDEBFA.GE.0) WRITE(LPRTFA,9006) CHLINE(1:LLINE)
- GOTO 10
- ENDIF
-*
-* Now match
-*
- CALL FMATCH(GENAM(1:LGN),CHLINE(1:LBLANK-1),IRC)
- IF(IRC.EQ.0) THEN
- LEND = LLINE
- JBLANK = INDEXB(CHLINE(1:LEND),' ')
- IF(JBLANK.EQ.0) THEN
- IF(IDEBFA.GE.0) WRITE(LPRTFA,9006) CHLINE(1:LLINE)
- GOTO 10
- ENDIF
- CHSERV = CHLINE(JBLANK+1:LEND)
-
- LEND = JBLANK - 1
-
- JBLANK = INDEXB(CHLINE(1:LEND),' ')
- IF(JBLANK.EQ.0) THEN
- IF(IDEBFA.GE.0) WRITE(LPRTFA,9006) CHLINE(1:LLINE)
- GOTO 10
- ENDIF
- CHNAME = CHLINE(JBLANK+1:LEND)
-
- LEND = JBLANK - 1
-
- JBLANK = INDEXB(CHLINE(1:LEND),' ')
- IF(JBLANK.EQ.0) THEN
- IF(IDEBFA.GE.0) WRITE(LPRTFA,9006) CHLINE(1:LLINE)
- GOTO 10
- ENDIF
- CHSGRP = CHLINE(JBLANK+1:LEND)
-
- IF(LBLANK.NE.JBLANK) THEN
- IF(IDEBFA.GE.0) WRITE(LPRTFA,9006) CHLINE(1:LLINE)
- GOTO 10
- ENDIF
- GOTO 20
- ENDIF
- GOTO 10
-*
-* EOF with no match
-*
-30 CONTINUE
- IRC = 1
- CHSGRP = ' '
- CHNAME = ' '
- CHSERV = ' '
-20 CONTINUE
-
-#if defined(CERNLIB_CSPACK)
- IF(FATNOD.NE.' ') THEN
- CALL XZCLOS(LUFZFA,' ',ISTAT)
- ELSE
-#endif
-#if defined(CERNLIB_IBM)
- CLOSE(LUFZFA)
-#endif
-#if defined(CERNLIB_VAXVMS)
- CLOSE(LUNSCL)
- CALL LIB$FREE_LUN(LUNSCL)
-#endif
-#if defined(CERNLIB_UNIX)
- CALL FMCFGL(LUNSCL,CHLINE,LLINE,'F',ISTAT)
- CALL CICLOS(LUNSCL)
-#endif
-#if defined(CERNLIB_CSPACK)
- ENDIF
-#endif
-
- RETURN
-9001 FORMAT(' FMCLASS. enter for genam = ',A,' CHOPT = ',A)
-9002 FORMAT(' FMCLASS. FATMEN storage classes file does not',
- + ' exist (',A,')')
-9003 FORMAT(' FMCLASS. could not assign logical unit to read',
- + ' storage classes file')
-9004 FORMAT(' FMCLASS. error ',I10,' opening ',A)
-9005 FORMAT(' FMCLASS. read ',A)
-9006 FORMAT(' FMCLASS. bad syntax in line ',A)
-
-99 CONTINUE
- IRC = 0
- RETURN
-
-98 CONTINUE
- IRC = 1
- END
diff --git a/src/packlib/fatmen/fmutil/fmdd2l.F b/src/packlib/fatmen/fmutil/fmdd2l.F
deleted file mode 100644
index d644cf5..0000000
--- a/src/packlib/fatmen/fmutil/fmdd2l.F
+++ /dev/null
@@ -1,68 +0,0 @@
-*
-* $Id: fmdd2l.F,v 1.1.1.1 1996/03/07 15:18:16 mclareni Exp $
-*
-* $Log: fmdd2l.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:16 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMDD2L(DDNAME,LUN,IRC)
-*
-* Convert a DDNAME to the corresponding logical unit
-*
- CHARACTER*(*) DDNAME
-
- IRC = 0
- LDD = LENOCC(DDNAME)
-*
-* Get logical unit from DDNAME
-*
- IF(DDNAME(1:2).EQ.'FT') THEN
-*
-* IBM FORTRAN
-*
- READ(DDNAME(3:4),'(I2)') LUN
-
- ELSEIF(DDNAME(1:6).EQ.'IOFILE') THEN
-*
-* IOPACK
-*
- READ(DDNAME(7:8),'(I2)') LUN
-
- ELSEIF(DDNAME(1:2).EQ.'VM') THEN
-*
-* VMIO
-*
- READ(DDNAME(3:4),'(I2)') LUN
-
- ELSEIF(DDNAME(1:3).EQ.'FOR') THEN
-*
-* VAX FORTRAN
-*
- READ(DDNAME(4:6),'(I3)') LUN
-
- ELSEIF(DDNAME(1:5).EQ.'fort.') THEN
-*
-* Unix FORTRAN
-*
- IF(LDD.EQ.6) THEN
- READ(DDNAME(6:6),'(I1)') LUN
- ELSE
- READ(DDNAME(6:7),'(I2)') LUN
- ENDIF
-
- ELSEIF(DDNAME(1:3).EQ.'ftn') THEN
-*
-* Unix FORTRAN (e.g. HP/UX)
-*
- READ(DDNAME(4:5),'(I2)') LUN
-*
-*
-* Character lun
-*
- ELSEIF(ICNUM(DDNAME,1,LDD).EQ.LDD+1) THEN
- LUN = ICDECI(DDNAME,1,LDD)
- ENDIF
-
- END
diff --git a/src/packlib/fatmen/fmutil/fmddnm.F b/src/packlib/fatmen/fmutil/fmddnm.F
deleted file mode 100644
index d69f3db..0000000
--- a/src/packlib/fatmen/fmutil/fmddnm.F
+++ /dev/null
@@ -1,36 +0,0 @@
-*
-* $Id: fmddnm.F,v 1.1.1.1 1996/03/07 15:18:19 mclareni Exp $
-*
-* $Log: fmddnm.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:19 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMDDNM(LUN,CHDD,IRC)
-
- CHARACTER*(*) CHDD
-
- IRC = 0
- CHDD = ' '
-
-#if defined(CERNLIB_UNIX)
- CHDD = 'fort.'
- IF(LUN.LT.10) THEN
- WRITE(CHDD(6:6),'(I1)') LUN
- ELSE
- WRITE(CHDD(6:6),'(I1)') LUN
- ENDIF
-
-#endif
-#if defined(CERNLIB_VAXVMS)
- CHDD = 'FOR000'
- WRITE(CHDD(4:6),'(I3.3)') LUN
-
-#endif
-#if defined(CERNLIB_IBM)
- CHDD = 'FT00F001'
- WRITE(CHDD(4:5),'(I2.2)') LUN
-#endif
-
- END
diff --git a/src/packlib/fatmen/fmutil/fmdtrn.F b/src/packlib/fatmen/fmutil/fmdtrn.F
deleted file mode 100644
index 1b5c172..0000000
--- a/src/packlib/fatmen/fmutil/fmdtrn.F
+++ /dev/null
@@ -1,60 +0,0 @@
-*
-* $Id: fmdtrn.F,v 1.1.1.1 1996/03/07 15:18:17 mclareni Exp $
-*
-* $Log: fmdtrn.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:17 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMDTRN(CHRAN,IDATE,ITIME,JDATE,JTIME,IC)
-*CMZ : 24/05/91 13.21.20 by Jamie Shiers
-*-- Author : Jamie Shiers 24/05/91
-* Convert character date & time range into integer format
-* yymmdd = yymmdd until now
-* -yymmdd = beginning of time until yymmdd
-* .hhmm = hhmm on first day of Universe/today depending on position
-*
- CHARACTER*(*) CHRAN
-
- IC = 0
- IDATE = 0
- ITIME = 0
- CALL DATIME(JDATE,JTIME)
-
- LCHRAN = LENOCC(CHRAN)
-
- IF(LCHRAN.EQ.0) THEN
- IC = -1
- RETURN
- ENDIF
-*
-* Start date and time?
-*
- IMINUS = INDEX(CHRAN(1:LCHRAN),'-')
-
- IF(IMINUS.EQ.1) GOTO 10
-
- IF(IMINUS.EQ.0) THEN
- IDOT = INDEX(CHRAN(1:LCHRAN),'.')
- ELSE
- IDOT = INDEX(CHRAN(1:IMINUS-1),'.')
- ENDIF
-
- IDATE = ICDECI(CHRAN,1,LCHRAN)
-
- IF(IDOT.NE.0) ITIME = ICDECI(CHRAN,IDOT+1,LCHRAN)
- IF((IMINUS.EQ.0).OR.(IMINUS.EQ.LCHRAN)) RETURN
-
-10 CONTINUE
-
- ISTART = IMINUS + 1
- JDOT = INDEX(CHRAN(ISTART:LCHRAN),'.')
- IF(JDOT.NE.1) JDATE = ICDECI(CHRAN,ISTART,LCHRAN)
- IF(JDOT.NE.0) THEN
- JTIME = ICDECI(CHRAN,ISTART+JDOT,LCHRAN)
- ELSE
- JTIME = 0
- ENDIF
-
- END
diff --git a/src/packlib/fatmen/fmutil/fmend.F b/src/packlib/fatmen/fmutil/fmend.F
deleted file mode 100644
index 3055b60..0000000
--- a/src/packlib/fatmen/fmutil/fmend.F
+++ /dev/null
@@ -1,65 +0,0 @@
-*
-* $Id: fmend.F,v 1.2 1996/10/29 10:09:01 jamie Exp $
-*
-* $Log: fmend.F,v $
-* Revision 1.2 1996/10/29 10:09:01 jamie
-* Dont call FMUPDT for unit 0
-*
-* Revision 1.1.1.1 1996/03/07 15:18:16 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMEND(IRC)
-#include "fatmen/fatbank.inc"
-#include "fatmen/fatpara.inc"
-#include "fatmen/fatsys.inc"
-#include "fatmen/fstate.inc"
-#include "fatmen/fatupd.inc"
-#include "fatmen/fmnkeys.inc"
- DIMENSION KEYS(LKEYFA)
-
- LURZFA = IQ(LTOPFA+KOFUFA+MLUNFA)
-*
-* Ensure that any outstanding updates have been sent
-*
- IF(MFPHAS.EQ.1) THEN
-*
-* Send logging record
-*
- MAXUPD = MAX(MAXUPD,0)
- IF(NUPDT.GE.MAXUPD) MAXUPD = NUPDT + 2
-#if !defined(CERNLIB_IBMVM)
- IF(LUFZFA.GT.0) THEN
-#endif
-#if defined(CERNLIB_IBMVM)
- IF(LUFZFA.NE.0) THEN
-#endif
- CALL FMFZO('LOG ',FATTOP(1:LENOCC(FATTOP)),0,KEYS,IRC)
- CALL FMUPDT(0,0,0,IRC)
- IF((IRC.NE.0) .AND. (IDEBFA.GT.-3))
- + PRINT *,'FMEND. Return code ',IRC,' from FMUPDT.'
- ENDIF
- ENDIF
-*
-* Set program phase
-*
- MFPHAS = 3
-
- IRC=0
- IF(IDEBFA.GT.-3) WRITE(LPRTFA,9001)
-#if !defined(CERNLIB_CZ)
- CALL RZEND(TOPDIR(3:LENOCC(TOPDIR)))
-#endif
- CALL MZWIPE(IDIVFA)
-9001 FORMAT(' FMEND. Terminating FATMEN package')
-#if (defined(CERNLIB_IBMVM))&&(!defined(CERNLIB_FMOTOZ))
- CALL FMONIT('End FATMEN')
-#endif
-
-#if defined(CERNLIB_CSPACK)
- IF(FATNOD.NE.' ') THEN
- CALL XZCLOS(LURZFA,' ',IRC)
- ENDIF
-#endif
- END
diff --git a/src/packlib/fatmen/fmutil/fmetoa.F b/src/packlib/fatmen/fmutil/fmetoa.F
deleted file mode 100644
index 67478a2..0000000
--- a/src/packlib/fatmen/fmutil/fmetoa.F
+++ /dev/null
@@ -1,38 +0,0 @@
-*
-* $Id: fmetoa.F,v 1.1.1.1 1996/03/07 15:18:20 mclareni Exp $
-*
-* $Log: fmetoa.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:20 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMETOA(CHTEXT,IRC)
-*
-***********************************************************************
-*
-* Converts EBCDIC character string to ASCII in place
-*
-***********************************************************************
- CHARACTER*(*) CHTEXT
- PARAMETER (NCHAR = 256)
- DIMENSION IASCII(NCHAR)
- DATA IASCII/
- +4*32,9,58*32,32,10*32,46,60,40,43,124,38,9*32,33,36,42,41,59,94,
- +45,47,9*32,44,37,95,62,63,9*32,96,58,35,64,39,61,34,32,97,98,99,
- +100,101,102,103,104,105,7*32,106,107,108,109,110,111,112,113,114,
- +7*32,126,115,116,117,118,119,120,121,122,3*32,91,15*32,93,32,32,
- +123,65,66,67,68,69,70,71,72,73,6*32,125,74,75,76,77,78,79,80,81,
- +82,6*32,92,32,83,84,85,86,87,88,89,90,6*32,48,49,50,51,52,53,54,
- +55,56,57,7*32/
-*-----------------------------------
-*
- LTEXT = LENOCC(CHTEXT)
- IRC = 0
-
- DO 10 I=1,LTEXT
- CHTEXT(I:I) = CHAR(IASCII(ICHAR(CHTEXT(I:I))))
- 10 CONTINUE
-
- END
-
diff --git a/src/packlib/fatmen/fmutil/fmexpo.F b/src/packlib/fatmen/fmutil/fmexpo.F
deleted file mode 100644
index 740bbdd..0000000
--- a/src/packlib/fatmen/fmutil/fmexpo.F
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: fmexpo.F,v 1.1.1.1 1996/03/07 15:18:19 mclareni Exp $
-*
-* $Log: fmexpo.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:19 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMEXPO(GENAM,KEYSO,CHMED,CHPOOL,CHLIB,CHOPT,IRC)
-*
-* chopt: F - use FZIN/OUT
-* T - test
-* M - write multiple files per volume
-* S - use STAGE (rather than mounting tapes directly)
-* W - synchronous STAGE PUT
-*
- END
diff --git a/src/packlib/fatmen/fmutil/fmfget.F b/src/packlib/fatmen/fmutil/fmfget.F
deleted file mode 100644
index 46fd2c4..0000000
--- a/src/packlib/fatmen/fmutil/fmfget.F
+++ /dev/null
@@ -1,126 +0,0 @@
-*
-* $Id: fmfget.F,v 1.1.1.1 1996/03/07 15:18:19 mclareni Exp $
-*
-* $Log: fmfget.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:19 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
-#if defined(CERNLIB_SHIFT)
- SUBROUTINE FMFGET(CHPOOL,CHUSER,CHFILE,CHPATH,IMODE,CHOPT,IRC)
-*
-* Fortran interface to sfget
-*
-#include "fatmen/slate.inc"
-#include "fatmen/fatbug.inc"
- CHARACTER*(*) CHPOOL,CHUSER,CHFILE,CHPATH
- CHARACTER*255 SHPOOL,SHUSER,SHFILE
- CHARACTER*255 SHCOMM,SHUNAM,SHFNAM
-
- INTEGER SYSTEMF
-
- LOGICAL IEXIST
-
-#include "fatmen/fatopts.inc"
-
- IRC = 0
-
- LPOOL = LENOCC(CHPOOL)
- LUSER = LENOCC(CHUSER)
- LFILE = LENOCC(CHFILE)
- SHPOOL = CHPOOL(1:LPOOL)
- SHUSER = CHUSER(1:LUSER)
- SHFILE = CHFILE(1:LFILE)
-
- CHPATH = ' '
-*
-* Get temporary file name
-*
- 10 CONTINUE
- CALL FMFNME(SHUNAM)
- LUNAM = LENOCC(SHUNAM)
- INQUIRE(FILE=SHUNAM(1:LUNAM),EXIST=IEXIST)
- IF(IEXIST) THEN
- IC = SLEEPF(1)
- GO TO 10
- ENDIF
-
- IF(IDEBFA.GE.1) PRINT *,'FMFGET. using temporary file ',
- + SHUNAM(1:LUNAM)
-*
-* Issue SFGET to obtain full shift pathname
-*
- IF(IDEBFA.GE.1) PRINT *,'FMFGET. shift pool = ',
- + SHPOOL(1:LPOOL),' shift user = ',SHUSER(1:LUSER),
- + ' shift file ',SHFILE(1:LFILE)
-
- SHCOMM = ' '
-
- IF(IMODE.EQ.0) THEN
- SHCOMM = 'sfget -k '
- LCOMM = 9
- ELSE
- SHCOMM = 'sfget '
- LCOMM = 6
- ENDIF
-
- IF(IOPTD.NE.0) THEN
- IF(LPOOL.GT.0) THEN
- SHCOMM(LCOMM+1:) = ' -p '//SHPOOL(1:LPOOL)//' '
- LCOMM = LCOMM + LPOOL + 5
- IF(IDEBFA.GE.1) PRINT *,'FMFGET. shift pool = '//
- + SHPOOL(1:LPOOL)
- ENDIF
- IF(LUSER.GT.0) THEN
- SHCOMM(LCOMM+1:) = ' -u '//SHUSER(1:LUSER) //' '
- LCOMM = LCOMM + LUSER + 5
- IF(IDEBFA.GE.1) PRINT *,'FMFGET. shift user = '//
- + SHUSER(1:LUSER)
- ENDIF
- ENDIF
-
- SHCOMM(LCOMM+1:) = SHFILE(1:LFILE)//' > '//SHUNAM(1:LUNAM)
- LCOMM = LCOMM + LFILE + LUNAM + 3
-
- IF(IDEBFA.GE.1) WRITE(LPRTFA,9001) SHCOMM(1:LCOMM)
- 9001 FORMAT(' FMFGET. issuing ',A)
- IRC = SYSTEMF(SHCOMM(1:LCOMM))
-
- IF(IRC.NE.0) THEN
- PRINT *,'FMFGET. return code ',IRC,' from SFGET'
- RETURN
- ENDIF
-*
-* Now check if sfget was successful...
-*
- CALL CIOPEN(LUNPTR,'r',SHUNAM(1:LUNAM),IRC)
- SHFNAM = ' '
- CALL CIGET(LUNPTR,SHFNAM,255,NREAD,IRC)
- CALL CICLOS(LUNPTR)
- LFNAM = LENOCC(SHFNAM)
- LNEWL = INDEX(SHFNAM,CHAR(10))
- IF(LNEWL.NE.0) THEN
- SHFNAM(LFNAM:) = ' '
- LFNAM = LNEWL - 1
- ENDIF
- IF(IDEBFA.GE.0) PRINT *,'FMFGET. shift file name is ',
- + SHFNAM(1:LFNAM)
-
- IF(INDEX(SHFNAM,'/shift').NE.1) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMFGET. error from ', 'sfget - ',
- + SHFNAM(1:LFNAM)
- IRC = -1
- RETURN
-*
-* Delete temporary file only if sfget worked
-*
- ELSE
- CHPATH = SHFNAM(1:LFNAM)
- CALL UNLINKF(SHUNAM(1:LUNAM))
- ENDIF
-
- IS(1) = LFNAM
-
- END
-#endif
diff --git a/src/packlib/fatmen/fmutil/fmfixf.F b/src/packlib/fatmen/fmutil/fmfixf.F
deleted file mode 100644
index e5c351f..0000000
--- a/src/packlib/fatmen/fmutil/fmfixf.F
+++ /dev/null
@@ -1,85 +0,0 @@
-*
-* $Id: fmfixf.F,v 1.1.1.1 1996/03/07 15:18:17 mclareni Exp $
-*
-* $Log: fmfixf.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:17 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMFIXF(FNAME,FULLN)
-#include "fatmen/fmpath.inc"
-#include "fatmen/fatbug.inc"
- CHARACTER*(*) FNAME,FULLN
- CHARACTER*255 CHPATH,FNAME2
- CHARACTER*255 PAFF
- PARAMETER (MAXLEV=20)
-*
-* Filename is in current directory, if full path name not specified
-*
- LFNAME = LENOCC(FNAME)
- IF(FNAME(LFNAME:LFNAME).EQ.'/') LFNAME = LFNAME - 1
- FNAME2 = FNAME(1:LFNAME)
- IF (FNAME(1:2) .NE. '//') THEN
-#if !defined(CERNLIB_CZ)
-*
-* Add CD to start of FNAME
-*
- CALL FACDIR(CHPATH,'R')
- LC = LENOCC(CHPATH)
- IF (LFNAME .EQ. 0) THEN
- FULLN=CHPATH(1:LC)
- RETURN
- ENDIF
-
- IF(FNAME2(1:1).EQ.'/') THEN
- FULLN = CHPATH(1:LC) // FNAME2(1:LFNAME)
- ELSE
- FULLN = CHPATH(1:LC) // '/' // FNAME2(1:LFNAME)
- ENDIF
-#endif
-#if defined(CERNLIB_CZ)
- FULLN = CDIR(1:LCDIR) // '/' // FNAME2(1:LFNAME)
-#endif
- ELSE
-
- FULLN = FNAME(1:LFNAME)
-
- ENDIF
-*
-* Now handle '..' characters
-*
- CHPATH = FULLN
- LPATH = LENOCC(CHPATH)
- CALL FMNWRD('/',CHPATH(3:LPATH),NWORDS)
- IF(NWORDS.GT.MAXLEV) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMFIXF. error - more than ',
- + MAXLEV,' elements found in path name'
- RETURN
- ENDIF
-
- IF(IDEBFA.GE.3) PRINT *,'FMFIXF. ',NWORDS,' words found in ',
- + CHPATH(3:LPATH)
-
- FULLN = '/'
- LF = 1
-
- DO 10 I=1,MIN(MAXLEV,NWORDS)
- PAFF = ' '
- CALL FMWORD(PAFF,I-1,'/',CHPATH(3:LPATH),IC)
- LP = LENOCC(PAFF)
- IF(PAFF(1:LP).NE.'..') THEN
- FULLN(LF+1:LF+LP+1) = '/'//PAFF
- IF(IDEBFA.GE.3) PRINT *,'FMFIXF. word ',I,' = ',PAFF(1:LP)
- LF = LF + LP + 1
- ELSE
- IF(IDEBFA.GE.3) PRINT *,'FMFIXF. word .. discarded'
- LF = INDEXB(FULLN(1:LF),'/') - 1
- ENDIF
-10 CONTINUE
-
- FULLN(LF+1:) = ' '
-
- CALL CLTOU(FULLN(1:LF))
-
- END
diff --git a/src/packlib/fatmen/fmutil/fmflun.F b/src/packlib/fatmen/fmutil/fmflun.F
deleted file mode 100644
index c9cbfb3..0000000
--- a/src/packlib/fatmen/fmutil/fmflun.F
+++ /dev/null
@@ -1,30 +0,0 @@
-*
-* $Id: fmflun.F,v 1.1.1.1 1996/03/07 15:18:17 mclareni Exp $
-*
-* $Log: fmflun.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:17 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMFLUN(LUN,IRC)
-*CMZ : 04/02/91 12.20.37 by Jamie Shiers
-*-- Author : Jamie Shiers 04/02/91
-#include "fatmen/fatpara.inc"
-#include "fatmen/fatbank.inc"
-#include "fatmen/fatlun.inc"
- IRC = 0
- DO 10 I=1,KMXLUN
- IF(MFMLUN(I).EQ.LUN) THEN
- MFMLUA(I) = -1
- GOTO 20
- ENDIF
-10 CONTINUE
- IRC = -1
-20 CONTINUE
-#if defined(CERNLIB_VAXVMS)
- IF(IRC.NE.0) THEN
- CALL LIB$FREE_LUN(LUN)
- ENDIF
-#endif
- END
diff --git a/src/packlib/fatmen/fmutil/fmfnm.F b/src/packlib/fatmen/fmutil/fmfnm.F
deleted file mode 100644
index 7a3bfa9..0000000
--- a/src/packlib/fatmen/fmutil/fmfnm.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: fmfnm.F,v 1.1.1.1 1996/03/07 15:18:16 mclareni Exp $
-*
-* $Log: fmfnm.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:16 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMFNM(HFNM)
- CHARACTER*(*) HFNM
- CHARACTER*8 FTYPE,CHUSER
- INTEGER FMJOB,FMUSER
-
- ICODE=FMUSER(CHUSER)
- CALL DATIME(ID,IT)
- CALL FMPKTM(ID,IT,IP,IRC)
- WRITE(FTYPE,9001) IP
-9001 FORMAT(Z8)
- LUSER = LENOCC(CHUSER)
- IF(LUSER.EQ.0) THEN
- CHUSER = 'UNKNOWN'
- LUSER = 7
- ENDIF
- HFNM = CHUSER(1:LUSER) // '.' // FTYPE
- END
diff --git a/src/packlib/fatmen/fmutil/fmfnme.F b/src/packlib/fatmen/fmutil/fmfnme.F
deleted file mode 100644
index f720bf1..0000000
--- a/src/packlib/fatmen/fmutil/fmfnme.F
+++ /dev/null
@@ -1,51 +0,0 @@
-*
-* $Id: fmfnme.F,v 1.1.1.1 1996/03/07 15:18:17 mclareni Exp $
-*
-* $Log: fmfnme.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:17 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMFNME(FNAME)
-*CMZ : 18/02/91 09.51.42 by Jamie Shiers
-*-- Author : Jamie Shiers 18/02/91
-*
-* Generate extended unique file name
-*
- COMMON/SLATE/IS(6),IDUMM(34)
- CHARACTER*(*) FNAME
- CHARACTER*8 CHUSER,CHHOST,CHTYPE,CHSYS,CHRAND
- CHARACTER*12 CHDATE
- CHARACTER*6 CHENT
- INTEGER FMHOST,FMUSER
- SAVE NENTRY,CHUSER,CHHOST,LCHU,LCHH
- DATA NENTRY/0/
-
- IF(NENTRY.EQ.0) THEN
- IC = FMUSER(CHUSER)
- IC = FMHOST(CHHOST,CHTYPE,CHSYS)
- LCHU = LENOCC(CHUSER)
- LCHH = LENOCC(CHHOST)
- ENDIF
-
- NENTRY = NENTRY + 1
- CALL DATIME(ID,IT)
-#if !defined(CERNLIB_IBMMVS)
- WRITE(CHENT ,'(I6.6)') NENTRY
- CALL FMRAND(CHRAND,IRC)
-* WRITE(CHRAND,'(I8.8)') MOD(IRNDM(IDUMMY),100000000)
- WRITE(CHDATE,'(I6.6,I4.4,I2.2)') ID,IT,IS(6)
- FNAME = CHUSER(1:LCHU) // '_' // CHHOST(1:LCHH) // '.' //
- + CHDATE // CHENT // CHRAND
-#endif
-#if defined(CERNLIB_IBMMVS)
- WRITE(CHRAND,'(A1,I5.5,I2.2)') 'R',MOD(IRNDM(IDUMMY),100000),
- +IS(6)
- FNAME = CHUSER(1:LCHU) // '.' // CHHOST(1:LCHH) // '.' //
- + CHRAND
-#endif
-
- END
-
-
diff --git a/src/packlib/fatmen/fmutil/fmglun.F b/src/packlib/fatmen/fmutil/fmglun.F
deleted file mode 100644
index ed767bd..0000000
--- a/src/packlib/fatmen/fmutil/fmglun.F
+++ /dev/null
@@ -1,38 +0,0 @@
-*
-* $Id: fmglun.F,v 1.1.1.1 1996/03/07 15:18:17 mclareni Exp $
-*
-* $Log: fmglun.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:17 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMGLUN(LUN,IRC)
-*CMZ : 04/02/91 12.20.37 by Jamie Shiers
-*-- Author : Jamie Shiers 04/02/91
-#include "fatmen/fatpara.inc"
-#include "fatmen/fatbank.inc"
-#include "fatmen/fatlun.inc"
- LUN = 0
- IRC = 0
- DO 10 I=1,KMXLUN
- IF((MFMLUN(I).NE.-1).AND.(MFMLUA(I).EQ.-1)) THEN
- MFMLUA(I) = MFMLUN(I)
- LUN = MFMLUN(I)
- GOTO 20
- ENDIF
- 10 CONTINUE
- IRC = -1
- 20 CONTINUE
-#if defined(CERNLIB_VAXVMS)
- IF(LUN.EQ.0) THEN
- ISTAT = LIB$GET_LUN(LUN)
-#include "fatmen/fatvaxrc.inc"
- IF(LUN.EQ.-1) THEN
- IRC = LUN
- ELSE
- IRC = 0
- ENDIF
- ENDIF
-#endif
- END
diff --git a/src/packlib/fatmen/fmutil/fmhost.F b/src/packlib/fatmen/fmutil/fmhost.F
deleted file mode 100644
index 120c5b5..0000000
--- a/src/packlib/fatmen/fmutil/fmhost.F
+++ /dev/null
@@ -1,136 +0,0 @@
-*
-* $Id: fmhost.F,v 1.1.1.1 1996/03/07 15:18:16 mclareni Exp $
-*
-* $Log: fmhost.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:16 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
-#if !defined(CERNLIB_IBMMVS)
- INTEGER FUNCTION FMHOST(HNAME,HTYPE,HSYS)
-#if defined(CERNLIB_VAXVMS)
- INTEGER SYS$GETSYIW
-#endif
-#if defined(CERNLIB_VAXVMS)||defined(CERNLIB_UNIX)
- CHARACTER*8 CHHOST
-#include "fatmen/slate.inc"
-#endif
-#if defined(CERNLIB_UNIX)
- INTEGER FMHSTC
-#endif
- CHARACTER*8 HNAME,HTYPE,HSYS
-#if defined(CERNLIB_IBMVM)
- CHARACTER*80 WRK
- CHARACTER*4 HT
-C
-C CALL CP COMMAND "QUERY USERID" AND PUT ANSWER IN THE STACK
-C
- CALL VMCMS('QUERY USERID (STACK LIFO',IND)
- IF (IND.EQ.0) GOTO 1
- FMHOST=1
- RETURN
-C
-C READ FROM STACK TO "WRK"
-C
- 1 CALL VMRTRM(WRK,LENWRK)
-
-C READ THE NAME OF THE SYSTEM
-* The format of the reply has changed in CMS 7!
-*
- LB = INDEXB(WRK(1:LENWRK),' ') + 1
- HNAME = WRK(LB:LENWRK)
-* READ (WRK,'(12X,A8)') HNAME
-C
-C READ THE NAME OF THE COMPUTER
-C
- CALL VMCMS('QUERY CPUID (STACK LIFO',IND)
- IF (IND.EQ.0) GOTO 2
- FMHOST=1
- RETURN
- 2 CALL VMRTRM(WRK,LEN)
- HTYPE=' '
- READ (WRK,'(16X,A4)') HT
- HTYPE = 'IBM' // HT
-C
-C READ THE NAME AND VERSION OF THE CMS
-C
- CALL VMCMS('QUERY CMSLEVEL (STACK LIFO',IND)
- IF (IND.EQ.0) GOTO 3
- FMHOST=1
- RETURN
- 3 CALL VMRTRM(WRK,LENWRK)
-*
-* Modified for CMS 7 - Nov 27 91
-*
- ILEVEL = INDEX(WRK(1:LENWRK),'CMS Level')
- IF(ILEVEL.EQ.0) THEN
- READ (WRK,'(6X,A7)') HSYS
- ELSE
- HSYS = 'CMS '//WRK(ILEVEL+10:INDEX(WRK,',')-1)
- ENDIF
-#endif
-#if defined(CERNLIB_VAXVMS)
-C HERE WE HAVE TO CALL VAX VMS SYSTEM SERVICE . !
- INCLUDE '($SYIDEF)'
- INCLUDE '($SSDEF)'
- CHARACTER*4 NODE_SWTYPE
- CHARACTER*31 HW_NAME
- CHARACTER*15 NODENAME
- CHARACTER*64 TEMP
- INTEGER HW_RETLEN,VER_RETLEN
-C
- STRUCTURE /GETSYI_STR/
- INTEGER*2 BUFLEN,ITMCOD /0/
- INTEGER*4 BUFADR,RETLEN /0/
- END STRUCTURE
-C
- RECORD /GETSYI_STR/ LIST (4)
-C
- LIST(1).ITMCOD=SYI$_HW_NAME
- LIST(1).BUFADR=%LOC(HW_NAME)
- LIST(1).RETLEN=%LOC(HW_RETLEN)
- LIST(1).BUFLEN=31
-C
- LIST(2).ITMCOD=SYI$_NODE_SWTYPE
- LIST(2).BUFADR=%LOC(NODE_SWTYPE)
- LIST(2).RETLEN=%LOC(NODE_RETLEN)
- LIST(2).BUFLEN=4
-C
- LIST(3).ITMCOD=SYI$_VERSION
- LIST(3).BUFADR=%LOC(HSYS)
- LIST(3).RETLEN=%LOC(VER_RETLEN)
- LIST(3).BUFLEN=8
-C
- LIST(4).ITMCOD=SYI$_NODENAME
- LIST(4).BUFADR=%LOC(NODENAME)
- LIST(4).RETLEN=%LOC(LHOST)
- LIST(4).BUFLEN=15
-C
-C PERFORM SYSTEM CALL
-C
- ISTAT=SYS$GETSYIW(,,,LIST,,,)
- IF (ISTAT.NE.SS$_NORMAL) FMHOST=1
-C
- TEMP = NODE_SWTYPE // HSYS
- LSYS = MIN(8,LENOCC(TEMP))
- HSYS = TEMP(1:LSYS)
- LTYPE = MIN(8,LENOCC(HW_NAME))
- HTYPE = HW_NAME(1:LTYPE)
- LNAME = MIN(8,LHOST)
- HNAME = NODENAME(1:LNAME)
-#endif
-#if defined(CERNLIB_UNIX)
- FMHOST = FMHSTC(HNAME,HTYPE,HSYS)
-#endif
-#if defined(CERNLIB_VAXVMS)||defined(CERNLIB_UNIX)
-*
-* Use value of environmental variable FMHOST if set
-*
- CALL GETENVF('FMHOST',CHHOST)
- IF(IS(1).GT.0) HNAME = CHHOST
-C
-#endif
- RETURN
- END
-#endif
diff --git a/src/packlib/fatmen/fmutil/fmitoc.F b/src/packlib/fatmen/fmutil/fmitoc.F
deleted file mode 100644
index 443be0d..0000000
--- a/src/packlib/fatmen/fmutil/fmitoc.F
+++ /dev/null
@@ -1,39 +0,0 @@
-*
-* $Id: fmitoc.F,v 1.1.1.1 1996/03/07 15:18:19 mclareni Exp $
-*
-* $Log: fmitoc.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:19 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMITOC(NUM,STR,JS)
-*
-* Convert integer NUM into character string STR with JS non-blank
-* characters. JS = 1 ... 12
-* Examples: CALL PNVI( -1,STR,JS) -> STR='-1' ; JS = 2
-* CALL PNVI(317,STR,JS) -> STR='317' ; JS = 3
-*
- CHARACTER*(*) STR
- CHARACTER*12 DIG(0:9)*1
- INTEGER ND(12)
- DATA DIG/'0','1','2','3','4','5','6','7','8','9'/
- JS=0
-*
- K=IABS(NUM)
- DO 10 I=1,12
- ND(I)=MOD(K,10)
- K =K/10
- IF(K.EQ.0) GOTO 12
- 10 CONTINUE
- I=12
- 12 STR=' '
- IF(NUM.LT.0) THEN
- JS=JS+1
- STR(JS:JS)='-'
- END IF
- DO 14 J=I,1,-1
- JS=JS+1
- 14 STR(JS:JS)=DIG(ND(J))
- RETURN
- END
diff --git a/src/packlib/fatmen/fmutil/fmjdat.F b/src/packlib/fatmen/fmutil/fmjdat.F
deleted file mode 100644
index 00d6ee5..0000000
--- a/src/packlib/fatmen/fmutil/fmjdat.F
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: fmjdat.F,v 1.1.1.1 1996/03/07 15:18:20 mclareni Exp $
-*
-* $Log: fmjdat.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:20 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- INTEGER FUNCTION FMJDAT(IYEAR,IMONTH,IDAY)
-*
-* Return Julian date
-*
- DIMENSION IDAYS(12)
- DATA IDAYS/00,31,59,90,120,151,181,212,243,273,304,334/
-
- JYEAR = MOD(IYEAR,100)
- FMJDAT = JYEAR * 10000 + IDAYS(IMONTH) + IDAY
-
- IF((JYEAR/4)*4.EQ.JYEAR.AND.IMONTH.GT.2) FMJDAT = FMJDAT + 1
-
- END
diff --git a/src/packlib/fatmen/fmutil/fmjob.F b/src/packlib/fatmen/fmutil/fmjob.F
deleted file mode 100644
index 67c2796..0000000
--- a/src/packlib/fatmen/fmutil/fmjob.F
+++ /dev/null
@@ -1,147 +0,0 @@
-*
-* $Id: fmjob.F,v 1.1.1.1 1996/03/07 15:18:16 mclareni Exp $
-*
-* $Log: fmjob.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:16 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
-#if !defined(CERNLIB_UNIX)
- INTEGER FUNCTION FMJOB(CHJOB)
- CHARACTER*8 CHJOB
- INTEGER FMUSER
-#if defined(CERNLIB_IBMMVS)
- DIMENSION HJOB(2)
- CALL JOBNAM(HJOB)
- CALL UHTOC(HJOB,4,CHJOB,8)
- FMJOB=0
-#endif
-#if defined(CERNLIB_IBMVM)
- CHARACTER*255 CHLINE
- FMJOB=0
- CALL JOBNAM(CHJOB)
- IF(CHJOB.EQ.'INTERACT') ICODE = FMUSER(CHJOB)
-#endif
-#if (defined(CERNLIB_IBMVM))&&(defined(CERNLIB_VMBATCH))
-*
-* Previous code does not work for VMBATCH
-*
- CALL VMCMS('IDENTIFY (STACK LIFO)',IRC)
- CALL VMRTRM(CHLINE,LLINE)
- CHJOB = CHLINE(1:INDEX(CHLINE,' ')-1)
- IF(CHJOB(1:5).EQ.'VMBAT') THEN
- CALL VMCMS('VMBATCH SERVICE $ID (STACK)',IRC)
- IF(IRC.EQ.0) THEN
- CALL VMRTRM(CHLINE,LLINE)
- CHJOB = 'JOB'//CHLINE(1:LLINE)
- ENDIF
- ENDIF
-#endif
-#if defined(CERNLIB_VAXVMS)
-C COPIED FROM SETUP
-C
- INTEGER*4 SYS$GETQUIW,LIB$MATCH_COND,STATUS
- CHARACTER*80 LINE
- CHARACTER*15 PROCNAM
- CHARACTER*20 STRING
- CHARACTER*60 FILENAME,COMM
- CHARACTER*10 FILETYPE
- CHARACTER*12 USERNAME
-
- INCLUDE '($JPIDEF)'
- INCLUDE '($QUIDEF)'
- INCLUDE '($LNMDEF)'
- INCLUDE '($SSDEF)'
-C
- INTEGER*4 LIB$GETJPI
-C
- STRUCTURE /ITMLST/
- UNION
- MAP
- INTEGER*2 BUFLEN,ITMCOD
- INTEGER*4 BUFADR,RETADR
- END MAP
- MAP
- INTEGER*4 END_LIST
- END MAP
- END UNION
- END STRUCTURE
-C
- STRUCTURE /IOSBLK/
- INTEGER*4 STS,ZEROED
- END STRUCTURE
-C
- STRUCTURE /LNMLST/
- UNION
- MAP
- INTEGER*2 BUFFER_LENGTH
- INTEGER*2 ITEM_CODE
- INTEGER*4 BUFFER_ADDRESS
- INTEGER*4 RETURN_LENGTH_ADDRESS
- ENDMAP
- MAP
- INTEGER*4 END_LIST /0/
- ENDMAP
- END UNION
- END STRUCTURE
-C
- RECORD /LNMLST/ LNM_LIST(2)
- RECORD /ITMLST/ GETQUI_LIST(4)
- RECORD /IOSBLK/ IOSB
-C
- CHARACTER*31 QUEUE_NAME
- CHARACTER*39 JOB_NAME
- INTEGER*2 QUEUE_NAME_LEN,JOB_NAME_LEN
- INTEGER*4 SEARCH_FLAGS,ENTRY_NUMBER
-*
-* GET PROCESS NAME PROCESS ID AND USERNAME.
-*
- IC = LIB$GETJPI(JPI$_PRCNAM,,,,PROCNAM,%REF(LEN))
- IC = LIB$GETJPI(JPI$_PID,,,IPID,,%REF(LEN))
- IC = LIB$GETJPI(JPI$_USERNAME,,,,USERNAME,%REF(LEN))
-*
-* GET MODE (UNKNOWN, NETWORK, BATCH OR INTERACTIVE)
-*
- IC = LIB$GETJPI(JPI$_MODE,,,MODE,,%REF(LEN))
- IF (MODE .NE. 2) THEN
-*
-* RETURN PROCESS NAME IF NOT IN BATCH
-*
- FMJOB=FMUSER(CHJOB)
- RETURN
- ENDIF
-*
- GETQUI_LIST(1).BUFLEN = 4
- GETQUI_LIST(1).ITMCOD = QUI$_SEARCH_FLAGS
- GETQUI_LIST(1).BUFADR = %LOC(SEARCH_FLAGS)
- GETQUI_LIST(1).RETADR = 0
- GETQUI_LIST(2).BUFLEN = 31
- GETQUI_LIST(2).ITMCOD = QUI$_QUEUE_NAME
- GETQUI_LIST(2).BUFADR = %LOC(QUEUE_NAME)
- GETQUI_LIST(2).RETADR = %LOC(QUEUE_NAME_LEN)
- GETQUI_LIST(3).BUFLEN = 39
- GETQUI_LIST(3).ITMCOD = QUI$_JOB_NAME
- GETQUI_LIST(3).BUFADR = %LOC(JOB_NAME)
- GETQUI_LIST(3).RETADR = %LOC(JOB_NAME_LEN)
- GETQUI_LIST(4).END_LIST = 0
-C
- SEARCH_FLAGS = QUI$M_SEARCH_THIS_JOB
-C
- FMJOB = SYS$GETQUIW(,%VAL(QUI$_DISPLAY_JOB),,GETQUI_LIST,IOSB,,)
- IF (.NOT. FMJOB) THEN
- CALL LIB$SIGNAL(%VAL(FMJOB))
- FMJOB = 1
- ELSE
- FMJOB = 0
- ENDIF
-*
-* TRUNCATE AT 8 CHARACTERS
-*
- LJOB = MIN(LENOCC(JOB_NAME),8)
- CHJOB=JOB_NAME(1:LJOB)
-C
-#endif
- RETURN
- END
-#endif
diff --git a/src/packlib/fatmen/fmutil/fmjour.F b/src/packlib/fatmen/fmutil/fmjour.F
deleted file mode 100644
index b5069aa..0000000
--- a/src/packlib/fatmen/fmutil/fmjour.F
+++ /dev/null
@@ -1,51 +0,0 @@
-*
-* $Id: fmjour.F,v 1.1.1.1 1996/03/07 15:18:19 mclareni Exp $
-*
-* $Log: fmjour.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:19 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMJOUR(FNAME)
-*CMZ : 18/02/91 09.51.42 by Jamie Shiers
-*-- Author : Jamie Shiers 18/02/91
-*
-* Generate unique name for journal file
-*
-#include "fatmen/slate.inc"
- CHARACTER*(*) FNAME
- CHARACTER*8 CHUSER,CHHOST,CHTYPE,CHSYS,CHRAND
- CHARACTER*12 CHDATE
- CHARACTER*6 CHENT
- INTEGER FMHOST,FMUSER
- SAVE NENTRY,CHUSER,CHHOST,LCHU,LCHH
- DATA NENTRY/0/
-
- IF(NENTRY.EQ.0) THEN
- IC = FMUSER(CHUSER)
- IC = FMHOST(CHHOST,CHTYPE,CHSYS)
- LCHU = LENOCC(CHUSER)
- LCHH = LENOCC(CHHOST)
- ENDIF
-
- NENTRY = NENTRY + 1
- CALL DATIME(ID,IT)
-#if !defined(CERNLIB_IBMMVS)
- WRITE(CHENT ,'(I6.6)') NENTRY
- CALL FMRAND(CHRAND,IRC)
-* WRITE(CHRAND,'(I8.8)') MOD(IRNDM(IDUMMY),100000000)
- WRITE(CHDATE,'(I6.6,I4.4,I2.2)') ID,IT,IS(6)
- FNAME = 'ZZ' // CHDATE // CHENT // CHRAND // '.' //
- + CHUSER(1:LCHU) // '_' // CHHOST(1:LCHH)
-#endif
-#if defined(CERNLIB_IBMMVS)
- WRITE(CHRAND,'(A1,I5.5,I2.2)') 'R',MOD(IRNDM(IDUMMY),100000),
- +IS(6)
- FNAME = CHUSER(1:LCHU) // '.' // CHHOST(1:LCHH) // '.' //
- + CHRAND
-#endif
-
- END
-
-
diff --git a/src/packlib/fatmen/fmutil/fml2dd.F b/src/packlib/fatmen/fmutil/fml2dd.F
deleted file mode 100644
index 3df8d09..0000000
--- a/src/packlib/fatmen/fmutil/fml2dd.F
+++ /dev/null
@@ -1,40 +0,0 @@
-*
-* $Id: fml2dd.F,v 1.1.1.1 1996/03/07 15:18:16 mclareni Exp $
-*
-* $Log: fml2dd.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:16 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FML2DD(LUN,DDNAME,IRC)
-*
-* Convert a FORTRAN logical unit to the corresponding DDNAME
-*
- CHARACTER*8 DDNAME
-
- IRC = 0
-#if defined(CERNLIB_IBMVM)
- DDNAME = 'FT00F001'
- WRITE(DDNAME(3:4),9001) LUN
-9001 FORMAT(I2)
-#endif
-#if defined(CERNLIB_VAXVMS)
- DDNAME = 'FOR00N'
- WRITE(DDNAME(4:6),9002) LUN
-9002 FORMAT(I3)
-#endif
-#if defined(CERNLIB_UNIX)
- DDNAME = 'fort. '
- IF(LUN.LT.10) THEN
- WRITE(DDNAME(6:6),'(I1)') LUN
- ELSE
- WRITE(DDNAME(6:7),'(I2)') LUN
- ENDIF
-#endif
-*
-* Now replace blanks by zeroes
-*
- CALL CTRANS(' ','0',DDNAME,1,LENOCC(DDNAME))
- END
-
diff --git a/src/packlib/fatmen/fmutil/fmlcod.F b/src/packlib/fatmen/fmutil/fmlcod.F
deleted file mode 100644
index 0af5642..0000000
--- a/src/packlib/fatmen/fmutil/fmlcod.F
+++ /dev/null
@@ -1,116 +0,0 @@
-*
-* $Id: fmlcod.F,v 1.1.1.1 1996/03/07 15:18:20 mclareni Exp $
-*
-* $Log: fmlcod.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:20 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMLCOD(LUNLOC,CHFILE,CHOPT,IRC)
-*
-* Look for file CHFILE and read list
-* of location codes and definitions
-*
- CHARACTER*(*) CHFILE
- CHARACTER*255 CHNAME,CHLINE
- LOGICAL IEXIST
-#include "fatmen/fatlcc.inc"
-#include "fatmen/fatsys.inc"
-#include "fatmen/fatbug.inc"
-#include "fatmen/slate.inc"
-
- IRC = 0
- NKLCFA = 0
-
- LFILE = LENOCC(CHFILE)
-#if defined(CERNLIB_IBM)
- CHNAME = '/'//CHFILE(1:LFILE)
- LNAME = LFILE + 1
-#endif
-#if !defined(CERNLIB_IBM)
- CHNAME = CHFILE(1:LFILE)
- LNAME = LFILE
-#endif
-*
-* Does file exist?
-*
- INQUIRE(FILE=CHNAME(1:LNAME),EXIST=IEXIST)
-
- IF(.NOT.IEXIST) THEN
- IF(IDEBFA.GE.2) PRINT 9001,CHNAME(1:LNAME)
-9001 FORMAT(' FMLCOD. location codes file does not exist (',A,')')
- GOTO 30
- ENDIF
-*
-* Open and read the file
-*
-#if defined(CERNLIB_IBMVM)
- OPEN(LUNLOC,FILE=CHFILE(1:LFILE),ACTION='READ', ACCESS= 'SEQUENTI'
- +//'AL',FORM='UNFORMATTED', STATUS='OLD',IOSTAT=IRC)
-#endif
-#if defined(CERNLIB_IBMMVS)
- CALL KUOPEN(LUNLOC,CHFILE(1:LFILE),'OLD',IRC)
-#endif
-#if defined(CERNLIB_VAXVMS)
- OPEN(LUNLOC,FILE=CHFILE(1:LFILE),READONLY,ACCESS='SEQUENTIAL',
- +STATUS='OLD',FORM='FORMATTED',IOSTAT=IRC)
-#endif
-#if defined(CERNLIB_UNIX)
- OPEN(LUNLOC,FILE=CHFILE(1:LFILE),ACCESS='SEQUENTIAL',
- +STATUS='OLD',FORM='FORMATTED',IOSTAT=IRC)
-#endif
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMLCOD. error ',IRC,' opening ',
- + CHFILE(1:LFILE)
- GOTO 30
- ENDIF
-
- 10 CONTINUE
-#if defined(CERNLIB_IBMVM)
- READ(LUNLOC,NUM=LLINE,END=20) CHLINE
-#endif
-#if !defined(CERNLIB_IBMVM)
- READ(LUNLOC,'(A)',END=20) CHLINE
- LLINE = LENOCC(CHLINE)
-#endif
-
- IF(LLINE.EQ.0) GOTO 10
- IF(IDEBFA.GE.3) PRINT *,'FMLCOD. read ',CHLINE(1:LLINE)
-*
-* Comments...
-*
- IF(CHLINE(1:1).EQ.'!') GOTO 10
- IF(CHLINE(1:1).EQ.'*') GOTO 10
- IF(CHLINE(1:1).EQ.'#') GOTO 10
-* G.Folger "/*" is bad for cpp, so split it...
- IF(CHLINE(1:1).EQ.'/' .AND. CHLINE(2:2).EQ.'*' ) GOTO 10
-*
-* Invalid lines
-*
- IEQULS = INDEX(CHLINE(1:LLINE),'=')
- IF(IEQULS.EQ.0) GOTO 10
-
- JX = ICNUM(CHLINE,1,IEQULS-1)
- IF(JX.NE.IEQULS) GOTO 10
-*
-* The bizzo
-*
- NKLCFA = NKLCFA + 1
- NLCCFA(NKLCFA) = ICDECI(CHLINE,1,IEQULS-1)
- CHLOCF(NKLCFA) = CHLINE(IEQULS+1:LLINE)
-
- IF(IDEBFA.GE.1) PRINT 9003,NLCCFA(NKLCFA),CHLINE(IEQULS+1:LLINE)
-9003 FORMAT(' FMLCOD. code ',I8.8,' = ',A)
-
- IF(NKLCFA.LT.MXLCFA) GO TO 10
-
- 20 CONTINUE
-
- CLOSE(LUNLOC)
-
- RETURN
-
- 30 CONTINUE
- IRC = 1
- END
diff --git a/src/packlib/fatmen/fmutil/fmlocc.F b/src/packlib/fatmen/fmutil/fmlocc.F
deleted file mode 100644
index 1b2797c..0000000
--- a/src/packlib/fatmen/fmutil/fmlocc.F
+++ /dev/null
@@ -1,204 +0,0 @@
-*
-* $Id: fmlocc.F,v 1.1.1.1 1996/03/07 15:18:19 mclareni Exp $
-*
-* $Log: fmlocc.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:19 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMLOCC(IRC)
-*
-* Look for FATMEN.LOCATION file and read list
-* of location codes and definitions
-*
-* Following example is for OPAL:
-*
-* 0=Cern Vault CERNVM VXCERN CRAY SHIFT etc
-* 1=Cern Vault
-* 2=Cern Vault
-* 11=VXOPON OPAL Online Vax cluster
-* 12=Online OPAL (apollo) online facilities
-* 21=VXOPOF OPAL Offline cluster
-* 31=SHIFT SHIFT disk and archive storage
-* 33101=Saclay Active cartridges
-* 33901=Saclay 'obsolete' cartridges
-* 44501=UKACRL Active cartridges
-* 44901=UKACRL 'obsolete' cartridges
-*
- CHARACTER*255 CHFILE,CHLINE
- LOGICAL IEXIST
-#include "fatmen/fatlcc.inc"
-#include "fatmen/fatsys.inc"
-#include "fatmen/fatbug.inc"
-#include "fatmen/slate.inc"
-
- IRC = 0
- NKLCFA = 0
- LDEF = LENOCC(DEFAULT)
-
-#if defined(CERNLIB_CSPACK)
- IF(FATNOD.NE.' ') THEN
-*
-* Open remote file. Here we are assuming that the remote
-* server is a Unix system
-*
- CHFILE = DEFAULT(1:LDEF)//'/FATMEN.LOCCODES'
- LFILE = LENOCC(CHFILE)
- CALL CUTOL(CHFILE(1:LFILE))
-*
-* Does file exist?
-*
- CALL XZINQR(LUFZFA,CHFILE(1:LFILE),FATNOD,ICODE,LRECL,IRC)
- IF(ICODE.NE.0) THEN
- IF(IDEBFA.GE.2) PRINT *,'FMLOCC. FATMEN.LOCCODES file ',
- + 'does not exist (',CHFILE(1:LFILE),')'
- GOTO 30
- ENDIF
- LRECL = 80
- CALL XZOPEN(LUFZFA,CHFILE(1:LFILE),FATNOD,LRECL,'F',IRC)
-
- ELSE
-
-#endif
-#if defined(CERNLIB_UNIX)
- CHFILE = DEFAULT(1:LDEF)//'/FATMEN.LOCCODES'
- CALL CUTOL(CHFILE)
-#endif
-#if defined(CERNLIB_VAXVMS)
- CHFILE = DEFAULT(1:LDEF)//'FATMEN.LOCCODES'
-#endif
-#if defined(CERNLIB_IBMVM)
- CHFILE = '/FATMEN LOCCODES '//SERMOD
-#endif
-#if defined(CERNLIB_IBMMVS)
- CHFILE = '/'//DEFAULT(1:LDEF)//'FATMEN.LOCCODES'
-#endif
- LFILE = LENOCC(CHFILE)
-*
-* Does file exist?
-*
- INQUIRE(FILE=CHFILE(1:LFILE),EXIST=IEXIST)
-
- IF(.NOT.IEXIST) THEN
- IF(IDEBFA.GE.2) PRINT *,'FMLOCC. FATMEN.LOCCODES file ',
- + 'does not exist (',CHFILE(1:LFILE),')'
- GOTO 30
- ENDIF
-*
-* Open and read the file
-*
-#if defined(CERNLIB_IBMVM)
- OPEN(LUFZFA,FILE=CHFILE(1:LFILE),ACTION='READ', ACCESS=
- + 'SEQUENTIAL',FORM='UNFORMATTED', STATUS='OLD',IOSTAT=IRC)
-#endif
-#if defined(CERNLIB_IBMMVS)
- CALL KUOPEN(LUFZFA,CHFILE(1:LFILE),'OLD',IRC)
-#endif
-#if defined(CERNLIB_VAXVMS)
- ISTAT = LIB$GET_LUN(LUNACC)
- IF(.NOT.ISTAT) THEN
- IRC = 42
- IF(IDEBFA.GE.-3) PRINT *,'FMLOCC. could not assign logical '
- + , 'unit to read location codes file'
- GOTO 30
- ENDIF
-
- OPEN(LUNACC,FILE=CHFILE(1:LFILE),READONLY,ACCESS='SEQUENTIAL',
- + STATUS='OLD',FORM='FORMATTED',IOSTAT=IRC)
-
-#endif
-#if defined(CERNLIB_UNIX)
- CALL CIOPEN(LUNACC,'r',CHFILE(1:LFILE),IRC)
-#endif
-#if defined(CERNLIB_CSPACK)
- ENDIF
-#endif
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMLOCC. error ',IRC,' opening ',
- + CHFILE(1:LFILE)
- GOTO 30
- ENDIF
-
- 10 CONTINUE
-#if defined(CERNLIB_CSPACK)
- IF(FATNOD.NE.' ') THEN
- CALL XZGETL(LUFZFA,CHLINE,'(A)',' ',IRC)
- IF(IRC.NE.0) GOTO 20
- LLINE = LENOCC(CHLINE)
- ELSE
-#endif
-#if defined(CERNLIB_IBMVM)
- READ(LUFZFA,NUM=LLINE,END=20) CHLINE
-#endif
-#if defined(CERNLIB_IBMMVS)
- READ(LUFZFA,'(A)',END=20) CHLINE
- LLINE = LENOCC(CHLINE)
-#endif
-#if defined(CERNLIB_VAXVMS)
- READ(LUNACC,'(A)',END=20) CHLINE
- LLINE = LENOCC(CHLINE)
-#endif
-#if defined(CERNLIB_UNIX)
- CALL FMCFGL(LUNACC,CHLINE,LLINE,' ',ISTAT)
- IF(ISTAT.NE.0) GOTO 20
-#endif
-#if defined(CERNLIB_CSPACK)
- ENDIF
-#endif
-
- IF(LLINE.EQ.0) GOTO 10
- IF(IDEBFA.GE.3) PRINT *,'FMLOCC. read ',CHLINE(1:LLINE)
-*
-* Comments...
-*
- IF(CHLINE(1:1).EQ.'!') GOTO 10
- IF(CHLINE(1:1).EQ.'*') GOTO 10
- IF(CHLINE(1:1).EQ.'#') GOTO 10
-* G.Folger "/*" is bad for cpp, so split it...
- IF(CHLINE(1:1).EQ.'/' .AND. CHLINE(2:2).EQ.'*' ) GOTO 10
-*
-* Invalid lines
-*
- IEQULS = INDEX(CHLINE(1:LLINE),'=')
- IF(IEQULS.EQ.0) GOTO 10
-
- JX = ICNUM(CHLINE,1,IEQULS-1)
- IF(JX.NE.IEQULS) GOTO 10
-*
-* The bizzo
-*
- NKLCFA = NKLCFA + 1
- NLCCFA(NKLCFA) = ICDECI(CHLINE,1,IEQULS-1)
- CHLOCF(NKLCFA) = CHLINE(IEQULS+1:LLINE)
-
- IF(NKLCFA.LT.MXLCFA) GO TO 10
-
- 20 CONTINUE
-
-#if defined(CERNLIB_CSPACK)
- IF(FATNOD.NE.' ') THEN
- CALL XZCLOS(LUFZFA,' ',ISTAT)
- ELSE
-#endif
-#if defined(CERNLIB_IBM)
- CLOSE(LUFZFA)
-#endif
-#if defined(CERNLIB_VAXVMS)
- CLOSE(LUNACC)
- CALL LIB$FREE_LUN(LUNACC)
-#endif
-#if defined(CERNLIB_UNIX)
- CALL FMCFGL(LUNACC,CHLINE,LLINE,'F',ISTAT)
- CALL CICLOS(LUNACC)
-#endif
-#if defined(CERNLIB_CSPACK)
- ENDIF
-#endif
-
- RETURN
-
- 30 CONTINUE
- IRC = 1
- END
-
diff --git a/src/packlib/fatmen/fmutil/fmloco.F b/src/packlib/fatmen/fmutil/fmloco.F
deleted file mode 100644
index e8230ca..0000000
--- a/src/packlib/fatmen/fmutil/fmloco.F
+++ /dev/null
@@ -1,13 +0,0 @@
-*
-* $Id: fmloco.F,v 1.1.1.1 1996/03/07 15:18:16 mclareni Exp $
-*
-* $Log: fmloco.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:16 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- INTEGER FUNCTION FMLOCO(LCODE)
- FMLOCO = 1
- END
-
diff --git a/src/packlib/fatmen/fmutil/fmlton.F b/src/packlib/fatmen/fmutil/fmlton.F
deleted file mode 100644
index 7627167..0000000
--- a/src/packlib/fatmen/fmutil/fmlton.F
+++ /dev/null
@@ -1,196 +0,0 @@
-*
-* $Id: fmlton.F,v 1.1.1.1 1996/03/07 15:18:20 mclareni Exp $
-*
-* $Log: fmlton.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:20 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMLTON(LOCCOD,MAXNOD,CHNODE,NNODES,CHOPT,IRC)
-*
-* Return all node names that match LOCCOD
-*
- CHARACTER*(*) CHNODE(MAXNOD)
- CHARACTER*255 CHFILE,CHLINE,PATH
- CHARACTER*20 NODE
- LOGICAL IEXIST
-
-#include "fatmen/fatsys.inc"
-#include "fatmen/fatbug.inc"
-#include "fatmen/slate.inc"
-#include "fatmen/fatopts.inc"
-
- IRC = 0
- NNODES = 0
- LDEF = LENOCC(DEFAULT)
-
- IF(IDEBFA.GE.3) PRINT 9001,LOCCOD,MAXNOD,CHOPT
- 9001 FORMAT(' FMLTON. enter for ',I10,1X,I10,1X,A)
-
-
-#if defined(CERNLIB_CSPACK)
- IF(FATNOD.NE.' ') THEN
-*
-* Open remote file. Here we are assuming that the remote
-* server is a Unix system
-*
- CHFILE = DEFAULT(1:LDEF)//'/FATMEN.LOCATIONS'
- LFILE = LENOCC(CHFILE)
- CALL CUTOL(CHFILE(1:LFILE))
-*
-* Does file exist?
-*
- CALL XZINQR(LUFZFA,CHFILE(1:LFILE),FATNOD,ICODE,LRECL,IRC)
- IF(ICODE.NE.0) THEN
- IF(IDEBFA.GE.2) PRINT 9002,CHFILE(1:LFILE)
- IRC = 1
- GOTO 40
- ENDIF
- LRECL = 80
- CALL XZOPEN(LUFZFA,CHFILE(1:LFILE),FATNOD,LRECL,'F',IRC)
-
- ELSE
-#endif
-#if defined(CERNLIB_UNIX)
- CHFILE = DEFAULT(1:LDEF)//'/FATMEN.LOCATIONS'
- CALL CUTOL(CHFILE)
-#endif
-#if defined(CERNLIB_VAXVMS)
- CHFILE = DEFAULT(1:LDEF)//'FATMEN.LOCATIONS'
-#endif
-#if defined(CERNLIB_IBMVM)
- CHFILE = '/FATMEN LOCATION '//SERMOD
-#endif
-#if defined(CERNLIB_IBMMVS)
- CHFILE = '/'//DEFAULT(1:LDEF)//'FATMEN.LOCATIONS'
-#endif
- LFILE = LENOCC(CHFILE)
-*
-* Does file exist?
-*
- INQUIRE(FILE=CHFILE(1:LFILE),EXIST=IEXIST)
-
- IF(.NOT.IEXIST) THEN
- IF(IDEBFA.GE.2) PRINT 9002,CHFILE(1:LFILE)
- 9002 FORMAT(' FMLTON. FATMEN locations file does not exist (',A,')')
- IRC = 1
- GOTO 40
- ENDIF
-*
-* Open and read the file
-*
-#if defined(CERNLIB_IBMVM)
- OPEN(LUFZFA,FILE=CHFILE(1:LFILE),ACTION='READ', ACCESS=
- + 'SEQUENTIAL',FORM='UNFORMATTED', STATUS='OLD',IOSTAT=IRC)
-#endif
-#if defined(CERNLIB_IBMMVS)
- CALL KUOPEN(LUFZFA,CHFILE(1:LFILE),'OLD',IRC)
-#endif
-#if defined(CERNLIB_VAXVMS)
- ISTAT = LIB$GET_LUN(LUNLOC)
- IF(.NOT.ISTAT) THEN
- IRC = 42
- IF(IDEBFA.GE.-3) PRINT *,'FMLTON. could not assign logical '
- + , 'unit to read locations file'
- GOTO 40
- ENDIF
-
- OPEN(LUNLOC,FILE=CHFILE(1:LFILE),READONLY,ACCESS='SEQUENTIAL',
- + STATUS='OLD',FORM='FORMATTED',IOSTAT=IRC)
-
-#endif
-#if defined(CERNLIB_UNIX)
- CALL CIOPEN(LUNLOC,'r',CHFILE(1:LFILE),IRC)
-#endif
-#if defined(CERNLIB_CSPACK)
- ENDIF
-#endif
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.-3) PRINT 9003,IRC,CHFILE(1:LFILE)
- 9003 FORMAT(' FMLTON. error ',I10,' opening ',A)
- IRC = 2
- GOTO 40
- ENDIF
-
- 10 CONTINUE
-#if defined(CERNLIB_CSPACK)
- IF(FATNOD.NE.' ') THEN
- CALL XZGETL(LUFZFA,CHLINE,'(A)',' ',ISTAT)
- IF(ISTAT.NE.0) GOTO 20
- LLINE = LENOCC(CHLINE)
- ELSE
-#endif
-#if defined(CERNLIB_IBMVM)
- READ(LUFZFA,NUM=LLINE,END=20) CHLINE
-#endif
-#if defined(CERNLIB_IBMMVS)
- READ(LUFZFA,'(A)',END=20) CHLINE
- LLINE = LENOCC(CHLINE)
-#endif
-#if defined(CERNLIB_VAXVMS)
- READ(LUNLOC,'(A)',END=20) CHLINE
- LLINE = LENOCC(CHLINE)
-#endif
-#if defined(CERNLIB_UNIX)
- CALL FMCFGL(LUNLOC,CHLINE,LLINE,' ',ISTAT)
- IF(ISTAT.NE.0) GOTO 20
-#endif
-#if defined(CERNLIB_CSPACK)
- ENDIF
-#endif
-
- IF(LLINE.EQ.0) GOTO 10
-
- IF(IDEBFA.GE.3) PRINT *,'FMLTON. read ',CHLINE(1:LLINE)
-*
-* Comments...
-*
- IF(CHLINE(1:1).EQ.'!') GOTO 10
- IF(CHLINE(1:1).EQ.'*') GOTO 10
- IF(CHLINE(1:1).EQ.'#') GOTO 10
-* G.Folger "/*" is bad for cpp, so split it...
- IF(CHLINE(1:1).EQ.'/' .AND. CHLINE(2:2).EQ.'*' ) GOTO 10
-
- IF(IOPTC.EQ.0) CALL CLTOU(CHLINE(1:LLINE))
-
- IEQUAL = INDEX(CHLINE(1:LLINE),'=')
- IF(IEQUAL.EQ.0) GOTO 10
-
- JCODE = ICDECI(CHLINE,IEQUAL+1,LLINE)
- IF(LOCCOD.EQ.JCODE) THEN
- NNODES = NNODES + 1
- IF(NNODES.LE.MAXNOD) CHNODE(NNODES) = CHLINE(1:IEQUAL-1)
- ENDIF
-
- GOTO 10
-
- 20 CONTINUE
-
- IF(NNODES.EQ.0) IRC = 3
-
-#if defined(CERNLIB_CSPACK)
- IF(FATNOD.NE.' ') THEN
- CALL XZCLOS(LUFZFA,' ',ISTAT)
- ELSE
-#endif
-#if defined(CERNLIB_IBM)
- CLOSE(LUFZFA)
-#endif
-#if defined(CERNLIB_VAXVMS)
- CLOSE(LUNLOC)
- CALL LIB$FREE_LUN(LUNLOC)
-#endif
-#if defined(CERNLIB_UNIX)
- CALL FMCFGL(LUNLOC,CHLINE,LLINE,'F',ISTAT)
- CALL CICLOS(LUNLOC)
-#endif
-#if defined(CERNLIB_CSPACK)
- ENDIF
-#endif
-
- RETURN
-
- 40 CONTINUE
-
- END
diff --git a/src/packlib/fatmen/fmutil/fmmedt.F b/src/packlib/fatmen/fmutil/fmmedt.F
deleted file mode 100644
index 7b668b2..0000000
--- a/src/packlib/fatmen/fmutil/fmmedt.F
+++ /dev/null
@@ -1,324 +0,0 @@
-*
-* $Id: fmmedt.F,v 1.1.1.1 1996/03/07 15:18:21 mclareni Exp $
-*
-* $Log: fmmedt.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:21 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMMEDT(IRC)
-*
-* Look for FATMEN.MEDTYPES file and read list
-* of media types and definitions
-*
-* ==> N.B. these definitions OVERRIDE any previously set.
-*
-* ==> N.B. the order of the definitions is SIGNIFICANT
-*
-* ==> N.B. negative MEDIA-TYPE is defined but NOT SELECTED
-*
-* FATMEN.MEDTYPES consists of blank separated fields.
-* All fields must be specified for a given device type,
-* otherwise that device type is skipped.
-*
-* Although it is not assumed that the definitions are given
-* in the order of the media-type (integer), it is assumed
-* that there are no 'holes', i.e. if media type 4 is defined,
-* so must be media types 1-3.
-*
-* The fields are as follows:
-*
-* MEDIA-TYPE DEVICE-TYPE GENERIC-TYPE DENSITY CAPACITY MOUNT-TYPE LABEL-TYPE
-*
-* e.g.
-*
-* 2 3480 CT1 38K 200 M SL
-* 3 3420 TAPE 6250 150 M SL
-* 4 8200 8MM 43200 2300 M SL
-* 5 8500 8MM 86400 5000 M SL
-*
-*
- CHARACTER*255 CHFILE,CHLINE
- LOGICAL IEXIST
-#include "fatmen/fatpara.inc"
-#include "fatmen/fatmtp.inc"
-#include "fatmen/fattyp.inc"
-#include "fatmen/fatsys.inc"
-#include "fatmen/fatbug.inc"
-#include "fatmen/slate.inc"
-
- IRC = 0
-*
- LDEF = LENOCC(DEFAULT)
-
-#if defined(CERNLIB_CSPACK)
- IF(FATNOD.NE.' ') THEN
-*
-* Open remote file. Here we are assuming that the remote
-* server is a Unix system
-*
- CHFILE = DEFAULT(1:LDEF)//'/FATMEN.MEDTYPES'
- LFILE = LENOCC(CHFILE)
- CALL CUTOL(CHFILE(1:LFILE))
-*
-* Does file exist?
-*
- CALL XZINQR(LUFZFA,CHFILE(1:LFILE),FATNOD,ICODE,LRECL,IRC)
- IF(ICODE.NE.0) THEN
- IF(IDEBFA.GE.2) PRINT *,'FMMEDT. FATMEN.MEDTYPES file ',
- + 'does not exist (',CHFILE(1:LFILE),')'
- GOTO 50
- ENDIF
- LRECL = 80
- CALL XZOPEN(LUFZFA,CHFILE(1:LFILE),FATNOD,LRECL,'F',IRC)
-
- ELSE
-
-#endif
-#if defined(CERNLIB_UNIX)
- CHFILE = DEFAULT(1:LDEF)//'/FATMEN.MEDTYPES'
- CALL CUTOL(CHFILE)
-#endif
-#if defined(CERNLIB_VAXVMS)
- CHFILE = DEFAULT(1:LDEF)//'FATMEN.MEDTYPES'
-#endif
-#if defined(CERNLIB_IBMVM)
- CHFILE = '/FATMEN MEDTYPES '//SERMOD
-#endif
-#if defined(CERNLIB_IBMMVS)
- CHFILE = '/'//DEFAULT(1:LDEF)//'FATMEN.MEDTYPES'
-#endif
- LFILE = LENOCC(CHFILE)
-*
-* Does file exist?
-*
- INQUIRE(FILE=CHFILE(1:LFILE),EXIST=IEXIST)
-
- IF(.NOT.IEXIST) THEN
- IF(IDEBFA.GE.2) PRINT *,'FMMEDT. FATMEN.MEDTYPES file ',
- + 'does not exist (',CHFILE(1:LFILE),')'
- GOTO 50
- ENDIF
-*
-* Open and read the file
-*
-#if defined(CERNLIB_IBMVM)
- OPEN(LUFZFA,FILE=CHFILE(1:LFILE),ACTION='READ', ACCESS=
- + 'SEQUENTIAL',FORM='UNFORMATTED', STATUS='OLD',IOSTAT=IRC)
-#endif
-#if defined(CERNLIB_IBMMVS)
- CALL KUOPEN(LUFZFA,CHFILE(1:LFILE),'OLD',IRC)
-#endif
-#if defined(CERNLIB_VAXVMS)
- ISTAT = LIB$GET_LUN(LUNACC)
- IF(.NOT.ISTAT) THEN
- IRC = 42
- IF(IDEBFA.GE.-3) PRINT *,'FMMEDT. could not assign logical '
- + , 'unit to read location codes file'
- GOTO 50
- ENDIF
-
- OPEN(LUNACC,FILE=CHFILE(1:LFILE),READONLY,ACCESS='SEQUENTIAL',
- + STATUS='OLD',FORM='FORMATTED',IOSTAT=IRC)
-
-#endif
-#if defined(CERNLIB_UNIX)
- CALL CIOPEN(LUNACC,'r',CHFILE(1:LFILE),IRC)
-#endif
-#if defined(CERNLIB_CSPACK)
- ENDIF
-#endif
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMMEDT. error ',IRC,' opening ',
- + CHFILE(1:LFILE)
- GOTO 50
- ENDIF
-
-*
-* Save and clear number of media types
-*
- NFMOLD = NFMTYP
- NFMTYP = 0
-*
-* Save and clear media type selection vector
-*
- NUMOLD = NUMMTP
- NUMMTP = 0
-*
- 10 CONTINUE
-#if defined(CERNLIB_CSPACK)
- IF(FATNOD.NE.' ') THEN
- CALL XZGETL(LUFZFA,CHLINE,'(A)',' ',IRC)
- IF(IRC.NE.0) GOTO 30
- LLINE = LENOCC(CHLINE)
- ELSE
-#endif
-#if defined(CERNLIB_IBMVM)
- READ(LUFZFA,NUM=LLINE,END=30) CHLINE
-#endif
-#if defined(CERNLIB_IBMMVS)
- READ(LUFZFA,'(A)',END=30) CHLINE
- LLINE = LENOCC(CHLINE)
-#endif
-#if defined(CERNLIB_VAXVMS)
- READ(LUNACC,'(A)',END=30) CHLINE
- LLINE = LENOCC(CHLINE)
-#endif
-#if defined(CERNLIB_UNIX)
- CALL FMCFGL(LUNACC,CHLINE,LLINE,' ',ISTAT)
- IF(ISTAT.NE.0) GOTO 30
-#endif
-#if defined(CERNLIB_CSPACK)
- ENDIF
-#endif
-
- IF(LLINE.EQ.0) GOTO 10
- IF(IDEBFA.GE.3) PRINT *,'FMMEDT. read ',CHLINE(1:LLINE)
-*
-* Comments...
-*
- IF(CHLINE(1:1).EQ.'!') GOTO 10
- IF(CHLINE(1:1).EQ.'*') GOTO 10
- IF(CHLINE(1:1).EQ.'#') GOTO 10
-* G.Folger "/*" is bad for cpp, so split it...
- IF(CHLINE(1:1).EQ.'/' .AND. CHLINE(2:2).EQ.'*' ) GOTO 10
-
- NFMTYP = NFMTYP + 1
- IF(NFMTYP.GT.NMTYP) THEN
- IF(IDEBFA.GE.-3) PRINT 9001,NMTYP
- 9001 FORMAT(' FMMEDT. cannot process any more media definitions.',
- + ' Maximum number = ',I10)
- GOTO 40
- ENDIF
-
- LEND = LLINE
-*
-* Media-type
-*
- I = ICDECI(CHLINE,1,LEND)
- J = IABS(I)
- IF(J.GT.NMTYP) THEN
- IF(IDEBFA.GE.-3) PRINT 9002,J,NMTYP
- 9002 FORMAT(' FMMEDT. media type ',I10,
- + ' outside range. Maximum allowed value = ',I10)
- GOTO 20
- ENDIF
-
- IF(J.EQ.0) THEN
- IF(IDEBFA.GE.-3) PRINT 9003,J
- 9003 FORMAT(' FMMEDT. invalid media type ',I10,
- + ' ignored. Specify a nonzero integer')
- GOTO 20
- ENDIF
-
-*
-* Label-type
-*
- LSTART = INDEXB(CHLINE(1:LEND),' ')
- IF(LSTART.EQ.0) GOTO 20
-
- CHMLAB(J) = CHLINE(LSTART+1:LEND)
- LEND = LSTART - 1
-*
-* Mount-type
-*
- LSTART = INDEXB(CHLINE(1:LEND),' ')
- IF(LSTART.EQ.0) GOTO 20
-
- CHMMNT(J) = CHLINE(LSTART+1:LEND)
- LEND = LSTART - 1
-*
-* Capacity
-*
- LSTART = INDEXB(CHLINE(1:LEND),' ')
- IF(LSTART.EQ.0) GOTO 20
-
- CHMSIZ(J) = CHLINE(LSTART+1:LEND)
- MEDSIZ(J) = ICDECI(CHLINE,LSTART+1,LEND)
- LEND = LSTART - 1
-*
-* Density
-*
- LSTART = INDEXB(CHLINE(1:LEND),' ')
- IF(LSTART.EQ.0) GOTO 20
-
- CHMDEN(J) = CHLINE(LSTART+1:LEND)
- MEDDEN(J) = ICDECI(CHLINE,LSTART+1,LEND)
- IF(INDEX(CHLINE(LSTART+1:LEND),'K').NE.0) MEDDEN(J) =
- + MEDDEN(J)*1000
- LEND = LSTART - 1
-*
-* Generic-type
-*
- LSTART = INDEXB(CHLINE(1:LEND),' ')
- IF(LSTART.EQ.0) GOTO 20
-
- CHMGEN(J) = CHLINE(LSTART+1:LEND)
- LEND = LSTART - 1
-*
-* Device-type
-*
- LSTART = INDEXB(CHLINE(1:LEND),' ')
- IF(LSTART.EQ.0) GOTO 20
-
- CHMTYP(J) = CHLINE(LSTART+1:LEND)
- LEND = LSTART - 1
-
- IF(I.GT.0) THEN
-*
-* Set also selection vector
-*
- NUMMTP = NUMMTP + 1
- MFMMTP(NUMMTP) = J
- ELSE
- IF(IDEBFA.GE.1) PRINT 9005,J
- 9005 FORMAT(' FMMEDT. media type ',I10,
- + ' booked but not selected')
- ENDIF
-
- GOTO 10
-
- 20 CONTINUE
-
- IF(IDEBFA.GE.0) WRITE(LPRTFA,9004) CHLINE(1:LLINE)
- 9004 FORMAT(' FMMEDT. skipping invalid line - ',A)
- NFMTYP = NFMTYP - 1
- GOTO 10
-
- 30 CONTINUE
- IF((NFMTYP.LE.0).OR.(NUMMTP.LE.0)) THEN
- NFMTYP = NFMOLD
- NUMMTP = NUMOLD
- IRC = 1
- ENDIF
-
-#if defined(CERNLIB_CSPACK)
- IF(FATNOD.NE.' ') THEN
- CALL XZCLOS(LUFZFA,' ',ISTAT)
- ELSE
-#endif
-#if defined(CERNLIB_IBM)
- CLOSE(LUFZFA)
-#endif
-#if defined(CERNLIB_VAXVMS)
- CLOSE(LUNACC)
- CALL LIB$FREE_LUN(LUNACC)
-#endif
-#if defined(CERNLIB_UNIX)
- CALL FMCFGL(LUNACC,CHLINE,LLINE,'F',ISTAT)
- CALL CICLOS(LUNACC)
-#endif
-#if defined(CERNLIB_CSPACK)
- ENDIF
-#endif
-
- RETURN
-
- 40 CONTINUE
- IRC = 1
- GOTO 30
-
- 50 CONTINUE
- IRC = 1
- END
diff --git a/src/packlib/fatmen/fmutil/fmmss.F b/src/packlib/fatmen/fmutil/fmmss.F
deleted file mode 100644
index b667af2..0000000
--- a/src/packlib/fatmen/fmutil/fmmss.F
+++ /dev/null
@@ -1,86 +0,0 @@
-*
-* $Id: fmmss.F,v 1.1.1.1 1996/03/07 15:18:21 mclareni Exp $
-*
-* $Log: fmmss.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:21 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMMSS(GENAM,CHURL,CHOPT,IRC)
-*
-* Check if 'GENAM' with URL 'CHURL' accessible on current node
-*
- CHARACTER*(*) GENAM,CHURL
- CHARACTER*255 CHHOME
- LOGICAL IEXIST
-#include "fatmen/slate.inc"
-#include "fatmen/fatbug.inc"
-#include "fatmen/fatopts.inc"
-
- IRC = 0
-
- LGN = LENOCC(GENAM)
- LURL = LENOCC(CHURL)
-
- IURL = INDEX(CHURL(1:LURL),'://')
- IF(IURL.EQ.0) THEN
- IRC = 1
- IF(IDEBFA.GE.0) WRITE(LPRTFA,9001) GENAM(1:LGN),CHURL(1:LURL)
- 9001 FORMAT(' FMMSS. genam ',A,' has invalid URL ',A)
- GOTO 999
- ENDIF
-*
-* Lachman OSM
-*
- IF(CHURL(1:IURL-1).EQ.'OSM') THEN
- CALL GETENVF('OSMHOME',CHHOME)
- IF(IS(1).EQ.0) THEN
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9002)
- 9002 FORMAT(' FMMSS. env. variable OSMHOME not defined.',
- + ' Looking for /osm...')
- INQUIRE(FILE='/osm',EXIST=IEXIST)
- IF(IEXIST) THEN
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9003)
- 9003 FORMAT(' FMMSS. OSMHOME defaulted to /osm')
- ELSE
- IF(IDEBFA.GE.0) WRITE(LPRTFA,9004)
- 9004 FORMAT(' FMMSS. files with URL like ',A,
- + ' cannot be accessed on this node.')
- IRC = 99
- GOTO 999
- ENDIF
- ELSE
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9005) CHHOME(1:IS(1))
- 9005 FORMAT(' FMMSS. $OSMHOME = ',A)
- ENDIF
- ENDIF
-*
-* Unitree ftp access (NFS access as for local files)
-*
- IF(CHURL(1:IURL-1).EQ.'UNITREE') THEN
- WRITE(LPRTFA,9006) CHURL(1:IURL-1)
- IRC = 99
- GOTO 999
- ENDIF
-
-*
-* Adstar ADSM
-*
- IF(CHURL(1:IURL-1).EQ.'ADSM') THEN
- WRITE(LPRTFA,9006) CHURL(1:IURL-1)
- IRC = 99
- GOTO 999
- ENDIF
-
-*
-* E-MASS (NFS ok as for Unitree?)
-*
- IF(CHURL(1:IURL-1).EQ.'EMASS') THEN
- WRITE(LPRTFA,9006) CHURL(1:IURL-1)
- IRC = 99
- GOTO 999
- ENDIF
-
- 9006 FORMAT(' FMMSS. support for ',A,' not yet available')
- 999 END
diff --git a/src/packlib/fatmen/fmutil/fmnamf.F b/src/packlib/fatmen/fmutil/fmnamf.F
deleted file mode 100644
index ca386a7..0000000
--- a/src/packlib/fatmen/fmutil/fmnamf.F
+++ /dev/null
@@ -1,217 +0,0 @@
-*
-* $Id: fmnamf.F,v 1.1.1.1 1996/03/07 15:18:20 mclareni Exp $
-*
-* $Log: fmnamf.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:20 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
-#if defined(CERNLIB_CSPACK)
- SUBROUTINE FMNAMF(LUN,CHFILE,CHNODE,CHIN,NIN,CHOUT,NOUT,IRC)
- CHARACTER*(*) CHIN(2,NIN),CHOUT(2,NOUT),CHFILE,CHNODE
- CHARACTER*255 CHLINE,CHBUF(10),CHUBUF(10)
- CHARACTER*255 CHTAG ,CHVAL ,CHULIN, CHNAME
- LOGICAL IEOF
-*
-#if defined(CERNLIB_IBMMVS)
- CHARACTER*8 PREFIX
-#endif
-*
-* CERN PROGLIB# M442 NAMEFD .VERSION KERNBIT 1.08 911120
-* Author: Jamie Shiers
-*
-* ==> Copied 02/12/92 to provide CSPACK access to remote names files
-*
-* Emulation of VM/CMS NAMEFIND command. Process NAMES file
-* looking for the first entry containing the specified
-* input tags and return those requested.
-* CHIN(1,I) = tag name
-* CHIN(2,I) = tag value
-*
-* Checks on tag name and value are case insensitive, but
-* values are returned asis.
-*
-* Return codes:
-* in case of OPEN error: IOSTAT from FORTRAN OPEN
-* 32 - no match found for input tags & values
-* 4 - not all requested output tags found
-*
-* Mods Date Comments
-* 92/10/15 Version=1.06 Fix bug for single character values
-* 92/10/09 Version=1.05 Handle multiple tags/line correctly
-* 92/06/11 Version=1.04 Look for tags terminated by .
-* Version=1.03 Open files on VAX READONLY
-* Version=1.02 Open files on IBM ACTION='READ'
-* Version=1.01 Open files on VAX shared
-* Version=1.00 First release
-* ------------------------------------------------------------------
- IRC = 0
- IFOUND = 0
-
- LF = LENOCC(CHFILE)
- CHNAME = CHFILE(1:LF)
-
- CALL XZOPEN(LUN,CHNAME(1:LF),CHNODE,80,'F',IRC)
- IF(IRC.NE.0) THEN
- PRINT *,'Cannot open ',CHNAME(1:LF),' IOSTAT = ',IRC
- RETURN
- ENDIF
-*
-* Loop over all records in the file, looking for the first
-* entry that matches input criteria
-*
- IEOF = .FALSE.
- NBUF = 1
-10 CONTINUE
- CALL XZGETL(LUN,CHLINE,'(A)',' ',IRC)
- LLINE = LENOCC(CHLINE)
- IF(LLINE.EQ.0) GOTO 10
-*
-* Ignore lines beginning with a *
-*
- IF(CHLINE(1:1).EQ.'*') GOTO 10
-
- CHULIN = CHLINE
- CALL CLTOU(CHULIN)
-*
-* Each element of the file starts with a line containing
-* :nick and ends with the next line containing :nick,
-* or the end-of-file
-*
- IF(INDEX(CHULIN(1:LLINE),':NICK').NE.0) THEN
- CHBUF(NBUF) = CHLINE(1:LLINE)
-*
-* Now get the remaining records for this element
-*
-20 CONTINUE
- CALL XZGETL(LUN,CHLINE,'(A)',' ',IRC)
-*
-* EOF handling could be better but...
-*
- IF(IRC.NE.0) GOTO 30
- LLINE = LENOCC(CHLINE)
- IF(LLINE.EQ.0) GOTO 20
- CHULIN = CHLINE
- CALL CLTOU(CHULIN)
- IF(INDEX(CHULIN(1:LLINE),':NICK').NE.0) GOTO 40
- NBUF = NBUF + 1
- CHBUF(NBUF) = CHLINE(1:LLINE)
- GOTO 20
-30 CONTINUE
- IEOF = .TRUE.
-40 CONTINUE
-*
-* Now have NBUF lines for current element.
-* Look for input tags...
-*
- NTAGS = 0
- DO 50 I=1,NBUF
- LBUF = LENOCC(CHBUF(I))
- IF(LBUF.EQ.0) GOTO 50
- DO 60 J=1,NIN
-*
-* Does this tag exist in current record?
-*
- LTAG = LENOCC(CHIN(1,J))
- CHTAG = CHIN(1,J)(1:LTAG)
- CHUBUF(I) = CHBUF(I)
- CALL CLTOU(CHTAG)
- CALL CLTOU(CHUBUF(I))
- ISTART = INDEX(CHUBUF(I)(1:LBUF),CHTAG(1:LTAG)//'.')
- IF(ISTART.NE.0) THEN
-*
-* Does the value match?
-*
- ISTART = ISTART + LTAG + 1
- IEND = INDEX(CHBUF(I)(ISTART+1:LBUF),' ')
- IF(IEND.EQ.0) THEN
- IEND = LBUF
- ELSE
- IEND = IEND + ISTART
- ENDIF
- CHVAL = CHIN(2,J)
- LCHVAL = LENOCC(CHIN(2,J))
- CALL CLTOU(CHVAL)
- IF(CHVAL(1:LCHVAL).NE.CHUBUF(I)(ISTART:IEND)) THEN
- GOTO 70
- ELSE
-*
-* Tag matched - increment counter
-*
- NTAGS = NTAGS + 1
- ENDIF
- ENDIF
-60 CONTINUE
-50 CONTINUE
-*
-* Check that we found all the tags we were looking for...
-*
- IF(NTAGS.LT.NIN) GOTO 70
- IFOUND = 1
-*
-* Now return want the user wanted...
-*
- NTAGS = 0
- DO 80 I=1,NBUF
- LBUF = LENOCC(CHBUF(I))
- IF(LBUF.EQ.0) GOTO 80
- DO 90 J=1,NOUT
-*
-* Does this tag exist in current record?
-*
- LTAG = LENOCC(CHOUT(1,J))
- CHTAG = CHOUT(1,J)(1:LTAG)
- CALL CLTOU(CHTAG)
- ISTART = INDEX(CHUBUF(I)(1:LBUF),CHTAG(1:LTAG)//'.')
- IF(ISTART.NE.0) THEN
-*
-* Get the value of this tag...
-*
- ISTART = ISTART + LTAG + 1
- IF(ISTART.GE.LBUF) THEN
- IEND = LBUF
- ELSE
- IEND = INDEX(CHBUF(I)(ISTART+1:LBUF),' :')
- IF(IEND.EQ.0) THEN
- IEND = LBUF
- ELSE
- IEND = IEND + ISTART
- ENDIF
- ENDIF
- CHOUT(2,J) = CHBUF(I)(ISTART:IEND)
- NTAGS = NTAGS + 1
- ENDIF
-90 CONTINUE
-80 CONTINUE
-*
-* We have found an entry - now return
-*
- IF(NTAGS.EQ.NOUT) THEN
- IFOUND = 2
- GOTO 99
- ENDIF
-*
-* Entry did not have all the fields we want
-* Look for a better one...
-*
-70 CONTINUE
-*
-* Anything left to process?
-*
- IF(.NOT.IEOF) THEN
- NBUF = 1
- CHBUF(NBUF) = CHLINE(1:LLINE)
- GOTO 20
- ENDIF
-*
- ENDIF
-
-99 CALL XZCLOS(LUN,' ',IRC)
-*
-* No entries found matching search criteria
-*
- IF(IFOUND.EQ.0) IRC = 32
- IF(IFOUND.EQ.1) IRC = 4
- END
-#endif
diff --git a/src/packlib/fatmen/fmutil/fmnick.F b/src/packlib/fatmen/fmutil/fmnick.F
deleted file mode 100644
index 153b072..0000000
--- a/src/packlib/fatmen/fmutil/fmnick.F
+++ /dev/null
@@ -1,177 +0,0 @@
-*
-* $Id: fmnick.F,v 1.1.1.1 1996/03/07 15:18:19 mclareni Exp $
-*
-* $Log: fmnick.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:19 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMNICK(LUN,CHFILE,CHNICK,CHNAME,CHDESC,CHOPT,IRC)
-*
-* Search in NAMES file 'CHFILE' for generic name and description
-* corresponding to nickname 'CHNICK'
-*
- CHARACTER*(*) CHFILE,CHNICK,CHNAME,CHDESC
- CHARACTER*255 CHIN(2,1),CHOUT(2,2)
- CHARACTER*255 CHRNGE,CHFNAM
- LOGICAL IEXIST
-#include "fatmen/fatbug.inc"
-#include "fatmen/fatsys.inc"
-#include "fatmen/fatopts.inc"
-
- IRC = 0
-
- CHNAME = ' '
- CHDESC = ' '
-
- LFILE = LENOCC(CHFILE)
- JFILE = LFILE
-
- IF(LFILE.EQ.0) THEN
- LDEF = LENOCC(DEFAULT)
- LSN = LENOCC(SERNAM)
-#if defined(CERNLIB_CSPACK)
- IF(FATNOD.NE.' ') THEN
- CHFNAM = DEFAULT(1:LDEF)//'/'//SERNAM(1:LSN)//'.NAMES'
- LFILE = LENOCC(CHFNAM)
- CALL CUTOL(CHFNAM(1:LFILE))
- IF(IDEBFA.GE.0) PRINT *,'FMNICK. using default names file -'
- + //' ', CHFNAM(1:LFILE),' on node ',FATNOD
- CALL XZINQR(LUFZFA,CHFNAM(1:LFILE),FATNOD,LRECL,ICODE,IRC)
- IF(ICODE.NE.0) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMNICK. names file ', 'does '
- + //'not exist (',CHFNAM(1:LFILE),')'
- IRC = 28
- RETURN
- ENDIF
-
- ELSE
-#endif
-#if defined(CERNLIB_UNIX)
- CHFNAM = DEFAULT(1:LDEF)//'/'//SERNAM(1:LSN)//'.NAMES'
-#endif
-#if defined(CERNLIB_VAXVMS)
- CHFNAM = DEFAULT(1:LDEF)//SERNAM(1:LSN)//'.NAMES'
-#endif
-#if defined(CERNLIB_IBMVM)
- CHFNAM = '/'//SERNAM(1:LSN)//' NAMES '//SERMOD
-#endif
-#if defined(CERNLIB_IBMMVS)
- CHFNAM = '/'//DEFAULT(1:LDEF)//'.'//SERNAM(1:LSN)//
- + '.NAMES'
-#endif
- LFILE = LENOCC(CHFNAM)
-#if defined(CERNLIB_UNIX)
- CALL CUTOL(CHFNAM(1:LFILE))
-#endif
- IF(IDEBFA.GE.0) PRINT *,'FMNICK. using default names file -'
- + //' ', CHFNAM(1:LFILE)
-#if defined(CERNLIB_CSPACK)
- ENDIF
-#endif
- ELSE
-#if defined(CERNLIB_IBM)
- IF(CHFILE(1:1).NE.'/') THEN
- CHFNAM = '/' // CHFILE(1:LFILE)
- ELSE
- CHFNAM = CHFILE(1:LFILE)
- ENDIF
-#endif
-#if !defined(CERNLIB_IBM)
- CHFNAM = CHFILE(1:LFILE)
-#endif
-#if defined(CERNLIB_UNIX)
- IF(IOPTC.EQ.0) CALL CUTOL(CHFNAM(1:LFILE))
-#endif
-
- ENDIF
-#if defined(CERNLIB_CSPACK)
- IF(FATNOD.EQ.' '.OR.JFILE.NE.0) THEN
-#endif
-*
-* Does file exist?
-*
- INQUIRE(FILE=CHFNAM(1:LFILE),EXIST=IEXIST)
-
- IF(.NOT.IEXIST) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMNICK. names file ', 'does not '
- + //'exist (',CHFNAM(1:LFILE),')'
- IRC = 28
- RETURN
- ENDIF
-
-#if defined(CERNLIB_CSPACK)
- ENDIF
-#endif
-
- LNICK = LENOCC(CHNICK)
- LSLASH = INDEX(CHNICK(1:LNICK),'/')
- IF(LSLASH.NE.0) THEN
- IF(CHNICK(LSLASH+1:LSLASH+1).EQ.'(') THEN
- CHRNGE = CHNICK(LSLASH+1:LNICK)
- LRNGE = LNICK - LSLASH
- ELSE
- CHRNGE = '(' // CHNICK(LSLASH+1:LNICK) // ')'
- LRNGE = LNICK - LSLASH + 2
- LMINUS = INDEX(CHRNGE(1:LRNGE),'-')
- IF(LMINUS.NE.0) THEN
- CHRNGE(LMINUS:LMINUS) = ':'
- ELSE
- CHRNGE = '*'
- LRNGE = 1
- ENDIF
- ENDIF
- IF(CHRNGE(LRNGE:LRNGE).NE.'*') THEN
- LRNGE = LRNGE + 1
- CHRNGE(LRNGE:LRNGE) = '*'
- ENDIF
- LNICK = LSLASH - 1
- ELSE
- LRNGE = 0
- ENDIF
-
- CHIN(1,1) = ':NICK'
- CHIN(2,1) = CHNICK(1:LNICK)
- NIN = 1
-
- CHOUT(1,1) = ':GNAME'
- CHOUT(2,1) = ' '
-
- CHOUT(1,2) = ':DESC'
- CHOUT(2,2) = ' '
- NOUT = 2
-
-#if defined(CERNLIB_CSPACK)
- IF(FATNOD.NE.' ') THEN
- CALL FMNAMF(LUN,CHFNAM,FATNOD,CHIN,NIN,CHOUT,NOUT,IRC)
- ELSE
-#endif
-
-#if defined(CERNLIB_IBM)
- IF(CHFNAM(1:1).EQ.'/') THEN
- CALL NAMEFD(LUN,CHFNAM(2:),CHIN,NIN,CHOUT,NOUT,IRC)
- ELSE
- CALL NAMEFD(LUN,CHFNAM,CHIN,NIN,CHOUT,NOUT,IRC)
- ENDIF
-#endif
- CALL NAMEFD(LUN,CHFNAM,CHIN,NIN,CHOUT,NOUT,IRC)
-#if defined(CERNLIB_CSPACK)
- ENDIF
-#endif
- IF(IRC.EQ.32) GOTO 99
-
- IRC = 0
- LDESC = LENOCC(CHOUT(2,2))
- LNAME = LENOCC(CHOUT(2,1))
-
- IF(LRNGE.EQ.0) THEN
- CHNAME = CHOUT(2,1)(1:LNAME)
- ELSE
- CHNAME = CHOUT(2,1)(1:LNAME)//CHRNGE(1:LRNGE)
- ENDIF
-
- CHDESC = CHOUT(2,2)(1:LDESC)
-
- 99 END
-
diff --git a/src/packlib/fatmen/fmutil/fmntol.F b/src/packlib/fatmen/fmutil/fmntol.F
deleted file mode 100644
index 78f035d..0000000
--- a/src/packlib/fatmen/fmutil/fmntol.F
+++ /dev/null
@@ -1,201 +0,0 @@
-*
-* $Id: fmntol.F,v 1.1.1.1 1996/03/07 15:18:20 mclareni Exp $
-*
-* $Log: fmntol.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:20 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMNTOL(CHNODE,LOCCOD,CHOPT,IRC)
-*
-* Return location code for node CHNODE
-*
- CHARACTER*(*) CHNODE
- CHARACTER*255 CHFILE,CHLINE,PATH
- CHARACTER*20 NODE
- LOGICAL IEXIST
-
-#include "fatmen/fatsys.inc"
-#include "fatmen/fatbug.inc"
-#include "fatmen/slate.inc"
-#include "fatmen/fatopts.inc"
-
- IRC = 0
- LOCCOD = 0
-
- LNODE = LENOCC(CHNODE)
- NODE = CHNODE(1:LNODE)
- IF(IOPTC.EQ.0) CALL CLTOU(NODE(1:LNODE))
-
- IF(IDEBFA.GE.3) PRINT 9001,CHNODE(1:LNODE),CHOPT
- 9001 FORMAT(' FMNTOL. enter for ',A,1X,A)
-
- LDEF = LENOCC(DEFAULT)
-
-#if defined(CERNLIB_CSPACK)
- IF(FATNOD.NE.' ') THEN
-*
-* Open remote file. Here we are assuming that the remote
-* server is a Unix system
-*
- CHFILE = DEFAULT(1:LDEF)//'/FATMEN.LOCATIONS'
- LFILE = LENOCC(CHFILE)
- CALL CUTOL(CHFILE(1:LFILE))
-*
-* Does file exist?
-*
- CALL XZINQR(LUFZFA,CHFILE(1:LFILE),FATNOD,ICODE,LRECL,IRC)
- IF(ICODE.NE.0) THEN
- IF(IDEBFA.GE.2) PRINT 9002,CHFILE(1:LFILE)
- IRC = 1
- GOTO 40
- ENDIF
- LRECL = 80
- CALL XZOPEN(LUFZFA,CHFILE(1:LFILE),FATNOD,LRECL,'F',IRC)
-
- ELSE
-#endif
-#if defined(CERNLIB_UNIX)
- CHFILE = DEFAULT(1:LDEF)//'/FATMEN.LOCATIONS'
- CALL CUTOL(CHFILE)
-#endif
-#if defined(CERNLIB_VAXVMS)
- CHFILE = DEFAULT(1:LDEF)//'FATMEN.LOCATIONS'
-#endif
-#if defined(CERNLIB_IBMVM)
- CHFILE = '/FATMEN LOCATION '//SERMOD
-#endif
-#if defined(CERNLIB_IBMMVS)
- CHFILE = '/'//DEFAULT(1:LDEF)//'FATMEN.LOCATIONS'
-#endif
- LFILE = LENOCC(CHFILE)
-*
-* Does file exist?
-*
- INQUIRE(FILE=CHFILE(1:LFILE),EXIST=IEXIST)
-
- IF(.NOT.IEXIST) THEN
- IF(IDEBFA.GE.2) PRINT 9002,CHFILE(1:LFILE)
- 9002 FORMAT(' FMNTOL. FATMEN locations file does not exist (',A,')')
- IRC = 1
- GOTO 40
- ENDIF
-*
-* Open and read the file
-*
-#if defined(CERNLIB_IBMVM)
- OPEN(LUFZFA,FILE=CHFILE(1:LFILE),ACTION='READ', ACCESS=
- + 'SEQUENTIAL',FORM='UNFORMATTED', STATUS='OLD',IOSTAT=IRC)
-#endif
-#if defined(CERNLIB_IBMMVS)
- CALL KUOPEN(LUFZFA,CHFILE(1:LFILE),'OLD',IRC)
-#endif
-#if defined(CERNLIB_VAXVMS)
- ISTAT = LIB$GET_LUN(LUNLOC)
- IF(.NOT.ISTAT) THEN
- IRC = 42
- IF(IDEBFA.GE.-3) PRINT *,'FMNTOL. could not assign logical '
- + , 'unit to read locations file'
- GOTO 40
- ENDIF
-
- OPEN(LUNLOC,FILE=CHFILE(1:LFILE),READONLY,ACCESS='SEQUENTIAL',
- + STATUS='OLD',FORM='FORMATTED',IOSTAT=IRC)
-
-#endif
-#if defined(CERNLIB_UNIX)
- CALL CIOPEN(LUNLOC,'r',CHFILE(1:LFILE),IRC)
-#endif
-#if defined(CERNLIB_CSPACK)
- ENDIF
-#endif
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.-3) PRINT 9003,IRC,CHFILE(1:LFILE)
- 9003 FORMAT(' FMNTOL. error ',I10,' opening ',A)
- IRC = 2
- GOTO 40
- ENDIF
-
- 10 CONTINUE
-#if defined(CERNLIB_CSPACK)
- IF(FATNOD.NE.' ') THEN
- CALL XZGETL(LUFZFA,CHLINE,'(A)',' ',IRC)
- IF(IRC.NE.0) GOTO 20
- LLINE = LENOCC(CHLINE)
- ELSE
-#endif
-#if defined(CERNLIB_IBMVM)
- READ(LUFZFA,NUM=LLINE,END=20) CHLINE
-#endif
-#if defined(CERNLIB_IBMMVS)
- READ(LUFZFA,'(A)',END=20) CHLINE
- LLINE = LENOCC(CHLINE)
-#endif
-#if defined(CERNLIB_VAXVMS)
- READ(LUNLOC,'(A)',END=20) CHLINE
- LLINE = LENOCC(CHLINE)
-#endif
-#if defined(CERNLIB_UNIX)
- CALL FMCFGL(LUNLOC,CHLINE,LLINE,' ',ISTAT)
- IF(ISTAT.NE.0) GOTO 20
-#endif
-#if defined(CERNLIB_CSPACK)
- ENDIF
-#endif
-
- IF(LLINE.EQ.0) GOTO 10
-
- IF(IDEBFA.GE.3) PRINT *,'FMNTOL. read ',CHLINE(1:LLINE)
-*
-* Comments...
-*
- IF(CHLINE(1:1).EQ.'!') GOTO 10
- IF(CHLINE(1:1).EQ.'*') GOTO 10
- IF(CHLINE(1:1).EQ.'#') GOTO 10
-* G.Folger "/*" is bad for cpp, so split it...
- IF(CHLINE(1:1).EQ.'/' .AND. CHLINE(2:2).EQ.'*' ) GOTO 10
-
- IF(IOPTC.EQ.0) CALL CLTOU(CHLINE(1:LLINE))
-
- IEQUAL = INDEX(CHLINE(1:LLINE),'=')
- IF(IEQUAL.EQ.0) GOTO 10
-
- IF(CHLINE(1:IEQUAL-1).EQ.NODE(1:LNODE)) THEN
- LOCCOD = ICDECI(CHLINE,IEQUAL+1,LLINE)
- GOTO 30
- ENDIF
-
- GOTO 10
-*
-* EOF with no match
-*
- 20 CONTINUE
- IRC = 3
- 30 CONTINUE
-
-#if defined(CERNLIB_CSPACK)
- IF(FATNOD.NE.' ') THEN
- CALL XZCLOS(LUFZFA,' ',ISTAT)
- ELSE
-#endif
-#if defined(CERNLIB_IBM)
- CLOSE(LUFZFA)
-#endif
-#if defined(CERNLIB_VAXVMS)
- CLOSE(LUNLOC)
- CALL LIB$FREE_LUN(LUNLOC)
-#endif
-#if defined(CERNLIB_UNIX)
- CALL FMCFGL(LUNLOC,CHLINE,LLINE,'F',ISTAT)
- CALL CICLOS(LUNLOC)
-#endif
-#if defined(CERNLIB_CSPACK)
- ENDIF
-#endif
-
- RETURN
-
- 40 CONTINUE
-
- END
diff --git a/src/packlib/fatmen/fmutil/fmntrc.F b/src/packlib/fatmen/fmutil/fmntrc.F
deleted file mode 100644
index a63b1ff..0000000
--- a/src/packlib/fatmen/fmutil/fmntrc.F
+++ /dev/null
@@ -1,89 +0,0 @@
-*
-* $Id: fmntrc.F,v 1.1.1.1 1996/03/07 15:18:19 mclareni Exp $
-*
-* $Log: fmntrc.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:19 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
-#if defined(CERNLIB_FPACK)||defined(CERNLIB_CSPACK)
- SUBROUTINE FMNTRC(HOST,CHOPT,IRC)
- CHARACTER*(*) HOST
- CHARACTER*20 CHHOST
- CHARACTER*80 LINE
- CHARACTER*20 CHUSER
- CHARACTER*255 CHNAME
- LOGICAL IEXIST
-#include "fatmen/fatbug.inc"
-#include "fatmen/slate.inc"
-#include "fatmen/fatopts.inc"
-*
-* Checks if HOST is in .netrc file
-* The .netrc file is in SYS$LOGIN:NETRC.; (VAX) with IOPTF & IOPTP
-* SYS$LOGIN:FTPLOGIN.; otherwise
-* userid.PER.NETRC (MVS)
-* $HOME/.netrc (Unix)
-* DOT NETRC A0 (VM?)
-*
- LHOST = LENOCC(HOST)
- CHHOST = 'MACHINE '
- CHHOST(9:) = HOST(1:LHOST)
- LHOST = LHOST + 8
- CALL CLTOU(CHHOST(1:LHOST))
-
- IRC = 1
- CHNAME = ' '
-*
-* Get the name of the netrc file...
-*
-#if defined(CERNLIB_IBMMVS)
- CALL KPREFI(CHUSER,LUSER)
- CHNAME = '/'//CHUSER(1:LUSER) // '.PER.NETRC'
-#endif
-#if defined(CERNLIB_IBMVM)
- CHNAME = '/DOT NETRC A0'
-#endif
-#if defined(CERNLIB_VAXVMS)
- IF(IOPTF.NE.0.AND.IOPTP.NE.0) THEN
- CHNAME = 'SYS$LOGIN:NETRC.;'
- ELSE
- CHNAME = 'SYS$LOGIN:FTPLOGIN.;'
- ENDIF
-#endif
-#if defined(CERNLIB_UNIX)
- CALL GETENVF('HOME',CHNAME)
- CHNAME(IS(1)+1:IS(1)+7) = '/.netrc'
-#endif
- LNAME = LENOCC(CHNAME)
-*
-* Does file exist?
-*
- INQUIRE(FILE=CHNAME(1:LNAME),EXIST=IEXIST)
- IF(.NOT.IEXIST) RETURN
-*
-* Open the file and look for 'host'
-*
- OPEN(LUFZFA,FILE=CHNAME(1:LNAME),FORM='FORMATTED',
-#if defined(CERNLIB_IBMVM)||defined(CERNLIB_IBMMVS)
- + ACTION='READ',
-#endif
-#if defined(CERNLIB_VAXVMS)
- + READONLY,
-#endif
- + ACCESS='SEQUENTIAL',STATUS='OLD',IOSTAT=ISTAT)
- IF(ISTAT.NE.0) RETURN
-
-10 CONTINUE
- READ(LUFZFA,'(A)',END=99) LINE
- CALL CLTOU(LINE)
- IF(INDEX(LINE,CHHOST(1:LHOST)) .NE.0) THEN
- IRC = 0
- GOTO 99
- ENDIF
- GOTO 10
-
-99 CLOSE(LUFZFA)
-
- END
-#endif
diff --git a/src/packlib/fatmen/fmutil/fmnwrd.F b/src/packlib/fatmen/fmutil/fmnwrd.F
deleted file mode 100644
index 7bc4901..0000000
--- a/src/packlib/fatmen/fmutil/fmnwrd.F
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: fmnwrd.F,v 1.1.1.1 1996/03/07 15:18:17 mclareni Exp $
-*
-* $Log: fmnwrd.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:17 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMNWRD(DELIM,SOURCE,IRC)
- CHARACTER*(*) SOURCE,DELIM
- IRC = 0
-*
-* Find the number of words in SOURCE delimited by DELIM
-*
- IR = LENOCC(SOURCE)
-* If string is non-blank, at least one word exists...
- IF(IR.EQ.0) THEN
- IRC = -1
- RETURN
- ENDIF
-
- IRC = 1
- IC = 1
-10 CONTINUE
- IL = INDEX(SOURCE(IC:IR),DELIM)
- IF(IL.EQ.0) GOTO 99
- IC = IC + IL
- IRC = IRC + 1
- IF(IC.GE.IR) GOTO 99
- GOTO 10
-
-99 END
-
diff --git a/src/packlib/fatmen/fmutil/fmodat.F b/src/packlib/fatmen/fmutil/fmodat.F
deleted file mode 100644
index feb24c5..0000000
--- a/src/packlib/fatmen/fmutil/fmodat.F
+++ /dev/null
@@ -1,51 +0,0 @@
-*
-* $Id: fmodat.F,v 1.1.1.1 1996/03/07 15:18:17 mclareni Exp $
-*
-* $Log: fmodat.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:17 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMODAT(IDATE,ITIME,ODATE)
-*
-* Routine to convert integer date and time to character format
-* for inserting into ORACLE / SQL tables
-* IDATE = YYMMDD, ITIME = HHMM (I*4)
-* ODATE = DD-MMM-YY HH:MM (24 hour clock)
-* Insert into ORACLE /SQL with TO_DATE(odate,'DD-MON-YY HH24:MI')
-*
- CHARACTER*15 ODATE
- CHARACTER*3 MONTH(12)
-
- DATA MONTH(1)/'JAN'/,
- + MONTH(2)/'FEB'/,
- + MONTH(3)/'MAR'/,
- + MONTH(4)/'APR'/,
- + MONTH(5)/'MAY'/,
- + MONTH(6)/'JUN'/,
- + MONTH(7)/'JUL'/,
- + MONTH(8)/'AUG'/,
- + MONTH(9)/'SEP'/,
- + MONTH(10)/'OCT'/,
- + MONTH(11)/'NOV'/,
- + MONTH(12)/'DEC'/
-
- IF ((ITIME .EQ. 0) .OR. (IDATE .EQ. 0)) CALL DATIME(IDATE,ITIME)
- IMIN = MOD(ITIME,100)
- IHOU = ITIME/100
-*
- IDAY = MOD(IDATE,100)
- IYEA = IDATE/100
- IMON = MOD(IYEA,100)
- IYEA = IYEA/100
-*
- WRITE(ODATE,9001) IDAY,MONTH(IMON),IYEA,IHOU,IMIN
-9001 FORMAT(I2,'-',A3,'-',I2,' ',I2,':',I2)
-
- DO 10 I=1,15
- IF (I .EQ. 10) GOTO 10
- IF (ODATE(I:I) .EQ. ' ') ODATE(I:I) = '0'
-10 CONTINUE
-*
- END
diff --git a/src/packlib/fatmen/fmutil/fmonit.F b/src/packlib/fatmen/fmutil/fmonit.F
deleted file mode 100644
index 0e403f4..0000000
--- a/src/packlib/fatmen/fmutil/fmonit.F
+++ /dev/null
@@ -1,30 +0,0 @@
-*
-* $Id: fmonit.F,v 1.1.1.1 1996/03/07 15:18:16 mclareni Exp $
-*
-* $Log: fmonit.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:16 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
-#if defined(CERNLIB_IBMVM)
- SUBROUTINE FMONIT(ACTION)
-#include "fatmen/fatsys.inc"
- CHARACTER*(*) ACTION
- INTEGER FMUSER,FMHOST
- CHARACTER*8 CHUSER,CHHOST,CHTYPE,CHSYS
-
- IC = FMUSER(CHUSER)
- IF(CHUSER(1:LENOCC(CHUSER)).EQ.SERNAM(1:LSN)) RETURN
-
- IC = FMHOST(CHHOST,CHTYPE,CHSYS)
- IF(CHHOST(1:LENOCC(CHHOST)).NE.'CERNVM') RETURN
-*
-* Routine to log action via SMSG to service machine
-* Action will appear in normal console log
-*
- CALL VMCMS('EXEC FATLOG '
- +//SERNAM(1:LENOCC(SERNAM))//' '//ACTION,IRC)
- END
-
-#endif
diff --git a/src/packlib/fatmen/fmutil/fmoptc.F b/src/packlib/fatmen/fmutil/fmoptc.F
deleted file mode 100644
index 61640d2..0000000
--- a/src/packlib/fatmen/fmutil/fmoptc.F
+++ /dev/null
@@ -1,40 +0,0 @@
-*
-* $Id: fmoptc.F,v 1.1.1.1 1996/03/07 15:18:18 mclareni Exp $
-*
-* $Log: fmoptc.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:18 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMOPTC(CHOPT,CHPOSS,IOPT)
-*CMZ : 20/08/91 17.23.54 by Jamie Shiers
-*-- Author : Jamie Shiers 20/08/91
-*
-* Decode character option string ignoring case
-*
- CHARACTER*(*) CHOPT,CHPOSS
- CHARACTER*255 CAPOPT
- DIMENSION IOPT(2)
-
- LCHOPT = LEN(CHOPT)
- IF(LCHOPT.EQ.0) THEN
- CALL VZERO(IOPT,LEN(CHPOSS))
- RETURN
- ENDIF
-
- CAPOPT = CHOPT(1:LCHOPT)
-
- CALL CLTOU(CAPOPT(1:LCHOPT))
-
- DO 10 JOPT=1,LEN(CHPOSS)
-
- IF(INDEX(CAPOPT(1:LCHOPT),CHPOSS(JOPT:JOPT)).NE.0) THEN
- IOPT(JOPT) = 1
- ELSE
- IOPT(JOPT) = 0
- ENDIF
-
-10 CONTINUE
-
- END
diff --git a/src/packlib/fatmen/fmutil/fmpkey.F b/src/packlib/fatmen/fmutil/fmpkey.F
deleted file mode 100644
index b826c4c..0000000
--- a/src/packlib/fatmen/fmutil/fmpkey.F
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: fmpkey.F,v 1.1.1.1 1996/03/07 15:18:16 mclareni Exp $
-*
-* $Log: fmpkey.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:16 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMPKEY(KEYS,NKEYS)
- DIMENSION KEYS(NKEYS)
-#include "fatmen/fatbank.inc"
-*
-* Prints out KEYS vector in a readable manner
-*
- WRITE(LPRTFA,9001) (KEYS(I),I=1,NKEYS-1)
-9001 FORMAT(' Key serial number = ',I6,' filename = ',5A4,
- +' data repr. = ',I3,' media type = ',I2,' location code = ',I6)
- END
-
diff --git a/src/packlib/fatmen/fmutil/fmpktm.F b/src/packlib/fatmen/fmutil/fmpktm.F
deleted file mode 100644
index 151ad76..0000000
--- a/src/packlib/fatmen/fmutil/fmpktm.F
+++ /dev/null
@@ -1,68 +0,0 @@
-*
-* $Id: fmpktm.F,v 1.2 1999/08/17 12:45:28 mclareni Exp $
-*
-* $Log: fmpktm.F,v $
-* Revision 1.2 1999/08/17 12:45:28 mclareni
-* Y2k mods submitted by Rob Komar
-*
-* Revision 1.1.1.1 1996/03/07 15:18:16 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMPKTM (IDATE, ITIME, IDATM,IRC)
-* ===========================================
-*
-************************************************************************
-* *
-* SUBR. FMPKTM (IDATE, ITIME, IDATM*, IRC*) *
-* *
-* Packs date and time into one word *
-* *
-* Arguments : *
-* *
-* IDATE Date : 6 Decimal integer : YYMMDD *
-* ITIME Time : 4 Decimal integer : HHMM *
-* IDATM* Packed date-time *
-* *
-* Modified from original DBPKTM 19/03/90 JDS *
-* *
-************************************************************************
-*
-#include "fatmen/fatbank.inc"
- DATA MXMIN/61/, MXHOU/25/, MXDAY/32/, MXMON/13/, MXYEA/134/
-*
-* ------------------------------------------------------------------
-*
- IRC = 0
-
- IMIN = MOD(ITIME,100)
- IHOU = ITIME/100
-*
- IDAY = MOD(IDATE,100)
- IYEA = IDATE/100
- IMON = MOD(IYEA,100)
- IYEA = IYEA/100
- IF(IYEA.LT.35) IYEA = IYEA + 100
-*
- IDATM = IMIN
- MAXX = MXMIN
- IDATM = IDATM + MAXX*IHOU
- MAXX = MAXX*MXHOU
- IDATM = IDATM + MAXX*IDAY
- MAXX = MAXX*MXDAY
- IDATM = IDATM + MAXX*IMON
- MAXX = MAXX*MXMON
- IDATM = IDATM + MAXX*IYEA
-
- IF((IYEA.GT.MXYEA) .OR. (IMON.GE.MXMON) .OR. (IDAY.GE.MXDAY) .OR.
- + (IHOU.GE.MXHOU) .OR. (IMIN.GE.MXMIN)) THEN
- IF(IDEBFA.GE.2)
- + PRINT *,'FMPKTM. Invalid date/time - IPACK set to zero'
- IRC = 1
- IDATM = 0
- ENDIF
-
-* END FMPKTM
- END
-
diff --git a/src/packlib/fatmen/fmutil/fmpkvx.F b/src/packlib/fatmen/fmutil/fmpkvx.F
deleted file mode 100644
index dbf6e76..0000000
--- a/src/packlib/fatmen/fmutil/fmpkvx.F
+++ /dev/null
@@ -1,39 +0,0 @@
-*
-* $Id: fmpkvx.F,v 1.1.1.1 1996/03/07 15:18:18 mclareni Exp $
-*
-* $Log: fmpkvx.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:18 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMPKVX(CHDATE,ID,IT,IP,IRC)
-*
-* Pack VAX format date & time
-* 11-JUL-1991 17:14:41.37
-* dd-mmm-yyyy hh:mm:ss
-* 123456789_123456789_
-*
- CHARACTER*(*) CHDATE
- CHARACTER*3 MONTHS(12),CHMON
- DATA MONTHS( 1)/'JAN'/,MONTHS( 2)/'FEB'/,
- + MONTHS( 3)/'MAR'/,MONTHS( 4)/'APR'/,
- + MONTHS( 5)/'MAY'/,MONTHS( 6)/'JUN'/,
- + MONTHS( 7)/'JUL'/,MONTHS( 8)/'AUG'/,
- + MONTHS( 9)/'SEP'/,MONTHS(10)/'OCT'/,
- + MONTHS(11)/'NOV'/,MONTHS(12)/'DEC'/
-
- READ(CHDATE,'(I2,1X,A3,1X,I4,1X,I2,1X,I2)')
- + IDAY,CHMON,IYEA,IHOU,IMIN
- IMON = ICNTH(CHMON,MONTHS,12)
-
- IYEA = MOD(IYEA,1900)
-
- ID = IYEA*10000 + IMON*100 + IDAY
- IT = IHOU*100 + IMIN
-*
-* and pack for insertion into FATMEN bank...
-*
- CALL FMPKTM(ID,IT,IP,IRC)
-
- END
diff --git a/src/packlib/fatmen/fmutil/fmplog.F b/src/packlib/fatmen/fmutil/fmplog.F
deleted file mode 100644
index 7bb9560..0000000
--- a/src/packlib/fatmen/fmutil/fmplog.F
+++ /dev/null
@@ -1,123 +0,0 @@
-*
-* $Id: fmplog.F,v 1.1.1.1 1996/03/07 15:18:20 mclareni Exp $
-*
-* $Log: fmplog.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:20 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMPLOG(LUN,IHEAD,LHEAD,IRC)
-#include "fatmen/fausto.inc"
- DIMENSION IHEAD(LHEAD)
- DIMENSION HEAD(KLREAL)
- CHARACTER*20 CHFSYS,CHFGRP,CHUSER,CHHOST,CHTYPE,CHSYS
- CHARACTER*64 CHTIT
-*
-* Print contents of log record on LUN
-*
- IRC = 0
-*
-* Unpack hollerith
-*
- CALL UHTOC(IHEAD(KFMSYS),4,CHFSYS,20)
- CALL UHTOC(IHEAD(KFMGRP),4,CHFGRP,20)
- CALL UHTOC(IHEAD(KFMTIT),4,CHTIT ,64)
- CALL UHTOC(IHEAD(KFMUSR),4,CHUSER,20)
- CALL UHTOC(IHEAD(KFMHST),4,CHHOST,20)
- CALL UHTOC(IHEAD(KFMTYP),4,CHTYPE,20)
- CALL UHTOC(IHEAD(KFMOS ),4,CHSYS ,20)
-*
-* Unpack reals
-*
- CALL UCOPY(IHEAD(KFMMBR),HEAD,KLREAL)
-*
-* Unpack dates and times
-*
- CALL FMUPTM(IDQ,ITQ,IHEAD(KFMIDQ),IRC)
- CALL FMUPTM(IDS,ITS,IHEAD(KFMIDS),IRC)
- CALL FMUPTM(IDE,ITE,IHEAD(KFMIDE),IRC)
-
- WRITE(LUN,9001) CHFSYS,CHFGRP,CHUSER,CHHOST,CHTYPE,CHSYS
- 9001 FORMAT(' FMPLOG. FATMEN system and group = ',A,1X,A,/,
- + ' user = ',A,/,
- + ' host name, type and system = ',A,1X,A,1X,A)
-
- WRITE(LUN,9002) CHTIT,IDQ,ITQ
- 9002 FORMAT(' FMPLOG. FATMEN version is'/,1X,A,/,
- + ' generated on ',I6,' at ',I4)
-
- WRITE(LUN,9003) IDS,ITS,IDE,ITE
- 9003 FORMAT(' FMPLOG. start session at ',I6,1X,I4,/,
- + ' end session at ',I6,1X,I4/)
-
- WRITE(LUN,9004) (HEAD(J),J=1,7)
- 9004 FORMAT(' FMPLOG. read ',F10.2,' MB',/,
- + ' wrote ',F10.2,' MB',/,
- + ' read (FZ) ',F10.2,' MB',/,
- + ' wrote (FZ) ',F10.2,' MB',/,
- + ' copied (total) ',F10.2,' MB',/,
- + ' copied (network) ',F10.2,' MB',/,
- + ' copied (queued) ',F10.2,' MB',/)
-
- WRITE(LUN,9005)
- 9005 FORMAT(' FMPLOG. catalogue manipulations:',/,1X,32('='),/)
-
- WRITE(LUN,9006) (IHEAD(J),J=KFMADD,KFMTCH)
- 9006 FORMAT(' # Add disk = ',I6,/,
- + ' # Add link = ',I6,/,
- + ' # Add tape = ',I6,/,
- + ' # MKDIR = ',I6,/,
- + ' # RMDIR = ',I6,/,
- + ' # RMLN = ',I6,/,
- + ' # RMTREE = ',I6,/,
- + ' # RM = ',I6,/,
- + ' # CP = ',I6,/,
- + ' # MV = ',I6,/,
- + ' # MODIFY = ',I6,/,
- + ' # TOUCH = ',I6,/)
-
- WRITE(LUN,9007)
- 9007 FORMAT(' FMPLOG. file accesses and copies:',/,1X,33('='),/)
-
- WRITE(LUN,9008) (IHEAD(J),J=KFMOPN,KFMCPN)
- 9008 FORMAT(' # OPENs = ',I6,/,
- + ' # CLOSEs = ',I6,/,
- + ' # COPYs (total) = ',I6,/,
- + ' # COPYs (queued) = ',I6,/,
- + ' # COPYs (remote) = ',I6,/)
-
- WRITE(LUN,9009)
- 9009 FORMAT(' FMPLOG. TMS commands:',/,1X,21('='),/)
-
- WRITE(LUN,9010) (IHEAD(J),J=KFMSRQ,KFMSTG)
- 9010 FORMAT(' # SYSREQs = ',I6,/,
- + ' # QVOLs = ',I6,/,
- + ' # Alloc VL = ',I6,/,
- + ' # Alloc SP = ',I6,/,
- + ' # POOLs = ',I6,/,
- + ' # LOCKs = ',I6,/,
- + ' # UNLOCKs = ',I6,/,
- + ' # DEL TAGS = ',I6,/,
- + ' # GET TAGS = ',I6,/,
- + ' # SET TAGS = ',I6,/)
-
- WRITE(LUN,9011)
- 9011 FORMAT(' FMPLOG. FATMEN client commands:',/,1X,31('='),/)
-
- WRITE(LUN,9012) (IHEAD(J),J=KFMBNK,KFMMTC)
- 9012 FORMAT(' # BANKs in = ',I6,/,
- + ' # GETs = ',I6,/,
- + ' # GETKs = ',I6,/,
- + ' # SHOWs = ',I6,/,
- + ' # SCANs = ',I6,/,
- + ' # LOOPs = ',I6,/,
- + ' # LDIRs = ',I6,/,
- + ' # LFILs = ',I6,/,
- + ' # SORTs = ',I6,/,
- + ' # RANKs = ',I6,/,
- + ' # SELKs = ',I6,/,
- + ' # MATCHes = ',I6,/)
-
- END
-
diff --git a/src/packlib/fatmen/fmutil/fmpurl.F b/src/packlib/fatmen/fmutil/fmpurl.F
deleted file mode 100644
index 085aa74..0000000
--- a/src/packlib/fatmen/fmutil/fmpurl.F
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: fmpurl.F,v 1.1.1.1 1996/03/07 15:18:20 mclareni Exp $
-*
-* $Log: fmpurl.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:20 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMPURL(GENAM,LBANK,KEYS,CHOPT,IRC)
-*
-* Simplified interface to FMURL. All info taken from
-* configuration file
-*
- CHARACTER*(*) GENAM
- CHARACTER*32 CHPROT,CHSERV,CHNAME,CHSGRP,CHBFID,CHOPT
-#include "fatmen/fmnkeys.inc"
- DIMENSION KEYS(LKEYFA)
-
- IRC = 0
-
- CHPROT = ' '
- CHSERV = ' '
- CHNAME = ' '
- CHSGRP = ' '
- CHBFID = ' '
- CHOPT = 'P'
-
- CALL FMURL(GENAM,LBANK,KEYS,
- + CHPROT,CHSERV,CHNAME,CHSGRP,CHBFID,CHOPT,IRC)
-
- END
diff --git a/src/packlib/fatmen/fmutil/fmqfat.F b/src/packlib/fatmen/fmutil/fmqfat.F
deleted file mode 100644
index f741be5..0000000
--- a/src/packlib/fatmen/fmutil/fmqfat.F
+++ /dev/null
@@ -1,106 +0,0 @@
-*
-* $Id: fmqfat.F,v 1.1.1.1 1996/03/07 15:18:18 mclareni Exp $
-*
-* $Log: fmqfat.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:18 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMQFAT(CHSYS,CHGRP,IRC)
-*
-* Return FATMEN system and group
-*
- CHARACTER*(*) CHSYS,CHGRP
- CHARACTER*16 CHTEMP
-#include "fatmen/slate.inc"
-#if defined(CERNLIB_IBMMVS)
- CHARACTER*100 CHPARM
-#endif
-#include "fatmen/fatbug.inc"
-#if defined(CERNLIB_IBMMVS)
- CALL GOPARM(LPARM,CHPARM)
- IF(LPARM.EQ.0) THEN
- NPARMS = 0
- ELSE
- CALL FMNWRD(',',CHPARM(1:LPARM),NPARMS)
- ENDIF
- IF(NPARMS.GT.0) THEN
- CALL FMWORD(CHSYS,0,',',CHPARM(1:LPARM),IRC)
- LCHSYS = LENOCC(CHSYS)
- ELSE
- PRINT *,'FMQFAT. GOPARM variable FATSYS not defined. '
- PRINT *,'FMQFAT. defaulted to CERN'
- CHSYS = 'CERN'
- LCHSYS = 4
- ENDIF
-#endif
-#if defined(CERNLIB_IBMVM)
- CALL VMREXX('F','FATSYS',CHSYS,IRC)
- IF(IRC.EQ.0) LCHSYS = LENOCC(CHSYS)
-#endif
-#if defined(CERNLIB_UNIX)||defined(CERNLIB_VAXVMS)
- CALL GETENVF('FATSYS',CHSYS)
- LCHSYS = IS(1)
- IRC = 0
- IF(LCHSYS .EQ.0) IRC = -1
-#endif
-#if defined(CERNLIB_IBMVM)||defined(CERNLIB_VAXVMS)||defined(CERNLIB_UNIX)
- IF(IRC.NE.0) THEN
- CHSYS = 'CERN'
- LCHSYS = 4
-#endif
-#if defined(CERNLIB_IBMVM)
- PRINT *,'FMQFAT. REXX variable FATSYS not defined. '
-#endif
-#if defined(CERNLIB_VAXVMS)
- PRINT *,'FMQFAT. symbol FATSYS not defined.'
-#endif
-#if defined(CERNLIB_UNIX)
- PRINT *,'FMQFAT. environmental variable FATSYS not defined. '
-#endif
-#if defined(CERNLIB_IBMVM)||defined(CERNLIB_VAXVMS)||defined(CERNLIB_UNIX)
- PRINT *,'FMQFAT. defaulted to CERN'
- ENDIF
-#endif
- CALL CLTOU(CHSYS)
- IF(CHSYS(1:2).NE.'//') THEN
- CHTEMP = '//'//CHSYS(1:LCHSYS)
- ELSE
- CHTEMP = CHSYS(1:LCHSYS)
- ENDIF
- CHSYS = CHTEMP
-#if defined(CERNLIB_IBMVM)
-*
-* Take username from REXX variable 'FATMAN'
-* If not defined, use current username
-* This username determines the FATMEN group for whom we are working...
-*
- CALL VMREXX('F','FATMAN',CHGRP,IRC)
-#endif
-#if defined(CERNLIB_UNIX)||defined(CERNLIB_VAXVMS)
- CALL GETENVF('FATGRP',CHGRP)
- LDEF = IS(1)
- IRC = 0
- IF(LDEF.EQ.0) IRC = -1
-#endif
-#if defined(CERNLIB_IBMMVS)
- IF(NPARMS.GE.2) THEN
- CALL FMWORD(CHGRP,1,',',CHPARM(1:LPARM),IRC)
- ELSE
- PRINT *,'FMQFAT. GOPARM variable FATUSER not defined. '
- IRC = -1
- ENDIF
-#endif
- IF(IRC.NE.0) THEN
- LCHGRP = LENOCC(CHGRP)
- IF(CHGRP(1:2).NE.'FM') THEN
- CHTEMP = 'FM'//CHGRP(1:LCHGRP)
- ELSE
- CHTEMP = CHGRP(1:LCHGRP)
- ENDIF
- CHGRP = CHTEMP
- ENDIF
-
-
- END
diff --git a/src/packlib/fatmen/fmutil/fmrand.F b/src/packlib/fatmen/fmutil/fmrand.F
deleted file mode 100644
index c89ad5b..0000000
--- a/src/packlib/fatmen/fmutil/fmrand.F
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: fmrand.F,v 1.1.1.1 1996/03/07 15:18:20 mclareni Exp $
-*
-* $Log: fmrand.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:20 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMRAND(CHRAND,IRC)
- CHARACTER*(*) CHRAND
- CHARACTER*9 CHTEMP
-#include "fatmen/slate.inc"
- SAVE NENTRY
- DATA NENTRY/0/
-
- IRC = 0
-
- IF(NENTRY.EQ.0) THEN
- CALL DATIME(ID,IT)
- I = 0
- J = 0
- CALL RMARIN(IT*100+IS(6),I,J)
- NENTRY = 1
- ENDIF
-
- CALL RANMAR(X,1)
-
- WRITE(CHTEMP,'(F9.8)') X
- CHRAND = CHTEMP(2:)
-
- END
diff --git a/src/packlib/fatmen/fmutil/fmrsln.F b/src/packlib/fatmen/fmutil/fmrsln.F
deleted file mode 100644
index 07c82ee..0000000
--- a/src/packlib/fatmen/fmutil/fmrsln.F
+++ /dev/null
@@ -1,73 +0,0 @@
-*
-* $Id: fmrsln.F,v 1.1.1.1 1996/03/07 15:18:20 mclareni Exp $
-*
-* $Log: fmrsln.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:20 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
-#if defined(CERNLIB_UNIX)
- SUBROUTINE FMRSLN(CHLINK,CHFILE,CHOPT,IRC)
-*
-* Return file name pointed to by CHLINK
-*
-#include "fatmen/slate.inc"
-#include "fatmen/fatbug.inc"
- CHARACTER*(*) CHLINK,CHFILE
- CHARACTER*255 CHTEMP,CHCOMM
- INTEGER SYSTEMF
-
- LOGICAL IEXIST
-
-#include "fatmen/fatopts.inc"
-
- IRC = 0
- CHFILE = ' '
- IS(1) = 0
-
- LLINK = LENOCC(CHLINK)
-
-* Get temporary file name
-*
- 10 CONTINUE
- CALL FMFNME(CHTEMP)
- LTEMP = LENOCC(CHTEMP)
- INQUIRE(FILE=CHTEMP(1:LTEMP),EXIST=IEXIST)
- IF(IEXIST) THEN
- IC = SLEEPF(1)
- GO TO 10
- ENDIF
-
- IF(IDEBFA.GE.1) PRINT 9001,CHTEMP(1:LTEMP)
- 9001 FORMAT(' FMRSLN. using temporary file ',A)
-
- WRITE(CHCOMM,9002) CHLINK(1:LLINK),CHTEMP(1:LTEMP)
- 9002 FORMAT('ls -l ',A,' > ',A)
- LCOMM = LENOCC(CHCOMM)
-
- IF(IDEBFA.GE.1) WRITE(LPRTFA,9003) CHCOMM(1:LCOMM)
- 9003 FORMAT(' FMRSLN. issuing ',A)
- IRC = SYSTEMF(CHCOMM(1:LCOMM))
-
- CALL CIOPEN(LUNPTR,'r',CHTEMP(1:LTEMP),IRC)
- CALL CIGET(LUNPTR,CHCOMM,255,NREAD,IRC)
- CALL CICLOS(LUNPTR)
- IF(NREAD.EQ.0.OR.IRC.NE.0) GOTO 99
- LCOMM = LENOCC(CHCOMM)
-
- LNEWL = INDEX(CHCOMM,CHAR(10))
- IF(LNEWL.NE.0) LCOMM = LNEWL - 1
-
- LSTART = INDEXB(CHCOMM(1:LCOMM),' ') + 1
-
- CHFILE = CHCOMM(LSTART:LCOMM)
- IS(1) = LCOMM - LSTART + 1
-
- IF(IDEBFA.GE.0) PRINT 9004,CHFILE(1:IS(1))
- 9004 FORMAT(' FMRSLN. file name is ',A)
-
- 99 CALL UNLINKF(CHTEMP(1:LTEMP))
-
- END
-#endif
diff --git a/src/packlib/fatmen/fmutil/fmrslv.F b/src/packlib/fatmen/fmutil/fmrslv.F
deleted file mode 100644
index 7c73ca9..0000000
--- a/src/packlib/fatmen/fmutil/fmrslv.F
+++ /dev/null
@@ -1,58 +0,0 @@
-*
-* $Id: fmrslv.F,v 1.1.1.1 1996/03/07 15:18:21 mclareni Exp $
-*
-* $Log: fmrslv.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:21 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMRSLV(DOMAIN,CHOPT,IRC)
-*
-* Get current domain
-*
- CHARACTER*(*) DOMAIN
- CHARACTER*255 CHLINE
-
-#include "fatmen/fatbug.inc"
-#include "fatmen/fatopts.inc"
-
- IRC = 0
- DOMAIN = ' '
-
-#if defined(CERNLIB_UNIX)
-*
-* Read /etc/resolv.conf and look for 'domain xxx'
-*
- CALL CIOPEN(LUNRSL,'r','/etc/resolv.conf',IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.-3) WRITE(LPRTFA,9001) IRC
- 9001 FORMAT(' FMRSLV. error ',I10,' opening /etc/resolv.conf')
- GOTO 999
- ENDIF
-
- 10 CONTINUE
- CALL FMCFGL(LUNRSL,CHLINE,LLINE,' ',ISTAT)
- IF(ISTAT.NE.0) GOTO 30
-
- IF(LLINE.EQ.0) GOTO 10
-*
-* Convert non-printing characters (e.g. tabs) to blanks
-*
- DO 20 I=1,LLINE
- IF(ICHAR(CHLINE(I:I)).LT.32.OR.
- + ICHAR(CHLINE(I:I)).GT.126) CHLINE(I:I) = ' '
- 20 CONTINUE
-
- IDOM = INDEX(CHLINE(1:LLINE),'domain ')
- IF(IDOM.EQ.0) GOTO 10
-
- DOMAIN = CHLINE(INDEXB(CHLINE(1:LLINE),' ')+1:LLINE)
- GOTO 30
-
- 30 CONTINUE
- CALL FMCFGL(LUNRSL,CHLINE,LLINE,'F',ISTAT)
- CALL CICLOS(LUNRSL)
-#endif
-
- 999 END
diff --git a/src/packlib/fatmen/fmutil/fmrtim.F b/src/packlib/fatmen/fmutil/fmrtim.F
deleted file mode 100644
index e554412..0000000
--- a/src/packlib/fatmen/fmutil/fmrtim.F
+++ /dev/null
@@ -1,87 +0,0 @@
-*
-* $Id: fmrtim.F,v 1.1.1.1 1996/03/07 15:18:17 mclareni Exp $
-*
-* $Log: fmrtim.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:17 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMRTIM(ELAPSD)
-*CMZ : 10/04/91 09.13.47 by Jamie Shiers
-*-- Author : Jamie Shiers 10/04/91
-*
-********************************************************************************
-*
-* Routine functionally equivalent to TIMED, but for real time
-*
-* (copied from KUIP)
-*
-********************************************************************************
-*
- CHARACTER*8 ELAPSD
- INTEGER ND(2),NT(2)
- CHARACTER*8 CD,CT
- CHARACTER*(*) DIGIT
- PARAMETER (DIGIT='0123456789')
- INTEGER MONTH(0:12)
- SAVE IOLDAY,IOLSEC
- DATA IOLDAY,IOLSEC /0,0/
- DATA MONTH /0,31,59,90,120,151,181,212,243,273,304,334,365/
-*
- CALL DATIMH(ND,NT)
- CALL UHTOC(ND,4,CD,8)
- CALL UHTOC(NT,4,CT,8)
-*
-* Convert date into number of days from start of year
-*
- NHIGH=INDEX(DIGIT,CD(1:1))-1
- NLOW=INDEX(DIGIT,CD(2:2))-1
- NDAY=NHIGH*10+NLOW
-
- NHIGH=INDEX(DIGIT,CD(4:4))-1
- NLOW=INDEX(DIGIT,CD(5:5))-1
- NMONTH=NHIGH*10+NLOW
-
- NHIGH=INDEX(DIGIT,CD(7:7))-1
- NLOW=INDEX(DIGIT,CD(8:8))-1
- NYEAR=NHIGH*10+NLOW
-
- IDAY=NDAY-1+MONTH(NMONTH-1)
- IF ((NYEAR/4)*4.EQ.NYEAR.AND.NMONTH.GT.2) IDAY=IDAY+1
-*
-* Convert time into number of seconds from start of day
-*
- NHIGH=INDEX(DIGIT,CT(1:1))-1
- NLOW=INDEX(DIGIT,CT(2:2))-1
- NHOUR=NHIGH*10+NLOW
-
- NHIGH=INDEX(DIGIT,CT(4:4))-1
- NLOW=INDEX(DIGIT,CT(5:5))-1
- NMINUT=NHIGH*10+NLOW
-
- NHIGH=INDEX(DIGIT,CT(7:7))-1
- NLOW=INDEX(DIGIT,CT(8:8))-1
- NSECON=NHIGH*10+NLOW
-
- ISEC=NSECON+NMINUT*60+NHOUR*3600
-*
-* Compute the elapsed time from previous call (in HH:MM:SS format)
-*
- IDELAP=IDAY-IOLDAY
- ISELAP=ISEC-IOLSEC
- IOLSEC=ISEC
- IOLDAY=IDAY
- ISEC=MOD(ISELAP,60)
- IMINUT=(MOD(ISELAP,3600)-ISEC)/60
- IHOUR=ISELAP/3600+IDELAP*24
- IF (IHOUR.GT.99) THEN
- WRITE(ELAPSD,1100) IMINUT,ISEC
- ELSE
- WRITE(ELAPSD,1000) IHOUR,IMINUT,ISEC
- ENDIF
-
-1000 FORMAT(I2.2,':',I2.2,':',I2.2)
-1100 FORMAT('**:',I2.2,':',I2.2)
-
- END
diff --git a/src/packlib/fatmen/fmutil/fmshok.F b/src/packlib/fatmen/fmutil/fmshok.F
deleted file mode 100644
index 6359e4f..0000000
--- a/src/packlib/fatmen/fmutil/fmshok.F
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: fmshok.F,v 1.1.1.1 1996/03/07 15:18:18 mclareni Exp $
-*
-* $Log: fmshok.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:18 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMSHOK(CHTITL,KEYS,NKEYS)
- CHARACTER*(*) CHTITL
- DIMENSION KEYS(NKEYS)
-#include "fatmen/fatbank.inc"
-*
-* Prints out KEYS vector in a readable manner with title
-*
- LTITLE = LENOCC(CHTITL)
-
- WRITE(LPRTFA,*) CHTITL(1:LTITLE)
-
- WRITE(LPRTFA,9001) (KEYS(I),I=1,NKEYS-1)
-9001 FORMAT(' Key serial number = ',I6,' filename = ',5A4,
- +' data repr. = ',I3,' media type = ',I2,' location code = ',I6)
- END
-
diff --git a/src/packlib/fatmen/fmutil/fmstop.F b/src/packlib/fatmen/fmutil/fmstop.F
deleted file mode 100644
index 74ac4b8..0000000
--- a/src/packlib/fatmen/fmutil/fmstop.F
+++ /dev/null
@@ -1,15 +0,0 @@
-*
-* $Id: fmstop.F,v 1.1.1.1 1996/03/07 15:18:17 mclareni Exp $
-*
-* $Log: fmstop.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:17 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMSTOP
-*CMZ : 08/05/91 11.30.21 by Jamie Shiers
-*-- Author : Jamie Shiers 08/05/91
- PRINT *,'FMSTOP. terminating due to fatal error.'
- STOP
- END
diff --git a/src/packlib/fatmen/fmutil/fmtdpk.F b/src/packlib/fatmen/fmutil/fmtdpk.F
deleted file mode 100644
index 7807f04..0000000
--- a/src/packlib/fatmen/fmutil/fmtdpk.F
+++ /dev/null
@@ -1,79 +0,0 @@
-*
-* $Id: fmtdpk.F,v 1.1.1.1 1996/03/07 15:18:17 mclareni Exp $
-*
-* $Log: fmtdpk.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:17 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- INTEGER FUNCTION FMTDPK(DATM)
-C LAST CORRECTION DATE IS JULY 14,1989. A. SHEVEL
-C THIS SUBROUTINE WAS PREPARED TO GET DATE !
-C IN PACKED FORM 'YMD' !
- INTEGER IT,ID,IY,IM,K,FMTIME
- CHARACTER*3 DATM
- CHARACTER*1 YY,MM,DD,T(31)
-C
- ICODE=FMTIME(ID,IT)
-C
-C TRANSFORM THE DATE INTO 3-BYTE
-C IN THE FORM 'YMD'
-C
- IY = ID / 10000
- IM = ID / 100 - IY * 100
- ID = ID - (IY * 10000 + IM * 100)
-C
- DO 10 I = 1,10
- K = 80 + (I-1) * 10
- IF ( (IY-K) .LE. 9 ) THEN
- IY = IY - K
- GOTO 1
- ENDIF
-10 CONTINUE
- 1 WRITE (YY,'(I1)') IY
-C
- IF (IM .GT. 12) IM = 12
- IF (IM .LT. 1) IM = 1
-C
- IF (ID .GT. 31) ID = 31
- IF (ID .LT. 1) ID = 1
-C
- T(1) = '1'
- T(2) = '2'
- T(3) = '3'
- T(4) = '4'
- T(5) = '5'
- T(6) = '6'
- T(7) = '7'
- T(8) = '8'
- T(9) = '9'
- T(10) = 'A'
- T(11) = 'B'
- T(12) = 'C'
- T(13) = 'D'
- T(14) = 'E'
- T(15) = 'F'
- T(16) = 'G'
- T(17) = 'H'
- T(18) = 'I'
- T(19) = 'J'
- T(20) = 'K'
- T(21) = 'L'
- T(22) = 'M'
- T(23) = 'N'
- T(24) = 'O'
- T(25) = 'P'
- T(26) = 'Q'
- T(27) = 'R'
- T(28) = 'S'
- T(29) = 'T'
- T(30) = 'U'
- T(31) = 'V'
-C
- DD = T(ID)
- MM = T(IM)
- DATM = YY // MM // DD
- FMTDPK=0
- RETURN
- END
diff --git a/src/packlib/fatmen/fmutil/fmtime.F b/src/packlib/fatmen/fmutil/fmtime.F
deleted file mode 100644
index 3f17c9b..0000000
--- a/src/packlib/fatmen/fmutil/fmtime.F
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: fmtime.F,v 1.1.1.1 1996/03/07 15:18:16 mclareni Exp $
-*
-* $Log: fmtime.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:16 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- INTEGER FUNCTION FMTIME(ID,IT)
-C THIS SUBROUTINE WAS PREPARED TO GET DATE AND TIME !
-C IN THE FORM OF 'YYMMDD' AND 'HHMM' !
- INTEGER ID,IT
- CALL DATIME(ID,IT)
- FMTIME = 0
- RETURN
- END
diff --git a/src/packlib/fatmen/fmutil/fmtovm.F b/src/packlib/fatmen/fmutil/fmtovm.F
deleted file mode 100644
index 25275fe..0000000
--- a/src/packlib/fatmen/fmutil/fmtovm.F
+++ /dev/null
@@ -1,122 +0,0 @@
-*
-* $Id: fmtovm.F,v 1.1.1.1 1996/03/07 15:18:18 mclareni Exp $
-*
-* $Log: fmtovm.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:18 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMTOVM(LUN,FNAME,IRC)
-#include "fatmen/fatsys.inc"
-#if defined(CERNLIB_VAXVMS)
-*
-* Copy file on unit 'lun' to CERNVM
-*
-#include "fatmen/fatbank.inc"
- CHARACTER*(*) FNAME
- CHARACTER*80 CARD
- CHARACTER*128 FILEN
- INTEGER SYSTEMF
- IF(TOPDIR(1:LENOCC(TOPDIR)).NE.'//CERN') RETURN
-
- LSN = LENOCC(SERNAM)
- LFN = LENOCC(FNAME)
- IRC = 0
-
- IF(INDEX(FNAME(1:LFN),SERNAM(1:LSN)//'_'//'CERNVM').NE.0) THEN
- PRINT *,'FMTOVM. file ',FNAME(1:LFN),' originated at CERNVM'
- PRINT *,' will not be sent back'
- RETURN
- ENDIF
-
- FILEN =
- +'CERNVM::"RDR:<'//SERNAM(1:LSN)//'>FATMEN.RDRFILE/CARD/CR"'
- IF(IDEBFA.GE.3) PRINT *,'FMTOVM. sending file ',
- + ' to ',FILEN
- OPEN(LUN,FILE=FNAME(1:LFN),STATUS='OLD',FORM='FORMATTED',
- + ACCESS='SEQUENTIAL')
- ISTAT = LIB$GET_LUN(LUNVM)
-#include "fatmen/fatvaxrc.inc"
- OPEN(UNIT=LUNVM,NAME=FILEN(1:LENOCC(FILEN)),STATUS='NEW',ERR=98)
-1 CONTINUE
- READ(LUN,'(A)',END=99) CARD
- WRITE(LUNVM,'(A)') CARD
- GOTO 1
-98 IRC = 1
-99 CLOSE (LUN)
- CLOSE (LUNVM)
- ISTAT = LIB$FREE_LUN(LUNVM)
-#include "fatmen/fatvaxrc.inc"
- IF ((IRC.EQ.0) .AND.(IDEBFA.GE.-3))
- + WRITE(LPRTFA,*) 'Sent file to ',SERNAM,' at CERNVM'
-#endif
-#if defined(CERNLIB_IBMVM)
- CHARACTER*(*) FNAME
- LSN = LENOCC(SERNAM)
- CALL VMCMS('EXEC FAT2CERN '//SERNAM(1:LSN),IRC)
-#endif
-#if (defined(CERNLIB_UNIX))&&(defined(CERNLIB_CRAY))
- CHARACTER*255 COMAND
- CHARACTER*255 FNAME
- INTEGER SYSTEMF
- COMAND = '/usr/bin/dispose '//FNAME(1:LENOCC(FNAME))//
- + ' -dPU -mVA -t"fn=fatcray,ft=fzfile,tid='//
- + SERNAM(1:LENOCC(SERNAM))//'"'
- ISTAT = SYSTEMF(COMAND(1:LENOCC(COMAND)))
- PRINT *,COMAND
-*dispose <fz-file> -d PU -t'fn=fatcray,ft=fzfile,tid=<fmxxx>' -mVA
-#endif
-#if (defined(CERNLIB_UNIX))&&(!defined(CERNLIB_CRAY))
-*
-* Just move the file to /tovm...
-*
-#include "fatmen/fatbug.inc"
- CHARACTER*(*) FNAME
- CHARACTER*255 FNIN,FNOUT
- CHARACTER*255 STR1,STR2
- INTEGER SYSTEMF
-
- IRC = 0
- CALL FMJOUR(FNOUT)
- LFNIN = LENOCC(FNAME)
- LFNOUT = LENOCC(FNOUT)
- FNIN = FNAME(1:LFNIN)
- LDEF = LENOCC(DEFAULT)
- LSN = LENOCC(SERNAM)
-
- STR1 = SERNAM(1:LSN)//'_CERNVM'
- STR2 = FNAME
- LSTR1 = LSN + 7
- LSTR2 = LFNIN
-
- CALL CUTOL(STR1(1:LSTR1))
- CALL CUTOL(STR2(1:LSTR2))
-
- IF(INDEX(STR2(1:LSTR2),STR1(1:LSTR1)).NE.0) THEN
- PRINT *,'FMTOVM. file ',FNAME(1:LFNIN),' originated at CERNVM'
- PRINT *,' will not be sent back'
- RETURN
- ENDIF
-*
-* Copy the file to the /tovm directory
-*
- IF(IDEBFA.GE.0) PRINT *,'FMTOVM. executing ',
- + 'cp '//FNIN(1:LFNIN)//' '//DEFAULT(1:LDEF)//
- + '/tovm/'//FNOUT(1:LFNOUT)
-
- IRC = SYSTEMF(
- + 'cp '//FNIN(1:LFNIN)//' '//DEFAULT(1:LDEF)//
- + '/tovm/'//FNOUT(1:LFNOUT))
-*
-* Now rename it
-*
- IF(IDEBFA.GE.0) PRINT *,'FMTOVM. executing ',
- + 'mv '//DEFAULT(1:LDEF)//'/tovm/'//FNOUT(1:LFNOUT)
- + //' '//DEFAULT(1:LDEF)//'/tovm/aa'//FNOUT(3:LFNOUT)
-
- IRC = SYSTEMF('mv '//DEFAULT(1:LDEF)//'/tovm/'//FNOUT(1:LFNOUT)
- + //' '//DEFAULT(1:LDEF)//'/tovm/aa'//FNOUT(3:LFNOUT))
-
-#endif
- END
diff --git a/src/packlib/fatmen/fmutil/fmuptm.F b/src/packlib/fatmen/fmutil/fmuptm.F
deleted file mode 100644
index 797eab8..0000000
--- a/src/packlib/fatmen/fmutil/fmuptm.F
+++ /dev/null
@@ -1,65 +0,0 @@
-*
-* $Id: fmuptm.F,v 1.3 1999/08/17 12:45:29 mclareni Exp $
-*
-* $Log: fmuptm.F,v $
-* Revision 1.3 1999/08/17 12:45:29 mclareni
-* Y2k mods submitted by Rob Komar
-*
-* Revision 1.2 1999/01/04 08:13:20 jamie
-* y2k bug in fmuptm
-*
-* Revision 1.1.1.1 1996/03/07 15:18:16 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMUPTM (IDATE, ITIME, IDATM, IRC)
-* ============================================
-*
-************************************************************************
-* *
-* SUBR. FMUPTM (IDATE*, ITIME*, IDATM, IRC*) *
-* *
-* Unpacks date and time from one word *
-* *
-* Arguments : *
-* *
-* IDATE* Date : 6 Decimal integer : YYMMDD *
-* ITIME* Time : 4 Decimal integer : HHMM *
-* IDATM Packed date-time *
-* *
-* Called by <USER> *
-* Modified from original DBUPTM 19/03/90 JDS *
-* *
-************************************************************************
-*
-#include "fatmen/fatbank.inc"
- DATA MXMIN/61/, MXHOU/25/, MXDAY/32/, MXMON/13/, MXYEA/134/
-*
-* ------------------------------------------------------------------
-*
- IRC = 0
- III = IDATM
- IMIN = MOD(III,MXMIN)
- III = (III-IMIN)/MXMIN
- IHOU = MOD(III,MXHOU)
- III = (III-IHOU)/MXHOU
- IDAY = MOD(III,MXDAY)
- III = (III-IDAY)/MXDAY
- IMON = MOD(III,MXMON)
- IYEA = (III-IMON)/MXMON
-
- IF((IYEA.GT.MXYEA) .OR. (IMON.GE.MXMON) .OR. (IDAY.GE.MXDAY) .OR.
- + (IHOU.GE.MXHOU) .OR. (IMIN.GE.MXMIN)) THEN
- IF(IDEBFA.GE.2)
- + PRINT *,'FMUPTM. Invalid PACKed time - IDATE/ITIME set to zero'
- IRC = 1
- IDATE = 0
- ITIME = 0
- ENDIF
-*
- IDATE = IDAY + 100*IMON + 10000*IYEA
- IDATE = MOD(IDATE, 1000000)
- ITIME = IMIN + 100*IHOU
-
- END
diff --git a/src/packlib/fatmen/fmutil/fmupvx.F b/src/packlib/fatmen/fmutil/fmupvx.F
deleted file mode 100644
index af88d1c..0000000
--- a/src/packlib/fatmen/fmutil/fmupvx.F
+++ /dev/null
@@ -1,43 +0,0 @@
-*
-* $Id: fmupvx.F,v 1.1.1.1 1996/03/07 15:18:18 mclareni Exp $
-*
-* $Log: fmupvx.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:18 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMUPVX(CHDATE,ID,IT,IP,IRC)
-*CMZ : 11/07/91 17.12.06 by Jamie Shiers
-*-- Author : Jamie Shiers 11/07/91
-*
-* Unpack date & time into VAX format
-* 11-JUL-1991 17:14:41.37
-* dd-mmm-yyyy hh:mm:ss
-* 123456789_123456789_
-*
- CHARACTER*(*) CHDATE
- CHARACTER*3 MONTHS(12),CHMON
- DATA MONTHS( 1)/'JAN'/,MONTHS( 2)/'FEB'/,
- + MONTHS( 3)/'MAR'/,MONTHS( 4)/'APR'/,
- + MONTHS( 5)/'MAY'/,MONTHS( 6)/'JUN'/,
- + MONTHS( 7)/'JUL'/,MONTHS( 8)/'AUG'/,
- + MONTHS( 9)/'SEP'/,MONTHS(10)/'OCT'/,
- + MONTHS(11)/'NOV'/,MONTHS(12)/'DEC'/
-
-*
-* Unpack from FATMEN bank...
-*
- CALL FMUPTM(ID,IT,IP,IRC)
-
- IYEA = 1900 + ID/10000
- IMON = MOD(ID/100,100)
- IDAY = MOD(ID,100)
- IHOU = IT/100
- IMIN = MOD(IT,100)
-
- WRITE(CHDATE,9001) IDAY,MONTHS(IMON),IYEA,IHOU,IMIN
-9001 FORMAT(I2.2,'-',A3,'-',I4,' ',I2.2,':',I2.2)
- CHDATE(18:23) = ':00.00'
-
- END
diff --git a/src/packlib/fatmen/fmutil/fmurl.F b/src/packlib/fatmen/fmutil/fmurl.F
deleted file mode 100644
index 410b1ee..0000000
--- a/src/packlib/fatmen/fmutil/fmurl.F
+++ /dev/null
@@ -1,193 +0,0 @@
-*
-* $Id: fmurl.F,v 1.1.1.1 1996/03/07 15:18:20 mclareni Exp $
-*
-* $Log: fmurl.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:20 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMURL(GENAM,LBANK,KEYS,
- + CHPROT,CHSERV,CHNAME,CHSGRP,CHBFID,CHOPT,IRC)
-
- CHARACTER*(*) GENAM,CHPROT,CHSERV,CHNAME,CHSGRP,CHBFID,CHOPT
-*
-* Generic name <-> host/serv/grp conversion
-*
-* CHOPT: G (default) get attributes from bank into arg-list
-* P put data from arg-list into bank
-* FMBOOK should be called first to create empty bank
-*
-* fields that are missing (zero length) are taken from
-* configuration file
-*
- PARAMETER (NPOSS=4)
- CHARACTER*8 CHPOSS(NPOSS)
-
- CHARACTER*255 GNAME,CHURL
- CHARACTER*64 STRGRP,STNAME,STSERV
-#include "fatmen/fmnkeys.inc"
- DIMENSION KEYS(LKEYFA),KEYL(LKEYFA)
-#include "fatmen/fatbank.inc"
-#include "fatmen/fatpara.inc"
-#include "fatmen/fatoptd.inc"
- SAVE CHPOSS
-
- DATA CHPOSS(1)/'OSM'/,
- + CHPOSS(2)/'UNITREE'/,
- + CHPOSS(3)/'ADSM'/,
- + CHPOSS(4)/'EMASS'/
-
-#include "fatmen/fatoptc.inc"
-
- IRC = 0
-
- NCH = LENOCC(GENAM)
- IF(NCH.EQ.0) THEN
- IF(IDEBFA.GE.-3) WRITE(LPRTFA,9001)
- 9001 FORMAT(' FMURL. illegal/missing generic name.')
- IRC = 1
- GOTO 999
- ENDIF
-
- IF(IOPTG.EQ.0.AND.IOPTP.EQ.0) IOPTG = 1
-
- IF(IOPTG.NE.0) THEN
- IF (LBANK.EQ.0) THEN
- CALL FMGET(GENAM,LBANK,KEYS,IRC)
- IF (IRC.NE.0) GOTO 999
- ELSE
-*
-* Update keys from bank
-*
- CALL FMUPKY(GENAM,LBANK,KEYS,IRC)
- ENDIF
-*
-* Is this entry a link?
-*
- IF(KEYS(MKLCFA).EQ.0) THEN
- CALL UHTOC(IQ(LBANK+KOFUFA+MFQNFA),4,GNAME,NFQNFA)
- LGN = LENOCC(GNAME)
- IF(IDEBFA.GE.0) WRITE(LPRTFA,9002) GENAM(1:NCH),GNAME(1:
- + LGN)
- 9002 FORMAT(' FMURL. ',A,' --> ',A)
- CALL VZERO(KEYL,LKEYFA)
- CALL FMGET(GENAM,LBANK,KEYL,IRC)
- IF (IRC.NE.0) GOTO 999
- ELSE
- IF(KEYS(MKMTFA).NE.1) THEN
- WRITE(LPRTFA,9003) KEYS(MKMTFA)
- 9003 FORMAT(' FMURL. invalid media type ',I10,
- + ' - only type 1 valid for URLs')
- IRC = 2
- GOTO 999
- ENDIF
- ENDIF
-
- CALL UHTOC(IQ(LBANK+KOFUFA+MFQNFA),4,CHURL,NFQNFA)
- LURL = LENOCC(CHURL)
-*
-* Split URL into component pieces
-* protocol://server-node/store-name/storage-class/bfid
-*
- LSLASH = INDEXB(CHURL(1:LURL),'/')
- IF(LSLASH.EQ.0) GOTO 10
-*
-* BitfileID
-*
- CHBFID = CHURL(LSLASH+1:LURL)
- LURL = LSLASH-1
-
- LSLASH = INDEXB(CHURL(1:LURL),'/')
- IF(LSLASH.EQ.0) GOTO 10
-*
-* Storage-class
-*
- CHSGRP = CHURL(LSLASH+1:LURL)
- LURL = LSLASH-1
-
- LSLASH = INDEXB(CHURL(1:LURL),'/')
- IF(LSLASH.EQ.0) GOTO 10
-*
-* Store-name
-*
- CHNAME = CHURL(LSLASH+1:LURL)
- LURL = LSLASH-1
-
- LSLASH = INDEXB(CHURL(1:LURL),'/')
- IF(LSLASH.EQ.0) GOTO 10
-*
-* Server-node
-*
- CHSERV = CHURL(LSLASH+1:LURL)
- LURL = LSLASH-1
-
- IF(INDEX (CHURL(1:LURL),'/').NE.
- + INDEXB(CHURL(1:LURL),'/')) GOTO 10
-
- GOTO 999
- 10 CONTINUE
- WRITE(LPRTFA,9004)
- 9004 FORMAT(' FMURL. error interpreting URL: ',A)
- IRC = 3
- GOTO 999
-
- ELSEIF(IOPTP.NE.0) THEN
-
- IF(LBANK.EQ.0) THEN
- IF(IDEBFA.GE.-3) WRITE(LPRTFA,9005) CHOPT
- 9005 FORMAT(' FMURL. Error - bank address must be given for option ',A)
- IRC = 98
- GOTO 999
- ENDIF
- LPROT = LENOCC(CHPROT)
- LSERV = LENOCC(CHSERV)
- LNAME = LENOCC(CHNAME)
- LSGRP = LENOCC(CHSGRP)
-
- IF(LPROT.EQ.0) THEN
- IF(IDEBFA.GE.-3) THEN
- WRITE(LPRTFA,9006)
- 9006 FORMAT(' FMURL. error - protocol must be specified.')
- WRITE(LPRTFA,9007) CHPOSS
- 9007 FORMAT(' FMURL. following protocols currently permitted: ',
- + /,(1X,A))
- ENDIF
- IRC = 4
- GOTO 999
- ELSE
-
- JPROT = ICNTHU(CHPROT(1:LPROT),CHPOSS,NPOSS)
- IF(JPROT.EQ.0) THEN
- IF(IDEBFA.GE.-3) THEN
- WRITE(LPRTFA,9008)
- 9008 FORMAT(' FMURL. error - invalid protocol specified - ',A)
- WRITE(LPRTFA,9007)
- ENDIF
- IRC = 5
- GOTO 999
- ENDIF
-*
-* Call FMCLASS and override with information from arg-list
-*
-* CALL FMCLASS(GNAME,STRGRP,STNAME,STSERV,CHOPT,IRC)
- IF(IRC.NE.0) GOTO 999
- LGRP = LENOCC(STRGRP)
-
- IF(LSGRP.EQ.0) CHSGRP = STRGRP(1:LENOCC(STRGRP))
- IF(LNAME.EQ.0) CHNAME = STNAME(1:LENOCC(STNAME))
- IF(LSERV.EQ.0) CHSERV = STSERV(1:LENOCC(STSERV))
-*
-* now build URL and stuff it back into bank
-*
- CHURL = CHPROT(1:LPROT)//'://'//CHSERV(1:LSERV)//'/'//
- + CHNAME(1:LNAME)//'/'//CHSGRP(1:LSGRP)//'/?'
- LURL = LPROT + LSERV + LNAME + LSGRP + 7
-
- CALL FMPUTC(LBANK,CHURL(1:LURL),MFQNFA,LURL,IRC)
-
- ENDIF
-
- ENDIF
-
- 999 END
diff --git a/src/packlib/fatmen/fmutil/fmuser.F b/src/packlib/fatmen/fmutil/fmuser.F
deleted file mode 100644
index b3bfa35..0000000
--- a/src/packlib/fatmen/fmutil/fmuser.F
+++ /dev/null
@@ -1,116 +0,0 @@
-*
-* $Id: fmuser.F,v 1.1.1.1 1996/03/07 15:18:16 mclareni Exp $
-*
-* $Log: fmuser.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:16 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
-#if !defined(CERNLIB_UNIX)
- INTEGER FUNCTION FMUSER(USER)
- CHARACTER*8 USER
-#if defined(CERNLIB_IBMVM)
- CHARACTER*80 CHLINE
-#endif
-#if (defined(CERNLIB_IBMVM))&&(defined(CERNLIB_HEPVM))
- DIMENSION SPACE(32)
- LOGICAL BATCH,JOB$VM
- CHARACTER*8 INFO(10)
- EQUIVALENCE (INFO(1),SPACE(1))
- EQUIVALENCE (TIME,SPACE(21))
- EQUIVALENCE (TNORM,SPACE(23))
- EQUIVALENCE (MACH,SPACE(25))
-C
- BATCH = JOB$VM(SPACE)
- USER = INFO(1)
- FMUSER = 0
-#endif
-#if (defined(CERNLIB_IBMVM))&&(!defined(CERNLIB_VMBATCH))&&(!defined(CERNLIB_HEPVM))
- FMUSER = 0
- CALL VMCMS('IDENTIFY (STACK LIFO',IRC)
- CALL VMRTRM(CHLINE,LLINE)
- USER = CHLINE(1:LLINE)
-#endif
-#if (defined(CERNLIB_IBMVM))&&(defined(CERNLIB_VMBATCH))
- FMUSER = 0
-*
-* Are we in batch?
-*
- CALL VMCMS('IDENTIFY (STACK LIFO',IRC)
- CALL VMRTRM(CHLINE,LLINE)
- IF(CHLINE(1:5).EQ.'VMBAT') THEN
- CALL VMCMS('VMBATCH SERVICE STACK $USER',IRC)
- IF(IRC.EQ.0) THEN
- CALL VMRTRM(CHLINE,LLINE)
- USER = CHLINE(1:LLINE)
- ELSE
- IF(IDEBFA.GE.-3) PRINT *,'FMUSER. cannot determine ',
- + 'username. Using *UNKNOWN'
- USER = '*UNKNOWN'
- FMUSER = 1
- ENDIF
- ELSE
- USER = CHLINE(1:LLINE)
- ENDIF
-#endif
-#if defined(CERNLIB_VAXVMS)
- CHARACTER*12 CHUSER
- INCLUDE '($JPIDEF)'
- INTEGER SYS$GETJPIW
- STRUCTURE /ITMLST/
- UNION
- MAP
- INTEGER*2 BUFFER_LENGTH
- INTEGER*2 ITEM_CODE
- INTEGER*4 BUFFER_ADDRESS
- INTEGER*4 RETURN_LENGTH_ADDRESS
- ENDMAP
- MAP
- INTEGER*4 END_LIST /0/
- ENDMAP
- END UNION
- END STRUCTURE
-
- RECORD /ITMLST/ JPI_LIST(2)
-
- JPI_LIST(1).BUFFER_LENGTH = 12
- JPI_LIST(1).ITEM_CODE = JPI$_USERNAME
- JPI_LIST(1).BUFFER_ADDRESS = %LOC(CHUSER)
- JPI_LIST(1).RETURN_LENGTH_ADDRESS = %LOC(LENU)
-
- JPI_LIST(2).END_LIST = 0
-
- ISTAT = SYS$GETJPIW(,,,JPI_LIST,,,)
- IF (.NOT. ISTAT) CALL LIB$SIGNAL(%VAL(ISTAT))
- LUSER = MIN(8,LENOCC(USER))
- USER = CHUSER(1:LUSER)
- IF (ISTAT.NE.0) THEN
- FMUSER=1
- ENDIF
-#endif
-#if (defined(CERNLIB_IBMMVS))&&(defined(CERNLIB_NEWLIB))
- CHARACTER*16 NAMES
- CHARACTER*80 VARIABLE,VALUE
- CALL JOBNAM(NAMES)
- USER(1:8) = NAMES
- FMUSER = 0
-#endif
-#if (defined(CERNLIB_IBMMVS))&&(!defined(CERNLIB_NEWLIB))
- LOGICAL INTRAC
- IF(INTRAC(DUMMY)) THEN
-*-- interactive mode
- NCH = 8
- FMUSER = ISPLNK('VCOPY','(ZUSER)',NCH,USER,'MOVE')
- IF(FMUSER.NE.0) THEN
- USER = 'unknown'
- ENDIF
- ELSE
-*-- batch mode
- FMUSER = FMJOBN(USER)
- USER(7:8) = ' '
- ENDIF
-#endif
- RETURN
- END
-#endif
diff --git a/src/packlib/fatmen/fmutil/fmword.F b/src/packlib/fatmen/fmutil/fmword.F
deleted file mode 100644
index f9a5a76..0000000
--- a/src/packlib/fatmen/fmutil/fmword.F
+++ /dev/null
@@ -1,52 +0,0 @@
-*
-* $Id: fmword.F,v 1.1.1.1 1996/03/07 15:18:17 mclareni Exp $
-*
-* $Log: fmword.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:17 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMWORD(DEST,IELEM,DELIM,SOURCE,IRC)
-*
-* Routine to return a word delimited by the specified character
-* Word 0 is the text preceding the first delimiter etc.
-*
- CHARACTER*(*) DEST,SOURCE
- CHARACTER*1 DELIM
-*
- IF (IELEM .LT. 0) THEN
- DEST = ' '
- IRC = 1
- RETURN
- ENDIF
-*
- IF (IELEM .EQ. 0) THEN
- IEND = INDEX(SOURCE,DELIM)
- IF(IEND.EQ.0) THEN
- IEND = LENOCC(SOURCE)
- ELSE
- IEND = IEND - 1
- ENDIF
- DEST = SOURCE(1:IEND)
- RETURN
- ENDIF
-*
-* Find start and end of string
-*
- ISTART = 0
- IEND = LENOCC(SOURCE)
- ILOC = 1
-*
-* Word IELEM is between IELEM and IELEM+1th occurance of
-* DELIM in SOURCE
-*
- DO 10 I=1,IELEM+1
- ILOC = ISTART + 1
- ITEMP = INDEX(SOURCE(ILOC:IEND),DELIM)
- IF (I .LE. IELEM) ISTART = ISTART + ITEMP
- IF (I .EQ. IELEM+1) IEND = ISTART + ITEMP - 1
- 10 CONTINUE
- IF (ITEMP .EQ. 0) IEND = LENOCC(SOURCE)
- DEST = SOURCE(ISTART+1:IEND)
- END
diff --git a/src/packlib/fatmen/fmvax/Imakefile b/src/packlib/fatmen/fmvax/Imakefile
deleted file mode 100644
index f797352..0000000
--- a/src/packlib/fatmen/fmvax/Imakefile
+++ /dev/null
@@ -1,9 +0,0 @@
-SRCS_F= fafndf.F fastgq.F fastgs.F fmbalq.F fmbque.F fmcstg.F \ @@\
- fmlook.F fmqstg.F fmquot.F fmrack.F fmrqui.F fmrstg.F \ @@\
- fmstgc.F fmstgp.F fmvaxc.F fmvusr.F fmwto.F
-
-#if defined(CERNLIB_VAXVMS)
-SRCS_F := $(SRCS_F) fmgtel.F fmgtlg.F fmxdsk.F
-#endif
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/fatmen/fmvax/fafndf.F b/src/packlib/fatmen/fmvax/fafndf.F
deleted file mode 100644
index 8e3910d..0000000
--- a/src/packlib/fatmen/fmvax/fafndf.F
+++ /dev/null
@@ -1,105 +0,0 @@
-*
-* $Id: fafndf.F,v 1.1.1.1 1996/03/07 15:18:23 mclareni Exp $
-*
-* $Log: fafndf.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:23 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- INTEGER FUNCTION FAFNDF(CHPATH,CHFILE,ICONT)
-*
-* FORTRAN interface to LIB$FIND_FILE
-*
- CHARACTER*(*) CHPATH,CHFILE
- CHARACTER*255 CHMESS,CHWTOM,EQUNAM
- INTEGER STATUS
- INTEGER SYS$GET_MSG
- INCLUDE '($SSDEF)'
- PARAMETER (DEFSNO=60.)
- PARAMETER (DEFSLP=1800.)
- PARAMETER (DEFTRY=10)
-#include "fatmen/slate.inc"
-#include "fatmen/fatbug.inc"
-*
-* Get short and long wait times and retry count
-*
- CALL FMGTLG('FATMEN_SNETWT',EQUNAM,'LNM$_SYSTEM',IRC)
- IF(IRC.EQ.0) THEN
- IVAL = ICDECI(EQUNAM,1,IS(1))
- SNOOZE = IVAL
- ELSE
- SNOOZE = DEFSNO
- ENDIF
-
- CALL FMGTLG('FATMEN_LNETWT',EQUNAM,'LNM$_SYSTEM',IRC)
- IF(IRC.EQ.0) THEN
- IVAL = ICDECI(EQUNAM,1,IS(1))
- SLEEP = IVAL
- ELSE
- SLEEP = DEFSLP
- ENDIF
-
- CALL FMGTLG('FATMEN_RETRY' ,EQUNAM,'LNM$_SYSTEM',IRC)
- IF(IRC.EQ.0) THEN
- MAXTRY = ICDECI(EQUNAM,1,IS(1))
- ELSE
- MAXTRY = DEFTRY
- ENDIF
-
- NTRY = 0
- WTTIME = SNOOZE
- LPATH = LENOCC(PATH)
- 10 CONTINUE
- NTRY = NTRY + 1
- FAFNDF = LIB$FIND_FILE(CHPATH,CHFILE,ICONT,,,ISTAT,)
- ICODE = LIB$FIND_FILE_END(ICONT)
- IF(ISTAT.NE.SS$_UNREACHABLE) RETURN
-
- IF(IDEBFA.GE.0) THEN
- PRINT 9001,ISTAT
- 9001 FORMAT(' FAFNDF. return code ',I10,' from LIB$FIND_FILE')
- ICODE = SYS$GETMSG(%VAL(ISTAT),LMESS,CHMESS,,)
- PRINT 9002,CHMESS(1:LMESS)
- 9002 FORMAT(' FAFNDF. message text = ',A)
- ENDIF
-
- IF(NTRY.LE.MAXTRY) THEN
- IF(IDEBFA.GE.0) PRINT 9003,WTTIME,NTRY
- 9003 FORMAT(' FAFNDF. sleeping for ',F5.0,
- + ' seconds before retry number ',I3)
- IF(WTTIME.EQ.SLEEP) THEN
- CHWTOM = ' '
- WRITE(CHWTOM,9004) CHMESS(1:LMESS),CHPATH(1:LPATH)
- 9004 FORMAT('FATMEN-W-FAFNDF, error ',A,' accessing ',A)
- LWTOM = LENOCC(CHWTOM)
- CALL FMWTO(CHWTOM,LWTOM,IRC)
- ENDIF
- ELSE
- IF(WTTIME.EQ.SNOOZE) THEN
- NTRY = 1
- WTTIME = SLEEP
- IF(IDEBFA.GE.0) PRINT 9005,WTTIME,MAXTRY
- 9005 FORMAT(' FAFNDF. switching to long sleep ',F5.0,
- + ' after ',I3,' retries at ',F5.0,' seconds')
- CHWTOM = ' '
- WRITE(CHWTOM,9004) CHMESS(1:LMESS),CHPATH(1:LPATH)
- LWTOM = LENOCC(CHWTOM)
- CALL FMWTO(CHWTOM,IWTOM,IRC)
- ICODE = LIB$WAIT(WTTIME)
- GOTO 10
- ELSE
- IF(IDEBFA.GE.0) PRINT 9006,MAXTRY
- 9006 FORMAT(' FAFNDF. giving up after ',I3,' retries')
- ENDIF
- ENDIF
-
- IF(NTRY.GT.MAXTRY) THEN
- FAFNDF = ISTAT
- RETURN
- ENDIF
-
- ICODE = LIB$WAIT(WTTIME)
- GOTO 10
-
- END
diff --git a/src/packlib/fatmen/fmvax/fastgq.F b/src/packlib/fatmen/fmvax/fastgq.F
deleted file mode 100644
index 51f98ae..0000000
--- a/src/packlib/fatmen/fmvax/fastgq.F
+++ /dev/null
@@ -1,79 +0,0 @@
-*
-* $Id: fastgq.F,v 1.1.1.1 1996/03/07 15:18:22 mclareni Exp $
-*
-* $Log: fastgq.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:22 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- subroutine fastgq(jobnum,chmess,irc)
- implicit integer (s)
-
- structure /itmlst/
- union
- map
- integer*2 buffer_length
- integer*2 item_code
- integer*4 buffer_address
- integer*4 return_length_address
- endmap
- map
- integer*4 end_list /0/
- endmap
- end union
- end structure
-
- record /itmlst/ qui_list(3)
-
- integer*4 iosb(2)
- include '($quidef)'
- include '($jbcmsgdef)'
- include '($sjcdef)'
-
- character*(*) chmess
-
- irc = 0
-*
-* Issue batch query for specified job entry
-*
- qui_list(1).buffer_length = 4
- qui_list(1).item_code = qui$_job_status
- qui_list(1).buffer_address = %loc(jobsta)
- qui_list(1).return_length_address = %loc(lenjob)
-
- qui_list(2).buffer_length = 4
- qui_list(2).item_code = qui$_search_number
- qui_list(2).buffer_address = %loc(jobnum)
- qui_list(2).return_length_address = %loc(lenjob)
-
- qui_list(3).end_list = 0
-
- status = sys$getquiw
- + (,%val(qui$_display_entry),,qui_list,iosb,,)
- if (.not. status) call lib$signal(%val(status))
-*
-* Has job completed?
-*
- if(iosb(1).eq.jbc$_nosuchent) then
- chmess = 'COMPLETED'
- elseif(iosb(1).eq.jbc$_normal) then
- if(jobsta.eq.qui$m_job_aborting) then
- chmess = 'ABORTING'
- elseif(jobsta.eq.qui$m_job_executing) then
- chmess = 'EXECUTING'
- elseif(jobsta.eq.qui$m_job_pending) then
- chmess = 'PENDING'
- else
- irc = jobsta
- WRITE(CHMESS,9001) IRC,IRC
- endif
- else
- irc = iosb(1)
- WRITE(CHMESS,9001) IRC,IRC
- endif
-
-9001 format(' unexpected return code ',I10,' (hex = ',Z8,
- + ') from SYS$GETQUIW')
-
- end
diff --git a/src/packlib/fatmen/fmvax/fastgs.F b/src/packlib/fatmen/fmvax/fastgs.F
deleted file mode 100644
index 3b87363..0000000
--- a/src/packlib/fatmen/fmvax/fastgs.F
+++ /dev/null
@@ -1,152 +0,0 @@
-*
-* $Id: fastgs.F,v 1.1.1.1 1996/03/07 15:18:22 mclareni Exp $
-*
-* $Log: fastgs.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:22 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- subroutine fastgs(chfile,chgen,chcomm,jobnum,chmess,irc)
- implicit integer (s)
-
- structure /itmlst/
- union
- map
- integer*2 buffer_length
- integer*2 item_code
- integer*4 buffer_address
- integer*4 return_length_address
- endmap
- map
- integer*4 end_list /0/
- endmap
- end union
- end structure
-
- record /itmlst/ jbc_list(9)
-
- integer*4 iosb(2)
- include '($sjcdef)'
- include '($jbcmsgdef)'
- character*(*) chfile,chgen,chcomm,chmess
- character*255 chque,chdcl,chstat,chlogs
-
-#include "fatmen/fatbug.inc"
-
- irc = 0
- lfile = lenocc(chfile)
- lgen = lenocc(chgen)
- lcomm = lenocc(chcomm)
-*
-* Create temporary command file
-*
- ic = lib$get_lun(luncom)
- if(.not.ic) call lib$signal(%val(ic))
-
- chdcl = chfile(1:lfile) // '.com'
- ldcl = lfile + 4
-
- open(luncom,status='new',form='formatted',
- + carriagecontrol='list',recl=255,
- + file=chdcl(1:ldcl),iostat=istat)
-
- if(istat.ne.0) then
- print *,'FASTGS. cannot create temporary file ',
- + chdcl(1:ldcl)
- irc = -1
- chmess = 'error creating temporary file'
- return
- endif
-
- write(luncom,'(A)') '$SET NOON '
- write(luncom,'(A)') '$SET VERIFY'
- write(luncom,'(A)') chcomm(1:lcomm)
-
- close(luncom)
-
- ic = lib$free_lun(luncom)
-*
-* Directory for log files
-*
- chlogs = 'STAGE_LOGS:'
- llogs = 11
-*
-* Queue name
-*
- chque = 'STAGE_' // chgen(1:lgen) // 'S'
- lque = lgen + 7
-*
-* jbc item codes:
-*
-* sjc$_delete_file - delete command file on job completion
-* sjc$_entry_number_output - get back job entry number
-* sjc$_job_status_output - job status message
-*
-
- jbc_list(1).buffer_length = ldcl
- jbc_list(1).item_code = sjc$_file_specification
- jbc_list(1).buffer_address = %loc(chdcl)
- jbc_list(1).return_length_address = %loc(lenfile)
-
- jbc_list(2).buffer_length = llogs
- jbc_list(2).item_code = sjc$_log_specification
- jbc_list(2).buffer_address = %loc(chlogs)
- jbc_list(2).return_length_address = %loc(lenl)
-
- jbc_list(3).buffer_length = lque
- jbc_list(3).item_code = sjc$_queue
- jbc_list(3).buffer_address = %loc(chque)
- jbc_list(3).return_length_address = %loc(lenq)
-
- jbc_list(4).buffer_length = 4
- jbc_list(4).item_code = sjc$_delete_file
- jbc_list(4).buffer_address = %loc(0)
- jbc_list(4).return_length_address = %loc(lendel)
-
- jbc_list(5).buffer_length = 4
- jbc_list(5).item_code = sjc$_no_notify
- jbc_list(5).buffer_address = %loc(0)
- jbc_list(5).return_length_address = %loc(lennot)
-
- jbc_list(6).buffer_length = 4
- jbc_list(6).item_code = sjc$_no_log_spool
- jbc_list(6).buffer_address = %loc(0)
- jbc_list(6).return_length_address = %loc(lenspl)
-
- jbc_list(7).buffer_length = 4
- jbc_list(7).item_code = sjc$_entry_number_output
- jbc_list(7).buffer_address = %loc(jobnum)
- jbc_list(7).return_length_address = %loc(lenjob)
-
- jbc_list(8).buffer_length = 255
- jbc_list(8).item_code = sjc$_job_status_output
- jbc_list(8).buffer_address = %loc(chmess)
- jbc_list(8).return_length_address = %loc(lenmsg)
-
- jbc_list(9).end_list = 0
-
- status = sys$sndjbcw
- + (,%val(sjc$_enter_file),,jbc_list,iosb,,)
- if (.not. status) call lib$signal(%val(status))
-*
-* jbc$_normal
-*
- if (iosb(1) .eq. jbc$_normal) then
-*
-* Send back success message and job entry number
-*
-
- else
-
-*
-* Send back failure message and error text
-*
- status = sys$getmsg(%val(iosb(1)),lenmsg,chmess,,)
- if (.not. status) call lib$signal(%val(status))
- irc = iosb(1)
- jobnum = -1
-
- endif
-
- end
diff --git a/src/packlib/fatmen/fmvax/fmbalq.F b/src/packlib/fatmen/fmvax/fmbalq.F
deleted file mode 100644
index abb8447..0000000
--- a/src/packlib/fatmen/fmvax/fmbalq.F
+++ /dev/null
@@ -1,36 +0,0 @@
-*
-* $Id: fmbalq.F,v 1.1.1.1 1996/03/07 15:18:21 mclareni Exp $
-*
-* $Log: fmbalq.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:21 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- INTEGER FUNCTION FMBALQ(FAB,RAB,LUN)
-*CMZ : 25/09/91 16.24.40 by Jamie Shiers
-*-- Author : Jamie Shiers 25/09/91
- IMPLICIT INTEGER S
- INCLUDE '($FABDEF)'
- INCLUDE '($RABDEF)'
- INCLUDE '($RMSDEF)'
-
- RECORD /FABDEF/ FAB
- RECORD /RABDEF/ RAB
-
-#include "fatmen/fabalq.inc"
-
- INTEGER LUN,RECFM
-
- RECFM = FAB.FAB$B_RFM
-
- STATUS = SYS$OPEN(FAB)
- IF(.NOT.STATUS) GOTO 99
-
- NBLOKS = FAB.FAB$L_ALQ
-
- FMBALQ = 0
- RETURN
-
-99 FMBALQ = 1
- END
diff --git a/src/packlib/fatmen/fmvax/fmbque.F b/src/packlib/fatmen/fmvax/fmbque.F
deleted file mode 100644
index 240e9ba..0000000
--- a/src/packlib/fatmen/fmvax/fmbque.F
+++ /dev/null
@@ -1,65 +0,0 @@
-*
-* $Id: fmbque.F,v 1.1.1.1 1996/03/07 15:18:23 mclareni Exp $
-*
-* $Log: fmbque.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:23 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMBQUE(CHQUE,QUEUE_NAME_LEN)
-
- CHARACTER*(*) CHQUE
- STRUCTURE /ITMLST/
- UNION
- MAP
- INTEGER*2 BUFFER_LENGTH
- INTEGER*2 ITEM_CODE
- INTEGER*4 BUFFER_ADDRESS
- INTEGER*4 RETURN_LENGTH_ADDRESS
- ENDMAP
- MAP
- INTEGER*4 END_LIST /0/
- ENDMAP
- END UNION
- END STRUCTURE
-
-
- STRUCTURE /IOSBLK/
- INTEGER*4 STS,ZEROED
- END STRUCTURE
-
- RECORD /IOSBLK/ IOSB
- RECORD /ITMLST/ QUEUE_LIST(4)
-
- CHARACTER*31 QUEUE_NAME
- INTEGER*4 QUEUE_NAME_LEN
- INTEGER*4 SEARCH_FLAGS,QSTATUS
- INCLUDE '($QUIDEF)'
-
- SEARCH_FLAGS = QUI$_QUEUE_NAME
- LQUE = LENOCC(CHQUE)
-
- QUEUE_LIST(1).BUFFER_LENGTH = LQUE
- QUEUE_LIST(1).ITEM_CODE = QUI$_SEARCH_NAME
- QUEUE_LIST(1).BUFFER_ADDRESS = %LOC(CHQUE)
- QUEUE_LIST(1).RETURN_LENGTH_ADDRESS = 0
-
- QUEUE_LIST(2).BUFFER_LENGTH = 4
- QUEUE_LIST(2).ITEM_CODE = QUI$_SEARCH_FLAGS
- QUEUE_LIST(2).BUFFER_ADDRESS = %LOC(SEARCH_FLAGS)
- QUEUE_LIST(2).RETURN_LENGTH_ADDRESS = 0
-
- QUEUE_LIST(3).BUFFER_LENGTH = 31
- QUEUE_LIST(3).ITEM_CODE = QUI$_QUEUE_NAME
- QUEUE_LIST(3).BUFFER_ADDRESS = %LOC(QUEUE_NAME)
- QUEUE_LIST(3).RETURN_LENGTH_ADDRESS = %LOC(QUEUE_NAME_LEN)
-
- QUEUE_LIST(4).END_LIST = 0
-
- QSTATUS = SYS$GETQUIW (,%VAL(QUI$_CANCEL_OPERATION),,,,,)
-
- QSTATUS = SYS$GETQUIW
- + (,%VAL(QUI$_DISPLAY_QUEUE),,QUEUE_LIST,IOSB,,)
-
- END
diff --git a/src/packlib/fatmen/fmvax/fmcstg.F b/src/packlib/fatmen/fmvax/fmcstg.F
deleted file mode 100644
index 0b8e520..0000000
--- a/src/packlib/fatmen/fmvax/fmcstg.F
+++ /dev/null
@@ -1,314 +0,0 @@
-*
-* $Id: fmcstg.F,v 1.1.1.1 1996/03/07 15:18:22 mclareni Exp $
-*
-* $Log: fmcstg.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:22 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMCSTG(CHFILE,CHTYPE,CHCOMM,ISIZE,CHOPT,IRC)
-*CMZ : 17/02/92 16.34.31 by Jamie Shiers
-*-- Author : Jamie Shiers 17/02/92
- CHARACTER*(*) CHFILE,CHTYPE,CHCOMM
- CHARACTER*255 CHNAME,CHMESS,CHLINE,JOBNAM,CHFULL
- LOGICAL MYFILE,QUEUED
-#include "fatmen/fmqued.inc"
-#include "fatmen/farstg.inc"
-#include "fatmen/fatbug.inc"
-#include "fatmen/slate.inc"
-#include "fatmen/fatopts.inc"
-
- IRC = 0
- MYFILE = .FALSE.
- QUEUED = .FALSE.
- LFILE = LENOCC(CHFILE)
- LTYPE = LENOCC(CHTYPE)
- LCOMM = LENOCC(CHCOMM)
-
- IF(IDEBFA.GE.3) PRINT *,'FMCSTG. enter for ',
- + 'file,type,comm = ',
- + CHTYPE(1:LTYPE),' ',CHFILE(1:LFILE),CHCOMM(1:LCOMM)
-
- LDOT = INDEX(CHFILE(1:LFILE),'.')
- CHNAME = CHFILE(1:LFILE)
- CHNAME(LDOT:LDOT) = '_'
-*
-* FULLTAPE list
-*
- CALL FMGTLG('STAGE_FULLTAPE',CHFULL,'LNM$SYSTEM',ISTAT)
- LFULL = IS(1)
-*
-* Look if there already is a job accessing the tape that
-* we want in any of the staging queues
-*
- JOBNAM=' '
- 10 CONTINUE
- CALL FMLOOK(CHNAME(1:LDOT-1),'*STAGE*',JOBNAM,JOBNUM)
-
- IF(JOBNUM.GT.0) THEN
-
- CALL DATIME(ID,IT)
-
- IF(IDEBFA.GE.0) PRINT *,'FMCSTG. tape used by job ',
- + JOBNAM(1:LENOCC(JOBNAM))
- IF(IDEBFA.GE.0) PRINT *,' the time now is ',ID,IT
- IF(IOPTQ.EQ.0.AND.LQUED.EQ.0.AND.IDEBFA.GE.0)
- + PRINT *,' waiting until tape is free'
- NCNAME=INDEX(CHNAME(LDOT+1:LFILE),'_')+LDOT-1
- NJNAME=INDEX(JOBNAM(LDOT+1:LFILE),'_')+LDOT-1
- IF(CHNAME(LDOT+1:NCNAME).EQ.
- + JOBNAM(LDOT+1:NJNAME)) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMCSTG. The other job is staging ',
- + 'the same file !'
- IF(IOPTQ.NE.0) RETURN
- ELSE
- IF(IDEBFA.GE.0) PRINT *,'FMCSTG. The other job is staging ',
- + 'another file.'
- IF(IOPTQ.NE.0.AND.
- + INDEX(CHFULL(1:LFULL),CHTYPE(1:LTYPE)).NE.0) RETURN
-*
-* If we are in server mode, queue request
-*
- IF(LQUED.GT.0.AND..NOT.QUEUED) THEN
-C
-C **** check if the job is a real staging job
-C
- IF (JOBNAM(LDOT+1:NJNAME).NE.'XX') THEN
- QUEUED = .TRUE.
- CALL FMQSTG(CHFILE,IRC)
-C
-C **** check if the job is still there
-C
- CALL SLEEPF(IWTACK)
- JOBNAM=' '
- CALL FMLOOK(CHNAME(1:LDOT-1),'*STAGE*',JOBNAM,JOBNUM)
- IF (JOBNUM.EQ.0) THEN
- GOTO 30
- ELSEIF(JOBNUM.LT.0) THEN
- IF(IDEBFA.GE.-3) PRINT *, 'FMCSTG. FMLOOK failed'
- ENDIF
-
- ENDIF
-
- ENDIF
-
- IF(IOPTQ.NE.0) RETURN
- ENDIF
-
- IWAIT = IWTPND
- 20 CONTINUE
- IF(IDEBFA.GE.0) PRINT *,'FMCSTG. please wait - next job ',
- + 'status in ',IWAIT,' seconds'
- CALL SLEEPF(IWAIT)
-
- CALL FASTGQ(JOBNUM,CHMESS,IRC)
- LMESS = LENOCC(CHMESS)
-
- CALL DATIME(ID,IT)
-
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMCSTG. unexpected status from ',
- + 'job inquiry - ',IRC
- GOTO 70
- ELSE
- IF(IDEBFA.GE.0) PRINT *,'FMCSTG. status at ',ID,IT,' = ',
- + CHMESS(1:LMESS)
- ENDIF
-*
-* Job pending, executing or disappeared?
-*
- IF(INDEX(CHMESS(1:LMESS),'PENDING').NE.0) THEN
-*
-* Check whether they already were kind enough to stage the file
-* that we want
-*
- CALL FMSTGC(CHFILE(1:LFILE),ISIZE,JSIZE,IFOUND)
- IF(IFOUND.EQ.0) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMCSTG. The file we want ',
- + 'is on now on disk!'
- GOTO 70
- ENDIF
- GOTO 20
- ELSEIF(INDEX(CHMESS(1:LMESS),'EXECUTING').NE.0) THEN
- IWAIT = IWTEXE
-*
-* Check whether they already were kind enough to stage the file
-* that we want
-*
- CALL FMSTGC(CHFILE(1:LFILE),ISIZE,JSIZE,IFOUND)
- IF(IFOUND.EQ.0) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMCSTG. The file we want ',
- + 'is on now on disk!'
- GOTO 70
- ENDIF
- GOTO 20
- ELSEIF(INDEX(CHMESS(1:LMESS),'COMPLETED').NE.0) THEN
- IF(IDEBFA.GE.1) PRINT *,'FMCSTG. job has completed - ',
- + 'we can continue'
- ENDIF
-*
-* Check whether they were kind enough to stage the file
-* that we want
-*
- CALL FMSTGC(CHFILE(1:LFILE),ISIZE,JSIZE,IFOUND)
- IF(IFOUND.EQ.0) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMCSTG. and the file we want ',
- + 'is on now on disk!'
- GOTO 70
- ELSE
- GOTO 10
- ENDIF
- ELSEIF (JOBNUM.LT.0) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMCSTG. FMLOOK failed'
- ENDIF
-
- 30 CONTINUE
-*
-* Submit job
-*
- CHMESS=' '
- CALL FASTGS(CHNAME(1:LFILE),CHTYPE(1:LTYPE),CHCOMM(1:LCOMM),
- + JOBNUM,CHMESS,IRC)
-
- LMESS = LENOCC(CHMESS)
-
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMCSTG. error submitting ',
- + 'stage job - ',CHMESS(1:LMESS)
- RETURN
- ENDIF
-
- CALL DATIME(ID,IT)
-
- IF(IDEBFA.GE.0) PRINT *,'FMCSTG. submit status at ',
- + ID,IT,' = ',CHMESS(1:LMESS)
- IF(IOPTQ.NE.0) RETURN
-*
-* Check batch queue until job is finished
-*
- IWAIT = IWTPND
- 40 CONTINUE
- IF(IDEBFA.GE.0) PRINT *,'FMCSTG. please wait - next job ',
- + 'status in ',IWAIT,' seconds'
- CALL SLEEPF(IWAIT)
-
- CALL FASTGQ(JOBNUM,CHMESS,IRC)
-
- LMESS = LENOCC(CHMESS)
-
- CALL DATIME(ID,IT)
-
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMCSTG. unexpected status from ',
- + 'job inquiry - ',IRC
- GOTO 70
- ELSE
- IF(IDEBFA.GE.0) PRINT *,'FMCSTG. status at ',ID,IT,' = ',
- + CHMESS(1:LMESS)
- ENDIF
-*
-* Job pending, executing or disappeared?
-*
- IF(INDEX(CHMESS(1:LMESS),'PENDING').NE.0) THEN
-*
-* First check if the file has been staged successfully
-* (maybe by someone else)
-*
- CALL FMSTGC(CHFILE(1:LFILE),ISIZE,JSIZE,IFOUND)
-
- IF(IFOUND.EQ.0) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMCSTG. The file we want ',
- + 'is on now on disk!'
- GOTO 70
- ENDIF
- GOTO 40
- ELSEIF(INDEX(CHMESS(1:LMESS),'EXECUTING').NE.0) THEN
- IWAIT = IWTEXE
-*
-* First check if the file has been staged successfully
-* (maybe by someone else)
-*
- CALL FMSTGC(CHFILE(1:LFILE),ISIZE,JSIZE,IFOUND)
-
- IF(IFOUND.EQ.0) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMCSTG. The file we want ',
- + 'is on now on disk!'
- GOTO 70
- ENDIF
- GOTO 40
-
- ELSEIF(INDEX(CHMESS(1:LMESS),'COMPLETED').NE.0) THEN
-*
-* Now check stage log file
-*
- ISTAT = LIB$GET_LUN(LUNSTG)
-#include "fatmen/fatvaxrc.inc"
- OPEN(LUNSTG,FILE='STAGE_LOGS:'//
- + CHNAME(1:LFILE)//'.LOG',FORM='FORMATTED',
- + STATUS='OLD',READONLY,IOSTAT=ISTAT)
- IF(ISTAT.NE.0) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMCSTG. cannot open ',
- + 'stage log file'
- CALL LIB$FREE_LUN(LUNSTG)
- GOTO 70
- ENDIF
-
- IF(IDEBFA.GE.0) THEN
- PRINT *
- PRINT *,'FMCSTG. stage log file follows...'
- PRINT *
- ENDIF
-
- IFOUND = 0
-
- 50 CONTINUE
- READ(LUNSTG,'(A)',END=60) CHLINE
- LLINE = LENOCC(CHLINE)
-
- IF(IFOUND.EQ.0) THEN
- IF(INDEX(CHLINE(1:LLINE),CHCOMM(1:LCOMM)).EQ.0) GOTO 50
- IFOUND = 1
- ENDIF
-
- IF(IDEBFA.GE.0) PRINT *,CHLINE(1:LLINE)
-
- IF(IFOUND.EQ.1) THEN
-
- IF(INDEX(CHLINE(1:LLINE),'STAGE-I-LOGNAME').GT.0) THEN
- IFOUND = 2
- ENDIF
-
- ENDIF
-
- GOTO 50
-
- 60 CONTINUE
- CLOSE(LUNSTG)
-
- CALL LIB$FREE_LUN(LUNSTG)
-
- IF(IDEBFA.GE.0) THEN
- PRINT *
- PRINT *,'FMCSTG. end of stage log file'
- PRINT *
- ENDIF
-*
-* Change this to an error if confident...
-*
- IF(IFOUND.NE.2) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMCSTG. warning - could not ',
- + 'find completion message in stage log'
- IRC = -2
-
- ENDIF
-
- GOTO 70
-
- ENDIF
-
- IRC = 1
-
- 70 RETURN
-
- END
diff --git a/src/packlib/fatmen/fmvax/fmgtel.F b/src/packlib/fatmen/fmvax/fmgtel.F
deleted file mode 100644
index ca5bc6b..0000000
--- a/src/packlib/fatmen/fmvax/fmgtel.F
+++ /dev/null
@@ -1,71 +0,0 @@
-*
-* $Id: fmgtel.F,v 1.1.1.1 1996/03/07 15:18:22 mclareni Exp $
-*
-* $Log: fmgtel.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:22 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
-#if defined(CERNLIB_VAXVMS)
- SUBROUTINE FMGTEL(LOGNAM,EQUNAM,TABNAM,IELEM,IRC)
- IMPLICIT INTEGER (S)
-
-#include "fatmen/fatbug.inc"
-#include "fatmen/slate.inc"
- CHARACTER*(*) LOGNAM,EQUNAM,TABNAM
-
- STRUCTURE /ITMLST/
- UNION
- MAP
- INTEGER*2 BUFFER_LENGTH
- INTEGER*2 ITEM_CODE
- INTEGER*4 BUFFER_ADDRESS
- INTEGER*4 RETURN_LENGTH_ADDRESS
- ENDMAP
- MAP
- INTEGER*4 END_LIST /0/
- ENDMAP
- END UNION
- END STRUCTURE
-
- RECORD /ITMLST/ LNM_LIST(3)
-
- INCLUDE '($LNMDEF)'
- INCLUDE '($SSDEF)'
-
- CHARACTER*80 MESS
-
-*
- IRC = 0
-
- LBUF = 255
- LNM_LIST(1).BUFFER_LENGTH = 4
- LNM_LIST(1).ITEM_CODE = LNM$_INDEX
- LNM_LIST(1).BUFFER_ADDRESS = %LOC(IELEM)
- LNM_LIST(1).RETURN_LENGTH_ADDRESS = %LOC(LELEM)
-
- LNM_LIST(2).BUFFER_LENGTH = LBUF
- LNM_LIST(2).ITEM_CODE = LNM$_STRING
- LNM_LIST(2).BUFFER_ADDRESS = %LOC(EQUNAM)
- LNM_LIST(2).RETURN_LENGTH_ADDRESS = %LOC(LNAM)
-
- LNM_LIST(3).END_LIST = 0
-
- LENLOG = LENOCC(LOGNAM)
- LENTAB = LENOCC(TABNAM)
- IF(IDEBFA.GE.3) PRINT *,'FMGTEL. attempting translation of ',
- + LOGNAM(1:LENLOG),' from table ',TABNAM(1:LENTAB)
-
- STATUS = SYS$TRNLNM(,TABNAM(1:LENTAB)
- + ,LOGNAM(1:LENLOG),,LNM_LIST)
- IF (.NOT. STATUS) THEN
- IC = SYS$GETMSG(%VAL(STATUS),LNAM,EQUNAM,,)
- IRC = 1
- ENDIF
-
- IS(1) = LNAM
-
- END
-
-#endif
diff --git a/src/packlib/fatmen/fmvax/fmgtlg.F b/src/packlib/fatmen/fmvax/fmgtlg.F
deleted file mode 100644
index 83253d2..0000000
--- a/src/packlib/fatmen/fmvax/fmgtlg.F
+++ /dev/null
@@ -1,71 +0,0 @@
-*
-* $Id: fmgtlg.F,v 1.1.1.1 1996/03/07 15:18:22 mclareni Exp $
-*
-* $Log: fmgtlg.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:22 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
-#if defined(CERNLIB_VAXVMS)
- SUBROUTINE FMGTLG(LOGNAM,EQUNAM,TABNAM,IRC)
- IMPLICIT INTEGER (S)
-
-#include "fatmen/fatbug.inc"
-#include "fatmen/slate.inc"
- CHARACTER*(*) LOGNAM,EQUNAM,TABNAM
-
- STRUCTURE /ITMLST/
- UNION
- MAP
- INTEGER*2 BUFFER_LENGTH
- INTEGER*2 ITEM_CODE
- INTEGER*4 BUFFER_ADDRESS
- INTEGER*4 RETURN_LENGTH_ADDRESS
- ENDMAP
- MAP
- INTEGER*4 END_LIST /0/
- ENDMAP
- END UNION
- END STRUCTURE
-
- RECORD /ITMLST/ LNM_LIST(2)
-
- INCLUDE '($LNMDEF)'
- INCLUDE '($SSDEF)'
-
- CHARACTER*80 MESS
-
-*
- IRC = 0
-
- LBUF = 255
- LNM_LIST(1).BUFFER_LENGTH = LBUF
- LNM_LIST(1).ITEM_CODE = LNM$_STRING
- LNM_LIST(1).BUFFER_ADDRESS = %LOC(EQUNAM)
- LNM_LIST(1).RETURN_LENGTH_ADDRESS = %LOC(LNAM)
-
- LNM_LIST(2).END_LIST = 0
-
- LENLOG = LENOCC(LOGNAM)
- LENTAB = LENOCC(TABNAM)
- IF(IDEBFA.GE.3) PRINT *,'FMGTLG. attempting translation of ',
- + LOGNAM(1:LENLOG),' from table ',TABNAM(1:LENTAB)
-
- STATUS = SYS$TRNLNM(,TABNAM(1:LENTAB)
- + ,LOGNAM(1:LENLOG),,LNM_LIST)
- IF (.NOT. STATUS) THEN
- IF(IDEBFA.GE.1) THEN
- IC = SYS$GETMSG(%VAL(STATUS),LMESS,MESS,,)
- PRINT *,'FMGTLG. error translating logical name - ',
- + MESS(1:LMESS)
- ENDIF
- IRC = 1
- IS(1) = 0
- ELSE
- IS(1) = LNAM
- ENDIF
-
- END
-
-#endif
diff --git a/src/packlib/fatmen/fmvax/fmlook.F b/src/packlib/fatmen/fmvax/fmlook.F
deleted file mode 100644
index dd1bff7..0000000
--- a/src/packlib/fatmen/fmvax/fmlook.F
+++ /dev/null
@@ -1,221 +0,0 @@
-*
-* $Id: fmlook.F,v 1.1.1.1 1996/03/07 15:18:23 mclareni Exp $
-*
-* $Log: fmlook.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:23 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMLOOK(CHJOB,CHQUE,JOB_NAME,IRC)
-C----------------------------------------------------------------------
-C-
-C- Purpose and Methods : to check if the tape is not being staged
-C-
-C- Inputs :
-C-
-C- CHJOB job name (tape labes) to be verified
-C- (file name up to and excluding ".")
-C-
-C- CHQUE class of queues to search
-C-
-C- Outputs :
-C-
-C- IRC = 0: job not found
-C- IRC > 0: entry number, coresponding to JOB_NAME
-C- IRC < 0: error
-C-
-C- JOB_NAME full job name (if found)
-C-
-C- Controls: none
-C-
-C- Created 10-JUN-1992 Krzysztof L. Genser
-C-
-C----------------------------------------------------------------------
-C
- IMPLICIT NONE
-C
- CHARACTER*(*) CHJOB,CHQUE
-C
- CHARACTER*39 JOB_NAME
- INTEGER*4 JOB_NAME_LEN
-
- INTEGER*4 LENOCC
- INTEGER*4 SYS$GETQUIW
-
-C
- INTEGER*4 IRC,IRC_LEN,QSTATUS,JSTATUS
- INTEGER*4 LJOB,LQUE
-C
- INTEGER*4 IDEBFA
- COMMON /FATUSE/ IDEBFA
-C
- STRUCTURE /ITMLST/
- UNION
- MAP
- INTEGER*2 BUFFER_LENGTH
- INTEGER*2 ITEM_CODE
- INTEGER*4 BUFFER_ADDRESS
- INTEGER*4 RETURN_LENGTH_ADDRESS
- ENDMAP
- MAP
- INTEGER*4 END_LIST /0/
- ENDMAP
- END UNION
- END STRUCTURE
-C
- STRUCTURE /IOSBLK/
- INTEGER*4 STS,ZEROED
- END STRUCTURE
-C
- RECORD /ITMLST/ QUEUE_LIST(4)
- RECORD /ITMLST/ JOB_LIST(6)
- RECORD /IOSBLK/ IOSB
-C
- CHARACTER*31 QUEUE_NAME
- INTEGER*4 QUEUE_NAME_LEN
- INTEGER*4 SEARCH_FLAGS,JOB_QSTATUS
-C
- INCLUDE '($QUIDEF)'
- INCLUDE '($JBCMSGDEF)'
- INCLUDE '($SJCDEF)'
-C
- IRC = 0
-C
- LJOB = LENOCC(CHJOB)
- LQUE = LENOCC(CHQUE)
-C
-C **** define the item list for queue operation
-C
- QUEUE_LIST(1).BUFFER_LENGTH = LQUE
- QUEUE_LIST(1).ITEM_CODE = QUI$_SEARCH_NAME
- QUEUE_LIST(1).BUFFER_ADDRESS = %LOC(CHQUE)
- QUEUE_LIST(1).RETURN_LENGTH_ADDRESS = 0
-C
- QUEUE_LIST(2).BUFFER_LENGTH = 4
- QUEUE_LIST(2).ITEM_CODE = QUI$_SEARCH_FLAGS
- QUEUE_LIST(2).BUFFER_ADDRESS = %LOC(SEARCH_FLAGS)
- QUEUE_LIST(2).RETURN_LENGTH_ADDRESS = 0
-C
- QUEUE_LIST(3).BUFFER_LENGTH = 31
- QUEUE_LIST(3).ITEM_CODE = QUI$_QUEUE_NAME
- QUEUE_LIST(3).BUFFER_ADDRESS = %LOC(QUEUE_NAME)
- QUEUE_LIST(3).RETURN_LENGTH_ADDRESS = %LOC(QUEUE_NAME_LEN)
-C
- QUEUE_LIST(4).END_LIST = 0
-C
-C **** define the item list for job query
-C
- JOB_LIST(1).BUFFER_LENGTH = 4
- JOB_LIST(1).ITEM_CODE = QUI$_SEARCH_FLAGS
- JOB_LIST(1).BUFFER_ADDRESS = %LOC(SEARCH_FLAGS)
- JOB_LIST(1).RETURN_LENGTH_ADDRESS = 0
-C
- JOB_LIST(2).BUFFER_LENGTH = 39
- JOB_LIST(2).ITEM_CODE = QUI$_JOB_NAME
- JOB_LIST(2).BUFFER_ADDRESS = %LOC(JOB_NAME)
- JOB_LIST(2).RETURN_LENGTH_ADDRESS = %LOC(JOB_NAME_LEN)
-C
- JOB_LIST(3).BUFFER_LENGTH = 4
- JOB_LIST(3).ITEM_CODE = QUI$_ENTRY_NUMBER
- JOB_LIST(3).BUFFER_ADDRESS = %LOC(IRC)
- JOB_LIST(3).RETURN_LENGTH_ADDRESS = %LOC(IRC_LEN)
-C
- JOB_LIST(4).END_LIST = 0
-C
-C
-C **** loop over the queues
-C
- QSTATUS = SYS$GETQUIW (,%VAL(QUI$_CANCEL_OPERATION),,,,,)
-
- IF ( .NOT.QSTATUS ) THEN
- CALL LIB$SIGNAL(%VAL(QSTATUS))
- IRC = -1
- ENDIF
-C
-C **** loop over generic queues first
-C
- SEARCH_FLAGS = ( QUI$M_SEARCH_GENERIC .OR.
- + QUI$M_SEARCH_WILDCARD .OR. QUI$M_SEARCH_ALL_JOBS)
-C
- 10 CONTINUE
-C
- QSTATUS = SYS$GETQUIW
- + (,%VAL(QUI$_DISPLAY_QUEUE),,QUEUE_LIST,IOSB,,)
-C
- IF ( QSTATUS ) THEN
-
- IF ( IOSB.STS ) THEN
-
- IF (IDEBFA.GE.1) PRINT *,QUEUE_NAME(1:QUEUE_NAME_LEN)
-C
-C **** loop over jobs in the queue
-C
- 20 CONTINUE
-
- JSTATUS = SYS$GETQUIW (,%VAL(QUI$_DISPLAY_JOB),,JOB_LIST,
- + IOSB,,)
-
- CALL CLTOU(JOB_NAME(1:JOB_NAME_LEN))
- IF ( JSTATUS ) THEN
-
- IF ( IOSB.STS .AND. IOSB.STS .NE.QUI$M_JOB_INACCESSIBLE)
- + THEN
-
- IF (IDEBFA.GE.1) PRINT *,JOB_NAME(1:JOB_NAME_LEN),
- + IRC
-
- IF (INDEX(JOB_NAME(1:JOB_NAME_LEN),CHJOB(1:LJOB))
- + .NE.0) THEN
- RETURN
- ENDIF
- GOTO 20
- ENDIF
- ENDIF
- GOTO 10
- ENDIF
- ENDIF
-C
-C **** loop over batch queues
-C
- SEARCH_FLAGS = ( QUI$M_SEARCH_BATCH .OR.
- + QUI$M_SEARCH_WILDCARD .OR. QUI$M_SEARCH_ALL_JOBS)
- 30 CONTINUE
-C
- QSTATUS = SYS$GETQUIW
- + (,%VAL(QUI$_DISPLAY_QUEUE),,QUEUE_LIST,IOSB,,)
-C
- IF ( QSTATUS ) THEN
-
- IF ( IOSB.STS ) THEN
-
- IF (IDEBFA.GE.1) PRINT *,QUEUE_NAME(1:QUEUE_NAME_LEN)
-C
-C **** loop over jobs in the queue
-C
- 40 CONTINUE
-
- JSTATUS = SYS$GETQUIW (,%VAL(QUI$_DISPLAY_JOB),,JOB_LIST,
- + IOSB,,)
-
- IF ( JSTATUS ) THEN
-
- IF ( IOSB.STS .AND. IOSB.STS .NE.QUI$M_JOB_INACCESSIBLE)
- + THEN
-
- IF (IDEBFA.GE.1) PRINT *,JOB_NAME(1:JOB_NAME_LEN),IRC
-
- IF (INDEX(JOB_NAME(1:JOB_NAME_LEN),CHJOB(1:LJOB))
- + .NE.0) THEN
- RETURN
- ENDIF
- GOTO 40
- ENDIF
- ENDIF
- GOTO 30
- ENDIF
- ENDIF
-
- IRC = 0
-
- END
diff --git a/src/packlib/fatmen/fmvax/fmqstg.F b/src/packlib/fatmen/fmvax/fmqstg.F
deleted file mode 100644
index f46f6ab..0000000
--- a/src/packlib/fatmen/fmvax/fmqstg.F
+++ /dev/null
@@ -1,60 +0,0 @@
-*
-* $Id: fmqstg.F,v 1.1.1.1 1996/03/07 15:18:23 mclareni Exp $
-*
-* $Log: fmqstg.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:23 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMQSTG(CHFILE,IRC)
- CHARACTER*(*) CHFILE
- CHARACTER*255 CHNAME
- CHARACTER*12 CHUSER
- CHARACTER*8 CHHOST,CHTYPE,CHSYS
- INTEGER FMHOST,FMVUSR,FAFNDF
- INCLUDE '($RMSDEF)'
-#include "fatmen/fmqued.inc"
-#include "fatmen/fatbug.inc"
-
- LFILE = LENOCC(CHFILE)
- IRC = 0
-*
-* Check that we can access queue directory
-*
- ICONT = 0
- ICODE = FAFNDF(CHQUED(1:LQUED)//CHFILE(1:LFILE),
- + CHNAME,ICONT)
- IF(ICODE.EQ.RMS$_SUC) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMQSTG. request file ',
- + CHQUED(1:LQUED)//CHFILE(1:LFILE),
- + ' already exists'
- RETURN
- ENDIF
-
- ICODE = LIB$GET_LUN(LUNSTG)
-
- OPEN(LUNSTG,FILE=CHQUED(1:LQUED)//CHFILE(1:LFILE),STATUS='NEW',
- + FORM='FORMATTED',ACCESS='SEQUENTIAL',IOSTAT=IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMQSTG. error ',IRC,
- + ' opening ',CHQUED(1:LQUED)//CHFILE(1:LFILE)
- GOTO 90
- ENDIF
-
- CALL DATIME(ID,IT)
-
- IC = FMVUSR(CHUSER)
- LUSER = LENOCC(CHUSER)
- IC = FMHOST(CHHOST,CHTYPE,CHSYS)
- LHOST = LENOCC(CHHOST)
-
- WRITE(LUNSTG,9001) CHFILE(1:LFILE),ID,IT,CHUSER,CHHOST
- 9001 FORMAT(' Stage request for ',A,' issued at ',I6,1X,I4,
- + ' by ',A,' on node ',A)
-
- CLOSE(LUNSTG)
-
- 90 CONTINUE
- ICODE = LIB$FREE_LUN(LUNSTG)
- END
diff --git a/src/packlib/fatmen/fmvax/fmquot.F b/src/packlib/fatmen/fmvax/fmquot.F
deleted file mode 100644
index b4fe9f2..0000000
--- a/src/packlib/fatmen/fmvax/fmquot.F
+++ /dev/null
@@ -1,140 +0,0 @@
-*
-* $Id: fmquot.F,v 1.1.1.1 1996/03/07 15:18:21 mclareni Exp $
-*
-* $Log: fmquot.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:21 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMQUOT(USED,FREE,ALLO,OVER,IRC)
-*CMZ : 13/11/91 12.06.22 by Jamie Shiers
-*-- Author : Julian Bunn 13/11/91
-*
-* Get disk quota information - blocks used,
-* allocated and overdraft. Copied from SPACE
-*
-* Return codes: < 0 : error
-* = 0 : OK
-* > 0 : disk quotas not enabled on this volume
-*
- IMPLICIT INTEGER (A-Z)
- INCLUDE '($SSDEF)'
- INCLUDE '($IODEF)'
- INCLUDE '($FIBDEF)'
- INCLUDE '($LBRDEF)'
- INCLUDE '($JPIDEF)'
- INCLUDE '($UAIDEF)'
- INCLUDE '($LNMDEF)'
- INTEGER*2 IOSB2(4)
- INTEGER*4 DESC(2),DF(2),IOSB(2)
- EQUIVALENCE (IOSB,IOSB2)
- INTEGER*2 DISK_CHAN
- INTEGER*4 QF(8)
- STRUCTURE /ITEMLIST/
- INTEGER*2 BUFLEN
- INTEGER*2 ITEMCODE
- INTEGER*4 BUFFADD
- INTEGER*4 RETLADD
- END STRUCTURE
- RECORD /ITEMLIST/ ITEM_LIST(3)
- STRUCTURE /FILEINFO/
- INTEGER*4 FIB$L_ACCTL
- INTEGER*4 FIB$L1
- INTEGER*4 FIB$L2
- INTEGER*4 FIB$L3
- INTEGER*4 FIB$L_WCC
- INTEGER*2 FIB$W_NMCTL
- INTEGER*2 FIB$W_CNTRLFUNC
- INTEGER*4 FIB$L_CNTRLVAL
- END STRUCTURE
- RECORD /FILEINFO/ FILE_INFO
-
- CHARACTER*80 DISK
- INTEGER UIC(2)
-#include "fatmen/slate.inc"
-
- IRC = 0
-*
-* Get current working directory
-*
- CALL GETWDF(DISK)
- IF(IS(1).LE.0) THEN
- IRC = -1
- GOTO 999
- ENDIF
-
- LDISK = INDEX(DISK,':') - 1
-*
-* Get current UIC
-*
- ITEM_LIST(1).BUFLEN =4
- ITEM_LIST(1).ITEMCODE =JPI$_UIC
- ITEM_LIST(1).BUFFADD =%LOC(UIC)
- ITEM_LIST(1).RETLADD =%LOC(LUIC)
- ITEM_LIST(2).BUFLEN =0
- ITEM_LIST(2).ITEMCODE =0
- STATUS=SYS$GETJPIW(,,,ITEM_LIST,,,)
- IF(STATUS.NE.SS$_NORMAL) THEN
- IRC = -2
- GOTO 999
- ENDIF
-
- UIC(2) = 0
-*
-* Assign the disk
-*
- STATUS = SYS$ASSIGN(DISK(:LDISK),DISK_CHAN,,)
- IF(.NOT.STATUS) THEN
- STATUS=LIB$SIGNAL(%VAL(STATUS))
- IRC = -3
- GOTO 999
- ENDIF
-*
-* Get quota information
-*
- QF(1) = 0
- QF(2) = UIC(1)
- FILE_INFO.FIB$L_ACCTL = 0
- FILE_INFO.FIB$L1 = 0
- FILE_INFO.FIB$L2 = 0
- FILE_INFO.FIB$L3 = 0
- FILE_INFO.FIB$L_WCC = 0
- FILE_INFO.FIB$W_NMCTL = 0
- FILE_INFO.FIB$W_CNTRLFUNC = FIB$C_EXA_QUOTA
- FILE_INFO.FIB$L_CNTRLVAL = 0
- DESC(1) = 28
- DESC(2) = %LOC(FILE_INFO)
- DF(1) = 32
- DF(2) = %LOC(QF)
-*
- STATUS = SYS$QIOW(,%VAL(DISK_CHAN),%VAL(IO$_ACPCONTROL),
- + IOSB,,,DESC,DF,LFIELD,DF,,)
- IF(.NOT.STATUS) THEN
- STATUS = LIB$SIGNAL(%VAL(STATUS))
- IRC = -4
- GOTO 999
- ENDIF
- IF(.NOT.IOSB(1)) THEN
- IF(IOSB(1).EQ.SS$_QFNOTACT) THEN
- IRC = 1
- ELSE
- STATUS = LIB$SIGNAL(%VAL(IOSB(1)))
- IRC = -5
- GOTO 999
- ENDIF
- ENDIF
-*
- USED = QF(3)
- ALLO = QF(4)
- OVER = QF(5)
- FREE = ALLO - USED
-
- 999 CONTINUE
-*
-* Deassign the disk
-*
- STATUS = SYS$DASSGN(%VAL(DISK_CHAN))
- IF(.NOT.STATUS) CALL LIB$SIGNAL(%VAL(STATUS))
- RETURN
- END
diff --git a/src/packlib/fatmen/fmvax/fmrack.F b/src/packlib/fatmen/fmvax/fmrack.F
deleted file mode 100644
index 26f3573..0000000
--- a/src/packlib/fatmen/fmvax/fmrack.F
+++ /dev/null
@@ -1,57 +0,0 @@
-*
-* $Id: fmrack.F,v 1.1.1.1 1996/03/07 15:18:22 mclareni Exp $
-*
-* $Log: fmrack.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:22 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMRACK(LUNNET,CHACK,CHJOB,IRC)
-*CMZ : 19/02/92 12.57.00 by Jamie Shiers
-*-- Author : Jamie Shiers 19/02/92
- CHARACTER*(*) CHACK,CHJOB
-#include "fatmen/fatbug.inc"
-#include "fatmen/farstg.inc"
-*
-* Read acknowledgement back from server
-*
- IRC = 0
-*
-* Give server a chance to do something
-*
- CALL SLEEPF(IWTACK)
-
- IRETRY = 0
- 10 CONTINUE
- IRETRY = IRETRY + 1
- READ(LUNNET,'(A)',END=20,ERR=30,IOSTAT=IRC) CHACK
- READ(LUNNET,'(A)',END=20,ERR=30,IOSTAT=IRC) CHJOB
- RETURN
-
- 20 CONTINUE
- IF(IRETRY.LT.MAXACK) THEN
- REWIND(LUNNET)
- IF(IDEBFA.GE.0) PRINT 9001,IWTACK,IRETRY
- 9001 FORMAT(' FMRACK. no reply from server - waiting ',I6,
- + ' seconds before retry # ',I6)
- CALL SLEEPF(IWTACK)
- GOTO 10
- ELSE
- IRC = -1
- CHACK = 'no reply from server'
- IF(IDEBFA.GE.0) PRINT 9002,MAXACK
- 9002 FORMAT(' FMRACK. Still no reply from server -',
- + ' maximum retry count (',I6,') reached')
- ENDIF
-
- RETURN
-
- 30 CONTINUE
-*
-* Error reading reply from server
-*
- WRITE(CHACK,9003) IRC
- 9003 FORMAT('Error ',I10,' reading reply from STGSERV')
-
- END
diff --git a/src/packlib/fatmen/fmvax/fmrqui.F b/src/packlib/fatmen/fmvax/fmrqui.F
deleted file mode 100644
index d783862..0000000
--- a/src/packlib/fatmen/fmvax/fmrqui.F
+++ /dev/null
@@ -1,119 +0,0 @@
-*
-* $Id: fmrqui.F,v 1.1.1.1 1996/03/07 15:18:23 mclareni Exp $
-*
-* $Log: fmrqui.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:23 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMRQUI(LUNNET,CHNODE,CHENT,IRC)
-*CMZ : 17/02/92 16.34.31 by Jamie Shiers
-*-- Author : Jamie Shiers 17/02/92
- CHARACTER*(*) CHNODE,CHENT
- CHARACTER*8 CHHOST
- CHARACTER*255 CHNAME,CHTASK,CHMESS,CHLINE,CHJOB
-#include "fatmen/farstg.inc"
-#include "fatmen/fatbug.inc"
- INCLUDE '($FORDEF)'
- PARAMETER (IO_OK=0)
-
- IRC = 0
- LNODE = LENOCC(CHNODE)
-*
-* Open communication with remote server
-*
- CHHOST = CHNODE(1:LNODE)
- CHTASK = CHHOST(1:LNODE) // '::"TASK=STGSERV"'
- LTASK = LENOCC(CHTASK)
-
- IWAIT = IWTPND
- 10 CONTINUE
-*
-* Restart server (maybe DECnet has kept it alive for us...)
-*
- IRETRY = 0
- 20 CONTINUE
- OPEN(UNIT=LUNNET,FILE=CHTASK(1:LTASK),STATUS='NEW',ERR=30,
- +FORM='FORMATTED',RECL=255)
-*
-* Send command
-*
- WRITE(LUNNET,'(A)',ERR=40) 'QUERY'
- WRITE(LUNNET,'(A)',ERR=40) CHENT
-*
-* Read back acknowledgement
-*
- CALL FMRACK(LUNNET,CHMESS,CHJOB,IRC)
-
- IF(IDEBFA.GE.0.OR.IRC.NE.0) THEN
- LMESS = LENOCC(CHMESS)
- CALL DATIME(ID,IT)
- ENDIF
-
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.0) WRITE(LPRTFA,9002) CHMESS(1:LMESS)
- 9002 FORMAT(' FMRQUI. error during remote job inquiry - ',A)
- GOTO 50
- ELSE
- IF(IDEBFA.GE.0) WRITE(LPRTFA,9003) ID,IT,CHMESS(1:LMESS)
- 9003 FORMAT(' FMRQUI. job status at ',I6,1X,I4,' = ',A)
- ENDIF
-*
-* Job pending, executing or disappeared?
-*
- IF(INDEX(CHMESS,'PENDING').NE.0) THEN
- CLOSE(LUNNET)
- GOTO 50
- ELSEIF(INDEX(CHMESS,'EXECUTING').NE.0) THEN
- CLOSE(LUNNET)
- IWAIT = IWTEXE
- GOTO 50
- ELSEIF(INDEX(CHMESS,'COMPLETED').NE.0) THEN
- GOTO 50
- ELSE
- CLOSE(LUNNET)
- IF(IDEBFA.GE.0) WRITE(LPRTFA,9001) IWAIT
- 9001 FORMAT(' FMRQUI. please wait - next job status in ',I10,
- + ' seconds')
- CALL SLEEPF(IWAIT)
- GOTO 10
- ENDIF
-
- 30 CONTINUE
- IRETRY = IRETRY + 1
- IF(IRETRY.LE.MAXNET) THEN
- IF(IDEBFA.GE.1) WRITE(LPRTFA,9004) IWTNET
- 9004 FORMAT(' FMRQUI. error starting server - retry in ',I10,
- + ' seconds')
- CALL SLEEPF(IWTNET)
- GOTO 20
- ENDIF
-
- IF(IDEBFA.GE.-3) WRITE(LPRTFA,9005) MAXNET
- 9005 FORMAT(' FMRQUI. maximum number of network retries exceeded.',
- + ' Retry count = ',I10)
- IRC = -2
- GOTO 60
-
- 40 CONTINUE
- IRETRY = IRETRY + 1
- IF(IRETRY.LE.MAXNET) THEN
- IF(IDEBFA.GE.1) WRITE(LPRTFA,9006) IWTNET
- 9006 FORMAT(' FMRQUI. error writing to server - retry in ',I10,
- + ' seconds')
- CALL SLEEPF(IWTNET)
- GOTO 20
- ENDIF
-
- IF(IDEBFA.GE.-3) WRITE(LPRTFA,9005) MAXNET
- IRC = -2
- GOTO 60
-
- 50 CONTINUE
-
- CLOSE(LUNNET)
-
- 60 CONTINUE
-
- END
diff --git a/src/packlib/fatmen/fmvax/fmrstg.F b/src/packlib/fatmen/fmvax/fmrstg.F
deleted file mode 100644
index e65a44f..0000000
--- a/src/packlib/fatmen/fmvax/fmrstg.F
+++ /dev/null
@@ -1,426 +0,0 @@
-*
-* $Id: fmrstg.F,v 1.1.1.1 1996/03/07 15:18:21 mclareni Exp $
-*
-* $Log: fmrstg.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:21 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMRSTG(CHNODE,CHFILE,CHTYPE,CHCOMM,ISIZE,CHOPT,IRC)
- CHARACTER*(*) CHNODE,CHFILE,CHTYPE,CHCOMM
- CHARACTER*8 CHHOST
- CHARACTER*255 CHNAME,CHTASK,CHENT,CHMESS,CHLINE,CHJOB,CHFULL
- INCLUDE '($FORDEF)'
- PARAMETER (IO_OK=0)
- LOGICAL QUEUED
-#include "fatmen/fmqued.inc"
-#include "fatmen/slate.inc"
-#include "fatmen/farstg.inc"
-#include "fatmen/fatbug.inc"
-#include "fatmen/fatopts.inc"
-
- IRC = 0
- QUEUED = .FALSE.
- LNODE = LENOCC(CHNODE)
- LFILE = LENOCC(CHFILE)
- LTYPE = LENOCC(CHTYPE)
- LCOMM = LENOCC(CHCOMM)
-
- IF(IDEBFA.GE.1) PRINT *,'FMRSTG. enter for ',
- + 'node,file,type,comm = ',
- + CHNODE(1:LNODE),' ',CHFILE(1:LFILE),' ',CHTYPE(1:LTYPE),
- + CHCOMM(1:LCOMM)
-
- LDOT = INDEX(CHFILE(1:LFILE),'.')
- CHNAME = CHFILE(1:LFILE)
- CHNAME(LDOT:LDOT) = '_'
-*
-* FULLTAPE list
-*
- CALL FMGTLG('STAGE_FULLTAPE',CHFULL,'LNM$SYSTEM',ISTAT)
- LFULL = IS(1)
-*
-* Get unit for network connection
-*
- ISTAT = LIB$GET_LUN(LUNNET)
-#include "fatmen/fatvaxrc.inc"
-*
-* Open communication with remote server
-*
- CHHOST = CHNODE(1:LNODE)
- CHTASK = CHHOST(1:LNODE) // '::"TASK=STGSERV"'
- LTASK = LENOCC(CHTASK)
-
- IRETRY = 0
- 10 CONTINUE
- OPEN(UNIT=LUNNET,FILE=CHTASK(1:LTASK),STATUS='NEW',ERR=100,
- +FORM='FORMATTED',RECL=255)
-*
-* First check whether tape is in use
-*
- WRITE(LUNNET,'(A)') 'LOOK'
-*
-* Send file name, generic device type and stage command
-*
- WRITE(LUNNET,'(A)') CHNAME(1:LDOT-1)
- WRITE(LUNNET,'(A)') CHTYPE(1:LTYPE)
-*
-* Read back job entry number. 0 = no such job
-*
- CALL FMRACK(LUNNET,CHENT,CHJOB,IRC)
- LCHENT = LENOCC(CHENT)
-
- IF(IDEBFA.GE.3) PRINT *,'FMRSTG. reply from stage server = ',
- + CHENT(1:LCHENT)
-
- JX = ICDECI(CHENT,1,LCHENT)
-
- IF(JX.GT.0) THEN
- IF(IDEBFA.GE.0) THEN
- CALL DATIME(ID,IT)
- PRINT *,'FMRSTG. tape in use at ',ID,IT,
- + ' on server cluster'
- PRINT *,'FMRSTG. waiting for job ',CHENT(1:LCHENT),
- + ' to release tape'
- ENDIF
- CLOSE(LUNNET)
- NCNAME=INDEX(CHNAME(LDOT+1:LFILE),'_')+LDOT-1
- NJNAME=INDEX(CHJOB(LDOT+1:LFILE),'_')+LDOT-1
- IF(CHNAME(LDOT+1:NCNAME).EQ.
- + CHJOB(LDOT+1:NJNAME)) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMRSTG. The other job is staging ',
- + 'the same file !'
- IF(IOPTQ.NE.0) GOTO 140
- ELSE
- IF(IDEBFA.GE.0) PRINT *,'FMRSTG. The other job is staging ',
- + 'another file.'
- IF(IOPTQ.NE.0.AND.
- + INDEX(CHFULL(1:LFULL),CHTYPE(1:LTYPE)).NE.0) GOTO 140
-*
-* If we are in server mode, queue request
-*
- IF(LQUED.GT.0.AND..NOT.QUEUED) THEN
-C
-C **** check if the job is a real staging job
-C
- IF ( CHJOB(LDOT+1:NJNAME).NE.'XX') THEN
- QUEUED = .TRUE.
- CALL FMQSTG(CHFILE,IRC)
-C
-C **** check if the job is still there
-C
- CALL SLEEPF(IWTACK)
- IRETRY = 0
- 20 CONTINUE
- OPEN(UNIT=LUNNET,FILE=CHTASK(1:LTASK), STATUS='NEW',
- + ERR=30 , FORM='FORMATTED',RECL=255)
- GOTO 40
-*
-* Error starter server - retry
-*
- 30 CONTINUE
- IRETRY = IRETRY + 1
- IF(IRETRY.LE.MAXNET) THEN
- IF(IDEBFA.GE.1) PRINT *,'FMRSTG. error starting '
- + //'server - ', 'retry in ',IWTNET,' seconds'
- CALL SLEEPF(IWTNET)
- GOTO 20
- ENDIF
-
- IF(IDEBFA.GE.-3) PRINT *,'FMRSTG. maximum number of '
- + //'network ', 'retries exceeded. Retry count = ',
- + MAXNET
- IRC = -2
- GOTO 140
-
- 40 CONTINUE
- WRITE(LUNNET,'(A)') 'LOOK'
-*
-* Send file name, generic device type and stage command
-*
- WRITE(LUNNET,'(A)') CHNAME(1:LDOT-1)
- WRITE(LUNNET,'(A)') CHTYPE(1:LTYPE)
-*
-* Read back job entry number. 0 = no such job
-*
- CALL FMRACK(LUNNET,CHENT,CHJOB,IRC)
- LCHENT = LENOCC(CHENT)
-
- IF(IDEBFA.GE.3)
- + PRINT *,'FMRSTG. reply from stage server = ',
- + CHENT(1:LCHENT)
-
- JX = ICDECI(CHENT,1,LCHENT)
- IF (JX.LE.0) THEN
- CLOSE(LUNNET)
- GOTO 50
- ELSE
- CLOSE(LUNNET)
- ENDIF
-
- ENDIF
-
- ENDIF
-
- IF(IOPTQ.NE.0) GOTO 140
-
- ENDIF
-
- CALL FMRQUI(LUNNET,CHNODE(1:LNODE),CHENT(1:LCHENT),
- + CHFILE(1:LFILE),IRC)
- IWAIT = IWTPND
- IF(IDEBFA.GE.0) PRINT *,'FMRSTG. please wait - next job ',
- + 'status in ',IWAIT,' seconds'
- CALL SLEEPF(IWAIT)
-*
-* Now check if the file we wanted has been staged
-*
- CALL FMSTGC(CHFILE(1:LFILE),ISIZE,JSIZE,IFOUND)
- IF(IFOUND.EQ.0) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMRSTG. The file we want ',
- + 'is on now on disk!'
- GOTO 140
- ELSE
- GOTO 10
- ENDIF
- ELSE
- CLOSE(LUNNET)
- ENDIF
- IRETRY = 0
- 50 CONTINUE
- OPEN(UNIT=LUNNET,FILE=CHTASK(1:LTASK),STATUS='NEW',ERR=110,
- +FORM='FORMATTED',RECL=255)
-*
-* Send command
-*
- WRITE(LUNNET,'(A)') 'STAGE'
-*
-* Send file name, generic device type and stage command
-*
- WRITE(LUNNET,'(A)') CHNAME(1:LFILE)
- WRITE(LUNNET,'(A)') CHTYPE(1:LTYPE)
- WRITE(LUNNET,'(A)') CHCOMM(1:LCOMM)
-*
-* Wait for job submission - read back job entry number
-*
- CALL FMRACK(LUNNET,CHENT,CHJOB,IRC)
-*
-* Check if returned message is numeric - if so it is job entry number
-*
- LCHENT = LENOCC(CHENT)
-
- IF(IDEBFA.GE.3) PRINT *,'FMRSTG. reply from stage server = ',
- + CHENT(1:LCHENT)
-
- JX = ICNUM(CHENT,1,LCHENT)
- IF(JX.LE.LCHENT) IRC = -1
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMRSTG. error during remote ',
- + 'job submission - ',CHENT(1:LCHENT)
- GOTO 130
- ELSE
- IF(IDEBFA.GE.0) THEN
- CALL DATIME(ID,IT)
- PRINT *,'FMRSTG. stage job successfully ',
- + 'submitted to node ',CHNODE(1:LNODE),'. Job entry ',
- + 'number = ',CHENT(1:LCHENT)
- PRINT *,'FMRSTG. The time is now ',ID,IT
- ENDIF
- ENDIF
- IF(IOPTQ.NE.0) GOTO 140
-*
-* Now loop until job is completed
-*
- CLOSE(LUNNET)
- IWAIT = IWTPND
- 60 CONTINUE
- IF(IDEBFA.GE.0) PRINT *,'FMRSTG. please wait - next job ',
- + 'status in ',IWAIT,' seconds'
- CALL SLEEPF(IWAIT)
-*
-* Restart server (maybe DECnet has kept it alive for us...)
-*
- IRETRY = 0
- 70 CONTINUE
-
- OPEN(UNIT=LUNNET,FILE=CHTASK(1:LTASK),STATUS='NEW',ERR=120,
- +FORM='FORMATTED',RECL=255)
-*
-* Send command
-*
- WRITE(LUNNET,'(A)') 'QUERY'
- WRITE(LUNNET,'(A)') CHENT
-*
-* Read back acknowledgement
-*
- CALL FMRACK(LUNNET,CHMESS,CHJOB,IRC)
-
- IF(IDEBFA.GE.0.OR.IRC.NE.0) THEN
- LMESS = LENOCC(CHMESS)
- CALL DATIME(ID,IT)
- ENDIF
-
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMRSTG. error during remote ',
- + 'job inquiry - ',CHMESS(1:LMESS)
- GOTO 130
- ELSE
- IF(IDEBFA.GE.0) PRINT *,'FMRSTG. job status at ',ID,IT,' = ',
- + CHMESS(1:LMESS)
- ENDIF
-*
-* Job pending, executing or disappeared?
-*
- IF(INDEX(CHMESS,'PENDING').NE.0) THEN
- CLOSE(LUNNET)
-*
-* Check if the file has been staged successfully
-* (maybe by someone else)
-*
- CALL FMSTGC(CHFILE(1:LFILE),ISIZE,JSIZE,IFOUND)
- IF(IFOUND.EQ.0) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMCSTG. The file we want ',
- + 'is on now on disk!'
- GOTO 140
- ENDIF
- GOTO 60
- ELSEIF(INDEX(CHMESS,'EXECUTING').NE.0) THEN
- CLOSE(LUNNET)
-*
-* Check if the file has been staged successfully
-* (maybe by someone else)
-*
- CALL FMSTGC(CHFILE(1:LFILE),ISIZE,JSIZE,IFOUND)
- IF(IFOUND.EQ.0) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMCSTG. The file we want ',
- + 'is on now on disk!'
- GOTO 140
- ENDIF
- IWAIT = IWTEXE
- GOTO 60
- ELSEIF(INDEX(CHMESS,'COMPLETED').NE.0) THEN
-*
-* Now check stage log file
-*
- CLOSE(LUNNET)
-
- ISTAT = LIB$GET_LUN(LUNSTG)
-#include "fatmen/fatvaxrc.inc"
-
- OPEN(LUNSTG,FILE='STAGE_LOGS:'//
- + CHNAME(1:LFILE)//'.LOG',FORM='FORMATTED',
- + STATUS='OLD',READONLY,IOSTAT=ISTAT)
- IF(ISTAT.NE.0) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMRSTG. cannot open ',
- + 'stage log file'
- CALL LIB$FREE_LUN(LUNSTG)
- GOTO 140
- ENDIF
-
- IF(IDEBFA.GE.0) THEN
- PRINT *
- PRINT *,'FMRSTG. stage log file follows...'
- PRINT *
- ENDIF
-
- IFOUND = 0
-
- 80 CONTINUE
- READ(LUNSTG,'(A)',END=90) CHLINE
- LLINE = LENOCC(CHLINE)
-
- IF(IFOUND.EQ.0) THEN
- IF(INDEX(CHLINE(1:LLINE),CHCOMM(1:LCOMM)).EQ.0) GOTO 80
- IFOUND = 1
- ENDIF
-
- IF(IDEBFA.GE.0) PRINT *,CHLINE(1:LLINE)
-
- IF(IFOUND.EQ.1) THEN
-
- IF(INDEX(CHLINE(1:LLINE),'STAGE-I-LOGNAME').GT.0) THEN
- IFOUND = 2
- ENDIF
-
- ENDIF
-
- GOTO 80
-
- 90 CONTINUE
- CLOSE(LUNSTG)
-
- CALL LIB$FREE_LUN(LUNSTG)
-
- IF(IDEBFA.GE.0) THEN
- PRINT *
- PRINT *,'FMRSTG. end of stage log file'
- PRINT *
- ENDIF
-*
-* Change this to an error if confident...
-*
- IF(IFOUND.NE.2) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMRSTG. warning - could not ',
- + 'find completion message in stage log'
- IRC = -2
- ENDIF
-
- GOTO 140
-
- ENDIF
-
- 100 CONTINUE
- IRETRY = IRETRY + 1
- IF(IRETRY.LE.MAXNET) THEN
- IF(IDEBFA.GE.1) PRINT *,'FMRSTG. error starting server - ',
- + 'retry in ',IWTNET,' seconds'
- CALL SLEEPF(IWTNET)
- GOTO 10
- ENDIF
-
- IF(IDEBFA.GE.-3) PRINT *,'FMRSTG. maximum number of network ',
- + 'retries exceeded. Retry count = ',MAXNET
- IRC = -2
- GOTO 140
-
- 110 CONTINUE
- IRETRY = IRETRY + 1
- IF(IRETRY.LE.MAXNET) THEN
- IF(IDEBFA.GE.1) PRINT *,'FMRSTG. error starting server - ',
- + 'retry in ',IWTNET,' seconds'
- CALL SLEEPF(IWTNET)
- GOTO 50
- ENDIF
-
- IF(IDEBFA.GE.-3) PRINT *,'FMRSTG. maximum number of network ',
- + 'retries exceeded. Retry count = ',MAXNET
- IRC = -2
- GOTO 140
-
- 120 CONTINUE
- IRETRY = IRETRY + 1
- IF(IRETRY.LE.MAXNET) THEN
- IF(IDEBFA.GE.1) PRINT *,'FMRSTG. error starting server - ',
- + 'retry in ',IWTNET,' seconds'
- CALL SLEEPF(IWTNET)
- GOTO 70
- ENDIF
-
- IF(IDEBFA.GE.-3) PRINT *,'FMRSTG. maximum number of network ',
- + 'retries exceeded. Retry count = ',MAXNET
- IRC = -2
- GOTO 140
-
- 130 CONTINUE
-
- CLOSE(LUNNET)
-
- 140 CONTINUE
-*
-* Free unit for network connection
-*
- ISTAT = LIB$FREE_LUN(LUNNET)
-#include "fatmen/fatvaxrc.inc"
-
- END
diff --git a/src/packlib/fatmen/fmvax/fmstgc.F b/src/packlib/fatmen/fmvax/fmstgc.F
deleted file mode 100644
index 1edc7d0..0000000
--- a/src/packlib/fatmen/fmvax/fmstgc.F
+++ /dev/null
@@ -1,73 +0,0 @@
-*
-* $Id: fmstgc.F,v 1.1.1.1 1996/03/07 15:18:22 mclareni Exp $
-*
-* $Log: fmstgc.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:22 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMSTGC(CHFILE,ISIZE,JSIZE,IRC)
-*CMZ : 20/05/92 10.57.25 by Jamie Shiers
-*-- Author : Jamie Shiers 20/05/92
-*
-* IRC = 0 : file found on disk
-* -1 : file not found
-* JSIZE : file size
-*
- CHARACTER*(*) CHFILE
- CHARACTER*255 CHSTFL,CHNAME
- LOGICAL IEXIST
- CHARACTER*255 CHGRP
-#include "fatmen/fatbug.inc"
-#include "fatmen/fabalq.inc"
- PARAMETER (MEGA=1024*1024)
- EXTERNAL FMBALQ
-
- DATA NENTRY/0/
- SAVE NENTRY,CHGRP,LCHGRP
-
- IRC = 99
- JSIZE = -1
-#if defined(CERNLIB_VAXTAP)
- IF(NENTRY.EQ.0) THEN
-*
-* Find staging group
-*
- CALL FMSTGP(CHGRP,IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMSTGQ. error checking STAGE',
- + ' IRC = ',IRC
- IRC = -2
- RETURN
- ENDIF
- LCHGRP = LENOCC(CHGRP)
- NENTRY = 1
- ENDIF
-
- LFILE = LENOCC(CHFILE)
- CHNAME = CHFILE(1:LFILE)
- CHSTFL = CHGRP(1:LCHGRP)//CHNAME(1:LFILE)
- LCHST = LCHGRP + LFILE
-*
-* Does this file exist?
-*
- INQUIRE(FILE=CHSTFL(1:LCHST),EXIST=IEXIST)
-
- IF(IEXIST) THEN
- IRC = 0
-*
-* Check file size on disk
-*
- ISTAT = LIB$GET_LUN(LUN)
-#include "fatmen/fatvaxrc.inc"
- OPEN(LUN,FILE=CHSTFL(1:LCHST),STATUS='OLD',
- + FORM='UNFORMATTED',READONLY,SHARED,
- + USEROPEN=FMBALQ,IOSTAT=ISTAT)
- JSIZE = (NBLOKS*512+.9999*MEGA)/MEGA
- ISTAT = LIB$FREE_LUN(LUN)
- ELSE
- IRC = -1
- ENDIF
-#endif
- END
diff --git a/src/packlib/fatmen/fmvax/fmstgp.F b/src/packlib/fatmen/fmvax/fmstgp.F
deleted file mode 100644
index 9e109a3..0000000
--- a/src/packlib/fatmen/fmvax/fmstgp.F
+++ /dev/null
@@ -1,159 +0,0 @@
-*
-* $Id: fmstgp.F,v 1.1.1.1 1996/03/07 15:18:21 mclareni Exp $
-*
-* $Log: fmstgp.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:21 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMSTGP(CHGRP,IRC)
-*CMZ : 25/09/91 15.47.18 by Jamie Shiers
-*-- Author : Jamie Shiers 25/09/91
-*
-* Get the name of the staging group for the current process
-*
- IMPLICIT INTEGER (S)
- STRUCTURE /ITMLST/
- UNION
- MAP
- INTEGER*2 BUFFER_LENGTH
- INTEGER*2 ITEM_CODE
- INTEGER*4 BUFFER_ADDRESS
- INTEGER*4 RETURN_LENGTH_ADDRESS
- ENDMAP
- MAP
- INTEGER*4 END_LIST /0/
- ENDMAP
- END UNION
- END STRUCTURE
-
- RECORD /ITMLST/ LNM_LIST(2)
-
- INCLUDE '($LNMDEF)'
- INCLUDE '($SSDEF)'
- INCLUDE '($JPIDEF)'
- INCLUDE '($RMSDEF)'
-
- CHARACTER*(*) CHGRP
- CHARACTER*133 UIC
- CHARACTER*133 TOPDIR
- CHARACTER*20 GROUP
- CHARACTER*255 STGDSK,CHTEMP,CHMESS
- INTEGER FAFNDF
-#include "fatmen/slate.inc"
-#include "fatmen/fatbug.inc"
- IRC = 0
-*
-* Check if this group is enabled to use STAGE
-*
- LNM_LIST(1).BUFFER_LENGTH = 255
- LNM_LIST(1).ITEM_CODE = LNM$_STRING
- LNM_LIST(1).BUFFER_ADDRESS = %LOC(STGDSK)
- LNM_LIST(1).RETURN_LENGTH_ADDRESS = %LOC(LENSTG)
-
- LNM_LIST(2).END_LIST = 0
-
- STATUS = SYS$TRNLNM(,'LNM$SYSTEM_TABLE','DISK$STAGE',,LNM_LIST)
-
- IF (STATUS .EQ. SS$_NOLOGNAM) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMSTGP. no staging disk found'
- IRC = 1
- RETURN
- ENDIF
-*
-* Translate again if necessary
-*
- IF (INDEX(STGDSK(1:LENSTG),':').EQ.0) THEN
-*
-* Use undocumented (obsolete) LIB$ routine to perform
-* translation if concealed
-*
- CHTEMP = STGDSK(1:LENSTG)
- LTEMP = LENSTG
- STATUS = LIB$SYS_TRNLOG(CHTEMP(1:LTEMP),LENSTG,STGDSK,,,)
-
- ENDIF
-*
-* Is DISK$STAGE a search list?
-*
- CALL FMGTEL('DISK$STAGE',CHTEMP,'LNM$SYSTEM',1,ILIST)
-
- IF(ILIST.EQ.0.AND.IS(1).GT.0.AND.IDEBFA.GE.1)
- + PRINT *,'FMSTGP. DISK$STAGE is a search list'
-*
-* Take staging group from STAGE_GROUP, if defined
-*
- STATUS = LIB$SYS_TRNLOG('STAGE_GROUP',LGROUP,GROUP,,,)
-
- IF(STATUS.EQ.SS$_NOTRAN) THEN
-
- STATUS = LIB$GETJPI(JPI$_UIC,,,,UIC,LENUIC)
- IF (.NOT. STATUS) CALL LIB$SIGNAL(%VAL(STATUS))
-
- LCOMMA = INDEX(UIC,',')
- IF(LCOMMA.EQ.0) LCOMMA = LENUIC
-
- GROUP = UIC(2:LCOMMA-1)
- LGROUP = LCOMMA-2
-*
-* Fix for ALEPH, DELPHI, L3 and OPAL
-*
- IF ((INDEX(GROUP,'ALEPH_') .NE. 0) .OR. (INDEX(GROUP,'DELPHI_'
- + ) .NE. 0) .OR. (INDEX(GROUP,'L3_') .NE. 0) .OR. (INDEX(GROUP,
- + 'OPAL_') .NE. 0)) THEN
-
- LGROUP = INDEX(GROUP,'_') - 1
-
- ENDIF
-*
-* Fix for DELPHI after VXCERN reconfiguration of 15/01/94
-*
- IF(GROUP(1:LGROUP).EQ.'PUBXX') THEN
- GROUP = 'DELPHI'
- LGROUP = 6
- ENDIF
-
- ENDIF
-
- IF(INDEX(STGDSK(1:LENSTG),'.]').EQ.0) THEN
-
- CHGRP = STGDSK(1:LENSTG) // '[' //
- + GROUP(1:LGROUP)//']'
- TOPDIR = STGDSK(1:LENSTG) // '[000000]' //
- + GROUP(1:LGROUP)//'.DIR'
- ELSE
-
- CHGRP = STGDSK(1:LENSTG-1) //
- + GROUP(1:LGROUP)//']'
- TOPDIR = STGDSK(1:LENSTG-2) // ']' //
- + GROUP(1:LGROUP)//'.DIR'
- ENDIF
-
- LENTOP = LENOCC(TOPDIR)
- LENGRP = LENOCC(CHGRP)
-
- IF(IDEBFA.GE.1) PRINT *,'FMSTGP. group is ',GROUP(1:LGROUP),
- + ' DISK$STAGE points to ',STGDSK(1:LENSTG)
- IF(IDEBFA.GE.1) PRINT *,'FMSTGP. top directory is ',
- + TOPDIR(1:LENTOP),' staging directory is ',CHGRP(1:LENGRP)
-
-* STATUS = LIB$FIND_FILE(TOPDIR(1:LENTOP),CHTEMP,ICONT)
- STATUS = FAFNDF(TOPDIR(1:LENTOP),CHTEMP,ICONT)
- ISTAT = LIB$FIND_FILE_END(ICONT)
-
- IF (STATUS .NE. RMS$_SUC) THEN
- IF(IDEBFA.GE.-3) THEN
- PRINT *,'FMSTGP. staging directory not ',
- + 'found for group ',GROUP(1:LGROUP)
- IC = SYS$GETMSG(%VAL(STATUS),LMESS,CHMESS,,)
- PRINT *,'FMSTGP. error from LIB$FIND_FILE = ',
- + CHMESS(1:LMESS)
- ENDIF
- IRC = 2
- RETURN
- ENDIF
-
- CHGRP = 'DISK$STAGE:[' // GROUP(1:LGROUP) // ']'
-
- END
diff --git a/src/packlib/fatmen/fmvax/fmvaxc.F b/src/packlib/fatmen/fmvax/fmvaxc.F
deleted file mode 100644
index 75dd3f8..0000000
--- a/src/packlib/fatmen/fmvax/fmvaxc.F
+++ /dev/null
@@ -1,91 +0,0 @@
-*
-* $Id: fmvaxc.F,v 1.1.1.1 1996/03/07 15:18:22 mclareni Exp $
-*
-* $Log: fmvaxc.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:22 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMVAXC(NODE,ICODE)
-*CMZ : 26/11/90 16.11.50 by Jamie Shiers
-*-- Author : Jamie Shiers 26/11/90
- CHARACTER*(*) NODE
- CHARACTER*8 TNODE
- INTEGER FMHOST
- CHARACTER*8 CHNODE,CHTYPE,CHSYS,CLUNAM,CLUNOD
-#include "fatmen/fatbug.inc"
-#if defined(CERNLIB_VAXVMS)
- INCLUDE '($SSDEF)'
- STRUCTURE /ITMLST/
- UNION
- MAP
- INTEGER*2 BUFFER_LENGTH
- INTEGER*2 ITEM_CODE
- INTEGER*4 BUFFER_ADDRESS
- INTEGER*4 RETURN_LENGTH_ADDRESS
- ENDMAP
- MAP
- INTEGER*4 END_LIST /0/
- ENDMAP
- END UNION
- END STRUCTURE
-
- RECORD /ITMLST/ SYI_LIST(2)
-
- INCLUDE '($SYIDEF)'
-#endif
- LN = LENOCC(NODE)
- IF(IDEBFA.GE.2) PRINT *,'FMVAXC. enter for ',NODE(1:LN)
- TNODE = NODE
- IC = FMHOST(CHNODE,CHTYPE,CHSYS)
- LCHN = LENOCC(CHNODE)
- IF(IDEBFA.GE.2) PRINT *,'FMVAXC. current node is ',
- + CHNODE(1:LCHN)
-
- CALL CLTOU(TNODE)
- CALL CLTOU(CHNODE)
-*
-* Node names match...
-*
- IF(TNODE(1:LN).EQ.CHNODE(1:LCHN)) THEN
- ICODE = 0
- RETURN
- ENDIF
-#if defined(CERNLIB_VAXVMS)
-*
-* Nodename specified is the VAXcluster alias
-*
- CALL FMGTLG('SYS$CLUSTER_NODE',CLUNAM,'LNM$SYSTEM',IRC)
- IF(IRC.EQ.0) THEN
- LENCLU = INDEX(CLUNAM,':') -1
- IF(IDEBFA.GE.2) PRINT *,'FMVAXC. cluster alias is ',
- + CLUNAM(1:LENCLU)
- IF(TNODE(1:LN).EQ.CLUNAM(1:LENCLU)) THEN
- ICODE = 1
- RETURN
- ENDIF
- ENDIF
-*
-* Check whether the node is in the same VAXcluster as us
-*
- MEMBER = 0
- SYI_LIST(1).BUFFER_LENGTH = 1
- SYI_LIST(1).ITEM_CODE = SYI$_CLUSTER_MEMBER
- SYI_LIST(1).BUFFER_ADDRESS = %LOC(MEMBER)
- SYI_LIST(1).RETURN_LENGTH_ADDRESS = %LOC(LENGTH)
- SYI_LIST(2).END_LIST = 0
-
- ISTAT = SYS$GETSYIW(,,TNODE(1:LN),SYI_LIST,,,)
-
-* IF (ISTAT .NE. SS$_NOSUCHNODE) GOTO 99
- IF(MEMBER.EQ.0) GOTO 99
- IF(IDEBFA.GE.2) PRINT *,'FMVAXC. ',TNODE(1:LN),
- + ' is a VAXcluster member'
- ICODE = 1
- RETURN
-#endif
-99 CONTINUE
- ICODE = 2
- END
-
diff --git a/src/packlib/fatmen/fmvax/fmvusr.F b/src/packlib/fatmen/fmvax/fmvusr.F
deleted file mode 100644
index 0b88b81..0000000
--- a/src/packlib/fatmen/fmvax/fmvusr.F
+++ /dev/null
@@ -1,48 +0,0 @@
-*
-* $Id: fmvusr.F,v 1.1.1.1 1996/03/07 15:18:22 mclareni Exp $
-*
-* $Log: fmvusr.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:22 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- INTEGER FUNCTION FMVUSR(USER)
- CHARACTER*(*) USER
- CHARACTER*12 CHUSER
- INCLUDE '($JPIDEF)'
- INTEGER SYS$GETJPIW
- STRUCTURE /ITMLST/
- UNION
- MAP
- INTEGER*2 BUFFER_LENGTH
- INTEGER*2 ITEM_CODE
- INTEGER*4 BUFFER_ADDRESS
- INTEGER*4 RETURN_LENGTH_ADDRESS
- ENDMAP
- MAP
- INTEGER*4 END_LIST /0/
- ENDMAP
- END UNION
- END STRUCTURE
-
- RECORD /ITMLST/ JPI_LIST(2)
-
- JPI_LIST(1).BUFFER_LENGTH = 12
- JPI_LIST(1).ITEM_CODE = JPI$_USERNAME
- JPI_LIST(1).BUFFER_ADDRESS = %LOC(CHUSER)
- JPI_LIST(1).RETURN_LENGTH_ADDRESS = %LOC(LENU)
-
- JPI_LIST(2).END_LIST = 0
-
- ISTAT = SYS$GETJPIW(,,,JPI_LIST,,,)
- IF (.NOT. ISTAT) CALL LIB$SIGNAL(%VAL(ISTAT))
- LUSER = MIN(12,LENOCC(USER))
- USER = CHUSER(1:LUSER)
- IF (ISTAT) THEN
- FMVUSR = 0
- ELSE
- FMVUSR=1
- ENDIF
-
- END
diff --git a/src/packlib/fatmen/fmvax/fmwto.F b/src/packlib/fatmen/fmvax/fmwto.F
deleted file mode 100644
index 41b1242..0000000
--- a/src/packlib/fatmen/fmvax/fmwto.F
+++ /dev/null
@@ -1,40 +0,0 @@
-*
-* $Id: fmwto.F,v 1.1.1.1 1996/03/07 15:18:23 mclareni Exp $
-*
-* $Log: fmwto.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:23 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- subroutine fmwto(string,len,irc)
- character*1 string(140)
-c
- parameter (dsc$k_class_s = 1)
- parameter (dsc$k_dtype_t = 14)
- parameter (ibufln = 128)
- integer*4 sys$sndopr
- include '($ssdef)'
- include '($opcdef)'
- integer*4 desc(2)
- integer*4 opstring(ibufln)
- logical*1 byte(128)
- equivalence (byte(1),opstring(1))
-
- desc(1) = (dsc$k_class_s)*2**24 + (dsc$k_dtype_t)*2**16 + ibufln
- desc(2) = %loc(byte(1))
-
- do i=1,128
- byte(i) = 0
- end do
-
- opstring(1) = (opc$_rq_rqst .or. (opc$m_nm_centrl*256))
-
- do i = 1,len
- byte(i+8) = ichar(string(i))
- end do
-
- istat = sys$sndopr(desc,,)
-#include "fatmen/fatvaxrc.inc"
- return
- end
diff --git a/src/packlib/fatmen/fmvax/fmxdsk.F b/src/packlib/fatmen/fmvax/fmxdsk.F
deleted file mode 100644
index a28855f..0000000
--- a/src/packlib/fatmen/fmvax/fmxdsk.F
+++ /dev/null
@@ -1,168 +0,0 @@
-*
-* $Id: fmxdsk.F,v 1.1.1.1 1996/03/07 15:18:22 mclareni Exp $
-*
-* $Log: fmxdsk.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:22 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
-#if defined(CERNLIB_VAXVMS)
- SUBROUTINE FMXDSK(CHDSN,DSN,IRC)
-*
-* If DSN contains logical name that is a search list,
-* find disk with most space and return fully qualified name
-*
-#include "fatmen/slate.inc"
-#include "fatmen/fatbug.inc"
- CHARACTER*(*) CHDSN,DSN
- CHARACTER*255 LOGNAM
-
- integer sys$getdviw
- structure /itmlst/
- union
- map
- integer*2 buffer_length
- integer*2 item_code
- integer*4 buffer_address
- integer*4 return_length_address
- endmap
- map
- integer*4 end_list
- endmap
- end union
- end structure
-
- record /itmlst/ dvi_list(5)
-
- include '($dvidef)'
- include '($ssdef)'
-
- data ivalid/Z0000800/
- data mntver/Z0004000/
-
- IRC = 0
- LDSN = LENOCC(CHDSN)
- DSN = CHDSN(1:LDSN)
-
- IF(IDEBFA.GE.1) PRINT *,'FMXDSK. enter for DSN = ',DSN(1:LDSN)
-
- LEND = INDEX(DSN(1:LDSN),':') -1
- IF(LEND.LE.0) RETURN
-*
-* Loop over all elements looking for the disk with max(freeblocks)
-*
- IOFF = 0
- MAX = 0
- 10 CONTINUE
- LOGNAM = ' '
- CALL FMGTEL(DSN(1:LEND),LOGNAM,'LNM$SYSTEM',IOFF,IC)
- LLOG = IS(1)
- IF(LLOG.EQ.0.OR.IC.NE.0) GOTO 30
-
- IF(IDEBFA.GE.1) PRINT *,'FMXDSK. checking element # ',IOFF+1,
- + ' of ',DSN(1:LEND)
-
- dvi_list(1).buffer_length = 4
- dvi_list(1).item_code = dvi$_mnt
- dvi_list(1).buffer_address = %loc(ismnt)
- dvi_list(1).return_length_address = %loc(lenmnt)
-
- dvi_list(2).buffer_length = 4
- dvi_list(2).item_code = dvi$_swl
- dvi_list(2).buffer_address = %loc(islock)
- dvi_list(2).return_length_address = %loc(lenlck)
-
- dvi_list(3).buffer_length = 4
- dvi_list(3).item_code = dvi$_sts
- dvi_list(3).buffer_address = %loc(istat)
- dvi_list(3).return_length_address = %loc(lensta)
-
- dvi_list(4).buffer_length = 4
- dvi_list(4).item_code = dvi$_freeblocks
- dvi_list(4).buffer_address = %loc(nfree)
- dvi_list(4).return_length_address = %loc(lenblk)
-
- dvi_list(5).end_list = 0
-
- ic = sys$getdviw(,,LOGNAM(1:LLOG),dvi_list,,,,)
-*
-* Does the device exist?
-*
- if(ic.eq.ss$_nosuchdev) then
- if(idebfa.ge.1) print 9001,lognam(1:llog)
-9001 format(' FMXDSK. device ',A,' rejected - no such device')
- goto 20
- endif
-*
-* Is it mounted?
-*
- if(ismnt.eq.0) then
- if(idebfa.ge.1) print 9002,lognam(1:llog)
-9002 format(' FMXDSK. device ',A,' rejected - not mounted')
- goto 20
- endif
-*
-* Is it s/w write locked?
-*
- if(islock.ne.0) then
- if(idebfa.ge.1) print 9003,lognam(1:llog)
-9003 format(' FMXDSK. device ',A,' rejected - write locked')
- goto 20
- endif
-*
-* Is it s/w valid?
-*
- if(iand(istat,ivalid).eq.0) then
- if(idebfa.ge.1) print 9004,lognam(1:llog)
-9004 format(' FMXDSK. device ',A,' rejected - not valid')
- goto 20
- endif
-*
-* Is it undergoing mount verification?
-*
- if(iand(istat,mntver).ne.0) then
- if(idebfa.ge.1) print 9005,lognam(1:llog)
-9005 format(' FMXDSK. device ',A,' rejected - in mount verification')
- goto 20
- endif
-
- IF(NFREE.GT.MAX) THEN
- MAX = NFREE
- JMAX = IOFF
- ENDIF
-
- IF(IDEBFA.GE.1) PRINT *,'FMXDSK. disk ',LOGNAM(1:LLOG),
- + ' has ',NFREE,' blocks'
-
- 20 CONTINUE
- IOFF = IOFF + 1
- GOTO 10
-
- 30 CONTINUE
-*
-* Was it a search list?
-*
- IF(MAX.EQ.0) RETURN
-*
-* Yes, get member with most free blocks
-*
- LOGNAM = ' '
- CALL FMGTEL(DSN(1:LEND),LOGNAM,'LNM$SYSTEM',JMAX,IC)
- LLOG = IS(1)
-*
-* and stick it back in the DSN
-*
- IF(INDEX(LOGNAM(1:LLOG),'.]').NE.0) THEN
- DSN = LOGNAM(1:LLOG-1) // DSN(LEND+3:LDSN)
- IS(1) = LLOG + LDSN - LEND - 2
- ELSEIF(INDEX(LOGNAM(1:LLOG),':').NE.0) THEN
- DSN = LOGNAM(1:LLOG) // DSN(LEND+2:LDSN)
- IS(1) = LLOG + LDSN - LEND - 1
- ELSE
- DSN = LOGNAM(1:LLOG) // DSN(LEND+1:LDSN)
- IS(1) = LLOG + LDSN - LEND
- ENDIF
-
- END
-#endif
diff --git a/src/packlib/fatmen/ibm/fatasm/faftidc.s b/src/packlib/fatmen/ibm/fatasm/faftidc.s
deleted file mode 100644
index 766016d..0000000
--- a/src/packlib/fatmen/ibm/fatasm/faftidc.s
+++ /dev/null
@@ -1,195 +0,0 @@
-*
-* $Id: faftidc.s,v 1.1.1.1 1996/03/07 15:17:36 mclareni Exp $
-*
-* $Log: faftidc.s,v $
-* Revision 1.1.1.1 1996/03/07 15:17:36 mclareni
-* Fatmen
-*
-*
-#if defined(CERNLIB_IBMMVS)
-#include "fatreg.inc"
-#include "fatbeg.inc"
-#include "fatschl.inc"
-#include "fatanf.inc"
-FAFTIDC CSECT
-**********************************************************************
-*
-* INVOZIERT IDCAMS
-*
-* AUFRUF: CALL FORTIDC(INLINE,OUTLINE,OUTLGTH,RET)
-*
-* INLINE ENTHAELT DIE INPUT-ZEILE FUER IDCAMS (LAENGE 80)
-* (NUR EINE ZEILE ERLAUBT).
-*
-* OUTLINE ENTHAELT DIE OUTPUT-ZEILE AUS IDCAMS (LAENGE 133)
-* (NUR EINE ZEILE ERLAUBT).
-*
-* OUTLGTH ENTHAELT DIE LAENGE DER OUTPUT-ZEILE (FULLWORD)
-*
-* RET ENTHAELT DEN RETURN-CODE VON IDCAMS (FULLWORD)
-* = 0 NORMALERWEISE
-* = MESSAGENR BEI IDCAMS MESSAGES
-* = -9999 BEI EOF
-*
-* NACH EOF SIND FORTIDC UND IDCAMS WIEDER JUNGFRAEULICH
-* UND KOENNEN MIT DER NAECHSTEN INPUT-KARTE GERUFEN WERDEN.
-* DER INPUT AUS INLINE WIRD NUR BEIM ALLERERSTEN AUFRUF VON
-* FORTIDC UND BEIM ERSTEN AUFRUF NACH RET = -9999 GELESEN.
-*
-* IDCAMS LIEST INPUT VOM PROGRAMM (WIE GESCHILDERT),
-* SYSPRINT WIRD INS PROGRAMM UMGELEITET.
-*
-* (C) P.KUHLMANN, DESY, 8.2.91
-**********************************************************************
- PRINT NOGEN
- REGISTER
- USING *,R12
- STM R14,R12,12(R13) SAVE REGISTERS
- LR R12,R15 SET UP BASE REGISTER
- LA R3,SAVE1 NEW SAVE AREA
- ST R3,R8(R13) SAVE ADDRESS OF NEW SAVE AREA
- ST R13,R4(R3) SAVE ADDRESS OF OLD SAVE AREA
- LR R13,R3 NEW SAVE AREA
-*
- L R2,0(R1) A(INPUT LINE)
- ST R2,INCARD STORE INTO IDCAMS INPUT PARAMETER
- L R2,4(R1) A(OUTPUT-LINE)
- ST R2,ALINE SAVE ADDRESS
- L R2,8(R1) A(LENGTH)
- ST R2,ALGTH SAVE ADDRESS
- L R2,12(R1) A(RETURNCODE)
- ST R2,ARET SAVE ADDRESS
-FIRST BC 0,NEXT FIRST TIME SWITCH
- OI FIRST+1,X'F0' INDICATE NOT FIRST TIME
-***************************************************************
-* *
-* INVOKE ACCESS METHOD SERVICES *
-* SPECIFY I/O-ROUTINES FOR SYSIN AND SYSPRINT *
-* *
-***************************************************************
- LOAD EP=IDCAMS LOAD IDCAMS
- LR R15,R0 GET A(IDCAMS)
- CALL (15),(OPT,OPT,OPT,AIOL),VL CALL IDCAMS
-* RETURN FROM IDCAMS
- NI FIRST+1,X'0F' RESET FIRST TIME SWITCH
- NI GETIN+1,X'0F' RESET FIRST TIME SWITCH
- LH R1,=H'-9999' INDICATE END OF IDCAMS
- L R2,ARET GET ADDRESS OF RETURNCODE
- ST R1,0(R2) SET RETURN CODE
- B EXIT0 RETURN TO CALLER
-*
- DS 0F IDCAMS PARAMETER LIST:
-OPT DC H'0' NO IDCAMS OPTIONS
-AIOL DC F'2' 2 ENTRIES IN IO LIST
- DC A(DDSYSIN) SYSIN
- DC A(GETC) ROUTINE TO SATISFY SYSIN REQUESTS
- DC A(0)
- DC A(DDSYSPRT) SYSPRINT
- DC A(PUTC) ROUTINE TO SATISFY SYSPRINT REQUESTS
- DC A(0)
-DDSYSIN DC CL10'DDSYSIN'
-DDSYSPRT DC CL10'DDSYSPRINT'
-SAVE DS 18F SAVE AREA WHEN CALLED FROM IDCAMS
-SAVE1 DS 18F SAVE AREA WHEN CALLED FROM CALLER
-***************************************************************
-* *
-* INPUT ROUTINE *
-* TO SUBMIT INPUT CARDS TO AMS *
-* *
-***************************************************************
-GETC STM R14,R12,12(R13) SAVE REGISTERS ON CALL FROM IDCAMS
- LR R12,R15
- LA R15,GETC-FAFTIDC
- SR R12,R15 SET UP BASE REGISTER
- LA R3,SAVE NEW SAVE AREA ON CALL FROM IDCAMS
- ST R3,R8(R13) SAVE NEW SAVE AREA
- ST R13,R4(R3) SAVE OLD SAVE AREA
- LR R13,R3 NEW SAVE AREA
-*
- L R2,4(R1) A(IOFLAGS)
- XR R3,R3
- IC R3,0(R2) GET KIND OF REQUEST FROM IDCAMS
- B LISTIN(R3) BRANCH RESPECTIVELY
-LISTIN B OPENIN OPEN FOR INPUT
- B CLOSEIN CLOSE INPUT
- B GETIN GET INPUT
- B PUTIN PUT INPUT (SHOULD NEVER OCCUR)
-*
-OPENIN TM 1(R2),X'A0' OPEN FOR INPUT WITH DDNAME ?
- BNO ABEND
- L R2,8(R1) A(DDNAME)
- CLC 0(8,R2),DDSYSIN+2 SYSIN ?
- BNE ABEND
- B EXIT0 YES, RETURN TO IDCAMS
-*
-GETIN BC 0,EOF FIRST TIME SWITCH
- OI GETIN+1,X'F0' INDICATE NOT FIRST TIME
- L R2,=A(INCARD) CURRENT INPUT CARD
- L R3,8(R1)
- MVC 0(8,R3),0(R2) DATA ADDRESS AND LENGTH TO IDCAMS
- B EXIT0 RETURN TO IDCAMS
-EOF SCHL RET=4 INDICATE END OF INPUT TO IDCAMS
-INCARD DS F
- DC F'80'
-***************************************************************
-* *
-* OUTPUT ROUTINE *
-* TO COLLECT MESSAGES FROM AMS *
-* *
-***************************************************************
-PUTC STM R14,R12,12(R13) SAVE REGISTERS
- LR R12,R15
- LA R15,PUTC-FAFTIDC
- SR R12,R15 SET UP BASE REGISTER
- LA R3,SAVE NEW SAVE AREA ON CALL FROM IDCAMS
- ST R3,R8(R13) SAVE NEW SAVE AREA
- ST R13,R4(R3) SAVE OLD SAVE AREA
- LR R13,R3 NEW SAVE AREA
-*
- LR R8,R1 SAVE PARAMETER REGISTER
- L R2,4(R8) A(IOFLAGS)
- XR R3,R3
- IC R3,0(R2) GET KIND OF REQUEST FROM IDCAMS
- LH R6,2(R2) GET MESSAGE NR
- B LISTOUT(R3) BRANCH RESPECTIVELY
-LISTOUT B OPENOUT OPEN FOR OUTPUT
- B CLOSEOUT CLOSE OUTPUT
- B GETOUT GET OUTPUT (SHOULD NEVER OCCUR)
- B PUTOUT PUT OUTPUT
-*
-OPENOUT TM 1(R2),X'60' OPEN FOR OUTPUT WITH DDNAME ?
- BNO ABEND
- L R2,8(R8) A(DSNAME)
- CLC 0(8,R2),DDSYSPRT+2 SYSPRINT
- BNE ABEND
- B EXIT0
-*
-PUTOUT L R2,8(R8) PUT LIST
- L R3,0(R2) A(OUTPUT LINE)
- L R4,4(R2) LENGTH OF PUTPUT LINE
- L R5,ALGTH
- ST R4,0(R5) SET OUTPUT LGTH
- BCTR R4,0
- L R5,ALINE RESTORE OUTPUT POINTER ADDRESS
- EX R4,MOVLN SET OUTPUT LINE
- L R2,ARET RESTORE ADDRESS OF RETURN CODE
- ST R6,0(R2) SET MESSAGE NUMBER
- LA R13,SAVE1 RESTORE CALLERS SAVE ROUTINE
- B EXIT0 EXIT TO CALLER
-MOVLN MVC 0(1,R5),0(R3)
-*
-NEXT LA R13,SAVE RETURN FROM CALLER
-CLOSEIN EQU * CLOSE FOR INPUT
-CLOSEOUT EQU * CLOSE FOR OUTPUT
-EXIT0 SCHL RET=0 RETURN TO IDCAMS
-*
-PUTIN EQU * PUT INPUT
-GETOUT EQU * GET OUTPUT
-ABEND ABEND 1,DUMP
-*
-ALINE DS F A(OUTPUT LINE)
-ALGTH DS F A(OUTPUT LENGTH)
-ARET DS F A(RETURN CODE)
-*
- END FAFTIDC
-#endif
diff --git a/src/packlib/fatmen/ibm/fatasm/fmhost.s b/src/packlib/fatmen/ibm/fatasm/fmhost.s
deleted file mode 100644
index 5c0f74e..0000000
--- a/src/packlib/fatmen/ibm/fatasm/fmhost.s
+++ /dev/null
@@ -1,130 +0,0 @@
-*
-* $Id: fmhost.s,v 1.1.1.1 1996/03/07 15:17:36 mclareni Exp $
-*
-* $Log: fmhost.s,v $
-* Revision 1.1.1.1 1996/03/07 15:17:36 mclareni
-* Fatmen
-*
-*
-#if defined(CERNLIB_IBMMVS)
-#include "fatreg.inc"
-#include "fatbeg.inc"
-#include "fatschl.inc"
-#include "fatanf.inc"
-* 30/01/91 101301642 MEMBER NAME SYSCON (X.S) ASSEMBLER
-***********************************************************************
-* *
-* S Y S C O N *
-* *
-* Written by Dietrich Moenkemeyer DESY Hamburg *
-* *
-* January 1991 *
-* *
-***********************************************************************
-* *
-* This routine returns some system constants.
-* *
-***********************************************************************
-* *
-* CALL: CALL SYSCON(node,system,model) *
-* *
-* Output: node 8 BYTES node name *
-* system 8 BYTES operating system *
-* model 8 BYTES CPU model number *
-* *
-* LKED: reentrant, 31bit *
-* *
-***********************************************************************
-* Change activity: *
-***********************************************************************
-*
- REGISTER
-FMHOST BEG *,MODE=RENT,RMODE=ANY
-*
- LR R9,R1 SAVE ADDRESS OF ARGUMENTLIST
-*
-**********************************************************************
-* *
-* Branch to amode 31 code to get the system constants *
-* *
-**********************************************************************
-*
- LA R15,ABOVE LOAD BRANCH ADDRESS
- L R1,BIT32
- OR R15,R1 SET AMODE 31 BIT
- BASSM R14,R15 BRANCH, SET AMODE AND SAVE OLD AMODE
- SCHL RET=(R15),MODE=RENT
-*
-**********************************************************************
-* *
-* Get system constants from the CVT *
-* *
-**********************************************************************
-*
-ABOVE L R2,CVTPTR
- LR R4,R2
- SH R4,=AL2(CVTMAP-CVTFIX)
- USING CVTFIX,R4 MAKE CVT PRFIX ADDRESSABLE
- USING CVTMAP,R2 MAKE CVT ADDESSABLE
-*
-* GET NODE NAME (FIXED)
-*
- L R1,0(R9)
- MVC 0(8,R1),NODE MOVE NODENAME
-*
-* GET OPERATING SYSTEM
-*
- L R1,4(R9)
- MVC 0(8,R1),OPVM
- TM CVTDCB,CVT1SSS VM
- BO SYS010
- MVC 0(8,R1),OPMVSXA
- TM CVTDCB,CVTMVSE+CVT8AOS2 MVS-XA
- BO SYS010
- MVC 0(8,R1),OPMVS
- TM CVTDCB,CVT8AOS2 MVS
- BO SYS010
- MVC 0(8,R1),OPMVT
- TM CVTDCB,CVT4MS1 MVT
- BO SYS010
- MVC 0(8,R1),OPMFT
- TM CVTDCB,CVT2SPS MFT
- BO SYS010
-*
-* GET CPU MODEL ID
-*
-SYS010 L R1,8(R9)
- MVC 0(8,R1),=CL8' ' INIT WITH BLANKS
- MVC 3(1,R1),CVTMDL+1 GET LAST DIGIT
- OI 3(R1),X'F0' MAKE IT PRINTABLE
- UNPK 0(3,R1),CVTMDL GET OTHER DIGITS
- OI 2(R1),X'F0' MAKE IT PRINTABLE
-*
- XR R15,R15
-RET15 BSM R0,R14 RETURN AND RESET AMODE
-*
-**********************************************************************
-* *
-* FIXED DATA AREA *
-* *
-**********************************************************************
-*
- DS 0F
-BIT32 DC XL4'80000000'
-NODE DC CL8'DHHDESY3'
-OPMVSXA DC CL8'MVS/XA'
-OPVM DC CL8'VM'
-OPMFT DC CL8'MFT'
-OPMVT DC CL8'MVT'
-OPMVS DC CL8'MVS'
- LTORG
-*
-**********************************************************************
-* *
-* D S E C T S *
-* *
-**********************************************************************
-*
- CVT DSECT=YES,PREFIX=YES,LIST=YES
- END
-#endif
diff --git a/src/packlib/fatmen/ibm/fatasm/fmjobn.s b/src/packlib/fatmen/ibm/fatasm/fmjobn.s
deleted file mode 100644
index 23225ff..0000000
--- a/src/packlib/fatmen/ibm/fatasm/fmjobn.s
+++ /dev/null
@@ -1,71 +0,0 @@
-*
-* $Id: fmjobn.s,v 1.1.1.1 1996/03/07 15:17:36 mclareni Exp $
-*
-* $Log: fmjobn.s,v $
-* Revision 1.1.1.1 1996/03/07 15:17:36 mclareni
-* Fatmen
-*
-*
-#if defined(CERNLIB_IBMMVS)
-*
-* FMJOBN PROGRAM
-* GIVES SOME JOB CARD PARAMETERS IN BATCH MODE
-*
-* AUTHOR:
-* G. WEIL CENTRE DE CALCUL DE STRASBOURG (CNRS)
-*
-* CALLING SEQUENCE:
-* CALL FMJOBN ( JOBID )
-*
-* JOBID CHARACTER*8 = JOB NAME (OUTPUT)
-*
-*
-FMJOBN START 0
-R0 EQU 0
-R1 EQU 1
-R2 EQU 2
-R3 EQU 3
-R4 EQU 4
-R5 EQU 5
-R6 EQU 6
-R7 EQU 7
-R8 EQU 8
-R9 EQU 9
-R10 EQU 10
-R11 EQU 11
-R12 EQU 12
-R13 EQU 13
-R14 EQU 14
-R15 EQU 15
-*
- USING *,R12
- SAVE (14,12)
- LR R12,R15
- LR R11,R13
- LA R13,OUTSAVE
- ST R11,4(R13)
- ST R13,8(R11)
-*
- LR R11,R1 LISTE ARGUMENTS
- EXTRACT ADR,'S',FIELDS=TIOT
- L R7,ADR
- USING TIOT1,R7
- L R10,0(R11) ARG JOB ID
- MVC 0(8,R10),TIOCNJOB
-* L R10,4(R11) ARG COMPTA
-* MVC 0(4,R10),TIOCNJOB
-* L R10,8(R11) 3IEM ARGUMENT
-* MVC 0(8,R10),=CL8'DUMMY '
-*
- L R13,4(R13)
- RETURN (14,12),T,RC=0
-*
-ADR DS 2F
-OUTSAVE DS 18F
- PRINT ON,NOGEN
- IKJTCB DSECT=YES,LIST=NO
- IEZJSCB
-TIOTSECT DSECT
- IEFTIOT1
- END
-#endif
diff --git a/src/packlib/fatmen/ibm/fatstat/fatcnt.F b/src/packlib/fatmen/ibm/fatstat/fatcnt.F
deleted file mode 100644
index 341352e..0000000
--- a/src/packlib/fatmen/ibm/fatstat/fatcnt.F
+++ /dev/null
@@ -1,45 +0,0 @@
-*
-* $Id: fatcnt.F,v 1.1.1.1 1996/03/07 15:17:36 mclareni Exp $
-*
-* $Log: fatcnt.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:36 mclareni
-* Fatmen
-*
-*
-#if defined(CERNLIB_IBMVM)
-#include "sys/CERNLIB_machine.h"
-#include "_fatmen/pilot.h"
- SUBROUTINE FATCNT(LUNRZ)
- DIMENSION IBUF(1024)
- CHARACTER*132 LINE
- NZERO = 0
- NLAST = 0
- CALL VMCMS('LISTFILE CERN FATRZ * (L STACK',IRC)
- CALL VMRTRM(LINE,LEN)
- READ(LINE,'(34X,I10)') NREC
- PRINT 9001,NREC
- DO 10 IREC=1,NREC
- READ(UNIT=LUNRZ,REC=IREC,ERR=30) IBUF
-*
-* Check which is the last non-zero record
-* Count total number of zeroed records
-*
- DO 20 I=1,1024
- IF(IBUF(I).NE.0) THEN
- NLAST = IREC
- GOTO 10
- ENDIF
-20 CONTINUE
- NZERO = NZERO + 1
-10 CONTINUE
- PRINT 9002,NZERO,NREC-NZERO,NLAST
- RETURN
-30 CONTINUE
- PRINT 9003,IREC
-9001 FORMAT(' FATCNT. Total of ',I5,' records in CERN FATRZ')
-9002 FORMAT(' FATCNT. Total of ',I5,' zeroed records, number used = ',
- +I5,' last used = ',I5)
-9003 FORMAT(' FATCNT. Error at record ',I5)
- RETURN
- END
-#endif
diff --git a/src/packlib/fatmen/ibm/fatstat/fatsiz.F b/src/packlib/fatmen/ibm/fatstat/fatsiz.F
deleted file mode 100644
index c98539c..0000000
--- a/src/packlib/fatmen/ibm/fatstat/fatsiz.F
+++ /dev/null
@@ -1,75 +0,0 @@
-*
-* $Id: fatsiz.F,v 1.1.1.1 1996/03/07 15:17:36 mclareni Exp $
-*
-* $Log: fatsiz.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:36 mclareni
-* Fatmen
-*
-*
-#if defined(CERNLIB_IBMVM)
-#include "sys/CERNLIB_machine.h"
-#include "_fatmen/pilot.h"
- SUBROUTINE FATSIZ
-#include "fatpara.inc"
- PARAMETER (LURCOR=200000)
- COMMON/CRZT/IXSTOR,IXDIV,IFENCE(2),LEV,LEVIN,BLVECT(LURCOR)
- DIMENSION LQ(999),IQ(999),Q(999)
- EQUIVALENCE (IQ(1),Q(1),LQ(9)),(LQ(1),LEV)
-*
- COMMON /USRLNK/LUSRK1,LUSRBK,LUSRLS
-*
- COMMON /QUEST/IQUEST(100)
- PARAMETER (MAXKEY=10000)
- PARAMETER (MAXFIL=10000)
- PARAMETER (MAXLEV=100)
- PARAMETER (LKEYFA=10)
- DIMENSION KEYS(LKEYFA,MAXKEY)
- CHARACTER*20 FILES(MAXKEY)
- CHARACTER*255 SUBDIR(MAXFIL)
- DATA NTOTAL/0/,NEMPTY/0/
-*
-* Find names of subdirectories in this RZ file...
-*
- CALL FMTREE('//CERN',SUBDIR,MAXLEV,NFOUND,MAXFIL,IRC)
- IF(IRC.NE.0) THEN
- PRINT 9001,IRC
- RETURN
- ELSE
- PRINT 9002,NFOUND
- ENDIF
-*
-* Now process each subdirectory in turn
-*
- DO 10 I=1,NFOUND
-*
-* Find number of files in current directory
-*
- LSUB = LENOCC(SUBDIR(I))
- IF(IDEBFA.GT.2) PRINT 9003,SUBDIR(I)(1:LSUB)
-
- CALL FMFNMS(SUBDIR(I)(1:LSUB),FILES,KEYS,NKEYS,MAXKEY,IRC)
- IF(IRC.NE.0) THEN
- PRINT 9004,IRC
- RETURN
- ENDIF
-
- IF(IDEBFA.GT.2) PRINT 9005,NKEYS,SUBDIR(I)(1:LSUB)
-
- IF(NKEYS.EQ.0) NEMPTY = NEMPTY + 1
- NTOTAL = NTOTAL + NKEYS
-
-10 CONTINUE
-
- PRINT 9006,NTOTAL,NFOUND,NEMPTY
-
-9001 FORMAT(' FATSIZ. Return code ',I5,' from FMTREE')
-9002 FORMAT(' FATSIZ. ',I5,' subdirectories found')
-9003 FORMAT(' FATSIZ. Processing directory ',A)
-9004 FORMAT(' FATSIZ. Return code ',I5,' from FMFNMS')
-9005 FORMAT(' FATSIZ. ',I5,' files in ',A)
-9006 FORMAT(' FATSIZ. ',I5,' files in ',I5,' subdirectories of which ',
- + I5,' are empty')
-
- END
-
-#endif
diff --git a/src/packlib/fatmen/ibm/fatstat/fatstat.F b/src/packlib/fatmen/ibm/fatstat/fatstat.F
deleted file mode 100644
index 30fac27..0000000
--- a/src/packlib/fatmen/ibm/fatstat/fatstat.F
+++ /dev/null
@@ -1,78 +0,0 @@
-*
-* $Id: fatstat.F,v 1.1.1.1 1996/03/07 15:17:36 mclareni Exp $
-*
-* $Log: fatstat.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:36 mclareni
-* Fatmen
-*
-*
-#if defined(CERNLIB_IBMVM)
-#include "sys/CERNLIB_machine.h"
-#include "_fatmen/pilot.h"
- PROGRAM FATSTAT
-*----------------------------------------------------------------------*
-* *
-* Test FATMEN program. Count number of directories, files and *
-* quota in FATMEN RZ file 'CERN FATRZ' *
-* *
-*----------------------------------------------------------------------*
- PARAMETER (LURCOR=200000)
- COMMON/CRZT/IXSTOR,IXDIV,IFENCE(2),LEV,LEVIN,BLVECT(LURCOR)
- DIMENSION LQ(999),IQ(999),Q(999)
- EQUIVALENCE (IQ(1),Q(1),LQ(9)),(LQ(1),LEV)
-*
- COMMON /USRLNK/LUSRK1,LUSRBK,LUSRLS
-*
- COMMON /QUEST/IQUEST(100)
-*
- PARAMETER (LKEYFA=10)
- DIMENSION KEY(LKEYFA)
- CHARACTER*8 THRONG
-*
-*
-* Initialise ZEBRA
-*
- CALL MZEBRA(-3)
- CALL MZSTOR(IXSTOR,'/CRZT/','Q',IFENCE,LEV,BLVECT(1),BLVECT(1),
- + BLVECT(5000),BLVECT(LURCOR))
- CALL MZLOGL(IXSTOR,-3)
-
-*
-* *** Define user division and link area like:
-*
- CALL MZDIV (IXSTOR, IXDIV, 'USERS', 50000, LURCOR, 'L')
- CALL MZLINK (IXSTOR, '/USRLNK/', LUSRK1, LUSRLS, LUSRK1)
-*
-* Units for FATMEN RZ/FZ files
-*
- LUNRZ = 1
- LUNFZ = 2
-*
-* Get name of throng from REXX variable THRONG
-*
- CALL VMREXX('F','THRONG',THRONG,IRC)
-*
-* Initialise FATMEN
-*
- CALL FMINIT(IXSTOR,LUNRZ,LUNFZ,
- +'//CERN/'//THRONG(1:LENOCC(THRONG)),IRC)
-*
-* Set maximum log level
-*
- CALL FMLOGL(3)
-*
-* Call routine to process RZ file
-*
- CALL FATSIZ
-*
-* Call routine to count number of zero/non-zero blocks
-*
- CALL FATCNT(LUNRZ)
-*
-* Terminate cleanly
-*
- CALL FMEND(IRC)
-
- END
-
-#endif
diff --git a/src/packlib/fatmen/ibm/fatstat/fsexec.dat b/src/packlib/fatmen/ibm/fatstat/fsexec.dat
deleted file mode 100644
index 402e81a..0000000
--- a/src/packlib/fatmen/ibm/fatstat/fsexec.dat
+++ /dev/null
@@ -1,36 +0,0 @@
-*
-* $Id: fsexec.dat,v 1.1.1.1 1996/03/07 15:17:36 mclareni Exp $
-*
-* $Log: fsexec.dat,v $
-* Revision 1.1.1.1 1996/03/07 15:17:36 mclareni
-* Fatmen
-*
-*
-#if defined(CERNLIB_IBMVM)
-/*EXEC to run FATSIZE program*/
-Arg throng .
-If Strip(throng) = '' then exit
-'MAKEBUF'
-'QUERY TXTLIB (STACK'
-Pull . . txtlib
-if index(txtlib,'FAT') = 0 then 'EXEC CERNLIB FATLIB'
-'DROPBUF'
-'DROP F (QUIET)'
-'MAKEBUF'
-'LISTFILE CERN FATRZ * (STACK'
-Do queued()
- Pull line
- mode = word(line,3)
- 'DROP' mode '(QUIET)'
- End
-'DROPBUF'
-If substr(throng,1,2) ^= 'FM' then throng = 'FM' || throng
-Signal on error
-'EXEC GIME 'throng' F (NONOTICE QUIET)'
-'DROP F (QUIET)'
-throng = substr(throng,3)
-'LOAD FATSIZE (NOMAP NOAUTO START)'
- Exit
-Error:
- Say 'Aaaarrrrrghhh!'
-#endif
diff --git a/src/packlib/fatmen/l3util/Imakefile b/src/packlib/fatmen/l3util/Imakefile
deleted file mode 100644
index 83db276..0000000
--- a/src/packlib/fatmen/l3util/Imakefile
+++ /dev/null
@@ -1,3 +0,0 @@
-SRCS_F= dbpktm.F dbpkts.F dbuptm.F dbupts.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/fatmen/l3util/dbpktm.F b/src/packlib/fatmen/l3util/dbpktm.F
deleted file mode 100644
index a9fc01f..0000000
--- a/src/packlib/fatmen/l3util/dbpktm.F
+++ /dev/null
@@ -1,57 +0,0 @@
-*
-* $Id: dbpktm.F,v 1.2 1998/03/05 14:53:39 mclareni Exp $
-*
-* $Log: dbpktm.F,v $
-* Revision 1.2 1998/03/05 14:53:39 mclareni
-* Modifications supplied by L3 to allow dates up to 2010
-*
-* Revision 1.1.1.1 1996/03/07 15:18:23 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE DBPKTM (IDATE, ITIME, IDATM)
-* =======================================
-*
-************************************************************************
-* *
-* SUBR. DBPKTM (IDATE, ITIME, IDATM*) *
-* *
-* Packs date and time into one word *
-* *
-* Arguments : *
-* *
-* IDATE Date : 6 Decimal integer : YYMMDD *
-* ITIME Time : 4 Decimal integer : HHMM *
-* IDATM* Packed date-time *
-* *
-* Called by user, DBDELT, DBDONT, DBEFOR, DBENTB, DBINIT, DBMDIP, *
-* DBPRGD, DBRDIC, DBRTFZ, DBCDIC, DBENFZ, DBKOUT, DBSDIR, *
-* DBSNAM, DBSPUR, DBUDIC, DBPLOB, DBAUXI, DBDCKH, DBDCKV, *
-* DBRVNT, DBRVPL *
-* *
-************************************************************************
-*
-#include "fatmen/dtmpak.inc"
-* ------------------------------------------------------------------
-*
- IMIN = MOD(ITIME,100)
- IHOU = ITIME/100
-*
- IDAY = MOD(IDATE,100)
- IYEA = IDATE/100
- IMON = MOD(IYEA,100)
- IYEA = MOD(IYEA/100,1000)
- IF (IYEA.LT.80) IYEA = IYEA + 100
-*
- IDATM = IMIN
- MAXX = MXMIN
- IDATM = IDATM + MAXX*IHOU
- MAXX = MAXX*MXHOU
- IDATM = IDATM + MAXX*IDAY
- MAXX = MAXX*MXDAY
- IDATM = IDATM + MAXX*IMON
- MAXX = MAXX*MXMON
- IDATM = IDATM + MAXX*IYEA
-* END DBPKTM
- END
diff --git a/src/packlib/fatmen/l3util/dbpkts.F b/src/packlib/fatmen/l3util/dbpkts.F
deleted file mode 100644
index 0c3236b..0000000
--- a/src/packlib/fatmen/l3util/dbpkts.F
+++ /dev/null
@@ -1,62 +0,0 @@
-*
-* $Id: dbpkts.F,v 1.2 1998/03/05 14:53:40 mclareni Exp $
-*
-* $Log: dbpkts.F,v $
-* Revision 1.2 1998/03/05 14:53:40 mclareni
-* Modifications supplied by L3 to allow dates up to 2010
-*
-* Revision 1.1.1.1 1996/03/07 15:18:23 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE DBPKTS (IDATE, ITIME, IDATM)
-* =======================================
-*
-************************************************************************
-* *
-* SUBR. DBPKTS (IDATE, ITIME, IDATM*) *
-* *
-* Packs date and time into one word *
-* *
-* Arguments : *
-* *
-* IDATE Date : 6 Decimal integer : YYMMDD *
-* (Only Year > 80 allowed) *
-* ITIME Time : 6 Decimal integer : HHMMSS *
-* IDATM* Packed date-time *
-* *
-* Called by user, DBCDIC, DBFRST, DBRDIC, DBSNAM, DBUDIC, DBPLNT, *
-* DBPLOB, DBPLOV, DBPLTI, DBAUXI, DBDCKH, DBDCKV, DVRVNT, *
-* DBRVPL, DBVIEW *
-* *
-************************************************************************
-*
-#include "fatmen/dtmpak.inc"
-* ------------------------------------------------------------------
-*
- ISEC = MOD(ITIME,100)
- IHOU = ITIME/100
- IMIN = MOD(IHOU,100)
- IHOU = IHOU/100
-*
- IDAY = MOD(IDATE,100)
- IYEA = IDATE/100
- IMON = MOD(IYEA,100)
- IYEA = IYEA/100 - 80
- IF (IYEA.LT.0) IYEA = IYEA + 100
- IF (IYEA.GT.MXYER) IYEA = MXYER
-*
- IDATM = ISEC
- MAXX = MXSEC
- IDATM = IDATM + MAXX*IMIN
- MAXX = MAXX*MXMIN
- IDATM = IDATM + MAXX*IHOU
- MAXX = MAXX*MXHOU
- IDATM = IDATM + MAXX*IDAY
- MAXX = MAXX*MXDAY
- IDATM = IDATM + MAXX*IMON
- MAXX = MAXX*MXMON
- IDATM = IDATM + MAXX*IYEA
-* END DBPKTS
- END
diff --git a/src/packlib/fatmen/l3util/dbuptm.F b/src/packlib/fatmen/l3util/dbuptm.F
deleted file mode 100644
index b391064..0000000
--- a/src/packlib/fatmen/l3util/dbuptm.F
+++ /dev/null
@@ -1,50 +0,0 @@
-*
-* $Id: dbuptm.F,v 1.2 1998/03/05 14:53:41 mclareni Exp $
-*
-* $Log: dbuptm.F,v $
-* Revision 1.2 1998/03/05 14:53:41 mclareni
-* Modifications supplied by L3 to allow dates up to 2010
-*
-* Revision 1.1.1.1 1996/03/07 15:18:23 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE DBUPTM (IDATE, ITIME, IDATM)
-* =======================================
-*
-************************************************************************
-* *
-* SUBR. DBUPTM (IDATE*, ITIME*, IDATM) *
-* *
-* Unpacks date and time from one word *
-* *
-* Arguments : *
-* *
-* IDATE* Date : 6 Decimal integer : YYMMDD *
-* ITIME* Time : 4 Decimal integer : HHMM *
-* IDATM Packed date-time *
-* *
-* Called by user, DBFZUP, DBLKEY, DBNTOP, DBPRGD, DBSRTM, DBENFZ, *
-* DBPLOB, DBDKYH, DBDKYV *
-* *
-************************************************************************
-*
-#include "fatmen/dtmpak.inc"
-* ------------------------------------------------------------------
-*
- III = IDATM
- IMIN = MOD(III,MXMIN)
- III = (III-IMIN)/MXMIN
- IHOU = MOD(III,MXHOU)
- III = (III-IHOU)/MXHOU
- IDAY = MOD(III,MXDAY)
- III = (III-IDAY)/MXDAY
- IMON = MOD(III,MXMON)
- IYEA = (III-IMON)/MXMON
- IYEA = MOD(IYEA,100)
-*
- IDATE = IDAY + 100*IMON + 10000*IYEA
- ITIME = IMIN + 100*IHOU
-* END DBUPTM
- END
diff --git a/src/packlib/fatmen/l3util/dbupts.F b/src/packlib/fatmen/l3util/dbupts.F
deleted file mode 100644
index 69b0e1e..0000000
--- a/src/packlib/fatmen/l3util/dbupts.F
+++ /dev/null
@@ -1,52 +0,0 @@
-*
-* $Id: dbupts.F,v 1.2 1998/03/05 14:53:41 mclareni Exp $
-*
-* $Log: dbupts.F,v $
-* Revision 1.2 1998/03/05 14:53:41 mclareni
-* Modifications supplied by L3 to allow dates up to 2010
-*
-* Revision 1.1.1.1 1996/03/07 15:18:23 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE DBUPTS (IDATE, ITIME, IDATM)
-* =======================================
-*
-************************************************************************
-* *
-* SUBR. DBUPTS (IDATE*, ITIME*, IDATM) *
-* *
-* Unpacks date and time from one word *
-* *
-* Arguments : *
-* *
-* IDATE* Date : 6 Decimal integer : YYMMDD *
-* ITIME* Time : 6 Decimal integer : HHMMSS *
-* IDATM Packed date-time *
-* *
-* Called by user, DBPLOB, DBPLOV, DBPLTI, DBAUXI, DBDISD, DBDKYH, *
-* DBDKYV *
-* *
-************************************************************************
-*
-#include "fatmen/dtmpak.inc"
-* ------------------------------------------------------------------
-*
- III = IDATM
- ISEC = MOD(III,MXSEC)
- III = (III-ISEC)/MXSEC
- IMIN = MOD(III,MXMIN)
- III = (III-IMIN)/MXMIN
- IHOU = MOD(III,MXHOU)
- III = (III-IHOU)/MXHOU
- IDAY = MOD(III,MXDAY)
- III = (III-IDAY)/MXDAY
- IMON = MOD(III,MXMON)
- IYEA = (III-IMON)/MXMON + 80
- IYEA = MOD(IYEA,100)
-*
- IDATE = IDAY + 100*IMON + 10000*IYEA
- ITIME = ISEC + 100*IMIN + 10000*IHOU
-* END DBUPTS
- END
diff --git a/src/packlib/fatmen/programs/Imakefile b/src/packlib/fatmen/programs/Imakefile
deleted file mode 100644
index 04819dc..0000000
--- a/src/packlib/fatmen/programs/Imakefile
+++ /dev/null
@@ -1,9 +0,0 @@
-#define IHaveSubdirs
-#define PassCDebugFlags
-
-PROGRAMDIRS= fatback fmkuip fatnew fatsend fatsrv
-
-SUBDIRS= $(PROGRAMDIRS)
-
-InstallBinSubdirs($(PROGRAMDIRS))
-
diff --git a/src/packlib/fatmen/programs/cheops2f/Imakefile b/src/packlib/fatmen/programs/cheops2f/Imakefile
deleted file mode 100644
index fedde3b..0000000
--- a/src/packlib/fatmen/programs/cheops2f/Imakefile
+++ /dev/null
@@ -1,3 +0,0 @@
-SRCS_F= cheops2f.F fmbtof.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/fatmen/programs/cheops2f/cheops2f.F b/src/packlib/fatmen/programs/cheops2f/cheops2f.F
deleted file mode 100644
index 1b15b5a..0000000
--- a/src/packlib/fatmen/programs/cheops2f/cheops2f.F
+++ /dev/null
@@ -1,315 +0,0 @@
-*
-* $Id: cheops2f.F,v 1.1.1.1 1996/03/07 15:17:36 mclareni Exp $
-*
-* $Log: cheops2f.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:36 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- PROGRAM CHEOPS2F
-*
-* Program to read CHEOPS .rqid and .rep files and update
-* FATMEN catalogue accordingly
-*
-#include "fatmen/slate.inc"
-#include "zebra/quest.inc"
-#include "fatmen/cheops.inc"
- INTEGER SYSTEMF
- LOGICAL EXIST
- CHARACTER*8 CHWAKE
- CHARACTER*20 CHREQ
- CHARACTER*255 CHDIR,CHFILE,CHNAME,CHSTR
- CHARACTER*255 CHLINE,CHSRCE,CHDEST
- PARAMETER (LURCOR=250000)
- COMMON/CRZT/IXSTOR,IXDIV,IFENCE(2),LEV,LEVIN,BLVECT(LURCOR)
- DIMENSION LQ(999),IQ(999),Q(999)
- EQUIVALENCE (IQ(1),Q(1),LQ(9)),(LQ(1),LEV)
-*
- COMMON/USRLNK/LSRCBK,LDSTBK
- INTEGER FMHOST,FMUSER,FAFNDF
- CHARACTER*12 CHUSER,CHSYS,CHLOG
- CHARACTER*80 CHCOMM
-*
-#include "fatmen/fatpara.inc"
-#include "fatmen/fatbug.inc"
- ILOG = 0
- LUNRZ = 1
- LUFZFA = 2
- LUNREQ = 3
- LPRTFA = 6
-*
-*
-* Initialise ZEBRA
-*
- CALL MZEBRA(-3)
- CALL MZSTOR(IXSTOR,'/CRZT/','Q',IFENCE,LEV,BLVECT(1),BLVECT(1),
- + BLVECT(5000),BLVECT(LURCOR))
-
- CALL MZLOGL(IXSTOR,-3)
-*
-* *** Define user division and link area like:
-*
- CALL MZDIV (IXSTOR,IXDIV,'USERS',50000,LURCOR, 'L')
- CALL MZLINK(IXSTOR,'/USRLNK/',LSRCBK,LDSTBK,LSRCBK)
-*
-* I/O descriptor for FATMEN bank
-*
- CALL MZFORM('DSFA','66H 3I 11H 8I 1H 2I 2H 3I 8H 21I 20H',IODSFA)
-
- CALL GETENVF('FMWAKEUP',CHWAKE)
- LCHW = IS(1)
- IF(LCHW.GT.0) THEN
- IC = 0
- ELSE
- IC = -1
- ENDIF
-
- IF(IC.EQ.0) THEN
- ISLEEP = ICDECI(CHWAKE,1,8)
- ENDIF
- IF(ISLEEP.EQ.0) THEN
- ISLEEP = 60
- WRITE(CHWAKE,'(I8.8)') ISLEEP
- ENDIF
-*
-* Print FATMEN version number
-*
- CALL FMVERS
-*
- PRINT *,'CHEOPS. wakeup interval is ',ISLEEP,' seconds'
-*
-* Set logging level
-*
- CALL GETENVF('FMLOGL',CHLOG)
- IF(IS(1).GT.0) ILOG = ICDECI(CHLOG,1,8)
- CALL FMLOGL(ILOG)
-*
-* Find queue directory
-*
- CALL GETENVF('FMCHEOPS',CHDIR)
- IF(IS(1).EQ.0) THEN
- CHDIR = '/fatmen/fmcheops'
- LDIR = 16
- IF(IDEBFA.GE.0) PRINT *,'CHEOPS. queue directory defaulted ',
- + 'to ',CHDIR(1:LDIR)
- ELSE
- LDIR = IS(1)
- IF(IDEBFA.GE.0) PRINT *,'CHEOPS. queue directory is ',
- + CHDIR(1:LDIR)
- ENDIF
-*
-* Lift banks for source and destination
-*
- JBIAS = 2
- CALL MZBOOK(IXSTOR,LSRCBK,LSUP,JBIAS,'DSFA',0,0,NWDSFA,IODSFA,0)
- CALL MZBOOK(IXSTOR,LDSTBK,LSUP,JBIAS,'DSFA',0,0,NWDSFA,IODSFA,0)
-
- ICONT = 0
- 10 CONTINUE
-*
-* Look for new files in queue directory
-*
- INQUIRE (FILE=CHDIR(1:LDIR)//'/signal.stop', EXIST=EXIST)
- IF(EXIST) THEN
- PRINT *,'CHEOPS. signal.stop file found - stopping'
- GOTO 80
- ENDIF
-*
-* Zero/blank banks according to I/O characteristic
-*
- CALL DZZERO(IXSTOR,LSRCBK)
- CALL DZZERO(IXSTOR,LDSTBK)
-
- CHFILE = ' '
- ISTAT = FAFNDF(CHDIR(1:LDIR),CHNAME,ICONT)
- IF(ISTAT.NE.0) THEN
- IF(IDEBFA.GE.1) THEN
- CALL DATIME(ID,IT)
- PRINT *,'CHEOPS. time is ',ID,IT,
- + ' sleeping for ',ISLEEP,' seconds'
- ENDIF
- CALL SLEEPF(ISLEEP)
- ICONT = 0
- GOTO 10
- ENDIF
-
- ICONT = 1
-*
-* Stop?
-*
- IF(INDEX(CHNAME,'signal.stop').NE.0) THEN
- PRINT *,'CHEOPS. signal.stop file found - stopping'
- GOTO 80
- ENDIF
-
- CHFILE = CHDIR(1:LDIR) // '/' // CHNAME
-*
-* Ignore files . and ..
-*
- IF((CHFILE(1:1).EQ.'.')) GOTO 10
-
- LFILE = LENOCC(CHFILE)
- IF(IDEBFA.GE.0) THEN
- CALL DATIME(ID,IT)
- PRINT *,'CHEOPS. time is ',ID,IT
- PRINT *,'CHEOPS. new file found --> ',CHFILE(1:LFILE)
- ENDIF
-
- IF(INDEX(CHFILE(1:LFILE),'.rqid').NE.0) THEN
-*
-* Get request ID and store in FATMEN catalogue
-*
- OPEN(LUNREQ,FILE=CHFILE(1:LFILE),STATUS='OLD',IOSTAT=IOSTAT,
- + FORM='FORMATTED',ACCESS='SEQUENTIAL',ERR=90)
- 20 CONTINUE
-*
-* Look for status message
-*
- CHCOMM = ' '
- READ(LUNREQ,'(A)',END=40) CHLINE
- LLINE = LENOCC(CHLINE)
- IF(CHLINE(1:1).EQ.'#') THEN
- IF(IDEBFA.GE.3) PRINT *,'CHEOPS. comment line skipped: ',
- + CHLINE(1:LLINE)
- GOTO 20
- ENDIF
-
- IF(IDEBFA.GE.3) PRINT *,'CHEOPS. status line: ',
- + CHLINE(1:LLINE)
-
- IERROR = INDEX(CHLINE(1:LLINE),'STATUS=ERROR')
- IF(IERROR.EQ.0) THEN
- CHCOMM = 'copy successfully queued to CHEOPS. '
- LCOMM = 26
- ELSE
- CHCOMM = 'CHEOPS error: '
- LCOMM = 14
- ENDIF
-*
-* Get request id / error message
-*
- READ(LUNREQ,'(A)',END=40) CHLINE
- LLINE = LENOCC(CHLINE)
- LLINE = MIN(80,LCOMM+LLINE)
- CHCOMM(LCOMM:) = CHLINE(1:LLINE)
- IF(IDEBFA.GE.3) PRINT *,'CHEOPS. request # / error message: ',
- + CHLINE(1:LLINE)
-*
-* Now read rest of file and fill source/destination banks
-*
- 30 CONTINUE
- READ(LUNREQ,'(A)',END=40) CHLINE
- LLINE = LENOCC(CHLINE)
- IF(IDEBFA.GE.3) PRINT *,'CHEOPS. read: ',
- + CHLINE(1:LLINE)
-
- IF(CHLINE(1:2).EQ.'S_') THEN
- CALL FMATOB(CHSRCE,LSRCBK,CHLINE,IRC)
- ELSEIF(CHLINE(1:2).EQ.'D_') THEN
- CALL FMATOB(CHDEST,LDSTBK,CHLINE,IRC)
- ENDIF
-
- GOTO 30
-
- 40 CONTINUE
-*
-* Update comment field
-*
- CALL UCTOH(CHCOMM,IQ(LDSTBK+MUCMFA),4,80)
-*
-* Now update catalogue
-*
- CALL FMBTOF(CHDEST,IRC)
- CLOSE(LUNREQ,STATUS='DELETE')
-
- ELSEIF(INDEX(CHFILE(1:LFILE),'.rep').NE.0) THEN
-*
-* Get completion status and update catalogue
-*
- OPEN(LUNREQ,FILE=CHFILE(1:LFILE),STATUS='OLD',IOSTAT=IOSTAT,
- + FORM='FORMATTED',ACCESS='SEQUENTIAL',ERR=90)
- JD = 0
- JCODE = 0
- JSTR = 0
- 50 CONTINUE
- READ(LUNREQ,'(A)',END=70) CHLINE
- LLINE = LENOCC(CHLINE)
- IF(CHLINE(1:11).EQ.'COMPL_CODE=') THEN
- ICODE = ICDECI(CHLINE,12,LLINE)
- JCODE = 1
- IF(IDEBFA.GE.3) PRINT *,'CHEOPS. completion code: ',
- + ICODE
- ELSEIF(CHLINE(1:10).EQ.'COMPL_STR=') THEN
- CHSTR = CHLINE(11:LLINE)
- LSTR = LLINE - 11 + 1
- JSTR = 1
- ELSEIF(CHLINE(1:5).EQ.'RQID=') THEN
- CHREQ = CHLINE(6:LLINE)
- JD = 1
- IF(IDEBFA.GE.3) PRINT *,'CHEOPS. RQID: ',CHLINE(6:LLINE)
- ENDIF
-
- IF(JCODE.EQ.0.OR.JD.EQ.0.OR.JSTR.EQ.0) GOTO 50
-*
-* Was it successful?
-*
- IF(ICODE.NE.0) THEN
- CHCOMM = CHSTR(1:LSTR)
- LCOMM = LSTR
- IF(IDEBFA.GE.3) PRINT *,'CHEOPS. error text: ',
- + CHCOMM(1:LCOMM)
- ENDIF
-*
-* Now read rest of file and fill source/destination banks
-*
- 60 CONTINUE
- READ(LUNREQ,'(A)',END=70) CHLINE
- LLINE = LENOCC(CHLINE)
-
- IF(IDEBFA.GE.3) PRINT *,'CHEOPS. read: ',
- + CHLINE(1:LLINE)
-
- IF(CHLINE(1:2).EQ.'S_') THEN
- CALL FMATOB(CHSRCE,LSRCBK,CHLINE,IRC)
- ELSEIF(CHLINE(1:2).EQ.'D_') THEN
- CALL FMATOB(CHDEST,LDSTBK,CHLINE,IRC)
- ENDIF
-
- GOTO 60
-
- 70 CONTINUE
-*
-* Update comment field if transfer failed
-*
- IF(ICODE.NE.0) CALL UCTOH(CHCOMM,IQ(LDSTBK+MUCMFA),4,LCOMM)
-*
-* Now update catalogue
-*
- CALL FMBTOF(CHDEST,IRC)
- CLOSE(LUNREQ,STATUS='DELETE')
-
- ELSEIF(INDEX(CHFILE(1:LFILE),'.BAD').NE.0) THEN
-*
-* Error in request - report to user
-*
- ELSEIF(INDEX(CHFILE(1:LFILE),'.req').NE.0) THEN
-*
-* Queue file - ignore quietly
-*
- IF(IDEBFA.GE.3) PRINT *,'CHEOPS. queue file: ',
- + CHFILE(1:LFILE),' (ignored quietly)'
- ELSE
- IF(IDEBFA.GE.0) PRINT *,'CHEOPS. unrecognised file: ',
- + CHFILE(1:LFILE),' (ignored)'
- ENDIF
-
- GOTO 10
-
- 80 CONTINUE
-
- STOP
-
- 90 PRINT *,'CHEOPS. error ',IOSTAT,' opening ',CHFILE(1:LFILE)
-
- END
diff --git a/src/packlib/fatmen/programs/cheops2f/fmbtof.F b/src/packlib/fatmen/programs/cheops2f/fmbtof.F
deleted file mode 100644
index f9b302b..0000000
--- a/src/packlib/fatmen/programs/cheops2f/fmbtof.F
+++ /dev/null
@@ -1,123 +0,0 @@
-*
-* $Id: fmbtof.F,v 1.1.1.1 1996/03/07 15:17:36 mclareni Exp $
-*
-* $Log: fmbtof.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:36 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMBTOF(GENAME,IRC)
- CHARACTER*(*) GENAME
-#include "fatmen/slate.inc"
-#include "fatmen/fatbug.inc"
- PARAMETER (LURCOR=250000)
- COMMON/CRZT/IXSTOR,IXDIV,IFENCE(2),LEV,LEVIN,BLVECT(LURCOR)
- DIMENSION LQ(999),IQ(999),Q(999)
- EQUIVALENCE (IQ(1),Q(1),LQ(9)),(LQ(1),LEV)
-*
- COMMON/USRLNK/LSRCBK,LDSTBK
- CHARACTER*20 FNAME
- CHARACTER*255 CHDIR,CHNAME,CHFILE
- CHARACTER*20 CHGRP
- DIMENSION IUHEAD(80),IOCH(80)
- LOGICAL EXIST
- PARAMETER (NW=80)
- PARAMETER (IEV=1)
- PARAMETER (LUNOUT=9)
-
- IRC = 0
- LGN = LENOCC(GENAME)
-*
-* Get the FATMEN group name
-*
- ISTART = INDEX(GENAME(3:),'/') + 3
- IEND = INDEX(GENAME(ISTART:),'/') + ISTART - 2
-
- CHGRP = 'FM' // GENAME(ISTART:IEND)
- LGRP = IEND - ISTART + 3
-
- IF(IDEBFA.GE.3) PRINT *,'FMBTOF. enter for ',GENAME(1:LGN),
- + ' ',CHGRP(1:LGRP)
-*
-* Find directory where updates should go
-*
- CALL GETENVF(CHGRP(1:LGRP),CHDIR)
- LDIR = IS(1)
-
- IF(LDIR.EQ.0) THEN
- PRINT *,'FMBTOF. error - cannot find update directory for ',
- + CHGRP(1:LGRP)
- IRC = -1
- RETURN
- ELSE
- IF(IDEBFA.GE.3) PRINT *,'FMBTOF. update directory is ',
- + CHDIR(1:LDIR)
- ENDIF
-*
-* Set up descriptor of header vector
-*
- CALL MZIOCH(IOCH,NW,'70H 10I')
-*
-* Fill header vector
-*
- CALL UCTOH('MOD ',IUHEAD,4,4)
-*
-* Fill with blanks for safety
-*
- CALL VBLANK(IUHEAD(2),69)
-
- CALL UCTOH(GENAME,IUHEAD(2),4,LGN)
-*
-* Keys
-*
- LEND = INDEXB(GENAME,'/') + 1
- FNAME = GENAME(LEND:LGN)
- IUHEAD(71) = 0
- IUHEAD(77) = IQ(LDSTBK+MCPLFA+KOFUFA)
- IUHEAD(78) = IQ(LDSTBK+MMTPFA+KOFUFA)
- IUHEAD(79) = IQ(LDSTBK+MLOCFA+KOFUFA)
- IUHEAD(80) = LKEYFA
- LENFN = LGN-LEND+1
-*
-* IUHEAD 71-80 contains the keys, which includes the CHFILEame
-*
- DO 2 I=LENFN+1,20
-2 FNAME(I:I) = ' '
- CALL UCTOH(FNAME,IUHEAD(72),4,20)
-*
-* Get a unique file name
-*
-300 CONTINUE
- CALL FMFNME(CHNAME)
- CALL CUTOL(CHNAME)
-
- CHFILE = CHDIR(1:LDIR) // '/todo/'
- +// CHNAME(1:LENOCC(CHNAME))
- LENF = LENOCC(CHFILE)
- IF(IDEBFA.GE.3) PRINT *,'FMBTOF. assigned temporary file ',
- + CHFILE(1:LENF)
- INQUIRE(FILE=CHFILE(1:LENF),EXIST=EXIST)
- IF(EXIST) THEN
- IF(IDEBFA.GE.3) PRINT *,'FMBTOF. file already exists - ',
- + 'sleeping for 1 second'
- CALL SLEEPF(1)
- GOTO 300
- ENDIF
-
- OPEN(LUNOUT,STATUS='NEW',FILE=CHFILE(1:LENF),ERR=998)
-
- CALL FZFILE(LUNOUT,0,'AO')
- CALL FZLOGL(LUNOUT,MAX(IDEBFA-1,-3))
- CALL FZOUT(LUNOUT,IXSTOR,LDSTBK,IEV,'S',IOCH,NW,IUHEAD)
- CALL FZENDO(LUNOUT,'T')
- CLOSE (LUNOUT)
- IF(IDEBFA.GE.0) PRINT *,'FMBTOF - update queued for processing',
- + ' (MOD ',GENAME(1:LGN),')'
- RETURN
-*
-998 CONTINUE
- PRINT *,'FMBTOF - error opening temporary file, name=',
- + CHFILE(1:LENF)
- CLOSE (LUNOUT)
- END
diff --git a/src/packlib/fatmen/programs/cheopsif/Imakefile b/src/packlib/fatmen/programs/cheopsif/Imakefile
deleted file mode 100644
index f457db4..0000000
--- a/src/packlib/fatmen/programs/cheopsif/Imakefile
+++ /dev/null
@@ -1,3 +0,0 @@
-SRCS_F= fmendk.F fminik.F fmstgi.F fmstgo.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/fatmen/programs/cheopsif/fmendk.F b/src/packlib/fatmen/programs/cheopsif/fmendk.F
deleted file mode 100644
index 5da5b68..0000000
--- a/src/packlib/fatmen/programs/cheopsif/fmendk.F
+++ /dev/null
@@ -1,39 +0,0 @@
-*
-* $Id: fmendk.F,v 1.1.1.1 1996/03/07 15:17:36 mclareni Exp $
-*
-* $Log: fmendk.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:36 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMENDK(IRC)
-*CMZ : 17/09/91 12.00.51 by Jamie Shiers
-*-- Author : Jamie Shiers 17/09/91
-#include "fatmen/fatbank.inc"
-#include "fatmen/fatsys.inc"
-#include "fatmen/fatron.inc"
- IF(THRONG(1:LTHR).EQ.'NONE') RETURN
-#if defined(CERNLIB_IBMVM)
- IF(SERNAM(1:4).NE.'INIT'.AND.SERMOD.NE.'?'
- + .AND.SERMOD.NE.'A') THEN
- CALL VMCMS('EXEC DROP '//SERMOD,IRC)
- SERMOD = '?'
- ENDIF
-#endif
- LURZFA = IQ(LTOPFA+KOFUFA+MLUNFA)
- CALL FMEND(IRC)
- IF(LURZFA.GT.1000) THEN
-#if defined(CERNLIB_UNIX)||defined(CERNLIB_VAXVMS)
- IF(IDEBFA.GE.3) PRINT *,'FMENDK. closing unit ',LURZFA-1000,
- + ' (C)'
- CALL CFCLOS(LURZFA-1000,0)
-#endif
- ELSE
- IF(IDEBFA.GE.3) PRINT *,'FMENDK. closing unit ',LURZFA,
- + ' (FORTRAN)'
- CLOSE(LURZFA)
- ENDIF
- THRONG = 'NONE'
- LTHR = 4
- END
diff --git a/src/packlib/fatmen/programs/cheopsif/fminik.F b/src/packlib/fatmen/programs/cheopsif/fminik.F
deleted file mode 100644
index 3f6725c..0000000
--- a/src/packlib/fatmen/programs/cheopsif/fminik.F
+++ /dev/null
@@ -1,63 +0,0 @@
-*
-* $Id: fminik.F,v 1.1.1.1 1996/03/07 15:17:36 mclareni Exp $
-*
-* $Log: fminik.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:36 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMINIK(IUDIV,LUNRZ,LUNFZ,CHPATH,IRC)
- CHARACTER*(*) CHPATH
-#include "fatmen/fmpath.inc"
-#include "fatmen/fatbug.inc"
- PARAMETER (LURCOR=200000)
- COMMON/CRZT/IXSTOR,IXDIV,IFENCE(2),LEV,LEVIN,BLVECT(LURCOR)
- DIMENSION LQ(999),IQ(999),Q(999)
- EQUIVALENCE (IQ(1),Q(1),LQ(9)),(LQ(1),LEV)
-#include "fatmen/fatusr.inc"
-#include "fatmen/fatsys.inc"
-#include "fatmen/fstate.inc"
-#include "fatmen/fatron.inc"
- SAVE NENTRY
- DATA NENTRY/0/
-
- IF((MFPHAS.NE.3).AND.(NENTRY.EQ.1)) THEN
- PRINT *,'FMINIK. Error - FATMEN has already been initialised'
- RETURN
- ENDIF
-
- IF(NENTRY.EQ.0) THEN
-*
-* Initialise ZEBRA
-*
- CALL MZEBRA(-3)
- CALL MZSTOR(IXSTOR,'/CRZT/','Q',IFENCE,LEV,BLVECT(1),BLVECT(1),
- + BLVECT(5000),BLVECT(LURCOR))
- CALL MZLOGL(IXSTOR,-3)
-*
-* *** Define user division and link area like:
-*
- CALL MZDIV (IXSTOR, IXDIV, 'USERS', 50000, LURCOR, 'L')
- CALL MZLINK (IXSTOR, '/USRLNK/', LUSRK1, LUSRLS, LUSRK1)
-
- ENDIF
- LPRTFA = 6
-
-* read mode
- LPATH = LENOCC(CHPATH)
- CALL FMINIT(IXSTOR,LUNRZ,LUNFZ,CHPATH(1:LPATH),IRC)
-*
-* Permit retry if GIME failed / catalogue not found
-*
- IF((IRC.EQ.104).OR.(IRC.EQ.28)) THEN
- NENTRY = -1
- THRONG = 'NONE'
- LTHR = 4
- RETURN
- ELSE
- NENTRY = 1
- ENDIF
-
- END
-
diff --git a/src/packlib/fatmen/programs/cheopsif/fmstgi.F b/src/packlib/fatmen/programs/cheopsif/fmstgi.F
deleted file mode 100644
index 76057c8..0000000
--- a/src/packlib/fatmen/programs/cheopsif/fmstgi.F
+++ /dev/null
@@ -1,156 +0,0 @@
-*
-* $Id: fmstgi.F,v 1.1.1.1 1996/03/07 15:17:36 mclareni Exp $
-*
-* $Log: fmstgi.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:36 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMSTGI(GENAME,
- + CFQNFA,CHSNFA,ICPLFA,IMTPFA,ILOCFA,CHSTFA,CHOSFA,
- + CVSNFA,CVIDFA,IVIPFA,IDENFA,IVSQFA,IFSQFA,ISRDFA,
- + IERDFA,ISBLFA,IEBLFA,CRFMFA,IRLNFA,IBLNFA,CFLFFA,
- + CFUTFA,ICRTFA,ICTTFA,ILATFA,CCURFA,CCIDFA,CCNIFA,
- + CCJIFA,IFPRFA,ISYWFA,IUSWFA,CUCMFA,
- + CHLINK,CHOPT,IRC)
- CHARACTER*(*) GENAME,CHLINK,CHOPT
- PARAMETER (LUNRZ=1)
- PARAMETER (LUNFZ=2)
- CHARACTER*(*) CFQNFA
- CHARACTER*(*) CHSNFA
- CHARACTER*(*) CHSTFA
- CHARACTER*(*) CHOSFA
- CHARACTER*(*) CVSNFA,CVIDFA
- CHARACTER*(*) CFLFFA,CFUTFA,CRFMFA
- CHARACTER*(*) CCURFA,CCIDFA,CCNIFA,CCJIFA
- CHARACTER*(*) CUCMFA
- CHARACTER*2 KOPTS
- DIMENSION ISYWFA(10),IUSWFA(10)
- PARAMETER (JBIAS=2)
-#include "fatmen/fatusr.inc"
-#include "zebra/quest.inc"
-#include "fatmen/fatpara.inc"
-#include "fatmen/fmnkeys.inc"
- DIMENSION KEYS(LKEYFA)
- PARAMETER (LURCOR=200000)
- COMMON/CRZT/IXSTOR,IXDIV,IFENCE(2),LEV,LEVIN,BLVECT(LURCOR)
- DIMENSION LQ(999),IQ(999),Q(999)
- EQUIVALENCE (IQ(1),Q(1),LQ(9)),(LQ(1),LEV)
-
- LFQNFA = LENOCC(CFQNFA)
- LHSNFA = LENOCC(CHSNFA)
- LHSTFA = LENOCC(CHSTFA)
- LHOSFA = LENOCC(CHOSFA)
- LVSNFA = LENOCC(CVSNFA)
- LVIDFA = LENOCC(CVIDFA)
- LFLFFA = LENOCC(CFLFFA)
- LFUTFA = LENOCC(CFUTFA)
- LRFMFA = LENOCC(CRFMFA)
- LCURFA = LENOCC(CCURFA)
- LCIDFA = LENOCC(CCIDFA)
- LCNIFA = LENOCC(CCNIFA)
- LCJIFA = LENOCC(CCJIFA)
- LUCMFA = LENOCC(CUCMFA)
-
- IRC = 0
-*
-* Check on input parameters
-*
- LGN = LENOCC(GENAME)
- IF(LGN.EQ.0) GOTO 90
- IF(GENAME(1:2).NE.'//') GOTO 90
- ISLASH = INDEX(GENAME(3:LGN),'/')
- IF(ISLASH.EQ.0) GOTO 90
- ISLASH = ISLASH + 2
- JSLASH = INDEX(GENAME(ISLASH+1:LGN),'/')
- IF(JSLASH.EQ.0) GOTO 90
- JSLASH = JSLASH + ISLASH - 1
-*
-* Initialise FATMEN
-*
- CALL FMINIK(IXSTOR,LUNRZ,LUNFZ,GENAME(1:JSLASH),IRC)
- IF(IRC.NE.0) GOTO 99
-*
-* Book the bank
-*
- CALL FMBOOK(GENAME(1:LGN),KEYS,LADDBK,LSUP,JBIAS,IRC)
-*
-* Zero/blank it according to I/O characteristic
-*
- CALL DZZERO(IXSTOR,LADDBK)
- IQUEST(1) = 0
-*
-* Character fields...
-*
- IF(LFQNFA.GT.0) CALL UCTOH(CFQNFA,IQ(LADDBK+MFQNFA),4,LFQNFA)
- IF(LHSNFA.GT.0) CALL UCTOH(CHSNFA,IQ(LADDBK+MHSNFA),4,LHSNFA)
- IF(LHSTFA.GT.0) CALL UCTOH(CHSTFA,IQ(LADDBK+MHSTFA),4,LHSTFA)
- IF(LHOSFA.GT.0) CALL UCTOH(CHOSFA,IQ(LADDBK+MHOSFA),4,LHOSFA)
- IF(LVSNFA.GT.0) CALL UCTOH(CVSNFA,IQ(LADDBK+MVSNFA),4,LVSNFA)
- IF(LVIDFA.GT.0) CALL UCTOH(CVIDFA,IQ(LADDBK+MVIDFA),4,LVIDFA)
- IF(LFLFFA.GT.0) CALL UCTOH(CFLFFA,IQ(LADDBK+MFLFFA),4,LFLFFA)
- IF(LFUTFA.GT.0) CALL UCTOH(CFUTFA,IQ(LADDBK+MFUTFA),4,LFUTFA)
- IF(LRFMFA.GT.0) CALL UCTOH(CRFMFA,IQ(LADDBK+MRFMFA),4,LRFMFA)
- IF(LCURFA.GT.0) CALL UCTOH(CCURFA,IQ(LADDBK+MCURFA),4,LCURFA)
- IF(LCIDFA.GT.0) CALL UCTOH(CCIDFA,IQ(LADDBK+MCIDFA),4,LCIDFA)
- IF(LCNIFA.GT.0) CALL UCTOH(CCNIFA,IQ(LADDBK+MCNIFA),4,LCNIFA)
- IF(LCJIFA.GT.0) CALL UCTOH(CCJIFA,IQ(LADDBK+MCJIFA),4,LCJIFA)
- IF(LUCMFA.GT.0) CALL UCTOH(CUCMFA,IQ(LADDBK+MUCMFA),4,LUCMFA)
-*
-* Integer fields...
-*
- IQ(LADDBK+MCPLFA) = ICPLFA
- IQ(LADDBK+MMTPFA) = IMTPFA
- IQ(LADDBK+MLOCFA) = ILOCFA
- IQ(LADDBK+MVIPFA) = IVIPFA
- IQ(LADDBK+MDENFA) = IDENFA
- IQ(LADDBK+MVSQFA) = IVSQFA
- IQ(LADDBK+MFSQFA) = IFSQFA
- IQ(LADDBK+MSRDFA) = ISRDFA
- IQ(LADDBK+MERDFA) = IERDFA
- IQ(LADDBK+MSBLFA) = ISBLFA
- IQ(LADDBK+MEBLFA) = IEBLFA
- IQ(LADDBK+MRLNFA) = IRLNFA
- IQ(LADDBK+MBLNFA) = IBLNFA
- IQ(LADDBK+MCRTFA) = ICRTFA
- IQ(LADDBK+MCTTFA) = ICTTFA
- IQ(LADDBK+MLATFA) = ILATFA
- IQ(LADDBK+MFPRFA) = IFPRFA
-*
-* Vectors...
-*
- CALL UCOPY(ISYWFA,IQ(LADDBK+MSYWFA),10)
- CALL UCOPY(IUSWFA,IQ(LADDBK+MUSWFA),10)
-*
-* Check that the bank is ok
-*
- CALL FMUPKY(GENAME(1:LGN),LADDBK,KEYS,IRC)
- CALL FMVERI(GENAME(1:LGN),LADDBK,KEYS,'A',IRC)
- IF(IRC.NE.0) THEN
- PRINT *,'FMSTGI. error ',IRC,
- + ' from FMVERI. Dare not use this bank'
- PRINT 9000,(IQUEST(I),I=1,26),(I,I=1,26)
-9000 FORMAT(' IQUEST:',/,1X,26I3,/1X,26I3)
- RETURN
- ENDIF
-*
-* Issue input stage
-*
- KOPTS = 'R'
- IF(IQ(LADDBK+MMTPFA).GT.1) KOPTS = 'RU'
- CALL FMOPEN(GENAME(1:LGN),CHLINK,LADDBK,KOPTS,IRC)
-*
-* Terminate FATMEN
-*
- CALL FMENDK(IC)
- GOTO 99
-
- 90 CONTINUE
- PRINT *,'FMSTGI. error - invalid generic name specified'
- IRC = 1
- GOTO 99
-
- 99 CONTINUE
-
- END
diff --git a/src/packlib/fatmen/programs/cheopsif/fmstgo.F b/src/packlib/fatmen/programs/cheopsif/fmstgo.F
deleted file mode 100644
index e351d27..0000000
--- a/src/packlib/fatmen/programs/cheopsif/fmstgo.F
+++ /dev/null
@@ -1,160 +0,0 @@
-*
-* $Id: fmstgo.F,v 1.1.1.1 1996/03/07 15:17:36 mclareni Exp $
-*
-* $Log: fmstgo.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:36 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMSTGO(GENAME,
- + CFQNFA,CHSNFA,ICPLFA,IMTPFA,ILOCFA,CHSTFA,CHOSFA,
- + CVSNFA,CVIDFA,IVIPFA,IDENFA,IVSQFA,IFSQFA,ISRDFA,
- + IERDFA,ISBLFA,IEBLFA,CRFMFA,IRLNFA,IBLNFA,CFLFFA,
- + CFUTFA,ICRTFA,ICTTFA,ILATFA,CCURFA,CCIDFA,CCNIFA,
- + CCJIFA,IFPRFA,ISYWFA,IUSWFA,CUCMFA,
- + CHLINK,CHOPT,IRC)
- CHARACTER*(*) GENAME,CHLINK,CHOPT
- PARAMETER (LUNRZ=1)
- PARAMETER (LUNFZ=2)
- CHARACTER*(*) CFQNFA
- CHARACTER*(*) CHSNFA
- CHARACTER*(*) CHSTFA
- CHARACTER*(*) CHOSFA
- CHARACTER*(*) CVSNFA,CVIDFA
- CHARACTER*(*) CFLFFA,CFUTFA,CRFMFA
- CHARACTER*(*) CCURFA,CCIDFA,CCNIFA,CCJIFA
- CHARACTER*(*) CUCMFA
- CHARACTER*2 KOPTS
- DIMENSION ISYWFA(10),IUSWFA(10)
- PARAMETER (JBIAS=2)
-#include "fatmen/fatinfo.inc"
-#include "fatmen/fatusr.inc"
-#include "zebra/quest.inc"
-#include "fatmen/fatpara.inc"
-#include "fatmen/fmnkeys.inc"
- DIMENSION KEYS(LKEYFA)
- PARAMETER (LURCOR=200000)
- COMMON/CRZT/IXSTOR,IXDIV,IFENCE(2),LEV,LEVIN,BLVECT(LURCOR)
- DIMENSION LQ(999),IQ(999),Q(999)
- EQUIVALENCE (IQ(1),Q(1),LQ(9)),(LQ(1),LEV)
-
- IRC = 0
-*
-* Check on input parameters
-*
- LGN = LENOCC(GENAME)
- IF(LGN.EQ.0) GOTO 90
- IF(GENAME(1:2).NE.'//') GOTO 90
- ISLASH = INDEX(GENAME(3:LGN),'/')
- IF(ISLASH.EQ.0) GOTO 90
- ISLASH = ISLASH + 2
- JSLASH = INDEX(GENAME(ISLASH+1:LGN),'/')
- IF(JSLASH.EQ.0) GOTO 90
- JSLASH = JSLASH + ISLASH - 1
-*
-* Initialise FATMEN
-*
- CALL FMINIK(IXSTOR,LUNRZ,LUNFZ,GENAME(1:JSLASH),IRC)
- IF(IRC.NE.0) GOTO 99
-
- LFQNFA = LENOCC(CFQNFA)
- LHSNFA = LENOCC(CHSNFA)
- LHSTFA = LENOCC(CHSTFA)
- LHOSFA = LENOCC(CHOSFA)
- LVSNFA = LENOCC(CVSNFA)
- LVIDFA = LENOCC(CVIDFA)
- LFLFFA = LENOCC(CFLFFA)
- LFUTFA = LENOCC(CFUTFA)
- LRFMFA = LENOCC(CRFMFA)
- LCURFA = LENOCC(CCURFA)
- LCIDFA = LENOCC(CCIDFA)
- LCNIFA = LENOCC(CCNIFA)
- LCJIFA = LENOCC(CCJIFA)
- LUCMFA = LENOCC(CUCMFA)
-*
-* Book the bank
-*
- CALL FMBOOK(GENAME(1:LGN),KEYS,LADDBK,LSUP,JBIAS,IRC)
-*
-* Zero/blank it according to I/O characteristic
-*
- CALL DZZERO(IXSTOR,LADDBK)
- IQUEST(1) = 0
-*
-* Character fields...
-*
- IF(LFQNFA.GT.0) CALL UCTOH(CFQNFA,IQ(LADDBK+MFQNFA),4,LFQNFA)
- IF(LHSNFA.GT.0) CALL UCTOH(CHSNFA,IQ(LADDBK+MHSNFA),4,LHSNFA)
- IF(LHSTFA.GT.0) CALL UCTOH(CHSTFA,IQ(LADDBK+MHSTFA),4,LHSTFA)
- IF(LHOSFA.GT.0) CALL UCTOH(CHOSFA,IQ(LADDBK+MHOSFA),4,LHOSFA)
- IF(LVSNFA.GT.0) CALL UCTOH(CVSNFA,IQ(LADDBK+MVSNFA),4,LVSNFA)
- IF(LVIDFA.GT.0) CALL UCTOH(CVIDFA,IQ(LADDBK+MVIDFA),4,LVIDFA)
- IF(LFLFFA.GT.0) CALL UCTOH(CFLFFA,IQ(LADDBK+MFLFFA),4,LFLFFA)
- IF(LFUTFA.GT.0) CALL UCTOH(CFUTFA,IQ(LADDBK+MFUTFA),4,LFUTFA)
- IF(LRFMFA.GT.0) CALL UCTOH(CRFMFA,IQ(LADDBK+MRFMFA),4,LRFMFA)
- IF(LCURFA.GT.0) CALL UCTOH(CCURFA,IQ(LADDBK+MCURFA),4,LCURFA)
- IF(LCIDFA.GT.0) CALL UCTOH(CCIDFA,IQ(LADDBK+MCIDFA),4,LCIDFA)
- IF(LCNIFA.GT.0) CALL UCTOH(CCNIFA,IQ(LADDBK+MCNIFA),4,LCNIFA)
- IF(LCJIFA.GT.0) CALL UCTOH(CCJIFA,IQ(LADDBK+MCJIFA),4,LCJIFA)
- IF(LUCMFA.GT.0) CALL UCTOH(CUCMFA,IQ(LADDBK+MUCMFA),4,LUCMFA)
-*
-* Integer fields...
-*
- IQ(LADDBK+MCPLFA) = ICPLFA
- IQ(LADDBK+MMTPFA) = IMTPFA
- IQ(LADDBK+MLOCFA) = ILOCFA
- IQ(LADDBK+MVIPFA) = IVIPFA
- IQ(LADDBK+MDENFA) = IDENFA
- IQ(LADDBK+MVSQFA) = IVSQFA
- IQ(LADDBK+MFSQFA) = IFSQFA
- IQ(LADDBK+MSRDFA) = ISRDFA
- IQ(LADDBK+MERDFA) = IERDFA
- IQ(LADDBK+MSBLFA) = ISBLFA
- IQ(LADDBK+MEBLFA) = IEBLFA
- IQ(LADDBK+MRLNFA) = IRLNFA
- IQ(LADDBK+MBLNFA) = IBLNFA
- IQ(LADDBK+MCRTFA) = ICRTFA
- IQ(LADDBK+MCTTFA) = ICTTFA
- IQ(LADDBK+MLATFA) = ILATFA
- IQ(LADDBK+MFPRFA) = IFPRFA
-*
-* Vectors...
-*
- CALL UCOPY(ISYWFA,IQ(LADDBK+MSYWFA),10)
- CALL UCOPY(IUSWFA,IQ(LADDBK+MUSWFA),10)
-*
-* Check that the bank is ok
-*
- CALL FMUPKY(GENAME(1:LGN),LADDBK,KEYS,IRC)
- CALL FMVERI(GENAME(1:LGN),LADDBK,KEYS,'A',IRC)
- IF(IRC.NE.0) THEN
- PRINT *,'FMSTGO. error ',IRC,
- + ' from FMVERI. Dare not use this bank'
- PRINT 9000,(IQUEST(I),I=1,26),(I,I=1,26)
-9000 FORMAT(' IQUEST:',/,1X,26I3,/1X,26I3)
- RETURN
- ENDIF
-*
-* Issue output stage
-*
- CALL FMDD2L(CHLINK,LUN,IRC)
- LFMODE(LUN) = 2
- KOPTS = 'P'
- IF(IQ(LADDBK+MMTPFA).GT.1) KOPTS = 'NP'
- CALL FMCLOS(GENAME(1:LGN),CHLINK,LADDBK,KOPTS,IRC)
- LFMODE(LUN) = 0
-*
-* Terminate FATMEN
-*
- CALL FMENDK(IC)
- GOTO 99
-
- 90 CONTINUE
- PRINT *,'FMSTGO. error - invalid generic name specified'
- IRC = 1
- GOTO 99
-
- 99 CONTINUE
-
- END
diff --git a/src/packlib/fatmen/programs/fat2sql/Imakefile b/src/packlib/fatmen/programs/fat2sql/Imakefile
deleted file mode 100644
index 09f095c..0000000
--- a/src/packlib/fatmen/programs/fat2sql/Imakefile
+++ /dev/null
@@ -1,3 +0,0 @@
-SRCS_F= fat2sql.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/fatmen/programs/fat2sql/fat2sql.F b/src/packlib/fatmen/programs/fat2sql/fat2sql.F
deleted file mode 100644
index b887478..0000000
--- a/src/packlib/fatmen/programs/fat2sql/fat2sql.F
+++ /dev/null
@@ -1,93 +0,0 @@
-*
-* $Id: fat2sql.F,v 1.1.1.1 1996/03/07 15:17:37 mclareni Exp $
-*
-* $Log: fat2sql.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:37 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- PARAMETER (LURCOR=200000)
- COMMON/CRZT/IXSTOR,IXDIV,IFENCE(2),LEV,LEVIN,BLVECT(LURCOR)
- DIMENSION LQ(999),IQ(999),Q(999)
- EQUIVALENCE (IQ(1),Q(1),LQ(9)),(LQ(1),LEV)
-*
- COMMON /USRLNK/LUSRK1,LUSRBK,LUSRLS
-*
-#include "fatmen/fatpara.inc"
-#include "fatmen/fatbug.inc"
- PARAMETER (LKEYFA=10)
- PARAMETER (MAXFIL=3000)
- PARAMETER (IMODE=0)
- DIMENSION KEYS(LKEYFA,MAXFIL)
- CHARACTER*255 FILES(MAXFIL)
- CHARACTER*80 CHSTEM
- CHARACTER*16 CHSYS,CHGRP
-*
-*
-* Initialise ZEBRA
-*
- CALL MZEBRA(-3)
- CALL MZSTOR(IXSTOR,'/CRZT/','Q',IFENCE,LEV,BLVECT(1),BLVECT(1),
- + BLVECT(5000),BLVECT(LURCOR))
- CALL MZLOGL(IXSTOR,-3)
-
-*
-* *** Define user division and link area like:
-*
- CALL MZDIV (IXSTOR, IXDIV, 'USERS', 50000, LURCOR, 'L')
- CALL MZLINK (IXSTOR, '/USRLNK/', LUSRK1, LUSRLS, LUSRK1)
-*
-* Get system and group name
-*
- CALL FMQFAT(CHSYS,CHGRP,IRC)
- IF(IRC.NE.0) CALL FMSTOP
- CHSTEM = CHSYS(1:LENOCC(CHSYS))//'/'//CHGRP(1:LENOCC(CHGRP))
- LCHSTEM = LENOCC(CHSTEM)
-*
-* Units for FATMEN RZ/FZ files
-*
- LUNRZ = 1
- LUNFZ = 2
-*
-* Initialise FATMEN
-*
- CALL FMINIT(IXSTOR,LUNRZ,LUNFZ,CHSTEM(1:LCHSTEM),IRC)
- CALL FMLOGL(1)
-*
-* Connect to ORACLE
-*
- CALL FMLOGI(IRC)
-*
-*
-* Get list of file names
-*
- JCONT = 0
-1 CONTINUE
- CALL FMLFIL(CHSTEM(1:LCHSTEM)//'/*/*',
- +FILES,KEYS,NFOUND,MAXFIL,JCONT,IRC)
- IF(IRC.EQ.-1) THEN
- JCONT = 1
- ELSE
- JCONT = 0
- ENDIF
-
- PRINT *,NFOUND,' files found'
-
- DO 10 I=1,NFOUND
- LENF = LENOCC(FILES(I))
- PRINT *,'Processing ',FILES(I)(1:LENF)
- LBANK = 0
- CALL FMGETK(FILES(I)(1:LENF),LBANK,KEYS(1,I),IRC)
- CALL FMZTOR(FILES(I)(1:LENF),LBANK+KOFUFA,IMODE,IRC)
- CALL MZDROP(IXSTOR,LBANK,' ')
-10 CONTINUE
- IF(JCONT.NE.0) GOTO 1
-*
-*
-* Terminate cleanly
-*
- CALL FMEND(IRC)
-
- END
-
diff --git a/src/packlib/fatmen/programs/fatback/Imakefile b/src/packlib/fatmen/programs/fatback/Imakefile
deleted file mode 100644
index 310b522..0000000
--- a/src/packlib/fatmen/programs/fatback/Imakefile
+++ /dev/null
@@ -1,9 +0,0 @@
-SRCS_F= fatback.F zabend.F
-
-#ifdef CERNLIB_VAXVMS
-NeedTcpipLib
-#endif
-
-CernlibFortranProgramTarget(fatback,$(OBJS),NullParameter,NullParameter,packlib)
-
-InstallProgram(fatback,$(CERN_BINDIR))
diff --git a/src/packlib/fatmen/programs/fatback/fatback.F b/src/packlib/fatmen/programs/fatback/fatback.F
deleted file mode 100644
index 781bc60..0000000
--- a/src/packlib/fatmen/programs/fatback/fatback.F
+++ /dev/null
@@ -1,86 +0,0 @@
-*
-* $Id: fatback.F,v 1.3 2000/01/04 16:41:32 mclareni Exp $
-*
-* $Log: fatback.F,v $
-* Revision 1.3 2000/01/04 16:41:32 mclareni
-* Remove dummy argument for IARGC
-*
-* Revision 1.2 2000/01/04 15:55:38 jamie
-* change I6 to I6.6 (blank in filename)
-*
-* Revision 1.1.1.1 1996/03/07 15:17:37 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- PROGRAM FATBACK
-*
-* Convert FATMEN RZ file to exchange format
-*
- CHARACTER*255 CHFILE,CHBACK,CHLINK
- PARAMETER (IPRINT=6)
- PARAMETER (IDEBUG=0)
- PARAMETER (LUNI=1)
- PARAMETER (LUNO=2)
- PARAMETER (NWPAW=1000000)
- COMMON/PAWC/PAW(NWPAW)
- INTEGER SYSTEMF
-
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB_TCPSOCK))
- IDUMMY = CINIT(DUMMY)
-#endif
- CALL HLIMIT(NWPAW)
-
- NARGS = IARGC()
-
- IF(NARGS.LT.2) GOTO 99
-
- CALL GETARG(1,CHFILE)
- LFILE = LENOCC(CHFILE)
-
- CALL GETARG(2,CHBACK)
- LBACK = LENOCC(CHBACK)
-
-#if defined(CERNLIB_UNIX)
- LBACK = LBACK + 1
- CHBACK(LBACK:LBACK) = '/'
-#endif
-
- CALL DATIME(ID,IT)
-
- WRITE(CHBACK(LBACK+1:),9001) ID
- 9001 FORMAT(I6.6,'.fatfx')
- LBACK = LBACK + 12
-
- CALL XZINIT(IPRINT,IDEBUG,LUNI,LUNO)
-
- IRECL = 3600
- PRINT 9002,CHFILE(1:LFILE),CHBACK(1:LBACK)
- 9002 FORMAT(' FATBACK. copying ',A,' to ',A)
- CALL XZRTOF(CHFILE(1:LFILE),CHBACK(1:LBACK),IRECL,' ',IRC)
- IF(IRC.NE.0) THEN
-#if defined(CERNLIB_IBMVM)
- STOP 4
-#endif
-#if defined(CERNLIB_VAXVMS)
- CALL SYS$EXIT(%VAL(4))
-#endif
-#if defined(CERNLIB_UNIX)
- CALL FAEXIT(4)
-#endif
- ELSE
-#if defined(CERNLIB_UNIX)
-*
-* Create link to latest 'good' backup
-*
- CHLINK = CHBACK(1:LBACK-12)//'good.fatfx'
- LLINK = LBACK - 2
- CALL UNLINKF(CHLINK(1:LLINK))
- PRINT 9003,CHBACK(1:LBACK),CHLINK(1:LLINK)
- 9003 FORMAT(' FATBACK. linking ',A,' to ',A)
- ISTAT = SYSTEMF('ln -s '//CHBACK(1:LBACK)//
- + ' '//CHLINK(1:LLINK))
-#endif
- ENDIF
-
- 99 END
diff --git a/src/packlib/fatmen/programs/fatback/zabend.F b/src/packlib/fatmen/programs/fatback/zabend.F
deleted file mode 100644
index bae1850..0000000
--- a/src/packlib/fatmen/programs/fatback/zabend.F
+++ /dev/null
@@ -1,30 +0,0 @@
-*
-* $Id: zabend.F,v 1.1.1.1 1996/03/07 15:17:37 mclareni Exp $
-*
-* $Log: zabend.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:37 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE ZABEND
- CHARACTER*255 CHDIR
-
- PRINT 9001
-9001 FORMAT(' FATBACK. ZABEND routine reached - ZPOSTM cancelled')
- CALL RZCDIR(CHDIR,'R')
- LDIR = LENOCC(CHDIR)
-
- PRINT 9002,CHDIR(1:LDIR)
-9002 FORMAT(' FATBACK. current directory is ',A)
-
-#if defined(CERNLIB_VAXVMS)
- CALL SYS$EXIT(%VAL(1736938))
-#endif
-#if defined(CERNLIB_UNIX)
- CALL FAEXIT(16)
-#endif
-#if defined(CERNLIB_IBM)
- STOP 16
-#endif
- END
diff --git a/src/packlib/fatmen/programs/fatcat/Imakefile b/src/packlib/fatmen/programs/fatcat/Imakefile
deleted file mode 100644
index e7e10b5..0000000
--- a/src/packlib/fatmen/programs/fatcat/Imakefile
+++ /dev/null
@@ -1,3 +0,0 @@
-SRCS_F= fatcat.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/fatmen/programs/fatcat/fatcat.F b/src/packlib/fatmen/programs/fatcat/fatcat.F
deleted file mode 100644
index dd1bbe0..0000000
--- a/src/packlib/fatmen/programs/fatcat/fatcat.F
+++ /dev/null
@@ -1,424 +0,0 @@
-*
-* $Id: fatcat.F,v 1.1.1.1 1996/03/07 15:17:37 mclareni Exp $
-*
-* $Log: fatcat.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:37 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
-#if defined(CERNLIB_IBMVM)
- PROGRAM FATCAT
-*CMZ : 21/02/91 16.24.17 by Jamie Shiers
-*-- Author : Jamie Shiers 21/02/91
-* Program to move updates between CERNVM and FATCAT
-*
- PARAMETER (NDIR=100)
- CHARACTER*255 CHDIRS(NDIR)
- PARAMETER (NMAX=500)
- CHARACTER*64 FILES(NMAX)
- CHARACTER*8 FATUSR,FATNOD,REMUSR,REMNOD
- CHARACTER*64 REMOTE,TARGET
- CHARACTER*12 CHTIME
- CHARACTER*8 CHUSER,CHPASS
- CHARACTER*8 CHNODE,CHTYPE,CHSYS,CHRAND
- CHARACTER*6 CHENT
- CHARACTER*80 CHMAIL,LINE,CHDIR
- CHARACTER*38 VALID
- CHARACTER*255 ERRMSG
- COMMON/PAWC/PAW(50000)
- PARAMETER (IPRINT=6)
- PARAMETER (IDEBUG=0)
- PARAMETER (LUNI=1)
- PARAMETER (LUNO=2)
- INTEGER FMHOST
-#include "zebra/quest.inc"
- COMMON/SLATE/IS(6),IDUMM(34)
- DATA NENTRY/0/
- DATA VALID/'ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890._'/
-*
-* Counters
-*
- NSENT = 0
- NRECV = 0
-*
-* Warning message for RDR backlog?
-*
- IWARN = 0
-*
-* Initialise ZEBRA
-*
- CALL HLIMIT(50000)
-*
-* Initialise XZ
-*
- CALL XZINIT(IPRINT,IDEBUG,LUNI,LUNO)
-*
- IC = FMHOST(CHNODE,CHTYPE,CHSYS)
- LNODE = LENOCC(CHNODE)
-*
-* Open connection to FATCAT...
-*
-#if defined(CERNLIB_TCPSOCK)
- IDUMMY = CINIT(IDUMMY)
-#endif
-#if !defined(CERNLIB_TCPSOCK)
- CALL VMREXX('F','USER',CHUSER,IC)
- CALL VMREXX('F','PWD' ,CHPASS,IC)
- CALL CUTOL(CHUSER)
- CALL CUTOL(CHPASS)
- CALL VMSTAK(CHPASS,'L',IC)
- CALL VMSTAK(CHUSER,'L',IC)
-#endif
-
- CALL CZOPEN('zserv','FATCAT',IRC)
-*
-* First entry: look on fatcat before sleeping
-*
- NDIRS = 0
- GOTO 20
-
- 10 CALL VMCMS('EXEC FATSERV',IRC)
- IF(IRC.EQ.99) GOTO 20
- IF(IRC.NE.0) THEN
- PRINT 9001,IRC
- 9001 FORMAT(' FATCAT. error ',I10,' from FATSERV. Stopping...')
- GOTO 80
- ENDIF
-
- NENTRY = NENTRY + 1
-*
-* Get the user and node name for this file...
-*
- CALL VMCMS('GLOBALV SELECT *EXEC STACK FATADDR',IC)
- CALL VMRTRM(LINE,IEND)
- ISTART = ICFNBL(LINE,1,IEND)
- CALL FMWORD(FATUSR,0,' ',LINE(ISTART:IEND),IC)
- LFAT = LENOCC(FATUSR)
- CALL FMWORD(FATNOD,1,' ',LINE(ISTART:IEND),IC)
- LNOD = LENOCC(FATNOD)
-
- IF(IDEBUG.GE.1) PRINT 9002,FATUSR(1:LFAT),FATNOD(1:LNOD)
- 9002 FORMAT(' FATCAT. Update received from ',A, ' at ',A)
-*
-* Number of pending files
-*
- CALL VMCMS('GLOBALV SELECT *EXEC STACK FATFILES',IC)
- CALL VMRTRM(LINE,IEND)
- NRDR = ICDECI(LINE,1,IEND)
-
- CALL DATIME(ID,IT)
- WRITE(CHTIME,'(I6.6,I4.4,I2.2)') ID,IT,IS(6)
- WRITE(CHENT ,'(I6.6)') NENTRY
- CALL FMRAND(CHRAND,IRC)
-*
-* Now put this file...
-* This assumes the FATCAT naming convention: /fatmen/fmgroup,
-* e.g. /fatmen/fml3
- CHDIR = '/fatmen/'//FATUSR(1:LFAT)//
- + '/todo'
- LDIR = LENOCC(CHDIR)
-*
- REMOTE = ' '
- REMOTE = 'zz'//CHTIME//CHRAND//CHENT
- + //'.'//FATUSR(1:LFAT)//'_'//FATNOD(1:LNOD)
- LREM = LENOCC(REMOTE)
- TARGET = REMOTE(1:LREM)
-*
-* Change remote directory
-*
- CALL CUTOL(CHDIR(1:LDIR))
- IF(IDEBUG.GE.1) PRINT 9003,CHDIR(1:LDIR)
- 9003 FORMAT(' FATCAT. Changing remote directory to ',A)
- CALL XZCD(CHDIR(1:LDIR),IRC)
- IF(IRC.NE.0) THEN
- WRITE(ERRMSG,9004) CHDIR(1:LDIR)
- 9004 FORMAT(' FATCAT. cannot set directory to ',A)
- LMSG = LENOCC(ERRMSG)
- GOTO 90
- ENDIF
-
- NSENT = NSENT + 1
- IF(IDEBUG.GE.1) PRINT 9005,NSENT,REMOTE(1:LREM)
- 9005 FORMAT(' FATCAT. Sending file # ',I6,' as ',A)
- CALL XZPUTA('FATMEN.RDRFILE.A',REMOTE(1:LREM),' ',IC)
- IF(IC.NE.0) THEN
- WRITE(ERRMSG,9006) IC,FATUSR,FATNOD
- 9006 FORMAT(' FATCAT. error ',I6,' sending update from ',
- + A,' at ',A,' to FATCAT')
- LMSG = LENOCC(ERRMSG)
- GOTO 90
- ENDIF
-*
-* Rename the remote update file
-*
- LSTA = INDEXB(TARGET(1:LREM),'/') + 1
- TARGET(LSTA:LSTA+1) = 'aa'
- IF(IDEBUG.GE.1) PRINT 9007,TARGET(1:LREM)
- 9007 FORMAT(' FATCAT. Renaming file to ',A)
- CALL XZMV(REMOTE(1:LREM),TARGET(1:LREM),' ',IRC)
- IF(IRC.NE.0) THEN
- WRITE(ERRMSG,9008) IRC,REMOTE(1:LREM),TARGET(1:LREM)
- 9008 FORMAT(' FATCAT. error ',I6,' renaming update from ',
- + A,' to ',A)
- LMSG = LENOCC(ERRMSG)
- GOTO 90
- ENDIF
-*
-* Delete this update...
-*
- CALL VMCMS('ERASE FATMEN RDRFILE A',IC)
-*
-* Try to clear out RDR
-*
- IF(NRDR.GT.10) THEN
- IF(IWARN.EQ.0) WRITE(6,9009) NRDR
- 9009 FORMAT(' FATCAT. backlog of ',I6,' files in RDR')
- IWARN = 1
- GOTO 10
- ELSE
- IWARN = 0
- ENDIF
-*
-* Are there any files for us to get?
-*
- 20 CONTINUE
-*
-* Get list of remote directories
-*
- JCONT = 0
- IF(NDIRS.EQ.0) THEN
- IF(IDEBUG.GE.1) PRINT 9010
- 9010 FORMAT(' FATCAT. Retrieving list of remote directories...')
- CALL XZLS('/fatmen/fm*/tovm',CHDIRS,NDIR,NDIRS,JCONT,'D',IC)
- NDIRS = MIN(NDIR,NDIRS)
- IF(JCONT.NE.0) THEN
- IC = 0
- PRINT 9011
- 9011 FORMAT(' FATCAT. too many directories - excess names ',
- + 'will be flushed')
-*
- 30 CONTINUE
- CALL CZGETA(CHMAIL,ISTAT)
- LCH = LENOCC(CHMAIL)
- IF(CHMAIL(1:1).EQ.'0') THEN
-*
-* Nop
-*
- ELSEIF(CHMAIL(1:1).EQ.'1') THEN
- ELSEIF(CHMAIL(1:1).EQ.'2') THEN
- GOTO 30
- ELSEIF(CHMAIL(1:1).EQ.'3') THEN
- IQUEST(1) = 1
- IRC = 1
- ELSEIF(CHMAIL(1:1).EQ.'E') THEN
- IQUEST(1) = -1
- IRC = -1
- ELSEIF(CHMAIL(1:1).EQ.'V') THEN
- GOTO 30
- ELSE
- IQUEST(1) = 1
- IRC = 1
- ENDIF
-*
- ENDIF
- ENDIF
-
- DO 70 J=1,NDIRS
-
- LDIR = LENOCC(CHDIRS(J))
- IF(LDIR.EQ.0) GOTO 70
- CALL CLTOU(CHDIRS(J)(1:LDIR))
-*
-* Get the name of the server for whom these updates are intended...
-*
- JSTART = INDEX(CHDIRS(J)(1:LDIR),'/FM')
- IF(JSTART.EQ.0) THEN
- IF(IDEBUG.GE.-3) PRINT 9012,CHDIRS(J)(1:LDIR)
- 9012 FORMAT(' FATCAT. unrecognised directory - skipped (',A,')')
- GOTO 70
- ELSE
- JSTART = JSTART + 1
- ENDIF
-
- JEND = INDEX(CHDIRS(J)(JSTART:LDIR),'/')
-
- IF(JEND.EQ.0) THEN
- PRINT 9013,CHDIRS(J)(1:LDIR)
- 9013 FORMAT(' FATCAT. unrecognised file name - skipped (',A,')')
- GOTO 70
- ENDIF
-
- REMUSR = CHDIRS(J)(JSTART:JSTART+JEND-2)
- LREM = LENOCC(REMUSR)
-
- IF(LREM.EQ.0) THEN
- IF(IDEBUG.GE.-3) PRINT 9013,CHDIRS(J)(1:LDIR)
- GOTO 70
- ENDIF
-
- IF(IDEBUG.GE.1) PRINT 9014,REMUSR(1:LREM)
- 9014 FORMAT(' FATCAT. processing updates for ',A)
- CALL XZCD(CHDIRS(J)(1:LDIR),IRC)
- IF(IRC.NE.0) THEN
- WRITE(ERRMSG,9004) CHDIRS(J)(1:LDIR)
- LMSG = LENOCC(ERRMSG)
- GOTO 90
- ENDIF
-
- ICONT = 0
- NFILES = 0
- IF(IDEBUG.GE.1) PRINT 9015,CHDIRS(J)(1:LDIR)
- 9015 FORMAT(' FATCAT. Retrieving list of remote files in ',A)
- CALL XZLS(' ',FILES,NMAX,NFILES,ICONT,' ',IC)
- NFILES = MIN(NFILES,NMAX)
- IF(IDEBUG.GE.2) PRINT 9016,NFILES,CHDIRS(J)(1:LDIR)
- 9016 FORMAT(' FATCAT. ',I10,' files found in ',A)
- IF(ICONT.NE.0) THEN
- IC = 0
- IF(IDEBUG.GE.0) PRINT 9017
- 9017 FORMAT(' FATCAT. too many files - excess names will be flushed')
-*
- 40 CONTINUE
- CALL CZGETA(CHMAIL,ISTAT)
- LCH = LENOCC(CHMAIL)
- IF(CHMAIL(1:1).EQ.'0') THEN
-*
-* Nop
-*
- ELSEIF(CHMAIL(1:1).EQ.'1') THEN
- ELSEIF(CHMAIL(1:1).EQ.'2') THEN
- GOTO 40
- ELSEIF(CHMAIL(1:1).EQ.'3') THEN
- IQUEST(1) = 1
- IRC = 1
- ELSEIF(CHMAIL(1:1).EQ.'E') THEN
- IQUEST(1) = -1
- IRC = -1
- ELSEIF(CHMAIL(1:1).EQ.'V') THEN
- GOTO 40
- ELSE
- IQUEST(1) = 1
- IRC = 1
- ENDIF
-*
- ENDIF
-
-
- DO 60 I=1,NFILES
- LF = LENOCC(FILES(I))
- IF(LF.EQ.0) GOTO 60
- CALL CLTOU(FILES(I))
-*
-* Fix for the case when there are no files...
-*
- IF(NFILES.EQ.1) THEN
-
- IF(INDEX(FILES(I)(1:LF),'DOES NOT EXIST').NE.0.OR.
- + INDEX(FILES (I)(1:LF),'NOT FOUND').NE.0) GOTO 10
-
- IF(INDEX(FILES(I)(1:LF),'ARG LIST TOO LONG').NE.0) THEN
- IF(IDEBUG.GE.-3) THEN
- PRINT 9018,FILES(I)(1:LF)
- 9018 FORMAT(' FATCAT. Stopping due to the following error...',/,1X,A)
- PRINT 9019
- 9019 FORMAT(' (Intervention required on FATCAT)')
- ENDIF
- CALL VMCMS('EXEC TELL JAMIE '//FILES(I)(1:LF),IC)
- CALL VMCMS('EXEC TELL JAMIE Logging off...',IC)
- CALL VMCMS('EXEC TELL FATONE Logging off due to'//
- + FILES(I)(1:LF),IC)
- CALL VMSTAK('LOGOFF','L',IC)
- STOP
- ENDIF
-
- ENDIF
-*
-* Check that file name is valid
-*
- DO 50 L=1,LF
- IF(INDEX(VALID,FILES(I)(L:L)).EQ.0) THEN
- IF(IDEBUG.GE.-3) THEN
- PRINT 9020,L,FILES(I)(1:LF)
- 9020 FORMAT(' FATCAT. invalid character at ',I3,' in ',A)
- PRINT 9021
- 9021 FORMAT(' FATCAT. skipping update...')
- ENDIF
- GOTO 60
- ENDIF
- 50 CONTINUE
-
- IF(INDEX(FILES(I)(1:LF),CHNODE(1:LNODE)).NE.0) THEN
- IF(IDEBUG.GE.1)
- + PRINT 9022,CHNODE(1:LNODE),FILES(I)(1:LF)
- 9022 FORMAT(' FATCAT. skipping update for ',A,' (',A,')')
- GOTO 60
- ENDIF
- LSLASH = INDEXB(FILES(I)(1:LF),'/')
- IF(FILES(I)(LSLASH+1:LSLASH+2).EQ.'ZZ') THEN
- IF(IDEBUG.GE.1)
- + PRINT 9023,FILES(I)(1:LF)
- 9023 FORMAT(' FATCAT. active file - skipped (',A,')')
- GOTO 60
- ENDIF
-
- IF(IDEBUG.GE.2)
- + PRINT 9024,REMUSR(1:LREM),FILES(I)(1:LF)
- 9024 FORMAT(' FATCAT. update found for ',A,' (',A,')')
-
- NRECV = NRECV + 1
- IF(IDEBUG.GE.1) PRINT 9025,NRECV,FILES(I)(1:LF)
- 9025 FORMAT(' FATCAT. retrieving update # ',I10,' (',A,')')
- CALL XZGETA('FATMEN.UPDATE.B',FILES(I)(1:LF),' ',IC)
- IF(IC.NE.0) THEN
- WRITE(ERRMSG,9026) IC,REMUSR(1:LREM)
- 9026 FORMAT(' FATCAT. error ',I6,' retrieving update for ',A)
- LMSG = LENOCC(ERRMSG)
- GOTO 90
- ENDIF
-
- CALL VMCMS('EXEC SENDFILE FATMEN UPDATE B TO ' //REMUSR(1:
- + LREM),IC)
- IF(IC.NE.0) THEN
- WRITE(ERRMSG,9027) IC,REMUSR(1:LREM)
- 9027 FORMAT(' FATCAT. error ',I6,' sending update to ',A)
- LMSG = LENOCC(ERRMSG)
- GOTO 90
- ENDIF
-
- CALL XZRM(FILES(I)(1:LF),IC)
- IF(IC.NE.0) THEN
- WRITE(ERRMSG,9028) IC,FILES(I)(1:LF)
- 9028 FORMAT(' FATCAT. error ',I6,' deleting file ',A)
- LMSG = LENOCC(ERRMSG)
- GOTO 90
- ENDIF
-
- 60 CONTINUE
-
- 70 CONTINUE
-*
-* Wait for some action...
-*
- GOTO 10
-
- 80 CALL CZCLOS(ISTAT)
- IF(IDEBUG.GE.-3) PRINT 9030,NSENT,NRECV
- STOP
- 90 CONTINUE
-*
-* Error exit
-*
- IF(IDEBUG.GE.-3) PRINT 9029,ERRMSG(1:LMSG)
- 9029 FORMAT(1X,A)
- IF(IDEBUG.GE.-3) PRINT 9030,NSENT,NRECV
- 9030 FORMAT(' FATCAT. sent ',I10,' files and received ',I10)
- CALL VMCMS('EXEC TELL JAMIE '//ERRMSG(1:LMSG),IC)
- CALL VMCMS('EXEC TELL JAMIE Logging off...',IC)
- CALL VMCMS('EXEC TELL FATONE Logging off due to'//ERRMSG(1:LMSG),
- + IC)
- CALL VMSTAK('LOGOFF','L',IC)
- GOTO 80
- END
-
-#endif
diff --git a/src/packlib/fatmen/programs/fatchk/Imakefile b/src/packlib/fatmen/programs/fatchk/Imakefile
deleted file mode 100644
index 1ecf719..0000000
--- a/src/packlib/fatmen/programs/fatchk/Imakefile
+++ /dev/null
@@ -1,3 +0,0 @@
-SRCS_F= fageta.F fatchk.F zabend.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/fatmen/programs/fatchk/fageta.F b/src/packlib/fatmen/programs/fatchk/fageta.F
deleted file mode 100644
index bfa7c0e..0000000
--- a/src/packlib/fatmen/programs/fatchk/fageta.F
+++ /dev/null
@@ -1,122 +0,0 @@
-*
-* $Id: fageta.F,v 1.1.1.1 1996/03/07 15:17:37 mclareni Exp $
-*
-* $Log: fageta.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:37 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FAGETA(CHPATH,NFILES,NDIRS)
-*
-#include "zebra/rzcl.inc"
-#include "zebra/rzdir.inc"
-#include "zebra/rzch.inc"
-#include "zebra/rzk.inc"
- CHARACTER *(*) CHPATH
- DIMENSION ISD(NLPATM),NSD(NLPATM),IHDIR(4)
-#include "fatmen/fatusr.inc"
-#include "fatmen/fatbug.inc"
-#include "fatmen/fmnkeys.inc"
- DIMENSION KEYS(LKEYFA)
-*
-*-----------------------------------------------------------------------
-*
- IQUEST(1) = 0
- NFILES = 0
- NDIRS = 0
- IF(LQRS.EQ.0)GO TO 60
-*
-* General case
-*
- IF(LCDIR.EQ.0)GO TO 60
- CALL RZCDIR(CHWOLD,'R')
- CALL RZCDIR(CHPATH,' ')
- IF(IQUEST(1).NE.0) GOTO 60
- CALL RZPAFF(CHPAT,NLPAT,CHL)
- NLPAT0=NLPAT
- ITIME=0
-*
-*
-* Set CWD to the current level
-*
- 10 CONTINUE
- NDIRS = NDIRS + 1
- IF(ITIME.NE.0)THEN
- CALL RZPAFF(CHPAT,NLPAT,CHL)
- IF(IQUEST(1).NE.0)THEN
- NLPAT=NLPAT-1
- GO TO 40
- ENDIF
- CALL RZCDIR(CHL,' ')
- ENDIF
- IF(IQUEST(1).NE.0)THEN
- NLPAT=NLPAT-1
- GO TO 40
- ENDIF
- ISD(NLPAT)=0
- NSD(NLPAT)=IQ(KQSP+LCDIR+KNSD)
-*
-* Get all objects in current directory
-*
- LK = IQ(KQSP+LCDIR+KLK)
- NK = IQ(KQSP+LCDIR+KNKEYS)
- NWK= IQ(KQSP+LCDIR+KNWKEY)
-*
-* No objects...
-*
- IF(NK.EQ.0) GOTO 40
- IF(IDEBFA.GE.1) CALL RZCDIR(' ','P')
- DO 30 I=1,NK
- K=LK+(NWK+1)*(I-1)
- DO 20 J=1,NWK
- IKDES=(J-1)/10
- IKBIT1=3*J-30*IKDES-2
- IF(JBYT(IQ(KQSP+LCDIR+KKDES+IKDES),IKBIT1,3).LT.3)THEN
- KEYS(J)=IQ(KQSP+LCDIR+K+J)
- ELSE
- CALL ZITOH(IQ(KQSP+LCDIR+K+J),KEYS(J),1)
- ENDIF
- 20 CONTINUE
-*
-* Try to get this object
-*
- ICYCLE = 9999
- JBIAS = 2
- CALL RZIN(IXDIV,LADDBK,JBIAS,KEYS,ICYCLE,' ')
- IF(IQUEST(1).EQ.0) THEN
- NFILES = NFILES + 1
- IF(IDEBFA.GE.1) CALL FMPKEY(KEYS,LKEYFA)
- CALL MZDROP(IXDIV,LADDBK,' ')
- LADDBK = 0
- ENDIF
- 30 CONTINUE
-
-*
-* Process possible down directories
-*
- 40 ISD(NLPAT)=ISD(NLPAT)+1
- IF(ISD(NLPAT).LE.NSD(NLPAT))THEN
- NLPAT=NLPAT+1
- LS=IQ(KQSP+LCDIR+KLS)
- IH=LS+7*(ISD(NLPAT-1)-1)
- CALL ZITOH(IQ(KQSP+LCDIR+IH),IHDIR,4)
- CALL UHTOC(IHDIR,4,CHPAT(NLPAT),16)
- ITIME=ITIME+1
- GO TO 10
- ELSE
- NLPAT=NLPAT-1
- IF(NLPAT.GE.NLPAT0)THEN
- LUP=LQ(KQSP+LCDIR+1)
- CALL MZDROP(JQPDVS,LCDIR,' ')
- LCDIR=LUP
- GO TO 40
- ENDIF
- ENDIF
-*
-* Reset CWD
-*
- 50 CALL RZCDIR(CHWOLD,' ')
-*
- 60 RETURN
- END
diff --git a/src/packlib/fatmen/programs/fatchk/fatchk.F b/src/packlib/fatmen/programs/fatchk/fatchk.F
deleted file mode 100644
index 0549144..0000000
--- a/src/packlib/fatmen/programs/fatchk/fatchk.F
+++ /dev/null
@@ -1,89 +0,0 @@
-*
-* $Id: fatchk.F,v 1.1.1.1 1996/03/07 15:17:37 mclareni Exp $
-*
-* $Log: fatchk.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:37 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- PROGRAM FATCHK
- PARAMETER (LURCOR=1000000)
- COMMON/CRZT/IXSTOR,IXDIV,IFENCE(2),LEV,LEVIN,BLVECT(LURCOR)
- DIMENSION LQ(999),IQ(999),Q(999)
- EQUIVALENCE (IQ(1),Q(1),LQ(9)),(LQ(1),LEV)
-*
- COMMON/USRLNK/LUSRK1,LUSRBK,LUSRLS
- COMMON/FLOOP2/NFILES
-*
-#include "zebra/quest.inc"
- PARAMETER (MAXDIR=100)
- CHARACTER*255 CHDIR(MAXDIR)
-#include "fatmen/fatpara.inc"
-#include "fatmen/fatbug.inc"
- CHARACTER*16 CHSYS,CHGRP
- CHARACTER*8 CHLOG
-#include "fatmen/slate.inc"
- EXTERNAL UROUT
-*
-*
-* Initialise ZEBRA
-*
- CALL MZEBRA(-3)
- CALL MZSTOR(IXSTOR,'/CRZT/','Q',IFENCE,LEV,BLVECT(1),BLVECT(1),
- + BLVECT(5000),BLVECT(LURCOR))
- CALL MZLOGL(IXSTOR,-3)
-
-*
-* *** Define user division and link area like:
-*
- CALL MZDIV (IXSTOR, IXDIV, 'USERS', 50000, LURCOR, 'L')
- CALL MZLINK (IXSTOR, '/USRLNK/', LUSRK1, LUSRLS, LUSRK1)
-
- NFILES = 0
-*
-* Units for FATMEN RZ/FZ files
-*
- LUNRZ = 1
- LUNFZ = 2
-
- CALL GETENVF('FATSYS',CHSYS)
- IF(IS(1).EQ.0) THEN
- PRINT *,'FATMEN system defaulted to CERN'
- CHSYS = 'CERN'
- LSYS = 4
- ELSE
- LSYS = IS(1)
- PRINT *,'FATMEN system: ',CHSYS(1:LSYS)
- ENDIF
-
- CALL GETENVF('FATGRP',CHGRP)
- IF(IS(1).EQ.0) THEN
- PRINT *,'FATMEN group not defined'
- STOP
- ELSE
- LGRP = IS(1)
- PRINT *,'FATMEN group: ',CHGRP(1:LGRP)
- ENDIF
-
- CALL GETENVF('FMLOGL',CHLOG)
- IF(IS(1).EQ.0) THEN
- LOGLV = 0
- ELSE
- LOGLV = ICDECI(CHLOG,1,IS(1))
- ENDIF
-*
-* Initialise FATMEN
-*
- CALL FMINIT(IXSTOR,LUNRZ,LUNFZ,
- + '//'//CHSYS(1:LSYS)//'/'//CHGRP(1:LGRP),IRC)
-
- CALL FMLOGL(LOGLV)
-
- CALL FAGETA('//'//CHSYS(1:LSYS)//'/'//CHGRP(1:LGRP),
- + NFILES,NDIRS)
-
- IF(IDEBFA.GE.0) PRINT 9001,NFILES,NDIRS
-9001 FORMAT(' FATCHK. found ',I8,' files in ',I6,' directories')
-
- END
diff --git a/src/packlib/fatmen/programs/fatchk/zabend.F b/src/packlib/fatmen/programs/fatchk/zabend.F
deleted file mode 100644
index 8fdb612..0000000
--- a/src/packlib/fatmen/programs/fatchk/zabend.F
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: zabend.F,v 1.1.1.1 1996/03/07 15:17:37 mclareni Exp $
-*
-* $Log: zabend.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:37 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE ZABEND
- PRINT *,'ZABEND routine for FATMEN reached - ZPOSTM cancelled'
-#if defined(CERNLIB_VAXVMS)
- CALL SYS$EXIT(%VAL(1736938))
-#endif
-#if defined(CERNLIB_UNIX)
- CALL FAEXIT(16)
-#endif
-#if defined(CERNLIB_IBM)
- STOP 16
-#endif
-
- END
-
diff --git a/src/packlib/fatmen/programs/fatkeops/Imakefile b/src/packlib/fatmen/programs/fatkeops/Imakefile
deleted file mode 100644
index 354d58a..0000000
--- a/src/packlib/fatmen/programs/fatkeops/Imakefile
+++ /dev/null
@@ -1,3 +0,0 @@
-SRCS_F= fatkeops.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/fatmen/programs/fatkeops/fatkeops.F b/src/packlib/fatmen/programs/fatkeops/fatkeops.F
deleted file mode 100644
index 4a6daf8..0000000
--- a/src/packlib/fatmen/programs/fatkeops/fatkeops.F
+++ /dev/null
@@ -1,132 +0,0 @@
-*
-* $Id: fatkeops.F,v 1.1.1.1 1996/03/07 15:17:38 mclareni Exp $
-*
-* $Log: fatkeops.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:38 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
-#if defined(CERNLIB_IBMVM)
- PROGRAM FATKEOPS
-*CMZ : 21/02/91 16.24.17 by Jamie Shiers
-*-- Author : Jamie Shiers 21/02/91
-* Program to move updates between CERNVM and the CHEOPS
-* directory on fatcat
-*
- PARAMETER (NMAX=100)
- CHARACTER*64 FILES(NMAX)
- CHARACTER*8 FATUSR,FATNOD,REMUSR,REMNOD
- CHARACTER*64 REMOTE,REQUST
- CHARACTER*12 CHTIME
- CHARACTER*8 CHUSER,CHPASS
- CHARACTER*8 CHNODE,CHTYPE,CHSYS,CHRAND
- CHARACTER*80 CHMAIL,LINE
- CHARACTER*255 ERRMSG
- COMMON/PAWC/PAW(50000)
- PARAMETER (IPRINT=6)
- PARAMETER (IDEBUG=3)
- PARAMETER (LUNI=1)
- PARAMETER (LUNO=2)
- INTEGER FMHOST
-#include "zebra/quest.inc"
- COMMON/SLATE/IS(6),IDUMM(34)
- DATA NENTRY/0/
-*
-* Initialise ZEBRA
-*
- CALL HLIMIT(50000)
-*
-* Initialise XZ
-*
- CALL XZINIT(IPRINT,IDEBUG,LUNI,LUNO)
-*
- IC = FMHOST(CHNODE,CHTYPE,CHSYS)
- LNODE = LENOCC(CHNODE)
-*
-* Open connection to FATCAT...
-*
-#if defined(CERNLIB_TCPSOCK)
- IDUMMY = CINIT(IDUMMY)
-#endif
-#if !defined(CERNLIB_TCPSOCK)
- CALL VMREXX('F','USER',CHUSER,IC)
- CALL VMREXX('F','PWD' ,CHPASS,IC)
- CALL CUTOL(CHUSER)
- CALL CUTOL(CHPASS)
- CALL VMSTAK(CHPASS,'L',IC)
- CALL VMSTAK(CHUSER,'L',IC)
-#endif
-
- CALL CZOPEN('zserv','FATCAT',IRC)
-
- CALL XZCD('/fatmen/fmcheops',IRC)
-
- 1 CALL VMCMS('EXEC FATSERV',IRC)
- IF(IRC.EQ.99) GOTO 1
- IF(IRC.NE.0) THEN
- PRINT *,'FATKEOPS. error ',IRC,' from FATSERV. Stopping...'
- GOTO 99
- ENDIF
-
- NENTRY = NENTRY + 1
-*
-* Get the user and node name for this file...
-*
- CALL VMCMS('GLOBALV SELECT *EXEC STACK FATADDR',IC)
- CALL VMRTRM(LINE,IEND)
- ISTART = ICFNBL(LINE,1,IEND)
- CALL FMWORD(FATUSR,0,' ',LINE(ISTART:IEND),IC)
- LFAT = LENOCC(FATUSR)
- CALL FMWORD(FATNOD,1,' ',LINE(ISTART:IEND),IC)
- LNOD = LENOCC(FATNOD)
-
- PRINT *,'FATKEOPS. Update received from ',FATUSR(1:LFAT), ' at ',
- + FATNOD(1:LNOD)
-
- CALL DATIME(ID,IT)
- WRITE(CHTIME,'(I6.6,I4.4,I2.2)') ID,IT,IS(6)
- CALL FMRAND(CHRAND,IRC)
-* WRITE(CHRAND,'(I8.8)') MOD(IRNDM(IDUMMY),100000000)
-*
-* Now put this file...
-*
- REMOTE = ' '
- REMOTE = FATUSR(1:LFAT)//'_'//
- + FATNOD(1:LNOD)//'.'//CHTIME//CHRAND
- LREM = LENOCC(REMOTE)
-
- CALL XZPUTA('FATMEN.RDRFILE.A',REMOTE(1:LREM),' ',IC)
- IF(IC.NE.0) THEN
- WRITE(ERRMSG,9001) IC,FATUSR,FATNOD
-9001 FORMAT(' FATKEOPS. error ',I6,' sending update from ',
- + A,' at ',A,' to FATKEOPS')
- LMSG = LENOCC(ERRMSG)
- PRINT *,ERRMSG(1:LMSG)
- CALL VMCMS('EXEC TELL JAMIE '//ERRMSG(1:LMSG),IC)
- CALL VMCMS('EXEC TELL JAMIE Logging off...',IC)
- CALL VMSTAK('LOGOFF','L',IC)
- STOP
- ELSE
-*
-* Now rename update
-*
- CALL CUTOL(REMOTE(1:LREM))
- REQUST = REMOTE(1:LREM)
- LREQ = LREM + 4
- REQUST(LREQ-3:LREQ) = '.req'
- CALL XZMV(REMOTE(1:LREM),REQUST(1:LREQ),' ',IRC)
-
- ENDIF
-*
-* Delete this update...
-*
- CALL VMCMS('ERASE FATMEN RDRFILE A',IC)
-*
-* Wait for some action...
-*
- GOTO 1
-
- 99 CALL CZCLOS(ISTAT)
- END
-#endif
diff --git a/src/packlib/fatmen/programs/fatlog/Imakefile b/src/packlib/fatmen/programs/fatlog/Imakefile
deleted file mode 100644
index 7b10f53..0000000
--- a/src/packlib/fatmen/programs/fatlog/Imakefile
+++ /dev/null
@@ -1,3 +0,0 @@
-SRCS_F= fatlog.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/fatmen/programs/fatlog/fatlog.F b/src/packlib/fatmen/programs/fatlog/fatlog.F
deleted file mode 100644
index 449e1f5..0000000
--- a/src/packlib/fatmen/programs/fatlog/fatlog.F
+++ /dev/null
@@ -1,85 +0,0 @@
-*
-* $Id: fatlog.F,v 1.1.1.1 1996/03/07 15:17:38 mclareni Exp $
-*
-* $Log: fatlog.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:38 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- PROGRAM FATLOG
-
- CHARACTER*255 CHLINE
-
-#include "fatmen/fatpara.inc"
- DIMENSION IVECT(NWDSFA)
- CHARACTER*8 CHVID
-
- PARAMETER (LUNRZ=7)
- PARAMETER (LUNFZ=8)
-
- LOGICAL INIT
- DATA INIT/.FALSE./
-*
-* Read FATSERV LOG file and process *FATLOG* lines*
-*
- OPEN(1,FORM='FORMATTED',ACCESS='SEQUENTIAL',
- + STATUS='OLD',IOSTAT=ISTAT)
- IF(ISTAT.NE.0) THEN
- WRITE(6,9001) ISTAT
- 9001 FORMAT(' FATLOG. return code ',I6,' opening input logfile')
- STOP
- ENDIF
-
- OPEN(2,FORM='FORMATTED',ACCESS='SEQUENTIAL',
- + STATUS='NEW',IOSTAT=ISTAT)
- IF(ISTAT.NE.0) THEN
- WRITE(6,9002) ISTAT
- 9002 FORMAT(' FATLOG. return code ',I6,' opening output logfile')
- STOP
- ENDIF
-
- NLINE = 0
- NLOG = 0
-
- 10 CONTINUE
-
- READ(1,'(A)',END=20) CHLINE
- LLINE = LENOCC(CHLINE)
-
- NLINE = NLINE + 1
- IF(INDEX(CHLINE(1:LLINE),'*FATLOG*').EQ.0) GOTO 10
- NLOG = NLOG + 1
-
- ISTART = INDEX(CHLINE(1:LLINE),' //')
- IF(ISTART.EQ.0) GOTO 10
-
- ISTART = ISTART + 1
- IEND = INDEX(CHLINE(ISTART:LLINE),' ') + ISTART - 1
-
- IF(.NOT.INIT) THEN
- LEND = INDEX(CHLINE(ISTART+2:LLINE),'/') + ISTART + 2
- LEND = LEND + INDEX(CHLINE(LEND:LLINE),'/') - 2
- CALL FMSTRT(LUNRZ,LUNFZ,CHLINE(ISTART:LEND),IRC)
- INIT = .TRUE.
- ENDIF
-
- CALL FMPEEK(CHLINE(ISTART:IEND),IVECT,'G',IRC)
- CALL UHTOC(IVECT(MVIDFA),4,CHVID,NVIDFA)
- ISEQ = IVECT(MFSQFA)
-
- WRITE(CHLINE(LLINE+1:),9003) CHVID,ISEQ
- 9003 FORMAT(1X,A8,1X,I3)
-
- WRITE(2,'(A)') CHLINE(1:LLINE+13)
-
- GOTO 10
-
- 20 CLOSE(1)
- CLOSE(2)
-
- WRITE(6,9004) NLINE,NLOG
- 9004 FORMAT(' FATLOG. processed ',I6,' lines of which ',I6,
- + ' were *FATLOG* records')
-
- END
diff --git a/src/packlib/fatmen/programs/fatloop/Imakefile b/src/packlib/fatmen/programs/fatloop/Imakefile
deleted file mode 100644
index 6f81c8b..0000000
--- a/src/packlib/fatmen/programs/fatloop/Imakefile
+++ /dev/null
@@ -1,3 +0,0 @@
-SRCS_F= cplear.F l3.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/fatmen/programs/fatloop/cplear.F b/src/packlib/fatmen/programs/fatloop/cplear.F
deleted file mode 100644
index ab3421a..0000000
--- a/src/packlib/fatmen/programs/fatloop/cplear.F
+++ /dev/null
@@ -1,150 +0,0 @@
-*
-* $Id: cplear.F,v 1.1.1.1 1996/03/07 15:17:38 mclareni Exp $
-*
-* $Log: cplear.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:38 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- PROGRAM CPLEAR
- PARAMETER (NWPAW=500000)
- COMMON/PAWC/NWP,IXPAWC,IHDIV,IXHIGZ,IXKU,FENC(5),LMAIN,HCV(NWPAW)
-#include "zebra/zunit.inc"
-#include "zebra/rzcl.inc"
-#include "zebra/rzdir.inc"
-#include "zebra/rzch.inc"
-#include "zebra/rzk.inc"
-#include "fatmen/fatpara.inc"
- CHARACTER*20 FNAME
- CHARACTER*8 CHVID
- DIMENSION ISD(NLPATM),NSD(NLPATM),IHDIR(4)
-
- DIMENSION KEYS(10)
-*
-*-----------------------------------------------------------------------
-*
- CALL HLIMIT(NWPAW)
-
- LRECL = 0
- CALL RZOPEN(1,'//CERN','cern.fatrz',' ',LRECL,IRC)
-
- CALL RZFILE(1,'CERN',' ')
-
- NDIRS = 0
- NFILES = 0
-
- IQUEST(1)=0
- CALL RZCDIR(' ',' ')
- CALL RZPAFF(CHPAT,NLPAT,CHL)
- NLPAT0=NLPAT
- ITIME=0
-*
-*
-* Set CWD to the current level
-*
- 10 CONTINUE
- IF(ITIME.NE.0)THEN
- CALL RZPAFF(CHPAT,NLPAT,CHL)
- IF(IQUEST(1).NE.0)THEN
- NLPAT=NLPAT-1
- GO TO 20
- ENDIF
- CALL RZCDIR(CHL,' ')
- ENDIF
- IF(IQUEST(1).NE.0)THEN
- NLPAT=NLPAT-1
- GO TO 20
- ENDIF
- ISD(NLPAT)=0
- NSD(NLPAT)=IQ(KQSP+LCDIR+KNSD)
-
- NDIRS = NDIRS + 1
- LK = IQ(KQSP+LCDIR+KLK)
- NK = IQ(KQSP+LCDIR+KNKEYS)
- NWK= IQ(KQSP+LCDIR+KNWKEY)
- DO 22 I=1,NK
- K=LK+(NWK+1)*(I-1)
- DO 11 J=1,NWK
- IKDES=(J-1)/10
- IKBIT1=3*J-30*IKDES-2
- IF(JBYT(IQ(KQSP+LCDIR+KKDES+IKDES),IKBIT1,3).LT.3)THEN
- KEYS(J)=IQ(KQSP+LCDIR+K+J)
- ELSE
- CALL ZITOH(IQ(KQSP+LCDIR+K+J),KEYS(J),1)
- ENDIF
- 11 CONTINUE
-*
-* Select on media type
-*
-*--- IF(KEYS(MKMTFA).NE.2) GOTO 22
-*
-* Select on location code
-*--- IF(KEYS(MKLCFA).NE.33) GOTO 22
-*
-* Select on copy level
-*
-*--- IF(KEYS(MKCLFA).NE.1) GOTO 22
-
- CALL RZIN(IXPAWC,LSUP,2,KEYS,9999,' ')
- NFILES = NFILES + 1
-*
-* Get filename, VID and fseq
-*
-#if defined(CERNLIB_OLD)
- CALL UHTOC(KEYS(2),4,FNAME,NFQNFA)
- CALL UHTOC(IQ(KQSP+LSUP+MVIDFA),4,CHVID,NVIDFA)
-
- WRITE(6,9001) CHL(1:LENOCC(CHL))//'/'//FNAME,CHVID,
- + IQ(KQSP+LSUP+MFSQFA)
-9001 FORMAT(' Generic name: ',A,' VID: ',A,' FSEQ: ',I3.3)
-
-#endif
-#if !defined(CERNLIB_OLD)
- WRITE(6,9001) CHL(1:LENOCC(CHL)),(KEYS(J),J=2,6),
- + IQ(KQSP+LSUP+MVIDFA),IQ(KQSP+LSUP+MVIDFA+1),
- + IQ(KQSP+LSUP+MFSQFA)
-9001 FORMAT(' Generic name: ',A,'/',5A4,' VID: ',2A4,
- + ' FSEQ: ',I3)
-
-#endif
-
- CALL SBIT1(IQ(KQSP+LSUP),IQDROP)
-* CALL MZDROP(IXPAWC,LSUP,' ')
- LSUP = 0
- 22 CONTINUE
-
-*
-* Process possible down directories
-*
- 20 ISD(NLPAT)=ISD(NLPAT)+1
- IF(ISD(NLPAT).LE.NSD(NLPAT))THEN
- NLPAT=NLPAT+1
- LS=IQ(KQSP+LCDIR+KLS)
- IH=LS+7*(ISD(NLPAT-1)-1)
- CALL ZITOH(IQ(KQSP+LCDIR+IH),IHDIR,4)
- CALL UHTOC(IHDIR,4,CHPAT(NLPAT),16)
- ITIME=ITIME+1
- GO TO 10
- ELSE
- NLPAT=NLPAT-1
- IF(NLPAT.GE.NLPAT0)THEN
- LUP=LQ(KQSP+LCDIR+1)
- CALL MZDROP(JQPDVS,LCDIR,' ')
- LCDIR=LUP
- GO TO 20
- ENDIF
- ENDIF
-*
-* Reset CWD
-*
- 90 CONTINUE
-
- CALL MZEND
-
- PRINT 9002,NFILES,NDIRS
-9002 FORMAT(' Number of files = ',I6,' number of directories = ',I6)
-*
- 8000 FORMAT(' //',4A4,' LUN=',I6,
- +' Created ',I6,'/',I4,' Modified ',I6,'/',I4)
- END
diff --git a/src/packlib/fatmen/programs/fatloop/l3.F b/src/packlib/fatmen/programs/fatloop/l3.F
deleted file mode 100644
index 2191101..0000000
--- a/src/packlib/fatmen/programs/fatloop/l3.F
+++ /dev/null
@@ -1,158 +0,0 @@
-*
-* $Id: l3.F,v 1.1.1.1 1996/03/07 15:17:38 mclareni Exp $
-*
-* $Log: l3.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:38 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- PROGRAM L3
- PARAMETER (NWPAW=500000)
- COMMON/PAWC/NWP,IXPAWC,IHDIV,IXHIGZ,IXKU,FENC(5),LMAIN,HCV(NWPAW)
-#include "zebra/zunit.inc"
-#include "zebra/rzcl.inc"
-#include "zebra/rzdir.inc"
-#include "zebra/rzch.inc"
-#include "zebra/rzk.inc"
-#include "fatmen/fatpara.inc"
- CHARACTER*20 FNAME
- CHARACTER*8 CHVID
- DIMENSION ISD(NLPATM),NSD(NLPATM),IHDIR(4)
-
- DIMENSION KEYS(10)
-*
-*-----------------------------------------------------------------------
-*
- CALL HLIMIT(NWPAW)
-
- LRECL = 0
- CALL RZOPEN(1,'//CERN','cern.fatrz',' ',LRECL,IRC)
-
- CALL RZFILE(1,'CERN',' ')
-
- NDIRS = 0
- NFILES = 0
-
- IQUEST(1)=0
- CALL RZCDIR(' ',' ')
- CALL RZPAFF(CHPAT,NLPAT,CHL)
- NLPAT0=NLPAT
- ITIME=0
-*
-*
-* Set CWD to the current level
-*
- 10 CONTINUE
- IF(ITIME.NE.0)THEN
- CALL RZPAFF(CHPAT,NLPAT,CHL)
- IF(IQUEST(1).NE.0)THEN
- NLPAT=NLPAT-1
- GO TO 20
- ENDIF
- CALL RZCDIR(CHL,' ')
- ENDIF
- IF(IQUEST(1).NE.0)THEN
- NLPAT=NLPAT-1
- GO TO 20
- ENDIF
- ISD(NLPAT)=0
- NSD(NLPAT)=IQ(KQSP+LCDIR+KNSD)
-
- NDIRS = NDIRS + 1
- LK = IQ(KQSP+LCDIR+KLK)
- NK = IQ(KQSP+LCDIR+KNKEYS)
- NWK= IQ(KQSP+LCDIR+KNWKEY)
- DO 22 I=1,NK
- K=LK+(NWK+1)*(I-1)
- DO 11 J=1,NWK
- IKDES=(J-1)/10
- IKBIT1=3*J-30*IKDES-2
- IF(JBYT(IQ(KQSP+LCDIR+KKDES+IKDES),IKBIT1,3).LT.3)THEN
- KEYS(J)=IQ(KQSP+LCDIR+K+J)
- ELSE
- CALL ZITOH(IQ(KQSP+LCDIR+K+J),KEYS(J),1)
- ENDIF
- 11 CONTINUE
-*
-* Select on media type
-*
-*--- IF(KEYS(MKMTFA).NE.2) GOTO 22
- IF(KEYS(MKMTFA).EQ.1) GOTO 22
-*
-* Select on location code
-*--- IF(KEYS(MKLCFA).NE.33) GOTO 22
-*
-* Select on copy level
-*
-*--- IF(KEYS(MKCLFA).NE.1) GOTO 22
-
- CALL RZIN(IXPAWC,LSUP,2,KEYS,9999,' ')
- NFILES = NFILES + 1
-*
-* GName
-* VID.FSEQ
-* File Format *
-* Device Group
-* Creator *
-* Node *
-* RECFM
-* LRECL
-* BLKSIZE *
-* Filesize
-* Date/time creation *
-*
- CALL FMUPTM(IDATE,ITIME,IQ(KQSP+LSUP+MCRTFA),IRC)
-
- WRITE(6,9001) CHL(1:LENOCC(CHL)),(KEYS(J),J=2,6),
- + IQ(KQSP+LSUP+MVIDFA),IQ(KQSP+LSUP+MVIDFA+1),
- + IQ(KQSP+LSUP+MFSQFA),IQ(KQSP+LSUP+MMTPFA),
- + IQ(KQSP+LSUP+MCURFA),IQ(KQSP+LSUP+MCURFA+1),
- + IQ(KQSP+LSUP+MCNIFA),IQ(KQSP+LSUP+MCNIFA+1),
- + IQ(KQSP+LSUP+MRFMFA),
- + IQ(KQSP+LSUP+MRLNFA),IQ(KQSP+LSUP+MBLNFA),
- + IQ(KQSP+LSUP+MFSZFA),IDATE,ITIME
-9001 FORMAT(' Generic name: ',A,'/',5A4,' VID: ',2A4,
- + ' FSEQ: ',I3,' device type: ',I2,' creator: ',2A4,
- + ' node: ',2A4,' recfm: ',A,' lrecl ',I6,' blksize ',I6,
- + ' filesize: ',I6,' created: ',I6,'/',I4)
-
- CALL SBIT1(IQ(KQSP+LSUP),IQDROP)
-* CALL MZDROP(IXPAWC,LSUP,' ')
- LSUP = 0
- 22 CONTINUE
-
-*
-* Process possible down directories
-*
- 20 ISD(NLPAT)=ISD(NLPAT)+1
- IF(ISD(NLPAT).LE.NSD(NLPAT))THEN
- NLPAT=NLPAT+1
- LS=IQ(KQSP+LCDIR+KLS)
- IH=LS+7*(ISD(NLPAT-1)-1)
- CALL ZITOH(IQ(KQSP+LCDIR+IH),IHDIR,4)
- CALL UHTOC(IHDIR,4,CHPAT(NLPAT),16)
- ITIME=ITIME+1
- GO TO 10
- ELSE
- NLPAT=NLPAT-1
- IF(NLPAT.GE.NLPAT0)THEN
- LUP=LQ(KQSP+LCDIR+1)
- CALL MZDROP(JQPDVS,LCDIR,' ')
- LCDIR=LUP
- GO TO 20
- ENDIF
- ENDIF
-*
-* Reset CWD
-*
- 90 CONTINUE
-
- CALL MZEND
-
- PRINT 9002,NFILES,NDIRS
-9002 FORMAT(' Number of files = ',I6,' number of directories = ',I6)
-*
- 8000 FORMAT(' //',4A4,' LUN=',I6,
- +' Created ',I6,'/',I4,' Modified ',I6,'/',I4)
- END
diff --git a/src/packlib/fatmen/programs/fatman/Imakefile b/src/packlib/fatmen/programs/fatman/Imakefile
deleted file mode 100644
index 1b16cb3..0000000
--- a/src/packlib/fatmen/programs/fatman/Imakefile
+++ /dev/null
@@ -1,3 +0,0 @@
-SRCS_F= fathead.F fatplog.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/fatmen/programs/fatman/fathead.F b/src/packlib/fatmen/programs/fatman/fathead.F
deleted file mode 100644
index 4a3903b..0000000
--- a/src/packlib/fatmen/programs/fatman/fathead.F
+++ /dev/null
@@ -1,75 +0,0 @@
-*
-* $Id: fathead.F,v 1.1.1.1 1996/03/07 15:17:39 mclareni Exp $
-*
-* $Log: fathead.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:39 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- PROGRAM FATHEAD
-*
-* Print headers of journal file on unit 1
-*
-* Unix usage: fathead filename
-* or for i in $FMCNDIV/done/*
-* do
-* fathead $i
-* done
-*
- COMMON/PAWC/PAW(50000)
- COMMON/QUEST/ IQUEST(100)
- CHARACTER*255 GENAM,CHFILE
- CHARACTER*4 CHCOMM
- DIMENSION IUHEAD(400)
- DIMENSION IOCR(100)
- PARAMETER (JBIAS=2)
- PARAMETER (IEVENT=0)
-*
-* Get the file name (if given)
-*
- CALL GETARG(1,CHFILE)
- LFILE = LENOCC(CHFILE)
-
- CALL HLIMIT(50000)
-
- CALL FZFILE(1,0,'IA')
-
- IF(LFILE.EQ.0) THEN
- OPEN(1,ACCESS='SEQUENTIAL', FORM='FORMATTED', STATUS='OLD')
- ELSE
-#if defined(CERNLIB_IBMVM)
- CALL CTRANS('.',' ',CHFILE,1,LFILE)
-#endif
- OPEN(1,ACCESS='SEQUENTIAL', FORM='FORMATTED', STATUS='OLD',
-#if !defined(CERNLIB_IBMVM)
- + FILE=CHFILE(1:LFILE))
-#endif
-#if defined(CERNLIB_IBMVM)
- + FILE='/'//CHFILE(1:LFILE))
-#endif
- ENDIF
- NREC = 0
- 1 CONTINUE
- NHEAD = 400
- CALL FZIN(1,0,LSUP,2,'S',NHEAD,IUHEAD)
- IF(IQUEST(1).EQ.0) THEN
- NREC = NREC + 1
- GENAM = ' '
- CALL UHTOC(IUHEAD(1),4,CHCOMM,4)
- CALL UHTOC(IUHEAD(2),4,GENAM,255)
- PRINT *,CHCOMM,GENAM(1:LENOCC(GENAM))
- IF(NHEAD.GT.80) THEN
- GENAM = ' '
- PRINT 9001,IUHEAD(81),IUHEAD(82)
- CALL UHTOC(IUHEAD(91),4,GENAM,255)
- PRINT *,'CHFNFA: ',GENAM(1:LENOCC(GENAM))
- ENDIF
-9001 FORMAT(' IHOWFA: ',Z8,' ITIMFA: ',I6)
- GOTO 1
- ENDIF
- PRINT *,IQUEST(1)
- PRINT *,'NUMBER OF RECORDS = ',NREC
- CALL FZENDI(1,'T')
-*
- 99 END
diff --git a/src/packlib/fatmen/programs/fatman/fatplog.F b/src/packlib/fatmen/programs/fatman/fatplog.F
deleted file mode 100644
index 8f8b823..0000000
--- a/src/packlib/fatmen/programs/fatman/fatplog.F
+++ /dev/null
@@ -1,42 +0,0 @@
-*
-* $Id: fatplog.F,v 1.1.1.1 1996/03/07 15:17:39 mclareni Exp $
-*
-* $Log: fatplog.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:39 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
-* Print FATMEN log records
- PROGRAM FATPLOG
- COMMON/PAWC/PAW(50000)
- COMMON/QUEST/ IQUEST(100)
- CHARACTER*255 GENAM
- CHARACTER*4 CHCOMM
- DIMENSION IUHEAD(400)
- DIMENSION IOCR(100)
- PARAMETER (JBIAS=2)
- PARAMETER (IEVENT=0)
-
- CALL HLIMIT(50000)
-
- CALL FZFILE(1,0,'ID')
- OPEN(1,ACCESS='DIRECT',
- + RECL=3600,
- + FORM='UNFORMATTED',
- + STATUS='OLD')
- CALL FZLOGL(1,0)
- NREC = 0
- 1 CONTINUE
- NHEAD = 400
- CALL FZIN(1,0,LSUP,2,'S',NHEAD,IUHEAD)
- NREC = NREC + 1
- PRINT *,'Record ',NREC,' header ',NHEAD,' words'
- IF(NHEAD.EQ.170) CALL FMPLOG(6,IUHEAD,NHEAD,IRC)
- IF(IQUEST(1).LT.4) GOTO 1
- PRINT *,IQUEST(1)
- CALL FZENDI(1,'T')
-*
- 99 END
-
-
diff --git a/src/packlib/fatmen/programs/fatnew/Imakefile b/src/packlib/fatmen/programs/fatnew/Imakefile
deleted file mode 100644
index 4a227c7..0000000
--- a/src/packlib/fatmen/programs/fatnew/Imakefile
+++ /dev/null
@@ -1,9 +0,0 @@
-SRCS_F= fatnew.F
-
-#ifdef CERNLIB_VAXVMS
-NeedTcpipLib
-#endif
-
-CernlibFortranProgramTarget(fatnew,$(OBJS),NullParameter,NullParameter,packlib)
-
-InstallProgram(fatnew,$(CERN_BINDIR))
diff --git a/src/packlib/fatmen/programs/fatnew/fatnew.F b/src/packlib/fatmen/programs/fatnew/fatnew.F
deleted file mode 100644
index 2b851de..0000000
--- a/src/packlib/fatmen/programs/fatnew/fatnew.F
+++ /dev/null
@@ -1,233 +0,0 @@
-*
-* $Id: fatnew.F,v 1.1.1.1 1996/03/07 15:17:39 mclareni Exp $
-*
-* $Log: fatnew.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:39 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- PROGRAM FATNEW
-*=======================================================================
-*
-* Main program to create a new CERN FATRZ file
-*
-* VM systems: REXX variables FATSYS & FATGRP & FATMODE
-* VMS systems: Global symbols FATSYS & FATGRP & FATMODE
-* Unix systems: Environmental variables FATSYS & FATGRP & FATMODe
-* MVS systems: GOPARM string 'fatsys,fatgrp,path'
-*
-* e.g. FATSYS:==CERN
-* FATGRP:==L3 to make a new RZ file CERN.FATRZ for CERN
-* experiment L3
-* e.g. FATSYS:==DESY
-* FATGRP:==H1 to make a new RZ file DESY.FATRZ for DESY
-* experiment H1
-*
-* On MVS systems, if PATH=R00PAV.H1, then the previous file will
-* be created as R00PAV.H1.DESY.FATRZ
-*
-*=======================================================================
-#include "fatmen/fatsys.inc"
-#include "fatmen/slate.inc"
-#if defined(CERNLIB_IBMMVS)
- CHARACTER*100 CHPARM
-#endif
- CHARACTER*4 CHMODE
- CHARACTER*12 CHOPT
- CHARACTER*240 GENAM
- CHARACTER*12 CHUSER,CHSYS
- CHARACTER*80 PATH
- PARAMETER (LURCOR=200000)
- COMMON/CRZT/IXSTOR,IXDIV,IFENCE(2),LEV,LEVIN,BLVECT(LURCOR)
- DIMENSION LQ(999),IQ(999),Q(999)
- EQUIVALENCE (IQ(1),Q(1),LQ(9)),(LQ(1),LEV)
- COMMON /FATUSE/ IDEBFA, IDIVFA, IKDRFA, KOFSFA, KOFUFA, LBFXFA
- + , LSAVFA, LTOPFA, LBBKFA, LBGNFA, LTDSFA, LBDSFA
- + , LPRTFA, NTOPFA, LUFZFA, IOUPFA, IOBKFA, IODSFA
-*
- COMMON /USRLNK/LUSRK1,LUSRBK,LUSRLS
-*
- PARAMETER (LKEYFA=10)
- CHARACTER*8 CHTAG(LKEYFA)
- CHARACTER*10 CHFOR
- DATA CHTAG/'Num.Id.',5*'Fname'
- + ,'cp.level','loc.code','medium','nm.banks'/
- DATA CHFOR/'IHHHHHIIII'/
-*
-* Initialise ZEBRA
-*
- CALL MZEBRA(-3)
- CALL MZSTOR(IXSTOR,'/CRZT/','Q',IFENCE,LEV,BLVECT(1),BLVECT(1),
- + BLVECT(5000),BLVECT(LURCOR))
-
- CALL MZLOGL(IXSTOR,-3)
-*
-* *** Define user division and link area like:
-*
- CALL MZDIV (IXSTOR, IXDIV, 'USERS', 50000, LURCOR, 'L')
- CALL MZLINK (IXSTOR, '/USRLNK/', LUSRK1, LUSRLS, LUSRK1)
-#if defined(CERNLIB_IBMMVS)
- CALL GOPARM(LPARM,CHPARM)
- IF(LPARM.EQ.0) THEN
- NPARMS = 0
- PRINT *,'FATNEW. no GOPARM string.',
- + ' FATSYS will default to CERN'
- CHSYS = 'CERN'
- ELSE
- CALL FMNWRD(',',CHPARM(1:LPARM),NPARMS)
- ENDIF
-
- IF(NPARMS.GT.0) THEN
- CALL FMWORD(CHSYS,0,',',CHPARM(1:LPARM),IRC)
- ENDIF
-
- IF(NPARMS.GE.2) THEN
- CALL FMWORD(CHUSER,1,',',CHPARM(1:LPARM),IRC)
- ELSE
- IRC = 1
- ENDIF
-
- IF(NPARMS.GE.3) THEN
- CALL FMWORD(DEFAULT,2,',',CHPARM(1:LPARM),IRC)
- LDEF = LENOCC(DEFAULT)
- ELSE
- CALL KPREFI(DEFAULT,LDEF)
- ENDIF
-
- IF(NPARMS.GE.4) THEN
- CALL FMWORD(CHMODE,3,',',CHPARM(1:LPARM),IRC)
- LMODE = LENOCC(MODE)
- ELSE
- LMODE = 0
- ENDIF
-
-#endif
-#if defined(CERNLIB_IBMVM)
- CALL VMREXX('F','FATSYS',CHSYS,IRC)
-#endif
-#if defined(CERNLIB_UNIX)||defined(CERNLIB_VAXVMS)
- CALL GETENVF('FATSYS',CHSYS)
- LDEF = IS(1)
- IRC = 0
- IF(LDEF.EQ.0) IRC = -1
-#endif
-#if !defined(CERNLIB_IBMMVS)
- IF(IRC.NE.0) THEN
- CHSYS = 'CERN'
-#endif
-#if defined(CERNLIB_IBMVM)
- PRINT *,'FATNEW. REXX variable FATSYS not defined. '
-#endif
-#if defined(CERNLIB_VAXVMS)
- PRINT *,'FATNEW. symbol FATSYS not defined.'
-#endif
-#if defined(CERNLIB_UNIX)
- PRINT *,'FATNEW. environmental variable FATSYS not defined. '
-#endif
-#if !defined(CERNLIB_IBMMVS)
- PRINT *,'defaulted to CERN'
- ENDIF
-#endif
- CALL CLTOU(CHSYS)
- TOPDIR = '//'//CHSYS
-#if defined(CERNLIB_IBMVM)
-*
-* Take username from REXX variable 'FATGRP'
-* If not defined, use current username
-* This username determines the FATMEN group for whom we are working...
-*
- CALL VMREXX('F','FATGRP',CHUSER,IRC)
-#endif
-#if defined(CERNLIB_UNIX)||defined(CERNLIB_VAXVMS)
- CALL GETENVF('FATGRP',CHUSER)
- LDEF = IS(1)
- IRC = 0
- IF(LDEF.EQ.0) IRC = -1
-#endif
- IF(IRC.NE.0) THEN
- IC = FMUSER(CHUSER)
-#if defined(CERNLIB_IBMMVS)
- PRINT *,'FATNEW. FATGRP not defined. '
-#endif
-#if defined(CERNLIB_IBMVM)
- PRINT *,'FATNEW. REXX variable FATGRP not defined. '
-#endif
-#if defined(CERNLIB_VAXVMS)
- PRINT *,'FATNEW. symbol FATGRP not defined.'
-#endif
-#if defined(CERNLIB_UNIX)
- PRINT *,'FATNEW. environmental variable FATGRP not defined. '
-#endif
- PRINT *,'Using current username'
- ENDIF
- CALL CLTOU(CHUSER)
- SERNAM = CHUSER
-
- IF(CHUSER(1:2).NE.'FM') THEN
- SERNAM = 'FM' // CHUSER(1:LENOCC(CHUSER))
- ELSE
- SERNAM = CHUSER(1:LENOCC(CHUSER))
- ENDIF
- LSN = LENOCC(SERNAM)
-
- CALL CLTOU(SERNAM)
-*
-* Get directory where RZ file is kept...
-*
-#if defined(CERNLIB_UNIX)||defined(CERNLIB_VAXVMS)
- CALL CFILL(' ',DEFAULT,1,132)
- CALL GETENVF(SERNAM(1:LENOCC(SERNAM)),DEFAULT)
- LDEF = IS(1)
-#endif
-#if defined(CERNLIB_UNIX)||defined(CERNLIB_VAXVMS)
- CALL GETENVF('FATMODE',CHMODE)
- LMODE = IS(1)
-#endif
-#if defined(CERNLIB_IBMVM)
- CALL VMREXX('F','FATMODE',CHMODE,IRC)
- IF(IRC.EQ.0) THEN
- LMODE = LENOCC(CHMODE)
- ELSE
- LMODE = 0
- ENDIF
-#endif
-#if defined(CERNLIB_UNIX)
- IF(LMODE.EQ.0) THEN
- PRINT *,'FATNEW. RZ file will be created in EXCHANGE format'
- LMODE = 1
- CHMODE = 'X'
- ENDIF
-#endif
- IF(LMODE.EQ.0) THEN
- PRINT *,'FATNEW. native mode FORTRAN RZ file will be created'
- CHOPT = '1DLZ'
- ELSE
- PRINT *,'FATNEW. RZ file will be created with options ',CHMODE
- CHOPT = '1DLZ'//CHMODE
- ENDIF
-*
-*
-* Initialise FATMEN...
-*
- LUNRZ = 1
- LUFZFA = 2
- IFLAG = 1
-*
- FATNOD = ' '
-
- CALL FMLOGL(3)
-*
-* Single user mode
-*
- PATH = '//' // CHSYS(1:LENOCC(CHSYS)) // '/' //
- + CHUSER(1:LENOCC(CHUSER))
- LP = LENOCC(PATH)
- IF(IDEBFA.GE.3) PRINT *,'FATNEW. call FATINI for ',
- + PATH(1:LP)
- CALL FATINI(IXSTOR,LUNRZ,LUFZFA,
- + PATH(1:LP),CHOPT)
- CALL FATMDI(PATH(1:LP),LKEYFA,CHFOR,CHTAG)
- CALL FMEND(IRC)
- END
-
diff --git a/src/packlib/fatmen/programs/fato2f/Imakefile b/src/packlib/fatmen/programs/fato2f/Imakefile
deleted file mode 100644
index 88030af..0000000
--- a/src/packlib/fatmen/programs/fato2f/Imakefile
+++ /dev/null
@@ -1,3 +0,0 @@
-SRCS_F= fato2f.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/fatmen/programs/fato2f/fato2f.F b/src/packlib/fatmen/programs/fato2f/fato2f.F
deleted file mode 100644
index 1033ace..0000000
--- a/src/packlib/fatmen/programs/fato2f/fato2f.F
+++ /dev/null
@@ -1,119 +0,0 @@
-*
-* $Id: fato2f.F,v 1.1.1.1 1996/03/07 15:17:39 mclareni Exp $
-*
-* $Log: fato2f.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:39 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- PROGRAM FATO2F
-*
-* Main program for ORACLE->FZ conversion (recovery)
-* This program expects to read a group name followed by a list
-* of generic names on LUN=5 (i.e. terminal or stack)
-* Each generic name is processed in turn and the matching entry
-* sent to the server as an FZ file. The generic name(s) may
-* be terminated with a wild-card.
-*
-#include "fatmen/fatsys.inc"
-#include "fatmen/slate.inc"
- CHARACTER*240 GENAM
- CHARACTER*20 CHUSER,CHSYS
- CHARACTER*80 CARD
- PARAMETER (LURCOR=200000)
- COMMON/CRZT/IXSTOR,IXDIV,IFENCE(2),LEV,LEVIN,BLVECT(LURCOR)
- DIMENSION LQ(999),IQ(999),Q(999)
- EQUIVALENCE (IQ(1),Q(1),LQ(9)),(LQ(1),LEV)
- COMMON /FATUSE/ IDEBFA, IDIVFA, IKDRFA, KOFSFA, KOFUFA, LBFXFA
- + , LSAVFA, LTOPFA, LBBKFA, LBGNFA, LTDSFA, LBDSFA
- + , LPRTFA, NTOPFA, LUFZFA, IOUPFA, IOBKFA, IODSFA
-*
- COMMON /USRLNK/LUSRK1,LUSRBK,LUSRLS
-*
-*
-* Initialise ZEBRA
-*
- CALL MZEBRA(-3)
- CALL MZSTOR(IXSTOR,'/CRZT/','Q',IFENCE,LEV,BLVECT(1),BLVECT(1),
- + BLVECT(5000),BLVECT(LURCOR))
-
- CALL MZLOGL(IXSTOR,-3)
-*
-* *** Define user division and link area like:
-*
- CALL MZDIV (IXSTOR, IXDIV, 'USERS', 50000, LURCOR, 'L')
- CALL MZLINK (IXSTOR, '/USRLNK/', LUSRK1, LUSRLS, LUSRK1)
-#if defined(CERNLIB_IBMVM)
- CALL VMREXX('F','FATSYS',CHSYS,IRC)
-#endif
-#if defined(CERNLIB_UNIX)||defined(CERNLIB_VAXVMS)
- CALL GETENVF('FATSYS',CHSYS)
- LDEF = IS(1)
- IRC = 0
- IF(LDEF.EQ.0) IRC = -1
-#endif
- IF(IRC.NE.0) THEN
- CHSYS = 'CERN'
-#if defined(CERNLIB_IBMVM)
- PRINT *,'FATSRV. REXX variable FATSYS not defined. '
-#endif
-#if defined(CERNLIB_VAXVMS)
- PRINT *,'FATSRV. symbol FATSYS not defined.'
-#endif
-#if defined(CERNLIB_UNIX)
- PRINT *,'FATSRV. environmental variable FATSYS not defined. '
-#endif
- PRINT *,'defaulted to CERN'
- ENDIF
- CALL CLTOU(CHSYS)
- TOPDIR = '//'//CHSYS
-#if defined(CERNLIB_IBMVM)
-*
-* Take username from REXX variable 'FATMAN'
-* If not defined, use current username
-* This username determines the FATMEN group for whom we are working...
-*
- CALL VMREXX('F','FATMAN',CHUSER,IRC)
-#endif
-#if defined(CERNLIB_UNIX)||defined(CERNLIB_VAXVMS)
- CALL GETENVF('FATGRP',CHUSER)
- LDEF = IS(1)
- IRC = 0
- IF(LDEF.EQ.0) IRC = -1
-#endif
- IF(IRC.NE.0) THEN
- IC = FMUSER(CHUSER)
-#if defined(CERNLIB_IBMVM)
- PRINT *,'FATSRV. REXX variable FATMAN not defined. '
-#endif
-#if defined(CERNLIB_VAXVMS)
- PRINT *,'FATSRV. symbol FATGRP not defined.'
-#endif
-#if defined(CERNLIB_UNIX)
- PRINT *,'FATSRV. environmental variable FATGRP not defined. '
-#endif
- PRINT *,'Using current username'
- ENDIF
- CALL CLTOU(CHUSER)
-*
-*
-* Initialise FATMEN...
-*
- LUNRZ = 1
- LUNFZ = 2
- IFLAG = 0
-
- LTOP = LENOCC(TOPDIR)
- CALL FMINIT(IXSTOR,LUNRZ,LUNFZ,TOPDIR(1:LTOP)//'/'//
- + CHUSER(1:LENOCC(CHUSER)),IRC)
- CALL FMLOGI(IRC)
-10 CONTINUE
- PRINT *,'Enter generic name'
- READ(5,'(A)',END=99) CARD
- CALL FMOTOZ(CARD(1:LENOCC(CARD)),IFLAG)
- GOTO 10
-99 CONTINUE
- CALL FMEND(IRC)
- END
-
diff --git a/src/packlib/fatmen/programs/fato2z/Imakefile b/src/packlib/fatmen/programs/fato2z/Imakefile
deleted file mode 100644
index 072a781..0000000
--- a/src/packlib/fatmen/programs/fato2z/Imakefile
+++ /dev/null
@@ -1,3 +0,0 @@
-SRCS_F= fato2z.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/fatmen/programs/fato2z/fato2z.F b/src/packlib/fatmen/programs/fato2z/fato2z.F
deleted file mode 100644
index 21c8fd3..0000000
--- a/src/packlib/fatmen/programs/fato2z/fato2z.F
+++ /dev/null
@@ -1,114 +0,0 @@
-*
-* $Id: fato2z.F,v 1.1.1.1 1996/03/07 15:17:39 mclareni Exp $
-*
-* $Log: fato2z.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:39 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- PROGRAM FATO2Z
-*
-* Main program for ORACLE->RZ conversion (recovery)
-*
- CHARACTER*240 GENAM
- CHARACTER*12 CUSER
- PARAMETER (LURCOR=200000)
- COMMON/CRZT/IXSTOR,IXDIV,IFENCE(2),LEV,LEVIN,BLVECT(LURCOR)
- DIMENSION LQ(999),IQ(999),Q(999)
- EQUIVALENCE (IQ(1),Q(1),LQ(9)),(LQ(1),LEV)
- COMMON /FATUSE/ IDEBFA, IDIVFA, IKDRFA, KOFSFA, KOFUFA, LBFXFA
- + , LSAVFA, LTOPFA, LBBKFA, LBGNFA, LTDSFA, LBDSFA
- + , LPRTFA, NTOPFA, LUFZFA, IOUPFA, IOBKFA, IODSFA
-#include "fatmen/fatsys.inc"
- CHARACTER*20 CHSYS,CHUSER
-*
- COMMON /USRLNK/LUSRK1,LUSRBK,LADDR,LUSRLS
-*
-*
-* Initialise ZEBRA
-*
- CALL MZEBRA(-3)
- CALL MZSTOR(IXSTOR,'/CRZT/','Q',IFENCE,LEV,BLVECT(1),BLVECT(1),
- + BLVECT(5000),BLVECT(LURCOR))
-
- CALL MZLOGL(IXSTOR,-3)
-*
-* *** Define user division and link area like:
-*
- CALL MZDIV (IXSTOR, IXDIV, 'USERS', 50000, LURCOR, 'L')
- CALL MZLINK (IXSTOR, '/USRLNK/', LUSRK1, LUSRLS, LUSRK1)
-#if defined(CERNLIB_IBMVM)
- CALL VMREXX('F','FATSYS',CHSYS,IRC)
-#endif
-#if defined(CERNLIB_UNIX)||defined(CERNLIB_VAXVMS)
- CALL GETENVF('FATSYS',CHSYS)
- LDEF = IS(1)
- IRC = 0
- IF(LDEF.EQ.0) IRC = -1
-#endif
- IF(IRC.NE.0) THEN
- CHSYS = 'CERN'
-#if defined(CERNLIB_IBMVM)
- PRINT *,'FATSRV. REXX variable FATSYS not defined. '
-#endif
-#if defined(CERNLIB_VAXVMS)
- PRINT *,'FATSRV. symbol FATSYS not defined.'
-#endif
-#if defined(CERNLIB_UNIX)
- PRINT *,'FATSRV. environmental variable FATSYS not defined. '
-#endif
- PRINT *,'defaulted to CERN'
- ENDIF
- CALL CLTOU(CHSYS)
- TOPDIR = '//'//CHSYS
-#if defined(CERNLIB_IBMVM)
-*
-* Take username from REXX variable 'FATMAN'
-* If not defined, use current username
-* This username determines the FATMEN group for whom we are working...
-*
- CALL VMREXX('F','FATMAN',CHUSER,IRC)
-#endif
-#if defined(CERNLIB_UNIX)||defined(CERNLIB_VAXVMS)
- CALL GETENVF('FATGRP',CHUSER)
- LDEF = IS(1)
- IRC = 0
- IF(LDEF.EQ.0) IRC = -1
-#endif
- IF(IRC.NE.0) THEN
- IC = FMUSER(CHUSER)
-#if defined(CERNLIB_IBMVM)
- PRINT *,'FATSRV. REXX variable FATMAN not defined. '
-#endif
-#if defined(CERNLIB_VAXVMS)
- PRINT *,'FATSRV. symbol FATGRP not defined.'
-#endif
-#if defined(CERNLIB_UNIX)
- PRINT *,'FATSRV. environmental variable FATGRP not defined. '
-#endif
- PRINT *,'Using current username'
- ENDIF
- CALL CLTOU(CHUSER)
-*
-*
-* Initialise FATMEN...
-*
- LUNRZ = 1
- LUFZFA = 2
- IFLAG = 1
-*
-* Single user mode
-*
- LTOP = LENOCC(TOPDIR)
- CALL FATINI(IXSTOR,LUNRZ,LUFZFA,TOPDIR(1:LTOP),'1DLZ')
- CUSER = ' '
- IC = FMUSER(CUSER)
- GENAM = TOPDIR(1:LTOP)//'/'//CHUSER(1:LENOCC(CHUSER)) //'/*'
- LGNAME = LENOCC(GENAM)
- CALL FMLOGI(IRC)
- WRITE(LPRTFA,*) 'Recovering from ',GENAM(1:LGNAME)
- CALL FMOTOZ(GENAM(1:LGNAME),IFLAG)
- CALL RZSTAT(TOPDIR(1:LTOP),20,' ')
- CALL FMEND(IRC)
- END
diff --git a/src/packlib/fatmen/programs/fatrzchk/Imakefile b/src/packlib/fatmen/programs/fatrzchk/Imakefile
deleted file mode 100644
index 6e28d6b..0000000
--- a/src/packlib/fatmen/programs/fatrzchk/Imakefile
+++ /dev/null
@@ -1,3 +0,0 @@
-SRCS_F= fatrzchk.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/fatmen/programs/fatrzchk/fatrzchk.F b/src/packlib/fatmen/programs/fatrzchk/fatrzchk.F
deleted file mode 100644
index 779aa81..0000000
--- a/src/packlib/fatmen/programs/fatrzchk/fatrzchk.F
+++ /dev/null
@@ -1,144 +0,0 @@
-*
-* $Id: fatrzchk.F,v 1.1.1.1 1996/03/07 15:17:39 mclareni Exp $
-*
-* $Log: fatrzchk.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:39 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- PROGRAM FATRZCHK
-*
-* Check that RZ file is not corrupted. Requires that RZVER2
-* is extracted with sequence RZBMAP appropriately defined.
-*
-* KDMAX must be >= NRECS * LRECL / 32 (lrecl in words)
-*
-#include "fatmen/fatbug.inc"
-#include "fatmen/slate.inc"
-#include "zebra/quest.inc"
-*
- COMMON/PAWC/PAW(500000)
- CHARACTER*255 FILE,DEFAULT
- CHARACTER*8 CHWAKE,CHLOGL,CHUSER,CHHOST,CHTYPE,CHSYS,SERNAM
-#if defined(CERNLIB_IBMVM)
- CHARACTER*80 LINE
- CHARACTER*1 SERMOD
-#endif
-
- INTEGER LENOCC
-
- CALL HLIMIT(500000)
-*
-* Get the log level
-*
- CALL GETENVF('FMLOGL',CHLOGL)
- IF(IS(1).GT.0) THEN
- IDEBFA = ICDECI(CHLOGL,1,8)
- ELSE
- IDEBFA = 0
- ENDIF
-*
-* Get the system name
-*
- CALL GETENVF('FATSYS',FILE)
- IF(IS(1).EQ.0) THEN
- FILE = 'CERN'
- IS(1) = 4
- ENDIF
-
- FILE(IS(1)+1:) = '.FATRZ'
- LFILE = IS(1) + 6
-
- IF(IDEBFA.GE.0) PRINT *,'FATRZCHK. The catalogue name is '//
- +FILE(1:LFILE)
-*
-* Get the group
-*
- CALL GETENVF('FATGRP',CHUSER)
-
- IF(IS(1).EQ.0) THEN
- CHUSER = 'FMCERN'
- LUSER = 6
- ELSE
- LUSER = IS(1)
- CALL CLTOU(CHUSER)
- ENDIF
-
-
- IF(CHUSER(1:2).NE.'FM') THEN
- SERNAM = 'FM' // CHUSER(1:LUSER)
- LUSER = LUSER + 2
- ELSE
- SERNAM = CHUSER(1:LUSER)
- ENDIF
- LSN = LUSER
-
-#if defined(CERNLIB_VAXVMS)||defined(CERNLIB_UNIX)
-*
-* Get directory where RZ file is kept...
-*
- DEFAULT = ' '
- CALL GETENVF(SERNAM(1:LSN),DEFAULT)
- LDEF = IS(1)
- IF(IDEBFA.GE.0) PRINT *,'FATRZCHK. catalogue is in directory ',
- + DEFAULT(1:LDEF)
-#endif
-#if defined(CERNLIB_UNIX)
- LDEF = LDEF + 1
- DEFAULT(LDEF:LDEF) = '/'
-#endif
-
- LREC = 0
-#if defined(CERNLIB_IBMVM)
-*
-* Link to disk of specified service machine
-*
- SERMOD = '?'
- CALL VMCMS('EXEC GIME '//SERNAM//
- +'(QUIET NONOTICE STACK)',IRC)
- IF (IRC .LE. 4) THEN
- CALL VMRTRM(LINE,LEN)
- SERMOD = LINE(1:1)
- IF(IDEBFA.GE.0)
- + PRINT *,'Linked to ',SERNAM,' mode ',SERMOD
- ELSEIF(IRC.EQ.104) THEN
- IF(IDEBFA.GT.-3)
- + PRINT *,'FATRZCHK. Invalid userid. Check variable FATGRP'
- STOP 16
- ELSE
- IF(IDEBFA.GT.-3)
- + PRINT *,'FATRZCHK. Error code ',IRC,' from EXEC GIME',
- + ' type FIND GIME for a list of return codes'
- STOP 16
- ENDIF
- CALL RZOPEN(1,'RZ',FILE(1:LFILE)//' '//SERMOD,' ',LREC,IRC)
-#endif
-#if defined(CERNLIB_VAXVMS)||defined(CERNLIB_UNIX)
- CALL RZOPEN(1,'RZ',DEFAULT(1:LDEF)//FILE(1:LFILE),' ',LREC,IRC)
-#endif
- IF(ISTAT.NE.0) THEN
- PRINT *,'FATRZCHK. error ,IRC, from RZOPEN'
- GOTO 99
- ENDIF
- CALL RZFILE(1,'RZ',' ')
- CALL RZLOGL(1,1)
- CALL RZVERI('//RZ','OP')
- IRC = IQUEST(1)
- CALL RZEND('RZ')
- CLOSE(1)
-99 CONTINUE
- IF(IRC.NE.0) THEN
- PRINT *,
- + 'FATRZCHK. input RZ file is corrupt or cannot be opened!'
-#if !defined(CERNLIB_VAXVMS)
- STOP 16
-#endif
-#if defined(CERNLIB_VAXVMS)
-*%BAS-E-CORFILSTR, Corrupted file structure
- CALL SYS$EXIT(%VAL(1736938))
-#endif
- ELSE
- PRINT *,'FATRZCHK. input RZ file seems to be OK!'
- ENDIF
- END
diff --git a/src/packlib/fatmen/programs/fatrzchk/rzover.inc b/src/packlib/fatmen/programs/fatrzchk/rzover.inc
deleted file mode 100644
index af287e5..0000000
--- a/src/packlib/fatmen/programs/fatrzchk/rzover.inc
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: rzover.inc,v 1.1.1.1 1996/03/07 15:17:40 mclareni Exp $
-*
-* $Log: rzover.inc,v $
-* Revision 1.1.1.1 1996/03/07 15:17:40 mclareni
-* Fatmen
-*
-*
-*
-* rzover.inc
-*
-*
-* List of overwritten records
-*
- PARAMETER(MAXBAD=100)
- COMMON/RZOVER/NBAD,IBAD(MAXBAD)
diff --git a/src/packlib/fatmen/programs/fatsend/Imakefile b/src/packlib/fatmen/programs/fatsend/Imakefile
deleted file mode 100644
index a2ce825..0000000
--- a/src/packlib/fatmen/programs/fatsend/Imakefile
+++ /dev/null
@@ -1,10 +0,0 @@
-SRCS_F= fatsend.F
-
-#ifdef CERNLIB_VAXVMS
-NeedTcpipLib
-NeedSysexe
-#endif
-
-CernlibFortranProgramTarget(fatsend,$(OBJS),NullParameter,NullParameter,packlib)
-
-InstallProgram(fatsend,$(CERN_BINDIR))
diff --git a/src/packlib/fatmen/programs/fatsend/fatsend.F b/src/packlib/fatmen/programs/fatsend/fatsend.F
deleted file mode 100644
index 1072eb0..0000000
--- a/src/packlib/fatmen/programs/fatsend/fatsend.F
+++ /dev/null
@@ -1,862 +0,0 @@
-*
-* $Id: fatsend.F,v 1.3 1996/04/12 07:55:56 cernlib Exp $
-*
-* $Log: fatsend.F,v $
-* Revision 1.3 1996/04/12 07:55:56 cernlib
-* new handling of title string
-*
-* Revision 1.2 1996/03/29 11:30:00 jamie
-* qftitlch
-*
-* Revision 1.1.1.1 1996/03/07 15:17:40 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- PROGRAM FATSEND
-*******************************************************************************
-* *
-* ###### ## ##### #### ###### # # ##### *
-* # # # # # # ## # # # *
-* ##### # # # #### ##### # # # # # *
-* # ###### # # # # # # # # *
-* # # # # # # # # ## # # *
-* # # # # #### ###### # # ##### *
-* *
-*******************************************************************************
-* *
-* Send FATMEN updates to remote servers *
-* This version is for VM, Unix and VAX/VMS systems only *
-* (MVS version requires XZLLS, GETENVF) *
-* Can be used to transfer updates to MAXSRV remote machines *
-* Updates can be for different groups. *
-* *
-* Method: FATSEND uses environment variables to determine which *
-* ======= groups to process *
-* FATGROUPS = comma delimited list of groups *
-* e.g. export FATGROUPS="FMDELPHI,FML3,FMCNDIV" *
-* FATGRP = single group *
-* e.g. export FATGRP="FML3" *
-* same as setting FATGROUPS to FML3 *
-* *
-* The names file of each group is processed in turn *
-* and the updates moved from the local to remote machine *
-* *
-* The method is not optimal in the sense that it connects *
-* to each machine for each group in turn *
-* *
-*******************************************************************************
-
- PARAMETER (MAXFIL=1000)
- PARAMETER (MAXSRV=50)
- PARAMETER (MAXGRP=50)
- PARAMETER (IPRINT=6)
- PARAMETER (IDEBUG=-1)
- PARAMETER (LUNI=1)
- PARAMETER (LUNO=2)
- COMMON/PAWC/PAW(50000)
-#include "fatmen/fatbug.inc"
-#include "fatmen/slate.inc"
-#include "zebra/quest.inc"
- COMMON/CZSOCK/LUNCZ,IADTCP,LBUF,ISKIN,ISKOUT,IPROT
- CHARACTER*255 FILES(MAXFIL),CHFILE,CHPATT,CHDIR
- CHARACTER*20 CHIN(2,10)
- CHARACTER*255 CHOUT(2,20)
- CHARACTER*255 CHSERV,CHLIST,CHSTOP
- CHARACTER*255 CHPATH(MAXSRV)
- CHARACTER*255 GENAM,REMDIR,REMFIL,LOCFIL,TODO
- CHARACTER*20 CHTEMP
- CHARACTER*80 CHCOMM
- CHARACTER*80 CHMAIL
- CHARACTER*8 CHWAKE,CHLOGL,USER,CHHOST,CHTYPE,CHSYS
- CHARACTER*8 GROUP
- CHARACTER*8 CHGRP (MAXGRP)
- CHARACTER*20 CHNAME(MAXSRV)
- CHARACTER*20 CHUSER(MAXSRV)
- CHARACTER*80 CHNODE(MAXSRV)
- CHARACTER*20 CHPROT(MAXSRV)
- CHARACTER*20 CHRECV(MAXSRV)
- CHARACTER*80 CHQUED(MAXSRV)
- CHARACTER*1 CHMODE,CHOPT
- INTEGER*4 FMUSER,FMHOST
- DIMENSION LGRP (MAXGRP)
- DIMENSION LPATH(MAXSRV),LNAME(MAXSRV),LUSER(MAXSRV),
- + LNODE(MAXSRV),LPROT(MAXSRV),
- + LRECV(MAXSRV),LQUED(MAXSRV)
- LOGICAL IEXIST,IOPEN,IWAIT
- CHARACTER VIDQQ*(*)
-#include "fatmen/qftitlch.inc"
- PARAMETER (VIDQQ = '@(#)' //
- + FatmenTitleFortranString
- + // '>')
- CALL CLEFT (VIDQQ,1,0)
-*
-* Initialise ZEBRA
-*
- CALL HLIMIT(50000)
-*
-* Initialise XZ
-*
- CALL XZINIT(IPRINT,IDEBUG,LUNI,LUNO)
-*
-* Get host name
-*
- IC = FMHOST(CHHOST,CHTYPE,CHSYS)
- LHOST = LENOCC(CHHOST)
- CALL CLTOU(CHHOST(1:LHOST))
-#if defined(CERNLIB_UNIX)
-*
-* Get process ID
-*
- CALL GETPIDF(IPID)
- IF(CHHOST(1:LHOST).EQ.'FATCAT'.OR.
- + CHHOST(1:LHOST).EQ.'SP020') THEN
- WRITE(CHCOMM,9001) IPID
- 9001 FORMAT(' echo PID = ',I10,' >> /fatmen/FMSEND.log')
- ICODE = SYSTEMF(CHCOMM)
- WRITE(LPRTFA,9002) IPID
- 9002 FORMAT(' FATSEND. process ID is ',I10)
- ENDIF
-#endif
-*
-* Get list of users to process
-*
- CALL GETENVF('FATGROUPS',CHLIST)
- LLIST = IS(1)
- IF(LLIST.EQ.0) THEN
- NUSERS = 1
-*
-* Get our name
-*
- CALL GETENVF('FATGRP',CHGRP(1))
- LGRP(1) = IS(1)
- IF(IS(1).EQ.0) THEN
- IC = FMUSER(CHGRP(1))
- LGRP(1) = LENOCC(CHGRP(1))
- ENDIF
- CALL CLTOU(CHGRP(1)(1:LGRP(1)))
- ELSE
- CALL CLTOU(CHLIST(1:LLIST))
- CALL FMNWRD(',',CHLIST(1:LLIST),NUSERS)
- DO 10 I=1,NUSERS
- CALL FMWORD(CHGRP(I),I-1,',',CHLIST(1:LLIST),IRC)
- LGRP(I) = LENOCC(CHGRP(I))
- 10 CONTINUE
- ENDIF
-*
-* Get stop file
-*
- CALL GETENVF('FATSTOP',CHSTOP)
- LSTOP = IS(1)
-*
-* Initialise counters
-*
- NSENT = 0
- NGOT = 0
-*
-* Wait unless no files were transferred
-*
- IWAIT = .TRUE.
-*
-* Get the log level
-*
- CALL GETENVF('FMLOGL',CHLOGL)
- IF(IS(1).GT.0) THEN
- IDEBFA = ICDECI(CHLOGL,1,8)
- ELSE
- IDEBFA = 0
- ENDIF
-
- IF(IDEBFA.GT.0) THEN
- CHOPT = 'S'
- ELSE
- CHOPT = ' '
- ENDIF
-*
-* Get the wakeup interval
-*
- CALL GETENVF('FMWAKEUP',CHWAKE)
- IF(IS(1).GT.0) THEN
- ISLEEP = ICDECI(CHWAKE,1,8)
- ELSE
- ISLEEP = 60
- ENDIF
-
- NPASS = 0
-
- 20 CONTINUE
-
- NPASS = NPASS + 1
-
- DO 130 N=1,NUSERS
-
- IF(IDEBFA.GE.0) PRINT 9003,CHGRP(N)(1:LGRP(N))
- 9003 FORMAT(' FATSEND. processing group ',A)
-
- IF(CHGRP(N)(1:2).EQ.'FM') THEN
- GROUP = CHGRP(N)(1:LGRP(N))
- ELSE
- GROUP = 'FM'//CHGRP(N)(1:LGRP(N))
- ENDIF
-*
-* Get location of names file
-*
- CALL GETENVF(GROUP(1:LGRP(N)),CHDIR)
- LDIR = IS(1)
- IF(LDIR.EQ.0) THEN
- CHFILE = GROUP(1:LGRP(N))//'.NAMES'
- ELSE
-#if defined(CERNLIB_IBMMVS)
- CHFILE = CHDIR(1:LDIR)//'.'//
- + GROUP(1:LGRP(N))//'.NAMES'
-#endif
-#if defined(CERNLIB_VAXVMS)
- CHFILE = CHDIR(1:LDIR)//
- + GROUP(1:LGRP(N))//'.NAMES'
-#endif
-#if defined(CERNLIB_UNIX)
- CHFILE = CHDIR(1:LDIR)//'/'//
- + GROUP(1:LGRP(N))//'.NAMES'
-#endif
- ENDIF
- LF = LENOCC(CHFILE)
-#if defined(CERNLIB_UNIX)
- CALL CUTOL(CHFILE(1:LF))
-#endif
-#if defined(CERNLIB_IBMMVS)
-*
-* Override with names files entries
-*
- CHIN(1,1) = ':nick'
- CHIN(2,1) = 'FATSEND'
-
- CHOUT(1,1) = ':wakeup'
- CHOUT(2,1) = ' '
- CHOUT(1,2) = ':logl'
- CHOUT(2,2) = ' '
-
- NIN = 1
- NOUT = 2
- LUN = 1
- CALL NAMEFD(LUN,CHFILE(1:LF),CHIN,NIN,CHOUT,NOUT,IRC)
- IF(IRC.EQ.0) THEN
- LOUT = LENOCC(CHOUT(2,1))
- IF(LOUT.NE.0) ISLEEP = ICDECI(CHOUT(2,1),1,LOUT)
- LOUT = LENOCC(CHOUT(2,2))
- IF(LOUT.NE.0) IDEBFA = ICDECI(CHOUT(2,1),1,LOUT)
- ENDIF
-#endif
-*
-* Get the list of FATSERVERS...
-*
- CHIN(1,1) = ':nick'
- CHIN(2,1) = 'FATSERVERS'
-
- CHOUT(1,1) = ':list'
-
- NIN = 1
- NOUT = 1
- LUN = 1
- IF(IDEBFA.GE.1) PRINT 9004,CHFILE(1:LF)
- 9004 FORMAT(' FATSEND. processing names file ',A)
- CALL NAMEFD(LUN,CHFILE(1:LF),CHIN,NIN,CHOUT,NOUT,IRC)
- IF(IRC.NE.0) THEN
- PRINT *,'FATSEND. error from NAMEFD, IRC = ',IRC
- GOTO 140
- ENDIF
-*
-* For each server, get
-* :node
-* :userid
-*
-* :userid gives us the name of the FATMEN group for whom
-* we are working. e.g.
-* :userid.fmcdf
-* We expect an environmental variable/symbol of this
-* name (uppercase), e.g.
-* FMCDF:==USR$ROOT37:[FMCDF]
-* This has subdirectories [.TOnode], e.g.
-* :node.FNALF = [.TOFNALF]
-*
- CHSERV = CHOUT(2,1)
- CALL CSQMBL(CHSERV,1,LEN(CHSERV))
- LCHSERV = LENOCC(CHSERV)
-
- CALL FMNWRD(' ',CHSERV(1:LCHSERV),NSERV)
-
- IF(NSERV.GT.MAXSRV) THEN
- PRINT *,'FATSEND. cannot process more than ',MAXSRV,
- + ' servers'
- NSERV = MAXSRV
- ENDIF
-
- DO 30 I=1,NSERV
- CALL FMWORD(CHNAME(I),I-1,' ',CHSERV(1:LCHSERV),IRC)
- IF(IDEBFA.GE.0) PRINT 9005,CHNAME(I)
- 9005 FORMAT(' FATSEND. processing node ',A)
- CHIN(1,1) = ':nick'
- CHIN(2,1) = CHNAME(I)
-
- CHOUT(1,1) = ':userid'
- CHOUT(2,1) = ' '
- CHOUT(1,2) = ':node'
- CHOUT(2,2) = ' '
- CHOUT(1,3) = ':protocol'
- CHOUT(2,3) = ' '
- CHOUT(1,4) = ':receive'
- CHOUT(2,4) = ' '
- CHOUT(1,5) = ':queue'
- CHOUT(2,5) = ' '
-#if defined(CERNLIB_IBMMVS)
- CHOUT(1,6) = ':mvsid'
- CHOUT(2,6) = ' '
-#endif
-
- NIN = 1
-#if defined(CERNLIB_IBMMVS)
- NOUT = 6
-#endif
-#if !defined(CERNLIB_IBMMVS)
- NOUT = 5
-#endif
-
- CALL NAMEFD(LUN,CHFILE(1:LF),CHIN,NIN,CHOUT,NOUT,IRC)
-
- LUSER(I) = LENOCC(CHOUT(2,1))
- CHUSER(I) = CHOUT(2,1)(1:LUSER(I))
-
- LNODE(I) = LENOCC(CHOUT(2,2))
- CHNODE(I) = CHOUT(2,2)(1:LNODE(I))
-
- LPROT(I) = LENOCC(CHOUT(2,3))
- IF(LPROT(I).EQ.0) THEN
- LPROT(I) = 18
- CHPROT(I) = 'TCP/IP (defaulted)'
- ELSE
- CHPROT(I) = CHOUT(2,3)(1:LPROT(I))
- CALL CLTOU(CHPROT(I)(1:LPROT(I)))
- ENDIF
-
- LRECV(I) = LENOCC(CHOUT(2,4))
- IF(LRECV(I).EQ.0) THEN
- LRECV(I) = 14
- CHRECV(I) = 'NO (defaulted)'
- ELSE
- CHRECV(I) = CHOUT(2,4)(1:LRECV(I))
- CALL CLTOU(CHRECV(I)(1:LRECV(I)))
- ENDIF
-
- LQUED(I) = LENOCC(CHOUT(2,5))
- CHQUED(I) = CHOUT(2,5)(1:LQUED(I))
-#if defined(CERNLIB_IBMMVS)
- LPATH(I) = LENOCC(CHOUT(2,6))
- CHPATH(I) = CHOUT(2,6)(1:LPATH(I))
- CALL CLTOU(CHPATH(I)(1:LPATH(I)))
-#endif
-
- IF(NPASS.EQ.1.AND.IDEBFA.GE.0) THEN
- PRINT 9006,CHUSER(I)(1:LUSER(I))
- 9006 FORMAT(' FATSEND. remote user : ',A)
- PRINT 9007,CHNODE(I)(1:LNODE(I))
- 9007 FORMAT(' FATSEND. remote node : ',A)
- IF(CHPROT(I)(1:LPROT(I)).EQ.'afs') THEN
- PRINT 9008,CHPROT(I)(1:LPROT(I))
- 9008 FORMAT(' FATSEND. protocol : ',A,' (skipped by this server)')
- ELSE
- PRINT 9009,CHPROT(I)(1:LPROT(I))
- 9009 FORMAT(' FATSEND. protocol : ',A)
- ENDIF
- PRINT 9010,CHRECV(I)(1:LRECV(I))
- 9010 FORMAT(' FATSEND. receive? : ',A)
- PRINT 9011,CHQUED(I)(1:LQUED(I))
- 9011 FORMAT(' FATSEND. remote queue : ',A)
- ENDIF
-
- IF(CHRECV(I)(1:LRECV(I)).EQ.'YES') THEN
- LRECV(I) = 0
- ELSE
- IF(INDEX(CHPROT(I)(1:LPROT(I)),'BITNET').NE.0) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FATSEND. receive option ',
- + 'invalid for Bitnet nodes'
- LRECV(I) = 0
- ENDIF
- ENDIF
-#if (defined(CERNLIB_IBMVM))&&(!defined(CERNLIB_SFS))
-*
-* Get disk mode on which the queue files are kept
-*
- CALL GETENVF('FATQUE',CHMODE)
- IF(IS(1).EQ.0) THEN
- IF(NPASS.EQ.1.AND.IDEBFA.GE.0)
- + PRINT *,'FATSEND. queue disk defaulted to B'
- CHMODE = 'B'
- ELSE
- IF(NPASS.EQ.1.AND.IDEBFA.GE.0)
- + PRINT *,'FATSEND. queue disk is at mode ',CHMODE
- ENDIF
-
-#endif
-#if (!defined(CERNLIB_IBMVM))&&(!defined(CERNLIB_SFS)||!defined(CERNLIB_IBMMVS))
-*
-* Get the pathname on the local machine where files are located
-*
- CHPATH(I) = ' '
- CHTEMP = CHUSER(I)(1:LUSER(I))
- CALL CLTOU(CHTEMP)
- CALL GETENVF(CHTEMP,CHPATH(I))
- LPATH(I) = IS(1)
-#endif
-#if (!defined(CERNLIB_IBMVM))&&(!defined(CERNLIB_SFS))
- IF(LPATH(I).EQ.0) THEN
- IF(NPASS.EQ.1)
- + PRINT *,'FATSEND. error - variable ',CHUSER(I)(1:
- + LUSER(I)), ' is not defined. Updates will not be '
- + //'processed.'
- ELSE
- IF(NPASS.EQ.1.AND.IDEBFA.GE.0)
- + PRINT *,'FATSEND. local queue : ',
- + CHPATH(I) (1:LPATH(I))
- ENDIF
-#endif
-
- 30 CONTINUE
-*
-* Now we are ready to go.
-*
- 40 CONTINUE
- DO 120 I=1,NSERV
-*
-* Loop over all remote servers
-#if (!defined(CERNLIB_IBMVM))&&(!defined(CERNLIB_SFS))
-*
-* Skip if local path undefined
-*
- IF(LPATH(I).EQ.0) GOTO 120
-*
-* Skip if protocol is AFS
-*
- IF(CHPROT(I)(1:LPROT(I)).EQ.'afs') GOTO 120
-#endif
-*
-* Look for files in local queue
-*
-#if defined(CERNLIB_VAXVMS)
- CHPATT = CHPATH(I)(1:LPATH(I)-1) // '.TO' // CHNODE(I)(1:
- + LNODE(I)) // CHPATH(I)(LPATH(I):LPATH(I))
- LPATT = LENOCC(CHPATT)
-#endif
-#if defined(CERNLIB_UNIX)
- CHPATT = CHPATH(I)(1:LPATH(I)) // '/TO' // CHNODE(I)(1:
- + LNODE(I))
- LPATT = LENOCC(CHPATT)
- CALL CUTOL(CHPATT(1:LPATT))
-#endif
-#if defined(CERNLIB_IBMMVS)
- CHPATT = CHPATH(I)(1:LPATH(I)) // '.TO' // CHNODE(I)(1:
- + LNODE(I))
- LPATT = LENOCC(CHPATT)
-#endif
-#if (defined(CERNLIB_IBMVM))&&(!defined(CERNLIB_SFS))
-*
-* Look for files on the FATQUE disk
-*
- CHPATT = CHUSER(I)(1:LUSER(I)) // ' ' // CHNODE(I)(1:
- + LNODE(I)) // ' ' //CHMODE
- LPATT = LENOCC(CHPATT)
-#endif
-#if !defined(CERNLIB_IBMVM)
-*
-* Look for signal.stop file
-*
- IF(LSTOP.EQ.0) THEN
-
-#endif
-#if defined(CERNLIB_IBMMVS)
- CHSTOP = '/'//CHPATT(1:LPATT)//'.SIGNAL.STOP'
- LSTOP = LPATT + 13
-#endif
-#if defined(CERNLIB_UNIX)
- CHSTOP = CHPATT(1:LPATT)//'/signal.stop'
- LSTOP = LPATT + 12
-#endif
-#if defined(CERNLIB_VAXVMS)
- CHSTOP = CHPATT(1:LPATT)//'SIGNAL.STOP'
- LSTOP = LPATT + 11
-#endif
-#if !defined(CERNLIB_IBMVM)
- ENDIF
- INQUIRE(FILE=CHSTOP(1:LSTOP),EXIST=IEXIST)
- IF(IEXIST) THEN
- PRINT *,'FATSEND. signal.stop file found - stopping'
- GOTO 140
- ENDIF
-#endif
-
- ICONT = 0
- ISENT = 0
- IOPEN = .FALSE.
- 50 CONTINUE
- CALL XZLLS(CHPATT(1:LPATT),FILES,MAXFIL,NFOUND,ICONT,' ',
- + IRC)
- IF(NFOUND.EQ.0) GOTO 120
-*
-* XZLLS sets IRC to -1 if NFOUND>MAXFIL...
-*
- IRC = 0
- NFOUND = MIN(NFOUND,MAXFIL)
-*
-* If we are continuing with an existing node, skip the CZOPEN etc.
-*
- IF(ICONT.NE.0.AND.IOPEN) GOTO 60
-*
- IF(INDEX(CHPROT(I),'BITNET').NE.0) THEN
- IPROT = -1
- ELSEIF(INDEX(CHPROT(I),'MVSJOB').NE.0) THEN
- IPROT = -2
- ELSEIF(INDEX(CHPROT(I),'DECNET').NE.0) THEN
- IPROT = 1
- ELSE
- IPROT = 0
- ENDIF
-*
-* Skip CZOPEN for Bitnet & MVS nodes
-*
- IF(IPROT.LT.0) GOTO 60
-*
-* Open connection to remote node using specified protocol
-* This assumes that we have a correctly configured .netrc
-* file, or the correct PROXY settings for DECnet connections.
-*
- CALL CZOPEN('zserv',CHNODE(I)(1:LNODE(I)),IRC)
- IF(IRC.NE.0) THEN
- PRINT *,'FATSEND. cannot connect to ', CHNODE(I)(1:
- + LNODE(I))
- GOTO 120
- ENDIF
-*
-* Get current directory - this will tell us what sort
-* of machine we are talking to...
-*
- CALL XZPWD(REMDIR,IRC)
- LRDIR = LENOCC(REMDIR)
-*
-* Get type of machine
-*
- IVAX = 0
- IF((INDEX(REMDIR(1:LRDIR),']').NE.0).OR. (INDEX(REMDIR(1:
- + LRDIR),'>').NE.0)) IVAX = 1
-*
-* If remote queue is not defined, assume that we are
-* in home directory of remote server
-*
- IF(LQUED(I).EQ.0) THEN
- IF(IVAX.EQ.1) THEN
- IF(IDEBFA.GE.1) PRINT 9012,'[.TODO]'
- CALL XZCD('[.TODO]',IRC)
- ELSE
- IF(IDEBFA.GE.1) PRINT 9012,'TODO'
- CALL XZCD('TODO',IRC)
- ENDIF
- ELSE
- IF(IDEBFA.GE.1) PRINT 9012,CHQUED(I)(1:LQUED(I))
- CALL XZCD(CHQUED(I)(1:LQUED(I)),IRC)
- ENDIF
- 9012 FORMAT(' FATSEND. setting remote directory to ',A)
-
- IF(IRC.NE.0) GOTO 140
-
- 60 CONTINUE
- IOPEN = .TRUE.
-
- DO 70 J=1,NFOUND
-#if defined(CERNLIB_UNIX)
- CHFILE = CHPATT(1:LPATT)//'/'//FILES(J)
-#endif
-#if defined(CERNLIB_VAXVMS)||defined(CERNLIB_IBMMVS)
- CHFILE = FILES(J)
-#endif
- LF = LENOCC(CHFILE)
-*
-* Skip active files
-*
-#if defined(CERNLIB_VAXVMS)
- IBRA = INDEXB(CHFILE(1:LF),']')
- IF(CHFILE(IBRA+1:IBRA+2).EQ.'ZZ') GOTO 70
- IF(CHFILE(IBRA+1:IBRA+2).EQ.'zz') GOTO 70
-#endif
-#if defined(CERNLIB_UNIX)
- ISLA = INDEXB(CHFILE(1:LF),'/')
- IF(CHFILE(ISLA+1:ISLA+2).EQ.'ZZ') GOTO 70
- IF(CHFILE(ISLA+1:ISLA+2).EQ.'zz') GOTO 70
-#endif
-*
-* Transfer the file
-*
- IF(IPROT.LT.0) THEN
- CALL FABNET(CHFILE(1:LF),CHUSER(I)(1:LUSER(I)),
- + CHNODE(I )(1:LNODE(I)),IPROT,IRC)
- ELSE
- CALL FMJOUR(REMFIL)
- LREM = LENOCC(REMFIL)
- IF(IDEBFA.GE.1) PRINT 9013,CHFILE(1:LF),
- + REMFIL(1:LREM)
- 9013 FORMAT(' FATSEND. sending ',A,' as ',A)
- CALL XZPUTA(CHFILE(1:LF),REMFIL(1:LREM),CHOPT,IRC)
- IF(IRC.EQ.0) THEN
- NSENT = NSENT + 1
- ISENT = ISENT + 1
-*
-* Now rename the remote file
-*
- IF(IDEBFA.GE.1) PRINT 9014,REMFIL(1:LREM),
- + 'AA'//REMFIL(3:LREM)
- 9014 FORMAT(' FATSEND. renaming ',A,' to ',A)
- CALL XZMV(REMFIL(1:LREM),'AA'//REMFIL(3:LREM),' ',
- + IRC)
- ENDIF
- ENDIF
- IF(IRC.NE.0) THEN
- PRINT 9015,CHFILE(1:LF),CHNODE(I)(1:LNODE(I))
- 9015 FORMAT(' FATSEND. error transferring ',A,' to ',A)
- ICONT = 0
- GOTO 110
- ENDIF
-*
-* and delete the original if successful
-*
- IF(IDEBFA.GE.1) PRINT 9016,CHFILE(1:LF)
- 9016 FORMAT(' FATSEND. deleting ',A)
- CALL XZLRM(CHFILE(1:LF),IRC)
-*
-* any remaining files to process?
-*
- 70 CONTINUE
- IF(ICONT.NE.0) GOTO 50
-
- IF(ISENT.NE.0) IWAIT = .FALSE.
- IF(ISENT.GT.0.AND.IDEBFA.GE.0) THEN
- CALL DATIME(ID,IT)
- WRITE(LPRTFA,9017) ID,IT,ISENT,CHNODE(I)(1:LNODE(I)),
- + CHGRP(N)(1:LGRP(N))
- 9017 FORMAT(' FATSEND. ',I6,1X,I4,' sent ',I10,' files to ',A,
- + ' for ',A)
- ENDIF
-*
-* Should we receive any files for us?
-*
- IF(LRECV(I).EQ.0) THEN
- IF(IVAX.EQ.0) THEN
- IF(IDEBFA.GE.1) PRINT 9012,
- + '../TO'//CHHOST(1:LHOST)
- CALL XZCD('../TO'//CHHOST(1:LHOST),IRC)
- ELSE
- IF(IDEBFA.GE.1) PRINT 9012,
- + '[-.TO'//CHHOST(1:LHOST)//']'
- CALL XZCD('[-.TO'//CHHOST(1:LHOST)//']',IRC)
- ENDIF
- IF(IRC.NE.0) GOTO 110
-*
-* Anything there?
-*
- ICONT = 0
- IGOT = 0
- 80 CONTINUE
- CALL XZLS(' ',FILES,MAXFIL,NFOUND,ICONT,' ',IRC)
- IF(ICONT.NE.0) THEN
- PRINT *,'FATSEND. too many files - excess names '//
- + 'will be flushed'
-*
- 90 CONTINUE
- CALL CZGETA(CHMAIL,ISTAT)
- LCH = LENOCC(CHMAIL)
- IF(CHMAIL(1:1).EQ.'0') THEN
- ELSEIF(CHMAIL(1:1).EQ.'1') THEN
- ELSEIF(CHMAIL(1:1).EQ.'2') THEN
- GOTO 90
- ELSEIF(CHMAIL(1:1).EQ.'3') THEN
- IQUEST(1) = 1
- IRC = 1
- ELSEIF(CHMAIL(1:1).EQ.'E') THEN
- IQUEST(1) = -1
- IRC = -1
- ELSEIF(CHMAIL(1:1).EQ.'V') THEN
- GOTO 90
- ELSE
- IQUEST(1) = 1
- IRC = 1
- ENDIF
-*
- ENDIF
-
- NFOUND = MIN(NFOUND,MAXFIL)
-
- DO 100 J=1,NFOUND
-*
-* Get current file
-*
- CHFILE = FILES(J)
- LF = LENOCC(CHFILE)
- CALL CLTOU(CHFILE(1:LF))
-*
-* Skip active files
-*
- IBRA = INDEXB(CHFILE(1:LF),']')
- IF(CHFILE(IBRA+1:IBRA+2).EQ.'ZZ') GOTO 100
-*
-* Did it come from this node?
-*
- IF(INDEX(CHFILE(1:LF),'_'//CHHOST(1:LHOST)).EQ.0) THEN
-#if (!defined(CERNLIB_IBMVM))&&(!defined(CERNLIB_SFS))
- CALL FMJOUR(LOCFIL)
- LLOC = LENOCC(LOCFIL)
-#endif
-#if defined(CERNLIB_VAXVMS)
- CHPATT = CHPATH(I)(1:LPATH(I)-1) // '.TODO' //
- + CHPATH(I)(LPATH(I):LPATH(I))
- LPATT = LENOCC(CHPATT)
-#endif
-#if defined(CERNLIB_UNIX)
- CHPATT = CHPATH(I)(1:LPATH(I)) // '/TODO/'
- LPATT = LENOCC(CHPATT)
- CALL CUTOL(CHPATT(1:LPATT))
-#endif
-#if defined(CERNLIB_IBMMVS)
- CHPATT = CHPATH(I)(1:LPATH(I)) // '.TODO.'
- LPATT = LENOCC(CHPATT)
-#endif
-#if (defined(CERNLIB_IBMVM))&&(!defined(CERNLIB_SFS))
-*
-* Receive into a temporary file
-*
- CHPATT = CHUSER(I)(1:LUSER(I)) // ' '
- LPATT = LUSER(I) + 1
- LOCFIL = CHNODE(I)(1:LNODE(I)) // ' A3'
- LLOC = LNODE(I) + 3
-#endif
- PRINT 9018,CHPATT(1:LPATT)//LOCFIL(1:LLOC),
- + CHFILE(1:LF)
- 9018 FORMAT(' FATSEND. receiving ',A,' from ',A)
- CALL XZGETA(CHPATT(1:LPATT)//LOCFIL(1:LLOC),
- + CHFILE(1 :LF),CHOPT,IRC)
- IF(IRC.NE.0) THEN
- ICONT = 0
- GOTO 110
- ENDIF
- NGOT = NGOT + 1
- IGOT = IGOT + 1
-#if (!defined(CERNLIB_IBMVM))&&(!defined(CERNLIB_SFS))
-*
-* Now rename the local file
-*
- PRINT 9014,CHPATT(1:LPATT)//LOCFIL(1:LLOC),
- + CHPATT(1: LPATT)//'AA'//LOCFIL(3:LLOC)
- CALL XZLMV(CHPATT(1:LPATT)//LOCFIL(1:LLOC),
- + CHPATT(1: LPATT)//'AA'//LOCFIL(3:LLOC), ' ',IRC)
-#endif
-#if (defined(CERNLIB_IBMVM))&&(!defined(CERNLIB_SFS))
-*
-* Now send it to the local server
-* The FATMEN server should not send it back if:
-* 1) fromid = gateway
-* 2) fromnode = current node
-*
- IF(IDEBFA.GE.1)
- + PRINT 9019,CHPATT(1:LPATT)//LOCFIL(1:LLOC),
- + CHUSER(I)(1:LUSER(I)),CHHOST(1:LHOST)
- 9019 FORMAT(' FATSEND. sending ',A,' to ',A,' at ',A)
- CALL VMCMS('EXEC SENDFILE '// CHPATT(1:LPATT)//
- + LOCFIL(1:LLOC)// ' TO '//CHUSER(I)(1:LUSER(I))//
- + ' AT '//CHHOST(1:LHOST),IRC)
-
-#endif
- ELSE
- IF(IDEBFA.GE.1) PRINT 9020,CHFILE(1:LF),
- + CHHOST(1:LHOST)
- 9020 FORMAT(' FATSEND. file ',A,' originated from this node (',A,')')
- ENDIF
-*
-* Delete
-*
- IF(IDEBFA.GE.1) PRINT 9021,CHFILE(1:LF)
- 9021 FORMAT(' FATSEND. removing file ',A)
- CALL XZRM(CHFILE(1:LF),IRC)
-
- 100 CONTINUE
- IF(ICONT.NE.0) GOTO 80
-
- IF(IGOT.NE.0) IWAIT = .FALSE.
- IF(IGOT.GT.0.AND.IDEBFA.GE.0) THEN
- CALL DATIME(ID,IT)
- WRITE(LPRTFA,9022) ID,IT,IGOT,CHNODE(I)(1:LNODE(I)),
- + CHGRP(N)(1:LGRP(N))
- 9022 FORMAT(' FATSEND. ',I6,1X,I4,' received ',I10,' files from ',A,
- + ' for ',A)
- ENDIF
-
- ENDIF
- 110 CONTINUE
- IF(IPROT.GE.0) THEN
-*
-* Close current connection
-*
- CALL CZCLOS(IRC)
- ENDIF
- 120 CONTINUE
-
- IF(NUSERS.EQ.1) THEN
- IF(IWAIT) THEN
- IF(IDEBFA.GE.0) THEN
- CALL DATIME(ID,IT)
- PRINT 9023,ID,IT,ISLEEP
- 9023 FORMAT(' FATSEND. time is ',I6,1X,I4,' sleeping for ',I6,
- + ' seconds')
- ENDIF
- IF(IDEBFA.GE.2) PRINT 9024
- 9024 FORMAT(' FATSEND. (no files transferred in last iteration)')
-
- CALL SLEEPF(ISLEEP)
- ENDIF
- IWAIT = .TRUE.
- GOTO 40
- ENDIF
- 130 CONTINUE
-
- IF(IWAIT) THEN
- IF(IDEBFA.GE.0) THEN
- CALL DATIME(ID,IT)
- PRINT 9023,ID,IT,ISLEEP
- ENDIF
- IF(IDEBFA.GE.2) PRINT 9024
-
- CALL SLEEPF(ISLEEP)
- ENDIF
- IWAIT = .TRUE.
-*
-* Reprocess names file in case of multiple groups
-*
- GOTO 20
-
- 140 CONTINUE
-
- CALL DATIME(ID,IT)
- PRINT 9025,NSENT,NGOT,NUSERS
- 9025 FORMAT(' FATSEND. sent ',I6,' and received ',I6,
- + ' files for ',I6,' servers')
- PRINT 9026,ID,IT
- 9026 FORMAT(' FATSEND. stopping at ',I6,1X,I4)
-
-#if defined(CERNLIB_VAXVMS)
-*
-* Dummmies
-*
- CALL CZDUMM
-#endif
-
- END
-#if defined(CERNLIB_VAXVMS)
- SUBROUTINE CZDUMM
- ENTRY CTL$GL_PCB
- ENTRY CTL$T_ACCOUNT
- ENTRY CTL$T_USERNAME
- END
-#endif
diff --git a/src/packlib/fatmen/programs/fatsreq/Imakefile b/src/packlib/fatmen/programs/fatsreq/Imakefile
deleted file mode 100644
index 1c19b5d..0000000
--- a/src/packlib/fatmen/programs/fatsreq/Imakefile
+++ /dev/null
@@ -1,3 +0,0 @@
-SRCS_F= fatsreq.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/fatmen/programs/fatsreq/fatsreq.F b/src/packlib/fatmen/programs/fatsreq/fatsreq.F
deleted file mode 100644
index 9273909..0000000
--- a/src/packlib/fatmen/programs/fatsreq/fatsreq.F
+++ /dev/null
@@ -1,103 +0,0 @@
-*
-* $Id: fatsreq.F,v 1.1.1.1 1996/03/07 15:17:40 mclareni Exp $
-*
-* $Log: fatsreq.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:40 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- PROGRAM FATSREQ
-*
-* Issue SYSREQ command with retry
-*
- CHARACTER*255 CHLINE
-#include "fatmen/tmsrep.inc"
-#if defined(CERNLIB_UNIX)
- CHARACTER*255 CHARG
-#endif
-
-#if defined(CERNLIB_IBM)
- CALL GOPARM(LLINE,CHLINE)
-#endif
-#if defined(CERNLIB_VAXVMS)
- IFLAG = 0
- CALL LIB$GET_FOREIGN(CHLINE,,LLINE,IFLAG)
-#endif
-#if defined(CERNLIB_UNIX)
- NARGS = IARGC(DUMMY)
- LLINE = 0
-
- DO 10 I=1,NARGS
- CALL GETARG(I,CHARG)
- LARG = LENOCC(CHARG)
- IF(I.EQ.1) THEN
- CHLINE = CHARG(1:LARG)
- LLINE = LARG
- ELSE
- CHLINE(LLINE+1:) = ' '//CHARG(1:LARG)
- LLINE = LLINE + LARG + 1
- ENDIF
- 10 CONTINUE
-#endif
-
- IF(LLINE.EQ.0) THEN
- WRITE(6,9001)
- 9001 FORMAT(' FATSREQ. service name missing')
-#if defined(CERNLIB_VAXVMS)
- CALL SYS$EXIT(%VAL(3))
-#endif
-#if defined(CERNLIB_UNIX)
- CALL FAEXIT(3)
-#endif
-#if defined(CERNLIB_IBM)
- STOP 3
-#endif
- ELSE
-
- L = LENREP
- IBLANK = INDEX(CHLINE(1:LLINE),' ')
- IF(IBLANK.EQ.0) THEN
- WRITE(6,9002)
- 9002 FORMAT(' FATSREQ. command missing')
-#if defined(CERNLIB_VAXVMS)
- CALL SYS$EXIT(%VAL(3))
-#endif
-#if defined(CERNLIB_UNIX)
- CALL FAEXIT(3)
-#endif
-#if defined(CERNLIB_IBM)
- STOP 3
-#endif
- ENDIF
- CALL FMSREQ(CHLINE(1:IBLANK-1),CHLINE(IBLANK+1:LLINE),
- + IRC,TMSREP,L)
- IF(IRC.NE.0) THEN
- WRITE(6,9003) IRC
- 9003 FORMAT(' FATSREQ. RC from FMSREQ = ',I6)
-#if defined(CERNLIB_IBM)
- STOP 8
-#endif
-#if defined(CERNLIB_VAXVMS)
- CALL SYS$EXIT(%VAL(44))
-#endif
-#if defined(CERNLIB_UNIX)
- CALL FAEXIT(8)
-#endif
- ENDIF
-
- DO 20 I=1,L
- WRITE(6,9004) TMSREP(I)(1:LENOCC(TMSREP(I)))
- 9004 FORMAT(1X,A)
- 20 CONTINUE
-
-#if defined(CERNLIB_VAXVMS)
- CALL SYS$EXIT(%VAL(1))
-#endif
-#if !defined(CERNLIB_VAXVMS)
- STOP
-#endif
-
- ENDIF
-
- END
diff --git a/src/packlib/fatmen/programs/fatsrv/Imakefile b/src/packlib/fatmen/programs/fatsrv/Imakefile
deleted file mode 100644
index 879e30c..0000000
--- a/src/packlib/fatmen/programs/fatsrv/Imakefile
+++ /dev/null
@@ -1,15 +0,0 @@
-SRCS_F= abend.F facopy.F fatlog.F fatsrv.F fmallk.F fmfzi.F fmssnd.F
-
-#ifdef CERNLIB_IBMMVS
-SRCS_F:= $(SRCS_F) falcat.F famove.F
-#endif
-
-#ifdef CERNLIB_VAXVMS
-NeedTcpipLib
-NeedSysexe
-#endif
-
-
-CernlibFortranProgramTarget(fatsrv,$(OBJS),NullParameter,NullParameter,packlib)
-
-InstallProgram(fatsrv,$(CERN_BINDIR))
diff --git a/src/packlib/fatmen/programs/fatsrv/abend.F b/src/packlib/fatmen/programs/fatsrv/abend.F
deleted file mode 100644
index 38bb08b..0000000
--- a/src/packlib/fatmen/programs/fatsrv/abend.F
+++ /dev/null
@@ -1,52 +0,0 @@
-*
-* $Id: abend.F,v 1.1.1.1 1996/03/07 15:17:41 mclareni Exp $
-*
-* $Log: abend.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:41 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE ABEND
-#include "fatmen/fatstat.inc"
-#include "fatmen/fatbug.inc"
- INTEGER SYSTEMF
-
- PRINT *,'ABEND. printing final FATSRV statistics'
-
- WRITE(LPRTFA,9001) NFMUSR,NFMNOD,NFMFIL,NFMCOM
- +,NFMPUT,NFMMOD,NFMDEL,NFMMDR,NFMRMD,NFMOPN,NFMCLS
- +,NFMPDK,NFMPRP,NFMPDL,NFMBAD,NFMLOG
-
- 9001 FORMAT(' FATSRV. termination statistics: ',/,
- + ' Number of different users = ',I6,' (not yet counted) ',/,
- + ' Number of different nodes = ',I6,' (not yet counted) ',/,
- + ' Number of files = ',I6,/,
- + ' Number of commands = ',I6,/,
- + ' Number of PUTs = ',I6,/,
- + ' Number of MODs = ',I6,/,
- + ' Number of DELs = ',I6,/,
- + ' Number of MKDIRs = ',I6,/,
- + ' Number of RMDIRs = ',I6,/,
- + ' Number of OPENs = ',I6,/,
- + ' Number of CLOSEs = ',I6,' (not yet counted) ',/,
- + ' Number of RZDELK warnings = ',I6,/,
- + ' Number of REP failures = ',I6,' (no such entry) ',/,
- + ' Number of DEL failures = ',I6,' (no such entry) ',/,
- + ' Number of BAD commands = ',I6,' (unrecognised) ',/,
- + ' Number of LOG commands = ',I6)
-
-#if defined(CERNLIB_UNIX)
- PRINT *,'ABEND. calling FATABEND script'
- IC = SYSTEMF('fatabend')
-#endif
-#if defined(CERNLIB_VAXVMS)
- PRINT *,'ABEND. calling FATABEND command file'
- IC = SYSTEMF('@FATABEND')
-#endif
-#if defined(CERNLIB_IBMVM)
- PRINT *,'ABEND. calling FATABEND exec'
- IC = SYSTEMF('EXEC FATABEND')
-#endif
-
- END
diff --git a/src/packlib/fatmen/programs/fatsrv/facopy.F b/src/packlib/fatmen/programs/fatsrv/facopy.F
deleted file mode 100644
index 1362e19..0000000
--- a/src/packlib/fatmen/programs/fatsrv/facopy.F
+++ /dev/null
@@ -1,81 +0,0 @@
-*
-* $Id: facopy.F,v 1.1.1.1 1996/03/07 15:17:41 mclareni Exp $
-*
-* $Log: facopy.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:41 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FACOPY(OLDDSN,NEWDSN,IRC)
-*CMZ : 17/05/91 14.46.08 by Jamie Shiers
-*-- Author : Jamie Shiers 17/05/91
- CHARACTER*(*) OLDDSN,NEWDSN
- CHARACTER*255 SRCDSN,TGTDSN
- CHARACTER*80 CARD
-#if defined(CERNLIB_UNIX)
- INTEGER SYSTEMF
-#endif
-#include "fatmen/fattyp.inc"
-#include "fatmen/fatbug.inc"
-
- IRC = 0
-
- LOLD = LENOCC(OLDDSN)
- LNEW = LENOCC(NEWDSN)
- IF(IDEBFA.GE.3) PRINT *,'FACOPY. copy ',OLDDSN(1:LOLD),
- + ' to ',NEWDSN(1:LNEW)
-#if defined(CERNLIB_IBMMVS)
- OPEN(11,FILE='/'//OLDDSN(1:LOLD),STATUS='OLD',ERR=98,
- + FORM='FORMATTED',ACTION='READWRITE')
-*
-* Create new CARD file
-*
- LUNIT = LENOCC(CHMGEN(1))
- CALL FILEINF(ISTAT,'DEVICE',CHMGEN(1)(1:LUNIT),'TRK',1,
- + 'SECOND',1,'DIR',0,
- + 'RECFM','FB','LRECL',80,'BLKSIZE',9040)
- OPEN(12,FILE='/'//NEWDSN(1:LNEW),STATUS='NEW',ERR=99,
- + FORM='FORMATTED',ACTION='READWRITE')
-#endif
-#if !defined(CERNLIB_IBMMVS)
- OPEN(11,FILE=OLDDSN(1:LOLD),STATUS='OLD',ERR=98,
- + FORM='FORMATTED')
- OPEN(12,FILE=NEWDSN(1:LNEW),STATUS='NEW',ERR=99,
- + FORM='FORMATTED')
-#endif
-
-1 READ(11,'(A)',END=97) CARD
- WRITE(12,'(A)') CARD
- GOTO 1
-
-97 CLOSE(11,STATUS='KEEP')
- CLOSE(12,STATUS='KEEP')
-*
-* Now rename the file
-*
- SRCDSN = NEWDSN(1:LNEW)
- TGTDSN = NEWDSN(1:LNEW)
-#if defined(CERNLIB_VAXVMS)
- LSTA = INDEX(TGTDSN(1:LNEW),']') + 1
- TGTDSN(LSTA:LSTA+1) = 'AA'
- ISTAT = LIB$RENAME_FILE(SRCDSN(1:LNEW),TGTDSN(1:LNEW),,,,,,,,,,)
- IF(.NOT.ISTAT) CALL LIB$SIGNAL(%VAL(ISTAT))
-#endif
-#if defined(CERNLIB_UNIX)
- LSTA = INDEXB(TGTDSN(1:LNEW),'/') + 1
- TGTDSN(LSTA:LSTA+1) = 'aa'
- ISTAT = SYSTEMF('mv '//SRCDSN(1:LNEW)//' '//TGTDSN(1:LNEW))
-#endif
-
- RETURN
-
-98 IRC = 1
- IF(IDEBFA.GE.-3) PRINT *,'FACOPY. cannot open input file - ',
- + OLDDSN(1:LOLD)
- RETURN
-99 IRC = 1
- IF(IDEBFA.GE.-3) PRINT *,'FACOPY. cannot open output file - ',
- + NEWDSN(1:LNEW)
- RETURN
- END
diff --git a/src/packlib/fatmen/programs/fatsrv/falcat.F b/src/packlib/fatmen/programs/fatsrv/falcat.F
deleted file mode 100644
index 8f824c0..0000000
--- a/src/packlib/fatmen/programs/fatsrv/falcat.F
+++ /dev/null
@@ -1,49 +0,0 @@
-*
-* $Id: falcat.F,v 1.1.1.1 1996/03/07 15:17:40 mclareni Exp $
-*
-* $Log: falcat.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:40 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
-#if defined(CERNLIB_IBMMVS)
-************************************************************************
-* ----- ----
- SUBROUTINE FALCAT(LEVEL,DSN,MAXDSN,FILLED,FLAG)
-* --- ------ ------ ----
-*
-* LEVEL - MVS catalogue level to be listed
-* DSN - character array of length MAXDSN filled up to FILLED
-* FLAG - 1 = more calls needed for full listing
-* - 0 = finished
-* (c) J.H.Peters, DESY, 8.3.1991
-************************************************************************
-
- CHARACTER*(*) LEVEL,DSN(MAXDSN)
- INTEGER MAXDSN,FILLED,FLAG
-
- CHARACTER OUTLINE*133,INLINE*80
- INTEGER RETC,OUTLGTH
-
- FLAG = 1
- INLINE = ' LISTCAT LEVEL('//LEVEL//') NONVSAM'
- FILLED = 0
-
- 1 CALL FAFTIDC(INLINE,OUTLINE,OUTLGTH,RETC)
- IF (RETC.EQ.-9999) THEN
- FLAG = 0
- GOTO 99
- ENDIF
- IF (OUTLINE(1:8).EQ.'0NONVSAM') THEN
- FILLED = FILLED + 1
- IF (FILLED.LE.MAXDSN) THEN
- DSN(FILLED) = OUTLINE(18:OUTLGTH)
- IF (FILLED.EQ.MAXDSN) RETURN
- ENDIF
- ENDIF
- GOTO 1
-
- 99 RETURN
- END
-#endif
diff --git a/src/packlib/fatmen/programs/fatsrv/famove.F b/src/packlib/fatmen/programs/fatsrv/famove.F
deleted file mode 100644
index fc67427..0000000
--- a/src/packlib/fatmen/programs/fatsrv/famove.F
+++ /dev/null
@@ -1,45 +0,0 @@
-*
-* $Id: famove.F,v 1.1.1.1 1996/03/07 15:17:40 mclareni Exp $
-*
-* $Log: famove.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:40 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
-#if defined(CERNLIB_IBMMVS)
- SUBROUTINE FAMOVE(OLDDSN,NEWDSN,IRC)
-*CMZ : 17/05/91 14.46.08 by Jamie Shiers
-*-- Author : Jamie Shiers 17/05/91
- CHARACTER*(*) OLDDSN,NEWDSN
- CHARACTER*80 CARD
-#include "fatmen/fattyp.inc"
-
- IRC = 0
-
- LOLD = LENOCC(OLDDSN)
- LNEW = LENOCC(NEWDSN)
- OPEN(11,FILE='/'//OLDDSN(1:LOLD),STATUS='OLD',ERR=99,
- + FORM='FORMATTED',ACTION='READWRITE')
-*
-* Create new CARD file
-*
- LUNIT = LENOCC(CHMGEN(1))
- CALL FILEINF(ISTAT,'DEVICE',CHMGEN(1)(1:LUNIT),'TRK',1,
- + 'SECOND',1,'DIR',0,
- + 'RECFM','FB','LRECL',80,'BLKSIZE',9040)
- OPEN(12,FILE='/'//NEWDSN(1:LNEW),STATUS='NEW',ERR=99,
- + FORM='FORMATTED',ACTION='READWRITE')
-
-1 READ(11,'(A)',END=98) CARD
- WRITE(12,'(A)') CARD
- GOTO 1
-
-98 CLOSE(11,STATUS='DELETE')
- CLOSE(12,STATUS='KEEP')
-
- RETURN
-
-99 IRC = 1
- END
-#endif
diff --git a/src/packlib/fatmen/programs/fatsrv/fatlog.F b/src/packlib/fatmen/programs/fatsrv/fatlog.F
deleted file mode 100644
index bc368c5..0000000
--- a/src/packlib/fatmen/programs/fatsrv/fatlog.F
+++ /dev/null
@@ -1,64 +0,0 @@
-*
-* $Id: fatlog.F,v 1.1.1.1 1996/03/07 15:17:41 mclareni Exp $
-*
-* $Log: fatlog.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:41 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FATLOG(IHEAD,LHEAD,IFORM,LFORM,IRC)
-#include "fatmen/fatsys.inc"
-#include "zebra/quest.inc"
-#include "fatmen/fatbug.inc"
-#include "fatmen/slate.inc"
- DIMENSION IHEAD(LHEAD),IFORM(LFORM)
- CHARACTER*21 CHLOG
- PARAMETER (MEDIUM=0)
- PARAMETER (NWREC=900)
- PARAMETER (NBUF=0)
- PARAMETER (LUNLOG=11)
- INTEGER CHDIRF
-
- IRC = 0
-
-#if !defined(CERNLIB_IBM)
- ISTAT = CHDIRF(DEFAULT)
-*
-* Write logging record to FZ file
-*
- CALL DATIME(ID,IT)
- WRITE(CHLOG,9001) ID
- 9001 FORMAT('fatlogs/FATLOG.',I6)
-
- IF(IDEBFA.GE.1) PRINT 9002,CHLOG
- 9002 FORMAT(' FATLOG. writing log record to ',A)
-
- CALL CFOPEN(LUNPTR,MEDIUM,NWREC,'a+',NBUF,CHLOG,IRC)
- IF(IRC.NE.0) THEN
- PRINT 9003,IRC
- 9003 FORMAT(' FATLOG. cannot open log file: ',A,' irc = ',I5)
- GOTO 999
- ENDIF
- IQUEST(1) = LUNPTR
-
- CALL FZFILE(LUNLOG,NWREC,'LXO')
- IF(IQUEST(1).NE.0) THEN
- PRINT 9004,IQUEST(1)
- IRC = IQUEST(1)
- 9004 FORMAT(' FATLOG. return code ',I5,' from FZFILE')
- GOTO 999
- ENDIF
-
- CALL FZOUT(LUNLOG,0,0,1,'Z',IFORM,LHEAD,IHEAD)
- IF(IQUEST(1).NE.0) THEN
- PRINT 9005,IQUEST(1)
- IRC = IQUEST(1)
- 9005 FORMAT(' FATLOG. return code ',I5,' from FZOUT')
- GOTO 999
- ENDIF
-
- CALL FZENDO(LUNLOG,'TX')
-#endif
-
- 999 END
diff --git a/src/packlib/fatmen/programs/fatsrv/fatsrv.F b/src/packlib/fatmen/programs/fatsrv/fatsrv.F
deleted file mode 100644
index f27583b..0000000
--- a/src/packlib/fatmen/programs/fatsrv/fatsrv.F
+++ /dev/null
@@ -1,962 +0,0 @@
-*
-* $Id: fatsrv.F,v 1.4 2000/06/09 17:03:22 cernsoft Exp $
-*
-* $Log: fatsrv.F,v $
-* Revision 1.4 2000/06/09 17:03:22 cernsoft
-* CERNLIB_BIGRZDIR for large memory needed by L3
-*
-* Revision 1.3 1997/03/17 12:48:05 jamie
-* bigger store
-*
-* Revision 1.2 1996/06/21 12:16:03 jamie
-* check for bad FZ files in Unix server
-*
-* Revision 1.1.1.1 1996/03/07 15:17:40 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- PROGRAM FATSRV
-*----------------------------------------------------------------------*
-* *
-* MAIN routine for FATMEN Service routine *
-* FATSRV wakes up at regulard intervals, or upon arrival of new RDR *
-* files (VM), reads them in and updates RZ file. *
-* ORACLE/SQL database is also updated if +USE,*SQL. *
-* *
-* VM/CMS *
-* ------ *
-* Issues WAKEUP (via EXEC) to wait for new RDR files in FZ format *
-* *
-* MVS *
-* --- *
-* Read FATSYS, FATGRP, FMWAKEUP and FMLOGL from unit 5. *
-* Look for new FZ files in .todo *
-* Use PARM instead of GETENVF, e.g. *
-* *
-* // EXEC PGM=FATSRV,PARM='DESY,H1,60,3' *
-* *
-* VAX/VMS *
-* ------- *
-* New FZ files are found in <.TODO>. On wakeup, server reads in *
-* FZ files and updates RZ file. FZ files then spooled to CERNVM. *
-* If link to CERNVM is done, renames files to <.TOVM>, else *
-* to <.DONE>. (Files in <.DONE> should be purged by a CRON job). *
-* *
-* UNIX *
-* ---- *
-* As for VMS, replacing <.DONE> etc. by /done. *
-* to /done . (Files in /done should be purged by a CRON job). *
-* *
-*----------------------------------------------------------------------*
-#include "fatmen/fatsys.inc"
-#include "fatmen/fatout.inc"
-#include "fatmen/slate.inc"
-#include "fatmen/fatstat.inc"
- INTEGER SYSTEMF
- LOGICAL EXIST
- CHARACTER*8 CHWAKE
-#if defined(CERNLIB_VAXVMS)
- INTEGER STATUS
- INCLUDE '($RMSDEF)'
- INTEGER SYS$GETMSG
- PARAMETER (MINBLK=500)
-#endif
-#if defined(CERNLIB_IBMMVS)
- PARAMETER (MAXDSN=100)
- CHARACTER*44 DSN(MAXDSN),NEWDSN
- DIMENSION HDSN(14)
- CHARACTER*100 CHPARM
-#endif
- CHARACTER*80 CHLINE
- CHARACTER*255 CHDIR
- CHARACTER*512 COMAND
- CHARACTER*240 GENEN
- CHARACTER*132 LINE,FILEN,NEWF
- CHARACTER*132 TODO
- CHARACTER*255 FNAME
- CHARACTER*255 FATRZ
- CHARACTER*1 DELM
- CHARACTER*4 CHOPT
-* COMMON / / FENCDB(22), LQ(150000)
-#if defined(CERNLIB_BIGRZDIR)
- PARAMETER (LURCOR=2000000) ! As L3 have one very large directory
-#endif
-#if !defined(CERNLIB_BIGRZDIR)
- PARAMETER (LURCOR=1000000)
-#endif
-* PARAMETER (LURCOR=500000)
-* PARAMETER (LURCOR=80000)
- COMMON/CRZT/IXSTOR,IXDIV,IFENCE(2),LEV,LEVIN,BLVECT(LURCOR)
- DIMENSION LQ(999),IQ(999),Q(999)
- EQUIVALENCE (IQ(1),Q(1),LQ(9)),(LQ(1),LEV)
-*
-#include "zebra/quest.inc"
- COMMON /USRLNK/LUSRK1,LUSRBK,LUSRLS
- INTEGER FMHOST,FMUSER,FAFNDF
- CHARACTER*12 CHUSER,CHSYS,CHLOG
- COMMON/FSRVCM/ HNAME,HTYPE,HSYS
- CHARACTER*8 HNAME,HTYPE,HSYS
- CHARACTER*64 FUNAM
-#if defined(CERNLIB_IBMMVS)
- LOGICAL ITOVM,IDONE
-#endif
-#if !defined(CERNLIB_IBMMVS)
- LOGICAL ITOVM,IDONE,ITODO
-#endif
-*
-#include "fatmen/fatbug.inc"
- LUNRZ = 1
- LUFZFA = 2
-*
-*
-* Initialise ZEBRA
-*
- CALL MZEBRA(-3)
- CALL MZSTOR(IXSTOR,'/CRZT/','Q',IFENCE,LEV,BLVECT(1),BLVECT(1),
- + BLVECT(5000),BLVECT(LURCOR))
-
- CALL MZLOGL(IXSTOR,-3)
-*
-* *** Define user division and link area like:
-*
- CALL MZDIV (IXSTOR, IXDIV, 'USERS', 50000, LURCOR, 'L')
- CALL MZLINK (IXSTOR, '/USRLNK/', LUSRK1, LUSRLS, LUSRK1)
-*
-*
-* Determine if we are running on CERNVM...
-*
- IC = FMHOST(HNAME,HTYPE,HSYS)
-#if defined(CERNLIB_IBMMVS)
- CALL GOPARM(LPARM,CHPARM)
- IF(LPARM.EQ.0) THEN
- NPARMS = 0
- ELSE
- CALL FMNWRD(',',CHPARM(1:LPARM),NPARMS)
- ENDIF
- IF(NPARMS.GT.0) THEN
- CALL FMWORD(CHSYS,0,',',CHPARM(1:LPARM),IRC)
- ELSE
- PRINT *,'FATSRV. GOPARM variable FATSYS not defined. '
- PRINT *,'FATSRV. defaulted to CERN'
- CHSYS = 'CERN'
- ENDIF
-#endif
-#if defined(CERNLIB_IBMVM)
- CALL VMREXX('F','FATSYS',CHSYS,IRC)
-#endif
-#if defined(CERNLIB_UNIX)||defined(CERNLIB_VAXVMS)
- CALL GETENVF('FATSYS',CHSYS)
- LDEF = IS(1)
- IRC = 0
- IF(LDEF.EQ.0) IRC = -1
-#endif
-#if defined(CERNLIB_IBMVM)||defined(CERNLIB_VAXVMS)||defined(CERNLIB_UNIX)
- IF(IRC.NE.0) THEN
- CHSYS = 'CERN'
-#endif
-#if defined(CERNLIB_IBMVM)
- PRINT *,'FATSRV. REXX variable FATSYS not defined. '
-#endif
-#if defined(CERNLIB_VAXVMS)
- PRINT *,'FATSRV. symbol FATSYS not defined.'
-#endif
-#if defined(CERNLIB_UNIX)
- PRINT *,'FATSRV. environmental variable FATSYS not defined. '
-#endif
-#if defined(CERNLIB_IBMVM)||defined(CERNLIB_VAXVMS)||defined(CERNLIB_UNIX)
- PRINT *,'FATSRV. defaulted to CERN'
- ENDIF
-#endif
- CALL CLTOU(CHSYS)
- TOPDIR = '//'//CHSYS
-#if defined(CERNLIB_IBMVM)
-*
-* Take username from REXX variable 'FATMAN'
-* If not defined, use current username
-* This username determines the FATMEN group for whom we are working...
-*
- CALL VMREXX('F','FATMAN',CHUSER,IRC)
-#endif
-#if defined(CERNLIB_UNIX)||defined(CERNLIB_VAXVMS)
- CALL GETENVF('FATGRP',CHUSER)
- LDEF = IS(1)
- IRC = 0
- IF(LDEF.EQ.0) IRC = -1
-#endif
-#if defined(CERNLIB_IBMMVS)
- IF(NPARMS.GE.2) THEN
- CALL FMWORD(CHUSER,1,',',CHPARM(1:LPARM),IRC)
- ELSE
- PRINT *,'FATSRV. GOPARM variable FATUSER not defined. '
- IRC = -1
- ENDIF
-#endif
- IF(IRC.NE.0) THEN
- IC = FMUSER(CHUSER)
-#if defined(CERNLIB_IBMVM)
- PRINT *,'FATSRV. REXX variable FATMAN not defined. '
-#endif
-#if defined(CERNLIB_VAXVMS)
- PRINT *,'FATSRV. symbol FATGRP not defined.'
-#endif
-#if defined(CERNLIB_UNIX)
- PRINT *,'FATSRV. environmental variable FATGRP not defined. '
-#endif
- PRINT *,'Using current username'
- ENDIF
- CALL CLTOU(CHUSER)
-
- IF(CHUSER(1:2).NE.'FM') THEN
- SERNAM = 'FM' // CHUSER(1:LENOCC(CHUSER))
- ELSE
- SERNAM = CHUSER(1:LENOCC(CHUSER))
- ENDIF
- LSN = LENOCC(SERNAM)
-*
-*
-* Get directory where RZ file is kept...
-*
-#if defined(CERNLIB_UNIX)||defined(CERNLIB_VAXVMS)
- DEFAULT = ' '
- CALL GETENVF(SERNAM(1:LSN),DEFAULT)
- LDEF = IS(1)
- IF(LDEF.GT.0) THEN
- IF(IDEBFA.GE.0) PRINT *,'FATSRV. catalogue is in directory ',
- + DEFAULT(1:LDEF)
- ELSE
- PRINT *,'FATSRV. symbol/variable ',SERNAM(1:LSN),
- + ' is undefined. Using current directory'
- CALL GETWDF(DEFAULT)
- LDEF = IS(1)
- ENDIF
-#endif
-#if defined(CERNLIB_IBMMVS)
-*
-* We are abit less flexible than on other systems and
-* require a DD card for the FATMEN RZ file...
-*
- CALL VBLANK(HDSN,14)
- CALL FTINFO(LUNRZ,-1,HDSN,IRC)
- CALL UHTOC(HDSN,4,DEFAULT,LEN(DEFAULT))
- LDEF = LENOCC(DEFAULT)
- LDEF = INDEXB(DEFAULT(1:LDEF),'.') - 1
- LDEF = INDEXB(DEFAULT(1:LDEF),'.') - 1
- DEFAULT(LDEF+1:) = ' '
-#endif
-*
-* Get wakeup interval
-*
- ISLEEP = 60
-#if defined(CERNLIB_IBMMVS)
- IF(NPARMS.GE.3) THEN
- CALL FMWORD(CHWAKE,2,',',CHPARM(1:LPARM),IRC)
- ELSE
- IC = -1
- ENDIF
-#endif
-#if defined(CERNLIB_IBMVM)
- CALL VMREXX('F','FMWAKEUP',CHWAKE,IC)
- LCHW = LENOCC(CHWAKE)
-#endif
-#if defined(CERNLIB_UNIX)||defined(CERNLIB_VAXVMS)
- CALL GETENVF('FMWAKEUP',CHWAKE)
- LCHW = IS(1)
- IF(LCHW.GT.0) THEN
- IC = 0
- ELSE
- IC = -1
- ENDIF
-#endif
- IF(IC.EQ.0) THEN
- ISLEEP = ICDECI(CHWAKE,1,8)
- ENDIF
- IF(ISLEEP.EQ.0) THEN
- ISLEEP = 60
- WRITE(CHWAKE,'(I8.8)') ISLEEP
- ENDIF
-*
- PRINT *,'FATSRV. Initialising for group ',CHUSER(1:LSN)
- PRINT *,'FATSRV. wakeup interval is ',ISLEEP,' seconds'
-#if defined(CERNLIB_VAX)
- SLEEP = FLOAT(ISLEEP)
-#endif
-*
-* Set logging level
-*
-#if defined(CERNLIB_IBMVM)
- CALL VMREXX('F','FMLOGL',CHLOG,IRC)
- IF(IRC.EQ.0) ILOG = ICDECI(CHLOG,1,8)
-#endif
-#if defined(CERNLIB_UNIX)||defined(CERNLIB_VAXVMS)
- CALL GETENVF('FMLOGL',CHLOG)
- IF(IS(1).GT.0) ILOG = ICDECI(CHLOG,1,8)
-#endif
-#if defined(CERNLIB_IBMMVS)
- IF(NPARMS.GE.4) THEN
- CALL FMWORD(CHLOG,3,',',CHPARM(1:LPARM),IRC)
- IF(IRC.EQ.0) ILOG = ICDECI(CHLOG,1,8)
- ENDIF
-#endif
-*
-* Initialise FATMEN...
-*
- CALL FMLOGL(ILOG)
-*
-* Set Zebra loglevel
-*
- IZLOG = MAX(ILOG,-3)
- IZLOG = MIN(ILOG,2)
- CALL MZLOGL(IXSTOR,IZLOG)
-*
-* Force non-CSPACK access
-*
- FATNOD = ' '
-*
-* Single user mode
-*
- LTOP = LENOCC(TOPDIR)
- CHOPT = '1DL '
-#if defined(CERNLIB_UNIX)
- CHOPT = '1DLX'
-#endif
- CALL FATINI(IXSTOR,LUNRZ,LUFZFA,TOPDIR(1:LTOP),CHOPT)
- OUTPUT = 'TTY'
-*
-* Zero counters
-*
- NFMUSR = 0
- NFMNOD = 0
- NFMFIL = 0
- NFMCOM = 0
- NFMPUT = 0
- NFMMOD = 0
- NFMDEL = 0
- NFMMDR = 0
- NFMRMD = 0
- NFMOPN = 0
- NFMCLS = 0
- NFMPDK = 0
- NFMPRP = 0
- NFMPDL = 0
- NFMBAD = 0
- NFMLOG = 0
-*
-* Compare bit map of allocated records against the file itself
-*
- CALL RZVERI(TOPDIR(1:LTOP),'C')
- IF(IQUEST(2).NE.0) THEN
-*
-* Rebuild bit map
-*
- PRINT *,'FATSRV. ',IQUEST(2),
- + ' records marked as free but in use'
- PRINT *,'FATSRV. rebuilding bitmap...'
- CALL RZFREE('RZFILE')
- CALL RZVERI(TOPDIR(1:LTOP),'B')
- CALL RZLOCK('RZFILE')
- ENDIF
-*
-* Print version
-*
- CALL FMVERS
-#if (defined(CERNLIB_APOLLO))&&(defined(CERNLIB_PLONK))
- NRETRY = 0
- 10 CONTINUE
- NRETRY = NRETRY + 1
- CALL RZEND(TOPDIR(3:LTOP))
- CLOSE (LUNRZ)
-*
-* Single user mode
-*
- FATRZ = TOPDIR(3:LTOP)//'.FATRZ'
- LRECL = 0
- CALL FAOPEN('FARZ',LUNRZ,'U',FATRZ,LRECL,5000)
- IF(IFMODX.EQ.0) THEN
- CHOPT = 'UDL'
- ELSE
- CHOPT = 'UDLX'
- ENDIF
- CALL RZFILE(LUNRZ,TOPDIR(3:LTOP),CHOPT)
- IF(IQUEST(1).NE.0) THEN
- PRINT *,'FATSRV. error ',IQUEST(1),' from RZFILE'
- IF(NRETRY.LT.2) THEN
- CALL RZEND(TOPDIR(3:LTOP))
- CLOSE (LUNRZ)
- GOTO 10
- ELSE
- PRINT *,'giving up after ',NRETRY,' retries'
- STOP
- ENDIF
- ENDIF
-#endif
-#if defined(CERNLIB_SQLCOM)
-*
-* Connect to ORACLE or SQL/DS
-*
- DO 20 I=1,5
- CALL FMLOGI(IRC)
- IF(IRC.EQ.0) GOTO 30
- PRINT *,'FATSRV. cannot connect to ORACLE.',
- + ' Will sleep for 1 minute then retry'
- CALL SLEEPF(60)
- 20 CONTINUE
-*
-* Cannot connect to ORACLE after 5 attempts - shutdown
-*
- CALL RZEND(TOPDIR(3:LTOP))
- CLOSE (LUNRZ)
-#endif
-#if (defined(CERNLIB_IBMVM))&&(defined(CERNLIB_SQLCOM))
- CALL VMCMS('#CP LOGOFF',IRC)
-#endif
-#if defined(CERNLIB_SQLCOM)
- STOP
-
- 30 CONTINUE
-#endif
-#if defined(CERNLIB_UNIX)||defined(CERNLIB_VAXVMS)
-*
-* Find directory name where updates are kept
-*
- TODO = ' '
-#endif
-#if defined(CERNLIB_UNIX)
- TODO = DEFAULT(1:LDEF) // '/todo'
-#endif
-#if defined(CERNLIB_VAXVMS)
- TODO = DEFAULT(1:LDEF-1) // '.TODO]AA*.*'
-#endif
-#if defined(CERNLIB_UNIX)||defined(CERNLIB_VAXVMS)
- LTODO = LENOCC(TODO)
-#endif
-*
-* Check that TODO directory exists
-*
-#if defined(CERNLIB_UNIX)
- INQUIRE(FILE=TODO(1:LTODO),EXIST=ITODO)
- IF(.NOT.ITODO) THEN
- PRINT *,'FATSRV. directory ',TODO(1:LTODO),
- + ' does not exist. Stopping...'
- GOTO 100
- ENDIF
-#endif
-#if defined(CERNLIB_VAXVMS)
- INQUIRE(FILE=DEFAULT(1:LDEF)//'TODO.DIR',EXIST=ITODO)
- IF(.NOT.ITODO) THEN
- PRINT *,'FATSRV. directory ',TODO(1:LTODO-5),
- + ' does not exist. Stopping...'
- GOTO 100
- ENDIF
-#endif
-*
-* Do we need to copy to VM?
-*
-#if defined(CERNLIB_IBMMVS)
- INQUIRE(FILE='/'//DEFAULT(1:LDEF)//'.tovm',EXIST=ITOVM)
-#endif
-#if defined(CERNLIB_VAXVMS)
- INQUIRE(FILE=DEFAULT(1:LDEF)//'TOVM.DIR',EXIST=ITOVM)
-#endif
-#if defined(CERNLIB_UNIX)
- INQUIRE(FILE=DEFAULT(1:LDEF)//'/tovm',EXIST=ITOVM)
-#endif
- IF(ITOVM) THEN
- PRINT *,'FATSRV. tovm directory exists - ',
- + 'will attempt to send files to CERNVM.'
- ENDIF
-*
-* Check that DONE directory exists
-*
-#if defined(CERNLIB_VAXVMS)
- INQUIRE(FILE=DEFAULT(1:LDEF)//'DONE.DIR',EXIST=IDONE)
- IF(.NOT.IDONE) THEN
- CHDIR = DEFAULT(1:LDEF-1)//'.DONE'//DEFAULT(LDEF:LDEF)
- LDIR = LENOCC(CHDIR)
- IF(IDEBFA.GE.0) PRINT *,'FATSRV. creating directory ',
- + CHDIR(1:LDIR)
- IC = LIB$CREATE_DIR(CHDIR(1:LDIR))
- IF(.NOT.IC) CALL LIB$SIGNAL(%VAL(IC))
- ENDIF
-#endif
-#if defined(CERNLIB_UNIX)
- INQUIRE(FILE=DEFAULT(1:LDEF)//'/done',EXIST=IDONE)
- IF(.NOT.IDONE) THEN
- CHDIR = DEFAULT(1:LDEF)//'/done'
- LDIR = LENOCC(CHDIR)
- CALL CUTOL(CHDIR(1:LDIR))
- IF(IDEBFA.GE.0) PRINT *,'FATSRV. creating directory ',
- + CHDIR(1:LDIR)
- IC = SYSTEMF('mkdir '//CHDIR(1:LDIR))
- IF(IC.NE.0) PRINT *,'FATSRV. error creating directory'
- ENDIF
-#endif
-*
-* Infinite loop - wait for new RDR files and then try to
-* read them in with FZ
-*
- 40 CONTINUE
-#if defined(CERNLIB_IBMVM)
- CALL VMCMS('EXEC FATSERV',IC)
- IF((IC.EQ.3).OR.(IC.EQ.99)) GOTO 40
- IF(IC.NE.0) THEN
- PRINT *,'ERROR FROM VMCMS, CODE=',IC
- GOTO 100
- ENDIF
-*
-* If we get here, we should have just received a file
-* Try to read in with FZIN
-*
- CALL FMFZI(' ',GENEN,ICOUNT)
-*
-* Error opening input file
-*
- IF(IQUEST(1).NE.0) GOTO 40
- LG = LENOCC(GENEN)
-*
-* No updates found in input file (curious)
-*
- IF(ICOUNT.EQ.0) THEN
-
- IF(IDEBFA.GE.-1) WRITE(LPRTFA,9002)
-
- ELSE
-*
-* Forward updates to remote nodes
-* (we now require an entry in the names file also for CERNVM)
-*
- CALL VMCMS('EXEC FAT4WARD '//GENEN(1:LG),IRC)
-
- ENDIF
-*
-* Store journal file
-*
- CALL VMCMS('EXEC FATJOURN',IRC)
-*
-* Close and re-open RZ file so that updates are visible
-*
- CALL RZEND(TOPDIR(3:LTOP))
- CLOSE (LUNRZ)
-*
-* Single user mode
-*
- FATRZ = TOPDIR(3:LTOP)//'.FATRZ.A6'
- LRECL = 0
- CALL FAOPEN('FARZ',LUNRZ,'U',FATRZ,LRECL,5000)
- IF(IFMODX.EQ.0) THEN
- CHOPT = '1'
- ELSE
- CHOPT = '1X'
- ENDIF
- CALL RZFILE(LUNRZ,TOPDIR(3:LTOP),CHOPT)
-
- GOTO 40
-#endif
-#if defined(CERNLIB_IBMMVS)
-*
-* Look for new files in .todo
-*
- 50 CONTINUE
- CALL FALCAT(DEFAULT(1:LDEF)//'.TODO',DSN,MAXDSN,NUMDSN,IRC)
- IF((IRC.EQ.0).AND.(NUMDSN.EQ.0)) THEN
- IF(IDEBFA.GE.1) THEN
- CALL DATIME(ID,IT)
- PRINT *,'FATSRV. time is ',ID,IT,
- + ' sleeping for ',ISLEEP,' seconds'
- ENDIF
- CALL SLEEPF(ISLEEP)
- GOTO 40
- ELSE
- DO 70 I=1,NUMDSN
-*
-* Read in FZ file
-*
- LDSN = LENOCC(DSN(I))
- IF(INDEX(DSN(I)(1:LDSN),'SIGNAL.STOP').NE.0) GOTO 100
- CALL FMFZI(DSN(I)(1:LDSN),GENEN,ICOUNT)
-*
-* Error opening input file
-*
- IF(IQUEST(1).NE.0) THEN
- CALL SLEEPF(ISLEEP)
- GOTO 40
- ENDIF
-
- IF(ICOUNT.EQ.0) THEN
-
- IF(IDEBFA.GE.-1) WRITE(LPRTFA,9002)
-
- ELSE
-*
-* Queue to remote servers
-*
- ITODO = INDEX(DSN(I)(1:LDSN),'.TODO')
- NEWDSN = DSN(I)(1:LDSN)
- NEWDSN(ITODO:ITODO+4) = '.TOVM'
- 60 CONTINUE
- CALL FMFNME(FUNAM)
- NEWDSN(ITODO+5:) = '.'//FUNAM
- LNEW = LENOCC(NEWDSN)
- INQUIRE(FILE='/'//NEWDSN(1:LNEW),EXIST=EXIST)
- IF(EXIST) THEN
- CALL SLEEPF(1)
- GOTO 60
- ENDIF
- CALL FAMOVE(DSN(I)(1:LDSN),NEWDSN(1:LNEW),IC)
-
- ENDIF
-
- 70 CONTINUE
-
-*
-* Any more files to be processed?
-*
- IF(IRC.EQ.1) GOTO 50
- ENDIF
-
- GOTO 40
-#endif
-#if defined(CERNLIB_VAXVMS)
-*
-* Check disk quota
-*
- CALL FMQUOT(IUSED,IFREE,IALLO,IOVER,IRC)
-
- IF(IRC.LT.0.AND.IDEBFA.GE.0) PRINT *,'FATSRV. error obtaining ',
- + 'disk quota information'
-
- IF(IRC.EQ.0.AND.IFREE.LT.MINBLK) THEN
- IF(IDEBFA.GE.0) PRINT *,'FATSRV. triggering disk cleanup'
- IF(IDEBFA.GE.0) PRINT *,'Current usage = ',IUSED,IFREE,
- + IALLO,IOVER,' blocks used/free/allocated/overdraft'
- IRC = SYSTEMF('PURGE *.*/LOG')
- CALL FMQUOT(IUSED,IFREE,IALLO,IOVER,IRC)
- IF(IDEBFA.GE.0) PRINT *,'After cleanup = ',IUSED,IFREE,
- + IALLO,IOVER,' blocks used/free/allocated/overdraft'
-
- ENDIF
-
- IF(IDEBFA.GE.3) PRINT *,'FATSRV. looking for files in ',
- + TODO(1:LTODO)
- ICONT = 0
-
- 80 CONTINUE
-*
-* Check for signal.stop file
-*
- JCONT = 0
- STATUS = LIB$FIND_FILE(TODO(1:LTODO-5)//'SIGNAL.STOP',
- + FILEN,JCONT)
- ISTAT = LIB$FIND_FILE_END(JCONT)
- IF(STATUS.EQ.RMS$_SUC) THEN
- PRINT *,'FATSRV. signal.stop file found - stopping'
- GOTO 100
- ENDIF
-*
-* Look for new files in <.TODO>
-*
- STATUS = LIB$FIND_FILE(TODO(1:LTODO),FILEN,ICONT)
-*
-* Unexpected error
-*
- IF(STATUS.NE.RMS$_NMF.AND.STATUS.NE.RMS$_FNF.AND.
- + .NOT.STATUS) THEN
- CALL LIB$SIGNAL(%VAL(STATUS))
- ENDIF
-*
-* No more files - clear context pointer
-*
- IF(STATUS.EQ.RMS$_NMF) THEN
- IRC = LIB$FIND_FILE_END(ICONT)
- ICONT = 0
- GOTO 40
- ENDIF
-*
-* File not found - sleep
-*
- IF(STATUS.EQ.RMS$_FNF) THEN
- IRC = LIB$FIND_FILE_END(ICONT)
- ICONT = 0
- IF(IDEBFA.GE.1) THEN
- CALL DATIME(ID,IT)
- PRINT *,'FATSRV. time is ',ID,IT,
- + ' sleeping for ',ISLEEP,' seconds'
- ENDIF
- CALL LIB$WAIT(SLEEP)
- GOTO 40
- ENDIF
-
- LFILEN = INDEX(FILEN,';') -1
- IF(IDEBFA.GE.1) PRINT *,'New FZFILE found ',FILEN(1:LFILEN)
-*
-* Read in FZ file
-*
- CALL FMFZI(FILEN(1:LFILEN),GENEN,ICOUNT)
-*
-* Error opening input file
-*
- IF(IQUEST(1).NE.0) THEN
- CALL SLEEPF(ISLEEP)
- GOTO 80
- ENDIF
-
- IF(ICOUNT.EQ.0) THEN
-
- IF(IDEBFA.GE.-1) WRITE(LPRTFA,9002)
-
- ELSE
-*
-* Send to remote servers
-*
- CALL FMSSND(GENEN,FILEN(1:LFILEN),IRC)
-
- ENDIF
-*
-* Try to copy to CERNVM
-*
- IF(ITOVM.AND.ICOUNT.GT.0) THEN
- CALL FMTOVM(LUFZFA,FILEN(1:LFILEN),IRC)
- ELSE
- IRC = 0
- ENDIF
-
- IDIR = INDEX(FILEN,'.TODO')
- NEWF = FILEN
-
- IF (IRC .EQ. 0) THEN
-*
-* Send to VM successful, can rename to <.DONE>
-*
- NEWF(IDIR+1:IDIR+4) = 'DONE'
- LCOLON = INDEX(FILEN(1:LFILEN),';')
- IF(LCOLON.NE.0) LFILEN = LCOLON
- IF(IDEBFA.GE.3) PRINT *,'FATSRV. renaming ',
- + FILEN(1:LFILEN),' to ',NEWF(1:LFILEN)
- IC = LIB$RENAME_FILE(FILEN(1:LFILEN),NEWF(1:LFILEN),,,,,,,,,,)
- IF (.NOT. IC) CALL LIB$SIGNAL(%VAL(IC))
-
- ELSE
-*
-* Send to VM failed, queue to <.TOVM>
-*
- NEWF(IDIR+1:IDIR+4) = 'TOVM'
- IF(IDEBFA.GE.3) PRINT *,'FATSRV. renaming ',
- + FILEN(1:LFILEN),' to ',NEWF(1:LFILEN)
- IC = LIB$RENAME_FILE(FILEN(1:LFILEN),NEWF(1:LFILEN),,,,,,,,,,)
- IF (.NOT. IC) CALL LIB$SIGNAL(%VAL(IC))
-
- ENDIF
-*
-* Close and re-open RZ file so that updates are visible
-*
- CALL RZEND(TOPDIR(3:LTOP))
- CLOSE (LUNRZ)
-*
-* Single user mode
-*
- FATRZ = TOPDIR(3:LTOP)//'.FATRZ'
- LRECL = 0
- CALL FAOPEN('FARZ',LUNRZ,'SU',FATRZ,LRECL,5000)
- IF(IFMODX.EQ.0) THEN
- CHOPT = '1DL'
- ELSE
- CHOPT = '1DLX'
- ENDIF
- CALL RZFILE(LUNRZ,TOPDIR(3:LTOP),CHOPT)
-*
-* Any more files with current context pointer?
-*
- GOTO 80
-#endif
-#if defined(CERNLIB_UNIX)
-
-*
-* Look for new files in /todo
-*
-
- ICONT = 0
- 90 CONTINUE
- FILEN = ' '
-
- INQUIRE (FILE=TODO(1:LTODO)//'/signal.stop', EXIST=EXIST)
- IF(EXIST) THEN
- PRINT *,'FATSRV. signal.stop file found - stopping'
- GOTO 100
- ENDIF
-
- ISTAT = FAFNDF(TODO(1:LTODO),FILEN,ICONT)
-*
-* If we were processing a previous batch of files and hit
-* EOF, go look immediately if there are now some more
-*
- IF(ISTAT.EQ.1.AND.ICONT.EQ.1) GOTO 40
-*
-* EOF?
-*
- IF(ISTAT.NE.0) THEN
- IF(IDEBFA.GE.1) THEN
- CALL DATIME(ID,IT)
- PRINT *,'FATSRV. time is ',ID,IT,
- + ' sleeping for ',ISLEEP,' seconds'
- ENDIF
- CALL SLEEPF(ISLEEP)
- GOTO 40
- ENDIF
-
- ICONT = 1
-*
-* Ignore files . and ..
-*
- IF((FILEN(1:1).EQ.'.')) GOTO 90
- LFILEN = LENOCC(FILEN)
-*
-* Ignore Kumacs
-*
- IF(INDEX(FILEN(1:LFILEN),'.kumac').NE.0) GOTO 90
-
- IF(IDEBFA.GE.1) PRINT *,'FATSRV. new FZFILE found ',
- + FILEN(1:LFILEN)
-
- IF (INDEX(FILEN,'signal.stop') .NE. 0) GOTO 100
-
- IF (FILEN(1:2).EQ.'zz'.OR.FILEN(1:2).EQ.'ZZ') THEN
- IF(IDEBFA.GE.1) THEN
- CALL DATIME(ID,IT)
- PRINT *,'FATSRV. time is ',ID,IT,
- + ' sleeping for ',ISLEEP,' seconds'
- ENDIF
- CALL SLEEPF(ISLEEP)
- GOTO 40
- ENDIF
-*
-* Read in FZ file
-*
- FNAME = TODO(1:LTODO)//'/'//FILEN(1:LFILEN)
- LFNAM = LENOCC(FNAME)
-*
-* Check for bad FZ files
-*
- OPEN(LUFZFA,FILE=FNAME(1:LFNAM),STATUS='OLD',ACCESS='SEQUENTIAL',
- + FORM='FORMATTED')
-
- READ(LUFZFA,'(A)') CHLINE
-
- CLOSE(LUFZFA)
-
- IF(CHLINE(1:2).NE.'>>') THEN
- IF(IDEBFA.GE.0) WRITE(LPRTFA,7001) FNAME(1:LFNAM)
-7001 FORMAT(' FATSRV. bad FZ file: ',A, ' moving to BAD directory')
- ISTAT =
- +SYSTEMF('mv '//FNAME(1:LFNAM)//' '//DEFAULT(1:LDEF)//'/bad')
- GOTO 40
- ENDIF
-
- CALL FMFZI(FNAME(1:LFNAM),GENEN,ICOUNT)
-*
-* Error opening input file
-*
- IF(IQUEST(1).NE.0) THEN
- CALL SLEEPF(ISLEEP)
- GOTO 40
- ENDIF
-
- IF(ICOUNT.EQ.0) THEN
-
- IF(IDEBFA.GE.-1) WRITE(LPRTFA,9002)
-
- ELSE
-
-*
-* Send to remote servers
-*
- CALL FMSSND(GENEN,FNAME(1:LFNAM),IRC)
-
- ENDIF
-*
-* Try to copy to CERNVM
-*
- IF(ITOVM.AND.ICOUNT.GT.0) THEN
- CALL FMTOVM(LUFZFA,FNAME(1:LFNAM),IRC)
- ELSE
- IRC = 0
- ENDIF
-
- IDIR = INDEX(TODO,'/todo')
- NEWF = FNAME
- LNEWF = LFNAM
-
- IF (IRC .EQ. 0) THEN
-*
-* Send to VM successful, can rename to /done
-*
- NEWF(IDIR+1:IDIR+4) = 'done'
- COMAND = 'mv ' //FNAME(1:LFNAM)// ' ' //NEWF(1:LNEWF)
- LCOM = LENOCC(COMAND)
- ISTAT = SYSTEMF(COMAND(1:LCOM))
- PRINT *,'FATSRV. executing ',COMAND(1:LCOM)
-
- ELSE
-*
-* Send to VM failed, queue to /tovm
-*
- NEWF(IDIR+1:IDIR+4) = 'tovm'
- COMAND = 'mv ' //FNAME(1:LFNAM)// ' ' //NEWF(1:LNEWF)
- LCOM = LENOCC(COMAND)
- ISTAT = SYSTEMF(COMAND(1:LCOM))
- IF(IDEBFA.GE.3) PRINT *,'FATSRV. executing ',COMAND(1:LCOM)
-
- ENDIF
-*
-* Close and re-open RZ file so that updates are visible
-*
- CALL RZEND(TOPDIR(3:LTOP))
- CLOSE (LUNRZ)
-*
-* Single user mode, exchange mode catalogue
-*
- FATRZ = TOPDIR(3:LTOP)//'.FATRZ'
- LRECL = 0
- CALL FAOPEN('FARZ',LUNRZ,'UX',FATRZ,LRECL,5000)
- CHOPT = '1DLX'
- CALL RZFILE(LUNRZ,TOPDIR(3:LTOP),CHOPT)
- IF(IQUEST(1).NE.0) THEN
- PRINT *,'FATSRV. return code ',IQUEST(1),' from RZFILE'
- GOTO 100
- ENDIF
-
- GOTO 90
-#endif
-
- 100 CALL RZEND(TOPDIR(3:LTOP))
- CLOSE (LUNRZ)
-*
-* Print termination statistics
-*
- IF(IDEBFA.GE.0) THEN
- WRITE(LPRTFA,9001) NFMUSR,NFMNOD,NFMFIL,NFMCOM
- +,NFMPUT,NFMMOD,NFMDEL,NFMMDR,NFMRMD,NFMOPN,NFMCLS
- +,NFMPDK,NFMPRP,NFMPDL,NFMBAD,NFMLOG
-
- 9001 FORMAT(' FATSRV. termination statistics: ',/,
- + ' Number of different users = ',I6,' (not yet counted) ',/,
- + ' Number of different nodes = ',I6,' (not yet counted) ',/,
- + ' Number of files = ',I6,/,
- + ' Number of commands = ',I6,/,
- + ' Number of PUTs = ',I6,/,
- + ' Number of MODs = ',I6,/,
- + ' Number of DELs = ',I6,/,
- + ' Number of MKDIRs = ',I6,/,
- + ' Number of RMDIRs = ',I6,/,
- + ' Number of OPENs = ',I6,/,
- + ' Number of CLOSEs = ',I6,' (not yet counted) ',/,
- + ' Number of RZDELK warnings = ',I6,/,
- + ' Number of REP failures = ',I6,' (no such entry) ',/,
- + ' Number of DEL failures = ',I6,' (no such entry) ',/,
- + ' Number of BAD commands = ',I6,' (unrecognised) ',/,
- + ' Number of LOG commands = ',I6)
- ENDIF
-
- 9002 FORMAT(' FATSRV. no updates found in journal file - will not',
- + ' be sent to remote nodes.')
-
- END
diff --git a/src/packlib/fatmen/programs/fatsrv/fmallk.F b/src/packlib/fatmen/programs/fatsrv/fmallk.F
deleted file mode 100644
index d165674..0000000
--- a/src/packlib/fatmen/programs/fatsrv/fmallk.F
+++ /dev/null
@@ -1,45 +0,0 @@
-*
-* $Id: fmallk.F,v 1.1.1.1 1996/03/07 15:17:40 mclareni Exp $
-*
-* $Log: fmallk.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:40 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMALLK(NEWKEY,IRC)
-#include "zebra/rzcl.inc"
-#include "zebra/rzk.inc"
- IRC = 0
- NKEYS = 0
- NEWKEY = -1
- JMAX = 0
- IF(LQRS.EQ.0)GO TO 99
- IF(LCDIR.EQ.0)GO TO 99
- LS = IQ(KQSP+LCDIR+KLS)
- LK = IQ(KQSP+LCDIR+KLK)
- NK = IQ(KQSP+LCDIR+KNKEYS)
- NWK= IQ(KQSP+LCDIR+KNWKEY)
-*
-* Is this loop necessary with RZOUT option R?
-* New keys are always appended to the list,
-* so the last key should have the highest value.
-*
-* keys block is nwk+1 long - word 1 is pointer to cycles block
-*
-* IF(NK.GT.0) THEN
-* K=LK+(NWK+1)*(NK-1) + 1
-* NEWKEY = IQ(KQSP+LCDIR+K) + 1
-* ELSE
-* NEWKEY = 1
-* ENDIF
-
- DO 20 I=1,NK
- K=LK+(NWK+1)*(I-1) + 1
- IF(IQ(KQSP+LCDIR+K).GT.JMAX) JMAX = IQ(KQSP+LCDIR+K)
- 20 CONTINUE
- NEWKEY = JMAX + 1
- RETURN
-*
- 99 IRC = -1
- END
diff --git a/src/packlib/fatmen/programs/fatsrv/fmfzi.F b/src/packlib/fatmen/programs/fatsrv/fmfzi.F
deleted file mode 100644
index bb44c4b..0000000
--- a/src/packlib/fatmen/programs/fatsrv/fmfzi.F
+++ /dev/null
@@ -1,681 +0,0 @@
-*
-* $Id: fmfzi.F,v 1.1.1.1 1996/03/07 15:17:40 mclareni Exp $
-*
-* $Log: fmfzi.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:40 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMFZI(FILEN,GENEN,ICOUNT)
-#include "fatmen/fatbank.inc"
-#include "fatmen/fatpara.inc"
-#include "fatmen/fatsys.inc"
-#include "fatmen/fausto.inc"
-#include "fatmen/fatstat.inc"
- CHARACTER*(*) FILEN
- COMMON/FSRVCM/ HNAME,HTYPE,HSYS
- CHARACTER*8 HNAME,HTYPE,HSYS
- CHARACTER*80 FILEDEF,LABELDEF,SETUP
- CHARACTER*4 COMAND
- CHARACTER*240 GENEN
- CHARACTER*20 FNAME
- CHARACTER*255 CHDSN
- CHARACTER*8 CHHST
- CHARACTER*8 CHVSN,CHVID
- CHARACTER*1 CHOPT
- CHARACTER*8 DELTIM
- CHARACTER*8 CHUSER,CHNODE
- CHARACTER*80 CHLINE
- CHARACTER*20 CHFSYS,CHFGRP
- PARAMETER (MHEAD=400)
- INTEGER*4 IUHEAD(MHEAD)
-#include "fatmen/fmaxcop.inc"
-#include "fatmen/fatout.inc"
- PARAMETER (LKEYFA=10)
- CHARACTER*8 CHTAG(LKEYFA)
- CHARACTER*10 CHFOR
- DIMENSION KEYS(LKEYFA),KEYZ(LKEYFA)
- DIMENSION KEYSOU(LKEYFA,MAXCOP),KEYSIN(LKEYFA)
- DIMENSION IFORM(10)
- DATA CHTAG/'Num.Id.',5*'Fname'
- + ,'cp.level','medium','loc.code','nm.banks'/
- DATA CHFOR/'IHHHHHIIII'/
- OUTPUT = 'TTY'
- LOUT = 3
- LWRITE = LPRTFA
- LMONIT = LPRTFA
-*
-* Count number of files
-*
- NFMFIL = NFMFIL + 1
-#if defined(CERNLIB_IBMVM)
-*
-* Try to read FZ file just received in RDR
-*
- WRITE(FILEDEF,9001) LUFZFA
- 9001 FORMAT('FILEDEF ',I3,' DISK FATMEN RDRFILE')
- CALL VMCMS(FILEDEF,IC)
-
- IF (IC .NE. 0) THEN
- PRINT *,'FMFZI. return code ',IC,' from VMCMS'
- STOP
- ENDIF
-*
-* Get user and node name of update
-*
- CALL VMCMS('GLOBALV SELECT *EXEC STACK FATADDR',IC)
- CALL VMRTRM(CHLINE,IEND)
- ISTART = ICFNBL(CHLINE,1,IEND)
- CALL FMWORD(CHUSER,0,' ',CHLINE(ISTART:IEND),IC)
- CALL FMWORD(CHNODE,1,' ',CHLINE(ISTART:IEND),IC)
-#endif
- CALL FZFILE(LUFZFA,0,'AI')
- CALL FZLOGL(LUFZFA,-2)
-#if defined(CERNLIB_IBMVM)
- OPEN(LUFZFA,STATUS='OLD',ERR=180)
-#endif
-#if !defined(CERNLIB_IBM)
- LENF = LENOCC(FILEN)
- OPEN(LUFZFA,STATUS='OLD',ERR=180,FILE=FILEN(1:LENF), FORM=
- +'FORMATTED')
- IF(IDEBFA.GE.0) PRINT *,'FMFZI. processing ',FILEN(1:LENF)
-#endif
-#if defined(CERNLIB_UNIX)
- LSTA = INDEXB(FILEN(1:LENF),'/') + 1
-#endif
-#if defined(CERNLIB_VAXVMS)
- LSTA = INDEXB(FILEN(1:LENF),']') + 1
-#endif
-#if !defined(CERNLIB_IBM)
-*
-* Old or new style journal file name?
-*
- LDOT = INDEX(FILEN(LSTA:LENF),'.') + LSTA - 1
- LUSC = INDEX(FILEN(LSTA:LDOT-1),'_')
- IF(LUSC.GT.0) THEN
- LUSC = LUSC + LSTA - 1
- CHUSER = FILEN(LSTA:LUSC-1)
- CHNODE = FILEN(LUSC+1:LDOT-1)
- ISTYLE = 0
- ELSE
- LUSC = INDEX(FILEN(LSTA:LENF),'_') + LSTA - 1
- CHUSER = FILEN(LDOT+1:LUSC-1)
- CHNODE = FILEN(LUSC+1:LENF)
- ISTYLE = 1
- ENDIF
-#endif
-#if defined(CERNLIB_IBMMVS)
- LENF = LENOCC(FILEN)
- OPEN(LUFZFA,STATUS='OLD',ERR=180,FILE='/'//FILEN(1:LENF), FORM=
- +'FORMATTED')
- LDOT = INDEX(FILEN(1:LENF),'.TODO.') + 5
- JDOT = INDEX(FILEN(LDOT+1:LENF),'.') + LDOT
- KDOT = INDEX(FILEN(JDOT+1:LENF),'.') + JDOT
- CHUSER = FILEN(LDOT+1:JDOT-1)
- CHNODE = FILEN(JDOT+1:KDOT-1)
-#endif
-*
-* Loop on FZ file - may contain multiple updates
-*
- IEOR = 0
- ICOUNT = 0
- 10 CONTINUE
- LHEAD = MHEAD
- CHOPT = ' '
- CALL FZIN(LUFZFA,IDIVFA,LNEWFA,2,CHOPT,LHEAD,IUHEAD)
-*
-* Have we seen an end of run record?
-*
- IF(IQUEST(1).EQ.2) IEOR = 1
- IF(IQUEST(1).GE.5) GOTO 160
- IF(IQUEST(1).NE.0) GOTO 10
-*
-* Start timer
-*
- CALL FMRTIM(DELTIM)
- CALL TIMED(T)
-*
-* Count commands
-*
- NFMCOM = NFMCOM + 1
- ICOUNT = ICOUNT + 1
-
- KEYOLD = 0
-*
-* Decode IUHEAD
-*
- CALL UHTOC(IUHEAD(1),4,COMAND,4)
-
- CALL DATIME(ID,IT)
-
- IF(IDEBFA.GE.-1) THEN
- WRITE (LPRTFA,9002) ID,IT
- 9002 FORMAT(1X,'===============================================',
- + 1X,I6,1X,I6,1X,
- + '===============================================')
- IF(COMAND.EQ.'LOG') THEN
- WRITE (LPRTFA,9003) COMAND,ICOUNT,NFMCOM
- 9003 FORMAT(' FMFZI. ',A,' (update # ',I6,' total ',I6,')')
-*
-* Unpack hollerith
-*
- CALL UHTOC(IUHEAD(KFMSYS),4,CHFSYS,20)
- CALL UHTOC(IUHEAD(KFMGRP),4,CHFGRP,20)
- GENEN = '//'//CHFSYS(1:LENOCC(CHFSYS))//'/'//
- + CHFGRP(1:LENOCC(CHFGRP))//'/FATLOG'
-
- ELSE
- CALL UHTOC(IUHEAD(2),4,GENEN,240)
- WRITE (LPRTFA,9004) COMAND,GENEN(1:LENOCC(GENEN)),ICOUNT,NFMCOM
- 9004 FORMAT(' FMFZI. ',A,1X,A,' (update # ',I6,' total ',I6,' )')
- ENDIF
- ENDIF
- IF(IDEBFA.GE.0) WRITE (LPRTFA,*) 'FMFZI. ',CHUSER,' @ ',CHNODE
-
- IF(COMAND.NE.'LOG') THEN
- CALL UCOPY(IUHEAD(71),KEYS(1),10)
-*
-* Monitoring information
-*
- IF(LHEAD.GT.80) THEN
- CHDSN = ' '
- WRITE(LMONIT,9005) IUHEAD(81),IUHEAD(82)
- CALL UHTOC(IUHEAD(91),4,CHDSN,255)
- WRITE(LMONIT,9006) CHDSN(1:LENOCC(CHDSN))
- NFMOPN = NFMOPN + 1
- ENDIF
- 9005 FORMAT(' IHOWFA: ',Z8,' ITIMFA: ',I6)
- 9006 FORMAT(' CHFNFA: ',A)
-*
-* Ensure the keys correctly reflect dataset name
-* (Problems with FZ files spooled from VAX)
-*
-* *** Find file name
-*
- NCH = LENOCC(GENEN)
- ICH = INDEXB(GENEN(1:NCH),'/')
- FNAME = GENEN(ICH+1:NCH)
- CALL VBLANK(KEYS(2),5)
- CALL UCTOH(FNAME,KEYS(2),4,MIN(NCH-ICH,20))
-*
-* Update keys vector from bank...
-*
- IF(INDEX(COMAND(2:4),'DIR').EQ.0) THEN
- KEYS(MKCLFA) = IQ(LNEWFA+MCPLFA+KOFUFA)
- KEYS(MKLCFA) = IQ(LNEWFA+MLOCFA+KOFUFA)
- KEYS(MKMTFA) = IQ(LNEWFA+MMTPFA+KOFUFA)
- IF(IDEBFA.GE.-1) CALL FMPKEY(KEYS,LKEYFA)
-*
-* Display dsn & host (disk files), vsn & vid (tape files)
-*
- IF(LHEAD.GT.80.AND.IDEBFA.GE.0) THEN
- IF(KEYS(MKMTFA).EQ.1) THEN
- CHDSN = ' '
- CALL UHTOC(IQ(LNEWFA+MFQNFA+KOFUFA),4,CHDSN,NFQNFA)
- CALL UHTOC(IQ(LNEWFA+MHSNFA+KOFUFA),4,CHHST,NHSNFA)
- LDSN = LENOCC(CHDSN)
- LHST = LENOCC(CHHST)
- WRITE(LMONIT,9007) CHDSN(1:LDSN),CHHST(1:LHST)
- 9007 FORMAT(' FMFZI. dsn = ',A,' host = ',A)
- ELSE
- CALL UHTOC(IQ(LNEWFA+MVSNFA+KOFUFA),4,CHVSN,NVSNFA)
- CALL UHTOC(IQ(LNEWFA+MVIDFA+KOFUFA),4,CHVID,NVIDFA)
- WRITE(LMONIT,9008) CHVSN,CHVID,IQ(LNEWFA+MFSQFA+KOFUFA)
- 9008 FORMAT(' FMFZI. vsn = ',A,' vid = ',A,' fseq = ',I6)
- ENDIF
- ENDIF
- ENDIF
-*
-* Display bank (for debug...)
-*
- IF((IDEBFA.GE.3).AND.
- + (INDEX(COMAND(2:4),'DIR').EQ.0)) THEN
- PRINT *,'FMFZI. new bank...'
- CALL FMSHOW(GENEN(1:NCH),LNEWFA,KEYS,'A',IC)
- ENDIF
-
- ENDIF
-*
-* Get unit for RZ file
-*
- LSAVFA = LTOPFA
- LUNRZ = IQ(LSAVFA+KOFUFA+MLUNFA)
-*
-* Now process command
-*
- IF (COMAND .EQ. 'MDIR') THEN
- CALL FATMDI(GENEN,LKEYFA,CHFOR,CHTAG)
- NFMMDR = NFMMDR + 1
-
- ELSEIF(COMAND(1:3) .EQ. 'DEL') THEN
- NFMDEL = NFMDEL + 1
- LEND = INDEXB(GENEN,'/') - 1
- CALL RZCDIR (GENEN(1:LEND), ' ')
- IF(IQUEST(1).NE.0) THEN
- WRITE(LPRTFA,*) 'FMFZI. cannot set directory to ',
- + GENEN(1:LEND)
- GOTO 10
- ENDIF
-*
-* Find KEYS(1) from RZ file by matching this bank against all
-* candidates in this directory.
-* A candidate matches when -
-* Disk files: hostname & file-id match.
-* Tape files: vsn, vid and file-seq match.
-*
-*
- IDEL = 0
- KEYS(1) = 0
-*
-* Update keys vector from bank...
-*
- KEYS(MKCLFA) = IQ(LNEWFA+MCPLFA+KOFUFA)
- KEYS(MKLCFA) = IQ(LNEWFA+MLOCFA+KOFUFA)
- KEYS(MKMTFA) = IQ(LNEWFA+MMTPFA+KOFUFA)
- CALL UCOPY(KEYS,KEYSIN,10)
- CALL FMSELK(GENEN,KEYSIN,KEYSOU,NMATCH,MAXCOP,IRC)
-
- IF(IDEBFA.GE.1) PRINT *,'FMFZI. found ',NMATCH,' matches'
-*
-* For each candidate, compare bank contents
-*
- DO 20 I=1,NMATCH
- LOLDFA = 0
- IF(IDEBFA.GE.0) THEN
- PRINT *,'FMFZI. candidate # ',I
- CALL FMPKEY(KEYSOU(1,I),LKEYFA)
- ENDIF
- CALL FMCOMP(GENEN,LNEWFA,KEYS,GENEN,LOLDFA,KEYSOU(1,I),IRC)
- CALL MZDROP(IDIVFA,LOLDFA,'L')
- LOLDFA = 0
- IF(IRC.EQ.0) THEN
- CALL UCOPY(KEYSOU(1,I),KEYS(1),10)
-*
-* Stop search
-*
- IDEL = 1
- GOTO 30
- ELSE
- IF(IDEBFA.GE.1) PRINT *,'FMFZI. comparison with ',
- + 'candidate # ',I,' failed with RC = ',IRC
- ENDIF
-
- 20 CONTINUE
- 30 CONTINUE
-
- IF(IDEL.EQ.0) THEN
-*
-* No match found
-*
- IF(IDEBFA.GE.-3) THEN
- PRINT *,'FMFZI. no match found for following entry - ',
- + 'last return code from FMCOMP was ',IRC
- CALL FMPKEY(KEYS,LKEYFA)
- NFMPDL = NFMPDL + 1
- ENDIF
- ELSE
-
- ICYCLE = 9999
- IF(IDEBFA.GE.1) PRINT *,'FMFZI. deleting following entry'
- CALL FMPKEY(KEYS,LKEYFA)
- CALL RZDELK(KEYS,ICYCLE,'C')
- IF(IQUEST(2).NE.0) THEN
- IF(IDEBFA.GE.-3)
- + PRINT *,'FMFZI. warning from RZDELK - cycles '//
- + 'structure contains previously deleted objects'
- NFMPDK = NFMPDK + 1
- CALL RZFREE('RZFILE')
- LTOP = LENOCC(TOPDIR)
- CALL RZVERI(TOPDIR(1:LTOP),'B')
- CALL RZLOCK('RZFILE')
- ENDIF
-
-#if defined(CERNLIB_SQLCOM)
- MODE =-1
- CALL FMZTOR(GENEN,LNEWFA+KOFUFA,MODE,IRC)
- PRINT *,'FMFZI. Return code ',IRC,' from ORACLE/SQL'
-*
-* Attempt reconnect in case ORACLE has died
-*
- IF((IRC.EQ.-6065).OR.(IRC.EQ.-3114)) THEN
- PRINT *,'FMFZI. attempting reconnect to ORACLE'
- CALL FMLOGI(IRC)
- CALL FMZTOR(GENEN,LNEWFA+KOFUFA,MODE,IRC)
- PRINT *,'FMFZI. Return code ',IRC,' from ORACLE/SQL'
- ENDIF
-
- IF (IRC .NE. 0) THEN
- CALL DZSHOW('FMFZI.',IDIVFA,LADDR,'L',0,0,0,0)
- ENDIF
-* ENDIF
-#endif
-
- ENDIF
-
- CALL MZDROP(IDIVFA,LNEWFA,'L')
- LNEWFA = 0
-
- ELSEIF(COMAND(1:4) .EQ. 'DDIR') THEN
- NFMRMD = NFMRMD + 1
-*
-* Delete this directory tree
-*
- CALL RZCDIR(GENEN(1:ICH-1), ' ')
- IF(IQUEST(1).NE.0) THEN
- PRINT *,'FMFZI. cannot set directory to ',GENEN(1:ICH-1)
- GOTO 10
- ENDIF
- CALL RZDELT(FNAME(1:NCH-ICH))
-
- ELSEIF((COMAND(1:3) .EQ. 'PUT') .OR. (COMAND(1:3) .EQ. 'MOD')
- + .OR. (COMAND(1:3) .EQ. 'REP')) THEN
-*
-* Counters
-*
- IF(COMAND(1:3).EQ.'PUT') NFMPUT = NFMPUT + 1
- IF(COMAND(1:3).EQ.'MOD') NFMMOD = NFMMOD + 1
- IF(COMAND(1:3).EQ.'REP') NFMMOD = NFMMOD + 1
-*
-*
-* Check if new directories have to be made
-*
- LEND = INDEXB(GENEN,'/') - 1
- CALL RZCDIR (GENEN(1:LEND), ' ')
- IF (IQUEST(1).NE.0)THEN
- CALL FATMDI(GENEN(1:LEND),LKEYFA,CHFOR,CHTAG)
- ELSE
-*
-* Check that file does not already exist. A match is true if
-* Disk files: hostname & file-id match.
-* Tape files: vsn, vid and file-seq match.
-*
-*
- CALL UCOPY(KEYS,KEYSIN,10)
-*
-* Don't compare copy level or location code
-*
- KEYSIN(MKCLFA) = -1
- KEYSIN(MKLCFA) = -1
- CALL FMSELK(GENEN,KEYSIN,KEYSOU,NMATCH,MAXCOP,IRC)
-
- IF(IDEBFA.GE.1) PRINT *,'FMFZI. found ',NMATCH,' matches'
-
- DO 70 IKEY=1,NMATCH
- IF(IDEBFA.GE.3) THEN
- PRINT *,'FMFZI. checking against following entry'
- + ,' from catalogue'
- CALL FMPKEY(KEYSOU(1,IKEY),LKEYFA)
- ENDIF
-*
-* KEYSOU contains the key vectors of any files in the CWD
-* which match the new key vector KEYS
-*
-* Read in next bank (must put in link area)
-*
- ICYCLE = 9999
- JBIAS = 2
- CALL RZIN(IDIVFA,LOLDFA,JBIAS,KEYSOU(1,IKEY),ICYCLE,' ')
- IF(IQUEST(1).NE.0) PRINT *,'FMFZI. Error ',IQUEST(1),
- + ' from RZIN'
-
- IF(IDEBFA.GE.3) THEN
- PRINT *,'FMFZI - bank from catalogue'
- CALL FMSHOW(GENEN(1:NCH),LOLDFA,KEYS,'A',IC)
- ENDIF
-
-*
-* Match fields against current bank, depending on media type
-*
- IF(KEYS(MKMTFA) .EQ. 1) THEN
-*
-* Disk data set, match MFQNFA, MHSNFA
-*
- DO 40 IOFF=MFQNFA+KOFUFA,MCPLFA+KOFUFA-1
- IF(IQ(LNEWFA+IOFF).NE.IQ(LOLDFA+IOFF)) THEN
- PRINT 9009,IKEY,IOFF-KOFUFA, IQ(LOLDFA+IOFF),
- + IQ(LNEWFA+IOFF)
- 9009 FORMAT(' FMFZI. Comparison with # ',I3,' failed at ',I5,1X,
- + A4,1X,A4,' (old/new)')
- GOTO 60
- ENDIF
- 40 CONTINUE
-
- ELSE
-*
-* Tape data set, match MVSNFA, MVIDFA, MFSQFA
-*
- DO 50 IOFF=MVSNFA+KOFUFA,MVIPFA+KOFUFA-1
- IF(IQ(LNEWFA+IOFF).NE.IQ(LOLDFA+IOFF)) THEN
- IF(IDEBFA.GE.1) PRINT 9009,IKEY,IOFF-KOFUFA,
- + IQ(LOLDFA+IOFF),IQ(LNEWFA+IOFF)
- GOTO 60
- ENDIF
- 50 CONTINUE
- IF(IQ(LNEWFA+MFSQFA+KOFUFA).NE. IQ(LOLDFA+MFSQFA+
- + KOFUFA)) THEN
- IF(IDEBFA.GE.1) PRINT 9010,IKEY,IOFF-KOFUFA,
- + IQ(LOLDFA+IOFF),IQ(LNEWFA+IOFF)
- 9010 FORMAT(' FMFZI. Comparison with # ',I3,' failed at ',I5,I4,1X,I4)
- GOTO 60
- ENDIF
-
- ENDIF
-*
-* Found a matching bank
-*
- IF(IDEBFA.GE.1)
- + PRINT *,'FMFZI. match succeeded against candidate # ',
- + IKEY
- GOTO 80
-
- 60 CONTINUE
-*
-* Finished with this bank, drop it
-*
- CALL MZDROP(IDIVFA,LOLDFA,'L')
- LOLDFA = 0
- 70 CONTINUE
- GOTO 120
-*
-* Get here if we have found a matching bank
-*
- 80 CONTINUE
- IF(COMAND(1:3) .EQ. 'PUT') THEN
- IF(IDEBFA.GE.0) PRINT *,
- + 'FMFZI. Error - file already exists, will not be added'
- CALL MZDROP(IDIVFA,LOLDFA,'L')
- LOLDFA = 0
- GOTO 140
- ELSE
- IF(IDEBFA.GE.0) PRINT *,
- + 'FMFZI. File already exists, will be replaced'
-*
-* Drop bank from catalogue
-*
- CALL MZDROP(IDIVFA,LOLDFA,'L')
- LOLDFA = 0
- ICYCLE = 9999
-*
-* Check if keys match...
-*
- IREP = 0
- DO 90 I=2,LKEYFA
- IF(KEYSOU(I,IKEY).NE.KEYS(I)) THEN
- IREP = 1
- GOTO 100
- ENDIF
-* IF(KEYSOU(I,IKEY).NE.KEYS(I)) GOTO 100
- 90 CONTINUE
- 100 CONTINUE
-*
-* Update using RZOUT option R
-*
- CALL RZOUT (IDIVFA, LNEWFA, KEYSOU(1,IKEY), ICYCLE, 'LR')
-*
-* Replace key vector in place if it is different
-*
- IF(IREP.NE.0) THEN
- KEYS(1) = KEYSOU(1,IKEY)
- CALL FMRKEY(KEYSOU(1,IKEY),KEYS,IRC)
- ENDIF
- CALL MZDROP(IDIVFA,LOLDFA,'L')
- GOTO 140
-
- 110 CONTINUE
- PRINT *,'Deleting entry with following key vector...'
- CALL FMPKEY(KEYSOU(1,IKEY),LKEYFA)
- CALL RZDELK(KEYSOU(1,IKEY),ICYCLE,'C')
- IF(IQUEST(2).NE.0) THEN
- NFMPDK = NFMPDK + 1
- PRINT *,'FMFZI. warning from RZDELK - cycles '//
- + 'structure contains previously deleted objects'
- CALL RZFREE('RZFILE')
- LTOP = LENOCC(TOPDIR)
- CALL RZVERI(TOPDIR(1:LTOP),'B')
- CALL RZLOCK('RZFILE')
- ENDIF
- KEYOLD = KEYSOU(1,IKEY)
-
- ENDIF
- GOTO 130
-*
-* Get here if there is no matching bank
-*
- 120 CONTINUE
-
- IF(COMAND(1:3) .EQ. 'REP') THEN
- PRINT *,
- + 'FMFZI. Error - replace operation for non-existant bank'
- NFMPRP = NFMPRP + 1
- CALL MZDROP(IDIVFA,LNEWFA,'L')
- LNEWFA = 0
- GOTO 150
- ENDIF
-
- ENDIF
-
- 130 CONTINUE
- LEND = INDEXB(GENEN,'/') - 1
- CALL RZCDIR (GENEN(1:LEND), ' ')
-* NKEYFA = IQUEST(7)
-* KEYS(1) = NKEYFA + 1
- IF(KEYOLD.NE.0) THEN
- IF(IDEBFA.GE.3)
- + PRINT *,'FMFZI. reusing key # ',KEYOLD
- KEYS(1) = KEYOLD
- ELSE
- CALL FMALLK(KEYS(1),IRC)
- IF(IDEBFA.GE.3)
- + PRINT *,'FMFZI. allocated new key # ',KEYS(1)
- ENDIF
-*
-* Write new bank to RZ file
-*
- IF(IDEBFA.GE.3) THEN
- PRINT *,'FMFZI. adding new entry with following KEYS'
- CALL FMPKEY(KEYS,LKEYFA)
- ENDIF
-
-* (can eventually use option Q for speed)
- CALL RZOUT (IDIVFA, LNEWFA, KEYS, ICYCLE, 'L')
- IF(IDEBFA.GE.3) PRINT *,'FMFZI. new entry has cycle # ',
- + ICYCLE
- 140 CONTINUE
-*
-* Delete previous cycle
-*
-* IF(KEYOLD.NE.0) THEN
-* CALL RZDELK(KEYS,ICYCLE-1,' ')
-* ENDIF
-#if defined(CERNLIB_SQLCOM)
- MODE = 0
- IF(COMAND(1:3) .EQ. 'REP') MODE = 1
- CALL FMZTOR(GENEN,LNEWFA+KOFUFA,MODE,IRC)
- PRINT *,'FMFZI. Return code ',IRC,' from ORACLE/SQL'
-*
-* Attempt reconnect in case ORACLE has died
-*
- IF((IRC.EQ.-6065).OR.(IRC.EQ.-3114)) THEN
- PRINT *,'FMFZI. attempting reconnect to ORACLE'
- CALL FMLOGI(IRC)
- CALL FMZTOR(GENEN,LNEWFA+KOFUFA,MODE,IRC)
- PRINT *,'FMFZI. Return code ',IRC,' from ORACLE/SQL'
- ENDIF
-
- IF (IRC .NE. 0) THEN
- CALL DZSHOW('FMFZI.',IDIVFA,LNEWFA,'L',0,0,0,0)
- ENDIF
-* ENDIF
-#endif
- CALL MZDROP(IDIVFA,LNEWFA,'L')
- LNEWFA = 0
- ELSEIF(COMAND.EQ.'LOG') THEN
-*
-* Logging record
-*
- NFMLOG = NFMLOG + 1
- IF(IDEBFA.GE.3) CALL FMPLOG(LPRTFA,IUHEAD,LHEAD,IRC)
-#if defined(CERNLIB_FATLOG)
- LFORM = IQUEST(20)
- CALL UCOPY(IQUEST(21),IFORM,LFORM)
- CALL FATLOG(IUHEAD,LHEAD,IFORM,LFORM,IRC)
-#endif
- ELSE
-*
-* Unrecognised command
-*
- NFMBAD = NFMBAD + 1
- WRITE(LPRTFA,9011) COMAND
- 9011 FORMAT(' FMFZI. !!! unrecognised command !!! ',A)
- ENDIF
-
- CALL FMRTIM(DELTIM)
- CALL TIMED(T)
- PRINT *,'FMFZI. Elapsed time = ',
- + DELTIM,' CP time = ',T,' sec.'
-
- GOTO 10
-
- 150 CONTINUE
- CALL FMRTIM(DELTIM)
- CALL TIMED(T)
- PRINT *,'FMFZI. Elapsed time = ',
- + DELTIM,' CP time = ',T,' sec.'
- 160 CONTINUE
- CLOSE (LUFZFA)
- CALL RZSAVE
-#if !defined(CERNLIB_IBMVM)
-*
-* Did we see a ZEBRA end of run?
-*
- IF(IEOR+ISTYLE.EQ.0) GOTO 170
-#endif
-
-* CALL FMSAVE(LUNRZ)
- CALL FZENDI(LUFZFA,'T')
- IQUEST(1) = 0
- RETURN
-
-#if !defined(CERNLIB_IBMVM)
- 170 CONTINUE
- WRITE(LPRTFA,*) 'FMFZI. ZEBRA e-o-r not found on unit ',LUFZFA
- CALL FZENDI(LUFZFA,'T')
- IQUEST(1) = 2
- RETURN
-
-#endif
- 180 CONTINUE
- WRITE(LPRTFA,*) 'FMFZI. Error opening input file on unit ',LUFZFA
- CALL FZENDI(LUFZFA,'T')
- IQUEST(1) = 1
- RETURN
-
- 190 CONTINUE
- WRITE(LPRTFA,*) 'FMFZI. fast exit on warning from RZDELK'
- CALL FZENDI(LUFZFA,'T')
- IQUEST(1) = 2
- RETURN
-*
- END
-
diff --git a/src/packlib/fatmen/programs/fatsrv/fmssnd.F b/src/packlib/fatmen/programs/fatsrv/fmssnd.F
deleted file mode 100644
index a90e34f..0000000
--- a/src/packlib/fatmen/programs/fatsrv/fmssnd.F
+++ /dev/null
@@ -1,259 +0,0 @@
-*
-* $Id: fmssnd.F,v 1.1.1.1 1996/03/07 15:17:41 mclareni Exp $
-*
-* $Log: fmssnd.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:41 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMSSND(GENAM,CHFILE,IRC)
-*CMZ : 05/07/91 11.15.20 by Jamie Shiers
-*-- Author : Jamie Shiers 05/07/91
-#include "fatmen/fatsys.inc"
- CHARACTER*(*) GENAM,CHFILE
- PARAMETER (MAXSRV=50)
- PARAMETER (MAXDIR=16)
- PARAMETER (LUNNAM=10)
- CHARACTER*20 CHIN(2,10)
- CHARACTER*255 CHOUT(2,17)
- CHARACTER*255 CHQUE
- CHARACTER*255 CHSERV
- CHARACTER*255 CHNAME,FNAME
- CHARACTER*8 CHUSER
- CHARACTER*80 CHNICK(MAXSRV)
- CHARACTER*80 CHNODE(MAXSRV)
- CHARACTER*80 CHQUES(MAXSRV)
- CHARACTER*80 CHDIRS(MAXSRV,MAXDIR)
- DIMENSION LDIRS(MAXSRV,MAXDIR)
- DIMENSION LQUES(MAXSRV)
- DIMENSION LNODE(MAXSRV)
- INTEGER FMUSER,FMNODE,SYSTEMF
- LOGICAL IEXIST
- SAVE CHNODE,CHDIRS,CHQUES,LNODE,LDIRS,LQUES,NSERV
-#include "fatmen/fatbug.inc"
-
- DATA NENTRY/0/
- SAVE NENTRY
-
- IRC = 0
-
- LGN = LENOCC(GENAM)
- LF = LENOCC(CHFILE)
-*
-* On first entry, get list of remote servers
-*
- IF(NENTRY.EQ.0) THEN
-
- LDEF = LENOCC(DEFAULT)
- NENTRY = 1
-#if defined(CERNLIB_VAXVMS)
- CHNAME = DEFAULT(1:LDEF)//SERNAM(1:LENOCC(SERNAM))//'.NAMES'
- LN = LENOCC(CHNAME)
-#endif
-#if defined(CERNLIB_UNIX)
- CHNAME = DEFAULT(1:LDEF)//'/'
- + //SERNAM(1:LENOCC(SERNAM))//'.NAMES'
- LN = LENOCC(CHNAME)
- CALL CUTOL(CHNAME(1:LN))
-#endif
-#if defined(CERNLIB_IBMMVS)
- CHNAME = DEFAULT(1:LDEF)//'.'
- + //SERNAM(1:LENOCC(SERNAM))//'.NAMES'
- LN = LENOCC(CHNAME)
-#endif
-*
-* Get the list of FATSERVERS...
-*
- CHIN(1,1) = ':nick'
- CHIN(2,1) = 'FATSERVERS'
-
- CHOUT(1,1) = ':list'
-
- NIN = 1
- NOUT = 1
- NSERV = 0
-
- IF(IDEBFA.GE.1) WRITE(LPRTFA,9001) CHNAME(1:LN)
- 9001 FORMAT(' FMSSND. names file is ',A)
-
- CALL NAMEFD(LUNNAM,CHNAME(1:LN),CHIN,NIN,CHOUT,NOUT,IRC)
-*
-* IRC = -1 : file not found
-* 32 : no match
-*
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.0) PRINT 9002,IRC
- 9002 FORMAT(' FMSSND. return code ',I5,' from NAMEFD')
- RETURN
- ENDIF
-*
-* For each server, get
-* :node and list of directory patterns
-*
- CHSERV = CHOUT(2,1)
- CALL CSQMBL(CHSERV,1,LEN(CHSERV))
- LCHSERV = LENOCC(CHSERV)
- IF(LCHSERV.EQ.0) RETURN
-
- CALL FMNWRD(' ',CHSERV(1:LCHSERV),NSERV)
-
- IF(NSERV.GT.MAXSRV) THEN
- IF(IDEBFA.GE.0) PRINT *,
- + 'FMSSND. cannot process more than ',MAXSRV,
- + ' servers'
- NSERV = MAXSRV
- ENDIF
-
- DO 30 I=1,NSERV
- CALL FMWORD(CHNICK(I),I-1,' ',CHSERV(1:LCHSERV),IRC)
- IF(IDEBFA.GE.0) PRINT *,'FMSSND. processing ',CHNICK(I)
-*
-* For each nick name, get the node and up to 50 directory names
-*
- CHIN(1,1) = ':nick'
- CHIN(2,1) = CHNICK(I)
-
- CHOUT(1,1) = ':node'
- CHOUT(2,1) = ' '
-*
-* *** CHOUT(2,1) = ':dir1' etc.
-*
- DO 10 J=2,MAXDIR+1
- JJ = J-1
- IF(JJ.LT.10) THEN
- WRITE(CHOUT(1,J),9003) JJ
- ELSE
- WRITE(CHOUT(1,J),9004) JJ
- ENDIF
- CHOUT(2,J) = ' '
- 9003 FORMAT(':DIR',I1)
- 9004 FORMAT(':DIR',I2)
- 10 CONTINUE
-
- NIN = 1
- NOUT = MAXDIR + 1
- CALL NAMEFD(LUNNAM,CHNAME(1:LN),CHIN,NIN,CHOUT,NOUT,IRC)
-
- LNODE(I) = LENOCC(CHOUT(2,1))
- CHNODE(I) = CHOUT(2,1)(1:LNODE(I))
- IF(IDEBFA.GE.0) PRINT *,'FMSSND. node : ',
- + CHNODE(I)(1:LNODE(I))
-
- DO 20 J=1,MAXDIR
- LDIRS(I,J) = LENOCC(CHOUT(2,J+1))
- IF(LDIRS(I,J).GT.0) THEN
- CHDIRS(I,J) = CHOUT(2,J+1)(1:LDIRS(I,J))
- IF(IDEBFA.GE.0) PRINT *,'FMSSND. directory : ',
- + CHOUT(2,J+1)(1:LDIRS(I,J))
- CALL CLTOU(CHDIRS(I,J)(1:LDIRS(I,J)))
- ENDIF
-*
- 20 CONTINUE
-#if defined(CERNLIB_UNIX)||defined(CERNLIB_VAXVMS)
- CHQUES(I) = 'TO'//CHNODE(I)(1:LNODE(I))
- LQUES(I) = LNODE(I) + 2
-#endif
-#if defined(CERNLIB_UNIX)
- CALL CUTOL(CHQUES(I)(1:LQUES(I)))
-#endif
-*
-* Check that this subdirectory exists, if not, create
-* (unless the node points to this one)
-*
- IRC = FMNODE(CHNODE(I)(1:LNODE(I)))
- IF(IRC.NE.0) THEN
-#if defined(CERNLIB_VAXVMS)
- CHQUE = DEFAULT(1:LDEF-1) // '.' // CHQUES(I)(1:LQUES(I))
- + // DEFAULT(LDEF:LDEF)
- LQUE = LENOCC(CHQUE)
- INQUIRE(FILE=DEFAULT(1:LDEF)//
- + CHQUES(I)(1:LQUES(I))//'.DIR',
- + EXIST=IEXIST)
- IF(.NOT.IEXIST) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMSSND. creating directory ',
- + CHQUE(1:LQUE)
- IC = LIB$CREATE_DIR(CHQUE(1:LQUE))
- IF(.NOT.IC) THEN
- IF(IDEBFA.GE.0) PRINT *,
- + 'FMSSND. error creating directory ',
- + CHQUE(1:LQUE)
- ENDIF
- ENDIF
-#endif
-#if defined(CERNLIB_UNIX)
- CHQUE = DEFAULT(1:LDEF) // '/' // CHQUES(I)(1:LQUES(I))
- LQUE = LENOCC(CHQUE)
- INQUIRE(FILE=CHQUE(1:LQUE),EXIST=IEXIST)
- IF(.NOT.IEXIST) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMSSND. creating directory ',
- + CHQUE(1:LQUE)
- IC = SYSTEMF('mkdir '//CHQUE(1:LQUE))
- IF(IC.NE.0) THEN
- IF(IDEBFA.GE.0) PRINT *,
- + 'FMSSND. error creating directory ',
- + CHQUE(1:LQUE)
- ENDIF
- ENDIF
-#endif
- ELSE
- IF(IDEBFA.GE.0) PRINT *,'FMSSND. skipping node ',
- + CHNODE(I)(1:LNODE(I))
- ENDIF
- 30 CONTINUE
-
- ENDIF
-*
-* Copy this file to subdirectories for all remote servers
-*
- CALL FMJOUR(FNAME)
- LENF = LENOCC(FNAME)
- DO 60 I=1,NSERV
-*
-* Check that we are not copying to ourselves...
-*
- IRC = FMNODE(CHNODE(I)(1:LNODE(I)))
- IF(IRC.EQ.0) GOTO 60
-*
-* Check that the file did not come from the current remote node
-*
- IF(INDEX(CHFILE(1:LF),'_'//CHNODE(I)(1:LNODE(I))).NE.0) GOTO 60
-*
-* Check that pathname matches at least one of those specified
-*
- DO 40 K=1,MAXDIR
- IF(LDIRS(I,K).EQ.0) GOTO 40
- CALL FMATCH(GENAM(1:LGN),CHDIRS(I,K)(1:LDIRS(I,K)),IRC)
- IF(IRC.EQ.0) GOTO 50
- 40 CONTINUE
-*
-* No match found - skip
-*
- PRINT *,'FMSSND. no match found - update skipped for ',
- + CHNODE(I)(1:LNODE(I))
- GOTO 60
- 50 CONTINUE
- IF(IDEBFA.GE.3) PRINT *,'FMSSND. match found for ',
- + CHNODE(I)(1:LNODE(I))
-#if defined(CERNLIB_VAXVMS)
- CHQUE = DEFAULT(1:LDEF-1) // '.' // CHQUES(I)(1:LQUES(I))
- + // DEFAULT(LDEF:LDEF)
-#endif
-#if defined(CERNLIB_UNIX)
- CHQUE = DEFAULT(1:LDEF) // '/' // CHQUES(I)(1:LQUES(I)) // '/'
-#endif
-#if defined(CERNLIB_IBMMVS)
- CHQUE = DEFAULT(1:LDEF) // '.' // CHQUES(I)(1:LQUES(I)) // '.'
-#endif
- LQUE = LENOCC(CHQUE)
- CALL FACOPY(CHFILE(1:LF),CHQUE(1:LQUE)//
- + FNAME(1:LENF),IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMSSND. error copying ',
- + CHFILE(1:LF),' to ',
- + CHQUE(1:LQUE)//FNAME(1:LENF)
- ENDIF
- 60 CONTINUE
-
- END
-
diff --git a/src/packlib/fatmen/programs/fatulok/Imakefile b/src/packlib/fatmen/programs/fatulok/Imakefile
deleted file mode 100644
index 866750f..0000000
--- a/src/packlib/fatmen/programs/fatulok/Imakefile
+++ /dev/null
@@ -1,3 +0,0 @@
-SRCS_F= fatulok.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/fatmen/programs/fatulok/fatulok.F b/src/packlib/fatmen/programs/fatulok/fatulok.F
deleted file mode 100644
index 19f6c48..0000000
--- a/src/packlib/fatmen/programs/fatulok/fatulok.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: fatulok.F,v 1.1.1.1 1996/03/07 15:17:42 mclareni Exp $
-*
-* $Log: fatulok.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:42 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- PROGRAM FATULOK
-*CMZ : 18/02/91 14.49.14 by Jamie Shiers
-*-- Author : Jamie Shiers 18/02/91
- COMMON/QUEST/IQUEST(100)
- COMMON/PAWC/PAW(50000)
- CHARACTER*80 FATFIL
- CALL HLIMIT(50000)
- LRECL = 0
- FATFIL = 'CERN.FATRZ'
- CALL RZOPEN(1,'//FAT',FATFIL,'U',
- + LRECL,ISTAT)
- PRINT *,'FATULOK. return from RZOPEN with LRECL/ISTAT = ',
- + LRECL,ISTAT
- CALL RZFILE(1,'//FAT','UDL')
- PRINT *,'FATULOK. return code ',IQUEST(1),' from RZFILE'
- CALL RZEND('FAT')
- END
diff --git a/src/packlib/fatmen/programs/fmfind/Imakefile b/src/packlib/fatmen/programs/fmfind/Imakefile
deleted file mode 100644
index ae2d483..0000000
--- a/src/packlib/fatmen/programs/fmfind/Imakefile
+++ /dev/null
@@ -1,3 +0,0 @@
-SRCS_F= fmfind.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/fatmen/programs/fmfind/fmfind.F b/src/packlib/fatmen/programs/fmfind/fmfind.F
deleted file mode 100644
index 26d13af..0000000
--- a/src/packlib/fatmen/programs/fmfind/fmfind.F
+++ /dev/null
@@ -1,164 +0,0 @@
-*
-* $Id: fmfind.F,v 1.1.1.1 1996/03/07 15:17:42 mclareni Exp $
-*
-* $Log: fmfind.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:42 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- PROGRAM FATFIND
-*
-* Taken command lines arguments and issue FMFIND
-*
- CHARACTER*255 GENAM,CHUNIT
- CHARACTER*36 CHOPT
- CHARACTER*26 KOPT
- CHARACTER*8 CHCODE
-#include "fatmen/fmnkeys.inc"
- DIMENSION KEYS(LKEYFA)
-#include "fatmen/fatoptd.inc"
-
- NARGS = IARGC(DUMMY)
-
- IF(NARGS.LT.2) THEN
- PRINT 9001
-9001 FORMAT(' FMFIND. usage: FMFIND GENAM CHUNIT [CHOPT] ')
- GOTO 99
- ENDIF
-
- CALL GETARG(1,GENAM)
- LGN = LENOCC(GENAM)
- CALL CLTOU(GENAM(1:LGN))
-
- IF(NARGS.GE.2) THEN
- CALL GETARG(2,CHUNIT)
- LUNIT = LENOCC(CHUNIT)
- ELSE
- CHUNIT = ' '
- LUNIT = 0
- ENDIF
-
- IF(NARGS.GE.3) THEN
- CALL GETARG(3,CHOPT)
- CALL FMOPTC(CHOPT,ALFNUM,IOPT)
- ELSE
- CHOPT = ' '
- CALL VZERO(IOPT,36)
- ENDIF
-
-*
-* Get FATMEN root and initialise
-*
- LUNRZ = 1
- LUNFZ = 2
-
- LEND = INDEX(GENAM(3:LGN),'/') + 3
- LEND = LEND + INDEX(GENAM(LEND:LGN),'/') - 2
-
- CALL FMLOGL(-3)
- CALL FMSTRT(LUNRZ,LUNFZ,GENAM(1:LEND),IRC)
- CALL FMLOGL(0)
-*
-* Build options string
-*
- IOPTU = 1
- IF(IOPTW.EQ.0) IOPTR = 1
-
- KOPT = 'U'
- LKOPT = 1
-
- IF(IOPTD.NE.0) THEN
- KOPT(LKOPT:LKOPT) = 'D'
- LKOPT = LKOPT + 1
- ENDIF
-
- IF(IOPTE.NE.0) THEN
- KOPT(LKOPT:LKOPT) = 'E'
- LKOPT = LKOPT + 1
- ENDIF
-
- IF(IOPTH.NE.0) THEN
- KOPT(LKOPT:LKOPT) = 'H'
- LKOPT = LKOPT + 1
- ENDIF
-
- IF(IOPTK.NE.0) THEN
- KOPT(LKOPT:LKOPT) = 'K'
- LKOPT = LKOPT + 1
- ENDIF
-
- IF(IOPTL.NE.0) THEN
- KOPT(LKOPT:LKOPT) = 'L'
- LKOPT = LKOPT + 1
- ENDIF
-
- IF(IOPTN.NE.0) THEN
- KOPT(LKOPT:LKOPT) = 'N'
- LKOPT = LKOPT + 1
- ENDIF
-
- IF(IOPTQ.NE.0) THEN
- KOPT(LKOPT:LKOPT) = 'Q'
- LKOPT = LKOPT + 1
- ENDIF
-
- IF(IOPTR.NE.0) THEN
- KOPT(LKOPT:LKOPT) = 'R'
- LKOPT = LKOPT + 1
- ENDIF
-
- IF(IOPTS.NE.0) THEN
- KOPT(LKOPT:LKOPT) = 'S'
- LKOPT = LKOPT + 1
- ENDIF
-
- IF(IOPTU.NE.0) THEN
- KOPT(LKOPT:LKOPT) = 'U'
- LKOPT = LKOPT + 1
- ENDIF
-
- IF(IOPTV.NE.0) THEN
- KOPT(LKOPT:LKOPT) = 'V'
- LKOPT = LKOPT + 1
- ENDIF
-
- IF(IOPTW.NE.0) THEN
- KOPT(LKOPT:LKOPT) = 'W'
- LKOPT = LKOPT + 1
- ENDIF
-
- IF(IOPTY.NE.0) THEN
- KOPT(LKOPT:LKOPT) = 'Y'
- LKOPT = LKOPT + 1
- ENDIF
-
- LFAT = 0
- CALL FMOPEN(GENAM(1:LGN),CHUNIT(1:LUNIT),LFAT,KOPT,IRC)
-
- CALL FMEND(IC)
-
- CALL FMITOC(IRC,CHCODE,LCODE)
-#if defined(CERNLIB_UNIX)
- CALL FAEXIT(IRC)
-#endif
-#if defined(CERNLIB_IBMVM)
- CALL VMREXX('S','FATCODE',CHCODE(1:LCODE),ISTAT)
- IF(IRC.EQ.0) THEN
- STOP
- ELSE
- STOP 16
- ENDIF
-#endif
-#if defined(CERNLIB_VAXVMS)
- ISTAT = LIB$SET_SYMBOL('FATCODE',CHCODE(1:LCODE),
- + LIB$K_CLI_GLOBAL_SYM)
- IF(IRC.EQ.0) THEN
- STOP
- CALL SYS$EXIT(%VAL(1))
- ELSE
- CALL SYS$EXIT(%VAL(44))
- ENDIF
-#endif
-99 END
-
diff --git a/src/packlib/fatmen/programs/fmget/Imakefile b/src/packlib/fatmen/programs/fmget/Imakefile
deleted file mode 100644
index ad4aca3..0000000
--- a/src/packlib/fatmen/programs/fmget/Imakefile
+++ /dev/null
@@ -1,3 +0,0 @@
-SRCS_F= fmget.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/fatmen/programs/fmget/fmget.F b/src/packlib/fatmen/programs/fmget/fmget.F
deleted file mode 100644
index 9c32222..0000000
--- a/src/packlib/fatmen/programs/fmget/fmget.F
+++ /dev/null
@@ -1,166 +0,0 @@
-*
-* $Id: fmget.F,v 1.1.1.1 1996/03/07 15:17:42 mclareni Exp $
-*
-* $Log: fmget.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:42 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- PROGRAM FATGET
-*
-* Taken command lines arguments and issue FMGET
-*
- CHARACTER*255 GENAM,CHFILE
- CHARACTER*36 CHOPT
- CHARACTER*8 CHKSN,CHCODE
- CHARACTER*8 CHHOST,CHFSEQ
- CHARACTER*6 CHVSN,CHVID
- CHARACTER*255 CHFQNA
- CHARACTER*8 CHLOGL
-#include "fatmen/slate.inc"
-#include "fatmen/fmnkeys.inc"
- DIMENSION KEYS(LKEYFA)
-#include "fatmen/fatout.inc"
-#include "fatmen/tmsdef0.inc"
-#include "fatmen/fatpara.inc"
-#include "fatmen/fatbank.inc"
-#include "fatmen/fatoptd.inc"
-
- NARGS = IARGC(DUMMY)
-
- IF(NARGS.EQ.0) THEN
- PRINT 9001
- 9001 FORMAT(' FMGET. usage: FMGET GENAM [KSN] [CHOPT] [CHFILE]')
- GOTO 99
- ENDIF
-
- CALL GETARG(1,GENAM)
- LGN = LENOCC(GENAM)
- CALL CLTOU(GENAM(1:LGN))
-
- IF(NARGS.GE.2) THEN
- CALL GETARG(2,CHKSN)
- KSN = ICDECI(CHKSN,1,LENOCC(CHKSN))
- ELSE
- KSN = 0
- ENDIF
-
- IF(NARGS.GE.3) THEN
- CALL GETARG(3,CHOPT)
- CALL FMOPTC(CHOPT,ALFNUM,IOPT)
- LOPT = LENOCC(CHOPT)
- ELSE
- CHOPT = ' '
- CALL VZERO(IOPT,36)
- LOPT = 0
- ENDIF
-
- IF(LOPT.GT.0) CALL CLTOU(CHOPT(1:LOPT))
-
- IF(LOPT.EQ.1.AND.
- + INDEX('ABCDEFGHIJKLMNOPQRSTUVWXYZ',CHOPT(1:LOPT)).EQ.0) THEN
- CHOPT = ' '
- CALL VZERO(IOPT,36)
- LOPT = 0
- ENDIF
-
- IF(NARGS.GE.4) THEN
- CALL GETARG(4,CHFILE)
- LFILE = LENOCC(CHFILE)
- ELSE
- CHFILE = ' '
- LFILE = 0
- ENDIF
-*
-* Get FATMEN root and initialise
-*
- LUNRZ = 1
- LUNFZ = 2
-
- LEND = INDEX(GENAM(3:LGN),'/') + 3
- LEND = LEND + INDEX(GENAM(LEND:LGN),'/') - 2
-*
-* Get debug level
-*
- CALL GETENVF('FMLOGL',CHLOGL)
- IF(IS(1).NE.0) THEN
- IDEBUG = ICDECI(CHLOGL,1,IS(1))
- ELSE
- IDEBUG = -3
- ENDIF
-
-
- CALL FMLOGL(IDEBUG)
- CALL FMSTRT(LUNRZ,LUNFZ,GENAM(1:LEND),IRC)
-
- IF(LFILE.GT.0) THEN
- CALL FAFILE(3,CHFILE(1:LFILE),IRC)
- OUTPUT = CHFILE(1:LFILE)
- LWRITE = 3
- ELSE
- OUTPUT = 'TTY'
- LWRITE = 6
- ENDIF
-
- LFAT = 0
-
- KEYS(1) = KSN
-
- CALL FMGETA(GENAM(1:LGN),LFAT,KEYS,IRC)
-
- IF(IRC.EQ.0) THEN
- IF(LOPT.EQ.0) THEN
- IF(IRC.EQ.0) THEN
- IF(KEYS(MKMTFA).EQ.1) THEN
- CHFQNA = ' '
- CHHOST = ' '
- CALL UHTOC(IQ(LFAT+KOFUFA+MFQNFA),4,CHFQNA,NFQNFA)
- CALL UHTOC(IQ(LFAT+KOFUFA+MHSNFA),4,CHHOST,NHSNFA)
- WRITE(LWRITE,9002) CHHOST(1:LENOCC(CHHOST)), CHFQNA(1
- + :LENOCC(CHFQNA))
- 9002 FORMAT(A,':',A)
- ELSE
- CALL UHTOC(IQ(LFAT+KOFUFA+MVSNFA),4,CHVSN,NVSNFA)
- CALL UHTOC(IQ(LFAT+KOFUFA+MVIDFA),4,CHVID,NVIDFA)
- CALL FMITOC(IQ(LFAT+KOFUFA+MFSQFA),CHFSEQ,LFSEQ)
- IQUEST(11) = KEYS(MKMTFA)
- CALL FMQTMS(CHVID,LIB,MODEL,DENS,MNTTYP,LABTYP,IRC)
- WRITE(LWRITE,9003) CHVSN(1:LENOCC(CHVSN)), CHFSEQ(1:
- + LFSEQ), LABTYP(1:LENOCC(LABTYP)), CHVID(1:
- + LENOCC(CHVID))
- 9003 FORMAT(A,'.',A,'.',A,'.',A)
- ENDIF
- ENDIF
- ELSE
- CALL FMSHOW(GENAM(1:LGN),LFAT,KEYS,CHOPT,IRC)
- ENDIF
- ENDIF
-
- CALL FMEND(ISTAT)
-
- CALL FMITOC(IRC,CHCODE,LCODE)
-#if defined(CERNLIB_UNIX)
- CALL FAEXIT(IRC)
-#endif
-#if defined(CERNLIB_IBMVM)
- CALL VMREXX('S','FATCODE',CHCODE(1:LCODE),ISTAT)
- IF(IRC.EQ.0) THEN
- STOP
- ELSE
- STOP 16
- ENDIF
-#endif
-#if defined(CERNLIB_VAXVMS)
- ISTAT = LIB$SET_SYMBOL('FATCODE',CHCODE(1:LCODE),
- + LIB$K_CLI_GLOBAL_SYM)
- IF(IRC.EQ.0) THEN
- STOP
- CALL SYS$EXIT(%VAL(1))
- ELSE
- CALL SYS$EXIT(%VAL(44))
- ENDIF
-#endif
-
-
- 99 END
diff --git a/src/packlib/fatmen/programs/fmkuip/Imakefile b/src/packlib/fatmen/programs/fmkuip/Imakefile
deleted file mode 100644
index 580a7d2..0000000
--- a/src/packlib/fatmen/programs/fmkuip/Imakefile
+++ /dev/null
@@ -1,33 +0,0 @@
-#define IHaveCDF
-
-SRCS_F= fmcd.F fmclr.F fmcopc.F fmcpc.F fmdumc.F \ @@\
- fmedit.F fmexit.F fmextr.F fmfc.F fmfndc.F fmgime.F fminic.F \ @@\
- fmkadd.F fmkadt.F fmkatt.F fmkcpl.F fmkdst.F fmkend.F fmklcc.F \ @@\
- fmkloc.F fmkmod.F fmkmtp.F fmksrc.F fmkuwd.F fmkver.F \ @@\
- fmld.F fmlnc.F \ @@\
- fmlogc.F fmlogn.F fmlokk.F fmlsc.F fmmakc.F fmmkdr.F fmmvc.F \ @@\
- fmnikk.F fmpwd.F fmquit.F fmrmc.F fmrmdc.F fmrmlc.F fmrmtc.F \ @@\
- fmrzld.F fmscat.F fmscpl.F fmsdst.F fmseac.F fmskan.F fmslcc.F \ @@\
- fmsloc.F fmsmdk.F fmsmtp.F fmssrc.F fmstat.F fmsupd.F fmsuwd.F \ @@\
- fmsver.F fmtagc.F fmtchc.F fmthrg.F fmtrek.F fmulcc.F \ @@\
- fmupdc.F fmzoom.F \ @@\
- zabend.F
-
-SRCS_CDF= fmcdf.cdf
-
-SubdirLibraryTarget(fmkuip,NullParameter)
-
-DefinePackageLibrary(fmkuip)
-
-#ifdef CERNLIB_HPUX
-SpecialFortranObjectRule(fatmen,fatmen,-O,'-WF,-P')
-#endif
-
-#ifdef CERNLIB_VAXVMS
-NeedTcpipLib
-NeedSysexe
-#endif
-
-CernlibFortranProgramTarget(fatmen,fatmen.o,$(PACKAGE_LIB),$(PACKAGE_LIB),packlib)
-
-InstallProgram(fatmen,$(CERN_BINDIR))
diff --git a/src/packlib/fatmen/programs/fmkuip/fatmen.F b/src/packlib/fatmen/programs/fmkuip/fatmen.F
deleted file mode 100644
index c29276e..0000000
--- a/src/packlib/fatmen/programs/fmkuip/fatmen.F
+++ /dev/null
@@ -1,116 +0,0 @@
-*
-* $Id: fatmen.F,v 1.3 1996/04/12 07:56:01 cernlib Exp $
-*
-* $Log: fatmen.F,v $
-* Revision 1.3 1996/04/12 07:56:01 cernlib
-* new handling of title string
-*
-* Revision 1.2 1996/03/29 11:30:03 jamie
-* qftitlch
-*
-* Revision 1.1.1.1 1996/03/07 15:17:42 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
-*
- PROGRAM FATMEN
-*
-#include "fatmen/fatsys.inc"
-#include "fatmen/fatbug.inc"
-#include "fatmen/fatron.inc"
- COMMON /PAWC/ PAW(1000000)
- EXTERNAL FMEXIT,FMQUIT
-#include "zebra/quest.inc"
- CHARACTER VIDQQ*(*)
-#include "fatmen/qftitlch.inc"
- PARAMETER (VIDQQ = '@(#)' //
- + FatmenTitleFortranString
- + // '>')
- CALL CLEFT (VIDQQ,1,0)
-*
-* Initialise C
-*
- CALL INITC
-*
-* Initialise Zebra...
-*
- CALL MZEBRA(-3)
- CALL MZPAW(1000000,' ')
-*
-* Kuip...
-*
- NWORDS = 50000
- CALL KUINIT(NWORDS)
-*
-* FATMEN...
-*
- LPRTFA = 6
- IDEBFA = 0
- SERNAM = 'INIT'
- FATNOD = ' '
-#if (!defined(CERNLIB_IBMVM))&&(!defined(CERNLIB_IBMMVS))
-*
-* XZ...
-*
- CALL XZINIT(LPRTFA,IDEBFA,3,4,IC)
-#endif
-*
-* CDF...
-*
- CALL FMCDF
-#if defined(CERNLIB_PREV93A)
-*
-* Was required to allow 'rm' and 'rmdir' etc.
-*
- CALL KUEXEC('STYLE -U')
-#endif
-*
-* Set prompt...
-*
- CALL KIPRMT('Type INIT to initialise FATMEN>')
- THRONG = 'NONE'
-
- CALL FMLOGN(IRC)
-*
-* If FATMEN.KUMAC not found, use KULOGN
-*
- IF(IRC.NE.0) THEN
- PRINT *,'Warning - future versions of FATMEN will not support',
- + ' FATMEN.KUMAC files'
- PRINT *,'The new scheme executes the following macros: '
- PRINT *,'FATSYS, FATGRP, FATUSR and FATLOCAL'
- PRINT *,'See the FATMEN manual for more information'
- ELSE
- CALL KULOGN('FAT','SGULV')
- ENDIF
-*
-* Set up the EXIT and QUIT routines
-*
- CALL KUEXIT(FMEXIT)
- CALL KUQUIT(FMQUIT)
-*
-* Pass control to KUIP...
-*
-#if !defined(CERNLIB_MOTIF)
- CALL KUWHAT
-#endif
-#if defined(CERNLIB_MOTIF)
- CALL KUWHAM('Fatmen')
-#endif
-
-#if defined(CERNLIB_VAXVMS)
- CALL SYS$EXIT(%VAL(1))
-#endif
- END
-#if defined(CERNLIB_UNIX)
- SUBROUTINE XYOPEN
-*
-* Dummies - not needed for interactive version
-*
- ENTRY XYCLOS
- ENTRY XYREAD
- ENTRY XYWRIT
- END
-*+
-#endif
diff --git a/src/packlib/fatmen/programs/fmkuip/fmcd.F b/src/packlib/fatmen/programs/fmkuip/fmcd.F
deleted file mode 100644
index ac70cca..0000000
--- a/src/packlib/fatmen/programs/fmkuip/fmcd.F
+++ /dev/null
@@ -1,135 +0,0 @@
-*
-* $Id: fmcd.F,v 1.3 1997/07/16 13:17:58 mclareni Exp $
-*
-* $Log: fmcd.F,v $
-* Revision 1.3 1997/07/16 13:17:58 mclareni
-* Add Linux to the normal Unix backslash case
-*
-* Revision 1.2 1996/03/11 14:23:49 cernlib
-* Add builing/installing programs for fatmen.
-*
-* Revision 1.1.1.1 1996/03/07 15:17:42 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMCD
-#include "fatmen/fmpath.inc"
-#include "fatmen/fatsys.inc"
-#include "fatmen/fatbug.inc"
- CHARACTER*255 CHPATH
- CHARACTER*80 CHOPT
- CHARACTER*80 LINE
- COMMON/QUEST/IQUEST(100)
-#include "fatmen/fatoptd.inc"
-#include "fatmen/fatinit.inc"
- CALL KUGETC(PATH,LPATH)
- CALL KUGETC(CHOPT,LCH)
- CALL FMFIXF(PATH,PATH)
- LPATH=LENOCC(PATH)
-
- IF(LCH.EQ.0) THEN
- CHOPT = ' '
- LCH = 1
- ENDIF
-
- CALL FMOPTC(CHOPT,ALFNUM,IOPT)
- IF(IOPTA.NE.0) THEN
- DO 36 J=1,36
- IOPT(J) = 1
-36 CONTINUE
- ENDIF
-
- IF(PATH(1:LPATH).EQ.'PWD') THEN
- CALL FMPWD
- RETURN
- ENDIF
-
- IF(IDEBFA.GE.3)
- + PRINT *,'FMCD. enter for path = ',PATH(1:LPATH)
-
- ISLASH = INDEX(PATH(1:LPATH),'/')
- IF(ISLASH.EQ.0) THEN
- LEND = LPATH
- ELSE
- LEND = ISLASH - 1
- ENDIF
- CHPATH = PATH
-
- IF(PATH(1:LEND).EQ.'..') THEN
-#if defined(CERNLIB_SUN)||defined(CERNLIB_SGI)||defined(CERNLIB_DECS)\
- ||defined(CERNLIB_IBMRT)||defined(CERNLIB_APOF77)||defined(CERNLIB_QMALPH)\
- ||defined(CERNLIB_HPUX)||defined(CERNLIB_LINUX)
- PATH = '\\'
-#else
- PATH = '\'
-#endif
- IF(ISLASH.GT.0) THEN
- PATH = PATH(1:1) // CHPATH(ISLASH:LPATH)
- LPATH = LENOCC(PATH)
- ELSE
- LPATH = 1
- ENDIF
- ENDIF
-
- IF((PATH(1:LEND).EQ.'~').OR.(PATH(1:LEND).EQ.'$HOME')) THEN
- PATH = FATTOP
- LTOP = LENOCC(PATH)
- IF(ISLASH.GT.0) THEN
- PATH = PATH(1:LTOP) // CHPATH(ISLASH:LPATH)
- ENDIF
- LPATH = LENOCC(PATH)
- IF(IDEBFA.GE.3) PRINT *,'FMCD. set path to ',PATH(1:LPATH)
- ENDIF
-
-#if !defined(CERNLIB_CZ)
- CALL RZCDIR(PATH(1:LPATH),'U')
- IF (IQUEST(1).EQ.0) THEN
- CALL RZCDIR(PATH(1:LPATH),'P')
- CALL RZCDIR(PATH,'R')
-*
-* Quota
-*
- IF(IOPTQ.NE.0) THEN
- PRINT *,'Quota = ',IQUEST(10)
- ENDIF
-*
-*
-* Subdirectories
-*
- IF(IOPTS.NE.0) THEN
- PRINT *,'Number of subdirectories = ',IQUEST(9)
- ENDIF
-*
-* Dates & Times
-*
- IF(IOPTT.NE.0) THEN
- PRINT *,'Created on ',IQUEST(14),' at ',IQUEST(15),
- + 'Modified on ',IQUEST(16),' at ',IQUEST(17)
- ENDIF
-*
-* Usage
-*
- IF(IOPTU.NE.0) THEN
- PRINT *,'Number of records used = ',IQUEST(18)
- PRINT *,IQUEST(19),' megawords + ',IQUEST(20),' words'
- ENDIF
-*
-#endif
-#if defined(CERNLIB_CZ)
- CALL CZPUTA('MESS :CD '//PATH(3:LPATH),ISTAT)
-1 CONTINUE
- CALL CZGETA(LINE,ISTAT)
- PRINT *,LINE(3:80)
- IF(INDEX('Cannot',LINE) .EQ. 0) THEN
-#endif
- CDIR = PATH
- LCDIR = LENOCC(CDIR)
- ELSE
- GOTO 99
- ENDIF
- RETURN
-
-99 CONTINUE
- PRINT *,'FMCD. Error setting directory, IRC = ',IQUEST(1)
- END
diff --git a/src/packlib/fatmen/programs/fmkuip/fmcdf.cdf b/src/packlib/fatmen/programs/fmkuip/fmcdf.cdf
deleted file mode 100644
index 6c12f80..0000000
--- a/src/packlib/fatmen/programs/fmkuip/fmcdf.cdf
+++ /dev/null
@@ -1,1178 +0,0 @@
-*
-* $Id: fmcdf.cdf,v 1.3 1997/01/07 11:20:31 jamie Exp $
-*
-* $Log: fmcdf.cdf,v $
-* Revision 1.3 1997/01/07 11:20:31 jamie
-* allow -I option through shell
-*
-* Revision 1.2 1996/08/01 11:07:55 jamie
-* Changes to support FMVERI On/Off
-*
-* Revision 1.1.1.1 1996/03/07 15:18:09 mclareni
-* Fatmen
-*
-*
-*----------------------------------------------------------------
-*
-* FATMEN command definition file (CDF)
-*
-*----------------------------------------------------------------
->NAME FMCDF
->MENU FATMEN
->Guidance
-FATMEN shell commands
-
-*----------------------------------------------------------------
->Command INIT
->Guidance
-Use the INIT command to initialise the FATMEN system for the specified
-group or throng, e.g. ALEPH
-.
-Syntax INIT GROUP or THRONG
->Action FMTHRG
->PARAMETERS
-GROUP 'Group or Throng name' C D=' '
-*----------------------------------------------------------------
->Command END
->Action FMKEND
->PARAMETERS
-+
->Guidance
-Use the END command when no more processing with current
-FATMEN catalogue is required.
-
-*----------------------------------------------------------------
->Command LOGLEVEL
->Action FMLOGC
->PARAMETERS
-+
-LOGLEVEL 'Loglevel' I D=0
->Guidance
-Use the LOGLEVEL command to set the FATMEN logging level.
-Syntax: LOGLEVEL loglevel
-
-*----------------------------------------------------------------
->Command GIME
->Guidance
-Use the GIME command to reaccess the disk of the service
-machine which maintains the FATMEN catalogue. This command
-has no parameters.
-Syntax: GIME
->Action FMGIME
-
-*----------------------------------------------------------------
->Command UPDATE
->Guidance
-Use the UPDATE command to control how updates are sent to the FATMEN
-server.
-.
-IFLAG can have the following values:
-.
--1 = reset to system defaults
-.
- 0 = reset as per MAX and NGROUP and send any outstanding updates
-to the server
-.
- 1 = reset as per MAX and NGROUP and purge any outstanding updates
-Syntax: UPDATE MAX NGROUP IFLAG
->Action FMUPDC
->PARAMETERS
-MAX 'maximum number of updates' I D=999
-NGROUP 'number of updates to send together' I D=0
-IFLAG 'flag to purge/send/reset' I D=0
-*----------------------------------------------------------------
->Command VERSION
->Guidance
-Use the VERSION command to display the version of the FATMEN
-software that you are running.
-Syntax: VERSION
->Action FMVERS
->MENU \FMCAT
->Guidance
-Commands to manipulate the FATMEN catalogue
-
-*----------------------------------------------------------------
->Command CD
->Guidance
-Use the CD command to change the current default directory.
-.
-Syntax: CD path
->Action FMCD
->PARAMETERS
-PATH 'path' C D='PWD'
-+
-CHOPT 'options ' C D=' '
--A 'all of below'
--Q 'show quota for new directory'
--S 'show number of subdirectories'
--T 'show creation & modification times'
--U 'show usage information'
-*----------------------------------------------------------------
->Command FC
->Action FMFC
->PARAMETERS
-+
-FILE 'File or pathname' C D='*'
-OUT*PUT 'Output filename' C D='TTY'
-CHOPT 'Options' C D=' '
--D 'display number of subdirectories at each level'
--F 'display number of files at each level'
--L 'display lowest level only, i.e. directories with no subdirectories'
--Z 'display only directories with no (zero) files'
->Guidance
-Use the FC command to count the number of files in a directory.
-FC will also count the number of files which match the specified pattern
-.
-Syntax: FC <pattern>
-
-*----------------------------------------------------------------
->Command LD
->Action FMLD
->PARAMETERS
-+
-FILE 'Pathname' C D='*'
-OUT*PUT 'Output filename' C D='TTY'
-NLEVEL 'Number of levels to display' I D=1
-CHOPT 'Options' C D=' '
--H 'write header line in output file'
--R 'list subdirectories recursively'
--V 'very wide' listing. As W, but 132 columns'
--W 'wide. Subdirectories are displayed in multi-column (80) format.'
->Guidance
-Use the LD command to display the contents of a directory.
-.
-Syntax: LD pathname <options>
-.
-Output: Redirect the output to the specified file
-.
-Nlevel: Number of levels to descend (with option R)
-
-*----------------------------------------------------------------
->Command LS
->Action FMLSC
->PARAMETERS
-+
-FILE 'File or pathname' C D='*'
-KSN 'Key serial number' I D=0
-OUT*PUT 'Output filename ' C D='TTY'
-NAMES 'Names filename ' C D=' '
-CHOPT 'Options' C D=' '
--A 'list all attributes, except options Q and Z.'
--B 'brief listing - one line (80 columns) per entry'
--C 'display comment field associated with file'
--D 'listing suitable for generated a macro to delete entry'
--E 'extended listing - one line (132 columns) per entry'
--F 'list file attributes, such as start/end record and block'
--G 'list the full generic name of each file'
--H 'write header line in output file'
--I 'output sorted by Increasing generic name'
--J 'show just those files that are accessible'
--K 'list keys associated with this file (copy level, media type, location)'
--L 'list logical attributes, such as FATMEN file format _
-(ZEBRA exchange etc.)'
--M 'list media attributes, such as VSN, VID, file sequence number for tape _
-files, host type and operating system for disk files.'
--N 'lists dataset name on disk/tape of this file'
--O 'list owner, node and job of creator etc.'
--P 'list physical attributes, such as record format etc.'
--Q 'query TMS for corresponding volume'
--R 'show where the data Reside'
--S 'lists security details of this file (protection)'
--T 'list date and time of creation, last access etc.'
--U 'list user words.'
--V 'very wide listing. As W, but 132 columns'
--W 'wide listing. Filenames (part of generic name following _
-last slash) are displayed in multi-column (80) format.'
--X 'each generic name displayed only once'
--Y 'verify bank contents using FMVERI.'
--Z 'dump ZEBRA bank with DZSHOW.'
->Guidance
-Use the LS command to display the contents of a directory
-or display information on a given file within the current or specified
-directory.
-.
-Syntax: LS file <options>
-.
-Output: Redirect the output to the specified file
-
-*----------------------------------------------------------------
->Command MODIFY
->Guidance
-Use the MOD command to modify an existing catalogue entry. Note
-that certain fields cannot be changed using the MOD command,
-notably the VSN, VID and FSEQ for tape files and the FILEID and
-HOSTNAME for disk files. Use the MV command if you wish to modify
-these fields.
-.
-e.g.
-.
-MOD FRED FSIZE=180
-.
-MOD TOM -KL
-.
->Action FMKMOD
->Parameters
-GNAME 'Generic name ' C D=' '
-+
-KSN 'Key serial number ' I D=0
-LOCCOD 'Location code ' I D=0
-DATREP 'Data representation ' I D=0
-MEDTYP 'Media type ' I D=0
-FFORM 'FATMEN file format ' C D=' '
-RECFM 'Record format ' C D=' '
-RECL 'Record length (words)' I D=0
-BLOCK 'Block length (words)' I D=0
-FSIZE 'File size (MB) ' I D=0
-COMM 'Comment ' C D=' '
-CHOPT 'Options ' C D=' '
--A 'modify all matching entries'
--I 'interactive mode : command line is ignored. Each field _
-in the bank is displayed and a new value prompted for _
-Alternatively, one or more of the following options may _
-be given, in which case only the corresponding fields will _
-be modified.'
--K 'modify keys. Note that if you modify the media type, _
-a new entry will be created corresponding to the new media _
-type, and the old entry will remain. To change the media type, _
-the MV command is preferred.'
--F 'modify file description'
--L 'modify logical description'
--P 'modify physical description'
--T 'modify time values'
--C 'modify creator information'
--U 'modify user area'
-*----------------------------------------------------------------
->Command NICK
->Action FMNIKK
->Guidance
-Use the NICK command to search in the specified or default
-names file for a given nickname
-.
-Syntax: NICK nickname
->PARAMETERS
-NICK 'Nickname ' C D=' '
-+
-NAMESFILE 'Names file' C D=' '
-CHOPT 'Options ' C D=' '
-*----------------------------------------------------------------
->Command PWD
->Guidance
-Use the PWD command to print the current (working) directory.
-.
-Syntax: PWD
->Action FMPWD
-*----------------------------------------------------------------
->Command SCAN
->Guidance
-Use the SCAN command to scan the FATMEN catalogue for the
-files specified. This command will only display entries
-that satisfy the current selection on location code, media
-type and copy level/data representation.
-.
-If option D is specified, files will be listed in reverse
-order. This is particularly efficient when deleting many
-entries from a directory.
-.
->Action FMSKAN
->PARAMETERS
-+
-PATH 'path name' C D='*'
-NLEVEL 'Number of levels' I D=1
-DSN 'Fileid/DSN' C D=' '
-HOST 'Hostname ' C D=' '
-VID 'VID ' C D=' '
-USER 'Username ' C D=' '
-NMAT*CH '# to match' I D=0
-CRE*ATED 'date range' C D=' '
-CAT*ALOGED 'date range' C D=' '
-ACC*ESSED 'date range' C D=' '
-UFORM 'user file format' C D=' '
-COMM*ENT 'comment' C D=' '
-OUT*PUT 'Output filename ' C D='TTY'
-STR*ING 'string to append to the RM command' C D=' '
-CHOPT 'Options' C D=' '
--A 'list all attributes, except options Q and Z.'
--B 'brief listing - one line (80 columns) per entry'
--C 'display comment field associated with file'
--D 'listing suitable for generated a macro to delete entry'
--E 'extended listing - one line (132 columns) per entry'
--F 'list file attributes, such as start/end record and block'
--G 'list the full generic name of each file'
--H 'write header line in output file'
--I 'output sorted by Increasing generic name'
--J 'show just those files that are accessible'
--K 'list keys associated with this file (copy level, media type, location)'
--L 'list logical attributes, such as FATMEN file format _
-(ZEBRA exchange etc.)'
--M 'list media attributes, such as VSN, VID, file sequence number for tape _
-files, host type and operating system for disk files.'
--N 'lists dataset name on disk/tape of this file'
--O 'list owner, node and job of creator etc.'
--P 'list physical attributes, such as record format etc.'
--Q 'query TMS for corresponding volume'
--R 'show where the data Reside'
--S 'lists security details of this file (protection)'
--T 'list date and time of creation, last access etc.'
--U 'list user words.'
--V 'very wide listing. As W, but 132 columns
--W 'wide listing. Filenames (part of generic name following _
-last slash) are displayed in multi-column (80) format.'
--X 'each generic name displayed only once'
--Y 'verify bank contents using FMVERI.'
--Z 'dump ZEBRA bank with DZSHOW.'
-*----------------------------------------------------------------
->Command SEARCH
->Guidance
-Use the SEARCH command to print the generic names of files which
-match the specified criteria. Character fields may include the
-* or % wild cards.
-.
-e.g. SEARCH * VID=I* # search current working directory for entries
-# with VID's beginning with I.
-.
-If NMATCH is non-zero, SEARCH will stop after NMATCH matches have
-been found.
-.
-Set the loglevel to <0 to stop the printing of the names of
-files and directories searched.
-.
-Date and time ranges may be given, as in the following example:
-which searches for files in the current directory that have been
-accessed between 31st January, 1991 and midday on 30th June 1991
-.
-SEARCH * accessed=910131-910630.1200
-.
-Entries that match are displayed as with the LS command.
->Action FMSEAC
->PARAMETERS
-PATH 'path name' C D='*'
-+
-DSN 'Fileid/DSN' C D=' '
-HOST 'Hostname ' C D=' '
-VID 'VID ' C D=' '
-USER 'Username ' C D=' '
-NMAT*CH '# to match' I D=0
-CRE*ATED 'date range' C D=' '
-CAT*ALOGED 'date range' C D=' '
-ACC*ESSED 'date range' C D=' '
-UFORM 'user file format' C D=' '
-COMM*ENT 'comment' C D=' '
-OUT*PUT 'Output filename ' C D='TTY'
-CHOPT 'Options' C D=' '
--A 'list all attributes, except options Q and Z.'
--B 'brief listing - one line (80 columns) per entry'
--C 'display comment field associated with file'
--D 'listing suitable for generated a macro to delete entry'
--E 'extended listing - one line (132 columns) per entry'
--F 'list file attributes, such as start/end record and block'
--G 'list the full generic name of each file'
--H 'write header line in output file'
--I 'output sorted by Increasing generic name'
--J 'show just those files that are accessible'
--K 'list keys associated with this file (copy level, media type, location)'
--L 'list logical attributes, such as FATMEN file format _
-(ZEBRA exchange etc.)'
--M 'list media attributes, such as VSN, VID, file sequence number for tape _
-files, host type and operating system for disk files.'
--N 'lists dataset name on disk/tape of this file'
--O 'list owner, node and job of creator etc.'
--P 'list physical attributes, such as record format etc.'
--Q 'query TMS for corresponding volume'
--R 'show where the data Reside'
--S 'lists security details of this file (protection)'
--T 'list date and time of creation, last access etc.'
--U 'list user words.'
--V 'very wide listing. As W, but 132 columns
--W 'wide listing. Filenames (part of generic name following _
-last slash) are displayed in multi-column (80) format.'
--X 'each generic name displayed only once'
--Y 'verify bank contents using FMVERI.'
--Z 'dump ZEBRA bank with DZSHOW.'
-*----------------------------------------------------------------
->Command TREE
->Guidance
-Use the TREE command to draw a directory tree starting at the
-specified directory down NLEVEL levels.
-.
-Syntax: TREE path nlevel
->Action FMTREK
->Parameters
-+
-PATH 'Path name ' C D=' '
-NLEVEL 'number of levels' I D=99
-OUT*PUT 'Output filename' C D='TTY'
-
-*----------------------------------------------------------------
->Command VIEW
->Guidance
-Use the VIEW command to edit a local disk file.
-This command will be extended to support tape and remote files.
-.
-Syntax: VIEW file <key>
->Action FMEDIT
->PARAMETERS
-FILE 'file' C D=' '
-+
-KSN 'Key serial number' I D=0
-*----------------------------------------------------------------
->Command ZOOM
->Action FMZOOM
->PARAMETERS
-+
-FILE 'Pathname' C D='*'
->Guidance
-Use the ZOOM command to descend the specified (wild-carded)
-directory tree to the first lowest level directory that
-contains one or more files.
-.
-e.g. ZOOM DATA
-.
- ZOOM *DST/*/P88*
-.
-If no wild-cards are present in the pathname, the characters /*
-are automatically appended. To zoom down a tree starting with
-.
-*ALLD, use ZOOM *ALLD/*
-.
->MENU \FMDATA
->Guidance
-Commands to manipulate the data
-
-*----------------------------------------------------------------
->Command COPY
-
->Action FMCOPC
->PARAMETERS
-GNAME 'Generic name' C D=' '
-+
-KS1 'Input Key serial number' I D=0
-KS2 'Output Key serial number' I D=0
-POOL 'TMS Pool ' C D=' '
-LIB*RARY 'TMS Library ' C D=' '
-VSN 'VSN ' C D=' '
-VID 'VID ' C D=' '
-FSEQ 'FSEQ ' I D=1
-NODE 'Remote node ' C D=' '
-FILE 'Remote file ' C D=' '
-TRANS*PORT 'Transport mechanism' C D='TCPIP' OPTION
--TCPIP 'Use TCP/IP as transport'
--DECNET 'Use DECnet as transport (between VAX/VMS systems only)'
--CHEOPS 'queue for transfer via Olympus satellite'
-LOC*COD 'Location code ' I D=0
-DAT*REP 'Data representation ' I D=0
-MED*TYP 'Media type ' I D=0
-CHOPT 'Options ' C D=' '
--C 'perform copy using STAGE CHANGE'
--F 'perform copy using FZ input/output (permits conversion)'
--K 'keep network connection open between transfers'
--L 'Lock output tape volume using TMS LOCK command'
--P '(default) perform PHYSICAL copy - no data or format conversion'
--S 'STAGE IN the input file'
--Z 'STAGE OUT the output file'
->Guidance
-Use the COPY command to copy the data referenced by a generic name.
-N.B. if you wish to copy just a catalogue entry, use the command CP.
-.
-Syntax: COPY GNAME <options>
-
-*----------------------------------------------------------------
->Command DUMP
->Guidance
-Use the DUMP command to request a TAPEDUMP of the VID
-corresponding to the specified generic name.
-.
-Syntax: DUMP generic-name key-serial-number
-
->Action FMDUMC
->PARAMETERS
-GENAM 'generic-name' C D=' '
-+
-KSN 'Key serial number' I D=0
-BYTES 'Number of bytes/block to dump' I D=320
-BLOCKS 'Number of blocks/file to dump' I D=1
-FILES 'Number of files to dump' I D=1
-CODE 'Character code (EBCDIC or ASCII)' C D='EBCDIC' OPTION
--ASCII 'Tape labels encoded in ASCII (AL)'
--EBCDIC 'Tape labels encoded in EBCDIC (SL)'
-
-*----------------------------------------------------------------
->Command FIND
->Guidance
-Use the FIND command to FIND the specified file and associate
-it with the specified logical unit. If required, the file is
-first staged to disk.
-.
-SYNTAX: FIND generic-name logical-unit
->Action FMFNDC
->PARAMETERS
-FILE 'NAME OF FILE' C D=' '
-LUNU 'Logical unit (nn/FTnnFlll/IOFILEnn etc.)' C D='0'
-+
-CHOPT 'Options' C D=' '
--D 'Make a duplicate into the SMCF robot (CERN only)'
--E 'When used with option T, add END option to SETUP command'
--H 'Stage the wHole tape, e.g. 1-E on VM, /FULLTAPE on VMS etc.'
--I 'Deselect -G option for SHIFT s/w'
--K 'KEEP option on STAGE OUT'
--L 'Override DCB in tape label with information in catalogue'
--N 'Do not add dataset name to stage command'
--Q 'Queue stage request, e.g. STAGE (NOWAIT'
--S 'Update FATMEN catalogue with file size returned from stage'
--V 'Verify file size in FATMEN catalogue against information _
-returned by stage
--Y 'Do not issue stage command but write to file on unit LUNU'
-
-*----------------------------------------------------------------
->Command MAKE
->Guidance
-Use the MAKE command to access the specified file and associate
-it with the specified logical unit in WRITE mode. For tape files,
-this corresponds to output staging.
-.
-SYNTAX: MAKE FILE LUNU
->Action FMMAKC
->PARAMETERS
-FILE 'NAME OF FILE' C D=' '
-LUNU 'Logical unit (nn/FTnnFlll/IOFILEnn etc.)' C D='0'
-
->MENU \FMUTIL
->Guidance
-Utility commands
-
-*----------------------------------------------------------------
->Command CLR
->Guidance
-Use the CLR command to clear the screen on a 3270 type terminal
-.
-Syntax: CLR
->Action FMCLR
-
-*----------------------------------------------------------------
->Command CP
->Guidance
-Use the CP command to copy a file entry.
-.
-N.B. if you wish to copy the DATA, use the command COPY.
-.
-The new entry will be added to the catalogue using the
-'FMPUT' subroutine. Thus, if an attempt is made to copy
-TO an entry with the same
-name and hostname/DSN (disk files) or VID/VSN/FSEQ (tape files),
-then this will be refused SILENTLY by the server.
-.
-Syntax: CP file1 file2 [key]
-
->Action FMCPC
->PARAMETERS
-FROM 'file1' C D=' '
-TO 'file2' C D=' '
-+
-KSN 'key ' I D=0
-LOC*COD 'Location code ' I D=0
-DAT*REP 'Data representation ' I D=0
-MED*TYP 'Media type ' I D=0
-VSN 'vsn ' C D=' '
-VID 'vid ' C D=' '
-FSEQ 'fseq ' I D=0
-DSN 'fileid ' C D=' '
-HOST 'host ' C D=' '
-
-*----------------------------------------------------------------
->Command DIR
->Guidance
-Use the DIR command to issue a call to RZLDIR for the specified
-path. This command is normally used for debug purposes only.
-.
-Syntax: DIR path options
->Action FMRZLD
->Parameters
-+
-PATH 'path-name' C D=' '
-OUTPUT 'output file name ' C D='TTY'
-CHOPT 'options ' C D=' '
--A 'RZLDIR option A (list also objects created with A option in RZOUT/RZVOUT)'
--T 'List also directory tree'
--X 'eXtended listing'
-
-*----------------------------------------------------------------
->Command EXTRACT
->Action FMEXTR
->PARAMETERS
-+
-PATH 'Pathname' C D='*/*'
-OUTPUT 'Output filename' C D=' '
-CHOPT 'Options ' C D='C'
->Guidance
-Use the EXTRACT command to copy a subset of the FATMEN catalogue
-to a FZ alpha exchange format file.
-Only those files that match the specified path and file name and
-the current keys selection will be written to the output file.
-e.g.
-.
-set/location 2
-extr */m* my.fa
-.
-will only write information about files with location code 2.
-All files begining with the letter M in all directories will
-be processed.
-
-*----------------------------------------------------------------
->Command LN
->Guidance
-Use the LN command to make a link or alias to a generic name.
-.
-N.B. This commands uses the Unix syntax where TARGET-->SOURCE(?)
->Action FMLNC
->PARAMETERS
-SOURCE 'source file' C D=' '
-TARGET 'target file' C D=' '
-+
-CHCOMM 'comment ' C D=' '
-IW1 'user word 1' I D=0
-IW2 'user word 2' I D=0
-IW3 'user word 3' I D=0
-IW4 'user word 4' I D=0
-IW5 'user word 5' I D=0
-IW6 'user word 6' I D=0
-IW7 'user word 7' I D=0
-IW8 'user word 8' I D=0
-IW9 'user word 9' I D=0
-IW10 'user word 10' I D=0
-CHOPT 'options ' C D=' '
--C 'set the comment of the link to CHCOMM'
--U 'set the user word vector'
-*----------------------------------------------------------------
->Command MEDIA
->Guidance
-Use the MEDIA command to set or list attributes of a given
-type of media.
-e.g.
-.
-MEDIA 2 3480 CT1 200 38K M SL
-.
-would set the attributes of FATMEN media type 2 to
-.
-model: 3480
-.
-generic device type: CT1 (used on STAGE/SETUP requests)
-.
-capacity: 200 MB (maximum size on STAGE command)
-.
-density: 38K
-.
-label : SL
-.
-MEDIA with no arguments lists the current settings
-.
-MEDIA 3 lists the settings for media type 3
-.
->Action FMSMDK
->PARAMETERS
-+
-MEDIA 'FATMEN media type' I D=2
-TYPE 'device type ' C D='3480'
-MODEL 'generic device ' C D='CT1 '
-SIZE 'capacity in MB ' C D='200 '
-DENS 'density ' C D='38K '
-MNTP 'mount-type ' C D='M' OPTION
--M 'manually mounted volume'
--R 'robotically mounted volume'
-LABL 'label-type ' C D='SL' OPTION
--SL 'Standard label tape (i.e. IBM label)'
--AL 'ANSI standard label (ascii)'
--NL 'No label'
-
-*----------------------------------------------------------------
->Command MKDIR
->Guidance
-Use the MKDIR command to create a directory.
-.
-Syntax: MKDIR directory_name.
->Action FMMKDR
->PARAMETERS
-DIRNAM 'directory' C D=' '
-*----------------------------------------------------------------
->Command MV
->Guidance
-Use the MV command to 'move' or rename a file.
-.
-Syntax: MV file1 file2 ksn
->Action FMMVC
->PARAMETERS
-FROM 'source generic name' C D=' '
-TO 'target generic name' C D=' '
-+
-KSN 'key serial number ' I D=0
-LOC*COD 'Location code ' I D=0
-DAT*REP 'Data representation ' I D=0
-MED*TYP 'Media type ' I D=0
-VSN 'vsn ' C D=' '
-VID 'vid ' C D=' '
-FSEQ 'fseq ' I D=0
-DSN 'fileid ' C D=' '
-HOST 'host ' C D=' '
-*----------------------------------------------------------------
->Command RM
->Guidance
-Use the RM command to remove a file from the catalogue.
-.
-Syntax: RM file <key> <dsn> <host> <vid> <user> <pool> <prot> <chopt>
->Action FMRMC
->PARAMETERS
-FILE 'file' C D=' '
-+
-KSN 'Key serial number' I D=0
-DSN 'Fileid/DSN' C D=' '
-HOST 'Hostname ' C D=' '
-VID 'VID ' C D=' '
-USER 'Username ' C D=' '
-POOL 'Pool to return tape to' C D=' '
-PROT 'Protection group ' C D=' '
-CHOPT 'Options' C D=' '
--A 'remove all occurances of this generic name'
--E 'if the entry points to a disk file, erase this file (if accessible)'
--I 'prompt before removing each matching entry _
-Turned on automatically if option A is given'
--N 'do not prompt in case of option A. To be used with caution'
--F 'free tape associated with specified entry'
--G 'set protection group to group specified _
-If no group is specified, then *None will be _
-used, unless option P is given, in which case _
-the POOL name will be used.'
--P 'when used with option F, allows privileged TMS _
-user to free anyones tapes (within a group)'
--U 'unlock or write-enable tape'
--D 'delete TMS tag'
--B 'binary TMS tag'
--T 'text TMS tag'
-
-*----------------------------------------------------------------
->Command RMDIR
->Guidance
-Use the RMDIR command to remove a directory from the catalogue.
-.
-N.B. directories can only be removed if
-.
- 1) They contain no subdirectories
-.
- 2) They contain no files
-.
-If you wish to remove a complete directory tree that contains
-no files, use the RMTREE command.
-.
-Syntax: RMDIR DIRECTORY_NAME
->Action FMRMDC
->PARAMETERS
-FILE 'directory' C D=' '
-*----------------------------------------------------------------
->Command RMLN
->Guidance
-Use the RMLN command to remove a link from the catalogue.
-.
-Syntax: RMLN chlink [lwrite] [chfile] [chopt]
->Action FMRMLC
->PARAMETERS
-CHLINK '[wild-carded] generic name' C D=' '
-+
-LWRITE 'logical unit for output ' I D=0
-CHFILE 'file name for output ' C D=' '
-CHOPT 'options ' C D=' '
--P 'print names of dangling links'
--D 'write names of dangling links in "rm ksn" format'
--R 'remove dangling links'
--F 'redirect output to CHFILE on LWRITE'
-*----------------------------------------------------------------
->Command RMTREE
->Guidance
-Use the RMTREE command to remove a complete directory tree.
-.
-N.B. if any of the directories below the named directory
-contain files, then the command will be refused.
-.
-Syntax: RMTREE DIRECTORY_NAME
->Action FMRMTC
->PARAMETERS
-FILE 'directory' C D=' '
-
-*----------------------------------------------------------------
->Command TOUCH
->Guidance
-Use the TOUCH command to reinsert an existing entry in the catalogue.
-If a negative key serial number is given, all matching entries
-will be updated.
-.
-Syntax: TOUCH GENERIC-NAME KEY-SERIAL-NUMBER CHOPT
->Action FMTCHC
->PARAMETERS
-FILE 'file' C D=' '
-+
-KSN 'Key serial number' I D=0
-CHOPT 'Options' C D=' '
--A 'set account field'
--C 'clear comment field'
--O 'reset owner, node and job of creator etc.'
--T 'update date and time of last access'
--U 'zero use count'
->MENU \TMS
->Guidance
-Commands that interface to the TMS
-
-*----------------------------------------------------------------
->Command ALLOCATE
->Guidance
-Use the ALLOCATE command to add a new tape file to the FATMEN catalogue
-A tape is allocated from the specified pool. The file sequence number
-is always set to 1.
->Action FMKATT
->Parameters
-POOL 'TMS Pool ' C D=' '
-LIBRARY 'TMS Library ' C D=' '
-GNAME 'generic file name' C D=' '
-DSN 'disk dataset name' C D=' '
-FFORM 'file format (FZ, FA, FX, RZ, EP, UN, AS)' C D='UN'
-CPLEV 'copy level (0=original, 1=copy etc.)' I D=0
-HOSTN 'host name (e.g. CERNVM)' C D='thisnode'
-+
-COMM 'comment (in quotes)' C D='Added via FATMEN CLI'
-RECFM 'record format (e.g. FB, VBS)' C D=' '
-LRECL 'record length (in words)' I D=0
-BLOCK 'block length (in words)' I D=0
-FSIZE 'file size (in megabytes)' I D=0
-MEDIA 'media type (2=3480,3=3420,4=8200,...)' I D=2
-*----------------------------------------------------------------
->Command LOCK
->Action FMLOKK
->PARAMETERS
-GENAM 'generic name' C D=' '
-+
-KSN 'Key serial number' I D=0
-CHOPT 'Options' C D=' '
->Guidance
-Use the LOCK command to disable WRITE access to the tape on which
-the file specified resides. If a negative key serial number is given,
-all entries will be locked.
-.
-Syntax: LOCK GENERIC-NAME KEY-SERIAL-NUMBER <CHOPT>
-
-*----------------------------------------------------------------
->Command TAG
->Guidance
-Use the TAG command to get, set or delete the TMS TAG
-associated with the a tape volume that corresponds to
-the specified generic name.
-.
-Syntax: TAG generic-name key-serial-number tag-text chopt
-.
-If option S is specified without any TAG text, the tag
-is sent to the generic name.
->Action FMTAGC
->PARAMETERS
-FILE 'file' C D=' '
-+
-KSN 'Key serial number' I D=0
-TAG 'Tag ' C D=' '
-CHOPT 'Options ' C D=' '
--D 'delete the tag'
--G 'get & display the tag'
--S 'set the tag'
--B 'to select the BINARY tag (stored as CHARACTER*255)'
--T 'to select the TEXT tag (default)'
--V 'to select the VOLINFO tag (SYSTEM tag at IN2P3)'
-*----------------------------------------------------------------
->Command UNLOCK
->Action FMULCC
->PARAMETERS
-GENAM 'generic name' C D=' '
-+
-KSN 'Key serial number' I D=0
-CHOPT 'Options' C D=' '
->Guidance
-Use the UNLOCK command to enable WRITE access to the tape on which
-the file specified resides. If a negative key serial number is given,
-all entries for the specified generic name will be unlocked.
-.
-Syntax: UNLOCK GENERIC-NAME KEY-SERIAL-NUMBER <CHOPT>
-*----------------------------------------------------------------
->Menu \ADD
->Guidance
-Commands to add entries to the FATMEN catalogue
-
-*----------------------------------------------------------------
->Command TAPE
->Guidance
-Use the ADD/TAPE command to add a new tape file to the FATMEN catalogue.
->Action FMKADT
->Parameters
-VSN 'volume serial number' C D=' '
-VID 'visual identifier' C D='VSN'
-FSEQ 'file sequence number' I D=1
-GNAME 'generic file name' C D=' '
-DSN 'dataset name' C D=' '
-FFORM 'file format (FZ, FA, FX, RZ, EP, UN, AS)' C D='UN'
-CPLEV 'copy level (0=original, 1=copy etc.)' I D=0
-HOSTN 'host name (e.g. CERNVM)' C D='THISNODE'
-+
-COMM 'comment (in SINGLE quotes)' C D='Added via FATMEN CLI'
-RECFM 'record format (e.g. FB, VBS)' C D=' '
-LRECL 'record length (in words)' I D=0
-BLOCK 'block length (in words)' I D=0
-FSIZE 'file size (in megabytes)' I D=0
-MED*IA 'media type (2=3480,3=3420,4=8200,...)' I D=2
-LOC*COD 'location code' I D=1
-USER1 'user word 1 ' I D=0
-USER2 'user word 2 ' I D=0
-USER3 'user word 3 ' I D=0
-USER4 'user word 4 ' I D=0
-USER5 'user word 5 ' I D=0
-USER6 'user word 6 ' I D=0
-USER7 'user word 7 ' I D=0
-USER8 'user word 8 ' I D=0
-USER9 'user word 9 ' I D=0
-USER10 'user word 10' I D=0
-*----------------------------------------------------------------
->Command DISK
->Guidance
-Use the ADD/DISK command to add a new disk file to the FATMEN catalogue.
->Action FMKADD
->Parameters
-GNAME 'generic file name' C D=' '
-DSN 'disk dataset name' C D=' '
-FFORM 'file format (FZ, FA, FX, RZ, EP, UN, AS)' C D='UN'
-CPLEV 'copy level (0=original, 1=copy etc.)' I D=0
-HOSTN 'host name (e.g. CERNVM)' C D='thisnode'
-+
-COMM 'comment (in quotes)' C D='Added via FATMEN CLI'
-RECFM 'record format (e.g. FB, VBS)' C D=' '
-LRECL 'record length (in words)' I D=0
-BLOCK 'block length (in words)' I D=0
-FSIZE 'file size (in megabytes)' I D=0
-LOC*COD 'location code' I D=1
-USER1 'user word 1 ' I D=0
-USER2 'user word 2 ' I D=0
-USER3 'user word 3 ' I D=0
-USER4 'user word 4 ' I D=0
-USER5 'user word 5 ' I D=0
-USER6 'user word 6 ' I D=0
-USER7 'user word 7 ' I D=0
-USER8 'user word 8 ' I D=0
-USER9 'user word 9 ' I D=0
-USER10 'user word 10' I D=0
-*----------------------------------------------------------------
->Menu \SET
->Guidance
-Commands to set FATMEN options
-
-*----------------------------------------------------------------
->Command Location
->Guidance
-Use the SET/LOCATION command to define the list of location codes
-to be used to select datasets. Only datasets with a location code
-in the specified range will be visible via LS commands, or accessible
-through FIND or MAKE commands.
-.
-e.g.
-.
-set/loc 1,3,5-17 # set location codes
-.
-set/loc -1 # Clear location codes
->Action FMKLOC
->Parameters
-RANGE 'range of location codes' C D='-1'
-*----------------------------------------------------------------
->Command DATAREP
->Guidance
-Use the SET/DATAREP command to define the list of data representation
-codes
-to be used to select datasets. Only datasets with a data representation
-in the specified range will be visible via LS commands, or accessible
-through FIND or MAKE commands.
-.
-e.g.
-.
-set/datarep 1,3,5-17 # set
-.
-set/datarep -1 # Clear
->Action FMKCPL
->Parameters
-RANGE 'range of data representation values' C D='-1'
-*----------------------------------------------------------------
->Command COPYLEVEL
->Guidance
-Use the SET/COPYLEVEL command to define the list of copy levels
-to be used to select datasets. Only datasets with a copy levels
-in the specified range will be visible via LS commands, or accessible
-through FIND or MAKE commands.
-.
-e.g.
-.
-set/copylevel 1,3,5-17 # set copy levels
-.
-set/copylevel -1 # Clear copy levels
->Action FMKCPL
->Parameters
-RANGE 'range of copy levels' C D='-1'
-*----------------------------------------------------------------
->Command MEDIATYPE
->Guidance
-Use the SET/MEDIATYPE command to define the list of media types
-to be used to select datasets. Only datasets with a media type
-in the specified range will be visible via LS commands, or accessible
-through FIND or MAKE commands.
-.
-e.g.
-.
-set/mediatype 1,3,5-17 # set media types
-.
-set/mediatype -1 # Clear media types
->Action FMKMTP
->Parameters
-RANGE 'range of media types' C D='-1'
-*----------------------------------------------------------------
->Command VERIFY
->Guidance
-Use the SET/VERIFY command to turn verification of FATMEN updates
-on/off. If verification is turned off, updates are still checked,
-and so warning messages are still displayed.
-.
->Action FMKVER
->Parameters
-+
-OPTION C 'Option' D='ON' R='ON,OFF'
-*----------------------------------------------------------------
->Command USERWORDS
->Guidance
-Use the SET/USERWORDS command to define the ranges for the user
-words that will be used in subsequent SEARCH commands.
-.
-e.g.
-.
-set/user 1-10 3 5 17 99-103 6 72 777 888-999 42
->Action FMKUWD
->Parameters
-+
-UWORD1 'range or value for user word 1 ' C D=' '
-UWORD2 'range or value for user word 2 ' C D=' '
-UWORD3 'range or value for user word 3 ' C D=' '
-UWORD4 'range or value for user word 4 ' C D=' '
-UWORD5 'range or value for user word 5 ' C D=' '
-UWORD6 'range or value for user word 6 ' C D=' '
-UWORD7 'range or value for user word 7 ' C D=' '
-UWORD8 'range or value for user word 8 ' C D=' '
-UWORD9 'range or value for user word 9 ' C D=' '
-UWORD10 'range or value for user word 10 ' C D=' '
-
-*----------------------------------------------------------------
->Command DESTINATION
->Guidance
-Use the SET/DESTINATION command to set the current destination site
-for CHEOPS transfers.
->Action FMKDST
->Parameters
-DEST 'destination site' C D=' '
-
-*----------------------------------------------------------------
->Command SOURCE
->Guidance
-Use the SET/SOURCE command to set the current source site for
-CHEOPS transfers.
->Action FMKSRC
->Parameters
-SOURCE 'source site' C D=' '
-
-*----------------------------------------------------------------
->Command LOCCODES
->Guidance
-Use the SET/LOCCODES command to load location code definitions
-from the specified file.
->Action FMKLCC
->Parameters
-FILE 'definition file' C D=' '
-
-*----------------------------------------------------------------
->Menu \SHOW
->Guidance
-Commands to show FATMEN options
-
-*----------------------------------------------------------------
->Command Catalogues
->Guidance
-Use the SHOW/CATALOGUES command to display a list of available
-FATMEN catalogues.
->Action FMSCAT
-
-*----------------------------------------------------------------
->Command Loccodes
->Guidance
-Use the SHOW/LOCCODES command to show the list of location codes
-and their meanings, as defined in the file FATMEN.LOCCODES or the
-user definitions loaded using SET/LOCCODES.
->Action FMSLCC
-
-*----------------------------------------------------------------
->Command Location
->Guidance
-Use the SHOW/LOCATION command to show the list of location codes
-that are currently in effect. Only datasets with a location code
-in the displayed range will be visible via LS commands, or accessible
-through FIND or MAKE commands.
->Action FMSLOC
-*----------------------------------------------------------------
->Command DATAREP
->Guidance
-Use the SHOW/DATAREP command to show the list of data representations
-that are currently in effect. Only datasets with a data representation
-in the displayed range will be visible via LS commands, or accessible
-through FIND or MAKE commands.
->Action FMSCPL
-*----------------------------------------------------------------
->Command COPYLEVEL
->Guidance
-Use the SHOW/COPYLEVEL command to show the list of copy levels
-that are currently in effect. Only datasets with a copy level
-in the displayed range will be visible via LS commands, or accessible
-through FIND or MAKE commands.
->Action FMSCPL
-*----------------------------------------------------------------
->Command MEDIATYPE
->Guidance
-Use the SHOW/MEDIATYPE command to show the list of media types
-that are currently in effect. Only datasets with a media type
-in the displayed range will be visible via LS commands, or accessible
-through FIND or MAKE commands.
->Action FMSMTP
-*----------------------------------------------------------------
->Command USERWORDS
->Guidance
-Use the SHOW/USERWORDS command to show the list of ranges for
-the 10 user words that are currently in effect.
-Only entries which match the current user word ranges will
-be found be the SEARCH command.
->Action FMSUWD
-
-*----------------------------------------------------------------
->Command DESTINATION
->Guidance
-Use the SHOW/DESTINATION command to show current destination site
-for CHEOPS transfers
->Action FMSDST
-
-*----------------------------------------------------------------
->Command SOURCE
->Guidance
-Use the SHOW/SOURCE command to show current source site for
-CHEOPS transfers
->Action FMSSRC
-*----------------------------------------------------------------
->Command VERIFY
->Guidance
-Use the SHOW/VERIFY command to display whether verification of
-FATMEN updates is turned on or off. If verification is turned off,
-updates are still checked, and so warning messages are still displayed.
-.
->Action FMSVER
-*----------------------------------------------------------------
->Command UPDATES
->Guidance
-Use the SHOW/UPDATES command to show how many catalogue updates
-have been queued, and how many tokens remain
->Action FMSUPD
diff --git a/src/packlib/fatmen/programs/fmkuip/fmclr.F b/src/packlib/fatmen/programs/fmkuip/fmclr.F
deleted file mode 100644
index 572f4eb..0000000
--- a/src/packlib/fatmen/programs/fmkuip/fmclr.F
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: fmclr.F,v 1.1.1.1 1996/03/07 15:17:42 mclareni Exp $
-*
-* $Log: fmclr.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:42 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMCLR
-#if defined(CERNLIB_IBMVM)
- CALL VMCMS('VMFCLEAR',IRET)
-#endif
-#if defined(CERNLIB_UNIX)
- INTEGER SYSTEMF
- IC = SYSTEMF('clear')
-#endif
- END
-
diff --git a/src/packlib/fatmen/programs/fmkuip/fmcopc.F b/src/packlib/fatmen/programs/fmkuip/fmcopc.F
deleted file mode 100644
index ef3cd47..0000000
--- a/src/packlib/fatmen/programs/fmkuip/fmcopc.F
+++ /dev/null
@@ -1,371 +0,0 @@
-*
-* $Id: fmcopc.F,v 1.1.1.1 1996/03/07 15:17:42 mclareni Exp $
-*
-* $Log: fmcopc.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:42 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMCOPC
-#include "fatmen/fmpath.inc"
-#include "fatmen/fatran.inc"
-#include "fatmen/fatsat.inc"
-#include "fatmen/fatbank.inc"
-#include "fatmen/fatpara.inc"
-#include "fatmen/fatoptd.inc"
-#include "fatmen/fatsys.inc"
-#include "fatmen/fatusr.inc"
- CHARACTER*255 GENAM,GNAME,GENAM2
- PARAMETER (LKEYFA=10)
- DIMENSION KEYS1(LKEYFA),KEYS2(LKEYFA)
- CHARACTER*15 VID
- CHARACTER*6 VSN
- CHARACTER*255 FILE
- CHARACTER*8 NODE
- CHARACTER*8 POOL
- CHARACTER*8 LIBRARY
- CHARACTER*8 CHOPT,CHOPC
- CHARACTER*8 MEDIA,DENS,COMPACT
- CHARACTER*8 CHHOST,CHTYPE,CHSYS
- CHARACTER*8 CHTRANS
- INTEGER FMHOST,FMNODE
- INTEGER FSEQ
- SAVE CHHOST,CHTYPE,CHSYS,NENTRY
- SAVE LHOST ,LTYPE ,LSYS
- DATA MEDIA/'3480'/,DENS/'38K'/,COMPACT/' '/
- DATA NENTRY/0/
-#include "fatmen/fatinit.inc"
-
- IF(NENTRY.EQ.0) THEN
- IC = FMHOST(CHHOST,CHTYPE,CHSYS)
- CALL CLTOU(CHHOST)
- CALL CLTOU(CHTYPE)
- CALL CLTOU(CHSYS)
- LHOST = LENOCC(CHHOST)
- LTYPE = LENOCC(CHTYPE)
- LSYS = LENOCC(CHSYS)
- NENTRY = 1
- ENDIF
-*
-* This routine performs copy functions in the following way:
-*
-* COPY GENAM KS1 KS2 # both entries are assumed to be in the catalogue
-* COPY GENAM [KS1] POOL= LIBRARY = # copy entry to tape allocated from
-* named pool in named library
-* COPY GENAM [KS1] VID= # copy entry to named VID (prefix.vid)
-* COPY GENAM [KS1] NODE= [FILE=] # copy entry to specified node
-*
-* Options for FMALLO: MEDIA, DENS and COMPACT currently not supported
-* (nor multi-file option: M)
-*
-* Save current directory
-*
- CALL RZCDIR(CDIR,'R')
- LCDIR = LENOCC(CDIR)
-*
-* Get command arguments
-*
- GENAM = ' '
- KS1 = 0
- KS2 = 0
- POOL = ' '
- NODE = ' '
- FILE = ' '
- VSN = ' '
- VID = ' '
- CHOPT = ' '
- LFILE = 0
- LNODE = 0
- CALL KUGETC(GENAM,LGN)
- CALL FMFIXF(GENAM,GNAME)
- LGN = LENOCC(GNAME)
- GENAM(1:LGN) = GNAME(1:LGN)
- CALL KUGETI(KS1)
- CALL KUGETI(KS2)
- CALL KUGETC(POOL,LPOOL)
- CALL KUGETC(LIBRARY,LLIB)
- CALL KUGETC(VSN,LVSN)
- CALL KUGETC(VID,LVID)
- CALL KUGETI(FSEQ)
- CALL KUGETC(NODE,LNODE)
- CALL KUGETC(FILE,LFILE)
- CALL KUGETC(CHTRANS,LTRANS)
- CALL KUGETI(ILOC)
- CALL KUGETI(ICOP)
- CALL KUGETI(IMED)
- CALL KUGETC(CHOPT,LCH)
- IF(LCH.EQ.0) THEN
- CHOPT = ' '
- LCH = 1
- ENDIF
-
-
- IF((LVSN.EQ.0).AND.(LVID.NE.0)) THEN
- VSN = VID
- LVSN = LVID
- ENDIF
-*
-* Parse options...
-*
- CALL UOPTC(CHOPT,ALFNUM,IOPT)
-*
- CHOPC = ' '
- LOPTC = 1
-
- IF(IOPTC.NE.0) THEN
- CHOPC(LOPTC:LOPTC) = 'C'
- LOPTC = LOPTC + 1
- ENDIF
-*
- IF(IOPTS.NE.0) THEN
- CHOPC(LOPTC:LOPTC) = 'S'
- LOPTC = LOPTC + 1
- ENDIF
-*
- IF(IOPTZ.NE.0) THEN
- CHOPC(LOPTC:LOPTC) = 'Z'
-* LOPTC = LOPTC + 1
- ENDIF
-*
- CALL VZERO(KEYS1,10)
- CALL VZERO(KEYS2,10)
- KEYS1(1) = KS1
- KEYS2(1) = KS2
- LBANK1 = 0
- LADDBK = 0
-*
-* Get input bank
-*
- CALL FMGBYK(GENAM(1:LGN),LBANK1,KEYS1,IRET)
- IF(IRET.NE.0) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMCOPC. error in FMGBYK'
- RETURN
- ENDIF
-*
-* Lift bank for output file, or read from FATMEN catalogue
-*
- IF(KS2.EQ.0) THEN
- CALL FMBOOK(GENAM(1:LGN),KEYS2,LADDBK,LSUP,2,IRET)
-*
-* Copy file name
-*
- CALL UCOPY(IQ(LBANK1+KOFUFA+MFQNFA),
- + IQ(LADDBK+KOFUFA+MFQNFA),NFQNFA/4)
-*
-* Copy file area and creation date...
-*
- CALL UCOPY(IQ(LBANK1+KOFUFA+MSRDFA),
- + IQ(LADDBK+KOFUFA+MSRDFA),MCRTFA-MSRDFA+1)
-*
-* Copy system and user area...
-*
- CALL UCOPY(IQ(LBANK1+KOFUFA+MFPRFA),
- + IQ(LADDBK+KOFUFA+MFPRFA),NWDSFA-MFPRFA+1)
-*
-* Keys
-*
- IF(ILOC.NE.0) THEN
- KEYS2(MKLCFA) = ILOC
- IQ(LADDBK+KOFUFA+MLOCFA) = ILOC
- ENDIF
-
- IF(ICOP.NE.0) THEN
- KEYS2(MKCLFA) = ICOP
- IQ(LADDBK+KOFUFA+MCPLFA) = ICOP
- ENDIF
-
- IF(IMED.NE.0) THEN
- KEYS2(MKMTFA) = IMED
- IQ(LADDBK+KOFUFA+MMTPFA) = IMED
- ENDIF
-
- ELSE
- CALL FMGBYK(GENAM(1:LGN),LADDBK,KEYS2,IRET)
- IF(IRET.NE.0) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMCOPC. return code ',IRET,
- + 'from FMGBYK'
- RETURN
- ENDIF
- ENDIF
-*
-* Now decide what we have to do...
-*
- IF((LPOOL.NE.0).AND.(LLIB.NE.0)) THEN
-*
-* Copy to tape from named pool
-*
- IQ(LADDBK+MMTPFA+KOFUFA) = 2
- KEYS2(MKMTFA) = 2
- IF(IDEBFA.GE.0) PRINT *,'FMCOPC. Copy to tape allocated '
- + //'from ', 'pool ',POOL(1:LPOOL),' in library ',LIBRARY(1:
- + LLIB)
-*
-* Allocate new tape
-*
- CALL FMALLO(MEDIA,DENS,COMPACT,LIBRARY(1:LLIB),POOL(1:
- + LPOOL), LADDBK,' ',VSN,VID,IRET)
- IF(IRET.NE.0) THEN
- PRINT *,'FMCOPC. unable to allocate a new tape'
- GOTO 99
- ENDIF
- ELSEIF((LPOOL.NE.0).AND.(LLIB.EQ.0)) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMCOPC. Library name must be '
- + //'specified ', 'if pool is given.'
- GOTO 99
-
- ELSEIF((LPOOL.EQ.0).AND.(LLIB.NE.0)) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMCOPC. Pool name must be '
- + //'specified ', 'if library is given.'
- GOTO 99
-
- ELSEIF(LVID.NE.0) THEN
-*
-* Copy to specified VID
-*
- IF(IDEBFA.GE.0) PRINT *,'FMCOPC. Copy to tape ',VID(1:LVID)
-*
-* Obtain tape details from TMS, add to FATMEN bank and then
-* call FMCOPY. VID maybe in extended VID format. In all
-* cases, it is also added to the bank (if LBANK/=0)
-*
- IF(IMED.EQ.0) THEN
- IQ(LADDBK+MMTPFA+KOFUFA) = 2
- KEYS2(MKMTFA) = 2
- ENDIF
- CALL UCTOH(VID,IQ(LADDBK+KOFUFA+MVIDFA),4,6)
- IQ(LADDBK+KOFUFA+MFSQFA) = FSEQ
- IF(LVSN.EQ.0) THEN
- CALL FMGTMS(VID,LADDBK,VSN,IDENS,IMEDIA,IRET)
- ELSE
- CALL UCTOH(VSN,IQ(LADDBK+KOFUFA+MVSNFA),4,6)
- ENDIF
-
- ELSEIF(LNODE.NE.0) THEN
-*
-* Allow node=*
-*
- IF(NODE(1:LNODE).EQ.'*') THEN
- NODE = CHHOST(1:LHOST)
- LNODE = LHOST
- ENDIF
-*
-* Copy to remote node
-*
- IF(IDEBFA.GE.0) PRINT *,'FMCOPC. Copy to node ',NODE(1:
- + LNODE)
-*
-* Is the node specified local or remote?
-*
- IREMOTE = FMNODE(NODE(1:LNODE))
-
- CALL VBLANK(IQ(LADDBK+KOFUFA+MHSNFA),NHSNFA/4)
- IF(IREMOTE.EQ.0) THEN
- CALL VBLANK(IQ(LADDBK+KOFUFA+MHSTFA),2)
- CALL UCTOH(CHTYPE,IQ(LADDBK+KOFUFA+MHSTFA),4,LTYPE)
- CALL UCTOH(CHSYS ,IQ(LADDBK+KOFUFA+MHOSFA),4,LSYS)
- ENDIF
- CALL UCTOH(NODE,IQ(LADDBK+KOFUFA+MHSNFA),4,LNODE)
- IF(KS2.EQ.0.AND.IMED.EQ.0) THEN
- IQ(LADDBK+MMTPFA+KOFUFA) = 1
- KEYS2(MKMTFA) = 1
- ELSE
- IF(IDEBFA.GE.0) PRINT *,'FMCOPC. Copy from KS1 to KS2',
- + KS1,KS2
- ENDIF
- ELSEIF(KS2.NE.0) THEN
-*
-* Copy according to entries in FATMEN catalogue
-*
- IF(IDEBFA.GE.0) PRINT *,'FMCOPC. Copy from KS1 to KS2',KS1,
- + KS2
- ELSE
- PRINT *,'FMCOPC. Unknown copy options. You can copy to:'
- PRINT *,'- a tape allocated from a pool in a TMS library'
- PRINT *,'- a specified VID'
- PRINT *,'- a specified node (file) '
- PRINT *,'- the location indicated by an existing catalogue '
- + //'entry'
- GOTO 99
- ENDIF
-*
-* Set use count
-*
- IQ(LADDBK+KOFUFA+MUSCFA) = 1
-*
-* Fill in file name if specified
-*
- IF(LFILE.NE.0) THEN
- CALL VBLANK(IQ(LADDBK+KOFUFA+MFQNFA),NFQNFA/4)
- CALL UCTOH(FILE,IQ(LADDBK+KOFUFA+MFQNFA),4,LFILE)
- ELSE
- IF((KEYS1(MKMTFA).NE.KEYS2(MKMTFA)).AND.
- + (KEYS1(MKMTFA).EQ.1.OR.KEYS2(MKMTFA).EQ.1)) THEN
- PRINT *,'FMCOPC. Error - filename must be given when',
- + ' copying from disk to tape or vice versa'
- GOTO 99
- ENDIF
- ENDIF
-*
-* Verify input and output banks
-*
- CALL FMVERI(GENAM(1:LGN),LBANK1,KEYS1,'A',IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMCOPC. errors in input bank'
- GOTO 99
- ENDIF
-
- CALL FMVERI(GENAM(1:LGN),LADDBK,KEYS2,'A',IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMCOPC. errors in output bank'
- GOTO 99
- ENDIF
-*
-* Transport type
-*
- ITRANS = 0
- IF(LTRANS.GT.0) THEN
- ITRANS = ICNTH(CHTRANS(1:LTRANS),CHTRNS,NTRANS)
- IF(ITRANS.EQ.0) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMCOPC. unknown transport ',
- + CHTRANS(1:LTRANS)
- ELSE
- IF(IDEBFA.GE.0) PRINT *,'FMCOPC. transport set to ',
- + TRANSP(ITRANS)
- CHTRANS = TRANSP(ITRANS)
- LTRANS = LENOCC(CHTRANS)
- IF(CHTRANS(1:LTRANS).EQ.'CHEOPS') THEN
- IF(LDSTST.EQ.0.OR.LSRCST.EQ.0) THEN
- PRINT *,'FMCOPC. error - you must set the ',
- + 'source and destination sites'
- PRINT *,'FMCOPC. use the commands SET/SOURCE',
- + ' and SET/DESTINATION'
- RETURN
- ENDIF
- LOPTC = LOPTC + 1
- CHOPC(LOPTC:LOPTC) = 'K'
- ENDIF
- ENDIF
- ENDIF
-*
-* Now we know what to do - call the copy routine
-*
- IF(IDEBFA.GE.3) CALL FMSHOW(GENAM(1:LGN),LADDBK,KEYS2,'A',
- + IRET)
- IF(IDEBFA.GE.3) PRINT *,'FMCOPC. call FMCOPY for ',
- + GENAM(1:LGN),' ',CHOPC(1:LOPTC)
-
- GENAM2 = GENAM(1:LGN)
- CALL FMCOPY(GENAM(1:LGN),LBANK1,KEYS1, GENAM2(1:LGN),LADDBK,
- + KEYS2,CHOPC(1:LOPTC),IRC)
- IF(IRC.NE.0) THEN
- PRINT *,'FMCOPC. return code ',IRC,' from FMCOPY'
- ELSE
- IF(IOPTL.NE.0) CALL FMLOCK(GENAM(1:LGN),LBANK1,KEYS1,' ',IC)
- ENDIF
- 99 CONTINUE
-*
-* Reset current directory
-*
- CALL RZCDIR(CDIR(1:LCDIR),' ')
- END
diff --git a/src/packlib/fatmen/programs/fmkuip/fmcpc.F b/src/packlib/fatmen/programs/fmkuip/fmcpc.F
deleted file mode 100644
index 0866845..0000000
--- a/src/packlib/fatmen/programs/fmkuip/fmcpc.F
+++ /dev/null
@@ -1,189 +0,0 @@
-*
-* $Id: fmcpc.F,v 1.1.1.1 1996/03/07 15:17:42 mclareni Exp $
-*
-* $Log: fmcpc.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:42 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMCPC
- CHARACTER*255 FTEMP
- CHARACTER*255 CHDIR
-#include "fatmen/faust.inc"
-#include "fatmen/fmpath.inc"
-#include "fatmen/fatbank.inc"
-#include "fatmen/fatpara.inc"
-#include "fatmen/fmnkeys.inc"
-#include "fatmen/fmaxcop.inc"
-#include "fatmen/fatsys.inc"
- DIMENSION KEYS(LKEYFA)
- DIMENSION KEYSIN(LKEYFA)
- DIMENSION KEYSOU(LKEYFA,MAXCOP)
- CHARACTER*20 FNAME
- CHARACTER*15 XVID
- CHARACTER*6 VSN,VID
- CHARACTER*8 HOST,VIP
- CHARACTER*255 DSN
-#include "fatmen/fatinit.inc"
-*
-* Save current directory
-*
- CALL RZCDIR(CHDIR,'R')
- LCDIR = LENOCC(CHDIR)
- CALL KUGETC(FILE1,LFILE1)
- CALL KUGETC(FILE2,LFILE2)
- IF((LFILE1.EQ.0).OR.(LFILE2.EQ.0)) RETURN
- CALL FMFIXF(FILE1,FTEMP)
- FILE1 = FTEMP
- LFILE1 = LENOCC(FILE1)
- CALL FMFIXF(FILE2,FTEMP)
- FILE2 = FTEMP
- LFILE2 = LENOCC(FILE2)
- CALL KUGETI(KSN)
-*
-* Allow user to change keys, tape or disk details
-*
- CALL KUGETI(JLOC)
- CALL KUGETI(JDAT)
- CALL KUGETI(JMED)
-
- CALL KUGETC(VSN,LVSN)
- CALL KUGETC(XVID,LVID)
- IF(LVID.NE.0) THEN
- CALL FMXVID(VID,JP,XVID,VIP,'I',IRC)
- LVID = LENOCC(VID)
- ENDIF
- CALL KUGETI(JFILE)
-
- CALL KUGETC(DSN,LDSN)
- CALL KUGETC(HOST,LHOST)
-
- IF(IDEBFA.GE.0) THEN
- PRINT *,'FMCPC. source: ',FILE1(1:LFILE1)
- PRINT *,'FMCPC. target: ',FILE2(1:LFILE2)
- ENDIF
-
- IF(KSN.EQ.0) THEN
- CALL VZERO(KEYS,10)
- ELSE
- KEYS(1) = KSN
- ENDIF
-
- LPATH = INDEXB(FILE1(1:LFILE1),'/') -1
- FNAME = FILE1(LPATH+2:LFILE1)
- LNAME = LENOCC(FNAME)
-*
-* Check how many copies of this dataset exist
-*
- CALL UCOPY(KEYS,KEYSIN,10)
-*
-* Don't compare media type, copy level or location code
-*
- KEYSIN(MKMTFA) = -1
- KEYSIN(MKCLFA) = -1
- KEYSIN(MKLCFA) = -1
- CALL FMSELK(FILE1(1:LFILE1),KEYSIN,KEYSOU,NMATCH,MAXCOP,IRC)
- IF(NMATCH.EQ.0) THEN
- IF(IDEBFA.GE.0)
- + PRINT *,'FMCPC. found 0 matches for ',FILE1(1:LFILE1)
- IRC = 1
- GOTO 99
- ELSEIF(NMATCH.GT.1.AND.KEYS(1).EQ.0) THEN
- IF(IDEBFA.GE.0) THEN
- PRINT *,'FMCPC. found ',NMATCH,' matches for ',
- + FILE1(1:LFILE1)
- PRINT *,'FMCPC. Please specify which entry is to be moved'
- ENDIF
- IRC = 1
- GOTO 99
- ELSE
-
- IF(IDEBFA.GE.1)
- + PRINT *,'FMCPC. found ',NMATCH,' matches for ',FILE1(1:LFILE1)
-
- CALL UCOPY(KEYS,KEYSIN,10)
-
- IFOUND = 0
- DO 10 I=1,NMATCH
-*
-* Was a specific key serial number specified?
-*
- IF((KEYSIN(1).NE.KEYSOU(1,I)).AND.(KEYSIN(1).NE.0)) GOTO 10
-
- IFOUND = 1
- CALL UCOPY(KEYSOU(1,I),KEYS,10)
-
- IF(IDEBFA.GE.1) THEN
- PRINT *,'FMCPC. candidate number ',I
- CALL FMPKEY(KEYSOU(1,I),LKEYFA)
- ENDIF
-
- LTDSFA = 0
- CALL FMGETK(FILE1(1:LFILE1),LTDSFA,KEYSOU(1,I),IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMCPC. Return code ',IRC,' '
- + //'from FMGETK'
- GOTO 99
- ENDIF
-*
-* Override fields that were given
-*
- IF(JLOC.NE.0) THEN
- IQ(LTDSFA+KOFUFA+MLOCFA) = JLOC
- ENDIF
-
- IF(JDAT.NE.0) THEN
- IQ(LTDSFA+KOFUFA+MCPLFA) = JDAT
- ENDIF
-
- IF(JMED.NE.0) THEN
- IQ(LTDSFA+KOFUFA+MMTPFA) = JMED
- ENDIF
-*
-* Tape information
-*
- IF(LVID.GT.0) THEN
- CALL VBLANK(IQ(LTDSFA+KOFUFA+MVIDFA),NVIDFA/4)
- CALL UCTOH(VID,IQ(LTDSFA+KOFUFA+MVIDFA),4,LVID)
- IQ(LTDSFA+KOFUFA+MVIPFA) = JP
- ENDIF
-
- IF(LVSN.GT.0) THEN
- CALL VBLANK(IQ(LTDSFA+KOFUFA+MVSNFA),NVSNFA/4)
- CALL UCTOH(VSN,IQ(LTDSFA+KOFUFA+MVSNFA),4,LVSN)
- ENDIF
-
- IF(JFILE.NE.0) IQ(LTDSFA+KOFUFA+MFSQFA) = JFILE
-*
-* Disk information
-*
- IF(LDSN.GT.0) THEN
- CALL VBLANK(IQ(LTDSFA+KOFUFA+MFQNFA),NFQNFA/4)
- CALL UCTOH(DSN,IQ(LTDSFA+KOFUFA+MFQNFA),4,LDSN)
- ENDIF
-
- IF(LHOST.GT.0) THEN
- CALL VBLANK(IQ(LTDSFA+KOFUFA+MHSNFA),NHSNFA/4)
- CALL UCTOH(HOST,IQ(LTDSFA+KOFUFA+MHSNFA),4,LHOST)
- ENDIF
-*
-* Put new file
-*
- NFCPFL = NFCPFL + 1
- CALL FMPUT(FILE2(1:LFILE2),LTDSFA,JRC)
- CALL MZDROP(IDIVFA,LTDSFA,' ')
- LTDSFA = 0
- 10 CONTINUE
-
- ENDIF
-
- IF(KSN.NE.0.AND.IFOUND.EQ.0.AND.IDEBFA.GE.-2) PRINT *,'FMCPC. ',
- + ' no match found for ',PATH(1:LPATH),' key = ',KSN
-
- 99 CONTINUE
-*
-* Reset current directory
-*
- CALL RZCDIR(CHDIR(1:LCDIR),' ')
- END
diff --git a/src/packlib/fatmen/programs/fmkuip/fmdumc.F b/src/packlib/fatmen/programs/fmkuip/fmdumc.F
deleted file mode 100644
index 8021f68..0000000
--- a/src/packlib/fatmen/programs/fmkuip/fmdumc.F
+++ /dev/null
@@ -1,42 +0,0 @@
-*
-* $Id: fmdumc.F,v 1.1.1.1 1996/03/07 15:17:42 mclareni Exp $
-*
-* $Log: fmdumc.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:42 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMDUMC
-*
-* Request tape dump of VID corresponding to specified generic name
-*
-#include "fatmen/fmpath.inc"
-#include "fatmen/fatpara.inc"
-#include "fatmen/fatbug.inc"
-#include "fatmen/fatsys.inc"
- PARAMETER (LURCOR=200000)
- COMMON/CRZT/IXSTOR,IXDIV,IFENCE(2),LEV,LEVIN,BLVECT(LURCOR)
- DIMENSION LQ(999),IQ(999),Q(999)
- EQUIVALENCE (IQ(1),Q(1),LQ(9)),(LQ(1),LEV)
- PARAMETER (LKEYFA=10)
- DIMENSION KEYS(LKEYFA)
- CHARACTER*255 GENAM,GENAM1
- CHARACTER*8 CODE
-#include "fatmen/fatinit.inc"
- CALL KUGETC(GENAM,LGN)
- CALL FMFIXF(GENAM,GENAM1)
- LGN = LENOCC(GENAM1)
- GENAM = GENAM1
- CALL KUGETI(IKEY)
- CALL KUGETI(NBYTES)
- CALL KUGETI(NBLOCKS)
- CALL KUGETI(NFILES)
- CALL KUGETC(CODE,NC)
- CALL VZERO(KEYS,10)
- KEYS(1) = IKEY
- CALL FMDUMP(GENAM(1:LGN),KEYS,NBYTES,NBLOCKS,NFILES,CODE,IRC)
- IF(IRC.NE.0) PRINT *,'Return code ',IRC,' from FMDUMP'
-
- END
-
diff --git a/src/packlib/fatmen/programs/fmkuip/fmedit.F b/src/packlib/fatmen/programs/fmkuip/fmedit.F
deleted file mode 100644
index 8214db2..0000000
--- a/src/packlib/fatmen/programs/fmkuip/fmedit.F
+++ /dev/null
@@ -1,113 +0,0 @@
-*
-* $Id: fmedit.F,v 1.1.1.1 1996/03/07 15:17:42 mclareni Exp $
-*
-* $Log: fmedit.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:42 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMEDIT
-#include "fatmen/fmpath.inc"
-#include "fatmen/fatpara.inc"
-#include "fatmen/fatbug.inc"
-#include "fatmen/fatsys.inc"
- PARAMETER (LURCOR=200000)
- COMMON/CRZT/IXSTOR,IXDIV,IFENCE(2),LEV,LEVIN,BLVECT(LURCOR)
- DIMENSION LQ(999),IQ(999),Q(999)
- EQUIVALENCE (IQ(1),Q(1),LQ(9)),(LQ(1),LEV)
- PARAMETER (LKEYFA=10)
- DIMENSION KEYS(LKEYFA)
- CHARACTER*8 HNAME,HTYPE,HSYS,HDISK
- CHARACTER*8 USER,ADDR
- CHARACTER*4 MODE
- CHARACTER*256 DSN
- CHARACTER*20 CHFILE
- CHARACTER*80 LINE
- INTEGER FMHOST,FMNODE
-#include "fatmen/fatinit.inc"
- CALL KUGETC(PATH,LPATH)
- IF(LPATH.EQ.0) RETURN
- CALL FMFIXF(PATH,PATH)
- LPATH = LENOCC(PATH)
- CALL KUGETI(KSN)
- IF(KSN .EQ. 0) THEN
- CALL VZERO(KEYS,10)
- ELSE
- KEYS(1) = KSN
- ENDIF
-
- CALL FMGETK(PATH(1:LPATH),L,KEYS,IRC)
- IF (IRC .NE. 0) PRINT *,'Return code ',IRC,' from FMGETK'
-*
-* Disk files ...
-*
- IF (IQ(L+MMTPFA) .EQ. 1) THEN
-*
-* File is on disk. Check if it is on this node.
-*
- IC = FMHOST(HNAME,HTYPE,HSYS)
- CALL UHTOC(IQ(L+MHSNFA),4,HDISK,8)
- LDISK = LENOCC(HDISK)
-
- IF (FMNODE(HDISK(1:LDISK)).NE.0) THEN
- IF(IDEBFA.GE.2) WRITE (LPRTFA,9014) HDISK,HNAME
-9014 FORMAT(' FMEDIT. Disk file is on host ',A8,
- + ' current host = ',A8)
- IRC = 1
- RETURN
- ENDIF
- CALL UHTOC(IQ(L+MFQNFA),4,DSN,NFQNFA)
- LDSN = LENOCC(DSN)
- LBLANK = INDEX(DSN,' ')
- IF(LBLANK.NE.0) LDSN = LBLANK
-#if defined(CERNLIB_IBMVM)
-*
-* Get disk name and link to it
-*
-
- LSTA = INDEX(DSN,'<')
- IF (LSTA .NE. 0) THEN
-*
-* Format of DSN is <user.address>filename.filetype on VM
-*
- LDOT = INDEX(DSN,'.')
- LBRA = INDEX(DSN,'>')
-
- IF ((LDOT .NE. 0) .AND. (LDOT .LE. LBRA)) THEN
- LEND = LDOT
- ELSE
- LEND = LBRA
- ENDIF
-
- USER = DSN(LSTA+1:LEND-1)
- LUSR = LEND - LSTA + 1
- ADDR = ' '
-
- IF ((LDOT .NE. 0) .AND. (LDOT .LE. LBRA)) THEN
- ADDR= DSN(LDOT+1:LBRA-1)
- ENDIF
-
- CALL VMCMS('EXEC GIME '//USER(1:LUSR)//ADDR//
- + '(QUIET NONOTICE STACK)',IRC)
- CALL VMRTRM(LINE,LENGTH)
- MODE = LINE(1:1)
- IF(IDEBFA.GE.2) WRITE(LPRTFA,9015) USER,MODE
-9015 FORMAT(' FMEDIT. linked to ',A8,' mode ',A4)
- ELSE
- MODE = '*'
- ENDIF
- CHFILE = DSN(LBRA+1:LDSN) // ' ' // MODE(1:2)
-
- CALL KUEDIT(CHFILE,ISTAT)
-#endif
-#if !defined(CERNLIB_IBMVM)
- CALL KUEDIT(DSN(1:LDSN),ISTAT)
-#endif
- IF(ISTAT.NE.0) PRINT *,'Return code ',ISTAT,' from KUEDIT'
- ELSE
- PRINT *,'FMEDIT. Only local disk files currently supported'
- IRC = 3
- ENDIF
-
- END
diff --git a/src/packlib/fatmen/programs/fmkuip/fmexit.F b/src/packlib/fatmen/programs/fmkuip/fmexit.F
deleted file mode 100644
index 0b2e9c8..0000000
--- a/src/packlib/fatmen/programs/fmkuip/fmexit.F
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: fmexit.F,v 1.1.1.1 1996/03/07 15:17:42 mclareni Exp $
-*
-* $Log: fmexit.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:42 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMEXIT
-#include "fatmen/fatsys.inc"
-#include "fatmen/fatron.inc"
- IF (THRONG(1:4) .NE. 'NONE') THEN
-#if defined(CERNLIB_IBMVM)
- IF(SERMOD.NE.'A'.AND.SERMOD.NE.'?')
- + CALL VMCMS('EXEC DROP '//SERMOD,IRC)
-#endif
- CALL FMEND(IRC)
- ENDIF
- END
diff --git a/src/packlib/fatmen/programs/fmkuip/fmextr.F b/src/packlib/fatmen/programs/fmkuip/fmextr.F
deleted file mode 100644
index 607b626..0000000
--- a/src/packlib/fatmen/programs/fmkuip/fmextr.F
+++ /dev/null
@@ -1,74 +0,0 @@
-*
-* $Id: fmextr.F,v 1.1.1.1 1996/03/07 15:17:42 mclareni Exp $
-*
-* $Log: fmextr.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:42 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMEXTR
- CHARACTER*255 PATHI,CHPATH
- CHARACTER*64 CHFA
- CHARACTER*36 CHOPT
-#include "zebra/quest.inc"
-#include "fatmen/faexcm.inc"
-#include "fatmen/fatbug.inc"
-#include "fatmen/fmpath.inc"
-#include "fatmen/fatsys.inc"
- EXTERNAL FAEXTR
- DIMENSION IHDIR(4)
-#include "zebra/rzdir.inc"
-#include "fatmen/fatinit.inc"
-
- CALL RZCDIR(CDIR,'R')
- LCDIR = LENOCC(CDIR)
-
- CALL KUGETC(PATHI,LPATH)
- CALL FMFIXF(PATHI,PATH)
- LPATH = LENOCC(PATH)
- CALL KUGETC(CHFA,LFA)
- CALL KUGETC(CHOPT,LCHOPT)
-
- IF(LFA.EQ.0) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMEXTR. an output file name ',
- + 'must be specified'
- RETURN
- ENDIF
-
- IF(LCHOPT.EQ.0) THEN
- CHOPT = ' '
- LCHOPT = 1
- ENDIF
-
- CALL FMOPTC(CHOPT,ALFNUM,IOPT)
-
- IF(IDEBFA.GE.1) PRINT *,'FMEXTR. enter for path = ',
- + PATH(1:LPATH),' output file = ',CHFA(1:LFA),
- + ' options = ',CHOPT(1:LCHOPT)
-*
-* Open output file
-*
- CALL FAFILE(LUFZFA,CHFA(1:LFA),IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMEXTR. cannot open output file'
- GOTO 99
- ENDIF
-
- CALL FZFILE(LUFZFA,0,'FAO')
-
- CALL FZLOGL(LUFZFA,MAX(IDEBFA-1,-3))
-
- NFILES = 0
- NBAD = 0
-
- CALL FMLOOP(PATH(1:LPATH),99,FAEXTR,IRC)
-
- CALL FZENDO(LUFZFA,'TE')
-
- 99 CALL RZCDIR(CDIR(1:LCDIR),' ')
- CLOSE(LUFZFA)
- IF(IDEBFA.GE.0) PRINT *,'FMEXTR. processed ',NFILES,
- + ' files of which ',NBAD,' could not be found'
-
- END
diff --git a/src/packlib/fatmen/programs/fmkuip/fmfc.F b/src/packlib/fatmen/programs/fmkuip/fmfc.F
deleted file mode 100644
index ce328ce..0000000
--- a/src/packlib/fatmen/programs/fmkuip/fmfc.F
+++ /dev/null
@@ -1,125 +0,0 @@
-*
-* $Id: fmfc.F,v 1.1.1.1 1996/03/07 15:17:42 mclareni Exp $
-*
-* $Log: fmfc.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:42 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMFC
- CHARACTER*255 FILES,PATH,CHPATH,PREDIR
- CHARACTER*255 PATH2
-#include "fatmen/fatsys.inc"
-#include "fatmen/fatout.inc"
- CHARACTER*36 CHOPT
-#include "fatmen/fatbank.inc"
-#include "fatmen/fatpara.inc"
- LOGICAL IEXIST,IOPEN
-#include "fatmen/fafccm.inc"
- EXTERNAL FAFC
-#include "fatmen/fatinit.inc"
-*
- OUTPUT = ' '
- LOUT = 0
- LWRITE = LPRTFA
- CALL RZCDIR(PREDIR,'R')
- LDIR = LENOCC(PREDIR)
- CALL RZCDIR(PREDIR(1:LDIR),'U')
-
- PATH = ' '
- CALL KUGETC(PATH,LPATH)
- CALL KUGETC(OUTPUT,LOUT)
- CALL KUGETC(CHOPT,LCHOPT)
-
- CALL FMFIXF(PATH,PATH2)
- PATH = PATH2
- LPATH = LENOCC(PATH)
-
- IF(LCHOPT.EQ.0) THEN
- CHOPT = ' '
- LCHOPT = 1
- ENDIF
-
- LWRITE = LPRTFA
-*
-* Fix for strange KUIP behaviour...
-*
- IF(OUTPUT(1:1).EQ.'-') THEN
- CHOPT = OUTPUT
- LCHOPT = LOUT
- OUTPUT = 'TTY'
- LOUT = 3
- ENDIF
-
- IF((OUTPUT(1:LOUT).NE.'TTY').OR.(LOUT.EQ.0)) THEN
- LWRITE = 3
- IF(IDEBFA.GE.2)
- + PRINT *,'FMFC. output will be redirected to ',OUTPUT(1:LOUT)
- CALL FAFILE(LWRITE,OUTPUT(1:LOUT),IRET)
- IF(IRET.NE.0) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMFC. error ',IRET,
- + ' opening file ',OUTPUT(1:LOUT),
- + ' - output will be sent to the screen'
- LWRITE = LPRTFA
- OUTPUT = 'TTY'
- ENDIF
- ELSE
- OUTPUT = 'TTY'
- ENDIF
-*
- IF(INDEX(CHOPT(1:LCHOPT),'H').NE.0) THEN
- WRITE(LWRITE,*) '>>> Command: FC ',
- + 'Options: ',CHOPT(1:LCHOPT)
- WRITE(LWRITE,*) '>>> Path: ',PATH(1:LPATH)
- WRITE(LWRITE,*) '>>> Current directory: ',
- + PREDIR(1:LDIR)
- ENDIF
-*
-
- IOPTD = 0
- IOPTF = 0
- IOPTL = 0
- IOPTZ = 0
- IF(INDEX(CHOPT(1:LCHOPT),'D').NE.0) IOPTD = 1
- IF(INDEX(CHOPT(1:LCHOPT),'F').NE.0) IOPTF = 1
- IF(INDEX(CHOPT(1:LCHOPT),'L').NE.0) IOPTL = 1
- IF(INDEX(CHOPT(1:LCHOPT),'Z').NE.0) IOPTZ = 1
-
- IF(IOPTL.NE.0) IOPTD = 1
- IF(IOPTZ.NE.0) IOPTF = 1
-*
- NFOUND = 0
- NMATCH = 0
- NDIRT = 0
-*
-* Count number of files matching pattern
-*
- LSLASH = INDEXB(PATH(1:LPATH),'/')
- CHPATH = PATH(1:LSLASH-1)
- CHFILE = PATH(LSLASH+1:LPATH)
- LP = LENOCC(CHPATH)
- LF = LENOCC(CHFILE)
- IF(IDEBFA.GE.2) PRINT *,'FMFC. enter for ',PATH(1:LPATH)
-
- IF(ICFMUL('*%(<>[]',CHPATH,1,LP).GT.LP) THEN
- CALL RZCDIR(CHPATH(1:LP),' ')
- IQUEST(12) = IQUEST(9)
- IQUEST(14) = IQUEST(7)
- CALL FAFC(CHPATH(1:LP),IRC)
- ELSE
- CALL FMSCAN(CHPATH(1:LPATH),99,FAFC,IRC)
- ENDIF
-
- IF(IDEBFA.GE.-2) THEN
- WRITE(LWRITE,9001) NMATCH,NFOUND,NDIRT
- 9001 FORMAT(' Total of ',I8,' matches (',I8,' files) in ',I6,
- + ' directories')
- ENDIF
-
- INQUIRE(3,OPENED=IOPEN)
- IF(IOPEN) CLOSE(3)
-
- CALL RZCDIR(PREDIR(1:LDIR),' ')
- RETURN
- END
diff --git a/src/packlib/fatmen/programs/fmkuip/fmfndc.F b/src/packlib/fatmen/programs/fmkuip/fmfndc.F
deleted file mode 100644
index 7b60742..0000000
--- a/src/packlib/fatmen/programs/fmkuip/fmfndc.F
+++ /dev/null
@@ -1,90 +0,0 @@
-*
-* $Id: fmfndc.F,v 1.1.1.1 1996/03/07 15:17:42 mclareni Exp $
-*
-* $Log: fmfndc.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:42 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMFNDC
-#include "fatmen/fmpath.inc"
-#include "fatmen/fatsys.inc"
- CHARACTER*6 MODE
- CHARACTER*8 CHLUN
- CHARACTER*26 CHOPT
- CHARACTER*26 KOPT
-#include "fatmen/fatinit.inc"
- CALL KUGETC(FILE2,LFILE2)
- CALL KUGETC(CHLUN,LCH)
- CALL FMFIXF(FILE2,FILE1)
- LFILE1 = LENOCC(FILE1)
- CALL KUGETC(CHOPT,LOPT)
- IF(LOPT.EQ.0) CHOPT = ' '
- L = 0
-*
-* Build useful options string
-*
- KOPT = 'RU'
- LKOPT = 2
-
- IF(INDEX(CHOPT,'D').NE.0) THEN
- KOPT(LKOPT:LKOPT) = 'D'
- LKOPT = LKOPT + 1
- ENDIF
-
- IF(INDEX(CHOPT,'E').NE.0) THEN
- KOPT(LKOPT:LKOPT) = 'E'
- LKOPT = LKOPT + 1
- ENDIF
-
- IF(INDEX(CHOPT,'H').NE.0) THEN
- KOPT(LKOPT:LKOPT) = 'H'
- LKOPT = LKOPT + 1
- ENDIF
-
- IF(INDEX(CHOPT,'K').NE.0) THEN
- KOPT(LKOPT:LKOPT) = 'K'
- LKOPT = LKOPT + 1
- ENDIF
-
- IF(INDEX(CHOPT,'L').NE.0) THEN
- KOPT(LKOPT:LKOPT) = 'L'
- LKOPT = LKOPT + 1
- ENDIF
-
- IF(INDEX(CHOPT,'N').NE.0) THEN
- KOPT(LKOPT:LKOPT) = 'N'
- LKOPT = LKOPT + 1
- ENDIF
-
- IF(INDEX(CHOPT,'Q').NE.0) THEN
- KOPT(LKOPT:LKOPT) = 'Q'
- LKOPT = LKOPT + 1
- ENDIF
-
- IF(INDEX(CHOPT,'S').NE.0) THEN
- KOPT(LKOPT:LKOPT) = 'S'
- LKOPT = LKOPT + 1
- ENDIF
-
- IF(INDEX(CHOPT,'V').NE.0) THEN
- KOPT(LKOPT:LKOPT) = 'V'
- LKOPT = LKOPT + 1
- ENDIF
-
- IF(INDEX(CHOPT,'Y').NE.0) THEN
- KOPT(LKOPT:LKOPT) = 'Y'
- LKOPT = LKOPT + 1
- ENDIF
-*
-* Save current directory
-*
- CALL RZCDIR(CDIR,'R')
- LCDIR = LENOCC(CDIR)
- CALL FMOPEN(FILE1(1:LFILE1),CHLUN,L,KOPT,IRC)
-*
-* Reset current directory
-*
- CALL RZCDIR(CDIR(1:LCDIR),' ')
- END
diff --git a/src/packlib/fatmen/programs/fmkuip/fmgime.F b/src/packlib/fatmen/programs/fmkuip/fmgime.F
deleted file mode 100644
index 4b2ce2d..0000000
--- a/src/packlib/fatmen/programs/fmkuip/fmgime.F
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: fmgime.F,v 1.1.1.1 1996/03/07 15:17:42 mclareni Exp $
-*
-* $Log: fmgime.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:42 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMGIME
-#include "fatmen/fatsys.inc"
-#if (defined(CERNLIB_IBMVM))&&(!defined(CERNLIB_FATSRV))
-*
-* Relink to disk of service machine
-*
- CALL VMCMS('EXEC GIME '//SERNAM,IRC)
-#endif
- END
diff --git a/src/packlib/fatmen/programs/fmkuip/fminic.F b/src/packlib/fatmen/programs/fmkuip/fminic.F
deleted file mode 100644
index 61c647f..0000000
--- a/src/packlib/fatmen/programs/fmkuip/fminic.F
+++ /dev/null
@@ -1,107 +0,0 @@
-*
-* $Id: fminic.F,v 1.1.1.1 1996/03/07 15:17:43 mclareni Exp $
-*
-* $Log: fminic.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:43 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMINIC
-#include "fatmen/fmpath.inc"
-#include "fatmen/fatbug.inc"
- PARAMETER (LURCOR=200000)
- COMMON/CRZT/IXSTOR,IXDIV,IFENCE(2),LEV,LEVIN,BLVECT(LURCOR)
- DIMENSION LQ(999),IQ(999),Q(999)
- EQUIVALENCE (IQ(1),Q(1),LQ(9)),(LQ(1),LEV)
-#include "fatmen/fatusr.inc"
-#include "fatmen/fatsys.inc"
-#include "fatmen/fstate.inc"
-*
- COMMON /QUEST/IQUEST(100)
-*
- PARAMETER (LKEYFA=10)
- DIMENSION KEYS(LKEYFA)
- CHARACTER*8 CHTAG(10),RTIME
- CHARACTER*80 LINE
- DIMENSION LUNFAT(3)
-#include "fatmen/fatron.inc"
- SAVE NENTRY
- DATA NENTRY/0/
-
- IF((MFPHAS.NE.3).AND.(NENTRY.EQ.1)) THEN
- PRINT *,'FMINIC. Error - FATMEN has already been initialised'
- RETURN
- ENDIF
-
- IF(NENTRY.EQ.0) THEN
-*
-* Initialise ZEBRA
-*
- CALL MZSTOR(IXSTOR,'/CRZT/','Q',IFENCE,LEV,BLVECT(1),BLVECT(1),
- + BLVECT(5000),BLVECT(LURCOR))
- CALL MZLOGL(IXSTOR,-3)
-*
-* *** Define user division and link area like:
-*
- CALL MZDIV (IXSTOR, IXDIV, 'USERS', 50000, LURCOR, 'L')
- CALL MZLINK (IXSTOR, '/USRLNK/', LUSRK1, LUSRLS, LUSRK1)
-
- ENDIF
-*
-* Unit for RZ database
-*
- LUNRZ = 1
- LUNFZ = 2
- LPRTFA = 6
-
-* read mode
- LTOP = LENOCC(TOPDIR)
- CALL FMINIT(IXSTOR,LUNRZ,LUNFZ,
- + TOPDIR(1:LTOP)//'/'//THRONG(1:LTHR),IRC)
-*
-* Permit retry if GIME failed / catalogue not found
-*
- IF((IRC.EQ.104).OR.(IRC.EQ.28)) THEN
- PRINT *
- PRINT *,'FMINIC. Please retry with a valid FATMEN group'
- PRINT *,' This is typically the name of your experiment'
- PRINT *,' e.g. INIT L3'
- PRINT *
- NENTRY = -1
- THRONG = 'NONE'
- LTHR = 4
- RETURN
- ELSE
- NENTRY = 1
- ENDIF
-*
-* Set logical units
-*
- LUNFAT(1) = 8
- LUNFAT(2) = 9
- LUNFAT(3) = 4
- CALL FMSETU(LUNFAT,3,IRC)
-
-#if defined(CERNLIB_CERNVM)
- CALL FMONIT('Init FATMEN shell')
-#endif
- CALL FMLOGL(999)
-#if !defined(CERNLIB_CZ)
- CALL RZCDIR(TOPDIR(1:LTOP)//'/'//THRONG(1:LTHR),' ')
- CALL RZCDIR(TOPDIR(1:LTOP)//'/'//THRONG(1:LTHR),'P')
-#endif
-#if defined(CERNLIB_CZ)
- CALL CZPUTA('MESS :CD '//TOPDIR(1:LTOP)//'/'
- + //THRONG(1:LTHR),ISTAT)
-1 CONTINUE
- CALL CZGETA(LINE,ISTAT)
- PRINT *,LINE(3:80)
- IF (LINE(1:1) .EQ. '2') GOTO 1
-#endif
- CDIR = TOPDIR(1:LTOP)//'/'//THRONG(1:LTHR)
- LCDIR = LENOCC(CDIR)
- CALL KIPRMT('FM>')
-
- END
-
diff --git a/src/packlib/fatmen/programs/fmkuip/fmkadd.F b/src/packlib/fatmen/programs/fmkuip/fmkadd.F
deleted file mode 100644
index 3fef70b..0000000
--- a/src/packlib/fatmen/programs/fmkuip/fmkadd.F
+++ /dev/null
@@ -1,148 +0,0 @@
-*
-* $Id: fmkadd.F,v 1.1.1.1 1996/03/07 15:17:43 mclareni Exp $
-*
-* $Log: fmkadd.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:43 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMKADD
-#include "fatmen/faust.inc"
-#include "fatmen/fatpara.inc"
-#include "fatmen/fatbug.inc"
-#include "fatmen/fatsys.inc"
-#include "fatmen/fatloc.inc"
- PARAMETER (LURCOR=200000)
- COMMON/CRZT/IXSTOR,IXDIV,IFENCE(2),LEV,LEVIN,BLVECT(LURCOR)
- DIMENSION LQ(999),IQ(999),Q(999)
- EQUIVALENCE (IQ(1),Q(1),LQ(9)),(LQ(1),LEV)
-#include "fatmen/fatron.inc"
-#include "fatmen/fatusr.inc"
- COMMON /QUEST/IQUEST(100)
- CHARACTER*255 GNAME,DSN,CHPATH,GNAME2
- CHARACTER*255 PATHN
- CHARACTER*20 FNAME
- CHARACTER*4 FFORM
- CHARACTER*8 HOSTN
- INTEGER CPLEV,FSEQ
- CHARACTER*255 PREDIR
-#include "fatmen/fatvidp.inc"
- CHARACTER*4 RECFM
- INTEGER LRECL,BLOCK,FSIZE
- CHARACTER*80 COMM
- PARAMETER (LKEYFA=10)
- DIMENSION KEYS(LKEYFA)
- DIMENSION IVECT(10)
- DATA NENTRY/0/
- SAVE NENTRY
-#include "fatmen/fatinit.inc"
-*
-* Add a new file to the FATMEN file catalogue
-*
- CALL KUGETC(GNAME,LGNAME)
- IF(LGNAME.EQ.0) RETURN
-
- NFADDD = NFADDD + 1
-*
-* GNAME is in current directory, if full path name not specified
-*
-
- CALL FMFIXF(GNAME,GNAME2)
- GNAME = GNAME2
- LGNAME = LENOCC(GNAME)
- IF(IDEBFA.GE.0) PRINT *,GNAME(1:LGNAME)
-
- CALL KUGETS(DSN, LDSN)
- IF(LDSN.EQ.0) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMKADD. ',
- + 'Dataset name will be generated by FATMEN'
- CALL FMFNM(DSN)
- LDSN = LENOCC(DSN)
- ENDIF
- CALL KUGETC(FFORM,LFFORM)
- CALL KUGETI(CPLEV)
- CALL KUGETC(HOSTN,LHOSTN)
- CALL KUGETC(COMM,LCOMM)
- CALL KUGETC(RECFM,LRECFM)
- CALL KUGETI(LRECL)
- CALL KUGETI(BLOCK)
- CALL KUGETI(FSIZE)
- CALL KUGETI(LOCCOD)
- CALL KUGETI(IVECT(1))
- CALL KUGETI(IVECT(2))
- CALL KUGETI(IVECT(3))
- CALL KUGETI(IVECT(4))
- CALL KUGETI(IVECT(5))
- CALL KUGETI(IVECT(6))
- CALL KUGETI(IVECT(7))
- CALL KUGETI(IVECT(8))
- CALL KUGETI(IVECT(9))
- CALL KUGETI(IVECT(10))
-
-*
-* Save current directory
-*
- CALL RZCDIR(PREDIR,'R')
-
- IF(NENTRY.EQ.0) THEN
- JBIAS = 2
- CALL FMBOOK(GNAME,KEYS,LADDBK,LSUP,JBIAS,IRC)
- NENTRY = 1
- ELSE
- IQ(LADDBK+MMTPFA) = 1
- CALL FMFILL(GNAME,LADDBK,KEYS,'A',IRC)
- ENDIF
-*
-* Override various fields as required
-*
- IF(LDSN.GT.0) THEN
- CALL VBLANK(IQ(LADDBK+MFQNFA),NFQNFA/4)
- CALL UCTOH(DSN,IQ(LADDBK+MFQNFA),4,LDSN)
- ENDIF
-
- IF (HOSTN(1:8) .NE. 'THISNODE') THEN
- CALL VBLANK(IQ(LADDBK+MHSNFA),NHSNFA/4)
- CALL UCTOH(HOSTN,IQ(LADDBK+MHSNFA),4,LHOSTN)
- ENDIF
-
- CALL UCTOH(FFORM,IQ(LADDBK+MFLFFA),4,LFFORM)
- IQ(LADDBK+MCPLFA) = CPLEV
- IQ(LADDBK+MMTPFA) = 1
- IQ(LADDBK+MLOCFA) = LOCCOD
- KEYS(MKLCFA) = LOCCOD
- KEYS(MKCLFA) = CPLEV
-
- IF(NUMLOC.EQ.1) THEN
- IQ(LADDBK+MLOCFA) = MFMLOC(1)
- KEYS(MKLCFA) = MFMLOC(1)
- ENDIF
-
- CALL VBLANK(IQ(LADDBK+MUCMFA),NUCMFA/4)
- CALL UCTOH(COMM,IQ(LADDBK+MUCMFA),4,LCOMM)
-
- CALL UCTOH(RECFM,IQ(LADDBK+MRFMFA),4,LRECFM)
- IQ(LADDBK+MRLNFA) = LRECL
- IQ(LADDBK+MBLNFA) = BLOCK
- IQ(LADDBK+MFSZFA) = FSIZE
-*
-* Userwords
-*
- CALL UCOPY(IVECT(1),IQ(LADDBK+MUSWFA),10)
-*
-* Display entry
-*
- IF(IDEBFA.GE.3) THEN
- CALL FMUPKY(GNAME,LADDBK,KEYS,IRC)
- CALL FMSHOW(GNAME,LADDBK,KEYS,'A',IRC)
- ENDIF
-*
-* Output this entry
-*
- CALL FMPUT(GNAME,LADDBK,IRC)
-*
-* Reset current directory
-*
- CALL RZCDIR(PREDIR(1:LENOCC(PREDIR)),' ')
-
- END
diff --git a/src/packlib/fatmen/programs/fmkuip/fmkadt.F b/src/packlib/fatmen/programs/fmkuip/fmkadt.F
deleted file mode 100644
index 0fad5df..0000000
--- a/src/packlib/fatmen/programs/fmkuip/fmkadt.F
+++ /dev/null
@@ -1,177 +0,0 @@
-*
-* $Id: fmkadt.F,v 1.1.1.1 1996/03/07 15:17:43 mclareni Exp $
-*
-* $Log: fmkadt.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:43 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMKADT
-#include "fatmen/faust.inc"
-#include "fatmen/fatpara.inc"
-#include "fatmen/fatbug.inc"
-#include "fatmen/fatloc.inc"
- PARAMETER (LURCOR=200000)
- COMMON/CRZT/IXSTOR,IXDIV,IFENCE(2),LEV,LEVIN,BLVECT(LURCOR)
- DIMENSION LQ(999),IQ(999),Q(999)
- EQUIVALENCE (IQ(1),Q(1),LQ(9)),(LQ(1),LEV)
-#include "fatmen/fatron.inc"
-#include "fatmen/fatusr.inc"
- COMMON /QUEST/IQUEST(100)
- CHARACTER*255 GNAME,DSN,CHPATH,GNAME2
- CHARACTER*255 PATHN
- CHARACTER*20 FNAME
- CHARACTER*4 FFORM
- CHARACTER*8 HOSTN
- INTEGER CPLEV,FSEQ
- CHARACTER*6 VSN
- CHARACTER*15 VID
- CHARACTER*8 VIP
- CHARACTER*255 PREDIR
-#include "fatmen/fatvidp.inc"
- CHARACTER*4 RECFM
- INTEGER LRECL,BLOCK,FSIZE
- CHARACTER*80 COMM
- PARAMETER (LKEYFA=10)
- DIMENSION KEYS(LKEYFA)
- DIMENSION IVECT(10)
- DATA NENTRY/0/
- SAVE NENTRY
-*
-* Get tape specific parameters
-*
- CALL KUGETC(VSN,LVSN)
- IF(LVSN.EQ.0) RETURN
- CALL KUGETC(VID,LVID)
- IF (VID(1:LVID) .EQ. 'VSN') THEN
- VID = VSN
- LVID = LVSN
- ENDIF
-*
-* Has a VID prefix been given?
-*
- JVIDP = INDEX(VID(1:LVID),'.')
- IF(JVIDP.NE.0) THEN
- VIP = VID(1:JVIDP-1)
- LVIP = JVIDP - 1
- VID = VID(JVIDP+1:LVID)
- LVID = LVID-JVIDP
- JP = ICNTH(VIP(1:LVIP),PREVID,NTMS)
- ELSE
- JP = 0
- ENDIF
-
- CALL KUGETI(FSEQ)
-
-* Add a new file to the FATMEN file catalogue
-*
- CALL KUGETC(GNAME,LGNAME)
- IF(LGNAME.EQ.0) RETURN
-
- NFADDT = NFADDT + 1
-*
-* GNAME is in current directory, if full path name not specified
-*
- CALL FMFIXF(GNAME,GNAME2)
- GNAME = GNAME2
- LGNAME = LENOCC(GNAME)
- IF(IDEBFA.GE.0) PRINT *,GNAME(1:LGNAME)
-
- CALL KUGETC(DSN, LDSN)
- IF(LDSN.EQ.0) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMKADT. ',
- + 'Dataset name will be generated by FATMEN'
- CALL FMFNM(DSN)
- LDSN = LENOCC(DSN)
- ENDIF
- CALL KUGETC(FFORM,LFFORM)
- CALL KUGETI(CPLEV)
- CALL KUGETC(HOSTN,LHOSTN)
- CALL KUGETC(COMM,LCOMM)
- CALL KUGETC(RECFM,LRECFM)
- CALL KUGETI(LRECL)
- CALL KUGETI(BLOCK)
- CALL KUGETI(FSIZE)
- CALL KUGETI(MEDIA)
- CALL KUGETI(LOCCOD)
- CALL KUGETI(IVECT(1))
- CALL KUGETI(IVECT(2))
- CALL KUGETI(IVECT(3))
- CALL KUGETI(IVECT(4))
- CALL KUGETI(IVECT(5))
- CALL KUGETI(IVECT(6))
- CALL KUGETI(IVECT(7))
- CALL KUGETI(IVECT(8))
- CALL KUGETI(IVECT(9))
- CALL KUGETI(IVECT(10))
-*
-* Save current directory
-*
- CALL RZCDIR(PREDIR,'R')
-
- IF(NENTRY.EQ.0) THEN
- JBIAS = 2
- CALL FMBOOK(GNAME,KEYS,LADDBK,LSUP,JBIAS,IRC)
- NENTRY = 1
- ELSE
- CALL FMFILL(GNAME,LADDBK,KEYS,'A',IRC)
- ENDIF
-*
-* Override various fields as required
-*
- IF(LDSN.GT.0) THEN
- CALL VBLANK(IQ(LADDBK+MFQNFA),NFQNFA/4)
- CALL UCTOH(DSN,IQ(LADDBK+MFQNFA),4,LDSN)
- ENDIF
-
- IF (HOSTN(1:8) .NE. 'THISNODE') THEN
- CALL VBLANK(IQ(LADDBK+MHSNFA),NHSNFA/4)
- CALL UCTOH(HOSTN,IQ(LADDBK+MHSNFA),4,LHOSTN)
- ENDIF
-
- CALL UCTOH(FFORM,IQ(LADDBK+MFLFFA),4,LFFORM)
- IQ(LADDBK+MCPLFA) = CPLEV
- IQ(LADDBK+MLOCFA) = LOCCOD
- KEYS(MKCLFA) = CPLEV
-
- IF(NUMLOC.EQ.1) THEN
- IQ(LADDBK+MLOCFA) = MFMLOC(1)
- KEYS(MKLCFA) = MFMLOC(1)
- ENDIF
-
- CALL VBLANK(IQ(LADDBK+MUCMFA),NUCMFA/4)
- CALL UCTOH(COMM,IQ(LADDBK+MUCMFA),4,LCOMM)
-
- CALL UCTOH(RECFM,IQ(LADDBK+MRFMFA),4,LRECFM)
- IQ(LADDBK+MRLNFA) = LRECL
- IQ(LADDBK+MBLNFA) = BLOCK
- IQ(LADDBK+MFSZFA) = FSIZE
-
- CALL UCTOH(VSN,IQ(LADDBK+MVSNFA),4,LVSN)
- CALL UCTOH(VID,IQ(LADDBK+MVIDFA),4,LVID)
- IQ(LADDBK+MVIPFA) = JP
- IQ(LADDBK+MFSQFA) = FSEQ
-* IQ(LADDBK+MMTPFA) = 2
- IQ(LADDBK+MMTPFA) = MEDIA
-*
-* Userwords
-*
- CALL UCOPY(IVECT(1),IQ(LADDBK+MUSWFA),10)
-*
-* Display entry
-*
- IF(IDEBFA.GE.3) THEN
- CALL FMUPKY(GNAME,LADDBK,KEYS,IRC)
- CALL FMSHOW(GNAME,LADDBK,KEYS,'A',IRC)
- ENDIF
-*
-* Output this entry
-*
- CALL FMPUT(GNAME,LADDBK,IRC)
-*
-* Reset current directory
-*
- CALL RZCDIR(PREDIR(1:LENOCC(PREDIR)),' ')
-
- END
diff --git a/src/packlib/fatmen/programs/fmkuip/fmkatt.F b/src/packlib/fatmen/programs/fmkuip/fmkatt.F
deleted file mode 100644
index f132528..0000000
--- a/src/packlib/fatmen/programs/fmkuip/fmkatt.F
+++ /dev/null
@@ -1,168 +0,0 @@
-*
-* $Id: fmkatt.F,v 1.1.1.1 1996/03/07 15:17:43 mclareni Exp $
-*
-* $Log: fmkatt.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:43 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMKATT
-#include "fatmen/fatpara.inc"
-#include "fatmen/fatsys.inc"
-#include "fatmen/fatbug.inc"
-#include "fatmen/fatloc.inc"
-#include "fatmen/fattyp.inc"
- PARAMETER (LURCOR=200000)
- COMMON/CRZT/IXSTOR,IXDIV,IFENCE(2),LEV,LEVIN,BLVECT(LURCOR)
- DIMENSION LQ(999),IQ(999),Q(999)
- EQUIVALENCE (IQ(1),Q(1),LQ(9)),(LQ(1),LEV)
-#include "fatmen/fatron.inc"
-#include "fatmen/fatusr.inc"
- COMMON /QUEST/IQUEST(100)
- CHARACTER*255 GNAME,DSN,CHPATH,GNAME2
- CHARACTER*255 PATHN
- CHARACTER*20 FNAME
- CHARACTER*4 FFORM
- CHARACTER*8 HOSTN
- INTEGER CPLEV,FSEQ
- CHARACTER*8 POOL,LIB
- CHARACTER*6 VSN
- CHARACTER*15 VID
- CHARACTER*8 VIP
- CHARACTER*255 PREDIR
-#include "fatmen/fatvidp.inc"
- CHARACTER*4 RECFM
- INTEGER LRECL,BLOCK,FSIZE
- CHARACTER*80 COMM
- PARAMETER (LKEYFA=10)
- DIMENSION KEYS(LKEYFA)
- DATA NENTRY/0/
- SAVE NENTRY
-#include "fatmen/fatinit.inc"
-*
-* Get tape specific parameters
-*
- CALL KUGETC(POOL,LPOOL)
- IF(LPOOL.EQ.0) RETURN
- CALL KUGETC(LIB,LLIB)
- IF(LLIB.EQ.0) RETURN
-*
-* Add a new file to the FATMEN file catalogue
-*
- CALL KUGETC(GNAME,LGNAME)
- IF(LGNAME.EQ.0) RETURN
-*
-* GNAME is in current directory, if full path name not specified
-*
-
- CALL FMFIXF(GNAME,GNAME2)
- GNAME = GNAME2
- LGNAME = LENOCC(GNAME)
- IF(IDEBFA.GE.0) PRINT *,GNAME(1:LGNAME)
-
- CALL KUGETC(DSN, LDSN)
- IF(LDSN.EQ.0) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMKATT. ',
- + 'Dataset name will be generated by FATMEN'
- CALL FMFNM(DSN)
- LDSN = LENOCC(DSN)
- ENDIF
- CALL KUGETC(FFORM,LFFORM)
- CALL KUGETI(CPLEV)
- CALL KUGETC(HOSTN,LHOSTN)
- CALL KUGETC(COMM,LCOMM)
- CALL KUGETC(RECFM,LRECFM)
- CALL KUGETI(LRECL)
- CALL KUGETI(BLOCK)
- CALL KUGETI(FSIZE)
- CALL KUGETI(MEDIA)
-*
-* Save current directory
-*
- CALL RZCDIR(PREDIR,'R')
-
- IF(NENTRY.EQ.0) THEN
- JBIAS = 2
- CALL FMBOOK(GNAME,KEYS,LADDBK,LSUP,JBIAS,IRC)
- NENTRY = 1
- ELSE
- CALL FMFILL(GNAME,LADDBK,KEYS,'A',IRC)
- ENDIF
-*
-* Try to allocate a new tape
-*
- IF(IDEBFA.GE.0) PRINT *,'FMKATT. trying to allocate a ',
- + CHMTYP(MEDIA),' from pool ',POOL(1:LPOOL),
- + ' in library ',LIB(1:LLIB),'...'
-
- CALL FMALLO(CHMTYP(MEDIA),' ',' ',LIB(1:LLIB),POOL(1:LPOOL),
- + LADDBK,' ',VSN,VID,IRC)
-
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMKATT. return code ',IRC,
- + ' from FMALLO'
- RETURN
- ELSE
- IF(IDEBFA.GE.-1) PRINT *,'FMKATT. allocated VSN/VID = ',
- + VSN,' ',VID
- ENDIF
-
- LVSN = LENOCC(VSN)
- LVID = LENOCC(VID)
-
- JP = 0
- FSEQ = 1
-*
-* Override various fields as required
-*
- IF(LDSN.GT.0) THEN
- CALL VBLANK(IQ(LADDBK+MFQNFA),NFQNFA/4)
- CALL UCTOH(DSN,IQ(LADDBK+MFQNFA),4,LDSN)
- ENDIF
-
- IF (HOSTN(1:8) .NE. 'THISNODE') THEN
- CALL VBLANK(IQ(LADDBK+MHSNFA),NHSNFA/4)
- CALL UCTOH(HOSTN,IQ(LADDBK+MHSNFA),4,LHOSTN)
- ENDIF
-
- CALL UCTOH(FFORM,IQ(LADDBK+MFLFFA),4,LFFORM)
- IQ(LADDBK+MCPLFA) = CPLEV
- IQ(LADDBK+MMTPFA) = 1
- IQ(LADDBK+MLOCFA) = 1
- KEYS(MKCLFA) = CPLEV
-
- IF(NUMLOC.EQ.1) THEN
- IQ(LADDBK+MLOCFA) = MFMLOC(1)
- KEYS(MKLCFA) = MFMLOC(1)
- ENDIF
-
- CALL VBLANK(IQ(LADDBK+MUCMFA),NUCMFA/4)
- CALL UCTOH(COMM,IQ(LADDBK+MUCMFA),4,LCOMM)
-
- CALL UCTOH(RECFM,IQ(LADDBK+MRFMFA),4,LRECFM)
- IQ(LADDBK+MRLNFA) = LRECL
- IQ(LADDBK+MBLNFA) = BLOCK
- IQ(LADDBK+MFSZFA) = FSIZE
-
- CALL UCTOH(VSN,IQ(LADDBK+MVSNFA),4,LVSN)
- CALL UCTOH(VID,IQ(LADDBK+MVIDFA),4,LVID)
- IQ(LADDBK+MVIPFA) = JP
- IQ(LADDBK+MFSQFA) = FSEQ
-* IQ(LADDBK+MMTPFA) = 2
- IQ(LADDBK+MMTPFA) = MEDIA
-
-*
-* Display entry
-*
- IF(IDEBFA.GE.3) CALL FMSHOW(GNAME,LADDBK,KEYS,'A',IRC)
-*
-* Output this entry
-*
- CALL FMPUT(GNAME,LADDBK,IRC)
-*
-* Reset current directory
-*
- CALL RZCDIR(PREDIR(1:LENOCC(PREDIR)),' ')
-
- END
diff --git a/src/packlib/fatmen/programs/fmkuip/fmkcpl.F b/src/packlib/fatmen/programs/fmkuip/fmkcpl.F
deleted file mode 100644
index bdf1763..0000000
--- a/src/packlib/fatmen/programs/fmkuip/fmkcpl.F
+++ /dev/null
@@ -1,91 +0,0 @@
-*
-* $Id: fmkcpl.F,v 1.1.1.1 1996/03/07 15:17:43 mclareni Exp $
-*
-* $Log: fmkcpl.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:43 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMKCPL
-*CMZ : 30/04/91 16.52.25 by Jamie Shiers
-*-- Author : Jamie Shiers 30/04/91
-#include "fatmen/fatsys.inc"
-#include "fatmen/fatpara.inc"
-#include "fatmen/fatbug.inc"
-#include "fatmen/fatcpl.inc"
- DIMENSION MYCPL(KMXCPL)
- CHARACTER*80 CHCPL,WORD
-#include "fatmen/fatinit.inc"
-
- CALL KUGETC(CHCPL,LCPL)
-
- IF(LCPL.EQ.0) RETURN
-*
- IF(CHCPL(1:1).EQ.'-') THEN
- NUMCPL = 0
- DO 1 I=1,KMXCPL
- MFMCPL(I) = -1
-1 CONTINUE
- IF(IDEBFA.GE.0) PRINT *,'FMKCPL. copy levels now cleared'
-
- RETURN
- ENDIF
-*
-* Get number of elements in CHCPL
-*
- CALL FMNWRD(',',CHCPL(1:LCPL),NWORDS)
-
- NCPL = 0
- DO 10 I=0,NWORDS-1
- WORD = ' '
- CALL FMWORD(WORD,I,',',CHCPL(1:LCPL),IRC)
- LWORD = LENOCC(WORD)
-* PRINT *,'Word ',I,WORD(1:LWORD)
-*
-* Range?
-*
- IMINUS = INDEX(WORD(1:LWORD),'-')
- IF(IMINUS.EQ.0) THEN
-*
-* Is it numeric?
-*
- IF(ICNUM(WORD,1,LWORD).LE.LWORD) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMKCPL. element ',I+1, ' of ',
- + CHCPL(1:LCPL),' is not numeric - ignored'
- GOTO 10
- ENDIF
-
- NCPL = NCPL + 1
- IF(NCPL.GT.KMXCPL) THEN
- PRINT *,'FMKCPL. maximum number of copy levels ',
- + 'reached - excess values discarded'
- GOTO 30
- ENDIF
- MYCPL(NCPL) = ICDECI(WORD,1,LWORD)
- IF(IDEBFA.GE.3) PRINT *,'FMKCPL. copy level # ',NCPL,
- + ' = ',MYCPL(NCPL)
-
- ELSE
- JLOW = ICDECI(WORD,1,IMINUS-1)
- JHIGH = ICDECI(WORD,IMINUS+1,LWORD)
- DO 20 J=JLOW,JHIGH
- NCPL = NCPL + 1
- IF(NCPL.GT.KMXCPL) THEN
- PRINT *,'FMKCPL. maximum number of copy levels ',
- + 'reached - excess values discarded'
- GOTO 30
- ENDIF
- MYCPL(NCPL) = J
- IF(IDEBFA.GE.3) PRINT *,'FMKCPL. copy level # ',NCPL,
- + ' = ',MYCPL(NCPL)
- 20 CONTINUE
- ENDIF
- 10 CONTINUE
- 30 CONTINUE
-
- NUMCPL = MIN(NCPL,KMXCPL)
-
- CALL UCOPY(MYCPL,MFMCPL,NUMCPL)
-
- END
diff --git a/src/packlib/fatmen/programs/fmkuip/fmkdst.F b/src/packlib/fatmen/programs/fmkuip/fmkdst.F
deleted file mode 100644
index db3353a..0000000
--- a/src/packlib/fatmen/programs/fmkuip/fmkdst.F
+++ /dev/null
@@ -1,45 +0,0 @@
-*
-* $Id: fmkdst.F,v 1.1.1.1 1996/03/07 15:17:43 mclareni Exp $
-*
-* $Log: fmkdst.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:43 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMKDST
-
-#include "fatmen/fatsys.inc"
-#include "fatmen/fatsat.inc"
-#include "fatmen/fatbug.inc"
-
- CHARACTER*40 DEST
-
-#include "fatmen/fatinit.inc"
-
- CALL KUGETC(DEST,LDEST)
-
- IF(LDEST.EQ.0) THEN
- CALL FMSDST
- RETURN
- ENDIF
-
- PRINT *,'FMKDST. setting destination site to ',DEST(1:LDEST)
-
- LDSTST = LDEST
- CHDEST = DEST(1:LDEST)
-
- JX = ICNTH(CHDEST(1:LDSTST),CHSITE,NSITES)
- IF(JX.EQ.0) THEN
- IF(IDEBFA.GE.0) PRINT *,'*** warning - site specified not ',
- + 'found in list of known sites ***'
- ENDIF
-*
-* Check that source and destination are not the same
-*
- IF(LSRCST.NE.0.AND.CHSRCE(1:LSRCST).EQ.CHDEST(1:LDEST)) THEN
- IF(IDEBFA.GE.0) PRINT *,'*** warning - source and destination',
- + ' sites are identical ***'
- ENDIF
-
- END
diff --git a/src/packlib/fatmen/programs/fmkuip/fmkend.F b/src/packlib/fatmen/programs/fmkuip/fmkend.F
deleted file mode 100644
index 5719ff8..0000000
--- a/src/packlib/fatmen/programs/fmkuip/fmkend.F
+++ /dev/null
@@ -1,45 +0,0 @@
-*
-* $Id: fmkend.F,v 1.1.1.1 1996/03/07 15:17:43 mclareni Exp $
-*
-* $Log: fmkend.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:43 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMKEND
-*CMZ : 17/09/91 12.00.51 by Jamie Shiers
-*-- Author : Jamie Shiers 17/09/91
-#include "fatmen/fatbank.inc"
-#include "fatmen/fatsys.inc"
-#include "fatmen/fatron.inc"
- IF(THRONG(1:LTHR).EQ.'NONE') RETURN
-#if defined(CERNLIB_IBMVM)
- IF(SERNAM(1:4).NE.'INIT'.AND.SERMOD.NE.'?'
- + .AND.SERMOD.NE.'A') THEN
- CALL VMCMS('EXEC DROP '//SERMOD,IRC)
- SERMOD = '?'
- ENDIF
-#endif
- LURZFA = IQ(LTOPFA+KOFUFA+MLUNFA)
- CALL FMEND(IRC)
-#if defined(CERNLIB_CSPACK)
- IF(FATNOD.EQ.' ') THEN
-#endif
- IF(LURZFA.GT.1000) THEN
-#if defined(CERNLIB_UNIX)||defined(CERNLIB_VAXVMS)
- IF(IDEBFA.GE.3) PRINT *,'FMKEND. closing unit ',LURZFA-1000,
- + ' (C)'
- CALL CFCLOS(LURZFA-1000,0)
-#endif
- ELSEIF(LURZFA.GT.0) THEN
- IF(IDEBFA.GE.3) PRINT *,'FMKEND. closing unit ',LURZFA,
- + ' (FORTRAN)'
- CLOSE(LURZFA)
- ENDIF
-#if defined(CERNLIB_CSPACK)
- ENDIF
-#endif
- THRONG = 'NONE'
- LTHR = 4
- END
diff --git a/src/packlib/fatmen/programs/fmkuip/fmklcc.F b/src/packlib/fatmen/programs/fmkuip/fmklcc.F
deleted file mode 100644
index 31a07c0..0000000
--- a/src/packlib/fatmen/programs/fmkuip/fmklcc.F
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: fmklcc.F,v 1.1.1.1 1996/03/07 15:17:44 mclareni Exp $
-*
-* $Log: fmklcc.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:44 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMKLCC
-
- CHARACTER*255 CHFILE
-
- CALL KUGETS(CHFILE,LFILE)
-
- IF(LFILE.EQ.0) RETURN
-
- CALL FMGLUN(LUNCOD,IRC)
- CALL FMLCOD(LUNCOD,CHFILE(1:LFILE),' ',IRC)
- CALL FMFLUN(LUNCOD,IRC)
-
- END
diff --git a/src/packlib/fatmen/programs/fmkuip/fmkloc.F b/src/packlib/fatmen/programs/fmkuip/fmkloc.F
deleted file mode 100644
index dd695e7..0000000
--- a/src/packlib/fatmen/programs/fmkuip/fmkloc.F
+++ /dev/null
@@ -1,93 +0,0 @@
-*
-* $Id: fmkloc.F,v 1.1.1.1 1996/03/07 15:17:43 mclareni Exp $
-*
-* $Log: fmkloc.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:43 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMKLOC
-*CMZ : 30/04/91 16.52.25 by Jamie Shiers
-*-- Author : Jamie Shiers 30/04/91
-#include "fatmen/fatsys.inc"
-#include "fatmen/fatpara.inc"
-#include "fatmen/fatbug.inc"
-#include "fatmen/fatloc.inc"
- DIMENSION MYLOC(KMXLOC)
- CHARACTER*80 CHLOC,WORD
-#include "fatmen/fatinit.inc"
-
- CALL KUGETC(CHLOC,LLOC)
-
- IF(LLOC.EQ.0) RETURN
-*
- IF(CHLOC(1:1).EQ.'-') THEN
- NUMLOC = 0
- DO 1 I=1,KMXLOC
- MFMLOC(I) = -1
-1 CONTINUE
- IF(IDEBFA.GE.0) PRINT *,'FMKLOC. location codes now cleared'
-
- RETURN
- ENDIF
-*
-* Get number of elements in CHLOC
-*
- CALL FMNWRD(',',CHLOC(1:LLOC),NWORDS)
-
- NLOC = 0
- DO 10 I=0,NWORDS-1
- WORD = ' '
- CALL FMWORD(WORD,I,',',CHLOC(1:LLOC),IRC)
- LWORD = LENOCC(WORD)
-* PRINT *,'Word ',I,WORD(1:LWORD)
-*
-* Range?
-*
- IMINUS = INDEX(WORD(1:LWORD),'-')
- IF(IMINUS.EQ.0) THEN
-*
-* Is it numeric?
-*
- IF(ICNUM(WORD,1,LWORD).LE.LWORD) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMKLOC. element ',I+1, ' of ',
- + CHLOC(1:LLOC),' is not numeric - ignored'
- GOTO 10
- ENDIF
-
- NLOC = NLOC + 1
- IF(NLOC.GT.KMXLOC) THEN
- PRINT *,'FMKLOC. maximum number of location codes ',
- + 'reached - excess values discarded'
- GOTO 30
- ENDIF
- MYLOC(NLOC) = ICDECI(WORD,1,LWORD)
- IF(IDEBFA.GE.3) PRINT *,'FMKLOC. location code # ',NLOC,
- + ' = ',MYLOC(NLOC)
-
- ELSE
- JLOW = ICDECI(WORD,1,IMINUS-1)
- JHIGH = ICDECI(WORD,IMINUS+1,LWORD)
- DO 20 J=JLOW,JHIGH
- NLOC = NLOC + 1
- IF(NLOC.GT.KMXLOC) THEN
- PRINT *,'FMKLOC. maximum number of location codes ',
- + 'reached - excess values discarded'
- GOTO 30
- ENDIF
- MYLOC(NLOC) = ICDECI(WORD,1,LWORD)
-
- MYLOC(NLOC) = J
- IF(IDEBFA.GE.3) PRINT *,'FMKLOC. location code # ',NLOC,
- + ' = ',MYLOC(NLOC)
- 20 CONTINUE
- ENDIF
- 10 CONTINUE
- 30 CONTINUE
-
- NUMLOC = MIN(NLOC,KMXLOC)
-
- CALL UCOPY(MYLOC,MFMLOC,NUMLOC)
-
- END
diff --git a/src/packlib/fatmen/programs/fmkuip/fmkmod.F b/src/packlib/fatmen/programs/fmkuip/fmkmod.F
deleted file mode 100644
index d7e3577..0000000
--- a/src/packlib/fatmen/programs/fmkuip/fmkmod.F
+++ /dev/null
@@ -1,421 +0,0 @@
-*
-* $Id: fmkmod.F,v 1.1.1.1 1996/03/07 15:17:43 mclareni Exp $
-*
-* $Log: fmkmod.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:43 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMKMOD
-#include "fatmen/faust.inc"
-#include "fatmen/fmnkeys.inc"
-#include "fatmen/fmaxcop.inc"
-#include "fatmen/fatbank.inc"
-#include "fatmen/fatpara.inc"
-#include "fatmen/slate.inc"
- DIMENSION KEYS(LKEYFA)
- DIMENSION KEYSIN(LKEYFA)
- DIMENSION KEYSOU(LKEYFA,MAXCOP)
- CHARACTER*255 GNAME,GNAM1,CHDIR,CHPROM
- CHARACTER*4 FFORM,RECFM
- CHARACTER*80 CHVAL1,CHVAL2
- CHARACTER*80 COMM
- CHARACTER*36 CHOPT
- CHARACTER*20 FNAME
-#include "fatmen/fatoptd.inc"
-
- CALL KUGETC(GNAM1,LGNAM1)
- CALL FMFIXF(GNAM1,GNAME)
- LGN = LENOCC(GNAME)
-
- CALL KUGETI(KSN)
- CALL KUGETI(JLOC)
- CALL KUGETI(JDAT)
- CALL KUGETI(JMED)
-
- CALL KUGETC(FFORM,LFORM)
- CALL KUGETC(RECFM,LRECF)
- CALL KUGETI(JRECL)
- CALL KUGETI(JBLOCK)
- CALL KUGETI(JSIZE)
- CALL KUGETC(COMM,LCOMM)
-
- CALL KUGETC(CHOPT,LCHOPT)
- IF(LCHOPT.EQ.0) THEN
- CALL VZERO(IOPT,36)
- ELSE
-#include "fatmen/fatoptc.inc"
- ENDIF
-
- IF(IOPTI.NE.0) THEN
- IOPTK = 1
- IOPTF = 1
- IOPTL = 1
- IOPTP = 1
- IOPTT = 1
- IOPTC = 1
- IOPTU = 1
- ENDIF
-
- IPROM = IOPTK + IOPTF + IOPTL + IOPTP + IOPTT + IOPTC + IOPTU
-
- CALL RZCDIR(CHDIR,'R')
- LCDIR = LENOCC(CHDIR)
-
- IF(KSN.EQ.0) THEN
- CALL VZERO(KEYS,10)
- ELSE
- KEYS(1) = KSN
- ENDIF
-
- LPATH = INDEXB(GNAME(1:LGN),'/') -1
- FNAME = GNAME(LPATH+2:LGN)
- LNAME = LENOCC(FNAME)
-*
-* Check how many copies of this dataset exist
-*
- CALL UCOPY(KEYS,KEYSIN,10)
-*
-* Don't compare media type, copy level or location code
-*
- KEYSIN(MKMTFA) = -1
- KEYSIN(MKCLFA) = -1
- KEYSIN(MKLCFA) = -1
- NMATCH = 0
- CALL FMSELK(GNAME(1:LGN),KEYSIN,KEYSOU,NMATCH,MAXCOP,IRC)
- IF(NMATCH.EQ.0) THEN
- IF(IDEBFA.GE.0)
- + PRINT *,'FMKMOD. found 0 matches for ',GNAME(1:LGN)
- IRC = 1
- GOTO 40
- ELSEIF(NMATCH.GT.1.AND.KEYS(1).EQ.0.AND.IOPTA.EQ.0) THEN
- IF(IDEBFA.GE.0) THEN
- PRINT *,'FMKMOD. found ',NMATCH,' matches for ',
- + GNAME(1:LGN)
- PRINT *,'FMKMOD. Please specify which entry is ',
- + 'to be modified'
- ENDIF
- IRC = 1
- GOTO 40
- ELSE
-
- IF(IDEBFA.GE.1)
- + PRINT *,'FMKMOD. found ',NMATCH,' matches for ',GNAME(1:LGN)
-
- CALL UCOPY(KEYS,KEYSIN,10)
-
- IFOUND = 0
- DO 30 I=1,NMATCH
-*
-* Was a specific key serial number specified?
-*
- IF((KEYSIN(1).NE.KEYSOU(1,I)).AND.(KEYSIN(1).NE.0)) GOTO 30
-
- IFOUND = 1
- CALL UCOPY(KEYSOU(1,I),KEYS,10)
-
- IF(IDEBFA.GE.1) THEN
- PRINT *,'FMKMOD. candidate number ',I
- CALL FMPKEY(KEYSOU(1,I),LKEYFA)
- ENDIF
-
- LTDSFA = 0
- CALL FMGETK(GNAME(1:LGN),LTDSFA,KEYSOU(1,I),IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMKMOD. Return code ',IRC,' from '
- + //'FMGETK'
- GOTO 40
- ENDIF
-*
-* Prompt?
-*
- IF(IPROM.EQ.0) THEN
-*
-* No, override fields that were given
-*
- IF(JLOC.NE.0) THEN
- IQ(LTDSFA+KOFUFA+MLOCFA) = JLOC
- ENDIF
-
- IF(JDAT.NE.0) THEN
- IQ(LTDSFA+KOFUFA+MCPLFA) = JDAT
- ENDIF
-
- IF(JMED.NE.0) THEN
- IF(JMED.NE.IQ(LTDSFA+KOFUFA+MMTPFA)) THEN
- PRINT *,'FMKMOD. sorry - cannot interchange media types'
- PRINT *,'FMKMOD. please use the mv command'
- GOTO 20
- ENDIF
- IQ(LTDSFA+KOFUFA+MMTPFA) = JMED
- ENDIF
-
- IF(LFORM.NE.0) THEN
- CALL VBLANK(IQ(LTDSFA+KOFUFA+MFLFFA),1)
- CALL UCTOH(FFORM,IQ(LTDSFA+KOFUFA+MFLFFA),4,LFORM)
- ENDIF
-
- IF(LRECF.NE.0) THEN
- CALL VBLANK(IQ(LTDSFA+KOFUFA+MRFMFA),1)
- CALL UCTOH(RECFM,IQ(LTDSFA+KOFUFA+MRFMFA),4,LRECF)
- ENDIF
-
- IF(JRECL.NE.0) THEN
- IQ(LTDSFA+KOFUFA+MRLNFA) = JRECL
- ENDIF
-
- IF(JBLOCK.NE.0) THEN
- IQ(LTDSFA+KOFUFA+MBLNFA) = JBLOCK
- ENDIF
-
- IF(JSIZE.NE.0) THEN
- IQ(LTDSFA+KOFUFA+MFSZFA) = JSIZE
- ENDIF
-
- IF(LCOMM.NE.0) THEN
- CALL VBLANK(IQ(LTDSFA+KOFUFA+MUCMFA),NUCMFA/4)
- CALL UCTOH(COMM,IQ(LTDSFA+KOFUFA+MUCMFA),4,LCOMM)
- ENDIF
-
- ELSE
-*
-* Display specified fields and prompt for new values
-*
- IF(IOPTK.NE.0) THEN
-*
-* Copy level / data representation
-*
- IVAL = 0
- WRITE(CHPROM,9001) IQ(LTDSFA+KOFUFA+MCPLFA)
- CALL KUPROI(CHPROM(1:LENOCC(CHPROM)),IVAL)
- IF(IVAL.NE.0) IQ(LTDSFA+KOFUFA+MCPLFA) = IVAL
-*
-* Location code
-*
- IVAL = 0
- WRITE(CHPROM,9002) IQ(LTDSFA+KOFUFA+MLOCFA)
- CALL KUPROI(CHPROM(1:LENOCC(CHPROM)),IVAL)
- IF(IVAL.NE.0) IQ(LTDSFA+KOFUFA+MLOCFA) = IVAL
-*
-* Media type
-*
- IVAL = 0
- WRITE(CHPROM,9003) IQ(LTDSFA+KOFUFA+MMTPFA)
- CALL KUPROI(CHPROM(1:LENOCC(CHPROM)),IVAL)
- IF(IVAL.NE.0) IQ(LTDSFA+KOFUFA+MMTPFA) = IVAL
- ENDIF
-
- IF(IOPTF.NE.0) THEN
-*
-* Start record
-*
- IVAL = 0
- WRITE(CHPROM,9004) IQ(LTDSFA+KOFUFA+MSRDFA)
- CALL KUPROI(CHPROM(1:LENOCC(CHPROM)),IVAL)
- IF(IVAL.NE.0) IQ(LTDSFA+KOFUFA+MSRDFA) = IVAL
-*
-* End record
-*
- IVAL = 0
- WRITE(CHPROM,9005) IQ(LTDSFA+KOFUFA+MERDFA)
- CALL KUPROI(CHPROM(1:LENOCC(CHPROM)),IVAL)
- IF(IVAL.NE.0) IQ(LTDSFA+KOFUFA+MERDFA) = IVAL
-*
-* Start block
-*
- IVAL = 0
- WRITE(CHPROM,9006) IQ(LTDSFA+KOFUFA+MSBLFA)
- CALL KUPROI(CHPROM(1:LENOCC(CHPROM)),IVAL)
- IF(IVAL.NE.0) IQ(LTDSFA+KOFUFA+MSBLFA) = IVAL
-*
-* End block
-*
- IVAL = 0
- WRITE(CHPROM,9007) IQ(LTDSFA+KOFUFA+MEBLFA)
- CALL KUPROI(CHPROM(1:LENOCC(CHPROM)),IVAL)
- IF(IVAL.NE.0) IQ(LTDSFA+KOFUFA+MEBLFA) = IVAL
- ENDIF
-
- IF(IOPTL.NE.0) THEN
-*
-* File format
-*
- CHVAL1 = ' '
- CHVAL2 = ' '
- CALL UHTOC(IQ(LTDSFA+KOFUFA+MFLFFA),4,CHVAL1,NFLFFA)
- WRITE(CHPROM,9008) CHVAL1
- CALL KUPROC(CHPROM(1:LENOCC(CHPROM)),CHVAL2,LVAL)
- IF(LVAL.NE.0) THEN
- CALL VBLANK(IQ(LTDSFA+KOFUFA+MFLFFA),1)
- CALL UCTOH(CHVAL2,IQ(LTDSFA+KOFUFA+MFLFFA),4,LVAL)
- ENDIF
-*
-* User format
-*
- CHVAL1 = ' '
- CHVAL2 = ' '
- CALL UHTOC(IQ(LTDSFA+KOFUFA+MFUTFA),4,CHVAL1,NFUTFA)
- WRITE(CHPROM,9009) CHVAL1
- CALL KUPROC(CHPROM(1:LENOCC(CHPROM)),CHVAL2,LVAL)
- IF(LVAL.NE.0) THEN
- CALL VBLANK(IQ(LTDSFA+KOFUFA+MFUTFA),1)
- CALL UCTOH(CHVAL2,IQ(LTDSFA+KOFUFA+MFUTFA),4,LVAL)
- ENDIF
- ENDIF
-
- IF(IOPTP.NE.0) THEN
-*
-* Record format
-*
- CHVAL1 = ' '
- CHVAL2 = ' '
- CALL UHTOC(IQ(LTDSFA+KOFUFA+MRFMFA),4,CHVAL1,NRFMFA)
- WRITE(CHPROM,9010) CHVAL1
- CALL KUPROC(CHPROM(1:LENOCC(CHPROM)),CHVAL2,LVAL)
- IF(LVAL.NE.0) THEN
- CALL VBLANK(IQ(LTDSFA+KOFUFA+MRFMFA),1)
- CALL UCTOH(CHVAL2,IQ(LTDSFA+KOFUFA+MRFMFA),4,LVAL)
- ENDIF
-*
-* Record length
-*
- IVAL = 0
- WRITE(CHPROM,9011) IQ(LTDSFA+KOFUFA+MRLNFA)
- CALL KUPROI(CHPROM(1:LENOCC(CHPROM)),IVAL)
- IF(IVAL.NE.0) IQ(LTDSFA+KOFUFA+MRLNFA) = IVAL
-*
-* Block length
-*
- IVAL = 0
- WRITE(CHPROM,9012) IQ(LTDSFA+KOFUFA+MBLNFA)
- CALL KUPROI(CHPROM(1:LENOCC(CHPROM)),IVAL)
- IF(IVAL.NE.0) IQ(LTDSFA+KOFUFA+MBLNFA) = IVAL
-*
-* File size
-*
- IVAL = 0
- WRITE(CHPROM,9013) IQ(LTDSFA+KOFUFA+MFSZFA)
- CALL KUPROI(CHPROM(1:LENOCC(CHPROM)),IVAL)
- IF(IVAL.NE.0) IQ(LTDSFA+KOFUFA+MFSZFA) = IVAL
-*
-* Use count
-*
- IVAL = 0
- WRITE(CHPROM,9014) IQ(LTDSFA+KOFUFA+MUSCFA)
- CALL KUPROI(CHPROM(1:LENOCC(CHPROM)),IVAL)
- IF(IVAL.NE.0) IQ(LTDSFA+KOFUFA+MUSCFA) = IVAL
- ENDIF
-
- IF(IOPTT.NE.0) THEN
-*
-* Date and time created
-*
- CALL FMUPTM(ID,IT,IQ(LTDSFA+KOFUFA+MCRTFA),IRC)
- CHVAL2 = ' '
- WRITE(CHPROM,9015) ID,IT
- CALL KUPROC(CHPROM(1:LENOCC(CHPROM)),CHVAL2,LVAL)
- IF(LVAL.NE.0) THEN
- ID = ICDECI(CHVAL2,1,LVAL)
- IT = ICDECI(CHVAL2,IS(1)+2,LVAL)
- CALL FMPKTM(ID,IT,IQ(LTDSFA+KOFUFA+MCRTFA),IRC)
- ENDIF
-*
-* Date and time catalogued
-*
- CALL FMUPTM(ID,IT,IQ(LTDSFA+KOFUFA+MCTTFA),IRC)
- CHVAL2 = ' '
- WRITE(CHPROM,9016) ID,IT
- CALL KUPROC(CHPROM(1:LENOCC(CHPROM)),CHVAL2,LVAL)
- IF(LVAL.NE.0) THEN
- ID = ICDECI(CHVAL2,1,LVAL)
- IT = ICDECI(CHVAL2,IS(1)+2,LVAL)
- CALL FMPKTM(ID,IT,IQ(LTDSFA+KOFUFA+MCTTFA),IRC)
- ENDIF
-*
-* Date and time of last access
-*
- CALL FMUPTM(ID,IT,IQ(LTDSFA+KOFUFA+MLATFA),IRC)
- CHVAL2 = ' '
- WRITE(CHPROM,9017) ID,IT
- CALL KUPROC(CHPROM(1:LENOCC(CHPROM)),CHVAL2,LVAL)
- IF(LVAL.NE.0) THEN
- ID = ICDECI(CHVAL2,1,LVAL)
- IT = ICDECI(CHVAL2,IS(1)+2,LVAL)
- CALL FMPKTM(ID,IT,IQ(LTDSFA+KOFUFA+MLATFA),IRC)
- ENDIF
- ENDIF
-
- IF(IOPTU.NE.0) THEN
-*
-* User words
-*
- DO 10 J=1,NUSWFA
- IVAL = 0
- WRITE(CHPROM,9018) J,IQ(LTDSFA+KOFUFA+MUSWFA+J-I)
- CALL KUPROI(CHPROM(1:LENOCC(CHPROM)),IVAL)
- IF(IVAL.NE.0) IQ(LTDSFA+KOFUFA+MUSWFA+J-I) = IVAL
- 10 CONTINUE
-*
-* Comment
-*
- CHVAL1 = ' '
- CHVAL2 = ' '
- CALL UHTOC(IQ(LTDSFA+KOFUFA+MUCMFA),4,CHVAL1,NUCMFA)
- WRITE(CHPROM,9019) CHVAL1
- CALL KUPROC(CHPROM(1:LENOCC(CHPROM)),CHVAL2,LVAL)
- IF(LVAL.NE.0) THEN
- CALL VBLANK(IQ(LTDSFA+KOFUFA+MUCMFA),NUCMFA/4)
- CALL UCTOH(CHVAL2,IQ(LTDSFA+KOFUFA+MUCMFA),4,LVAL)
- ENDIF
-
- ENDIF
-
- ENDIF
-*
-* Update keys
-*
- KEYS(MKCLFA) = IQ(LTDSFA+KOFUFA+MCPLFA)
- KEYS(MKLCFA) = IQ(LTDSFA+KOFUFA+MLOCFA)
- KEYS(MKMTFA) = IQ(LTDSFA+KOFUFA+MMTPFA)
-*
-* Put new file
-*
- IFLAG = 0
- CALL FMMOD(GNAME(1:LGN),LTDSFA,IFLAG,JRC)
- NFMODI = NFMODI + 1
- 20 CONTINUE
- CALL MZDROP(IDIVFA,LTDSFA,' ')
- LTDSFA = 0
- 30 CONTINUE
-
- ENDIF
-
- IF(KSN.NE.0.AND.IFOUND.EQ.0.AND.IDEBFA.GE.-2) PRINT *,'FMKMOD. ',
- + ' no match found for ',GNAME(1:LGN),' key = ',KSN
-
- 40 CONTINUE
-*
-* Reset current directory
-*
- CALL RZCDIR(CHDIR(1:LCDIR),' ')
- 9001 FORMAT('Data representation: ',I4)
- 9002 FORMAT('Location code : ',I4)
- 9003 FORMAT('Media type : ',I4)
- 9004 FORMAT('Start record : ',I4)
- 9005 FORMAT('End record : ',I4)
- 9006 FORMAT('Start block : ',I4)
- 9007 FORMAT('End block : ',I4)
- 9008 FORMAT('File format : ',A4)
- 9009 FORMAT('User format : ',A4)
- 9010 FORMAT('Record format : ',A4)
- 9011 FORMAT('Record length : ',I4)
- 9012 FORMAT('Block length : ',I4)
- 9013 FORMAT('File size : ',I4)
- 9014 FORMAT('Use count : ',I4)
- 9015 FORMAT('Created : ',I6,'.',I4)
- 9016 FORMAT('Catalogued : ',I6,'.',I4)
- 9017 FORMAT('Last access : ',I6,'.',I4)
- 9018 FORMAT('User word # ',I2.2,': ',I10)
- 9019 FORMAT('Comment : ',A)
- END
diff --git a/src/packlib/fatmen/programs/fmkuip/fmkmtp.F b/src/packlib/fatmen/programs/fmkuip/fmkmtp.F
deleted file mode 100644
index 4d5ef9a..0000000
--- a/src/packlib/fatmen/programs/fmkuip/fmkmtp.F
+++ /dev/null
@@ -1,91 +0,0 @@
-*
-* $Id: fmkmtp.F,v 1.1.1.1 1996/03/07 15:17:43 mclareni Exp $
-*
-* $Log: fmkmtp.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:43 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMKMTP
-*CMZ : 30/04/91 16.52.25 by Jamie Shiers
-*-- Author : Jamie Shiers 30/04/91
-#include "fatmen/fatsys.inc"
-#include "fatmen/fatpara.inc"
-#include "fatmen/fatbug.inc"
-#include "fatmen/fatmtp.inc"
- DIMENSION MYMTP(KMXMTP)
- CHARACTER*80 CHMTP,WORD
-#include "fatmen/fatinit.inc"
-
- CALL KUGETC(CHMTP,LMTP)
-
- IF(LMTP.EQ.0) RETURN
-*
- IF(CHMTP(1:1).EQ.'-') THEN
- NUMMTP = 0
- DO 1 I=1,KMXMTP
- MFMMTP(I) = -1
-1 CONTINUE
- IF(IDEBFA.GE.0) PRINT *,'FMKMTP. media types now cleared'
-
- RETURN
- ENDIF
-*
-* Get number of elements in CHMTP
-*
- CALL FMNWRD(',',CHMTP(1:LMTP),NWORDS)
-
- NMTP = 0
- DO 10 I=0,NWORDS-1
- WORD = ' '
- CALL FMWORD(WORD,I,',',CHMTP(1:LMTP),IRC)
- LWORD = LENOCC(WORD)
-* PRINT *,'Word ',I,WORD(1:LWORD)
-*
-* Range?
-*
- IMINUS = INDEX(WORD(1:LWORD),'-')
- IF(IMINUS.EQ.0) THEN
-*
-* Is it numeric?
-*
- IF(ICNUM(WORD,1,LWORD).LE.LWORD) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMKMTP. element ',I+1, ' of ',
- + CHMTP(1:LMTP),' is not numeric - ignored'
- GOTO 10
- ENDIF
-
- NMTP = NMTP + 1
- IF(NMTP.GT.KMXMTP) THEN
- PRINT *,'FMKMTP. maximum number of media types ',
- + 'reached - excess values discarded'
- GOTO 30
- ENDIF
- MYMTP(NMTP) = ICDECI(WORD,1,LWORD)
- IF(IDEBFA.GE.3) PRINT *,'FMKMTP. media type # ',NMTP,
- + ' = ',MYMTP(NMTP)
-
- ELSE
- JLOW = ICDECI(WORD,1,IMINUS-1)
- JHIGH = ICDECI(WORD,IMINUS+1,LWORD)
- DO 20 J=JLOW,JHIGH
- NMTP = NMTP + 1
- IF(NMTP.GT.KMXMTP) THEN
- PRINT *,'FMKMTP. maximum number of media types ',
- + 'reached - excess values discarded'
- GOTO 30
- ENDIF
- MYMTP(NMTP) = J
- IF(IDEBFA.GE.3) PRINT *,'FMKMTP. media type # ',NMTP,
- + ' = ',MYMTP(NMTP)
- 20 CONTINUE
- ENDIF
- 10 CONTINUE
- 30 CONTINUE
-
- NUMMTP = MIN(NMTP,KMXMTP)
-
- CALL UCOPY(MYMTP,MFMMTP,NUMMTP)
-
- END
diff --git a/src/packlib/fatmen/programs/fmkuip/fmksrc.F b/src/packlib/fatmen/programs/fmkuip/fmksrc.F
deleted file mode 100644
index f867f9b..0000000
--- a/src/packlib/fatmen/programs/fmkuip/fmksrc.F
+++ /dev/null
@@ -1,45 +0,0 @@
-*
-* $Id: fmksrc.F,v 1.1.1.1 1996/03/07 15:17:43 mclareni Exp $
-*
-* $Log: fmksrc.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:43 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMKSRC
-
-#include "fatmen/fatsys.inc"
-#include "fatmen/fatsat.inc"
-#include "fatmen/fatbug.inc"
-
- CHARACTER*40 SOURCE
-
-#include "fatmen/fatinit.inc"
-
- CALL KUGETC(SOURCE,LSRC)
-
- IF(LSRC.EQ.0) THEN
- CALL FMSSRC
- RETURN
- ENDIF
-
- PRINT *,'FMKSRC. setting source site to ',SOURCE(1:LSRC)
-
- LSRCST = LSRC
- CHSRCE = SOURCE(1:LSRC)
-
- JX = ICNTH(CHSRCE(1:LSRCST),CHSITE,NSITES)
- IF(JX.EQ.0) THEN
- IF(IDEBFA.GE.0) PRINT *,'*** warning - site specified not ',
- + 'found in list of known sites ***'
- ENDIF
-*
-* Check that source and destination are not the same
-*
- IF(LDSTST.NE.0.AND.CHSRCE(1:LSRCST).EQ.CHDEST(1:LDSTST)) THEN
- IF(IDEBFA.GE.0) PRINT *,'*** warning - source and destination',
- + ' sites are identical ***'
- ENDIF
-
- END
diff --git a/src/packlib/fatmen/programs/fmkuip/fmkuwd.F b/src/packlib/fatmen/programs/fmkuip/fmkuwd.F
deleted file mode 100644
index cd30ef1..0000000
--- a/src/packlib/fatmen/programs/fmkuip/fmkuwd.F
+++ /dev/null
@@ -1,73 +0,0 @@
-*
-* $Id: fmkuwd.F,v 1.1.1.1 1996/03/07 15:17:43 mclareni Exp $
-*
-* $Log: fmkuwd.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:43 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMKUWD
-*CMZ : 30/04/91 16.52.25 by Jamie Shiers
-*-- Author : Jamie Shiers 30/04/91
-#include "fatmen/fatpara.inc"
-#include "fatmen/fatsys.inc"
-#include "fatmen/fatbug.inc"
-#include "fatmen/fatuwd.inc"
- CHARACTER*80 CHWORD(10)
- DIMENSION LCH(10)
-#include "fatmen/fatinit.inc"
-
- CALL KUGETC(CHWORD(1),LCH(1))
- CALL KUGETC(CHWORD(2),LCH(2))
- CALL KUGETC(CHWORD(3),LCH(3))
- CALL KUGETC(CHWORD(4),LCH(4))
- CALL KUGETC(CHWORD(5),LCH(5))
- CALL KUGETC(CHWORD(6),LCH(6))
- CALL KUGETC(CHWORD(7),LCH(7))
- CALL KUGETC(CHWORD(8),LCH(8))
- CALL KUGETC(CHWORD(9),LCH(9))
- CALL KUGETC(CHWORD(10),LCH(10))
-
- IF(LCH(1).EQ.0) RETURN
-
- DO 10 I=1,10
- IF(LCH(I).EQ.0) GOTO 10
-*
-* -1?
-*
- IF(CHWORD(I)(1:LCH(I)).EQ.'-1') THEN
- IFUSER(1,I) = -1
- IFUSER(2,I) = -1
- GOTO 10
- ENDIF
-*
-* Range?
-*
- IMINUS = INDEX(CHWORD(I)(1:LCH(I)),'-')
- IF(IMINUS.EQ.0) THEN
-*
-* Is it numeric?
-*
- IF(ICNUM(CHWORD(I),1,LCH(I)).LE.LCH(I)) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMKUWD. element ',I, ' of ',
- + CHWORD(I)(1:LCH(I)),' is not numeric - ignored'
- GOTO 10
- ENDIF
-
- IFUSER(1,I) = ICDECI(CHWORD(I),1,LCH(I))
- IFUSER(2,I) = IFUSER(1,I)
-
- IF(IDEBFA.GE.3) PRINT *,'FMKUWD. user word # ',I,
- + ' = ',IFUSER(1,I)
-
- ELSE
- IFUSER(1,I) = ICDECI(CHWORD(I),1,IMINUS-1)
- IFUSER(2,I) = ICDECI(CHWORD(I),IMINUS+1,LCH(I))
- IF(IDEBFA.GE.3) PRINT *,'FMKUWD. user word # ',I,
- + ' = ',IFUSER(1,I),' to ',IFUSER(2,I)
- ENDIF
-
- 10 CONTINUE
-
- END
diff --git a/src/packlib/fatmen/programs/fmkuip/fmkver.F b/src/packlib/fatmen/programs/fmkuip/fmkver.F
deleted file mode 100644
index ae6f81a..0000000
--- a/src/packlib/fatmen/programs/fmkuip/fmkver.F
+++ /dev/null
@@ -1,24 +0,0 @@
-#include "fatmen/pilot.h"
- SUBROUTINE FMKVER
-#include "fatmen/fatveri.inc"
-#include "fatmen/fatbug.inc"
- CHARACTER*80 OPTION
- PARAMETER (IZERO=0)
- PARAMETER (IONE=1)
-
- CALL KUGETC(OPTION,LOPT)
-
- IF(LOPT.LE.0) RETURN
-
- IF(OPTION(1:LOPT).EQ.'OFF') THEN
- PRINT *,'FMKVER. setting verification off'
- CALL FMSETV(IZERO,IRC)
- ELSEIF(OPTION(1:LOPT).EQ.'ON') THEN
- PRINT *,'FMKVER. setting verification on'
- CALL FMSETV(IONE,IRC)
- ELSE
- PRINT 9001,OPTION(1:LOPT)
-9001 FORMAT(' FMKVER. error - option must be OFF or ON (not ',A,')')
- ENDIF
-
- END
diff --git a/src/packlib/fatmen/programs/fmkuip/fmld.F b/src/packlib/fatmen/programs/fmkuip/fmld.F
deleted file mode 100644
index 6486b08..0000000
--- a/src/packlib/fatmen/programs/fmkuip/fmld.F
+++ /dev/null
@@ -1,123 +0,0 @@
-*
-* $Id: fmld.F,v 1.3 1996/04/02 10:22:59 cernlib Exp $
-*
-* $Log: fmld.F,v $
-* Revision 1.3 1996/04/02 10:22:59 cernlib
-* Murphy strikes back! "/ *" without the space not even allowed on a
-* comment line -- at least without the quotes
-*
-* Revision 1.2 1996/04/02 10:02:32 cernlib
-* Split up "/ *" to two lines; VMS fpp took this as a comment start.
-*
-* Revision 1.1.1.1 1996/03/07 15:17:43 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMLD
-#include "fatmen/fmpath.inc"
- CHARACTER*255 PATH2
- CHARACTER*255 PATHI
- CHARACTER*4 CHOPT
- LOGICAL IOPEN
-#include "fatmen/fatsys.inc"
-#include "fatmen/fatout.inc"
-#include "zebra/quest.inc"
-#include "fatmen/fatbug.inc"
-#include "fatmen/fatinit.inc"
-*
-* List contents of current directory
-*
- CHOPT = ' '
- CALL KUGETC(PATH,LPATH)
- CALL FMNWRD('/',PATH(1:LPATH),JLEVEL)
-*
-* If just a directory name with no wild cards is specified,
-* assume that we want to look down one level
-*
- IF((INDEX(PATH(1:LPATH),'/').EQ.0).AND.
- + (ICFMUL('*%()<>[]',PATH,1,LPATH).GT.LPATH)) THEN
- PATH(LPATH+1:LPATH+1) = '/'
- PATH(LPATH+2:LPATH+2) = '*'
- LPATH = LPATH + 2
- ENDIF
-
- CALL FMFIXF(PATH,PATH2)
- PATH = PATH2
- LPATH = LENOCC(PATH)
- CALL KUGETC(OUTPUT,LOUT)
- CALL KUGETI(NLEVEL)
- CALL KUGETC(CHOPT,LCHOPT)
-
- IF(LCHOPT.EQ.0) THEN
- CHOPT = ' '
- LCHOPT = 1
- ENDIF
-
- LWRITE = LPRTFA
-*
-* Fix for strange KUIP behaviour...
-*
- IF(OUTPUT(1:1).EQ.'-') THEN
- CHOPT = OUTPUT
- LCHOPT = LOUT
- OUTPUT = 'TTY'
- LOUT = 3
- ENDIF
-
- IF((OUTPUT(1:LOUT).NE.'TTY').OR.(LOUT.EQ.0)) THEN
- LWRITE = 3
- IF(IDEBFA.GE.2)
- + PRINT *,'FMLD. output will be redirected to ',OUTPUT(1:LOUT)
- CALL FAFILE(LWRITE,OUTPUT(1:LOUT),IRET)
- IF(IRET.NE.0) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMLD. return code ',IRET,
- + ' opening file ',OUTPUT(1:LOUT),
- + ' - output will be sent to the screen'
- LWRITE = LPRTFA
- OUTPUT = 'TTY'
- ENDIF
- ELSE
- OUTPUT = 'TTY'
- ENDIF
-*
-* Save current directory
-*
- CALL RZCDIR(CDIR,'R')
- LCDIR = LENOCC(CDIR)
-*
- IF(INDEX(CHOPT(1:LCHOPT),'H').NE.0) THEN
- WRITE(LWRITE,*) '>>> Command: LD ',
- + 'Options: ',CHOPT(1:LCHOPT)
- WRITE(LWRITE,*) '>>> Path: ',PATH(1:LPATH)
- WRITE(LWRITE,*) '>>> Current directory: ',CDIR(1:LCDIR)
- ENDIF
-
- WRITE(LWRITE,*) 'List of subdirectories...'
-
- IF(INDEX(CHOPT,'R').NE.0.AND.NLEVEL.EQ.1) NLEVEL = 99
-
- IF(JLEVEL.GT.NLEVEL) NLEVEL = JLEVEL
-
- CALL FALD(PATH(1:LPATH),NLEVEL,LWRITE,CHOPT,IRET)
-
- NDIR = IQUEST(11)
- NMAT = IQUEST(12)
-
- IF(NDIR.NE.0) THEN
- WRITE(LWRITE,9001) NDIR,NMAT
- ELSE
- WRITE(LWRITE,9002)
- ENDIF
-*
-* Reset current directory
-*
- CALL RZCDIR(CDIR(1:LCDIR),'U')
-
- 9001 FORMAT(' Total of ',I10,' subdirectories of which ',
- + I10,' match')
- 9002 FORMAT(' No subdirectories found')
-
- INQUIRE(3,OPENED=IOPEN)
- IF(IOPEN) CLOSE(3)
- END
diff --git a/src/packlib/fatmen/programs/fmkuip/fmlnc.F b/src/packlib/fatmen/programs/fmkuip/fmlnc.F
deleted file mode 100644
index 85218ca..0000000
--- a/src/packlib/fatmen/programs/fmkuip/fmlnc.F
+++ /dev/null
@@ -1,44 +0,0 @@
-*
-* $Id: fmlnc.F,v 1.1.1.1 1996/03/07 15:17:44 mclareni Exp $
-*
-* $Log: fmlnc.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:44 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMLNC
-
- CHARACTER*255 CHSRCE,CHTRGT,CHTEMP
- CHARACTER*80 CHCOMM
- CHARACTER*8 CHOPT
-
- DIMENSION IVECT(10)
- EQUIVALENCE (IVECT(1),IW1),(IVECT(2),IW2),(IVECT(3),IW3),
- + (IVECT(4),IW4),(IVECT(5),IW5),(IVECT(6),IW6),
- + (IVECT(7),IW7),(IVECT(8),IW8),(IVECT(9),IW9),
- + (IVECT(10),IW10)
-
- CALL KUGETC(CHTEMP,LSRCE)
- CALL FMFIXF(CHTEMP,CHSRCE)
- LSRCE = LENOCC(CHSRCE)
- CALL KUGETC(CHTEMP,LTRGT)
- CALL FMFIXF(CHTEMP,CHTRGT)
- LTRGT = LENOCC(CHTRGT)
- CALL KUGETC(CHCOMM,LCOMM)
- CALL KUGETI(IW1)
- CALL KUGETI(IW2)
- CALL KUGETI(IW3)
- CALL KUGETI(IW4)
- CALL KUGETI(IW5)
- CALL KUGETI(IW6)
- CALL KUGETI(IW7)
- CALL KUGETI(IW8)
- CALL KUGETI(IW9)
- CALL KUGETI(IW10)
- CALL KUGETC(CHOPT,LOPT)
-
- CALL FMLN(CHSRCE(1:LSRCE),CHTRGT(1:LTRGT),CHCOMM(1:LCOMM),
- + IVECT,CHOPT(1:LOPT),IRC)
-
- END
diff --git a/src/packlib/fatmen/programs/fmkuip/fmlogc.F b/src/packlib/fatmen/programs/fmkuip/fmlogc.F
deleted file mode 100644
index d4d438d..0000000
--- a/src/packlib/fatmen/programs/fmkuip/fmlogc.F
+++ /dev/null
@@ -1,13 +0,0 @@
-*
-* $Id: fmlogc.F,v 1.1.1.1 1996/03/07 15:17:43 mclareni Exp $
-*
-* $Log: fmlogc.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:43 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMLOGC
- CALL KUGETI(L)
- CALL FMLOGL(L)
- END
diff --git a/src/packlib/fatmen/programs/fmkuip/fmlogn.F b/src/packlib/fatmen/programs/fmkuip/fmlogn.F
deleted file mode 100644
index 37dcd5d..0000000
--- a/src/packlib/fatmen/programs/fmkuip/fmlogn.F
+++ /dev/null
@@ -1,69 +0,0 @@
-*
-* $Id: fmlogn.F,v 1.1.1.1 1996/03/07 15:17:43 mclareni Exp $
-*
-* $Log: fmlogn.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:43 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMLOGN(IRC)
-#if defined(CERNLIB_IBMMVS)
- CHARACTER*8 CHUSER
-#endif
-#if defined(CERNLIB_VAXVMS)
- CHARACTER*256 MATCH
-#endif
-#if defined(CERNLIB_IBMVM)
- CHARACTER*80 CHFILE
- CHARACTER*1 CHMODE
-#endif
- LOGICAL IMAC,IEXIST
-
- IEXIST = .FALSE.
-
- IRC = 0
-
-#if defined(CERNLIB_IBMMVS)
-*
- IC = FMUSER(CHUSER)
- INQUIRE(FILE='/'//CHUSER(1:LENOCC(CHUSER))//
- + '.FATMEN.KUMAC',EXIST=IMAC)
-#endif
-#if defined(CERNLIB_IBMVM)
-*
-* Look for a file on the A-disk or G-disk, including extensions
-*
- INQUIRE(FILE='/FATMEN KUMAC *',NAME=CHFILE,EXIST=IEXIST)
- IF(IEXIST) THEN
- LF = LENOCC(CHFILE)
- CHMODE = CHFILE(LF-1:LF-1)
- IF((LLT(CHMODE,'G').AND.CHMODE.NE.'A').OR.
- + LGT(CHMODE,'G')) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMKUIP. warning - ',
- + 'found file ',CHFILE(2:LENOCC(CHFILE))
- IF(IDEBFA.GE.0) PRINT *,'This file must be on ',
- + 'disks A or G to be executed automatically'
- IF(IDEBFA.GE.0) PRINT *,'(An extension, e.g. B/A ',
- + 'will also work)'
- IMAC = .FALSE.
- ELSE
- IMAC = .TRUE.
- ENDIF
- ENDIF
-#endif
-#if defined(CERNLIB_VAXVMS)
- ICONT = 0
- IMAC = LIB$FIND_FILE('FATMEN.KUMAC',MATCH,ICONT,,,,)
-#endif
-#if defined(CERNLIB_UNIX)
- INQUIRE (FILE='fatmen.kumac', EXIST=IMAC)
-#endif
- IF(IMAC) THEN
- CALL KUEXEC('EXEC FATMEN')
- IRC = 1
-* ELSE
-* IF(.NOT.IEXIST) PRINT *,'FATMEN.KUMAC not found'
- ENDIF
-
- END
diff --git a/src/packlib/fatmen/programs/fmkuip/fmlokk.F b/src/packlib/fatmen/programs/fmkuip/fmlokk.F
deleted file mode 100644
index ffdf880..0000000
--- a/src/packlib/fatmen/programs/fmkuip/fmlokk.F
+++ /dev/null
@@ -1,83 +0,0 @@
-*
-* $Id: fmlokk.F,v 1.1.1.1 1996/03/07 15:17:44 mclareni Exp $
-*
-* $Log: fmlokk.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:44 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMLOKK
-*
-* Lock VID corresponding to specified generic name
-*
-#include "fatmen/fmpath.inc"
-#include "fatmen/fatpara.inc"
-#include "fatmen/fatbank.inc"
- PARAMETER (LKEYFA=10)
-#include "fatmen/fmaxcop.inc"
-#include "fatmen/fatsys.inc"
- DIMENSION KEYS(LKEYFA)
- DIMENSION KEYSIN(LKEYFA)
- DIMENSION KEYSOU(LKEYFA,MAXCOP)
- CHARACTER*255 GENAM
- CHARACTER*8 CHOPT
-#include "fatmen/fatinit.inc"
- CALL KUGETC(GENAM,LGN)
- CALL FMFIXF(GENAM,GENAM)
- LGN = LENOCC(GENAM)
- CALL KUGETI(KSN)
- KEYS(1) = KSN
- CALL KUGETC(CHOPT,NCH)
- LBANK = 0
- CALL RZCDIR(CDIR(1:LCDIR),'R')
-
- LFILE = INDEXB(GENAM(1:LGN),'/') -1
- FILE1 = GENAM(LFILE+2:LGN)
- CALL RZCDIR(GENAM(1:LFILE),'U')
- LFILE = LENOCC(FILE1)
-*
-* Check how many copies of this dataset exist
-*
- CALL UCOPY(KEYS,KEYSIN,10)
-*
-* Don't compare media type, copy level or location code
-*
- KEYSIN(MKMTFA) = -1
- KEYSIN(MKCLFA) = -1
- KEYSIN(MKLCFA) = -1
- CALL FMSELK(GENAM(1:LGN),KEYSIN,KEYSOU,NMATCH,MAXCOP,IRC)
- IF(NMATCH.EQ.0) THEN
- IF(IDEBFA.GE.0)
- + PRINT *,'FMLOKK. found 0 matches for ',GENAM(1:LGN)
- IRC = 1
- GOTO 99
- ELSEIF((NMATCH.GT.1).AND.(KEYS(1).EQ.0)) THEN
- IF(IDEBFA.GE.0) THEN
- PRINT *,'FMLOKK. found ',NMATCH,' matches for ',
- + GENAM(1:LGN)
- PRINT *,'FMLOKK. Please specify which copy is to be locked'
- ENDIF
- IRC = 1
- GOTO 99
- ELSE
- DO 10 I=1,NMATCH
-10 IF(KEYS(1).EQ.KEYSOU(1,I)) GOTO 20
-20 CONTINUE
- CALL FMGETK(GENAM(1:LGN),LTDSFA,KEYSOU(1,I),IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.0)
- + PRINT *,'FMLOKK. Return code ',IRC,' from FMGETK'
- GOTO 99
- ENDIF
- ENDIF
-
- CALL FMLOCK(GENAM(1:LGN),LTDSFA,KEYS,CHOPT,IRC)
- IF(IRC.NE.0) PRINT *,'Return code ',IRC,' from FMLOCK'
-99 CONTINUE
-*
-* Reset current directory
-*
- CALL RZCDIR(CDIR(1:LCDIR),' ')
-
- END
diff --git a/src/packlib/fatmen/programs/fmkuip/fmlsc.F b/src/packlib/fatmen/programs/fmkuip/fmlsc.F
deleted file mode 100644
index 7842127..0000000
--- a/src/packlib/fatmen/programs/fmkuip/fmlsc.F
+++ /dev/null
@@ -1,213 +0,0 @@
-*
-* $Id: fmlsc.F,v 1.1.1.1 1996/03/07 15:17:43 mclareni Exp $
-*
-* $Log: fmlsc.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:43 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMLSC
- CHARACTER*255 PATH,CHPATH,PREDIR
- CHARACTER*255 PATH2,CHNAME
- CHARACTER*255 CHDESC
-#include "fatmen/fmnkeys.inc"
- DIMENSION KEYS(LKEYFA)
-#include "fatmen/slate.inc"
-#include "fatmen/falscm.inc"
-#include "fatmen/fatpara.inc"
-#include "fatmen/fatloc.inc"
-#include "fatmen/fatmtp.inc"
-#include "fatmen/fatcpl.inc"
-#include "fatmen/fatsys.inc"
-#include "fatmen/fatout.inc"
-#include "fatmen/fatsho.inc"
- CHARACTER*36 CHOPT
- DIMENSION JOPT(36)
-#include "fatmen/fatbank.inc"
- LOGICAL IOPEN,IEXIST
- CHARACTER*5 KFILE
- CHARACTER*11 KDIR
- EXTERNAL FALS
-#include "fatmen/fatinit.inc"
-*
- OUTPUT = ' '
- LOUT = 0
- LWRITE = LPRTFA
-
- NFILES = 0
- NDIRT = 0
- NFILT = 0
-
- CALL RZCDIR(PREDIR,'R')
- LPRE = LENOCC(PREDIR)
- CALL RZCDIR(PREDIR(1:LPRE),'U')
-
- CWDSHO = ' '
-
- PATH = ' '
- PATH2 = ' '
- CALL KUGETC(PATH,LPATH)
- CALL KUGETI(KSN)
- CALL KUGETC(OUTPUT,LOUT)
- CALL KUGETC(CHNAME,LNAME)
- CALL KUGETC(CHOPT,LCHOPT)
-
- IF(PATH(1:1).EQ.'%') THEN
-*
-* Names file handling
-*
- CALL FMGLUN(LUN,IC)
- CALL FMNICK(LUN,CHNAME(1:LNAME),PATH(2:LPATH),
- + PATH2,CHDESC,CHOPT,IRC)
- CALL FMFLUN(LUN,IC)
-
- IF(IRC.EQ.28) RETURN
-
- IF(IRC.EQ.32) THEN
- PRINT *,'FMLSC. nick name ',PATH(2:LPATH),
- + ' not found in names file'
- RETURN
- ENDIF
-
- LNICK = LENOCC(PATH2)
- LDESC = LENOCC(CHDESC)
-
- WRITE(LWRITE,9002) PATH(2:LNICK),PATH2(1:LNICK),CHDESC(1:LDESC)
-9002 FORMAT(' FMLSC. nickname: ',A,' = ',A/,' description: ',A)
-
- ELSEIF(PATH(1:1).EQ.'$') THEN
-*
-* Environment variables
-*
- LEND = INDEX(PATH(1:LPATH),'/')
- IF(LEND.EQ.0) LEND = LPATH
- CALL GETENVF(PATH(2:LEND),PATH2)
- LPATH = IS(1)
- IF(LPATH.EQ.0) THEN
- PRINT *,'FMLSC. environment variable ',PATH(2:LEND),
- + ' not defined'
- RETURN
- ENDIF
- ELSE
- PATH2 = PATH(1:LPATH)
- ENDIF
-*
-* default handling
-*
- CALL FMFIXF(PATH2,PATH)
- LPATH = LENOCC(PATH)
-
- IF(LCHOPT.EQ.0) THEN
- CHOPT = ' '
- LCHOPT = 1
- ENDIF
-
- CALL FMOPTC(CHOPT,ALFNUM,JOPT)
- CALL UCOPY(JOPT,IOPT,36)
-*
-* Fix for strange KUIP behaviour...
-*
- IF(OUTPUT(1:1).EQ.'-') THEN
- CHOPT = OUTPUT
- LCHOPT = LOUT
- OUTPUT = 'TTY'
- LOUT = 3
- ENDIF
-
- LOUT = LENOCC(OUTPUT)
- IF((OUTPUT(1:LOUT).EQ.'TTY').OR.(LOUT.EQ.0)) THEN
- OUTPUT = ' '
- LWRITE = LPRTFA
- ELSE
- LWRITE = 3
- IF(IDEBFA.GE.2)
- + PRINT *,'FMLSC. output will be redirected to ',OUTPUT(1:LOUT)
- CALL FAFILE(LWRITE,OUTPUT(1:LOUT),IRET)
- IF(IRET.NE.0) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMLSC. return code ',IRET,
- + ' opening file ',OUTPUT(1:LOUT),
- + ' - output will be sent to screen'
- OUTPUT = ' '
- LWRITE = LPRTFA
- ENDIF
- ENDIF
-
- IF(LENOCC(CHOPT).EQ.0) THEN
- CHOPT = ' '
- LCHOPT = 1
- ENDIF
-*
-* Check for D option
-*
- IF(INDEX(CHOPT(1:LCHOPT),'D').NE.0) THEN
- PRINT *,'FMLSC. warning - files should be deleted by '//
- + 'descending key serial number'
- ENDIF
-*
- NFILES = 0
-*
-* Look for some files and show the bank and key content:
-*
- LSLASH = INDEXB(PATH(1:LPATH),'/')
- CHPATH = PATH(1:LSLASH-1)
- CHFILE = PATH(LSLASH+1:LPATH)
- LP = LENOCC(CHPATH)
- LF = LENOCC(CHFILE)
-
- IF(IDEBFA.GE.2) PRINT *,'FMLSC. enter for ',PATH(1:LPATH),
- + ',',OUTPUT,',',CHOPT
-*
- IF(INDEX(CHOPT(1:LCHOPT),'H').NE.0) THEN
- WRITE(LWRITE,*) '>>> Command: LS ',
- + 'Options: ',CHOPT(1:LCHOPT)
- WRITE(LWRITE,*) '>>> Path: ',PATH(1:LPATH)
- WRITE(LWRITE,*) '>>> Current directory: ',
- + PREDIR(1:LENOCC(PREDIR))
- ENDIF
-
- IF(ICFMUL('*%(<>[]',CHPATH,1,LP).GT.LP) THEN
-*
-* Was a KSN specified?
-*
- IF(KSN.NE.0) THEN
- NDIRT = 1
- KEYS(1) = KSN
- LBANK = 0
- CALL FMGBYK(PATH(1:LPATH),LBANK,KEYS,IRC)
- IF(IRC.EQ.0) THEN
- NFILT = 1
- CALL FMSHOW(PATH(1:LPATH),LBANK,KEYS,CHOPT,IRC)
- CALL MZDROP(IDIVFA,LBANK,' ')
- LBANK = 0
- ENDIF
- ELSE
- CALL RZCDIR(CHPATH(1:LP),' ')
- CALL FALS(CHPATH(1:LP),IRC)
- ENDIF
- ELSE
-*
-* Directory scan required
-*
- CALL FMSCAN(CHPATH(1:LP),99,FALS,IRC)
- ENDIF
-
- IF(NFILT.EQ.1) THEN
- KFILE = 'file '
- ELSE
- KFILE = 'files'
- ENDIF
-
- IF(NDIRT.EQ.1) THEN
- KDIR = 'directory '
- ELSE
- KDIR = 'directories'
- ENDIF
-
- WRITE(LWRITE,9001) NFILT,KFILE,NDIRT,KDIR
- 9001 FORMAT(' Total of ',I6,1X,A5,' in ',I6,1X,A11)
-
- INQUIRE(3,OPENED=IOPEN)
- IF(IOPEN) CLOSE(3)
- CALL RZCDIR(PREDIR(1:LPRE),' ')
- END
diff --git a/src/packlib/fatmen/programs/fmkuip/fmmakc.F b/src/packlib/fatmen/programs/fmkuip/fmmakc.F
deleted file mode 100644
index 75c6d8b..0000000
--- a/src/packlib/fatmen/programs/fmkuip/fmmakc.F
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: fmmakc.F,v 1.1.1.1 1996/03/07 15:17:43 mclareni Exp $
-*
-* $Log: fmmakc.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:43 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMMAKC
-#include "fatmen/fmpath.inc"
-#include "fatmen/fatsys.inc"
- CHARACTER*6 MODE
- CHARACTER*8 CHLUN
-#include "fatmen/fatinit.inc"
- CALL KUGETC(FILE1,LFILE1)
- CALL KUGETC(CHLUN,LCH)
- CALL FMFIXF(FILE1,FILE1)
- LFILE1 = LENOCC(FILE1)
- L = 0
-*
-* Save current directory
-*
- CALL RZCDIR(CDIR,'R')
- LCDIR = LENOCC(CDIR)
- CALL FMMAKE(FILE1(1:LFILE1),CHLUN,L,IRC)
-*
-* Reset current directory
-*
- CALL RZCDIR(CDIR(1:LCDIR),' ')
- END
-C
-C
diff --git a/src/packlib/fatmen/programs/fmkuip/fmmkdr.F b/src/packlib/fatmen/programs/fmkuip/fmmkdr.F
deleted file mode 100644
index a55d9ff..0000000
--- a/src/packlib/fatmen/programs/fmkuip/fmmkdr.F
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: fmmkdr.F,v 1.1.1.1 1996/03/07 15:17:43 mclareni Exp $
-*
-* $Log: fmmkdr.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:43 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMMKDR
-#include "fatmen/fmpath.inc"
- CHARACTER*255 PATH2
- CALL KUGETC(PATH,LPATH)
- IF(LPATH.EQ.0) RETURN
- CALL FMFIXF(PATH,PATH2)
- LPATH = LENOCC(PATH2)
- PATH = PATH2
- CALL FMKDIR(PATH(1:LPATH),IRC)
- IF(IRC.NE.0) PRINT *,'FMMKDR. Return code ',IRC,' from FMKDIR'
- END
diff --git a/src/packlib/fatmen/programs/fmkuip/fmmvc.F b/src/packlib/fatmen/programs/fmkuip/fmmvc.F
deleted file mode 100644
index b36bb6a..0000000
--- a/src/packlib/fatmen/programs/fmkuip/fmmvc.F
+++ /dev/null
@@ -1,211 +0,0 @@
-*
-* $Id: fmmvc.F,v 1.1.1.1 1996/03/07 15:17:43 mclareni Exp $
-*
-* $Log: fmmvc.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:43 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMMVC
- CHARACTER*255 FTEMP
- CHARACTER*255 CHDIR
-#include "fatmen/faust.inc"
-#include "fatmen/fatupd.inc"
-#include "fatmen/fmpath.inc"
-#include "fatmen/fatpara.inc"
-#include "fatmen/fmnkeys.inc"
-#include "fatmen/fmaxcop.inc"
-#include "fatmen/fatbank.inc"
-#include "fatmen/fatsys.inc"
- DIMENSION KEYS(LKEYFA)
- DIMENSION KEYSIN(LKEYFA)
- DIMENSION KEYSOU(LKEYFA,MAXCOP)
- CHARACTER*20 FNAME
- CHARACTER*15 XVID
- CHARACTER*6 VSN,VID
- CHARACTER*8 HOST,VIP
- CHARACTER*255 DSN
-#include "fatmen/fatinit.inc"
-*
-* Check that we have enough update tokens left
-*
- IF(MAXUPD-NUPDT.LT.2) THEN
- IF(IDEBFA.GE.0) PRINT 9001,NUPDT,MAXUPD
-9001 FORMAT(' FMMVC. A "mv" operation requires two updates'/,
- + ' You have made ',I10,' updates out of ',I10,
- + ' maximum')
- RETURN
- ENDIF
-*
-* Save current directory
-*
- CALL RZCDIR(CHDIR,'R')
- LCDIR = LENOCC(CHDIR)
- CALL KUGETC(FILE1,LFILE1)
- CALL KUGETC(FILE2,LFILE2)
- IF((LFILE1.EQ.0).OR.(LFILE2.EQ.0)) RETURN
- CALL FMFIXF(FILE1,FTEMP)
- FILE1 = FTEMP
- LFILE1 = LENOCC(FILE1)
- CALL FMFIXF(FILE2,FTEMP)
- FILE2 = FTEMP
- LFILE2 = LENOCC(FILE2)
- CALL KUGETI(KSN)
-*
-* Allow user to change keys, tape or disk details
-*
- CALL KUGETI(JLOC)
- CALL KUGETI(JDAT)
- CALL KUGETI(JMED)
-
- CALL KUGETC(VSN,LVSN)
- CALL KUGETC(XVID,LVID)
- IF(LVID.NE.0) THEN
- CALL FMXVID(VID,JP,XVID,VIP,'I',IRC)
- LVID = LENOCC(VID)
- ENDIF
- CALL KUGETI(JFILE)
-
- CALL KUGETC(DSN,LDSN)
- CALL KUGETC(HOST,LHOST)
-
- IF(IDEBFA.GE.0) THEN
- PRINT *,'FMMVC. source: ',FILE1(1:LFILE1)
- PRINT *,'FMMVC. target: ',FILE2(1:LFILE2)
- ENDIF
-
- IF(KSN.EQ.0) THEN
- CALL VZERO(KEYS,10)
- ELSE
- KEYS(1) = KSN
- ENDIF
-
- LPATH = INDEXB(FILE1(1:LFILE1),'/') -1
- FNAME = FILE1(LPATH+2:LFILE1)
- LNAME = LENOCC(FNAME)
-*
-* Check how many copies of this dataset exist
-*
- CALL UCOPY(KEYS,KEYSIN,10)
-*
-* Don't compare media type, copy level or location code
-*
- KEYSIN(MKMTFA) = -1
- KEYSIN(MKCLFA) = -1
- KEYSIN(MKLCFA) = -1
- CALL FMSELK(FILE1(1:LFILE1),KEYSIN,KEYSOU,NMATCH,MAXCOP,IRC)
- IF(NMATCH.EQ.0) THEN
- IF(IDEBFA.GE.0)
- + PRINT *,'FMMVC. found 0 matches for ',FILE1(1:LFILE1)
- IRC = 1
- GOTO 99
- ELSEIF(NMATCH.GT.1.AND.KEYS(1).EQ.0) THEN
- IF(IDEBFA.GE.0) THEN
- PRINT *,'FMMVC. found ',NMATCH,' matches for ',
- + FILE1(1:LFILE1)
- PRINT *,'FMMVC. Please specify which entry is to be moved'
- ENDIF
- IRC = 1
- GOTO 99
- ELSE
-
- IF(IDEBFA.GE.1)
- + PRINT *,'FMMVC. found ',NMATCH,' matches for ',FILE1(1:LFILE1)
-
- CALL UCOPY(KEYS,KEYSIN,10)
-
- IFOUND = 0
- DO 10 I=1,NMATCH
-*
-* Was a specific key serial number specified?
-*
- IF((KEYSIN(1).NE.KEYSOU(1,I)).AND.(KEYSIN(1).NE.0)) GOTO 10
-
- IFOUND = 1
- CALL UCOPY(KEYSOU(1,I),KEYS,10)
-
- IF(IDEBFA.GE.1) THEN
- PRINT *,'FMMVC. candidate number ',I
- CALL FMPKEY(KEYSOU(1,I),LKEYFA)
- ENDIF
-
- LTDSFA = 0
- CALL FMGETK(FILE1(1:LFILE1),LTDSFA,KEYSOU(1,I),IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMMVC. Return code ',IRC,' '
- + //'from FMGETK'
- GOTO 99
- ENDIF
-*
-* Remove old file
-*
- CALL FMRM(FILE1(1:LFILE1),LTDSFA,KEYS,IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMMVC. return code ',IRC,
- + ' from FMRM'
- CALL MZDROP(IDIVFA,LTDSFA,' ')
- LTDSFA = 0
- GOTO 99
- ENDIF
-*
-* Override fields that were given
-*
- IF(JLOC.NE.0) THEN
- IQ(LTDSFA+KOFUFA+MLOCFA) = JLOC
- ENDIF
-
- IF(JDAT.NE.0) THEN
- IQ(LTDSFA+KOFUFA+MCPLFA) = JDAT
- ENDIF
-
- IF(JMED.NE.0) THEN
- IQ(LTDSFA+KOFUFA+MMTPFA) = JMED
- ENDIF
-*
-* Tape information
-*
- IF(LVID.GT.0) THEN
- CALL VBLANK(IQ(LTDSFA+KOFUFA+MVIDFA),NVIDFA/4)
- CALL UCTOH(VID,IQ(LTDSFA+KOFUFA+MVIDFA),4,LVID)
- IQ(LTDSFA+KOFUFA+MVIPFA) = JP
- ENDIF
-
- IF(LVSN.GT.0) THEN
- CALL VBLANK(IQ(LTDSFA+KOFUFA+MVSNFA),NVSNFA/4)
- CALL UCTOH(VSN,IQ(LTDSFA+KOFUFA+MVSNFA),4,LVSN)
- ENDIF
-
- IF(JFILE.NE.0) IQ(LTDSFA+KOFUFA+MFSQFA) = JFILE
-*
-* Disk information
-*
- IF(LDSN.GT.0) THEN
- CALL VBLANK(IQ(LTDSFA+KOFUFA+MFQNFA),NFQNFA/4)
- CALL UCTOH(DSN,IQ(LTDSFA+KOFUFA+MFQNFA),4,LDSN)
- ENDIF
-
- IF(LHOST.GT.0) THEN
- CALL VBLANK(IQ(LTDSFA+KOFUFA+MHSNFA),NHSNFA/4)
- CALL UCTOH(HOST,IQ(LTDSFA+KOFUFA+MHSNFA),4,LHOST)
- ENDIF
-*
-* Put new file
-*
- NFMVFL = NFMVFL + 1
- CALL FMPUT(FILE2(1:LFILE2),LTDSFA,IRC)
- CALL MZDROP(IDIVFA,LTDSFA,' ')
- LTDSFA = 0
- 10 CONTINUE
-
- ENDIF
-
- IF(KSN.NE.0.AND.IFOUND.EQ.0.AND.IDEBFA.GE.-2) PRINT *,'FMMVC. ',
- + ' no match found for ',PATH(1:LPATH),' key = ',KSN
-
- 99 CONTINUE
-*
-* Reset current directory
-*
- CALL RZCDIR(CHDIR(1:LCDIR),' ')
- END
diff --git a/src/packlib/fatmen/programs/fmkuip/fmnikk.F b/src/packlib/fatmen/programs/fmkuip/fmnikk.F
deleted file mode 100644
index 21e65cb..0000000
--- a/src/packlib/fatmen/programs/fmkuip/fmnikk.F
+++ /dev/null
@@ -1,46 +0,0 @@
-*
-* $Id: fmnikk.F,v 1.1.1.1 1996/03/07 15:17:44 mclareni Exp $
-*
-* $Log: fmnikk.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:44 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMNIKK
-
- CHARACTER*255 CHNICK,CHNAME,CHDESC,CHFILE
- CHARACTER*8 CHOPT
- LOGICAL IEXIST
-#include "fatmen/fatbug.inc"
-#include "fatmen/fatsys.inc"
-
- CALL KUGETC(CHNICK,LNICK)
- CALL KUGETC(CHFILE,LFILE)
- CALL KUGETC(CHOPT,LOPT)
-
- IF(LFILE.EQ.0) THEN
-
- CHFILE = ' '
- LFILE = 1
- ENDIF
-
- CALL FMGLUN(LUN,IC)
- CALL FMNICK(LUN,CHFILE(1:LFILE),CHNICK(1:LNICK),
- + CHNAME,CHDESC,CHOPT,IRC)
- CALL FMFLUN(LUN,IC)
-
- IF(IRC.EQ.32) THEN
- WRITE(LPRTFA,9001) CHNICK(1:LNICK),CHFILE(1:LFILE)
- RETURN
- ENDIF
-
- LNAME = LENOCC(CHNAME)
- LDESC = LENOCC(CHDESC)
-
- WRITE(LPRTFA,9002) CHNICK(1:LNICK),CHNAME(1:LNAME),CHDESC(1:LDESC)
-
-9002 FORMAT(' FMNIKK. nickname: ',A,' = ',A/,' description: ',A)
-9001 FORMAT(' FMNIKK. nickname ',A,' not found in ',A)
-
- END
diff --git a/src/packlib/fatmen/programs/fmkuip/fmpwd.F b/src/packlib/fatmen/programs/fmkuip/fmpwd.F
deleted file mode 100644
index f2d2784..0000000
--- a/src/packlib/fatmen/programs/fmkuip/fmpwd.F
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: fmpwd.F,v 1.1.1.1 1996/03/07 15:17:43 mclareni Exp $
-*
-* $Log: fmpwd.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:43 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMPWD
-#include "fatmen/fmpath.inc"
- COMMON/QUEST/ IQUEST(100)
- CHARACTER*80 LINE
-#if !defined(CERNLIB_CZ)
- CALL RZCDIR(' ','P')
- IF (IQUEST(1) .NE. 0) PRINT *,'Return code ',IQUEST(1),
- +' from RZCDIR'
-#endif
-#if defined(CERNLIB_CZ)
- CALL CZPUTA('MESS :CD',ISTAT)
- CALL CZGETA(LINE,ISTAT)
- PRINT *,LINE(3:80)
-#endif
- END
-C
diff --git a/src/packlib/fatmen/programs/fmkuip/fmquit.F b/src/packlib/fatmen/programs/fmkuip/fmquit.F
deleted file mode 100644
index a2a1a76..0000000
--- a/src/packlib/fatmen/programs/fmkuip/fmquit.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: fmquit.F,v 1.1.1.1 1996/03/07 15:17:43 mclareni Exp $
-*
-* $Log: fmquit.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:43 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMQUIT
-#include "fatmen/fatsys.inc"
-#include "fatmen/fstate.inc"
-#include "fatmen/fatron.inc"
- PRINT 9001
-9001 FORMAT(' *** FATMEN force termination. Use EXIT or END',
- + ' to terminate normally')
- IF (THRONG(1:4) .NE. 'NONE') THEN
-#if defined(CERNLIB_IBMVM)
- IF(SERMOD.NE.'A'.AND.SERMOD.NE.'?')
- + CALL VMCMS('EXEC DROP '//SERMOD,IRC)
-#endif
- CALL FMUPDT(0,0,1,IRC)
- MFPHAS = 2
- CALL FMEND(IRC)
- ENDIF
- END
diff --git a/src/packlib/fatmen/programs/fmkuip/fmrmc.F b/src/packlib/fatmen/programs/fmkuip/fmrmc.F
deleted file mode 100644
index 63e2b12..0000000
--- a/src/packlib/fatmen/programs/fmkuip/fmrmc.F
+++ /dev/null
@@ -1,356 +0,0 @@
-*
-* $Id: fmrmc.F,v 1.1.1.1 1996/03/07 15:17:43 mclareni Exp $
-*
-* $Log: fmrmc.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:43 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMRMC
-#include "fatmen/faust.inc"
-#include "fatmen/fatout.inc"
-#include "fatmen/fmpath.inc"
-#include "fatmen/fmnkeys.inc"
-#include "fatmen/fmaxcop.inc"
-#include "fatmen/fatbank.inc"
-#include "fatmen/fatpara.inc"
-#include "fatmen/fatsea.inc"
- DIMENSION KEYS(LKEYFA)
- DIMENSION KEYSIN(LKEYFA)
- DIMENSION KEYSOU(LKEYFA,MAXCOP)
- CHARACTER*20 CHOPT,CHPOOL,CHPROT,FNAME
- CHARACTER*255 PATH2
- CHARACTER*255 DSN,CHDSN
- CHARACTER*12 HOST,VID,USER
- CHARACTER*4 COMM
- CHARACTER*8 ACCT,ACNT,CHANS
- CHARACTER*3 CHYES
- INTEGER FMACNT
-
-*
-* Options: A - remove all occurances of this generic name
-* E - erase disk file
-* I - prompt before removing each matching entry
-* N - noprompt for option A
-* F - free tape associated with specified entry
-* P - when used with option F, allows privileged TMS
-* user to free anyones tapes (within a group)
-* U - 'unlock' or write-enable tape
-* D - delete TMS tag
-* B - binary TMS tag
-* T - text TMS tag
-*
- IC = FMACNT(ACCT)
-
- COMM = 'DEL '
-*
-* Save current directory
-*
- CALL RZCDIR(CDIR,'R')
- LCDIR = LENOCC(CDIR)
-
- CHYES = 'YES'
-
- OUTPUT = ' '
-
- KSN = 0
- IOPTA = 0
- IOPTB = 0
- IOPTD = 0
- IOPTE = 0
- IOPTF = 0
- IOPTG = 0
- IOPTI = 0
- IOPTN = 0
- IOPTP = 0
- IOPTU = 0
- CALL KUGETC(PATH,LPATH)
- CALL KUGETI(KSN)
- CALL KUGETC(DSN,LDSN)
- CALL KUGETC(HOST,LHOST)
- CALL KUGETC(VID,LVID)
- CALL KUGETC(USER,LUSER)
- CALL KUGETC(CHPOOL,LPOOL)
- CALL KUGETC(CHPROT,LPROT)
- CALL KUGETC(CHOPT,LCHOPT)
-
- IF(LPATH.EQ.0) RETURN
- CALL FMFIXF(PATH,PATH2)
- LPATH = LENOCC(PATH2)
- PATH = PATH2
-
- IF(IDEBFA.GE.3) PRINT *,'FMRMC. PATH = ',PATH(1:LPATH)
-
- IF(LDSN.EQ.0) THEN
- DSN = ' '
- ELSE
- IF(IDEBFA.GE.3) PRINT *,'FMRMC. DSN = ',DSN(1:LDSN)
- ENDIF
-
- IF(LHOST.EQ.0) THEN
- HOST = ' '
- ELSE
- IF(IDEBFA.GE.3) PRINT *,'FMRMC. HOST = ',HOST(1:LHOST)
- ENDIF
-
- IF(LVID.EQ.0) THEN
- VID = ' '
- ELSE
- IF(IDEBFA.GE.3) PRINT *,'FMRMC. VID = ',VID(1:LVID)
- ENDIF
-
- IF(LUSER.EQ.0) THEN
- USER = ' '
- ELSE
- IF(IDEBFA.GE.3) PRINT *,'FMRMC. USER = ',USER(1:LUSER)
- ENDIF
-
- IF(LCHOPT.EQ.0) THEN
- LCHOPT = 1
- CHOPT = ' '
- ELSE
- IF(IDEBFA.GE.3) PRINT *,'FMRMC. CHOPT = ',CHOPT(1:LCHOPT)
- ENDIF
-
- IF(INDEX(CHOPT(1:LCHOPT),'A').NE.0) IOPTA = 1
- IF(INDEX(CHOPT(1:LCHOPT),'B').NE.0) IOPTB = 1
- IF(INDEX(CHOPT(1:LCHOPT),'D').NE.0) IOPTD = 1
- IF(INDEX(CHOPT(1:LCHOPT),'E').NE.0) IOPTE = 1
- IF(INDEX(CHOPT(1:LCHOPT),'G').NE.0) IOPTG = 1
- IF(INDEX(CHOPT(1:LCHOPT),'F').NE.0) IOPTF = 1
- IF(INDEX(CHOPT(1:LCHOPT),'I').NE.0) IOPTI = 1
- IF(INDEX(CHOPT(1:LCHOPT),'N').NE.0) IOPTN = 1
- IF(INDEX(CHOPT(1:LCHOPT),'P').NE.0) IOPTP = 1
- IF(INDEX(CHOPT(1:LCHOPT),'U').NE.0) IOPTU = 1
-
- IF(IOPTA.NE.0) THEN
- IF(IOPTN.NE.0) THEN
- IF(IDEBFA.GE.0) THEN
- PRINT *,'FMRMC. warning. all matching entries will '
- + //'be deleted without prompting.'
- CALL KUPROC('FMRMC. Do you want to continue??? ',
- + CHANS,LENANS)
- IF(LENANS.EQ.0) THEN
- LENANS = 2
- CHANS = 'NO'
- ENDIF
- IF(CHANS(1:LENANS).NE.CHYES(1:LENANS)) RETURN
- IOPTI = 0
- ENDIF
- ELSE
- IOPTI = 1
- ENDIF
- ENDIF
-
- IDCREA = -1
- IDCATA = -1
- IDLAST = -1
-
- DO 20 I=1,2
- DO 10 J=1,10
- IUSER(I,J) = -1
- 10 CONTINUE
- 20 CONTINUE
-
- IF((IOPTF.NE.0).AND.(LPOOL.EQ.0)) THEN
- CHPOOL = ACCT(5:6)//'_FAT1'
- LPOOL = 7
- IF(IDEBFA.GE.0) PRINT *,'FMRMC. tape will be returned to ',
- + ' pool ',CHPOOL(1:LPOOL)
- ENDIF
-
- IF((IOPTG.NE.0).AND.(LPROT.EQ.0)) THEN
-
- IF(IOPTP.EQ.0) THEN
- CHPROT = '*None'
- LPROT = 5
- ELSE
- CHPROT = CHPOOL
- LPROT = 7
- ENDIF
-
- IF(IDEBFA.GE.0) PRINT *,'FMRMC. protection group will ',
- + 'be set to ',CHPROT(1:LPROT)
- ENDIF
-
- IF(KSN.EQ.0) THEN
- CALL VZERO(KEYS,10)
- ELSE
- KEYS(1) = KSN
- ENDIF
-
- LFILE = INDEXB(PATH(1:LPATH),'/') -1
- FNAME = PATH(LFILE+2:LPATH)
- CALL RZCDIR(PATH(1:LFILE),'U')
- LNAME = LENOCC(FNAME)
-*
-* Check how many copies of this dataset exist
-*
- CALL UCOPY(KEYS,KEYSIN,10)
-*
-* Don't compare media type, copy level or location code
-*
- KEYSIN(MKMTFA) = -1
- KEYSIN(MKCLFA) = -1
- KEYSIN(MKLCFA) = -1
- CALL FMSELK(PATH(1:LPATH),KEYSIN,KEYSOU,NMATCH,MAXCOP,IRC)
- IF(NMATCH.EQ.0) THEN
- IF(IDEBFA.GE.0)
- + PRINT *,'FMRMC. found 0 matches for ',PATH(1:LPATH)
- IRC = 1
- GOTO 50
- ELSEIF((NMATCH.GT.1).AND.(KEYS(1).EQ.0)
- + .AND.(IOPTA.EQ.0)) THEN
- IF(IDEBFA.GE.0) THEN
- PRINT *,'FMRMC. found ',NMATCH,' matches for ',PATH(1:LPATH)
- PRINT *,'FMRMC. Please specify which copy is to be deleted'
- ENDIF
- IRC = 1
- GOTO 50
- ELSE
-
- IF(IDEBFA.GE.1)
- + PRINT *,'FMRMC. found ',NMATCH,' matches for ',PATH(1:LPATH)
-
- CALL UCOPY(KEYS,KEYSIN,10)
-
- IFOUND = 0
- DO 40 I=1,NMATCH
-*
-* Was a specific key serial number specified?
-*
- IF((KEYSIN(1).NE.KEYSOU(1,I)).AND.(KEYSIN(1).NE.0)) GOTO
- + 40
-
- IFOUND = 1
- CALL UCOPY(KEYSOU(1,I),KEYS,10)
-
- IF(IDEBFA.GE.1) THEN
- PRINT *,'FMRMC. candidate number ',I
- CALL FMPKEY(KEYSOU(1,I),LKEYFA)
- ENDIF
-
- LTDSFA = 0
- CALL RZCDIR(PATH(1:LFILE),'U')
- CALL FMGETK(PATH(1:LPATH),LTDSFA,KEYSOU(1,I),IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMRMC. Return code ',IRC,' '
- + //'from FMGETK'
- GOTO 50
- ENDIF
-
-*
-* Check account against that of creator, permitting account aliases
-*
- CALL UHTOC(IQ(LTDSFA+KOFUFA+MCIDFA),4,ACNT,8)
- CALL FMACCT(ACCT,ACNT,IRC)
-* IF (ACNT .NE. ACCT) THEN
- IF(IRC.NE.0) THEN
-
- WRITE(LPRTFA,*) 'FMRMC. key serial number = ',KEYSOU(1,
- + I)
- WRITE(LPRTFA,*) 'You cannot delete this file'
- WRITE(LPRTFA,*) 'File is owned by ',ACNT, ' current '
- + //'account = ',ACCT
- IRC = 1
- GOTO 30
- ENDIF
-*
-* Now check if this entry matches
-* (no check on user file format or comment)
-*
- CALL FMSEAR(PATH(1:LPATH),LTDSFA,KEYS,DSN,HOST,VID, USER,' '
- + ,' ',IRET)
- IF(IRET.NE.0) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMRMC. return code ',IRET,
- + ' from FMSEAR'
- GOTO 30
- ENDIF
-
- IF(IOPTI.NE.0) THEN
-
- CALL FMSHOW(PATH(1:LPATH),LTDSFA,KEYS,'A',IC)
- CALL KUPROC('FMRMC. Delete??? ',CHANS,LENANS)
- IF(LENANS.EQ.0) THEN
- LENANS = 2
- CHANS = 'NO'
- ENDIF
-
- IF(CHANS(1:LENANS).NE.CHYES(1:LENANS)) GOTO 30
-
- ENDIF
-
- CALL FMVERI(PATH(1:LPATH),LTDSFA,KEYS,'A',IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMRMC. error(s) detected ',
- + 'by FMVERI. Cannot perform deletion.'
- GOTO 30
- ENDIF
-
- NFRMFL = NFRMFL + 1
- CALL FMFZO(COMM,PATH,LTDSFA,KEYS,IRC)
- IF(IRC.NE.0) GOTO 30
-*
-* Erase disk file?
-*
- IF(IOPTE.NE.0.AND.KEYS(MKMTFA).EQ.1) THEN
- CALL UHTOC(IQ(LTDSFA+KOFUFA+MFQNFA),4,CHDSN,NFQNFA)
- CALL FAERAS(CHDSN,IRC)
- ELSEIF(KEYS(MKMTFA).GT.1) THEN
-*
-* TMS tags?
-*
- IF(IOPTD.NE.0) THEN
- IF(IOPTB.EQ.0.AND.IOPTT.EQ.0) IOPTT = 1
- IF(IOPTB.NE.0) THEN
- CALL FMTAGS(PATH(1:LPATH),LTDSFA,KEYS,' ','DB',
- + IRC)
- ENDIF
- IF(IOPTT.NE.0) THEN
- CALL FMTAGS(PATH(1:LPATH),LTDSFA,KEYS,' ','DT',
- + IRC)
- ENDIF
- ENDIF
-
- IF(IOPTU.NE.0) THEN
- CALL FMULOK(PATH(1:LPATH),LTDSFA,KEYS,' ',IRC)
- IF(IRC.NE.0) PRINT *,'FMRMC. return code ',IRC,
- + ' from FMULOK'
- ENDIF
-
- IF(IOPTG.NE.0) THEN
- CALL FMPROT(PATH(1:LPATH),LTDSFA,KEYS, CHPROT(1:
- + LPROT),' ',IRC)
- IF(IRC.NE.0) PRINT *,'FMRMC. return code ',IRC,
- + ' from FMPROT'
- ENDIF
-
- IF((IOPTF.NE.0).AND.(LPOOL.NE.0)) THEN
- IF(IOPTP.EQ.0) THEN
- CALL FMPOOL(PATH(1:LPATH),LTDSFA,KEYS,CHPOOL(1:
- + LPOOL), ' ',IRC)
- ELSE
- CALL FMPOOL(PATH(1:LPATH),LTDSFA,KEYS,CHPOOL(1:
- + LPOOL), 'P',IRC)
- ENDIF
- IF(IRC.NE.0) PRINT *,'FMRMC. return code ',IRC,
- + ' from FMPOOL'
- ENDIF
- ENDIF
-
- 30 CONTINUE
- CALL MZDROP(IDIVFA,LTDSFA,' ')
- LTDSFA = 0
- 40 CONTINUE
- ENDIF
- IF(KSN.NE.0.AND.IFOUND.EQ.0.AND.IDEBFA.GE.-2) PRINT *,'FMRMC. ',
- + ' no match found for ',PATH(1:LPATH),' key = ',KSN
-
- 50 CONTINUE
-*
-* Reset current directory
-*
- CALL RZCDIR(CDIR(1:LCDIR),' ')
- END
-
diff --git a/src/packlib/fatmen/programs/fmkuip/fmrmdc.F b/src/packlib/fatmen/programs/fmkuip/fmrmdc.F
deleted file mode 100644
index 736522f..0000000
--- a/src/packlib/fatmen/programs/fmkuip/fmrmdc.F
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: fmrmdc.F,v 1.1.1.1 1996/03/07 15:17:43 mclareni Exp $
-*
-* $Log: fmrmdc.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:43 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMRMDC
- CHARACTER*255 FTEMP
-#include "fatmen/fmpath.inc"
-#include "fatmen/fatsys.inc"
-#include "fatmen/fatinit.inc"
-*
-* Save current directory
-*
- CALL RZCDIR(CDIR,'R')
- LCDIR = LENOCC(CDIR)
- CALL KUGETC(PATH,LPATH)
- IF(LPATH.EQ.0) RETURN
- CALL FMFIXF(PATH,FTEMP)
- PATH = FTEMP
- LPATH = LENOCC(PATH)
- CALL FMRMDR(PATH(1:LPATH),IRC)
- IF (IRC .NE. 0) PRINT *,'Return code ',IRC,' from FMRMDR'
-*
-* Reset current directory
-*
- CALL RZCDIR(CDIR(1:LCDIR),' ')
- END
diff --git a/src/packlib/fatmen/programs/fmkuip/fmrmlc.F b/src/packlib/fatmen/programs/fmkuip/fmrmlc.F
deleted file mode 100644
index 7753883..0000000
--- a/src/packlib/fatmen/programs/fmkuip/fmrmlc.F
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: fmrmlc.F,v 1.1.1.1 1996/03/07 15:17:44 mclareni Exp $
-*
-* $Log: fmrmlc.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:44 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMRMLC
-
- CHARACTER*255 CHLINK,CHFILE
- CHARACTER*8 CHOPT
-
- CALL KUGETC(CHFILE,LLINK)
- CALL FMFIXF(CHFILE,CHLINK)
- LLINK = LENOCC(CHLINK)
- CALL KUGETI(LWRITE)
- CALL KUGETC(CHFILE,LFILE)
- CALL KUGETC(CHOPT,LOPT)
-
- CALL FMRMLN(CHLINK(1:LLINK),LWRITE,CHFILE(1:LFILE),
- + CHOPT(1:LOPT),IRC)
-
- END
diff --git a/src/packlib/fatmen/programs/fmkuip/fmrmtc.F b/src/packlib/fatmen/programs/fmkuip/fmrmtc.F
deleted file mode 100644
index 10b717b..0000000
--- a/src/packlib/fatmen/programs/fmkuip/fmrmtc.F
+++ /dev/null
@@ -1,175 +0,0 @@
-*
-* $Id: fmrmtc.F,v 1.2 1996/04/02 10:26:36 cernlib Exp $
-*
-* $Log: fmrmtc.F,v $
-* Revision 1.2 1996/04/02 10:26:36 cernlib
-* Split up line with "/ *" ( without this blank) to avoid start a comment
-*
-* Revision 1.1.1.1 1996/03/07 15:17:43 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMRMTC
-#include "fatmen/faust.inc"
- PARAMETER (MAXFIL=2)
- PARAMETER (MAXDIR=100)
- PARAMETER (LKEYFA=10)
- PARAMETER (LZERO=0)
- CHARACTER*255 FILES(MAXFIL),PATH,CHPATH,PREDIR
- CHARACTER*255 PATH2
- CHARACTER*255 CHDIR(MAXDIR),CHTMP
-#include "fatmen/fatsys.inc"
- CHARACTER*20 CHFILE,MATCH,FNAME
- CHARACTER*36 CHOPT,OPTN
- CHARACTER*3 CHSTAT
- CHARACTER*4 COMM
-#include "fatmen/fatbank.inc"
-#include "fatmen/fatpara.inc"
- DIMENSION MYKEYS(LKEYFA,MAXFIL)
- DIMENSION KEYS(LKEYFA)
- CHARACTER*4 WILD
- DATA WILD/'%*(['/
-#include "fatmen/fatinit.inc"
-*
- CALL RZCDIR(PREDIR,'R')
-
- COMM = 'DDIR'
- PATH = ' '
- CALL KUGETC(PATH,LPATH)
- IX = ICFMUL(WILD,PATH,1,LPATH)
- IF(IX.LE.LPATH) THEN
- PRINT *,'FMRMTC. path must not contain wild-cards'
- RETURN
- ENDIF
-
- NFRTRE = NFRTRE + 1
-
- CALL FMFIXF(PATH,CHPATH)
- LPATH = LENOCC(CHPATH)
- CHPATH(LPATH+1:LPATH+1) = '/'
- CHPATH(LPATH+2:LPATH+2) = '*'
- LP = LPATH + 2
-*
- NFOUND = 0
- NDIRT = 0
- ICONT = 0
- IPASS = 0
-*
-* Any files at this level?
-*
- CALL RZCDIR(PATH(1:LPATH),' ')
- IF(IQUEST(1).NE.0) THEN
- PRINT *,'FMRMTC. error setting directory to ',
- + PATH(1:LPATH)
- RETURN
- ENDIF
-
- CALL FMKEYS(LKEYFA,MAXFIL,IFIRST,ILAST,MYKEYS,NFILES,IRET)
- NFIL = IQUEST(11)
- IF(IDEBFA.GE.2) PRINT *,'FMRMTC. ',NFIL,' files in ',
- + PATH(1:LPATH)
-
- IF(NFIL.NE.0) THEN
- WRITE(LPRTFA,*)
- WRITE(LPRTFA,*) 'Directory: ',PATH(1:LPATH),
- + ' contains ',NFIL,' file(s)'
- PRINT *,'FMRMTC. directory tree cannot be deleted'
- GOTO 99
- ENDIF
-
-*
-* Get list of subdirectories
-*
- 10 CONTINUE
- CALL FMLDIR(CHPATH(1:LP),CHDIR,NDIRS,MAXDIR,ICONT,IRC)
- IF(IRC.EQ.-1) THEN
- ICONT = 1
- ELSEIF(IRC.NE.0) THEN
- PRINT *,'FMRMTC. return code ',IRC,' from FMLDIR'
- RETURN
- ELSE
- ICONT = 0
- ENDIF
-
- 20 CONTINUE
-
- NDIRT = NDIRT + NDIRS
-
- DO 70 I=1,NDIRS
- LEND = LENOCC(CHDIR(I))
- IF(IPASS.EQ.1) THEN
- CALL FMVERI(CHDIR(I)(1:LEND),LZERO,KEYS,'G',IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GT.-3) PRINT *,'FMRMTC. errors detected by ',
- + 'FMVERI - update will not be processed'
- RETURN
- ENDIF
-
- IF(IDEBFA.GE.0) PRINT *,'FMRMTC. removing directory ',
- + CHDIR(I)(1:LEND)
-
- CALL FMFZO(COMM,CHDIR(I)(1:LEND),LZERO,KEYS,IRC)
- ELSE
- IF(IDEBFA.GE.2) PRINT *,'FMRMTC. processing directory ',
- + CHDIR(I)(1:LEND)
- CALL RZCDIR(CHDIR(I)(1:LEND),' ')
-*
-* Any subdirectories are there at this level?
-*
- CALL RZRDIR(1,CHTMP,NDIR)
- NDIR = IQUEST(11)
- IF(IDEBFA.GE.2) PRINT *,'FMRMTC. ',NDIR,' subdirectories'
-*
-* Any files?
-*
- IFIRST = 1
- ILAST = MAXFIL
- NMAT = 0
- NFIL = 0
-
- 30 CONTINUE
- CALL FMKEYS(LKEYFA,MAXFIL,IFIRST,ILAST,MYKEYS,NFILES,IRET)
- NFIL = IQUEST(11)
- IF(IDEBFA.GE.2) PRINT *,'FMRMTC. ',NFIL,' files'
-
- IF(NFIL.NE.0) THEN
- WRITE(LPRTFA,*)
- WRITE(LPRTFA,*) 'Directory: ',CHDIR(I)(1:LEND), ' '
- + //'contains ',NFIL,' file(s)'
- PRINT *,'FMRMTC. directory tree cannot be deleted'
- GOTO 99
- ENDIF
-
- 60 CONTINUE
- NFOUND = NFOUND + NFIL
-
- ENDIF
- 70 CONTINUE
- IF(ICONT.NE.0) GOTO 10
-
- IF(IPASS.EQ.1) THEN
-*
-* Now remove top level directory
-*
- CALL FMVERI(CHPATH(1:LPATH),LZERO,KEYS,'G',IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GT.-3) PRINT *,'FMRMTC. errors detected by ',
- + 'FMVERI - update will not be processed'
- RETURN
- ENDIF
- IF(IDEBFA.GE.0) PRINT *,'FMRMTC. removing directory ',
- + CHPATH(1:LPATH)
- CALL FMFZO(COMM,CHPATH(1:LPATH),LZERO,KEYS,IRC)
- GOTO 99
- ENDIF
-
- PRINT *,'FMRMTC. directory tree empty, starting deletion pass'
- IPASS = 1
- ICONT = 0
- GOTO 10
-
- 99 CONTINUE
- CALL RZCDIR(PREDIR,' ')
- RETURN
- END
diff --git a/src/packlib/fatmen/programs/fmkuip/fmrzld.F b/src/packlib/fatmen/programs/fmkuip/fmrzld.F
deleted file mode 100644
index bbf84e5..0000000
--- a/src/packlib/fatmen/programs/fmkuip/fmrzld.F
+++ /dev/null
@@ -1,65 +0,0 @@
-*
-* $Id: fmrzld.F,v 1.1.1.1 1996/03/07 15:17:43 mclareni Exp $
-*
-* $Log: fmrzld.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:43 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMRZLD
-*CMZ : 21/08/91 14.44.10 by Jamie Shiers
-*-- Author : Jamie Shiers 21/08/91
-#include "zebra/zunit.inc"
-#include "fatmen/fatbank.inc"
-#include "fatmen/fatpara.inc"
-#include "fatmen/fmnkeys.inc"
-#include "fatmen/fatsys.inc"
- CHARACTER*255 PATH,PATH1
- CHARACTER*80 OUTPUT,CHOPT
- LOGICAL IOPEN
-#include "fatmen/fatinit.inc"
-
- CALL KUGETC(PATH1,LPATH)
- IF(LPATH.EQ.0) THEN
- CALL RZCDIR(PATH,'R')
- ELSE
- CALL FMFIXF(PATH1,PATH)
- ENDIF
- LPATH = LENOCC(PATH)
-
- CALL KUGETC(OUTPUT,LOUT)
-
- CALL KUGETC(CHOPT,LCH)
-
- IF(LCH.EQ.0) CHOPT = ' '
-
- IQFATS = IQPRNT
-
- IF((OUTPUT(1:LOUT).EQ.'TTY').OR.(LOUT.EQ.0)) THEN
- OUTPUT = ' '
- LWRITE = LPRTFA
- ELSE
- LWRITE = 3
- IF(IDEBFA.GE.2)
- + PRINT *,'FMRZLD. output will be redirected to ',OUTPUT(1:LOUT)
- CALL FAFILE(LWRITE,OUTPUT(1:LOUT),IRET)
- IF(IRET.NE.0) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMRZLD. return code ',IRET,
- + ' opening file ',OUTPUT(1:LOUT),
- + ' - output will be sent to screen'
- OUTPUT = ' '
- LWRITE = LPRTFA
- ENDIF
- ENDIF
-*
-* Call RZLDIR
-*
- IQPRNT = LWRITE
-
- CALL RZLDIR(PATH(1:LPATH),CHOPT)
-
- INQUIRE(3,OPENED=IOPEN)
- IF(IOPEN) CLOSE(3)
- IQPRNT = IQFATS
- END
diff --git a/src/packlib/fatmen/programs/fmkuip/fmscat.F b/src/packlib/fatmen/programs/fmkuip/fmscat.F
deleted file mode 100644
index 5144886..0000000
--- a/src/packlib/fatmen/programs/fmkuip/fmscat.F
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: fmscat.F,v 1.1.1.1 1996/03/07 15:17:43 mclareni Exp $
-*
-* $Log: fmscat.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:43 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMSCAT
-*
-* Display FATMEN catalogues that are available
-*
-#if defined(CERNLIB_UNIX)||defined(CERNLIB_VAXVMS)
- PRINT *
- PRINT *,'FMSCAT. list of FATMEN catalogues...'
- PRINT *
-#endif
-#if defined(CERNLIB_UNIX)
- CALL SYSTEMF('printenv | grep FM')
-#endif
-#if defined(CERNLIB_VAXVMS)
- CALL SYSTEMF('SHOW SYMBOL FM*')
-#endif
-#if (!defined(CERNLIB_UNIX))&&(!defined(CERNLIB_VAXVMS))
- PRINT *,'FMSCAT. this command only works on ',
- + 'VMS or Unix systems'
-#endif
- END
diff --git a/src/packlib/fatmen/programs/fmkuip/fmscpl.F b/src/packlib/fatmen/programs/fmkuip/fmscpl.F
deleted file mode 100644
index e912bb7..0000000
--- a/src/packlib/fatmen/programs/fmkuip/fmscpl.F
+++ /dev/null
@@ -1,30 +0,0 @@
-*
-* $Id: fmscpl.F,v 1.1.1.1 1996/03/07 15:17:43 mclareni Exp $
-*
-* $Log: fmscpl.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:43 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMSCPL
-*CMZ : 30/04/91 16.52.25 by Jamie Shiers
-*-- Author : Jamie Shiers 30/04/91
-#include "fatmen/fatsys.inc"
-#include "fatmen/fatpara.inc"
-#include "fatmen/fatbug.inc"
-#include "fatmen/fatcpl.inc"
-#include "fatmen/fmdrep.inc"
-#include "fatmen/fatinit.inc"
-
- IF(NUMCPL.EQ.0) THEN
- PRINT *,'FMSCPL. no data representations defined. ',
- + 'Checks on data repr. will be skipped'
- ELSE
- DO 10 I=1,NUMCPL
- PRINT 9001,I,MFMCPL(I),CHDREP(MFMCPL(I))
-9001 FORMAT(' FMSCPL. data repr. # ',I2.2,' = ',I6.6,' = ',A30)
- 10 CONTINUE
- ENDIF
-
- END
diff --git a/src/packlib/fatmen/programs/fmkuip/fmsdst.F b/src/packlib/fatmen/programs/fmkuip/fmsdst.F
deleted file mode 100644
index 3bff47b..0000000
--- a/src/packlib/fatmen/programs/fmkuip/fmsdst.F
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: fmsdst.F,v 1.1.1.1 1996/03/07 15:17:43 mclareni Exp $
-*
-* $Log: fmsdst.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:43 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMSDST
-
-#include "fatmen/fatsys.inc"
-#include "fatmen/fatsat.inc"
-#include "fatmen/fatinit.inc"
-
- IF(LDSTST.EQ.0) THEN
- PRINT *,'FMSDST. destination site has not been set'
- ELSE
- PRINT *,'FMSDST. destination site is ',CHDEST(1:LDSTST)
- ENDIF
-
- END
diff --git a/src/packlib/fatmen/programs/fmkuip/fmseac.F b/src/packlib/fatmen/programs/fmkuip/fmseac.F
deleted file mode 100644
index 4327025..0000000
--- a/src/packlib/fatmen/programs/fmkuip/fmseac.F
+++ /dev/null
@@ -1,171 +0,0 @@
-*
-* $Id: fmseac.F,v 1.1.1.1 1996/03/07 15:17:43 mclareni Exp $
-*
-* $Log: fmseac.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:43 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMSEAC
- CHARACTER*255 PATH2
- CHARACTER*255 PATH,CHPATH,PREDIR
- CHARACTER*80 CHCRE,CHCAT,CHACC
-#include "fatmen/fasecm.inc"
-#include "fatmen/fatsea.inc"
-#include "fatmen/fatpara.inc"
-#include "fatmen/fatuwd.inc"
-#include "fatmen/fatloc.inc"
-#include "fatmen/fatmtp.inc"
-#include "fatmen/fatcpl.inc"
-#include "fatmen/fatsys.inc"
-#include "fatmen/fatout.inc"
- CHARACTER*36 CHOPT
-#include "fatmen/fatbank.inc"
- LOGICAL IOPEN,IEXIST
- EXTERNAL FASEAC
-#include "fatmen/fatinit.inc"
-*
- OUTPUT = ' '
- LOUT = 0
- LWRITE = LPRTFA
- CALL RZCDIR(PREDIR,'R')
- CALL RZCDIR(PREDIR,'U')
-
- PATH = ' '
- CALL KUGETC(PATH,LPATH)
- CALL FMFIXF(PATH,PATH2)
- PATH = PATH2
- LPATH = LENOCC(PATH2)
-
- CALL KUGETC(DSN,LDSN)
- CALL KUGETC(HOST,LHOST)
- CALL KUGETC(VID,LVID)
- CALL KUGETC(USER,LUSER)
- CALL KUGETI(NMATCH)
- CALL KUGETC(CHCRE,LCHCRE)
- CALL KUGETC(CHCAT,LCHCAT)
- CALL KUGETC(CHACC,LCHACC)
- CALL KUGETC(UFORM,LFORM)
- CALL KUGETC(COMM,LCOMM)
- CALL KUGETC(OUTPUT,LOUT)
- CALL KUGETC(CHOPT,LCHOPT)
-
- IF(LDSN.EQ.0) DSN = ' '
- IF(LHOST.EQ.0) HOST = ' '
- IF(LVID.EQ.0) VID = ' '
- IF(LUSER.EQ.0) USER = ' '
- IF(LFORM.EQ.0) UFORM = ' '
- IF(LCOMM.EQ.0) COMM = ' '
- IF(LCHOPT.EQ.0) CHOPT = ' '
-
- IF(IDEBFA.GE.1) THEN
- IF(LDSN .GT.0) PRINT *,'FMSEAC. dsn = ',DSN(1:LDSN)
- IF(LHOST.GT.0) PRINT *,'FMSEAC. host = ',HOST(1:LHOST)
- IF(LVID .GT.0) PRINT *,'FMSEAC. vid = ',VID(1:LVID)
- IF(LUSER.GT.0) PRINT *,'FMSEAC. user = ',USER(1:LUSER)
- IF(LFORM.GT.0) PRINT *,'FMSEAC. uform = ',UFORM(1:LFORM)
- IF(LCOMM.GT.0) PRINT *,'FMSEAC. comment = ',COMM(1:LCOMM)
- ENDIF
-*
-* Date and time ranges:
-*
- IF(LCHCRE.NE.0) THEN
- CALL FMDTRN(CHCRE(1:LCHCRE),IDCREA,ITCREA,JDCREA,JTCREA,IC)
- IF(IDEBFA.GE.1) PRINT *,'FMSEAC. range of creation dates & ',
- + 'times is ',IDCREA,ITCREA,JDCREA,JTCREA
- ELSE
- IDCREA = -1
- ENDIF
-
- IF(LCHCAT.NE.0) THEN
- CALL FMDTRN(CHCAT(1:LCHCAT),IDCATA,ITCATA,JDCATA,JTCATA,IC)
- IF(IDEBFA.GE.1) PRINT *,'FMSEAC. range of dates & ',
- + 'times of cataloging is ',IDCATA,ITCATA,JDCATA,JTCATA
- ELSE
- IDCATA = -1
- ENDIF
-
- IF(LCHACC.NE.0) THEN
- CALL FMDTRN(CHACC(1:LCHACC),IDLAST,ITLAST,JDLAST,JTLAST,IC)
- IF(IDEBFA.GE.1) PRINT *,'FMSEAC. range of dates & ',
- + 'times of last access is ',IDLAST,ITLAST,JDLAST,JTLAST
- ELSE
- IDLAST = -1
- ENDIF
-*
-* Copy ranges of user words
-*
- CALL UCOPY(IFUSER,IUSER,20)
-
- IF((OUTPUT(1:LOUT).EQ.'TTY').OR.(LOUT.EQ.0)) THEN
- OUTPUT = ' '
- LWRITE = LPRTFA
- ELSE
- LWRITE = 3
- IF(IDEBFA.GE.2)
- + PRINT *,'FMSEAC. output will be redirected to ',OUTPUT(1:LOUT)
- CALL FAFILE(LWRITE,OUTPUT(1:LOUT),IRET)
- IF(IRET.NE.0) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMSEAC. return code ',IRET,
- + 'from OPEN for ',OUTPUT(1:LOUT)
- ENDIF
- ENDIF
-
- IF(LENOCC(CHOPT).EQ.0) THEN
- CHOPT = ' '
- LCHOPT = 1
- ENDIF
-*
-* Check for D option
-*
- IF(INDEX(CHOPT(1:LCHOPT),'D').NE.0) THEN
- PRINT *,'FMSEAC. warning - files should be deleted by '//
- + 'descending key serial number'
- ENDIF
-*
- IF(INDEX(CHOPT(1:LCHOPT),'H').NE.0) THEN
- WRITE(LWRITE,*) '>>> Command: SEARCH ',
- + 'Options: ',CHOPT(1:LCHOPT)
- WRITE(LWRITE,*) '>>> Path: ',PATH(1:LPATH)
- WRITE(LWRITE,*) '>>> Current directory: ',
- + PREDIR(1:LENOCC(PREDIR))
- ENDIF
-*
- NFILES = 0
- NDIRS = 0
-*
-* Look for some files and show the bank and key content:
-*
- LSLASH = INDEXB(PATH(1:LPATH),'/')
- CHPATH = PATH(1:LSLASH-1)
- CHFILE = PATH(LSLASH+1:LPATH)
- LP = LENOCC(CHPATH)
- LC = LENOCC(CHFILE)
- IF(IDEBFA.GE.2) PRINT *,'FMSEAC. enter for path = ',
- + PATH(1:LPATH),' chopt = ',CHOPT
-
- CALL FMOPTC(CHOPT,ALFNUM,IOPT)
-
- IF(ICFMUL('*%(<>[]',CHPATH,1,LP).GT.LP) THEN
- CALL RZCDIR(CHPATH(1:LP),' ')
- CALL FASEAC(CHPATH(1:LP),IRC)
- ELSE
- CALL FMSCAN(CHPATH(1:LP),99,FASEAC,IRC)
- ENDIF
-
- WRITE(LWRITE,*)
-
- IF(IOPTD.NE.0) THEN
- WRITE(LPRTFA,*) 'Total of ',NFILES,
- + ' candidates for deletion in ',NDIRS,' directories'
- ELSE
- WRITE(LWRITE,*) 'Total of ',NFILES,
- + ' matches in ',NDIRS,' directories'
- ENDIF
-
- INQUIRE(3,OPENED=IOPEN)
- IF(IOPEN) CLOSE(3)
- CALL RZCDIR(PREDIR,' ')
- RETURN
- END
diff --git a/src/packlib/fatmen/programs/fmkuip/fmskan.F b/src/packlib/fatmen/programs/fmkuip/fmskan.F
deleted file mode 100644
index 1b903f7..0000000
--- a/src/packlib/fatmen/programs/fmkuip/fmskan.F
+++ /dev/null
@@ -1,182 +0,0 @@
-*
-* $Id: fmskan.F,v 1.1.1.1 1996/03/07 15:17:44 mclareni Exp $
-*
-* $Log: fmskan.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:44 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMSKAN
- CHARACTER*255 PATH2
- CHARACTER*255 PATH,CHPATH,PREDIR
- CHARACTER*80 CHCRE,CHCAT,CHACC
-#include "fatmen/facard.inc"
-#include "fatmen/fasecm.inc"
-#include "fatmen/fatsea.inc"
-#include "fatmen/fatpara.inc"
-#include "fatmen/fatuwd.inc"
-#include "fatmen/fatloc.inc"
-#include "fatmen/fatmtp.inc"
-#include "fatmen/fatcpl.inc"
-#include "fatmen/fatsys.inc"
-#include "fatmen/fatout.inc"
- CHARACTER*36 CHOPT
-#include "fatmen/fatbank.inc"
- LOGICAL IOPEN,IEXIST
- EXTERNAL FASEAR
-#include "fatmen/fatinit.inc"
-*
- OUTPUT = ' '
- LOUT = 0
- LWRITE = LPRTFA
- CALL RZCDIR(PREDIR,'R')
- CALL RZCDIR(PREDIR,'U')
-
- PATH = ' '
- CALL KUGETC(PATH,LPATH)
- CALL FMFIXF(PATH,PATH2)
- PATH = PATH2
- LPATH = LENOCC(PATH2)
-
- CALL KUGETI(NLEVEL)
-
- CALL KUGETC(DSN,LDSN)
- CALL KUGETC(HOST,LHOST)
- CALL KUGETC(VID,LVID)
- CALL KUGETC(USER,LUSER)
- CALL KUGETI(NMATCH)
- CALL KUGETC(CHCRE,LCHCRE)
- CALL KUGETC(CHCAT,LCHCAT)
- CALL KUGETC(CHACC,LCHACC)
- CALL KUGETC(UFORM,LFORM)
- CALL KUGETC(COMM,LCOMM)
- CALL KUGETC(OUTPUT,LOUT)
- CALL KUGETC(CHSTR,LSTR)
- CALL KUGETC(CHOPT,LCHOPT)
-
- IF(LDSN.EQ.0) DSN = ' '
- IF(LHOST.EQ.0) HOST = ' '
- IF(LVID.EQ.0) VID = ' '
- IF(LUSER.EQ.0) USER = ' '
- IF(LFORM.EQ.0) UFORM = ' '
- IF(LSTR.EQ.0) CHSTR = ' '
- IF(LCOMM.EQ.0) COMM = ' '
- IF(LCHOPT.EQ.0) CHOPT = ' '
-
- IF(IDEBFA.GE.1) THEN
- IF(LDSN .GT.0) PRINT *,'FMSKAN. dsn = ',DSN(1:LDSN)
- IF(LHOST.GT.0) PRINT *,'FMSKAN. host = ',HOST(1:LHOST)
- IF(LVID .GT.0) PRINT *,'FMSKAN. vid = ',VID(1:LVID)
- IF(LUSER.GT.0) PRINT *,'FMSKAN. user = ',USER(1:LUSER)
- IF(LFORM.GT.0) PRINT *,'FMSKAN. uform = ',UFORM(1:LFORM)
- IF(LSTR .GT.0) PRINT *,'FMSKAN. string = ',CHSTR(1:LSTR)
- IF(LCOMM.GT.0) PRINT *,'FMSKAN. comment = ',COMM(1:LCOMM)
- ENDIF
-*
-* Date and time ranges:
-*
- IF(LCHCRE.NE.0) THEN
- CALL FMDTRN(CHCRE(1:LCHCRE),IDCREA,ITCREA,JDCREA,JTCREA,IC)
- IF(IDEBFA.GE.1) PRINT *,'FMSKAN. range of creation dates & ',
- + 'times is ',IDCREA,ITCREA,JDCREA,JTCREA
- ELSE
- IDCREA = -1
- ENDIF
-
- IF(LCHCAT.NE.0) THEN
- CALL FMDTRN(CHCAT(1:LCHCAT),IDCATA,ITCATA,JDCATA,JTCATA,IC)
- IF(IDEBFA.GE.1) PRINT *,'FMSKAN. range of dates & ',
- + 'times of cataloging is ',IDCATA,ITCATA,JDCATA,JTCATA
- ELSE
- IDCATA = -1
- ENDIF
-
- IF(LCHACC.NE.0) THEN
- CALL FMDTRN(CHACC(1:LCHACC),IDLAST,ITLAST,JDLAST,JTLAST,IC)
- IF(IDEBFA.GE.1) PRINT *,'FMSKAN. range of dates & ',
- + 'times of last access is ',IDLAST,ITLAST,JDLAST,JTLAST
- ELSE
- IDLAST = -1
- ENDIF
-*
-* Copy ranges of user words
-*
- CALL UCOPY(IFUSER,IUSER,20)
-
- IF((OUTPUT(1:LOUT).EQ.'TTY').OR.(LOUT.EQ.0)) THEN
- OUTPUT = ' '
- LWRITE = LPRTFA
- ELSE
- LWRITE = 3
- IF(IDEBFA.GE.2)
- + PRINT *,'FMSKAN. output will be redirected to ',OUTPUT(1:LOUT)
- CALL FAFILE(LWRITE,OUTPUT(1:LOUT),IRET)
- IF(IRET.NE.0) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMSKAN. return code ',IRET,
- + 'from OPEN for ',OUTPUT(1:LOUT)
- ENDIF
- ENDIF
-
- IF(LENOCC(CHOPT).EQ.0) THEN
- CHOPT = ' '
- LCHOPT = 1
- ENDIF
-*
-* Check for D option
-*
- IF(INDEX(CHOPT(1:LCHOPT),'D').NE.0) THEN
- PRINT *,'FMSKAN. warning - files should be deleted by '//
- + 'descending key serial number'
- PRINT *,'FMSKAN. directories will be scanned backwards'
- ENDIF
-*
- IF(INDEX(CHOPT(1:LCHOPT),'H').NE.0) THEN
- WRITE(LWRITE,*) '>>> Command: SEARCH ',
- + 'Options: ',CHOPT(1:LCHOPT)
- WRITE(LWRITE,*) '>>> Path: ',PATH(1:LPATH)
- WRITE(LWRITE,*) '>>> Current directory: ',
- + PREDIR(1:LENOCC(PREDIR))
- ENDIF
-*
- NFILES = 0
- NDIRS = 0
-*
-* Look for some files and show the bank and key content:
-*
- LSLASH = INDEXB(PATH(1:LPATH),'/')
- CHPATH = PATH(1:LSLASH-1)
- CHFILE = PATH(LSLASH+1:LPATH)
- LP = LENOCC(CHPATH)
- LC = LENOCC(CHFILE)
- IF(IDEBFA.GE.2) PRINT *,'FMSKAN. enter for path = ',
- + PATH(1:LPATH),' chopt = ',CHOPT
-
- CALL FMOPTC(CHOPT,ALFNUM,IOPT)
-
- IF(IOPTD.EQ.0) THEN
- CALL FMLOOP(PATH(1:LPATH),NLEVEL,FASEAR,IRC)
- ELSE
- CALL FMBACK(PATH(1:LPATH),NLEVEL,FASEAR,IRC)
- ENDIF
-*
-* flush buffer
-*
- IF(IWIDTH.GT.0.AND.INDEX(CHOPT(1:LCHOPT),'W').NE.0)
- + WRITE(LWRITE,'(1X,A)') CARD(1:IWIDTH)
-
- WRITE(LWRITE,*)
-
- IF(IOPTD.NE.0) THEN
- WRITE(LPRTFA,*) 'Total of ',NFILES,
- + ' candidates for deletion in ',NDIRS,' directories'
- ELSE
- WRITE(LWRITE,*) 'Total of ',NFILES,
- + ' matches in ',NDIRS,' directories'
- ENDIF
-
- INQUIRE(3,OPENED=IOPEN)
- IF(IOPEN) CLOSE(3)
- CALL RZCDIR(PREDIR,' ')
- RETURN
- END
diff --git a/src/packlib/fatmen/programs/fmkuip/fmslcc.F b/src/packlib/fatmen/programs/fmkuip/fmslcc.F
deleted file mode 100644
index 773feff..0000000
--- a/src/packlib/fatmen/programs/fmkuip/fmslcc.F
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: fmslcc.F,v 1.1.1.1 1996/03/07 15:17:44 mclareni Exp $
-*
-* $Log: fmslcc.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:44 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMSLCC
-#include "fatmen/fatlcc.inc"
-
- IF(NKLCFA.EQ.0) THEN
- PRINT 9001
- ELSE
- PRINT 9002,NKLCFA
- DO 10 I=1,NKLCFA
- PRINT 9003,NLCCFA(I),CHLOCF(I)(1:LENOCC(CHLOCF(I)))
- 10 CONTINUE
- ENDIF
-9001 FORMAT(' FMSLCC. no location codes defined')
-9002 FORMAT(' FMSLCC. ',I2,' locations are defined'/
- + ' Location code Location')
-9003 FORMAT(4X,I10,7X,A)
- END
diff --git a/src/packlib/fatmen/programs/fmkuip/fmsloc.F b/src/packlib/fatmen/programs/fmkuip/fmsloc.F
deleted file mode 100644
index 1373bd5..0000000
--- a/src/packlib/fatmen/programs/fmkuip/fmsloc.F
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: fmsloc.F,v 1.1.1.1 1996/03/07 15:17:43 mclareni Exp $
-*
-* $Log: fmsloc.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:43 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMSLOC
-*CMZ : 30/04/91 16.52.25 by Jamie Shiers
-*-- Author : Jamie Shiers 30/04/91
-#include "fatmen/fatsys.inc"
-#include "fatmen/fatpara.inc"
-#include "fatmen/fatbug.inc"
-#include "fatmen/fatloc.inc"
-#include "fatmen/fatinit.inc"
-
- IF(NUMLOC.EQ.0) THEN
- PRINT *,'FMSLOC. no location codes defined. ',
- + 'Checks on location code will be skipped'
- ELSE
- DO 10 I=1,NUMLOC
- PRINT 9001,I,MFMLOC(I)
-9001 FORMAT(' FMSLOC. location code # ',I2.2,' = ',I6.6)
- 10 CONTINUE
- ENDIF
-
- END
diff --git a/src/packlib/fatmen/programs/fmkuip/fmsmdk.F b/src/packlib/fatmen/programs/fmkuip/fmsmdk.F
deleted file mode 100644
index 7c37293..0000000
--- a/src/packlib/fatmen/programs/fmkuip/fmsmdk.F
+++ /dev/null
@@ -1,104 +0,0 @@
-*
-* $Id: fmsmdk.F,v 1.1.1.1 1996/03/07 15:17:44 mclareni Exp $
-*
-* $Log: fmsmdk.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:44 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMSMDK
-*CMZ : 10/07/91 11.45.43 by Jamie Shiers
-*-- Author : Jamie Shiers 10/07/91
-#include "fatmen/fatbug.inc"
-#include "fatmen/fattyp.inc"
- CHARACTER*8 PTYP,GTYP,SIZE,CDEN,CMNT,CLAB
- CHARACTER*80 COMAND
-#include "fatmen/fatsys.inc"
-#include "fatmen/fatinit.inc"
-
- CALL KUGETI(NMEDIA)
- CALL KUGETC(PTYP,LT)
- CALL KUGETC(GTYP,LG)
- CALL KUGETC(SIZE,LS)
- CALL KUGETC(CDEN,LD)
- CALL KUGETC(CMNT,LM)
- CALL KUGETC(CLAB,LL)
- CALL KUPATL(COMAND,NPARS)
-
-
- IF(NPARS.EQ.0) THEN
- ISTART = 1
- IEND = NMTYP
- ELSE
- ISTART = NMEDIA
- IEND = NMEDIA
- ENDIF
-
- IF(NPARS.LT.2) THEN
-
- DO 10 I=ISTART,IEND
- IF(MEDSIZ(I).LT.0) GOTO 10
- LT = LENOCC(CHMTYP(I))
- LG = LENOCC(CHMGEN(I))
- LS = LENOCC(CHMSIZ(I))
- LD = LENOCC(CHMDEN(I))
- LM = LENOCC(CHMMNT(I))
- LL = LENOCC(CHMLAB(I))
- PRINT 9001,I,CHMTYP(I)(1:LT),CHMGEN(I)(1:LG),
- + CHMSIZ(I)(1:LS),CHMDEN(I)(1:LD),
- + CHMMNT(I)(1:LM),CHMLAB(I)(1:LL)
- 9001 FORMAT(' FMSMDK. Media type: ',I3,' device: ',A,
- + ' generic device: ',A,/,
- + ' capacity: ',A,' density: ',A,/,
- + ' mount type: ',A,' label type: ',A)
- 10 CONTINUE
-
- RETURN
-
- ELSE
-
- J = NMEDIA
-
- IF(J.GT.NMTYP) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMSMDK. media type ',J,
- + ' outside range. Maximum allowed value = ',NMTYP
- RETURN
- ENDIF
-
- IF(IDEBFA.GE.1) THEN
- PRINT *,'FMSMDK. setting following attributes:'
- PRINT 9001,NMEDIA,PTYP(1:LT),GTYP(1:LG), SIZE(1:LS),CDEN(1:
- + LD), CMNT(1:LM),CLAB(1:LL)
- ENDIF
-*
-* Physical device type
-*
- CHMTYP(J) = PTYP(1:LT)
-*
-* Generic device type
-*
- CHMGEN(J) = GTYP(1:LG)
-*
-* Capacity
-*
- CHMSIZ(J) = SIZE(1:LS)
- MEDSIZ(J) = ICDECI(CHMSIZ(J),1,LS)
-*
-* Density
-*
- CHMDEN(J) = CDEN(1:LD)
- MEDDEN(J) = ICDECI(CDEN,1,LD)
- IF(INDEX(CHMDEN(J),'K').NE.0) MEDDEN(J) = MEDDEN(J) * 1000
-*
-* Label type
-*
- CHMLAB(J) = CLAB(1:LL)
-*
-* Mount type
-*
- CHMMNT(J) = CMNT(1:LM)
-*
- ENDIF
-
- END
diff --git a/src/packlib/fatmen/programs/fmkuip/fmsmtp.F b/src/packlib/fatmen/programs/fmkuip/fmsmtp.F
deleted file mode 100644
index 132092b..0000000
--- a/src/packlib/fatmen/programs/fmkuip/fmsmtp.F
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: fmsmtp.F,v 1.1.1.1 1996/03/07 15:17:44 mclareni Exp $
-*
-* $Log: fmsmtp.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:44 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMSMTP
-*CMZ : 30/04/91 16.52.25 by Jamie Shiers
-*-- Author : Jamie Shiers 30/04/91
-#include "fatmen/fatsys.inc"
-#include "fatmen/fatpara.inc"
-#include "fatmen/fatbug.inc"
-#include "fatmen/fatmtp.inc"
-#include "fatmen/fatinit.inc"
-
- IF(NUMMTP.EQ.0) THEN
- PRINT *,'FMSMTP. no media types defined. ',
- + 'Checks on media type will be skipped'
- ELSE
- DO 10 I=1,NUMMTP
- PRINT 9001,I,MFMMTP(I)
-9001 FORMAT(' FMSMTP. media type # ',I2.2,' = ',I6.6)
- 10 CONTINUE
- ENDIF
-
- END
diff --git a/src/packlib/fatmen/programs/fmkuip/fmssrc.F b/src/packlib/fatmen/programs/fmkuip/fmssrc.F
deleted file mode 100644
index c7e7b08..0000000
--- a/src/packlib/fatmen/programs/fmkuip/fmssrc.F
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: fmssrc.F,v 1.1.1.1 1996/03/07 15:17:44 mclareni Exp $
-*
-* $Log: fmssrc.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:44 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMSSRC
-
-#include "fatmen/fatsys.inc"
-#include "fatmen/fatsat.inc"
-#include "fatmen/fatinit.inc"
-
- IF(LSRCST.EQ.0) THEN
- PRINT *,'FMSSRC. source site has not been set'
- ELSE
- PRINT *,'FMSSRC. source site is ',CHSRCE(1:LSRCST)
- ENDIF
-
- END
diff --git a/src/packlib/fatmen/programs/fmkuip/fmstat.F b/src/packlib/fatmen/programs/fmkuip/fmstat.F
deleted file mode 100644
index e0f29f9..0000000
--- a/src/packlib/fatmen/programs/fmkuip/fmstat.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: fmstat.F,v 1.1.1.1 1996/03/07 15:17:44 mclareni Exp $
-*
-* $Log: fmstat.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:44 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMSTAT
-#include "fatmen/fmpath.inc"
- CALL KUGETC(PATH,LPATH)
- IF (PATH(1:4) .EQ. '*') THEN
- PATH = CDIR
- LPATH = LCDIR
- ENDIF
-
- CALL RZSTAT(PATH(1:LPATH),9999,' ')
- END
-C
-C
diff --git a/src/packlib/fatmen/programs/fmkuip/fmsupd.F b/src/packlib/fatmen/programs/fmkuip/fmsupd.F
deleted file mode 100644
index 9a16792..0000000
--- a/src/packlib/fatmen/programs/fmkuip/fmsupd.F
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: fmsupd.F,v 1.1.1.1 1996/03/07 15:17:44 mclareni Exp $
-*
-* $Log: fmsupd.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:44 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMSUPD
-#include "fatmen/fatupd.inc"
-
- PRINT 9001,NUPDT,MAXUPD
- IF(NGROUP.GT.1) PRINT 9002,NGROUP
-9001 FORMAT(' FMSUPD. You have made ',I10,' updates out of ',
- + I10,' maximum.')
-9002 FORMAT(' Updates are grouped in bunches of ',I10)
-
- END
diff --git a/src/packlib/fatmen/programs/fmkuip/fmsuwd.F b/src/packlib/fatmen/programs/fmkuip/fmsuwd.F
deleted file mode 100644
index 188db9e..0000000
--- a/src/packlib/fatmen/programs/fmkuip/fmsuwd.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: fmsuwd.F,v 1.1.1.1 1996/03/07 15:17:44 mclareni Exp $
-*
-* $Log: fmsuwd.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:44 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMSUWD
-*CMZ : 30/04/91 16.52.25 by Jamie Shiers
-*-- Author : Jamie Shiers 30/04/91
-#include "fatmen/fatsys.inc"
-#include "fatmen/fatpara.inc"
-#include "fatmen/fatbug.inc"
-#include "fatmen/fatuwd.inc"
-#include "fatmen/fatinit.inc"
-
- PRINT *,'FMSUWD. range of user words (-1 = no check)'
-
- DO 10 I=1,10
- PRINT *,'FMSUWD. user word # ',I,': ',
- + IFUSER(1,I), ' to ',IFUSER(2,I)
- 10 CONTINUE
-
- END
diff --git a/src/packlib/fatmen/programs/fmkuip/fmsver.F b/src/packlib/fatmen/programs/fmkuip/fmsver.F
deleted file mode 100644
index 64364b1..0000000
--- a/src/packlib/fatmen/programs/fmkuip/fmsver.F
+++ /dev/null
@@ -1,17 +0,0 @@
-#include "fatmen/pilot.h"
- SUBROUTINE FMSVER
-#include "fatmen/fatveri.inc"
-#include "fatmen/fatbug.inc"
-
- IF(IFMVER.EQ.0) THEN
- PRINT 9001
- ELSEIF(IFMVER.EQ.1) THEN
- PRINT 9002
- ELSE
- PRINT 9003
- ENDIF
-
-9001 FORMAT(' FMSVER. verification is ON')
-9002 FORMAT(' FMSVER. verification is OFF')
-9003 FORMAT(' FMSVER. verification is set to unknown state')
- END
diff --git a/src/packlib/fatmen/programs/fmkuip/fmtagc.F b/src/packlib/fatmen/programs/fmkuip/fmtagc.F
deleted file mode 100644
index 824c39d..0000000
--- a/src/packlib/fatmen/programs/fmkuip/fmtagc.F
+++ /dev/null
@@ -1,83 +0,0 @@
-*
-* $Id: fmtagc.F,v 1.1.1.1 1996/03/07 15:17:44 mclareni Exp $
-*
-* $Log: fmtagc.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:44 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMTAGC
-*
-* Interface to FMTAGS
-*
-#include "fatmen/fmpath.inc"
-#include "fatmen/fatpara.inc"
-#include "fatmen/fatbug.inc"
- PARAMETER (LKEYFA=10)
- DIMENSION KEYS(LKEYFA)
- CHARACTER*8 CHOPT
- CHARACTER*255 GENAM,GENAM1,CHTAG
-#include "fatmen/fatsys.inc"
-#include "fatmen/fatinit.inc"
- CHOPT = ' '
- CHTAG = ' '
- CALL KUGETC(GENAM,LGN)
- CALL FMFIXF(GENAM,GENAM1)
- LGN = LENOCC(GENAM1)
- GENAM = GENAM1
- CALL KUGETI(IKEY)
- CALL KUGETS(CHTAG,NTG)
- CALL KUGETC(CHOPT,NCH)
-
- IF(NCH.EQ.0) THEN
- IF((NTG.NE.0).AND.(CHTAG(1:1).EQ.'-')) THEN
- CHOPT = CHTAG
- NCH = NTG
- NTG = 1
- CHTAG = ' '
- ELSE
- NCH = 1
- CHOPT = ' '
- ENDIF
- ENDIF
-
- CALL VZERO(KEYS,10)
- KEYS(1) = IKEY
- LBANK = 0
-*
-* Get key vector if KEYS(1) specified
-*
- IF(IKEY.NE.0) THEN
- CALL FMGBYK(GENAM(1:LGN),LBANK,KEYS,IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMTAGC. return code ',IRC,
- + ' from FMGBYK'
- RETURN
- ENDIF
- ENDIF
-*
-* For option S with NTG = 0, use current generic name
-*
- IF((INDEX(CHOPT(1:NCH),'S').NE.0).AND.
- + (NTG.EQ.0)) THEN
- CHTAG = GENAM
- NTG = LGN
- ENDIF
-
- CALL FMTAGS(GENAM(1:LGN),LBANK,KEYS,CHTAG,CHOPT,IRC)
- IF(IRC.NE.0) THEN
- PRINT *,'FMTAGC. return code ',IRC,' from FMTAGS'
- ELSE
- IF(INDEX(CHOPT(1:NCH),'G').NE.0) THEN
- LTG = LENOCC(CHTAG)
- IF(LTG.EQ.0) THEN
- PRINT *,'FMTAGC. no tag set'
- ELSE
- PRINT *,'FMTAGC. tag = ',CHTAG(1:LTG)
- ENDIF
- ENDIF
- ENDIF
-
- END
-
diff --git a/src/packlib/fatmen/programs/fmkuip/fmtchc.F b/src/packlib/fatmen/programs/fmkuip/fmtchc.F
deleted file mode 100644
index 41f5c28..0000000
--- a/src/packlib/fatmen/programs/fmkuip/fmtchc.F
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: fmtchc.F,v 1.1.1.1 1996/03/07 15:17:44 mclareni Exp $
-*
-* $Log: fmtchc.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:44 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMTCHC
-*
-* 'TOUCH' files
-*
-#include "fatmen/fatsys.inc"
-#include "fatmen/fatpara.inc"
-#include "fatmen/fatbug.inc"
- PARAMETER (LKEYFA=10)
- DIMENSION KEYS(LKEYFA)
- CHARACTER*255 GENAM,CHDIR
- CHARACTER*8 CHOPT
-#include "fatmen/fatinit.inc"
-
- CALL RZCDIR(CHDIR,'R')
- LDIR = LENOCC(CHDIR)
- CALL KUGETC(GENAM,LGN)
- CALL FMFIXF(GENAM,GENAM)
- LGN = LENOCC(GENAM)
- CALL KUGETI(KSN)
- CALL KUGETC(CHOPT,NCH)
-*
-* If KSN = 0, FMTOUC will TOUCH the file 'chosen' by FATMEN
-*
- CALL VZERO(KEYS,LKEYFA)
- KEYS(1) = KSN
- CALL FMTOUC(GENAM(1:LGN),KEYS,CHOPT,IRC)
- IF(IRC.NE.0) PRINT *,'Return code ',IRC,' from FMTOUC'
-
- CALL RZCDIR(CHDIR(1:LDIR),' ')
-
- END
-
diff --git a/src/packlib/fatmen/programs/fmkuip/fmthrg.F b/src/packlib/fatmen/programs/fmkuip/fmthrg.F
deleted file mode 100644
index 73cdc02..0000000
--- a/src/packlib/fatmen/programs/fmkuip/fmthrg.F
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: fmthrg.F,v 1.1.1.1 1996/03/07 15:17:44 mclareni Exp $
-*
-* $Log: fmthrg.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:44 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMTHRG
-#include "fatmen/fatsys.inc"
-#include "fatmen/fatbug.inc"
-#include "fatmen/fatron.inc"
- CHARACTER*255 PATH
-
- CALL KUGETC(PATH,LP)
- IF(PATH(1:2).NE.'//') THEN
- THRONG = PATH
- LTHR = LP
-
-#if defined(CERNLIB_DESY)
- TOPDIR = '//DESY'
-#endif
-#if defined(CERNLIB_FNAL)
- TOPDIR = '//FNAL'
-#endif
-#if (!defined(CERNLIB_FNAL))&&(!defined(CERNLIB_DESY))
- TOPDIR = '//CERN'
-#endif
-
- ELSE
- ISTART = 3
- IEND = INDEX(PATH(ISTART:LP),'/') - 1
- TOPDIR = PATH(1:IEND+2)
- THRONG = PATH(INDEXB(PATH(1:LP),'/')+1:LP)
- LTHR = LENOCC(THRONG)
- ENDIF
- IF(IDEBFA.GE.3) PRINT *,'FMTHRG. TOPDIR = ',TOPDIR,
- + ' GROUP = ',THRONG
- IF (THRONG(1:4) .NE. 'NONE') CALL FMINIC
- END
diff --git a/src/packlib/fatmen/programs/fmkuip/fmtrek.F b/src/packlib/fatmen/programs/fmkuip/fmtrek.F
deleted file mode 100644
index 7dda767..0000000
--- a/src/packlib/fatmen/programs/fmkuip/fmtrek.F
+++ /dev/null
@@ -1,69 +0,0 @@
-*
-* $Id: fmtrek.F,v 1.1.1.1 1996/03/07 15:17:44 mclareni Exp $
-*
-* $Log: fmtrek.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:44 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMTREK
-*CMZ : 21/08/91 14.44.10 by Jamie Shiers
-*-- Author : Jamie Shiers 21/08/91
-#include "fatmen/fatbank.inc"
-#include "fatmen/fatpara.inc"
-#include "fatmen/fmnkeys.inc"
-#include "fatmen/fatsys.inc"
-
- CHARACTER*255 PATH,PATH1
-
- CHARACTER*80 OUTPUT
-
- LOGICAL IOPEN
-
-#include "fatmen/fatinit.inc"
-
- CALL KUGETC(PATH1,LPATH)
- IF(LPATH.EQ.0) THEN
- CALL RZCDIR(PATH,'R')
- ELSE
- CALL FMFIXF(PATH1,PATH)
- ENDIF
- LPATH = LENOCC(PATH)
-
- CALL KUGETI(NLEVEL)
-
- CALL KUGETC(OUTPUT,LOUT)
-
- IF((OUTPUT(1:LOUT).EQ.'TTY').OR.(LOUT.EQ.0)) THEN
- OUTPUT = ' '
- LWRITE = LPRTFA
- LOUT = 1
- ELSE
- LWRITE = 3
- IF(IDEBFA.GE.2)
- + PRINT *,'FMTREK. output will be redirected to ',OUTPUT(1:LOUT)
- CALL FAFILE(LWRITE,OUTPUT(1:LOUT),IRET)
- IF(IRET.NE.0) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMTREK. return code ',IRET,
- + ' opening file ',OUTPUT(1:LOUT),
- + ' - output will be sent to screen'
- OUTPUT = ' '
- LWRITE = LPRTFA
- ENDIF
- ENDIF
-*
-* Get tree
-*
- WRITE(LWRITE,*) 'FMTREK. directory tree structure below ',
- + PATH(1:LPATH),' down ',NLEVEL,' levels'
-
- CALL FATREK(PATH(1:LPATH),NLEVEL,LWRITE,IRC)
-
- WRITE(LWRITE,*)
- WRITE(LWRITE,*) IQUEST(11),' subdirectories found'
-
-
- INQUIRE(3,OPENED=IOPEN)
- IF(IOPEN) CLOSE(3)
- END
diff --git a/src/packlib/fatmen/programs/fmkuip/fmulcc.F b/src/packlib/fatmen/programs/fmkuip/fmulcc.F
deleted file mode 100644
index e6b2142..0000000
--- a/src/packlib/fatmen/programs/fmkuip/fmulcc.F
+++ /dev/null
@@ -1,84 +0,0 @@
-*
-* $Id: fmulcc.F,v 1.1.1.1 1996/03/07 15:17:44 mclareni Exp $
-*
-* $Log: fmulcc.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:44 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMULCC
-*
-* Lock VID corresponding to specified generic name
-*
-#include "fatmen/fmpath.inc"
-#include "fatmen/fatpara.inc"
-#include "fatmen/fatbank.inc"
- PARAMETER (LKEYFA=10)
-#include "fatmen/fmaxcop.inc"
-#include "fatmen/fatsys.inc"
- DIMENSION KEYS(LKEYFA)
- DIMENSION KEYSIN(LKEYFA)
- DIMENSION KEYSOU(LKEYFA,MAXCOP)
- CHARACTER*255 GENAM
- CHARACTER*8 CHOPT
-#include "fatmen/fatinit.inc"
- CALL KUGETC(GENAM,LGN)
- CALL FMFIXF(GENAM,GENAM)
- LGN = LENOCC(GENAM)
- CALL KUGETI(KSN)
- KEYS(1) = KSN
- CALL KUGETC(CHOPT,NCH)
- LBANK = 0
- CALL RZCDIR(CDIR(1:LCDIR),'R')
-
- LFILE = INDEXB(GENAM(1:LGN),'/') -1
- FILE1 = GENAM(LFILE+2:LGN)
- CALL RZCDIR(GENAM(1:LFILE),'U')
- LFILE = LENOCC(FILE1)
-*
-* Check how many copies of this dataset exist
-*
- CALL UCOPY(KEYS,KEYSIN,10)
-*
-* Don't compare media type, copy level or location code
-*
- KEYSIN(MKMTFA) = -1
- KEYSIN(MKCLFA) = -1
- KEYSIN(MKLCFA) = -1
- CALL FMSELK(GENAM(1:LGN),KEYSIN,KEYSOU,NMATCH,MAXCOP,IRC)
- IF(NMATCH.EQ.0) THEN
- IF(IDEBFA.GE.0)
- + PRINT *,'FMULCC. found 0 matches for ',GENAM(1:LGN)
- IRC = 1
- GOTO 99
- ELSEIF((NMATCH.GT.1).AND.(KEYS(1).EQ.0)) THEN
- IF(IDEBFA.GE.0) THEN
- PRINT *,'FMULCC. found ',NMATCH,' matches for ',
- + GENAM(1:LGN)
- PRINT *,'FMULCC. Please specify which copy is to be locked'
- ENDIF
- IRC = 1
- GOTO 99
- ELSE
- DO 10 I=1,NMATCH
- 10 IF(KEYS(1).EQ.KEYSOU(1,I)) GOTO 20
- 20 CONTINUE
- CALL FMGETK(GENAM(1:LGN),LTDSFA,KEYSOU(1,I),IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMULCC. Return code ',IRC,' from '
- + //'FMGETK'
- GOTO 99
- ENDIF
- ENDIF
-
- CALL FMULOK(GENAM(1:LGN),LTDSFA,KEYS,CHOPT,IRC)
- IF(IRC.NE.0) PRINT *,'Return code ',IRC,' from FMULOK'
- 99 CONTINUE
-*
-* Reset current directory
-*
- CALL RZCDIR(CDIR(1:LCDIR),' ')
-
- END
-
diff --git a/src/packlib/fatmen/programs/fmkuip/fmupdc.F b/src/packlib/fatmen/programs/fmkuip/fmupdc.F
deleted file mode 100644
index bb4bb63..0000000
--- a/src/packlib/fatmen/programs/fmkuip/fmupdc.F
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: fmupdc.F,v 1.1.1.1 1996/03/07 15:17:44 mclareni Exp $
-*
-* $Log: fmupdc.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:44 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMUPDC
-#include "fatmen/fatsys.inc"
-#include "fatmen/fatinit.inc"
- CALL KUGETI(MAX)
- CALL KUGETI(NGROUP)
- CALL KUGETI(IFLAG)
- CALL FMUPDT(MAX,NGROUP,IFLAG,IRC)
- IF (IRC .NE. 0) PRINT *,'Return code ',IRC,' from FMUPDT'
- END
diff --git a/src/packlib/fatmen/programs/fmkuip/fmzoom.F b/src/packlib/fatmen/programs/fmkuip/fmzoom.F
deleted file mode 100644
index d410bca..0000000
--- a/src/packlib/fatmen/programs/fmkuip/fmzoom.F
+++ /dev/null
@@ -1,39 +0,0 @@
-*
-* $Id: fmzoom.F,v 1.1.1.1 1996/03/07 15:17:44 mclareni Exp $
-*
-* $Log: fmzoom.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:44 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMZOOM
-*CMZ : 21/08/91 14.44.10 by Jamie Shiers
-*-- Author : Jamie Shiers 21/08/91
-#include "fatmen/fatbank.inc"
-#include "fatmen/fatpara.inc"
-#include "fatmen/fmnkeys.inc"
-#include "fatmen/fatsys.inc"
- CHARACTER*255 PATH,PATH1
-#include "fatmen/fatinit.inc"
-
- CALL KUGETC(PATH1,LPATH)
- IF(LPATH.EQ.0) THEN
- CALL RZCDIR(PATH,'R')
- ELSE
- CALL FMFIXF(PATH1,PATH)
- ENDIF
- LPATH = LENOCC(PATH)
-
- CALL FAZOOM(PATH(1:LPATH),IRC)
- CALL RZCDIR(' ','P')
-
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMZOOM. unable to find ',
- + 'lowest level directory with ',
- + 'one or more files'
- ELSE
- PRINT *,'FMZOOM. files: ',IQUEST(14)
- ENDIF
-
- END
diff --git a/src/packlib/fatmen/programs/fmkuip/zabend.F b/src/packlib/fatmen/programs/fmkuip/zabend.F
deleted file mode 100644
index cca1c3d..0000000
--- a/src/packlib/fatmen/programs/fmkuip/zabend.F
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: zabend.F,v 1.1.1.1 1996/03/07 15:17:44 mclareni Exp $
-*
-* $Log: zabend.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:44 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE ZABEND
-#include "zebra/zstate.inc"
- PRINT *,'ZABEND routine for FATMEN reached - ZPOSTM cancelled'
- IF(NQPHAS.LE.0) CALL ABEND
- NQPHAS = - 2
- CALL ZEND
- END
-
diff --git a/src/packlib/fatmen/programs/fmlogi/Imakefile b/src/packlib/fatmen/programs/fmlogi/Imakefile
deleted file mode 100644
index b64b2b1..0000000
--- a/src/packlib/fatmen/programs/fmlogi/Imakefile
+++ /dev/null
@@ -1,3 +0,0 @@
-SRCS_F= fmlogi.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/fatmen/programs/fmlogi/fmlogi.F b/src/packlib/fatmen/programs/fmlogi/fmlogi.F
deleted file mode 100644
index 9a6a639..0000000
--- a/src/packlib/fatmen/programs/fmlogi/fmlogi.F
+++ /dev/null
@@ -1,69 +0,0 @@
-*
-* $Id: fmlogi.F,v 1.1.1.1 1996/03/07 15:17:48 mclareni Exp $
-*
-* $Log: fmlogi.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:48 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
-#if !defined(CERNLIB_IBMRT)
- SUBROUTINE FMLOGI(IRC)
-#endif
-#if defined(CERNLIB_IBMRT)
- SUBROUTINE FMLOGI_(IRC)
-#endif
-
- EXEC SQL BEGIN DECLARE SECTION
-#if defined(CERNLIB_ORACLE)
- CHARACTER*20 UID,PWD
-* SQL/DS complains if longer than 8 bytes...
-#endif
-#if defined(CERNLIB_SQLDS)
- CHARACTER*8 UID,PWD
-#endif
-
- EXEC SQL END DECLARE SECTION
-
- EXEC SQL INCLUDE SQLCA
-
- UID = 'FATMEN'
-#if defined(CERNLIB_IBMVM)
- CALL VMREXX('F','PWD',PWD,IRC)
-#endif
-#if (defined(CERNLIB_UNIX)||defined(CERNLIB_VAXVMS))&&(!defined(CERNLIB_IBMRT))
- CALL GETENVF('PWD',PWD)
-#endif
-#if defined(CERNLIB_IBMRT)
- CALL GETENVF_('PWD',PWD)
-#endif
-
- EXEC SQL WHENEVER SQLERROR GOTO 100
-
- EXEC SQL CONNECT :UID IDENTIFIED by :PWD
-
- IRC = 0
- WRITE(6,90) UID
-90 FORMAT(/,' CONNECTED TO ORACLE/SQL AS USER: ' , A20,/)
-
- RETURN
-
-100 CONTINUE
-
- WRITE(6,110)
-110 FORMAT(/, ' Error connecting to ORACLE/SQL')
-
-#if (defined(CERNLIB_IBMVM))&&(defined(CERNLIB_CERNVM))
- CALL VMCMS('EXEC TELL FATONE Error connecting to ORACLE/SQL',IRC)
-#endif
-
- EXEC SQL WHENEVER SQLERROR CONTINUE
- WRITE(6,1010) (SQLEMC(I),I=1,70)
-1010 FORMAT(/,1X,70A1,/)
-
- EXEC SQL ROLLBACK WORK RELEASE
-
- IRC = 1
-
- RETURN
- END
diff --git a/src/packlib/fatmen/programs/fmorac/Imakefile b/src/packlib/fatmen/programs/fmorac/Imakefile
deleted file mode 100644
index fa9a887..0000000
--- a/src/packlib/fatmen/programs/fmorac/Imakefile
+++ /dev/null
@@ -1,3 +0,0 @@
-SRCS_F= fmsize.F fmstat.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/fatmen/programs/fmorac/fmsize.F b/src/packlib/fatmen/programs/fmorac/fmsize.F
deleted file mode 100644
index fbdec42..0000000
--- a/src/packlib/fatmen/programs/fmorac/fmsize.F
+++ /dev/null
@@ -1,100 +0,0 @@
-*
-* $Id: fmsize.F,v 1.1.1.1 1996/03/07 15:17:47 mclareni Exp $
-*
-* $Log: fmsize.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:47 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMSIZE(EXPER, NTOTAL, NACTIVE, NDELETE)
-*
-*
-* Action : Get the number of files per experiment and print the
-* total number active and number deleted.
-*
-*
-* Receives : EXPER =======> Experiment name.
-*
-*
-* Returns : NTOTAL =====> Total number of files per experiment.
-* NACTIVE =====> Total number of active files.
-* NDELETE =====> Total number of deleted files.
-*
-*
-*...General variables
-*
- CHARACTER*20 EXPER
-*
-* ...Variables for Oracle.
-*
- EXEC SQL BEGIN DECLARE SECTION
- CHARACTER*100 STMT1
- CHARACTER*200 STMT2
- CHARACTER*200 STMT3
- INTEGER NTOTAL
- INTEGER NACTIVE
- INTEGER NDELETE
-
- EXEC SQL END DECLARE SECTION
-*
-* ... Sql common area used.
- EXEC SQL INCLUDE SQLCA
-* ... If exist problems with sqlca
- EXEC SQL WHENEVER SQLERROR GOTO 300
-*
-* ... SQL dynamic sentences (Method 3).
-*
- STMT1 = 'SELECT COUNT(GN#) FROM FILES_' // EXPER
- STMT2 = STMT1 // ' WHERE (ACTIVE = ''Y'')'
- STMT3 = STMT1 // ' WHERE (ACTIVE = ''N'')'
-*
-* ... For obtain NTOTAL
- EXEC SQL PREPARE S1 FROM :STMT1
- EXEC SQL DECLARE C1 CURSOR FOR S1
- EXEC SQL OPEN C1
- EXEC SQL FETCH C1 INTO :NTOTAL
- EXEC SQL WHENEVER SQLERROR GOTO 300
-*
-* ... For obtain NACTIVE
- EXEC SQL PREPARE S2 FROM :STMT2
- EXEC SQL DECLARE C2 CURSOR FOR S2
- EXEC SQL OPEN C2
- EXEC SQL FETCH C2 INTO :NACTIVE
- EXEC SQL WHENEVER SQLERROR GOTO 300
-*
-* ... For obtain NDELETE
- EXEC SQL PREPARE S3 FROM :STMT3
- EXEC SQL DECLARE C3 CURSOR FOR S3
- EXEC SQL OPEN C3
- EXEC SQL FETCH C3 INTO :NDELETE
- EXEC SQL WHENEVER SQLERROR GOTO 300
-*
-* ... Results.
-* IRC = IOSCLR()
- WRITE(6, *)
- WRITE(6, 50) EXPER
-50 FORMAT (/,' EXPERIMENT : ', A20)
- WRITE(6,*)
- WRITE(6,*)
- WRITE(6, 100) NTOTAL
-100 FORMAT (/, ' Total number of files : ', I10)
- WRITE(6, *)
- WRITE(6,150) NACTIVE
-150 FORMAT (/, ' Total number of active files : ', I10)
- WRITE(6, *)
- WRITE(6,250) NDELETE
-250 FORMAT (/, ' Total number of deleted files : ', I10)
- WRITE(6,*)
- WRITE(6,*)
- RETURN
-*
-* ... Causes contained into SQLEMC(70).
-300 CONTINUE
- WRITE(6,350) (SQLEMC(I),I=1,70)
-350 FORMAT(/, 1X,70A1,/)
- EXEC SQL WHENEVER SQLERROR CONTINUE
- EXEC SQL ROLLBACK WORK RELEASE
- RETURN
- END
- END
diff --git a/src/packlib/fatmen/programs/fmorac/fmstat.F b/src/packlib/fatmen/programs/fmorac/fmstat.F
deleted file mode 100644
index b1beb2b..0000000
--- a/src/packlib/fatmen/programs/fmorac/fmstat.F
+++ /dev/null
@@ -1,44 +0,0 @@
-*
-* $Id: fmstat.F,v 1.1.1.1 1996/03/07 15:17:47 mclareni Exp $
-*
-* $Log: fmstat.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:47 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- PROGRAM FMSTAT
-* lee en oracle en nonmbre de todos los experimento y les aplica growth.
- INTEGER A
- INTEGER B
- INTEGER C
- CHARACTER*20 UID
- CHARACTER*20 PWD
- EXEC SQL BEGIN DECLARE SECTION
- CHARACTER*8 VECTOR
- EXEC SQL END DECLARE SECTION
- EXEC SQL INCLUDE SQLCA
- EXEC SQL WHENEVER SQLERROR GOTO 200
- A = 0
- B = 0
- C = 0
- CALL FMLOGI(IRC)
- EXEC SQL DECLARE C1 CURSOR FOR SELECT EXPERIMENT FROM FATMEN
- EXEC SQL OPEN C1
- EXEC SQL WHENEVER NOT FOUND GOTO 150
-100 CONTINUE
- EXEC SQL FETCH C1 INTO :VECTOR
- CALL FMSIZE(VECTOR, A, B, C)
- EXEC SQL WHENEVER SQLERROR GOTO 200
-* CALL VMCMS('CP SLEEP 3 SEC', IRC)
- GO TO 100
-150 CONTINUE
- EXEC SQL CLOSE C1
- EXEC SQL COMMIT WORK RELEASE
-200 CONTINUE
- WRITE(6,210) (SQLEMC(I),I=1,70)
-210 FORMAT(/,1X,70A1,/)
- EXEC SQL WHENEVER SQLERROR CONTINUE
- EXEC SQL ROLLBACK WORK RELEASE
- STOP
- END
diff --git a/src/packlib/fatmen/programs/fmotoz/Imakefile b/src/packlib/fatmen/programs/fmotoz/Imakefile
deleted file mode 100644
index fca2de1..0000000
--- a/src/packlib/fatmen/programs/fmotoz/Imakefile
+++ /dev/null
@@ -1,3 +0,0 @@
-SRCS_F= fmotoz.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/fatmen/programs/fmotoz/fmotoz.F b/src/packlib/fatmen/programs/fmotoz/fmotoz.F
deleted file mode 100644
index 44be77a..0000000
--- a/src/packlib/fatmen/programs/fmotoz/fmotoz.F
+++ /dev/null
@@ -1,260 +0,0 @@
-*
-* $Id: fmotoz.F,v 1.1.1.1 1996/03/07 15:17:48 mclareni Exp $
-*
-* $Log: fmotoz.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:48 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMOTOZ(GENAM,IFLAG)
-*
-* This routine calls FOGETx, according to the generic name
-* If IFLAG = 0, send via FMPUT to server
-* 1, write directly to RZ file
-*
- CHARACTER*20 FILEN
- CHARACTER*240 GNAME
-#include "fatmen/fatsys.inc"
-#include "fatmen/fatpara.inc"
-#include "fatmen/fofile.inc"
-#include "fatmen/fovars.inc"
- PARAMETER (LURCOR=200000)
- COMMON/CRZT/IXSTOR,IXDIV,IFENCE(2),LEV,LEVIN,BLVECT(LURCOR)
- DIMENSION LQ(999),IQ(999),Q(999)
- EQUIVALENCE (IQ(1),Q(1),LQ(9)),(LQ(1),LEV)
- COMMON /FATUSE/ IDEBFA, IDIVFA, IKDRFA, KOFSFA, KOFUFA, LBFXFA
- + , LSAVFA, LTOPFA, LBBKFA, LBGNFA, LTDSFA, LBDSFA
- + , LPRTFA, NTOPFA, LUFZFA, IOUPFA, IOBKFA, IODSFA
-*
- COMMON /USRLNK/LUSRK1,LUSRBK,LADDR,LUSRLS
- COMMON/QUEST/IQUEST(100)
- CHARACTER*(*) GENAM
- CHARACTER*16 EXPER
- CHARACTER*1 MEDTYP(4)
- CHARACTER*3 MONTH,MONTHS(12)
- PARAMETER (LKEYFA=10)
- DIMENSION KEYS(LKEYFA)
- CHARACTER*8 CHTAG(LKEYFA)
- CHARACTER*10 CHFOR
- DATA CHTAG/'Num.Id.',5*'Fname'
- + ,'cp.level','loc.code','medium','nm.banks'/
- DATA CHFOR/'IHHHHHIIII'/
-
- DATA MONTHS(1)/'JAN'/,
- + MONTHS(2)/'FEB'/,
- + MONTHS(3)/'MAR'/,
- + MONTHS(4)/'APR'/,
- + MONTHS(5)/'MAY'/,
- + MONTHS(6)/'JUN'/,
- + MONTHS(7)/'JUL'/,
- + MONTHS(8)/'AUG'/,
- + MONTHS(9)/'SEP'/,
- + MONTHS(10)/'OCT'/,
- + MONTHS(11)/'NOV'/,
- + MONTHS(12)/'DEC'/
-
- DATA MEDTYP(1)/'D'/,MEDTYP(2)/'C'/,MEDTYP(3)/'T'/,MEDTYP(4)/'X'/
-
- DATA NPROC/0/,NDEL/0/
-
- LTOP = LENOCC(TOPDIR)
- CALL FMWORD(EXPER,3,'/',GENAM,IRC)
- LENEXP = LENOCC(EXPER)
-*
-* Loop until all information has been returned
-*
- ITOTAL = 0
-1 CONTINUE
-
- CALL FOGET(GENAM,ITOTAL,IRC)
- IF (IRC .LT. 0) THEN
- WRITE(LPRTFA,*) 'Error code ',IRC,' from FOGET'
- RETURN
- ENDIF
-
- DO 10 I=1,ITOTAL
-
- JBIAS = 2
- NCH = LENOCC(GENAME(I))
- CALL FMBOOK(GNAME(1:NCH),KEYS,LSUP,LADDR,JBIAS,IRC)
- GNAME = TOPDIR(1:LTOP)//'/'//
- + EXPER(1:LENEXP)//'/'//GENAME(I)(1:NCH)
-*
-* Find file name
-*
- ICH = INDEXB(GENAME(I)(1:NCH),'/')
- FILEN = GENAME(I)(ICH+1:NCH)
-*
-* Check delete flag...
-*
- IF(ACTIVE(I) .EQ. 'N') THEN
- WRITE(LPRTFA,*) 'Skipping ',GENAME(I)(1:NCH),' (deleted) ...'
- NDEL = NDEL + 1
- GOTO 10
- ENDIF
-
- WRITE(LPRTFA,*) 'Processing ',GENAME(I)(1:NCH)
- NPROC = NPROC + 1
-
-#if defined(CERNLIB_OLD)
- IF(IFLAG.EQ.0) THEN
-*
-* Pretend we're a disk file - going to change it anyway
-*
- CALL FMLIFT(GNAME(1:LENOCC(GNAME)),KEYS,'DISK',' ',IRC)
- CALL FMLINK(GNAME(1:LENOCC(GNAME)),LADDR,' ',IRC)
-
- ELSE
-*
-* Lift stand-alone bank
-*
- CALL MZBOOK(IDIVFA,LADDR,L,2,'LFAT',0,0,NWDSFA,IODSFA,0)
-*
-* Zero/blank it according to I/O characteristic
-*
- CALL DZZERO(IDIVFA,LADDR)
-
- ENDIF
-#endif
-*
-* Now fill it with data from COMMON blocks
-*
- IQ(LADDR+MCPLFA) = CPLVL(I)
- IQ(LADDR+MLOCFA) = LOCAT(I)
- CALL UCTOH(FNAME(I),IQ(LADDR+MFQNFA),4,240)
- CALL UCTOH(HNAME(I),IQ(LADDR+MHSNFA),4,8)
- CALL UCTOH(HTYPE(I),IQ(LADDR+MHSTFA),4,16)
- CALL UCTOH(OPSYS(I),IQ(LADDR+MHOSFA),4,12)
- CALL UCTOH(FFORMT(I),IQ(LADDR+MFLFFA),4,4)
- CALL UCTOH(USRFMT(I),IQ(LADDR+MFUTFA),4,4)
- IQ(LADDR+MSRDFA) = SRTREC(I)
- IQ(LADDR+MERDFA) = ENDREC(I)
- IQ(LADDR+MSBLFA) = SRTBLK(I)
- IQ(LADDR+MEBLFA) = ENDBLK(I)
- CALL UCTOH(RECFMT(I),IQ(LADDR+MRFMFA),4,4)
- IQ(LADDR+MRLNFA) = RECLGH(I)
- IQ(LADDR+MBLNFA) = BLKLGH(I)
-*
-* date/time are stored in format DD-MON-YY HH:MM
-* for ORACLE. IDATE = YYMMDD, ITIME = HHMM
-*
- CALL CLTOU(CREDAT(I))
- READ(CREDAT(I),9001) IDAY,MONTH,IYEAR,IHOU,IMIN
-9001 FORMAT(I2,1X,A3,1X,I2,1X,I2,1X,I2)
- IMONTH = ICNTH(MONTH,MONTHS,12)
- IDATE = IYEAR * 10000 + IMONTH * 100 + IDAY
- ITIME = IHOU * 100 + IMIN
- CALL FMPKTM(IDATE,ITIME,IQ(LADDR+MCRTFA),IRC)
-
- CALL CLTOU(CATDAT(I))
- READ(CATDAT(I),9001) IDAY,MONTH,IYEAR,IHOU,IMIN
- IMONTH = ICNTH(MONTH,MONTHS,12)
- IDATE = IYEAR * 10000 + IMONTH * 100 + IDAY
- ITIME = IHOU * 100 + IMIN
- CALL FMPKTM(IDATE,ITIME,IQ(LADDR+MCTTFA),IRC)
-
- CALL CLTOU(ACSDAT(I))
- READ(ACSDAT(I),9001) IDAY,MONTH,IYEAR,IHOU,IMIN
- IMONTH = ICNTH(MONTH,MONTHS,12)
- IDATE = IYEAR * 10000 + IMONTH * 100 + IDAY
- ITIME = IHOU * 100 + IMIN
- CALL FMPKTM(IDATE,ITIME,IQ(LADDR+MLATFA),IRC)
-
- CALL UCTOH(CRENAM(I),IQ(LADDR+MCURFA),4,8)
- CALL UCTOH(CREACC(I),IQ(LADDR+MCIDFA),4,8)
- CALL UCTOH(CRENOD(I),IQ(LADDR+MCNIFA),4,8)
- CALL UCTOH(CREJOB(I),IQ(LADDR+MCJIFA),4,8)
-
-
- IQ(LADDR+MFPRFA) = PROTEC(I)
- IQ(LADDR+MUSWFA) = USRWD0(I)
- IQ(LADDR+MUSWFA+1) = USRWD1(I)
- IQ(LADDR+MUSWFA+2) = USRWD2(I)
- IQ(LADDR+MUSWFA+3) = USRWD3(I)
- IQ(LADDR+MUSWFA+4) = USRWD4(I)
- IQ(LADDR+MUSWFA+5) = USRWD5(I)
- IQ(LADDR+MUSWFA+6) = USRWD6(I)
- IQ(LADDR+MUSWFA+7) = USRWD7(I)
- IQ(LADDR+MUSWFA+8) = USRWD8(I)
- IQ(LADDR+MUSWFA+9) = USRWD9(I)
-
- IQ(LADDR+MSYWFA) = SYSWD0(I)
- IQ(LADDR+MSYWFA+1) = SYSWD1(I)
- IQ(LADDR+MSYWFA+2) = SYSWD2(I)
- IQ(LADDR+MSYWFA+3) = SYSWD3(I)
- IQ(LADDR+MSYWFA+4) = SYSWD4(I)
- IQ(LADDR+MSYWFA+5) = SYSWD5(I)
- IQ(LADDR+MSYWFA+6) = SYSWD6(I)
- IQ(LADDR+MSYWFA+7) = SYSWD7(I)
- IQ(LADDR+MSYWFA+8) = SYSWD8(I)
- IQ(LADDR+MSYWFA+9) = SYSWD9(I)
-
- CALL UCTOH(COMMTS(I),IQ(LADDR+MUCMFA),4,80)
- IQ(LADDR+MMTPFA) = ICNTH(MEDIA(I),MEDTYP,4)
- IQ(LADDR+MFSQFA) = FLSQNO(I)
- IQ(LADDR+MVSQFA) = VLSQNO(I)
- CALL UCTOH(VSN(I),IQ(LADDR+MVSNFA),4,6)
- CALL UCTOH(VID(I),IQ(LADDR+MVIDFA),4,6)
- IQ(LADDR+MVIPFA) = PREF(I)
- IQ(LADDR+MDENFA) = DENS(I)
- CALL VBLANK(KEYS(2),5)
- CALL UCTOH(FILEN,KEYS(2),4,NCH-ICH)
- KEYS(MKCLFA) = IQ(LADDR+MCPLFA)
- KEYS(MKMTFA) = IQ(LADDR+MMTPFA)
- KEYS(MKLCFA) = IQ(LADDR+MLOCFA)
- KEYS(MKNBFA) = LKEYFA
-
- IF(IFLAG.EQ.0) THEN
-
- CALL FMPUT(GNAME,LADDR,IRC)
-
- ELSE
-*
-* Check if new directories have to be made
-*
- LEND = INDEXB(GNAME,'/') - 1
- CALL FACDIR (GNAME(1:LEND), ' ')
- IF (IQUEST(1).NE.0)
- + CALL FATMDI(GNAME(1:LEND),LKEYFA,CHFOR,CHTAG)
- CALL FACDIR(GNAME(1:LEND), ' ')
-* NKEYFA = IQUEST(7)
-* KEYS(1) = NKEYFA + 1
- CALL FMALLK(KEYS(1),IRC)
-*
-* Display what we've got so far...
-*
-* CALL DZSHOW('SQL->RZ conversion',IDIVFA,LADDR,'L',0,0,0,0)
-*
-* Verify bank contents
-*
- CALL FMVERI(GNAME(1:NCH),LADDR,KEYS,'A',IRC)
- IF(IRC.NE.0) GOTO 10
-*
-* Write new bank to RZ file
-*
- ICYCLE = 9999
- CALL RZOUT (IDIVFA, LADDR, KEYS, ICYCLE, 'SW')
- CALL RZSAVE
-#if defined(CERNLIB_OLD)
-*
-* Drop bank...
-*
- CALL MZDROP(IDIVFA,LADDR,'.')
- LADDR = 0
-#endif
- ENDIF
-
-10 CONTINUE
-
- IF (IRC .EQ. 1) THEN
- ITOTAL = 1
- GOTO 1
- ENDIF
-
- WRITE(LPRTFA,9002) NPROC,NDEL
-9002 FORMAT(//' FMOTOZ. Total of ',I5,' entries processed ',
- + ' including ',I5,' deleted files ')
-
- END
-
diff --git a/src/packlib/fatmen/programs/fmztor/Imakefile b/src/packlib/fatmen/programs/fmztor/Imakefile
deleted file mode 100644
index 87c6b6a..0000000
--- a/src/packlib/fatmen/programs/fmztor/Imakefile
+++ /dev/null
@@ -1,3 +0,0 @@
-SRCS_F= fmztor.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/fatmen/programs/fmztor/fmztor.F b/src/packlib/fatmen/programs/fmztor/fmztor.F
deleted file mode 100644
index b31b820..0000000
--- a/src/packlib/fatmen/programs/fmztor/fmztor.F
+++ /dev/null
@@ -1,114 +0,0 @@
-*
-* $Id: fmztor.F,v 1.1.1.1 1996/03/07 15:17:47 mclareni Exp $
-*
-* $Log: fmztor.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:47 mclareni
-* Fatmen
-*
-*
-#if defined(CERNLIB_SQLCOM)
- SUBROUTINE FMZTOR(GENAM,LADDR,MODE,IRC)
-*
-* Routine to fill COMMON block /FOFILE/ for call to FOPUTx
-* This version only fills one element of the arrays
-* MODE = -1 Delete entry
-* MODE = 0 Add entry, replace if already exists
-* MODE = 1 Replace entry, error if not found
-*
-#include "fatmen/fatbank.inc"
-#include "fatmen/fatpara.inc"
-#include "fatmen/fofile.inc"
-#include "fatmen/fovars.inc"
-#include "fatmen/slate.inc"
- PARAMETER (ITOTAL=1)
- CHARACTER*(*) GENAM
- CHARACTER*16 EXPER
- CHARACTER*1 MEDTYP(4)
- DATA MEDTYP(1)/'D'/,MEDTYP(2)/'C'/,MEDTYP(3)/'T'/,MEDTYP(4)/'X'/
-*
-* Fill COMMON block
-*
-*... Host variables for GName_ table
-*
- GENAME(ITOTAL) = GENAM
-*
-*... Host variables for Files_ table
-*
- CPLVL(ITOTAL) = IQ(LADDR+MCPLFA)
- LOCAT(ITOTAL) = IQ(LADDR+MLOCFA)
- CALL UHTOC(IQ(LADDR+MHSNFA),4,HNAME(ITOTAL),8)
- CALL UHTOC(IQ(LADDR+MFQNFA),4,FNAME(ITOTAL),240)
- CALL UHTOC(IQ(LADDR+MHSTFA),4,HTYPE(ITOTAL),16)
- CALL UHTOC(IQ(LADDR+MHOSFA),4,OPSYS(ITOTAL),12)
- CALL UHTOC(IQ(LADDR+MFLFFA),4,FFORMT(ITOTAL),4)
- CALL UHTOC(IQ(LADDR+MUTFFA),4,USRFMT(ITOTAL),4)
- SRTREC(ITOTAL) = IQ(LADDR+MSRDFA)
- ENDREC(ITOTAL) = IQ(LADDR+MERDFA)
- SRTBLK(ITOTAL) = IQ(LADDR+MSBLFA)
- ENDBLK(ITOTAL) = IQ(LADDR+MEBLFA)
- CALL UHTOC(IQ(LADDR+MRFMFA),4,RECFMT(ITOTAL),4)
- RECLGH(ITOTAL) = IQ(LADDR+MRLNFA)
- BLKLGH(ITOTAL) = IQ(LADDR+MBLNFA)
-*
-* Unpack date/time and store in a way that ORACLE will understand
-* (See TO_DATE calls in FOGETx/FOPUTx)
-*
- CALL FMUPTM(IDATE,ITIME,IQ(LADDR+MCRTFA),IRC)
-
- CALL FMODAT(IDATE,ITIME,CREDAT(ITOTAL))
- CALL FMUPTM(IDATE,ITIME,IQ(LADDR+MCTTFA),IRC)
- CALL FMODAT(IDATE,ITIME,CATDAT(ITOTAL))
- CALL FMUPTM(IDATE,ITIME,IQ(LADDR+MLATFA),IRC)
- CALL FMODAT(IDATE,ITIME,ACSDAT(ITOTAL))
-*
-* This is the delete flag...
-*
- ACTIVE(ITOTAL) = 'Y'
- IF (MODE .EQ.-1) ACTIVE(ITOTAL) = 'N'
-
- CALL UHTOC(IQ(LADDR+MCURFA),4,CRENAM(ITOTAL),8)
- CALL UHTOC(IQ(LADDR+MCIDFA),4,CREACC(ITOTAL),8)
- CALL UHTOC(IQ(LADDR+MCNIFA),4,CRENOD(ITOTAL),8)
- CALL UHTOC(IQ(LADDR+MCJIFA),4,CREJOB(ITOTAL),8)
- PROTEC(ITOTAL) = IQ(LADDR+MFPRFA)
- USRWD0(ITOTAL) = IQ(LADDR+MUSWFA)
- USRWD1(ITOTAL) = IQ(LADDR+MUSWFA+1)
- USRWD2(ITOTAL) = IQ(LADDR+MUSWFA+2)
- USRWD3(ITOTAL) = IQ(LADDR+MUSWFA+3)
- USRWD4(ITOTAL) = IQ(LADDR+MUSWFA+4)
- USRWD5(ITOTAL) = IQ(LADDR+MUSWFA+5)
- USRWD6(ITOTAL) = IQ(LADDR+MUSWFA+6)
- USRWD7(ITOTAL) = IQ(LADDR+MUSWFA+7)
- USRWD8(ITOTAL) = IQ(LADDR+MUSWFA+8)
- USRWD9(ITOTAL) = IQ(LADDR+MUSWFA+9)
- SYSWD0(ITOTAL) = IQ(LADDR+MSYWFA)
- SYSWD1(ITOTAL) = IQ(LADDR+MSYWFA+1)
- SYSWD2(ITOTAL) = IQ(LADDR+MSYWFA+2)
- SYSWD3(ITOTAL) = IQ(LADDR+MSYWFA+3)
- SYSWD4(ITOTAL) = IQ(LADDR+MSYWFA+4)
- SYSWD5(ITOTAL) = IQ(LADDR+MSYWFA+5)
- SYSWD6(ITOTAL) = IQ(LADDR+MSYWFA+6)
- SYSWD7(ITOTAL) = IQ(LADDR+MSYWFA+7)
- SYSWD8(ITOTAL) = IQ(LADDR+MSYWFA+8)
- SYSWD9(ITOTAL) = IQ(LADDR+MSYWFA+9)
- CALL UHTOC(IQ(LADDR+MUCMFA),4,COMMTS(ITOTAL),80)
- MEDIA(ITOTAL) = MEDTYP(IQ(LADDR+MMTPFA))
- FLSQNO(ITOTAL) = IQ(LADDR+MFSQFA)
- VLSQNO(ITOTAL) = IQ(LADDR+MVSQFA)
- CALL UHTOC(IQ(LADDR+MVSNFA),4,VSN(ITOTAL),6)
- CALL UHTOC(IQ(LADDR+MVIDFA),4,VID(ITOTAL),6)
- PREF(ITOTAL) = IQ(LADDR+MVIPFA)
- DENS(ITOTAL) = IQ(LADDR+MDENFA)
- CALL FMWORD(EXPER,3,'/',GENAM,IRC)
- CALL DATIME(ID,IT)
- PRINT *,'FMZTOR. time before ORACLE = ',ID,IT,IS(6)
- IF (MODE .EQ.-1) THEN
- CALL FODEL(IRC)
- ELSE
- CALL FOPUT(ITOTAL,MODE,IRC)
- ENDIF
- CALL DATIME(ID,IT)
- PRINT *,'FMZTOR. time after ORACLE = ',ID,IT,IS(6)
-
- END
-#endif
diff --git a/src/packlib/fatmen/programs/fodel/Imakefile b/src/packlib/fatmen/programs/fodel/Imakefile
deleted file mode 100644
index 869433a..0000000
--- a/src/packlib/fatmen/programs/fodel/Imakefile
+++ /dev/null
@@ -1,3 +0,0 @@
-SRCS_F= fodel.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/fatmen/programs/fodel/fodel.F b/src/packlib/fatmen/programs/fodel/fodel.F
deleted file mode 100644
index ea51c90..0000000
--- a/src/packlib/fatmen/programs/fodel/fodel.F
+++ /dev/null
@@ -1,362 +0,0 @@
-*
-* $Id: fodel.F,v 1.1.1.1 1996/03/07 15:17:48 mclareni Exp $
-*
-* $Log: fodel.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:48 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
-
-#if !defined(CERNLIB_IBMRT)
- SUBROUTINE FODEL(IRETC)
-#endif
-#if defined(CERNLIB_IBMRT)
- SUBROUTINE FODEL_(IRETC)
-#endif
- INTEGER IRETC
-
-* Action : Excludes from the FATMEN file database the information
-* received in the first tuple of common block FOFILE, if
-* file information exists and user account provided is
-* the same as of the creator.
-* File information is only logically deleted (ACTIVE is
-* set to "N") in FILES_ table, but all related rows in
-* FXV_ and VOLUMES_ tables are removed (from VOLUMES_
-* only if last file on that volume)
-*
-* Returns : IRETC => return code ( 0 => normal end. First tuple in
-* FOFILE removed from the
-* database
-* -9998=> SQL warning. See FOR006
-* -9997=> //database/experiment does
-* not exist
-* -9996=> generic name does not exist
-* -9995=> file entry does exist (check
-* file and volume fields)
-* -9994=> user account not authorized
-* to remove the file entry
-* -6079 to
-* -0001=> SQL errors, IRETC=SQLCDE )
-*
-* Note: Although the multi-volume case is not yet considered, the
-* DELETE operation (including removal of the volumes) can be
-* issued by a sequence of calls to this routine, using same
-* values each time and only changing the VID and VSN values
-*
-* Responsible : Luigino Palermo (PALERMO at VXCERN,CERNVM)
-*
-* Changes history:
-*
-* DATE MODIFICATIONS
-*-----------------------------------------------------------------------
-*
-* 15/09/89 Correction of bug when selecting VOL# in FXV_ table
-* before deleting tape from VOLUMES_ table (problem
-* only for multi-file volume). Now uses COUNT function
-* 26/09/89 Recodification, using dynamic-defined statements.
-* Method 3 (PREPARE, DECLARE, OPEN & FETCH) for SELECT
-* method 1 (EXECUTE IMMEDIATE) for LOCK and method 2
-* otherwise.
-
-#if defined(CERNLIB_IBMRT)
-#include "fatmen/fofilex.inc"
-#endif
-#if !defined(CERNLIB_IBMRT)
-#include "fatmen/fofile.inc"
-#endif
-#include "fatmen/fovars.inc"
-
-*...General variables
-
- INTEGER I1, I2, I3, LEXP
- EXTERNAL CLTOU
- CHARACTER*6 CMD
-*
-*...Variables for Oracle/SQL...........................................
-*
- EXEC SQL BEGIN DECLARE SECTION
-
- CHARACTER*8 DBASE, EXPER
- CHARACTER*100 STMT1, STMT2, STMT5, STMT6, STMT7, STMT8
- CHARACTER*200 STMT3
- CHARACTER*400 STMT4
-#if defined(CERNLIB_SQLDS)
- INTEGER*2 LSTMT4
- CHARACTER*200 STMT04
- COMMON/STMT02/ LSTMT4,STMT4
- EQUIVALENCE (LSTMT4,STMT04)
-#endif
- INTEGER LINES
-
-*...Auxiliary host variables to hold internal identifiers of rows
-
- INTEGER GNID, FILEID, VOLID
-
-*...Auxiliary host vars for GNAMES_ table
-
- CHARACTER*240 GENAM2
-
-*...Auxiliary host vars for FILES_ table
-
- INTEGER LOCA2, FLSQN2, VLSQN2
- CHARACTER HNAM2*8, FNAM2*240, CREAC2*8, MEDI2*1
-
-*...Auxiliary host vars for VOLUMES_ table
-
- INTEGER PRE2, DEN2
- CHARACTER VI2*6, VS2*6
-
-*...Indicator variables
-
- INTEGER*2 CREACI
-
- EXEC SQL END DECLARE SECTION
-*......................................................................
-
-
-*
-*...SQL common area
-*
- EXEC SQL INCLUDE SQLCA.FOR
-
-*... Converts lower to upper case in the generic name
-
- GENAM2 = GENAME(1)
- CALL CLTOU (GENAM2)
-
-*... I1, I2, and I3 mark the limits of first 2 parts of generic name
-
- I1 = INDEX (GENAM2, '//')
- I2 = INDEX (GENAM2(I1+2:), '/')
- I3 = INDEX (GENAM2(I1+I2+2:), '/')
- IF ((I1.LE.0).OR.(I2.LE.1).OR.(I3.LE.1)) GOTO 1300
-
-*... Parse generic name and exclude //database/experiment/ prologue
-* (in the tables of an experiment do not contain the database and
-* experiment names)
-
- DBASE = GENAM2(I1+2:I1+I2)
- EXPER = GENAM2(I1+I2+2:I1+I2+I3)
- LEXP = INDEX (EXPER, ' ') - 1
- GENAM2 = GENAM2(I1+I2+I3+2:)
-
- EXEC SQL WHENEVER SQLWARNING GOTO 1100
- EXEC SQL WHENEVER SQLERROR GOTO 1200
-
-*...Locks FATMEN table to avoid parallel writing while reading it
-
- EXEC SQL LOCK TABLE FATMEN IN SHARE MODE
-
-*...Looks for database and experiment in FATMEN table (if doesn't exist,
-*...returns error -9997)
-
- EXEC SQL WHENEVER NOT FOUND GOTO 1300
-
- EXEC SQL SELECT * INTO :DBASE, :EXPER FROM FATMEN
- 2 WHERE DATABASE =:DBASE AND EXPERIMENT =:EXPER
-
-*...Locks all tables to be modified for exclusive access
-
- STMT1 = 'LOCK TABLE GNAMES_' // EXPER(1:LEXP) // ', FILES_' //
- 1 EXPER(1:LEXP) // ', FXV_' // EXPER(1:LEXP) //
- 2 ',VOLUMES_' // EXPER(1:LEXP) // ' IN EXCLUSIVE MODE'
-
- CMD = 'STMT1'
- EXEC SQL EXECUTE IMMEDIATE :STMT1
-
-*...Looks for generic name in GNAMES_ table (error if it does not exist)
-
- EXEC SQL WHENEVER NOT FOUND GOTO 1400
-
- STMT2 = 'SELECT GN# FROM GNAMES_' // EXPER(1:LEXP) //
- 1 ' WHERE GNAME = :GENAM2'
-
- CMD = 'STMT2'
- EXEC SQL PREPARE S2 FROM :STMT2
- EXEC SQL DECLARE C2 CURSOR FOR S2
- EXEC SQL OPEN C2 USING :GENAM2
- EXEC SQL FETCH C2 INTO :GNID
-
- 30 CONTINUE
-
-*...NB: Stores every array bind variable to be used in SQL statement in
-*... a temporary variable with same name less last char, plus "2"
-*... (PCC precompiler DOES NOT accept arrays elements !)
-
- MEDI2 = MEDIA(1)
- CALL CLTOU (MEDI2)
-
- EXEC SQL WHENEVER NOT FOUND GOTO 1500
-
- IF (MEDI2.EQ.'D') THEN
-
-*... Assigns values to temporary variables to be used in SELECT
-* of FILES_ table (disk files)
-
- HNAM2 = HNAME(1)
- CALL CLTOU (HNAM2)
-
- FNAM2 = FNAME(1)
- CALL CLTOU (FNAM2)
-
-
- STMT3 = 'SELECT FILE#, CREATORACCOUNT FROM FILES_' //
- 1 EXPER(1:LEXP) // ' WHERE HOSTNAME = :HNAM2' //
- 2 ' AND FULLNAME = :FNAM2 AND MEDIATYPE = :MEDI2' //
- 3 ' AND ACTIVE = ''Y'' AND GN# = :GNID'
-
- CMD = 'STMT3'
- EXEC SQL PREPARE S3 FROM :STMT3
- EXEC SQL DECLARE C3 CURSOR FOR S3
- EXEC SQL OPEN C3 USING :HNAM2, :FNAM2, :MEDI2, :GNID
- EXEC SQL FETCH C3 INTO :FILEID, :CREAC2:CREACI
-
- ELSE
-
-*... Assigns values to temporary variables to be used in SELECT
-* (tape files, columns to identify it uniquely come from
-* FILES_, FXV_ and VOLUMES_ tables)
-
- LOCA2 = LOCAT(1)
-
- VI2 = VID(1)
- CALL CLTOU (VI2)
-
- VS2 = VSN(1)
- CALL CLTOU (VS2)
-
- FLSQN2 = FLSQNO(1)
-
- STMT4 = 'SELECT FILES_' // EXPER(1:LEXP) //
- 1 '.FILE#, VOLUMES_' // EXPER(1:LEXP) //
- 2 '.VOL#, CREATORACCOUNT FROM VOLUMES_' //
- 3 EXPER(1:LEXP) // ', FXV_'// EXPER(1:LEXP) //
- 4 ', FILES_' // EXPER(1:LEXP) // ' WHERE FILES_' //
- 5 EXPER(1:LEXP) //'.FILE# = FXV_' // EXPER(1:LEXP) //
- 6 '.FILE# AND FXV_' // EXPER(1:LEXP) //
- 7 '.VOL# = VOLUMES_' // EXPER(1:LEXP) //
- 8 '.VOL# AND VID = :VI2 AND VSN = :VS2' //
- 9 ' AND FILESEQ# = :FLSQN2 AND LOCATION = :LOCA2' //
- A ' AND MEDIATYPE = :MEDI2 AND ACTIVE = ''Y''' //
- B ' AND GN# = :GNID'
-
- CMD = 'STMT4'
-#if defined(CERNLIB_ORACLE)
- EXEC SQL PREPARE S4 FROM :STMT4
-#endif
-#if defined(CERNLIB_SQLDS)
- EXEC SQL PREPARE S4 FROM :STMT04
-#endif
- EXEC SQL DECLARE C4 CURSOR FOR S4
- EXEC SQL OPEN C4 USING :VI2, :VS2, :FLSQN2, :LOCA2,
- 1 :MEDI2, :GNID
- EXEC SQL FETCH C4 INTO :FILEID, :VOLID, :CREAC2:CREACI
-
- ENDIF
-
-*... Checks if the creator account is the same as the provided in
-* the common area (if NULL, goes on deletion)
-
- IF ((CREAC2.NE.CREACC(1)).AND.(CREACI.NE.-1)) GOTO 1600
-
-*... Marks the file entry as a "deleted" one, but keeps row with
-* ACTIVE = No
-
- STMT6 = 'UPDATE FILES_' // EXPER(1:LEXP) //
- 1 ' SET ACTIVE = ''N'' WHERE FILE# = :FILEID'
-
- CMD = 'STMT6'
- EXEC SQL PREPARE S6 FROM :STMT6
- EXEC SQL EXECUTE S6 USING :FILEID
-
-*... Verifies if file was the only on that tape volume, and if
-* positive, deletes respective rows in VOLUMES_, besides FXV_
-
- IF (MEDI2.NE.'D') THEN
-
- STMT7 = 'DELETE FROM FXV_' // EXPER(1:LEXP) //
- 1 ' WHERE FILESEQ# = :FLSQN2' //
- 2 ' AND VOL# = :VOLID AND FILE# = :FILEID'
-
- CMD = 'STMT7'
- EXEC SQL PREPARE S7 FROM :STMT7
- EXEC SQL EXECUTE S7 USING :FLSQN2, :VOLID, :FILEID
-
- EXEC SQL WHENEVER NOT FOUND CONTINUE
-
- LINES = 0
-
- STMT5 = 'SELECT COUNT(VOL#) FROM FXV_' // EXPER(1:LEXP)
- 1 // ' WHERE VOL# = :VOLID'
-
- CMD = 'STMT5'
- EXEC SQL PREPARE S5 FROM :STMT5
- EXEC SQL DECLARE C5 CURSOR FOR S5
- EXEC SQL OPEN C5 USING :VOLID
- EXEC SQL FETCH C5 INTO :LINES
-
- IF (LINES.EQ.0) THEN
-
- STMT8 = 'DELETE FROM VOLUMES_' // EXPER(1:LEXP) //
- 1 ' WHERE VOL# = :VOLID'
-
- CMD = 'STMT8'
- EXEC SQL PREPARE S8 FROM :STMT8
- EXEC SQL EXECUTE S8 USING :VOLID
-
- ENDIF
- ENDIF
-
- EXEC SQL COMMIT WORK
-
- RETURN
-
- 1100 CONTINUE
- WRITE (6,1110) CMD, SQLWN1, SQLWN2, SQLWN3, SQLWN4, SQLWN5,
- 2 SQLWN6, SQLWN7
- IRETC = -9998
- EXEC SQL WHENEVER SQLWARNING CONTINUE
- EXEC SQL ROLLBACK WORK
- RETURN
-
- 1200 CONTINUE
- WRITE (6,1210) CMD, SQLCDE, (SQLEMC(J), J=1,70)
- IRETC = SQLCDE
- EXEC SQL WHENEVER SQLERROR CONTINUE
- EXEC SQL ROLLBACK WORK
- RETURN
-
- 1300 CONTINUE
- WRITE (6,1310) DBASE,EXPER
- IRETC = -9997
- EXEC SQL ROLLBACK WORK
- RETURN
-
- 1400 CONTINUE
- WRITE (6,1410)
- IRETC = -9996
- EXEC SQL ROLLBACK WORK
- RETURN
-
- 1500 CONTINUE
- WRITE (6,1510)
- IRETC = -9995
- EXEC SQL ROLLBACK WORK
- RETURN
-
- 1600 CONTINUE
- WRITE (6,1610)
- IRETC = -9994
- EXEC SQL ROLLBACK WORK
- RETURN
-
- 1110 FORMAT (/, ' SQL WARNING ON ', A6, '. SQLWN_ INDICATORS: ',
- 1 7('"',A1,'"',2X))
- 1210 FORMAT (/, ' SQL ERROR ON ', A6, ': ', I5, ' ', 70A1)
- 1310 FORMAT (/, ' ERROR: UNKNOWN DATABASE AND EXPERIMENT,A,1X,A')
- 1410 FORMAT (/, ' ERROR: GENERIC NAME DOES NOT EXIST')
- 1510 FORMAT (/, ' ERROR: DISK OR TAPE FILE ENTRY DOES NOT EXIST')
- 1610 FORMAT (/, ' ERROR: PROVIDED ACCOUNT DIFFERS FROM CREATOR''S ONE')
- END
-
diff --git a/src/packlib/fatmen/programs/foget/Imakefile b/src/packlib/fatmen/programs/foget/Imakefile
deleted file mode 100644
index 49f3a3b..0000000
--- a/src/packlib/fatmen/programs/foget/Imakefile
+++ /dev/null
@@ -1,3 +0,0 @@
-SRCS_F= foget.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/fatmen/programs/foget/foget.F b/src/packlib/fatmen/programs/foget/foget.F
deleted file mode 100644
index 6655840..0000000
--- a/src/packlib/fatmen/programs/foget/foget.F
+++ /dev/null
@@ -1,283 +0,0 @@
-*
-* $Id: foget.F,v 1.1.1.1 1996/03/07 15:17:48 mclareni Exp $
-*
-* $Log: foget.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:48 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
-
-#if defined(CERNLIB_IBMRT)
- SUBROUTINE FOGET(NAME, NDONE, IRETC)
-#endif
-#if !defined(CERNLIB_IBMRT)
- SUBROUTINE FOGET_(NAME, NDONE, IRETC)
-#endif
- CHARACTER*(*) NAME
- INTEGER NDONE, IRETC
-
-* Action : Looks if //Database/Experiment are OK. If yes, then
-* searches in the FATMEN file database on Oracle/SQL
-* for generic name (more than 1 if directory-like)
-* derived from NAME and fills common block FOFILE with
-* information found in tables GNAMES_, FILES_, FXV_
-* and VOLUMES_
-*
-* Receives: NAME => complete or partial (one * means any value in
-* that position) generic name to be searched
-*
-* NDONE => zero indicates is the first time routine is
-* being called. Any other value indicates that is
-* a continuation of previous call (ATTENTION !!)
-*
-* Returns : NDONE => number of entries filled in the common blocks
-* for this call
-*
-* IRETC => <0 : errors (-9999 => no information retrieved)
-* (-9998 => SQL warning. See FOR006 )
-* (-9997 => Database and Experiment
-* wrongly specified )
-* (-0001 to
-* -6079 => SQL errors, IRETC=SQLCDE)
-* =0 : no more information (normal end)
-* =1 : to be continued (incomplete end)
-*
-* Interface : common block /FOFILE/, containing 10-elements arrays
-* which will contain at the end (if no errors) NDONE
-* logical tuples made of concatenation of elements in
-* the same position of the arrays. Information about
-* each table is repeated when necessary (same generic
-* name/file attributes when multi-volume files, whose
-* are indicated by volume sequence number (VLSQNO)
-*
-* Responsible : Luigino Palermo (PALERMO at VXCERN,CERNVM)
-*
-* Changes history:
-*
-* DATE MODIFICATIONS
-*--------------------------------------------------------------------
-*
-* 28/06/89 Use of Oracle CURSOR instead of array fetch (due
-* to unknown number of retrieved rows)
-* 01/07/89 Generic name begining with //CERN/exp-name/...
-* and case-insensitive
-* 04/04/89 Call CLTOU instead of TRE0EU (lower to upper case)
-* 07/07/89 Lock of tables in SHARE mode (no parallel updating
-* allowed) before read them
-* 13/07/89 Inclusion of creator account (CREACC) and 10 system
-* words (SYSWDx); use of Patchy to manage code
-* 26/09/89 Recodification, using dynamic-defined statements.
-* Method 3 (PREPARE, DECLARE, OPEN & FETCH) for SELECT
-* and method 1 (EXECUTE IMMEDIATE) for LOCK
-*
-
-*... General variables
-
- INTEGER I1, I2, I3, J, K
- INTEGER NTOTAL, LEXP
- EXTERNAL CLTOU
- CHARACTER*1100 SELECT
- CHARACTER*80 FROM, ORDER
- CHARACTER*6 CMD
-#if !defined(CERNLIB_IBMRT)
-#include "fatmen/fofile.inc"
-#endif
-#if defined(CERNLIB_IBMRT)
-#include "fatmen/fofilex.inc"
-#endif
-
-*... Variables for Oracle
-
- EXEC SQL BEGIN DECLARE SECTION
-
- CHARACTER*8 DBASE, EXPER
- CHARACTER*100 STMT1
- CHARACTER*240 GFN
- CHARACTER*200 WHERE
- CHARACTER*2000 STMT2
-#if defined(CERNLIB_SQLDS)
- INTEGER*2 LSTMT2
- CHARACTER*200 STMT02
- COMMON/STMT02/ LSTMT2,STMT2
- EQUIVALENCE (LSTMT2,STMT02)
-#endif
-#include "fatmen/fovars.inc"
-
- EXEC SQL END DECLARE SECTION
-
-*... SQL common area
-
- EXEC SQL INCLUDE SQLCA.FOR
-
- EXEC SQL WHENEVER SQLERROR GOTO 1200
-
-*... If NDONE is zero, this is the first call. Otherwise, continuation
-* of previous call
-
- IF (NDONE) 90, 10, 90
-
-10 CONTINUE
-
- NTOTAL = 0
-
-*... Translate to upper case
-
- CALL CLTOU (NAME)
-
-*... I1, I2 and I3 mark the limits of first 2 parts of generic name
-
- I1 = INDEX (NAME, '//')
- I2 = INDEX (NAME(I1+2:), '/')
- I3 = INDEX (NAME(I1+I2+2:), '/')
- IF ((I1.LE.0).OR.(I2.LE.1).OR.(I3.LE.1)) GOTO 1300
-
-*... Parse the generic NAME and search for *, preparing fetch
-
- DBASE = NAME (I1+2:I1+I2)
- EXPER = NAME (I1+I2+2:I1+I2+I3)
- LEXP = INDEX (EXPER,' ') - 1
- NAME = NAME (I1+I2+I3+2:)
- K = INDEX (NAME, '*')
- IF (K.NE.0) THEN
-*... '%' in SQL means any string of zero or more chars
- NAME(K:K) = '%'
- ENDIF
-
- GFN = NAME
-
- EXEC SQL WHENEVER NOT FOUND GOTO 1300
-
-*... Looks for Database and Experiment provided
-
- EXEC SQL SELECT * INTO :DBASE, :EXPER FROM FATMEN
- 2 WHERE DATABASE=:DBASE AND EXPERIMENT=:EXPER
-
-*... Prepare Oracle cursor to fetch of tuples containing files
-
- SELECT = 'SELECT GNAME,NVL(COPYLEVEL,-1),NVL(LOCATION,-1),'//
- 1 'NVL(HOSTNAME,'' ''),NVL(FULLNAME,'' ''),'//
- 2 'NVL(HOSTTYPE,'' ''),NVL(OPERSYS,'' ''),NVL(FILEFORMAT,'' ''),'
- 3 //'NVL(USERFORMAT,'' ''),NVL(STARTREC#,-1),NVL(ENDREC#,-1),'//
- 4 'NVL(STARTBLK#,-1),NVL(ENDBLK#,-1),NVL(RECFORMAT,'' ''),'//
- 5 'NVL(RECLENGTH,-1),NVL(BLKLENGTH,-1),NVL(ACTIVE,'' ''),'//
- 6 'NVL(TO_CHAR(CREATION,''DD-MON-YY HH24:MM''),'' ''),'//
- 7 'NVL(TO_CHAR(CATALOGATION,''DD-MON-YY HH24:MM''),'' ''),'//
- 8 'NVL(TO_CHAR(LASTACCESS,''DD-MON-YY HH24:MM''),'' ''),'//
- 9 'NVL(CREATORNAME,'' ''),NVL(CREATORACCOUNT,'' ''),'//
- A 'NVL(CREATORNODE,'' ''),NVL(CREATORJOB,'' ''),'//
- B 'NVL(PROTECTION,-1),NVL(USERWORD0,-1),NVL(USERWORD1,-1),'//
- C 'NVL(USERWORD2,-1),NVL(USERWORD3,-1),NVL(USERWORD4,-1),'//
- D 'NVL(USERWORD5,-1),NVL(USERWORD6,-1),NVL(USERWORD7,-1),'//
- E 'NVL(USERWORD8,-1),NVL(USERWORD9,-1),NVL(SYSWORD0,-1),'//
- F 'NVL(SYSWORD1,-1),NVL(SYSWORD2,-1),NVL(SYSWORD3,-1),'//
- G 'NVL(SYSWORD4,-1),NVL(SYSWORD5,-1),NVL(SYSWORD6,-1),'//
- H 'NVL(SYSWORD7,-1),NVL(SYSWORD8,-1),NVL(SYSWORD9,-1),'//
- I 'NVL(COMMENTS, '' ''),NVL(MEDIATYPE,'' ''),NVL(FILESEQ#,-1),'//
- J 'NVL(VOLSEQ#,-1),NVL(VID,'' ''),NVL(VSN,'' ''),'//
- K 'NVL(VIDPREFIX,-1),NVL(DENSITY,-1) '
- FROM = ' FROM VOLUMES_' // EXPER(1:LEXP) // ', FXV_' //
- 1 EXPER(1:LEXP)// ',FILES_' // EXPER(1:LEXP) //
- 2 ', GNAMES_' // EXPER(1:LEXP)
- WHERE = ' WHERE GNAMES_' // EXPER(1:LEXP) // '.GN# = FILES_'
- 1 // EXPER(1:LEXP) // '.GN# (+) AND FILES_' //
- 2 EXPER(1:LEXP) // '.FILE# = FXV_' //
- 3 EXPER(1:LEXP) // '.FILE# (+) AND FXV_' //
- 4 EXPER(1:LEXP) // '.VOL# = VOLUMES_' //
- 5 EXPER(1:LEXP) // '.VOL# (+) AND ' //
- 6 'ACTIVE = ''Y'' AND GNAME LIKE :GFN'
- ORDER = ' ORDER BY GNAMES_' // EXPER(1:LEXP) //
- 1 '.GN#, FILES_' // EXPER(1:LEXP) // '.FILE#, VOLSEQ#'
-
- STMT2 = SELECT//FROM//WHERE//ORDER
-#if defined(CERNLIB_ORACLE)
- EXEC SQL PREPARE S1 FROM :STMT2
-#endif
-#if defined(CERNLIB_SQLDS)
-* Warning: must use this trick for SQL/DS pre-compiler
-* LONG VARCHAR variables are not allowed, and we don't have
-* structures in FORTRAN so...
-* Change reference 452 to 448 before compiling
- EXEC SQL PREPARE S1 FROM :STMT02
-#endif
- EXEC SQL DECLARE C1 CURSOR FOR S1
-
-*... Lock all tables of that experiment for read access
-
- STMT1 = 'LOCK TABLE GNAMES_' // EXPER(1:LEXP) //
- 1 ',FILES_' // EXPER(1:LEXP) // ',FXV_' //
- 2 EXPER(1:LEXP) // ',VOLUMES_' // EXPER(1:LEXP)
- 3 // ' IN SHARE MODE'
-
- CMD = 'STMT1'
- EXEC SQL EXECUTE IMMEDIATE :STMT1
-
- EXEC SQL OPEN C1 USING :GFN
-
-90 CONTINUE
-
- EXEC SQL WHENEVER NOT FOUND GOTO 1000
- EXEC SQL WHENEVER SQLWARNING GOTO 1100
-
- CMD = 'STMT2'
- EXEC SQL FETCH C1 INTO
- 1 :GENAME, :CPLVL, :LOCAT, :HNAME, :FNAME, :HTYPE,
- 2 :OPSYS, :FFORMT, :USRFMT, :SRTREC, :ENDREC, :SRTBLK,
- 3 :ENDBLK, :RECFMT, :RECLGH, :BLKLGH, :ACTIVE,
- 4 :CREDAT, :CATDAT, :ACSDAT,
- 5 :CRENAM, :CREACC, :CRENOD, :CREJOB, :PROTEC,
- 6 :USRWD0, :USRWD1, :USRWD2, :USRWD3, :USRWD4, :USRWD5,
- 7 :USRWD6, :USRWD7, :USRWD8, :USRWD9,
- 6 :SYSWD0, :SYSWD1, :SYSWD2, :SYSWD3, :SYSWD4, :SYSWD5,
- 6 :SYSWD6, :SYSWD7, :SYSWD8, :SYSWD9,
- 8 :COMMTS, :MEDIA, :FLSQNO, :VLSQNO,
- 9 :VID, :VSN, :PREF, :DENS
-
-*... NDONE holds the number of tuples for this fetch, NTOTAL the total
-* of tuples up to last fetch
-
- NDONE = SQLERD(3) - NTOTAL
- NTOTAL = SQLERD(3)
- IRETC = 1
- RETURN
-
-1000 CONTINUE
- NDONE = SQLERD(3) - NTOTAL
- NTOTAL = SQLERD(3)
- IF ((NDONE.EQ.0).AND.(NTOTAL.EQ.0)) THEN
-*...no information could be retrieved (wrong generic name?)
- IRETC = -9999
- ELSE
- IRETC = 0
- ENDIF
-
- EXEC SQL CLOSE C1
- EXEC SQL COMMIT WORK
- RETURN
-
-1100 CONTINUE
- WRITE (6,1110) CMD, SQLWN1, SQLWN2, SQLWN3, SQLWN4, SQLWN5,
- 2 SQLWN6, SQLWN7
- IRETC = -9998
- EXEC SQL ROLLBACK WORK
- RETURN
-
-1200 CONTINUE
- WRITE (6,1210) CMD, SQLCDE, (SQLEMC(J), J=1,70)
- IRETC = SQLCDE
- EXEC SQL WHENEVER SQLERROR CONTINUE
- EXEC SQL ROLLBACK WORK
- RETURN
-
-1300 CONTINUE
- WRITE (6,1310) DBASE,EXPER
- IRETC = -9997
- EXEC SQL ROLLBACK WORK
- RETURN
-
-1110 FORMAT (/, ' SQL WARNING ON ', A6, '. SQLWN_ INDICATORS: ',
- 1 7('"',A1,'"',2X))
-1210 FORMAT (/, ' SQL ERROR ON ', A6, ': ', I5, ' ', 70A1)
-1310 FORMAT (/, ' ERROR: UNKNOWN DATABASE AND EXPERIMENT',A,1X,A)
-
- END
diff --git a/src/packlib/fatmen/programs/foput/Imakefile b/src/packlib/fatmen/programs/foput/Imakefile
deleted file mode 100644
index 7185df2..0000000
--- a/src/packlib/fatmen/programs/foput/Imakefile
+++ /dev/null
@@ -1,3 +0,0 @@
-SRCS_F= foput.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/fatmen/programs/foput/foput.F b/src/packlib/fatmen/programs/foput/foput.F
deleted file mode 100644
index 798861d..0000000
--- a/src/packlib/fatmen/programs/foput/foput.F
+++ /dev/null
@@ -1,900 +0,0 @@
-*
-* $Id: foput.F,v 1.1.1.1 1996/03/07 15:17:48 mclareni Exp $
-*
-* $Log: foput.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:48 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
-
-#if !defined(CERNLIB_IBMRT)
- SUBROUTINE FOPUT(ITOTAL, IFLAG, IRETC)
-#endif
-#if defined(CERNLIB_IBMRT)
- SUBROUTINE FOPUT_(ITOTAL, IFLAG, IRETC)
-#endif
- INTEGER IRETC, ITOTAL, IFLAG
-
-* Action : Modifies in the FATMEN file database the information
-* received in ITOTAL tuples of common block FOFILE.
-* Information is inserted as rows of tables GNAMES_,
-* FILES_, FXV_ and VOLUMES_.
-* If the file entry does not exist, take one of 2 actions:
-* include it (IFLAG=0) or return an error (IFLAG=1)
-* All generic names referred to in the common area must be
-* the same and provided in its complete format (without '*')
-*
-* Receives: ITOTAL=> number of elements in the arrays of the COMMON
-* area to be included in the database (<=10, but
-* normally =1)
-* IFLAG => action when file entry not yet in FATMEN
-* (=0, add new entry ; =1, error IRETC=-9996)
-*
-* Returns : IRETC => return code ( 0 => normal end. ITOTAL tuples
-* written from FOFILE into the
-* database
-* -9999=> generic name is not the same
-* for all tuples
-* -9998=> SQL warning. See FOR006
-* -9997=> //database/experiment does
-* not exist
-* -9996=> entry file to be modified
-* does not exist (IFLAG=1)
-* -9995=> entry file to be added
-* already exists (IFLAG=-1)
-* -6079 to
-* -0001=> SQL errors, IRETC=SQLCDE )
-* ITOTAL=> when IRETC=-9996, tuple where error occured
-*
-* Responsible : Luigino Palermo (PALERMO at VXCERN,CERNVM)
-*
-* Changes history:
-*
-* DATE MODIFICATIONS
-*----------------------------------------------------------------------
-*
-* 13/07/89 Inclusion of creator account (CREACC) and 10 system
-* words (SYSWDx); use of Patchy to manage code
-* 15/09/89 Modification to allow more than one generic name
-* pointing to the same file (aliases for generic names)
-* 26/09/89 Recodification, using dynamic-defined statements.
-* Method 1 (EXECUTE IMMEDIATE) for LOCK, method 3
-* (PREPARE, DECLARE, OPEN & FETCH) for SELECT and
-* 17/01/90 Location is no more considered to check existence of
-* a tape file entry. Default action of FOPUT now is to
-* modify existing entries. If entry is not in FATMEN,
-* action is defined according to IFLAG value
-* 29/01/90 Correction of error when modifying a file: it was
-* including an entry in FXV_ even if was already there
-* File seq # is NOT NULL, so variable FLSQNI removed
-* 01/02/90 Restructuring of the routine due to consecutive errors
-* of logic, after having changed the default operation
-* to modification and included parameter IFLAG
-
-#if defined(CERNLIB_IBMRT)
-#include "fatmen/fofilex.inc"
-#endif
-#if !defined(CERNLIB_IBMRT)
-#include "fatmen/fofile.inc"
-#endif
-#include "fatmen/fovars.inc"
-* To get IDEBFA for debug
-#include "fatmen/fatbank.inc"
-
-*...General variables
-
- INTEGER I, J, I1, I2, I3, LEXP
- LOGICAL OLDGN, OLDFILE
- EXTERNAL CLTOU
- CHARACTER*6 CMD
-*
-*...Variables for Oracle...............................................
-*
- EXEC SQL BEGIN DECLARE SECTION
-
- CHARACTER*8 DBASE, EXPER
- CHARACTER*100 STMT1, STMT2, STMT3, STMT5, STMT6, STMT7, STMT9,
- 1 STMT11, STMT12, STMT16
- CHARACTER*150 STMT8, STMT14, STMT15
- CHARACTER*300 STMT4
- CHARACTER*1000 STMT10
- CHARACTER*1500 STMT13
-#if defined(CERNLIB_SQLDS)
- COMMON/STMT40/LSTMT04,STMT4
- CHARACTER*200 STMT04
- EQUIVALENCE (LSTMT04,STMT04)
- COMMON/STMT0A/LSTMT10,STMT10
- CHARACTER*200 STMT0A
- EQUIVALENCE (LSTMT10,STMT0A)
- COMMON/STMT0A/LSTMT13,STMT13
- CHARACTER*200 STMT0D
- EQUIVALENCE (LSTMT13,STMT0D)
-#endif
-
-*...Auxiliary host variables to hold internal identifiers of rows
-
- INTEGER GNID, FILEID, VOLID
-
-*...Auxiliary host vars for GNAMES_ table
-
- CHARACTER*240 GENAM2
-
-*...Auxiliary host vars for FILES_ table
-* (USRWx2 instead of USRWDx2, sorry!)
-* (SYSWx2 instead of SYSWDx2, sorry again!)
-
- INTEGER CPLV2, LOCA2, SRTRE2, ENDRE2,
- 1 SRTBL2, ENDBL2, RECLG2, BLKLG2,
- 2 PROTE2, USRW02, USRW12, USRW22,
- 3 USRW32, USRW42, USRW52, USRW62,
- 4 USRW72, USRW82, USRW92, SYSW02,
- 5 SYSW12, SYSW22, SYSW32, SYSW42,
- 6 SYSW52, SYSW62, SYSW72, SYSW82,
- 7 SYSW92, FLSQN2, VLSQN2
-
- CHARACTER HNAM2*8, FNAM2*240, HTYP2*16, OPSY2*12,
- 1 FFORM2*4, USRFM2*4, RECFM2*4, CREDA2*15,
- 2 CATDA2*15, ACSDA2*15, CRENA2*8, CREAC2*8,
- 3 CRENO2*8, CREJO2*8, COMMT2*80, MEDI2*1,
- 4 ACTIV2*1
-
-*...Auxiliary hots vars for VOLUMES_ table
-
- INTEGER PRE2, DEN2
-
- CHARACTER VI2*6, VS2*6
-
-*...Indicator variables for all possible NULL columns
-
- INTEGER*2 HTYPI, OPSYI, USRFMI, SRTREI, ENDREI, SRTBLI, ENDBLI,
- 1 RECFMI, RECLGI, BLKLGI, CREDAI, CATDAI, ACSDAI, CRENAI,
- 2 CRENOI, CREJOI, PROTEI, USRW0I, USRW1I, USRW2I, USRW3I,
- 3 USRW4I, USRW5I, USRW6I, USRW7I, USRW8I, USRW9I, SYSW0I,
- 4 SYSW1I, SYSW2I, SYSW3I, SYSW4I, SYSW5I, SYSW6I, SYSW7I,
- 5 SYSW8I, SYSW9I, COMMTI, MEDII, VLSQNI, PREI,
- 6 DENI, CREACI
-
- EXEC SQL END DECLARE SECTION
-*......................................................................
-
-
-*
-*...SQL common area
-*
- EXEC SQL INCLUDE SQLCA.FOR
-
-*...Verifies if generic name is the same for all files to be included
-
- DO 10 I=1,ITOTAL-1
- IF (GENAME(I).NE.GENAME(I+1)) THEN
- IF(IDEBFA.GT.2)
- + PRINT *,'FOPUT. Generic name must be the same for all files'
- IRETC = -9999
- RETURN
- ENDIF
- 10 CONTINUE
-
- GENAM2 = GENAME(1)
-
-*... Converts lower to upper case in the generic name
-
- CALL CLTOU (GENAM2)
-
-*... I1, I2, and I3 mark the limits of first 2 parts of generic name
-
- I1 = INDEX (GENAM2, '//')
- I2 = INDEX (GENAM2(I1+2:), '/')
- I3 = INDEX (GENAM2(I1+I2+2:), '/')
- IF ((I1.LE.0).OR.(I2.LE.1).OR.(I3.LE.1)) GOTO 1300
-
-*... Parse generic name and exclude //database/experiment/ prologue
-* (in the tables of an experiment do not contain the database and
-* experiment names)
-
- DBASE = GENAM2(I1+2:I1+I2)
- EXPER = GENAM2(I1+I2+2:I1+I2+I3)
- LEXP = INDEX (EXPER, ' ') - 1
- GENAM2 = GENAM2(I1+I2+I3+2:)
-
- EXEC SQL WHENEVER SQLWARNING GOTO 1100
- EXEC SQL WHENEVER SQLERROR GOTO 1200
-
-*...Locks FATMEN table to avoid parallel writing while reading it
-
- EXEC SQL LOCK TABLE FATMEN IN SHARE MODE
-
-*...Looks for database and experiment in FATMEN table (if doesn't exist,
-*...returns error -9997)
-
- EXEC SQL WHENEVER NOT FOUND GOTO 1300
-
- EXEC SQL SELECT * INTO :DBASE, :EXPER FROM FATMEN
- 1 WHERE DATABASE =:DBASE AND EXPERIMENT =:EXPER
-
-*...Locks all tables to be modified for exclusive access
-
- STMT1 = 'LOCK TABLE GNAMES_' // EXPER(1:LEXP) // ', FILES_' //
- 1 EXPER(1:LEXP) // ', FXV_' // EXPER(1:LEXP) //
- 2 ', VOLUMES_' // EXPER(1:LEXP) // ' IN EXCLUSIVE MODE'
-
- CMD = 'STMT1'
- EXEC SQL EXECUTE IMMEDIATE :STMT1
-
-*...Looks for generic name in GNAMES_ table(if already exists drops
-*...insert step)
-
- EXEC SQL WHENEVER NOT FOUND CONTINUE
-
- STMT2 = 'SELECT GN# FROM GNAMES_' // EXPER(1:LEXP) //
- 1 ' WHERE GNAME = :GENAM2'
-
- CMD = 'STMT2'
- EXEC SQL PREPARE S2 FROM :STMT2
- EXEC SQL DECLARE C2 CURSOR FOR S2
- EXEC SQL OPEN C2 USING :GENAM2
- EXEC SQL FETCH C2 INTO :GNID
-
- OLDGN = .FALSE.
-
- IF(IDEBFA.GT.2)
- + PRINT *,'FOPUT. Return code from select on GNAME = ',SQLERD(3),
- + ' IFLAG = ',IFLAG
-
- IF (SQLERD(3).EQ.0) THEN
-
- IF (IFLAG.EQ.1) THEN
-*... If IFLAG is set, then generic name should exist !
- GOTO 1400
- ELSE
-
-*... If generic name does not exist, takes greatest GN#,
-*... increments by 1 and inserts new row in GNAMES_ table.
-
- STMT3 = 'SELECT MAX(GN#) FROM GNAMES_' // EXPER(1:LEXP)
-
- CMD = 'STMT3'
- EXEC SQL PREPARE S3 FROM :STMT3
- EXEC SQL DECLARE C3 CURSOR FOR S3
- EXEC SQL OPEN C3
- EXEC SQL FETCH C3 INTO :GNID
-
- GNID = GNID + 1
- STMT9 = 'INSERT INTO GNAMES_' // EXPER(1:LEXP)
- 1 // ' (GNAME, GN#) VALUES (:GENAM2, :GNID)'
-
- CMD = 'STMT9'
- EXEC SQL PREPARE S9 FROM :STMT9
- EXEC SQL EXECUTE S9 USING :GENAM2, :GNID
- ENDIF
-
- ELSE
- OLDGN = .TRUE.
- ENDIF
-
-*... Prepares dynamic-defined statements to be used inside the loop
-* (DO 50 J=1,ITOTAL) and declares cursors when necessary (SELECTs)
-
- STMT4 = 'SELECT FILES_' // EXPER(1:LEXP) // '.FILE#' //
- 1 ' FROM VOLUMES_' // EXPER(1:LEXP) // ', FXV_' //
- 2 EXPER(1:LEXP) // ', FILES_' // EXPER(1:LEXP) //
- 3 ' WHERE FILES_' // EXPER(1:LEXP) // '.FILE# = ' //
- 4 'FXV_' // EXPER(1:LEXP) // '.FILE# AND FXV_' //
- 5 EXPER(1:LEXP) //
- 6 '.VOL# = VOLUMES_' // EXPER(1:LEXP) // '.VOL# AND ' //
- 7 'VID = :VI2 AND VSN = :VS2 AND FILESEQ# = :FLSQN2' //
- 8 ' AND MEDIATYPE = :MEDI2' //
- 9 ' AND GN# = :GNID AND ACTIVE = ''Y'''
-
-#if defined(CERNLIB_ORACLE)
- EXEC SQL PREPARE S4 FROM :STMT4
-#endif
-#if defined(CERNLIB_SQLDS)
- EXEC SQL PREPARE S4 FROM :STMT04
-#endif
- EXEC SQL DECLARE C4 CURSOR FOR S4
-
- STMT5 = 'SELECT MAX(FILE#) FROM FILES_' // EXPER(1:LEXP)
-
- EXEC SQL PREPARE S5 FROM :STMT5
- EXEC SQL DECLARE C5 CURSOR FOR S5
-
- STMT6 = 'SELECT VOL# FROM VOLUMES_' // EXPER(1:LEXP) //
- 1 ' WHERE VSN = :VS2 AND VID = :VI2'
-
- EXEC SQL PREPARE S6 FROM :STMT6
- EXEC SQL DECLARE C6 CURSOR FOR S6
-
- STMT7 = 'SELECT MAX(VOL#) FROM VOLUMES_' // EXPER(1:LEXP)
-
- EXEC SQL PREPARE S7 FROM :STMT7
- EXEC SQL DECLARE C7 CURSOR FOR S7
-
- STMT8 = 'SELECT FILE# FROM FILES_' // EXPER(1:LEXP) //
- 1 ' WHERE HOSTNAME = :HNAM2 AND FULLNAME = :FNAM2' //
- 2 ' AND MEDIATYPE = :MEDI2' //
- 3 ' AND GN# = :GNID AND ACTIVE = ''Y'''
-
- EXEC SQL PREPARE S8 FROM :STMT8
- EXEC SQL DECLARE C8 CURSOR FOR S8
-
- STMT10 = 'INSERT INTO FILES_' //
- 1 EXPER(1:LEXP) // ' VALUES (:FILEID,' //
- 2 ' :GNID, :CPLV2, :LOCA2, :HNAM2, :FNAM2,' //
- 3 ' :HTYP2:HTYPI, :OPSY2:OPSYI, :FFORM2,' //
- 4 ' :USRFM2:USRFMI, :SRTRE2:SRTREI, :ENDRE2:ENDREI,' //
- 5 ' :SRTBL2:SRTBLI, :ENDBL2:ENDBLI, :RECFM2:RECFMI,' //
- 6 ' :RECLG2:RECLGI, :BLKLG2:BLKLGI,' //
- 7 ' TO_DATE(:CREDA2:CREDAI,''DD-MON-YY HH24:MI''),' //
- 8 ' TO_DATE(:CATDA2:CATDAI,''DD-MON-YY HH24:MI''),' //
- 9 ' TO_DATE(:ACSDA2:ACSDAI,''DD-MON-YY HH24:MI''),' //
- A ' :ACTIV2, :CRENA2:CRENAI,' //
- B ' :CREAC2:CREACI, :CRENO2:CRENOI, :CREJO2:CREJOI,' //
- C ' :PROTE2:PROTEI, :USRW02:USRW0I, :USRW12:USRW1I,' //
- D ' :USRW22:USRW2I, :USRW32:USRW3I, :USRW42:USRW4I,' //
- E ' :USRW52:USRW5I, :USRW62:USRW6I, :USRW72:USRW7I,' //
- F ' :USRW82:USRW8I, :USRW92:USRW9I, :SYSW02:SYSW0I,' //
- G ' :SYSW12:SYSW1I, :SYSW22:SYSW2I, :SYSW32:SYSW3I,' //
- H ' :SYSW42:SYSW4I, :SYSW52:SYSW5I, :SYSW62:SYSW6I,' //
- I ' :SYSW72:SYSW7I, :SYSW82:SYSW8I, :SYSW92:SYSW9I,' //
- J ' :COMMT2:COMMTI, :MEDI2:MEDII)'
-
-#if defined(CERNLIB_ORACLE)
- EXEC SQL PREPARE S10 FROM :STMT10
-#endif
-#if defined(CERNLIB_SQLDS)
- EXEC SQL PREPARE S10 FROM :STMT0A
-#endif
-
- STMT11 = 'INSERT INTO VOLUMES_' // EXPER(1:LEXP) //
- 1 ' VALUES (:VOLID, :VS2, :VI2, :PRE2:PREI, :DEN2:DENI)'
-
- EXEC SQL PREPARE S11 FROM :STMT11
-
- STMT12 = 'INSERT INTO FXV_' // EXPER(1:LEXP) //
- 1 ' VALUES (:FILEID, :FLSQN2, :VOLID, :VLSQN2:VLSQNI)'
-
- EXEC SQL PREPARE S12 FROM :STMT12
-
- STMT13 = 'UPDATE FILES_' // EXPER(1:LEXP) //
- 1 ' SET GN#=:GNID, COPYLEVEL=:CPLV2, LOCATION=:LOCA2,' //
- 2 ' HOSTNAME=:HNAM2, FULLNAME=:FNAM2,' //
- 3 ' HOSTTYPE=:HTYP2:HTYPI, OPERSYS=:OPSY2:OPSYI,' //
- 4 ' FILEFORMAT=:FFORM2, USERFORMAT=:USRFM2:USRFMI,' //
- 5 ' STARTREC#=:SRTRE2:SRTREI, ENDREC#=:ENDRE2:ENDREI,' //
- 6 ' STARTBLK#=:SRTBL2:SRTBLI, ENDBLK#=:ENDBL2:ENDBLI,' //
- 7 ' RECFORMAT=:RECFM2:RECFMI, RECLENGTH=:RECLG2:RECLGI,' //
- 8 ' BLKLENGTH=:BLKLG2:BLKLGI,' //
- 9 ' CREATION=TO_DATE(:CREDA2:CREDAI,''DD-MON-YY HH24:MI''),' //
- A ' CATALOGATION=TO_DATE(:CATDA2:CATDAI,''DD-MON-YY HH24:MI''),'//
- B ' LASTACCESS=TO_DATE(:ACSDA2:ACSDAI,''DD-MON-YY HH24:MI''),' //
- C ' ACTIVE=:ACTIV2, CREATORNAME=:CRENA2:CRENAI,' //
- D ' CREATORACCOUNT=:CREAC2:CREACI, CREATORNODE=:CRENO2:CRENOI,' //
- E ' CREATORJOB=:CREJO2:CREJOI, PROTECTION=:PROTE2:PROTEI,' //
- F ' USERWORD0=:USRW02:USRW0I, USERWORD1=:USRW12:USRW1I,' //
- G ' USERWORD2=:USRW22:USRW2I, USERWORD3=:USRW32:USRW3I,' //
- H ' USERWORD4=:USRW42:USRW4I, USERWORD5=:USRW52:USRW5I,' //
- I ' USERWORD6=:USRW62:USRW6I, USERWORD7=:USRW72:USRW7I,' //
- J ' USERWORD8=:USRW82:USRW8I, USERWORD9=:USRW92:USRW9I,' //
- K ' SYSWORD0=:SYSW02:SYSW0I, SYSWORD1=:SYSW12:SYSW1I,' //
- L ' SYSWORD2=:SYSW22:SYSW2I, SYSWORD3=:SYSW32:SYSW3I,' //
- M ' SYSWORD4=:SYSW42:SYSW4I, SYSWORD5=:SYSW52:SYSW5I,' //
- N ' SYSWORD6=:SYSW62:SYSW6I, SYSWORD7=:SYSW72:SYSW7I,' //
- O ' SYSWORD8=:SYSW82:SYSW8I, SYSWORD9=:SYSW92:SYSW9I, ' //
- P ' COMMENTS=:COMMT2:COMMTI, MEDIATYPE=:MEDI2:MEDII ' //
- Q ' WHERE FILE#=:FILEID'
-
-#if defined(CERNLIB_ORACLE)
- EXEC SQL PREPARE S13 FROM :STMT13
-#endif
-#if defined(CERNLIB_SQLDS)
- EXEC SQL PREPARE S13 FROM :STMT0D
-#endif
-
- STMT14= 'SELECT FILE# FROM FXV_' // EXPER(1:LEXP) //
- 1 ' WHERE FILE# = :FILEID AND FILESEQ# = :FLSQN2' //
- 2 ' AND VOL# = :VOLID'
-
- EXEC SQL PREPARE S14 FROM :STMT14
- EXEC SQL DECLARE C14 CURSOR FOR S14
-
- STMT15 = 'UPDATE VOLUMES_' // EXPER(1:LEXP) //
- 1 ' SET VIDPREFIX = :PRE2:PREI, DENSITY = :DEN2:DENI' //
- 2 ' WHERE VSN = :VS2 AND VID = :VI2'
-
- EXEC SQL PREPARE S15 FROM :STMT15
-
- STMT16 = 'SELECT FILE# FROM FILES_' // EXPER(1:LEXP) //
- 1 ' WHERE MEDIATYPE = :MEDI2' //
- 2 ' AND GN# = :GNID AND ACTIVE = ''Y'''
-
- EXEC SQL PREPARE S16 FROM :STMT16
- EXEC SQL DECLARE C16 CURSOR FOR S16
-
-*...NB: Stores every array bind variable to be used in SQL statement in
-*... a temporary variable with same name less last char, plus "2"
-*... (PCC precompiler DOES NOT accept arrays elements !)
-
- DO 50 J=1,ITOTAL
-
- MEDI2 = MEDIA(J)
- CALL CLTOU (MEDI2)
- OLDFILE = .FALSE.
-
- IF (MEDI2.EQ.'D') THEN
-
- IF(IDEBFA.GT.2)
- + PRINT *,'FOPUT. Media is disk, check on ',
- + 'HNAME,FNAME,MEDIA and GN#'
-
-*... Assigns values to temporary variables to be used in SELECT
-* of FILES_ table
-
- HNAM2 = HNAME(J)
- CALL CLTOU (HNAM2)
-
- FNAM2 = FNAME(J)
- CALL CLTOU (FNAM2)
-
- CMD = 'STMT8'
- EXEC SQL OPEN C8 USING :HNAM2, :FNAM2, :MEDI2, :GNID
- EXEC SQL FETCH C8 INTO :FILEID
-
- ELSE
-
-*... Assigns values to temporary variables to be used in SELECT
-* (if file on tape, columns to identify it uniquely come from
-* FILES_, FXV_ and VOLUMES_ tables)
-
- IF(IDEBFA.GT.2)
- + PRINT *,'FOPUT. Media is tape, check on ',
- + 'VSN,VID,FSEQ,MEDIA and GN#'
-
-
- VI2 = VID(J)
- CALL CLTOU (VI2)
-
- VS2 = VSN(J)
- CALL CLTOU (VS2)
-
- FLSQN2 = FLSQNO(J)
-
- CMD = 'STMT4'
- EXEC SQL OPEN C4 USING :VI2, :VS2, :FLSQN2,
- 1 :MEDI2, :GNID
- EXEC SQL FETCH C4 INTO :FILEID
-
- ENDIF
-
-*... Non-existence of file entry to be modified is error only
-* if IFLAG is set
-
- IF(IDEBFA.GT.2)
- + PRINT *,'FOPUT. Return code from select on FILE = ',SQLERD(3),
- + ' IFLAG = ',IFLAG
-
- IF (SQLERD(3).NE.0) OLDFILE = .TRUE.
- IF ((.NOT.OLDFILE).AND.(IFLAG.EQ.1)) GOTO 1400
-*
-* If IFLAG = -1, error if file already exists
-*
- IF ((OLDFILE) .AND.(IFLAG.EQ.-1)) GOTO 1500
-
-*... Assigns values to temporary variables to be used in INSERT
-* and UPDATE commands on FILES_, FXV_ and VOLUMES_ tables
-* (PCC does not accept array elements!)
-
- LOCA2 = LOCAT(J)
- CPLV2 = CPLVL(J)
- HNAM2 = HNAME(J)
- CALL CLTOU (HNAM2)
- FNAM2 = FNAME(J)
- CALL CLTOU (FNAM2)
- FFORM2 = FFORMT(J)
- CALL CLTOU (FFORM2)
- ACTIV2 = ACTIVE(J)
- CALL CLTOU (ACTIV2)
-
- HTYP2 = HTYPE(J)
- IF (HTYP2.EQ.' ') THEN
- HTYPI = -1
- ELSE
- CALL CLTOU (HTYP2)
- ENDIF
-
- OPSY2 = OPSYS(J)
- IF (OPSY2.EQ.' ') THEN
- OPSYI = -1
- ELSE
- CALL CLTOU (OPSY2)
- ENDIF
-
- USRFM2 = USRFMT(J)
- IF (USRFM2.EQ.' ') THEN
- USRFMI = -1
- ELSE
- CALL CLTOU (USRFM2)
- ENDIF
-
- SRTRE2 = SRTREC(J)
- IF (SRTRE2.EQ.-1) SRTREI = -1
-
- ENDRE2 = ENDREC(J)
- IF (ENDRE2.EQ.-1) ENDREI = -1
-
- SRTBL2 = SRTBLK(J)
- IF (SRTBL2.EQ.-1) SRTBLI = -1
-
- ENDBL2 = ENDBLK(J)
- IF (ENDBL2.EQ.-1) ENDBLI = -1
-
- RECFM2 = RECFMT(J)
- IF (RECFM2.EQ.' ') THEN
- RECFMI = -1
- ELSE
- CALL CLTOU (RECFM2)
- ENDIF
-
- RECLG2 = RECLGH(J)
- IF (RECLG2.EQ.-1) RECLGI = -1
-
- BLKLG2 = BLKLGH(J)
- IF (BLKLG2.EQ.-1) BLKLGI = -1
-
- CREDA2 = CREDAT(J)
- IF (CREDA2.EQ.' ') THEN
- CREDAI = -1
- ELSE
- CALL CLTOU (CREDA2)
- ENDIF
-
- CATDA2 = CATDAT(J)
- IF (CATDA2.EQ.' ') THEN
- CATDAI = -1
- ELSE
- CALL CLTOU (CATDA2)
- ENDIF
-
- ACSDA2 = ACSDAT(J)
- IF (ACSDA2.EQ.' ') THEN
- ACSDAI = -1
- ELSE
- CALL CLTOU (ACSDA2)
- ENDIF
-
- CRENA2 = CRENAM(J)
- IF (CRENA2.EQ.' ') THEN
- CRENAI = -1
- ELSE
- CALL CLTOU (CRENA2)
- ENDIF
-
- CREAC2 = CREACC(J)
- IF (CREAC2.EQ.' ') THEN
- CREACI = -1
- ELSE
- CALL CLTOU (CREAC2)
- ENDIF
-
- CRENO2 = CRENOD(J)
- IF (CRENO2.EQ.' ') THEN
- CRENOI = -1
- ELSE
- CALL CLTOU (CRENO2)
- ENDIF
-
- CREJO2 = CREJOB(J)
- IF (CREJO2.EQ.' ') THEN
- CREJOI = -1
- ELSE
- CALL CLTOU (CREJO2)
- ENDIF
-
- PROTE2 = PROTEC(J)
- IF (PROTE2.EQ.-1) PROTEI = -1
-
- USRW02 = USRWD0(J)
- IF (USRW02.EQ.-1) USRW0I = -1
-
- USRW12 = USRWD1(J)
- IF (USRW12.EQ.-1) USRW1I = -1
-
- USRW22 = USRWD2(J)
- IF (USRW22.EQ.-1) USRW2I = -1
-
- USRW32 = USRWD3(J)
- IF (USRW32.EQ.-1) USRW3I = -1
-
- USRW42 = USRWD4(J)
- IF (USRW42.EQ.-1) USRW4I = -1
-
- USRW52 = USRWD5(J)
- IF (USRW52.EQ.-1) USRW5I = -1
-
- USRW62 = USRWD6(J)
- IF (USRW62.EQ.-1) USRW6I = -1
-
- USRW72 = USRWD7(J)
- IF (USRW72.EQ.-1) USRW7I = -1
-
- USRW82 = USRWD8(J)
- IF (USRW82.EQ.-1) USRW8I = -1
-
- USRW92 = USRWD9(J)
- IF (USRW92.EQ.-1) USRW9I = -1
-
- SYSW02 = SYSWD0(J)
- IF (SYSW02.EQ.-1) SYSW0I = -1
-
- SYSW12 = SYSWD1(J)
- IF (SYSW12.EQ.-1) SYSW1I = -1
-
- SYSW22 = SYSWD2(J)
- IF (SYSW22.EQ.-1) SYSW2I = -1
-
- SYSW32 = SYSWD3(J)
- IF (SYSW32.EQ.-1) SYSW3I = -1
-
- SYSW42 = SYSWD4(J)
- IF (SYSW42.EQ.-1) SYSW4I = -1
-
- SYSW52 = SYSWD5(J)
- IF (SYSW52.EQ.-1) SYSW5I = -1
-
- SYSW62 = SYSWD6(J)
- IF (SYSW62.EQ.-1) SYSW6I = -1
-
- SYSW72 = SYSWD7(J)
- IF (SYSW72.EQ.-1) SYSW7I = -1
-
- SYSW82 = SYSWD8(J)
- IF (SYSW82.EQ.-1) SYSW8I = -1
-
- SYSW92 = SYSWD9(J)
- IF (SYSW92.EQ.-1) SYSW9I = -1
-
- COMMT2 = COMMTS(J)
- IF (COMMT2.EQ.' ') THEN
- COMMTI = -1
- ELSE
- CALL CLTOU (COMMT2)
- ENDIF
-
- IF (MEDI2.NE.'D') THEN
-
-*... Assigns values to temporary vars to be used in INSERT/
-* UPDATE in FILES_, VOLUMES_ tables
-
- PRE2 = PREF(J)
- IF (PRE2.EQ.-1) PREI = -1
-
- DEN2 = DENS(J)
- IF (DEN2.EQ.-1) DENI = -1
-
-*... Assigns values to temporary vars to be used in INSERT
-* UPDATE FXV_ table (always insert, because FILEID is new)
-
- FLSQN2 = FLSQNO(J)
-
- VLSQN2 = VLSQNO(J)
- IF (VLSQN2.EQ.-1) VLSQNI = -1
-
- ENDIF
-
- IF (OLDFILE.AND.OLDGN) THEN
-
-*... Generic name and file already exist, so perform an UPDATE
-
- IF(IDEBFA.GT.2) PRINT *,'FOPUT. Updating existing entry.'
-
- CMD = 'STMT13'
- EXEC SQL EXECUTE S13 USING
- 1 :GNID, :CPLV2, :LOCA2, :HNAM2, :FNAM2,
- 2 :HTYP2:HTYPI, :OPSY2:OPSYI, :FFORM2,
- 3 :USRFM2:USRFMI, :SRTRE2:SRTREI, :ENDRE2:ENDREI,
- 4 :SRTBL2:SRTBLI, :ENDBL2:ENDBLI, :RECFM2:RECFMI,
- 5 :RECLG2:RECLGI, :BLKLG2:BLKLGI,
- 6 :CREDA2:CREDAI, :CATDA2:CATDAI,
- 7 :ACSDA2:ACSDAI, :ACTIV2, :CRENA2:CRENAI,
- 8 :CREAC2:CREACI, :CRENO2:CRENOI, :CREJO2:CREJOI,
- 9 :PROTE2:PROTEI, :USRW02:USRW0I, :USRW12:USRW1I,
- A :USRW22:USRW2I, :USRW32:USRW3I, :USRW42:USRW4I,
- B :USRW52:USRW5I, :USRW62:USRW6I, :USRW72:USRW7I,
- C :USRW82:USRW8I, :USRW92:USRW9I, :SYSW02:SYSW0I,
- D :SYSW12:SYSW1I, :SYSW22:SYSW2I, :SYSW32:SYSW3I,
- E :SYSW42:SYSW4I, :SYSW52:SYSW5I, :SYSW62:SYSW6I,
- F :SYSW72:SYSW7I, :SYSW82:SYSW8I, :SYSW92:SYSW9I,
- G :COMMT2:COMMTI, :MEDI2:MEDII, :FILEID
-
-*... Modify also VOLUMES_ if tape file (new prefix or density)
-
- IF (MEDI2.NE.'D') THEN
- CMD = 'STMT15'
- EXEC SQL EXECUTE S15 USING :PRE2:PREI,
- 1 :DEN2:DENI, :VS2, :VI2
- ENDIF
-
- ELSE
-
-*... There is a new generic name (new GNID) or a new file (new
-* FILEID), or both, but the former was already included
-
- IF (.NOT.OLDFILE) THEN
-
- IF (MEDI2.EQ.'D') THEN
-
-*... Disk file not in FILES_ table. Gets greatest
-* FILE#, increments by 1 to be key of new row
-
- CMD = 'STMT5'
- EXEC SQL OPEN C5
- EXEC SQL FETCH C5 INTO :FILEID
- FILEID = FILEID + 1
-
- CMD = 'STMT10'
- EXEC SQL EXECUTE S10 USING :FILEID,
- 1 :GNID, :CPLV2, :LOCA2, :HNAM2, :FNAM2,
- 2 :HTYP2:HTYPI, :OPSY2:OPSYI, :FFORM2,
- 3 :USRFM2:USRFMI, :SRTRE2:SRTREI, :ENDRE2:ENDREI,
- 4 :SRTBL2:SRTBLI, :ENDBL2:ENDBLI, :RECFM2:RECFMI,
- 5 :RECLG2:RECLGI, :BLKLG2:BLKLGI,
- 6 :CREDA2:CREDAI, :CATDA2:CATDAI,
- 7 :ACSDA2:ACSDAI, :ACTIV2, :CRENA2:CRENAI,
- 8 :CREAC2:CREACI, :CRENO2:CRENOI, :CREJO2:CREJOI,
- 9 :PROTE2:PROTEI, :USRW02:USRW0I, :USRW12:USRW1I,
- A :USRW22:USRW2I, :USRW32:USRW3I, :USRW42:USRW4I,
- B :USRW52:USRW5I, :USRW62:USRW6I, :USRW72:USRW7I,
- C :USRW82:USRW8I, :USRW92:USRW9I, :SYSW02:SYSW0I,
- D :SYSW12:SYSW1I, :SYSW22:SYSW2I, :SYSW32:SYSW3I,
- E :SYSW42:SYSW4I, :SYSW52:SYSW5I, :SYSW62:SYSW6I,
- F :SYSW72:SYSW7I, :SYSW82:SYSW8I, :SYSW92:SYSW9I,
- G :COMMT2:COMMTI, :MEDI2:MEDII
-
- ELSE
-
-*... If it is a tape file, maybe FILES_ entry is already
-* there (check without considering tape attributes)
-
- CMD = 'STMT16'
- EXEC SQL OPEN C16 USING :MEDI2, :GNID
- EXEC SQL FETCH C16 INTO :FILEID
-
- IF (SQLERD(3).EQ.0) THEN
-
-*... Tape file not in FILES_ table. Gets greatest
-* FILE#, increments by 1 to be key of new row
-
- CMD = 'STMT5'
- EXEC SQL OPEN C5
- EXEC SQL FETCH C5 INTO :FILEID
-
- FILEID = FILEID + 1
-
- CMD = 'STMT10'
- EXEC SQL EXECUTE S10 USING :FILEID,
- 1 :GNID, :CPLV2, :LOCA2, :HNAM2, :FNAM2,
- 2 :HTYP2:HTYPI, :OPSY2:OPSYI, :FFORM2,
- 3 :USRFM2:USRFMI, :SRTRE2:SRTREI, :ENDRE2:ENDREI,
- 4 :SRTBL2:SRTBLI, :ENDBL2:ENDBLI, :RECFM2:RECFMI,
- 5 :RECLG2:RECLGI, :BLKLG2:BLKLGI,
- 6 :CREDA2:CREDAI, :CATDA2:CATDAI,
- 7 :ACSDA2:ACSDAI, :ACTIV2, :CRENA2:CRENAI,
- 8 :CREAC2:CREACI, :CRENO2:CRENOI, :CREJO2:CREJOI,
- 9 :PROTE2:PROTEI, :USRW02:USRW0I, :USRW12:USRW1I,
- A :USRW22:USRW2I, :USRW32:USRW3I, :USRW42:USRW4I,
- B :USRW52:USRW5I, :USRW62:USRW6I, :USRW72:USRW7I,
- C :USRW82:USRW8I, :USRW92:USRW9I, :SYSW02:SYSW0I,
- D :SYSW12:SYSW1I, :SYSW22:SYSW2I, :SYSW32:SYSW3I,
- E :SYSW42:SYSW4I, :SYSW52:SYSW5I, :SYSW62:SYSW6I,
- F :SYSW72:SYSW7I, :SYSW82:SYSW8I, :SYSW92:SYSW9I,
- G :COMMT2:COMMTI, :MEDI2:MEDII
-
- ENDIF
-
-*... Check if VOLUMES_ and FXV_ entries already exist and
-* insert if not
-
- CMD = 'STMT6'
- EXEC SQL OPEN C6 USING :VS2, :VI2
- EXEC SQL FETCH C6 INTO :VOLID
-
- IF (SQLERD(3).EQ.0) THEN
- CMD = 'STMT7'
- EXEC SQL OPEN C7
- EXEC SQL FETCH C7 INTO :VOLID
- VOLID = VOLID + 1
-
- CMD = 'STMT11'
- EXEC SQL EXECUTE S11 USING :VOLID, :VS2, :VI2,
- 1 :PRE2:PREI, :DEN2:DENI
- ENDIF
-
- CMD = 'STMT14'
- EXEC SQL OPEN C14 USING :FILEID, :FLSQN2, :VOLID
- EXEC SQL FETCH C14 INTO :FILEID
-
- IF (SQLERD(3).EQ.0) THEN
- CMD = 'STMT12'
- EXEC SQL EXECUTE S12 USING :FILEID, :FLSQN2,
- 1 :VOLID, :VLSQN2:VLSQNI
- ENDIF
-
- ENDIF
-
- ENDIF
-
- ENDIF
-
- 50 CONTINUE
-
- EXEC SQL COMMIT WORK
-
- RETURN
-
- 1100 CONTINUE
- WRITE (6,1110) CMD, SQLWN1, SQLWN2, SQLWN3, SQLWN4, SQLWN5,
- 2 SQLWN6, SQLWN7
- IRETC = -9998
- EXEC SQL WHENEVER SQLWARNING CONTINUE
- EXEC SQL ROLLBACK WORK
- RETURN
-
- 1200 CONTINUE
- WRITE (6,1210) CMD, SQLCDE, (SQLEMC(J), J=1,70)
- IRETC = SQLCDE
- EXEC SQL WHENEVER SQLERROR CONTINUE
- EXEC SQL ROLLBACK WORK
- RETURN
-
- 1300 CONTINUE
- WRITE (6,1310) DBASE,EXPER
- IRETC = -9997
- EXEC SQL ROLLBACK WORK
- RETURN
-
- 1400 CONTINUE
- WRITE (6,1410) J
- IRETC = -9996
- ITOTAL = J
- EXEC SQL ROLLBACK WORK
- RETURN
-
- 1500 CONTINUE
- WRITE (6,1510) J
- IRETC = -9995
- ITOTAL = J
- EXEC SQL ROLLBACK WORK
- RETURN
-
- 1110 FORMAT (/, ' SQL WARNING ON ', A6, '. SQLWN_ INDICATORS: ',
- 1 7('"',A1,'"',2X))
- 1210 FORMAT (/, ' SQL ERROR ON ', A6, ': ', I5, ' ', 70A1)
- 1310 FORMAT (/, ' ERROR: UNKNOWN DATABASE AND EXPERIMENT',A,1X,A)
- 1410 FORMAT (/, ' ERROR: GENERIC NAME AND FILE (TUPLE ', I2,
- 2 ') DO NOT EXIST')
- 1510 FORMAT (/, ' ERROR: generic name and file (TUPLE ', I2,
- 2 ') already exist, will not be replaced')
- END
-
-#if defined(CERNLIB_SQLDS)
- BLOCKDATA
-* For FODEL
- COMMON/STMT04/LSTMT4,STMT4
- CHARACTER*400 STMT4
- INTEGER*4 LSTMT4/400/
-* For FOGET
- COMMON/STMT02/LSTMT2,STMT2
- CHARACTER*2000 STMT2
- INTEGER*2 LSTMT2/2000/
-* For FOPUT
- COMMON/STMT40/LSTMT40,STMT4X
- CHARACTER*300 STMT4X
- INTEGER*2 LSTMT40/300/
- COMMON/STMT0A/LSTMT10,STMT10
- CHARACTER*1300 STMT10
- INTEGER*2 LSTMT10/1300/
- COMMON/STMT0A/LSTMT13,STMT13
- CHARACTER*1500 STMT13
- INTEGER*2 LSTMT13/1500/
- END
-#endif
diff --git a/src/packlib/fatmen/programs/sqlcom/fofile.inc b/src/packlib/fatmen/programs/sqlcom/fofile.inc
deleted file mode 100644
index 3dd34a5..0000000
--- a/src/packlib/fatmen/programs/sqlcom/fofile.inc
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: fofile.inc,v 1.1.1.1 1996/03/07 15:17:49 mclareni Exp $
-*
-* $Log: fofile.inc,v $
-* Revision 1.1.1.1 1996/03/07 15:17:49 mclareni
-* Fatmen
-*
-*
-* Common block definition
-*
-* fofile.inc
-*
-
-*... Labelled COMMON to interface with calling module
-
- COMMON /FOFILE/ GENAME, CPLVL, LOCAT, HNAME, FNAME, HTYPE,
- 1 OPSYS, FFORMT, USRFMT, SRTREC, ENDREC, SRTBLK,
- 2 ENDBLK, RECFMT, RECLGH, BLKLGH, CREDAT, CATDAT,
- 3 ACSDAT, ACTIVE, CRENAM, CREACC, CRENOD, CREJOB,
- 4 PROTEC, USRWD0, USRWD1, USRWD2, USRWD3, USRWD4,
- 5 USRWD5, USRWD6, USRWD7, USRWD8, USRWD9, SYSWD0,
- 6 SYSWD1, SYSWD2, SYSWD3, SYSWD4, SYSWD5, SYSWD6,
- 7 SYSWD7, SYSWD8, SYSWD9, COMMTS, MEDIA, FLSQNO,
- 8 VLSQNO, VSN, VID, PREF, DENS
-
diff --git a/src/packlib/fatmen/programs/sqlcom/fofilex.inc b/src/packlib/fatmen/programs/sqlcom/fofilex.inc
deleted file mode 100644
index bd33584..0000000
--- a/src/packlib/fatmen/programs/sqlcom/fofilex.inc
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: fofilex.inc,v 1.1.1.1 1996/03/07 15:17:49 mclareni Exp $
-*
-* $Log: fofilex.inc,v $
-* Revision 1.1.1.1 1996/03/07 15:17:49 mclareni
-* Fatmen
-*
-*
-* Common block definition
-*
-* fofilex.inc
-*
-
-*... Labelled COMMON to interface with calling module
-
- COMMON /FOFILE_/GENAME, CPLVL, LOCAT, HNAME, FNAME, HTYPE,
- 1 OPSYS, FFORMT, USRFMT, SRTREC, ENDREC, SRTBLK,
- 2 ENDBLK, RECFMT, RECLGH, BLKLGH, CREDAT, CATDAT,
- 3 ACSDAT, ACTIVE, CRENAM, CREACC, CRENOD, CREJOB,
- 4 PROTEC, USRWD0, USRWD1, USRWD2, USRWD3, USRWD4,
- 5 USRWD5, USRWD6, USRWD7, USRWD8, USRWD9, SYSWD0,
- 6 SYSWD1, SYSWD2, SYSWD3, SYSWD4, SYSWD5, SYSWD6,
- 7 SYSWD7, SYSWD8, SYSWD9, COMMTS, MEDIA, FLSQNO,
- 8 VLSQNO, VSN, VID, PREF, DENS
-
diff --git a/src/packlib/fatmen/programs/sqlcom/fovars.inc b/src/packlib/fatmen/programs/sqlcom/fovars.inc
deleted file mode 100644
index 8876f54..0000000
--- a/src/packlib/fatmen/programs/sqlcom/fovars.inc
+++ /dev/null
@@ -1,39 +0,0 @@
-*
-* $Id: fovars.inc,v 1.1.1.1 1996/03/07 15:17:49 mclareni Exp $
-*
-* $Log: fovars.inc,v $
-* Revision 1.1.1.1 1996/03/07 15:17:49 mclareni
-* Fatmen
-*
-*
-* Common variables definition (separated because of PCC)
-*
-* fovars.inc
-*
-
-*... Host variables for GNAME_ table
-
- CHARACTER*240 GENAME(50)
-
-*... Host variables for FILES_ table
-
- INTEGER CPLVL(50), LOCAT(50), SRTREC(50), ENDREC(50),
- 1 SRTBLK(50), ENDBLK(50), RECLGH(50), BLKLGH(50),
- 2 PROTEC(50), USRWD0(50), USRWD1(50), USRWD2(50),
- 3 USRWD3(50), USRWD4(50), USRWD5(50), USRWD6(50),
- 4 USRWD7(50), USRWD8(50), USRWD9(50), SYSWD0(50),
- 5 SYSWD1(50), SYSWD2(50), SYSWD3(50), SYSWD4(50),
- 6 SYSWD5(50), SYSWD6(50), SYSWD7(50), SYSWD8(50),
- 7 SYSWD9(50), FLSQNO(50), VLSQNO(50)
-
- CHARACTER HNAME(50)*8, FNAME(50)*240,HTYPE(50)*16, OPSYS(50)*12,
- 1 FFORMT(50)*4, USRFMT(50)*4, RECFMT(50)*4, CREDAT(50)*15,
- 2 CATDAT(50)*15,ACSDAT(50)*15,CRENAM(50)*8, CREACC(50)*8,
- 3 CRENOD(50)*8, CREJOB(50)*8, COMMTS(50)*80,MEDIA(50)*1,
- 4 ACTIVE(50)*1
-
-*... Host variables for GNAME_ table
-
- INTEGER PREF(50), DENS(50)
- CHARACTER VID(50)*6, VSN(50)*6
-
diff --git a/src/packlib/fatmen/programs/sqlint/Imakefile b/src/packlib/fatmen/programs/sqlint/Imakefile
deleted file mode 100644
index 853f977..0000000
--- a/src/packlib/fatmen/programs/sqlint/Imakefile
+++ /dev/null
@@ -1,3 +0,0 @@
-SRCS_F= cltou.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/fatmen/programs/sqlint/cltou.F b/src/packlib/fatmen/programs/sqlint/cltou.F
deleted file mode 100644
index 6d5350e..0000000
--- a/src/packlib/fatmen/programs/sqlint/cltou.F
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: cltou.F,v 1.1.1.1 1996/03/07 15:17:49 mclareni Exp $
-*
-* $Log: cltou.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:49 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
-#if defined(CERNLIB_QX_SC)
- SUBROUTINE CLTOU(CHSTR)
-*CMZ : 29/04/91 17.34.54 by Jamie Shiers
-*-- Author : Jamie Shiers 29/04/91
-*
-* Needed because CERNLIB compiled with -qextname (RS6000)
-* but ORACLE libraries are compiled without this
-* option. (FATMEN<->ORACLE interface routines must
-* therefore be compiled without -qextname)
-*
-* HP/UX : no +ppu
-*
- CHARACTER*(*) CHSTR
- CALL CLTOU_(CHSTR)
- END
-#endif
diff --git a/src/packlib/fatmen/programs/stgserv/Imakefile b/src/packlib/fatmen/programs/stgserv/Imakefile
deleted file mode 100644
index 350dfbc..0000000
--- a/src/packlib/fatmen/programs/stgserv/Imakefile
+++ /dev/null
@@ -1,3 +0,0 @@
-SRCS_F= stgserv.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/fatmen/programs/stgserv/stgserv.F b/src/packlib/fatmen/programs/stgserv/stgserv.F
deleted file mode 100644
index 4e52462..0000000
--- a/src/packlib/fatmen/programs/stgserv/stgserv.F
+++ /dev/null
@@ -1,127 +0,0 @@
-*
-* $Id: stgserv.F,v 1.1.1.1 1996/03/07 15:17:47 mclareni Exp $
-*
-* $Log: stgserv.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:47 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
-********************************************************************************
-* Program STAGE_SERVER *
-* -------------------- *
-* J.D. Shiers CERN/CN/AS 1992 *
-* *
-* Modification log: *
-* ----------------- *
-* *
-* 11/06/92 - add LOOK command : call FMLOOK to see if a given tape is in use *
-* *
-* *
-********************************************************************************
- implicit integer (s)
- character*80 chact,chent
- character*255 chfile,chgen,chcomm,chmess,jobnam
-*
-* Get unit for network connection
-*
- status = lib$get_lun(lun)
- if (.not. status) call lib$signal(%val(status))
-*
-* Open network connection
-*
- open(unit=lun,file='SYS$NET',status='old')
-*
-* Read action: either SUBMIT, QUERY or LOOK
-* In case of QUERY, the job entry number is also supplied
-*
- read(lun,'(A)',end=99,err=99) chact
-
- if(chact(1:5).eq.'QUERY') then
-*
-* Get job entry number
-*
- read(lun,'(A)',end=99,err=99) chent
- lchent = lenocc(chent)
- jobnum = icdeci(chent,1,lchent)
- print *,'STGSERV. stage query command received for job ',
- + chent(1:lchent)
- call fastgq(jobnum,chmess,irc)
-*
-* and send back status
-*
- lmess = lenocc(chmess)
- write(lun,'(A)') chmess(1:lmess)
- write(lun,'(A)') ' '
- print *,'STGSERV. job status = ',chmess(1:lmess)
- goto 99
- elseif(chact(1:4).eq.'LOOK') then
-*
-* Read tape parameters
-*
- read(lun,'(A)',end=99,err=99) chfile
- lfile = lenocc(chfile)
-*
-* Read generic device type
-*
- read(lun,'(A)',end=99,err=99) chgen
- lgen = lenocc(chgen)
-*
-* Look to see if their is a job accessing this tape
-* (Look in all STAGE batch queues as some devices, e.g.
-* 8500, can read also 8200 tapes)
-*
- call fmlook(chfile(1:lfile),'*STAGE*',jobnam,jobnum)
-*
-* Send back the job entry number (0=no such job)
-*
- call fmitoc(jobnum,chmess,lmess)
- write(lun,'(A)') chmess(1:lmess)
- write(lun,'(A)') jobnam(1:lenocc(jobnam))
- print *,'STGSERV. job number = ',chmess(1:lmess)
- goto 99
-
- elseif(chact(1:5).eq.'STAGE') then
-*
-* Read tape parameters
-*
- read(lun,'(A)',end=99,err=99) chfile
- lfile = lenocc(chfile)
-*
-* Read generic device type
-*
- read(lun,'(A)',end=99,err=99) chgen
- lgen = lenocc(chgen)
-*
-* Read stage command
-*
- read(lun,'(A)',end=99,err=99) chcomm
- lcomm = lenocc(chcomm)
-
- print *,'STGSERV. stage submit command received - ',
- + chcomm(1:lcomm)
- print *,'STGSERV. generic device type = ',chgen(1:lgen),
- + ' log file name (directory STAGE_LOGS:) = ',chfile(1:lfile)
-
- call fastgs(chfile(1:lfile),chgen(1:lgen),chcomm(1:lcomm),
- + jobnum,chmess,irc)
- endif
-*
-* Send back status information
-*
- if(jobnum.ge.0) then
- call fmitoc(jobnum,chmess,lmess)
- else
- lmess = lenocc(chmess)
- endif
-
- write(lun,'(A)') chmess(1:lmess)
- write(lun,'(A)') ' '
-
- print *,'STGSERV. status from job submission = ',chmess(1:lmess)
-
-99 continue
-
- call sys$exit(%val(1))
-
- end
diff --git a/src/packlib/fatmen/scripts/dcl/fat2vm.dat b/src/packlib/fatmen/scripts/dcl/fat2vm.dat
deleted file mode 100644
index 1200103..0000000
--- a/src/packlib/fatmen/scripts/dcl/fat2vm.dat
+++ /dev/null
@@ -1,47 +0,0 @@
-*
-* $Id: fat2vm.dat,v 1.1.1.1 1996/03/07 15:17:49 mclareni Exp $
-*
-* $Log: fat2vm.dat,v $
-* Revision 1.1.1.1 1996/03/07 15:17:49 mclareni
-* Fatmen
-*
-*
-$!DECK ID>, FAT2VM.COM
-$SET NOON
-$ !
-$ ! Retry sending updates to VM
-$ !
-$ if p1 .eqs. "" then exit
-$ fatmen = p1
-$ count = 0
-$ save_mess = f$environment("MESSAGE")
-$ set message/nofacility/noseverity/noid/notext
-$ node = f$getsyi("NODENAME")
-$loop:
-$ fatman = f$element(count,",",fatmen)
-$ if fatman .eqs. "," then goto end
-$ count = count + 1
-$ write sys$output "Processing ''fatman'..."
-$ ON WARNING THEN GOTO UNDEFINED
-$ fatdir = &fatman
-$ fatfil = f$extract(0,f$length(fatdir)-1,fatdir) + ".TOVM]*.*;*"
-$ ON WARNING THEN CONTINUE
-$ loop$f:
-$ current_file = f$search(fatfil)
-$ if current_file .eqs. "" then goto loop
-$ write sys$output "Processing ''current_file'..."
-$ if f$locate(fatvm,current_file).lt.f$length(current_file)
-$ then
-$ delete/nolog/noconfirm 'current_file'
-$ goto loop$f
-$ endif
-$ copy/log 'current_file' -
-cernvm::"rscs$''fatvm':[''fatman']''fatman'.''node'"
-$ if $severity .eq. 1 then delete/nolog/noconfirm 'current_file'
-$ goto loop$f
-$ undefined:
-$ write sys$output "Warning: symbol ''fatman' is not defined"
-$ goto loop
-$ end:
-$ set message 'save_mess'
-$ exit
diff --git a/src/packlib/fatmen/scripts/dcl/fatabend.dat b/src/packlib/fatmen/scripts/dcl/fatabend.dat
deleted file mode 100644
index 89a1132..0000000
--- a/src/packlib/fatmen/scripts/dcl/fatabend.dat
+++ /dev/null
@@ -1,11 +0,0 @@
-*
-* $Id: fatabend.dat,v 1.1.1.1 1996/03/07 15:17:50 mclareni Exp $
-*
-* $Log: fatabend.dat,v $
-* Revision 1.1.1.1 1996/03/07 15:17:50 mclareni
-* Fatmen
-*
-*
-$!DECK ID>, FATABEND.COM
-$SET NOON
-$MAIL/SUBJECT="FATMEN server abending" _NL: VXCERN::JAMIE
diff --git a/src/packlib/fatmen/scripts/dcl/fatcheck.dat b/src/packlib/fatmen/scripts/dcl/fatcheck.dat
deleted file mode 100644
index ee9041c..0000000
--- a/src/packlib/fatmen/scripts/dcl/fatcheck.dat
+++ /dev/null
@@ -1,77 +0,0 @@
-*
-* $Id: fatcheck.dat,v 1.1.1.1 1996/03/07 15:17:49 mclareni Exp $
-*
-* $Log: fatcheck.dat,v $
-* Revision 1.1.1.1 1996/03/07 15:17:49 mclareni
-* Fatmen
-*
-*
-$!DECK ID>, FATCHECK.COM
-$SET NOON
-$ !
-$ ! Check that FATMEN servers are started
-$ !
-$ if p1 .eqs. "" then exit
-$ fatmen = p1
-$ count = 0
-$ save_mess = f$environment("MESSAGE")
-$ set message/nofacility/noseverity/noid/notext
-$ bqname = f$trnlnm("SYS$FATMEN")
-$ if bqname .eqs. "" then bqname = "SYS$FATMEN"
-$ !
-$ ! Check that the queue is started
-$ !
-$ if f$getqui("DISPLAY_QUEUE","QUEUE_STOPPED",bqname) .eqs. "TRUE" then -
- start/queue 'bqname'
-$loop:
-$ fatman = f$element(count,",",fatmen)
-$ if fatman .eqs. "," then goto end
-$ count = count + 1
-$ write sys$output "Processing ''fatman'..."
-$ show user/nooutput 'fatman'
-$ if $severity .ne. 1
-$ then
-$ !
-$ ! Check that server has not been stopped
-$ !
-$ ON WARNING THEN GOTO UNDEFINED
-$ fatdir = &fatman
-$ ON WARNING THEN CONTINUE
-$ fatdir = f$extract(0,f$length(fatdir)-1,fatdir) + ".TODO]SIGNAL.STOP"
-$ if f$search(fatdir) .nes. ""
-$ then write sys$output "Signal.Stop file found - will not restart"
-$ goto loop
-$ endif
-$ !
-$ ! Check that there is not already a job pending (or otherwise)
-$ ! for this user
-$ !
-$ TEMP = F$GETQUI("")
-$ QLOOP:
-$ QNAME = F$GETQUI("DISPLAY_QUEUE","QUEUE_NAME","*")
-$ IF QNAME .EQS. "" THEN goto loop
-$ IF QNAME .NES. bqname then goto qloop
-$ WRITE SYS$OUTPUT ""
-$ WRITE SYS$OUTPUT "QUEUE: ", QNAME
-$ JLOOP:
-$ NOACCESS = F$GETQUI("DISPLAY_JOB","JOB_INACCESSIBLE",,"ALL_JOBS")
-$ IF NOACCESS .EQS. "TRUE" THEN GOTO JLOOP
-$ IF NOACCESS .EQS. "" THEN GOTO QLOOP
-$ JNAME = F$GETQUI("DISPLAY_JOB","JOB_NAME",,"FREEZE_CONTEXT,ALL_JOBS")
-$ UNAME = F$GETQUI("DISPLAY_JOB","USERNAME",,"FREEZE_CONTEXT,ALL_JOBS")
-$ JID = F$GETQUI("DISPLAY_JOB","ENTRY_NUMBER",,"FREEZE_CONTEXT,ALL_JOBS")
-$ WRITE SYS$OUTPUT "JOB: ", JNAME," ENTRY: ",JID," USER: ",UNAME
-$ if uname .eqs. fatman then goto loop
-$ goto jloop
-$ !
-$ ! No job found - restart
-$ !
-$ write sys$output "Restarting server ..."
-$ fatserv = &fatman + "FATSERV.COM"
-$ submit/queue='bqname'/user='fatman' /id 'fatserv'
-$ endif
-$ goto loop
-$ undefined:$ write sys$output "Warning: symbol ''fatman' is not defined"
-$ goto loop
-$ end:
-$ exit
diff --git a/src/packlib/fatmen/scripts/dcl/fatlib.dat b/src/packlib/fatmen/scripts/dcl/fatlib.dat
deleted file mode 100644
index bef1afd..0000000
--- a/src/packlib/fatmen/scripts/dcl/fatlib.dat
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: fatlib.dat,v 1.1.1.1 1996/03/07 15:17:49 mclareni Exp $
-*
-* $Log: fatlib.dat,v $
-* Revision 1.1.1.1 1996/03/07 15:17:49 mclareni
-* Fatmen
-*
-*
-$!DECK ID>, FATLIB.COM
-$ypatchy cern:[pro.src.car]zebra.car fmint.for :go <<!
-&use,qcde.
-&use,vaxvms,*fatlib.
-&use,tms,t=inhibit.
-&exe.
-&pam,11,r=qcde,t=c.
-&pam,12,t=c,a. fatmen.cards
-&quit
-$for fmint.for
diff --git a/src/packlib/fatmen/scripts/dcl/fatmast.dat b/src/packlib/fatmen/scripts/dcl/fatmast.dat
deleted file mode 100644
index bb65820..0000000
--- a/src/packlib/fatmen/scripts/dcl/fatmast.dat
+++ /dev/null
@@ -1,62 +0,0 @@
-*
-* $Id: fatmast.dat,v 1.1.1.1 1996/03/07 15:17:49 mclareni Exp $
-*
-* $Log: fatmast.dat,v $
-* Revision 1.1.1.1 1996/03/07 15:17:49 mclareni
-* Fatmen
-*
-*
-$!DECK ID>, FATMAST.COM
-$SET NOON
-$ !
-$ ! Master FATMEN command file
-$ !
-$ ! define list of servers
-$ !
-$ if f$trnlnm("SYS$CLUSTER_NODE").eqs."VXCERN"
-$ then
-$ fatmen = "FMDELPHI,FMNA44,FMCHORUS" ! Separate by commas
-$ fmdelphi:==disk$delphi1:[fmdelphi]
-$ fmna44 :==disk$mf:[fmna44]
-$ fmchorus:==disk$mf:[fmchorus]
-$ fatvm :== CERNVM ! Tailor for other nodes
-$ else
-$ endif
-$ !
-$ if f$type(fatmen).eqs.""
-$ then
-$ write sys$output "Check configuration - FATMEN symbol(s) not defined"
-$ exit
-$ endif
-$ !
-$ fmwakeup :== 00:30:00 ! Every 30 minutes
-$ !
-$ save_mess = f$environment("MESSAGE")
-$ set message/nofacility/noseverity/noid/notext
-$ write sys$output "FATMAST starting at ''f$time()'"
-$ !
-$ ! Ensure that FATMEN queue is started
-$ !
-$ if f$getqui("DISPLAY_QUEUE","QUEUE_STOPPED","SYS$FATMEN") .eqs. "TRUE" then -
-start/queue sys$fatmen
-$ again:
-$ !
-$ ! Run the command files that expect a complete list as argument
-$ !
-$ write sys$output ">>> FATPURGE..."
-$ @CERN_ROOT:[EXE]FATPURGE 'fatmen' ! Purge old journal files
-$ !
-$ write sys$output ">>> FATCHECK..."
-$ @CERN_ROOT:[EXE]FATCHECK 'fatmen' ! Check that servers are started
-$ !
-$ write sys$output ">>> FAT2VM..."
-$ @CERN_ROOT:[EXE]FAT2VM 'fatmen' ! Retry transmission to 'FATVM'
-$ !
-$ write sys$output ">>> FATRL..."
-$ @CERN_ROOT:[EXE]FATRL 'fatmen' ! Copy new updates from 'RDR'...
-$ !
-$ write sys$output ">>> waiting ''fmwakeup'..."
-$ wait 'fmwakeup'
-$ goto again
-$ set message 'save_mess'
-$ exit
diff --git a/src/packlib/fatmen/scripts/dcl/fatpurge.dat b/src/packlib/fatmen/scripts/dcl/fatpurge.dat
deleted file mode 100644
index 2e75680..0000000
--- a/src/packlib/fatmen/scripts/dcl/fatpurge.dat
+++ /dev/null
@@ -1,35 +0,0 @@
-*
-* $Id: fatpurge.dat,v 1.1.1.1 1996/03/07 15:17:49 mclareni Exp $
-*
-* $Log: fatpurge.dat,v $
-* Revision 1.1.1.1 1996/03/07 15:17:49 mclareni
-* Fatmen
-*
-*
-$!DECK ID>, FATPURGE.COM
-$SET NOON
-$ !
-$ ! Purge journalled FATMEN updates that are over a day old
-$ !
-$ if p1 .eqs. "" then exit
-$ fatmen = p1
-$ count = 0
-$ save_mess = f$environment("MESSAGE")
-$ set message/nofacility/noseverity/noid/notext
-$loop:
-$ fatman = f$element(count,",",fatmen)
-$ if fatman .eqs. "," then goto end
-$ count = count + 1
-$ write sys$output "Processing ''fatman'..."
-$ ON WARNING THEN GOTO UNDEFINED
-$ fatdir = &fatman
-$ fatfil = f$extract(0,f$length(fatdir)-1,fatdir) + ".DONE]*.*;*"
-$ ON WARNING THEN CONTINUE
-$ delete/before=-0-23:59 'fatfil'
-$ goto loop
-$ undefined:
-$ write sys$output "Warning: symbol ''fatman' is not defined"
-$ goto loop
-$ end:
-$ set message 'save_mess'
-$ exit
diff --git a/src/packlib/fatmen/scripts/dcl/fatrl.dat b/src/packlib/fatmen/scripts/dcl/fatrl.dat
deleted file mode 100644
index d2e6030..0000000
--- a/src/packlib/fatmen/scripts/dcl/fatrl.dat
+++ /dev/null
@@ -1,70 +0,0 @@
-*
-* $Id: fatrl.dat,v 1.1.1.1 1996/03/07 15:17:49 mclareni Exp $
-*
-* $Log: fatrl.dat,v $
-* Revision 1.1.1.1 1996/03/07 15:17:49 mclareni
-* Fatmen
-*
-*
-$!DECK ID>, FATRL.COM
-$!
-$! Copy FATMEN update files from "RDR" to [.TODO]
-$! Requires CERN Interlink mod to transfer files as user.fn_ft
-$!
-$ set noverify
-$ !
-$ if p1 .eqs. "" then exit
-$ fatmen = p1
-$ count = 0
-$ save_mess = f$environment("MESSAGE")
-$ set message/nofacility/noseverity/noid/notext
-$ if f$trnlnm("RDRLIST_DEVICE") .eqs. "" then -
-define/proc/nolog rdrlist_device "SYS$SPECIFIC:"
-$ if f$trnlnm("RDRLIST_DIRECTORY") .eqs. ""
-$ then rdr_dir = "[DECNET]"
-$ else rdr_dir = f$trnlnm("RDRLIST_DIRECTORY")
-$ endif
-$ !
-$ ! Loop over all FATMEN
-$ !
-$loop:
-$ fatman = f$element(count,",",fatmen)
-$ if fatman .eqs. "," then goto end
-$ count = count + 1
-$ write sys$output "Processing ''fatman'..."
-$ ON WARNING THEN GOTO UNDEFINED
-$ fatdir = &fatman
-$ ON WARNING THEN CONTINUE
-$ search = "RDRLIST_DEVICE:" + rdr_dir + fatman + ".*;*"
-$ fatuser = &fatman
-$ fatdir = f$extract(0,f$length(fatuser)-1,fatuser) + ".TODO]"
-$ loop_rdr:
-$ cur_file = f$search(search)
-$ if cur_file .eqs. "" then goto loop
-$ if f$locate("_",cur_file) .eq. f$length(cur_file) then goto loop_rdr
-$ fname = f$parse(cur_file,,,"NAME")
-$ !
-$ ! Skip files not destined for us...
-$ !
-$ if fname .nes. fatman then goto loop_rdr
-$ ftype = f$parse(cur_file,,,"TYPE") - "."
-$ if f$locate("_",ftype) .eq. f$length(ftype) then goto loop_rdr
-$ created = f$file_attributes(cur_file,"RDT")
-$ fatdate = f$cvtime(created,,"DATE") - "-" - "-"
-$ fattime = f$cvtime(created,,"HOUR") + f$cvtime(created,,"MINUTE") + -
-f$cvtime(created,,"SECOND")
-$ ftype = "''fname'_CERNVM"
-$ fatfile = fatdir + ftype + "." + fatdate + fattime
-$ copy 'cur_file' 'fatfile'
-$ !
-$ delete 'cur_file' ! requires PRIV
-$ !
-$ goto loop_rdr
-$ !
-$ undefined:
-$ write sys$output "Warning: symbol ''fatman' is not defined"
-$ goto loop
-$ !
-$ end:
-$ set message 'save_mess'
-$ exit
diff --git a/src/packlib/fatmen/scripts/dcl/fatsend.dat b/src/packlib/fatmen/scripts/dcl/fatsend.dat
deleted file mode 100644
index 848a776..0000000
--- a/src/packlib/fatmen/scripts/dcl/fatsend.dat
+++ /dev/null
@@ -1,43 +0,0 @@
-*
-* $Id: fatsend.dat,v 1.1.1.1 1996/03/07 15:17:50 mclareni Exp $
-*
-* $Log: fatsend.dat,v $
-* Revision 1.1.1.1 1996/03/07 15:17:50 mclareni
-* Fatmen
-*
-*
-$!DECK ID>, FATSEND.COM
-$ set noon
-$!
-$! Example FATSEND.COM
-$!
-$ dd = f$cvtime(,,"WEEKDAY")
-$ tt = f$time()
-$ hh = f$trnlnm("SYS$NODE")
-$ write sys$output ""
-$ write sys$output "FATSEND starting at ''dd' ''tt' on ''hh'"
-$ write sys$output ""
-$ FATSYS:==CERN
-$ !
-$ ! Set FATMEN group
-$ !
-$ FATGRP:==FMCNDIV
-$ !
-$ ! Set FATMEN wakeup interval in seconds
-$ !
-$ FMWAKEUP:==30
-$ !
-$ ! Set FATMEN log level
-$ !
-$ FMLOGL:==3
-$ write sys$output -
-"FATMEN group set to ''FATGRP', wakeup interval is ''FMWAKEUP' seconds"
-$ !
-$ ! N.B. FMCNDIV (in this case) must also be defined to point
-$ ! to the directory where the FATMEN RZ file for FMCNDIV is located.
-$ !
-$ ! Set process name
-$ !
-$ set proc/name="FATSEND_''f$edit(f$getjpi("","USERNAME"),"TRIM")'"
-$ run cern:[pro.exe]fatd$send
-
diff --git a/src/packlib/fatmen/scripts/dcl/fatserv.dat b/src/packlib/fatmen/scripts/dcl/fatserv.dat
deleted file mode 100644
index 7bc4037..0000000
--- a/src/packlib/fatmen/scripts/dcl/fatserv.dat
+++ /dev/null
@@ -1,46 +0,0 @@
-*
-* $Id: fatserv.dat,v 1.1.1.1 1996/03/07 15:17:49 mclareni Exp $
-*
-* $Log: fatserv.dat,v $
-* Revision 1.1.1.1 1996/03/07 15:17:49 mclareni
-* Fatmen
-*
-*
-$!DECK ID>, FATSERV.COM
-$ set noon
-$!
-$! Example FATSERV.COM
-$!
-$ dd = f$cvtime(,,"WEEKDAY")
-$ tt = f$time()
-$ hh = f$trnlnm("SYS$NODE")
-$ write sys$output ""
-$ write sys$output "FATSERV starting at ''dd' ''tt' on ''hh'"
-$ write sys$output ""
-$ !
-$ ! Set FATMEN system
-$ !
-$ FATSYS:==CERN
-$ !
-$ ! Set FATMEN group
-$ !
-$ FATGRP:==FMCNDIV
-$ !
-$ ! Set FATMEN wakeup interval in seconds
-$ !
-$ FMWAKEUP:==30
-$ !
-$ ! Set FATMEN log level
-$ !
-$ FMLOGL:==3
-$ write sys$output -
-"FATMEN group set to ''FATGRP', wakeup interval is ''FMWAKEUP' seconds"
-$ !
-$ ! N.B. FMCNDIV (in this case) must also be defined to point
-$ ! to the directory where the FATMEN RZ file for FMCNDIV is located.
-$ !
-$ ! Set process name
-$ !
-$ set proc/name="fatserv_''f$edit(f$getjpi("","USERNAME"),"TRIM")'"
-$ run cern:[pro.exe]fatsrv
-
diff --git a/src/packlib/fatmen/scripts/dcl/fmkuip.dat b/src/packlib/fatmen/scripts/dcl/fmkuip.dat
deleted file mode 100644
index 81e6808..0000000
--- a/src/packlib/fatmen/scripts/dcl/fmkuip.dat
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: fmkuip.dat,v 1.1.1.1 1996/03/07 15:17:49 mclareni Exp $
-*
-* $Log: fmkuip.dat,v $
-* Revision 1.1.1.1 1996/03/07 15:17:49 mclareni
-* Fatmen
-*
-*
-$!DECK ID>, FMKUIP.COM
-$ypatchy cern:[pro.src.car]zebra.car fmkuip.for tty tty - fmcdf.cdf :go <<!
-&use,qcde.
-&use,vaxvms.
-&use,fmc,t=inhibit.
-&use,fmh,t=inhibit.
-&use,tms,t=inhibit.
-&use,*fmkuip.
-&asm,23.
-&exe.
-&pam,11,r=qcde,t=c.
-&pam,12,t=c,a. fatmen.cards
-&quit
-$kuipc fmcdf.cdf fmcdf.for
-$for fmcdf
-$for fmkuip
diff --git a/src/packlib/fatmen/scripts/dcl/mkfatnew.dat b/src/packlib/fatmen/scripts/dcl/mkfatnew.dat
deleted file mode 100644
index 2ad9513..0000000
--- a/src/packlib/fatmen/scripts/dcl/mkfatnew.dat
+++ /dev/null
@@ -1,43 +0,0 @@
-*
-* $Id: mkfatnew.dat,v 1.1.1.1 1996/03/07 15:17:49 mclareni Exp $
-*
-* $Log: mkfatnew.dat,v $
-* Revision 1.1.1.1 1996/03/07 15:17:49 mclareni
-* Fatmen
-*
-*
-$!DECK ID>, MKFATNEW.COM
-$! fatsys:==CERN ! For example
-$! fatgrp:==LHC ! For example
-$
-$ type/nopage sys$input
-
-Please give the name of the FATMEN system. This name forms
-the top-level of the FATMEN catalogue, e.g. //CERN
-
-$eod
-$ inquire/nopunc ans "FATSYS? "
-$ if ans.eqs."" then ans = "CERN"
-$ fatsys==ans - "//"
-$ type/nopage sys$input
-
-Please give the name of the FATMEN group.
-
-$eod
-$ inquire/nopunc ans "FATGRP? "
-$ if ans.eqs."" then exit
-$ fatgrp==ans - "FM"
-$ write sys$output ""
-$ inquire/nopunc fatdir "Directory where FATMEN catalogue should reside? "
-$ olddir = f$environment("DEFAULT")
-$ set default 'fatdir'
-$ create/directory [.todo]
-$ create/directory [.tovm]
-$ create/directory [.done]
-$ set file/protection=w:rw todo.dir
-$ fatman="FM''fatgrp'"
-$ set file/acl=(id='fatman',access=read+write,options=default) todo.dir
-$ set file/protection=w:rw tovm.dir
-$ set file/protection=w:rw done.dir
-$ run cern:[pro.exe]fatnew
-$ set default 'olddir'
diff --git a/src/packlib/fatmen/scripts/dcl/run_fat.dat b/src/packlib/fatmen/scripts/dcl/run_fat.dat
deleted file mode 100644
index 1b53932..0000000
--- a/src/packlib/fatmen/scripts/dcl/run_fat.dat
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: run_fat.dat,v 1.1.1.1 1996/03/07 15:17:50 mclareni Exp $
-*
-* $Log: run_fat.dat,v $
-* Revision 1.1.1.1 1996/03/07 15:17:50 mclareni
-* Fatmen
-*
-*
-$! modified JJB 2/2/1993 Added /soft option to avoid stale bread buns
-$ set noon
-$ if f$trnlm("FATMEN").eqs."" then NFSMOUNT/soft FATCAT::"/fatmen" FATMEN
-$ @cern:[pro.exe]fatmast
diff --git a/src/packlib/fatmen/scripts/dcl/stgserv.dat b/src/packlib/fatmen/scripts/dcl/stgserv.dat
deleted file mode 100644
index f0f3d0c..0000000
--- a/src/packlib/fatmen/scripts/dcl/stgserv.dat
+++ /dev/null
@@ -1,42 +0,0 @@
-*
-* $Id: stgserv.dat,v 1.1.1.1 1996/03/07 15:17:50 mclareni Exp $
-*
-* $Log: stgserv.dat,v $
-* Revision 1.1.1.1 1996/03/07 15:17:50 mclareni
-* Fatmen
-*
-*
-$!DECK ID>, STGSERV.COM
-$ set noon
-$!
-$! STGSERV.COM
-$!
-$! This command file is invoked when a remote stage operation is
-$! required.
-$!
-$! Display remote user and node name
-$!
-$ remote_user = f$trnlnm("SYS$REM_ID")
-$ remote_node = f$trnlnm("SYS$REM_NODE")
-$!
-$ date_time = f$cvtime(,"ABSOLUTE")
-$!
-$ write sys$output ""
-$ write sys$output ">>> Start of STGSERV command file"
-$ write sys$output ""
-$!
-$ write sys$output "Remote stage submit/query request from user ",-
-"''remote_user' at ''remote_node' at ''date_time'"
-$!
-$! Set messages how we want them...
-$!
-$ SET MESSAGE/FACILITY/IDENTIFICATION/SEVERITY/TEXT
-$!
-$! Run the server
-$!
-$ RUN SETUP_EXE:STGSERV
-$!
-$ write sys$output ""
-$ write sys$output ">>> End of STGSERV command file"
-$ write sys$output ""
-$!
diff --git a/src/packlib/fatmen/scripts/fatsql/cretab.F b/src/packlib/fatmen/scripts/fatsql/cretab.F
deleted file mode 100644
index 30edbc4..0000000
--- a/src/packlib/fatmen/scripts/fatsql/cretab.F
+++ /dev/null
@@ -1,91 +0,0 @@
-*
-* $Id: cretab.F,v 1.1.1.1 1996/03/07 15:17:51 mclareni Exp $
-*
-* $Log: cretab.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:51 mclareni
-* Fatmen
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_fatmen/pilot.h"
-#if defined(CERNLIB_ORACLE)
-
-INSERT INTO Fatmen VALUES ('CERN', 'throng')
-/
-
-REM *** SPECIFIC TABLES FOR throng
-
-CREATE TABLE GNames_throng ( GName CHAR(240) NOT NULL,
- GN# NUMBER NOT NULL)
-/
-CREATE TABLE Files_throng ( File# NUMBER NOT NULL,
- GN# NUMBER NOT NULL,
- Copylevel NUMBER(2) NOT NULL,
- Location NUMBER NOT NULL,
- Hostname CHAR(8) NOT NULL,
- Fullname CHAR(240) NOT NULL,
- Hosttype CHAR(16),
- Opersys CHAR(12),
- Fileformat CHAR(4) NOT NULL,
- Userformat CHAR(4),
- Startrec# NUMBER,
- Endrec# NUMBER,
- Startblk# NUMBER,
- Endblk# NUMBER,
- Recformat CHAR(4),
- Reclength NUMBER,
- Blklength NUMBER,
- Creation DATE,
- Catalogation DATE,
- Lastaccess DATE,
- Active CHAR(1) NOT NULL,
- Creatorname CHAR(8),
- Creatoraccount CHAR(8),
- Creatornode CHAR(8),
- Creatorjob CHAR(8),
- Protection NUMBER(2),
- Userword0 NUMBER,
- Userword1 NUMBER,
- Userword2 NUMBER,
- Userword3 NUMBER,
- Userword4 NUMBER,
- Userword5 NUMBER,
- Userword6 NUMBER,
- Userword7 NUMBER,
- Userword8 NUMBER,
- Userword9 NUMBER,
- Sysword0 NUMBER,
- Sysword1 NUMBER,
- Sysword2 NUMBER,
- Sysword3 NUMBER,
- Sysword4 NUMBER,
- Sysword5 NUMBER,
- Sysword6 NUMBER,
- Sysword7 NUMBER,
- Sysword8 NUMBER,
- Sysword9 NUMBER,
- Comments CHAR(80),
- Mediatype CHAR(1))
-/
-CREATE TABLE FXV_throng ( File# NUMBER NOT NULL,
- Fileseq# NUMBER NOT NULL,
- Vol# NUMBER NOT NULL,
- Volseq# NUMBER)
-/
-CREATE TABLE Volumes_throng ( Vol# NUMBER NOT NULL,
- VSN CHAR(6) NOT NULL,
- VID CHAR(6) NOT NULL,
- VIDprefix NUMBER,
- Density NUMBER)
-/
-
-GRANT SELECT ON Gnames_throng TO PUBLIC
-/
-GRANT SELECT ON Files_throng TO PUBLIC
-/
-GRANT SELECT ON FXV_throng TO PUBLIC
-/
-GRANT SELECT ON Volumes_throng TO PUBLIC
-/
-
-#endif
diff --git a/src/packlib/fatmen/scripts/jcl/fatsrv.dat b/src/packlib/fatmen/scripts/jcl/fatsrv.dat
deleted file mode 100644
index 99725f0..0000000
--- a/src/packlib/fatmen/scripts/jcl/fatsrv.dat
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: fatsrv.dat,v 1.1.1.1 1996/03/07 15:17:50 mclareni Exp $
-*
-* $Log: fatsrv.dat,v $
-* Revision 1.1.1.1 1996/03/07 15:17:50 mclareni
-* Fatmen
-*
-*
-// JOB
-// EXEC PGM=FATSRV
-//JOBLIB DD DSN=FATLIB,DISP=SHR
-//* Following statements define Catalogue name, Group name
-//* wakeup interval (seconds) and loglevel.
-//SYSIN DD *
-DESY
-H1
-60
-3
-//FT01F001 DD DSN=R01JDS.FATMEN.H1.DESY.FATRZ,DISP=SHR
diff --git a/src/packlib/fatmen/scripts/kumac/fatindx.F b/src/packlib/fatmen/scripts/kumac/fatindx.F
deleted file mode 100644
index e0a152b..0000000
--- a/src/packlib/fatmen/scripts/kumac/fatindx.F
+++ /dev/null
@@ -1,57 +0,0 @@
-*
-* $Id: fatindx.F,v 1.1.1.1 1996/03/07 15:17:50 mclareni Exp $
-*
-* $Log: fatindx.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:50 mclareni
-* Fatmen
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_fatmen/pilot.h"
-MESS ' '
-MESS 'Example KUMAC to create entries for program FATINDX'
-MESS ' '
-init cndiv
-cd jamie/dd
-add/tape js0008 js0008 1 p021 M1E05001 FX 1 UKACRL 'G120 5001 5250'
-add/tape js0008 js0008 3 p023 M1E05501 FX 1 UKACRL 'G120 5501 5750'
-add/tape js0009 js0009 2 p025 M1E06001 FX 1 UKACRL 'G120 6001 6250'
-add/tape js0010 js0010 1 p027 M1E06501 FX 1 UKACRL 'G120 6501 6750'
-add/tape js0010 js0010 3 p029 M1E07001 FX 1 UKACRL 'G120 7001 7250'
-add/tape js0011 js0011 2 p031 M1E07501 FX 1 UKACRL 'G120 7501 7750'
-add/tape js0012 js0012 1 p033 M1E08001 FX 1 UKACRL 'G120 8001 8250'
-add/tape js0012 js0012 3 p035 M1E08501 FX 1 UKACRL 'G120 8501 8750'
-add/tape js0013 js0013 2 p037 M1E09001 FX 1 UKACRL 'G120 9001 9250'
-add/tape js0014 js0014 1 p039 M1E09501 FX 1 UKACRL 'G120 9501 9750'
-add/tape js0014 js0014 3 p041 M1E10001 FX 1 UKACRL 'G120 10001 10250'
-add/tape js0015 js0015 2 p043 M1E10501 FX 1 UKACRL 'G120 10501 10750'
-add/tape js0016 js0016 1 p045 M1E11001 FX 1 UKACRL 'G120 11001 11250'
-add/tape js0016 js0016 3 p047 M1E11501 FX 1 UKACRL 'G120 11501 11750'
-add/tape js0017 js0017 2 p049 M1E12001 FX 1 UKACRL 'G120 12001 12250'
-add/tape js0018 js0018 1 p051 M1E12501 FX 1 UKACRL 'G120 12501 12750'
-add/tape js0018 js0018 3 p053 M1E13001 FX 1 UKACRL 'G120 13001 13250'
-add/tape js0019 js0019 2 p055 M1E13501 FX 1 UKACRL 'G120 13501 13750'
-add/tape js0020 js0020 1 p057 M1E14001 FX 1 UKACRL 'G120 14001 14250'
-add/tape js0020 js0020 3 p059 M1E14501 FX 1 UKACRL 'G120 14501 14750'
-add/tape js0021 js0021 2 p061 M1E15001 FX 1 UKACRL 'G120 15001 15250'
-add/tape js0008 js0008 2 p022 M1E05251 FX 1 UKACRL 'G120 5251 5500'
-add/tape js0009 js0009 1 p024 M1E05751 FX 1 UKACRL 'G120 5751 6000'
-add/tape js0009 js0009 3 p026 M1E06251 FX 1 UKACRL 'G120 6251 6500'
-add/tape js0010 js0010 2 p028 M1E06751 FX 1 UKACRL 'G120 6751 7000'
-add/tape js0011 js0011 1 p030 M1E07251 FX 1 UKACRL 'G120 7251 7500'
-add/tape js0011 js0011 3 p032 M1E07751 FX 1 UKACRL 'G120 7751 8000'
-add/tape js0012 js0012 2 p034 M1E08251 FX 1 UKACRL 'G120 8251 8500'
-add/tape js0013 js0013 1 p036 M1E08751 FX 1 UKACRL 'G120 8751 9000'
-add/tape js0013 js0013 3 p038 M1E09251 FX 1 UKACRL 'G120 9251 9500'
-add/tape js0014 js0014 2 p040 M1E09751 FX 1 UKACRL 'G120 9751 10000'
-add/tape js0015 js0015 1 p042 M1E10251 FX 1 UKACRL 'G120 10251 10500'
-add/tape js0015 js0015 3 p044 M1E10751 FX 1 UKACRL 'G120 10751 11000'
-add/tape js0016 js0016 2 p046 M1E11251 FX 1 UKACRL 'G120 11251 11500'
-add/tape js0017 js0017 1 p048 M1E11751 FX 1 UKACRL 'G120 11751 12000'
-add/tape js0017 js0017 3 p050 M1E12251 FX 1 UKACRL 'G120 12251 12500'
-add/tape js0018 js0018 2 p052 M1E12751 FX 1 UKACRL 'G120 12751 13000'
-add/tape js0019 js0019 1 p054 M1E13251 FX 1 UKACRL 'G120 13251 13500'
-add/tape js0019 js0019 3 p056 M1E13751 FX 1 UKACRL 'G120 13751 14000'
-add/tape js0020 js0020 2 p058 M1E14251 FX 1 UKACRL 'G120 14251 14500'
-add/tape js0021 js0021 1 p060 M1E14751 FX 1 UKACRL 'G120 14751 15000'
-add/tape js0021 js0021 3 p062 M1E15251 FX 1 UKACRL 'G120 15251 15500'
diff --git a/src/packlib/fatmen/scripts/names/fmnames.F b/src/packlib/fatmen/scripts/names/fmnames.F
deleted file mode 100644
index f2593c2..0000000
--- a/src/packlib/fatmen/scripts/names/fmnames.F
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: fmnames.F,v 1.1.1.1 1996/03/07 15:17:50 mclareni Exp $
-*
-* $Log: fmnames.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:50 mclareni
-* Fatmen
-*
-*
-* EXAMPLE NAMES FILE
-#include "sys/CERNLIB_machine.h"
-#include "_fatmen/pilot.h"
-:nick.FATOPERATORS
- :list.fatop1 fatop2
-
-:nick.FATOP1
- :userid.console
- :node.cernvm
-
-:nick.FATOP2
- :userid.opsutil
- :node.cernvm
-
-:nick.FATOWN1
- :userid.fatone
- :node.cernvm
-
-:nick.FATOWN2
- :userid.hrrcr
- :node.cernvm
-
-:nick.FATOWNERS
- :list.fatown1 fatown2 jamie
-
diff --git a/src/packlib/fatmen/scripts/rexx/fat2cern.dat b/src/packlib/fatmen/scripts/rexx/fat2cern.dat
deleted file mode 100644
index 6057aa8..0000000
--- a/src/packlib/fatmen/scripts/rexx/fat2cern.dat
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: fat2cern.dat,v 1.1.1.1 1996/03/07 15:17:50 mclareni Exp $
-*
-* $Log: fat2cern.dat,v $
-* Revision 1.1.1.1 1996/03/07 15:17:50 mclareni
-* Fatmen
-*
-*
-/*DECK ID>, FAT2CERN.EXEC */
-/*---------------------------------------------------------------------*/
-/* F A T 2 C E R N E X E C */
-/* ------------------------ */
-/* */
-/* EXEC to forward FATMEN updates to central FAT server. */
-/* The update will not be forwarded if it came from FMxxxx at CERNVM. */
-/* */
-/*---------------------------------------------------------------------*/
-Parse arg server
-/* 'ID(STACK'
-Pull server .
-*/
-'GLOBALV SELECT *EXEC STACK FATADDR'
-Pull fatuser fatnode
-if substr(fatuser,1,2) = 'FM' & fatnode = 'CERNVM' then do
- Say 'Update originated at CERNVM - will not be sent back'
- exit
- end
- else do
- 'EXEC SENDFILE FATMEN RDRFILE ' server ' AT CERNVM'
- end
-
diff --git a/src/packlib/fatmen/scripts/rexx/fat2vax.dat b/src/packlib/fatmen/scripts/rexx/fat2vax.dat
deleted file mode 100644
index 7971d8e..0000000
--- a/src/packlib/fatmen/scripts/rexx/fat2vax.dat
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: fat2vax.dat,v 1.1.1.1 1996/03/07 15:17:50 mclareni Exp $
-*
-* $Log: fat2vax.dat,v $
-* Revision 1.1.1.1 1996/03/07 15:17:50 mclareni
-* Fatmen
-*
-*
-/*DECK ID>, FAT2VAX.EXEC */
-/**/
-
-Parse arg fn ft remote_user remote_node
-
-"ID(STACK"
-
-Pull user . node .
-
-"RENAME "fn ft "A "user node "A"
-
-"EXEC SENDFILE "user node" TO "remote_user " AT "remote_node
-
-
-"RENAME "user node "A " fn ft "A"
diff --git a/src/packlib/fatmen/scripts/rexx/fat4ward.dat b/src/packlib/fatmen/scripts/rexx/fat4ward.dat
deleted file mode 100644
index b519c03..0000000
--- a/src/packlib/fatmen/scripts/rexx/fat4ward.dat
+++ /dev/null
@@ -1,138 +0,0 @@
-*
-* $Id: fat4ward.dat,v 1.1.1.1 1996/03/07 15:17:50 mclareni Exp $
-*
-* $Log: fat4ward.dat,v $
-* Revision 1.1.1.1 1996/03/07 15:17:50 mclareni
-* Fatmen
-*
-*
-/*DECK ID>, FAT4WARD.EXEC */
-/*---------------------------------------------------------------------*/
-/* F A T 4 W A R D E X E C */
-/* ------------------------ */
-/* */
-/* EXEC to forward FATMEN updates to remote FAT servers. */
-/* Input: Generic-name */
-/* */
-/* The generic-name will be matched against tags DIR1-DIR16 for each */
-/* server in the list FATSERVERS. */
-/* DIR1-DIR16 are generic name patterns, e.g. */
-/* //CERN/ALEPH */
-/* //CERN/DELPHI/SIMD/RAWD */
-/* */
-/* Each element of the generic name patterns may be a full directory */
-/* name of an asterisk. Other combinations are not currently supported.*/
-/*---------------------------------------------------------------------*/
-
-Parse upper arg generic_name .
-
-If generic_name = '' then do
- Say 'Error - no generic name specified'
- Exit 999
-End /* No generic name */
-
-Say 'Processing generic name: ' generic_name
-gname = translate(generic_name,' ','/')
-g = words(gname)
-'IDENTIFY (STACK'
-Pull me . mynode .
-'GLOBALV SELECT *EXEC STACK FATADDR'
-Pull fatuser fatnode
-
-/* Find out the names of the FATMEN servers */
-
-'MAKEBUF'
-'NAMEFIND :NICK FATSERVERS (STACK'
-code = rc
-If code ^= 0 then do
- Say 'Error from NAMEFIND - RC = 'code
- exit
-End /* No FATSERVERS */
-Pull .
-Pull servers
-'DROPBUF'
-
-Do i=2 to words(servers)
- server = word(servers,i)
- say 'Processing server: ' server
- 'NAMEFIND :NICK 'server ':USERID :NODE (STACK'
- Pull remote_user
- If remote_user = '' then remote_user = server
- Pull remote_node
- If remote_node = '' then remote_node = mynode
-
- If remote_user = fatuser & remote_node = fatnode then do
- say 'Skipping sender ('fatuser 'at' fatnode ')'
- iterate
- End /* Don't send update back to originator */
-
- If remote_user = me & remote_node = mynode then do
- say 'Skipping myself...'
- iterate
- end /* Don't send update to ourselves */
-
- 'NAMEFIND :NICK 'server ' :EXEC (STACK'
- Pull send_exec
-
- 'NAMEFIND :NICK 'server ' :GATEWAY (STACK'
- Pull gateway
-
- if strip(gateway)^= '' then do
-
- if words(gateway) = 1 then do
- gateway = gateway " AT " mynode
- end /* Assume gateway machine is on this node if node not defined */
-
- parse upper var gateway gateuser " AT " gatenode
-
- if (fatuser=gateuser) & (fatnode=gatenode) then do
- say 'Skipping sender ('fatuser 'at' fatnode ')'
- iterate
- end /* Skip updates from a gateway machine */
-
- end /* End gateway ^= '' */
-
- Do j=1 to 16
-/* Try to match this directory against generic name */
-/* If ok, send this file to server and leave */
- tag = ':DIR'||j
- 'NAMEFIND :NICK ' server tag' (STACK'
- If Rc^= 0 then leave /* No such tag */
- Pull match
- If strip(match) ^= '' then do
- match = translate(match,' ','/')
- m = words(match)
- ok = 1
- if m > g then iterate /* Match is longer than generic-name */
- do k=1 to m
- if (word(match,k) ^= word(gname,k)) & ,
- (word(match,m) ^= '*') then do
- ok = 0
- leave /* One failure compare and we're out */
- end /* Check each element of generic name */
- end
- if ok then do
- say 'Match found for 'server
- /* Process this entry */
- If strip(gateway) = '' then do
- If strip(send_exec) = '' then do
- 'EXEC SENDFILE FATMEN RDRFILE' server
- end /* no special send exec - sendfile directly */
- else do
- 'EXEC 'send_exec' FATMEN RDRFILE' remote_user remote_node
- end /* use special send exec */
- end /* No gateway machine */
- else do
-
-/* Send to gateway machine. First rename file, then send, then rename back */
-
- 'RENAME FATMEN RDRFILE A 'remote_user remote_node 'A'
- 'EXEC SENDFILE' remote_user remote_node gateway
- 'RENAME 'remote_user remote_node 'A FATMEN RDRFILE A'
- end /* Sendfile to gateway machine */
-
- leave /* Don't look for another match... */
- end /* We had a match */
- end /* Non-blank tags */
- end /* Loop over tags DIR1 .. DIR16 */
-end /* Loop over FATSERVERS */
diff --git a/src/packlib/fatmen/scripts/rexx/fatabend.dat b/src/packlib/fatmen/scripts/rexx/fatabend.dat
deleted file mode 100644
index 7cd91b5..0000000
--- a/src/packlib/fatmen/scripts/rexx/fatabend.dat
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: fatabend.dat,v 1.1.1.1 1996/03/07 15:17:51 mclareni Exp $
-*
-* $Log: fatabend.dat,v $
-* Revision 1.1.1.1 1996/03/07 15:17:51 mclareni
-* Fatmen
-*
-*
-/*DECK ID>, FATABEND.EXEC */
-/*-------------------------------------------------------------*/
-/* */
-/* F A T A B E N D */
-/* */
-/*-------------------------------------------------------------*/
-'ID (STACK'
-Pull user . node .
-if fexist(FATMEN MAILFILE A3) then 'ERASE FATMEN MAILFILE A3'
-'EXECIO 1 DISKW FATMEN MAILFILE A3 (STRING 'user node
-'EXEC MAIL FATMAN (NOEDIT NOLOG FILE FATMEN MAILFILE SUBJECT FATSRV abend'
diff --git a/src/packlib/fatmen/scripts/rexx/fatgime.dat b/src/packlib/fatmen/scripts/rexx/fatgime.dat
deleted file mode 100644
index 13f9c9c..0000000
--- a/src/packlib/fatmen/scripts/rexx/fatgime.dat
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: fatgime.dat,v 1.1.1.1 1996/03/07 15:17:50 mclareni Exp $
-*
-* $Log: fatgime.dat,v $
-* Revision 1.1.1.1 1996/03/07 15:17:50 mclareni
-* Fatmen
-*
-*
-/*DECK ID>, FATGIME.EXEC */
-/*-------------------------------------------------------------*/
-/* */
-/* F A T G I M E */
-/* */
-/* Simple GIME exec to handle numeric userids. */
-/* No interface to GIME names files etc. */
-/* */
-/*-------------------------------------------------------------*/
-Parse arg user addr . '(' options ')' .
-If user = '' then exit 99
-If addr = '' then addr = 191
-slot = QDISK("?","SLOT")
-If RC ^= 0 then exit RC
-Parse var slot mode vaddr
-access = 'RR'
-If index(options,'MR') ^= 0 then access = 'MR'
-'CP LINK 'user addr vaddr access
-If RC ^= 0 then exit RC
-'ACCESS 'vaddr mode
-If RC ^= 0 then exit RC
diff --git a/src/packlib/fatmen/scripts/rexx/fatjourn.dat b/src/packlib/fatmen/scripts/rexx/fatjourn.dat
deleted file mode 100644
index 6d6a4eb..0000000
--- a/src/packlib/fatmen/scripts/rexx/fatjourn.dat
+++ /dev/null
@@ -1,60 +0,0 @@
-*
-* $Id: fatjourn.dat,v 1.1.1.1 1996/03/07 15:17:50 mclareni Exp $
-*
-* $Log: fatjourn.dat,v $
-* Revision 1.1.1.1 1996/03/07 15:17:50 mclareni
-* Fatmen
-*
-*
-/*DECK ID>, FATJOURN.EXEC */
-/*---------------------------------------------------------------------*/
-/* F A T J O U R N E X E C */
-/* ------------------------ */
-/* */
-/* EXEC to store FATMEN journal files. */
-/* Input: None */
-/* Output: New journal (FZ) file */
-/* Action: Copy FATMEN RDRFILE A -> journal file */
-/*---------------------------------------------------------------------*/
-
-'STATE FATMEN RDRFILE A'
-If RC ^=0 then Do
- Say 'FATMEN RDRFILE not found - cannot create journal file'
- Exit 999
- End
-/* Get new filename */
-
-retry:
-
-fat_date = date("JULIAN")
-fat_time = remove(time(),':')
-fat_file = "FAT"||fat_date || " FZ" || fat_time
-
-If fexist(fat_file) then do
- 'CP SLEEP 1 SEC'
- signal retry
- end
-
-b_left = QDISK("B","BLKLEFT")
-b_size = QDISK("B","BLKSIZE")
-b_used = QDISK("B","PERCENT")
-a_size = QDISK("A","BLKSIZE")
-f_size = QFILE("FATMEN RDRFILE A","BLKNO")
-if f_size*a_size*2 < b_left*b_size & b_used < 90 then do
-
- 'COPYFILE FATMEN RDRFILE A 'fat_file 'B (TYPE'
- 'ERASE FATMEN RDRFILE A'
- end
-
- else do
-
-/* 'EXEC MESS JAMIE No space free for journal file, need 'f_size,
- ' have ' b_left' blocks left, used 'b_used '%' */
-
- 'LISTFILE FAT* FZ* B (E'
-
- 'CMS EXEC FATPURGE'
- 'COPYFILE FATMEN RDRFILE A 'fat_file 'B (TYPE'
- 'ERASE FATMEN RDRFILE A'
-
- end
diff --git a/src/packlib/fatmen/scripts/rexx/fatlog.dat b/src/packlib/fatmen/scripts/rexx/fatlog.dat
deleted file mode 100644
index ae9ed28..0000000
--- a/src/packlib/fatmen/scripts/rexx/fatlog.dat
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: fatlog.dat,v 1.1.1.1 1996/03/07 15:17:50 mclareni Exp $
-*
-* $Log: fatlog.dat,v $
-* Revision 1.1.1.1 1996/03/07 15:17:50 mclareni
-* Fatmen
-*
-*
-/*DECK ID>, FATLOG.EXEC */
-/* F A T _ L O G */
-Parse arg server message
-Userid = "XNAME"("USERID")
-Account = "XACCOUNT"()
-server = strip(server)
-"EXECIO 0 CP (STRING Q USER "server
-If rc ^= 0 then exit
-"EXEC TELL "server "*FATLOG* from "Userid Account ": "message
diff --git a/src/packlib/fatmen/scripts/rexx/fatmast.dat b/src/packlib/fatmen/scripts/rexx/fatmast.dat
deleted file mode 100644
index 3981deb..0000000
--- a/src/packlib/fatmen/scripts/rexx/fatmast.dat
+++ /dev/null
@@ -1,133 +0,0 @@
-*
-* $Id: fatmast.dat,v 1.1.1.1 1996/03/07 15:17:50 mclareni Exp $
-*
-* $Log: fatmast.dat,v $
-* Revision 1.1.1.1 1996/03/07 15:17:50 mclareni
-* Fatmen
-*
-*
-/*DECK ID>, FATMAST.EXEC */
-/* FAT_MASTER Service machine exec */
-wait:
-
-/*auth_users = 'JAMIE/CONSOLE/ORACLE/OPSSERVE/HRRCR/TNT/JULIAN/ONEALE/OPALSVR2/OPALFAT6'*/
-auth_users = 'JAMIE/CONSOLE/OPSSERVE/HRRCR/TNT/JULIAN/ONEALE/OPALSVR2/OPALFAT6'
-valid = 'SHUTDOWN/HELLO/STARTUP/WHO/LOGOFF/ADDFAT/REMFAT'
-'ID(LIFO'
-Pull . . mynode .
-'DROPBUF'
-'CP SET MSG IUCV'
-deltim = '+00:01'
- Do Forever
-
- 'WAKEUP' deltim '(IUCVMSG' /* Wakeup every 10 minutes */
- code = rc
- deltim = '+00:10:00'
-/* P r o c e s s m e s s a g e */
-
-Select
- When code = 2 then do /* Wakeup and see what's happening */
- /* What's the time? */
-/* ttime = time("M") /* Minutes past midnight */
- if (ttime > 200) & (ttime < 550) then iterate*/
- "EXEC QFAT"
- end
- When code = 5 then do /* New MSG */
- Pull text
- Parse var text . user text
-/* Say 'New MSG received'*/
- If user = XNAME("RSCSID") | user = "DECMCS" then do
- Parse Var text . "FROM" user_node text
- Parse Var user_node node "(" user ")" .
- If user = "" | DATATYPE(user,"N") then Return 1
- End
- Else do
- node = mynode
-/* Say 'Message 'text 'from user 'user 'at 'node */
- If Index(auth_users,user) = 0 then do
-/* Say 'User not authorised' */
- End
- Else Do
- Call Process Text
- If rc = 999 then exit
- End
- Iterate
- End
-
- Say 'Message 'text 'from user 'user 'at 'node
-
- end
- When code = 6 then do /* Terminal input */
- Leave
- end
- Otherwise nop
- End
-
-End
-Exit
-
-/* Process message */
-Process: Procedure Expose Text Valid User Node
-Parse Arg Action Object
-Text = Strip(Text)
-
-if fexist(FATMEN MAILFILE A3) then 'ERASE FATMEN MAILFILE A3'
-'EXECIO 1 DISKW FATMEN MAILFILE A3 (STRING ** Request received from 'user 'AT' node
-'EXECIO 1 DISKW FATMEN MAILFILE A3 (STRING 'action object
-'EXEC MAIL FATMAN (NOEDIT NOLOG FILE FATMEN MAILFILE SUBJECT 'action object
-
-If Index('LOGOFF',Action) ^= 0 then do
- "EXEC MFAT LOGOFF" object
- Queue "CP LOGOFF"
- Exit 999
- End
-If Index('SHUTDOWN',Action) ^= 0 then do
- "EXEC MFAT LOGOFF" object
- End
-If Index('STARTUP',Action) ^= 0 then do
- EXEC QFAT Text
- End
-If Index('WHO',Action) ^= 0 then do
- 'GLOBALV SELECT *EXEC STACK FATMEN'
- Pull FATMEN
- nfat = words(fatmen)
- "EXEC TELL "user "AT" node "There are "nfat" FATMEN..."
- "EXEC TELL "user "AT" node FATMEN
- End
-If Index('ADDFAT',Action) ^= 0 then do
- 'GLOBALV SELECT *EXEC STACK FATMEN'
- Pull FATMEN
- npos = wordpos(object,fatmen)
- if npos = 0 then do
- 'EXEC DEFAULTS SET FATMEN 'object
- 'GLOBALV SELECT *EXEC STACK FATMEN'
- Pull FATMEN
- nfat = words(fatmen)
- "EXEC TELL "user "AT" node "There are now "nfat" FATMEN..."
- "EXEC TELL "user "AT" node FATMEN
- end
- else do
- nfat = words(fatmen)
- "EXEC TELL "user "AT" node object "is already a fatman"
- "EXEC TELL "user "AT" node "There are currently "nfat" FATMEN..."
- "EXEC TELL "user "AT" node FATMEN
- end
- End
-If Index('REMFAT',Action) ^= 0 then do
- 'GLOBALV SELECT *EXEC STACK FATMEN'
- Pull FATMEN
- nfat = words(fatmen)
- npos = wordpos(object,fatmen)
- "EXEC TELL "user "AT" node "There are currently "nfat" FATMEN..."
- "EXEC TELL "user "AT" node FATMEN
- if npos > 0 then do
- fatmen = delword(fatmen,npos,1)
- "EXEC TELL "user "AT" node "There are now "nfat" FATMEN..."
- "EXEC TELL "user "AT" node FATMEN
- 'GLOBALV SELECT *EXEC SETPL FATMEN' fatmen
- end
- else do
- "EXEC TELL "user "AT" node "and" object" is not one of them..."
- end
- End
-Return
diff --git a/src/packlib/fatmen/scripts/rexx/fatnft.dat b/src/packlib/fatmen/scripts/rexx/fatnft.dat
deleted file mode 100644
index 08211ad..0000000
--- a/src/packlib/fatmen/scripts/rexx/fatnft.dat
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: fatnft.dat,v 1.1.1.1 1996/03/07 15:17:50 mclareni Exp $
-*
-* $Log: fatnft.dat,v $
-* Revision 1.1.1.1 1996/03/07 15:17:50 mclareni
-* Fatmen
-*
-*
-/*DECK ID>, FATNFT.EXEC */
-/* Send update to VAX using NFT */
-
-fat_date = date("JULIAN")
-fat_time = remove(time(""),':')
-fat_file = "FAT"||fat_date || " FZ" || fat_time
-
-'EXEC NFT SEND 'vax_file ' FATMEN.RDRFILE '
diff --git a/src/packlib/fatmen/scripts/rexx/fatprof.dat b/src/packlib/fatmen/scripts/rexx/fatprof.dat
deleted file mode 100644
index 6667500..0000000
--- a/src/packlib/fatmen/scripts/rexx/fatprof.dat
+++ /dev/null
@@ -1,42 +0,0 @@
-*
-* $Id: fatprof.dat,v 1.1.1.1 1996/03/07 15:17:50 mclareni Exp $
-*
-* $Log: fatprof.dat,v $
-* Revision 1.1.1.1 1996/03/07 15:17:50 mclareni
-* Fatmen
-*
-*
-/*DECK ID>, FATPROF.EXEC */
-/**********************************************************************/
- Address Command
-
- news='NONEWS'
-
- 'ACCESS 193 B'
- 'ID (STACK'
- pull me . node
- if node = 'CERNVM' then do
- 'EXEC GIME ORACLE'
- 'EXEC DB OPS (NONEWS)'
- end
-
- If QCONSOLE("DISCO") then do
- exper = userid()
- spool_nick = 'PM' || substr(exper,3)
- 'NAMEFIND :NICK' spool_nick '(LIFO'
- If rc ^= 0 then spool_to = 'JAMIE'
- else do
- Pull .
- Pull . spool_to
- Pull .
- end
-
- 'CP SPOOL CONSOLE START TO' spool_to
-
- 'EXEC TELL JAMIE 'userid() ' starting up, log spooled to 'spool_to
- 'EXEC FATSTART'
- end
- else do
- say "Type FATSTART to start FATMEN server"
- say "followed by #CP DISC"
- end
diff --git a/src/packlib/fatmen/scripts/rexx/fatpurge.dat b/src/packlib/fatmen/scripts/rexx/fatpurge.dat
deleted file mode 100644
index 6cf02d6..0000000
--- a/src/packlib/fatmen/scripts/rexx/fatpurge.dat
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: fatpurge.dat,v 1.1.1.1 1996/03/07 15:17:50 mclareni Exp $
-*
-* $Log: fatpurge.dat,v $
-* Revision 1.1.1.1 1996/03/07 15:17:50 mclareni
-* Fatmen
-*
-*
-/*DECK ID>, FATPURGE.EXEC */
-/**/
-Parse arg journal
-'ERASE' journal
diff --git a/src/packlib/fatmen/scripts/rexx/fatqueue.dat b/src/packlib/fatmen/scripts/rexx/fatqueue.dat
deleted file mode 100644
index 8220930..0000000
--- a/src/packlib/fatmen/scripts/rexx/fatqueue.dat
+++ /dev/null
@@ -1,68 +0,0 @@
-*
-* $Id: fatqueue.dat,v 1.1.1.1 1996/03/07 15:17:50 mclareni Exp $
-*
-* $Log: fatqueue.dat,v $
-* Revision 1.1.1.1 1996/03/07 15:17:50 mclareni
-* Fatmen
-*
-*
-/*DECK ID>, FATQUEUE.EXEC */
-/*---------------------------------------------------------------------*/
-/* F A T Q U E U E E X E C */
-/* ------------------------ */
-/* */
-/* Receive RDR files and add to local queue. */
-/* */
-/*---------------------------------------------------------------------*/
-
-next = "FIRST"
-fatque = "193"
-fatmode = qdisk(fatque,"MODE")
-
-Do forever
-/* Anything in the RDR? */
-
-numrdr = qspool("RDR","NUMFILES")
-
-if numrdr = 0 then exit 1
-
-/* Enough disk space? */
-
-percent = qdisk(fatque,"PERCENT")
-
-if percent > 90 then exit 2
-
-/* Can we receive this RDR file? */
-
-nrecs = qspool(NEXT,"RECNO")
-lrecl = qspool(NEXT,"LRECL")
-
-blksize = qdisk(fatque,"BLKSIZE")
-blkleft = qdisk(fatque,"BLKLEFT")
-
-nblks = (nrecs*lrecl)/blksize
-
-if nblks > blkleft then exit 3
-
-/* OK, receive this file */
-
-fatfile = QSPOOL(NEXT,"FILEID")
-spoolid = QSPOOL(NEXT,"SPOOLID")
-
-parse var fatfile fatuser fatnode
-
-/* Append to local queue */
-
-"EXEC RECEIVE" spoolid "FATMEN QUEUE (REPLACE"
-
-"EXECIO * DISKR FATMEN QUEUE A"
-
-Do queued()
-
- "EXECIO 1 DISKW "fatuser fatnode fatmode
-
-end
-
-NEXT = "NEXT"
-
-end
diff --git a/src/packlib/fatmen/scripts/rexx/fatserv.dat b/src/packlib/fatmen/scripts/rexx/fatserv.dat
deleted file mode 100644
index 1704209..0000000
--- a/src/packlib/fatmen/scripts/rexx/fatserv.dat
+++ /dev/null
@@ -1,842 +0,0 @@
-*
-* $Id: fatserv.dat,v 1.1.1.1 1996/03/07 15:17:50 mclareni Exp $
-*
-* $Log: fatserv.dat,v $
-* Revision 1.1.1.1 1996/03/07 15:17:50 mclareni
-* Fatmen
-*
-*
-/*DECK ID>, FATSERV.EXEC */
-/*---------------------------------------------------------------------*/
-/* */
-/* Generic server exec for FATMEN/PMDELPHI/CPDELPHI */
-/* ------------------------------------------------ */
-/* */
-/* Last modification: 26/03/92 */
-/* =========================== */
-/* */
-/* Based on DBL3 exec. */
-/* */
-/*---------------------------------------------------------------------*/
-Parse Source . . execname .
-
-If Index('FATSERV/DELSERV/DELCOPY/DELPSF',execname) = 0 then do
- Say 'Action not currently supported'
- Exit 999
- end
-
-If execname = 'DELSERV' then do
- if fexist('DELSERV ERRFILE') then 'ERASE DELSERV ERRFILE'
- end
-
-'IDENTIFY (LIFO'
-Parse pull username . mynode .
-if XFLAG('CPXA') then do
- NOREAD = 'NOREAD'
- IUCVMSG = 'IUCVMSG'
- end
- else do
- NOREAD = ''
- IUCVMSG = ''
- end
-
-/* Get wakeup interval */
-
-interval = "+01:00:00"
-
-"GLOBALV SELECT *EXEC STACK FMWAKEUP"
-
-pull sleep
-
-if strip(sleep) = '' then sleep = interval
-
-"GLOBALV SELECT *EXEC GET FATADDR"
-Parse var fataddr fatuser fatnode .
-
-Select
- When execname = 'FATSERV' then do
- if fexist("FATMEN RDRFILE A") then do
- Say "Unprocessed FATMEN RDRFILE exists -> will process now"
- "GLOBALV SELECT *EXEC GET FATADDR"
- Parse var fataddr fatuser fatnode .
- exit /* Fast exit if we still have a file to process */
- end
-/*
- owner.0 = 4
- owner.1 = username mynode
- owner.2 = "JAMIE CERNVM"
- owner.3 = "FATONE"
- owner.4 = "HRRCR"
-
- operator.0 = 3
- operator.1 = "OPSUTIL"
- operator.2 = "CONSOLE"
- operator.3 = "LEPSERV"*/
-
-/* Build list of FAT owners and operators */
-fatstaff = 'FATOWNERS FATOPERATORS'
-
-Do j = 1 to 2
-current = word(fatstaff,j)
-'NAMEFIND :NICK 'current'(STACK'
-If RC = 32 then do
- ic = setvar(stem'.0',0)
- end
-
- else do
- stem = substr(current,4,length(current)-4)
- Pull line
- Pull . line
-/* stem.0 = words(line) */
- ic = setvar(stem'.0',words(line))
- do i = 1 to words(line)
- current = word(line,i)
- 'NAMEFIND :NICK 'current'(STACK'
- If RC = 32 then do
- address = current mynode
- ic = setvar(stem'.'i,address)
- end
- else do
- Pull .
- Pull . user
- Pull . node
- address = user node
- ic = setvar(stem'.'i,address)
- end
- end
- end
-
-end
- end
- When execname = 'DELSERV' | execname = 'DELCOPY' | ,
- execname = 'DELPSF' then do
- owner.0 = 4
- owner.1 = username mynode /* this must be here always */
- owner.2 = "JAMIE CERNVM"
- owner.3 = "PALERMO CERNVM"
- owner.4 = "NICK CERNVM"
-
- operator.0 = 2
- operator.1 = "OPSUTIL"
- operator.2 = "CONSOLE"
- end
- otherwise nop
-end /* Select on EXECNAME */
-
-validmsg.0 = 15
-validmsg.1 = "HELP = display this list"
-validmsg.2 = "HELLO = check if server is active"
-validmsg.3 = "STOP = stop server"
-validmsg.4 = "QDISK (QUERY_DISK_parameters) (,File) "
-validmsg.5 = "QSPOOL = return number of spool files"
-validmsg.6 = "DROP fmode (fmode) (...)"
-validmsg.7 = "GIME gime_parameters_and_options"
-validmsg.8 = "*FATLOG* = log FATMEN request "
-validmsg.9 = "CLOSE = close console log and send to JAMIE"
-validmsg.10 = "NEWLOG = start new "execname "log"
-validmsg.11 = "FINIS = close "execname "log"
-validmsg.12 = "SETPW"
-validmsg.13 = "LOGOFF"
-validmsg.14 = "PURGE = purge old FAT* FZ* journal files"
-validmsg.15 = "WAKEUP = simulate arrival of new RDR file"
-
-Stop = 999999
-
-/* Issue WAKEUP and wait for new RDR files ... */
-
-wait:
-
-'DROPBUF'
-'CP SET MSG IUCV'
- Do Forever
-
- Call wakeup_wait
- RC = Result
- Select
- When RC = 6 then do /* Console attention */
- Signal Stop
- Call Logmes execname mynode "Stop"
- End
-
-/* When RC = 3 then do /* time */
- time = 'TIME'("S")
- do i = 1 to times.0
- timediff = time-times.i
- If timediff >= 0 & timediff < 5 then leave
- End
- If i <= times.0 then do
- Call logmes execname mynode "TIME" time
- nomsg = 1
- end
- nomsg = 0
- End */
-
- Otherwise do
- End
- End
-End /*Do Forever*/
-
-/*=================== W A K E U P - W A I T ========================*/
-
-wakeup_wait:
-if fexist("$ORACLE$ $OSDPRT$") then do
- "ERASE $ORACLE$ $OSDPRT$"
- end
-'WAKEUP' sleep '(RDR' NOREAD IUCVMSG
-code = rc
-/* P r o c e s s m e s s a g e */
-
-Select
-
- When code = 2 then do /* Timer expired */
- if username = 'FMFATCAT' then do
- Say 'Wakeup at 'date() time()
- exit 99
- end
- end
-
- When code = 4 then do /* New RDR file */
- Say 'New RDR file received'
- call check_sp /* Check disk space */
- temp = QSPOOL("FIRST")
- Parse var temp origin spoolid class fna fty .
- fattype = QSPOOL("FIRST","TYPE")
- if fattype = 'CON' then do
- Say 'Purging console file ...'
- 'CP PURGE RDR 'spoolid
- end
- fatuser = QSPOOL("FIRST","ORIGINID")
- fatnode = QSPOOL("FIRST","FROMNODE")
-
-/* Fix user and node name for files arriving from Cray station */
-
- if fatuser = "CRNCRAYX" & fatnode = "CERNVM" then do
- fatuser = username
- fatnode = "SN201"
- end
-
- "GLOBALV SELECT *EXEC SETPL FATADDR " fatuser fatnode
-
- If class = "U" & index(origin,'ORA') ^= 0 then do
- Say origin spoolid class
- Say 'Log file from ORACLE - purge'
- 'CP PURGE R' spoolid
- Return 1
- end
-
- If fty = "MAIL" | fty = "NOTE" then do
- "CP PURGE RDR" spoolid
- Say purging mail file...
- Return 1
- End/* End of MAIL handling */
-/* Receive RDR file and then exit */
- /* call queue_rdr*/
- Select
- When execname = 'FATSERV' then do
- 'EXEC Receive 'spoolid 'FATMEN RDRFILE (REPLACE)'
- "GLOBALV SELECT *EXEC STACK FATUPDATES"
- pull fatupdates
- if strip(fatupdates) = '' then fatupdates = 0
- fatupdates = fatupdates + 1
- 'GLOBALV SELECT *EXEC SETPL FATUPDATES 'fatupdates
- 'GLOBALV INIT'
-
-/* Number of pending RDR files */
-
- nfiles = QSPOOL("RDR","NUMFILES")
- "GLOBALV SELECT *EXEC SETPL FATFILES "nfiles
-
- Exit
- end
- When execname = 'DELSERV' then do
- 'GLOBALV SELECT *DELPHI SET origin 'origin
- 'EXEC Receive 'spoolid 'DELPHI MINIPSF (REPLACE)'
- 'COPY DELPHI MINIPSF A (REPLACE LRECL 132 RECFM F)'
- Exit
- end
- When execname = 'DELCOPY' then do
- 'EXEC Receive 'spoolid 'DELPHI MINIPSF (REPLACE)'
- 'EXEC DELCP'
- end
- When execname = 'DELPSF' then do
- 'EXEC Receive 'spoolid 'DELPHI MINIPSF (REPLACE)'
- 'EXEC APPPSF'
- end
- Otherwise nop
- End
- End
-
- When code = 5 then do /* New MSG */
- Pull text
- Parse var text . user text
-/* Say 'New MSG received'*/
-
-/* HCPMID6001I TIME IS 00:00:00 SET MONDAY 03/23/92 */
-
-/* Special processing for wakeup at midnight */
-
- if index(text,'TIME IS 00:00:00') ^= 0 then do
- 'GLOBALV SELECT *EXEC STACK FATUPDATES'
- pull fatupdates
- if strip(fatupdates) = '' then fatupdates = 0
- Say '**** ' fatupdates ' updates processed in last 24 hours '
- 'GLOBALV SELECT *EXEC SETPL FATUPDATES 0'
- 'GLOBALV INIT'
- return
- end
-
- If user = XNAME("RSCSID") | user = "DECMCS" then do
- Parse Var text . "FROM" user_node text
- Parse Var user_node node "(" user ")" .
- If user = "" | DATATYPE(user,"N") then Return 1
- End
- Else do
- node = mynode
- End
- If index(text,"*GONE") ^= 0 then Return /* Ignore GONE messages */
- If index(user,"DECSTG") ^= 0 then Return /* Ignore DECSTG% messages */
- If user = 'MAILER' then Return /* Don't process messages from MAILER */
- If user = "MAILER" then Return 1
- Call process_msg
- Return result
- end
- When code = 6 then do /* Console interrupt */
- Say ""
- Say "Stopping due to CONSOLE interrupt at "date() time()
- Say "Stopping due to CONSOLE interrupt at "date() time()
- Say ""
- Signal stop
- end
- Otherwise nop
- End
-
-Return
-
-/*====================== L o g m e s ========================*/
-
-Logmes: Procedure Expose execname Nextwork stop owner.
-Trace Off
-
-Parse arg user node action text
-
- day = DATE("O")
- tim = TIME()
- line = day tim ,
- LEFT(user,8) LEFT(node,8) LEFT(action,8) text
- Call Check_A "Logging" line
- 'EXECIO 1 DISKW 'execname' LOG A ( VAR LINE '
-
-Return 0
-
-/*====================== H a l t ==============================*/
-
-Halt:
-
-Call Logmes execname XNAME("NODEID") "ERROR" "Halt at line" sigl
-Signal Stop
-
-/*====================== S y n t a x ========================*/
-
-Syntax:
-
-Call Logmes execname XNAME("NODEID") "ERROR" "Syntax error at line" sigl
-Signal Stop
-
-/*====================== N o v a l u e =====================*/
-
-Novalue:
-
-Call Logmes execname XNAME("NODEID") "ERROR" "Undefined variable at line" sigl
-Signal Stop
-
-/*====================== C h e c k _ f m ==================*/
-
-Check_fm: Procedure Expose execname Nextwork stop owner.
-Trace Off
-Parse Arg fm,blkneed
-
-mynode = XNAME("NODEID")
-If ^QDISK(fm,'RW') then do
- text = "Not write access to my" fm "disk"
- Call warning text
- Return -2
-End
-lim = 10
-blkmin = 30
-blkleft = QDISK(fm,'BLKLEFT')
-If blkleft < blkmin then do
- text = "Disk space = "blkleft" blocks in my" fm "disk"
- Call warning text
- Return -1
-End
-If blkleft < blkmin+blkneed then irc = Nextwork
-Else irc = 0
-
-blktot = QDISK(fm,'BLKTOT')
-left = 100 * blkleft/blktot
-If left < lim then do
- If ^FEXIST(execname "LESS"lim fm) then do
- line = "Disk space: Only " FORMAT(left,3,1)"% free "
- 'EXECIO 1 DISKW' execname 'LESS'lim fm '1 ( VAR LINE FINIS'
- text = line "on my" fm "disk"
- Call warning text
- End
-End
-Else do
- If FEXIST(execname "LESS"lim fm) then 'ERASE' execname 'LESS'lim fm
-End
-Return irc
-
-/*====================== C h e c k _ s p ==================*/
-
-Check_sp: Procedure Expose username execname Nextwork stop owner.
-Trace Off
-
-permax = 90
-perused = QDISK('A','PERCENT')
-If perused > permax then do
- text = perused "% of A-disk in use - performing cleanup "
- Call warning text
- Say text
- "EXEC SENDFILE "execname "LOG TO JAMIE AT CERNVM"
- Call warning "Erasing "execname "LOG"
- "ERASE "execname "LOG"
- Call warning "Erasing "username "NETLOG"
- "ERASE "username "NETLOG"
- perused = QDISK('A','PERCENT')
- text = perused "% of A-disk in use after cleanup "
- Call warning text
- If perused > permax then do
- Call warning "Clean-up failed - exiting"
- Exit 999
- End
- Return 0
-End
-
-/*====================== C h e c k _ A =====================*/
-
-Check_A:
-Trace Off
-Parse arg mssg
-
-irc = Check_fm("A",0)
-If irc <= -2 then do
- Say mssg
- Signal Stop
-End
-If irc = - 1 then do
- If QFILE(execname "LOG A","BLKNO") > 10 then do
- 'EXEC SENDFILE 'execname' LOG A TO 'XNAME("USERID")' ( NOLOG'
- 'ERASE 'execname' LOG A'
- If Check_fm("A",0) < 0 then do
- Say mssg
- Signal Stop
- End
- Else Return 0
- End
- Else do
- Say mssg
- Signal Stop
- End
-End
-Return 0
-
-/*====================== O p e r a t o r ==================*/
-
-Operator: Procedure Expose execname stop owner. operator. mynode
-
-Parse arg user , node
-If node ^= mynode then Return -1
-do i=1 to operator.0
- If operator.i = user then Return 0
-End
-
-Return -1
-
-
-/*====================== A u t h o r i z e ===============*/
-
-Authorize: Procedure Expose execname stop owner.
-
-Parse arg user , node
-
-do i=1 to owner.0
- Parse Var owner.i usero nodeo
- If user = usero then do
- If nodeo = "" | node = nodeo then Return 0
- End
-End
-
-Return -1
-
-/*====================== P r o c e s s _ m s g ===================*/
-
-Process_msg:
-/*Say text*/
-action = SUBSTR(WORD(text,1),1,4," ")
-Select
-
- When action = "QSPO" then do
- If Authorize(user,node) = 0 | operator(user,node) = 0 then do
- Call Logmes user node "Qspool "
- n_files = QSPOOL("RDR","NUMFILES")
- Call Send_msg user node "I have "n_files" files in my RDR"
- End
- Else Do
- Call Logmes user node "NOAUTHO" text
- Call send_msg user node "Not authorized"
- End
- End
-
- When action = "STOP" then do
- If Authorize(user,node) = 0 | operator(user,node) = 0 then do
- Call Logmes user node "Stop "
- Call Send_msg user node "Stop"
- Signal Stop
- End
- Else Do
- Call Logmes user node "NOAUTHO" text
- Call send_msg user node "Not authorized"
- End
- End
-
- When action = "LOGO" then do
- If Authorize(user,node) = 0 | operator(user,node) = 0 then do
- Call Logmes user node "Logoff "
- Call Send_msg user node "Logoff"
- Queue "CP LOGOFF"
- Signal Stop
- End
- Else Do
- Call Logmes user node "NOAUTHO" text
- Call send_msg user node "Not authorized"
- End
- End
-
- When action = "WAKE" then do
- If Authorize(user,node) = 0 | operator(user,node) = 0 then do
- Call Logmes user node "WAKEUP"
- Call Send_msg user node "Thanks for the alarm call"
- Exit 99
- End
- Else Do
- Call Logmes user node "NOAUTHO" text
- Call send_msg user node "Not authorized"
- End
- End
-
- When action = "PURG" then do
- If Authorize(user,node) = 0 | operator(user,node) = 0 then do
- Call Logmes user node "PURGE"
- Call Send_msg user node "Purging journal files..."
- 'LISTFILE FAT* FZ* B (E'
- 'CMS EXEC PURGE'
- End
- Else Do
- Call Logmes user node "NOAUTHO" text
- Call send_msg user node "Not authorized"
- End
- End
-
- When action = "HELL" then do
- If Authorize(user,node) = 0 | operator(user,node) = 0 then do
- Call Logmes user node "Hello "
- Call Send_msg user node "Hello and how are you today?"
- End
- Else Do
- Call Logmes user node "NOAUTHO" text
- Call send_msg user node "Not authorized"
- End
- End
-
- When action = "HELP" then do
- If Authorize(user,node) = 0 then do
- Call Logmes user node text
- Call Help
- End
- Else Do
- Call Logmes user node "NOAUTHO" text
- Call send_msg user node "Not authorized"
- End
- End
-
- When action = "NEWL" then do
- If Authorize(user,node) = 0 then do
- "FINIS "execname "LOG"
- "ERASE "execname "LOG"
- Call Logmes user node text
- Call send_msg user node "Old "execname "log erased"
- End
- Else Do
- Call Logmes user node "NOAUTHO" text
- Call send_msg user node "Not authorized"
- End
- End
-
- When action = "FINI" then do
- If Authorize(user,node) = 0 then do
- "FINIS "execname "LOG"
- Call Logmes user node text
- Call send_msg user node execname "log closed"
- End
- Else Do
- Call Logmes user node "NOAUTHO" text
- Call send_msg user node "Not authorized"
- End
- End
-
- When action = "SETP" then do
- If Authorize(user,node) = 0 then do
- Parse var text wud pw .
-/* "GLOBALV SELECT *EXEC SETPL PWD "pw
- "GLOBALV INIT" */
- "EXEC RACKF" pw
- Call Logmes user node wud
- Call send_msg user node "SETPW processed"
- Call Logmes user node "Logoff after pw change"
- Call Send_msg user node "Logoff after pw change"
- "CP LOGOFF"
- End
- Else Do
- Call Logmes user node "NOAUTHO" text
- Call send_msg user node "Not authorized"
- End
- End
-
- When action = "CLOS" then do
- If Authorize(user,node) = 0 then do
- Call Logmes user node text
- "CP SPOOL CONSOLE CLOSE"
- saverc = Result
- Call Send_msg user node text "processed."
- Return saverc
- End
- Else Call Logmes user node "NOAUTHO" text
- End
-
- When action = "QQUE" then do
- If Authorize(user,node) = 0 then do
- Call Logmes user node text
- Call qqueue text
- End
- Else Call Logmes user node "NOAUTHO" text
- End
-
- When action = "QDIS" then do
- If Authorize(user,node) = 0 then do
- Call Logmes user node text
- Call q_disk text
- End
- Else Call Logmes user node "NOAUTHO" text
- End
-
- When action = "DROP" then do
- If Authorize(user,node) = 0 then do
- Call Logmes user node text
- Call drop text
- End
- Else Call Logmes user node "NOAUTHO" text
- End
-
- When action = "GIME" then do
- If Authorize(user,node) = 0 then do
- Call Logmes user node text
- Call gime text
- End
- Else Call Logmes user node "NOAUTHO" text
- End
-
- When action = "CHQU" then do
- If Authorize(user,node) = 0 then do
- Call Logmes user node text
- Call chqueue text
- Return result
- End
- Else Call Logmes user node "NOAUTHO" text
- End
-
- When action = "*FAT" then do
- Call Logmes user node text
- End
-
- When action = "CHJO" then do
- If Authorize(user,node) = 0 then do
- Call Logmes user node text
- Call chjour text
- Return result
- End
- Else Call Logmes user node "NOAUTHO" text
- End
-
- Otherwise do
- If Authorize(user,node) = 0 then do
- Call send_msg user node "Invalid command" text
- Call Help
- End
- Call Logmes user node "BAD_MSG" text
- End
-End
-
-Return 1
-
-/*====================== H e l p ==============================*/
-
-Help:
-parse arg ihelp
-
-If DATATYPE(ihelp,"N") & ihelp > 0 & ihelp <= validmsg.0 then do
- Call Send_msg user node validmsg.ihelp
-End
-Else do
- Call Send_msg user node "The valid commands are:"
- do i=1 to validmsg.0
- Call Send_msg user node validmsg.i
- End
-End
-Return 0
-
-/*====================== S e n d _ m s g ==================*/
-
-Send_msg: Procedure Expose execname stop owner.
-Parse arg user node stext
-mynode = XNAME("NODEID")
-If user = XNAME("USERID") & node = mynode then Say stext
-Else do
- If node = mynode then 'CP MSG' user stext
- Else 'EXEC TELL' user 'AT' node stext
-End
-Return 0
-
-/*====================== C h e c k _ f i l e =====================*/
-
-Check_file:
-
-Parse arg fname,ftype,fuser,faddr
-
-If faddr ^= QDISK(Buffm,"ADDRESS") | fuser ^= XNAME("USERID") then do
- 'EXEC GIME 'fuser faddr '(STACK QUIET'
- If RC > 4 then Return -2
- Parse Pull fmode .
- idrop = 1
-End
-Else do
- fmode = Buffm
- idrop = 0
-End
-
-iexist = FEXIST(fname ftype fmode) - 1
-If iexist = 0 then do
- blkno = QFILE("=","BLKNO")
- blksize = QDISK(fmode,"BLKSIZE")
- size = FORMAT(blkno*blksize/1000,6,1)
-End
-If idrop then 'EXEC DROP 'fmode
-
-Return iexist
-
-/*====================== S t o p ==============================*/
-
-Stop:
- text = 'STOP'
- call warning text
-If FEXIST(execname "AUXLOG A") Then 'ERASE 'execname' AUXLOG A'
-
-Exit stop
-
-/*====================== W a r n i n g =====================*/
-
-Warning:
-
-Parse arg msg
-do i = 2 to owner.0
- Parse var owner.i user node
- If node = "" then node = XNAME("NODEID")
- Call mail user node msg
-End
-Return 0
-
-/*====================== M a i l ==============================*/
-
-Mail: Procedure Expose execname stop owner.
-
-Parse Arg user node text
-test = 1
-If ^test then
- 'EXEC MAIL' user 'AT' node '(NOPROMPT NOLOG NOEDIT FILE DUMMY MAIL A',
- 'SUBJECT' execname 'AT' XNAME("NODEID")':' text
-Else Call Send_msg user node text
-Return 0
-
-/*====================== R e c e i v e =====================*/
-
-Receive:
-
-Parse Arg spoolid fname ftype fmode
-
-'EXECIO 0 CP ( STRING ORDER READER' spoolid
-Do forever
- 'EXECIO 1000 CARD (STEM BUFF. '
- Rcsave = RC
- 'EXECIO' Buff.0 'DISKW' fname ftype fmode '0 F 80 ( STEM BUFF. '
- If Rcsave = 2 then leave
-End
- 'FINIS' fname ftype fmode
-
-Return 0
-
-/*====================== D r o p ==============================*/
-
-Drop:
-
-Parse arg . fm
-'EXEC DROP 'fm' ( QUIET'
-Call Send_msg user node "DROP "fm" ===> Rc="RC
-Return 0
-
-/*====================== G i m e ==============================*/
-
-Gime:
-
-Parse arg . fm
-'MAKEBUF'
-ibuf = Rc
-'EXEC GIME 'fm' ( QUIET STACK'
-rcsave = rc
-If rcsave <= 4 then Parse pull fmode .
-'DROPBUF' ibuf
-Call Send_msg user node "GIME "fm" ===> Rc="rcsave "fm="fmode
-Return 0
-
-/*====================== Q d i s k ===========================*/
-
-Q_disk:
-
-Parse arg . rest
-Parse Var rest opt "," ifile
-mynode = XNAME("NODEID")
-ifile = 'ABBREV'('WORD'(ifile,1),"F")
-'MAKEBUF'
-buffn = Rc
-'QUERY DISK 'opt'( STACK'
-Queue ""
-If ifile then do
- If node = mynode then do
- 'CP SPOOL PUNCH TO 'user
- End
- Else do
- 'CP SPOOL PUNCH TO 'XNAME("RSCSID")
- 'CP TAG DEV PUNCH 'node user
- End
- 'EXECIO * PUNCH '
- 'CP CLOSE PUNCH NAME' execname 'QDISK'
- 'CP SPOOL PUNCH OFF'
- If node ^= mynode then 'CP TAG DEV PUNCH'
-End
-Else do forever
- Parse pull line
- If line = "" then leave
- Call Send_msg user node line
-End
-'DROPBUF' buffn
-Return 0
-
diff --git a/src/packlib/fatmen/scripts/rexx/fatstack.dat b/src/packlib/fatmen/scripts/rexx/fatstack.dat
deleted file mode 100644
index 2d1b696..0000000
--- a/src/packlib/fatmen/scripts/rexx/fatstack.dat
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: fatstack.dat,v 1.1.1.1 1996/03/07 15:17:50 mclareni Exp $
-*
-* $Log: fatstack.dat,v $
-* Revision 1.1.1.1 1996/03/07 15:17:50 mclareni
-* Fatmen
-*
-*
-/*DECK ID>, FATSTACK.EXEC */
-/* Exec to Stack a line (LIFO or FIFO) */
-Parse arg line '(' options ')' .
-options = translate(options)
-Say 'FATSTACK. enter for arg=' line ' options = 'options
-if strip(options) = '' then options = 'FIFO'
-if options ^= 'FIFO' & options ^='LIFO' then do
- Say 'Invalid option: 'options
- Exit 1
- end
- else do
- if options = 'FIFO' then queue line
- else push line
- Exit 0
- end
diff --git a/src/packlib/fatmen/scripts/rexx/fatstart.dat b/src/packlib/fatmen/scripts/rexx/fatstart.dat
deleted file mode 100644
index 34c4743..0000000
--- a/src/packlib/fatmen/scripts/rexx/fatstart.dat
+++ /dev/null
@@ -1,37 +0,0 @@
-*
-* $Id: fatstart.dat,v 1.1.1.1 1996/03/07 15:17:50 mclareni Exp $
-*
-* $Log: fatstart.dat,v $
-* Revision 1.1.1.1 1996/03/07 15:17:50 mclareni
-* Fatmen
-*
-*
-/*DECK ID>, FATSTART.EXEC */
-/* F A T _ S T A R T */
- If QCONSOLE("DISCO") then nop
- else do
- Say "+++ Type #CP DISC to disconnect +++"
- Say "+++ Type #CP DISC to disconnect +++"
- Say "+++ Type #CP DISC to disconnect +++"
- end
-'IDENTIFY (STACK'
-Parse pull . . locnode .
-
-If locnode = 'CERNVM' then do
-
-/* Start FAT_server FORTRAN Program, which calls FATSERV EXEC */
- 'EXEC GIME JAMIE (NONOTICE'
- 'EXEC ORARUN FATSRV ' /*FATMEN*/
- end
-
- else do
-
-/* Start FAT_Rserver FORTRAN Program, which calls FATSERV EXEC */
- 'NAMEFIND :NICK FATGRP (STACK'
- If RC^=0 then 'ID (STACK'
- Pull FATMAN .
- 'EXEC CERNLIB'
- 'LOADMOD FATSRV'
- 'START'
-
- end
diff --git a/src/packlib/fatmen/scripts/rexx/fatsub.dat b/src/packlib/fatmen/scripts/rexx/fatsub.dat
deleted file mode 100644
index 00ae2f7..0000000
--- a/src/packlib/fatmen/scripts/rexx/fatsub.dat
+++ /dev/null
@@ -1,73 +0,0 @@
-*
-* $Id: fatsub.dat,v 1.1.1.1 1996/03/07 15:17:50 mclareni Exp $
-*
-* $Log: fatsub.dat,v $
-* Revision 1.1.1.1 1996/03/07 15:17:50 mclareni
-* Fatmen
-*
-*
-/*DECK ID>, FATSUB.EXEC */
-/*---------------------------------------------------------------------*/
-/* F A T S U B E X E C */
-/* ------------------------ */
-/* */
-/*---------------------------------------------------------------------*/
-
-Parse upper arg fn ft fm . remuser . remnode
-
-'NAMEFIND :NICK 'remuser ':JOBCARD (STACK'
-Pull jobcard
-
-If strip(jobcard) = '' then do
- Say 'Error - no job card for 'remuser 'at' remnode
- exit 9
-end
-
-'ID (LIFO'
-
-Pull me . mynode .
-
-code = cpush('PUN')
-if code ^= 0 then call ABEND code "Return code" code "from CPUSH PUN."
-
-"CP TAG DEV PUNCH "remnode remuser
-code = RC
-if code ^= 0 then call ABEND code "Return code" code "from CP TAG."
-
-/* Now, punch the job card and the JCL */
-
-'EXECIO 1 PUNCH (STRING 'jobcard
-
-'EXECIO 1 PUNCH (STRING // EXEC PGM=IEBGENER'
-'EXECIO 1 PUNCH (STRING //SYSIN DD DUMMY'
-'EXECIO 1 PUNCH (STRING //SYSPRINT DD SYSOUT=*'
-'EXECIO 1 PUNCH (STRING //SYSUT2 DD UNIT=FAST,SPACE=(1,1),DISP=(NEW,CATLG),'
-
-fat_date = date("JULIAN")
-fat_time = remove(time(""),':')
-fat_file = "FAT"||fat_date || fat_time
-
-fatfile = remuser//'.TODO.'// me // '_' // mynode // '.' // fat_file
-
-'EXECIO 1 PUNCH (STRING // DSN='//fatfile
-'EXECIO 1 PUNCH (STRING //SYSUT1 DD *'
-
-nprev = queued()
-"EXECIO * DISKR" fn ft fm
-"FINIS "fn ft fm
-
-nlines = queued() - nprev
-do nlines
- 'EXECIO 1 PUNCH'
-end
-
-'EXECIO 1 PUNCH (STRING //'
-
-"CP CLOSE PUNCH"
-code = cpop('pun')
-if code ^= 0 then call ABEND code "Return code" code "from CPOP PUN."
-Exit
-
-ABEND:
-Parse Arg abend_code text
-Say text
diff --git a/src/packlib/fatmen/scripts/rexx/fatuse.dat b/src/packlib/fatmen/scripts/rexx/fatuse.dat
deleted file mode 100644
index 6109277..0000000
--- a/src/packlib/fatmen/scripts/rexx/fatuse.dat
+++ /dev/null
@@ -1,138 +0,0 @@
-*
-* $Id: fatuse.dat,v 1.1.1.1 1996/03/07 15:17:50 mclareni Exp $
-*
-* $Log: fatuse.dat,v $
-* Revision 1.1.1.1 1996/03/07 15:17:50 mclareni
-* Fatmen
-*
-*
-/*DECK ID>, FATUSE.EXEC */
-/*---------------------------------------------------------------------*/
-/* F A T U S E E X E C */
-/* ---------------------- */
-/* */
-/* 12/04/90 Modified to count FINDs and MAKEs rather than GETs */
-/* 03/04/90 J.D. Shiers */
-/* */
-/* EXEC to measure FATMEN usage from FATSERV LOG files on server disks.*/
-/* For a given group, counts: Number of users */
-/* For each user, counts: Number of INITs, Number of FINDs, MAKEs */
-/* */
-/*---------------------------------------------------------------------*/
-Parse upper arg fatgroup from to '(' opt .
-
-If fatgroup = '' then do
- Say "Please supply name of group"
- exit 1
- end
-
-Say 'Look at usage statistics for group 'fatgroup
-
-If strip(from) ^= '' then Say "From "from
- else from = '00/00/00'
-If strip(to) ^= '' then Say "To "to
- else to = '99/99/99'
-
-If substr(fatgroup,1,2) ^= 'FM' then fatgroup = 'FM' || fatgroup
-
-'EXEC GIME 'fatgroup '(NONOTICE QUIET STACK'
-Pull fatmode .
-'EXECIO * DISKR FATSERV LOG 'fatmode
-
-nusers = 0
-fusers = ''
-ninit = 0
-nshell = 0
-nfind = 0
-nmake = 0
-nstrange = 0
-nline = 0
-nlines = queued()
-
-Do queued()
- Pull line
- nline = nline + 1
-
- If nline = 1 then parse var line sd st .
- If nline = nlines then parse var line ed et .
-
- If index(line,'*FATLOG*') = 0 then iterate
- Parse var line dd .
- If dd < from then iterate
- If dd > to then iterate
-
- Parse var line . '*FATLOG*' . fuser facc . verb noun adjective .
-
-/* Encountered this user already? */
-
- If index(fusers,fuser||'/') = 0 then do
- nusers = nusers + 1
- fusers = fusers || fuser || '/'
- end
-
-
-/* Count number of INITs, FINDs and MAKEs */
-
- Select
-
- When verb = 'INIT' then do
- If adjective = 'SHELL' then nshell = nshell + 1
- else ninit = ninit + 1
- end
-
- When verb = 'FMFIND.' then do
- nfind = nfind + 1
- end
-
- When verb = 'FMMAKE.' then do
- nmake = nmake + 1
- end
-
- When verb = 'END' then do
- end
-
- Otherwise do
- nstrange = nstrange + 1
- end
-
- end /*Select*/
-
- end
-
-len = 69 + length(fatgroup)
-equals = copies('=',len)
-
-Say 'FATMEN log for group 'fatgroup 'runs from 'sd st' to 'ed et
-Say equals
-Say ''
-Say 'Selected period: 'from ' to 'to
-Say ''
-Say 'Total number of users = 'nusers
-Say 'Total number of INITs (FORTRAN) = 'ninit
-Say 'Total number of INITs (SHELL) = 'nshell
-Say 'Total number of FINDs = 'nfind
-Say 'Total number of MAKEs = 'nmake
-Say 'Total number of unrecognised lines = 'nstrange
-
-'EXEC DROP 'fatmode '(QUIET)'
-
-if opt = '' then exit
-
-
-fn = "FATUSERS "||substr(fatgroup,3) || ' ' || qdisk("MAX","MODE")
-
-Say 'List of users will be stored in 'fn
-
-if fexist(fn) then "ERASE "fn
-
-fusers = translate(fusers,' ','/')
-
-i = 0
-
-do words(fusers)
-i = i + 1
- fuser = word(fusers,i)
- "EXECIO 1 DISKW "fn "(STRING" fuser
- end
-
- "FINIS "fn
diff --git a/src/packlib/fatmen/scripts/rexx/fm.dat b/src/packlib/fatmen/scripts/rexx/fm.dat
deleted file mode 100644
index d79f5e9..0000000
--- a/src/packlib/fatmen/scripts/rexx/fm.dat
+++ /dev/null
@@ -1,61 +0,0 @@
-*
-* $Id: fm.dat,v 1.1.1.1 1996/03/07 15:17:50 mclareni Exp $
-*
-* $Log: fm.dat,v $
-* Revision 1.1.1.1 1996/03/07 15:17:50 mclareni
-* Fatmen
-*
-*
-/*DECK ID>, FM.EXEC */
-/**********************************************************************
- * *
- * FATMEN EXEC V1.03 *
- * *
- * user interface to FATMEN MODULE *
- * *
- * Author: M.Marquina 90/01/29 *
- * *
- * Mods Date Comments *
- * MARQUINA 90/05/22 Use GETVER to find the version *
- * 91/02/24 Support PF-keys, check storage *
- * JAMIE 91/05/16 Do not pop or push filesdefs *
- * *
- **********************************************************************/
- Address Command
- Arg parms "(" options
- Parse Source . . xfn .
- xfn="FATMEN"
-
- If ^'QSTOR'("5M") Then Call ERROR 1 8 "5M"
-
- vn='GETVER'(options,"LINK")
- vv=""
- If vn^="PRO" Then Do
- vv='LEFT'(vn,1)"_"
- Say
- Say "Calling" vn "version of" xfn"..."
- Say
- End
-
- If vn='NEW' Then Do
- 'EXEC GIME TESTSOFT (QUIET NONOTICE'
- 'NUCXDROP *'
- End
-
- nw='FIND'(options,vn)
- If nw>0 Then options='DELWORD'(options,nw,1)
-
- If options^="" Then parms=parms "("options
- pgm=vv||xfn
- prc='XCPUSH'("PFK","SET")
- 'FILEDEF 6 TERM (LRECL 133'
-
- 'IDENTIFY ( LIFO' ; Pull . . site .
- If site="CERNVM" Then 'EXEC UMLOG FATMEN 0' vn parms
- 'EXEC USERPF' xfn /* Set FATMEN PF-keys */
- pgm parms
- cc=rc
- If site="CERNVM" Then 'EXEC UMLOG FATMEN 1' vn parms
-
- If prc=0 Then rc='XCPOP'("PFK","SET")
- Exit cc
diff --git a/src/packlib/fatmen/scripts/rexx/mkfatnew.dat b/src/packlib/fatmen/scripts/rexx/mkfatnew.dat
deleted file mode 100644
index be4184c..0000000
--- a/src/packlib/fatmen/scripts/rexx/mkfatnew.dat
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: mkfatnew.dat,v 1.1.1.1 1996/03/07 15:17:50 mclareni Exp $
-*
-* $Log: mkfatnew.dat,v $
-* Revision 1.1.1.1 1996/03/07 15:17:50 mclareni
-* Fatmen
-*
-*
-/*DECK ID>, MKFATNEW.EXEC */
-/*---------------------------------------------------------------------*/
-/* */
-/* FATNEW EXEC. */
-/* */
-/*---------------------------------------------------------------------*/
-'EXEC CERNLIB'
-FREE_BLOCKS = QDISK("191","BLKLEFT") /* Look how many blocks are left
- on 191 disk */
-/* Now define FATSYS and FATGRP. These will be used by FATNEW to
- generate an RZ file named fatsys.FATRZ with a top-directory
- //fatsys/fatgrp.
-
- e.g. for FATSYS = IN2P3, FATGRP = BUGEY
-
- //IN2P3/BUGEY in file IN2P3.FATRZ.A6
-*/
-/*FATGRP = 'BUGEY'*/
-/*FATSYS = 'IN2P3'*/
-Say
-Say "Please give the name of the FATMEN system. This name forms"
-Say "the top-level of the FATMEN catalogue,"
-Say "e.g. CERN, FNAL, DESY etc."
-Say
-Say "Please give the name of the FATMEN system"
-Pull FATSYS
-Say
-Say "Please give the name of the FATMEN group"
-Pull FATGRP
-
-Address Command
-
-'FATNEW'
diff --git a/src/packlib/fatmen/scripts/sql/addgroup.F b/src/packlib/fatmen/scripts/sql/addgroup.F
deleted file mode 100644
index bcd0a2f..0000000
--- a/src/packlib/fatmen/scripts/sql/addgroup.F
+++ /dev/null
@@ -1,169 +0,0 @@
-*
-* $Id: addgroup.F,v 1.1.1.1 1996/03/07 15:17:51 mclareni Exp $
-*
-* $Log: addgroup.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:51 mclareni
-* Fatmen
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_fatmen/pilot.h"
-
-#if defined(CERNLIB_ORACLE)
-INSERT INTO Fatmen VALUES ('CERN', 'THRONG')
-/
-
-REM *** SPECIFIC TABLES FOR THRONG
-REM *** Note: 1) CHAR(240) => Oracle V5.1
-REM *** 2) TMS later substitutes Volumes_
-
-
-CREATE TABLE GNames_THRONG ( GName CHAR(240) NOT NULL,
- GN# NUMBER NOT NULL)
-/
-CREATE TABLE Files_THRONG ( File# NUMBER NOT NULL,
- GN# NUMBER NOT NULL,
- Copylevel NUMBER(2) NOT NULL,
- Location NUMBER NOT NULL,
- Hostname CHAR(8) NOT NULL,
- Fullname CHAR(240) NOT NULL,
- Hosttype CHAR(16),
- Opersys CHAR(12),
- Fileformat CHAR(4) NOT NULL,
- Userformat CHAR(4),
- Startrec# NUMBER,
- Endrec# NUMBER,
- Startblk# NUMBER,
- Endblk# NUMBER,
- Recformat CHAR(4),
- Reclength NUMBER,
- Blklength NUMBER,
- Creation DATE,
- Catalogation DATE,
- Lastaccess DATE,
- Active CHAR(1) NOT NULL,
- Creatorname CHAR(8),
- Creatoraccount CHAR(8),
- Creatornode CHAR(8),
- Creatorjob CHAR(8),
- Protection NUMBER(2),
- Userword0 NUMBER,
- Userword1 NUMBER,
- Userword2 NUMBER,
- Userword3 NUMBER,
- Userword4 NUMBER,
- Userword5 NUMBER,
- Userword6 NUMBER,
- Userword7 NUMBER,
- Userword8 NUMBER,
- Userword9 NUMBER,
- Sysword0 NUMBER,
- Sysword1 NUMBER,
- Sysword2 NUMBER,
- Sysword3 NUMBER,
- Sysword4 NUMBER,
- Sysword5 NUMBER,
- Sysword6 NUMBER,
- Sysword7 NUMBER,
- Sysword8 NUMBER,
- Sysword9 NUMBER,
- Comments CHAR(80),
- Mediatype CHAR(1))
-/
-CREATE TABLE FXV_THRONG ( File# NUMBER NOT NULL,
- Fileseq# NUMBER NOT NULL,
- Vol# NUMBER NOT NULL,
- Volseq# NUMBER)
-/
-CREATE TABLE Volumes_THRONG ( Vol# NUMBER NOT NULL,
- VSN CHAR(6) NOT NULL,
- VID CHAR(6) NOT NULL,
- VIDprefix NUMBER,
- Density NUMBER)
-/
-
-REM *** ALLOWING ACCESS TO EVERYBODY
-REM *** Note: Only Fatmen table was protected
-REM *** against modifications
-
-
-GRANT SELECT ON Gnames_THRONG TO PUBLIC
-/
-GRANT SELECT ON Files_THRONG TO PUBLIC
-/
-GRANT SELECT ON FXV_THRONG TO PUBLIC
-/
-GRANT SELECT ON Volumes_THRONG TO PUBLIC
-/
-
-#endif
-#if defined(CERNLIB_SQLDS)
-INSERT INTO Fatmen VALUES ('CERN', 'throng')
-
-CREATE TABLE GNames_throng ( GName CHAR(240) NOT NULL, -
- GN# INTEGER NOT NULL)
-CREATE TABLE Files_throng ( File# INTEGER NOT NULL, -
- GN# INTEGER NOT NULL, -
- Copylevel INTEGER NOT NULL, -
- Location INTEGER NOT NULL, -
- Hostname CHAR(8) NOT NULL, -
- Fullname CHAR(240) NOT NULL, -
- Hosttype CHAR(16), -
- Opersys CHAR(12), -
- Fileformat CHAR(4) NOT NULL, -
- Userformat CHAR(4), -
- Startrec# INTEGER, -
- Endrec# INTEGER, -
- Startblk# INTEGER, -
- Endblk# INTEGER, -
- Recformat CHAR(4), -
- Reclength INTEGER, -
- Blklength INTEGER, -
- Creation DATE, -
- Catalogation DATE, -
- Lastaccess DATE, -
- Active CHAR(1) NOT NULL -
- Creatorname CHAR(8), -
- Creatoraccount CHAR(8), -
- Creatornode CHAR(8), -
- Creatorjob CHAR(8), -
- Protection INTEGER(2))
-\end{XMP}
-\end{minipage}\hfill
-\begin{minipage}[t]{.494\linewidth}
-\tiny\begin{XMP}
-Alter table files_throng add (Userword0 INTEGER, -
- -
- Userword1 INTEGER, -
- Userword2 INTEGER, -
- Userword3 INTEGER, -
- Userword4 INTEGER, -
- Userword5 INTEGER, -
- Userword6 INTEGER, -
- Userword7 INTEGER, -
- Userword8 INTEGER, -
- Userword9 INTEGER, -
- Sysword0 INTEGER, -
- Sysword1 INTEGER, -
- Sysword2 INTEGER, -
- Sysword3 INTEGER, -
- Sysword4 INTEGER, -
- Sysword5 INTEGER, -
- Sysword6 INTEGER, -
- Sysword7 INTEGER, -
- Sysword8 INTEGER, -
- Sysword9 INTEGER, -
- Comments CHAR(80), -
- Mediatype CHAR(1))
-CREATE TABLE FXV_throng ( File# INTEGER NOT NULL, -
- Fileseq# INTEGER NOT NULL, -
- Vol# INTEGER NOT NULL, -
- Volseq# INTEGER)
-CREATE TABLE Volumes_throng ( Vol# INTEGER NOT NULL, -
- VSN CHAR(6) NOT NULL, -
- VID CHAR(6) NOT NULL, -
- VIDprefix INTEGER, -
- Density INTEGER)
-
-
-#endif
diff --git a/src/packlib/fatmen/scripts/sql/delgroup.F b/src/packlib/fatmen/scripts/sql/delgroup.F
deleted file mode 100644
index 833757e..0000000
--- a/src/packlib/fatmen/scripts/sql/delgroup.F
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: delgroup.F,v 1.1.1.1 1996/03/07 15:17:51 mclareni Exp $
-*
-* $Log: delgroup.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:51 mclareni
-* Fatmen
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_fatmen/pilot.h"
-DELETE FROM GNAMES_group;
-/
-DELETE FROM FILES_group;
-/
-DELETE FROM VOLUMES_group;
-/
-DELETE FROM FXV_group;
-/
diff --git a/src/packlib/fatmen/scripts/sql/dropgrou.F b/src/packlib/fatmen/scripts/sql/dropgrou.F
deleted file mode 100644
index ac85678..0000000
--- a/src/packlib/fatmen/scripts/sql/dropgrou.F
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: dropgrou.F,v 1.1.1.1 1996/03/07 15:17:51 mclareni Exp $
-*
-* $Log: dropgrou.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:51 mclareni
-* Fatmen
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_fatmen/pilot.h"
-DELETE FROM GNAMES_group;
-/
-DELETE FROM FILES_group;
-/
-DELETE FROM VOLUMES_group;
-/
-DELETE FROM FXV_group;
-/
diff --git a/src/packlib/fatmen/scripts/sql/index.F b/src/packlib/fatmen/scripts/sql/index.F
deleted file mode 100644
index 11d1032..0000000
--- a/src/packlib/fatmen/scripts/sql/index.F
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: index.F,v 1.1.1.1 1996/03/07 15:17:51 mclareni Exp $
-*
-* $Log: index.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:51 mclareni
-* Fatmen
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_fatmen/pilot.h"
-CREATE UNIQUE INDEX GNAMES_THRONG_GNAME ON GNAMES_THRONG(GNAME);
-CREATE UNIQUE INDEX GNAMES_THRONG_GN# ON GNAMES_THRONG(GN#);
-CREATE INDEX FILES_THRONG_FULLNAME ON FILES_THRONG(FULLNAME);
-CREATE INDEX FILES_THRONG_HOSTNAME ON FILES_THRONG(HOSTNAME);
-CREATE UNIQUE INDEX FILES_THRONG_FILE# ON FILES_THRONG(FILE#);
-CREATE INDEX FXV_THRONG_FILE# ON FXV_THRONG(FILE#);
-CREATE INDEX FXV_THRONG_VOL# ON FXV_THRONG(VOL#);
-CREATE UNIQUE INDEX VOLUMES_THRONG_VOL# ON VOLUMES_THRONG(VOL#);
-CREATE INDEX FILES_THRONG_GN# ON FILES_THRONG(GN#);
diff --git a/src/packlib/fatmen/scripts/sql/smcf.F b/src/packlib/fatmen/scripts/sql/smcf.F
deleted file mode 100644
index e3a1197..0000000
--- a/src/packlib/fatmen/scripts/sql/smcf.F
+++ /dev/null
@@ -1,11 +0,0 @@
-*
-* $Id: smcf.F,v 1.1.1.1 1996/03/07 15:17:51 mclareni Exp $
-*
-* $Log: smcf.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:51 mclareni
-* Fatmen
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_fatmen/pilot.h"
-select count(vsn) from fatmen.volumes_&1 where vsn like 'I%';
diff --git a/src/packlib/fatmen/scripts/sql/vid.F b/src/packlib/fatmen/scripts/sql/vid.F
deleted file mode 100644
index 2c61aad..0000000
--- a/src/packlib/fatmen/scripts/sql/vid.F
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: vid.F,v 1.1.1.1 1996/03/07 15:17:51 mclareni Exp $
-*
-* $Log: vid.F,v $
-* Revision 1.1.1.1 1996/03/07 15:17:51 mclareni
-* Fatmen
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_fatmen/pilot.h"
-column gname format a80
-select gname "FATMEN Generic Name " from fatmen.volumes_&2,fatmen.fxv_&2,
- fatmen.files_&2,fatmen.gnames_&2
- where fatmen.gnames_&2..gn#=fatmen.files_&2..gn# and
- fatmen.files_&2..file#=fatmen.fxv_&2..file# and
- fatmen.fxv_&2..vol#=fatmen.volumes_&2..vol# and
- vsn='&1' and active='Y' ;
diff --git a/src/packlib/fatmen/scripts/unix/addfat.dat b/src/packlib/fatmen/scripts/unix/addfat.dat
deleted file mode 100644
index 9c0d76d..0000000
--- a/src/packlib/fatmen/scripts/unix/addfat.dat
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: addfat.dat,v 1.1.1.1 1996/03/07 15:17:51 mclareni Exp $
-*
-* $Log: addfat.dat,v $
-* Revision 1.1.1.1 1996/03/07 15:17:51 mclareni
-* Fatmen
-*
-*
-typeset -l group
-typeset -l throng
-
-if test $1
-then
- temp=${1#'fm'}
- if test $temp = $1
- then
- group='fm'${1}
- else
- group=$1
- fi
- echo Adding FATMEN group $group ...
-
- if test -d /fatmen/${group}
- then
- echo /fatmen/${group} already exists
- else
- mkdir /fatmen/${group}
- mkdir /fatmen/${group}/todo
- mkdir /fatmen/${group}/done
- mkdir /fatmen/${group}/tovm
- chmod -f 777 /fatmen/${group}/todo
- touch /fatmen/${group}/fatmen.loccodes
- touch /fatmen/${group}/${group}.names
-#if defined(CERNLIB_SQL)
- throng=`echo ${group} | cut -c3-`
- addsql $throng
-#endif
- fi
-else
- echo Usage: $0 group
-fi
diff --git a/src/packlib/fatmen/scripts/unix/addsql.dat b/src/packlib/fatmen/scripts/unix/addsql.dat
deleted file mode 100644
index 804bfcd..0000000
--- a/src/packlib/fatmen/scripts/unix/addsql.dat
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: addsql.dat,v 1.1.1.1 1996/03/07 15:17:51 mclareni Exp $
-*
-* $Log: addsql.dat,v $
-* Revision 1.1.1.1 1996/03/07 15:17:51 mclareni
-* Fatmen
-*
-*
-#!/bin/ksh
-#
-# Create the SQL commands to create the tables for a new
-# FATMEN group.
-# Template file is "addsql.sql"
-#
-typeset -l group
-typeset -u ugroup
-group=$1
-ugroup=$1
-sed "s/THRONG/${ugroup}/g" $HOME/sql/addfat.sql > $HOME/sql/${group}.sql
diff --git a/src/packlib/fatmen/scripts/unix/bootmail.dat b/src/packlib/fatmen/scripts/unix/bootmail.dat
deleted file mode 100755
index c51753b..0000000
--- a/src/packlib/fatmen/scripts/unix/bootmail.dat
+++ /dev/null
@@ -1,3 +0,0 @@
-#!/bin/ksh
-subject="`hostname` rebooting at `date`"
-mail -s "${subject}" fatcat-mgr at zfatal.cern.ch < /dev/null > /dev/null
diff --git a/src/packlib/fatmen/scripts/unix/ctab.dat b/src/packlib/fatmen/scripts/unix/ctab.dat
deleted file mode 100644
index 54db3fd..0000000
--- a/src/packlib/fatmen/scripts/unix/ctab.dat
+++ /dev/null
@@ -1,28 +0,0 @@
-#
-# Start FATMEN backups at 02:00
-#
-0 2 * * * /afs/cern.ch/project/fatmen/scripts/fatback.sh >> /fatmen/fatback/logs 2>&1
-#
-# Check all servers running at 08:00
-#
-0 8 * * * /afs/cern.ch/project/fatmen/scripts/fatchk > /dev/null 2>&1
-#
-# Check for backlogs
-#
-0 0 * * * /afs/cern.ch/project/fatmen/scripts/fatqueue > /dev/null 2>&1
-#
-# Check that filesystems are not too full
-#
-0 0 * * * /afs/cern.ch/project/fatmen/scripts/fatdf > /dev/null 2>&1
-#
-# Check that none of the servers have died
-#
-0 * * * * /afs/cern.ch/project/fatmen/scripts/fatok > /dev/null 2>&1
-#
-# Special check for fmsend
-#
-30 * * * * /afs/cern.ch/project/fatmen/scripts/fatsendchk > /dev/null 2>&1
-#
-# Remove old ZZ files
-#
-0 6 * * * /afs/cern.ch/project/fatmen/scripts/fatzz > /dev/null 2>&1
diff --git a/src/packlib/fatmen/scripts/unix/fat.dat b/src/packlib/fatmen/scripts/unix/fat.dat
deleted file mode 100644
index 48a76f3..0000000
--- a/src/packlib/fatmen/scripts/unix/fat.dat
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: fat.dat,v 1.1.1.1 1996/03/07 15:17:52 mclareni Exp $
-*
-* $Log: fat.dat,v $
-* Revision 1.1.1.1 1996/03/07 15:17:52 mclareni
-* Fatmen
-*
-*
-for i in /fatmen/fm*
- do
- typeset -u fatgrp
- fatpath=$i
- fatgrp=`basename $i`
- echo Setting $fatgrp to $fatpath ...
- eval $fatgrp=$fatpath;export $fatgrp
- done
diff --git a/src/packlib/fatmen/scripts/unix/fat0.dat b/src/packlib/fatmen/scripts/unix/fat0.dat
deleted file mode 100755
index 64b7c5e..0000000
--- a/src/packlib/fatmen/scripts/unix/fat0.dat
+++ /dev/null
@@ -1,9 +0,0 @@
-#!/bin/ksh
-
-for i in /fatmen/fm*
- do
- typeset -u fatgrp
- fatpath=$i
- fatgrp=`basename $i`
- eval $fatgrp=$fatpath;export $fatgrp
- done
diff --git a/src/packlib/fatmen/scripts/unix/fat2sql.dat b/src/packlib/fatmen/scripts/unix/fat2sql.dat
deleted file mode 100644
index 854aa84..0000000
--- a/src/packlib/fatmen/scripts/unix/fat2sql.dat
+++ /dev/null
@@ -1,30 +0,0 @@
-*
-* $Id: fat2sql.dat,v 1.1.1.1 1996/03/07 15:17:51 mclareni Exp $
-*
-* $Log: fat2sql.dat,v $
-* Revision 1.1.1.1 1996/03/07 15:17:51 mclareni
-* Fatmen
-*
-*
-#!/bin/ksh
-#
-# Run fat2sql program - take all entries from FATMEN
-# catalogue and add to ORACLE database.
-# Argument 1 is the group name (required)
-# Argument 2 is the system name (defaults to CERN)
-#
-# Check if FATMEN group is given...
-#
-: ${1:?FATMEN group missing - Usage: $0 group [system]}
-#
-# Avoid trick using tr to get uppercase variables
-#
-typeset -u FATSYS
-typeset -u FATGRP
-export FATSYS=${2:-CERN}
-export FATGRP=$1
-export PWD=...... # Set to ORACLE password
-#
-# Run program
-#
-./fat2sql
diff --git a/src/packlib/fatmen/scripts/unix/fatabend.dat b/src/packlib/fatmen/scripts/unix/fatabend.dat
deleted file mode 100644
index 2a172c7..0000000
--- a/src/packlib/fatmen/scripts/unix/fatabend.dat
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: fatabend.dat,v 1.1.1.1 1996/03/07 15:17:52 mclareni Exp $
-*
-* $Log: fatabend.dat,v $
-* Revision 1.1.1.1 1996/03/07 15:17:52 mclareni
-* Fatmen
-*
-*
-#
-# This is for FATCAT. Modify at will
-#
-echo FATMEN server $FATSYS $FATGRP abending | mail fatcat-mgr at zfatal.cern.ch
diff --git a/src/packlib/fatmen/scripts/unix/fatback.dat b/src/packlib/fatmen/scripts/unix/fatback.dat
deleted file mode 100644
index 977f716..0000000
--- a/src/packlib/fatmen/scripts/unix/fatback.dat
+++ /dev/null
@@ -1,160 +0,0 @@
-*
-* $Id: fatback.dat,v 1.3 1996/04/22 06:37:57 jamie Exp $
-*
-* $Log: fatback.dat,v $
-* Revision 1.3 1996/04/22 06:37:57 jamie
-* better messages regarding actual backup
-*
-* Revision 1.2 1996/04/16 06:43:37 jamie
-* latest fatmen scripts from /afs/cern.ch/project/fatmen/scripts
-*
-* Revision 1.1.1.1 1996/03/07 15:17:52 mclareni
-* Fatmen
-*
-*
-#!/bin/ksh
-d=`date`
-echo
-echo FATBACK running at $d
-echo
-#
-# Fix for CERNSP based fatcat server
-#
-this_host=`hostname`
-
-if [ $this_host = "sp020" ]
- then export FMHOST=fatcat
- echo ${0}: setting FATMEN hostname to $FMHOST
-fi
-#
-# Delete old backup files
-#
-find /fatback0 -name *.fatfx -mtime +5 -exec rm {} \;
-find /fatback1 -name *.fatfx -mtime +5 -exec rm {} \;
-#
-d=`date`
-echo
-echo FATBACK cleanup completed at $d
-echo
-#
-# Loop over all FATMEN servers and
-# stop them
-# copy the .fatrz file to the backup area, verifying it in the process
-# restart current server
-#
-log=" "
-run=" "
-nos=" "
-b="."
-#
-# Ensure that variables are defined...
-#
-for i in /fatmen/fm*
-do
- typeset -u fatgrp
- typeset -l fatman
- fatpath=$i
- fatgrp=`basename $i`
- fatman=$fatgrp
- eval $fatgrp=$fatpath;export $fatgrp
- if [ $fatman != "fmsend" -a $fatman != "fmkeops" ]
- then
-#
-# and stop those servers that are running...
-#
- if [ -x ${i}/fatserv ]
- then
-#
-# does a log file exist?
-#
- if [ -f /fatmen/${fatgrp}.log ]
- then
- echo Log file exists for ${fatgrp} - looking for existing process
- log=${log}${b}${fatgrp}
- pid=`cat /fatmen/${fatgrp}.log | awk '{printf "%s\n",$14}'`
- if (test $pid)
- then
- echo Looking for server process for $fatgrp
- if(ps -ae | grep -ws $pid )
- then
- echo FATSRV running PID = $pid
- run=${run}${b}${fatgrp}
- d=`date`
- echo Stopped at $d for backup > /fatmen/${fatman}/todo/signal.stop
-#
-# Wait until the server is stopped
-#
- while (ps -ae | grep -s $pid )
- do
- d=`date`
- echo Server ${fatman} still running - sleeping at $d
- sleep 60
- done
-#
-# Check that output directory exists
-#
- if [ ! -d /fatback/${fatman} ]
- then
- echo Creating directory /fatback/${fatman}
- mkdir /fatback/${fatman}
- fi
-#
-# Server is now stopped - backup RZ file
-#
- d=`date`
- echo Backing up /fatmen/${fatman}/cern.fatrz at ${d} >> \
- /fatback/fatback.log
-
- /afs/cern.ch/project/fatmen/@sys/bin/fatback /fatmen/${fatman}/cern.fatrz \
- /fatback/${fatman} >> /fatback/fatback.log
- rc=$?
- if [ $rc -ne 0 ]
- then
-#
-# Send mail
-#
- echo RC = $rc for backup of RZ file for ${fatman} | mail \
- -s "FATMEN backup for ${fatman}" fatcat-mgr at zfatal.cern.ch
-#
-# print in log
-#
- echo RC = $rc for backup of RZ file for ${fatman} >> \
- /fatback/fatback.log
-#
-# stdout
-#
- echo RC = $rc for backup of RZ file for ${fatman}
- fi
-#
- echo Backup of /fatmen/${fatman}/cern.fatrz complete at ${d} >> \
- /fatback/fatback.log
-
- echo Backup of /fatmen/${fatman}/cern.fatrz complete at ${d}
-
-#
-# Touch good backup file
-#
- touch /fatback/${fatman}/good.fatfx
-#
-# Now restart server
-#
- d=`date`
- echo Restarting server for ${fatman} at ${d}
- rm /fatmen/${fatman}/todo/signal.stop
- nohup /fatmen/${fatman}/fatserv > /fatlogs/${fatman}/fatserv.log &
- else
- echo No existing server found for $fatgrp
- echo Removing old log file...
- rm /fatmen/${fatgrp}.log
- nos=${nos}${b}${fatgrp}
- fi
- fi
- fi
- fi
- fi
-done
-
-echo
-echo Log files found for $log | tr '.' ' '
-echo Servers running for $run | tr '.' ' '
-echo No server found for $nos | tr '.' ' '
diff --git a/src/packlib/fatmen/scripts/unix/fatcheck.dat b/src/packlib/fatmen/scripts/unix/fatcheck.dat
deleted file mode 100644
index e959012..0000000
--- a/src/packlib/fatmen/scripts/unix/fatcheck.dat
+++ /dev/null
@@ -1,48 +0,0 @@
-*
-* $Id: fatcheck.dat,v 1.1.1.1 1996/03/07 15:17:51 mclareni Exp $
-*
-* $Log: fatcheck.dat,v $
-* Revision 1.1.1.1 1996/03/07 15:17:51 mclareni
-* Fatmen
-*
-*
-#!/bin/ksh
-#
-# Check that the FATMEN server is running for all known servers
-# Restart if not, unless signal.stop file exists
-#
-
-typeset -l program
-typeset -l logfile
-typeset -l stopfile
-
-for i in /fatmen/*.log
-do
-pid=`cat $i | awk '{printf "%s\n",$14}'`
-server=`basename $i .log`
-echo
-echo Processing ${server}...
-if (test $pid)
- then
- echo Looking for server process for $server
- if(ps -ae | grep -s $pid )
- then
- echo FATSRV running PID = $pid
- else
- echo FATSRV not found
- fi
- else
- echo Cannot find PID of server process for $server
- stopfile=/fatmen/${server}/todo/signal.stop
- if [ -f $stopfile ]
- then
- echo Server has been stopped - remove ${stopfile} to restart
- else
- program=/fatmen/${server}/fatserv
- logfile=${program}.log
- echo To start server, type
- echo "nohup $program > $logfile &"
- fi
- fi
-done
-
diff --git a/src/packlib/fatmen/scripts/unix/fatchk.dat b/src/packlib/fatmen/scripts/unix/fatchk.dat
deleted file mode 100644
index 1d91d93..0000000
--- a/src/packlib/fatmen/scripts/unix/fatchk.dat
+++ /dev/null
@@ -1,35 +0,0 @@
-*
-* $Id: fatchk.dat,v 1.2 1996/04/16 06:43:39 jamie Exp $
-*
-* $Log: fatchk.dat,v $
-* Revision 1.2 1996/04/16 06:43:39 jamie
-* latest fatmen scripts from /afs/cern.ch/project/fatmen/scripts
-*
-* Revision 1.1.1.1 1996/03/07 15:17:52 mclareni
-* Fatmen
-*
-*
-#!/bin/ksh
-#
-# Ensure that variables are defined...
-#
-for i in /fatmen/fm*
-
- do
-
- typeset -u fatgrp
- fatpath=$i
- fatgrp=`basename $i`
- eval $fatgrp=$fatpath;export $fatgrp
-#
-# Look for startable servers (fatserv exists)
-#
- if [ -x ${i}/fatserv ]
- then
- if [ -f ${i}/todo/signal.stop ]
- then
- subject=`echo Warning: server for ${fatgrp} has been stopped`
- ls -l ${i}/todo/signal.stop | mail -s " ${subject} " fatcat-mgr at zfatal.cern.ch
- fi
- fi
- done
diff --git a/src/packlib/fatmen/scripts/unix/fatcore.dat b/src/packlib/fatmen/scripts/unix/fatcore.dat
deleted file mode 100755
index 1d06ae5..0000000
--- a/src/packlib/fatmen/scripts/unix/fatcore.dat
+++ /dev/null
@@ -1,27 +0,0 @@
-#!/bin/ksh
-#
-# Ensure that variables are defined...
-#
-for i in /fatmen/fm*
-
- do
-
- typeset -u fatgrp
- fatpath=$i
- fatgrp=`basename $i`
- eval $fatgrp=$fatpath;export $fatgrp
-#
-# Look for startable servers (fatserv exists)
-#
- if [ -x ${i}/fatserv ]
- then
-
- if [ -f ${i}/core ]
- then
-
- subject=`echo Alert: core file found for ${fatgrp}`
- ls -l ${i}/core | mail -s " ${subject} " fatcat-mgr at zfatal.cern.ch
-
- fi
- fi
- done
diff --git a/src/packlib/fatmen/scripts/unix/fatdf.dat b/src/packlib/fatmen/scripts/unix/fatdf.dat
deleted file mode 100644
index e2e14cf..0000000
--- a/src/packlib/fatmen/scripts/unix/fatdf.dat
+++ /dev/null
@@ -1,52 +0,0 @@
-*
-* $Id: fatdf.dat,v 1.2 1996/04/16 06:43:40 jamie Exp $
-*
-* $Log: fatdf.dat,v $
-* Revision 1.2 1996/04/16 06:43:40 jamie
-* latest fatmen scripts from /afs/cern.ch/project/fatmen/scripts
-*
-* Revision 1.1.1.1 1996/03/07 15:17:52 mclareni
-* Fatmen
-*
-*
-#!/bin/ksh
-
-#------------------------------------------------------------------
-#
-# Modified for AIX version 4.1 27/03/96
-#
-# (output of df command is slightly different)
-#
-#------------------------------------------------------------------
-
-filesystem="/fatmen"
-warn="90"
-alert="95"
-
-a=`df ${filesystem}`
-
-aix_version=`echo $a | cut -f2 -d\ `
-
-if [ ${aix_version} = "512-blocks" ]
-then
- b=`echo $a | cut -f12 -d\ `
-else
- b=`echo $a | cut -f13 -d\ `
-fi
-
-c=`echo $b | tr -d %`
-
-if [ ${c} -gt ${alert} ]
-then
- echo ALARM!! - filesystem ${filesystem} ${c}% full | \
- mail -s " ALARM!! ${filesystem} ${c}% full " fatcat-mgr at zfatal.cern.ch
- exit
-fi
-
-if [ ${c} -gt ${warn} ]
-then
- echo Warning - filesystem ${filesystem} ${c}% full | \
- mail -s " Warning - ${filesystem} ${c}% full " fatcat-mgr at zfatal.cern.ch
- exit
-fi
-
diff --git a/src/packlib/fatmen/scripts/unix/fatdone.dat b/src/packlib/fatmen/scripts/unix/fatdone.dat
deleted file mode 100644
index b09f5d0..0000000
--- a/src/packlib/fatmen/scripts/unix/fatdone.dat
+++ /dev/null
@@ -1,14 +0,0 @@
-*
-* $Id: fatdone.dat,v 1.1.1.1 1996/03/07 15:17:52 mclareni Exp $
-*
-* $Log: fatdone.dat,v $
-* Revision 1.1.1.1 1996/03/07 15:17:52 mclareni
-* Fatmen
-*
-*
-#
-# Delete old backup files
-#
-find /fatmen/fm*/done -name '*.*' -mtime +60 -exec rm -f {} \;
-
-
diff --git a/src/packlib/fatmen/scripts/unix/fatjobs.dat b/src/packlib/fatmen/scripts/unix/fatjobs.dat
deleted file mode 100644
index 939f9d3..0000000
--- a/src/packlib/fatmen/scripts/unix/fatjobs.dat
+++ /dev/null
@@ -1,63 +0,0 @@
-*
-* $Id: fatjobs.dat,v 1.1.1.1 1996/03/07 15:17:51 mclareni Exp $
-*
-* $Log: fatjobs.dat,v $
-* Revision 1.1.1.1 1996/03/07 15:17:51 mclareni
-* Fatmen
-*
-*
-#!/bin/ksh
-#
-# Print the names of the FATMEN servers that are running.
-# Should a log file be found for which no process exists,
-# it is deleted.
-#
-stop=" "
-run=" "
-nolog=" "
-noscr=" "
-b="."
-d=`date`
-#
-# Print names of FATMEN servers that are running
-#
-for i in /fatmen/fm*
- do
-
-typeset -u fatgrp
-typeset -l fatman
-fatpath=$i
-fatgrp=`basename $i`
-fatman=$fatgrp
-eval $fatgrp=$fatpath;export $fatgrp
-#
-if [ -x ${i}/fatserv ]
- then
-#
-# does a log file exist?
-#
- if [ -f /fatmen/${fatgrp}.log ]
- then
- echo Log file exists for ${fatgrp} - looking for existing process
- log=${log}${b}${fatgrp}
- pid=`cat /fatmen/${fatgrp}.log | awk '{printf "%s\n",$14}'`
- if (test $pid)
- then
- echo Looking for server process for $fatgrp
- if(ps -ae | grep -s $pid )
- then
- echo FATSRV running PID = $pid
- run=${run}${b}${fatgrp}
- else
- echo Removing old log file...
- rm /fatmen/${fatgrp}.log
- fi
- fi
- fi
-fi
-
-done
-
-echo
-echo Log files found for $log | tr '.' ' '
-echo Servers running for $run | tr '.' ' '
diff --git a/src/packlib/fatmen/scripts/unix/fatlib.dat b/src/packlib/fatmen/scripts/unix/fatlib.dat
deleted file mode 100644
index 0ff63c1..0000000
--- a/src/packlib/fatmen/scripts/unix/fatlib.dat
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: fatlib.dat,v 1.1.1.1 1996/03/07 15:17:51 mclareni Exp $
-*
-* $Log: fatlib.dat,v $
-* Revision 1.1.1.1 1996/03/07 15:17:51 mclareni
-* Fatmen
-*
-*
-rm fmint.f
-ypatchy /cern/src/car/zebra.car fmint.f :go <<!
-&use,qcde.
-&use,ibmrt,*fatlib.
-&use,fmc,t=inhibit.
-&use,fmh,t=inhibit.
-&use,tms,t=inhibit.
-&exe.
-&pam,11,r=qcde,t=c.
-&pam,12,t=c,a. fatmen.cards
-&quit
-!
-xlf -c -q extname fmint.f
diff --git a/src/packlib/fatmen/scripts/unix/fatlog_clean.dat b/src/packlib/fatmen/scripts/unix/fatlog_clean.dat
deleted file mode 100755
index 386dc49..0000000
--- a/src/packlib/fatmen/scripts/unix/fatlog_clean.dat
+++ /dev/null
@@ -1,40 +0,0 @@
-#!/bin/ksh
-d=`date`
-echo
-echo $0 running at $d
-echo
-#
-# Fix for CERNSP based fatcat server
-#
-this_host=`hostname`
-
-if [ $this_host = "sp020" ]
- then export FMHOST=fatcat
- echo ${0}: setting FATMEN hostname to $FMHOST
-fi
-#
-# Delete old journal files
-#
-echo
-echo Before cleanup..
-echo
-df /fatlogs0
-find /fatlogs0 -name aa* -mtime +30 -exec rm {} \;
-echo
-echo After cleanup..
-echo
-df /fatlogs0
-echo
-echo Before cleanup..
-echo
-df /fatlogs1
-find /fatlogs1 -name aa* -mtime +30 -exec rm {} \;
-echo
-echo After cleanup..
-echo
-df /fatlogs1
-#
-d=`date`
-echo
-echo $0 cleanup completed at $d
-echo
diff --git a/src/packlib/fatmen/scripts/unix/fatmnt.dat b/src/packlib/fatmen/scripts/unix/fatmnt.dat
deleted file mode 100644
index 97dc50b..0000000
--- a/src/packlib/fatmen/scripts/unix/fatmnt.dat
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: fatmnt.dat,v 1.1.1.1 1996/03/07 15:17:52 mclareni Exp $
-*
-* $Log: fatmnt.dat,v $
-* Revision 1.1.1.1 1996/03/07 15:17:52 mclareni
-* Fatmen
-*
-*
-#!/bin/ksh
-#
-# Mount FATMEN disks from CERNVM
-#
-for i in /fatmen/fm*
- do
- fatgrp=`basename $i`
-#
-# Check that directory exists
-#
- if [ ! -d ~jamie/fatmen/cernvm/${fatgrp} ]
- then
- echo Creating directory ~jamie/fatmen/cernvm/${fatgrp}
- mkdir ~jamie/fatmen/cernvm/${fatgrp}
- fi
-#
-# Now mount the file system
-#
- echo Mounting ${fatgrp}.191
- /etc/mount -n cernvm ${fatgrp}.191,ro,record=nl \
- ~jamie/fatmen/cernvm/${fatgrp}
-
- done
diff --git a/src/packlib/fatmen/scripts/unix/fatok.dat b/src/packlib/fatmen/scripts/unix/fatok.dat
deleted file mode 100755
index 5c2474d..0000000
--- a/src/packlib/fatmen/scripts/unix/fatok.dat
+++ /dev/null
@@ -1,27 +0,0 @@
-#!/bin/ksh
-#
-# Check that the FATMEN servers are running for all known servers
-# Send warning mail if not
-#
-
-typeset -l logfile
-
-for i in /fatmen/*.log
-do
-pid=`cat $i | awk '{printf "%s\n",$14}'`
-server=`basename $i .log`
-
-if (test $pid)
- then
-
- if(ps -ae | grep -qs $pid )
- then
- :
- else
- subject=`echo ${0}: Process for ${server} - tail of logfile`
- logfile=/fatmen/${server}/fatserv.log
- tail ${logfile} | mail -s " ${subject} " fatcat-mgr at zfatal.cern.ch
- fi
-fi
-done
-
diff --git a/src/packlib/fatmen/scripts/unix/fatps.dat b/src/packlib/fatmen/scripts/unix/fatps.dat
deleted file mode 100644
index b6383e5..0000000
--- a/src/packlib/fatmen/scripts/unix/fatps.dat
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: fatps.dat,v 1.2 1996/04/16 09:35:15 jamie Exp $
-*
-* $Log: fatps.dat,v $
-* Revision 1.2 1996/04/16 09:35:15 jamie
-* mods for aix 4
-*
-* Revision 1.1.1.1 1996/03/07 15:17:51 mclareni
-* Fatmen
-*
-*
-#echo 'FATMEN server Elapsed CPU time %CPU'
-#echo '==============================================================================='
-#ps -aef -F "args,etime,time,pcpu" | grep "/fatsrv" | sort +2 -r
-#
-# For AIX 4
-#
-echo ' Elapsed CPU time %CPU ** FATMEN server ** '
-echo '========================================================'
-ps -aef -F "etime,time,pcpu,args" | cut -c 1-80 | grep "/fatsrv" | sort +1 -r
diff --git a/src/packlib/fatmen/scripts/unix/fatpurg.dat b/src/packlib/fatmen/scripts/unix/fatpurg.dat
deleted file mode 100644
index 35d15e6..0000000
--- a/src/packlib/fatmen/scripts/unix/fatpurg.dat
+++ /dev/null
@@ -1,37 +0,0 @@
-*
-* $Id: fatpurg.dat,v 1.1.1.1 1996/03/07 15:17:51 mclareni Exp $
-*
-* $Log: fatpurg.dat,v $
-* Revision 1.1.1.1 1996/03/07 15:17:51 mclareni
-* Fatmen
-*
-*
-#
-# Purge journal files more than 1 week old
-#
-#find /fatmen/fm*/done/* -atime +7 -exec rm {} \;
-#
-# Do it the long way in case there are too many files found
-#
-for i in /fatmen/fm*/done/*
- do
- find $i -atime +7 -exec rm {} \;
- done
-&PATCH,//FATMEN/SCRIPT
-&DECK,FMKUIP.
-rm fort.23 fmcdf.f fmkuip.f
-ypatchy /cern/src/car/zebra.car fmkuip.f :go <<!
-&use,qcde.
-&use,ibmrt,*fatlib.
-&use,fmc,t=inhibit.
-&use,fmh,t=inhibit.
-&use,tms,t=inhibit.
-&use,*fmkuip.
-&asm,23.
-&exe.
-&pam,11,r=qcde,t=c.
-&pam,12,t=c,a. fatmen.cards
-&quit
-!
-kuipc fort.23 fmcdf.f
-xlf -q extname fmkuip.f fmcdf.f -L/cern/pro/lib -lpacklib -o fm
diff --git a/src/packlib/fatmen/scripts/unix/fatqueue.dat b/src/packlib/fatmen/scripts/unix/fatqueue.dat
deleted file mode 100644
index 4be68c1..0000000
--- a/src/packlib/fatmen/scripts/unix/fatqueue.dat
+++ /dev/null
@@ -1,57 +0,0 @@
-*
-* $Id: fatqueue.dat,v 1.2 1996/04/16 06:43:41 jamie Exp $
-*
-* $Log: fatqueue.dat,v $
-* Revision 1.2 1996/04/16 06:43:41 jamie
-* latest fatmen scripts from /afs/cern.ch/project/fatmen/scripts
-*
-* Revision 1.1.1.1 1996/03/07 15:17:52 mclareni
-* Fatmen
-*
-*
-#!/bin/ksh
-#
-# Ensure that variables are defined...
-#
-for i in /fatmen/fm*
-
- do
-
- typeset -u fatgrp
- fatpath=$i
- fatgrp=`basename $i`
- eval $fatgrp=$fatpath;export $fatgrp
-#
-# Look for startable servers (fatserv exists)
-#
- if [ -x ${i}/fatserv ]
- then
-#
-# Pending files?
-#
- todo=`ls ${i}/todo/aa* 2> /dev/null | wc -l`
- if [ ${todo} != "0" ]
- then
- echo ${todo} pending files in TODO for ${fatgrp} | \
- mail -s " ${fatgrp}: TODO backlog " fatcat-mgr at zfatal.cern.ch
- fi
-
- todo=`ls ${i}/todo/zz* 2> /dev/null | wc -l`
- if [ ${todo} != "0" ]
- then
- echo ${todo} ZZ files in TODO for ${fatgrp} | \
- mail -s " ${fatgrp}: TODO backlog " fatcat-mgr at zfatal.cern.ch
- fi
-
- if [ -d ${i}/tovm ]
- then
- tovm=`ls ${i}/tovm | wc -l`
- if [ ${tovm} != "0" ]
- then
- subject=`echo ${fatgrp}: TOVM backlog`
- echo ${tovm} pending files for transmission to CERNVM for ${fatgrp} | \
- mail -s " ${subject} " fatcat-mgr at zfatal.cern.ch
- fi
- fi
- fi
- done
diff --git a/src/packlib/fatmen/scripts/unix/fatsend.dat b/src/packlib/fatmen/scripts/unix/fatsend.dat
deleted file mode 100644
index c89d6cd..0000000
--- a/src/packlib/fatmen/scripts/unix/fatsend.dat
+++ /dev/null
@@ -1,52 +0,0 @@
-*
-* $Id: fatsend.dat,v 1.2 1996/04/16 06:43:42 jamie Exp $
-*
-* $Log: fatsend.dat,v $
-* Revision 1.2 1996/04/16 06:43:42 jamie
-* latest fatmen scripts from /afs/cern.ch/project/fatmen/scripts
-*
-* Revision 1.1.1.1 1996/03/07 15:17:52 mclareni
-* Fatmen
-*
-*
-#!/bin/ksh
-#
-# Check that the FATMEN server is running for all known servers
-# Restart if not, unless signal.stop file exists
-#
-
-typeset -l program
-typeset -l logfile
-typeset -l stopfile
-
-for i in /fatmen/FMSEND.log
-do
-pid=`cat $i | awk '{printf "%s\n",$14}'`
-server=`basename $i .log`
-echo
-echo Processing ${server}...
-if (test $pid)
- then
- if(ps -ae | grep -qs $pid )
- then
- else
- echo FATSRV not found
- program=/fatmen/${server}/fatserv
- logfile=${program}.log
- echo "nohup $program > $logfile &"
- fi
- else
- echo Cannot find PID of server process for $server
- stopfile=/fatmen/${server}/todo/signal.stop
- if [ -f $stopfile ]
- then
- echo Server has been stopped - remove ${stopfile} to restart
- else
- program=/fatmen/${server}/fatserv
- logfile=${program}.log
- echo To start server, type
- echo "nohup $program > $logfile &"
- fi
- fi
-done
-
diff --git a/src/packlib/fatmen/scripts/unix/fatsendchk.dat b/src/packlib/fatmen/scripts/unix/fatsendchk.dat
deleted file mode 100755
index 938021e..0000000
--- a/src/packlib/fatmen/scripts/unix/fatsendchk.dat
+++ /dev/null
@@ -1,28 +0,0 @@
-#!/bin/ksh
-#
-# Check that the FATMEN 'fmsend' server is not stuck
-#
-
-. /afs/cern.ch/project/fatmen/scripts/fat0
-
-tail /fatmen/fmsend/fatserv.log > /fatmen/fmsend/check1
-
-diff /fatmen/fmsend/check0 /fatmen/fmsend/check1 > /dev/null 2>&1
-
-if [ $? -eq 0 ]
-
-then
-
- logfile=/fatmen/fmsend/fatserv.log
- lm=`ls -lLm ${logfile}`
- subject=`echo ${0}: ${lm}`
- tail ${logfile} | mail -s " ${subject} " fatcat-mgr at zfatal.cern.ch
- (su - jamie;/afs/cern.ch/project/fatmen/scripts/restart_fatsend)
- ps -ef | grep fmsend | mail -s " fmsend restarted " fatcat-mgr at zfatal.cern.ch
-
-else
-
- mv /fatmen/fmsend/check1 /fatmen/fmsend/check0
-
-fi
-
diff --git a/src/packlib/fatmen/scripts/unix/fatserv.dat b/src/packlib/fatmen/scripts/unix/fatserv.dat
deleted file mode 100644
index d6e21c2..0000000
--- a/src/packlib/fatmen/scripts/unix/fatserv.dat
+++ /dev/null
@@ -1,39 +0,0 @@
-*
-* $Id: fatserv.dat,v 1.1.1.1 1996/03/07 15:17:51 mclareni Exp $
-*
-* $Log: fatserv.dat,v $
-* Revision 1.1.1.1 1996/03/07 15:17:51 mclareni
-* Fatmen
-*
-*
-#!/bin/ksh
-#
-# Example FATSERV script.
-#
-typeset -l fatpath
-typeset -u FATGRP
-
-FATGRP=${1};export FATGRP
-fatpath=/fatmen/${1}
-eval ${FATGRP}=${fatpath};export ${FATGRP}
-
-FMWAKEUP=120; export FMWAKEUP
-FMLOGL=0;export FMLOGL
-PWD=fatmen;export PWD
-
-t=`date`
-h=`hostname`
-echo
-echo FATSERV starting at $t on $h
-echo
-echo FATMEN group set to $FATGRP , wakeup interval is $FMWAKEUP seconds
-echo
-echo $FATGRP starting at $t on $h PID = $$ > /fatmen/${FATGRP}.log
-typeset -l fatpath
-fatpath=/fatmen/${FATGRP}
-${fatpath}/fatsrv
-if [ -f /fatmen/${FATGRP}.log ]
-then
- rm -f /fatmen/${FATGRP}.log
-fi
-
diff --git a/src/packlib/fatmen/scripts/unix/fatsql.dat b/src/packlib/fatmen/scripts/unix/fatsql.dat
deleted file mode 100644
index 61ca6bf..0000000
--- a/src/packlib/fatmen/scripts/unix/fatsql.dat
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: fatsql.dat,v 1.1.1.1 1996/03/07 15:17:51 mclareni Exp $
-*
-* $Log: fatsql.dat,v $
-* Revision 1.1.1.1 1996/03/07 15:17:51 mclareni
-* Fatmen
-*
-*
-rm fatsql.fortsql
-ypatchy fatmen.cards fatsql.fortsql :go <<!
-&EXE.
-&ASM, 21,R=!.CDECK ID>, !.fortsql
-&USE,*FATSQL,ORACLE.
-&USE,IBMRT.
-&PAM,11,T=C,A. fatmen.cards
-&QUIT.
-!
-fcasplit fatsql.fortsql
-rm fatsql.fortsql
-for i in *.fortsql
- do
- pcc iname=$i host=fortran
- j=`basename $i .fortsql`
- xlf -q charlen=32756 -c $j.f
- done
-
diff --git a/src/packlib/fatmen/scripts/unix/fatsrvo.dat b/src/packlib/fatmen/scripts/unix/fatsrvo.dat
deleted file mode 100644
index 6ab2631..0000000
--- a/src/packlib/fatmen/scripts/unix/fatsrvo.dat
+++ /dev/null
@@ -1,14 +0,0 @@
-*
-* $Id: fatsrvo.dat,v 1.1.1.1 1996/03/07 15:17:51 mclareni Exp $
-*
-* $Log: fatsrvo.dat,v $
-* Revision 1.1.1.1 1996/03/07 15:17:51 mclareni
-* Fatmen
-*
-*
-# With ORACLE...
-xlf -c -qcharlen=32000 fmlogi.f foget.f foput.f fodel.f
-xlf -q extname -qcharlen=32000 fmsrv.f fmlogi.o foget.o \
- foput.o fodel.o cltou.o $ORACLE_HOME/rdbms/lib/osntab.o \
- -L/cern/new/lib -lpacklib -L$ORACLE_HOME/rdbms/lib \
- -lora -lsql -lsqlnet -L$ORACLE_HOME/tcp/lib -ltcp -lc -o fatsrvo
diff --git a/src/packlib/fatmen/scripts/unix/fatstart.dat b/src/packlib/fatmen/scripts/unix/fatstart.dat
deleted file mode 100644
index 071dc1e..0000000
--- a/src/packlib/fatmen/scripts/unix/fatstart.dat
+++ /dev/null
@@ -1,107 +0,0 @@
-*
-* $Id: fatstart.dat,v 1.2 1996/04/16 06:43:44 jamie Exp $
-*
-* $Log: fatstart.dat,v $
-* Revision 1.2 1996/04/16 06:43:44 jamie
-* latest fatmen scripts from /afs/cern.ch/project/fatmen/scripts
-*
-* Revision 1.1.1.1 1996/03/07 15:17:51 mclareni
-* Fatmen
-*
-*
-#!/bin/ksh
-start=" "
-stop=" "
-run=" "
-nolog=" "
-noscr=" "
-b="."
-#
-# Fix for CERNSP based fatcat server
-#
-this_host=`hostname`
-
-if [ $this_host = "sp020" ]
- then export FMHOST=fatcat
- echo ${0}: setting FATMEN hostname to $FMHOST
-fi
-
-#
-# Ensure that variables are defined...
-#
-
-for i in /fatmen/fm*
- do
-
-echo
-typeset -u fatgrp
-typeset -l fatdir
-fatpath=$i
-fatgrp=`basename $i`
-fatdir=`basename $i`
-echo Setting $fatgrp to $fatpath ...
-eval $fatgrp=$fatpath;export $fatgrp
-#
-# and start the servers
-#
-if [ -x ${i}/fatserv ]
- then
-#
-# does a log file exist?
-#
- if [ -f /fatmen/${fatgrp}.log ]
- then
- echo '>>> log file exists - looking for existing process'
- log=${log}${b}${fatgrp}
- pid=`cat /fatmen/${fatgrp}.log | awk '{printf "%s\n",$14}'`
- if (test $pid)
- then
- echo Looking for server process for $fatgrp
- if(ps -ae | grep -s $pid )
- then
- echo FATSRV running PID = $pid
- run=${run}${b}${fatgrp}
- else
- echo No existing server found for $fatgrp - starting server
- if [ -f ${i}/todo/signal.stop ]
- then echo but signal.stop file found!
- else echo Starting server for $fatgrp
- nohup ${i}/fatserv > /fatlogs/${fatdir}/fatserv.log &
- start=${start}${b}${fatgrp}
- fi
- fi
-
- else
- echo No existing server found for $fatgrp - starting server
- if [ -f ${i}/todo/signal.stop ]
- then echo but signal.stop file found!
- stop=${stop}${b}${fatgrp}
- else echo Starting server for $fatgrp
- nohup ${i}/fatserv > /fatlogs/${fatdir}/fatserv.log &
- start=${start}${b}${fatgrp}
- fi
- fi
- else
- echo No server log found in $i
- if [ -f ${i}/todo/signal.stop ]
- then echo but signal.stop file found!
- stop=${stop}${b}${fatgrp}
- else echo Starting server for $fatgrp
- nohup ${i}/fatserv > /fatlogs/${fatdir}/fatserv.log &
- start=${start}${b}${fatgrp}
- fi
- fi
- else
- echo No fatserv script found in $i - cannot start server
- scr=${scr}${b}${fatgrp}
-fi
-
-done
-
-echo
-echo Log files found for $log | tr '.' ' '
-echo Started servers for $start | tr '.' ' '
-echo Servers already running for $run | tr '.' ' '
-echo Servers stopped $stop | tr '.' ' '
-echo No scripts found for $scr | tr '.' ' '
-echo
diff --git a/src/packlib/fatmen/scripts/unix/fatstop.dat b/src/packlib/fatmen/scripts/unix/fatstop.dat
deleted file mode 100644
index 8f0180a..0000000
--- a/src/packlib/fatmen/scripts/unix/fatstop.dat
+++ /dev/null
@@ -1,81 +0,0 @@
-*
-* $Id: fatstop.dat,v 1.2 1996/04/16 06:43:44 jamie Exp $
-*
-* $Log: fatstop.dat,v $
-* Revision 1.2 1996/04/16 06:43:44 jamie
-* latest fatmen scripts from /afs/cern.ch/project/fatmen/scripts
-*
-* Revision 1.1.1.1 1996/03/07 15:17:51 mclareni
-* Fatmen
-*
-*
-#!/bin/ksh
-stop=" "
-run=" "
-nolog=" "
-noscr=" "
-b="."
-d=`date`
-#
-# Ensure that variables are defined...
-#
-if [ -f restart_fat ]
- echo Removing old restart_fat file...
- then rm restart_fat
-fi
-
-for i in /fatmen/fm*
- do
-
-typeset -u fatgrp
-typeset -l fatman
-fatpath=$i
-fatgrp=`basename $i`
-fatman=$fatgrp
-eval $fatgrp=$fatpath;export $fatgrp
-#
-# and stop those servers that are running...
-#
-if [ -x ${i}/fatserv ]
- then
-#
-# does a log file exist?
-#
- if [ -f /fatmen/${fatgrp}.log ]
- then
- echo Log file exists for ${fatgrp} - looking for existing process
- log=${log}${b}${fatgrp}
- pid=`cat /fatmen/${fatgrp}.log | awk '{printf "%s\n",$14}'`
- if (test $pid)
- then
- echo Looking for server process for $fatgrp
- if(ps -ae | grep -s $pid )
- then
- echo FATSRV running PID = $pid
- run=${run}${b}${fatgrp}
- echo rm /fatmen/${fatman}/todo/signal.stop >> restart_fat
- echo Server stopped at $d > /fatmen/${fatman}/todo/signal.stop
- else
- echo No existing server found for $fatgrp
- echo Removing old log file...
- rm /fatmen/${fatgrp}.log
- if [ -f ${i}/todo/signal.stop ]
- then echo signal.stop file found!
- rm ${i}/todo/signal.stop
- echo '(removed)'
- fi
- fi
- fi
- fi
-fi
-
-done
-
-echo
-echo Log files found for $log | tr '.' ' '
-echo Servers already running for $run | tr '.' ' '
-echo fatstart >> restart_fat
-if [ -f restart_fat ]
- then chmod +x restart_fat
- echo restart reservers by typing restart_fat
-fi
diff --git a/src/packlib/fatmen/scripts/unix/fatzero.dat b/src/packlib/fatmen/scripts/unix/fatzero.dat
deleted file mode 100644
index dd24717..0000000
--- a/src/packlib/fatmen/scripts/unix/fatzero.dat
+++ /dev/null
@@ -1,37 +0,0 @@
-*
-* $Id: fatzero.dat,v 1.1.1.1 1996/03/07 15:17:52 mclareni Exp $
-*
-* $Log: fatzero.dat,v $
-* Revision 1.1.1.1 1996/03/07 15:17:52 mclareni
-* Fatmen
-*
-*
-#!/bin/ksh
-#
-# Ensure that variables are defined...
-#
-for i in /fatmen/fm*
-
- do
-
- typeset -u fatgrp
- fatpath=$i
- fatgrp=`basename $i`
- eval $fatgrp=$fatpath;export $fatgrp
-#
-# Look for startable servers (fatserv exists)
-#
- if [ -x ${i}/fatserv ]
- then
-#
-# Zero files?
-#
- for i in ${i}/todo/*
-
- do
- [ ! -s ${i} ] && echo zero length file in TODO for ${fatgrp} | \
- mail -s " ${i}: zero length file " fatcat-mgr at zfatal.cern.ch
- done
-
- fi
- done
diff --git a/src/packlib/fatmen/scripts/unix/fatzz.dat b/src/packlib/fatmen/scripts/unix/fatzz.dat
deleted file mode 100755
index 0145fff..0000000
--- a/src/packlib/fatmen/scripts/unix/fatzz.dat
+++ /dev/null
@@ -1,7 +0,0 @@
-#!/bin/ksh
-d=`date`
-#
-# Delete old zz files
-#
-find /fatmen/fm*/todo -name zz* -mtime +1 -exec rm {} \;
-#find /fatmen/fm*/todo -name zz* -mtime +1 -print ;
diff --git a/src/packlib/fatmen/scripts/unix/fmkuip.dat b/src/packlib/fatmen/scripts/unix/fmkuip.dat
deleted file mode 100644
index 34cda66..0000000
--- a/src/packlib/fatmen/scripts/unix/fmkuip.dat
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: fmkuip.dat,v 1.1.1.1 1996/03/07 15:17:51 mclareni Exp $
-*
-* $Log: fmkuip.dat,v $
-* Revision 1.1.1.1 1996/03/07 15:17:51 mclareni
-* Fatmen
-*
-*
-rm fort.23 fmcdf.f fmkuip.f
-ypatchy /cern/src/car/zebra.car fmkuip.f :go <<!
-&use,qcde.
-&use,ibmrt,*fatlib.
-&use,fmc,t=inhibit.
-&use,fmh,t=inhibit.
-&use,tms,t=inhibit.
-&use,*fmkuip.
-&asm,23.
-&exe.
-&pam,11,r=qcde,t=c.
-&pam,12,t=c,a. fatmen.cards
-&quit
-!
-kuipc fort.23 fmcdf.f
-xlf -q extname fmkuip.f fmcdf.f -L/cern/pro/lib -lpacklib -o fm
diff --git a/src/packlib/fatmen/scripts/unix/indexsql.dat b/src/packlib/fatmen/scripts/unix/indexsql.dat
deleted file mode 100644
index e179e19..0000000
--- a/src/packlib/fatmen/scripts/unix/indexsql.dat
+++ /dev/null
@@ -1,13 +0,0 @@
-*
-* $Id: indexsql.dat,v 1.1.1.1 1996/03/07 15:17:51 mclareni Exp $
-*
-* $Log: indexsql.dat,v $
-* Revision 1.1.1.1 1996/03/07 15:17:51 mclareni
-* Fatmen
-*
-*
-typeset -l group
-typeset -u ugroup
-group=$1
-ugroup=${1#'FM'}
-sed "s/THRONG/${ugroup}/g" $HOME/sql/indexfat.sql > $HOME/sql/ix${group}.sql
diff --git a/src/packlib/fatmen/scripts/unix/mkfatnew.dat b/src/packlib/fatmen/scripts/unix/mkfatnew.dat
deleted file mode 100644
index cf3a1b0..0000000
--- a/src/packlib/fatmen/scripts/unix/mkfatnew.dat
+++ /dev/null
@@ -1,40 +0,0 @@
-*
-* $Id: mkfatnew.dat,v 1.1.1.1 1996/03/07 15:17:51 mclareni Exp $
-*
-* $Log: mkfatnew.dat,v $
-* Revision 1.1.1.1 1996/03/07 15:17:51 mclareni
-* Fatmen
-*
-*
-#
-# Job to create empty FATMEN catalogue
-#
-cat <<!
-
-Please give the name of the FATMEN system. This name forms
-the top-level of the FATMEN catalogue,
-e.g. CERN, FNAL, DESY etc.
-
-!
-echo -n 'Please give the name of the FATMEN system '
-read FATSYS
-export FATSYS
-echo
-echo -n 'Please give the name of the FATMEN group '
-read FATGRP
-export FATGRP
-echo
-echo -n 'Please give the directory where the new catalogue should reside '
-read FATDIR
-OLDDIR=`pwd`
-echo Setting directory to $FATDIR ...
-cd $FATDIR
-echo Creating subdirectories ...
-mkdir todo
-mkdir tovm
-mkdir done
-chmod a+w todo
-echo Running FATNEW ...
-fatnew
-echo Restoring directory...
-cd $OLDDIR
diff --git a/src/packlib/fatmen/scripts/unix/orald.dat b/src/packlib/fatmen/scripts/unix/orald.dat
deleted file mode 100644
index 38e3850..0000000
--- a/src/packlib/fatmen/scripts/unix/orald.dat
+++ /dev/null
@@ -1,13 +0,0 @@
-*
-* $Id: orald.dat,v 1.1.1.1 1996/03/07 15:17:51 mclareni Exp $
-*
-* $Log: orald.dat,v $
-* Revision 1.1.1.1 1996/03/07 15:17:51 mclareni
-* Fatmen
-*
-*
-xlf -c -qcharlen=32000 fmlogi.f foget.f foput.f fodel.f
-xlf -q extname -qcharlen=32000 fmsrv.f fmlogi.o foget.o \
- foput.o fodel.o cltou.o $ORACLE_HOME/rdbms/lib/osntab.o \
- -L/cern/new/lib -lpacklib -L$ORACLE_HOME/rdbms/lib \
- -lora -lsql -lsqlnet -L$ORACLE_HOME/tcp/lib -ltcp -lc -o fatsrvo
diff --git a/src/packlib/fatmen/unref/Imakefile b/src/packlib/fatmen/unref/Imakefile
deleted file mode 100644
index 7743328..0000000
--- a/src/packlib/fatmen/unref/Imakefile
+++ /dev/null
@@ -1,6 +0,0 @@
-SRCS_F= fafldr.F fafndf.F fmallk.F fmcdf.F fmcfgl.F fmfc.F \ @@\
- fmfilc.F fmfind.F fmget.F fmld.F fmldir.F fmls.F fmlsc.F \ @@\
- fmltgt.F fmmake.F fmmany.F fmopen.F fmscan.F fmseac.F fmselk.F \ @@\
- getenv.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/fatmen/unref/fafldr.F b/src/packlib/fatmen/unref/fafldr.F
deleted file mode 100644
index f4376fe..0000000
--- a/src/packlib/fatmen/unref/fafldr.F
+++ /dev/null
@@ -1,90 +0,0 @@
-*
-* $Id: fafldr.F,v 1.1.1.1 1996/03/07 15:18:24 mclareni Exp $
-*
-* $Log: fafldr.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:24 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
-/*
-++++++++++++++++++++++++++FAFLDR
-.type: module
-.language: C
-.ident: next file in direcetory
-.version: 1.0 - 90-05-19
-.envir: UNIX
-.uses: <dir.h>, directory procedures
-.author: J. Shiers, Defert Ph.,
-.keywords: Directory list.
-.descript: Gives the next entry of a directory.
-----------------------------------------------------------------
-*/
-/*
- External declarations
-*/
-#include <stdio.h>
-#include <errno.h>
-#include "fafldr.h"
-
-/*
- Body
-*/
-
-int fafldr(dirnam, filnam, icont)
-char *dirnam;
-char *filnam;
-int icont;
-/*
-++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-.input: dirnam: string -> the directory name
- icont: int -> continuation flag
-.output: filnam: string -> the name of the searched file.
-.returns: status of the call (FAFLDR_OK,FAFLDR_EOF,FAFLDR_FAILED,FAFLDR_INVA
-.type: function
-.description: the name of the file returned is
- - the next in the directory opened at the preceeding
- call to fafldr if icont == 1. Thus, "dirnam" is ignored.
- - the first in the directory "dirnam" if icont == 0
-------------------------------------------------------------------------------
-*/
-{
- static DIR *dd = NULL;
- struct direct *entry;
-/*
--- open directory dirnam if necessary i.e. icont == 0
-*/
- filnam[0] = '\0';
- if (icont == 0) {
- if (dd != NULL) {
- (void)closedir(dd);
- }
- errno = 0;
- dd = opendir(dirnam);
- if (dd == NULL) {
- return(FAFLDR_FAILED);
- }
- }
-/*
--- read next entry in directory
-*/
- if (dd == NULL) {
- return(FAFLDR_INVARG);
- }
- errno = 0;
- entry = readdir(dd);
- if (entry == NULL) {
- if (errno == 0) {
- (void)closedir(dd);
- dd = NULL;
- return(FAFLDR_EOF);
- }
- else {
- (void)closedir(dd);
- dd = NULL;
- return(FAFLDR_FAILED);
- }
- }
- strcpy(filnam,entry->d_name);
- return(FAFLDR_OK);
-}
diff --git a/src/packlib/fatmen/unref/fafldr.h b/src/packlib/fatmen/unref/fafldr.h
deleted file mode 100644
index a6d6d27..0000000
--- a/src/packlib/fatmen/unref/fafldr.h
+++ /dev/null
@@ -1,34 +0,0 @@
-/*
- * $Id: fafldr.h,v 1.1.1.1 1996/03/07 15:18:25 mclareni Exp $
- *
- * $Log: fafldr.h,v $
- * Revision 1.1.1.1 1996/03/07 15:18:25 mclareni
- * Fatmen
- *
- */
-/*
-++++++++++++++++++++++++++FAFLDR
-.type: definitions
-.language: C
-.ident: next file in direcetory
-.version: 1.0 - 90-05-19
-.envir: UNIX
-.uses:
-.author: J. Shiers, Defert Ph.,
-.keywords: Directory list.
-.descript: Gives the next entry of a directory.
-----------------------------------------------------------------
-*/
-
-#include <sys/types.h>
-#include <dirent.h>
-#define direct dirent
-
-#define FAFLDR_OK ((int)0)
-#define FAFLDR_EOF ((int)1)
-#define FAFLDR_FAILED ((int)2)
-#define FAFLDR_INVARG ((int)3)
-
-
-/*extern int fafldr(char *dirnam, char *filnam, int icont);*/
-extern int fafldr();
diff --git a/src/packlib/fatmen/unref/fafndf.F b/src/packlib/fatmen/unref/fafndf.F
deleted file mode 100644
index f200349..0000000
--- a/src/packlib/fatmen/unref/fafndf.F
+++ /dev/null
@@ -1,82 +0,0 @@
-*
-* $Id: fafndf.F,v 1.1.1.1 1996/03/07 15:18:24 mclareni Exp $
-*
-* $Log: fafndf.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:24 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
-#if defined(CERNLIB_APOLLO)
-/*
-++++++++++++++++++++++++++++++APONF
-.type: module
-.language: C
-.ident: Fortran interface to nxfilindir for apollo
-.version: 1.0 - 90-05-19
-.envir: DomainIX
-.uses: nxfldr (C standard equivalent)
-.author: J. Shiers, Defert Ph.,
-.keywords: Directory list.
-.descript: Gives the next entry of a directory.
-------------------------------------------------------------------
-*/
-/*
--- external declarations
-*/
-#include <string.h>
-#include "fafldr.h"
-/*
--- body
-*/
-
-int fafndf(dirnam,filnam,icont,dirlen,fillen)
-char *dirnam;
-char *filnam;
-int *icont;
-int dirlen;
-int fillen;
-/*
-++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-.input: dirnam,dirlen: fortran string descriptor -> the directory name
- icont: int -> continuation flag
-.output: filnam,fillen: fortran string descriptor -> the name of the
- searched file.
-.returns: status of the call (NXFLDR_OK,NXFLDR_EOF,NXFLDR_FAILED,
- NXFLDR_INVARG)
-.type: function
-.description: the name of the file returned is
- - the next in the directory opened at the preceeding
- call to nxfldr if icont == 1. Thus, "dirnam" is ignored.
- - the first in the directory "dirnam" if icont == 0
-------------------------------------------------------------------------------
-*/
-{
- char direct[MAXNAMLEN + 1];
- char nextfile[MAXNAMLEN + 1];
- int status,i;
- char *p;
-/*
--- conversion of fortran input to c
-*/
- if (*icont == 0) {
- strncpy(direct,dirnam,dirlen);
- direct[dirlen] = '\0';
- p = strchr(direct,' ');
- if (p) *p = '\0';
- }
-/*
--- call to the real c function
-*/
- status = fafldr(direct,nextfile,*icont);
-/*
--- conversion of c output to fortran
-*/
- if (status == 0) {
- strncpy(filnam,nextfile,fillen);
- for (i = strlen(nextfile); i < fillen ; i++)
- filnam[i] = ' ';
- }
- return(status);
-}
-#endif
diff --git a/src/packlib/fatmen/unref/fmallk.F b/src/packlib/fatmen/unref/fmallk.F
deleted file mode 100644
index e9df7e6..0000000
--- a/src/packlib/fatmen/unref/fmallk.F
+++ /dev/null
@@ -1,40 +0,0 @@
-*
-* $Id: fmallk.F,v 1.1.1.1 1996/03/07 15:18:24 mclareni Exp $
-*
-* $Log: fmallk.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:24 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMALLK(NEWKEY,IRC)
-*
-* Allocate next unused key in CWD
-* Must be a better way of doing this...
-*
-#include "fatmen/fatpara.inc"
- PARAMETER (MAXKEY=10000)
- PARAMETER (LKEYFA=10)
- COMMON/FAALLK/KEYS
- DIMENSION KEYS(LKEYFA,MAXKEY)
-*
- IRC = 0
- CALL RZKEYS(LKEYFA,MAXKEY,KEYS,NKEYS)
-*
-* Adding at the end is easy...
-*
- IF(NKEYS.EQ.0) THEN
- NEWKEY = 1
- ELSE
-* CALL SORTI(KEYS,LKEYFA,NKEYS,MKSRFA)
-* NEWKEY = KEYS(1,NKEYS) + 1
-
- IBIG = 0
- DO 10 I=1,NKEYS
- IF(KEYS(1,I).GT.IBIG) IBIG = KEYS(1,I)
-10 CONTINUE
- NEWKEY = IBIG + 1
- ENDIF
-
- END
-
diff --git a/src/packlib/fatmen/unref/fmcdf.F b/src/packlib/fatmen/unref/fmcdf.F
deleted file mode 100644
index 96c017f..0000000
--- a/src/packlib/fatmen/unref/fmcdf.F
+++ /dev/null
@@ -1,709 +0,0 @@
-*
-* $Id: fmcdf.F,v 1.1.1.1 1996/03/07 15:18:24 mclareni Exp $
-*
-* $Log: fmcdf.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:24 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
-*----------------------------------------------------------------
-*
-* FATMEN comand definition file (CDF)
-*
-*----------------------------------------------------------------
->NAME FMCDF
->MENU FATMEN
->Guidence
-Summary of FATMEN shell comands:
-
-*----------------------------------------------------------------
->Comand ALLOCATE
->Guidence
-Use the ALLOCATE comand to add a new tape file to the FATMEN catalogue
-A tape is allocated from the specified pool. The file sequence number
-is always set to 1.
->Action FMKATT
->Parameters
-POOL 'TMS Pool ' C D=' '
-LIBRARY 'TMS Library ' C D=' '
-GNAME 'generic file name' C D=' '
-DSN 'disk dataset name' C D=' '
-FFORM 'file format (FZ, FA, FX, RZ, EP, UN, AS)' C D='UN'
-CPLEV 'copy level (0=original, 1=copy etc.)' I D=0
-HOSTN 'host name (e.g. CERNVM)' C D='thisnode'
-+
-COMM 'comment (in quotes)' C D='Added via FATMEN CLI'
-RECFM 'record format (e.g. FB, VBS)' C D=' '
-LRECL 'record length (in words)' I D=0
-BLOCK 'block length (in words)' I D=0
-FSIZE 'file size (in megabytes)' I D=0
-MEDIA 'media type (2=3480,3=3420,4=8200,...)' I D=2
-*----------------------------------------------------------------
->Comand CD
->Guidence
-Use the CD comand to change the current default directory.
-Syntax: CD path
-Options: A - all of below
- Q - show quota for new directory
- S - show number of subdirectories
- T - show creation & modification times
- U - show usage information
->Action FMCD
->PARAMETERS
-PATH 'path' C D='PWD'
-+
-CHOPT 'options ' C D=' '
-*----------------------------------------------------------------
->Comand CLR
->Guidence
-Use the CLR comand to clear the screen on a 3270 type terminal
-Syntax: CLR
->Action FMCLR
-*----------------------------------------------------------------
->Comand COPY
-
->Action FMCOPC
->PARAMETERS
-GNAME 'Generic name' C D=' '
-+
-KS1 'Input Key serial number' I D=0
-KS2 'Output Key serial number' I D=0
-POOL 'TMS Pool ' C D=' '
-LIBRARY 'TMS Library ' C D=' '
-VSN 'VSN ' C D=' '
-VID 'VID ' C D=' '
-FSEQ 'FSEQ ' I D=1
-NODE 'Remote node ' C D=' '
-FILE 'Remote file ' C D=' '
-TRANSPORT 'Transport mechanism' C D='TCPIP'
-CHOPT 'Options ' C D=' ' R='CFKLSTZ'
->Guidence
-Use the COPY comand to copy the data referenced by a generic name.
-N.B. if you wish to copy just a catalogue entry, use the comand CP.
-Syntax: COPY GNAME <options>
-Transport:
- TCPIP (default)
- DECnet (between VAX/VMS systems only)
- CHEOPS (queue for transfer via Olympus satellite)
-Options:
- C - perform copy using STAGE CHANGE
- K - keep network connection open between transfers
- L - Lock output tape volume using TMS LOCK comand
- S - STAGE IN the input file
-*----------------------------------------------------------------
->Comand CP
->Guidence
-Use the CP comand to copy a file entry.
-N.B. if you wish to copy the DATA, use the comand COPY
-Syntax: CP file1 file2
-
->Action FMCPC
->PARAMETERS
-FROM 'file1' C D=' '
-TO 'file2' C D=' '
-*----------------------------------------------------------------
->Comand DIR
->Guidence
-Use the DIR command to issue a call to RZLDIR for the specified
-path. This command is normally used for debug purposes only.
-Syntax: DIR path options
-Options: T - list also subdirectory tree
->Action FMRZLD
->Parameters
-+
-PATH 'path-name' C D=' '
-OUTPUT 'output file name ' C D='TTY'
-CHOPT 'options ' C D=' '
-*----------------------------------------------------------------
->Comand DUMP
->Guidence
-Use the DUMP comand to request a TAPEDUMP of the VID
-corresponding to the specified generic name.
-Syntax: DUMP generic-name key-serial-number
-
->Action FMDUMC
->PARAMETERS
-GENAM 'generic-name' C D=' '
-+
-KSN 'Key serial number' I D=0
-BYTES 'Number of bytes/block to dump' I D=320
-BLOCKS 'Number of blocks/file to dump' I D=1
-FILES 'Number of files to dump' I D=1
-CODE 'Character code (EBCDIC or ASCII)' C D='EBCDIC'
-*----------------------------------------------------------------
->Comand END
->Action FMKEND
->PARAMETERS
-+
->GUIDANCE
-Use the END command when no more processing with current
-FATMEN catalogue is required.
-*----------------------------------------------------------------
->Comand EXTRACT
->Action FMEXTR
->PARAMETERS
-+
-PATH 'Pathname' C D='*/*'
-OUTPUT 'Output filename' C D=' '
-CHOPT 'Options ' C D='C'
->GUIDANCE
-Use the EXTRACT command to copy a subset of the FATMEN catalogue
-to a FZ alpha exchange format file.
-Only those files that match the specified path and file name and
-the current keys selection will be written to the output file.
-e.g.
-
-set/location 2
-extr */m* my.fa
-
-will only write information about files with location code 2.
-All files begining with the letter M in all directories will
-be processed.
-*----------------------------------------------------------------
->Comand FC
->Action FMFC
->PARAMETERS
-+
-FILE 'File or pathname' C D='*'
-OUTPUT 'Output filename' C D='TTY'
-CHOPT 'Options' C D=' '
->GUIDANCE
-Use the FC comand to count the number of files in a directory.
-FC will also count the number of files which match the specified pattern
-Syntax: FC <pattern>
-Options:
- D - display number of subdirectories at each level
- F - display number of files at each level
- L - display lowest level only, i.e. directories with no subdirectories
- Z - display only directories with no (zero) files
-*----------------------------------------------------------------
->Comand FIND
->Guidence
-Use the FIND comand to FIND the specified file and associate
-it with the specified logical unit. If required, the file is
-first staged to disk.
-SYNTAX: FIND generic-name logical-unit
->Action FMFNDC
->PARAMETERS
-FILE 'NAME OF FILE' C D=' '
-LUNU 'Logical unit (nn/FTnnFlll/IOFILEnn etc.)' C D='0'
-*----------------------------------------------------------------
->Comand GIME
->Guidence
-Use the GIME comand to reaccess the disk of the service
-machine which maintains the FATMEN catalogue. This comand
-has no parameters.
-Syntax: GIME
->Action FMGIME
-*----------------------------------------------------------------
->Comand INIT
->Guidence
-Use the INIT comand to initialise the FATMEN system for the specified
-group or throng, e.g. ALEPH
-Syntax INIT GROUP or THRONG
->Action FMTHRG
->PARAMETERS
-GROUP 'Group or Throng name' C D=' '
-*----------------------------------------------------------------
->Comand LD
->Action FMLD
->PARAMETERS
-+
-FILE 'Pathname' C D='*'
-OUTPUT 'Output filename' C D='TTY'
-NLEVEL 'Number of levels to display' I D=1
-CHOPT 'Options' C D=' '
->GUIDANCE
-Use the LD comand to display the contents of a directory
-Syntax: LD pathname <options>
-Output: Redirect the output to the specified file
-Nlevel: Number of levels to descend (with option R)
-Options:
- H - write header line in output file
- R - list subdirectories recursively
- V - 'very wide' listing. As W, but 132 columns
- W - 'wide'. Subdirectories are displayed in multi-column (80) format.
-*----------------------------------------------------------------
->Comand LOCK
->Action FMLOCC
->PARAMETERS
-GENAM 'generic name' C D=' '
-+
-KSN 'Key serial number' I D=0
-CHOPT 'Options' C D=' '
->GUIDANCE
-Use the LOCK comand to disable WRITE access to the tape on which
-the file specified resides. If a negative key serial number is given,
-all entries will be locked.
-Syntax: LOCK GENERIC-NAME KEY-SERIAL-NUMBER <CHOPT>
-*----------------------------------------------------------------
->Comand LOGLEVEL
->Action FMLOGC
->PARAMETERS
-+
-LOGLEVEL 'Loglevel' I D=0
->GUIDANCE
-Use the LOGLEVEL comand to set the FATMEN logging level.
-Syntax: LOGLEVEL loglevel
-*----------------------------------------------------------------
->Comand LS
->Action FMLSC
->PARAMETERS
-+
-FILE 'File or pathname' C D='*'
-OUTPUT 'Output filename' C D='TTY'
-CHOPT 'Options' C D=' '
->GUIDANCE
-Use the LS comand to display the contents of a directory
-or display information on a given file within the current or specified
-directory
-Syntax: LS file <options>
-Options:
- A - list all attributes, except options Q and Z.
- B - brief listing - one line (80 columns) per entry
- C - display comment field associated with file
- D - listing suitable for generated a macro to delete entry
- E - extended listing - one line (132 columns) per entry
- F - list file attributes, such as start/end record and block
- G - list the full generic name of each file
- H - write header line in output file
- I - output sorted by Increasing generic name
-#if defined(CERNLIB_NEVER)
- j - <free>
-#endif
- K - list keys associated with this file (copy level, media type, location)
- L - list logical attributes, such as FATMEN file format
- (ZEBRA exchange etc.)
- M - list media attributes, such as VSN, VID, file sequence number for tape
- files, host type and operating system for disk files.
- N - lists dataset name on disk/tape of this file
- O - list owner, node and job of creator etc.
- P - list physical attributes, such as record format etc.
- Q - query TMS for corresponding volume
-#if defined(CERNLIB_NEVER)
- r - <free>
-#endif
- S - lists security details of this file (protection)
- T - list date and time of creation, last access etc.
- U - list user words.
- V - 'very wide' listing. As W, but 132 columns
- W - 'wide' listing. Filenames (part of generic name following
- last slash) are displayed in multi-column (80) format.
- X - each generic name displayed only once
- Y - verify bank contents using FMVERI.
- Z - dump ZEBRA bank with DZSHOW.
-Output: Redirect the output to the specified file
-*----------------------------------------------------------------
->Comand MAKE
->Guidence
-Use the MAKE comand to access the specified file and associate
-it with the specified logical unit in WRITE mode. For tape files,
-this corresponds to output staging.
-SYNTAX: MAKE .
->Action FMMAKC
->PARAMETERS
-FILE 'NAME OF FILE' C D=' '
-LUNU 'Logical unit (nn/FTnnFlll/IOFILEnn etc.)' C D='0'
-*----------------------------------------------------------------
->Comand MEDIA
->Guidence
-Use the MEDIA command to set or list attributes of a given
-type of media.
-e.g.
-
-MEDIA 2 3480 CT1 200 38K M SL
-
-would set the attributes of FATMEN media type 2 to
-
-model: 3480
-generic device type: CT1 (used on STAGE/SETUP requests)
-capacity: 200 MB (maximum size on STAGE command)
-density: 38K
-label : SL
-
-MEDIA with no arguments lists the current settings
-
-MEDIA 3 lists the settings for media type 3
-
->Action FMSMDK
->PARAMETERS
-+
-MEDIA 'FATMEN media type' I D=2
-TYPE 'device type ' C D='3480'
-MODEL 'generic device ' C D='CT1 '
-SIZE 'capacity in MB ' C D='200 '
-DENS 'density ' C D='38K '
-MNTP 'mount-type (M/R) ' C D='M'
-LABL 'label-type (SL/AL/NL) ' C D='SL'
-
-*----------------------------------------------------------------
->Comand MKDIR
->Guidence
-Use the MKDIR comand to create a directory
-Syntax: MKDIR directory_name.
->Action FMMKDR
->PARAMETERS
-DIRNAM 'directory' C D=' '
-*----------------------------------------------------------------
->Comand MV
->Guidence
-Use the MV comand to 'move' or rename a file
-Syntax: MV file1 file2
->Action FMMVC
->PARAMETERS
-FROM 'file1' C D=' '
-TO 'file2' C D=' '
-*----------------------------------------------------------------
->Comand PWD
->Guidence
-Use the PWD comand to print the current (working) directory.
-Syntax: PWD
->Action FMPWD
-*----------------------------------------------------------------
->Comand RM
->Guidence
-Use the RM comand to remove a file from the catalogue
-Syntax: RM file <key> <dsn> <host> <vid> <user> <pool> <prot> <chopt>
-*
-* Options: A - remove all occurances of this generic name
-* I - prompt before removing each matching entry
-* F - free tape associated with specified entry
-* G - set protection group to group specified
-* If no group is specified, then *None will be
-* used, unless option P is given, in which case
-* the POOL name will be used.
-* P - when used with option F, allows privileged TMS
-* user to free anyones tapes (within a group)
-* U - 'unlock' or write-enable tape
-*
->Action FMRMC
->PARAMETERS
-FILE 'file' C D=' '
-+
-KSN 'Key serial number' I D=0
-DSN 'Fileid/DSN' C D=' '
-HOST 'Hostname ' C D=' '
-VID 'VID ' C D=' '
-USER 'Username ' C D=' '
-POOL 'Pool to return tape to' C D=' '
-PROT 'Protection group ' C D=' '
-CHOPT 'Options' C D=' '
-*----------------------------------------------------------------
->Comand RMDIR
->Guidence
-Use the RMDIR comand to remove a directory from the catalogue.
-N.B. directories can only be removed if
- 1) They contain no subdirectories
- 2) They contain no files
-
-If you wish to remove a complete directory tree that contains
-no files, use the RMTREE command.
-
-Syntax: RMDIR DIRECTORY_NAME
->Action FMRMDC
->PARAMETERS
-FILE 'directory' C D=' '
-*----------------------------------------------------------------
->Comand RMTREE
->Guidence
-Use the RMTREE comand to remove a complete directory tree.
-N.B. if any of the directories below the named directory
-contain files, then the command file be refused.
-Syntax: RMTREE DIRECTORY_NAME
->Action FMRMTC
->PARAMETERS
-FILE 'directory' C D=' '
-*----------------------------------------------------------------
->Comand SEARCH
->Guidence
-Use the search comand to print the generic names of files which
-match the specified criteria. Character fields may include the
-* or % wild cards.
-
-e.g. SEARCH * VID=I* # search current working directory for entries
-# with VID's beginning with I.
-
-If NMATCH is non-zero, SEARCH will stop after NMATCH matches have
-been found.
-
-Set the loglevel to <0 to stop the printing of the names of
-files and directories searched.
-
-Date and time ranges may be given, as in the following example:
-which searches for files in the current directory that have been
-accessed between 31st January, 1991 and midday on 30th June 1991
-
-SEARCH * accessed=910131-910630.1200
-
-Entries that match are displayed as with the LS comand.
->Action FMSEAC
->PARAMETERS
-PATH 'path name' C D='*'
-+
-DSN 'Fileid/DSN' C D=' '
-HOST 'Hostname ' C D=' '
-VID 'VID ' C D=' '
-USER 'Username ' C D=' '
-NMATCH '# to match' I D=0
-CREATED 'date range' C D=' '
-CATALOGED 'date range' C D=' '
-ACCESSED 'date range' C D=' '
-UFORM 'user file format' C D=' '
-COMMENT 'comment' C D=' '
-OUTPUT 'Output filename ' C D='TTY'
-CHOPT 'Options ' C D=' '
- H - write header line in output file
-*----------------------------------------------------------------
->Comand TAG
->Guidence
-Use the TAG comand to get, set or delete the TMS TAG
-associated with the a tape volume that corresponds to
-the specified generic name.
-
-Syntax: TAG generic-name key-serial-number tag-text chopt
-
-Options: D - delete the tag
- G - get & display the tag
- S - set the tag
-
- B - to select the BINARY tag (stored as CHARACTER*255)
- T - to select the TEXT tag (default)
-
-If option G is specified without any TAG text, the tag
-is sent to the generic name.
->Action FMTAGC
->PARAMETERS
-FILE 'file' C D=' '
-+
-KSN 'Key serial number' I D=0
-TAG 'Tag ' C D=' '
-CHOPT 'Options ' C D=' ' R='BDGST'
-*----------------------------------------------------------------
->Comand TOUCH
->Guidence
-Use the TOUCH comand to reinsert an existing entry in the catalogue.
-If a negative key serial number is given, all matching entries
-will be updated.
-Syntax: TOUCH GENERIC-NAME KEY-SERIAL-NUMBER CHOPT
-Options:
- O - reset owner, node and job of creator etc.
- T - update date and time of last access
- U - zero use count
->Action FMTCHC
->PARAMETERS
-FILE 'file' C D=' '
-+
-KSN 'Key serial number' I D=0
-CHOPT 'Options' C D=' ' R='OTU'
-*----------------------------------------------------------------
->Comand TREE
->Guidence
-Use the TREE command to draw a directory tree starting at the
-specified directory down NLEVEL levels.
-Syntax: TREE path nlevel
->Action FMTREK
->Parameters
-+
-PATH 'Path name ' C D=' '
-NLEVEL 'number of levels' I D=99
-OUTPUT 'Output filename' C D='TTY'
-*----------------------------------------------------------------
->Comand UNLOCK
->Action FMULCC
->PARAMETERS
-GENAM 'generic name' C D=' '
-+
-KSN 'Key serial number' I D=0
-CHOPT 'Options' C D=' '
->GUIDANCE
-Use the UNLOCK comand to enable WRITE access to the tape on which
-the file specified resides. If a negative key serial number is given,
-all entries for the specified generic name will be unlocked.
-Syntax: UNLOCK GENERIC-NAME KEY-SERIAL-NUMBER <CHOPT>
-*----------------------------------------------------------------
->Comand UPDATE
->Guidence
-Use the UPDATE comand to control how updates are sent to the FATMEN
-server.
-Syntax: UPDATE MAX NGROUP IFLAG
->Action FMUPDC
->PARAMETERS
-MAX 'maximum number of updates' I D=999
-NGROUP 'number of updates to send together' I D=0
-IFLAG 'flag to purge/send/reset' I D=0
-*----------------------------------------------------------------
->Comand VERSION
->Guidence
-Use the VERSION comand to display the version of the FATMEN
-software that you are running.
-Syntax: VERSION
->Action FMVERS
-*----------------------------------------------------------------
->Comand VIEW
->Guidence
-Use the VIEW comand to edit a local disk file.
-This comand will be extended to support tape and remote files.
-Syntax: VIEW file <key>
->Action FMEDIT
->PARAMETERS
-FILE 'file' C D=' '
-+
-KSN 'Key serial number' I D=0
-*----------------------------------------------------------------
->Comand ZOOM
->Action FMZOOM
->PARAMETERS
-+
-FILE 'Pathname' C D='*'
->Guidence
-Use the ZOOM command to descend the specified (wild-carded)
-directory tree to the first lowest level directory that
-contains one of more files
-
-e.g. ZOOM DATA
- ZOOM *DST/*/P88*
-
-If no wild-cards are present in the pathname, the characters /*
-are automatically appended. To zoom down a tree starting with
-
-*ALLD, use ZOOM *ALLD/*
-
-*----------------------------------------------------------------
->Menu ADD
-*----------------------------------------------------------------
->Comand TAPE
->Guidence
-Use the ADD/TAPE comand to add a new tape file to the FATMEN catalogue
->Action FMKADT
->Parameters
-VSN 'volume serial number' C D=' '
-VID 'visual identifier' C D='VSN'
-FSEQ 'file sequence number' I D=1
-GNAME 'generic file name' C D=' '
-DSN 'dataset name' C D=' '
-FFORM 'file format (FZ, FA, FX, RZ, EP, UN, AS)' C D='UN'
-CPLEV 'copy level (0=original, 1=copy etc.)' I D=0
-HOSTN 'host name (e.g. CERNVM)' C D='THISNODE'
-+
-COMM 'comment (in SINGLE quotes)' C D='Added via FATMEN CLI'
-RECFM 'record format (e.g. FB, VBS)' C D=' '
-LRECL 'record length (in words)' I D=0
-BLOCK 'block length (in words)' I D=0
-FSIZE 'file size (in megabytes)' I D=0
-MEDIA 'media type (2=3480,3=3420,4=8200,...)' I D=2
-*----------------------------------------------------------------
->Comand DISK
->Guidence
-Use the ADD/DISK comand to add a new disk file to the FATMEN catalogue
->Action FMKADD
->Parameters
-GNAME 'generic file name' C D=' '
-DSN 'disk dataset name' C D=' '
-FFORM 'file format (FZ, FA, FX, RZ, EP, UN, AS)' C D='UN'
-CPLEV 'copy level (0=original, 1=copy etc.)' I D=0
-HOSTN 'host name (e.g. CERNVM)' C D='thisnode'
-+
-COMM 'comment (in quotes)' C D='Added via FATMEN CLI'
-RECFM 'record format (e.g. FB, VBS)' C D=' '
-LRECL 'record length (in words)' I D=0
-BLOCK 'block length (in words)' I D=0
-FSIZE 'file size (in megabytes)' I D=0
-*----------------------------------------------------------------
->Menu \SET
-*----------------------------------------------------------------
->Comand Location
->Guidance
-Use the SET/LOCATION comand to define the list of location codes
-to be used to select datasets. Only datasets with a location code
-in the specified range will be visible via LS comands, or accessible
-through FIND or MAKE comands.
-e.g.
-set/loc 1,3,5-17 # set location codes
-set/loc -1 # Clear location codes
->Action FMKLOC
->Parameters
-RANGE 'range of location codes' C D='-1'
-*----------------------------------------------------------------
->Comand COPYLEVEL
->Guidance
-Use the SET/COPYLEVEL comand to define the list of copy levels
-to be used to select datasets. Only datasets with a copy levels
-in the specified range will be visible via LS comands, or accessible
-through FIND or MAKE comands.
-e.g.
-set/loc 1,3,5-17 # set copy levels
-set/loc -1 # Clear copy levels
->Action FMKCPL
->Parameters
-RANGE 'range of copy levels' C D='-1'
-*----------------------------------------------------------------
->Comand MEDIATYPE
->Guidance
-Use the SET/MEDIATYPE comand to define the list of media types
-to be used to select datasets. Only datasets with a media type
-in the specified range will be visible via LS comands, or accessible
-through FIND or MAKE comands.
-e.g.
-set/loc 1,3,5-17 # set media types
-set/loc -1 # Clear media types
->Action FMKMTP
->Parameters
-RANGE 'range of media types' C D='-1'
-*----------------------------------------------------------------
->Comand USERWORDS
->Guidance
-Use the SET/USERWORDS comand to define the ranges for the user
-words that will be used in subsequent SEARCH commands.
-e.g.
-set/user 1-10 3 5 17 99-103 6 72 777 888-999 42
->Action FMKUWD
->Parameters
-+
-UWORD1 'range or value for user word 1 ' C D=' '
-UWORD2 'range or value for user word 2 ' C D=' '
-UWORD3 'range or value for user word 3 ' C D=' '
-UWORD4 'range or value for user word 4 ' C D=' '
-UWORD5 'range or value for user word 5 ' C D=' '
-UWORD6 'range or value for user word 6 ' C D=' '
-UWORD7 'range or value for user word 7 ' C D=' '
-UWORD8 'range or value for user word 8 ' C D=' '
-UWORD9 'range or value for user word 9 ' C D=' '
-UWORD10 'range or value for user word 10 ' C D=' '
-*----------------------------------------------------------------
->Menu \SHOW
-*----------------------------------------------------------------
->Comand Location
->Guidance
-Use the SHOW/LOCATION comand to show the list of location codes
-that are currently in effect. Only datasets with a location code
-in the displayed range will be visible via LS comands, or accessible
-through FIND or MAKE comands.
->Action FMSLOC
-*----------------------------------------------------------------
->Comand COPYLEVEL
->Guidance
-Use the SHOW/COPYLEVEL comand to show the list of copy levels
-that are currently in effect. Only datasets with a copy level
-in the displayed range will be visible via LS comands, or accessible
-through FIND or MAKE comands.
->Action FMSCPL
-*----------------------------------------------------------------
->Comand MEDIATYPE
->Guidance
-Use the SHOW/MEDIATYPE comand to show the list of media types
-that are currently in effect. Only datasets with a media type
-in the displayed range will be visible via LS comands, or accessible
-through FIND or MAKE comands.
->Action FMSMTP
-*----------------------------------------------------------------
->Comand USERWORDS
->Guidance
-Use the SHOW/USERWORDS comand to show the list of ranges for
-the 10 user words that are currently in effect.
-Only entries which match the current user word ranges will
-be found be the SEARCH command.
->Action FMSUWD
-* Sequence for FATMEN user comands
-#include "fatmen/fmucdf.inc"
-* Ignoring t=pass
diff --git a/src/packlib/fatmen/unref/fmcfgl.F b/src/packlib/fatmen/unref/fmcfgl.F
deleted file mode 100644
index 347fdca..0000000
--- a/src/packlib/fatmen/unref/fmcfgl.F
+++ /dev/null
@@ -1,103 +0,0 @@
-*
-* $Id: fmcfgl.F,v 1.1.1.1 1996/03/07 15:18:25 mclareni Exp $
-*
-* $Log: fmcfgl.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:25 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
-#if defined(CERNLIB_UNIX)||defined(CERNLIB_VAXVMS)
- SUBROUTINE FMCFGL(LUNPTR,CHLINE,LLINE,CHOPT,IRC)
-*CMZ : 14/11/91 15.21.53 by Jamie Shiers
-*-- Author : Jamie Shiers 14/11/91
-*
-* Get a line from a Unix file using C I/O
-*
-* IOPTF: flush buffer from previous operation
-*
- CHARACTER*(*) CHLINE,CHOPT
- CHARACTER*80 CHBUFF
- CHARACTER*1 NL
-#if defined(CERNLIB_CRAY)
- PARAMETER (IQCHAW=8)
-#endif
-#if !defined(CERNLIB_CRAY)
- PARAMETER (IQCHAW=4)
-#endif
-#include "fatmen/fatoptd.inc"
- DATA NENTRY/0/,ISTART/0/
- SAVE NENTRY,NL,ISTART,LBUFF,NBUFF
-
- CALL FMOPTC(CHOPT,ALFNUM,IOPT)
-
- IRC = 0
-
- IF(NENTRY.EQ.0) THEN
- NENTRY = 1
- NL = CHAR(10)
- NBUFF = LEN(CHBUFF)
- LBUFF = NBUFF/IQCHAW
- ENDIF
-
- IF(IOPTF.NE.0) THEN
- ISTART = 0
- CHBUFF = ' '
- RETURN
- ENDIF
-*
-* Get logical line
-*
- LLINE = 0
- IF(ISTART.EQ.0) THEN
- NWTAK = LBUFF
- CALL CFGET(LUNPTR,0,LBUFF,NWTAK,CHBUFF,ISTAT)
-
- IF(ISTAT.NE.0.AND.ISTAT.NE.-1) RETURN
- JBUFF = NWTAK*IQCHAW
- ISTART = 1
- ENDIF
-*
-* Look for newline character
-*
- IEND = INDEX(CHBUFF(ISTART:JBUFF),NL)
- IF(IEND.NE.0) THEN
- LLINE = IEND - 1
- CHLINE = CHBUFF(ISTART:ISTART+IEND-1)
- ISTART = ISTART + IEND
- RETURN
- ELSE
-*
-* Move first part of line
-*
-10 CONTINUE
- CHLINE = CHBUFF(ISTART:JBUFF)
- ISTART = JBUFF + ISTART - 1
- LLINE = ISTART
-*
-* Get next buffer
-*
- NWTAK = LBUFF
- CALL CFGET(LUNPTR,0,LBUFF,NWTAK,CHBUFF,ISTAT)
- IF(ISTAT.NE.0.AND.ISTAT.NE.-1) RETURN
- JBUFF = NWTAK*IQCHAW
-*
-* Look for end of last line
-*
- IEND = INDEX(CHBUFF(1:JBUFF),NL)
-*
-* Is first character a newline?
-*
- IF(IEND.GT.1) THEN
- CHLINE(ISTART+1:ISTART+IEND-1) = CHBUFF(1:IEND-1)
- LLINE = ISTART + IEND - 1
- ISTART = IEND + 1
- ELSE
- CHLINE(ISTART+1:ISTART+JBUFF-1) = CHBUFF(1:JBUFF)
- GOTO 10
- ENDIF
-
- ENDIF
-
- END
-#endif
diff --git a/src/packlib/fatmen/unref/fmfc.F b/src/packlib/fatmen/unref/fmfc.F
deleted file mode 100644
index 8b9a0ad..0000000
--- a/src/packlib/fatmen/unref/fmfc.F
+++ /dev/null
@@ -1,211 +0,0 @@
-*
-* $Id: fmfc.F,v 1.1.1.1 1996/03/07 15:18:23 mclareni Exp $
-*
-* $Log: fmfc.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:23 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMFC
- PARAMETER (MAXFIL=100)
- PARAMETER (MAXDIR=500)
- PARAMETER (LKEYFA=10)
- CHARACTER*255 FILES,PATH,CHPATH,PREDIR
- CHARACTER*255 PATH2
- CHARACTER*255 CHDIR(MAXDIR),CHTMP
-#include "fatmen/fatsys.inc"
-#include "fatmen/fatout.inc"
- CHARACTER*20 CHFILE,MATCH,FNAME
- CHARACTER*36 CHOPT,OPTN
- CHARACTER*3 CHSTAT
-#include "fatmen/fatbank.inc"
-#include "fatmen/fatpara.inc"
- COMMON/FATFC/FILES(MAXFIL),MYKEYS(LKEYFA,MAXFIL)
- LOGICAL IEXIST,IOPEN
- DATA NENT/0/
-#include "fatmen/fatinit.inc"
-*
- OUTPUT = ' '
- LOUT = 0
- LWRITE = LPRTFA
- CALL FACDIR(PREDIR,'R')
-
- PATH = ' '
- CALL KUGETC(PATH,LPATH)
- CALL KUGETC(OUTPUT,LOUT)
- CALL KUGETC(CHOPT,LCHOPT)
-
- CALL FMFIXF(PATH,PATH2)
- PATH = PATH2
- LPATH = LENOCC(PATH)
-
- IF(LCHOPT.EQ.0) THEN
- CHOPT = ' '
- LCHOPT = 1
- ENDIF
-
- LWRITE = LPRTFA
-*
-* Fix for strange KUIP behaviour...
-*
- IF(OUTPUT(1:1).EQ.'-') THEN
- CHOPT = OUTPUT
- LCHOPT = LOUT
- OUTPUT = 'TTY'
- LOUT = 3
- ENDIF
-
- IF((OUTPUT(1:LOUT).NE.'TTY').OR.(LOUT.EQ.0)) THEN
- LWRITE = 3
- IF(IDEBFA.GE.2)
- + PRINT *,'FMFC. output will be redirected to ',OUTPUT(1:LOUT)
- CALL FAFILE(LWRITE,OUTPUT(1:LOUT),IRET)
- IF(IRET.NE.0) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMFC. error ',IRET,
- + ' opening file ',OUTPUT(1:LOUT),
- + ' - output will be sent to the screen'
- LWRITE = LPRTFA
- OUTPUT = 'TTY'
- ENDIF
- ELSE
- OUTPUT = 'TTY'
- ENDIF
-*
- IF(INDEX(CHOPT(1:LCHOPT),'H').NE.0) THEN
- WRITE(LWRITE,*) '>>> Command: FC ',
- + 'Options: ',CHOPT(1:LCHOPT)
- WRITE(LWRITE,*) '>>> Path: ',PATH(1:LPATH)
- WRITE(LWRITE,*) '>>> Current directory: ',
- + PREDIR(1:LENOCC(PREDIR))
- ENDIF
-*
-
- IOPTD = 0
- IOPTF = 0
- IOPTL = 0
- IOPTZ = 0
- IF(INDEX(CHOPT(1:LCHOPT),'D').NE.0) IOPTD = 1
- IF(INDEX(CHOPT(1:LCHOPT),'F').NE.0) IOPTF = 1
- IF(INDEX(CHOPT(1:LCHOPT),'L').NE.0) IOPTL = 1
- IF(INDEX(CHOPT(1:LCHOPT),'Z').NE.0) IOPTZ = 1
-
- IF(IOPTL.NE.0) IOPTD = 1
- IF(IOPTZ.NE.0) IOPTF = 1
-*
- NFOUND = 0
- NMATCH = 0
- NDIRT = 0
-*
-* Count number of files matching pattern
-*
- LSLASH = INDEXB(PATH(1:LPATH),'/')
- CHPATH = PATH(1:LSLASH-1)
- CHFILE = PATH(LSLASH+1:LPATH)
- LP = LENOCC(CHPATH)
- LF = LENOCC(CHFILE)
- IF(IDEBFA.GE.2) PRINT *,'FMFC. enter for ',PATH(1:LPATH)
- IWILD = ICFMUL('*%(<',CHPATH,1,LP)
- IF(IWILD.LE.LP) THEN
- GOTO 10
- ELSE
- NDIRS = 1
- CHDIR(1) = CHPATH
- GOTO 20
- ENDIF
-*
-* Get list of subdirectories
-*
- 10 CONTINUE
- CALL FMLDIR(CHPATH(1:LP),CHDIR,NDIRS,MAXDIR,ICONT,IRC)
- IF(IRC.EQ.-1) THEN
- ICONT = 1
- ELSE
- ICONT = 0
- ENDIF
-
- 20 CONTINUE
-
- NDIRT = NDIRT + NDIRS
-
- DO 70 I=1,NDIRS
- LEND = LENOCC(CHDIR(I))
- CALL FACDIR(CHDIR(I)(1:LEND),' ')
-*
-* How many subdirectories are there at this level?
-*
- CALL RZRDIR(1,CHTMP,NDIR)
- NDIR = IQUEST(11)
-*
-* Get total number of files, number which match
-*
- IFIRST = 1
- ILAST = MAXFIL
- NMAT = 0
- NFIL = 0
-
- 30 CONTINUE
- CALL FMKEYS(LKEYFA,MAXFIL,IFIRST,ILAST,MYKEYS,NFILES,IRET)
- NFIL = IQUEST(11)
- IF(IQUEST(1) .NE. 0) THEN
- IF(IDEBFA.GE.2) PRINT *,'FMFC. More than ',MAXFIL,' files '
- + //'in ',PATH(1:LP)
- IF(IDEBFA.GE.2) PRINT *,'FMFC. IQUEST(11-12) = ',IQUEST(11)
- + ,IQUEST(12)
- ENDIF
-*
-* Process all keys returned and move those that match to KEYS
-*
- NRET = IQUEST(13)
- IF(NRET.EQ.0) GOTO 60
- 40 CONTINUE
- DO 50 J=1,NRET
- CALL UHTOC(MYKEYS(2,J),4,FNAME,(MKCLFA-MKFNFA)*4)
- CALL FMATCH(FNAME(1:LENOCC(FNAME)),CHFILE(1:LF),IMAT)
- IF(IMAT.NE.0) GOTO 50
- NMAT = NMAT + 1
-
- 50 CONTINUE
- IF(ILAST.LT.NFIL) THEN
- IFIRST = IFIRST + MAXFIL
- ILAST = MIN(NFIL,IFIRST+MAXFIL-1)
- GOTO 30
- ENDIF
-
- 60 CONTINUE
- NFOUND = NFOUND + NFIL
- NMATCH = NMATCH + NMAT
-*
-* Display only empty (zero files) directories
-*
- IF((IOPTZ.NE.0).AND.(NFIL.NE.0)) GOTO 70
-*
-* Display only lowest level directories
-*
- IF((IOPTL.NE.0).AND.(NDIR.NE.0)) GOTO 70
-
- IF((IOPTD.NE.0).OR.(IOPTF.NE.0)) THEN
- WRITE(LWRITE,*)
- WRITE(LWRITE,*) 'Directory: ',CHDIR(I)(1:LEND)
- ENDIF
-
- IF(IOPTD.NE.0) WRITE(LWRITE,*) ' subdirectories: ',NDIR
-*
-* Number of files, matches
-*
- IF(IOPTF.NE.0) WRITE(LWRITE,*) ' files: ',NFIL,
- + ' matches: ',NMAT
-
- 70 CONTINUE
- IF(ICONT.NE.0) GOTO 10
-
- WRITE(LWRITE,9001) NMATCH,NFOUND,NDIRT
- 9001 FORMAT(' Total of ',I6,' matches (',I6,' files) in ',I6,
- + ' directories')
-
- INQUIRE(3,OPENED=IOPEN)
- IF(IOPEN) CLOSE(3)
-
- CALL FACDIR(PREDIR,' ')
- RETURN
- END
diff --git a/src/packlib/fatmen/unref/fmfilc.F b/src/packlib/fatmen/unref/fmfilc.F
deleted file mode 100644
index c26b620..0000000
--- a/src/packlib/fatmen/unref/fmfilc.F
+++ /dev/null
@@ -1,47 +0,0 @@
-*
-* $Id: fmfilc.F,v 1.1.1.1 1996/03/07 15:18:24 mclareni Exp $
-*
-* $Log: fmfilc.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:24 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMFILC(PATH,NFILES,IRC)
- PARAMETER (MAXFIL=1000)
- PARAMETER (LKEYFA=10)
- DIMENSION KEYS(LKEYFA,MAXFIL)
- CHARACTER*(*) PATH
- CHARACTER*255 FILES,CHPATH,PREDIR
- CHARACTER*20 CHFILE,MATCH
- CHARACTER*36 CHOPT,OPTN
-#include "fatmen/fatbank.inc"
- COMMON /MYWKSP/ FILES(MAXFIL)
-*
- IRC = 0
- NFILES = 0
-*
-* Count number of files matching pattern
-*
- LPATH = LENOCC(PATH)
- LSLASH = INDEXB(PATH(1:LPATH),'/')
- CHPATH = PATH(1:LSLASH-1)
- CHFILE = PATH(LSLASH+1:LPATH)
- LP = LENOCC(CHPATH)
- LF = LENOCC(CHFILE)
- IF(IDEBFA.GE.2) PRINT *,'FMFILC. enter for ',PATH(1:LPATH)
- CALL FMLIST(CHPATH(1:LP),FILES,KEYS,NFOUND,MAXFIL,IRC)
- DO 200 I=1,NFOUND
- LFILE = LENOCC(FILES(I))
- JSLASH = INDEXB(FILES(I)(1:LFILE),'/')
- MATCH = FILES(I)(JSLASH+1:LFILE)
- LM = LENOCC(MATCH)
- CALL FMATCH(MATCH(1:LM),CHFILE(1:LF),IMAT)
- IF(IMAT.NE.0) GOTO 200
- LBANK=0
- NFILES = NFILES + 1
-200 CONTINUE
-
- RETURN
- END
-
diff --git a/src/packlib/fatmen/unref/fmfind.F b/src/packlib/fatmen/unref/fmfind.F
deleted file mode 100644
index e18d609..0000000
--- a/src/packlib/fatmen/unref/fmfind.F
+++ /dev/null
@@ -1,1068 +0,0 @@
-*
-* $Id: fmfind.F,v 1.1.1.1 1996/03/07 15:18:23 mclareni Exp $
-*
-* $Log: fmfind.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:23 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMFIND(GENAME,CHLUN,LENTRY,IRC)
-*
-#include "fatmen/fatbank.inc"
-#include "fatmen/fatpara.inc"
-#include "fatmen/tmsdef.inc"
-#include "fatmen/fatstg.inc"
-#include "fatmen/fattyp.inc"
-#include "fatmen/fatinfo.inc"
-#include "zebra/zmach.inc"
-#include "fatmen/fatvidp.inc"
- PARAMETER (LKEYFA=10)
- DIMENSION KEYS(LKEYFA)
- CHARACTER*8 ROUTIN,STATE
- CHARACTER*16 SHUSER,SHPOOL
- CHARACTER*12 FORMT
- CHARACTER*255 COMAND,SETUP,LABELDEF,FILEDEF,CHFILE
- CHARACTER*255 CHNFS,CHDSN
- CHARACTER*4 DEVTYP
- CHARACTER*6 VSN,VID,FSEQ
- CHARACTER*15 XVID
- CHARACTER*8 VIP
- CHARACTER*2 LABEL
- CHARACTER*6 CHRECL,CHBLK
- CHARACTER*6 VAXLAB(3)
- CHARACTER*2 IBMLAB(3)
- CHARACTER*(*) GENAME
- CHARACTER*8 HNAME,HTYPE,HSYS,HDISK
- CHARACTER*8 USER,ADDR
- CHARACTER*8 CHUSER
- CHARACTER*256 DSN
- CHARACTER*2 MODE
- CHARACTER*80 CHLINE
- CHARACTER*8 FORLUN
- INTEGER FMHOST,FMUSER
- CHARACTER*5 IOMODE
- CHARACTER*4 FFORM,FTEMP
- CHARACTER*(*) CHLUN
- CHARACTER*6 CDEN
- CHARACTER*4 CSIZE
- CHARACTER*4 FZOPT,RZOPT,SHOPT
- CHARACTER*20 STGOPT
- CHARACTER*1 VMOPT
- CHARACTER*40 DCB
- CHARACTER*20 FNAME
- CHARACTER*4 RECFM1
- CHARACTER*4 RECFM
- CHARACTER*8 RING
- CHARACTER*8 DDNAME
- CHARACTER*1 DEVNAM
- CHARACTER*3 DEVNUM
- CHARACTER*12 CHDIR
-#if defined(CERNLIB_UNIX)
- INTEGER SYSTEMF
-#endif
- LOGICAL IWAIT
- DIMENSION LENTRY(1)
- DATA NENTRY/0/
- DATA IBMLAB(1)/'SL'/,IBMLAB(2)/'NL'/IBMLAB(3)/'AL'/
- DATA VAXLAB(1)/'EBCDIC'/,
- + VAXLAB(2)/'NONE '/,
- + VAXLAB(3)/'ASCII '/
-#include "fatmen/fatoptd.inc"
-*
-* Set routine name
-*
- ROUTIN = 'FMFIND. '
- NCH = LENOCC(GENAME)
- CALL VZERO(IOPT,36)
-C======================== Modified by C. Onions =================
- IF (LENTRY(1) .EQ. 0) THEN
- IF(IDEBFA.GE.1) WRITE(LPRTFA,9011) GENAME(1:NCH)
-9011 FORMAT(' FMFIND. find ',A)
- CALL FMGET(GENAME,LENTRY,KEYS,IRC)
- IF (IRC.NE.0) RETURN
- ELSE
- IF(IDEBFA.GE.1) WRITE(LPRTFA,9012) GENAME(1:NCH)
-9012 FORMAT(' FMFIND. find ',A,' using user supplied bank')
- ENDIF
-C======================== End of C. Onions modification =========
- IMODE = 0
- IOMODE = '/IN '
-#if defined(CERNLIB_IBMVM)
- CALL FMONIT('FMFIND. '//GENAME(1:NCH))
-#endif
- GOTO 10
-
-10 CONTINUE
- L = LENTRY(1)
-*
-* CHLUN can have the following formats:
-*
-* nn
-* FTnnFlll
-* IOFILEnn
-* FORnnn
-* fort.nn
-*
- LUN = 0
- LCHLUN = LENOCC(CHLUN)
-* Dirty trick to satisfy Unix machines
- IF (LCHLUN .EQ. 1) THEN
- READ(CHLUN,1) LUN
- ELSEIF(LCHLUN .EQ. 2) THEN
- READ(CHLUN,2) LUN
- ENDIF
-1 FORMAT(I1)
-2 FORMAT(I2)
-
- IC = FMUSER(CHUSER)
-
-#if defined(CERNLIB_SETUP)
- IF((IOPTT.EQ.0).AND.(IDEBFA.GE.0).AND.(NENTRY.EQ.0))
- +PRINT *,ROUTIN//'Tape staging has been disabled at this location'
- NENTRY = 1
- IOPTT = 1
-#endif
-#if defined(CERNLIB_STAGE)
- IF((IOPTT.NE.0).AND.(IDEBFA.GE.0).AND.(NENTRY.EQ.0))
- +PRINT *,ROUTIN//'Tape staging is enforced at this location'
- NENTRY = 1
- IOPTT = 0
-#endif
- CALL CLTOU(GENAME)
- CALL UHTOC(IQ(L+KOFUFA+MFQNFA),4,DSN,NFQNFA)
- LDSN = LENOCC(DSN)
- LBLANK = INDEX(DSN,' ')
- IF(LBLANK.NE.0) LDSN = LBLANK
-#if defined(CERNLIB_UNIX)
-*
-* If DSN starts with a $, assume that it is an environmental
-* variable.
- IF(DSN(1:1).EQ.'$') THEN
- LENV = INDEX(DSN(1:LDSN),'/')
- CALL GETENVF(DSN(2:LENV-1),CHNFS)
- IF(IS(1).GT.0) THEN
- CHDSN = CHNFS(1:IS(1)) // DSN(LENV:LDSN)
- LDSN = LENOCC(DSN)
- DSN = CHDSN(1:LDSN)
- ELSE
- IF(IDEBFA.GE.-3) PRINT *,'FMFIND. cannot translate ',
- + ' environmental variable ',DSN(1:LENV-1)
- ENDIF
- ENDIF
-#endif
-*
-* Get DCB information
-*
- CALL UHTOC(IQ(L+KOFUFA+MRFMFA),4,RECFM,4)
- LRECL = IQ(L+KOFUFA+MRLNFA)*4
- LBLOCK = IQ(L+KOFUFA+MBLNFA)*4
-*
-* FATMEN file format (for call to FZFILE,RZFILE)
-*
- CALL UHTOC(IQ(L+KOFUFA+MFLFFA),4,FFORM,4)
-*
-* New Zebra uses FORTRAN I/O as default...
-*
- LFORM = LENOCC(FFORM)
- IF(FFORM(1:2).EQ.'FX') THEN
- FTEMP = FFORM
- FFORM = 'F'//FTEMP(1:LFORM)
- ENDIF
-*
-* Find file and STAGE if necessary
-*
-*
-* Disk files ...
-*
- IF (IQ(L+KOFUFA+MMTPFA) .EQ. 1) THEN
-*
-* File is on disk. Check on Node etc. has been done in FMRZIN
-*
- IC = FMHOST(HNAME,HTYPE,HSYS)
- CALL UHTOC(IQ(L+KOFUFA+MHSNFA),4,HDISK,8)
- LHOST = LENOCC(HNAME)
-
-#if defined(CERNLIB_IBMVM)
- COMAND = 'FILEDEF FTnnF001 DISK '
- IF ((FFORM(1:2) .EQ. 'FX') .OR. (FFORM(1:2) .EQ. 'EP'))
- + COMAND = 'FILEDEF IOFILEnn DISK '
- WRITE(COMAND(17:18),9001) LUN
- IF (COMAND(17:17) .EQ. ' ') COMAND(17:17) = '0'
- IF (LUN .EQ. 0) COMAND(15:22) = CHLUN
-*
-* Get disk name and link to it
-*
-
- LSTA = INDEX(DSN,'<')
- IF (LSTA .NE. 0) THEN
-*
-* Format of DSN is <user.address>filename.filetype on VM
-*
- LDOT = INDEX(DSN,'.')
- LBRA = INDEX(DSN,'>')
-
- IF ((LDOT .NE. 0) .AND. (LDOT .LE. LBRA)) THEN
- LEND = LDOT
- ELSE
- LEND = LBRA
- ENDIF
-
- USER = DSN(LSTA+1:LEND-1)
- LUSR = LEND - LSTA + 1
- ADDR = ' '
-
- IF ((LDOT .NE. 0) .AND. (LDOT .LE. LBRA)) THEN
- ADDR= DSN(LDOT+1:LBRA-1)
- ENDIF
-
- CALL VMCMS('EXEC GIME '//USER(1:LUSR)//ADDR//
- + '(QUIET NONOTICE STACK)',IRC)
- IF(IRC.GT.4) THEN
- IF(IDEBFA.GE.0)
- + PRINT *,ROUTIN//' return code from GIME = ',IRC
- RETURN
- ENDIF
-
- CALL VMRTRM(CHLINE,LENGTH)
- MODE = CHLINE(1:1)
-*
-* Use mode 4 for all CMS files, except RECFM F
-* N.B. files in CMS format V will be incorrectly handled!
-* To be read correctly, RECFM=U
-*
- IF (FFORM(1:2) .EQ. 'RZ') THEN
- MODE(2:2) = '6'
- ELSE
- MODE(2:2) = '4'
- ENDIF
-
- IF (RECFM(1:1) .EQ. 'U') MODE(2:2) = '1'
- IF(IDEBFA.GE.0) WRITE(LPRTFA,9015) ROUTIN,USER,ADDR,MODE
-9015 FORMAT(1X,A8,'linked to ',A8,' address ',A3,' mode ',A4)
- ELSE
- MODE = '*'
- ENDIF
-
- LDOT = INDEXB(DSN,'.')
- DSN(LDOT:LDOT) = ' '
- COMAND = COMAND(1:30) // DSN(LBRA+1:LDSN) // ' ' // MODE
- LENCOM = LENOCC(COMAND)
- WRITE(DCB,8001) RECFM,LRECL,LBLOCK
-* IF(IMODE.NE.0) THEN
- COMAND = COMAND(1:LENOCC(COMAND)) // '(' // DCB
-* ENDIF
-
- LENCOM = LENOCC(COMAND)
- IF(IDEBFA.GE.0)
- + PRINT *,ROUTIN//'running ',COMAND(1:LENCOM)
-
- CALL VMCMS(COMAND(1:LENCOM),IRC)
-
-#endif
-#if defined(CERNLIB_VAXVMS)
-*
-* Find disk with most space
-*
- IF(IMODE.NE.0) CALL FMXDSK(DSN,IRC)
-*
-* Just assign the relevant logical name...
-*
- FORLUN = 'FOR00N'
- WRITE(FORLUN(4:6),9002) LUN
-9002 FORMAT(I3)
- IF (FORLUN(4:4) .EQ. ' ') FORLUN(4:4) = '0'
- IF (FORLUN(5:5) .EQ. ' ') FORLUN(5:5) = '0'
- IF (LUN .EQ. 0) FORLUN = CHLUN
- IC = LIB$SET_LOGICAL(FORLUN(1:LENOCC(FORLUN)),
- + DSN(1:LDSN))
- IF (.NOT. IC) CALL LIB$SIGNAL(%VAL(STATUS))
- IF (IDEBFA .GE. 2) WRITE(LPRTFA,*) 'Assign ',DSN(1:LDSN),
- + FORLUN(1:LENOCC(FORLUN))
-#endif
-#if defined(CERNLIB_UNIX)
-*
-* Just issue the assign...
-*
- FORLUN = 'fort. '
- IF(LUN.LT.10) THEN
- WRITE(FORLUN(6:6),'(I1)') LUN
- ELSE
- WRITE(FORLUN(6:7),'(I2)') LUN
- ENDIF
-
- IF (LUN .EQ. 0) FORLUN = CHLUN
- LFLUN = LENOCC(FORLUN)
-#endif
-#if (defined(CERNLIB_UNIX))&&(!defined(CERNLIB_SHIFT))
- CALL CUTOL(DSN)
-#endif
-#if (defined(CERNLIB_UNIX))&&(!defined(CERNLIB_CRAY))&&(!defined(CERNLIB_SHIFT))&&(!defined(CERNLIB_APOLLO))
- IC = SYSTEMF('ln -s '//DSN(1:LDSN)//' '
- + //FORLUN(1:LFLUN))
- IF (IDEBFA .GE. 2) WRITE(LPRTFA,*) 'ln for logical unit ',
- + FORLUN(1:LFLUN),' dsn = ',DSN(1:LDSN)
-#endif
-#if defined(CERNLIB_APOLLO)
- IC = SYSTEMF('ln -s '//DSN(1:LDSN)//' '
- + //FORLUN(1:LFLUN))
- IF (IDEBFA .GE. 2) WRITE(LPRTFA,*) 'ln for logical unit ',
- + FORLUN(1:LFLUN),' dsn = ',DSN(1:LDSN)
-#endif
-#if (defined(CERNLIB_UNIX))&&(defined(CERNLIB_CRAY))
- IC = SYSTEMF('assign -a '//DSN(1:LDSN)//' '
- + //FORLUN(1:LFLUN))
- IF (IDEBFA .GE. 2) WRITE(LPRTFA,*) 'Assign for logical unit ',
- + FORLUN(1:LFLUN),' dsn = ',DSN(1:LDSN)
-#endif
-#if (defined(CERNLIB_UNIX))&&(defined(CERNLIB_SHIFT))
-*
-* Check if link already exists...
-*
- INQUIRE(FILE=FORLUN(1:LFLUN),EXIST=ILINK)
- IF(ILINK) THEN
- IF(IDEBFA.GE.0)
- + PRINT *,'FMFIND. removing existing symbolic link...'
- IC = SYSTEMF('rm '//FORLUN(1:LFLUN))
- ENDIF
-
- IF(LUN.LT.10) THEN
- WRITE(FORLUN,'(I1)') LUN
- ELSE
- WRITE(FORLUN,'(I2)') LUN
- ENDIF
-
- LFLUN = LENOCC(FORLUN)
-
- CALL CTRANS('<','[',DSN,1,LDSN)
- CALL CTRANS('>',']',DSN,1,LDSN)
- ILSQB = INDEX(DSN(1:LDSN),'[')
- IRSQB = INDEX(DSN(1:LDSN),']')
-
-
- IF(ILSQB.NE.0) THEN
-
- IF(IDEBFA.GE.0) PRINT *,'FMFIND. SHIFT POOL file...'
-
- IDOT = INDEX(DSN(1:IRSQB),'.')
- SHPOOL = DSN(2:IDOT-1)
- SHUSER = DSN(IDOT+1:IRSQB-1)
- ISTART = IRSQB+1
- IEND = LDSN
- IF (IDEBFA.GE.0) WRITE(LPRTFA,*) 'Assign for logical unit ',
- + FORLUN(1:LFLUN),' pool = ',SHPOOL,
- + ' user = ',SHUSER,' dsn = ',DSN(ISTART:IEND)
- IC = SYSTEMF('assign ` sfget -k -p '//SHPOOL//
- + ' -u '//SHUSER// ' '//DSN(ISTART:IEND)//' `
- + '//FORLUN(1:LFLUN)//' ')
- IF(IC.NE.0) THEN
- PRINT *,'FMFIND. return code ',IC,' from SFGET'
- RETURN
- ENDIF
- ELSE
-
- IF(IDEBFA.GE.0) PRINT *,'FMFIND. SHIFT private file...'
- IF (IDEBFA.GE.0) WRITE(LPRTFA,*) 'Assign for logical unit ',
- + FORLUN(1:LFLUN),' dsn = ',DSN(1:LDSN)
- IC = SYSTEMF('assign '//DSN(1:LDSN)//' '//
- + FORLUN(1:LFLUN))
- IF(IC.NE.0) THEN
- PRINT *,'FMFIND. return code ',IC,' from SFGET'
- RETURN
- ENDIF
- ENDIF
-
-#endif
-*
-* Tape files ...
-*
- ELSEIF(IQ(L+KOFUFA+MMTPFA) .GT. 1) THEN
-
- CDEN = CHMDEN(IQ(L+KOFUFA+MMTPFA))
-*
-* "EXEC STAGE IN ddname vsn.fseq.label.vid" (IBM)
-* "STAGE/IN vsn vid /NAME=/NUMB=/GENERIC=/LABEL= ddname" (VAX)
-* "stagein fort.lun -v vsn -V vid -l sl|nl|al|blp
-* -g TAPE|CART|SMCF -d 6250|1600" (CRAY)
-* "stagein -U unit -v vsn -V vid -l sl|nl|al|blp
-* -g TAPE|CART|SMCF -d 6250|1600" (SHIFT)
-*
- CALL UHTOC(IQ(L+KOFUFA+MVSNFA),4,VSN,6)
- LVSN = LENOCC(VSN)
- CALL CLTOU(VSN)
- CALL UHTOC(IQ(L+KOFUFA+MVIDFA),4,VID,6)
- LVID = LENOCC(VID)
- CALL CLTOU(VID)
-*
-* Generate eXtended VID - with VID prefix
-*
- JP = IQ(L+KOFUFA+MVIPFA)
- IF(JP.NE.0) THEN
- LVIP = LENOCC(PREVID(JP))
- VIP = PREVID(JP)(1:LVIP)
- XVID = PREVID(JP)(1:LENOCC(PREVID(JP)))
- + // '.' // VID(1:LVID)
- LXVID = LENOCC(XVID)
-
- ELSE
- XVID = VID
- LXVID = LVID
- LVIP = 0
- ENDIF
-
-
- WRITE(FSEQ,9003) IQ(L+KOFUFA+MFSQFA)
-9003 FORMAT(I6)
-
- JFSEQ = INDEXB(FSEQ,' ') + 1
-*
-* File size, if zero take default size for current medium
-*
- IF(IOPTO.EQ.0) ISIZE = IQ(L+KOFUFA+MFSZFA)
- IF(ISIZE .NE. 0) THEN
-*
-* May need slightly more space on disk, due to VBS format!
-*
- IFUDGE = MAX(2,ISIZE/15)
-#if defined(CERNLIB_CERNVM)
-*
-* Increase max. size by 10 MB (a few 210 MB staging disks exist...)
-*
- WRITE(CSIZE,9004) MIN(ISIZE+IFUDGE,
- + MEDSIZ(IQ(L+KOFUFA+MMTPFA))+10)
-#endif
-#if !defined(CERNLIB_CERNVM)
- WRITE(CSIZE,9004) MIN(ISIZE+IFUDGE,
- + MEDSIZ(IQ(L+KOFUFA+MMTPFA)))
-#endif
- ELSE
- WRITE(CSIZE,9004) MEDSIZ(IQ(L+KOFUFA+MMTPFA))
- ENDIF
-9004 FORMAT(I4)
-
- IF(CHLUN(1:LCHLUN) .EQ. 'NOWAIT') THEN
- STGOPT = 'NOWAIT'
- IWAIT = .FALSE.
- ELSE
- STGOPT = 'WAIT'
- IWAIT = .TRUE.
- ENDIF
-
-#if defined(CERNLIB_IBMVM)
-C======================== Modified by C. Onions =================
- IF ((FFORM(1:2) .EQ. 'FX') .OR. (FFORM(1:2) .EQ. 'EP'))THEN
- COMAND = 'EXEC STAGE IN IOFILEnn '
- WRITE(COMAND(21:22),9001) LUN
- IF (COMAND(21:21) .EQ. ' ') COMAND(21:21) = '0'
- IF (LUN .EQ. 0) COMAND(15:22) = CHLUN
- ELSE
- COMAND = 'EXEC STAGE IN FTnnF001 '
- WRITE(COMAND(17:18),9001) LUN
-9001 FORMAT(I2)
- IF (COMAND(17:17) .EQ. ' ') COMAND(17:17) = '0'
- IF (LUN .EQ. 0) COMAND(15:22) = CHLUN
- ENDIF
-*
-* Output staging?
-*
- IF (IMODE .NE. 0) COMAND(12:13) = 'OU'
-C======================== End of C. Onions modification =========
- IF(.NOT.IWAIT) COMAND(15:22) = 'FT00F001'
-*
-* Set IQUEST(11) to media type in case volume unknown or
-* TMS option not installed.
-*
- IQUEST(11) = IQ(L+KOFUFA+MMTPFA)
-#endif
-#if (!defined(CERNLIB_PREFIX))&&(defined(CERNLIB_IBMVM))
- CALL FMQTMS(VID(1:LVID),LIB,MODEL,DENS,MNTTYP,LABTYP,IC)
-#endif
-#if (defined(CERNLIB_PREFIX))&&(defined(CERNLIB_IBMVM))
- CALL FMQTMS(XVID(1:LXVID),LIB,MODEL,DENS,MNTTYP,LABTYP,IC)
-#endif
-#if defined(CERNLIB_IBMVM)
- IF(IDEBFA.GE.3) THEN
- PRINT *,'FMFIND. return from FMQTMS with ',
- + VID,'/',LIB,'/',MODEL,'/',DENS,'/',MNTTYP,'/',
- + LABTYP,'/',IC
- ENDIF
-
- IF(MODEL(1:4).EQ.'3480') THEN
- IF(MNTTYP.EQ.'R') THEN
- MODEL = 'SMCF'
- ELSE
- MODEL = 'CT1 '
- ENDIF
- ENDIF
-
- IF(MODEL(1:4).EQ.'3420') MODEL = 'TAPE'
-
-*
-* Believe density from TMS if tape is known
-*
- IF(IC.EQ.0) CDEN = DENS
- CALL CLTOU(LABTYP)
- LLAB = LENOCC(LABTYP)
- IF(IMODE.EQ.1) STGOPT = 'AUTOPUT DELAY'
- COMAND = COMAND(1:25) // VSN(1:LVSN) // '.'
- + // FSEQ(JFSEQ:LEN(FSEQ))
- + // '.' // LABTYP(1:LLAB) // '.' // VID(1:LVID)
-
-#endif
-#if (defined(CERNLIB_PREFIX))&&(defined(CERNLIB_IBMVM))
- IF(LVIP.NE.0) COMAND = COMAND(1:LENOCC(COMAND))
- + // '.' // VIP(1:LVIP)
-#endif
-#if defined(CERNLIB_IBMVM)
- COMAND = COMAND(1:LENOCC(COMAND))
- + // ' (' //STGOPT//' SIZE '//CSIZE // ' DEN '//CDEN
-*
-* Specify dataset name only if option N not specified
-*
- IF((LDSN.NE.0) .AND. (IOPTN.EQ.0))
- + COMAND = COMAND(1:LENOCC(COMAND)) // ' DSN ' //DSN(1:LDSN)
-
-* IF((VID(1:1).EQ.'I') .AND. (IQ(L+KOFUFA+MMTPFA).EQ.2) .AND.
-* + (ICNUM(VID,2,6).EQ.7)) THEN
- IF(LIB(1:4).EQ.'SMCF') THEN
- COMAND = COMAND(1:LENOCC(COMAND)) // ' DEVTYPE SMCF'
- ENDIF
-*
-* Output STAGing only - add DCB information (also NL tapes)
-*
- IF((IMODE.NE.0).OR.(LABTYP(1:2).EQ.'NL')
- + .OR.(IOPTL.NE.0)) THEN
- WRITE(DCB,8001) RECFM,LRECL,LBLOCK
-8001 FORMAT(' RECFM ',A4,' LRECL ',I5,' BLOCK ',I5)
- COMAND = COMAND(1:LENOCC(COMAND)) // DCB
- ENDIF
-*
-* Output STAGing only - options Keep, autoPut
-*
- IF((IMODE.NE.0).AND.(IOPTK.NE.0)) THEN
- COMAND = COMAND(1:LENOCC(COMMAND)) // ' KEEP'
- ENDIF
-
- IF((IMODE.NE.0).AND.(IOPTP.NE.0)) THEN
- COMAND = COMAND(1:LENOCC(COMMAND)) // ' AUTOPUT'
- ENDIF
-
- LENCOM = LENOCC(COMAND)
-
- IF(IOPTT.EQ.0) THEN
-*
-* Use STAGE
-*
-20 CONTINUE
- IF(IDEBFA.GE.0) PRINT *,ROUTIN//'running ',COMAND(1:LENCOM)
-
- CALL VMCMS(COMAND(1:LENCOM),IRC)
-*
-* NOWAIT specified - just return
-*
- IF(.NOT.IWAIT) RETURN
-
- IF(IRC.EQ.0) THEN
-*
-* Read mode only, if file size is currently zero, option S
-* specified, and DBS opened for write...
-*
- IF((IOPTS.NE.0).AND.(LUFZFA.GT.0).AND.(IMODE.EQ.0)
- + .AND.(IQ(L+KOFUFA+MFSZFA).EQ.0)) THEN
-*
-* Build STAGE Query command
-*
- COMAND = 'EXEC STAGE QUERY ' // VSN(1:LVSN) // '.'
- + // FSEQ(JFSEQ:LEN(FSEQ))
- + // '.' // LABTYP(1:LLAB) // '.' // VID(1:LVID)
- + // ' (LIFO'
- CALL VMCMS(COMAND(1:LENOCC(COMAND)),IRC)
-*
-* Get answer and extract file size
-*
- CALL VMRTRM(CHLINE,LENGTH)
- ISLASH = INDEX(CHLINE,'/')
- IDOT = INDEXB(CHLINE(1:ISLASH),'.')
- IBLANK = INDEXB(CHLINE(1:IDOT),' ')
- READ(CHLINE(IBLANK+1:IDOT-1),*) ISIZE
-*
-* Add 1 MB to file size as we ignore the fraction...
-*
- IQ(L+KOFUFA+MFSZFA) = ISIZE + 1
-
- IF(IDEBFA.GE.0) THEN
- PRINT *,ROUTIN//'- updating file size from STAGE information'
- PRINT *,ROUTIN//CHLINE(1:LENOCC(CHLINE))
- ENDIF
- ENDIF
-*
-* Option D - make a duplicate copy into the robot
-*
- IF((IOPTD.NE.0).AND.(IMODE.EQ.0)) THEN
- CALL FMSMCF(GENAME,L,IC)
- IF(IC.NE.0) THEN
- PRINT *,ROUTIN//'- return code ',IC,' from FMSMCF'
- ENDIF
-
- ENDIF
-
- ELSEIF(IRC.EQ.400) THEN
-*
-* STAGE failed - cannot allocate disk size of size requested
-*
- READ(CSIZE,9004) ISIZE
- IF(ISIZE.LT.MEDSIZ(IQ(L+KOFUFA+MMTPFA))) THEN
- IF(IDEBFA.GE.0)
- + PRINT *,ROUTIN//' unable to allocate staging disk for',
- + ' size ',CSIZE,' - will try larger disk'
-*
-* Increase size by MAX of file size in FATMEN catalogue and 20MB
-* up to maximum size for this media type
-*
- ISIZE = MIN(ISIZE +
- + MAX(20,IQ(L+KOFUFA+MFSZFA)),
- + MEDSIZ(IQ(L+KOFUFA+MMTPFA)))
- WRITE(CSIZE,9004) ISIZE
- ISTART = INDEX(COMAND,'SIZE ') + 5
- COMAND(ISTART:ISTART+3) = CSIZE
- GOTO 20
- ELSE
- IF(IDEBFA.GE.0)
- + PRINT *,ROUTIN//' return code from STAGE = ',IRC
- RETURN
- ENDIF
-
- ELSEIF(IRC.GE.20) THEN
-
- IF(IDEBFA.GE.0)
- + PRINT *,ROUTIN//' return code from STAGE = ',IRC
- RETURN
-
- ENDIF
-
- ELSE
-*
-* Use SETUP
-*
- RING = ' NORING '
-
- CALL FMWORD(DDNAME,3,' ',COMAND,IRC)
- LDD = LENOCC(DDNAME)
- IF(LDD.LE.2) THEN
- READ(DDNAME(1:LDD),*) LUN
- DDNAME = 'FT00F001'
- WRITE(DDNAME(3:4),9001) LUN
- ENDIF
-*
-* Find first free tape drive
-*
- ITAPE = IUCOMP(0,IDEV,16)
- IF(ITAPE.EQ.17) THEN
- IF(IDEBFA.GE.-2) PRINT *,ROUTIN
- + //' no free virtual address for tape unit'
- IRC = 1
- RETURN
- ENDIF
-
- ITEMP = 179 + ITAPE
- IF(ITAPE.GT.8) ITEMP = 277 + ITAPE
- WRITE(DEVNUM,'(I3)') ITEMP
- WRITE(DEVNAM,'(Z1)') ITAPE-1
-
-#endif
-#if (defined(CERNLIB_IBMVM))&&(defined(CERNLIB_HEPVM))
- SETUP = 'SETUP CT1 '//DEVNUM//' '
- + //VSN(1:LVSN)//' VID '//XVID//' '
- + //LABTYP//CDEN//RING
-
- IF(IOPTE.NE.0) THEN
- LENS = LENOCC(SETUP)
- SETUP = SETUP(1:LENS)//' (END'
- ENDIF
-
- IF(LIB(1:4).EQ.'SMCF') SETUP(7:10) = 'SMCF'
-
- LENS = LENOCC(SETUP)
- IF(IDEBFA.GE.0) PRINT *,ROUTIN//'running ',SETUP(1:LENS)
- CALL VMCMS(SETUP(1:LENS),IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.0) PRINT *,ROUTIN//'return code ',IRC,
- + ' from SETUP'
- RETURN
- ENDIF
-#endif
-#if (defined(CERNLIB_IBMVM))&&(defined(CERNLIB_VMTAPE))
-
- RING = ' READ '
-
- SETUP = 'VMTAPE MOUNT '//VSN(1:LVSN)//DEVNAM
- + //' DSN ? (DEN '//CDEN//' LABEL '//LABTYP
- + //RING//' WAIT '//
- LENS = LENOCC(SETUP)
- IF(IDEBFA.GE.0) PRINT *,ROUTIN//'running ',SETUP(1:LENS)
- CALL VMCMS(SETUP(1:LENS),IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.0) PRINT *,ROUTIN//'return code ',IRC,
- + ' from VMTAPE'
- RETURN
- ENDIF
- CALL VMSTAK(DSN(1:LDSN),'L',IRC)
-#endif
-#if defined(CERNLIB_IBMVM)
-
- FILEDEF = 'FILEDEF '//DDNAME//' TAP'
- + //DEVNAM//' '//LABTYP//' (DEN '//CDEN
- LENF = LENOCC(FILEDEF)
-
- IF(IOPTW.NE.0) THEN
- FILEDEF = FILEDEF(1:LENF) // DCB
- LENF = LENOCC(FILEDEF)
- ENDIF
-
- IF(IDEBFA.GE.0) PRINT *,ROUTIN//'running ',FILEDEF(1:LENF)
- CALL VMCMS(FILEDEF(1:LENF),IRC)
-
- IF((LDSN.GT.0).AND.(IOPTN.EQ.0)) THEN
- LABELDEF = 'LABELDEF '//DDNAME//' FID ?'
- LENL = LENOCC(LABELDEF)
-
- IF(IDEBFA.GE.0)
- + PRINT *,ROUTIN//'running ',LABELDEF(1:LENL)
-*
-* Put DSN on program STACK for LABELDEF
-*
-CSELF,IF=-QMIBMXA,IF=IBMVM.
-C CALL VMCMS('EXEC FATSTACK '//DSN(1:LDSN)//' (LIFO',IRC)
-CSELF,IF=QMIBMXA,IF=IBMVM.
- IF(IDEBFA.GE.0)
- + PRINT *,ROUTIN//'DSN is ',DSN(1:LDSN)
- CALL VMSTAK(DSN(1:LDSN),'L',IRC)
-CSELF,IF=IBMVM.
- CALL VMCMS(LABELDEF(1:LENL),IRC)
-
- ENDIF
-
- ENDIF
-
-#endif
-#if defined(CERNLIB_VAXVMS)
-*
-* Build the relevant logical name for STAGE
-*
- FORLUN = 'FOR00N'
- WRITE(FORLUN(4:6),9002) LUN
- IF (FORLUN(4:4) .EQ. ' ') FORLUN(4:4) = '0'
- IF (FORLUN(5:5) .EQ. ' ') FORLUN(5:5) = '0'
- IF (LUN .EQ. 0) FORLUN = CHLUN
-
- JX = ICFNBL(CSIZE,1,4)
-*
-* Set IQUEST(11) to media type in case volume unknown or
-* TMS option not installed.
-*
- IQUEST(11) = IQ(L+KOFUFA+MMTPFA)
-#endif
-#if (defined(CERNLIB_VAXVMS))&&(!defined(CERNLIB_PREFIX))
- CALL FMQTMS(VID(1:LVID),LIB,MODEL,DENS,MNTTYP,LABTYP,IC)
-#endif
-#if (defined(CERNLIB_VAXVMS))&&(defined(CERNLIB_PREFIX))
- CALL FMQTMS(XVID(1:LXVID),LIB,MODEL,DENS,MNTTYP,LABTYP,IC)
-#endif
-#if defined(CERNLIB_VAXVMS)
- IF(IDEBFA.GE.3) THEN
- PRINT *,'FMFIND. return from FMQTMS with ',
- + VID,'/',LIB,'/',MODEL,'/',DENS,'/',MNTTYP,'/',
- + LABTYP,'/',IC
- ENDIF
-*
-* Translate IBM to VAX labels (SL->EBCDIC etc.)
-*
- JL = ICNTH(LABTYP,IBMLAB,3)
- COMAND = '$STAGE ' // VSN(1:LVSN) // ' ' // VID(1:LVID) // ' '
- + // FORLUN // IOMODE // '/NAME=' // DSN(1:LDSN)
- + // '/NUMBER=' // FSEQ(JFSEQ:LEN(FSEQ))
- + // '/SIZE=' // CSIZE(JX:4)
- + // '/GENERIC='// MODEL
- + // '/LABEL='// VAXLAB(JL)
-*
-* Output STAGing only - add DCB information (also NL tapes)
-*
- IF((IMODE.NE.0).OR.(LABTYP(1:2).EQ.'NL')
- + .OR.(IOPTL.NE.0)) THEN
- IF(INDEX(RECFM,'F').NE.0) THEN
- COMAND = COMAND(1:LENOCC(COMAND)) // '/FIXED'
- ELSEIF(INDEX(RECFM,'V').NE.0) THEN
- COMAND = COMAND(1:LENOCC(COMAND)) // '/VARIABLE'
- ENDIF
- WRITE(CHRECL,'(I6.6)') LRECL
- WRITE(CHBLK, '(I6.6)') LBLOCK
- IF(LRECL.GT.0) COMAND = COMAND(1:LENOCC(COMAND)) //
- + '/RECORDSIZE='//CHRECL
- IF(LBLOCK.GT.0) COMAND = COMAND(1:LENOCC(COMAND)) //
- + '/BLOCKSIZE='//CHBLK
- ENDIF
-*
- LENCOM = LENOCC(COMAND)
-*
-* 'T' option - read directly from tape
-*
- IF(IOPTT.NE.0) THEN
- COMAND = COMAND(1:LENCOM) // '/DIRECT'
- LENCOM = LENCOM + 7
- ENDIF
-
- IF(IDEBFA.GE.0) PRINT *'FMFIND. running ',COMAND(1:LENCOM)
-
- IRC = LIB$SPAWN(COMAND(1:LENCOM))
- IF (.NOT. IRC) CALL LIB$SIGNAL(%VAL(IRC))
-#endif
-#if (defined(CERNLIB_UNIX))&&(!defined(CERNLIB_CRAY))&&(!defined(CERNLIB_SHIFT))&&(!defined(CERNLIB_APOL3))
- PRINT *,'FMFIND. Tape support is not available for this ',
- + 'system'
- IRC = 999
- RETURN
-#endif
-#if defined(CERNLIB_CRAY)||defined(CERNLIB_SHIFT)||defined(CERNLIB_APOL3)
-*
-* Set IQUEST(11) to media type in case volume unknown or
-* TMS option not installed.
-*
- IQUEST(11) = IQ(L+KOFUFA+MMTPFA)
-#endif
-#if (defined(CERNLIB_CRAY)||defined(CERNLIB_SHIFT)||defined(CERNLIB_APOL3))&&(!defined(CERNLIB_PREFIX))
- CALL FMQTMS(VID(1:LVID),LIB,MODEL,DENS,MNTTYP,LABTYP,IC)
-#endif
-#if (defined(CERNLIB_CRAY)||defined(CERNLIB_SHIFT)||defined(CERNLIB_APOL3))&&(defined(CERNLIB_PREFIX))
- CALL FMQTMS(XVID(1:LXVID),LIB,MODEL,DENS,MNTTYP,LABTYP,IC)
-#endif
-#if defined(CERNLIB_CRAY)||defined(CERNLIB_SHIFT)||defined(CERNLIB_APOL3)
- IF(IDEBFA.GE.3) THEN
- PRINT *,'FMFIND. return from FMQTMS with ',
- + VID,'/',LIB,'/',MODEL,'/',DENS,'/',MNTTYP,'/',
- + LABTYP,'/',IC
- ENDIF
-
- IF(MODEL(1:4).EQ.'3480') THEN
- IF(MNTTYP.EQ.'R') THEN
- MODEL = 'SMCF'
- ELSE
-#endif
-#if defined(CERNLIB_APOL3)
- MODEL = 'CART'
-#endif
-#if defined(CERNLIB_CRAY)||defined(CERNLIB_SHIFT)
- MODEL = 'CT1'
-#endif
-#if defined(CERNLIB_CRAY)||defined(CERNLIB_SHIFT)||defined(CERNLIB_APOL3)
- ENDIF
- ENDIF
-
- IF(MODEL(1:4).EQ.'3420') MODEL = 'TAPE'
-*
-* Believe density from TMS if tape is known
-*
- IF(IC.NE.0) CDEN = DENS
- CALL CUTOL(LABTYP)
- LLAB = LENOCC(LABTYP)
-
-#endif
-#if defined(CERNLIB_CRAY)
- FORLUN = 'fort. '
- IF(LUN.LT.10) THEN
- WRITE(FORLUN(6:6),'(I1)') LUN
- ELSE
- WRITE(FORLUN(6:7),'(I2)') LUN
- ENDIF
-
-#endif
-#if defined(CERNLIB_SHIFT)
- IF(LUN.LT.10) THEN
- WRITE(FORLUN,'(I1)') LUN
- ELSE
- WRITE(FORLUN,'(I2)') LUN
- ENDIF
-
-#endif
-#if defined(CERNLIB_CRAY)||defined(CERNLIB_SHIFT)||defined(CERNLIB_APOL3)
- WRITE(FSEQ,9003) IQ(L+KOFUFA+MFSQFA)
-
- IF (LUN .EQ. 0) FORLUN = CHLUN
-* "stagein fort.lun -v vsn -V vid -l sl|nl|al|blp
-* -g TAPE|CART|SMCF -d 6250|1600"
-#endif
-#if defined(CERNLIB_APOL3)
- IF(IMODE.EQ.0) THEN
- COMAND = 'stage -i '
- ELSEIF(IMODE.EQ.1) THEN
- COMAND = 'stage -o '
- ENDIF
- COMAND = COMAND(1:LENOCC(COMAND))
- + // ' -v '
- + //VID(1:LVID)//' -l '//LABTYP//' -t '//MODEL
- + // ' -f ' //FSEQ// ' -d '//CDEN // ' -s '//CSIZE
- IF(IWAIT) COMAND = COMAND(1:LENOCC(COMAND)) // ' -w '
-#endif
-#if defined(CERNLIB_CRAY)
- COMAND = 'stagein '//FORLUN
-#endif
-#if defined(CERNLIB_SHIFT)
- COMAND = 'stagein -G -U '//FORLUN
-#endif
-#if defined(CERNLIB_CRAY)||defined(CERNLIB_SHIFT)
- + // ' -v '//VSN(1:LVSN)// ' -V '
- + //VID(1:LVID)//' -l '//LABTYP//' -g '//MODEL
- + // ' -q ' //FSEQ(JFSEQ:LEN(FSEQ))
-#endif
-#if defined(CERNLIB_SHIFT)
- + // ' -s ' //CSIZE // ' -u '//CHUSER
- + // ' -p shift1'
-#endif
-#if defined(CERNLIB_CRAY)
- + // ' -K -S sbin'
-#endif
-#if defined(CERNLIB_CRAY)||defined(CERNLIB_SHIFT)
-
- IF(IMODE.NE.0) COMAND(1:8) = 'stageout'
-#endif
-#if defined(CERNLIB_CRAY)||defined(CERNLIB_SHIFT)||defined(CERNLIB_APOL3)
- LENCOM = LENOCC(COMAND)
-#endif
-#if defined(CERNLIB_CRAY)||defined(CERNLIB_SHIFT)
-*
-* Add DSN if IOPTN not specified
-*
- IF(IOPTN.EQ.0) THEN
- COMAND = COMAND(1:LENCOM) // ' -f '//DSN(1:LDSN)
- LENCOM = LENOCC(COMAND)
- ENDIF
-
-#endif
-#if defined(CERNLIB_APOL3)
-*
-* Add DSN if IOPTN not specified
-*
- IF(IOPTN.EQ.0) THEN
- COMAND = COMAND(1:LENCOM) // ' -n '//DSN(1:LDSN)
- LENCOM = LENOCC(COMAND)
- ENDIF
-
-#endif
-#if defined(CERNLIB_CRAY)||defined(CERNLIB_SHIFT)
-*
-* Option T - direct access to tapes
-*
- IF(IOPTT.NE.0) THEN
- COMAND(1:8) = 'setup '
-*
-* Option W - write access
-*
- IF(IOPTW.NE.0) THEN
- COMAND = COMAND(1:LENCOM) // '-r in'
- LENCOM = LENCOM + 5
- ENDIF
-
- ENDIF
-*
-* Add DCB information
-*
- WRITE(DCB,8002) RECFM(1:1),LRECL,LBLOCK
-8002 FORMAT(' -F ',A1,' -L ',I5,' -b ',I5)
- COMAND = COMAND(1:LENOCC(COMAND)) // DCB
- LENCOM = LENOCC(COMAND)
-
-#endif
-#if defined(CERNLIB_APOL3)
-*
-* Add DCB information, direct output to temporary file
-*
- CALL FMFNME(CHFILE)
- LCHF = LENOCC(CHFILE)
- IF(IDEBFA.GE.3) PRINT *,'FMFIND. output of STAGE command ',
- + 'will be sent to /tmp/'//CHFILE(1:LCHF)
- WRITE(DCB,8002) RECFM,LRECL,LBLOCK
-8002 FORMAT(' -r ',A,' -c ',I5,' -b ',I5)
- COMAND = COMAND(1:LENOCC(COMAND)) // DCB
- + // ' ' // VSN(1:LVSN)
- + // ' > /tmp/'//CHFILE(1:LCHF)
- LENCOM = LENOCC(COMAND)
-
-#endif
-#if defined(CERNLIB_CRAY)||defined(CERNLIB_SHIFT)||defined(CERNLIB_APOL3)
-
- CALL CSQMBL(COMAND,1,LENCOM)
- LENCOM = LENOCC(COMAND)
- IF(IDEBFA.GE.0) PRINT *,'FMFIND. executing ',COMAND(1:LENCOM)
-#endif
-#if defined(CERNLIB_APOL3)
- ISTAT = 0
-100 CONTINUE
- IC = SYSTEMF(COMAND(1:LENCOM))
-*
-* Check output of stage command
-*
- OPEN(LUN,FILE='/tmp/'//CHFILE(1:LCHF),STATUS='OLD',
- + FORM='FORMATTED')
-101 READ(LUN,'(A)',END=102) CHLINE
- LCHL = LENOCC(CHLINE)
- IF(IDEBFA.GE.0) PRINT *,'FMOPEN. ',CHLINE(1:LCHL)
- IF(INDEX(CHLINE(1:LCHL),'path : ').NE.0) THEN
- ISTART = INDEX(CHLINE(1:LCHL),'/')
- STGPTH = CHLINE(ISTART:)
- ELSEIF(INDEX(CHLINE(1:LCHL),'stat : ').NE.0) THEN
- ISTAT = 1
- IF(INDEX(CHLINE(1:LCHL),'ABORTED').NE.0) THEN
- IRC = -1
- RETURN
- ELSEIF(INDEX(CHLINE(1:LCHL),'ENDED_OK').NE.0) THEN
- GOTO 102
- ENDIF
- ENDIF
- GOTO 101
-102 CLOSE(LUN)
- IF(ISTAT.EQ.0) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMOPEN. no status return ',
- + 'from stage. Will retry in 60 seconds'
- CALL SLEEPF(60)
- GOTO 100
- ENDIF
-103 CONTINUE
-#endif
-#if defined(CERNLIB_SHIFT)
- IC = SYSTEMF(COMAND(1:LENCOM))
- IF(IC.NE.0) THEN
- PRINT *,'FMFIND. return code ',IC,' from stage command'
- RETURN
- ENDIF
-#endif
-#if defined(CERNLIB_CRAY)
- IC = SYSTEMF(COMAND(1:LENCOM))
-#endif
-
- ENDIF
-
-*
-* Record last access date and use count in bank send to server
-*
- CALL DATIME(ID,IT)
- CALL FMPKTM(ID,IT,IP,IRC)
- IQ(L+KOFUFA+MLATFA) = IP
- IF(IMODE.EQ.1) THEN
- IQ(L+KOFUFA+MUSCFA) = 1
- ELSE
- IQ(L+KOFUFA+MUSCFA) = IQ(L+KOFUFA+MUSCFA) + 1
- ENDIF
- IF((LUFZFA.GT.0).AND.(IMODE.EQ.0))THEN
- IF(IDEBFA.GE.0)
- + PRINT *,ROUTIN//'- updating last access date and use count'
- IF(IDEBFA.GE.3)
- + CALL FMSHOW(GENAME(1:NCH),L,KEYS,'A',IRC)
- CALL FMMOD(GENAME(1:NCH),L,0,IRC)
- IF((IRC.NE.0).AND.(IDEBFA.GE.0)) THEN
- PRINT *,ROUTIN//
- +'- error updating use count/last access date'
- PRINT *,'Return code from FMMOD = ',IRC
- ENDIF
- ENDIF
-
-
- END
diff --git a/src/packlib/fatmen/unref/fmget.F b/src/packlib/fatmen/unref/fmget.F
deleted file mode 100644
index 80211fd..0000000
--- a/src/packlib/fatmen/unref/fmget.F
+++ /dev/null
@@ -1,81 +0,0 @@
-*
-* $Id: fmget.F,v 1.1.1.1 1996/03/07 15:18:24 mclareni Exp $
-*
-* $Log: fmget.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:24 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMGET(GENAME,L,KEYS,IRC)
- CHARACTER*(*) GENAME
-#include "fatmen/fatbank.inc"
-#include "fatmen/fatpara.inc"
- PARAMETER (LKEYFA=10)
- DIMENSION KEYS(LKEYFA)
-* CHARACTER PATHN*256,PATH*256,PATHX*256,FNAME*20
- DIMENSION LSUP(9)
- LOGICAL GETK
- GETK = .FALSE.
- NCH=LENOCC(GENAME)
- CALL CLTOU(GENAME)
- IF(IDEBFA.GE.1) WRITE(LPRTFA,9001) GENAME(1:NCH)
-9001 FORMAT(' FMGET. ',A)
- GOTO 10
- ENTRY FMGETK(GENAME,L,KEYS,IRC)
- GETK = .TRUE.
- NCH=LENOCC(GENAME)
- CALL CLTOU(GENAME)
- IF(IDEBFA.GE.1) WRITE(LPRTFA,9002) GENAME(1:NCH)
-9002 FORMAT(' FMGETK. ',A)
-*
-* If KEYS(1) not set, then we do FMGET...
-*
- IF(KEYS(1).EQ.0) THEN
- GETK = .FALSE.
- ENDIF
-
- IF(IDEBFA.GE.1) CALL FMPKEY(KEYS,10)
-10 CONTINUE
- L=0
- IRC = 0
- IF(NCH.LT.3.OR.GENAME(1:2).NE.'//'.OR.GENAME(NCH:NCH).EQ.'/')THEN
- IQUEST(1)=61
- GO TO 999
- ENDIF
- ICH=INDEXB(GENAME(1:NCH-1),'/')
- IF(ICH.LE.3.OR.NCH-ICH.GT.20) THEN
- IQUEST(1)=62
- GO TO 999
- ENDIF
-*
-* Modify for AIX Fortran
-*
-* PATHN=GENAME(1:ICH-1)
-* FNAME=GENAME(ICH+1:NCH)
- IF(LTDSFA.NE.0) CALL MZDROP(IDIVFA,LTDSFA,'L')
- IF (.NOT. GETK) CALL VZERO(KEYS,NKDSFA)
- NWORDS = NKDSFA
- IFLAG = 0
- IF (GETK) IFLAG = 1
- JBIAS = 1
-#if !defined(CERNLIB_CZ)
-*
-* Modify for AIX
-*
-* CALL FTRIN(PATHN,FNAME,IDIVFA,LTDSFA,JBIAS,NWORDS,KEYS,IFLAG)
- CALL FMRZIN(GENAME(1:NCH),IDIVFA,LTDSFA,JBIAS,NWORDS,KEYS,IFLAG)
-#endif
-#if defined(CERNLIB_CZ)
-* This will have to be fixed too...
-* CALL FMRIN(PATHN,FNAME,IDIVFA,LTDSFA,JBIAS,NWORDS,KEYS,IFLAG)
-#endif
- L=LTDSFA
- 999 IRC=IQUEST(1)
-*
-* Return a zero bank address if not found
-*
- IF(IRC.NE.0) L=0
- RETURN
- END
-
diff --git a/src/packlib/fatmen/unref/fmld.F b/src/packlib/fatmen/unref/fmld.F
deleted file mode 100644
index dc611df..0000000
--- a/src/packlib/fatmen/unref/fmld.F
+++ /dev/null
@@ -1,250 +0,0 @@
-*
-* $Id: fmld.F,v 1.1.1.1 1996/03/07 15:18:24 mclareni Exp $
-*
-* $Log: fmld.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:24 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMLD
-#include "fatmen/fmpath.inc"
- PARAMETER (MAXDIR=1000)
- COMMON/FALD/CHDIR
- CHARACTER*255 CHDIR(MAXDIR),COMAND
- CHARACTER*255 PATH2
- CHARACTER*255 PATHI
- CHARACTER*132 CARD
- CHARACTER*80 LINE
- CHARACTER*4 CHOPT
- CHARACTER*3 CHSTAT
- LOGICAL IOPEN,IEXIST
-#include "fatmen/fatsys.inc"
-#include "fatmen/fatout.inc"
-#include "zebra/quest.inc"
-#include "fatmen/fatbug.inc"
-#include "fatmen/fatinit.inc"
-*
- CALL CFILL(' ',CHDIR,1,255*MAXDIR)
-*
-* List contents of current directory
-*
- CHOPT = ' '
- CALL KUGETC(PATH,LPATH)
- PATHI = PATH
- LPATHI = LPATH
- CALL KUGETC(OUTPUT,LOUT)
- CALL KUGETI(NLEVEL)
- CALL KUGETC(CHOPT,LCHOPT)
-
- IF(LCHOPT.EQ.0) THEN
- CHOPT = ' '
- LCHOPT = 1
- ENDIF
-
- IOPTR = 0
- IF(INDEX(CHOPT,'R').NE.0) IOPTR = 1
- IF(INDEX(PATH(1:LPATH),'/').NE.0) IOPTR = 1
- CALL FMFIXF(PATH,PATH2)
- PATH = PATH2
- LPATH = LENOCC(PATH)
-
- LWRITE = LPRTFA
-*
-* Fix for strange KUIP behaviour...
-*
- IF(OUTPUT(1:1).EQ.'-') THEN
- CHOPT = OUTPUT
- LCHOPT = LOUT
- OUTPUT = 'TTY'
- LOUT = 3
- ENDIF
-
- IF((OUTPUT(1:LOUT).NE.'TTY').OR.(LOUT.EQ.0)) THEN
- LWRITE = 3
- IF(IDEBFA.GE.2)
- + PRINT *,'FMLD. output will be redirected to ',OUTPUT(1:LOUT)
- CALL FAFILE(LWRITE,OUTPUT(1:LOUT),IRET)
- IF(IRET.NE.0) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMLD. return code ',IRET,
- + ' opening file ',OUTPUT(1:LOUT),
- + ' - output will be sent to the screen'
- LWRITE = LPRTFA
- OUTPUT = 'TTY'
- ENDIF
- ELSE
- OUTPUT = 'TTY'
- ENDIF
-*
-* Save current directory
-*
- CALL FACDIR(CDIR,' ')
- LCDIR = LENOCC(CDIR)
-*
- IF(INDEX(CHOPT(1:LCHOPT),'H').NE.0) THEN
- WRITE(LWRITE,*) '>>> Command: LD ',
- + 'Options: ',CHOPT(1:LCHOPT)
- WRITE(LWRITE,*) '>>> Path: ',PATH(1:LPATH)
- WRITE(LWRITE,*) '>>> Current directory: ',CDIR(1:LCDIR)
- ENDIF
-*
-*
-* Find first wild card in path name
-*
- IWILD = ICFMUL('*%(',PATH,1,LPATH)
- IF((PATH(1:LPATH).EQ.'*').OR.(IWILD.GT.LPATH)) IWILD = 0
-
- IF ((PATH(1:LPATH) .NE. 'CURRENT_DIRECTORY') .AND.
- + (PATH(1:LPATH) .NE. '*') .AND.
- + (IWILD.NE.0) .AND.
- + (IOPTR .EQ. 0)) THEN
-*
-* Set the current directory
-*
-#if !defined(CERNLIB_CZ)
- IF(IWILD.EQ.0) CALL FACDIR(PATH(1:LPATH),'U')
-#endif
-#if defined(CERNLIB_CZ)
- CALL CZPUTA('MESS :CD '//PATH(3:LPATH),ISTAT)
- 1 CONTINUE
- CALL CZGETA(LINE,ISTAT)
- WRITE(LWRITE,9001) LINE(3:80)
- IF(LINE(1:1) .EQ. '2') GOTO 1
- CALL CZPUTA('MESS :LD ',ISTAT)
- 2 CONTINUE
- CALL CZGETA(LINE,ISTAT)
- WRITE(LWRITE,9001) LINE(3:80)
- IF(LINE(1:1) .EQ. '2') GOTO 2
-#endif
- ELSE
-#if !defined(CERNLIB_CZ)
- CALL FACDIR(CDIR(1:LCDIR),'U')
-#endif
-#if defined(CERNLIB_CZ)
- CALL CZPUTA('MESS :CD '//CDIR(3:LCDIR),ISTAT)
- 3 CONTINUE
- CALL CZGETA(LINE,ISTAT)
- WRITE(LWRITE,9001) LINE(3:80)
- IF(LINE(1:1) .EQ. '2') GOTO 3
-#endif
- ENDIF
-*
-* Read names of directories below this one
-*
-#if !defined(CERNLIB_CZ)
- IWIDTH = 0
- JWIDTH = 78
- IF(INDEX(CHOPT,'V').NE.0) JWIDTH = 132
-* IF((IWILD.EQ.0).AND.(IOPTR .EQ. 0)) THEN
- IF(IOPTR .EQ. 0) THEN
- CALL RZRDIR(MAXDIR,CHDIR,NDIR)
- ELSE
-
- IF((PATH(1:LPATH) .EQ. '*').OR.
- + (PATH(1:LPATH) .EQ. 'CURRENT_DIRECTORY')) THEN
- PATH = CDIR
- LPATH = LCDIR
- ENDIF
-
- CALL FASCAN(PATH(1:LPATH),NLEVEL,LWRITE,' ',IRET)
- NDIR = IQUEST(11)
-#endif
-#if defined(CERNLIB_NEVER)
- ISLASH = INDEXB(PATH(1:IWILD),'/')
-*
-* Find subdirectories below first branch
-*
- CALL FMTREE(PATH(1:ISLASH-1),CHDIR,NLEVEL,NDIR,MAXDIR,IRET)
- IF(IRET.NE.0.AND.IDEBFA.GT.-3) PRINT *,'FMLD. Return code ',
- + IRET,' from FMTREE'
- IF(IRET.EQ.0.AND.IDEBFA.GE.3) PRINT *,'FMLD. ',NDIR,' '
- + //'directories found below ', PATH(1:ISLASH-1)
-
- IF(IQUEST(1).LT.0) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMLD. ',IQUEST(11), ' '
- + //'directories found, only ',MAXDIR,' can be '
- + //'displayed', ' interactively.'
- ENDIF
-#endif
- ENDIF
-#if defined(CERNLIB_CZ)
- CALL CZPUTA('MESS :LD',ISTAT)
- 4 CONTINUE
- CALL CZGETA(LINE,ISTAT)
- WRITE(LWRITE,9001) LINE(3:80)
- IF (LINE(1:1) .EQ. '2') GOTO 4
-#endif
-#if !defined(CERNLIB_CZ)
-*
-* Loop over directories returned
-*
- IF (NDIR .GT. 0) THEN
-
- WRITE (LWRITE,9002)
-
- NMAT = 0
- DO 10 I=1,NDIR
- LDIR = LENOCC(CHDIR(I))
-*
-* Match against input pattern
-*
- IF(IWILD.NE.0) THEN
- IF(IOPTR .EQ. 0) THEN
- CALL FMATCH(CHDIR(I)(1:LDIR),PATHI(1:LPATHI),IMAT)
- ELSE
- CALL FMATCH(CHDIR(I)(1:LDIR),PATH(1:LPATH),IMAT)
- ENDIF
- IF(IMAT.NE.0) GOTO 10
- ENDIF
- NMAT = NMAT + 1
- IF((INDEX(CHOPT,'W').NE.0) .OR.
- + (INDEX(CHOPT,'V').NE.0) .AND.
- + (IOPTR.EQ.0)) THEN
-*
-* Just display file names across the terminal...
-*
- IF(IWIDTH+LDIR.GE.JWIDTH) THEN
-* flush current buffer
- WRITE(LWRITE,'(1X,A)') CARD(1:IWIDTH)
- IWIDTH = 0
- ENDIF
- IF(IWIDTH.EQ.0) THEN
- CARD = CHDIR(I)(1:LDIR) // ' '
- ELSE
- CARD = CARD(1:IWIDTH) // CHDIR(I)(1:LDIR) // ' '
- ENDIF
- IWIDTH = IWIDTH + LDIR + 1
- ELSE
- WRITE(LWRITE,9001) CHDIR(I)(1:LDIR)
- ENDIF
- 10 CONTINUE
- IF((INDEX(CHOPT,'W').NE.0) .OR.
- + (INDEX(CHOPT,'V').NE.0) .AND.
- + (IOPTR.EQ.0))
- + WRITE(LWRITE,'(1X,A)') CARD(1:IWIDTH)
-
-
- WRITE(LWRITE,9003) NMAT
-
- ELSE
- WRITE(LWRITE,9004)
- ENDIF
-*
-* Reset current directory
-*
- CALL FACDIR(CDIR(1:LCDIR),'U')
-#endif
-#if defined(CERNLIB_CZ)
- CALL CZPUTA('MESS :CD'//CDIR(1:LCDIR),ISTAT)
- CALL CZGETA(LINE,ISTAT)
- WRITE(LWRITE,9001) LINE(3:80)
-#endif
- 9001 FORMAT(1X,A)
- 9002 FORMAT(' List of subdirectories...')
- 9003 FORMAT(' Total of ',I10,' subdirectories')
- 9004 FORMAT(' No subdirectories found')
-
- INQUIRE(3,OPENED=IOPEN)
- IF(IOPEN) CLOSE(3)
- END
-
diff --git a/src/packlib/fatmen/unref/fmldir.F b/src/packlib/fatmen/unref/fmldir.F
deleted file mode 100644
index 32e1101..0000000
--- a/src/packlib/fatmen/unref/fmldir.F
+++ /dev/null
@@ -1,235 +0,0 @@
-*
-* $Id: fmldir.F,v 1.1.1.1 1996/03/07 15:18:24 mclareni Exp $
-*
-* $Log: fmldir.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:24 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMLDIR(CHPATH,FILES,NFOUND,MAXFIL,ICONT,IRC)
-#include "zebra/quest.inc"
-#include "fatmen/fatbug.inc"
-* Maximum number of subdirectories at any level
- PARAMETER (MAXDIR=1000)
-* Maximum number of directories on the stack
- PARAMETER (MAXSTK=1000)
- CHARACTER*20 SUBDIR(MAXDIR),MATCH
- CHARACTER*(*) CHPATH
- CHARACTER*255 PATH,CHDIR
- COMMON/FALDIR/STACK
- CHARACTER*255 STACK(MAXSTK),FILES(MAXFIL)
- PARAMETER (NCH=20)
- PARAMETER (MAXLEV=20)
- CHARACTER*20 DIRNAM(MAXLEV)
- CHARACTER*20 CHWORD
- SAVE NSTACK
-*
-* IRC is set to -1 if more directories found than can be returned
-* IRC is set to -2 if # directories at any level exceeds MAXDIR
-* in FILES(MAXFIL)
-* FMLDIR should then be called again with ICONT^=0 and the next
-* batch of directories will be returned.
-*
- NFOUND = 0
- IRC = 0
- LPATH = LENOCC(CHPATH)
- CALL CLTOU(CHPATH)
- IF(ICONT.EQ.0) THEN
- NSTACK = 0
-*
-* Split input path name into its component pieces
-* (this is the opposite of RZPAFF which glues them together)
-*
- CALL FMPAFF(CHPATH(1:LPATH),DIRNAM,MAXLEV,IRET)
- ELSE
- GOTO 30
- ENDIF
-*
-* Find first wild card in generic name
-*
- IF(IDEBFA.GE.3)
- +PRINT *,'FMLDIR. enter for PATH = ',CHPATH(1:LPATH),
- + ' MAXDIR = ',MAXFIL
- IWILD = ICFMUL('*%(<>',CHPATH,1,LPATH)
-*
-* No wild cards found - just return directories below CHPATH
-*
- IF(IWILD.GT.LPATH) THEN
- IF(IDEBFA.GE.3) PRINT *,'FMLDIR. look for subdirectories '
- + //'below ', CHPATH(1:LPATH)
- CALL FACDIR(CHPATH(1:LPATH),' ')
- IF(IQUEST(1).NE.0) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMLDIR. cannot set directory ',
- + 'to ',CHPATH(1:LPATH)
- IRC = IQUEST(1)
- RETURN
- ENDIF
- CALL CFILL(' ',SUBDIR,1,20*MAXDIR)
- CALL RZRDIR(MAXDIR,SUBDIR,NFOUND)
- IF(IDEBFA.GE.3) PRINT *,'FMLDIR. ',NFOUND,' subdirectories '
- + //'found'
- DO 10 I=1,NFOUND
- FILES(I) = ' '
- PATH = CHPATH(1:LPATH)//'/'
- + //SUBDIR(I)(1:LENOCC(SUBDIR(I)))
- FILES(I) = PATH(1:LENOCC(PATH))
- 10 CONTINUE
- RETURN
- ENDIF
-
- ISLASH = INDEXB(CHPATH(1:IWILD),'/')
- JSLASH = INDEX(CHPATH(IWILD:LPATH),'/') + IWILD -2
-*
-* Find subdirectories below first branch
-*
- IF(IDEBFA.GE.3)
- +PRINT *,'FMLDIR. look for subdirectories below ',
- +CHPATH(1:ISLASH-1)
- CALL FACDIR(CHPATH(1:ISLASH-1),' ')
- IF(IQUEST(1).NE.0) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMLDIR. cannot set directory ',
- + 'to ',CHPATH(1:ISLASH-1)
- IRC = IQUEST(1)
- RETURN
- ENDIF
- CALL CFILL(' ',SUBDIR,1,20*MAXDIR)
- CALL RZRDIR(MAXDIR,SUBDIR,NSDIR)
- IF(IDEBFA.GE.2)
- +PRINT *,'FMLDIR. ',NSDIR,' subdirectories found below ',
- +CHPATH(1:ISLASH-1)
-*
-* Perform wild-card matching
-*
- CALL FMNWRD('/',CHPATH(3:LPATH),NWORDS)
- LDIR = LENOCC(DIRNAM(NWORDS))
- IBRA = ICFMUL('<>',DIRNAM(NWORDS),1,LDIR)
- IF(IBRA.GT.LDIR) IBRA = 0
-
- IF(IBRA.NE.0) THEN
- CALL FMMANY(DIRNAM(NWORDS)(1:LDIR),SUBDIR,NSDIR,NMATCH,IRET)
- IF(NMATCH.EQ.0) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMLDIR. no directories match ',
- + 'selection ',DIRNAM(NWORDS)(1:LDIR)
- IRC = 1
- RETURN
- ELSE
- IF(IDEBFA.GE.3) PRINT *,'FMLDIR. selected ',
- + SUBDIR(NMATCH)
- ENDIF
- NLOW = NMATCH
- NHIGH = NMATCH
- NSDIR = 1
- ELSE
- NLOW = 1
- NHIGH = NSDIR
- ENDIF
-
- DO 20 I=NLOW,NHIGH
- FILES(I) = ' '
- PATH = CHPATH(1:ISLASH)//SUBDIR(I)(1:LENOCC(SUBDIR(I)))
- LP = LENOCC(PATH)
-*
-* Compare the current subdirectory name with the corresponding
-* component of the input file name
-*
- CALL FMNWRD('/',PATH(3:LP),NWUDS)
- IF(NWUDS.LE.NWORDS) THEN
- CALL FMATCH(SUBDIR(I)(1:LENOCC(SUBDIR(I))),DIRNAM(NWUDS)
- + (1:LENOCC(DIRNAM(NWUDS))),IMAT)
- IF(IMAT.NE.0) GOTO 20
- ENDIF
- NSTACK = NSTACK + 1
- STACK(NSTACK) = PATH(1:LP)
-*
-* Only move subdirectory to output array if complete path name
-* matches.
-*
- CALL FMATCH(PATH(1:LP),CHPATH(1:LPATH),IRET)
- IF(IRET.EQ.0) THEN
- NFOUND = NFOUND + 1
- FILES(NFOUND) = PATH(1:LP)
- ENDIF
- 20 CONTINUE
- PATH = ' '
- 30 CONTINUE
- IF(NSTACK.EQ.0) GOTO 50
- CHDIR = STACK(NSTACK)
- NSTACK = NSTACK - 1
- LCHDIR = LENOCC(CHDIR)
- CALL FACDIR(CHDIR(1:LCHDIR),' ')
- IF(IQUEST(1).NE.0) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMLDIR. cannot set directory ',
- + 'to ',CHDIR(1:LCHDIR)
- IRC = IQUEST(1)
- RETURN
- ENDIF
-*
-* For each subdirectory, find subdirectories...
-*
- CALL CFILL(' ',SUBDIR,1,20*MAXDIR)
- CALL RZRDIR(MAXDIR,SUBDIR,NSDIR)
- IF(NSDIR.EQ.0) GOTO 30
-*
-* Perform wild-card matching at this level
-*
- CALL FMNWRD('/',CHDIR(3:LENOCC(CHDIR)),NWORDS)
- LDIR = LENOCC(DIRNAM(NWORDS+1))
- IBRA = ICFMUL('<>',DIRNAM(NWORDS+1),1,LDIR)
- IF(IBRA.GT.LDIR) IBRA = 0
- IF(IBRA.NE.0) THEN
- CALL FMMANY(DIRNAM(NWORDS+1)(1:LDIR),SUBDIR,NSDIR,NMATCH,
- + IRET)
- IF(NMATCH.EQ.0) GOTO 30
- NLOW = NMATCH
- NHIGH = NMATCH
- NSDIR = 1
- ELSE
- NLOW = 1
- NHIGH = NSDIR
- ENDIF
-*
-* Check if we can accept any more directories
-* If not, leave last entry on the stack and return
-*
- IF(NSDIR.GT.MAXFIL) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMLDIR. number of subdirectories ',
- + '(',NSDIR,')',' exceeds MAXDIR ',
- + '(',MAXFIL,')',' directory = ',CHDIR(1:LCHDIR)
- IRC = -2
- RETURN
- ENDIF
-
- IF(NFOUND+NSDIR.GT.MAXFIL) THEN
- IF(IDEBFA.GE.2) PRINT *, 'FMLDIR. maximum number of '
- + //'subdirectories reached'
- NSTACK = NSTACK + 1
- IRC = -1
- ICONT = 1
- RETURN
- ENDIF
-
- IF(NSTACK+NSDIR.GT.MAXSTK) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMLDIR. Stack overflow'
- IRC = 1
- RETURN
- ENDIF
-
- DO 40 I=NLOW,NHIGH
- PATH = CHDIR(1:LENOCC(CHDIR)) // '/' // SUBDIR(I)(1:
- + LENOCC(SUBDIR(I)))
- LP = LENOCC(PATH)
- IF(IDEBFA.GE.3) PRINT *,'FMLDIR. processing directory ',
- + PATH(1:LP)
- NSTACK = NSTACK + 1
- STACK(NSTACK) = PATH(1:LP)
- IF(IBRA.EQ.0) THEN
- CALL FMATCH(PATH(1:LP),CHPATH(1:LPATH),IRET)
- IF(IRET.NE.0) GOTO 40
- ENDIF
- NFOUND = NFOUND + 1
- FILES(NFOUND) = PATH(1:LP)
- 40 CONTINUE
- GOTO 30
- 50 CONTINUE
- END
diff --git a/src/packlib/fatmen/unref/fmls.F b/src/packlib/fatmen/unref/fmls.F
deleted file mode 100644
index 363c7c6..0000000
--- a/src/packlib/fatmen/unref/fmls.F
+++ /dev/null
@@ -1,190 +0,0 @@
-*
-* $Id: fmls.F,v 1.1.1.1 1996/03/07 15:18:23 mclareni Exp $
-*
-* $Log: fmls.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:23 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMLS(PATHN,CHOPT,IRC)
- CHARACTER*(*) PATHN
- PARAMETER (MAXFIL=1000)
- PARAMETER (LKEYFA=10)
- DIMENSION KEYS(LKEYFA,MAXFIL),JSORT(MAXFIL),KEYSAV(LKEYFA)
- CHARACTER*255 FILES,PATH,CHPATH,PREDIR,GENAM,OLDNAM
-#include "fatmen/fatsho.inc"
-#include "fatmen/fatpara.inc"
-#include "fatmen/fatloc.inc"
-#include "fatmen/fatmtp.inc"
-#include "fatmen/fatcpl.inc"
-#include "fatmen/fatout.inc"
- CHARACTER*20 CHFILE,MATCH
-#include "fatmen/fatbank.inc"
- COMMON /MYWKSP/ FILES(MAXFIL)
- CHARACTER*132 CARD
-#include "fatmen/fatopts.inc"
-*
-* Options which effect this routine: I=sort in increasing order
-* X=display each generic name only once
-* V=very wide display
-* X=wide display
-*
- PATH = PATHN
- LPATH = LENOCC(PATHN)
- PATH = PATHN(1:LPATH)
- IRC = 0
- IF(IOPTI.NE.0) IOPTX = 1
-
- OUTPUT = 'TTY'
- LOUT = 3
- LWRITE = LPRTFA
-
- CWDSHO = ' '
-
- CALL FACDIR(PREDIR,'R')
-*
- NFILES = 0
-*
-* Look for some files and show the bank and key content:
-*
- LSLASH = INDEXB(PATH(1:LPATH),'/')
- CHPATH = PATH(1:LSLASH-1)
- MATCH = PATH(LSLASH+1:LPATH)
- LP = LENOCC(CHPATH)
- LM = LENOCC(MATCH)
- IF(IDEBFA.GE.2) PRINT *,'FMLS. enter for ',PATH(1:LPATH),
- + CHOPT
- JCONT = 0
-1 CONTINUE
- CALL FMLFIL(PATH(1:LPATH),FILES,KEYS,NFOUND,MAXFIL,JCONT,IRC)
- IF(IRC.EQ.-1) THEN
- JCONT = 1
- ELSE
- JCONT = 0
- ENDIF
-* CALL FMLIST(CHPATH(1:LP),FILES,KEYS,NFOUND,MAXFIL,IRC)
- OLDNAM = ' '
- LOLD = 1
- IF(IOPTI.NE.0) THEN
- IF(IDEBFA.GE.3) PRINT *,'FMLS. sorting file names...'
- CALL FMSORT(FILES,KEYS,NFOUND,JSORT,IC)
- ENDIF
- IWIDTH = 0
- JWIDTH = 78
- IF(IOPTV.NE.0) JWIDTH = 132
- DO 200 I=1,NFOUND
- IF(IOPTI.NE.0) THEN
- J = JSORT(I)
- ELSE
- J = I
- ENDIF
- GENAM = FILES(J)
- IF(IDEBFA.GE.3) PRINT *,'FMLS. GENAM = ',GENAM
- IF(IOPTX.NE.0) THEN
- IF(IDEBFA.EQ.3) PRINT *,'FMLS. GENAM/OLDNAM = ',
- + GENAM,' / ',OLDNAM
- IF(GENAM.EQ.OLDNAM) GOTO 200
- ENDIF
- LFILE = LENOCC(GENAM)
- ISLASH = INDEXB(OLDNAM(1:LOLD),'/')
- JSLASH = INDEXB(GENAM(1:LFILE),'/')
- CHFILE = GENAM(JSLASH+1:LFILE)
- LF = LENOCC(CHFILE)
- CALL FMATCH(CHFILE(1:LF),MATCH(1:LM),IMAT)
- IF(IMAT.NE.0) GOTO 200
-*
-* Check that keys match those selected
-* Location code:
-*
- IF(NUMLOC.GT.0) THEN
- IF(IUCOMP(KEYS(MKLCFA,J),MFMLOC,NUMLOC).EQ.0) THEN
- IF(IDEBFA.GE.3) PRINT *,'FMLS. candidate # ',J,
- + ' fails location code check'
- GOTO 200
- ENDIF
- ENDIF
-*
-* Copy level:
-*
- IF(NUMCPL.GT.0) THEN
- IF(IUCOMP(KEYS(MKCLFA,J),MFMCPL,NUMCPL).EQ.0) THEN
- IF(IDEBFA.GE.3) PRINT *,'FMLS. candidate # ',J,
- + ' fails copy level check'
- GOTO 200
- ENDIF
- ENDIF
-*
-* Media type:
-*
- IF(NUMMTP.GT.0) THEN
- IF(IUCOMP(KEYS(MKMTFA,J),MFMMTP,NUMMTP).EQ.0) THEN
- IF(IDEBFA.GE.3) PRINT *,'FMLS. candidate # ',J,
- + ' fails media type check'
- GOTO 200
- ENDIF
- ENDIF
-
-
- NFILES = NFILES + 1
- LBANK=0
- IF(IOPTX.NE.0) THEN
-*
-* Option 1 - display each entry only once
-* Display entry chosen by current selection unless not found
-*
- CALL UCOPY(KEYS(1,J),KEYSAV,10)
- KEYS(1,J) = 0
- CALL FMGET(GENAM,LBANK,KEYS(1,J),IC)
- IF(IC.NE.0) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMLS. ** Warning. ** ',
- + 'No match with current selection criteria for ',
- + CHFILE(1:LF)
- CALL UCOPY(KEYSAV,KEYS(1,J),10)
- ENDIF
- LBANK=0
- ENDIF
- IF((IOPTW.NE.0).OR.(IOPTV.NE.0)) THEN
- IF(OLDNAM(1:JSLASH-1).NE.GENAM(1:ISLASH-1)) THEN
- IF(IWIDTH.GT.0) THEN
- WRITE(LWRITE,'(1X,A)') CARD(1:IWIDTH)
- IWIDTH = 0
- ENDIF
- WRITE(LWRITE,*)
- WRITE(LWRITE,8001) GENAM(1:JSLASH-1)
- WRITE(LWRITE,*)
-8001 FORMAT(' Directory :',A)
- ENDIF
-*
-* Just display file names across the terminal...
-*
- IF(IWIDTH+LF.GE.JWIDTH) THEN
-* flush current buffer
- WRITE(LWRITE,'(1X,A)') CARD(1:IWIDTH)
- IWIDTH = 0
- ENDIF
- IF(IWIDTH.EQ.0) THEN
- CARD = CHFILE(1:LF) // ' '
- ELSE
- CARD = CARD(1:IWIDTH) // CHFILE(1:LF) // ' '
- ENDIF
- IWIDTH = IWIDTH + LF + 1
- ELSE
- CALL FMPKEY(KEYS(1,J),10)
- CALL FMSHOW(GENAM,LBANK,KEYS(1,J),CHOPT,IRC)
- CALL MZDROP(IXSTOR,LBANK,' ')
- LBANK = 0
- ENDIF
- OLDNAM = GENAM
- LOLD = LFILE
-200 CONTINUE
- IF((IOPTW.NE.0).OR.(IOPTV.NE.0))
- + WRITE(LWRITE,'(1X,A)') CARD(1:IWIDTH)
-
- IF(JCONT.NE.0) GOTO 1
-
- IRC = NFILES
- CALL FACDIR(PREDIR,' ')
- RETURN
- END
-
diff --git a/src/packlib/fatmen/unref/fmlsc.F b/src/packlib/fatmen/unref/fmlsc.F
deleted file mode 100644
index 4a8594a..0000000
--- a/src/packlib/fatmen/unref/fmlsc.F
+++ /dev/null
@@ -1,259 +0,0 @@
-*
-* $Id: fmlsc.F,v 1.1.1.1 1996/03/07 15:18:24 mclareni Exp $
-*
-* $Log: fmlsc.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:24 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMLSC
- PARAMETER (MAXFIL=1000)
- PARAMETER (LKEYFA=10)
- DIMENSION KEYS(LKEYFA,MAXFIL),JSORT(MAXFIL)
- DIMENSION KEYSAV(LKEYFA)
- CHARACTER*255 FILES(MAXFIL),PATH,CHPATH,PREDIR,GENAM,OLDNAM
- CHARACTER*255 PATH2
- COMMON/FALSC/KEYS,JSORT,FILES
-#include "fatmen/fatpara.inc"
-#include "fatmen/fatloc.inc"
-#include "fatmen/fatmtp.inc"
-#include "fatmen/fatcpl.inc"
-#include "fatmen/fatsys.inc"
-#include "fatmen/fatout.inc"
-#include "fatmen/fatsho.inc"
- CHARACTER*20 CHFILE,MATCH
- CHARACTER*36 CHOPT,OPTN
-#include "fatmen/fatbank.inc"
- CHARACTER*132 CARD
- CHARACTER*3 CHSTAT
- CHARACTER*80 COMAND
- LOGICAL IOPEN,IEXIST
- DATA NENT/0/
-#include "fatmen/fatinit.inc"
-*
- OUTPUT = ' '
- LOUT = 0
- LWRITE = LPRTFA
- CALL FACDIR(PREDIR,'R')
- CALL FACDIR(PREDIR,'U')
-
- CWDSHO = ' '
-
- IF(NENT.EQ.0) THEN
- NENT = 1
-* RETURN
- ENDIF
-
- PATH = ' '
- CALL KUPATL(COMAND,NPAR)
- CALL KUGETC(PATH,LPATH)
- CALL KUGETC(OUTPUT,LOUT)
- CALL KUGETC(CHOPT,LCHOPT)
- CALL FMFIXF(PATH,PATH2)
- PATH = PATH2
- LPATH = LENOCC(PATH)
-
- IF(LCHOPT.EQ.0) THEN
- CHOPT = ' '
- LCHOPT = 1
- ENDIF
-*
-* Fix for strange KUIP behaviour...
-*
- IF(OUTPUT(1:1).EQ.'-') THEN
- CHOPT = OUTPUT
- LCHOPT = LOUT
- OUTPUT = 'TTY'
- LOUT = 3
- ENDIF
-
- LOUT = LENOCC(OUTPUT)
- IF((OUTPUT(1:LOUT).EQ.'TTY').OR.(LOUT.EQ.0)) THEN
- OUTPUT = ' '
- LWRITE = LPRTFA
- ELSE
- LWRITE = 3
- IF(IDEBFA.GE.2)
- + PRINT *,'FMLSC. output will be redirected to ',OUTPUT(1:LOUT)
- CALL FAFILE(LWRITE,OUTPUT(1:LOUT),IRET)
- IF(IRET.NE.0) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMLSC. return code ',IRET,
- + ' opening file ',OUTPUT(1:LOUT),
- + ' - output will be sent to screen'
- OUTPUT = ' '
- LWRITE = LPRTFA
- ENDIF
- ENDIF
-
- IF(LENOCC(CHOPT).EQ.0) THEN
- CHOPT = ' '
- LCHOPT = 1
- ENDIF
-*
- NFILES = 0
-*
-* Look for some files and show the bank and key content:
-*
- LSLASH = INDEXB(PATH(1:LPATH),'/')
- CHPATH = PATH(1:LSLASH-1)
- MATCH = PATH(LSLASH+1:LPATH)
- LP = LENOCC(CHPATH)
- LM = LENOCC(MATCH)
- IF(IDEBFA.GE.2) PRINT *,'FMLSC. enter for ',PATH(1:LPATH),
- + ',',OUTPUT,',',CHOPT
-*
- IF(INDEX(CHOPT(1:LCHOPT),'H').NE.0) THEN
- WRITE(LWRITE,*) '>>> Command: LS ',
- + 'Options: ',CHOPT(1:LCHOPT)
- WRITE(LWRITE,*) '>>> Path: ',PATH(1:LPATH)
- WRITE(LWRITE,*) '>>> Current directory: ',
- + PREDIR(1:LENOCC(PREDIR))
- ENDIF
-*
- JCONT = 0
- 1 CONTINUE
- CALL FMLFIL(PATH(1:LPATH),FILES,KEYS,NFOUND,MAXFIL,JCONT,IRC)
- IF(IRC.EQ.-1) THEN
- JCONT = 1
- ELSE
- JCONT = 0
- ENDIF
-
-* CALL FMLIST(CHPATH(1:LP),FILES,KEYS,NFOUND,MAXFIL,IRC)
- OLDNAM = ' '
- LOLD = 1
- IF((INDEX(CHOPT,'I').NE.0) .OR.
- + (INDEX(CHOPT,'X').NE.0)) THEN
- IF(IDEBFA.EQ.3) PRINT *,'FMLS. sorting file names...'
- CALL FMSORT(FILES,KEYS,NFOUND,JSORT,IC)
- ENDIF
- IWIDTH = 0
- JWIDTH = 78
- IF(INDEX(CHOPT,'V').NE.0) JWIDTH = 132
- DO 200 I=1,NFOUND
- IF((INDEX(CHOPT,'I').NE.0).OR.
- + (INDEX(CHOPT,'X').NE.0)) THEN
- J = JSORT(I)
- ELSE
- J = I
- ENDIF
- GENAM = FILES(J)
- LFILE = LENOCC(GENAM)
- IF(IDEBFA.GE.3) PRINT *,'FMLSC. GENAM = ',GENAM(1:LFILE)
- IF(IDEBFA.GE.3) PRINT *,'FMLSC. OLDNAM = ',OLDNAM(1:LOLD)
- IF(INDEX(CHOPT,'X').NE.0) THEN
- IF(GENAM.EQ.OLDNAM) GOTO 200
- ENDIF
- ISLASH = INDEXB(OLDNAM(1:LOLD),'/')
- JSLASH = INDEXB(GENAM(1:LFILE),'/')
- CHFILE = GENAM(JSLASH+1:LFILE)
- LF = LENOCC(CHFILE)
- CALL FMATCH(CHFILE(1:LF),MATCH(1:LM),IMAT)
- IF(IMAT.NE.0) GOTO 200
-*
-* Check that keys match those selected
-* Location code:
-*
- IF(NUMLOC.GT.0) THEN
- IF(IUCOMP(KEYS(MKLCFA,J),MFMLOC,NUMLOC).EQ.0) THEN
- IF(IDEBFA.GE.3) PRINT *,'FMLSC. candidate # ',J,
- + ' fails location code check'
- GOTO 200
- ENDIF
- ENDIF
-*
-* Copy level:
-*
- IF(NUMCPL.GT.0) THEN
- IF(IUCOMP(KEYS(MKCLFA,J),MFMCPL,NUMCPL).EQ.0) THEN
- IF(IDEBFA.GE.3) PRINT *,'FMLSC. candidate # ',J,
- + ' fails copy level check'
- GOTO 200
- ENDIF
- ENDIF
-*
-* Media type:
-*
- IF(NUMMTP.GT.0) THEN
- IF(IUCOMP(KEYS(MKMTFA,J),MFMMTP,NUMMTP).EQ.0) THEN
- IF(IDEBFA.GE.3) PRINT *,'FMLSC. candidate # ',J,
- + ' fails media type check'
- GOTO 200
- ENDIF
- ENDIF
-
- NFILES = NFILES + 1
- LBANK=0
- IF(INDEX(CHOPT,'X').NE.0) THEN
-*
-* Option X - display each entry only once
-* Display entry chosen by current selection unless not found
-*
- CALL UCOPY(KEYS(1,J),KEYSAV,10)
- CALL FMGET(GENAM,LBANK,KEYS(1,J),IC)
- IF(IC.NE.0) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMLSC. ** Warning. ** ',
- + 'No match with current selection criteria for ',
- + CHFILE(1:LF)
- CALL UCOPY(KEYSAV,KEYS(1,J),10)
- ENDIF
- LBANK=0
- ENDIF
- IF((INDEX(CHOPT,'W').NE.0) .OR.
- + (INDEX(CHOPT,'V').NE.0)) THEN
- IF(OLDNAM(1:JSLASH-1).NE.GENAM(1:ISLASH-1)) THEN
- IF(IWIDTH.GT.0) THEN
- WRITE(LWRITE,'(1X,A)') CARD(1:IWIDTH)
- IWIDTH = 0
- ENDIF
- WRITE(LWRITE,*)
- WRITE(LWRITE,8001) GENAM(1:JSLASH-1)
- WRITE(LWRITE,*)
- 8001 FORMAT(' Directory :',A)
- ENDIF
-*
-* Just display file names across the terminal...
-*
- IF(IWIDTH+LF.GE.JWIDTH) THEN
-* flush current buffer
- WRITE(LWRITE,'(1X,A)') CARD(1:IWIDTH)
- IWIDTH = 0
- ENDIF
- IF(IWIDTH.EQ.0) THEN
- CARD = CHFILE(1:LF) // ' '
- ELSE
- CARD = CARD(1:IWIDTH) // CHFILE(1:LF) // ' '
- ENDIF
- IWIDTH = IWIDTH + LF + 1
- ELSE
- CALL FMSHOW(GENAM,LBANK,KEYS(1,J),CHOPT,IRC)
- CALL MZDROP(IXSTOR,LBANK,' ')
- LBANK = 0
- ENDIF
- OLDNAM = GENAM
- LOLD = LFILE
- 200 CONTINUE
- IF((INDEX(CHOPT,'W').NE.0) .OR.
- + (INDEX(CHOPT,'V').NE.0))
- + WRITE(LWRITE,'(1X,A)') CARD(1:IWIDTH)
-
- IF(JCONT.NE.0) GOTO 1
-
- IF (IDEBFA.GE.-2) THEN
-
- WRITE(LWRITE,'(A)') ' '
- IF(NFILES .EQ. 0) THEN
- WRITE(LWRITE,8016)
- 8016 FORMAT(' Specified file(s) not found')
- ELSE
- WRITE(LWRITE,8017) NFILES
- 8017 FORMAT(' Files:',I5)
- ENDIF
- ENDIF
-
- INQUIRE(3,OPENED=IOPEN)
- IF(IOPEN) CLOSE(3)
- CALL FACDIR(PREDIR(1:LENOCC(PREDIR)),' ')
- RETURN
- END
diff --git a/src/packlib/fatmen/unref/fmltgt.F b/src/packlib/fatmen/unref/fmltgt.F
deleted file mode 100644
index ad20130..0000000
--- a/src/packlib/fatmen/unref/fmltgt.F
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: fmltgt.F,v 1.1.1.1 1996/03/07 15:18:23 mclareni Exp $
-*
-* $Log: fmltgt.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:23 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMLTGT(MATCH,SUBDIR,NSUB,IC)
- CHARACTER*(*) SUBDIR(NSUB)
- CHARACTER*20 CHDIR(1000)
- CHARACTER*(*) MATCH
- CHARACTER*20 XMATCH
-*
-* First, find all subdirs which match, replacing < & > by *
-*
- LMATCH = LENOCC(MATCH)
- XMATCH = MATCH(1:LMATCH)
- CALL CTRANS('<','*',XMATCH,1,LMATCH)
- CALL CTRANS('>','*',XMATCH,1,LMATCH)
- NPASS = 0
- DO 10 I=1,NSUB
- CALL FMATCH(SUBDIR(I),XMATCH(1:LMATCH),IRC)
- IF(IRC.NE.0) GOTO 10
- NPASS = NPASS + 1
- CHDIR(NPASS) = SUBDIR(I)
-10 CONTINUE
-
- END
-
diff --git a/src/packlib/fatmen/unref/fmmake.F b/src/packlib/fatmen/unref/fmmake.F
deleted file mode 100644
index 6a6c84f..0000000
--- a/src/packlib/fatmen/unref/fmmake.F
+++ /dev/null
@@ -1,1019 +0,0 @@
-*
-* $Id: fmmake.F,v 1.1.1.1 1996/03/07 15:18:23 mclareni Exp $
-*
-* $Log: fmmake.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:23 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMMAKE(GENAME,CHLUN,LENTRY,IRC)
-*
-#include "fatmen/fatbank.inc"
-#include "fatmen/fatpara.inc"
-#include "fatmen/tmsdef.inc"
-#include "fatmen/fatstg.inc"
-#include "fatmen/fattyp.inc"
-#include "fatmen/fatinfo.inc"
-#include "zebra/zmach.inc"
-#include "fatmen/fatvidp.inc"
-#include "fatmen/slate.inc"
- PARAMETER (LKEYFA=10)
- DIMENSION KEYS(LKEYFA)
- CHARACTER*8 ROUTIN,STATE
- CHARACTER*16 SHUSER,SHPOOL
- CHARACTER*12 FORMT
- CHARACTER*255 COMAND,SETUP,LABELDEF,FILEDEF,CHFILE,L3PATH
- CHARACTER*255 CHNFS,CHDSN
- CHARACTER*4 DEVTYP
- CHARACTER*6 VSN,VID,FSEQ
- CHARACTER*15 XVID
- CHARACTER*8 VIP
- CHARACTER*2 LABEL
- CHARACTER*6 CHRECL,CHBLK
- CHARACTER*6 VAXLAB(3)
- CHARACTER*2 IBMLAB(3)
- CHARACTER*(*) GENAME
- CHARACTER*8 HNAME,HTYPE,HSYS,HDISK
- CHARACTER*8 USER,ADDR
- CHARACTER*8 CHUSER
- CHARACTER*256 DSN
- CHARACTER*2 MODE
- CHARACTER*80 LINE
- CHARACTER*8 FORLUN
- INTEGER FMHOST,FMUSER
- CHARACTER*5 IOMODE
- CHARACTER*4 FFORM,FTEMP
- CHARACTER*(*) CHLUN
- CHARACTER*6 CDEN
- CHARACTER*4 CSIZE
- CHARACTER*4 FZOPT,RZOPT,SHOPT
- CHARACTER*20 STGOPT
- CHARACTER*1 VMOPT
- CHARACTER*40 DCB
- CHARACTER*20 FNAME
- CHARACTER*4 RECFM1
- CHARACTER*4 RECFM
- CHARACTER*8 RING
- CHARACTER*8 DDNAME
- CHARACTER*1 DEVNAM
- CHARACTER*3 DEVNUM
- CHARACTER*12 CHDIR
-#if defined(CERNLIB_UNIX)
- INTEGER SYSTEMF
-#endif
- LOGICAL IWAIT
- DIMENSION LENTRY(1)
- DATA NENTRY/0/
- DATA IBMLAB(1)/'SL'/,IBMLAB(2)/'NL'/IBMLAB(3)/'AL'/
- DATA VAXLAB(1)/'EBCDIC'/,
- + VAXLAB(2)/'NONE '/,
- + VAXLAB(3)/'ASCII '/
-#include "fatmen/fatoptd.inc"
-*
-* Set routine name
-*
- ROUTIN = 'FMMAKE. '
- NCH = LENOCC(GENAME)
- CALL VZERO(IOPT,36)
- IF(IDEBFA.GE.1) WRITE(LPRTFA,9013) GENAME(1:NCH)
-9013 FORMAT(' FMMAKE. make ',A)
- IMODE = 1
- IOMODE = '/OUT '
-#if defined(CERNLIB_IBMVM)
- CALL FMONIT('FMMAKE. '//GENAME(1:NCH))
-#endif
-10 CONTINUE
- L = LENTRY(1)
-*
-* CHLUN can have the following formats:
-*
-* nn
-* FTnnFlll
-* IOFILEnn
-* FORnnn
-* fort.nn
-*
- LUN = 0
- LCHLUN = LENOCC(CHLUN)
-* Dirty trick to satisfy Unix machines
- IF (LCHLUN .EQ. 1) THEN
- READ(CHLUN,1) LUN
- ELSEIF(LCHLUN .EQ. 2) THEN
- READ(CHLUN,2) LUN
- ENDIF
-1 FORMAT(I1)
-2 FORMAT(I2)
-
- IC = FMUSER(CHUSER)
-
-#if defined(CERNLIB_SETUP)
- IF((IOPTT.EQ.0).AND.(IDEBFA.GE.0).AND.(NENTRY.EQ.0))
- +PRINT *,ROUTIN//'Tape staging has been disabled at this location'
- NENTRY = 1
- IOPTT = 1
-#endif
-#if defined(CERNLIB_STAGE)
- IF((IOPTT.NE.0).AND.(IDEBFA.GE.0).AND.(NENTRY.EQ.0))
- +PRINT *,ROUTIN//'Tape staging is enforced at this location'
- NENTRY = 1
- IOPTT = 0
-#endif
- CALL CLTOU(GENAME)
- CALL UHTOC(IQ(L+KOFUFA+MFQNFA),4,DSN,NFQNFA)
- LDSN = LENOCC(DSN)
- LBLANK = INDEX(DSN,' ')
- IF(LBLANK.NE.0) LDSN = LBLANK
-#if defined(CERNLIB_UNIX)
-*
-* If DSN starts with a $, assume that it is an environmental
-* variable.
- IF(DSN(1:1).EQ.'$') THEN
- LENV = INDEX(DSN(1:LDSN),'/')
- CALL GETENVF(DSN(2:LENV-1),CHNFS)
- IF(IS(1).GT.0) THEN
- CHDSN = CHNFS(1:IS(1)) // DSN(LENV:LDSN)
- LDSN = LENOCC(DSN)
- DSN = CHDSN(1:LDSN)
- ELSE
- IF(IDEBFA.GE.-3) PRINT *,'FMMAKE. cannot translate ',
- + ' environmental variable ',DSN(1:LENV-1)
- ENDIF
- ENDIF
-#endif
-*
-* Get DCB information
-*
- CALL UHTOC(IQ(L+KOFUFA+MRFMFA),4,RECFM,4)
- LRECL = IQ(L+KOFUFA+MRLNFA)*4
- LBLOCK = IQ(L+KOFUFA+MBLNFA)*4
-*
-* FATMEN file format (for call to FZFILE,RZFILE)
-*
- CALL UHTOC(IQ(L+KOFUFA+MFLFFA),4,FFORM,4)
-*
-* New Zebra uses FORTRAN I/O as default...
-*
- LFORM = LENOCC(FFORM)
- IF(FFORM(1:2).EQ.'FX') THEN
- FTEMP = FFORM
- FFORM = 'F'//FTEMP(1:LFORM)
- ENDIF
-*
-* Find file and STAGE if necessary
-*
-*
-* Disk files ...
-*
- IF (IQ(L+KOFUFA+MMTPFA) .EQ. 1) THEN
-*
-* File is on disk. Check on Node etc. has been done in FMRZIN
-*
- IC = FMHOST(HNAME,HTYPE,HSYS)
- CALL UHTOC(IQ(L+KOFUFA+MHSNFA),4,HDISK,8)
- LHOST = LENOCC(HNAME)
-
-#if defined(CERNLIB_IBMVM)
- COMAND = 'FILEDEF FTnnF001 DISK '
- IF ((FFORM(1:2) .EQ. 'FX') .OR. (FFORM(1:2) .EQ. 'EP'))
- + COMAND = 'FILEDEF IOFILEnn DISK '
- WRITE(COMAND(17:18),9001) LUN
- IF (COMAND(17:17) .EQ. ' ') COMAND(17:17) = '0'
- IF (LUN .EQ. 0) COMAND(15:22) = CHLUN
-*
-* Get disk name and link to it
-*
-
- LSTA = INDEX(DSN,'<')
- IF (LSTA .NE. 0) THEN
-*
-* Format of DSN is <user.address>filename.filetype on VM
-*
- LDOT = INDEX(DSN,'.')
- LBRA = INDEX(DSN,'>')
-
- IF ((LDOT .NE. 0) .AND. (LDOT .LE. LBRA)) THEN
- LEND = LDOT
- ELSE
- LEND = LBRA
- ENDIF
-
- USER = DSN(LSTA+1:LEND-1)
- LUSR = LEND - LSTA + 1
- ADDR = ' '
-
- IF ((LDOT .NE. 0) .AND. (LDOT .LE. LBRA)) THEN
- ADDR= DSN(LDOT+1:LBRA-1)
- ENDIF
-
- CALL VMCMS('EXEC GIME '//USER(1:LUSR)//ADDR//
- + '(QUIET NONOTICE STACK)',IRC)
- IF(IRC.GT.4) THEN
- IF(IDEBFA.GE.0)
- + PRINT *,ROUTIN//' return code from GIME = ',IRC
- RETURN
- ENDIF
-
- CALL VMRTRM(LINE,LENGTH)
- MODE = LINE(1:1)
-*
-* Use mode 4 for all CMS files, except RECFM F
-* N.B. files in CMS format V will be incorrectly handled!
-* To be read correctly, RECFM=U
-*
- IF (FFORM(1:2) .EQ. 'RZ') THEN
- MODE(2:2) = '6'
- ELSE
- MODE(2:2) = '4'
- ENDIF
-
- IF (RECFM(1:1) .EQ. 'U') MODE(2:2) = '1'
- IF(IDEBFA.GE.0) WRITE(LPRTFA,9015) ROUTIN,USER,ADDR,MODE
-9015 FORMAT(1X,A8,'linked to ',A8,' address ',A3,' mode ',A4)
- ELSE
- MODE = '*'
- ENDIF
-
- LDOT = INDEXB(DSN,'.')
- DSN(LDOT:LDOT) = ' '
- COMAND = COMAND(1:30) // DSN(LBRA+1:LDSN) // ' ' // MODE
- LENCOM = LENOCC(COMAND)
- WRITE(DCB,8001) RECFM,LRECL,LBLOCK
-* IF(IMODE.NE.0) THEN
- COMAND = COMAND(1:LENOCC(COMAND)) // '(' // DCB
-* ENDIF
-
- LENCOM = LENOCC(COMAND)
- IF(IDEBFA.GE.0)
- + PRINT *,ROUTIN//'running ',COMAND(1:LENCOM)
-
- CALL VMCMS(COMAND(1:LENCOM),IRC)
-
-#endif
-#if defined(CERNLIB_VAXVMS)
-*
-* Find disk with most space
-*
- IF(IMODE.NE.0) CALL FMXDSK(DSN,IRC)
-*
-* Just assign the relevant logical name...
-*
- FORLUN = 'FOR00N'
- WRITE(FORLUN(4:6),9002) LUN
-9002 FORMAT(I3)
- IF (FORLUN(4:4) .EQ. ' ') FORLUN(4:4) = '0'
- IF (FORLUN(5:5) .EQ. ' ') FORLUN(5:5) = '0'
- IF (LUN .EQ. 0) FORLUN = CHLUN
- IC = LIB$SET_LOGICAL(FORLUN(1:LENOCC(FORLUN)),
- + DSN(1:LDSN))
- IF (.NOT. IC) CALL LIB$SIGNAL(%VAL(STATUS))
- IF (IDEBFA .GE. 2) WRITE(LPRTFA,*) 'Assign ',DSN(1:LDSN),
- + FORLUN(1:LENOCC(FORLUN))
-#endif
-#if defined(CERNLIB_UNIX)
-*
-* Just issue the assign...
-*
- FORLUN = 'fort. '
- IF(LUN.LT.10) THEN
- WRITE(FORLUN(6:6),'(I1)') LUN
- ELSE
- WRITE(FORLUN(6:7),'(I2)') LUN
- ENDIF
-
- IF (LUN .EQ. 0) FORLUN = CHLUN
- LFLUN = LENOCC(FORLUN)
-#endif
-#if (defined(CERNLIB_UNIX))&&(!defined(CERNLIB_SHIFT))
- CALL CUTOL(DSN)
-#endif
-#if (defined(CERNLIB_UNIX))&&(!defined(CERNLIB_CRAY))&&(!defined(CERNLIB_SHIFT))&&(!defined(CERNLIB_APOLLO))
- IC = SYSTEMF('ln -s '//DSN(1:LDSN)//' '
- + //FORLUN(1:LFLUN))
- IF (IDEBFA .GE. 2) WRITE(LPRTFA,*) 'Assign for logical unit ',
- + FORLUN(1:LFLUN),' dsn = ',DSN(1:LDSN)
-#endif
-#if defined(CERNLIB_APOLLO)
- IC = SYSTEMF('ln -s '//DSN(1:LDSN)//' '
- + //FORLUN(1:LFLUN))
- IF (IDEBFA .GE. 2) WRITE(LPRTFA,*) 'Assign for logical unit ',
- + FORLUN(1:LFLUN),' dsn = ',DSN(1:LDSN)
-#endif
-#if (defined(CERNLIB_UNIX))&&(defined(CERNLIB_CRAY))
- IC = SYSTEMF('assign -a '//DSN(1:LDSN)//' '
- + //FORLUN(1:LFLUN))
- IF (IDEBFA .GE. 2) WRITE(LPRTFA,*) 'Assign for logical unit ',
- + FORLUN(1:LFLUN),' dsn = ',DSN(1:LDSN)
-#endif
-#if (defined(CERNLIB_UNIX))&&(defined(CERNLIB_SHIFT))
-*
-* Check if link already exists...
-*
- INQUIRE(FILE=FORLUN(1:LFLUN),EXIST=ILINK)
- IF(ILINK) THEN
- IF(IDEBFA.GE.0)
- + PRINT *,'FMMAKE. removing existing symbolic link...'
- IC = SYSTEMF('rm '//FORLUN(1:LFLUN))
- ENDIF
-
- IF(LUN.LT.10) THEN
- WRITE(FORLUN,'(I1)') LUN
- ELSE
- WRITE(FORLUN,'(I2)') LUN
- ENDIF
-
- LFLUN = LENOCC(FORLUN)
-
- CALL CTRANS('<','[',DSN,1,LDSN)
- CALL CTRANS('>',']',DSN,1,LDSN)
-
- ILSQB = INDEX(DSN(1:LDSN),'[')
- IRSQB = INDEX(DSN(1:LDSN),']')
-
- IF(ILSQB.NE.0) THEN
-
- IF(IDEBFA.GE.0) PRINT *,'FMMAKE. SHIFT POOL file...'
-
- IDOT = INDEX(DSN(1:IRSQB),'.')
- SHPOOL = DSN(2:IDOT-1)
- SHUSER = DSN(IDOT+1:IRSQB-1)
- ISTART = IRSQB+1
- IEND = LDSN
- IF (IDEBFA.GE.0) WRITE(LPRTFA,*) 'Assign for logical unit ',
- + FORLUN(1:LFLUN),' pool = ',SHPOOL,
- + ' user = ',SHUSER,' dsn = ',DSN(ISTART:IEND)
- IC = SYSTEMF('assign ` sfget -p '//SHPOOL//
- + ' -u '//SHUSER// ' '//DSN(ISTART:IEND)//' `
- + '//FORLUN(1:LFLUN)//' ')
- IF(IC.NE.0) THEN
- PRINT *,'FMMAKE. return code ',IC,' from SFGET'
- RETURN
- ENDIF
- ELSE
-
- IF(IDEBFA.GE.0) PRINT *,'FMMAKE. SHIFT private file...'
- IF (IDEBFA.GE.0) WRITE(LPRTFA,*) 'Assign for logical unit ',
- + FORLUN(1:LFLUN),' dsn = ',DSN(1:LDSN)
- IC = SYSTEMF('assign '//DSN(1:LDSN)//' '//
- + FORLUN(1:LFLUN))
- IF(IC.NE.0) THEN
- PRINT *,'FMMAKE. return code ',IC,' from SFGET'
- RETURN
- ENDIF
- ENDIF
-
-#endif
-*
-* Tape files ...
-*
- ELSEIF(IQ(L+KOFUFA+MMTPFA) .GT. 1) THEN
-
- CDEN = CHMDEN(IQ(L+KOFUFA+MMTPFA))
-*
-* "EXEC STAGE IN ddname vsn.fseq.label.vid" (IBM)
-* "STAGE/IN vsn vid /NAME=/NUMB=/GENERIC=/LABEL= ddname" (VAX)
-* "stagein fort.lun -v vsn -V vid -l sl|nl|al|blp
-* -g TAPE|CART|SMCF -d 6250|1600" (CRAY)
-* "stagein -U unit -v vsn -V vid -l sl|nl|al|blp
-* -g TAPE|CART|SMCF -d 6250|1600" (SHIFT)
-*
- CALL UHTOC(IQ(L+KOFUFA+MVSNFA),4,VSN,6)
- LVSN = LENOCC(VSN)
- CALL CLTOU(VSN)
- CALL UHTOC(IQ(L+KOFUFA+MVIDFA),4,VID,6)
- LVID = LENOCC(VID)
- CALL CLTOU(VID)
-*
-* Generate eXtended VID - with VID prefix
-*
- JP = IQ(L+KOFUFA+MVIPFA)
- IF(JP.NE.0) THEN
- LVIP = LENOCC(PREVID(JP))
- VIP = PREVID(JP)(1:LVIP)
- XVID = PREVID(JP)(1:LENOCC(PREVID(JP)))
- + // '.' // VID(1:LVID)
- LXVID = LENOCC(XVID)
-
- ELSE
- XVID = VID
- LXVID = LVID
- LVIP = 0
- ENDIF
-
-
- WRITE(FSEQ,9003) IQ(L+KOFUFA+MFSQFA)
-9003 FORMAT(I6)
-
- JFSEQ = INDEXB(FSEQ,' ') + 1
-*
-* File size, if zero take default size for current medium
-*
- IF(IOPTO.EQ.0) ISIZE = IQ(L+KOFUFA+MFSZFA)
- IF(ISIZE .NE. 0) THEN
-*
-* May need slightly more space on disk, due to VBS format!
-*
- IFUDGE = MAX(2,ISIZE/15)
-#if defined(CERNLIB_CERNVM)
-*
-* Increase max. size by 10 MB (a few 210 MB staging disks exist...)
-*
- WRITE(CSIZE,9004) MIN(ISIZE+IFUDGE,
- + MEDSIZ(IQ(L+KOFUFA+MMTPFA))+10)
-#endif
-#if !defined(CERNLIB_CERNVM)
- WRITE(CSIZE,9004) MIN(ISIZE+IFUDGE,
- + MEDSIZ(IQ(L+KOFUFA+MMTPFA)))
-#endif
- ELSE
- WRITE(CSIZE,9004) MEDSIZ(IQ(L+KOFUFA+MMTPFA))
- ENDIF
-9004 FORMAT(I4)
-
- IF(CHLUN(1:LCHLUN) .EQ. 'NOWAIT') THEN
- STGOPT = 'NOWAIT'
- IWAIT = .FALSE.
- ELSE
- STGOPT = 'WAIT'
- IWAIT = .TRUE.
- ENDIF
-
-#if defined(CERNLIB_IBMVM)
-C======================== Modified by C. Onions =================
- IF ((FFORM(1:2) .EQ. 'FX') .OR. (FFORM(1:2) .EQ. 'EP'))THEN
- COMAND = 'EXEC STAGE IN IOFILEnn '
- WRITE(COMAND(21:22),9001) LUN
- IF (COMAND(21:21) .EQ. ' ') COMAND(21:21) = '0'
- IF (LUN .EQ. 0) COMAND(15:22) = CHLUN
- ELSE
- COMAND = 'EXEC STAGE IN FTnnF001 '
- WRITE(COMAND(17:18),9001) LUN
-9001 FORMAT(I2)
- IF (COMAND(17:17) .EQ. ' ') COMAND(17:17) = '0'
- IF (LUN .EQ. 0) COMAND(15:22) = CHLUN
- ENDIF
-*
-* Output staging?
-*
- IF (IMODE .NE. 0) COMAND(12:13) = 'OU'
-C======================== End of C. Onions modification =========
- IF(.NOT.IWAIT) COMAND(15:22) = 'FT00F001'
-*
-* Set IQUEST(11) to media type in case volume unknown or
-* TMS option not installed.
-*
- IQUEST(11) = IQ(L+KOFUFA+MMTPFA)
-#endif
-#if (!defined(CERNLIB_PREFIX))&&(defined(CERNLIB_IBMVM))
- CALL FMQTMS(VID(1:LVID),LIB,MODEL,DENS,MNTTYP,LABTYP,IC)
-#endif
-#if (defined(CERNLIB_PREFIX))&&(defined(CERNLIB_IBMVM))
- CALL FMQTMS(XVID(1:LXVID),LIB,MODEL,DENS,MNTTYP,LABTYP,IC)
-#endif
-#if defined(CERNLIB_IBMVM)
- IF(IDEBFA.GE.3) THEN
- PRINT *,'FMMAKE. return from FMQTMS with ',
- + VID,'/',LIB,'/',MODEL,'/',DENS,'/',MNTTYP,'/',
- + LABTYP,'/',IC
- ENDIF
-
- IF(MODEL(1:4).EQ.'3480') THEN
- IF(MNTTYP.EQ.'R') THEN
- MODEL = 'SMCF'
- ELSE
- MODEL = 'CT1 '
- ENDIF
- ENDIF
-
- IF(MODEL(1:4).EQ.'3420') MODEL = 'TAPE'
-
-*
-* Believe density from TMS if tape is known
-*
- IF(IC.EQ.0) CDEN = DENS
- CALL CLTOU(LABTYP)
- LLAB = LENOCC(LABTYP)
- IF(IMODE.EQ.1) STGOPT = 'AUTOPUT DELAY'
- COMAND = COMAND(1:25) // VSN(1:LVSN) // '.'
- + // FSEQ(JFSEQ:LEN(FSEQ))
- + // '.' // LABTYP(1:LLAB) // '.' // VID(1:LVID)
-
-#endif
-#if (defined(CERNLIB_PREFIX))&&(defined(CERNLIB_IBMVM))
- IF(LVIP.NE.0) COMAND = COMAND(1:LENOCC(COMAND))
- + // '.' // VIP(1:LVIP)
-#endif
-#if defined(CERNLIB_IBMVM)
- COMAND = COMAND(1:LENOCC(COMAND))
- + // ' (' //STGOPT//' SIZE '//CSIZE // ' DEN '//CDEN
-*
-* Specify dataset name only if option N not specified
-*
- IF((LDSN.NE.0) .AND. (IOPTN.EQ.0))
- + COMAND = COMAND(1:LENOCC(COMAND)) // ' DSN ' //DSN(1:LDSN)
-
-* IF((VID(1:1).EQ.'I') .AND. (IQ(L+KOFUFA+MMTPFA).EQ.2) .AND.
-* + (ICNUM(VID,2,6).EQ.7)) THEN
- IF(LIB(1:4).EQ.'SMCF') THEN
- COMAND = COMAND(1:LENOCC(COMAND)) // ' DEVTYPE SMCF'
- ENDIF
-*
-* Output STAGing only - add DCB information (also NL tapes)
-*
- IF((IMODE.NE.0).OR.(LABTYP(1:2).EQ.'NL')
- + .OR.(IOPTL.NE.0)) THEN
- WRITE(DCB,8001) RECFM,LRECL,LBLOCK
-8001 FORMAT(' RECFM ',A4,' LRECL ',I5,' BLOCK ',I5)
- COMAND = COMAND(1:LENOCC(COMAND)) // DCB
- ENDIF
-*
-* Output STAGing only - options Keep, autoPut
-*
- IF((IMODE.NE.0).AND.(IOPTK.NE.0)) THEN
- COMAND = COMAND(1:LENOCC(COMMAND)) // ' KEEP'
- ENDIF
-
- IF((IMODE.NE.0).AND.(IOPTP.NE.0)) THEN
- COMAND = COMAND(1:LENOCC(COMMAND)) // ' AUTOPUT'
- ENDIF
-
- LENCOM = LENOCC(COMAND)
-
- IF(IOPTT.EQ.0) THEN
-*
-* Use STAGE
-*
-20 CONTINUE
- IF(IDEBFA.GE.0) PRINT *,ROUTIN//'running ',COMAND(1:LENCOM)
-
- CALL VMCMS(COMAND(1:LENCOM),IRC)
-*
-* NOWAIT specified - just return
-*
- IF(.NOT.IWAIT) RETURN
-
- IF(IRC.EQ.0) THEN
-*
-* Read mode only, if file size is currently zero, option S
-* specified, and DBS opened for write...
-*
- IF((IOPTS.NE.0).AND.(LUFZFA.GT.0).AND.(IMODE.EQ.0)
- + .AND.(IQ(L+KOFUFA+MFSZFA).EQ.0)) THEN
-*
-* Build STAGE Query command
-*
- COMAND = 'EXEC STAGE QUERY ' // VSN(1:LVSN) // '.'
- + // FSEQ(JFSEQ:LEN(FSEQ))
- + // '.' // LABTYP(1:LLAB) // '.' // VID(1:LVID)
- + // ' (LIFO'
- CALL VMCMS(COMAND(1:LENOCC(COMAND)),IRC)
-*
-* Get answer and extract file size
-*
- CALL VMRTRM(LINE,LENGTH)
- ISLASH = INDEX(LINE,'/')
- IDOT = INDEXB(LINE(1:ISLASH),'.')
- IBLANK = INDEXB(LINE(1:IDOT),' ')
- READ(LINE(IBLANK+1:IDOT-1),*) ISIZE
-*
-* Add 1 MB to file size as we ignore the fraction...
-*
- IQ(L+KOFUFA+MFSZFA) = ISIZE + 1
-
- IF(IDEBFA.GE.0) THEN
- PRINT *,ROUTIN//'- updating file size from STAGE information'
- PRINT *,ROUTIN//LINE(1:LENOCC(LINE))
- ENDIF
- ENDIF
-*
-* Option D - make a duplicate copy into the robot
-*
- IF((IOPTD.NE.0).AND.(IMODE.EQ.0)) THEN
- CALL FMSMCF(GENAME,L,IC)
- IF(IC.NE.0) THEN
- PRINT *,ROUTIN//'- return code ',IC,' from FMSMCF'
- ENDIF
-
- ENDIF
-
- ELSEIF(IRC.EQ.400) THEN
-*
-* STAGE failed - cannot allocate disk size of size requested
-*
- READ(CSIZE,9004) ISIZE
- IF(ISIZE.LT.MEDSIZ(IQ(L+KOFUFA+MMTPFA))) THEN
- IF(IDEBFA.GE.0)
- + PRINT *,ROUTIN//' unable to allocate staging disk for',
- + ' size ',CSIZE,' - will try larger disk'
-*
-* Increase size by MAX of file size in FATMEN catalogue and 20MB
-* up to maximum size for this media type
-*
- ISIZE = MIN(ISIZE +
- + MAX(20,IQ(L+KOFUFA+MFSZFA)),
- + MEDSIZ(IQ(L+KOFUFA+MMTPFA)))
- WRITE(CSIZE,9004) ISIZE
- ISTART = INDEX(COMAND,'SIZE ') + 5
- COMAND(ISTART:ISTART+3) = CSIZE
- GOTO 20
- ELSE
- IF(IDEBFA.GE.0)
- + PRINT *,ROUTIN//' return code from STAGE = ',IRC
- RETURN
- ENDIF
-
- ELSEIF(IRC.GE.20) THEN
-
- IF(IDEBFA.GE.0)
- + PRINT *,ROUTIN//' return code from STAGE = ',IRC
- RETURN
-
- ENDIF
-
- ELSE
-*
-* Use SETUP
-*
- RING = ' RING '
-
- CALL FMWORD(DDNAME,3,' ',COMAND,IRC)
- LDD = LENOCC(DDNAME)
- IF(LDD.LE.2) THEN
- READ(DDNAME(1:LDD),*) LUN
- DDNAME = 'FT00F001'
- WRITE(DDNAME(3:4),9001) LUN
- ENDIF
-*
-* Find first free tape drive
-*
- ITAPE = IUCOMP(0,IDEV,16)
- IF(ITAPE.EQ.17) THEN
- IF(IDEBFA.GE.-2) PRINT *,ROUTIN
- + //' no free virtual address for tape unit'
- IRC = 1
- RETURN
- ENDIF
-
- ITEMP = 179 + ITAPE
- IF(ITAPE.GT.8) ITEMP = 277 + ITAPE
- WRITE(DEVNUM,'(I3)') ITEMP
- WRITE(DEVNAM,'(Z1)') ITAPE-1
-
-#endif
-#if (defined(CERNLIB_IBMVM))&&(defined(CERNLIB_HEPVM))
- SETUP = 'SETUP CT1 '//DEVNUM//' '
- + //VSN(1:LVSN)//' VID '//XVID//' '
- + //LABTYP//CDEN//RING
-
- IF(IOPTE.NE.0) THEN
- LENS = LENOCC(SETUP)
- SETUP = SETUP(1:LENS)//' (END'
- ENDIF
-
- IF(LIB(1:4).EQ.'SMCF') SETUP(7:10) = 'SMCF'
-
- LENS = LENOCC(SETUP)
- IF(IDEBFA.GE.0) PRINT *,ROUTIN//'running ',SETUP(1:LENS)
- CALL VMCMS(SETUP(1:LENS),IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.0) PRINT *,ROUTIN//'return code ',IRC,
- + ' from SETUP'
- RETURN
- ENDIF
-#endif
-#if (defined(CERNLIB_IBMVM))&&(defined(CERNLIB_VMTAPE))
-
- IF(IOPTW.EQ.0) THEN
- RING = ' READ '
- ELSE
- RING = ' WRITE '
- ENDIF
-
- SETUP = 'VMTAPE MOUNT '//VSN(1:LVSN)//DEVNAM
- + //' DSN ? (DEN '//CDEN//' LABEL '//LABTYP
- + //RING//' WAIT '//
- LENS = LENOCC(SETUP)
- IF(IDEBFA.GE.0) PRINT *,ROUTIN//'running ',SETUP(1:LENS)
- CALL VMCMS(SETUP(1:LENS),IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.0) PRINT *,ROUTIN//'return code ',IRC,
- + ' from VMTAPE'
- RETURN
- ENDIF
- CALL VMSTAK(DSN(1:LDSN),'L',IRC)
-#endif
-#if defined(CERNLIB_IBMVM)
-
- FILEDEF = 'FILEDEF '//DDNAME//' TAP'
- + //DEVNAM//' '//LABTYP//' (DEN '//CDEN
- LENF = LENOCC(FILEDEF)
-
- IF(IOPTW.NE.0) THEN
- FILEDEF = FILEDEF(1:LENF) // DCB
- LENF = LENOCC(FILEDEF)
- ENDIF
-
- IF(IDEBFA.GE.0) PRINT *,ROUTIN//'running ',FILEDEF(1:LENF)
- CALL VMCMS(FILEDEF(1:LENF),IRC)
-
- IF((LDSN.GT.0).AND.(IOPTN.EQ.0)) THEN
- LABELDEF = 'LABELDEF '//DDNAME//' FID ?'
- LENL = LENOCC(LABELDEF)
-
- IF(IDEBFA.GE.0)
- + PRINT *,ROUTIN//'running ',LABELDEF(1:LENL)
-*
-* Put DSN on program STACK for LABELDEF
-*
-CSELF,IF=-QMIBMXA,IF=IBMVM.
-C CALL VMCMS('EXEC FATSTACK '//DSN(1:LDSN)//' (LIFO',IRC)
-CSELF,IF=QMIBMXA,IF=IBMVM.
- IF(IDEBFA.GE.0)
- + PRINT *,ROUTIN//'DSN is ',DSN(1:LDSN)
- CALL VMSTAK(DSN(1:LDSN),'L',IRC)
-CSELF,IF=IBMVM.
- CALL VMCMS(LABELDEF(1:LENL),IRC)
-
- ENDIF
-
- ENDIF
-
-#endif
-#if defined(CERNLIB_VAXVMS)
-*
-* Build the relevant logical name for STAGE
-*
- FORLUN = 'FOR00N'
- WRITE(FORLUN(4:6),9002) LUN
- IF (FORLUN(4:4) .EQ. ' ') FORLUN(4:4) = '0'
- IF (FORLUN(5:5) .EQ. ' ') FORLUN(5:5) = '0'
- IF (LUN .EQ. 0) FORLUN = CHLUN
-
- JX = ICFNBL(CSIZE,1,4)
-*
-* Set IQUEST(11) to media type in case volume unknown or
-* TMS option not installed.
-*
- IQUEST(11) = IQ(L+KOFUFA+MMTPFA)
-#endif
-#if (!defined(CERNLIB_PREFIX))&&(defined(CERNLIB_VAXVMS))
- CALL FMQTMS(VID(1:LVID),LIB,MODEL,DENS,MNTTYP,LABTYP,IC)
-#endif
-#if (defined(CERNLIB_PREFIX))&&(defined(CERNLIB_VAXVMS))
- CALL FMQTMS(XVID(1:LXVID),LIB,MODEL,DENS,MNTTYP,LABTYP,IC)
-#endif
-#if defined(CERNLIB_VAXVMS)
- IF(IDEBFA.GE.3) THEN
- PRINT *,'FMMAKE. return from FMQTMS with ',
- + VID,'/',LIB,'/',MODEL,'/',DENS,'/',MNTTYP,'/',
- + LABTYP,'/',IC
- ENDIF
-
- IF(MODEL(1:4).EQ.'3480') THEN
- IF(MNTTYP.EQ.'R') THEN
- MODEL = 'SMCF'
- ELSE
- MODEL = 'CT1'
- ENDIF
- ENDIF
-
- IF(MODEL(1:4).EQ.'3420') MODEL = 'TAPE'
-*
-*
-* Translate IBM to VAX labels (SL->EBCDIC etc.)
-*
- JL = ICNTH(LABTYP,IBMLAB,3)
- COMAND = '$STAGE ' // VSN(1:LVSN) // ' ' // VID(1:LVID) // ' '
- + // FORLUN // IOMODE // '/NAME=' // DSN(1:LDSN)
- + // '/NUMBER=' // FSEQ(JFSEQ:LEN(FSEQ))
- + // '/SIZE=' // CSIZE(JX:4)
- + // '/GENERIC='// MODEL
- + // '/LABEL='// VAXLAB(JL)
-*
-* Output STAGing only - add DCB information (also NL tapes)
-*
- IF((IMODE.NE.0).OR.(LABTYP(1:2).EQ.'NL')
- + .OR.(IOPTL.NE.0)) THEN
- IF(INDEX(RECFM,'F').NE.0) THEN
- COMAND = COMAND(1:LENOCC(COMAND)) // '/FIXED'
- ELSEIF(INDEX(RECFM,'V').NE.0) THEN
- COMAND = COMAND(1:LENOCC(COMAND)) // '/VARIABLE'
- ENDIF
- WRITE(CHRECL,'(I6.6)') LRECL
- WRITE(CHBLK, '(I6.6)') LBLOCK
- IF(LRECL.GT.0) COMAND = COMAND(1:LENOCC(COMAND)) //
- + '/RECORDSIZE='//CHRECL
- IF(LBLOCK.GT.0) COMAND = COMAND(1:LENOCC(COMAND)) //
- + '/BLOCKSIZE='//CHBLK
- ENDIF
-*
- LENCOM = LENOCC(COMAND)
-*
-* 'T' option - read directly from tape
-*
- IF(IOPTT.NE.0) THEN
- COMAND = COMAND(1:LENCOM) // '/DIRECT'
- LENCOM = LENCOM + 7
- ENDIF
-
- IF(IDEBFA.GE.0) PRINT *'FMMAKE. running ',COMAND(1:LENCOM)
-
- IRC = LIB$SPAWN(COMAND(1:LENCOM))
- IF (.NOT. IRC) CALL LIB$SIGNAL(%VAL(IRC))
-#endif
-#if (defined(CERNLIB_UNIX))&&(!defined(CERNLIB_CRAY))&&(!defined(CERNLIB_SHIFT))&&(!defined(CERNLIB_APOL3))
- PRINT *,'FMMAKE. Tape support is not available for this ',
- + 'system'
- IRC = 999
- RETURN
-#endif
-#if defined(CERNLIB_CRAY)||defined(CERNLIB_SHIFT)
-*
-* Set IQUEST(11) to media type in case volume unknown or
-* TMS option not installed.
-*
- IQUEST(11) = IQ(L+KOFUFA+MMTPFA)
-#endif
-#if (defined(CERNLIB_CRAY)||defined(CERNLIB_SHIFT)||defined(CERNLIB_APOL3))&&(!defined(CERNLIB_PREFIX))
- CALL FMQTMS(VID(1:LVID),LIB,MODEL,DENS,MNTTYP,LABTYP,IC)
-#endif
-#if (defined(CERNLIB_CRAY)||defined(CERNLIB_SHIFT)||defined(CERNLIB_APOL3))&&(defined(CERNLIB_PREFIX))
- CALL FMQTMS(XVID(1:LXVID),LIB,MODEL,DENS,MNTTYP,LABTYP,IC)
-#endif
-#if defined(CERNLIB_CRAY)||defined(CERNLIB_SHIFT)||defined(CERNLIB_APOL3)
- IF(IDEBFA.GE.3) THEN
- PRINT *,'FMMAKE. return from FMQTMS with ',
- + VID,'/',LIB,'/',MODEL,'/',DENS,'/',MNTTYP,'/',
- + LABTYP,'/',IC
- ENDIF
-
- IF(MODEL(1:4).EQ.'3480') THEN
- IF(MNTTYP.EQ.'R') THEN
- MODEL = 'SMCF'
- ELSE
- MODEL = 'CT1'
- ENDIF
- ENDIF
-
- IF(MODEL(1:4).EQ.'3420') MODEL = 'TAPE'
-*
-*
-* Believe density from TMS if tape is known
-*
- IF(IC.NE.0) CDEN = DENS
- CALL CUTOL(LABTYP)
- LLAB = LENOCC(LABTYP)
-
-#endif
-#if defined(CERNLIB_CRAY)||defined(CERNLIB_APOL3)
- FORLUN = 'fort. '
- IF(LUN.LT.10) THEN
- WRITE(FORLUN(6:6),'(I1)') LUN
- ELSE
- WRITE(FORLUN(6:7),'(I2)') LUN
- ENDIF
-
-#endif
-#if defined(CERNLIB_SHIFT)
- IF(LUN.LT.10) THEN
- WRITE(FORLUN,'(I1)') LUN
- ELSE
- WRITE(FORLUN,'(I2)') LUN
- ENDIF
-
-#endif
-#if defined(CERNLIB_CRAY)||defined(CERNLIB_SHIFT)
-
- WRITE(FSEQ,9003) IQ(L+KOFUFA+MFSQFA)
-
- IF (LUN .EQ. 0) FORLUN = CHLUN
-* "stagein fort.lun -v vsn -V vid -l sl|nl|al|blp
-* -g TAPE|CART|SMCF -d 6250|1600"
-#endif
-#if defined(CERNLIB_APOL3)
-*
-* Output staging on Apollo:
-* Use temporary file in current directory
-* or in directory specified by L3STAGE
-*
- CALL GETENVF('L3STAGE',L3PATH)
- IF(IS(1).EQ.0) THEN
- STGPTH = DSN(1:LDSN)
- ELSE
- STGPTH = L3PATH(1:IS(1)) // DSN(1:LDSN)
- LSTG = IS(1) + LDSN
- ENDIF
- LSTG = IS(1) + LDSN
- IF(IDEBFA.GE.0) PRINT *,'FMMAKE. stage out file is ',
- + STGPTH(1:LSTG)
- IC = SYSTEMF('ln -s '//STGPTH(1:LSTG)//' '
- + //FORLUN(1:LENOCC(FORLUN)))
- IF(IDEBFA.GE.2) WRITE(LPRTFA,*) 'Assign for logical unit ',
- + FORLUN(1:LENOCC(FORLUN)),' dsn = ',STGPTH(1:LSTG)
-#endif
-#if defined(CERNLIB_CRAY)
- COMAND = 'stagein '//FORLUN
-#endif
-#if defined(CERNLIB_SHIFT)
- COMAND = 'stagein -G -U '//FORLUN
-#endif
-#if defined(CERNLIB_CRAY)||defined(CERNLIB_SHIFT)
- + // ' -v '//VSN(1:LVSN)// ' -V '
- + //VID(1:LVID)//' -l '//LABTYP//' -g '//MODEL
- + // ' -q ' //FSEQ(JFSEQ:LEN(FSEQ))
-#endif
-#if defined(CERNLIB_SHIFT)
- + // ' -s ' //CSIZE // ' -u '//CHUSER
- + // ' -p shift1'
-#endif
-#if defined(CERNLIB_CRAY)
- + // ' -K -S sbin'
-#endif
-#if defined(CERNLIB_CRAY)||defined(CERNLIB_SHIFT)
-
- IF(IMODE.NE.0) COMAND(1:8) = 'stageout'
-#endif
-#if defined(CERNLIB_CRAY)||defined(CERNLIB_SHIFT)
- LENCOM = LENOCC(COMAND)
-#endif
-#if defined(CERNLIB_CRAY)||defined(CERNLIB_SHIFT)
-*
-* Add DSN if IOPTN not specified
-*
- IF(IOPTN.EQ.0) THEN
- COMAND = COMAND(1:LENCOM) // ' -f '//DSN(1:LDSN)
- LENCOM = LENOCC(COMAND)
- ENDIF
-
-#endif
-#if defined(CERNLIB_CRAY)||defined(CERNLIB_SHIFT)
-*
-* Option T - direct access to tapes
-*
- IF(IOPTT.NE.0) THEN
- COMAND(1:8) = 'setup '
-*
-* Option W - write access
-*
- IF(IOPTW.NE.0) THEN
- COMAND = COMAND(1:LENCOM) // '-r in'
- LENCOM = LENCOM + 5
- ENDIF
-
- ENDIF
-*
-* Add DCB information
-*
-* IF((IMODE.NE.0).OR.(IOPTL.NE.0)) THEN
- WRITE(DCB,8002) RECFM(1:1),LRECL,LBLOCK
-8002 FORMAT(' -F ',A1,' -L ',I5,' -b ',I5)
- COMAND = COMAND(1:LENOCC(COMAND)) // DCB
- LENCOM = LENOCC(COMAND)
-* ENDIF
-
-#endif
-#if defined(CERNLIB_CRAY)||defined(CERNLIB_SHIFT)
-
- CALL CSQMBL(COMAND,1,LENCOM)
- LENCOM = LENOCC(COMAND)
- IF(IDEBFA.GE.0) PRINT *,'FMMAKE. executing ',COMAND(1:LENCOM)
-#endif
-#if defined(CERNLIB_SHIFT)
- IC = SYSTEMF(COMAND(1:LENCOM))
- IF(IC.NE.0) THEN
- PRINT *,'FMMAKE. return code ',IC,' from stage command'
- RETURN
- ENDIF
-#endif
-#if defined(CERNLIB_CRAY)
- IC = SYSTEMF(COMAND(1:LENCOM))
-#endif
-
- ENDIF
-
-*
-* Record last access date and use count in bank send to server
-*
- CALL DATIME(ID,IT)
- CALL FMPKTM(ID,IT,IP,IRC)
- IQ(L+KOFUFA+MLATFA) = IP
- IF(IMODE.EQ.1) THEN
- IQ(L+KOFUFA+MUSCFA) = 1
- ELSE
- IQ(L+KOFUFA+MUSCFA) = IQ(L+KOFUFA+MUSCFA) + 1
- ENDIF
- IF((LUFZFA.GT.0).AND.(IMODE.EQ.0))THEN
- IF(IDEBFA.GE.0)
- + PRINT *,ROUTIN//'- updating last access date and use count'
- IF(IDEBFA.GE.3)
- + CALL FMSHOW(GENAME(1:NCH),L,KEYS,'A',IRC)
- CALL FMMOD(GENAME(1:NCH),L,0,IRC)
- IF((IRC.NE.0).AND.(IDEBFA.GE.0)) THEN
- PRINT *,ROUTIN//
- +'- error updating use count/last access date'
- PRINT *,'Return code from FMMOD = ',IRC
- ENDIF
- ENDIF
-
-
- END
diff --git a/src/packlib/fatmen/unref/fmmany.F b/src/packlib/fatmen/unref/fmmany.F
deleted file mode 100644
index ecfd56f..0000000
--- a/src/packlib/fatmen/unref/fmmany.F
+++ /dev/null
@@ -1,221 +0,0 @@
-*
-* $Id: fmmany.F,v 1.1.1.1 1996/03/07 15:18:24 mclareni Exp $
-*
-* $Log: fmmany.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:24 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMMANY(CHMTCH,CHFILE,NFILES,NMATCH,IRC)
-*
-* This routine performs wild card file name matching
-* a la VM/CMS (FILELIST/LISTFILE) and VAX/VMS (DIRECTORY)
-* Thus: % corresponds to a single arbitrary character,
-* * corresponds to n (n>=0) arbitrary characters
-* Numeric ranges are also supported, thus (9:12) will
-* match strings 09,10,11,12.
-*
-#include "fatmen/fatbank.inc"
-#include "fatmen/farnge.inc"
-*
- COMMON /SLATE/ NDSLAT,NESLAT, DUMMY(38)
- CHARACTER*(*) CHFILE(NFILES),CHMTCH
- CHARACTER*255 FILE,MATCH
- CHARACTER*10 CHLOW,CHHIGH,CHMAT,CHPASS,CHPLOW,CHPHI
- CHARACTER*5 WILD
- CHARACTER*27 HUNT
- DATA WILD/'%*(<>'/
- DATA HUNT/'ABCDEFGHIJKLMNOPQRSTUVWXYZ/'/
-
- NMATCH = 0
- CHPLOW = '9999999999'
- CHPHI = ' '
- DO 1 ILOOP=1,NFILES
- FILE = CHFILE(ILOOP)
- ILOW = 0
- IHIGH = 0
- ISTART = 0
- JSTART = 0
- IRC = 0
- IEND = LENOCC(CHMTCH)
- JEND = LENOCC(FILE)
- MATCH = CHMTCH(1:IEND)
- ISQ = INDEX(MATCH(1:IEND),'[')
-
-*
-* Convert [] to ()
-*
- CALL CTRANS('[','(',MATCH,1,IEND)
- CALL CTRANS(']',')',MATCH,1,IEND)
-*
-* Remove multiple *'s
-*
- NESLAT = IEND
- CALL CSQMCH(MATCH,'*',1,IEND)
- IF(NESLAT.LT.IEND) IEND = NESLAT
- IF(IDEBFA.GT.2) PRINT *,'FMMANY. Compare ',MATCH(1:IEND),
- + ' against ',FILE(1:JEND)
-*
-* Process all characters in FILE
-*
-10 CONTINUE
-*
-* Have reached the end of both match and file and all is ok
-*
- IF((ISTART.EQ.IEND).AND.(JSTART.EQ.JEND)) GOTO 1
- ISTART = ISTART + 1
- JSTART = JSTART + 1
-*
-* Have processed all characters in MATCH and all compare
-*
- IF(ISTART.GT.IEND) THEN
-*
-* but FILE is longer than MATCH...
-*
- IF(ISTART.LE.JEND) IRC = 1
- GOTO 1
- ENDIF
-*
-* Look down MATCH for a * or %
-*
- IX = ICFMUL(WILD,MATCH,ISTART,IEND)
-*
-* Match any characters up until first wild card
-*
- IF(IX.GT.ISTART) THEN
- LWORD = IX-ISTART-1
- IF(FILE(JSTART:JSTART+LWORD).NE.MATCH(ISTART:ISTART+LWORD))
- + GOTO 99
- ISTART = ISTART + LWORD
- JSTART = JSTART + LWORD
- GOTO 10
- ENDIF
-
- IF(MATCH(IX:IX).EQ.'*') THEN
-*
-* Current character is a *
-* Find first non-wild character in MATCH and find
-* in FILE.
-*
- IF(IX.EQ.IEND) GOTO 1
- DO 20 I=ISTART+1,IEND
- IF((MATCH(I:I).NE.'*').AND.(MATCH(I:I).NE.'%') .AND.
- + (MATCH(I:I).NE.'(')) GOTO 30
-20 CONTINUE
-*
-* MATCH only contains * followed by other wild-cards - ok
-*
- IF(IDEBFA.GT.2)
- + PRINT *,'FMMANY. Match pattern contains only wild-cards'
- GOTO 1
-30 CONTINUE
-*
-* Look for current word in FILE and reset JSTART
-* Word is delimited by two wild-chars or end of string.
-*
- IWILD = ICFMUL(WILD,MATCH,I,IEND)
- IF(IWILD.LE.IEND) THEN
- II = IWILD - 1
- ELSE
- II = IEND
- ENDIF
-* II = MIN(IEND,ICFMUL(WILD,MATCH,I,IEND))
- JFIND = INDEX(FILE(JSTART:JEND),MATCH(I:II))
- IF(JFIND.EQ.0) GOTO 99
- ISTART = I
- JSTART = JSTART+JFIND-1
- GOTO 10
-
- ELSEIF(MATCH(IX:IX).EQ.'%') THEN
-*
-* Current character is a <
-*
- ELSEIF((MATCH(IX:IX).EQ.'<').OR.(MATCH(IX:IX).EQ.'>')) THEN
-*
-* Current character is a < or >
-* Look for a /, an alphabetic character or the end of the string
-*
- IF(IDEBFA.GT.2)
- + PRINT *,'FMMANY. Found a < or > character'
- JX = ICFMUL(HUNT,FILE,JSTART,JEND)
- IF(JX.GT.JEND) JX = JEND
- CHPASS = FILE(JSTART:JX)
-
- IF(MATCH(IX:IX).EQ.'<') THEN
- IF(LLT(CHPASS,CHPLOW)) THEN
- CHPLOW = CHPASS
- NMATCH = ILOOP
- IF(ISQ.NE.0.AND.JELEM.NE.0)
- + IFELEM(JELEM,NLPAT) = IFILE
- ENDIF
-
- ELSE
-
- IF(LGT(CHPASS,CHPHI)) THEN
- CHPHI = CHPASS
- NMATCH = ILOOP
- IF(ISQ.NE.0.AND.JELEM.NE.0)
- + IFELEM(JELEM,NLPAT) = IFILE
- ENDIF
- ENDIF
-
- IF(IDEBFA.GT.2)
- + PRINT 9001,CHPASS, CHPLOW, CHPHI
-9001 FORMAT(' FMMANY. CHPASS, CHPLOW, CHPHI = ',3A20)
- JSTART = JX
- GOTO 10
-*
-* Current character is a %
-*
- ELSEIF(MATCH(IX:IX).EQ.'(') THEN
-*
-* Found a range delimiter
-*
- IF(IDEBFA.GT.2)
- + PRINT *,'FMMANY. range encountered in MATCH pattern'
- IBRA = INDEX(MATCH(IX:IEND),')')
- ICOL = INDEX(MATCH(IX:IEND),':')
- CHLOW = MATCH(IX+1:IX+ICOL-2)
- CHHIGH = MATCH(IX+ICOL:IX+IBRA-2)
- LNHIGH = LENOCC(CHHIGH)
- CALL CRIGHT(CHLOW,1,LNHIGH)
- CALL CTRANS(' ','0',CHLOW,1,LNHIGH)
- IF(IDEBFA.GT.2)
- + PRINT *,'FMMANY. range = ',CHLOW,' to ',CHHIGH
- CHMAT = FILE(JSTART:JSTART+LNHIGH-1)
- IF(IDEBFA.GT.2)
- + PRINT *,'FMMANY. match = ',CHMAT
- IF(ISQ.NE.0) THEN
- IELEM = ICDECI(CHMAT,1,LNHIGH)
- IF(IDEBFA.GE.3) PRINT *,'FMMANY. IELEM = ',IELEM
- IF(IELEM.NE.0) THEN
- JELEM = IUFIND(IELEM,IFRNGE(1,NLPAT),1,
- + NFRNGE(NLPAT))
- IF(JELEM.GT.NFRNGE(NLPAT)) JELEM = 0
- ELSE
- JELEM = 0
- ENDIF
- IF(IDEBFA.GE.3) PRINT *,'FMMANY. JELEM = ',JELEM
- ENDIF
- IF(LLT(CHMAT(1:LNHIGH),CHLOW(1:LNHIGH)) .OR.
- + LGT(CHMAT(1:LNHIGH),CHHIGH(1:LNHIGH))) GOTO 99
- ISTART = ISTART + IBRA - 1
- JSTART = JSTART + LNHIGH - 1
- GOTO 10
-
- ELSE
-*
-* Current character is a not a wild card
-*
- IF(FILE(JSTART:JSTART).NE.MATCH(ISTART:ISTART)) GOTO 99
-
- ENDIF
-
- GOTO 10
-
-99 CONTINUE
- IRC = 1
-1 CONTINUE
- END
-
diff --git a/src/packlib/fatmen/unref/fmopen.F b/src/packlib/fatmen/unref/fmopen.F
deleted file mode 100644
index b684989..0000000
--- a/src/packlib/fatmen/unref/fmopen.F
+++ /dev/null
@@ -1,2331 +0,0 @@
-*
-* $Id: fmopen.F,v 1.1.1.1 1996/03/07 15:18:24 mclareni Exp $
-*
-* $Log: fmopen.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:24 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMOPEN(GENAME,CHLUN,LENTRY,CHOPT,IRC)
-*
-#include "fatmen/fatbank.inc"
-#include "fatmen/fatpara.inc"
-#include "fatmen/tmsdef.inc"
-#include "fatmen/fatstg.inc"
-#include "fatmen/fattyp.inc"
-#include "fatmen/fatinfo.inc"
-#include "zebra/zmach.inc"
-#include "fatmen/fatvidp.inc"
-#include "fatmen/slate.inc"
-#include "fatmen/fabalq.inc"
- PARAMETER (MEGA=1024*1024)
- PARAMETER (LKEYFA=10)
-#if defined(CERNLIB_CERNVM)
- PARAMETER (MAXSTG=210)
-#endif
-#if !defined(CERNLIB_CERNVM)
- PARAMETER (MAXSTG=200)
-#endif
-#if defined(CERNLIB_IBMMVS)
- PARAMETER (MODEFT=1)
-#endif
- DIMENSION KEYS(LKEYFA)
-#if defined(CERNLIB_IBMVM)
- CHARACTER*16 CHSFS
- CHARACTER*80 CHGIME
-#endif
-#if defined(CERNLIB_SHIFT)
- CHARACTER*255 SHFNAM,SHUNAM
- CHARACTER*16 SHPOOL,SHUSER
-#endif
-#if defined(CERNLIB_VAXVMS)
- CHARACTER*8 CHSERV
- CHARACTER*255 EQUNAM
- CHARACTER*155 CHGRP,CHSTFL
-#endif
-#if defined(CERNLIB_IBMMVS)
-*
-* For tape files, a DD statement of the form
-* //FTnnFffff DD UNIT(=model,,DEFER),VOL=PRIVATE
-* is required.
-*
- DIMENSION HDISP(3),HVOL(2),HLAB(3),HDCB(4),HUNIT(2)
-#endif
-#if defined(CERNLIB_IBMMVS)
-#include "fatmen/fatdcb.inc"
-#endif
- CHARACTER*12 CHNREC,CHNRC2,CHRECL,CHBLF
- CHARACTER*9 CHACT
- CHARACTER*8 CHUSER
- CHARACTER*8 ROUTIN,STATE
- CHARACTER*12 FORMT
- CHARACTER*255 COMAND,SETUP,LABELDEF,FILEDEF,CHFILE,L3PATH,CWD
- CHARACTER*255 CHNFS,CHDSN
- CHARACTER*4 DEVTYP
- CHARACTER*6 VSN,VID,FSEQ
- CHARACTER*15 XVID
- CHARACTER*8 VIP
-* CHARACTER*2 LABEL
- CHARACTER*6 CHREC,CHBLK
- CHARACTER*6 VAXLAB(3)
- CHARACTER*2 IBMLAB(3)
- CHARACTER*(*) GENAME
- CHARACTER*8 HNAME,HTYPE,HSYS,HHOST
- CHARACTER*8 USER,ADDR
- CHARACTER*256 DSN
- CHARACTER*2 MODE
- CHARACTER*4 CFMODE
- CHARACTER*80 CHLINE
- CHARACTER*8 FORLUN
- INTEGER FMHOST,FMUSER,FMNODE
- CHARACTER*5 IOMODE
- CHARACTER*4 FFORM,FTEMP
- CHARACTER*(*) CHLUN
- CHARACTER*6 CDEN
- CHARACTER*4 CSIZE
- CHARACTER*4 FZOPT,RZOPT,SHOPT
- CHARACTER*20 STGOPT
- CHARACTER*1 VMOPT
- CHARACTER*40 DCB
- CHARACTER*20 FNAME
- CHARACTER*4 RECFM1
- CHARACTER*4 RECFM
- CHARACTER*8 RING
- CHARACTER*8 DDNAME
- CHARACTER*1 DEVNAM
- CHARACTER*3 DEVNUM
- CHARACTER*12 CHDIR
- LOGICAL IWAIT,ILINK,IEXIST,IVMIO,FPACK
- INTEGER SYSTEMF
-#if defined(CERNLIB_IBMVM)
- EXTERNAL FMVMIO
- CHARACTER*8 CHACC
- CHARACTER*2 CHUNIT
-#endif
-#if defined(CERNLIB_SHIFT)
- EXTERNAL FMFZIO
-#endif
-#if defined(CERNLIB_VAXVMS)
- EXTERNAL FMBALQ
-#endif
- DIMENSION LENTRY(1)
- DATA NENTRY/0/
- DATA IBMLAB(1)/'SL'/,IBMLAB(2)/'NL'/IBMLAB(3)/'AL'/
- DATA VAXLAB(1)/'EBCDIC'/,
- + VAXLAB(2)/'NONE '/,
- + VAXLAB(3)/'ASCII '/
-#if defined(CERNLIB_IBMMVS)
- DATA HDISP(2)/4HKEEP/,HDISP(3)/4HKEEP/
-#endif
-*
-* CHOPT: (lowercase = reserved but not implemented)
-* reserved: acm
-* free : bghijqy
-*
-* a - append
-* b - *free*
-* c - concatenate (for M)
-* D - make duplicate into robot
-* E - when used with T, issue SETUP END
-* F - issue FZFILE or FPARM as appropriate
-* g - *free*
-* h - *free*
-* i - *free*
-* j - *free*
-* K - KEEP option on STAGE OUT
-* L - override tape label information with DCB from catalogue
-* m - multi-file?
-* N - don't use DSN on STAGE
-* O - override size with IQUEST(11)
-* P - autoput on STAGE OUT
-* q - *free*
-* R - read
-* S - update catalogue with size returned from STAGE IN
-* T - use tape directly (i.e. not stage)
-* U - user will issue open
-* V - as S, but even if file size is non-zero
-* W - write
-* y - *free*
-* X - D/A
-* Z - issue RZFILE
-#include "fatmen/fatopts.inc"
- NCH = LENOCC(GENAME)
-#if defined(CERNLIB_IBMVM)
- CALL FMONIT('FMOPEN. '//GENAME(1:NCH)//' CHOPT '//CHOPT)
-#endif
- IF (LENTRY(1) .EQ. 0) THEN
- IF(IDEBFA.GE.1) WRITE(LPRTFA,9001) GENAME(1:NCH),CHOPT
- 9001 FORMAT(' FMOPEN. enter for ',A,1X,A)
- CALL FMGET(GENAME,LENTRY,KEYS,IRC)
- IF (IRC.NE.0) RETURN
- ELSE
- IF(IDEBFA.GE.1) WRITE(LPRTFA,9002) GENAME(1:NCH)
- 9002 FORMAT(' FMOPEN. enter for ',A,' using user supplied bank')
- ENDIF
- L = LENTRY(1)
-*
-* Set routine name
-*
- ROUTIN = 'FMOPEN. '
-*
-* FATMEN file format (for call to FZFILE,RZFILE)
-*
- CALL UHTOC(IQ(L+KOFUFA+MFLFFA),4,FFORM,4)
- ISIZE = 0
- ICFOP = 0
- IVMIO = .FALSE.
-*
-* Check options
-*
- CALL FMCHOP(ROUTIN,CHOPT,'CDEFKLMONPRSTUVWXZ',IC)
-
- IF((IOPTR.EQ.0).AND.(IOPTW.EQ.0)) IOPTR = 1
-
- IF(IOPTR.EQ.0.AND.IOPTW.NE.0) THEN
- CHACT = 'WRITE'
- LCHACT = 5
- ELSEIF(IOPTR.NE.0.AND.IOPTW.NE.0) THEN
- CHACT = 'READWRITE'
- LCHACT = 9
- ELSE
- CHACT = 'READ'
- LCHACT = 4
- ENDIF
-*
-* Take file size from IQUEST vector, if option O is specified
-*
- IF(IOPTO.NE.0) ISIZE = IQUEST(11)
-*
-* I/O options for FZ:
-* IQUEST(10) = 1 - Use C I/O in FZ
-* IQUEST(10) = 2 - Use FORTRAN D/A I/O
-* IQUEST(10) = 3 - Use 'package' I/O in FZ (e.g. IOPACK)
-*
- FPACK = .FALSE.
- IF(INDEX(FFORM,'FP').NE.0) FPACK = .TRUE.
-
- IF(IOPTF.NE.0.AND..NOT.FPACK) ICFOP = IQUEST(10)
- IF(ICFOP.EQ.2) IOPTX = 1
-
- IF((IOPTX.NE.0).AND.(IOPTT.NE.0)) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMOPEN. FORTRAN direct-access ',
- + 'not valid for tape files - ignored'
- IOPTX = 0
- ENDIF
-
- IF(ICFOP.EQ.1) THEN
- IF(IOPTU.NE.0) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMOPEN. user open not allowed',
- + ' for C I/O with Zebra FZ'
- ENDIF
- IOPTU = 0
- ENDIF
-*
-* Set mode (read/write)
-*
- IMODE = IOPTW
- IOMODE = '/IN '
- IF(IMODE.NE.0) IOMODE = '/OUT '
-
-*
-* CHLUN can have the following formats:
-*
-* nn
-* FTnnFlll
-* VMnnFlll
-* IOFILEnn
-* FORnnn
-* fort.nn
-* Other formats may be used with FPACK, for example BOSINPUT
-*
- LUN = 0
- LCHLUN = LENOCC(CHLUN)
-* Dirty trick to satisfy Unix machines
- IF (LCHLUN .EQ. 1) THEN
- READ(CHLUN,9003) LUN
- ELSEIF(LCHLUN .EQ. 2) THEN
- READ(CHLUN,9004) LUN
- ENDIF
- 9003 FORMAT(I1)
- 9004 FORMAT(I2)
-*
-* Get LUN from CHLUN (DDNAME) if necessary
-*
- IF(LUN.EQ.0.AND..NOT.FPACK) THEN
- CALL FMDD2L(CHLUN(1:LCHLUN),LUN,IRC)
- ENDIF
-
- IC = FMUSER(CHUSER)
-
-#if defined(CERNLIB_SETUP)
- IF((IOPTT.EQ.0).AND.(IDEBFA.GE.0).AND.(NENTRY.EQ.0))
- +PRINT *,ROUTIN//'Tape staging has been disabled at this location'
- NENTRY = 1
- IOPTT = 1
-#endif
-#if defined(CERNLIB_STAGE)
- IF((IOPTT.NE.0).AND.(IDEBFA.GE.0).AND.(NENTRY.EQ.0))
- +PRINT *,ROUTIN//'Tape staging is enforced at this location'
- NENTRY = 1
- IOPTT = 0
-#endif
- CALL CLTOU(GENAME)
- CALL UHTOC(IQ(L+KOFUFA+MFQNFA),4,DSN,NFQNFA)
- LDSN = LENOCC(DSN)
- LBLANK = INDEX(DSN,' ')
- IF(LBLANK.NE.0) LDSN = LBLANK - 1
-#if defined(CERNLIB_UNIX)
-*
-* If DSN starts with a $, assume that it is an environmental
-* variable.
-*
- IF(DSN(1:1).EQ.'$') THEN
- LENV = INDEX(DSN(1:LDSN),'/')
- CALL GETENVF(DSN(2:LENV-1),CHNFS)
- IF(IS(1).GT.0) THEN
- CHDSN = CHNFS(1:IS(1)) // DSN(LENV:LDSN)
- LDSN = LENOCC(CHDSN)
- DSN = CHDSN(1:LDSN)
- ELSE
- IF(IDEBFA.GE.-3) PRINT *,'FMOPEN. cannot translate ',
- + ' environmental variable ',DSN(1:LENV-1)
- ENDIF
- ENDIF
-#endif
-#if defined(CERNLIB_VAXVMS)
-*
-* If DSN starts with a $, assume that it is an environmental
-* variable.
-*
- IF(DSN(1:1).EQ.'$') THEN
- LENV = INDEX(DSN(1:LDSN),'/')
- CALL FMGTLG(DSN(2:LENV-1),CHNFS,'LNM$SYSTEM',IRC)
- LCHNFS = IS(1)
- IF(LCHNFS.GT.0) THEN
-*
-* If there is more than one slash in file name
-* assume that the intervening elements are directory names
-*
- JSLASH = INDEXB(DSN(1:LDSN),'/')
- IF(JSLASH.EQ.LENV) THEN
- CHNFS(LCHNFS+1:) = DSN(LENV+1:LDSN)
- LCHNFS = LCHNFS + LDSN - LENV
- ELSE
- CHNFS(LCHNFS+1:) = '[' // DSN(LENV+1:JSLASH-1)
- + // ']' // DSN(JSLASH+1:LDSN)
- LCHNFS = LCHNFS + LDSN - LENV + 1
- CALL CTRANS('/','.',CHNFS,1,LCHNFS)
- ENDIF
- DSN = CHNFS(1:LCHFNS)
- LDSN = LCHNFS
-
- ENDIF
- ENDIF
-#endif
-*
-* Get DCB information
-*
- CALL UHTOC(IQ(L+KOFUFA+MRFMFA),4,RECFM,4)
- LRECL = IQ(L+KOFUFA+MRLNFA)*4
- LBLOCK = IQ(L+KOFUFA+MBLNFA)*4
-#if defined(CERNLIB_IBMVM)
-*
-* Suppress user open for FX, FXN files
-*
- IF(ICFOP.EQ.2) THEN
- IVMIO = .TRUE.
- IF(IOPTU.NE.0) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMOPEN. user open not allowed',
- + ' for direct-access I/O with Zebra FZ'
- ENDIF
- IOPTU = 0
- ENDIF
-#endif
-*
-* New Zebra uses FORTRAN I/O as default...
-*
- LFORM = LENOCC(FFORM)
-#if !defined(CERNLIB_IBMVM)
- IF((FFORM(1:2).EQ.'FX').AND.(ICFOP.LE.1)) THEN
-#endif
-#if defined(CERNLIB_IBMVM)
- IF((FFORM(1:2).EQ.'FX').AND.(ICFOP.NE.1).AND.(ICFOP.NE.3)) THEN
-#endif
- FTEMP = FFORM
- FFORM = 'F'//FTEMP(1:LFORM)
- ENDIF
-
- IC = FMHOST(HNAME,HTYPE,HSYS)
- CALL UHTOC(IQ(L+KOFUFA+MHSNFA),4,HHOST,8)
- LHOST = LENOCC(HHOST)
-*
-* Find file and STAGE if necessary
-*
-#if defined(CERNLIB_FPACK)
-*=======================================================================
-* FPACK files : machine independant interface
-*=======================================================================
- IF(FPACK) THEN
-*
-* build comand string for FPACK interpreter
-* OPEN symbolic-name FILE=filename HOST=hostname [options...]
-* options: RECL, BLFACTOR, NREC, NREC2, ACTION, ACCESS,
-* STATUS, FORM, WORDFMT, RECSEP, NOOPEN
-*
-* ACCESS = sequential (FPT, FPS), direct (FPD), keyed (FPK),
-* ordered (FPO)
-* FORM = FPT = text, binary otherwise
-* NOOPEN = IOPTU
-* WORDFMT = MCPLFA
-* ACTION = IOPTR & IOPTW (modify not supported)
-* STATUS = OLD, unless action=write
-* NREC = number of records, primary allocation
-* NREC2 = number of records, secondary allocation
-* RECSEP = (not yet implemented)
-* RECL = MRLNFA*4
-* BLFACTOR = MBLNFA/MRLNFA
-*
- CHFILE = CHLUN
- COMAND = 'OPEN '//CHFILE(1:LCHLUN)//' FILE="'//DSN(1:LDSN)//'"'
- + //' HOST='//HHOST(1:LHOST)//' ACTION='
- + //CHACT(1:LCHACT)
- LCOM = LENOCC(COMAND)
-*
-* RECL BLFACTOR
-*
- IF(IQ(L+KOFUFA+MRLNFA).GT.0) THEN
- CALL FMITOC(IQ(L+KOFUFA+MRLNFA)*4,CHRECL,JS)
- COMAND(LCOM+1:LCOM+JS+6) = ' RECL='//CHRECL(1:JS)
- LCOM = LCOM + JS + 6
- IF(IQ(L+KOFUFA+MBLNFA).GT.0) THEN
- CALL FMITOC(IQ(L+KOFUFA+MBLNFA)/IQ(L+KOFUFA+MRLNFA),
- + CHBLF,JS)
- COMAND(LCOM+1:LCOM+JS+10) = ' BLFACTOR='//CHBLF(1:JS)
- LCOM = LCOM + JS + 10
- ENDIF
- ENDIF
-*
-* Status: NEW enforced for ACTION=WRITE
-*
- IF(IOPTW.NE.1.AND.IOPTR.EQ.0) THEN
- COMAND(LCOM+1:LCOM+11) = ' STATUS=NEW'
-*
-* Allocation
-*
- IF(IQUEST(12).GT.0) THEN
-*
-* Primary...
-*
- CALL FMITOC(IQUEST(12),CHNREC,JS)
- COMAND(LCOM+1:LCOM+JS+6) = ' NREC='//CHNREC(1:JS)
- LCOM = LCOM + JS + 6
- IF(IQUEST(13).GT.0) THEN
-*
-* Secondary...
-*
- CALL FMITOC(IQUEST(12),CHNREC,JS)
- COMAND(LCOM+1:LCOM+JS+7) = ' NREC2='//CHNRC2(1:JS)
- LCOM = LCOM + JS + 7
- ENDIF
- ENDIF
- ELSE
- COMAND(LCOM+1:LCOM+11) = ' STATUS=OLD'
- ENDIF
- LCOM = LCOM + 11
-*
-* Space: in case of new files, primary/secondary allocations
-* are taken from IQUEST(12-13), if non-zero
-*
-
- IF(IOPTU.NE.0) THEN
- COMAND(LCOM+1:LCOM+7) = ' NOOPEN'
- LCOM = LCOM + 7
- ENDIF
-*
-* WORDFMT...
-*
- IF(IQ(L+KOFUFA+MCPLFA).EQ.0) THEN
-*
-* 'local' i.e. native
-*
- COMAND(LCOM+1:LCOM+16) = ' WORDFMT=WFLOCAL'
- LCOM = LCOM + 16
-
- ELSEIF(IQ(L+KOFUFA+MCPLFA).EQ.1) THEN
-*
-* IEEE big endian
-*
- COMAND(LCOM+1:LCOM+15) = ' WORDFMT=WFIEEE'
- LCOM = LCOM + 15
-
- ELSEIF(IQ(L+KOFUFA+MCPLFA).EQ.2) THEN
-*
-* IBM
-*
- COMAND(LCOM+1:LCOM+14) = ' WORDFMT=WFIBM'
- LCOM = LCOM + 14
-
- ELSEIF(IQ(L+KOFUFA+MCPLFA).EQ.3) THEN
-*
-* VAX
-*
- COMAND(LCOM+1:LCOM+14) = ' WORDFMT=WFVAX'
- LCOM = LCOM + 14
-
- ELSEIF(IQ(L+KOFUFA+MCPLFA).EQ.4) THEN
-*
-* DECstation (IEEE little endian)
-*
- COMAND(LCOM+1:LCOM+14) = ' WORDFMT=WFDEC'
- LCOM = LCOM + 14
-
- ELSEIF(IQ(L+KOFUFA+MCPLFA).EQ.5) THEN
-*
-* CRAY
-*
- COMAND(LCOM+1:LCOM+15) = ' WORDFMT=WFCRAY'
- LCOM = LCOM + 15
-
- ENDIF
-
-*
-* FPACK FORM and ACCESS parameters...
-*
- IF(FFORM(1:3).EQ.'FPT') THEN
-*
-* text files
-*
- COMAND(LCOM+1:LCOM+28) = ' ACCESS=SEQUENTIAL FORM=TEXT'
- LCOM = LCOM + 28
-
- ELSEIF(FFORM(1:3).EQ.'FPS') THEN
-*
-* binary sequential files
-*
- COMAND(LCOM+1:LCOM+30) = ' ACCESS=SEQUENTIAL FORM=BINARY'
- LCOM = LCOM + 30
-
- ELSEIF(FFORM(1:3).EQ.'FPD') THEN
-*
-* binary direct access files
-*
- COMAND(LCOM+1:LCOM+26) = ' ACCESS=DIRECT FORM=BINARY'
- LCOM = LCOM + 26
-
- ELSEIF(FFORM(1:3).EQ.'FPK') THEN
-*
-* binary keyed access files
-*
- COMAND(LCOM+1:LCOM+25) = ' ACCESS=KEYED FORM=BINARY'
- LCOM = LCOM + 25
-
- ELSEIF(FFORM(1:3).EQ.'FPO') THEN
-*
-* binary ordered access files
-*
- COMAND(LCOM+1:LCOM+27) = ' ACCESS=ORDERED FORM=BINARY'
- LCOM = LCOM + 27
-
- ENDIF
-
- IF(IDEBFA.GE.0) PRINT *,'FMOPEN. call FPARM for ',
- + COMAND(1:LCOM)
- CALL FPARM(COMAND(1:LCOM))
- CALL FERMES(COMAND,1)
- IRC = LENOCC(COMAND)
- IF(IRC.NE.0.AND.IDEBFA.GE.-3) PRINT *,'FMOPEN. error ',
- + 'from FPARM = ',COMAND(1:IRC)
- RETURN
- ENDIF
-*=======================================================================
-* FPACK files : end
-*=======================================================================
-#endif
-*=======================================================================
-*
-* Disk files ...
-*
-*=======================================================================
- IF(IQ(L+KOFUFA+MMTPFA).EQ.1) THEN
-*
-* File is on disk. Check on Node etc. has been done in FMRZIN
-*
-#if defined(CERNLIB_IBMVM)
- COMAND = 'FILEDEF FTnnF001 DISK '
- DDNAME = 'FT00F001'
-
- IF((INDEX(FFORM,'FX').NE.0).AND.(IOPTX.NE.0)) THEN
- COMAND = 'FILEDEF VMnnF001 DISK '
- DDNAME = 'VM00F001'
- ENDIF
-
- WRITE(COMAND(17:18),9009) LUN
- WRITE(DDNAME(3:4),'(I2.2)') LUN
-
- IF(((FFORM(1:2).EQ.'FX').AND.(IOPTX.EQ.0))
- + .OR.(FFORM(1:2).EQ.'EP')) THEN
- COMAND = 'FILEDEF IOFILEnn DISK '
- WRITE(COMAND(21:22),9009) LUN
- DDNAME = 'IOFILE00'
- WRITE(DDNAME(7:8),'(I2.2)') LUN
- ENDIF
-
-* IF (LUN .EQ. 0) COMAND(15:22) = CHLUN
- IF(LCHLUN.GT.2) COMAND(15:22) = CHLUN
-*
-* Get disk name and link to it
-*
-
- LSTA = INDEX(DSN,'<')
- IF (LSTA .NE. 0) THEN
-*
-* Format of DSN is <user.address>filename.filetype on VM
-* address defaults to 191. If field <> missing, defaults to
-* current userid.
-*
-* Valid filenames:
-* FN.FT
-* <JAMIE>FN.FT
-* <JAMIE.191>FN.FT
-* SFS POOL:<JAMIE.A191>FN.FT
-*
- CALL CTRANS('[','<',DSN,1,LDSN)
- CALL CTRANS(']','>',DSN,1,LDSN)
- LDOT = INDEX(DSN,'.')
- LBRA = INDEX(DSN,'>')
-
- IF ((LDOT .NE. 0) .AND. (LDOT .LE. LBRA)) THEN
- LEND = LDOT
- ELSE
- LEND = LBRA
- ENDIF
-
- USER = DSN(LSTA+1:LEND-1)
- LUSR = LEND - LSTA - 1
- ADDR = ' '
-
- IF ((LDOT .NE. 0) .AND. (LDOT .LE. LBRA)) THEN
- ADDR= DSN(LDOT+1:LBRA-1)
- ENDIF
-
- LCHSFS = INDEX(DSN(1:LDSN),':')
- IF(LCHSFS.NE.0) THEN
- CHSFS = DSN(1:LCHSFS)
- IF(IDEBFA.GE.2) PRINT *,'FMOPEN. SFS pool = ',
- + CHSFS(1:LCHSFS)
- ENDIF
-
- IF(IOPTW.NE.0) THEN
- CHACC = ' ( MR ) '
- ELSE
- CHACC = ' ( RR ) '
- ENDIF
-*
-* Check if user name is numeric
-*
- IC = ICNUM(USER(1:LUSR),1,LUSR)
-
- IF(IC.GT.LUSR) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMOPEN. username is numeric.',
- + ' Cannot link to this userid using GIME'
- IF(IDEBFA.GE.0) PRINT *,'FMOPEN. executing ',
- + 'EXEC FATGIME '//USER(1:LUSR)//ADDR//CHACC
- CALL VMCMS('EXEC FATGIME '//USER(1:LUSR)//ADDR//
- + CHACC,IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.0)
- + PRINT *,ROUTIN//' return code from FATGIME = ',IRC
- RETURN
- ENDIF
-
- ELSE
-
- IF(LCHSFS.EQ.0) THEN
-
- CHGIME = 'EXEC GIME '//USER(1:LUSR)//ADDR//
- + '(QUIET NONOTICE STACK)'
- ELSE
- CHGIME = 'EXEC GIME '//
- + CHSFS(1:LCHSFS)//USER(1:LUSR)//'.'//ADDR//
- + '(QUIET NONOTICE STACK)'
- ENDIF
-
- CALL CSQMBL(CHGIME,1,80)
- LCHG = LENOCC(CHGIME)
-
- IF(IDEBFA.GE.0) PRINT *,'FMOPEN. executing ',
- + CHGIME(1:LCHG)
- CALL VMCMS(CHGIME(1:LCHG),IRC)
-
- IF(IRC.GT.4) THEN
- IF(IDEBFA.GE.0)
- + PRINT *,ROUTIN//' return code from GIME = ',IRC
- RETURN
- ENDIF
-
- ENDIF
-
- CALL VMRTRM(CHLINE,LENGTH)
- MODE = CHLINE(1:1)
-*
-* Use mode 4 for all CMS files, except RECFM F
-* N.B. files in CMS format V will be incorrectly handled!
-* To be read correctly, RECFM=U
-*
- IF (FFORM(1:2) .EQ. 'RZ') THEN
- MODE(2:2) = '6'
- ELSE
- MODE(2:2) = '4'
- ENDIF
-
- IF (RECFM(1:1) .EQ. 'U') MODE(2:2) = '1'
- IF(IDEBFA.GE.0) WRITE(LPRTFA,9005) ROUTIN,USER,ADDR,MODE
- 9005 FORMAT(1X,A8,'linked to ',A8,' address ',A3,' mode ',A4)
- ELSE
- MODE = '*'
- ENDIF
-
- LDOT = INDEXB(DSN,'.')
- DSN(LDOT:LDOT) = ' '
- COMAND = COMAND(1:30) // DSN(LBRA+1:LDSN) // ' ' // MODE
- LENCOM = LENOCC(COMAND)
-* F - issue FZFILE
-*
-* Don't add DCB if it is missing...
-*
- WRITE(DCB,9010) RECFM,LRECL,LBLOCK
- IF((LENOCC(RECFM).GT.0).AND.
- + (LRECL.NE.0.OR.LBLOCK.NE.0)) THEN
-* IF(IMODE.NE.0) THEN
- COMAND = COMAND(1:LENOCC(COMAND)) // ' ( ' // DCB
- ENDIF
-
- LENCOM = LENOCC(COMAND)
- IF(IDEBFA.GE.0)
- + PRINT *,ROUTIN//'running ',COMAND(1:LENCOM)
-
- CALL VMCMS(COMAND(1:LENCOM),IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMOPEN. return code ',IRC,
- + ' from FILEDEF'
- RETURN
- ENDIF
-
-#endif
-#if defined(CERNLIB_VAXVMS)
-*
-* Find disk with most space
-*
- IF(IMODE.NE.0) THEN
- CALL FMXDSK(DSN,IRC)
- LDSN = LENOCC(DSN)
- ENDIF
-*
-* Just assign the relevant logical name...
-*
- FORLUN = 'FOR00N'
- WRITE(FORLUN(4:6),9006) LUN
- 9006 FORMAT(I3)
- IF (FORLUN(4:4) .EQ. ' ') FORLUN(4:4) = '0'
- IF (FORLUN(5:5) .EQ. ' ') FORLUN(5:5) = '0'
- IF (LUN .EQ. 0) FORLUN = CHLUN
- IC = LIB$SET_LOGICAL(FORLUN(1:LENOCC(FORLUN)),
- + DSN(1:LDSN))
- IF (.NOT. IC) CALL LIB$SIGNAL(%VAL(IC))
- IF (IDEBFA .GE. 2) WRITE(LPRTFA,*) 'Assign ',DSN(1:LDSN),
- + FORLUN(1:LENOCC(FORLUN))
-#endif
-#if defined(CERNLIB_UNIX)
-*
-* Just issue the assign...
-*
- FORLUN = 'fort. '
- IF(LUN.LT.10) THEN
- WRITE(FORLUN(6:6),'(I1)') LUN
- ELSE
- WRITE(FORLUN(6:7),'(I2)') LUN
- ENDIF
-
- IF (LUN .EQ. 0) FORLUN = CHLUN
- LFLUN = LENOCC(FORLUN)
-*
-* Check if link already exists...
-*
- INQUIRE(FILE=FORLUN(1:LFLUN),EXIST=ILINK)
- IF(ILINK) THEN
- IF(IDEBFA.GE.0)
- + PRINT *,'FMOPEN. removing existing symbolic link...'
- IC = SYSTEMF('rm '//FORLUN(1:LFLUN))
- ENDIF
-#endif
-#if (defined(CERNLIB_UNIX))&&(!defined(CERNLIB_SHIFT))
- CALL CUTOL(DSN)
-#endif
-#if (defined(CERNLIB_UNIX))&&(!defined(CERNLIB_CRAY))&&(!defined(CERNLIB_SHIFT))&&(!defined(CERNLIB_APOLLO))
- IC = SYSTEMF('ln -s '//DSN(1:LDSN)//' '
- + //FORLUN(1:LFLUN))
- IF (IDEBFA .GE. 2) WRITE(LPRTFA,*) 'ln for logical unit ',
- + FORLUN(1:LFLUN),' dsn = ',DSN(1:LDSN)
-#endif
-#if defined(CERNLIB_APOLLO)
- IC = SYSTEMF('ln -s '//DSN(1:LDSN)//' '
- + //FORLUN(1:LFLUN))
- IF (IDEBFA .GE. 2) WRITE(LPRTFA,*) 'ln for logical unit ',
- + FORLUN(1:LFLUN),' dsn = ',DSN(1:LDSN)
-#endif
-#if (defined(CERNLIB_UNIX))&&(defined(CERNLIB_CRAY))
- IC = SYSTEMF('assign -a '//DSN(1:LDSN)//' '
- + //FORLUN(1:LFLUN))
- IF (IDEBFA .GE. 2) WRITE(LPRTFA,*) 'Assign for logical unit ',
- + FORLUN(1:LFLUN),' dsn = ',DSN(1:LDSN)
-#endif
-#if (defined(CERNLIB_UNIX))&&(defined(CERNLIB_SHIFT))
-*
-* Check if link already exists...
-*
- INQUIRE(FILE=FORLUN(1:LFLUN),EXIST=ILINK)
- IF(ILINK) THEN
- IF(IDEBFA.GE.0)
- + PRINT *,'FMOPEN. removing existing symbolic link...'
- IC = SYSTEMF('rm '//FORLUN(1:LFLUN))
- ENDIF
-
- IF(LUN.LT.10) THEN
- WRITE(FORLUN,'(I1)') LUN
- ELSE
- WRITE(FORLUN,'(I2)') LUN
- ENDIF
-
- LFLUN = LENOCC(FORLUN)
-
- CALL CTRANS('<','[',DSN,1,LDSN)
- CALL CTRANS('>',']',DSN,1,LDSN)
- ILSQB = INDEX(DSN(1:LDSN),'[')
- IRSQB = INDEX(DSN(1:LDSN),']')
-
- IF(ILSQB.NE.0) THEN
-
- IF(IDEBFA.GE.0) PRINT *,'FMOPEN. SHIFT POOL file...'
-
- IDOT = INDEX(DSN(1:IRSQB),'.')
- SHPOOL = DSN(2:IDOT-1)
- SHUSER = DSN(IDOT+1:IRSQB-1)
- ISTART = IRSQB+1
- IEND = LDSN
- IF (IDEBFA.GE.0) WRITE(LPRTFA,*) 'Assign for logical unit ',
- + FORLUN(1:LFLUN),' pool = ',SHPOOL,
- + ' user = ',SHUSER,' dsn = ',DSN(ISTART:IEND)
-*
-* Get temporary file name
-*
- 10 CONTINUE
- CALL FMFNME(SHUNAM)
- LUNAM = LENOCC(SHUNAM)
- INQUIRE(FILE=SHUNAM(1:LUNAM),EXIST=IEXIST)
- IF(IEXIST) THEN
- IC = SLEEPF(1)
- GO TO 10
- ENDIF
-*
-* Issue SFGET to obtain full shift pathname
-*
- IF(IMODE.EQ.0) THEN
-
- IRC = SYSTEMF('sfget -k -p '//SHPOOL//
- + ' -u '//SHUSER//' '//DSN(ISTART:IEND)//' > '
- + //SHUNAM(1:LUNAM))
-
-* IRC = SYSTEMF('assign ` sfget -k -p '//SHPOOL//
-* + ' -u '//SHUSER// ' '//DSN(ISTART:IEND)//' `
-* + '//FORLUN(1:LFLUN)//' ')
- ELSE
-
- IRC = SYSTEMF('sfget -p '//SHPOOL//
- + ' -u '//SHUSER//' '//DSN(ISTART:IEND)//' > '
- + //SHUNAM(1:LUNAM))
-
-* IRC = SYSTEMF('assign ` sfget -p '//SHPOOL//
-* + ' -u '//SHUSER// ' '//DSN(ISTART:IEND)//' `
-* + '//FORLUN(1:LFLUN)//' ')
- ENDIF
- IF(IRC.NE.0) THEN
- PRINT *,'FMOPEN. return code ',IRC,' from SFGET'
- RETURN
- ENDIF
-*
-* Now check if sfget was successful...
-*
- CALL CFOPEN(LUNPTR,0,0,'r',0,
- + SHUNAM(1:LUNAM),IRC)
- NWREC = LEN(SHFNAM)/4
- NWTAK = NWREC
- SHFNAM = ' '
- CALL CFGET(LUNPTR,0,NWREC,NWTAK,SHFNAM,IRC)
- CALL CFCLOS(LUNPTR,0)
- LFNAM = LENOCC(SHFNAM)
- IF(INDEX(SHFNAM,'/shift').NE.1) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMOPEN. error from ',
- + 'sfget - ',SHFNAM(1:LFNAM)
- IRC = -1
- RETURN
-*
-* Delete temporary file only if sfget worked
-*
- ELSE
- IRC = SYSTEMF('rm '//SHUNAM(1:LUNAM))
- ENDIF
-*
-* Perform assign
-*
- IRC = SYSTEMF('assign '//SHFNAM(1:LSHF)//' '
- + //FORLUN(1:LFLUN)//' ')
-
- ELSE
-
- IF(IDEBFA.GE.0) PRINT *,'FMOPEN. SHIFT private file...'
- IF (IDEBFA.GE.0) WRITE(LPRTFA,*) 'Assign for logical unit ',
- + FORLUN(1:LFLUN),' dsn = ',DSN(1:LDSN)
- IC = SYSTEMF('assign '//DSN(1:LDSN)//' '//
- + FORLUN(1:LFLUN))
- SHFNAM = DSN(1:LDSN)
- LFNAM = LDSN
- IF(IC.NE.0) THEN
- PRINT *,'FMOPEN. return code ',IC,' from SFGET'
- RETURN
- ENDIF
- ENDIF
-
-#endif
-*=======================================================================
-*
-* Tape files ...
-*
-*=======================================================================
- ELSEIF(IQ(L+KOFUFA+MMTPFA).GT.1) THEN
-
- CDEN = CHMDEN(IQ(L+KOFUFA+MMTPFA))
-*
-* "EXEC STAGE IN ddname vsn.fseq.label.vid" (IBM)
-* "STAGE/IN vsn vid /NAME=/NUMB=/GENERIC=/LABEL= ddname" (VAX)
-* "stagein fort.lun -v vsn -V vid -l sl|nl|al|blp
-* -g TAPE|CART|SMCF -d 6250|1600" (CRAY)
-* "stagein -U unit -v vsn -V vid -l sl|nl|al|blp
-* -g TAPE|CART|SMCF -d 6250|1600" (SHIFT)
-*
- CALL UHTOC(IQ(L+KOFUFA+MVSNFA),4,VSN,6)
- LVSN = LENOCC(VSN)
- CALL CLTOU(VSN)
- CALL UHTOC(IQ(L+KOFUFA+MVIDFA),4,VID,6)
- LVID = LENOCC(VID)
- CALL CLTOU(VID)
-*
-* Generate eXtended VID - with VID prefix
-*
- JP = IQ(L+KOFUFA+MVIPFA)
- IF(JP.NE.0) THEN
- LVIP = LENOCC(PREVID(JP))
- VIP = PREVID(JP)(1:LVIP)
- XVID = PREVID(JP)(1:LENOCC(PREVID(JP)))
- + // '.' // VID(1:LVID)
- LXVID = LENOCC(XVID)
-
- ELSE
- XVID = VID
- LXVID = LVID
- LVIP = 0
- ENDIF
-
-
- WRITE(FSEQ,9007) IQ(L+KOFUFA+MFSQFA)
- 9007 FORMAT(I6)
-
- JFSEQ = INDEXB(FSEQ,' ') + 1
-*
-* File size, if zero take default size for current medium
-*
- IF(IOPTO.EQ.0) ISIZE = IQ(L+KOFUFA+MFSZFA)
- IF(ISIZE.NE.0) THEN
- IF(ISIZE.GT.MAXSTG) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMOPEN. Warning - ',
- + 'staging disks are limited to ',MAXSTG,
- + ' MB on this system'
- ENDIF
-#if defined(CERNLIB_IBMVM)
-*
-* May need slightly more space on disk, due to VBS format!
-*
- IFUDGE = MAX(2,ISIZE/15)
-#endif
-#if !defined(CERNLIB_IBMVM)
- IFUDGE = 0
-#endif
- WRITE(CSIZE,9008) MIN(ISIZE+IFUDGE,MAXSTG,
- + MEDSIZ(IQ(L+KOFUFA+MMTPFA)))
- ELSE
- WRITE(CSIZE,9008) MIN(MEDSIZ(IQ(L+KOFUFA+MMTPFA)),MAXSTG)
- ENDIF
- 9008 FORMAT(I4)
-
- IF(CHLUN(1:LCHLUN) .EQ. 'NOWAIT') THEN
- STGOPT = 'NOWAIT'
- IWAIT = .FALSE.
- ELSE
- STGOPT = 'WAIT'
- IWAIT = .TRUE.
- ENDIF
-
-#if defined(CERNLIB_IBMMVS)
-*=======================================================================
-* I B M M V S
-*=======================================================================
-*
-* Build arguments for call to FTDD...
-*
-*
- CALL UCTOH(DSN(1:LDSN)//' ',HDSN(1),4,LDSN+1)
-*
-* Check if file is catalogued
-*
- INQUIRE(FILE='/'//DSN(1:LDSN),EXIST=IEXIST)
- IF(.NOT.IEXIST) THEN
-*
-* Get media details
-*
- CALL FMQVOL(GENAME(1:NCH),L,KEYS,
- + LIB,MODEL,DENS,MNTTYP,LABTYP,IC)
- CALL UHTOC(IQ(L+KOFUFA+MVSNFA),4,VSN,6)
- LVSN = LENOCC(VSN)
- CALL CLTOU(VSN)
-
- IF(IDEBFA.GE.3) THEN
- PRINT *,'FMOPEN. return from FMQVOL with ',
- + LIB,'/',MODEL,'/',DENS,'/',MNTTYP,'/',
- + LABTYP,'/',IC
- ENDIF
- LLAB = LENOCC(LABTYP)
- LMOD = LENOCC(MODEL)
- CALL UCTOH('NEW ',HDISP(1),4,4)
- CALL UCTOH(VSN(1:LVSN),HVOL,4,LVSN)
- CALL UCTOH(MODEL,HUNIT(1),4,LMOD)
- HLAB(1) = IQ(L+KOFUFA+MFSQFA)
- CALL UCTOH(LABTYP,HLAB(2),4,LLAB)
- IF(IOPTW.NE.0) THEN
- CALL UCTOH('OUT ',HLAB(3),4,4)
- ELSE
- CALL UCTOH('IN ',HLAB(3),4,4)
- ENDIF
- HDCB(2) = IQ(L+KOFUFA+MRLNFA)*4
- HDCB(3) = IQ(L+KOFUFA+MBLNFA)*4
- HDCB(4) = MEDDEN(IQ(L+KOFUFA+MMTPFA))
- CALL FTDD(LUN,MODEFT,HDSN,HDISP,HVOL,HLAB,HDCB,HUNIT,IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMOPEN. return code ',IRC,
- + ' from FTDD'
- RETURN
- ENDIF
- ELSE
-*
-* Just set DISP=OLD
-*
- CALL UCTOH('OLD ',HDISP(1),4,4)
- CALL FTDD(LUN,MODEFT,HDSN,HDISP,IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMOPEN. return code ',IRC,
- + ' from FTDD'
- RETURN
- ENDIF
- ENDIF
-*=======================================================================
-* end I B M M V S
-*=======================================================================
-#endif
-#if (defined(CERNLIB_IBMVM))&&(defined(CERNLIB_NEEDFILE))
-*
-* Interface to FNAL NEEDFILE exec
-*
- CALL FMQTMS(VID(1:LVID),LIB,MODEL,DENS,MNTTYP,LABTYP,IC)
- IF(IDEBFA.GE.3) THEN
- PRINT *,'FMOPEN. return from FMQTMS with ',
- + VID,'/',LIB,'/',MODEL,'/',DENS,'/',MNTTYP,'/',
- + LABTYP,'/',IC
- ENDIF
-*
- IF(CHLUN(1:LCHLUN) .EQ. 'NOWAIT') THEN
- STGOPT = 'NOREPLY'
- IWAIT = .FALSE.
- ELSE
- STGOPT = 'WAIT'
- IWAIT = .TRUE.
- WRITE(CHUNIT,'(I2.2)') LUN
- ENDIF
-
- COMAND = 'EXEC NEEDFILE '//VSN(1:LVSN) //
- + ' ( UNIT '//CHUNIT//' '//MODEL//' '//STGOPT
-#endif
-#if (defined(CERNLIB_IBMVM))&&(!defined(CERNLIB_NEEDFILE))
-C======================== Modified by C. Onions =================
- IF(((FFORM(1:2).EQ.'FX').AND.(IOPTX.EQ.0))
- + .OR.(FFORM(1:2).EQ.'EP')) THEN
- COMAND = 'EXEC STAGE IN IOFILEnn '
- WRITE(COMAND(21:22),9009) LUN
- ELSEIF((FFORM(1:2).EQ.'FX').AND.(IOPTX.NE.0))THEN
- COMAND = 'EXEC STAGE IN VMnnF001 '
- WRITE(COMAND(17:18),9009) LUN
- 9009 FORMAT(I2.2)
- ELSE
- COMAND = 'EXEC STAGE IN FTnnF001 '
- WRITE(COMAND(17:18),9009) LUN
- ENDIF
-
- IF(LCHLUN.GT.2) COMAND(15:22) = CHLUN
-* IF (LUN .EQ. 0) COMAND(15:22) = CHLUN
-*
-* Output staging?
-*
- IF (IMODE .NE. 0) COMAND(12:13) = 'OU'
-C======================== End of C. Onions modification =========
- IF(.NOT.IWAIT) COMAND(15:22) = 'FT00F001'
-*
-* Set IQUEST(11) to media type in case volume unknown or
-* TMS option not installed.
-*
- IQUEST(11) = IQ(L+KOFUFA+MMTPFA)
-#endif
-#if (!defined(CERNLIB_PREFIX))&&(defined(CERNLIB_IBMVM))
- CALL FMQTMS(VID(1:LVID),LIB,MODEL,DENS,MNTTYP,LABTYP,IC)
-#endif
-#if (defined(CERNLIB_PREFIX))&&(defined(CERNLIB_IBMVM))
- CALL FMQTMS(XVID(1:LXVID),LIB,MODEL,DENS,MNTTYP,LABTYP,IC)
-#endif
-#if defined(CERNLIB_IBMVM)
- IF(IDEBFA.GE.3) THEN
- PRINT *,'FMOPEN. return from FMQTMS with ',
- + VID,'/',LIB,'/',MODEL,'/',DENS,'/',MNTTYP,'/',
- + LABTYP,'/',IC
- ENDIF
-*
-* Believe density from TMS if tape is known
-*
- IF(IC.EQ.0) CDEN = DENS
- CALL CLTOU(LABTYP)
- LLAB = LENOCC(LABTYP)
- IF(IMODE.EQ.1) STGOPT = 'AUTOPUT DELAY'
- COMAND = COMAND(1:25) // VSN(1:LVSN) // '.'
- + // FSEQ(JFSEQ:LEN(FSEQ))
- + // '.' // LABTYP(1:LLAB) // '.' // VID(1:LVID)
-
-#endif
-#if (defined(CERNLIB_PREFIX))&&(defined(CERNLIB_IBMVM))
- IF(LVIP.NE.0) COMAND = COMAND(1:LENOCC(COMAND))
- + // '.' // VIP(1:LVIP)
-#endif
-#if defined(CERNLIB_IBMVM)
- COMAND = COMAND(1:LENOCC(COMAND))
- + // ' (' //STGOPT//' SIZE '//CSIZE // ' DEN '//CDEN
-*
-* Specify dataset name only if option N not specified
-*
- IF((LDSN.NE.0) .AND. (IOPTN.EQ.0))
- + COMAND = COMAND(1:LENOCC(COMAND)) // ' DSN ' //DSN(1:LDSN)
-
- COMAND = COMAND(1:LENOCC(COMAND)) // ' DEVTYPE '//MODEL
-*
-* Output STAGing only - add DCB information (also NL tapes)
-*
- IF((IMODE.NE.0).OR.(LABTYP(1:2).EQ.'NL')
- + .OR.(IOPTL.NE.0)) THEN
- WRITE(DCB,9010) RECFM,LRECL,LBLOCK
- 9010 FORMAT(' RECFM ',A4,' LRECL ',I5,' BLOCK ',I5)
- COMAND = COMAND(1:LENOCC(COMAND)) // DCB
- ENDIF
-*
-* Output STAGing only - options Keep, autoPut
-*
- IF((IMODE.NE.0).AND.(IOPTK.NE.0)) THEN
- COMAND = COMAND(1:LENOCC(COMAND)) // ' KEEP'
- ENDIF
-
- IF((IMODE.NE.0).AND.(IOPTP.NE.0)) THEN
- COMAND = COMAND(1:LENOCC(COMAND)) // ' AUTOPUT'
- ENDIF
-
- LENCOM = LENOCC(COMAND)
-
- IF(IOPTT.EQ.0) THEN
-*
-* Use STAGE
-*
- 20 CONTINUE
- IF(IDEBFA.GE.0) PRINT *,ROUTIN//'running ',COMAND(1:LENCOM)
-
- CALL VMCMS(COMAND(1:LENCOM),IRC)
-*
-* NOWAIT specified - just return
-*
- IF(.NOT.IWAIT) RETURN
-
- IF(IRC.EQ.0) THEN
-*
-* If option S specified and file size currently zero OR
-* option V AND
-* read mode and data base opened for write...
-*
- IF(((IOPTS.NE.0.AND.IQ(L+KOFUFA+MFSZFA).EQ.0).OR.IOPTV.NE.0)
- + .AND.(LUFZFA.GT.0.AND.IMODE.EQ.0)) THEN
-*
-* Build STAGE Query command
-*
- COMAND = 'EXEC STAGE QUERY ' // VSN(1:LVSN) // '.'
- + // FSEQ(JFSEQ:LEN(FSEQ))
- + // '.' // LABTYP(1:LLAB) // '.' // VID(1:LVID)
- + // ' (LIFO'
- LC = LENOCC(COMAND)
- IF(IDEBFA.GE.2) PRINT *,'FMOPEN. running ',
- + COMAND(1:LC)
- CALL VMCMS(COMAND(1:LC),IRC)
-*
-* Get answer and extract file size
-*
- CALL VMRTRM(CHLINE,LENGTH)
- ISLASH = INDEX(CHLINE,'/')
- IDOT = INDEXB(CHLINE(1:ISLASH),'.')
- IBLANK = INDEXB(CHLINE(1:IDOT),' ')
- READ(CHLINE(IBLANK+1:IDOT-1),*) ISIZE
-*
-* Add 1 MB to file size as we ignore the fraction...
-*
- ISIZE = ISIZE + 1
-
- IF(IOPTV.NE.0.AND.
- + IABS(IQ(L+KOFUFA+MFSZFA)-ISIZE).GT.1) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMOPEN. file size in catalogue ',
- + '(',IQ(L+KOFUFA+MFSZFA),
- + ') disagress with that returned by VMSTAGE (',ISIZE,')'
- ENDIF
-
- IQ(L+KOFUFA+MFSZFA) = ISIZE
-
- IF(IDEBFA.GE.0) THEN
- PRINT *,ROUTIN//'- updating file size from STAGE information'
- PRINT *,ROUTIN//CHLINE(1:LENGTH)
- ENDIF
- ENDIF
-*
-* Option D - make a duplicate copy into the robot
-*
- IF((IOPTD.NE.0).AND.(IMODE.EQ.0)) THEN
- CALL FMSMCF(GENAME,L,IC)
- IF(IC.NE.0) THEN
- PRINT *,'FMOPEN - return code ',
- + IC,' from FMSMCF'
- ENDIF
-
- ENDIF
-
- ELSEIF(IRC.EQ.400) THEN
-*
-* STAGE failed - cannot allocate disk size of size requested
-*
- READ(CSIZE,9008) ISIZE
- IF(ISIZE.LT.MEDSIZ(IQ(L+KOFUFA+MMTPFA))) THEN
- IF(IDEBFA.GE.0)
- + PRINT *,ROUTIN//' unable to allocate staging disk for',
- + ' size ',CSIZE,' - will try larger disk'
-*
-* Increase size by MAX of file size in FATMEN catalogue and 20MB
-* up to maximum size for this media type
-*
- ISIZE = MIN(ISIZE +
- + MAX(20,IQ(L+KOFUFA+MFSZFA)),
- + MAXSTG,
- + MEDSIZ(IQ(L+KOFUFA+MMTPFA)))
- WRITE(CSIZE,9008) ISIZE
- ISTART = INDEX(COMAND,'SIZE ') + 5
- COMAND(ISTART:ISTART+3) = CSIZE
- GOTO 20
- ELSE
- IF(IDEBFA.GE.0)
- + PRINT *,ROUTIN//' return code from STAGE = ',IRC
- RETURN
- ENDIF
-
- ELSEIF(IRC.GE.20) THEN
-
- IF(IDEBFA.GE.0)
- + PRINT *,ROUTIN//' return code from STAGE = ',IRC
- RETURN
-
- ENDIF
-
- ELSE
-*
-* Use SETUP
-*
- IF(IOPTW.EQ.0) THEN
- RING = ' NORING '
- ELSE
- RING = ' RING '
- ENDIF
-
- CALL FMWORD(DDNAME,3,' ',COMAND,IRC)
- LDD = LENOCC(DDNAME)
- IF(LDD.LE.2) THEN
- READ(DDNAME(1:LDD),*) LUN
- DDNAME = 'FT00F001'
- WRITE(DDNAME(3:4),9009) LUN
- ENDIF
-*
-* Find first free tape drive
-*
- ITAPE = IUCOMP(0,IDEV,16)
- IF(ITAPE.EQ.17) THEN
- IF(IDEBFA.GE.-2) PRINT *,ROUTIN
- + //' no free virtual address for tape unit'
- IRC = 1
- RETURN
- ENDIF
-
- ITEMP = 179 + ITAPE
- IF(ITAPE.GT.8) ITEMP = 277 + ITAPE
- WRITE(DEVNUM,'(I3)') ITEMP
- WRITE(DEVNAM,'(Z1)') ITAPE-1
-
-#endif
-#if (defined(CERNLIB_IBMVM))&&(defined(CERNLIB_HEPVM))
- SETUP = 'SETUP '//MODEL//' '//DEVNUM//' '
- + //VSN(1:LVSN)//' VID '//XVID//' '
- + //LABTYP//CDEN//RING
-
- IF(IOPTE.NE.0) THEN
- LENS = LENOCC(SETUP)
- SETUP = SETUP(1:LENS)//' (END'
- ENDIF
-
- LENS = LENOCC(SETUP)
- IF(IDEBFA.GE.0) PRINT *,ROUTIN//'running ',SETUP(1:LENS)
- CALL VMCMS(SETUP(1:LENS),IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.0) PRINT *,ROUTIN//'return code ',IRC,
- + ' from SETUP'
- RETURN
- ENDIF
-#endif
-#if (defined(CERNLIB_IBMVM))&&(defined(CERNLIB_VMTAPE))
-
- IF(IOPTW.EQ.0) THEN
- RING = ' READ '
- ELSE
- RING = ' WRITE '
- ENDIF
-
- SETUP = 'VMTAPE MOUNT '//VSN(1:LVSN)//DEVNAM
- + //' DSN ? (DEN '//CDEN//' LABEL '//LABTYP
- + //RING//' WAIT UNIT '//MODEL
- LENS = LENOCC(SETUP)
- IF(IDEBFA.GE.0) PRINT *,ROUTIN//'running ',SETUP(1:LENS)
- CALL VMCMS(SETUP(1:LENS),IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.0) PRINT *,ROUTIN//'return code ',IRC,
- + ' from VMTAPE'
- RETURN
- ENDIF
- CALL VMSTAK(DSN(1:LDSN),'L',IRC)
-#endif
-#if defined(CERNLIB_IBMVM)
-
- FILEDEF = 'FILEDEF '//DDNAME//' TAP'
- + //DEVNAM//' '//LABTYP//' (DEN '//CDEN
- LENF = LENOCC(FILEDEF)
-
- IF(IOPTW.NE.0) THEN
- FILEDEF = FILEDEF(1:LENF) // DCB
- LENF = LENOCC(FILEDEF)
- ENDIF
-
- IF(IDEBFA.GE.0) PRINT *,ROUTIN//'running ',FILEDEF(1:LENF)
- CALL VMCMS(FILEDEF(1:LENF),IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMOPEN. return code ',IRC,
- + ' from FILEDEF'
- RETURN
- ENDIF
-
- IF((LDSN.GT.0).AND.(IOPTN.EQ.0)) THEN
- LABELDEF = 'LABELDEF '//DDNAME//' FID ?'
- LENL = LENOCC(LABELDEF)
-
- IF(IDEBFA.GE.0)
- + PRINT *,ROUTIN//'running ',LABELDEF(1:LENL)
-*
-* Put DSN on program STACK for LABELDEF
-*
- IF(IDEBFA.GE.0)
- + PRINT *,ROUTIN//'DSN is ',DSN(1:LDSN)
- CALL VMSTAK(DSN(1:LDSN),'L',IRC)
- CALL VMCMS(LABELDEF(1:LENL),IRC)
-
- ENDIF
-
- ENDIF
-
-#endif
-#if defined(CERNLIB_VAXVMS)
-*
-* Build the relevant logical name for STAGE
-*
- FORLUN = 'FOR00N'
- WRITE(FORLUN(4:6),9006) LUN
- IF (FORLUN(4:4) .EQ. ' ') FORLUN(4:4) = '0'
- IF (FORLUN(5:5) .EQ. ' ') FORLUN(5:5) = '0'
- IF (LUN .EQ. 0) FORLUN = CHLUN
- LFLUN = LENOCC(FORLUN)
-
- JX = ICFNBL(CSIZE,1,4)
-*
-* Set IQUEST(11) to media type in case volume unknown or
-* TMS option not installed.
-*
- IQUEST(11) = IQ(L+KOFUFA+MMTPFA)
-#endif
-#if (defined(CERNLIB_VAXVMS))&&(!defined(CERNLIB_PREFIX))
- CALL FMQTMS(VID(1:LVID),LIB,MODEL,DENS,MNTTYP,LABTYP,IC)
-#endif
-#if (defined(CERNLIB_VAXVMS))&&(defined(CERNLIB_PREFIX))
- CALL FMQTMS(XVID(1:LXVID),LIB,MODEL,DENS,MNTTYP,LABTYP,IC)
-#endif
-#if defined(CERNLIB_VAXVMS)
- IF(IDEBFA.GE.3) THEN
- PRINT *,'FMOPEN. return from FMQTMS with ',
- + VID,'/',LIB,'/',MODEL,'/',DENS,'/',MNTTYP,'/',
- + LABTYP,'/',IC
- ENDIF
-
-*
-* Translate IBM to VAX labels (SL->EBCDIC etc.)
-*
- JL = ICNTH(LABTYP,IBMLAB,3)
- COMAND = '$STAGE ' // VSN(1:LVSN) // ' ' // VID(1:LVID) // ' '
- + // FORLUN(1:LFLUN) // IOMODE
- + // '/NAME=' // DSN(1:LDSN)
- + // '/NUMBER=' // FSEQ(JFSEQ:LEN(FSEQ))
- + // '/SIZE=' // CSIZE(JX:4)
- + // '/GENERIC='// MODEL
- + // '/LABEL='// VAXLAB(JL)
-*
-* Output STAGing only - add DCB information (also NL tapes)
-*
- IF((IMODE.NE.0).OR.(LABTYP(1:2).EQ.'NL')
- + .OR.(IOPTL.NE.0)) THEN
- IF(INDEX(RECFM,'F').NE.0) THEN
- COMAND = COMAND(1:LENOCC(COMAND)) // '/FIXED'
- ELSEIF(INDEX(RECFM,'V').NE.0) THEN
- COMAND = COMAND(1:LENOCC(COMAND)) // '/VARIABLE'
- ENDIF
- WRITE(CHREC,'(I6.6)') LRECL
- WRITE(CHBLK, '(I6.6)') LBLOCK
- IF(LRECL.GT.0) COMAND = COMAND(1:LENOCC(COMAND)) //
- + '/RECORDSIZE='//CHREC
- IF(LBLOCK.GT.0) COMAND = COMAND(1:LENOCC(COMAND)) //
- + '/BLOCKSIZE='//CHBLK
- ENDIF
-*
- LENCOM = LENOCC(COMAND)
-*
-* RMS format
-*
- IF(RECFM(1:3).EQ.'RMS') THEN
- COMAND(LENCOM+1:LENCOM+4) = '/RMS'
- LENCOM = LENCOM + 4
- ENDIF
-*
-* 'T' option - read directly from tape
-*
- IF(IOPTT.NE.0) THEN
- COMAND = COMAND(1:LENCOM) // '/DIRECT'
- LENCOM = LENCOM + 7
- ENDIF
-*
-* Check that we can use STAGE, before doing LIB$SPAWN...
-*
- CALL FMSTGP(CHGRP,IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMOPEN. error checking STAGE',
- + ' IRC = ',IRC
- RETURN
- ENDIF
-
- ISTAGE = .TRUE.
- IF(IMODE.EQ.0.AND.IOPTT.EQ.0) THEN
-*
-* Check that file is not already on disk
-*
- LCHGRP = LENOCC(CHGRP)
- CHSTFL = CHGRP(1:LCHGRP)//VSN(1:LVSN)//'_'//VID(1:LVID)
- + //'.'//FSEQ(JFSEQ:LEN(FSEQ))//'_'//VAXLAB(JL)
- LCHST = LENOCC(CHSTFL)
-
- INQUIRE(FILE=CHSTFL(1:LCHST),EXIST=IEXIST)
- IF(IEXIST) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMOPEN. requested file ',
- + 'already on disk - checking file size...'
- OPEN(LUN,FILE=CHSTFL(1:LCHST),STATUS='OLD',
- + FORM='UNFORMATTED',READONLY,SHARED,
- + USEROPEN=FMBALQ,IOSTAT=ISTAT)
- ISIZE = (NBLOKS*512)/MEGA + 1
- IF(IDEBFA.GE.0) PRINT *,'FMOPEN. size allocated = ',
- + NBLOKS,' disk blocks = ',ISIZE,' MB'
-*
-* If file already on disk, accept and set logical name
-*
- IF(IABS(IQ(L+KOFUFA+MFSZFA)-ISIZE).LT.1) THEN
- IRC = LIB$SET_LOGICAL(FORLUN(1:LFLUN),
- + CHSTFL(1:LCHST),'LNM$JOB',,)
- IF(.NOT.IRC) CALL LIB$SIGNAL(%VAL(IRC))
- GOTO 70
- ENDIF
- ENDIF
- ENDIF
-*
-* Check if we should issue a local or remote stage...
-*
- LM = LENOCC(MODEL)
- CALL FMGTLG('SETUP_'//MODEL(1:LM)//'S',EQUNAM,
- + 'LNM$SYSTEM',ILOCAL)
- INQUIRE(FILE='SETUP_EXE:TPSERV.CONF',EXIST=IEXIST)
- IF(ILOCAL.NE.0.AND.IEXIST) THEN
-
- IF(IDEBFA.GE.0) PRINT *,'FMOPEN. generic device type ',
- + MODEL(1:LM),' not found on this node - checking ',
- + 'served devices'
- ISTAT = LIB$GET_LUN(LUNTAP)
-#include "fatmen/fatvaxrc.inc"
- OPEN(LUNTAP,FILE='SETUP_EXE:TPSERV.CONF',
- + FORM='FORMATTED',STATUS='OLD',
- + READONLY,SHARED,IOSTAT=ISTAT)
- IF(ISTAT.NE.0) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMRZIN. cannot open TPSERV ',
- + 'configuration file (SETUP_EXE:TPSERV.CONF)'
- ELSE
- 50 CONTINUE
- READ(LUNTAP,'(A)',END=60) CHLINE
- LLINE = LENOCC(CHLINE)
- IF(IDEBFA.GE.2) PRINT *,'FMOPEN. tpserv line : ',
- + CHLINE(1:LLINE)
- IF(INDEX(CHLINE(1:LLINE),'TPSERV').NE.0.AND.
- + INDEX(CHLINE(1:LLINE),MODEL(1:LM)).NE.0) THEN
-*
-* Get remote host name
-*
- LBLNK = INDEXB(CHLINE(1:LLINE),' ')
- CHSERV = CHLINE(LBLNK+1:LLINE)
- LSERV = LLINE - LBLNK
- IF(IDEBFA.GE.0) PRINT *,'FMOPEN. served ',MODEL(1:LM),
- + ' found on node ',CHSERV(1:LSERV)
- GOTO 60
- ENDIF
- GOTO 50
- 60 CONTINUE
- CLOSE(LUNTAP)
- ISTAT = LIB$FREE_LUN(LUNTAP)
-#include "fatmen/fatvaxrc.inc"
- ENDIF
-*
-* Now submit remote job and wait for completion
-*
- LSTA = INDEX(CHSTFL,']') + 1
-*
-* Is remote node in the same cluster?
-* (Can talk to job controller directly)
-*
- IF(FMNODE(CHSERV(1:LSERV)).EQ.0) THEN
-
- IF(IDEBFA.GE.0) PRINT *,'FMOPEN. node ',CHSERV(1:LSERV),
- + ' is in this VAXcluster - can talk to job controller'
- CALL FMCSTG(CHSTFL(LSTA:LCHST),
- + MODEL(1:LM),COMAND(1:LENCOM),IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMOPEN. return code ',
- + IRC,' from FMCSTG'
- RETURN
- ENDIF
-
- ELSE
-
- IF(IDEBFA.GE.0) PRINT *,'FMOPEN. node ',CHSERV(1:LSERV),
- + ' is not in this VAXcluster - submit job via DECnet'
- CALL FMRSTG(CHSERV(1:LSERV),CHSTFL(LSTA:LCHST),
- + MODEL(1:LM),COMAND(1:LENCOM),IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMOPEN. return code ',
- + IRC,' from FMRSTG'
- RETURN
- ENDIF
- ENDIF
-*
-* Set logical name
-*
- IF(IRC.EQ.0) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMOPEN. defining logical name ',
- + FORLUN(1:LFLUN),' to point to ',CHSTFL(1:LCHST)
- IRC = LIB$SET_LOGICAL(FORLUN(1:LFLUN),
- + CHSTFL(1:LCHST),'LNM$JOB',,)
- IF(.NOT.IRC) CALL LIB$SIGNAL(%VAL(IRC))
- ENDIF
-
- ELSE
-
- IF(ISTAGE) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMOPEN. running ',COMAND(1:LENCOM)
-
- IRC = LIB$SPAWN(COMAND(1:LENCOM))
- IF (.NOT. IRC) CALL LIB$SIGNAL(%VAL(IRC))
-
- ENDIF
-
-*
-* Check file size on disk
-*
- IF(((IOPTS.NE.0.AND.IQ(L+KOFUFA+MFSZFA).EQ.0)
- + .OR.IOPTV.NE.0)
- + .AND.(LUFZFA.GT.0.AND.IMODE.EQ.0)) THEN
- OPEN(LUN,FILE=CHSTFL(1:LCHST),STATUS='OLD',
- + FORM='UNFORMATTED',READONLY,SHARED,
- + USEROPEN=FMBALQ,IOSTAT=ISTAT)
-
- ISIZE = (NBLOKS*512)/MEGA + 1
- IF(IDEBFA.GE.1) PRINT *,'FMOPEN. size allocated = ',
- + NBLOKS,' disk blocks = ',ISIZE,' MB'
-
- IF(IOPTV.NE.0.AND.
- + IABS(IQ(L+KOFUFA+MFSZFA)-ISIZE).GT.1) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMOPEN. file size in ',
- + 'catalogue (',IQ(L+KOFUFA+MFSZFA),
- + ') disagress with that returned by STAGE (',
- + ISIZE,')'
- ENDIF
-
- IQ(L+KOFUFA+MFSZFA) = ISIZE
-
- ENDIF
-
- ENDIF
-
-70 CONTINUE
-
-#endif
-#if (defined(CERNLIB_IBMVM))&&(!defined(CERNLIB_HEPVM))&&(!defined(CERNLIB_VMTAPE))&&(!defined(CERNLIB_NEEDFILE))
- PRINT *,'FMOPEN. Tape support is not available for this ',
- + 'system'
- IRC = 999
- RETURN
-
-#endif
-#if (defined(CERNLIB_VAXVMS))&&(!defined(CERNLIB_VAXTAP))
- PRINT *,'FMOPEN. Tape support is not available for this ',
- + 'system'
- IRC = 999
- RETURN
-
-#endif
-#if (defined(CERNLIB_UNIX))&&(!defined(CERNLIB_CRAY))&&(!defined(CERNLIB_SHIFT))&&(!defined(CERNLIB_APOL3))
- PRINT *,'FMOPEN. Tape support is not available for this ',
- + 'system'
- IRC = 999
- RETURN
-
-#endif
-#if defined(CERNLIB_CRAY)||defined(CERNLIB_SHIFT)||defined(CERNLIB_APOL3)
-*
-* Set IQUEST(11) to media type in case volume unknown or
-* TMS option not installed.
-*
- IQUEST(11) = IQ(L+KOFUFA+MMTPFA)
-#endif
-#if (defined(CERNLIB_CRAY)||defined(CERNLIB_SHIFT)||defined(CERNLIB_APOL3))&&(!defined(CERNLIB_PREFIX))
- CALL FMQTMS(VID(1:LVID),LIB,MODEL,DENS,MNTTYP,LABTYP,IC)
-#endif
-#if (defined(CERNLIB_CRAY)||defined(CERNLIB_SHIFT)||defined(CERNLIB_APOL3))&&(defined(CERNLIB_PREFIX))
- CALL FMQTMS(XVID(1:LXVID),LIB,MODEL,DENS,MNTTYP,LABTYP,IC)
-#endif
-#if defined(CERNLIB_CRAY)||defined(CERNLIB_SHIFT)||defined(CERNLIB_APOL3)
- IF(IDEBFA.GE.3) THEN
- PRINT *,'FMOPEN. return from FMQTMS with ',
- + VID,'/',LIB,'/',MODEL,'/',DENS,'/',MNTTYP,'/',
- + LABTYP,'/',IC
- ENDIF
-*
-* Believe density from TMS if tape is known
-*
- IF(IC.NE.0) CDEN = DENS
- CALL CUTOL(LABTYP)
- LLAB = LENOCC(LABTYP)
-
-#endif
-#if defined(CERNLIB_CRAY)
- FORLUN = 'fort. '
- IF(LUN.LT.10) THEN
- WRITE(FORLUN(6:6),'(I1)') LUN
- ELSE
- WRITE(FORLUN(6:7),'(I2)') LUN
- ENDIF
-
-#endif
-#if defined(CERNLIB_SHIFT)
- IF(LUN.LT.10) THEN
- WRITE(FORLUN,'(I1)') LUN
- ELSE
- WRITE(FORLUN,'(I2)') LUN
- ENDIF
-
-#endif
-#if defined(CERNLIB_CRAY)||defined(CERNLIB_SHIFT)||defined(CERNLIB_APOL3)
-
- WRITE(FSEQ,9007) IQ(L+KOFUFA+MFSQFA)
-
- IF (LUN .EQ. 0) FORLUN = CHLUN
-* "stagein fort.lun -v vsn -V vid -l sl|nl|al|blp
-* -g TAPE|CART|SMCF -d 6250|1600"
-#endif
-#if defined(CERNLIB_APOL3)
- IF(IMODE.EQ.0) THEN
- COMAND = 'stage -i '
- ELSEIF(IMODE.EQ.1) THEN
-*
-* Output staging on Apollo:
-* Use temporary file in current directory
-* or in directory specified by L3STAGE
-*
- CALL GETENVF('L3STAGE',L3PATH)
- IF(IS(1).EQ.0) THEN
- STGPTH = DSN(1:LDSN)
- ELSE
- STGPTH = L3PATH(1:IS(1)) // DSN(1:LDSN)
- LSTG = IS(1) + LDSN
- ENDIF
- LSTG = IS(1) + LDSN
- IF(IDEBFA.GE.0) PRINT *,'FMOPEN. stage out file is ',
- + STGPTH(1:LSTG)
- GOTO 60
- ENDIF
- COMAND = COMAND(1:LENOCC(COMAND))
- + // ' -v '
- + //VID(1:LVID)//' -l '//LABTYP//' -t '//MODEL
- + // ' -f ' //FSEQ// ' -d '//CDEN // ' -s '//CSIZE
- IF(IWAIT) COMAND = COMAND(1:LENOCC(COMAND)) // ' -w '
-#endif
-#if defined(CERNLIB_CRAY)
- COMAND = 'stagein '//FORLUN
-#endif
-#if defined(CERNLIB_SHIFT)
- LFLUN = LENOCC(FORLUN)
- COMAND = 'stagein -G -U '//FORLUN(1:LFLUN)
- + // ' T'//VID(1:LVID)//'.FSEQ'//FSEQ(JFSEQ:LEN(FSEQ))
-#endif
-#if defined(CERNLIB_CRAY)||defined(CERNLIB_SHIFT)
- + // ' -v '//VSN(1:LVSN)// ' -V '
- + //VID(1:LVID)//' -l '//LABTYP//' -g '//MODEL
- + // ' -q ' //FSEQ
-#endif
-#if defined(CERNLIB_SHIFT)
- + // ' -s ' //CSIZE // ' -u '//CHUSER
- + // ' -p shift1'
-#endif
-#if defined(CERNLIB_CRAY)
- + // ' -K -S sbin'
-#endif
-#if defined(CERNLIB_CRAY)||defined(CERNLIB_SHIFT)
-
- IF(IMODE.NE.0) COMAND(1:8) = 'stageout'
-#endif
-#if defined(CERNLIB_CRAY)||defined(CERNLIB_SHIFT)||defined(CERNLIB_APOL3)
- LENCOM = LENOCC(COMAND)
-#endif
-#if defined(CERNLIB_CRAY)||defined(CERNLIB_SHIFT)
-*
-* Add DSN if IOPTN not specified
-*
- IF(IOPTN.EQ.0) THEN
- COMAND = COMAND(1:LENCOM) // ' -f '//DSN(1:LDSN)
- LENCOM = LENOCC(COMAND)
- ENDIF
-
-#endif
-#if defined(CERNLIB_APOL3)
-*
-* Add DSN if IOPTN not specified
-*
- IF(IOPTN.EQ.0) THEN
- COMAND = COMAND(1:LENCOM) // ' -n '//DSN(1:LDSN)
- LENCOM = LENOCC(COMAND)
- ENDIF
-
-#endif
-#if defined(CERNLIB_CRAY)||defined(CERNLIB_SHIFT)
-*
-* Option T - direct access to tapes
-*
- IF(IOPTT.NE.0) THEN
- COMAND(1:8) = 'setup '
-*
-* Option W - write access
-*
- IF(IOPTW.NE.0) THEN
- COMAND = COMAND(1:LENCOM) // '-r in'
- LENCOM = LENCOM + 5
- ENDIF
-
- ENDIF
-*
-* Add DCB information
-*
- WRITE(DCB,9011) RECFM(1:1),LRECL,LBLOCK
- 9011 FORMAT(' -F ',A1,' -L ',I5,' -b ',I5)
- COMAND = COMAND(1:LENOCC(COMAND)) // DCB
- LENCOM = LENOCC(COMAND)
-
-#endif
-#if defined(CERNLIB_APOL3)
-*
-* Add DCB information, direct output to temporary file
-*
- CALL FMFNME(CHFILE)
- LCHF = LENOCC(CHFILE)
- IF(IDEBFA.GE.3) PRINT *,'FMOPEN. output of STAGE command ',
- + 'will be sent to /tmp/'//CHFILE(1:LCHF)
- WRITE(DCB,9011) RECFM,LRECL,LBLOCK
- 9011 FORMAT(' -r ',A,' -c ',I5,' -b ',I5)
- COMAND = COMAND(1:LENOCC(COMAND)) // DCB
- + // ' ' // VSN(1:LVSN)
- + // ' > /tmp/'//CHFILE(1:LCHF)
- LENCOM = LENOCC(COMAND)
-
-#endif
-#if defined(CERNLIB_CRAY)||defined(CERNLIB_SHIFT)||defined(CERNLIB_APOL3)
-
- CALL CSQMBL(COMAND,1,LENCOM)
- LENCOM = LENOCC(COMAND)
- IF(IDEBFA.GE.0) PRINT *,'FMOPEN. executing ',COMAND(1:LENCOM)
-#endif
-#if defined(CERNLIB_APOL3)
- ISTAT = 0
- 30 CONTINUE
- IC = SYSTEMF(COMAND(1:LENCOM))
-*
-* Check output of stage command
-*
- OPEN(LUN,FILE='/tmp/'//CHFILE(1:LCHF),STATUS='OLD',
- + FORM='FORMATTED')
- 40 READ(LUN,'(A)',END=50 ) CHLINE
- LCHL = LENOCC(CHLINE)
- IF(IDEBFA.GE.0) PRINT *,'FMOPEN. ',CHLINE(1:LCHL)
- IF(INDEX(CHLINE(1:LCHL),'path : ').NE.0) THEN
- ISTART = INDEX(CHLINE(1:LCHL),'/')
- STGPTH = CHLINE(ISTART:)
- ELSEIF(INDEX(CHLINE(1:LCHL),'stat : ').NE.0) THEN
- ISTAT = 1
- IF(INDEX(CHLINE(1:LCHL),'ABORTED').NE.0) THEN
- IRC = -1
- RETURN
- ELSEIF(INDEX(CHLINE(1:LCHL),'ENDED_OK').NE.0) THEN
- GOTO 50
- ENDIF
- ENDIF
- GOTO 40
- 50 CLOSE(LUN)
- IF(ISTAT.EQ.0) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMOPEN. no status return ',
- + 'from stage. Will retry in 60 seconds'
- CALL SLEEPF(60)
- GOTO 30
- ENDIF
- 60 CONTINUE
-#endif
-#if defined(CERNLIB_SHIFT)
- IC = SYSTEMF(COMAND(1:LENCOM))
- IF(IC.NE.0) THEN
- PRINT *,'FMOPEN. return code ',IC,' from stage command'
- RETURN
- ENDIF
-#endif
-#if defined(CERNLIB_CRAY)
- IC = SYSTEMF(COMAND(1:LENCOM))
-#endif
-
- ENDIF
-
-*=======================================================================
-*
-* End of media dependant code
-*
-*=======================================================================
-*
-* Record last access date and use count in bank send to server
-*
- CALL DATIME(ID,IT)
- CALL FMPKTM(ID,IT,IP,IRC)
- IQ(L+KOFUFA+MLATFA) = IP
- IF(IMODE.EQ.1) THEN
- IQ(L+KOFUFA+MUSCFA) = 1
- ELSE
- IQ(L+KOFUFA+MUSCFA) = IQ(L+KOFUFA+MUSCFA) + 1
- ENDIF
- IF((LUFZFA.GT.0).AND.(IMODE.EQ.0))THEN
- IF(IDEBFA.GE.0)
- + PRINT *,ROUTIN//'- updating last access date and use count'
- IF(IDEBFA.GE.3)
- + CALL FMSHOW(GENAME(1:NCH),L,KEYS,'A',IRC)
- CALL FMMOD(GENAME(1:NCH),L,0,IRC)
- IF((IRC.NE.0).AND.(IDEBFA.GE.0)) THEN
- PRINT *,ROUTIN//
- +'- error updating use count/last access date'
- PRINT *,'Return code from FMMOD = ',IRC
- ENDIF
- ENDIF
-#if defined(CERNLIB_IBMVM)
-*
-* Set vaddr used for tape
-*
- IF(IOPTT.NE.0) THEN
- IVADDR(LUN) = ITAPE
- IDEV(ITAPE) = IVADDR(LUN)
- ENDIF
-#endif
-*
-* Set the disk and access modes (for FMCLOS)
-*
- IF (IQ(L+KOFUFA+MMTPFA) .EQ. 1) THEN
-#if defined(CERNLIB_IBMVM)
- CHMODE(LUN) = MODE(1:1)
-#endif
- LFMODE(LUN) = 1
- ELSE
- CHMODE(LUN) = ' '
- IF(IOPTT.EQ.0) THEN
- LFMODE(LUN) = 2
- ELSE
- LFMODE(LUN) = 3
- ENDIF
- ENDIF
-*
-* Set FZFILE options: C I/O, FORTRAN I/O, package etc.
-*
- JFMODE(LUN) = ICFOP
-*
-* Mode for FZENDx (In or Out)
-*
- IFMODE(LUN) = IMODE
-*
-* Issue FZFILE and do the OPEN
-*
- IF(IOPTF.NE.0) THEN
-*
-* Build FZ options
-*
-* Direction...
-*
- FZOPT = 'I'
- IF(IOPTW.NE.0) FZOPT = 'O'
- LFZOPT = 1
-*
-* Medium...
-*
-#if !defined(CERNLIB_SETUP)
-
- IF((IQ(L+KOFUFA+MMTPFA).GT.1).AND.(IOPTT.NE.0)) THEN
- LFZOPT = LFZOPT + 1
- FZOPT(LFZOPT:LFZOPT) = 'T'
-#endif
-#if (!defined(CERNLIB_SETUP))&&(!defined(CERNLIB_IBMVM))
-*SELF,IF=-SETUP. !! When FZHOOK -> FMVMIO -> VMIO working
- ELSEIF(IOPTX.NE.0) THEN
- LFZOPT = LFZOPT + 1
- FZOPT(LFZOPT:LFZOPT) = 'D'
-#endif
-#if !defined(CERNLIB_SETUP)
- ENDIF
-#endif
-#if defined(CERNLIB_SETUP)
- IF((IQ(L+KOFUFA+MMTPFA).EQ.1).AND.(IOPTX.NE.0)) THEN
-#endif
-#if (defined(CERNLIB_SETUP))&&(!defined(CERNLIB_IBMVM))
- LFZOPT = LFZOPT + 1
- FZOPT(LFZOPT:LFZOPT) = 'D'
-#endif
-#if defined(CERNLIB_SETUP)
- ELSE
- LFZOPT = LFZOPT + 1
- FZOPT(LFZOPT:LFZOPT) = 'T'
- ENDIF
-#endif
-*
-* Data Format...
-*
- IF(INDEX(FFORM,'A').NE.0) THEN
- LFZOPT = LFZOPT + 1
- FZOPT(LFZOPT:LFZOPT) = 'A'
- ELSEIF(INDEX(FFORM,'X').NE.0) THEN
- LFZOPT = LFZOPT + 1
- FZOPT(LFZOPT:LFZOPT) = 'X'
- ENDIF
-*
-* FORTRAN I/O...
-*
- IF((INDEX(FFORM,'FFX').NE.0).AND.(ICFOP.EQ.0)) THEN
- LFZOPT = LFZOPT + 1
- FZOPT(LFZOPT:LFZOPT) = 'F'
- ENDIF
-*
-* Package I/O... (e.g. IOPACK, MAGTAP)
-*
- IF((INDEX(FFORM,'FX').NE.0).AND.(ICFOP.EQ.3)) THEN
- LFZOPT = LFZOPT + 1
- FZOPT(LFZOPT:LFZOPT) = 'Y'
- ENDIF
-*
-* File format X, but native data...
-*
- IF(INDEX(FFORM,'FXN').NE.0) THEN
- LFZOPT = LFZOPT + 1
- FZOPT(LFZOPT:LFZOPT) = 'N'
- ENDIF
-#if defined(CERNLIB_IBMVM)
-*
-* File format X, direct access
-*
- IF((INDEX(FFORM,'FX').NE.0).AND.(IOPTX.NE.0)) THEN
- LFZOPT = LFZOPT + 1
- FZOPT(LFZOPT:LFZOPT) = 'C'
- ENDIF
-#endif
-
- LRECL = IQ(L+KOFUFA+MRLNFA)
-
-#if defined(CERNLIB_SHIFT)
- IF(ICFOP.EQ.0) THEN
- LFZOPT = LFZOPT + 1
- FZOPT(LFZOPT:LFZOPT) = 'C'
- ELSE
- LFZOPT = LFZOPT + 1
- FZOPT(LFZOPT:LFZOPT) = 'L'
- IF(IOPTR.NE.0) CFMODE = 'r'
- IF(IOPTW.NE.0) CFMODE = 'w'
-
- MEDIUM = 0
- NBUF = 1
-
- CALL CFOPEN(LUNPTR,MEDIUM,LRECL,CFMODE,NBUF,
- + SHFNAM(1:LFNAM),IRC)
-* + 'fort.'//FORLUN(1:LFLUN),IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMOPEN. return code ',IRC,
- + ' from CFOPEN'
- RETURN
- ENDIF
- IQUEST(1) = LUNPTR
- ENDIF
-#endif
- IF(IDEBFA.GE.2) PRINT *,'FMOPEN. call FZFILE with ',
- + 'LRECL/CHOPT = ',LRECL,'/',FZOPT(1:LFZOPT)
- CALL FZFILE(LUN,LRECL,FZOPT(1:LFZOPT))
- CALL FZLOGL(LUN,IDEBFA)
-#if defined(CERNLIB_IBMVM)
- IF((IOPTF.NE.0).AND.(IOPTX.NE.0).AND.
- + (INDEX(FFORM,'FX').NE.0)) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMOPEN. call FZHOOK for ',
- + 'LUN = ',LUN
- CALL FZHOOK(LUN,FMVMIO,DBUF)
- ENDIF
-#endif
-
-
- ENDIF
-
- IF(IOPTU.EQ.0) THEN
-*
-* Decide on file format
-*
- IF((INDEX(FFORM,'AS').NE.0).OR.(INDEX(FFORM,'FA').NE.0)) THEN
- FORMT = 'FORMATTED'
- ELSE
- FORMT = 'UNFORMATTED'
- ENDIF
-*
-* Decide on file status
-*
- IF(IOPTW.NE.0) THEN
- STATE = 'NEW'
- ELSE
- STATE = 'OLD'
- ENDIF
-*
-* For disk files, check if file already exists
-*
- IF(IQ(L+KOFUFA+MMTPFA).EQ.1) THEN
-#if defined(CERNLIB_IBMMVS)
- INQUIRE(FILE='/'//DSN(1:LDSN),EXIST=IEXIST)
-#endif
-#if defined(CERNLIB_IBMVM)
- INQUIRE(FILE=DDNAME,EXIST=IEXIST)
-#endif
-#if (!defined(CERNLIB_IBMMVS))&&(!defined(CERNLIB_IBMVM))
- INQUIRE(FILE=DSN(1:LDSN),EXIST=IEXIST)
-#endif
- IF(IEXIST) STATE = 'OLD'
- ELSE
-#if defined(CERNLIB_VAXVMS)
- INQUIRE(FILE=FORLUN,EXIST=IEXIST)
- IF(IEXIST) STATE = 'OLD'
-#endif
- ENDIF
-
-#if defined(CERNLIB_IBMMVS)
-*
-* Only FORTRAN I/O currently supported...
-*
- IF(IQ(L+KOFUFA+MMTPFA).EQ.1) THEN
-*
-* Check if file exists...
-*
- INQUIRE(FILE='/'//DSN(1:LDSN),EXIST=IEXIST)
- IF(.NOT.IEXIST) THEN
-*
-* Issue FILEINF for DCB and SPACE information
-*
- IF(INDEX('TRK/BLK/CYL',CHSPAC(1:3)).EQ.0) THEN
- IF(IDEBFA.GE.-1) PRINT *,'FMOPEN. invalid value (',
- + CHSPAC,') given for SPACE parameter. TRK will be used'
- CHSPAC = 'TRK '
- ENDIF
-
- MODEL = CHMGEN(1)
- LMOD = LENOCC(MODEL)
-
- CALL FILEINF(IRC,'DEVICE',MODEL(1:LMOD),CHSPAC(1:3),
- + ISPACE(2),'SECOND',ISPACE(3),'DIR',ISPACE(4),
- + 'RECFM',RECFM,'LRECL',IQ(L+KOFUFA+MRLNFA)*4,
- + 'BLKSIZE',IQ(L+KOFUFA+MBLNFA)*4)
- ENDIF
- ENDIF
-
- IF((FFORM(1:2).EQ.'FX').OR.(FFORM(1:2).EQ.'EP').OR.
- + (INDEX(CHLUN,'IOFILE').NE.0)) THEN
-*
-* IOPACK (implied or explicit)
-*
- IF(IDEBFA.GE.2) PRINT *,'FMOPEN. FORTRAN open supressed'
-*
-* FORTRAN direct access
-*
- ELSEIF((FFORM(1:2).EQ.'DA').OR.(IOPTX.NE.0)
- + .AND.(CHLUN(1:2).NE.'VM')) THEN
- IF(IDEBFA.GE.2) PRINT *,'FMOPEN. FORTRAN D/A open...'
- OPEN(UNIT=LUN,
- + FILE='/'//DSN(1:LDSN),ACTION=CHACT(1:LCHACT),
- + ACCESS='DIRECT',STATUS=STATE,RECL=LRECL*4)
- ELSE
-*
-* FORTRAN sequential I/O
-*
- IF(IDEBFA.GE.2) PRINT *,'FMOPEN. FORTRAN open...'
- OPEN(UNIT=LUN,
- + FILE='/'//DSN(1:LDSN),ACTION=CHACT(1:LCHACT),
- + FORM=FORMT,STATUS=STATE)
- ENDIF
-#endif
-#if defined(CERNLIB_IBMVM)
- IF((CHLUN(1:2).EQ.'VM').OR.(IVMIO)) THEN
-*
-* VMIO
-*
- FNAME = ' '
- LREC1 = LRECL*4
- LBLK1 = LBLOCK*4
- RECFM1 = RECFM
- IF(IOPTR.NE.0) VMOPT = 'R'
- IF(IOPTW.NE.0) VMOPT = 'W'
-*
-* VMOPT = U requires VMUPDT to write the data
-*
-* IF((IOPTX.NE.0).AND.(IOPTW.NE.0)) VMOPT = 'U'
- IF(IDEBFA.GE.2) PRINT *,
- + 'FMOPEN. call VMOPEN for input dataset on unit ',LUN,
- + ' with DCB ',RECFM1,LREC1,LBLK1,' VMOPT ',VMOPT
- CALL VMOPEN(LUN,FNAME,VMOPT,RECFM1,LREC1,LBLK1,IRC,INFO)
- IF(IDEBFA.GE.2) PRINT *,
- + 'FMOPEN. return from VMOPEN ',
- + ' with DCB ',RECFM1,LREC1,LBLK1
- IF(IABS(IRC).GT.1) THEN
- IF(IDEBFA.GT.-3)
- + PRINT *,'FMOPEN. return code ',IRC,
- + ' from VMOPEN for input file, INFO = ',INFO
- ELSE
- IRC = 0
- ENDIF
-#endif
-#if defined(CERNLIB_IBMVM)
- ELSEIF((FFORM(1:2).EQ.'FX').OR.(FFORM(1:2).EQ.'EP').OR.
- + (INDEX(CHLUN,'IOFILE').NE.0)) THEN
-*
-* IOPACK (implied or explicit)
-*
- IF(IDEBFA.GE.2) PRINT *,'FMOPEN. FORTRAN open supressed'
-*
-* FORTRAN direct access
-*
- ELSEIF((FFORM(1:2).EQ.'DA').OR.(IOPTX.NE.0)
- + .AND.(CHLUN(1:2).NE.'VM')) THEN
- IF(IDEBFA.GE.2) PRINT *,'FMOPEN. FORTRAN D/A open...'
- OPEN (UNIT=LUN,ACCESS='DIRECT',STATUS=STATE,RECL=LRECL*4,
- + ACTION=CHACT(1:LCHACT))
- ELSE
-*
-* FORTRAN sequential I/O
-*
- IF(IDEBFA.GE.2) PRINT *,'FMOPEN. FORTRAN open...'
- OPEN (UNIT=LUN,FORM=FORMT,STATUS=STATE,
- + ACTION=CHACT(1:LCHACT))
- ENDIF
-#endif
-#if defined(CERNLIB_APOL3)
- IF((IQ(L+KOFUFA+MMTPFA).EQ.1).OR.(IMODE.NE.0)) THEN
- CHFILE = DSN(1:LDSN)
- LCHF = LDSN
- ELSEIF((IQ(L+KOFUFA+MMTPFA).GT.1).AND.(IMODE.EQ.0)) THEN
- CHFILE = STGPTH
- LCHF = LENOCC(CHFILE)
- ENDIF
- IF(IDEBFA.GE.0) PRINT *,'FMOPEN. open file ',
- + CHFILE(1:LCHF)
-#endif
-#if defined(CERNLIB_UNIX)
- IF((FFORM(1:2).EQ.'DA').OR.(IOPTX.NE.0)) THEN
-#endif
-#if (defined(CERNLIB_APOLLO)||defined(CERNLIB_NORD)||defined(CERNLIB_SUN)||defined(CERNLIB_IBMRT)||defined(CERNLIB_MACMPW)||defined(CERNLIB_AIX370))&&(defined(CERNLIB_UNIX))
- LREC=LRECL*4
-#endif
-#if (defined(CERNLIB_DECS)||defined(CERNLIB_SGI))&&(defined(CERNLIB_UNIX))
- LREC=LRECL
-#endif
-#if (defined(CERNLIB_CRAY)||defined(CERNLIB_CONVEX))&&(defined(CERNLIB_UNIX))
- LREC=LRECL*8
-#endif
-#if (defined(CERNLIB_UNIX))&&(!defined(CERNLIB_SHIFT))&&(!defined(CERNLIB_APOL3))
- IF(IDEBFA.GE.2) PRINT *,'FMOPEN. FORTRAN D/A open...'
- OPEN (UNIT=LUN,ACCESS='DIRECT',STATUS=STATE,RECL=LREC)
- ELSE
- IF(IDEBFA.GE.2) PRINT *,'FMOPEN. FORTRAN open...'
- OPEN (UNIT=LUN,FORM=FORMT,STATUS=STATE)
- ENDIF
-#endif
-#if defined(CERNLIB_APOL3)
- IF(IDEBFA.GE.2) PRINT *,'FMOPEN. FORTRAN D/A open...'
- OPEN (UNIT=LUN,FILE=CHFILE(1:LCHF),
- + ACCESS='DIRECT',STATUS=STATE,RECL=LREC)
- ELSE
- IF(IDEBFA.GE.2) PRINT *,'FMOPEN. FORTRAN open...'
- OPEN (UNIT=LUN,FILE=CHFILE(1:LCHF),
- + FORM=FORMT,STATUS=STATE)
- ENDIF
-
-#endif
-#if defined(CERNLIB_SHIFT)
-*
-* LRECL in bytes for SHIFT...
-*
- LREC = LRECL*4
- SHOPT = ' '
- ELSE
- LREC = LRECL*4
- SHOPT = 'D'
- ENDIF
-
- IF(ICFOP.EQ.0) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMOPEN. calling XYOPEN with ',
- + 'LUN,LRECL,CHOPT = ',LUN,',',LREC,',',SHOPT
- CALL XYOPEN(LUN,LREC,SHOPT,IRC)
- IF(IRC.NE.0) THEN
- PRINT *,'FMOPEN. return code ',IRC,' from XYOPEN '
- RETURN
- ENDIF
-
- IF(IOPTF.NE.0) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMOPEN. call FZHOOK for ',
- + 'LUN = ',LUN
- CALL FZHOOK(LUN,FMFZIO,DBUF)
- ENDIF
-
- ENDIF
-
-#endif
-#if defined(CERNLIB_VAXVMS)
-*
-* Always open VAX files SHARED
-*
- IF(IOPTR.NE.0) THEN
- IF((FFORM(1:2).EQ.'DA').OR.(IOPTX.NE.0)) THEN
- IF(IDEBFA.GE.2) PRINT *,'FMOPEN. FORTRAN D/A open...'
- OPEN (UNIT=LUN,STATUS=STATE,
- + ACCESS='DIRECT',RECL=LRECL,
- + SHARED, READONLY)
- ELSE
- IF(IDEBFA.GE.2) PRINT *,'FMOPEN. FORTRAN open...'
- OPEN (UNIT=LUN, FORM=FORMT, STATUS=STATE,
- + SHARED, READONLY)
- ENDIF
-
- ELSE
- IF((FFORM(1:2).EQ.'DA').OR.(IOPTX.NE.0)) THEN
- OPEN (UNIT=LUN,STATUS=STATE,
- + ACCESS='DIRECT',RECL=LRECL,
- + SHARED)
- ELSE
- OPEN (UNIT=LUN, FORM=FORMT, STATUS=STATE,
- + SHARED)
- ENDIF
-
- ENDIF
-#endif
- ENDIF
-
-*
-*
-* Issue RZOPEN and RZFILE
-*
- IF(IOPTZ.NE.0) THEN
-*
-* Mode for FMCLOS
-*
- IFMODE(LUN) = 2
-*
-* Build RZ options
-*
- LRECL = IQ(L+KOFUFA+MRLNFA)
- LRECL = LRECL*4/IQCHAW
- RZOPT = 'W'
- IF(IOPTW.NE.0) RZOPT = 'UW'
- IF(IDEBFA.GE.2) PRINT *,'FMOPEN. call RZOPEN with ',
- + 'LUN/CHDIR/DSN/RZOPT/LRECL = ',
- + LUN,'/',CHDIR,'/',DSN(1:LDSN),'/',RZOPT,'/',LRECL
- CALL RZOPEN(LUN,CHDIR,DSN(1:LDSN),RZOPT,LRECL,IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMOPEN. return code ',IRC,
- + ' from RZOPEN'
- RETURN
- ENDIF
-
- RZOPT = ' '
- IF(IOPTW.NE.0) RZOPT = 'ULD'
- IF(IOPT1.NE.0) RZOPT = '1ULD'
- IF(IDEBFA.GE.2) PRINT *,'FMOPEN. call RZFILE for ',
- + ' LUN/CHDIR/RZOPT = ',LUN,'/',CHDIR,'/',RZOPT
- CALL RZFILE(LUN,CHDIR,RZOPT)
- IRC = IQUEST(1)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMOPEN. return code ',IRC,
- + ' from RZFILE'
- RETURN
- ENDIF
- ENDIF
-
- END
diff --git a/src/packlib/fatmen/unref/fmscan.F b/src/packlib/fatmen/unref/fmscan.F
deleted file mode 100644
index 5bae129..0000000
--- a/src/packlib/fatmen/unref/fmscan.F
+++ /dev/null
@@ -1,92 +0,0 @@
-*
-* $Id: fmscan.F,v 1.1.1.1 1996/03/07 15:18:24 mclareni Exp $
-*
-* $Log: fmscan.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:24 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMSCAN(CHPATH,FILES,KEYS,KEYSEL,NFIRST,NLAST,NMAX,
- + CHOPT,IRC)
-#include "fatmen/fatbank.inc"
-#include "fatmen/fatpara.inc"
- PARAMETER (LKEYFA=10)
- PARAMETER (MAXFIL=10000)
- CHARACTER*(*) CHPATH,FILES(NMAX)
- DIMENSION KEYS(LKEYFA,NMAX)
- DIMENSION JSORT(MAXFIL)
-*
-* CHOPT: R - search for generic names for which a ROBOT copy exists
-* M - search for generic names for which a MANUAL copy exists
-* D - search for generic names for which a DISK copy exists
-* C - search for generic names for which multiple copies exist
-* U - call FUSCAN for all matching entries
-* RC implies that there are multiple copies, one of which is in the
-* robot,
-* DR implies that a copy exists both on disk and in the robot etc.
-*
-* KEYSEL: keys vector as for call to FMSELK, e.g.
-* KEYSEL(MKLCFA) = 1
-* KEYSEL(MKMTFA) = 2
-* KEYSEL(MKCLFA) = 2
-* would look for location code 1 (CERN), media type 2 (3480)
-* and copy level 2 (byte-swapped IEEE format, e.g. DEC/Ultrix)
-*
-#include "fatmen/fatopts.inc"
-*
-* Subroutine to return a list of FATMEN-selected generic names
-* corresponding to the (wild-carded) generic name and current
-* selection criteria
-*
- IRC = 0
- IF((NFIRST.LE.0).OR.(NLAST.LT.NFIRST)) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMSCAN - NFIRST/NLAST invalid ',
- + NFIRST,NLAST
- IRC = 1
- RETURN
- ENDIF
-
- CALL FMLIST(CHPATH,FILES,KEYS,NFOUND,NMAX,IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMSCAN - return code ',IRC,
- + 'from FMLIST'
- RETURN
- ENDIF
-
-*
-* Sort this list...
-*
- CALL FMSORT(FILES,KEYS,NFOUND,JSORT,IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMSCAN - return code ',IRC,
- + 'from FMSORT'
- RETURN
- ENDIF
-
-*
-* For NFIRST to NLAST, make FATMEN selection
-*
- DO 10 I=NFIRST,NLAST
- CALL FMGET(FILES,LBANK,KEYS,IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMSCAN - return code ',IRC,
- + 'from FMGET'
- RETURN
- ENDIF
-
-*
-* Make user selection on this entry
-*
- IF(IOPTU.NE.0) THEN
- ISEL = 0
- CALL FUSCAN(FILES(I),LBANK,KEYS,ISEL)
- IF(ISEL.NE.0) GOTO 10
- ENDIF
-*
-* Move generic name and keys to output array
-*
-* CALL UCOPY
-10 CONTINUE
- END
-
diff --git a/src/packlib/fatmen/unref/fmseac.F b/src/packlib/fatmen/unref/fmseac.F
deleted file mode 100644
index 57b157b..0000000
--- a/src/packlib/fatmen/unref/fmseac.F
+++ /dev/null
@@ -1,307 +0,0 @@
-*
-* $Id: fmseac.F,v 1.1.1.1 1996/03/07 15:18:24 mclareni Exp $
-*
-* $Log: fmseac.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:24 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMSEAC
- PARAMETER (MAXFIL=1000)
- PARAMETER (LKEYFA=10)
- DIMENSION KEYS(LKEYFA,MAXFIL),JSORT(MAXFIL)
- DIMENSION KEYSAV(LKEYFA)
- CHARACTER*255 PATH2
- CHARACTER*255 FILES,PATH,CHPATH,PREDIR,GENAM,OLDNAM,
- + CWD,OLDWD
- CHARACTER*255 DSN
- CHARACTER*80 CHCRE,CHCAT,CHACC
- CHARACTER*12 HOST,VID,USER
-#include "fatmen/fatsea.inc"
-#include "fatmen/fatpara.inc"
-#include "fatmen/fatloc.inc"
-#include "fatmen/fatmtp.inc"
-#include "fatmen/fatcpl.inc"
-#include "fatmen/fatsys.inc"
-#include "fatmen/fatout.inc"
- CHARACTER*20 CHFILE,MATCH
- CHARACTER*36 CHOPT,OPTN
-#include "fatmen/fatbank.inc"
- COMMON /MYWKSP/ FILES(MAXFIL)
- CHARACTER*132 CARD
- CHARACTER*3 CHSTAT
- LOGICAL IOPEN,IEXIST
- DATA NENT/0/
-#include "fatmen/fatinit.inc"
-*
- OUTPUT = ' '
- LOUT = 0
- LWRITE = LPRTFA
- CALL FACDIR(PREDIR,'R')
- CALL FACDIR(PREDIR,'U')
-
- IF(NENT.EQ.0) THEN
- NENT = 1
-* RETURN
- ENDIF
-
- PATH = ' '
- CALL KUGETC(PATH,LPATH)
- CALL FMFIXF(PATH,PATH2)
- PATH = PATH2
- LPATH = LENOCC(PATH2)
-
- CALL KUGETC(DSN,LDSN)
- CALL KUGETC(HOST,LHOST)
- CALL KUGETC(VID,LVID)
- CALL KUGETC(USER,LUSER)
- CALL KUGETI(NMATCH)
- CALL KUGETC(CHCRE,LCHCRE)
- CALL KUGETC(CHCAT,LCHCAT)
- CALL KUGETC(CHACC,LCHACC)
- CALL KUGETC(OUTPUT,LOUT)
- CALL KUGETC(CHOPT,LCHOPT)
-
- IF(LDSN.EQ.0) DSN = ' '
- IF(LHOST.EQ.0) HOST = ' '
- IF(LVID.EQ.0) VID = ' '
- IF(LUSER.EQ.0) USER = ' '
- IF(LCHOPT.EQ.0) CHOPT = ' '
-*
-* Date and time ranges:
-*
- IF(LCHCRE.NE.0) THEN
- CALL FMDTRN(CHCRE(1:LCHCRE),IDCREA,ITCREA,JDCREA,JTCREA,IC)
- IF(IDEBFA.GE.1) PRINT *,'FMSEAC. range of creation dates & ',
- + 'times is ',IDCREA,ITCREA,JDCREA,JTCREA
- ELSE
- IDCREA = -1
- ENDIF
-
- IF(LCHCAT.NE.0) THEN
- CALL FMDTRN(CHCAT(1:LCHCAT),IDCATA,ITCATA,JDCATA,JTCATA,IC)
- IF(IDEBFA.GE.1) PRINT *,'FMSEAC. range of dates & ',
- + 'times of cataloging is ',IDCATA,ITCATA,JDCATA,JTCATA
- ELSE
- IDCATA = -1
- ENDIF
-
- IF(LCHACC.NE.0) THEN
- CALL FMDTRN(CHACC(1:LCHACC),IDLAST,ITLAST,JDLAST,JTLAST,IC)
- IF(IDEBFA.GE.1) PRINT *,'FMSEAC. range of dates & ',
- + 'times of last access is ',IDLAST,ITLAST,JDLAST,JTLAST
- ELSE
- IDLAST = -1
- ENDIF
-
- IF((OUTPUT(1:LOUT).EQ.'TTY').OR.(LOUT.EQ.0)) THEN
- OUTPUT = ' '
- LWRITE = LPRTFA
- ELSE
- LWRITE = 3
- IF(IDEBFA.GE.2)
- + PRINT *,'FMSEAC. output will be redirected to ',OUTPUT(1:LOUT)
- CALL FAFILE(LWRITE,OUTPUT(1:LOUT),IRET)
- IF(IRET.NE.0) THEN
- IF(IDEBFA.GE.-3) PRINT *,'FMSEAC. return code ',IRET,
- + 'from OPEN'
- ENDIF
- ENDIF
-
- IF(LENOCC(CHOPT).EQ.0) THEN
- CHOPT = ' '
- LCHOPT = 1
- ENDIF
-*
- IF(INDEX(CHOPT(1:LCHOPT),'H').NE.0) THEN
- WRITE(LWRITE,*) '>>> Command: SEARCH ',
- + 'Options: ',CHOPT(1:LCHOPT)
- WRITE(LWRITE,*) '>>> Path: ',PATH(1:LPATH)
- WRITE(LWRITE,*) '>>> Current directory: ',
- + PREDIR(1:LENOCC(PREDIR))
- ENDIF
-*
- NFILES = 0
- OLDWD = ' '
- LOLDWD = 1
-*
-* Look for some files and show the bank and key content:
-*
- LSLASH = INDEXB(PATH(1:LPATH),'/')
- CHPATH = PATH(1:LSLASH-1)
- MATCH = PATH(LSLASH+1:LPATH)
- LP = LENOCC(CHPATH)
- LM = LENOCC(MATCH)
- IF(IDEBFA.GE.2) PRINT *,'FMSEAC. enter for ',PATH(1:LPATH),
- + CHOPT
-1 CONTINUE
- CALL FMLFIL(PATH(1:LPATH),FILES,KEYS,NFOUND,MAXFIL,JCONT,IRC)
- IF(IRC.EQ.-1) THEN
- JCONT = 1
- ELSE
- JCONT = 0
- ENDIF
-* CALL FMLIST(CHPATH(1:LP),FILES,KEYS,NFOUND,MAXFIL,IRC)
- OLDNAM = ' '
- LOLD = 1
- IF(INDEX(CHOPT,'I').NE.0) THEN
- IF(IDEBFA.EQ.3) PRINT *,'FMSEAC. sorting file names...'
- CALL FMSORT(FILES,KEYS,NFOUND,JSORT,IC)
- ENDIF
- IWIDTH = 0
- JWIDTH = 78
- IF(INDEX(CHOPT,'1').NE.0) JWIDTH = 132
- DO 200 I=1,NFOUND
- IF(INDEX(CHOPT,'I').NE.0) THEN
- J = JSORT(I)
- ELSE
- J = I
- ENDIF
- GENAM = FILES(J)
- LFILE = LENOCC(GENAM)
- IF(IDEBFA.GE.3) PRINT *,'FMSEAC. GENAM = ',GENAM(1:LFILE)
- IF(IDEBFA.GE.3) PRINT *,'FMSEAC. OLDNAM = ',OLDNAM(1:LOLD)
- IF(INDEX(CHOPT,'X').NE.0) THEN
- IF(GENAM.EQ.OLDNAM) GOTO 200
- ENDIF
- ISLASH = INDEXB(OLDNAM(1:LOLD),'/')
- JSLASH = INDEXB(GENAM(1:LFILE),'/')
- CHFILE = GENAM(JSLASH+1:LFILE)
- LF = LENOCC(CHFILE)
-
- IF(GENAM(1:JSLASH-1).NE.OLDWD(1:LOLDWD)) THEN
- IF(IDEBFA.GE.0)
- + PRINT *,'Searching directory ',GENAM(1:JSLASH-1)
- OLDWD = GENAM(1:JSLASH-1)
- LOLDWD = JSLASH-1
- ENDIF
- CALL FMATCH(CHFILE(1:LF),MATCH(1:LM),IMAT)
- IF(IMAT.NE.0) GOTO 200
-*
-* Check that keys match those selected
-* Location code:
-*
- IF(NUMLOC.GT.0) THEN
- IF(IUCOMP(KEYS(MKLCFA,J),MFMLOC,NUMLOC).EQ.0) THEN
- IF(IDEBFA.GE.3) PRINT *,'FMLSC. candidate # ',J,
- + ' fails location code check'
- GOTO 200
- ENDIF
- ENDIF
-*
-* Copy level:
-*
- IF(NUMCPL.GT.0) THEN
- IF(IUCOMP(KEYS(MKCLFA,J),MFMCPL,NUMCPL).EQ.0) THEN
- IF(IDEBFA.GE.3) PRINT *,'FMLSC. candidate # ',J,
- + ' fails copy level check'
- GOTO 200
- ENDIF
- ENDIF
-*
-* Media type:
-*
- IF(NUMMTP.GT.0) THEN
- IF(IUCOMP(KEYS(MKMTFA,J),MFMMTP,NUMMTP).EQ.0) THEN
- IF(IDEBFA.GE.3) PRINT *,'FMLSC. candidate # ',J,
- + ' fails media type check'
- GOTO 200
- ENDIF
- ENDIF
-
- LBANK=0
- IF(INDEX(CHOPT,'X').NE.0) THEN
-*
-* Option X - display each entry only once
-* Display entry chosen by current selection unless not found
-*
- CALL UCOPY(KEYS(1,J),KEYSAV,10)
- CALL FMGET(GENAM,LBANK,KEYS(1,J),IC)
- IF(IC.NE.0) THEN
- IF(IDEBFA.GE.0) PRINT *,'FMSEAC. ** Warning. ** ',
- + 'No match with current selection criteria for ',
- + CHFILE(1:LF)
- CALL UCOPY(KEYSAV,KEYS(1,J),10)
- ENDIF
- LBANK=0
- ENDIF
-*
-* Now check if this entry matches
-*
- CALL FMSEAR(GENAM,LBANK,KEYS(1,J),DSN,HOST,VID,USER,IRET)
- IF(IRET.NE.0) THEN
- CALL MZDROP(IXSTOR,LBANK,' ')
- LBANK = 0
- GOTO 200
- ENDIF
- NFILES = NFILES + 1
-
- IF(INDEX(CHOPT,'W').NE.0) THEN
- IF(OLDNAM(1:JSLASH-1).NE.GENAM(1:ISLASH-1)) THEN
- IF(IWIDTH.GT.0) THEN
- WRITE(LWRITE,'(1X,A)') CARD(1:IWIDTH)
- IWIDTH = 0
- ENDIF
- WRITE(LWRITE,*)
- WRITE(LWRITE,8001) GENAM(1:JSLASH-1)
- WRITE(LWRITE,*)
- 8001 FORMAT(' Directory :',A)
- ENDIF
-*
-* Just display file names across the terminal...
-*
- IF(IWIDTH+LF.GE.JWIDTH) THEN
-* flush current buffer
- WRITE(LWRITE,'(1X,A)') CARD(1:IWIDTH)
- IWIDTH = 0
- ENDIF
- IF(IWIDTH.EQ.0) THEN
- CARD = CHFILE(1:LF) // ' '
- ELSE
- CARD = CARD(1:IWIDTH) // CHFILE(1:LF) // ' '
- ENDIF
- IWIDTH = IWIDTH + LF + 1
- ELSE
- CALL FMSHOW(GENAM,LBANK,KEYS(1,J),CHOPT(1:LCHOPT),IRC)
- CALL MZDROP(IXSTOR,LBANK,' ')
- LBANK = 0
- ENDIF
- OLDNAM = GENAM
- LOLD = LFILE
- IF((NFILES.EQ.NMATCH).AND.(NMATCH.NE.0)) THEN
- IF(INDEX(CHOPT,'W').NE.0)
- + WRITE(LWRITE,'(1X,A)') CARD(1:IWIDTH)
- IF(IDEBFA.GE.-3) PRINT *,'FMSEAC. stopping after ',
- + NFILES,' matches'
- GOTO 400
- ENDIF
- 200 CONTINUE
- 300 CONTINUE
- IF(INDEX(CHOPT,'W').NE.0) WRITE(LWRITE,'(1X,A)') CARD(1:IWIDTH)
-
- IF(JCONT.NE.0) GOTO 1
-
- 400 CONTINUE
-
- IF(INDEX(CHOPT,'D').NE.0) THEN
- PRINT *,NFILES,' candidates for deletion'
- ELSE
- IF(IDEBFA.GE.-2) THEN
-
- WRITE(LWRITE,'(A)') ' '
- IF(NFILES .EQ. 0) THEN
- WRITE(LWRITE,8016)
- 8016 FORMAT(' No matches found')
- ELSE
- WRITE(LWRITE,8017) NFILES
- 8017 FORMAT(' Matches:',I5)
- ENDIF
- ENDIF
- ENDIF
-
- INQUIRE(3,OPENED=IOPEN)
- IF(IOPEN) CLOSE(3)
- CALL FACDIR(PREDIR,' ')
- RETURN
- END
diff --git a/src/packlib/fatmen/unref/fmselk.F b/src/packlib/fatmen/unref/fmselk.F
deleted file mode 100644
index 9a39362..0000000
--- a/src/packlib/fatmen/unref/fmselk.F
+++ /dev/null
@@ -1,126 +0,0 @@
-*
-* $Id: fmselk.F,v 1.1.1.1 1996/03/07 15:18:24 mclareni Exp $
-*
-* $Log: fmselk.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:24 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
- SUBROUTINE FMSELK(GENAM,KEYSIN,KEYSOU,NDONE,MAXKEY,IRC)
-*
-* This subroutine matches the input key vector KEYSIN
-* against the keys in the directory specified by the
-* the generic name GENAM. A maximum of MAXKEY key vectors
-* are returned in the arrary KEYSOU. NDONE returns the
-* actual number of vectors returned.
-* IRC =-1 invalid pathname
-* = 0 success
-* = 1 more than NMAX files in CWD
-* IQUEST(11) = number of matching files in CWD
-* IQUEST(12) = total number of files in CWD
-*
-#include "fatmen/fatpara.inc"
-#include "fatmen/fatbank.inc"
- CHARACTER*(*) GENAM
- CHARACTER*255 PATH
- CHARACTER*20 FNAME
- PARAMETER (LKEYFA=10)
-*
-* NMAX limits the maximum number of keys that can be processed
-* in a single call to FMKEYS
-*
- PARAMETER (NMAX=100)
- DIMENSION KEYS(LKEYFA),MYVECT(LKEYFA)
- DIMENSION KEYSIN(LKEYFA),KEYSOU(LKEYFA,MAXKEY)
- DIMENSION MYKEYS(LKEYFA,NMAX)
-
- IRC = 0
-*
-* Convert generic name to upper case
-*
- CALL CLTOU(GENAM)
-*
-* Save current directory
-*
- CALL FACDIR(PATH,'R')
-*
-* Reset current directory
-*
- LGEN = INDEXB(GENAM,'/')
- CALL FACDIR(GENAM(1:LGEN-1),' ')
-
- IF(IQUEST(1) .NE. 0) THEN
- IRC = -1
- GOTO 999
- ENDIF
-*
-* Build compare vector
-*
- CALL VZERO(MYVECT,LKEYFA)
- CALL UCOPY(KEYSIN(MKCLFA),MYVECT(MKCLFA),LKEYFA-MKCLFA+1)
- IFIRST = 1
- ILAST = NMAX
- NDONE = 0
- NMATCH = 0
-*
-* *** Find file name
-*
- NCH = LENOCC(GENAM)
- FNAME = GENAM(LGEN+1:NCH)
- CALL VBLANK(MYVECT(2),5)
- CALL UCTOH(FNAME,MYVECT(2),4,MIN(NCH-LGEN,20))
- IF(IDEBFA.GE.3) PRINT *,'FMSELK. enter for ',GENAM(1:NCH)
- IF(IDEBFA.GE.3) CALL FMPKEY(MYVECT,LKEYFA)
-1 CONTINUE
- CALL FMKEYS(LKEYFA,NMAX,IFIRST,ILAST,MYKEYS,NFILES,IRET)
- NKEYS = IQUEST(11)
- IF(IQUEST(1) .NE. 0) THEN
- IF(IDEBFA.GE.2)
- + PRINT *,'FMSELK. More than ',NMAX,' files in ',GENAM(1:LGEN-1)
- IF(IDEBFA.GE.2)
- + PRINT *,'FMSELK. IQUEST(11-12) = ',IQUEST(11),IQUEST(12)
- ENDIF
-*
-* Process all keys returned and move those that match to KEYSOU
-*
- NRET = IQUEST(13)
- DO 10 I=1,NRET
-*
-* Check file name, media type, copy level and location code
-* (essentially just keys(2-9)
-*
- IF(IDEBFA.GE.3) THEN
- PRINT *,'FMSELK. candidate # ',I
- CALL FMPKEY(MYKEYS(1,I),LKEYFA)
- ENDIF
- DO 20 J=MKFNFA,MKLCFA
-*
-* Don't compare negative fields
-*
- IF((MYVECT(J) .LT. 0) .AND. (J.GE.MKCLFA)) GOTO 20
- IF(MYVECT(J) .NE. MYKEYS(J,I)) GOTO 10
-20 CONTINUE
-*
-* Can we accept any more keys?
-*
- NMATCH = NMATCH + 1
- IF(NDONE .LT. MAXKEY) THEN
- NDONE = NDONE + 1
- CALL UCOPY(MYKEYS(1,I),KEYSOU(1,NDONE),LKEYFA)
- ELSE
- IRC = 1
- ENDIF
-
-10 CONTINUE
- IF(ILAST.LT.NKEYS) THEN
- IFIRST = IFIRST + NMAX
- ILAST = MIN(NKEYS,ILAST+NMAX)
- GOTO 1
- ENDIF
-
-999 CALL FACDIR(PATH(1:LENOCC(PATH)),' ')
- IQUEST(11) = NMATCH
- IQUEST(12) = NKEYS
- END
-
diff --git a/src/packlib/fatmen/unref/getenv.F b/src/packlib/fatmen/unref/getenv.F
deleted file mode 100644
index 7c6cdd3..0000000
--- a/src/packlib/fatmen/unref/getenv.F
+++ /dev/null
@@ -1,84 +0,0 @@
-*
-* $Id: getenv.F,v 1.1.1.1 1996/03/07 15:18:23 mclareni Exp $
-*
-* $Log: getenv.F,v $
-* Revision 1.1.1.1 1996/03/07 15:18:23 mclareni
-* Fatmen
-*
-*
-#include "fatmen/pilot.h"
-#if !defined(CERNLIB_CRAY)
-/*
-++++++++++++++++++++++++++++++APOGE
-.type: module
-.language: C
-.ident: Fortran interface to getenv for apollo
-.version: 1.0 - 90-05-19
-.envir: DomainIX
-.uses: libc
-.author: J. Shiers, Defert Ph.,
-.keywords: Environment variable
-.descript: Get the value of an environment variable
-------------------------------------------------------------------
-*/
-/*
--- external declarations
-*/
-#include <stdio.h>
-#include <string.h>
-#include <errno.h>
-extern char* calloc();
-extern char* getenv();
-/*
--- body
-*/
-#define EV_OK ((int)0)
-#define EV_NOEXIST ((int)1)
-#define EV_MALLOC ((int)2)
-
-int fmgenv(envvar,envval,varlen,vallen)
-char *envvar;
-char *envval;
-int varlen;
-int vallen;
-/*
-++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-.input: envvar,varlen: fortran string descriptor -> the name of the
- variable
-.output:
-.returns: status of the call (EV_OK,EV_NOEXIST,EV_MALLOC)
-.type: function
-.description: Get the value of an environment variable
-------------------------------------------------------------------------------
-*/
-{
- char *cenvvar;
- char *cenvval;
- char *p;
- int i;
-/*
--- conversion of fortran input to c
-*/
- cenvvar = calloc(varlen+1, sizeof(char));
- if (cenvvar == NULL) return(EV_MALLOC);
- strncpy(cenvvar,envvar,varlen);
- cenvvar[varlen] = '\0';
- p = strchr(cenvvar,' ');
- if (p) *p = '\0';
-/*
--- call to the real c function
-*/
- errno = 0;
- cenvval = getenv(cenvvar);
- if (cenvvar) free(cenvvar);
-/*
--- checks returned pointer
-*/
- if (envval == NULL)
- return(EV_NOEXIST);
- strncpy(envval,cenvval,vallen);
- for (i = strlen(cenvval); i < vallen ; i++)
- envval[i] = ' ';
- return(EV_OK);
-}
-#endif
diff --git a/src/packlib/ffread/Imakefile b/src/packlib/ffread/Imakefile
deleted file mode 100644
index 251076d..0000000
--- a/src/packlib/ffread/Imakefile
+++ /dev/null
@@ -1,15 +0,0 @@
-
-#define IHaveSubdirs
-#define PassCDebugFlags
-
-AllTarget(libraries)
-
-SUBDIRS= sffread test ffread
-
-TopOfPackage(ffread)
-
-SubdirLibraryTarget(ffread,sffread)
-
-TestSubdirs(test)
-
-InstallIncludeSubdirs(ffread)
diff --git a/src/packlib/ffread/ffread/Imakefile b/src/packlib/ffread/ffread/Imakefile
deleted file mode 100644
index 05ca3e1..0000000
--- a/src/packlib/ffread/ffread/Imakefile
+++ /dev/null
@@ -1,5 +0,0 @@
-INCLUDES= cfread.inc cfreadsv.inc ffchar.inc ffcharsv.inc \ @@\
- ffcomm.inc ffcommsv.inc ffluns.inc ffmach.inc ffparm.inc \ @@\
- pilot.h
-
-InstallIncludes($(INCLUDES),$(CERN_INCLUDEDIR),ffread)
diff --git a/src/packlib/ffread/ffread/cfread.inc b/src/packlib/ffread/ffread/cfread.inc
deleted file mode 100644
index 5aee5b8..0000000
--- a/src/packlib/ffread/ffread/cfread.inc
+++ /dev/null
@@ -1,56 +0,0 @@
-*
-* $Id: cfread.inc,v 1.1.1.1 1996/03/08 11:50:41 mclareni Exp $
-*
-* $Log: cfread.inc,v $
-* Revision 1.1.1.1 1996/03/08 11:50:41 mclareni
-* Ffread
-*
-*
-#ifndef CERNLIB_FFREAD_CFREAD_INC
-#define CERNLIB_FFREAD_CFREAD_INC
-*
-*
-* cfread.inc
-*
-#include "ffread/ffparm.inc"
- COMMON /CFREAD/ NWORDS, NCHKEY, NWDKEY, NKEYS, MAXKEY,
- * NOFLEN, NOFTYP, NOFKEY,
- * LINPUT, LUNIN, LUNOUT,
- * ISTACK, LUNS(LSTACK),
- * IFFOPT(8), KEYOPT(3),
- * IWORDS(NCSIZE)
-#if defined(CERNLIB_SAVE)
-#include "ffread/cfreadsv.inc"
-#endif
- PARAMETER (NOFLOC = 0)
-C
-C Common CFREAD contains all information FFREAD knows about.
-C The variables contain the following:
-C
-C NWORDS - # of words available in array IWORDS for key storage
-C
-C NCHKEY - # of characters per key - default is four
-C NWDKEY - # of words per key
-C NKEYS - # of keys currently defined
-C MAXKEY - maximum # of keys IWORDS will hold, considering NCHKEY and NWORDS
-C
-C (NOFLOC)- offset for storage of addresses in IWORDS
-C (This is declared a parameter, as it is implicitly 0.)
-C NOFLEN - ditto for array lengths
-C NOFTYP - ditto for type field
-C NOFKEY - ditto for keys
-C
-C LINPUT - # of significant characters on data card
-C LUNIN - unit number for reading
-C LUNOUT - unit number for output
-C
-C IFFOPT - character options for FFGET/FFSET
-C KEYOPT - character options for FFKEY
-C
-C ISTACK - stack pointer into LUNS()
-C LUNS() - stack for reading from files
-C
-C IWORDS - storage for keys, value locations, their length, and their type.
-C
-
-#endif
diff --git a/src/packlib/ffread/ffread/cfreadsv.inc b/src/packlib/ffread/ffread/cfreadsv.inc
deleted file mode 100644
index 01b75ae..0000000
--- a/src/packlib/ffread/ffread/cfreadsv.inc
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: cfreadsv.inc,v 1.1.1.1 1996/03/08 11:50:41 mclareni Exp $
-*
-* $Log: cfreadsv.inc,v $
-* Revision 1.1.1.1 1996/03/08 11:50:41 mclareni
-* Ffread
-*
-*
-#ifndef CERNLIB_FFREAD_CFREADSV_INC
-#define CERNLIB_FFREAD_CFREADSV_INC
-*
-*
-* cfreadsv.inc
-*
- SAVE /CFREAD/
-
-#endif
diff --git a/src/packlib/ffread/ffread/ffchar.inc b/src/packlib/ffread/ffread/ffchar.inc
deleted file mode 100644
index ad3b122..0000000
--- a/src/packlib/ffread/ffread/ffchar.inc
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: ffchar.inc,v 1.1.1.1 1996/03/08 11:50:41 mclareni Exp $
-*
-* $Log: ffchar.inc,v $
-* Revision 1.1.1.1 1996/03/08 11:50:41 mclareni
-* Ffread
-*
-*
-#ifndef CERNLIB_FFREAD_FFCHAR_INC
-#define CERNLIB_FFREAD_FFCHAR_INC
-*
-*
-* ffchar.inc
-*
- COMMON /FFCHAR/ BUFFER
- CHARACTER*(LENMAX) BUFFER
-#if defined(CERNLIB_SAVE)
-#include "ffread/ffcharsv.inc"
-#endif
-C
-C FFCHAR is a character string which contains the input data card
-C
-
-#endif
diff --git a/src/packlib/ffread/ffread/ffcharsv.inc b/src/packlib/ffread/ffread/ffcharsv.inc
deleted file mode 100644
index cf24b50..0000000
--- a/src/packlib/ffread/ffread/ffcharsv.inc
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: ffcharsv.inc,v 1.1.1.1 1996/03/08 11:50:41 mclareni Exp $
-*
-* $Log: ffcharsv.inc,v $
-* Revision 1.1.1.1 1996/03/08 11:50:41 mclareni
-* Ffread
-*
-*
-#ifndef CERNLIB_FFREAD_FFCHARSV_INC
-#define CERNLIB_FFREAD_FFCHARSV_INC
-*
-*
-* ffcharsv.inc
-*
- SAVE /FFCHAR/
-
-#endif
diff --git a/src/packlib/ffread/ffread/ffcomm.inc b/src/packlib/ffread/ffread/ffcomm.inc
deleted file mode 100644
index 2d786c6..0000000
--- a/src/packlib/ffread/ffread/ffcomm.inc
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: ffcomm.inc,v 1.1.1.1 1996/03/08 11:50:41 mclareni Exp $
-*
-* $Log: ffcomm.inc,v $
-* Revision 1.1.1.1 1996/03/08 11:50:41 mclareni
-* Ffread
-*
-*
-#ifndef CERNLIB_FFREAD_FFCOMM_INC
-#define CERNLIB_FFREAD_FFCOMM_INC
-*
-*
-* ffcomm.inc
-*
- PARAMETER (NFJUMP=99)
- COMMON /FFCOMM/ FFFLAG, KUJUMP, KFJUMP(NFJUMP)
-#if defined(CERNLIB_SAVE)
-#include "ffread/ffcommsv.inc"
-#endif
-C
-C FFFLAG gives the number of errors that occured during reading of
-C the data cards.
-C
-
-#endif
diff --git a/src/packlib/ffread/ffread/ffcommsv.inc b/src/packlib/ffread/ffread/ffcommsv.inc
deleted file mode 100644
index 154fa3b..0000000
--- a/src/packlib/ffread/ffread/ffcommsv.inc
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: ffcommsv.inc,v 1.1.1.1 1996/03/08 11:50:41 mclareni Exp $
-*
-* $Log: ffcommsv.inc,v $
-* Revision 1.1.1.1 1996/03/08 11:50:41 mclareni
-* Ffread
-*
-*
-#ifndef CERNLIB_FFREAD_FFCOMMSV_INC
-#define CERNLIB_FFREAD_FFCOMMSV_INC
-*
-*
-* ffcommsv.inc
-*
- SAVE /FFCOMM/
-
-#endif
diff --git a/src/packlib/ffread/ffread/ffluns.inc b/src/packlib/ffread/ffread/ffluns.inc
deleted file mode 100644
index c95b472..0000000
--- a/src/packlib/ffread/ffread/ffluns.inc
+++ /dev/null
@@ -1,36 +0,0 @@
-*
-* $Id: ffluns.inc,v 1.1.1.1 1996/03/08 11:50:40 mclareni Exp $
-*
-* $Log: ffluns.inc,v $
-* Revision 1.1.1.1 1996/03/08 11:50:40 mclareni
-* Ffread
-*
-*
-#ifndef CERNLIB_FFREAD_FFLUNS_INC
-#define CERNLIB_FFREAD_FFLUNS_INC
-*
-*
-* ffluns.inc
-*
-#if defined(CERNLIB_CDC)
- PARAMETER (LUNDIN = L"INPUT" ,
- * LUNDUT = L"OUTPUT",
- * LUNMAX = 99)
-#endif
-#if defined(CERNLIB_LUNF77)
- PARAMETER (LUNDIN = 5,
- * LUNDUT = 6,
- * LUNMAX = 99)
-#endif
-#if defined(CERNLIB_VAX)||defined(CERNLIB_DECS)
- PARAMETER (LUNDIN = 5,
- * LUNDUT = 6,
- * LUNMAX = 119)
-#endif
-C
-C LUNDIN - default input LUN
-C LUNDUT - default output LUN
-C LUNMAX - maximum LUN allowed
-C
-
-#endif
diff --git a/src/packlib/ffread/ffread/ffmach.inc b/src/packlib/ffread/ffread/ffmach.inc
deleted file mode 100644
index 1342303..0000000
--- a/src/packlib/ffread/ffread/ffmach.inc
+++ /dev/null
@@ -1,46 +0,0 @@
-*
-* $Id: ffmach.inc,v 1.1.1.1 1996/03/08 11:50:40 mclareni Exp $
-*
-* $Log: ffmach.inc,v $
-* Revision 1.1.1.1 1996/03/08 11:50:40 mclareni
-* Ffread
-*
-*
-#ifndef CERNLIB_FFREAD_FFMACH_INC
-#define CERNLIB_FFREAD_FFMACH_INC
-*
-*
-* ffmach.inc
-*
-#if defined(CERNLIB_DOUBLE)
- PARAMETER (NCHWD = 4,
- * NBITCH = 8,
- * NBITWD = 32,
- * IQANIL = -77)
-#endif
-#if (defined(CERNLIB_SINGLE))&&(!defined(CERNLIB_CDC))
- PARAMETER (NCHWD = 8,
- * NBITCH = 8,
- * NBITWD = 64,
- * IQANIL = -77)
-#endif
-#if defined(CERNLIB_CDC)
- PARAMETER (NCHWD = 10,
- * NBITCH = 6,
- * NBITWD = 60,
- * IQANIL = -77)
-#endif
-#if defined(CERNLIB_UNIVAC)
- PARAMETER (NCHWD = 4,
- * NBITCH = 9,
- * NBITWD = 36,
- * IQANIL = -77)
-#endif
-C
-C NCHWD - # of characters per word
-C NBITCH - # of bits per character
-C NBITWD - # of bits per word
-C IQANIL - # weard address for the user routine
-C
-
-#endif
diff --git a/src/packlib/ffread/ffread/ffparm.inc b/src/packlib/ffread/ffread/ffparm.inc
deleted file mode 100644
index ff34f72..0000000
--- a/src/packlib/ffread/ffread/ffparm.inc
+++ /dev/null
@@ -1,39 +0,0 @@
-*
-* $Id: ffparm.inc,v 1.1.1.1 1996/03/08 11:50:40 mclareni Exp $
-*
-* $Log: ffparm.inc,v $
-* Revision 1.1.1.1 1996/03/08 11:50:40 mclareni
-* Ffread
-*
-*
-#ifndef CERNLIB_FFREAD_FFPARM_INC
-#define CERNLIB_FFREAD_FFPARM_INC
-*
-*
-* ffparm.inc
-*
- PARAMETER (NCHKYD = 4,
- * NCHMAX = 32,
- * LENMIN = 72,
- * LENDEF = 80,
- * LENMAX = 132,
- * LSTACK = 20,
- * NCSIZE = 500,
- * NKYOVH = 3,
- * NOVERH = 23 + LSTACK)
-C
-C NCHKYD - default key size in characters
-C NCHMAX - maximum key size in characters
-C LENMIN - minimum significant length of data card
-C LENDEF - default significant length of data card
-C LENMAX - maximum significant length of data card
-C LSTACK - size of input LUN stack
-C NCSIZE - default size of IWORDS
-C NKYOVH - overhead per key in words (in addition to NWDKEY)
-C NOVERH - words in common CFREAD before IWORDS
-C
-C NB: If NCHMAX or LSTACK are changed, also modify the length of
-C the variable BLANK in FFGO to be MAX(LSTACK+2, NCHMAX-6).
-C
-
-#endif
diff --git a/src/packlib/ffread/ffread/pilot.h b/src/packlib/ffread/ffread/pilot.h
deleted file mode 100644
index fa9982d..0000000
--- a/src/packlib/ffread/ffread/pilot.h
+++ /dev/null
@@ -1,39 +0,0 @@
-*
-* $Id: pilot.h,v 1.1.1.1 1996/03/08 11:50:41 mclareni Exp $
-*
-* $Log: pilot.h,v $
-* Revision 1.1.1.1 1996/03/08 11:50:41 mclareni
-* Ffread
-*
-*
-#ifndef CERNLIB_UNIX
-#define CERNLIB_UNIX
-#endif
-
-#if (defined(CERNLIB_UNIX))&&(!defined(CERNLIB_SINGLE))
-#ifndef CERNLIB_DOUBLE
-#define CERNLIB_DOUBLE
-#endif
-#endif
-
-#if defined(CERNLIB_UNIX)
-#ifndef CERNLIB_SAVE
-#define CERNLIB_SAVE
-#endif
-#endif
-
-#ifndef CERNLIB_UPLOW
-#define CERNLIB_UPLOW
-#endif
-
-#if defined(CERNLIB_VAX)||defined(CERNLIB_DECS)
-#ifndef CERNLIB_TABS
-#define CERNLIB_TABS
-#endif
-#endif
-
-#if (!defined(CERNLIB_VAX))&&(!defined(CERNLIB_CDC))&&(!defined(CERNLIB_DECS))
-#ifndef CERNLIB_LUNF77
-#define CERNLIB_LUNF77
-#endif
-#endif
diff --git a/src/packlib/ffread/sffread/Imakefile b/src/packlib/ffread/sffread/Imakefile
deleted file mode 100644
index edfaa85..0000000
--- a/src/packlib/ffread/sffread/Imakefile
+++ /dev/null
@@ -1,5 +0,0 @@
-SRCS_F= \ @@\
- ffcard.F fffind.F ffget.F ffgo.F ffinit.F ffkey.F ffread.F ffrset.F \ @@\
- ffset.F ffskip.F ffupca.F ffuser.F ffuset.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/ffread/sffread/ffcard.F b/src/packlib/ffread/sffread/ffcard.F
deleted file mode 100644
index 3ee38be..0000000
--- a/src/packlib/ffread/sffread/ffcard.F
+++ /dev/null
@@ -1,412 +0,0 @@
-*
-* $Id: ffcard.F,v 1.1.1.1 1996/03/08 11:50:41 mclareni Exp $
-*
-* $Log: ffcard.F,v $
-* Revision 1.1.1.1 1996/03/08 11:50:41 mclareni
-* Ffread
-*
-*
-#include "ffread/pilot.h"
-#if defined(CERNLIB_MACMPW)
-!!S SEG_FFCARD
-#endif
- SUBROUTINE FFCARD (BUFFER, KURIN, ISYMB, KUROUT, LENGTH, IVALUE)
-C
-C FUNCTIONAL DESCRIPTION:
-C
-C This routine scans the string given in BUFFER for
-C tokens. These are integer or floating point numbers
-C or alphanumeric symbols.
-C
-C DUMMY ARGUMENTS:
-C
-C BUFFER - passed length character string containing
-C line to be parsed.
-C KURIN - position in BUFFER to start scan
-C ISYMB - type of token found. Values are:
-C 1 - text (IVALUE undefined)
-C 2 - a special character (IVALUE undefined)
-C 3 - an integer number
-C 4 - a floating point number
-C 5 - a logical value - allowed are:
-C T, TRUE, and ON for .TRUE.
-C F, FALS(E), and OFF for .FALSE.
-C 6 - no token found up to end of string.
-C In this case, the other output
-C parameters are undefined.
-C KUROUT - position in BUFFER token starts
-C LENGTH - length of token found
-C IVALUE - value associated with token if ISYMB = 3, 4, 5
-C
-C IMPLICIT INPUTS:
-C
-C NONE
-C
-C IMPLICIT OUTPUTS:
-C
-C NONE
-C
-C SIDE EFFECTS:
-C
-C NONE
-C
-#include "ffread/cfread.inc"
- CHARACTER BUFFER*(*)
-
- CHARACTER*(*) ALPHA, DIGITS, SPECAL
- PARAMETER (SPECAL = '*''=$()"/')
- PARAMETER (DIGITS = '1234567890')
-#if defined(CERNLIB_UPLOW)
- PARAMETER (ALPHA =
- * 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz')
-
- CHARACTER CHECK*5
-#endif
-#if !defined(CERNLIB_UPLOW)
- PARAMETER (ALPHA = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ')
-#endif
-
- LOGICAL LVALU
- EQUIVALENCE (IVALU, RVALU, LVALU)
-C
-C----------------- Beginning of executable statements -------------------------
-C
-C Reset some variables to default values
-C
- ISYMB = 0
- IVALU = 0
- IEXP = 0
- ISGNVA = 1
- ISGNEX = 1
- MANTIS = 0
- MANLEN = 0
-
- ICUR = KURIN - 1
- IMAX = LEN (BUFFER)
-C
-C Loop over all characters remaining
-C
- 100 ICUR = ICUR + 1
- IF (ICUR .GT. IMAX) GO TO 200
- GO TO (1, 11, 201, 31, 41), ISYMB + 1
- GO TO 201
-C
-C We have no idea what to expect - so throw blanks etc. away
-C
- 1 IF (BUFFER(ICUR:ICUR) .EQ. ' '
-#if defined(CERNLIB_TABS)
- * .OR. ICHAR (BUFFER(ICUR:ICUR)) .EQ. 9
-#endif
- * ) GO TO 100
-C
-C Check for a digit or decimal point
-C
-#if !defined(CERNLIB_VAX)
- ITMP1 = INDEX (DIGITS, BUFFER(ICUR:ICUR))
-#endif
-#if defined(CERNLIB_VAX)
- ITMP1 = LIB$LOCC (BUFFER(ICUR:ICUR), DIGITS)
-#endif
-
- IF (ITMP1 .NE. 0) THEN
- ISYMB = 3
- KUROUT = ICUR
- LENGTH = 1
- IF (ITMP1 .NE. 10) IVALU = ITMP1
- GO TO 100
- END IF
-
- IF (BUFFER(ICUR:ICUR) .EQ. '.') THEN
- ISYMB = 4
- KUROUT = ICUR
- LENGTH = 1
- IFIELD = 1
- GO TO 100
- END IF
-C
-C Check for unary + or -
-C
- IF (BUFFER(ICUR:ICUR) .EQ. '-') THEN
- ISGNVA = -1
- KUROUT = ICUR
- LENGTH = 1
- ISYMB = 3
- GO TO 100
- END IF
-
- IF (BUFFER(ICUR:ICUR) .EQ. '+') THEN
- ISYMB = 3
- KUROUT = ICUR
- LENGTH = 1
- GO TO 100
- END IF
-C
-C Check for text and special characters
-C
-#if !defined(CERNLIB_VAX)
- ITMP2 = INDEX (ALPHA, BUFFER(ICUR:ICUR))
-#endif
-#if defined(CERNLIB_VAX)
- ITMP2 = LIB$LOCC (BUFFER(ICUR:ICUR), ALPHA)
-#endif
- IF (ITMP2 .NE. 0) GO TO 10
-
-#if !defined(CERNLIB_VAX)
- ITMP2 = INDEX (SPECAL, BUFFER(ICUR:ICUR))
-#endif
-#if defined(CERNLIB_VAX)
- ITMP2 = LIB$LOCC (BUFFER(ICUR:ICUR), SPECAL)
-#endif
- IF (ITMP2 .NE. 0) GO TO 20
-C
-C Whatever this might be - we'll ignore it
-C
- GO TO 100
-C
-C Start up a text
-C
- 10 ISYMB = 1
- KUROUT = ICUR
- LENGTH = 1
- GO TO 100
-C
-C Continue with text.
-C If we find something else, check for logical constants.
-C
-#if !defined(CERNLIB_VAX)
- 11 ITMP3 = INDEX (ALPHA, BUFFER(ICUR:ICUR))
- IF (ITMP3 .EQ. 0)
- * ITMP3 = INDEX (DIGITS, BUFFER(ICUR:ICUR))
-#endif
-#if defined(CERNLIB_VAX)
- 11 ITMP3 = LIB$LOCC (BUFFER(ICUR:ICUR), ALPHA)
- IF (ITMP3 .EQ. 0)
- * ITMP3 = LIB$LOCC (BUFFER(ICUR:ICUR), DIGITS)
-#endif
-
- IF (ITMP3 .NE. 0) THEN
- LENGTH = LENGTH + 1
- GO TO 100
- END IF
-
- GO TO 210
-C
-C
-C Special character - that's easy
-C
- 20 ISYMB = 2
- KUROUT = ICUR
- LENGTH = 1
- RETURN
-C
-C Digit of integer; if decimal point, switch to real
-C
-#if !defined(CERNLIB_VAX)
- 31 ITMP4 = INDEX (DIGITS, BUFFER(ICUR:ICUR))
-#endif
-#if defined(CERNLIB_VAX)
- 31 ITMP4 = LIB$LOCC (BUFFER(ICUR:ICUR), DIGITS)
-#endif
-
- IF (ITMP4 .NE. 0) THEN
- LENGTH = LENGTH + 1
- IVALU = IVALU * 10
- IF (ITMP4 .NE. 10) IVALU = IVALU + ITMP4
- GO TO 100
- END IF
-
- IF (BUFFER(ICUR:ICUR) .EQ. '.') THEN
- ISYMB = 4
- LENGTH = LENGTH + 1
- IFIELD = 1
- GO TO 100
- END IF
-
-#if defined(CERNLIB_UPLOW)
- IF ( BUFFER(ICUR:ICUR) .EQ. 'E'
- * .OR. BUFFER(ICUR:ICUR) .EQ. 'e') THEN
- CALL FFUPCA (BUFFER, ICUR, 1)
-#endif
-#if !defined(CERNLIB_UPLOW)
- IF ( BUFFER(ICUR:ICUR) .EQ. 'E') THEN
-#endif
- ISYMB = 4
- LENGTH = LENGTH + 1
- IFIELD = 2
- GO TO 100
- END IF
-
- GO TO 230
-C
-C Real number: dispatch on current field
-C
- 41 GO TO (46, 47, 48), IFIELD
-C
-C Scanning fractional part - expect digit, 'E', or end
-C
-#if !defined(CERNLIB_VAX)
- 46 ITMP5 = INDEX (DIGITS, BUFFER(ICUR:ICUR))
-#endif
-#if defined(CERNLIB_VAX)
- 46 ITMP5 = LIB$LOCC (BUFFER(ICUR:ICUR), DIGITS)
-#endif
-
- IF (ITMP5 .NE. 0) THEN
- LENGTH = LENGTH + 1
- MANLEN = MANLEN + 1
- MANTIS = MANTIS * 10
- IF (ITMP5 .NE. 10) MANTIS = MANTIS + ITMP5
- GO TO 100
- END IF
-
-#if defined(CERNLIB_UPLOW)
- IF ( BUFFER(ICUR:ICUR) .EQ. 'E'
- * .OR. BUFFER(ICUR:ICUR) .EQ. 'e') THEN
- CALL FFUPCA (BUFFER, ICUR, 1)
-#endif
-#if !defined(CERNLIB_UPLOW)
- IF ( BUFFER(ICUR:ICUR) .EQ. 'E') THEN
-#endif
- LENGTH = LENGTH + 1
- IFIELD = 2
- GO TO 100
- END IF
-
- GO TO 240
-C
-C Last item was 'E'. Check for exponent sign
-C
- 47 IFIELD = 3
-
- IF (BUFFER(ICUR:ICUR) .EQ. '-') THEN
- ISGNEX = -1
- LENGTH = LENGTH + 1
- GO TO 100
- END IF
-
- IF (BUFFER(ICUR:ICUR) .EQ. '+') THEN
- LENGTH = LENGTH + 1
- GO TO 100
- END IF
-C
-C Scanning exponent field
-C
-#if !defined(CERNLIB_VAX)
- 48 ITMP6 = INDEX (DIGITS, BUFFER(ICUR:ICUR))
-#endif
-#if defined(CERNLIB_VAX)
- 48 ITMP6 = LIB$LOCC (BUFFER(ICUR:ICUR), DIGITS)
-#endif
-
- IF (ITMP6 .NE. 0) THEN
- LENGTH = LENGTH + 1
- IFIELD = 3
- IEXP = IEXP * 10
- IF (ITMP6 .NE. 10) IEXP = IEXP + ITMP6
- GO TO 100
- END IF
-
- GO TO 240
-C
-C We get here when the string is exhausted.
-C If ISYMB = 0, no token found.
-C If not, finish current token.
-C
- 200 IF (ISYMB .EQ. 0) THEN
- ISYMB = 6
- RETURN
- END IF
-
- GO TO (210, 201, 230, 240), ISYMB
-
- 201 WRITE(LUNOUT,'('' FFCARD INTERNAL CODING ERROR'')')
- STOP
-C
-C For text, check whether it's a logical constant
-C
- 210 IF (LENGTH .GT. 5) RETURN
-#if defined(CERNLIB_UPLOW)
- CHECK(1:LENGTH) = BUFFER(KUROUT:KUROUT+LENGTH-1)
- CALL FFUPCA (CHECK, 1, LENGTH)
-#endif
- GO TO (211, 212, 213, 214, 215), LENGTH
- GO TO 201
-
-#if defined(CERNLIB_UPLOW)
- 211 IF (CHECK(1:1) .EQ. 'T') GO TO 221
- IF (CHECK(1:1) .EQ. 'F') GO TO 222
-#endif
-#if !defined(CERNLIB_UPLOW)
- 211 IF (BUFFER(KUROUT:KUROUT) .EQ. 'T') GO TO 221
- IF (BUFFER(KUROUT:KUROUT) .EQ. 'F') GO TO 222
-#endif
- RETURN
-
-#if defined(CERNLIB_UPLOW)
- 212 IF (CHECK(1:2) .EQ. 'ON') GO TO 221
-#endif
-#if !defined(CERNLIB_UPLOW)
- 212 IF (BUFFER(KUROUT:KUROUT+1) .EQ. 'ON') GO TO 221
-#endif
- RETURN
-
-#if defined(CERNLIB_UPLOW)
- 213 IF (CHECK(1:3) .EQ. 'OFF') GO TO 222
-#endif
-#if !defined(CERNLIB_UPLOW)
- 213 IF (BUFFER(KUROUT:KUROUT+2) .EQ. 'OFF') GO TO 222
-#endif
- RETURN
-
-#if defined(CERNLIB_UPLOW)
- 214 IF (CHECK(1:4) .EQ. 'TRUE') GO TO 221
- IF (CHECK(1:4) .EQ. 'FALS') GO TO 222
-#endif
-#if !defined(CERNLIB_UPLOW)
- 214 IF (BUFFER(KUROUT:KUROUT+3) .EQ. 'TRUE') GO TO 221
- IF (BUFFER(KUROUT:KUROUT+3) .EQ. 'FALS') GO TO 222
-#endif
- RETURN
-
-#if defined(CERNLIB_UPLOW)
- 215 IF (CHECK(1:5) .EQ. 'FALSE') GO TO 222
-#endif
-#if !defined(CERNLIB_UPLOW)
- 215 IF (BUFFER(KUROUT:KUROUT+4) .EQ. 'FALSE') GO TO 222
-#endif
- RETURN
-C
-C Termination processing for logical constants
-C
- 221 LVALU = .TRUE.
- GO TO 223
-
- 222 LVALU = .FALSE.
-
- 223 ISYMB = 5
-#if defined(CERNLIB_UPLOW)
- BUFFER(KUROUT:KUROUT+LENGTH-1) = CHECK(1:LENGTH)
-#endif
- IVALUE = IVALU
- RETURN
-C
-C Termination processing for integers
-C
- 230 IVALUE = IVALU * ISGNVA
- RETURN
-C
-C Termination processing for floating point
-C
- 240 RVALU = REAL(IVALU)
-
- IF (MANLEN .NE. 0 .AND. MANTIS .NE. 0) THEN
- RVALU = RVALU + REAL(MANTIS) * 10.**(-MANLEN)
- END IF
-
- IF (ISGNVA .LT. 0) RVALU = - RVALU
- IF (IEXP .NE. 0) RVALU = RVALU * 10.**(IEXP*ISGNEX)
-
- IVALUE = IVALU
- RETURN
-
- END
diff --git a/src/packlib/ffread/sffread/fffind.F b/src/packlib/ffread/sffread/fffind.F
deleted file mode 100644
index a81c708..0000000
--- a/src/packlib/ffread/sffread/fffind.F
+++ /dev/null
@@ -1,75 +0,0 @@
-*
-* $Id: fffind.F,v 1.1.1.1 1996/03/08 11:50:41 mclareni Exp $
-*
-* $Log: fffind.F,v $
-* Revision 1.1.1.1 1996/03/08 11:50:41 mclareni
-* Ffread
-*
-*
-#include "ffread/pilot.h"
- INTEGER FUNCTION FFFIND (NEWSTR)
-C
-C FUNCTIONAL DESCRIPTION:
-C
-C This function searches all keys in common CFREAD
-C for a match with the key in NEWSTR.
-C
-C DUMMY ARGUMENTS:
-C
-C NEWSTR contains the character string to compare the keys with.
-C
-C IMPLICIT INPUTS:
-C
-C The key list in common CFREAD. Comparison is made up
-C to the length specified by NCHKEY.
-C
-C IMPLICIT OUTPUTS:
-C
-C NONE
-C
-C FUNCTION VALUE:
-C
-C If the key in NEWSTR is found in the list, the index
-C is returned. If the key is not found, the negative index
-C of the key value which would follow this key is returned.
-C This is used for insertion of keys.
-C
-C SIDE EFFECTS:
-C
-C NONE
-C
-#include "ffread/ffmach.inc"
-#include "ffread/cfread.inc"
- CHARACTER NEWSTR*(*)
- CHARACTER COMPAR*(NCHMAX), OLDSTR*(NCHMAX)
-C
-C Loop over all keys to find given one.
-C In case of no keys, the loop isn't executed and
-C the statement after the loop is correct.
-C
- COMPAR(1:NCHKEY) = NEWSTR
- DO 1 I = 1, NKEYS
- CALL UHTOC (IWORDS(NOFKEY+I*NWDKEY), NCHWD, OLDSTR, NCHKEY)
- IF (LGT (COMPAR(1:NCHKEY), OLDSTR(1:NCHKEY)) ) GO TO 1
- IF (LLT (COMPAR(1:NCHKEY), OLDSTR(1:NCHKEY)) ) GO TO 2
-C
-C Found a match - return its index
-C
- FFFIND = I
- RETURN
-C
-C Step to next key
-C
- 1 CONTINUE
-C
-C No match, this key comes after the last known key
-C
- FFFIND = - (NKEYS+1)
- RETURN
-C
-C No match, return index of next higher key for insertion
-C
- 2 FFFIND = - I
- RETURN
-
- END
diff --git a/src/packlib/ffread/sffread/ffget.F b/src/packlib/ffread/sffread/ffget.F
deleted file mode 100644
index 5fa3ea2..0000000
--- a/src/packlib/ffread/sffread/ffget.F
+++ /dev/null
@@ -1,85 +0,0 @@
-*
-* $Id: ffget.F,v 1.1.1.1 1996/03/08 11:50:41 mclareni Exp $
-*
-* $Log: ffget.F,v $
-* Revision 1.1.1.1 1996/03/08 11:50:41 mclareni
-* Ffread
-*
-*
-#include "ffread/pilot.h"
- SUBROUTINE FFGET (CHOPT, IVALUE)
-C
-C FUNCTIONAL DESCRIPTION:
-C
-C This routine returns certain internal parameters of FFREAD.
-C
-C DUMMY ARGUMENTS:
-C
-C CHOPT - character string specifying which item is requested.
-C Possible values are:
-C LENG - # of significant characters on data card
-C LINP - LUN for input
-C LOUT - LUN for output
-C NBIT - # of bits per word -
-C NCHW - # of characters per word ) machine constants
-C NBCH - # of bits per character -
-C NCHK - # of characters per key
-C IVALUE - integer value corresponding to requested item
-C
-C IMPLICIT INPUTS:
-C
-C For CHOPT = LENG, LINP, LOUT, or NCHK, the corresponding
-C values from common CFREAD.
-C The other values are machine-dependant constants.
-C
-C IMPLICIT OUTPUTS:
-C
-C NONE
-C
-C SIDE EFFECTS:
-C
-C NONE
-C
-#include "ffread/ffmach.inc"
-#include "ffread/ffluns.inc"
-#include "ffread/cfread.inc"
- CHARACTER CHOPT*(*)
-C
-C----------------- Beginning of executable statements -------------------------
-C
-C Check option and dispatch on it
-C
- CALL UCTOH (CHOPT, NCHOPT, NCHWD, MIN (LEN (CHOPT), 4) )
- IOPT = IUCOMP (NCHOPT, IFFOPT(2), 7)
- GO TO (1, 2, 3, 4, 5, 6, 7), IOPT
-C
-C Unknown option
-C
- WRITE (UNIT=LUNOUT, FMT=1001) NCHOPT
- RETURN
-
- 1 IVALUE = LINPUT
- RETURN
-
- 2 IVALUE = LUNIN
- RETURN
-
- 3 IVALUE = LUNOUT
- RETURN
-
- 4 IVALUE = NBITWD
- RETURN
-
- 5 IVALUE = NCHWD
- RETURN
-
- 6 IVALUE = NBITCH
- RETURN
-
- 7 IVALUE = NCHKEY
- RETURN
-
-1001 FORMAT
- * (' FFGET --- UNRECOGNIZED OPTION ''', A4, ''' - TRY AGAIN')
-
- END
diff --git a/src/packlib/ffread/sffread/ffgo.F b/src/packlib/ffread/sffread/ffgo.F
deleted file mode 100644
index c32bbfb..0000000
--- a/src/packlib/ffread/sffread/ffgo.F
+++ /dev/null
@@ -1,829 +0,0 @@
-*
-* $Id: ffgo.F,v 1.1.1.1 1996/03/08 11:50:42 mclareni Exp $
-*
-* $Log: ffgo.F,v $
-* Revision 1.1.1.1 1996/03/08 11:50:42 mclareni
-* Ffread
-*
-*
-#include "ffread/pilot.h"
- SUBROUTINE FFGO
-C
-C FUNCTIONAL DESCRIPTION:
-C
-C This routine actually reads input from the specified
-C unit(s), interprets the data cards, and modifies the
-C corresponding variables.
-C
-C DUMMY ARGUMENTS:
-C
-C NONE
-C
-C IMPLICIT INPUTS:
-C
-C The common CFREAD contains the keys the user has defined.
-C Keywords LIST, NOLIST, READ, WRITE, END, STOP, KEYS, HOLL,
-C and C have predefined actions.
-C
-C IMPLICIT OUTPUTS:
-C
-C The variables given in the key definition are modified
-C as indicated on the data cards.
-C
-C SIDE EFFECTS:
-C
-C If the predefined command READ is given, an indirect input
-C file is opened and reading continues from this file.
-C
-#include "ffread/ffmach.inc"
-#include "ffread/ffluns.inc"
-#include "ffread/cfread.inc"
-#include "ffread/ffcomm.inc"
-#include "ffread/ffchar.inc"
- INTEGER FFFIND
-
- CHARACTER REST*(NCHWD-1), TXTSEP*1
-
- CHARACTER OUTBUF*116
-
- CHARACTER ERRHDR*48
- PARAMETER (ERRHDR =
- * ' -------------------- DATA CARD ERROR ----- ')
-
- CHARACTER BLANK*26
- INTEGER IBUF((NCHMAX+NCHWD-1)/NCHWD)
-#if defined(CERNLIB_UPLOW)
-
- CHARACTER CHECK*5
-#endif
-
- LOGICAL STRING, CALUSR, LISKEY, TITLE, LIST, STOP, SHIFT
-
- PARAMETER (IBFLEN = LENMAX/2)
- INTEGER LENBUF(IBFLEN), LOCBUF(IBFLEN)
- INTEGER IVALUS(IBFLEN)
- REAL RVALUS(IBFLEN)
- EQUIVALENCE (IVALUS(1), RVALUS(1)), (IVALUE, RVALUE)
-
- PARAMETER (NSYSKY = 10)
- CHARACTER SYSKEY(NSYSKY)*6
- INTEGER LKYMIN(NSYSKY), LKYMAX(NSYSKY)
-C
-C The fact that for END and STOP their index is their correct
-C length plus one is used at labels 150 and 907.
-C The index of system keys 2 to 4 is used at label 900.
-C
- DATA SYSKEY / 'C ', 'LIST ', 'READ ',
- * 'END ', 'STOP ', 'NOLIST',
- * 'WRITE ', 'HOLL ', 'KEYS ',
- * '* '/
- DATA LKYMIN / 1, 4, 4, 3, 4, 4, 4, 4, 4, 1 /,
- * LKYMAX / 2, 4, 4, 3, 4, 6, 5, 4, 4, 2 /
-
- DATA BLANK / ' ' /
-C
-C----------------- Beginning of executable statements -------------------------
-C
-C Check that we have at least one key
-C
- IF (NKEYS .LE. 0) THEN
- WRITE (UNIT=LUNOUT, FMT=1011)
- RETURN
- END IF
-C
-C Initialize some variables
-C LINPUT is copied to a local variable to aid compiler optimization.
-C
- LIST = .FALSE.
- TITLE = .FALSE.
- LISKEY = .FALSE.
- STRING = .FALSE.
- STOP = .FALSE.
- CALUSR = .FALSE.
- KURKEY = 0
- FFFLAG = 0.
- TXTSEP = ''''
- IBFSIZ = LINPUT
-C
-C Reset variables and read in a data card
-C
- 1 KURSOR = 1
- IERROR = 0
- ICOUNT = 0
- SHIFT = .FALSE.
-
- IF (LUNIN.LT.0) THEN
- CALL JUMPST(KFJUMP(-LUNIN))
- CALL JUMPX1(IBFSIZ)
- ELSE
-CSELF,IF= IBMVM.
-C READ (UNIT=LUNIN, NUM=NBYT, IOSTAT=IOS) BUFFER(1:IBFSIZ)
-C IF(IOS.LT.0) GOTO 80
-C BUFFER(NBYT+1:IBFSIZ)=' '
-CSELF,IF=-IBMVM.
- READ (UNIT=LUNIN, FMT=2001, END=80) BUFFER(1:IBFSIZ)
-CSELF.
- END IF
- IF (STRING) GO TO 150
-C
-C Parse first item.
-C
- CALL FFCARD (BUFFER(1:IBFSIZ), KURSOR, ISYMB,
- * KURSOR, LENGTH, IVALUE)
-C
-C A blank card will be ignored.
-C
- IF (ISYMB .EQ. 6) GO TO 900
-C
-C If first non-blank character of card is '*',
-C it can't be a continuation card. In this case,
-C get the key, if this is not a comment
-C
- IF (ISYMB .EQ. 2 .AND. BUFFER(KURSOR:KURSOR) .EQ. '*') THEN
- IF(BUFFER(KURSOR+1:KURSOR+1) .NE. ' ') THEN
- KURSOR = KURSOR + 1
- SHIFT = .TRUE.
- CALL FFCARD (BUFFER(1:IBFSIZ), KURSOR, ISYMB,
- * KURSOR, LENGTH, IVALUE)
- END IF
- ELSE
-C
-C If it seems to be a continuation card, we must have a current key
-C
- IF (ISYMB .NE. 1) THEN
- IF (KURKEY .NE. 0 .AND. .NOT. SHIFT) THEN
- GO TO 121
- ELSE
- IF (SHIFT) THEN
- SHIFT = .FALSE.
- IERROR = 5
- ELSE
- IERROR = 10
- END IF
- GO TO 900
- END IF
- END IF
- END IF
-C
-C It's a symbol - convert it to uppercase if necessary.
-C
-C Check for a system key.
-C The comparison in the loop below ensures that a system key
-C is compared with the token:
-C - at least for its minimum length
-C - at most for its maximum length
-C - at most for the user-defined key length.
-C
-#if defined(CERNLIB_UPLOW)
- CALL FFUPCA (BUFFER, KURSOR, LENGTH)
-
-#endif
- DO 2 IKEY = 1, NSYSKY
- IF (LENGTH .GE. LKYMIN(IKEY)) THEN
- ITMP = MIN(LENGTH, NCHKEY)
- IF (LKYMAX(IKEY) .GE. LENGTH) THEN
- IF (BUFFER(KURSOR:KURSOR+ITMP-1) .EQ.
- * SYSKEY(IKEY)(1:ITMP)) GO TO 3
- ELSE IF (ITMP .NE. LENGTH) THEN
- IF (BUFFER(KURSOR:KURSOR+LKYMAX(IKEY)-1) .EQ.
- * SYSKEY(IKEY)) GO TO 3
- END IF
- END IF
- 2 CONTINUE
-
- GO TO 100
-C
-C We have found a system key.
-C If it is 'C' or a '*', ignore this card completely.
-C Otherwise, dispatch after calling FFUSER
-C for last key if necessary.
-C
- 3 IF (IKEY .EQ. 1 .OR. IKEY .EQ. 10) GO TO 900
-
- KURSOR = KURSOR + LENGTH
-
- 4 IF (CALUSR) THEN
- CALL JUMPST(KUJUMP)
- CALL JUMPX1(IWORDS(NOFKEY+KURKEY*NWDKEY))
- END IF
- CALUSR = .FALSE.
- KURKEY = 0
- GO TO (10, 20, 30, 40, 50, 20, 60, 70), IKEY - 1
-C
-C 'LIST' - turn on listing, give title if not yet done
-C
- 10 LIST = .TRUE.
-
- IF (.NOT. TITLE) THEN
- WRITE (UNIT=LUNOUT, FMT=2104)
- TITLE = .TRUE.
- END IF
-
- GO TO 90
-C
-C 'READ' or 'WRITE' - change input/output LUNs.
-C For 'READ', a stack is used.
-C
-C Get LUN, check it's an integer and in the correct range.
-C
- 20 CALL FFCARD (BUFFER(1:IBFSIZ), KURSOR, ISYMB,
- * KURSOR, LENGTH, IVALUE)
-
- IF (ISYMB .NE. 3) THEN
- IERROR = 2
- GO TO 90
- END IF
-
- IF(IKEY.EQ.3) THEN
- LUNMIN = -NFJUMP
- ELSE
- LUNMIN = 0
- END IF
-
- IF (IVALUE .LT. LUNMIN .OR. IVALUE .GT. LUNMAX) THEN
- IERROR = 3
- GO TO 90
- END IF
-C
-C Now store value; for 'READ', check for space on stack
-C
- IF (IKEY .EQ. 3) THEN
-C
-C In case of user reading routine, check if address
-C initialized
-C
- IF(IVALUE.LT.0) THEN
- IF(KFJUMP(-IVALUE).EQ.IQANIL) THEN
- IERROR = 11
- GO TO 90
- END IF
- END IF
-
- IF (ISTACK .LT. LSTACK) THEN
- ISTACK = ISTACK + 1
- LUNS(ISTACK) = LUNIN
- LUNIN = IVALUE
- ELSE
- IERROR = 4
- END IF
- ELSE
- LUNOUT = IVALUE
- END IF
-
- GO TO 90
-C
-C 'END' - if indirect file, pop stack, else same as 'STOP'
-C
- 30 IF (ISTACK .GT. 0) THEN
- 35 LUNIN = LUNS(ISTACK)
- ISTACK = ISTACK - 1
- IF(LUNIN.LT.0) THEN
- IF(KFJUMP(-LUNIN).EQ.IQANIL) THEN
- IERROR = 11
- GO TO 35
- END IF
- END IF
- GO TO 90
- END IF
-C
-C 'STOP', or 'END' on primary input
-C
- 40 STOP = .TRUE.
- GO TO 90
-C
-C 'NOLIST' - turn off listing
-C
- 50 LIST = .FALSE.
- GO TO 90
-C
-C 'HOLL' - change text seperator, must be a special character
-C
- 60 CALL FFCARD (BUFFER(1:IBFSIZ), KURSOR, ISYMB,
- * KURSOR, LENGTH, IVALUE)
-
- IF (ISYMB .EQ. 2) THEN
- IF (BUFFER(KURSOR:KURSOR) .EQ. '*' .OR.
- * BUFFER(KURSOR:KURSOR) .EQ. '=') THEN
- IERROR = 1
- ELSE
- TXTSEP = BUFFER(KURSOR:KURSOR)
- END IF
- ELSE
- IERROR = 1
- END IF
-
- GO TO 90
-C
-C 'KEYS' - give listing of all keys at end of reading
-C
- 70 LISKEY = .TRUE.
- GO TO 90
-C
-C End-of-file on input: give error if reading string.
-C Then treat same as 'END'.
-C
- 80 IF (STRING) THEN
- STRING = .FALSE.
- IERROR = 7
- END IF
-
- IKEY = 4
- BUFFER = 'END'
- GO TO 4
-C
-C Check whether user wants to be called for this key.
-C That's it for a system key.
-C
- 90 IF (SHIFT) THEN
- CALL UCTOH (SYSKEY(IKEY)//BLANK, IBUF, NCHWD, NCHKEY)
- CALL JUMPST(KUJUMP)
-CF90 Pass explicitely the dimensionality to bypass argument checking
- CALL JUMPX1(IBUF(1))
- END IF
-
- GO TO 900
-C
-C We might have a user key here.
-C
- 100 ITMP0 = FFFIND (BUFFER(KURSOR:KURSOR+LENGTH-1))
- IF (ITMP0 .GT. 0) GO TO 101
-C
-C This is an unknown command. Ignore it with error message.
-C
- IERROR = 8
- GO TO 900
-C
-C New key, wind up old one and reset variables
-C
- 101 IF (CALUSR) THEN
- CALL JUMPST(KUJUMP)
- CALL JUMPX1(IWORDS(NOFKEY+KURKEY*NWDKEY))
- END IF
- CALUSR = SHIFT
- KURKEY = ITMP0
- LOC = 1
-C
-C Update cursor. Only action if item was text or special character
-C
- 110 KURSOR = KURSOR + LENGTH
-C
-C Loop here over all items on the card
-C
- 120 CALL FFCARD (BUFFER(1:IBFSIZ), KURSOR, ISYMB,
- * KURSOR, LENGTH, IVALUE)
-
- IF (ISYMB .EQ. 1) GO TO 110
- 121 IF (ISYMB .EQ. 2) GO TO 130
- IF (ISYMB .EQ. 6) GO TO 600
-
- KURSOR = KURSOR + LENGTH
- ICOUNT = ICOUNT + 1
- LENBUF(ICOUNT) = 1
- LOCBUF(ICOUNT) = LOC
-
- GO TO (200, 300, 400), ISYMB - 2
-C
-C Special character. If it's the text seperator,
-C start storing a text. Otherwise, consider it
-C part of a comment and ignore it.
-C
- 130 IF (BUFFER(KURSOR:KURSOR) .NE. TXTSEP) GO TO 110
-C
-C Check whether we're reading a logical key -
-C strings are not allowed in this case.
-C
- 131 IF (IWORDS(NOFTYP+KURKEY) .EQ. 3) THEN
- IERROR = 6
- GO TO 900
- END IF
-C
-C Take everything up to next seperator
-C
- KURSOR = KURSOR + 1
- IF (KURSOR .GT. IBFSIZ) GO TO 132
-#if !defined(CERNLIB_VAX)
- LSTRNG = INDEX (BUFFER(KURSOR:IBFSIZ), TXTSEP)
-#endif
-#if defined(CERNLIB_VAX)
- LSTRNG = LIB$LOCC (TXTSEP, BUFFER(KURSOR:IBFSIZ))
-#endif
- IF (LSTRNG .NE. 0) GO TO 140
-C
-C Text overflows to next card
-C Do necessary housekeeping.
-C
- 132 STRING = .TRUE.
- LSTRNG = IBFSIZ - KURSOR + 1
-
- IF (LSTRNG .EQ. 0) THEN
- LREST = 0
- GO TO 600
- END IF
-
- LREST = LSTRNG - (LSTRNG / NCHWD) * NCHWD
-
- IF (LREST .NE. 0) THEN
- REST = BUFFER(IBFSIZ-LREST+1:IBFSIZ)
- LSTRNG = LSTRNG - LREST
- END IF
-
- GO TO 141
-C
-C We have a text item. Store it - empty string is a no-op.
-C
- 140 LSTRNG = LSTRNG - 1
-
- IF (LSTRNG .EQ. 0) THEN
- KURSOR = KURSOR + 1
- GO TO 120
- END IF
-
- 141 ICOUNT = ICOUNT + 1
- CALL UCTOH (BUFFER(KURSOR:KURSOR+LSTRNG-1),
- * IVALUS(ICOUNT), NCHWD, LSTRNG)
- ITMP1 = (LSTRNG + NCHWD - 1) / NCHWD - 1
-
- DO 142 ITMP2 = ICOUNT, ICOUNT + ITMP1
- LENBUF(ITMP2) = 1
- LOCBUF(ITMP2) = LOC
- LOC = LOC + 1
- 142 CONTINUE
-
- ICOUNT = ICOUNT + ITMP1
-C
-C If the string wasn't terminated, we're already done with this card.
-C Else, update cursor and continue parsing.
-C
- IF (STRING) GO TO 600
- KURSOR = KURSOR + LSTRNG + 1
- GO TO 500
-C
-C A string has been continued.
-C Check whether first item is END or STOP.
-C
- 150 IKEY = 0
-#if defined(CERNLIB_UPLOW)
- CHECK = BUFFER(1:5)
- CALL FFUPCA (CHECK, 1, 5)
- IF (CHECK(1:4) .EQ. 'END ' ) IKEY = 4
- IF (CHECK(1:5) .EQ. 'STOP ') IKEY = 5
-#endif
-#if !defined(CERNLIB_UPLOW)
- IF (BUFFER(1:4) .EQ. 'END ' ) IKEY = 4
- IF (BUFFER(1:5) .EQ. 'STOP ') IKEY = 5
-#endif
- IF (IKEY .NE. 0) THEN
- IERROR = 7
-#if defined(CERNLIB_UPLOW)
- BUFFER(1:IKEY) = CHECK(1:IKEY)
-#endif
- STRING = .FALSE.
- GO TO 4
- END IF
-C
-C Try to find the end of it and deal with leftovers.
-C
-#if !defined(CERNLIB_VAX)
- LSTRNG = INDEX (BUFFER(1:IBFSIZ), TXTSEP)
-#endif
-#if defined(CERNLIB_VAX)
- LSTRNG = LIB$LOCC (TXTSEP, BUFFER(1:IBFSIZ))
-#endif
-
- IF (LREST .EQ. 0 .AND. LSTRNG .EQ. 1) THEN
- KURSOR = 2
- STRING = .FALSE.
- GO TO 120
- END IF
-
- ICOUNT = 1
- LENBUF(ICOUNT) = 1
- LOCBUF(ICOUNT) = LOC
- LOC = LOC + 1
-
- IF (LREST+LSTRNG .LE. NCHWD) THEN
- CALL UCTOH (REST(1:LREST)//BUFFER(1:LSTRNG),
- * IVALUS(ICOUNT), NCHWD, LREST+LSTRNG)
- KURSOR = LSTRNG + 1
- GO TO 500
- END IF
-
- CALL UCTOH (REST(1:LREST)//BUFFER(1:NCHWD-LREST),
- * IVALUS(ICOUNT), NCHWD, NCHWD)
-C
-C Now set up to copy the rest of the card.
-C
- KURSOR = NCHWD - LREST + 1
-
- IF (LSTRNG .NE. 0) THEN
- LSTRNG = LSTRNG - KURSOR
- STRING = .FALSE.
- ELSE
- LSTRNG = IBFSIZ - KURSOR
- END IF
-
- GO TO 141
-C
-C Found an integer item.
-C Check whether it's an address or repeat count.
-C
- 200 CALL FFSKIP (BUFFER(1:IBFSIZ), KURSOR)
- IF (KURSOR .GT. IBFSIZ) GO TO 230
- IF ( BUFFER(KURSOR:KURSOR) .EQ. '*') GO TO 220
- IF (.NOT. BUFFER(KURSOR:KURSOR) .EQ. '=') GO TO 230
-C
-C This is an address. Validate it and get next field.
-C Next field may be integer, real, logical, or string.
-C
- IF (IVALUE .LE. 0 .OR. IVALUE .GT. IWORDS(NOFLEN+KURKEY)) THEN
- LOC = IVALUE + 1
- IERROR = 9
- GO TO 900
- END IF
-
- LOCBUF(ICOUNT) = IVALUE
- LOC = IVALUE
- KURSOR = KURSOR + 1
- CALL FFCARD (BUFFER(1:IBFSIZ), KURSOR, ISYMB,
- * KURSOR, LENGTH, IVALUE)
-
- IF (ISYMB .EQ. 1 .OR. ISYMB .EQ. 6) THEN
- IERROR = 5
- GO TO 900
- END IF
-
- IF (ISYMB .EQ. 2) THEN
- IF (BUFFER(KURSOR:KURSOR) .EQ. TXTSEP) THEN
- GO TO 131
- ELSE
- IERROR = 5
- GO TO 900
- END IF
- END IF
-
- KURSOR = KURSOR + LENGTH
- GO TO (300, 400), ISYMB - 3
-C
-C Another integer. Check for a repeat count.
-C
- CALL FFSKIP (BUFFER(1:IBFSIZ), KURSOR)
- IF (KURSOR .GT. IBFSIZ) GO TO 230
- IF (BUFFER(KURSOR:KURSOR) .NE. '*') GO TO 230
-C
-C This is a repeat count. Check it is positive and get next field.
-C Strings are not allowed to have repeat counts.
-C
- 220 IF (IVALUE .LE. 0) THEN
- IERROR = 5
- GO TO 900
- END IF
-
- LENBUF(ICOUNT) = IVALUE
- KURSOR = KURSOR + 1
- CALL FFCARD (BUFFER(1:IBFSIZ), KURSOR, ISYMB,
- * KURSOR, LENGTH, IVALUE)
-
- IF (ISYMB .LT. 3 .OR. ISYMB .EQ. 6) THEN
- IERROR = 5
- GO TO 900
- END IF
-
- KURSOR = KURSOR + LENGTH
- GO TO (300, 400), ISYMB - 3
-C
-C Integer value. Check type and convert if necessary.
-C
- 230 GO TO (240, 240, 250, 260), IWORDS(NOFTYP+KURKEY)+1
-
- 240 IVALUS(ICOUNT) = IVALUE
- GO TO 500
-
- 250 RVALUS(ICOUNT) = REAL(IVALUE)
- GO TO 500
-
- 260 IERROR = 6
- GO TO 900
-C
-C Floating point value. Check type and convert if necessary.
-C
- 300 GO TO (320, 310, 320, 330), IWORDS(NOFTYP+KURKEY)+1
-
- 310 IVALUS(ICOUNT) = INT(RVALUE)
- GO TO 500
-
- 320 RVALUS(ICOUNT) = RVALUE
- GO TO 500
-
- 330 IERROR = 6
- GO TO 900
-C
-C Logical value. Error if for floating point key.
-C
- 400 IF (IWORDS(NOFTYP+KURKEY) .NE. 2) THEN
- IVALUS(ICOUNT) = IVALUE
- ELSE
- IERROR = 6
- GO TO 900
- END IF
-C
-C Correct location counter before we parse next item.
-C At the same time, check that we haven't exceeded
-C the allowed address range.
-C
- 500 LOC = LOCBUF(ICOUNT) + LENBUF(ICOUNT)
-
- IF (LOC-1 .GT. IWORDS(NOFLEN+KURKEY)) THEN
- IERROR = 9
- GO TO 900
- END IF
-
- IF (KURSOR .LE. IBFSIZ) GO TO 120
-C
-C End of card - now actually store the values.
-C
-C If no value given, store 1, 1.0, and .TRUE., respectively,
-C depending on type of key, into current location.
-C
-C This only differs from element 1 if the only item
-C on this card is the end of a continued text.
-C
- 600 IF (ICOUNT .NE. 0) THEN
- NOFF1 = IWORDS(NOFLOC+KURKEY)
- DO 601 ITMP5 = 1, ICOUNT
- NOFF2 = NOFF1 + LOCBUF(ITMP5) - 1
- DO 602 ITMP6 = 0, LENBUF(ITMP5) - 1
- IWORDS(NOFF2+ITMP6) = IVALUS(ITMP5)
- 602 CONTINUE
- 601 CONTINUE
- ELSE
- ITMP7 = IWORDS(NOFLOC+KURKEY) + LOC - 1
- GO TO (611, 612, 613), IWORDS(NOFTYP+KURKEY)
-
- 611 IWORDS(ITMP7) = 1
- GO TO 900
-
- 612 RVALUS(1) = 1.
- CALL UCOPY2 (RVALUS(1), IWORDS(ITMP7), 1)
- GO TO 900
-
-CF90 The call to UCOPY2 was confusing the compiler
- 613 CALL UCOPY (.TRUE., IWORDS(ITMP7), 1)
- GO TO 900
- END IF
-C
-C Here we print the data card and any error messages,
-C if so required. Indent data cards according to 'READ'
-C nesting level.
-C
- 900 IF (LIST) THEN
- IF (IKEY .EQ. 3) THEN
- ITMP8 = ISTACK + 1
- ELSE IF ((IKEY .EQ. 4 .OR. IKEY .EQ. 5) .AND. .NOT. STOP) THEN
- ITMP8 = ISTACK + 3
- ELSE
- ITMP8 = ISTACK + 2
- END IF
- IF (SHIFT) ITMP8 = ITMP8 - 1
-
- WRITE (UNIT=LUNOUT, FMT=2105) BLANK(1:ITMP8)//BUFFER(1:IBFSIZ)
-
- IF (IERROR .NE. 0) THEN
- FFFLAG = FFFLAG + 1.
- GO TO (901, 902, 903, 904, 905,
- * 906, 907, 908, 909, 910, 915), IERROR
- END IF
-
- END IF
-C
-C Check for end of input
-C
- IF (.NOT. STOP) GO TO 1
- GO TO 920
-
- 901 WRITE (UNIT=LUNOUT, FMT=1001) ERRHDR
- IF (.NOT. STOP) GO TO 1
- GO TO 920
-
- 902 WRITE (UNIT=LUNOUT, FMT=1002) ERRHDR
- IF (.NOT. STOP) GO TO 1
- GO TO 920
-
- 903 WRITE (UNIT=LUNOUT, FMT=1003) ERRHDR, IVALUE
- IF (.NOT. STOP) GO TO 1
- GO TO 920
-
- 904 WRITE (UNIT=LUNOUT, FMT=1004) ERRHDR, IVALUE
- IF (.NOT. STOP) GO TO 1
- GO TO 920
-
- 905 WRITE (UNIT=LUNOUT, FMT=1005) ERRHDR
- IF (.NOT. STOP) GO TO 1
- GO TO 920
-
- 906 WRITE (UNIT=LUNOUT, FMT=1006) ERRHDR
- IF (.NOT. STOP) GO TO 1
- GO TO 920
-
- 907 WRITE (UNIT=LUNOUT, FMT=1007) ERRHDR, SYSKEY(IKEY)(1:IKEY-1)
- IF (.NOT. STOP) GO TO 1
- GO TO 920
-
- 908 WRITE (UNIT=LUNOUT, FMT=1008) ERRHDR
- IF (.NOT. STOP) GO TO 1
- GO TO 920
-
- 909 WRITE (UNIT=LUNOUT, FMT=1009) ERRHDR, LOC-1
- IF (.NOT. STOP) GO TO 1
- GO TO 920
-
- 910 WRITE (UNIT=LUNOUT, FMT=1010) ERRHDR
- IF (.NOT. STOP) GO TO 1
-C
- 915 WRITE (UNIT=LUNOUT, FMT=1012) ERRHDR, LUNIN
- IF (.NOT. STOP) GO TO 1
-C
-C End of reading.
-C List keys if required
-C
- 920 IF (LISKEY) THEN
- WRITE (UNIT=LUNOUT, FMT=2101)
- MAXPOS = LEN (OUTBUF) - NCHKEY + 1
- OUTBUF = ' FFREAD KEYWORDS'
- IPOS = 29
-
- DO 921 ITMP9 = 1, NSYSKY
- OUTBUF(IPOS:IPOS+NCHKEY-1) = SYSKEY(ITMP9)
- IPOS = IPOS + NCHKEY + 1
- IF (IPOS .GT. MAXPOS) THEN
- WRITE (UNIT=LUNOUT, FMT=2103) OUTBUF
- OUTBUF = ' '
- IPOS = 29
- END IF
- 921 CONTINUE
- IF (IPOS .NE. 29) WRITE (UNIT=LUNOUT, FMT=2103) OUTBUF
-
- WRITE (UNIT=LUNOUT, FMT=2102)
- OUTBUF = ' USER KEYWORDS'
- IPOS = 29
-
- DO 922 ITMP9 = 1, NKEYS
- CALL UHTOC (IWORDS(NOFKEY+ITMP9*NWDKEY), NCHWD,
- * OUTBUF(IPOS:IPOS+NCHKEY-1), NCHKEY)
- IPOS = IPOS + NCHKEY + 1
- IF (IPOS .GT. MAXPOS) THEN
- WRITE (UNIT=LUNOUT, FMT=2103) OUTBUF
- OUTBUF = ' '
- IPOS = 29
- END IF
- 922 CONTINUE
- IF (IPOS .NE. 29) WRITE (UNIT=LUNOUT, FMT=2103) OUTBUF
-
- END IF
-C
-C All done !
-C
- RETURN
-C
-C FORMATs for all error messages.
-C
-1001 FORMAT (A,
- * 'KEY ''HOLL'' MUST BE FOLLOWED BY SPECIAL CHARACTER ',
- * 'NEITHER * NOR =')
-1002 FORMAT (A,
- * 'KEY ''READ''/''WRITE'' MUST BE FOLLOWED BY AN INTEGER')
-1003 FORMAT (A,
- * 'LUN', I12, ' FOR ''READ''/''WRITE'' OUT OF RANGE')
-1004 FORMAT (A,
- * 'CAN''T READ FROM UNIT ', I3, ' BECAUSE OF STACK OVERFLOW')
-1005 FORMAT (A,
- * 'SYNTAX ERROR')
-1006 FORMAT (A,
- * 'TYPE MISMATCH OF KEY DECLARATION AND VALUE')
-1007 FORMAT (A,
- * 'SECOND DELIMITER NOT FOUND. SCAN TERMINATED BY ''', A, '''')
-1008 FORMAT (A,
- * 'COMMAND NOT FOUND IN DICTIONARY')
-1009 FORMAT (A,
- * 'ADDRESS', I12, ' OUT OF RANGE')
-1010 FORMAT (A,
- * 'DECK CANNOT START BY A CONTINUATION CARD')
-1011 FORMAT
- * (' FFGO --- NO KEYS ARE CURRENTLY DEFINED.'/
- * ' YOU MUST BE JOKING!')
-1012 FORMAT(A,
- *' FFGO --- UNSET USER READ ROUTINE - UNIT ',I3,' SKIPPED.')
-C
-C FORMAT for input.
-C
-2001 FORMAT (A)
-C
-C FORMATs for output.
-C
-2101 FORMAT (/)
-2102 FORMAT ( )
-2103 FORMAT (' ', A)
-2104 FORMAT ('1 USER''S DIRECTIVES TO RUN THIS JOB'/
- * ' ----------------------------------'//)
-2105 FORMAT (' ***** DATA CARD CONTENT ', A)
-
- END
diff --git a/src/packlib/ffread/sffread/ffinit.F b/src/packlib/ffread/sffread/ffinit.F
deleted file mode 100644
index fcbf052..0000000
--- a/src/packlib/ffread/sffread/ffinit.F
+++ /dev/null
@@ -1,114 +0,0 @@
-*
-* $Id: ffinit.F,v 1.1.1.1 1996/03/08 11:50:42 mclareni Exp $
-*
-* $Log: ffinit.F,v $
-* Revision 1.1.1.1 1996/03/08 11:50:42 mclareni
-* Ffread
-*
-*
-#include "ffread/pilot.h"
- SUBROUTINE FFINIT (NW)
-C
-C FUNCTIONAL DESCRIPTION:
-C
-C This routine intializes the FFREAD package.
-C If any keys had been previously specified,
-C they are erased with all associated information.
-C
-C DUMMY ARGUMENTS:
-C
-C NW specifies the number of words allocated by the
-C user in common CFREAD. This can be used to increase
-C the number of available keys.
-C
-C IMPLICIT INPUTS:
-C
-C NONE
-C
-C IMPLICIT OUTPUTS:
-C
-C The common CFREAD is initialized with default information.
-C
-C SIDE EFFECTS:
-C
-C Any information set up by previous calls to FFREAD routines
-C is destroyed. Users of FFREAD (which calls FFINIT with
-C NW=0) can call FFINIT(NW) before calling FFREAD.
-C
- EXTERNAL FFUSER
-C
-#include "ffread/ffmach.inc"
-#include "ffread/ffluns.inc"
-#include "ffread/cfread.inc"
-#include "ffread/ffcomm.inc"
-C
-C--- Define initial value for NWORDS (so FFREAD users can call FFINIT)
- DATA NWINIT/ NCSIZE/
-C----------------- Beginning of executable statements -------------------------
-C
-C Initialize default unit numbers and input file stack
-C
- LINPUT = LENDEF
- LUNIN = LUNDIN
- LUNOUT = LUNDUT
- ISTACK = 0
-C
-C Initialize jump addresses
-C
- CALL VFILL(KFJUMP,NFJUMP,IQANIL)
- CALL FFUSET(FFUSER)
-C
-C Default key size and associated values
-C
- NCHKEY = NCHKYD
- NKEYS = 0
- NWDKEY = (NCHKEY+NCHWD-1) / NCHWD
-C
-C Set size of common, check for at least one key possible if NW not 0
-C
- IF (NW .EQ. 0) THEN
- NWORDS = NWINIT
- ELSE
- IF (NW .GE. NOVERH+NWDKEY+NKYOVH) THEN
- NWORDS = NW - NOVERH
- ELSE
- WRITE (UNIT=LUNOUT, FMT=1001) NW
- NWORDS = NCSIZE
- END IF
-C Remember NWORDS in NWINIT for later FFINIT(0) call by FFREAD
- NWINIT= NWORDS
- END IF
-
- MAXKEY = NWORDS / (NWDKEY + NKYOVH)
-C
-C Calculate offsets into IWORDS for different arrays
-C
- NOFLEN = MAXKEY - 1 + 1
- NOFTYP = MAXKEY*2 - 1 + 1
- NOFKEY = MAXKEY*3 - NWDKEY + 1
-C
-C Initialize character options for FFGET, FFKEY, and FFSET.
-C
- CALL UCTOH ('SIZE', IFFOPT(1), NCHWD, 4)
- CALL UCTOH ('LENG', IFFOPT(2), NCHWD, 4)
- CALL UCTOH ('LINP', IFFOPT(3), NCHWD, 4)
- CALL UCTOH ('LOUT', IFFOPT(4), NCHWD, 4)
- CALL UCTOH ('NBIT', IFFOPT(5), NCHWD, 4)
- CALL UCTOH ('NCHW', IFFOPT(6), NCHWD, 4)
- CALL UCTOH ('NBCH', IFFOPT(7), NCHWD, 4)
- CALL UCTOH ('NCHK', IFFOPT(8), NCHWD, 4)
-
- CALL UCTOH ('INTE', KEYOPT(1), NCHWD, 4)
- CALL UCTOH ('REAL', KEYOPT(2), NCHWD, 4)
- CALL UCTOH ('LOGI', KEYOPT(3), NCHWD, 4)
-C
-C Reset error counter
-C
- FFFLAG = 0.
- RETURN
-
-1001 FORMAT
- * (' FFINIT --- INVALID PARAMETER NW =', I12,
- * ' - DEFAULT ASSUMED')
-
- END
diff --git a/src/packlib/ffread/sffread/ffkey.F b/src/packlib/ffread/sffread/ffkey.F
deleted file mode 100644
index e541f11..0000000
--- a/src/packlib/ffread/sffread/ffkey.F
+++ /dev/null
@@ -1,123 +0,0 @@
-*
-* $Id: ffkey.F,v 1.1.1.1 1996/03/08 11:50:42 mclareni Exp $
-*
-* $Log: ffkey.F,v $
-* Revision 1.1.1.1 1996/03/08 11:50:42 mclareni
-* Ffread
-*
-*
-#include "ffread/pilot.h"
- SUBROUTINE FFKEY (KEY, ADRESS, LENGTH, CHTYPE)
-C
-C FUNCTIONAL DESCRIPTION:
-C
-C This routine accepts the definition of a user key
-C for later use by FFGO.
-C
-C DUMMY ARGUMENTS:
-C
-C KEY - character string containing the key to use
-C ADRESS - variable/array to store values to
-C LENGTH - number of values associated with this key
-C CHTYPE - character string containing either INTE, REAL,
-C or LOGI to signify ADRESS contains integer,
-C floating point, or logical data, respectively.
-C
-C IMPLICIT INPUTS:
-C
-C The currently defined keys are checked for unambiguity
-C of the new key. If no more keys can be defined, an error
-C message is issued.
-C
-C IMPLICIT OUTPUTS:
-C
-C CFREAD is updated to include the new information.
-C
-C SIDE EFFECTS:
-C
-C NONE
-C
-#include "ffread/ffmach.inc"
-#include "ffread/ffluns.inc"
-#include "ffread/cfread.inc"
- CHARACTER KEY*(*), CHTYPE*(*)
-CF90 Declare ADRESS as integer to avoid consistency checking by LOCF
- INTEGER ADRESS(1)
- INTEGER FFFIND
-
- CHARACTER KEYSTR*(NCHMAX)
-C
-C----------------- Beginning of executable statements -------------------------
-C
-C Get key string into local variable, possibly truncating it
-C
- KEYSTR(1:NCHKEY) = KEY
-C
-C Check whether enough space for a new key
-C
- IF (NKEYS .LT. MAXKEY) THEN
-C
-C Check key for ambiguity (convert to upper case if necesssary).
-C This also gives us the place to insert it.
-C
-#if defined(CERNLIB_UPLOW)
- CALL FFUPCA (KEYSTR, 1, NCHKEY)
-#endif
- IPOINT = FFFIND (KEYSTR)
-
- IF (IPOINT .GT. 0) THEN
- WRITE (UNIT=LUNOUT, FMT=1001) KEYSTR(1:NCHKEY)
- RETURN
- END IF
-C
-C Check length is positive
-C
- IF (LENGTH .LE. 0) THEN
- WRITE (UNIT=LUNOUT, FMT=1002) KEYSTR(1:NCHKEY)
- RETURN
- END IF
-C
-C Find which type of key it is
-C
- CALL UCTOH (CHTYPE, NTYPE, NCHWD, MIN (LEN (CHTYPE), 4) )
- ITYPE = IUCOMP (NTYPE, KEYOPT, 3)
-C
-C Count this key and make room for it if necessary
-C
- NKEYS = NKEYS + 1
- IPOINT = - IPOINT
- ITEMP = NOFKEY + IPOINT*NWDKEY
-
- IF (IPOINT .NE. NKEYS) THEN
- CALL UCOPY2 (IWORDS(NOFLOC+IPOINT ),
- * IWORDS(NOFLOC+IPOINT+1), NKEYS-IPOINT)
- CALL UCOPY2 (IWORDS(NOFLEN+IPOINT ),
- * IWORDS(NOFLEN+IPOINT+1), NKEYS-IPOINT)
- CALL UCOPY2 (IWORDS(NOFTYP+IPOINT ),
- * IWORDS(NOFTYP+IPOINT+1), NKEYS-IPOINT)
- CALL UCOPY2 (IWORDS(ITEMP),
- * IWORDS(ITEMP+NWDKEY), NWDKEY*(NKEYS-IPOINT))
- END IF
-C
-C Now fill in data as appropriate
-C
- IWORDS(NOFLOC+IPOINT) = LOCF(ADRESS) - LOCF(IWORDS) + 1
- IWORDS(NOFLEN+IPOINT) = LENGTH
- IWORDS(NOFTYP+IPOINT) = ITYPE
- CALL UCTOH (KEYSTR, IWORDS(ITEMP), NCHWD, NCHKEY)
- ELSE
-C
-C Not enough room for this key, sorry.
-C
- WRITE (UNIT=LUNOUT, FMT=1003) KEYSTR(1:NCHKEY)
- END IF
- RETURN
-
-1001 FORMAT
- * (' FFKEY --- REPEATED DEFINITION OF ''', A, ''' - CALL IGNORED')
-1002 FORMAT
- * (' FFKEY --- INVALID LENGTH FOR ''', A, ''' - TRY AGAIN')
-1003 FORMAT
- * (' FFKEY --- NO SPACE TO DEFINE ''', A, ''' - CALL IGNORED')
-
- END
diff --git a/src/packlib/ffread/sffread/ffread.F b/src/packlib/ffread/sffread/ffread.F
deleted file mode 100644
index e362d0a..0000000
--- a/src/packlib/ffread/sffread/ffread.F
+++ /dev/null
@@ -1,95 +0,0 @@
-*
-* $Id: ffread.F,v 1.1.1.1 1996/03/08 11:50:42 mclareni Exp $
-*
-* $Log: ffread.F,v $
-* Revision 1.1.1.1 1996/03/08 11:50:42 mclareni
-* Ffread
-*
-*
-#include "ffread/pilot.h"
- SUBROUTINE FFREAD (NKEY, KEY, LOCVAR, LENVAR)
-C
-C FUNCTIONAL DESCRIPTION:
-C
-C This is the old-fashioned form of using FFREAD and is
-C only supplied for backward compatibility.
-C
-C If NKEY is set to 0, it is used to modify the values for
-C the default input/output LUNs.
-C
-C If NKEY is negative, it will return them.
-C
-C If NKEY is positive, it specifies the number of keys
-C in KEY. The keys will be set up and FFGO called to do
-C the work.
-C
-C DUMMY ARGUMENTS:
-C
-C NKEY - number of keys. Different actions depending on
-C sign of NKEYS are described above.
-C KEY - array containing user's keys, one per machine word,
-C with NCHKYD (four) significant characters.
-C LOCVAR - locations of variables/arrays to change as returned
-C by LOCF.
-C LENVAR - length of array at location given in LOCVAR.
-C
-C IMPLICIT INPUTS:
-C
-C The data cards entered by the user.
-C
-C IMPLICIT OUTPUTS:
-C
-C The data cards read modify appropriate locations in memory.
-C
-C SIDE EFFECTS:
-C
-C NONE
-C
-#include "ffread/ffmach.inc"
-#include "ffread/ffluns.inc"
-#include "ffread/cfread.inc"
- INTEGER KEY(1), LOCVAR(1), LENVAR(1)
-
- CHARACTER KEYSTR*(NCHKYD)
-
- INTEGER LFFIN, LFFOUT
- DATA LFFIN / LUNDIN /, LFFOUT / LUNDUT /
-C
-C----------------- Beginning of executable statements -------------------------
-C
-C NKEY < 0: Return values of input/output LUNs
-C
- IF (NKEY .LT. 0) THEN
- LOCVAR(1) = LFFIN
- LENVAR(1) = LFFOUT
- RETURN
- END IF
-C
-C NKEY = 0: Set values of input/output LUNs
-C
- IF (NKEY .EQ. 0) THEN
- IF (LOCVAR(1) .NE. 0) LFFIN = LOCVAR(1)
- IF (LENVAR(1) .NE. 0) LFFOUT = LENVAR(1)
- RETURN
- END IF
-C
-C Here for the real work. First, initialize.
-C
- CALL FFINIT (0)
- IF (LFFIN .NE. LUNDIN) CALL FFSET ('LINP', LFFIN)
- IF (LFFOUT .NE. LUNDUT) CALL FFSET ('LOUT', LFFOUT)
-C
-C Extract the keys and call FFKEY for each.
-C
- DO 1 I = 1, NKEY
- CALL UHTOC (KEY(I), NCHKYD, KEYSTR, NCHKYD)
- IADRES = LOCVAR(I) - LOCF(IWORDS) + 1
- CALL FFKEY (KEYSTR, IWORDS(IADRES), LENVAR(I), 'NONE')
- 1 CONTINUE
-C
-C Now let FFGO do the rest.
-C
- CALL FFGO
- RETURN
-
- END
diff --git a/src/packlib/ffread/sffread/ffrset.F b/src/packlib/ffread/sffread/ffrset.F
deleted file mode 100644
index b04b6a0..0000000
--- a/src/packlib/ffread/sffread/ffrset.F
+++ /dev/null
@@ -1,76 +0,0 @@
-*
-* $Id: ffrset.F,v 1.1.1.1 1996/03/08 11:50:42 mclareni Exp $
-*
-* $Log: ffrset.F,v $
-* Revision 1.1.1.1 1996/03/08 11:50:42 mclareni
-* Ffread
-*
-*
-#include "ffread/pilot.h"
- SUBROUTINE FFRSET (LUNSUB, FFRSUB)
-C
-C FUNCTIONAL DESCRIPTION:
-C
-C This routines stores the address of FFRSUB (to be
-C declared EXTERNAL in the calling program). When a
-C data card READ is encountered, if the number of the
-C logical unit is -LUNSUB, then this routine will be
-C used to input the next data card.
-C
-C DUMMY ARGUMENTS:
-C
-C LUNSUB - absolute value of the negative logical unit
-C associated with this subroutine. Must be:
-C 0 < LUNSUB < NFJUMP
-C FFRSUB - routine to be called when reading is directed
-C to unit -LUNSUB via a READ data cards. This
-C routine has the following calling sequence:
-C
-C SUBROUTINE FFRSUB(IBUSIZ)
-C
-C Where:
-C
-C IBUSIZ - Length of the character string
-C to be returned with the data card,
-C blank padded.
-C
-C the string may be accessed using the common FFCHAR:
-C
-C COMMON / FFCHAR / STRING
-C CHARACTER*132 STRING
-C
-C
-C
-C IMPLICIT INPUTS:
-C
-C NONE
-C
-C IMPLICIT OUTPUTS:
-C
-C The appropriate value in common CFREAD is changed.
-C
-C SIDE EFFECTS:
-C
-C NONE
-C
-#include "ffread/ffmach.inc"
-#include "ffread/ffluns.inc"
-#include "ffread/ffcomm.inc"
-#include "ffread/cfread.inc"
-C
-C----------------- Beginning of executable statements -------------------------
-C
-C Check if logical unit within range
-C
- IF(LUNSUB.LE.0.OR.LUNSUB.GT.NFJUMP) THEN
- WRITE (UNIT=LUNOUT, FMT=1001) LUNSUB
- GO TO 999
- END IF
- KFJUMP(LUNSUB) = JUMPAD(FFRSUB)
-
- 999 CONTINUE
-
-1001 FORMAT
- * (' FFRSET --- INVALID VALUE', I12,
- * ' FOR LUNSUB - ADDRESS NOT STORED')
- END
diff --git a/src/packlib/ffread/sffread/ffset.F b/src/packlib/ffread/sffread/ffset.F
deleted file mode 100644
index 73ee0cf..0000000
--- a/src/packlib/ffread/sffread/ffset.F
+++ /dev/null
@@ -1,113 +0,0 @@
-*
-* $Id: ffset.F,v 1.1.1.1 1996/03/08 11:50:42 mclareni Exp $
-*
-* $Log: ffset.F,v $
-* Revision 1.1.1.1 1996/03/08 11:50:42 mclareni
-* Ffread
-*
-*
-#include "ffread/pilot.h"
- SUBROUTINE FFSET (CHOPT, IVALUE)
-C
-C FUNCTIONAL DESCRIPTION:
-C
-C This sets some values which are optional within FFREAD.
-C
-C DUMMY ARGUMENTS:
-C
-C CHOPT - Character argument specifying which item to change.
-C Valid are:
-C LENG - set # of significant characters on data cards
-C LINP - change input LUN
-C LOUT - change output LUN
-C SIZE - set key size in number of characters.
-C This must be at least 4 and cannot be
-C greater than NCHMAX.
-C The last option, SIZE, can only be specified
-C after a call to FFINIT and before the first
-C call to FFKEY/FFGO.
-C IVALUE - Value of the desired argument
-C
-C IMPLICIT INPUTS:
-C
-C NONE
-C
-C IMPLICIT OUTPUTS:
-C
-C The appropriate value in common CFREAD is changed.
-C
-C SIDE EFFECTS:
-C
-C NONE
-C
-#include "ffread/ffmach.inc"
-#include "ffread/ffluns.inc"
-#include "ffread/ffcomm.inc"
-#include "ffread/cfread.inc"
- CHARACTER CHOPT*(*)
-C
-C----------------- Beginning of executable statements -------------------------
-C
-C Check option and dispatch on it
-C
- CALL UCTOH (CHOPT, NCHOPT, NCHWD, MIN (LEN (CHOPT), 4) )
- IOPT = IUCOMP (NCHOPT, IFFOPT, 4)
- GO TO (1, 2, 3, 4), IOPT
-
- WRITE (UNIT=LUNOUT, FMT=1005) NCHOPT
- RETURN
-
- 1 IF (NKEYS .EQ. 0) THEN
- IF ( IVALUE .GE. 4
- * .AND. IVALUE .LE. NCHMAX
- * .AND. IVALUE .LT. (NWORDS-NKYOVH)*NCHWD) THEN
- NCHKEY = IVALUE
- NWDKEY = (NCHKEY+NCHWD-1) / NCHWD
- MAXKEY = NWORDS / (NWDKEY + NKYOVH)
- NOFLEN = MAXKEY - 1 + 1
- NOFTYP = MAXKEY*2 - 1 + 1
- NOFKEY = MAXKEY*3 - NWDKEY + 1
- ELSE
- WRITE (UNIT=LUNOUT, FMT=1001) IVALUE
- END IF
- ELSE
- WRITE (UNIT=LUNOUT, FMT=1002)
- END IF
- RETURN
-
- 2 IF (IVALUE .GE. LENMIN .AND. IVALUE .LE. LENMAX) THEN
- LINPUT = IVALUE
- ELSE
- WRITE (UNIT=LUNOUT, FMT=1003) IVALUE
- END IF
- RETURN
-
- 3 IF (IVALUE .GE. -NFJUMP .AND. IVALUE .LE. LUNMAX) THEN
- LUNIN = IVALUE
- ELSE
- WRITE (UNIT=LUNOUT, FMT=1004) IVALUE, 'INPUT'
- END IF
- RETURN
-
- 4 IF (IVALUE .GE. 0 .AND. IVALUE .LE. LUNMAX) THEN
- LUNOUT = IVALUE
- ELSE
- WRITE (UNIT=LUNOUT, FMT=1004) IVALUE, 'OUTPUT'
- END IF
- RETURN
-
-1001 FORMAT
- * (' FFSET --- INVALID VALUE', I12,
- * ' FOR KEY SIZE - NOT CHANGED')
-1002 FORMAT
- * (' FFSET --- INVALID STATE FOR OPTION ''SIZE'' - IGNORED')
-1003 FORMAT
- * (' FFSET --- INVALID VALUE', I12,
- * ' FOR CARD LENGTH - NOT CHANGED')
-1004 FORMAT
- * (' FFSET --- INVALID LUN', I12,
- * ' FOR ', A, ' - NOT CHANGED')
-1005 FORMAT
- * (' FFSET --- UNRECOGNIZED OPTION ''', A4, ''' - TRY AGAIN')
-
- END
diff --git a/src/packlib/ffread/sffread/ffskip.F b/src/packlib/ffread/sffread/ffskip.F
deleted file mode 100644
index 20b5494..0000000
--- a/src/packlib/ffread/sffread/ffskip.F
+++ /dev/null
@@ -1,54 +0,0 @@
-*
-* $Id: ffskip.F,v 1.1.1.1 1996/03/08 11:50:42 mclareni Exp $
-*
-* $Log: ffskip.F,v $
-* Revision 1.1.1.1 1996/03/08 11:50:42 mclareni
-* Ffread
-*
-*
-#include "ffread/pilot.h"
- SUBROUTINE FFSKIP (BUFFER, KURSOR)
-C
-C FUNCTIONAL DESCRIPTION:
-C
-C This routine skips over blanks in BUFFER, starting
-C at position KURSOR. The position of the first non-blank
-C character is returned in KURSOR; if none is found, KURSOR
-C will equal LEN (BUFFER) + 1.
-C
-C DUMMY ARGUMENTS:
-C
-C BUFFER - passed length character string
-C KURSOR - input: starting position
-C output: position of first non-blank character
-C
-C IMPLICIT INPUTS:
-C
-C NONE
-C
-C IMPLICIT OUTPUTS:
-C
-C NONE
-C
-C SIDE EFFECTS:
-C
-C NONE
-C
- CHARACTER BUFFER*(*)
-C
-C----------------- Beginning of executable statements -------------------------
-C
-C
-C Loop over all characters remaining
-C
- DO 1 I = KURSOR, LEN(BUFFER)
- IF (BUFFER(I:I) .NE. ' '
-#if defined(CERNLIB_TABS)
- * .AND. ICHAR (BUFFER(I:I)) .NE. 9
-#endif
- * ) GO TO 2
-1 CONTINUE
-
-2 KURSOR = I
-
- END
diff --git a/src/packlib/ffread/sffread/ffupca.F b/src/packlib/ffread/sffread/ffupca.F
deleted file mode 100644
index c4e3efa..0000000
--- a/src/packlib/ffread/sffread/ffupca.F
+++ /dev/null
@@ -1,56 +0,0 @@
-*
-* $Id: ffupca.F,v 1.1.1.1 1996/03/08 11:50:42 mclareni Exp $
-*
-* $Log: ffupca.F,v $
-* Revision 1.1.1.1 1996/03/08 11:50:42 mclareni
-* Ffread
-*
-*
-#include "ffread/pilot.h"
-#if defined(CERNLIB_UPLOW)
- SUBROUTINE FFUPCA (STRING, IPOS, LENGTH)
-C
-C FUNCTIONAL DESCRIPTION:
-C
-C This routine will convert all characters in
-C STRING(IPOS:IPOS+LENGTH-1) to upper case.
-C
-C DUMMY ARGUMENTS:
-C
-C STRING - passed length character string to be converted
-C to upper case (done in place)
-C IPOS - starting position
-C LENGTH - number of characters to convert
-C
-C IMPLICIT INPUTS:
-C
-C NONE
-C
-C IMPLICIT OUTPUTS:
-C
-C NONE
-C
-C SIDE EFFECTS:
-C
-C NONE
-C
-#if !defined(CERNLIB_EBCDIC)
- PARAMETER (IDIFF = -32)
-#endif
-#if defined(CERNLIB_EBCDIC)
- PARAMETER (IDIFF = 64)
-#endif
- CHARACTER STRING*(*)
-C
-C----------------- Beginning of executable statements -------------------------
-C
-C Loop over characters and substitute if lower case
-C
- DO 1 I = IPOS, IPOS + LENGTH - 1
- J = ICHAR (STRING(I:I))
- IF (J .GE. ICHAR ('a') .AND. J .LE. ICHAR ('z'))
- * STRING(I:I) = CHAR (J + IDIFF)
-1 CONTINUE
-
- END
-#endif
diff --git a/src/packlib/ffread/sffread/ffuser.F b/src/packlib/ffread/sffread/ffuser.F
deleted file mode 100644
index 4456437..0000000
--- a/src/packlib/ffread/sffread/ffuser.F
+++ /dev/null
@@ -1,36 +0,0 @@
-*
-* $Id: ffuser.F,v 1.1.1.1 1996/03/08 11:50:42 mclareni Exp $
-*
-* $Log: ffuser.F,v $
-* Revision 1.1.1.1 1996/03/08 11:50:42 mclareni
-* Ffread
-*
-*
-#include "ffread/pilot.h"
- SUBROUTINE FFUSER (KEY)
-C
-C FUNCTIONAL DESCRIPTION:
-C
-C This is a dummy user routine which does nothing.
-C
-C DUMMY ARGUMENTS:
-C
-C KEY - This is an array containing the current key
-C stored in hollerith, blank padded to the
-C defined length of a key.
-C
-C IMPLICIT INPUTS:
-C
-C NONE
-C
-C IMPLICIT OUTPUTS:
-C
-C NONE
-C
-C SIDE EFFECTS:
-C
-C NONE
-C
- INTEGER KEY(1)
-
- END
diff --git a/src/packlib/ffread/sffread/ffuset.F b/src/packlib/ffread/sffread/ffuset.F
deleted file mode 100644
index 0115b44..0000000
--- a/src/packlib/ffread/sffread/ffuset.F
+++ /dev/null
@@ -1,44 +0,0 @@
-*
-* $Id: ffuset.F,v 1.1.1.1 1996/03/08 11:50:42 mclareni Exp $
-*
-* $Log: ffuset.F,v $
-* Revision 1.1.1.1 1996/03/08 11:50:42 mclareni
-* Ffread
-*
-*
-#include "ffread/pilot.h"
- SUBROUTINE FFUSET(FUSUB)
-C
-C FUNCTIONAL DESCRIPTION:
-C
-C This routine stores the address of the user
-C routine which should be called when a key
-C is preceded by an *. This routine can be
-C called at any time to redefine the address
-C of the user routine, but AFTER FFINIT. If
-C this routine is not called, the default
-C routine FFUSER will be used
-C
-C DUMMY ARGUMENTS:
-C
-C FUSUB - routine to be called (to be declared
-C EXTERNAL in the caling program)
-C
-C IMPLICIT INPUTS:
-C
-C NONE
-C
-C IMPLICIT OUTPUTS:
-C
-C NONE
-C
-C SIDE EFFECTS:
-C
-C NONE
-C
-#include "ffread/ffcomm.inc"
-#include "ffread/ffmach.inc"
-C
- KUJUMP = JUMPAD(FUSUB)
-C
- END
diff --git a/src/packlib/ffread/test/Imakefile b/src/packlib/ffread/test/Imakefile
deleted file mode 100644
index 0ec0eb9..0000000
--- a/src/packlib/ffread/test/Imakefile
+++ /dev/null
@@ -1,9 +0,0 @@
-SRCS_F= ffuser.F furead.F fustar.F main.F
-
-DefinePackageLibrary(NullParameter)
-
-CernlibFortranProgramTarget(ffread,$(OBJS),$(PACKAGE_LIB),$(PACKAGE_LIB),kernlib)
-
-TestTarget(ffread,NullParameter,test.input)
-
-CopyFile(ffdata.dat,test.input)
diff --git a/src/packlib/ffread/test/ffdata.dat b/src/packlib/ffread/test/ffdata.dat
deleted file mode 100644
index 087d31c..0000000
--- a/src/packlib/ffread/test/ffdata.dat
+++ /dev/null
@@ -1,30 +0,0 @@
-*
-* $Id: ffdata.dat,v 1.1.1.1 1996/03/08 11:50:41 mclareni Exp $
-*
-* $Log: ffdata.dat,v $
-* Revision 1.1.1.1 1996/03/08 11:50:41 mclareni
-* Ffread
-*
-*
-LIST
-INTVAR 127
-INTARRAY 3=5.7 2*12 (THIS IS A COMMENT) 10=1 1=2*4
-C YOU CAN PUT ANYTHING ON A CARD LIKE THIS - IT IS IGNORED COMPLETELY
-* THIS ALSO IS A COMMENT CARD - IT IS IGNORED AS WELL
-
-LOGVAR 1 (THIS PRODCUES AN ERROR!)
-LOGVAR 2=TRUE (THIS ONE ALSO)
-
-READ -300
-(THIS SHOULD GIVE AN ERROR !)
-
-*LOGVAR FALSE
-LOGARRA ON OFF T F TRUE FALS FALSE 9=2*TRUE
-
-CBLABLA (THIS IS AN UNKNOWN COMMAND AND PRODUCES AN ERROR)
-
-REALVAR 'TEXT'
-*REALARRAY 1 -1 1. -1.456
- 3.76E-2 1 =5.7 6=-6.2E03 8=3*.9995 (THIS IS A CONTINUATION CARD)
-READ -10
-STOP
diff --git a/src/packlib/ffread/test/ffuser.F b/src/packlib/ffread/test/ffuser.F
deleted file mode 100644
index 4776cce..0000000
--- a/src/packlib/ffread/test/ffuser.F
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: ffuser.F,v 1.1.1.1 1996/03/08 11:50:41 mclareni Exp $
-*
-* $Log: ffuser.F,v $
-* Revision 1.1.1.1 1996/03/08 11:50:41 mclareni
-* Ffread
-*
-*
-#include "ffread/pilot.h"
- SUBROUTINE FFUSER (KEY)
-
- DIMENSION KEY(1)
- CHARACTER*6 KEYSTR
-C
-C----------------- Beginning of executable statements -------------------------
-C
- CALL FFGET ('NCHW', NCHW)
- CALL UHTOC(KEY, NCHW, KEYSTR, 6)
-
- WRITE (*, *) ' STANDARD FFUSER CALLED WITH KEY ''', KEYSTR, ''''
- WRITE (*, *)
-
- END
diff --git a/src/packlib/ffread/test/furead.F b/src/packlib/ffread/test/furead.F
deleted file mode 100644
index 0619a5c..0000000
--- a/src/packlib/ffread/test/furead.F
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: furead.F,v 1.1.1.1 1996/03/08 11:50:41 mclareni Exp $
-*
-* $Log: furead.F,v $
-* Revision 1.1.1.1 1996/03/08 11:50:41 mclareni
-* Ffread
-*
-*
-#include "ffread/pilot.h"
- SUBROUTINE FUREAD (IBFSIZ)
-
- COMMON / FFCHAR / STRING
- CHARACTER*132 STRING
- EXTERNAL FUSTAR
-C
-C----------------- Beginning of executable statements -------------------------
-C
- DATA ITIME /0/
-#if defined(CERNLIB_SAVE)
- SAVE ITIME
-#endif
- ITIME = ITIME + 1
- WRITE(*,*) 'User reading routine called'
- IF(ITIME.EQ.1) THEN
- WRITE(STRING(1:IBFSIZ),'(''*INTARRAY 7=-77'')')
- ELSE IF(ITIME.EQ.2) THEN
- CALL FFUSET(FUSTAR)
- WRITE(STRING(1:IBFSIZ),'(''REALARRAY 7=-77.'')')
- ELSE IF(ITIME.EQ.3) THEN
- WRITE(STRING(1:IBFSIZ),'(''*LOGARRAY 7=OFF'')')
- ELSE IF(ITIME.EQ.4) THEN
- WRITE(STRING(1:IBFSIZ),'(''END'')')
- END IF
- END
diff --git a/src/packlib/ffread/test/fustar.F b/src/packlib/ffread/test/fustar.F
deleted file mode 100644
index 7eaa708..0000000
--- a/src/packlib/ffread/test/fustar.F
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: fustar.F,v 1.1.1.1 1996/03/08 11:50:41 mclareni Exp $
-*
-* $Log: fustar.F,v $
-* Revision 1.1.1.1 1996/03/08 11:50:41 mclareni
-* Ffread
-*
-*
-#include "ffread/pilot.h"
- SUBROUTINE FUSTAR (KEY)
-
- DIMENSION KEY(1)
- CHARACTER*6 KEYSTR
-C
-C----------------- Beginning of executable statements -------------------------
-C
- CALL FFGET ('NCHW', NCHW)
- CALL UHTOC(KEY, NCHW, KEYSTR, 6)
-
- WRITE (*, *)
- + ' USER ACTION ROUTINE CALLED WITH KEY ''', KEYSTR, ''''
- WRITE (*, *)
-
- END
diff --git a/src/packlib/ffread/test/main.F b/src/packlib/ffread/test/main.F
deleted file mode 100644
index 770ce89..0000000
--- a/src/packlib/ffread/test/main.F
+++ /dev/null
@@ -1,79 +0,0 @@
-*
-* $Id: main.F,v 1.2 2004/07/29 13:53:57 mclareni Exp $
-*
-* $Log: main.F,v $
-* Revision 1.2 2004/07/29 13:53:57 mclareni
-* For 64-bit pointer systems put local variables referenced by LOCF
-* in a dummy named common block to keep addresses in the program region.
-* Changed added by cpp define CERNLIB_QMLXIA64 but it should work in all
-* systems.
-*
-* Revision 1.1.1.1 1996/03/08 11:50:41 mclareni
-* Ffread
-*
-*
-#include "ffread/pilot.h"
-#if defined(CERNLIB_CDC)
- PROGRAM FFTEST(INPUT,OUTPUT)
-#endif
-#if !defined(CERNLIB_CDC)
- PROGRAM FFTEST
-#endif
-#if defined(CERNLIB_QMLXIA64)
- COMMON /TEST64/X,Y,I,J,A,B,TEXT
-#endif
-
- INTEGER I, J(10)
- REAL X, Y(10)
- LOGICAL A, B(10)
- CHARACTER*4 TEXT
- EXTERNAL FUREAD, FUSTAR
-C
-C----------------- Beginning of executable statements -------------------------
-C
- I = 0
- X = 0.
- A = .FALSE.
-
- DO 10 K = 1, 10
- J(K) = 0
- Y(K) = 0.
- B(K) = .FALSE.
- 10 CONTINUE
-
- CALL FFINIT (0)
-
- CALL FFSET ('SIZE', 6)
-
- CALL FFRSET( 10, FUREAD)
-
- CALL FFKEY ('INTVAR', I, 1, 'INTEGER')
- CALL FFKEY ('INTARRAY', J, 10, 'INTEGER')
-
- CALL FFKEY ('REALVAR', X, 1, 'REAL')
- CALL FFKEY ('REALARRAY', Y, 10, 'REAL')
-
- CALL FFKEY ('LOGVAR', A, 1, 'LOGICAL')
- CALL FFKEY ('LOGARRAY', B, 10, 'LOGICAL')
-
- CALL FFGO
-
- WRITE (*, *)
-
- WRITE (*, *) ' INTEGER VARIABLE:', I
- WRITE (*, *) ' INTEGER ARRAY: ', (J(K), K = 1, 5)
- WRITE (*, *) ' ', (J(K), K = 6,10)
- WRITE (*, *)
-
- WRITE (*, *) ' LOGICAL VARIABLE:', A
- WRITE (*, *) ' LOGICAL ARRAY: ', (B(K), K = 1, 5)
- WRITE (*, *) ' ', (B(K), K = 6,10)
- WRITE (*, *)
-
- CALL UHTOC (X, 4, TEXT, 4)
- WRITE (*, *) ' TEXT (REALVAR): ''', TEXT, ''''
- WRITE (*, *) ' REAL ARRAY: ', (Y(K), K = 1, 4)
- WRITE (*, *) ' ', (Y(K), K = 5, 8)
- WRITE (*, *) ' ', (Y(K), K = 9,10)
-
- END
diff --git a/src/packlib/ffread/versions/patchy_flags b/src/packlib/ffread/versions/patchy_flags
deleted file mode 100644
index 9544e96..0000000
--- a/src/packlib/ffread/versions/patchy_flags
+++ /dev/null
@@ -1,84 +0,0 @@
-*
-* $Id: patchy_flags,v 1.1.1.1 1996/03/08 11:50:42 mclareni Exp $
-*
-* $Log: patchy_flags,v $
-* Revision 1.1.1.1 1996/03/08 11:50:42 mclareni
-* Ffread
-*
-*
-* This directory was created from ffread.car patch fffread
-#if defined(CERNLIB_IBMMVS)||defined(CERNLIB_IBMVM)
-#ifndef CERNLIB_IBM
-#define CERNLIB_IBM
-#endif
-#endif
-#if defined(CERNLIB_ALLIANT)||defined(CERNLIB_APOLLO)||defined(CERNLIB_CONVEX)||defined(CERNLIB_IBMAIX)||defined(CERNLIB_NECSX)||defined(CERNLIB_UNISYS)
-#ifndef CERNLIB_UNIX
-#define CERNLIB_UNIX
-#endif
-#endif
-#if defined(CERNLIB_DECS)||defined(CERNLIB_HPUX)||defined(CERNLIB_IBMRT)||defined(CERNLIB_SGI)||defined(CERNLIB_SUN)
-#ifndef CERNLIB_UNIX
-#define CERNLIB_UNIX
-#endif
-#endif
-#if defined(CERNLIB_AMIGAUX)||defined(CERNLIB_CDCUX)||defined(CERNLIB_GOULD)||defined(CERNLIB_IPSC)||defined(CERNLIB_MACMPW)||defined(CERNLIB_MACAUX)||defined(CERNLIB_MIPS)
-#ifndef CERNLIB_UNIX
-#define CERNLIB_UNIX
-#endif
-#endif
-#if defined(CERNLIB_MSDOS)||defined(CERNLIB_IBMUX)||defined(CERNLIB_NEXT)||defined(CERNLIB_LINUX)||defined(CERNLIB_WINNT)
-#ifndef CERNLIB_UNIX
-#define CERNLIB_UNIX
-#endif
-#endif
-#if defined(CERNLIB_VAXVMS)||defined(CERNLIB_VAXULX)
-#ifndef CERNLIB_VAX
-#define CERNLIB_VAX
-#endif
-#endif
-#if defined(CERNLIB_CDC)||defined(CERNLIB_CRAY)
-#ifndef CERNLIB_SINGLE
-#define CERNLIB_SINGLE
-#endif
-#endif
-#if defined(CERNLIB_IBM)||defined(CERNLIB_VAX)||defined(CERNLIB_NORD)
-#ifndef CERNLIB_DOUBLE
-#define CERNLIB_DOUBLE
-#endif
-#endif
-#if (defined(CERNLIB_UNIX))&&(!defined(CERNLIB_SINGLE))
-#ifndef CERNLIB_DOUBLE
-#define CERNLIB_DOUBLE
-#endif
-#endif
-#if defined(CERNLIB_IBM)
-#ifndef CERNLIB_QMIBMXA
-#define CERNLIB_QMIBMXA
-#endif
-#endif
-#if defined(CERNLIB_UNIX)
-#ifndef CERNLIB_SAVE
-#define CERNLIB_SAVE
-#endif
-#endif
-#if !defined(CERNLIB_CDC)
-#ifndef CERNLIB_UPLOW
-#define CERNLIB_UPLOW
-#endif
-#endif
-#if defined(CERNLIB_IBM)
-#ifndef CERNLIB_EBCDIC
-#define CERNLIB_EBCDIC
-#endif
-#endif
-#if defined(CERNLIB_VAX)||defined(CERNLIB_DECS)
-#ifndef CERNLIB_TABS
-#define CERNLIB_TABS
-#endif
-#endif
-#if (!defined(CERNLIB_VAX))&&(!defined(CERNLIB_CDC))&&(!defined(CERNLIB_DECS))
-#ifndef CERNLIB_LUNF77
-#define CERNLIB_LUNF77
-#endif
-#endif
diff --git a/src/packlib/ffread/versions/v20x.dat b/src/packlib/ffread/versions/v20x.dat
deleted file mode 100644
index 27feed3..0000000
--- a/src/packlib/ffread/versions/v20x.dat
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: v20x.dat,v 1.1.1.1 1996/03/08 11:50:43 mclareni Exp $
-*
-* $Log: v20x.dat,v $
-* Revision 1.1.1.1 1996/03/08 11:50:43 mclareni
-* Ffread
-*
-*
-* Version 2.0x
-C 2.03 (851120)
-C Bug corrected in routine FFGOR
-C
-C 2.02 (850912)
-C CHARACTER VARIABLES ALLOWED IN CALLS TO FFREAD ROUTINES
-C PROTECTION WHEN TYPING LOWER CASE LETTERS
-C
-C 2.01 (850309)
-C NORD50 VERSION INTRODUCED
-C
-C 2.00 (831024)
-C NEW ROUTINES INTRODUCED
-C FFINIT,FFSET,FFGET,FFGO
-C (SEE FFREAD 2.00 DOCUMENTATION)
-C
diff --git a/src/packlib/ffread/versions/v300.dat b/src/packlib/ffread/versions/v300.dat
deleted file mode 100644
index 089978b..0000000
--- a/src/packlib/ffread/versions/v300.dat
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: v300.dat,v 1.1.1.1 1996/03/08 11:50:43 mclareni Exp $
-*
-* $Log: v300.dat,v $
-* Revision 1.1.1.1 1996/03/08 11:50:43 mclareni
-* Ffread
-*
-*
-* Version 3.00 860417
-C
-C- Complete rewrite to allow an arbitrary length of user
-C keys in the range of 4 to 32.
-C It is now possible to do nested reads.
-C A new type of key 'LOGI' for FFKEY.
-C FORTRAN-77 version only.
-C
diff --git a/src/packlib/ffread/versions/v301.dat b/src/packlib/ffread/versions/v301.dat
deleted file mode 100644
index 4739a0a..0000000
--- a/src/packlib/ffread/versions/v301.dat
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: v301.dat,v 1.1.1.1 1996/03/08 11:50:42 mclareni Exp $
-*
-* $Log: v301.dat,v $
-* Revision 1.1.1.1 1996/03/08 11:50:42 mclareni
-* Ffread
-*
-*
-* Version 3.01 861019
-C
-C- Correct bugs in FFREAD, FFGO
-C- Remove restriction on data cards - '3* 5' is now legal
-C- Introduce possibility to define length of input line in the
-C range 72 to 132 characters (FFINIT, FFGET, FFSET, FFGO)
-C- Optimization for VAX in FFGO
-C
diff --git a/src/packlib/ffread/versions/v302.dat b/src/packlib/ffread/versions/v302.dat
deleted file mode 100644
index 4666f1d..0000000
--- a/src/packlib/ffread/versions/v302.dat
+++ /dev/null
@@ -1,13 +0,0 @@
-*
-* $Id: v302.dat,v 1.1.1.1 1996/03/08 11:50:42 mclareni Exp $
-*
-* $Log: v302.dat,v $
-* Revision 1.1.1.1 1996/03/08 11:50:42 mclareni
-* Ffread
-*
-*
-* Version 3.02 861203
-C
-C- Correct bug in FFCARD which caused incorrect handling of
-C E-format input with exponents greater than 1 digit.
-C
diff --git a/src/packlib/ffread/versions/v303.dat b/src/packlib/ffread/versions/v303.dat
deleted file mode 100644
index 2dafad5..0000000
--- a/src/packlib/ffread/versions/v303.dat
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: v303.dat,v 1.1.1.1 1996/03/08 11:50:42 mclareni Exp $
-*
-* $Log: v303.dat,v $
-* Revision 1.1.1.1 1996/03/08 11:50:42 mclareni
-* Ffread
-*
-*
-* Version 3.03 870817
-C
-C- Correct STOP statement in FFCARD for better FORTRAN 77 compatibility
-C
diff --git a/src/packlib/ffread/versions/v304.dat b/src/packlib/ffread/versions/v304.dat
deleted file mode 100644
index d677bf0..0000000
--- a/src/packlib/ffread/versions/v304.dat
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: v304.dat,v 1.1.1.1 1996/03/08 11:50:42 mclareni Exp $
-*
-* $Log: v304.dat,v $
-* Revision 1.1.1.1 1996/03/08 11:50:42 mclareni
-* Ffread
-*
-*
-* Version 3.04 880328
-C
-C- Maximum number of chars printed by FFREAD changed from 132 to 116
-C
diff --git a/src/packlib/ffread/versions/v305.dat b/src/packlib/ffread/versions/v305.dat
deleted file mode 100644
index 1aca808..0000000
--- a/src/packlib/ffread/versions/v305.dat
+++ /dev/null
@@ -1,13 +0,0 @@
-*
-* $Id: v305.dat,v 1.1.1.1 1996/03/08 11:50:42 mclareni Exp $
-*
-* $Log: v305.dat,v $
-* Revision 1.1.1.1 1996/03/08 11:50:42 mclareni
-* Ffread
-*
-*
-* Version 3.05 880711
-C
-C- Patchy flag for VAX ULTRIX introduced.
-C- PATCH TEST removed, see the INSTALL PAM file
-C
diff --git a/src/packlib/ffread/versions/v306.dat b/src/packlib/ffread/versions/v306.dat
deleted file mode 100644
index f0dbc13..0000000
--- a/src/packlib/ffread/versions/v306.dat
+++ /dev/null
@@ -1,13 +0,0 @@
-*
-* $Id: v306.dat,v 1.1.1.1 1996/03/08 11:50:42 mclareni Exp $
-*
-* $Log: v306.dat,v $
-* Revision 1.1.1.1 1996/03/08 11:50:42 mclareni
-* Ffread
-*
-*
-* Version 3.06 881219
-C
-C- Missing sequence CFREAD added in FFCARD
-C- * added as a comment as well as C
-C
diff --git a/src/packlib/ffread/versions/v307.dat b/src/packlib/ffread/versions/v307.dat
deleted file mode 100644
index 885dd90..0000000
--- a/src/packlib/ffread/versions/v307.dat
+++ /dev/null
@@ -1,14 +0,0 @@
-*
-* $Id: v307.dat,v 1.1.1.1 1996/03/08 11:50:42 mclareni Exp $
-*
-* $Log: v307.dat,v $
-* Revision 1.1.1.1 1996/03/08 11:50:42 mclareni
-* Ffread
-*
-*
-* Version 3.07 890709
-C
-C- New routine FFRSET to set user reading routine
-C- New routine FFUSET to set user action routine
-C- <0 units used with READ card to read from user routine set by FFRSET
-C
diff --git a/src/packlib/ffread/versions/v308.dat b/src/packlib/ffread/versions/v308.dat
deleted file mode 100644
index 097c573..0000000
--- a/src/packlib/ffread/versions/v308.dat
+++ /dev/null
@@ -1,13 +0,0 @@
-*
-* $Id: v308.dat,v 1.1.1.1 1996/03/08 11:50:42 mclareni Exp $
-*
-* $Log: v308.dat,v $
-* Revision 1.1.1.1 1996/03/08 11:50:42 mclareni
-* Ffread
-*
-*
-* Version 3.08 891110
-C
-C- Bug corrected in the handling of the '*' as a comment
-C- Introduce pilot patch *FFREAD, flags UNIX, ULTRIX
-C
diff --git a/src/packlib/ffread/versions/v309.dat b/src/packlib/ffread/versions/v309.dat
deleted file mode 100644
index e3a2779..0000000
--- a/src/packlib/ffread/versions/v309.dat
+++ /dev/null
@@ -1,13 +0,0 @@
-*
-* $Id: v309.dat,v 1.1.1.1 1996/03/08 11:50:42 mclareni Exp $
-*
-* $Log: v309.dat,v $
-* Revision 1.1.1.1 1996/03/08 11:50:42 mclareni
-* Ffread
-*
-*
-* Version 3.09 900212 16.30
-C
-C- Patch/flag changes:
-C > TEST : add in *FFREAD
-C
diff --git a/src/packlib/ffread/versions/v310.dat b/src/packlib/ffread/versions/v310.dat
deleted file mode 100644
index 55e5c3f..0000000
--- a/src/packlib/ffread/versions/v310.dat
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: v310.dat,v 1.1.1.1 1996/03/08 11:50:42 mclareni Exp $
-*
-* $Log: v310.dat,v $
-* Revision 1.1.1.1 1996/03/08 11:50:42 mclareni
-* Ffread
-*
-*
-* Version 3.10 910408 7.00
-C
-C- New patches/flags
-C SFFREAD: Source patch
-C FFFREAD: Flags patch
-C DFFREAD: Documentation patch (originally in P=HISTORY + P=INFORM)
-C segmenting version updates in decks
-C HPUX : For HP/UX
-C MIPS : For MIPS machine
-C
-C- Routine changes:
-C > P=SFFREAD ,D=FFGO : Enable reading of RECFM=V input files
-C > P=TFFREAD ,D=FUREAD : Move DATA statement before SAVE
-C
diff --git a/src/packlib/ffread/versions/v311.dat b/src/packlib/ffread/versions/v311.dat
deleted file mode 100644
index 89d4aa1..0000000
--- a/src/packlib/ffread/versions/v311.dat
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: v311.dat,v 1.1.1.1 1996/03/08 11:50:42 mclareni Exp $
-*
-* $Log: v311.dat,v $
-* Revision 1.1.1.1 1996/03/08 11:50:42 mclareni
-* Ffread
-*
-*
-* Version 3.11 910723 13.00
-C
-C- New patches/flags
-C AMIGAUX, CDCUX, IBMPC, IBMUX, NECSX
-C
-C- Routine changes:
-C > P=FFFREAD : Replace B32 flag by DOUBLE
-C > P=SFFREAD ,D=FFGO : Comment out reading of RECFM=V input files
-C
diff --git a/src/packlib/ffread/versions/v312.dat b/src/packlib/ffread/versions/v312.dat
deleted file mode 100644
index ef4bfe2..0000000
--- a/src/packlib/ffread/versions/v312.dat
+++ /dev/null
@@ -1,14 +0,0 @@
-*
-* $Id: v312.dat,v 1.1.1.1 1996/03/08 11:50:42 mclareni Exp $
-*
-* $Log: v312.dat,v $
-* Revision 1.1.1.1 1996/03/08 11:50:42 mclareni
-* Ffread
-*
-*
-* Version 3.12 911217 12.00
-C
-C- Routine changes:
-C > P=SFFREAD ,D=FFGO : Change for compatibility with f90-NAG
-C > P=SFFREAD ,D=FFKEY : Change for compatibility with f90-NAG
-C
diff --git a/src/packlib/ffread/versions/v313.dat b/src/packlib/ffread/versions/v313.dat
deleted file mode 100644
index e52ed95..0000000
--- a/src/packlib/ffread/versions/v313.dat
+++ /dev/null
@@ -1,13 +0,0 @@
-*
-* $Id: v313.dat,v 1.1.1.1 1996/03/08 11:50:42 mclareni Exp $
-*
-* $Log: v313.dat,v $
-* Revision 1.1.1.1 1996/03/08 11:50:42 mclareni
-* Ffread
-*
-*
-* Version 3.13 920719 16.00
-C
-C- New patches/flags
-C IPSC, MSDOS
-C
diff --git a/src/packlib/ffread/versions/v31303.dat b/src/packlib/ffread/versions/v31303.dat
deleted file mode 100644
index 8393cb4..0000000
--- a/src/packlib/ffread/versions/v31303.dat
+++ /dev/null
@@ -1,13 +0,0 @@
-*
-* $Id: v31303.dat,v 1.1.1.1 1996/03/08 11:50:42 mclareni Exp $
-*
-* $Log: v31303.dat,v $
-* Revision 1.1.1.1 1996/03/08 11:50:42 mclareni
-* Ffread
-*
-*
-* Version 3.13/03 940207 11.00
-C
-C- New patches/flags
-C WINNT
-C
diff --git a/src/packlib/ffread/versions/v314.dat b/src/packlib/ffread/versions/v314.dat
deleted file mode 100644
index ddf8d2c..0000000
--- a/src/packlib/ffread/versions/v314.dat
+++ /dev/null
@@ -1,13 +0,0 @@
-*
-* $Id: v314.dat,v 1.1.1.1 1996/03/08 11:50:42 mclareni Exp $
-*
-* $Log: v314.dat,v $
-* Revision 1.1.1.1 1996/03/08 11:50:42 mclareni
-* Ffread
-*
-*
-* Version 3.14 920918 18.30
-C
-C- New patches/flags
-C NEXT
-C
diff --git a/src/packlib/hbook/Imakefile b/src/packlib/hbook/Imakefile
deleted file mode 100644
index 5981ebc..0000000
--- a/src/packlib/hbook/Imakefile
+++ /dev/null
@@ -1,28 +0,0 @@
-
-#define IHaveSubdirs
-#define PassCDebugFlags
-
-LIBDIRS= hdiff hmerge hquad chbook fpclassc \ @@\
- hrz code hmcstat hntup
-
-#ifdef CERNLIB_VAX
-LIBDIRS := $(LIBDIRS) hglobal
-#endif
-
-#if defined(CERNLIB_UNIX) && !defined(CERNLIB_CRAY) \
- && !defined(CERNLIB_IPSC) && !defined(CERNLIB_MSDOS)
-LIBDIRS := $(LIBDIRS) hmmap
-#endif
-
-SUBDIRS= $(LIBDIRS) tests examples hbook
-
-TopOfPackage(hbook)
-
-SubdirLibraryTarget(hbook,$(LIBDIRS))
-
-TestSubdirs(examples)
-
-/* in code/Imakefile, the pilot is included : */
-DoIncludePackage(hbook)
-
-InstallIncludeSubdirs(hbook)
diff --git a/src/packlib/hbook/chbook/Imakefile b/src/packlib/hbook/chbook/Imakefile
deleted file mode 100644
index ab0d22a..0000000
--- a/src/packlib/hbook/chbook/Imakefile
+++ /dev/null
@@ -1,19 +0,0 @@
-SRCS_C= halloc.c hbvers.c hbpqry.c
-
-#ifdef CERNLIB_UNIX
-#if defined(CERNLIB_APOLLO) || defined(CERNLIB_CONVEX) || defined(CERNLIB_WINNT)
-SRCS_C+= hmmap.c
-#else
-SRCS_C+= hshm.c
-#endif
-#endif
-
-#if defined(CERNLIB_HPUX) || defined(CERNLIB_IBMRT)
-EXTRA_DEFINES := $(EXTRA_DEFINES) -Dextname
-#endif
-
-#if defined(CERNLIB_LINUX)
-EXTRA_DEFINES := $(EXTRA_DEFINES) -Df2cFortran
-#endif
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/hbook/chbook/halloc.c b/src/packlib/hbook/chbook/halloc.c
deleted file mode 100644
index 25a4fac..0000000
--- a/src/packlib/hbook/chbook/halloc.c
+++ /dev/null
@@ -1,673 +0,0 @@
-/*
- * $Id: halloc.c,v 1.3 1997/09/02 13:08:57 mclareni Exp $
- *
- * $Log: halloc.c,v $
- * Revision 1.3 1997/09/02 13:08:57 mclareni
- * WINNT correction
- *
- * Revision 1.2 1997/03/14 17:03:17 mclareni
- * WNT mods
- *
- * Revision 1.1.1.1.2.1 1997/01/21 11:27:47 mclareni
- * All mods for Winnt 96a on winnt branch
- *
- * Revision 1.1.1.1 1996/01/16 17:08:10 mclareni
- * First import
- *
- */
-#include "hbook/pilot.h"
-/*CMZ : 18/10/95 18.01.49 by Julian Bunn*/
-/*-- Author :*/
-#include <stdio.h>
-#include <string.h>
-#include <stdlib.h>
-#include <time.h>
-#if defined(CERNLIB_CRAY)
-#include <fortran.h>
-#endif
-#if defined(CERNLIB_VAX)
-#include <descrip.h>
-#endif
-
-#define MY_STDCALL
-#if defined(CERNLIB_QX_SC)
-#define hbinit1 hbinit1_
-#define hbfree hbfree_
-#define hbfreec hbfreec_
-#define hballo1 hballo1_
-#define hbvm hbvm_
-#define hbsmax hbsmax_
-#define hbgmax hbgmax_
-#define hbprnt hbprnt_
-#endif
-#if defined(CERNLIB_CRAY)
-#define hbinit1 HBINIT1
-#define hbfree HBFREE
-#define hbfreec HBFREEC
-#define hballo1 HBALLO1
-#define hbvm HBVM
-#define hbsmax HBSMAX
-#define hbgmax HBGMAX
-#define hbprnt HBPRNT
-#endif
-#if defined(CERNLIB_WINNT) || defined(CERNLIB_MSSTDCALL)
-#define hbinit1 HBINIT1
-#define hbfree HBFREE
-#define hbfreec HBFREEC
-#define hballo1 HBALLO1
-#define hbvm HBVM
-#define hbsmax HBSMAX
-#define hbgmax HBGMAX
-#define hbprnt HBPRNT
-#define MY_STDCALL __stdcall
-#endif
-#if defined(CERNLIB_IBM)
-#pragma linkage(hbinit1,FORTRAN)
-#pragma linkage(hbfree,FORTRAN)
-#pragma linkage(hbfreec,FORTRAN)
-#pragma linkage(hballo1,FORTRAN)
-#pragma linkage(hbvm,FORTRAN)
-#pragma linkage(hbsmax,FORTRAN)
-#pragma linkage(hbgmax,FORTRAN)
-#pragma linkage(hbprnt,FORTRAN)
-#endif
-
-#ifndef NULL
-# define NULL 0
-#endif
-
-#define False 0
-#define True 1
-
-#define MAX_MALLOC 10485760 /* 10 MB default maximum */
-#define UMAX_MALLOC 128 /* 128 MB user definable maximum */
-
-#define REAL 1
-#define INTEGER 2
-#define UINTEGER 3
-#define BOOLEAN 4
-#define CHAR 5
-
-#ifdef CRAY
-typedef long Boolean;
-#else
-typedef char Boolean;
-#endif
-
-
-/* type declarations */
-typedef struct _NtupleBuffer NtupleBuffer;
-struct _NtupleBuffer {
- int id;
- char path[128];
- char var[36];
- char block[16];
- int type;
- int size;
- int ifirst;
- int nelem;
- Boolean in_use;
- int no_times_used;
- time_t last_used;
- void *data;
- NtupleBuffer *link;
-};
-
-
-/* root and last in NtupleBuffer list */
-static NtupleBuffer *ntbuf_root = NULL;
-static NtupleBuffer *ntbuf_last = NULL;
-
-/* the amount of currently malloced space */
-static unsigned int malloc_used = 0;
-static unsigned int malloc_max = MAX_MALLOC; /* build in limit */
-static unsigned int malloc_umax = MAX_MALLOC; /* user set limit */
-
-/* the amount of space accessed during the programs' lifetime (in words) */
-static float malloc_total = 0.0;
-
-
-/***********************************************************************
- * *
- * Free the least used, oldest, not in_use Ntuple buffer (column). *
- * *
- ***********************************************************************/
-static int free_column(void)
-{
- NtupleBuffer *tmp, *tmp1, *t1, *t2;
-
- /* find least used, oldest, not in_use, with allocated data buffer */
- t1 = NULL;
- tmp1 = NULL;
- tmp = ntbuf_root;
- while (tmp) {
- if (!tmp->in_use && tmp->data) {
- if (t1) {
- if (tmp->no_times_used < t1->no_times_used) {
- t1 = tmp;
- t2 = tmp1;
- }
- if (tmp->no_times_used == t1->no_times_used &&
- tmp->last_used < t1->last_used) {
- t1 = tmp;
- t2 = tmp1;
- }
- } else {
- t1 = tmp;
- t2 = tmp1;
- }
- }
- tmp1 = tmp;
- tmp = tmp->link;
- }
-
- if (t1) {
- /* remove t1 from list */
- if (t2) {
- t2->link = t1->link;
- if (ntbuf_last == t1) ntbuf_last = t2;
- } else {
- ntbuf_root = t1->link;
- if (ntbuf_last == t1) ntbuf_last = NULL;
- }
-
- malloc_used -= t1->size*t1->nelem + sizeof(NtupleBuffer);
-
- /* recuperate space */
- /* printf("free_column: Deleted column %s from memory\n", t1->var); */
- free(t1->data);
- free(t1);
-
- return 0;
- }
-
- /* cannot free any space */
- return -1;
-}
-
-/***********************************************************************
- * *
- * Free all Ntuple buffers. *
- * *
- ***********************************************************************/
-static void free_all(void)
-{
- NtupleBuffer *t1, *t2;
-
- t1 = ntbuf_root;
- while (t1) {
- t2 = t1->link;
- free(t1->data);
- free(t1);
- t1 = t2;
- }
- ntbuf_root = NULL;
- ntbuf_last = NULL;
- malloc_used = 0;
- malloc_max = malloc_umax;
-}
-
-/***********************************************************************
- * *
- * Free all Ntuple buffers for Ntuples in file "path". *
- * *
- ***********************************************************************/
-static void free_lun(char *path)
-{
- NtupleBuffer *t1, *t2, *tmp;
- int lp;
-
- lp = strlen(path);
-
- t1 = ntbuf_root;
- t2 = NULL;
- while (t1) {
- if (!strncmp(t1->path, path, lp)) {
- if (t2) {
- t2->link = t1->link;
- if (ntbuf_last == t1) ntbuf_last = t2;
- } else {
- ntbuf_root = t1->link;
- if (ntbuf_last == t1) ntbuf_last = NULL;
- }
-
- tmp = t1->link;
-
- malloc_used -= t1->size*t1->nelem + sizeof(NtupleBuffer);
-
- free(t1->data);
- free(t1);
-
- t1 = tmp;
- } else {
- t2 = t1;
- t1 = t1->link;
- }
- }
-}
-
-/***********************************************************************
- * *
- * Free all temporary Ntuple buffers. Temporary buffers are *
- * identified by variable names starting with an _. They are used to *
- * store intermediate results during Ntuple plot and project *
- * commands. Temporary buffers are always deleted by hbinit1. *
- * *
- ***********************************************************************/
-static void free_tmp(void)
-{
- NtupleBuffer *t1, *t2, *tmp;
-
- t1 = ntbuf_root;
- t2 = NULL;
- while (t1) {
- if (t1->var[0] == '_') {
- if (t2) {
- t2->link = t1->link;
- if (ntbuf_last == t1) ntbuf_last = t2;
- } else {
- ntbuf_root = t1->link;
- if (ntbuf_last == t1) ntbuf_last = NULL;
- }
-
- tmp = t1->link;
-
- malloc_used -= t1->size*t1->nelem + sizeof(NtupleBuffer);
-
- free(t1->data);
- free(t1);
-
- t1 = tmp;
- } else {
- t2 = t1;
- t1 = t1->link;
- }
- }
-}
-
-/***********************************************************************
- * *
- * Free all in_use Ntuple buffers. Called by hbfree with lun<0. *
- * *
- ***********************************************************************/
-static void free_in_use(void)
-{
- NtupleBuffer *t1, *t2, *tmp;
-
- t1 = ntbuf_root;
- t2 = NULL;
- while (t1) {
- if (t1->in_use && t1->no_times_used <= 1) {
- if (t2) {
- t2->link = t1->link;
- if (ntbuf_last == t1) ntbuf_last = t2;
- } else {
- ntbuf_root = t1->link;
- if (ntbuf_last == t1) ntbuf_last = NULL;
- }
-
- tmp = t1->link;
-
- malloc_used -= t1->size*t1->nelem + sizeof(NtupleBuffer);
-
- free(t1->data);
- free(t1);
-
- t1 = tmp;
- } else {
- t2 = t1;
- t1 = t1->link;
- }
- }
-}
-
-/***********************************************************************
- * *
- * Free all Ntuple buffers or all buffers belonging to Ntuples in *
- * the same unit. *
- * If lun<0 free all Ntuple buffers that are in use (do this from an *
- * exception handler in case the filling of the buffers was *
- * interrupted). *
- * *
- ***********************************************************************/
-void MY_STDCALL hbfree(int *lun)
-{
- char path[15];
-
- if (*lun == 0)
- free_all();
- else if (*lun < 0)
- free_in_use();
- else {
- sprintf(path, "//LUN%d", *lun);
- free_lun(path);
- strcpy(path, "//PAWC"); /* <--- add these two lines */
- free_lun(path); /* <--- */
- }
-}
-
-/***********************************************************************
- * *
- * Free all Ntuple buffers belonging to Ntuples in the chain CHAIN. *
- * *
- ***********************************************************************/
-#if defined(CERNLIB_VAX)
-void hbfreec( struct dsc$descriptor_s *dsc_chain1, int *lc)
-{
- char *chain1 = dsc_chain1->dsc$a_pointer;
-#endif
-#if defined(CERNLIB_CRAY)
-void hbfreec(_fcd fcd_chain1, int *lc)
-{
- char *chain1 = _fcdtocp( fcd_chain1 );
-#endif
-#if (!defined(CERNLIB_VAX))&&(!defined(CERNLIB_CRAY))
-#ifndef CERNLIB_MSSTDCALL
-void MY_STDCALL hbfreec(char *chain1, int *lc)
-#else
-void MY_STDCALL hbfreec(char *chain1, int len_chain1, int *lc)
-#endif
-{
-#endif
- char chain[80];
-
- strncpy(chain, chain1, *lc); chain[*lc] = '\0';
-
- free_lun(chain);
-}
-
-/***********************************************************************
- * *
- * Report the total number of words accessed during the programs' *
- * lifetime. *
- * *
- ***********************************************************************/
-void MY_STDCALL hbvm(float *words)
-{
- *words = malloc_total;
-}
-
-/***********************************************************************
- * *
- * Change the maximum amount of memory that may be malloced. *
- * *
- ***********************************************************************/
-void MY_STDCALL hbsmax(int *mbytes)
-{
- int mb = *mbytes;
-
- if (mb >= 0) {
- if (mb > UMAX_MALLOC) mb = UMAX_MALLOC;
-
- malloc_umax = mb*1024*1024;
- malloc_max = malloc_umax;
- }
-}
-
-/***********************************************************************
- * *
- * Get the maximum amount of memory that may be malloced. *
- * *
- ***********************************************************************/
-void MY_STDCALL hbgmax(int *mbytes)
-{
- *mbytes = malloc_umax/(1024*1024);
-}
-
-/***********************************************************************
- * *
- * Print buffer statistics. *
- * *
- ***********************************************************************/
-void MY_STDCALL hbprnt(int *flag)
-{
- NtupleBuffer *ntbuf;
- char type;
-
- if (*flag == 1) {
- printf("\n Dynamic Ntuple Memory Buffer Statistics (in bytes):\n\n");
- printf(" Upper Limit Used Free\n");
- printf(" %-10d %-10d %-10d\n\n", malloc_max,
- malloc_used, malloc_max - malloc_used);
-
- } else {
-
- ntbuf = ntbuf_root;
- printf("\n Variable Lun Ntuple Type Usage");
- printf(" Size\n");
- printf("----------------------------------------------------");
- printf("-------------\n");
- if (!ntbuf) {
- printf(" No variables in memory.\n\n");
- return;
- }
-
- while (ntbuf) {
- switch (ntbuf->type) {
- case REAL:
- type = 'R';
- break;
- case INTEGER:
- type = 'I';
- break;
- case UINTEGER:
- type = 'U';
- break;
- case BOOLEAN:
- type = 'L';
- break;
- case CHAR:
- type = 'C';
- break;
- }
- printf("%10s %10s %8d %c %5d %9d\n",
- ntbuf->var, ntbuf->path, ntbuf->id, type,
- ntbuf->no_times_used, ntbuf->size*ntbuf->nelem);
-
- ntbuf = ntbuf->link;
- if (!ntbuf)
- printf("\n");
- }
- }
-}
-
-/***********************************************************************
- * *
- * Initialize the Ntuple buffer manager, i.e. declare all buffers *
- * unused (but don't free them because they will be used again). *
- * *
- ***********************************************************************/
-void MY_STDCALL hbinit1(int *tfree)
-{
- NtupleBuffer *tmp;
-
- /* clear in_use flag of all buffers */
- tmp = ntbuf_root;
- while (tmp) {
- tmp->in_use = False;
- tmp = tmp->link;
- }
-
- /* free space occupied by tmp buffers */
- if (*tfree == 1)
- free_tmp();
-}
-
-/***********************************************************************
- * *
- * Allocate space for Ntuple column of size*nelem bytes. *
- * If not enough space call free_column to free the least used, *
- * oldest not in_use buffer. *
- * *
- ***********************************************************************/
-static NtupleBuffer *hballo2(int id, char *path, char *var, char *block,
- int type, int size, int ifirst, int nelem)
-{
- NtupleBuffer *ntbuf, *tmp;
-
- /* see if buffer is already allocated */
- tmp = ntbuf_root;
- while (tmp) {
- /*
- * For the time being the variable name must be unique in an Ntuple
- * so no need to test on the block name.
- * if (tmp->id == id && !strcmp(tmp->path, path) &&
- * !strcmp(tmp->var, var) && !strcmp(tmp->block, block)) {
- */
- if (tmp->id == id && !strcmp(tmp->path,path) && !strcmp(tmp->var,var)) {
- ntbuf = tmp;
- break;
- }
- tmp = tmp->link;
- }
-
- /* if not allocate it */
- if (!tmp) {
- /* is there enough space left? */
-again:
- while (malloc_used + size*nelem + sizeof(NtupleBuffer) > malloc_max) {
- if (free_column() == -1)
- return NULL;
- goto again;
- }
-
- ntbuf = (NtupleBuffer *) calloc(1, sizeof(NtupleBuffer));
- if (!ntbuf) {
- if (free_column() == -1)
- return NULL;
- goto again;
- }
-
- strcpy(ntbuf->path, path);
- strcpy(ntbuf->var, var);
- strcpy(ntbuf->block, block);
- ntbuf->id = id;
- ntbuf->type = type;
- ntbuf->size = size;
- ntbuf->ifirst = ifirst;
- ntbuf->nelem = nelem;
- ntbuf->data = malloc(size*nelem);
-
- if (!ntbuf->data) {
- free(ntbuf);
- if (free_column() == -1)
- return NULL;
- goto again;
- }
-
- if (!ntbuf_root) {
- ntbuf_root = ntbuf;
- ntbuf_last = ntbuf;
- } else {
- ntbuf_last->link = ntbuf;
- ntbuf_last = ntbuf;
- }
-
- malloc_used += size*nelem + sizeof(NtupleBuffer);
-
- } else if (nelem > ntbuf->nelem || ifirst != ntbuf->ifirst ||
- strlen(path) == 0) {
-
- void *data;
-
- /*
- * Buffer is already allocated but too small or contains the
- * wrong range of elements or memory resident Ntuple.
- * Turn on in_use flag so when columns have to be freed to get
- * more space this column is not freed, and reset the no_times_use
- * counter so the buffer will be filled again.
- */
- ntbuf->no_times_used = 0;
- ntbuf->in_use = True;
-
-again1:
- while (malloc_used + size*(nelem-ntbuf->nelem) > malloc_max) {
- if (free_column() == -1) {
- ntbuf->in_use = False; /* buffer is not used so may be freed */
- return NULL;
- }
- goto again1;
- }
-
- ntbuf->ifirst = ifirst;
- ntbuf->nelem = nelem;
- data = realloc(ntbuf->data, size*nelem);
-
- if (!data) {
- if (free_column() == -1) {
- ntbuf->in_use = False; /* buffer is not used so may be freed */
- return NULL;
- }
- goto again1;
- }
-
- ntbuf->data = data;
-
- }
-
- ntbuf->no_times_used++;
- ntbuf->in_use = True;
- ntbuf->last_used = time(NULL);
-
- malloc_total += (float)(size*nelem + sizeof(NtupleBuffer))/4.0;
-
- return ntbuf;
-}
-
-/***********************************************************************
- * *
- * Interface routine to hballo2 which allocates the buffer. *
- * *
- ***********************************************************************/
-#if defined(CERNLIB_VAX)
-void hballo1(int *id, struct dsc$descriptor_s *dsc_path1, int *lp,
- struct dsc$descriptor_s *dsc_var1, int *lv,
- struct dsc$descriptor_s *dsc_block1, int *lb, int *type,
- int *size, int *ifirst, int *nelem, long *buf, int *nuse)
-{
- char *path1 = dsc_path1->dsc$a_pointer;
- char *var1 = dsc_var1->dsc$a_pointer;
- char *block1 = dsc_block1->dsc$a_pointer;
-#endif
-#if defined(CERNLIB_CRAY)
-void hballo1(int *id, _fcd fcd_path1, int *lp, _fcd fcd_var1, int *lv,
- _fcd fcd_block1, int *lb, int *type,
- int *size, int *ifirst, int *nelem, long *buf, int *nuse)
-{
- char *path1 = _fcdtocp( fcd_path1 );
- char *var1 = _fcdtocp( fcd_var1 );
- char *block1 = _fcdtocp( fcd_block1 );
-#endif
-#if (!defined(CERNLIB_VAX))&&(!defined(CERNLIB_CRAY))
-#ifndef CERNLIB_MSSTDCALL
-void MY_STDCALL hballo1(int *id, char *path1, int *lp, char *var1, int *lv,
- char *block1, int *lb, int *type,
- int *size, int *ifirst, int *nelem, long *buf, int *nuse)
-#else
-void MY_STDCALL hballo1(int *id, char *path1, int len_path1, int *lp,
- char *var1, int len_var1, int *lv,
- char *block1,int len_block1,
- int *lb, int *type, int *size, int *ifirst,
- int *nelem, long *buf, int *nuse)
-#endif
-{
-#endif
- char path[128], var[36], block[16];
- unsigned long tmp;
- NtupleBuffer *ntbuf;
-
- strncpy(path, path1, *lp); path[*lp] = '\0';
- strncpy(var, var1, *lv); var[*lv] = '\0';
- strncpy(block, block1, *lb); block[*lb] = '\0';
-
- ntbuf = hballo2(*id, path, var, block, *type, *size, *ifirst, *nelem);
-
- if (!ntbuf) {
- *nuse = 0;
- *buf = 0;
- } else {
- *nuse = ntbuf->no_times_used;
- tmp = (unsigned long) ntbuf->data;
- *buf = (long) (tmp >> 2);
- }
-}
diff --git a/src/packlib/hbook/chbook/hbpqry.c b/src/packlib/hbook/chbook/hbpqry.c
deleted file mode 100644
index 837e137..0000000
--- a/src/packlib/hbook/chbook/hbpqry.c
+++ /dev/null
@@ -1,59 +0,0 @@
-#define PQRY_KEYW "PQRY"
-#define INVALID_KEYW "Invalid"
-#define VERS_KEYW "VERS"
-
-#include "hbook/pilot.h"
-#include <cfortran/cfortran.h>
-
-
-/* PiafVers = 0 -> a PIAF server before new QP; >1 later versions */
-static int PiafVers = 0;
-
-
-/* Function to set the PIAF version */
-void
-SetVers(int Version)
-{
- PiafVers = Version;
-}
-FCALLSCSUB1(SetVers,SETPIAFVER,setpiafver,INT)
-
-
-/* Function to get the PIAF version */
-int
-GetPiafVersion ()
-{
- return PiafVers;
-}
-FCALLSCFUN1(INT,GetPiafVersion,IGETPIAFVER,igetpiafver,INT)
-
-
-/* To allow the PAW client to query the Piaf master, the MESSAGE command */
-/* back door is used. This function checks the PIAF text output to 'grep' */
-/* the PQRY keyword; if the keyword is found some specific processing takes */
-/* place, according to another keyword that identifies the name of the info */
-/* actually retrieved */
-void
-GrepPqryStr (char *LogLine, int *retval)
-{
- char s1[32],s2[32];
- int pv;
- if (strstr (LogLine,PQRY_KEYW) != NULL) {
- *retval = 1;
- /* PQRY's handler */
- if (strstr (LogLine,VERS_KEYW) != NULL) {
- /* There is a version message */
- if (strstr (LogLine,INVALID_KEYW) == NULL) {
- /* Querying the PIAF version */
- sscanf(LogLine,"%s %s %d",s1,s2,&pv);
- SetVers (pv);
- } else {
- SetVers(0);
- }
- }
- } else {
- *retval = 0;
- }
-}
-FCALLSCSUB2(GrepPqryStr,GREPPQRY,greppqry,PSTRING,PINT)
-
diff --git a/src/packlib/hbook/chbook/hbvers.c b/src/packlib/hbook/chbook/hbvers.c
deleted file mode 100644
index 0722eb1..0000000
--- a/src/packlib/hbook/chbook/hbvers.c
+++ /dev/null
@@ -1,101 +0,0 @@
-/*
- * $Id: hbvers.c,v 1.27 2003/06/04 15:03:55 couet Exp $
- *
- * $Log: hbvers.c,v $
- * Revision 1.27 2003/06/04 15:03:55 couet
- * - 4.28/01
- *
- * Revision 1.26 2003/02/07 12:15:34 couet
- * - 4.28/00
- *
- * Revision 1.25 2001/12/12 16:23:34 couet
- * - 4.27/03
- *
- * Revision 1.24 2001/10/10 08:24:41 couet
- * - 4.27/02
- *
- * Revision 1.23 2001/10/02 09:08:37 couet
- * - 4.27/01
- *
- * Revision 1.22 2001/09/24 14:30:19 couet
- * - 4.27/00
- *
- * Revision 1.21 2000/12/19 16:59:24 couet
- * - 4.26/01
- *
- * Revision 1.20 2000/01/25 17:10:02 couet
- * - 4.26/00
- *
- * Revision 1.19 1999/03/23 14:37:30 couet
- * vers ++
- *
- * Revision 1.18 1999/03/05 15:44:14 couet
- * - ver++
- *
- * Revision 1.17 1999/02/18 09:53:38 couet
- * - 4.25/02
- *
- * Revision 1.16 1998/11/10 09:24:46 couet
- * - 4.25/01 and Y2K
- *
- * Revision 1.15 1998/06/11 13:29:38 couet
- * - 4.25/00
- *
- * Revision 1.14 1998/04/09 13:00:01 couet
- * - Compilation date removed from the vidqq string: it was meaningless
- *
- * Revision 1.13 1998/03/20 09:46:43 couet
- * - 4.24/11
- *
- * Revision 1.12 1998/01/06 13:01:12 couet
- * - version ++
- *
- * Revision 1.11 1997/09/18 07:26:12 couet
- * - 4.24/09
- *
- * Revision 1.10 1997/08/20 16:10:08 couet
- * error in the date
- *
- * Revision 1.9 1997/08/20 16:04:02 couet
- * - vers ++
- *
- * Revision 1.8 1997/05/13 15:27:10 couet
- * - version++
- *
- * Revision 1.7 1997/02/27 14:46:31 couet
- * - 4.24/06
- *
- * Revision 1.6 1997/02/25 14:14:33 couet
- * - 4.24/05
- *
- * Revision 1.5 1997/02/21 12:23:21 couet
- * - 4.24/04
- *
- * Revision 1.4 1997/01/17 09:11:48 couet
- * - version ++
- *
- * Revision 1.3 1997/01/10 17:50:28 couet
- * version++
- *
- * Revision 1.2 1996/11/18 13:52:38 couet
- * - Version ++
- *
- * Revision 1.1.1.1 1996/01/16 17:08:10 mclareni
- * First import
- *
- */
-#include "hbook/pilot.h"
-
-static char vidqq[] =
-"@(#)HBOOK 4.28/01 04/06/2003 17.00.00";
-
-/*
- * Return the static version string for HBOOK
- */
-
-char *
-hbvers()
-{
- /* skip the 4 char that contain the "what" string */
- return &vidqq[4];
-}
diff --git a/src/packlib/hbook/chbook/hmmap.c b/src/packlib/hbook/chbook/hmmap.c
deleted file mode 100644
index 11e8630..0000000
--- a/src/packlib/hbook/chbook/hmmap.c
+++ /dev/null
@@ -1,264 +0,0 @@
-/*
- * $Id: hmmap.c,v 1.3 1997/09/02 13:08:59 mclareni Exp $
- *
- * $Log: hmmap.c,v $
- * Revision 1.3 1997/09/02 13:08:59 mclareni
- * WINNT correction
- *
- * Revision 1.2 1997/03/14 17:03:19 mclareni
- * WNT mods
- *
- * Revision 1.1.1.1.2.1 1997/01/21 11:27:55 mclareni
- * All mods for Winnt 96a on winnt branch
- *
- * Revision 1.1.1.1 1996/01/16 17:08:10 mclareni
- * First import
- *
- */
-#include "hbook/pilot.h"
-#if defined(CERNLIB_BSD)||defined(CERNLIB_WINNT)
-/*CMZ : 4.20/04 05/08/93 15.06.17 by Rene Brun*/
-/*-- Author : Fons Rademakers 20/03/91*/
-
-#ifdef WIN32
-/* One needs to set the following options to compile this module:
- * $(cc) -DALPHA=1 -DWIN32 -DNT -DWIN -DNOT_IMPLEMENTED
- -D_PORTABLE_32BIT_CONTEXT
- */
- #include <windows.h>
- #include <io.h>
-#endif
-
-#include <stdio.h>
-#include <string.h>
-#include <stdlib.h>
-#include <errno.h>
-#include <fcntl.h>
-#include <sys/types.h>
-#ifndef WIN32
- #include <sys/mman.h>
- #include <sys/file.h>
- #include <sys/stat.h>
-#endif
-
-#if defined(CERNLIB_QXCAPT)
-# define hcreatei type_of_call HCREATEI
-# define hmapi type_of_call HMAPI
-# define hfreem type_of_call HFREEM
-#else
-# if defined(CERNLIB_QX_SC)
-# define hcreatei hcreatei_
-# define hmapi hmapi_
-# define hfreem hfreem_
-#endif
-#endif
-
-static int fd_pawc;
-static long len;
-
-
-/***********************************************************************
- * *
- * Create a memory mapped file and map common on it. *
- * mfile the filename *
- * mflen length of filename *
- * base_common common that should be mapped to file *
- * size length of common in 32 bit words *
- * comaddr starting address of the mapping on output *
- * *
- ***********************************************************************/
-#ifndef CERNLIB_MSSTDCALL)
-int hcreatei(char *mfile, int *mflen, long *base_common, int *size,
- long *comaddr)
-#else
-int hcreatei(char *mfile, int len_mfile, int *mflen, long *base_common, int *size,
- long *comaddr)
-#endif
-{
-#ifdef WIN32
- HANDLE hMap, paddr=NULL;
-#else
- caddr_t paddr;
- char *file, *buf;
-#endif
- int istat;
- unsigned long inter;
-
- len = *size * 4;
-#ifndef WIN32
- file = calloc(*mflen+6, 1);
- strcpy(file, "/tmp/");
- strncat(file, mfile, *mflen);
-
- buf = calloc(len, 1);
-
- fd_pawc = open(file,O_RDWR|O_CREAT,0666);
- free(file);
- if (fd_pawc < 0) {
- perror("open");
- istat = -errno;
- free(buf);
- } else
-#endif
- {
- /* reserve space in file */
-#if defined(CERNLIB_WINNT)
- char *mapname;
- int i;
- istat = -1;
- mapname = malloc(*mflen+1);
- memcpy(mapname,mfile,*mflen);mapname[*mflen] = 0;
- hMap = CreateFileMapping((HANDLE)0xffffffff, NULL, PAGE_READWRITE,
- 0, len, (LPSTR) mapname);
- free(mapname);
- paddr = NULL;
- if (hMap != NULL)
- paddr = MapViewOfFile(hMap, FILE_MAP_READ | FILE_MAP_WRITE, 0 , 0, 0);
-#else
- istat = write(fd_pawc, buf, len);
- free(buf);
- if (istat != len) {
- istat = -1;
- close(fd_pawc);
- return(istat);
- }
-#endif
-#if defined(CERNLIB_APOLLO)
- paddr = mmap((caddr_t) base_common, &len,
- PROT_READ|PROT_WRITE, MAP_FILE|MAP_SHARED, fd_pawc, 0);
-#endif
-#if defined(CERNLIB_SUN)
- paddr = mmap((caddr_t) base_common, len,
- PROT_READ|PROT_WRITE, MAP_SHARED, fd_pawc, 0);
-#endif
- if (paddr == NULL) {
- perror("mmap");
-#ifdef WIN32
- istat = GetLastError();
- istat = -istat;
-#else
- istat = -errno;
- close(fd_pawc);
-#endif
- } else {
- istat = 0;
- inter = (unsigned long) paddr;
- *comaddr = (long) (inter >> 2);
- }
- }
- return(istat);
-}
-
-/***********************************************************************
- * *
- * Map common to file. *
- * mfile the filename *
- * mflen length of filename *
- * base_common common that should be mapped to file *
- * size length of common in 32 bit words *
- * comaddr starting address of the mapping on output *
- * *
- ***********************************************************************/
-#ifndef CERNLIB_MSSTDCALL
- int hmapi(char *mfile, int *mflen, long *base_common, long *comaddr)
-#else
- int hmapi(char *mfile, int len_mfile, int *mflen, long *base_common, long *comaddr)
-#endif
-{
-#ifdef WIN32
- HANDLE hMap, paddr;
-#else
- caddr_t paddr;
-#endif
- unsigned long inter;
- int istat;
-#if defined(CERNLIB_WINNT)
- int i;
- char *mapname;
-
- mapname = malloc(*mflen+1);
- memcpy(mapname,mfile,*mflen);mapname[*mflen] = 0;
- hMap = OpenFileMapping(FILE_MAP_READ | FILE_MAP_WRITE, FALSE,
- (LPTSTR)mapname);
- free(mapname);
-
- if (hMap == NULL) {
- perror("open");
- istat = GetLastError();
- istat = -istat;
- } else {
- paddr= MapViewOfFile(hMap, FILE_MAP_READ | FILE_MAP_WRITE,0,0,0);
-#else
- char *file;
- struct stat buf;
-
- file = calloc(*mflen+6, 1);
- strcpy(file, "/tmp/");
- strncat(file, mfile, *mflen);
-
- fd_pawc = open(file,O_RDWR);
- free(file);
- if (fd_pawc < 0 ) {
- perror("open");
- istat = -errno;
- } else {
- stat(file,&buf);
- len = buf.st_size;
-#endif
-#if defined(CERNLIB_APOLLO)
- paddr = mmap((caddr_t) base_common, &len,
- PROT_READ|PROT_WRITE, MAP_FILE|MAP_SHARED, fd_pawc, 0);
-#endif
-#if defined(CERNLIB_SUN)
- paddr = mmap((caddr_t) base_common, len,
- PROT_READ|PROT_WRITE, MAP_SHARED, fd_pawc, 0);
-#endif
- if (paddr == NULL) {
- perror("mmap");
-#ifdef WIN32
- istat = GetLastError();
- istat = -istat;
-#else
- istat = -errno;
- close(fd_pawc);
-#endif
- } else {
- istat = 0;
- inter = (unsigned long) paddr;
- *comaddr = (long) (inter >> 2);
- }
- }
- return(istat);
-}
-
-/***********************************************************************
- * *
- * Unmap common and close file. *
- * comaddr address of common that should be unmapped *
- * *
- ***********************************************************************/
-int hfreem(long *comaddr)
-{
- int istat;
-
-#ifdef WIN32
- istat = 0;
- if (!UnmapViewOfFile((LPVOID)(*comaddr << 2))) istat = -1;
-#else
- istat = munmap((caddr_t) *comaddr, len);
-#endif
- if (istat == -1) {
- perror("munmap");
-#ifdef WIN32
- istat = GetLastError();
- istat = -istat;
-#else
- istat = -errno;
-#endif
- }
-#ifndef WIN32
- close(fd_pawc);
-#endif
- return(istat);
-}
-#endif
diff --git a/src/packlib/hbook/chbook/hshm.c b/src/packlib/hbook/chbook/hshm.c
deleted file mode 100644
index 7405d2c..0000000
--- a/src/packlib/hbook/chbook/hshm.c
+++ /dev/null
@@ -1,197 +0,0 @@
-/*
- * $Id: hshm.c,v 1.2 1996/03/13 10:13:08 couet Exp $
- *
- * $Log: hshm.c,v $
- * Revision 1.2 1996/03/13 10:13:08 couet
- * Mods for ALPHA_OSF: William Badgett, Univ of Wisconsin <BADGETT at vxdesy.desy.de>
- *
- * Revision 1.1.1.1 1996/01/16 17:08:10 mclareni
- * First import
- *
- */
-#include "hbook/pilot.h"
-#if defined(CERNLIB_SYS5)
-/*CMZ : 4.20/10 11/10/93 15.44.27 by Rene Brun*/
-/*-- Author : Fons Rademakers 20/03/91*/
-/*-- Modified: Wojtek Burkot 02/03/92*/
-
-#include <stdio.h>
-#include <errno.h>
-#include <sys/types.h>
-#include <sys/ipc.h>
-#include <sys/shm.h>
-
-#if defined(CERNLIB_QX_SC)
-#define hcreatei hcreatei_
-#define hmapi hmapi_
-#define hfreem hfreem_
-#endif
-#if defined(CERNLIB_LINUX)
-#define SHM_R 0400
-#define SHM_W 0200
-#endif
-
-static int shm_pawc;
-static void *paddr;
-static long len;
-
-
-/***********************************************************************
- * *
- * Create a shared memory segment. *
- * mkey identifier for the shared segment *
- * size length of common in 32 bit words *
- * comaddr required starting address of mapping on input *
- * starting address of the mapping on output *
- * *
- ***********************************************************************/
-#if defined(CERNLIB_ALPHA_OSF)
-int hcreatei(key_t *mkey, int *size, void *comaddr)
-#endif
-#if !defined(CERNLIB_ALPHA_OSF)
-int hcreatei(key_t *mkey, int *size, long *comaddr)
-#endif
-{
- int istat;
- int flag = IPC_CREAT | 0666;
- unsigned long inter;
- void *req_addr;
-
- len = *size * 4;
-
- /* create shared memory segment */
- if ((shm_pawc = shmget(*mkey, len, flag)) < 0) {
- perror("shmget");
- istat = -errno;
- return(istat);
- }
-
- /*
- * attach shared memory segment
- * starting at req_addr
- */
-#if !defined(CERNLIB_ALPHA_OSF)
- req_addr = (void*)(*comaddr);
-#endif
-#if defined(CERNLIB_ALPHA_OSF)
- req_addr = comaddr;
-#endif
- if ((paddr = shmat(shm_pawc, req_addr, SHM_RND)) == (void *)-1) {
- perror("shmat");
- istat = -errno;
- } else {
- istat = 0;
- inter = (unsigned long) paddr;
-#if !defined(CERNLIB_ALPHA_OSF)
- *comaddr = (long) (inter >> 2);
-#endif
-#if defined(CERNLIB_ALPHA_OSF)
- if ( paddr != comaddr )
- {
- printf ( "shmat: error attaching map to requested memory address\n" ) ;
- istat = -1;
- }
-#endif
- }
- return(istat);
-}
-
-/***********************************************************************
- * *
- * Attach to existing shared memory segment. *
- * mkey identifier for the shared segment *
- * comaddr required starting address of mapping on input *
- * starting address of the mapping on output *
- * *
- ***********************************************************************/
-#if defined(CERNLIB_ALPHA_OSF)
-int hmapi(key_t *mkey, void *comaddr)
-#endif
-#if !defined(CERNLIB_ALPHA_OSF)
-int hmapi(key_t *mkey, long *comaddr)
-#endif
-{
- int istat;
- unsigned long inter;
- void *req_addr;
- struct shmid_ds shm_stat;
-
- /* get id of existing shared memory segment */
- if ((shm_pawc = shmget(*mkey, 0, SHM_R | SHM_W)) < 0) {
- perror("shmget");
- istat = -errno;
- return(istat);
- }
-
- /* get size of shared memory segment */
- if (shmctl(shm_pawc, IPC_STAT, &shm_stat) == -1) {
- perror("shmctl");
- istat = -errno;
- return(istat);
- }
- len = shm_stat.shm_segsz;
-
- /*
- * set required mapping address - actual mapping addres depends on
- * setting of system variables. This requires modification in
- * the interface fortran routine HMAPM
- */
-#if !defined(CERNLIB_ALPHA_OSF)
- req_addr=(void*)(*comaddr);
-#endif
-#if defined(CERNLIB_ALPHA_OSF)
- req_addr=comaddr;
-#endif
- /* attach shared memory segment */
- if ((paddr = shmat(shm_pawc, req_addr, SHM_RND)) == (void *)-1) {
- perror("shmat");
- istat = -errno;
- } else {
- istat = 0;
- inter = (unsigned long) paddr;
-#if !defined(CERNLIB_ALPHA_OSF)
- *comaddr = (long) (inter >> 2);
-#endif
-#if defined(CERNLIB_ALPHA_OSF)
- if ( paddr != comaddr )
- {
- printf ( "shmat: error attaching map to requested memory address\n" ) ;
- istat = -1;
- }
-#endif
- }
- return(istat);
-}
-
-/***********************************************************************
- * *
- * Free a shared memory segment. *
- * comaddr address of common that should be unmapped (not used) *
- * *
- ***********************************************************************/
-#if defined(CERNLIB_ALPHA_OSF)
-int hfreem(void *comaddr)
-#endif
-#if !defined(CERNLIB_ALPHA_OSF)
-int hfreem(long *comaddr)
-#endif
-{
- int istat;
-
- /* unmaps segment from address space */
- if ((istat = shmdt(paddr)) == -1) {
- perror("shmdt");
- istat = -errno;
- return(istat);
- }
-
- /* delete shared segment */
-/*****
- if ((istat = shmctl(shm_pawc, IPC_RMID, (struct shmid_ds *)0)) == -1) {
- perror("shmctl");
- istat = -errno;
- }
-*****/
- return(istat);
-}
-#endif
diff --git a/src/packlib/hbook/code/Imakefile b/src/packlib/hbook/code/Imakefile
deleted file mode 100644
index d460bea..0000000
--- a/src/packlib/hbook/code/Imakefile
+++ /dev/null
@@ -1,62 +0,0 @@
-SRCS_F= h1evli.F h2page.F harith.F harray.F hauto.F hbandx.F \ @@\
- hbandy.F hbar2.F hbarx.F hbary.F hbasft.F hbcd.F hbcdf.F \ @@\
- hbcdi.F hbfun1.F hbfun2.F hbigbi.F hbin.F hbinsz.F hblack.F \ @@\
- hbook1.F hbook2.F hbookb.F hbookn.F hbooknc.F hbpro.F \ @@\
- hbprof.F hbprox.F hbproy.F hbslix.F hbsliy.F hbstat.F \ @@\
- hbtit.F hbuff.F hbug.F hcdir.F hchnam.F hcmom.F hcompa.F \ @@\
- hconvol.F hcopy.F hcopym.F hcopyn.F hcopyr.F hcopyt.F \ @@\
- hcopyu.F hcorrl.F hcovw.F hcx.F hcxy.F hdcofl.F hddir.F \ @@\
- hdelet.F hderi1.F hderi2.F hderin.F hderiv.F hdexpo.F \ @@\
- hdipkl.F hdummy.F hdump.F heleft.F hermes.F herror.F \ @@\
- hexda1.F hexdat.F hexist.F hf1.F hf1aut.F hf1e.F hf1n.F \ @@\
- hf2.F hfact.F hfc1.F hfc2.F hfcn.F hfcnh.F hfcnv.F hfcnv1.F \ @@\
- hfcx.F hfcxy.F hfetc1.F hfetch.F hff1.F hff2.F hfidp.F \ @@\
- hfill.F hfilpf.F hfilpr.F hfinam.F hfind.F hfinop.F hfit.F \ @@\
- hfit1.F hfitex.F hfitf.F hfitga.F hfith.F hfith1.F hfithc.F \ @@\
- hfithn.F hfitl.F hfitn.F hfitpo.F hfits.F hfitv.F hfn.F \ @@\
- hfnov.F hforma.F hfpak1.F hfpbug.F hframe.F hfumil.F hfunc.F \ @@\
- hgaus.F hgdire.F hgetff.F hgetfl.F hgfit.F hgive.F hgiven.F \ @@\
- hgn.F hgnf.F hgnpar.F hgstat.F hhipar.F hhxye.F hi.F \ @@\
- hictoi.F hid1.F hid2.F hidall.F hidopt.F hidpos.F hie.F \ @@\
- hif.F hij.F hije.F hijxy.F hindex.F hinprx.F hinteg.F \ @@\
- hipak1.F histdo.F histgo.F hix.F hkf1.F hkf1q.F hkf2.F \ @@\
- hkff1.F hkff2.F hkffi1.F hkfi1.F hkfil2.F hkfill.F hkfilpf.F \ @@\
- hkind.F hknul1.F hknuli.F hlabel.F hlabeq.F hlabnb.F \ @@\
- hlattr.F hlccmp.F hldir.F hldir1.F hldir2.F hldirt.F \ @@\
- hlgnxt.F hlhcmp.F hlimit.F hllsq.F hlnext.F hlocat.F \ @@\
- hlogar.F hloop.F hlpos.F hlshft.F hlsort.F hlsq.F hlswap.F \ @@\
- hmachi.F hmax.F hmaxim.F hmconv.F hmdir.F hmedia.F hmin.F \ @@\
- hminim.F hminui.F hminut.F hmonit.F hmufit.F hnoent.F \ @@\
- hnorma.F hobsol.F hoper1.F hoper1a.F hopera.F houtpu.F \ @@\
- hp1dim.F hp1rot.F hpaff.F hpagsz.F hpak.F hpakad.F hpake.F \ @@\
- hpakes.F hparam.F hparmn.F hpath.F hpchan.F hpchar.F \ @@\
- hpcont.F hpdir.F hphist.F hphs.F hphst.F hpkr32.F hpolyn.F \ @@\
- hponce.F hpr1h.F hpr1v.F hpr2.F hprcha.F hprcon.F hprerr.F \ @@\
- hprfun.F hprhis.F hprint.F hprlow.F hprntu.F hprof2.F \ @@\
- hproj1.F hproj2.F hprot.F hprst.F hprsta.F hpsca.F \ @@\
- hpscat.F hpstat.F hpta.F hptab.F hptit.F hrdir.F hread.F \ @@\
- hrebin.F hrename.F hrep1.F hreset.F hrez0.F hrndm.F hrndm1.F \ @@\
- hrndm2.F hrngpf.F hrotat.F hrval.F hscale.F hselbf.F \ @@\
- hseqnr.F hsetbf.F hsetpr.F hsgz.F hsifla.F hsmoof.F \ @@\
- hspace.F hspfun.F hspli1.F hspli2.F hsquez.F hstaf.F \ @@\
- hstar.F hstati.F hstelf.F hsum.F hsupim.F hsupin.F hsupis.F \ @@\
- htable.F htfunc.F htitle.F hunpak.F hunpke.F huoptc.F \ @@\
- hupkrd.F hwork.F hwritf.F hx.F hxe.F hxi.F hxnorm.F hxy.F \ @@\
- hxye.F hxyij.F hinq.F
-
-#if defined(CERNLIB_VAXVMS)
-IMAKE_INCLUDES=-i$(TOP)$(PACKAGETOP).hbook]
-#else
-IMAKE_INCLUDES=-I$(TOP)$(PACKAGETOP)/hbook -I$(PROJECTROOT)$(LOCALTOP)$(PACKAGETOP)/hbook
-#endif
-#include "pilot.h"
-
-#ifdef CERNLIB_MACMPW
-SRCS_F += h0mpw.F
-#endif
-
-#if defined(CERNLIB_CZ)
-SRCS_F := $(SRCS_F) hlogpf.F hinpf.F houtpf.F hoptpf.F
-#endif
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/hbook/code/h0mpw.F b/src/packlib/hbook/code/h0mpw.F
deleted file mode 100644
index c25ec10..0000000
--- a/src/packlib/hbook/code/h0mpw.F
+++ /dev/null
@@ -1,15 +0,0 @@
-*
-* $Id: h0mpw.F,v 1.1.1.1 1996/01/16 17:07:31 mclareni Exp $
-*
-* $Log: h0mpw.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:31 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-#if defined(CERNLIB_MACMPW)
-*CMZ : 4.10/05 11/04/90 14.19.00 by Rene Brun
-*-- Author : Rene Brun 11/04/90
-!!S SEG_HBSEG
-
-#endif
diff --git a/src/packlib/hbook/code/h1evli.F b/src/packlib/hbook/code/h1evli.F
deleted file mode 100644
index 4fc75ef..0000000
--- a/src/packlib/hbook/code/h1evli.F
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: h1evli.F,v 1.1.1.1 1996/01/16 17:07:31 mclareni Exp $
-*
-* $Log: h1evli.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:31 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.10/05 11/04/90 14.19.18 by Rene Brun
-*-- Author :
- SUBROUTINE H1EVLI(ID1)
-*.==========>
-*. AT EDITING 1 LINE WILL CORRESPOND AT MINIMUM
-*. TO 1 ENTRY.
-*..=========> ( R.Brun )
-*.___________________________________________
- CALL HIDOPT(ID1,'1EVLI')
- CALL HOBSOL('H1EVLI','1EVL','AEVL')
- END
diff --git a/src/packlib/hbook/code/h2page.F b/src/packlib/hbook/code/h2page.F
deleted file mode 100644
index 170048a..0000000
--- a/src/packlib/hbook/code/h2page.F
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: h2page.F,v 1.1.1.1 1996/01/16 17:07:31 mclareni Exp $
-*
-* $Log: h2page.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:31 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.10/05 21/02/89 16.14.45 by Rene Brun
-*-- Author :
- SUBROUTINE H2PAGE(ID1)
-*.==========>
-*. HIST ID2 WILL BE PRINTED OVER 2 PAGES
-*..=========> ( R.Brun )
-*.___________________________________________
- CALL HIDOPT(ID1,'2PAG')
- CALL HOBSOL('H2PAGE','2PAG','1PAG')
- END
diff --git a/src/packlib/hbook/code/harith.F b/src/packlib/hbook/code/harith.F
deleted file mode 100644
index 788a6b3..0000000
--- a/src/packlib/hbook/code/harith.F
+++ /dev/null
@@ -1,61 +0,0 @@
-*
-* $Id: harith.F,v 1.1.1.1 1996/01/16 17:07:31 mclareni Exp $
-*
-* $Log: harith.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:31 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.10/05 05/03/89 09.22.01 by Rene Brun
-*-- Author :
- SUBROUTINE HARITH (TFUNC,Y,A,DF,PL0,AMX,AMN)
-*.==========>
-*. HARITH sets value of y-fitting function
-*. and calculates df=dy/da-derivatives
-*..=========> ( I.Ivanchenko )
- DIMENSION A(1),DF(1),PL0(1),AMX(1),AMN(1)
-#include "hbook/hcfit2.inc"
- EXTERNAL TFUNC
-*
-* 10.*MAXIMUM RELATIVE PRECISION
- SAVE RP
- DATA RP/1.E-14/
-*.___________________________________________
- IF(IDIMPN.EQ.4)THEN
- XHFIT=XFUMIL(1)
- YHFIT=XFUMIL(2)
- CALL HTFUNC(TFUNC,XHFIT,YHFIT,Y)
- ELSE
- Y=TFUNC(XFUMIL)
- ENDIF
-*
- DO 10 I=1,NA
- DF(I)=0.
- IF (PL0(I).LE.0.)GO TO 10
- AI=A(I)
- HI=0.01*PL0(I)
- PI=RP*ABS(AI)
- IF (HI.LE.PI) HI=PI
- A(I)=AI+HI
- IF (A(I)-AMX(I).GT.0.)THEN
- A(I)=AI-HI
- HI=-HI
- IF (A(I)-AMN(I).LT.0.)THEN
- A(I)=AMX(I)
- HI=AMX(I)-AI
- IF (AMN(I)-AI+HI.LT.0.)THEN
- A(I)=AMN(I)
- HI=AMN(I)-AI
- ENDIF
- ENDIF
- ENDIF
- IF(IDIMPN.EQ.4)THEN
- CALL HTFUNC(TFUNC,XHFIT,YHFIT,Z)
- ELSE
- Z=TFUNC(XFUMIL)
- ENDIF
- DF(I)=(Z-Y)/HI
- A(I)=AI
- 10 CONTINUE
- END
diff --git a/src/packlib/hbook/code/harray.F b/src/packlib/hbook/code/harray.F
deleted file mode 100644
index 0d7639a..0000000
--- a/src/packlib/hbook/code/harray.F
+++ /dev/null
@@ -1,67 +0,0 @@
-*
-* $Id: harray.F,v 1.1.1.1 1996/01/16 17:07:31 mclareni Exp $
-*
-* $Log: harray.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:31 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.20/08 12/09/93 18.54.40 by Rene Brun
-*-- Author :
- SUBROUTINE HARRAY(IDD,N,ILOC)
-*.==========>
-*. reserve n consecutive words in /PAWC/ for user
-*. the 1st free address is ILOC+1
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
-#include "hbook/hcflag.inc"
-*.___________________________________________
-*
-* Check if ID already in the table
-*
- ILOC=0
- NRHIST=IQ(LCDIR+KNRH)
- IDPOS=LOCATI(IQ(LTAB+1),NRHIST,IDD)
- IF(IDPOS.GT.0)THEN
- CALL HBUG('+Already existing array','HARRAY',IDD)
- CALL HDELET(IDD)
- NRHIST=IQ(LCDIR+KNRH)
- IDPOS=-IDPOS+1
- ENDIF
- ID=IDD
-*
- CALL HSPACE(N+1000,'HARRAY',IDD)
- IF(IERR.NE.0)GO TO 99
-*
-* Enter ID in the list of ordered IDs
-*
- IDPOS=-IDPOS+1
- IF(NRHIST.GE.IQ(LTAB-1))THEN
- CALL MZPUSH(IHDIV,LTAB,500,500,' ')
- ENDIF
- DO 10 I=NRHIST,IDPOS,-1
- IQ(LTAB+I+1)=IQ(LTAB+I)
- LQ(LTAB-I-1)=LQ(LTAB-I)
- 10 CONTINUE
-*
-* Build array bank
-*
- IF(LIDS.EQ.0)THEN
- CALL MZBOOK(IHDIV,LIDS,LCDIR,-2,'HIDA',0,0,N,3,0)
- LCID=LIDS
- ELSE
- LLID=LQ(LCDIR-9)
- CALL MZBOOK(IHDIV,LCID,LLID, 0,'HIDA',0,0,N,3,0)
- ENDIF
- LQ(LCDIR-9)=LCID
-*
- IQ(LCID-5)=ID
- IQ(LTAB+IDPOS)=ID
- LQ(LTAB-IDPOS)=LCID
- ILOC=LCID
- NRHIST=NRHIST+1
- IQ(LCDIR+KNRH)=NRHIST
-*
- 99 RETURN
- END
diff --git a/src/packlib/hbook/code/hauto.F b/src/packlib/hbook/code/hauto.F
deleted file mode 100644
index 90f6d2d..0000000
--- a/src/packlib/hbook/code/hauto.F
+++ /dev/null
@@ -1,112 +0,0 @@
-*
-* $Id: hauto.F,v 1.1.1.1 1996/01/16 17:07:31 mclareni Exp $
-*
-* $Log: hauto.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:31 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.19/00 26/04/93 11.03.23 by Rene Brun
-*-- Author :
- SUBROUTINE HAUTO(Y)
-*.==========>
-*. computes automaticaly the bin width during filling
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
-#include "hbook/hcbits.inc"
- COMMON/HCGARB/DB,ICN,ITAMP,J,NOENT,BFW,IDL,IFW,K,M
- + ,NWPROX,X0,X1,XCN,GA(3)
-*.___________________________________________
- ICN=IQ(LPRX)
- XCN=ICN
- NWPROX=ICN+3
- ITAMP=0
- M=1+I9
- X=Y
- LPX=LCONT+KCON1-1
- NOENT=IQ(LCONT+KNOENT)
- IF(NOENT.GE.3)GO TO 50
- IF(NOENT.EQ.2)GO TO 10
- Q(LPRX+1)=X-0.001*ABS(X)
- IF(X.EQ.0.)Q(LPRX+1)=-1.E-20
- Q(LPRX+2)=X+XCN
- GO TO 999
-*
- 10 IDL=0
- IF(X.NE.Q(LPRX+1))GO TO 20
- X=1.001*X
- 20 IF(X.LT.Q(LPRX))GO TO 30
- Q(LPRX+1)=X+0.001*ABS(X)
- IF(X.EQ.0.)Q(LPRX+1)=1.E+20
- GO TO 40
-*
- 30 BFW=Q(LPRX+1)
- IDL=1
- Q(LPRX+1)=X-0.001*ABS(X)
- IF(X.EQ.0.)Q(LPRX+1)=-1.E-20
- Q(LPRX+2)=BFW+0.001*ABS(BFW)
- IF(BFW.EQ.0.)Q(LPRX+2)=1.E+20
- 40 X0=Q(LPRX+1)
- X1=Q(LPRX+2)
- CALL HBIN(X0,X1,IQ(LPRX),Q(LPRX+1),X1,ICN,DB)
- Q(LPRX+2)=Q(LPRX+1)+XCN*DB
- IF(IDL.EQ.0)GO TO 999
- I=(BFW-Q(LPRX+1))/DB + 2.
- Q(LPX+I)=Q(LPX+2)
- Q(LPX+2)=0.
- IF(I9.EQ.0)GO TO 999
- LW=LQ(LCONT)
- Q(LW+I)=Q(LW+2)
- Q(LW+2)=0.
- GO TO 999
-*
- 50 CONTINUE
- 60 X0=Q(LPRX+1)
- X1=Q(LPRX+2)
- IF(X.LT.X0)GO TO 70
- IF(X.GE.X1)GO TO 90
- GO TO 200
-*
- 70 Q(LPRX+1)=2.*X0-X1
- IF(ITAMP.NE.1)THEN
- ITAMP=1
- IQ(LCONT+KNOENT)=IQ(LCONT+KNOENT)+1
- ENDIF
- J=ICN+2
- LW=LQ(LCONT)
- DO 80 I=1,ICN,2
- J=J-1
- K=ICN-I+1
- Q(LPX+J)=Q(LPX+K)+Q(LPX+K+1)
- IF(I9.NE.0)Q(LW+J)=Q(LW+K)+Q(LW+K+1)
- 80 CONTINUE
-*
- CALL VZERO(Q(LPX+2),ICN/2)
- IF(I9.NE.0)CALL VZERO(Q(LW+2),ICN/2)
- GO TO 60
-*
- 90 Q(LPRX+2)=0.5*(X1+X0)
- IF(ITAMP.NE.1)THEN
- ITAMP=1
- IQ(LCONT+KNOENT)=IQ(LCONT+KNOENT)+1
- ENDIF
- J=1
- LW=LQ(LCONT)
- DO 100 I=1,ICN,2
- J=J+1
- K=I+1
- Q(LPX+J)=Q(LPX+K)+Q(LPX+K+1)
- IF(I9.NE.0)Q(LW+J)=Q(LW+K)+Q(LW+K+1)
- 100 CONTINUE
- CALL VZERO(Q(LPX+J+1),ICN/2)
- IF(I9.NE.0)CALL VZERO(Q(LW+J+1),ICN/2)
-*
- GO TO 60
-*
- 200 IF(NOENT/(IQ(LCONT+KNOENT)+1).LT.20)GO TO 999
- IQ(LCONT+KNOENT)=0
- CALL HSIFLA(5,0)
-*
- 999 RETURN
- END
diff --git a/src/packlib/hbook/code/hbandx.F b/src/packlib/hbook/code/hbandx.F
deleted file mode 100644
index ccdcc24..0000000
--- a/src/packlib/hbook/code/hbandx.F
+++ /dev/null
@@ -1,84 +0,0 @@
-*
-* $Id: hbandx.F,v 1.1.1.1 1996/01/16 17:07:31 mclareni Exp $
-*
-* $Log: hbandx.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:31 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.22/11 23/08/94 14.17.45 by Rene Brun
-*-- Author :
- SUBROUTINE HBANDX(ID2,YY0,YY1,VALMAX)
-*.==========>
-*. book a band along axis x for YY0<Y<YY1
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
-#include "hbook/hcflag.inc"
-#include "hbook/hcform.inc"
-#include "hbook/hcbits.inc"
-*.___________________________________________
- NARG = 4
- CALL NOARG (NARG)
- VALMA = 0.
- IF (NARG .EQ. 4) VALMA = FLOARG (VALMAX)
-*
-* COMPUTES NUMBER OF WORDS PER CHANNEL
-* DEPENDING FROM VALUE OF VALMAX
-*
- IF (VALMA .GE. 1.)THEN
- NBPROX = LOG (VALMA)/LOG (2.) +1
- IF(NBPROX.GT.16)NBPROX=32
- ELSE
- NBPROX = 32
- ENDIF
- IF(NBPROX.EQ.32)THEN
- IODES=IOCF1
- ELSE
- IODES=IOCB1
- ENDIF
- IRET= 3
-*
- 20 CALL HLOOP (ID2,'HBANDX',IRET)
- IF (IRET .EQ. 0) GO TO 99
-*
- CALL HDCOFL
- IF (I230 .EQ. 0) GO TO 40
-*
-* Check if enough space
-*
- NC = IQ(LCID+KNCX)
- NB = 32/NBPROX
- NW = (NC+1)/NB+KCON1
- NTOT = NW+I9*(NC+10)+25
- CALL HSPACE(NTOT,'HBANDX',ID2)
- IF(IERR.NE.0)GO TO 40
-*
-* Create data structure BANX
-*
- LR1=LQ(LCID-6)
- IF(LR1.EQ.0)THEN
- LR1=LCID
- JBIAS=-6
- ELSE
- JBIAS=0
- 30 IF(LQ(LR1).NE.0)THEN
- LR1=LQ(LR1)
- GO TO 30
- ENDIF
- ENDIF
- CALL MZBOOK(IHDIV,LBANX,LR1,JBIAS,'BANX',1,1,2,3,0)
- Q(LBANX+1)=FLOARG(YY0)
- Q(LBANX+2)=FLOARG(YY1)
- CALL MZBOOK(IHDIV,LCONT,LBANX,-1,'BANX',2,2,NW,IODES,0)
- IQ(LCONT+KNBIT)=NBPROX
- IF(I9.NE.0)THEN
- CALL MZBOOK(IHDIV,LW,LCONT,0,'BAXE',0,0,NC,3,0)
- ENDIF
- CALL HSIFLA(8,1)
- IQ(LCID+KNTOT)=IQ(LCID+KNTOT)+NTOT
-*
- 40 IRET = 2
- GO TO 20
- 99 RETURN
- END
diff --git a/src/packlib/hbook/code/hbandy.F b/src/packlib/hbook/code/hbandy.F
deleted file mode 100644
index c48f87a..0000000
--- a/src/packlib/hbook/code/hbandy.F
+++ /dev/null
@@ -1,84 +0,0 @@
-*
-* $Id: hbandy.F,v 1.1.1.1 1996/01/16 17:07:31 mclareni Exp $
-*
-* $Log: hbandy.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:31 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.10/05 22/05/89 16.23.18 by Rene Brun
-*-- Author :
- SUBROUTINE HBANDY(ID2,XX0,XX1,VALMAX)
-*.==========>
-*. book a band along axis y for XX0<X<XX1
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
-#include "hbook/hcflag.inc"
-#include "hbook/hcform.inc"
-#include "hbook/hcbits.inc"
-*.___________________________________________
- NARG = 4
- CALL NOARG (NARG)
- VALMA = 0.
- IF (NARG .EQ. 4) VALMA = FLOARG (VALMAX)
-*
-* COMPUTES NUMBER OF WORDS PER CHANNEL
-* DEPENDING FROM VALUE OF VALMAX
-*
- IF (VALMA .GE. 1.)THEN
- NBPROX = LOG (VALMA)/LOG (2.) +1
- IF(NBPROX.GT.16)NBPROX=32
- ELSE
- NBPROX = 32
- ENDIF
- IF(NBPROX.EQ.32)THEN
- IODES=IOCF1
- ELSE
- IODES=IOCB1
- ENDIF
- IRET= 3
-*
- 20 CALL HLOOP (ID2,'HBANDY',IRET)
- IF (IRET .EQ. 0) GO TO 99
-*
- CALL HDCOFL
- IF (I230 .EQ. 0) GO TO 40
-*
-* Check if enough space
-*
- NC = IQ(LCID+KNCY)
- NB = 32/NBPROX
- NW = (NC+1)/NB+KCON1
- NTOT = NW+I10*(NC+10)+25
- CALL HSPACE(NTOT,'HBANDY',ID2)
- IF(IERR.NE.0)GO TO 40
-*
-* Create data structure BANX
-*
- LR1=LQ(LCID-7)
- IF(LR1.EQ.0)THEN
- LR1=LCID
- JBIAS=-7
- ELSE
- JBIAS=0
- 30 IF(LQ(LR1).NE.0)THEN
- LR1=LQ(LR1)
- GO TO 30
- ENDIF
- ENDIF
- CALL MZBOOK(IHDIV,LBANY,LR1,JBIAS,'BANY',1,1,2,3,0)
- Q(LBANY+1)=FLOARG(XX0)
- Q(LBANY+2)=FLOARG(XX1)
- CALL MZBOOK(IHDIV,LCONT,LBANY,-1,'BANY',2,2,NW,IODES,0)
- IQ(LCONT+KNBIT)=NBPROX
- IF(I10.NE.0)THEN
- CALL MZBOOK(IHDIV,LW,LCONT,0,'BAYE',0,0,NC,3,0)
- ENDIF
- CALL HSIFLA(8,1)
- IQ(LCID+KNTOT)=IQ(LCID+KNTOT)+NTOT
-*
- 40 IRET = 2
- GO TO 20
- 99 RETURN
- END
diff --git a/src/packlib/hbook/code/hbar2.F b/src/packlib/hbook/code/hbar2.F
deleted file mode 100644
index b12bfed..0000000
--- a/src/packlib/hbook/code/hbar2.F
+++ /dev/null
@@ -1,56 +0,0 @@
-*
-* $Id: hbar2.F,v 1.1.1.1 1996/01/16 17:07:31 mclareni Exp $
-*
-* $Log: hbar2.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:31 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.23/01 20/02/95 09.39.07 by Julian Bunn
-*-- Author : Rene Brun 20/06/94
- SUBROUTINE HBAR2(IDD)
-*.==========>
-*. create bank to store sum of square of weigths
-*. for 2-D histograms
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
-#include "hbook/hcflag.inc"
-#include "hbook/hcbits.inc"
-#include "hbook/hcprin.inc"
-*.___________________________________________
- IRET = 3
- 10 CALL HLOOP (IDD,'HBAR2 ',IRET)
- IF (IRET .EQ. 0) GO TO 999
- CALL HDCOFL
- IF(I230.EQ.0)GO TO 100
- NCX=IQ(LCID+KNCX)
- NCY=IQ(LCID+KNCY)
-*
-* 2-DIM histogram
-*
- LCONT=LQ(LCID-1)
- LSCAT=LCONT
- LW=LQ(LCONT)
- IF(LW.NE.0)GO TO 100
- NTOT=NCX*NCY+10
- CALL HSPACE(NTOT,'HBAR2 ',IDD)
- IF(IERR.NE.0)GO TO 100
- CALL MZBOOK(IHDIV,LW,LCONT,0,'HI2E',0,0,NCX*NCY,3,0)
- CALL SBIT0(IQ(LCID),5)
- NB=IQ(LCONT+KNBIT)
- K=0
- DO 30 I=1,NCY
- DO 20 J=1,NCX
- K=K+1
- XX=HCXY(J,I,1)
- Q(LW+K)=ABS(XX)
- 20 CONTINUE
- 30 CONTINUE
-*
- 80 IQ(LCID+KNTOT)=IQ(LCID+KNTOT)+NTOT
-*
- 100 IRET = 2
- GO TO 10
- 999 RETURN
- END
diff --git a/src/packlib/hbook/code/hbarx.F b/src/packlib/hbook/code/hbarx.F
deleted file mode 100644
index e176d6e..0000000
--- a/src/packlib/hbook/code/hbarx.F
+++ /dev/null
@@ -1,110 +0,0 @@
-*
-* $Id: hbarx.F,v 1.1.1.1 1996/01/16 17:07:31 mclareni Exp $
-*
-* $Log: hbarx.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:31 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.10/05 30/06/89 10.52.39 by Rene Brun
-*-- Author :
- SUBROUTINE HBARX(IDD)
-*.==========>
-*. create bank to store sum of square of weigths
-*. for projections X
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
-#include "hbook/hcflag.inc"
-#include "hbook/hcbits.inc"
-#include "hbook/hcprin.inc"
-*.___________________________________________
- IRET = 3
- 10 CALL HLOOP (IDD,'HBARX ',IRET)
- IF (IRET .EQ. 0) GO TO 999
- CALL HDCOFL
- IF(I9.NE.0)GO TO 100
- NCX=IQ(LCID+KNCX)
-*
-* 1-DIM histogram
-*
- IF(I1.NE.0)THEN
- LCONT=LQ(LCID-1)
- NTOT=IQ(LCID+KNCX)+10
- CALL HSPACE(NTOT,'HBARX ',IDD)
- IF(IERR.NE.0)GO TO 100
- CALL MZBOOK(IHDIV,LW,LCONT,0,'HI1E',0,0,NCX,3,0)
- NB=IQ(LCONT+KNBIT)
- DO 15 I=1,NCX
- Q(LW+I)=HCX(I,1)
- 15 CONTINUE
- GO TO 80
- ENDIF
-*
-* 2-DIM histogram
-*
- IF(I230.EQ.0)GO TO 100
- NTOT=0
-*
-* PROX
-*
- LPROX=LQ(LCID-2)
- IF(LPROX.NE.0)THEN
- NW=NCX+10
- CALL HSPACE(NW,'HBARX ',IDD)
- IF(IERR.NE.0)GO TO 100
- CALL MZBOOK(IHDIV,LW,LPROX,0,'PRXE',0,0,NCX,3,0)
- NTOT=NTOT+NW
- LKEEP=LCONT
- LCONT=LPROX
- NB=IQ(LCONT+KNBIT)
- DO 16 I=1,NCX
- Q(LW+I)=HCX(I,1)
- 16 CONTINUE
- LCONT=LKEEP
- ENDIF
-*
-* SLIX
-*
- LSLIX=LQ(LCID-4)
- IF(LSLIX.NE.0)THEN
- NW=(NCX+10)*IQ(LSLIX-2)
- CALL HSPACE(NW,'HBARX ',IDD)
- IF(IERR.NE.0)GO TO 100
- DO 20 I=1,IQ(LSLIX-2)
- LCONT=LQ(LSLIX-I)
- CALL MZBOOK(IHDIV,LW,LCONT,0,'SLXE',0,0,NCX,3,0)
- NB=IQ(LCONT+KNBIT)
- DO 17 J=1,NCX
- Q(LW+J)=HCX(J,1)
- 17 CONTINUE
- 20 CONTINUE
- NTOT=NTOT+NW
- ENDIF
-*
-* BANX
-*
- LBANX=LQ(LCID-6)
- 30 IF(LBANX.NE.0)THEN
- NW=NCX+10
- CALL HSPACE(NW,'HBARX ',IDD)
- IF(IERR.NE.0)GO TO 100
- LCONT=LQ(LBANX-1)
- CALL MZBOOK(IHDIV,LW,LCONT,0,'BAXE',0,0,NCX,3,0)
- NB=IQ(LCONT+KNBIT)
- DO 35 I=1,NCX
- Q(LW+I)=HCX(I,1)
- 35 CONTINUE
- NTOT=NTOT+NW
- LBANX=LQ(LBANX)
- GO TO 30
- ENDIF
-*
- 80 CALL HSIFLA (9,1)
- CALL HSIFLA(11,0)
- IQ(LCID+KNTOT)=IQ(LCID+KNTOT)+NTOT
-*
- 100 IRET = 2
- GO TO 10
- 999 RETURN
- END
diff --git a/src/packlib/hbook/code/hbary.F b/src/packlib/hbook/code/hbary.F
deleted file mode 100644
index cb4bf2b..0000000
--- a/src/packlib/hbook/code/hbary.F
+++ /dev/null
@@ -1,92 +0,0 @@
-*
-* $Id: hbary.F,v 1.1.1.1 1996/01/16 17:07:31 mclareni Exp $
-*
-* $Log: hbary.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:31 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.10/05 30/06/89 10.51.36 by Rene Brun
-*-- Author :
- SUBROUTINE HBARY(IDD)
-*.==========>
-*. create bank to store sum of square of weigths
-*. for projections Y
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
-#include "hbook/hcflag.inc"
-#include "hbook/hcbits.inc"
-#include "hbook/hcprin.inc"
-*.___________________________________________
- IRET = 3
- 10 CALL HLOOP (IDD,'HBARY ',IRET)
- IF (IRET .EQ. 0) GO TO 999
- CALL HDCOFL
- IF(I10.NE.0)GO TO 100
- IF(I230.EQ.0)GO TO 100
- NCY=IQ(LCID+KNCY)
- NTOT=0
-*
-* PROY
-*
- LPROY=LQ(LCID-3)
- IF(LPROY.NE.0)THEN
- NW=NCY+10
- CALL HSPACE(NW,'HBARY ',IDD)
- IF(IERR.NE.0)GO TO 100
- CALL MZBOOK(IHDIV,LW,LPROY,0,'PRYE',0,0,NCY,3,0)
- NTOT=NTOT+NW
- LKEEP=LCONT
- LCONT=LPROY
- NB=IQ(LCONT+KNBIT)
- DO 16 I=1,NCY
- Q(LW+I)=HCX(I,1)
- 16 CONTINUE
- LCONT=LKEEP
- ENDIF
-*
-* SLIY
-*
- LSLIY=LQ(LCID-5)
- IF(LSLIY.NE.0)THEN
- NW=(NCY+10)*IQ(LSLIY-2)
- CALL HSPACE(NW,'HBARY ',IDD)
- IF(IERR.NE.0)GO TO 100
- DO 20 I=1,IQ(LSLIY-2)
- LCONT=LQ(LSLIY-I)
- CALL MZBOOK(IHDIV,LW,LCONT,0,'SLYE',0,0,NCY,3,0)
- NB=IQ(LCONT+KNBIT)
- DO 17 J=1,NCY
- Q(LW+J)=HCX(J,1)
- 17 CONTINUE
- 20 CONTINUE
- NTOT=NTOT+NW
- ENDIF
-*
-* BANY
-*
- LBANY=LQ(LCID-7)
- 30 IF(LBANY.NE.0)THEN
- NW=NCY+10
- CALL HSPACE(NW,'HBARY ',IDD)
- IF(IERR.NE.0)GO TO 100
- LCONT=LQ(LBANY-1)
- CALL MZBOOK(IHDIV,LW,LCONT,0,'BAYE',0,0,NCY,3,0)
- NB=IQ(LCONT+KNBIT)
- DO 35 I=1,NCY
- Q(LW+I)=HCX(I,1)
- 35 CONTINUE
- NTOT=NTOT+NW
- LBANY=LQ(LBANY)
- GO TO 30
- ENDIF
-*
- CALL HSIFLA(10,1)
- CALL HSIFLA(11,0)
- IQ(LCID+KNTOT)=IQ(LCID+KNTOT)+NTOT
-*
- 100 IRET = 2
- GO TO 10
- 999 RETURN
- END
diff --git a/src/packlib/hbook/code/hbasft.F b/src/packlib/hbook/code/hbasft.F
deleted file mode 100644
index c7885d9..0000000
--- a/src/packlib/hbook/code/hbasft.F
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: hbasft.F,v 1.1.1.1 1996/01/16 17:07:31 mclareni Exp $
-*
-* $Log: hbasft.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:31 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.10/05 21/02/89 16.14.45 by Rene Brun
-*-- Author :
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION HBASFT (IBF,X)
-#endif
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION FUNCTION HBASFT (IBF,X)
-#endif
-*.==========>
-*. returns basic function (order number ibf)
-*. this is a default function
-*..=========> ( R.Brun )
- DIMENSION X(1)
- HBASFT=0.
- END
diff --git a/src/packlib/hbook/code/hbcd.F b/src/packlib/hbook/code/hbcd.F
deleted file mode 100644
index 593d2c0..0000000
--- a/src/packlib/hbook/code/hbcd.F
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: hbcd.F,v 1.1.1.1 1996/01/16 17:07:31 mclareni Exp $
-*
-* $Log: hbcd.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:31 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.10/05 21/02/89 16.14.45 by Rene Brun
-*-- Author :
- SUBROUTINE HBCD(Y,N,IA)
-*.==========>
-*. converts real Y in a BCD array IA with N characters
-*. in format F8.3.
-*. if Y.ge.10000 it is converted in an integer BCD array
-*..=========> ( R.Brun )
- DIMENSION IA(2)
- IF(Y.LE.10000.)THEN
- CALL HBCDF(Y,N,IA)
- ELSE
- I=Y
- CALL HBCDI(I,9,IA)
- ENDIF
- END
diff --git a/src/packlib/hbook/code/hbcdf.F b/src/packlib/hbook/code/hbcdf.F
deleted file mode 100644
index 49fe83c..0000000
--- a/src/packlib/hbook/code/hbcdf.F
+++ /dev/null
@@ -1,50 +0,0 @@
-*
-* $Id: hbcdf.F,v 1.1.1.1 1996/01/16 17:07:31 mclareni Exp $
-*
-* $Log: hbcdf.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:31 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.10/05 21/02/89 16.14.45 by Rene Brun
-*-- Author :
- SUBROUTINE HBCDF(Y,N,IA)
-*.==========>
-*. this routine converts a floating point number in BCD
-*. number of N characters including signe
-*..=========> ( R.Brun )
- DIMENSION IA(2)
-#include "hbook/hcprin.inc"
-*.___________________________________________
- IA(1)=IDG(41)
- IA(2)=IDG(41)
- IA(N-3)=IDG(41)
- IF(Y.LT.-0.001)IA(1)=IDG(39)
- NN=N-2
- M=1000.*ABS(Y)+0.5
- IPOINT=0
- N1=1
- K1=0
- J=N+1
- DO 60 I=1,NN
- J=J-1
- IF(M.LT.N1.AND.I.GT.3)GO TO 40
- N2=10*N1
- K2=MOD(M,N2)
- K=(K2-K1)/N1
- IF(I-4)10,20,30
- 10 IF(IPOINT.NE.0)GO TO 15
- IF(K.EQ.0)GO TO 40
- IPOINT=1
- 15 IA(J)=IDG(K+1)
- GO TO 50
- 20 J=J-1
- 30 IA(J)=IDG(K+1)
- GO TO 50
- 40 IA(J)=IDG(41)
- 50 K1=K2
- N1=N2
- 60 CONTINUE
- IF(IPOINT.NE.0)IA(N-3)=IDG(38)
- END
diff --git a/src/packlib/hbook/code/hbcdi.F b/src/packlib/hbook/code/hbcdi.F
deleted file mode 100644
index 4cbde9c..0000000
--- a/src/packlib/hbook/code/hbcdi.F
+++ /dev/null
@@ -1,49 +0,0 @@
-*
-* $Id: hbcdi.F,v 1.1.1.1 1996/01/16 17:07:32 mclareni Exp $
-*
-* $Log: hbcdi.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:32 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.10/05 05/03/89 09.18.58 by Rene Brun
-*-- Author :
- SUBROUTINE HBCDI(L,N,IA)
-*.==========>
-*. this routine converts integer in BCD
-*..=========> ( R.Brun )
- DIMENSION IA(1)
-#include "hbook/hcprin.inc"
-*.___________________________________________
- IF(L.EQ.0)THEN
- DO 10 I=1,N
- 10 IA(I)=IDG(41)
- RETURN
- ENDIF
-*
- M=L
- NN=N
- IA(1)=IDG(41)
- IF(L.LT.0)THEN
- M=-L
- IA(1)=IDG(39)
- NN=N-1
- ENDIF
- N1=1
- J=N+1
- K1=0
- DO 40 I=1,NN
- J=J-1
- IF(M.GE.N1)THEN
- N2=10*N1
- K2=MOD(M,N2)
- K=(K2-K1)/N1
- IA(J)=IDG(K+1)
- ELSE
- IA(J)=IDG(41)
- ENDIF
- K1=K2
- N1=N2
- 40 CONTINUE
- END
diff --git a/src/packlib/hbook/code/hbfun1.F b/src/packlib/hbook/code/hbfun1.F
deleted file mode 100644
index e788992..0000000
--- a/src/packlib/hbook/code/hbfun1.F
+++ /dev/null
@@ -1,43 +0,0 @@
-*
-* $Id: hbfun1.F,v 1.1.1.1 1996/01/16 17:07:32 mclareni Exp $
-*
-* $Log: hbfun1.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:32 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.19/00 02/04/93 08.38.48 by Rene Brun
-*-- Author :
- SUBROUTINE HBFUN1(IDD,CHTITL,NCHA,XMIN,XMAX,FUNC)
-*.==========>
-*. creation of a 1-dim id and filling with FUNC
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
-#include "hbook/hcflag.inc"
- CHARACTER*(*) CHTITL
- EXTERNAL FUNC
-*.___________________________________________
- NCH=INTARG(NCHA)
- XMI=FLOARG(XMIN)
- XMA=FLOARG(XMAX)
-*
- CALL HBOOK1(IDD,CHTITL,NCH,XMI,XMA,0.)
-*
- CALL HFIND(IDD,'HBFUN1')
- IF(LCID.EQ.0)GO TO 99
- CALL HIDOPT(ID,'STAR')
-*
- LFUNC=LQ(LCID-1)
- DX=(XMA-XMI)/FLOAT(NCH)
- X=XMI-0.5*DX
-*
- DO 10 I=1,NCH
- X=X+DX
- XX=X
- Q(LFUNC+KCON1+I)=FUNC(XX)
- 10 CONTINUE
- IQ(LFUNC+KNOENT)=NCH
-*
- 99 RETURN
- END
diff --git a/src/packlib/hbook/code/hbfun2.F b/src/packlib/hbook/code/hbfun2.F
deleted file mode 100644
index 53b8c0e..0000000
--- a/src/packlib/hbook/code/hbfun2.F
+++ /dev/null
@@ -1,52 +0,0 @@
-*
-* $Id: hbfun2.F,v 1.1.1.1 1996/01/16 17:07:32 mclareni Exp $
-*
-* $Log: hbfun2.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:32 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.19/02 21/05/93 16.58.46 by Rene Brun
-*-- Author :
- SUBROUTINE HBFUN2(IDD,CHTITL,NCHAX,XMIN,XMAX,NCHAY,YMIN,YMAX,FUNC)
-*.==========>
-*. creation of a 2-Dim-plot and filling with FUNC
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
-#include "hbook/hcflag.inc"
- CHARACTER*(*) CHTITL
- EXTERNAL FUNC
-*.___________________________________________
- NCHX=INTARG(NCHAX)
- NCHY=INTARG(NCHAY)
- XMI=FLOARG(XMIN)
- XMA=FLOARG(XMAX)
- YMI=FLOARG(YMIN)
- YMA=FLOARG(YMAX)
-*
- CALL HBOOK2(IDD,CHTITL,NCHX,XMI,XMA,NCHY,YMI,YMA,0.)
-*
- CALL HFIND(IDD,'HBFUN2')
- IF(LCID.EQ.0)GO TO 99
-*
- LCONT=LQ(LCID-1)
- DX=(XMA-XMI)/FLOAT(NCHX)
- DY=(YMA-YMI)/FLOAT(NCHY)
- X=XMI-0.5*DX
-*
- DO 20 I=1,NCHX
- X=X+DX
- Y=YMI-0.5*DY
- DO 10 J=1,NCHY
- Y=Y+DY
- XX=X
- YY=Y
- W=FUNC(XX,YY)
- CALL HF2(IDD,X,Y,W)
- 10 CONTINUE
- 20 CONTINUE
- IDLAST=0
-*
- 99 RETURN
- END
diff --git a/src/packlib/hbook/code/hbigbi.F b/src/packlib/hbook/code/hbigbi.F
deleted file mode 100644
index 291a257..0000000
--- a/src/packlib/hbook/code/hbigbi.F
+++ /dev/null
@@ -1,39 +0,0 @@
-*
-* $Id: hbigbi.F,v 1.1.1.1 1996/01/16 17:07:32 mclareni Exp $
-*
-* $Log: hbigbi.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:32 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.10/05 21/02/89 16.14.45 by Rene Brun
-*-- Author :
- SUBROUTINE HBIGBI(ID2,NSTEP)
-*.==========>
-*. one channel will be printed over NSTEP columns
-*..=========> ( R.Brun )
-#include "hbook/hcbits.inc"
-#include "hbook/hcbook.inc"
- COMMON/HCGARB/IS,NSTEP0,IRET,NARG,GA(13)
-*.___________________________________________
- NARG=2
- CALL NOARG(NARG)
- NSTEP0=0
- IF(NARG.EQ.2)NSTEP0=INTARG(NSTEP)
- IF(NSTEP0.LT.1)NSTEP0=1
- IRET=3
-*
- 10 CALL HLOOP(ID2,'HBIGBI',IRET)
- IF(IRET.EQ.0)GO TO 99
-*
- CALL HDCOFL
- IF(I123.NE.0)THEN
- CALL HSIFLA(17,1)
- CALL SBYT(NSTEP0,IQ(LCID),1,4)
- ENDIF
- IRET=2
- GO TO 10
-*
- 99 RETURN
- END
diff --git a/src/packlib/hbook/code/hbin.F b/src/packlib/hbook/code/hbin.F
deleted file mode 100644
index 558d29e..0000000
--- a/src/packlib/hbook/code/hbin.F
+++ /dev/null
@@ -1,74 +0,0 @@
-*
-* $Id: hbin.F,v 1.1.1.1 1996/01/16 17:07:32 mclareni Exp $
-*
-* $Log: hbin.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:32 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 30/06/95 09.31.39 by Rene Brun
-*-- Author :
- SUBROUTINE HBIN(A1,A2,NAA,BL,BH,NB,BWID)
-*.==========>
-*. adjust binsiz
-*..=========> ( F.James )
- AL = MIN(A1,A2)
- AH = MAX(A1,A2)
- IF (AL.EQ.AH) then
- if (ah.eq.0)then
- ah=1.
- else
- AH = AL + abs(al)*1.e-6
- endif
- endif
-* IF NAA .EQ. -1 , PROGRAM USES BWID INPUT FROM CALLING ROUTINE
- IF (NAA .EQ. -1) GO TO 150
- 10 NA = NAA - 1
- IF (NA .LT. 1) NA = 1
-* GET NOMINAL BIN WIDTH IN EXPON FORM
- 20 AWID = (AH-AL)/FLOAT(NA)
- JLOG = LOG10(AWID)
- IF (AWID .LE. 1.0) JLOG=JLOG-1
- SIGFIG = AWID * (10.00 **(-JLOG))
-* ROUND MANTISSA UP TO 2, 2.5, 5, OR 10
- IF(SIGFIG .GT. 2.0) GO TO 40
- SIGRND = 2.0
- GO TO 100
- 40 IF (SIGFIG .GT. 2.5) GO TO 45
- SIGRND = 2.5
- GO TO 100
- 45 IF(SIGFIG.GT.4.)GO TO 50
- SIGRND=4.
- GO TO 100
- 50 IF(SIGFIG .GT. 5.0) GO TO 60
- SIGRND =5.0
- GO TO 100
- 60 SIGRND = 1.0
- JLOG = JLOG + 1
- 100 CONTINUE
- BWID = SIGRND*10.0**JLOG
- GO TO 200
-* GET NEW BOUNDS FROM NEW WIDTH BWID
- 150 IF (BWID .LE. 0.) GO TO 10
- 200 CONTINUE
- ALB = AL/BWID
- LWID=ALB
- IF (ALB .LT. 0.0) LWID=LWID-1
- BL=SIGRND*FLOAT(LWID)*10.**JLOG
- ALB = AH/BWID + 1.0
- KWID = ALB
- IF (ALB .LT. 0.0) KWID=KWID-1
- BH=SIGRND*FLOAT(KWID)*10.**JLOG
- NB = KWID-LWID
- IF (NAA .GT. 5) GO TO 240
- IF (NAA .EQ. -1) RETURN
-* REQUEST FOR ONE BIN IS DIFFICULT CASE
- IF (NAA .GT. 1 .OR. NB .EQ. 1) RETURN
- BWID = BWID*2.0
- NB = 1
- RETURN
- 240 IF (2*NB .NE. NAA) RETURN
- NA = NA + 1
- GO TO 20
- END
diff --git a/src/packlib/hbook/code/hbinsz.F b/src/packlib/hbook/code/hbinsz.F
deleted file mode 100644
index be913b5..0000000
--- a/src/packlib/hbook/code/hbinsz.F
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: hbinsz.F,v 1.1.1.1 1996/01/16 17:07:32 mclareni Exp $
-*
-* $Log: hbinsz.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:32 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.17/01 04/12/92 10.29.36 by Rene Brun
-*-- Author :
- SUBROUTINE HBINSZ(KORDRE)
-*.==========>
-*. will provide rounded bin size for all histograms
-*. booked after this call
-*..=========> ( R.Brun )
-#include "hbook/hcprin.inc"
- CHARACTER*(*) KORDRE
-*.___________________________________________
- KBINSZ=0
- CALL UCTOH(KORDRE,KORD,4,4)
- IF(KORD.NE.INO) KBINSZ=1
- END
diff --git a/src/packlib/hbook/code/hblack.F b/src/packlib/hbook/code/hblack.F
deleted file mode 100644
index 3a50c42..0000000
--- a/src/packlib/hbook/code/hblack.F
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: hblack.F,v 1.1.1.1 1996/01/16 17:07:32 mclareni Exp $
-*
-* $Log: hblack.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:32 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.10/05 21/02/89 16.14.46 by Rene Brun
-*-- Author :
- SUBROUTINE HBLACK(ID1)
-*.==========>
-*. option BLAC selected at printing
-*..=========> ( R.Brun )
-*.___________________________________________
- CALL HIDOPT(ID1,'BLAC')
- CALL HOBSOL('HBLACK','BLAC','CONT')
- END
diff --git a/src/packlib/hbook/code/hbook1.F b/src/packlib/hbook/code/hbook1.F
deleted file mode 100644
index fcaf629..0000000
--- a/src/packlib/hbook/code/hbook1.F
+++ /dev/null
@@ -1,174 +0,0 @@
-*
-* $Id: hbook1.F,v 1.1.1.1 1996/01/16 17:07:32 mclareni Exp $
-*
-* $Log: hbook1.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:32 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.21/04 27/11/93 10.56.03 by Rene Brun
-*-- Author :
- SUBROUTINE HBOOK1(IDD,CHTITL,NNNX,XXX0,XXX1,VALMAX)
-*.==========>
-*. booking of a 1-dim histogram
-*.
-*B..HID1 1-D histogram header TITLE at DATA(10:11)
-*B.AU m.g. 05/02/93
-*B.VE 1.00
-*B.ST /PAWC/
-*B.DV QDIV2
-*B.NL 7
-*B.NS 7
-*B.ND 15
-*B.NX HID2
-*B.UP HDIR
-*B.IO 1B 2I 3F 1I 4F -H
-*B.LINK
-*B.REP 7
-*B.1 HCO1
-*B/REP
-*B/LINK
-*B.DATA
-*B.1 KBITS Status word
-*B.2 NW Total number of words in histogram data structure
-*B.3 NCX Number of channels in X
-*B.4 XMIN Lower limit in X
-*B.5 XMAX Upper limit in X
-*B.6 XIBW Inverse of binwidth in X
-*B.7 HMIN Minimum for histogram (HMINIM)
-*B.8 HMAX Maximum for histogram (HMAXIM)
-*B.9 HNOR Normalization factor (HNORMA)
-*B.REP 2
-*B.1 TITL Title of histogram
-*B/REP
-*B/DATA
-*..=========> ( R.Brun )
-#include "hbook/hcflag.inc"
-#include "hbook/hcbook.inc"
-#include "hbook/hcform.inc"
-#include "hbook/hcprin.inc"
-#include "hbook/hcopt.inc"
- CHARACTER*(*) CHTITL
-*.___________________________________________
- IERR=0
- IF(IDD.EQ.0)THEN
- CALL HBUG('ID=0 is an illegal identifier','HBOOK1',IDD)
- RETURN
- ENDIF
-*
- NOENT=0
- NARG=6
- CALL NOARG(NARG)
- XVALMA=0.
- IF(NARG.EQ.6)XVALMA=FLOARG(VALMAX)
- X1=FLOARG(XXX1)
- X0=FLOARG(XXX0)
- NX=INTARG(NNNX)
- IF(NX.EQ.0)NX=100
- IF(X1.LE.X0)NOENT=1
-*
-* Automatic boundaries adjustment
- ID=IDD
- IF(KBINSZ.NE.0)THEN
- CALL HBIN(X0,X1,NX,X0,X1,NXX,BWID)
- X1=X0+BWID*FLOAT(NX)
- ENDIF
-*
-* Check if ID already in the table
-*
- NRHIST=IQ(LCDIR+KNRH)
- IDPOS=LOCATI(IQ(LTAB+1),NRHIST,ID)
- IF(IDPOS.GT.0)THEN
- CALL HBUG('+Already existing histogram replaced','HBOOK1',IDD)
- CALL HDELET(IDD)
- NRHIST=IQ(LCDIR+KNRH)
- IDPOS=-IDPOS+1
- ENDIF
-*
-* Compute packing factor
-*
- NBPROX=32
- IF(NARG.GE.6)THEN
- IF(XVALMA.GE.1.)THEN
- NBPROX=LOG(XVALMA)/LOG(2.)+1.
- IF(NBPROX.GT.16)NBPROX=32
- ENDIF
- ENDIF
- IF(NBPROX.EQ.32)THEN
- IODES=IOCF1
- ELSE
- IODES=IOCB1
- ENDIF
-*
-* Get title length
-*
- CALL HBTIT(CHTITL,NWTITL,NCHT)
- NB=32/NBPROX
- NWH=(NX+1)/NB + KCON1
- NWID=NWTITL+KTIT1-1
- NTOT=NWH+NWID+23
-*
-* Enough space left ?
-*
- CALL HSPACE(NTOT+1000,'HBOOK1',IDD)
- IF(IERR.NE.0) GO TO 99
-*
-* Enter ID in the list of ordered IDs
-*
- IDPOS=-IDPOS+1
- IF(NRHIST.GE.IQ(LTAB-1))THEN
- CALL MZPUSH(IHDIV,LTAB,500,500,' ')
- ENDIF
- DO 10 I=NRHIST,IDPOS,-1
- IQ(LTAB+I+1)=IQ(LTAB+I)
- LQ(LTAB-I-1)=LQ(LTAB-I)
- 10 CONTINUE
-*
-* Build histogram data structure
-*
- IF(LIDS.EQ.0)THEN
- CALL MZBOOK(IHDIV,LIDS,LCDIR,-2,'HID1',1,1,NWID,IOH1,0)
- LCID=LIDS
- ELSE
- LLID=LQ(LCDIR-9)
- CALL MZBOOK(IHDIV,LCID,LLID, 0,'HID1',1,1,NWID,IOH1,0)
- ENDIF
- LQ(LCDIR-9)=LCID
- CALL MZBOOK(IHDIV,LCONT,LCID,-1,'HCO1',2,2,NWH,IODES,0)
-*
- IQ(LCID-5)=ID
- IQ(LTAB+IDPOS)=ID
- LQ(LTAB-IDPOS)=LCID
- CALL SBIT1(IQ(LCID+KBITS),1)
-*
-* Automatic binning
-*
- IF(NOENT.NE.0)THEN
- CALL SBIT1(IQ(LCID+KBITS),5)
- CALL MZBOOK(IHDIV,LAUTO,LCONT,-2,'HAUT',0,0,200,3,0)
- ENDIF
-*
-* Automatic filling of statistics
-*
- IF(ISTAF.NE.0)THEN
- CALL SBIT1(IQ(LCID+KBITS),7)
- ENDIF
-*
- IF(NWTITL.NE.0)THEN
- CALL UCTOH(CHTITL,IQ(LCID+KTIT1),4,NCHT)
- ENDIF
-*
- IQ(LCID+KNTOT)=NTOT
- IQ(LCID+KNCX)=NX
- Q (LCID+KXMIN)=X0
- Q (LCID+KXMAX)=X1
-*-* The following statement should be removed in 1994
- IF(NOENT.NE.1)Q (LCID+KXMAX+1)=FLOAT(NX)/(X1-X0)
- LCONT=LQ(LCID-1)
- IQ(LCONT+KNBIT)=NBPROX
- NRHIST=NRHIST+1
- IQ(LCDIR+KNRH)=NRHIST
-*
- 99 RETURN
- END
diff --git a/src/packlib/hbook/code/hbook2.F b/src/packlib/hbook/code/hbook2.F
deleted file mode 100644
index bfb3e3c..0000000
--- a/src/packlib/hbook/code/hbook2.F
+++ /dev/null
@@ -1,198 +0,0 @@
-*
-* $Id: hbook2.F,v 1.1.1.1 1996/01/16 17:07:32 mclareni Exp $
-*
-* $Log: hbook2.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:32 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.21/04 27/11/93 10.54.09 by Rene Brun
-*-- Author :
- SUBROUTINE HBOOK2(IDD,CHTITL,NNX,XX0,XX1,NNY,YY0,YY1,VALMAX)
-*.==========>
-*. booking of a 2-dim histogram
-*.
-*B..HID2 2-D histogram header TITLE at DATA(12:99)
-*B.AU m.g. 7 feb 1993
-*B.VE 1.00
-*B.ST /PAWC/
-*B.DV QDIV2
-*B.NL 7
-*B.NS 7
-*B.ND variable
-*B.NX HIDT
-*B.UP HDIR -2
-*B.IO 1B 2I 3F 1I 4F -H
-*B.LINK
-*B.1 HCO2
-*B.2 PROX
-*B.3 PROY
-*B.4 SLMX
-*B.5 SLMY
-*B.6 BAMX
-*B.7 BAMY
-*B/LINK
-*B.DATA
-*B.1 KBITS Status word
-*B.2 NW Total number of words in histogram data structure
-*B.3 NCX Number of channels in X
-*B.4 XMIN Lower limit in X
-*B.5 XMAX Upper limit in X
-*B.6 XIBW Inverse of binwidth in X
-*B.7 NCY Number of channels in Y
-*B.8 YMIN Lower limit in Y
-*B.9 YMAX Upper limit in Y
-*B.10 YIBW Inverse of binwidth in Y
-*B.11 SCAL Scale Factor (HSCALE)
-*B.REP NNNN
-*B.12 TITL Title of histogram
-*B/REP
-*B/DATA
-*..=========> ( R.Brun )
-#include "hbook/hcflag.inc"
-#include "hbook/hcbook.inc"
-#include "hbook/hcform.inc"
-#include "hbook/hcprin.inc"
-#include "hbook/hcopt.inc"
- CHARACTER*(*) CHTITL
-*.___________________________________________
- IERR=0
- IF(IDD.EQ.0)THEN
- CALL HBUG('ID=0 is an illegal identifier','HBOOK2',IDD)
- RETURN
- ENDIF
-*
- NX=INTARG(NNX)
- X0=FLOARG(XX0)
- X1=FLOARG(XX1)
- NY=INTARG(NNY)
- Y0=FLOARG(YY0)
- Y1=FLOARG(YY1)
-*
- NARG=9
- CALL NOARG(NARG)
- IF(X0.GE.X1)THEN
- CALL HBUG('XMIN.GE.XMAX','HBOOK2',IDD)
- GO TO 20
- ENDIF
- IF(Y0.GE.Y1)THEN
- CALL HBUG('YMIN.GE.YMAX','HBOOK2',IDD)
- GO TO 20
- ENDIF
- IF(NX.LE.0.OR.NY.LE.0)THEN
- CALL HBUG('NX.LE.0.or.NY.LE.0','HBOOK2',IDD)
- GO TO 20
- ENDIF
-*
-* Automatic boundaries adjustment
- ID=IDD
- IF(KBINSZ.NE.0)THEN
- CALL HBIN(X0,X1,NX,X0,X1,NX,BWIDX)
- CALL HBIN(Y0,Y1,NY,Y0,Y1,NY,BWIDY)
- ENDIF
- NX=INTARG(NNX)
- NY=INTARG(NNY)
-*
-* Check if ID already in the table
-*
- NRHIST=IQ(LCDIR+KNRH)
- IDPOS=LOCATI(IQ(LTAB+1),NRHIST,ID)
- IF(IDPOS.GT.0)THEN
- CALL HBUG('+Already existing histogram replaced','HBOOK2',IDD)
- CALL HDELET(IDD)
- NRHIST=IQ(LCDIR+KNRH)
- IDPOS=-IDPOS+1
- ENDIF
-*
-* Compute packing factor
-*
- NBSCAT=10/NV
- IF(NARG.GE.9)THEN
- XVALMA=FLOARG(VALMAX)
- IF(XVALMA.LT.1.)THEN
- NBSCAT=32
- ELSE
- NBSCAT=LOG(XVALMA)/LOG(2.)+1.
- IF(NBSCAT.GT.16)NBSCAT=32
- ENDIF
- ENDIF
- IF(NBSCAT.EQ.32)THEN
- IODES=IOCF2
- ELSE
- IODES=IOCB2
- ENDIF
-*
-* Title transform from various accepted formats
-*
- CALL HBTIT(CHTITL,NWTITL,NCHT)
- NB=32/NBSCAT
- NWH=((NX+2)*(NY+2)-1)/NB+KCON2
- NWID=NWTITL+KTIT2-1
- NTOT=NWH+NWID+29
-*
-* Enough space left ?
-*
- CALL HSPACE(NTOT+1000,'HBOOK2',IDD)
- IF(IERR.NE.0)GO TO 20
-*
-* Enter ID in the list of ordered IDs
-*
- IDPOS=-IDPOS+1
- IF(NRHIST.GE.IQ(LTAB-1))THEN
- CALL MZPUSH(IHDIV,LTAB,500,500,' ')
- ENDIF
- DO 10 I=NRHIST,IDPOS,-1
- IQ(LTAB+I+1)=IQ(LTAB+I)
- LQ(LTAB-I-1)=LQ(LTAB-I)
- 10 CONTINUE
-*
-* Build histogram data structure
-*
- IF(LIDS.EQ.0)THEN
- CALL MZBOOK(IHDIV,LIDS,LCDIR,-2,'HID2',7,7,NWID,IOH2,0)
- LCID=LIDS
- ELSE
- LLID=LQ(LCDIR-9)
- CALL MZBOOK(IHDIV,LCID,LLID, 0,'HID2',7,7,NWID,IOH2,0)
- ENDIF
- LQ(LCDIR-9)=LCID
- CALL MZBOOK(IHDIV,LCONT,LCID,-1,'HCO2',2,2,NWH,IODES,0)
-*
- IQ(LCID-5)=ID
- IQ(LTAB+IDPOS)=ID
- LQ(LTAB-IDPOS)=LCID
- IF(NV.EQ.2)THEN
- CALL SBIT1(IQ(LCID+KBITS),2)
- ELSE
- CALL SBIT1(IQ(LCID+KBITS),3)
- ENDIF
-*
-* Automatic filling of statistics
-*
- IF(ISTAF.NE.0)THEN
- CALL SBIT1(IQ(LCID+KBITS),7)
- ENDIF
-*
- IF(NWTITL.NE.0)THEN
- CALL UCTOH(CHTITL,IQ(LCID+KTIT2),4,NCHT)
- ENDIF
-*
- IQ(LCID+KNTOT)=NTOT
- IQ(LCID+KNCX)=NX
- Q(LCID+KXMIN)=X0
- Q(LCID+KXMAX)=X1
-*
- IQ(LCID+KNCY)=NY
- Q(LCID+KYMIN)=Y0
- Q(LCID+KYMAX)=Y1
-*-* The following 2 statements should be removed in 1994
- Q (LCID+KXMAX+1)=FLOAT(NX)/(X1-X0)
- Q (LCID+KYMAX+1)=FLOAT(NY)/(Y1-Y0)
-*
- IQ(LCONT+KNBIT)=NBSCAT
- NRHIST=NRHIST+1
- IQ(LCDIR+KNRH)=NRHIST
-*
- 20 RETURN
- END
diff --git a/src/packlib/hbook/code/hbookb.F b/src/packlib/hbook/code/hbookb.F
deleted file mode 100644
index dda47fa..0000000
--- a/src/packlib/hbook/code/hbookb.F
+++ /dev/null
@@ -1,137 +0,0 @@
-*
-* $Id: hbookb.F,v 1.1.1.1 1996/01/16 17:07:32 mclareni Exp $
-*
-* $Log: hbookb.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:32 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.20/08 12/09/93 18.56.12 by Rene Brun
-*-- Author :
- SUBROUTINE HBOOKB(IDD,CHTITL,NX,XBINS,VALMAX)
-*.==========>
-*. booking of a 1-dim histogram
-*. with non-equidistant bins
-*..=========> ( R.Brun )
-#include "hbook/hcflag.inc"
-#include "hbook/hcbook.inc"
-#include "hbook/hcform.inc"
-#include "hbook/hcprin.inc"
- DIMENSION XBINS(2)
- CHARACTER*(*) CHTITL
-*.___________________________________________
- IERR=0
- IF(IDD.EQ.0)THEN
- CALL HBUG('ID=0 is an illegal identifier','HBOOKB',IDD)
- RETURN
- ENDIF
-*
- NARG=5
- CALL NOARG(NARG)
- XVALMA=0.
- IF(NARG.EQ.5)XVALMA=FLOARG(VALMAX)
-*
-* Check consistency of array XBINS
- DO 5 I=2,NX+1
- IF(XBINS(I).LE.XBINS(I-1))THEN
- CALL HBUG('Bins are not in increasing order','HBOOKB',IDD)
- GO TO 99
- ENDIF
- 5 CONTINUE
- X0=XBINS(1)
- X1=XBINS(NX+1)
- ID=IDD
-*
-* Check if ID already in the table
-*
- NRHIST=IQ(LCDIR+KNRH)
- IDPOS=LOCATI(IQ(LTAB+1),NRHIST,ID)
- IF(IDPOS.GT.0)THEN
- CALL HBUG('+Already existing histogram','HBOOKB',IDD)
- CALL HDELET(IDD)
- NRHIST=IQ(LCDIR+KNRH)
- IDPOS=-IDPOS+1
- ENDIF
-*
-* Compute packing factor
-*
- NBPROX=32
- IF(NARG.GE.5)THEN
- IF(XVALMA.GE.1.)THEN
- NBPROX=LOG(XVALMA)/LOG(2.)+1.
- IF(NBPROX.GT.16)NBPROX=32
- ENDIF
- ENDIF
- IF(NBPROX.EQ.32)THEN
- IODES=IOCF1
- ELSE
- IODES=IOCB1
- ENDIF
-*
-* Get title length
-*
- CALL HBTIT(CHTITL,NWTITL,NCHT)
- NB=32/NBPROX
- NWH=(NX+1)/NB + KCON1
- NWID=NWTITL+KTIT1-1
- NTOT=NWH+NWID+35+NX
-*
-* Enough space left ?
-*
- CALL HSPACE(NTOT+1000,'HBOOKB',IDD)
- IF(IERR.NE.0) GO TO 99
-*
-* Enter ID in the list of ordered IDs
-*
- IDPOS=-IDPOS+1
- IF(NRHIST.GE.IQ(LTAB-1))THEN
- CALL MZPUSH(IHDIV,LTAB,500,500,' ')
- ENDIF
- DO 10 I=NRHIST,IDPOS,-1
- IQ(LTAB+I+1)=IQ(LTAB+I)
- LQ(LTAB-I-1)=LQ(LTAB-I)
- 10 CONTINUE
-*
-* Build histogram data structure
-*
- IF(LIDS.EQ.0)THEN
- CALL MZBOOK(IHDIV,LIDS,LCDIR,-2,'HID1',2,2,NWID,IOH1,0)
- LCID=LIDS
- ELSE
- LLID=LQ(LCDIR-9)
- CALL MZBOOK(IHDIV,LCID,LLID, 0,'HID1',2,2,NWID,IOH1,0)
- ENDIF
- LQ(LCDIR-9)=LCID
- CALL MZBOOK(IHDIV,LCONT,LCID,-1,'HCO1',2,2,NWH,IODES,0)
-*
- IQ(LCID-5)=ID
- IQ(LTAB+IDPOS)=ID
- LQ(LTAB-IDPOS)=LCID
- CALL SBIT1(IQ(LCID+KBITS),1)
-*
-* Store bin values
-*
- CALL SBIT1(IQ(LCID+KBITS),6)
- CALL MZBOOK(IHDIV,LBINS,LCID,-2,'HBIN',0,0,NX+1,3,-1)
- DO 30 I=1,NX+1
- Q(LBINS+I)=XBINS(I)
- 30 CONTINUE
-*
- IF(NWTITL.NE.0)THEN
- CALL UCTOH(CHTITL,IQ(LCID+KTIT1),4,NCHT)
- ENDIF
-*
- IQ(LCID+KNTOT)=NTOT
- IQ(LCID+KNCX)=NX
- Q (LCID+KXMIN)=X0
- Q (LCID+KXMAX)=X1
-*-* The following statement should be removed in 1994
- Q (LCID+KXMAX+1)=FLOAT(NX)/(X1-X0)
- LCONT=LQ(LCID-1)
- IQ(LCONT+KNBIT)=NBPROX
- NRHIST=NRHIST+1
- IQ(LCDIR+KNRH)=NRHIST
-*
- 99 RETURN
- END
diff --git a/src/packlib/hbook/code/hbookn.F b/src/packlib/hbook/code/hbookn.F
deleted file mode 100644
index c5d3ae0..0000000
--- a/src/packlib/hbook/code/hbookn.F
+++ /dev/null
@@ -1,201 +0,0 @@
-*
-* $Id: hbookn.F,v 1.1.1.1 1996/01/16 17:07:32 mclareni Exp $
-*
-* $Log: hbookn.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:32 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.22/00 30/03/94 09.33.33 by Rene Brun
-*-- Author :
- SUBROUTINE HBOOKN(IDD,CHTITL,NVAR,CHRZPA,NPRIME,CHTAGS)
-*.==========>
-*. BOOKING OF A N-TUPLE
-*.
-*. ============> N-TUPLE DATA STRUCTURE <============
-*.
-*. I
-*. I
-*. I LCID
-*. -3 -2 -1 V
-*. ************************************************************************
-*. * * * ****** Bits,NDIM,NOENT,etc (See A) *
-*. ************************************************************************
-*. . I I LNLAST pointer to last linear bank
-*. ......I.....I.......................................
-*. I I .
-*. I I LCONT .
-*. I I V
-*. I I **************************** ********************
-*. I I------>* (x1,y1,z1,,),(x2,y2,z2,,)*-->* next if no RZ *
-*. I **************************** ********************
-*. I LLIMS
-*. I
-*. I *****************************************
-*. I------->* xlow,xup,ylow,yup,zlow,zup,etc *
-*. *****************************************
-*.
-*.
-*. **********************************************************************
-*. * word * tag * content *
-*. **********************************************************************
-*. * * * *
-*. * 1 * BITS * status word *
-*. * 2 * NDIM * Number of variables in the N-Tuple *
-*. * 3 * NOENT * Total number of entries *
-*. * 4 * NPRIME * Number of words for primary allocation *
-*. * 5 * NMEM * Number of memory blocks (only 1 with RZ) *
-*. * 6 * NRZB * Number of RZ records (If RZ is used) *
-*. * 7 * IFIRST * pointer to 1st free word in LCONT *
-*. * 8 * NWTITL * Number of words in the title *
-*. (A)* 9 * ITIT1 * Internal pointer to the first word of title *
-*. * 10 * ITAG1 * pointer to the first tag *
-*. * 11 * NCHRZ * Number of characters in RZ dir (may be 0) *
-*. * 12 * CHRZ1 * 1st word of RZ directory *
-*. * 13 * CHRZ2 * 2nd word,etc *
-*. * * ... * *
-*. * ITAG1* TAG1 * 1st tag (8 characters on 2 words) *
-*. * * ... * *
-*. * ITIT1* TITLE1 * 1st word of title *
-*. * * ... * *
-*. **********************************************************************
-*.
-*..=========> ( R.Brun )
-#include "hbook/hcflag.inc"
-#include "hbook/hcbook.inc"
-#include "hbook/hcform.inc"
-#include "hbook/hcprin.inc"
- CHARACTER*(*) CHTAGS(1)
- CHARACTER*(*) CHRZPA,CHTITL
- CHARACTER*80 CHRZ
- CHARACTER*8 CHT1
-*.___________________________________________
- IERR=0
- IF(IDD.LE.0)THEN
- CALL HBUG('ID<1 is an illegal identifier','HBOOKN',IDD)
- RETURN
- ENDIF
- IF(IDD.GE.10000)THEN
- CALL HBUG('ID>9999 is an illegal identifier','HBOOKN',IDD)
- RETURN
- ENDIF
-*
- NOENT=0
-*
-* Check if ID already in the table
-*
- ID=IDD
- NRHIST=IQ(LCDIR+KNRH)
- IDPOS=LOCATI(IQ(LTAB+1),NRHIST,ID)
- IF(IDPOS.GT.0)THEN
- CALL HBUG('+Already existing N-tuple replaced','HBOOKN',IDD)
- CALL HDELET(IDD)
- NRHIST=IQ(LCDIR+KNRH)
- IDPOS=-IDPOS+1
- ENDIF
-*
-* Check NVAR<513
-*
- NDIM=NVAR
- IF(NDIM.LE.0.OR.NDIM.GT.512)THEN
- CALL HBUG('NVAR must be 0<NVAR<513','HBOOKN',IDD)
- IF(NVAR.LE.0)NDIM=1
- IF(NVAR.GT.512)NDIM=512
- ENDIF
-*
-* Title transform from various accepted formats
-*
- CALL HBTIT(CHTITL,NWTITL,NCHT)
-*
- NCHRZ=LENOCC(CHRZPA)
- IF(NCHRZ.GT.78)NCHRZ=78
- IF(NCHRZ.GT.0)THEN
- CHRZ=CHRZPA
- IF(CHRZPA(1:2).NE.'//')THEN
- CHRZ='//'//CHRZPA(1:NCHRZ)
- NCHRZ=NCHRZ+2
- ENDIF
- ENDIF
- NCHR=20
- ITAG1=12+NCHR
- ITIT1=ITAG1+2*NDIM
- IF(NPRIME.GT.10*NDIM)THEN
- NWP=NPRIME
- ELSE
- NWP=10*NDIM
- ENDIF
- NWP=NWP-MOD(NWP,NDIM)
- NWH=NWP
- NWID=NWTITL+ITIT1-1
- NTOT=NWH+NWID+2*NDIM+33
-*
-* Enough space left ?
-*
- CALL HSPACE(NTOT+1000,'HBOOKN',IDD)
- IF(IERR.NE.0) GO TO 99
-*
-* Enter ID in the list of ordered IDs
-*
- IDPOS=-IDPOS+1
- IF(NRHIST.GE.IQ(LTAB-1))THEN
- CALL MZPUSH(IHDIV,LTAB,500,500,' ')
- ENDIF
- DO 10 I=NRHIST,IDPOS,-1
- IQ(LTAB+I+1)=IQ(LTAB+I)
- LQ(LTAB-I-1)=LQ(LTAB-I)
- 10 CONTINUE
-*
-* Build histogram data structure
-*
- IF(LIDS.EQ.0)THEN
- CALL MZBOOK(IHDIV,LIDS,LCDIR,-2,'HIDN',3,2,NWID,IOHN,0)
- LCID=LIDS
- ELSE
- LLID=LQ(LCDIR-9)
- CALL MZBOOK(IHDIV,LCID,LLID, 0,'HIDN',3,2,NWID,IOHN,0)
- ENDIF
- LQ(LCDIR-9)=LCID
- CALL MZBOOK(IHDIV,LCONT,LCID,-1,'HCON',0,0,NWH,3,0)
- CALL MZBOOK(IHDIV,LLIMS,LCID,-2,'HLIM',0,0,2*NDIM,3,0)
- LQ(LCID-3)=LCONT
-*
- IQ(LCID-5)=ID
- IQ(LTAB+IDPOS)=ID
- LQ(LTAB-IDPOS)=LCID
- CALL SBIT1(IQ(LCID+KBITS),4)
-*
- IQ(LCID+2)=NDIM
- IQ(LCID+4)=NWP
- IQ(LCID+5)=1
- IQ(LCID+7)=1
- IQ(LCID+8)=NWTITL
- IQ(LCID+9)=ITIT1
- IQ(LCID+10)=ITAG1
- IQ(LCID+11)=NCHRZ
-*
-* Copy RZ path, TAGS and title
-*
- IF(NCHRZ.NE.0)THEN
- CALL UCTOH(CHRZ,IQ(LCID+12),4,80)
- CALL SBIT1(IQ(LCONT),1)
- IQ(LCID+5)=ID
- ENDIF
- IF(NWTITL.NE.0)THEN
- CALL UCTOH(CHTITL,IQ(LCID+ITIT1),4,NCHT)
- ENDIF
-*
-* Initialize boundaries
-*
- DO 20 I=1,NDIM
- CHT1=CHTAGS(I)
- CALL UCTOH(CHT1,IQ(LCID+ITAG1+2*I-2),4,8)
- Q(LLIMS+2*I-1)=1.E31
- Q(LLIMS+2*I )=-1.E31
- 20 CONTINUE
-*
- NRHIST=NRHIST+1
- IQ(LCDIR+KNRH)=NRHIST
-*
- 99 RETURN
- END
diff --git a/src/packlib/hbook/code/hbooknc.F b/src/packlib/hbook/code/hbooknc.F
deleted file mode 100644
index a658433..0000000
--- a/src/packlib/hbook/code/hbooknc.F
+++ /dev/null
@@ -1,90 +0,0 @@
-*
-* $Id: hbooknc.F,v 1.1.1.1 1996/01/16 17:07:32 mclareni Exp $
-*
-* $Log: hbooknc.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:32 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.22/11 23/08/94 14.17.45 by Rene Brun
-*-- Author : Rene Brun 10/02/94
- Subroutine HBOOKNC(id, chtitl, nvar, block, tuple, tags)
-****************************************************************
-* Action: Book variables to be stored in a CWN described by the
-* old-style mechanism used by RWN's. Book new CWN if neccesary.
-*
-* INPUT:
-* id Id of CWN. If it doesn't already exist, it is created.
-* chtitl Name of ntuple. Not used if it already exists.
-* nvar Number of variables per event. Maximum 200 ???
-* block Name of the block inside CWN. Default 'Block1'.
-* tuple Array of dimension nvar that will contain values at filling time.
-* tags See HBOOKN.
-*
-* Author: Achim Braemer, braemer at doc.physi.uni-heidelberg.de
-* Rewritten by Rene Brun to remove limitations on nvar
-****************************************************************
- implicit none
-
- integer id, nvar, i,nbvmax
- character*(*) chtitl, block
- real tuple(*)
- character*(*) tags(*)
-
- parameter (nbvmax=40)
- integer icold,icnew,nbn,nch,ibl,lenocc
- character*8 tag1,bname
- character*1300 chform
- character*1 type
-
- logical hexist
-****************************************************************
-
-*-* -- create CWN if neccessary
- if (.not. hexist(id)) call hbnt(id, chtitl, ' ')
-*
- chform=' '
- icold=1
- nbn=0
- type='R'
- do 10 i=1,nvar
- tag1=tags(i)
- if(tag1.eq.' ')then
- write(tag1,30000)i
-30000 format('VAR',I3)
- if(tag1(4:4).eq.' ')tag1(4:4)='0'
- if(tag1(5:5).eq.' ')tag1(5:5)='0'
- endif
- nch=lenocc(tag1)
- icnew=icold+nch+2
- chform(icold:icnew)=tag1(1:nch)//':'//type//','
- if(mod(i,nbvmax).eq.0.or.i.eq.nvar)then
- nbn=nbn+1
-*-* Keep user block name for the first block
- if(nbn.eq.1)then
- bname=block
- if(bname.eq.' ')bname='Block1'
-*-* otherwise generate block name automatically
- elseif(nbn.gt.1 .and. nbn.lt.10) then
- write(bname,10000)nbn
-10000 format('Block',i1)
- elseif (nbn.ge. 10 .and. nbn.lt. 100) then
- write(bname,10001)nbn
-10001 format('Block',i2)
- elseif (nbn.ge.100 .and. nbn.lt.1000) then
- write(bname,10002)nbn
-10002 format('Block',i3)
- else
- print *, 'HBOOKNC: In trouble, NBN = ',nbn
- bname = 'BlockXYZ'
- endif
- ibl=(nbn-1)*nbvmax +1
- call hbname(id,bname,tuple(ibl),chform(1:icnew-1))
- icnew=0
- chform=' '
- endif
- icold=icnew+1
- 10 continue
-*
- end
diff --git a/src/packlib/hbook/code/hbpro.F b/src/packlib/hbook/code/hbpro.F
deleted file mode 100644
index dd23a39..0000000
--- a/src/packlib/hbook/code/hbpro.F
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: hbpro.F,v 1.1.1.1 1996/01/16 17:07:32 mclareni Exp $
-*
-* $Log: hbpro.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:32 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.10/05 21/02/89 16.14.46 by Rene Brun
-*-- Author :
- SUBROUTINE HBPRO (ID2,VALMAX)
-*.==========>
-*. BOOKS PROJECTION X AND Y
-*..=========> ( R.Brun )
-*.___________________________________________
- NARG = 2
- CALL NOARG (NARG)
- VALMA = 0.
- IF (NARG .EQ. 2) VALMA = FLOARG (VALMAX)
-*
- CALL HBPROX (ID2,VALMA)
- CALL HBPROY (ID2,VALMA)
- END
diff --git a/src/packlib/hbook/code/hbprof.F b/src/packlib/hbook/code/hbprof.F
deleted file mode 100644
index d832e68..0000000
--- a/src/packlib/hbook/code/hbprof.F
+++ /dev/null
@@ -1,196 +0,0 @@
-*
-* $Id: hbprof.F,v 1.2 1998/10/05 14:38:54 couet Exp $
-*
-* $Log: hbprof.F,v $
-* Revision 1.2 1998/10/05 14:38:54 couet
-* - New option P for profile histograms. Implemented by: Nello Nappi
-* <Nello.Nappi at cern.ch>
-*
-* Revision 1.1.1.1 1996/01/16 17:07:32 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.22/04 02/06/94 14.09.35 by Rene Brun
-*-- Author :
- SUBROUTINE HBPROF(IDD,CHTITL,NX,XX0,XX1,YMIN,YMAX,CHOPT)
-*.==========>
-*. booking of a profile histogram
-*.
-*. NOTE: The computation of the errors is based on a proposal by
-*. Stephane Coutu. below is a copy of the email with the proposal
-*. ONLY options 'S' and 'I' are implemented
-*.
-*. I realized that there is another case where this kind of trouble
-*. occurs: if a bin has N data points all with the same value Y (especially
-*. possible when dealing with integers), the spread in Y for that bin
-*. is zero, and the uncertainty assigned is also zero, and the bin is
-*. ignored in making subsequent fits. If SQRT(Y) was the correct error
-*. in the case above, then SQRT(Y)/SQRT(N) would be the correct error here.
-*. In fact, any bin with non-zero number of entries N but with zero spread
-*. should have an uncertainty SQRT(Y)/SQRT(N).
-*.
-*. Now, is SQRT(Y)/SQRT(N) really the correct uncertainty? I believe
-*. that it is only in the case where the Y variable is some sort
-*. of counting statistics, following a Poisson distribution. This should
-*. probably be set as the default case. However, Y can be any variable
-*. from an original NTUPLE, not necessarily distributed "Poissonly",
-*. and perhaps extra options could be offered with the command:
-*. PROFILE id title ncx xmin xmax ymin ymax [ chopt ]
-*. to allow the user to choose how errors are calculated. We could have,
-*. for example:
-*. CHOPT
-*. ' ' (Default) Errors are Spread/SQRT(N) for Spread.ne.0. ,
-*. " " SQRT(Y)/SQRT(N) for Spread.eq.0,N.gt.0 ,
-*. " " 0. for N.eq.0
-*. 'S' Errors are Spread for Spread.ne.0. ,
-*. " " SQRT(Y) for Spread.eq.0,N.gt.0 ,
-*. " " 0. for N.eq.0
-*. 'I' Errors are Spread/SQRT(N) for Spread.ne.0. ,
-*. " " 1./SQRT(12.*N) for Spread.eq.0,N.gt.0 ,
-*. " " 0. for N.eq.0
-*. 'P' This option allows to overcome the severe precision
-*. problems which occurr in the error calculation when the
-*. standard deviation is much smaller than the mean. In such
-*. a case, the use of the standard formula:
-*.
-*. < ( y - <y> )^2 > = < y^2> - <y>^2
-*.
-*. involves the calculation of a small difference between
-*. two large numbers. The problem is avoided by accumulating
-*. the sum of the squares of the deviations of y with respect
-*. to the mean, instead of the sum of the squares of y. The
-* prior knowledge of the mean is avoided by the use of an
-*. iterative formula making use of the running average.
-*. This option has been implemented by:
-*. Nello Nappi <Nello.Nappi at cern.ch>
-*.
-*. The third case above corresponds to Integer Y values for which the
-*. uncertainty is +-0.5, with the assumption that the probability that Y
-*. takes any value between Y-0.5 and Y+0.5 is uniform (the same argument
-*. goes for Y uniformly distributed between Y and Y+1); this would be
-*. useful if Y is an ADC measurement, for example. Other, fancier options
-*. would be possible, at the cost of adding one more parameter to the PROFILE
-*. command. For example, if all Y variables are distributed according to some
-*. known Gaussian of standard deviation Sigma, then:
-*. 'G' Errors are Spread/SQRT(N) for Spread.ne.0. ,
-*. " " Sigma/SQRT(N) for Spread.eq.0,N.gt.0 ,
-*. " " 0. for N.eq.0
-*. For example, this would be useful when all Y's are experimental quantities
-*. measured with the same instrument with precision Sigma.
-*.
-*. Stephane Coutu
-*. coutu at roo.physics.lsa.umich.edu
-*.
-*..=========> ( R.Brun )
-#include "hbook/hcflag.inc"
-#include "hbook/hcbook.inc"
-#include "hbook/hcform.inc"
-#include "hbook/hcprin.inc"
-#include "hbook/hcopt.inc"
- CHARACTER*(*) CHTITL,CHOPT
- DIMENSION IOPTS(3)
-*.___________________________________________
- IERR=0
- IF(IDD.EQ.0)THEN
- CALL HBUG('ID=0 is an illegal identifier','HBPROF',IDD)
- RETURN
- ENDIF
-*
-*
-* Automatic boundaries adjustment
- ID=IDD
- X0=XX0
- X1=XX1
- IF(KBINSZ.NE.0)THEN
- CALL HBIN(X0,X1,NX,X0,X1,NXX,BWID)
- X1=X0+BWID*FLOAT(NX)
- ENDIF
- IF(X1.LE.X0)THEN
- CALL HBUG('XMIN.GE.XMAX','HBPROF',IDD)
- ENDIF
-*
-* Check if ID already in the table
-*
- NRHIST=IQ(LCDIR+KNRH)
- IDPOS=LOCATI(IQ(LTAB+1),NRHIST,ID)
- IF(IDPOS.GT.0)THEN
- CALL HBUG('+Already existing histogram replaced','HBPROF',IDD)
- CALL HDELET(IDD)
- NRHIST=IQ(LCDIR+KNRH)
- IDPOS=-IDPOS+1
- ENDIF
-*
-* Get title length
-*
- CALL HBTIT(CHTITL,NWTITL,NCHT)
- NWH=NX+1+KCON1
- NWID=NWTITL+KTIT1-1
- NTOT=NWH+NWID+43+2*NX
-*
-* Enough space left ?
-*
- CALL HSPACE(NTOT+1000,'HBPROF',IDD)
- IF(IERR.NE.0) GO TO 99
-*
-* Enter ID in the list of ordered IDs
-*
- IDPOS=-IDPOS+1
- IF(NRHIST.GE.IQ(LTAB-1))THEN
- CALL MZPUSH(IHDIV,LTAB,500,500,' ')
- ENDIF
- DO 10 I=NRHIST,IDPOS,-1
- IQ(LTAB+I+1)=IQ(LTAB+I)
- LQ(LTAB-I-1)=LQ(LTAB-I)
- 10 CONTINUE
-*
-* Build histogram data structure
-*
- IF(LIDS.EQ.0)THEN
- CALL MZBOOK(IHDIV,LIDS,LCDIR,-2,'HIDP',1,1,NWID,IOH1,0)
- LCID=LIDS
- ELSE
- LLID=LQ(LCDIR-9)
- CALL MZBOOK(IHDIV,LCID,LLID, 0,'HIDP',1,1,NWID,IOH1,0)
- ENDIF
- LQ(LCDIR-9)=LCID
- CALL MZBOOK(IHDIV,LCONT,LCID,-1,'HCOP',2,2,NWH,IOCF1,0)
- CALL MZBOOK(IHDIV,LR1,LCONT,0,'HI1E',0,0,NX,3,0)
- CALL MZBOOK(IHDIV,LR2,LR1 ,0,'HI1N',0,0,NX,3,0)
-*
- IQ(LCID-5)=ID
- IQ(LTAB+IDPOS)=ID
- LQ(LTAB-IDPOS)=LCID
- CALL SBIT1(IQ(LCID+KBITS),1)
- CALL SBIT1(IQ(LCID+KBITS),8)
- CALL SBIT1(IQ(LCID+KBITS),9)
- CALL HUOPTC(CHOPT,'SIP',IOPTS)
- IF(IOPTS(1).NE.0)CALL SBYT(1,IQ(LR1),1,2)
- IF(IOPTS(2).NE.0)CALL SBYT(2,IQ(LR1),1,2)
- IF(IOPTS(3).NE.0)CALL SBIT1(IQ(LR1),3)
-*
-* Automatic filling of statistics
-*
- IF(ISTAF.NE.0)THEN
- CALL SBIT1(IQ(LCID+KBITS),7)
- ENDIF
-*
- IF(NWTITL.NE.0)THEN
- CALL UCTOH(CHTITL,IQ(LCID+KTIT1),4,NCHT)
- ENDIF
-*
- IQ(LCID+KNTOT)=NTOT
- IQ(LCID+KNCX)=NX
- Q (LCID+KXMIN)=X0
- Q (LCID+KXMAX)=X1
-*
- Q (LCID+KXMAX+1)=FLOAT(NX)/(X1-X0)
- Q (LCID+KMIN1) =YMIN
- Q (LCID+KMAX1) =YMAX
- LCONT=LQ(LCID-1)
- IQ(LCONT+KNBIT)=32
- NRHIST=NRHIST+1
- IQ(LCDIR+KNRH)=NRHIST
-*
- 99 RETURN
- END
diff --git a/src/packlib/hbook/code/hbprox.F b/src/packlib/hbook/code/hbprox.F
deleted file mode 100644
index 04e9d17..0000000
--- a/src/packlib/hbook/code/hbprox.F
+++ /dev/null
@@ -1,72 +0,0 @@
-*
-* $Id: hbprox.F,v 1.1.1.1 1996/01/16 17:07:32 mclareni Exp $
-*
-* $Log: hbprox.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:32 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.10/05 22/05/89 16.23.19 by Rene Brun
-*-- Author :
- SUBROUTINE HBPROX(ID2,VALMAX)
-*.==========>
-*. BOOK PROJECTION X
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
-#include "hbook/hcflag.inc"
-#include "hbook/hcform.inc"
-#include "hbook/hcbits.inc"
-*.___________________________________________
- NARG = 2
- CALL NOARG (NARG)
- VALMA = 0.
- IF (NARG .EQ. 2) VALMA = FLOARG (VALMAX)
-*
-* computes number of words per channel
-* from VALMAX
-*
- IF (VALMA .GE. 1.)THEN
- NBPROX = LOG (VALMA)/LOG (2.) +1
- IF(NBPROX.GT.16)NBPROX=32
- ELSE
- NBPROX = 32
- ENDIF
- IF(NBPROX.EQ.32)THEN
- IODES=IOCF1
- ELSE
- IODES=IOCB1
- ENDIF
- NB = 32/NBPROX
- IRET= 3
-*
- 20 CALL HLOOP (ID2,'HBPROX',IRET)
- IF (IRET .EQ. 0) GO TO 99
-*
- CALL HDCOFL
- IF (I230 .EQ. 0) GO TO 40
- LPROX=LQ(LCID-2)
- IF(LPROX.NE.0)GO TO 40
-*
-* Check if enough space
-*
- NC = IQ(LCID+KNCX)
- NW = (NC+1)/NB+KCON1
- NTOT = NW+I9*(NC+10)+12
- CALL HSPACE(NTOT,'HBPROX',ID2)
- IF(IERR.NE.0)GO TO 40
-*
-* Create data structure PROX
-*
- CALL MZBOOK(IHDIV,LPROX,LCID,-2,'PROX',2,2,NW,IODES,0)
- IQ(LPROX+KNBIT)=NBPROX
- IF(I9.NE.0)THEN
- CALL MZBOOK(IHDIV,LW,LPROX,0,'PRXE',0,0,NC,3,0)
- ENDIF
- CALL HSIFLA(8,1)
- IQ(LCID+KNTOT)=IQ(LCID+KNTOT)+NTOT
-*
- 40 IRET = 2
- GO TO 20
- 99 RETURN
- END
diff --git a/src/packlib/hbook/code/hbproy.F b/src/packlib/hbook/code/hbproy.F
deleted file mode 100644
index 26574f1..0000000
--- a/src/packlib/hbook/code/hbproy.F
+++ /dev/null
@@ -1,72 +0,0 @@
-*
-* $Id: hbproy.F,v 1.1.1.1 1996/01/16 17:07:32 mclareni Exp $
-*
-* $Log: hbproy.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:32 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.10/05 22/05/89 16.23.19 by Rene Brun
-*-- Author :
- SUBROUTINE HBPROY(ID2,VALMAX)
-*.==========>
-*. BOOK PROJECTION Y
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
-#include "hbook/hcflag.inc"
-#include "hbook/hcform.inc"
-#include "hbook/hcbits.inc"
-*.___________________________________________
- NARG = 2
- CALL NOARG (NARG)
- VALMA = 0.
- IF (NARG .EQ. 2) VALMA = FLOARG (VALMAX)
-*
-* computes number of words per channel
-* from VALMAX
-*
- IF (VALMA .GE. 1.)THEN
- NBPROX = LOG (VALMA)/LOG (2.) +1
- IF(NBPROX.GT.16)NBPROX=32
- ELSE
- NBPROX = 32
- ENDIF
- IF(NBPROX.EQ.32)THEN
- IODES=IOCF1
- ELSE
- IODES=IOCB1
- ENDIF
- NB = 32/NBPROX
- IRET= 3
-*
- 20 CALL HLOOP (ID2,'HBPROY',IRET)
- IF (IRET .EQ. 0) GO TO 99
-*
- CALL HDCOFL
- IF (I230 .EQ. 0) GO TO 40
- LPROY=LQ(LCID-3)
- IF(LPROY.NE.0)GO TO 40
-*
-* Check if enough space
-*
- NC = IQ(LCID+KNCY)
- NW = (NC+1)/NB+KCON1
- NTOT = NW+I10*(NC+10)+12
- CALL HSPACE(NTOT,'HBPROY',ID2)
- IF(IERR.NE.0)GO TO 40
-*
-* Create data structure PROX
-*
- CALL MZBOOK(IHDIV,LPROY,LCID,-3,'PROY',2,2,NW,IODES,0)
- IQ(LPROY+KNBIT)=NBPROX
- IF(I10.NE.0)THEN
- CALL MZBOOK(IHDIV,LW,LPROY,0,'PRYE',0,0,NC,3,0)
- ENDIF
- CALL HSIFLA(8,1)
- IQ(LCID+KNTOT)=IQ(LCID+KNTOT)+NTOT
-*
- 40 IRET = 2
- GO TO 20
- 99 RETURN
- END
diff --git a/src/packlib/hbook/code/hbslix.F b/src/packlib/hbook/code/hbslix.F
deleted file mode 100644
index 515d1f0..0000000
--- a/src/packlib/hbook/code/hbslix.F
+++ /dev/null
@@ -1,75 +0,0 @@
-*
-* $Id: hbslix.F,v 1.1.1.1 1996/01/16 17:07:32 mclareni Exp $
-*
-* $Log: hbslix.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:32 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.10/05 22/05/89 16.23.19 by Rene Brun
-*-- Author :
- SUBROUTINE HBSLIX(ID2,NSL,VALMAX)
-*.==========>
-*. BOOK SLICES ALONG X AXIS
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
-#include "hbook/hcflag.inc"
-#include "hbook/hcform.inc"
-#include "hbook/hcbits.inc"
-*.___________________________________________
- NARG = 3
- CALL NOARG (NARG)
- VALMA = 0.
- IF (NARG .EQ. 3) VALMA = FLOARG (VALMAX)
-*
-* computes number of words per channel
-* from VALMAX
-*
- IF (VALMA .GE. 1.)THEN
- NBPROX = LOG (VALMA)/LOG (2.) +1
- IF(NBPROX.GT.16)NBPROX=32
- ELSE
- NBPROX = 32
- ENDIF
- IF(NBPROX.EQ.32)THEN
- IODES=IOCF1
- ELSE
- IODES=IOCB1
- ENDIF
- IRET= 3
-*
- 20 CALL HLOOP (ID2,'HBSLIX',IRET)
- IF (IRET .EQ. 0) GO TO 99
-*
- CALL HDCOFL
- IF (I230 .EQ. 0) GO TO 40
- LSLIX=LQ(LCID-4)
- IF(LSLIX.NE.0)GO TO 40
-*
-* Check if enough space
-*
- NC = IQ(LCID+KNCX)
- NB = 32/NBPROX
- NW = (NC+1)/NB+KCON1
- NTOT = NSL*(NW+I9*(NC+10)+12)+NSL+10
- CALL HSPACE(NTOT,'HBSLIX',ID2)
- IF(IERR.NE.0)GO TO 40
-*
-* Create data structure PROX
-*
- CALL MZBOOK(IHDIV,LSLIX,LCID,-4,'SLIX',NSL,NSL,0,0,0)
- DO 30 I=1,NSL
- CALL MZBOOK(IHDIV,LCONT,LSLIX,-I,'SLIX',2,2,NW,IODES,0)
- IQ(LCONT+KNBIT)=NBPROX
- IF(I9.NE.0)THEN
- CALL MZBOOK(IHDIV,LW,LCONT,0,'SLXE',0,0,NC,3,0)
- ENDIF
- 30 CONTINUE
- CALL HSIFLA(8,1)
- IQ(LCID+KNTOT)=IQ(LCID+KNTOT)+NTOT
-*
- 40 IRET = 2
- GO TO 20
- 99 RETURN
- END
diff --git a/src/packlib/hbook/code/hbsliy.F b/src/packlib/hbook/code/hbsliy.F
deleted file mode 100644
index a4fb4e9..0000000
--- a/src/packlib/hbook/code/hbsliy.F
+++ /dev/null
@@ -1,75 +0,0 @@
-*
-* $Id: hbsliy.F,v 1.1.1.1 1996/01/16 17:07:32 mclareni Exp $
-*
-* $Log: hbsliy.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:32 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.10/05 22/05/89 16.23.19 by Rene Brun
-*-- Author :
- SUBROUTINE HBSLIY(ID2,NSL,VALMAX)
-*.==========>
-*. BOOK SLICES ALONG Y AXIS
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
-#include "hbook/hcflag.inc"
-#include "hbook/hcform.inc"
-#include "hbook/hcbits.inc"
-*.___________________________________________
- NARG = 3
- CALL NOARG (NARG)
- VALMA = 0.
- IF (NARG .EQ. 3) VALMA = FLOARG (VALMAX)
-*
-* computes number of words per channel
-* from VALMAX
-*
- IF (VALMA .GE. 1.)THEN
- NBPROX = LOG (VALMA)/LOG (2.) +1
- IF(NBPROX.GT.16)NBPROX=32
- ELSE
- NBPROX = 32
- ENDIF
- IF(NBPROX.EQ.32)THEN
- IODES=IOCF1
- ELSE
- IODES=IOCB1
- ENDIF
- IRET= 3
-*
- 20 CALL HLOOP (ID2,'HBSLIY',IRET)
- IF (IRET .EQ. 0) GO TO 99
-*
- CALL HDCOFL
- IF (I230 .EQ. 0) GO TO 40
- LSLIY=LQ(LCID-5)
- IF(LSLIY.NE.0)GO TO 40
-*
-* Check if enough space
-*
- NC = IQ(LCID+KNCY)
- NB = 32/NBPROX
- NW = (NC+1)/NB+KCON1
- NTOT = NSL*(NW+I10*(NC+10)+12)+NSL+10
- CALL HSPACE(NTOT,'HBSLIY',ID2)
- IF(IERR.NE.0)GO TO 40
-*
-* Create data structure PROX
-*
- CALL MZBOOK(IHDIV,LSLIY,LCID,-5,'SLIY',NSL,NSL,0,0,0)
- DO 30 I=1,NSL
- CALL MZBOOK(IHDIV,LCONT,LSLIY,-I,'SLIY',2,2,NW,IODES,0)
- IQ(LCONT+KNBIT)=NBPROX
- IF(I10.NE.0)THEN
- CALL MZBOOK(IHDIV,LW,LCONT,0,'SLYE',0,0,NC,3,0)
- ENDIF
- 30 CONTINUE
- CALL HSIFLA(8,1)
- IQ(LCID+KNTOT)=IQ(LCID+KNTOT)+NTOT
-*
- 40 IRET = 2
- GO TO 20
- 99 RETURN
- END
diff --git a/src/packlib/hbook/code/hbstat.F b/src/packlib/hbook/code/hbstat.F
deleted file mode 100644
index 34805c2..0000000
--- a/src/packlib/hbook/code/hbstat.F
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: hbstat.F,v 1.1.1.1 1996/01/16 17:07:32 mclareni Exp $
-*
-* $Log: hbstat.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:32 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.10/05 21/02/89 16.14.46 by Rene Brun
-*-- Author :
- SUBROUTINE HBSTAT(ID1)
-*.==========>
-*. Select option to fill statistics at filling time
-*..=========> ( R.Brun )
-*.___________________________________________
- CALL HIDOPT(ID1,'STAT')
- CALL HOBSOL('HBSTAT','STAT',' ')
- END
diff --git a/src/packlib/hbook/code/hbtit.F b/src/packlib/hbook/code/hbtit.F
deleted file mode 100644
index 3ad2d6c..0000000
--- a/src/packlib/hbook/code/hbtit.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: hbtit.F,v 1.1.1.1 1996/01/16 17:07:33 mclareni Exp $
-*
-* $Log: hbtit.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:33 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.10/05 21/02/89 16.14.46 by Rene Brun
-*-- Author :
- SUBROUTINE HBTIT(CHTITL,NWTITL,NCHT)
-*.==========>
-*. computes number of words given in STRING CHTITL
-*..=========> ( R.Brun )
- CHARACTER*(*) CHTITL
-*.___________________________________________
- NCHT=LENOCC(CHTITL)
- IF(CHTITL(NCHT:NCHT).EQ.'$')NCHT=NCHT-1
- IF(NCHT.EQ.1)THEN
- IF(CHTITL(1:1).EQ.' ')NCHT=0
- ENDIF
- NWTITL=(NCHT+3)/4
-*
- 99 RETURN
- END
diff --git a/src/packlib/hbook/code/hbuff.F b/src/packlib/hbook/code/hbuff.F
deleted file mode 100644
index 9794e0c..0000000
--- a/src/packlib/hbook/code/hbuff.F
+++ /dev/null
@@ -1,53 +0,0 @@
-*
-* $Id: hbuff.F,v 1.1.1.1 1996/01/16 17:07:33 mclareni Exp $
-*
-* $Log: hbuff.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:33 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.10/05 07/03/89 11.05.36 by Rene Brun
-*-- Author :
- SUBROUTINE HBUFF(IERR,ILABEL,ID)
-*.==========>
-*. This routine prints error messages on file LERR
-*.
-*. 111 histogram not referenced
-*. 212 number of channels in x .gt.nclim
-*. 213 number of channels in y .gt.nclim
-*. 214 abscissa of origin .gt.abscissa of extremity
-*. 323 command already executed
-*. 324 this command must appear before filling
-*. 112 ID is already referenced
-*. 321 command not available for a 1-dim
-*. 322 ........... 2-dim
-*. 811 buffer area too short
-*. 711 operation between hist with different specifica
-*. 541 comparison .........................
-*. 542 normalisation factor=0.
-*. 543 bad scale factor
-*. 721 degree of polynomial .le.0 in hfitpo
-*. 722 number of channels .lt.degree of polynomial
-*. 311 first location of buffer set .le.o by histgo
-*. 211 number of channels in x or y .le.o
-*. 113 ID=0 illegal booking identifier
-*. 215 packing not permitted with automatic binning
-*. 712 operand histograms must resid in memory
-*. 114 illegal parameter
-*. 115 this band or slice number does not exist
-*. 325 option not existing
-*..=========> ( R.Brun )
- COMMON/HFORM/IA(127),IDU
- DIMENSION ILABEL(1)
-*.___________________________________________
- CALL HFORMA(5)
- CALL VBLANK(IA,127)
- CALL UCTOH('****** HBOOK ERROR NO =',IA,1,23)
- CALL HBCDI(IERR,3,IA(24))
- CALL UCTOH(' CALLED FROM ',IA(27),1,15)
- CALL UBLOW(ILABEL,IA(42),6)
- IF(ID.NE.0)CALL UCTOH('ID =',IA(52),1,4)
- CALL HBCDI(ID,8,IA(56))
- CALL HFORMA(4)
- END
diff --git a/src/packlib/hbook/code/hbug.F b/src/packlib/hbook/code/hbug.F
deleted file mode 100644
index 876025f..0000000
--- a/src/packlib/hbook/code/hbug.F
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: hbug.F,v 1.1.1.1 1996/01/16 17:07:33 mclareni Exp $
-*
-* $Log: hbug.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:33 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.22/13 28/09/94 08.38.37 by Rene Brun
-*-- Author :
- SUBROUTINE HBUG(CHMESS,CHROUT,ID)
-*.==========>
-*. To print error message CHMESS called from routine CHROUT
-*.
-*..=========> ( R.Brun )
-#include "hbook/hcunit.inc"
-#include "hbook/hcmail.inc"
- CHARACTER*(*) CHMESS,CHROUT
-*.___________________________________________
- IF(LERR.LE.0)RETURN
- NCMESS=LENOCC(CHMESS)
- NCROUT=LENOCC(CHROUT)
- IF(CHMESS(1:1).EQ.'+')THEN
- CHMAIL=' *** WARNING in '//CHROUT(1:NCROUT)//' : '
- + //CHMESS(2:NCMESS)//' : '
- NCMESS=NCMESS+NCROUT+22
- ELSE
- CHMAIL=' ***** ERROR in '//CHROUT(1:NCROUT)//' : '
- + //CHMESS(1:NCMESS)//' : '
- NCMESS=NCMESS+NCROUT+23
- ENDIF
- IF(ID.NE.0)THEN
- CHMAIL(NCMESS:)='ID='
- NCMESS=NCMESS+3
- WRITE(CHMAIL(NCMESS:),'(I8)')ID
- NCMESS=NCMESS+8
- ENDIF
- WRITE(LERR,1000)CHMAIL(1:NCMESS)
- 1000 FORMAT(A)
- END
diff --git a/src/packlib/hbook/code/hcdir.F b/src/packlib/hbook/code/hcdir.F
deleted file mode 100644
index 47de66f..0000000
--- a/src/packlib/hbook/code/hcdir.F
+++ /dev/null
@@ -1,191 +0,0 @@
-*
-* $Id: hcdir.F,v 1.1.1.1 1996/01/16 17:07:33 mclareni Exp $
-*
-* $Log: hcdir.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:33 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.22/03 19/05/94 14.31.24 by Rene Brun
-*-- Author :
- SUBROUTINE HCDIR(CHPATH,CHOPT)
-*.==========>
-*. To set,read or print the Current Working Directory
-*. Input:
-*. *CHPATH* Character variable specifying the pathname of the CWD
-*. (default option).
-*. The top level directory is //PAWC. When the pathname does
-*. not start with a '/', the pathname is prefixed with the path
-*. of the CWD.
-*. CHOPT Character variable specifying the option
-*. 'R' Read the CWD pathname into CHPATH
-*. 'P' Print the CWD
-*. ' ' Set the CWD
-*. Output:
-*. *CHPATH* Character variable containing the complete pathname of the
-*. current working directory (with 'R' option only).
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
-#include "hbook/hcflag.inc"
-#include "hbook/hcunit.inc"
-#include "hbook/hcdire.inc"
-#include "hbook/hcmail.inc"
-#include "hbook/hcpiaf.inc"
-#include "hbook/czsock.inc"
-*
- COMMON/QUEST/IQUEST(100)
-*
- CHARACTER*2 NODIR
- PARAMETER (NODIR = '@#')
- CHARACTER*128 CHAIN, CACHE
- DIMENSION IOPTV(2),IHDIR(4)
- EQUIVALENCE (IOPTR,IOPTV(1)), (IOPTP,IOPTV(2))
- CHARACTER*(*) CHPATH,CHOPT
-*
- SAVE CACHE
- DATA CACHE /NODIR/
-*.___________________________________________
- IF(LHBOOK.EQ.0)GO TO 99
- CALL HUOPTC (CHOPT,'RP',IOPTV)
-*
-* Read Working directory
-*
- IF(IOPTR.NE.0)THEN
- CALL HPAFF(CHCDIR,NLCDIR,CHPATH)
- GO TO 99
- ENDIF
-*
-* Print Working directory
-*
- IF(IOPTP.NE.0)THEN
- CALL HPAFF(CHCDIR,NLCDIR,CHMAIL)
- WRITE(LOUT,1000)CHMAIL(1:90)
- 1000 FORMAT(' Current Working Directory = ',A)
- GO TO 99
- ENDIF
-*
-* Set Working directory
-*
- IQUEST(1)=0
- IF(CHPATH(1:1).EQ.'.')THEN
- CALL HPATH(' ')
- ELSE
- CALL HPATH(CHPATH)
- ENDIF
-*
- IF(NLPAT.LE.0)GO TO 99
-*
- ICDOLD=ICDIR
- ICDIR=1
- DO 10 I=1,NCHTOP
- IF(CHPAT(1).EQ.CHTOP(I))THEN
- ICDIR=I
- IF(ICHTOP(I).GT.0)THEN
-*
-*-- 200<ICHTOP<300 for a chain referencing an already open unit
-*
- IF (ICHTOP(I).GT.200 .AND. ICHTOP(I).LT.300) THEN
- CALL HPAFF(CHPAT,NLPAT,CHMAIL)
- CALL HCHNAM(CHMAIL, ICHTOP(I), CHAIN)
- CALL HRZCD(CHAIN, CHOPT)
- ELSEIF (ICHTOP(ICDIR).GT.1000 .AND. CONNPF) THEN
-*-- don't allow CD to server connection point when connected to Piaf
- IF (ICHLUN(ICDIR) .EQ. 0) GOTO 10
-#if defined(CERNLIB_CZ)
- IF (CHPATH.EQ.CACHE.AND.INDEX(CHOPT,'R').EQ.0) GOTO 60
- IF (CACHE.NE.NODIR .AND.INDEX(CHOPT,'R').NE.0) THEN
- CHPATH = CACHE
- GOTO 60
- ENDIF
-*
-*--- remote file on Piaf server
-*
- ISKIN =MOD(ICHTOP(ICDIR),10000)
- ISKOUT=ICHTOP(ICDIR)/10000
- CHSMPF='HCDIR:'//CHOPT
- CHSMPF(21:)=CHPATH
- CALL CZPUTA(CHSMPF,IRC)
- IF (IRC .NE. 0) THEN
- CACHE = NODIR
- GOTO 90
- ENDIF
- CALL HLOGPF(' ',IRC)
- IF(IQUEST(1).EQ.0 .AND. INDEX(CHOPT,'R').NE.0) THEN
- CALL CZGETA(CHPATH,IRC)
- ENDIF
- IF (IQUEST(1).EQ.0) THEN
- CACHE = CHPATH
- ELSE
- CACHE = NODIR
- ENDIF
-#endif
-#if !defined(CERNLIB_CZ)
- CALL HBUG('CZ option not active','HCDIR',0)
- IQUEST(1)=1
-#endif
- ELSE
- IF(CHPATH(1:1).EQ.'.')THEN
- CALL HRZCD(' ',CHOPT)
- ELSE
- CALL HRZCD(CHPATH,CHOPT)
- ENDIF
- ENDIF
- IF(IQUEST(1).NE.0)THEN
- ICDIR=ICDOLD
- GO TO 99
- ENDIF
- GO TO 60
- ELSEIF(ICHTOP(I).LT.0)THEN
- GO TO 60
- ENDIF
- GO TO 20
- ENDIF
- 10 CONTINUE
- ICDIR=ICDOLD
- GO TO 90
-*
- 20 LR1 = LHBOOK
-*
-* Search levels down
-*
- IF(NLPAT.GT.1)THEN
- DO 50 IL=2,NLPAT
- CALL UCTOH(CHPAT(IL),IHDIR,4,16)
- LR1=LQ(LR1-1)
- 30 IF(LR1.EQ.0)GO TO 90
- DO 40 I=1,4
- IF(IHDIR(I).NE.IQ(LR1+I))THEN
- LR1=LQ(LR1)
- GO TO 30
- ENDIF
- 40 CONTINUE
- 50 CONTINUE
- ENDIF
-*
- 60 NLCDIR= NLPAT
- DO 70 I=1,NLPAT
- CHCDIR(I)=CHPAT(I)
- 70 CONTINUE
- IF(ICHTOP(ICDIR).EQ.0)THEN
- LCDIR = LR1
- LID = 0
- ENDIF
- IDLAST= 0
- IDHOLD= 0
- LIDS = LQ(LCDIR-2)
- LTAB = LQ(LCDIR-3)
- LBUFM = LQ(LCDIR-4)
- LTMPM = LQ(LCDIR-5)
- IQUEST(1)=0
- GO TO 99
-*
-* Error
-*
- 90 CALL HPAFF(CHPAT,NLPAT,CHMAIL)
- IQUEST(1)=1
- WRITE(LOUT,2000)CHMAIL(1:90)
- 2000 FORMAT(' HCDIR. UNKNOWN DIRECTORY ',A)
-*
- 99 RETURN
- END
diff --git a/src/packlib/hbook/code/hchnam.F b/src/packlib/hbook/code/hchnam.F
deleted file mode 100644
index 7c28327..0000000
--- a/src/packlib/hbook/code/hchnam.F
+++ /dev/null
@@ -1,42 +0,0 @@
-*
-* $Id: hchnam.F,v 1.1.1.1 1996/01/16 17:07:33 mclareni Exp $
-*
-* $Log: hchnam.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:33 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.19/00 07/04/93 12.23.53 by Fons Rademakers
-*-- Author : Fons Rademakers 02/04/93
- SUBROUTINE HCHNAM(CHPATH, IUNIT, PATH)
-*.==========>
-*.
-*. The pathname of a chain referencing an already open unit is
-*. converted to a pathname containing the open unit.
-*. E.g.: //CHAIN/BLABLA becomes //LUN2/BLABLA when IUNIT=202
-*.
-*..=========> ( A.A. Rademakers )
-*
- CHARACTER*(*) CHPATH, PATH
- CHARACTER*2 CLUN
-*
- IF (CHPATH .EQ. ' ') THEN
- PATH = ' '
- RETURN
- ENDIF
-*
- CALL HITOC(IUNIT-200, CLUN, LC, IER)
- PATH = '//LUN'//CLUN
- LP = LENOCC(PATH)
-*
-*-- string must start with //, redundant IF statement
-*
- IF (CHPATH(1:2) .EQ. '//') THEN
- I = INDEX(CHPATH(3:), '/')
- IF (I .NE. 0) THEN
- PATH = PATH(1:LP)//CHPATH(I+2:)
- ENDIF
- ENDIF
-*
- END
diff --git a/src/packlib/hbook/code/hcmom.F b/src/packlib/hbook/code/hcmom.F
deleted file mode 100644
index bb72511..0000000
--- a/src/packlib/hbook/code/hcmom.F
+++ /dev/null
@@ -1,75 +0,0 @@
-*
-* $Id: hcmom.F,v 1.1.1.1 1996/01/16 17:07:33 mclareni Exp $
-*
-* $Log: hcmom.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:33 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.22/11 23/08/94 14.17.45 by Rene Brun
-*-- Author :
- SUBROUTINE HCMOM(IDD,CMOM)
-*.==========>
-*. CALCULATES INITIAL VALUES OF THE CHEBYSHEF COEFFICIENTS
-*. A1,A2,...,AN IN HPOLYN AS THE SUM OF CONTENTS/NCHAN, MEAN, RMS
-*. AND THIRD (UP TO THE 6-TH) CENTRAL MOMENTS OF HISTOGRAM IDD.
-*.
-*. OUTPUT ARGUMENT CMOM = ARRAY OF CMOMENTS
-*..=========> ( E.Lessner )
-#include "hbook/hcfit2.inc"
-#include "hbook/hcfit3.inc"
-#include "hbook/hcbook.inc"
-#include "hbook/hcfitr.inc"
- DIMENSION XVAL(6), CMOM(*)
-*
- DO 10 I=1,7
- CMOM(I)=0.
- 10 CONTINUE
- DO 15 I=1,6
- XVAL(I)=0.
- 15 CONTINUE
-*
- IF (ALLCHA.EQ.0.) GO TO 99
- NCHAN=IQ(LPRX)
- NCHANE=0
- X=XMIN-BINWID*0.5
- DO 30 I=1,NCHAN
- IF(IFTRNG.NE.0)THEN
- IF(I.LT.IFXLOW.OR.I.GT.IFXUP)GO TO 30
- ENDIF
- X=X+BINWID
- NCHANE=NCHANE+1
- W=HCX(I,1)
- W=ABS(W)
- DO 25 J=1,6
- W=W*X
- XVAL(J)=XVAL(J)+W
- 25 CONTINUE
- 30 CONTINUE
-*
- CMOM(1)=ALLCHA/NCHANE
- IF (NPOLYN.EQ.0) GO TO 99
- CMOM(2)=HSTATI(IDD,1,'HIST',1)
- IF (NPOLYN.EQ.1) GO TO 99
- CMOM(3)=HSTATI(IDD,2,'HIST',1)
- IF (NPOLYN.EQ.2) GO TO 99
-*
- CMOM(4)=(XVAL(3) - 3.*CMOM(2)*XVAL(2))/ALLCHA +
- + 2.*CMOM(2)**3
- IF (NPOLYN.EQ.3) GO TO 99
-*
- CMOM(5)=(XVAL(4) - 4.*CMOM(2)*XVAL(3) + 6.*CMOM(2)*CMOM(2)
- + *XVAL(2))/ALLCHA - 3.*CMOM(2)**4
- IF (NPOLYN.EQ.4) GO TO 99
-*
- CMOM(6)=(XVAL(5) - 5.*XVAL(4)*CMOM(2) + 10.*XVAL(3)*
- + CMOM(2)*CMOM(2) - 10.*XVAL(2)*CMOM(2)**3)/ALLCHA +
- + 4.*CMOM(2)**5
- IF (NPOLYN.EQ.5) GO TO 99
-*
- CMOM(7)=( XVAL(6) - 6.*XVAL(5)*CMOM(2) +
- + 15.*XVAL(4)*CMOM(2)*CMOM(2) -
- + 20.*XVAL(3)*CMOM(2)**3 + 15.*XVAL(2)*CMOM(2)**4)/ALLCHA -
- + 5.*CMOM(2)**6
- 99 END
diff --git a/src/packlib/hbook/code/hcompa.F b/src/packlib/hbook/code/hcompa.F
deleted file mode 100644
index baf0cf2..0000000
--- a/src/packlib/hbook/code/hcompa.F
+++ /dev/null
@@ -1,88 +0,0 @@
-*
-* $Id: hcompa.F,v 1.1.1.1 1996/01/16 17:07:33 mclareni Exp $
-*
-* $Log: hcompa.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:33 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.10/05 22/05/89 16.27.21 by Rene Brun
-*-- Author :
- SUBROUTINE HCOMPA(IDVECT,N)
-*.==========>
-*. calculates the maximum and minimum value of all
-*. one-dim histograms referenced in IDVECT.
-*. if N.eq.0 or missing applies to all 1-dim
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
-#include "hbook/hcflag.inc"
-#include "hbook/hcprin.inc"
- DIMENSION IDVECT(1)
-*.___________________________________________
- J=0
- NARG=2
- CALL NOARG(NARG)
- XMIN=BIGP
- XMAX=-XMIN
- IF(NARG.EQ.1)GO TO 30
- IF(N.EQ.0)GO TO 30
-*
-* USER GIVES AN ARRAY OF IDS
-*
- DO 10 I=1,N
- ID=IDVECT(I)
- CALL HFIND(ID,'HCOMPA')
- IF(LCID.EQ.0)GO TO 10
- IF(JBIT(IQ(LCID+KBITS),1).NE.0)THEN
- XMA=HMAX(ID)
- XMI=HMIN(ID)
- XMAX=MAX(XMA,XMAX)
- XMIN=MIN(XMI,XMIN)
- J=1
- ENDIF
- 10 CONTINUE
-*
- IF(J.EQ.0)GO TO 90
- DO 20 I=1,N
- ID=IDVECT(I)
- CALL HFIND(ID,'HCOMPA')
- IF(LCID.EQ.0)GO TO 20
- IF(JBIT(IQ(LCID+KBITS),1).NE.0)THEN
- CALL HMAXIM(ID,XMAX)
- CALL HMINIM(ID,XMIN)
- ENDIF
- 20 CONTINUE
- GO TO 99
-*
-*
-* APPLIES TO ALL 1-DIM HIST
-*
- 30 NRHIST=IQ(LCDIR+KNRH)
- DO 40 I=1,NRHIST
- ID=IQ(LTAB+I)
- LCID=LQ(LTAB-I)
- IF(JBIT(IQ(LCID+KBITS),1).NE.0)THEN
- XMA=HMAX(ID)
- XMI=HMIN(ID)
- XMAX=MAX(XMA,XMAX)
- XMIN=MIN(XMI,XMIN)
- J=1
- ENDIF
- 40 CONTINUE
-*
- IF(J.EQ.0)GO TO 90
- DO 50 I=1,NRHIST
- ID=IQ(LTAB+I)
- LCID=LQ(LTAB-I)
- IF(JBIT(IQ(LCID+KBITS),1).NE.0)THEN
- CALL HMAXIM(ID,XMAX)
- CALL HMINIM(ID,XMIN)
- ENDIF
- 50 CONTINUE
- GO TO 99
-*
- 90 CALL HBUG('Histograms with different specifications','HCOMPA',0)
-*
- 99 RETURN
- END
diff --git a/src/packlib/hbook/code/hconvol.F b/src/packlib/hbook/code/hconvol.F
deleted file mode 100644
index 20d46cf..0000000
--- a/src/packlib/hbook/code/hconvol.F
+++ /dev/null
@@ -1,191 +0,0 @@
-*
-* $Id: hconvol.F,v 1.1.1.1 1996/01/16 17:07:33 mclareni Exp $
-*
-* $Log: hconvol.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:33 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.22/11 23/08/94 14.17.45 by Rene Brun
-*-- Author :
- SUBROUTINE HCONVOL ( ID1, ID2, ID3, IERROR )
-************************************************************************
-* *
-*-- Action: Perform 1D convolution of ID2 with ID1 as kernel *
-*-- Result in ID3. *
-* *
-*-- Setup: All histograms involved must exist before this call. *
-*-- ID2 and ID3 histograms must be 1D. *
-*-- ID1 can be 1-D or 2-D *
-* *
-* Author: Per Steinar Iversen (PerSteinar.Iversen at fi.uib.no) *
-* *
-* NB: This method scales badly for large histograms. The best general *
-* algorithm would be to unpack the histograms, add a suitable number *
-* of zeros, do the two FFTs, multiply the transforms, do yet *
-* another FFT and stuff the resulting histogram back into HBOOK. *
-* However, for small histograms, the naive method is probably faster, *
-* especially if recoded in terms of lower level calls. It will also *
-* work with 1D and 2D kernel-histograms that do not have matched *
-* coordinate systems - the FFT method implies equal binsize in X and Y *
-* for the kernel and the histogram to be folded; This simple method *
-* uses HBOOK to avoid this in one (X) dimension at least, corresponding*
-* to folding in a constant resolution term. *
-* *
-* EXAMPLE of use *
-* ============== *
-* CALL HBOOK1(1,'Kernel 1 - 1D',100,-5.0,5.0,0.0) *
-* CALL HBOOK2(2,'Kernel 2 - 2D',100,-5.0,5.0,100,0.0,100.0,0.0) *
-* CALL HBPRO(2,0.0) *
-* CALL HBOOK2(3,'Kernel 3 - 2D',100,-5.0,5.0,100,0.0,100.0,0.0) *
-* CALL HBPRO(3,0.0) *
-* CALL HBOOK1(4,'Function',100,0.0,100.0,0.0) *
-* CALL HBOOK1(5,'Result 1',100,-10.0,110.0,0.0) *
-* CALL HBOOK1(6,'Result 2',100,-10.0,110.0,0.0) *
-* CALL HBOOK1(7,'Result 3',100,-10.0,110.0,0.0) *
-* *
-* DO 10 I=1,100000 *
-* CALL RANNOR(A,B) *
-* CALL HFILL(1,A,0.0,1.0) *
-* CALL HFILL(1,B,0.0,1.0) *
-* CALL RANNOR(A,B) *
-* CALL HFILL(2,A,100.0*RNDM(I),1.0) *
-* CALL HFILL(2,B,100.0*RNDM(I),1.0) *
-* CALL RANNOR(A,B) *
-* CALL HFILL(3,A,100.0*SQRT(RNDM(I+1)),1.0) *
-* CALL HFILL(3,B,100.0*SQRT(RNDM(I+1)),1.0) *
-* X = 30.0*(RNDM(I)-0.5)+50.0 *
-* CALL HFILL(4,X,0.0,1.0) *
-* 10 CONTINUE *
-* *
-* CALL HCONVOL(1,4,5,IERROR) *
-* CALL HCONVOL(2,4,6,IERROR) *
-* CALL HCONVOL(3,4,7,IERROR) *
-************************************************************************
-*
-*-- Externals
-*
- INTEGER ID1, ID2, ID3, IERROR
-*
-*-- Internals
-*
- LOGICAL HEXIST
-*
- INTEGER NX1, NY1, LOC1
- INTEGER NX2, NY2, LOC2
- INTEGER NX3, NY3, LOC3
- REAL XMI1, YMI1, XMA1, YMA1
- REAL XMI2, YMI2, XMA2, YMA2
- REAL XMI3, YMI3, XMA3, YMA3
- CHARACTER*4 CHTITL
- INTEGER I, J
- REAL X1, X2, X3
- REAL Y1, Y2, Y3
- REAL HI, HIJ
-*
-************************************************************************
-* *
-*-- Test input data before anything else *
-************************************************************************
-*
-*--- Check if the IDs exist
-*
- IERROR = 0
-*
- IF ( .NOT. HEXIST ( ID1 ) ) THEN
- CALL HBUG('Kernel histogram does not exist', 'HCONVOL', ID1)
- IERROR = 1
- ENDIF
-*
- IF ( .NOT. HEXIST ( ID2 ) ) THEN
- CALL HBUG('Input histogram does not exist', 'HCONVOL', ID2 )
- IERROR = 1
- ENDIF
-*
- IF ( .NOT. HEXIST ( ID3 ) ) THEN
- CALL HBUG('Output histogram does not exist', 'HCONVOL', ID3)
- IERROR = 1
- ENDIF
-*
- IF ( IERROR .NE. 0 ) RETURN
-*
-*-- Check if the IDs are 1D (not strictly necessary for ID1)
-*
- NWT = 0
- CALL HGIVE (ID1,CHTITL,NX1,XMI1,XMA1,NY1,YMI1,YMA1,NWT,LOC1)
- BWID1=(XMA1-XMI1)/FLOAT(NX1)
-*
- CALL HGIVE (ID2,CHTITL,NX2,XMI2,XMA2,NY2,YMI2,YMA2,NWT,LOC2)
- BWID2=(XMA2-XMI2)/FLOAT(NX2)
- IF ( NY2 .NE. 0 ) THEN
- CALL HBUG ( 'Input histogram is not 1D', 'HCONVOL', ID2 )
- IERROR = 1
- ENDIF
-*
- CALL HGIVE (ID3,CHTITL,NX3,XMI3,XMA3,NY3,YMI3,YMA3,NWT,LOC3)
- IF ( NY3 .NE. 0 ) THEN
- CALL HBUG ( 'Output histogram is not 1D', 'HCONVOL', ID3 )
- IERROR = 1
- ENDIF
-*
- IF ( IERROR .NE. 0 ) RETURN
-*
-*-- Check if ID1 and ID2 are compatible when kernel is 2D
-*
- IF ( NY1 .NE. 0 ) THEN
-*
- IF ( NY1 .NE. NX1 ) THEN
- CALL HBUG ( 'Number of bins in kernel and input IDs '
- + //'unequal', 'HCONVOL', ID1 )
- IERROR = 1
- ENDIF
-*
- IF ( YMI1 .NE. XMI2 ) THEN
- CALL HBUG ( 'Lower limit of kernel and input IDs unequal',
- + 'HCONVOL', ID1 )
- IERROR = 1
- ENDIF
-*
- IF ( YMA1 .NE. XMA2 ) THEN
- CALL HBUG ( 'Upper limit of kernel and input IDs unequal',
- + 'HCONVOL', ID1 )
- IERROR = 1
- ENDIF
-*
- ENDIF
-*
- IF ( IERROR .NE. 0 ) RETURN
-*
-*-- Clean up any previous results
-*
- CALL HRESET ( ID3, ' ' )
-*
-************************************************************************
-* *
-*-- Do the folding *
-* *
-************************************************************************
-*
-*-- For each bin in ID2
-*
- DO 20 I = 1, NX2
- X2 = XMI2+(FLOAT(I)-0.5)*BWID2
- Y2 = HI ( ID2, I )
-*
-*-- Sum contribution from kernel ID1 into ID3
-*
- DO 10 J = 1, NX1
- IF ( NY1 .EQ. 0 ) THEN
- Y1 = HI ( ID1, J )
- ELSE
- Y1 = HIJ ( ID1, J, I )
- ENDIF
- X1 = XMI1+(FLOAT(J)-0.5)*BWID1
- X3 = X1 + X2
- Y3 = Y1 * Y2
- CALL HFILL ( ID3, X3, 0.0, Y3 )
- 10 CONTINUE
- 20 CONTINUE
-*
- END
diff --git a/src/packlib/hbook/code/hcopy.F b/src/packlib/hbook/code/hcopy.F
deleted file mode 100644
index 18bd61d..0000000
--- a/src/packlib/hbook/code/hcopy.F
+++ /dev/null
@@ -1,107 +0,0 @@
-*
-* $Id: hcopy.F,v 1.1.1.1 1996/01/16 17:07:34 mclareni Exp $
-*
-* $Log: hcopy.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:34 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.20/08 12/09/93 18.56.12 by Rene Brun
-*-- Author :
- SUBROUTINE HCOPY(ID1,ID2,CHTITL)
-*.==========>
-*. COPY ID1 ON ID2
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
-#include "hbook/hcflag.inc"
-#include "hbook/hcbits.inc"
- CHARACTER*(*) CHTITL
-*.___________________________________________
- IF(ID2.EQ.ID1)GO TO 90
- IF(ID2.EQ.0)GO TO 90
- NRHIST=IQ(LCDIR+KNRH)
- CALL HFIND(ID1,'HCOPY ')
- IF(LCID.EQ.0)GO TO 99
- IDPOS=LOCATI(IQ(LTAB+1),NRHIST,ID2)
- IF(IDPOS.GT.0)THEN
- CALL HBUG('+Already existing histogram replaced','HCOPY',ID2)
- CALL HDELET(ID2)
- NRHIST=IQ(LCDIR+KNRH)
- IDPOS=-IDPOS+1
- ENDIF
- CALL HFIND(ID1,'HCOPY ')
-*
- CALL HDCOFL
- ID=ID2
- NARG=3
- CALL NOARG(NARG)
-*
-* Get new title (if any)
-*
- IF(I1.NE.0)THEN
- NWOLD=IQ(LCID-1)-KTIT1+1
- ELSEIF(I230.NE.0)THEN
- NWOLD=IQ(LCID-1)-KTIT2+1
- ELSE
- NWOLD=0
- ENDIF
- NWTITL=NWOLD
- IF(NARG.EQ.3)THEN
- CALL HBTIT(CHTITL,NWTITL,NCHT)
- ENDIF
-*
- NMORE=NWTITL-NWOLD
- IF(NWTITL.EQ.0)NMORE=0
- N2=IQ(LCID+KNTOT)+NMORE
- CALL HSPACE(N2+1000,'HCOPY ',ID1)
- IF(IERR.NE.0)GO TO 99
-*
-* Enter ID in the list of ordered IDs
-*
- IDPOS=-IDPOS+1
- IF(NRHIST.GE.IQ(LTAB-1))THEN
- CALL MZPUSH(IHDIV,LTAB,500,500,' ')
- ENDIF
- DO 10 I=NRHIST,IDPOS,-1
- IQ(LTAB+I+1)=IQ(LTAB+I)
- LQ(LTAB-I-1)=LQ(LTAB-I)
- 10 CONTINUE
-*
-* Copy ID1 data structure
-*
- LLID=LQ(LCDIR-9)
- CALL MZCOPY(IHDIV,LCID,IHDIV,LLID,0,' ')
- LCID=LQ(LLID)
- LLID=LCID
- CALL SBIT0(IQ(LCID),5)
- IQ(LCID+KNTOT)=N2
- LQ(LCDIR-9)=LLID
- IQ(LCID-5)=ID2
- IQ(LTAB+IDPOS)=ID2
- LQ(LTAB-IDPOS)=LCID
- NRHIST=NRHIST+1
- IQ(LCDIR+KNRH)=NRHIST
-*
-* Adjust size of top bank for new title
-*
- IF(NMORE.NE.0)THEN
- CALL MZPUSH(IHDIV,LCID,0,NMORE,' ')
- ENDIF
-*
-* Enter new title
-*
- IF(NWTITL.NE.0)THEN
- IF(I1.NE.0)THEN
- J1=KTIT1
- ELSE
- J1=KTIT2
- ENDIF
- CALL UCTOH(CHTITL,IQ(LCID+J1),4,NCHT)
- ENDIF
- GO TO 99
-*
- 90 CALL HBUG('Wrong parameter','HCOPY ',ID1)
-*
- 99 RETURN
- END
diff --git a/src/packlib/hbook/code/hcopym.F b/src/packlib/hbook/code/hcopym.F
deleted file mode 100644
index 02b38b0..0000000
--- a/src/packlib/hbook/code/hcopym.F
+++ /dev/null
@@ -1,56 +0,0 @@
-*
-* $Id: hcopym.F,v 1.1.1.1 1996/01/16 17:07:34 mclareni Exp $
-*
-* $Log: hcopym.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:34 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.21/00 23/10/93 16.53.51 by Rene Brun
-*-- Author :
- SUBROUTINE HCOPYM(ID,IPAWD,IOFSET)
-*.==========>
-*. To copy histogram ID from IPAWD area to /PAWC/
-*. If ID=0 copy all histograms
-*. The copied histogram is stored as ID+IOFSET
-*..=========> ( R.Brun)
-#include "hbook/hcdire.inc"
- DIMENSION IHDIR(4)
- DIMENSION IPAWD(100)
-*.___________________________________________
- JR1=IPAWD(11)
- KOF=0
-*
-* Search levels down
-*
- IF(NLPAT.GT.1)THEN
- DO 50 IL=2,NLPAT
- CALL UCTOH(CHPAT(IL),IHDIR,4,16)
- JR1=IPAWD(JR1+9)
- 30 IF(JR1.EQ.0)GO TO 99
- DO 40 I=1,4
- IF(IHDIR(I).NE.IPAWD(JR1+I+18))THEN
- JR1=IPAWD(JR1+10)
- GO TO 30
- ENDIF
- 40 CONTINUE
- 50 CONTINUE
- ENDIF
-*
- JCDIR = JR1
- JTAB = IPAWD(JCDIR+7)
-*
- IF(ID.NE.0)THEN
- CALL HCOPYN(IPAWD(19),IPAWD(11),ID,IOFSET,JTAB,KOF)
- ELSE
- NTOT =IPAWD(JTAB+17)
- DO 60 I=1,NTOT
- IF(IPAWD(JTAB-I+10).EQ.0)GO TO 60
- ID1=IPAWD(JTAB+I+18)
- CALL HCOPYN(IPAWD(19),IPAWD(11),ID1,IOFSET,JTAB,KOF)
- 60 CONTINUE
- ENDIF
-*
- 99 RETURN
- END
diff --git a/src/packlib/hbook/code/hcopyn.F b/src/packlib/hbook/code/hcopyn.F
deleted file mode 100644
index ad82266..0000000
--- a/src/packlib/hbook/code/hcopyn.F
+++ /dev/null
@@ -1,244 +0,0 @@
-*
-* $Id: hcopyn.F,v 1.1.1.1 1996/01/16 17:07:34 mclareni Exp $
-*
-* $Log: hcopyn.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:34 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.22/11 23/08/94 14.17.45 by Rene Brun
-*-- Author :
- SUBROUTINE HCOPYN(IB,LB,ID1,IOFSET,JTAB,KOF)
-*.==========>
-*. Auxiliary for HCOPYM
-*. Copy one histogram from mapped /PAWC/ to current /PAWC/
-*..=========> ( R.Brun)
-#include "hbook/hcbook.inc"
-#include "hbook/hcflag.inc"
-#include "hbook/hcform.inc"
-#include "hbook/hcbits.inc"
- CHARACTER*4 BNAME
- DIMENSION IB(1),LB(1)
-*.___________________________________________
- NH=IB(JTAB-1)
- DO 10 I=1,NH
- IF(IB(JTAB+I).EQ.ID1)GO TO 20
- 10 CONTINUE
- GO TO 99
-*
- 20 CONTINUE
- ID=ID1+IOFSET
- JCID=LB(JTAB-I)-KOF
- I4=JBIT(IB(JCID+KBITS),4)
- IF(I4.NE.0)THEN
- CALL HCOPYT(IB,LB,ID1,IOFSET,JCID,KOF)
- GO TO 99
- ENDIF
- I123=JBYT(IB(JCID+KBITS),1,3)
- NTOT=IB(JCID+KNTOT)
- IF(I123.EQ.0)THEN
- CALL HBUG('Object is not an histogram','HCOPYM',ID1)
- GO TO 99
- ENDIF
- JCONT=LB(JCID-1)-KOF
- NWID=IB(JCID-1)
- NBPROX=IB(JCONT+KNBIT)
- I1=JBIT(I123,1)
-*
-* Check if ID already in the table
-*
- NRHIST=IQ(LCDIR+KNRH)
- IDPOS=LOCATI(IQ(LTAB+1),NRHIST,ID)
- IF(IDPOS.GT.0)THEN
- CALL HBUG('+Already existing histogram replaced','HCOPYM',ID)
- CALL HDELET(ID)
- NRHIST=IQ(LCDIR+KNRH)
- IDPOS=-IDPOS+1
- ENDIF
-*
-* Enough space left to copy ID ?
-*
- CALL HSPACE(NTOT+1000,'HCOPYM',ID1)
- IF(IERR.NE.0) GO TO 99
-*
-* Enter ID in the list of ordered IDs
-*
- IDPOS=-IDPOS+1
- IF(NRHIST.GE.IQ(LTAB-1))THEN
- CALL MZPUSH(IHDIV,LTAB,500,500,' ')
- ENDIF
- DO 30 I=NRHIST,IDPOS,-1
- IQ(LTAB+I+1)=IQ(LTAB+I)
- LQ(LTAB-I-1)=LQ(LTAB-I)
- 30 CONTINUE
-*
-* Build top level bank
-*
- IF(I1.NE.0)THEN
- IODES=IOH1
- BNAME='HID1'
- NL=1
- ELSE
- IODES=IOH2
- BNAME='HID2'
- NL=7
- ENDIF
-*
- IF(LIDS.EQ.0)THEN
- CALL MZBOOK(IHDIV,LIDS,LCDIR,-2,BNAME,NL,NL,NWID,IODES,0)
- LCID=LIDS
- ELSE
- LLID=LQ(LCDIR-9)
- CALL MZBOOK(IHDIV,LCID,LLID, 0,BNAME,NL,NL,NWID,IODES,0)
- ENDIF
- CALL UCOPY(IB(JCID+1),IQ(LCID+1),NWID)
- LQ(LCDIR-9)=LCID
- IQ(LCID-5)=ID
- IQ(LTAB+IDPOS)=ID
- LQ(LTAB-IDPOS)=LCID
- NRHIST=NRHIST+1
- IQ(LCDIR+KNRH)=NRHIST
-*
-* 1-DIM case
-*
- IF(I1.NE.0)THEN
- IF(NBPROX.GE.32)THEN
- IODES=IOCF1
- ELSE
- IODES=IOCB1
- ENDIF
- NW=IB(JCONT-1)
- CALL MZBOOK(IHDIV,LCONT,LCID,-1,'HCO1',2,2,NW,IODES,0)
- CALL UCOPY(IB(JCONT+1),IQ(LCONT+1),NW)
- IF(LB(JCONT).NE.0)THEN
- JR1=LB(JCONT)-KOF
- NW=IB(JR1-1)
- CALL MZBOOK(IHDIV,LR1,LCONT,0,'HI1E',0,0,NW,3,0)
- CALL UCOPY(IB(JR1+1),IQ(LR1+1),NW)
- IF(JBIT(IB(JR1),1).NE.0)CALL SBIT1(IQ(LR1),1)
- IF(LB(JR1).NE.0)THEN
- JR2=LB(JR1)-KOF
- NW=IB(JR2-1)
- CALL MZBOOK(IHDIV,LR2,LR1,0,'HI1N',0,0,NW,3,0)
- CALL UCOPY(IB(JR2+1),IQ(LR2+1),NW)
- ENDIF
- ENDIF
- IF(LB(JCONT-1).NE.0)THEN
- JFUNC=LB(JCONT-1) -KOF
- NW=IB(JFUNC-1)
- CALL MZBOOK(IHDIV,LFUNC,LCONT,-1,'HFUN',0,0,NW,IOCF2,0)
- CALL UCOPY(IB(JFUNC+1),IQ(LFUNC+1),NW)
- ENDIF
-*????????????????? Should copy LHFIT structure here.
- GO TO 99
- ENDIF
-*
-* 2-DIM case
-*
- IF(NBPROX.GE.32)THEN
- IODES=IOCF2
- ELSE
- IODES=IOCB2
- ENDIF
- NW=IB(JCONT-1)
- CALL MZBOOK(IHDIV,LCONT,LCID,-1,'HCO2',2,2,NW,IODES,0)
- CALL UCOPY(IB(JCONT+1),IQ(LCONT+1),NW)
-* New (30/07/92) 2-D contents bank has 2 structural links. If old histogram
-* was old style, NTOT should should be increased by 2!
- IF(IB(JCONT-2).EQ.0)IQ(LCID+KNTOT)=IQ(LCID+KNTOT)+2
-*
-*????????????? Should copy LFUNC and LHFIT structures here.
-*
-* PROX
-*
- IF(LB(JCID-2).NE.0)THEN
- JCONT=LB(JCID-2)-KOF
- NBPROX=IB(JCONT+KNBIT)
- IF(NBPROX.GE.32)THEN
- IODES=IOCF1
- ELSE
- IODES=IOCB1
- ENDIF
- NW=IB(JCONT-1)
- CALL MZBOOK(IHDIV,LCONT,LCID,-2,'PROX',2,2,NW,IODES,0)
- CALL UCOPY(IB(JCONT+1),IQ(LCONT+1),NW)
- IF(LB(JCONT).NE.0)THEN
- JW=LB(JCONT)-KOF
- NW=IB(JW-1)
- CALL MZBOOK(IHDIV,LW,LCONT,0,'PRXE',0,0,NW,3,0)
- CALL UCOPY(IB(JW+1),IQ(LW+1),NW)
- ENDIF
- IF(LB(JCONT-1).NE.0)THEN
- JFUNC=LB(JCONT-1)-KOF
- NW=IB(JFUNC-1)
- CALL MZBOOK(IHDIV,LFUNC,LCONT,-1,'HFUN',0,0,NW,IOCF2,0)
- CALL UCOPY(IB(JFUNC+1),IQ(LFUNC+1),NW)
- ENDIF
- ENDIF
-*
-* PROY
-*
- IF(LB(JCID-3).NE.0)THEN
- JCONT=LB(JCID-3)-KOF
- NBPROX=IB(JCONT+KNBIT)
- IF(NBPROX.GE.32)THEN
- IODES=IOCF1
- ELSE
- IODES=IOCB1
- ENDIF
- NW=IB(JCONT-1)
- CALL MZBOOK(IHDIV,LCONT,LCID,-3,'PROY',2,2,NW,IODES,0)
- CALL UCOPY(IB(JCONT+1),IQ(LCONT+1),NW)
- IF(LB(JCONT).NE.0)THEN
- JW=LB(JCONT)-KOF
- NW=IB(JW-1)
- CALL MZBOOK(IHDIV,LW,LCONT,0,'PRYE',0,0,NW,3,0)
- CALL UCOPY(IB(JW+1),IQ(LW+1),NW)
- ENDIF
- IF(LB(JCONT-1).NE.0)THEN
- JFUNC=LB(JCONT-1)-KOF
- NW=IB(JFUNC-1)
- CALL MZBOOK(IHDIV,LFUNC,LCONT,-1,'HFUN',0,0,NW,IOCF2,0)
- CALL UCOPY(IB(JFUNC+1),IQ(LFUNC+1),NW)
- ENDIF
- ENDIF
-*
-* SLIX
-*
- IF(LB(JCID-4).NE.0)THEN
- JSLIX=LB(JCID-4)
- DO 40 I=1,IB(JSLIX-2)
-** CALL HREZ0(LQ(LSLIX-I))
- 40 CONTINUE
- ENDIF
-*
-* SLIY
-*
- IF(LB(JCID-5).NE.0)THEN
- JSLIY=LB(JCID-5)
- DO 50 I=1,IB(JSLIY-2)
-** CALL HREZ0(LQ(LSLIY-I))
- 50 CONTINUE
- ENDIF
-*
-* BANX
-*
- JBANX=LB(JCID-6)
- 60 IF(JBANX.NE.0)THEN
-** CALL HREZ0(LQ(LBANX-1))
- JBANX=LB(JBANX)
- IF(JBANX.NE.0)GO TO 60
- ENDIF
-*
-* BANY
-*
- JBANY=LB(JCID-7)
- 70 IF(JBANY.NE.0)THEN
-** CALL HREZ0(LQ(LBANY-1))
- JBANY=LB(JBANY)
- IF(JBANY.NE.0)GO TO 70
- ENDIF
-
- 99 RETURN
- END
diff --git a/src/packlib/hbook/code/hcopyr.F b/src/packlib/hbook/code/hcopyr.F
deleted file mode 100644
index 67dff61..0000000
--- a/src/packlib/hbook/code/hcopyr.F
+++ /dev/null
@@ -1,126 +0,0 @@
-*
-* $Id: hcopyr.F,v 1.1.1.1 1996/01/16 17:07:34 mclareni Exp $
-*
-* $Log: hcopyr.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:34 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 15/06/95 13.26.31 by Unknown
-*-- Author : J.J.Bunn
- SUBROUTINE HCOPYR(ID1,ID2,CHTITL,IBINX1,IBINX2,IBINY1,IBINY2,
- + CHOPT)
-*.==========>
-*. Copy Histogram ID1 to a new histogram ID2, only
-*. moving the bin contents from bins IBINX1 to IBINX2, IBINY1 to IBINY2
-*. and setting the title to CHTITL.
-*.
-*. ID1 Existing histogram ID to be copied
-*. ID2 New histogram ID to receive copy
-*. CHTITL New histogram title (or ' ' to receive same as ID1)
-*. IBINX1 Low bin for range in X
-*. IBINX2 High bin for range in X
-*. IBINY1 Low bin for range in Y (if 2D histo, ignored otherwise)
-*. IBINY2 High bin for range in Y ( " ditto " )
-*. CHOPT ' ' no errors will be copied,
-*. 'E' bin errors will be copied
-*.
-*..=========> ( J.J.Bunn )
- CHARACTER*(*) CHTITL,CHOPT
- CHARACTER*80 CHID2
- LOGICAL HEXIST,LERRORS
- EXTERNAL HEXIST
-*.___________________________________________
- IF(ID2.EQ.ID1) THEN
- CALL HBUG('Identifiers must be different','HCOPYR',ID1)
- RETURN
- ELSE IF(ID2.EQ.0) THEN
- CALL HBUG('New histogram ID must not be 0','HCOPYR',ID1)
- RETURN
- ELSE IF(.NOT.HEXIST(ID1)) THEN
- CALL HBUG('Source histogram does not exist!','HCOPYR',ID1)
- RETURN
- ELSE IF(HEXIST(ID2)) THEN
- CALL HBUG('+Existing Histogram will be replaced','HCOPYR',ID2)
- CALL HDELET(ID2)
- ENDIF
-C
-C get the booking parameters of the source histogram
-C
- CALL HGIVE(ID1,CHID2,NX,XMI,XMA,NY,YMI,YMA,NWT,LOCH)
-C
-C check that the bin range to be copied is correct
-C
- IF(IBINX1.GT.IBINX2) THEN
- CALL HBUG('Bin range in X is bad','HCOPYR',ID1)
- RETURN
- ELSE IF(NY.GT.0.AND.(IBINY1.GT.IBINY2)) THEN
- CALL HBUG('Bin range in Y is bad','HCOPYR',ID1)
- RETURN
- ENDIF
-C
-C book the new histogram with a new title if necessary
-C
- IF(LENOCC(CHTITL).NE.0) CHID2 = CHTITL
- BINWX = (XMA-XMI)/REAL(NX)
- NBINX = IBINX2-IBINX1+1
- IF(NY.GT.0) THEN
- BINWY = (YMA-YMI)/REAL(NY)
- NBINY = IBINY2-IBINY1+1
- CALL HIJXY(ID1,IBINX1,IBINY1,XMINEW,YMINEW)
- XMANEW = XMINEW + REAL(NBINX)*BINWX
- YMANEW = YMINEW + REAL(NBINY)*BINWY
- CALL HBOOK2(ID2,CHID2,NBINX,XMINEW,XMANEW,
- & NBINY,YMINEW,YMANEW,0.)
- ELSE
- CALL HIX(ID1,IBINX1,XMINEW)
- XMANEW = XMINEW + REAL(NBINX)*BINWX
- CALL HBOOK1(ID2,CHID2,NBINX,XMINEW,XMANEW,0.)
- ENDIF
-C
-C check the booking was successful
-C
- IF(.NOT.HEXIST(ID2)) THEN
- CALL HBUG('Failed to book new histogram','HCOPYR',ID2)
- RETURN
- ENDIF
-C
-C now copy the required range of bins into the new histogram
-C
- LERRORS = INDEX(CHOPT,'E').NE.0 .OR. INDEX(CHOPT,'e').NE.0
- XPOS = XMI - BINWX*0.5
- IXNEW = 0
- DO 10 IX=1,NX
- XPOS = XPOS + BINWX
- IXNEW = IXNEW + 1
-C check for 2D
- IF(NY.GT.0) THEN
- YPOS = YMI - BINWY*0.5
- IYNEW = 0
- DO 20 IY=1,NY
- YPOS = YPOS + BINWY
- IYNEW = IYNEW + 1
-C
-C fill the new histogram with the contents of this cell in the old histogram
-C
- CALL HFILL(ID2,XPOS,YPOS,HIJ(ID1,IX,IY))
-C
-C store the error on this cell, if requested
-C
- IF(LERRORS)
- & CALL HPAKES(ID2,IXNEW,IYNEW,HIJE(ID1,IX,IY))
- 20 CONTINUE
- ELSE
-C
-C fill the new histogram with the contents of this bin in the old histogram
-C
- CALL HFILL(ID2,XPOS,0.,HI(ID1,IX))
-C
-C store the error on this bin, if requested
-C
- IF(LERRORS) CALL HPAKES(ID2,IXNEW,0,HIE(ID1,IX))
- ENDIF
- 10 CONTINUE
-C
- END
diff --git a/src/packlib/hbook/code/hcopyt.F b/src/packlib/hbook/code/hcopyt.F
deleted file mode 100644
index 9f492bc..0000000
--- a/src/packlib/hbook/code/hcopyt.F
+++ /dev/null
@@ -1,93 +0,0 @@
-*
-* $Id: hcopyt.F,v 1.1.1.1 1996/01/16 17:07:34 mclareni Exp $
-*
-* $Log: hcopyt.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:34 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.21/00 23/10/93 16.55.46 by Rene Brun
-*-- Author :
- SUBROUTINE HCOPYT(IB,LB,ID1,IOFSET,JCID,KOF)
-*.==========>
-*. Auxiliary for HCOPYM/HCOPYN
-*. Copy one Ntuple from mapped /PAWC/ to current /PAWC/
-*..=========> ( R.Brun)
-#include "hbook/hcbook.inc"
-#include "hbook/hcflag.inc"
-#include "hbook/hcform.inc"
- DIMENSION IB(1),LB(1)
-*.___________________________________________
- NDIM = IB(JCID+2)
- JCONT = LB(JCID-1)-KOF
- JLIMS = LB(JCID-2)-KOF
- NWID = IB(JCID-1)
- NTOT = NWID+IB(JCONT-1)+IB(JLIMS-1)+100
-*
-* Check if ID already in the table
-*
- ID=ID1+IOFSET
- NRHIST=IQ(LCDIR+KNRH)
- IDPOS=LOCATI(IQ(LTAB+1),NRHIST,ID)
- IF(IDPOS.GT.0)THEN
- CALL HBUG('+Already existing Ntuple replaced','HCOPYM',ID)
- CALL HDELET(ID)
- NRHIST=IQ(LCDIR+KNRH)
- IDPOS=-IDPOS+1
- ENDIF
-*
-* Enough space left to copy ID ?
-*
- CALL HSPACE(NTOT+1000,'HCOPYM',ID1)
- IF(IERR.NE.0) GO TO 99
-*
-* Enter ID in the list of ordered IDs
-*
- IDPOS=-IDPOS+1
- IF(NRHIST.GE.IQ(LTAB-1))THEN
- CALL MZPUSH(IHDIV,LTAB,500,500,' ')
- ENDIF
- DO 30 I=NRHIST,IDPOS,-1
- IQ(LTAB+I+1)=IQ(LTAB+I)
- LQ(LTAB-I-1)=LQ(LTAB-I)
- 30 CONTINUE
-*
-* Build top level bank
-*
- IF(LIDS.EQ.0)THEN
- CALL MZBOOK(IHDIV,LIDS,LCDIR,-2,'HIDN',3,2,NWID,IOHN,0)
- LCID=LIDS
- ELSE
- LLID=LQ(LCDIR-9)
- CALL MZBOOK(IHDIV,LCID,LLID, 0,'HIDN',3,2,NWID,IOHN,0)
- ENDIF
- CALL UCOPY(IB(JCID+1),IQ(LCID+1),NWID)
- LQ(LCDIR-9)=LCID
- IQ(LCID-5)=ID
- IQ(LTAB+IDPOS)=ID
- LQ(LTAB-IDPOS)=LCID
- NRHIST=NRHIST+1
- IQ(LCDIR+KNRH)=NRHIST
-*
- NW=IB(JCONT-1)
- CALL MZBOOK(IHDIV,LCONT,LCID,-1,'HCON',0,0,NW,3,0)
- CALL MZBOOK(IHDIV,LLIMS,LCID,-2,'HLIM',0,0,2*NDIM,3,0)
- CALL UCOPY(IB(JCONT+1),IQ(LCONT+1),NW)
- CALL UCOPY(IB(JLIMS+1),IQ(LLIMS+1),2*NDIM)
- JR1=LB(JCONT)-KOF
- LR1=LCONT
- IF(LB(JCONT).NE.0)THEN
- 40 NW=IB(JR1-1)
- LR2=LR1
- CALL MZBOOK(IHDIV,LR1,LR2,0,'HCON',0,0,NW,3,0)
- CALL UCOPY(IB(JR1+1),IQ(LR1+1),NW)
- IF(LB(JR1).NE.0)THEN
- JR1=LB(JR1)-KOF
- GO TO 40
- ENDIF
- ENDIF
- LQ(LCID-3)=LR1
-*
- 99 RETURN
- END
diff --git a/src/packlib/hbook/code/hcopyu.F b/src/packlib/hbook/code/hcopyu.F
deleted file mode 100644
index 907564b..0000000
--- a/src/packlib/hbook/code/hcopyu.F
+++ /dev/null
@@ -1,59 +0,0 @@
-*
-* $Id: hcopyu.F,v 1.1.1.1 1996/01/16 17:07:34 mclareni Exp $
-*
-* $Log: hcopyu.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:34 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.21/00 23/10/93 16.53.51 by Rene Brun
-*-- Author : Rene Brun 29/03/91
- SUBROUTINE HCOPYU(ID,IPAWD,IOFSET)
-*.==========>
-*. To copy histogram ID from IPAWD area to /PAWC/
-*. If ID=0 copy all histograms
-*. The copied histogram is stored as ID+IOFSET
-*..=========> ( R.Brun)
-#include "hbook/hcdire.inc"
- DIMENSION IHDIR(4)
- DIMENSION IPAWD(100)
-*.___________________________________________
- NW=IPAWD(1)
- KOF=IPAWD(2)
- ILAST=IPAWD(NW)
- JR1=ILAST-KOF
-*
-* Search levels down
-*
- IF(NLPAT.GT.1)THEN
- DO 50 IL=2,NLPAT
- CALL UCTOH(CHPAT(IL),IHDIR,4,16)
- JR1=IPAWD(JR1-1)-KOF
- 30 IF(JR1.EQ.0)GO TO 99
- DO 40 I=1,4
- IF(IHDIR(I).NE.IPAWD(JR1+I+8))THEN
- JR1=IPAWD(JR1)-KOF
- GO TO 30
- ENDIF
- 40 CONTINUE
- 50 CONTINUE
- ENDIF
-*
- JCDIR = JR1
- JTAB = IPAWD(JCDIR-3) -KOF
-*
- IF(ID.NE.0)THEN
- CALL HCOPYN(IPAWD(9),IPAWD(1),ID,IOFSET,JTAB,KOF)
- ELSE
- NTOT =IPAWD(JTAB-1+8)
- DO 60 I=1,NTOT
- IF(IPAWD(JTAB-I).EQ.0)GO TO 60
- ID1=IPAWD(JTAB+I+8)
- CALL HCOPYN(IPAWD(9),IPAWD(1),ID1,IOFSET,JTAB,KOF)
- 60 CONTINUE
- ENDIF
-*
- 99 RETURN
- END
-
diff --git a/src/packlib/hbook/code/hcorrl.F b/src/packlib/hbook/code/hcorrl.F
deleted file mode 100644
index 6c8c381..0000000
--- a/src/packlib/hbook/code/hcorrl.F
+++ /dev/null
@@ -1,65 +0,0 @@
-*
-* $Id: hcorrl.F,v 1.1.1.1 1996/01/16 17:07:34 mclareni Exp $
-*
-* $Log: hcorrl.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:34 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.10/05 31/08/90 18.52.55 by Rene Brun
-*-- Author :
- SUBROUTINE HCORRL (X,Y)
-*.==========>
-*. BUILDS CORRELATION MATRIX OF X WITH Y AND
-*. X WITH X - OUTPUT ON UNIT LOUT
-*..=========> ( D.Lienart )
-#include "hbook/hcpar1.inc"
-#include "hbook/hcunit.inc"
- DIMENSION X(NPMAX,ND),Y(1),C(11,10),XM(10)
-*
-* COMPUTED XM MEAN VALUE OF X FOR EACH DIMENSION
-*
- DO 10 I=1,ND
- XM(I)=0.
- DO 5 K=1,NP
- XM(I)=XM(I)+X(K,I)
- 5 CONTINUE
- XM(I)=XM(I)/NP
- 10 CONTINUE
-*
-* COMPUTE YM MEAN VALUE OF Y
-*
- YM=0.
- DO 15 K=1,NP
- YM=YM+Y(K)
- 15 CONTINUE
- YM=YM/NP
-*
-* COMPUTE CORRELATIONS BETWEEN X AND Y
-*
- DO 20 I=1,ND
- C(1,I)=-NP*XM(I)*YM
- DO 20 K=1,NP
- C(1,I)=C(1,I)+X(K,I)*Y(K)
- 20 CONTINUE
-*
-* COMPUTE AUTOCORRELATIONS OF X
-*
- DO 25 I=1,ND
- DO 25 J=1,I
- C(I+1,J)=-NP*XM(I)*XM(J)
- DO 25 K=1,NP
- C(I+1,J)=C(I+1,J)+X(K,I)*X(K,J)
- 25 CONTINUE
-*
-* PRINT MATRIX C
-*
- WRITE (LOUT,100)
- WRITE (LOUT,200) (C(1,J),J=1,ND)
- DO 30 I=1,ND
- WRITE (LOUT,200) (C(I+1,J),J=1,I)
- 30 CONTINUE
- 100 FORMAT (//' X-Y AND X-X CORRELATIONS'/,1X,24('-'))
- 200 FORMAT (1X,10(G12.5,1X))
- END
diff --git a/src/packlib/hbook/code/hcovw.F b/src/packlib/hbook/code/hcovw.F
deleted file mode 100644
index a912b4a..0000000
--- a/src/packlib/hbook/code/hcovw.F
+++ /dev/null
@@ -1,103 +0,0 @@
-*
-* $Id: hcovw.F,v 1.1.1.1 1996/01/16 17:07:34 mclareni Exp $
-*
-* $Log: hcovw.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:34 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.10/05 31/08/90 18.52.54 by Rene Brun
-*-- Author :
- SUBROUTINE HCOVW (X,EY,W,WT,B,BT,DD,FF,IBASFT,JBF)
-*.==========>
-*. FORM VARIANCE-COVARIANCE MATRIX OF W WITH
-*. ONE ADDITIONAL BASIC FUNCTION IBASFT(*,JBF)
-*..=========> ( D.Lienart )
-#include "hbook/hcpar1.inc"
- DIMENSION X(NPMAX,ND),EY(1),W(NPMAX,NCOMAX),WT(1),
- + B(NCOMAX,NCOMAX),BT(NCOMAX,NCOMAX),DD(1),FF(1),
- + IBASFT(ND,NBFMAX),XV(10)
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION W,WT,WNT,B,BT,DD,FF,E,HSTELF,HELEFT,HBASFT,DP
-#endif
-*
-* DETERMINE IF THE GIVEN BASIC FUNCTION IS THE CONSTANT TERM
-*
- ICONST=1
- DO 5 I=1,ND
- IF (IBASFT(I,JBF).NE.0) ICONST=0
- 5 CONTINUE
- DO 10 K=1,NP
- WT(K)=1.
- 10 CONTINUE
-*
-* COMPUTE THE NP VALUES OF THE BASIC FUNCTION IN VECTOR WT
-*
- IF (ICONST.EQ.0) THEN
- DO 35 I=1,ND
- NUM=IBASFT(I,JBF)/10
- ITYP=IBASFT(I,JBF)-NUM*10
- IF (NUM.NE.0) THEN
- IF (ITYP.EQ.0) THEN
- DO 15 K=1,NP
- WT(K)=WT(K)*HSTELF(IOPT(4),NUM,X(K,I))
- 15 CONTINUE
- ELSE IF (ITYP.EQ.1) THEN
- DO 20 K=1,NP
- WT(K)=WT(K)*HELEFT(NUM,X(K,I))
- 20 CONTINUE
- ELSE IF (ITYP.EQ.2) THEN
- DO 30 K=1,NP
- DO 25 J=1,ND
- XV(J)=X(K,J)
- 25 CONTINUE
- WT(K)=HBASFT(NUM,XV)
- 30 CONTINUE
- GOTO 40
- ENDIF
- ENDIF
- 35 CONTINUE
- ENDIF
-*
-* APPLY WEIGHT CORRECTION TO WT
-*
- 40 IF (IOPT(3).EQ.0) THEN
- DO 45 K=1,NP
- WT(K)=WT(K)/EY(K)
- 45 CONTINUE
- ENDIF
-*
-* UPDATE COVARIANCE MATRIX B: FIRST PARTITION W'W, THEN
-* INVERT THIS PARTITIONED MATRIX
-*
- WNT=0.
- DO 47 I=1,NP
- WNT=WNT+WT(I)*WT(I)
- 47 CONTINUE
- DO 50 I=1,NCO-1
- DP=0.
- DO 49 K=1,NP
- DP=DP+WT(K)*W(K,I)
- 49 CONTINUE
- DD(I)=DP
- 50 CONTINUE
- E=0.
- DO 55 I=1,NCO-1
- DP=0.
- DO 52 K=1,NCO-1
- DP=DP+DD(K)*B(K,I)
- 52 CONTINUE
- FF(I)=DP
- E=E+DP*DD(I)
- 55 CONTINUE
- E=1./(WNT-E)
- DO 65 I=1,NCO-1
- DO 60 J=1,NCO-1
- BT(I,J)=B(I,J)+E*FF(I)*FF(J)
- 60 CONTINUE
- BT(I,NCO)=-FF(I)*E
- BT(NCO,I)=BT(I,NCO)
- 65 CONTINUE
- BT(NCO,NCO)=E
- END
diff --git a/src/packlib/hbook/code/hcx.F b/src/packlib/hbook/code/hcx.F
deleted file mode 100644
index 838f36e..0000000
--- a/src/packlib/hbook/code/hcx.F
+++ /dev/null
@@ -1,169 +0,0 @@
-*
-* $Id: hcx.F,v 1.7 1998/12/02 09:05:17 couet Exp $
-*
-* $Log: hcx.F,v $
-* Revision 1.7 1998/12/02 09:05:17 couet
-* - clean up
-*
-* Revision 1.6 1998/10/05 14:39:00 couet
-* - New option P for profile histograms. Implemented by: Nello Nappi
-* <Nello.Nappi at cern.ch>
-*
-* Revision 1.5 1998/06/11 13:27:14 couet
-* - mod from Kees.van.der.Poel at nikhef.nl
-*
-* Revision 1.4 1998/06/10 15:38:24 couet
-* - bug fixed for option I (Kees van der Poel <keesp at nikhef.nl>)
-*
-* Revision 1.3 1997/01/10 17:49:04 couet
-* - CONT and ERR2 need to be in double precision
-*
-* Revision 1.2 1996/11/18 13:50:09 couet
-* - Bug fixed in the computation of the errors for profile histograms.
-* the bug has been found by Stephane Coutu (coutu at pooh.physics.lsa.umich.edu)
-* and fixed by Olivier Couet. The following macro shows the problem:
-*
-* v/create xv(3) r 0.2 0.4 1.5
-* v/create yv(3) r 0.8 1.2 1.1
-* v/write xv,yv test.dat '2(1x,f5.2)'
-* nt/create 200 'Test ntuple' 2 ! ! x y
-* nt/read 200 test.dat '2(1x,f5.2)'
-* profile 201 'Test profile histogram 1' 2 0. 2. 0. 2.
-* nt/pro 201 200.y%x
-* v/create con1(2) r
-* v/create err1(2) r
-* h/get_vect/con 201 con1
-* h/get_vect/err 201 err1
-* v/print con1
-* v/print err1
-*
-* The output should be:
-*
-* CON1(1) = 1
-* CON1(2) = 1.1
-* ERR1(1) = 0.141421
-* ERR1(2) = 1.04881 <=====
-*
-* and not:
-*
-* CON1(1) = 1
-* CON1(2) = 1.1
-* ERR1(1) = 0.141421
-* ERR1(2) = 0.000119604 <======
-*
-* Revision 1.1.1.1 1996/01/16 17:07:34 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
- FUNCTION HCX(ICX,IOPT)
-*.==========>
-*. IOPT =1 HCX= CONTENT OF CHANNEL ICX
-*. IOPT =2 HCX= ERROR CORRESPONDING TO CHANNEL ICX
-*. IOPT =3 HCX= FUNCTION CORRESPONDING TO CHANNEL ICX
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
-#include "hbook/hcprin.inc"
- DOUBLE PRECISION CONT,ERR2,SUM,EPRIM
-*.___________________________________________
-#include "hbook/jbyt.inc"
-C
-C RETURN THE CONTENTS FOR IOPT=1, OR PRE-CALCULATE THE CONTENTS
-C IF IOPT=2 AND THERE ARE NO PRE-PACKED ERRORS
-C
- HCX = 0.0
- LW = LQ(LCONT)
-C
- IF(IOPT.EQ.1.OR.(IOPT.EQ.2.AND.LW.EQ.0)) THEN
- IF(NB.GE.32)THEN
- HCX = Q(LCONT+KCON1+ICX)
- IF(LW.NE.0)THEN
- IF(LQ(LW).NE.0)THEN
- LN=LQ(LW)
- IF(ICX.LE.0.OR.ICX.GT.IQ(LN-1)) THEN
- HCX = 0.0
- GOTO 1
- ENDIF
- SUM=Q(LN+ICX)
- IF(SUM.NE.0.) HCX = HCX/SUM
- ENDIF
- ENDIF
- ELSE
- L1=ICX*NB
- NBITH=32-MOD(32,NB)
- L2=MOD(L1,NBITH)+1
- L1=LCONT+KCON1+L1/NBITH
- HCX = JBYT(IQ(L1),L2,NB)
- ENDIF
- 1 IF(IOPT.EQ.1) RETURN
- ENDIF
-*
- IF(IOPT.EQ.2) THEN
-C
-C IF NO PRE-PACKED ERRORS, THEN ERROR IS SQRT CONTENTS
-C
- IF(LW.EQ.0) THEN
- HCX = SQRT(ABS(HCX))
- RETURN
- ENDIF
-C
- IF(LQ(LW).EQ.0)THEN
-C
-C ERRORS ARE AVAILABLE IN THE BANK
-C
- HCX=SQRT(Q(LW+ICX))
- RETURN
- ELSE
-C
-C Profile histogram. See HBPROF for explanation of options
-C
- IOPTS=JBYT(IQ(LW),1,2)
- LN=LQ(LW)
- CONT=Q(LCONT+KCON1+ICX)
- ERR2=Q(LW+ICX)
- SUMP=ABS(Q(LN+ICX))
- IF(SUMP.NE.0.)THEN
- IF(JBIT(IQ(LW),3).EQ.0)THEN
- EPRIM=SQRT(ABS(ERR2/SUMP - (CONT/SUMP)**2))
- ELSE
- EPRIM=SQRT(ABS(ERR2/SUMP))
- ENDIF
- IF(EPRIM.LE.0..AND.SUMP.GE.1.)THEN
- IF(IOPTS.EQ.2)THEN
-*
-* Mod from Kees.van.der.Poel at nikhef.nl
-* The previous version was:
-* EPRIM=1./SQRT(12.*SUMP)
-*
- EPRIM=1./SQRT(12.)
-*
- ELSE
- EPRIM=SQRT(ABS(CONT))
- ENDIF
- ENDIF
- IF(IOPTS.EQ.0)THEN
- HCX=EPRIM/SQRT(SUMP)
- ELSEIF(IOPTS.EQ.1)THEN
- HCX=EPRIM
- ELSE
- HCX=EPRIM/SQRT(SUMP)
- ENDIF
- ENDIF
- RETURN
- ENDIF
- ELSE IF(IOPT.EQ.3) THEN
-C
-C GET THE VALUE OF THE FUNCTION ASSOCIATED WITH THE HISTOGRAM
-C
- LFUNC=LQ(LCONT-1)
- IC1=IQ(LFUNC+1)
- IF(ICX.GE.IC1.AND.ICX.LE.IQ(LFUNC+2))THEN
- HCX=Q(LFUNC+ICX-IC1+3)
- ENDIF
- ELSE
-C
-C AN INVALID OPTION VALUE WAS GIVEN
-C
- CALL HBUG('+Error in option value','HCX',IOPT)
- ENDIF
- END
diff --git a/src/packlib/hbook/code/hcxy.F b/src/packlib/hbook/code/hcxy.F
deleted file mode 100644
index b2959e8..0000000
--- a/src/packlib/hbook/code/hcxy.F
+++ /dev/null
@@ -1,58 +0,0 @@
-*
-* $Id: hcxy.F,v 1.1.1.1 1996/01/16 17:07:34 mclareni Exp $
-*
-* $Log: hcxy.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:34 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.23/01 20/02/95 09.33.53 by Julian Bunn
-*-- Author :
- FUNCTION HCXY(ICX,ICY,IOPT)
-*.==========>
-*. RETURNS EITHER THE CONTENTS OR ERROR ON 2D CELL ICX,IXY
-*.
-*. IOPT = 1 RETURN CONTENTS
-*. IOPT = 2 RETURN ERROR (COMPUTED OR PACKED)
-*.
-*. Modified 20/2/95 JJB Add argument IOPT
-*.
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
-#include "hbook/hcprin.inc"
-*.___________________________________________
-#include "hbook/jbyt.inc"
-C
-C FIRST GET CONTENTS
-C
- NW=32/NB
- J=(IQ(LCID+KNCY)-ICY+1)*(IQ(LCID+KNCX)+2)
- L2=ICX+J
- L1=L2/NW+LSCAT+KCON2
- IF(NW.NE.1)THEN
- L2=(NW-1-MOD(L2,NW))*NB +1
- HCXY=JBYT(IQ(L1),L2,NB)
- ELSE
- HCXY=Q(L1)
- ENDIF
-C
-C IF IOPT=2, THEN GET ERROR
-C
- IF(IOPT.EQ.2) THEN
- LW = LQ(LCONT)
- IF(LW.NE.0) THEN
-C
-C ERROR IS PACKED IN HISTOGRAM
-C
- NCX = IQ(LCID+KNCX)
- IOFF = (ICY-1)*NCX + ICX
- HCXY = SQRT(Q(LW+IOFF))
- ELSE
-C
-C ERROR MUST BE CALCULATED AS SQRT CONTENTS
-C
- HCXY = SQRT(ABS(HCXY))
- ENDIF
- ENDIF
- END
diff --git a/src/packlib/hbook/code/hdcofl.F b/src/packlib/hbook/code/hdcofl.F
deleted file mode 100644
index 181ef1c..0000000
--- a/src/packlib/hbook/code/hdcofl.F
+++ /dev/null
@@ -1,30 +0,0 @@
-*
-* $Id: hdcofl.F,v 1.1.1.1 1996/01/16 17:07:35 mclareni Exp $
-*
-* $Log: hdcofl.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:35 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.18/00 17/02/93 13.22.06 by Rene Brun
-*-- Author :
- SUBROUTINE HDCOFL
-*.==========>
-*. DECODE BITS IN HISTOGRAM STATUS WORD
-*..=========> ( R.Brun )
-#include "hbook/hcbits.inc"
-#include "hbook/hcbook.inc"
- DIMENSION IFLAG(37)
- EQUIVALENCE (IFLAG(1),I1)
-*.___________________________________________
- IF(IQ(LCID-2).NE.0)THEN
- DO 10 J=1,31
- 10 IFLAG(J)=JBIT(IQ(LCID+KBITS),J)
- ELSE
- CALL VZERO(IFLAG,31)
- ENDIF
-*
- I230=I2+I3
- I123= I1+I230
- END
diff --git a/src/packlib/hbook/code/hddir.F b/src/packlib/hbook/code/hddir.F
deleted file mode 100644
index 590b0ca..0000000
--- a/src/packlib/hbook/code/hddir.F
+++ /dev/null
@@ -1,39 +0,0 @@
-*
-* $Id: hddir.F,v 1.1.1.1 1996/01/16 17:07:35 mclareni Exp $
-*
-* $Log: hddir.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:35 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.17/03 04/01/93 12.21.06 by Rene Brun
-*-- Author :
- SUBROUTINE HDDIR(CHDIR)
-*.==========>
-*. Delete sub-directory CHDIR from /PAWC/
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
- COMMON/QUEST/IQUEST(100)
- CHARACTER*(*) CHDIR
- CHARACTER*64 CHWOLD
-*.___________________________________________
-*
- CALL HCDIR(CHWOLD,'R')
- IF(CHWOLD(3:6).NE.'PAWC')THEN
-*
-* Directory is in a RZ file
-*
- CALL RZDELT(CHDIR)
- ELSE
-*
-* Directory is in //PAWC
-*
- CALL HCDIR(CHDIR,' ')
- IF(IQUEST(1).NE.0)GO TO 99
- CALL MZDROP(IHDIV,LCDIR,' ')
- ENDIF
- CALL HCDIR(CHWOLD,' ')
-*
- 99 RETURN
- END
diff --git a/src/packlib/hbook/code/hdelet.F b/src/packlib/hbook/code/hdelet.F
deleted file mode 100644
index d71ffe5..0000000
--- a/src/packlib/hbook/code/hdelet.F
+++ /dev/null
@@ -1,103 +0,0 @@
-*
-* $Id: hdelet.F,v 1.1.1.1 1996/01/16 17:07:35 mclareni Exp $
-*
-* $Log: hdelet.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:35 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.21/01 01/11/93 19.01.14 by Fons Rademakers
-*-- Author :
- SUBROUTINE HDELET(ID1)
-*.==========>
-*. DELETE ID FROM MEMORY
-*..=========> ( R.Brun )
-#include "hbook/hcntpar.inc"
-#include "hbook/hcflag.inc"
-#include "hbook/hcbook.inc"
-#include "hbook/hcpiaf.inc"
-#if defined(CERNLIB_CZ)
-#include "hbook/hcache.inc"
-#endif
-*.___________________________________________
- IF(LCDIR.LE.0)GO TO 999
- IF(ID1.EQ.0)GO TO 120
- ID=ID1
- IDPOS=LOCATI(IQ(LTAB+1),IQ(LCDIR+KNRH),ID)
- IF(IDPOS.LE.0)THEN
-#if defined(CERNLIB_CZ)
- IF (SERVPF) THEN
- IDNPOS = LOCATI(IDNOT,IDTNOT,ID)
- IF (IDNPOS .GT. 0) THEN
- DO 5 I = IDNPOS+1, IDTNOT
- IDNOT(I-1) = IDNOT(I)
- 5 CONTINUE
- IDTNOT = IDTNOT - 1
- ENDIF
- ENDIF
-#endif
- CALL HBUG('Unknown histogram','HDELET',ID1)
- GO TO 999
- ENDIF
-*
- LCID=LQ(LTAB-IDPOS)
-*
-*-- if new N-tuple drop also storage buffers
-*
- IF (JBIT(IQ(LCID+KBITS),4).NE.0 .AND. IQ(LCID-2).EQ.ZLINK) THEN
- CALL HNBUFD(ID1)
- ENDIF
-*
- CALL MZDROP(IHDIV,LCID,' ')
- LIDS=LQ(LCDIR-2)
- LQ(LTAB-IDPOS)=0
-*
-* Remove ID from table of ordered IDs
-*
- NRHIST=IQ(LCDIR+KNRH)
- DO 10 I=IDPOS,NRHIST-1
- IQ(LTAB+I)=IQ(LTAB+I+1)
- LQ(LTAB-I)=LQ(LTAB-I-1)
- 10 CONTINUE
- IQ(LCDIR+KNRH)=NRHIST-1
- NRHIST=IQ(LCDIR+KNRH)
-*
-* Update LLDIR in case deleted ID was the last one
-*
- IF(LQ(LCDIR-9).EQ.LCID)THEN
- LREF=0
- LCID=LIDS
- 20 IF(LCID.NE.0)THEN
- LREF=LCID
- LCID=LQ(LCID)
- GO TO 20
- ENDIF
- LQ(LCDIR-9)=LREF
- ENDIF
- GO TO 999
-*
-* Delete all IDs
-*
- 120 IF(LIDS .GT. 0) THEN
- CALL HNBUFD(0)
- CALL MZDROP(IHDIV,LIDS ,'L')
- ENDIF
- NRHIST=IQ(LCDIR+KNRH)
- IF(NRHIST.GT.0.AND.LTAB.GT.0)THEN
- CALL VZERO(LQ(LTAB-NRHIST),NRHIST)
- ENDIF
- IQ(LCDIR+KNRH)=0
- LQ(LCDIR-2)=0
- LQ(LCDIR-9)=0
- LIDS=0
- LLID=0
- NRHIST=0
-#if defined(CERNLIB_CZ)
- IDTNOT = 0
-#endif
-*
- 999 IDLAST=0
- IDHOLD=0
- LID =0
- END
diff --git a/src/packlib/hbook/code/hderi1.F b/src/packlib/hbook/code/hderi1.F
deleted file mode 100644
index 082afe4..0000000
--- a/src/packlib/hbook/code/hderi1.F
+++ /dev/null
@@ -1,48 +0,0 @@
-*
-* $Id: hderi1.F,v 1.1.1.1 1996/01/16 17:07:35 mclareni Exp $
-*
-* $Log: hderi1.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:35 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.10/05 19/06/89 10.00.53 by Rene Brun
-*-- Author :
- SUBROUTINE HDERI1(IDD,X,PARAM,DERIV)
-*.==========>
-*. FOR EACH CASE ,EXCEPT 2-DIM.HISTOGRAM,SEE HDERI2
-*. sets values of derivatives for the parameters of the
-*. external function ufunc (see hfit note)
-*.
-*. INPUT IDD = HISTOGRAM IDENTIFIER
-*. ARGUMENTS
-*. X = ARGUMENTS OF FUNCTION: CENTRE OF
-*. CHANNEL OR CELL (ARRAY)
-*.
-*. PARAM = CURRENT VALUES OF THE PARAMETERS
-*. (ARRAY)
-*.
-*. OUTPUT DERIV =DERIVATIVES (ARRAY)
-*. ARGUMENT
-*..=========> ( I.Ivanchenko )
-#if !defined(CERNLIB_DOUBLE)
- DIMENSION X(1),PARAM(1),DERIV(1)
-#endif
-#if defined(CERNLIB_DOUBLE)
- DIMENSION X(1)
- DOUBLE PRECISION PARAM(1),DERIV(1)
-#endif
-*.___________________________________________
-* IF(IDD.NE.2)THEN
-* DERIV(1)=EXP(PARAM(1)+PARAM(2)*X(1))
-* DERIV(2)=DERIV(1)*X(1)
-* ELSE
-* R1GAUS=(X(1)-PARAM(2))/PARAM(3)
-* R2GAUS=R1GAUS**2
-* DERIV(1)=EXP(-0.5*R2GAUS)
-* HGAUSS=PARAM(1)*DERIV(1)
-* DERIV(2)=HGAUSS*R1GAUS/PARAM(3)
-* DERIV(3)=HGAUSS*R2GAUS/PARAM(3)
-* ENDIF
- END
diff --git a/src/packlib/hbook/code/hderi2.F b/src/packlib/hbook/code/hderi2.F
deleted file mode 100644
index e75d9fd..0000000
--- a/src/packlib/hbook/code/hderi2.F
+++ /dev/null
@@ -1,35 +0,0 @@
-*
-* $Id: hderi2.F,v 1.1.1.1 1996/01/16 17:07:35 mclareni Exp $
-*
-* $Log: hderi2.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:35 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.10/05 19/06/89 10.01.34 by Rene Brun
-*-- Author :
- SUBROUTINE HDERI2(IDD,X,Y,PARAM,DERIV)
-*.==========>
-*. sets values of derivatives for the parameters of the
-*. external function ufunc (see hfit note)
-*.
-*. INPUT IDD = HISTOGRAM IDENTIFIER
-*. ARGUMENTS
-*. X =
-*. ARGUMENTS OF FUNCTION:CENTRE OF CELL
-*. Y =
-*.
-*. PARAM = CURRENT VALUES OF THE PARAMETERS
-*. (ARRAY)
-*. OUTPUT DERIV = DERIVATIVES (ARRAY)
-*. ARGUMENT
-*..=========> ( I.Ivanchenko )
-#if !defined(CERNLIB_DOUBLE)
- DIMENSION PARAM(1),DERIV(1)
-#endif
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION PARAM(1),DERIV(1)
-#endif
-*.___________________________________________
- END
diff --git a/src/packlib/hbook/code/hderin.F b/src/packlib/hbook/code/hderin.F
deleted file mode 100644
index 26dc303..0000000
--- a/src/packlib/hbook/code/hderin.F
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: hderin.F,v 1.1.1.1 1996/01/16 17:07:35 mclareni Exp $
-*
-* $Log: hderin.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:35 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.10/05 21/02/89 16.14.47 by Rene Brun
-*-- Author :
- SUBROUTINE HDERIN (X,PAR,DER)
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION PAR,DER
-#endif
- DIMENSION X(1),PAR(1),DER(1)
- END
diff --git a/src/packlib/hbook/code/hderiv.F b/src/packlib/hbook/code/hderiv.F
deleted file mode 100644
index 4013b3e..0000000
--- a/src/packlib/hbook/code/hderiv.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: hderiv.F,v 1.1.1.1 1996/01/16 17:07:35 mclareni Exp $
-*
-* $Log: hderiv.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:35 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.10/05 17/08/89 08.50.24 by Rene Brun
-*-- Author :
- SUBROUTINE HDERIV(DERIV)
-*.==========>
-*. stores values of derivatives for the parameters of the
-*. function being fitted.
-*. Routine called from the user function
-*.
-*..=========> ( R.Brun )
-#include "hbook/hcfits.inc"
- DIMENSION DERIV(1)
-*.___________________________________________
-*.
- DO 10 I=1,NFPAR
- FITDER(I)=DERIV(I)
- 10 CONTINUE
- END
diff --git a/src/packlib/hbook/code/hdexpo.F b/src/packlib/hbook/code/hdexpo.F
deleted file mode 100644
index f793e2a..0000000
--- a/src/packlib/hbook/code/hdexpo.F
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: hdexpo.F,v 1.1.1.1 1996/01/16 17:07:35 mclareni Exp $
-*
-* $Log: hdexpo.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:35 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.21/08 24/01/94 19.07.48 by Rene Brun
-*-- Author :
- FUNCTION HDEXPO (X)
-*.==========>
-*. Evaluates function E(X)=EXP(A+B*X)
-*. and its first derivatives
-*..=========> ( R.Brun, E.Lessner)
-#include "hbook/hcfits.inc"
-#include "hbook/hcfitd.inc"
- DOUBLE PRECISION DD,XX
- PARAMETER (DDMAX=60.)
-*.___________________________________________
- XX=X
- DD=FITPAD(1)+FITPAD(2)*XX
- IF (DD.LT.-DDMAX) DD=-DDMAX
- IF (DD.GT.DDMAX) DD=DDMAX
- FITFUN=EXP(DD)
- HDEXPO=FITFUN
- FITDER(1)=FITFUN
- FITDER(2)=FITFUN*XX
- END
-
diff --git a/src/packlib/hbook/code/hdipkl.F b/src/packlib/hbook/code/hdipkl.F
deleted file mode 100644
index 754f2c0..0000000
--- a/src/packlib/hbook/code/hdipkl.F
+++ /dev/null
@@ -1,58 +0,0 @@
-*
-* $Id: hdipkl.F,v 1.1.1.1 1996/01/16 17:07:35 mclareni Exp $
-*
-* $Log: hdipkl.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:35 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.22/11 23/08/94 14.17.45 by Rene Brun
-*-- Author :
- FUNCTION HDIPKL(Z)
-*==========>
-C CALCULATES THE PROBABILITY OF EXCEEDING THE VALUE Z=N**2 * DN
-C FOR THE KOLMOGOROV TEST, WHERE DN=MAX DISTANCE BETWEEN
-C CUMULATIVE DISTRIBUTION FUNCTION AND N EXPERIMENTAL VALUES.
-C FUNCTION HOLDS ONLY FOR LARGE N, BUT IS ACCURATE TO 10**-11
-C THETA FUNCTIONS INVERSION FORMULA IS USED FOR THE ARGUMENTS .LE.1
-C
-C This is a copy of the CERN Library routine PROBKL
-*==========>
- DIMENSION CONS(3) , FJ2(5)
- SAVE CONS,FJ2,SQR2PI
-C CONS(J) = -0.5*(PI*(2*J-1)/2)**2
- DATA CONS / -1.233700550136 , -11.10330496 , -30.84251376 /
-C FJ2(J) = -2 * J**2
- DATA FJ2 / -2. , -8. , -18. , -32. , -50. /
- DATA SQR2PI/2.50662827463/
- P = 0.
- IF(Z.GT.1.) GO TO 3
- IF(Z.LT.0.2) GO TO 6
-C Z .LT. 1. USE SERIES IN EXP(1/Z**2)
- ZINV = 1./Z
- A = SQR2PI * ZINV
- ZINV2 = ZINV**2
- DO 4 J= 1, 3
- ARG = CONS(J)*ZINV2
- IF(ARG.LT.-30.)GO TO 4
- P = P + EXP(ARG)
- 4 CONTINUE
- P = 1. - A*P
- GO TO 2
-C Z .GT. 1 USE SERIES IN EXP(Z**2)
- 3 SIG2 = -2.
- Z2 = Z**2
- DO 5 J= 1, 5
- SIG2 = -SIG2
- C = FJ2(J) * Z2
- IF(C.LT.-100) GO TO 2
- E = SIG2 * EXP(C)
- 5 P = P + E
- GO TO 2
-C Z .LT. 0.2 PROB = 1.
- 6 P=1.
- 2 CONTINUE
- HDIPKL = P
- RETURN
- END
diff --git a/src/packlib/hbook/code/hdummy.F b/src/packlib/hbook/code/hdummy.F
deleted file mode 100644
index baf5a26..0000000
--- a/src/packlib/hbook/code/hdummy.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: hdummy.F,v 1.1.1.1 1996/01/16 17:07:35 mclareni Exp $
-*
-* $Log: hdummy.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:35 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.10/05 21/02/89 16.14.47 by Rene Brun
-*-- Author :
- SUBROUTINE HDUMMY(CHROUT)
-*.==========>
-*. A dummy routine has been called
-*..=========> ( R.Brun )
-#include "hbook/hcunit.inc"
- CHARACTER*6 CHROUT
-*.___________________________________________
- WRITE(LOUT,1000)CHROUT
- 1000 FORMAT(' ***** WARNING DUMMY ROUTINE ',A,' HAS BEEN CALLED ****')
- END
diff --git a/src/packlib/hbook/code/hdump.F b/src/packlib/hbook/code/hdump.F
deleted file mode 100644
index 174c588..0000000
--- a/src/packlib/hbook/code/hdump.F
+++ /dev/null
@@ -1,35 +0,0 @@
-*
-* $Id: hdump.F,v 1.1.1.1 1996/01/16 17:07:35 mclareni Exp $
-*
-* $Log: hdump.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:35 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.10/05 21/02/89 16.14.47 by Rene Brun
-*-- Author :
- SUBROUTINE HDUMP(ID2)
-*.==========>
-*. DUMPS HISTOGRAM ID2
-*. IF ID2=0 DUMPS ALL THE HBOOK AREA IN /PAWC/
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
-*.___________________________________________
- IF(ID2.NE.0)THEN
- CALL HFIND(ID2,'HDUMP ')
- IF(LCID.NE.0)THEN
- IF(LFIX.EQ.0)THEN
- CALL DZSHOW('DZSHOW',IHDIV,LCID, 'V',0,0,0,0)
- ELSE
- CALL DZSHOW('DZSHOW',IHDIV,LCONT,'V',0,0,0,0)
- ENDIF
- ELSE
- RETURN
- ENDIF
- ELSE
- IF(LCDIR.NE.0)THEN
- CALL DZSHOW('DZSHOW',IHDIV,LCDIR,'V',0,0,0,0)
- ENDIF
- ENDIF
- END
diff --git a/src/packlib/hbook/code/heleft.F b/src/packlib/hbook/code/heleft.F
deleted file mode 100644
index 7fbc62c..0000000
--- a/src/packlib/hbook/code/heleft.F
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: heleft.F,v 1.1.1.1 1996/01/16 17:07:35 mclareni Exp $
-*
-* $Log: heleft.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:35 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.10/05 21/02/89 16.14.47 by Rene Brun
-*-- Author :
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION HELEFT (IEF,X)
-#endif
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION FUNCTION HELEFT (IEF,X)
-#endif
-*.==========>
-*. RETURNS ELEMENTARY FUNCTION (ORDER NUMBER IEF)
-*. THIS IS A DEFAULT FUNCTION
-*..=========> ( R.Brun )
- HELEFT=0.
- END
diff --git a/src/packlib/hbook/code/hermes.F b/src/packlib/hbook/code/hermes.F
deleted file mode 100644
index 527ae33..0000000
--- a/src/packlib/hbook/code/hermes.F
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: hermes.F,v 1.1.1.1 1996/01/16 17:07:35 mclareni Exp $
-*
-* $Log: hermes.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:35 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.22/13 28/09/94 08.39.36 by Rene Brun
-*-- Author :
- SUBROUTINE HERMES(IER)
-*.==========>
-*. To define logical unit used for error messages
-*. If LERR.LE.0 errors are not printed by HBUG.
-*..=========> ( R.Brun )
-#include "hbook/hcunit.inc"
-*.___________________________________________
- LERR=IER
- END
diff --git a/src/packlib/hbook/code/herror.F b/src/packlib/hbook/code/herror.F
deleted file mode 100644
index fcd2110..0000000
--- a/src/packlib/hbook/code/herror.F
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: herror.F,v 1.1.1.1 1996/01/16 17:07:35 mclareni Exp $
-*
-* $Log: herror.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:35 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.10/05 21/02/89 16.14.47 by Rene Brun
-*-- Author :
- SUBROUTINE HERROR(ID1)
-*.==========>
-*. STATISTICAL ERRORS WILL BE CALCULATED AT EDITING
-*. IN THIS CASE FILLING MUST BE DONE WITH EQUAL WEIGTHS
-*..=========> ( R.Brun )
-*.___________________________________________
- CALL HIDOPT(ID1,'ERRO')
- CALL HOBSOL('HERROR','ERRO','NERR')
- END
diff --git a/src/packlib/hbook/code/hexda1.F b/src/packlib/hbook/code/hexda1.F
deleted file mode 100644
index 40d1558..0000000
--- a/src/packlib/hbook/code/hexda1.F
+++ /dev/null
@@ -1,88 +0,0 @@
-*
-* $Id: hexda1.F,v 1.1.1.1 1996/01/16 17:07:35 mclareni Exp $
-*
-* $Log: hexda1.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:35 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.23/01 20/02/95 09.39.39 by Julian Bunn
-*-- Author :
- SUBROUTINE HEXDA1(EXDA,ICELL,IFLRET)
-*.==========>
-*. PUTS ONE PORTION OF DATA F,SIGF,ARGUMENT
-*. INTO THE EXDA
-*..=========> ( I.Ivanchenko )
-#include "hbook/hcbook.inc"
-#include "hbook/hcfit2.inc"
-#include "hbook/hcfitr.inc"
- DIMENSION EXDA(4)
-*.___________________________________________
- IFLRET=0
-*
- IF(IFLSF.NE.0)THEN
- ICHANX=(ICELL-1)*IDIMPN
- DO 1 I=1,IDIMPN
- 1 EXDA(I)=HCX(ICHANX+I,1)
- IF(EXDA(2).EQ.0.)THEN
- EXDA(2)=ABS(EXDA(1))
- IF(EXDA(2).EQ.0.)GO TO 99
- ENDIF
- IFLRET=1
- GO TO 99
- ENDIF
-*
- ICHANX=MOD(ICELL,NCHANX)
- IF(ICHANX.EQ.0)ICHANX=NCHANX
- RCHANX=ICHANX
- ICHX=ICHANX
- IF(IFTRNG.NE.0)THEN
- ICHANX=ICHANX+IFXLOW-1
- ENDIF
-*
- EXDA(3)=XMIN+(RCHANX-0.5)*BINWID
- IF(IDIMPN.EQ.3)THEN
- EXDA(1)=HCX(ICHANX,1)
- ELSE
- ICHANY=(ICELL-ICHX)/NCHANX+1
- RCHANY=ICHANY
- IF(IFTRNG.NE.0)THEN
- ICHANY=ICHANY+IFYLOW-1
- ENDIF
- EXDA(1)=HCXY(ICHANX,ICHANY,1)
- EXDA(4)=YMIN+(RCHANY-0.5)*BINWIY
- ENDIF
-*
-* CHECK OUT OF ERRORBARS PRESENCE
-*
- IF(IWEIGH.NE.0)THEN
- IF(IWEIGH.EQ.1)THEN
- IF(EXDA(1).NE.0.)THEN
- EXDA(2)=1.
- ELSE
- EXDA(2)=0.
- ENDIF
- ELSEIF(IWEIGH.EQ.2)THEN
- EXDA(2)=1.
- ELSE
- EXDA(2)=WGTMAX
- ENDIF
- IFLRET=1
- GO TO 99
- ENDIF
-*
- IF(LQ(LCONT).NE.0.AND.IDIMPN.EQ.3)THEN
- EXDA(2)=HCX(ICHANX,2)
- ELSE
- EXDA(2)=SQRT(ABS(EXDA(1)))
- ENDIF
- IF(EXDA(2).EQ.0.)THEN
- EXDA(2)=ABS(EXDA(1))
- IF(EXDA(2).EQ.0.)GO TO 99
- ENDIF
-*
- IFLRET=1
-*
- 99 RETURN
- END
diff --git a/src/packlib/hbook/code/hexdat.F b/src/packlib/hbook/code/hexdat.F
deleted file mode 100644
index 968074b..0000000
--- a/src/packlib/hbook/code/hexdat.F
+++ /dev/null
@@ -1,107 +0,0 @@
-*
-* $Id: hexdat.F,v 1.1.1.1 1996/01/16 17:07:35 mclareni Exp $
-*
-* $Log: hexdat.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:35 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.23/01 20/02/95 09.40.09 by Julian Bunn
-*-- Author :
- SUBROUTINE HEXDAT(IEXDAT,IFLRET)
-*.==========>
-*. PREPARES Q(IEXDAT)-ARRAY FOR HFUMIL AND RETURNS
-*. IFLRET=0,IF HISTOGRAM IS EMPTY,OTHERWISE IFLRET=1
-*. PUTS HISTOGRAM PARAMETRS NUMEP,XMIN,EPSW,ALLCHA,BINWID,
-*. WGTMAX INTO THE /HCFIT2/
-*..=========> ( I.Ivanchenko )
-#include "hbook/hcflag.inc"
-#include "hbook/hcbook.inc"
-#include "hbook/hcfit2.inc"
-*.___________________________________________
- IFLRET=0
- NCHANX=IQ(LPRX)
- NCHANY=1
- BINWID=(Q(LPRX+2)-Q(LPRX+1))/FLOAT(NCHANX)
- CUR1X=Q(LPRX+1)-BINWID*0.5
-*
-* PREPARATION EXDATA (F,SIGF,X),SIGF=SQRT(F)
-* IF(F.LT.0.)SIGF=1. IF((F/FMAX).LT.EPSW)EJECT BIN
-*
- L=1
- EPSW=1.E-10
- ALLCHA=0.
-*
- IF(IDIMPN.NE.3)THEN
- NCHANY=IQ(LPRY)
- BINWIY=(Q(LPRY+2)-Q(LPRY+1))/FLOAT(NCHANY)
- CURY=Q(LPRY+1)-BINWIY*0.5
- ENDIF
-*
-* CHECK OUT OF ERRORBARS PRESENCE
- IF(LQ(LCONT).NE.0.AND.IDIMPN.EQ.3)GO TO 16
-*
- WGTMAX=0.
- K=1
- DO 4 J=1,NCHANY
- DO 3 I=1,NCHANX
- LL1 = IEXDAT + IDIMPN*(K-1)
- IF( IDIMPN.EQ.3 ) Q(LL1) = HCX (I,1)
- IF( IDIMPN.EQ.4 ) Q(LL1) = HCXY(I,J,1)
- IF( ABS( Q(LL1) ).GT.WGTMAX ) WGTMAX = ABS( Q(LL1) )
- K=K+1
- 3 CONTINUE
- 4 CONTINUE
-*
-* IF(HISTOGRAM IS EMPTY)RETURN
-*
- IF(WGTMAX.EQ.0.)CALL HBUG('Empty histogram','HFIT**',ID)
- IF(WGTMAX.EQ.0.)GO TO 99
-*
- K=1
- DO 14 J=1,NCHANY
- IF(IDIMPN.EQ.4)CURY=CURY+BINWIY
- CURX=CUR1X
- DO 13 I=1,NCHANX
- CURX=CURX+BINWID
- LL1 = IEXDAT + IDIMPN*(K-1)
- LL2 = IEXDAT + IDIMPN*(L-1)
- IF(IWEIGH.NE.0)THEN
- Q(LL2+1) = 1.
- ELSE
- IF( ABS( Q(LL1) )/WGTMAX .LE. EPSW ) GO TO 14
- Q(LL2) = Q(LL1)
- Q(LL2+1) = SQRT( ABS( Q(LL2) ) )
- ENDIF
- IF( IDIMPN.EQ.4 ) Q(LL2+3) = CURY
- Q(LL2+2) = CURX
- ALLCHA = ALLCHA + Q(LL2)
- L=L+1
- K=K+1
- 13 CONTINUE
- 14 CONTINUE
- GO TO 18
-*
- 16 CONTINUE
- CURX=CUR1X
- DO 17 K=1,NCHANX
- CURX=CURX+BINWID
- LL2 = IEXDAT + IDIMPN*(L-1)
- Q(LL2+1) = HCX(K,2)
- IF( Q(LL2+1).EQ.0 ) GO TO 17
- Q(LL2) = HCX(K,1)
- Q(LL2+2) = CURX
- ALLCHA = ALLCHA + Q(LL2)
- L=L+1
- 17 CONTINUE
- 18 NUMEP=L-1
-*
-* IF(HISTOGRAM IS EMPTY)RETURN
-*
- IF(NUMEP.EQ.0)CALL HBUG('Empty histogram','HFIT**',ID)
- IF(NUMEP.EQ.0)GO TO 99
- IFLRET=1
-*
- 99 RETURN
- END
diff --git a/src/packlib/hbook/code/hexist.F b/src/packlib/hbook/code/hexist.F
deleted file mode 100644
index 45d6bf1..0000000
--- a/src/packlib/hbook/code/hexist.F
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: hexist.F,v 1.1.1.1 1996/01/16 17:07:35 mclareni Exp $
-*
-* $Log: hexist.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:35 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.10/05 21/02/89 16.14.47 by Rene Brun
-*-- Author :
- LOGICAL FUNCTION HEXIST(ID2)
-*.==========>
-*. HEXIST=.TRUE. IF ID2 PRESENTLY EXIST
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
-#include "hbook/hcflag.inc"
-*.___________________________________________
- HEXIST=.FALSE.
- ID=ID2
- IF(LCDIR.GT.0)THEN
- IDPOS=LOCATI(IQ(LTAB+1),IQ(LCDIR+KNRH),ID)
- IF(IDPOS.GT.0) HEXIST=.TRUE.
- ENDIF
- END
diff --git a/src/packlib/hbook/code/hf1.F b/src/packlib/hbook/code/hf1.F
deleted file mode 100644
index 9fe4b82..0000000
--- a/src/packlib/hbook/code/hf1.F
+++ /dev/null
@@ -1,97 +0,0 @@
-*
-* $Id: hf1.F,v 1.2 2000/12/19 09:43:53 couet Exp $
-*
-* $Log: hf1.F,v $
-* Revision 1.2 2000/12/19 09:43:53 couet
-* - Bug fixed in RMS calculation. When IDOPT STAT is on the RMS calculation
-* was wrong one some machines because it was done using REAL and DOUBLE
-* PRECISION numbers. Now we use on ly DOUBLE PRECISION numbers.
-*
-* Revision 1.1.1.1 1996/01/16 17:07:35 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.20/08 10/09/93 09.16.55 by Rene Brun
-*-- Author :
- SUBROUTINE HF1(ID1,X,W)
-*.==========>
-*. FAST FILLING ENTRY FOR A 1-DIM HISTOGRAM
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
-#include "hbook/hcflag.inc"
-#include "hbook/hcbits.inc"
-#include "hbook/hcprin.inc"
- DOUBLE PRECISION SWX(2),DBLX,DBLZ
-*.___________________________________________
-#include "hbook/jbyt.inc"
- IF(ID1.NE.IDLAST)THEN
- ID=ID1
- IDPOS=LOCATI(IQ(LTAB+1),IQ(LCDIR+KNRH),ID)
- IF(IDPOS.LE.0)RETURN
- IDLAST=ID1
- LCID=LQ(LTAB-IDPOS)
- LCONT=LQ(LCID-1)
- LPRX=LCID+KNCX
- I5=JBIT(IQ(LCID+KBITS),5)
- I6=JBIT(IQ(LCID+KBITS),6)
- I7=JBIT(IQ(LCID+KBITS),7)
- ENDIF
-*
- IF(I5.NE.0)CALL HF1AUT(X,W)
- IQ(LCONT+KNOENT)=IQ(LCONT+KNOENT)+1
- IF(X.LT.Q(LPRX+1))THEN
- ICHAN=0
- ELSEIF(.NOT.(X.LT.Q(LPRX+2)))THEN
- ICHAN=IQ(LPRX)+1
- ELSE
- IF(I6.EQ.0)THEN
- ICHAN=(X-Q(LPRX+1))*FLOAT(IQ(LPRX))/(Q(LPRX+2)-Q(LPRX+1))+ 1
- ELSE
- LBINS=LQ(LCID-2)
- ICHAN=1
- 10 IF(.NOT.(X.LT.Q(LBINS+ICHAN+1)))THEN
- ICHAN=ICHAN+1
- GO TO 10
- ENDIF
- ENDIF
- ENDIF
-*
- IF(IQ(LCONT+KNBIT).GE.32)THEN
- Q(LCONT+ICHAN+KCON1)=Q(LCONT+ICHAN+KCON1)+W
- ELSE
- NBPROX=IQ(LCONT+KNBIT)
- NB=32/NBPROX
- LWORD=ICHAN/NB
- LBIT=(ICHAN-NB*LWORD)*NBPROX+1
- INC=JBYT(IQ(LCONT+LWORD+KCON1),LBIT,NBPROX)
- INC=INC+W+0.5
- IF(INC.GT.MAXBIT(NBPROX))INC=MAXBIT(NBPROX)
- CALL SBYT(INC,IQ(LCONT+LWORD+KCON1),LBIT,NBPROX)
- ENDIF
-*
-* ERRORS
-*
- IF(LQ(LCONT).NE.0)THEN
- IF(ICHAN.GT.0.AND.ICHAN.LE.IQ(LPRX))THEN
- LW=LQ(LCONT)
- Q(LW+ICHAN)=Q(LW+ICHAN)+W*W
- ENDIF
- ENDIF
-*
-* STATISTICS
-*
- IF(I7.NE.0)THEN
- IF(ICHAN.GT.0.AND.ICHAN.LE.IQ(LPRX))THEN
- Z=ABS(W)
- Q(LCONT+KSTAT1)=Q(LCONT+KSTAT1)+Z
- Q(LCONT+KSTAT1+1)=Q(LCONT+KSTAT1+1)+Z*Z
- CALL UCOPY(Q(LCONT+KSTAT1+2),SWX,4)
- DBLX=X
- DBLZ=Z
- SWX(1)=SWX(1)+DBLZ*DBLX
- SWX(2)=SWX(2)+DBLZ*DBLX*DBLX
- CALL UCOPY(SWX,Q(LCONT+KSTAT1+2),4)
- ENDIF
- ENDIF
- END
diff --git a/src/packlib/hbook/code/hf1aut.F b/src/packlib/hbook/code/hf1aut.F
deleted file mode 100644
index 488f1a8..0000000
--- a/src/packlib/hbook/code/hf1aut.F
+++ /dev/null
@@ -1,119 +0,0 @@
-*
-* $Id: hf1aut.F,v 1.1.1.1 1996/01/16 17:07:35 mclareni Exp $
-*
-* $Log: hf1aut.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:35 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.19/00 26/04/93 11.57.51 by Rene Brun
-*-- Author :
- SUBROUTINE HF1AUT(X,W)
-*.==========>
-*. computes bin width at filling time
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
-#include "hbook/hcbits.inc"
-#include "hbook/hcprin.inc"
-*.___________________________________________
-#include "hbook/jbyt.inc"
- LAUTO=LQ(LCONT-2)
- IF(LAUTO.LE.0)GO TO 99
- NOENT=IQ(LCONT+KNOENT)
-*
-* Special case for first entry
-*
- IF(NOENT.EQ.0)THEN
- BWID=0.001*ABS(X)
- IF(BWID.EQ.0.)BWID=1.E-30
- XMIN=X-BWID
- XMAX=X+BWID
- ELSE
-*
-* Find mean value and RMS.
-*
- XMEAN=Q(LAUTO+1)
- XRMS=XMEAN*XMEAN
- XXMIN=XMEAN
- XXMAX=XMEAN
- DO 10 I=2,NOENT
- XX=Q(LAUTO+2*I-1)
- XMEAN=XMEAN+XX
- XRMS=XRMS+XX*XX
- XXMIN=MIN(XX,XXMIN)
- XXMAX=MAX(XX,XXMAX)
- 10 CONTINUE
- XMEAN=XMEAN/NOENT
- XRMS=SQRT(ABS(XRMS/NOENT -XMEAN*XMEAN))
-*
-* Find nice binning
-*
- CALL HBIN(0.,6.*XRMS,IQ(LCID+KNCX),XMIN,X1,ICN,BWID)
-*
- DXM=IQ(LCID+KNCX)*BWID/2.
- IF(XXMIN.GE.0.)THEN
- XMIN=XXMIN-MOD(XXMIN,10.*BWID)
- IF(XMIN.LT.0.)XMIN=0.
- IF(XXMAX-XXMIN.GT.XXMIN)XMIN=0.
- ENDIF
- IF(XXMAX.LE.0.)THEN
- XMAX=XXMAX-MOD(XXMAX,10.*BWID)
- IF(XMAX.GT.0.)XMAX=0.
- IF(XXMIN-XXMAX.LT.XXMAX)XMAX=0.
- XMIN=XMAX-2.*DXM
- ENDIF
- IF(XXMIN*XXMAX.LT.0..AND.(XMEAN-DXM)*(XMEAN+DXM).LT.0.)THEN
- XMIN=XMEAN-MOD(XMEAN,10.*BWID)-DXM
- ENDIF
- XMAX=XMIN+2.*DXM
- ENDIF
-*
-* Reset old entries (except statistics)
-* and fill again if new binning
-*
- IF(XMIN.NE.Q(LCID+KXMIN).OR.XMAX.NE.Q(LCID+KXMAX))THEN
- CALL VZERO(IQ(LCONT+KCON1),IQ(LCONT-1)-KCON1+1)
- LW=LQ(LCONT)
- IF(LW.NE.0)CALL VZERO(IQ(LW+1),IQ(LW-1))
- Q(LCID+KXMIN)=XMIN
- Q(LCID+KXMAX)=XMAX
- DO 20 I=1,NOENT
- XX=Q(LAUTO+2*I-1)
- WW=Q(LAUTO+2*I)
- ICHAN=(XX-XMIN)/BWID +1
- IF(ICHAN.LE.0)ICHAN=0
- IF(ICHAN.GT.IQ(LCID+KNCX))ICHAN=IQ(LCID+KNCX)+1
- IF(IQ(LCONT+KNBIT).GE.32)THEN
- Q(LCONT+ICHAN+KCON1)=Q(LCONT+ICHAN+KCON1)+WW
- ELSE
- NBPROX=IQ(LCONT+KNBIT)
- NB=32/NBPROX
- LWORD=ICHAN/NB
- LBIT=(ICHAN-NB*LWORD)*NBPROX+1
- INC=JBYT(IQ(LCONT+LWORD+KCON1),LBIT,NBPROX)
- INC=INC+W+0.5
- IF(INC.GT.MAXBIT(NBPROX))INC=MAXBIT(NBPROX)
- CALL SBYT(INC,IQ(LCONT+LWORD+KCON1),LBIT,NBPROX)
- ENDIF
- IF(LW.NE.0)THEN
- IF(ICHAN.GT.0.AND.ICHAN.LE.IQ(LCID+KNCX))THEN
- Q(LW+ICHAN)=Q(LW+ICHAN)+WW*WW
- ENDIF
- ENDIF
- 20 CONTINUE
- ENDIF
-*
-* Stop automatic binning algorithm after 50 entries
-*
- IF(NOENT.LT.100)THEN
- Q(LAUTO+2*NOENT+1)=X
- Q(LAUTO+2*NOENT+2)=W
- ELSE
- CALL MZDROP(IHDIV,LAUTO,' ')
- CALL SBIT0(IQ(LCID+KBITS),5)
- I5=0
- ENDIF
-*
- 99 RETURN
- END
diff --git a/src/packlib/hbook/code/hf1e.F b/src/packlib/hbook/code/hf1e.F
deleted file mode 100644
index 5347aaa..0000000
--- a/src/packlib/hbook/code/hf1e.F
+++ /dev/null
@@ -1,98 +0,0 @@
-*
-* $Id: hf1e.F,v 1.2 2000/12/19 16:56:22 couet Exp $
-*
-* $Log: hf1e.F,v $
-* Revision 1.2 2000/12/19 16:56:22 couet
-* - Bug fixed in RMS calculation. When IDOPT STAT is on the RMS calculation
-* was wrong one some machines because it was done using REAL and DOUBLE
-* PRECISION numbers. Now we use on ly DOUBLE PRECISION numbers.
-*
-* Revision 1.1.1.1 1996/01/16 17:07:35 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.21/09 28/02/94 15.24.40 by Rene Brun
-*-- Author :
- SUBROUTINE HF1E(ID1,X,W,E)
-*.==========>
-*. FAST FILLING ENTRY FOR A 1-DIM HISTOGRAM
-*. Channel incremented by W and errors by E
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
-#include "hbook/hcflag.inc"
-#include "hbook/hcbits.inc"
-#include "hbook/hcprin.inc"
- DOUBLE PRECISION SWX(2),DBLX,DBLZ
-*.___________________________________________
-#include "hbook/jbyt.inc"
- IF(ID1.NE.IDLAST)THEN
- ID=ID1
- IDPOS=LOCATI(IQ(LTAB+1),IQ(LCDIR+KNRH),ID)
- IF(IDPOS.LE.0)RETURN
- IDLAST=ID1
- LCID=LQ(LTAB-IDPOS)
- LCONT=LQ(LCID-1)
- LPRX=LCID+KNCX
- I5=JBIT(IQ(LCID+KBITS),5)
- I6=JBIT(IQ(LCID+KBITS),6)
- I7=JBIT(IQ(LCID+KBITS),7)
- ENDIF
-*
- IF(I5.NE.0)CALL HF1AUT(X,W)
- IQ(LCONT+KNOENT)=IQ(LCONT+KNOENT)+1
- IF(X.LT.Q(LPRX+1))THEN
- ICHAN=0
- ELSEIF(.NOT.(X.LT.Q(LPRX+2)))THEN
- ICHAN=IQ(LPRX)+1
- ELSE
- IF(I6.EQ.0)THEN
- ICHAN=(X-Q(LPRX+1))*FLOAT(IQ(LPRX))/(Q(LPRX+2)-Q(LPRX+1))+ 1
- ELSE
- LBINS=LQ(LCID-2)
- ICHAN=1
- 10 IF(.NOT.(X.LT.Q(LBINS+ICHAN+1)))THEN
- ICHAN=ICHAN+1
- GO TO 10
- ENDIF
- ENDIF
- ENDIF
-*
- IF(IQ(LCONT+KNBIT).GE.32)THEN
- Q(LCONT+ICHAN+KCON1)=Q(LCONT+ICHAN+KCON1)+W
- ELSE
- NBPROX=IQ(LCONT+KNBIT)
- NB=32/NBPROX
- LWORD=ICHAN/NB
- LBIT=(ICHAN-NB*LWORD)*NBPROX+1
- INC=JBYT(IQ(LCONT+LWORD+KCON1),LBIT,NBPROX)
- INC=INC+W+0.5
- IF(INC.GT.MAXBIT(NBPROX))INC=MAXBIT(NBPROX)
- CALL SBYT(INC,IQ(LCONT+LWORD+KCON1),LBIT,NBPROX)
- ENDIF
-*
-* ERRORS
-*
- IF(LQ(LCONT).NE.0)THEN
- IF(ICHAN.GT.0.AND.ICHAN.LE.IQ(LPRX))THEN
- LW=LQ(LCONT)
- Q(LW+ICHAN)=Q(LW+ICHAN)+E*E
- ENDIF
- ENDIF
-*
-* STATISTICS
-*
- IF(I7.NE.0)THEN
- IF(ICHAN.GT.0.AND.ICHAN.LE.IQ(LPRX))THEN
- Z=ABS(W)
- Q(LCONT+KSTAT1)=Q(LCONT+KSTAT1)+Z
- Q(LCONT+KSTAT1+1)=Q(LCONT+KSTAT1+1)+Z*Z
- CALL UCOPY(Q(LCONT+KSTAT1+2),SWX,4)
- DBLX=X
- DBLZ=Z
- SWX(1)=SWX(1)+DBLZ*DBLX
- SWX(2)=SWX(2)+DBLZ*DBLX*DBLX
- CALL UCOPY(SWX,Q(LCONT+KSTAT1+2),4)
- ENDIF
- ENDIF
- END
diff --git a/src/packlib/hbook/code/hf1n.F b/src/packlib/hbook/code/hf1n.F
deleted file mode 100644
index 9c928ed..0000000
--- a/src/packlib/hbook/code/hf1n.F
+++ /dev/null
@@ -1,111 +0,0 @@
-*
-* $Id: hf1n.F,v 1.2 2000/12/19 16:56:22 couet Exp $
-*
-* $Log: hf1n.F,v $
-* Revision 1.2 2000/12/19 16:56:22 couet
-* - Bug fixed in RMS calculation. When IDOPT STAT is on the RMS calculation
-* was wrong one some machines because it was done using REAL and DOUBLE
-* PRECISION numbers. Now we use on ly DOUBLE PRECISION numbers.
-*
-* Revision 1.1.1.1 1996/01/16 17:07:35 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.20/08 10/09/93 09.20.50 by Rene Brun
-*-- Author :
- SUBROUTINE HF1N(ID1,X,W,N)
-*.==========>
-*. Fill 1-Dim histogram with N values
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
-#include "hbook/hcflag.inc"
-#include "hbook/hcbits.inc"
-#include "hbook/hcprin.inc"
- DOUBLE PRECISION SWX(2),DBLX,DBLZ
- DIMENSION X(1),W(1)
- SAVE XMIN,XMAX,NCHAN,BWID1
-*.___________________________________________
-*
-#include "hbook/jbyt.inc"
- IF(ID1.NE.IDLAST)THEN
- ID=ID1
- IDPOS=LOCATI(IQ(LTAB+1),IQ(LCDIR+KNRH),ID)
- IF(IDPOS.LE.0)RETURN
- IDLAST=ID1
- LCID=LQ(LTAB-IDPOS)
- LCONT=LQ(LCID-1)
- LPRX=LCID+KNCX
- I5=JBIT(IQ(LCID+KBITS),5)
- I6=JBIT(IQ(LCID+KBITS),6)
- I7=JBIT(IQ(LCID+KBITS),7)
- XMIN=Q(LPRX+1)
- XMAX=Q(LPRX+2)
- NCHAN=IQ(LPRX)
- BWID1=FLOAT(NCHAN)/(XMAX-XMIN)
- ENDIF
-*
- IF(I5.NE.0)THEN
- DO 10 I=1,N
- CALL HF1(ID1,X(I),W(I))
- 10 CONTINUE
- RETURN
- ENDIF
- IQ(LCONT+KNOENT)=IQ(LCONT+KNOENT)+N
- NBPROX=IQ(LCONT+KNBIT)
- DO 30 I=1,N
- IF(X(I).LT.XMIN)THEN
- ICHAN=0
- ELSEIF(.NOT.(X(I).LT.XMAX))THEN
- ICHAN=NCHAN+1
- ELSE
- IF(I6.EQ.0)THEN
- ICHAN=(X(I)-XMIN)*BWID1 + 1
- ELSE
- LBINS=LQ(LCID-2)
- ICHAN=1
- 20 IF(.NOT.(X(I).LT.Q(LBINS+ICHAN+1)))THEN
- ICHAN=ICHAN+1
- GO TO 20
- ENDIF
- ENDIF
- ENDIF
-*
- IF(NBPROX.GE.32)THEN
- Q(LCONT+ICHAN+KCON1)=Q(LCONT+ICHAN+KCON1)+W(I)
- ELSE
- NB=32/NBPROX
- LWORD=ICHAN/NB
- LBIT=(ICHAN-NB*LWORD)*NBPROX+1
- INC=JBYT(IQ(LCONT+LWORD+KCON1),LBIT,NBPROX)
- INC=INC+W(I)+0.5
- IF(INC.GT.MAXBIT(NBPROX))INC=MAXBIT(NBPROX)
- CALL SBYT(INC,IQ(LCONT+LWORD+KCON1),LBIT,NBPROX)
- ENDIF
-*
-* ERRORS
-*
- IF(LQ(LCONT).NE.0)THEN
- IF(ICHAN.GT.0.AND.ICHAN.LE.NCHAN)THEN
- LW=LQ(LCONT)
- Q(LW+ICHAN)=Q(LW+ICHAN)+W(I)*W(I)
- ENDIF
- ENDIF
-*
-* STATISTICS
-*
- IF(I7.NE.0)THEN
- IF(ICHAN.GT.0.AND.ICHAN.LE.NCHAN)THEN
- Z=ABS(W(I))
- Q(LCONT+KSTAT1)=Q(LCONT+KSTAT1)+Z
- Q(LCONT+KSTAT1+1)=Q(LCONT+KSTAT1+1)+Z*Z
- CALL UCOPY(Q(LCONT+KSTAT1+2),SWX,4)
- DBLX=X(I)
- DBLZ=Z
- SWX(1)=SWX(1)+DBLZ*DBLX
- SWX(2)=SWX(2)+DBLZ*DBLX*DBLX
- CALL UCOPY(SWX,Q(LCONT+KSTAT1+2),4)
- ENDIF
- ENDIF
- 30 CONTINUE
- END
diff --git a/src/packlib/hbook/code/hf2.F b/src/packlib/hbook/code/hf2.F
deleted file mode 100644
index c619104..0000000
--- a/src/packlib/hbook/code/hf2.F
+++ /dev/null
@@ -1,77 +0,0 @@
-*
-* $Id: hf2.F,v 1.1.1.1 1996/01/16 17:07:36 mclareni Exp $
-*
-* $Log: hf2.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:36 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.22/09 25/07/94 16.36.31 by Rene Brun
-*-- Author :
- SUBROUTINE HF2(ID1,X,Y,W)
-*.==========>
-*. FAST FILLING ENTRY FOR A 2-DIM HISTOGRAM
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
-#include "hbook/hcflag.inc"
-#include "hbook/hcprin.inc"
-*.___________________________________________
-#include "hbook/jbyt.inc"
- IF(ID1.NE.IDLAST)THEN
- ID=ID1
- IDPOS=LOCATI(IQ(LTAB+1),IQ(LCDIR+KNRH),ID)
- IF(IDPOS.LE.0)RETURN
- IDLAST=ID1
- LCID=LQ(LTAB-IDPOS)
- LCONT=LQ(LCID-1)
- ENDIF
-*
- IQ(LCONT+KNOENT)=IQ(LCONT+KNOENT)+1
- IF(X.LT.Q(LCID+KXMIN))THEN
- I=0
- ELSEIF(.NOT.(X.LT.Q(LCID+KXMAX)))THEN
- I=IQ(LCID+KNCX)+1
- ELSE
- I=(X-Q(LCID+KXMIN))*FLOAT(IQ(LCID+KNCX))/
- + (Q(LCID+KXMAX)-Q(LCID+KXMIN)) + 1
- ENDIF
-*
- IF(Y.LT.Q(LCID+KYMIN))THEN
- J=0
- ELSEIF(.NOT.(Y.LT.Q(LCID+KYMAX)))THEN
- J=IQ(LCID+KNCY)+1
- ELSE
- J=(Y-Q(LCID+KYMIN))*FLOAT(IQ(LCID+KNCY))/
- + (Q(LCID+KYMAX)-Q(LCID+KYMIN)) + 1
- ENDIF
-*
- ICHAN=(IQ(LCID+KNCY)-J+1)*(IQ(LCID+KNCX)+2)+I
-*
-* Errors
-*
- LW=LQ(LCONT)
- IF(LW.NE.0)THEN
- IF(I.GT.0.AND.I.LE.IQ(LCID+KNCX).AND.J.GT.0.AND.
- + J.LE.IQ(LCID+KNCY))THEN
- K=IQ(LCID+KNCX)*(J-1)+I
- Q(LW+K)=Q(LW+K)+W*W
- ENDIF
- ENDIF
-*
-* Contents
-*
- IF(IQ(LCONT+KNBIT).LT.32)THEN
- NBSCAT=IQ(LCONT+KNBIT)
- NB=32/NBSCAT
- LWORD=ICHAN/NB
- LBIT=(NB-1-MOD(ICHAN,NB))*NBSCAT + 1
- IAD=LWORD+LCONT+KCON2
- INC=JBYT(IQ(IAD),LBIT,NBSCAT)+W+0.5
- IF(INC.GT.MAXBIT(NBSCAT))INC=MAXBIT(NBSCAT)
- CALL SBYT(INC,IQ(IAD),LBIT,NBSCAT)
- ELSE
- LWORD=LCONT+ICHAN+KCON2
- Q(LWORD)=Q(LWORD)+W
- ENDIF
- END
diff --git a/src/packlib/hbook/code/hfact.F b/src/packlib/hbook/code/hfact.F
deleted file mode 100644
index 648657e..0000000
--- a/src/packlib/hbook/code/hfact.F
+++ /dev/null
@@ -1,52 +0,0 @@
-*
-* $Id: hfact.F,v 1.1.1.1 1996/01/16 17:07:36 mclareni Exp $
-*
-* $Log: hfact.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:36 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.10/05 22/05/89 16.23.19 by Rene Brun
-*-- Author :
- SUBROUTINE HFACT(A,N,ISIGNE,IEXP1,IEXP2,FACT)
-*.==========>
-*. THIS ROUTINE CHANGES ARRAY A SUCH THAT MAXIMUM OF A
-*. IS .LT. 10000. OR .GE. 0.001 . FACT IS THE MULTIPLYING
-*. FACTOR
-*. EX. IF FACT = 10**-3 ISIGNE=1H- ,IEXP1=1H ,IEXP2=1H3
-*..=========> ( R.Brun )
- DIMENSION A(N),IB(2)
- SAVE IDGT,IDGTN
- DATA IDGT /1H /
- DATA IDGTN/1H-/
-*.___________________________________________
- ISIGNE=IDGT
- IEXP1=IDGT
- IEXP2=IDGT
- FACT=1.
- XMAX=VMAX(A,N)
- XMIN=VMIN(A,N)
- IF(ABS(XMAX).LT.ABS(XMIN))XMAX=XMIN
- XMAX=ABS(XMAX)
- IF(XMAX.EQ.0.)RETURN
-*
- 10 IF(XMAX.LT.10000.)GO TO 20
- ISIGNE=IDGTN
- FACT=FACT*10.
- XMAX=XMAX/10.
- GO TO 10
- 20 IF(XMAX.GE.1.)GO TO 30
- FACT=FACT*10.
- XMAX=XMAX*10.
- GO TO 20
- 30 IF(FACT.EQ.1.)RETURN
-*
- I=LOG10(FACT)+0.0001
- CALL HBCDI(I,2,IB)
- IEXP1=IB(1)
- IEXP2=IB(2)
- IF(ISIGNE.EQ.IDGTN)FACT=1./FACT
- DO 40 I=1,N
- 40 A(I)=A(I)*FACT
- END
diff --git a/src/packlib/hbook/code/hfc1.F b/src/packlib/hbook/code/hfc1.F
deleted file mode 100644
index 9d150f9..0000000
--- a/src/packlib/hbook/code/hfc1.F
+++ /dev/null
@@ -1,269 +0,0 @@
-*
-* $Id: hfc1.F,v 1.3 2001/10/10 08:12:07 couet Exp $
-*
-* $Log: hfc1.F,v $
-* Revision 1.3 2001/10/10 08:12:07 couet
-* - Do not call MZFORM any more. MZFORM for alphanumeric labels date banks
-* is now called at initialisation time (HLIMIT or HLIMAP).
-*
-* Revision 1.2 1998/12/02 09:05:19 couet
-* - clean up
-*
-* Revision 1.1.1.1 1996/01/16 17:07:36 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.22/11 23/08/94 14.17.45 by Rene Brun
-*-- Author : P.Aubert 18/11/92
- SUBROUTINE HFC1(ID1,IPOS,CHX,W,CHOPT)
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-C HFC1
-C ID1 : Histogram identifier
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-C CHX : Channel
-C W :
-C CHOPT : Options 'N' Normal filling
-C 'S' or default automatically Sort
-C 'U' UNDEFLOW IF 'U' IS SET AND THE CHANNEL DOESN T
-C EXIST THEN THE UNDERFLOW CHANNEL IS INCREMENTED
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-#include "hbook/hcbook.inc"
-#include "hbook/hcflag.inc"
-#include "hbook/hcbits.inc"
-#include "hbook/hcprin.inc"
-#include "hbook/hcform.inc"
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-C PARAMETER
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
- INTEGER KLGRCX,KBLAB,KNCHX
- PARAMETER(KLGRCX=16,KBLAB=7,KNCHX=2)
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-C COMMON
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
- INTEGER LCHX,NCHX
- EQUIVALENCE(LCHX ,LHDUM(1))
- INTEGER LOCATI
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
- INTEGER HLCCMP,LENOCC
- LOGICAL HLABEQ
- REAL HCX
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
- INTEGER ID1,IPOS,JBIT,NBPROX,IKNOENT
- CHARACTER*(*) CHX
- REAL W
- CHARACTER*(*) CHOPT
-C ----------------------------------------------------------------------
- INTEGER NCCHX,ICHAN,IDPOS,IOPT(3),LEFT,RIGHT,MEDIAN,CMP,I,J,
- + L1,L2,LW,IOCC
- REAL Z,SWX(2)
- CHARACTER*16 CHANNELX
- LOGICAL EXIST
-C ----------------------------------------------------------------------
-C Init value
-C ----------------------------------------------------------------------
- IF(ID1.NE.IDLAST)THEN
- ID = ID1
- IDPOS = LOCATI(IQ(LTAB+1),IQ(LCDIR+KNRH),ID)
- IF(IDPOS.LE.0)RETURN
- IDLAST = ID1
- LCID = LQ(LTAB-IDPOS)
- LCONT = LQ(LCID-1)
- ENDIF
- IKNOENT= IQ(LCONT+KNOENT)
-C -- options ???
- CALL UOPTC(CHOPT,'NSU',IOPT)
-C ----------------------------------------------------------------------
-C IF THE BANK CHX DOESN T EXIST
-C ----------------------------------------------------------------------
- IF(.NOT.HLABEQ(ID,' '))THEN
-C -- add link
- NBLINK=IQ(LCID-2)
- CALL MZPUSH(IHDIV,LCID,8-NBLINK,0,' ')
-C -- create LCHX : WARNING NO PACKING IODES=IOCF1
- CALL MZBOOK(IHDIV,LCHX,LCID,-8,'HLCX',0,0,KBLAB,IOCC,0)
-C -- first word is the number of character in each label
- IQ(LCHX+1)=KLGRCX
-C -- second word is the number of channel ( we don t count
-C underflow )
- IQ(LCHX+2)=0
-C -- initialise channel 0 : by default underflow
- CALL UCTOH('UNDERFLOW ',IQ(LCHX+3),4,KLGRCX)
- Q(LCONT+KCON1)=0.0
-C -- describe id dim
- CALL SBIT0(IQ(LCHX),17)
- CALL SBIT0(IQ(LCHX),18)
-C -- update binwidth xmin and xmax
- Q(LCID+KXMIN) = 1.0
- Q(LCID+KXMAX) = 2.0
- IQ(LCID+KNCX) = 1
- ENDIF
- LCHX = LQ(LCID-8)
- NBPROX = IQ(LCONT+KNBIT)
- NB = 32/NBPROX
- NCHX = IQ(LCHX+KNCHX)
-C ----------------------------------------------------------------------
-C Find channel
-C ----------------------------------------------------------------------
- IF(IPOS.NE.0)THEN
- EXIST = .TRUE.
- ICHAN = IPOS
- IF((IPOS.GT.NCHX).OR.(IPOS.LT.0))THEN
- CALL HBUG('IPOS out of range','HFC1',ID1)
- RETURN
- ENDIF
- ELSE
-C 2/ be care of length must be equal KLGRCX
- CHANNELX(1:KLGRCX) = ' '
- NCCHX = LENOCC(CHX)
- IF(NCCHX.GT.KLGRCX) THEN
- NCCHX=KLGRCX
- ENDIF
- CHANNELX(1:NCCHX) = CHX(1:NCCHX)
-C 3/ does the channel exist ?
- EXIST = .FALSE.
-C 31/ linear search
- IF(IOPT(1).EQ.1)THEN
-C -- set the first status bit at 1
- CALL SBIT0(IQ(LCHX),1)
- IF(NCHX.GE.1)THEN
- ICHAN=0
- 10 ICHAN=ICHAN+1
- IF(HLCCMP(IQ(LCHX+KBLAB+(ICHAN-1)*4),
- + CHANNELX,KLGRCX).EQ.0)THEN
- EXIST = .TRUE.
- ENDIF
-C
- IF((ICHAN.LT.NCHX).AND.(.NOT.(EXIST))) GO TO 10
- ENDIF
-C -- pour verifier l invariant de boucle
- IF(.NOT.EXIST)THEN
- ICHAN = NCHX + 1
- ENDIF
- ELSE
-C 32/ binary search
-C -- set the first status bit at 0
- CALL SBIT1(IQ(LCHX),1)
- LEFT = 1
- RIGHT = NCHX
-C -- while
- 20 IF((LEFT.LE.RIGHT).AND.(.NOT.EXIST))THEN
- MEDIAN = ( LEFT + RIGHT ) /2
- CMP = HLCCMP(IQ(LCHX+KBLAB+(MEDIAN-1)*4),
- + CHANNELX,KLGRCX)
- IF(CMP.LT.0)THEN
- LEFT = MEDIAN+1
- ELSE IF(CMP.EQ.0)THEN
- EXIST = .TRUE.
- ICHAN = MEDIAN
- ELSE
- RIGHT = MEDIAN-1
- ENDIF
- GO TO 20
- ENDIF
- IF(.NOT.EXIST)THEN
- ICHAN = LEFT
- ENDIF
- ENDIF
- ENDIF
-C ----------------------------------------------------------------------
-C IF 'U' IS SET
-C ----------------------------------------------------------------------
- IF(IOPT(3).EQ.1)THEN
- IF(.NOT.EXIST)THEN
- ICHAN = 0
- EXIST = .TRUE.
- ENDIF
- ENDIF
-C ----------------------------------------------------------------------
-C Compute the new value if channel exist else create it
-C ----------------------------------------------------------------------
- IF(.NOT.EXIST)THEN
- NCHX = NCHX+1
- IQ(LCHX+KNCHX) = NCHX
- IQ(LCID+KNCX) = NCHX
- Q(LCID+KXMAX) = FLOAT(NCHX)+1.0
-C NEED MORE SPACE ?
- IF(((IQ(LCHX-1)-1)/4).LE.NCHX)THEN
-C ALLOCATION IN BANK 'LCONT' AND 'LCHX'
-C TRY WITH 100 NEW CHANNEL
- L1 = 100 / NB
- L2 = 400 / NB
- CALL HSPACE(L1+L2,'HFC1',ID)
- IF(IERR.EQ.0)THEN
- CALL MZPUSH(IHDIV,LCONT,0,L1,' ')
- CALL MZPUSH(IHDIV,LCHX ,0,L2,' ')
- ELSE
-C TRY WITH 1
- L1 = 1 / NB
- L2 = 4 / NB
- CALL HSPACE(L1+L2,'HFC1',ID)
- IF(IERR.EQ.0)THEN
- CALL MZPUSH(IHDIV,LCONT,0,L1,' ')
- CALL MZPUSH(IHDIV,LCHX ,0,L2,' ')
- ELSE
- CALL HBUG('Not enough space in memory','HFC1',ID)
- RETURN
- ENDIF
- ENDIF
- ENDIF
-C -- ICHAN = numero du canal a inserer
-C -- NCHX a deja la taille du nouveau tableau
- IF(ICHAN.NE.NCHX)THEN
-C -- shift label ( newer packed )
- DO 100 I=NCHX,ICHAN+1,-1
- DO 110 J=1,4
- IQ(LCHX+KBLAB+4*(I-1)+J-1)=IQ(LCHX+KBLAB+4*(I-2)+J-1)
- 110 CONTINUE
- 100 CONTINUE
-C HORRIBLE HACK see hcx.f
- NB = NBPROX
-C -- shift cont
- DO 130 I=NCHX,ICHAN+1,-1
- CALL HFCX(I,HCX(I-1,1))
- 130 CONTINUE
- ENDIF
- CALL UCTOH(CHANNELX,IQ(LCHX+KBLAB+4*(ICHAN-1)),4,KLGRCX)
-C -- ADD AN ENTRY
- ENDIF
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-C -- Value W
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
- IF(EXIST)THEN
-C HORRIBLE HACK see hcx.f
- NB = NBPROX
- CALL HFCX(ICHAN,HCX(ICHAN,1)+W)
- ELSE
- CALL HFCX(ICHAN,W)
- ENDIF
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-C -- ERROR
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
- IF(LQ(LCONT).NE.0)THEN
- IF(ICHAN.GT.0.AND.ICHAN.LE.IQ(LPRX))THEN
- LW=LQ(LCONT)
- Q(LW+ICHAN)=Q(LW+ICHAN)+W*W
- ENDIF
- ENDIF
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-C -- STATISTIQUES
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
- I7 = JBIT(IQ(LCID+KBITS),7)
- IF(I7.NE.0)THEN
- IF(ICHAN.GT.0.AND.ICHAN.LE.IQ(LPRX))THEN
- Z=ABS(W)
- Q(LCONT+KSTAT1)=Q(LCONT+KSTAT1)+Z
- Q(LCONT+KSTAT1+1)=Q(LCONT+KSTAT1+1)+Z*Z
- CALL UCOPY(Q(LCONT+KSTAT1+2),SWX,4)
-C SWX(1)=SWX(1)+Z*X
-C SWX(2)=SWX(2)+Z*X*X
- CALL UCOPY(SWX,Q(LCONT+KSTAT1+2),4)
- ENDIF
- ENDIF
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-C -- ADD ONE ENTRY
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
- IQ(LCONT+KNOENT) = IKNOENT + 1
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
- RETURN
- END
diff --git a/src/packlib/hbook/code/hfc2.F b/src/packlib/hbook/code/hfc2.F
deleted file mode 100644
index 2f7d3b2..0000000
--- a/src/packlib/hbook/code/hfc2.F
+++ /dev/null
@@ -1,134 +0,0 @@
-*
-* $Id: hfc2.F,v 1.1.1.1 1996/01/16 17:07:36 mclareni Exp $
-*
-* $Log: hfc2.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:36 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.22/11 23/08/94 14.17.45 by Rene Brun
-*-- Author : P.Aubert 18/11/92
- SUBROUTINE HFC2(ID1,IPOS,CHX,JPOS,CHY,W,CHOPT)
-C **********************************************************************
-C HFC2
-C **********************************************************************
-C ID1 : Histogram identifier
-C CHX : Channel X
-C CHY : Channel Y
-C W : Weight
-C CHOPT : Options 'N' Normal filling
-C 'S' or default automatically Sort
-C 'U' UNDEFLOW IF 'U' IS SET AND THE CHANNEL DOESN T
-C EXIST THEN THE UNDERFLOW CHANNEL IS INCREMENTED
-C **********************************************************************
-#include "hbook/hcbook.inc"
-#include "hbook/hcflag.inc"
-#include "hbook/hcprin.inc"
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-C PARAMETER
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
- INTEGER KNCHX
- PARAMETER(KNCHX =2)
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-C COMMON
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
- INTEGER LCHX,NCHX,LCHY,NCHY
- EQUIVALENCE(LCHX ,LHDUM(1))
- EQUIVALENCE(LCHY ,LHDUM(2))
- INTEGER LOCATI
-C ----------------------------------------------------------------------
- LOGICAL HLABEQ
-C ----------------------------------------------------------------------
- INTEGER ID1,IPOS,JPOS,IIPOS,JJPOS
- CHARACTER*(*) CHX,CHY
- REAL W
- CHARACTER*(*) CHOPT
-C ----------------------------------------------------------------------
-C Init value
-C ----------------------------------------------------------------------
- IF(ID1.NE.IDLAST)THEN
- ID = ID1
- IDPOS = LOCATI(IQ(LTAB + 1),IQ(LCDIR + KNRH),ID)
- IF(IDPOS.LE.0)RETURN
- IDLAST = ID1
- LCID = LQ(LTAB - IDPOS)
- LCONT = LQ(LCID - 1)
- ENDIF
-C ----------------------------------------------------------------------
-C IF THE LABEL DON''T EXIST
-C ----------------------------------------------------------------------
- IF(.NOT.HLABEQ(ID,'X'))THEN
- IF(.NOT.HLABEQ(ID,'Y'))THEN
- CALL HBUG('No labels : CALL HLABEL first','HFC2',ID)
- RETURN
- ENDIF
- ENDIF
-C ----------------------------------------------------------------------
-C FIND IPOS AND JPOS
-C ----------------------------------------------------------------------
- IIPOS = IPOS
- JJPOS = JPOS
- IF(IIPOS.EQ.0)THEN
- IF(.NOT.HLABEQ(ID,'X'))THEN
- CALL HBUG('Could not reference bin on axis X','HFC2',ID)
- CALL HBUG('No labels : CALL HLABEL first on axis X',
- + 'HFC2',ID)
- RETURN
- ENDIF
- CALL HLPOS(ID,CHX,IIPOS,'X')
- ENDIF
- IF(JJPOS.EQ.0)THEN
- IF(.NOT.HLABEQ(ID,'Y'))THEN
- CALL HBUG('Could not reference bin on axis Y','HFC2',ID)
- CALL HBUG('No labels : CALL HLABEL first on axis Y',
- + 'HFC2',ID)
- RETURN
- ENDIF
- CALL HLPOS(ID,CHY,JJPOS,'Y')
- ENDIF
-C ----------------------------------------------------------------------
-C LIMITS PROBLEMS ? GO TO OVERFLOW BAD
-C We use the underflow channel if the position IIPOS or JJPOS is out of
-C limit
-C ----------------------------------------------------------------------
- IF(HLABEQ(ID,'X'))THEN
- LCHX = LQ(LCID - 8)
- NCHX = IQ(LCHX + KNCHX)
- ELSE
- NCHX = IQ( LCID + KNCX )
- ENDIF
- IF(HLABEQ(ID,'Y'))THEN
- LCHY = LQ(LCID - 9)
- NCHY = IQ(LCHY + KNCHX)
- ELSE
- NCHY = IQ( LCID + KNCY )
- ENDIF
- IF((IIPOS.GT.NCHX).OR.(IIPOS.LT.0))THEN
- IIPOS = 0
- ENDIF
- IF((JJPOS.GT.NCHY).OR.(JJPOS.LT.0))THEN
- JJPOS = 0
- ENDIF
-C ----------------------------------------------------------------------
-C STORE THE VALUE
-C ----------------------------------------------------------------------
- IQ(LCONT + KNOENT) = IQ(LCONT + KNOENT)+1
- ICHAN = (IQ(LCID + KNCY) - JJPOS + 1)*(IQ(LCID + KNCX) + 2) +
- + IIPOS
- IF(IQ(LCONT + KNBIT).LT.32)THEN
- NBSCAT = IQ(LCONT + KNBIT)
- NB = 32/NBSCAT
- LWORD = ICHAN/NB
- LBIT = (NB - 1 - MOD(ICHAN,NB))*NBSCAT + 1
- IAD = LWORD + LCONT + KCON2
- INC = JBYT(IQ(IAD),LBIT,NBSCAT) + W + 0.5
- IF(INC.GT.MAXBIT(NBSCAT))INC = MAXBIT(NBSCAT)
- CALL SBYT(INC,IQ(IAD),LBIT,NBSCAT)
- ELSE
- LWORD = LCONT + ICHAN + KCON2
- Q(LWORD) = Q(LWORD) + W
- ENDIF
-C ----------------------------------------------------------------------
- RETURN
- END
diff --git a/src/packlib/hbook/code/hfcn.F b/src/packlib/hbook/code/hfcn.F
deleted file mode 100644
index f8fa425..0000000
--- a/src/packlib/hbook/code/hfcn.F
+++ /dev/null
@@ -1,156 +0,0 @@
-*
-* $Id: hfcn.F,v 1.3 1997/09/02 13:09:02 mclareni Exp $
-*
-* $Log: hfcn.F,v $
-* Revision 1.3 1997/09/02 13:09:02 mclareni
-* WINNT correction
-*
-* Revision 1.2 1997/03/14 17:04:22 mclareni
-* WNT mods
-*
-* Revision 1.1.1.1.2.1 1997/01/21 11:27:58 mclareni
-* All mods for Winnt 96a on winnt branch
-*
-* Revision 1.1.1.1 1996/01/16 17:07:36 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.22/11 23/08/94 14.17.45 by Rene Brun
-*-- Author :
- SUBROUTINE HFCN (NPAR,GRAD,F,U,IFLAG,UFCN)
-*.==========>
-*. COMPUTES CHI2 OF FIT INTO F
-*. IF USERS' FORCE, COMPUTE GRADIENT
-*..=========> ( E.Lessner,D.Lienart )
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION UFCN,F,FU,GRAD,U,DQ,FUSUM,FSUM
-#endif
- DIMENSION EXDA(20),DQ(2),GRAD(*),U(*)
-#include "hbook/hcfit2.inc"
-#include "hbook/hcfit3.inc"
-#include "hbook/hcfit6.inc"
-#include "hbook/hcflag.inc"
-#include "hbook/hcbook.inc"
- EQUIVALENCE (Q(1),DQ(1))
- EXTERNAL UFCN
- LOGICAL UGIN
- DATA NAMPO,NAMGA,NAMEX/2HPO,2HGA,2HEX/
-*.___________________________________________
-#if !defined(CERNLIB_DOUBLE)
- CALL UCOPY(U,XVAR(IOFSET+1),NUP)
-#endif
-#if defined(CERNLIB_DOUBLE)
- CALL UCOPY(U,XVAR(IOFSET+1),2*NUP)
-#endif
- UGIN=.FALSE.
- IF (NAMFUN.NE.NAMPO.OR.NAMFUN.NE.NAMGA.OR.NAMFUN.NE.NAMEX)
- + UGIN=.TRUE.
-*
- NPFIT=0
- F=0.
-*
-* INITIALIZE THE SUMS:
- CUSUM=0.
- EUSUM=0.
- FUSUM=0.
-*
- IF (IFLAG.EQ.2) THEN
- DO 3 I=1,NUP
- GRAD(I)=0.
- DQ(IDESUM+I-1)=0.
- 3 CONTINUE
- ENDIF
-*
- IF (IHIS.EQ.1) THEN
- DO 30 L1=1,NUMEP
- CALL HEXDA1 (EXDA,L1,IFLRET)
- DO 10 I=1,IDIMPN-2
- XVAR(I)=EXDA(I+2)
- 10 CONTINUE
- CU=EXDA(1)
- EU=EXDA(2)
- IF(EU.LE.0.)GO TO 30
- IF (IDIMPN.EQ.4.AND.IFLSF.EQ.0) THEN
- FU=UFCN(XVAR(1),XVAR(2))
- IF (IFLAG.EQ.2)THEN
- CALL HDERI2(ID,XVAR(1),XVAR(2),U,DQ(IDERIV))
- ENDIF
- ELSE
-#if defined(CERNLIB_MACMPW) || defined(CERNLIB_MSSTDCALL)
- FU=UFCN(XVAR,0.)
-#else
- FU=UFCN(XVAR)
-#endif
- IF (IFLAG.EQ.2) THEN
- IF (UGIN) CALL HDERI1(ID,XVAR,U,DQ(IDERIV))
- ENDIF
- END IF
- IF (IFLAG.EQ.2) THEN
- DO 15 K=1,NUP
- DQ(IDESUM+K-1)=DQ(IDESUM+K-1)+DQ(IDERIV+K-1)
- 15 CONTINUE
- ENDIF
- EU=EU*EU
- FUSUM=FUSUM+FU
- CUSUM=CUSUM+CU
- EUSUM=EUSUM+EU
- TEST=CUSUM*CUSUM/EUSUM
- IF (L1.EQ.NUMEP.OR.IWEIGH.NE.0.OR.TEST.GE.0.) THEN
- NPFIT=NPFIT+1
- IF (IFLAG.EQ.2) THEN
- DO 20 K=1,NUP
- GRAD(K)=GRAD(K)+2*DQ(IDESUM+K-1)*(FUSUM-CUSUM)/
- + EUSUM
- DQ(IDESUM+K-1)=0.
- 20 CONTINUE
- ENDIF
- FSUM=(CUSUM-FUSUM)**2/EUSUM
- F=F+FSUM
- CUSUM=0.
- EUSUM=0.
- FUSUM=0.
- ENDIF
- 30 CONTINUE
- ELSE
- DO 60 L1=1,NUMEP
- CU=Q(ILYE+L1-1)
- DO 40 I=1,NX
- XVAR(I)=Q(ILXE+L1-1+NUMEP*(I-1))
- 40 CONTINUE
- EU=Q(ILEY+L1-1)
- IF(EU.LE.0.)GO TO 60
-#if defined(CERNLIB_MACMPW) || defined(CERNLIB_MSSTDCALL)
- FU=UFCN(XVAR,0.)
-#else
- FU=UFCN(XVAR)
-#endif
- IF (IFLAG.EQ.2) THEN
- CALL HDERIN(XVAR,U,DQ(IDERIV))
- DO 45 K=1,NUP
- DQ(IDESUM+K-1)=DQ(IDESUM+K-1)+DQ(IDERIV+K-1)
- 45 CONTINUE
- ENDIF
- EU=EU*EU
- FUSUM=FUSUM+FU
- CUSUM=CUSUM+CU
- EUSUM=EUSUM+EU
- TEST=CUSUM*CUSUM/EUSUM
- IF (L1.EQ.NUMEP.OR.IWEIGH.NE.0.OR.TEST.GE.0.) THEN
- NPFIT=NPFIT+1
- IF (IFLAG.EQ.2) THEN
- DO 50 K=1,NUP
- GRAD(K)=GRAD(K)+2*DQ(IDESUM+K-1)*(FUSUM-CUSUM)/
- + EUSUM
- DQ(IDESUM+K-1)=0.
- 50 CONTINUE
- ENDIF
- FSUM=(CUSUM-FUSUM)**2/EUSUM
- F=F+FSUM
- CUSUM=0.
- EUSUM=0.
- FUSUM=0.
- ENDIF
- 60 CONTINUE
- ENDIF
- END
diff --git a/src/packlib/hbook/code/hfcnh.F b/src/packlib/hbook/code/hfcnh.F
deleted file mode 100644
index 5919b39..0000000
--- a/src/packlib/hbook/code/hfcnh.F
+++ /dev/null
@@ -1,158 +0,0 @@
-*
-* $Id: hfcnh.F,v 1.3 1997/09/02 13:09:02 mclareni Exp $
-*
-* $Log: hfcnh.F,v $
-* Revision 1.3 1997/09/02 13:09:02 mclareni
-* WINNT correction
-*
-* Revision 1.2 1997/03/14 17:04:23 mclareni
-* WNT mods
-*
-* Revision 1.1.1.1.2.1 1997/01/21 11:27:59 mclareni
-* All mods for Winnt 96a on winnt branch
-*
-* Revision 1.1.1.1 1996/01/16 17:07:36 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.22/11 23/08/94 14.17.45 by Rene Brun
-*-- Author :
- SUBROUTINE HFCNH (NPAR,GRAD,F,UD,IFLAG,UFCN)
-*.==========>
-*. Computes Minuit function (histogram case)
-*..=========> ( R.Brun, E.Lessner )
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION F,GRAD,UD
- DOUBLE PRECISION CUSUM,EUSUM,FUSUM,DERSUM
- DOUBLE PRECISION CU,EU,FU,FSUM,FSUB,FOBS,DSUB
-#endif
- DIMENSION DERSUM(35),EXDA(5),XV(2),GRAD(*),UD(*)
-#include "hbook/hcfit2.inc"
-#include "hbook/hcfits.inc"
-#include "hbook/hcfit6.inc"
-#include "hbook/hcfitd.inc"
- EXTERNAL UFCN
-*.___________________________________________
-*
- NPFITS=0
- F=0.
- DO 10 I=1,NFPAR
- FITPAR(IOFSET+I)=UD(I)
- FITPAD(I)=UD(I)
- 10 CONTINUE
- IF (IFLAG.EQ.2) THEN
- DO 20 I=1,NFPAR
- GRAD(I)=0.
- DERSUM(I)=0.
- 20 CONTINUE
- ENDIF
-*
-*=======> Chisquare fit
-*
- IF(LINEAR.NE.0)GO TO 100
- CUSUM=0.
- EUSUM=0.
- FUSUM=0.
- DO 60 L1=1,NUMEP
- CALL HFITH1 (EXDA,L1)
- DO 30 I=1,IDIMPN-2
- XV(I)=EXDA(I+2)
- 30 CONTINUE
- CU=EXDA(1)
- EU=EXDA(2)
- IF(EU.LE.0.)GO TO 60
- IF(IDIMPN.EQ.3)THEN
-#if defined(CERNLIB_MACMPW) || defined(CERNLIB_MSSTDCALL)
- FU=UFCN(XV,0.)
-#else
- FU=UFCN(XV)
-#endif
- ELSE
- FU=UFCN(XV(1),XV(2))
- ENDIF
- IF(IFLFUN.NE.0)THEN
- FU=FITFUN
- ENDIF
- IF (IFLAG.EQ.2) THEN
- DO 40 K=1,NFPAR
- DERSUM(K)=DERSUM(K)+FITDER(K)
- 40 CONTINUE
- ENDIF
- EU=EU*EU
- FUSUM=FUSUM+FU
- CUSUM=CUSUM+CU
- EUSUM=EUSUM+EU
- TEST=CUSUM*CUSUM/EUSUM
- IF (L1.EQ.NUMEP.OR.IWEIGH.NE.0.OR.TEST.GE.0.) THEN
- NPFITS=NPFITS+1
- IF (IFLAG.EQ.2) THEN
- DO 50 K=1,NFPAR
- GRAD(K)=GRAD(K)+2*DERSUM(K)*(FUSUM-CUSUM)/EUSUM
- DERSUM(K)=0.
- 50 CONTINUE
- ENDIF
- FSUM=(CUSUM-FUSUM)**2/EUSUM
- F=F+FSUM
- CUSUM=0.
- EUSUM=0.
- FUSUM=0.
- ENDIF
- 60 CONTINUE
- RETURN
-*
-*=======> Log-Likelihood fit
-* Basically, it forms the likelihood by determining the Poisson
-* probability that given a number of entries in a particualar bin,
-* the fit would predict it's value. This is then done for each bin,
-* and the sum of the logs is taken as the likelihood.
-*
- 100 CONTINUE
- DO 160 L1=1,NUMEP
- CALL HFITH1 (EXDA,L1)
- DO 130 I=1,IDIMPN-2
- XV(I)=EXDA(I+2)
- 130 CONTINUE
- ICU=EXDA(1)
- EU=EXDA(2)
- IF(IWEIGH.NE.0)THEN
- IF(EU.LE.0.)GO TO 160
- ENDIF
- IF(IDIMPN.EQ.3)THEN
-#if defined(CERNLIB_MACMPW) || defined(CERNLIB_MSSTDCALL)
- FU=UFCN(XV,0.)
-#else
- FU=UFCN(XV)
-#endif
- ELSE
- FU=UFCN(XV(1),XV(2))
- ENDIF
- IF(IFLFUN.NE.0)THEN
- FU=FITFUN
- ENDIF
- IF (FU.LT.1.E-9) FU=1.E-9
- FSUB=-FU+ICU*LOG(FU)
- FOBS= 0.0
- IF (ICU.GT.1) THEN
- DO 135 J=1,ICU
- FOBS=FOBS+LOG(FLOAT(J))
- 135 CONTINUE
- ENDIF
- FSUB=FSUB-FOBS
- F=F-FSUB
- NPFITS=NPFITS+1
- IF (IFLAG.EQ.2) THEN
- DO 150 K=1,NFPAR
- DSUB=ICU*FITDER(K)/FU - FITDER(K)
- GRAD(K)=GRAD(K)-DSUB
- 150 CONTINUE
- ENDIF
- 160 CONTINUE
- F=2.*F
- IF (IFLAG.EQ.2) THEN
- DO 170 I=1,NFPAR
- GRAD(I)=2.*GRAD(I)
- 170 CONTINUE
- ENDIF
-*
- END
diff --git a/src/packlib/hbook/code/hfcnv.F b/src/packlib/hbook/code/hfcnv.F
deleted file mode 100644
index 027bd48..0000000
--- a/src/packlib/hbook/code/hfcnv.F
+++ /dev/null
@@ -1,100 +0,0 @@
-*
-* $Id: hfcnv.F,v 1.1.1.1 1996/01/16 17:07:36 mclareni Exp $
-*
-* $Log: hfcnv.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:36 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.22/11 23/08/94 14.17.45 by Rene Brun
-*-- Author :
- SUBROUTINE HFCNV (NPAR,GRAD,F,UD,IFLAG,UFCN)
-*.==========>
-*. Computes Minuit function (vector case)
-*..=========> ( R.Brun, E.Lessner )
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION F,GRAD,UD
- DOUBLE PRECISION CUSUM,EUSUM,FUSUM,DERSUM
- DOUBLE PRECISION CU,EU,FU,FSUM
-#endif
- DIMENSION GRAD(*),UD(*)
-#include "hbook/hcfit2.inc"
-#include "hbook/hcfit6.inc"
-#include "hbook/hcfits.inc"
-#include "hbook/hcfitd.inc"
-#include "hbook/hcbook.inc"
- DIMENSION XV(50),DERSUM(35)
- EXTERNAL UFCN
-*.___________________________________________
-*
- NPFITS=0
- F=0.
-*
-* INITIALIZE THE SUMS:
- CUSUM=0.
- EUSUM=0.
- FUSUM=0.
-*
- DO 10 I=1,NFPAR
- FITPAR(IOFSET+I)=UD(I)
- FITPAD(I)=UD(I)
- 10 CONTINUE
- IF (IFLAG.EQ.2) THEN
- DO 20 I=1,NFPAR
- GRAD(I)=0.
- DERSUM(I)=0.
- 20 CONTINUE
- ENDIF
-*
-*====> User own fitting model (option 'FCN' given)
-*
- IF(LINEAR.NE.0)THEN
- CALL HFCNV1(NUMEP,Q(ILXE),Q(ILYE),Q(ILEY),NPAR,IFLAG,UFCN)
- F=FITFUN
- RETURN
- ENDIF
-*
-*====> Chisquare method
- DO 60 L1=1,NUMEP
- CU=Q(ILYE+L1-1)
- EU=Q(ILEY+L1-1)
- IF(EU.LE.0.)GO TO 60
- DO 30 I=1,NX
- XV(I)=Q(ILXE+L1-1+NUMEP*(I-1))
- 30 CONTINUE
-#if defined(CERNLIB_MACMPW)
- FU=UFCN(XV,0.)
-#endif
-#if !defined(CERNLIB_MACMPW)
- FU=UFCN(XV)
-#endif
- IF(IFLFUN.NE.0)THEN
- FU=FITFUN
- ENDIF
- IF (IFLAG.EQ.2) THEN
- DO 40 K=1,NFPAR
- DERSUM(K)=DERSUM(K)+FITDER(K)
- 40 CONTINUE
- ENDIF
- EU=EU*EU
- FUSUM=FUSUM+FU
- CUSUM=CUSUM+CU
- EUSUM=EUSUM+EU
- TEST=CUSUM*CUSUM/EUSUM
- IF (L1.EQ.NUMEP.OR.IWEIGH.NE.0.OR.TEST.GE.0.) THEN
- NPFITS=NPFITS+1
- IF (IFLAG.EQ.2) THEN
- DO 50 K=1,NFPAR
- GRAD(K)=GRAD(K)+2*DERSUM(K)*(FUSUM-CUSUM)/EUSUM
- DERSUM(K)=0.
- 50 CONTINUE
- ENDIF
- FSUM=(CUSUM-FUSUM)**2/EUSUM
- F=F+FSUM
- CUSUM=0.
- EUSUM=0.
- FUSUM=0.
- ENDIF
- 60 CONTINUE
- END
diff --git a/src/packlib/hbook/code/hfcnv1.F b/src/packlib/hbook/code/hfcnv1.F
deleted file mode 100644
index 597057b..0000000
--- a/src/packlib/hbook/code/hfcnv1.F
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: hfcnv1.F,v 1.1.1.1 1996/01/16 17:07:36 mclareni Exp $
-*
-* $Log: hfcnv1.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:36 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.21/09 27/02/94 15.28.56 by Rene Brun
-*-- Author : Rene Brun 27/02/94
- SUBROUTINE HFCNV1 (N,X,Y,EY,NPAR,IFLAG,UFCN)
-*.==========>
-*. Computes Minuit function (vector case with user fitting model)
-*..=========> ( R.Brun )
-#include "hbook/hcfits.inc"
- DIMENSION X(1),Y(1),EY(1)
- EXTERNAL UFCN
-*.___________________________________________
-*
- CALL UFCN(N,X,Y,EY,NPAR,IFLAG,NPFITS)
-*
- END
diff --git a/src/packlib/hbook/code/hfcx.F b/src/packlib/hbook/code/hfcx.F
deleted file mode 100644
index f3bce88..0000000
--- a/src/packlib/hbook/code/hfcx.F
+++ /dev/null
@@ -1,78 +0,0 @@
-*
-* $Id: hfcx.F,v 1.2 2000/12/19 16:56:22 couet Exp $
-*
-* $Log: hfcx.F,v $
-* Revision 1.2 2000/12/19 16:56:22 couet
-* - Bug fixed in RMS calculation. When IDOPT STAT is on the RMS calculation
-* was wrong one some machines because it was done using REAL and DOUBLE
-* PRECISION numbers. Now we use on ly DOUBLE PRECISION numbers.
-*
-* Revision 1.1.1.1 1996/01/16 17:07:36 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.22/03 24/05/94 12.55.16 by Rene Brun
-*-- Author :
- SUBROUTINE HFCX(ICX,W)
-*.==========>
-*. Fills channel number ICX with W
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
-#include "hbook/hcbits.inc"
-#include "hbook/hcprin.inc"
-#if !defined(CERNLIB_DOUBLE)
- DIMENSION SWX(4)
-#endif
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION SWX(2),DBLX,DBLZ
-#endif
-*.___________________________________________
- NB=IQ(LCONT+KNBIT)
- IF(NB.GE.32)THEN
- Q(LCONT+KCON1+ICX)=W
- ELSE
- NBB=32/NB
- L1=ICX/NBB
- L2=(ICX-NBB*L1)*NB +1
- INC=W
- IF(INC.LT.0)INC=0
- IF(INC.GT.MAXBIT(NB))INC=MAXBIT(NB)
- CALL SBYT(INC,IQ(LCONT+L1+KCON1),L2,NB)
- ENDIF
- AW=ABS(W)
- IF(W.GT.1.E6.OR.W.LT.0..OR.MOD(AW,1.).GT.1.E-5)THEN
- IQ(LCONT+KNOENT)=-1
- ELSE
- IF(IQ(LCONT+KNOENT).GE.0)THEN
- IF(IQ(LCONT+KNOENT).LT.10000000)THEN
- IQ(LCONT+KNOENT)=IQ(LCONT+KNOENT)+INT(W)
- ELSE
- IQ(LCONT+KNOENT)=-1
- ENDIF
- ENDIF
- ENDIF
-*
- IF(I7.NE.0)THEN
- IF(ICX.EQ.0)THEN
- CALL VZERO(Q(LCONT+KSTAT1),6)
- ELSEIF(ICX.LE.IQ(LPRX))THEN
- X=Q(LPRX+1)+(FLOAT(ICX-1)+0.5)*(Q(LPRX+2)-Q(LPRX+1))/
- + FLOAT(IQ(LPRX))
- Z=ABS(W)
- Q(LCONT+KSTAT1)=Q(LCONT+KSTAT1)+Z
- Q(LCONT+KSTAT1+1)=Q(LCONT+KSTAT1+1)+Z*Z
- CALL UCOPY(Q(LCONT+KSTAT1+2),SWX,4)
-#if defined(CERNLIB_DOUBLE)
- DBLX=X
- DBLZ=Z
- SWX(1)=SWX(1)+DBLZ*DBLX
- SWX(2)=SWX(2)+DBLZ*DBLX*DBLX
-#else
- SWX(1)=SWX(1)+Z*X
- SWX(2)=SWX(2)+Z*X*X
-#endif
- CALL UCOPY(SWX,Q(LCONT+KSTAT1+2),4)
- ENDIF
- ENDIF
- END
diff --git a/src/packlib/hbook/code/hfcxy.F b/src/packlib/hbook/code/hfcxy.F
deleted file mode 100644
index 3ff4a2c..0000000
--- a/src/packlib/hbook/code/hfcxy.F
+++ /dev/null
@@ -1,38 +0,0 @@
-*
-* $Id: hfcxy.F,v 1.1.1.1 1996/01/16 17:07:36 mclareni Exp $
-*
-* $Log: hfcxy.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:36 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.22/11 17/08/94 12.08.45 by Rene Brun
-*-- Author :
- SUBROUTINE HFCXY(ICX,ICY,X)
-*.==========>
-*. FILLS THE CELL DEFINED BY ICX AND ICY WITH X
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
-#include "hbook/hcprin.inc"
-*.___________________________________________
- NW=32/NB
- J=(IQ(LCID+KNCY)-ICY+1)*(IQ(LCID+KNCX)+2)
- L2=ICX+J
- L1=L2/NW +KCON2
- IF(NW.NE.1)THEN
- L2=(NW-1-MOD(L2,NW))*NB +1
- IX=X
- CALL SBYT(IX,IQ(LCONT+L1),L2,NB)
- ELSE
- Q(LCONT+L1)=X
- ENDIF
- AX=ABS(X)
- IF(AX.GT.1.E8.OR.X.LT.0..OR.MOD(AX,1.).GT.1.E-5)THEN
- IQ(LCONT+KNOENT)=-1
- ELSE
- IF(IQ(LCONT+KNOENT).GE.0)THEN
- IQ(LCONT+KNOENT)=IQ(LCONT+KNOENT)+INT(X)
- ENDIF
- ENDIF
- END
diff --git a/src/packlib/hbook/code/hfetc1.F b/src/packlib/hbook/code/hfetc1.F
deleted file mode 100644
index 01c89e5..0000000
--- a/src/packlib/hbook/code/hfetc1.F
+++ /dev/null
@@ -1,44 +0,0 @@
-*
-* $Id: hfetc1.F,v 1.1.1.1 1996/01/16 17:07:36 mclareni Exp $
-*
-* $Log: hfetc1.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:36 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.10/05 21/02/89 16.14.47 by Rene Brun
-*-- Author :
- SUBROUTINE HFETC1(NBP,NC)
-*.==========>
-*. Auxiliary for HFETCH
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
-#include "hbook/hcprin.inc"
-#include "hbook/hcflag.inc"
- DIMENSION IHCV(99)
- EQUIVALENCE (IHCV(1),HCV(1))
-*.___________________________________________
- DO 10 I=0,NC+1
- IF(NBP.EQ.NBIT)THEN
- W=HCV(IFW+I+1)
- ELSE
- L1=I*NBP
- NBITH=NBIT-MOD(NBIT,NBP)
- L2=MOD(L1,NBITH)+1
- L1=IFW+1+L1/NBITH
- W=JBYT(IHCV(L1),L2,NBP)
- ENDIF
- CALL HFCX(I,W)
- 10 CONTINUE
- IQ(LCONT+KNOENT)=IHCV(IFW)
- LW=LQ(LCONT)
- IF(LW.NE.0)THEN
- NBB=NBIT/NBP
- NW=(NC+2)/NBB+1
- DO 20 I=1,NC
- J=IFW+I+NW+1
- Q(LW+I)=HCV(J)
- 20 CONTINUE
- ENDIF
- END
diff --git a/src/packlib/hbook/code/hfetch.F b/src/packlib/hbook/code/hfetch.F
deleted file mode 100644
index 1ec54c9..0000000
--- a/src/packlib/hbook/code/hfetch.F
+++ /dev/null
@@ -1,235 +0,0 @@
-*
-* $Id: hfetch.F,v 1.1.1.1 1996/01/16 17:07:36 mclareni Exp $
-*
-* $Log: hfetch.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:36 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.10/06 11/12/90 09.47.14 by Rene Brun
-*-- Author :
- SUBROUTINE HFETCH(IDD,LUN1)
-*.==========>
-*. Reads histograms previously stored with HBOOK3 routine
-*. HSTORE.
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
-#include "hbook/hcprin.inc"
-#include "hbook/hcflag.inc"
-#include "hbook/hcbits.inc"
-#include "hbook/hcform.inc"
- CHARACTER*80 KTITL
- DIMENSION IHCV(99)
- EQUIVALENCE (IHCV(1),HCV(1))
-*.___________________________________________
- N=0
- LUN=IABS(LUN1)
- IF(LUN1.GT.0)THEN
- REWIND LUN
- ENDIF
-*
- 10 CONTINUE
- READ(LUN,END=900)ID1,NWHIST,IC
- CALL HSPACE(2*NWHIST+100,'HFETCH',IDD)
- IF(IERR.NE.0)GO TO 999
- IF(ID1.EQ.0)GO TO 900
-* This is necessary for an old NORD compiler
-#if (defined(CERNLIB_NORD))&&(defined(CERNLIB_AREAD))
- READ(LUN,END=900)IDUM,(HCV(K),K=1,NWHIST)
-#endif
-#if !defined(CERNLIB_AREAD)
- READ(LUN,ERR=900,END=900)(HCV(K),K=1,NWHIST)
-#endif
- IF(IDD.NE.0.AND.ID1.NE.IDD)GO TO 10
-*
- ID=ID1
- N=1
- IDPOS=LOCATI(IQ(LTAB+1),IQ(LCDIR+KNRH),ID)
- IF(IDPOS.GT.0)THEN
- CALL HDELET(ID1)
- CALL HBUG('Already existing histogram replaced','HFETCH',ID1)
- ENDIF
-*
- K1=JBIT(IC,1)
- K2=JBYT(IC,2,2)
- IF(K1.EQ.0.AND.K2.EQ.0)THEN
- CALL HARRAY(ID1,NWHIST,ILOC)
- CALL UCOPY(IHCV,IQ(LCID+1),NWHIST)
- GO TO 800
- ENDIF
-*
- JNEXT=IHCV(1)+1
- IFW=JNEXT+IHCV(JNEXT+2)
- NBP=IHCV(IFW-1)
- IF(NBP.GE.32)THEN
- VMX=0.
- ELSE
- VMX=MAXBIT(NBP)
- ENDIF
- NCX=IHCV(2)
- XMIN=HCV(3)+0.000001/HCV(5)
- XMAX=HCV(4)
- IWT=6
- IF(K2.NE.0)THEN
- NCY=IHCV(6)
- YMIN=HCV(7)+0.000001/HCV(9)
- YMAX=HCV(8)
- IWT=IWT+4
- ENDIF
- KTITL=' '
- NCTIT=NCHAR*(IHCV(1)-IWT+1)
- NWT=MIN(79,NCTIT)
- IF(NWT.GT.0)THEN
- CALL UHTOC(IHCV(IWT),4,KTITL,NWT)
- ENDIF
- IF(K1.NE.0)THEN
- CALL HBOOK1(ID1,KTITL,NCX,XMIN,XMAX,VMX)
- LCONT=LQ(LCID-1)
- LPRX=LCID+KNCX
- DO 11 I=0,NCX+1
- IF(NBP.EQ.NBIT)THEN
- W=HCV(IFW+I+1)
- ELSE
- L1=I*NBP
- NBITH=NBIT-MOD(NBIT,NBP)
- L2=MOD(L1,NBITH)+1
- L1=IFW+1+L1/NBITH
- W=JBYT(IHCV(L1),L2,NBP)
- ENDIF
- CALL HFCX(I,W)
- 11 CONTINUE
- IF(JBIT(IC,9).NE.0)THEN
- CALL MZBOOK(IHDIV,LW,LCONT,0,'HI1E',0,0,NCX,3,0)
- IQ(LCID+KNTOT)=IQ(LCID+KNTOT)+NCX+10
- NBB=NBIT/NBP
- NW=(NCX+2)/NBB+1
- LW=LQ(LCONT)
- DO 12 I=1,NCX
- J=IFW+I+NW+1
- Q(LW+I)=HCV(J)
- 12 CONTINUE
- ENDIF
- IF(JBIT(IC,12).NE.0)THEN
- CALL MZBOOK(IHDIV,LFUNC,LCONT,-1,'HFUN',0,0,NCX+2,IOCF2,0)
- IQ(LCID+KNTOT)=IQ(LCID+KNTOT)+NCX+12
- L2=1+IHCV(1)
- LFUNC=LQ(LCONT-1)
- IQ(LFUNC+1)=1
- IQ(LFUNC+2)=NCX
- DO 13 I=1,NCX
- J=L2+IHCV(L2)+I+1
- Q(LFUNC+I+2)=HCV(J)
- 13 CONTINUE
- ENDIF
- ELSE
- CALL HBOOK2(ID1,KTITL,NCX,XMIN,XMAX,NCY,YMIN,YMAX,VMX)
- NW=NBIT/NBP
- NB=NBP
- DO 15 J=0,NCY+1
- DO 14 I=0,NCX+1
- K=(NCY-J+2)*(NCX+3)
- L2=I+K
- L1=L2/NW+IFW+1
- IF(NW.EQ.1)THEN
- W=HCV(L1)
- ELSE
- L2=(NW-1-MOD(L2,NW))*NBP+1
- W=JBYT(IHCV(L1),L2,NBP)
- ENDIF
- CALL HFCXY(I,J,W)
- 14 CONTINUE
- 15 CONTINUE
- ENDIF
- IQ(LCONT+KNOENT)=IHCV(IFW)
- IQ(LCID+KBITS)=IC
- CALL HDCOFL
- IF(I17.NE.0)CALL HBIGBI(ID1,HCV(NWHIST-I17-I18-I19-I20-I21))
- IF(I18.NE.0)CALL HNORMA(ID1,HCV(NWHIST-I18-I19-I20-I21))
- IF(I19.NE.0)CALL HSCALE(ID1,HCV(NWHIST-I19-I20-I21))
- IF(I20.NE.0)CALL HMAXIM(ID1,HCV(NWHIST-I20-I21))
- IF(I21.NE.0)CALL HMINIM(ID1,HCV(NWHIST-I21))
-C
- 20 JNEXT=JNEXT+IHCV(JNEXT)
- IF(IHCV(JNEXT).EQ.0)GO TO 800
- JTYPE=IHCV(JNEXT+1)
- IF(JTYPE.EQ.9)GO TO 800
- IF(JTYPE.EQ.5.OR.JTYPE.EQ.6)THEN
- IFW=JNEXT+IHCV(JNEXT+3)
- ELSE
- IFW=JNEXT+IHCV(JNEXT+2)
- ENDIF
- NBP=IHCV(IFW-1)
- IF(NBP.GE.32)THEN
- VMX=0.
- ELSE
- VMX=MAXBIT(NBP)
- ENDIF
-C
- GO TO(20,20,50,60,70,80,100,110,800),JTYPE
-C
-C PROJECTION X
-C
- 50 CALL HBPROX(ID1,VMX)
- LCONT=LQ(LCID-2)
- LPRX=LCID+KNCX
- CALL HFETC1(NBP,NCX)
- GO TO 20
-C
-C PROJECTION Y
-C
- 60 CALL HBPROY(ID1,VMX)
- LCONT=LQ(LCID-3)
- LPRX=LCID+KNCY
- CALL HFETC1(NBP,NCY)
- GO TO 20
-C
-C SLICES X
-C
- 70 NSL=IHCV(JNEXT+2)
- CALL HBSLIX(ID1,NSL,VMX)
- LPRX=LCID+KNCX
- DO 78 NUM=1,NSL
- IFW=JNEXT+IHCV(JNEXT+NUM+2)
- LCONT=LQ(LSLIX-NUM)
- CALL HFETC1(NBP,NCX)
- 78 CONTINUE
- GO TO 20
-C
-C SLICES Y
-C
- 80 NSL=IHCV(JNEXT+2)
- CALL HBSLIY(ID1,NSL,VMX)
- LPRX=LCID+KNCY
- DO 88 NUM=1,NSL
- IFW=JNEXT+IHCV(JNEXT+NUM+2)
- LCONT=LQ(LSLIY-NUM)
- CALL HFETC1(NBP,NCY)
- 88 CONTINUE
- GO TO 20
-C
-C BAND X
-C
- 100 YLOW=HCV(JNEXT+3)
- YUP =HCV(JNEXT+4)
- CALL HBANDX(ID1,YLOW,YUP,VMX)
- LPRX=LCID+KNCX
- CALL HFETC1(NBP,NCX)
- GO TO 20
-C
-C BAND Y
-C
- 110 XLOW=HCV(JNEXT+3)
- XUP =HCV(JNEXT+4)
- CALL HBANDY(ID1,XLOW,XUP,VMX)
- LPRX=LCID+KNCY
- CALL HFETC1(NBP,NCY)
- GO TO 20
-*
- 800 IF(IDD.EQ.0)GO TO 10
-*
- 900 IF(IDD.NE.0.AND.N.EQ.0)
- +CALL HBUG('Unknown histogram','HFETCH',IDD)
-*
- 999 RETURN
- END
diff --git a/src/packlib/hbook/code/hff1.F b/src/packlib/hbook/code/hff1.F
deleted file mode 100644
index 2d90360..0000000
--- a/src/packlib/hbook/code/hff1.F
+++ /dev/null
@@ -1,71 +0,0 @@
-*
-* $Id: hff1.F,v 1.1.1.1 1996/01/16 17:07:36 mclareni Exp $
-*
-* $Log: hff1.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:36 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.20/08 10/09/93 09.15.02 by Rene Brun
-*-- Author :
- SUBROUTINE HFF1(ID1,NID,X,W)
-*.==========>
-*. FAST FILLING ROUTINE FOR 1-DIM HIST
-*. NID IS AN OUTPUT PARAMETER = HIST NUMBER-1
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
-#include "hbook/hcflag.inc"
-#include "hbook/hcprin.inc"
- DIMENSION NID(1)
- SAVE BWID1
-*.___________________________________________
-#include "hbook/jbyt.inc"
- IF(ID1.NE.IDLAST)THEN
-*
-* CHECK IF ID1 IS AT THE ADDRESS CORRESPONDING TO NID(1)
-* IF NOT COMPUTE NID(1).
-*
- IF(NID(1).LE.0)GO TO 10
- IF(NID(1).GT.IQ(LCDIR+KNRH))GO TO 10
- LCID=LQ(LTAB-NID(1))
- IF(IQ(LTAB+NID(1)).EQ.ID1)GO TO 20
-*
-* SEARCH ADDRESS OF ID IN THE ADDRESS TABLE (BINARY SEARCH)
-*
- 10 ID=ID1
- IDPOS=LOCATI(IQ(LTAB+1),IQ(LCDIR+KNRH),ID)
- IF(IDPOS.LE.0)RETURN
- NID(1)=IDPOS
-*
-* COMPUTE POINTERS TO ACCESS HISTOGRAM AREA
-*
- 20 IDLAST=ID1
- LCID =LQ(LTAB-NID(1))
- LCONT=LQ(LCID-1)
- BWID1=FLOAT(IQ(LCID+KNCX))/(Q(LCID+KXMAX)-Q(LCID+KXMIN))
- ENDIF
-*
-* INCREMENT NUMBER OF ENTRIES AND COMPUTE CHANNEL NUMBER
-*
- IQ(LCONT+KNOENT)=IQ(LCONT+KNOENT)+1
- IF(X.LT.Q(LCID+KXMIN))THEN
- ICHAN=0
- ELSEIF(.NOT.(X.LT.Q(LCID+KXMAX)))THEN
- ICHAN=IQ(LCID+KNCX)+1
- ELSE
- ICHAN=(X-Q(LCID+KXMIN))*BWID1+1
- ENDIF
- IF(IQ(LCONT+KNBIT).GE.32)THEN
- Q(LCONT+ICHAN+KCON1)=Q(LCONT+ICHAN+KCON1)+W
- ELSE
- NBPROX=IQ(LCONT+KNBIT)
- NB=32/NBPROX
- LWORD=ICHAN/NB
- LBIT=(ICHAN-NB*LWORD)*NBPROX+1
- INC=JBYT(IQ(LCONT+LWORD+KCON1),LBIT,NBPROX)
- INC=INC+W+0.5
- IF(INC.GT.MAXBIT(NBPROX))INC=MAXBIT(NBPROX)
- CALL SBYT(INC,IQ(LCONT+LWORD+KCON1),LBIT,NBPROX)
- ENDIF
- END
diff --git a/src/packlib/hbook/code/hff2.F b/src/packlib/hbook/code/hff2.F
deleted file mode 100644
index 2f5a341..0000000
--- a/src/packlib/hbook/code/hff2.F
+++ /dev/null
@@ -1,81 +0,0 @@
-*
-* $Id: hff2.F,v 1.1.1.1 1996/01/16 17:07:36 mclareni Exp $
-*
-* $Log: hff2.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:36 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.20/08 10/09/93 09.18.09 by Rene Brun
-*-- Author :
- SUBROUTINE HFF2(ID1,NID,X,Y,W)
-*.==========>
-*. FAST FILLING ROUTINE FOR 2-DIM HIST
-*. NID IS AN OUTPUT PARAMETER = HIST NUMBER-1
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
-#include "hbook/hcflag.inc"
-#include "hbook/hcprin.inc"
- DIMENSION NID(1)
- SAVE NBSCAT,BWIDX1,BWIDY1
-*.___________________________________________
- IF(ID1.NE.IDLAST)THEN
-*
-* CHECK IF ID1 IS AT THE ADDRESS CORRESPONDING TO NID(1)
-* IF NOT COMPUTE NID(1).
-*
- IF(NID(1).LE.0)GO TO 10
- IF(NID(1).GT.IQ(LCDIR+KNRH))GO TO 10
- LCID=LQ(LTAB-NID(1))
- IF(IQ(LTAB+NID(1)).EQ.ID1)GO TO 20
-*
-* SEARCH ADDRESS OF ID IN THE ADDRESS TABLE (BINARY SEARCH)
-*
- 10 ID=ID1
- IDPOS=LOCATI(IQ(LTAB+1),IQ(LCDIR+KNRH),ID)
- IF(IDPOS.LE.0)RETURN
- NID(1)=IDPOS
-*
-* COMPUTE POINTERS TO ACCESS HISTOGRAM AREA
-*
- 20 IDLAST=ID1
- LCID =LQ(LTAB-NID(1))
- LSCAT =LQ(LCID-1)
- NBSCAT=IQ(LSCAT+KNBIT)
- BWIDX1=FLOAT(IQ(LCID+KNCX))/(Q(LCID+KXMAX)-Q(LCID+KXMIN))
- BWIDY1=FLOAT(IQ(LCID+KNCY))/(Q(LCID+KYMAX)-Q(LCID+KYMIN))
- ENDIF
-*
-* INCREMENT NUMBER OF ENTRIES AND COMPUTE CELL NUMBER
-*
- IQ(LSCAT+KNOENT)=IQ(LSCAT+KNOENT)+1
- IF(X.LT.Q(LCID+KXMIN))THEN
- I=0
- ELSEIF(.NOT.(X.LT.Q(LCID+KXMAX)))THEN
- I=IQ(LCID+KNCX)+1
- ELSE
- I=(X-Q(LCID+KXMIN))*BWIDX1 + 1
- ENDIF
- IF(Y.LT.Q(LCID+KYMIN))THEN
- J=0
- ELSEIF(.NOT.(Y.LT.Q(LCID+KYMAX)))THEN
- J=IQ(LCID+KNCY)+1
- ELSE
- J=(Y-Q(LCID+KYMIN))*BWIDY1 + 1
- ENDIF
-*
- ICHAN=(IQ(LCID+KNCY)-J+1)*(IQ(LCID+KNCX)+2)+I
- IF(NBSCAT.LT.32)THEN
- NB=32/NBSCAT
- LWORD=ICHAN/NB
- LBIT=(NB-1-MOD(ICHAN,NB))*NBSCAT + 1
- IAD=LWORD+LSCAT+KCON2
- INC=JBYT(IQ(IAD),LBIT,NBSCAT)+W+0.5
- IF(INC.GT.MAXBIT(NBSCAT))INC=MAXBIT(NBSCAT)
- CALL SBYT(INC,IQ(IAD),LBIT,NBSCAT)
- ELSE
- LWORD=LSCAT+ICHAN+KCON2
- Q(LWORD)=Q(LWORD)+W
- ENDIF
- END
diff --git a/src/packlib/hbook/code/hfidp.F b/src/packlib/hbook/code/hfidp.F
deleted file mode 100644
index 083232a..0000000
--- a/src/packlib/hbook/code/hfidp.F
+++ /dev/null
@@ -1,89 +0,0 @@
-*
-* $Id: hfidp.F,v 1.1.1.1 1996/01/16 17:07:36 mclareni Exp $
-*
-* $Log: hfidp.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:36 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.10/05 21/02/89 16.14.47 by Rene Brun
-*-- Author :
- SUBROUTINE HFIDP(ID1,X,Y,W)
-*.==========>
-*. FILLS PROJECTIONS OF A 2-DIM
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
-*.___________________________________________
-*
-* PROX
-*
- LCONT=LQ(LCID-2)
- IF(LCONT.NE.0)THEN
- LPRX=LCID+KNCX
- CALL HF1(ID1,X,W)
- ENDIF
-*
-* PROY
-*
- LCONT=LQ(LCID-3)
- IF(LCONT.NE.0)THEN
- LPRX=LCID+KNCY
- CALL HF1(ID1,Y,W)
- ENDIF
-*
-* SLIX
-*
- LSLIX=LQ(LCID-4)
- IF(LSLIX.NE.0)THEN
- NSL=IQ(LSLIX-2)
- ISL=FLOAT(NSL)*(Y-Q(LCID+KYMIN))/(Q(LCID+KYMAX)
- + -Q(LCID+KYMIN))+1
- IF(ISL.GT.0.AND.ISL.LE.NSL)THEN
- LCONT=LQ(LSLIX-ISL)
- LPRX=LCID+KNCX
- CALL HF1(ID1,X,W)
- ENDIF
- ENDIF
-*
-* SLIY
-*
- LSLIY=LQ(LCID-5)
- IF(LSLIY.NE.0)THEN
- NSL=IQ(LSLIY-2)
- ISL=FLOAT(NSL)*(X-Q(LCID+KXMIN))/(Q(LCID+KXMAX)
- + -Q(LCID+KXMIN))+1
- IF(ISL.GT.0.AND.ISL.LE.NSL)THEN
- LCONT=LQ(LSLIY-ISL)
- LPRX=LCID+KNCY
- CALL HF1(ID1,Y,W)
- ENDIF
- ENDIF
-*
-* BAND X
-*
- LBANX=LQ(LCID-6)
- IF(LBANX.NE.0)THEN
- 10 IF(Y.GE.Q(LBANX+1).AND.Y.LT.Q(LBANX+2))THEN
- LCONT=LQ(LBANX-1)
- LPRX=LCID+KNCX
- CALL HF1(ID1,X,W)
- ENDIF
- LBANX=LQ(LBANX)
- IF(LBANX.NE.0)GO TO 10
- ENDIF
-*
-* BAND Y
-*
- LBANY=LQ(LCID-7)
- IF(LBANY.NE.0)THEN
- 20 IF(X.GE.Q(LBANY+1).AND.X.LT.Q(LBANY+2))THEN
- LCONT=LQ(LBANY-1)
- LPRX=LCID+KNCY
- CALL HF1(ID1,Y,W)
- ENDIF
- LBANY=LQ(LBANY)
- IF(LBANY.NE.0)GO TO 20
- ENDIF
-*
- END
diff --git a/src/packlib/hbook/code/hfill.F b/src/packlib/hbook/code/hfill.F
deleted file mode 100644
index 7c89141..0000000
--- a/src/packlib/hbook/code/hfill.F
+++ /dev/null
@@ -1,83 +0,0 @@
-*
-* $Id: hfill.F,v 1.1.1.1 1996/01/16 17:07:36 mclareni Exp $
-*
-* $Log: hfill.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:36 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.23/02 05/05/95 08.51.58 by Francois Dardare
-*-- Author :
- SUBROUTINE HFILL(ID1,X,Y,W)
-*.==========>
-*. GENERAL FILLING ROUTINE
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
-#include "hbook/hcflag.inc"
-#include "hbook/hcbits.inc"
-*.___________________________________________
-
-#if defined(CERNLIB_SUN)||defined(CERNLIB_SOLARIS)||defined(CERNLIB_SGI)||defined(CERNLIB_DECS)||defined(CERNLIB_ALPHA)||defined(CERNLIB_HPUX)||defined(CERNLIB_IBMRT)
-*test the floating point X
- J=IFPS(X)
- IF(J .EQ. 0) THEN
- CALL HFPBUG(X,'HFILL first float variable: X',ID1)
- ENDIF
-*test the floating point Y
- J=IFPS(Y)
- IF(J .EQ. 0) THEN
- CALL HFPBUG(Y,'HFILL second float variable: Y',ID1)
- ENDIF
-*test the floating point W
- J=IFPS(W)
- IF(J .EQ. 0) THEN
- CALL HFPBUG(W,'HFILL third float variable: W',ID1)
- ENDIF
-*
-#endif
-
- IF(ID1.NE.IDLAST)THEN
- ID=ID1
- IDPOS=LOCATI(IQ(LTAB+1),IQ(LCDIR+KNRH),ID)
- IF(IDPOS.LE.0)RETURN
- LCID=LQ(LTAB-IDPOS)
- I1=JBIT(IQ(LCID+KBITS),1)
- I5=JBIT(IQ(LCID+KBITS),5)
- I6=JBIT(IQ(LCID+KBITS),6)
- I7=JBIT(IQ(LCID+KBITS),7)
- I8=JBIT(IQ(LCID+KBITS),8)
- LCONT=LQ(LCID-1)
- LPRX=LCID+KNCX
- IDLAST=ID1
- ENDIF
-*
- IF(I1.NE.0)THEN
-*
-* 1-DIM HISTOGRAM OR PROFILE
-*
- IF(I8.EQ.0)THEN
- CALL HF1(ID1,X,W)
- ELSE
- CALL HFILPF(ID1,X,Y,W)
- ENDIF
- ELSE
-*
-* 2-DIM HISTOGRAM
-*
- CALL HF2 (ID1,X,Y,W)
- CALL HFIDP(ID1,X,Y,W)
- LCONT=LQ(LCID-1)
- ENDIF
- END
-
-
-
-
-
-
-
-
-
-
-
diff --git a/src/packlib/hbook/code/hfilpf.F b/src/packlib/hbook/code/hfilpf.F
deleted file mode 100644
index d790a37..0000000
--- a/src/packlib/hbook/code/hfilpf.F
+++ /dev/null
@@ -1,116 +0,0 @@
-*
-* $Id: hfilpf.F,v 1.7 2000/12/19 16:56:22 couet Exp $
-*
-* $Log: hfilpf.F,v $
-* Revision 1.7 2000/12/19 16:56:22 couet
-* - Bug fixed in RMS calculation. When IDOPT STAT is on the RMS calculation
-* was wrong one some machines because it was done using REAL and DOUBLE
-* PRECISION numbers. Now we use on ly DOUBLE PRECISION numbers.
-*
-* Revision 1.6 1998/10/05 14:39:01 couet
-* - New option P for profile histograms. Implemented by: Nello Nappi
-* <Nello.Nappi at cern.ch>
-*
-* Revision 1.5 1996/10/08 16:21:17 couet
-* - rounding problem fixed
-*
-* Revision 1.4 1996/09/20 08:54:26 couet
-* - IFIX come back ... But now at the right place ...
-*
-* Revision 1.3 1996/09/18 15:34:19 couet
-* - The previous fixe in this routine (IFIX ...) had catastrophic side
-* effects.
-*
-* Revision 1.2 1996/05/24 12:25:26 couet
-* - Rounding problem. IFIX added
-*
-* Revision 1.1.1.1 1996/01/16 17:07:36 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
- SUBROUTINE HFILPF(ID1,X,Y,W)
-*.==========>
-*. FAST FILLING ENTRY FOR A PROFILE HISTOGRAM
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
-#include "hbook/hcflag.inc"
-#include "hbook/hcbits.inc"
-#if !defined(CERNLIB_DOUBLE)
- DIMENSION SWX(4)
-#endif
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION SWX(2),DBLX,DBLZ
-#endif
-*.___________________________________________
-*
- IF(ID1.NE.IDLAST)THEN
- ID=ID1
- IDPOS=LOCATI(IQ(LTAB+1),IQ(LCDIR+KNRH),ID)
- IF(IDPOS.LE.0)RETURN
- IDLAST=ID1
- LCID=LQ(LTAB-IDPOS)
- LCONT=LQ(LCID-1)
- LPRX=LCID+KNCX
- I7=JBIT(IQ(LCID+KBITS),7)
- ENDIF
-*
- IQ(LCONT+KNOENT)=IQ(LCONT+KNOENT)+1
- IF(Y.LT.Q(LCID+KMIN1))RETURN
- IF(Y.GT.Q(LCID+KMAX1))RETURN
- Z=ABS(W)
- IF(X.LT.Q(LPRX+1))THEN
-C
-C underflow
-C
- ICHAN=0
- ELSEIF(X.GE.Q(LPRX+2))THEN
-C
-C overflow
-C
- ICHAN=IQ(LPRX)+1
- ELSE
-C
-C In range
-C
- ICHAN=IFIX(
- + (X-Q(LPRX+1))*
- + FLOAT(IQ(LPRX))/(Q(LPRX+2)-Q(LPRX+1))
- + ) + 1
- IF (ICHAN.EQ.IQ(LPRX)+1) GOTO 10
- IF (ICHAN.EQ.0) GOTO 10
- LW=LQ(LCONT)
- LN=LQ(LW)
- IF(JBIT(IQ(LW),3).NE.0)THEN
- IF(Q(LN+ICHAN).NE.0.)THEN
- YDIF=Y-Q(LCONT+ICHAN+KCON1)/Q(LN+ICHAN)
- Q(LW+ICHAN)=Q(LW+ICHAN)+
- + Z*Q(LN+ICHAN)*YDIF*YDIF/(Z+Q(LN+ICHAN))
- ENDIF
- ELSE
- Q(LW+ICHAN)=Q(LW+ICHAN)+Z*Y*Y
- ENDIF
- Q(LN+ICHAN)=Q(LN+ICHAN)+W
-*
-* I7 means HBSTAT has been called
-*
- IF(I7.NE.0)THEN
- Q(LCONT+KSTAT1)=Q(LCONT+KSTAT1)+Z
- Q(LCONT+KSTAT1+1)=Q(LCONT+KSTAT1+1)+Z*Z
- CALL UCOPY(Q(LCONT+KSTAT1+2),SWX,4)
-#if defined(CERNLIB_DOUBLE)
- DBLX=X
- DBLZ=Z
- SWX(1)=SWX(1)+DBLZ*DBLX
- SWX(2)=SWX(2)+DBLZ*DBLX*DBLX
-#else
- SWX(1)=SWX(1)+Z*X
- SWX(2)=SWX(2)+Z*X*X
-#endif
- CALL UCOPY(SWX,Q(LCONT+KSTAT1+2),4)
- ENDIF
- ENDIF
-*
- 10 Q(LCONT+ICHAN+KCON1)=Q(LCONT+ICHAN+KCON1)+Z*Y
-*
- END
diff --git a/src/packlib/hbook/code/hfilpr.F b/src/packlib/hbook/code/hfilpr.F
deleted file mode 100644
index 3b284fb..0000000
--- a/src/packlib/hbook/code/hfilpr.F
+++ /dev/null
@@ -1,54 +0,0 @@
-*
-* $Id: hfilpr.F,v 1.1.1.1 1996/01/16 17:07:36 mclareni Exp $
-*
-* $Log: hfilpr.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:36 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.23/01 20/02/95 09.40.34 by Julian Bunn
-*-- Author :
- SUBROUTINE HFILPR(IDD)
-*.==========>
-*. Fills projections,slices,bands, of a scatter-plot
-*. from the 2-Dim contents
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
-#include "hbook/hcflag.inc"
-#include "hbook/hcbits.inc"
-#include "hbook/hcprin.inc"
-*.___________________________________________
- CALL HFIND(IDD,'HFILPR')
- IF(LCID.LE.0)GO TO 99
- CALL HDCOFL
- IF(I230.EQ.0)GO TO 99
- CALL SBIT0(IQ(LCID),5)
- LSCAT=LCONT
- NBS=NB
- IDLAST=IDD
- NCX=IQ(LCID+KNCX)
- XMIN=Q(LCID+KXMIN)
- XMAX=Q(LCID+KXMAX)
- NCY=IQ(LCID+KNCY)
- YMIN=Q(LCID+KYMIN)
- YMAX=Q(LCID+KYMAX)
-C
- DX=(XMAX-XMIN)/FLOAT(NCX)
- DY=(YMAX-YMIN)/FLOAT(NCY)
-C
- Y=YMIN-0.5*DY
- DO 20 J=1,NCY
- Y=Y+DY
- X=XMIN-0.5*DX
- DO 10 I=1,NCX
- X=X+DX
- NB=NBS
- CONT=HCXY(I,J,1)
- CALL HFIDP(IDD,X,Y,CONT)
- 10 CONTINUE
- 20 CONTINUE
- IDLAST=0
-C
- 99 RETURN
- END
diff --git a/src/packlib/hbook/code/hfinam.F b/src/packlib/hbook/code/hfinam.F
deleted file mode 100644
index c022992..0000000
--- a/src/packlib/hbook/code/hfinam.F
+++ /dev/null
@@ -1,54 +0,0 @@
-*
-* $Id: hfinam.F,v 1.1.1.1 1996/01/16 17:07:36 mclareni Exp $
-*
-* $Log: hfinam.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:36 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.17/02 15/12/92 21.48.30 by Rene Brun
-*-- Author :
- SUBROUTINE HFINAM(IDD,FITN,NPAR)
-*.==========>
-*. Stores names of parameters in fit bank
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
-#include "hbook/hcbits.inc"
- CHARACTER*(*) FITN(*)
- CHARACTER*8 FIT1
-*.___________________________________________
- CALL HFIND(IDD,'HFINAM')
- IF(LCID.LE.0)GO TO 99
- CALL HDCOFL
- IF(I1.EQ.0)THEN
- CALL HBUG('Routine can only be called for 1-D histos',
- + 'HFINAM',IDD)
- GO TO 99
- ENDIF
-*
- CALL UCTOH('HFNA',IHFNA,4,4)
- IF(IQ(LCONT-2).EQ.0)GO TO 90
- LFUNC=LQ(LCONT-1)
- IF(LFUNC.EQ.0)GO TO 90
- IF(IQ(LFUNC-2).EQ.0)GO TO 90
- LHFIT=LQ(LFUNC-1)
- IF(LHFIT.EQ.0)GO TO 90
- L=LQ(LHFIT)
- 5 IF(L.EQ.0)GO TO 90
- IF(IQ(L-4).EQ.IHFNA)THEN
- NP=MIN(NPAR,IQ(L-1)/2)
- DO 10 I=1,NP
- FIT1=FITN(I)
- CALL UCTOH(FIT1,IQ(L+2*I-1),4,8)
- 10 CONTINUE
- GO TO 99
- ELSE
- L=LQ(L)
- GO TO 5
- ENDIF
-*
-* Fit name bank does not exist
-*
- 90 CALL HBUG('Cannot store names','HFINAM',IDD)
- 99 END
diff --git a/src/packlib/hbook/code/hfind.F b/src/packlib/hbook/code/hfind.F
deleted file mode 100644
index 5faa772..0000000
--- a/src/packlib/hbook/code/hfind.F
+++ /dev/null
@@ -1,48 +0,0 @@
-*
-* $Id: hfind.F,v 1.2 2001/09/24 14:25:12 couet Exp $
-*
-* $Log: hfind.F,v $
-* Revision 1.2 2001/09/24 14:25:12 couet
-* - The number of entries of a non existing histogram was not 0.
-*
-* Revision 1.1.1.1 1996/01/16 17:07:37 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.17/03 14/01/93 17.06.36 by Rene Brun
-*-- Author :
- SUBROUTINE HFIND(IDD,CHROUT)
-*.==========>
-*. Find IDD location and compute local pointers
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
-#include "hbook/hcflag.inc"
-#include "hbook/hcprin.inc"
- COMMON /QUEST/ IQUEST(100)
- CHARACTER*(*) CHROUT
-*.___________________________________________
- IF(LFIX.NE.0)GO TO 99
- IQUEST(1)=0
- ID=IDD
- IDLAST=0
- IDPOS=LOCATI(IQ(LTAB+1),IQ(LCDIR+KNRH),ID)
- IF(IDPOS.LE.0)THEN
- LCID=0
- CALL HBUG('Unknown histogram',CHROUT,IDD)
- IQUEST(1)=1
- GO TO 99
- ENDIF
-*
- LCID=LQ(LTAB-IDPOS)
- LCONT=LQ(LCID-1)
- LSCAT=LCONT
- NB=IQ(LCONT+KNBIT)
- LPRX=LCID+KNCX
- IF(JBYT(IQ(LCID+KBITS),2,2).NE.0)THEN
- LPRY=LCID+KNCY
- ELSE
- LPRY=0
- ENDIF
- 99 RETURN
- END
diff --git a/src/packlib/hbook/code/hfinop.F b/src/packlib/hbook/code/hfinop.F
deleted file mode 100644
index 5fff5a4..0000000
--- a/src/packlib/hbook/code/hfinop.F
+++ /dev/null
@@ -1,80 +0,0 @@
-*
-* $Id: hfinop.F,v 1.1.1.1 1996/01/16 17:07:37 mclareni Exp $
-*
-* $Log: hfinop.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:37 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.10/05 09/08/89 14.43.53 by Rene Brun
-*-- Author :
- SUBROUTINE HFINOP(IDD,LABEL,IFWW,NBB,IFX,IFY,ICASE,NUM)
-*.==========>
-*. LOCATE THE POSITION OF OPTION (ICASE,NUM )
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
-#include "hbook/hcprin.inc"
- CHARACTER*(*) LABEL
-*.___________________________________________
- IFX=0
- IFY=0
- IFW=0
- NB=0
- IC=IUCOMP(ICASE,IDENT,8)
-*
- IRET=3
- CALL HLOOP(IDD,LABEL,IRET)
- IF(IRET.EQ.0)GO TO 99
-*
- I1=JBIT(IQ(LCID+KBITS),1)
- ILINK=1
- IF(IC.GT.2)ILINK=IC-1
- NBX=0
- NBY=0
-*
- 30 LNEXT=LQ(LCID-ILINK)
- IF(LNEXT.EQ.0)GO TO 99
-*
- GO TO(40,40,70,80,90,100,110,99,99),ILINK
-*
- 40 IFX=LCID+KNCX
- 45 IFW=LNEXT
- NB=IQ(LNEXT+KNBIT)
- IF(I1.EQ.0.AND.ILINK.EQ.1)IFY=LCID+KNCY
- GO TO 99
- 70 IFX=LCID+KNCY
- GO TO 45
-*
- 80 IFX=LCID+KNCX
- 85 NSL=IQ(LNEXT-2)
- IF(NUM.LT.1.OR.NUM.GT.NSL)GO TO 99
- LNEXT=LQ(LNEXT-NUM)
- GO TO 45
- 90 IFX=LCID+KNCY
- GO TO 85
-*
- 100 NBX=NBX+1
- IF(NUM.NE.NBX)THEN
- LNEXT=LQ(LNEXT)
- IF(LNEXT.EQ.0)GO TO 99
- GO TO 100
- ELSE
- LNEXT=LQ(LNEXT-1)
- GO TO 40
- ENDIF
-*
- 110 NBY=NBY+1
- IF(NUM.NE.NBY)THEN
- LNEXT=LQ(LNEXT)
- IF(LNEXT.EQ.0)GO TO 99
- GO TO 110
- ELSE
- LNEXT=LQ(LNEXT-1)
- IFX=LCID+KNCY
- GO TO 45
- ENDIF
-*
- 99 IFWW=IFW
- NBB=NB
- END
diff --git a/src/packlib/hbook/code/hfit.F b/src/packlib/hbook/code/hfit.F
deleted file mode 100644
index e9e016c..0000000
--- a/src/packlib/hbook/code/hfit.F
+++ /dev/null
@@ -1,229 +0,0 @@
-*
-* $Id: hfit.F,v 1.1.1.1 1996/01/16 17:07:37 mclareni Exp $
-*
-* $Log: hfit.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:37 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.22/08 04/07/94 08.58.13 by Rene Brun
-*-- Author :
- SUBROUTINE HFIT (IDD,UFUNC,NPAR,PARAM,CHI2,ICONTR,SIGPAR,COVMAT,
- +STEP0,PARMIN,PARMAX)
-*.==========>
-*. FITS THE PARAMETRIC FUNCTION TO THE CONTENTS OF THE
-*. 1- OR 2-DIMENSIONAL HISTOGRAM IDD,AND OPTIONALLY SUPER-
-*. IMPOSES IT TO THE 1-DIMENSIONAL HISTOGRAM WHEN EDITING
-*.
-*.
-*. INPUT IDD = HISTOGRAM IDENTIFIER
-*. ARGUMENTS
-*. UFUNC = PARAMETRIC FUNCTION (EXTERNAL)
-*.
-*. NPAR = NUMBER OF PARAMETERS
-*.
-*. PARAM = INITIAL VALUES OF PARAMETERS(ARRAY)
-*.
-*. ICONTR = CONTROL WORD
-*. 1 - NO SUPERIMPOSING
-*. 2 - FITTED FUNCTION IS SUPER-
-*. IMPOSED TO HISTOGRAM
-*.
-*. STEP0 = INITIAL STEP SIZES FOR PARAMETERS
-*. SEARCH (ARRAY)
-*.
-*. PARMIN = LOWER
-*. PARAMETER BOUNDS (ARRAY)
-*. PARMAX = UPPER
-*. (-/+10**4WORDLENGTH BY DEFAULT)
-*.
-*. OUTPUT PARAM = FINAL VALUES OF PARAMETERS (ARRAY)
-*. ARGUMENTS
-*. CHI2 = CHISQUARE OF FIT
-*.
-*. SIGPAR = STANDARD DEVIATIONS OF PARAMETERS
-*. (ARRAY)
-*.
-*. COVMAT = COVARIENCE MATRIX OF PARAMETERS
-*. (ARRAY L=NPAR*(NPAR+1)/2)
-*.
-*. ARGUMENTS FROM CHI2 INCLUDED, ARE OPTIONAL
-*.
-*. ---------------------------REMARKS------------------------------
-*.
-*. ICONTR=L*10**6+F*100000+B*10000+D*1000+W*100+P*10+S
-*.
-*. S=2,DEFAULT - SUPERIMPOSES FUNCTION TO HISTOGRAM
-*. S=1 - NO SUPERIMPOSING
-*.
-*. P=1 - PRINTS RESULTS OF THE FINAL ITERATION
-*. P>1 - PRINTS RESULTS OF ITERATIONS N*(P-1),WHERE
-*. N=0,1,2,...
-*. P=0,DEFAULT - SUPPRESSES INTERMEDIATE PRINTING
-*.
-*. W=1 - SETS WEIGHTS EQUAL TO 1.
-*. W=0,DEFAULT -CALCULATES ERROR BAR E=SQRT(CONTENTS)
-*. AND SETS THE WEIGHT EQUAL TO 1./E**2
-*. HOWEVER IF ERROR BARS ARE AVAILABLE (E.G.AFTER CALL TO
-*. HBARX OR HPAKE)THEY ARE USED FOR SETTING OF THE WEIGHTS
-*.
-*. D,F ARE ESSENTIAL ONLY FOR HFIT, OTHER FIT-SUBROUTINES
-*. IGNORED D,F
-*. D=0,DEFAULT - SAVE USER"S FORCE:CALCULATES DERIVATIVES
-*. FOR PARAMETERS NUMERICALLY
-*. D=1 - REQUIRES USER ROUTINE HDERI2(2-DIM)
-*. HDERI1(OTHERWISE) FOR COMPUTATION
-*. OF DERIVATIVES
-*.
-*. B=0,DEFAULT - SAVE MEMORY,USED DIRECTLY HISTOGRAM CON-
-*. TENTS
-*. B=1 - SAVE TIME,DEMANDS BUFFER ARRAY FOR FITTED
-*. DATA:TRANSFORMED HISTOGRAM CONTENTS
-*.
-*. F>0 - SPECIAL FORMAT:DATA SET FOR F VARIABLES
-*. (C,SIGMAC,X1,...,XF)
-*. F=0,DEFAULT - USUAL FORMAT OF HISTOGRAMS
-*.
-*. L=1 - LINEAR CASE
-*. L=0,DEFAULT - GENERAL CASE
-*..=========> ( R.Brun, I.Ivanchenko )
- DIMENSION PARAM(1),SIGPAR(1),COVMAT(1),STEP0(1),PARMIN(1)
- +,PARMAX(1),NCHAN(2)
-#include "hbook/hcfit2.inc"
-#include "hbook/hcflag.inc"
-#include "hbook/hcbits.inc"
-#include "hbook/hcprin.inc"
-#include "hbook/hcbook.inc"
- EXTERNAL UFUNC
- COMMON/HCGARB/NDIM,PLMIN,PLEPS,IBIT,LEXDAT,ISWTCH,GA(11)
- DATA NAME/2H /
-#if defined(CERNLIB_CDC)
- DATA I4000B/O"4000"/
-#endif
-*.___________________________________________
- CALL HFIND(IDD,'HHFIT ' )
- IF(LCID.EQ.0)GO TO 99
- IF(IQ(LCONT+KNOENT).EQ.0)THEN
- CALL HBUG('Empty histogram','HFIT',IDD)
- GO TO 99
- ENDIF
- CALL HDCOFL
-*
- NDIM=1
- NCHAN(1)=IQ(LPRX)
- IF(I1.EQ.0)THEN
- NDIM=2
- NCHAN(2)=IQ(LPRY)
- ENDIF
-*
- IDIMPN=2+NDIM
- IFLFUN=1
- NAMFUN=NAME
-*
- NARG=11
- CALL NOARG(NARG)
-*
- CALL HGETFL(ICONTR)
-*
- NV=1
- IF(IDIMPN.EQ.3.AND.ISUPIM.EQ.2)CALL HFUNC(IDD,UFUNC)
- NV=2
-*
- LEXDAT=IDIMPN
- DO 2 I=1,NDIM
- 2 LEXDAT=NCHAN(I)*LEXDAT
-*
- IF(IFLBUF.EQ.0)LEXDAT=IDIMPN
- LMATR=(NPAR*(NPAR+1))/2
- LAHFIT=LEXDAT+8*NPAR+LMATR
- IF(NARG.LT.8)LAHFIT=LAHFIT+LMATR+NPAR
-*
- CALL HWORK(LAHFIT,IMATR0,'HFIT ')
- IF(IMATR0.EQ.0)GO TO 99
- IMATR=IMATR0+LMATR
- ISIGMA=IMATR+LMATR
- IGRADS=ISIGMA+NPAR
- IF(NARG.GE.8)IGRADS=IMATR0+LMATR
- IDERFU=IGRADS+NPAR
- IPL0 =IDERFU+NPAR
- IPLFUM=IPL0+NPAR
- IRFUM =IPLFUM+NPAR
- IDELPA=IRFUM +NPAR
- IMAXPA=IDELPA+NPAR
- IMINPA=IMAXPA+NPAR
- IEXDAT=IMINPA+NPAR
-*
-*
-* SETS BOUNDARY SIZES FOR THE PARAMETERS
-*
- DO 3 I=1,NPAR
- Q(IMINPA+I-1)=-BIGP
- IF(NARG.GE.10)Q(IMINPA+I-1)=PARMIN(I)
- Q(IMAXPA+I-1)=BIGP
- IF(NARG.GE.11)Q(IMAXPA+I-1)=PARMAX(I)
- 3 CONTINUE
-*
-#if defined(CERNLIB_CDC)
-*
-* IF(START VALUE OF A PARAMETER IS UNDEFINED)SETS TO 0,MESS
-*
- IUNDEF=0
- DO 5 I=1,NPAR
- IBIT=JBYT(PARAM(I),49,12)
- IF(IBIT.NE.I4000B)GO TO 5
- IUNDEF=1
- PARAM(I)=0.
- 5 CONTINUE
- IF(IUNDEF.EQ.1)CALL HBUG('Error 727','HFIT',ID)
-*
-#endif
-*
- IF(IFLBUF.EQ.1)CALL HEXDAT(IEXDAT,IFLRET)
- IF(IFLBUF.EQ.0)CALL HHIPAR(IFLRET)
-*
- IF(IFLRET.EQ.0)GO TO 99
-*
-* SETS INITIAL STEP SIZES FOR PARAMETERS
-*
- IF(NARG.LT.9)THEN
- PLMIN=BINWID
- PLEPS=1.E-9
- DO 15 I=1,NPAR
- Q(IPL0+I-1)=0.3*ABS(PARAM(I))
- IF(Q(IPL0+I-1).LT.PLEPS)Q(IPL0+I-1)=PLMIN
- 15 CONTINUE
- IF(LINEAR.EQ.1)CALL VFILL(Q(IPL0),NPAR,BIGP)
- ELSE
- DO 21 I=1,NPAR
- Q(IPL0+I-1)=STEP0(I)
- 21 CONTINUE
- ENDIF
-*
- IF(NARG.GE.8)
- +CALL HFUMIL(UFUNC,FUMIN,NPAR,ITFUM,MCFUM,COVMAT,Q(IMATR0),
- +Q(IGRADS),PARAM,Q(IDERFU),Q(IPL0),SIGPAR,Q(IPLFUM),
- +Q(IRFUM),Q(IDELPA),Q(IMAXPA),Q(IMINPA),Q(IEXDAT))
- IF(NARG.LT.8)CALL HFUMIL(UFUNC,FUMIN,NPAR,
- +ITFUM,MCFUM,Q(IMATR),Q(IMATR0),Q(IGRADS),
- +PARAM,Q(IDERFU),Q(IPL0),Q(ISIGMA),Q(IPLFUM),Q(IRFUM),
- +Q(IDELPA),Q(IMAXPA),Q(IMINPA),Q(IEXDAT))
-*
-*
- ISWTCH=NARG-3
- GO TO(36,35,35,32,35,28,28,28),ISWTCH
- 28 CONTINUE
- DO 29 I=1,NPAR
- STEP0(I)=Q(IPL0+I-1)
- 29 CONTINUE
- GO TO 35
- 32 CONTINUE
- DO 33 I=1,NPAR
- SIGPAR(I)=Q(ISIGMA+I-1)
- 33 CONTINUE
- 35 CHI2=FUMIN+FUMIN
- 36 CONTINUE
- IF(IDIMPN.EQ.3.AND.ISUPIM.EQ.2)CALL HFUNC(IDD,UFUNC)
-*
- 99 RETURN
- END
diff --git a/src/packlib/hbook/code/hfit1.F b/src/packlib/hbook/code/hfit1.F
deleted file mode 100644
index 72bf4a0..0000000
--- a/src/packlib/hbook/code/hfit1.F
+++ /dev/null
@@ -1,175 +0,0 @@
-*
-* $Id: hfit1.F,v 1.1.1.1 1996/01/16 17:07:37 mclareni Exp $
-*
-* $Log: hfit1.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:37 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.22/11 23/08/94 14.17.45 by Rene Brun
-*-- Author :
- SUBROUTINE HFIT1 (X,Y,EY,N,UFUNC,NP,PARAM,CHI2,ICONTR,SIGPAR)
-*.==========>
-*. FITS THE PARAMETRIC FUNCTION TO THE 1-DIMENSIONAL
-*. DISTRIBUTION (X,Y)
-*.
-*.
-*. INPUT X,Y = COORDINATES OF POINTS (ARRAYS
-*. OF LENGTH N)
-*. ARGUMENTS
-*. EY = ERRORS ON Y (ARRAY OF LENGTH N)
-*.
-*. N = NUMBER OF POINTS OF THE DISTRIB
-*.
-*. UFUNC = PARAMETRIC FUNCTION (EXTERNAL)
-*.
-*. NP = NUMBER OF PARAMETERS
-*.
-*. PARAM = INITIAL VALUES OF PARAMETERS(ARRAY)
-*.
-*. ICONTR = CONTROL WORD
-*. 1 - NO SUPERIMPOSING
-*. SEE REMARKS
-*.
-*. OUTPUT PARAM = FINAL VALUES OF PARAMETERS (ARRAY)
-*. ARGUMENTS
-*. CHI2 = CHISQUARE OF FIT
-*.
-*. SIGPAR = STANDARD DEVIATIONS OF PARAMETERS
-*. (ARRAY)
-*.
-*. ---------------------------REMARKS------------------------------
-*.
-*. ICONTR=M*10**6+F*100000+B*10000+D*1000+W*100+P*10+S
-*.
-*. S=1 - NO SUPERIMPOSING
-*.
-*. P=1 - PRINTS RESULTS OF THE FINAL ITERATION
-*. P>1 - PRINTS RESULTS OF ITERATIONS N*(P-1),WHERE
-*. N=0,1,2,...
-*. P=0 - SUPPRESSES INTERMEDIATE PRINTING
-*.
-*. W=0 - ERROR BARS GIVEN BY EY
-*. W=1 - ERRORS COMPUTED AS SQRT(Y)
-*.
-*. D=0 - SAVE USER"S FORCE:CALCULATES DERIVATIVES
-*. FOR PARAMETERS NUMERICALLY
-*. D=1 - REQUIRES USER ROUTINE HDERIN
-*. FOR COMPUTATION OF DERIVATIVES
-*.
-*. B=0 - ALL PARAMETERS MAY VARY FREELY
-*. B=2 - LINEAR EQUALITY CONSTRAINTS BETWEEN PARAMS
-*. - OPTION PRESENTLY INACTIVE
-*.
-*. F=0 - UNDEFINED DIGIT
-*.
-*. M=1 - DAVIDON-FLETCHER-POWELL METHOD
-*. M=0 - GAUSS-NEWTON METHOD
-*..=========> ( R.Brun, E.Lessner, D.Lienart)
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION PARAM,UFUNC,DQ
-#endif
- DIMENSION PARAM(*),SIGPAR(*),X(N),Y(N),EY(N),DQ(2)
-#include "hbook/hcfit2.inc"
-#include "hbook/hcfit3.inc"
-#include "hbook/hcfit6.inc"
-#include "hbook/hcflag.inc"
-#include "hbook/hcbook.inc"
-#include "hbook/hcunit.inc"
-#include "hbook/hcfits.inc"
- EQUIVALENCE (Q(1),DQ(1))
- EXTERNAL UFUNC
- DATA NAME/2H1 /
-*.___________________________________________
- NUMEP=N
- IHIS=0
- NX=1
- NY=N
- IFLFUN=1
- NAMFUN=NAME
- FITNAM(1)=' '
-*
- CALL HGETFL(ICONTR)
- ITPR=ITFUM
- ILICO=IFLBUF
- IF (ILICO.EQ.2) THEN
- WRITE (LOUT,'(A)') ' LINEAR EQUALITIES NOT AVAILABLE ',
- + ' IN THIS VERSION.'
- GO TO 99
- ENDIF
- IMINU=1
-*
- IDIMPN=3
- IFLSF=1
- ISUPIM=1
-*
- LEXDAT=1
- LMATR=NP*NP
- LXMATR=NX*NY
- LAHFIT=LEXDAT+2*LMATR+LXMATR+11*NP+2*NY+1
- ID=0
- CALL HWORK(LAHFIT,IBQ(1),'HFIT1 ')
- IF (IBQ(1).EQ.0) GO TO 99
-*
-* SET ADDRESSES OF WORKING VECTORS
-*
- IF ((IBQ(1)/2)*2.EQ.IBQ(1)) IBQ(1)=IBQ(1)+1
- IBQ(7)=IBQ(1)+2*LMATR+10*NP
- IBQ(1)=(IBQ(1)+1)/2
- DO 5 I=2,6
- IBQ(I)=IBQ(I-1)+NP
- 5 CONTINUE
- IBQ(8)=IBQ(7)+LXMATR
- IBQ(9)=IBQ(8)+NY
- IBQ(10)=IBQ(9)+NY
- IDERIV=IBQ(4)
- IDESUM=IBQ(5)
- ICOV=IBQ(6)
- ILXE=IBQ(7)
- ILYE=IBQ(8)
- ILEY=IBQ(9)
- IVARP=IBQ(10)
-*
- EPSW=1.E-10
- WGTMAX=0.
- DO 9 L1=1,N
- IF (ABS(Y(L1)).GT.WGTMAX) WGTMAX=ABS(Y(L1))
- 9 CONTINUE
-*
- DO 15 J=1,NY
- Q(ILXE+J-1)=X(J)
- Q(ILYE+J-1)=Y(J)
- IF(IWEIGH.EQ.0)THEN
- Q(ILEY+J-1)=EY(J)
- ELSEIF(IWEIGH.EQ.1)THEN
- Q(ILEY+J-1)=1.
- ELSEIF(IWEIGH.EQ.2)THEN
- Q(ILEY+J-1)=WGTMAX
- ELSE
- Q(ILEY+J-1)=WGTMAX/100.
- ENDIF
- 15 CONTINUE
-*
-* SET BOUNDARY SIZES FOR PARAMETERS
-*
- DO 25 I=1,NP
- DQ(IBQ(1)+I-1)=0.
- DQ(IBQ(2)+I-1)=0.
- DQ(IBQ(3)+I-1)=-1.
- 25 CONTINUE
-*
-* OTHER INITIALIZATIONS
-*
- NUP=NP
- IMAT=0
-*
- CALL HMINUI (UFUNC,PARAM,DQ(IBQ(1)),DQ(IBQ(2)),DQ(IBQ(3)),
- + DQ(ICOV),IQ(IVARP))
-*
- CHI2=CHIM
- DO 30 I=1,NUP
- SIGPAR(I)=DQ(IBQ(3)+I-1)
- 30 CONTINUE
-*
- 99 END
diff --git a/src/packlib/hbook/code/hfitex.F b/src/packlib/hbook/code/hfitex.F
deleted file mode 100644
index 1326a3c..0000000
--- a/src/packlib/hbook/code/hfitex.F
+++ /dev/null
@@ -1,69 +0,0 @@
-*
-* $Id: hfitex.F,v 1.1.1.1 1996/01/16 17:07:37 mclareni Exp $
-*
-* $Log: hfitex.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:37 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.10/05 17/08/89 08.50.24 by Rene Brun
-*-- Author :
- SUBROUTINE HFITEX(IDD,AA,BB,CHI2,ICONTR,SIGPAR)
-*.==========>
-*. Fits an exponential function
-*. E(X)=EXP(AA+BB*X)
-*. to the contents of 1-dim histogram IDD and
-*. optionally superimposes it to the histogram
-*.
-*.
-*. Input IDD = Histogram identifier
-*. arguments
-*. ICONTR = control word(see old HFITL)
-*.
-*. Output AA =
-*. arguments parameters of the exponential
-*. BB =
-*.
-*. CHI2 = chisquare of fit
-*.
-*. SIGPAR = standard deviations of parameters
-*. (array)
-*.
-*..=========> ( R.Brun,E.Lessner)
-#include "hbook/hcfit2.inc"
-#include "hbook/hcbits.inc"
-#include "hbook/hcbook.inc"
-#include "hbook/hcfits.inc"
- DIMENSION SIGPAR(2)
- EXTERNAL HDEXPO
- CHARACTER*8 CHOPT
-*.___________________________________________
- CALL HFIND(IDD,'HFITEX')
- IF(LCID.EQ.0)GO TO 99
- IF(IQ(LCONT+KNOENT).EQ.0)THEN
- CALL HBUG('Empty histogram','HFITEX',IDD)
- GO TO 99
- ENDIF
- CALL HDCOFL
- IF(I1.EQ.0.AND.LFIX.EQ.0)GO TO 99
-*
- NP=2
- FITNAM(1)='Constant'
- FITNAM(2)='Slope'
- FITNAM(3)='HFITEX'
- CALL HGETFF(ICONTR,IFLRET,CHOPT)
-*
-* Set initial values of parameters
-*
- CALL HLLSQ(-NCHANX,FITPAR(1),FITPAR(2),IFAIL)
- IF (IFAIL.NE.0) GO TO 99
-*
-* Minimization
-*
- CALL HFITH(IDD,HDEXPO,CHOPT,NP,FITPAR,STEP,PMIN,PMAX,
- + SIGPAR,CHI2)
- AA = FITPAR(1)
- BB = FITPAR(2)
-*
- 99 END
diff --git a/src/packlib/hbook/code/hfitf.F b/src/packlib/hbook/code/hfitf.F
deleted file mode 100644
index 59fb147..0000000
--- a/src/packlib/hbook/code/hfitf.F
+++ /dev/null
@@ -1,83 +0,0 @@
-*
-* $Id: hfitf.F,v 1.1.1.1 1996/01/16 17:07:37 mclareni Exp $
-*
-* $Log: hfitf.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:37 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.10/05 14/11/89 11.48.56 by Rene Brun
-*-- Author :
- SUBROUTINE HFITF(CHEX,NP)
-*.==========>
-* To decode the kind of expression to be fitted
-* Ex: G+P7 or P7*E+G
-*..=========> ( R.Brun)
-*
-#include "hbook/hcfitf.inc"
- COMMON /QUEST/ IQUEST(100)
- CHARACTER*(*) CHEX
- CHARACTER*32 CHEXP
- DIMENSION ITOK(11)
-*.___________________________________________
- CHEXP=CHEX
- CALL CLTOU(CHEXP)
- NCH=LENOCC(CHEXP)
- CALL VZERO(LOPER,3*MAXOP)
-*
-* Scan for delimiters
-*
- NP=0
- NOPER=1
- ITOK(1)=0
- LOPER(1)=1
- DO 10 I=1,NCH
- IF(NOPER.GE.MAXOP)GO TO 10
- IF(CHEXP(I:I).EQ.'+')THEN
- NOPER=NOPER+1
- ITOK(NOPER)=I
- LOPER(NOPER)=1
- GO TO 10
- ENDIF
- IF(CHEXP(I:I).EQ.'*')THEN
- NOPER=NOPER+1
- ITOK(NOPER)=I
- LOPER(NOPER)=2
- ENDIF
- 10 CONTINUE
- ITOK(NOPER+1)=NCH+1
-*
- DO 30 I=1,NOPER
- IK1=ITOK(I)+1
- IK2=ITOK(I+1)-1
- IF(IK2.LT.IK1)GO TO 90
- IGAUS=INDEX(CHEXP(IK1:IK1),'G')
- IF(IGAUS.NE.0)THEN
- IFTYPE(I)=1
- NPF(I)=3
- ENDIF
- IEXPO=INDEX(CHEXP(IK1:IK1),'E')
- IF(IEXPO.NE.0)THEN
- IFTYPE(I)=2
- NPF(I)=2
- ENDIF
- IPOLY=INDEX(CHEXP(IK1:IK1),'P')
- IF(IPOLY.NE.0)THEN
- NPOL=1
- CALL HICTOI(CHEXP(IK1+1:IK2),NPOL)
- IF(IQUEST(1).NE.0)GO TO 90
- IFTYPE(I)=3
- NPF(I)=NPOL+1
- ENDIF
- IF(IFTYPE(I).EQ.0)GO TO 90
- NP=NP+NPF(I)
- 30 CONTINUE
- GO TO 99
-*
-* Error
-*
- 90 CALL HBUG('Invalid expression','HFITHN',0)
- NOPER=0
-*
- 99 END
diff --git a/src/packlib/hbook/code/hfitga.F b/src/packlib/hbook/code/hfitga.F
deleted file mode 100644
index 5bbadfa..0000000
--- a/src/packlib/hbook/code/hfitga.F
+++ /dev/null
@@ -1,81 +0,0 @@
-*
-* $Id: hfitga.F,v 1.1.1.1 1996/01/16 17:07:37 mclareni Exp $
-*
-* $Log: hfitga.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:37 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 27/07/95 16.15.05 by Julian Bunn
-*-- Author :
- SUBROUTINE HFITGA(IDD,COEFF,AVERAG,SIGM,CHI2,ICONTR,SIGPAR)
-*.==========>
-*. Fits a gaussian
-*. G(X)=COEFF*EXP(-0.5*((X-AVERAG)/SIGM)**2)
-*. to the contents of 1-dim histogram IDD and
-*. optionally superimposes it to the histogram
-*.
-*.
-*. Input IDD = histogram identifier
-*. arguments
-*. ICONTR = control word
-*.
-*. Output COEFF =
-*. arguments
-*. AVERAG = parameters of the gaussian
-*.
-*. SIGM =
-*.
-*. CHI2 = chisquare of fit
-*.
-*. SIGPAR = standard deviations of parameters
-*. (array)
-*.
-*..=========> ( R.Brun,E.Lessner)
-*
-#include "hbook/hcfit2.inc"
-#include "hbook/hcbits.inc"
-#include "hbook/hcbook.inc"
-#include "hbook/hcfits.inc"
- DIMENSION SIGPAR(3),STEP(3),PMIN(3),PMAX(3)
- EXTERNAL HGAUS
- CHARACTER*8 CHOPT
- DATA SQRT2P /2.506628/
-*.___________________________________________
-*
-C Does the min value for par(3) need to be set to zero ??
- CALL HFIND(IDD,'HFITGA')
- IF(LCID.EQ.0)GO TO 99
- IF(IQ(LCONT+KNOENT).EQ.0)THEN
- CALL HBUG('Empty histogram','HFITGA',IDD)
- GO TO 99
- ENDIF
- CALL HDCOFL
- IF(I1.EQ.0.AND.LFIX.EQ.0)GO TO 99
-*
- NP=3
- FITNAM(1)='Constant'
- FITNAM(2)='Mean'
- FITNAM(3)='Sigma'
- FITNAM(4)='HFITGA'
- CALL HGETFF(ICONTR,IFLRET,CHOPT)
-*
-* Set initial values of parameters
-*
- FITPAR(2)=HSTATI (IDD,1,'HIST',1)
- FITPAR(3)=HSTATI (IDD,2,'HIST',1)
- IF (FITPAR(3).EQ.0.) THEN
- FITPAR(3)=BINWID*NCHANX*0.25
- END IF
- FITPAR(1)=BINWID*ALLCHA/(SQRT2P*FITPAR(3))
-*
-* Minimization
-*
- CALL HFITH(IDD,HGAUS,CHOPT,NP,FITPAR,STEP,PMIN,PMAX,
- + SIGPAR,CHI2)
- COEFF = FITPAR(1)
- AVERAG= FITPAR(2)
- SIGM = FITPAR(3)
-*
- 99 END
diff --git a/src/packlib/hbook/code/hfith.F b/src/packlib/hbook/code/hfith.F
deleted file mode 100644
index 9898a58..0000000
--- a/src/packlib/hbook/code/hfith.F
+++ /dev/null
@@ -1,250 +0,0 @@
-*
-* $Id: hfith.F,v 1.1.1.1 1996/01/16 17:07:37 mclareni Exp $
-*
-* $Log: hfith.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:37 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.23/01 20/02/95 09.40.57 by Julian Bunn
-*-- Author :
- SUBROUTINE HFITH (IDD,UFUNC,CHOPT,NP,PARAM,STEP,PMIN,PMAX,SIGPAR
- + ,CHI2)
-*.==========>
-*.
-*. Fits the parametric function to the contents of the
-*. 1- or 2-dimensional histogram IDD,and optionally super-
-*. imposes it to the 1-dimensional histogram when editing
-*.
-*.
-*. Input IDD = histogram identifier
-*. arguments
-*. UFUNC = Parametric function (EXTERNAL)
-*.
-*. CHOPT = Character string for options
-*.
-*. NP = Number of parameters
-*.
-*. PARAM = Initial values of parameters(array)
-*.
-*. STEP = initial step sizes for parameters
-*. search (array)
-*.
-*. PMIN = Lower parameter bounds (array)
-*. PMAX = Upper
-*.
-*. Output PARAM = Final values of parameters (array)
-*. arguments
-*. SIGPAR = Standard deviations of parameters
-*. (array)
-*. CHI2 = Chisquare of fit
-*.
-*.
-*.
-*. ---------------------------REMARKS------------------------------
-*.
-*. CHOPT : Possible options 'RQVNFBMLDWTE'
-*.
-*. 'R' Fit a Restricted area of the histogram - 1-D only.
-*. IFXLOW = IQUEST(11)
-*. IFYUP = IQUEST(12)
-*. IFYLOW = IQUEST(13)
-*. IFYUP = IQUEST(14)
-*.
-*. 'Q' Quiet mode. No print
-* . 'V' Verbode mode. Results after each iteration are printed
-*. By default only final results are printed.
-*.
-*. 'N' Do not store the result of the fit bin by bin with the histogram.
-*. By default, for 1-D, the function is calculated at the centre of
-*. each bin in the specified range and stored.
-*.
-*. 'F' Force storing of the result of the fit bin by bin with the
-*. histogram for any-dimension histogram.
-*.
-*. 'B' Some or all parameters are bounded. The array STEP,PMIN,PMAX
-*. must be specified.
-*. Default is: All parameters vary freely.
-*.
-*. 'M' Interactive Minuit is invoked.
-*.
-*. 'L' Use Log Likelihood.
-*. Default is chisquare method.
-*.
-*. 'D' The user is assumed to compute derivatives analytically
-*. using the routine HDERIV.
-*. By default, derivatives are computed numerically.
-*.
-*. 'W' Sets weights equal to 1 for the chisquare method.
-*. By default, weights are taken following statistical errors.
-*. If the 'L' option is given (Log Likelihood), bins with errors=0
-*. are excluded of the fit.
-*.
-*. 'T' HFITH is being called by another HBOOK routine
-*. In this case takes parameter names from HCFITS.
-*.
-*. 'E' Performs a better error evaluation, calling HESSE and MINOS
-*.
-*. 'U' User function value is taken from /HCFITD/FITPAD(24),FITFUN
-*.
-*. 'K' Do not reset the Application Hminuit settings for option 'M'
-*.
-*..=========> ( R.Brun ,E.Lessner)
-*
-#include "hbook/hcfit2.inc"
-#include "hbook/hcflag.inc"
-#include "hbook/hcbits.inc"
-#include "hbook/hcbook.inc"
-#include "hbook/hcfitr.inc"
-#include "hbook/hcfits.inc"
- COMMON/QUEST/IQUEST(100)
- PARAMETER(MAXPAR=34)
- DIMENSION PARAM(*),SIGPAR(*),STEP(*),PMIN(*),PMAX(*)
- DIMENSION STE(MAXPAR),PMI(MAXPAR),PMA(MAXPAR)
- DIMENSION IOPT(13)
- EQUIVALENCE (IOPTQ,IOPT(1)),(IOPTV,IOPT(2))
- EQUIVALENCE (IOPTB,IOPT(3)),(IOPTL,IOPT(4))
- EQUIVALENCE (IOPTD,IOPT(5)),(IOPTW,IOPT(6))
- EQUIVALENCE (IOPTR,IOPT(7)),(IOPTN,IOPT(8))
- EQUIVALENCE (IOPTT,IOPT(9)),(IOPTE,IOPT(10))
- EQUIVALENCE (IOPTM,IOPT(11)),(IOPTU,IOPT(12))
- EQUIVALENCE (IOPTF,IOPT(13))
- EXTERNAL UFUNC,HFCNH
- CHARACTER*(*) CHOPT
-*.___________________________________________
- CALL HUOPTC(CHOPT,'QVBLDWRNTEMUF',IOPT)
-*
-* Skip this part if HFITH called by another routine
-*
- NDIM=1
- IF(IOPTT.EQ.0)THEN
- IF(NP.LE.0.OR.NP.GT.MAXPAR)THEN
- CALL HBUG('Wrong number of parameters','HFITH',IDD)
- GO TO 999
- ENDIF
- CALL HFIND(IDD,'HFITH ')
- IF(LCID.EQ.0)GO TO 999
- IF(IQ(LCONT+KNOENT).EQ.0)THEN
- CALL HBUG('Empty histogram','HFITH',IDD)
- GO TO 999
- ENDIF
- CALL HDCOFL
-*
- FITNAM(1) = ' '
- FITNAM(NP+1)= 'HFITH'
-*
- NDIM=1
- IF(I1.EQ.0)THEN
- IF(LCONT.EQ.LQ(LCID-1)) NDIM=2
- ENDIF
- ENDIF
-*
- IDIMPN=2+NDIM
- IFLSF = 0
- IDER = IOPTD
- IWEIGH= IOPTW
- ITFUM = 0
- IF(IOPTQ.NE.0)ITFUM=-1
- IF(IOPTV.NE.0)ITFUM=1
- LINEAR=IOPTL
-*
- BINWID=(Q(LPRX+2)-Q(LPRX+1))/FLOAT(IQ(LPRX))
- IF(IOPTR.NE.0)THEN
- IFTRNG=1
- IFXLOW=IQUEST(11)
- IFXUP =IQUEST(12)
- ICX1=IFXLOW
- IF(IFXUP.GT.IQ(LPRX))IFXUP=IQ(LPRX)
- ICX2=IFXUP
- NCHANX=ICX2-ICX1+1
- XMIN=Q(LPRX+1)+(ICX1-1)*BINWID
- ELSE
- IFTRNG=0
- NCHANX=IQ(LPRX)
- ICX1=1
- ICX2=NCHANX
- XMIN=Q(LPRX+1)
- ENDIF
- NCHANY=1
- ICY1=1
- ICY2=1
- IF(IDIMPN.NE.3)THEN
- BINWIY=(Q(LPRY+2)-Q(LPRY+1))/FLOAT(IQ(LPRY))
- IF(IOPTR.NE.0)THEN
- IFYLOW=IQUEST(13)
- IFYUP =IQUEST(14)
- ICY1=IFYLOW
- IF(IFYUP.GT.IQ(LPRY))IFYUP=IQ(LPRY)
- ICY2=IFYUP
- NCHANY=ICY2-ICY1+1
- YMIN=Q(LPRY+1)+(ICY1-1)*BINWIY
- ELSE
- NCHANY=IQ(LPRY)
- ICY1=1
- ICY2=NCHANY
- YMIN=Q(LPRY+1)
- ENDIF
- ENDIF
- NUMEP=NCHANX*NCHANY
-*
-*
-* Computes ALLCHA and WGTMAX
-*
- ALLCHA=0.
- WGTMAX=0.
- DO 20 J=ICY1,ICY2
- DO 10 I=ICX1,ICX2
- IF(IDIMPN.EQ.3)CONTEN=HCX(I,1)
- IF(IDIMPN.EQ.4)CONTEN=HCXY(I,J,1)
- IF(CONTEN.LT.0.AND.LQ(LCONT).EQ.0)IWEIGH=1
- IF(ABS(CONTEN).GT.WGTMAX)WGTMAX=ABS(CONTEN)
- ALLCHA=ALLCHA+CONTEN
- 10 CONTINUE
- 20 CONTINUE
-*
- IF(WGTMAX.EQ.0)THEN
- CALL HBUG('Empty histogram','HFITH',ID)
- GO TO 999
- ENDIF
-*
-* Create bank for function values
-*
- IF(IDIMPN.EQ.3)THEN
- CALL HSUPIS(UFUNC,0,ICX1,ICX2)
- IF(IOPTN.EQ.0)CALL HSUPIS(UFUNC,1,ICX1,ICX2)
- ENDIF
-*
-* Set boundary sizes for parameters
-*
- DO 30 I=1,NP
- IF (IOPTB.EQ.0) THEN
- PMI(I)=0.
- PMA(I)=0.
- STE(I)=-1.
- ELSE
- PMI(I)=PMIN(I)
- PMA(I)=PMAX(I)
- STE(I)=STEP(I)
- END IF
- 30 CONTINUE
-*
-* Perform minimization
-*
- NFPAR=NP
- CALL HMINUT (HFCNH,UFUNC,PARAM,STE,PMI,PMA,CHOPT)
-*
- IFTRNG=0
- CHI2=FITCHI
- DO 40 I=1,NFPAR
- SIGPAR(I)=STE(I)
- 40 CONTINUE
- IF(FITNAM(NP+1).EQ.'HFITGA')FITPAR(3)=ABS(FITPAR(3))
-*
- IF(IOPTN.EQ.0)THEN
- CALL HSUPIS(UFUNC,2,ICX1,ICX2)
- ELSEIF(IOPTF.EQ.0)THEN
- CALL HSUPIS(UFUNC,3,ICX1,ICX2)
- ENDIF
-*
- 999 END
diff --git a/src/packlib/hbook/code/hfith1.F b/src/packlib/hbook/code/hfith1.F
deleted file mode 100644
index f34e133..0000000
--- a/src/packlib/hbook/code/hfith1.F
+++ /dev/null
@@ -1,83 +0,0 @@
-*
-* $Id: hfith1.F,v 1.1.1.1 1996/01/16 17:07:37 mclareni Exp $
-*
-* $Log: hfith1.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:37 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.23/01 20/02/95 09.41.22 by Julian Bunn
-*-- Author :
- SUBROUTINE HFITH1(EXDA,ICELL)
-*.==========>
-*. Gets histogram bin/cell content into EXDA
-*..=========> ( I.Ivanchenko )
-#include "hbook/hcbook.inc"
-#include "hbook/hcbits.inc"
-#include "hbook/hcfit2.inc"
-#include "hbook/hcfitr.inc"
- DIMENSION EXDA(4)
-*.___________________________________________
-*
- ICHANX=MOD(ICELL,NCHANX)
- IF(ICHANX.EQ.0)ICHANX=NCHANX
- RCHANX=ICHANX
- ICHX=ICHANX
- IF(IFTRNG.NE.0)THEN
- ICHANX=ICHANX+IFXLOW-1
- ENDIF
-*
- IF(IDIMPN.EQ.3)THEN
- EXDA(1)=HCX(ICHANX,1)
- IF(I6.EQ.0)THEN
- EXDA(3)=XMIN+(RCHANX-0.5)*BINWID
- ELSE
- LBINS=LQ(LCID-2)
- EXDA(3)=0.5*(Q(LBINS+ICHANX)+Q(LBINS+ICHANX+1))
- ENDIF
- ELSE
- ICHANY=(ICELL-ICHX)/NCHANX+1
- RCHANY=ICHANY
- IF(IFTRNG.NE.0)THEN
- ICHANY=ICHANY+IFYLOW-1
- ENDIF
- EXDA(1)=HCXY(ICHANX,ICHANY,1)
- EXDA(3)=XMIN+(RCHANX-0.5)*BINWID
- EXDA(4)=YMIN+(RCHANY-0.5)*BINWIY
- ENDIF
-*
-* Check if there are error bars
-*
- IF(IWEIGH.NE.0)THEN
- IF(IWEIGH.EQ.1)THEN
- IF(EXDA(1).NE.0.)THEN
- EXDA(2)=1.
- ELSE
- EXDA(2)=0.
- ENDIF
- ELSEIF(IWEIGH.EQ.2)THEN
- EXDA(2)=1.
- ELSE
- EXDA(2)=WGTMAX
- ENDIF
- GO TO 99
- ENDIF
-*
- IF(LQ(LCONT).EQ.0)THEN
- EXDA(2)=SQRT(ABS(EXDA(1)))
- ELSE
- IF(IDIMPN.EQ.3)THEN
- EXDA(2)=HCX(ICHANX,2)
- ELSE
- LW=LQ(LCONT)
- EXDA(2)=SQRT(ABS(Q(LW+ICELL)))
- ENDIF
- ENDIF
- IF(EXDA(2).EQ.0.)THEN
- EXDA(2)=ABS(EXDA(1))
- IF(EXDA(2).EQ.0.)GO TO 99
- ENDIF
-*
- 99 RETURN
- END
diff --git a/src/packlib/hbook/code/hfithc.F b/src/packlib/hbook/code/hfithc.F
deleted file mode 100644
index 3fe49ca..0000000
--- a/src/packlib/hbook/code/hfithc.F
+++ /dev/null
@@ -1,60 +0,0 @@
-*
-* $Id: hfithc.F,v 1.1.1.1 1996/01/16 17:07:37 mclareni Exp $
-*
-* $Log: hfithc.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:37 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.22/05 16/06/94 15.43.29 by Rene Brun
-*-- Author :
- FUNCTION HFITHC(XX)
-*.==========>
-* Evaluates fitting function for combinations
-* of simple expressions
-*..=========> ( R.Brun)
-#include "hbook/hcfitf.inc"
-#include "hbook/hcfitd.inc"
-#if !defined(CERNLIB_DOUBLE)
- DIMENSION F(10)
-#endif
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION F(10)
- DOUBLE PRECISION HF,X
-#endif
-*.___________________________________________
- X=XX
- IPAR=0
- DO 20 I=1,NOPER
- IF(IFTYPE(I).EQ.1)THEN
- IF(FITPAD(IPAR+3).EQ.0.0)FITPAD(IPAR+3)=1.
- F(I)=FITPAD(IPAR+1)*EXP(-0.5*((X-FITPAD(IPAR+2))
- + /FITPAD(IPAR+3))**2)
- IPAR=IPAR+3
- ELSEIF(IFTYPE(I).EQ.2)THEN
- F(I)=EXP(FITPAD(IPAR+1)+X*FITPAD(IPAR+2))
- IPAR=IPAR+2
- ELSE
- F(I)=FITPAD(IPAR+1)
- DO 10 J=2,NPF(I)
- F(I)=F(I)+FITPAD(IPAR+J)*X**(J-1)
- 10 CONTINUE
- IPAR=IPAR+NPF(I)
- ENDIF
- 20 CONTINUE
-*
- DO 30 I=2,NOPER
- IF(LOPER(I).EQ.2)THEN
- F(I)=F(I)*F(I-1)
- F(I-1)=0.
- ENDIF
- 30 CONTINUE
- HF=0.
- DO 40 I=1,NOPER
- HF=HF+F(I)
- 40 CONTINUE
- FITFUN=HF
- HFITHC=HF
- END
-
diff --git a/src/packlib/hbook/code/hfithn.F b/src/packlib/hbook/code/hfithn.F
deleted file mode 100644
index 6351823..0000000
--- a/src/packlib/hbook/code/hfithn.F
+++ /dev/null
@@ -1,135 +0,0 @@
-*
-* $Id: hfithn.F,v 1.1.1.1 1996/01/16 17:07:37 mclareni Exp $
-*
-* $Log: hfithn.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:37 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.19/00 28/04/93 11.39.30 by Rene Brun
-*-- Author :
- SUBROUTINE HFITHN(ID,CUFUNC,CHOPT,NPP,PARAM,STEP,PMIN,PMAX,SIGPAR
- + ,CHI2)
-*.==========>
-*.
-*. Fits the parametric function to the contents of the
-*. 1- or 2-dimensional histogram IDD,and optionally super-
-*. imposes it to the 1-dimensional histogram when editing
-*.
-*.
-*. Input IDD = histogram identifier
-*. arguments
-*. CUFUNC = Parametric function (CHARACTER)
-*.
-*. CHOPT = Character string for options
-*.
-*. NP = Number of parameters
-*.
-*. PARAM = Initial values of parameters(array)
-*.
-*. STEP = initial step sizes for parameters
-*. search (array)
-*.
-*. PMIN = Lower parameter bounds (array)
-*. PMAX = Upper
-*.
-*. Output PARAM = Final values of parameters (array)
-*. arguments
-*. SIGPAR = Standard deviations of parameters
-*. (array)
-*. CHI2 = Chisquare of fit
-*.
-*.
-*.
-*. ---------------------------REMARKS------------------------------
-*.
-*. CHOPT : Possible options 'RQVNBLDW'
-*.
-*. 'R' Fit a Restricted area of the histogram
-*. IFXLOW = IQUEST(11)
-*. IFXUP = IQUEST(12)
-*. IFYLOW = IQUEST(13)
-*. IFYUP = IQUEST(14)
-*.
-*. 'Q' Quiet mode. No print
-* . 'V' Verbode mode. Results after each iteration are printed
-*. By default only final results are printed.
-*.
-*. 'N' Do not store the result of the fit bin by bin with the histogram.
-*. By default the function is calculated at the centre of each bin
-*. in the specified range.
-*.
-*. 'B' Some or all parameters are bounded. The array STEP,PMIN,PMAX
-*. must be specified.
-*. Default is: All parameters vary freely.
-*.
-*. 'M' Interactive Minuit is invoked.
-*.
-*. 'L' Use Log Likelihood.
-*. Default is chisquare method.
-*.
-*. 'D' The user is assumed to compute derivatives analytically
-*. using the routine HDERIV.
-*. By default, derivatives are computed numerically.
-*.
-*. 'W' Sets weights equal to 1.
-*. By default, weights are taken following statistical errors.
-*.
-*. 'T' HFITHN is being called by another HBOOK routine
-*. In this case takes parameter names from HCFITS.
-*.
-*. 'U' User function value is taken from /HCFITD/FITPAD(24),FITFUN
-*.
-*..=========> ( R.Brun)
-*
-#include "hbook/hcfitf.inc"
- COMMON/PAWPAR/PAR(200)
- DIMENSION PARAM(*),SIGPAR(*),STEP(*),PMIN(*),PMAX(*)
- DIMENSION IOPT(13)
- EQUIVALENCE (IOPTQ,IOPT(1)),(IOPTV,IOPT(2))
- EQUIVALENCE (IOPTB,IOPT(3)),(IOPTL,IOPT(4))
- EQUIVALENCE (IOPTD,IOPT(5)),(IOPTW,IOPT(6))
- EQUIVALENCE (IOPTR,IOPT(7)),(IOPTN,IOPT(8))
- EQUIVALENCE (IOPTT,IOPT(9)),(IOPTM,IOPT(10))
- EQUIVALENCE (IOPTF,IOPT(11))
- CHARACTER*(*) CHOPT,CUFUNC
- EXTERNAL HFITHC
-*.___________________________________________
- CALL HUOPTC(CHOPT,'QVBLDWRNTEMUF',IOPT)
-*
- NOPER=0
- CALL HFITF(CUFUNC,NP)
- IF(NOPER.EQ.0)GO TO 99
- IF(NOPER.EQ.1)THEN
- IC=12
- IF(IOPTN.NE.0)IC=IC-2
- IF(IOPTV.NE.0)IOPTQ=0
- IF(IOPTV.NE.0)IC=IC+10
- IF(IOPTQ.NE.0)IC=IC-10
- IF(IOPTW.NE.0)IC=IC+100
- IF(IOPTM.NE.0)IC=IC+10000
- IF(IOPTR.NE.0)IC=IC+100000
- IF(IOPTL.NE.0)IC=IC+1000000
- ENDIF
- IF(NOPER.GT.1.OR.NPP.EQ.NP)THEN
- DO 10 I=1,NP
- PAR(I)=PARAM(I)
- 10 CONTINUE
- CALL HFITH(ID,HFITHC,CHOPT,NP,PAR,STEP,PMIN,PMAX,
- + SIGPAR,CHI2)
- ELSE
- IF(IFTYPE(1).EQ.1)THEN
- CALL HFITGA(ID,PAR(1),PAR(2),PAR(3),CHI2,IC,SIGPAR)
- ELSEIF(IFTYPE(1).EQ.2)THEN
- CALL HFITEX(ID,PAR(1),PAR(2),CHI2,IC,SIGPAR)
- ELSEIF(IFTYPE(1).EQ.3)THEN
- CALL HFITPO(ID,NP,PAR,CHI2,IC,SIGPAR)
- ENDIF
- ENDIF
-*
- DO 20 I=1,NP
- PARAM(I)=PAR(I)
- 20 CONTINUE
-*
- 99 END
diff --git a/src/packlib/hbook/code/hfitl.F b/src/packlib/hbook/code/hfitl.F
deleted file mode 100644
index cef7b68..0000000
--- a/src/packlib/hbook/code/hfitl.F
+++ /dev/null
@@ -1,224 +0,0 @@
-*
-* $Id: hfitl.F,v 1.1.1.1 1996/01/16 17:07:37 mclareni Exp $
-*
-* $Log: hfitl.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:37 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.22/11 23/08/94 14.17.45 by Rene Brun
-*-- Author :
- SUBROUTINE HFITL (IDD,UFUNC,NP,PARAM,CHI2,ICONTR,SIGPAR,COVMAT,
- +STEP0,PARMIN,PARMAX)
-*.==========>
-*. NEW FITTING PACKAGE - AUTHORS: E.LESSNER, D.LIENART
-*.
-*. FITS THE PARAMETRIC FUNCTION TO THE CONTENTS OF THE
-*. 1- OR 2-DIMENSIONAL HISTOGRAM IDD,AND OPTIONALLY SUPER-
-*. IMPOSES IT TO THE 1-DIMENSIONAL HISTOGRAM WHEN EDITING
-*.
-*.
-*. INPUT IDD = HISTOGRAM IDENTIFIER
-*. ARGUMENTS
-*. UFUNC = PARAMETRIC FUNCTION (EXTERNAL)
-*.
-*. NP = NUMBER OF PARAMETERS
-*.
-*. PARAM = INITIAL VALUES OF PARAMETERS(ARRAY)
-*.
-*. ICONTR = CONTROL WORD
-*. 1 - NO SUPERIMPOSING
-*. 2 - FITTED FUNCTION IS SUPER-
-*. IMPOSED TO HISTOGRAM
-*.
-*. STEP0 = INITIAL STEP SIZES FOR PARAMETERS
-*. SEARCH (ARRAY)
-*.
-*. PARMIN = LOWER
-*. PARAMETER BOUNDS (ARRAY)
-*. PARMAX = UPPER
-*. (0. IF UNBOUNDED) *
-*.
-*. OUTPUT PARAM = FINAL VALUES OF PARAMETERS (ARRAY)
-*. ARGUMENTS
-*. CHI2 = CHISQUARE OF FIT
-*.
-*. SIGPAR = STANDARD DEVIATIONS OF PARAMETERS
-*. (ARRAY)
-*.
-*. COVMAT = COVARIANCE MATRIX OF PARAMETERS
-*. (ARRAY L=NPAR*(NPAR+1)/2)
-*.
-*.
-*. ---------------------------REMARKS------------------------------
-*.
-*. ICONTR=M*10**6+F*100000+B*10000+D*1000+W*100+P*10+S
-*.
-*. S=2 - SUPERIMPOSES FUNCTION TO HISTOGRAM
-*. S=1 - NO SUPERIMPOSING
-*.
-*. P=1 - PRINTS RESULTS OF THE FINAL ITERATION
-*. P>1 - PRINTS RESULTS OF ITERATIONS N*(P-1),WHERE
-*. N=0,1,2,...
-*. P=0 - SUPPRESSES INTERMEDIATE PRINTING
-*.
-*. W=1 - SETS WEIGHTS EQUAL TO 1.
-*. W=0 -CALCULATES ERROR BAR E=SQRT(CONTENTS)
-*. AND SETS THE WEIGHT EQUAL TO 1./E**2
-*. HOWEVER IF ERROR BARS ARE AVAILABLE (E.G.AFTER CALL TO
-*. HBARX OR HPAKE)THEY ARE USED FOR SETTING OF THE WEIGHTS
-*.
-*. D=0 - SAVE USER"S FORCE:CALCULATES DERIVATIVES
-*. FOR PARAMETERS NUMERICALLY
-*. D=1 - REQUIRES USER ROUTINE HDERI2(2-DIM)
-*. HDERI1(OTHERWISE) FOR COMPUTATION
-*. OF DERIVATIVES
-*.
-*. B=0 - ALL PARAMETERS MAY VARY FREELY
-*. B=1 - SOME OR ALL PARAMETERS ARE BOUNDED
-*. B=2 - LINEAR EQUALITY CONSTRAINTS BETWEEN PARAMS
-*. - OPTION PRESENTLY INACTIVE
-*.
-*. F>0 - SPECIAL FORMAT:DATA SET FOR F VARIABLES
-*. (C,SIGMAC,X1,...,XF)
-*. F=0 - USUAL FORMAT OF HISTOGRAMS
-*.
-*. M=1 - DAVIDON-FLETCHER-POWELL METHOD
-*. M=0 - GAUSS-NEWTON METHOD
-*..=========> ( R.Brun ,E.Lessner,D.Lienart)
- DIMENSION PARAM(*),SIGPAR(*),COVMAT(*),STEP0(*),PARMIN(*),
- + PARMAX(*),NCHAN(2),DQ(2)
-*
-#include "hbook/hcfit2.inc"
-#include "hbook/hcfit3.inc"
-#include "hbook/hcfit6.inc"
-#include "hbook/hcflag.inc"
-#include "hbook/hcbits.inc"
-#include "hbook/hcbook.inc"
-#include "hbook/hcunit.inc"
-#include "hbook/hcfits.inc"
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION PARAM,DQ,UFUNC
-#endif
- EQUIVALENCE (Q(1),DQ(1))
- EXTERNAL UFUNC
- DATA NAME/2HL /
-*.___________________________________________
- CALL HFIND(IDD,'HFITL ')
- IF(LCID.EQ.0)GO TO 99
- IF(IQ(LCONT+KNOENT).EQ.0)THEN
- CALL HBUG('Empty histogram','HFITL',IDD)
- GO TO 99
- ENDIF
- CALL HDCOFL
-*
- NDIM=1
- NCHAN(1)=IQ(LPRX)
- IF(I1.EQ.0)THEN
- IF(LCONT.EQ.LQ(LCID-1))THEN
- NDIM=2
- NCHAN(2)=IQ(LPRY)
- ENDIF
- ENDIF
-*
- FITNAM(1)=' '
- IDIMPN=2+NDIM
- IHIS=1
- NX=1
- NY=1
- IFLFUN=1
- NAMFUN=NAME
- CALL HGETFL(ICONTR)
- ITPR=ITFUM
- ILICO=IFLBUF
- IF (ILICO.EQ.2) THEN
- WRITE (LOUT,'(A)') ' LINEAR EQUALITIES NOT AVAILABLE ',
- + ' IN THIS VERSION.'
- GO TO 99
- ENDIF
- IMINU=1
-*
- NV=1
- IF(IDIMPN.EQ.3.AND.ISUPIM.EQ.2)CALL HSUPIM(UFUNC)
- NV=2
-*
- LEXDAT=IDIMPN
- LMATR=NP*NP
- LXMATR=NX*NY
- LAHFIT=LEXDAT+2*LMATR+LXMATR+11*NP+2*NY+1
- CALL HWORK(LAHFIT,IBQ(1),'HFITL ')
- IF (IBQ(1).EQ.0) GO TO 99
-*
- CALL HHIPAR (IFLRET)
- IF (IFLRET.EQ.0) GOTO 99
-*
-* SET ADDRESSES OF WORKING VECTORS
-*
- IF ((IBQ(1)/2)*2.EQ.IBQ(1)) IBQ(1)=IBQ(1)+1
- IBQ(7)=IBQ(1)+2*LMATR+10*NP
- IBQ(1)=(IBQ(1)+1)/2
- DO 5 I=2,6
- IBQ(I)=IBQ(I-1)+NP
- 5 CONTINUE
- IBQ(8)=IBQ(7)+LXMATR
- IBQ(9)=IBQ(8)+NY
- IBQ(10)=IBQ(9)+NY
- IDERIV=IBQ(4)
- IDESUM=IBQ(5)
- ICOV=IBQ(6)
- ILXE=IBQ(7)
- ILYE=IBQ(8)
- ILEY=IBQ(9)
- IVARP=IBQ(10)
-*
-* SET BOUNDARY SIZES FOR PARAMETERS
-*
- DO 25 I=1,NP
- IF (ILICO.NE.1.OR.PARMIN(I).GT.PARMAX(I)) THEN
- DQ(IBQ(1)+I-1)=0.
- DQ(IBQ(2)+I-1)=0.
- ELSE
- DQ(IBQ(1)+I-1)=PARMIN(I)
- DQ(IBQ(2)+I-1)=PARMAX(I)
- END IF
- DQ(IBQ(3)+I-1)=STEP0(I)
- 25 CONTINUE
-*
-* OTHER INITIALIZATIONS
-*
- NUP=NP
- IMAT=1
-*
- CALL HMINUI (UFUNC,PARAM,DQ(IBQ(1)),DQ(IBQ(2)),DQ(IBQ(3)),
- + DQ(ICOV),IQ(IVARP))
-*
- CHI2=CHIM
- DO 30 I=1,NUP
- SIGPAR(I)=DQ(IBQ(3)+I-1)
- 30 CONTINUE
-*
- IF (ICSTAT.GT.0) THEN
- KFIX=0
- K=0
- DO 40 I=1,NUP
- LC=IQ(IVARP+I-1)
- IF (LC.LE.0) KFIX=KFIX+1
- INTI=I-KFIX
- INTJ=0
- DO 35 J=1,I
- K=K+1
- LCC=IQ(IVARP+J-1)
- IF (LC.LE.0.OR.LCC.LE.0) THEN
- COVMAT(K)=0.
- ELSE
- INTJ=INTJ+1
- COVMAT(K)=DQ(ICOV+NUP*(INTI-1)+(INTJ-1))
- ENDIF
- 35 CONTINUE
- 40 CONTINUE
- ENDIF
-*
- IF(IDIMPN.EQ.3.AND.ISUPIM.EQ.2)CALL HSUPIM(UFUNC)
-*
- 99 END
diff --git a/src/packlib/hbook/code/hfitn.F b/src/packlib/hbook/code/hfitn.F
deleted file mode 100644
index 706ed60..0000000
--- a/src/packlib/hbook/code/hfitn.F
+++ /dev/null
@@ -1,225 +0,0 @@
-*
-* $Id: hfitn.F,v 1.1.1.1 1996/01/16 17:07:37 mclareni Exp $
-*
-* $Log: hfitn.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:37 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.22/11 23/08/94 14.17.45 by Rene Brun
-*-- Author :
- SUBROUTINE HFITN (X,Y,EY,N,NDIM,NVAR,UFUNC,NP,PARAM,CHI2,ICONTR,
- +SIGPAR,COVMAT,STEP0,PARMIN,PARMAX)
-*.==========>
-*. FITS THE PARAMETRIC FUNCTION TO THE N-DIMENSIONAL
-*. DISTRIBUTION (X,Y) (SEE HFITL ALSO)
-*.
-*.
-*. INPUT X,Y = COORDINATES OF POINTS (X= 2-DIM
-*. ARRAY OF SIZE N*NDIM, Y= ARRAY
-*. OF LENGTH N)
-*. ARGUMENTS
-*. EY = ERRORS ON Y (ARRAY OF LENGTH N)
-*.
-*. N = NUMBER OF POINTS OF THE DISTRIB
-*.
-*. NDIM = DECLARED FIRST DIMENSION OF X
-*. NVAR = DIMENSION OF THE DISTRIBUTION
-*.
-*. UFUNC = PARAMETRIC FUNCTION (EXTERNAL)
-*.
-*. NP = NUMBER OF PARAMETERS
-*.
-*. PARAM = INITIAL VALUES OF PARAMETERS(ARRAY)
-*.
-*. ICONTR = CONTROL WORD
-*. 1 - NO SUPERIMPOSING
-*. SEE REMARKS
-*.
-*. STEP0 = INITIAL STEP SIZES FOR PARAMETERS
-*. SEARCH (ARRAY)
-*.
-*. PARMIN = LOWER
-*. PARAMETER BOUNDS (ARRAY)
-*. PARMAX = UPPER
-*. (0. IF UNBOUNDED) *
-*.
-*. OUTPUT PARAM = FINAL VALUES OF PARAMETERS (ARRAY)
-*. ARGUMENTS
-*. CHI2 = CHISQUARE OF FIT
-*.
-*. SIGPAR = STANDARD DEVIATIONS OF PARAMETERS
-*. (ARRAY)
-*.
-*. COVMAT = COVARIANCE MATRIX OF PARAMETERS
-*. (ARRAY L=NPAR*(NPAR+1)/2)
-*.
-*.
-*. ---------------------------REMARKS------------------------------
-*.
-*. ICONTR=M*10**6+F*100000+B*10000+D*1000+W*100+P*10+S
-*.
-*. S=1 - NO SUPERIMPOSING
-*.
-*. P=1 - PRINTS RESULTS OF THE FINAL ITERATION
-*. P>1 - PRINTS RESULTS OF ITERATIONS N*(P-1),WHERE
-*. N=0,1,2,...
-*. P=0 - SUPPRESSES INTERMEDIATE PRINTING
-*.
-*. W=0 - ERROR BARS GIVEN BY EY
-*. W=1 - ERRORS COMPUTED AS SQRT(Y)
-*.
-*. D=0 - SAVE USER"S FORCE:CALCULATES DERIVATIVES
-*. FOR PARAMETERS NUMERICALLY
-*. D=1 - REQUIRES USER ROUTINE HDERIN
-*. FOR COMPUTATION OF DERIVATIVES
-*.
-*. B=0 - ALL PARAMETERS MAY VARY FREELY
-*. B=1 - SOME OR ALL PARAMETERS ARE BOUNDED
-*. B=2 - LINEAR EQUALITY CONSTRAINTS BETWEEN PARAMS
-*. - OPTION PRESENTLY INACTIVE
-*.
-*. F=0 - UNDEFINED DIGIT
-*.
-*. M=1 - DAVIDON-FLETCHER-POWELL METHOD
-*. M=0 - GAUSS-NEWTON METHOD
-*..=========> ( R.Brun ,E.Lessner, D.Lienart)
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION PARAM,UFUNC,DQ
-#endif
- DIMENSION PARAM(*),SIGPAR(*),COVMAT(*),STEP0(*),PARMIN(*),
- + PARMAX(*),X(NDIM,NVAR),Y(NDIM),EY(NDIM),DQ(2)
-*
-#include "hbook/hcfit2.inc"
-#include "hbook/hcfit3.inc"
-#include "hbook/hcfit6.inc"
-#include "hbook/hcflag.inc"
-#include "hbook/hcbook.inc"
-#include "hbook/hcunit.inc"
-#include "hbook/hcfits.inc"
- EQUIVALENCE (Q(1),DQ(1))
- EXTERNAL UFUNC
- DATA NAME/2HN /
-*.___________________________________________
- NUMEP=N
- IHIS=0
- NX=NVAR
- NY=N
- IFLFUN=1
- NAMFUN=NAME
-*
- CALL HGETFL(ICONTR)
- ITPR=ITFUM
- ILICO=IFLBUF
- IF (ILICO.EQ.2) THEN
- WRITE (LOUT,'(A)') ' LINEAR EQUALITIES NOT AVAILABLE ',
- + ' IN THIS VERSION.'
- GO TO 99
- ENDIF
- IMINU=1
-*
- FITNAM(1)=' '
- IDIMPN=NVAR+2
- IFLSF=NVAR
- ISUPIM=1
-*
- LEXDAT=1
- LMATR=NP*NP
- LXMATR=NX*NY
- LAHFIT=LEXDAT+2*LMATR+LXMATR+11*NP+2*NY+1
- ID=0
- CALL HWORK(LAHFIT,IBQ(1),'HFITN ')
- IF (IBQ(1).EQ.0) GO TO 99
-*
-* SET ADDRESSES OF WORKING VECTORS
-*
- IF ((IBQ(1)/2)*2.EQ.IBQ(1)) IBQ(1)=IBQ(1)+1
- IBQ(7)=IBQ(1)+2*LMATR+10*NP
- IBQ(1)=(IBQ(1)+1)/2
- DO 5 I=2,6
- IBQ(I)=IBQ(I-1)+NP
- 5 CONTINUE
- IBQ(8)=IBQ(7)+LXMATR
- IBQ(9)=IBQ(8)+NY
- IBQ(10)=IBQ(9)+NY
- IDERIV=IBQ(4)
- IDESUM=IBQ(5)
- ICOV=IBQ(6)
- ILXE=IBQ(7)
- ILYE=IBQ(8)
- ILEY=IBQ(9)
- IVARP=IBQ(10)
-*
- EPSW=1.E-10
- WGTMAX=0.
- DO 9 L1=1,N
- IF (ABS(Y(L1)).GT.WGTMAX) WGTMAX=ABS(Y(L1))
- 9 CONTINUE
-*
- DO 12 I=1,NX
- DO 10 J=1,NY
- Q(ILXE+J-1+NY*(I-1))=X(J,I)
- 10 CONTINUE
- 12 CONTINUE
- DO 15 I=1,N
- Q(ILYE+I-1)=Y(I)
- IF(IWEIGH.EQ.0)THEN
- Q(ILEY+I-1)=EY(I)
- ELSEIF(IWEIGH.EQ.1)THEN
- Q(ILEY+I-1)=1.
- ELSEIF(IWEIGH.EQ.2)THEN
- Q(ILEY+I-1)=WGTMAX
- ELSE
- Q(ILEY+I-1)=WGTMAX/100.
- ENDIF
- 15 CONTINUE
-*
-* SET BOUNDARY SIZES FOR PARAMETERS
-*
- DO 25 I=1,NP
- IF (ILICO.NE.1.OR.PARMIN(I).GT.PARMAX(I)) THEN
- DQ(IBQ(1)+I-1)=0.
- DQ(IBQ(2)+I-1)=0.
- ELSE
- DQ(IBQ(1)+I-1)=PARMIN(I)
- DQ(IBQ(2)+I-1)=PARMAX(I)
- END IF
- DQ(IBQ(3)+I-1)=STEP0(I)
- 25 CONTINUE
-*
-* OTHER INITIALIZATIONS
-*
- NUP=NP
- IMAT=1
-*
- CALL HMINUI (UFUNC,PARAM,DQ(IBQ(1)),DQ(IBQ(2)),DQ(IBQ(3)),
- + DQ(ICOV),IQ(IVARP))
-*
- CHI2=CHIM
- DO 30 I=1,NUP
- SIGPAR(I)=DQ(IBQ(3)+I-1)
- 30 CONTINUE
-*
- IF (ICSTAT.GT.0) THEN
- KFIX=0
- K=0
- DO 40 I=1,NUP
- LC=IQ(IVARP+I-1)
- IF (LC.LE.0) KFIX=KFIX+1
- INTI=I-KFIX
- INTJ=0
- DO 35 J=1,I
- K=K+1
- LCC=IQ(IVARP+J-1)
- IF (LC.LE.0.OR.LCC.LE.0) THEN
- COVMAT(K)=0.
- ELSE
- INTJ=INTJ+1
- COVMAT(K)=DQ(ICOV+NUP*(INTI-1)+(INTJ-1))
- ENDIF
- 35 CONTINUE
- 40 CONTINUE
- ENDIF
-*
- 99 END
diff --git a/src/packlib/hbook/code/hfitpo.F b/src/packlib/hbook/code/hfitpo.F
deleted file mode 100644
index 28460d4..0000000
--- a/src/packlib/hbook/code/hfitpo.F
+++ /dev/null
@@ -1,92 +0,0 @@
-*
-* $Id: hfitpo.F,v 1.1.1.1 1996/01/16 17:07:37 mclareni Exp $
-*
-* $Log: hfitpo.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:37 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.10/05 17/08/89 08.50.24 by Rene Brun
-*-- Author :
- SUBROUTINE HFITPO(IDD,NP,A,CHI2,ICONTR,SIGPAR)
-*.==========>
-*. Fits a polynomial
-*. P(X)=A(1)+A(2)*X +...+ A(NP)*X**(NP-1)
-*. to the contents of 1-dim histogram idd and
-*. optionally superimposes it to the histogram
-*.
-*.
-*. Input IDD = Histogram identifier
-*. arguments
-*. NP = number of coefficients (order+1)
-*.
-*. ICONTR = Control word(see old HFITL)
-*.
-*. Output A = coefficients,increasing order
-*. arguments of x power (array)
-*.
-*. CHI2 = chisquare of fit
-*.
-*. SIGPAR = standard deviations of coefficients
-*. (array)
-*.
-*..=========> ( R.Brun,E.Lessner)
-#include "hbook/hcfit2.inc"
-#include "hbook/hcbits.inc"
-#include "hbook/hcbook.inc"
-#include "hbook/hcfits.inc"
- DIMENSION SIGPAR(*),A(*)
- EXTERNAL HPOLYN
- CHARACTER*8 CHOPT
-*.___________________________________________
- CALL HFIND(IDD,'HFITPO')
- IF(LCID.EQ.0)GO TO 99
- IF(IQ(LCONT+KNOENT).EQ.0)THEN
- CALL HBUG('Empty histogram','HFITPO',IDD)
- GO TO 99
- ENDIF
- CALL HDCOFL
- IF(I1.EQ.0.AND.LFIX.EQ.0)GO TO 99
-*
- IF (NP.LE.0.OR.NP.GT.18)THEN
- CALL HBUG('Wrong number of coefficients.LE.0','HFITPO',IDD)
- GOTO 99
- ENDIF
- IF (IQ(LPRX).LT.NP)THEN
- CALL HBUG('Number of channels.LE.Degree of polynomial'
- + ,'HFITPO',IDD)
- GOTO 99
- ENDIF
-*
- FITNAM(1)='A0'
- DO 2 I=2,NP
- IF(I.LT.11)THEN
- WRITE(FITNAM(I),10200)I-1
- ELSE
- WRITE(FITNAM(I),10300)I-1
- ENDIF
- 2 CONTINUE
- FITNAM(NP+1)='HFITPO'
- CALL HGETFF(ICONTR,IFLRET,CHOPT)
-*
-* Set initial values of parameters
-*
- IF(NCHANX.LE.1.OR.NP.EQ.1)THEN
- FITPAR(1)=ALLCHA/FLOAT(NCHANX)
- ELSE
- CALL HLSQ(NCHANX,NP,FITPAR)
- ENDIF
-*
-* Minimization
-*
- CALL HFITH(IDD,HPOLYN,CHOPT,NP,FITPAR,STEP,PMIN,PMAX,
- + SIGPAR,CHI2)
-*
- DO 80 I=1,NP
- A(I)=FITPAR(I)
- 80 CONTINUE
-*
-10200 FORMAT('A',I1,6X)
-10300 FORMAT('A',I2,5X)
- 99 END
diff --git a/src/packlib/hbook/code/hfits.F b/src/packlib/hbook/code/hfits.F
deleted file mode 100644
index 432c200..0000000
--- a/src/packlib/hbook/code/hfits.F
+++ /dev/null
@@ -1,182 +0,0 @@
-*
-* $Id: hfits.F,v 1.1.1.1 1996/01/16 17:07:37 mclareni Exp $
-*
-* $Log: hfits.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:37 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.22/11 23/08/94 14.17.45 by Rene Brun
-*-- Author :
- SUBROUTINE HFITS (IDD,UFUNC,NP,PARAM,CHI2,ICONTR,SIGPAR)
-*.==========>
-*. FITS THE PARAMETRIC FUNCTION TO THE CONTENTS OF THE
-*. 1- OR 2-DIMENSIONAL HISTOGRAM IDD,AND OPTIONALLY SUPER-
-*. IMPOSES IT TO THE 1-DIMENSIONAL HISTOGRAM WHEN EDITING
-*.
-*.
-*. INPUT IDD = HISTOGRAM IDENTIFIER
-*. ARGUMENTS
-*. UFUNC = PARAMETRIC FUNCTION (EXTERNAL)
-*.
-*. NP = NUMBER OF PARAMETERS
-*.
-*. PARAM = INITIAL VALUES OF PARAMETERS(ARRAY)
-*.
-*. ICONTR = CONTROL WORD
-*. 1 - NO SUPERIMPOSING
-*. 2 - FITTED FUNCTION IS SUPER-
-*. IMPOSED TO HISTOGRAM
-*.
-*. OUTPUT PARAM = FINAL VALUES OF PARAMETERS (ARRAY)
-*. ARGUMENTS
-*. CHI2 = CHISQUARE OF FIT
-*.
-*. SIGPAR = STANDARD DEVIATIONS OF PARAMETERS
-*. (ARRAY)
-*.
-*. ---------------------------REMARKS------------------------------
-*.
-*. ICONTR=M*10**6+F*100000+B*10000+D*1000+W*100+P*10+S
-*.
-*. S=2 - SUPERIMPOSES FUNCTION TO HISTOGRAM
-*. S=1 - NO SUPERIMPOSING
-*.
-*. P=1 - PRINTS RESULTS OF THE FINAL ITERATION
-*. P>1 - PRINTS RESULTS OF ITERATIONS N*(P-1),WHERE
-*. N=0,1,2,...
-*. P=0 - SUPPRESSES INTERMEDIATE PRINTING
-*.
-*. W=1 - SETS WEIGHTS EQUAL TO 1.
-*. W=0 -CALCULATES ERROR BAR E=SQRT(CONTENTS)
-*. AND SETS THE WEIGHT EQUAL TO 1./E**2
-*. HOWEVER IF ERROR BARS ARE AVAILABLE (E.G.AFTER CALL TO
-*. HBARX OR HPAKE)THEY ARE USED FOR SETTING OF THE WEIGHTS
-*.
-*. D=0 - SAVE USER"S FORCE:CALCULATES DERIVATIVES
-*. FOR PARAMETERS NUMERICALLY
-*. D=1 - REQUIRES USER ROUTINE HDERI2(2-DIM)
-*. HDERI1(OTHERWISE) FOR COMPUTATION
-*. OF DERIVATIVES
-*.
-*. B=0 - ALL PARAMETERS MAY VARY FREELY
-*. B=2 - LINEAR EQUALITY CONSTRAINTS BETWEEN PARAMS
-*. - OPTION PRESENTLY INACTIVE
-*.
-*. F>0 - SPECIAL FORMAT:DATA SET FOR F VARIABLES
-*. (C,SIGMAC,X1,...,XF)
-*. F=0 - USUAL FORMAT OF HISTOGRAMS
-*.
-*. M=1 - DAVIDON-FLETCHER-POWELL METHOD
-*. M=0 - GAUSS-NEWTON METHOD
-*..=========> ( R.Brun,E.Lessner,D.Lienart)
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION PARAM,UFUNC,DQ
-#endif
- DIMENSION PARAM(*),SIGPAR(*),NCHAN(2),DQ(2)
-*
-#include "hbook/hcfit2.inc"
-#include "hbook/hcfit3.inc"
-#include "hbook/hcfit6.inc"
-#include "hbook/hcflag.inc"
-#include "hbook/hcbits.inc"
-#include "hbook/hcbook.inc"
-#include "hbook/hcunit.inc"
-#include "hbook/hcfits.inc"
- EQUIVALENCE (Q(1),DQ(1))
- EXTERNAL UFUNC
- DATA NAME/2HS /
-*.___________________________________________
- CALL HFIND(IDD,'HFITS ')
- IF(LCID.EQ.0)GO TO 99
- IF(IQ(LCONT+KNOENT).EQ.0)THEN
- CALL HBUG('Empty histogram','HFITS',IDD)
- GO TO 99
- ENDIF
- CALL HDCOFL
-*
- NDIM=1
- NCHAN(1)=IQ(LPRX)
- IF(I1.EQ.0)THEN
- IF(LCONT.EQ.LQ(LCID-1))THEN
- NDIM=2
- NCHAN(2)=IQ(LPRY)
- ENDIF
- ENDIF
-*
- FITNAM(1)=' '
- IDIMPN=2+NDIM
- IHIS=1
- NX=1
- NY=1
- IFLFUN=1
- NAMFUN=NAME
-*
- CALL HGETFL(ICONTR)
- ITPR=ITFUM
- ILICO=IFLBUF
- IF (ILICO.EQ.2) THEN
- WRITE (LOUT,'(A)') ' LINEAR EQUALITIES NOT AVAILABLE ',
- + ' IN THIS VERSION.'
- GO TO 99
- ENDIF
- IMINU=1
-*
- NV=1
- IF(IDIMPN.EQ.3.AND.ISUPIM.EQ.2)CALL HSUPIM(UFUNC)
- NV=2
-*
- LEXDAT=IDIMPN
- LMATR=NP*NP
- LXMATR=NX*NY
- LAHFIT=LEXDAT+2*LMATR+LXMATR+11*NP+2*NY+1
- CALL HWORK(LAHFIT,IBQ(1),'HFITS ')
- IF (IBQ(1).EQ.0) GO TO 99
-*
- CALL HHIPAR (IFLRET)
- IF (IFLRET.EQ.0) GOTO 99
-*
-* SET ADDRESSES OF WORKING VECTORS
-*
- IF ((IBQ(1)/2)*2.EQ.IBQ(1)) IBQ(1)=IBQ(1)+1
- IBQ(7)=IBQ(1)+2*LMATR+10*NP
- IBQ(1)=(IBQ(1)+1)/2
- DO 5 I=2,6
- IBQ(I)=IBQ(I-1)+NP
- 5 CONTINUE
- IBQ(8)=IBQ(7)+LXMATR
- IBQ(9)=IBQ(8)+NY
- IBQ(10)=IBQ(9)+NY
- IDERIV=IBQ(4)
- IDESUM=IBQ(5)
- ICOV=IBQ(6)
- ILXE=IBQ(7)
- ILYE=IBQ(8)
- ILEY=IBQ(9)
- IVARP=IBQ(10)
-*
-* SET BOUNDARY SIZES FOR PARAMETERS
-*
- DO 25 I=1,NP
- DQ(IBQ(1)+I-1)=0.
- DQ(IBQ(2)+I-1)=0.
- DQ(IBQ(3)+I-1)=-1.
- 25 CONTINUE
-*
-* OTHER INITIALIZATIONS
-*
- NUP=NP
- IMAT=0
-*
- CALL HMINUI (UFUNC,PARAM,DQ(IBQ(1)),DQ(IBQ(2)),DQ(IBQ(3)),
- + DQ(ICOV),IQ(IVARP))
-*
- CHI2=CHIM
- DO 30 I=1,NUP
- SIGPAR(I)=DQ(IBQ(3)+I-1)
- 30 CONTINUE
-*
- IF(IDIMPN.EQ.3.AND.ISUPIM.EQ.2)CALL HSUPIM(UFUNC)
-*
- 99 END
diff --git a/src/packlib/hbook/code/hfitv.F b/src/packlib/hbook/code/hfitv.F
deleted file mode 100644
index 51b22fe..0000000
--- a/src/packlib/hbook/code/hfitv.F
+++ /dev/null
@@ -1,175 +0,0 @@
-*
-* $Id: hfitv.F,v 1.1.1.1 1996/01/16 17:07:37 mclareni Exp $
-*
-* $Log: hfitv.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:37 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.22/11 23/08/94 14.17.45 by Rene Brun
-*-- Author :
- SUBROUTINE HFITV (N,NDIM,NVAR,X,Y,EY,UFUNC,CHOPT,NP,PARAM
- + ,STEP,PMIN,PMAX,SIGPAR,CHI2)
-*.==========>
-*.
-*. Fits the parametric function to the contents of the
-*. N points in vectors X,Y with associated error bars in EY.
-*.
-*.
-*. Input N = Number of points
-*. arguments NDIM = Declared first dimension of X
-*. NVAR = Dimension of the distribution
-*. X = X coordinates (array of N points)
-*. Y = Y coordinates (array of N points)
-*. EY = Array of errors on Y (array of N values)
-*.
-*. UFUNC = Parametric function (EXTERNAL)
-*.
-*. CHOPT = Character string for options
-*.
-*. NP = Number of parameters
-*.
-*. PARAM = Initial values of parameters(array)
-*.
-*. STEP = initial step sizes for parameters
-*. search (array)
-*.
-*. PMIN = Lower parameter bounds (array)
-*. PMAX = Upper
-*.
-*. Output PARAM = Final values of parameters (array)
-*. arguments
-*. SIGPAR = Standard deviations of parameters
-*. (array)
-*. CHI2 = Chisquare of fit
-*.
-*.
-*.
-*. ---------------------------REMARKS------------------------------
-*.
-*. CHOPT : Possible options 'QVBLDW'
-*.
-*. 'Q' Quiet mode. No print
-* . 'V' Verbode mode. Results after each iteration are printed
-*. By default only final results are printed.
-*.
-*. 'B' Some or all parameters are bounded. The array STEP,PMIN,PMAX
-*. must be specified.
-*. Default is: All parameters vary freely.
-*.
-*. 'M' Interactive Minuit is invoked.
-*.
-*. 'L' Use Log Likelihood.
-*. Default is chisquare method.
-*.
-*. 'D' The user is assumed to compute derivatives analytically
-*. using the routine HDERIV.
-*. By default, derivatives are computed numerically.
-*.
-*. 'W' Sets weights equal to 1.
-*. In this case, array EY is ignored.
-*.
-*. 'Z' UFUNC is the user FCN (user own fitting model)
-*.
-*. 'K' Do not reset the Application Hminuit settings for option 'M'
-*.
-*..=========> ( R.Brun ,E.Lessner)
-*
-#include "hbook/hcfit2.inc"
-#include "hbook/hcfit6.inc"
-#include "hbook/hcflag.inc"
-#include "hbook/hcbook.inc"
-#include "hbook/hcfits.inc"
- PARAMETER(MAXPAR=34)
- DIMENSION PARAM(*),SIGPAR(*),STEP(*),PMIN(*),PMAX(*)
- DIMENSION X(NDIM,NVAR),Y(*),EY(*)
- DIMENSION STE(MAXPAR),PMI(MAXPAR),PMA(MAXPAR)
- DIMENSION IOPT(7)
- EQUIVALENCE (IOPTQ,IOPT(1)),(IOPTV,IOPT(2))
- EQUIVALENCE (IOPTB,IOPT(3)),(IOPTL,IOPT(4))
- EQUIVALENCE (IOPTD,IOPT(5)),(IOPTW,IOPT(6))
- EQUIVALENCE (IOPTZ,IOPT(7))
- EXTERNAL UFUNC,HFCNV
- CHARACTER*(*) CHOPT
-*.___________________________________________
- IF(NP.LE.0.OR.NP.GT.MAXPAR)THEN
- CALL HBUG('Wrong number of parameters','HFITV',IDD)
- GO TO 999
- ENDIF
- NUMEP=N
- ID=0
- IDLAST=0
-*
- NX=NVAR
- NY=N
-*
- FITNAM(1)=' '
- FITNAM(NP+1)='HFITV'
- IDIMPN=2+NVAR
- CALL HUOPTC(CHOPT,'QVBLDWZ',IOPT)
- IFLSF = 0
- IDER = IOPTD
- IWEIGH= IOPTW
- ITFUM = 0
- LINEAR= IOPTZ
- IF(IOPTQ.NE.0)ITFUM=-1
- IF(IOPTV.NE.0)ITFUM=1
-*
-* Set addresses of working vectors
-*
- LAHFIT=NX*NY+2*NY+100
- CALL HWORK(LAHFIT,ILXE,'HFITV')
- IF(ILXE.EQ.0)GO TO 999
- ILYE=ILXE+NX*NY
- ILEY=ILYE+NY
-*
-*
-* Computes ALLCHA and WGTMAX
-*
- BINWID=1.
- ALLCHA=0.
- WGTMAX=0.
- DO 10 L1=1,N
- IF (ABS(Y(L1)).GT.WGTMAX) WGTMAX=ABS(Y(L1))
- 10 CONTINUE
-*
- DO 30 I=1,NX
- DO 20 J=1,NY
- Q(ILXE+J-1+NY*(I-1))=X(J,I)
- 20 CONTINUE
- 30 CONTINUE
- DO 40 I=1,N
- Q(ILYE+I-1)=Y(I)
- IF(IWEIGH.EQ.0)THEN
- Q(ILEY+I-1)=EY(I)
- ELSE
- Q(ILEY+I-1)=1.
- ENDIF
- 40 CONTINUE
-*
-* Set boundary sizes for parameters
-*
- DO 50 I=1,NP
- IF (IOPTB.EQ.0) THEN
- PMI(I)=0.
- PMA(I)=0.
- STE(I)=-1.
- ELSE
- PMI(I)=PMIN(I)
- PMA(I)=PMAX(I)
- STE(I)=STEP(I)
- END IF
- 50 CONTINUE
-*
-* Other initializations
-*
- NFPAR=NP
- CALL HMINUT (HFCNV,UFUNC,PARAM,STE,PMI,PMA,CHOPT)
-*
- CHI2=FITCHI
- DO 60 I=1,NFPAR
- SIGPAR(I)=STE(I)
- 60 CONTINUE
-*
- 999 END
diff --git a/src/packlib/hbook/code/hfn.F b/src/packlib/hbook/code/hfn.F
deleted file mode 100644
index fc982cc..0000000
--- a/src/packlib/hbook/code/hfn.F
+++ /dev/null
@@ -1,135 +0,0 @@
-*
-* $Id: hfn.F,v 1.2 1996/02/29 11:20:10 cernlib Exp $
-*
-* $Log: hfn.F,v $
-* Revision 1.2 1996/02/29 11:20:10 cernlib
-* Replace a tab by spaces
-*
-* Revision 1.1.1.1 1996/01/16 17:07:37 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 04/08/95 12.08.44 by Julian Bunn
-*-- Author :
- SUBROUTINE HFN(ID1,X)
-*.==========>
-*. FILLING OF A N-TUPLE
-*.
-*..=========> ( R.Brun )
-#include "hbook/hcflag.inc"
-#include "hbook/hcbook.inc"
-#include "hbook/hcbits.inc"
-#include "hbook/hcdire.inc"
- COMMON/QUEST/IQUEST(100)
- CHARACTER*64 CHWOLD,CHDIR,CWDRZ
- DIMENSION X(*)
- INTEGER IDRZ(2)
- CHARACTER*80 MSG
-*.___________________________________________
-*
-
-
- IF(ID1.NE.IDLAST)THEN
- ID=ID1
- IDPOS=LOCATI(IQ(LTAB+1),IQ(LCDIR+KNRH),ID)
- IF(IDPOS.LE.0)RETURN
- IDLAST=ID1
- LCID=LQ(LTAB-IDPOS)
- I4=JBIT(IQ(LCID+KBITS),4)
- IF(I4.EQ.0)RETURN
- IF (IQ(LCID-2) .NE. 2) THEN
- CALL HBUG('New N-tuple, fill it with HFNT',
- + 'HFN',ID)
- RETURN
- ENDIF
- ENDIF
-*
-* Memory bank full ?
-* Allocate a new block if memory only
-* Write current block with RZ and start filling same block
-* if RZ option
-*
- LCONT=LQ(LCID-1)
- LR2=LQ(LCID-3)
- NDIM=IQ(LCID+2)
- IFIRST=IQ(LCID+7)
- 10 IF(IFIRST+NDIM-1.GT.IQ(LCONT-1))THEN
- NCHRZ=IQ(LCID+11)
- NWP=IQ(LCONT-1)
- IF(NCHRZ.EQ.0)THEN
- CALL HSPACE(NWP+10,'HFN ',ID1)
- IF(IERR.NE.0)GO TO 30
- CALL MZBOOK(IHDIV,LR2,LR2,0,'HCON',0,0,NWP,3,0)
- LQ(LCID-3)=LR2
- IQ(LCID+5)=IQ(LCID+5)+1
- ELSE
- CALL SBIT0(IQ(LCONT),1)
- IQ(LCID+6)=IQ(LCID+6)+1
- CALL RZCDIR(CWDRZ,'R')
- CALL HCDIR(CHWOLD,'R')
- CHDIR=' '
- CALL UHTOC(IQ(LCID+12),4,CHDIR,NCHRZ)
- CALL HCDIR(CHDIR,' ')
- IF(IQUEST(1).NE.0)THEN
- IQ(LCID+11)=0
- CALL HBUG('+Switch to memory mode','HFN',ID1)
- GO TO 10
- ENDIF
- IF (ICHTYP(ICDIR) .EQ. 1) THEN
- IDRZ(1) = 10000*IQ(LCID+6)+ID1
- ELSE
- IDRZ(1) = ID1
- IDRZ(2) = IQ(LCID+6)
- ENDIF
- CALL HRZOUT(IHDIV,LCONT,IDRZ,ICYCLE,'A')
- IF(IQ(LCID+6).EQ.1)THEN
- IDRZ(2)=0
- CALL HRZOUT(IHDIV,LCID,IDRZ,ICYCLE,'S')
- ENDIF
- CALL RZSAVE
- CALL HCDIR(CHWOLD,' ')
- IF(CHWOLD.NE.CWDRZ)THEN
- CALL RZCDIR(CWDRZ,' ')
- ENDIF
- CALL SBIT1(IQ(LCONT),1)
- ENDIF
- IFIRST=1
- ENDIF
-*
- LLIMS=LQ(LCID-2)
- IQ(LCID+3)=IQ(LCID+3)+1
- DO 20 I=1,NDIM
-
-#if defined(CERNLIB_SUN)||defined(CERNLIB_SOLARIS)||defined(CERNLIB_SGI)||defined(CERNLIB_DECS)||defined(CERNLIB_ALPHA)||defined(CERNLIB_HPUX)||defined(CERNLIB_IBMRT)
-* test the floating point
- JX=IFPS(X(I))
- IF(JX .EQ. 0) THEN
- WRITE(MSG,'(A,I10)') 'HFN bad float in column',I
- CALL HFPBUG(X(I),MSG,ID1)
- ENDIF
-*
-#endif
-
- IF(X(I).LT.Q(LLIMS+2*I-1))Q(LLIMS+2*I-1)=X(I)
- IF(X(I).GT.Q(LLIMS+2*I ))Q(LLIMS+2*I )=X(I)
- Q(LR2+IFIRST+I-1)=X(I)
- 20 CONTINUE
- IQ(LCID+7)=IFIRST+NDIM
-*
- 30 RETURN
- END
-
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/src/packlib/hbook/code/hfnov.F b/src/packlib/hbook/code/hfnov.F
deleted file mode 100644
index 81a8b19..0000000
--- a/src/packlib/hbook/code/hfnov.F
+++ /dev/null
@@ -1,62 +0,0 @@
-*
-* $Id: hfnov.F,v 1.1.1.1 1996/01/16 17:07:37 mclareni Exp $
-*
-* $Log: hfnov.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:37 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.17/00 10/02/92 15.07.20 by Fons Rademakers
-*-- Author : Rene Brun 20/02/90
- SUBROUTINE HFNOV(ID1,X)
-*.==========>
-*. To fill a memory-resident Ntuple
-*. When the memory buffer gets full,
-*. the first events are overwritten
-*.
-*..=========> ( R.Brun )
-#include "hbook/hcflag.inc"
-#include "hbook/hcbook.inc"
-#include "hbook/hcbits.inc"
- DIMENSION X(*)
-*.___________________________________________
-*
- IF(ID1.NE.IDLAST)THEN
- ID=ID1
- IDPOS=LOCATI(IQ(LTAB+1),IQ(LCDIR+KNRH),ID)
- IF(IDPOS.LE.0)RETURN
- IDLAST=ID1
- LCID=LQ(LTAB-IDPOS)
- LCONT=LQ(LCID-1)
- I4=JBIT(IQ(LCID+KBITS),4)
- IF(I4.EQ.0)RETURN
- IF (IQ(LCID-2) .NE. 2) THEN
- CALL HBUG('New N-tuple, can not use HFNOV',
- + 'HFNOV',ID)
- RETURN
- ENDIF
- ENDIF
-*
- NDIM=IQ(LCID+2)
- IFIRST=IQ(LCID+7)
- NMAX=IQ(LCID+4)/NDIM
- NCHRZ=IQ(LCID+11)
- IF(NCHRZ.NE.0)THEN
- CALL HBUG('HFNOV used with a disk-resident Ntuple','HFNOV',ID1)
- GO TO 99
- ENDIF
-*
- LLIMS=LQ(LCID-2)
- LR2=LQ(LCID-3)
- DO 10 I=1,NDIM
- IF(X(I).LT.Q(LLIMS+2*I-1))Q(LLIMS+2*I-1)=X(I)
- IF(X(I).GT.Q(LLIMS+2*I ))Q(LLIMS+2*I )=X(I)
- Q(LR2+IFIRST+I-1)=X(I)
- 10 CONTINUE
- IF(IQ(LCID+3).LT.NMAX) IQ(LCID+3)=IQ(LCID+3)+1
- IQ(LCID+7)=IFIRST+NDIM
- IF(IQ(LCID+7).GT.IQ(LCID+4))IQ(LCID+7)=1
-*
- 99 RETURN
- END
diff --git a/src/packlib/hbook/code/hforma.F b/src/packlib/hbook/code/hforma.F
deleted file mode 100644
index 2bb0c1c..0000000
--- a/src/packlib/hbook/code/hforma.F
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: hforma.F,v 1.1.1.1 1996/01/16 17:07:37 mclareni Exp $
-*
-* $Log: hforma.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:37 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.19/00 19/04/93 10.13.24 by Rene Brun
-*-- Author :
- SUBROUTINE HFORMA(I)
-*.==========>
-*. THIS ROUTINE PRINTS DIFFERENT FORMATS OF HBOOK
-*..=========> ( R.Brun )
-#include "hbook/hcunit.inc"
- COMMON/HFORM/IA(127),IDU
-#include "hbook/hcprin.inc"
-#include "hbook/hcrlf.inc"
-*.___________________________________________
- IF(I.EQ.1)THEN
- DO 10 K=127,1,-1
- IF(IA(K).NE.IDG(41))GO TO 20
- 10 CONTINUE
- 20 WRITE(LOUT,1000)(IA(J),J=1,K)
- GO TO 999
- ELSEIF(I.EQ.2)THEN
- WRITE(LOUT,2000)
- ELSEIF(I.EQ.3)THEN
- WRITE(LOUT,3000)CRLF
- ELSEIF(I.EQ.4)THEN
- WRITE(LERR,1000)IA
- ELSE
- WRITE(LERR,2000)
- ENDIF
-*
- 1000 FORMAT(' ',127A1)
- 2000 FORMAT(' ')
- 3000 FORMAT(A)
- 999 RETURN
- END
diff --git a/src/packlib/hbook/code/hfpak1.F b/src/packlib/hbook/code/hfpak1.F
deleted file mode 100644
index 9d165e1..0000000
--- a/src/packlib/hbook/code/hfpak1.F
+++ /dev/null
@@ -1,73 +0,0 @@
-*
-* $Id: hfpak1.F,v 1.1.1.1 1996/01/16 17:07:37 mclareni Exp $
-*
-* $Log: hfpak1.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:37 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.20/08 10/09/93 09.23.36 by Rene Brun
-*-- Author :
- SUBROUTINE HFPAK1(ID1,NID,X,N)
-*.==========>
-*. FAST FILLING ROUTINE FOR 1-DIM HIST
-*. NID IS AN OUTPUT PARAMETER = HIST NUMBER-1
-*. N IS THE NUMBER OF ELEMENTS OF ARRAY X TO BE FILLED
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
-#include "hbook/hcflag.inc"
-#include "hbook/hcprin.inc"
- DIMENSION X(1),NID(1)
- SAVE BWID1
-*.___________________________________________
-#include "hbook/jbyt.inc"
- IF(ID1.NE.IDLAST)THEN
-*
-* CHECK IF ID1 IS AT THE ADDRESS CORRESPONDING TO NID(1)
-* IF NOT COMPUTE NID(1).
-*
- IF(NID(1).LE.0)GO TO 10
- IF(NID(1).GT.IQ(LCDIR+KNRH))GO TO 10
- LCID=LQ(LTAB-NID(1))
- IF(IQ(LTAB+NID(1)).EQ.ID1)GO TO 20
-*
-* SEARCH ADDRESS OF ID IN THE ADDRESS TABLE (BINARY SEARCH)
-*
- 10 ID=ID1
- IDPOS=LOCATI(IQ(LTAB+1),IQ(LCDIR+KNRH),ID)
- IF(IDPOS.LE.0)RETURN
- NID(1)=IDPOS
-*
-* COMPUTE POINTERS TO ACCESS HISTOGRAM AREA
-*
- 20 IDLAST=ID1
- LCID =LQ(LTAB-NID(1))
- LCONT=LQ(LCID-1)
- BWID1=FLOAT(IQ(LCID+KNCX))/(Q(LCID+KXMAX)-Q(LCID+KXMIN))
- ENDIF
-*
-* INCREMENT NUMBER OF ENTRIES AND COMPUTE CHANNEL NUMBER
-*
- IQ(LCONT+KNOENT)=IQ(LCONT+KNOENT)+N
- DO 30 I=1,N
- IF(X(I).LT.Q(LCID+KXMIN))THEN
- ICHAN=0
- ELSEIF(.NOT.(X(I).LT.Q(LCID+KXMAX)))THEN
- ICHAN=IQ(LCID+KNCX)+1
- ELSE
- ICHAN=(X(I)-Q(LCID+KXMIN))*BWID1+1
- ENDIF
- IF(IQ(LCONT+KNBIT).GE.32)THEN
- Q(LCONT+ICHAN+KCON1)=Q(LCONT+ICHAN+KCON1)+1.
- ELSE
- NBPROX=IQ(LCONT+KNBIT)
- NB=32/NBPROX
- LWORD=ICHAN/NB
- LBIT=(ICHAN-NB*LWORD)*NBPROX+1
- INC=JBYT(IQ(LCONT+LWORD+KCON1),LBIT,NBPROX)+1
- IF(INC.GT.MAXBIT(NBPROX))INC=MAXBIT(NBPROX)
- CALL SBYT(INC,IQ(LCONT+LWORD+KCON1),LBIT,NBPROX)
- ENDIF
- 30 CONTINUE
- END
diff --git a/src/packlib/hbook/code/hfpbug.F b/src/packlib/hbook/code/hfpbug.F
deleted file mode 100644
index 2f9a713..0000000
--- a/src/packlib/hbook/code/hfpbug.F
+++ /dev/null
@@ -1,42 +0,0 @@
-*
-* $Id: hfpbug.F,v 1.4 1997/10/23 13:46:33 mclareni Exp $
-*
-* $Log: hfpbug.F,v $
-* Revision 1.4 1997/10/23 13:46:33 mclareni
-* NT mods
-*
-* Revision 1.3 1997/02/27 16:19:28 couet
-* - Wrong coding of the error messages
-*
-* Revision 1.2 1997/02/27 14:44:59 couet
-* - wrong comparison. X was used instead of I
-*
-* Revision 1.1.1.1 1996/01/16 17:07:38 mclareni
-* First import
-*
-#include "hbook/pilot.h"
-*-- Author : Francois Dardare 24/04/95
-*----------------------------------------------------------------------------*
-* *
-* function called when the floating point is not finit *
-* it gives an accurate classification of it *
-* *
-*----------------------------------------------------------------------------*
- SUBROUTINE HFPBUG(X,ROUT,ID)
- CHARACTER*(*) ROUT
-#ifndef CERNLIB_WINNT
- I=IFPSCL(X)
-#else
- I = 0;
- CALL HBUG('WIN32 can not recognise this bug',ROUT,ID)
-#endif
- IF (I .EQ. 5) THEN
- CALL HBUG('Negative infinity',ROUT,ID)
- ELSEIF (I .EQ. 4) THEN
- CALL HBUG('Positive infinity',ROUT,ID)
- ELSEIF (I .EQ. 8) THEN
- CALL HBUG('Signaling NaN',ROUT,ID)
- ELSE
- CALL HBUG('Quiet NaN',ROUT,ID)
- ENDIF
- END
diff --git a/src/packlib/hbook/code/hframe.F b/src/packlib/hbook/code/hframe.F
deleted file mode 100644
index c804a8c..0000000
--- a/src/packlib/hbook/code/hframe.F
+++ /dev/null
@@ -1,121 +0,0 @@
-*
-* $Id: hframe.F,v 1.1.1.1 1996/01/16 17:07:38 mclareni Exp $
-*
-* $Log: hframe.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:38 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.23/01 20/02/95 09.42.37 by Julian Bunn
-*-- Author :
- SUBROUTINE HFRAME(IX,XMIN,FACTOR,W5)
-*.==========>
-*. PRINTS STATISTICS FOR SCATTER PLOTS AND TABLES
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
-#include "hbook/hcbits.inc"
-#include "hbook/hcprin.inc"
- CHARACTER*9 XNUMB
- COMMON/HEXPO/ISI,IE1,IE2,NBS,FACT
- COMMON/HFORM/IA(127),IDU
-*.___________________________________________
- FA=1.
- IF(NBS.GE.32.AND.I3.NE.0)FA=FACT
- CALL VBLANK(IA,NCOLPA)
- IA(61)=IDG(19)
- IA(71)=IDG(19)
- NCX=IQ(LCID+KNCX)
- NCY=IQ(LCID+KNCY)
- W1=HCXY(0,NCY+1,1)*FA
- W2=0.
- W8=0.
- DO 1 I=1,NCX
- W2=W2+HCXY(I,NCY+1,1)*FA
- W8=W8+HCXY(I,0,1)*FA
- 1 CONTINUE
- W3=HCXY(NCX+1,NCY+1,1)*FA
- W4=0.
- W6=0.
- DO 2 I=1,NCY
- W4=W4+HCXY(0,I,1)*FA
- W6=W6+HCXY(NCX+1,I,1)*FA
- 2 CONTINUE
- W7=HCXY(0,0,1)*FA
- W9=HCXY(NCX+1,0,1)*FA
- W5=W5-W1-W2-W3-W4-W6-W7-W8-W9
-*
-* FIRST LINE
-*
- CALL HBCD(W1,9,IA(52))
- CALL HBCD(W2,9,IA(62))
- CALL HBCD(W3,9,IA(72))
- IA(2)=IDG(37)
- CALL HFORMA(1)
-*
-* SECOND LINE
-*
- CALL VBLANK(IA(4),NCOLPA-3)
- CALL UCTOH('ENTRIES =',IA(4),1,9)
-*
- CALL HBCDI(IX,9,IA(13))
- CALL UCTOH('PLOT',IA(41),1,4)
-*
- CALL VFILL(IA(52),29,IDG(39))
- IA(61)=IDG(19)
- IA(71)=IDG(19)
- CALL HFORMA(1)
-*
-* LINE 3
-*
- CALL VBLANK(IA(4),NCOLPA-3)
- CALL UCTOH('SATURATION AT= INFINITY ',IA(4),1,28)
-*
- IF(NBS.LT.32)CALL HBCDI(MAXBIT(NBS),9,IA(23))
-*
- CALL HBCD(W4,9,IA(52))
- IA(61)=IDG(19)
- IA(71)=IDG(19)
- CALL HBCD(W5,9,IA(62))
- CALL HBCD(W6,9,IA(72))
- CALL HFORMA(1)
-*
-* LINE 4
-*
- CALL VBLANK(IA(4),NCOLPA-3)
- IF(I3.NE.0)GO TO 20
- CALL UCTOH('SCALE .,+,2,3,.,., A,B,',IA(4),1,24)
- 20 CALL UCTOH('STATISTICS',IA(39),1,10)
-*
- CALL VFILL(IA(52),29,IDG(39))
- IA(61)=IDG(19)
- IA(71)=IDG(19)
- CALL HFORMA(1)
-*
-* LINE 5
-*
- CALL VBLANK(IA(4),NCOLPA-3)
- IF(I2.NE.0)GO TO 35
- IF(NBS.LT.32)GO TO 40
- IF(IE2.EQ.IDG(41))GO TO 40
- CALL UCTOH('CONTENTS *10**',IA(4),1,14)
- IA(18)=ISI
- IA(19)=IE1
- IA(20)=IE2
- GO TO 40
-*
- 35 CALL UCTOH('STEP =',IA(4),1,6)
- WRITE(XNUMB,'(G9.3)')FACTOR
- CALL UCTOH1(XNUMB,IA(10),9)
- CALL UCTOH('* MINIMUM=',IA(20),1,10)
- WRITE(XNUMB,'(G9.3)')XMIN
- CALL UCTOH1(XNUMB,IA(30),9)
- IF(XMIN.EQ.0.)IA(30)=IDG(1)
- 40 CALL HBCD(W7,9,IA(52))
- IA(61)=IDG(19)
- IA(71)=IDG(19)
- CALL HBCD(W8,9,IA(62))
- CALL HBCD(W9,9,IA(72))
- CALL HFORMA(1)
-*
- END
diff --git a/src/packlib/hbook/code/hfumil.F b/src/packlib/hbook/code/hfumil.F
deleted file mode 100644
index b049031..0000000
--- a/src/packlib/hbook/code/hfumil.F
+++ /dev/null
@@ -1,319 +0,0 @@
-*
-* $Id: hfumil.F,v 1.1.1.1 1996/01/16 17:07:38 mclareni Exp $
-*
-* $Log: hfumil.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:38 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.19/00 19/04/93 10.27.31 by Rene Brun
-*-- Author :
- SUBROUTINE HFUMIL(TFUNC,S,M,IT,MC,Z,
- +Z0,G ,A ,DF ,PL0 ,SIGMA ,PL ,R ,DA,AMX,AMN,EXDA)
-*.==========>
-*. HFUMIL IS SPECIAL VERSION OF THE FUMILI
-*. (D510 CERN LIBRARY)
-*. THIS VERSION ALLOWS TO USE DYNAMIC MEMORY MANAGEMENT
-*. AND FITTING FUNCTIONS AS FOLLOWS:
-*. IFLFUN=1-EXTERNAL FUNCTION TO BE WRITTEN BY USER
-*. =2-INTERNAL HBOOK FUNCTION I.E. HGAUSS HPOLY HEXP.
-*. (THESE FUNCTIONS ARE USED INSTEAD OF THE HARITH)
-*..=========> ( I.Ivanchenko )
- DIMENSION Z(1),Z0(1),
- +G(1),A(1),DF(1),PL0(1),SIGMA(1),PL(1),R(1),DA(1),AMX(1),AMN(1),
- +EXDA(1)
-#include "hbook/hcfit1.inc"
-#include "hbook/hcfit2.inc"
-#include "hbook/hcunit.inc"
-#include "hbook/hcflag.inc"
-#include "hbook/hcrlf.inc"
-* 10.*MAXIMUM RELATIVE PRECISION
-*
- DATA RP/1.E-14/
-*.___________________________________________
- N1=2
- N2=1
- N3=113
- EPS=0.1
- INDFLG(3)=0
- IF(IT.GE.0)WRITE(LOUT,84)CRLF, NAMFUN,ID
- NN2=0
- N=M
- FIXFLG=0.
- ENDFLG=0.
- INDFLG(2)=0
- IFIX1=0.
- FI=0.
- NN3=0
- DO 2 I=1,N
- R(I)=0.
- IF (EPS.GT.0.) SIGMA(I)=0.
- PL(I)=PL0(I)
- 2 CONTINUE
-*
-* START NEW ITERATION
-*
- 3 NN1=1
- T1=1.
-*
-* REPEAT ITERATION WITH SMALLER STEP
-*
- 4 S=0.
- N0=0
- DO 7 I=1,N
- G(I)=0.
- IF (PL0(I).LE.0.)GO TO 7
- N0=N0+1
- IF (PL(I).GT.0.)THEN
- PL0(I)=PL(I)
- ENDIF
- 7 CONTINUE
- NN0=N0*(N0+1)/2
- IF (NN0.LT.1) GO TO 9
- DO 8 I=1,NN0
- Z(I)=0.
- 8 CONTINUE
- 9 NA=M
- INDFLG(1)=0
-*
-* CALCULATE OBJECTIVE FUNCTION
-*
- CALL HSGZ (TFUNC,M,S,Z,G,A,DF,EXDA,PL0,AMX,AMN)
- SP=RP*ABS(S)
- IF (NN0.GE.1)THEN
- DO 10 I=1,NN0
- Z0(I)=Z(I)
- 10 CONTINUE
- ENDIF
- IF (NN3.LE.0)GO TO 19
- IF (NN1-N1.GT.0)GO TO 19
- T=2.*(S-OLDS-GT)
- IF (INDFLG(1).NE.0)GO TO 16
- IF (ABS(S-OLDS).LE.SP.AND.-GT.LE.SP) GO TO 19
- IF (0.59*T+GT.LT.0.)GO TO 19
- T=-GT/T
- IF (T-0.25) 16,17,17
- 16 T=0.25
- 17 GT=GT*T
- T1=T1*T
- NN2=0
- DO 18 I=1,N
- IF (PL(I).LE.0.) GO TO 18
- A(I)=A(I)-DA(I)
- PL(I)=PL(I)*T
- DA(I)=DA(I)*T
- A(I)=A(I)+DA(I)
- 18 CONTINUE
- NN1=NN1+1
- GO TO 4
-*
-* REMOVE CONTRIBUTION OF FIXED PARAMETERS FROM Z
-*
- 19 IF (INDFLG(1).EQ.0) GO TO 20
- ENDFLG=-4.
- GO TO 85
- 20 K1=1
- K2=1
- I1=1
- DO 30 I=1,N
- IF (PL0(I).LE.0.)GO TO 30
- IF (PL(I).EQ.0.) PL(I)=PL0(I)
- IF (PL(I)) 23,23,24
- 22 PL(I)=0.
- 23 K1=K1+I1
- GO TO 29
- 24 IF (A(I).GE.AMX(I).AND.G(I).LT.0.) GO TO 22
- IF (A(I).LE.AMN(I).AND.G(I).GT.0.) GO TO 22
- DO 28 J=1,I
- IF (PL0(J).LE.0)GO TO 28
- IF (PL(J).GT.0.)THEN
- Z(K2)=Z0(K1)
- K2=K2+1
- ENDIF
- K1=K1+1
- 28 CONTINUE
- 29 I1=I1+1
- 30 CONTINUE
-*
-* INVERT Z
-*
- I1=1
- L=I1
- DO 32 I=1,N
- IF (PL(I).LE.0.)GO TO 32
- R(I)=Z(L)
- I1=I1+1
- L=L+I1
- 32 CONTINUE
- N0=I1-1
- CALL HMCONV (N0,Z,PL,R)
- IF (INDFLG(1).NE.0)THEN
- INDFLG(1)=0
- INDFLG(2)=1
- GO TO 49
- ENDIF
-*
-* CALCULATE THEORETICAL STEP TO MINIMUM
- I1=1
- DO 41 I=1,N
- DA(I)=0.
- IF (PL(I).LE.0.)GO TO 41
- L1=1
- DO 40 L=1,N
- IF (PL(L).LE.0.)GO TO 40
- IF (I1-L1.LE.0)THEN
- K=L1*(L1-1)/2+I1
- ELSE
- K=I1*(I1-1)/2+L1
- ENDIF
- DA(I)=DA(I)-G(L)*Z(K)
- L1=L1+1
- 40 CONTINUE
- I1=I1+1
- 41 CONTINUE
-*
-* CHECK FOR PARAMETERS ON BOUNDARY
-*
- AFIX=0.
- IFIX=0
- I1=1
- L=I1
- DO 47 I=1,N
- IF (PL(I).LE.0.)GO TO 47
- SIGI=SQRT(ABS(Z(L)))
- R(I)=R(I)*Z(L)
- IF (EPS.GT.0.)THEN
- SIGMA(I)=SIGI
- ENDIF
- IF ((A(I).LT.AMX(I).OR.DA(I).LE.0.).AND.
- + (A(I).GT.AMN(I).OR.DA(I).GE.0.)) GO TO 46
- AKAP=ABS(DA(I)/SIGI)
- IF (AKAP-AFIX.GT.0.)THEN
- AFIX=AKAP
- IFIX=I
- IFIX1=I
- ENDIF
- 46 I1=I1+1
- L=L+I1
- 47 CONTINUE
- IF (IFIX.EQ.0)GO TO 50
- PL(IFIX)=-1.
- 49 FIXFLG=FIXFLG+1.
- FI=0.
-*
-* REPEAT CALCULATION OF THEORETICAL STEP
-* AFTER FIXING EACH PARAMETER
-*
- GO TO 19
-*
-* CALCULATE STEP CORRECTION FACTOR
-*
- 50 ALAMBD=1.
- AKAPPA=0.
- IMAX=0
- DO 60 I=1,N
- IF (PL(I).LE.0.)GO TO 60
- BM=AMX(I)-A(I)
- ABI=A(I)+PL(I)
- ABM=AMX(I)
- IF (DA(I).LE.0.)THEN
- BM=A(I)-AMN(I)
- ABI=A(I)-PL(I)
- ABM=AMN(I)
- ENDIF
- BI=PL(I)
- IF (BI-BM.GT.0.)THEN
- BI=BM
- ABI=ABM
- ENDIF
- IF (ABS(DA(I))-BI.GT.0.)THEN
- AL=ABS(BI/DA(I))
- IF (ALAMBD-AL.GT.0.)THEN
- IMAX=I
- AIMAX=ABI
- ALAMBD=AL
- ENDIF
- ENDIF
- AKAP=ABS(DA(I)/SIGMA(I))
- IF (AKAP-AKAPPA.LE.0.)GO TO 60
- AKAPPA=AKAP
- 60 CONTINUE
-*
-* CALCULATE NEW CORRECTED STEP
-*
- GT=0.
- AMB=1.E+18
- IF (ALAMBD.GT.0)THEN
- AMB=0.25/ALAMBD
- ENDIF
- DO 67 I=1,N
- IF (PL(I).LE.0.)GO TO 67
- IF (NN2-N2.GT.0)THEN
- IF (ABS(DA(I)/PL(I))-AMB.GE.0.)THEN
- PL(I)=4.*PL(I)
- T1=4.
- ENDIF
- ENDIF
- DA(I)=DA(I)*ALAMBD
- GT=GT+DA(I)*G(I)
- 67 CONTINUE
-*
-* CHECK IF MINIMUM ATTAINED AND SET EXIT MODE
-*
- IF (-GT.GT.SP.OR.T1.GE.1..OR.ALAMBD.GE.1.) GO TO 68
- ENDFLG=-1.
- 68 IF (ENDFLG.LT.0)GO TO 85
- IF (AKAPPA-ABS(EPS).GE.0.)GO TO 75
- IF (FIXFLG.EQ.0)THEN
- ENDFLG=1.
- GO TO 85
- ENDIF
- IF (ENDFLG) 85,77,73
- 73 IF (IFIX1) 85,85,76
- 74 IF (FI-FIXFLG) 76,76,77
- 75 IF (FIXFLG.NE.0)GO TO 74
- 76 FI=FI+1.
- ENDFLG=0.
- 85 IF(ENDFLG.EQ.0..AND.NN3.GE.N3) ENDFLG=-3.
- IF(ENDFLG.GT.0..AND.INDFLG(2).GT.0) ENDFLG=-2.
- CALL HMONIT(S,M,NN3,IT,GT,AKAPPA,ALAMBD,A,SIGMA,R,PL,PL0)
- IF (ENDFLG) 83,79,83
-*
-* CHECK IF FIXING ON BOUND IS CORRECT
-*
- 77 ENDFLG=1.
- FIXFLG=0.
- IFIX1=0
- DO 78 I=1,M
- 78 PL(I)=PL0(I)
- INDFLG(2)=0
- GO TO 19
-*
-* NEXT ITERATION
-*
- 79 ENDFLG=0.
- DO 80 I=1,N
- A(I)=A(I)+DA(I)
- 80 CONTINUE
- IF (IMAX.GT.0)THEN
- A(IMAX)=AIMAX
- ENDIF
- OLDS=S
- NN2=NN2+1
- NN3=NN3+1
- GO TO 3
- 83 MC=ENDFLG
-*
- 84 FORMAT(A,
- +/' ********************************************************',
- +/' * *',/
- +5X,'* FUNCTION MINIMIZATION BY SUBROUTINE HFIT',A2,' ID=',I6,'*'
- +/' * *',
- +/' ********************************************************',
- +/'0 S = VALUE OF OBJECTIVE FUNCTION ',
- +/' 2S = CHISQUARE ',
- +/' EC = EXPECTED CHANGE IN S DURING THE NEXT ITERATION ',
- +/' KAPPA = ESTIMATED DISTANCE TO MINIMUM ',
- +/' LAMBDA= STEP LENGTH MODIFIER '//)
- END
diff --git a/src/packlib/hbook/code/hfunc.F b/src/packlib/hbook/code/hfunc.F
deleted file mode 100644
index 809f62b..0000000
--- a/src/packlib/hbook/code/hfunc.F
+++ /dev/null
@@ -1,123 +0,0 @@
-*
-* $Id: hfunc.F,v 1.1.1.1 1996/01/16 17:07:38 mclareni Exp $
-*
-* $Log: hfunc.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:38 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.19/00 26/04/93 11.57.51 by Rene Brun
-*-- Author :
- SUBROUTINE HFUNC (ID2,FUNC)
-*.==========>
-*. Store value of function FUNC in LFUNC data structure
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
-#include "hbook/hcflag.inc"
-#include "hbook/hcbits.inc"
-#include "hbook/hcform.inc"
- REAL V(2)
- EQUIVALENCE (X, V(1)), (Y, V(2))
- EXTERNAL FUNC
-*.___________________________________________
- IRET=3
- 10 CALL HLOOP(ID2,'HFUNC ',IRET)
- IF(IRET.EQ.0)GO TO 60
- CALL HDCOFL
- IF(I123.EQ.0)THEN
- CALL HBUG('Not a histogram','HFUNC',ID)
- IRET=2
- GO TO 10
- ENDIF
-*
- LCONT=LQ(LCID-1)
- IF(IQ(LCONT-2).EQ.0)THEN
- NNOW=IQ(LCONT-1)+IQ(LCONT-3)+10
- NMORE=2
- NNEW=NNOW+NMORE
- CALL HSPACE(NNOW+NNEW,'HFUNC ',ID)
- IF(IERR.NE.0)GO TO 50
- CALL MZPUSH(IHDIV,LCONT,NMORE,0,' ')
- IQ(LCID+KNTOT)=IQ(LCID+KNTOT)+NMORE
- ENDIF
- IF(LQ(LCONT-1).EQ.0)THEN
- IF(I1.NE.0)THEN
- NCX=IQ(LCID+KNCX)
- NTOT=NCX+12
- CALL HSPACE(NTOT,'HFUNC ',ID2)
- IF(IERR.NE.0)GO TO 50
- CALL HSIFLA(12,1)
- IQ(LCID+KNTOT)=IQ(LCID+KNTOT)+NTOT
- CALL MZBOOK(IHDIV,LFUNC,LCONT,-1,'HFUN',1,1,NCX+2,
- + IOCF2,0)
- ELSE
- NCX=IQ(LCID+KNCX)
- NCY=IQ(LCID+KNCY)
- IF(LQ(LCONT-1).EQ.0)THEN
- NTOT=NCX*NCY+14
- CALL HSPACE(NTOT,'HFUNC ',ID2)
- IF(IERR.NE.0)GO TO 50
- CALL HSIFLA(12,1)
- IQ(LCID+KNTOT)=IQ(LCID+KNTOT)+NTOT
- CALL MZBOOK(IHDIV,LFUNC,LCONT,-1,'HFUN',1,1,NCX*NCY+4,
- + IOCF4,0)
- ENDIF
- ENDIF
- ELSE
- LFUNC=LQ(LCONT-1)
- IF(I1.NE.0)THEN
- NCX=IQ(LCID+KNCX)
- NMORE=NCX+2-IQ(LFUNC-1)
- IF(NMORE.NE.0)THEN
- LR1=LFUNC
- CALL MZPUSH(IHDIV,LR1,0,NMORE,' ')
- IQ(LCID+KNTOT)=IQ(LCID+KNTOT)+NMORE
- ENDIF
- ENDIF
- ENDIF
- LFUNC =LQ(LCONT-1)
- LHFIT =LQ(LFUNC-1)
- IF(IQ(LFUNC-2).EQ.0)LHFIT=0
- IF(LHFIT.NE.0)IQ(LHFIT+1)=0
- IQ(LFUNC+1)=1
- IQ(LFUNC+2)=NCX
- IF(I1.EQ.0)THEN
- IQ(LFUNC+3)=1
- IQ(LFUNC+4)=NCY
- ENDIF
- IF(NV.NE.1)THEN
- IF(I1.NE.0)THEN
- DX=(Q(LCID+KXMAX)-Q(LCID+KXMIN))/FLOAT(IQ(LCID+KNCX))
- DO 20 I=1,NCX
- IF(I6.EQ.0)THEN
- X=Q(LCID+KXMIN) +DX*(FLOAT(I)-0.5)
- ELSE
- LBINS=LQ(LCID-2)
- X=0.5*(Q(LBINS+I)+Q(LBINS+I+1))
- ENDIF
- Q(LFUNC+I+2)=FUNC(V)
- 20 CONTINUE
- ELSE
-* MZPUSH HFUN bank if necessary.
- IF(IQ(LFUNC-1).EQ.4)THEN
- CALL MZPUSH(IHDIV,LFUNC,0,NCX*NCY,' ')
- IQ(LCID+KNTOT)=IQ(LCID+KNTOT)+NCX*NCY
- ENDIF
- DX=(Q(LCID+KXMAX)-Q(LCID+KXMIN))/FLOAT(IQ(LCID+KNCX))
- DY=(Q(LCID+KYMAX)-Q(LCID+KYMIN))/FLOAT(IQ(LCID+KNCY))
- DO 40 IX=1,NCX
- X=Q(LCID+KXMIN)+(IX-0.5)*DX
- DO 30 IY=1,NCY
- Y=Q(LCID+KYMIN)+(IY-0.5)*DY
- I=(IY-1)*NCX+IX
- Q(LFUNC+I+4)=FUNC(V)
- 30 CONTINUE
- 40 CONTINUE
- ENDIF
- ENDIF
-*
- 50 IRET=2
- GO TO 10
- 60 NV=2
- END
diff --git a/src/packlib/hbook/code/hgaus.F b/src/packlib/hbook/code/hgaus.F
deleted file mode 100644
index 3a2d34f..0000000
--- a/src/packlib/hbook/code/hgaus.F
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: hgaus.F,v 1.1.1.1 1996/01/16 17:07:38 mclareni Exp $
-*
-* $Log: hgaus.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:38 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.19/00 28/04/93 11.20.00 by Rene Brun
-*-- Author :
- FUNCTION HGAUS (X)
-*.==========>
-*. Computes value of gaussian
-*. G(X)=(COEFF/SIGM)*EXP(-0.5*((X-AVERAG)/SIGM)**2)
-*. and its first derivatives
-*..=========> ( E.Lessner,D.Lienart )
-#include "hbook/hcfits.inc"
-#include "hbook/hcfitd.inc"
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION DD1,DD2,DD3
-#endif
-*.___________________________________________
- DD1=(X-FITPAD(2))/FITPAD(3)
- DD2=DD1*DD1
- DD3=0.
- IF (DD2.LT.172.) DD3=EXP(-0.5*DD2)
- FITFUN=FITPAD(1)*DD3
- HGAUS=FITFUN
- FITDER(1)=DD3
- FITDER(2)=FITFUN*DD1/FITPAD(3)
- FITDER(3)=FITFUN*(DD2-1.)/FITPAD(3)
- END
diff --git a/src/packlib/hbook/code/hgdire.F b/src/packlib/hbook/code/hgdire.F
deleted file mode 100644
index 36f8dbd..0000000
--- a/src/packlib/hbook/code/hgdire.F
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: hgdire.F,v 1.1.1.1 1996/01/16 17:07:38 mclareni Exp $
-*
-* $Log: hgdire.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:38 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.10/05 26/04/89 11.56.46 by Federico Carminati
-*-- Author : Federico Carminati
- SUBROUTINE HGDIRE(LUN,CHDIR)
-*.==========>
-*. Gets the Directory name for a given Logical unit
-*..=========> ( F.Carminati )
-#include "hbook/hcdire.inc"
- CHARACTER*(*) CHDIR
-*
-*.___________________________________________
-*
- DO 10 I=2,NCHTOP
- IF(ICHTOP(I).EQ.LUN)THEN
- CHDIR=CHTOP(I)
- GO TO 999
- ENDIF
- 10 CONTINUE
-*
- CALL HBUG('Unit not used by HBOOK','HGDIRE',LUN)
- CHDIR=' '
-*
- 999 END
diff --git a/src/packlib/hbook/code/hgetff.F b/src/packlib/hbook/code/hgetff.F
deleted file mode 100644
index 111ff31..0000000
--- a/src/packlib/hbook/code/hgetff.F
+++ /dev/null
@@ -1,89 +0,0 @@
-*
-* $Id: hgetff.F,v 1.1.1.1 1996/01/16 17:07:38 mclareni Exp $
-*
-* $Log: hgetff.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:38 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.19/00 28/04/93 11.39.30 by Rene Brun
-*-- Author :
- SUBROUTINE HGETFF(ICONTR,IFLRET,CHOPT)
-*.==========>
-*. SETS FLAGS LINEAR,IFLSF,IFLBUF,IDER,IWEIGH,ITFUM,ISUPIM
-*. INTO THE /HCFIT2/
-*..=========> ( I.Ivanchenko )
-#include "hbook/hcfit2.inc"
-#include "hbook/hcfitr.inc"
- COMMON/QUEST/IQUEST(100)
- DIMENSION IFLARR(7)
- EQUIVALENCE (IFLARR(1),LINEAR)
- CHARACTER*(*) CHOPT
-*.___________________________________________
-*
-* Build CHOPT
-*
- JCONTR=ICONTR
- DO 10 I=1,7
- IFLARR(I)=JCONTR/10**(7-I)
- JCONTR=JCONTR-IFLARR(I)*10**(7-I)
- 10 CONTINUE
- CHOPT='TU'
- J=3
- IF(LINEAR.NE.0)THEN
- CHOPT(J:J)='L'
- J=J+1
- ENDIF
- IF(IFLSF.NE.0)THEN
- CHOPT(J:J)='R'
- IFTRNG=1
- IFXLOW=IQUEST(11)
- IFXUP =IQUEST(12)
- IFYLOW=IQUEST(13)
- IFYUP =IQUEST(14)
- J=J+1
- ENDIF
- IF(IFLBUF.NE.0)THEN
- CHOPT(J:J)='M'
- J=J+1
- ENDIF
- IF(IDER.NE.0)THEN
- CHOPT(J:J)='D'
- J=J+1
- ENDIF
- IF(IWEIGH.NE.0)THEN
- CHOPT(J:J)='W'
- J=J+1
- ENDIF
- IF(ITFUM.EQ.0)THEN
- CHOPT(J:J)='Q'
- J=J+1
- ELSE
- IF(MOD(ITFUM,2).EQ.0)THEN
- CHOPT(J:J)='E'
- J=J+1
- ENDIF
- ENDIF
- IF(ITFUM.GT.5)THEN
- CHOPT(J:J)='V'
- J=J+1
- ENDIF
- IF(ISUPIM.NE.2)THEN
- CHOPT(J:J)='N'
- ENDIF
- LINEAR=0
- IFLSF =0
- ISUPIM=0
- IFLBUF=0
- IDER =0
- IWEIGH=0
- ITFUM =0
- IDIMPN=3
-*
-* Get main histogram parameters
-*
- CALL HHIPAR(IFLRET)
-*
- 99 RETURN
- END
diff --git a/src/packlib/hbook/code/hgetfl.F b/src/packlib/hbook/code/hgetfl.F
deleted file mode 100644
index e2007e2..0000000
--- a/src/packlib/hbook/code/hgetfl.F
+++ /dev/null
@@ -1,44 +0,0 @@
-*
-* $Id: hgetfl.F,v 1.1.1.1 1996/01/16 17:07:38 mclareni Exp $
-*
-* $Log: hgetfl.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:38 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.10/05 05/03/89 09.22.01 by Rene Brun
-*-- Author :
- SUBROUTINE HGETFL(ICONTR)
-*.==========>
-*. SETS FLAGS LINEAR,IFLSF,IFLBUF,IDER,IWEIGH,ITFUM,ISUPIM
-*. INTO THE /HCFIT2/
-*..=========> ( I.Ivanchenko )
-#include "hbook/hcfit2.inc"
- COMMON/HCGARB/GA(16),JCONTR
- DIMENSION IFLARR(7)
- EQUIVALENCE (IFLARR(1),LINEAR)
- SAVE NFL
- DATA NFL/7/
-*.___________________________________________
- LINEAR=0
- IFLSF=0
- IFLBUF=0
- IDER =0
- ITFUM =-1
- IWEIGH=0
- ISUPIM=2
-*
- JCONTR=ICONTR
- DO 10 I=1,NFL
- IFLARR(I)=JCONTR/10**(NFL-I)
- JCONTR=JCONTR-IFLARR(I)*10**(NFL-I)
- 10 CONTINUE
- IF(IFLFUN.EQ.2)IFLSF=0
- ITFUM=ITFUM-1
- IF(IFLSF.EQ.0)GO TO 99
- IFLBUF=0
- IDIMPN=IFLSF+2
-*
- 99 RETURN
- END
diff --git a/src/packlib/hbook/code/hgfit.F b/src/packlib/hbook/code/hgfit.F
deleted file mode 100644
index 96c2e88..0000000
--- a/src/packlib/hbook/code/hgfit.F
+++ /dev/null
@@ -1,130 +0,0 @@
-*
-* $Id: hgfit.F,v 1.1.1.1 1996/01/16 17:07:38 mclareni Exp $
-*
-* $Log: hgfit.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:38 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.17/02 15/12/92 21.48.30 by Rene Brun
-*-- Author :
- SUBROUTINE HGFIT(IDD,NFPAR,NPFITS,FITCHI,FITPAR,FITSIG,FITNAM)
-*.==========>
-*.
-*. Returns fit parameters
-*.
-*..==========> (R.Brun)
-#include "hbook/hcbook.inc"
- DIMENSION FITPAR(1),FITSIG(1)
- CHARACTER*(*) FITNAM(3)
-*.______________________________________
-*
- CHARACTER*4 NAME
-#if defined(CERNLIB_DOUBLE)
- PARAMETER (NWW=2)
- DOUBLE PRECISION SS
-#endif
-#if !defined(CERNLIB_DOUBLE)
- PARAMETER (NWW=1)
- REAL SS
-#endif
-*
- CALL HFIND(IDD,'HGFIT ')
-*
- NFPAR=0
- IF(LCID.LE.0)GO TO 999
-*
- LFUNC=LQ(LCONT-1)
- IF(LFUNC.EQ.0)GO TO 999
- IF(IQ(LFUNC-2).EQ.0)GO TO 999
- LHFIT =LQ(LFUNC-1)
- IF(LHFIT.EQ.0)GO TO 999
-*
- IF(JBIT(IQ(LHFIT),5).EQ.0)THEN
-* Old format
- NFPAR =Q(LHFIT+1)
- IF(NFPAR.EQ.0)GO TO 999
- NPFITS=Q(LHFIT+2)
- FITCHI=Q(LHFIT+3)
- NCH=LEN(FITNAM(1))
- IF(NCH.GT.8)NCH=8
- DO 10 I=1,NFPAR
- FITPAR(I)=Q(LHFIT+ 4+I)
- FITSIG(I)=Q(LHFIT+24+I)
- FITNAM(I)=' '
- CALL UHTOC(Q(LHFIT+43+2*I),4,FITNAM(I),NCH)
- 10 CONTINUE
- ELSE
-* New format (29/07/92).
- IFITTY=IQ(LHFIT+1)
- IF(IFITTY.EQ.0)GO TO 999
- NFPAR=IQ(LHFIT+2)
- IF(NFPAR.EQ.0)GO TO 999
- NPFITS=IQ(LHFIT+3)
- NOTHER=IQ(LHFIT+4)
- FITCHI=Q(LHFIT+6)
- IF(IFITTY.EQ.4)THEN
- CALL HQGETF(LHFIT)
- ELSE
- NP=MIN(NFPAR,35)
- II=11
- DO 20 I=1,NP
- CALL UCOPY(Q(LHFIT+II),SS,NWW)
- FITPAR(I)=SS
-* Note: FITPAR is only single precision.
- II=II+NWW
- 20 CONTINUE
- NWERR=IQ(LHFIT-1)-NWW*(NFPAR+NOTHER)
- IF(NWERR.GT.0)THEN
- II=IQ(LHFIT-1)-NWERR+11
- DO 30 I=1,NP
- CALL UCOPY(Q(LHFIT+II),SS,NWW)
- FITSIG(I)=SS
-* Note: FITSIG is only single precision.
- II=II+NWW
- 30 CONTINUE
- ENDIF
-* Get names if available, otherwise generate from IFITTY.
- DO 40 I=1,NP
- FITNAM(I)=' '
- 40 CONTINUE
- IF(IFITTY.EQ.1)THEN
-* Polynomial.
- N1=MAX(NP,10)
- DO 50 I=1,N1
- WRITE(FITNAM(I),'(''A'',I1,6X)')I-1
- 50 CONTINUE
- IF(NP.GT.10)THEN
- DO 60 I=11,NP
- WRITE(FITNAM(I),'(''A'',I2,5X)')I-1
- 60 CONTINUE
- END IF
- ELSE IF(IFITTY.EQ.2)THEN
-* Exponential.
- FITNAM(1)='Constant'
- FITNAM(2)='Slope'
- ELSE IF(IFITTY.EQ.3)THEN
-* Gaussian.
- FITNAM(1)='Constant'
- FITNAM(2)='Mean'
- FITNAM(3)='Sigma'
- ELSE IF(IFITTY.NE.4)THEN
- L=LQ(LHFIT)
- 70 CONTINUE
- IF(L.NE.0)THEN
- CALL UHTOC(IQ(L-4),4,NAME,4)
- IF(NAME.EQ.'HFNA')THEN
- DO 80 I=1,NP
- CALL UHTOC(Q(L+2*I-1),4,FITNAM(I),8)
- 80 CONTINUE
- ELSE
- GO TO 70
- END IF
- END IF
- END IF
- END IF
-* Get covariances if required and when available.
- END IF
-*
- 999 END
diff --git a/src/packlib/hbook/code/hgive.F b/src/packlib/hbook/code/hgive.F
deleted file mode 100644
index d50974a..0000000
--- a/src/packlib/hbook/code/hgive.F
+++ /dev/null
@@ -1,72 +0,0 @@
-*
-* $Id: hgive.F,v 1.1.1.1 1996/01/16 17:07:38 mclareni Exp $
-*
-* $Log: hgive.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:38 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.21/12 15/03/94 08.59.50 by Rene Brun
-*-- Author :
- SUBROUTINE HGIVE(IDD,CHTITL,NCX,XMIN,XMAX,NCY,YMIN,YMAX,
- +NWT,IDB)
-*.==========>
-*. RETURN BOOKING PARAMETERS OF IDD
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
-#include "hbook/hcbits.inc"
-#include "hbook/hcntpar.inc"
- CHARACTER*(*) CHTITL
-*.___________________________________________
- NARG=10
- CALL NOARG(NARG)
- NCX=0
- IF(NARG.GT.5)NCY=0
- IF(NARG.GT.8)NWT=0
- IF(NARG.GT.9)IDB=0
- CALL HFIND(IDD,'HGIVE ')
-*
-* IDD DOES NOT EXIST
-*
- IF(LCID.LE.0)GO TO 99
-*
- CALL HDCOFL
- IF(I4.NE.0)THEN
- IF (IQ(LCID-2) .NE. ZLINK) THEN
- NCX = IQ(LCID+2)
- IWT = IQ(LCID+9)+LCID
- NWTIT = IQ(LCID+8)
- ELSE
- NCX = IQ(LCID+ZNDIM)
- IWT = IQ(LCID+ZITIT1)+LCID
- NWTIT = IQ(LCID+ZNWTIT)
- ENDIF
- XMIN=0.
- XMAX=0.
- YMIN=0.
- YMAX=0.
- ELSE
- NCX=IQ(LCID+KNCX)
- XMIN=Q(LCID+KXMIN)
- XMAX=Q(LCID+KXMAX)
- IWT=LCID+KTIT1
- IF(I230.NE.0)THEN
- IF(NARG.GT.5)NCY=IQ(LCID+KNCY)
- IF(NARG.GT.6)YMIN=Q(LCID+KYMIN)
- IF(NARG.GT.7)YMAX=Q(LCID+KYMAX)
- IWT=LCID+KTIT2
- ENDIF
- NWTIT=IQ(LCID-1)-IWT+LCID+1
- ENDIF
- IF(NARG.GT.9)IDB=LCID
- IF(NARG.LT.9)GO TO 99
- NWT=NWTIT
- IF(NWT.EQ.0)GO TO 99
- NCH=LEN(CHTITL)
- NWCH=MIN(NCH,4*NWT)
- IF(NCH.GT.0)CHTITL=' '
- CALL UHTOC(IQ(IWT),4,CHTITL,NWCH)
-*
- 99 RETURN
- END
diff --git a/src/packlib/hbook/code/hgiven.F b/src/packlib/hbook/code/hgiven.F
deleted file mode 100644
index 6c2832f..0000000
--- a/src/packlib/hbook/code/hgiven.F
+++ /dev/null
@@ -1,95 +0,0 @@
-*
-* $Id: hgiven.F,v 1.1.1.1 1996/01/16 17:07:38 mclareni Exp $
-*
-* $Log: hgiven.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:38 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.22/03 26/05/94 11.47.32 by Rene Brun
-*-- Author :
- SUBROUTINE HGIVEN( ID1, CHTITL, NVAR, TAGS, RLOW, RHIGH )
-*.==========>
-*. To give information about a N-tuple. On entry, NVAR
-*. must specify the dimension of the TAGS, RLOW and RHIGH
-*. arrays. On return, NVAR is overwritten by the actual
-*. number of dimensions. If ID1 does not exist or is not
-*. an N-tuple, a value of 0 is returned
-*.
-*..=========> ( R. Namjoshi )
-#include "hbook/hcflag.inc"
-#include "hbook/hcbook.inc"
-#include "hbook/hcbits.inc"
-#include "hbook/hcntpar.inc"
-*
- CHARACTER*(*) CHTITL, TAGS(*)
- INTEGER ID1, NVAR
- REAL RLOW(*), RHIGH(*)
- CHARACTER*8 BLOCK
- LOGICAL NTOLD
-*.___________________________________________
-*
- NMAX = NVAR
- NVAR = 0
-*
- ID = ID1
- IDPOS = LOCATI(IQ(LTAB+1),IQ(LCDIR+KNRH),ID)
- IF( IDPOS.LE.0 ) RETURN
- IDLAST = ID1
- LCID = LQ(LTAB-IDPOS)
- I4 = JBIT(IQ(LCID+KBITS),4)
- IF( I4.EQ.0 ) RETURN
-*
- IF (IQ(LCID-2) .NE. ZLINK) THEN
- NTOLD = .TRUE.
- ELSE
- NTOLD = .FALSE.
- ENDIF
-*
- IF (NTOLD) THEN
- NDIM = IQ(LCID+2)
- LLIMS = LQ(LCID-2)
- ITAG1 = IQ(LCID+10)
- ITIT1 = IQ(LCID+9)
- NWTIT = IQ(LCID+8)
- ELSE
- NDIM = IQ(LCID+ZNDIM)
- ITIT1 = IQ(LCID+ZITIT1)
- NWTIT = IQ(LCID+ZNWTIT)
- ENDIF
-*
- NVAR = MIN(NDIM, NMAX)
-*
-* Copy title
-*
- NCH = LEN(CHTITL)
- IF (NCH .GT. 0) CHTITL = ' '
- NCH = MIN( NCH, 4*NWTIT )
- IF (NCH .GT. 0) CALL UHTOC( IQ(LCID+ITIT1), 4, CHTITL, NCH )
-*
-* Copy tag names and current lower/upper range
-*
- IF (NTOLD) THEN
- NCH = LEN( TAGS(1) )
- NCH = MIN( NCH, 8 )
- DO 10 I = 1, NVAR
- IF( NCH.GT.0 ) TAGS(I) = ' '
- IF( NCH.GT.0 )THEN
- TAGS(I)=' '
- CALL UHTOC( IQ(LCID+ITAG1+2*(I-1)), 4, TAGS(I), NCH )
- ENDIF
- RLOW (I) = Q(LLIMS+2*I-1)
- RHIGH(I) = Q(LLIMS+2*I)
- 10 CONTINUE
- ELSE
- DO 20 I = 1, NVAR
- CALL HNTVAR(ID1, I, TAGS(I), BLOCK, NS, IT, IS, IE)
- RLOW(I) = 0.0
- RHIGH(I) = 0.0
- 20 CONTINUE
- ENDIF
-*
- NVAR = NDIM
-*
- END
diff --git a/src/packlib/hbook/code/hgn.F b/src/packlib/hbook/code/hgn.F
deleted file mode 100644
index bc29cb1..0000000
--- a/src/packlib/hbook/code/hgn.F
+++ /dev/null
@@ -1,79 +0,0 @@
-*
-* $Id: hgn.F,v 1.1.1.1 1996/01/16 17:07:38 mclareni Exp $
-*
-* $Log: hgn.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:38 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.22/11 23/08/94 14.02.12 by Rene Brun
-*-- Author :
- SUBROUTINE HGN(IDN,NIDN,IDNEVT,X,IERROR)
-*.==========>
-*. Return in array X the variables of event IDNEVT
-*.
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
-#include "hbook/hcdire.inc"
- DIMENSION X(*)
- INTEGER KEYS(2)
-*.___________________________________________
-*
- CALL HGNPAR(IDN,'HGN ')
- IF(LCIDN.LE.0)GO TO 90
-*
- IF(IDNEVT.LE.0)GO TO 90
- IF(IDNEVT.GT.IQ(LCIDN+3))THEN
- IERROR=-1
- RETURN
- ENDIF
- LC=LQ(LCIDN-1)
- NEVB=IQ(LC-1)/IQ(LCIDN+2)
- IBANK=(IDNEVT-1)/NEVB + 1
-*
-* Load bank containing this event
-*
- IF(IQ(LCIDN+11).EQ.0)THEN
- LC=LQ(LCIDN-3-IBANK)
- ELSE
- IF(IQ(LCIDN).EQ.IBANK.OR.IQ(LCIDN+6).EQ.0)GO TO 20
- IF(IBANK.LE.IQ(LCIDN+6))THEN
- LKEY=LQ(LC)
- IF(LKEY.GT.0)THEN
-*-* case where bank with keys serial numbers exist
- KEYS(1)=IQ(LKEY+IBANK)
- CALL HRZIN(IHDIV,LCIDN,-1,KEYS,99999,'RS')
- ELSE
-*-* case where bank with keys serial numbers does not exist
- IF(ICHTYP(ICDIR).EQ.1)THEN
- KEYS(1) = IQ(LCIDN+5)+10000*IBANK
- KEYS(2) = 0
- ELSE
- KEYS(1) = IQ(LCIDN+5)
- KEYS(2) = IBANK
- ENDIF
- CALL HRZIN(IHDIV,LCIDN,-1,KEYS,99999,'R')
- ENDIF
- ELSE
- IOFSET=IDN-IQ(LCIDN+5)
- CALL HDELET(IDN)
- CALL HRIN(IDN-IOFSET,99999,IOFSET)
- NIDN=LOCATI(IQ(LTAB+1),IQ(LCDIR+KNRH),IDN)
- LCIDN=LQ(LTAB-NIDN)
- ENDIF
- LC=LQ(LCIDN-1)
- IQ(LCIDN)=IBANK
- ENDIF
-*
- 20 IERROR=0
- IAD=IQ(LCIDN+2)*(IDNEVT-NEVB*(IBANK-1)-1)
- DO 30 I=1,IQ(LCIDN+2)
- X(I)=Q(LC+IAD+I)
- 30 CONTINUE
- RETURN
-*
-* Error
-*
- 90 IERROR=1
- END
diff --git a/src/packlib/hbook/code/hgnf.F b/src/packlib/hbook/code/hgnf.F
deleted file mode 100644
index 34cee9d..0000000
--- a/src/packlib/hbook/code/hgnf.F
+++ /dev/null
@@ -1,73 +0,0 @@
-*
-* $Id: hgnf.F,v 1.1.1.1 1996/01/16 17:07:39 mclareni Exp $
-*
-* $Log: hgnf.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:39 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.21/08 26/01/94 13.46.18 by Rene Brun
-*-- Author :
- SUBROUTINE HGNF(IDN,IDNEVT,X,IERROR)
-*.==========>
-*. Return in array X the variables of event IDNEVT
-*.
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
-#include "hbook/hcdire.inc"
- COMMON/QUEST/IQUEST(100)
- DIMENSION X(*)
- INTEGER KEYS(2)
-*.___________________________________________
-*
- LC=LQ(LCIDN-1)
- NEVB=IQ(LC-1)/IQ(LCIDN+2)
- IBANK=(IDNEVT-1)/NEVB + 1
-*
-* Load bank containing this event
-*
- IF(IQ(LCIDN+11).EQ.0)THEN
- LC=LQ(LCIDN-3-IBANK)
- ELSE
- IF(IQ(LCIDN).EQ.IBANK.OR.IQ(LCIDN+6).EQ.0)GO TO 20
- IF(IBANK.LE.IQ(LCIDN+6))THEN
- LKEY=LQ(LC)
- IF(LKEY.GT.0)THEN
-*-* case where bank with keys serial numbers exist
- KEYS(1)=IQ(LKEY+IBANK)
- CALL HRZIN(IHDIV,LCIDN,-1,KEYS,99999,'RS')
- ELSE
-*-* case where bank with keys serial numbers does not exist
- IF(ICHTYP(ICDIR).EQ.1)THEN
- KEYS(1) = IQ(LCIDN+5)+10000*IBANK
- KEYS(2) = 0
- ELSE
- KEYS(1) = IQ(LCIDN+5)
- KEYS(2) = IBANK
- ENDIF
- CALL HRZIN(IHDIV,LCIDN,-1,KEYS,99999,'R')
- IF(IQUEST(1).NE.0)GO TO 90
- ENDIF
- ELSE
- IOFSET=IDN-IQ(LCIDN+5)
- CALL HDELET(IDN)
- CALL HRIN(IDN-IOFSET,99999,IOFSET)
- NIDN=LOCATI(IQ(LTAB+1),IQ(LCDIR+KNRH),IDN)
- LCIDN=LQ(LTAB-NIDN)
- ENDIF
- LC=LQ(LCIDN-1)
- IQ(LCIDN)=IBANK
- ENDIF
-*
- 20 IERROR=0
- IAD=IQ(LCIDN+2)*(IDNEVT-NEVB*(IBANK-1)-1)
- DO 30 I=1,IQ(LCIDN+2)
- X(I)=Q(LC+IAD+I)
- 30 CONTINUE
- RETURN
-*
-* Error
-*
- 90 IERROR=1
- END
diff --git a/src/packlib/hbook/code/hgnpar.F b/src/packlib/hbook/code/hgnpar.F
deleted file mode 100644
index 352d0ce..0000000
--- a/src/packlib/hbook/code/hgnpar.F
+++ /dev/null
@@ -1,72 +0,0 @@
-*
-* $Id: hgnpar.F,v 1.1.1.1 1996/01/16 17:07:39 mclareni Exp $
-*
-* $Log: hgnpar.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:39 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.17/01 09/10/92 14.52.30 by Unknown
-*-- Author :
- SUBROUTINE HGNPAR(IDN,CHROUT)
-*.==========>
-*. Get address and parameters of Ntuple IDN.
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
- CHARACTER*(*) CHROUT
- INTEGER KEYS(2)
-*.___________________________________________
-*
- LCIDN=0
- NIDN=LOCATI(IQ(LTAB+1),IQ(LCDIR+KNRH),IDN)
- IF(NIDN.LE.0)THEN
- CALL HRIN(IDN,9999,0)
- NIDN=LOCATI(IQ(LTAB+1),IQ(LCDIR+KNRH),IDN)
- IF(NIDN.LE.0)THEN
- CALL HBUG('Unknown N-tuple',CHROUT,IDN)
- RETURN
- ENDIF
- ENDIF
- LCIDN=LQ(LTAB-NIDN)
- I4=JBIT(IQ(LCIDN+KBITS),4)
- IF(I4.EQ.0)THEN
- CALL HBUG('Not a N-tuple',CHROUT,IDN)
- RETURN
- ENDIF
- IF (IQ(LCIDN-2) .NE. 2) THEN
- CALL HBUG('New N-tuple, this routine works only for old '//
- + 'N-tuples',CHROUT,IDN)
- RETURN
- ENDIF
-*
-* Make Reference links for memory-resident Ntuple
-*
- NCHRZ=IQ(LCIDN+11)
- IF(NCHRZ.EQ.0)THEN
- NMORE=IQ(LCIDN+5)+3-IQ(LCIDN-3)
- IF(NMORE.GT.0)THEN
- CALL MZPUSH(IHDIV,LCIDN,NMORE,0,' ')
- LC=LQ(LCIDN-1)
- IF(IQ(LCIDN+5).GE.1)THEN
- DO 10 IB=1,IQ(LCIDN+5)
- LQ(LCIDN-3-IB)=LC
- LC=LQ(LC)
- IF(LC.EQ.0)GO TO 999
- 10 CONTINUE
- ENDIF
- GO TO 999
- ENDIF
- ENDIF
-*
-* Make sure header is stored on disk
-*
- LC=LQ(LCIDN-1)
- IF(JBIT(IQ(LC),1).NE.0)THEN
- CALL SBIT0(IQ(LC),1)
- KEYS(1) = IDN
- KEYS(2) = 0
- CALL HRZOUT(IHDIV,LCIDN,KEYS,ICYCLE,' ')
- ENDIF
-*
- 999 END
diff --git a/src/packlib/hbook/code/hgstat.F b/src/packlib/hbook/code/hgstat.F
deleted file mode 100644
index bc007c1..0000000
--- a/src/packlib/hbook/code/hgstat.F
+++ /dev/null
@@ -1,91 +0,0 @@
-*
-* $Id: hgstat.F,v 1.1.1.1 1996/01/16 17:07:39 mclareni Exp $
-*
-* $Log: hgstat.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:39 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.23/01 20/02/95 09.43.42 by Julian Bunn
-*-- Author :
- SUBROUTINE HGSTAT(IDD,STAT)
-*.==========>
-*. RETURN SUM OF CONTENTS OF IDD (WITH UNDER OVERFLOWS )
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
- DIMENSION STAT(9)
-*.___________________________________________
-C FIND HISTO WITH IDENTIFIER IDD AND MAKE IT THE
-C CURRENT HISTO
-C
- CALL HFIND(IDD,'HGSTAT')
-C
-C IDD IS AN INVALID IDENTIFIER, RETURN
-C
- IF(LCID.EQ.0)GO TO 99
- NCX=IQ(LPRX)
- IF(LPRY.NE.0)GO TO 20
-C
-C 1-DIM HIST OR PROJECTION
-C
-C UNDERFLOW
-C
- STAT(1)=HCX(0,1)
-C
-C IN RANGE
-C
- STAT(2)=0.
- DO 10 I=1,NCX
- 10 STAT(2)=STAT(2)+HCX(I,1)
-C
-C OVERFLOW
-C
- STAT(3)=HCX(NCX+1,1)
- STAT(4)=-1.0E11
- GO TO 99
-C
-C 2-DIM HIST
-C
- 20 NCY=IQ(LPRY)
-C
-C STAT(1)= (X-UFLW, Y-OFLW)
-C
- STAT(1)=HCXY(0,NCY+1,1)
- STAT(2)=0.
-C
-C STAT(3)= (X-UFLW, Y-OFLW)
-C
- STAT(3)=HCXY(NCX+1,NCY+1,1)
- STAT(4)=0.
- STAT(5)=0.
- STAT(6)=0.
-C
-C STAT(4)= (X-UFLW, Y-RANGE)
-C STAT(5)= (X-RANGE, Y-RANGE)
-C STAT(6)= (X-OFLW, Y-RANGE)
-C
- DO 40 I=1,NCY
- STAT(4)=STAT(4)+HCXY(0,I,1)
- DO 45 J=1,NCX
- 45 STAT(5)=STAT(5)+HCXY(J,I,1)
- 40 STAT(6)=STAT(6)+HCXY(NCX+1,I,1)
-C
-C STAT(7)= (X-UFLW, Y-UFLW)
-C
- STAT(7)=HCXY(0,0,1)
- STAT(8)=0.
-C
-C STAT(2)= (X-RANGE, Y-OFLW)
-C STAT(8)= (X-RANGE, Y-UFLW)
-C
- DO 30 I=1,NCX
- STAT(2)=STAT(2)+HCXY(I,NCY+1,1)
- 30 STAT(8)=STAT(8)+HCXY(I,0,1)
-C
-C STAT(9)= (X-OFLW, Y-UFLW)
-C
- STAT(9)=HCXY(NCX+1,0,1)
-C
- 99 RETURN
- END
diff --git a/src/packlib/hbook/code/hhipar.F b/src/packlib/hbook/code/hhipar.F
deleted file mode 100644
index 2f296b6..0000000
--- a/src/packlib/hbook/code/hhipar.F
+++ /dev/null
@@ -1,87 +0,0 @@
-*
-* $Id: hhipar.F,v 1.1.1.1 1996/01/16 17:07:39 mclareni Exp $
-*
-* $Log: hhipar.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:39 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.23/01 20/02/95 09.44.08 by Julian Bunn
-*-- Author :
- SUBROUTINE HHIPAR(IFLRET)
-*.==========>
-*. PUTS HISTOGRAM PARAMETERS
-*. NUMEP,ALLCHA,BINWID,XMIN,WGTMAX,EPSW ,YMIN,BINWIY IF ANY,
-*. NCHANX INTO /HCFIT2/
-*. RETURNS IFLRET=0 IF HISTOGRAM IS EMPTY
-*..=========> ( R.Brun )
-#include "hbook/hcflag.inc"
-#include "hbook/hcbook.inc"
-#include "hbook/hcfit2.inc"
-#include "hbook/hcfitr.inc"
-*.___________________________________________
- IFLRET=0
-*
- EPSW=1.E-10
- BINWID=(Q(LPRX+2)-Q(LPRX+1))/FLOAT(IQ(LPRX))
- IF(IFTRNG.NE.0)THEN
- ICX1=IFXLOW
- IF(IFXUP.GT.IQ(LPRX))IFXUP=IQ(LPRX)
- ICX2=IFXUP
- NCHANX=ICX2-ICX1+1
- XMIN=Q(LPRX+1)+(ICX1-1)*BINWID
- ELSE
- NCHANX=IQ(LPRX)
- ICX1=1
- ICX2=NCHANX
- XMIN=Q(LPRX+1)
- ENDIF
- NCHANY=1
- ICY1=1
- ICY2=1
- IF(IFLSF.NE.0)GO TO 98
- IF(IDIMPN.NE.3)THEN
- BINWIY=(Q(LPRY+2)-Q(LPRY+1))/FLOAT(IQ(LPRY))
- IF(IFTRNG.NE.0)THEN
- ICY1=IFYLOW
- IF(IFYUP.GT.IQ(LPRY))IFYUP=IQ(LPRY)
- ICY2=IFYUP
- NCHANY=ICY2-ICY1+1
- YMIN=Q(LPRY+1)+(ICY1-1)*BINWIY
- ELSE
- NCHANY=IQ(LPRY)
- ICY1=1
- ICY2=NCHANY
- YMIN=Q(LPRY+1)
- ENDIF
- ENDIF
- NUMEP=NCHANX*NCHANY
-*
-*
-* COMPUTES ALLCHA AND WGTMAX(MAX. CONTENTS)
-*
- ALLCHA=0.
- WGTMAX=0.
- DO 30 J=ICY1,ICY2
- DO 20 I=ICX1,ICX2
- IF(IDIMPN.EQ.3)CONTEN=HCX(I,1)
- IF(IDIMPN.EQ.4)CONTEN=HCXY(I,J,1)
- IF(CONTEN.LT.0.AND.LQ(LCONT).EQ.0)IWEIGH=1
- IF(ABS(CONTEN).GT.WGTMAX)WGTMAX=ABS(CONTEN)
- ALLCHA=ALLCHA+CONTEN
- 20 CONTINUE
- 30 CONTINUE
-*
-* IF(HISTOGRAM IS EMPTY)RETURN
-*
- IF(WGTMAX.EQ.0)THEN
- CALL HBUG('Empty histogram','HFIT**',ID)
- GO TO 99
- ENDIF
-*
- 98 IF(IFLSF.NE.0)NUMEP=NCHANX/IDIMPN
- IFLRET=1
-*
- 99 RETURN
- END
diff --git a/src/packlib/hbook/code/hhxye.F b/src/packlib/hbook/code/hhxye.F
deleted file mode 100644
index 23867be..0000000
--- a/src/packlib/hbook/code/hhxye.F
+++ /dev/null
@@ -1,93 +0,0 @@
-*
-* $Id: hhxye.F,v 1.1.1.1 1996/01/16 17:07:39 mclareni Exp $
-*
-* $Log: hhxye.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:39 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.23/01 20/02/95 09.47.28 by Julian Bunn
-*-- Author :
- SUBROUTINE HHXYE (X,Y,EY)
-*.==========>
-*. COPIES HISTOGRAM BINS (CELLS) ALONG WITH
-*. CONTENTS AND ERRORS INTO X, Y AND EY
-*..=========> ( D.Lienart )
-#include "hbook/hcflag.inc"
-#include "hbook/hcbook.inc"
-#include "hbook/hcpar1.inc"
-#include "hbook/hcpout.inc"
- DIMENSION X(NPMAX,ND),Y(1),EY(1)
-*
- EPSW=1.E-10
- BINWID=(Q(LPRX+2)-Q(LPRX+1))/FLOAT(IQ(LPRX))
- CUR1X=Q(LPRX+1)-BINWID*0.499999
- NCHANX=IQ(LPRX)
- NCHANY=1
- IF (ND.EQ.2) THEN
- NCHANY=IQ(LPRY)
- BINWIY=(Q(LPRY+2)-Q(LPRY+1))/FLOAT(IQ(LPRY))
- CURY=Q(LPRY+1)-BINWIY*0.499999
- ENDIF
-*
-* FILL (Y,EY,X), EY=SQRT(Y)
-* IF (Y.LT.0.) EY=1. - IF (Y/YMAX.LT.EPSW) EJECT BIN
-*
-* CHECK OUT OF ERRORBARS PRESENCE
-*
- IF (LQ(LCONT).NE.0.AND.ND.EQ.1) THEN
- L=1
- CURX=CUR1X
- DO 5 K=1,NCHANX
- CURX=CURX+BINWID
- EY(L)=HCX(K,2)
- IF (EY(L).NE.0.) THEN
- Y(L)=HCX(K,1)
- X(L,1)=CURX
- L=L+1
- ENDIF
- 5 CONTINUE
- ELSE
- YMAX=0.
- K=1
- DO 10 J=1,NCHANY
- DO 10 I=1,NCHANX
- IF (ND.EQ.1) Y(K)=HCX(I,1)
- IF (ND.EQ.2) Y(K)=HCXY(I,J,1)
- IF (ABS(Y(K)).GT.YMAX) YMAX=ABS(Y(K))
- K=K+1
- 10 CONTINUE
- IF (YMAX.EQ.0.) THEN
- CALL HBUG('Empty histogram','HHXYE',ID)
- IFLAG=6
- RETURN
- ENDIF
-*
- K=1
- L=1
- DO 20 J=1,NCHANY
- IF (ND.EQ.2) CURY=CURY+BINWIY
- CURX=CUR1X
- DO 20 I=1,NCHANX
- CURX=CURX+BINWID
- IF (IOPT(3).EQ.1) THEN
- EY(L)=1.
- ELSE
- IF (ABS(Y(K))/YMAX.LE.EPSW) GOTO 15
- Y(L)=Y(K)
- EY(L)=SQRT(ABS(Y(L)))
- ENDIF
- IF (ND.EQ.2) X(L,2)=CURY
- X(L,1)=CURX
- L=L+1
- 15 K=K+1
- 20 CONTINUE
- ENDIF
-*
- NP=L-1
- IF (NP.EQ.0) THEN
- CALL HBUG('Empty histogram','HHXYE',ID)
- IFLAG=6
- ENDIF
- END
diff --git a/src/packlib/hbook/code/hi.F b/src/packlib/hbook/code/hi.F
deleted file mode 100644
index ec83528..0000000
--- a/src/packlib/hbook/code/hi.F
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: hi.F,v 1.1.1.1 1996/01/16 17:07:39 mclareni Exp $
-*
-* $Log: hi.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:39 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.10/05 21/02/89 16.14.49 by Rene Brun
-*-- Author :
- FUNCTION HI(IDD,I)
-*.==========>
-*. RETURNS THE CONTENT OF CHANNEL I OF IDD
-*..=========> ( R.Brun )
-*.___________________________________________
- CALL HFIND(IDD,'HI ')
- HI=HCX(I,1)
- END
diff --git a/src/packlib/hbook/code/hictoi.F b/src/packlib/hbook/code/hictoi.F
deleted file mode 100644
index d287e85..0000000
--- a/src/packlib/hbook/code/hictoi.F
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: hictoi.F,v 1.1.1.1 1996/01/16 17:07:39 mclareni Exp $
-*
-* $Log: hictoi.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:39 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.22/11 23/08/94 14.17.45 by Rene Brun
-*-- Author :
- SUBROUTINE HICTOI(CVAL,IVAL)
-*.==========>
-* Convert character string CVAL into integer value IVAL
-*..=========> ( P.Zanarini (KUIP routine KICTOI)
- COMMON /QUEST/ IQUEST(100)
- CHARACTER*(*) CVAL
- PARAMETER (MAXDIG=15)
- CHARACTER*(MAXDIG) CHTEMP,BLANK
-*.___________________________________________
- IQUEST(1)=0
- L=LENOCC(CVAL)
- IF (L.EQ.0) GO TO 999
- IF (L.GT.MAXDIG) THEN
- IQUEST(1)=1
- GO TO 999
- ENDIF
- DO 10 I=1,L
- IF ((CVAL(I:I).LT.'0'.OR.CVAL(I:I).GT.'9').AND. CVAL(I:I)
- + .NE.'+'.AND.CVAL(I:I).NE.'-'.AND. CVAL(I:I).NE.' ') GO TO 100
- 10 CONTINUE
- BLANK=' '
- IF (L.EQ.MAXDIG) THEN
- CHTEMP=CVAL
- ELSE
- CHTEMP=BLANK(:MAXDIG-L)//CVAL
- ENDIF
- READ (CHTEMP,'(I15)',ERR=100) IVAL
- GO TO 999
- 100 IQUEST(1)=1
- 999 END
diff --git a/src/packlib/hbook/code/hid1.F b/src/packlib/hbook/code/hid1.F
deleted file mode 100644
index bfe9072..0000000
--- a/src/packlib/hbook/code/hid1.F
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: hid1.F,v 1.1.1.1 1996/01/16 17:07:39 mclareni Exp $
-*
-* $Log: hid1.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:39 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.10/05 21/02/89 16.14.49 by Rene Brun
-*-- Author :
- SUBROUTINE HID1(IDVECT,N)
-*.==========>
-*. RETURN LIST OF ALL 1-DIM IDS
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
- DIMENSION IDVECT(1)
-*.___________________________________________
- N=0
- NRHIST=IQ(LCDIR+KNRH)
- DO 10 I=1,NRHIST
- LC=LQ(LTAB-I)
- IF(JBIT(IQ(LC+KBITS),1).EQ.0)GO TO 10
- N=N+1
- IDVECT(N)=IQ(LTAB+I)
- 10 CONTINUE
- END
diff --git a/src/packlib/hbook/code/hid2.F b/src/packlib/hbook/code/hid2.F
deleted file mode 100644
index 028f752..0000000
--- a/src/packlib/hbook/code/hid2.F
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: hid2.F,v 1.1.1.1 1996/01/16 17:07:39 mclareni Exp $
-*
-* $Log: hid2.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:39 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.10/05 21/02/89 16.14.49 by Rene Brun
-*-- Author :
- SUBROUTINE HID2(IDVECT,N)
-*.==========>
-*. RETURN LIST OF ALL 2-DIM IDS
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
- DIMENSION IDVECT(1)
-*.___________________________________________
-#include "hbook/jbyt.inc"
- N=0
- NRHIST=IQ(LCDIR+KNRH)
- DO 10 I=1,NRHIST
- LC=LQ(LTAB-I)
- IF(JBYT(IQ(LC+KBITS),2,2).EQ.0)GO TO 10
- N=N+1
- IDVECT(N)=IQ(LTAB+I)
- 10 CONTINUE
- 99 RETURN
- END
diff --git a/src/packlib/hbook/code/hidall.F b/src/packlib/hbook/code/hidall.F
deleted file mode 100644
index d544596..0000000
--- a/src/packlib/hbook/code/hidall.F
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: hidall.F,v 1.1.1.1 1996/01/16 17:07:39 mclareni Exp $
-*
-* $Log: hidall.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:39 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.10/05 21/02/89 16.14.49 by Rene Brun
-*-- Author :
- SUBROUTINE HIDALL(IDVECT,N)
-*.==========>
-*. RETURN IN IDVECT LIST OF ALL IDS
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
- DIMENSION IDVECT(1)
-*.___________________________________________
- N=IQ(LCDIR+KNRH)
- DO 10 I=1,N
- IDVECT(I)=IQ(LTAB+I)
- 10 CONTINUE
- END
diff --git a/src/packlib/hbook/code/hidopt.F b/src/packlib/hbook/code/hidopt.F
deleted file mode 100644
index cb1e4cc..0000000
--- a/src/packlib/hbook/code/hidopt.F
+++ /dev/null
@@ -1,248 +0,0 @@
-*
-* $Id: hidopt.F,v 1.1.1.1 1996/01/16 17:07:39 mclareni Exp $
-*
-* $Log: hidopt.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:39 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.22/04 02/06/94 14.13.27 by Rene Brun
-*-- Author :
- SUBROUTINE HIDOPT(ID1,KKOPT)
-*.==========>
-*. To set options
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
-#include "hbook/hcbits.inc"
-#include "hbook/hcflag.inc"
-#include "hbook/hcunit.inc"
- CHARACTER*(*)KKOPT
- CHARACTER*4 KOPT
-*
- DIMENSION IOPT(31)
- EQUIVALENCE (IOPT(1),I1)
- CHARACTER*4 CHOPT(31),LCHOPT(21)
- SAVE CHOPT
- DATA CHOPT/' ',' ','TABL',' ',' ',' ','STAT',' '
- + ,' ',' ','ERRO',' ','ROTA','PFUN','PLOW','PHIS'
- + ,' ',' ',' ','MAXI','MINI','INTE','2PAG','1EVL'
- + ,'PSTA','LOGY','BLAC','STAR','PCHA','PCON','PERR'/
-*.___________________________________________
- KOPT=KKOPT
- CALL CLTOU(KOPT)
- IRET=1
- 10 CALL HLOOP(ID1,'HIDOPT',IRET)
- IF(IRET.EQ.0)RETURN
- CALL HDCOFL
-*
- IF (KOPT.EQ.'BLAC')THEN
- CALL HSIFLA(28,0)
- CALL HSIFLA(27,1)
- GO TO 90
- ENDIF
- IF(KOPT.EQ.'CONT')THEN
- CALL HSIFLA(27,0)
- CALL HSIFLA(28,0)
- GO TO 90
- ENDIF
- IF(KOPT.EQ.'STAR')THEN
- CALL HSIFLA(27,0)
- CALL HSIFLA(28,1)
- GO TO 90
- ENDIF
- IF(KOPT.EQ.'STAT')THEN
- CALL HSIFLA(7,1)
- GO TO 90
- ENDIF
- IF(KOPT.EQ.'NSTA')THEN
- CALL HSIFLA(7,0)
- GO TO 90
- ENDIF
- IF(KOPT.EQ.'TABL')THEN
- IF(I230.NE.0)THEN
- CALL HSIFLA(3,1)
- CALL HSIFLA(2,0)
- ENDIF
- GO TO 90
- ENDIF
- IF(KOPT.EQ.'SCAT')THEN
- IF(I230.NE.0)THEN
- CALL HSIFLA(3,0)
- CALL HSIFLA(2,1)
- ENDIF
- GO TO 90
- ENDIF
- IF(KOPT.EQ.'ERRO')THEN
- IF(I9+I10.EQ.0)CALL HSIFLA(11,1)
- GO TO 90
- ENDIF
- IF(KOPT.EQ.'NERR')THEN
- CALL HSIFLA(11,0)
- GO TO 90
- ENDIF
- IF(KOPT.EQ.'INTE')THEN
- CALL HSIFLA(22,1)
- GO TO 90
- ENDIF
- IF(KOPT.EQ.'NINT')THEN
- CALL HSIFLA(22,0)
- GO TO 90
- ENDIF
- IF(KOPT.EQ.'LOGY')THEN
- CALL HSIFLA(26,1)
- GO TO 90
- ENDIF
- IF(KOPT.EQ.'LINY')THEN
- CALL HSIFLA(26,0)
- GO TO 90
- ENDIF
- IF(KOPT.EQ.'PCHA')THEN
- CALL HSIFLA(29,0)
- GO TO 90
- ENDIF
- IF(KOPT.EQ.'NPCH')THEN
- CALL HSIFLA(29,1)
- GO TO 90
- ENDIF
- IF(KOPT.EQ.'PERR')THEN
- CALL HSIFLA(31,1)
- GO TO 90
- ENDIF
- IF(KOPT.EQ.'NPER')THEN
- CALL HSIFLA(31,0)
- GO TO 90
- ENDIF
- IF(KOPT.EQ.'PFUN')THEN
- CALL HSIFLA(14,1)
- GO TO 90
- ENDIF
- IF(KOPT.EQ.'NPFU')THEN
- CALL HSIFLA(14,0)
- GO TO 90
- ENDIF
- IF(KOPT.EQ.'PLOW')THEN
- CALL HSIFLA(15,0)
- GO TO 90
- ENDIF
- IF(KOPT.EQ.'NPLO')THEN
- CALL HSIFLA(15,1)
- GO TO 90
- ENDIF
- IF(KOPT.EQ.'PHIS')THEN
- CALL HSIFLA(16,0)
- GO TO 90
- ENDIF
- IF(KOPT.EQ.'NPHI')THEN
- CALL HSIFLA(16,1)
- GO TO 90
- ENDIF
- IF(KOPT.EQ.'PSTA')THEN
- CALL HSIFLA(25,0)
- GO TO 90
- ENDIF
- IF(KOPT.EQ.'NPST')THEN
- CALL HSIFLA(25,1)
- GO TO 90
- ENDIF
- IF(KOPT.EQ.'PCON')THEN
- CALL HSIFLA(30,0)
- GO TO 90
- ENDIF
- IF(KOPT.EQ.'NPCO')THEN
- CALL HSIFLA(30,1)
- GO TO 90
- ENDIF
- IF(KOPT.EQ.'ROTA')THEN
- CALL HSIFLA(13,1)
- GO TO 90
- ENDIF
- IF(KOPT.EQ.'NROT')THEN
- CALL HSIFLA(13,0)
- GO TO 90
- ENDIF
- IF(KOPT.EQ.'1EVL')THEN
- CALL HSIFLA(24,1)
- GO TO 90
- ENDIF
- IF(KOPT.EQ.'AEVL')THEN
- CALL HSIFLA(24,0)
- GO TO 90
- ENDIF
- IF(KOPT.EQ.'2PAG')THEN
- CALL HSIFLA(23,1)
- GO TO 90
- ENDIF
- IF(KOPT.EQ.'1PAG')THEN
- CALL HSIFLA(23,0)
- GO TO 90
- ENDIF
- IF(KOPT.EQ.'AUTO')THEN
- CALL HSIFLA(20,0)
- CALL HSIFLA(21,0)
- GO TO 90
- ENDIF
- IF(KOPT.EQ.'PROE')THEN
- LCONT=LQ(LCID-1)
- LW=LQ(LCONT)
- IF(LW.NE.0)CALL SBYT(0,IQ(LW),1,2)
- GO TO 90
- ENDIF
- IF(KOPT.EQ.'PROS')THEN
- LCONT=LQ(LCID-1)
- LW=LQ(LCONT)
- IF(LW.NE.0)CALL SBYT(1,IQ(LW),1,2)
- GO TO 90
- ENDIF
- IF(KOPT.EQ.'PROI')THEN
- LCONT=LQ(LCID-1)
- LW=LQ(LCONT)
- IF(LW.NE.0)CALL SBYT(2,IQ(LW),1,2)
- GO TO 90
- ENDIF
- IF(KOPT.EQ.'SETD')THEN
- DO 20 I=11,16
- CALL HSIFLA(I,0)
- 20 CONTINUE
- DO 30 I=22,31
- CALL HSIFLA(I,0)
- 30 CONTINUE
- GO TO 90
- ENDIF
- IF(KOPT.EQ.'SHOW')THEN
- NCH=0
- DO 40 I=3,31
- IF(CHOPT(I).EQ.' ')GO TO 40
- IF(IOPT(I).EQ.0)GO TO 40
- IF(NCH.GT.20)GO TO 40
- NCH=NCH+1
- LCHOPT(NCH)=CHOPT(I)
- 40 CONTINUE
- IF(I1.NE.0.AND.I8.NE.0)THEN
- LCONT=LQ(LCID-1)
- LW=LQ(LCONT)
- IF(LW.NE.0)THEN
- NCH=NCH+1
- IOPTS=JBYT(IQ(LW),1,2)
- IF(IOPTS.EQ.0)THEN
- LCHOPT(NCH)='PROE'
- ELSEIF(IOPTS.EQ.1)THEN
- LCHOPT(NCH)='PROS'
- ELSE
- LCHOPT(NCH)='PROI'
- ENDIF
- ENDIF
- ENDIF
- IF(NCH.EQ.0)THEN
- WRITE(LOUT,1000)ID
- ELSE
- WRITE(LOUT,1100)ID,(LCHOPT(I),I=1,NCH)
- ENDIF
- ENDIF
- 90 CALL HDCOFL
-*
- IRET=2
- GO TO 10
- 1000 FORMAT(' ID=',I8,' Options : NONE')
- 1100 FORMAT(' ID=',I8,' Options :',20(1X,A4))
- END
diff --git a/src/packlib/hbook/code/hidpos.F b/src/packlib/hbook/code/hidpos.F
deleted file mode 100644
index 0a645e6..0000000
--- a/src/packlib/hbook/code/hidpos.F
+++ /dev/null
@@ -1,72 +0,0 @@
-*
-* $Id: hidpos.F,v 1.1.1.1 1996/01/16 17:07:39 mclareni Exp $
-*
-* $Log: hidpos.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:39 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.21/01 01/11/93 18.24.14 by Fons Rademakers
-*-- Author : Alfred Nathaniel 13/04/93
- SUBROUTINE HIDPOS(IDH,IDPOS)
-*
-* locate the position of histogram IDH in LTAB
-*
-* CALL HIDPOS(IDH,IDPOS)
-* is the replacement for
-* IDPOS=LOCATI(IQ(LTAB+1),IQ(LCDIR+KNRH),IDH)
-*
-* The Piaf server has to import the histogram from the client in case it
-* does not exist in the local /PAWC/.
-*
-#include "hbook/hcbook.inc"
-#include "hbook/hcpiaf.inc"
-#if defined(CERNLIB_CZ)
-#include "hbook/hcache.inc"
-#endif
-*
- IDPOS = LOCATI(IQ(LTAB+1),IQ(LCDIR+KNRH),IDH)
-*
-#if defined(CERNLIB_CZ)
- IF (IDPOS.LE.0 .AND. SERVPF) THEN
-*
-*-- Check if IDH is in the cache of not existing histograms so we
-*-- don't have to ask the master server or the client over-and-over
-*-- if the histogram exists
-*
- IDNPOS = LOCATI(IDNOT,IDTNOT,IDH)
- IF (IDNPOS .GT. 0) THEN
- IDPOS = 0
- RETURN
- ENDIF
-*
- WRITE(CHSMPF,'(A,I12)') 'HEXIST',IDH
- CALL CZPUTA(CHSMPF,ISTAT)
- CALL CZGETA(CHSMPF,ISTAT)
- IF (CHSMPF.EQ.'YES') THEN
- WRITE(CHSMPF,'(A,I12)') 'HOUTPF',IDH
- CALL CZPUTA(CHSMPF,ISTAT)
- CALL HINPF(IDH,0)
- IDPOS = LOCATI(IQ(LTAB+1),IQ(LCDIR+KNRH),IDH)
- ELSE
-*
-*-- Fill the cache of not existing histograms.
-*-- This cache is reset by the command 'histo/delete 0', issued before
-*-- executing an Ntuple command.
-*
- IF (IDTNOT .LT. IDMXNT) THEN
- IDNPOS = -IDNPOS + 1
- DO 10 I = IDTNOT, IDNPOS, -1
- IDNOT(I+1) = IDNOT(I)
- 10 CONTINUE
- IDNOT(IDNPOS) = IDH
- IDTNOT = IDTNOT + 1
- ENDIF
- IF (MASTPF) THEN
- PRINT *, ' *** Piaf: Unknown histogram, ID=', IDH
- ENDIF
- ENDIF
- ENDIF
-#endif
- END
diff --git a/src/packlib/hbook/code/hie.F b/src/packlib/hbook/code/hie.F
deleted file mode 100644
index 7eab0ff..0000000
--- a/src/packlib/hbook/code/hie.F
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: hie.F,v 1.1.1.1 1996/01/16 17:07:39 mclareni Exp $
-*
-* $Log: hie.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:39 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.10/05 21/02/89 16.14.49 by Rene Brun
-*-- Author :
- FUNCTION HIE(IDD,I)
-*.==========>
-*. RETURNS SQUARE OF ERROR OF CHANNEL I OF IDD
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
-*.___________________________________________
- CALL HFIND(IDD,'HIE ')
- IF(JBIT(IQ(LCID+KBITS),9).NE.0)THEN
- HIE=HCX(I,2)
- ELSE
- RES=ABS(HCX(I,1))
- HIE=SQRT(RES)
- ENDIF
- END
diff --git a/src/packlib/hbook/code/hif.F b/src/packlib/hbook/code/hif.F
deleted file mode 100644
index aca6765..0000000
--- a/src/packlib/hbook/code/hif.F
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: hif.F,v 1.1.1.1 1996/01/16 17:07:39 mclareni Exp $
-*
-* $Log: hif.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:39 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.10/05 21/02/89 16.14.49 by Rene Brun
-*-- Author :
- FUNCTION HIF(IDD,I)
-*.==========>
-*. RETURN FUNCTION CORRESPONDING TO CHANNEL I OF IDD
-*..=========> ( R.Brun )
-*.___________________________________________
- CALL HFIND(IDD,'HIF ')
- HIF=HCX(I,3)
- END
diff --git a/src/packlib/hbook/code/hij.F b/src/packlib/hbook/code/hij.F
deleted file mode 100644
index 69e493e..0000000
--- a/src/packlib/hbook/code/hij.F
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: hij.F,v 1.1.1.1 1996/01/16 17:07:40 mclareni Exp $
-*
-* $Log: hij.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:40 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.23/01 20/02/95 09.47.50 by Julian Bunn
-*-- Author :
- FUNCTION HIJ(IDD,I,J)
-*.==========>
-*. RETURN THE CONTENT OF CELL (I,J) OF IDD
-*..=========> ( R.Brun )
-*.___________________________________________
- CALL HFIND(IDD,'HIJ ')
- HIJ=HCXY(I,J,1)
- END
diff --git a/src/packlib/hbook/code/hije.F b/src/packlib/hbook/code/hije.F
deleted file mode 100644
index a37b494..0000000
--- a/src/packlib/hbook/code/hije.F
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: hije.F,v 1.1.1.1 1996/01/16 17:07:40 mclareni Exp $
-*
-* $Log: hije.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:40 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.23/01 20/02/95 10.21.54 by Julian Bunn
-*-- Author :
- FUNCTION HIJE(IDD,I,J)
-*.==========>
-*. RETURN THE ERROR ON CELL (I,J) OF IDD
-*..=========> ( J.Bunn )
-*.___________________________________________
- CALL HFIND(IDD,'HIJE ')
- HIJE=HCXY(I,J,2)
- END
diff --git a/src/packlib/hbook/code/hijxy.F b/src/packlib/hbook/code/hijxy.F
deleted file mode 100644
index 4b4cb04..0000000
--- a/src/packlib/hbook/code/hijxy.F
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: hijxy.F,v 1.1.1.1 1996/01/16 17:07:40 mclareni Exp $
-*
-* $Log: hijxy.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:40 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.19/00 26/04/93 11.57.51 by Rene Brun
-*-- Author :
- SUBROUTINE HIJXY(IDD,I,J,X,Y)
-*.==========>
-*. RETURNS THE VALUES I,J CORRESPONDING TO X,Y
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
-*.___________________________________________
- CALL HFIND(IDD,'HIJXY ')
- DX=(Q(LCID+KXMAX)-Q(LCID+KXMIN))/FLOAT(IQ(LCID+KNCX))
- DY=(Q(LCID+KYMAX)-Q(LCID+KYMIN))/FLOAT(IQ(LCID+KNCY))
- X=FLOAT(I-1)*DX+Q(LCID+KXMIN)
- Y=FLOAT(J-1)*DY+Q(LCID+KYMIN)
- END
diff --git a/src/packlib/hbook/code/hindex.F b/src/packlib/hbook/code/hindex.F
deleted file mode 100644
index 73fea2e..0000000
--- a/src/packlib/hbook/code/hindex.F
+++ /dev/null
@@ -1,247 +0,0 @@
-*
-* $Id: hindex.F,v 1.2 1998/11/10 09:18:51 couet Exp $
-*
-* $Log: hindex.F,v $
-* Revision 1.2 1998/11/10 09:18:51 couet
-* - mods for Y2K
-*
-* Revision 1.1.1.1 1996/01/16 17:07:40 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.22/11 23/08/94 14.17.45 by Rene Brun
-*-- Author :
- SUBROUTINE HINDEX
-*.==========>
-*. prints index of histograms
-*..=========> ( R.Brun )
-*
-#include "hbook/hcflag.inc"
-#include "hbook/hcbits.inc"
-#include "hbook/hcunit.inc"
-#include "hbook/hcbook.inc"
-#include "hbook/hcvers.inc"
-#include "hbook/hcprin.inc"
- COMMON/HFORM/IA(127),IDU
-*.___________________________________________
- IF(IPONCE.EQ.2)GO TO 999
- IH=0
- NHT=0
- NH=0
-*
-* PRINT GLOBAL TITLE,IF ANY
-*
- CALL HFORMA(3)
- CALL VBLANK(IA,128)
- IF(LGTIT.EQ.0)GO TO 10
- J=IQ(LGTIT-1)
- IF(J.EQ.0)GO TO 10
- IF(J.GT.20)J=20
- DO 5 I=1,J
- CALL UBLOW(IQ(LGTIT+I),IA(4*I-3),4)
- 5 CONTINUE
- CALL HFORMA(1)
- CALL HFORMA(2)
-*
- 10 CALL VFILL(IA,125,IDG(38))
- CALL HFORMA(1)
- CALL VBLANK(IA(2),123)
- CALL HFORMA(1)
-*
-*
-* PRINT HEADER
-*
- WRITE(LOUT,9010) INSTAL,IVERS,CHDATE
-*
- CALL HFORMA(1)
- CALL VFILL(IA,125,IDG(38))
- CALL HFORMA(1)
- CALL VBLANK(IA(2),123)
- CALL HFORMA(1)
-*
-* PRINT EXPLANATION OF COLUMNS
-*
- WRITE(LOUT,9020)
-*
- CALL HFORMA(1)
- CALL VFILL(IA,125,IDG(38))
- CALL HFORMA(1)
- CALL VBLANK(IA(2),123)
- CALL HFORMA(1)
-*
-* PRINT INFORMATION RELATIVE TO EACH HISTOGRAM
-*
- IDD=0
- IRET=3
-*
- 20 CALL HLOOP(IDD,'HINDEX',IRET)
-*
- IF(IRET.EQ.0)GO TO 130
- NBX=0
- NBY=0
- CALL HDCOFL
- ILINK=0
-*
- 25 ILINK=ILINK+1
- IF(ILINK.GT.1.AND.I1.NE.0)GO TO 120
- IF(ILINK.GT.7.AND.I1.EQ.0)GO TO 120
- LCONT=LQ(LCID-ILINK)
- IF(LCONT.EQ.0)GO TO 25
- GO TO (30,50,60,70,70,100,110),ILINK
-*
-* 1-DIM HISTOGRAM
-*
- 30 IF(I1.NE.0)THEN
- XLOW=Q(LCID+KXMIN)
- CALL HFORMA(1)
- NWTITL=(IQ(LCID-1)-KTIT1+1)
- IF(NWTITL.GT.20)NWTITL=20
- CALL VBLANK(IA(2),80)
- DO 35 I=1,NWTITL
- K=4*(I-1)+2
- CALL UBLOW(IQ(LCID+KTIT1+I-1),IA(K),4)
- 35 CONTINUE
- NH=NH+1
-*
- WRITE(LOUT,9800)NH,(IA(I),I=2,41),ID,IQ(LCONT+KNBIT),
- + IQ(LCONT+KNOENT),IDG(2),IDG(34),IQ(LCID+KNCX),XLOW,
- + Q(LCID+KXMAX),LCID,IQ(LCID+KNTOT)
-*
- WRITE(LOUT,9810)(IA(I),I=42,81)
- CALL VBLANK(IA(2),123)
- GO TO 120
- ENDIF
-*
-* N-tuple
-*
- IF(I4.NE.0)THEN
- CALL HFORMA(1)
- NWTITL=IQ(LCID+8)
- CALL VBLANK(IA(2),80)
- ITIT1=IQ(LCID+9)
- DO 36 I=1,NWTITL
- K=4*(I-1)+2
- CALL UBLOW(IQ(LCID+ITIT1+I-1),IA(K),4)
- 36 CONTINUE
- NH=NH+1
-*
- WRITE(LOUT,9820)NH,(IA(I),I=2,41),ID,IDG(24),LCID,IQ(LCID-1)
-*
- WRITE(LOUT,9810)(IA(I),I=42,81)
- CALL VBLANK(IA(2),123)
- GO TO 120
- ENDIF
-*
-* 2-DIM HISTOGRAM
-*
- IF(I230.EQ.0)GO TO 120
- XLOW=Q(LCID+KXMIN)
- YLOW=Q(LCID+KYMIN)
- NH=NH+1
- NWTITL=(IQ(LCID-1)-KTIT2+1)
- NCX=IQ(LCID+KNCX)
- NCY=IQ(LCID+KNCY)
- CALL HFORMA(1)
- CALL VBLANK(IA(2),80)
- IF(NWTITL.GT.20)NWTITL=20
- DO 37 I=1,NWTITL
- K=4*(I-1)+2
- CALL UBLOW(IQ(LCID+KTIT2+I-1),IA(K),4)
- 37 CONTINUE
-*
- WRITE(LOUT,9800)NH,(IA(I),I=2,41),ID,IQ(LCONT+KNBIT),
- +IQ(LCONT+KNOENT),IDG(3),IDG(34),NCX,XLOW,
- +Q(LCID+KXMAX),LCID,IQ(LCID+KNTOT)
-*
- NT2=IQ(LCONT-1)+10
- WRITE(LOUT,9805)(IA(I),I=42,81),IDG(35),NCY,YLOW,
- + Q(LCID+KYMAX),LCONT,NT2
-*
- CALL VBLANK(IA(2),123)
- GO TO 25
-*
-* PROJECTION X
-*
- 50 CALL HINPRX('PROJECTION X',IDG(34),0,NCX,XLOW,Q(LCID+KXMAX),
- +LCONT)
- GO TO 25
-*
-* PROJECTION Y
-*
- 60 CALL HINPRX('PROJECTION Y',IDG(35),0,NCY,YLOW,Q(LCID+KYMAX),
- +LCONT)
- GO TO 25
-*
-* SLICES
-*
- 70 NSL=IQ(LCONT-2)
- DO 90 NUM=1,NSL
- LC=LQ(LCONT-NUM)
- IF(ILINK.EQ.4)THEN
- BW=(Q(LCID+KYMAX)-Q(LCID+KYMIN))/FLOAT(NSL)
- YMIN=Q(LCID+KYMIN)+BW*FLOAT(NUM-1)
- YMAX=YMIN+BW
- CALL HINPRX('SLICE X ',IDG(34),NUM,NCX,YMIN,YMAX,LC)
- ELSE
- BW=(Q(LCID+KXMAX)-Q(LCID+KXMIN))/FLOAT(NSL)
- XMIN=Q(LCID+KXMIN)+BW*FLOAT(NUM-1)
- XMAX=XMIN+BW
- CALL HINPRX('SLICE Y ',IDG(35),NUM,NCY,XMIN,XMAX,LC)
- ENDIF
- 90 CONTINUE
- GO TO 25
-*
-* BAND X
-*
- 100 LBANX=LCONT
- 105 LCONT=LQ(LBANX-1)
- NBX=NBX+1
- YMIN=Q(LBANX+1)
- YMAX=Q(LBANX+2)
- CALL HINPRX('BAND X ',IDG(34),NBX,NCX,YMIN,YMAX,LCONT)
- LBANX=LQ(LBANX)
- IF(LBANX.NE.0)GO TO 105
- GO TO 25
-*
-* BAND Y
-*
- 110 LBANY=LCONT
- 115 LCONT=LQ(LBANY-1)
- NBY=NBY+1
- XMIN=Q(LBANY+1)
- XMAX=Q(LBANY+2)
- CALL HINPRX('BAND Y ',IDG(35),NBY,NCY,XMIN,XMAX,LCONT)
- LBANY=LQ(LBANY)
- IF(LBANY.NE.0)GO TO 115
- GO TO 25
-*
- 120 IRET=2
- GO TO 20
-*
-* PRINT INFORMATION,ABOUT MEMORY AND DISK USAGE
-*
- 130 CALL HFORMA(1)
- CALL VFILL(IA,125,IDG(38))
- CALL HFORMA(1)
- WRITE(LOUT,9090)
- WRITE(LOUT,9092)NWPAW
- NH=0
- IF(IPONCE.NE.0)IPONCE=2
-*
-*
- 9010 FORMAT(' .',3X,'HBOOK',3X,20A1,3X,'VERSION ',5A1,6X,
- + 'HISTOGRAM AND PLOT INDEX ',27X,A10,5X,'.')
- 9020 FORMAT(' .',2X,'NO',21X,'TITLE',22X,'ID',2X,'B/C',2X,
- + 'ENTRIES',1X,'DIM',3X,'NCHA',5X,'LOWER',7X,'UPPER',
- + 7X,'ADDRESS',1X,'LENGTH',1X,'.')
- 9800 FORMAT(' .',I4,2X,40A1,1X,I7,2X,I2,I9,2(2X,A1),
- + I6,2(2X,E10.3),3X,I9,I7,1X,'.')
- 9805 FORMAT(' .',6X,40A1,26X,A1,I6,2X,E10.3,2X,E10.3,
- + 3X,I9,I7,1X,'.')
- 9810 FORMAT(' .',6X,40A1,77X,'.')
- 9820 FORMAT(' .',I4,2X,40A1,I8,15X,A1,36X,I9,I7,1X,'.')
- 9090 FORMAT(///,' MEMORY UTILISATION',/)
- 9092 FORMAT(' ',5X,'MAXIMUM TOTAL SIZE OF COMMON /PAWC/ ',I10)
- 999 RETURN
- END
diff --git a/src/packlib/hbook/code/hinpf.F b/src/packlib/hbook/code/hinpf.F
deleted file mode 100644
index f0a1560..0000000
--- a/src/packlib/hbook/code/hinpf.F
+++ /dev/null
@@ -1,105 +0,0 @@
-*
-* $Id: hinpf.F,v 1.1.1.1 1996/01/16 17:07:40 mclareni Exp $
-*
-* $Log: hinpf.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:40 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-#if defined(CERNLIB_CZ)
-*CMZ : 4.21/01 27/10/93 17.06.00 by Fons Rademakers
-*-- Author : Alfred Nathaniel 13/04/93
- SUBROUTINE HINPF(IDH,IREPL)
-*
-* Receive a histogram
-*
-* IREPL.LT.0 : print warning if IDH already exists
-* IREPL.EQ.0 : replace without warning
-* IREPL.GT.0 : add histograms if IDH already exists
-*
-#include "hbook/hcflag.inc"
-#include "hbook/hcbook.inc"
-#include "hbook/hcpiaf.inc"
-*
- COMMON/QUEST/IQUEST(100)
-
-*
-* Check if IDH already in the table
-*
- IDD=IDH
- NRHIST=IQ(LCDIR+KNRH)
- IDPOS=LOCATI(IQ(LTAB+1),NRHIST,IDD)
- IF(IDPOS.GT.0) THEN
- IF(IREPL.LT.0) THEN
- CALL HBUG('Already existing histogram replaced','HINPF',IDD)
- ENDIF
- IF(IREPL.LE.0) THEN
- CALL HDELET(IDD)
- NRHIST=IQ(LCDIR+KNRH)
- ELSE
-*--- allocate a new IDD for adding
- IDD=IQ(LTAB+NRHIST)+1
- IDPOS=NRHIST+1
- ENDIF
- IDPOS=-IDPOS+1
- ENDIF
-*
-* Enter IDD in the list of ordered IDs
-*
- IDPOS=-IDPOS+1
- IF(NRHIST.GE.IQ(LTAB-1)) THEN
- CALL MZPUSH(IHDIV,LTAB,500,500,' ')
- ENDIF
- DO 10 I=NRHIST,IDPOS,-1
- IQ(LTAB+I+1)=IQ(LTAB+I)
- LQ(LTAB-I-1)=LQ(LTAB-I)
- 10 CONTINUE
-*
-* Import histogram data structure
-*
- NUH=0
- IF(LIDS.EQ.0)THEN
- CALL FZIN(999,IHDIV,LCDIR,-2,' ',NUH,0)
- IF(IQUEST(1).NE.0) GOTO 99
- LIDS=LQ(LCDIR-2)
- LCID=LIDS
- ELSE
- LLID=LQ(LCDIR-9)
- CALL FZIN(999,IHDIV,LLID,0,' ',NUH,0)
- IF(IQUEST(1).NE.0) GOTO 99
- LCID=LQ(LLID)
- ENDIF
- IQ(LCID-5)=IDD
- LQ(LCDIR-9)=LCID
- IQ(LCDIR+KNRH)=IQ(LCDIR+KNRH)+1
- IQ(LTAB+IDPOS)=IDD
- LQ(LTAB-IDPOS)=LCID
- CALL SBIT0(IQ(LCID),5)
-*
-* Add histograms
-*
- IF(IDD.NE.IDH) THEN
- CALL HOPERA(IDH,'+',IDD,IDH,1.,1.)
- CALL HDELET(IDD)
-*
-* Existing histogram was updated so clear bit 6 of status word
-*
- NRHIST=IQ(LCDIR+KNRH)
- IDPOS=LOCATI(IQ(LTAB+1),NRHIST,IDH)
- CALL SBIT0(IQ(LQ(LTAB-IDPOS)),6)
- ENDIF
-*
-* On slave servers histograms should always be cleared to prevent multiple
-* counting when the partial histograms are added by the master server
-*
- IF (SLAVPF) THEN
- CALL HRESET(IDH,' ')
- ENDIF
-
- RETURN
-
- 99 CONTINUE
- CALL HBUG('Bad sequence for FZ','HINPF',IDD)
- END
-#endif
diff --git a/src/packlib/hbook/code/hinprx.F b/src/packlib/hbook/code/hinprx.F
deleted file mode 100644
index aab1e52..0000000
--- a/src/packlib/hbook/code/hinprx.F
+++ /dev/null
@@ -1,38 +0,0 @@
-*
-* $Id: hinprx.F,v 1.1.1.1 1996/01/16 17:07:40 mclareni Exp $
-*
-* $Log: hinprx.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:40 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.22/11 19/08/94 13.51.14 by Rene Brun
-*-- Author :
- SUBROUTINE HINPRX(LABEL,IXY,NUM,NC,XLOW,XUP,LC)
-*.==========>
-*. PRINTS INDEX INFO FOR PRO, BAND,SLICE
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
-#include "hbook/hcprin.inc"
-#include "hbook/hcunit.inc"
- COMMON/HFORM/IA(127),IDU
- CHARACTER*(*) LABEL
-*.___________________________________________
- CALL VBLANK(IA(2),12)
- CALL UCTOH(LABEL,IA(2),1,12)
- IF(NUM.NE.0)CALL HBCDI(NUM,3,IA(11))
- NH=NH+1
- NT=IQ(LC-1)+12
- IF(LQ(LC).NE.0)THEN
- LW=LQ(LC)
- NT=NT+IQ(LW-1)+10
- ENDIF
-*
- WRITE(LOUT,9700)NH,(IA(I),I=2,13),IQ(LC+KNBIT),IQ(LC+KNOENT),
- + IDG(2),IXY,NC,XLOW,XUP,LC,NT
- 9700 FORMAT(' .',I4,12X,12A1,28X,I2,I9,2(2X,A1),I6,
- * 2(2X,E10.3),3X,I9,I7,1X,'.')
-*
- CALL VBLANK(IA(2),123)
- END
diff --git a/src/packlib/hbook/code/hinq.F b/src/packlib/hbook/code/hinq.F
deleted file mode 100644
index a75003f..0000000
--- a/src/packlib/hbook/code/hinq.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: hinq.F,v 1.1 1997/01/29 09:09:10 couet Exp $
-*
-* $Log: hinq.F,v $
-* Revision 1.1 1997/01/29 09:09:10 couet
-* - New routine to inquire if a LUN is used by HBOOK or not.
-*
-*
-#include "hbook/pilot.h"
-*-- Author : Olivier Couet
- LOGICAL FUNCTION HINQ(LUN)
-*.==========>
-*. Returns .TRUE. if the LUN is used by HBOOK, .FALSE. otherwise.
-*..=========>
-#include "hbook/hcdire.inc"
-*.___________________________________________
-*
- HINQ=.FALSE.
- DO 10 I=2,NCHTOP
- IF(ICHTOP(I).EQ.LUN)THEN
- HINQ=.TRUE.
- RETURN
- ENDIF
- 10 CONTINUE
-*
- END
diff --git a/src/packlib/hbook/code/hinteg.F b/src/packlib/hbook/code/hinteg.F
deleted file mode 100644
index db690f0..0000000
--- a/src/packlib/hbook/code/hinteg.F
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: hinteg.F,v 1.1.1.1 1996/01/16 17:07:40 mclareni Exp $
-*
-* $Log: hinteg.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:40 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.10/05 21/02/89 16.14.49 by Rene Brun
-*-- Author :
- SUBROUTINE HINTEG(ID1)
-*.==========>
-*. AT EDITING TIME INTEGRATED CONTENTS WILL BE PRINTED
-*..=========> ( R.Brun )
-*.___________________________________________
- CALL HIDOPT(ID1,'INTE')
- CALL HOBSOL('HINTEG','INTE','NINT')
- END
diff --git a/src/packlib/hbook/code/hipak1.F b/src/packlib/hbook/code/hipak1.F
deleted file mode 100644
index 364832a..0000000
--- a/src/packlib/hbook/code/hipak1.F
+++ /dev/null
@@ -1,74 +0,0 @@
-*
-* $Id: hipak1.F,v 1.1.1.1 1996/01/16 17:07:40 mclareni Exp $
-*
-* $Log: hipak1.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:40 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.19/00 26/04/93 09.16.28 by Rene Brun
-*-- Author :
- SUBROUTINE HIPAK1(ID1,NID,IX,N)
-*.==========>
-*. FAST FILLING ROUTINE FOR 1-DIM HIST
-*. NID IS AN OUTPUT PARAMETER = HIST NUMBER-1
-*. N IS THE NUMBER OF ELEMENTS OF ARRAY IX TO BE FILLED
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
-#include "hbook/hcflag.inc"
-#include "hbook/hcprin.inc"
- DIMENSION IX(1),NID(1)
- SAVE BWID1
-*.___________________________________________
-#include "hbook/jbyt.inc"
- IF(ID1.NE.IDLAST)THEN
-*
-* CHECK IF ID1 IS AT THE ADDRESS CORRESPONDING TO NID(1)
-* IF NOT COMPUTE NID(1).
-*
- IF(NID(1).LE.0)GO TO 10
- IF(NID(1).GT.IQ(LCDIR+KNRH))GO TO 10
- LCID=LQ(LTAB-NID(1))
- IF(IQ(LTAB+NID(1)).EQ.ID1)GO TO 20
-*
-* SEARCH ADDRESS OF ID IN THE ADDRESS TABLE (BINARY SEARCH)
-*
- 10 ID=ID1
- IDPOS=LOCATI(IQ(LTAB+1),IQ(LCDIR+KNRH),ID)
- IF(IDPOS.LE.0)RETURN
- NID(1)=IDPOS
-*
-* COMPUTE POINTERS TO ACCESS HISTOGRAM AREA
-*
- 20 IDLAST=ID1
- LCID =LQ(LTAB-NID(1))
- LCONT=LQ(LCID-1)
- BWID1=FLOAT(IQ(LCID+KNCX))/(Q(LCID+KXMAX)-Q(LCID+KXMIN))
- ENDIF
-*
-* INCREMENT NUMBER OF ENTRIES AND COMPUTE CHANNEL NUMBER
-*
- IQ(LCONT+KNOENT)=IQ(LCONT+KNOENT)+N
- DO 30 I=1,N
- X=IX(I)
- IF(X.LT.Q(LCID+KXMIN))THEN
- ICHAN=0
- ELSEIF(X.GE.Q(LCID+KXMAX))THEN
- ICHAN=IQ(LCID+KNCX)+1
- ELSE
- ICHAN=(X-Q(LCID+KXMIN))*BWID1+1
- ENDIF
- IF(IQ(LCONT+KNBIT).GE.32)THEN
- Q(LCONT+ICHAN+KCON1)=Q(LCONT+ICHAN+KCON1)+1.
- ELSE
- NBPROX=IQ(LCONT+KNBIT)
- NB=32/NBPROX
- LWORD=ICHAN/NB
- LBIT=(ICHAN-NB*LWORD)*NBPROX+1
- INC=JBYT(IQ(LCONT+LWORD+KCON1),LBIT,NBPROX)+1
- IF(INC.GT.MAXBIT(NBPROX))INC=MAXBIT(NBPROX)
- CALL SBYT(INC,IQ(LCONT+LWORD+KCON1),LBIT,NBPROX)
- ENDIF
- 30 CONTINUE
- END
diff --git a/src/packlib/hbook/code/histdo.F b/src/packlib/hbook/code/histdo.F
deleted file mode 100644
index afab53f..0000000
--- a/src/packlib/hbook/code/histdo.F
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: histdo.F,v 1.1.1.1 1996/01/16 17:07:40 mclareni Exp $
-*
-* $Log: histdo.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:40 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.10/05 16/03/89 17.37.20 by Rene Brun
-*-- Author :
- SUBROUTINE HISTDO
-*.==========>
-*. PRINT INDEX AND EDIT ALL HISTOGRAMS
-*..=========> ( R.Brun )
-*.___________________________________________
- CALL HPDIR('//PAWC','TI')
- END
diff --git a/src/packlib/hbook/code/histgo.F b/src/packlib/hbook/code/histgo.F
deleted file mode 100644
index 0cdbb6d..0000000
--- a/src/packlib/hbook/code/histgo.F
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: histgo.F,v 1.1.1.1 1996/01/16 17:07:40 mclareni Exp $
-*
-* $Log: histgo.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:40 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.10/05 21/02/89 16.14.49 by Rene Brun
-*-- Author :
- SUBROUTINE HISTGO (N)
-*.==========>
-*. Dummy routine in HBOOK4
-*..=========> ( R.Brun )
- CALL HDUMMY('HISTGO')
- END
diff --git a/src/packlib/hbook/code/hix.F b/src/packlib/hbook/code/hix.F
deleted file mode 100644
index b7e2382..0000000
--- a/src/packlib/hbook/code/hix.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: hix.F,v 1.1.1.1 1996/01/16 17:07:40 mclareni Exp $
-*
-* $Log: hix.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:40 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.19/00 26/04/93 11.57.51 by Rene Brun
-*-- Author :
- SUBROUTINE HIX(IDD,I,X)
-*.==========>
-*. RETURNS THE ABSCISSA CORRESPONDING TO CHANNEL I
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
-#include "hbook/hcbits.inc"
-*.___________________________________________
- CALL HFIND(IDD,'HIX ')
- CALL HDCOFL
- IF(I6.EQ.0)THEN
- DX=(Q(LCID+KXMAX)-Q(LCID+KXMIN))/FLOAT(IQ(LCID+KNCX))
- X=FLOAT(I-1)*DX+Q(LCID+KXMIN)
- ELSE
- LBINS=LQ(LCID-2)
- X=Q(LBINS+I)
- ENDIF
- END
diff --git a/src/packlib/hbook/code/hkf1.F b/src/packlib/hbook/code/hkf1.F
deleted file mode 100644
index 3443c75..0000000
--- a/src/packlib/hbook/code/hkf1.F
+++ /dev/null
@@ -1,97 +0,0 @@
-*
-* $Id: hkf1.F,v 1.2 2000/12/19 16:56:22 couet Exp $
-*
-* $Log: hkf1.F,v $
-* Revision 1.2 2000/12/19 16:56:22 couet
-* - Bug fixed in RMS calculation. When IDOPT STAT is on the RMS calculation
-* was wrong one some machines because it was done using REAL and DOUBLE
-* PRECISION numbers. Now we use on ly DOUBLE PRECISION numbers.
-*
-* Revision 1.1.1.1 1996/01/16 17:07:40 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.21/08 17/02/94 15.16.59 by Rene Brun
-*-- Author : Rene Brun 14/02/94
- SUBROUTINE HKF1(LINE,ID1,X,W)
-*.==========>
-*. Special fast filling routine for COMIS
-*. All calls to HF1 replaced by calls to this routine
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
-#include "hbook/hcflag.inc"
-#include "hbook/hcbits.inc"
-#include "hbook/hcprin.inc"
- DOUBLE PRECISION SWX(2),DBLX,DBLZ
-*.___________________________________________
- IF(ID1.NE.IDLAST)THEN
- ID=ID1
- IDPOS=LOCATI(IQ(LTAB+1),IQ(LCDIR+KNRH),ID)
- IF(IDPOS.LE.0)RETURN
- IDLAST=ID1
- LCID=LQ(LTAB-IDPOS)
- LCONT=LQ(LCID-1)
- LPRX=LCID+KNCX
- I5=JBIT(IQ(LCID+KBITS),5)
- I6=JBIT(IQ(LCID+KBITS),6)
- I7=JBIT(IQ(LCID+KBITS),7)
- ENDIF
-*
- IF(I5.NE.0)CALL HF1AUT(X,W)
- IQ(LCONT+KNOENT)=IQ(LCONT+KNOENT)+1
- IF(X.LT.Q(LPRX+1))THEN
- ICHAN=0
- ELSEIF(.NOT.(X.LT.Q(LPRX+2)))THEN
- ICHAN=IQ(LPRX)+1
- ELSE
- IF(I6.EQ.0)THEN
- ICHAN=(X-Q(LPRX+1))*FLOAT(IQ(LPRX))/(Q(LPRX+2)-Q(LPRX+1))+ 1
- ELSE
- LBINS=LQ(LCID-2)
- ICHAN=1
- 10 IF(.NOT.(X.LT.Q(LBINS+ICHAN+1)))THEN
- ICHAN=ICHAN+1
- GO TO 10
- ENDIF
- ENDIF
- ENDIF
-*
- IF(IQ(LCONT+KNBIT).GE.32)THEN
- Q(LCONT+ICHAN+KCON1)=Q(LCONT+ICHAN+KCON1)+W
- ELSE
- NBPROX=IQ(LCONT+KNBIT)
- NB=32/NBPROX
- LWORD=ICHAN/NB
- LBIT=(ICHAN-NB*LWORD)*NBPROX+1
- INC=JBYT(IQ(LCONT+LWORD+KCON1),LBIT,NBPROX)
- INC=INC+W+0.5
- IF(INC.GT.MAXBIT(NBPROX))INC=MAXBIT(NBPROX)
- CALL SBYT(INC,IQ(LCONT+LWORD+KCON1),LBIT,NBPROX)
- ENDIF
-*
-* ERRORS
-*
- IF(LQ(LCONT).NE.0)THEN
- IF(ICHAN.GT.0.AND.ICHAN.LE.IQ(LPRX))THEN
- LW=LQ(LCONT)
- Q(LW+ICHAN)=Q(LW+ICHAN)+W*W
- ENDIF
- ENDIF
-*
-* STATISTICS
-*
- IF(I7.NE.0)THEN
- IF(ICHAN.GT.0.AND.ICHAN.LE.IQ(LPRX))THEN
- Z=ABS(W)
- Q(LCONT+KSTAT1)=Q(LCONT+KSTAT1)+Z
- Q(LCONT+KSTAT1+1)=Q(LCONT+KSTAT1+1)+Z*Z
- CALL UCOPY(Q(LCONT+KSTAT1+2),SWX,4)
- DBLX=X
- DBLZ=Z
- SWX(1)=SWX(1)+DBLZ*DBLX
- SWX(2)=SWX(2)+DBLZ*DBLX*DBLX
- CALL UCOPY(SWX,Q(LCONT+KSTAT1+2),4)
- ENDIF
- ENDIF
- END
diff --git a/src/packlib/hbook/code/hkf1q.F b/src/packlib/hbook/code/hkf1q.F
deleted file mode 100644
index b703958..0000000
--- a/src/packlib/hbook/code/hkf1q.F
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: hkf1q.F,v 1.1.1.1 1996/01/16 17:07:40 mclareni Exp $
-*
-* $Log: hkf1q.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:40 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.22/11 23/08/94 14.17.45 by Rene Brun
-*-- Author : Rene Brun 17/02/94
- SUBROUTINE HKF1Q(LINE,ID1,X,W)
-*.==========>
-*. Special fast filling routine for COMIS
-*. All calls to HF1 point initially to this routine
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
-#include "hbook/hcbits.inc"
-#include "hbook/hcfast.inc"
- EXTERNAL HKF1,HKFF1,HKNUL1
-*.___________________________________________
- LINABS=ABS(LINE)
- CALL HFILL(ID1,X,0.,W)
- IDPOS=LOCATI(IQ(LTAB+1),IQ(LCDIR+KNRH),ID1)
- IF(IDPOS.LE.0)THEN
- CALL CSHFAST(LINABS,HKNUL1)
- RETURN
- ENDIF
- IF(I8.EQ.0)THEN
- IF(I5.EQ.0.AND.I6.EQ.0.AND.I7.EQ.0)THEN
- IF(LINE.GT.0.AND.LINE.LT.1000)THEN
- NID(LINE)=0
- CALL CSHFAST(LINABS,HKFF1)
- ELSE
- CALL CSHFAST(LINABS,HKF1)
- ENDIF
- ELSE
- CALL CSHFAST(LINABS,HKF1)
- ENDIF
- ENDIF
- END
diff --git a/src/packlib/hbook/code/hkf2.F b/src/packlib/hbook/code/hkf2.F
deleted file mode 100644
index 35072d9..0000000
--- a/src/packlib/hbook/code/hkf2.F
+++ /dev/null
@@ -1,63 +0,0 @@
-*
-* $Id: hkf2.F,v 1.1.1.1 1996/01/16 17:07:40 mclareni Exp $
-*
-* $Log: hkf2.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:40 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.21/08 14/02/94 17.29.20 by Rene Brun
-*-- Author : Rene Brun 14/02/94
- SUBROUTINE HKF2(LINE,ID1,X,Y,W)
-*.==========>
-*. Special fast filling routine for COMIS.
-*. Slow calls to HF1 are replaced by this routine.
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
-#include "hbook/hcflag.inc"
-#include "hbook/hcprin.inc"
-*.___________________________________________
- IF(ID1.NE.IDLAST)THEN
- ID=ID1
- IDPOS=LOCATI(IQ(LTAB+1),IQ(LCDIR+KNRH),ID)
- IF(IDPOS.LE.0)RETURN
- IDLAST=ID1
- LCID=LQ(LTAB-IDPOS)
- LCONT=LQ(LCID-1)
- ENDIF
-*
- IQ(LCONT+KNOENT)=IQ(LCONT+KNOENT)+1
- IF(X.LT.Q(LCID+KXMIN))THEN
- I=0
- ELSEIF(.NOT.(X.LT.Q(LCID+KXMAX)))THEN
- I=IQ(LCID+KNCX)+1
- ELSE
- I=(X-Q(LCID+KXMIN))*FLOAT(IQ(LCID+KNCX))/
- + (Q(LCID+KXMAX)-Q(LCID+KXMIN)) + 1
- ENDIF
-*
- IF(Y.LT.Q(LCID+KYMIN))THEN
- J=0
- ELSEIF(.NOT.(Y.LT.Q(LCID+KYMAX)))THEN
- J=IQ(LCID+KNCY)+1
- ELSE
- J=(Y-Q(LCID+KYMIN))*FLOAT(IQ(LCID+KNCY))/
- + (Q(LCID+KYMAX)-Q(LCID+KYMIN)) + 1
- ENDIF
-*
- ICHAN=(IQ(LCID+KNCY)-J+1)*(IQ(LCID+KNCX)+2)+I
- IF(IQ(LCONT+KNBIT).LT.32)THEN
- NBSCAT=IQ(LCONT+KNBIT)
- NB=32/NBSCAT
- LWORD=ICHAN/NB
- LBIT=(NB-1-MOD(ICHAN,NB))*NBSCAT + 1
- IAD=LWORD+LCONT+KCON2
- INC=JBYT(IQ(IAD),LBIT,NBSCAT)+W+0.5
- IF(INC.GT.MAXBIT(NBSCAT))INC=MAXBIT(NBSCAT)
- CALL SBYT(INC,IQ(IAD),LBIT,NBSCAT)
- ELSE
- LWORD=LCONT+ICHAN+KCON2
- Q(LWORD)=Q(LWORD)+W
- ENDIF
- END
diff --git a/src/packlib/hbook/code/hkff1.F b/src/packlib/hbook/code/hkff1.F
deleted file mode 100644
index 94483b4..0000000
--- a/src/packlib/hbook/code/hkff1.F
+++ /dev/null
@@ -1,70 +0,0 @@
-*
-* $Id: hkff1.F,v 1.1.1.1 1996/01/16 17:07:40 mclareni Exp $
-*
-* $Log: hkff1.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:40 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.21/08 14/02/94 17.27.25 by Rene Brun
-*-- Author : Rene Brun 14/02/94
- SUBROUTINE HKFF1(LINE,ID1,X,W)
-*.==========>
-*. Special fast filling routine for COMIS.
-*. Fast calls to HF1 are replaced by this routine.
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
-#include "hbook/hcflag.inc"
-#include "hbook/hcprin.inc"
-#include "hbook/hcfast.inc"
- SAVE BWID1
-*.___________________________________________
- IF(ID1.NE.IDLAST)THEN
-*
-* CHECK IF ID1 IS AT THE ADDRESS CORRESPONDING TO NID(LINE)
-* IF NOT COMPUTE NID(LINE).
-*
- IF(NID(LINE).LE.0)GO TO 10
- IF(NID(LINE).GT.IQ(LCDIR+KNRH))GO TO 10
- LCID=LQ(LTAB-NID(LINE))
- IF(IQ(LTAB+NID(LINE)).EQ.ID1)GO TO 20
-*
-* SEARCH ADDRESS OF ID IN THE ADDRESS TABLE (BINARY SEARCH)
-*
- 10 ID=ID1
- IDPOS=LOCATI(IQ(LTAB+1),IQ(LCDIR+KNRH),ID)
- IF(IDPOS.LE.0)RETURN
- NID(LINE)=IDPOS
-*
-* COMPUTE POINTERS TO ACCESS HISTOGRAM AREA
-*
- 20 IDLAST=ID1
- LCID =LQ(LTAB-NID(LINE))
- LCONT=LQ(LCID-1)
- BWID1=FLOAT(IQ(LCID+KNCX))/(Q(LCID+KXMAX)-Q(LCID+KXMIN))
- ENDIF
-*
-* INCREMENT NUMBER OF ENTRIES AND COMPUTE CHANNEL NUMBER
-*
- IQ(LCONT+KNOENT)=IQ(LCONT+KNOENT)+1
- IF(X.LT.Q(LCID+KXMIN))THEN
- ICHAN=0
- ELSEIF(.NOT.(X.LT.Q(LCID+KXMAX)))THEN
- ICHAN=IQ(LCID+KNCX)+1
- ELSE
- ICHAN=(X-Q(LCID+KXMIN))*BWID1+1
- ENDIF
- IF(IQ(LCONT+KNBIT).GE.32)THEN
- Q(LCONT+ICHAN+KCON1)=Q(LCONT+ICHAN+KCON1)+W
- ELSE
- NBPROX=IQ(LCONT+KNBIT)
- NB=32/NBPROX
- LWORD=ICHAN/NB
- LBIT=(ICHAN-NB*LWORD)*NBPROX+1
- INC=JBYT(IQ(LCONT+LWORD+KCON1),LBIT,NBPROX)
- INC=INC+W+0.5
- IF(INC.GT.MAXBIT(NBPROX))INC=MAXBIT(NBPROX)
- CALL SBYT(INC,IQ(LCONT+LWORD+KCON1),LBIT,NBPROX)
- ENDIF
- END
diff --git a/src/packlib/hbook/code/hkff2.F b/src/packlib/hbook/code/hkff2.F
deleted file mode 100644
index ffa5b4d..0000000
--- a/src/packlib/hbook/code/hkff2.F
+++ /dev/null
@@ -1,81 +0,0 @@
-*
-* $Id: hkff2.F,v 1.1.1.1 1996/01/16 17:07:40 mclareni Exp $
-*
-* $Log: hkff2.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:40 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.21/08 15/02/94 09.17.01 by Rene Brun
-*-- Author : Rene Brun 14/02/94
- SUBROUTINE HKFF2(LINE,ID1,X,Y,W)
-*.==========>
-*. Special fast filling routine for COMIS.
-*. Fast calls to HF2 are replaced by this routine.
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
-#include "hbook/hcflag.inc"
-#include "hbook/hcprin.inc"
-#include "hbook/hcfast.inc"
- SAVE NBSCAT,BWIDX1,BWIDY1
-*.___________________________________________
- IF(ID1.NE.IDLAST)THEN
-*
-* CHECK IF ID1 IS AT THE ADDRESS CORRESPONDING TO NID(LINE)
-* IF NOT COMPUTE NID(LINE).
-*
- IF(NID(LINE).LE.0)GO TO 10
- IF(NID(LINE).GT.IQ(LCDIR+KNRH))GO TO 10
- LCID=LQ(LTAB-NID(LINE))
- IF(IQ(LTAB+NID(LINE)).EQ.ID1)GO TO 20
-*
-* SEARCH ADDRESS OF ID IN THE ADDRESS TABLE (BINARY SEARCH)
-*
- 10 ID=ID1
- IDPOS=LOCATI(IQ(LTAB+1),IQ(LCDIR+KNRH),ID)
- IF(IDPOS.LE.0)RETURN
- NID(LINE)=IDPOS
-*
-* COMPUTE POINTERS TO ACCESS HISTOGRAM AREA
-*
- 20 IDLAST=ID1
- LCID =LQ(LTAB-NID(LINE))
- LSCAT =LQ(LCID-1)
- NBSCAT=IQ(LSCAT+KNBIT)
- BWIDX1=FLOAT(IQ(LCID+KNCX))/(Q(LCID+KXMAX)-Q(LCID+KXMIN))
- BWIDY1=FLOAT(IQ(LCID+KNCY))/(Q(LCID+KYMAX)-Q(LCID+KYMIN))
- ENDIF
-*
-* INCREMENT NUMBER OF ENTRIES AND COMPUTE CELL NUMBER
-*
- IQ(LSCAT+KNOENT)=IQ(LSCAT+KNOENT)+1
- IF(X.LT.Q(LCID+KXMIN))THEN
- I=0
- ELSEIF(.NOT.(X.LT.Q(LCID+KXMAX)))THEN
- I=IQ(LCID+KNCX)+1
- ELSE
- I=(X-Q(LCID+KXMIN))*BWIDX1 + 1
- ENDIF
- IF(Y.LT.Q(LCID+KYMIN))THEN
- J=0
- ELSEIF(.NOT.(Y.LT.Q(LCID+KYMAX)))THEN
- J=IQ(LCID+KNCY)+1
- ELSE
- J=(Y-Q(LCID+KYMIN))*BWIDY1 + 1
- ENDIF
-*
- ICHAN=(IQ(LCID+KNCY)-J+1)*(IQ(LCID+KNCX)+2)+I
- IF(NBSCAT.LT.32)THEN
- NB=32/NBSCAT
- LWORD=ICHAN/NB
- LBIT=(NB-1-MOD(ICHAN,NB))*NBSCAT + 1
- IAD=LWORD+LSCAT+KCON2
- INC=JBYT(IQ(IAD),LBIT,NBSCAT)+W+0.5
- IF(INC.GT.MAXBIT(NBSCAT))INC=MAXBIT(NBSCAT)
- CALL SBYT(INC,IQ(IAD),LBIT,NBSCAT)
- ELSE
- LWORD=LSCAT+ICHAN+KCON2
- Q(LWORD)=Q(LWORD)+W
- ENDIF
- END
diff --git a/src/packlib/hbook/code/hkffi1.F b/src/packlib/hbook/code/hkffi1.F
deleted file mode 100644
index 63e2af2..0000000
--- a/src/packlib/hbook/code/hkffi1.F
+++ /dev/null
@@ -1,70 +0,0 @@
-*
-* $Id: hkffi1.F,v 1.1.1.1 1996/01/16 17:07:40 mclareni Exp $
-*
-* $Log: hkffi1.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:40 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.21/08 17/02/94 15.16.59 by Rene Brun
-*-- Author : Rene Brun 17/02/94
- SUBROUTINE HKFFI1(LINE,ID1,X,Y,W)
-*.==========>
-*. Special fast filling routine for COMIS.
-*. Fast calls to HFILL are replaced by this routine.
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
-#include "hbook/hcflag.inc"
-#include "hbook/hcprin.inc"
-#include "hbook/hcfast.inc"
- SAVE BWID1
-*.___________________________________________
- IF(ID1.NE.IDLAST)THEN
-*
-* CHECK IF ID1 IS AT THE ADDRESS CORRESPONDING TO NID(LINE)
-* IF NOT COMPUTE NID(LINE).
-*
- IF(NID(LINE).LE.0)GO TO 10
- IF(NID(LINE).GT.IQ(LCDIR+KNRH))GO TO 10
- LCID=LQ(LTAB-NID(LINE))
- IF(IQ(LTAB+NID(LINE)).EQ.ID1)GO TO 20
-*
-* SEARCH ADDRESS OF ID IN THE ADDRESS TABLE (BINARY SEARCH)
-*
- 10 ID=ID1
- IDPOS=LOCATI(IQ(LTAB+1),IQ(LCDIR+KNRH),ID)
- IF(IDPOS.LE.0)RETURN
- NID(LINE)=IDPOS
-*
-* COMPUTE POINTERS TO ACCESS HISTOGRAM AREA
-*
- 20 IDLAST=ID1
- LCID =LQ(LTAB-NID(LINE))
- LCONT=LQ(LCID-1)
- BWID1=FLOAT(IQ(LCID+KNCX))/(Q(LCID+KXMAX)-Q(LCID+KXMIN))
- ENDIF
-*
-* INCREMENT NUMBER OF ENTRIES AND COMPUTE CHANNEL NUMBER
-*
- IQ(LCONT+KNOENT)=IQ(LCONT+KNOENT)+1
- IF(X.LT.Q(LCID+KXMIN))THEN
- ICHAN=0
- ELSEIF(.NOT.(X.LT.Q(LCID+KXMAX)))THEN
- ICHAN=IQ(LCID+KNCX)+1
- ELSE
- ICHAN=(X-Q(LCID+KXMIN))*BWID1+1
- ENDIF
- IF(IQ(LCONT+KNBIT).GE.32)THEN
- Q(LCONT+ICHAN+KCON1)=Q(LCONT+ICHAN+KCON1)+W
- ELSE
- NBPROX=IQ(LCONT+KNBIT)
- NB=32/NBPROX
- LWORD=ICHAN/NB
- LBIT=(ICHAN-NB*LWORD)*NBPROX+1
- INC=JBYT(IQ(LCONT+LWORD+KCON1),LBIT,NBPROX)
- INC=INC+W+0.5
- IF(INC.GT.MAXBIT(NBPROX))INC=MAXBIT(NBPROX)
- CALL SBYT(INC,IQ(LCONT+LWORD+KCON1),LBIT,NBPROX)
- ENDIF
- END
diff --git a/src/packlib/hbook/code/hkfi1.F b/src/packlib/hbook/code/hkfi1.F
deleted file mode 100644
index 9a558a2..0000000
--- a/src/packlib/hbook/code/hkfi1.F
+++ /dev/null
@@ -1,97 +0,0 @@
-*
-* $Id: hkfi1.F,v 1.2 2000/12/19 16:56:22 couet Exp $
-*
-* $Log: hkfi1.F,v $
-* Revision 1.2 2000/12/19 16:56:22 couet
-* - Bug fixed in RMS calculation. When IDOPT STAT is on the RMS calculation
-* was wrong one some machines because it was done using REAL and DOUBLE
-* PRECISION numbers. Now we use on ly DOUBLE PRECISION numbers.
-*
-* Revision 1.1.1.1 1996/01/16 17:07:40 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.21/08 17/02/94 15.16.59 by Rene Brun
-*-- Author : Rene Brun 17/02/94
- SUBROUTINE HKFI1(LINE,ID1,X,Y,W)
-*.==========>
-*. Special fast filling routine for COMIS
-*. All calls to HFILL for 1-Ds replaced by calls to this routine
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
-#include "hbook/hcflag.inc"
-#include "hbook/hcbits.inc"
-#include "hbook/hcprin.inc"
- DOUBLE PRECISION SWX(2),DBLX,DBLZ
-*.___________________________________________
- IF(ID1.NE.IDLAST)THEN
- ID=ID1
- IDPOS=LOCATI(IQ(LTAB+1),IQ(LCDIR+KNRH),ID)
- IF(IDPOS.LE.0)RETURN
- IDLAST=ID1
- LCID=LQ(LTAB-IDPOS)
- LCONT=LQ(LCID-1)
- LPRX=LCID+KNCX
- I5=JBIT(IQ(LCID+KBITS),5)
- I6=JBIT(IQ(LCID+KBITS),6)
- I7=JBIT(IQ(LCID+KBITS),7)
- ENDIF
-*
- IF(I5.NE.0)CALL HF1AUT(X,W)
- IQ(LCONT+KNOENT)=IQ(LCONT+KNOENT)+1
- IF(X.LT.Q(LPRX+1))THEN
- ICHAN=0
- ELSEIF(.NOT.(X.LT.Q(LPRX+2)))THEN
- ICHAN=IQ(LPRX)+1
- ELSE
- IF(I6.EQ.0)THEN
- ICHAN=(X-Q(LPRX+1))*FLOAT(IQ(LPRX))/(Q(LPRX+2)-Q(LPRX+1))+ 1
- ELSE
- LBINS=LQ(LCID-2)
- ICHAN=1
- 10 IF(.NOT.(X.LT.Q(LBINS+ICHAN+1)))THEN
- ICHAN=ICHAN+1
- GO TO 10
- ENDIF
- ENDIF
- ENDIF
-*
- IF(IQ(LCONT+KNBIT).GE.32)THEN
- Q(LCONT+ICHAN+KCON1)=Q(LCONT+ICHAN+KCON1)+W
- ELSE
- NBPROX=IQ(LCONT+KNBIT)
- NB=32/NBPROX
- LWORD=ICHAN/NB
- LBIT=(ICHAN-NB*LWORD)*NBPROX+1
- INC=JBYT(IQ(LCONT+LWORD+KCON1),LBIT,NBPROX)
- INC=INC+W+0.5
- IF(INC.GT.MAXBIT(NBPROX))INC=MAXBIT(NBPROX)
- CALL SBYT(INC,IQ(LCONT+LWORD+KCON1),LBIT,NBPROX)
- ENDIF
-*
-* ERRORS
-*
- IF(LQ(LCONT).NE.0)THEN
- IF(ICHAN.GT.0.AND.ICHAN.LE.IQ(LPRX))THEN
- LW=LQ(LCONT)
- Q(LW+ICHAN)=Q(LW+ICHAN)+W*W
- ENDIF
- ENDIF
-*
-* STATISTICS
-*
- IF(I7.NE.0)THEN
- IF(ICHAN.GT.0.AND.ICHAN.LE.IQ(LPRX))THEN
- Z=ABS(W)
- Q(LCONT+KSTAT1)=Q(LCONT+KSTAT1)+Z
- Q(LCONT+KSTAT1+1)=Q(LCONT+KSTAT1+1)+Z*Z
- CALL UCOPY(Q(LCONT+KSTAT1+2),SWX,4)
- DBLX=X
- DBLZ=Z
- SWX(1)=SWX(1)+DBLZ*DBLX
- SWX(2)=SWX(2)+DBLZ*DBLX*DBLX
- CALL UCOPY(SWX,Q(LCONT+KSTAT1+2),4)
- ENDIF
- ENDIF
- END
diff --git a/src/packlib/hbook/code/hkfil2.F b/src/packlib/hbook/code/hkfil2.F
deleted file mode 100644
index 3b51c4a..0000000
--- a/src/packlib/hbook/code/hkfil2.F
+++ /dev/null
@@ -1,4 +0,0 @@
- SUBROUTINE HKFIL2(LINE,ID1,X,Y,W)
- CALL HF2(ID1,X,Y,W)
- CALL HFIDP(ID1,X,Y,W)
- END
diff --git a/src/packlib/hbook/code/hkfill.F b/src/packlib/hbook/code/hkfill.F
deleted file mode 100644
index 616cdb7..0000000
--- a/src/packlib/hbook/code/hkfill.F
+++ /dev/null
@@ -1,64 +0,0 @@
-*
-* $Id: hkfill.F,v 1.1.1.1 1996/01/16 17:07:40 mclareni Exp $
-*
-* $Log: hkfill.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:40 mclareni
-* First import
-*
-*
-*CMZ : 4.22/11 23/08/94 14.17.45 by Rene Brun
-*-- Author : Rene Brun 14/02/94
- SUBROUTINE HKFILL(LINE,ID1,X,Y,W)
-*.==========>
-*. Special fast filling routine for COMIS
-*. All calls to HFILL point initially to this routine
-*..=========> ( R.Brun )
-#include "hbook/pilot.h"
-#include "hbook/hcbook.inc"
-#include "hbook/hcbits.inc"
-#include "hbook/hcfast.inc"
- EXTERNAL HKFI1,HKFFI1,HKFF2,HKFILPF,HKFIL2,HKNULI
-*.___________________________________________
- LINABS=ABS(LINE)
- CALL HFILL(ID1,X,Y,W)
- IDPOS=LOCATI(IQ(LTAB+1),IQ(LCDIR+KNRH),ID1)
- IF(IDPOS.LE.0)THEN
- CALL CSHFAST(LINABS,HKNULI)
- RETURN
- ENDIF
-*
- IF(I1.NE.0)THEN
-*
-* 1-DIM HISTOGRAM OR PROFILE
-*
- IF(I8.EQ.0)THEN
- IF(I5.EQ.0.AND.I6.EQ.0.AND.I7.EQ.0)THEN
- IF(LINE.GT.0.AND.LINE.LT.1000)THEN
- NID(LINE)=0
- CALL CSHFAST(LINABS,HKFFI1)
- ELSE
- CALL CSHFAST(LINABS,HKFI1)
- ENDIF
- ELSE
- CALL CSHFAST(LINABS,HKFI1)
- ENDIF
- ELSE
- CALL CSHFAST(LINABS,HKFILPF)
- ENDIF
- ELSE
-*
-* 2-DIM HISTOGRAM
-*
- IF(LQ(LCID-2).EQ.0.AND.LQ(LCID-3).EQ.0.AND.LQ(LCID-4).EQ.0.AND.
- + LQ(LCID-5).EQ.0.AND.LQ(LCID-6).EQ.0.AND.LQ(LCID-2).EQ.0)THEN
- IF(LINE.GT.0.AND.LINE.LT.1000)THEN
- NID(LINE)=0
- CALL CSHFAST(LINABS,HKFF2)
- ELSE
- CALL CSHFAST(LINABS,HKF2)
- ENDIF
- ELSE
- CALL CSHFAST(LINABS,HKFIL2)
- ENDIF
- ENDIF
- END
diff --git a/src/packlib/hbook/code/hkfilpf.F b/src/packlib/hbook/code/hkfilpf.F
deleted file mode 100644
index 00ace58..0000000
--- a/src/packlib/hbook/code/hkfilpf.F
+++ /dev/null
@@ -1,3 +0,0 @@
- SUBROUTINE HKFILPF(LINE,ID1,X,Y,W)
- CALL HFILPF(ID1,X,Y,W)
- END
diff --git a/src/packlib/hbook/code/hkind.F b/src/packlib/hbook/code/hkind.F
deleted file mode 100644
index ccee4b6..0000000
--- a/src/packlib/hbook/code/hkind.F
+++ /dev/null
@@ -1,99 +0,0 @@
-*
-* $Id: hkind.F,v 1.1.1.1 1996/01/16 17:07:40 mclareni Exp $
-*
-* $Log: hkind.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:40 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.21/09 28/02/94 15.24.54 by Rene Brun
-*-- Author :
- SUBROUTINE HKIND(IDD,KIND,CHOPT)
-*.==========>
-*. returns the attributes of the histogram ID as follows:
-*. if CHOPT=' ' only KIND(1) is filled
-*. KIND(1) =
-*. -1 - unknown kind of histogram
-*. 0 - ID does not exits
-*. 1 - one-dim plot
-*. 2 - two-dim plot
-*. 3 - table
-*. 4 - n-tuple
-*. 8 - profile
-*.
-*. if CHOPT='A' all the 32 status bits are returned in array KIND(32)
-*.
-*. I1 HBOOK1
-*. I2 HBOOK2
-*. I3 HTABLE
-*. I4 NTUPLE
-*. I5 AUTOMATIC BINNING
-*. I6 VARIABLE BIN SIZE HISTOGRAM
-*. I7 HBSTAT
-*. I8 PROFILE HISTOGRAM
-*. I9 HBARX
-*. I10 HBARY
-*. I11 HERROR
-*. I12 HFUNC
-*. I13 HROTAT
-*. I14 HPRFUN
-*. I15 HPRLOW
-*. I16 HPRHIS
-*. I17 HBIGBI
-*. I18 HNORMA
-*. I19 HSCALE
-*. I20 HMAXIM
-*. I21 HMINIM
-*. I22 HINTEG
-*. I23 H2PAGE
-*. I24 H1EVLI
-*. I25 HPRSTA
-*. I26 HLOGAR
-*. I27 HBLACK
-*. I28 HSTAR
-*. I29 HPRCHA
-*. I30 HPRCON
-*. I31 HPRERR
-*.
-*..=========> ( R.Brun, Kees van der Poel )
-#include "hbook/hcbook.inc"
-#include "hbook/hcbits.inc"
- DIMENSION KIND(32)
- CHARACTER*(*) CHOPT
-*.___________________________________________
- CALL HFIND(IDD,'HKIND ')
- IF(LCID .EQ. 0) THEN
- KIND(1)=0
- RETURN
- ENDIF
- CALL HDCOFL
- CALL HUOPTC(CHOPT,'A',IOPTA)
- IF(IOPTA.NE.0)THEN
- CALL UCOPY(I1,KIND,32)
- RETURN
- ENDIF
-*
- IF(I1.NE.0) THEN
- IF(I8.EQ.0) THEN
-*- one-dim
- KIND(1)=1
- ELSE
-*- profile
- KIND(1)=8
- ENDIF
- ELSEIF(I2.NE.0) THEN
-*- two-dim
- KIND(1)=2
- ELSEIF(I3.NE.0) THEN
-*- table
- KIND(1)=3
- ELSEIF(I4.NE.0) THEN
-*- n-tuple
- KIND(1)=4
- ELSE
-*- unknown
- KIND(1)=-1
- ENDIF
-*
- END
diff --git a/src/packlib/hbook/code/hknul1.F b/src/packlib/hbook/code/hknul1.F
deleted file mode 100644
index 91dcb43..0000000
--- a/src/packlib/hbook/code/hknul1.F
+++ /dev/null
@@ -1,2 +0,0 @@
- SUBROUTINE HKNUL1(LINE,ID1,X,W)
- END
diff --git a/src/packlib/hbook/code/hknuli.F b/src/packlib/hbook/code/hknuli.F
deleted file mode 100644
index f9fe426..0000000
--- a/src/packlib/hbook/code/hknuli.F
+++ /dev/null
@@ -1,2 +0,0 @@
- SUBROUTINE HKNULI(LINE,ID1,X,Y,W)
- END
diff --git a/src/packlib/hbook/code/hlabel.F b/src/packlib/hbook/code/hlabel.F
deleted file mode 100644
index e610d3c..0000000
--- a/src/packlib/hbook/code/hlabel.F
+++ /dev/null
@@ -1,649 +0,0 @@
-*
-* $Id: hlabel.F,v 1.2 2001/10/10 08:12:07 couet Exp $
-*
-* $Log: hlabel.F,v $
-* Revision 1.2 2001/10/10 08:12:07 couet
-* - Do not call MZFORM any more. MZFORM for alphanumeric labels date banks
-* is now called at initialisation time (HLIMIT or HLIMAP).
-*
-* Revision 1.1.1.1 1996/01/16 17:07:41 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.23/01 20/02/95 10.12.54 by Julian Bunn
-*-- Author : P.Aubert 18/11/92
- SUBROUTINE HLABEL(IDD,NLABEL,CHLAB,CHOPT)
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-C HLABEL :
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-C
-C ID HISTOGRAM ID
-C
-C GENERAL REMARK
-C --------------
-C
-C 1/ by default axis equals 'X', you could specifie 'X' or 'Y' in CHOPT.
-C 2/ for a 2-D histogram, you must specifie 'X' or 'Y'
-C 3/ option 'N' 'T' 'R' 'S' are mutally exclusive
-C
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-C CHOPT = 'N'
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-C
-C ADD LABEL TO AN HISTOGRAM WITHOUT LABEL
-C
-C IN
-C --
-C ID HISTOGRAN ID
-C NLABEL NUMBER OF LABEL TO ADD TO AXIS 'X' or 'Y'
-C CHLAB ARRAY OF LABEL CHARACTER*(*) CHLAB*
-C CHOPT 'N'='NX','NY'
-C
-C EXEMPLE :
-C CALL HLABEL(ID,10,CHLAB,'NX')
-C
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-C CHOPT = 'T'
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-C
-C CHANGE LABEL TO AN HISTOGRAM WICH ALREADY HAVE LABEL
-C
-C IN
-C --
-C ID HISTOGRAN ID
-C NLABEL NUMBER OF LABEL TO CHANGE TO AXIS 'X' or 'Y'
-C CHLAB ARRAY OF LABEL CHARACTER*(*) CHLAB*
-C CHOPT 'T'='TX','TY'
-C
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-C CHOPT = 'R'
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-C
-C GET BACK AN ARRAY 'CHLAB' CONTAINING THE ARRAY OF LABEL FOR AXIS 'X'
-C OR 'Y'
-C
-C IN
-C --
-C ID HISTOGRAN ID
-C NLABEL NUMBER OF LABEL TO STORE FROM AXIS 'X' or 'Y' TO CHLAB
-C CHOPT 'R'='RX','RY'
-C
-C OUT
-C ---
-C CHLAB ARRAY OF LABEL CHARACTER*(*) CHLAB*
-C
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-C CHOPT = 'S'
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-C
-C SORT OPTION
-C
-C IN
-C --
-C ID HISTOGRAN ID
-C CHOPT S X Y A E V R
-C
-C EXAMPLE
-C -------
-C
-C TO SORT X AXIS ALPHABETICALLY
-C CALL HLABEL(ID,0,' ','SAX')
-C TO SORT Y AXIS ALPHABETICALLY
-C CALL HLABEL(ID,0,' ','SAY')
-C
-C THIS WORKS ONLY FOR 1-D HISTOGRAM
-C ---------------------------------
-C TO SORT X AXIS BY INCREASING CHANNEL CONTENTS
-C CALL HLABEL(ID,0,' ','SXD')
-C TO SORT X AXIS BY DECREASING CHANNEL CONTENTS
-C CALL HLABEL(ID,0,' ','SXV')
-C
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-C ERROR
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-C
-C 'Unknowm histogram type'
-C histogram ID is unknown
-C
-C 'OPTION N and S are mutually exclusive'
-C you could add label and sort them at the same time
-C use 2 call to hlabel first with chopt 'N' and then 'S'
-C
-C 'FOR A 2-D HISTOGRAM CHOPT MUST CONTAIN X or Y'
-C you MUST have 'X' or 'Y' in chopt for a 2D histgram
-C
-C 'Y-AXIS DO NOT HAVE LABEL '
-C use hlabel with option 'N' before
-C
-C 'X-AXIS DO NOT HAVE LABEL '
-C use hlabel with option 'N' before
-C
-C 'NLABEL <= 0 '
-C nlabel must be > 0
-C
-C 'No data sorting for a 2D histo'
-C there is no sense to sort an 2-D histogram according to the
-C value of row or column
-C
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-#include "hbook/hcbook.inc"
-#include "hbook/hcbits.inc"
-#include "hbook/hcflag.inc"
-#include "hbook/hcprin.inc"
-#include "hbook/hcform.inc"
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-C PARAMETER
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
- INTEGER KLGRCX,KBLAB,KNCHX
- PARAMETER(KLGRCX = 16,KBLAB = 7,KNCHX = 2)
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-C COMMON
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
- INTEGER LCHX,LCHY,LCH,NCHX,NCHY,LINDEX,LTEMP,LGR
- EQUIVALENCE(LCHX ,LHDUM(1))
- EQUIVALENCE(LCHY ,LHDUM(2))
- EQUIVALENCE(LCH ,LHDUM(3))
- EQUIVALENCE(LINDEX ,LHDUM(4))
- EQUIVALENCE(LTEMP ,LHDUM(5))
- LOGICAL HLABEQ
- REAL HCX,HCXY
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-C VARIABLE FOR QUICKSORT
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
- INTEGER QUICKM
- PARAMETER (QUICKM = 20)
- INTEGER LEFT,RIGHT,LEVEL
- REAL X,W
- INTEGER STACKLEFT(QUICKM),STACKRIGHT(QUICKM)
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-C VARIABLE INPUT OUTPUT
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
- INTEGER IDD,NLABEL,JBIT
- CHARACTER*(*) CHOPT
- CHARACTER*(*) CHLAB(*)
- CHARACTER*8 CHOPTU
- CHARACTER*16 CHTMP
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-C LOCAL VARIABLE
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
- INTEGER I,J,K,L,IVALUE,LW,IOCC,DIMHISTO,IKNOENT
- INTEGER NBLOC
- REAL ERR
- CHARACTER CHAXE
- LOGICAL BUILD
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
- NBLOC = NLABEL
-C OPTIONS ?
- CHOPTU=CHOPT
- CALL CLTOU(CHOPTU)
- IOPTN=INDEX(CHOPTU,'N')
- IOPTS=INDEX(CHOPTU,'S')
- IOPTA=INDEX(CHOPTU,'A')
- IOPTE=INDEX(CHOPTU,'E')
- IOPTD=INDEX(CHOPTU,'D')
- IOPTV=INDEX(CHOPTU,'V')
- IOPTT=INDEX(CHOPTU,'T')
- IOPTX=INDEX(CHOPTU,'X')
- IOPTY=INDEX(CHOPTU,'Y')
- IOPTZ=INDEX(CHOPTU,'Z')
- IOPTR=INDEX(CHOPTU,'R')
-C -- INIT VALUE
- CALL HFIND(IDD,'HLABEL')
- IF(LCID.EQ.0)GO TO 999
- CALL HDCOFL
- IF(I123.EQ.0)THEN
- CALL HBUG('Unknowm histogram type','HLABEL',IDD)
- GO TO 999
- ENDIF
-C -- some test to detect inconsistant option and type of the histogram
-C 1/ TOO MANY OPTIONS
- IF((IOPTN.NE.0).AND.(IOPTS.NE.0))THEN
- CALL HBUG('OPTION N and S are mutually exclusive','HLABEL',IDD)
- GO TO 999
- ENDIF
-C 2/
- IF((I2.NE.0).AND.((IOPTX.NE.0).AND.(IOPTY.NE.0)))THEN
- CALL HBUG('FOR A 2-D HISTOGRAM CHOPT MUST CONTAIN X or Y',
- + 'HLABEL',IDD)
- ENDIF
- CALL SBIT0(IQ(LCID),5)
-C -- We store the value because of side effect in the routine hfc1
- IKNOENT = IQ(LCONT + KNOENT)
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-C ADD BANK IF THE LABEL'S BANK DON'T EXIST
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
- NL=IQ(LCID-2)
-C 1D FIRST
- IF(I1.NE.0)THEN
- DIMHISTO = 1
- IF(.NOT.HLABEQ(ID,'X'))THEN
- CALL MZPUSH(IHDIV,LCID,8-NL,0,' ')
- CALL MZBOOK(IHDIV,LCHX,LCID, -8,'HLCX',0,0,KBLAB,IOCC,0)
- IQ(LCHX + 1) = KLGRCX
- IQ(LCHX + KNCHX) = 0
- CALL UCTOH('UNDERFLOW ',IQ(LCHX + 3),4,KLGRCX)
- CALL SBIT0(IQ(LCHX),17)
- CALL SBIT1(IQ(LCHX),18)
- ENDIF
-C 2D
- ELSE
- DIMHISTO = 2
-C
-C -- s'il n'y a pas de label sur X ni sur Y, c'est clair qu'il faut les
-C -- mettre
-C -- par contre si nous n'avons des labels que sur
-C -X
-C si l'action porte sur l'axe X et qu'elle ne concerne pas 'N'
-C pas de problemes
-C si l'action porte sur l'axe Y et qu'elle ne concerne pas 'N'
-C -> HBUG
-C -Y
-C inverse evidement
-C -- Y-a-t-il d'autres problemes des cas de bloquages ?
-C
- BUILD = .FALSE.
- IF(HLABEQ(ID,'X'))THEN
- IF(.NOT.HLABEQ(ID,'Y'))THEN
- IF((IOPTY.NE.0).AND.(IOPTN.EQ.0))THEN
- CALL HBUG('No labels on Y-AXIS ','HLABEL',ID)
- RETURN
- ENDIF
- ENDIF
- ELSE
- IF(HLABEQ(ID,'Y'))THEN
- IF((IOPTX.NE.0).AND.(IOPTN.EQ.0))THEN
- CALL HBUG('No labels on X-AXIS ','HLABEL',ID)
- RETURN
- ENDIF
- ELSE
- BUILD = .TRUE.
- ENDIF
- ENDIF
-C
- IF(BUILD)THEN
- CALL MZPUSH(IHDIV,LCID,9-NL,0,' ')
- CALL MZBOOK(IHDIV,LCHX,LCID, -8,'HLCX',0,0,KBLAB,IOCC,0)
- IQ(LCHX + 1) = KLGRCX
- IQ(LCHX + KNCHX) = 0
- CALL UCTOH('UNDERFLOW ',IQ(LCHX + 3),4,KLGRCX)
- CALL SBIT0(IQ(LCHX),17)
- CALL SBIT1(IQ(LCHX),18)
- CALL MZBOOK(IHDIV,LCHY,LCID, -9,'HLCY',0,0,KBLAB,IOCC,0)
- IQ(LCHY + 1) = KLGRCX
- IQ(LCHY + KNCHX) = 0
- CALL UCTOH('UNDERFLOW ',IQ(LCHY + 3),4,KLGRCX)
- CALL SBIT0(IQ(LCHY),17)
- CALL SBIT1(IQ(LCHY),18)
- ENDIF
- ENDIF
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-C Axis Selection
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
- IF(DIMHISTO.EQ.1)THEN
- LCH = LQ(LCID - 8)
- NCH = IQ(LCH + KNCHX)
- CHAXE = 'X'
- ELSE
-C -- Y
- IF (IOPTY.NE.0)THEN
- LCH = LQ(LCID - 9)
- NCH = IQ(LCH + KNCHX)
- CHAXE = 'Y'
-C -- X or default
- ELSE
- LCH = LQ(LCID - 8)
- NCH = IQ(LCH + KNCHX)
- CHAXE = 'X'
- ENDIF
- ENDIF
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-C IF CHOPT = T
-C CHANGE LABEL
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
- IF(IOPTT.NE.0)THEN
- IF(NBLOC.GT.NCH)THEN
- NBLOC = NCH
- ENDIF
- IF(NBLOC.LE.0)THEN
- CALL HBUG('NLABEL <= 0 ','HLABEL',ID)
- ENDIF
- DO 10 I = 1,NBLOC
- CHTMP = ' '
- LGR = LENOCC(CHLAB(I))
- IF(LGR.GT.KLGRCX)THEN
- LGR = KLGRCX
- ENDIF
- CHTMP(1:LGR) = CHLAB(I)(1:LGR)
- CALL UCTOH(CHTMP,IQ(LCH + KBLAB + 4*(I - 1)),4,KLGRCX)
- 10 CONTINUE
- RETURN
- ENDIF
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-C IF CHOPT = R
-C RETURN ARRAY OF LABEL
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
- IF(IOPTR.NE.0)THEN
- IF(NBLOC.GT.NCH)THEN
- NBLOC = NCH
- ENDIF
- IF(NBLOC.LE.0)THEN
- CALL HBUG('NLABEL <= 0 ','HLABEL',ID)
- ENDIF
- DO 20 I = 1,NBLOC
- CALL HLGNXT(ID,I,CHLAB(I),CHAXE)
- 20 CONTINUE
- RETURN
- ENDIF
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-C IF CHOPT = N
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
- IF(IOPTN.NE.0)THEN
-C req : il faut peut-etre mettre a jour des bits genre auto binning ...
- NBLOC = NBLOC + 2
- CALL HSPACE(NBLOC*4,'HLABEL',ID)
-C -- if not enough memory
- IF(IERR.NE.0) GO TO 999
-C -- else
- CALL MZPUSH(IHDIV,LCH,0,4*NBLOC,' ')
-C -- we don''t count UNDERFLOW et OVERFLOW
- IQ(LCH + KNCHX) = NBLOC - 2
- CALL UCTOH('UNDERFLOW ',IQ(LCH + KBLAB - 4),4,KLGRCX)
- DO 30 I = 1,NBLOC - 2
- CHTMP = ' '
- LGR = LENOCC(CHLAB(I))
- IF(LGR.GT.KLGRCX)THEN
- LGR = KLGRCX
- ENDIF
- CHTMP(1:LGR) = CHLAB(I)(1:LGR)
- CALL UCTOH(CHTMP,IQ(LCH + KBLAB + 4*(I - 1)),4,KLGRCX)
- 30 CONTINUE
- CALL UCTOH('OVERFLOW ',IQ(LCH + KBLAB + 4*(NBLOC - 2)),
- + 4,KLGRCX)
-C
- IF(DIMHISTO.EQ.2)THEN
- IF(CHAXE.EQ.'X')THEN
- Q(LCID+KXMIN) = 1.0
- Q(LCID+KXMAX) = FLOAT(IQ(LCID+KNCX))+1.0
- ELSE
- Q(LCID+KYMIN) = 1.0
- Q(LCID+KYMAX) = FLOAT(IQ(LCID+KNCY))+1.0
- ENDIF
- ENDIF
- RETURN
- ENDIF
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-C IF CHOPT = S
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
- IF(IOPTS.NE.0)THEN
-C -- INIT VALUE
-C -- we need an auxillary array of integer length = nch
- CALL HSPACE(NCH,'HLABEL',ID)
- IF(IERR.NE.0) GO TO 999
- CALL MZPUSH(IHDIV,LCHX,1,0,' ')
- CALL MZBOOK(IHDIV,LINDEX,LCHX,-1,'LIDX',0,0,NCH+2,2,0)
-C -- HACK for hcx.f
- NB = IQ(LCONT + KNBIT)
-C -- if error exist
- IF(LQ(LCONT).NE.0)THEN
- LW = LQ(LCONT)
- ENDIF
-C -- call sort routine
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-C IF CHOPT = A
-C ALPHANUMERIC SORT
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-C -- SI ON TRIE PAR ORDRE ALPHABETIQUE OK
-C -- AUSSI SI ON VEUX TRIER PAR ORDRE INVERSE ALPHABETIQUE
- IF((IOPTA.NE.0).OR.(IOPTE.NE.0))THEN
-C -- axe X pour l instant
-C IF NOT AUTOMATICALLY SORT
- IF(JBIT(IQ(LCH),1).EQ.0)THEN
-C -- status bit =1 now
- CALL SBIT1(IQ(LCH),1)
-C -- sort label
- CALL HLSORT(IQ(LCH + KBLAB),IQ(LINDEX+1),NCH,KLGRCX)
-C
- IF(DIMHISTO.EQ.1)THEN
-C -- add memory
- CALL HSPACE(NCH,'HLABEL',ID)
- IF(IERR.NE.0) GO TO 999
- CALL MZPUSH(IHDIV,LINDEX,0,NCH+2,' ')
-C -- sort value
- DO 40 I = 1,NCH
- Q(LINDEX + NCH + I) = HCX(IQ(LINDEX + I),1)
- 40 CONTINUE
- DO 50 I = 1,NCH
- CALL HFCX(I,Q(LINDEX + NCH + I))
- 50 CONTINUE
-C -- sort ERROR
- IF(LQ(LCONT).NE.0)THEN
- DO 60 I = 1,NCH
- Q(LINDEX + NCH + I) = Q(LW + IQ(LINDEX + I))
- 60 CONTINUE
- DO 70 I = 1,NCH
- Q(LW + I) = Q(LINDEX + NCH + I)
- 70 CONTINUE
- ENDIF
- ELSE IF(DIMHISTO.EQ.2)THEN
- IF(HLABEQ(ID,'X'))THEN
- LCHX = LQ(LCID-8)
- NCHX = IQ(LCHX+KNCHX)
- ELSE
- NCHX = IQ(LCID+KNCX)
- ENDIF
- IF(HLABEQ(ID,'Y'))THEN
- LCHY = LQ(LCID-9)
- NCHY = IQ(LCHY+KNCHX)
- ELSE
- NCHY = IQ(LCID+KNCY)
- ENDIF
- NB = IQ(LCONT+KNBIT)
-C -- we create a temporary buffer
- CALL HSPACE(NCHX*NCHY,'HLABEL',ID)
-C -- if not enough memory
- IF(IERR.NE.0) GO TO 999
-C -- else
- CALL MZPUSH(IHDIV,LCID,1,0,' ')
- CALL MZBOOK(IHDIV,LTEMP,LCID,-10,'TEMP',
- + 0,0,NCHX*NCHY,3,0)
-C -- est-ce utile ? Cf hcxy ou c'est pas declare'
- LSCAT = LQ(LCID-1)
-C -- store value in TEMP
- DO 90 I=1,NCHX
- DO 80 J=1,NCHY
- Q(LTEMP+(J-1)*NCHX+I) = HCXY(I,J,1)
- 80 CONTINUE
- 90 CONTINUE
-C -- sort value
- IF(CHAXE.EQ.'X')THEN
- DO 110 I=1,NCHX
- DO 100 J=1,NCHY
- CALL HFCXY(I,J,
- + Q(LTEMP+(J-1)*NCHX+IQ(LINDEX+I)))
- 100 CONTINUE
- 110 CONTINUE
- ELSE
- DO 130 I=1,NCHX
- DO 120 J=1,NCHY
- CALL HFCXY(I,J,
- + Q(LTEMP+(IQ(LINDEX+J)-1)*NCHX+I))
- 120 CONTINUE
- 130 CONTINUE
- ENDIF
-C ??? faut-il permuter les erreurs ???
-C -- destroy temp bank
- CALL MZDROP(IHDIV,LTEMP,' ')
- CALL MZPUSH(IHDIV,LCID,-1,0,' ')
- ENDIF
- ENDIF
- ENDIF
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-C IF CHOPT = D
-C SORT BY DATA
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-C -- on trie sur les donnees : dans les 2 cas ordre direct et inverse
-C -- on rentre
- IF((IOPTD.NE.0).OR.(IOPTV.NE.0))THEN
-C
-C -- WARNING : we are not sort alphabetically now
- CALL SBIT0(IQ(LCH),1)
-C
- IF(DIMHISTO.EQ.2)THEN
- CALL HBUG('No data sorting for a 2D histo','HLABEL',ID)
- RETURN
- ENDIF
-C superbe trie quicksort : on devrait faire un test sur la taille de la
-C pile
-C
- LEVEL = 1
- STACKLEFT(1) = 1
- STACKRIGHT(1) = NCH
-C
-C -- REPEAT
- 140 CONTINUE
- LEFT = STACKLEFT(LEVEL)
- RIGHT = STACKRIGHT(LEVEL)
- LEVEL = LEVEL - 1
-C-- REPEAT
- 150 CONTINUE
- I = LEFT
- J = RIGHT
- X = HCX((LEFT + RIGHT)/2,1)
-C -- REPEAT
- 160 CONTINUE
-C -- WHILE
- 170 CONTINUE
- IF(HCX(I,1).LT.X)THEN
- I = I + 1
- GO TO 170
- ENDIF
-C -- END WHILE
-C -- WHILE
- 180 CONTINUE
- IF(X.LT.HCX(J,1))THEN
- J = J - 1
- GO TO 180
- ENDIF
-C -- END WHILE
- IF(I.LE.J)THEN
- W = HCX(I,1)
- CALL HFCX(I,HCX(J,1))
- CALL HFCX(J,W)
-C -- swap label i,j
- DO 190 L = 0,3
- IVALUE = IQ(LCH + KBLAB + 4*(I - 1) + L)
- IQ(LCH + KBLAB + 4*(I - 1) + L) = IQ(LCH + KBLAB + 4*
- + (J - 1) + L)
- IQ(LCH + KBLAB + 4*(J - 1) + L) = IVALUE
- 190 CONTINUE
-C -- swap error i,f
- IF(LQ(LCONT).NE.0)THEN
- ERR = Q(LW + I)
- Q(LW + I) = Q(LW + J)
- Q(LW + J) = ERR
- ENDIF
-C -- compute new left an dright
- I = I + 1
- J = J - 1
- ENDIF
- IF(I.LE.J) GO TO 160
-C -- END REPEAT
- IF((J - LEFT).LT.(RIGHT - I))THEN
- IF(I.LT.RIGHT)THEN
- LEVEL = LEVEL + 1
- STACKLEFT(LEVEL) = I
- STACKRIGHT(LEVEL) = RIGHT
- ENDIF
- RIGHT = J
- ELSE
- IF(LEFT.LT.J)THEN
- LEVEL = LEVEL + 1
- STACKLEFT(LEVEL) = LEFT
- STACKRIGHT(LEVEL) = J
- ENDIF
- LEFT = I
- ENDIF
- IF(LEFT.LT.RIGHT) GO TO 150
-C -- END REPEAT
- IF(LEVEL.NE.0)GO TO 140
-C -- END REPEAT
-C
- ENDIF
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-C IF CHOPT = R ou V
-C REVERSE ALPHANUMERIC SORT
-C THIS PART OF HLABEL IS THE SAME IF YOU SORT REVERSE WITH RESPECT TO
-C THE DATA VALUE OR THE LABEL
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
- IF((IOPTE.NE.0).OR.(IOPTV.NE.0))THEN
-C -- WARNING : we are not sort alphabetically now
- CALL SBIT0(IQ(LCH),1)
-C -- swap label
- DO 210 I = 1,NCH/2
- DO 200 J = 0,3
- K = IQ(LCH + KBLAB + 4*(I - 1) + J)
- IQ(LCH + KBLAB + 4*(I - 1) + J) =
- + IQ(LCH + KBLAB + 4*(NCH - I) + J)
- IQ(LCH + KBLAB + 4*(NCH - I) + J) = K
- 200 CONTINUE
- 210 CONTINUE
-C -- 1 D
- IF(DIMHISTO.EQ.1)THEN
-C -- swap value
- DO 220 I=1,NCH/2
- X = HCX(I,1)
- CALL HFCX(I,HCX(NCH - I + 1,1))
- CALL HFCX(NCH - I + 1,X)
- 220 CONTINUE
-C -- swap error
- IF(LQ(LCONT).NE.0)THEN
- DO 230 I = 1,NCH/2
- ERR = Q(LW + I)
- Q(LW + I) = Q(LW + NCH + 1 - I)
- Q(LW + NCH + 1 - I) = ERR
- 230 CONTINUE
- ENDIF
- ELSE
-C -- 2D
- IF(HLABEQ(ID,'X'))THEN
- LCHX = LQ(LCID-8)
- NCHX = IQ(LCHX+KNCHX)
- ELSE
- NCHX = IQ(LCID+KNCX)
- ENDIF
- IF(HLABEQ(ID,'Y'))THEN
- LCHY = LQ(LCID-9)
- NCHY = IQ(LCHY+KNCHX)
- ELSE
- NCHY = IQ(LCID+KNCY)
- ENDIF
-C -- swap value
- IF(CHAXE.EQ.'X')THEN
- DO 250 I=1,NCHX/2
- DO 240 J=1,NCHY
- X = HCXY(I,J,1)
- CALL HFCXY(I,J,HCXY(NCHX-I+1,J,1))
- CALL HFCXY(NCHX-I+1,J,X)
- 240 CONTINUE
- 250 CONTINUE
- ELSE
- DO 270 I=1,NCHY/2
- DO 260 J=1,NCHX
- X = HCXY(I,J,1)
- CALL HFCXY(I,J,HCXY(I,NCHY-J+1,1))
- CALL HFCXY(I,NCHY-J+1,X)
- 260 CONTINUE
- 270 CONTINUE
-
- ENDIF
-C ??? swap error ???
- ENDIF
- ENDIF
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
- CALL MZDROP(IHDIV,LINDEX,' ')
- ENDIF
-C -- END OPTION 'S'
-C -- catch the old value ( should be modified by hfcx )
- IQ(LCONT + KNOENT) = IKNOENT
- 999 END
diff --git a/src/packlib/hbook/code/hlabeq.F b/src/packlib/hbook/code/hlabeq.F
deleted file mode 100644
index a21109e..0000000
--- a/src/packlib/hbook/code/hlabeq.F
+++ /dev/null
@@ -1,74 +0,0 @@
-*
-* $Id: hlabeq.F,v 1.1.1.1 1996/01/16 17:07:41 mclareni Exp $
-*
-* $Log: hlabeq.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:41 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.22/11 23/08/94 14.17.45 by Rene Brun
-*-- Author : P.Aubert 18/11/92
- LOGICAL FUNCTION HLABEQ(IDD,CHOPT)
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-C HLABEQ : HBOOK ALPHA LABEL ?
-C TRUE IF ALPHA LABEL EXIST
-C ELSE FALSE
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-#include "hbook/hcbook.inc"
-#include "hbook/hcbits.inc"
-C
- INTEGER KNCHX
- PARAMETER(KNCHX=2)
-C
- INTEGER LCHX,NCHX,LCHY,NCHY
- EQUIVALENCE(LCHX ,LHDUM(1))
- EQUIVALENCE(LCHY ,LHDUM(2))
-C
- INTEGER IDD,IOPT(2),IOPTX,IOPTY
- CHARACTER*(*) CHOPT
- CHARACTER*8 CHOPTU
-C ----------------------------------------------------------------------
- CHOPTU=CHOPT
- CALL CLTOU(CHOPTU)
- IOPTX=INDEX(CHOPTU,'X')
- IOPTY=INDEX(CHOPTU,'Y')
-C ----------------------------------------------------------------------
- HLABEQ = .FALSE.
- CALL HFIND(IDD,'HLABEQ')
- IF(LCID.EQ.0)GO TO 999
- CALL HDCOFL
- IF(I123.EQ.0)GO TO 999
-C ----------------------------------------------------------------------
- NBLINK = IQ(LCID-2)
- CALL HUOPTC(CHOPT,'XY',IOPT)
- IF(I230.EQ.0)THEN
-C -- 1D
- IF(NBLINK.LT.8)GO TO 999
- IF(IOPT(2).EQ.1)GO TO 999
- LCHX = LQ(LCID-8)
- IF(LCHX.LE.0)GO TO 999
- NCHX = IQ(LCHX+KNCHX)
- IF(NCHX.GE.1) HLABEQ = .TRUE.
- ELSE
-C -- 2D
- IF(NBLINK.LT.9)GO TO 999
-C -- X
- IF(IOPTY.NE.0)THEN
- LCHY = LQ(LCID-9)
- IF(LCHY.LE.0)GO TO 999
- NCHY = IQ(LCHY+KNCHX)
- IF(NCHY.GE.1) HLABEQ = .TRUE.
-C -- Y
- ELSE IF(IOPTX.NE.0)THEN
- LCHX = LQ(LCID-8)
- IF(LCHX.LE.0)GO TO 999
- NCHX = IQ(LCHX+KNCHX)
- IF(NCHX.GE.1) HLABEQ = .TRUE.
- ELSE
- CALL HBUG('FOR A 2-D HISTOGRAM : '
- + //' CHOPT MUST CONTAIN X or Y', 'HLABEQ',ID)
- RETURN
- ENDIF
- ENDIF
- 999 END
diff --git a/src/packlib/hbook/code/hlabnb.F b/src/packlib/hbook/code/hlabnb.F
deleted file mode 100644
index 807d87f..0000000
--- a/src/packlib/hbook/code/hlabnb.F
+++ /dev/null
@@ -1,82 +0,0 @@
-*
-* $Id: hlabnb.F,v 1.1.1.1 1996/01/16 17:07:41 mclareni Exp $
-*
-* $Log: hlabnb.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:41 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.17/09 05/02/93 16.35.43 by Rene Brun
-*-- Author : P.Aubert 20/11/92
- INTEGER FUNCTION HLABNB(ID1,CHOPT)
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-C HLABNB : HBOOK LABEL NUMBER
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-C CHOPT = 'X','Y' or 'Z'
-C 'X' is the default
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-#include "hbook/hcbook.inc"
-#include "hbook/hcflag.inc"
-#include "hbook/hcbits.inc"
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-C PARAMETER
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
- INTEGER KNCHX
- PARAMETER(KNCHX=2)
- INTEGER LOCATI
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
- LOGICAL HLABEQ
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
- CHARACTER*(*) CHOPT
- INTEGER NBLABEL,IOPT(2)
-C ----------------------------------------------------------------------
-C Init value
-C ----------------------------------------------------------------------
- IF(ID1.NE.IDLAST)THEN
- ID = ID1
- IDPOS = LOCATI(IQ(LTAB+1),IQ(LCDIR+KNRH),ID)
- IDLAST = ID1
- LCID = LQ(LTAB-IDPOS)
- LCONT = LQ(LCID-1)
- CALL HDCOFL
- ENDIF
-C ----------------------------------------------------------------------
-C -- options ???
-C ----------------------------------------------------------------------
- CALL UOPTC(CHOPT,'XY',IOPT)
-C ----------------------------------------------------------------------
-C -- id with label ?
-C ----------------------------------------------------------------------
- HLABNB=0
- IF(.NOT.HLABEQ(ID,CHOPT))THEN
- CALL HBUG('No labels on this histogram','HLABNB',ID)
- RETURN
- ENDIF
-C ----------------------------------------------------------------------
-C NB OF LABEL
-C ----------------------------------------------------------------------
- NBLABEL = IQ(LCID-2)
- IF(I1.NE.0)THEN
-C -- 1D
- IF(IOPT(2).EQ.1)THEN
- CALL HBUG('No labels on Y axis','HLABNB',ID)
- RETURN
- ELSE
- HLABNB = IQ(LQ(LCID-8)+KNCHX)
- ENDIF
- ELSE IF(I230.NE.0)THEN
-C -- 2D
- IF(IOPT(2).EQ.1)THEN
-C -- Y
- HLABNB = IQ(LQ(LCID-9)+KNCHX)
- ELSE
-C -- X
- HLABNB = IQ(LQ(LCID-8)+KNCHX)
- ENDIF
- ELSE
- CALL HBUG('Bad number of links','HLABNB',ID)
- ENDIF
-C ----------------------------------------------------------------------
- RETURN
- END
diff --git a/src/packlib/hbook/code/hlattr.F b/src/packlib/hbook/code/hlattr.F
deleted file mode 100644
index cf95cbc..0000000
--- a/src/packlib/hbook/code/hlattr.F
+++ /dev/null
@@ -1,205 +0,0 @@
-*
-* $Id: hlattr.F,v 1.1.1.1 1996/01/16 17:07:41 mclareni Exp $
-*
-* $Log: hlattr.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:41 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 27/07/95 17.19.33 by Julian Bunn
-*-- Author : Fons Rademakers 06/07/92
- SUBROUTINE HLATTR(IDH,CHTYPE,CHTITL,NX,XMIN,XMAX,NY,YMIN,YMAX,
- + ISW,IER)
-*.==========>
-*. To get the attributes of the object IDH.
-*.
-*.
-*. Input:
-*. IDH identifier of object (1d, 2d or N-tuple)
-*. CHTYPE* returns histogram type:
-*. '1' 1-dimensional
-*. '2' 2-dimensional
-*. 'N' N-tuple
-*. CHTITL* returns histogram title or subdirectory name
-*. NX* returns number of X channels (# of columns for Ntuple)
-*. XMIN* returns X min
-*. XMAX*
-*. NY* returns number of Y channels (# of entries for Ntuple)
-*. YMIN*
-*. YMAX*
-*. ISW* returns objects status word
-*. IER* returns -1 when object not found
-*.
-*..=========> ( Fons Rademakers )
-*
-#include "hbook/hcbits.inc"
-#include "hbook/hcbook.inc"
-#include "hbook/hcdire.inc"
-#include "hbook/hcntpar.inc"
- DIMENSION IPAWC(99)
- EQUIVALENCE (NWPAW,IPAWC(1))
-*
- CHARACTER*(*) CHTYPE,CHTITL
- COMMON/QUEST/IQUEST(100)
- INTEGER KEYS(2)
-*.___________________________________________
-*
- IER = 0
- NX = 0
- XMIN = 0.0
- XMAX = 0.0
- NY = 0
- YMIN = 0.0
- YMAX = 0.0
- ISW = 0
- CHTYPE = ' '
- CHTITL = ' '
-*
- IF(ICHTOP(ICDIR).EQ.0)GO TO 20
-*
-* Return histograms in RZ file
-*
- KOF=0
- IF(ICHTOP(ICDIR).GT.0)THEN
- KEYS(1) = IDH
- KEYS(2) = 0
- CALL HRZIN(IHWORK,LHWORK,1,KEYS,9999,' ')
- IF(IQUEST(1).NE.0) GOTO 30
- IF(LHWORK.EQ.0)GO TO 30
- IF(IQ(LHWORK-2).EQ.0)THEN
- CHTYPE = '?'
- CHTITL = '??? '
- GO TO 10
- ENDIF
- ENDIF
-*
-*-* Shared memory or global section
-#if defined(CERNLIB_VAX)
- IF(ICHTOP(ICDIR).LT.0)THEN
- LOCQ=1-LOCF(IPAWC(1))-ICHTOP(ICDIR)
- CALL HRZING(IPAWC(LOCQ),IDH,JCID)
- LHWORK=JCID+LOCQ-1
- KOF=1-LOCQ
- ENDIF
-#endif
-#if defined(CERNLIB_HMMAP)
- IF(ICHTOP(ICDIR).LT.0)THEN
- IGOFF=-LOCF(LQ(1))-ICHTOP(ICDIR)
- KOF=LQ(IGOFF+2)
- CALL HRZINM(LQ(IGOFF+1),IDH,JCID)
- LHWORK=JCID+IGOFF
- ENDIF
-#endif
-*
- IF (JBIT(IQ(LHWORK+KBITS),1).NE.0) THEN
- CHTYPE = '1'
- CHTITL = ' '
- NWTITL = IQ(LHWORK-1)-KTIT1+1
- CALL UHTOC(IQ(LHWORK+KTIT1),4,CHTITL,NWTITL*4)
- NX = IQ(LHWORK+KNCX)
- XMIN = Q(LHWORK+KXMIN)
- XMAX = Q(LHWORK+KXMAX)
- ISW = IQ(LHWORK+KBITS)
- ELSEIF (JBYT(IQ(LHWORK+KBITS),2,2).NE.0) THEN
- CHTYPE = '2'
- CHTITL = ' '
- NWTITL = IQ(LHWORK-1)-KTIT2+1
- CALL UHTOC(IQ(LHWORK+KTIT2),4,CHTITL,NWTITL*4)
- NX = IQ(LHWORK+KNCX)
- XMIN = Q(LHWORK+KXMIN)
- XMAX = Q(LHWORK+KXMAX)
- NY = IQ(LHWORK+KNCY)
- YMIN = Q(LHWORK+KYMIN)
- YMAX = Q(LHWORK+KYMAX)
- ISW = IQ(LHWORK+KBITS)
- ELSE
- CHTYPE = 'N'
- CHTITL = ' '
- IF (IQ(LHWORK-2) .EQ. 2) THEN
- ITIT1 = IQ(LHWORK+9)
- NWTITL = IQ(LHWORK+8)
- ISW = IQ(LHWORK+KBITS)
- NX = IQ(LHWORK+2)
- NY = IQ(LHWORK+3)
- LL = LQ(LHWORK-2)-KOF
- XMIN = Q(LL+1)
- XMAX = Q(LL+2)
- ELSE
- ITIT1 = IQ(LHWORK+ZITIT1)
- NWTITL = IQ(LHWORK+ZNWTIT)
- ISW = IQ(LHWORK+ZBITS)
- NX = IQ(LHWORK+ZNDIM)
- NY = IQ(LHWORK+ZNOENT)
- XMIN = 1
- XMAX = 100
- ENDIF
- CALL UHTOC(IQ(LHWORK+ITIT1),4,CHTITL,NWTITL*4)
- ENDIF
- 10 IF(ICHTOP(ICDIR).GT.0)CALL MZDROP(IHWORK,LHWORK,' ')
- LHWORK=0
- GO TO 999
-*
-* Return histograms in memory
-*
- 20 CALL HFIND(IDH,'HLATTR')
- IF(LCID.EQ.0) GOTO 30
- CALL HDCOFL
-*
- IF(IQ(LCID-2).EQ.0)THEN
- CHTYPE = '?'
- CHTITL = '??? '
- GO TO 999
- ENDIF
- IF (I1.NE.0) THEN
- CHTYPE = '1'
- CHTITL = ' '
- NWTITL = IQ(LCID-1)-KTIT1+1
- CALL UHTOC(IQ(LCID+KTIT1),4,CHTITL,NWTITL*4)
- NX = IQ(LCID+KNCX)
- XMIN = Q(LCID+KXMIN)
- XMAX = Q(LCID+KXMAX)
- ISW = IQ(LCID+KBITS)
- ELSEIF (I230.NE.0) THEN
- CHTYPE = '2'
- CHTITL = ' '
- NWTITL = IQ(LCID-1)-KTIT2+1
- CALL UHTOC(IQ(LCID+KTIT2),4,CHTITL,NWTITL*4)
- NX = IQ(LCID+KNCX)
- XMIN = Q(LCID+KXMIN)
- XMAX = Q(LCID+KXMAX)
- NY = IQ(LCID+KNCY)
- YMIN = Q(LCID+KYMIN)
- YMAX = Q(LCID+KYMAX)
- ISW = IQ(LCID+KBITS)
- ELSEIF (I4.NE.0) THEN
- CHTYPE = 'N'
- CHTITL = ' '
- IF (IQ(LCID-2) .EQ. 2) THEN
- ITIT1 = IQ(LCID+9)
- NWTITL = IQ(LCID+8)
- ISW = IQ(LCID+KBITS)
- NX = IQ(LCID+2)
- NY = IQ(LCID+3)
- LL = LQ(LCID-2)
- XMIN = Q(LL+1)
- XMAX = Q(LL+2)
- ELSE
- ITIT1 = IQ(LCID+ZITIT1)
- NWTITL = IQ(LCID+ZNWTIT)
- ISW = IQ(LCID+ZBITS)
- NX = IQ(LCID+ZNDIM)
- NY = IQ(LCID+ZNOENT)
- XMIN = 1
- XMAX = 100
- ENDIF
- CALL UHTOC(IQ(LCID+ITIT1),4,CHTITL,NWTITL*4)
- ELSE
- CHTYPE = '?'
- CHTITL = '??? '
- ENDIF
- GO TO 999
-*
- 30 IER = -1
-*
- 999 END
diff --git a/src/packlib/hbook/code/hlccmp.F b/src/packlib/hbook/code/hlccmp.F
deleted file mode 100644
index b1d41b4..0000000
--- a/src/packlib/hbook/code/hlccmp.F
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: hlccmp.F,v 1.1.1.1 1996/01/16 17:07:41 mclareni Exp $
-*
-* $Log: hlccmp.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:41 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.17/01 18/11/92 18.21.19 by Rene Brun
-*-- Author :
- INTEGER FUNCTION HLCCMP(H1,CH,LGR)
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-C HLHCMP compare h1 an hollerith chacacter and CH a normal charcater
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-C H1 array of integer ( length LGR/4 )
-C CH CHARACTER*LGR
-C LGR < 40
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
- INTEGER HLHCMP
- INTEGER H1(*)
- CHARACTER CH*(*)
- INTEGER LGR
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
- INTEGER H2(16)
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
- CALL UCTOH(CH,H2(1),4,LGR)
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
- HLCCMP = HLHCMP(H1,H2(1),LGR)
- RETURN
-C
- END
-
-
diff --git a/src/packlib/hbook/code/hldir.F b/src/packlib/hbook/code/hldir.F
deleted file mode 100644
index b198ecc..0000000
--- a/src/packlib/hbook/code/hldir.F
+++ /dev/null
@@ -1,165 +0,0 @@
-*
-* $Id: hldir.F,v 1.1.1.1 1996/01/16 17:07:42 mclareni Exp $
-*
-* $Log: hldir.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:42 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.23/01 15/11/94 18.27.42 by Fons Rademakers
-*-- Author :
- SUBROUTINE HLDIR(CHPATH,CHOPT)
-*.==========>
-*. To list histogram titles and IDs of directory CHPATH.
-*. Input:
-*. *CHPATH* Character variable specifying the pathname
-*. (if CHPATH=' ') same as Current directory
-*. CHOPT Character variable specifying the option
-*. ' ' list only Current directory
-*. 'T' list subdirectories tree as well
-*. 'I' option HINDEX selected instead of simple list
-*. 'N' only Ntuples are listed
-*. 'R' List using RZ format
-*. 'S' List directory in increasing order of IDs
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
-#include "hbook/hcunit.inc"
-#include "hbook/hcdire.inc"
-#include "hbook/hcmail.inc"
-#include "hbook/hcpiaf.inc"
- DIMENSION IPAWC(99)
- EQUIVALENCE (NWPAW,IPAWC(1))
- COMMON/QUEST/IQUEST(100)
- CHARACTER*(*) CHPATH,CHOPT
- CHARACTER*128 CHWOLD
- DIMENSION LCUR(15),IOPT(5)
- EQUIVALENCE (IOPTT,IOPT(1)),(IOPTR,IOPT(2)),(IOPTN,IOPT(3))
- EQUIVALENCE (IOPTI,IOPT(4)),(IOPTS,IOPT(5))
- EXTERNAL HLDIRT
-*.___________________________________________
- IF(CHPATH.EQ.'//')THEN
- DO 10 I=1,NCHTOP
- CHMAIL=CHTOP(I)//HFNAME(I)
- NCH=LENOCC(CHMAIL)
- WRITE(LOUT,1000)CHMAIL(1:NCH)
- 10 CONTINUE
- 1000 FORMAT(' //',A)
- GO TO 99
- ENDIF
- IF(LHBOOK.EQ.0)GO TO 99
- CALL HUOPTC (CHOPT,'TRNIS',IOPT)
-*
-* Save Current directory
-*
- CALL HPAFF(CHCDIR,NLCDIR,CHWOLD)
- LR2=LCDIR
-*
-* Set Current Working directory to CHPATH
-*
- CALL HCDIR(CHPATH,' ')
- IF (IQUEST(1) .NE. 0) GOTO 40
-*
- IF(ICHTOP(ICDIR).NE.0)THEN
-#if defined(CERNLIB_CZ)
- IF(ICHTOP(ICDIR).GT.1000 .AND.
- + ICHLUN(ICDIR).NE.0)THEN
-*
-* remote file on Piaf server
-*
- ISKIN =MOD(ICHTOP(ICDIR),10000)
- ISKOUT=ICHTOP(ICDIR)/10000
- CHSMPF='HLDIR:'//CHOPT
- CHSMPF(21:)=CHPATH
- CALL CZPUTA(CHSMPF,ISTAT)
- IF (ISTAT .NE. 0) GOTO 40
- CALL HLOGPF(' ',ISTAT)
- GOTO 40
- ENDIF
- IF(ICHTOP(ICDIR).GT.1000 .AND.
- + ICHLUN(ICDIR).EQ.0)THEN
-*
-* remote file on PAWSERV (global section or shared memory)
-*
- ISKIN =MOD(ICHTOP(ICDIR),10000)
- ISKOUT=ICHTOP(ICDIR)/10000
- CHSMPF='MESS :LI'
- CALL CZPUTA(CHSMPF,ISTAT)
- IF (ISTAT .NE. 0) GOTO 40
- 15 CALL CZGETA(CHMAIL,ISTAT)
- IF (ISTAT .NE. 0) GOTO 40
- IF(CHMAIL(1:1).EQ.'0')GO TO 40
- NCH=LENOCC(CHMAIL)
- IF(NCH.GT.1)THEN
- WRITE(LOUT,'(A)')CHMAIL(2:NCH)
- ENDIF
- IF(CHMAIL(1:1).EQ.'2')GO TO 15
- GOTO 40
- ENDIF
-#endif
-#if defined(CERNLIB_HMMAP)
- IF(ICHTOP(ICDIR).LT.0)THEN
- IGOFF=-LOCF(LQ(1))-ICHTOP(ICDIR)
- CALL HPLISM(LQ(IGOFF+1))
- GO TO 99
- ENDIF
-#endif
-#if defined(CERNLIB_VAX)
- IF(ICHTOP(ICDIR).LT.0)THEN
- LOCQ=1-LOCF(IPAWC(1))-ICHTOP(ICDIR)
- CALL HPLISG(IPAWC(LOCQ))
- GO TO 99
- ENDIF
-#endif
- IF(IOPTR.NE.0)THEN
- CALL HRZLD(' ',CHOPT)
- ELSE
- IQUEST(88)=IOPTS
- IQUEST(89)=IOPTN
- IF(IOPTT.EQ.0)THEN
- CALL HLDIRT(CHPATH)
- ELSE
- CALL RZSCAN(' ',HLDIRT)
- ENDIF
- ENDIF
- GO TO 40
- ENDIF
-*
- NLPAT0=NLPAT
- LCUR(NLPAT)=LCDIR
-*
-* Lists current level
-*
- IF(IOPTS.NE.0)CALL ZSORTI(IHDIV,LIDS,-5)
- CALL HLDIR1(IOPTI,IOPTN,1)
-*
-* Lists subdirectories
-*
- 20 NLPAT=NLPAT+1
- LCDIR=LQ(LCDIR-1)
- 30 LCUR(NLPAT)=LCDIR
- IF(LCDIR.EQ.0)THEN
- NLPAT=NLPAT-1
- LCDIR=LCUR(NLPAT)
- IF(NLPAT.LE.NLPAT0)GO TO 40
- LCDIR=LQ(LCDIR)
- GO TO 30
- ENDIF
- CALL UHTOC(IQ(LCDIR+1),4,CHCDIR(NLPAT),16)
- LIDS=LQ(LCDIR-2)
- LTAB=LQ(LCDIR-3)
- IF(IOPTS.NE.0)CALL ZSORTI(IHDIV,LIDS,-5)
- CALL HLDIR1(IOPTI,IOPTN,IOPTT)
- GO TO 20
-*
-* Restore Current Directory
-*
- 40 CALL HCDIR(CHWOLD,' ')
- LCDIR = LR2
- LIDS = LQ(LCDIR-2)
- LTAB = LQ(LCDIR-3)
- LBUFM = LQ(LCDIR-4)
- LTMPM = LQ(LCDIR-5)
-*
- 99 RETURN
- END
diff --git a/src/packlib/hbook/code/hldir1.F b/src/packlib/hbook/code/hldir1.F
deleted file mode 100644
index 668bae1..0000000
--- a/src/packlib/hbook/code/hldir1.F
+++ /dev/null
@@ -1,80 +0,0 @@
-*
-* $Id: hldir1.F,v 1.1.1.1 1996/01/16 17:07:42 mclareni Exp $
-*
-* $Log: hldir1.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:42 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.17/09 08/02/93 12.59.16 by Rene Brun
-*-- Author :
- SUBROUTINE HLDIR1(IOPTI,IOPTN,IOPTT)
-*.==========>
-*. To list the contents of directory pointed by LCDIR.
-*. If IOPTI=1 lists with HINDEX format
-*. If IOPTN=1 lists only Ntuples
-*. If IOPTT=1 lists subdirectories
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
-#include "hbook/hcflag.inc"
-#include "hbook/hcunit.inc"
-#include "hbook/hcbits.inc"
-#include "hbook/hcmail.inc"
-#include "hbook/hcdire.inc"
-#include "hbook/hcntpar.inc"
- CHARACTER*1 HTYPE
-*.___________________________________________
-*
-* Write name of directory pointed by LCDIR
-*
- CHMAIL=' '
- CALL HPAFF(CHCDIR,NLPAT,CHMAIL)
- NCH=LENOCC(CHMAIL)
- WRITE(LOUT,1000)CHMAIL(1:NCH)
- IF(IOPTT.EQ.0)GO TO 99
-*
- IF(IOPTI.NE.0)THEN
- CALL HINDEX
- GO TO 99
- ENDIF
-*
- IDD=0
- IRET=3
- 10 CALL HLOOP(IDD,'HLDIR ',IRET)
- IF(IRET.EQ.0)GO TO 99
-*
- CALL HDCOFL
- IF(I1.NE.0)THEN
- IF(IOPTN.EQ.0)THEN
- HTYPE='1'
- NWTITL=IQ(LCID-1)-KTIT1+1
- WRITE(LOUT,2000)ID,HTYPE,(IQ(LCID+KTIT1+I-1),I=1,NWTITL)
- ENDIF
- ELSEIF(I230.NE.0)THEN
- IF(IOPTN.EQ.0)THEN
- HTYPE='2'
- NWTITL=IQ(LCID-1)-KTIT2+1
- WRITE(LOUT,2000)ID,HTYPE,(IQ(LCID+KTIT2+I-1),I=1,NWTITL)
- ENDIF
- ELSEIF(I4.NE.0)THEN
- HTYPE='N'
- IF (IQ(LCID-2) .EQ. 2) THEN
- ITIT1=IQ(LCID+9)
- NWTITL=IQ(LCID+8)
- ELSE
- ITIT1=IQ(LCID+ZITIT1)
- NWTITL=IQ(LCID+ZNWTIT)
- ENDIF
- WRITE(LOUT,2000)ID,HTYPE,(IQ(LCID+ITIT1+I-1),I=1,NWTITL)
- ELSE
- WRITE(LOUT,2100)ID
- ENDIF
- IRET=2
- GO TO 10
-*
- 1000 FORMAT(//,' ===> Directory : ',A)
- 2000 FORMAT(1X,I10,1X,'(',A,')',3X,20A4)
- 2100 FORMAT(1X,I10,1X,'(A) Unnamed array')
- 99 RETURN
- END
diff --git a/src/packlib/hbook/code/hldir2.F b/src/packlib/hbook/code/hldir2.F
deleted file mode 100644
index 091d2ec..0000000
--- a/src/packlib/hbook/code/hldir2.F
+++ /dev/null
@@ -1,108 +0,0 @@
-*
-* $Id: hldir2.F,v 1.1.1.1 1996/01/16 17:07:42 mclareni Exp $
-*
-* $Log: hldir2.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:42 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.20/08 12/09/93 18.56.12 by Rene Brun
-*-- Author :
- SUBROUTINE HLDIR2
-*.==========>
-*. To list the contents of a RZ directory
-*. in format ID Title
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
-#include "hbook/hcflag.inc"
-#include "hbook/hcmail.inc"
-#include "hbook/hcunit.inc"
-#include "hbook/hcdire.inc"
- COMMON/QUEST/IQUEST(100)
- CHARACTER*1 HTYPE
- INTEGER KEYS(2)
-*.___________________________________________
-*
-* Check if directory in GLOBAL SECTION
-*
- IF(ICHTOP(ICDIR).LT.0)THEN
- LOCQ=1-LOCF(IQUEST(1))-ICHTOP(ICDIR)
- CALL HCOPYM(0,IQUEST(LOCQ),IOFSET)
- GO TO 99
- ENDIF
-* Write name of directory pointed by LCDIR
-*
- CHMAIL=' '
- CALL HPAFF(CHCDIR,NLPAT,CHMAIL)
- NCH=LENOCC(CHMAIL)
- WRITE(LOUT,1000)CHMAIL(1:NCH)
-*
-*
-* Find first ID in the RZ directory
-*
- KEYS(1) = 1
- KEYS(2) = 0
- CALL HRZIN(IHWORK,0,0,KEYS,9999,'SC')
- IDN=IQUEST(21)
- IQ42=IQUEST(22)
-
-*
-* Enough space left ?
-*
- 10 KEYS(1) = IDN
- KEYS(2) = IQ42
- CALL HRZIN(IHWORK,0,0,KEYS,9999,'NC')
- IF(IQUEST(1).NE.0)GO TO 90
- IQ40=IQUEST(40)
- IQ41=IQUEST(41)
- IQ42=IQUEST(42)
- NWORDS=IQUEST(12)
- IOPTA=JBIT(IQUEST(14),4)
- IF(IOPTA.NE.0)GO TO 40
- CALL HSPACE(NWORDS+1000,'HLDIR ',IDD)
- IF(IERR.NE.0) GO TO 90
-*
-* Read histogram data structure
-*
- KEYS(1) = IDN
- CALL HRZIN(IHWORK,LHWORK,1,KEYS,9999,'ND')
- IF(IQUEST(1).NE.0)THEN
- CALL HBUG('Bad sequence for RZ','HLDIR',IDN)
- GO TO 90
- ENDIF
-*
- IF(IQ(LHWORK-2).EQ.0)THEN
- WRITE(LOUT,2100)IDN
- ELSEIF(JBIT(IQ(LHWORK+KBITS),1).NE.0)THEN
- HTYPE='1'
- NWTITL=IQ(LHWORK-1)-KTIT1+1
- WRITE(LOUT,2000)IDN,HTYPE,(IQ(LHWORK+KTIT1+I-1),I=1,NWTITL)
- ELSEIF(JBYT(IQ(LHWORK+KBITS),2,2).NE.0)THEN
- HTYPE='2'
- NWTITL=IQ(LHWORK-1)-KTIT2+1
- WRITE(LOUT,2000)IDN,HTYPE,(IQ(LHWORK+KTIT2+I-1),I=1,NWTITL)
- ELSEIF(JBIT(IQ(LHWORK+KBITS),4).NE.0)THEN
- HTYPE='N'
- ITIT1=IQ(LHWORK+9)
- NWTITL=IQ(LHWORK+8)
- WRITE(LOUT,2000)IDN,HTYPE,(IQ(LHWORK+ITIT1+I-1),I=1,NWTITL)
- ENDIF
-*
- CALL MZDROP(IHWORK,LHWORK,' ')
- 40 LHWORK=0
-*
- IF(IQ40.EQ.0)THEN
- CALL MZWIPE(IHWORK)
- GO TO 99
- ENDIF
- IDN=IQ41
- GO TO 10
-*
- 90 CONTINUE
-*
- 1000 FORMAT(//,' ===> Directory : ',A)
- 2000 FORMAT(1X,I10,1X,'(',A,')',3X,20A4)
- 2100 FORMAT(1X,I10,1X,'(A) Unnamed array')
- 99 RETURN
- END
diff --git a/src/packlib/hbook/code/hldirt.F b/src/packlib/hbook/code/hldirt.F
deleted file mode 100644
index 3d8ab1f..0000000
--- a/src/packlib/hbook/code/hldirt.F
+++ /dev/null
@@ -1,116 +0,0 @@
-*
-* $Id: hldirt.F,v 1.1.1.1 1996/01/16 17:07:42 mclareni Exp $
-*
-* $Log: hldirt.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:42 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.23/01 15/11/94 18.29.06 by Fons Rademakers
-*-- Author : Rene Brun 17/07/91
- SUBROUTINE HLDIRT(CHDIR)
-*.==========>
-*. To list the contents of a RZ directory
-*. in format ID Title
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
-#include "hbook/hcflag.inc"
-#include "hbook/hcunit.inc"
-#include "hbook/hcntpar.inc"
- CHARACTER*(*) CHDIR
- COMMON/QUEST/IQUEST(100)
- CHARACTER*1 HTYPE
- INTEGER KEYS(2)
-*.___________________________________________
-*
-* Write name of current directory
-*
- NCH=LENOCC(CHDIR)
- WRITE(LOUT,1000)CHDIR(1:NCH)
-*
-*-- Sort directory if IOPTS set
- IOPTS=IQUEST(88)
- IOPTN=IQUEST(89)
- IF(IOPTS.NE.0)CALL HRSORT('S')
-*
-*
-* Find first ID in the RZ directory
-*
- KEYNUM = 1
- KEYS(1) = KEYNUM
- KEYS(2) = 0
- CALL HRZIN(IHWORK,0,0,KEYS,9999,'SC')
- IDN=IQUEST(21)
- IQ42=IQUEST(22)
-*
-* Enough space left ?
-*
- 10 IF (IDN .EQ. 0) GOTO 90
- KEYS(1) = KEYNUM
- CALL HRZIN(IHWORK,0,0,KEYS,9999,'SNC')
- IF(IQUEST(1).NE.0)GO TO 90
- IDN =IQUEST(21)
- IQ40=IQUEST(40)
- IQ41=IQUEST(41)
- IQ42=IQUEST(42)
- IF(IQ40.EQ.0) IQ41=0
- NWORDS=IQUEST(12)
- IOPTA=JBIT(IQUEST(14),4)
- IF(IOPTA.NE.0)GO TO 40
- CALL HSPACE(NWORDS+1000,'HLDIR ',IDN)
- IF(IERR.NE.0) GO TO 90
-*
-* Read histogram data structure
-*
- CALL HRZIN(IHWORK,LHWORK,1,KEYS,9999,'SND')
- IF(IQUEST(1).NE.0)THEN
- CALL HBUG('Bad sequence for RZ','HLDIR',IDN)
- GO TO 90
- ENDIF
-*
- IF(IQ(LHWORK-2).EQ.0)THEN
- WRITE(LOUT,2100)IDN
- ELSEIF(JBIT(IQ(LHWORK+KBITS),1).NE.0)THEN
- IF(IOPTN.EQ.0)THEN
- HTYPE='1'
- NWTITL=IQ(LHWORK-1)-KTIT1+1
- WRITE(LOUT,2000)IDN,HTYPE,(IQ(LHWORK+KTIT1+I-1),I=1,NWTITL)
- ENDIF
- ELSEIF(JBYT(IQ(LHWORK+KBITS),2,2).NE.0)THEN
- IF(IOPTN.EQ.0)THEN
- HTYPE='2'
- NWTITL=IQ(LHWORK-1)-KTIT2+1
- WRITE(LOUT,2000)IDN,HTYPE,(IQ(LHWORK+KTIT2+I-1),I=1,NWTITL)
- ENDIF
- ELSEIF(JBIT(IQ(LHWORK+KBITS),4).NE.0)THEN
- HTYPE='N'
- IF (IQ(LHWORK-2) .EQ. 2) THEN
- ITIT1=IQ(LHWORK+9)
- NWTITL=IQ(LHWORK+8)
- ELSE
- ITIT1=IQ(LHWORK+ZITIT1)
- NWTITL=IQ(LHWORK+ZNWTIT)
- ENDIF
- WRITE(LOUT,2000)IDN,HTYPE,(IQ(LHWORK+ITIT1+I-1),I=1,NWTITL)
- ENDIF
-*
- CALL MZDROP(IHWORK,LHWORK,' ')
- 40 LHWORK=0
-*
- IF(IQ40.EQ.0)THEN
- CALL MZWIPE(IHWORK)
- GO TO 99
- ENDIF
- KEYNUM=KEYNUM+1
- IDN=IQ41
- GO TO 10
-*
- 90 CONTINUE
-*
- 1000 FORMAT(//,' ===> Directory : ',A)
- 2000 FORMAT(1X,I10,1X,'(',A,')',3X,20A4)
- 2100 FORMAT(1X,I10,1X,'(A) Unnamed array')
- 99 RETURN
- END
-
diff --git a/src/packlib/hbook/code/hlgnxt.F b/src/packlib/hbook/code/hlgnxt.F
deleted file mode 100644
index 230b526..0000000
--- a/src/packlib/hbook/code/hlgnxt.F
+++ /dev/null
@@ -1,71 +0,0 @@
-*
-* $Id: hlgnxt.F,v 1.1.1.1 1996/01/16 17:07:42 mclareni Exp $
-*
-* $Log: hlgnxt.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:42 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.17/03 13/01/93 21.07.52 by Rene Brun
-*-- Author : P.Aubert 18/11/92
- SUBROUTINE HLGNXT(IDD,IPOS,CHLAB,CHOPT)
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-C HLGNXT : HBOOK GET NEXT LABEL
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-C IDD
-C IPOS
-C CHLAB
-C CHOPT 'X','Y' OR 'Z' 'X' BY DEFAULT
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-#include "hbook/hcbook.inc"
-#include "hbook/hcflag.inc"
-#include "hbook/hcbits.inc"
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-C PARAMETER
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
- INTEGER KLGRCX,KBLAB,KNCHX
- PARAMETER(KLGRCX=16,KBLAB=7,KNCHX=2)
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
- INTEGER IDD,IPOS
- CHARACTER*(*) CHLAB,CHOPT
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
- INTEGER IOPT(3),IDPOS
- CHARACTER*16 CHTEMP
-C ----------------------------------------------------------------------
-C Init value
-C ----------------------------------------------------------------------
- IF(IDD.NE.IDLAST)THEN
- ID = IDD
- IDPOS = LOCATI(IQ(LTAB+1),IQ(LCDIR+KNRH),ID)
- IF(IDPOS.LE.0)RETURN
- IDLAST = ID
- LCID = LQ(LTAB-IDPOS)
- CALL HDCOFL
- ENDIF
-C -- options ???
- CALL UOPTC(CHOPT,'XYZ',IOPT)
-C -- DIM ?
- IF(I1.NE.0)THEN
-C -- 1D
- LCH = LQ(LCID-8)
- ELSE
-C -- 2D
-C -- AXE Y
- IF(IOPT(2).EQ.1)THEN
- LCH = LQ(LCID-9)
-C -- AXE X or default
- ELSE
- LCH = LQ(LCID-8)
- ENDIF
- ENDIF
-C -- test
- IF((IPOS.LT.0).OR.(IPOS.GT.IQ(LCH+KNCHX)))THEN
- CALL HBUG('IPOS out of range','HLGNXT',ID)
- ENDIF
- CALL UHTOC(IQ(LCH+KBLAB+4*(IPOS-1)),4,CHTEMP,KLGRCX)
-C
- LGR = MIN(LEN(CHLAB),KLGRCX)
- CHLAB(1:LGR) = CHTEMP(1:LGR)
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
- END
diff --git a/src/packlib/hbook/code/hlhcmp.F b/src/packlib/hbook/code/hlhcmp.F
deleted file mode 100644
index 56000a6..0000000
--- a/src/packlib/hbook/code/hlhcmp.F
+++ /dev/null
@@ -1,75 +0,0 @@
-*
-* $Id: hlhcmp.F,v 1.2 1998/09/25 09:26:58 mclareni Exp $
-*
-* $Log: hlhcmp.F,v $
-* Revision 1.2 1998/09/25 09:26:58 mclareni
-* Modifications for the Mklinux port flagged by CERNLIB_PPC
-*
-* Revision 1.1.1.1 1996/01/16 17:07:42 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.22/11 23/08/94 14.17.45 by Rene Brun
-*-- Author : Aubert Pierre
- INTEGER FUNCTION HLHCMP(H1,H2,LGR)
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-C HLHCMP compare two hollerith chacacters H1 and H2 of length LGR
-C 4 by 4 blocks
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-C H1,H2 two array of integer ( length LGR/4 )
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
- INTEGER H1(*),H2(*),LGR
-#if defined(CERNLIB_VAX)||defined(CERNLIB_DECS)||defined(CERNLIB_MSDOS)||(defined(CERNLIB_LINUX) && !defined(CERNLIB_PPC))||defined(CERNLIB_WINNT)
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-C
-C WITH BYTE SWAPING
-C
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
- CHARACTER*64 CH1,CH2
-C
- CALL UHTOC(H1,4,CH1,LGR)
- CALL UHTOC(H2,4,CH2,LGR)
-C
- IF(CH1(1:LGR).LT.CH2(1:LGR))THEN
- HLHCMP = -1
- ELSE IF(CH1(1:LGR).EQ.CH2(1:LGR))THEN
- HLHCMP = 0
- ELSE
- HLHCMP = 1
- ENDIF
- RETURN
-#endif
-#if (!defined(CERNLIB_VAX))&&(!defined(CERNLIB_DECS))&&(!defined(CERNLIB_MSDOS))&&(!(defined(CERNLIB_LINUX) && !defined(CERNLIB_PPC)))&&(!defined(CERNLIB_WINNT))
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-C
-C WITHOUT BYTE SWAPING
-C
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
- INTEGER NB,NBTOT,P1,P2
-C
- IF(MOD(LGR,4).NE.0) LGR = LGR - MOD(LGR,4)
-C
- NBTOT = LGR / 4
-C
- NB = 1
- 10 P1 = H1(NB)
- P2 = H2(NB)
- IF( P1 .LT. P2 )THEN
- HLHCMP = -1
- RETURN
- ELSE IF( P1 .GT. P2 )THEN
- HLHCMP = +1
- RETURN
- ELSE
- IF( NB .EQ. NBTOT )THEN
- HLHCMP = 0
- RETURN
- ELSE
- NB = NB + 1
- GO TO 10
- ENDIF
- ENDIF
-C
-#endif
- END
diff --git a/src/packlib/hbook/code/hlimit.F b/src/packlib/hbook/code/hlimit.F
deleted file mode 100644
index 894d288..0000000
--- a/src/packlib/hbook/code/hlimit.F
+++ /dev/null
@@ -1,97 +0,0 @@
-*
-* $Id: hlimit.F,v 1.3 2001/10/10 08:09:12 couet Exp $
-*
-* $Log: hlimit.F,v $
-* Revision 1.3 2001/10/10 08:09:12 couet
-* - Call MZFROM to initialise IOCC which is used later in HLABEL to create
-* alphamuneric labels data bank in histograms.
-*
-* Revision 1.2 1998/04/08 14:12:12 couet
-* - VIDQQ was not used, and was initialised as a wrong "what" string.
-*
-* Revision 1.1.1.1 1996/01/16 17:07:42 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.22/14 04/10/94 12.53.47 by Rene Brun
-*-- Author :
- SUBROUTINE HLIMIT (LIMIT)
-*.==========>
-*. Initialization routine for HBOOK
-*. IF(LIMIT>0) CALL MZEBRA and MZPAW
-*. IF(LIMIT=0) no calls to MZEBRA and MZPAW
-*. IF(LIMIT<0) CALL MZPAW
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
-#include "hbook/hcform.inc"
-#include "hbook/hcdire.inc"
-*.___________________________________________
-*
- CALL HMACHI
-*
- NHBOOK=IABS(LIMIT)
- IF(NHBOOK.LT.10000)NHBOOK=10000
- IF(LIMIT.GT.0)CALL MZEBRA(-3)
- IF(LIMIT.NE.0)CALL MZPAW(NHBOOK,' ')
- CALL MZLINK(IXPAWC,'/HCBOOK/',LHBOOK,LCDIR,LCIDN)
-*
-**************************************************************
-* *
-*-- Structural links in LHBOOK and LCDIR *
-* *
-* lq(lcdir-1)= lsdir : pointer to subdirectory *
-* lq(lcdir-2)= lids : pointer to 1st ID in directory *
-* lq(lcdir-3)= ltab : pointer to list of ordered IDs *
-* lq(lcdir-4)= lbuf : pointer to ntuple buffers *
-* lq(lcdir-5)= ltmp : pointer to ntuple buffers *
-* lq(lcdir-6)= lhquad: pointer to HQUAD buffers *
-* lq(lcdir-7)= : free *
-* lq(lcdir-8)= : free *
-* *
-*-- Reference links in LHBOOK and LCDIR *
-* R lq(lcdir-9)= llid : pointer to last ID in directory *
-* lq(lcdir-10)= : free *
-* lq(lcdir-11)= : \ *
-* .... : > free *
-* lq(lcdir-39)= : / *
-* R lq(lcdir-40)= : used by PAW *
-* R lq(lcdir-41)= : used by PAW *
-* lq(lcdir-42)= : \ *
-* .... : > free *
-* lq(lcdir-50)= : / *
-**************************************************************
-*
- IHWORK=IXPAWC+1
- IHDIV =IXPAWC+2
-*
- CALL MZFORM('HDIR','4H -I',IODIR)
- CALL MZFORM('HID1','1B 2I 6F -H',IOH1)
- CALL MZFORM('HID2','1B 2I 3F 1I 4F -H',IOH2)
- CALL MZFORM('HIDN','11I -H',IOHN)
- CALL MZFORM('HIDT','13I -H',IONT)
- CALL MZFORM('HBLK','7I -H',IOBL)
- CALL MZFORM('HCF1','2I 2F 4D -F',IOCF1)
- CALL MZFORM('HCB1','2I 2F 4D -B',IOCB1)
- CALL MZFORM('HCF2','2I -F',IOCF2)
- CALL MZFORM('HCF4','4I -F',IOCF4)
- CALL MZFORM('HCB2','2I -B',IOCB2)
- CALL MZFORM('HFIT','5I 5F -D',IOFIT)
- CALL MZFORM('LCHX','2I -H',IOCC)
- CALL MZBOOK(IHDIV,LCDIR,LHBOOK, 1,'HDIR',50,8,10,IODIR,0)
- CALL UCTOH('PAWC ',IQ(LCDIR+1),4,16)
- CALL MZBOOK(IHDIV,LTAB ,LHBOOK,-3,'HTAB',500,0,500,2,0)
-*
- LMAIN =LHBOOK
- NLCDIR=1
- NLPAT =1
- CHCDIR(1)='PAWC'
- NCHTOP=1
- CHTOP(1)='PAWC'
- HFNAME(1)='COMMON /PAWC/ in memory'
- ICHTOP(1)=0
- ICHLUN(1)=0
- ICDIR=1
-*
- 10 RETURN
- END
diff --git a/src/packlib/hbook/code/hllsq.F b/src/packlib/hbook/code/hllsq.F
deleted file mode 100644
index 9e91e34..0000000
--- a/src/packlib/hbook/code/hllsq.F
+++ /dev/null
@@ -1,51 +0,0 @@
-*
-* $Id: hllsq.F,v 1.1.1.1 1996/01/16 17:07:42 mclareni Exp $
-*
-* $Log: hllsq.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:42 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.22/11 23/08/94 14.17.45 by Rene Brun
-*-- Author :
- SUBROUTINE HLLSQ(NDATA,A0,A1,IFAIL)
-*.==========>
-*. Auxiliary to HFITPO/HFITEX.
-* Extracted from CERN Program library routine LLSQ
-*.
-*. Least square linear fit without weights
-*. (added to LSQ by B. Schorr, 15.02.1982.)
-*..=========> ( R.Brun from CERNLIB )
- DIMENSION EXDA(4)
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION XBAR, YBAR, X2BAR, XYBAR, DET
-#endif
- N=ABS(NDATA)
- IFAIL=-2
- XBAR=0.
- YBAR=0.
- X2BAR=0.
- XYBAR=0.
- DO 10 I=1,N
- CALL HFITH1(EXDA,I)
- XK=EXDA(3)
- YK=EXDA(1)
- IF(NDATA.LT.0)THEN
- IF(YK.LE.0.)YK=1.E-9
- YK=LOG(YK)
- ENDIF
- XBAR=XBAR+XK
- YBAR=YBAR+YK
- X2BAR=X2BAR+XK**2
- XYBAR=XYBAR+XK*YK
- 10 CONTINUE
- FN=FLOAT(N)
- DET=FN*X2BAR-XBAR**2
- IFAIL=-1
- IF(DET .LE. 0.) RETURN
- IFAIL=0
- A0=(X2BAR*YBAR-XBAR*XYBAR)/DET
- A1=(FN*XYBAR-XBAR*YBAR)/DET
- RETURN
- END
diff --git a/src/packlib/hbook/code/hlnext.F b/src/packlib/hbook/code/hlnext.F
deleted file mode 100644
index 5f41e1d..0000000
--- a/src/packlib/hbook/code/hlnext.F
+++ /dev/null
@@ -1,327 +0,0 @@
-*
-* $Id: hlnext.F,v 1.1.1.1 1996/01/16 17:07:42 mclareni Exp $
-*
-* $Log: hlnext.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:42 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 27/07/95 17.19.58 by Julian Bunn
-*-- Author : Alfred Nathaniel 06/07/92
- SUBROUTINE HLNEXT(IDH,CHTYPE,CHTITL,CHOPT)
-*.==========>
-*. To scan the content of the current directory in memory or RZ file:
-*.
-*. IDH=0
-*. 1 CONTINUE
-*. CALL HLNEXT(IDH,CHTYPE,CHTITL,CHOPT)
-*. IF(IDH.NE.0) THEN
-*. ... process
-*. GOTO 1
-*. ENDIF
-*.
-*. Input:
-*. *IDH* must be zero at first call
-*. returns identifier of next histogram
-*. returns zero if all histograms have been processed
-*. CHTYPE* returns histogram type:
-*. '1' 1-dimensional
-*. '2' 2-dimensional
-*. 'N' N-tuple
-*. 'D' subdirectory
-*. '?' unknown
-*. CHTITL* returns histogram title or subdirectory name
-*. CHOPT Character variable specifying the items to be scanned:
-*. '1' include 1d histograms
-*. '2' include 2d histograms
-*. 'N' include N-tuples
-*. 'D' include subdirectories
-*. ' ' include everything, i.e. equivalent to CHOPT='12ND?'
-*..=========> ( A.Nathaniel )
-#include "hbook/hcbits.inc"
-#include "hbook/hcbook.inc"
-#include "hbook/hcdire.inc"
-#include "hbook/hcflag.inc"
-#include "hbook/hcntpar.inc"
-#include "hbook/hcpiaf.inc"
-#include "hbook/czsock.inc"
- DIMENSION IPAWC(99)
- EQUIVALENCE (NWPAW,IPAWC(1))
- CHARACTER*(*) CHTYPE,CHTITL,CHOPT
- COMMON/QUEST/IQUEST(100)
- PARAMETER(MAXDIR=100)
- CHARACTER CHDIR(MAXDIR)*16,CHOPTL*5
- INTEGER IOPT(5), KEYS(2)
- EQUIVALENCE (IOPT1,IOPT(1)),(IOPT2,IOPT(2)),(IOPTN,IOPT(3))
- EQUIVALENCE (IOPTD,IOPT(4)),(IOPTX,IOPT(5))
- LOGICAL HISTOS,INFILE,FOUND,REMOTE
- SAVE HISTOS,INFILE,REMOTE
- SAVE CHDIR
- SAVE IOPT,KEYS,KEYNUM,NDIR,IDN,IQ40,IQ41,IQ42,IDD,IRET
-*.___________________________________________
- IF(IDH.EQ.0) THEN
-*
-* Initialize on first call
-*
- KEYNUM = 1
- CHOPTL = CHOPT
- IF(CHOPTL.EQ.' ') CHOPTL = '12ND?'
- CALL HUOPTC (CHOPTL,'12ND?',IOPT)
-*
- REMOTE = .FALSE.
- IF (ICHTOP(ICDIR) .GT. 1000) THEN
- REMOTE = .TRUE.
- GOTO 5
- ENDIF
-*
- HISTOS = IOPT1.NE.0 .OR. IOPT2.NE.0
- + .OR. IOPTN.NE.0 .OR. IOPTX.NE.0
- IF (HISTOS) THEN
-*
-* Find first ID in the RZ directory / Setup HLOOP
-*
- INFILE = ICHTOP(ICDIR).GT.0.AND.ICHTOP(ICDIR).LT.1000
- IF(INFILE) THEN
- KEYS(1) = KEYNUM
- KEYS(2) = 0
- CALL HRSORT('S')
- CALL HRZIN(IHWORK,0,0,KEYS,9999,'SC')
- IDN=IQUEST(21)
- IQ42=IQUEST(22)
- ELSEIF(ICHTOP(ICDIR).EQ.0)THEN
- CALL ZSORTI(IHDIV,LIDS,-5)
- IDD=0
- IRET=3
- ENDIF
- ENDIF
-*
-* Inquire number of subdirectories
-*
- NDIR=0
- IF(IOPTD.NE.0) THEN
- CALL HRDIR(MAXDIR,CHDIR,NDIR)
- IF(NDIR.GT.MAXDIR) THEN
- CALL HBUG('too many subdirectories','HLNEXT',NDIR)
- NDIR=MAXDIR
- ENDIF
- IOPTD=0
- ENDIF
- ENDIF
-*
- 5 IF (REMOTE) THEN
-#if defined(CERNLIB_CZ)
- IF(ICHTOP(ICDIR).GT.1000 .AND.
- + ICHLUN(ICDIR).EQ.0.AND.ICHTYP(ICDIR).EQ.0)THEN
-*
-* remote file on PAWSERV (global section or shared memory)
-*
- if(idh.eq.0)then
- ISKIN =MOD(ICHTOP(ICDIR),10000)
- ISKOUT=ICHTOP(ICDIR)/10000
- CHSMPF='MESS :LI'
- CALL CZPUTA(CHSMPF,ISTAT)
- IF (ISTAT .NE. 0) RETURN
- endif
- CALL CZGETA(CHSMPF,ISTAT)
- IF (ISTAT .NE. 0) RETURN
- IF(CHSMPF(1:1).EQ.'0')then
- idh=0
- RETURN
- endif
- READ(CHSMPF,'(1X,I10,2X,A1,4X,A60)')IDH,CHTYPE,CHTITL
- RETURN
- ENDIF
-*
-*--- remote file on Piaf server
-*
- ISKIN = MOD(ICHTOP(ICDIR),10000)
- ISKOUT = ICHTOP(ICDIR)/10000
- CHSMPF = 'HLNEXT:'
- WRITE(CHSMPF(8:),'(I8,A)') IDH,CHOPT
- CALL CZPUTA(CHSMPF,IRC)
- IF (IRC .NE. 0) THEN
- IDH = 0
- RETURN
- ENDIF
- CALL HLOGPF(' ',IRC)
- IDH = IQUEST(1)
- CALL CZGETA(CHSMPF,IRC)
- CHTYPE = CHSMPF(1:1)
- CHTITL = CHSMPF(2:)
-#endif
-#if !defined(CERNLIB_CZ)
- CALL HBUG('CZ option not active','HLNEXT',0)
- IQUEST(1)=1
-#endif
- RETURN
- ENDIF
-*
-* Return subdirectories
-*
- IOPTD=IOPTD+1
- IF(IOPTD.LE.NDIR) THEN
- IDH=IOPTD
- CHTYPE='D'
- CHTITL=CHDIR(IOPTD)
- RETURN
- ENDIF
-*
- IF(.NOT.HISTOS) RETURN
-*
-*-* Shared memory or global section
-#if defined(CERNLIB_VAX)
- IF(ICHTOP(ICDIR).LT.0)THEN
- LOCQ=1-LOCF(IPAWC(1))-ICHTOP(ICDIR)
- IF(KEYNUM.EQ.1)IDH=0
- CALL HLNXTG(IPAWC(LOCQ),IDH,CHTYPE,CHTITL,CHOPTL)
- KEYNUM=KEYNUM+1
- RETURN
- ENDIF
-#endif
-#if defined(CERNLIB_HMMAP)
- IF(ICHTOP(ICDIR).LT.0)THEN
- IGOFF=-LOCF(LQ(1))-ICHTOP(ICDIR)
- IF(KEYNUM.EQ.1)IDH=0
- CALL HLNXTM(LQ(IGOFF+1),IDH,CHTYPE,CHTITL,CHOPTL)
- KEYNUM=KEYNUM+1
- RETURN
- ENDIF
-#endif
-*
- IDH=0
- FOUND=.FALSE.
- 10 CONTINUE
- IF(INFILE) THEN
-*
-* Return histograms in RZ file
-*
- IF(IDN.EQ.0) RETURN
- KEYS(1) = KEYNUM
- CALL HRZIN(IHWORK,0,0,KEYS,9999,'SNC')
- IF(IQUEST(1).NE.0) RETURN
- IDN =IQUEST(21)
- IQ40=IQUEST(40)
- IQ41=IQUEST(41)
- IQ42=IQUEST(42)
- IF(IQ40.EQ.0) IQ41=0
- NWORDS=IQUEST(12)
- IF(JBIT(IQUEST(14),4).EQ.0) THEN
- CALL HSPACE(NWORDS+1000,'HLNEXT',IDN)
- IF(IERR.NE.0) RETURN
-*
-* Read histogram data structure
-*
-** KEYS(1)=IDN
-** KEYS(2)=0
- CALL HRZIN(IHWORK,LHWORK,1,KEYS,9999,'SND')
- IF(IQUEST(1).NE.0) THEN
- CALL HBUG('Bad sequence for RZ','HLNEXT',IDN)
- RETURN
- ENDIF
-*
- IF(IQ(LHWORK-2).EQ.0) THEN
- IF(IOPTX.NE.0) THEN
- FOUND=.TRUE.
- IDH=IDN
- CHTYPE='?'
- CHTITL='??? '
- ENDIF
- ELSEIF(JBIT(IQ(LHWORK+KBITS),1).NE.0) THEN
- IF(IOPT1.NE.0) THEN
- FOUND=.TRUE.
- IDH=IDN
- CHTYPE='1'
- CHTITL=' '
- NWTITL=IQ(LHWORK-1)-KTIT1+1
- CALL UHTOC(IQ(LHWORK+KTIT1),4,CHTITL,NWTITL*4)
- ENDIF
- ELSEIF(JBYT(IQ(LHWORK+KBITS),2,2).NE.0)THEN
- IF(IOPT2.NE.0) THEN
- FOUND=.TRUE.
- IDH=IDN
- CHTYPE='2'
- CHTITL=' '
- NWTITL=IQ(LHWORK-1)-KTIT2+1
- CALL UHTOC(IQ(LHWORK+KTIT2),4,CHTITL,NWTITL*4)
- ENDIF
- ELSEIF(JBIT(IQ(LHWORK+KBITS),4).NE.0)THEN
- IF(IOPTN.NE.0) THEN
- FOUND=.TRUE.
- IDH=IDN
- CHTYPE='N'
- CHTITL=' '
- IF (IQ(LHWORK-2) .EQ. 2) THEN
- ITIT1=IQ(LHWORK+9)
- NWTITL=IQ(LHWORK+8)
- ELSE
- ITIT1=IQ(LHWORK+ZITIT1)
- NWTITL=IQ(LHWORK+ZNWTIT)
- ENDIF
- CALL UHTOC(IQ(LHWORK+ITIT1),4,CHTITL,NWTITL*4)
- ENDIF
- ENDIF
-*
- CALL MZDROP(IHWORK,LHWORK,' ')
- ENDIF
- LHWORK=0
-*
- IF(IQ40.EQ.0) CALL MZWIPE(IHWORK)
- KEYNUM=KEYNUM+1
- IDN=IQ41
- IF(.NOT.FOUND) GOTO 10
- ELSE
-*
-* Return histograms in memory
-*
- 20 CONTINUE
- CALL HLOOP(IDD,'HLNEXT',IRET)
- IF(IRET.EQ.0) RETURN
- IRET=2
-*
- CALL HDCOFL
- IF(I1.NE.0) THEN
- IF(IOPT1.NE.0) THEN
- IDH=ID
- CHTYPE='1'
- CHTITL=' '
- NWTITL=IQ(LCID-1)-KTIT1+1
- CALL UHTOC(IQ(LCID+KTIT1),4,CHTITL,NWTITL*4)
- RETURN
- ENDIF
- ELSEIF(I230.NE.0) THEN
- IF(IOPT2.NE.0) THEN
- IDH=ID
- CHTYPE='2'
- CHTITL=' '
- NWTITL=IQ(LCID-1)-KTIT2+1
- CALL UHTOC(IQ(LCID+KTIT2),4,CHTITL,NWTITL*4)
- RETURN
- ENDIF
- ELSEIF(I4.NE.0) THEN
- IF(IOPTN.NE.0) THEN
- IDH=ID
- CHTYPE='N'
- CHTITL=' '
- IF (IQ(LCID-2) .EQ. 2) THEN
- ITIT1=IQ(LCID+9)
- NWTITL=IQ(LCID+8)
- ELSE
- ITIT1=IQ(LCID+ZITIT1)
- NWTITL=IQ(LCID+ZNWTIT)
- ENDIF
- CALL UHTOC(IQ(LCID+ITIT1),4,CHTITL,NWTITL*4)
- RETURN
- ENDIF
- ELSE
- IF(IOPTX.NE.0) THEN
- IDH=-1
- CHTYPE='?'
- CHTITL='??? '
- RETURN
- ENDIF
- ENDIF
- GOTO 20
- ENDIF
-*
- END
diff --git a/src/packlib/hbook/code/hlocat.F b/src/packlib/hbook/code/hlocat.F
deleted file mode 100644
index 24cd7f5..0000000
--- a/src/packlib/hbook/code/hlocat.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: hlocat.F,v 1.1.1.1 1996/01/16 17:07:42 mclareni Exp $
-*
-* $Log: hlocat.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:42 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.10/05 21/02/89 16.14.50 by Rene Brun
-*-- Author :
- SUBROUTINE HLOCAT(ID1,IFIRST)
-*.==========>
-*. returns the adress of hisT ID1
-*..=========> ( R.Brun )
-#include "hbook/hcflag.inc"
-#include "hbook/hcbook.inc"
-*.___________________________________________
- ID=ID1
- IDPOS=LOCATI(IQ(LTAB+1),IQ(LCDIR+KNRH),ID)
- IF(IDPOS.GT.0)THEN
- IFIRST=LQ(LTAB-IDPOS)
- ELSE
- IFIRST=0
- ENDIF
- END
diff --git a/src/packlib/hbook/code/hlogar.F b/src/packlib/hbook/code/hlogar.F
deleted file mode 100644
index 6c0ff71..0000000
--- a/src/packlib/hbook/code/hlogar.F
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: hlogar.F,v 1.1.1.1 1996/01/16 17:07:42 mclareni Exp $
-*
-* $Log: hlogar.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:42 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.10/05 21/02/89 16.14.50 by Rene Brun
-*-- Author :
- SUBROUTINE HLOGAR(ID1)
-*.==========>
-*. HISTS WILL BE PRINTED IN LOG SCALE (10) FOR CONTENTS
-*..=========> ( R.Brun )
-*.___________________________________________
- CALL HIDOPT(ID1,'LOGY')
- CALL HOBSOL('HLOGAR','LOGY','LINY')
- END
diff --git a/src/packlib/hbook/code/hlogpf.F b/src/packlib/hbook/code/hlogpf.F
deleted file mode 100644
index 13a00f0..0000000
--- a/src/packlib/hbook/code/hlogpf.F
+++ /dev/null
@@ -1,95 +0,0 @@
-*
-* $Id: hlogpf.F,v 1.2 1996/03/15 10:40:08 dinofm Exp $
-*
-* $Log: hlogpf.F,v $
-* Revision 1.2 1996/03/15 10:40:08 dinofm
-* The SUBROUTINE hlogpf.F has been modified so that the 'Logfile' coming from
-* the PIAF master is checked line by line before being printed on stdout.
-* This allows to suppress output of lines containing information that are
-* not relevant to the PAW user (such as PIAF server version)
-*
-* Revision 1.1.1.1 1996/01/16 17:07:42 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-#if defined(CERNLIB_CZ)
-*CMZ : 4.20/05 11/08/93 19.26.58 by Fons Rademakers
-*-- Author : Alfred Nathaniel 07/04/93
- SUBROUTINE HLOGPF(CHHEAD,ISTAT)
- CHARACTER*(*) CHHEAD
-*
-* receive log file from Piaf server and print it
-*
-#include "hbook/hcbook.inc"
-#include "hbook/czbuff.inc"
-#include "hbook/czcbuf.inc"
-*
- COMMON/QUEST/IQUEST(100)
- DIMENSION IQSAVE(100)
- CHARACTER CHMAIL*80
-
- IF(CHHEAD.NE.' ') THEN
- CHMAIL=CHHEAD
- ELSE
-*
-* get header from PSPLOG first
-*
- CALL CZGETA(CHMAIL,ISTAT)
- ENDIF
-
-*--- no log file
- IF(CHMAIL(7:).NE.' ') GOTO 99
-
- 1 CONTINUE
-*
-* get record length
-*
- N=6
- IF(IZCBUF.EQ.0)GO TO 999
- CALL JUMPST(IZCBUF)
- CALL JUMPX2(N,ISTAT)
- IF(ISTAT.NE.0) GOTO 999
- READ(CHBUF,'(I6)') LRECL
- IF(LRECL.LT.0) THEN
- NBYTE=-LRECL-1
- ELSE
- NBYTE=LRECL
- ENDIF
- IF(NBYTE.EQ.0) THEN
- CHBUF(:1)=' '
- L=1
- ELSE
- CALL JUMPX2(NBYTE,ISTAT)
- IF(ISTAT.NE.0) GOTO 999
- L=NBYTE
- ENDIF
-*-- If the PQRY keyword is found in the Log Line then there is some useful
-*-- info that must be retrieved instead of being printed.
- CALL GREPPQRY(CHBUF(:L),IRET)
- IF (IRET.EQ.0) THEN
-#if defined(CERNLIB_IBM)||defined(CERNLIB_VAX)
- PRINT '(1X,A)', CHBUF(:L)
-#endif
-#if (!defined(CERNLIB_IBM))&&(!defined(CERNLIB_VAX))
- PRINT '(A)', CHBUF(:L)
-#endif
- ENDIF
-
-*
-* last line has LRECL<0
-*
- IF(LRECL.GE.0) GOTO 1
-
- 99 CONTINUE
-*
-* receive IQUEST vector
-*
- NUH=100
- CALL FZIN(999,IHDIV,0,1,' ',NUH,IQSAVE(1))
- ISTAT=IQUEST(1)
- CALL UCOPY(IQSAVE(1),IQUEST(1),100)
-
- 999 CONTINUE
- END
-#endif
diff --git a/src/packlib/hbook/code/hloop.F b/src/packlib/hbook/code/hloop.F
deleted file mode 100644
index 2bfedf0..0000000
--- a/src/packlib/hbook/code/hloop.F
+++ /dev/null
@@ -1,50 +0,0 @@
-*
-* $Id: hloop.F,v 1.1.1.1 1996/01/16 17:07:42 mclareni Exp $
-*
-* $Log: hloop.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:42 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.10/05 24/03/89 10.46.48 by Rene Brun
-*-- Author :
- SUBROUTINE HLOOP(ID1,CHROUT,IRET)
-*.==========>
-*. IRET=2 CONTINUATION OF IRET=3
-*. =3 RETURN CONTROL TO ROUTINE CHROUT ONCE ENOUGH
-*. INFORMATION IS OBTAINED
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
-#include "hbook/hcflag.inc"
- CHARACTER*(*) CHROUT
-*.___________________________________________
- IDLAST=0
- IF(IRET.EQ.2)GO TO 50
- LCID=LIDS
-*
- IF(ID1.NE.0)THEN
- ID=ID1
- IDPOS=LOCATI(IQ(LTAB+1),IQ(LCDIR+KNRH),ID)
- IF(IDPOS.GT.0)THEN
- LCID=LQ(LTAB-IDPOS)
- GO TO 99
- ELSE
- LCID=0
- CALL HBUG('Unknown histogram',CHROUT,ID1)
- GO TO 60
- ENDIF
- ENDIF
-*
- 20 IF(LCID.EQ.0)GO TO 60
- ID=IQ(LCID-5)
- GO TO 99
-*
- 50 IF(ID1.NE.0)GO TO 60
- IF(IRET.EQ.2)IRET=3
- LCID=LQ(LCID)
- GO TO 20
-*
- 60 IRET=0
- 99 RETURN
- END
diff --git a/src/packlib/hbook/code/hlpos.F b/src/packlib/hbook/code/hlpos.F
deleted file mode 100644
index b1d7284..0000000
--- a/src/packlib/hbook/code/hlpos.F
+++ /dev/null
@@ -1,155 +0,0 @@
-*
-* $Id: hlpos.F,v 1.1.1.1 1996/01/16 17:07:42 mclareni Exp $
-*
-* $Log: hlpos.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:42 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.17/08 03/02/93 13.49.23 by Pierre Aubert
-*-- Author : P.Aubert 19/11/92
- SUBROUTINE HLPOS(IDD,CHX,IPOS,CHOPT)
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-C HLPOS : HBOOK LABEL POSITION
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-C
-C IN
-C --
-C
-C IDD : IDentifier
-C CHX : Character describe a LABEL on an axis discribe by CHOPT
-C CHOPT : 'X' or default 'Y','Z'
-C
-C OUT
-C ---
-C
-C IPOS : If Found -> return IPOS else retunr -1
-C
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-#include "hbook/hcbook.inc"
-#include "hbook/hcflag.inc"
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-C PARAMETER
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
- INTEGER KLGRCX,KBLAB,KNCHX
- PARAMETER(KLGRCX=16,KBLAB=7,KNCHX=2)
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-C COMMON
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
- LOGICAL HLABEQ
- INTEGER LCHX,NCHX,LCHY
- EQUIVALENCE(LCHX ,LHDUM(1))
- EQUIVALENCE(LCHY ,LHDUM(2))
- INTEGER LOCATI,HLCCMP
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-C VARIABLE
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
- INTEGER IDD
- CHARACTER*(*) CHX,CHOPT
- INTEGER IPOS
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-C LOCAL VARIABLE
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
- INTEGER IOPT(3),BITPOS,NCCHX,LEFT,RIGHT,MEDIAN
- CHARACTER AXE
- CHARACTER*16 CHANNELX
- LOGICAL LINEAR,EXIST
-C ----------------------------------------------------------------------
-C Init value
-C ----------------------------------------------------------------------
- IF(IDD.NE.IDLAST)THEN
- ID = IDD
- IDPOS = LOCATI(IQ(LTAB+1),IQ(LCDIR+KNRH),ID)
- IDLAST = ID
- LCID = LQ(LTAB-IDPOS)
- LCONT = LQ(LCID-1)
- ENDIF
-C ----------------------------------------------------------------------
-C -- options ???
-C ----------------------------------------------------------------------
- CALL UOPTC(CHOPT,'XYZ',IOPT)
- IF(IOPT(3).EQ.1)THEN
- AXE = 'Z'
- BITPOS = 3
- CALL HBUG('OPTION Z NOT IMPLEMENTED','HLPOS',ID)
- RETURN
- ELSE IF(IOPT(2).EQ.1)THEN
- AXE = 'Y'
- BITPOS = 2
- LCHX = LQ(LCID-9)
- NCHX = IQ(LCHY+KNCHX)
- ELSE
- AXE = 'X'
- BITPOS = 1
- LCHX = LQ(LCID-8)
- NCHX = IQ(LCHX+KNCHX)
- ENDIF
-C ----------------------------------------------------------------------
-C DOES LABEL EXIST ?
-C ----------------------------------------------------------------------
- IF(.NOT.HLABEQ(ID,AXE))THEN
- CALL HBUG('LABEL does not exist','HLPOS',ID)
- RETURN
- ENDIF
-C ----------------------------------------------------------------------
-C CHANNELX
-C ----------------------------------------------------------------------
- CHANNELX(1:KLGRCX) = ' '
- NCCHX = LENOCC(CHX)
- IF(NCCHX.GT.KLGRCX) THEN
- NCCHX=KLGRCX
- ENDIF
- CHANNELX(1:NCCHX) = CHX(1:NCCHX)
-C ----------------------------------------------------------------------
-C FIND CHANEL
-C ----------------------------------------------------------------------
- EXIST = .FALSE.
- LINEAR = .FALSE.
-C -- linear or binary search
- IF(JBIT(IQ(LCHX),BITPOS).EQ.0)THEN
- LINEAR = .TRUE.
- ENDIF
-C ----------------------------------------------------------------------
-C linear search
-C ----------------------------------------------------------------------
- IF(LINEAR)THEN
- IF(NCHX.GE.1)THEN
- IPOS=0
- 10 IPOS=IPOS+1
- IF(HLCCMP(IQ(LCHX+KBLAB+(IPOS-1)*4),
- $ CHANNELX,KLGRCX).EQ.0)THEN
- EXIST = .TRUE.
- ENDIF
- IF((IPOS.LT.NCHX).AND.(.NOT.EXIST)) GO TO 10
- ENDIF
- ELSE
-C ----------------------------------------------------------------------
-C binary search
-C ----------------------------------------------------------------------
- LEFT = 1
- RIGHT = NCHX
-C -- while
- 20 IF((LEFT.LE.RIGHT).AND.(.NOT.EXIST))THEN
- MEDIAN = ( LEFT + RIGHT ) /2
- CMP = HLCCMP(IQ(LCHX+KBLAB+(MEDIAN-1)*4),
- $ CHANNELX,KLGRCX)
- IF(CMP.LT.0)THEN
- LEFT = MEDIAN+1
- ELSE IF(CMP.EQ.0)THEN
- EXIST = .TRUE.
- IPOS = MEDIAN
- ELSE
- RIGHT = MEDIAN-1
- ENDIF
- GO TO 20
- ENDIF
- ENDIF
-C ----------------------------------------------------------------------
- IF(.NOT.EXIST)THEN
- IPOS = -1
- ENDIF
-C ----------------------------------------------------------------------
- END
-
-
diff --git a/src/packlib/hbook/code/hlshft.F b/src/packlib/hbook/code/hlshft.F
deleted file mode 100644
index 3ea2dbc..0000000
--- a/src/packlib/hbook/code/hlshft.F
+++ /dev/null
@@ -1,52 +0,0 @@
-*
-* $Id: hlshft.F,v 1.1.1.1 1996/01/16 17:07:42 mclareni Exp $
-*
-* $Log: hlshft.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:42 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.17/03 13/01/93 21.09.21 by Rene Brun
-*-- Author :
- SUBROUTINE HLSHFT(ARRAY,IINDEX,LEFT,RIGHT,LGRHOLL)
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-C PART OF HSORT
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
- INTEGER HLHCMP
-C
- INTEGER ARRAY(*),IINDEX(*),LEFT,RIGHT,LGRHOLL
-C
- INTEGER I,J
- INTEGER X(4),XX
-C
-C -- sort
- I = LEFT
- J = 2*LEFT
- CALL HLSWAP(X,ARRAY,1,LEFT)
-C -- index
- XX = IINDEX(LEFT)
-C
-C -- sort
- IF((J.LT.RIGHT).AND.
- $ (HLHCMP(ARRAY(4*(J-1)+1),ARRAY(4*J+1),LGRHOLL).LT.0))THEN
- J = J+1
- ENDIF
-C -- while
- 10 IF((J.LE.RIGHT).AND.(HLHCMP(X,ARRAY(4*(J-1)+1),LGRHOLL).LT.0))THEN
- CALL HLSWAP(ARRAY,ARRAY,I,J)
- IINDEX(I) = IINDEX(J)
- I = J
- J = 2*J
- IF((J.LT.RIGHT).AND.
- $ (HLHCMP(ARRAY(4*(J-1)+1),ARRAY(4*J+1),LGRHOLL).LT.0))THEN
- J = J+1
- ENDIF
- GO TO 10
- ENDIF
-C
- CALL HLSWAP(ARRAY,X,I,1)
- IINDEX(I) = XX
-C
- END
-C
diff --git a/src/packlib/hbook/code/hlsort.F b/src/packlib/hbook/code/hlsort.F
deleted file mode 100644
index a0630ce..0000000
--- a/src/packlib/hbook/code/hlsort.F
+++ /dev/null
@@ -1,63 +0,0 @@
-*
-* $Id: hlsort.F,v 1.1.1.1 1996/01/16 17:07:42 mclareni Exp $
-*
-* $Log: hlsort.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:42 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.17/03 13/01/93 21.09.21 by Rene Brun
-*-- Author : P.Aubert 18/11/92
- SUBROUTINE HLSORT(ARRAY,IINDEX,LGRARRAY,LGRHOLL)
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-C HLSORT : HEAP SORT
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-C ARRAY : ARRAY TO BE SORTED
-C IINDEX : ARRAY OF RESULT
-C LGRARRAY : NUMBER OF WORD ( LENGTH OF ARRAY = 4*LGRARRAY )
-C LGRHOLL : NUMBER OF CHARACTER IN EACH WORD
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-C EXEMPLE :
-C IN ARRAY = 8 6 4 2 1
-C OUTPUT ARRAY = 1 2 4 6 8 IINDEX = 5 4 3 2 1
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-C
- INTEGER ARRAY(*),IINDEX(*),LGRARRAY,LGRHOLL
-C
- INTEGER LEFT,RIGHT
- INTEGER X(4),XX
- INTEGER I
-C
- LEFT = ( LGRARRAY / 2 ) + 1
- RIGHT = LGRARRAY
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-C -- init index
- DO 1 I=1,LGRARRAY
- IINDEX(I)=I
- 1 CONTINUE
-C -- while
- 10 IF(LEFT.GT.1)THEN
- LEFT = LEFT-1
- CALL HLSHFT(ARRAY,IINDEX,LEFT,RIGHT,LGRHOLL)
- GO TO 10
- ENDIF
-C -- end while
-C -- while
- 20 IF(RIGHT.GT.1)THEN
-C -- swap ARRAY(1) and ARRAY(RIGHT)
- CALL HLSWAP(X,ARRAY,1,1)
- CALL HLSWAP(ARRAY,ARRAY,1,RIGHT)
- CALL HLSWAP(ARRAY,X,RIGHT,1)
-C -- index
- XX = IINDEX(1)
- IINDEX(1) = IINDEX(RIGHT)
- IINDEX(RIGHT)= XX
-C -- sort
- RIGHT = RIGHT-1
- CALL HLSHFT(ARRAY,IINDEX,LEFT,RIGHT,LGRHOLL)
- GO TO 20
- ENDIF
-C -- end while
-C
- END
diff --git a/src/packlib/hbook/code/hlsq.F b/src/packlib/hbook/code/hlsq.F
deleted file mode 100644
index 6d38e01..0000000
--- a/src/packlib/hbook/code/hlsq.F
+++ /dev/null
@@ -1,94 +0,0 @@
-*
-* $Id: hlsq.F,v 1.1.1.1 1996/01/16 17:07:42 mclareni Exp $
-*
-* $Log: hlsq.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:42 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.22/11 23/08/94 14.17.45 by Rene Brun
-*-- Author :
- SUBROUTINE HLSQ(N,M,A)
-*.==========>
-*. Auxiliary to HFITPO/HFITEX.
-* Extracted from CERN Program library routine LSQ
-*.
-*. Least squares lpolynomial fitting without weights
-*. (E.Keil. revised by B.Schorr, 23.10.1981.)
-*..=========> ( R.Brun from CERNLIB )
- REAL A(9),EXDA(4)
- SAVE ZERO,ONE,IDIM
-#if !defined(CERNLIB_DOUBLE)
- REAL ZERO, ONE, POWER, XK, YK, B(20,20)
- DATA ZERO, ONE / 0., 1. /
-#endif
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION ZERO, ONE, POWER, XK, YK, B(20,20)
- DOUBLE PRECISION DA(20)
- DATA ZERO, ONE / 0.D0, 1.D0 /
-#endif
- DATA IDIM / 20 /
- IF(M .GT. 2) GOTO 30
- CALL HLLSQ(N,A(1),A(2),IFAIL)
- GOTO 999
- 30 IF(M .GT. IDIM .OR. M .GT. N) GOTO 999
- B(1,1)=FLOAT(N)
-#if !defined(CERNLIB_DOUBLE)
- A(1)=ZERO
-#endif
-#if defined(CERNLIB_DOUBLE)
- DA(1)=ZERO
-#endif
- DO 1 L=2,M
- B(L,1)=ZERO
- B(M,L)=ZERO
-#if !defined(CERNLIB_DOUBLE)
- A(L)=ZERO
-#endif
-#if defined(CERNLIB_DOUBLE)
- DA(L)=ZERO
-#endif
- 1 CONTINUE
- DO 4 K=1,N
- CALL HFITH1(EXDA,K)
- XK=EXDA(3)
- YK=EXDA(1)
- POWER=ONE
-#if !defined(CERNLIB_DOUBLE)
- A(1)=A(1)+YK
-#endif
-#if defined(CERNLIB_DOUBLE)
- DA(1)=DA(1)+YK
-#endif
- DO 2 L=2,M
- POWER=POWER*XK
- B(L,1)=B(L,1)+POWER
-#if !defined(CERNLIB_DOUBLE)
- A(L)=A(L)+POWER*YK
-#endif
-#if defined(CERNLIB_DOUBLE)
- DA(L)=DA(L)+POWER*YK
-#endif
- 2 CONTINUE
- DO 3 L=2,M
- POWER=POWER*XK
- B(M,L)=B(M,L)+POWER
- 3 CONTINUE
- 4 CONTINUE
- DO 6 I=3,M
- DO 5 K=I,M
- B(K-1,I-1)=B(K,I-2)
- 5 CONTINUE
- 6 CONTINUE
-#if !defined(CERNLIB_DOUBLE)
- CALL HSEQNR(M,B,IDIM,IFAIL,1,A)
-#endif
-#if defined(CERNLIB_DOUBLE)
- CALL HSEQND(M,B,IDIM,IFAIL,1,DA)
- DO 9 I=1,M
- A(I)=DA(I)
- 9 CONTINUE
-#endif
- 999 RETURN
- END
diff --git a/src/packlib/hbook/code/hlswap.F b/src/packlib/hbook/code/hlswap.F
deleted file mode 100644
index 3c88001..0000000
--- a/src/packlib/hbook/code/hlswap.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: hlswap.F,v 1.1.1.1 1996/01/16 17:07:42 mclareni Exp $
-*
-* $Log: hlswap.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:42 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.17/01 18/11/92 18.21.19 by Rene Brun
-*-- Author :
- SUBROUTINE HLSWAP(A,B,I,J)
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-C PART OF HSORT
-C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
- INTEGER A(*),B(*),I,J,K
- DO 10 K=1,4
- A(4*(I-1)+K)=B(4*(J-1)+K)
- 10 CONTINUE
- END
-C
diff --git a/src/packlib/hbook/code/hmachi.F b/src/packlib/hbook/code/hmachi.F
deleted file mode 100644
index 9bf043d..0000000
--- a/src/packlib/hbook/code/hmachi.F
+++ /dev/null
@@ -1,291 +0,0 @@
-*
-* $Id: hmachi.F,v 1.6 2000/01/26 09:58:08 couet Exp $
-*
-* $Log: hmachi.F,v $
-* Revision 1.6 2000/01/26 09:58:08 couet
-* - To be Y2K compliant this routine has been changed to use the new DATIME.
-* The calling sequence used was CALL DATIME(ID,IT). This is the one used is
-* the manual. ID and IT are not used because after the call to DATIME, the
-* time and date are taken in a COMMON block. Unfortunately, the variable name
-* ID is used in the common block hcflag. So this variable was corrupted by
-* the call to DATIME.
-*
-* Revision 1.5 1998/11/10 09:18:54 couet
-* - mods for Y2K
-*
-* Revision 1.3 1998/11/09 14:16:51 couet
-* - update version number
-*
-* Revision 1.2 1998/09/25 09:27:01 mclareni
-* Modifications for the Mklinux port flagged by CERNLIB_PPC
-*
-* Revision 1.1.1.1 1996/01/16 17:07:43 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.21/05 29/11/93 09.45.20 by Rene Brun
-*-- Author :
- SUBROUTINE HMACHI
-*.==========>
-*. INITIALISATION SUBROUTINE
-*. ROUTINE called by HLIMIT at the start of HBOOK
-*. DEFINE CONTANTS FOR ONE MACHINE
-*.
-*. ****************************************************************
-*.
-*. DESCRIPTION OF VARIABLES IN COMMONS
-*.
-*. A, COMMON/HCFLAG/
-*.
-*. ID CURRENT IDENTIFIER
-*. IDLAST LAST IDENTIFIER FILLED
-*. IDHOLD LAST ID ACCESSED BY HI,HIJ,ETC.
-*. LID LAST IDENTIFIER SEARCHED IN ADDRESS TABLE
-*. IDBADD ADDRESS OF ID IN ADDRESS TABLE (LIBRARY)
-*. NBIT NUMBER OF BITS IN A MACHINE WORD
-*. NBITCH NUMBER OF BITS PER CHARACTER
-*. NCHAR NUMBER OF CHARACTERS IN A MACHINE WORD
-*. IERR 0,1 NO ERROR,ERROR AFTER ANY MEMORY ACTION
-*. NV 1 FOR HTABLE 2 FOR HBOOK2
-*. LCID FIRST LOCATION OF HIST ID IN /PAWC/
-*.
-*.
-*. B, COMMON/HCPRIN/
-*.
-*. IFW POINTER TO NUMBER OF ENTRIES FOR CURRENT ID
-*. NW NUMBER OF WORDS FOR SUM OF WEIGHTS
-*. NB NUMBER OF BITS PER CHANNEL
-*. IH CURRENT NUMBER OF HISTOGRAM PRINTED
-*. NHT NUMBER OF PIECES IN WHICH ID IS SPLITTED
-*. ICN NUMBER OF CHANNELS
-*. NH NUMBER OF HISTOGRAMS PRINTED
-*. MSTEP NUMBER OF PRINTER COLUMNS (HBIGBI)
-*. NOENT SEVERAL MEANINGS
-*. NOLD USED TO PRINT TITLE
-*. IDOLAR 1H$ INTEGER VALUE
-*. IBLANC 1H
-*. KBINSZ =1 IF BIN ADJUSTEMENT REQUIRED AT BOOKING
-*. KSQUEZ =1 IF NO PAGE EJECT AT PRINTING
-*. NCOLMA MAXIMUM NUMBER OF COLUMNS FOR PRINTING
-*. NCOLPA NUMBER OF COLUMNS IN ONE PAGE
-*. NLINPA NUMBER OF LINES IN ONE PAGE
-*. MAX POWERS OF 2
-*. INO 2HNO
-*. BIGP VERY BIG NUMBER
-*.
-*.
-*. C, COMMON/HCBITS/
-*.
-*. I1 HBOOK1
-*. I2 HBOOK2
-*. I3 HTABLE
-*. I4 NTUPLE
-*. I5 AUTOMATIC BINNING
-*. I6 VARIABLE BIN SIZE HISTOGRAM
-*. I7 HBSTAT
-*. I8 PROFILE HISTOGRAM
-*. I9 HBARX
-*. I10 HBARY
-*. I11 HERROR
-*. I12 HFUNC
-*. I13 HROTAT
-*. I14 HPRFUN
-*. I15 HPRLOW
-*. I16 HPRHIS
-*. I17 HBIGBI
-*. I18 HNORMA
-*. I19 HSCALE
-*. I20 HMAXIM
-*. I21 HMINIM
-*. I22 HINTEG
-*. I23 H2PAGE
-*. I24 H1EVLI
-*. I25 HPRSTA
-*. I26 HLOGAR
-*. I27 HBLACK
-*. I28 HSTAR
-*. I29 HPRCHA
-*. I30 HPRCON
-*. I31 HPRERR
-*.
-*. I32,I33,I35 NOT YET USED
-*. I34 USED NOT AS A BIT BUT A FLAG AT PRINTING
-*. I230=I2+I3
-*. I123=I1+I230
-*.
-*.
-*. D, COMMON/HCUNIT/
-*.
-*. LOUT LOGICAL UNIT FOR PRINTING OUTPUT
-*. LERR LOGICAL UNIT FOR ERROR MESSAGES
-*. LINFIT LOGICAL UNIT FOR MINUIT INPUT
-*.
-*.
-*. E, COMMON/HCNT/
-*.
-*. IBIPW Bits per word (=MBIT)
-*. IBIPB Bits per byte (=MBITCH)
-*. IBYPW Bytes per word (=NCHAR)
-*. ISHBIT Bits to shift to devide by IBIPW (shifting is faster
-*. than dividing)
-*.
-*. F, COMMON/HCOPT/
-*. ISTAF to fill statistics at filling time
-* ICOPT not used
-*.
-*..=========> ( R.Brun )
-#include "hbook/hcflag.inc"
-#include "hbook/hcbits.inc"
-#include "hbook/hcbook.inc"
-#include "hbook/hcpar0.inc"
-#include "hbook/hcprin.inc"
-#include "hbook/hcunit.inc"
-#include "hbook/hcfitr.inc"
-#include "hbook/hcvers.inc"
-#include "hbook/hcnt.inc"
-#include "hbook/hcset.inc"
-#include "hbook/hcrecv.inc"
-#include "hbook/hmachine.inc"
-#include "hbook/hcminpu.inc"
-#include "hbook/hcpiaf.inc"
-#include "hbook/czcbuf.inc"
-#include "hbook/hcopt.inc"
- COMMON /SLATE/ ISL(40)
- CHARACTER*1 IDGTDA(42)
- CHARACTER*4 IPROJ(9)
- SAVE IDGTDA,IPROJ
- DATA IDGTDA/'0','1','2','3','4','5','6','7','8','9',
- + 'A','B','C','D','E','F','G','H','I','J',
- + 'K','L','M','N','O','P','Q','R','S','T',
- + 'U','V','W','X','Y','Z','*','.','-','+',
- + ' ','/'/
-*
- DATA IPROJ/'HIST','HIST','PROX','PROY','SLIX',
- + 'SLIY','BANX','BANY','FUNC'/
-*.___________________________________________
-*
-* Get date of day
-*
- CALL DATIMH(IVERS,INSTAL)
- CALL UBLOW(IVERS,IDATE,8)
- CALL DATIME(IIDATE,IITIME)
- IYEAR = ISL(1)
- IMONTH = ISL(2)
- IDAY = ISL(3)
- CHDATE = ' '
- WRITE (CHDATE(1:2),'(I2.2)') IDAY
- CHDATE(3:3) = '/'
- WRITE (CHDATE(4:5),'(I2.2)') IMONTH
- CHDATE(6:6) = '/'
- WRITE (CHDATE(7:10),'(I4.4)') IYEAR
-*
-* Set version number
-*
- HVERSN = 4.25
- CALL UCTOH('4.25 ',IVERS,1,5)
-#if defined(CERNLIB_NEWLIB)
- CALL UCTOH1 ( 'IBM DESY ', INSTAL, 14 )
-#else
- CALL UCTOH('HBOOK CERN ',INSTAL,1,20)
-#endif
-*
- IZCBUF = 0
- CONNPF = .FALSE.
- SERVPF = .FALSE.
-*
- NCMINP = 0
- IADINP = 0
- NBIT = MBIT
- NBITCH = MBITCH
- LINFIT = 5
- LOUT = MOUT
- BIGP = HMBIGP
- LERR = LOUT
- NHT = 1
- MSTEP = 1
- NOLD = 4
- NCHAR = NBIT/NBITCH
- NCOLPA = 128
- NCOLMA = 100
-#if defined(CERNLIB_NEWLIB)
- NLINPA = 85
-#else
- NLINPA = 61
-#endif
- IDHOLD = 0
- IDLAST = 0
- NV = 2
- KBINSZ = 0
- KSQUEZ = 0
- LID = 0
- NRHIST = 0
- IERR = 0
- IH = 0
- NH = 0
- IPONCE = 0
- PNEF = 0.
- PNBF = 0.
- PSEL = -1.
- PFLV = -1.
- PLUN = -1.
- PNBX = -1.
- PNCX = -1.
- FNIX = -1.
- FEPS = -1.
- IFTRNG = 0
- IFXLOW = 1
- IFXUP = 99999
- IFYLOW = 1
- IFYUP = 99999
- ISTAF = 0
- CALL VZERO(ICOPT,9)
-*
- CALL VZERO(I1,37)
- K = (NBIT+1)/2
- MAXBIT(1) = 2
- DO 10 I=2,K
- MAXBIT(I) = MAXBIT(I-1)*2
- MAXBIT(I-1) = MAXBIT(I-1)-1
- 10 CONTINUE
- MAXBIT(K) = MAXBIT(K)-1
- CALL VBLANK(IDG,42)
- CALL UCTOH(IDGTDA,IDG,1,42)
- ICSTAR = IDG(37)
- ICBLAC = IDG(34)
- ICFUNC = IDG(37)
- CALL UCTOH(IPROJ,IDENT,4,36)
- CALL UCTOH('NO ',INO,4,4)
-*
-#if defined(CERNLIB_VAX)||defined(CERNLIB_DECS)||defined(CERNLIB_MSDOS)||(defined(CERNLIB_LINUX) && !defined(CERNLIB_PPC))||defined(CERNLIB_WINNT)
- L2 = 1
-#else
- L2 = NBIT-NBITCH+1
-#endif
- CALL UCTOH('$ ',IDOL,4,4)
- IDOLAR = JBYT(IDOL,L2,NBITCH)
- IBLANC = JBYT(IDG(41),L2,NBITCH)
-*
-*-- set Ntuple recover flag off
-*
- NRECOV = .FALSE.
-*
-*-- buffer size of new N-tuple
-*-- Should be set to Record_length - 15 words for ZEBRA headers
-*
- IBSIZE = 1009
-*
-*-- no. of bits/word, bits/byte, byte/word and no. of bits to shift to
-*-- divide by bits/word (used by new n-tuples)
-*
- IBIPW = MBIT
- IBIPB = MBITCH
- IBYPW = NCHAR
- ISHBIT = 0
- DO 20 I = 1, 10
- IF (2**I .EQ. IBIPW) THEN
- ISHBIT = I
- ENDIF
- 20 CONTINUE
-*
- END
diff --git a/src/packlib/hbook/code/hmax.F b/src/packlib/hbook/code/hmax.F
deleted file mode 100644
index e9faeae..0000000
--- a/src/packlib/hbook/code/hmax.F
+++ /dev/null
@@ -1,39 +0,0 @@
-*
-* $Id: hmax.F,v 1.1.1.1 1996/01/16 17:07:43 mclareni Exp $
-*
-* $Log: hmax.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:43 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.23/01 20/02/95 09.48.16 by Julian Bunn
-*-- Author :
- FUNCTION HMAX(IDD)
-*.==========>
-*. RETURN MAXIMUM VALUE OF A BIN OR CELL
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
-#include "hbook/hcprin.inc"
-*.___________________________________________
- XMAX=-BIGP
- CALL HFIND(IDD,'HMAX ')
- IF(LCID.EQ.0)GO TO 99
- NCX=IQ(LCID+KNCX)
- IF(JBIT(IQ(LCID+KBITS),1).NE.0)THEN
- DO 10 I=1,NCX
- X=HCX(I,1)
- XMAX=AMAX1(XMAX,X)
- 10 CONTINUE
- ELSE
- NCY=IQ(LCID+KNCY)
- DO 30 I=1,NCX
- DO 20 J=1,NCY
- X=HCXY(I,J,1)
- XMAX=AMAX1(X,XMAX)
- 20 CONTINUE
- 30 CONTINUE
- ENDIF
-*
- 99 HMAX=XMAX
- END
diff --git a/src/packlib/hbook/code/hmaxim.F b/src/packlib/hbook/code/hmaxim.F
deleted file mode 100644
index 3fddf15..0000000
--- a/src/packlib/hbook/code/hmaxim.F
+++ /dev/null
@@ -1,56 +0,0 @@
-*
-* $Id: hmaxim.F,v 1.1.1.1 1996/01/16 17:07:43 mclareni Exp $
-*
-* $Log: hmaxim.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:43 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 16/05/95 10.12.49 by O.Couet
-*-- Author :
- SUBROUTINE HMAXIM(ID2,AMAX)
-*.==========>
-*. Set maximum scale of the histogram ID2. When a
-*. maximum is fixed in the histogram data structure
-*. the flag I20 is set.
-*..=========> ( R.Brun )
-#include "hbook/hcbits.inc"
-#include "hbook/hcbook.inc"
-*.___________________________________________
-*
- IRET=3
-*
- 10 CALL HLOOP(ID2,'HMAXIM',IRET)
- IF(IRET.EQ.0)GOTO 999
-*
- CALL HDCOFL
-*
-* 1D histograms
-*
- IF(I1.NE.0)THEN
- Q(LCID+KMAX1)=FLOARG(AMAX)
- IF(I21.NE.0.AND.Q(LCID+KMAX1).LE.Q(LCID+KMIN1))THEN
- CALL HSIFLA(20,0)
- CALL HSIFLA(21,0)
- ELSE
- CALL HSIFLA(20,1)
- ENDIF
- ENDIF
-*
-* 2D histograms
-*
- IF(I230.NE.0)THEN
- Q(LCID+KMAX2)=FLOARG(AMAX)
- IF(I21.NE.0.AND.Q(LCID+KMAX2).LE.Q(LCID+KMIN2))THEN
- CALL HSIFLA(20,0)
- CALL HSIFLA(21,0)
- ELSE
- CALL HSIFLA(20,1)
- ENDIF
- ENDIF
-*
- IRET=2
- GOTO 10
-*
- 999 END
diff --git a/src/packlib/hbook/code/hmconv.F b/src/packlib/hbook/code/hmconv.F
deleted file mode 100644
index 917bbe2..0000000
--- a/src/packlib/hbook/code/hmconv.F
+++ /dev/null
@@ -1,93 +0,0 @@
-*
-* $Id: hmconv.F,v 1.1.1.1 1996/01/16 17:07:43 mclareni Exp $
-*
-* $Log: hmconv.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:43 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.10/05 05/03/89 09.22.02 by Rene Brun
-*-- Author :
- SUBROUTINE HMCONV (N,Z,PL,R)
-*.==========>
-*. INVERTS THE POSITIVE DEFINITE PACKED SYMMETRIC MATRIX Z
-*. BY THE SQUARE-ROOT METHOD
-*..=========> ( D.Lienart )
- DIMENSION Z(1),PL(1),R(1)
-#include "hbook/hcfit2.inc"
-#include "hbook/hcprin.inc"
-*
-* MAXIMUM REAL NUMBER AND 10.*MAXIMUM RELATIVE
-* PRECISION
-*
- EQUIVALENCE (AM,BIGP)
- SAVE RP
- DATA RP/1.E-14/
-*.___________________________________________
- IF (N.LT.1) RETURN
- APS=SQRT(AM/FLOAT(N))
- AP=1./(APS*APS)
- IR=0
- DO 11 I=1,N
- 1 IR=IR+1
- IF (PL(IR).LE.0.)GO TO 1
- NI=I*(I-1)/2
- II=NI+I
- K=N+1
- IF (Z(II).LE.RP*ABS(R(IR)).OR.Z(II).LE.AP) GO TO 19
- Z(II)=1./SQRT(Z(II))
- NL=II-1
- 3 IF (NL-NI.LE.0)GO TO 5
- Z(NL)=Z(NL)*Z(II)
- IF (ABS(Z(NL)).GE.APS) GO TO 16
- NL=NL-1
- GO TO 3
- 5 IF (I-N.GE.0)GO TO 12
- 6 K=K-1
- NK=K*(K-1)/2
- NL=NK
- KK=NK+I
- D=Z(KK)*Z(II)
- C=D*Z(II)
- L=K
- 7 LL=NK+L
- LI=NL+I
- Z(LL)=Z(LL)-Z(LI)*C
- L=L-1
- NL=NL-L
- IF (L-I) 9,9,7
- 8 LL=NK+L
- LI=NI+L
- Z(LL)=Z(LL)-Z(LI)*D
- 9 L=L-1
- IF (L.GT.0)GO TO 8
- Z(KK)=-C
- IF (K-I-1.GT.0)GO TO 6
- 11 CONTINUE
-*
- 12 DO 14 I=1,N
- DO 14 K=I,N
- NL=K*(K-1)/2
- D=0.
- DO 13 L=K,N
- LI=NL+I
- LK=NL+K
- D=D+Z(LI)*Z(LK)
- NL=NL+L
- 13 CONTINUE
- KI=K*(K-1)/2+I
- Z(KI)=D
- 14 CONTINUE
- 15 RETURN
- 16 K=I+NL-II
- IR=0
- DO 18 I=1,K
- 17 IR=IR+1
- IF (PL(IR).LE.0.)GO TO 17
- 18 CONTINUE
- 19 PL(IR)=-2.
- R(IR)=0.
- INDFLG(1)=IR
- GO TO 15
- END
diff --git a/src/packlib/hbook/code/hmdir.F b/src/packlib/hbook/code/hmdir.F
deleted file mode 100644
index 9d624e7..0000000
--- a/src/packlib/hbook/code/hmdir.F
+++ /dev/null
@@ -1,115 +0,0 @@
-*
-* $Id: hmdir.F,v 1.1.1.1 1996/01/16 17:07:43 mclareni Exp $
-*
-* $Log: hmdir.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:43 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 16/05/95 18.30.41 by Julian Bunn
-*-- Author :
- SUBROUTINE HMDIR(CHDIR,CHOPT)
-*.==========>
-*. Create a sub-directory of the current directory
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
-#include "hbook/hcform.inc"
-#include "hbook/hcdire.inc"
- CHARACTER*(*) CHDIR,CHOPT
- CHARACTER*64 CHWOLD
- CHARACTER*16 CHD
- CHARACTER*16 CTHIS
- CHARACTER*8 TAGS(2)
-*.___________________________________________
-*
-* Check if directory to be created is in the CWD
-* If not, save CWD and go to the parent directory
-*
- ICWD=0
- NCH=LENOCC(CHDIR)
- IF(NCH.GT.2)THEN
- IF(CHDIR(1:2).EQ.'//')THEN
- CALL HCDIR(CHWOLD,'R')
- DO 5 I=NCH,3,-1
- IF(CHDIR(I:I).EQ.'/')THEN
- CHD=CHDIR(I+1:)
- CALL HCDIR(CHDIR(1:I-1),' ')
- ICWD=1
- GO TO 7
- ENDIF
- 5 CONTINUE
- ENDIF
- ENDIF
-*
- IF(NCH.LE.16)THEN
- CHD=CHDIR
- ELSE
- CHD=CHDIR(1:16)
- ENDIF
-* Current directory refers to a RZ file.
-*
- 7 IF(ICHTOP(ICDIR).GT.0)THEN
- TAGS(1) = 'HBOOK-ID'
- TAGS(2) = 'VARIABLE'
- NWK=ICHTYP(ICDIR)
- CALL RZMDIR(CHD,NWK,'II',TAGS)
- GO TO 90
- ENDIF
-*
-* Cannot create directory in a GLOBAL section
-*
- IF(ICHTOP(ICDIR).LT.0)THEN
- CALL HBUG('Cannot create a directory in a global section',
- + 'HMDIR',0)
- GO TO 99
- ENDIF
-*
-* Directory is in //PAWC
-*
-* Search last Sub-directory or create first one
-*
- IF(LQ(LCDIR-1).EQ.0)THEN
- CALL MZBOOK(IHDIV,LR1,LCDIR,-1,'HDIR',10,8,10,IODIR,0)
- ELSE
- LF=LQ(LCDIR-1)
-C
-C Check whether this existing directory matches the user's
-C and do not create a new bank if so
-C
- 10 CALL UHTOC(IQ(LF+1),4,CTHIS,16)
- IF(CTHIS.EQ.CHD(:16)) THEN
- CALL HBUG('+Directory '//CTHIS//' already exists',
- & 'HMDIR',0)
- GOTO 90
- ENDIF
-C
-C No match, get the next directory bank in the list
-C
- LR2=LQ(LF)
- IF(LR2.NE.0)THEN
- LF=LR2
- GO TO 10
- ENDIF
-C
-C We are at the end of the bank list, so we can put the new dir here
-C
- LR2=LF
- CALL MZBOOK(IHDIV,LR1,LR2, 0,'HDIR',10,8,10,IODIR,0)
- ENDIF
- CALL VBLANK(IQ(LR1+1),4)
- IF(NCH.GT.16)NCH=16
- CALL UCTOH(CHD,IQ(LR1+1),4,NCH)
- CALL MZBOOK(IHDIV,LR2 ,LR1,-3,'HTAB',50,0,50,2,0)
-*
-C
-C If Option 'S' is given, the set the current directory one down
-C
- 90 IF(CHOPT.EQ.'S')THEN
- CALL HCDIR(CHD,' ')
- ELSE
- IF(ICWD.NE.0)CALL HCDIR(CHWOLD,' ')
- ENDIF
-*
- 99 RETURN
- END
diff --git a/src/packlib/hbook/code/hmedia.F b/src/packlib/hbook/code/hmedia.F
deleted file mode 100644
index 546fc75..0000000
--- a/src/packlib/hbook/code/hmedia.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: hmedia.F,v 1.1.1.1 1996/01/16 17:07:43 mclareni Exp $
-*
-* $Log: hmedia.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:43 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.10/05 21/02/89 16.14.50 by Rene Brun
-*-- Author :
- FUNCTION HMEDIA(X,N)
-*.==========>
-*. RETURN THE MEDIAN ELEMENT OF THE N ELEMENTS OF ARRAY X
-*. EG. X= 25,1,18,7,3 THEN HMEDIA=7
-*..=========> ( R.Brun )
- DIMENSION X(1)
-*.___________________________________________
- IN=3
- IMAX=LVMAX(X,N)
- XM=X(IMAX)
- 10 IMIN=LVMIN(X,N)
- X(IMIN)=XM
- IN=IN+1
- IF(IN.LT.N)GO TO 10
- IMIN=LVMIN(X,N)
- HMEDIA=X(IMIN)
- END
diff --git a/src/packlib/hbook/code/hmin.F b/src/packlib/hbook/code/hmin.F
deleted file mode 100644
index 314ad00..0000000
--- a/src/packlib/hbook/code/hmin.F
+++ /dev/null
@@ -1,39 +0,0 @@
-*
-* $Id: hmin.F,v 1.1.1.1 1996/01/16 17:07:43 mclareni Exp $
-*
-* $Log: hmin.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:43 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.23/01 20/02/95 09.48.40 by Julian Bunn
-*-- Author :
- FUNCTION HMIN(IDD)
-*.==========>
-*. RETURN MINIMUM VALUE OF A BIN OR CELL
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
-#include "hbook/hcprin.inc"
-*.___________________________________________
- XMIN=BIGP
- CALL HFIND(IDD,'HMIN ')
- IF(LCID.EQ.0)GO TO 99
-*
- NCX=IQ(LCID+KNCX)
- IF(JBIT(IQ(LCID+KBITS),1).NE.0)THEN
- DO 10 I=1,NCX
- X=HCX(I,1)
- 10 XMIN=MIN(XMIN,X)
- ELSE
- NCY=IQ(LCID+KNCY)
- DO 30 I=1,NCX
- DO 20 J=1,NCY
- X=HCXY(I,J,1)
- XMIN=MIN(XMIN,X)
- 20 CONTINUE
- 30 CONTINUE
- ENDIF
-*
- 99 HMIN=XMIN
- END
diff --git a/src/packlib/hbook/code/hminim.F b/src/packlib/hbook/code/hminim.F
deleted file mode 100644
index 2333d78..0000000
--- a/src/packlib/hbook/code/hminim.F
+++ /dev/null
@@ -1,56 +0,0 @@
-*
-* $Id: hminim.F,v 1.1.1.1 1996/01/16 17:07:43 mclareni Exp $
-*
-* $Log: hminim.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:43 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 16/05/95 10.12.49 by O.Couet
-*-- Author :
- SUBROUTINE HMINIM(ID2,AMIN)
-*.==========>
-*. Set minimum value of the histogram ID2. When a
-*. minimum is fixed in the histogram data structure
-*. the flag I21 is set.
-*..=========> ( R.Brun )
-#include "hbook/hcbits.inc"
-#include "hbook/hcbook.inc"
-*.___________________________________________
-*
- IRET=3
-*
- 10 CALL HLOOP(ID2,'HMINIM',IRET)
- IF(IRET.EQ.0)GOTO 999
-*
- CALL HDCOFL
-*
-* 1D histograms
-*
- IF(I1.NE.0)THEN
- Q(LCID+KMIN1)=FLOARG(AMIN)
- IF(I20.NE.0.AND.Q(LCID+KMAX1).LE.Q(LCID+KMIN1))THEN
- CALL HSIFLA(20,0)
- CALL HSIFLA(21,0)
- ELSE
- CALL HSIFLA(21,1)
- ENDIF
- ENDIF
-*
-* 2D histograms
-*
- IF(I230.NE.0)THEN
- Q(LCID+KMIN2)=FLOARG(AMIN)
- IF(I20.NE.0.AND.Q(LCID+KMAX2).LE.Q(LCID+KMIN2))THEN
- CALL HSIFLA(20,0)
- CALL HSIFLA(21,0)
- ELSE
- CALL HSIFLA(21,1)
- ENDIF
- ENDIF
-*
- IRET=2
- GOTO 10
-*
- 999 END
diff --git a/src/packlib/hbook/code/hminui.F b/src/packlib/hbook/code/hminui.F
deleted file mode 100644
index 7f04cd0..0000000
--- a/src/packlib/hbook/code/hminui.F
+++ /dev/null
@@ -1,211 +0,0 @@
-*
-* $Id: hminui.F,v 1.1.1.1 1996/01/16 17:07:43 mclareni Exp $
-*
-* $Log: hminui.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:43 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.22/11 24/08/94 09.02.15 by Rene Brun
-*-- Author :
- SUBROUTINE HMINUI (UFCN,PARAM,ALIM,BLIM,WERR,EMAT,IVARB)
-*.==========>
-*. TOP ROUTINE FOR HFITXX
-*..=========> ( E.Lessner,D.Lienart )
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION PARAM,ALIM,BLIM,WERR,FCNMH,ARGLIS,AMIN,
- + EDM,ERRDEF,RHOTOL,EMAT,UFCN,EPSIH
-#endif
-#include "hbook/hcflag.inc"
-#include "hbook/hcunit.inc"
-#include "hbook/hcpar0.inc"
-#include "hbook/hcfit2.inc"
-#include "hbook/hcfit6.inc"
-#include "hbook/hcfits.inc"
-#include "hbook/hcrlf.inc"
-*
- DIMENSION PARAM(NUP),ALIM(NUP),BLIM(NUP),WERR(NUP),ARGLIS(3),
- + EMAT(NUP,NUP),IVARB(NUP)
- EXTERNAL UFCN,HFCN
- SAVE LTOLD
- DATA LTOLD/0/
- DATA NAMPO,NAMGA /2HPO,2HGA/
-*_________________________________________________
-*
-* Initializes Interface HBOOK4-MINUIT
-*
- IF(LTOLD.NE.LOUT)THEN
- LTOLD=LOUT
- CALL MNINIT(IRD,LOUT,ISAV)
- ELSE
- CALL MNCLER
- ENDIF
-*
-* Calculate iofset
-*
- IOFSET=LOCF(PARAM(1))-LOCF(XVAR(1))
-*
-* Set initial step sizes for parameters
-*
- IF (NAMFUN.NE.NAMPO) THEN
- STMIN=0.1
- IF (IHIS.EQ.1) STMIN=BINWID
- PLEPS=1.E-6
- DO 9 I=1,NUP
- IF (WERR(I).EQ.0..AND.ILICO.LT.2) GOTO 9
- IF (WERR(I).LT.0.) WERR(I)=0.3*ABS(PARAM(I))
- IF (WERR(I).LE.PLEPS*ABS(PARAM(I))) WERR(I)=STMIN
- 9 CONTINUE
- IF (NAMFUN.EQ.NAMGA) THEN
- WERR(2)=0.3*ABS(PARAM(2))+BINWID*5.
- WERR(3)=0.3*ABS(PARAM(3))+BINWID*5.
- END IF
- END IF
-*
- NITMAX=200
- EPSIH=10.-9.*IMINU
- IF (FNIX.GT.0..AND.FNIX.LT.1000.) NITMAX=FNIX
- IF (FEPS.GT.0..AND.FEPS.LE.1000.) EPSIH=FEPS*10.
- NFCNMH=NITMAX+100*NUP+10*NUP**2
- RHOTOL=1.E-4*EPSIH
- IF (ITPR.GE.0) THEN
- WRITE (LOUT,470)CRLF, NAMFUN
- WRITE (LOUT,480)
- IF (IHIS.EQ.1) WRITE (LOUT,485) ID
- WRITE (LOUT,490) RHOTOL
- END IF
-*
-* INITIALIZATIONS
-*
- IF (ITPR.LT.1) THEN
- ARGLIS(1)=-1.
- NARG=1
- CALL MNEXCM(HFCN,'SET PRINT',ARGLIS,NARG,IERFL,UFCN)
- ARGLIS(1)=0.
- NARG=0
- CALL MNEXCM(HFCN,'SET NOW',ARGLIS,NARG,IERFL,UFCN)
- ENDIF
-*
- IF(FITNAM(1).EQ.' ')THEN
- DO 5 I=1,NUP
- IF(I.LT.10)THEN
- WRITE(FITNAM(I),1000)I
- ELSE
- WRITE(FITNAM(I),2000)I
- ENDIF
- 5 CONTINUE
- ENDIF
-*
- DO 10 I=1,NUP
- CALL MNPARM(I,FITNAM(I),PARAM(I),WERR(I),ALIM(I),BLIM(I),
- + IERFLP)
- IF (IERFLP.GT.0) THEN
- WRITE (LERR,*) ' REQUEST FOR PARAMETERS FAILED.'
- WRITE (LERR,*) ' CHECK INPUT PARAMETERS.'
- ICSTAT=0
- RETURN
- ENDIF
- 10 CONTINUE
-*
-* SET GRADIENT, IF IDER=1 (FORCING DERIVATIVES) OR IDER=2 (NOT FORCING)
-*
- IF (IDER.NE.0) THEN
- IF (IDER.EQ.1) THEN
- ARGLIS(1)=1.
- ELSEIF (IDER.EQ.2) THEN
- ARGLIS(1)=0.
- ENDIF
- NARG=1
- CALL MNEXCM(HFCN,'SET GRAD',ARGLIS,NARG,IERFLG,UFCN)
- ENDIF
-*
-* RESET PRINT LEVEL
-*
- IF (ITPR.GT.0) THEN
- IF (ITPR.EQ.1) THEN
- ARGLIS(1)=0.
- ELSEIF (ITPR.EQ.2) THEN
- ARGLIS(1)=1.
- ELSE
- ARGLIS(1)=2.
- ENDIF
- NARG=1
- CALL MNEXCM(HFCN,'SET PRINT',ARGLIS,NARG,IERFL,UFCN)
- ENDIF
-*
-* PERFORM MINIMIZATION
-*
- FCNMH=FLOAT(NFCNMH)
- ARGLIS(1)=FCNMH
- ARGLIS(2)=EPSIH
- NARG=2
- CALL MNEXCM(HFCN,'MIGRAD',ARGLIS,NARG,IERFLM,UFCN)
-*
-* GET STATUS AT RETURN TIME
-*
- DO 20 I=1,NUP
- CALL MNPOUT(I,FITNAM(I),PARAM(I),WERR(I),ALIM(I),BLIM(I),
- + IVARB(I))
- 20 CONTINUE
- CALL MNSTAT(AMIN,EDM,ERRDEF,NUP,NPARX,ICSTAT)
- CHIM=AMIN
-*
-* PRINT FINAL VALUES OF PARAMETERS, IF ITPR=0.
-*
- IF (ITPR.EQ.0) THEN
- CALL MNPRIN(3,AMIN)
- ENDIF
-*
-* COMPUTE COVARIANCE MATRIX IF REQUIRED
-*
- IF (IMAT.EQ.0) GOTO 98
- IF (ICSTAT.EQ.0) THEN
- IF (ITPR.GE.0)
- + WRITE (LOUT,*) ' COVARIANCE MATRIX NOT CALCULATED.'
- ELSEIF (ICSTAT.GT.0) THEN
- IF (ITPR.NE.0) THEN
- ARGLIS(1)=-1.
- ELSE
- ARGLIS(1)=1.
- ENDIF
- NARG=1
- CALL MNEXCM(HFCN,'SET PRINT',ARGLIS,NARG,IERFL,UFCN)
- CALL MNEMAT(EMAT,NUP)
- ENDIF
-*
- IF (ITPR.EQ.0.OR.ITPR.EQ.1) CALL MNMATU(0)
- 98 IF (NPFIT-NUP.GT.0) THEN
- CHISQ=AMIN/(NPFIT-NUP)
- ELSE
- CHISQ=9999.
- ENDIF
- IF (ITPR.GE.0) THEN
- WRITE (LOUT,500)CHISQ,NPFIT
- ENDIF
-*
-* Copy results in /HCFITS/
-*
- FITCHI=CHISQ
- NPFITS=NPFIT
- NFPAR =NUP
- DO 40 I=1,NUP
- FITPAR(I)=PARAM(I)
- FITSIG(I)=WERR(I)
- 40 CONTINUE
-*
- 470 FORMAT (A,
- +/' **********************************************',
- +/' * *',
- +/' * FUNCTION MINIMIZATION BY SUBROUTINE HFIT',A2,' *')
- 480 FORMAT (' * VARIABLE-METRIC METHOD *')
- 485 FORMAT (' * ID = ',I10,' *')
- 490 FORMAT (' * *',
- +/' **********************************************',/
- +' CONVERGENCE WHEN ESTIMATED DISTANCE TO MINIMUM',
- +' (EDM) .LT. ',E9.2)
- 500 FORMAT (/,' CHISQUARE =',E11.4,' NPFIT =',I6,/)
- 1000 FORMAT('P',I1,6X)
- 2000 FORMAT('P',I2,5X)
-*
- END
diff --git a/src/packlib/hbook/code/hminut.F b/src/packlib/hbook/code/hminut.F
deleted file mode 100644
index 8c6eae7..0000000
--- a/src/packlib/hbook/code/hminut.F
+++ /dev/null
@@ -1,253 +0,0 @@
-*
-* $Id: hminut.F,v 1.1.1.1 1996/01/16 17:07:43 mclareni Exp $
-*
-* $Log: hminut.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:43 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.23/01 15/11/94 12.19.06 by Rene Brun
-*-- Author :
- SUBROUTINE HMINUT (FCN,UFCN,PARAM,WERR,ALIM,BLIM,CHOPT)
-*.==========>
-*. TOP ROUTINE FOR HFITXX
-*..=========> ( R.Brun, E.Lessner)
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION PAR,AL,BL,WE,FCNMH,ARGLIS,AMIN,
- + EDM,ERRDEF,EPSIH,EPLUS,EMINUS,EPARAB,GLOBCC
-#endif
- DIMENSION PARAM(*),ALIM(*),BLIM(*),WERR(*),ARGLIS(3)
-#include "hbook/hcflag.inc"
-#include "hbook/hcunit.inc"
-#include "hbook/hcfit2.inc"
-#include "hbook/hcfit6.inc"
-#include "hbook/hcfits.inc"
-#include "hbook/hcpar0.inc"
-#include "hbook/hcprin.inc"
-#include "hbook/hcfitd.inc"
-#include "hbook/hcminpu.inc"
-#include "hbook/hchoptm.inc"
-*
- CHARACTER*(*) CHOPT
- CHARACTER*10 CHOPTT
- EXTERNAL UFCN,FCN
- SAVE LTOLD
- DATA LTOLD/0/
-*_________________________________________________
-*
-* Initializes Interface HBOOK4-MINUIT
-*
- CHOPTM=CHOPT
- IFLFUN=INDEX(CHOPT,'U')
- IOPTE=INDEX(CHOPT,'E')
- IOPTZ=INDEX(CHOPT,'Z')
- IF(LTOLD.NE.LOUT)THEN
- LTOLD=LOUT
- IRD=5
- ISAV=7
- CALL MNINIT(IRD,LOUT,ISAV)
-* ARGLIS(1)=0.0000002
- ARGLIS(1)=1.E-7
- NARG=1
- CALL MNEXCM(FCN,'SET EPS',ARGLIS,NARG,IERFL,UFCN)
- ELSE
- CALL MNCLER
- ENDIF
-*
-* Set error criterion for Chi**2 or Liklihood fits
-*
- NARG=1
- ARGLIS(1) = 1.0
- IOPTL=INDEX(CHOPT,'L')
-*
-*-* MINUIT ERRDEF should not be set to 0.5 in case of loglikelihood fit.
-*-* because the FCN is already multipiled by 2 in HFCNH
-*
-* IF(IOPTL.NE.0) ARGLIS(1)=0.5
- CALL MNEXCM(FCN,'SET ERR',ARGLIS,NARG,IERFL,UFCN)
-*
-* Name parameters if not already done
-*
- IF(FITNAM(1).EQ.' ')THEN
- DO 2 I=1,NFPAR
- IF(I.LT.10)THEN
- WRITE(FITNAM(I),10200)I
- ELSE
- WRITE(FITNAM(I),10300)I
- ENDIF
- 2 CONTINUE
- ENDIF
-*
-* Calculate iofset
-*
- IOFSET=LOCF(PARAM(1))-LOCF(FITPAR(1))
-*
-* Set initial step sizes for parameters
-*
- STMIN=BINWID
- PLEPS=1.E-6
- DO 10 I=1,NFPAR
- IF (WERR(I).EQ.0.) GOTO 10
- IF (WERR(I).LT.0.) WERR(I)=0.3*ABS(PARAM(I))
- IF (WERR(I).LE.PLEPS*ABS(PARAM(I))) WERR(I)=STMIN
- 10 CONTINUE
-*
- NITMAX=200+100*NFPAR+10*NFPAR**2
- EPSIH=1.
- IF (FNIX.GT.0.) NITMAX=FNIX
- IF (FEPS.GT.0.) EPSIH=FEPS
- IF (ITFUM.GE.0) THEN
- CHOPTT=CHOPT
- IF(KSQUEZ.EQ.0)CALL HFORMA(3)
- WRITE (LOUT,10000) FITNAM(NFPAR+1)(1:6),ID,CHOPTT,EPSIH
- END IF
-*
-* Initializations
-*
- IF (ITFUM.LT.1) THEN
- ARGLIS(1)=-1.
- NARG=1
- CALL MNEXCM(FCN,'SET PRINT',ARGLIS,NARG,IERFL,UFCN)
- ARGLIS(1)=0.
- NARG=0
- CALL MNEXCM(FCN,'SET NOW',ARGLIS,NARG,IERFL,UFCN)
- ENDIF
-*
- DO 30 I=1,NFPAR
- PAR= PARAM(I)
- AL = ALIM(I)
- BL = BLIM(I)
- WE = WERR(I)
- CALL MNPARM(I,FITNAM(I),PAR,WE,AL,BL,IERFLP)
- IF (IERFLP.GT.0) THEN
- WRITE (LERR,*) ' REQUEST FOR PARAMETERS FAILED.'
- WRITE (LERR,*) ' CHECK INPUT PARAMETERS.'
- ICSTAT=0
- RETURN
- ENDIF
- 30 CONTINUE
-*
-* Invoke interactive Minuit if option 'M'
-*
- IF(INDEX(CHOPT,'M').NE.0)THEN
- IF(IADINP.EQ.0)THEN
- CALL MNREAD(FCN,3,IFLGUT,UFCN)
- ELSE
- CALL JUMPST(IADINP)
- CALL JUMPX2(FCN,UFCN)
- ENDIF
- IF(INDEX(CHOPT,'K').EQ.0)THEN
- NCMINP=0
- ENDIF
- GO TO 500
- ENDIF
-*
-* Set gradient
-*
- IF (IDER.NE.0) THEN
- IF (IDER.EQ.1) THEN
- ARGLIS(1)=1.
- ELSEIF (IDER.EQ.2) THEN
- ARGLIS(1)=0.
- ENDIF
- NARG=1
- CALL MNEXCM(FCN,'SET GRAD',ARGLIS,NARG,IERFLG,UFCN)
- ENDIF
-*
-* Reset print level
-*
- IF (ITFUM.GT.0) THEN
- IF (ITFUM.EQ.1) THEN
- ARGLIS(1)=0.
- ELSEIF (ITFUM.EQ.2) THEN
- ARGLIS(1)=1.
- ELSE
- ARGLIS(1)=2.
- ENDIF
- NARG=1
- CALL MNEXCM(FCN,'SET PRINT',ARGLIS,NARG,IERFL,UFCN)
- ENDIF
-*
-* Perform minimization
-*
- FCNMH=FLOAT(NITMAX)
- ARGLIS(1)=FCNMH
- ARGLIS(2)=EPSIH
- NARG=2
- CALL MNEXCM(FCN,'MIGRAD',ARGLIS,NARG,IERFLM,UFCN)
- IF(IOPTE.NE.0)THEN
- NARG=0
- CALL MNEXCM(FCN,'HESSE' ,ARGLIS,NARG,IERFLM,UFCN)
- CALL MNEXCM(FCN,'MINOS' ,ARGLIS,NARG,IERFLM,UFCN)
- ENDIF
-*
-* Get status at return time
-*
- 500 CONTINUE
- DO 40 I=1,NFPAR
- CALL MNPOUT(I,FITNAM(I),PAR,WE,AL,BL,IVARB)
- FITPAD(I)=PAR
- PARAM(I) = PAR
- ALIM(I) = AL
- BLIM(I) = BL
- IF(IOPTE.EQ.0)THEN
- WERR(I) = WE
- ELSE
- CALL MNERRS(I,EPLUS,EMINUS,EPARAB,GLOBCC)
- IF(EPLUS.GT.0..AND.EMINUS.LT.0.)THEN
- WERR(I) = 0.5*(EPLUS-EMINUS)
- ELSE
- WERR(I) = WE
- ENDIF
- ENDIF
- 40 CONTINUE
- CALL MNSTAT(AMIN,EDM,ERRDEF,NVPAR,NPARX,ICSTAT)
-*
-* Print final values of parameters, if ITFUM=0.
-*
- IF (ITFUM.EQ.0) THEN
- IF(IOPTE.EQ.0)THEN
- CALL MNPRIN(3,AMIN)
- ELSE
- CALL MNPRIN(4,AMIN)
- ENDIF
- ENDIF
-*
-* If log-likelihood, compute an equivalent chisquare
- IF(LINEAR.NE.0.AND.IOPTZ.EQ.0)THEN
- LINEAR=0
- CALL FCN(NFPAR,FITPAD,AMIN,FITPAD,1,UFCN)
- ENDIF
-*
- IF (NPFITS-NVPAR.GT.0) THEN
- FITCHI=AMIN/(NPFITS-NVPAR)
- ELSE
- FITCHI=9999.
- ENDIF
- IF (ITFUM.GE.0) THEN
- WRITE (LOUT,10100)FITCHI,NPFITS
- ENDIF
-*
-* Copy results in /HCFITS/
-*
- DO 50 I=1,NFPAR
- FITPAR(I)=PARAM(I)
- FITSIG(I)=WERR(I)
- 50 CONTINUE
-*
-10000 FORMAT (
- +/' **********************************************',
- +/' * *',
- +/' * Function minimization by SUBROUTINE ',A6,' *',
- +/' * Variable-metric method *',
- +/' * ID = ',I10,' CHOPT = ',A, ' *',
- +/' * *',
- +/' **********************************************',
- +/' Convergence when estimated distance to minimum',
- +' (EDM) .LT. ',E9.2)
-10100 FORMAT (/,' CHISQUARE =',E11.4,' NPFIT =',I6,/)
-10200 FORMAT('P',I1,6X)
-10300 FORMAT('P',I2,5X)
-*
- END
diff --git a/src/packlib/hbook/code/hmonit.F b/src/packlib/hbook/code/hmonit.F
deleted file mode 100644
index d7fa573..0000000
--- a/src/packlib/hbook/code/hmonit.F
+++ /dev/null
@@ -1,73 +0,0 @@
-*
-* $Id: hmonit.F,v 1.1.1.1 1996/01/16 17:07:43 mclareni Exp $
-*
-* $Log: hmonit.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:43 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.10/05 05/03/89 09.22.02 by Rene Brun
-*-- Author :
- SUBROUTINE HMONIT (S,M,NN3,IT,GT,AKAPPA,ALAMBD,
- +A,SIGMA,R,PL,PL0)
-*.==========>
-*. ITERATION PROGRESS OUTPUT
-*..=========> ( I.Ivanchenko )
- DIMENSION A(1),SIGMA(1),R(1),PL(1),PL0(1)
-#include "hbook/hcfit2.inc"
-#include "hbook/hcunit.inc"
-#include "hbook/hcflag.inc"
- SAVE NM
- DATA NM/0/
-*.___________________________________________
- IF (IT) 11,3,1
- 1 IF (NN3) 4,4,2
- 2 IF (NM) 3,4,4
- 3 IF (ENDFLG) 4,12,4
-*
-* PRINTER CARRIAGE CONTROL
-*
- 4 I1=0
- IF(M.GT.20)I1=1
- S2=S+S
- WRITE(LOUT,19) I1,NN3,S2,GT,AKAPPA,ALAMBD
- DO 10 I=1,M
- IF (PL0(I).LE.0.)GO TO 9
- IF (PL(I)) 8,7,6
- 6 CONTINUE
- WRITE(LOUT,20) I,A(I),SIGMA(I),R(I)
- GO TO 10
- 7 WRITE(LOUT,21) I,A(I),SIGMA(I),R(I)
- GO TO 10
- 8 IF (PL(I).GE.-1.) GO TO 7
- WRITE(LOUT,22) I,A(I)
- GO TO 10
- 9 WRITE(LOUT,23) I,A(I)
- 10 CONTINUE
- 11 NM=-IT
- 12 NM=NM+1
- IF (ENDFLG) 13,14,14
- 13 I=-ENDFLG
- GO TO (15,16,17,18), I
- 14 RETURN
- 15 CALL HBUG('Error 723','HFIT**',ID)
- GO TO 14
- 16 CALL HBUG('724','HFIT**',ID)
- GO TO 14
- 17 CALL HBUG('725','HFIT**',ID)
- GO TO 14
- 18 WRITE(LERR,27)
- GO TO 14
-*
- 19 FORMAT (I1,'ITERATION NO.',I3,',2S=',E12.5,', EC = ',E12.5,',KAP',
- 1'PA= ',E12.5,', LAMBDA=',E12.5//7X,'PARAMETER',6X,'PARAMETER',9X
- 2,'STANDARD',8X,'CORRELATION',/,9X,'NUMBER',9X,'VALUE',11X,'DEV',
- 3'IATION',9X,'FACTOR'/)
- 20 FORMAT (' ',8X,I3,4X,3(5X,E12.5))
- 21 FORMAT (' ',8X,I3,4X,3(5X,E12.5),' PARAMETER ON BOUNDARY')
- 22 FORMAT (' ',8X,I3,9X,E12.5,5X,'INFINITE ERROR ESTIMATED')
- 23 FORMAT (' ',8X,I3,9X,E12.5,5X,'THIS PARAMETER FIXED')
- 27 FORMAT ('0','MINIMISATION TERMINATED AS NEGATIVE OR ZERO Y ENCOU',
- 1'NTERED AS LOGARITHMIC ARGUEMENT',/'1')
- END
diff --git a/src/packlib/hbook/code/hmufit.F b/src/packlib/hbook/code/hmufit.F
deleted file mode 100644
index 9050fc4..0000000
--- a/src/packlib/hbook/code/hmufit.F
+++ /dev/null
@@ -1,383 +0,0 @@
-*
-* $Id: hmufit.F,v 1.1.1.1 1996/01/16 17:07:43 mclareni Exp $
-*
-* $Log: hmufit.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:43 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.10/05 31/08/90 18.34.26 by Rene Brun
-*-- Author :
- SUBROUTINE HMUFIT (X,Y,EY,IBASFT,W,WT,WY,B,BT,BTT,DD,FF,COEFF,
- + CT,MARKBF,MAXBF,R2MIN,FLEVEL)
-*.==========>
-*. PERFORM MULTIDIMENSIONAL FIT
-*. W = MATRIX WHOSE COLUMNS ARE THE BASIC
-*. FUNCTIONS OR REGRESSORS
-*. WT = ONE BASIC FUNCTION CORRESPONDING TO A COLUMN
-*. OF MATRIX W
-*. WY = MATRIX PRODUCT W.Y
-*. B = COVARIANCE MATRIX = (W'.W)-1
-*. BT,BTT = TEMPORARY COPIES OF B
-*. DD,FF = WORKING STORAGE FOR PARTITIONED INVERSION OF W'.W
-*. MARKBF = BASIC FUNCTIONS MARKER
-*. 0 : AVAILABLE
-*. >0 : ALREADY INCLUDED (=REGRESSOR NUMBER)
-*. -1 : UNAVAILABLE FOR ONE ROUND (REJECTED BY THE
-*. STEPWISE PROCEDURE)
-*. MAXBF = GIVES NUMBER OF BASIC FUNCTION CORRESPONDING TO A
-*. REGRESSOR NUMBER
-*. SYY = SUM OF SQUARES OF Y-VALUES
-*. RSS = RESIDUAL SUM OF SQUARES
-*. VARIAN = ESTIMATED VARIANCE OF RESIDUALS OR MULTIPLICATION
-*. FACTOR OF THE COVARIANCE MATRIX B
-*. DROP = DROP IN SYY CORRESPONDING TO THE INCLUSION
-*. OF ONE ADDITIONAL REGRESSOR
-*. R2P = PARTIAL CORRELATION COEFFICIENT BETWEEN Y AND THE
-*. NEW REGRESSOR, ALL OTHERS ALREADY INCLUDED
-*. FR = F-RATIO FOR THE INCLUSION OF A NEW REGRESSOR
-*. F = F-RATIO FOR THE REJECTANCE TEST OF ALREADY INCLUDED
-*. REGRESSORS ; A REGRESSOR WILL BE REJECTED IF ITS
-*. F-RATIO < FLEVEL
-*. R2 = MULTIPLE CORRELATION COEFFICIENT
-*. R2ADJ = " " " ADJUSTED FOR THE
-*. DEGREES OF FREEDOM
-*. MINVAR = REGRESSOR NUMBER CORR. TO MIN VARIAN OR MAX R2ADJ
-*..=========> ( D.Lienart )
-#include "hbook/hcpar1.inc"
-#include "hbook/hcpout.inc"
-#include "hbook/hcunit.inc"
- DIMENSION X(NPMAX,ND),Y(1),EY(1),IBASFT(ND,NBFMAX),
- + W(NPMAX,NCOMAX),WT(1),WY(1),B(NCOMAX,NCOMAX),
- + BT(NCOMAX,NCOMAX),BTT(NCOMAX,NCOMAX),DD(1),FF(1),
- + COEFF(1),CT(1),MARKBF(1),MAXBF(1),IAUX(10)
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION W,WT,WY,B,BT,BTT,DD,FF,COEFF,CT,SYY,RSS,VARIAN,
- + WYT,DROP,DROPMX,DP,R2,R2ADJ,YD,BII,
- + FR,R2P,R2PMX,EPSMAC
- DOUBLE PRECISION ONE, HALF, EPSTST
-#endif
-*
-* DETERMINE MACHINE ACCURACY EPSMAC
-*
- EPSMAC=0.0625
- ONE = 1.
- HALF = 0.5
- 1 CONTINUE
- EPSMAC = EPSMAC * HALF
- EPSTST = ONE + EPSMAC * HALF
- IF (EPSTST .NE. ONE) GO TO 1
- SYY=0.
- DO 3 I=1,NP
-#if !defined(CERNLIB_DOUBLE)
- YD=Y(I)
-#endif
-#if defined(CERNLIB_DOUBLE)
- YD=DBLE(Y(I))
-#endif
- SYY=SYY+YD*YD
- 3 CONTINUE
- RSS=SYY
- VARIAN=SYY/NP
- IF (IOPT(7).NE.2) CALL VZERO (MARKBF,NBF)
- NCO=0
- ITER=0
-*
- IF (IOPT(2).GE.1) WRITE (LOUT,290) NBF,NP,SYY,EPSMAC
-*
-*
-* SET UP MARKBF FOR SIMPLE REGRESSION (IOPT(7)=2): ALL BASIC
-* FUNCTIONS WILL BE INCLUDED
-*
- 5 NCO=NCO+1
- ITER=ITER+1
- IFLAG=1
- R2PMX=0.
- DROPMX=0.
- IF (IOPT(7).EQ.2) THEN
- MARKBF(NCO)=0
- CALL VFILL (MARKBF(NCO+1),NBF-NCO,-1)
- ENDIF
-*
-* FOR EACH AVAILABLE BASIC FUNCTION, FORM COVARIANCE MATRIX,
-* COMPUTE COEFF. CT, DROP AND FR; IF THIS RATIO IS NEGATIVE, RSS CANNOT
-* BE REDUCED ANY MORE DUE TO PRECISION PROBLEMS (IFLAG=2); OTHERWISE
-* R2P IS COMPUTED AND POSSIBLY SAVED IF > R2PMX, ALONG WITH DROP,WT,BT,
-* WYT AND THE REGRESSOR NUMBER
-*
- DO 30 I=1,NBF
- IF (MARKBF(I).EQ.0.AND.IFLAG.NE.2) THEN
- CALL HCOVW (X,EY,W,WT,B,BT,DD,FF,IBASFT,I)
- DP=0.
- DO 7 K=1,NP
- DP=DP+WT(K)*Y(K)
- 7 CONTINUE
- WY(NCO)=DP
- DROP=0.
- DO 10 J=1,NCO
- DP=0.
- DO 8 K=1,NCO
- DP=DP+WY(K)*BT(K,J)
- 8 CONTINUE
- CT(J)=DP
- DROP=DROP+DP*WY(J)
- 10 CONTINUE
- FR=CT(NCO)**2*(NP-NCO)/(BT(NCO,NCO)*(SYY-DROP))
- IF (FR.LT.0.) THEN
-*
-* NORMALLY FR IS ALWAYS > 0; DUE TO MACHINE PRECISION LIMITATIONS IT
-* CAN HAPPEN THAT RSS GETS < 0; A SLIGHT PERTURBATION OF THE VARIANCE
-* OF THE LAST REGRESSOR WILL NORMALLY SETTLE THIS PROBLEM
-*
- BII=BT(NCO,NCO)
- DP=CT(NCO)
- BT(NCO,NCO)=BII*(1.-EPSMAC)
- CT(NCO)=DP+(BT(NCO,NCO)-BII)*WY(NCO)
- DROP=DROP+(DP-CT(NCO))*WY(NCO)
- FR=CT(NCO)**2*(NP-NCO)/(BT(NCO,NCO)*(SYY-DROP))
- IF (FR.LT.0.) IFLAG=2
- ENDIF
- IF (FR.GE.0.) THEN
- IF (R2MIN.NE.2..OR.(FR.GT.FLEVEL.AND.
- + (SYY-DROP)/(NP-NCO).LT.VARIAN)) THEN
-*
-* IF R2MIN=2, THE VARIANCE SHOULD DECREASE FOR A REGRESSOR TO BE
-* CONSIDERED FOR INCLUSION: 2 EQUIVALENT TESTS ARE USED TO INSURE
-* GREATER STABILITY
-*
- IFLAG=-1
- R2P=FR/(FR+NP-NCO)
- IF (R2P.GT.R2PMX) THEN
- R2PMX=R2P
- DROPMX=DROP
- DO 15 K=1,NP
- W(K,NCO)=WT(K)
- 15 CONTINUE
- DO 25 K=1,NCO
- DO 20 L=1,NCO
- BTT(K,L)=BT(K,L)
- 20 CONTINUE
- 25 CONTINUE
- WYT=WY(NCO)
- MAXBF(NCO)=I
- ENDIF
- ENDIF
- ENDIF
- ENDIF
- 30 CONTINUE
-*
-* IF THE MINIMUM VARIANCE CRITERION IS ACTIVE, AND THE VARIANCE
-* DOES NOT DECREASE ANY MORE, THEN THE PROCESS WILL BE STOPPED
-* IT WILL ALSO BE STOPPED IF THE VARIANCE GETS NEGATIVE
-*
- IF (IFLAG.NE.-1) THEN
- NCO=NCO-1
- ELSE
-*
-* VALIDATE NEW MODEL: SET B, WY AND RSS
-* REENABLE DISABLED CANDIDATE BASIC FUNCTIONS
-*
- RSS=SYY-DROPMX
- WY(NCO)=WYT
- DO 33 J=1,NCO
- DP=0.
- DO 32 I=1,NCO
- B(I,J)=BTT(I,J)
- DP=DP+WY(I)*B(I,J)
- 32 CONTINUE
- COEFF(J)=DP
- 33 CONTINUE
- MARKBF(MAXBF(NCO))=NCO
- DO 35 I=1,NBF
- IF (MARKBF(I).EQ.-1) MARKBF(I)=0
- 35 CONTINUE
-*
-* BACKWARD STAGE OF THE STEPWISE REGRESSION
-* REJECT REGRESSOR WITH MINIMUM F-RATIO UNLESS > FLEVEL
-* UPDATE RSS, W, WY, B, COEFF, MAXBF AND MARK THE CORR. BASIC
-* FUNCTION WITH VALUE -1
-* REPEAT UNTIL NO MORE REGRESSORS CAN BE ELIMINATED
-*
- IF (IOPT(7).EQ.0) THEN
- 40 IFMIN=0
- FMIN=FLEVEL
- DO 45 I=1,NCO-1
- F=COEFF(I)**2*(NP-NCO)/(B(I,I)*RSS)
- IF (F.LT.FLEVEL.AND.F.LT.FMIN) THEN
- FMIN=F
- IFMIN=I
- ENDIF
- 45 CONTINUE
- IF (IFMIN.NE.0) THEN
- J=MAXBF(IFMIN)
- MARKBF(J)=-1
- BII=B(IFMIN,IFMIN)
- DO 50 K=1,NCO
- DD(K)=B(K,IFMIN)
- 50 CONTINUE
- DO 70 K=IFMIN+1,NCO
- DO 55 L=1,NP
- W(L,K-1)=W(L,K)
- 55 CONTINUE
- DO 60 L=1,NCO
- B(L,K-1)=B(L,K)
- 60 CONTINUE
- DO 65 L=1,NCO
- B(K-1,L)=B(K,L)
- 65 CONTINUE
- MAXBF(K-1)=MAXBF(K)
- WY(K-1)=WY(K)
- DD(K-1)=DD(K)
- 70 CONTINUE
- NCO=NCO-1
- DO 75 I=1,NCO
- DO 75 J=1,NCO
- B(I,J)=B(I,J)-DD(I)*DD(J)/BII
- 75 CONTINUE
- RSS=SYY
- DO 80 K=1,NCO
- DP=0.
- DO 77 I=1,NCO
- DP=DP+WY(I)*B(I,K)
- 77 CONTINUE
- COEFF(K)=DP
- RSS=RSS-DP*WY(K)
- 80 CONTINUE
- GOTO 40
- ENDIF
- ENDIF
- IF (RSS/(NP-NCO).LT.VARIAN) THEN
- VARIAN=RSS/(NP-NCO)
- MINVAR=-1
- ELSE
- IF (MINVAR.EQ.-1) MINVAR=NCO-1
- ENDIF
- ENDIF
-*
-*
-*
- R2=1-RSS/SYY
- R2ADJ=1-(NP-1)*(1-R2)/(NP-NCO)
-*
-* TEST IF FITTING IS TO BE STOPPED OR NOT
-*
- IF (IFLAG.EQ.2) THEN
- WRITE (LOUT,190) R2,NCO
- ELSE
- IF (IFLAG.EQ.1) THEN
- WRITE (LOUT,200) R2,NCO
- ELSE
- IF (R2.GE.R2MIN) THEN
- WRITE (LOUT,210) R2,NCO
- IFLAG=0
- ELSE
- IF (NCO.LT.NCOMAX) THEN
- DO 85 I=1,NBF
- IF (MARKBF(I).EQ.0) GOTO 87
- 85 CONTINUE
- WRITE (LOUT,220) R2,NCO
- IFLAG=4
- ELSE
- WRITE (LOUT,230) NCOMAX,R2
- IFLAG=3
- ENDIF
- ENDIF
- ENDIF
- ENDIF
-*
-* PRINT OUT RESULTS OF EACH ITERATION AND/OR FINAL RESULTS
-*
- 87 IF (IFLAG.NE.-1) THEN
- IF (IFLAG.NE.1.AND.IFLAG.NE.2.AND.IOPT(2).GE.1) THEN
- IF (MINVAR.EQ.-1) THEN
- WRITE (LOUT,240)
- ELSE
- WRITE (LOUT,250) MINVAR
- ENDIF
- ENDIF
- WRITE (LOUT,300)
- ENDIF
- IF (IOPT(2).EQ.2.OR.IFLAG.NE.-1) THEN
- WRITE (LOUT,260)
- WRITE (LOUT,270) ITER,RSS,R2ADJ,COEFF(1),(IBASFT(K,MAXBF(1))
- + ,K=1,ND)
- DO 88 I=2,NCO
- WRITE (LOUT,280) I,COEFF(I),(IBASFT(K,MAXBF(I)),K=1,ND)
- 88 CONTINUE
- ENDIF
- IF (IFLAG.EQ.-1) GOTO 5
-*
-* REORDER IBASFT SO AS TO REFLECT THE ORDER OF INCLUSION
-* OF THE CORR. REGRESSORS IN THE FINAL EQUATION
-*
- DO 105 I=1,NCO
- J=MAXBF(I)
- DO 95 L=I+1,NCO
- IF (MAXBF(L).EQ.I) THEN
- MAXBF(L)=MAXBF(I)
- DO 90 K=1,ND
- IAUX(K)=IBASFT(K,I)
- IBASFT(K,I)=IBASFT(K,J)
- IBASFT(K,J)=IAUX(K)
- 90 CONTINUE
- GOTO 105
- ENDIF
- 95 CONTINUE
- DO 100 K=1,ND
- IBASFT(K,I)=IBASFT(K,J)
- 100 CONTINUE
- 105 CONTINUE
-*
-* COMPUTE THE STANDARD DEVIATIONS OF THE COEFFICIENTS
-*
- VARIAN=RSS/(NP-NCO)
- DO 110 K=1,NCO
- SECO(K)=SQRT(B(K,K)*VARIAN)
- 110 CONTINUE
-*
-* COMPUTE CONFIDENCE INTERVALS FOR COEFFICIENTS
-*
- T=1.56/(NP-NCO)+1.645
- DO 115 I=1,NCO
- COMIN(I)=COEFF(I)-T*SECO(I)
- COMAX(I)=COEFF(I)+T*SECO(I)
- 115 CONTINUE
-*
-*
- IF (IOPT(2).GE.1) THEN
- WRITE (LOUT,310)
- DO 120 I=1,NCO
- WRITE (LOUT,320) I,SECO(I),COMIN(I),COMAX(I)
- 120 CONTINUE
- ENDIF
- RSSS=RSS
- R2S=R2
-*
- 190 FORMAT (//' FITTING PROCESS STOPPED AS RESIDUAL SUM OF SQUARES',
- + ' CANNOT BE REDUCED ANY MORE'/,' R2 = ',F8.5,5X,
- + I3,' REGRESSORS INCLUDED')
- 200 FORMAT (//' FITTING PROCESS STOPPED AS RESIDUAL VARIANCE HITS ',
- + 'MINIMUM'/,' R2 = ',F8.5,5X,I3,' REGRESSORS INCLUDED')
- 210 FORMAT (//' FITTING PROCESS STOPPED AS R2 = ',F8.5,/,
- + I3,' REGRESSORS INCLUDED')
- 220 FORMAT (//' FITTING PROCESS STOPPED AS NO MORE REGRESSORS ',
- + 'AVAILABLE'/,' R2 = ',F7.5,5X,I3,' REGRESSORS INCLUDED')
- 230 FORMAT (//' FITTING PROCESS STOPPED AS THE MAXIMUM NUMBER OF ',
- + 'REGRESSORS (',I2,') WAS REACHED'/,' R2 = ',F8.5)
- 240 FORMAT (' RESIDUAL VARIANCE STILL DECREASES')
- 250 FORMAT (' MIMIMUM RESIDUAL VARIANCE REACHED AFTER REGRESSOR',
- + ' NO ',I2,' WAS INCLUDED')
- 260 FORMAT (//' ITERATION',7X,'RSS',7X,'R2ADJ',5X,'REGRESSOR',2X,
- + 'COEFF. VALUE',3X,'TERM OF PARAMETRIZATION'/)
- 270 FORMAT (4X,I2,6X,G12.5,3X,F8.5,6X,' 1',6X,G12.5,3X,10(I3,1X))
- 280 FORMAT (40X,I2,6X,G12.5,3X,10(I3,1X))
- 290 FORMAT (/,1X,I3,' CANDIDATE BASIC FUNCTIONS WERE RETAINED FOR',
- + ' THE FIT',/,' NUMBER OF POINTS TO FIT = ',I5,/,
- + ' SUM OF SQUARES OF Y-VALUES = ',G12.5,/,' MACHINE ',
- + 'PRECISION = ',E9.2)
- 300 FORMAT (///' FINAL RESULTS OF THE FIT'/,1X,24('*'))
- 310 FORMAT (//' REGRESSOR',2X,'STANDARD DEVIATION',5X,'CONFIDENCE',
- + ' INTERVAL')
- 320 FORMAT (4X,I2,9X,G12.5,5X,'[',G12.5,',',G12.5,']')
- END
diff --git a/src/packlib/hbook/code/hnoent.F b/src/packlib/hbook/code/hnoent.F
deleted file mode 100644
index 08bac31..0000000
--- a/src/packlib/hbook/code/hnoent.F
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: hnoent.F,v 1.2 2001/09/24 14:25:12 couet Exp $
-*
-* $Log: hnoent.F,v $
-* Revision 1.2 2001/09/24 14:25:12 couet
-* - The number of entries of a non existing histogram was not 0.
-*
-* Revision 1.1.1.1 1996/01/16 17:07:44 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.10/05 21/02/89 16.14.50 by Rene Brun
-*-- Author :
- SUBROUTINE HNOENT(IDD,NUMB)
-*.==========>
-*. RETURNS THE NUMBER OF ENTRIES OF IDD
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
- COMMON /QUEST/ IQUEST(100)
-*.___________________________________________
- CALL HFIND(IDD,'HNOENT')
- IF(IQUEST(1).NE.0)THEN
- NUMB=0
- ELSE
- I4=JBIT(IQ(LCID+KBITS),4)
- IF(I4.NE.0)THEN
- NUMB=IQ(LCID+3)
- ELSE
- NUMB=IQ(LCONT+KNOENT)
- ENDIF
- ENDIF
- END
diff --git a/src/packlib/hbook/code/hnorma.F b/src/packlib/hbook/code/hnorma.F
deleted file mode 100644
index 139ac60..0000000
--- a/src/packlib/hbook/code/hnorma.F
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: hnorma.F,v 1.1.1.1 1996/01/16 17:07:44 mclareni Exp $
-*
-* $Log: hnorma.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:44 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.10/05 08/05/89 12.19.12 by Rene Brun
-*-- Author :
- SUBROUTINE HNORMA(ID2,FACTOR)
-*.==========>
-*. store normalisation factor for contents
-*. normalisation will be made only at printing
-*. the original contents are not mofified
-*..=========> ( R.Brun )
-#include "hbook/hcbits.inc"
-#include "hbook/hcbook.inc"
-*.___________________________________________
- IRET=3
- FACT=FLOARG(FACTOR)
-*
- 10 CALL HLOOP(ID2,'HNORMA',IRET)
- IF(IRET.EQ.0)GO TO 99
-*
- CALL HDCOFL
- IF(I1.EQ.0)GO TO 30
- IF(FACT.GT.0.)THEN
- CALL HSIFLA(18,1)
- Q(LCID+KNORM)=FACT
- ELSE
- CALL HSIFLA(18,0)
- Q(LCID+KNORM)=0.
- ENDIF
-*
- 30 IRET=2
- GO TO 10
-*
- 99 RETURN
- END
diff --git a/src/packlib/hbook/code/hobsol.F b/src/packlib/hbook/code/hobsol.F
deleted file mode 100644
index 5ab1b47..0000000
--- a/src/packlib/hbook/code/hobsol.F
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: hobsol.F,v 1.1.1.1 1996/01/16 17:07:44 mclareni Exp $
-*
-* $Log: hobsol.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:44 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.10/05 21/02/89 16.14.50 by Rene Brun
-*-- Author :
- SUBROUTINE HOBSOL(CHROUT,CH1,CH2)
-*.==========>
-*. To inform new users of obsolete routines
-*. and of the equivalent
-*..=========> ( R.Brun )
-#include "hbook/hcunit.inc"
- CHARACTER*6 CHROUT
- CHARACTER*4 CH1,CH2
-*.___________________________________________
- WRITE(LOUT,1000)CHROUT,CH1,CH2
- 1000 FORMAT(' ***** OBSOLETE ROUTINE ',A,' HAS BEEN CALLED',/,
- + ' ***** USE CALL HIDOPT(ID,"',A,'"/"',A,'") INSTEAD')
- END
diff --git a/src/packlib/hbook/code/hoper1.F b/src/packlib/hbook/code/hoper1.F
deleted file mode 100644
index 6d7d495..0000000
--- a/src/packlib/hbook/code/hoper1.F
+++ /dev/null
@@ -1,222 +0,0 @@
-*
-* $Id: hoper1.F,v 1.2 1998/01/06 11:26:41 couet Exp $
-*
-* $Log: hoper1.F,v $
-* Revision 1.2 1998/01/06 11:26:41 couet
-* - option L in MZDROP was missing. Without this option the following PAW macro
-* doesn't work:
-*
-* v/cr p3(3) r 0 1 0
-* v/cr a(10) r 1 3 2 5 4 8 6 10 7 9
-* 1d 1 '' 10 0 10
-* put/con 1 a
-* h/fit 1 p2.f q 3 p3
-* add 1 1 2
-* h/pl 2
-*
-* with p2.f:
-*
-* REAL FUNCTION P2(X)
-* REAL X, PAR(3)
-* COMMON /PAWPAR/PAR
-* P2 = PAR(1) + PAR(2)*X + PAR(3)*X*X
-* END
-*
-* Revision 1.1.1.1 1996/01/16 17:07:44 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 26/09/95 11.16.41 by Julian Bunn
-*-- Author :
- SUBROUTINE HOPER1(KOP,NC,LC1,LC2,LC3,C1,C2,IOPTB)
-*.==========>
-*. Auxiliary of HOPERA for one projection
-*.
-*. Binomial errors (IOPTB=1) only used for divisions.
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
-#include "hbook/hcbits.inc"
-#include "hbook/hcprin.inc"
- DIMENSION STAT(2)
-#if !defined(CERNLIB_DOUBLE)
- DIMENSION SWX(4)
-#endif
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION SWX(4)
-#endif
-*.___________________________________________
- IF(LC1.EQ.0.OR.LC2.EQ.0.OR.LC3.EQ.0)GO TO 99
- LW1=LQ(LC1)
- LW2=LQ(LC2)
- LW3=LQ(LC3)
- IF(LW1.EQ.0.OR.LW2.EQ.0.OR.LW3.EQ.0)THEN
- LW123=0
- ELSE
- LW123=LW1
- ENDIF
- D1=C1*C1
- D2=C2*C2
-*
-* Contents
-*
- KN=IQ(LC1+KNOENT)+IQ(LC2+KNOENT)
- IQ(LC3+KNOENT)=-1
- IF(I7.NE.0)THEN
- STAT(1)=C1*Q(LC1+KSTAT1)+C2*Q(LC2+KSTAT1)
- STAT(2)=D1*Q(LC1+KSTAT1+1)+D2*Q(LC2+KSTAT1+1)
- CALL UCOPY(Q(LC1+KSTAT1+2),SWX(1),4)
- CALL UCOPY(Q(LC2+KSTAT1+2),SWX(3),4)
- SWX(1)=C1*SWX(1)+C2*SWX(3)
- SWX(2)=C1*SWX(2)+C2*SWX(4)
- ENDIF
- DO 10 I=0,NC+1
- LCONT=LC1
- NB=IQ(LCONT+KNBIT)
-C
-C CHECK ERROR BANKS DON'T EXIST ...
-C
- IF(I8.EQ.0.OR.I1.EQ.0)THEN
- R1=HCX(I,1)
- S1=ABS(R1)
- IF(LW1.NE.0.AND.I.GT.0.AND.I.LE.NC)THEN
- S1=HCX(I,2)
- S1=S1*S1
- ENDIF
- ELSE
- R1=Q(LC1+KCON1+I)
- IF(I.GT.0.AND.I.LE.NC)S1=Q(LW1+I)
- ENDIF
- LCONT=LC2
- NB=IQ(LCONT+KNBIT)
-C
-C CHECK ERROR BANKS DON'T EXIST ...
-C
- IF(I8.EQ.0.OR.I1.EQ.0)THEN
- R2=HCX(I,1)
- S2=ABS(R2)
- IF(LW2.NE.0.AND.I.GT.0.AND.I.LE.NC)THEN
- S2=HCX(I,2)
- S2=S2*S2
- ENDIF
- ELSE
- R2=Q(LC2+KCON1+I)
- IF(I.GT.0.AND.I.LE.NC)S2=Q(LW2+I)
- ENDIF
- LCONT=LC3
- IF(I.GT.0.AND.I.LE.NC)THEN
- KW=LW3
- ELSE
- KW=0
- ENDIF
- NB=IQ(LCONT+KNBIT)
- IF(KOP.EQ.1)THEN
- R3=C1*R1+C2*R2
- IF(KW.NE.0)THEN
- S3=D1*S1+D2*S2
- ENDIF
- ELSEIF(KOP.EQ.2)THEN
- R3=C1*R1-C2*R2
- IF(KW.NE.0)THEN
- S3=D1*S1+D2*S2
- ENDIF
- ELSEIF(KOP.EQ.3)THEN
- R3=C1*R1*C2*R2
- IF(KW.NE.0)THEN
- S3=D1*D2*(S1*R2*R2+S2*R1*R1)
- ENDIF
- ELSEIF(KOP.EQ.4)THEN
- DIV=C2*R2
- IF ( ABS(DIV) .GT. 1.0E-10 ) THEN
- R3=C1*R1/DIV
- IF(KW.NE.0)THEN
- IF(IOPTB.EQ.0)THEN
- S3=D1*D2*(S1*R2*R2+S2*R1*R1)/DIV**4
- ELSE
- S3=ABS(R3*(1.-R3)/DIV)
- ENDIF
- ENDIF
- ELSE
- R3=0.
- S3=0.
- ENDIF
- ENDIF
- CALL HFCX(I,R3)
- IF(KW.NE.0)THEN
- Q(LW3+I)=S3
- ENDIF
- 10 CONTINUE
- IQ(LC3+KNOENT)=KN
- IF(I7.NE.0)THEN
- CALL UCOPY(STAT,Q(LC3+KSTAT1 ),2)
- CALL UCOPY(SWX ,Q(LC3+KSTAT1+2),4)
- ENDIF
-*
-* Profile histogram
-*
- IF(I8.NE.0.AND.LW123.NE.0)THEN
- LF1=LQ(LW1)
- LF2=LQ(LW2)
- LF3=LQ(LW3)
- IF(LF1.EQ.0.OR.LF2.EQ.0.OR.LF3.EQ.0)GO TO 30
- DO 20 I=1,NC
- R1=Q(LF1+I)
- R2=Q(LF2+I)
- IF(KOP.EQ.1)THEN
- R3=C1*R1+C2*R2
- ELSEIF(KOP.EQ.2)THEN
- R3=C1*R1-C2*R2
- ELSEIF(KOP.EQ.3)THEN
- R3=C1*R1*C2*R2
- ELSEIF(KOP.EQ.4)THEN
- DIV=C2*R2
- IF(DIV.NE.0.)THEN
- R3=C1*R1/DIV
- ELSE
- R3=0.
- ENDIF
- ENDIF
- Q(LF3+I)=R3
- 20 CONTINUE
- ENDIF
-*
-* Function
-*
- 30 LF1=LQ(LC1-1)
- IF(LF1.EQ.0)GO TO 99
- LF2=LQ(LC2-1)
- IF(LF2.EQ.0)GO TO 99
- LF3=LQ(LC3-1)
- IF(LF3.EQ.0)GO TO 99
- NCF1=IQ(LF1+2)-IQ(LF1+1)+1
- NCF2=IQ(LF2+2)-IQ(LF2+1)+1
- NCF3=IQ(LF3+2)-IQ(LF3+1)+1
- IF(NCF1.NE.NCF2)GO TO 99
- IF(NCF1.NE.NCF3)GO TO 99
- IF(NCF1+2.GT.IQ(LF1-1))GO TO 99
-* If standard function, drop HFIT bank
- IF(IQ(LF3-2).NE.0)THEN
- IF(LQ(LF3-1).NE.0)CALL MZDROP(IHDIV,LQ(LF3-1),'L')
- ENDIF
- DO 40 I=1,NCF1
- R1=Q(LF1+I+2)
- R2=Q(LF2+I+2)
- IF(KOP.EQ.1)THEN
- R3=C1*R1+C2*R2
- ELSEIF(KOP.EQ.2)THEN
- R3=C1*R1-C2*R2
- ELSEIF(KOP.EQ.3)THEN
- R3=C1*R1*C2*R2
- ELSEIF(KOP.EQ.4)THEN
- DIV=C2*R2
- IF(DIV.NE.0.)THEN
- R3=C1*R1/DIV
- ELSE
- R3=0.
- ENDIF
- ENDIF
- Q(LF3+I+2)=R3
- 40 CONTINUE
-*
- 99 RETURN
- END
diff --git a/src/packlib/hbook/code/hoper1a.F b/src/packlib/hbook/code/hoper1a.F
deleted file mode 100644
index c41b9db..0000000
--- a/src/packlib/hbook/code/hoper1a.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: hoper1a.F,v 1.1.1.1 1996/01/16 17:07:44 mclareni Exp $
-*
-* $Log: hoper1a.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:44 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.21/01 28/10/93 11.24.26 by Rene Brun
-*-- Author : Rene Brun 28/10/93
- SUBROUTINE HOPER1A(NCX,ID1,ID2,C1)
-*.==========>
-*. Auxiliary of HOPERA for 1-D histograms with alphanumeric labels
-*.==========> ( R.Brun )
- CHARACTER*16 CHLAB
-*.___________________________________________
-*
-* Loop on all channels on ID1 and fill ID2
-*
- DO 10 I=1,NCX
- CALL HLGNXT(ID1,I,CHLAB,'X')
- W=C1*HI(ID1,I)
- CALL HLPOS(ID2,CHLAB,IPOS,'X')
- IPOS=MAX(IPOS,0)
- CALL HFC1(ID2,IPOS,CHLAB,W,'X')
- 10 CONTINUE
- END
diff --git a/src/packlib/hbook/code/hopera.F b/src/packlib/hbook/code/hopera.F
deleted file mode 100644
index 64aca07..0000000
--- a/src/packlib/hbook/code/hopera.F
+++ /dev/null
@@ -1,319 +0,0 @@
-*
-* $Id: hopera.F,v 1.2 1996/08/28 09:48:46 couet Exp $
-*
-* $Log: hopera.F,v $
-* Revision 1.2 1996/08/28 09:48:46 couet
-* *** empty log message ***
-*
-* Revision 1.1.1.1 1996/01/16 17:07:44 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.23/01 20/02/95 09.49.13 by Julian Bunn
-*-- Author :
- SUBROUTINE HOPERA(ID1,CHOP,ID2,ID3,CC1,CC2)
-*.==========>
-*. Operations between histograms
-*. CHOP='+' ID3=C1*ID1+C2*ID2
-*. CHOP='-' ID3=C1*ID1-C2*ID2
-*. CHOP='*' ID3=C1*ID1*C2*ID2
-*. CHOP='/' ID3=C1*ID1/(C2*ID2)
-*. If option 'E' errors will be computed on ID3
-*. If option '/B' is given , binomial errors are computed.
-*..=========> ( R.Brun )
-#include "hbook/hcflag.inc"
-#include "hbook/hcbook.inc"
-#include "hbook/hcprin.inc"
-#include "hbook/hcbits.inc"
- CHARACTER*(*) CHOP
- LOGICAL HLABEQ,HL1,HL2
-*.___________________________________________
- C1=1.
- C2=1.
- N=6
- CALL NOARG(N)
- IF(N.GE.5)C1=FLOARG(CC1)
- IF(N.GE.6)C2=FLOARG(CC2)
-*
- IBE=0
- IF(INDEX(CHOP,'+').NE.0)THEN
- KOP=1
- ELSEIF(INDEX(CHOP,'-').NE.0)THEN
- KOP=2
- ELSEIF(INDEX(CHOP,'*').NE.0)THEN
- KOP=3
- ELSEIF(INDEX(CHOP,'/').NE.0)THEN
- KOP=4
- IF(INDEX(CHOP,'B').NE.0)IBE=1
- IF(INDEX(CHOP,'b').NE.0)IBE=1
- ELSE
- GO TO 90
- ENDIF
- IOPTE=0
- IF(INDEX(CHOP,'E').NE.0)IOPTE=1
- IF(INDEX(CHOP,'e').NE.0)IOPTE=1
-*
-* Find Address of ID1
-*
- IERR=0
- CALL HFIND(ID1,'HOPERA')
- IF(LCID.EQ.0)GO TO 99
- HL1=HLABEQ(ID1,'X')
- LR1=LCID
- NWTOT=IQ(LR1+KNTOT)
- CALL HNOENT(ID1,N1)
-*
-* Find Address of ID2
-*
- CALL HFIND(ID2,'HOPERA')
- IF(LCID.EQ.0)GO TO 99
- HL2=HLABEQ(ID2,'X')
- LR2=LCID
- CALL HNOENT(ID2,N2)
-*
-* Find Address of ID3 or create it
-*
- ID=ID3
- IDPOS=LOCATI(IQ(LTAB+1),IQ(LCDIR+KNRH),ID3)
- IF(IDPOS.LE.0)THEN
- CALL HSPACE(NWTOT+100,'HOPERA',ID1)
- IF(IERR.NE.0)GO TO 99
- CALL HCOPY(ID1,ID3,' ')
- CALL HFIND(ID3,'HOPERA')
- ELSE
- LCID=LQ(LTAB-IDPOS)
- CALL SBIT0(IQ(LCID),5)
- ENDIF
- CALL HDCOFL
- IF(I1.NE.0.AND.I9.EQ.0.AND.IOPTE.NE.0)THEN
- CALL HBARX(ID3)
- ENDIF
- IF(I230.NE.0.AND.IOPTE.NE.0)THEN
- CALL HBAR2(ID3)
- CALL HBARX(ID3)
- CALL HBARY(ID3)
- ENDIF
-*
-*======> Array
-*
- IF(I123.EQ.0)THEN
- IF(I4.NE.0)GO TO 90
- IF(IQ(LR1-1).NE.IQ(LR2-1).OR.IQ(LR1-1).NE.IQ(LCID-1))GO TO 90
- DO 10 I=1,IQ(LCID-1)
- IF(KOP.EQ.1)THEN
- Q(LCID+I)=C1*Q(LR1+I)+C2*Q(LR2+I)
- ELSEIF(KOP.EQ.2)THEN
- Q(LCID+I)=C1*Q(LR1+I)-C2*Q(LR2+I)
- ELSEIF(KOP.EQ.3)THEN
- Q(LCID+I)=C1*Q(LR1+I)*C2*Q(LR2+I)
- ELSEIF(KOP.EQ.4)THEN
- DIV=C2*Q(LR2+I)
- IF(DIV.NE.0.)THEN
- Q(LCID+I)=C1*Q(LR1+I)/DIV
- ELSE
- Q(LCID+I)=0.
- ENDIF
- ENDIF
- 10 CONTINUE
- GO TO 99
- ENDIF
-*
-*======> 1-DIM histogram
-*
- IF(I1.NE.0)THEN
- NCX1=IQ(LR1+KNCX)
- NCX2=IQ(LR2+KNCX)
- NCX3=IQ(LCID+KNCX)
-*
-* Histogram with Alphanumeric labels: 4 possible cases: (only with '+')
-* 1- ID1 ID1 ID1 : process like normal case
-* 2- ID1 ID2 ID1 : loop on ID2 and fill ID1
-* 3- ID1 ID2 ID2 : loop on ID1 and fill ID2
-* 4- ID1 ID2 ID3 : loop on ID1 and fill ID3, loop on ID2 and fill ID3
- IF(KOP.EQ.1.AND.(HL1.OR.HL2))THEN
- IF(ID1.EQ.ID2.AND.ID2.EQ.ID3)GO TO 12
- IF(ID3.EQ.ID1)THEN
- IF(N2.NE.0)CALL HOPER1A(NCX2,ID2,ID3,C2)
- ELSEIF(ID3.EQ.ID2)THEN
- IF(N1.NE.0)CALL HOPER1A(NCX1,ID1,ID3,C1)
- ELSE
- CALL HRESET(ID3,' ')
- IF(N1.NE.0)CALL HOPER1A(NCX1,ID1,ID3,C1)
- IF(N2.NE.0)CALL HOPER1A(NCX2,ID2,ID3,C2)
- ENDIF
- CALL HFIND(ID3,'HOPERA')
- LC3=LQ(LCID-1)
- IQ(LC3+KNOENT)=N1+N2
- GO TO 99
- ENDIF
- 12 IF(NCX1.NE.NCX2.OR.NCX1.NE.NCX3)GO TO 90
- LPRX=LCID+KNCX
- CALL HOPER1(KOP,NCX1,LQ(LR1-1),LQ(LR2-1),LQ(LCID-1),C1,C2,IBE)
- GO TO 99
- ENDIF
-*
-*=====> 2-DIM histogram
-*
- IF(I230.NE.0)THEN
- NCX1=IQ(LR1+KNCX)
- NCY1=IQ(LR1+KNCY)
- NCX2=IQ(LR2+KNCX)
- NCY2=IQ(LR2+KNCY)
- NCX3=IQ(LCID+KNCX)
- NCY3=IQ(LCID+KNCY)
- IF(NCX1.NE.NCX2.OR.NCX1.NE.NCX3)GO TO 90
- IF(NCY1.NE.NCY2.OR.NCY1.NE.NCY3)GO TO 90
- LC1=LQ(LR1-1)
- LC2=LQ(LR2-1)
- LC3=LQ(LCID-1)
- LW1=LQ(LC1)
- LW2=LQ(LC2)
- LW3=LQ(LC3)
- KN=IQ(LC1+KNOENT)+IQ(LC2+KNOENT)
- LCONT=LC3
- D1=C1*C1
- D2=C2*C2
- DO 30 I=0,NCX1+1
- DO 20 J=0,NCY1+1
- IF(I.GT.0.AND.I.LE.NCX1.AND.J.GT.0.AND.J.LE.NCY1)THEN
- KW=NCX1*(J-1)+I
- IF(LW3.EQ.0)KW=0
- ELSE
- KW=0
- ENDIF
- LSCAT=LC1
- NB=IQ(LSCAT+KNBIT)
- R1=HCXY(I,J,1)
- S1=ABS(R1)
- IF(LW1.NE.0.AND.KW.NE.0)THEN
- S1=Q(LW1+KW)
- ENDIF
- LSCAT=LC2
- NB=IQ(LSCAT+KNBIT)
- R2=HCXY(I,J,1)
- S2=ABS(R2)
- IF(LW2.NE.0.AND.KW.NE.0)THEN
- S2=Q(LW2+KW)
- ENDIF
- LSCAT=LC3
- NB=IQ(LSCAT+KNBIT)
- IF(KOP.EQ.1)THEN
- R3=C1*R1+C2*R2
- IF(KW.NE.0)THEN
- S3=D1*S1+D2*S2
- ENDIF
- ELSEIF(KOP.EQ.2)THEN
- R3=C1*R1-C2*R2
- IF(KW.NE.0)THEN
- S3=D1*S1+D2*S2
- ENDIF
- ELSEIF(KOP.EQ.3)THEN
- R3=C1*R1*C2*R2
- IF(KW.NE.0)THEN
- S3=D1*D2*(S1*R2*R2+S2*R1*R1)
- ENDIF
- ELSEIF(KOP.EQ.4)THEN
- DIV=C2*R2
- IF(DIV.NE.0.)THEN
- R3=C1*R1/DIV
- IF(KW.NE.0)THEN
- IF(IBE.EQ.0)THEN
- S3=D1*D2*(S1*R2*R2+S2*R1*R1)/DIV**4
- ELSE
- S3=ABS(R3*(1.-R3)/DIV)
- ENDIF
- ENDIF
- ELSE
- R3=0.
- S3=0.
- ENDIF
- ENDIF
- CALL HFCXY(I,J,R3)
- IF(KW.NE.0)THEN
- Q(LW3+KW)=S3
- ENDIF
- 20 CONTINUE
- 30 CONTINUE
- IQ(LC3+KNOENT)=KN
-*
-* PROX
-*
- LPRX=LCID+KNCX
- CALL HOPER1(KOP,NCX1,LQ(LR1-2),LQ(LR2-2),LQ(LCID-2),C1,C2,IBE)
-*
-* PROY
-*
- LPRX=LCID+KNCY
- CALL HOPER1(KOP,NCY1,LQ(LR1-3),LQ(LR2-3),LQ(LCID-3),C1,C2,IBE)
-*
-* SLIX
-*
- LSLIX=LQ(LCID-4)
- LC1=LQ(LR1-4)
- LC2=LQ(LR2-4)
- LPRX=LCID+KNCX
- IF(LSLIX.NE.0)THEN
- DO 40 I=1,IQ(LSLIX-2)
- CALL HOPER1(KOP,NCX1,LQ(LC1-I),LQ(LC2-I),LQ(LSLIX-I)
- + ,C1,C2,IBE)
- 40 CONTINUE
- ENDIF
-*
-* SLIY
-*
- LSLIY=LQ(LCID-5)
- LC1=LQ(LR1-5)
- LC2=LQ(LR2-5)
- LPRX=LCID+KNCY
- IF(LSLIY.NE.0)THEN
- DO 50 I=1,IQ(LSLIY-2)
- CALL HOPER1(KOP,NCY1,LQ(LC1-I),LQ(LC2-I),LQ(LSLIY-I)
- + ,C1,C2,IBE)
- 50 CONTINUE
- ENDIF
-*
-* BANX
-*
- LBANX=LQ(LCID-6)
- LC1=LQ(LR1-6)
- LC2=LQ(LR2-6)
- LPRX=LCID+KNCX
- 60 IF(LBANX.NE.0)THEN
- CALL HOPER1(KOP,NCX1,LQ(LC1-1),LQ(LC2-1),LQ(LBANX-1)
- + ,C1,C2,IBE)
- LBANX=LQ(LBANX)
- IF(LBANX.NE.0)THEN
- LC1=LQ(LC1)
- IF(LC1.NE.0)THEN
- LC2=LQ(LC2)
- IF(LC2.NE.0)GO TO 60
- ENDIF
- ENDIF
- ENDIF
-*
-* BANY
-*
- LBANY=LQ(LCID-7)
- LC1=LQ(LR1-7)
- LC2=LQ(LR2-7)
- LPRX=LCID+KNCY
- 70 IF(LBANY.NE.0)THEN
- CALL HOPER1(KOP,NCY1,LQ(LC1-1),LQ(LC2-1),LQ(LBANY-1)
- + ,C1,C2,IBE)
- LBANY=LQ(LBANY)
- IF(LBANY.NE.0)THEN
- LC1=LQ(LC1)
- IF(LC1.NE.0)THEN
- LC2=LQ(LC2)
- IF(LC2.NE.0)GO TO 70
- ENDIF
- ENDIF
- ENDIF
- ENDIF
- GO TO 99
-*
- 90 CALL HBUG('Histograms with different specifications','HOPERA',ID1)
-*
- 99 RETURN
- END
diff --git a/src/packlib/hbook/code/hoptpf.F b/src/packlib/hbook/code/hoptpf.F
deleted file mode 100644
index c466a02..0000000
--- a/src/packlib/hbook/code/hoptpf.F
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: hoptpf.F,v 1.1.1.1 1996/01/16 17:07:44 mclareni Exp $
-*
-* $Log: hoptpf.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:44 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-#if defined(CERNLIB_CZ)
-*CMZ : 4.21/05 29/11/93 15.21.22 by Fons Rademakers
-*-- Author : Fons Rademakers 29/11/93
- SUBROUTINE HOPTPF
-*.==========>
-*. Send HCOPT options to PIAF
-*..=========> ( A.A.Rademakers )
-*
-#include "hbook/hcopt.inc"
-#include "hbook/hcpiaf.inc"
-*
- IF (CONNPF) THEN
- WRITE(CHSMPF,'(A,10I5)') 'HCOPT:',(ICOPT(I),I=1,10)
- CALL CZPUTA(CHSMPF,ISTAT)
- ENDIF
-*
- END
-#endif
diff --git a/src/packlib/hbook/code/houtpf.F b/src/packlib/hbook/code/houtpf.F
deleted file mode 100644
index 94e801c..0000000
--- a/src/packlib/hbook/code/houtpf.F
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: houtpf.F,v 1.1.1.1 1996/01/16 17:07:44 mclareni Exp $
-*
-* $Log: houtpf.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:44 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-#if defined(CERNLIB_CZ)
-*CMZ : 4.20/05 22/08/93 11.52.15 by Fons Rademakers
-*-- Author : Alfred Nathaniel 14/04/93
- SUBROUTINE HOUTPF(IDH)
-*
-* Send a histogram.
-* Set bit 6 in status word to 1. This bit will be reset to 0 by any
-* filling routine. This bit can be checked to prevent sending an unchanged
-* histogram again.
-*
-#include "hbook/hcbook.inc"
-
- NRHIST=IQ(LCDIR+KNRH)
- IDPOS=LOCATI(IQ(LTAB+1),NRHIST,IDH)
- LBANK=LQ(LTAB-IDPOS)
- CALL FZOUT(998,IHDIV,LBANK,1,' ',0,0,0)
- CALL SBIT1(IQ(LBANK),6)
-
- END
-#endif
diff --git a/src/packlib/hbook/code/houtpu.F b/src/packlib/hbook/code/houtpu.F
deleted file mode 100644
index 3fc8235..0000000
--- a/src/packlib/hbook/code/houtpu.F
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: houtpu.F,v 1.1.1.1 1996/01/16 17:07:44 mclareni Exp $
-*
-* $Log: houtpu.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:44 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.10/05 21/02/89 16.14.51 by Rene Brun
-*-- Author :
- SUBROUTINE HOUTPU(LOUTF)
-*.==========>
-*. FILE OUTPUT IS LOUTF
-*..=========> ( R.Brun )
-#include "hbook/hcunit.inc"
-*.___________________________________________
- LOUT=LOUTF
- END
diff --git a/src/packlib/hbook/code/hp1dim.F b/src/packlib/hbook/code/hp1dim.F
deleted file mode 100644
index 376321d..0000000
--- a/src/packlib/hbook/code/hp1dim.F
+++ /dev/null
@@ -1,288 +0,0 @@
-*
-* $Id: hp1dim.F,v 1.1.1.1 1996/01/16 17:07:44 mclareni Exp $
-*
-* $Log: hp1dim.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:44 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.10/05 23/08/89 18.05.35 by Rene Brun
-*-- Author :
- SUBROUTINE HP1DIM(C,E,F,N,XMIN,XMAX,NLINE)
-*.==========>
-*. PRINTS HIST VERTICALLY
-*..=========> ( R.Brun )
-#include "hbook/hcbits.inc"
-#include "hbook/hcprin.inc"
- COMMON/HCGARB/YUP,YLOW,ETOP,EDOWN,IZERO,YL,YR,K,Y0,Y1,
- + BH,BL,BWID,NBB,Y,XS,GA
- COMMON/HFORM/IFORM(128)
- DIMENSION C(1),E(1),F(1),KY(9),ITAB(110)
- EQUIVALENCE (KY(1),IFORM(4)),(ITAB(1),IFORM(16))
- SAVE AK,IBIG
- DATA AK/10000./
- DATA IBIG/1000000/
-*.___________________________________________
-*
-* GET SCALE
-*
- IF(XMIN.EQ.0..AND.XMAX.EQ.0.)RETURN
- IF(XMIN.GT.XMAX)RETURN
- IF(I34.NE.0)THEN
- ETOP=-BIGP
- EDOWN=BIGP
- DO 5 I=1,N
- BH=C(I)+E(I)
- BL=C(I)-E(I)
- IF(BH.GT.ETOP)ETOP=BH
- IF(BL.LT.EDOWN)EDOWN=BL
- 5 CONTINUE
- ENDIF
-*
- IF(I20.EQ.0)THEN
- IF(I34.NE.0)XMAX=ETOP
- IF(I12.NE.0)THEN
- YUP=VMAX(F,N)
- XMAX=MAX(YUP,XMAX)
- ENDIF
- ENDIF
- IF(I21.EQ.0)THEN
- IF(I34.NE.0)XMIN=EDOWN
- IF(I12.NE.0)THEN
- YLOW=VMIN(F,N)
- XMIN=MIN(YLOW,XMIN)
- ENDIF
- ENDIF
- Y0=XMIN
-*-* IF(XMAX.EQ.0.)XMAX=-0.000001
- Y1=XMAX
- IF(I26.NE.0)THEN
- IF(XMAX.LE.0)RETURN
- Y1=LOG10(XMAX)
- AL10=LOG(10.)
- IF(XMIN.LE.0.)THEN
- XMIN=BIGP
- DO 40 J=1,N
- IF(C(J).LT.XMIN.AND.C(J).GT.0.)XMIN=C(J)
- 40 CONTINUE
- ENDIF
- Y0=LOG10(0.9999999*XMIN)
- ENDIF
-*
- CALL HBIN(Y0,Y1,NLINE,BL,BH,NBB,BWID)
-*
- IF(BWID.GE.5.)GO TO 70
- IF(I24.EQ.0)GO TO 70
- IF(I26.NE.0)GO TO 70
-*
-* H1EVLI CALLED STEP MUST BE INTEGER
-*
- XS=1.
- IF(BWID.EQ.2.5)XS=.625
- IF(BWID.EQ.1.5)XS=.75
- IF(BWID.LT.1.) XS=BWID
- BWID=BWID/XS
- BL=BL-MOD(BL,BWID)
- IF(BL.GT.XMIN)BL=BL-BWID
- BH=BH-MOD(BH,BWID)
- IF(BH.LT.XMAX)BH=BH+BWID
- NBB=(BH-BL)/BWID +0.00001
- 70 CALL VBLANK(IFORM,128)
- IF(BL*BH.LT.0.)NBB=NBB+1
- IF(BH.LT.0.)BH=BH-BWID
-*
- NL=0
- 100 NL=NL+1
- IF(NL.GT.NBB)GO TO 99
-*
- CALL VBLANK(ITAB,N)
-*
- YUP=BH+FLOAT(1-NL)*BWID
- YLOW=YUP-BWID
- IF(I26.NE.0)THEN
- YUP=EXP(YUP*AL10)
- IF(YUP.LT.XMIN)GO TO 99
- YLOW=EXP(YLOW*AL10)
- ENDIF
- IF(YUP.LT.0.)GO TO 300
- IF(XMAX.LT.0.)NBB=NBB+1
- IF(XMAX.LT.0.)GO TO 100
- IF(YLOW.LE.-0.000001)THEN
- CALL VFILL(ITAB,N,IDG(39))
- GO TO 420
- ENDIF
- IUP=AK*YUP+0.5
- ILOW=AK*YLOW+0.5
- XS=YUP-YLOW
-*
- IF(I34.NE.0)GO TO 180
- IF(I27.NE.0)GO TO 130
- IF(I28.NE.0)GO TO 160
-*
-* NORMAL CONTOUR HISTOGRAM
-*
- DO 120 J=1,N
- IF(C(J).LE.0.)GO TO 120
- I=AK*C(J)+0.5
- IF(I.LE.ILOW)GO TO 120
- IF(I.LE.IUP)THEN
- ITAB(J)=IDG(39)
- ELSE
- ITAB(J)=IDG(19)
- IL=-IBIG
- IF(J.NE.1)IL=AK*(C(J-1)-XS)+0.5
- IR=-IBIG
- IF(J.NE.N)IR=AK*(C(J+1)-XS)+0.5
- IF(ILOW.LT.IL.AND.ILOW.LT.IR)ITAB(J)=IDG(41)
- ENDIF
- 120 CONTINUE
- GO TO 200
-*
-* BLACK HISTOGRAM
-*
- 130 CONTINUE
- DO 150 J=1,N
- IF(C(J).LE.0.)GO TO 150
- I=AK*C(J)+0.5
- IF(I.LE.ILOW)GO TO 150
- IF(I.GT.IUP)GO TO 140
-*
-* COMPUTES PERCENTAGE CHARACTER
-*
- K=10.*(C(J)-YLOW)/XS+1.001
- IF(K.GT.10)GO TO 140
- ITAB(J)=IDG(K)
- GO TO 150
- 140 ITAB(J)=ICBLAC
- 150 CONTINUE
- GO TO 200
-*
-* STAR HISTOGRAM
-*
- 160 CONTINUE
- DO 170 J=1,N
- IF(C(J).LE.0.)GO TO 170
- I=AK*C(J)+0.5
- IF(I.LE.ILOW)GO TO 170
- IF(I.GT.IUP)GO TO 170
- ITAB(J)=ICSTAR
- 170 CONTINUE
- GO TO 200
-*
-* ERROR BARS
-*
- 180 CONTINUE
- DO 190 J=1,N
- Y=C(J)
- IF(Y.EQ.0..AND.E(J).EQ.0.)GO TO 190
- ETOP=Y+E(J)
- EDOWN=Y-E(J)
- IF(EDOWN.GT.YUP)GO TO 190
- IF(ETOP.LE.YLOW)GO TO 190
- IF(ETOP.EQ.0.)GO TO 190
- IF(E(J).NE.0.)ITAB(J)=IDG(19)
- IF(Y.GT.YLOW.AND.Y.LE.YUP)ITAB(J)=IDG(1)
- 190 CONTINUE
-*
-* FUNCTION SUPERIMPOSED
-*
- 200 IF(I12.EQ.0)GO TO 420
- DO 210 J=1,N
- Y=F(J)
- IF(Y.LE.0.)GO TO 210
- IF(Y.LE.YLOW)GO TO 210
- IF(Y.GT.YUP)GO TO 210
- ITAB(J)=ICFUNC
- 210 CONTINUE
- GO TO 420
-*
-*
-* CONTENTS ARE NEGATIVE
-*
- 300 IUP=AK*YUP-0.5
- ILOW=AK*YLOW-0.5
- IF(I34.NE.0)GO TO 380
- IF(I27.NE.0)GO TO 330
- IF(I28.NE.0)GO TO 360
-*
-* NORMAL CONTOUR HISTOGRAM
-*
- DO 320 J=1,N
- IF(C(J).GE.0.)GO TO 320
- I=AK*(C(J)-BWID)-0.5
- IF(I.GE.IUP)GO TO 320
- IF(I.GE.ILOW)THEN
- ITAB(J)=IDG(39)
- ELSE
- ITAB(J)=IDG(19)
- IL=IBIG
- IF(J.NE.1)IL=AK*C(J-1)-0.5
- IR=IBIG
- IF(J.NE.N)IR=AK*C(J+1)-0.5
- IF(IUP.GT.IL.AND.IUP.GT.IR)ITAB(J)=IDG(41)
- ENDIF
- 320 CONTINUE
- GO TO 400
-*
-* BLACK HISTOGRAM
-*
- 330 CONTINUE
- DO 350 J=1,N
- IF(C(J).GE.0.)GO TO 350
- I=AK*(C(J)-BWID)-0.5
- IF(I.LE.ILOW)GO TO 340
- IF(I.GE.IUP)GO TO 350
-*
- K=10.*(YUP-C(J)+BWID)/BWID+1.001
- IF(K.GT.10)GO TO 340
- ITAB(J)=IDG(K)
- GO TO 350
- 340 ITAB(J)=ICBLAC
- 350 CONTINUE
- GO TO 400
-*
-* STAR HISTOGRAM
-*
- 360 CONTINUE
- DO 370 J=1,N
- IF(C(J).GE.0.)GO TO 370
- I=AK*(C(J)-BWID)-0.5
- IF(I.LT.ILOW)GO TO 370
- IF(I.GE.IUP)GO TO 370
- ITAB(J)=ICSTAR
- 370 CONTINUE
- GO TO 400
-*
-* ERROR BARS
-*
- 380 CONTINUE
- DO 390 J=1,N
- IF(C(J).EQ.0..AND.E(J).EQ.0.)GO TO 390
- Y=C(J)-BWID
- ETOP=Y+E(J)
- EDOWN=Y-E(J)
- IF(EDOWN.GE.YUP)GO TO 390
- IF(ETOP.LT.YLOW)GO TO 390
- IF(EDOWN.EQ.-BWID)GO TO 390
- IF(E(J).NE.0.)ITAB(J)=IDG(19)
- IF(Y.GE.YLOW.AND.Y.LT.YUP)ITAB(J)=IDG(1)
- 390 CONTINUE
-*
-* FUNCTION SUPERIMPOSED
-*
- 400 IF(I12.EQ.0)GO TO 420
- DO 410 J=1,N
- IF(F(J).GE.0.)GO TO 410
- Y=F(J)-BWID
- IF(Y.LT.YLOW)GO TO 410
- IF(Y.GE.YUP)GO TO 410
- ITAB(J)=ICFUNC
- 410 CONTINUE
-*
- 420 CALL HBCDF(YUP,9,KY)
- CALL HFORMA(1)
- GO TO 100
-*
- 99 RETURN
- END
diff --git a/src/packlib/hbook/code/hp1rot.F b/src/packlib/hbook/code/hp1rot.F
deleted file mode 100644
index 04a847d..0000000
--- a/src/packlib/hbook/code/hp1rot.F
+++ /dev/null
@@ -1,412 +0,0 @@
-*
-* $Id: hp1rot.F,v 1.1.1.1 1996/01/16 17:07:45 mclareni Exp $
-*
-* $Log: hp1rot.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:45 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.22/11 23/08/94 14.17.45 by Rene Brun
-*-- Author :
- SUBROUTINE HP1ROT(C,E,F,IDME,XMIN,XMAX,X0,XSIZE,ISIGNE,IEXP1,
- +IEXP2,D,B)
-*.==========>
-*. THIS ROUTINE PRINTS ONE LINE OF A 1-DIM HISTOGRAM
-*. IF THE USER HAS CALLED HROTAT .
-*. PRINTS ALSO AXIS AND LABELS AT BEGINNING AND END
-*..=========> ( R.Brun )
-#include "hbook/hcbits.inc"
-#include "hbook/hcprin.inc"
- COMMON/HFORM/IA(127),IDU
- DIMENSION A(127),B(1),D(1)
- EQUIVALENCE (A(1),IA(1))
- SAVE AL10,ICONT,MLOW,XLOW,MST,XINTEG,PAS
- SAVE CLAST,ELAST,FLAST,IOLD,ICHAN,ITERM,ICASE,NCOL,NLINE
- SAVE XMINI,XFIRST,IICHAN,IERMIN,IERMAX
- DATA AL10/2.30259/
-*.___________________________________________
- IF(IDME.GE.0)GO TO 120
- IF(I17.EQ.0)MSTEP=1
- MST=MSTEP/2+1
- IF(MOD(MSTEP,2).EQ.0)MST=MST-1
- ITERM=0
-*
-* ICONT=0 IF CONTOUR TO BE PRINTED
-*
- I27=I27*(1-I34)
- I28=I28*(1-I34)
- ICONT=I34+I27+I28
- IF(ICONT.NE.0)ITERM=1
- IOLD=0
- ICASE=1
- IF(I17.NE.0)ICASE=ICASE+4
- IF(I27.NE.0)ICASE=ICASE+1
- IF(I28.NE.0)ICASE=ICASE+2
- IF(I34.NE.0)ICASE=ICASE+3
-*
-* ICASE=1 CONTOUR HISTOGRAM ICASE=5 CONTOUR HISTOGRAM B
-* 2 BLACK 6 BLACK WITH BIGBIN
-* 3 STAR 7 STAR
-* 4 ERRORS 8 ERRORS
-*
- CLAST=C
- ELAST=E
- FLAST=F
-*
-* PRINTING OF LONGITUDINAL AXIS AND SCALE
-*
- NCOL=10*(3+I22+I31+I14-I29-I30-I15)
- NLINE=NCOLPA-NCOL
-*
-* DEFINITION OF CHARACTERS TO BE PRINTED (HBLACK,HCROSS)
-*
-*
- 5 CONTINUE
- IF(IDME.EQ.1)CALL HFORMA(2)
- CALL VZERO(A,NCOLPA)
- MLOW=0
- XINTEG=0.
- IF(I26.NE.0)GO TO 20
-*
-* DEFINITION SCALE LINEAR CASE
-*
- IF(IDME.EQ.1)GO TO 7
- PAS=(XMAX-XMIN)/FLOAT(NLINE)
- XMINI=XMIN
- XMAXI=XMAX
- CALL HBIN(XMIN,XMAX,NLINE,XMIN,XMAX,NLINE,PAS)
- IF(I24.EQ.0)GO TO 7
- IF(PAS.GT.1.)GO TO 7
- PAS=1.
- XMIN=XMINI
- XMAX=XMAXI
- NLINE=XMAX-XMIN+1.
- 7 N=0
- DO 10 I=1,NLINE,4
- N=N+1
- 10 A(N)=XMIN+FLOAT(I-1)*PAS
- GO TO 40
-*
-* DEFINITION SCALE LOGAR CASE
-*
- 20 IF(IDME.NE.1)THEN
- XFIRST=LOG10(XMIN)
- XLAST=LOG10(XMAX)
- PAS=LOG10(XMAX/XMIN)/FLOAT(NLINE)
- CALL HBIN(XFIRST,XLAST,NLINE,XFIRST,XLAST,NLINE,PAS)
- XMIN=EXP(AL10*XFIRST)
- XMAX=EXP(AL10*XLAST)
- ENDIF
- N=0
- DO 30 I=1,NLINE,4
- N=N+1
- XLAST=XFIRST+FLOAT(I-1)*PAS
- A(N)=EXP(AL10*XLAST)
- 30 CONTINUE
-*
- 40 ICHAN=4*N
- N=NCOL-7
- IMF=MSTEP
- XMAMI=XMAX
- IF(ABS(XMIN).GT.ABS(XMAX))XMAMI=XMIN
- CALL HPCONT(' ',A,ICHAN,7,XMAMI,D,N,B,ISIGNE,
- + IEXP1,IEXP2)
- MSTEP=IMF
- ICHAN=7
- IF(IDME.EQ.1)RETURN
-*
-* PRINT AXIS WITH LABELS
-*
- 45 N=1
- CALL VBLANK(IA,NCOLPA)
-*
-* LOW EDGE
-*
- IF(I15.NE.0)GO TO 50
- CALL UCTOH('LOW EDGE',IA(N+1),1,8)
- N=N+10
-*
-* INTEGRATION
-*
- 50 IF(I22.EQ.0)GO TO 60
- CALL UCTOH('INTEGRAT',IA(N+1),1,8)
- N=N+10
-*
-* FUNCTION
-*
- 60 IF(I14.EQ.0)GO TO 70
- IF(I12.EQ.0)GO TO 70
- CALL UCTOH('FUNCTION',IA(N+1),1,8)
- N=N+10
-*
-* ERRORS
-*
- 70 IF(I31.EQ.0)GO TO 80
- CALL UCTOH('ERRORS',IA(N+2),1,6)
- N=N+10
-*
-* CONTENTS
-*
- 80 IF(I30.NE.0)GO TO 90
- CALL UCTOH('CONTENTS',IA(N+1),1,8)
- N=N+10
-*
-* CHANNELS
-*
- 90 IF(I29.NE.0)GO TO 100
- CALL UCTOH('CHANNELS',IA(N+1),1,8)
- N=N+10
- 100 CONTINUE
-*
- ICHAN=N
-*
- DO 110 I=1,NLINE
- N=N+1
- 110 IA(N)=IDG(39)
-*
- DO 115 I=1,NLINE,4
- IA(ICHAN)=IDG(19)
- 115 ICHAN=ICHAN+4
-*
- CALL HFORMA(1)
- IF(IDME.EQ.1)GO TO 5
-*
-*
-* LOW EDGE
-*
- 120 CONTINUE
- IF(ICONT.EQ.0)THEN
- IF(IDME.EQ.-1)RETURN
- GO TO 122
- ENDIF
-*
-*
- 121 CLAST=C
- ELAST=E
- FLAST=F
- 122 MLOW=MLOW+1
- CALL VBLANK(IA,NCOLPA)
- N=0
- IF(I15.NE.0)GO TO 150
- IF(MSTEP.EQ.1)GO TO 125
- IF(MOD(MLOW,MSTEP).NE.1)GO TO 140
- 125 XLOW=X0
- IF(ITERM.EQ.1)XLOW=XLOW+XSIZE
- CALL HBCDF(XLOW,9,IA(N+1))
- IF(ABS(XLOW).LT.0.001)IA(N+5)=IDG(1)
- 140 N=N+10
-*
- 150 ICHAN=MLOW-MST
- IF(MOD(ICHAN,MSTEP).NE.0)GO TO 250
-*
-* INTEGRATION
-*
- IF(I22.EQ.0)GO TO 170
- XINTEG=XINTEG+CLAST
- CALL HBCDF(XINTEG,9,IA(N+1))
- N=N+10
-*
-* FUNCTION
-*
- 170 IF(I14.EQ.0)GO TO 190
- IF(I12.EQ.0)GO TO 190
- CALL HBCDF(FLAST,9,IA(N+1))
- N=N+10
-*
-* ERRORS
-*
- 190 IF(I31.EQ.0)GO TO 210
- CALL HBCDF(ELAST,9,IA(N+1))
- N=N+10
-*
-* CONTENTS
-*
- 210 IF(I30.NE.0)GO TO 230
- CALL HBCDF(CLAST,9,IA(N+1))
- N=N+10
-*
-* CHANNELS
-*
- 230 IF(I29.NE.0)GO TO 260
- N=N+3
- ICHAN=(MLOW+MST-1)/MSTEP
- IF(MOD(MSTEP,2).EQ.0)ICHAN=(MLOW+MST)/MSTEP
- CALL HBCDI(ICHAN,4,IA(N+1))
- N=N+7
- GO TO 260
-*
- 250 N=N+10*(2+I14+I22+I31-I29-I30)
-*
-* CALCULATION OF FUNCTION CHANNEL
-*
- 260 IFUNC=0
- IF(I12.EQ.0)GO TO 280
- IF(I26.NE.0)GO TO 270
- IFUNC=(FLAST-XMINI)/PAS
- GO TO 280
- 270 IF(FLAST/XMIN.LT.1.)GO TO 280
- IFUNC=LOG10(FLAST/XMIN)/PAS
-*
-* CALCULATION OF HISTOGRAM CHANNEL
-*
- 280 ICHAN=0
- XCHAN=0.
- INEW=0
- IF(IFUNC.LT.0)IFUNC=0
- IF(IFUNC.NE.0)IFUNC=IFUNC+2-I26
- IF(I26.EQ.0)THEN
- XCHAN=(CLAST-XMINI)/PAS
- ICHAN=XCHAN
- YCHAN=ICHAN
- IF(YCHAN.EQ.0.)YCHAN=1.
- IICHAN=10.*MOD(XCHAN,YCHAN)+1.0001
- IF(IICHAN.EQ.1)IICHAN=41
- INEW=(C-XMINI)/PAS
- IF(XMINI.NE.0..AND.INEW.EQ.0)INEW=INEW+1
- IF(XMINI.NE.0..AND.ICHAN.EQ.0)ICHAN=ICHAN+1
- IF(ICHAN.LT.0)ICHAN=0
- IF(INEW.LT.0)INEW=0
- ELSE
- IF(CLAST/XMIN.GE.1.)THEN
- XCHAN=LOG10(CLAST/XMIN)/PAS
- ICHAN=XCHAN
- YCHAN=ICHAN
- IF(YCHAN.EQ.0.)YCHAN=1.
- IICHAN=10.*MOD(XCHAN,YCHAN)+1.0001
- IF(IICHAN.EQ.1)IICHAN=41
- IF(CLAST.EQ.XMIN)ICHAN=1
- IF(CLAST.EQ.XMIN)IICHAN=34
- IF(C/XMIN.LT.1.)GO TO 300
- INEW=LOG10(C/XMIN)/PAS
- ENDIF
- ENDIF
-*
- 300 CONTINUE
- IF(XCHAN.GT.0.)ICHAN=ICHAN+2-I26
- IF(INEW.NE.0)INEW=INEW+2-I26
-*
-* NUMBER OF CHANNELS PRINTED FOR ERROR
-*
- IF(I34.EQ.0)GO TO 500
- IERMIN=0
- IERMAX=0
- IF(I26.NE.0)GO TO 350
- IF(ICHAN.EQ.0)GO TO 4500
- IERMIN=(CLAST-E-XMINI)/PAS+2.
- IERMAX=(CLAST+E-XMINI)/PAS+2.
- ICHAN=(IERMIN+IERMAX)/2
- GO TO 400
- 350 XCHAN=(CLAST-E)/XMIN
- IF(XCHAN.LE.1.)GO TO 360
- IERMIN=LOG10(XCHAN)/PAS +1.
- 360 YCHAN=(CLAST+E)/XMIN
- IF(YCHAN.LE.1.)GO TO 400
- IERMAX=LOG10(YCHAN)/PAS +1.
-*
- 400 IF(IERMIN.LE.0)IERMIN=1
- IF(IERMAX.LE.0)IERMAX=1
-*
- 500 IF(IFUNC.GT.NLINE)IFUNC=NLINE
- IF(ICHAN.GT.NLINE)ICHAN=NLINE
- IF(INEW.GT.NLINE)INEW=NLINE
- IF(IERMIN.GT.NLINE)IERMIN=NLINE
- IF(IERMAX.GT.NLINE)IERMAX=NLINE
- IF(ICHAN.LE.0)GO TO 8500
-*
-*
- GO TO(1000,2000,3000,4000,1000,6000,7000,8000),ICASE
-*
-*
-*
- 1000 I=2
- J=2
- K=2
- IF(IOLD.LT.ICHAN)I=1
- IF(IOLD.GT.ICHAN)I=3
- IF(INEW.LT.ICHAN)K=1
- IF(INEW.GT.ICHAN)K=3
- I=10*I+J+K-2
- K=MOD(I,10)
- J=MOD(I,100)-K
- J=J/10
- J=2*J-1
- IF(J.EQ.1)J=0
- IF(J.EQ.5)J=6
- I=J+K
- IF(I.EQ.1.AND.INEW.LT.IOLD)I=4
-*
- GO TO (1121,1121,1121,1221,1222,1222,1221,1222,1222),I
-*
- 1121 I=IOLD
- IF(I.EQ.0)I=1
- CALL VFILL(IA(N+I),ICHAN-I+1,IDG(39))
- IA(N+ICHAN)=IDG(19)
- GO TO 8500
- 1221 I=INEW
- IF(I.EQ.0)I=1
- CALL VFILL(IA(N+I),ICHAN-I+1,IDG(39))
- 1222 IA(N+ICHAN)=IDG(19)
-*
- GO TO 8500
-*
-*
- 2000 CONTINUE
-* BLACK HISTOGRAM
-*
- CALL VFILL(IA(N+1),ICHAN,ICBLAC)
- IA(N+ICHAN)=IDG(IICHAN)
- GO TO 4500
-*
-* STAR HISTOGRAM
-*
- 3000 IA(N+ICHAN)=ICSTAR
- GO TO 4500
-*
- 4000 CONTINUE
-*
-* HISTOGRAM WITH ERRORS
-*
- CALL VFILL(IA(N+IERMIN),IERMAX-IERMIN+1,IDG(39))
- IA(N+IERMIN)=IDG(19)
- IA(N+IERMAX)=IDG(19)
- IA(N+ICHAN)=IDG(25)
-*
- 4500 IF(I12.EQ.0)GO TO 9000
- IF(IFUNC.NE.0)IA(N+IFUNC)=ICFUNC
- GO TO 9000
-*
-* SAME FOR HISTOGRAM WITH BIGBIN
-*
-*
- 6000 CONTINUE
- CALL VFILL(IA(N+1),ICHAN,IDG(34))
- IA(N+ICHAN)=IDG(IICHAN)
- GO TO 8500
-*
- 7000 CONTINUE
- IA(N+ICHAN)=ICSTAR
- GO TO 8500
-*
- 8000 IF(MOD(MLOW-MST,MSTEP).NE.0)GO TO 9000
- CALL VFILL(IA(N+IERMIN),IERMAX-IERMIN+1,IDG(39))
- IA(N+IERMIN)=IDG(19)
- IA(N+IERMAX)=IDG(19)
- IA(N+ICHAN)=IDG(25)
-*
- 8500 IF(I12.EQ.0)GO TO 9000
- IF(MOD(MLOW-MST,MSTEP).NE.0)GO TO 9000
- IF(IFUNC.NE.0)IA(N+IFUNC)=ICFUNC
-*
- 9000 CALL HFORMA(1)
-*
- IOLD=ICHAN
- CLAST=C
- ELAST=E
- FLAST=F
- IF(IDME.NE.1)RETURN
- IF(ITERM.EQ.1)GO TO 45
- ITERM=1
- GO TO 121
-*
- END
diff --git a/src/packlib/hbook/code/hpaff.F b/src/packlib/hbook/code/hpaff.F
deleted file mode 100644
index b7105af..0000000
--- a/src/packlib/hbook/code/hpaff.F
+++ /dev/null
@@ -1,50 +0,0 @@
-*
-* $Id: hpaff.F,v 1.1.1.1 1996/01/16 17:07:45 mclareni Exp $
-*
-* $Log: hpaff.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:45 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.22/11 23/08/94 14.17.45 by Rene Brun
-*-- Author :
- SUBROUTINE HPAFF(CH,NL,CHPATH)
-*.==========>
-*. HPAFF reconstructs into the character variable CHPATH the pathname
-*. stored into the character array CH.
-*. where NL is the number of levels starting from the root directory
-*.
-*. Input:
-*. CH Character array of NL elements
-*. Output:
-*. *CHPATH* Character variable specifying the pathname
-*..=========> ( R.Brun )
-#include "hbook/hcmail.inc"
- CHARACTER*(*) CHPATH,CH(*)
- CHARACTER*16 CHL
-*.___________________________________________
- MAXLEN=LEN(CHPATH)
- IF(MAXLEN.GT.110)MAXLEN=110
-*
- CHPATH='//'//CH(1)
- LENG=LENOCC(CHPATH)
- IF(LENG.EQ.2) THEN
- CHPATH='//HOME'
- LENG=6
- ENDIF
- IF(NL.EQ.1) GOTO 99
-*
- DO 20 I=2,NL
- CHL=CH(I)
- NMAX=LENOCC(CHL)
- IF(NMAX.EQ.0) GOTO 99
- IF(LENG+NMAX.GT.MAXLEN)NMAX=MAXLEN-LENG
- CHMAIL=CHPATH(1:LENG)//'/'//CHL(1:NMAX)
- CHPATH=CHMAIL
- LENG=LENG+NMAX+1
- IF(LENG.EQ.MAXLEN)GO TO 99
- 20 CONTINUE
-*
- 99 RETURN
- END
diff --git a/src/packlib/hbook/code/hpagsz.F b/src/packlib/hbook/code/hpagsz.F
deleted file mode 100644
index 759c133..0000000
--- a/src/packlib/hbook/code/hpagsz.F
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: hpagsz.F,v 1.1.1.1 1996/01/16 17:07:45 mclareni Exp $
-*
-* $Log: hpagsz.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:45 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.10/05 21/02/89 16.14.51 by Rene Brun
-*-- Author :
- SUBROUTINE HPAGSZ(NLINES)
-*.==========>
-*. Changes the number of lines per page
-*..=========> ( R.Brun )
-#include "hbook/hcprin.inc"
-*.___________________________________________
- NLINPA=NLINES
-*
- END
diff --git a/src/packlib/hbook/code/hpak.F b/src/packlib/hbook/code/hpak.F
deleted file mode 100644
index e0ccebe..0000000
--- a/src/packlib/hbook/code/hpak.F
+++ /dev/null
@@ -1,65 +0,0 @@
-*
-* $Id: hpak.F,v 1.1.1.1 1996/01/16 17:07:45 mclareni Exp $
-*
-* $Log: hpak.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:45 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.22/02 05/05/94 09.30.22 by Rene Brun
-*-- Author :
- SUBROUTINE HPAK(IDD,X)
-*.==========>
-*. Fill histogram with array X
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
-#include "hbook/hcbits.inc"
-#include "hbook/hcprin.inc"
- DIMENSION X(1)
-*.___________________________________________
- CALL HFIND(IDD,'HPAK ')
-*
- IF(LCID.EQ.0)GO TO 99
- CALL HDCOFL
- IF(I123.EQ.0)GO TO 40
- CALL SBIT0(IQ(LCID),5)
- NCX=IQ(LCID+KNCX)
- IQ(LCONT+KNOENT)=0
- IF(I1.NE.0)THEN
- NW=IQ(LCONT-1)-KCON1+1
- CALL VZERO(Q(LCONT+KCON1),NW)
- I7=JBIT(IQ(LCID+KBITS),7)
- IF(I7.NE.0)CALL VZERO(Q(LCONT+KSTAT1),6)
- LPRX=LCID+KNCX
- DO 10 I=1,NCX
- XX=FLOARG(X(I))
- CALL HFCX(I,XX)
- 10 CONTINUE
- IF(IQ(LCONT+KNOENT).LE.0)THEN
- IQ(LCONT+KNOENT)=NCX
- ENDIF
- ELSE
-*
- NW=IQ(LCONT-1)-KCON2+1
- CALL VZERO(Q(LCONT+KCON2),NW)
- NCY=IQ(LCID+KNCY)
- K=0
- DO 30 I=1,NCY
- DO 20 J=1,NCX
- K=K+1
- XX=FLOARG(X(K))
- CALL HFCXY(J,I,XX)
- 20 CONTINUE
- 30 CONTINUE
- IF(IQ(LCONT+KNOENT).LE.0)THEN
- IQ(LCONT+KNOENT)=NCX*NCY
- ENDIF
- ENDIF
- GO TO 99
-*
- 40 NW=IQ(LCID-1)
- CALL UCOPY(X,Q(LCID+1),NW)
-*
- 99 RETURN
- END
diff --git a/src/packlib/hbook/code/hpakad.F b/src/packlib/hbook/code/hpakad.F
deleted file mode 100644
index b19e902..0000000
--- a/src/packlib/hbook/code/hpakad.F
+++ /dev/null
@@ -1,61 +0,0 @@
-*
-* $Id: hpakad.F,v 1.2 1996/01/19 10:16:58 couet Exp $
-*
-* $Log: hpakad.F,v $
-* Revision 1.2 1996/01/19 10:16:58 couet
-* The number entries is reset to 0
-*
-* Revision 1.1.1.1 1996/01/16 17:07:45 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.23/01 20/02/95 09.49.50 by Julian Bunn
-*-- Author :
- SUBROUTINE HPAKAD(IDD,X)
-*.==========>
-*. Fill histogram with array X
-*. At the difference of HPAK which overwrites
-*. the current channel contents by the new values in X,
-*. HPAKAD adds the new values to the existing contents.
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
-#include "hbook/hcbits.inc"
- DIMENSION X(1)
-*.___________________________________________
- CALL HFIND(IDD,'HPAK ')
-*
- IF(LCID.EQ.0)GO TO 99
- CALL HDCOFL
- IF(I123.EQ.0)GO TO 99
- CALL SBIT0(IQ(LCID),5)
- NEOLD=IQ(LCONT+KNOENT)
- NCX=IQ(LCID+KNCX)
- IQ(LCONT+KNOENT)=0
- IF(I1.NE.0)THEN
- LPRX=LCID+KNCX
- DO 10 I=1,NCX
- XX=HCX(I,1) + X(I)
- CALL HFCX(I,XX)
- 10 CONTINUE
- IF(IQ(LCONT+KNOENT).LT.0)THEN
- IQ(LCONT+KNOENT)=NEOLD+NCX
- ENDIF
- ELSE
-*
- NCY=IQ(LCID+KNCY)
- K=0
- DO 30 I=1,NCY
- DO 20 J=1,NCX
- K=K+1
- XX=X(K) + HCXY(J,I,1)
- CALL HFCXY(J,I,XX)
- 20 CONTINUE
- 30 CONTINUE
- IF(IQ(LCONT+KNOENT).LT.0)THEN
- IQ(LCONT+KNOENT)=NEOLD+NCX*NCY
- ENDIF
- ENDIF
-*
- 99 RETURN
- END
diff --git a/src/packlib/hbook/code/hpake.F b/src/packlib/hbook/code/hpake.F
deleted file mode 100644
index 3ab8a4f..0000000
--- a/src/packlib/hbook/code/hpake.F
+++ /dev/null
@@ -1,56 +0,0 @@
-*
-* $Id: hpake.F,v 1.1.1.1 1996/01/16 17:07:45 mclareni Exp $
-*
-* $Log: hpake.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:45 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.22/05 20/06/94 10.39.31 by Rene Brun
-*-- Author :
- SUBROUTINE HPAKE(IDD,E)
-*.==========>
-*. Fills histogram (1-D or 2-D) with error bars
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
-#include "hbook/hcflag.inc"
-#include "hbook/hcbits.inc"
- DIMENSION E(1)
-*.___________________________________________
- CALL HFIND(IDD,'HPAKE ')
- IF(LCID.EQ.0)GO TO 99
- CALL HDCOFL
-*
-* 2-D histogram
-*
- IF(I230.NE.0)THEN
- LW=LQ(LCONT)
- IF(LW.EQ.0)THEN
- CALL HBAR2(IDD)
- IF(IERR.NE.0)GO TO 99
- LW=LQ(LCONT)
- ENDIF
- DO 20 I=1,IQ(LW-1)
- Q(LW+I)=E(I)*E(I)
- 20 CONTINUE
- CALL SBIT0(IQ(LCID),5)
- GO TO 99
- ENDIF
-*
-* 1-D histogram
-*
- IF(I9.EQ.0)THEN
- CALL HBARX(IDD)
- IF(IERR.NE.0)GO TO 99
- ENDIF
-*
- CALL SBIT0(IQ(LCID),5)
- LW=LQ(LCONT)
- NCX=IQ(LCID+KNCX)
- DO 30 I=1,NCX
- Q(LW+I)=E(I)*E(I)
- 30 CONTINUE
-*
- 99 RETURN
- END
diff --git a/src/packlib/hbook/code/hpakes.F b/src/packlib/hbook/code/hpakes.F
deleted file mode 100644
index c9f2bed..0000000
--- a/src/packlib/hbook/code/hpakes.F
+++ /dev/null
@@ -1,52 +0,0 @@
-*
-* $Id: hpakes.F,v 1.1.1.1 1996/01/16 17:07:45 mclareni Exp $
-*
-* $Log: hpakes.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:45 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 08/05/95 10.48.01 by Julian Bunn
-*-- Author : J.J.Bunn
- SUBROUTINE HPAKES(IDD,IX,IY,E)
-*.==========>
-*. Fills histogram IDD's channel (IX,IY) with error E
-*..=========> ( J.J.Bunn )
-#include "hbook/hcbook.inc"
-#include "hbook/hcflag.inc"
-#include "hbook/hcbits.inc"
- real E
-*.___________________________________________
- CALL HFIND(IDD,'HPAKE ')
- IF(LCID.EQ.0)GO TO 99
- CALL HDCOFL
-*
-* 2-D histogram
-*
- IF(I230.NE.0)THEN
- LW=LQ(LCONT)
- IF(LW.EQ.0)THEN
- CALL HBAR2(IDD)
- IF(IERR.NE.0)GO TO 99
- LW=LQ(LCONT)
- ENDIF
- NCX = IQ(LCID+KNCX)
- Q(LW+(IY-1)*NCX+IX) = E*E
- CALL SBIT0(IQ(LCID),5)
- GO TO 99
- ENDIF
-*
-* 1-D histogram
-*
- IF(I9.EQ.0)THEN
- CALL HBARX(IDD)
- IF(IERR.NE.0)GO TO 99
- ENDIF
-*
- CALL SBIT0(IQ(LCID),5)
- LW=LQ(LCONT)
- Q(LW+IX) = E*E
-*
- 99 RETURN
- END
diff --git a/src/packlib/hbook/code/hparam.F b/src/packlib/hbook/code/hparam.F
deleted file mode 100644
index ddff3f7..0000000
--- a/src/packlib/hbook/code/hparam.F
+++ /dev/null
@@ -1,290 +0,0 @@
-*
-* $Id: hparam.F,v 1.1.1.1 1996/01/16 17:07:45 mclareni Exp $
-*
-* $Log: hparam.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:45 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.22/08 04/07/94 08.57.13 by Rene Brun
-*-- Author :
- SUBROUTINE HPARAM (IDH,ICONTR,R2MINI,MAXPOW,COEFFI,ITERM,NCOEF)
-*.==========>
-*. MULTIDIMENSIONAL FIT PACKAGE - AUTHOR: D. LIENART
-*.==========>
-*. 1. COMMON /HCPAR1/
-*.
-*. IOPT SELECTS VARIOUS OPTIONS FOR THE FIT
-*. 1 ENABLES/DISABLES SUPERPOSITION OF PARAMETRI-
-*. ZATION ON HISTOGRAM
-*. 2 AMOUNT OF OUTPUT DESIRED
-*. 3 TYPE OF WEIGHTING
-*. 4 STANDARD ELEMENTARY FUNCTION TYPE
-*. 5 SELECTS BASIC FUNCTIONS CLASS
-*. 6 BASIC FUNCTION SELECTION MODE
-*. 7 REGRESSION MODE
-*. 8 NORMALIZATION TYPE
-*. ND NUMBER OF VARIABLES (DIM OF X-SPACE)
-*. NP NUMBER OF POINTS TO FIT
-*. NPMAX FIRST DIMENSION OF ARRAY X
-*. NBF NUMBER OF BASIC FUNCTIONS AFTER SELECTION
-*. NBFMAX NUMBER OF BASIC FUNCTIONS BEFORE SELECTION
-*. NEF NUMBER OF USER-DEFINED ELEMENTARY FUNCTIONS
-*. NCO NUMBER OF REGRESSORS
-*. NCOMAX MAXIMUM ALLOWED NUMBER OF REGRESSORS
-*.
-*.
-*. 2. COMMON /HCPAR2/
-*.
-*. COEFF COEFFICIENTS OF THE REGRESSORS
-*. IBASFT BASIC FUNCTIONS TABLE: IBASFT(I,J) GIVES THE
-*. NUMBER OF THE ELEMENTARY FUNCTION IN VARIABLE I
-*. AND REGRESSOR J FOLLOWED BY THE FUNCTION CLASS
-*. EACH BASIC FUNCTION IS EITHER A USER-GIVEN BASIC
-*. FUNCTION OR A PRODUCT OF ND ELEMENTARY FUNCTIONS
-*. XMIN MINIMUM X-VALUE FOR EACH VARIABLE (DIM)
-*. XMAX MAXIMUM " " "
-*. ALIM LOWER BOUNDS OF NORMALIZATION INTERVALS
-*. BLIM UPPER " " "
-*.
-*.
-*. 3. COMMON /HCPOUT/
-*.
-*. IFLAG STATUS FLAG
-*. RSSS RESIDUAL SUM OF SQUARES
-*. R2S MULTIPLE CORRELATION COEFFICIENT
-*. SECO STANDARD DEVIATIONS OF THE ESTIMATED COEFFICIENTS
-*. COMIN LOWER BOUND OF CONFIDENCE INTERVAL FOR COEFFICIENT
-*. COMAX UPPER " " " "
-*.
-*.
-*. 4. OTHER IMPORTANT DATA
-*.
-*. X INDEPENDENT VARIABLES
-*. Y DEPENDENT VARIABLE
-*. R2MIN MINIMUM ACCEPTABLE R2 (GOODNESS OF FIT TEST)
-*. EY ERRORS ON Y VARIABLE
-*. MAXPOW MAXIMUM DEGREE OF STANDARD POLYNOMIAL IN
-*. VARIABLE I
-*. SELLIM LIMITS THE NUMBER OF BASIC FUNCTIONS SELECTED BY
-*. LIMITING THE DEGREES OF THE STANDARD POLYNOMIALS
-*. WHICH MAKE UP A BASIC FUNCTION
-*. FLEVEL F-SIGNIFICANCE LEVEL USED FOR TESTING REJECTANCE OF
-*. ALREADY INCLUDED REGRESSORS (STEPWISE PROCEDURE)
-*.=========>
-*. CALLING SEQUENCE FOR 1- AND 2-DIM HISTOGRAMS
-*. MAIN ROUTINE, ORGANIZES WORKING SPACE IN /PAWC/ AND
-*. CONTROLS THE SUCCESSIVE STAGES OF THE FIT
-*..=========> ( R.Brun ,D.Lienart )
- DIMENSION MAXPOW(1),COEFFI(1),ITERM(1,1)
-#include "hbook/hcflag.inc"
-#include "hbook/hcbook.inc"
-#include "hbook/hcbits.inc"
-#include "hbook/hcunit.inc"
-#include "hbook/hcpar0.inc"
-#include "hbook/hcpar1.inc"
-#include "hbook/hcpar2.inc"
-#include "hbook/hcpout.inc"
- DIMENSION DQ(2)
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION DQ,COEFF,COEFFI,HRVAL
-#endif
- EQUIVALENCE (Q(1),DQ(1))
- EXTERNAL HRVAL
-*
-*
-* INITIALIZATIONS
-*
- IFLAG=-1
- CALL HFIND (IDH,'HPARAM')
- IF (LCID.EQ.0) THEN
- IFLAG=6
- RETURN
- ENDIF
- IF (IQ(LCONT+KNOENT).EQ.0) THEN
- IFLAG=6
- CALL HBUG('Empty histogram','HPARAM',ID)
- RETURN
- ENDIF
- CALL HDCOFL
- ND=1
- NX=IQ(LCID+KNCX)
- NY=1
- IF (I1.EQ.0) THEN
- ND=2
- NY=IQ(LCID+KNCY)
- ENDIF
- NPMAX=NX*NY
- NBF=0
- NBFMAX=500
- NEF=0
- NCOMAX=50
- ITAP=0
- ICONT=ICONTR
- DO 5 I=1,8
- IOPT(I)=ICONT-(ICONT/10)*10
- ICONT=ICONT/10
- 5 CONTINUE
- ISUP=0
- IF (IOPT(1).EQ.1.AND.ND.EQ.1) ISUP=1
- SELLIM=1.
- FLEVEL=1.
- R2MIN=R2MINI
- IF (IOPT(7).EQ.2) THEN
- R2MIN=1.5
- ELSE IF (R2MIN.GE.1.) THEN
- R2MIN=2.
- ENDIF
- IF (IOPT(5).GE.1) NEF=PNEF
- IF (IOPT(5).EQ.2.OR.IOPT(6).EQ.2) NBF=PNBF
- IF (PSEL.GT.0..AND.PSEL.LE.ND) SELLIM=PSEL
- IF (PFLV.GT.0..AND.PFLV.LT.1000.) FLEVEL=PFLV
- IF (PLUN.GT.0..AND.PLUN.LT.100.) ITAP=PLUN
- IF (PNBX.GT.0..AND.PNBX.LE.2000.) NBFMAX=PNBX
- IF (PNCX.GT.0..AND.PNCX.LE.50.) NCOMAX=PNCX
- NV=1
-#if !defined(CERNLIB_DOUBLE)
- IF (ISUP.EQ.1) CALL HFUNC (IDH,HRVAL)
-#endif
-#if defined(CERNLIB_DOUBLE)
- IF (ISUP.EQ.1) CALL HSUPIM (HRVAL)
-#endif
- NV=2
-*
-* RESERVE WORKING SPACE IN /PAWC/: SET START ADDRESSES
-*
- LXYE=(ND+2)*NPMAX
-#if !defined(CERNLIB_DOUBLE)
- LAHPAR=NPMAX+(ND+1)*NBFMAX+(3*NCOMAX+NPMAX+6)*NCOMAX+LXYE
-#endif
-#if defined(CERNLIB_DOUBLE)
- LAHPAR=2*NPMAX+(ND+1)*NBFMAX+(6*NCOMAX+2*NPMAX+11)*NCOMAX+LXYE
-#endif
- CALL HWORK (LAHPAR,ICO,'HPARAM')
- IF (ICO.EQ.0) THEN
- IFLAG=6
- RETURN
- ENDIF
-#if defined(CERNLIB_DOUBLE)
- IF ((ICO/2)*2.EQ.ICO) ICO=ICO+1
- IBF=ICO+(10+2*NPMAX+6*NCOMAX)*NCOMAX+2*NPMAX
- ICO=(ICO+1)/2
-#endif
- ICT=ICO+NCOMAX
- IW=ICT+NCOMAX
- IWT=IW+NPMAX*NCOMAX
- IWY=IWT+NPMAX
- IV=IWY+NCOMAX
- IVT=IV+NCOMAX*NCOMAX
- IVTT=IVT+NCOMAX*NCOMAX
- IDD=IVTT+NCOMAX*NCOMAX
- IFF=IDD+NCOMAX
-#if !defined(CERNLIB_DOUBLE)
- IBF=IFF+NCOMAX
-#endif
- IMB=IBF+ND*NBFMAX
- IBM=IMB+NBFMAX
- IX=IBM+NCOMAX
- IY=IX+ND*NPMAX
- IE=IY+NPMAX
-*
-* COPY HISTOGRAM INTO X,Y,E
-*
- CALL HHXYE (Q(IX),Q(IY),Q(IE))
- IF (IFLAG.EQ.6) RETURN
-*
-* PRINT OUT FIT OPTIONS AND CHARACTERISTICS
-*
- WRITE (LOUT,100)
- IF (IOPT(2).GE.1) THEN
- WRITE (LOUT,110) ID,ND,LAHPAR,NBF,NEF,NCOMAX,(MAXPOW(I),
- + I=1,ND)
- WRITE (LOUT,120) (IOPT(I),I=2,8),SELLIM,FLEVEL
- IF (ISUP.EQ.1) WRITE (LOUT,160)
- IF (ITAP.NE.0) WRITE (LOUT,170) ITAP
- IF (R2MIN.EQ.1.5) THEN
- WRITE (LOUT,130)
- ELSE
- IF (R2MIN.EQ.2.) THEN
- WRITE (LOUT,140)
- ELSE
- WRITE (LOUT,150) R2MIN
- ENDIF
- ENDIF
- ENDIF
- IF (IOPT(2).EQ.2) CALL HCORRL (Q(IX),Q(IY))
-*
-*
- IF (IOPT(3).EQ.0) THEN
- DO 10 I=1,NP
- Q(IY+I-1)=Q(IY+I-1)/Q(IE+I-1)
- 10 CONTINUE
- ENDIF
-*
-*
- IF (IOPT(8).GT.0) CALL HXNORM (Q(IX))
-*
-* SET UP BASIC FUNCTIONS TABLE
-*
- IF (IOPT(6).EQ.2) THEN
- CALL UCOPY (ITERM(1,1),IQ(IBF),ND*NBF)
- ELSE
- CALL HSETBF (IQ(IBF),MAXPOW,SELLIM)
- IF (IFLAG.EQ.5) RETURN
- ENDIF
-*
-*
-#if !defined(CERNLIB_DOUBLE)
- CALL HMUFIT (Q(IX),Q(IY),Q(IE),IQ(IBF),Q(IW),Q(IWT),Q(IWY),Q(IV),
- + Q(IVT),Q(IVTT),Q(IDD),Q(IFF),Q(ICO),Q(ICT),IQ(IMB),
- + IQ(IBM),R2MIN,FLEVEL)
-#endif
-#if defined(CERNLIB_DOUBLE)
- CALL HMUFIT (Q(IX),Q(IY),Q(IE),IQ(IBF),DQ(IW),DQ(IWT),DQ(IWY),
- + DQ(IV),DQ(IVT),DQ(IVTT),DQ(IDD),DQ(IFF),DQ(ICO),
- + DQ(ICT),IQ(IMB),IQ(IBM),R2MIN,FLEVEL)
-#endif
- NCOEF=NCO
- DO 20 I=1,NCO
-#if !defined(CERNLIB_DOUBLE)
- COEFF(I)=Q(ICO+I-1)
-#endif
-#if defined(CERNLIB_DOUBLE)
- COEFF(I)=DQ(ICO+I-1)
-#endif
- COEFFI(I)=COEFF(I)
- DO 15 K=1,ND
- IBASFT(K,I)=IQ(IBF+ND*(I-1)+K-1)
- 15 CONTINUE
- 20 CONTINUE
- CALL UCOPY (IQ(IBF),ITERM(1,1),ND*NCO)
- IF (ITAP.NE.0) CALL HWRITF (ITAP)
-#if !defined(CERNLIB_DOUBLE)
- IF (ISUP.EQ.1) CALL HFUNC (IDH,HRVAL)
-#endif
-#if defined(CERNLIB_DOUBLE)
- IF (ISUP.EQ.1) CALL HSUPIM (HRVAL)
-#endif
- 100 FORMAT (///,1X,40('*'),/,' *',38X,'*',/,' * MULTIDIMENSIONAL'
- + ,' PARAMETRIZATION *'/,' *',38X,'*'/,1X,40('*'))
- 110 FORMAT (//' FIT CHARACTERISTICS AND OPTIONS'/,1X,31('*'),/
- + /' ID = ',I3,/,' DIM = ',I2,/,' WORKING SPACE IN /PAWC/ = '
- + ,I7,/,1X,I2,' USER-DEFINED BASIC FUNCTIONS'/,1X,I2,
- + ' USER-DEFINED ELEMENTARY FUNCTIONS'/,' MAX NUMBER OF',
- + ' REGRESSORS = ',I2,/,' MAX POWERS OF POLYNOMIALS IN ',
- + ' EACH DIM = ',10(I2,2X))
- 120 FORMAT (' AMOUNT OF OUTPUT = ',I1,/,' WEIGHTING TYPE = '
- + ,I1,/,' CLASS OF POLYNOMIALS = ',I1,/,' CLASS OF BASIC'
- + ,' FUNCTIONS = ',I1,/,' BASIC FUNCTION SELECTION MODE = ',
- + I1,/,' REGRESSION MODE = ',I1,/,' X-NORMALIZATION TYPE = '
- + ,I1,/,' POWER LIMITOR = ',F5.2,/,' F-TEST LEVEL = ',F6.2)
- 130 FORMAT (/' FITTING PROCESS WILL STOP WHEN ALL CANDIDATE ',
- + 'BASIC FUNCTIONS ARE INCLUDED')
- 140 FORMAT (/' FITTING PROCESS WILL STOP WHEN THE RESIDUAL VARIANCE'
- + ,' HITS A MINIMUM')
- 150 FORMAT (/' FITTING PROCESS WILL STOP WHEN THE MULTIPLE ',
- + 'CORRELATION COEFFICIENT GETS HIGHER THAN ',F7.4)
- 160 FORMAT (' PARAMETRIZATION SUPERIMPOSED ON HISTOGRAM')
- 170 FORMAT (' FORTRAN CODE FPARAM WRITTEN ON UNIT ',I2)
- END
diff --git a/src/packlib/hbook/code/hparmn.F b/src/packlib/hbook/code/hparmn.F
deleted file mode 100644
index 26e0b55..0000000
--- a/src/packlib/hbook/code/hparmn.F
+++ /dev/null
@@ -1,177 +0,0 @@
-*
-* $Id: hparmn.F,v 1.1.1.1 1996/01/16 17:07:45 mclareni Exp $
-*
-* $Log: hparmn.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:45 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.17/02 08/12/92 08.41.57 by Rene Brun
-*-- Author :
- SUBROUTINE HPARMN (X,Y,EY,NPMX,NDIM,ICONTR,R2MINI,MAXPOW,
- + COEFFI,ITERM,NCOEF)
-*.==========>
-*. SEE HPARAM - CALLING SEQUENCE FOR N-DIM DISTRIBUTIONS
-*..=========> ( R.Brun D.Lienart )
- DIMENSION X(NPMX,NDIM),Y(1),EY(1),MAXPOW(1),COEFFI(1),ITERM(1,1)
-#include "hbook/hcbook.inc"
-#include "hbook/hcunit.inc"
-#include "hbook/hcpar0.inc"
-#include "hbook/hcpar1.inc"
-#include "hbook/hcpar2.inc"
-#include "hbook/hcpout.inc"
- DIMENSION DQ(2)
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION DQ,COEFF,COEFFI
-#endif
- EQUIVALENCE (Q(1),DQ(1))
-*
-* INITIALIZATIONS
-*
- IFLAG=-1
- ND=NDIM
- NPMAX=NPMX
- NP=NPMAX
- NBF=0
- NBFMAX=500
- NEF=0
- NCOMAX=50
- ITAP=0
- ICONT=ICONTR
- DO 5 I=1,8
- IOPT(I)=ICONT-(ICONT/10)*10
- ICONT=ICONT/10
- 5 CONTINUE
- SELLIM=1.
- FLEVEL=1.
- R2MIN=R2MINI
- IF (IOPT(7).EQ.2) THEN
- R2MIN=1.5
- ELSE IF (R2MIN.GE.1.) THEN
- R2MIN=2.
- ENDIF
- IF (IOPT(5).GE.1) NEF=PNEF
- IF (IOPT(5).EQ.2.OR.IOPT(6).EQ.2) NBF=PNBF
- IF (PSEL.GT.0..AND.PSEL.LE.ND) SELLIM=PSEL
- IF (PFLV.GT.0..AND.PFLV.LT.1000.) FLEVEL=PFLV
- IF (PLUN.GT.0..AND.PLUN.LT.100.) ITAP=PLUN
- IF (PNBX.GT.0..AND.PNBX.LE.2000.) NBFMAX=PNBX
- IF (PNCX.GT.0..AND.PNCX.LE.50.) NCOMAX=PNCX
-*
-* RESERVE WORKING SPACE IN /PAWC/: SET START ADDRESSES
-*
-#if !defined(CERNLIB_DOUBLE)
- LAHPAR=NPMAX+(ND+1)*NBFMAX+(3*NCOMAX+NPMAX+6)*NCOMAX
-#endif
-#if defined(CERNLIB_DOUBLE)
- LAHPAR=2*NPMAX+(ND+1)*NBFMAX+(6*NCOMAX+2*NPMAX+11)*NCOMAX
-#endif
- CALL HWORK (LAHPAR,ICO,'HPARMN')
- IF (ICO.EQ.0) THEN
- IFLAG=6
- RETURN
- ENDIF
-#if defined(CERNLIB_DOUBLE)
- IF ((ICO/2)*2.EQ.ICO) ICO=ICO+1
- IBF=ICO+(10+2*NPMAX+6*NCOMAX)*NCOMAX+2*NPMAX
- ICO=(ICO+1)/2
-#endif
- ICT=ICO+NCOMAX
- IW=ICT+NCOMAX
- IWT=IW+NPMAX*NCOMAX
- IWY=IWT+NPMAX
- IV=IWY+NCOMAX
- IVT=IV+NCOMAX*NCOMAX
- IVTT=IVT+NCOMAX*NCOMAX
- IDD=IVTT+NCOMAX*NCOMAX
- IFF=IDD+NCOMAX
-#if !defined(CERNLIB_DOUBLE)
- IBF=IFF+NCOMAX
-#endif
- IMB=IBF+ND*NBFMAX
- IBM=IMB+NBFMAX
-*
-* PRINT OUT FIT OPTIONS AND CHARACTERISTICS
-*
- WRITE (LOUT,100)
- IF (IOPT(2).GE.1) THEN
- WRITE (LOUT,110) ND,LAHPAR,NBF,NEF,NCOMAX,(MAXPOW(I),
- + I=1,ND)
- WRITE (LOUT,120) (IOPT(I),I=2,8),SELLIM,FLEVEL
- IF (ITAP.NE.0) WRITE (LOUT,160) ITAP
- IF (R2MIN.EQ.1.5) THEN
- WRITE (LOUT,130)
- ELSE
- IF (R2MIN.EQ.2.) THEN
- WRITE (LOUT,140)
- ELSE
- WRITE (LOUT,150) R2MIN
- ENDIF
- ENDIF
- ENDIF
- IF (IOPT(2).EQ.2) CALL HCORRL (X,Y)
-*
- IF (IOPT(3).EQ.0) THEN
- DO 10 I=1,NP
- IF (EY(I).NE.0.) Y(I)=Y(I)/EY(I)
- 10 CONTINUE
- ENDIF
-*
- IF (IOPT(8).GT.0) CALL HXNORM (X)
-*
-* SET UP BASIC FUNCTIONS TABLE
-*
- IF (IOPT(6).EQ.2) THEN
- CALL UCOPY (ITERM(1,1),IQ(IBF),ND*NBF)
- ELSE
- CALL HSETBF (IQ(IBF),MAXPOW,SELLIM)
- IF (IFLAG.EQ.5) RETURN
- ENDIF
-*
-#if !defined(CERNLIB_DOUBLE)
- CALL HMUFIT (X,Y,EY,IQ(IBF),Q(IW),Q(IWT),Q(IWY),Q(IV),
- + Q(IVT),Q(IVTT),Q(IDD),Q(IFF),Q(ICO),Q(ICT),IQ(IMB),
- + IQ(IBM),R2MIN,FLEVEL)
-#endif
-#if defined(CERNLIB_DOUBLE)
- CALL HMUFIT (X,Y,EY,IQ(IBF),DQ(IW),DQ(IWT),DQ(IWY),
- + DQ(IV),DQ(IVT),DQ(IVTT),DQ(IDD),DQ(IFF),DQ(ICO),
- + DQ(ICT),IQ(IMB),IQ(IBM),R2MIN,FLEVEL)
-#endif
- NCOEF=NCO
- DO 20 I=1,NCO
-#if !defined(CERNLIB_DOUBLE)
- COEFF(I)=Q(ICO+I-1)
-#endif
-#if defined(CERNLIB_DOUBLE)
- COEFF(I)=DQ(ICO+I-1)
-#endif
- COEFFI(I)=COEFF(I)
- DO 15 K=1,ND
- IBASFT(K,I)=IQ(IBF+ND*(I-1)+K-1)
- 15 CONTINUE
- 20 CONTINUE
- CALL UCOPY (IQ(IBF),ITERM(1,1),ND*NCO)
- IF (ITAP.NE.0) CALL HWRITF (ITAP)
- 100 FORMAT (///,1X,40('*'),/,' *',38X,'*',/,' * MULTIDIMENSIONAL'
- + ,' PARAMETRIZATION *'/,' *',38X,'*'/,1X,40('*'))
- 110 FORMAT (//' FIT CHARACTERISTICS AND OPTIONS'/,1X,31('*'),/
- + /,1X,I2,'-DIM DISTRIBUTION',/,' WORKING SPACE IN /PAWC/ = '
- + ,I7,/,1X,I2,' USER-DEFINED BASIC FUNCTIONS'/,1X,I2,
- + ' USER-DEFINED ELEMENTARY FUNCTIONS'/,' MAX NUMBER OF',
- + ' REGRESSORS = ',I2,/,' MAX POWERS OF POLYNOMIALS IN ',
- + ' EACH DIM = ',10(I2,2X))
- 120 FORMAT (' AMOUNT OF OUTPUT = ',I1,/,' WEIGHTING TYPE = '
- + ,I1,/,' CLASS OF POLYNOMIALS = ',I1,/,' CLASS OF BASIC'
- + ,' FUNCTIONS = ',I1,/,' BASIC FUNCTION SELECTION MODE = ',
- + I1,/,' REGRESSION MODE = ',I1,/,' X-NORMALIZATION TYPE = '
- + ,I1,/,' POWER LIMITOR = ',F5.2,/,' F-TEST LEVEL = ',F6.2)
- 130 FORMAT (/' FITTING PROCESS WILL STOP WHEN ALL CANDIDATE ',
- + 'BASIC FUNCTIONS ARE INCLUDED')
- 140 FORMAT (/' FITTING PROCESS WILL STOP WHEN THE RESIDUAL VARIANCE'
- + ,' HITS A MINIMUM')
- 150 FORMAT (/' FITTING PROCESS WILL STOP WHEN THE MULTIPLE ',
- + 'CORRELATION COEFFICIENT GETS HIGHER THAN ',F7.4)
- 160 FORMAT (' FORTRAN CODE FPARAM WRITTEN ON UNIT ',I2)
- END
diff --git a/src/packlib/hbook/code/hpath.F b/src/packlib/hbook/code/hpath.F
deleted file mode 100644
index 99f5351..0000000
--- a/src/packlib/hbook/code/hpath.F
+++ /dev/null
@@ -1,167 +0,0 @@
-*
-* $Id: hpath.F,v 1.1.1.1 1996/01/16 17:07:45 mclareni Exp $
-*
-* $Log: hpath.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:45 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.23/00 21/10/94 08.57.42 by Rene Brun
-*-- Author :
- SUBROUTINE HPATH(CHPATH)
-*.==========>
-*. HPATH decodes the character string CHPATH into a character
-*. array CHPAT(1),,CHPAT(NLPAT)
-*. ( NLPAT is the number of levels starting from the root directory)
-*.
-*. Input:
-*. *CHPATH* Character variable specifying the pathname
-*..=========> ( R.Brun )
-#include "hbook/hcunit.inc"
-#include "hbook/hcdire.inc"
- CHARACTER*(*) CHPATH
- CHARACTER*1 CH1,BSLASH
- CHARACTER*2 CH2
-*.___________________________________________
-#if defined(CERNLIB_BSLASH)
- BSLASH='\\'
-#endif
-#if !defined(CERNLIB_BSLASH)
- BSLASH='\'
-#endif
- NCHP=LEN(CHPATH)
- NLPAT=0
- 10 IF(CHPATH(NCHP:NCHP).EQ.' ')THEN
- NCHP=NCHP-1
- IF(NCHP.GT.0)GO TO 10
- NLPAT=NLCDIR
- DO 20 I=1,NLCDIR
- CHPAT(I)=CHCDIR(I)
- 20 CONTINUE
- GO TO 99
- ENDIF
-*
- IS1=1
- 30 IF(CHPATH(IS1:IS1).EQ.' ')THEN
- IS1=IS1+1
- GO TO 30
- ENDIF
-*
- CH1=CHPATH(IS1:IS1)
- IF(IS1.LT.NCHP)CH2=CHPATH(IS1:IS1+1)
- IF(CH1.EQ.'/')THEN
- IF(IS1.GE.NCHP)GO TO 90
- IF(CHPATH(IS1+1:IS1+1).EQ.'/')THEN
-*
-* Case where Path starts with //Topdirectory
-*
- IS=IS1+2
- IF(IS.GT.NCHP)GO TO 99
- 40 IF(CHPATH(IS:IS).EQ.'/')THEN
- IF(IS.EQ.IS1+2)GO TO 90
- NLPAT=1
- CHPAT(1)=CHPATH(IS1+2:IS-1)
- IS1=IS+1
- IS=IS1
- GO TO 50
- ELSE
- IS=IS+1
- IF(IS.LT.NCHP)GO TO 40
- NLPAT=1
- CHPAT(1)=CHPATH(IS1+2:IS)
- GO TO 99
- ENDIF
- ENDIF
-*
-* Case where Path starts just below topdirectory /a/b/c
-*
- IF(CHPATH(IS1+1:IS1+1).EQ.BSLASH)GO TO 90
- NLPAT=1
- CHPAT(1)=CHCDIR(1)
- IS=IS1+1
- IS1=IS
-*
- 50 IF(IS.EQ.NCHP)THEN
- IF(CHPATH(IS1:IS).NE.'..'.AND.
- + CHPATH(IS1:IS).NE.BSLASH) THEN
- NLPAT=NLPAT+1
- IF(NLPAT.GT.NLPATM)GO TO 90
- CHPAT(NLPAT)=CHPATH(IS1:IS)
- ELSE
- NLPAT = NLPAT -1
- ENDIF
- GO TO 99
- ELSE
- IF(CHPATH(IS:IS).EQ.'/')THEN
- IF(NLPAT.GT.NLPATM)GO TO 90
- IF(CHPATH(IS1:IS-1).NE.'..'.AND.
- + CHPATH(IS1:IS-1).NE.BSLASH) THEN
- NLPAT=NLPAT+1
- CHPAT(NLPAT)=CHPATH(IS1:IS-1)
- ELSE
- NLPAT = NLPAT - 1
- ENDIF
- IS1=IS+1
- ENDIF
- IS=IS+1
- GO TO 50
- ENDIF
- ENDIF
-*
-* Case where Path is relative to the working directory
-*
- DO 70 I=1,NLCDIR
- CHPAT(I)=CHCDIR(I)
- 70 CONTINUE
- NLPAT=NLCDIR
-*
- 75 IF(CH1.EQ.BSLASH)THEN
- NLPAT=NLPAT-1
- IF(NLPAT.EQ.0)NLPAT=1
- IF(IS1.EQ.NCHP)GO TO 99
- IS1=IS1+1
- CH1=CHPATH(IS1:IS1)
- GO TO 75
- ENDIF
-*
- IS=IS1
- 76 IF(CH2.EQ.'..')THEN
- NLPAT=NLPAT-1
- IF(NLPAT.EQ.0)NLPAT=1
- IF(IS1+1.EQ.NCHP)GO TO 99
- IF(CHPATH(IS1+2:IS1+2).NE.'/') GOTO 90
- IS =IS1
- IS1=IS1+3
- CH2=CHPATH(IS1:IS1+1)
- GO TO 76
- ENDIF
- 80 IF(IS.EQ.NCHP)THEN
- NLPAT=NLPAT+1
- IF(NLPAT.GT.NLPATM)GO TO 90
- CHPAT(NLPAT)=CHPATH(IS1:IS)
- GO TO 99
- ELSE
- IF(CHPATH(IS:IS).EQ.'/')THEN
- IF(IS.GT.IS1)THEN
- NLPAT=NLPAT+1
- IF(NLPAT.GT.NLPATM)GO TO 90
- CHPAT(NLPAT)=CHPATH(IS1:IS-1)
- ENDIF
- IS1=IS+1
- ENDIF
- IS=IS+1
- GO TO 80
- ENDIF
-*
-* Error in Pathname
-*
- 90 IS1=LEN(CHPATH)
- IF(IS1.GT.90)IS1=90
- WRITE(LOUT,1000)CHPATH(1:IS1)
- 1000 FORMAT(' HPATH. ERROR IN PATHNAME,',A)
- NLPAT=0
-*
- 99 RETURN
- END
-
diff --git a/src/packlib/hbook/code/hpchan.F b/src/packlib/hbook/code/hpchan.F
deleted file mode 100644
index 4bf0015..0000000
--- a/src/packlib/hbook/code/hpchan.F
+++ /dev/null
@@ -1,66 +0,0 @@
-*
-* $Id: hpchan.F,v 1.1.1.1 1996/01/16 17:07:45 mclareni Exp $
-*
-* $Log: hpchan.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:45 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.10/05 07/03/89 11.05.37 by Rene Brun
-*-- Author :
- SUBROUTINE HPCHAN(CCHAR,IMIN,IMAX,NN,A)
-*.==========>
-*. This routine prints the channel numbers
-*. MSTEP = Number of columns for a channel
-*. CCHAR=1H no UNDER,OVER printed
-*. CCHAR=1H1 only UNDER printed
-*. CCHAR=1H2 only OVER printed
-*. CCHAR=Anything except 1H ,1H1,1H2 UNDER,OVER printed
-*..=========> ( R.Brun )
-#include "hbook/hcunit.inc"
-#include "hbook/hcprin.inc"
- DIMENSION A(NN),UNDER(5),OVER(5),FLAG(8)
- DIMENSION C(15)
- INTEGER A,CCHAR,UNDER,OVER,C,FLAG
- SAVE UNDER,OVER,C
- DATA UNDER/1HU,1HN,1HD,1HE,1H /
- DATA OVER/1HO,1HV,1HE,1HR,1H /
- DATA C/1H ,1H ,1H ,1H ,1H ,1H ,1H ,1H ,1H ,1H ,
- + 1H ,1H ,1H ,1H ,1H /
-*.___________________________________________
- CALL UCTOH('CHANNELS',FLAG,1,8)
- MST=MSTEP
- IF(CCHAR.EQ.IDG(37))MST=1
- K=1000
- L=0
- N=0
- CALL VBLANK(A,NN)
- KMAX=IMIN-1+(IMAX-IMIN+1)/MSTEP
- 10 IF(K.GT.KMAX)GO TO 50
- N1=-1
- L=L+1
- N=N+1
- M=0
- DO 20 I=IMIN,IMAX
- M=M+MSTEP
- IF(M.GT.NN)GO TO 22
- J=MOD(I/K,10)+1
- IF(J.NE.N1)A(M)=IDG(J)
- N1=J
- 20 CONTINUE
-*
- 22 IF(CCHAR.EQ.UNDER(5).OR.CCHAR.EQ.IDG(37))THEN
- L=5
- N=5
- ENDIF
- IF(CCHAR.EQ.IDG(2))L=5
- IF(CCHAR.EQ.IDG(3))N=5
- WRITE(LOUT,1000)FLAG,K,(C(J1),J1=1,MST),UNDER(N),C(1),A,
- +(C(J2),J2=1,MST),OVER(L),(C(J3),J3=1,MST)
- CALL VBLANK(FLAG,8)
- 50 K=K/10
- IF(K.GT.0)GO TO 10
-*
- 1000 FORMAT(' ',8A1,I4,115A1)
- END
diff --git a/src/packlib/hbook/code/hpchar.F b/src/packlib/hbook/code/hpchar.F
deleted file mode 100644
index 9b7621e..0000000
--- a/src/packlib/hbook/code/hpchar.F
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: hpchar.F,v 1.1.1.1 1996/01/16 17:07:45 mclareni Exp $
-*
-* $Log: hpchar.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:45 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.10/05 07/03/89 11.05.37 by Rene Brun
-*-- Author :
- SUBROUTINE HPCHAR(LABEL,ICHAR)
-*.==========>
-*. To change character type for printing histos
-*. default characters are
-*.
-*. BLACK 1HX
-*. STAR 1H*
-*. FUNC 1H*
-*..=========> ( R.Brun )
-#include "hbook/hcprin.inc"
- DIMENSION LABEL(1),ICHAR(1)
-*.___________________________________________
- CALL UCTOH(LABEL,ITEST,1,1)
- IF(ITEST.EQ.IDG(12))THEN
- CALL UCTOH(ICHAR,ICBLAC,1,1)
- ELSEIF(ITEST.EQ.IDG(29))THEN
- CALL UCTOH(ICHAR,ICSTAR,1,1)
- ELSEIF(ITEST.EQ.IDG(16))THEN
- CALL UCTOH(ICHAR,ICFUNC,1,1)
- ENDIF
- END
diff --git a/src/packlib/hbook/code/hpcont.F b/src/packlib/hbook/code/hpcont.F
deleted file mode 100644
index fa9567e..0000000
--- a/src/packlib/hbook/code/hpcont.F
+++ /dev/null
@@ -1,194 +0,0 @@
-*
-* $Id: hpcont.F,v 1.1.1.1 1996/01/16 17:07:45 mclareni Exp $
-*
-* $Log: hpcont.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:45 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.10/05 19/06/89 10.09.48 by Rene Brun
-*-- Author :
- SUBROUTINE HPCONT(LABEL,P,NS,ICASE,XMAXI,A,MST,B,ISIGNE,
- + IEXP1,IEXP2)
-*.==========>
-*. This routine prints array p in vertical direction
-*. the precision is limited to 5 lines. A decimal point
-*. is printed if any. negatives values are indicated by a -
-*. in the first line.
-*. a label dependant of ICASE is also printed.
-*. MSTEP = number of columns for a channel
-*. MST = number of blanks before first character
-*..=========> ( R.Brun )
- DIMENSION P(NS),A(NS),B(MST),FLAG(8),ID(4)
- CHARACTER*(*) LABEL
-#include "hbook/hcunit.inc"
- INTEGER A,B,FLAG
-#include "hbook/hcprin.inc"
-*.___________________________________________
- IF(ICASE.EQ.7)MSTEP=4
- IEXP=0
-*
-* NC is the effective number of channels
-*
- IEDGE=0
- NC=NS/MSTEP
- NPZE=0
- CALL UCTOH(LABEL,FLAG,1,8)
- CALL VBLANK(ID,4)
- CALL VBLANK(A,NS)
- CALL VBLANK(B,MST)
- X=ABS(XMAXI)
- IF(X.LT.1.)IEDGE=1
- N=X
- NZERO=1
-*
- X=N
- N=-1
- IF(X.GE.1.)N=LOG10(X+0.01)
- X=10.**N
- IVALUE=X
-*
- NLINZE=0
- Z=X/20000.
- NOVAL=0
- M=1-MSTEP/2-MOD(MSTEP,2)
- IF(ICASE.EQ.5)M=1-MSTEP
- IF(ICASE.EQ.7)M=0
- DO 10 J=1,NC
- IF(P(J).GE.0.)GO TO 10
- NOVAL=1
- IEDGE=0
- KK=M+J*MSTEP
- A(KK)=IDG(39)
- NZERO=0
- 10 CONTINUE
- IF(NZERO.NE.0)GO TO 40
- IF(NOVAL.EQ.0)GO TO 20
- IF(ICASE.NE.7)GO TO 15
- CALL VBLANK(ID,4)
- WRITE(LOUT,6000)B,ID,A
- GO TO 30
- 15 CONTINUE
- WRITE(LOUT,1000)FLAG,B,A
- GO TO 30
- 20 IF(ICASE.NE.7)GO TO 25
- CALL HBCDI(IVALUE,4,ID)
- IF(IVALUE.EQ.0)ID(4)=IDG(1)
- WRITE(LOUT,6000)B,ID,A
- GO TO 30
- 25 CONTINUE
- WRITE(LOUT,2000)FLAG,IVALUE,B,A
- 30 LL=1
- GO TO 160
- 35 CONTINUE
-*
-* PRINT maximum 5 lines
-*
- 40 I=0
- 45 I=I+1
- JJ=0
-*
-* Fill current line
-*
- M=1-MSTEP/2-MOD(MSTEP,2)
- IF(ICASE.EQ.5)M=1-MSTEP
- IF(ICASE.EQ.7)M=0
- DO 80 J=1,NC
- M=M+MSTEP
- PDJ=ABS(P(J))+Z
- PJMOD=PDJ/X
- K=MOD(PJMOD,10.)+.00001
- IF(K.NE.0)GO TO 70
- IF(X.LT.1.)GO TO 50
- IF(PDJ.GE.X)GO TO 70
- NLINZE=NLINZE+1
- GO TO 60
- 50 MODPJ=PDJ/X
- PJMOD=MODPJ
- DIF=ABS(P(J))/X-PJMOD-.1
- IF(DIF.GT.0.)GO TO 70
- JJ=JJ+1
- A(M)=IDG(1)
- GO TO 80
- 60 JJ=JJ+1
- A(M)=IDG(41)
- GO TO 80
- 70 A(M)=IDG(K+1)
- 80 CONTINUE
-*
- IF(NLINZE.EQ.NC)GO TO 120
- IF(JJ.EQ.NC.AND.IEXP.GT.1)GO TO 140
- IF(IEDGE.NE.1)GO TO 90
- IF(N-I+2.NE.0)GO TO 90
- IF(NPZE.EQ.1)GO TO 85
-*
-* line where decimal point is printed
-*
- IF(ICASE.NE.7)GO TO 83
- A(1)=IDG(38)
- CALL VBLANK(ID,4)
- WRITE(LOUT,6000)B,ID,A
- A(1)=IDG(41)
- GO TO 85
- 83 CONTINUE
- WRITE(LOUT,3000)FLAG
- 85 LL=2
- GO TO 160
- 89 CONTINUE
- IF(ICASE.NE.7)GO TO 88
- CALL HBCDI(IVALUE,4,ID)
- IF(IVALUE.EQ.0)ID(4)=IDG(1)
- WRITE(LOUT,6000)B,ID,A
- GO TO 120
- 88 CONTINUE
- WRITE(LOUT,2000)FLAG,IVALUE,B,A
- CALL VBLANK(FLAG,8)
- GO TO 120
- 90 IF(N-I+2.EQ.1)GO TO 100
- IF(ICASE.NE.7)GO TO 95
- CALL HBCDI(IVALUE,4,ID)
- IF(IVALUE.EQ.0)ID(4)=IDG(1)
- WRITE(LOUT,6000)B,ID,A
- GO TO 110
- 95 CONTINUE
- WRITE(LOUT,2000)FLAG,IVALUE,B,A
- CALL VBLANK(FLAG,8)
- GO TO 110
- 100 IF(ICASE.NE.7)GO TO 105
- A(1)=IDG(38)
- CALL HBCDI(IVALUE,4,ID)
- IF(IVALUE.EQ.0)ID(4)=IDG(1)
- WRITE(LOUT,6000)B,ID,A
- A(1)=IDG(41)
- GO TO 106
- 105 CONTINUE
- WRITE(LOUT,4000)FLAG,IVALUE,B,A
- CALL VBLANK(FLAG,8)
- 106 NPZE=1
- 110 LL=3
- GO TO 160
- 120 X=X/10.
- NLINZE=NC+1
- IVALUE=X
- IF(I.LT.5)GO TO 45
-*
- 140 CALL HFORMA(2)
- GO TO 999
-*
- 160 IEXP=IEXP+1
- CALL UCTOH('*10**',FLAG,1,5)
- FLAG(6)=ISIGNE
- FLAG(7)=IEXP1
- FLAG(8)=IEXP2
- IF(IEXP2.EQ.IDG(41).OR.IEXP.GT.1)CALL VBLANK(FLAG,8)
-*
- GO TO(35,89,120,999),LL
-*
- 1000 FORMAT(' ',8A1,5X,114A1)
- 2000 FORMAT(' ',8A1,I4,1X,114A1)
- 3000 FORMAT(' ',8A1,4X,1H.)
- 4000 FORMAT(' ',8A1,I4,1H.,114A1)
- 6000 FORMAT(' ',127A1)
- 999 RETURN
- END
diff --git a/src/packlib/hbook/code/hpdir.F b/src/packlib/hbook/code/hpdir.F
deleted file mode 100644
index c7d0283..0000000
--- a/src/packlib/hbook/code/hpdir.F
+++ /dev/null
@@ -1,76 +0,0 @@
-*
-* $Id: hpdir.F,v 1.1.1.1 1996/01/16 17:07:45 mclareni Exp $
-*
-* $Log: hpdir.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:45 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.13/00 17/07/91 17.34.00 by Rene Brun
-*-- Author :
- SUBROUTINE HPDIR(CHPATH,CHOPT)
-*.==========>
-*. To Print histograms of directory CHPATH.
-*. Input:
-*. *CHPATH* Character variable specifying the pathname
-*. (if CHPATH=' ') same as Current directory
-*. CHOPT Character variable specifying the option
-*. ' ' Print only histograms in CHPATH
-*. 'I' Print an index
-*. 'T' Print subdirectories tree as well
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
-#include "hbook/hcdire.inc"
- CHARACTER*(*) CHPATH,CHOPT
- CHARACTER*128 CHWOLD
- DIMENSION LCUR(15),IOPT(2)
- EQUIVALENCE (IOPTT,IOPT(1)),(IOPTI,IOPT(2))
-*.___________________________________________
- IF(LHBOOK.EQ.0)GO TO 99
- CALL HUOPTC (CHOPT,'TI',IOPT)
-*
-* Save Current directory
-*
- CALL HPAFF(CHCDIR,NLCDIR,CHWOLD)
-*
-* Set Current Working directory to CHPATH
-*
- CALL HCDIR(CHPATH,' ')
- IF(ICHTOP(ICDIR).NE.0)THEN
- CALL HBUG('HPDIR cannot print RZ files','HPDIR',0)
- GO TO 40
- ENDIF
-*
- NLPAT0=NLPAT
- LCUR(NLPAT)=LCDIR
-*
-* Lists current level
-*
- IF(IOPTI.NE.0)CALL HINDEX
- CALL HPRINT(0)
- IF(IOPTT.NE.0)THEN
- 20 NLPAT=NLPAT+1
- LCDIR=LQ(LCDIR-1)
- 30 LCUR(NLPAT)=LCDIR
- IF(LCDIR.EQ.0)THEN
- NLPAT=NLPAT-1
- LCDIR=LCUR(NLPAT)
- IF(NLPAT.LE.NLPAT0)GO TO 40
- LCDIR=LQ(LCDIR)
- GO TO 30
- ENDIF
- CALL UHTOC(IQ(LCDIR+1),4,CHCDIR(NLPAT),16)
- LIDS=LQ(LCDIR-2)
- LTAB=LQ(LCDIR-3)
- IF(IOPTI.NE.0)CALL HINDEX
- CALL HPRINT(0)
- GO TO 20
- ENDIF
-*
-* Restore Current Directory
-*
- 40 CALL HCDIR(CHWOLD,' ')
-*
- 99 RETURN
- END
diff --git a/src/packlib/hbook/code/hphist.F b/src/packlib/hbook/code/hphist.F
deleted file mode 100644
index 36616d7..0000000
--- a/src/packlib/hbook/code/hphist.F
+++ /dev/null
@@ -1,190 +0,0 @@
-*
-* $Id: hphist.F,v 1.1.1.1 1996/01/16 17:07:45 mclareni Exp $
-*
-* $Log: hphist.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:45 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.19/00 26/04/93 11.57.51 by Rene Brun
-*-- Author :
- SUBROUTINE HPHIST(IDD,KNAME,NUMM)
-*.==========>
-*. PRINTS A 1-DIM HIST VERTICALLY
-*. IF(IDD.EQ.0)PRINTS ALL HISTOGRAMS
-*. KNAME IS THE OPTION TO BE PRINTED(PROX,PROY,SLIX,ETC)
-*. NUM IS THE SLICE OR BAND NUMBER
-*. NUM=0 MEANS ALL SLICES OR BANDS
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
-#include "hbook/hcbits.inc"
-#include "hbook/hcprin.inc"
- COMMON/HFORM/IFORM(128)
- CHARACTER*(*) KNAME
-*.___________________________________________
- IRET=3
- NUM=NUMM
-*
- CALL UCTOH(KNAME,NAME,4,4)
- ICASE=IUCOMP(NAME,IDENT,8)
-*
- 20 CALL HLOOP(IDD,'HPHIST',IRET)
- IF(IRET.EQ.0)GO TO 99
-*
- CALL HDCOFL
- IF(I123.EQ.0)GO TO 80
- INUM=0
- IF(I9+I10+I11.NE.0)INUM=1
- NW=(1+I12+INUM)*102
-*
- CALL HWORK(NW,IAD,'HPHIST')
- IF(IAD.EQ.0)GO TO 99
- IADE=IAD+102*INUM
- IADF=IADE+102*I12
- XMIN=0.
- XMAX=0.
-*
-* Simple histogram
-*
- IF(ICASE.LT.3.AND.I1.NE.0)THEN
- LPRX=LCID+KNCX
- LCONT=LQ(LCID-1)
- NOENT=I9
- NB=IQ(LCONT+KNBIT)
- X0=Q(LCID+KXMIN)
- XSIZE=(Q(LCID+KXMAX)-Q(LCID+KXMIN))/FLOAT(IQ(LCID+KNCX))
-*
- CALL HPR1V(Q(IAD),Q(IADE),Q(IADF),IFORM(1),IFORM(111),
- + 1,IQ(LCID+KNCX)+2,1,X0,XSIZE,XMIN,XMAX)
- ENDIF
- IF(I230.EQ.0)GO TO 80
-*
-* Projection X
-*
- IF(ICASE.EQ.3.OR.ICASE.EQ.0)THEN
- LCONT=LQ(LCID-2)
- LPRX=LCID+KNCX
- IF(LCONT.NE.0)THEN
- NOENT=I9
- NB=IQ(LCONT+KNBIT)
- X0=Q(LCID+KXMIN)
- XSIZE=(Q(LCID+KXMAX)-Q(LCID+KXMIN))/FLOAT(IQ(LCID+KNCX))
- CALL HPR1V(Q(IAD),Q(IADE),Q(IADF),IFORM(1),IFORM(111),
- + 3,IQ(LCID+KNCX)+2,1,X0,XSIZE,XMIN,XMAX)
- ENDIF
- ENDIF
-*
-* Projection Y
-*
- IF(ICASE.EQ.4.OR.ICASE.EQ.0)THEN
- LCONT=LQ(LCID-3)
- LPRX=LCID+KNCY
- IF(LCONT.NE.0)THEN
- NOENT=I10
- NB=IQ(LCONT+KNBIT)
- X0=Q(LCID+KYMIN)
- XSIZE=(Q(LCID+KYMAX)-Q(LCID+KYMIN))/FLOAT(IQ(LCID+KNCY))
- CALL HPR1V(Q(IAD),Q(IADE),Q(IADF),IFORM(1),IFORM(111),
- + 4,IQ(LCID+KNCY)+2,1,X0,XSIZE,XMIN,XMAX)
- ENDIF
- ENDIF
-*
-* Slices X
-*
- IF(ICASE.EQ.5.OR.ICASE.EQ.0)THEN
- LSLIX=LQ(LCID-4)
- LPRX=LCID+KNCX
- IF(LSLIX.NE.0)THEN
- BW=(Q(LCID+KYMAX)-Q(LCID+KYMIN))/FLOAT(IQ(LSLIX-2))
- DO 25 I=1,IQ(LSLIX-2)
- IF(NUM.NE.0.AND.NUM.NE.I)GO TO 25
- LCONT=LQ(LSLIX-I)
- NOENT=I9
- NB=IQ(LCONT+KNBIT)
- X0=Q(LCID+KXMIN)
- XSIZE=(Q(LCID+KXMAX)-Q(LCID+KXMIN))/FLOAT(IQ(LCID+KNCX))
- XMIN=Q(LCID+KYMIN)+BW*FLOAT(I-1)
- XMAX=XMIN+BW
- CALL HPR1V(Q(IAD),Q(IADE),Q(IADF),IFORM(1),IFORM(111),
- + 5,IQ(LCID+KNCX)+2,I,X0,XSIZE,XMIN,XMAX)
- 25 CONTINUE
- ENDIF
- ENDIF
-*
-* Slices Y
-*
- IF(ICASE.EQ.6.OR.ICASE.EQ.0)THEN
- LSLIY=LQ(LCID-5)
- LPRX=LCID+KNCY
- IF(LSLIY.NE.0)THEN
- BW=(Q(LCID+KXMAX)-Q(LCID+KXMIN))/FLOAT(IQ(LSLIY-2))
- DO 30 I=1,IQ(LSLIY-2)
- IF(NUM.NE.0.AND.NUM.NE.I)GO TO 30
- LCONT=LQ(LSLIY-I)
- NOENT=I10
- NB=IQ(LCONT+KNBIT)
- X0=Q(LCID+KYMIN)
- XSIZE=(Q(LCID+KYMAX)-Q(LCID+KYMIN))/FLOAT(IQ(LCID+KNCY))
- XMIN=Q(LCID+KXMIN)+BW*FLOAT(I-1)
- XMAX=XMIN+BW
- CALL HPR1V(Q(IAD),Q(IADE),Q(IADF),IFORM(1),IFORM(111),
- + 6,IQ(LCID+KNCY)+2,I,X0,XSIZE,XMIN,XMAX)
- 30 CONTINUE
- ENDIF
- ENDIF
-*
-* Bande X
-*
- IF(ICASE.EQ.7.OR.ICASE.EQ.0)THEN
- LBANX=LQ(LCID-6)
- LPRX=LCID+KNCX
- IF(LBANX.NE.0)THEN
- NBX=1
- 40 LCONT=LQ(LBANX-1)
- IF(NUM.EQ.0.OR.NUM.EQ.NBX)THEN
- NOENT=I9
- NB=IQ(LCONT+KNBIT)
- X0=Q(LCID+KXMIN)
- XSIZE=(Q(LCID+KXMAX)-Q(LCID+KXMIN))/FLOAT(IQ(LCID+KNCX))
- XMIN=Q(LBANX+1)
- XMAX=Q(LBANX+2)
- CALL HPR1V(Q(IAD),Q(IADE),Q(IADF),IFORM(1),IFORM(111),
- + 7,IQ(LCID+KNCX)+2,NBX,X0,XSIZE,XMIN,XMAX)
- ENDIF
- NBX=NBX+1
- LBANX=LQ(LBANX)
- IF(LBANX.NE.0)GO TO 40
- ENDIF
- ENDIF
-*
-* Bande Y
-*
- IF(ICASE.EQ.8.OR.ICASE.EQ.0)THEN
- LBANY=LQ(LCID-7)
- LPRX=LCID+KNCY
- IF(LBANY.NE.0)THEN
- NBY=1
- 50 LCONT=LQ(LBANY-1)
- IF(NUM.EQ.0.OR.NUM.EQ.NBY)THEN
- NOENT=I10
- NB=IQ(LCONT+KNBIT)
- X0=Q(LCID+KYMIN)
- XSIZE=(Q(LCID+KYMAX)-Q(LCID+KYMIN))/FLOAT(IQ(LCID+KNCY))
- XMIN=Q(LBANY+1)
- XMAX=Q(LBANY+2)
- CALL HPR1V(Q(IAD),Q(IADE),Q(IADF),IFORM(1),IFORM(111),
- + 8,IQ(LCID+KNCY)+2,NBY,X0,XSIZE,XMIN,XMAX)
- ENDIF
- NBY=NBY+1
- LBANY=LQ(LBANY)
- IF(LBANY.NE.0)GO TO 50
- ENDIF
- ENDIF
-*
- 80 IRET=2
- IF(IPONCE.NE.0.AND.I230.EQ.0)CALL SBYT(0,IQ(LCID+KBITS),1,3)
- GO TO 20
-*
- 99 RETURN
- END
diff --git a/src/packlib/hbook/code/hphs.F b/src/packlib/hbook/code/hphs.F
deleted file mode 100644
index 36ec83b..0000000
--- a/src/packlib/hbook/code/hphs.F
+++ /dev/null
@@ -1,57 +0,0 @@
-*
-* $Id: hphs.F,v 1.1.1.1 1996/01/16 17:07:45 mclareni Exp $
-*
-* $Log: hphs.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:45 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.10/05 21/02/89 16.14.51 by Rene Brun
-*-- Author :
- SUBROUTINE HPHS(ID1)
-*.==========>
-*. PRINT 1-DIM VERTICAL AND SCATTER-PLOTS
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
-#include "hbook/hcflag.inc"
-#include "hbook/hcprin.inc"
-*.___________________________________________
- ID=ID1
- IDLAST=0
-*
- IF(ID1.NE.0)THEN
- IDPOS=LOCATI(IQ(LTAB+1),IQ(LCDIR+KNRH),ID)
- IF(IDPOS.GT.0)THEN
- LCID=LQ(LTAB-IDPOS)
- GO TO 30
- ELSE
- CALL HBUG('Unknown histogram','HPHS',ID1)
- GO TO 99
- ENDIF
- ENDIF
-*
- LCID=LIDS
- 20 IF(LCID.EQ.0)GO TO 99
- IF(ID1.NE.0)GO TO 99
- ID=IQ(LCID-5)
-*
- 30 IF(JBIT(IQ(LCID+KBITS),1).EQ.0)GO TO 60
- CALL HPHIST(ID,' ',0)
- GO TO 90
-*
- 60 IF(JBIT(IQ(LCID+KBITS),2).NE.0)THEN
- CALL HPSCAT(ID)
- ELSE
- GO TO 95
- ENDIF
- IF(JBIT(IQ(LCID+KBITS),8).NE.0.AND.IQ(LSCAT+KNOENT).NE.0)THEN
- CALL HPHIST(ID,' ',0)
- ENDIF
-*
- 90 IF(IPONCE.NE.0)CALL SBYT(0,IQ(LCID+KBITS),1,3)
- 95 LCID=LQ(LCID)
- GO TO 20
-*
- 99 RETURN
- END
diff --git a/src/packlib/hbook/code/hphst.F b/src/packlib/hbook/code/hphst.F
deleted file mode 100644
index bbcc350..0000000
--- a/src/packlib/hbook/code/hphst.F
+++ /dev/null
@@ -1,59 +0,0 @@
-*
-* $Id: hphst.F,v 1.1.1.1 1996/01/16 17:07:45 mclareni Exp $
-*
-* $Log: hphst.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:45 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.10/05 21/02/89 16.14.51 by Rene Brun
-*-- Author :
- SUBROUTINE HPHST(ID1)
-*.==========>
-*. PRINT 1-DIM VERTICAL,SCATTER AND TABLES
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
-#include "hbook/hcflag.inc"
-#include "hbook/hcprin.inc"
-*.___________________________________________
- ID=ID1
- IDLAST=0
-*
- IF(ID1.NE.0)THEN
- IDPOS=LOCATI(IQ(LTAB+1),IQ(LCDIR+KNRH),ID)
- IF(IDPOS.GT.0)THEN
- LCID=LQ(LTAB-IDPOS)
- GO TO 30
- ELSE
- CALL HBUG('Unknown histogram','HPHST',ID1)
- GO TO 99
- ENDIF
- ENDIF
-*
- LCID=LIDS
- 20 IF(LCID.EQ.0)GO TO 99
- IF(ID1.NE.0)GO TO 99
- ID=IQ(LCID-5)
-*
- 30 IF(JBIT(IQ(LCID+KBITS),1).EQ.0)GO TO 60
- CALL HPHIST(ID,' ',0)
- GO TO 90
-*
- 60 IF(JBIT(IQ(LCID+KBITS),2).NE.0)THEN
- CALL HPSCAT(ID)
- ELSEIF(JBIT(IQ(LCID+KBITS),3).NE.0)THEN
- CALL HPTAB(ID)
- ELSE
- GO TO 95
- ENDIF
- IF(JBIT(IQ(LCID+KBITS),8).NE.0.AND.IQ(LSCAT+KNOENT).NE.0)THEN
- CALL HPHIST(ID,' ',0)
- ENDIF
-*
- 90 IF(IPONCE.NE.0)CALL SBYT(0,IQ(LCID+KBITS),1,3)
- 95 LCID=LQ(LCID)
- GO TO 20
-*
- 99 RETURN
- END
diff --git a/src/packlib/hbook/code/hpkr32.F b/src/packlib/hbook/code/hpkr32.F
deleted file mode 100644
index 863ace4..0000000
--- a/src/packlib/hbook/code/hpkr32.F
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: hpkr32.F,v 1.1.1.1 1996/01/16 17:07:45 mclareni Exp $
-*
-* $Log: hpkr32.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:45 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.10/05 16/06/89 15.20.45 by Rene Brun
-*-- Author :
- FUNCTION HPKR32(IVALUE)
-*.==========>
-*. Convert real number from machine independent format
-*..=========> ( R.Brun )
-*.___________________________________________
-#include "hbook/jbyt.inc"
- PACK32 = 0.0
- IF(IVALUE.EQ.0) GO TO 99
- XMANT = JBYT(IVALUE,1,24)
- INTEXP = 68 - JBYT(IVALUE,25,7)
- IF(IABS(INTEXP).GT.24)GO TO 99
- PACK32 = XMANT / (16.0**INTEXP)
- IF(JBIT(IVALUE,32).EQ.1) PACK32 = -PACK32
-99 HPKR32 = PACK32
- RETURN
- END
diff --git a/src/packlib/hbook/code/hpolyn.F b/src/packlib/hbook/code/hpolyn.F
deleted file mode 100644
index 6668148..0000000
--- a/src/packlib/hbook/code/hpolyn.F
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: hpolyn.F,v 1.1.1.1 1996/01/16 17:07:45 mclareni Exp $
-*
-* $Log: hpolyn.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:45 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.19/00 28/04/93 11.20.57 by Rene Brun
-*-- Author :
- FUNCTION HPOLYN (X)
-*.==========>
-*. Compute value of a polynomial and its derivatives.
-*..=========> (R.Brun,E.Lessner,D.Lienart )
-#include "hbook/hcfits.inc"
-#include "hbook/hcfitd.inc"
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION DD
-#endif
-*.___________________________________________
-*
- DD=1.
- FITDER(1)=1.
- FITFUN=FITPAD(1)
- DO 10 I=2,NFPAR
- DD=DD*X
- FITFUN=FITFUN+FITPAD(I)*DD
- FITDER(I)=DD
- 10 CONTINUE
- HPOLYN=FITFUN
- END
diff --git a/src/packlib/hbook/code/hponce.F b/src/packlib/hbook/code/hponce.F
deleted file mode 100644
index e93033b..0000000
--- a/src/packlib/hbook/code/hponce.F
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: hponce.F,v 1.1.1.1 1996/01/16 17:07:46 mclareni Exp $
-*
-* $Log: hponce.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:46 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.10/05 21/02/89 16.14.52 by Rene Brun
-*-- Author :
- SUBROUTINE HPONCE
-*.==========>
-*. IN CASE OF ERROR REPRIEVE (TIME LIMIT) WILL FORCE
-*. PRINTING OF INDEX AND EACH HISTOGRAM ONLY ONCE
-*..=========> ( R.Brun )
-#include "hbook/hcprin.inc"
-*.___________________________________________
- IPONCE=1
- END
diff --git a/src/packlib/hbook/code/hpr1h.F b/src/packlib/hbook/code/hpr1h.F
deleted file mode 100644
index d762610..0000000
--- a/src/packlib/hbook/code/hpr1h.F
+++ /dev/null
@@ -1,154 +0,0 @@
-*
-* $Id: hpr1h.F,v 1.1.1.1 1996/01/16 17:07:46 mclareni Exp $
-*
-* $Log: hpr1h.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:46 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.19/00 26/04/93 12.38.31 by Rene Brun
-*-- Author :
- SUBROUTINE HPR1H(ICAS,NC,NUM,XX0,XXSIZE,XMIN,XMAX,AA,BB)
-*.==========>
-*. CONTROL ROUTINE TO PRINT A 1-DIM HIST HORIZONTHAL
-*..=========> ( R.Brun )
- DIMENSION C(2),E(1),F(1),AA(1)
-#include "hbook/hcbook.inc"
-#include "hbook/hcbits.inc"
-#include "hbook/hcprin.inc"
-*.___________________________________________
-* NO ENTRIES CASE
-*
- IF(IQ(LCONT+KNOENT).EQ.0)THEN
- NOENT=2
- NH=NH+1
- CALL HPTIT(ICAS,NUM,0.,0.)
- RETURN
- ENDIF
-*
- IF(I1.EQ.0)THEN
- I20=0
- I21=0
- ENDIF
- NOLD=4
- I34=NOENT
- NH=NH+1
- IF(I11.NE.0)I34=1
- X0=XX0
- XSIZE=XXSIZE
- MSTEP=1
- NHT=1
- IH=1
- ICN=NC
-*
-* ROTATE HISTOGRAM by 90 DEGREES
-*
- MSTEP=1
- IF(I17.NE.0)THEN
- MSTEP=JBYT(IQ(LCID),1,4)
- IF(MSTEP.EQ.0)MSTEP=5
- ENDIF
- XMINI=X0
- XMAXI=X0+FLOAT(NC-1)*XSIZE
- IF(ABS(XMINI).GT.ABS(XMAXI))XMAXI=XMINI
- C(1)=XMAXI
- CALL HFACT(C(1),1,ISIGNL,IEXPL1,IEXPL2,FACT)
- X0=X0*FACT
- XSIZE=XSIZE*FACT
- FACTL=FACT
- CALL HPTIT(ICAS,NUM,XMIN,XMAX)
- CALL HFORMA(2)
-*
- XMAXI=-BIGP
- XMINI=-XMAXI
- ALLCHA=0.
- DO 120 ICX=1,NC
- C(1)=HCX(ICX,1)
- XMAXI=MAX(XMAXI,C(1))
- IF(I26.NE.0.AND.C(1).EQ.0.)GO TO 120
- XMINI=MIN(XMINI,C(1))
- ALLCHA=ALLCHA+C(1)
- 120 CONTINUE
- IEXP2=IDG(41)
-*
- IF(I20.NE.0)XMAXI=Q(LCID+KMAX1)
- IF(I21.NE.0)THEN
- IF(I26.NE.0.)THEN
- IF(Q(LCID+KMIN1).GT.0.)XMINI=Q(LCID+KMIN1)
- ENDIF
- ENDIF
- IF(XMINI.GE.XMAXI)GO TO 150
- FACTOR=ALLCHA
- IF(I18.NE.0)FACTOR=Q(LCID+KNORM)
- IF(ALLCHA.NE.0.)FACTOR=FACTOR/ALLCHA
- IF(FACTOR.EQ.0.)FACTOR=1.
- XMAXI=XMAXI*FACTOR
- XMINI=XMINI*FACTOR
- C(1)=XMAXI
- IF(ABS(XMINI).GT.ABS(C(1)))C(1)=XMINI
- CALL HFACT(C(1),1,ISIGNE,IEXP1,IEXP2,FACT)
- ICMIN=-1
- XMAXI=XMAXI*FACT
- XMINI=XMINI*FACT
-*
- C(2)=XMAXI
- IF(I20.EQ.0)THEN
- IF(I12.NE.0)THEN
- C(2)=HCX(1,3)*FACT
- DO 122 ICX=2,NC
- F(1)=HCX(ICX,3)*FACT
- C(2)=MAX(C(2),F(1))
- 122 CONTINUE
- ENDIF
- IF(I34.NE.0.AND.XMAXI.GT.0.)XMAXI=XMAXI+SQRT(XMAXI)
- XMAXI=MAX(C(2),XMAXI)
- ENDIF
- IF(I16.EQ.0)THEN
- DO 145 ICX=1,NC
- DO 140 I=1,MSTEP
- IF(ICX.GT.1.OR.I.NE.1)ICMIN=0
- IF(ICX.EQ.NC.AND.I.EQ.MSTEP)ICMIN=1
- IF(I.EQ.1)THEN
- C(1)=HCX(ICX,1)*FACTOR*FACT
- IF(I11.NE.0) E(1)=SQRT(ABS(C(1)*FACTOR*FACT))
- IF(NOENT.NE.0)E(1)=HCX(ICX,2)*FACTOR*FACT
- IF(I12.NE.0)F(1)=HCX(ICX,3)*FACT
- IF(ICX.NE.1)THEN
- IF(I6.NE.0)THEN
- LBINS=LQ(LCID-2)
- X0=FACTL*Q(LBINS+ICX-1)
- XSIZE=FACTL*(Q(LBINS+ICX))-X0
- ELSE
- XSIZE=FACTL*XXSIZE
- X0=FACTL*(XX0+(ICX-2)*XXSIZE)
- ENDIF
- ENDIF
- ENDIF
- CALL HP1ROT(C(1),E(1),F(1),ICMIN,XMINI,XMAXI,X0,XSIZE
- + ,ISIGNE,IEXP1,IEXP2,AA,BB)
- 140 CONTINUE
- 145 CONTINUE
- ENDIF
-*
-* PRINTING OF STATISTICS
-*
- 150 IF(I25.EQ.0)THEN
- CHI=-1.
- IF(I12.NE.0)THEN
- CHI=0.
- DO 160 I=1,ICN
- C(1)=HCX(I,1)
- F(1)=HCX(I,3)/FACTOR
- E(1)=C(1)
- IF(NOENT.NE.0)E(1)=HCX(I,2)**2
- IF(E(1).EQ.0.)GO TO 160
- CHI=CHI+((C(1)-F(1))**2)/E(1)
- 160 CONTINUE
- ENDIF
-*
- CALL HPRST(ALLCHA,ISIGNE,ISIGNL,IEXP1,IEXP2,
- + IEXPL1,IEXPL2,CHI)
- ENDIF
-*
- END
diff --git a/src/packlib/hbook/code/hpr1v.F b/src/packlib/hbook/code/hpr1v.F
deleted file mode 100644
index b74292f..0000000
--- a/src/packlib/hbook/code/hpr1v.F
+++ /dev/null
@@ -1,310 +0,0 @@
-*
-* $Id: hpr1v.F,v 1.1.1.1 1996/01/16 17:07:46 mclareni Exp $
-*
-* $Log: hpr1v.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:46 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.22/11 23/08/94 14.17.45 by Rene Brun
-*-- Author :
- SUBROUTINE HPR1V(C,E,F,A,W,ICAS,NCX,NUM,XX0,XXSIZE,XMIN,XMAX)
-*.==========>
-*. CONTROL ROUTINE TO PRINT A 1-DIM HIST VERTICAL
-*..=========> ( R.Brun )
- DIMENSION C(3),E(1),F(1),A(1),W(1)
-#include "hbook/hcbook.inc"
-#include "hbook/hcbits.inc"
-#include "hbook/hcprin.inc"
-*.___________________________________________
-* NO ENTRIES CASE
-*
- IF(IQ(LCONT+KNOENT).EQ.0)THEN
- NOENT=2
- NH=NH+1
- CALL HPTIT(ICAS,NUM,0.,0.)
- RETURN
- ENDIF
-*
- IF(I1.EQ.0)THEN
- I20=0
- I21=0
- ENDIF
- NOLD=4
- I34=NOENT
- NH=NH+1
- IF(I11.NE.0)I34=1
- X0=XX0
- XSIZE=XXSIZE
- MSTEP=1
- NHT=1
- IH=1
- NC=NCX-2
- ICN=NC
- NHT=NCOLPA-16
- IF(NHT.GT.100)NHT=100
- NHT=(NC+NHT-1)/NHT
- ALLCHA=0.
- ICMAX=0
- XMAXI=-BIGP
- XMINI=-XMAXI
- IF(NHT.NE.1)THEN
- DO 5 I=1,NC
- C(1)=HCX(I,1)
- ALLCHA=ALLCHA+C(1)
- XMAXI=MAX(XMAXI,C(1))
- IF(I26.NE.0.AND.C(1).EQ.0.)GO TO 5
- XMINI=MIN(XMINI,C(1))
- 5 CONTINUE
- FACTOR=ALLCHA
- IF(I18.NE.0)THEN
- FACTOR=Q(LCID+KNORM)
- IF(ALLCHA.NE.0.)FACTOR=FACTOR/ALLCHA
- ENDIF
- IF(FACTOR.EQ.ALLCHA)FACTOR=1.
- C(1)=XMAXI*FACTOR
- IF(I20.NE.0)THEN
- XMAX20=Q(LCID+KMAX1)*FACTOR
- IF(XMAX20.GT.C(1))C(1)=XMAX20
- ENDIF
- CALL HFACT(C,1,ISIGNE,IEXP1,IEXP2,FACT)
- XMAXI=C(1)
- XMINI=XMINI*FACTOR*FACT
- IF(I20.NE.0)XMAXI=Q(LCID+KMAX1)*FACT
- IF(I21.NE.0)XMINI=Q(LCID+KMIN1)*FACT
- ENDIF
-*
- XMAXX=XMAXI
- XMINX=XMINI
- XINT=0.
-*
- DO 100 IH=1,NHT
-*
- XMINI=XMINX
- XMAXI=XMAXX
- ICMIN=ICMAX+1
- ICMAX=ICMIN+NCOLPA-29
- IF(ICMAX.GT.NC)ICMAX=NC
-*
- J=0
- ICN=ICMAX-ICMIN+1
- IF(I34.NE.0)CALL VZERO(E,ICN)
- IF(I12.NE.0)CALL VZERO(F,ICN)
-*
- DO 10 ICX=ICMIN,ICMAX
- J=J+1
- C(J)=HCX(ICX,1)
- IF(I11.NE.0)THEN
- E(J)=SQRT(ABS(C(J)))
- ELSE
- IF(NOENT.NE.0)E(J)=HCX(ICX,2)
- ENDIF
- IF(I12.NE.0)F(J)=HCX(ICX,3)
- IF(NHT.NE.1)THEN
- C(J)=C(J)*FACTOR*FACT
- IF(I34.NE.0)E(J)=E(J)*FACTOR*FACT
- IF(I12.NE.0)F(J)=F(J)*FACT
- ELSE
- ALLCHA=ALLCHA+C(J)
- ENDIF
- 10 CONTINUE
- IF(NHT.NE.1)GO TO 25
-*
- FACTOR=ALLCHA
- IF(I18.NE.0)THEN
- FACTOR=Q(LCID+KNORM)
- IF(ALLCHA.NE.0.)FACTOR=FACTOR/ALLCHA
- ENDIF
- IF(FACTOR.EQ.ALLCHA)FACTOR=1.
- DO 15 J=1,ICN
- C(J)=C(J)*FACTOR
- IF(I34.NE.0)E(J)=E(J)*FACTOR
- 15 CONTINUE
- IF(I20.EQ.0)THEN
- CALL HFACT(C,ICN,ISIGNE,IEXP1,IEXP2,FACT)
- ELSE
- C(ICN+1)=Q(LCID+KMAX1)
- CALL HFACT(C,ICN+1,ISIGNE,IEXP1,IEXP2,FACT)
- ENDIF
- XMAXI=VMAX(C,ICN)
- XMINI=BIGP
- DO 20 J=1,ICN
- IF(I34.NE.0)E(J)=E(J)*FACT
- IF(I12.NE.0)F(J)=F(J)*FACT
- IF(I26.NE.0.AND.C(J).LE.0.)GO TO 20
- XMINI=MIN(XMINI,C(J))
- 20 CONTINUE
- IF(I20.NE.0)XMAXI=Q(LCID+KMAX1)*FACT
- IF(I21.NE.0)XMINI=Q(LCID+KMIN1)*FACT
-*
-* DEFINITION OF STEP WHEN HBIGBI
-*
- IF(I17.NE.0)THEN
- MSTEP=JBYT(IQ(LCID),1,4)
- IF(MSTEP.EQ.0)MSTEP=NCOLMA/ICN
- IF(MSTEP.GT.NCOLMA/ICN)MSTEP=1
- IF(MSTEP.EQ.0)MSTEP=1
- K=0
- DO 22 I=1,ICN
- DO 22 J=1,MSTEP
- K=K+1
- A(K)=C(I)
- 22 CONTINUE
- CALL UCOPY2(A,C,ICN*MSTEP)
-*
- IF(I34.NE.0)THEN
- K=0
- DO 23 I=1,ICN
- DO 23 J=1,MSTEP
- K=K+1
- A(K)=E(I)
- 23 CONTINUE
- CALL UCOPY2(A,E,ICN*MSTEP)
- ENDIF
-*
- IF(I12.NE.0)THEN
- K=0
- DO 24 I=1,ICN
- DO 24 J=1,MSTEP
- K=K+1
- A(K)=F(I)
- 24 CONTINUE
- CALL UCOPY2(A,F,ICN*MSTEP)
- ENDIF
- ENDIF
-*
-* PRINT TITLE AND HISTOGRAM
-*
- 25 ICN=ICN*MSTEP
- NLTIT=1
- IF(LGTIT.NE.0)NLTIT=NLTIT+3
- NLCONT=3*(1-I29)+5*(2+I14+I31+I22-I30-I15)
- NLSTAT=I25*(2+I12)
- NLINE=NLINPA-NLTIT-NLCONT-NLSTAT+NLINPA*I23
-*
- CALL HPTIT(ICAS,NUM,XMIN,XMAX)
-*
- IF(I16.EQ.0)THEN
- CALL HP1DIM(C,E,F,ICN,XMINI,XMAXI,NLINE)
- ENDIF
- CALL HFORMA(2)
- MST=-1
-*
-*
-* PRINT CHANNELS
-*
- IF(I29.EQ.0)THEN
- NLTIT=IDG(41)
- IF(I17.NE.0)NLTIT=IDG(37)
- NLCONT=ICMAX*MSTEP
- CALL HPCHAN(NLTIT,ICMIN,NLCONT,ICN,A)
- CALL HFORMA(2)
- ENDIF
-*
-* PRINT CONTENTS
-*
- IF(I30.EQ.0)THEN
- K=0
- DO 35 I=MSTEP,ICN,MSTEP
- K=K+1
- C(K)=C(I)
- 35 CONTINUE
- XMAXI=VMAX(C,ICN)
- XMAXI=ABS(XMAXI)
- XMINI=VMIN(C,ICN)
- IF(ABS(XMINI).GT.XMAXI)XMAXI=XMINI
- CALL HPCONT('CONTENTS',C,ICN,1,XMAXI,A,MST+3,W,ISIGNE,
- + IEXP1,IEXP2)
- ENDIF
-*
-* PRINT ERRORS
-*
- IF(I31*I34.NE.0)THEN
- K=0
- DO 45 I=MSTEP,ICN,MSTEP
- K=K+1
- E(K)=E(I)
- 45 CONTINUE
- XMAXI=VMAX(E,ICN)
- CALL HPCONT('ERROR ',E,ICN,2,XMAXI,A,MST+3,W,ISIGNE,
- + IEXP1,IEXP2)
- ENDIF
-*
-* PRINT FUNCTION
-*
- IF(I14.NE.0.AND.I12.NE.0)THEN
- K=0
- DO 55 I=MSTEP,ICN,MSTEP
- K=K+1
- F(K)=F(I)
- 55 CONTINUE
- XMAXI=VMAX(F,ICN)
- XMINI=VMIN(F,ICN)
- IF(ABS(XMINI).GT.XMAXI)XMAXI=XMINI
- CALL HPCONT('FUNCTION',F,ICN,3,XMAXI,A,MST+3,W,ISIGNE,
- + IEXP1,IEXP2)
- ENDIF
-*
-* PRINT INTEGRATED CONTENTS
-*
- IF(I22.NE.0)THEN
- CALL VZERO(A,ICN)
- A(1)=XINT+C(1)
- DO 70 I=2,ICN
- A(I)=A(I-1)+C(I)
- 70 CONTINUE
- XINT=A(ICN)
- CALL UCOPY2(A,C,ICN)
- CALL HFACT(C,ICN,IL1,IL2,IL3,CHI)
- XMAXI=ABS(VMAX(C,ICN))
- XMINI= VMIN(C,ICN)
- IF(ABS(XMINI).GT.XMAXI) XMAXI=XMINI
- CALL HPCONT('INTEGRAT',C,ICN,4,XMAXI,A,MST+3,W,IL1,IL2,IL3)
- ENDIF
-*
-* PRINT LOW-EDGE
-*
- IF(I15.EQ.0)THEN
- C(1)=X0
- DO 90 I=2,ICN
- IF(I6.EQ.0)THEN
- C(I)=C(I-1)+XSIZE
- ELSE
- LBINS=LQ(LCID-2)
- C(I)=Q(LBINS+I)
- ENDIF
- 90 CONTINUE
- X0=C(ICN)+XSIZE
- CALL HFACT(C,ICN,IL1,IL2,IL3,CHI)
- MST=2
- XMAXI=ABS(C(ICN))
- IF(ABS(C(1)).GT.XMAXI)XMAXI=C(1)
- CALL HPCONT('LOW-EDGE',C,ICN,5,XMAXI,A,MST,W,IL1,IL2,IL3)
- ENDIF
- 100 CONTINUE
- IEXP2=IDG(41)
- IEXPL2=IDG(41)
-*
-* PRINT STATISTICS
-*
- IF(I25.EQ.0)THEN
- ICN=ICMAX
- CHI=-1.
- IF(I12.NE.0)THEN
- CHI=0.
- DO 110 I=1,ICN
- C(1)=HCX(I,1)
- C(2)=HCX(I,3)/FACTOR
- C(3)=C(1)
- IF(NOENT.NE.0)C(3)=HCX(I,2)**2
- IF(C(3).EQ.0.)GO TO 110
- CHI=CHI+((C(1)-C(2))**2)/C(3)
- 110 CONTINUE
- ENDIF
-*
- CALL HPRST(ALLCHA,ISIGNE,ISIGNL,IEXP1,IEXP2,
- + IEXPL1,IEXPL2,CHI)
- ENDIF
-*
- END
diff --git a/src/packlib/hbook/code/hpr2.F b/src/packlib/hbook/code/hpr2.F
deleted file mode 100644
index 751dbd5..0000000
--- a/src/packlib/hbook/code/hpr2.F
+++ /dev/null
@@ -1,215 +0,0 @@
-*
-* $Id: hpr2.F,v 1.1.1.1 1996/01/16 17:07:46 mclareni Exp $
-*
-* $Log: hpr2.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:46 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.23/01 20/02/95 09.50.31 by Julian Bunn
-*-- Author :
- SUBROUTINE HPR2(C,A,W)
-*.==========>
-*. CONTROL ROUTINE TO PRINT A 2-DIM HISTOGRAM
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
-#include "hbook/hcbits.inc"
-#include "hbook/hcprin.inc"
- COMMON/HEXPO/ISI,IE1,IE2,NBS,FACT
- DIMENSION C(3),A(3),W(1)
- INTEGER CHAR,A,W
-*.___________________________________________
- NCX=IQ(LCID+KNCX)
- NCY=IQ(LCID+KNCY)
- X0=Q(LCID+KXMIN)
- Y0=Q(LCID+KYMIN)
- XSIZE=(Q(LCID+KXMAX)-Q(LCID+KXMIN))/FLOAT(IQ(LCID+KNCX))
- YSIZE=(Q(LCID+KYMAX)-Q(LCID+KYMIN))/FLOAT(IQ(LCID+KNCY))
- NH=NH+1
- NBSCAT=IQ(LSCAT+KNBIT)
- NBS=NBSCAT
- IF(IQ(LSCAT+KNOENT).EQ.0)THEN
- NOENT=2
- CALL HPTIT(1,0,0.,0.)
- GO TO 999
- ENDIF
- NOENT=1
- NOLD=4
- FACTOR=1.
- IF(I19.NE.0)FACTOR=Q(LCID+KSCAL2)
- IF(I3.EQ.0)THEN
- NHT=NCOLPA-28
- NHT=(NCX-2+NHT)/NHT
- ICHAN=NCOLPA-29
- MSTEP=1
- ELSE
- IF(NBSCAT.GE.32)THEN
- ICMIN=10
- ELSE
- Y=MAXBIT(NBSCAT)
- ICMIN=LOG10(Y)+2
- ENDIF
- MSTEP=ICMIN
- NHT=(NCOLPA-25-3*ICMIN)/ICMIN
- ICHAN=NHT-1
- NHT=(NCX-2+NHT)/NHT
- ENDIF
- ICMAX=0
- XLOW=X0-XSIZE
-*
- XMINI=BIGP
- XMAXI=-XMINI
- IF(I2.EQ.0)THEN
- IF(NBSCAT.GE.32)THEN
- DO 43 ICY=1,NCY
- DO 42 ICX=1,NCX
- C(1)=HCXY(ICX,ICY,1)
- XMAXI=MAX(XMAXI,C(1))
- XMINI=MIN(XMINI,C(1))
- 42 CONTINUE
- 43 CONTINUE
- ENDIF
- ENDIF
- XM1=XMAXI
- XM2=XMINI
- C(1)=XM1
- C(2)=XM2
- FACT8=1.
- W5=0.
- IF(I3.NE.0.AND.NBSCAT.GE.32)CALL HFACT(C,2,A(1),A(2),A(3),FACT8)
-*
- DO 90 IH=1,NHT
- Y=Y0+FLOAT(NCY+1)*YSIZE
- ICMIN=ICMAX+1
- CHAR=IDG(41)
- IF(IH.EQ.1)CHAR=IDG(2)
- IF(IH.EQ.NHT)CHAR=IDG(3)
- IF(NHT.EQ.1)CHAR=IDG(4)
- IBI=0
- IF(IH.EQ. 1)IBI=IBI+1
- IF(IH.EQ.NHT)IBI=IBI+1
- ICMAX=ICMIN+ICHAN+IBI
- IF(ICMAX.GT.NCX+2)ICMAX=NCX+2
-*
-* PRINTING OF TITLE AND CHANNEL NUMBER
-*
- CALL HPTIT(1,1,0,0)
-*
- ICN=ICMAX-ICMIN+1
- IBI=ICMIN
- IF(IH.GT.1)IBI=IBI-1
- IF(I3.EQ.0)THEN
- ICT=ICN
- IF(IH.EQ. 1)ICT=ICT-1
- IF(IH.EQ.NHT)ICT=ICT-1
- CALL HPCHAN(CHAR,IBI,ICMAX,ICT,A)
- ELSE
- NW=(ICMAX-ICMIN+1)*MSTEP
- IFW=ICMIN+NW-1
- ICT=NW
- IF(IH.EQ. 1)ICT=ICT-MSTEP
- IF(IH.EQ.NHT)ICT=ICT-MSTEP
- CALL HPCHAN(CHAR,IBI,IFW,ICT,A)
- ENDIF
-*
-* AUTOMATIC SCALING IF FACTOR=0.
-* SEMI-AUTOMATIC SCALING IF FACTOR.NE.0.
-*
- XMINI=0.
- STEP=FACTOR
- IF(I19.EQ.0)GO TO 49
- IF(FACTOR.NE.0.)GO TO 49
- XMINI=BIGP
- XMAXI=-XMINI
-*
- DO 48 ICY=1,NCY
- DO 47 ICX=ICMIN,ICMAX
- C(1)=HCXY(ICX-1,ICY,1)
- XMINI=MIN(XMINI,C(1))
- XMAXI=MAX(XMAXI,C(1))
- 47 CONTINUE
- 48 CONTINUE
- IF(XMAXI.EQ.0.)XMAXI=1.
- IF(XMAXI.EQ.XMINI)XMAXI=XMAXI+1.
-*
- CALL HBIN(XMINI,XMAXI,37,XMINI,XMAXI,C(1),STEP)
- IF(I24.NE.0)STEP=MAX(STEP,1.)
- FACTOR=1./STEP
- XMINI=-FACTOR*XMINI
-*
- 49 CONTINUE
-*
-* DETERMINATION OF LINE CONTENTS
-*
- C(1)=Y
- C(2)=Y-YSIZE*FLOAT(NCY)
- CALL HFACT(C,2,ISI,IE1,IE2,FACT)
- Y2=Y*FACT
- YSI2=YSIZE*FACT
-*
-*
- DO 70 ICYY=NCY+1,0,-1
- ICY=ICYY
- Y2=Y2-YSI2
- J=0
- DO 50 ICX=ICMIN,ICMAX
- J=J+1
- C(J)=HCXY(ICX-1,ICY,1)*FACT8
- 50 CONTINUE
- W5=W5+VSUM(C,J)
-*
- IF(ICYY.EQ.NCY+1)ICY=IDG(25)
- IF(ICYY.EQ.0 )ICY=IDG(31)
-*
- IF(I3.EQ.0)THEN
- CALL HPSCA(C,ICN,ICY,Y2,FACTOR,XMINI)
- ELSE
- CALL HPTA(C,ICN,ICY,Y2)
- ENDIF
-*
- 70 CONTINUE
-*
-* DEFINITION AND PRINTING OF LOW-EDGE
-*
- C(1)=XLOW+XSIZE
- DO 75 ICX=2,ICN
- C(ICX)=C(ICX-1)+XSIZE
- XLOW=C(ICX)
- 75 CONTINUE
- IF(IH.EQ.1)XLOW=XLOW-XSIZE
-*
- CALL HFACT(C,ICN,ISIGNE,IEXP1,IEXP2,FACT)
- XMAXI=VMAX(C,ICN)
- XMAXI=ABS(XMAXI)
- IF(ABS(C(1)).GT.XMAXI)XMAXI=C(1)
- IF(I3.EQ.0)THEN
- ICT=ICN
- IF(IH.EQ. 1)ICT=ICT-1
- IF(IH.EQ.NHT)ICT=ICT-1
- CALL HPCONT('LOW-EDGE',C,ICT,5,XMAXI,A,2,W,ISIGNE,
- + IEXP1,IEXP2)
- ELSE
- ICN=ICN*MSTEP
- ICT=ICN
- IF(IH.EQ. 1)ICT=ICT-MSTEP
- IF(IH.EQ.NHT)ICT=ICT-MSTEP
- CALL HPCONT('LOW-EDGE',C,ICT,5,XMAXI,A,2*MSTEP,W,ISIGNE,
- + IEXP1,IEXP2)
- ENDIF
- 90 CONTINUE
-*
-* PRINTING OF PLOT STATISTICS
-*
- IF(I25.EQ.0)THEN
- IF(I2.NE.0)THEN
- CALL HFRAME(IQ(LSCAT+KNOENT),-XMINI/FACTOR,STEP,W5)
- ELSE
- C(1)=XM1
- C(2)=XM2
- CALL HFACT(C,2,ISI,IE1,IE2,FACT)
- CALL HFRAME(IQ(LSCAT+KNOENT),0.,0.,W5)
- ENDIF
- ENDIF
- 999 RETURN
- END
diff --git a/src/packlib/hbook/code/hprcha.F b/src/packlib/hbook/code/hprcha.F
deleted file mode 100644
index 87f64f9..0000000
--- a/src/packlib/hbook/code/hprcha.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: hprcha.F,v 1.1.1.1 1996/01/16 17:07:46 mclareni Exp $
-*
-* $Log: hprcha.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:46 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.17/01 04/12/92 10.30.57 by Rene Brun
-*-- Author :
- SUBROUTINE HPRCHA(ID1,KOPT)
-*.==========>
-*. CHANNEL NUMBER IS NOT PRINTED IF (IOPT=2HNO)
-*..=========> ( R.Brun )
-#include "hbook/hcprin.inc"
- CHARACTER*(*) KOPT
-*.___________________________________________
- CALL UCTOH(KOPT,IOPT,4,4)
- IF(IOPT.NE.INO)THEN
- CALL HIDOPT(ID1,'PCHA')
- ELSE
- CALL HIDOPT(ID1,'NPCH')
- ENDIF
- CALL HOBSOL('HPRCHA','NPCH','PCHA')
- END
diff --git a/src/packlib/hbook/code/hprcon.F b/src/packlib/hbook/code/hprcon.F
deleted file mode 100644
index bc34f80..0000000
--- a/src/packlib/hbook/code/hprcon.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: hprcon.F,v 1.1.1.1 1996/01/16 17:07:46 mclareni Exp $
-*
-* $Log: hprcon.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:46 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.17/01 04/12/92 10.31.10 by Rene Brun
-*-- Author :
- SUBROUTINE HPRCON(ID1,KOPT)
-*.==========>
-*. CONTENTS ARE NOT PRINTED IF(IOPT=2HNO)
-*..=========> ( R.Brun )
-#include "hbook/hcprin.inc"
- CHARACTER*(*) KOPT
-*.___________________________________________
- CALL UCTOH(KOPT,IOPT,4,4)
- IF(IOPT.NE.INO)THEN
- CALL HIDOPT(ID1,'PCON')
- ELSE
- CALL HIDOPT(ID1,'NPCO')
- ENDIF
- CALL HOBSOL('HPRCON','NPCO','PCON')
- END
diff --git a/src/packlib/hbook/code/hprerr.F b/src/packlib/hbook/code/hprerr.F
deleted file mode 100644
index 64b4faa..0000000
--- a/src/packlib/hbook/code/hprerr.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: hprerr.F,v 1.1.1.1 1996/01/16 17:07:46 mclareni Exp $
-*
-* $Log: hprerr.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:46 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.17/01 04/12/92 10.31.35 by Rene Brun
-*-- Author :
- SUBROUTINE HPRERR(ID1,KOPT)
-*.==========>
-*. VALUES OF ERRORS ARE PRINTED IF(IOPT=3HYES)
-*..=========> ( R.Brun )
-#include "hbook/hcprin.inc"
- CHARACTER*(*) KOPT
-*.___________________________________________
- CALL UCTOH(KOPT,IOPT,4,4)
- IF(IOPT.NE.INO)THEN
- CALL HIDOPT(ID1,'PERR')
- ELSE
- CALL HIDOPT(ID1,'NPER')
- ENDIF
- CALL HOBSOL('HPRERR','NPER','PERR')
- END
diff --git a/src/packlib/hbook/code/hprfun.F b/src/packlib/hbook/code/hprfun.F
deleted file mode 100644
index 4cdd779..0000000
--- a/src/packlib/hbook/code/hprfun.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: hprfun.F,v 1.1.1.1 1996/01/16 17:07:46 mclareni Exp $
-*
-* $Log: hprfun.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:46 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.17/01 04/12/92 10.31.49 by Rene Brun
-*-- Author :
- SUBROUTINE HPRFUN(ID1,KOPT)
-*.==========>
-*. VALUES OF FUNCTION ARE PRINTED IF(IOPT.NE.2HNO)
-*..=========> ( R.Brun )
-#include "hbook/hcprin.inc"
- CHARACTER*(*) KOPT
-*.___________________________________________
- CALL UCTOH(KOPT,IOPT,4,4)
- IF(IOPT.NE.INO)THEN
- CALL HIDOPT(ID1,'PFUN')
- ELSE
- CALL HIDOPT(ID1,'NPFU')
- ENDIF
- CALL HOBSOL('HPRFUN','NPFU','PFUN')
- END
diff --git a/src/packlib/hbook/code/hprhis.F b/src/packlib/hbook/code/hprhis.F
deleted file mode 100644
index daa83b3..0000000
--- a/src/packlib/hbook/code/hprhis.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: hprhis.F,v 1.1.1.1 1996/01/16 17:07:46 mclareni Exp $
-*
-* $Log: hprhis.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:46 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.17/01 04/12/92 10.32.00 by Rene Brun
-*-- Author :
- SUBROUTINE HPRHIS(ID1,KOPT)
-*.==========>
-*. SUPPRESS PRINTING OF HISTOGRAM IF(IOPT=2HNO)
-*..=========> ( R.Brun )
-#include "hbook/hcprin.inc"
- CHARACTER*(*) KOPT
-*.___________________________________________
- CALL UCTOH(KOPT,IOPT,4,4)
- IF(IOPT.NE.INO)THEN
- CALL HIDOPT(ID1,'PHIS')
- ELSE
- CALL HIDOPT(ID1,'NPHI')
- ENDIF
- CALL HOBSOL('HPRHIS','NPHI','PHIS')
- END
diff --git a/src/packlib/hbook/code/hprint.F b/src/packlib/hbook/code/hprint.F
deleted file mode 100644
index e9bc7b5..0000000
--- a/src/packlib/hbook/code/hprint.F
+++ /dev/null
@@ -1,65 +0,0 @@
-*
-* $Id: hprint.F,v 1.1.1.1 1996/01/16 17:07:46 mclareni Exp $
-*
-* $Log: hprint.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:46 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.10/05 21/02/89 16.14.52 by Rene Brun
-*-- Author :
- SUBROUTINE HPRINT(ID1)
-*.==========>
-*. PRINTS HIST ID1
-*. IF(ID1=0) PRINTS ALL HIST IN THE BOOKING ORDER
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
-#include "hbook/hcflag.inc"
-#include "hbook/hcprin.inc"
-*.___________________________________________
- ID=ID1
- IDLAST=0
-*
- IF(ID1.NE.0)THEN
- IDPOS=LOCATI(IQ(LTAB+1),IQ(LCDIR+KNRH),ID)
- IF(IDPOS.GT.0)THEN
- LCID=LQ(LTAB-IDPOS)
- GO TO 30
- ELSE
- CALL HBUG('Unknown histogram','HPRINT',ID1)
- GO TO 99
- ENDIF
- ENDIF
-*
- LCID=LIDS
- 20 IF(LCID.EQ.0)GO TO 99
- IF(ID1.NE.0)GO TO 99
- ID=IQ(LCID-5)
-*
- 30 IF(JBIT(IQ(LCID+KBITS),1).EQ.0)GO TO 60
- 40 IF(JBIT(IQ(LCID+KBITS),13).NE.0)THEN
- CALL HPROT(ID,' ',0)
- ELSE
- CALL HPHIST(ID,' ',0)
- ENDIF
- GO TO 90
-*
- 60 IF(JBIT(IQ(LCID+KBITS),2).NE.0)THEN
- CALL HPSCAT(ID)
- ELSEIF(JBIT(IQ(LCID+KBITS),3).NE.0)THEN
- CALL HPTAB(ID)
- ELSE
- CALL HPRNTU(ID)
- GO TO 95
- ENDIF
- IF(IQ(LSCAT+KNOENT).NE.0)THEN
- IF(JBIT(IQ(LCID+KBITS),8).NE.0)GO TO 40
- ENDIF
-*
- 90 IF(IPONCE.NE.0)CALL SBYT(0,IQ(LCID+KBITS),1,3)
- 95 LCID=LQ(LCID)
- GO TO 20
-*
- 99 RETURN
- END
diff --git a/src/packlib/hbook/code/hprlow.F b/src/packlib/hbook/code/hprlow.F
deleted file mode 100644
index 3b0d250..0000000
--- a/src/packlib/hbook/code/hprlow.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: hprlow.F,v 1.1.1.1 1996/01/16 17:07:46 mclareni Exp $
-*
-* $Log: hprlow.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:46 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.17/01 04/12/92 10.32.11 by Rene Brun
-*-- Author :
- SUBROUTINE HPRLOW(ID1,KOPT)
-*.==========>
-*. NO PRINTING OF LOW-EDGE IF(IOPT=2HNO)
-*..=========> ( R.Brun )
-#include "hbook/hcprin.inc"
- CHARACTER*(*) KOPT
-*.___________________________________________
- CALL UCTOH(KOPT,IOPT,4,4)
- IF(IOPT.NE.INO)THEN
- CALL HIDOPT(ID1,'PLOW')
- ELSE
- CALL HIDOPT(ID1,'NPLO')
- ENDIF
- CALL HOBSOL('HPRLOW','NPLO','PLOW')
- END
diff --git a/src/packlib/hbook/code/hprntu.F b/src/packlib/hbook/code/hprntu.F
deleted file mode 100644
index b92e417..0000000
--- a/src/packlib/hbook/code/hprntu.F
+++ /dev/null
@@ -1,64 +0,0 @@
-*
-* $Id: hprntu.F,v 1.1.1.1 1996/01/16 17:07:46 mclareni Exp $
-*
-* $Log: hprntu.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:46 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.17/01 17/08/92 16.04.10 by Fons Rademakers
-*-- Author :
- SUBROUTINE HPRNTU(ID1)
-*.==========>
-*. To print statistics about a N-tuple
-*.
-*..=========> ( R.Brun )
-#include "hbook/hcflag.inc"
-#include "hbook/hcbook.inc"
-#include "hbook/hcbits.inc"
-#include "hbook/hcunit.inc"
- DIMENSION NAME(2)
-*.___________________________________________
-*
- ID=ID1
- IDPOS=LOCATI(IQ(LTAB+1),IQ(LCDIR+KNRH),ID)
- IF(IDPOS.LE.0)RETURN
- LCID=LQ(LTAB-IDPOS)
- LCONT=LQ(LCID-3)
- I4=JBIT(IQ(LCID+KBITS),4)
- IF(I4.EQ.0)RETURN
- IF (IQ(LCID-2) .NE. 2) THEN
- CALL HPRNT(ID1)
- RETURN
- ENDIF
-*
- NDIM=IQ(LCID+2)
- LLIMS=LQ(LCID-2)
- NOENT=IQ(LCID+3)
- ITAG1=IQ(LCID+10)
- ITIT1=IQ(LCID+9)
- NWTIT=IQ(LCID+8)
-*
- WRITE(LOUT,1000)ID1,NOENT,(IQ(LCID+ITIT1+I-1),I=1,NWTIT)
- WRITE(LOUT,2000)
- DO 10 I=1,NDIM
- CALL UCOPY(IQ(LCID+ITAG1+2*(I-1)),NAME,2)
- WRITE(LOUT,3000)I,NAME,Q(LLIMS+2*I-1),Q(LLIMS+2*I)
- 10 CONTINUE
- WRITE(LOUT,4000)
-*
- 1000 FORMAT(//,
- + ' ********************************************************',/,
- + ' * NTUPLE ID=',I5,' ENTRIES=',I7,3X,20A4)
- 2000 FORMAT(
- + ' ********************************************************',/,
- + ' * Var numb * Name * Lower * Upper *',/,
- + ' ********************************************************')
- 3000 FORMAT(
- + ' *',4X,I3,5X,'* ',2A4,2X,'* ',E12.6,' * ',E12.6,' *')
- 4000 FORMAT(
- + ' ********************************************************',/)
-*
- 99 RETURN
- END
diff --git a/src/packlib/hbook/code/hprof2.F b/src/packlib/hbook/code/hprof2.F
deleted file mode 100644
index 89677fb..0000000
--- a/src/packlib/hbook/code/hprof2.F
+++ /dev/null
@@ -1,71 +0,0 @@
-*
-* $Id: hprof2.F,v 1.1.1.1 1996/01/16 17:07:46 mclareni Exp $
-*
-* $Log: hprof2.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:46 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.20/03 28/07/93 09.26.34 by Rene Brun
-*-- Author : Rene Brun 28/07/93
- Subroutine hprof2(id,idp,chopt)
-*
-* Converts a 2-d histogram ID into a profile histogram IDP
-* IDP is automatically created if it does not exists.
-* Note:
-* Information may be lost in a cell (i,j) if packing is used
-* Profile histograms cannot be filled with weights. This routine
-* assumes that ID has been filled with weigths=1
-* CHOPT:
-* 'S' Profile will be withe Spread option (default=error on mean)
-* 'X' Profile will be along X (default)
-* 'Y' Profile will be along Y
-*
- character*80 title
- character*1 chopt
- logical hexist
- dimension iopt(3)
- equivalence (iopt(1),ioptx),(iopt(2),iopty),(iopt(3),iopts)
-#include "hbook/hcunit.inc"
-*._________________________________________________________
-*
- call hgive(id,title,ncx,xmin,xmax,ncy,ymin,ymax,nwt,idb)
- if(ncy.le.0)then
- call hbug('Not a 2-d histogram','HPROF2',id)
- return
- endif
- call huoptc(chopt,'XYS',iopt)
- if(iopty.eq.0)ioptx=1
- if(iopty.ne.0.and.ioptx.ne.0)iopty=0
- if(.not.hexist(idp))then
- if(ioptx.ne.0)then
- call hbprof(idp,title,ncx,xmin,xmax,ymin,ymax,chopt)
- else
- call hbprof(idp,title,ncy,ymin,ymax,xmin,xmax,chopt)
- endif
- endif
- dx2 = 0.5*(xmax-xmin)/float(ncx)
- dy2 = 0.5*(ymax-ymin)/float(ncy)
- ibad=0
- do 20 j=1,ncy
- do 10 i=1,ncx
- cont=hij(id,i,j)
- n=cont
- xn=n
- if(xn.ne.cont)ibad=ibad+1
- call hijxy(id,i,j,x,y)
- do 5 k=1,n
- if(ioptx.ne.0)then
- call hfill(idp,x,y+dy2,1.)
- else
- call hfill(idp,y,x+dx2,1.)
- endif
- 5 continue
- 10 continue
- 20 continue
- if(ibad.ne.0)then
- write(lout,1000)ibad
- 1000 format(' HPROF2:',i6,' cells have non-integer contents')
- endif
- end
diff --git a/src/packlib/hbook/code/hproj1.F b/src/packlib/hbook/code/hproj1.F
deleted file mode 100644
index 84690ce..0000000
--- a/src/packlib/hbook/code/hproj1.F
+++ /dev/null
@@ -1,46 +0,0 @@
-*
-* $Id: hproj1.F,v 1.1.1.1 1996/01/16 17:07:46 mclareni Exp $
-*
-* $Log: hproj1.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:46 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.20/09 27/09/93 08.19.10 by Rene Brun
-*-- Author :
- SUBROUTINE HPROJ1(ID1,IDN,ISEL,UWFUNC,IFROM,ITOM,IVARX)
-*.==========>
-*. Fill histogram ID1 using variable number IVARX
-*. from the N-tuple IDN.
-*.
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
- COMMON/PAWIDN/IDNEVT,VIDN1,VIDN2,VIDN3,X(522)
- EXTERNAL UWFUNC
-*.___________________________________________
-*
- CALL HGNPAR(IDN,'HPROJ1')
- IF(LCIDN.LE.0)GO TO 99
- NDIM=IQ(LCIDN+2)
- IF(IVARX.LE.0.OR.IVARX.GT.NDIM)THEN
- CALL HBUG('Error in N-tuple parameters','HPROJ1',IDN)
- RETURN
- ENDIF
- ITO=MIN(ITOM,IQ(LCIDN+3))
-*
- DO 10 IDNEVT=IFROM,ITO
- CALL HGNF(IDN,IDNEVT,X,IERROR)
- IF(IERROR.NE.0)GO TO 99
- VIDN1=X(IVARX)
- IF(ISEL.EQ.0)THEN
- CALL HF1(ID1,X(IVARX),1.)
- ELSE
- W=UWFUNC(X,ISEL)
- IF(W.NE.0.)THEN
- CALL HF1(ID1,X(IVARX),W)
- ENDIF
- ENDIF
- 10 CONTINUE
-*
- 99 END
diff --git a/src/packlib/hbook/code/hproj2.F b/src/packlib/hbook/code/hproj2.F
deleted file mode 100644
index 86440cf..0000000
--- a/src/packlib/hbook/code/hproj2.F
+++ /dev/null
@@ -1,51 +0,0 @@
-*
-* $Id: hproj2.F,v 1.1.1.1 1996/01/16 17:07:46 mclareni Exp $
-*
-* $Log: hproj2.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:46 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.20/09 27/09/93 08.19.21 by Rene Brun
-*-- Author :
- SUBROUTINE HPROJ2(ID1,IDN,ISEL,UWFUNC,IFROM,ITOM,IVARX,IVARY)
-*.==========>
-*. Fill 2-DIM histogram ID1 using variables number IVARX
-*. and IVARY from the N-tuple IDN.
-*.
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
- COMMON/PAWIDN/IDNEVT,VIDN1,VIDN2,VIDN3,X(522)
- EXTERNAL UWFUNC
-*.___________________________________________
-*
- CALL HGNPAR(IDN,'HPROJ2')
- IF(LCIDN.LE.0)GO TO 99
- NDIM=IQ(LCIDN+2)
- IF(IVARX.LE.0.OR.IVARX.GT.NDIM)THEN
- CALL HBUG('Wrong parameters','HPROJ2',IDN)
- RETURN
- ENDIF
- IF(IVARY.LE.0.OR.IVARY.GT.NDIM)THEN
- CALL HBUG('Wrong parameters','HPROJ2',IDN)
- RETURN
- ENDIF
- ITO=MIN(ITOM,IQ(LCIDN+3))
-*
- DO 10 IDNEVT=IFROM,ITO
- CALL HGNF(IDN,IDNEVT,X,IERROR)
- IF(IERROR.NE.0)GO TO 99
- VIDN1=X(IVARX)
- VIDN2=X(IVARY)
- IF(ISEL.EQ.0)THEN
- CALL HFILL(ID1,X(IVARX),X(IVARY),1.)
- ELSE
- W=UWFUNC(X,ISEL)
- IF(W.NE.0.)THEN
- CALL HFILL(ID1,X(IVARX),X(IVARY),W)
- ENDIF
- ENDIF
- 10 CONTINUE
-*
- 99 END
diff --git a/src/packlib/hbook/code/hprot.F b/src/packlib/hbook/code/hprot.F
deleted file mode 100644
index e1ad840..0000000
--- a/src/packlib/hbook/code/hprot.F
+++ /dev/null
@@ -1,183 +0,0 @@
-*
-* $Id: hprot.F,v 1.1.1.1 1996/01/16 17:07:46 mclareni Exp $
-*
-* $Log: hprot.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:46 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.19/00 26/04/93 11.57.51 by Rene Brun
-*-- Author :
- SUBROUTINE HPROT(IDD,KNAME,NUMM)
-*.==========>
-*. PRINTS A 1-DIM HIST ROTATES
-*. IF(IDD.EQ.0)PRINTS ALL HISTOGRAMS
-*. KNAME IS THE OPTION TO BE PRINTED(PROX,PROY,SLIX,ETC)
-*. NUM IS THE SLICE OR BAND NUMBER
-*. NUM=0 MEANS ALL SLICES OR BANDS
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
-#include "hbook/hcbits.inc"
-#include "hbook/hcprin.inc"
- CHARACTER*(*) KNAME
-*.___________________________________________
- IRET=3
- NUM=NUMM
-*
- CALL UCTOH(KNAME,NAME,4,4)
- ICASE=IUCOMP(NAME,IDENT,8)
-*
- 20 CALL HLOOP(IDD,'HPROT ',IRET)
- IF(IRET.EQ.0)GO TO 99
-*
- CALL HDCOFL
- IF(I123.EQ.0)GO TO 80
-*
- CALL HWORK(165,IAD,'HPROT ')
- IF(IAD.EQ.0)GO TO 99
- XMIN=0.
- XMAX=0.
-*
-* Simple histogram
-*
- IF(ICASE.LT.3.AND.I1.NE.0)THEN
- LCONT=LQ(LCID-1)
- LPRX=LCID+KNCX
- NOENT=I9
- NB=IQ(LCONT+KNBIT)
- X0=Q(LCID+KXMIN)
- XSIZE=(Q(LCID+KXMAX)-Q(LCID+KXMIN))/FLOAT(IQ(LCID+KNCX))
- CALL HPR1H(1,IQ(LCID+KNCX),1,X0,XSIZE,XMIN,XMAX,
- + Q(IAD),Q(IAD+105))
- ENDIF
- IF(I230.EQ.0)GO TO 80
-*
-* Projection X
-*
- IF(ICASE.EQ.3.OR.ICASE.EQ.0)THEN
- LCONT=LQ(LCID-2)
- LPRX=LCID+KNCX
- IF(LCONT.NE.0)THEN
- NOENT=I9
- NB=IQ(LCONT+KNBIT)
- X0=Q(LCID+KXMIN)
- XSIZE=(Q(LCID+KXMAX)-Q(LCID+KXMIN))/FLOAT(IQ(LCID+KNCX))
- CALL HPR1H(3,IQ(LCID+KNCX),1,X0,XSIZE,XMIN,XMAX,
- + Q(IAD),Q(IAD+105))
- ENDIF
- ENDIF
-*
-* Projection Y
-*
- IF(ICASE.EQ.4.OR.ICASE.EQ.0)THEN
- LCONT=LQ(LCID-3)
- LPRX=LCID+KNCY
- IF(LCONT.NE.0)THEN
- NOENT=I10
- NB=IQ(LCONT+KNBIT)
- X0=Q(LCID+KYMIN)
- XSIZE=(Q(LCID+KYMAX)-Q(LCID+KYMIN))/FLOAT(IQ(LCID+KNCY))
- CALL HPR1H(4,IQ(LCID+KNCY),1,X0,XSIZE,XMIN,XMAX,
- + Q(IAD),Q(IAD+105))
- ENDIF
- ENDIF
-*
-* Slices X
-*
- IF(ICASE.EQ.5.OR.ICASE.EQ.0)THEN
- LSLIX=LQ(LCID-4)
- LPRX=LCID+KNCX
- IF(LSLIX.NE.0)THEN
- BW=(Q(LCID+KYMAX)-Q(LCID+KYMIN))/FLOAT(IQ(LSLIX-2))
- DO 25 I=1,IQ(LSLIX-2)
- IF(NUM.NE.0.AND.NUM.NE.I)GO TO 25
- LCONT=LQ(LSLIX-I)
- NOENT=I9
- NB=IQ(LCONT+KNBIT)
- X0=Q(LCID+KXMIN)
- XSIZE=(Q(LCID+KXMAX)-Q(LCID+KXMIN))/FLOAT(IQ(LCID+KNCX))
- XMIN=Q(LCID+KYMIN)+BW*FLOAT(I-1)
- XMAX=XMIN+BW
- CALL HPR1H(5,IQ(LCID+KNCX),I,X0,XSIZE,XMIN,XMAX,
- + Q(IAD),Q(IAD+105))
- 25 CONTINUE
- ENDIF
- ENDIF
-*
-* Slices Y
-*
- IF(ICASE.EQ.6.OR.ICASE.EQ.0)THEN
- LSLIY=LQ(LCID-5)
- LPRX=LCID+KNCY
- IF(LSLIY.NE.0)THEN
- BW=(Q(LCID+KXMAX)-Q(LCID+KXMIN))/FLOAT(IQ(LSLIY-2))
- DO 30 I=1,IQ(LSLIY-2)
- IF(NUM.NE.0.AND.NUM.NE.I)GO TO 30
- LCONT=LQ(LSLIY-I)
- NOENT=I10
- NB=IQ(LCONT+KNBIT)
- X0=Q(LCID+KYMIN)
- XSIZE=(Q(LCID+KYMAX)-Q(LCID+KYMIN))/FLOAT(IQ(LCID+KNCY))
- XMIN=Q(LCID+KXMIN)+BW*FLOAT(I-1)
- XMAX=XMIN+BW
- CALL HPR1H(6,IQ(LCID+KNCY),I,X0,XSIZE,XMIN,XMAX,
- + Q(IAD),Q(IAD+105))
- 30 CONTINUE
- ENDIF
- ENDIF
-*
-* Bande X
-*
- IF(ICASE.EQ.7.OR.ICASE.EQ.0)THEN
- LBANX=LQ(LCID-6)
- LPRX=LCID+KNCX
- IF(LBANX.NE.0)THEN
- NBX=1
- 40 LCONT=LQ(LBANX-1)
- IF(NUM.EQ.0.OR.NUM.EQ.NBX)THEN
- NOENT=I9
- NB=IQ(LCONT+KNBIT)
- X0=Q(LCID+KXMIN)
- XSIZE=(Q(LCID+KXMAX)-Q(LCID+KXMIN))/FLOAT(IQ(LCID+KNCX))
- XMIN=Q(LBANX+1)
- XMAX=Q(LBANX+2)
- CALL HPR1H(7,IQ(LCID+KNCX),NBX,X0,XSIZE,XMIN,XMAX,
- + Q(IAD),Q(IAD+105))
- ENDIF
- NBX=NBX+1
- LBANX=LQ(LBANX)
- IF(LBANX.NE.0)GO TO 40
- ENDIF
- ENDIF
-*
-* Bande Y
-*
- IF(ICASE.EQ.8.OR.ICASE.EQ.0)THEN
- LBANY=LQ(LCID-7)
- LPRX=LCID+KNCY
- IF(LBANY.NE.0)THEN
- NBY=1
- 50 LCONT=LQ(LBANY-1)
- IF(NUM.EQ.0.OR.NUM.EQ.NBY)THEN
- NOENT=I10
- NB=IQ(LCONT+KNBIT)
- X0=Q(LCID+KYMIN)
- XSIZE=(Q(LCID+KYMAX)-Q(LCID+KYMIN))/FLOAT(IQ(LCID+KNCY))
- XMIN=Q(LBANY+1)
- XMAX=Q(LBANY+2)
- CALL HPR1H(8,IQ(LCID+KNCY),NBY,X0,XSIZE,XMIN,XMAX,
- + Q(IAD),Q(IAD+105))
- ENDIF
- NBY=NBY+1
- LBANY=LQ(LBANY)
- IF(LBANY.NE.0)GO TO 50
- ENDIF
- ENDIF
-*
- 80 IRET=2
- IF(IPONCE.NE.0.AND.I230.EQ.0)CALL SBYT(0,IQ(LCID+KBITS),1,3)
- GO TO 20
-*
- 99 RETURN
- END
diff --git a/src/packlib/hbook/code/hprst.F b/src/packlib/hbook/code/hprst.F
deleted file mode 100644
index def6242..0000000
--- a/src/packlib/hbook/code/hprst.F
+++ /dev/null
@@ -1,97 +0,0 @@
-*
-* $Id: hprst.F,v 1.1.1.1 1996/01/16 17:07:46 mclareni Exp $
-*
-* $Log: hprst.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:46 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.19/00 26/04/93 11.19.47 by Rene Brun
-*-- Author :
- SUBROUTINE HPRST(ALL,ISIGNE,ISIGNF,EXP1,EXP2,EXPL1,EXPL2,CHI)
-*.==========>
-*. THIS ROUTINE PRINTS STATISTICS
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
-#include "hbook/hcbits.inc"
-#include "hbook/hcunit.inc"
-#include "hbook/hcprin.inc"
- INTEGER EXP1,EXP2,EXPL1,EXPL2
- DOUBLE PRECISION SWX(2),XVALM,XRMS,VALMEA
-*.___________________________________________
-*
-* PRINTING OF SCALE FACTOR IF ANY
-*
- IF(EXP2.NE.IDG(41))THEN
- WRITE(LOUT,1000)ISIGNE,EXP1,EXP2
- ENDIF
- IF(EXPL2.NE.IDG(41))THEN
- WRITE(LOUT,2000)ISIGNF,EXPL1,EXPL2
- ENDIF
-*
-* CALCULATION OF STATISTICS VALUES
-*
- UNDER=HCX(0,1)
- OVER=HCX(ICN+1,1)
- BWID=(Q(LPRX+2)-Q(LPRX+1))/FLOAT(IQ(LPRX))
- X=Q(LPRX+1)-0.5*BWID
-*
- IF(I7.NE.0)THEN
- ALLCHA=Q(LCONT+KSTAT1)
- CALL UCOPY(Q(LCONT+KSTAT1+2),SWX,4)
- XVALM=SWX(1)
- VALMEA=0.
- RMS=0.
- EQUIV=0.
- IF(ALLCHA.NE.0.)THEN
- VALMEA=XVALM/ALLCHA
- RMS=SQRT(ABS(SWX(2)/ALLCHA - (SWX(1)/ALLCHA)**2))
- EQN=Q(LCONT+KSTAT1+1)
- IF(EQN.NE.0.)EQUIV=ALLCHA*ALLCHA/EQN
- ENDIF
- WRITE(LOUT,4000)IQ(LCONT+KNOENT),ALL,UNDER,OVER,BWID
- + ,VALMEA,RMS,EQUIV
- ELSE
- ALLCHA=0.
- XVALM=0.
- XRMS=0.
- VALMEA=0.
- RMS=0.
- DO 10 J=1,ICN
- IF(I6.EQ.0)THEN
- X=X+BWID
- ELSE
- LBINS=LQ(LCID-2)
- X=0.5*(Q(LBINS+J)+Q(LBINS+J+1))
- ENDIF
- W=ABS(HCX(J,1))
- ALLCHA=ALLCHA+W
- XVALM=XVALM+W*X
- XRMS=XRMS+W*X*X
- 10 CONTINUE
- IF(ALLCHA.NE.0.)THEN
- VALMEA=XVALM/ALLCHA
- RMS=XRMS/ALLCHA-VALMEA*VALMEA
- RMS=SQRT(ABS(RMS))
- ENDIF
- WRITE(LOUT,3000)IQ(LCONT+KNOENT),ALL,UNDER,OVER,BWID
- + ,VALMEA,RMS
- ENDIF
-*
- IF(CHI.LT.0.)GO TO 999
- WRITE(LOUT,5000)CHI
-*
- 1000 FORMAT(' * CONTENTS, ETC ARE MULTIPLIED BY 10**',3A1)
- 2000 FORMAT(' * LOW EDGE IS MULTIPLIED BY 10**',3A1)
- 3000 FORMAT(' * ENTRIES =',I11,6X,'* ALL CHANNELS =',E11.4,6X,
- +'* UNDERFLOW =',E11.4,6X,'* OVERFLOW =',E11.4,/,
- +' * BIN WID =',E11.4,6X,'* MEAN VALUE =',E11.4,6X,
- +'* R . M . S =',E11.4)
- 4000 FORMAT(' * ENTRIES =',I11,6X,'* ALL CHANNELS =',E11.4,6X,
- +'* UNDERFLOW =',E11.4,6X,'* OVERFLOW =',E11.4,/,
- +' * BIN WID =',E11.4,6X,'* MEAN VALUE =',E11.4,6X,
- +'* R . M . S =',E11.4,6X,'* NEQUIVAL =',E11.4)
- 5000 FORMAT(' * CHISQUAR = ',E11.4)
- 999 RETURN
- END
diff --git a/src/packlib/hbook/code/hprsta.F b/src/packlib/hbook/code/hprsta.F
deleted file mode 100644
index a526477..0000000
--- a/src/packlib/hbook/code/hprsta.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: hprsta.F,v 1.1.1.1 1996/01/16 17:07:46 mclareni Exp $
-*
-* $Log: hprsta.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:46 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.17/01 04/12/92 10.32.32 by Rene Brun
-*-- Author :
- SUBROUTINE HPRSTA(ID1,KOPT)
-*.==========>
-*. IF(IOPT='NO ')NO PRINTING OF STATISTICS
-*..=========> ( R.Brun )
-#include "hbook/hcprin.inc"
- CHARACTER*(*) KOPT
-*.___________________________________________
- CALL UCTOH(KOPT,IOPT,4,4)
- IF(IOPT.NE.INO)THEN
- CALL HIDOPT(ID1,'PSTA')
- ELSE
- CALL HIDOPT(ID1,'NPST')
- ENDIF
- CALL HOBSOL('HPRSTA','NPST','PSTA')
- END
diff --git a/src/packlib/hbook/code/hpsca.F b/src/packlib/hbook/code/hpsca.F
deleted file mode 100644
index c51e9ca..0000000
--- a/src/packlib/hbook/code/hpsca.F
+++ /dev/null
@@ -1,102 +0,0 @@
-*
-* $Id: hpsca.F,v 1.1.1.1 1996/01/16 17:07:46 mclareni Exp $
-*
-* $Log: hpsca.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:46 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.10/05 05/03/89 09.22.02 by Rene Brun
-*-- Author :
- SUBROUTINE HPSCA(A,N,ICY,Y,FACTOR,XMINI)
-*.==========>
-*. THIS ROUTINE PRINTS ONE LINE OF A SCATTER PLOT
-*..=========> ( R.Brun )
- DIMENSION A(N)
- COMMON/HFORM/IA(127),IDU
-#include "hbook/hcprin.inc"
- COMMON/HEXPO/ISI,IE1,IE2,NBSCAT,FACT
- SAVE ICOL
- DATA ICOL/6/
-*.___________________________________________
- KOLD=0
- 1 CALL VBLANK(IA,NCOLPA)
- DO 35 I=1,N
- J=XMINI+1.+FACTOR*A(I)
- K=I+ICOL+8
- IF(IH.GT.1)K=K+1
- IF(IH.EQ.1.AND.I.EQ.1)K=K-1
- IF(IH.EQ.NHT.AND.I.EQ.N)K=K+1
- IF(J.EQ.1)THEN
- J=41
- IF(ABS(XMINI-A(I)).GT.0.01/FACTOR)J=38
- ELSE
- IF(J.LT.1)J=41
- IF(J.GE.37)J=37
- IF(J.EQ.2)J=40
- IF(J.EQ.40)GO TO 35
- IF(FACTOR.EQ.1.)THEN
- IF(NBSCAT.LT.32)THEN
- IF(J.GT.MAXBIT(NBSCAT))J=37
- ENDIF
- ENDIF
- ENDIF
- 30 IF(ABS(A(I)).LT.0.01/FACTOR)J=41
- 35 IA(K)=IDG(J)
-*
-* PRINTS THE LINE
-*
- IA(12)=IDG(37)
- K=K+1
- IA(K+1)=IDG(37)
- IF(ICY.EQ.IDG(25))GO TO 50
- IF(ICY.EQ.IDG(31))GO TO 40
- K=K+2
-*
- CALL HBCDI(ICY,4,IA(K))
- CALL HBCDF(Y,9,IA)
-*
- GO TO 70
-*
- 40 IA(3)=IDG(31)
- IA(4)=IDG(24)
- IA(5)=IDG(14)
- IA(K+3)=IDG(31)
- IA(K+4)=IDG(24)
- IA(K+5)=IDG(14)
- CALL HFORMA(1)
- CALL VBLANK(IA,NCOLPA)
- J=K+1
- DO 45 I=12,J
- 45 IA(I)=IDG(37)
- IF(IE2.EQ.IDG(41))GO TO 70
- IA(1)=IDG(37)
- IA(2)=IDG(2)
- IA(3)=IDG(1)
- IA(4)=IDG(37)
- IA(5)=IDG(37)
- IA(6)=ISI
- IA(7)=IE1
- IA(8)=IE2
- GO TO 70
-*
- 50 J=K+1
- IF(KOLD.EQ.0)THEN
- DO 55 I=12,J
- IA(I)=IDG(37)
- 55 CONTINUE
- CALL HFORMA(1)
- KOLD=1
- GO TO 1
- ENDIF
- IA(3)=IDG(25)
- IA(4)=IDG(32)
- IA(5)=IDG(15)
- IA(K+3)=IDG(25)
- IA(K+4)=IDG(32)
- IA(K+5)=IDG(15)
-*
- 70 CALL HFORMA(1)
-*
- END
diff --git a/src/packlib/hbook/code/hpscat.F b/src/packlib/hbook/code/hpscat.F
deleted file mode 100644
index 39b00fa..0000000
--- a/src/packlib/hbook/code/hpscat.F
+++ /dev/null
@@ -1,49 +0,0 @@
-*
-* $Id: hpscat.F,v 1.1.1.1 1996/01/16 17:07:46 mclareni Exp $
-*
-* $Log: hpscat.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:46 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.10/05 20/04/89 10.34.17 by Rene Brun
-*-- Author :
- SUBROUTINE HPSCAT(IDD)
-*.==========>
-*. PRINTS IDD AS A SCATTER-PLOT
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
-#include "hbook/hcbits.inc"
-#include "hbook/hcprin.inc"
- COMMON/HFORM/IFORM(128)
-*.___________________________________________
- INNOT=1
- IRET=3
-*
- 10 CALL HLOOP(IDD,'HPSCAT',IRET)
- IF(IRET.EQ.0)GO TO 90
-*
- CALL HWORK(103,IAD,'HPSCAT')
- IF(IAD.EQ.0)GO TO 20
-*
- CALL HDCOFL
- IF(I230.EQ.0)GO TO 90
- LSCAT=LQ(LCID-1)
- NB=IQ(LSCAT+KNBIT)
- I2=1
- I3=0
- INNOT=0
-*
- CALL HPR2(Q(IAD),IFORM(1),IFORM(111))
-*
- 20 IRET=2
- IF(IPONCE.NE.0.AND.I8.EQ.0)CALL SBYT(0,IQ(LCID+KBITS),1,3)
- GO TO 10
-*
- 90 IF(INNOT.EQ.0)GO TO 99
- IF(IAD.EQ.0)GO TO 99
- CALL HBUG('Wrong parameter','HPSCAT',IDD)
-*
- 99 RETURN
- END
diff --git a/src/packlib/hbook/code/hpstat.F b/src/packlib/hbook/code/hpstat.F
deleted file mode 100644
index 741349a..0000000
--- a/src/packlib/hbook/code/hpstat.F
+++ /dev/null
@@ -1,132 +0,0 @@
-*
-* $Id: hpstat.F,v 1.1.1.1 1996/01/16 17:07:47 mclareni Exp $
-*
-* $Log: hpstat.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:47 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.23/01 20/02/95 09.51.33 by Julian Bunn
-*-- Author :
- SUBROUTINE HPSTAT(IDD)
-*.==========>
-*. To print statistics for ID
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
-#include "hbook/hcflag.inc"
-#include "hbook/hcbits.inc"
-#include "hbook/hcprin.inc"
-#include "hbook/hcunit.inc"
- DIMENSION STAT(9)
-*.___________________________________________
-*
- IRET=1
- 10 CALL HLOOP(IDD,'HSTAT ',IRET)
- IF(IRET.EQ.0)GO TO 99
- CALL HDCOFL
-*
-* 1-DIM histogram
-*
- IF(I1.NE.0)THEN
- LCONT=LQ(LCID-1)
- NB=IQ(LCONT+KNBIT)
- NCX=IQ(LCID+KNCX)
- NWTIT=IQ(LCID-1)-KTIT1+1
- WRITE(LOUT,1000)ID,(IQ(LCID+KTIT1+I-1),I=1,NWTIT)
- ALLCHA=0.
- DO 15 I=1,NCX
- ALLCHA=ALLCHA+HCX(I,1)
- 15 CONTINUE
- UNDER=HCX(0,1)
- OVER=HCX(NCX+1,1)
- WRITE(LOUT,2000)IQ(LCONT+KNOENT),ALLCHA
- WRITE(LOUT,3000)UNDER,OVER
- XMEAN=HSTATI(ID,1,'HIST',1)
- XRMS =HSTATI(ID,2,'HIST',1)
- WRITE(LOUT,4000)XMEAN,XRMS
- GO TO 90
- ENDIF
-*
-* 2-DIM histogram
-*
- IF(I230.NE.0)THEN
- LCONT=LQ(LCID-1)
- LSCAT=LCONT
- NB=IQ(LCONT+KNBIT)
- NCX=IQ(LCID+KNCX)
- NCY=IQ(LCID+KNCY)
- NWTIT=IQ(LCID-1)-KTIT2+1
- WRITE(LOUT,1000)ID,(IQ(LCID+KTIT2+I-1),I=1,NWTIT)
- WRITE(LOUT,5000)IQ(LCONT+KNOENT)
-C
-C STAT(1)= (X-UFLW, Y-OFLW)
-C
- STAT(1)=HCXY(0,NCY+1,1)
- STAT(2)=0.
-C
-C STAT(3)= (X-UFLW, Y-OFLW)
-C
- STAT(3)=HCXY(NCX+1,NCY+1,1)
- STAT(4)=0.
- STAT(5)=0.
- STAT(6)=0.
-C
-C STAT(4)= (X-UFLW, Y-RANGE)
-C STAT(5)= (X-RANGE, Y-RANGE)
-C STAT(6)= (X-OFLW, Y-RANGE)
-C
- DO 40 I=1,NCY
- STAT(4)=STAT(4)+HCXY(0,I,1)
- DO 45 J=1,NCX
- STAT(5)=STAT(5)+HCXY(J,I,1)
- 45 CONTINUE
- STAT(6)=STAT(6)+HCXY(NCX+1,I,1)
- 40 CONTINUE
-C
-C STAT(7)= (X-UFLW, Y-UFLW)
-C
- STAT(7)=HCXY(0,0,1)
- STAT(8)=0.
-C
-C STAT(2)= (X-RANGE, Y-OFLW)
-C STAT(8)= (X-RANGE, Y-UFLW)
-C
- DO 30 I=1,NCX
- STAT(2)=STAT(2)+HCXY(I,NCY+1,1)
- STAT(8)=STAT(8)+HCXY(I,0,1)
- 30 CONTINUE
-C
-C STAT(9)= (X-OFLW, Y-UFLW)
-C
- STAT(9)=HCXY(NCX+1,0,1)
- WRITE(LOUT,6100)STAT(1),STAT(2),STAT(3)
- WRITE(LOUT,6200)
- WRITE(LOUT,6100)STAT(4),STAT(5),STAT(6)
- WRITE(LOUT,6200)
- WRITE(LOUT,6100)STAT(7),STAT(8),STAT(9)
- GO TO 90
- ENDIF
-*
-* N-Tuple
-*
- IF(I4.NE.0)THEN
- IF (IQ(LCID-2) .EQ. 2) THEN
- CALL HPRNTU(ID)
- ELSE
- CALL HPRNT(ID)
- ENDIF
- ENDIF
-*
- 90 IRET=2
- GO TO 10
-*
- 1000 FORMAT(/,' =====> ID =',I8,3X,20A4)
- 2000 FORMAT(8X,' ENTRIES =',I9, 9X, ' ALL CHANN =',G13.7)
- 3000 FORMAT(8X,' UNDERFLOW =',G13.7,5X,' OVERFLOW =',G13.7)
- 4000 FORMAT(8X,' MEAN VALUE =',G13.7,5X,' R . M . S =',G13.7)
- 5000 FORMAT(8X,' ENTRIES =',I9)
- 6100 FORMAT(8X,1X,G13.7,' I ',G13.7,' I ',G13.7)
- 6200 FORMAT(8X,' --------------I---------------I--------------')
- 99 RETURN
- END
diff --git a/src/packlib/hbook/code/hpta.F b/src/packlib/hbook/code/hpta.F
deleted file mode 100644
index fd56a14..0000000
--- a/src/packlib/hbook/code/hpta.F
+++ /dev/null
@@ -1,92 +0,0 @@
-*
-* $Id: hpta.F,v 1.1.1.1 1996/01/16 17:07:47 mclareni Exp $
-*
-* $Log: hpta.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:47 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.10/05 21/02/89 16.14.52 by Rene Brun
-*-- Author :
- SUBROUTINE HPTA(C,N,ICY,Y)
-*.==========>
-*. THIS ROUTINE PRINTS ONE LINE OF A TABLE
-*..=========> ( R.Brun )
- DIMENSION C(N)
- COMMON/HFORM/IA(127),IDU
-#include "hbook/hcprin.inc"
- COMMON/HEXPO/ISI,IE1,IE2,NBSCAT,FACT
-*.___________________________________________
-*
- KOLD=0
- 1 CALL VBLANK(IA,NCOLPA)
- DO 10 I=1,N
- K=(I-1)*MSTEP+15
- IF(IH.GT.1)K=I*MSTEP+15
- IF(NBSCAT.GE.32)K=K+4
- IF(IH.EQ.1.AND.I.EQ.1)K=K-1
- IF(IH.EQ.NHT.AND.I.EQ.N)K=K+1
- IF(C(I).EQ.0.)GO TO 10
- IF(NBSCAT.GE.32)THEN
- CALL HBCDF(C(I),9,IA(K))
- ELSE
- IC=C(I)
- CALL HBCDI(IC,MSTEP,IA(K))
- ENDIF
- 10 CONTINUE
-*
-* PRINTS THE LINE
-*
- K=K+MSTEP+3
- IA(12)=IDG(37)
- IA(K-2)=IDG(37)
- IF(ICY.EQ.IDG(25))GO TO 30
- IF(ICY.EQ.IDG(31))GO TO 20
-*
- CALL HBCDI(ICY,4,IA(K-1))
- CALL HBCDF(Y,9,IA)
-*
- GO TO 50
-*
- 20 IA(3)=IDG(31)
- IA(4)=IDG(24)
- IA(5)=IDG(14)
- IA(K)=IDG(31)
- IA(K+1)=IDG(24)
- IA(K+2)=IDG(14)
- CALL HFORMA(1)
- CALL VBLANK(IA,NCOLPA)
- J=K-2
- DO 25 I=12,J
- 25 IA(I)=IDG(37)
- IF(IE2.EQ.IDG(41))GO TO 50
- IA(1)=IDG(37)
- IA(2)=IDG(2)
- IA(3)=IDG(1)
- IA(4)=IDG(37)
- IA(5)=IDG(37)
- IA(6)=ISI
- IA(7)=IE1
- IA(8)=IE2
- GO TO 50
-*
- 30 J=K-2
- IF(KOLD.EQ.0)THEN
- DO 35 I=12,J
- IA(I)=IDG(37)
- 35 CONTINUE
- CALL HFORMA(1)
- KOLD=1
- GO TO 1
- ENDIF
- IA(3)=IDG(25)
- IA(4)=IDG(32)
- IA(5)=IDG(15)
- IA(K)=IDG(25)
- IA(K+1)=IDG(32)
- IA(K+2)=IDG(15)
-*
- 50 CALL HFORMA(1)
-*
- END
diff --git a/src/packlib/hbook/code/hptab.F b/src/packlib/hbook/code/hptab.F
deleted file mode 100644
index 9b77b11..0000000
--- a/src/packlib/hbook/code/hptab.F
+++ /dev/null
@@ -1,49 +0,0 @@
-*
-* $Id: hptab.F,v 1.1.1.1 1996/01/16 17:07:47 mclareni Exp $
-*
-* $Log: hptab.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:47 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.10/05 20/04/89 10.34.17 by Rene Brun
-*-- Author :
- SUBROUTINE HPTAB(IDD)
-*.==========>
-*. PRINTS IDD AS A TABLE
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
-#include "hbook/hcbits.inc"
-#include "hbook/hcprin.inc"
- COMMON/HFORM/IFORM(128)
-*.___________________________________________
- INNOT=1
- IRET=3
-*
- 10 CALL HLOOP(IDD,'HPTAB ',IRET)
- IF(IRET.EQ.0)GO TO 90
-*
- CALL HWORK(103,IAD,'HPTAB ')
-*
- IF(IAD.EQ.0)GO TO 20
- CALL HDCOFL
- IF(I230.EQ.0)GO TO 90
- LSCAT=LQ(LCID-1)
- NB=IQ(LSCAT+KNBIT)
- I2=0
- I3=1
- INNOT=0
-*
- CALL HPR2(Q(IAD),IFORM(1),IFORM(108))
-*
- 20 IRET=2
- IF(IPONCE.NE.0.AND.I8.EQ.0)CALL SBYT(0,IQ(LCID+KBITS),1,3)
- GO TO 10
-*
- 90 IF(INNOT.EQ.0)GO TO 99
- IF(IAD.EQ.0)GO TO 99
- CALL HBUG('Wrong parameter','HPTAB ',IDD)
-*
- 99 RETURN
- END
diff --git a/src/packlib/hbook/code/hptit.F b/src/packlib/hbook/code/hptit.F
deleted file mode 100644
index 1d54423..0000000
--- a/src/packlib/hbook/code/hptit.F
+++ /dev/null
@@ -1,151 +0,0 @@
-*
-* $Id: hptit.F,v 1.2 1998/11/10 09:18:55 couet Exp $
-*
-* $Log: hptit.F,v $
-* Revision 1.2 1998/11/10 09:18:55 couet
-* - mods for Y2K
-*
-* Revision 1.1.1.1 1996/01/16 17:07:47 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.19/00 19/04/93 10.19.58 by Rene Brun
-*-- Author :
- SUBROUTINE HPTIT(ICAS,NUM,XMIN,XMAX)
-*.==========>
-*. THIS ROUTINE PRINTS GLOBAL TITLE,TITLE OF HISTOGRAM,
-*. NATURE OF HISTOGRAM AND THE LIMITS IN CASE OF SLICES
-*. OR BANDES. 2 DIFFERENT FORMATS,PRINTER AND TTY.
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
-#include "hbook/hcflag.inc"
-#include "hbook/hcunit.inc"
-#include "hbook/hcbits.inc"
-#include "hbook/hcvers.inc"
- COMMON/HFORM/IA(127),IDU
-#include "hbook/hcprin.inc"
-#include "hbook/hcrlf.inc"
-*.___________________________________________
- CALL VBLANK(IA,NCOLPA)
-*
- IF(ICAS.EQ.3)THEN
- CALL UCTOH('PROJECTION X',IA,1,12)
- ELSEIF(ICAS.EQ.4)THEN
- CALL UCTOH('PROJECTION Y',IA,1,12)
- ELSEIF(ICAS.EQ.5)THEN
- CALL UCTOH('SLICE X',IA,1,7)
- ELSEIF(ICAS.EQ.6)THEN
- CALL UCTOH('SLICE Y',IA,1,7)
- ELSEIF(ICAS.EQ.7)THEN
- CALL UCTOH('BAND X',IA,1,6)
- ELSEIF(ICAS.EQ.8)THEN
- CALL UCTOH('BAND Y',IA,1,6)
- ENDIF
-*
-* NO ENTRIES CASE
-*
- IF(NOENT.EQ.2)THEN
- CALL HFORMA(2)
- IF(ICAS.LE.4)THEN
- WRITE(LOUT,8000)ID,(IA(I),I=1,12)
- ELSE
- WRITE(LOUT,9000)ID,(IA(I),I=1,12),NUM
- ENDIF
- GO TO 99
- ENDIF
-*
-* PAGE EJECT OR NOT PAGE EJECT
-*
- IF(KSQUEZ.NE.0)WRITE(LOUT,5000)
- IEJECT=1
- IF(KSQUEZ.NE.0)IEJECT=0
- IF(LGTIT.NE.0)THEN
- NWT=IQ(LGTIT-1)
- IF(NWT.GT.20)NWT=20
- CALL VBLANK(IA(20),80)
- DO 5 I=1,NWT
- K=20+4*(I-1)
- CALL UBLOW(IQ(LGTIT+I),IA(K),4)
- 5 CONTINUE
- IF(IEJECT.EQ.0)WRITE(LOUT,1000)(IA(I),I=20,99)
- IF(IEJECT.NE.0)WRITE(LOUT,1500)CRLF,(IA(I),I=20,99)
- IEJECT=0
- DO 10 I=1,80
- J2=NWT*4+21-I
- IF(IA(J2).NE.IDG(41))GO TO 20
- 10 CONTINUE
- 20 CONTINUE
- DO 30 J1=20,J2
- 30 IA(J1)=IDG(39)
- WRITE(LOUT,1000)(IA(I),I=20,99)
- CALL HFORMA(2)
- ENDIF
-*
-*
- IF(I1.NE.0)THEN
- J1=LCID+KTIT1
- ELSE
- J1=LCID+KTIT2
- ENDIF
- J2=IQ(LCID-1)+LCID
- NWTITL=J2-J1+1
- NWT=NWTITL
- NWLINE=20
- CALL VBLANK(IA(20),80)
- J3=NWLINE
- IF(NWT.LT.NWLINE)J3=NWT
- DO 35 I=1,J3
- K=20+4*(I-1)
- CALL UBLOW(IQ(J1+I-1),IA(K),4)
- 35 CONTINUE
- IF(NHT.EQ.1)THEN
- IF(IEJECT.EQ.0)WRITE(LOUT,1000)(IA(I),I=20,99)
- IF(IEJECT.NE.0)WRITE(LOUT,1500)CRLF,(IA(I),I=20,99)
- ELSE
- IF(IEJECT.EQ.0)WRITE(LOUT,4000)(IA(I),I=20,99),IH,NHT
- IF(IEJECT.NE.0)WRITE(LOUT,4500)CRLF,(IA(I),I=20,99),IH,NHT
- ENDIF
-*
- 40 NWT=NWT-J3
- IF(NWT.GT.0)THEN
- CALL VBLANK(IA(20),80)
- J1=J1+J3
- J3=NWLINE
- IF(NWT.LT.NWLINE)J3=NWT
- DO 45 I=1,J3
- K=20+4*(I-1)
- CALL UBLOW(IQ(J1+I-1),IA(K),4)
- 45 CONTINUE
- WRITE(LOUT,1000)(IA(I),I=20,99)
- GO TO 40
- ENDIF
-*
- CALL HFORMA(2)
- WRITE(LOUT,2000)ID,(IA(I),I=1,12),CHDATE,NH
- CALL HFORMA(2)
-*
- IF(XMIN.EQ.0..AND.XMAX.EQ.0.)GO TO 99
- IF(MOD(ICAS,2).EQ.0)THEN
- WRITE(LOUT,7000)(IA(I),I=1,12),NUM,XMIN,XMAX
- CALL HFORMA(2)
- ELSE
- WRITE(LOUT,7100)(IA(I),I=1,12),NUM,XMIN,XMAX
- CALL HFORMA(2)
- ENDIF
-*
- 1000 FORMAT(' ',80A1)
- 1500 FORMAT(A,80A1)
- 2000 FORMAT(' ','HBOOK',5X,'ID =',I10,13X,12A1,15X,'DATE ',A10,
- +12X,'NO =',I6)
- 4000 FORMAT(' ',80A1,5X,'PART',I2,' OF ',I2)
- 4500 FORMAT(A,80A1,5X,'PART ' ,I2,' OF ',I2)
- 5000 FORMAT(//)
- 7000 FORMAT(' ',12A1,'NO =',I4,5X,'XMIN=',E12.4,2X,'XMAX=',E12.4)
- 7100 FORMAT(' ',12A1,'NO =',I4,5X,'YMIN=',E12.4,2X,'YMAX=',E12.4)
- 8000 FORMAT(' ','****** HBOOK NO ENTRIES FOR HISTOGRAM ID= ',
- 1 I8,5X,12A1)
- 9000 FORMAT(' ','****** HBOOK NO ENTRIES FOR HISTOGRAM ID= ',
- 1 I8,5X,12A1,2X,'NO=',I6)
- 99 RETURN
- END
diff --git a/src/packlib/hbook/code/hrdir.F b/src/packlib/hbook/code/hrdir.F
deleted file mode 100644
index db3fb44..0000000
--- a/src/packlib/hbook/code/hrdir.F
+++ /dev/null
@@ -1,139 +0,0 @@
-*
-* $Id: hrdir.F,v 1.1.1.1 1996/01/16 17:07:47 mclareni Exp $
-*
-* $Log: hrdir.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:47 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.21/07 20/12/93 13.00.08 by Rene Brun
-*-- Author :
- SUBROUTINE HRDIR(MAXDIR,CHDIR,NDIR)
-*.==========>
-*. Returns the list of subdirectories of the CWD
-*. Input:
-*. MAXDIR Length of the character array CHDIR
-*. Output:
-*. CHDIR* Character array which will contain the directory names
-*. attached to the CWD. If the length of the directory name is
-*. greater then the length of one element of CHDIR (as obtained
-*. by the LEN function), only as many characters as will fit in
-*. the array element are returned.
-*. NDIR* Actual number of subdirectories attached to the CWD
-*. If this number is greater than MAXDIR, only the first MAXDIR
-*. directory names will be returned in CHDIR.
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
-#include "hbook/hcdire.inc"
-#include "hbook/hcpiaf.inc"
-#include "hbook/czsock.inc"
-#include "hbook/czbuff.inc"
-#include "hbook/czcbuf.inc"
-*
- COMMON/QUEST/IQUEST(100)
-#if defined(CERNLIB_VAX)
- DIMENSION LQQ(50),IQQ(50),IHDIR(4)
- EQUIVALENCE (LQQ(1),IQUEST(11)),(IQQ(1),LQQ(9))
-#endif
- CHARACTER*(*) CHDIR(*)
-*.___________________________________________
-*
-* Current directory refers to a RZ file.
-*
- IF(ICHTOP(ICDIR).GT.0)THEN
- IF (ICHTOP(ICDIR).GT.1000 .AND.
- + ICHLUN(ICDIR).NE.0) THEN
-#if defined(CERNLIB_CZ)
-*
-*--- remote file on Piaf server
-*
- ISKIN = MOD(ICHTOP(ICDIR),10000)
- ISKOUT = ICHTOP(ICDIR)/10000
- IF(IZCBUF.EQ.0)GO TO 60
- CHSMPF = 'HRDIR:'
- WRITE(CHSMPF(7:),'(I4)') MAXDIR
- CALL CZPUTA(CHSMPF,IRC)
- CALL HLOGPF(' ',IRC)
- IF (IQUEST(1) .EQ. 0) THEN
- N = 4
- CALL JUMPST(IZCBUF)
- CALL JUMPX2(N,ISTAT)
- IF (ISTAT .NE. 0) GOTO 60
- READ(CHBUF,'(I4)') NDIR
- DO 5 I = 1, NDIR
- N = 16
- CALL JUMPX2(N,ISTAT)
- IF (ISTAT .NE. 0) GOTO 60
- CHDIR(I) = CHBUF
- 5 CONTINUE
- ENDIF
-#endif
-#if !defined(CERNLIB_CZ)
- CALL HBUG('CZ option not active','HRDIR',0)
- NDIR = 0
-#endif
- ELSE
- CALL RZRDIR(MAXDIR,CHDIR,NDIR)
- ENDIF
- GO TO 60
- ENDIF
-*
-* Current directory in a GLOBAL section
-*
- NCHMAX= LEN(CHDIR(1))
- NCH = MIN(NCHMAX,16)
-#if defined(CERNLIB_VAX)
- IF(ICHTOP(ICDIR).LT.0)THEN
- LOCQ=-LOCF(IQUEST(1))-ICHTOP(ICDIR)
- NDIR=0
- JCDIR=LQQ(LOCQ+1)
- IF(NLPAT.GT.1)THEN
- DO 30 IL=2,NLPAT
- CALL UCTOH(CHPAT(IL),IHDIR,4,16)
- JCDIR=LQQ(LOCQ+JCDIR-1)
- 10 IF(JCDIR.EQ.0)GO TO 60
- DO 20 I=1,4
- IF(IHDIR(I).NE.IQQ(LOCQ+JCDIR+I))THEN
- JCDIR=LQQ(LOCQ+JCDIR)
- GO TO 10
- ENDIF
- 20 CONTINUE
- 30 CONTINUE
- ENDIF
-*
- LF=LQQ(LOCQ+JCDIR-1)
- IF(LF.NE.0)THEN
- 40 IF(NDIR.GE.MAXDIR)GO TO 60
- NDIR=NDIR+1
- CHDIR(NDIR)=' '
- CALL UHTOC(IQQ(LOCQ+LF+1),4,CHDIR(NDIR),NCH)
- LF=LQQ(LOCQ+LF)
- IF(LF.NE.0)GO TO 40
- ENDIF
- GO TO 60
- ENDIF
-#endif
-#if defined(CERNLIB_HMMAP)
- IF(ICHTOP(ICDIR).LT.0)THEN
- IGOFF=-LOCF(LQ(1))-ICHTOP(ICDIR)
- CALL HRDIRM(LQ(IGOFF+1),MAXDIR,CHDIR,NDIR)
- RETURN
- ENDIF
-#endif
-*
-* Directory is in //PAWC
-*
- LF=LQ(LCDIR-1)
- NDIR=0
- IF(LF.NE.0)THEN
- 50 IF(NDIR.GE.MAXDIR)GO TO 60
- NDIR=NDIR+1
- CHDIR(NDIR)=' '
- CALL UHTOC(IQ(LF+1),4,CHDIR(NDIR),NCH)
- LF=LQ(LF)
- IF(LF.NE.0)GO TO 50
- ENDIF
-*
- 60 RETURN
- END
diff --git a/src/packlib/hbook/code/hread.F b/src/packlib/hbook/code/hread.F
deleted file mode 100644
index 40b6413..0000000
--- a/src/packlib/hbook/code/hread.F
+++ /dev/null
@@ -1,691 +0,0 @@
-*
-* $Id: hread.F,v 1.1.1.1 1996/01/16 17:07:47 mclareni Exp $
-*
-* $Log: hread.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:47 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.22/11 23/08/94 14.17.45 by Rene Brun
-*-- Author :
- SUBROUTINE HREAD(IDD,LUN,MABUFF,LENGTH,MODEE,NOMORE)
-*.==========>
-*. read into memory the contents of histogram IDD
-*. from LUN in machine independent format.
-*.
-*. Routine provided in HBOOK4 to read histograms from version 3.
-*. All parameters but IDD and LUN are not used anymore.
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
-#include "hbook/hcflag.inc"
-#include "hbook/hcprin.inc"
-#include "hbook/hcbits.inc"
- COMMON/HCGARB/JTEMP(10),KEEP1,KEEP2,LOW1,LOW2,LO1,LO2,LTITLE
- CHARACTER*80 CHTIT
- DIMENSION TEMP(8)
- EQUIVALENCE (XMIN,TEMP(4)) , (XMAX,TEMP(5))
- EQUIVALENCE (YMIN,TEMP(7)) , (YMAX,TEMP(8))
-C
- COMMON/HMIBUF/MISCUR,NBUFMI,LUNTYP,NEWBUF,LCBUFF,LUBUFF,MIBEND
-C
- DIMENSION ISPEC(11)
- SAVE ISPEC
-C DATA ISPEC/1H!,1H?,1H^,1H>,1H<,1H[,1H],1H&,1H",1H#,1H$/
-#if defined(CERNLIB_CDC)
- DATA ISPEC/
- + O"66555555555555555555"
- + ,O"71555555555555555555"
- + ,O"76555555555555555555"
- + ,O"73555555555555555555"
- + ,O"72555555555555555555"
- + ,O"61555555555555555555"
- + ,O"62555555555555555555"
- + ,O"67555555555555555555"
- + ,O"64555555555555555555"
- + ,O"60555555555555555555"
- + ,O"63555555555555555555"/
-#endif
-#if defined(CERNLIB_IBM)||defined(CERNLIB_IBMMVS)
- DATA ISPEC/
- + Z5A404040,Z6F404040,Z6A404040,Z6E404040,Z4C404040,
- + ZAD404040,ZBD404040,Z50404040,Z7F404040,Z7B404040,
- + Z7A404040/
-#endif
-#if defined(CERNLIB_NORD)
- DATA ISPEC/
- + 4110020040B, 7710020040B,13610020040B, 7610020040B,
- + 7410020040B,13310020040B,13510020040B, 4510020040B,
- + 4210020040B, 4310020040B, 7210020040B/
-#endif
-#if (defined(CERNLIB_VAX))&&(defined(CERNLIB_OLD))
- DATA ISPEC/
- + Z20202021,Z2020203F,Z2020205E,Z2020203E,Z2020203C,
- + Z2020205B,Z2020205D,Z20202025,Z20202022,Z20202023,
- + Z2020203A/
-#endif
-#if defined(CERNLIB_VAX)
- DATA ISPEC/
- + '20202021'X,'2020203F'X,'2020205E'X,'2020203E'X,'2020203C'X,
- + '2020205B'X,'2020205D'X,'20202025'X,'20202022'X,'20202023'X,
- + '2020203A'X/
-#endif
-#if defined(CERNLIB_UNIX)||defined(CERNLIB_CRAY)||defined(CERNLIB_UNIVAC)
- DATA ISPEC/1H!,1H?,1H^,1H>,1H<,1H[,1H],1H&,1H",1H#,1H$/
-#endif
-*.___________________________________________
-C
-C Reserve 1000 words of working space
-C
- LUBUFF = 945
- LCBUFF = LUBUFF*32 / NBIT
- CALL HWORK(1000,MEMSWA,'HREAD ')
- IF(MEMSWA.EQ.0) GO TO 999
-*
- 100 NEWBUF = 1
- ID = 0
- NBUFMI = 4
- LUNTYP = -1
-C
-C Read in the first record
-C
- CALL HUPKRD(LUN,NEXT,MEMSWA)
- IF(NBUFMI.EQ.0) GO TO 997
- IF(IQ(MISCUR).EQ.0) GO TO 996
-*
- IF(IQ(MISCUR).EQ.0) GO TO 997
- IF(IDD.EQ.0) GO TO 200
- ID = IDD
- NRHIST=IQ(LCDIR+KNRH)
- IDPOS=LOCATI(IQ(LTAB+1),NRHIST,IDD)
- IF(IDPOS.GT.0)THEN
-C
-C ID NO. already exists
-C
- NEWID = ID
- CALL HBUG('Already existing histogram replaced','HREAD ',NEWID)
- GO TO 999
- ENDIF
-C
-C Search for the required histogram on tape
-C
- 130 IF(IQ(MEMSWA+3).EQ.0) GO TO 140
-C
-C A new id starts somewhere in this record
-C
- MISCUR = MEMSWA+IQ(MEMSWA+3)
- 160 IF(IQ(MISCUR).EQ.0) GO TO 996
- NEXT = MISCUR+1
- IF(IQ(NEXT).NE.0) GO TO 150
-C
-C New id header section encountered
-C
- ID = HPKR32(IQ(NEXT+1))
- IF(ID.EQ.IDD) GO TO 210
-C
-C Not the required histogram, move onto the next section
-C
- 150 MISCUR = MISCUR+IQ(MISCUR)
- IF(MISCUR.LT.MIBEND) GO TO 160
-C
-C Read in the next record
-C
- 140 CALL HUPKRD(LUN,NEXT,MEMSWA)
- IF(NBUFMI.EQ.0) GO TO 997
- GO TO 130
- 200 IF(IQ(MISCUR).EQ.0) GO TO 997
- IF(IQ(NEXT).NE.0) GO TO 997
- ID = HPKR32(IQ(NEXT+1))
- 210 NEXT = NEXT+2
- IF(ID.NE.0) GO TO 300
-C
-C Global title - reserve space and create it
-C
- LTITLE = IQ(NEXT)-2
- CHTIT=' '
- NCH=MIN(79,LTITLE)
- CHTIT(NCH+1:NCH+1)='$'
-C
-C Title requires I words for LTITLE characters
-C
- CALL HTITLE(CHTIT)
- NEXT = NEXT+1
- LOW1 = LGTIT+1
- NCHT = 0
- LOW2 = 0
- LO1 = 0
- 215 CALL VBLANK(JTEMP,NCHAR)
- 220 NEXT=NEXT+1
- IF(NEXT.LE.MIBEND)GO TO 240
- CALL HUPKRD(LUN,NEXT,MEMSWA)
- IF(NBUFMI.EQ.0)GO TO 997
- IF(IQ(MISCUR).EQ.0)GO TO 997
- NEXT=NEXT-1
-C
- 240 LOW2=LOW2+1
- IBN=IQ(NEXT)
- IF(IBN.LT.50)JTEMP(LOW2)=IDG(IBN)
- IF(IBN.GT.50)JTEMP(LOW2)=ISPEC(IBN-50)
- NCHT=NCHT+1
- LTITLE=LTITLE-1
- IF(LTITLE.EQ.0)GO TO 260
- IF(LOW2.NE.NCHAR)GO TO 220
-C
- 260 CONTINUE
- IF(NCHT.LE.80)CALL UBUNCH(JTEMP,IQ(LOW1),NCHAR)
- LOW1=LOW1+1
- LOW2=0
- CALL VBLANK(JTEMP,NCHAR)
- IF(LTITLE.NE.0)GO TO 220
-C
- 280 MISCUR=NEXT+1
- NEXT=MISCUR+1
- IF(NEXT.LE.MIBEND)GO TO 285
- CALL HUPKRD(LUN,NEXT,MEMSWA)
- IF(NBUFMI.EQ.0)GO TO 997
- IF(IQ(MISCUR).EQ.0)GO TO 997
- 285 IF(LO1.NE.0)GO TO 440
- GO TO 200
-C
- 300 NEWID = ID
- IF(IDD.NE.0) GO TO 310
- NRHIST=IQ(LCDIR+KNRH)
- IDPOS=LOCATI(IQ(LTAB+1),NRHIST,IDD)
- IF(IDPOS.GT.0)THEN
-C
-C ID NO. already exists
-C
- NEWID = ID
- CALL HBUG('Already existing histogram replaced','HREAD ',NEWID)
- GO TO 999
- ENDIF
- 310 NEXT = NEXT+1
- IF(IQ(NEXT).NE.13) GO TO 997
-C
-C Store the dimensions of the histogram
-C
- NEXT = NEXT+1
- CALL UCOPY(IQ(NEXT),TEMP,8)
- DO 330 I = 3,8
- TEMP(I) = HPKR32(TEMP(I))
- 330 CONTINUE
- NCHX = TEMP(3)
- NCHY = TEMP(6)
- NEXT = NEXT+8
- VMX = 0.0
- I = IQ(NEXT)
- IF(I.LT.32) VMX = 2.0**I-1.0
- I1 = JBIT(TEMP(1),1)
- I2 = JBIT(TEMP(1),2)
- I3 = JBIT(TEMP(1),3)
- I230 = I2+I3
- I123 = I1+I230
- MISCUR = NEXT+1
- NEXT = MISCUR+1
- IF(MISCUR.LT.MIBEND) GO TO 340
- CALL HUPKRD(LUN,NEXT,MEMSWA)
- IF(NBUFMI.EQ.0) GO TO 997
- IF(IQ(MISCUR).EQ.0) GO TO 997
- 340 IF(I123.EQ.0) GO TO 400
-C
-C Check if there's a title for the histogram
-C
- I = 0
- IF(IQ(NEXT).NE.12) GO TO 350
- K = IQ(MISCUR)-2
- I = K/NCHAR
- J = MOD(K,NCHAR)
- IF(J.NE.0) I = I+1
- NCH=MIN(79,K)
- CHTIT=' '
- CHTIT(NCH+1:NCH+1)='$'
-C
-C BOOK IT
-C
- 350 IF(I230.NE.0) GO TO 360
- CALL HBOOK1(NEWID,CHTIT,NCHX,XMIN,XMAX,VMX)
- IF(IERR.EQ.0) GO TO 380
- GO TO 999
- 360 IF(I2.EQ.0) GO TO 370
- CALL HBOOK2(NEWID,CHTIT,NCHX,XMIN,XMAX,NCHY,YMIN,YMAX,VMX)
- IF(IERR.EQ.0) GO TO 380
- GO TO 999
- 370 CALL HTABLE(NEWID,CHTIT,NCHX,XMIN,XMAX,NCHY,YMIN,YMAX,VMX)
- IF(IERR.NE.0) GO TO 999
-C
-C Store part of the status word
-C
- 380 CONTINUE
- KEEP1 = JBYT(TEMP,4,3)
- KEEP2 = JBYT(TEMP,11,1)
- LOW1 = JBYT(TEMP,13,4)
- LOW2 = JBYT(TEMP,22,11)
- CALL SBYT(KEEP1,IQ(LCID+KBITS),4,3)
- CALL SBYT(KEEP2,IQ(LCID+KBITS),11,1)
- CALL SBYT(LOW1,IQ(LCID+KBITS),13,4)
- CALL SBYT(LOW2,IQ(LCID+KBITS),22,11)
- IF(I.EQ.0) GO TO 440
-C
-C Individual title - create it and store it
-C
- LTITLE = K
- IF(I230.EQ.0)THEN
- LOW1 = LCID+KTIT1
- ELSE
- LOW1 = LCID+KTIT2
- ENDIF
- NCHT =0
- LOW2 = 0
- LO1 = 1
- GO TO 215
-C
-C CALL HARRAY(ID,HOWLONG,FROMWHERE)
-C
- 400 CALL HARRAY(NEWID,NCHX,I)
- IF(IERR.NE.0) GO TO 999
- KEEP1 = I+1
- J = I+NCHX
- 410 LOW1 = KEEP1
- DO 430 I = LOW1,J
- NEXT = NEXT+1
- Q(I) = HPKR32(IQ(NEXT))
- IF(NEXT.NE.MIBEND) GO TO 430
- NEWBUF = 0
- JUMP = 6
- KEEP1 = I+1
- IF(I.EQ.J)THEN
- NEWBUF = 1
- JUMP = 7
- ENDIF
- CALL HUPKRD(LUN,NEXT,MEMSWA)
- IF(NBUFMI.EQ.0) GO TO 997
- IF(IQ(MISCUR).EQ.0) GO TO 997
- IF(JUMP.NE.6) GO TO 990
- 430 CONTINUE
- MISCUR = NEXT+1
- NEXT = MISCUR+1
- GO TO 990
-C
-C Now build the histograms
-C
- 440 IF(JBIT(TEMP(1),7).EQ.0) GO TO 450
-C
-C HBSTAT FLAG SET
-C
- CALL HIDOPT(NEWID,'STAT')
- IF(IERR.NE.0) GO TO 999
- 450 IF(JBIT(TEMP(1),9).EQ.0) GO TO 460
-C
-C BAR(X) FLAG SET
-C
- CALL HBARX(NEWID)
- IF(IERR.NE.0) GO TO 999
- 460 IF(JBIT(TEMP(1),10).EQ.0) GO TO 480
-C
-C BAR(Y) FLAG SET
-C
- CALL HBARY(NEWID)
- IF(IERR.NE.0) GO TO 999
- 480 KARYON = 0
- NUMOPT = 1
- GO TO 500
- 490 CALL HUPKRD(LUN,NEXT,MEMSWA)
- IF(NBUFMI.EQ.0) GO TO 997
- 500 IF(I230.NE.0) GO TO 700
-C
-C 1-D HISTOGRAMS
-C
- IF(KARYON.NE.0) GO TO (525,540,560,580,600,610,990) , KARYON
- KARYON = 1
- IF(JBIT(TEMP(1),7).EQ.0) GO TO 525
-C
-C HBSTAT FLAG SET
-C
- 510 CONTINUE
- DO 520 K = 1,5
- NEXT = NEXT+1
-** Q(K) = HPKR32(IQ(NEXT))
- 520 CONTINUE
- MISCUR = NEXT+1
- IF(MISCUR.GT.MIBEND) GO TO 490
- NEXT = MISCUR+1
- GO TO 500
-C
-C Fill the channels
-C
- 525 LOPCON = NCHX+3
- 530 CONTINUE
- 535 CONTINUE
- NB=IQ(LCONT+KNBIT)
- KTYPE = IQ(NEXT)
- NEXT = NEXT+1
-C
-C First, store the no. of entries in the option
-C
- ENTOPT = HPKR32(IQ(NEXT))
- KEEP1 = 1
- KARYON = 2
- I7 = 0
-C
-C NOW THE CONTENTS
-C
- 540 LOW1 = KEEP1
- LPRX = LCID+KNCX
- IF(KTYPE.EQ.4.OR.KTYPE.EQ.6.OR.KTYPE.EQ.8)LPRX=LCID+KNCY
- DO 550 I = LOW1,LOPCON
- NEXT = NEXT+1
- IF(KTYPE.EQ.10) VALUE = HPKR32(IQ(NEXT))
- IF(KTYPE.EQ.11) VALUE = FLOAT(IQ(NEXT))
- IF(I.NE.LOPCON) CALL HFCX(I-1,VALUE)
- IF(NEXT.NE.MIBEND) GO TO 550
- KEEP1 = I+1
- NEWBUF = 0
- IF(I.NE.LOPCON) GO TO 490
- KARYON = 3
- NEWBUF = 1
- GO TO 490
- 550 CONTINUE
- MISCUR = NEXT+1
- NEXT = MISCUR+1
- KARYON = 3
- 560 IQ(LCONT+KNOENT) = ENTOPT
- I7 = JBIT(TEMP(1),7)
- IF(I230.NE.0) GO TO 700
- IF(JBIT(TEMP(1),9).EQ.0) GO TO 990
-C
-C ENTRIES FOR BAR(X) FOLLOWING
-C
- KARYON = 4
- NW = (NCHX+2) / (NBIT/NB) + 1
- KEEP1 = 1
- 580 LOW1 = KEEP1
- LW=LQ(LCONT)
- DO 590 I = LOW1,LOPCON
- NEXT = NEXT+1
- VALUE = HPKR32(IQ(NEXT))
- VALUE = VALUE*VALUE
- IF(I.GT.LOW1.AND.I.LT.LOPCON-1)Q(LW+I-1)=VALUE
- IF(NEXT.NE.MIBEND) GO TO 590
- KEEP1 = I+1
- NEWBUF = 0
- IF(I.NE.LOPCON) GO TO 490
- KARYON = 5
- NEWBUF = 1
- GO TO 490
- 590 CONTINUE
- MISCUR = NEXT+1
- NEXT = MISCUR+1
- KARYON = 5
- 600 IF(I230.NE.0) GO TO 700
- IF(JBIT(TEMP(1),12).EQ.0) GO TO 990
-C
-C Superimposition of function flag set.
-C (NV = 1 stops HFUNC sampling a non-existent function)
-C
- LO1 = NV
- NV = 1
- CALL HFUNC(NEWID,SQRT)
- IF(IERR.NE.0) GO TO 999
- NV = LO1
- KEEP1 = 2
- KARYON = 6
- J = NCHX+1
- 610 LOW1 = KEEP1
- LFUNC=LQ(LCONT-1)
- DO 620 I = LOW1,J
- NEXT = NEXT+1
- VALUE = HPKR32(IQ(NEXT))
- IF(I.GT.LOW1.AND.I.LT.J-1)Q(LFUNC+I+1)=VALUE
- IF(NEXT.NE.MIBEND) GO TO 620
- KEEP1 = I+1
- NEWBUF = 0
- IF(I.NE.J) GO TO 490
- KARYON = 7
- NEWBUF = 1
- GO TO 490
- 620 CONTINUE
- MISCUR = NEXT+1
- NEXT = MISCUR+1
- GO TO 990
-C
-C 2-D HISTOGRAM (SCATTER PLOT OR TABLE)
-C
- 700 CONTINUE
- GO TO (705,705,760,760,770,770,780,780) , NUMOPT
- 705 IF(KARYON.EQ.1) GO TO 710
- IF(KARYON.EQ.2) GO TO 740
- KARYON = 1
-C
-C Fill the channels
-C
- LCONT=LQ(LCID-1)
- LSCAT=LCONT
- NB = IQ(LCONT+KNBIT)
- KTYPE = IQ(NEXT)
- NEXT = NEXT+1
-C
-C How many entries are there...
-C
- ENTOPT = HPKR32(IQ(NEXT))
- M = NCHX+3
- N = NCHY+3
-C
-C THERE ARE (NCHX+3)*(NCHY+3) CELLS
-C
- KEEP1 = 1
- KEEP2 = 1
- 710 LOW1 = KEEP1
- LOW2 = KEEP2
- DO 730 I = LOW1,M
- DO 720 J = LOW2,N
- NEXT = NEXT+1
- IF(KTYPE.EQ.10) VALUE = HPKR32(IQ(NEXT))
- IF(KTYPE.EQ.11) VALUE = FLOAT(IQ(NEXT))
- IF(I.NE.M.AND.J.NE.N)CALL HFCXY(I-1,J-1,VALUE)
- IF(NEXT.NE.MIBEND) GO TO 720
- NEWBUF = 0
- KEEP1 = I
- KEEP2 = J+1
- IF(J.NE.N) GO TO 490
- KEEP1 = KEEP1+1
- KEEP2 = 1
- IF(I.NE.M) GO TO 490
- KARYON = 2
- NEWBUF = 1
- GO TO 490
- 720 CONTINUE
- LOW2 = 1
- 730 CONTINUE
- MISCUR = NEXT+1
- NEXT = MISCUR+1
- 740 IQ(LCONT+KNOENT) = ENTOPT
- IF(JBIT(TEMP(1),8).EQ.0) GO TO 990
-C
-C The ID has one or more options as well
-C
- 750 KARYON = 0
- IF(IQ(MISCUR).EQ.0) GO TO 999
- NUMOPT = IQ(NEXT)
- IF(NUMOPT.EQ.0) GO TO 990
- IF(NUMOPT.EQ.10) GO TO 990
- NEXT = NEXT+1
- VMX = 0.0
- I = IQ(NEXT)
- IF(I.LT.32) VMX = 2.0**I-1.0
- IF(NUMOPT.GT.4) GO TO 752
- IF(NUMOPT.EQ.3)THEN
- CALL HBPROX(NEWID,VMX)
- LCONT=LPROX
- ENDIF
- IF(NUMOPT.EQ.4)THEN
- CALL HBPROY(NEWID,VMX)
- LCONT=LPROY
- ENDIF
- IF(IERR.NE.0) GO TO 999
- GO TO 754
- 752 IF(NUMOPT.GT.6) GO TO 753
- NEXT = NEXT+1
- NSLICE = IQ(NEXT)
- IF(NUMOPT.EQ.5)THEN
- CALL HBSLIX(NEWID,NSLICE,VMX)
- ENDIF
- IF(NUMOPT.EQ.6)THEN
- CALL HBSLIY(NEWID,NSLICE,VMX)
- ENDIF
- IF(IERR.NE.0) GO TO 999
- GO TO 754
- 753 NEXT = NEXT+1
- XMIN = HPKR32(IQ(NEXT))
- NEXT = NEXT+1
- XMAX = HPKR32(IQ(NEXT))
- IF(NUMOPT.EQ.7)THEN
- CALL HBANDX(NEWID,XMIN,XMAX,VMX)
- LCONT=LQ(LBANX-1)
- ENDIF
- IF(NUMOPT.EQ.8)THEN
- CALL HBANDY(NEWID,XMIN,XMAX,VMX)
- LCONT=LQ(LBANY-1)
- ENDIF
- IF(IERR.NE.0) GO TO 999
- 754 CONTINUE
-C
-C NOWOPT points to the start of the newly created option
-C
- 756 MISCUR = NEXT+1
- IF(MISCUR.GT.MIBEND) GO TO 490
- NEXT = MISCUR+1
- GO TO 700
-C
-C PROJECTIONS ON X OR Y
-C
- 760 CONTINUE
- IF(KARYON.NE.0) GO TO (761,540,763,580,750) , KARYON
- KARYON = 1
-C
-C IS THE HBSTAT FLAG SET...
-C
- IF(JBIT(TEMP(1),7).EQ.1) GO TO 510
- 761 LOPCON = NCHX
- IF(NUMOPT.EQ.4) LOPCON = NCHY
- 762 LOPCON = LOPCON+3
- GO TO 530
- 763 IF(NUMOPT.EQ.3.AND.JBIT(TEMP(1),9).EQ.0) GO TO 750
- IF(NUMOPT.EQ.4.AND.JBIT(TEMP(1),10).EQ.0) GO TO 750
-C
-C BAR(X) OR BAR(Y) FLAG SET
-C
- 764 NW = (LOPCON-1) / (NBIT/NB) + 1
- KEEP1 = 1
- KARYON = 4
- GO TO 580
-C
-C SLICES ALONG X OR Y
-C
- 770 CONTINUE
- IF(KARYON.NE.0) GO TO (773,540,774,580,771) , KARYON
- NCSLYC = 0
- 771 IF(NCSLYC.EQ.NSLICE) GO TO 750
- KARYON = 1
- NCSLYC = NCSLYC+1
- IF(NUMOPT.EQ.5)LCONT=LQ(LSLIX-NCSLYC)
- IF(NUMOPT.EQ.6)LCONT=LQ(LSLIY-NCSLYC)
- IF(JBIT(TEMP(1),7).EQ.0) GO TO 773
-C
-C HBSTAT FLAG SET
-C
- DO 772 K = 1,6
- NEXT = NEXT+1
-** Q(K) = HPKR32(IQ(NEXT))
- 772 CONTINUE
- MISCUR = NEXT+1
- IF(MISCUR.GT.MIBEND) GO TO 490
- NEXT = MISCUR+1
-C
-C Restore the contents of the slice
-C
- 773 CONTINUE
- LOPCON = NCHX
- IF(NUMOPT.EQ.6) LOPCON = NCHY
- LOPCON = LOPCON+3
- GO TO 535
- 774 IF(NUMOPT.EQ.5.AND.JBIT(TEMP(1),9).EQ.0) GO TO 771
- IF(NUMOPT.EQ.6.AND.JBIT(TEMP(1),10).EQ.0) GO TO 771
-C
-C BAR(X) OR BAR(Y) FLAG SET
-C
- GO TO 764
-C
-C BANDS ON X OR Y
-C
- 780 CONTINUE
- IF(KARYON.NE.0) GO TO (782,540,783,580,750) , KARYON
- KARYON = 1
-C
-C IS THE HBSTAT FLAG SET...
-C
- IF(JBIT(TEMP(1),7).EQ.0) GO TO 782
- DO 781 K = 1,5
- NEXT = NEXT+1
-** Q(K) = HPKR32(IQ(NEXT))
- 781 CONTINUE
- MISCUR = NEXT+1
- IF(MISCUR.GT.MIBEND) GO TO 490
- NEXT = MISCUR+1
- 782 LOPCON = NCHX
- IF(NUMOPT.EQ.8) LOPCON = NCHY
- GO TO 762
- 783 IF(NUMOPT.EQ.7.AND.JBIT(TEMP(1),9).EQ.0) GO TO 750
- IF(NUMOPT.EQ.8.AND.JBIT(TEMP(1),10).EQ.0) GO TO 750
-C
-C BAR(X) OR BAR(Y) FLAG SET
-C
- GO TO 764
- 990 I = JBYT(TEMP(1),17,5)
- IF(I.EQ.0) GO TO 995
-C
-C There are a few editing constants as well
-C
- IF(JBIT(TEMP(1),17).EQ.0) GO TO 991
- NEXT = NEXT+1
- J = HPKR32(IQ(NEXT))+0.1
- CALL HBIGBI(NEWID,J)
- IF(IERR.NE.0) GO TO 999
- 991 IF(JBIT(TEMP(1),18).EQ.0) GO TO 992
- NEXT = NEXT+1
- VALUE = HPKR32(IQ(NEXT))
- CALL HNORMA(NEWID,HPKR32(IQ(NEXT)))
- IF(IERR.NE.0) GO TO 999
- 992 IF(JBIT(TEMP(1),19).EQ.0) GO TO 993
- NEXT = NEXT+1
- CALL HSCALE(NEWID,HPKR32(IQ(NEXT)))
- IF(IERR.NE.0) GO TO 999
- 993 IF(JBIT(TEMP(1),20).EQ.0) GO TO 994
- NEXT = NEXT+1
- CALL HMAXIM(NEWID,HPKR32(IQ(NEXT)))
- IF(IERR.NE.0) GO TO 999
- 994 IF(JBIT(TEMP(1),21).EQ.0) GO TO 995
- NEXT = NEXT+1
- CALL HMINIM(NEWID,HPKR32(IQ(NEXT)))
- IF(IERR.NE.0) GO TO 999
-C
-C end of histogram, any more to do...
-C
- 995 IF(IDD.NE.0) GO TO 999
- IF(I.EQ.0) GO TO 200
- MISCUR = NEXT+1
- IF(MISCUR.GT.MIBEND) GO TO 100
- NEXT = MISCUR+1
- GO TO 200
-C
-C required id not on the tape
-C
- 996 CALL HBUG('Unknown histogram','HREAD',IDD)
- GO TO 999
-C
-C tape format error - abnormal termination
-C
- 997 IF(IDD.EQ.0) GO TO 999
- NEWID = ID
- CALL HBUG('Error while reading','HREAD',NEWID)
- 999 RETURN
- END
diff --git a/src/packlib/hbook/code/hrebin.F b/src/packlib/hbook/code/hrebin.F
deleted file mode 100644
index 9c49bad..0000000
--- a/src/packlib/hbook/code/hrebin.F
+++ /dev/null
@@ -1,133 +0,0 @@
-*
-* $Id: hrebin.F,v 1.2 1996/03/27 10:52:43 couet Exp $
-*
-* $Log: hrebin.F,v $
-* Revision 1.2 1996/03/27 10:52:43 couet
-* The test ILAS.LE.IFIRS is now a LT this allow to rebin only one channel.
-*
-* Revision 1.1.1.1 1996/01/16 17:07:47 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.23/01 24/01/95 11.09.42 by Julian Bunn
-*-- Author :
- SUBROUTINE HREBIN(ID,X,Y,DX,DY,NNR,IFIRST,ILAST)
-*.==========>
-*. CHANNELS OF ID BETWEEN IFIRST,ILAST ARE CUMULATED INTO
-*. NNR BINS
-*. X ARRAY OF NEW ABCISSA VALUES
-*. Y ARRAY OF CUMULATED CONTENTS
-*. DX ARRAY OF X ERRORS
-*. DY ARRAY OF Y ERRORS
-*.
-*. If NNR<0 Errors in X are computed assuming a flat
-*. distribution in one bin
-*.
-*. If IFIRST<0 do not normalize result in Y
-*.
-*. Modifications
-*. =============
-*. JJB 16/1/95 Allow for variable width bins. Changed error calc.
-*..=========> ( R.Brun )
-#include "hbook/hcmail.inc"
- DIMENSION X(1),Y(1),DX(1),DY(1)
- LOGICAL LSIGX,NORMAL
-*.___________________________________________
- NARG=8
- CALL NOARG(NARG)
- LSIGX = .FALSE.
- NN=NNR
-*
-* GET HISTOGRAM SPECIFICATIONS
-*
- CALL HGIVE(ID,CHMAIL,NCX,XLOW,XUP,NCY,YLOW,YUP,NWT,IAD)
-*
- IF (NCX.LE.0) GO TO 99
- N=NCX
-
- IFIRS=1
- ILAS=NCX
- IF(NARG.GE.6) THEN
- IF (NN .LT. 0.) THEN
- LSIGX = .TRUE.
- NN = -NN
- ENDIF
- N=NN
- ENDIF
- IF(NARG.GE.7)IFIRS=IFIRST
- IF(NARG.GE.8)ILAS=ILAST
- IF(IFIRS.LT.0)THEN
- IFIRS=-IFIRS
- NORMAL=.FALSE.
- ELSE
- NORMAL=.TRUE.
- ENDIF
- IF(IFIRS.LE.0)IFIRS=1
- IF(IFIRS.GT.NCX)IFIRS=1
- IF(ILAS.GT.NCX)ILAS=NCX
- IF(ILAS.LT.IFIRS)ILAS=NCX
- IF(N.LE.0)N=NCX
- IF(N.GT.NCX)N=NCX
- NTOT = ILAS - IFIRS + 1
- IF (N.GT.NTOT)N = NTOT
- NEW = NTOT / N
-*
-* FILL NEW BINS,ETC.
-*
- DO 20 J = 1,N
- I1 = IFIRS + NEW * (J - 1)
- I2 = I1 + NEW - 1
- IF (I2.GT.ILAS)I2 = ILAS
-*
- Y(J) = 0.
- DY(J) = 0.
- XMEAN = 0.
- XRMS = 0.
-*
-* LOOP ON ALL CHANNELS GOING INTO NEW BIN "J"
-*
- numnew = 0
- DO 10 I = I1,I2
- numnew = numnew + 1
-c
-c Get lower edge of bin I
-c
- call hix(id,i,xlower)
-c
-c Get upper edge of bin I (= low edge of bin I+1)
-c
- xupper = xup
- if(i+1.le.ncx) call hix(id,i+1,xupper)
-c
-c Calculate centre of bin
-c
- xbin = 0.5*(xupper+xlower)
-c
-c Calculate width of new bin
-c
- if(i.eq.i1) xstart = xlower
- if(i.eq.i2) binwid = xupper-xstart
-c
- XMEAN = XMEAN + XBIN
- Y(J) = Y(J) + HI(ID,I)
- EY = HIE(ID,I)
- DY(J) = DY(J) + EY**2
- 10 CONTINUE
-*
- X(J) = XMEAN / numnew
- IF (LSIGX) THEN
- DX(J) = binwid /sqrt(12.)
- ELSE
- DX(J) = 0.5*binwid
- ENDIF
- IF(NORMAL)THEN
- DY(J) = SQRT(DY(J)) / numnew
- Y(J) = Y(J) / numnew
- ELSE
- DY(J) = SQRT(DY(J))
- ENDIF
- 20 CONTINUE
-*
- 99 RETURN
- END
diff --git a/src/packlib/hbook/code/hrename.F b/src/packlib/hbook/code/hrename.F
deleted file mode 100644
index 00cecbd..0000000
--- a/src/packlib/hbook/code/hrename.F
+++ /dev/null
@@ -1,106 +0,0 @@
-*
-* $Id: hrename.F,v 1.1.1.1 1996/01/16 17:07:47 mclareni Exp $
-*
-* $Log: hrename.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:47 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.22/04 06/06/94 20.09.36 by Fons Rademakers
-*-- Author : Rene Brun 26/05/94
- SUBROUTINE HRENAME(ID1,CHOLD,CHNEW)
-*.==========>
-*. To rename column CHOLD of ntuple ID into CHNEW
-*..=========> ( R. Brun )
-#include "hbook/hcflag.inc"
-#include "hbook/hcbook.inc"
-#include "hbook/hcbits.inc"
-#include "hbook/hcntpar.inc"
-*
- CHARACTER*(*) CHOLD, CHNEW
- CHARACTER*32 COLD, CNEW, CIVAR
- CHARACTER*8 TAGS, TOLD, TNEW, BLOCK
- INTEGER HNBPTR, HNMPTR
- LOGICAL NTOLD
-*.___________________________________________
-*
- ID = ID1
- IDPOS = LOCATI(IQ(LTAB+1),IQ(LCDIR+KNRH),ID)
- IF(IDPOS.LE.0)THEN
- LCID=0
- CALL HBUG('Unknown Ntuple','HRENAME',ID)
- GO TO 99
- ENDIF
- IDLAST = ID1
- LCID = LQ(LTAB-IDPOS)
- I4 = JBIT(IQ(LCID+KBITS),4)
- IF( I4.EQ.0 ) RETURN
-*
- IF (IQ(LCID-2) .NE. ZLINK) THEN
- NTOLD = .TRUE.
- ELSE
- NTOLD = .FALSE.
- ENDIF
-*
- IF (NTOLD) THEN
- NVAR = IQ(LCID+2)
- ITAG1 = IQ(LCID+10)
- ELSE
- NVAR = IQ(LCID+ZNDIM)
- ITIT1 = IQ(LCID+ZITIT1)
- ENDIF
-*
-* Loop over all ntuple column names until we find CHOLD
-*
- IF (NTOLD) THEN
- TOLD=CHOLD
- TNEW=CHNEW
- DO 10 I = 1, NVAR
- CALL UHTOC( IQ(LCID+ITAG1+2*(I-1)), 4, TAGS, 8 )
- IF(TAGS.EQ.TOLD)THEN
- CALL UCTOH(TNEW,IQ(LCID+ITAG1+2*(I-1)),4,8)
- GO TO 99
- ENDIF
- 10 CONTINUE
- ELSE
- COLD = CHOLD
- CNEW = CHNEW
- CALL HVXIST(COLD, BLOCK, CIVAR, IT, IS, IE)
- IF (IE .NE. 0) THEN
- LBLOK = HNBPTR(BLOCK)
- LNAME = LQ(LBLOK-1)
- IOFF = HNMPTR(COLD)
-*
-*-- make sure there is enough space in the LCHAR bank
-*
- LL = LENOCC(CNEW)
- JMAX = IQ(LCID+ZIFCHA)-1 + LL
- IF (JMAX .GT. IQ(LCHAR-1)) THEN
- CALL MZPUSH(IHDIV, LCHAR, 0, LL, 'I')
- ENDIF
-*
-*-- in ZLNAME: the length of the new variable name
-*
- IQ(LNAME+IOFF+ZLNAME) = LL
-*
-*-- in ZNAME: the pointer to the new name in LCHAR
-*--
-*-- NOTE: the space of the old name is not recuperated since that
-*-- would involve a pass over all variables to update all pointers
-*-- to the LCHAR bank. This is not a problem since HRENAME will not
-*-- be called that often.
-*
- I = IQ(LCID+ZIFCHA)
- IQ(LNAME+IOFF+ZNAME) = I
- CALL UCTOH(CNEW, IQ(LCHAR+I), 4, LL)
- IQ(LCID+ZIFCHA) = IQ(LCID+ZIFCHA) + (LL+3)/4
-*
-*-- Ntuple structure has been changed.
-*
- LBLOK = LQ(LCID-1)
- CALL SBIT1(IQ(LBLOK),1)
- ENDIF
- ENDIF
-*
- 99 END
diff --git a/src/packlib/hbook/code/hrep1.F b/src/packlib/hbook/code/hrep1.F
deleted file mode 100644
index 18014dd..0000000
--- a/src/packlib/hbook/code/hrep1.F
+++ /dev/null
@@ -1,39 +0,0 @@
-*
-* $Id: hrep1.F,v 1.1.1.1 1996/01/16 17:07:47 mclareni Exp $
-*
-* $Log: hrep1.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:47 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.10/05 01/09/89 08.59.21 by Rene Brun
-*-- Author :
- SUBROUTINE HREP1(IDD,ICX,VALUE)
-*.==========>
-*. Replace contents of channel ICX by new value VALUE
-*. (only for 1-DIM histograms)
-*..=========> ( R.Brun )
-#include "hbook/hcbits.inc"
-#include "hbook/hcbook.inc"
-#include "hbook/hcprin.inc"
-*.___________________________________________
- CALL HFIND(IDD,'HREP1')
- IF(LCID.LE.0)GO TO 99
- CALL HDCOFL
- IF(I1.EQ.0)GO TO 99
- CALL SBIT0(IQ(LCID),5)
- IF(NB.GE.32)THEN
- Q(LCONT+KCON1+ICX)=VALUE
- ELSE
- NBB=32/NB
- L1=ICX/NBB
- L2=(ICX-NBB*L1)*NB +1
- INC=VALUE
- IF(INC.LT.0)INC=0
- IF(INC.GT.MAXBIT(NB))INC=MAXBIT(NB)
- CALL SBYT(INC,IQ(LCONT+L1+KCON1),L2,NB)
- ENDIF
-*
- 99 RETURN
- END
diff --git a/src/packlib/hbook/code/hreset.F b/src/packlib/hbook/code/hreset.F
deleted file mode 100644
index b7919f8..0000000
--- a/src/packlib/hbook/code/hreset.F
+++ /dev/null
@@ -1,175 +0,0 @@
-*
-* $Id: hreset.F,v 1.1.1.1 1996/01/16 17:07:47 mclareni Exp $
-*
-* $Log: hreset.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:47 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.22/08 04/07/94 08.53.18 by Rene Brun
-*-- Author :
- SUBROUTINE HRESET(IDD,CHTITL)
-*.==========>
-*. RESETS TO 0. CONTENT OF IDD
-*. OPTIONNALY CHANGE TITLE
-*..=========> ( R.Brun )
-#include "hbook/hcbits.inc"
-#include "hbook/hcbook.inc"
- CHARACTER*(*) CHTITL
- CHARACTER*80 CHRZ
-*.___________________________________________
- NARG=2
- CALL NOARG(NARG)
- IRET=3
-*
- 10 CALL HLOOP(IDD,'HRESET',IRET)
- IF(IRET.EQ.0)GO TO 99
- CALL HDCOFL
- CALL SBIT0(IQ(LCID),5)
- IF(I4.NE.0)THEN
- IF(IDD.NE.0)THEN
- NDIM=IQ(LCID+2)
- NCHRZ=IQ(LCID+11)
- IF (IQ(LCID-2) .NE. 2) THEN
- CALL HNTRSET(IDD, CHTITL)
- GO TO 90
- ENDIF
-*
- LLIMS=LQ(LCID-2)
- DO 15 I=1,NDIM
- Q(LLIMS+2*I-1)=1.E31
- Q(LLIMS+2*I )=-1.E31
- 15 CONTINUE
- CALL SBIT1(IQ(LCONT),1)
- IQ(LCID+3)=0
- IQ(LCID+5)=IDD
- IQ(LCID+7)=1
- IQ(LCID+11)=0
- CALL HCDIR(CHRZ, 'R')
- IF (CHRZ(1:6) .EQ. '//PAWC') THEN
- IQ(LCID+11) = 0
- CHRZ = ' '
- ELSE
- IQ(LCID+11) = LENOCC(CHRZ)
- ENDIF
- CALL UCTOH(CHRZ,IQ(LCID+12),4,80)
-*
- CALL HBTIT(CHTITL,NWTITL,NCHT)
- IF (NWTITL .NE. 0) THEN
- NMORE = NWTITL - IQ(LCID+8)
- IF(NMORE.NE.0)THEN
- CALL MZPUSH(IHDIV,LCID,0,NMORE,' ')
- ENDIF
- ITIT1 = IQ(LCID+9)
- CALL UCTOH(CHTITL,IQ(LCID+ITIT1),4,NCHT)
- ENDIF
- IQ(LCID+8) = NWTITL
-* drop linear structure for memory resident ntuples
- IF(NCHRZ.EQ.0)THEN
- LR2=LQ(LCID-1)
- IF(LQ(LR2).NE.0)THEN
- CALL MZDROP(IHDIV,LQ(LR2),' ')
- ENDIF
- ENDIF
- ENDIF
- GO TO 90
- ENDIF
-*
-* CHANGE TITLE
-*
- IF(NARG.EQ.2.AND.I123.NE.0)THEN
- CALL HBTIT(CHTITL,NWTITL,NCHT)
- IF(NWTITL.NE.0)THEN
- IF(I1.NE.0)THEN
- NWOLD=IQ(LCID-1)-KTIT1+1
- J1=KTIT1
- ELSEIF(I230.NE.0)THEN
- NWOLD=IQ(LCID-1)-KTIT2+1
- J1=KTIT2
- ENDIF
- NMORE=NWTITL-NWOLD
- IF(NMORE.NE.0)THEN
- CALL MZPUSH(IHDIV,LCID,0,NMORE,' ')
- IQ(LCID+KNTOT)=IQ(LCID+KNTOT)+NMORE
- ENDIF
- IF(NWTITL.NE.0)THEN
- CALL UCTOH(CHTITL,IQ(LCID+J1),4,NCHT)
- ENDIF
- ENDIF
- ENDIF
-*
-* Reset contents
-*
-*======> Array
-*
- IF(I123.EQ.0)THEN
- CALL VZERO(IQ(LCID+1),IQ(LCID-1))
- GO TO 90
- ENDIF
-*
-*======> 1-DIM histogram
-*
- IF(I1.NE.0)THEN
- LCONT=LQ(LCID-1)
- CALL HSUPIS(SQRT,0,0,0)
- CALL HREZ0(LQ(LCID-1))
- GO TO 90
- ENDIF
-*
-*=====> 2-DIM histogram
-*
- IF(I230.NE.0)THEN
- LSCAT=LQ(LCID-1)
- CALL VZERO(IQ(LSCAT+KNOENT),IQ(LSCAT-1)-1)
-*
-* PROX
-*
- CALL HREZ0(LQ(LCID-2))
-*
-* PROY
-*
- CALL HREZ0(LQ(LCID-3))
-*
-* SLIX
-*
- LSLIX=LQ(LCID-4)
- IF(LSLIX.NE.0)THEN
- DO 40 I=1,IQ(LSLIX-2)
- CALL HREZ0(LQ(LSLIX-I))
- 40 CONTINUE
- ENDIF
-*
-* SLIY
-*
- LSLIY=LQ(LCID-5)
- IF(LSLIY.NE.0)THEN
- DO 50 I=1,IQ(LSLIY-2)
- CALL HREZ0(LQ(LSLIY-I))
- 50 CONTINUE
- ENDIF
-*
-* BANX
-*
- LBANX=LQ(LCID-6)
- 60 IF(LBANX.NE.0)THEN
- CALL HREZ0(LQ(LBANX-1))
- LBANX=LQ(LBANX)
- IF(LBANX.NE.0)GO TO 60
- ENDIF
-*
-* BANY
-*
- LBANY=LQ(LCID-7)
- 70 IF(LBANY.NE.0)THEN
- CALL HREZ0(LQ(LBANY-1))
- LBANY=LQ(LBANY)
- IF(LBANY.NE.0)GO TO 70
- ENDIF
- ENDIF
-*
- 90 IRET=2
- GO TO 10
-*
- 99 RETURN
- END
diff --git a/src/packlib/hbook/code/hrez0.F b/src/packlib/hbook/code/hrez0.F
deleted file mode 100644
index 68cb851..0000000
--- a/src/packlib/hbook/code/hrez0.F
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: hrez0.F,v 1.1.1.1 1996/01/16 17:07:47 mclareni Exp $
-*
-* $Log: hrez0.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:47 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.10/05 21/02/89 16.14.53 by Rene Brun
-*-- Author :
- SUBROUTINE HREZ0(LBANK)
-*.==========>
-*. RESETS TO 0. DATA STRUCTURE POINTED BY LBANK
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
-*.___________________________________________
- IF(LBANK.NE.0)THEN
- CALL VZERO(IQ(LBANK+KNOENT),IQ(LBANK-1)-1)
- LW=LQ(LBANK)
- IF(LW.NE.0)THEN
- CALL VZERO(IQ(LW+1),IQ(LW-1))
- LN=LQ(LW)
- IF(LN.NE.0)THEN
- CALL VZERO(IQ(LN+1),IQ(LN-1))
- ENDIF
- ENDIF
- LFUNC=LQ(LBANK-1)
- IF(LFUNC.NE.0)CALL VZERO(IQ(LFUNC+3),IQ(LFUNC-1)-2)
- ENDIF
- END
diff --git a/src/packlib/hbook/code/hrndm.F b/src/packlib/hbook/code/hrndm.F
deleted file mode 100644
index 6109f72..0000000
--- a/src/packlib/hbook/code/hrndm.F
+++ /dev/null
@@ -1,14 +0,0 @@
-*
-* $Id: hrndm.F,v 1.1.1.1 1996/01/16 17:07:47 mclareni Exp $
-*
-* $Log: hrndm.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:47 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.10/05 21/02/89 16.14.53 by Rene Brun
-*-- Author :
- FUNCTION HRNDM(IDD)
- HRNDM=HRNDM1(IDD)
- END
diff --git a/src/packlib/hbook/code/hrndm1.F b/src/packlib/hbook/code/hrndm1.F
deleted file mode 100644
index de3b63a..0000000
--- a/src/packlib/hbook/code/hrndm1.F
+++ /dev/null
@@ -1,83 +0,0 @@
-*
-* $Id: hrndm1.F,v 1.1.1.1 1996/01/16 17:07:47 mclareni Exp $
-*
-* $Log: hrndm1.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:47 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.19/00 26/04/93 11.57.51 by Rene Brun
-*-- Author :
- FUNCTION HRNDM1(IDD)
-*.==========>
-*. RETURN IN HRNDM1 A RANDOM NUMBER DISTRIBUTED
-*. FOLLOWING THE CONTENTS OF HISTOGRAM IDD.
-*. ( IDD CAN CONTAINS A FUNCTION )
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
-#include "hbook/hcflag.inc"
- SAVE JDLAST,NER,NCHA,XMIN,XWID
- DATA JDLAST/0/
- DATA NER/0/
-*.___________________________________________
- IF(IDD.NE.IDLAST)GO TO 5
- IF(IDD.EQ.JDLAST)GO TO 40
-*
-* LOCATE IDD IN BLANK COMMON
-*
- 5 JDLAST=IDD
- ID=IDD
- IDPOS=LOCATI(IQ(LTAB+1),IQ(LCDIR+KNRH),ID)
- IF(IDPOS.LE.0)GO TO 99
- LCID=LQ(LTAB-IDPOS)
- LCONT=LQ(LCID-1)
- IDLAST=IDD
-*
- NCHA=IQ(LCID+KNCX)
- XMIN=Q(LCID+KXMIN)
- XWID=(Q(LCID+KXMAX)-Q(LCID+KXMIN))/FLOAT(IQ(LCID+KNCX))
-*
-* COMPUTE INTEGRALE AND NORMALIZE
- IF(IQ(LCONT+KNOENT).EQ.-1)GO TO 40
- IF(IQ(LCONT+KNBIT).GE.32)GO TO 7
- IF(NER.EQ.0)CALL HBUG('Histogram with packing','HRNDM1',IDD)
- NER=1
- GO TO 99
-*
- 7 IQ(LCONT+KNOENT)=-1
- 10 CONTINUE
-*
- DO 20 I=2,NCHA
- 20 Q(LCONT+KCON1+I)=Q(LCONT+KCON1+I)+Q(LCONT+KCON1+I-1)
- IF(Q(LCONT+KCON1+NCHA).NE.0.)GO TO 27
-*
- DO 25 I=1,NCHA
- 25 Q(LCONT+KCON1+I)=1.
- CALL HBUG('Integral is zero','HRNDM1',IDD)
- GO TO 10
-*
- 27 CONTINUE
- DO 30 I=1,NCHA
- 30 Q(LCONT+KCON1+I)=Q(LCONT+KCON1+I)/Q(LCONT+KCON1+NCHA)
- Q(LCONT+KCON1)=0.
- CALL SBIT0(IQ(LCID),5)
-*
-*
-* NORMAL ENTRY
-*
- 40 R=RNDM(XMIN)
- ICHA=LOCATF(Q(LCONT+KCON1+1),NCHA,R)
- KCHA=IABS(ICHA)
- ICHA=KCHA+LCONT+KCON1+1
- DY=Q(ICHA)-Q(ICHA-1)
- IF(DY.GT.0.)THEN
- HRNDM1=XMIN+(R-Q(ICHA-1))*XWID/DY + XWID*FLOAT(KCHA)
- ELSE
- HRNDM1=XMIN + XWID*FLOAT(KCHA)
- ENDIF
- RETURN
-*
- 99 HRNDM1=0.
- IDLAST=0
- END
diff --git a/src/packlib/hbook/code/hrndm2.F b/src/packlib/hbook/code/hrndm2.F
deleted file mode 100644
index cfca0ff..0000000
--- a/src/packlib/hbook/code/hrndm2.F
+++ /dev/null
@@ -1,125 +0,0 @@
-*
-* $Id: hrndm2.F,v 1.1.1.1 1996/01/16 17:07:47 mclareni Exp $
-*
-* $Log: hrndm2.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:47 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.19/00 26/04/93 11.57.51 by Rene Brun
-*-- Author :
- SUBROUTINE HRNDM2(IDD,XR,YR)
-*.==========>
-*. RETURN IN XR AND YR 2 RANDOM NUMBERS DISTRIBUTED
-*. FOLLOWING THE CONTENTS OF IDD
-*. XR AND YR ARE 2 VARIABLES CORRELATED
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
-#include "hbook/hcflag.inc"
- SAVE JDLAST,NER,N,NCX,NCY,XMIN,YMIN,XWID,YWID
- DATA JDLAST/0/
- DATA NER/0/
-*.___________________________________________
- IF(IDD.NE.IDLAST)GO TO 5
- IF(IDD.EQ.JDLAST)GO TO 80
-*
-* LOCATES IDD IN BLANK COMMON
-*
- 5 JDLAST=IDD
- ID=IDD
- IDPOS=LOCATI(IQ(LTAB+1),IQ(LCDIR+KNRH),ID)
- IF(IDPOS.LE.0)GO TO 99
- LCID=LQ(LTAB-IDPOS)
- LCONT=LQ(LCID-1)
- LSCAT=LCONT
- IDLAST=IDD
-*
-* IF IS THE POINTER TO THE NUMBER OF ENTRIES
-*
- NCX=IQ(LCID+KNCX)+2
- XMIN=Q(LCID+KXMIN)
- XWID=(Q(LCID+KXMAX)-Q(LCID+KXMIN))/FLOAT(IQ(LCID+KNCX))
- NCY=IQ(LCID+KNCY)+2
- YMIN=Q(LCID+KYMIN)
- YWID=(Q(LCID+KYMAX)-Q(LCID+KYMIN))/FLOAT(IQ(LCID+KNCY))
-*
-* COMPUTE INTEGRALE AND NORMALISE
-*
- N=NCX*NCY
-*
- IF(IQ(LCONT+KNOENT).EQ.-1)GO TO 80
- IF(IQ(LCONT+KNBIT).GE.32)GO TO 10
- IF(NER.EQ.0)CALL HBUG('Histogram with packing','HRNDM2',IDD)
- NER=1
- GO TO 99
-*
-*
- 10 K=LCONT+KCON2-1
- Q(K)=0.
- DO 42 JJ=1,NCY
- J=NCY-JJ+1
- DO 40 I=1,NCX
- K=K+1
- IF(I.GT.1.AND.I.LT.NCX)GO TO 20
- Q(K)=0.
- GO TO 30
- 20 IF(J.GT.1.AND.J.LT.NCY)GO TO 30
- Q(K)=0.
- 30 Q(K)=Q(K)+Q(K-1)
- 40 CONTINUE
- 42 CONTINUE
-*
- IF(Q(K).NE.0.)GO TO 70
- CALL HBUG('Integral is zero','HRNDM2',IDD)
-*
- K=LCONT+KCON2-1
- DO 62 JJ=1,NCY
- J=NCY-JJ+1
- DO 60 I=1,NCX
- K=K+1
- Q(K)=1.
- IF(I.GT.1.AND.I.LT.NCX)GO TO 45
- Q(K)=0.
- GO TO 50
- 45 IF(J.GT.1.AND.J.LT.NCY)GO TO 50
- Q(K)=0.
- 50 Q(K)=Q(K)+Q(K-1)
- 60 CONTINUE
- 62 CONTINUE
-*
- 70 CONTINUE
-*
- DO 75 I=1,N
- 75 Q(LCONT+KCON2+I-1)=Q(LCONT+KCON2+I-1)/Q(K)
- IQ(LCONT+KNOENT)=-1
- CALL SBIT0(IQ(LCID),5)
-*
-*
-* NORMAL ENTRY
-*
-*
- 80 R=RNDM(XMIN)
- ICHA=LOCATF(Q(LCONT+KCON2),N,R)
- JCHA=IABS(ICHA)+LCONT+KCON2
- DXINT=Q(JCHA)-Q(JCHA-1)
- IF(DXINT.GT.0.)THEN
- DX=XWID*(R-Q(JCHA-1))/DXINT
- ELSE
- DX=0.
- ENDIF
- DY=YWID*RNDM(YMIN)
- ICHA=JCHA-LCONT-KCON2+1
-*
- I=MOD(ICHA,NCX)
- IF(I.EQ.0)I=NCX
- J=NCY-(ICHA-I)/NCX
-*
- XR=XMIN+XWID*FLOAT(I-2)+DX
- YR=YMIN+YWID*FLOAT(J-2)+DY
- RETURN
-*
- 99 XR=0.
- YR=0.
- IDLAST=0
- END
diff --git a/src/packlib/hbook/code/hrngpf.F b/src/packlib/hbook/code/hrngpf.F
deleted file mode 100644
index 9ff3ff3..0000000
--- a/src/packlib/hbook/code/hrngpf.F
+++ /dev/null
@@ -1,42 +0,0 @@
-*
-* $Id: hrngpf.F,v 1.1.1.1 1996/01/16 17:07:47 mclareni Exp $
-*
-* $Log: hrngpf.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:47 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.20/08 07/09/93 11.57.08 by Fons Rademakers
-*-- Author : Fons Rademakers 20/08/93
- SUBROUTINE HRNGPF(NSLAV, MYSID, IFIRST, ITO)
-************************************************************************
-* *
-* Depending on the number of active slaves and the slave id, calculate *
-* the range of events this slave has to analyze. *
-* IFIRST and ITO are input and output parameters. *
-* *
-************************************************************************
-*
-*-- Total number of events
-*
- ITOT = ITO - IFIRST + 1
-*
-*-- Events per slave
-*
- IEV = NINT(FLOAT(ITOT) / FLOAT(NSLAV))
- IF (IEV .EQ. 0) IEV = 1
- IMAX = ITO
-*
-*-- Find range for this slave
-*
- DO 10 I = 1, NSLAV
- ITO = IFIRST + IEV - 1
- IF (I .EQ. MYSID) GOTO 20
- IFIRST = IFIRST + IEV
-10 CONTINUE
-*
-20 IF (ITO .GT. IMAX) ITO = IMAX
- IF (MYSID.EQ.NSLAV .AND. ITO.LT.IMAX) ITO = IMAX
-*
- END
diff --git a/src/packlib/hbook/code/hrotat.F b/src/packlib/hbook/code/hrotat.F
deleted file mode 100644
index 09412ff..0000000
--- a/src/packlib/hbook/code/hrotat.F
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: hrotat.F,v 1.1.1.1 1996/01/16 17:07:47 mclareni Exp $
-*
-* $Log: hrotat.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:47 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.10/05 21/02/89 16.14.53 by Rene Brun
-*-- Author :
- SUBROUTINE HROTAT(ID1)
-*.==========>
-*. HISTOGRAM WILL BE PRINTED ROTATED BY 90 DEGREES
-*..=========> ( R.Brun )
-*.___________________________________________
- CALL HIDOPT(ID1,'ROTA')
- CALL HOBSOL('HROTAT','ROTA','NROT')
- END
diff --git a/src/packlib/hbook/code/hrval.F b/src/packlib/hbook/code/hrval.F
deleted file mode 100644
index 599b2d7..0000000
--- a/src/packlib/hbook/code/hrval.F
+++ /dev/null
@@ -1,68 +0,0 @@
-*
-* $Id: hrval.F,v 1.1.1.1 1996/01/16 17:07:47 mclareni Exp $
-*
-* $Log: hrval.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:47 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.10/05 21/02/89 16.14.53 by Rene Brun
-*-- Author :
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION HRVAL (X)
-#endif
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION FUNCTION HRVAL (X)
-#endif
-*.==========>
-*. GIVES THE VALUE OF THE REGRESSION COMPUTED AT
-*. POINT X (PREDICTION)
-*..=========> ( D.Lienart )
- DIMENSION X(1),XN(10)
-#include "hbook/hcpar1.inc"
-#include "hbook/hcpar2.inc"
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION COEFF,P,HSTELF,HELEFT,HBASFT
-#endif
-*
-* NORMALIZE X USING THE SAME TRANSFORMATION AS FOR THE
-* ORIGINAL SAMPLE
-*
- IF (IOPT(8).EQ.0) THEN
- DO 5 I=1,ND
- XN(I)=X(I)
- 5 CONTINUE
- ELSE
- IF (IOPT(8).EQ.3) THEN
- DO 10 I=1,ND
- XN(I)=X(I)-XMIN(I)
- 10 CONTINUE
- ELSE
- DO 15 I=1,ND
- XN(I)=ALIM(I)+(BLIM(I)-ALIM(I))*(X(I)-XMIN(I))/
- + (XMAX(I)-XMIN(I))
- 15 CONTINUE
- ENDIF
- ENDIF
-*
-* COMPUTE REGRESSION VALUE
-*
- HRVAL=0.
- DO 30 K=1,NCO
- P=1.
- DO 20 I=1,ND
- NUM=IBASFT(I,K)/10
- ITYP=IBASFT(I,K)-NUM*10
- IF (NUM.NE.0) THEN
- IF (ITYP.EQ.0) P=P*HSTELF(IOPT(4),NUM,XN(I))
- IF (ITYP.EQ.1) P=P*HELEFT(NUM,XN(I))
- IF (ITYP.EQ.2) THEN
- P=HBASFT(NUM,XN)
- GOTO 25
- ENDIF
- ENDIF
- 20 CONTINUE
- 25 HRVAL=HRVAL+COEFF(K)*P
- 30 CONTINUE
- END
diff --git a/src/packlib/hbook/code/hscale.F b/src/packlib/hbook/code/hscale.F
deleted file mode 100644
index 7aa2655..0000000
--- a/src/packlib/hbook/code/hscale.F
+++ /dev/null
@@ -1,37 +0,0 @@
-*
-* $Id: hscale.F,v 1.1.1.1 1996/01/16 17:07:48 mclareni Exp $
-*
-* $Log: hscale.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:48 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.19/00 26/04/93 14.38.24 by Rene Brun
-*-- Author :
- SUBROUTINE HSCALE(ID2,SCALE)
-*.==========>
-*. STORE SCALE FACTOR FOR SCATTER-PLOTS
-*..=========> ( R.Brun )
-#include "hbook/hcbits.inc"
-#include "hbook/hcbook.inc"
-*.___________________________________________
- IRET=3
- NARG=2
- CALL NOARG(NARG)
- SCAL=0.
- IF(NARG.EQ.2)SCAL=FLOARG(SCALE)
-*
- 10 CALL HLOOP(ID2,'HSCALE',IRET)
- IF(IRET.EQ.0)GO TO 99
-*
- CALL HDCOFL
- IF(I230.NE.0)THEN
- Q(LCID+KSCAL2)=SCAL
- CALL HSIFLA(19,1)
- ENDIF
- IRET=2
- GO TO 10
-*
- 99 RETURN
- END
diff --git a/src/packlib/hbook/code/hselbf.F b/src/packlib/hbook/code/hselbf.F
deleted file mode 100644
index c88e505..0000000
--- a/src/packlib/hbook/code/hselbf.F
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: hselbf.F,v 1.1.1.1 1996/01/16 17:07:48 mclareni Exp $
-*
-* $Log: hselbf.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:48 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.10/05 21/02/89 16.14.53 by Rene Brun
-*-- Author :
- LOGICAL FUNCTION HSELBF (IELEF)
-*.==========>
-*. SELECTS OR REJECTS BASIC FUNCTION IELEF
-*. THIS IS A DEFAULT FUNCTION
-*..=========> ( R.Brun )
- DIMENSION IELEF(1)
- HSELBF=.TRUE.
- END
diff --git a/src/packlib/hbook/code/hseqnr.F b/src/packlib/hbook/code/hseqnr.F
deleted file mode 100644
index 7ae77f2..0000000
--- a/src/packlib/hbook/code/hseqnr.F
+++ /dev/null
@@ -1,83 +0,0 @@
-*
-* $Id: hseqnr.F,v 1.2 1996/02/20 16:47:42 cernlib Exp $
-*
-* $Log: hseqnr.F,v $
-* Revision 1.2 1996/02/20 16:47:42 cernlib
-* Merge hseqnr.F and hseqnd.F into hseqnr.F;delete hseqnd.F.
-* These routines were identical, except for singe/double precision, and
-* only one of them is used on a given machine.
-*
-* Revision 1.1.1.1 1996/01/16 17:07:48 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.22/11 23/08/94 14.17.45 by Rene Brun
-*-- Author :
-#if defined(CERNLIB_DOUBLE)
- SUBROUTINE HSEQND(N,A,IDIM,IFAIL,K,B)
-#else
- SUBROUTINE HSEQNR(N,A,IDIM,IFAIL,K,B)
-#endif
-*.==========>
-*. Auxiliary to HFITPO/HFITEX. Called by HLSQ
-* Extracted from CERN Program library routine RSEQN
-*..=========> ( R.Brun from CERNLIB )
-
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION A(IDIM,*), B(IDIM,*), ONE
- DOUBLE PRECISION S1, S21, S22
-#else
- REAL A(IDIM,*), B(IDIM,*), ONE
- REAL S1, S21, S22
-#endif
- DATA ONE / 1. /
- IF(IDIM .LT. N) GOTO 999
-*SEQ, SFACT.
- IFAIL = 0
- DO 144 J = 1, N
- IF(A(J,J) .LE. 0.) GOTO 150
- A(J,J) = ONE / A(J,J)
- IF(J .EQ. N) GOTO 199
- 140 JP1 = J+1
- DO 143 L = JP1, N
- A(J,L) = A(J,J)*A(L,J)
- S1 = -A(L,J+1)
- DO 141 I = 1, J
- S1 = A(L,I)*A(I,J+1)+S1
- 141 CONTINUE
- A(L,J+1) = -S1
- 143 CONTINUE
- 144 CONTINUE
- 150 IFAIL = -1
- RETURN
- 199 CONTINUE
-*SEQ, SFEQN.
- IF(K .LE. 0) GOTO 999
- DO 220 L = 1, K
- B(1,L) = A(1,1)*B(1,L)
- 220 CONTINUE
- IF(N .EQ. 1) GOTO 999
- DO 243 L = 1, K
- DO 232 I = 2, N
- IM1 = I-1
- S21 = - B(I,L)
- DO 231 J = 1, IM1
- S21 = A(I,J)*B(J,L)+S21
- 231 CONTINUE
- B(I,L) = - A(I,I)*S21
- 232 CONTINUE
- NM1 = N-1
- DO 242 I = 1, NM1
- NMI = N-I
- S22 = - B(NMI,L)
- DO 241 J = 1, I
- NMJP1 = N - J+1
- S22 = A(NMI,NMJP1)*B(NMJP1,L)+S22
- 241 CONTINUE
- B(NMI,L) = - S22
- 242 CONTINUE
- 243 CONTINUE
- 999 RETURN
- END
-
diff --git a/src/packlib/hbook/code/hsetbf.F b/src/packlib/hbook/code/hsetbf.F
deleted file mode 100644
index 278679f..0000000
--- a/src/packlib/hbook/code/hsetbf.F
+++ /dev/null
@@ -1,96 +0,0 @@
-*
-* $Id: hsetbf.F,v 1.1.1.1 1996/01/16 17:07:48 mclareni Exp $
-*
-* $Log: hsetbf.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:48 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.10/05 31/08/90 18.33.21 by Rene Brun
-*-- Author :
- SUBROUTINE HSETBF (IBASFT,MAXPOW,SELLIM)
-*.==========>
-*. SET UP BASIC FUNCTIONS TABLE BY SELECTING FROM
-*. THE USER-GIVEN BASIC AND ELEMENTARY FUNCTIONS AND
-*. FROM THE STANDARD POLYNOMIALS
-*. HSELBF = USER-WRITTEN SELECTION FUNCTION
-*. IELEF = A BASIC FUNCTION REPRESENTATION, SAME
-*. CODING AS FOR IBASFT
-*..=========> ( D.Lienart )
- LOGICAL HSELBF,LSEL
-#include "hbook/hcpar1.inc"
-#include "hbook/hcpout.inc"
-#include "hbook/hcunit.inc"
- DIMENSION IBASFT(ND,NBFMAX),MAXPOW(1),IELEF(10)
-*
-* USER-GIVEN BASIC FUNCTION SELECTION
-*
- DO 10 K=1,NBF
- LSEL=.TRUE.
- IELEF(1)=K*10+2
- IF (IOPT(6).EQ.1) THEN
- DO 5 I=2,ND
- IELEF(I)=K*10+2
- 5 CONTINUE
- LSEL=HSELBF(IELEF)
- ENDIF
- IF (LSEL) IBASFT(1,K)=IELEF(1)
- 10 CONTINUE
-*
-* ELEMENTARY FUNCTION SELECTION TEST
-* STANDARD POLYNOMIALS MAY BE SELECTED BY A DEGREE LIMITING PROCEDURE
-*
- CALL VZERO (IELEF,ND)
-*
- 15 IF (IOPT(6).EQ.0) THEN
- S=0.
- DO 20 I=1,ND
- IS=IELEF(I)/10
- IF (IS*10.EQ.IELEF(I).AND.MAXPOW(I).NE.0) S=S+
- + FLOAT(IS)/MAXPOW(I)
- 20 CONTINUE
- LSEL=S.LE.SELLIM
- ELSE
- LSEL=HSELBF(IELEF)
- ENDIF
-*
-* BUILD UP IBASFT
-*
- IF (LSEL) THEN
- NBF=NBF+1
- IF (NBF.GT.NBFMAX) THEN
- WRITE (LERR,100) NBFMAX
- IFLAG=5
- RETURN
- ENDIF
- DO 25 I=1,ND
- IBASFT(I,NBF)=IELEF(I)
- 25 CONTINUE
- ENDIF
-*
-* GENERATE ALL POSSIBLE BASIC FUNCTIONS MADE UP FROM
-* ELEMENTARY FUNCTIONS ; MAXPOW AND NEF ARE USED AS LIMITORS
-*
- DO 35 I=1,ND
- NUM=IELEF(I)/10
- ITYP=IELEF(I)-NUM*10
- IF (ITYP.EQ.0) NUMMAX=MAXPOW(I)
- IF (ITYP.EQ.1) NUMMAX=NEF
- IF ((NEF.NE.0.AND.ITYP.EQ.0).OR.NUM.LT.NUMMAX) THEN
- DO 30 K=1,I-1
- IELEF(K)=0
- 30 CONTINUE
- IF (NUM.LT.NUMMAX) THEN
- IELEF(I)=(NUM+1)*10+ITYP
- GOTO 15
- ELSE
- IELEF(I)=11
- GOTO 15
- ENDIF
- ENDIF
- 35 CONTINUE
-*
- 100 FORMAT (' UNABLE TO BUILD THE BASIC FUNCTIONS TABLE ',
- + '- MAXIMUM NUMBER OF CANDIDATE FUNCTIONS > ',I3)
- END
diff --git a/src/packlib/hbook/code/hsetpr.F b/src/packlib/hbook/code/hsetpr.F
deleted file mode 100644
index f31736f..0000000
--- a/src/packlib/hbook/code/hsetpr.F
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: hsetpr.F,v 1.1.1.1 1996/01/16 17:07:48 mclareni Exp $
-*
-* $Log: hsetpr.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:48 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.10/05 05/03/89 09.22.02 by Rene Brun
-*-- Author :
- SUBROUTINE HSETPR (NAME,VALUE)
-*.==========>
-*. SETS A HFIT OR HPARAM PARAMETER 'NAME' TO A SPECIFIED VALUE
-*..=========> ( R.Brun ,D.Lienart )
-#include "hbook/hcpar0.inc"
- CHARACTER*4 NAME,NAMPAR(9)
- DIMENSION VALPAR(9)
- EQUIVALENCE (PNEF,VALPAR(1))
- SAVE NAMPAR
- DATA NAMPAR /'PNEF','PNBF','PSEL','PFLV','PLUN','PNBX','PNCX',
- + 'FNIX','FEPS'/
-*
-*
- DO 10 I=1,9
- IF (NAME.EQ.NAMPAR(I)) THEN
- VALPAR(I)=VALUE
- RETURN
- ENDIF
- 10 CONTINUE
- END
diff --git a/src/packlib/hbook/code/hsgz.F b/src/packlib/hbook/code/hsgz.F
deleted file mode 100644
index dff73ba..0000000
--- a/src/packlib/hbook/code/hsgz.F
+++ /dev/null
@@ -1,79 +0,0 @@
-*
-* $Id: hsgz.F,v 1.1.1.1 1996/01/16 17:07:48 mclareni Exp $
-*
-* $Log: hsgz.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:48 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.22/11 23/08/94 14.17.45 by Rene Brun
-*-- Author :
- SUBROUTINE HSGZ (TFUNC,M,S,Z,G,A,DF,EXDA,PL0,AMX,AMN)
-*.==========>
-*. HSGZ SETS UP S(OBJECTIVE MIN. FUNCTION),
-*. G(GRADIENT OF S) AND Z(APPROXIMATE COVARIANCE MATRIX)
-*..=========> ( I.Ivanchenko )
- DIMENSION Z(1),G(1),A(1),DF(1),EXDA(1),PL0(1),AMX(1),AMN(1)
-#include "hbook/hcfit1.inc"
-#include "hbook/hcfit2.inc"
-#include "hbook/hcflag.inc"
- EXTERNAL TFUNC
-*.___________________________________________
- NUMEP1=0
- K=NUMEP
- K2=1
- DO 18 L1=1,K
- K1=K2
- IF(IFLBUF.EQ.0)K1=1
- NX=IDIMPN-2
-*
- IF(IFLBUF.EQ.1)GO TO 5
- CALL HEXDA1(EXDA,L1,IFLRET)
- IF(IFLRET.EQ.0)GO TO 18
-*
- 5 CONTINUE
- NUMEP1=NUMEP1+1
- DO 6 I=1,NX
- KI=K1+1+I
- XFUMIL(I)=EXDA(KI)
- 6 CONTINUE
- 7 CONTINUE
- IF(IFLFUN.EQ.2)Y=TFUNC(XFUMIL)
- IF(IFLFUN.EQ.1.AND.IDER.EQ.0)CALL HARITH(TFUNC,Y,A,DF,PL0,AMX,
- + AMN)
- IF(IFLFUN.EQ.2.OR.IDER.EQ.0)GO TO 9
- IF(IDIMPN.EQ.4)GO TO 8
- Y=TFUNC(XFUMIL)
- CALL HDERI1(ID,XFUMIL,A,DF)
- GO TO 9
- 8 XHFIT=XFUMIL(1)
- YHFIT=XFUMIL(2)
- CALL HTFUNC(TFUNC,XHFIT,YHFIT,Y)
-*
- CALL HDERI2(ID,XHFIT,YHFIT,A,DF)
- 9 CONTINUE
-*
-* CHI SQUARED
-*
- 11 SIG=EXDA(K1+1)
- Y=Y-EXDA(K1)
- S=S+((Y/SIG)**2)/2.
- 12 CONTINUE
- N=0
- DO 14 J=1,M
- IF (PL0(J)) 14,14,13
- 13 N=N+1
- DF(N)=DF(J)/SIG
- G(J)=G(J)+DF(N)*(Y/SIG)
- 14 CONTINUE
- L=1
- IF (N.LT.1) GO TO 17
- DO 16 I=1,N
- DO 16 J=1,I
- Z(L)=Z(L)+DF(I)*DF(J)
- L=L+1
- 16 CONTINUE
- 17 K2=K2+IDIMPN
- 18 CONTINUE
- END
diff --git a/src/packlib/hbook/code/hsifla.F b/src/packlib/hbook/code/hsifla.F
deleted file mode 100644
index 6864b60..0000000
--- a/src/packlib/hbook/code/hsifla.F
+++ /dev/null
@@ -1,35 +0,0 @@
-*
-* $Id: hsifla.F,v 1.1.1.1 1996/01/16 17:07:48 mclareni Exp $
-*
-* $Log: hsifla.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:48 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.10/05 31/08/89 17.46.57 by Rene Brun
-*-- Author :
- SUBROUTINE HSIFLA(KFLA,I)
-*.==========>
-*. SETS BIT NO KFLA TO I
-*..=========> ( R.Brun )
-#include "hbook/hcbits.inc"
-#include "hbook/hcbook.inc"
- DIMENSION IFLAG(32)
- EQUIVALENCE (IFLAG(1),I1)
-*.___________________________________________
- IF(I.NE.0)THEN
- CALL SBIT1(IQ(LCID+KBITS),KFLA)
- ELSE
- CALL SBIT0(IQ(LCID+KBITS),KFLA)
- ENDIF
-*
-* Status word bit 5 means that histogram
-* in memory has been modified (for PAW use only)
-*
- CALL SBIT0(IQ(LCID),5)
-*
- IFLAG(KFLA)=I
- I230=I2+I3
- I123=I1+I230
- END
diff --git a/src/packlib/hbook/code/hsmoof.F b/src/packlib/hbook/code/hsmoof.F
deleted file mode 100644
index 4e8d85b..0000000
--- a/src/packlib/hbook/code/hsmoof.F
+++ /dev/null
@@ -1,143 +0,0 @@
-*
-* $Id: hsmoof.F,v 1.1.1.1 1996/01/16 17:07:48 mclareni Exp $
-*
-* $Log: hsmoof.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:48 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.22/11 23/08/94 14.17.45 by Rene Brun
-*-- Author :
- SUBROUTINE HSMOOF(IDD,ICASS,SUMQR)
-*.==========>
-*. THIS ROUTINE SMOOTHS AN HISTOGRAM IDD FOLLOWING
-*. THE METHOD DESCRIBED BY J.FRIEDMAN IN THE PROCEEDINGS
-*. OF THE C.E.R.N SCHOOL OF COMPUTING AT BERGEN
-*. IN AUGUST 1974.THE ALGORITHM USED IS THE 353QH,TWICE
-*.
-*. ICASE=1 THE CONTENTS OF IDD ARE REPLACED BY THE
-*. SMOOTHED VALUES
-*. ICASE=2 THE SMOOTHED VALUES ARE SUPERIMPOSED TO IDD
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
-#include "hbook/hcflag.inc"
-#include "hbook/hcbits.inc"
-#include "hbook/hcprin.inc"
- DIMENSION X(6)
-*.___________________________________________
- ICASE=1
- NARG=3
- CALL NOARG(NARG)
- IF(NARG.NE.1)ICASE=ICASS
- NOENT=1
- CALL HFIND(IDD,'HSMOOF')
- IF(LCID.EQ.0)GO TO 99
- CALL SBIT0(IQ(LCID),5)
- CALL HDCOFL
- IF(I1.EQ.0.AND.LFIX.EQ.0)THEN
- CALL HBUG('Not a 1-DIM histogram','HSMOOF',IDD)
- GO TO 99
- ENDIF
-*
- NCHAN=IQ(LPRX)
- NV=1
- IF(ICASE.EQ.2)CALL HFUNC(IDD,SQRT)
- NV=2
-*
- CALL HWORK(3*NCHAN,NOLD,'HSMOOF')
-*
- IF(NOLD.EQ.0)GO TO 99
- CALL HUNPAK(ID,Q(NOLD),'HIST',1)
-*
- 5 CONTINUE
-*
- DO 30 K=1,3
- CALL UCOPY2(Q(NOLD),Q(NOLD+NCHAN),NCHAN)
- IK=0
- IF(K.EQ.2)IK=1
- N1=IK+2
- N2=NCHAN-IK-1
-*
- DO 10 I=N1,N2
- CALL UCOPY2(Q(NOLD+NCHAN+I-IK-2),X,3+2*IK)
- Q(NOLD+I-1)=HMEDIA(X,3+2*IK)
- 10 CONTINUE
- GO TO (15,20,30),K
-*
- 15 X(3)=Q(NOLD+1)
- X(2)=Q(NOLD)
- X(1)=3.*X(3)-2.*Q(NOLD+2)
- Q(NOLD)=HMEDIA(X,3)
-*
- X(1)=Q(NOLD+NCHAN-2)
- X(2)=Q(NOLD+NCHAN-1)
- X(3)=3.*X(1)-2.*Q(NOLD+NCHAN-3)
- Q(NOLD+N2)=HMEDIA(X,3)
- GO TO 30
-*
- 20 CONTINUE
-*
- CALL UCOPY2(Q(NOLD+NCHAN),X,3)
- Q(NOLD+1)=HMEDIA(X,3)
- CALL UCOPY2(Q(NOLD+NCHAN+N2-1),X,3)
- Q(NOLD+N2)=HMEDIA(X,3)
- 30 CONTINUE
-*
-* QUADRATIC INTERPOLATION IF NECESSARY
-*
-* 1, SEARCH FOR A FLAT
-*
- N2=N2-2
- DO 40 I=N1,N2
- IF(Q(NOLD+I-1).NE.Q(NOLD+I))GO TO 40
- IF(Q(NOLD+I).NE.Q(NOLD+I+1))GO TO 40
- X(1)=Q(NOLD+I-2)-Q(NOLD+I)
- X(2)=Q(NOLD+I+2)-Q(NOLD+I)
- IF(X(1)*X(2).LE.0.)GO TO 40
- J1=1
- IF(ABS(X(2)).GT.ABS(X(1))) J1=-1
- Q(NOLD+I)=-.5*Q(NOLD+I-2*J1)+Q(NOLD+I-J1)/.75+Q(NOLD+I+2*J1)/6.
- Q(NOLD+I+J1)=.5*(Q(NOLD+I+2*J1)-Q(NOLD+I-2*J1))+Q(NOLD+I-J1)
- 40 CONTINUE
-*
-* 2 , RUNNING MEANS
-*
- N1=2
- N2=NCHAN-1
- CALL UCOPY2(Q(NOLD),Q(NOLD+NCHAN),NCHAN)
- DO 50 I=N1,N2
- J=NOLD+NCHAN+I
- 50 Q(NOLD+I-1)=.25*Q(J-2)+.5*Q(J-1)+.25*Q(J)
-*
- IF(NOENT.EQ.2)GO TO 70
- NOENT=2
- CALL UCOPY2(Q(NOLD),Q(NOLD+2*NCHAN),NCHAN)
-*
- DO 60 I=1,NCHAN
- 60 Q(NOLD+I-1)=HCX(I,1)-Q(NOLD+I-1)
- GO TO 5
- 70 CONTINUE
-*
- SUMSQR=0.
- DO 80 I=1,NCHAN
- Q(NOLD+I-1)=Q(NOLD+2*NCHAN+I-1)+Q(NOLD+I-1)
- ER=HCX(I,1+I9)
- IF(I9.NE.0)ER=ER*ER
- IF(ER.EQ.0.)ER=Q(NOLD+I-1)
- IF(ER.EQ.0.)GO TO 80
- SUMSQR=SUMSQR+((Q(NOLD+I-1)-HCX(I,1))**2)/ER
- 80 CONTINUE
-*
- IF(NARG.EQ.3)SUMQR=SUMSQR
- IF(ICASE.EQ.2)GO TO 90
- NOENT=IQ(LCONT+KNOENT)
- CALL HPAK(ID,Q(NOLD))
- IQ(LCONT+KNOENT)=NOENT
- GO TO 99
-*
- 90 LFUNC=LQ(LCONT-1)
- CALL UCOPY2(Q(NOLD),Q(LFUNC+3),IQ(LFUNC-1)-2)
-*
- 99 RETURN
- END
diff --git a/src/packlib/hbook/code/hspace.F b/src/packlib/hbook/code/hspace.F
deleted file mode 100644
index 08fc6c4..0000000
--- a/src/packlib/hbook/code/hspace.F
+++ /dev/null
@@ -1,35 +0,0 @@
-*
-* $Id: hspace.F,v 1.1.1.1 1996/01/16 17:07:48 mclareni Exp $
-*
-* $Log: hspace.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:48 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.10/05 06/09/89 08.13.14 by Rene Brun
-*-- Author :
- SUBROUTINE HSPACE (N,CHROUT,IDD)
-*.==========>
-*. ROUTINE CALLED BY SUBROUTINE CHROUT
-*. IERR=0 N WORDS CAN BE USED FOR STORAGE STARTING
-*. AT ADRESS NEWHIS
-*. =1 NOT ENOUGH SPACE
-*..=========> ( R.Brun )
-#include "hbook/hcflag.inc"
-#include "hbook/hcbook.inc"
- COMMON/QUEST/IQUEST(100)
- CHARACTER*(*) CHROUT
-*.___________________________________________
- IDLAST=0
- IERR=0
- CALL MZNEED(IHDIV,N,' ')
- IF(IQUEST(11).LT.0)THEN
- CALL MZNEED(IHDIV,N,'G')
- ENDIF
- IQUEST(1)=0
- IF(IQUEST(11).LT.0)THEN
- CALL HBUG('Not enough space in memory',CHROUT,IDD)
- IERR =1
- ENDIF
- END
diff --git a/src/packlib/hbook/code/hspfun.F b/src/packlib/hbook/code/hspfun.F
deleted file mode 100644
index 1a86bd2..0000000
--- a/src/packlib/hbook/code/hspfun.F
+++ /dev/null
@@ -1,214 +0,0 @@
-*
-* $Id: hspfun.F,v 1.1.1.1 1996/01/16 17:07:48 mclareni Exp $
-*
-* $Log: hspfun.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:48 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.22/11 23/08/94 14.17.45 by Rene Brun
-*-- Author :
- FUNCTION HSPFUN(IDD,X,IN,IK)
-*.==========>
-*. RETURN THE INTERPOLATED VALUE AT ABSCISSA X OBTAINED
-*. WITH SPLINES
-*..=========> ( D.Leborgne )
-#include "hbook/hcbook.inc"
-#include "hbook/hcbits.inc"
- COMMON/HCGARB /IDIMEN,IKNOTS,ICOEIN,ISPLIN,ISPLI1,ISPLI2,ICALCU,
- + ICOMPT,NCHAN ,BWID ,XMIN ,XMAX ,XMIN1 ,XMAX1 ,NARG ,
- + DIST ,SPLINE
-*.___________________________________________
- HSPFUN=0.
-*
- NARG=4
- CALL NOARG(NARG)
- IF(NARG.LT.4)THEN
- CALL HBUG('Wrong number of parameters','HSPFUN',IDD)
- GO TO 999
- ENDIF
-*
- K=IK
- IF(K.LE.1)K=3
- N=IN
- IF(N.LE.0)N=13
-*
- CALL HFIND(IDD,'HSPFUN')
- IF(LCID.EQ.0)GO TO 999
- CALL HDCOFL
- IF(I1.EQ.0.AND.LFIX.EQ.0)THEN
- CALL HBUG('Not a 1-DIM histogram','HSPFUN',IDD)
- GO TO 999
- ENDIF
-*
- NCHAN=IQ(LCID+KNCX)
- IDIMEN=NCHAN+2*N+4*K+3
- CALL HWORK(IDIMEN,IKNOTS,'HSPFUN')
- IF(IKNOTS.EQ.0)GO TO 999
-*
- ICOEIN=IKNOTS+N+2*K+1
- ISPLIN=ICOEIN+N+K
- ISPLI1=ISPLIN+NCHAN
- ISPLI2=ISPLI1+1
- ICALCU=ISPLI2+1
-*
- BWID=(Q(LCID+KXMAX)-Q(LCID+KXMIN))/FLOAT(IQ(LCID+KNCX))
- XMIN=Q(LCID+KXMIN)+0.5*BWID
- XMAX=Q(LCID+KXMAX)-0.5*BWID
-*
-* CALCULATION OF THE POINTS XMIN1 AND XMAX1 .
-* WE HAVE THE FUNCTION , WHICH REPRESENTS THE ORIGINAL
-* HISTOGRAM IDD , EQUALS ZERO WHEN X.LT.XMIN1.OR.X.GT.XMAX1
-*
- DO 40 I=1,NCHAN
- IF(HCX(I,1).EQ.0.)GO TO 40
- XMIN1=XMIN+BWID*FLOAT(I-1)
- GO TO 50
- 40 CONTINUE
-*
- 50 CONTINUE
-*
- DO 60 I=1,NCHAN
- J=NCHAN-I+1
- IF(HCX(J,1).EQ.0.)GO TO 60
- XMAX1=XMAX-BWID*FLOAT(I-1)
- GO TO 70
- 60 CONTINUE
-*
- 70 M=N+2*K+1
- NPK=N+K
- KP1=K+1
- KP2=K+2
- KM1=K-1
- MMKP1=M-KP1
- MMKP2=M-KP2
- ICOMPT=0
-*
- DIST=(XMAX1-XMIN1)/FLOAT(M-2*K-1)
-*
-* WE CALCULATE NOW THE POSITIONS OF THE KNOTS .
-*
- CALL VFILL(Q(IKNOTS),KP1,XMIN1)
- CALL VFILL(Q(ICOEIN-KP1),KP1,XMAX1)
-*
- DO 90 I=KP2,MMKP1
- 90 Q(IKNOTS+I-1)=XMIN1+DIST*FLOAT(I-KP1)
-*
-* LET'S CALCULATE NOW THE COEFFICIENTS OF THE INTEGRAL
-* OF THE SPLINE FUNCTION S(X) .
-*
-* WE USE ICOMPT TO DIFFERENCIATE THE CALCULATION OF THE
-* FIRST SPLINE (WE NEED THE VALUES OF THIS AT THE POINTS
-* SITUATED AT THE CENTRES OF THE CHANNELS OF IDD , TO
-* HAVE THE COEFFICIENTS OF THE FIRST DERIVATIVE OF S(X)
-* AND TO CALCULATE THE VALUE OF THE SECOND SPLINE IN X) ,
-* AND THE CALCULATION OF THE SPLINE ON THE DIFFERENCE
-* BETWEEN IDD AND THE FIRST SPLINE .
-*
- 80 ICOMPT=ICOMPT+1
-*
- DO 110 I=1,NPK
- XI=VSUM(Q(IKNOTS+I),K)/FLOAT(K)
- E1=0.
- DO 100 L=1,NCHAN
- XL=XMIN+BWID*FLOAT(L-1)
- IF(XI.LE.XL)GO TO 105
- Z=HCX(L,1)
- IF(ICOMPT.NE.1)THEN
- Z=Z-Q(ISPLIN+L-1)
- ENDIF
- E1=E1+Z*BWID
- 100 CONTINUE
-*
- 105 Q(ICOEIN+I-1)=E1
- 110 CONTINUE
-*
-* WE CALCULATE NOW THE COEFFICIENTS OF S(X) .
-*
- DO 120 I=1,MMKP2
- Q(ICOEIN+I-1)=FLOAT(K)*(Q(ICOEIN+I)-Q(ICOEIN+I-1))
- Q(ICOEIN+I-1)=Q(ICOEIN+I-1)/(Q(IKNOTS+I+K)-Q(IKNOTS+I))
- 120 CONTINUE
-*
-* LET'S CALCULATE THE VALUES OF THE FIRST SPLINE AT X AND
-* AT ALL THE ABSCISAS WHICH ARE AT THE CENTERS OF THE
-* CHANNELS OF IDD , AND THE VALUE OF THE SECOND SPLINE IN X.
-*
- NCHAP1=NCHAN+1
-*
- DO 250 I=1,NCHAP1
- SPLINE=0.
- IF(ICOMPT.EQ.2.AND.I.NE.NCHAP1)GO TO 250
- IF(I.NE.NCHAP1)THEN
- XI=XMIN+BWID*FLOAT(I-1)
- ELSE
- XI=X
- ENDIF
-*
-* FIND INTERVAL WHERE , XN(KK-1).LE.XI.AND.XI.LT.XN(KK)
-*
- IF(XI.LT.Q(IKNOTS+K))GO TO 220
- IF(XI.GT.Q(ICOEIN-1))GO TO 220
-*
- DO 160 L=KP1,MMKP1
- KK=L+1
- IF(Q(IKNOTS+L-1).LE.XI.AND.XI.LT.Q(IKNOTS+L))GO TO 170
- 160 CONTINUE
-*
- 170 KKM1=KK-1
- KKM2=KK-2
- E1=XI-Q(IKNOTS+KKM2)
- E2=Q(IKNOTS+KKM1)-XI
- Q(ICALCU)=1./(Q(IKNOTS+KKM1)-Q(IKNOTS+KKM2))
-*
- DO 180 J=2,K
- Q(ICALCU+J-1)=E1*Q(ICALCU+J-2)
- Q(ICALCU+J-1)=Q(ICALCU+J-1)/(Q(IKNOTS+KKM2+J)-Q(IKNOTS+
- + KKM2))
- 180 CONTINUE
-*
- DO 200 J=1,KM1
- E3=XI-Q(IKNOTS+KKM2-J)
- Q(ICALCU)=E2*Q(ICALCU)/(Q(IKNOTS+KKM1)-Q(IKNOTS+KKM2-J))
- KMJ=K-J
- IF(KMJ.LT.2)GO TO 200
- DO 190 L=2,KMJ
- A1=E3*Q(ICALCU+L-2)
- A2=(Q(IKNOTS+KKM2+L)-XI)*Q(ICALCU+L-1)
- Q(ICALCU+L-1)=(A1+A2)/(Q(IKNOTS+KKM2+L)-Q(IKNOTS+KKM2-J)
- + )
- 190 CONTINUE
- 200 CONTINUE
-*
- KKMKM2=KK-K-2
-*
- DO 210 J=1,K
- II=KKM1+J
- L=KKMKM2+J
- E1=(Q(IKNOTS+II-1)-Q(IKNOTS+II-KP1))*Q(ICALCU+J-1)*
- + Q(ICOEIN+L-1)
- SPLINE=SPLINE+E1
- 210 CONTINUE
-*
- 220 IF(ICOMPT.EQ.2)GO TO 240
- IF(I.EQ.NCHAP1)GO TO 230
- Q(ISPLIN+I-1)=SPLINE
- GO TO 250
-*
- 230 Q(ISPLI1)=SPLINE
- GO TO 250
-*
- 240 Q(ISPLI2)=SPLINE
-*
- 250 CONTINUE
-*
-* WE HAVE FINISHED , LET'S GIVE NOW THE RESULT .
-*
- IF(ICOMPT.EQ.2)GO TO 260
- GO TO 80
-*
- 260 HSPFUN=Q(ISPLI1)+Q(ISPLI2)
-*
- 999 RETURN
- END
diff --git a/src/packlib/hbook/code/hspli1.F b/src/packlib/hbook/code/hspli1.F
deleted file mode 100644
index beca793..0000000
--- a/src/packlib/hbook/code/hspli1.F
+++ /dev/null
@@ -1,227 +0,0 @@
-*
-* $Id: hspli1.F,v 1.1.1.1 1996/01/16 17:07:48 mclareni Exp $
-*
-* $Log: hspli1.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:48 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.22/11 23/08/94 14.17.45 by Rene Brun
-*-- Author :
- SUBROUTINE HSPLI1(IDD,ISUPIM,IN,IK,CHISQ)
-*.==========>
-*. THIS ROUTINE SMOOTHS THE 1-DIM HISTOGRAM IDD BY THE
-*. METHOD OF NORMALIZED B-SPLINES .
-*..=========> ( R.Brun ,D.Leborgne)
-#include "hbook/hcbook.inc"
-#include "hbook/hcflag.inc"
-#include "hbook/hcbits.inc"
-#include "hbook/hcprin.inc"
- COMMON/HCGARB /IDIMEN,IKNOTS,ICOEIN,ISPLI1,ICALCU,ICOMPT,NCHAN ,
- + BWID ,XMIN ,XMAX ,XMIN1 ,XMAX1 ,IFUNC ,NARG ,SPLINE,
- + ICASE ,DIST
-*.___________________________________________
- NARG=5
- CALL NOARG(NARG)
-*
- CALL HFIND(IDD,'HSPLI1')
- IF(LCID.EQ.0)GO TO 999
- CALL HDCOFL
- IF(I1.EQ.0)THEN
- CALL HBUG('Not a 1-DIM histogram','HSPLI1',IDD)
- GO TO 999
- ENDIF
-*
- ICASE=1
- IF(NARG.NE.1)ICASE=ISUPIM
- IF(ICASE.LE.0)ICASE=2
- NV=1
- IF(ICASE.EQ.2)CALL HFUNC(IDD,SQRT)
- NV=2
-*
- K=3
- IF(NARG.GE.4)K=IK
- IF(K.LE.1)K=3
-*
- N=13
- IF(NARG.GE.3)N=IN
- IF(N.LE.0)N=13
-*
- NCHAN=IQ(LCID+KNCX)
- IDIMEN=NCHAN+2*N+4*K
- CALL HWORK(IDIMEN,IKNOTS,'HSPLI1')
- IF(IKNOTS.EQ.0)GO TO 999
-*
- ICOEIN=IKNOTS+N+2*K+1
- ISPLI1=ICOEIN+N+K
- ICALCU=ISPLI1+NCHAN
-*
- BWID=(Q(LCID+KXMAX)-Q(LCID+KXMIN))/FLOAT(IQ(LCID+KNCX))
- XMIN=Q(LCID+KXMIN)+0.5*BWID
- XMAX=Q(LCID+KXMAX)-0.5*BWID
-*
-* CALCULATION OF THE POINTS XMIN1 AND XMAX1 .
-* WE HAVE THE FUNCTION , WHICH REPRESENTS THE ORIGINAL
-* HISTOGRAM IDD , ZERO WHEN X.LT.XMIN1 OR X.GT.XMAX1 .
-*
- DO 20 I=1,NCHAN
- IF(HCX(I,1).EQ.0.)GO TO 20
- XMIN1=XMIN+FLOAT(I-1)*BWID
- GO TO 30
- 20 CONTINUE
-*
- 30 CONTINUE
-*
- DO 40 I=1,NCHAN
- J=NCHAN-I+1
- IF(HCX(J,1).EQ.0.)GO TO 40
- XMAX1=XMAX-FLOAT(I-1)*BWID
- GO TO 50
- 40 CONTINUE
-*
- 50 M=N+2*K+1
- NPK=N+K
- KP1=K+1
- KP2=K+2
- KM1=K-1
- MMKP1=M-KP1
- MMKP2=M-KP2
- ICOMPT=0
-*
- DIST=(XMAX1-XMIN1)/FLOAT(M-2*K-1)
-*
-* WE CALCULATE THE POSITIONS OF THE KNOTS .
-*
- CALL VFILL(Q(IKNOTS),KP1,XMIN1)
- CALL VFILL(Q(ICOEIN-KP1),KP1,XMAX1)
-*
- DO 70 I=KP2,MMKP1
- 70 Q(IKNOTS+I-1)=XMIN1+DIST*FLOAT(I-KP1)
-*
-* LET US CALCULATE NOW THE COEFFICIENTS OF THE INTEGRAL
-* OF THE SPLINE FUNCTION S(X) .
-*
-* WE HAVE ICOMPT TO DIFFERENCIATE THE CALCULATION OF THE
-* FIRST SPLINE AND THE SPLINE ON THE DIFFERENCE BETWEEN
-* THE ORIGINAL HISTOGRAM IDD AND THE FIRST SPLINE .
-*
- 60 ICOMPT=ICOMPT+1
-*
- DO 90 I=1,NPK
- XI=VSUM(Q(IKNOTS+I),K)/FLOAT(K)
- E1=0.
- DO 80 L=1,NCHAN
- X=XMIN+BWID*FLOAT(L-1)
- IF(XI.LE.X)GO TO 85
- Z=HCX(L,1)
- IF(ICOMPT.NE.1)THEN
- Z=Z-Q(ISPLI1+L-1)
- ENDIF
- E1=E1+Z*BWID
- 80 CONTINUE
- 85 Q(ICOEIN+I-1)=E1
- 90 CONTINUE
-*
-* WE CALCULATE NOW THE COEFFICIENTS OF THE SPLINE S(X) .
-*
- DO 100 I=1,MMKP2
- Q(ICOEIN+I-1)=FLOAT(K)*(Q(ICOEIN+I)-Q(ICOEIN+I-1))
- Q(ICOEIN+I-1)=Q(ICOEIN+I-1)/(Q(IKNOTS+I+K)-Q(IKNOTS+I))
- 100 CONTINUE
-*
-* WE CALCULATE NOW THE VALUES OF THE SPLINE FUNCTION AT
-* THE POINTS SITUATED AT THE CENTRE OF THE CHANNELS OF IDD .
-*
- DO 190 I=1,NCHAN
- SPLINE=0.
- X=XMIN+BWID*FLOAT(I-1)
-*
-* FIND INTERVAL WHERE , XN(KK-1).LE.X.AND.X.LT.XN(KK)
-*
- IF(X.LT.Q(IKNOTS+K))GO TO 170
- IF(X.GT.Q(ICOEIN-1))GO TO 170
-*
- DO 110 L=KP1,MMKP1
- KK=L+1
- IF(Q(IKNOTS+L-1).LE.X.AND.X.LT.Q(IKNOTS+L))GO TO 120
- 110 CONTINUE
-*
- 120 KKM1=KK-1
- KKM2=KK-2
- E1=X-Q(IKNOTS+KKM2)
- E2=Q(IKNOTS+KKM1)-X
- Q(ICALCU)=1./(Q(IKNOTS+KKM1)-Q(IKNOTS+KKM2))
-*
- DO 130 J=2,K
- Q(ICALCU+J-1)=E1*Q(ICALCU+J-2)
- Q(ICALCU+J-1)=Q(ICALCU+J-1)/(Q(IKNOTS+KKM2+J)-Q(IKNOTS+
- + KKM2))
- 130 CONTINUE
-*
- DO 150 J=1,KM1
- E3=X-Q(IKNOTS+KKM2-J)
- Q(ICALCU)=E2*(Q(ICALCU))/(Q(IKNOTS+KKM1)-Q(IKNOTS+KKM2-J))
- KMJ=K-J
- IF(KMJ.LT.2)GO TO 150
-*
- DO 140 L=2,KMJ
- A1=E3*Q(ICALCU+L-2)
- A2=(Q(IKNOTS+KKM2+L)-X)*Q(ICALCU+L-1)
- Q(ICALCU+L-1)=(A1+A2)/(Q(IKNOTS+KKM2+L)-Q(IKNOTS+KKM2-J))
- 140 CONTINUE
- 150 CONTINUE
-*
- KKMKM2=KK-K-2
-*
- DO 160 J=1,K
- II=KKM1+J
- L=KKMKM2+J
- E1=(Q(IKNOTS+II-1)-Q(IKNOTS+II-KP1))*Q(ICALCU+J-1)
- + *Q(ICOEIN+L-1)
- SPLINE=SPLINE+E1
- 160 CONTINUE
-*
- 170 IF(ICOMPT.EQ.2)GO TO 180
- Q(ISPLI1+I-1)=SPLINE
- GO TO 190
- 180 Q(ISPLI1+I-1)=SPLINE+Q(ISPLI1+I-1)
-*
- 190 CONTINUE
-*
- IF(ICOMPT.NE.2)GO TO 60
-*
-* WE HAVE FINISHED THE CALCULATION OF THE TWO SPLINES ,
-* AND WE HAVE MADE THE SUM OF THESE . THIS SUM IS THE
-* FINAL RESULT .
-*
-* WE HAVE TO PRINT NOW THE RESULT ACCORDING TO THE VALUE
-* OF ISUPIM AND TO LOOK IF WE MUST CALCULATE THE CHISQUARE .
-*
- 200 CONTINUE
-*
- IF(NARG.LT.5)GO TO 230
-*
- CHISQ=0.
- DO 220 I=1,NCHAN
- Z=HCX(I,1)
- IF(Z.EQ.0.)GO TO 220
- E1=Z-Q(ISPLI1+I-1)
- CHISQ=CHISQ+(E1*E1)/ABS(Z)
- 220 CONTINUE
-*
-* LET'S SEE NOW IF WE MUST OR NO SUPERIMPOSE
-* THE SPLINE FUNCTION .
-*
- 230 IF(ICASE.NE.2)GO TO 240
- LFUNC=LQ(LCONT-1)
- IF(LFUNC.NE.0)CALL UCOPY(Q(ISPLI1),Q(LFUNC+3),IQ(LFUNC-1)-2)
- CALL SBIT0(IQ(LCID),5)
- GO TO 999
-*
- 240 NOENT=IQ(LCONT+KNOENT)
- CALL HPAK(IDD,Q(ISPLI1))
- IQ(LCONT+KNOENT)=NOENT
-*
- 999 RETURN
- END
diff --git a/src/packlib/hbook/code/hspli2.F b/src/packlib/hbook/code/hspli2.F
deleted file mode 100644
index e4a788d..0000000
--- a/src/packlib/hbook/code/hspli2.F
+++ /dev/null
@@ -1,353 +0,0 @@
-*
-* $Id: hspli2.F,v 1.1.1.1 1996/01/16 17:07:48 mclareni Exp $
-*
-* $Log: hspli2.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:48 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.23/01 20/02/95 09.52.17 by Julian Bunn
-*-- Author :
- SUBROUTINE HSPLI2(IDD,INX,INY,IKX,IKY)
-*.==========>
-*. THIS ROUTINE GIVES THE RESULT OF THE INTERPOLATION
-*. MADE ON THE 2-DIM HISTOGRAM IDD . WE USE FOR THIS
-*. INTERPOLATION THE ALGORITHM OF B-SPLINES .
-*.
-*. PARAMETERS :
-*. - INX AND INY ARE CONNECTED RESPECTIVELY AT THE
-*. NUMBER OF KNOTS WE PLACE ON THE AXIS X AND Y .
-*. - IKX AND IKY ARE RESPECTIVELY THE DEGREES OF THE
-*. SPLINE FUNCTION IN X AND Y .
-*.
-*. REMARKS :
-*. - WHEN INX.LE.0 , WE TAKE INX=13 .
-*. - WHEN INY.LE.0 , WE PUT INY AT 13 .
-*. - WHEN IKX.LE.0 , WE TAKE IKX=3 .
-*. - WHEN IKY.LE.0 , WE PUT IKY AT 3 .
-*. - AN ERROR MESSAGE IS GIVEN IF IKX OR IKY ARE PUT
-*. AT 1 BY THE USER .
-*..=========> ( R.Brun ,D.Leborgne)
-#include "hbook/hcbook.inc"
-#include "hbook/hcbits.inc"
-#include "hbook/hcprin.inc"
- COMMON/HCGARB /ISPACE,IKNOTX,IKNOTY,ICOEFF,ICALCX,ICALCY,ICOMPT,
- + NCX ,NCY ,BWIDX ,BWIDY ,XMIN ,XMAX ,YMIN ,YMAX ,
- + NARG ,SPLINE
-*.___________________________________________
- NARG=5
- CALL NOARG(NARG)
-*
- CALL HFIND(IDD,'HSPLI2')
- IF(LCID.EQ.0)GO TO 999
- CALL HDCOFL
- IF(I230.EQ.0)THEN
- CALL HBUG('Not a 2-DIM histogram','HSPLI2',IDD)
- GO TO 999
- ENDIF
-*
- KX=3
- KY=3
- NX=13
- NY=13
-*
- IF(NARG.LT.5)GO TO 20
- KY=IKY
- IF(KY.LE.1)KY=3
-*
- 20 IF(NARG.LT.4)GO TO 30
- KX=IKX
- IF(KX.LE.1)KX=3
-*
- 30 IF(NARG.LT.3)GO TO 40
- NY=INY
- IF(NY.LE.0)NY=13
-*
- 40 IF(NARG.LT.2)GO TO 50
- NX=INX
- IF(NX.LE.0)NX=13
-*
- 50 NCX=IQ(LCID+KNCX)
- NCY=IQ(LCID+KNCY)
- BWIDX=(Q(LCID+KXMAX)-Q(LCID+KXMIN))/FLOAT(IQ(LCID+KNCX))
- BWIDY=(Q(LCID+KYMAX)-Q(LCID+KYMIN))/FLOAT(IQ(LCID+KNCY))
- XMIN=Q(LCID+KXMIN)+0.5*BWIDX
- XMAX=Q(LCID+KXMAX)-0.5*BWIDX
- YMIN=Q(LCID+KYMIN)+0.5*BWIDY
- YMAX=Q(LCID+KYMAX)-0.5*BWIDY
-*
- ISPACE=NX+NY+3*KX+3*KY+2+(NX+KX)*(NY+KY)
-*
- CALL HWORK(ISPACE,IKNOTX,'HSPLI2')
- IF(IKNOTX.EQ.0)GO TO 999
-*
- CALL SBIT0(IQ(LCID),5)
- IKNOTY=IKNOTX+NX+2*KX+1
- ICOEFF=IKNOTY+NY+2*KY+1
- ICALCX=ICOEFF+(NX+KX)*(NY+KY)
- ICALCY=ICALCX+KX
-*
-* LET US CALCULATE THE POINTS XMIN1,XMAX1,YMIN1,YMAX1 .
-* FROM THESE ABSCISSES , THE VALUES OF THE HISTOGRAM IDD
-* BECOME DIFFERENT OF ZERO .
-*
- DO 70 I=1,NCX
- DO 60 J=1,NCY
- IF(HCXY(I,J,1).EQ.0.)GO TO 60
- XMIN1=XMIN+BWIDX*FLOAT(I-1)
- IF(I.EQ.1)XMIN1=XMIN
- GO TO 80
- 60 CONTINUE
- 70 CONTINUE
-*
- 80 CONTINUE
- DO 100 I=1,NCX
- II=NCX-I+1
- DO 90 J=1,NCY
- IF(HCXY(II,J,1).EQ.0.)GO TO 90
- XMAX1=XMAX-BWIDX*FLOAT(I-1)
- GO TO 110
- 90 CONTINUE
- 100 CONTINUE
-*
- 110 CONTINUE
-*
- DO 130 I=1,NCY
- DO 120 J=1,NCX
- IF(HCXY(J,I,1).EQ.0.)GO TO 120
- YMIN1=YMIN+BWIDY*FLOAT(I-1)
- IF(I.EQ.1)YMIN1=YMIN
- GO TO 140
- 120 CONTINUE
- 130 CONTINUE
-*
- 140 CONTINUE
-*
- DO 160 I=1,NCY
- II=NCY-I+1
- DO 150 J=1,NCX
- IF(HCXY(J,II,1).EQ.0.)GO TO 150
- YMAX1=YMAX-BWIDY*FLOAT(I-1)
- GO TO 170
- 150 CONTINUE
- 160 CONTINUE
-*
- 170 MX=NX+2*KX+1
- MY=NY+2*KY+1
- KXP1=KX+1
- KXP2=KX+2
- KXM1=KX-1
- MXMKP1=MX-KXP1
- MXMKP2=MX-KXP2
- NXPK=NX+KX
- KYP1=KY+1
- KYP2=KY+2
- KYM1=KY-1
- MYMKP1=MY-KYP1
- MYMKP2=MY-KYP2
- NYPK=NY+KY
-*
- DISTX=(XMAX1-XMIN1)/FLOAT(MX-2*KX-1)
- DISTY=(YMAX1-YMIN1)/FLOAT(MY-2*KY-1)
-*
-* LET'S CALCULATE NOW THE POSITIONS OF THE KNOTS ON THE
-* AXIS X AND Y .
-*
- CALL VFILL(Q(IKNOTX),KXP1,XMIN1)
- CALL VFILL(Q(IKNOTY-KXP1),KXP1,XMAX1)
- CALL VFILL(Q(IKNOTY),KYP1,YMIN1)
- CALL VFILL(Q(ICOEFF-KYP1),KYP1,YMAX1)
-*
- DO 180 I=KXP2,MXMKP1
- 180 Q(IKNOTX+I-1)=XMIN1+DISTX*FLOAT(I-KXP1)
-*
- DO 190 I=KYP2,MYMKP1
- 190 Q(IKNOTY+I-1)=YMIN1+DISTY*FLOAT(I-KYP1)
-*
-* LET US CALCULATE NOW THE COEFFICIENTS OF THE SPLINE
-* FUNCTION S(X) . THESE COEFFICIENTS ARE THE SAME THAN
-* THE COEFFICIENTS C(I) OF THE THEORY . BUT HERE WE ARE
-* IN DIMENSION 2 .
-*
- ICOMPT=0
-*
- DO 280 I=1,NXPK
- XI=VSUM(Q(IKNOTX+I),KX)/FLOAT(KX)
-*
- DO 200 JX=1,NCX
- XJ=XMIN+BWIDX*FLOAT(JX-1)
- IF(XI.GT.XJ)GO TO 200
- ILIMX=JX
- GO TO 210
- 200 CONTINUE
-*
- 210 CONTINUE
-*
- DO 270 J=1,NYPK
- ICOMPT=ICOMPT+1
- YI=VSUM(Q(IKNOTY+J),KY)/FLOAT(KY)
- IF(J.EQ.1)THEN
- YLIM=YMIN
- ILIM=1
- ENDIF
- DO 230 JY=ILIM,NCY
- YJ=YLIM+BWIDY*FLOAT(JY-ILIM)
- IF(YI.GT.YJ)GO TO 230
- ILIM2=JY
- YLIM=YJ
- GO TO 240
- 230 CONTINUE
- 240 SUM=0.
-*
- DO 250 IJ=1,ILIMX
- DO 250 JJ=ILIM,ILIM2
- 250 SUM=SUM+HCXY(IJ,JJ,1)*BWIDX*BWIDY
-*
- ILIM=ILIM2
- IF(J.EQ.1)THEN
- Q(ICOEFF+ICOMPT-1)=0.
- ELSE
- Q(ICOEFF+ICOMPT-1)=Q(ICOEFF+ICOMPT-2)+SUM
- ENDIF
- 270 CONTINUE
-*
- 280 CONTINUE
-*
-* LET US CALCULATE NOW THE COEFFICIENTS WHICH CORRESPOND
-* AT THE FIRST DERIVATIVE OF THE SPLINE FUNCTION S(X) .
-* AS BEFORE , WE HAVE TAKEN FOR THE CALCULATION OF THE
-* COEFFICIENTS ("C(I)") THE PRIMITIVE OF THE HISTOGRAM
-* IDD , THE COEFFICIENTS WE CALCULATE NOW CORRESPOND AT
-* THE VALUES OF THE SPLINE FUNCTION AT THE NODES . (SEE
-* THE EXPLANATION IN THE DOCUMENTATION) .
-*
- DO 290 J=1,NYPK
- DO 285 I=1,MXMKP2
- IJK=ICOEFF+(I-1)*NYPK+J-1
- A=FLOAT(KX)*(Q(IJK+NYPK)-Q(IJK))
- Q(IJK)=A/(Q(IKNOTX+I+KX)-Q(IKNOTX+I))
- 285 CONTINUE
- 290 CONTINUE
-*
- DO 300 I=1,NXPK
- DO 300 J=1,MYMKP2
- IJK=ICOEFF+(I-1)*NYPK+J-1
- A=FLOAT(KY)*(Q(IJK+1)-Q(IJK))
- Q(IJK)=A/(Q(IKNOTY+J+KY)-Q(IKNOTY+J))
- 300 CONTINUE
-*
-* WE HAVE TO CALCULATE NOW THE VALUES OF THE SPLINE FUNC-
-* TION AT ALL THE POINTS SITUATED AT THE CENTRE OF THE
-* CELLS (I,J) OF IDD . WE REPLACE THE VALUES OF THE ORI-
-* GINAL FUNCTION WHICH REPRESENTS IDD BY THE VALUES OF
-* THE SPLINE FUNCTION S(X) .
-*
- NEOLD=IQ(LCONT+KNOENT)
- CALL VZERO(IQ(LCONT+KNOENT),IQ(LCONT-1)-1)
- DO 440 IJK=1,NCX
- X=XMIN+BWIDX*FLOAT(IJK-1)
-*
- DO 430 JKL=1,NCY
- Y=YMIN+BWIDY*FLOAT(JKL-1)
-*
- SPLINE=0.
-*
- IF(X.LT.Q(IKNOTX+KX))GO TO 420
- IF(X.GT.Q(IKNOTY-1))GO TO 420
- IF(Y.LT.Q(IKNOTY+KY))GO TO 420
- IF(Y.GT.Q(ICOEFF-1))GO TO 420
-*
- DO 310 L=KXP1,MXMKP1
- KKX=L+1
- IF(Q(IKNOTX+L-1).LE.X.AND.X.LT.Q(IKNOTX+L))GO TO 320
- 310 CONTINUE
-*
- 320 CONTINUE
-*
- DO 330 L=KYP1,MYMKP1
- KKY=L+1
- IF(Q(IKNOTY+L-1).LE.Y.AND.Y.LT.Q(IKNOTY+L))GO TO 340
- 330 CONTINUE
-*
- 340 KKXM1=KKX-1
- KKXM2=KKX-2
- KKYM1=KKY-1
- KKYM2=KKY-2
- EX1=X-Q(IKNOTX+KKXM2)
- EY1=Y-Q(IKNOTY+KKYM2)
- EX2=Q(IKNOTX+KKXM1)-X
- EY2=Q(IKNOTY+KKYM1)-Y
-*
- Q(ICALCX)=1./(Q(IKNOTX+KKXM1)-Q(IKNOTX+KKXM2))
- Q(ICALCY)=1./(Q(IKNOTY+KKYM1)-Q(IKNOTY+KKYM2))
-*
- DO 350 J=2,KX
- A=EX1*Q(ICALCX+J-2)
- Q(ICALCX+J-1)=A/(Q(IKNOTX+KKXM2+J)-Q(IKNOTX+KKXM2))
- 350 CONTINUE
-*
- DO 360 J=2,KY
- A=EY1*Q(ICALCY+J-2)
- Q(ICALCY+J-1)=A/(Q(IKNOTY+KKYM2+J)-Q(IKNOTY+KKYM2))
- 360 CONTINUE
-*
- DO 380 J=1,KXM1
- EX3=X-Q(IKNOTX+KKXM2-J)
- A4=Q(IKNOTX+KKXM1)-Q(IKNOTX+KKXM2-J)
- Q(ICALCX)=EX2*Q(ICALCX)/A4
- KXMJ=KX-J
- IF(KXMJ.LT.2)GO TO 380
- DO 370 L=2,KXMJ
- A1=EX3*Q(ICALCX+L-2)
- A2=(Q(IKNOTX+KKXM2+L)-X)*Q(ICALCX+L-1)
- A3=Q(IKNOTX+KKXM2+L)-Q(IKNOTX+KKXM2-J)
- Q(ICALCX+L-1)=(A1+A2)/A3
- 370 CONTINUE
- 380 CONTINUE
-*
- DO 400 J=1,KYM1
- EY3=Y-Q(IKNOTY+KKYM2-J)
- A4=Q(IKNOTY+KKYM1)-Q(IKNOTY+KKYM2-J)
- Q(ICALCY)=EY2*Q(ICALCY)/A4
- KYMJ=KY-J
- IF(KYMJ.LT.2)GO TO 400
- DO 390 L=2,KYMJ
- A1=EY3*Q(ICALCY+L-2)
- A2=(Q(IKNOTY+KKYM2+L)-Y)*Q(ICALCY+L-1)
- A3=Q(IKNOTY+KKYM2+L)-Q(IKNOTY+KKYM2-J)
- Q(ICALCY+L-1)=(A1+A2)/A3
- 390 CONTINUE
- 400 CONTINUE
-*
- KKXMK2=KKX-KX-2
- KKYMK2=KKY-KY-2
-*
- DO 415 I=1,KX
- IX=KKXM1+I
- LX=KKXMK2+I
- DO 410 J=1,KY
- JY=KKYM1+J
- LY=KKYMK2+J
- A1=Q(IKNOTX+IX-1)-Q(IKNOTX+IX-KXP1)
- A2=Q(IKNOTY+JY-1)-Q(IKNOTY+JY-KYP1)
- A3=Q(ICALCX+I-1)*Q(ICALCY+J-1)
- A4=Q(ICOEFF+(LX-1)*NYPK+LY-1)
- SPLINE=SPLINE+A1*A2*A3*A4
- 410 CONTINUE
- 415 CONTINUE
-*
- IF(SPLINE.EQ.0.)GO TO 420
-*
- IF(SPLINE.LT.0..AND.NB.LT.32)SPLINE=0.
-*
- 420 CONTINUE
-*
- CALL HFCXY(IJK,JKL,SPLINE)
-*
- 430 CONTINUE
- 440 CONTINUE
- IQ(LCONT+KNOENT)=NEOLD
-*
- 999 RETURN
- END
diff --git a/src/packlib/hbook/code/hsquez.F b/src/packlib/hbook/code/hsquez.F
deleted file mode 100644
index ec30fee..0000000
--- a/src/packlib/hbook/code/hsquez.F
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: hsquez.F,v 1.1.1.1 1996/01/16 17:07:48 mclareni Exp $
-*
-* $Log: hsquez.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:48 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.13/00 01/05/91 17.37.01 by Rene Brun
-*-- Author :
- SUBROUTINE HSQUEZ(KORDRE)
-*.==========>
-*. SUPPRESS (RESTORE) PAGE EJECT AT PRINTING
-*..=========> ( R.Brun )
-#include "hbook/hcprin.inc"
- CHARACTER*(*) KORDRE
-*.___________________________________________
- KSQUEZ=0
- CALL UCTOH(KORDRE,IOP,4,4)
- IF(IOP.NE.INO)KSQUEZ=1
- END
diff --git a/src/packlib/hbook/code/hstaf.F b/src/packlib/hbook/code/hstaf.F
deleted file mode 100644
index 48800a5..0000000
--- a/src/packlib/hbook/code/hstaf.F
+++ /dev/null
@@ -1,30 +0,0 @@
-*
-* $Id: hstaf.F,v 1.1.1.1 1996/01/16 17:07:48 mclareni Exp $
-*
-* $Log: hstaf.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:48 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.21/05 29/11/93 14.18.24 by Fons Rademakers
-*-- Author : Rene Brun 27/11/93
- SUBROUTINE HSTAF(CHOPTT)
-*.==========>
-*. To set option for filling statistics
-*..=========> ( R.Brun )
-#include "hbook/hcopt.inc"
- CHARACTER*(*) CHOPTT
- CHARACTER*4 CHOPT
-*.___________________________________________
- CHOPT=CHOPTT
- CALL CLTOU(CHOPT)
- IF(INDEX(CHOPT,'YES').NE.0)THEN
- ISTAF=1
- ELSE
- ISTAF=0
- ENDIF
-#if defined(CERNLIB_CZ)
- CALL HOPTPF
-#endif
- END
diff --git a/src/packlib/hbook/code/hstar.F b/src/packlib/hbook/code/hstar.F
deleted file mode 100644
index c7fd2fa..0000000
--- a/src/packlib/hbook/code/hstar.F
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: hstar.F,v 1.1.1.1 1996/01/16 17:07:48 mclareni Exp $
-*
-* $Log: hstar.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:48 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.10/05 21/02/89 16.14.53 by Rene Brun
-*-- Author :
- SUBROUTINE HSTAR(ID1)
-*.==========>
-*. SELECT STAR OPTION AT PRINTING
-*..=========> ( R.Brun )
-*.___________________________________________
- CALL HIDOPT(ID1,'STAR')
- CALL HOBSOL('HSTAR ','STAR','CONT')
- END
diff --git a/src/packlib/hbook/code/hstati.F b/src/packlib/hbook/code/hstati.F
deleted file mode 100644
index 059d614..0000000
--- a/src/packlib/hbook/code/hstati.F
+++ /dev/null
@@ -1,109 +0,0 @@
-*
-* $Id: hstati.F,v 1.1.1.1 1996/01/16 17:07:48 mclareni Exp $
-*
-* $Log: hstati.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:48 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.19/00 26/04/93 18.56.16 by Rene Brun
-*-- Author :
- FUNCTION HSTATI(IDD,IS,KCASE,NUMM)
-*.==========>
-*. IS=1 MEAN IS RETURNED
-*. IS=2 R.M.S.
-*. IS>2 NUMBER OF EQUIVALENT EVENTS
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
-#include "hbook/hcprin.inc"
-#include "hbook/hcfitr.inc"
- DOUBLE PRECISION SWX(2),XVAL(2),VALMEA,RMS,X,W
- CHARACTER*(*) KCASE
-*.___________________________________________
- HSTATI=0.
- NARG=4
- CALL NOARG(NARG)
- ICAS=0
- NUM=0
- IF(NARG.EQ.4)NUM=NUMM
- IF(NARG.GT.2)THEN
- CALL UCTOH(KCASE,ICAS,4,4)
- ENDIF
-*
- IF(LFIX.EQ.0)THEN
- CALL HFINOP(IDD,'HSTATI',IFW,NB,IFX,IFY,ICAS,NUM)
- LCONT=IFW
- ELSE
- IFW=LCONT
- IFX=LPRX
- IFY=LPRY
- ENDIF
-*
- IF(IFW.EQ.0)GO TO 99
- IF(IFY.NE.0)GO TO 99
- NCX=IQ(IFX)
- BWID=(Q(IFX+2)-Q(IFX+1))/FLOAT(NCX)
- XVAL(1)=0.
- XVAL(2)=0.
- X=Q(IFX+1)-0.5*BWID
- IF(IFTRNG.NE.0)THEN
- I7=0
- IC1=IFXLOW
- IC2=IFXUP
- ELSE
- I7=JBIT(IQ(LCID+KBITS),7)
- IC1=1
- IC2=NCX
- ENDIF
- IF(I7.NE.0)THEN
- ALLCHA=Q(IFW+KSTAT1)
- ELSE
- ALLCHA=0.
- DO 10 I=1,NCX
- X=X+BWID
- IF(I.LT.IC1.OR.I.GT.IC2)GO TO 10
- W=ABS(HCX(I,1))
- ALLCHA=ALLCHA+W
- XVAL(1)=XVAL(1)+W*X
- XVAL(2)=XVAL(2)+W*X*X
- 10 CONTINUE
- ENDIF
-*
- IF(ALLCHA.EQ.0.)GO TO 99
- IF(IS.GE.3)THEN
- HSTATI=IQ(IFW+KNOENT)
- IF(I7.NE.0)THEN
- EQUIV=Q(IFW+KSTAT1+1)
- IF(EQUIV.NE.0.)HSTATI=ALLCHA*ALLCHA/EQUIV
- ENDIF
- GO TO 99
- ENDIF
-*
- IF(I7.NE.0)THEN
- CALL UCOPY(Q(IFW+KSTAT1+2),SWX,4)
- XVAL(1)=SWX(1)
- XVAL(2)=SWX(2)
- RMS=SQRT(ABS(SWX(2)/ALLCHA - (SWX(1)/ALLCHA)**2))
- ENDIF
-*
- VALMEA=XVAL(1)/ALLCHA
- IF(IS.EQ.1)THEN
- HSTATI=VALMEA
- GO TO 99
- ENDIF
-*
- IF(I7.EQ.0)THEN
- RMS=XVAL(2)/ALLCHA - VALMEA*VALMEA
- RMS=SQRT(ABS(RMS))
- ENDIF
- IF(RMS.EQ.0.)GO TO 99
- IF(IS.LE.2)THEN
- HSTATI=RMS
- GO TO 99
- ENDIF
-*
- HSTATI=0.
-*
- 99 CONTINUE
- END
diff --git a/src/packlib/hbook/code/hstelf.F b/src/packlib/hbook/code/hstelf.F
deleted file mode 100644
index 971c599..0000000
--- a/src/packlib/hbook/code/hstelf.F
+++ /dev/null
@@ -1,84 +0,0 @@
-*
-* $Id: hstelf.F,v 1.1.1.1 1996/01/16 17:07:48 mclareni Exp $
-*
-* $Log: hstelf.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:48 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.10/05 21/02/89 16.14.54 by Rene Brun
-*-- Author :
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION HSTELF (ITYP,IDEG,X)
-#endif
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION FUNCTION HSTELF (ITYP,IDEG,X)
-#endif
-*.==========>
-*. GIVES THE VALUE COMPUTED AT X OF A STANDARD
-*. ELEMENTARY FUNCTION (POLYNOMIAL) OF TYPE ITYP
-*. AND DEGREE IDEG
-*. ITYP = 0 MONOMIAL
-*. 1 TCHEBYSHEV POLYNOMIAL
-*. 2 LEGENDRE POLYNOMIAL
-*. 3 SHIFTED TCHEBYSHEV POLYNOMIAL
-*. 4 LAGUERRE POLYNOMIAL
-*. 5 HERMITE POLYNOMIAL
-*..=========> ( D.Lienart )
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION P0,P1,P2
-#endif
-*.___________________________________________
- P0=1
- I1=ITYP+1
- GOTO (10,20,30,40,50,60),I1
-*
- 10 P1=X
- DO 15 I=2,IDEG
- P2=P1*X
- P1=P2
- 15 CONTINUE
- GOTO 70
-*
- 20 P1=X
- DO 25 I=2,IDEG
- P2=2.*X*P1-P0
- P0=P1
- P1=P2
- 25 CONTINUE
- GOTO 70
-*
- 30 P1=X
- DO 35 I=2,IDEG
- P2=(2.*I-1.)/I*X*P1-(I-1.)/I*P0
- P0=P1
- P1=P2
- 35 CONTINUE
- GOTO 70
-*
- 40 P1=2.*X-1.
- DO 45 I=2,IDEG
- P2=2.*(2.*X-1.)*P1-P0
- P0=P1
- P1=P2
- 45 CONTINUE
- GOTO 70
-*
- 50 P1=1.-X
- DO 55 I=2,IDEG
- P2=(2.*I-1.-X)*P1-(I-1.)**2*P0
- P0=P1
- P1=P2
- 55 CONTINUE
- GOTO 70
-*
- 60 P1=2.*X
- DO 65 I=2,IDEG
- P2=2.*X*P1-2.*(I-1.)*P0
- P0=P1
- P1=P2
- 65 CONTINUE
-*
- 70 HSTELF=P1
- END
diff --git a/src/packlib/hbook/code/hsum.F b/src/packlib/hbook/code/hsum.F
deleted file mode 100644
index 5f725bd..0000000
--- a/src/packlib/hbook/code/hsum.F
+++ /dev/null
@@ -1,42 +0,0 @@
-*
-* $Id: hsum.F,v 1.1.1.1 1996/01/16 17:07:48 mclareni Exp $
-*
-* $Log: hsum.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:48 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.23/01 20/02/95 09.52.45 by Julian Bunn
-*-- Author :
- FUNCTION HSUM(IDD)
-*.==========>
-*. RETURN SUM OF CONTENTS OF IDD (NO UNDER OVERFLOWS )
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
- COMMON/HCGARB/NCX,NCY,GA(15)
-*.___________________________________________
- SUM=0.
- CALL HFIND(IDD,'HSUM ')
- IF(LCID.EQ.0)GO TO 99
- NCX=IQ(LCID+KNCX)
- IF(JBIT(IQ(LCID+KBITS),1).EQ.0)GO TO 20
-*
-* 1-DIM HIST
-*
- DO 10 I=1,NCX
- SUM=SUM+HCX(I,1)
- 10 CONTINUE
- GO TO 99
-*
-* 2-DIM HIST
-*
- 20 NCY=IQ(LCID+KNCY)
- DO 40 I=1,NCX
- DO 30 J=1,NCY
- SUM=SUM+HCXY(I,J,1)
- 30 CONTINUE
- 40 CONTINUE
-*
- 99 HSUM=SUM
- END
diff --git a/src/packlib/hbook/code/hsupim.F b/src/packlib/hbook/code/hsupim.F
deleted file mode 100644
index 2f6d78b..0000000
--- a/src/packlib/hbook/code/hsupim.F
+++ /dev/null
@@ -1,68 +0,0 @@
-*
-* $Id: hsupim.F,v 1.1.1.1 1996/01/16 17:07:48 mclareni Exp $
-*
-* $Log: hsupim.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:48 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.19/00 26/04/93 11.21.02 by Rene Brun
-*-- Author :
- SUBROUTINE HSUPIM (FUNC)
-*.==========>
-*. cette routine stocke la valeur de la fonction
-*. FUNC pour un unidimensionnel
-*..=========> ( R.Brun ,I.Ivanchenko, D.Lienart)
-#include "hbook/hcflag.inc"
-#include "hbook/hcbook.inc"
-#include "hbook/hcform.inc"
-#include "hbook/hcfitr.inc"
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION FUNC
-#endif
- EXTERNAL FUNC
-*.___________________________________________
-*
- IF(IFTRNG.NE.0)THEN
- NCX=IFXUP-IFXLOW+1
- ELSE
- NCX=IQ(LPRX)
- ENDIF
- IF(NV.EQ.1)THEN
- IF(LQ(LCONT-1).EQ.0)THEN
- NTOT=NCX+12
- CALL HSPACE(NTOT,'HSUPIM',ID)
- IF(IERR.NE.0)GO TO 99
- CALL MZBOOK(IHDIV,LFUNC,LCONT,-1,'HFUN',0,0,NCX+2,IOCF2,-1)
- CALL HSIFLA(12,1)
- IQ(LCID+KNTOT)=IQ(LCID+KNTOT)+NTOT
- ELSE
- LFUNC=LQ(LCONT-1)
- NMORE=NCX+2-IQ(LFUNC-1)
- IF(NMORE.NE.0)THEN
- LR1=LFUNC
- CALL MZPUSH(IHDIV,LR1,0,NMORE,' ')
- IQ(LCID+KNTOT)=IQ(LCID+KNTOT)+NMORE
- ENDIF
- ENDIF
- LFUNC=LQ(LCONT-1)
- IF(IFTRNG.NE.0)THEN
- IQ(LFUNC+1)=IFXLOW
- IQ(LFUNC+2)=IFXUP
- ELSE
- IQ(LFUNC+1)=1
- IQ(LFUNC+2)=NCX
- ENDIF
- ELSE
- LFUNC=LQ(LCONT-1)
- DX=(Q(LPRX+2)-Q(LPRX+1))/FLOAT(IQ(LPRX))
- X=Q(LPRX+1)-0.5*DX
- IF(IFTRNG.NE.0)X=X+DX*(IFXLOW-1)
- DO 40 I=1,NCX
- X=X+DX
- Q(LFUNC+I+2)=FUNC(X)
- 40 CONTINUE
- ENDIF
- 99 NV=2
- END
diff --git a/src/packlib/hbook/code/hsupin.F b/src/packlib/hbook/code/hsupin.F
deleted file mode 100644
index 958bde9..0000000
--- a/src/packlib/hbook/code/hsupin.F
+++ /dev/null
@@ -1,139 +0,0 @@
-*
-* $Id: hsupin.F,v 1.1.1.1 1996/01/16 17:07:48 mclareni Exp $
-*
-* $Log: hsupin.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:48 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.17/02 15/12/92 21.52.04 by Rene Brun
-*-- Author : John Allison 08/09/92
- SUBROUTINE HSUPIN (ICASE)
-*.==========>
-*. Stores fit parameters for ntuples.
-*. ICASE = 0, drop structure.
-*. ICASE = 1, initialise structure.
-*. ICASE >= 2, store parameters.
-*.
-*. I
-*. I LHFIT=LQ(LFUNC-1) and LFUNC=LQ(LCID-5) for ntuples.
-*. I
-*. V
-*. ********************************************
-*. * HFIT chain - see HSUPIS for description. *
-*. ********************************************
-*.
-*. Note: In the case of 1- and 2-D the LFUNC bank is used to store the
-* channel numbers of any histogram with which it is associated,
-* as, e.g., in PANDRA (which processes the NTUPLE/DRAW commmand in
-* PAW). The first 4 words are reserved for this. Otherwise the
-* bank is not used at the moment.
-*.
-*..=========> ( R.Brun, J.Allison)
-#include "hbook/hcbook.inc"
-#include "hbook/hcflag.inc"
-#include "hbook/hcform.inc"
-#include "hbook/hcfits.inc"
-#if defined(CERNLIB_DOUBLE)
- PARAMETER (NWW=2)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- PARAMETER (NWW=1)
-#endif
-*.___________________________________________
-*
-*000000000000000000000000000000000000000000000000000000000000000000000000
- CALL SBIT0(IQ(LCID),5)
- IF(ICASE.EQ.0)THEN
- IF(IQ(LCID-2).EQ.2)THEN
-* Old ntuple.
- IF(IQ(LCONT-2).EQ.0)GO TO 20
- LFUNC=LQ(LCONT-1)
- ELSEIF(IQ(LCID-2).EQ.6)THEN
-* New ntuple.
- LFUNC=LQ(LCID-5)
- ELSE
- GO TO 20
- ENDIF
- IF(LFUNC.EQ.0)GO TO 20
- CALL MZDROP(IHDIV,LFUNC,' ')
-*11111111111111111111111111111111111111111111111111111111111111111111111
- ELSEIF(ICASE.EQ.1)THEN
- NTOT=21
- CALL HSPACE(NTOT,'HSUPIN',ID)
- IF(IERR.NE.0)GO TO 20
- IF(IQ(LCID-2).EQ.2)THEN
-* Old ntuple.
- IF(IQ(LCONT-2).EQ.0)THEN
- NNOW=IQ(LCONT-1)+IQ(LCONT-3)+10
- NMORE=1
- NNEW=NNOW+NMORE
- CALL HSPACE(NNOW+NNEW,'HSUPIN',ID)
- IF(IERR.NE.0)GO TO 20
- CALL MZPUSH(IHDIV,LCONT,NMORE,0,' ')
- ENDIF
- CALL MZBOOK(IHDIV,LFUNC,LCONT,-1,'HFUN',1,1,10,2,0)
- ELSEIF(IQ(LCID-2).EQ.6)THEN
-* New ntuple.
- CALL MZBOOK(IHDIV,LFUNC,LCID,-5,'HFUN',1,1,10,2,0)
- ELSE
- GO TO 20
- ENDIF
-*2+2+2+2+2+2+2+2+2+2+2+2+2+2+2+2+2+2+2+2+2+2+2+2+2+2+2+2+2+2+2+2+2+2+2+2+
- ELSEIF(ICASE.GE.2)THEN
-* Book the LHFIT banks.
- IFITTY=100
- IF(FITNAM(1).EQ.'MQuadric')IFITTY=4
- IF(IFITTY.NE.4)GO TO 20
- NDIM=IQ(LCID+2)
- NOTHER=(NDIM+1)*NFPAR+5
- NWERR=0
- NWFIT=10+NWW*(NFPAR+NOTHER+NWERR)
- NTOT=NWFIT+10
- CALL HSPACE(NTOT,'HSUPIN',ID)
- IF(IERR.NE.0)GO TO 20
- IF(IQ(LCID-2).EQ.2)THEN
-* Old ntuple.
- IF(IQ(LCONT-2).EQ.0)THEN
- NNOW=IQ(LCONT-1)+IQ(LCONT-3)+10
- NMORE=1
- NNEW=NNOW+NMORE
- CALL HSPACE(NNOW+NNEW,'HSUPIN',ID)
- IF(IERR.NE.0)GO TO 20
- CALL MZPUSH(IHDIV,LCONT,NMORE,0,' ')
- ENDIF
- LFUNC=LQ(LCONT-1)
- ELSEIF(IQ(LCID-2).EQ.6)THEN
-* New ntuple.
- LFUNC=LQ(LCID-5)
- ELSE
- GO TO 20
- ENDIF
- IF(LFUNC.LE.0)GO TO 20
- CALL MZBOOK(IHDIV,LHFIT,LFUNC,-1,'HFIT',0,0,NWFIT,IOFIT,0)
- CALL SBIT1(IQ(LHFIT),5)
-* Calculate no. of words in LFCOV bank and add to end of chain if space.
- LFCOV=0
- NWCOV=NWW*NFPAR*(NFPAR+1)/2
- NTOT=NWCOV+10
- CALL HSPACE(NTOT,'HSUPIN',ID)
- IF(IERR.EQ.0)THEN
- L=LHFIT
- 10 CONTINUE
- LR1=L
- L=LQ(L)
- IF(L.NE.0)GO TO 10
- CALL MZBOOK(IHDIV,LFCOV,LR1,0,'HFCO',0,0,NWCOV,4,-1)
- ENDIF
-* Fill LHFIT banks.
- IQ(LHFIT+1)=IFITTY
- IQ(LHFIT+2)=NFPAR
- IQ(LHFIT+3)=NPFITS
- IQ(LHFIT+4)=NOTHER
- Q(LHFIT+6)=FITCHI
- CALL HQPUTF(LHFIT)
- ENDIF
-*
- 20 RETURN
- END
diff --git a/src/packlib/hbook/code/hsupis.F b/src/packlib/hbook/code/hsupis.F
deleted file mode 100644
index 5a90065..0000000
--- a/src/packlib/hbook/code/hsupis.F
+++ /dev/null
@@ -1,313 +0,0 @@
-*
-* $Id: hsupis.F,v 1.1.1.1 1996/01/16 17:07:49 mclareni Exp $
-*
-* $Log: hsupis.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:49 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.22/05 20/06/94 16.21.17 by Rene Brun
-*-- Author :
- SUBROUTINE HSUPIS (FUNC,ICASE,JC1,JC2)
-*.==========>
-*. Stores values of FUNC and/or parameters.
-*. ICASE = 0, drop structure and clear HCBITS flag 12.
-*. ICASE = 1, initialise structure and set HCBITS flag 12.
-*. ICASE = 2, store parameters and, for 1-D, store function values.
-*. ICASE = 3, store parameters and function values for all-D.
-*. JC1, JC2 = lower and upper channel no. of range (1-D only).
-*. (If JC2 = 0, whole histogram assumed.)
-*. New format for parameter storage (29/07/92) - LHFIT bit 5 is set.
-*.
-*. I
-*. I LHFIT=LQ(LFUNC-1) and LFUNC=LQ(LCONT-1) for both 1- and 2-D.
-*. I
-*. V LHFCO, LHFNA
-*. ************************** *****************************
-*. * HFIT * Detailed below. *-->* Linear chain - see below. *
-*. ************************** *****************************
-*.
-*.
-*. Details of fit parameter storage banks - LHFIT and linear chain.
-*. ---------------------------------------------------------------
-*.
-*. ***********************************************************************
-*. * LHFIT bank (name HFIT). *
-*. ***********************************************************************
-*. * word * type * content *
-*. ***********************************************************************
-*. * 1 * I * type of parametrisation: (IFITTY) *
-*. * * * = 0, no parameters stored. *
-*. * * * = 1, polynomial. *
-*. * * * = 2, exponential. *
-*. * * * = 3, gaussian. *
-*. * * * = 4, multiquadric. *
-*. * * * = 100, other. *
-*. ***********************************************************************
-*. * 2 * I * no. of variable parameters. (NFPAR) *
-*. * 3 * I * no. of data points fitted. (NPFITS) *
-*. * 4 * I * no. of other (fixed) parameters. (NOTHER) *
-*. * 5 * I * not used. *
-*. ***********************************************************************
-*. * 6 * R * chi-squared/no. of degrees of freedom. (FITCHI) *
-*. * 7 * R * minimum function value (sampled at bin centres). *
-*. * 8 * R * maximum function value (sampled at bin centres). *
-*. * 9 * R * not used. *
-*. * 10 * R * not used. *
-*. ***********************************************************************
-*. * 20ff * D * fitted parameters. (NFPAR D.P. words) *
-*. * * * fixed parameters. (NOTHER D.P. words) *
-*. * * * errors on fitted parameters. (NFPAR D.P. words) *
-*. * * * (If covariances are available, no errors are stored.) *
-*. ***********************************************************************
-*. I
-*. I
-*. V
-*. ***********************************************************************
-*. * LHSCOV bank (if present) (name HFCO). *
-*. ***********************************************************************
-*. * * D * lower triangle of covariance matrix of fitted *
-*. * * * parameters. (NFPAR*(NFPAR+1)/2 D.P. words) *
-*. ***********************************************************************
-*. I
-*. I
-*. V
-*. ***********************************************************************
-*. * LHSNAM bank (if present) (name HFNA). *
-*. ***********************************************************************
-*. * * 8H * parameter names. (NFPAR 8H words) *
-*. ***********************************************************************
-*.
-*..=========> ( R.Brun, J.Allison)
-#include "hbook/hcbook.inc"
-#include "hbook/hcbits.inc"
-#include "hbook/hcflag.inc"
-#include "hbook/hcform.inc"
-#include "hbook/hcfits.inc"
- INTEGER IC1, IC2
-#if defined(CERNLIB_DOUBLE)
- PARAMETER (NWW=2)
- DOUBLE PRECISION SS
-#endif
-#if !defined(CERNLIB_DOUBLE)
- PARAMETER (NWW=1)
- REAL SS
-#endif
- REAL V(2)
- EQUIVALENCE (X, V(1)), (Y, V(2))
- EXTERNAL FUNC
-*.___________________________________________
-*
- CALL SBIT0(IQ(LCID),5)
- IF(JC2.EQ.0)THEN
- IC1=1
- IC2=IQ(LCID+KNCX)
- ELSE
- IC1=JC1
- IC2=JC2
- ENDIF
- NCX=IC2-IC1+1
- IF(I230.NE.0)NCY=IQ(LCID+KNCY)
-*000000000000000000000000000000000000000000000000000000000000000000000000
- IF(ICASE.EQ.0)THEN
- IF(IQ(LCONT-2).EQ.0)GO TO 100
- LFUNC=LQ(LCONT-1)
- IF(LFUNC.LE.0)GO TO 100
- NTOT=IQ(LFUNC-1)+IQ(LFUNC-3)+10
- IF(IQ(LFUNC-2).NE.0)THEN
- LHFIT=LQ(LFUNC-1)
- IF(LHFIT.NE.0)THEN
- NTOT=NTOT+IQ(LHFIT-1)+10
- L=LHFIT
- 10 CONTINUE
- L=LQ(L)
- IF(L.NE.0)THEN
- NTOT=NTOT+IQ(L-1)+10
- GO TO 10
- ENDIF
- ENDIF
- ENDIF
- CALL MZDROP(IHDIV,LFUNC,' ')
- CALL HSIFLA(12,0)
- IQ(LCID+KNTOT)=IQ(LCID+KNTOT)-NTOT
-*11111111111111111111111111111111111111111111111111111111111111111111111
- ELSEIF(ICASE.EQ.1)THEN
-* If old style 2-D bank, MZPUSH 2 structural links.
- IF(IQ(LCONT-2).EQ.0)THEN
- NNOW=IQ(LCONT-1)+IQ(LCONT-3)+10
- NMORE=2
- NNEW=NNOW+NMORE
- CALL HSPACE(NNOW+NNEW,'HSUPIS',ID)
- IF(IERR.NE.0)GO TO 100
- CALL MZPUSH(IHDIV,LCONT,NMORE,0,' ')
- IQ(LCID+KNTOT)=IQ(LCID+KNTOT)+NMORE
- ENDIF
- LFUNC=LQ(LCONT-1)
- IF(LFUNC.EQ.0)THEN
- IF(I1.NE.0)THEN
- NTOT=NCX+13
- CALL HSPACE(NTOT,'HSUPIS',ID)
- IF(IERR.NE.0)GO TO 100
- CALL MZBOOK(IHDIV,LFUNC,LCONT,-1,'HFUN',1,1,NCX+2,
- + IOCF2,-1)
- ELSE
-* Create short 2-D HFUN bank - MZPUSH later if required.
- NTOT=15
- CALL HSPACE(NTOT,'HSUPIS',ID)
- IF(IERR.NE.0)GO TO 100
- CALL MZBOOK(IHDIV,LFUNC,LCONT,-1,'HFUN',1,1,4,
- + IOCF4,0)
- ENDIF
- CALL HSIFLA(12,1)
- IQ(LCID+KNTOT)=IQ(LCID+KNTOT)+NTOT
- ELSEIF(I1.NE.0)THEN
- NMORE=NCX+2-IQ(LFUNC-1)
- IF(NMORE.NE.0)THEN
- NNOW=IQ(LFUNC-1)+IQ(LFUNC-3)+10
- NNEW=NNOW+NMORE
- CALL HSPACE(NNOW+NNEW,'HSUPIS',ID)
- IF(IERR.NE.0)GO TO 100
- CALL MZPUSH(IHDIV,LFUNC,0,NMORE,' ')
- IQ(LCID+KNTOT)=IQ(LCID+KNTOT)+NMORE
- ENDIF
- ENDIF
- IF(I1.NE.0)THEN
- IQ(LFUNC+1)=IC1
- IQ(LFUNC+2)=IC2
- ELSE
- IQ(LFUNC+1)=1
- IQ(LFUNC+2)=NCX
- IQ(LFUNC+3)=1
- IQ(LFUNC+4)=NCY
- ENDIF
-*2+2+2+2+2+2+2+2+2+2+2+2+2+2+2+2+2+2+2+2+2+2+2+2+2+2+2+2+2+2+2+2+2+2+2+2+
- ELSEIF(ICASE.GE.2)THEN
- IF(IQ(LCONT-2).EQ.0)GO TO 100
- LFUNC=LQ(LCONT-1)
- IF(LFUNC.EQ.0)GO TO 100
- IF(IQ(LFUNC-2).LT.1)GO TO 100
- IFITTY=100
- IF(FITNAM(1).EQ.'A0'.AND.FITNAM(NFPAR+1).EQ.'HFITPO')IFITTY=1
- IF(NFPAR.EQ.2.AND.FITNAM(3).EQ.'HFITEX')IFITTY=2
- IF(NFPAR.EQ.3.AND.FITNAM(4).EQ.'HFITGA')IFITTY=3
- IF(FITNAM(1).EQ.'MQuadric')IFITTY=4
-* Calculate no. of words in LHFIT bank and book.
- IF(IFITTY.EQ.4)THEN
- IF(I1.NE.0)THEN
- NOTHER=2*NFPAR+5
- ELSE
- NOTHER=3*NFPAR+5
- ENDIF
- NWERR=0
- ELSE
- NOTHER=0
- NWERR=NFPAR
- ENDIF
- NWFIT=10+NWW*(NFPAR+NOTHER+NWERR)
- NTOT=NWFIT+10
- CALL HSPACE(NTOT,'HSUPIS',ID)
- IF(IERR.NE.0)GO TO 100
- CALL MZBOOK(IHDIV,LHFIT,LFUNC,-1,'HFIT',0,0,NWFIT,IOFIT,0)
- IQ(LCID+KNTOT)=IQ(LCID+KNTOT)+NTOT
- CALL SBIT1(IQ(LHFIT),5)
-* Calculate no. of words in LHFCO bank and add to end of chain if space.
- LHFCO=0
- LHFNA=0
- IF(IFITTY.EQ.4)THEN
- NWCOV=NWW*NFPAR*(NFPAR+1)/2
- NTOT=NWCOV+10
- CALL HSPACE(NTOT,'HSUPIS',ID)
- IF(IERR.EQ.0)THEN
- L=LHFIT
- 20 CONTINUE
- LR1=L
- L=LQ(L)
- IF(L.NE.0)GO TO 20
- CALL MZBOOK(IHDIV,LHFCO,LR1,0,'HFCO',0,0,NWCOV,4,-1)
- IQ(LCID+KNTOT)=IQ(LCID+KNTOT)+NTOT
- ENDIF
- ENDIF
-* Calculate no. of words in LHFNA bank and add to end of chain if space.
- IF(IFITTY.GE.100)THEN
- NWNAM=2*NFPAR
- NTOT=NWNAM+10
- CALL HSPACE(NTOT,'HSUPIS',ID)
- IF(IERR.EQ.0)THEN
- L=LHFIT
- 30 CONTINUE
- LR1=L
- L=LQ(L)
- IF(L.NE.0)GO TO 30
- CALL MZBOOK(IHDIV,LHFNA,LR1,0,'HFNA',0,0,NWNAM,5,-1)
- IQ(LCID+KNTOT)=IQ(LCID+KNTOT)+NTOT
- ENDIF
- ENDIF
-* Fill banks.
- IQ(LHFIT+1)=IFITTY
- IQ(LHFIT+2)=NFPAR
- IQ(LHFIT+3)=NPFITS
- IQ(LHFIT+4)=NOTHER
- Q(LHFIT+6)=FITCHI
- IF(IFITTY.EQ.4)THEN
- CALL HQPUTF(LHFIT)
- ELSE
- II=11
- DO 40 I=1,NFPAR
-* Note: FITPAR is only single precision.
- SS=FITPAR(I)
- CALL UCOPY(SS,Q(LHFIT+II),NWW)
- II=II+NWW
- 40 CONTINUE
- DO 50 I=1,NFPAR
-* Note: FITSIG is only single precision.
- SS=FITSIG(I)
- CALL UCOPY(SS,Q(LHFIT+II),NWW)
- II=II+NWW
- 50 CONTINUE
-* IF(LHFCO.NE.0)CALL MNEMAT and fill covariance bank.
- IF(LHFNA.NE.0)THEN
- DO 60 I=1,NFPAR
- CALL UCTOH(FITNAM(I),Q(LHFNA+2*I-1),4,8)
- 60 CONTINUE
- ENDIF
- ENDIF
-* Now fill HFUN bank with function values at bin centres.
- IF(I1.NE.0)THEN
- DX=(Q(LPRX+2)-Q(LPRX+1))/FLOAT(IQ(LPRX))
- DO 70 I=1,NCX
- IF(I6.EQ.0)THEN
- X=Q(LPRX+1)+0.5*DX+DX*(IC1+I-2)
- ELSE
- LBINS=LQ(LCID-2)
- X=0.5*(Q(LBINS+IC1+I-1)+Q(LBINS+IC1+I))
- ENDIF
- Q(LFUNC+I+2)=FUNC(V)
- 70 CONTINUE
- ELSEIF(ICASE.EQ.3)THEN
-* MZPUSH HFUN bank if necessary.
- IF(I230.NE.0.AND.IQ(LFUNC-1).EQ.4)THEN
- NNOW=4+IQ(LFUNC-3)+10
- NMORE=NCX*NCY
- NNEW=NNOW+NMORE
- CALL HSPACE(NNOW+NNEW,'HSUPIS',ID)
- IF(IERR.NE.0)GO TO 100
- LFUNC=LQ(LCONT-1)
- CALL MZPUSH(IHDIV,LFUNC,0,NMORE,' ')
- IQ(LCID+KNTOT)=IQ(LCID+KNTOT)+NMORE
- ENDIF
- DX=(Q(LPRX+2)-Q(LPRX+1))/FLOAT(IQ(LPRX))
- DY=(Q(LPRY+2)-Q(LPRY+1))/FLOAT(IQ(LPRY))
- DO 90 IX=1,NCX
- X=Q(LPRX+1)+(IX-0.5)*DX
- DO 80 IY=1,NCY
- Y=Q(LPRY+1)+(IY-0.5)*DY
- I=(IY-1)*NCX+IX
- Q(LFUNC+I+4)=FUNC(V)
- 80 CONTINUE
- 90 CONTINUE
- ENDIF
- ENDIF
-*
- 100 RETURN
- END
diff --git a/src/packlib/hbook/code/htable.F b/src/packlib/hbook/code/htable.F
deleted file mode 100644
index 8eead12..0000000
--- a/src/packlib/hbook/code/htable.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: htable.F,v 1.1.1.1 1996/01/16 17:07:49 mclareni Exp $
-*
-* $Log: htable.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:49 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.10/05 21/02/89 16.14.54 by Rene Brun
-*-- Author :
- SUBROUTINE HTABLE(ID2,CHTITL,NNX,XX0,XX1,NNY,YY0,YY1,VALMAX)
-*.==========>
-*. BOOKING OF A TABLE
-*..=========> ( R.Brun )
-#include "hbook/hcflag.inc"
- CHARACTER*(*) CHTITL
-*.___________________________________________
- NV=1
- XVALMA=1000.
- IFW=9
- CALL NOARG(IFW)
- IF(IFW.EQ.9)XVALMA=FLOARG(VALMAX)
- CALL HBOOK2(ID2,CHTITL,NNX,XX0,XX1,NNY,YY0,YY1,XVALMA)
- NV=2
- END
diff --git a/src/packlib/hbook/code/htfunc.F b/src/packlib/hbook/code/htfunc.F
deleted file mode 100644
index 9a3d810..0000000
--- a/src/packlib/hbook/code/htfunc.F
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: htfunc.F,v 1.1.1.1 1996/01/16 17:07:49 mclareni Exp $
-*
-* $Log: htfunc.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:49 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.10/05 06/06/90 17.45.59 by Rene Brun
-*-- Author :
- SUBROUTINE HTFUNC(TFUNC,XHFIT,YHFIT,Z)
-*.==========>
-*. COMPUTES Z=TFUNC(XHFIT,YHFIT)
-*..=========> ( R.Brun )
- EXTERNAL TFUNC
-*.___________________________________________
- Z=TFUNC(XHFIT,YHFIT)
- 99 RETURN
- END
diff --git a/src/packlib/hbook/code/htitle.F b/src/packlib/hbook/code/htitle.F
deleted file mode 100644
index dd0871d..0000000
--- a/src/packlib/hbook/code/htitle.F
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: htitle.F,v 1.1.1.1 1996/01/16 17:07:49 mclareni Exp $
-*
-* $Log: htitle.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:49 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.10/05 21/02/89 16.14.54 by Rene Brun
-*-- Author :
- SUBROUTINE HTITLE(CHTITL)
-*.==========>
-*. STORE GLOBAL TITLE IN LGTIT
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
-#include "hbook/hcflag.inc"
- CHARACTER*(*) CHTITL
-*.___________________________________________
- CALL HBTIT(CHTITL,NWT,NCHT)
- IF(LGTIT.NE.0)THEN
- CALL MZDROP(IHDIV,LGTIT,' ')
- LGTIT=0
- ENDIF
- IF(NWT.EQ.0)GO TO 99
- CALL HSPACE(NWT+20,'HTITLE',0)
- IF(IERR.NE.0)GO TO 99
-*
- CALL MZBOOK(IHDIV,LGTIT,LGTIT,1,'HGTI',0,0,NWT,4,-1)
- CALL UCTOH(CHTITL,IQ(LGTIT+1),4,NCHT)
-*
- 99 RETURN
- END
diff --git a/src/packlib/hbook/code/hunpak.F b/src/packlib/hbook/code/hunpak.F
deleted file mode 100644
index 81d7379..0000000
--- a/src/packlib/hbook/code/hunpak.F
+++ /dev/null
@@ -1,69 +0,0 @@
-*
-* $Id: hunpak.F,v 1.1.1.1 1996/01/16 17:07:49 mclareni Exp $
-*
-* $Log: hunpak.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:49 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.23/01 20/02/95 09.53.13 by Julian Bunn
-*-- Author :
- SUBROUTINE HUNPAK(IDD,X,KCASE,NUMM)
-*.==========>
-*. THIS ROUTINE UNPACKS VALUES CORRESPONDING TO HIST ID
-*. FOLLOWING VALUES OF KCASE HUNPAK RETURNS THE CONTENTS OF
-*. HISTOGRAM,OR PROJECTION,SLICES OR BANDES
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
- DIMENSION X(1)
- CHARACTER*(*) KCASE
-*.___________________________________________
- NARG=4
- CALL NOARG(NARG)
- ICAS=0
- NUM=0
- IF(NARG.EQ.4)NUM=NUMM
- IF(NARG.GT.2)THEN
- CALL UCTOH(KCASE,ICAS,4,4)
- ENDIF
-*
- IF(LFIX.EQ.0)THEN
- CALL HFINOP(IDD,'HUNPAK',IFW,NB,IFX,IFY,ICAS,NUM)
- LCONT=LQ(LCID-1)
- ELSE
- IFW=LCONT
- IFX=LPRX
- IFY=LPRY
- ENDIF
-*
- IF(IFW.EQ.0)THEN
- IF(JBYT(IQ(LCID+KBITS),1,3).EQ.0)GO TO 40
- CALL HBUG('Cannot find projection','HUNPAK',IDD)
- GO TO 99
- ENDIF
- LCONT=IFW
- NCX=IQ(IFX)
- IF(IFY.EQ.0)THEN
- DO 10 I=1,NCX
- X(I)=HCX(I,1)
- 10 CONTINUE
- GO TO 99
- ENDIF
-*
- NCY=IQ(IFY)
- LSCAT=LCONT
- K=0
- DO 30 J=1,NCY
- DO 20 I=1,NCX
- K=K+1
- X(K)=HCXY(I,J,1)
- 20 CONTINUE
- 30 CONTINUE
- GO TO 99
-*
- 40 NW=IQ(LCID-1)
- CALL UCOPY(Q(LCID+1),X,NW)
-*
- 99 RETURN
- END
diff --git a/src/packlib/hbook/code/hunpke.F b/src/packlib/hbook/code/hunpke.F
deleted file mode 100644
index f9fafc7..0000000
--- a/src/packlib/hbook/code/hunpke.F
+++ /dev/null
@@ -1,72 +0,0 @@
-*
-* $Id: hunpke.F,v 1.1.1.1 1996/01/16 17:07:49 mclareni Exp $
-*
-* $Log: hunpke.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:49 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.23/01 20/02/95 09.57.00 by Julian Bunn
-*-- Author :
- SUBROUTINE HUNPKE(IDD,X,CHCASE,NUMM)
-*.==========>
-*. This routine unpacks errors corresponding to hist ID
-*. following values of KCASE, HUNPKE returns the errors of
-*. HISTogram, or PROJection, SLI(X/Y)ces or BAN(X/Y)ds
-*..=========> ( R. Namjoshi, modified from HUNPAK )
-#include "hbook/hcbook.inc"
- CHARACTER*(*) CHCASE
- CHARACTER*4 KCASE
- DIMENSION X(1)
-*.___________________________________________
- ICAS = 0
- NUM = NUMM
- KCASE=CHCASE
- IF(KCASE.EQ.' ')KCASE='HIST'
- CALL UCTOH(KCASE,ICAS,4,4)
-*
- IF( LFIX.EQ.0 ) THEN
- CALL HFINOP( IDD, 'HUNPKE', IFW, NB, IFX, IFY, ICAS, NUM )
- LCONT=LQ(LCID-1)
- ELSE
- IFW = LCONT
- IFX = LPRX
- IFY = LPRY
- ENDIF
-*
- IF( IFW.EQ.0 ) THEN
- CALL HBUG( 'Cannot find projection', 'HUNPKE', IDD )
- GO TO 99
- ENDIF
- LCONT = IFW
- NCX = IQ(IFX)
- IF( IFY.EQ.0 ) THEN
- IHBX = JBIT(IQ(LCID+KBITS),9)
- IHBY = JBIT(IQ(LCID+KBITS),10)
- ISQR = 1
- IF( (KCASE(4:4).EQ.'X' .AND. IHBX.NE.0) .OR.
- & (KCASE(1:4).EQ.'HIST'.AND. IHBX.NE.0) .OR.
- & (KCASE(4:4).EQ.'Y' .AND. IHBY.NE.0) ) ISQR = 0
- DO 10 I = 1, NCX
- IF( ISQR.EQ.0 ) THEN
- X(I) = HCX(I,2)
- ELSE
- RES = ABS(HCX(I,1))
- X(I) = SQRT(RES)
- ENDIF
- 10 CONTINUE
- GO TO 99
- ENDIF
-*
- 20 NCY = IQ(IFY)
- K = 0
- DO 35 J = 1, NCY
- DO 30 I = 1, NCX
- K = K + 1
- X(K) = HCXY(I,J,2)
- 30 CONTINUE
- 35 CONTINUE
-*
- 99 RETURN
- END
diff --git a/src/packlib/hbook/code/huoptc.F b/src/packlib/hbook/code/huoptc.F
deleted file mode 100644
index 5ab55d9..0000000
--- a/src/packlib/hbook/code/huoptc.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: huoptc.F,v 1.1.1.1 1996/01/16 17:07:49 mclareni Exp $
-*
-* $Log: huoptc.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:49 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.10/05 21/02/89 16.14.54 by Rene Brun
-*-- Author :
- SUBROUTINE HUOPTC(CCHOPT,CSTR,IOPT)
-*.==========>
-*. Same as KERNLIB routine UOPTC, but in addition
-*. translate string CCHOPT to upper case string CHOPT.
-*..=========> ( R. Brun )
- CHARACTER*(*) CCHOPT,CSTR
- CHARACTER*12 CHOPT
- DIMENSION IOPT(1)
-*.___________________________________________
- CHOPT=CCHOPT
- CALL CLTOU(CHOPT)
- CALL UOPTC(CHOPT,CSTR,IOPT)
-*
- RETURN
- END
diff --git a/src/packlib/hbook/code/hupkrd.F b/src/packlib/hbook/code/hupkrd.F
deleted file mode 100644
index c72d526..0000000
--- a/src/packlib/hbook/code/hupkrd.F
+++ /dev/null
@@ -1,44 +0,0 @@
-*
-* $Id: hupkrd.F,v 1.1.1.1 1996/01/16 17:07:49 mclareni Exp $
-*
-* $Log: hupkrd.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:49 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.10/05 21/02/89 16.14.54 by Rene Brun
-*-- Author :
- SUBROUTINE HUPKRD(LUN,NEXT,MEMSWA)
-*.==========>
-*. Unpack machine independent 32-bit block .Read input
-*. buffer from file LUN
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
- COMMON/HMIBUF/MISCUR,NBUFMI,LUNTYP,NEWBUF,LCBUFF,LUBUFF,MIBEND
- COMMON/HFORM/I5BUFF(128)
-*.___________________________________________
- IF(NBUFMI.EQ.0) GO TO 999
- L = MEMSWA+LUBUFF-1
- LBLOCK = 63
- DO 40 I = MEMSWA,L,64
- LI5BUF = L-I
- IF(LI5BUF.LT.63) LBLOCK = LI5BUF
- READ(LUN,1000)I5BUFF
- K = I+LBLOCK
- I5NEXT = 1
- DO 30 J = I,K
- IQ(J) = I5BUFF(I5NEXT+1)
- CALL SBYT(I5BUFF(I5NEXT),IQ(J),17,16)
- I5NEXT = I5NEXT+2
- 30 CONTINUE
- 40 CONTINUE
- NBUFMI = IQ(MEMSWA)
- MIBEND = MEMSWA+NBUFMI-1
- MISCUR = MEMSWA+4
- NEXT = MISCUR+1
- IF(NEWBUF.EQ.0) NEXT = MISCUR-1
- NEWBUF = 1
-999 RETURN
-1000 FORMAT(16I5)
- END
diff --git a/src/packlib/hbook/code/hwork.F b/src/packlib/hbook/code/hwork.F
deleted file mode 100644
index 46fa870..0000000
--- a/src/packlib/hbook/code/hwork.F
+++ /dev/null
@@ -1,35 +0,0 @@
-*
-* $Id: hwork.F,v 1.2 1997/03/14 17:04:24 mclareni Exp $
-*
-* $Log: hwork.F,v $
-* Revision 1.2 1997/03/14 17:04:24 mclareni
-* WNT mods
-*
-* Revision 1.1.1.1.2.1 1997/01/21 11:28:10 mclareni
-* All mods for Winnt 96a on winnt branch
-*
-* Revision 1.1.1.1 1996/01/16 17:07:49 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.10/05 21/02/89 16.14.54 by Rene Brun
-*-- Author :
- SUBROUTINE HWORK(N,IAD,CHROUT)
-*.==========>
-*. Reserve N words in IHWORK division
-*. IF(IAD=0) NOT ENOUGH SPACE
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
-#include "hbook/hcflag.inc"
- CHARACTER*(*) CHROUT
-*.___________________________________________
- IF(NZLEFT(IHWORK,0).GT.N+100)THEN
- IAD=100
- ELSE
- IAD=0
- IERR=1
- CALL HBUG('Not enough space in memory',CHROUT,ID)
- ENDIF
- 99 RETURN
- END
diff --git a/src/packlib/hbook/code/hwritf.F b/src/packlib/hbook/code/hwritf.F
deleted file mode 100644
index 46fc285..0000000
--- a/src/packlib/hbook/code/hwritf.F
+++ /dev/null
@@ -1,110 +0,0 @@
-*
-* $Id: hwritf.F,v 1.1.1.1 1996/01/16 17:07:49 mclareni Exp $
-*
-* $Log: hwritf.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:49 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.17/01 09/10/92 17.51.13 by Janusz Chwastowski
-*-- Author :
- SUBROUTINE HWRITF (ITAP)
-*.==========>
-*. WRITE FORTRAN FUNCTION FPARAM ON TAPE ITAP
-*. THE FORTRAN CODE GENERATED COMPUTES THE
-*. REGRESSION VALUE AT A POINT X AND IS COMPLETELY
-*. INDEPENDENT FROM THE HPARAM PACKAGE
-*..=========> ( D.Lienart )
- CHARACTER NORM*1
-#include "hbook/hcpar1.inc"
-#include "hbook/hcpar2.inc"
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION COEFF
-#endif
-*
-* WRITE DECLARATIONS AND POSSIBLY NORMALIZATION CODE
-*
- NORM=' '
- IF (IOPT(8).GT.0) NORM='N'
- WRITE (ITAP,500)
- WRITE (ITAP,510) NCO,ND,NCO
- IF (IOPT(8).EQ.3) WRITE (ITAP,520) ND,ND
- IF (IOPT(8).EQ.1.OR.IOPT(8).EQ.2) WRITE (ITAP,530) ND,ND,ND,ND,ND
- WRITE (ITAP,540) (COEFF(I),I=1,NCO)
- WRITE (ITAP,560)
- WRITE (ITAP,550) ((IBASFT(I,J),I=1,ND),J=1,NCO)
- WRITE (ITAP,560)
- IF (IOPT(8).EQ.3) THEN
- WRITE (ITAP,570) (XMIN(I),I=1,ND)
- WRITE (ITAP,590) ND
- ENDIF
- IF (IOPT(8).EQ.1.OR.IOPT(8).EQ.2) THEN
- WRITE (ITAP,580) (XMIN(I),I=1,ND),(XMAX(I),I=1,ND),
- + (ALIM(I),I=1,ND),(BLIM(I),I=1,ND)
- WRITE (ITAP,600) ND
- ENDIF
-*
-* WRITE REGRESSION CODE
-*
- WRITE (ITAP,610) NCO,ND
- IF (IOPT(4).EQ.0) WRITE (ITAP,620) NORM,NORM
- IF (IOPT(4).EQ.1) WRITE (ITAP,630) NORM,NORM
- IF (IOPT(4).EQ.2) WRITE (ITAP,640) NORM,NORM
- IF (IOPT(4).EQ.3) WRITE (ITAP,650) NORM,NORM
- IF (IOPT(4).EQ.4) WRITE (ITAP,660) NORM,NORM
- IF (IOPT(4).EQ.5) WRITE (ITAP,670) NORM,NORM
- WRITE (ITAP,680) NORM,NORM
-*
-#if !defined(CERNLIB_DOUBLE)
- 500 FORMAT (6X,'FUNCTION FPARAM (X)')
-#endif
-#if defined(CERNLIB_DOUBLE)
- 500 FORMAT (6X,'DOUBLE PRECISION FUNCTION FPARAM (X)',/,
- + 6X,'DOUBLE PRECISION COEFF,P,P0,P1,P2,HELEFT,HBASFT')
-#endif
- 510 FORMAT (6X,'DIMENSION X(1),COEFF(',I2,'),IBASFT(',I2,',',I2,')')
- 520 FORMAT (5X,'+,XN(',I2,'),XMIN(',I2,')')
- 530 FORMAT (5X,'+,XN(',I2,'),XMIN(',I2,'),XMAX(',I2,'),ALIM(',I2,
- + '),BLIM(',I2,')')
-#if !defined(CERNLIB_DOUBLE)
- 540 FORMAT (6X,'DATA COEFF/',4(G12.5,:,','),14(/,5X,'+',
- + 4(G12.5,:,',')))
-#endif
-#if defined(CERNLIB_DOUBLE)
- 540 FORMAT (6X,'DATA COEFF/',3(D15.8,:,','),19(/,5X,'+',
- + 3(D15.8,:,',')))
-#endif
- 550 FORMAT (6X,'DATA IBASFT/',12(I3,:,','),49(/,5X,'+',
- + 12(I3,:,',')))
- 560 FORMAT (5X,'+/')
- 570 FORMAT (6X,'DATA XMIN/',4(E12.5,:','),/,5X,'+',4(E12.5,:,','),
- + /,5X,'+',2(E12.5,:,','))
- 580 FORMAT (6X,'DATA XMIN,XMAX,ALIM,BLIM/',2(E12.5,:','),10(/,5X,'+',
- + 4(E12.5,:',')))
- 590 FORMAT (5X,'+/',/,6X,'DO 5 I=1,',I2,/,4X,'5 XN(I)=X(I)-XMIN(I)')
- 600 FORMAT (5X,'+/',/,6X,'DO 5 I=1,',I2,/,4X,'5 XN(I)=ALIM(I)+',
- + '(BLIM(I)-ALIM(I))*(X(I)-XMIN(I))/(XMAX(I)-XMIN(I))')
- 610 FORMAT (6X,'FPARAM=0.',/,6X,'DO 25 K=1,',I2,/,6X,'P=1.',/,6X,
- + 'DO 15 I=1,',I2,/,6X,'NUM=IBASFT(I,K)/10',/,6X,
- + 'ITYP=IBASFT(I,K)-NUM*10',/,6X,'IF (NUM.NE.0) THEN',/,
- + 6X,'IF (ITYP.EQ.0) THEN',/,6X,'P0=1.')
- 620 FORMAT (6X,'P1=X',A1,'(I)',/,6X,'DO 10 J=2,NUM',/,
- + 6X,'P2=P1*X',A1,'(I)')
- 630 FORMAT (6X,'P1=X',A1,'(I)',/,6X,'DO 10 J=2,NUM',/,
- + 6X,'P2=2*X',A1,'(I)*P1-P0')
- 640 FORMAT (6X,'P1=X',A1,'(I)',/,6X,'DO 10 J=2,NUM',/,
- + 6X,'P2=(2*J-1)/J*P1*X',A1,'(I)-(J-1)/J*P0')
- 650 FORMAT (6X,'P1=2*X',A1,'(I)-1.',/,6X,'DO 10 J=2,NUM'
- + ,/,6X,'P2=2*(2*X',A1,'(I)-1.)*P1-P0')
- 660 FORMAT (6X,'P1=1-X',A1,'(I)',/,6X,'DO 10 J=2,NUM',/,
- + 6X,'P2=(2*J-1-X',A1,'(I))*P1-(J-1)**2*P0')
- 670 FORMAT (6X,'P1=2*X',A1,'(I)',/,6X,'DO 10 J=2,NUM',/,
- + 6X,'P2=2*X',A1,'(I)*P1-2*(J-1)*P0')
- 680 FORMAT (6X,'P0=P1',/,3X,'10 P1=P2',/,6X,'P=P*P1',/,6X,'END IF',
- + /,6X,'IF (ITYP.EQ.1) P=P*HELEFT(NUM,X',A1,'(I))',/,6X,
- + 'IF (ITYP.EQ.2) THEN',/,6X,'P=HBASFT(NUM,X',A1,')',/,6X,
- + 'GOTO 20',/,6X,'END IF',/,6X,'END IF',/,3X,'15 CONTINUE'
- + ,/,3X,'20 FPARAM=FPARAM+COEFF(K)*P',/,3X,'25 CONTINUE',
- + /,6X,'RETURN',/,6X,'END')
- END
diff --git a/src/packlib/hbook/code/hx.F b/src/packlib/hbook/code/hx.F
deleted file mode 100644
index 1108c35..0000000
--- a/src/packlib/hbook/code/hx.F
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: hx.F,v 1.1.1.1 1996/01/16 17:07:49 mclareni Exp $
-*
-* $Log: hx.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:49 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.19/00 26/04/93 11.57.51 by Rene Brun
-*-- Author :
- FUNCTION HX(IDD,X)
-*.==========>
-*. RETURN THE CONTENT OF CHANNEL CORRESPONDING TO ABSCISSA X
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
-#include "hbook/hcbits.inc"
-*.___________________________________________
- CALL HFIND(IDD,'HX ')
- CALL HDCOFL
- IF(I6.EQ.0)THEN
- DX=FLOAT(IQ(LCID+KNCX))/(Q(LCID+KXMAX)-Q(LCID+KXMIN))
- I=(X-Q(LCID+KXMIN))*DX+1.
- ELSE
- LBINS=LQ(LCID-2)
- DO 10 IC=1,IQ(LCID+KNCX)
- IF(X.GE.Q(LBINS+IC))I=IC
- 10 CONTINUE
- ENDIF
- IF(X.LT.Q(LCID+KXMIN))I=0
- IF(X.GT.Q(LCID+KXMAX))I=IQ(LCID+KNCX)+1
- HX=HCX(I,1)
- END
diff --git a/src/packlib/hbook/code/hxe.F b/src/packlib/hbook/code/hxe.F
deleted file mode 100644
index 954cf69..0000000
--- a/src/packlib/hbook/code/hxe.F
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: hxe.F,v 1.1.1.1 1996/01/16 17:07:49 mclareni Exp $
-*
-* $Log: hxe.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:49 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.19/01 03/05/93 15.46.26 by Rene Brun
-*-- Author :
- FUNCTION HXE(IDD,X)
-*.==========>
-*. RETURN THE ERROR OF CHANNEL CORRESPONDING TO ABSCISSA X
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
-#include "hbook/hcbits.inc"
-*.___________________________________________
- CALL HFIND(IDD,'HXE ')
- CALL HDCOFL
- IF(I6.EQ.0)THEN
- DX=FLOAT(IQ(LCID+KNCX))/(Q(LCID+KXMAX)-Q(LCID+KXMIN))
- I=(X-Q(LCID+KXMIN))*DX+1.
- ELSE
- LBINS=LQ(LCID-2)
- DO 10 IC=1,IQ(LCID+KNCX)
- IF(X.GE.Q(LBINS+IC))I=IC
- 10 CONTINUE
- ENDIF
- IF(X.LT.Q(LCID+KXMIN))I=0
- IF(X.GT.Q(LCID+KXMAX))I=IQ(LCID+KNCX)+1
- HXE=HCX(I,2)
- END
diff --git a/src/packlib/hbook/code/hxi.F b/src/packlib/hbook/code/hxi.F
deleted file mode 100644
index 4225783..0000000
--- a/src/packlib/hbook/code/hxi.F
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: hxi.F,v 1.1.1.1 1996/01/16 17:07:49 mclareni Exp $
-*
-* $Log: hxi.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:49 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.19/00 26/04/93 11.57.51 by Rene Brun
-*-- Author :
- SUBROUTINE HXI(IDD,X,I)
-*.==========>
-*. RETURNS THE VALUE OF CHANNEL I CORRESPONDING TO X
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
-#include "hbook/hcbits.inc"
-*.___________________________________________
- CALL HFIND(IDD,'HXI')
- CALL HDCOFL
- IF(I6.EQ.0)THEN
- DX=FLOAT(IQ(LCID+KNCX))/(Q(LCID+KXMAX)-Q(LCID+KXMIN))
- I=(X-Q(LCID+KXMIN))*DX+1.
- ELSE
- LBINS=LQ(LCID-2)
- DO 10 IC=1,IQ(LCID+KNCX)
- IF(X.GE.Q(LBINS+IC))I=IC
- 10 CONTINUE
- ENDIF
- IF(X.LT.Q(LCID+KXMIN))I=0
- IF(X.GT.Q(LCID+KXMAX))I=IQ(LCID+KNCX)+1
- END
diff --git a/src/packlib/hbook/code/hxnorm.F b/src/packlib/hbook/code/hxnorm.F
deleted file mode 100644
index 9524a0f..0000000
--- a/src/packlib/hbook/code/hxnorm.F
+++ /dev/null
@@ -1,63 +0,0 @@
-*
-* $Id: hxnorm.F,v 1.1.1.1 1996/01/16 17:07:49 mclareni Exp $
-*
-* $Log: hxnorm.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:49 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.22/11 23/08/94 14.17.45 by Rene Brun
-*-- Author :
- SUBROUTINE HXNORM (X)
-*.==========>
-*. NORMALIZATION OF THE X-SPACE BY LINEAR TRANSFORMATION
-*..=========> ( R.Brun )
-#include "hbook/hcpar1.inc"
-#include "hbook/hcpar2.inc"
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION COEFF
-#endif
- DIMENSION X(NPMAX,ND)
-*
-* FIND VARIABLE RANGE
-*
- DO 10 J=1,ND
- XMIN(J)=X(1,J)
- XMAX(J)=XMIN(J)
- DO 5 I=2,NP
- IF (X(I,J).LT.XMIN(J)) XMIN(J)=X(I,J)
- IF (X(I,J).GT.XMAX(J)) XMAX(J)=X(I,J)
- 5 CONTINUE
- 10 CONTINUE
-*
-* PERFORM NORMALIZATION [0,-->[, [0,1] OR [-1,1]
-*
- IF (IOPT(8).EQ.3) THEN
- DO 20 J=1,ND
- XMN=XMIN(J)
- DO 15 I=1,NP
- X(I,J)=X(I,J)-XMN
- 15 CONTINUE
- 20 CONTINUE
- ELSE
- DO 25 I=1,ND
- IF (IOPT(8).EQ.1) THEN
- ALIM(I)=-1.
- BLIM(I)=1.
- ELSE IF (IOPT(8).EQ.2) THEN
- ALIM(I)=0.
- BLIM(I)=1.
- ENDIF
- 25 CONTINUE
- DO 35 J=1,ND
- AL=ALIM(J)
- BAL=BLIM(J)-AL
- XMN=XMIN(J)
- XR=XMAX(J)-XMN
- DO 30 I=1,NP
- X(I,J)=AL+BAL*(X(I,J)-XMN)/XR
- 30 CONTINUE
- 35 CONTINUE
- ENDIF
- END
diff --git a/src/packlib/hbook/code/hxy.F b/src/packlib/hbook/code/hxy.F
deleted file mode 100644
index 6b294bc..0000000
--- a/src/packlib/hbook/code/hxy.F
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: hxy.F,v 1.1.1.1 1996/01/16 17:07:49 mclareni Exp $
-*
-* $Log: hxy.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:49 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.23/01 20/02/95 10.11.57 by Julian Bunn
-*-- Author :
- FUNCTION HXY(IDD,X,Y)
-*.==========>
-*. RETURNS THE CONTENT OF CELL DEFINED BY ABSCISSA X
-*. AND ORDINATE Y
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
-*.___________________________________________
- CALL HFIND(IDD,'HXY ')
- DX=FLOAT(IQ(LCID+KNCX))/(Q(LCID+KXMAX)-Q(LCID+KXMIN))
- DY=FLOAT(IQ(LCID+KNCY))/(Q(LCID+KYMAX)-Q(LCID+KYMIN))
- I=(X-Q(LCID+KXMIN))*DX+1.
- J=(Y-Q(LCID+KYMIN))*DY+1.
- IF(X.LT.Q(LCID+KXMIN))I=0
- IF(X.GT.Q(LCID+KXMAX))I=IQ(LCID+KNCX)+1
- IF(Y.LT.Q(LCID+KYMIN))J=0
- IF(Y.GT.Q(LCID+KYMAX))J=IQ(LCID+KNCY)+1
- HXY=HCXY(I,J,1)
- END
diff --git a/src/packlib/hbook/code/hxye.F b/src/packlib/hbook/code/hxye.F
deleted file mode 100644
index 267a81a..0000000
--- a/src/packlib/hbook/code/hxye.F
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: hxye.F,v 1.1.1.1 1996/01/16 17:07:49 mclareni Exp $
-*
-* $Log: hxye.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:49 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.23/01 20/02/95 10.21.16 by Julian Bunn
-*-- Author :
- FUNCTION HXYE(IDD,X,Y)
-*.==========>
-*. RETURNS THE ERROR ON THE CELL DEFINED BY ABSCISSA X
-*. AND ORDINATE Y
-*..=========> ( J.Bunn )
-#include "hbook/hcbook.inc"
-*.___________________________________________
- CALL HFIND(IDD,'HXYE ')
- DX=FLOAT(IQ(LCID+KNCX))/(Q(LCID+KXMAX)-Q(LCID+KXMIN))
- DY=FLOAT(IQ(LCID+KNCY))/(Q(LCID+KYMAX)-Q(LCID+KYMIN))
- I=(X-Q(LCID+KXMIN))*DX+1.
- J=(Y-Q(LCID+KYMIN))*DY+1.
- IF(X.LT.Q(LCID+KXMIN))I=0
- IF(X.GT.Q(LCID+KXMAX))I=IQ(LCID+KNCX)+1
- IF(Y.LT.Q(LCID+KYMIN))J=0
- IF(Y.GT.Q(LCID+KYMAX))J=IQ(LCID+KNCY)+1
- HXYE=HCXY(I,J,2)
- END
diff --git a/src/packlib/hbook/code/hxyij.F b/src/packlib/hbook/code/hxyij.F
deleted file mode 100644
index 4dc787b..0000000
--- a/src/packlib/hbook/code/hxyij.F
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: hxyij.F,v 1.1.1.1 1996/01/16 17:07:49 mclareni Exp $
-*
-* $Log: hxyij.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:49 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.19/00 26/04/93 11.57.51 by Rene Brun
-*-- Author :
- SUBROUTINE HXYIJ(IDD,X,Y,I,J)
-*.==========>
-*. RETURNS THE VALUE OF I,J CORRESPONDING TO X,Y
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
-*.___________________________________________
- CALL HFIND(IDD,'HXYIJ ')
- DX=FLOAT(IQ(LCID+KNCX))/(Q(LCID+KXMAX)-Q(LCID+KXMIN))
- DY=FLOAT(IQ(LCID+KNCY))/(Q(LCID+KYMAX)-Q(LCID+KYMIN))
- I=(X-Q(LCID+KXMIN))*DX+1.
- J=(Y-Q(LCID+KYMIN))*DY+1.
- IF(X.LT.Q(LCID+KXMIN))I=0
- IF(X.GT.Q(LCID+KXMAX))I=IQ(LCID+KNCX)+1
- IF(Y.LT.Q(LCID+KYMIN))J=0
- IF(Y.GT.Q(LCID+KYMAX))J=IQ(LCID+KNCY)+1
- END
diff --git a/src/packlib/hbook/examples/Imakefile b/src/packlib/hbook/examples/Imakefile
deleted file mode 100644
index 693b5ae..0000000
--- a/src/packlib/hbook/examples/Imakefile
+++ /dev/null
@@ -1,15 +0,0 @@
-SRCS_F= hexam1.F hexam2.F hexam3.F hexam4.F hexam5.F hexam6.F \ @@\
- hexam7.F hexam8.F
-
-SubdirLibraryTarget(hbtlib,NullParameter)
-
-DefinePackageLibrary(hbtlib)
-
-CernlibFortranProgramTarget(hbtest,hexam.o,$(PACKAGE_LIB),$(PACKAGE_LIB),NullParameter)
-
-CernlibFortranProgramTarget(hbdiff,htdiffb.o,$(PACKAGE_LIB),$(PACKAGE_LIB),mathlib)
-
-CernlibFortranProgramTarget(hmerge,hmerg.o hmergin.o,$(PACKAGE_LIB),$(PACKAGE_LIB),mathlib)
-
-TestTarget(hbtest,NullParameter,NullParameter)
-TestTarget(hbdiff,NullParameter,NullParameter)
diff --git a/src/packlib/hbook/examples/hexam.F b/src/packlib/hbook/examples/hexam.F
deleted file mode 100644
index 2d806b6..0000000
--- a/src/packlib/hbook/examples/hexam.F
+++ /dev/null
@@ -1,82 +0,0 @@
-*
-* $Id: hexam.F,v 1.2 1996/06/06 09:52:36 cernlib Exp $
-*
-* $Log: hexam.F,v $
-* Revision 1.2 1996/06/06 09:52:36 cernlib
-* Remove #ifdef (CERNLIB_EXAMPLES) and pilot.h where not used
-*
-* Revision 1.1.1.1 1996/01/16 17:07:49 mclareni
-* First import
-*
-*
-#include "pilot.h"
-*CMZ : 4.17/02 18/12/92 12.44.27 by Unknown
-*-- Author :
- PROGRAM HTEST
-*.==========>
-*. HBOOK GENERAL TEST PROGRAM
-*..=========> ( R.Brun )
- PARAMETER (NWPAW=300000)
- COMMON/PAWC/H(NWPAW)
-*.___________________________________________
-*
-#if (defined(CERNLIB_IBM))&&(!defined(CERNLIB_IBMMVS))
- CALL VMCMS('FILEDEF 31 DISK HEXAM OUT A (RECFM F LRECL 133',IST)
- IF (IST.EQ.0)OPEN(UNIT=31,STATUS='UNKNOWN')
-#endif
-#if defined(CERNLIB_IBMMVS)
-* File is allocated via JCL
-#endif
-#if defined(CERNLIB_UNIX)
- OPEN(UNIT=31,FILE='hexam.out',STATUS='UNKNOWN')
-#endif
-#if defined(CERNLIB_CRAY)
- OPEN(UNIT=31,FILE='hexam.out',STATUS='UNKNOWN')
-#endif
- CALL HLIMIT(NWPAW)
- CALL HOUTPU(31)
-* CALL HPAGSZ(45)
- CALL TIMED(T0)
- CALL HEXAM1
- CALL HDELET(0)
- CALL TIMED(T1)
- WRITE(31,*) 'TIME FOR EXAMPLE 1 =',T1,' SECONDS'
- WRITE( 6,*) 'TIME FOR EXAMPLE 1 =',T1,' SECONDS'
- CALL HEXAM2
- CALL HDELET(0)
- CALL TIMED(T2)
- WRITE(31,*) 'TIME FOR EXAMPLE 2 =',T2,' SECONDS'
- WRITE( 6,*) 'TIME FOR EXAMPLE 2 =',T2,' SECONDS'
- CALL HEXAM3
- CALL HDELET(0)
- CALL TIMED(T3)
- WRITE(31,*) 'TIME FOR EXAMPLE 3 =',T3,' SECONDS'
- WRITE( 6,*) 'TIME FOR EXAMPLE 3 =',T3,' SECONDS'
- CALL HEXAM4
- CALL HDELET(0)
- CALL TIMED(T4)
- WRITE(31,*) 'TIME FOR EXAMPLE 4 =',T4,' SECONDS'
- WRITE( 6,*) 'TIME FOR EXAMPLE 4 =',T4,' SECONDS'
- CALL HEXAM5
- CALL TIMED(T5)
- WRITE(31,*) 'TIME FOR EXAMPLE 5 =',T5,' SECONDS'
- WRITE( 6,*) 'TIME FOR EXAMPLE 5 =',T5,' SECONDS'
- CALL HDELET(0)
- CALL HEXAM6
- CALL TIMED(T6)
- WRITE(31,*) 'TIME FOR EXAMPLE 6 =',T6,' SECONDS'
- WRITE( 6,*) 'TIME FOR EXAMPLE 6 =',T6,' SECONDS'
- CALL HDELET(0)
- CALL HEXAM7
- CALL TIMED(T7)
- WRITE(31,*) 'TIME FOR EXAMPLE 7 =',T7,' SECONDS'
- WRITE( 6,*) 'TIME FOR EXAMPLE 7 =',T7,' SECONDS'
- CALL HDELET(0)
- CALL HEXAM8
- CALL TIMED(T8)
- WRITE(31,*) 'TIME FOR EXAMPLE 8 =',T8,' SECONDS'
- WRITE( 6,*) 'TIME FOR EXAMPLE 8 =',T8,' SECONDS'
- TTOT=T1+T2+T3+T4+T5+T6+T7+T8
- WRITE(31,*) 'TIME FOR HEXAM =',TTOT,' SECONDS'
- WRITE( 6,*) 'TIME FOR HEXAM =',TTOT,' SECONDS'
- END
diff --git a/src/packlib/hbook/examples/hexam1.F b/src/packlib/hbook/examples/hexam1.F
deleted file mode 100644
index 844a1c3..0000000
--- a/src/packlib/hbook/examples/hexam1.F
+++ /dev/null
@@ -1,62 +0,0 @@
-*
-* $Id: hexam1.F,v 1.2 1996/06/06 09:52:38 cernlib Exp $
-*
-* $Log: hexam1.F,v $
-* Revision 1.2 1996/06/06 09:52:38 cernlib
-* Remove #ifdef (CERNLIB_EXAMPLES) and pilot.h where not used
-*
-* Revision 1.1.1.1 1996/01/16 17:07:49 mclareni
-* First import
-*
-*
-*CMZ : 4.10/05 20/06/90 16.17.06 by Rene Brun
-*-- Author :
- SUBROUTINE HEXAM1
-*.==========>
-*. HBOOK BASIC EXAMPLE USING 1-DIM HISTOGRAM,
-*. SCATTER-PLOT AND TABLE.
-*..=========> ( R.Brun )
-* Set global title
-*
- CALL HTITLE('EXAMPLE NO = 1')
-*
-* Book 1-dim, scatter-plot and table
-*
- CALL HBOOK1(10,'EXAMPLE OF 1-DIM HISTOGRAM',100,1.,101.,0.)
- CALL HBOOK2(20,'EXAMPLE OF SCATTER-PLOT',100,0.,1.,40,1.,41.,30.)
- CALL HTABLE(30,'EXAMPLE OF TABLE',15,1.,16.,40,1.,41.,1000.)
-*
-* Fill 1-dim histogram
-*
- DO 10 I=1,100
- W=10*MOD(I,25)
- CALL HFILL(10,FLOAT(I)+0.5,0.,W)
- 10 CONTINUE
-*
-* Fill scatter-plot
-*
- X=-0.005
- DO 30 I=1,100
- X=X+0.01
- DO 20 J=1,40
- Y=J
- IW=MOD(I,25)*MOD(J,10)
- IWMAX=J-MOD(I,25)+10
- IF(IW.GT.IWMAX)IW=0
- CALL HFILL(20,X,Y,FLOAT(IW))
- 20 CONTINUE
- 30 CONTINUE
-*
-* Fill table
-*
- DO 50 I=1,20
- DO 40 J=1,40
- CALL HFILL(30,FLOAT(I)+0.5,FLOAT(J)+0.5,FLOAT(I+J))
- 40 CONTINUE
- 50 CONTINUE
-*
-* Print all histograms with an index
-*
- CALL HISTDO
-*
- END
diff --git a/src/packlib/hbook/examples/hexam2.F b/src/packlib/hbook/examples/hexam2.F
deleted file mode 100644
index f83003d..0000000
--- a/src/packlib/hbook/examples/hexam2.F
+++ /dev/null
@@ -1,115 +0,0 @@
-*
-* $Id: hexam2.F,v 1.2 1996/06/06 09:52:41 cernlib Exp $
-*
-* $Log: hexam2.F,v $
-* Revision 1.2 1996/06/06 09:52:41 cernlib
-* Remove #ifdef (CERNLIB_EXAMPLES) and pilot.h where not used
-*
-* Revision 1.1.1.1 1996/01/16 17:07:49 mclareni
-* First import
-*
-*
-#include "pilot.h"
-*CMZ : 4.10/05 22/11/89 18.48.26 by Rene Brun
-*-- Author :
- SUBROUTINE HEXAM2
-*.==========>
-*. TEST OF SOME BOOKING OPTIONS USING HBOOK RANDOM
-*. NUMBER GENERATORS.
-*..=========> ( R.Brun )
- COMMON/HDEXF/C1,C2,XM1,XM2,XS1,XS2
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION C1,C2,XM1,XM2,XS1,XS2
-#endif
- EXTERNAL HTFUN1,HTFUN2
-*.___________________________________________
-*.
- CALL HTITLE('EXAMPLE NO = 2')
-*
-* Booking
-*
- C1=1.
- C2=0.5
- XM1=0.3
- XM2=0.7
- XS1=0.07
- XS2=0.12
-*
- CALL HBFUN1(100,'TEST OF HRNDM1',100,0.,1.,HTFUN1)
- CALL HIDOPT(100,'STAR')
- CALL HCOPY(100,10,' ')
-*
- CALL HBOOK1(110, 'THIS HISTOGRAM IS FILLED ACCORDING TO THE FUNCT
- +ION HTFUN1'
- + ,100,0.,1.,1000.)
-*
- CALL HBFUN2(200,'TEST OF HRNDM2',100,0.,1.,40,0.,1.,HTFUN2)
- CALL HSCALE(200,0.)
- CALL HCOPY(200,20,' ')
-*
- CALL HBOOK2(210,'HIST FILLED WITH HFILL AND HRNDM2' ,100,0.,1.,
- + 40,0.,1.,30.)
-*
-* Filling
-*
- DO 10 I=1,5000
- X=HRNDM1(100)
- CALL HFILL(110,X,0.,1.)
- CALL HRNDM2(200,X,Y)
- CALL HFILL(210,X,Y,1.)
- 10 CONTINUE
-*
-* Save all histograms on file 'hexam.dat'
-*
- CALL HRPUT(0,'hexam.dat','N')
-*
- CALL HDELET(100)
- CALL HDELET(200)
-*
-* Printing
-*
- CALL HPRINT(0)
- END
-
-
- FUNCTION HTFUN1(X)
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION HDFUN1
-#endif
- HTFUN1=HDFUN1(X)
- END
-
-
- FUNCTION HTFUN2(X,Y)
- HTFUN2=HTFUN1(X)*HTFUN1(Y)
- END
-
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION FUNCTION HDFUN1(X)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION HDFUN1(X)
-#endif
- COMMON/HDEXF/C1,C2,XM1,XM2,XS1,XS2
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION C1,C2,XM1,XM2,XS1,XS2,A1,A2,X1,X2
-#endif
-*
- A1=-0.5*((X-XM1)/XS1)**2
- A2=-0.5*((X-XM2)/XS2)**2
- IF(A1.LT.-20.)THEN
- X1=0.
- ELSEIF(A1.GT.20.)THEN
- X1=1.E5
- ELSE
- X1=C1*EXP(A1)
- ENDIF
- IF(A2.LT.-20.)THEN
- X2=0.
- ELSEIF(A2.GT.20.)THEN
- X2=1.E5
- ELSE
- X2=C2*EXP(A2)
- ENDIF
- HDFUN1=X1+X2
- END
diff --git a/src/packlib/hbook/examples/hexam3.F b/src/packlib/hbook/examples/hexam3.F
deleted file mode 100644
index 47e3db3..0000000
--- a/src/packlib/hbook/examples/hexam3.F
+++ /dev/null
@@ -1,65 +0,0 @@
-*
-* $Id: hexam3.F,v 1.2 1996/06/06 09:52:41 cernlib Exp $
-*
-* $Log: hexam3.F,v $
-* Revision 1.2 1996/06/06 09:52:41 cernlib
-* Remove #ifdef (CERNLIB_EXAMPLES) and pilot.h where not used
-*
-* Revision 1.1.1.1 1996/01/16 17:07:50 mclareni
-* First import
-*
-*
-*CMZ : 4.10/05 22/11/89 18.48.26 by Rene Brun
-*-- Author :
- SUBROUTINE HEXAM3
-*.==========>
-*. MORE BOOKING OPTIONS
-*..=========> ( R.Brun )
-*.
- CALL HTITLE('EXAMPLE NO = 3')
-*
-* Get all histograms saved in example 2
-*
- CALL HROPEN(1,'HEXAM','hexam.dat','U',1024,ISTAT)
- CALL HRIN(0,9999,0)
- CALL HMDIR('HEXAM3','S')
-*
-* Print an index of all histograms that are now in memory
-*
- CALL HINDEX
-*
-* Reset hist 110 and 210. adds more options
-*
- CALL HRESET(110,' ')
- CALL HRESET(210,' ')
- CALL HIDOPT(110,'STAT')
- CALL HBARX(210)
- CALL HBPROX(210,0.)
- CALL HBSLIX(210,3,1000.)
- CALL HBANDY(210,0.1,0.5,0.)
- CALL HIDOPT(0,'1EVL')
-*
-* New filling
-*
- DO 10 I=1,2000
- CALL HFILL(110,HRNDM1(10),0.,1.)
- CALL HRNDM2(20,X,Y)
- CALL HFILL(210,X,Y,1.)
- 10 CONTINUE
-*
-* Print new contents using specialized printing routines
-* Same result could be obtained using HISTDO/HPRINT(0)/HPHS.
-*
- CALL HPHIST(110,'HIST',1)
- CALL HPSCAT(210)
- CALL HPHIST(210,'PROX',1)
- CALL HPHIST(210,'BANY',1)
- CALL HPHIST(210,'SLIX',0)
-*
-* Save all histograms in new directory HEXAM3
-*
- CALL HROUT(0,ICYCLE,' ')
- CALL HREND('HEXAM')
- CLOSE (1)
-*
- END
diff --git a/src/packlib/hbook/examples/hexam4.F b/src/packlib/hbook/examples/hexam4.F
deleted file mode 100644
index a6bb565..0000000
--- a/src/packlib/hbook/examples/hexam4.F
+++ /dev/null
@@ -1,74 +0,0 @@
-*
-* $Id: hexam4.F,v 1.2 1996/06/06 09:52:42 cernlib Exp $
-*
-* $Log: hexam4.F,v $
-* Revision 1.2 1996/06/06 09:52:42 cernlib
-* Remove #ifdef (CERNLIB_EXAMPLES) and pilot.h where not used
-*
-* Revision 1.1.1.1 1996/01/16 17:07:50 mclareni
-* First import
-*
-*
-*CMZ : 4.10/05 22/11/89 18.48.27 by Rene Brun
-*-- Author :
- SUBROUTINE HEXAM4
-*.==========>
-*. TEST PRINTING OPTIONS
-*..=========> ( R.Brun )
- DATA XMIN,XMAX/0.,1./
-*.___________________________________________
-*.
- CALL HTITLE('EXAMPLE NO = 4')
-*
-* Get hist 110 from data base
-*
- CALL HRGET(110,'hexam.dat',' ')
-*
-* Book 2 new histograms
-*
- CALL HBOOK1(1000,'TEST OF PRINTING OPTIONS',40,1.,41.,0.)
- CALL HBOOK1(2000,'TEST OF BIG BIN',20,XMIN,XMAX,0.)
- CALL HIDOPT(1000,'ERRO')
-*
-* Fills new IDs
-*
- DO 10 I=1,40
- J=2*I-1
- W=HI(110,J)+HI(110,J+1)
- CALL HFILL(1000,FLOAT(I),0.,W)
- 10 CONTINUE
-*
- DO 20 I=1,20
- J=5*I
- W=SQRT(HI(110,J))
- CALL HIX(2000,I,X)
- CALL HF1(2000,X,W)
- 20 CONTINUE
-*
-* Set various printing options
-*
- CALL HIDOPT(110,'BLAC')
- CALL HIDOPT(110,'NPLO')
- CALL HIDOPT(110,'NPST')
- CALL HPHIST(110,'HIST',1)
- CALL HMAXIM(110,100.)
- CALL HIDOPT(110,'1EVL')
- CALL HIDOPT(110,'NPCH')
- CALL HPHIST(110,'HIST',1)
-*
- CALL HIDOPT(1000,'NPCH')
- CALL HIDOPT(1000,'NPCO')
- CALL HPROT(1000,'HIST',1)
- CALL HIDOPT(1000,'LOGY')
- CALL HPRINT(1000)
- CALL HIDOPT(1000,'INTE')
- CALL HIDOPT(1000,'PERR')
- CALL HIDOPT(1000,'ROTA')
- CALL HPRINT(1000)
-*
- CALL HBIGBI(2000,5)
- CALL HIDOPT(2000,'NPCO')
- CALL HIDOPT(2000,'NPLO')
- CALL HPRINT(2000)
-*
- END
diff --git a/src/packlib/hbook/examples/hexam5.F b/src/packlib/hbook/examples/hexam5.F
deleted file mode 100644
index 7f828e0..0000000
--- a/src/packlib/hbook/examples/hexam5.F
+++ /dev/null
@@ -1,186 +0,0 @@
-*
-* $Id: hexam5.F,v 1.2 1996/06/06 09:52:43 cernlib Exp $
-*
-* $Log: hexam5.F,v $
-* Revision 1.2 1996/06/06 09:52:43 cernlib
-* Remove #ifdef (CERNLIB_EXAMPLES) and pilot.h where not used
-*
-* Revision 1.1.1.1 1996/01/16 17:07:50 mclareni
-* First import
-*
-*
-#include "pilot.h"
-*CMZ : 4.10/05 22/11/89 18.48.27 by Rene Brun
-*-- Author :
- SUBROUTINE HEXAM5
-*.==========>
-*. OPERATIONS ON HISTOGRAMS AND FITTING
-*..=========> ( R.Brun )
- COMMON/HDEXF/C1,C2,XM1,XM2,XS1,XS2
- COMMON /HEXF/A,B,C,D
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION C1,C2,XM1,XM2,XS1,XS2,HDFUN,HDFUN1
-#endif
- DIMENSION X(100),Y(100)
- DIMENSION XF(4000,2),YF(4000),EY(4000),SIGPAR(6),COV(21),ST(6),
- +PMI(6),PMA(6)
- EXTERNAL HDFUN,HDFUN1,HFUNGA
- CHARACTER*12 TITL1
- DATA TITL1/'TITLE OF ID1'/
-*.___________________________________________
-*.
- CALL HTITLE('EXAMPLE NO = 5')
-*
-* GET hist 110 from data base
-*
- CALL HRGET(110,'hexam.dat',' ')
- CALL HRGET(210,'hexam.dat',' ')
-*
-*
- CALL HBOOK1(1,TITL1,100,0.,1.,0.)
- CALL HCOPY(1,2,'TITLE OF ID = 2')
-*
-* Gets information from ID=110 and fills new IDs 1,2
-*
- CALL HUNPAK(110,X,'HIST',1)
- CALL UCOPY(X,Y,100)
- CALL VZERO(X(51),50)
- CALL HPAK(1,X)
- CALL HPHIST(1,'HIST',1)
- CALL VZERO(Y,50)
- CALL HPAK(2,Y)
- CALL HPHIST(2,'HIST',1)
-*
-* adds 1 and 2. Identifier 3 is created and will contain
-* result of addition
-*
- CALL HOPERA(1,'+',2,3,1.,1.)
- CALL HCOPY(3,4,' ')
-*
-* Fits 3 with the function HTFUN1 defined in example 2 .
-* Initializes parameters. Prints results of the last
-* iteration.
-* Superimpose result of fit to the histogram
-* The result of this fit can be compared with the initial
-* parameters of example 2
-*
- C1=40.
- C2=20.
- XM1=0.4
- XM2=0.6
- XS1=0.1
- XS2=0.1
-*
- CALL HFITS(3,HDFUN1,6,C1,CHI2,12,SIGPAR)
-*
- CALL HPHIST(3,'HIST',1)
-*
-*
-* Fits a two-dimensional distribution (xf,yf) with HFITN
-* initialize parameters. Prints results of the last
-* iteration.
-* Errors EY automatically computed as SQRT(yf)
-*
- NY=0
- DO 10 J=1,40
- DO 5 I=1,100
- CONT=HIJ (210,I,J)
- IF (CONT.EQ.0.) GOTO 5
- NY=NY+1
- YF(NY)=CONT
- EY(NY)=SQRT(CONT)
- CALL HIJXY (210,I,J,X1,X2)
- XF(NY,1)=X1+0.005
- XF(NY,2)=X2+0.0125
- 5 CONTINUE
- 10 CONTINUE
- C1=3.
- C2=1.
- XM1=0.3
- XM2=0.7
- XS1=0.07
- XS2=0.12
- DO 15 I=1,6
- ST(I)=-1.
- 15 CONTINUE
-*
- CALL HFITN (XF,YF,EY,NY,4000,2,HDFUN,6,C1,CHI2,11,SIGPAR,COV,
- +ST,PMI,PMA)
- WRITE(31,*) ' COVARIANCE MATRIX'
- WRITE(31,*) ' *****************'
- I2=0
- DO 20 K=1,6
- I1=I2+1
- I2=I1+K-1
- WRITE(31,*) (COV(I),I=I1,I2)
- 20 CONTINUE
-*
-*
-* Gaussian fitting. Prints first and last iterations.
-*
- CALL HDELET (0)
- A=2.
- B=0.4
- C=0.1
- CALL HBFUN1 (1,' ',100,0.,1.,HFUNGA)
- CALL HBOOK1 (5,' ',100,0.,1.,1000.)
- DO 30 I=1,5000
- XR=HRNDM1 (1)
- CALL HFILL (5,XR,0.,1.)
- 30 CONTINUE
-*
- CALL HFITGA (5,A,B,C,CHI2,12,SIGPAR)
- CALL HPRINT (5)
- CALL HDELET (0)
-*
- END
-*
-*
-#if !defined(CERNLIB_DOUBLE)
- FUNCTION HDFUN (X)
-#endif
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION FUNCTION HDFUN (X)
- DOUBLE PRECISION PAR,DER,DER1,HDFUN1,F1,F2
-#endif
- DIMENSION DER(6),DER1(6),X(2)
- COMMON/HDEXF/PAR(6)
-*
-* Compute value of the function at point X
-*
- F1=HDFUN1(X(1))
- F2=HDFUN1(X(2))
- HDFUN=F1+F2
-*
-* Compute derivatives
-*
-* CALL HDERU1 (X(1),PAR,DER)
-* CALL HDERU1 (X(2),PAR,DER1)
-* DO 10 K=1,6
-* DER(K)=DER(K)+DER1(K)
-* 10 CONTINUE
-*
-* CALL HDERIV(DER)
-*
- END
-*
-*
-*
- SUBROUTINE HDERU1 (X,PAR,DER)
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION PAR,DER
-#endif
- DIMENSION PAR(6),DER(6)
- DER(1)=EXP(-0.5*((X-PAR(3))/PAR(5))**2)
- DER(2)=EXP(-0.5*((X-PAR(4))/PAR(6))**2)
- DER(3)=PAR(1)*(X-PAR(3))/PAR(5)**2*DER(1)
- DER(4)=PAR(2)*(X-PAR(4))/PAR(6)**2*DER(2)
- DER(5)=DER(3)*(X-PAR(3))/PAR(5)
- DER(6)=DER(4)*(X-PAR(4))/PAR(6)
- END
-*
-*
- FUNCTION HFUNGA (X)
- COMMON /HEXF/ A,B,C,D
- HFUNGA=A*EXP(-0.5*((X-B)/C)**2)
- END
diff --git a/src/packlib/hbook/examples/hexam6.F b/src/packlib/hbook/examples/hexam6.F
deleted file mode 100644
index cebb9a7..0000000
--- a/src/packlib/hbook/examples/hexam6.F
+++ /dev/null
@@ -1,83 +0,0 @@
-*
-* $Id: hexam6.F,v 1.2 1996/06/06 09:52:44 cernlib Exp $
-*
-* $Log: hexam6.F,v $
-* Revision 1.2 1996/06/06 09:52:44 cernlib
-* Remove #ifdef (CERNLIB_EXAMPLES) and pilot.h where not used
-*
-* Revision 1.1.1.1 1996/01/16 17:07:50 mclareni
-* First import
-*
-*
-#include "pilot.h"
-*CMZ : 4.17/02 21/12/92 08.21.10 by John Allison
-*-- Author :
- SUBROUTINE HEXAM6
-*.==========>
-*. PARAMETRIZATION - SMOOTHING
-*..=========> ( R.Brun )
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION COEFF
-#endif
- DIMENSION ITERM(15),COEFF(15)
-*.___________________________________________
-*
- CALL HTITLE('EXAMPLE NO = 6')
-*
-* Get hist 110 from data base
-*
- CALL HRGET(110,'hexam.dat',' ')
-*
-*
-* Find best parametrization of histogram in terms of powers
-* of shifted Tchebychev polynomials
-* also produces the corresponding fortran function (here on
-* standard output)
-*
-*
- CALL HCOPY(110,1,' ')
- CALL HSETPR('PNBX',15.)
- CALL HSETPR('PNCX',15.)
- CALL HSETPR('PLUN',31.)
- CALL HPARAM(1,3011,1.,14,COEFF,ITERM,NCO)
- CALL HPRINT(1)
-*
-*
-* ID=2 is smoothed with B-splines
-* statistical errors (sqrt of contents) are drawn
-*
-*
- CALL HCOPY(110,2,' ')
- CALL HSPLI1(2,2,14,3,CHI2)
- CALL HIDOPT(2,'ERRO')
- CALL HPHIST(2,'HIST',1)
-*
-*
-* ID=3 is smoothed with multiquadrics
-* statistical errors (sqrt of contents) are drawn
-*
-*
- CALL HCOPY(110,3,' ')
- CALL HQUAD(3,'V',0,0.,0.,NPAR,CHI2,NDF,FMIN,FMAX,IERR)
- LOUT=31
- IF(IERR.NE.0)THEN
- WRITE (LOUT, 10000) IERR
- ELSE
- WRITE (LOUT, 10100) NPAR, CHI2, NDF
- WRITE (LOUT, 10200) FMIN, FMAX
- CALL HIDOPT(3,'ERRO')
- CALL HPHIST(3,'HIST',1)
- END IF
-*
-*
-* Turn off writing of parameter function.
-*
-*
- CALL HSETPR('PLUN',0.)
-*
-*
-10000 FORMAT (1X, 'Error', I5, ' in multiquadric smoothing.')
-10100 FORMAT (1X, 'Multiquadric smoothing with', I4, ' parameters.'/
- +3X, 'Chi-squared', G12.5, ' for', I7, ' degrees of freedom.')
-10200 FORMAT (3X, 'Min/max event density:', 2G12.5)
- END
diff --git a/src/packlib/hbook/examples/hexam7.F b/src/packlib/hbook/examples/hexam7.F
deleted file mode 100644
index 41ec8e2..0000000
--- a/src/packlib/hbook/examples/hexam7.F
+++ /dev/null
@@ -1,56 +0,0 @@
-*
-* $Id: hexam7.F,v 1.2 1996/06/06 09:52:45 cernlib Exp $
-*
-* $Log: hexam7.F,v $
-* Revision 1.2 1996/06/06 09:52:45 cernlib
-* Remove #ifdef (CERNLIB_EXAMPLES) and pilot.h where not used
-*
-* Revision 1.1.1.1 1996/01/16 17:07:50 mclareni
-* First import
-*
-*
-#include "pilot.h"
-*CMZ : 4.10/05 22/11/89 18.48.27 by Rene Brun
-*-- Author :
- SUBROUTINE HEXAM7
-*.==========>
-*. Example of N-tuples.
-*..=========> ( R.Brun )
- DIMENSION X(3)
- CHARACTER*8 CHTAGS(3)
- DATA CHTAGS/' X ',' Y ',' Z '/
-*.___________________________________________
-*.
- CALL HTITLE('EXAMPLE NO = 7')
-*
-* Reopen data base
-*
- CALL HROPEN(1,'HEXAM7','hexam.dat','U',1024,ISTAT)
- CALL HMDIR('NTUPLES','S')
-*
- CALL HBOOK1(10,'TEST1',100,-3.,3.,0.)
- CALL HBOOK2(20,'TEST2',20,-3.,3.,20,-3.,3.,250.)
- CALL HBOOKN(30,'N-TUPLE',3,'//HEXAM7/NTUPLES',1000,CHTAGS)
-*
- DO 10 I=1,10000
- CALL RANNOR(A,B)
- X(1)=A
- X(2)=B
- X(3)=A*A+B*B
- CALL HFN(30,X)
- 10 CONTINUE
-*
- CALL HROUT(30,ICYCLE,' ')
- CALL HPROJ1(10,30,0,0,1,999999,1)
- CALL HPROJ2(20,30,0,0,1,999999,1,2)
- CALL HPRINT(0)
-*
- CALL HROUT(10,ICYCLE,' ')
- CALL HROUT(20,ICYCLE,' ')
-*
- CALL HLDIR(' ',' ')
-*
- CALL HREND('HEXAM7')
- CLOSE (1)
-*
- END
diff --git a/src/packlib/hbook/examples/hexam8.F b/src/packlib/hbook/examples/hexam8.F
deleted file mode 100644
index 45d8b9a..0000000
--- a/src/packlib/hbook/examples/hexam8.F
+++ /dev/null
@@ -1,63 +0,0 @@
-*
-* $Id: hexam8.F,v 1.2 1996/06/06 09:52:46 cernlib Exp $
-*
-* $Log: hexam8.F,v $
-* Revision 1.2 1996/06/06 09:52:46 cernlib
-* Remove #ifdef (CERNLIB_EXAMPLES) and pilot.h where not used
-*
-* Revision 1.1.1.1 1996/01/16 17:07:50 mclareni
-* First import
-*
-*
-*CMZ : 4.17/02 18/12/92 12.39.38 by Unknown
-*-- Author : John Allison 17/12/92
- SUBROUTINE HEXAM8
-* Example of multiquadric smoothing, including a "simple" ntuple.
- DIMENSION X(3)
- CHARACTER*8 CHTAGS(3)
- DATA CHTAGS/' X ',' Y ',' Z '/
- DATA LOUT/31/
-*
- CALL HBOOK1(10,'TEST1',100,-3.,3.,0.)
- CALL HBOOK2(20,'TEST2',20,-3.,3.,20,-3.,3.,250.)
- CALL HBOOKN(30,'N-TUPLE',3,' ',1000,CHTAGS)
-*
- DO 10 I=1,1000
- CALL RANNOR(A,B)
- X(1)=A
- X(2)=B
- X(3)=A*A+B*B
- CALL HFN(30,X)
- 10 CONTINUE
-*
- CALL HPROJ1(10,30,0,0,1,999999,1)
- CALL HQUAD(10,'V',0,0.,0.,NPAR,CHI2,NDF,FMIN,FMAX,IERR)
- IF(IERR.NE.0)THEN
- WRITE (LOUT, 10000) IERR
- ELSE
- WRITE (LOUT, 10100) NPAR, CHI2, NDF
- WRITE (LOUT, 10200) FMIN, FMAX
- END IF
- CALL HPROJ2(20,30,0,0,1,999999,1,2)
- CALL HQUAD(20,'V',0,0.,0.,NPAR,CHI2,NDF,FMIN,FMAX,IERR)
- IF(IERR.NE.0)THEN
- WRITE (LOUT, 10000) IERR
- ELSE
- WRITE (LOUT, 10100) NPAR, CHI2, NDF
- WRITE (LOUT, 10200) FMIN, FMAX
- END IF
- IERR=0
-** CALL HQUAD(30,'V',0,0.,0.,NPAR,CHI2,NDF,FMIN,FMAX,IERR)
-** IF(IERR.NE.0)THEN
-** WRITE (LOUT, 10000) IERR
-** ELSE
-** WRITE (LOUT, 10100) NPAR, CHI2, NDF
-** WRITE (LOUT, 10200) FMIN, FMAX
-** END IF
-*
-10000 FORMAT (1X, 'Error', I5, ' in multiquadric smoothing.')
-10100 FORMAT (1X, 'Multiquadric smoothing with', I4, ' parameters.'/
- +3X, 'Chi-squared', G12.5, ' for', I7, ' degrees of freedom.')
-10200 FORMAT (3X, 'Min/max event density:', 2G12.5)
-*
- END
diff --git a/src/packlib/hbook/examples/hmerg.F b/src/packlib/hbook/examples/hmerg.F
deleted file mode 100644
index 246d09a..0000000
--- a/src/packlib/hbook/examples/hmerg.F
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: hmerg.F,v 1.2 1996/06/06 09:52:46 cernlib Exp $
-*
-* $Log: hmerg.F,v $
-* Revision 1.2 1996/06/06 09:52:46 cernlib
-* Remove #ifdef (CERNLIB_EXAMPLES) and pilot.h where not used
-*
-* Revision 1.1 1996/02/20 15:46:22 cernlib
-* Correct Imakefiles
-*
-* Revision 1.1.1.1 1996/01/16 17:08:10 mclareni
-* First import
-*
-*
-*CMZ : 4.22/07 28/06/94 16.52.36 by Rene Brun
-*-- Author : Rene Brun, J.C. Marin and Fons Rademakers 26/05/94
- PROGRAM HMERG
-*.==========>
-*.
-*. This program can be used to merge HBOOK files with identical objects
-*. and directories.
-*.
-*..=========> (Rene Brun, J.C. Marin, A.A.Rademakers )
-*
- INTEGER MXBOOK
- PARAMETER (MXBOOK=1000000)
- REAL PAW
- COMMON/PAWC/ PAW(MXBOOK)
-*
- CALL HLIMIT(MXBOOK)
-*
- CALL HMERGIN
-*
- END
diff --git a/src/packlib/hbook/examples/hmergin.F b/src/packlib/hbook/examples/hmergin.F
deleted file mode 100644
index 4f8b632..0000000
--- a/src/packlib/hbook/examples/hmergin.F
+++ /dev/null
@@ -1,62 +0,0 @@
-*
-* $Id: hmergin.F,v 1.2 1996/06/06 09:52:47 cernlib Exp $
-*
-* $Log: hmergin.F,v $
-* Revision 1.2 1996/06/06 09:52:47 cernlib
-* Remove #ifdef (CERNLIB_EXAMPLES) and pilot.h where not used
-*
-* Revision 1.1 1996/02/20 15:46:23 cernlib
-* Correct Imakefiles
-*
-* Revision 1.1.1.1 1996/01/16 17:08:10 mclareni
-* First import
-*
-*
-*CMZ : 4.22/11 23/08/94 14.21.16 by Rene Brun
-*-- Author : Rene Brun, J.C. Marin and Fons Rademakers 26/05/94
- SUBROUTINE HMERGIN
-*.==========>
-*.
-*. Main subroutine to merge HBOOK files with identical objects
-*. and directories.
-*.
-*..=========> (Rene Brun, J.C. Marin, A.A.Rademakers )
-*
- INTEGER MXFILES
- PARAMETER (MXFILES=99)
- INTEGER NFILES
- CHARACTER*80 FILES
- COMMON /FILES/ NFILES, FILES(MXFILES)
-*
- CHARACTER*80 FILOUT
-*____________________________________________________________________
-*
-* Get output file name
-*
- FILOUT = ' '
- WRITE(6,1000)
- 1000 FORMAT(' Give output file name ===>')
- READ(5,'(A)') FILOUT
- IF (LENOCC(FILOUT) .LE. 0) THEN
- WRITE(6,'('' No OUTPUT file. Job aborted'')')
- GOTO 99
- ENDIF
-*
-* Get all input file names
-*
- NFILES = 0
- 5 WRITE(6,2000)
- 2000 FORMAT(' Give input file name or terminate with a blank ==>')
- FILES(NFILES+1) = ' '
- READ(5,'(A)') FILES(NFILES+1)
- NCH = LENOCC(FILES(NFILES+1))
- IF (NCH .GT. 0) THEN
- NFILES = NFILES + 1
- IF(NFILES.LT.MXFILES)GOTO 5
- ENDIF
-*
-* call the main merger
-*
- CALL HMERGE(NFILES,FILES,FILOUT)
-*
- 99 END
diff --git a/src/packlib/hbook/examples/htdiffb.F b/src/packlib/hbook/examples/htdiffb.F
deleted file mode 100644
index b2f3bdd..0000000
--- a/src/packlib/hbook/examples/htdiffb.F
+++ /dev/null
@@ -1,114 +0,0 @@
-*
-* $Id: htdiffb.F,v 1.4 2002/06/25 15:14:03 couet Exp $
-*
-* $Log: htdiffb.F,v $
-* Revision 1.4 2002/06/25 15:14:03 couet
-* - Protection added in case the arrays index X goes outside the arrays limits
-*
-* Revision 1.3 1997/12/03 12:47:17 couet
-* - The initialisation of the vector FLLARY was missing
-*
-* Revision 1.2 1996/06/06 09:52:48 cernlib
-* Remove #ifdef (CERNLIB_EXAMPLES) and pilot.h where not used
-*
-* Revision 1.1.1.1 1996/01/16 17:07:50 mclareni
-* First import
-*
-*
-*CMZ : 4.17/02 18/12/92 12.28.50 by Rene Brun
-*-- Author :
- PROGRAM HTDIFFB
-C----------------------------------------------------------------------
-C-
-C- Purpose and Methods : DEMONSTRATE C AND S OPTIONS OF HDIFFB
-C-
-C-
-C- Inputs : none
-C- Outputs : 6 histograms, the 4 used in the 3 example calls, and
-C- the 3 DIFFS arrays packed into histograms.
-C- Controls: none
-C-
-C- Created 26-OCT-1992 R J Genik II
-C-
-C----------------------------------------------------------------------
- INTEGER NWPAWC,X,NBAD,Q,MINBIN,MAXBIN,NBINS,MU
- REAL TOL,H,DIFFS,FLLARY,AMU,ID,RN32,Z
- PARAMETER (NWPAWC = 100000)
- PARAMETER (MU = 100)
- PARAMETER (TOL = 0.05)
- PARAMETER (NBINS = 100)
- PARAMETER (MINBIN = 1)
- PARAMETER (MAXBIN = 100)
- COMMON/PAWC/H(NWPAWC)
- DIMENSION DIFFS(MINBIN:MAXBIN),FLLARY(MINBIN:MAXBIN)
-C- Initialise HBOOK
- AMU = REAL(MU)
- CALL HLIMIT(NWPAWC)
-C- Create the histograms
- CALL HBOOK1(10,'DATA HISTOGRAM 1',NBINS,REAL(MINBIN),
- + REAL(MAXBIN+1),0.)
- CALL HBOOK1(20,'DATA HISTOGRAM 2',NBINS,REAL(MINBIN),
- + REAL(MAXBIN+1),0.)
- CALL HBOOK1(30,'REFERENCE HISTOGRAM',NBINS,REAL(MINBIN),
- + REAL(MAXBIN+1),0.)
- CALL HBOOK1(40,'LINEARLY INCREASING HISTOGRAM',NBINS,REAL(MINBIN),
- + REAL(MAXBIN+1),0.)
- CALL HBOOK1(100,'DIFFS VALUES FOR S OPTION ID1=10, ID2=20',NBINS
- + ,REAL(MINBIN), REAL(MAXBIN+1),0.)
- CALL HBOOK1(200,'DIFFS VALUES FOR C OPTION ID1=30, ID2=20',NBINS
- + ,REAL(MINBIN), REAL(MAXBIN+1),0.)
- CALL HBOOK1(300,'DIFFS VALUES FOR C OPTION ID1=30, ID2=40',NBINS
- + ,REAL(MINBIN),REAL(MAXBIN+1),0.)
-C- Initialise the vector FLLARY
- DO 10 I=MINBIN,MAXBIN
- FLLARY(I) = 0.
- 10 CONTINUE
-C- Create two pseudo uniform random distributions to compare
- DO 30 Q=1,MU*(MAXBIN-MINBIN+1)
- X = RN32(ID)*(MAXBIN-MINBIN+1)
- X = MAX(X,MINBIN)
- X = MIN(X,MAXBIN)
- FLLARY(X) = FLLARY(X) + 1.
- 30 CONTINUE
- CALL HPAK(10,FLLARY)
- DO 35 Q=MINBIN,MAXBIN
- FLLARY(Q) = 0.
- 35 CONTINUE
- DO 40 Q=1,MU*(MAXBIN-MINBIN+1)
- X = RN32(ID)*(MAXBIN-MINBIN+1)
- X = MAX(X,MINBIN)
- X = MIN(X,MAXBIN)
- FLLARY(X) = FLLARY(X) + 1.
- 40 CONTINUE
- CALL HPAK(20,FLLARY)
-C- Create 2 more histograms, one with x=mu, other linearly increasing
- DO 50 Q=MINBIN,MAXBIN
- FLLARY(Q) = AMU
- 50 CONTINUE
- CALL HPAK(30,FLLARY)
- Z = 50.
- DO 60 Q = MINBIN,MAXBIN
- FLLARY(Q) = Z
- Z = Z + 1.
- 60 CONTINUE
- CALL HPAK(40,FLLARY)
-C- HDIFFB calling sequence
- CALL HDIFFB(10,20,TOL,NBINS,'S',NBAD,DIFFS)
- CALL HPAK(100,DIFFS)
- CALL HDIFFB(30,20,TOL,NBINS,'C',NBAD,DIFFS)
- CALL HPAK(200,DIFFS)
- CALL HDIFFB(30,40,TOL,NBINS,'CN',NBAD,DIFFS)
- CALL HPAK(300,DIFFS)
-C- Print results, use various options for clarity
- CALL HIDOPT(0,'NPST')
- CALL HIDOPT(0,'NPLO')
- CALL HIDOPT(30,'1EVL')
- CALL HPRINT(10)
- CALL HPRINT(20)
- CALL HPRINT(100)
- CALL HPRINT(30)
- CALL HPRINT(200)
- CALL HPRINT(40)
- CALL HPRINT(300)
- STOP
- END
diff --git a/src/packlib/hbook/examples/pilot.h b/src/packlib/hbook/examples/pilot.h
deleted file mode 100644
index 70ed02f..0000000
--- a/src/packlib/hbook/examples/pilot.h
+++ /dev/null
@@ -1,18 +0,0 @@
-#ifndef CERNLIB_EXAMPLES
-#define CERNLIB_EXAMPLES
-#endif
-#if defined(CERNLIB_IBM)||defined(CERNLIB_VAX)||defined(CERNLIB_NORD)||defined(CERNLIB_UNIVAC)
-#ifndef CERNLIB_DOUBLE
-#define CERNLIB_DOUBLE
-#endif
-#endif
-#if (defined(CERNLIB_UNIX))&&(!defined(CERNLIB_SINGLE))
-#ifndef CERNLIB_DOUBLE
-#define CERNLIB_DOUBLE
-#endif
-#endif
-#if defined(CERNLIB_UNIX)||(defined(CERNLIB_WINNT) && !defined(CERNLIB_QFMSOFT))
-#ifndef CERNLIB_BSLASH
-#define CERNLIB_BSLASH
-#endif
-#endif
diff --git a/src/packlib/hbook/fpclassc/Imakefile b/src/packlib/hbook/fpclassc/Imakefile
deleted file mode 100644
index 9d71f7f..0000000
--- a/src/packlib/hbook/fpclassc/Imakefile
+++ /dev/null
@@ -1,3 +0,0 @@
-SRCS_C= ifp.c ifpdcl.c ifpscl.c
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/hbook/fpclassc/ifp.c b/src/packlib/hbook/fpclassc/ifp.c
deleted file mode 100644
index fcae3ff..0000000
--- a/src/packlib/hbook/fpclassc/ifp.c
+++ /dev/null
@@ -1,111 +0,0 @@
-/*
- * $Id: ifp.c,v 1.4 1998/09/25 09:27:10 mclareni Exp $
- *
- * $Log: ifp.c,v $
- * Revision 1.4 1998/09/25 09:27:10 mclareni
- * Modifications for the Mklinux port flagged by CERNLIB_PPC
- *
- * Revision 1.3 1997/03/14 17:05:25 mclareni
- * WNT mods
- *
- * Revision 1.2 1996/09/20 14:27:07 cernlib
- * add Linux
- *
- * Revision 1.1.1.1 1996/01/16 17:08:12 mclareni
- * First import
- *
- */
-#include "hbook/pilot.h"
-/*CMZ : 26/06/95 14.06.04 by Julian Bunn*/
-/*-- Author : Francois Dardare 15/03/95*/
-#if ( defined(CERNLIB_SUN)||defined(CERNLIB_SOLARIS)||defined(CERNLIB_SGI)\
- ||defined(CERNLIB_DECS)||defined(CERNLIB_ALPHA)||defined(CERNLIB_HPUX)\
- ||defined(CERNLIB_IBMRT)||defined(CERNLIB_LINUX))\
- &&(!defined(CERNLIB_VAX))
-#define ifps ifps_
-#define ifpd ifpd_
-#endif
-#if defined(CERNLIB_QXCAPT)
-#define ifps type_of_call IFPS
-#define ifpd type_of_call IFPD
-#endif
-#if defined(CERNLIB_CRAY)
-#define ifps IFPS
-#define ifpd IFPD
-#endif
-#if defined(CERNLIB_IBM)
-#pragma linkage (ifps ,FORTRAN)
-#pragma linkage (ifpd ,FORTRAN)
-#endif
-
-/****************************/
-/*test if the float is finit*/
-/****************************/
-
-typedef union {
- float flt;
- unsigned uint;
-} float_rep;
-
-int ifps(x)
-float_rep *x;
-{
-#if ( defined(CERNLIB_SUN)||defined(CERNLIB_SOLARIS)||defined(CERNLIB_SGI)\
- ||defined(CERNLIB_DECS)||defined(CERNLIB_ALPHA)||defined(CERNLIB_HPUX)\
- ||defined(CERNLIB_IBMRT)||defined(CERNLIB_LINUX))\
- &&(!defined(CERNLIB_VAX))
-/*test the exponent part of the float*/
-if ((x->uint & 0x7f800000)==0x7f800000)
-return 0;
-else
-return 1;
-#endif
-#if (!defined(CERNLIB_SUN))&&(!defined(CERNLIB_SOLARIS))\
- &&(!defined(CERNLIB_SGI))&&(!defined(CERNLIB_DECS))\
- &&(!defined(CERNLIB_ALPHA))&&(!defined(CERNLIB_HPUX))\
- &&(!defined(CERNLIB_IBMRT))&&(!defined(CERNLIB_LINUX))
-return 1;
-#endif
-#if (defined(CERNLIB_VAX))&&(defined(CERNLIB_ALPHA))
-return 1;
-#endif
-}
-
-/*****************************/
-/*test if the double is finit*/
-/*****************************/
-
-/* +SELF,IF=SUN,SOLARIS,SGI,DECS,ALPHA,HPUX,IBMRT. */
-typedef union {
- double dbl;
- unsigned uint[2];
-} double_rep;
-/* +SELF. */
-
-int ifpd(x)
-double_rep *x;
-{
-/*test the exponent part of the double*/
-#if defined(CERNLIB_SUN)||defined(CERNLIB_SOLARIS)||defined(CERNLIB_SGI)||defined(CERNLIB_HPUX)||defined(CERNLIB_IBMRT)||defined(CERNLIB_PPC)
-if ((x->uint[0] & 0x7ff00000)==0x7ff00000)
-return 0;
-else
-return 1;
-#endif
-#if (defined(CERNLIB_DECS)||defined(CERNLIB_ALPHA))&&(!defined(CERNLIB_VAX)) \
- || (defined(CERNLIB_LINUX) && !defined(CERNLIB_PPC))
-if ((x->uint[1] & 0x7ff00000)==0x7ff00000)
-return 0;
-else
-return 1;
-#endif
-#if (!defined(CERNLIB_SUN))&&(!defined(CERNLIB_SOLARIS))\
- &&(!defined(CERNLIB_SGI))&&(!defined(CERNLIB_DECS))\
- &&(!defined(CERNLIB_ALPHA))&&(!defined(CERNLIB_HPUX))\
- &&(!defined(CERNLIB_IBMRT))&&(!defined(CERNLIB_LINUX))
-return 1;
-#endif
-#if (defined(CERNLIB_VAX))&&(defined(CERNLIB_ALPHA))
-return 1;
-#endif
-}
diff --git a/src/packlib/hbook/fpclassc/ifpdcl.c b/src/packlib/hbook/fpclassc/ifpdcl.c
deleted file mode 100644
index c384ffc..0000000
--- a/src/packlib/hbook/fpclassc/ifpdcl.c
+++ /dev/null
@@ -1,259 +0,0 @@
-/*
- * $Id: ifpdcl.c,v 1.4 1997/09/02 13:09:05 mclareni Exp $
- *
- * $Log: ifpdcl.c,v $
- * Revision 1.4 1997/09/02 13:09:05 mclareni
- * WINNT correction
- *
- * Revision 1.3 1997/03/14 17:05:25 mclareni
- * WNT mods
- *
- * Revision 1.2.2.1 1997/01/21 11:28:26 mclareni
- * All mods for Winnt 96a on winnt branch
- *
- * Revision 1.2 1996/02/20 16:48:58 cernlib
- * Clean up the code; use elif/else instead of the patchy syntax.
- *
- * Revision 1.1.1.1 1996/01/16 17:08:12 mclareni
- * First import
- *
- */
-#include "hbook/pilot.h"
-/*CMZ : 17/05/95 17.23.35 by Julian Bunn*/
-/*-- Author : Francois Dardare 06/03/95*/
-/******************************************************************************
- * *
- * NAME: *
- * *
- * ifpdcl() - double-point operand classification FORTRAN *
- * callable function *
- * *
- * SYNOPSIS: *
- * *
- * I = IFPDCL(X) *
- * *
- * DESCRIPTION: *
- * *
- * ifpdcl() returns a non-negative integer value that specifies *
- * the IEEE operand class to which the argument x belongs. The *
- * value returned are defined as follow: *
- * *
- * 0 = Positive normalized *
- * 1 = Negative normalized *
- * 2 = Positive zero *
- * 3 = Negative zero *
- * 4 = Positive infinity *
- * 5 = Negative infinity *
- * 6 = Positive denormalized *
- * 7 = Negative denormalized *
- * 8 = Signalling NaN *
- * 9 = Quiet NaN *
- * *
- ******************************************************************************/
-
-#if defined(CERNLIB_DECS) || defined(CERNLIB_SGI) || defined(CERNLIB_ALPHA_OSF)
-#include <fp_class.h>
-#elif defined(CERNLIB_HPUX)
-#include <math.h>
-#elif defined(CERNLIB_IBMRT)
-#include <math.h>
-#include <float.h>
-#elif (defined(CERNLIB_SUN))&&(!defined(CERNLIB_SOLARIS))
-#include <floatingpoint.h>
-#elif defined(CERNLIB_SOLARIS)
-#include <ieeefp.h>
-#endif
-
-#if defined(CERNLIB_UNIX) && ! defined(CERNLIB_APOLLO) && !defined(CERNLIB_MSSTDCALL) && !defined(CERNLIB_QFDEC)
-# define ifpdcl ifpdcl_
-#elif defined(CERNLIB_QXCAPT)
-# define ifpdcl type_of_call IFPDCL
-#elif defined(CERNLIB_CRAY)
-# define ifpdcl IFPDCL
-#elif defined(CERNLIB_IBM)
-# pragma linkage (ifpdcl ,FORTRAN)
-#endif
-
-int ifpdcl(x)
-double *x;
-{
-#if defined(CERNLIB_DECS) && ! defined(CERNLIB_ALPHA_OSF)
-int i;
-i=fp_class_d(*x);
-switch(i)
- {
- case 0 :
- return 8;
- case 1 :
- return 9;
- case 2 :
- return 4;
- case 3 :
- return 5;
- case 4 :
- return 0;
- case 5 :
- return 1;
- case 6 :
- return 6;
- case 7 :
- return 7;
- case 8 :
- return 2;
- case 9 :
- return 3;
- }
-}
-#elif defined(CERNLIB_ALPHA_OSF)
-int i;
-i=fp_class(*x);
-switch(i)
- {
- case FP_SNAN :
- return 8;
- case FP_QNAN :
- return 9;
- case FP_POS_INF :
- return 4;
- case FP_NEG_INF :
- return 5;
- case FP_POS_NORM :
- return 0;
- case FP_NEG_NORM :
- return 1;
- case FP_POS_DENORM :
- return 6;
- case FP_NEG_DENORM :
- return 7;
- case FP_POS_ZERO :
- return 2;
- case FP_NEG_ZERO :
- return 3;
- }
-}
-#elif defined(CERNLIB_HPUX)
-return fpclassify(*x);
-}
-#elif defined(CERNLIB_IBMRT)
-int i;
-i = class(*x);
-switch(i)
- {
- case FP_PLUS_NORM :
- return 0;
- case FP_MINUS_NORM :
- return 1;
- case FP_PLUS_DENORM :
- return 6;
- case FP_MINUS_DENORM :
- return 7;
- case FP_PLUS_ZERO:
- return 2;
- case FP_MINUS_ZERO:
- return 3;
- case FP_PLUS_INF :
- return 4;
- case FP_MINUS_INF :
- return 5;
- case 8 :
- return 8;
- case 9 :
- return 9;
- }
-}
-#elif defined(CERNLIB_SGI)
-int i;
-i=fp_class_d(*x);
-switch(i)
- {
- case 0 :
- return 8;
- case 1 :
- return 9;
- case 2 :
- return 4;
- case 3 :
- return 5;
- case 4 :
- return 0;
- case 5 :
- return 1;
- case 6 :
- return 6;
- case 7 :
- return 7;
- case 8 :
- return 2;
- case 9 :
- return 3;
- }
-}
-#elif defined(CERNLIB_SUN) && !defined(CERNLIB_SOLARIS)
-int i;
-i=fp_class(*x);
-switch(i)
- {
- case 0:
- if (signbit(*x)==1) {
- return 3;
- } else {
- return 2;
- }
- case 1:
- if (*x<0) {
- return 7;
- } else {
- return 6;
- }
- case 2:
- if (*x<0) {
- return 1;
- } else {
- return 0;
- }
- case 3:
- if (*x<0) {
- return 5;
- } else {
- return 4;
- }
- case 4:
- return 9;
- case 5:
- return 8;
- }
-}
-#elif defined(CERNLIB_SOLARIS)
-fpclass_t i;
-i=fpclass(*x);
-switch(i)
- {
- case FP_SNAN:
- return 8;
- case FP_QNAN :
- return 9;
- case FP_NINF :
- return 5;
- case FP_PINF :
- return 4;
- case FP_NDENORM:
- return 7;
- case FP_PDENORM:
- return 6;
- case FP_NZERO :
- return 3;
- case FP_PZERO :
- return 2;
- case FP_NNORM:
- return 1;
- case FP_PNORM :
- return 0;
- }
-}
-#else
-if (*x<0) return 1;
-if (*x==0) return 2;
-if (*x>0) return 0;
-return 9;
-}
-#endif
diff --git a/src/packlib/hbook/fpclassc/ifpscl.c b/src/packlib/hbook/fpclassc/ifpscl.c
deleted file mode 100644
index b267ad2..0000000
--- a/src/packlib/hbook/fpclassc/ifpscl.c
+++ /dev/null
@@ -1,261 +0,0 @@
-/*
- * $Id: ifpscl.c,v 1.5 1997/09/02 13:09:05 mclareni Exp $
- *
- * $Log: ifpscl.c,v $
- * Revision 1.5 1997/09/02 13:09:05 mclareni
- * WINNT correction
- *
- * Revision 1.4 1997/03/14 17:05:26 mclareni
- * WNT mods
- *
- * Revision 1.3 1996/02/21 16:09:13 cernlib
- * Correct a typo
- *
- * Revision 1.2 1996/02/20 16:49:00 cernlib
- * Clean up the code; use elif/else instead of the patchy syntax.
- *
- * Revision 1.1.1.1 1996/01/16 17:08:12 mclareni
- * First import
- *
- */
-#include "hbook/pilot.h"
-/*CMZ : 17/05/95 17.23.35 by Julian Bunn*/
-/*-- Author : Francois Dardare 03/03/95*/
-/******************************************************************************
- * *
- * NAME: *
- * *
- * ifpscl() - floating-point operand classification FORTRAN *
- * callable function. *
- * *
- * SYNOPSIS: *
- * *
- * I = IFPSCL(X) *
- * *
- * DESCRIPTION: *
- * *
- * ifpscl() returns a non-negative integer value that specifies *
- * the IEEE operand class to which the argument x belongs. The *
- * value returned are defined as follow: *
- * *
- * 0 = Positive normalized *
- * 1 = Negative normalized *
- * 2 = Positive zero *
- * 3 = Negative zero *
- * 4 = Positive infinity *
- * 5 = Negative infinity *
- * 6 = Positive denormalized *
- * 7 = Negative denormalized *
- * 8 = Signalling NaN *
- * 9 = Quiet NaN *
- * *
- ******************************************************************************/
-#if defined(CERNLIB_DECS) || defined(CERNLIB_SGI) || defined(CERNLIB_ALPHA_OSF)
-#include <fp_class.h>
-#elif defined(CERNLIB_HPUX)
-#include <math.h>
-#elif defined(CERNLIB_IBMRT)
-#include <math.h>
-#include <float.h>
-#elif (defined(CERNLIB_SUN))&&(!defined(CERNLIB_SOLARIS))
-#include <floatingpoint.h>
-#elif defined(CERNLIB_SOLARIS)
-#include <ieeefp.h>
-#endif
-
-#if defined(CERNLIB_UNIX) && defined(CERNLIB_QX_SC)
-#define ifpscl ifpscl_
-#elif defined(CERNLIB_QXCAPT)
-#define ifpscl type_of_call IFPSCL
-#elif defined(CERNLIB_CRAY)
-#define ifpscl IFPSCL
-#elif defined(CERNLIB_IBM)
-#pragma linkage (ifpscl ,FORTRAN)
-#endif
-
-int ifpscl(x)
-float *x;
-{
-#if defined(CERNLIB_DECS) && ! defined(CERNLIB_ALPHA_OSF)
-int i;
-i=fp_class_d(*x);
-switch(i)
- {
- case 0 :
- return 8;
- case 1 :
- return 9;
- case 2 :
- return 4;
- case 3 :
- return 5;
- case 4 :
- return 0;
- case 5 :
- return 1;
- case 6 :
- return 6;
- case 7 :
- return 7;
- case 8 :
- return 2;
- case 9 :
- return 3;
- }
-}
-#elif defined(CERNLIB_ALPHA_OSF)
-int i;
-i=fp_classf(*x);
-switch(i)
- {
- case FP_SNAN :
- return 8;
- case FP_QNAN :
- return 9;
- case FP_POS_INF :
- return 4;
- case FP_NEG_INF :
- return 5;
- case FP_POS_NORM :
- return 0;
- case FP_NEG_NORM :
- return 1;
- case FP_POS_DENORM :
- return 6;
- case FP_NEG_DENORM :
- return 7;
- case FP_POS_ZERO :
- return 2;
- case FP_NEG_ZERO :
- return 3;
- }
-}
-#elif defined(CERNLIB_HPUX)
-return fpclassifyf(*x);
-}
-#elif defined(CERNLIB_IBMRT)
-int i;
-i = class(*x);
-switch(i)
- {
- case FP_PLUS_NORM :
- return 0;
- case FP_MINUS_NORM :
- return 1;
- case FP_PLUS_DENORM :
- return 6;
- case FP_MINUS_DENORM :
- return 7;
- case FP_PLUS_ZERO:
- return 2;
- case FP_MINUS_ZERO:
- return 3;
- case FP_PLUS_INF :
- return 4;
- case FP_MINUS_INF :
- return 5;
- case 8 :
- return 8;
- case 9 :
- return 9;
- }
-}
-#elif defined(CERNLIB_SGI)
-int i;
-i=fp_class_f(*x);
-switch(i)
- {
- case 0 :
- return 8;
- case 1 :
- return 9;
- case 2 :
- return 4;
- case 3 :
- return 5;
- case 4 :
- return 0;
- case 5 :
- return 1;
- case 6 :
- return 6;
- case 7 :
- return 7;
- case 8 :
- return 2;
- case 9 :
- return 3;
- }
-}
-#elif defined(CERNLIB_SUN) && !defined(CERNLIB_SOLARIS)
-int i;
-i=fp_class(*x);
-switch(i)
- {
- case 0:
- if (signbit(*x)==1) {
- return 3;
- } else {
- return 2;
- }
- case 1:
- if (*x<0) {
- return 7;
- } else {
- return 6;
- }
- case 2:
- if (*x<0) {
- return 1;
- } else {
- return 0;
- }
- case 3:
- if (*x<0) {
- return 5;
- } else {
- return 4;
- }
- case 4:
- return 9;
- case 5:
- return 8;
- }
-}
-#elif defined(CERNLIB_SOLARIS)
-fpclass_t i;
-i=fpclass(*x);
-switch(i)
- {
- case FP_SNAN:
- return 8;
- case FP_QNAN :
- return 9;
- case FP_NINF :
- return 5;
- case FP_PINF :
- return 4;
- case FP_NDENORM:
- return 7;
- case FP_PDENORM:
- return 6;
- case FP_NZERO :
- return 3;
- case FP_PZERO :
- return 2;
- case FP_NNORM:
- return 1;
- case FP_PNORM :
- return 0;
- }
-}
-#else
-if (*x<0) return 1;
-if (*x==0) return 2;
-if (*x>0) return 0;
-return 9;
-}
-#endif
-
-
-
diff --git a/src/packlib/hbook/hbook/Imakefile b/src/packlib/hbook/hbook/Imakefile
deleted file mode 100644
index 55113a3..0000000
--- a/src/packlib/hbook/hbook/Imakefile
+++ /dev/null
@@ -1,15 +0,0 @@
-INCLUDES= czbuff.inc czcbuf.inc czsock.inc hcache.inc \ @@\
- hcbits.inc hcbont.inc hcbook.inc hcdifb.inc hcdire.inc \ @@\
- hcfast.inc hcfit1.inc hcfit2.inc hcfit3.inc hcfit6.inc \ @@\
- hcfitd.inc hcfitd1.inc hcfitf.inc hcfitr.inc hcfits.inc \ @@\
- hcflag.inc hcform.inc hchoptm.inc hck.inc hcmail.inc \ @@\
- hcmcpm.inc hcmcpm1.inc hcmcpm2.inc hcminpu.inc hcnt.inc \ @@\
- hcntpar.inc hcntpaw.inc hcopt.inc hcpar0.inc hcpar1.inc \ @@\
- hcpar2.inc hcpiaf.inc hcpout.inc hcprin.inc hcqcom.inc \ @@\
- hcqcor.inc hcqcor1.inc hcqcor2.inc hcrecv.inc hcrlf.inc \ @@\
- hcrlf1.inc hcrlf2.inc hcsave.inc hcset.inc hctit.inc \ @@\
- hcunit.inc hcvers.inc hmac1.inc hmac2.inc hmac3.inc hmac4.inc \ @@\
- hmac5.inc hmac6.inc hmachine.inc hntcur.inc jbyt.inc jbyt1.inc \ @@\
- jbyt2.inc jbyt3.inc jbyt4.inc pilot.h
-
-InstallIncludes($(INCLUDES),$(CERN_INCLUDEDIR),hbook)
diff --git a/src/packlib/hbook/hbook/czbuff.inc b/src/packlib/hbook/hbook/czbuff.inc
deleted file mode 100644
index 809d2ea..0000000
--- a/src/packlib/hbook/hbook/czbuff.inc
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: czbuff.inc,v 1.1.1.1 1996/01/16 17:07:51 mclareni Exp $
-*
-* $Log: czbuff.inc,v $
-* Revision 1.1.1.1 1996/01/16 17:07:51 mclareni
-* First import
-*
-*
-#ifndef CERNLIB_HBOOK_CZBUFF_INC
-#define CERNLIB_HBOOK_CZBUFF_INC
-*
-*
-* czbuff.inc
-*
-*CMZ : 4.20/03 28/07/93 10.57.50 by Rene Brun
-*-- Author : Fons Rademakers 06/05/93
- CHARACTER*512 CHBUF
- COMMON/CZBUFC/CHBUF
-*
-
-#endif
diff --git a/src/packlib/hbook/hbook/czcbuf.inc b/src/packlib/hbook/hbook/czcbuf.inc
deleted file mode 100644
index aad375b..0000000
--- a/src/packlib/hbook/hbook/czcbuf.inc
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: czcbuf.inc,v 1.1.1.1 1996/01/16 17:07:51 mclareni Exp $
-*
-* $Log: czcbuf.inc,v $
-* Revision 1.1.1.1 1996/01/16 17:07:51 mclareni
-* First import
-*
-*
-#ifndef CERNLIB_HBOOK_CZCBUF_INC
-#define CERNLIB_HBOOK_CZCBUF_INC
-*
-*
-* czcbuf.inc
-*
-*CMZ : 4.19/05 08/06/93 10.43.23 by Rene Brun
-*-- Author : Rene Brun 08/06/93
- COMMON/CZCBUF/IZCBUF
-*
-
-#endif
diff --git a/src/packlib/hbook/hbook/czsock.inc b/src/packlib/hbook/hbook/czsock.inc
deleted file mode 100644
index 058d339..0000000
--- a/src/packlib/hbook/hbook/czsock.inc
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: czsock.inc,v 1.1.1.1 1996/01/16 17:07:51 mclareni Exp $
-*
-* $Log: czsock.inc,v $
-* Revision 1.1.1.1 1996/01/16 17:07:51 mclareni
-* First import
-*
-*
-#ifndef CERNLIB_HBOOK_CZSOCK_INC
-#define CERNLIB_HBOOK_CZSOCK_INC
-*
-*
-* czsock.inc
-*
-*CMZ : 4.22/04 02/06/94 08.46.59 by Rene Brun
-*-- Author : Fons Rademakers 06/05/93
- INTEGER LUNCZ,IADTCP,LBUFCZ,ISKIN,ISKOUT,IPROT
- COMMON/CZSOCK/LUNCZ,IADTCP,LBUFCZ,ISKIN,ISKOUT,IPROT
-
-#endif
diff --git a/src/packlib/hbook/hbook/hcache.inc b/src/packlib/hbook/hbook/hcache.inc
deleted file mode 100644
index ea7972c..0000000
--- a/src/packlib/hbook/hbook/hcache.inc
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: hcache.inc,v 1.1.1.1 1996/01/16 17:07:50 mclareni Exp $
-*
-* $Log: hcache.inc,v $
-* Revision 1.1.1.1 1996/01/16 17:07:50 mclareni
-* First import
-*
-*
-#ifndef CERNLIB_HBOOK_HCACHE_INC
-#define CERNLIB_HBOOK_HCACHE_INC
-*
-*
-* hcache.inc
-*
-*CMZ : 4.21/01 01/11/93 18.20.48 by Fons Rademakers
-*-- Author : Fons Rademakers 01/11/93
- PARAMETER (IDMXNT = 100)
- COMMON /HCACHE/ IDNOT(IDMXNT), IDTNOT
-
-#endif
diff --git a/src/packlib/hbook/hbook/hcbits.inc b/src/packlib/hbook/hbook/hcbits.inc
deleted file mode 100644
index 0342138..0000000
--- a/src/packlib/hbook/hbook/hcbits.inc
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: hcbits.inc,v 1.1.1.1 1996/01/16 17:07:51 mclareni Exp $
-*
-* $Log: hcbits.inc,v $
-* Revision 1.1.1.1 1996/01/16 17:07:51 mclareni
-* First import
-*
-*
-#ifndef CERNLIB_HBOOK_HCBITS_INC
-#define CERNLIB_HBOOK_HCBITS_INC
-*
-*
-* hcbits.inc
-*
-*CMZ : 4.19/00 13/04/93 16.36.40 by Rene Brun
-*-- Author :
- INTEGER I1, I2, I3, I4, I5, I6, I7, I8,
- + I9, I10, I11, I12, I13, I14, I15, I16,
- +I17, I18, I19, I20, I21, I22, I23, I24, I25, I26, I27,
- +I28, I29, I30, I31, I32, I33, I34, I35, I123, I230
- COMMON / HCBITS / I1, I2, I3, I4, I5, I6, I7, I8,
- + I9, I10, I11, I12, I13, I14, I15, I16,
- +I17, I18, I19, I20, I21, I22, I23, I24, I25, I26, I27,
- +I28, I29, I30, I31, I32, I33, I34, I35, I123, I230
-*
-
-#endif
diff --git a/src/packlib/hbook/hbook/hcbont.inc b/src/packlib/hbook/hbook/hcbont.inc
deleted file mode 100644
index 06b9658..0000000
--- a/src/packlib/hbook/hbook/hcbont.inc
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: hcbont.inc,v 1.1.1.1 1996/01/16 17:07:50 mclareni Exp $
-*
-* $Log: hcbont.inc,v $
-* Revision 1.1.1.1 1996/01/16 17:07:50 mclareni
-* First import
-*
-*
-#ifndef CERNLIB_HBOOK_HCBONT_INC
-#define CERNLIB_HBOOK_HCBONT_INC
-*
-*
-* hcbont.inc
-*
-*CMZ : 4.21/10 01/03/94 11.54.50 by Rene Brun
-*-- Author : Rene Brun 10/01/94
-*
-*-- ATTENTION: when changing anything in these common blocks check
-*-- also $HCNTPAW.
-*
- PARAMETER (MAXNP = 1000, MAXNC = 8000)
- PARAMETER (MAXDUM=50007-4*MAXNP-3)
- REAL XONT(MAXNP), YONT(MAXNP), ZONT(MAXNP), WONT(MAXNP)
- REAL DUMCR4(MAXDUM)
- INTEGER KONTYP, NONT,NCHONT
- CHARACTER*4 CHONT(MAXNC)
-*
- COMMON /PAWCR4/KONTYP,NONT,XONT,YONT,ZONT,WONT,NCHONT,DUMCR4
- COMMON /PAWC32/ CHONT
-*
-
-#endif
diff --git a/src/packlib/hbook/hbook/hcbook.inc b/src/packlib/hbook/hbook/hcbook.inc
deleted file mode 100644
index 7a9afec..0000000
--- a/src/packlib/hbook/hbook/hcbook.inc
+++ /dev/null
@@ -1,37 +0,0 @@
-*
-* $Id: hcbook.inc,v 1.1.1.1 1996/01/16 17:07:51 mclareni Exp $
-*
-* $Log: hcbook.inc,v $
-* Revision 1.1.1.1 1996/01/16 17:07:51 mclareni
-* First import
-*
-*
-#ifndef CERNLIB_HBOOK_HCBOOK_INC
-#define CERNLIB_HBOOK_HCBOOK_INC
-*
-*
-* hcbook.inc
-*
-*CMZ : 4.19/01 30/04/93 17.22.15 by Rene Brun
-*-- Author :
- INTEGER NWPAW,IXPAWC,IHDIV,IXHIGZ,IXKU, LMAIN
- REAL FENC , HCV
- COMMON/PAWC/NWPAW,IXPAWC,IHDIV,IXHIGZ,IXKU,FENC(5),LMAIN,HCV(9989)
- INTEGER IQ ,LQ
- REAL Q
- DIMENSION IQ(2),Q(2),LQ(8000)
- EQUIVALENCE (LQ(1),LMAIN),(IQ(1),LQ(9)),(Q(1),IQ(1))
- INTEGER HVERSN,IHWORK,LHBOOK,LHPLOT,LGTIT,LHWORK,
- +LCDIR,LSDIR,LIDS,LTAB,LCID,LCONT,LSCAT,LPROX,LPROY,LSLIX,
- +LSLIY,LBANX,LBANY,LPRX,LPRY,LFIX,LLID,LR1,LR2,LNAME,LCHAR,LINT,
- +LREAL,LBLOK,LLBLK,LBUFM,LBUF,LTMPM,LTMP,LTMP1,LHPLIP,LHDUM,
- +LHFIT,LFUNC,LHFCO,LHFNA,LCIDN
- COMMON/HCBOOK/HVERSN,IHWORK,LHBOOK,LHPLOT,LGTIT,LHWORK,
- +LCDIR,LSDIR,LIDS,LTAB,LCID,LCONT,LSCAT,LPROX,LPROY,LSLIX,
- +LSLIY,LBANX,LBANY,LPRX,LPRY,LFIX,LLID,LR1,LR2,LNAME,LCHAR,LINT,
- +LREAL,LBLOK,LLBLK,LBUFM,LBUF,LTMPM,LTMP,LTMP1,LHPLIP,LHDUM(9),
- +LHFIT,LFUNC,LHFCO,LHFNA,LCIDN
-*
-#include "hbook/hck.inc"
-
-#endif
diff --git a/src/packlib/hbook/hbook/hcdifb.inc b/src/packlib/hbook/hbook/hcdifb.inc
deleted file mode 100644
index d4e4dd1..0000000
--- a/src/packlib/hbook/hbook/hcdifb.inc
+++ /dev/null
@@ -1,76 +0,0 @@
-*
-* $Id: hcdifb.inc,v 1.1.1.1 1996/01/16 17:07:53 mclareni Exp $
-*
-* $Log: hcdifb.inc,v $
-* Revision 1.1.1.1 1996/01/16 17:07:53 mclareni
-* First import
-*
-*
-#ifndef CERNLIB_HBOOK_HCDIFB_INC
-#define CERNLIB_HBOOK_HCDIFB_INC
-*
-*
-* hcdifb.inc
-*
-*CMZ : 4.19/00 13/04/93 16.36.40 by Rene Brun
-*-- Author :
-C
-C----------------------------------------------------------------------
-C
-C HDIFFB specific common block
-C
-C----------------------------------------------------------------------
-C
-C
-C Option string: Contains all possible character options, used as input
-C for the option decoding utility HUOPTC. This returns a
-C 1-d array of length the number of options with contents
-C one or zero. One indicates that that option was selected.
-C For example, HUOPTC('A','ABC',SELECTED(3)) would return
-C (1,0,0) in SELECTED array. Likewise, 'CB' would return
-C (0,1,1).
-C
-C HDIFFB has 12 possible options, and the resulting 1-d
-C array, OPTS(12) is placed in the HDIFFB common block.
-C
-C----------------------------------------------------------------------
-C
- INTEGER NPARMS
- PARAMETER( NPARMS = 12 )
- CHARACTER*(NPARMS) OPTST
- INTEGER OFLOW, UFLOW, SOPTN, COPTN, AOPTN
- INTEGER NORMD,DEBUG,ZEROS,XUNDR,XOVER,YUNDR,YOVER
-C - possible options string
- PARAMETER( OPTST = 'NDOUSCAZRLTB' )
-C - option N, don't normalize contents
-C - option D, debugging printout
-C - option O, overflow option
-C - option U, underflow option
-C - option S, statistical comparison
-C - option C, compatibility test
-C - option A, absolute test
-C - option Z, skip ref bin = 0
-C - option R, X-Axis overflow
-C - option L, X-Axis underflow
-C - option T, Y-Axis overflow
-C - option B, Y-Axis underflow
- PARAMETER( NORMD = 1 , DEBUG = 2 , OFLOW = 3, UFLOW = 4,
- + SOPTN = 5, COPTN = 6 , AOPTN = 7 , ZEROS = 8, XOVER = 9,
- + XUNDR = 10, YOVER = 11, YUNDR = 12)
-C
-C----------------------------------------------------------------------
-C Global HDIFFB declarations
-C----------------------------------------------------------------------
-C
- INTEGER DUMPDV,IDR,IDD,BEGINI,BEGINJ,ENDI,ENDJ
- INTEGER OPTS(NPARMS),XSIZ
- REAL LAMBDA,LNBIGP,ACDIGT
- LOGICAL TWODIM,WEIGHR,WEIGHD,PROFIL,PSDMR,PSDMD
-
- COMMON/HCDIFB/TWODIM,WEIGHR,WEIGHD,PROFIL,PSDMR,PSDMD,DUMPDV,
- + IDR,IDD,BEGINI,BEGINJ,ENDI,ENDJ,LAMBDA,OPTS,XSIZ,LNBIGP,ACDIGT
-
-
-
-
-#endif
diff --git a/src/packlib/hbook/hbook/hcdire.inc b/src/packlib/hbook/hbook/hcdire.inc
deleted file mode 100644
index cdf8cae..0000000
--- a/src/packlib/hbook/hbook/hcdire.inc
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: hcdire.inc,v 1.2 2003/02/07 12:13:37 couet Exp $
-*
-* $Log: hcdire.inc,v $
-* Revision 1.2 2003/02/07 12:13:37 couet
-* - The size of the HFNAME character string has been increased to 128. It
-* was 80 before. 80 was not long enough to support long file names one
-* can get using CASTOR files in a CHAIN command. The HFNAME length is now
-* defined as the parameter LENHFN.
-*
-* Revision 1.1.1.1 1996/01/16 17:07:51 mclareni
-* First import
-*
-*
-#ifndef CERNLIB_HBOOK_HCDIRE_INC
-#define CERNLIB_HBOOK_HCDIRE_INC
-*
-*
-* hcdire.inc
-*
-*CMZ : 4.20/03 28/07/93 09.33.32 by Rene Brun
-*-- Author :
- PARAMETER (NLPATM=100, MXFILES=50, LENHFN=128)
- COMMON /HCDIRN/NLCDIR,NLNDIR,NLPAT,ICDIR,NCHTOP,ICHTOP(MXFILES)
- + ,ICHTYP(MXFILES),ICHLUN(MXFILES)
- CHARACTER*16 CHNDIR, CHCDIR, CHPAT ,CHTOP
- COMMON /HCDIRC/CHCDIR(NLPATM),CHNDIR(NLPATM),CHPAT(NLPATM)
- + ,CHTOP(NLPATM)
- CHARACTER*(LENHFN) HFNAME
- COMMON /HCFILE/HFNAME(MXFILES)
-*
-
-#endif
diff --git a/src/packlib/hbook/hbook/hcfast.inc b/src/packlib/hbook/hbook/hcfast.inc
deleted file mode 100644
index d58e4df..0000000
--- a/src/packlib/hbook/hbook/hcfast.inc
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: hcfast.inc,v 1.1.1.1 1996/01/16 17:07:50 mclareni Exp $
-*
-* $Log: hcfast.inc,v $
-* Revision 1.1.1.1 1996/01/16 17:07:50 mclareni
-* First import
-*
-*
-#ifndef CERNLIB_HBOOK_HCFAST_INC
-#define CERNLIB_HBOOK_HCFAST_INC
-*
-*
-* hcfast.inc
-*
-*CMZ : 4.21/08 14/02/94 17.19.04 by Rene Brun
-*-- Author : Rene Brun 14/02/94
- PARAMETER (NIDMAX=1000)
- COMMON/HCFAST/NID(NIDMAX)
-
-
-#endif
diff --git a/src/packlib/hbook/hbook/hcfit1.inc b/src/packlib/hbook/hbook/hcfit1.inc
deleted file mode 100644
index d450907..0000000
--- a/src/packlib/hbook/hbook/hcfit1.inc
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: hcfit1.inc,v 1.1.1.1 1996/01/16 17:07:51 mclareni Exp $
-*
-* $Log: hcfit1.inc,v $
-* Revision 1.1.1.1 1996/01/16 17:07:51 mclareni
-* First import
-*
-*
-#ifndef CERNLIB_HBOOK_HCFIT1_INC
-#define CERNLIB_HBOOK_HCFIT1_INC
-*
-*
-* hcfit1.inc
-*
-*CMZ : 4.19/00 13/04/93 16.36.40 by Rene Brun
-*-- Author :
- COMMON /HCFIT1/ NUMEP1,N3,EPS
-*
-
-#endif
diff --git a/src/packlib/hbook/hbook/hcfit2.inc b/src/packlib/hbook/hbook/hcfit2.inc
deleted file mode 100644
index d55dc95..0000000
--- a/src/packlib/hbook/hbook/hcfit2.inc
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: hcfit2.inc,v 1.1.1.1 1996/01/16 17:07:51 mclareni Exp $
-*
-* $Log: hcfit2.inc,v $
-* Revision 1.1.1.1 1996/01/16 17:07:51 mclareni
-* First import
-*
-*
-#ifndef CERNLIB_HBOOK_HCFIT2_INC
-#define CERNLIB_HBOOK_HCFIT2_INC
-*
-*
-* hcfit2.inc
-*
-*CMZ : 4.19/00 13/04/93 16.36.40 by Rene Brun
-*-- Author :
- COMMON/HCFIT2/ENDFLG,NA,INDFLG(5),IFLFUN,NAMFUN,IDIMPN,XFUMIL(10),
- + NUMEP ,XMIN ,EPSW ,ALLCHA,BINWID,WGTMAX,YMIN,BINWIY,
- + NCHANX,LINEAR,IFLSF ,IFLBUF,IDER,IWEIGH,ITFUM,ISUPIM
-*
-
-#endif
diff --git a/src/packlib/hbook/hbook/hcfit3.inc b/src/packlib/hbook/hbook/hcfit3.inc
deleted file mode 100644
index debd57a..0000000
--- a/src/packlib/hbook/hbook/hcfit3.inc
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: hcfit3.inc,v 1.1.1.1 1996/01/16 17:07:51 mclareni Exp $
-*
-* $Log: hcfit3.inc,v $
-* Revision 1.1.1.1 1996/01/16 17:07:51 mclareni
-* First import
-*
-*
-#ifndef CERNLIB_HBOOK_HCFIT3_INC
-#define CERNLIB_HBOOK_HCFIT3_INC
-*
-*
-* hcfit3.inc
-*
-*CMZ : 4.19/00 13/04/93 16.36.40 by Rene Brun
-*-- Author :
- COMMON /HCFIT3/ NPOLYN,IPARAM,IDERIV,IDEROK
-*
-
-#endif
diff --git a/src/packlib/hbook/hbook/hcfit6.inc b/src/packlib/hbook/hbook/hcfit6.inc
deleted file mode 100644
index 1093aa3..0000000
--- a/src/packlib/hbook/hbook/hcfit6.inc
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: hcfit6.inc,v 1.1.1.1 1996/01/16 17:07:52 mclareni Exp $
-*
-* $Log: hcfit6.inc,v $
-* Revision 1.1.1.1 1996/01/16 17:07:52 mclareni
-* First import
-*
-*
-#ifndef CERNLIB_HBOOK_HCFIT6_INC
-#define CERNLIB_HBOOK_HCFIT6_INC
-*
-*
-* hcfit6.inc
-*
-*CMZ : 4.19/00 13/04/93 16.36.40 by Rene Brun
-*-- Author :
- COMMON /HCFIT6/XVAR(10),EPSIF,NUP,NFCNMH,ITPR,IHIS,IMINU,
- + NX,NY,NPFIT,ILICO,CHIM,IOFSET,IMAT,IBQ(14),ILXE,ILYE,
- + ILEY,ICSTAT,NFLRET,IDESUM
-*
-
-#endif
diff --git a/src/packlib/hbook/hbook/hcfitd.inc b/src/packlib/hbook/hbook/hcfitd.inc
deleted file mode 100644
index 52b8f19..0000000
--- a/src/packlib/hbook/hbook/hcfitd.inc
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: hcfitd.inc,v 1.1.1.1 1996/01/16 17:07:52 mclareni Exp $
-*
-* $Log: hcfitd.inc,v $
-* Revision 1.1.1.1 1996/01/16 17:07:52 mclareni
-* First import
-*
-*
-#ifndef CERNLIB_HBOOK_HCFITD_INC
-#define CERNLIB_HBOOK_HCFITD_INC
-*
-*
-* hcfitd.inc
-*
-*CMZ : 4.19/00 28/04/93 11.16.52 by Rene Brun
-*-- Author :
-#if defined(CERNLIB_DOUBLE)
-#include "hbook/hcfitd1.inc"
-#endif
- COMMON/HCFITD/FITPAD(24),FITFUN
-*
-
-#endif
diff --git a/src/packlib/hbook/hbook/hcfitd1.inc b/src/packlib/hbook/hbook/hcfitd1.inc
deleted file mode 100644
index a68d1dd..0000000
--- a/src/packlib/hbook/hbook/hcfitd1.inc
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: hcfitd1.inc,v 1.1.1.1 1996/01/16 17:07:52 mclareni Exp $
-*
-* $Log: hcfitd1.inc,v $
-* Revision 1.1.1.1 1996/01/16 17:07:52 mclareni
-* First import
-*
-*
-#ifndef CERNLIB_HBOOK_HCFITD1_INC
-#define CERNLIB_HBOOK_HCFITD1_INC
-*
-*
-* hcfitd1.inc
-*
-*CMZ : 4.19/00 28/04/93 11.16.52 by Rene Brun
-*-- Author :
- DOUBLE PRECISION FITPAD,FITFUN
-
-#endif
diff --git a/src/packlib/hbook/hbook/hcfitf.inc b/src/packlib/hbook/hbook/hcfitf.inc
deleted file mode 100644
index 5e5aea1..0000000
--- a/src/packlib/hbook/hbook/hcfitf.inc
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: hcfitf.inc,v 1.1.1.1 1996/01/16 17:07:51 mclareni Exp $
-*
-* $Log: hcfitf.inc,v $
-* Revision 1.1.1.1 1996/01/16 17:07:51 mclareni
-* First import
-*
-*
-#ifndef CERNLIB_HBOOK_HCFITF_INC
-#define CERNLIB_HBOOK_HCFITF_INC
-*
-*
-* hcfitf.inc
-*
-*CMZ : 4.19/00 13/04/93 16.36.40 by Rene Brun
-*-- Author :
- PARAMETER(MAXOP=10)
- COMMON/HCFITF/NOPER,LOPER(MAXOP),IFTYPE(MAXOP),NPF(MAXOP)
-*
-
-#endif
diff --git a/src/packlib/hbook/hbook/hcfitr.inc b/src/packlib/hbook/hbook/hcfitr.inc
deleted file mode 100644
index a6f3954..0000000
--- a/src/packlib/hbook/hbook/hcfitr.inc
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: hcfitr.inc,v 1.1.1.1 1996/01/16 17:07:51 mclareni Exp $
-*
-* $Log: hcfitr.inc,v $
-* Revision 1.1.1.1 1996/01/16 17:07:51 mclareni
-* First import
-*
-*
-#ifndef CERNLIB_HBOOK_HCFITR_INC
-#define CERNLIB_HBOOK_HCFITR_INC
-*
-*
-* hcfitr.inc
-*
-*CMZ : 4.22/04 02/06/94 08.47.30 by Rene Brun
-*-- Author :
- INTEGER IFTRNG,IFXLOW,IFXUP,IFYLOW,IFYUP
- COMMON/HCFITR/IFTRNG,IFXLOW,IFXUP,IFYLOW,IFYUP
-C
-
-#endif
diff --git a/src/packlib/hbook/hbook/hcfits.inc b/src/packlib/hbook/hbook/hcfits.inc
deleted file mode 100644
index 69e103f..0000000
--- a/src/packlib/hbook/hbook/hcfits.inc
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: hcfits.inc,v 1.1.1.1 1996/01/16 17:07:52 mclareni Exp $
-*
-* $Log: hcfits.inc,v $
-* Revision 1.1.1.1 1996/01/16 17:07:52 mclareni
-* First import
-*
-*
-#ifndef CERNLIB_HBOOK_HCFITS_INC
-#define CERNLIB_HBOOK_HCFITS_INC
-*
-*
-* hcfits.inc
-*
-*CMZ : 4.19/00 13/04/93 16.36.40 by Rene Brun
-*-- Author :
- INTEGER NCFITS,NPFITS,NFPAR
- REAL FITCHI,FITPAR ,FITSIG
- + ,FITDER
- COMMON/HCFITS/NCFITS,NPFITS,NFPAR,FITCHI,FITPAR(35),FITSIG(35)
- + ,FITDER(35)
- CHARACTER*8 FITNAM
- COMMON/HCFITN/FITNAM(35)
-*
-
-#endif
diff --git a/src/packlib/hbook/hbook/hcflag.inc b/src/packlib/hbook/hbook/hcflag.inc
deleted file mode 100644
index 475a424..0000000
--- a/src/packlib/hbook/hbook/hcflag.inc
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: hcflag.inc,v 1.1.1.1 1996/01/16 17:07:51 mclareni Exp $
-*
-* $Log: hcflag.inc,v $
-* Revision 1.1.1.1 1996/01/16 17:07:51 mclareni
-* First import
-*
-*
-#ifndef CERNLIB_HBOOK_HCFLAG_INC
-#define CERNLIB_HBOOK_HCFLAG_INC
-*
-*
-* hcflag.inc
-*
-*CMZ : 4.19/00 13/04/93 16.36.40 by Rene Brun
-*-- Author :
- INTEGER ID ,IDBADD,LID ,IDLAST,IDHOLD,NBIT ,NBITCH,
- + NCHAR ,NRHIST,IERR ,NV
- COMMON/HCFLAG/ID ,IDBADD,LID ,IDLAST,IDHOLD,NBIT ,NBITCH,
- + NCHAR ,NRHIST,IERR ,NV
-*
-
-#endif
diff --git a/src/packlib/hbook/hbook/hcform.inc b/src/packlib/hbook/hbook/hcform.inc
deleted file mode 100644
index c1cca99..0000000
--- a/src/packlib/hbook/hbook/hcform.inc
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: hcform.inc,v 1.2 2001/10/10 08:07:28 couet Exp $
-*
-* $Log: hcform.inc,v $
-* Revision 1.2 2001/10/10 08:07:28 couet
-* - In this common block IJUNK has been replaced by IOCC (IJUNK was not used
-* in HBOOK). IOCC is returned by MZFORM and used later to create the HLABEL
-* data bank.
-*
-* Revision 1.1.1.1 1996/01/16 17:07:51 mclareni
-* First import
-*
-*
-#ifndef CERNLIB_HBOOK_HCFORM_INC
-#define CERNLIB_HBOOK_HCFORM_INC
-*
-*
-* hcform.inc
-*
-*CMZ : 4.19/00 13/04/93 16.36.40 by Rene Brun
-*-- Author :
- COMMON/HCFORM/IODIR,IOH1,IOH2,IOHN,IOCF1,IOCF2,IOCB1,IOCB2,
- + IOCF4,IOFIT,IONT,IOBL,IOCC
-*
-
-#endif
diff --git a/src/packlib/hbook/hbook/hchoptm.inc b/src/packlib/hbook/hbook/hchoptm.inc
deleted file mode 100644
index 060beac..0000000
--- a/src/packlib/hbook/hbook/hchoptm.inc
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: hchoptm.inc,v 1.1.1.1 1996/01/16 17:07:50 mclareni Exp $
-*
-* $Log: hchoptm.inc,v $
-* Revision 1.1.1.1 1996/01/16 17:07:50 mclareni
-* First import
-*
-*
-#ifndef CERNLIB_HBOOK_HCHOPTM_INC
-#define CERNLIB_HBOOK_HCHOPTM_INC
-*
-*
-* hchoptm.inc
-*
-*CMZ : 4.22/11 24/08/94 17.54.34 by Rene Brun
-*-- Author : Rene Brun 24/08/94
- CHARACTER*16 CHOPTM
- COMMON/HCHOPTM/CHOPTM
-*
-
-#endif
diff --git a/src/packlib/hbook/hbook/hck.inc b/src/packlib/hbook/hbook/hck.inc
deleted file mode 100644
index 1cb840d..0000000
--- a/src/packlib/hbook/hbook/hck.inc
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: hck.inc,v 1.1.1.1 1996/01/16 17:07:51 mclareni Exp $
-*
-* $Log: hck.inc,v $
-* Revision 1.1.1.1 1996/01/16 17:07:51 mclareni
-* First import
-*
-*
-#ifndef CERNLIB_HBOOK_HCK_INC
-#define CERNLIB_HBOOK_HCK_INC
-*
-*
-* hck.inc
-*
-*CMZ : 4.19/00 26/04/93 12.34.29 by Rene Brun
-*-- Author :
- INTEGER KNCX ,KXMIN ,KXMAX ,KMIN1 ,KMAX1 ,KNORM , KTIT1,
- + KNCY ,KYMIN ,KYMAX ,KMIN2 ,KMAX2 ,KSCAL2 , KTIT2,
- + KNBIT ,KNOENT ,KSTAT1 ,KNSDIR ,KNRH ,
- + KCON1 ,KCON2 ,KBITS ,KNTOT
- PARAMETER(KNCX=3,KXMIN=4,KXMAX=5,KMIN1=7,KMAX1=8,KNORM=9,KTIT1=10,
- + KNCY=7,KYMIN=8,KYMAX=9,KMIN2=6,KMAX2=10,KSCAL2=11,
- + KTIT2=12,KNBIT=1,KNOENT=2,KSTAT1=3,KNSDIR=5,KNRH=6,
- + KCON1=9,KCON2=3,KBITS=1,KNTOT=2)
-*
-
-#endif
diff --git a/src/packlib/hbook/hbook/hcmail.inc b/src/packlib/hbook/hbook/hcmail.inc
deleted file mode 100644
index e75f776..0000000
--- a/src/packlib/hbook/hbook/hcmail.inc
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: hcmail.inc,v 1.1.1.1 1996/01/16 17:07:52 mclareni Exp $
-*
-* $Log: hcmail.inc,v $
-* Revision 1.1.1.1 1996/01/16 17:07:52 mclareni
-* First import
-*
-*
-#ifndef CERNLIB_HBOOK_HCMAIL_INC
-#define CERNLIB_HBOOK_HCMAIL_INC
-*
-*
-* hcmail.inc
-*
-*CMZ : 4.19/00 13/04/93 16.36.40 by Rene Brun
-*-- Author :
- CHARACTER*128 CHMAIL
- COMMON /HCMAIL/CHMAIL
-*
-
-#endif
diff --git a/src/packlib/hbook/hbook/hcmcpm.inc b/src/packlib/hbook/hbook/hcmcpm.inc
deleted file mode 100644
index 57951d0..0000000
--- a/src/packlib/hbook/hbook/hcmcpm.inc
+++ /dev/null
@@ -1,40 +0,0 @@
-*
-* $Id: hcmcpm.inc,v 1.1.1.1 1996/01/16 17:07:50 mclareni Exp $
-*
-* $Log: hcmcpm.inc,v $
-* Revision 1.1.1.1 1996/01/16 17:07:50 mclareni
-* First import
-*
-*
-#ifndef CERNLIB_HBOOK_HCMCPM_INC
-#define CERNLIB_HBOOK_HCMCPM_INC
-*
-*
-* hcmcpm.inc
-*
-*CMZ : 4.20/13 19/10/93 15.38.13 by Roger Barlow, Christine Beeston
-*-- Author : Christine Beeston 24/09/93
-
-C some maximum values - max number of bins and dimensions
- INTEGER NSRCMX,NSRCMN,NOPTS
- PARAMETER(NSRCMX=20,NSRCMN=2,NOPTS=7)
-
-C Numbers of monte carlo and data events, links to data, MC and weight
-C histograms, Number of mc sources, options, total number of bins.
-C normalisation constants for weight histograms
-
-#if !defined(CERNLIB_DOUBLE)
-#include "hbook/hcmcpm1.inc"
-#endif
-#if defined(CERNLIB_DOUBLE)
-#include "hbook/hcmcpm2.inc"
-#endif
- INTEGER NDATEV,NMCEV(NSRCMX),
- + NMCSRC,IOPT(NOPTS),NTOT
- COMMON/HINPUTS/NDATEV,NMCEV,NMCSRC,IOPT,NTOT,BJ
-C Histogram IDs
- INTEGER IDD,IDM(NSRCMX),IDW(NSRCMX)
- COMMON/HMCIDS/IDD,IDM,IDW
-
-
-#endif
diff --git a/src/packlib/hbook/hbook/hcmcpm1.inc b/src/packlib/hbook/hbook/hcmcpm1.inc
deleted file mode 100644
index 4014a04..0000000
--- a/src/packlib/hbook/hbook/hcmcpm1.inc
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: hcmcpm1.inc,v 1.1.1.1 1996/01/16 17:07:50 mclareni Exp $
-*
-* $Log: hcmcpm1.inc,v $
-* Revision 1.1.1.1 1996/01/16 17:07:50 mclareni
-* First import
-*
-*
-#ifndef CERNLIB_HBOOK_HCMCPM1_INC
-#define CERNLIB_HBOOK_HCMCPM1_INC
-*
-*
-* hcmcpm1.inc
-*
-*CMZ : 4.20/10 30/09/93 08.15.34 by Rene Brun
-*-- Author :
- REAL BJ(NSRCMX)
-
-#endif
diff --git a/src/packlib/hbook/hbook/hcmcpm2.inc b/src/packlib/hbook/hbook/hcmcpm2.inc
deleted file mode 100644
index b8fce11..0000000
--- a/src/packlib/hbook/hbook/hcmcpm2.inc
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: hcmcpm2.inc,v 1.1.1.1 1996/01/16 17:07:50 mclareni Exp $
-*
-* $Log: hcmcpm2.inc,v $
-* Revision 1.1.1.1 1996/01/16 17:07:50 mclareni
-* First import
-*
-*
-#ifndef CERNLIB_HBOOK_HCMCPM2_INC
-#define CERNLIB_HBOOK_HCMCPM2_INC
-*
-*
-* hcmcpm2.inc
-*
-*CMZ : 4.20/10 30/09/93 08.15.34 by Rene Brun
-*-- Author :
- DOUBLE PRECISION BJ(NSRCMX)
-
-#endif
diff --git a/src/packlib/hbook/hbook/hcminpu.inc b/src/packlib/hbook/hbook/hcminpu.inc
deleted file mode 100644
index 3a0090d..0000000
--- a/src/packlib/hbook/hbook/hcminpu.inc
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: hcminpu.inc,v 1.1.1.1 1996/01/16 17:07:50 mclareni Exp $
-*
-* $Log: hcminpu.inc,v $
-* Revision 1.1.1.1 1996/01/16 17:07:50 mclareni
-* First import
-*
-*
-#ifndef CERNLIB_HBOOK_HCMINPU_INC
-#define CERNLIB_HBOOK_HCMINPU_INC
-*
-*
-* hcminpu.inc
-*
-*CMZ : 4.20/03 28/07/93 09.34.19 by Rene Brun
-*-- Author : Rene Brun 18/06/93
- INTEGER NCMINP,IADINP
- COMMON/HCMINP1/NCMINP,IADINP
- PARAMETER (MCHINP=50)
- CHARACTER*80 CHINPU(MCHINP)
- COMMON/HCMINPU/CHINPU
-*
-
-#endif
diff --git a/src/packlib/hbook/hbook/hcnt.inc b/src/packlib/hbook/hbook/hcnt.inc
deleted file mode 100644
index 1a68ed2..0000000
--- a/src/packlib/hbook/hbook/hcnt.inc
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: hcnt.inc,v 1.1.1.1 1996/01/16 17:07:52 mclareni Exp $
-*
-* $Log: hcnt.inc,v $
-* Revision 1.1.1.1 1996/01/16 17:07:52 mclareni
-* First import
-*
-*
-#ifndef CERNLIB_HBOOK_HCNT_INC
-#define CERNLIB_HBOOK_HCNT_INC
-*
-*
-* hcnt.inc
-*
-*CMZ : 4.19/00 13/04/93 16.36.40 by Rene Brun
-*-- Author :
- COMMON /HCNT/ IBIPW, IBIPB, IBYPW, ISHBIT
-*
-
-#endif
diff --git a/src/packlib/hbook/hbook/hcntpar.inc b/src/packlib/hbook/hbook/hcntpar.inc
deleted file mode 100644
index e5e1560..0000000
--- a/src/packlib/hbook/hbook/hcntpar.inc
+++ /dev/null
@@ -1,30 +0,0 @@
-*
-* $Id: hcntpar.inc,v 1.1.1.1 1996/01/16 17:07:52 mclareni Exp $
-*
-* $Log: hcntpar.inc,v $
-* Revision 1.1.1.1 1996/01/16 17:07:52 mclareni
-* First import
-*
-*
-#ifndef CERNLIB_HBOOK_HCNTPAR_INC
-#define CERNLIB_HBOOK_HCNTPAR_INC
-*
-*
-* hcntpar.inc
-*
-*CMZ : 4.20/00 21/06/93 12.39.17 by Fons Rademakers
-*-- Author :
- INTEGER ZBITS, ZNDIM, ZNOENT, ZNPRIM, ZNRZB, ZIFCON,
- + ZIFNAM, ZIFCHA, ZIFINT, ZIFREA, ZNWTIT, ZITIT1,
- + ZNCHRZ, ZDESC, ZLNAME, ZNAME, ZARIND, ZRANGE, ZNADDR,
- + ZIBLOK, ZNBLOK, ZLCONT, ZIFBIT, ZIBANK, ZIFTMP, ZITMP,
- + ZID, ZNTMP, ZNTMP1, ZLINK
- PARAMETER(ZBITS=1, ZNDIM=2, ZNOENT=3, ZNPRIM=4, ZLCONT=6,
- + ZNRZB=5, ZIFCON=7, ZIFNAM=4, ZIFCHA=5, ZIFINT=6,
- + ZIFREA=7, ZNWTIT=8, ZITIT1=9, ZNCHRZ=13, ZIFBIT=8,
- + ZDESC=1, ZLNAME=2, ZNAME=3, ZRANGE=4, ZNADDR=12,
- + ZARIND=11, ZIBLOK=8, ZNBLOK=10, ZIBANK=9, ZIFTMP=11,
- + ZID=12, ZITMP=10, ZNTMP=6, ZNTMP1=3, ZLINK=6)
-*
-
-#endif
diff --git a/src/packlib/hbook/hbook/hcntpaw.inc b/src/packlib/hbook/hbook/hcntpaw.inc
deleted file mode 100644
index 21fea53..0000000
--- a/src/packlib/hbook/hbook/hcntpaw.inc
+++ /dev/null
@@ -1,37 +0,0 @@
-*
-* $Id: hcntpaw.inc,v 1.1.1.1 1996/01/16 17:07:52 mclareni Exp $
-*
-* $Log: hcntpaw.inc,v $
-* Revision 1.1.1.1 1996/01/16 17:07:52 mclareni
-* First import
-*
-*
-#ifndef CERNLIB_HBOOK_HCNTPAW_INC
-#define CERNLIB_HBOOK_HCNTPAW_INC
-*
-*
-* hcntpaw.inc
-*
-*CMZ : 4.21/10 01/03/94 11.54.50 by Rene Brun
-*-- Author : Fons Rademakers 10/04/93
-*
-*-- ATTENTION: MAXCR4 must be 50007 in order for variables in $HCBONT to
-*-- fit into PAWCR4. When changing any of these parameters
-*-- check also $HCBONT.
-*
- PARAMETER (MAXCR8 = 1000, MAXCR4 = 50007, MAXC32 = 1000)
- REAL*8 RVAR8(MAXCR8)
- REAL RVAR4(MAXCR4)
- INTEGER IVAR4(MAXCR4)
- LOGICAL LVAR4(MAXCR4)
- CHARACTER*32 CVAR32(MAXC32)
-*
- COMMON /PAWCR8/ RVAR8
- COMMON /PAWCR4/ RVAR4
- COMMON /PAWC32/ CVAR32
-*
- EQUIVALENCE (IVAR4, RVAR4)
- EQUIVALENCE (LVAR4, RVAR4)
-*
-
-#endif
diff --git a/src/packlib/hbook/hbook/hcopt.inc b/src/packlib/hbook/hbook/hcopt.inc
deleted file mode 100644
index 94a316f..0000000
--- a/src/packlib/hbook/hbook/hcopt.inc
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: hcopt.inc,v 1.1.1.1 1996/01/16 17:07:50 mclareni Exp $
-*
-* $Log: hcopt.inc,v $
-* Revision 1.1.1.1 1996/01/16 17:07:50 mclareni
-* First import
-*
-*
-#ifndef CERNLIB_HBOOK_HCOPT_INC
-#define CERNLIB_HBOOK_HCOPT_INC
-*
-*
-* hcopt.inc
-*
-*CMZ : 4.21/05 29/11/93 14.10.46 by Fons Rademakers
-*-- Author : Rene Brun 27/11/93
- COMMON/HCOPT/ICOPT(10)
-*
- EQUIVALENCE (ISTAF, ICOPT(1))
-*
-
-#endif
diff --git a/src/packlib/hbook/hbook/hcpar0.inc b/src/packlib/hbook/hbook/hcpar0.inc
deleted file mode 100644
index 682f65e..0000000
--- a/src/packlib/hbook/hbook/hcpar0.inc
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: hcpar0.inc,v 1.1.1.1 1996/01/16 17:07:51 mclareni Exp $
-*
-* $Log: hcpar0.inc,v $
-* Revision 1.1.1.1 1996/01/16 17:07:51 mclareni
-* First import
-*
-*
-#ifndef CERNLIB_HBOOK_HCPAR0_INC
-#define CERNLIB_HBOOK_HCPAR0_INC
-*
-*
-* hcpar0.inc
-*
-*CMZ : 4.19/00 13/04/93 16.36.40 by Rene Brun
-*-- Author :
- REAL PNEF,PNBF,PSEL,PFLV,PLUN,PNBX,PNCX,FNIX,FEPS
- COMMON /HCPAR0/ PNEF,PNBF,PSEL,PFLV,PLUN,PNBX,PNCX,FNIX,FEPS
-*
-
-#endif
diff --git a/src/packlib/hbook/hbook/hcpar1.inc b/src/packlib/hbook/hbook/hcpar1.inc
deleted file mode 100644
index 443cadf..0000000
--- a/src/packlib/hbook/hbook/hcpar1.inc
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: hcpar1.inc,v 1.1.1.1 1996/01/16 17:07:51 mclareni Exp $
-*
-* $Log: hcpar1.inc,v $
-* Revision 1.1.1.1 1996/01/16 17:07:51 mclareni
-* First import
-*
-*
-#ifndef CERNLIB_HBOOK_HCPAR1_INC
-#define CERNLIB_HBOOK_HCPAR1_INC
-*
-*
-* hcpar1.inc
-*
-*CMZ : 4.19/00 13/04/93 16.36.40 by Rene Brun
-*-- Author :
- COMMON /HCPAR1/ IOPT(8),ND,NP,NPMAX,NBF,NBFMAX,NEF,NCO,NCOMAX
-*
-
-#endif
diff --git a/src/packlib/hbook/hbook/hcpar2.inc b/src/packlib/hbook/hbook/hcpar2.inc
deleted file mode 100644
index 0179373..0000000
--- a/src/packlib/hbook/hbook/hcpar2.inc
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: hcpar2.inc,v 1.1.1.1 1996/01/16 17:07:51 mclareni Exp $
-*
-* $Log: hcpar2.inc,v $
-* Revision 1.1.1.1 1996/01/16 17:07:51 mclareni
-* First import
-*
-*
-#ifndef CERNLIB_HBOOK_HCPAR2_INC
-#define CERNLIB_HBOOK_HCPAR2_INC
-*
-*
-* hcpar2.inc
-*
-*CMZ : 4.19/00 13/04/93 16.36.40 by Rene Brun
-*-- Author :
- COMMON /HCPAR2/ COEFF(50),IBASFT(10,50),XMIN(10),XMAX(10),
- + ALIM(10),BLIM(10)
-*
-
-#endif
diff --git a/src/packlib/hbook/hbook/hcpiaf.inc b/src/packlib/hbook/hbook/hcpiaf.inc
deleted file mode 100644
index 1ef668d..0000000
--- a/src/packlib/hbook/hbook/hcpiaf.inc
+++ /dev/null
@@ -1,62 +0,0 @@
-*
-* $Id: hcpiaf.inc,v 1.1.1.1 1996/01/16 17:07:51 mclareni Exp $
-*
-* $Log: hcpiaf.inc,v $
-* Revision 1.1.1.1 1996/01/16 17:07:51 mclareni
-* First import
-*
-*
-#ifndef CERNLIB_HBOOK_HCPIAF_INC
-#define CERNLIB_HBOOK_HCPIAF_INC
-*
-*
-* hcpiaf.inc
-*
-*CMZ : 4.21/08 01/02/94 11.41.10 by Fons Rademakers
-*-- Author : Fons Rademakers 15/04/93
-*--- shared between HBOOK and PAW
- PARAMETER (MXSLPF = 32)
- COMMON/HCPIAF/NTPIAF
- + ,CONNPF,SERVPF,MASTPF,SLAVPF,CLINPF,CLUTPF,LOGLPF
- + ,NSLAVE,NSLBAD,NSLVPF,SLINPF(MXSLPF),SLUTPF(MXSLPF)
- + ,NGSIZE, MYSID, SMASK, SRIN, SROUT, SVMIO, STUSER
- + ,STCPU, MASPID
- COMMON/HCPIA1/SLHOPF(MXSLPF), SLHBAD(MXSLPF), PIAFRC
-*--- flag set by HGETNT if the current Ntuple is on Piaf server
- LOGICAL NTPIAF
-*--- flag if Piaf server is connected
- LOGICAL CONNPF
-*--- flag if this is a server (master or slave)
- LOGICAL SERVPF
-*--- flag if this is the master server
- LOGICAL MASTPF
-*--- flag if this is a slave server
- LOGICAL SLAVPF
-*--- sockets between client and master server
- INTEGER CLINPF, CLUTPF
-*--- log level of diagnostic output
- INTEGER LOGLPF
-*--- number of active slaves and mask used by the select (PSELCT) function
- INTEGER NSLAVE, SMASK
-*--- number of running slave servers and sockets between master and slaves
- INTEGER NSLVPF, SLINPF, SLUTPF
-*--- hosts on which slaves are running
- CHARACTER*16 SLHOPF
-*--- number hosts on which no slaves can be run
- INTEGER NSLBAD
-*--- hosts on which no slaves can be run
- CHARACTER*16 SLHBAD
-*--- current slave group view: group size and unique slave id
- INTEGER NGSIZE, MYSID
-*--- pid of the master server (used by slave servers)
- INTEGER MASPID
-*--- authentication record
- CHARACTER*64 PIAFRC
-*--- IO and CPU usage of all slaves
- REAL SRIN, SROUT, SVMIO, STUSER, STCPU
-*--- Work space
- COMMON/HCPIAC/CHSMPF, CHLMPF
- CHARACTER CHSMPF*80, CHLMPF*256
-*
-
-#endif
diff --git a/src/packlib/hbook/hbook/hcpout.inc b/src/packlib/hbook/hbook/hcpout.inc
deleted file mode 100644
index f53cdbc..0000000
--- a/src/packlib/hbook/hbook/hcpout.inc
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: hcpout.inc,v 1.1.1.1 1996/01/16 17:07:51 mclareni Exp $
-*
-* $Log: hcpout.inc,v $
-* Revision 1.1.1.1 1996/01/16 17:07:51 mclareni
-* First import
-*
-*
-#ifndef CERNLIB_HBOOK_HCPOUT_INC
-#define CERNLIB_HBOOK_HCPOUT_INC
-*
-*
-* hcpout.inc
-*
-*CMZ : 4.19/00 13/04/93 16.36.40 by Rene Brun
-*-- Author :
- COMMON /HCPOUT/ IFLAG,RSSS,R2S,SECO(50),COMIN(50),COMAX(50)
-*
-
-#endif
diff --git a/src/packlib/hbook/hbook/hcprin.inc b/src/packlib/hbook/hbook/hcprin.inc
deleted file mode 100644
index 3c11002..0000000
--- a/src/packlib/hbook/hbook/hcprin.inc
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: hcprin.inc,v 1.1.1.1 1996/01/16 17:07:51 mclareni Exp $
-*
-* $Log: hcprin.inc,v $
-* Revision 1.1.1.1 1996/01/16 17:07:51 mclareni
-* First import
-*
-*
-#ifndef CERNLIB_HBOOK_HCPRIN_INC
-#define CERNLIB_HBOOK_HCPRIN_INC
-*
-*
-* hcprin.inc
-*
-*CMZ : 4.22/04 02/06/94 14.29.18 by Rene Brun
-*-- Author :
- INTEGER IFW ,NW ,NB ,IH ,NHT ,ICN ,IPONCE,
- + NH ,MSTEP ,NOENT ,NOLD ,IDOLAR,IBLANC,KBINSZ,INO ,
- + KSQUEZ,NCOLMA,NCOLPA,NLINPA, ICBLAC,ICSTAR,ICFUNC,
- + IDG(42),MAXBIT(30),IDENT(9)
- REAL BIGP
-*
- COMMON/HCPRIN/IFW ,NW ,NB ,IH ,NHT ,ICN ,IPONCE,
- + NH ,MSTEP ,NOENT ,NOLD ,IDOLAR,IBLANC,KBINSZ,INO ,
- + KSQUEZ,NCOLMA,NCOLPA,NLINPA,BIGP ,ICBLAC,ICSTAR,ICFUNC,
- + IDG ,MAXBIT,IDENT
-*
-
-#endif
diff --git a/src/packlib/hbook/hbook/hcqcom.inc b/src/packlib/hbook/hbook/hcqcom.inc
deleted file mode 100644
index 63d3548..0000000
--- a/src/packlib/hbook/hbook/hcqcom.inc
+++ /dev/null
@@ -1,151 +0,0 @@
-*
-* $Id: hcqcom.inc,v 1.1.1.1 1996/01/16 17:07:53 mclareni Exp $
-*
-* $Log: hcqcom.inc,v $
-* Revision 1.1.1.1 1996/01/16 17:07:53 mclareni
-* First import
-*
-*
-#ifndef CERNLIB_HBOOK_HCQCOM_INC
-#define CERNLIB_HBOOK_HCQCOM_INC
-*
-*
-* hcqcom.inc
-*
-*CMZ : 4.19/00 13/04/93 16.36.40 by Rene Brun
-*-- Author :
-* Basic parameters and data for multiquadric fit.
-* VPRINT is true if verbose option selected.
- LOGICAL VPRINT
-* NTUPLE is .TRUE. if ntuple is being processed, otherwise .FALSE.
- LOGICAL NTUPLE
-* IMQFUN function flag: = 0, no function evaluated yet.
-* = 1, linear sum of multiquadrics.
-* = 2, exponential of linear sum of multiquadrics.
-* (Note: HQF... routines take account of this, HQD... always calculate the
-* simple sum of multiquadrics.)
- INTEGER IMQFUN
-* IDMQ stores current histogram no. when required.
- INTEGER IDMQ
-* JMQ, KMQ store current multiquadric basis function nos. when required.
- INTEGER JMQ, KMQ
-* NSIG is number of significant points.
- INTEGER NSIG
-* NFREE is number of free parameters in the fitting (often equal to NSIG).
- INTEGER NFREE
-* Limits and recommended values of no. of significant points.
- INTEGER NSMIN, NSMIN1, NSMIN2, NSMIN3, NSREC1, NSREC2, NSREC3
- PARAMETER (NSMIN1 = 5, NSMIN2 = 10, NSMIN3 = 10)
- PARAMETER (NSREC1 = 15, NSREC2 = 50, NSREC3 = 50)
-* NSMAX its maximum no. of significant points.
- INTEGER NSMAX
- PARAMETER (NSMAX = 500)
-* NDIM is the number of dimensions - NDMAX is its maximum.
- INTEGER NDIM, NDMAX
- PARAMETER (NDMAX = 3)
-* NDIMC is dimensionality of data currently under consideration (<= NDIM).
-* NDIMWH is which of the NDIM1 dimensions are currently being considered.
- INTEGER NDIMC, NDIMWH (NDMAX)
-* NBINS is no. of bins in each coordinate, NBTOT the total
-* no. of bins in current histogram.
- INTEGER NBINS (NDMAX)
- INTEGER NX, NY, NZ, NBTOT
- EQUIVALENCE (NX, NBINS (1)), (NY, NBINS (2)), (NZ, NBINS (3))
-* Similarly, NBINSN is no. of bins for which first significant points where
-* found when surveying Ntuple data.
- INTEGER NBINSN (NDMAX)
- INTEGER NXN, NYN, NZN
- EQUIVALENCE (NXN, NBINSN (1)), (NYN, NBINSN (2)),
- +(NZN, NBINSN (3))
-* NNBINn is no. of bins used to bin ntuple data in n-dimensions.
- INTEGER NNBIN1, NNBIN2, NNBIN3
- PARAMETER (NNBIN1 = 100, NNBIN2 = 40, NNBIN3 = 40)
-* NMQEVS is no. of events (see also WMQEVS).
- INTEGER NMQEVS
-* NMQFUL is no. of histogram bins with non-zero content.
- INTEGER NMQFUL
-* NINTVS, NQUADS are no. of intervals and no. of gaussian quadrature points
-* per interval for integration of multiquadric functions.
- INTEGER NINTVS, NQUADS
- PARAMETER (NINTVS = 50, NQUADS = 8)
-* LAREA is working space for ZEBRA link maintenance.
-* LHQUAD is pointer to parent bank in Q in /PAWC/ in SEQ HCBOOK.
-* (For bank structure see HQINIT header.)
-* LnH and LnV are pointers to current n-D histogram contents and variances.
-* LHQCOV is pointer to covariances.
-* LHQDER is working bank for double derivatives.
-* LHQWK1/2.. are more working banks.
-* LHQDJN is pointer to temporary bank holding function values.
-* LLAST is a dummy pointer - always last!
- INTEGER LAREA (2), LHQUAD, L1H, L1V, L2H, L2V, L3H, L3V,
- +LHQCOV, LHQDER, LHQWK1, LHQWK2, LHQWK3,
- +LHQDJN, LLAST
-*
-* SIGGRD contains the gradient of the function with respect to the strengths.
-* SIGDEN the (approximate) density of the function at the significant point.
- REAL SIGGRD (NSMAX)
- REAL SIGDEN (NSMAX)
-* SIGV contains significant points' coordinate vectors.
- REAL SIGV (NSMAX, NDMAX)
- REAL SIGX (NSMAX), SIGY (NSMAX), SIGZ (NSMAX)
- EQUIVALENCE (SIGX, SIGV), (SIGY, SIGV (1, 2)), (SIGZ, SIGV (1, 3))
-* SIGDEL contains the scale parameter Delta for each coordinate.
- REAL SIGDEL (NSMAX)
-* SIGVMI, SIGVMA, SIGVBI, SIGVT are lower and upper limits, bin size
-* and total range.
- REAL SIGVMI (NDMAX), SIGVMA (NDMAX), SIGVBI (NDMAX), SIGVT (NDMAX)
- REAL XMI, XMA, DX, DXT, YMI, YMA, DY, DYT, ZMI, ZMA, DZ, DZT
- EQUIVALENCE (XMI, SIGVMI (1)), (XMA, SIGVMA (1))
- EQUIVALENCE (DX, SIGVBI (1)), (DXT, SIGVT (1))
- EQUIVALENCE (YMI, SIGVMI (2)), (YMA, SIGVMA (2))
- EQUIVALENCE (DY, SIGVBI (2)), (DYT, SIGVT (2))
- EQUIVALENCE (ZMI, SIGVMI (3)), (ZMA, SIGVMA (3))
- EQUIVALENCE (DZ, SIGVBI (3)), (DZT, SIGVT (3))
-* BINV is used to store current coordinates - usually bin centres, but can
-* be edges 0. or 1.
- REAL BINV (NDMAX)
- REAL XBIN, YBIN, ZBIN
- EQUIVALENCE (XBIN, BINV (1)), (YBIN, BINV (2)), (ZBIN, BINV (3))
-* VOLTOT is total "volume" and VOLBIN is "volume" of bin in current histogram.
- REAL VOLTOT, VOLBIN
-* WMQEVS is weighted no. of events (see also NMQEVS).
- REAL WMQEVS
-* VSCALE scales variances (only if incorrectly assigned errors suspected).
- REAL VSCALE
-* VMEAN1, VMEAN2 are mean variance per histogram entry and its square.
- REAL VMEAN1, VMEAN2
-* VCONST is a constant multiplying exponential of sum of multiquadrics for
-* Poisson likelihood fitting.
- REAL VCONST
-* SENSIT is a sensitivity parameter - normally 1 - which controls the
-* selection of significant points.
- REAL SENSIT
-* SLCUT is current value of cut for Laplacian significance.
- REAL SLCUT
-* SLRMS is rms of Laplacian significance.
- REAL SLRMS
-* SPREAD is a smoothness parameter - normally 1 - which multiplies the
-* scale parameter (radius of curvature).
- REAL SPREAD
-* SMALLD is a "small" value of the multiquadric parameter DELTA for edges, etc.
-* (usually set to 1.E-6 in HQUAD, HQUADN).
- REAL SMALLD
-* HQMIN, HQMAX, HQFMIN, HQFMAX are current minimum and maximum bin heights and
-* function values (at bin centres).
- REAL HQMIN, HQMAX, HQFMIN, HQFMAX
-*
- COMMON /HCQCOM/ SIGGRD, SIGDEN, SIGV, SIGDEL,
- + SIGVMI, SIGVMA, SIGVBI, SIGVT,
- + BINV, VOLTOT, VOLBIN, WMQEVS, VSCALE, VMEAN1, VMEAN2,
- + VCONST, SENSIT, SLCUT, SLRMS, SPREAD, SMALLD,
- + HQMIN, HQMAX, HQFMIN, HQFMAX,
- + IMQFUN, IDMQ, JMQ, KMQ,
- + NSIG, NFREE, NSMIN, NDIM, NDIMC, NDIMWH,
- + NBINS, NBTOT, NBINSN, NMQEVS, NMQFUL,
- + LAREA, LHQUAD, L1H, L1V, L2H, L2V, L3H, L3V,
- + LHQCOV, LHQDER, LHQWK1, LHQWK2, LHQWK3,
- + LHQDJN, LLAST,
- + VPRINT, NTUPLE
-
-
-#endif
diff --git a/src/packlib/hbook/hbook/hcqcor.inc b/src/packlib/hbook/hbook/hcqcor.inc
deleted file mode 100644
index cacb479..0000000
--- a/src/packlib/hbook/hbook/hcqcor.inc
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: hcqcor.inc,v 1.1.1.1 1996/01/16 17:07:53 mclareni Exp $
-*
-* $Log: hcqcor.inc,v $
-* Revision 1.1.1.1 1996/01/16 17:07:53 mclareni
-* First import
-*
-*
-#ifndef CERNLIB_HBOOK_HCQCOR_INC
-#define CERNLIB_HBOOK_HCQCOR_INC
-*
-*
-* hcqcor.inc
-*
-*CMZ : 4.19/00 13/04/93 16.36.40 by Rene Brun
-*-- Author :
-#if !defined(CERNLIB_DOUBLE)
-#include "hbook/hcqcor1.inc"
-#endif
-#if defined(CERNLIB_DOUBLE)
-#include "hbook/hcqcor2.inc"
-#endif
-
-#endif
diff --git a/src/packlib/hbook/hbook/hcqcor1.inc b/src/packlib/hbook/hbook/hcqcor1.inc
deleted file mode 100644
index fb2c22e..0000000
--- a/src/packlib/hbook/hbook/hcqcor1.inc
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: hcqcor1.inc,v 1.1.1.1 1996/01/16 17:07:53 mclareni Exp $
-*
-* $Log: hcqcor1.inc,v $
-* Revision 1.1.1.1 1996/01/16 17:07:53 mclareni
-* First import
-*
-*
-#ifndef CERNLIB_HBOOK_HCQCOR1_INC
-#define CERNLIB_HBOOK_HCQCOR1_INC
-*
-*
-* hcqcor1.inc
-*
-*CMZ : 4.19/00 13/04/93 16.36.40 by Rene Brun
-*-- Author :
-* SIGA contains the coefficients of the multiquadric basis functions.
- REAL SIGA (NSMAX)
- COMMON /HCQCOR/ SIGA
-
-#endif
diff --git a/src/packlib/hbook/hbook/hcqcor2.inc b/src/packlib/hbook/hbook/hcqcor2.inc
deleted file mode 100644
index a3398ea..0000000
--- a/src/packlib/hbook/hbook/hcqcor2.inc
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: hcqcor2.inc,v 1.1.1.1 1996/01/16 17:07:53 mclareni Exp $
-*
-* $Log: hcqcor2.inc,v $
-* Revision 1.1.1.1 1996/01/16 17:07:53 mclareni
-* First import
-*
-*
-#ifndef CERNLIB_HBOOK_HCQCOR2_INC
-#define CERNLIB_HBOOK_HCQCOR2_INC
-*
-*
-* hcqcor2.inc
-*
-*CMZ : 4.19/00 13/04/93 16.36.40 by Rene Brun
-*-- Author :
-* SIGA contains the coefficients of the multiquadric basis functions.
- DOUBLE PRECISION SIGA (NSMAX)
- COMMON /HCQCOD/ SIGA
-
-
-#endif
diff --git a/src/packlib/hbook/hbook/hcrecv.inc b/src/packlib/hbook/hbook/hcrecv.inc
deleted file mode 100644
index 5f8e88c..0000000
--- a/src/packlib/hbook/hbook/hcrecv.inc
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: hcrecv.inc,v 1.1.1.1 1996/01/16 17:07:50 mclareni Exp $
-*
-* $Log: hcrecv.inc,v $
-* Revision 1.1.1.1 1996/01/16 17:07:50 mclareni
-* First import
-*
-*
-#ifndef CERNLIB_HBOOK_HCRECV_INC
-#define CERNLIB_HBOOK_HCRECV_INC
-*
-*
-* hcrecv.inc
-*
-*CMZ : 4.20/05 19/08/93 11.48.32 by Rene Brun
-*-- Author : Fons Rademakers 25/05/93
- LOGICAL NRECOV
- COMMON /HCRECV/ NRECOV
-*
-
-#endif
diff --git a/src/packlib/hbook/hbook/hcrlf.inc b/src/packlib/hbook/hbook/hcrlf.inc
deleted file mode 100644
index 53e37bd..0000000
--- a/src/packlib/hbook/hbook/hcrlf.inc
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: hcrlf.inc,v 1.1.1.1 1996/01/16 17:07:51 mclareni Exp $
-*
-* $Log: hcrlf.inc,v $
-* Revision 1.1.1.1 1996/01/16 17:07:51 mclareni
-* First import
-*
-*
-#ifndef CERNLIB_HBOOK_HCRLF_INC
-#define CERNLIB_HBOOK_HCRLF_INC
-*
-*
-* hcrlf.inc
-*
-*CMZ : 4.20/13 21/10/93 15.01.47 by Rene Brun
-*-- Author : Rene Brun 19/04/93
- CHARACTER*1 CRLF
-#if (!defined(CERNLIB_MSDOS))&&(!defined(CERNLIB_WINNT))
-#include "hbook/hcrlf1.inc"
-#endif
-#if defined(CERNLIB_MSDOS)||defined(CERNLIB_WINNT)
-#include "hbook/hcrlf2.inc"
-#endif
-
-#endif
diff --git a/src/packlib/hbook/hbook/hcrlf1.inc b/src/packlib/hbook/hbook/hcrlf1.inc
deleted file mode 100644
index 8468314..0000000
--- a/src/packlib/hbook/hbook/hcrlf1.inc
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: hcrlf1.inc,v 1.1.1.1 1996/01/16 17:07:51 mclareni Exp $
-*
-* $Log: hcrlf1.inc,v $
-* Revision 1.1.1.1 1996/01/16 17:07:51 mclareni
-* First import
-*
-*
-#ifndef CERNLIB_HBOOK_HCRLF1_INC
-#define CERNLIB_HBOOK_HCRLF1_INC
-*
-*
-* hcrlf1.inc
-*
-*CMZ : 4.19/00 19/04/93 10.16.13 by Rene Brun
-*-- Author : Rene Brun 19/04/93
- PARAMETER (CRLF='1')
-
-#endif
diff --git a/src/packlib/hbook/hbook/hcrlf2.inc b/src/packlib/hbook/hbook/hcrlf2.inc
deleted file mode 100644
index a65f824..0000000
--- a/src/packlib/hbook/hbook/hcrlf2.inc
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: hcrlf2.inc,v 1.1.1.1 1996/01/16 17:07:51 mclareni Exp $
-*
-* $Log: hcrlf2.inc,v $
-* Revision 1.1.1.1 1996/01/16 17:07:51 mclareni
-* First import
-*
-*
-#ifndef CERNLIB_HBOOK_HCRLF2_INC
-#define CERNLIB_HBOOK_HCRLF2_INC
-*
-*
-* hcrlf2.inc
-*
-*CMZ : 4.19/00 19/04/93 10.16.13 by Rene Brun
-*-- Author : Rene Brun 19/04/93
- PARAMETER (CRLF=CHAR(12))
-
-#endif
diff --git a/src/packlib/hbook/hbook/hcsave.inc b/src/packlib/hbook/hbook/hcsave.inc
deleted file mode 100644
index 4bcd4ca..0000000
--- a/src/packlib/hbook/hbook/hcsave.inc
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: hcsave.inc,v 1.1.1.1 1996/01/16 17:07:51 mclareni Exp $
-*
-* $Log: hcsave.inc,v $
-* Revision 1.1.1.1 1996/01/16 17:07:51 mclareni
-* First import
-*
-*
-#ifndef CERNLIB_HBOOK_HCSAVE_INC
-#define CERNLIB_HBOOK_HCSAVE_INC
-*
-*
-* hcsave.inc
-*
-*CMZ : 4.19/02 14/05/93 12.46.14 by Fons Rademakers
-*-- Author : Fons Rademakers 14/05/93
- LOGICAL NTSAVE
- COMMON /HCSAVE/ NTSAVE
-*
-
-#endif
diff --git a/src/packlib/hbook/hbook/hcset.inc b/src/packlib/hbook/hbook/hcset.inc
deleted file mode 100644
index 87ed307..0000000
--- a/src/packlib/hbook/hbook/hcset.inc
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: hcset.inc,v 1.1.1.1 1996/01/16 17:07:52 mclareni Exp $
-*
-* $Log: hcset.inc,v $
-* Revision 1.1.1.1 1996/01/16 17:07:52 mclareni
-* First import
-*
-*
-#ifndef CERNLIB_HBOOK_HCSET_INC
-#define CERNLIB_HBOOK_HCSET_INC
-*
-*
-* hcset.inc
-*
-*CMZ : 4.19/00 13/04/93 16.36.40 by Rene Brun
-*-- Author :
- COMMON /HCSET/ IBSIZE
-*
-
-#endif
diff --git a/src/packlib/hbook/hbook/hctit.inc b/src/packlib/hbook/hbook/hctit.inc
deleted file mode 100644
index 38942b9..0000000
--- a/src/packlib/hbook/hbook/hctit.inc
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: hctit.inc,v 1.1.1.1 1996/01/16 17:07:51 mclareni Exp $
-*
-* $Log: hctit.inc,v $
-* Revision 1.1.1.1 1996/01/16 17:07:51 mclareni
-* First import
-*
-*
-#ifndef CERNLIB_HBOOK_HCTIT_INC
-#define CERNLIB_HBOOK_HCTIT_INC
-*
-*
-* hctit.inc
-*
-*CMZ : 4.19/00 13/04/93 16.36.40 by Rene Brun
-*-- Author :
- COMMON/HCTIT/LTIT(40)
-*
-
-#endif
diff --git a/src/packlib/hbook/hbook/hcunit.inc b/src/packlib/hbook/hbook/hcunit.inc
deleted file mode 100644
index e965f13..0000000
--- a/src/packlib/hbook/hbook/hcunit.inc
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: hcunit.inc,v 1.1.1.1 1996/01/16 17:07:51 mclareni Exp $
-*
-* $Log: hcunit.inc,v $
-* Revision 1.1.1.1 1996/01/16 17:07:51 mclareni
-* First import
-*
-*
-#ifndef CERNLIB_HBOOK_HCUNIT_INC
-#define CERNLIB_HBOOK_HCUNIT_INC
-*
-*
-* hcunit.inc
-*
-*CMZ : 4.20/00 17/06/93 13.11.59 by Rene Brun
-*-- Author :
- INTEGER LOUT,LERR,LINFIT
- COMMON/HCUNIT/LOUT,LERR,LINFIT
-*
-
-#endif
diff --git a/src/packlib/hbook/hbook/hcvers.inc b/src/packlib/hbook/hbook/hcvers.inc
deleted file mode 100644
index 52ac2d6..0000000
--- a/src/packlib/hbook/hbook/hcvers.inc
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: hcvers.inc,v 1.2 1998/11/10 09:20:08 couet Exp $
-*
-* $Log: hcvers.inc,v $
-* Revision 1.2 1998/11/10 09:20:08 couet
-* - common HCVERC added to store the date with the millenium
-*
-* Revision 1.1.1.1 1996/01/16 17:07:51 mclareni
-* First import
-*
-*
-#ifndef CERNLIB_HBOOK_HCVERS_INC
-#define CERNLIB_HBOOK_HCVERS_INC
-*
-*
-* hcvers.inc
-*
-*-- Author : Rene Brun
- INTEGER INSTAL(20),IVERS(5),IDATE(8)
- CHARACTER*10 CHDATE
- COMMON/HCVERS/INSTAL,IVERS,IDATE
- COMMON/HCVERC/CHDATE
-*
-#endif
diff --git a/src/packlib/hbook/hbook/hmac1.inc b/src/packlib/hbook/hbook/hmac1.inc
deleted file mode 100644
index d817638..0000000
--- a/src/packlib/hbook/hbook/hmac1.inc
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: hmac1.inc,v 1.1.1.1 1996/01/16 17:07:52 mclareni Exp $
-*
-* $Log: hmac1.inc,v $
-* Revision 1.1.1.1 1996/01/16 17:07:52 mclareni
-* First import
-*
-*
-#ifndef CERNLIB_HBOOK_HMAC1_INC
-#define CERNLIB_HBOOK_HMAC1_INC
-*
-*
-* hmac1.inc
-*
-*CMZ : 4.19/00 13/04/93 16.36.40 by Rene Brun
-*-- Author :
- PARAMETER (MBIT=60,MBITCH=6,MOUT=L"OUTPUT",HMBIGP=1.E+200)
-
-#endif
diff --git a/src/packlib/hbook/hbook/hmac2.inc b/src/packlib/hbook/hbook/hmac2.inc
deleted file mode 100644
index fa138ad..0000000
--- a/src/packlib/hbook/hbook/hmac2.inc
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: hmac2.inc,v 1.1.1.1 1996/01/16 17:07:52 mclareni Exp $
-*
-* $Log: hmac2.inc,v $
-* Revision 1.1.1.1 1996/01/16 17:07:52 mclareni
-* First import
-*
-*
-#ifndef CERNLIB_HBOOK_HMAC2_INC
-#define CERNLIB_HBOOK_HMAC2_INC
-*
-*
-* hmac2.inc
-*
-*CMZ : 4.19/00 13/04/93 16.36.40 by Rene Brun
-*-- Author :
- PARAMETER (MBIT=32,MBITCH=8,MOUT=6,HMBIGP=1.E+60)
-
-#endif
diff --git a/src/packlib/hbook/hbook/hmac3.inc b/src/packlib/hbook/hbook/hmac3.inc
deleted file mode 100644
index 326cbcd..0000000
--- a/src/packlib/hbook/hbook/hmac3.inc
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: hmac3.inc,v 1.1.1.1 1996/01/16 17:07:52 mclareni Exp $
-*
-* $Log: hmac3.inc,v $
-* Revision 1.1.1.1 1996/01/16 17:07:52 mclareni
-* First import
-*
-*
-#ifndef CERNLIB_HBOOK_HMAC3_INC
-#define CERNLIB_HBOOK_HMAC3_INC
-*
-*
-* hmac3.inc
-*
-*CMZ : 4.19/00 13/04/93 16.36.40 by Rene Brun
-*-- Author :
- PARAMETER (MBIT=36,MBITCH=9,MOUT=2,HMBIGP=1.E+38)
-
-#endif
diff --git a/src/packlib/hbook/hbook/hmac4.inc b/src/packlib/hbook/hbook/hmac4.inc
deleted file mode 100644
index 5972273..0000000
--- a/src/packlib/hbook/hbook/hmac4.inc
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: hmac4.inc,v 1.1.1.1 1996/01/16 17:07:52 mclareni Exp $
-*
-* $Log: hmac4.inc,v $
-* Revision 1.1.1.1 1996/01/16 17:07:52 mclareni
-* First import
-*
-*
-#ifndef CERNLIB_HBOOK_HMAC4_INC
-#define CERNLIB_HBOOK_HMAC4_INC
-*
-*
-* hmac4.inc
-*
-*CMZ : 4.19/00 13/04/93 16.36.40 by Rene Brun
-*-- Author :
- PARAMETER (MBIT=32,MBITCH=8,MOUT=6,HMBIGP=1.E+36)
-
-#endif
diff --git a/src/packlib/hbook/hbook/hmac5.inc b/src/packlib/hbook/hbook/hmac5.inc
deleted file mode 100644
index 6de8e9b..0000000
--- a/src/packlib/hbook/hbook/hmac5.inc
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: hmac5.inc,v 1.1.1.1 1996/01/16 17:07:52 mclareni Exp $
-*
-* $Log: hmac5.inc,v $
-* Revision 1.1.1.1 1996/01/16 17:07:52 mclareni
-* First import
-*
-*
-#ifndef CERNLIB_HBOOK_HMAC5_INC
-#define CERNLIB_HBOOK_HMAC5_INC
-*
-*
-* hmac5.inc
-*
-*CMZ : 4.19/00 13/04/93 16.36.40 by Rene Brun
-*-- Author :
- PARAMETER (MBIT=64,MBITCH=8,MOUT=6,HMBIGP=1.E+200)
-
-#endif
diff --git a/src/packlib/hbook/hbook/hmac6.inc b/src/packlib/hbook/hbook/hmac6.inc
deleted file mode 100644
index a5513b5..0000000
--- a/src/packlib/hbook/hbook/hmac6.inc
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: hmac6.inc,v 1.1.1.1 1996/01/16 17:07:52 mclareni Exp $
-*
-* $Log: hmac6.inc,v $
-* Revision 1.1.1.1 1996/01/16 17:07:52 mclareni
-* First import
-*
-*
-#ifndef CERNLIB_HBOOK_HMAC6_INC
-#define CERNLIB_HBOOK_HMAC6_INC
-*
-*
-* hmac6.inc
-*
-*CMZ : 4.19/00 13/04/93 16.36.40 by Rene Brun
-*-- Author :
- PARAMETER (MBIT=32,MBITCH=8,MOUT=6,HMBIGP=1.E+30)
-
-#endif
diff --git a/src/packlib/hbook/hbook/hmachine.inc b/src/packlib/hbook/hbook/hmachine.inc
deleted file mode 100644
index 70638c8..0000000
--- a/src/packlib/hbook/hbook/hmachine.inc
+++ /dev/null
@@ -1,37 +0,0 @@
-*
-* $Id: hmachine.inc,v 1.1.1.1 1996/01/16 17:07:52 mclareni Exp $
-*
-* $Log: hmachine.inc,v $
-* Revision 1.1.1.1 1996/01/16 17:07:52 mclareni
-* First import
-*
-*
-#ifndef CERNLIB_HBOOK_HMACHINE_INC
-#define CERNLIB_HBOOK_HMACHINE_INC
-*
-*
-* hmachine.inc
-*
-*CMZ : 4.19/00 19/04/93 09.58.06 by Rene Brun
-*-- Author :
-#if defined(CERNLIB_CDC)
-#include "hbook/hmac1.inc"
-#endif
-#if defined(CERNLIB_IBM)||defined(CERNLIB_NORD)
-#include "hbook/hmac2.inc"
-#endif
-#if defined(CERNLIB_UNIVAC)
-#include "hbook/hmac3.inc"
-#endif
-#if defined(CERNLIB_VAX)
-#include "hbook/hmac4.inc"
-#endif
-#if (defined(CERNLIB_CRAY)||defined(CERNLIB_CONVEX)||defined(CERNLIB_UNIX))&&(!defined(CERNLIB_DOUBLE))
-#include "hbook/hmac5.inc"
-#endif
-#if (defined(CERNLIB_UNIX))&&(defined(CERNLIB_DOUBLE))
-#include "hbook/hmac6.inc"
-#endif
-
-
-#endif
diff --git a/src/packlib/hbook/hbook/hntcur.inc b/src/packlib/hbook/hbook/hntcur.inc
deleted file mode 100644
index b86fc23..0000000
--- a/src/packlib/hbook/hbook/hntcur.inc
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: hntcur.inc,v 1.1.1.1 1996/01/16 17:07:52 mclareni Exp $
-*
-* $Log: hntcur.inc,v $
-* Revision 1.1.1.1 1996/01/16 17:07:52 mclareni
-* First import
-*
-*
-#ifndef CERNLIB_HBOOK_HNTCUR_INC
-#define CERNLIB_HBOOK_HNTCUR_INC
-*
-*
-* hntcur.inc
-*
-*CMZ : 4.19/00 13/04/93 16.36.40 by Rene Brun
-*-- Author :
- COMMON /HNTCUR/ NTCUR
-*
-
-#endif
diff --git a/src/packlib/hbook/hbook/jbyt.inc b/src/packlib/hbook/hbook/jbyt.inc
deleted file mode 100644
index 06cbedb..0000000
--- a/src/packlib/hbook/hbook/jbyt.inc
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: jbyt.inc,v 1.1.1.1 1996/01/16 17:07:53 mclareni Exp $
-*
-* $Log: jbyt.inc,v $
-* Revision 1.1.1.1 1996/01/16 17:07:53 mclareni
-* First import
-*
-*
-#ifndef CERNLIB_HBOOK_JBYT_INC
-#define CERNLIB_HBOOK_JBYT_INC
-*
-*
-* jbyt.inc
-*
-*CMZ : 4.21/08 14/02/94 10.53.41 by Rene Brun
-*-- Author :
-#if defined(CERNLIB_VAX)||defined(CERNLIB_ALLIANT)
-#include "hbook/jbyt1.inc"
-#endif
-#if (defined(CERNLIB_IBM)||defined(CERNLIB_NORD)||defined(CERNLIB_CRAY)||defined(CERNLIB_CDC)||defined(CERNLIB_UNIX))&&(!defined(CERNLIB_ALLIANT))&&(!defined(CERNLIB_MSDOS))&&(!defined(CERNLIB_WINNT))
-#include "hbook/jbyt2.inc"
-#endif
-#if (defined(CERNLIB_MSDOS))&&(defined(CERNLIB_NDP))
-#include "hbook/jbyt3.inc"
-#endif
-#if (defined(CERNLIB_MSDOS)||defined(CERNLIB_WINNT))&&(defined(CERNLIB_QF2C))
-#include "hbook/jbyt4.inc"
-#endif
-
-
-#endif
diff --git a/src/packlib/hbook/hbook/jbyt1.inc b/src/packlib/hbook/hbook/jbyt1.inc
deleted file mode 100644
index 0d32a35..0000000
--- a/src/packlib/hbook/hbook/jbyt1.inc
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: jbyt1.inc,v 1.1.1.1 1996/01/16 17:07:52 mclareni Exp $
-*
-* $Log: jbyt1.inc,v $
-* Revision 1.1.1.1 1996/01/16 17:07:52 mclareni
-* First import
-*
-*
-#ifndef CERNLIB_HBOOK_JBYT1_INC
-#define CERNLIB_HBOOK_JBYT1_INC
-*
-*
-* jbyt1.inc
-*
-*CMZ : 4.19/00 13/04/93 16.36.40 by Rene Brun
-*-- Author :
- JBYT (IZW,IZP,NZB) = JIBITS (IZW,IZP-1,NZB)
-
-#endif
diff --git a/src/packlib/hbook/hbook/jbyt2.inc b/src/packlib/hbook/hbook/jbyt2.inc
deleted file mode 100644
index f48c5af..0000000
--- a/src/packlib/hbook/hbook/jbyt2.inc
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: jbyt2.inc,v 1.1.1.1 1996/01/16 17:07:53 mclareni Exp $
-*
-* $Log: jbyt2.inc,v $
-* Revision 1.1.1.1 1996/01/16 17:07:53 mclareni
-* First import
-*
-*
-#ifndef CERNLIB_HBOOK_JBYT2_INC
-#define CERNLIB_HBOOK_JBYT2_INC
-*
-*
-* jbyt2.inc
-*
-*CMZ : 4.19/00 13/04/93 16.36.40 by Rene Brun
-*-- Author :
-*
-
-#endif
diff --git a/src/packlib/hbook/hbook/jbyt3.inc b/src/packlib/hbook/hbook/jbyt3.inc
deleted file mode 100644
index d8bf8ed..0000000
--- a/src/packlib/hbook/hbook/jbyt3.inc
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: jbyt3.inc,v 1.1.1.1 1996/01/16 17:07:53 mclareni Exp $
-*
-* $Log: jbyt3.inc,v $
-* Revision 1.1.1.1 1996/01/16 17:07:53 mclareni
-* First import
-*
-*
-#ifndef CERNLIB_HBOOK_JBYT3_INC
-#define CERNLIB_HBOOK_JBYT3_INC
-*
-*
-* jbyt3.inc
-*
-*CMZ : 4.19/00 19/04/93 09.55.52 by Rene Brun
-*-- Author :
-*
- JBIT (IZZW,IZZP) = IBITS (IZZW,IZZP-1,1)
- JBYT (IZZW,IZZP,NZZB) = IBITS (IZZW,IZZP-1,NZZB)
-
-#endif
diff --git a/src/packlib/hbook/hbook/jbyt4.inc b/src/packlib/hbook/hbook/jbyt4.inc
deleted file mode 100644
index b33afca..0000000
--- a/src/packlib/hbook/hbook/jbyt4.inc
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: jbyt4.inc,v 1.1.1.1 1996/01/16 17:07:53 mclareni Exp $
-*
-* $Log: jbyt4.inc,v $
-* Revision 1.1.1.1 1996/01/16 17:07:53 mclareni
-* First import
-*
-*
-#ifndef CERNLIB_HBOOK_JBYT4_INC
-#define CERNLIB_HBOOK_JBYT4_INC
-*
-*
-* jbyt4.inc
-*
-*CMZ : 4.19/00 19/04/93 09.55.52 by Rene Brun
-*-- Author :
-*
- JBIT (IZW,IZP) = AND(RSHIFT(IZW,IZP-1),1)
- JBYT (IZW,IZP,NZB) = ISHFTR(LSHIFT(IZW,33-IZP-NZB),32-NZB)
-
-#endif
diff --git a/src/packlib/hbook/hbook/pilot.h b/src/packlib/hbook/hbook/pilot.h
deleted file mode 100644
index 4d3a409..0000000
--- a/src/packlib/hbook/hbook/pilot.h
+++ /dev/null
@@ -1,108 +0,0 @@
-#if defined(CERNLIB_VAX)
-#if defined(CERNLIB_QMALPH)
-#ifndef CERNLIB_ALPHA
-#define CERNLIB_ALPHA
-#endif
-#endif
-#endif
-
-#if defined(CERNLIB_QMVAOS)
-#ifndef CERNLIB_ALPHA_OSF
-#define CERNLIB_ALPHA_OSF
-#ifndef CERNLIB_ALPHA
-#define CERNLIB_ALPHA
-#endif
-#endif
-#endif
-
-#if defined(CERNLIB_IBMMVS)||defined(CERNLIB_NEWLIB)
-#ifndef CERNLIB_IBM
-#define CERNLIB_IBM
-#endif
-#endif
-
-#if defined(CERNLIB_MSDOS)
-#ifndef CERNLIB_QF2C
-#define CERNLIB_QF2C
-#endif
-#endif
-
-#if defined(CERNLIB_IBM)||defined(CERNLIB_VAX)||defined(CERNLIB_NORD)||defined(CERNLIB_UNIVAC)
-#ifndef CERNLIB_DOUBLE
-#define CERNLIB_DOUBLE
-#endif
-#endif
-
-#if (defined(CERNLIB_UNIX))&&(!defined(CERNLIB_SINGLE))
-#ifndef CERNLIB_DOUBLE
-#define CERNLIB_DOUBLE
-#endif
-#endif
-
-#if defined(CERNLIB_UNIX)||defined(CERNLIB_GNU)||defined(CERNLIB_QMALPH)||defined(CERNLIB_WINNT)||defined(CERNLIB_QF2C)
-#ifndef CERNLIB_BSLASH
-#define CERNLIB_BSLASH
-#endif
-#endif
-
-#if (defined(CERNLIB_APOLLO)||defined(CERNLIB_VAX)||defined(CERNLIB_UNIX)||defined(CERNLIB_IBM))&&(!defined(CERNLIB_IPSC))&&(!defined(CERNLIB_MSDOS))
-#ifndef CERNLIB_CZ
-#define CERNLIB_CZ
-#endif
-#endif
-
-#if (defined(CERNLIB_APOLLO)||defined(CERNLIB_UNIX))&&(!defined(CERNLIB_CRAY))&&(!defined(CERNLIB_IPSC))&&(!defined(CERNLIB_MSDOS))
-#ifndef CERNLIB_HMMAP
-#define CERNLIB_HMMAP
-#endif
-#endif
-
-#if defined(CERNLIB_UNIX)||defined(CERNLIB_MSDOS)||(defined(CERNLIB_WINNT) && !defined(CERNLIB_MSSTDCALL))
-# ifndef CERNLIB_QX_SC
-# define CERNLIB_QX_SC
-# endif
-#endif
-
-#if defined(CERNLIB_APOLLO)||defined(CERNLIB_CONVEX)
-#ifndef CERNLIB_BSD
-#define CERNLIB_BSD
-#endif
-#endif
-
-#if defined(CERNLIB_SUN)
-# if defined(CERNLIB_SOLARIS)
-# ifndef CERNLIB_SYS5
-# define CERNLIB_SYS5
-# endif
-# else
-# ifndef CERNLIB_BSD
-# define CERNLIB_BSD
-# endif
-# endif
-#endif
-
-#if defined(CERNLIB_IBMRT)||defined(CERNLIB_DECS)||defined(CERNLIB_HPUX)||defined(CERNLIB_SGI)||defined(CERNLIB_AIX370)||defined(CERNLIB_IPSC)||defined(CERNLIB_LINUX)
-#ifndef CERNLIB_SYS5
-#define CERNLIB_SYS5
-#endif
-#endif
-
-#if defined(CERNLIB_IBM)||defined(CERNLIB_VAX)||defined(CERNLIB_AIX370)||defined(CERNLIB_NORD)||defined(CERNLIB_UNIVAC)
-#ifndef CERNLIB_NO_IEEE
-#define CERNLIB_NO_IEEE
-#endif
-
-#endif
-#ifdef CERNLIB_MSSTDCALL
-# define VISUAL_CPLUSPLUS
-# ifndef CERNLIB_QXCAPT
-# define CERNLIB_QXCAPT
-# endif
-# ifndef type_of_call
-# define type_of_call _stdcall
-# endif
-#endif
-
-#ifndef type_of_call
-# define type_of_call
-#endif
diff --git a/src/packlib/hbook/hdiff/Imakefile b/src/packlib/hbook/hdiff/Imakefile
deleted file mode 100644
index 3220371..0000000
--- a/src/packlib/hbook/hdiff/Imakefile
+++ /dev/null
@@ -1,4 +0,0 @@
-SRCS_F= hbnsum.F hdbaop.F hdbcop.F hdbini.F hdbprf.F hdbsop.F hdiff.F \ @@\
- hdiffb.F hgcont.F hlbino.F hlnfct.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/hbook/hdiff/hbnsum.F b/src/packlib/hbook/hdiff/hbnsum.F
deleted file mode 100644
index 5ed3b11..0000000
--- a/src/packlib/hbook/hdiff/hbnsum.F
+++ /dev/null
@@ -1,147 +0,0 @@
-*
-* $Id: hbnsum.F,v 1.1.1.1 1996/01/16 17:07:53 mclareni Exp $
-*
-* $Log: hbnsum.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:53 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.17/01 23/10/92 11.51.54 by R. J. Genik II
-*-- Author : R. J. Genik II 23/10/92
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION FUNCTION HBNSUM(NSTRT,NEND,NMAX,P,QQQ,ACCUR)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- REAL FUNCTION HBNSUM(NSTRT,NEND,NMAX,P,QQQ,ACCUR)
-#endif
-C----------------------------------------------------------------------
-C-
-C- Purpose and Methods : CALCULATE BINOMIAL DISTRIBUTION INTERVAL SUM
-C-
-C- Returned value : (DOUBLE PRECISION) SUM OF BINOMIAL TERMS
-C- BETWEEN NSTRT, NEND TO ACCUR ORDER
-C- Inputs : NSTRT,NEND : INTEGER; P,QQQ: DBLE PREC; ACCUR : REAL
-C- Outputs : NONE
-C- Controls: ACCUR ; Stops summing if rest of sum is smaller than
-C- requested accuracy.
-C-
-C- CREATED 22-OCT-1992 R. J. Genik II
-C----------------------------------------------------------------------
-C
-C Local and passed variable declarations
-C
-C----------------------------------------------------------------------
-C
- INTEGER NSTRT,NEND,NSTEP,NMAX,N,K
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION HLBINO, P,QQQ,DLNTRM,DLAST,DLNP,DLNQQQ
-#endif
- REAL SMLNUM, ACCUR
-C
-#include "hbook/hcdifb.inc"
-C----------------------------------------------------------------------
-C
-C
-C Small Num is used to terminate summing and increase speed by
-C not calculating terms which are not significant to the user.
-C This is how it works (it emulates a DO WHILE we care loop):
-C
-C The summation extends from the most to least significant
-C terms (low to high for U, high to low for L). When the rest
-C of the sum (tail) becomes less than the requested accuracy,
-C the loop is terminated with a GOTO. The general procedure
-C is to calculate the log of the term, the check if we can
-C exponentiate it within machine error.
-C
-C The user is responsible for putting NSTRT,NEND in the right
-C order. Mistakes will just waste time, not give the wrong
-C answer (because we have included a flag to make sure that
-C the terms are decreasing before we quit summing.)
-C
-C When we are asked to only calculate one term, ACCUR is
-C set to its default value. The default value is the
-C smallest allowed by underflow. (i.e. maximum accuracy)
-C
-C----------------------------------------------------------------------
-C
-C
- HBNSUM=0.0
-C
-C
-C----------------------------------------------------------------------
-C * Check if invalid values were sent
-C----------------------------------------------------------------------
-C
- IF ((NSTRT.LT.0).OR.(NEND.LT.0).OR.(NMAX.LT.0).OR.
- + (QQQ.LE.0.).OR.(P.LE.0.)) GOTO 999
-C
-C
-C
-C----------------------------------------------------------------------
-C * Set accuracy, default to -lnbigp
-C----------------------------------------------------------------------
-C
- IF ((ACCUR.LE.0.).OR.(NSTRT.EQ.NEND).OR.
- + (LOG(ACCUR).LT.(-LNBIGP-10.*ABS(NSTRT-NEND)))) THEN
- SMLNUM = -LNBIGP
- ELSE
- SMLNUM = LOG(ACCUR/(ABS(NSTRT-NEND)*10.))
- ENDIF
-C
- DLNP = LOG(P)
- DLNQQQ = LOG(QQQ)
- N = NMAX
-C
-C
-C----------------------------------------------------------------------
-C * Get the log of the first term for the first comparison
-C----------------------------------------------------------------------
-C
- DLAST = HLBINO(N,NSTRT) + NSTRT*DLNP+(N-NSTRT)*DLNQQQ
-C
-C
-C
-C----------------------------------------------------------------------
-C * Set step control for do loop
-C----------------------------------------------------------------------
-C
- NSTEP = 1
- IF (NSTRT.GT.NEND) NSTEP = -1
-C
- DO 10 K=NSTRT,NEND,NSTEP
-C
-C
-C----------------------------------------------------------------------
-C * Use LOG terms. For our purposes, the accuracy of
-C calculating p**k and the like is similiar to that
-C of k*log(p)
-C----------------------------------------------------------------------
-C
- DLNTRM = HLBINO(N,K) + K*DLNP+(N-K)*DLNQQQ
-C
-C----------------------------------------------------------------------
-C * If exp(dtemp) is within accuracy requested, or the
-C default of underflow protection, add to sum.
-C----------------------------------------------------------------------
-C
- IF (DLNTRM.GT.SMLNUM) THEN
- HBNSUM =HBNSUM + EXP(DLNTRM)
- DLAST = DLNTRM
-C
-C----------------------------------------------------------------------
-C Terminate DO loops to save time once we acheive
-C requested accuracy.
-C BUT...
-C Make sure we are not increasing before we
-C terminate loop.
-C----------------------------------------------------------------------
-C
- ELSEIF (DLNTRM.LT.DLAST) THEN
- GOTO 999
-C
-C
- ENDIF
- 10 CONTINUE
- 999 RETURN
- END
diff --git a/src/packlib/hbook/hdiff/hdbaop.F b/src/packlib/hbook/hdiff/hdbaop.F
deleted file mode 100644
index 40425f7..0000000
--- a/src/packlib/hbook/hdiff/hdbaop.F
+++ /dev/null
@@ -1,151 +0,0 @@
-*
-* $Id: hdbaop.F,v 1.1.1.1 1996/01/16 17:07:53 mclareni Exp $
-*
-* $Log: hdbaop.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:53 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.19/00 09/03/93 08.29.18 by R. J. Genik II
-*-- Author : R. J. Genik II 23/10/92
- SUBROUTINE HDBAOP(TOL,NBINS,NBAD,DIFFS)
-C----------------------------------------------------------------------
-C-
-C- Purpose and Methods : Absolute comparison of 2 histograms bin
-C- by bin (HDIFFB A option)
-C- Must have 1d histogram with error bars
-C-
-C- Inputs : TOL,NBINS
-C- Outputs : NBAD,DIFFS, If DEBUG option on, various messages
-C- Controls: None
-C-
-C-
-C- Created : 3-DEC-1990 James T. McKinley
-C- Michigan State University, USA
-C-
-C-
-C- MODIFIED: 24-SEP-1992 R. J. Genik II
-C- Michigan State University, USA
-C-
-C-
-C- MODIFIED: 8-MAR-1993 R. J. Genik II
-C- Michigan State University, USA
-C- A_OPTION now returns signed DIFFS values
-C-
-C----------------------------------------------------------------------
-C Local and passed variable declarations
-C----------------------------------------------------------------------
-C
- INTEGER NBINS,NBAD,I,INDEX
- REAL TOL,DIFFS(NBINS),HGCONT
-C
-C NOTE: R is contents of ID1 = IDR = REFERENCE HISTOGRAM
-C D is contents of ID2 = IDD = DATA HISTOGRAM
-C SIGR is error bars of ID1 = IDR = REFERENCE HISTOGRAM
-C
- REAL R,D,SIGR
-C
-C
-#include "hbook/hcprin.inc"
-#include "hbook/hcdifb.inc"
-C---------------------------------------------------------------------
-C Begin calculation
-C---------------------------------------------------------------------
-C
- NBAD=0
- DO 100 I=BEGINI, ENDI
- R = HGCONT(IDR, I, 0, 1)
-C ! Get value from Ref HG
- D = HGCONT(IDD, I, 0, 1)
-C ! Value from Dat HG
-C---------------------------------------------------------------------
-C Compute position in DIFFS
-C---------------------------------------------------------------------
-C
- INDEX = I - BEGINI + 1
-C
-C---------------------------------------------------------------------
-C default is to pass; in this case, 0 s.d. away means pass
-C---------------------------------------------------------------------
-C
- DIFFS(INDEX) = 0
-C
-C---------------------------------------------------------------------
-C Do actual comparisons. NOTE: R = ID1 = IDR = REFERENCE HISTOGRAM
-C D = ID2 = IDD = DATA HISTOGRAM
-C---------------------------------------------------------------------
-C
-C---------------------------------------------------------------------
-C If option Z has been selected and Ref bin = 0, skip bin
-C---------------------------------------------------------------------
-C
- IF((OPTS(ZEROS).EQ.1) .AND. (R .EQ. 0)) THEN
- IF (OPTS(DEBUG) .EQ. 1) WRITE(DUMPDV,FMT=400) I,0
-C ! Debug opt
- GO TO 100
- ENDIF
-C
- SIGR = HGCONT(IDR,I,0,2)
-C
-C---------------------------------------------------------------------
-C If SIGR = 0 we will get divide by zero error.
-C Check SIGR, and decide whether or not to pass the bin.
-C---------------------------------------------------------------------
-C
- IF ((SIGR.EQ.0).OR.(R.EQ.0)) THEN
- IF (D.EQ.R*LAMBDA) THEN
- IF(OPTS(DEBUG).EQ.1) WRITE(DUMPDV,FMT=410) 'A',I,0
- ELSE
- DIFFS(INDEX)=ABS(BIGP)
-C ! Set DIFFS to a very large
- IF (OPTS(DEBUG).EQ.1) WRITE(DUMPDV,FMT=420) I,0
- ENDIF
-C
- ELSE
-C
-C---------------------------------------------------------------------
-C Note: this can overflow the machine, but for the
-C promised range of 10**9, sigd would have to be
-C 10**-29, which is unreasonable.
-C---------------------------------------------------------------------
-C
- DIFFS(INDEX)=(D-LAMBDA*R)/(LAMBDA*SIGR)
-C ! Compute diffs
- ENDIF
- IF (ABS(DIFFS(INDEX)) .GT. TOL) NBAD=NBAD+1
-C
-C---------------------------------------------------------------------
-C Display debugging information
-C---------------------------------------------------------------------
-C
- IF(OPTS(DEBUG).EQ.1) THEN
- WRITE(DUMPDV,FMT=700) R, D, LAMBDA*R, LAMBDA*SIGR
- WRITE(DUMPDV,FMT=810) I,0,DIFFS(INDEX),NBAD
- ENDIF
- 100 CONTINUE
-C
-C=====================================================================
-C Formats
-C=====================================================================
-C
-C---------------------------------------------------------------------
-C Special case indicators
-C---------------------------------------------------------------------
-C
- 400 FORMAT('0','Reference bin ',I5,',',I3,
- + '=0, Z opt, so bin passed')
- 410 FORMAT('0','Ref=Dat=0 with opts ',A,' in bin ',I3,',',I3)
- 420 FORMAT('0','Reference bin',I5,',',I3,
- +
- +': Cont=0, A opt, no Z opt, DIFFS is undefined so bin fails.')
- 460 FORMAT('0','A opt and Ref. error bar= 0, thus bin ',I5,
- + ' fails.')
-C
-C A option data
- 700 FORMAT('0','REF',E10.4,' DAT',E10.4,' Expect',E10.4,' EBar',E10.
- + 4)
-C
- 810 FORMAT(1X,'Bin ',I5,',',I4,': DIFFS',E10.4,' No. Bad',I4)
-C
- END
diff --git a/src/packlib/hbook/hdiff/hdbcop.F b/src/packlib/hbook/hdiff/hdbcop.F
deleted file mode 100644
index ebd3a10..0000000
--- a/src/packlib/hbook/hdiff/hdbcop.F
+++ /dev/null
@@ -1,320 +0,0 @@
-*
-* $Id: hdbcop.F,v 1.1.1.1 1996/01/16 17:07:53 mclareni Exp $
-*
-* $Log: hdbcop.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:53 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.21/01 28/10/93 08.26.07 by R. J. Genik II
-*-- Author : R. J. Genik II 23/10/92
- SUBROUTINE HDBCOP(TOL,NBINS,NBAD,DIFFS)
-C----------------------------------------------------------------------
-C-
-C- Purpose and Methods: Statistical compatibility of data histogram
-C- bin by bin with a reference histogram
-C- (HDIFFB C option)
-C-
-C- Inputs : TOL,NBINS
-C- Outputs : NBAD,DIFFS, If DEBUG option on, various messages
-C- Controls: None
-C-
-C- Created 3-DEC-1990 James T. McKinley, Michigan State University, USA
-C-
-C-
-C- MODIFIED 1-OCT-1992 R. J. Genik II, Michigan State University, USA
-C- MODIFIED 27-OCT-1993 R. J. Genik II, Michigan State University, USA
-C- Divide by zero protection increased. See
-C- comment below.
-C-
-C---------------------------------------------------------------------
-C Local variable declarations for HDIFFB C option
-C---------------------------------------------------------------------
-C
- INTEGER I,J,INDEX,ND
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION DTEMPU,DTEMPL,DGAGNC,DGAPNC
-#endif
-#if !defined(CERNLIB_DOUBLE)
- REAL GAGNC,GAPNC
-#endif
- REAL ZVAL,MEAND,L,U,HGCONT,PROB,FREQ,GAMDIS
-C
-C---------------------------------------------------------------------
-C... passed varaibles, input and output
-C---------------------------------------------------------------------
-C
- INTEGER NBINS,NBAD
- REAL TOL,DIFFS(NBINS)
-#include "hbook/hcdifb.inc"
-C
-C
-C
- NBAD=0
- ZVAL=0.
- DO 110 J = BEGINJ, ENDJ
- DO 100 I=BEGINI, ENDI
- R = HGCONT(IDR, I, J, 1)
-C ! Get value from Ref HG
- D = HGCONT(IDD, I, J, 1)
-C ! Value from Dat HG
- INDEX = I - BEGINI + 1
-C ! Compute position in DIFFS
- IF (TWODIM) INDEX = INDEX + XSIZ*(J - BEGINJ)
-C
-C---------------------------------------------------------------------
-C default is to pass
-C---------------------------------------------------------------------
-C
- DIFFS(INDEX) = 1.0
-C
-C---------------------------------------------------------------------
-C
-C Do actual comparisons. NOTE: R = ID1 = IDR = REFERENCE HISTOGRAM
-C D = ID2 = IDD = DATA HISTOGRAM
-C
-C---------------------------------------------------------------------
-C Check for negative contents (and fail)
-C---------------------------------------------------------------------
-C
- IF(R.LT.0.)THEN
- DIFFS(INDEX) = 0.0
-C !absolute fail
- WRITE(DUMPDV,FMT=900) I,J,IDR
- GOTO 90
- ENDIF
- IF(D.LT.0.)THEN
- DIFFS(INDEX) = 0.0
-C !absolute fail
- WRITE(DUMPDV,FMT=900) I,J,IDD
- GOTO 90
- ENDIF
-C
-C---------------------------------------------------------------------
-C If option Z has been selected and Ref bin = 0, skip bin
-C---------------------------------------------------------------------
-C
- IF((OPTS(ZEROS).EQ.1) .AND. (R .EQ. 0)) THEN
- IF (OPTS(DEBUG) .EQ. 1) WRITE(DUMPDV,FMT=400) I,J
-C ! Debug opt
- GO TO 90
- ENDIF
-C
-C---------------------------------------------------------------------
-C If R=D=0 then skip the comp.
-C---------------------------------------------------------------------
-C
- IF((R+D).EQ.0.) THEN
- IF (OPTS(DEBUG).EQ.1) WRITE(DUMPDV,FMT=410) 'C', I,J
- GOTO 90
- ENDIF
-C
-C---------------------------------------------------------------------
-C Get expected value for D, <D>=lambda*<R> (<R>=R)
-C or =lambda*sum(Wr)
-C---------------------------------------------------------------------
-C
- MEAND = LAMBDA*R
-C
-C---------------------------------------------------------------------
-C This is the update referred to above
-C 27 October 1993 - R. J. Genik II
-C The calculation of ZVAL will be done here, now, after we make
-C sure no divide by zero error will occur.
-C The check for negative contents assures that R and D are equal
-C to or greater than zero. Then, we are assured that the case
-C R=D=0 has been handled. If D=0.NE.R, the calculations and
-C functions called properly return the probability that 0
-C was seen when we expected a non-zero result. (The case
-C lambda = 0 is handled in HDBINI) The case R=0.NE.D is handled
-C below: we issue an absolute fail because the specification of
-C the routine states that the error bar is taken from the
-C reference histogram. We do not allow the user to specify an
-C error bar in this option, that is what the A-option is for.
-C e.g. the question: I expected zero and got 3 is not answered.
-C---------------------------------------------------------------------
-C
-C---------------------------------------------------------------------
-C Calculate the SIGD value for Poisson
-C---------------------------------------------------------------------
-C
-C
-C
- SIGD=SQRT(MEAND)
-C
- IF((SIGD.EQ.0.).AND.(D.NE.R))THEN
- DIFFS(INDEX)=0.0
-C ! Absolute fail
- IF(OPTS(DEBUG).EQ.1) WRITE(DUMPDV,FMT=470) I
- GOTO 90
- ENDIF
-C
-C----------------------------------------------------------------------
-C Compute ZVAL (how many sigmas), used to determine
-C level of accuracy required and in Large Stat case
-C----------------------------------------------------------------------
-C
- ZVAL=(D-MEAND)/SIGD
-C
-C---------------------------------------------------------------------
-C
-C======================================================================
-C Large statistics or weighted
-C======================================================================
-C
- IF((MEAND.GT.1000000).AND.(TOL.GE.0.01)
- + .OR.(WEIGHD))THEN
-C
- ZVAL=ABS(ZVAL)
-C ! for Large stat, we remove the sign
-C
-C----------------------------------------------------------------------
-C Here is where the approximation is:
-C
-C We assume that Poisson ==> Gaussian
-C Hence, we have symmetric distribution with
-C standard deviation of sqrt(mean), or sqrt(sum w**2),
-C and then use z value as the test statistic.
-C
-C
-C---------------------------------------------------------------------
-C Compute the probabilities
-C---------------------------------------------------------------------
-C
- DIFFS(INDEX) = 2. - 2.*FREQ(ZVAL)
-C
-C----------------------------------------------------------------------
-C Do a debugging dump if requested
-C----------------------------------------------------------------------
-C
- IF (OPTS(DEBUG).EQ.1) THEN
- WRITE(DUMPDV,FMT=600) R, D, MEAND, SIGD
- WRITE(DUMPDV,FMT=800)I,J,ZVAL**2,DIFFS(INDEX)
- ENDIF
- ELSE
-C
-C======================================================================
-C Small statistics
-C======================================================================
-C
- ND = INT(D + 0.5)
-C !avoid roundoff problems
-C
-C----------------------------------------------------------------------
-C If we have small tol, are far away from the mean, and are within
-C the range of called function accuracy, do more accurate L, U
-C calculation.
-C----------------------------------------------------------------------
-C
- IF (ND.EQ.0) THEN
- L = EXP(-MEAND)
- ELSE
- IF ((TOL.LT.0.0001).AND.(ZVAL.LT.-3.)) THEN
-#if defined(CERNLIB_DOUBLE)
- DTEMPL = DGAGNC(REAL(ND)+1.,MEAND)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- DTEMPL = GAGNC(REAL(ND)+1.,MEAND)
-#endif
- L = REAL(DTEMPL)
- ELSE
- L = PROB(2.*MEAND, (2*ND+ 2))
- ENDIF
- ENDIF
-C ! Get lower tail probability
- IF ((TOL.LT.0.0001).AND.(ZVAL.GT.3.).AND.
- + (MEAND).LT.10000.) THEN
-C
-C----------------------------------------------------------------------
-C - The above avoids convergence error in DGAPNC
-C----------------------------------------------------------------------
-C
-#if defined(CERNLIB_DOUBLE)
- DTEMPU = DGAPNC(REAL(ND),MEAND)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- DTEMPU = GAPNC(REAL(ND),MEAND)
-#endif
- U = REAL(DTEMPU)
- ELSE
- IF (ND.EQ.0) THEN
- U = 1.
-C
-C----------------------------------------------------------------------
-C - The below avoids convergence error in GAMDIS
-C----------------------------------------------------------------------
-C
- ELSE IF ((ZVAL.GT.2.0).AND.(MEAND.LT.5000.)) THEN
- U = GAMDIS(MEAND,REAL(ND))
- ELSE
-C
-C----------------------------------------------------------------------
-C - PROB uses 26.4.14 from Abramowitz, et al, for large
-C values of mean and degrees of freedom. Accurate to
-C 3 digits for dof.gt.100, and it doesn't generate errors
-C for our guarenteed range.
-C----------------------------------------------------------------------
-C
- U = 1. - PROB(2.*MEAND,2*ND)
- ENDIF
- ENDIF
-C
-C----------------------------------------------------------------------
-C Calculate DIFFS. Use smallest tail * 2
-C----------------------------------------------------------------------
-C
- DIFFS(INDEX)=2.*MIN(L,U)
-C
-C
-C---------------------------------------------------------------------
-C Display debugging dump if requested
-C---------------------------------------------------------------------
-C
- IF (OPTS(DEBUG).EQ.1) THEN
- WRITE(DUMPDV, FMT=610) R,D,L,U
- ENDIF
- ENDIF
- 90 CONTINUE
-C
-C----------------------------------------------------------------------
-C Check if bin is below user's tol level
-C----------------------------------------------------------------------
-C
- IF(DIFFS(INDEX) .LT. TOL) NBAD=NBAD+1
-C
-C---------------------------------------------------------------------
-C Display debugging dump if requested
-C---------------------------------------------------------------------
-C
- IF (OPTS(DEBUG).EQ.1) THEN
- WRITE(DUMPDV, FMT=810) I,J,DIFFS(INDEX),NBAD
- ENDIF
- 100 CONTINUE
- 110 CONTINUE
-C
-C
-C---------------------------------------------------------------------
-C Formats
-C---------------------------------------------------------------------
-C
-C Special case indicators and debug dump info...
-C---------------------------------------------------------------------
- 400 FORMAT('0','Reference bin ',I6,',',I6,
- + '=0, Z opt, so bin passed')
- 410 FORMAT('0','Ref=Dat=0 with opts ',A,' in bin ',I6,',',I6)
- 470 FORMAT('0','C opt and Ref. error bar= 0, thus bin ',I6,
- + I6,' fails.')
-C
-C C option data
- 600 FORMAT('0','REF',E10.4,' DAT',E10.4,' Expect',E10.4,' EBar',E10.
- + 4)
- 610 FORMAT('0','REF',E10.4,' DAT',E10.4,' L',E10.4,' U',E10.4)
-C
-C Result for each bin
- 800 FORMAT(1X,'Bin ',I6,',',I6,': CHISQ',E10.4,' Diffs',E10.4)
- 810 FORMAT(1X,'Bin ',I6,',',I6,': DIFFS',E10.4,' No. Bad',I6)
- 900 FORMAT(1X,'Negative bin contents for BIN=',I6,',',I6,'ID=',I6,
- + 5X, 'Negative bin contents not allowed for S and C options')
-C
- END
diff --git a/src/packlib/hbook/hdiff/hdbini.F b/src/packlib/hbook/hdiff/hdbini.F
deleted file mode 100644
index 36461f1..0000000
--- a/src/packlib/hbook/hdiff/hdbini.F
+++ /dev/null
@@ -1,528 +0,0 @@
-*
-* $Id: hdbini.F,v 1.1.1.1 1996/01/16 17:07:53 mclareni Exp $
-*
-* $Log: hdbini.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:53 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.20/03 23/07/93 17.46.20 by Rene Brun
-*-- Author : R. J. Genik II 23/10/92
- SUBROUTINE HDBINI(ID1,ID2,TOL,NBINS,CHOPT,ERRORS)
-C----------------------------------------------------------------------
-C-
-C- Purpose and Methods : Initialization routine for HDIFFB
-C- 1) set option flags and check for validity
-C- 2) set overall normalization
-C- 3) fill the local common block
-C-
-C- Inputs : IDR,IDD,TOL,NBINS,CHOPT
-C- Outputs : ERRORS, If DEBUG option on, various messages
-C- fills /HDBCOM/ the HDIFFB common block
-C- Controls: NONE
-C-
-C- Created : 3-DEC-1990 James T. McKinley
-C- Michigan State University, USA
-C-
-C-
-C- MODIFIED: 24-SEP-1992 R. J. Genik II
-C- Michigan State University, USA
-C-
-C-
-C---------------------------------------------------------------------
-C
-C
-C
-C----------------------------------------------------------------------
-C Local Variable Declaration
-C----------------------------------------------------------------------
-C
- INTEGER NBINS,ID1,ID2,NUMZSR,NUMZSD
- INTEGER LOCR,NCXR,NCYR,LEXCR,LEYCR,UEXCR,UEYCR,NWTR
- INTEGER LOCD,NCXD,NCYD,LEXCD,LEYCD,UEXCD,UEYCD,NWTD
- INTEGER LCIDR,LCIDD,LCONTR,LCONTD,LWR,LWD,JBIT
- INTEGER NENTR,NENTD,I,J,K,L,PROFIR,PROFID
- REAL HGCONT,TOTALR,TOTALD,SUMR,SUMD,TOL
- LOGICAL ERRORS,NGCONR,NGCOND,ERBARR,ERBARD
- CHARACTER*80 TITLR,TITLD
- CHARACTER*(*) CHOPT
-C
-C
-#include "hbook/hcbook.inc"
-#include "hbook/hcbits.inc"
-#include "hbook/hcunit.inc"
-#include "hbook/hcprin.inc"
-#include "hbook/hcdifb.inc"
-C
-C=====================================================================C
-C SECTION 1 - Initialize variables, error check, set flags C
-C=====================================================================C
-C Initialize the variables
-C
- ERRORS = .FALSE.
-C ! No errors yet
- WEIGHR = .FALSE.
-C ! Histogram 1 not weighted
- WEIGHD = .FALSE.
-C ! 2 is not either
- TWODIM = .FALSE.
-C ! Assume 1-D for now
- PROFIL = .FALSE.
-C ! Assume not profile for now
- PSDMR = .TRUE.
-C ! Assume std deviation of mean for error
- PSDMD = .TRUE.
-C ! bar, if it is a profile histogram
- NGCONR = .FALSE.
-C ! Negative contents flag
- NGCOND = .FALSE.
-C ! Negative contents flag
-C
-C----------------------------------------------------------------------
-C Change ID1 and ID2 to IDR and IDD to keep reference and data
-C straight internally.
-C----------------------------------------------------------------------
-C
- IDR=ID1
- IDD=ID2
-C
-C----------------------------------------------------------------------
-C Set the default output device for the debug dump (DUMPDV) to the
-C common default device (LOUT)
-C----------------------------------------------------------------------
-C
- DUMPDV = LOUT
-C
-C----------------------------------------------------------------------
-C Set the default accuracy for small S stat to 2 digits
-C----------------------------------------------------------------------
-C
- ACDIGT = 2.
-C----------------------------------------------------------------------
-C Make sure the tolerance is not 0 (Warning)
-C----------------------------------------------------------------------
-C
- IF (TOL .LE. 0.) CALL HBUG('+Zero tolerance ',
- + 'HDIFFB',IDR)
-C
-C----------------------------------------------------------------------
-C Get booking information for IDR and IDD
-C----------------------------------------------------------------------
-C
- CALL HGIVE(IDR, TITLR, NCXR, LEXCR, UEXCR, NCYR, LEYCR, UEYCR,
- + NWTR, LOCR)
- CALL HGIVE(IDD, TITLD, NCXD, LEXCD, UEXCD, NCYD, LEYCD, UEYCD,
- + NWTD, LOCD)
-C
-C----------------------------------------------------------------------
-C Check that the histograms are of the same dimension. If Y channels
-C are present, set flag for two dimensions.
-C----------------------------------------------------------------------
-C
- IF ((NCYR.EQ.0 .OR. NCYD.EQ.0) .AND. NCYR+NCYD.NE.0) THEN
- CALL HBUG('Both histograms must be the same dimension.',
- + 'HDIFFB', IDR)
- ERRORS=.TRUE.
- ENDIF
- IF (NCXR .NE. NCXD .OR. NCYR .NE. NCYD) THEN
- CALL HBUG('Number of channels is different.', 'HDIFFB', IDR)
- ERRORS=.TRUE.
- ENDIF
- IF (NCYR .GT. 0) TWODIM=.TRUE.
-C
-C----------------------------------------------------------------------
-C Decode option string
-C----------------------------------------------------------------------
-C
- CALL HUOPTC(CHOPT,OPTST,OPTS)
-C
-C----------------------------------------------------------------------
-C If A option is selected require that errors bars exist.
-C----------------------------------------------------------------------
-C
- CALL HFIND(IDR,'HDIFFB')
- LCIDR=LCID
- ERBARR = LQ(LQ(LCIDR-1)).NE.0
- IF((OPTS(AOPTN).EQ.1).AND..NOT.ERBARR) THEN
- CALL HBUG('A option with no error bars on reference histogram',
- + 'HDIFFB',IDR)
- ERRORS = .TRUE.
- ENDIF
-C
-C----------------------------------------------------------------------
-C Determine whether the histograms are of profile type
-C and if so, set profile flag.
-C----------------------------------------------------------------------
-C
-C Get address of IDR (REF) and decode flags I1-I230 (in HCBITS)
-C
- CALL HDCOFL
- PROFIR=I8
- PROFIL = (PROFIR.EQ.1)
-C Find kind of error bar used for reference profile histograms
- IF (PROFIL) THEN
- LCONTR=LQ(LCIDR-1)
- LWR=LQ(LCONTR)
- PSDMR = JBIT(IQ(LWR),1).EQ.0
-C !True if using spread instead of SD mean
-C
- ENDIF
-C
-C Get address of IDD (DAT) and decode flags I1-I230 (in HCBITS)
-C
- CALL HFIND(IDD,'HDIFFB')
- LCIDD=LCID
- CALL HDCOFL
- PROFID=I8
-C
-C
- ERBARD = LQ(LQ(LCIDD-1)).NE.0
-C Find kind of error bar used for data profile histograms
- IF (PROFIL) THEN
- LCONTD=LQ(LCIDD-1)
- LWD=LQ(LCONTD)
- PSDMD = JBIT(IQ(LWD),1).EQ.0
- ENDIF
-C
-C----------------------------------------------------------------------
-C Check that both histograms are profile type
-C----------------------------------------------------------------------
-C
-C
- IF (PROFIR.NE.PROFID) THEN
- CALL HBUG('Both histograms must be standard or profile type',
- + 'HDIFFB',IDR)
- ERRORS = .TRUE.
- ENDIF
-C
-C----------------------------------------------------------------------
-C Display options string and TOL to user for Debug Option
-C----------------------------------------------------------------------
-C
-C
- IF (OPTS(DEBUG) .EQ. 1) THEN
- WRITE(DUMPDV, FMT=200) IDR, IDD
- WRITE(DUMPDV, FMT=210) CHOPT, TOL
- ENDIF
-C
-C----------------------------------------------------------------------
-C Options N,O,U,L,R,T,B not allowed for profile histograms
-C Check parameterization for OPTS index values (numbers to save space)
-C----------------------------------------------------------------------
-C
- IF((PROFIR+PROFID.NE.0).AND.((OPTS(1)+OPTS(3)+OPTS(4)+OPTS(9)+
- + OPTS(10)+OPTS(11)+OPTS(12)).NE.0))THEN
- CALL HBUG('options N,O,U,L,R,T, or B used with profile hist.',
- + 'HDIFFB',IDR)
- ERRORS=.TRUE.
- ENDIF
-C
-C----------------------------------------------------------------------
-C Screen out incompatible options. S,C, or A. (Warning)
-C Set S option as default.
-C----------------------------------------------------------------------
-C
- IF (OPTS(SOPTN) + OPTS(COPTN) + OPTS(AOPTN) .GT. 1) THEN
- CALL HBUG('Only one comparison at a time, please','HDIFFB',
- + IDR)
- OPTS(SOPTN) = 1
-C ! Default to S case
- OPTS(COPTN) = 0
-C ! Turn off both the
- OPTS(AOPTN) = 0
-C ! C and A modes.
- ENDIF
-C
-C
-C----------------------------------------------------------------------
-C If no test options are selected, default to S
-C----------------------------------------------------------------------
-C
- IF (OPTS(SOPTN)+OPTS(COPTN)+OPTS(AOPTN).EQ.0) OPTS(SOPTN)=1
-C
-C
-C----------------------------------------------------------------------
-C Make sure both histograms have the same binning. The routines that
-C return the content and error bars don't worry about the different
-C binning, but it may cause bad results, so warn user.
-C----------------------------------------------------------------------
-C
- IF (LEXCR .NE. LEXCD) THEN
- CALL HBUG('+Different binning ','HDIFFB',IDR)
- ENDIF
- IF (NCYR.NE.0.AND.LEYCR .NE. LEYCD) THEN
- CALL HBUG('+Different binning ','HDIFFB',IDR)
- ENDIF
-C
-C
-C----------------------------------------------------------------------
-C Prepare for calculation of indices in DIFFS
-C----------------------------------------------------------------------
-C
- BEGINI = 1
-C ! First bin, no underflow, X
- ENDI = NCXR
-C ! Last bin, no overflow, X
-C
- IF (TWODIM) THEN
- BEGINJ = 1
-C ! First bin, no underflow, Y
- ENDJ = NCYR
-C ! Last bin, no overflow, Y
- ELSE
- BEGINJ = 0
-C ! Zero bins
- ENDJ = 0
-C ! Zero is also the last bin
- ENDIF
-C
-C
-C----------------------------------------------------------------------
-C Find the starting and ending points with O/U flow bins
-C----------------------------------------------------------------------
-C
- IF (OPTS(UFLOW).EQ.1.OR.OPTS(XUNDR).EQ.1) BEGINI = 0
- IF (OPTS(OFLOW).EQ.1.OR.OPTS(XOVER).EQ.1) ENDI = NCXR+1
- IF ((OPTS(UFLOW).EQ.1.OR.OPTS(YUNDR).EQ.1).AND.TWODIM) BEGINJ=0
- IF((OPTS(OFLOW).EQ.1.OR.OPTS(YOVER).EQ.1).AND.TWODIM)ENDJ=NCYR+1
-C
-C
-C----------------------------------------------------------------------
-C Find the XSIZ value (total length across the X-Axis)
-C----------------------------------------------------------------------
-C
- XSIZ = ENDI - BEGINI + 1
-C ! Used in INDEX calculation
-C
-C
-C----------------------------------------------------------------------
-C Verify that DIFFS has enough room for the output.
-C----------------------------------------------------------------------
-C
- K = XSIZ*(ENDJ-BEGINJ+1)
- IF (K.GT.NBINS)THEN
- CALL HBUG('Not enough bins in DIFFS to hold result','HDIFFB',
- + IDR)
- WRITE(DUMPDV, FMT=910) K
- ERRORS = .TRUE.
- ENDIF
-C
-C
-C----------------------------------------------------------------------
-C Jump ship if any errors have been detected
-C----------------------------------------------------------------------
-C
- IF (ERRORS) GO TO 999
-C
-C======================================================================
-C Section 2: Continue with the second stage of initialization.
-C======================================================================
-C
-C
-C----------------------------------------------------------------------
-C Find the sum of the weights for each histogram
-C----------------------------------------------------------------------
-C
-C Clear sums of number of bins with zero contents
-C
- NUMZSR = 0
- NUMZSD = 0
-C
-C
- SUMR = 0.
-C ! Clear sums in "good" regions
- SUMD = 0.
- TOTALR =0.
-C ! Clear total sums
- TOTALD =0.
- L=0
-C ! Initialize L for 1-D
- IF (TWODIM) L=1
-C ! Add for Y overflow only on 2-D
-C
- DO 41 J=0, NCYR+L
-C ! including O/U flows
- DO 40 I=0, NCXR+1
-C ! Sum each bin contents
- R = HGCONT(IDR,I,J,1)
-C ! Save content
- IF(R.LT.0.)NGCONR=.TRUE.
- TOTALR=TOTALR+R
-C ! Add to total sum
- IF(I.GE.BEGINI .AND. I.LE.ENDI .AND. J.GE.BEGINJ .AND. J.LE.
- + ENDJ) THEN
- SUMR=SUMR+R
-C ! Add to sum if in requested region
-C
-C
- IF (R.EQ.0.) NUMZSR = NUMZSR + 1
-C
-C ! Add to number of zeroes
-C
- ENDIF
- 40 CONTINUE
- 41 CONTINUE
-C
- DO 46 J=0, NCYD+L
-C ! including O/U flows
- DO 45 I=0, NCXD+1
-C ! Sum each bin contents
- D = HGCONT(IDD,I,J,1)
-C ! Save content
- IF(D.LT.0.)NGCOND=.TRUE.
- TOTALD=TOTALD+D
-C ! Add to total sum
- IF(I.GE.BEGINI .AND. I.LE.ENDI .AND. J.GE.BEGINJ .AND. J.LE.
- + ENDJ) THEN
- SUMD=SUMD+D
-C ! Add to sum if in requested region
-C
-C
- IF (D.EQ.0.) NUMZSD = NUMZSD + 1
-C
-C ! Add to number of zeroes
- ENDIF
- 45 CONTINUE
- 46 CONTINUE
-C
-C
-C----------------------------------------------------------------------
-C If sum of contents is 0, exit
-C----------------------------------------------------------------------
-C
- IF ((SUMR .EQ. 0).AND.(.NOT.NGCONR)) THEN
- CALL HBUG('Sum of hitsogram contents is zero!', 'HDIFFB', IDR)
- ERRORS = .TRUE.
- ENDIF
- IF ((SUMD .EQ. 0).AND.(.NOT.NGCOND)) THEN
- CALL HBUG('Sum of hitsogram contents is zero!', 'HDIFFB', IDD)
- ERRORS = .TRUE.
- ENDIF
-C
-C
-C----------------------------------------------------------------------
-C Find out if reference histogram is weighted.
-C Note: We flag as weighted if the number of entries is not equal
-C any of the below:
-C
-C - Sum of contents (filled via HFILL)
-C - NBINS (filled via HPAK)
-C - NBINS - #zeroes (filled via HPAK, but had zeores in filling
-C array. In this case HNOENT returns number of non-zero bins)
-C
-C
-C----------------------------------------------------------------------
-C
- CALL HNOENT(IDR, NENTR)
- WEIGHR = ((REAL(NENTR) .NE. TOTALR).AND.(NENTR .NE. NBINS)
- + .AND.(NENTR.NE.(NBINS-NUMZSR)) .AND. .NOT.PROFIL)
- IF (WEIGHR) THEN
-C
- IF ((OPTS(3)+OPTS(4)+OPTS(9)+OPTS(10)+
- + OPTS(11)+OPTS(12)).NE.0) THEN
- CALL HBUG('U/O/R/L/T/B Option with weighted events',
- + 'HDIFFB', IDR)
- ERRORS = .TRUE.
- ENDIF
-C
- IF (TWODIM) THEN
- CALL HBUG(
- + 'Weighted or saturated 2-D histogram, results are unreliable!'
- + ,'HDIFFB',IDR)
- ELSEIF (.NOT.ERBARR) THEN
- CALL HBUG('Weighted events and no HBARX','HDIFFB',IDR)
- ENDIF
- ENDIF
-C
-C
-C----------------------------------------------------------------------
-C Check if data histogram is weighted.
-C----------------------------------------------------------------------
-C
- CALL HNOENT(IDD, NENTD)
- WEIGHD = ((REAL(NENTD).NE.TOTALD).AND.(NENTD.NE.NBINS)
- + .AND.(NENTD.NE.(NBINS-NUMZSD)).AND.(.NOT.PROFIL))
- IF (WEIGHD) THEN
-C
- IF ((OPTS(3)+OPTS(4)+OPTS(9)+OPTS(10)+
- + OPTS(11)+OPTS(12)).NE.0) THEN
- CALL HBUG('U/O/R/L/T/B Option with weighted events',
- + 'HDIFFB', IDD)
- ERRORS = .TRUE.
- ENDIF
-C
- IF (TWODIM) THEN
- CALL HBUG(
- +'Weighted or saturated 2-D histogram, results are unreliable!'
- +,'HDIFFB',IDD)
- ELSEIF (.NOT.ERBARD) THEN
- CALL HBUG('Weighted events and no HBARX','HDIFFB',IDD)
- ENDIF
- ENDIF
-C
-C
-C----------------------------------------------------------------------
-C Beam up if any errors have occured
-C----------------------------------------------------------------------
-C
- IF (ERRORS) GO TO 999
-C
-C
-C
-C----------------------------------------------------------------------
-C Find scaling factor for overall normalization difference between R+D
-C----------------------------------------------------------------------
-C
-C
- IF (OPTS(NORMD).EQ.1) THEN
- LAMBDA = 1
-C ! Turn off scaling for N option
- ELSE
- LAMBDA = 1
- IF (SUMR.NE.0) LAMBDA = SUMD/SUMR
-C ! Scale to contents in desired region
- ENDIF
-C
- IF (OPTS(DEBUG) .EQ. 1) THEN
-C ! Tell user weighted status for Debug
- WRITE(DUMPDV, FMT=220) WEIGHR,WEIGHD
- WRITE(DUMPDV, FMT=240) LAMBDA, SUMR, SUMD
-C ! Debugging dump
- ENDIF
-
-C---------------------------------------------------------------------
-C Put LOG(bigp) - 1. into /HDBCOM/ used in routines to
-C avoid overflow. We use -1. because usually we will get a log
-C approxitmation to test for possible overflow before we
-C actually calculate the number.
-C---------------------------------------------------------------------
-C
- LNBIGP = LOG(ABS(REAL(BIGP))) - 1.
-C
-C======================================================================
-C Formats
-C======================================================================
-C
-C
-C
-C----------------------------------------------------------------------
-C Initialization messages
-C----------------------------------------------------------------------
-C
- 200 FORMAT('1','HDIFFB debugging dump is now on for histograms R=',
- + I10,' + D=',I10,'.')
- 210 FORMAT(1X,'Option string: ',A,' TOL=',E10.4)
- 220 FORMAT(1X,'Ref, Data histograms are of weighted type? ',2L2)
- 240 FORMAT(1X,'Ratio',E10.4,' REF Cont',E10.4,' DAT Cont',E10.4)
-C
-C
-C----------------------------------------------------------------------
-C Error message for not enough room in input arrays
-C----------------------------------------------------------------------
-C
- 910 FORMAT(1X,'This histograms requires',I6,' bins for the result.')
-C
-C
- 999 RETURN
- END
diff --git a/src/packlib/hbook/hdiff/hdbprf.F b/src/packlib/hbook/hdiff/hdbprf.F
deleted file mode 100644
index 748efbd..0000000
--- a/src/packlib/hbook/hdiff/hdbprf.F
+++ /dev/null
@@ -1,292 +0,0 @@
-*
-* $Id: hdbprf.F,v 1.1.1.1 1996/01/16 17:07:56 mclareni Exp $
-*
-* $Log: hdbprf.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:56 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.19/00 09/03/93 08.31.41 by R. J. Genik II
-*-- Author : R. J. Genik II 23/10/92
- SUBROUTINE HDBPRF(TOL,NBINS,NBAD,DIFFS)
-C----------------------------------------------------------------------
-C-
-C- Purpose and Methods : Compares 2 profile histograms bin by bin
-C- (called by HDIFFB)
-C- Inputs : TOL,NBINS
-C- Outputs : NBAD,DIFFS, If DEBUG option on, various messages
-C- Controls: None
-C-
-C- Created 3-DEC-1990 James T. McKinley, Michigan State University, USA
-C- Modified 10-OCT-1992 R. J. Genik, MSU, USA
-C- Modified 8-MAR-1993 R. J. Genik, MSU, USA
-C- A-option now returns signed DIFFS values.
-C----------------------------------------------------------------------
-C Local and passed variable declarations
-C----------------------------------------------------------------------
-C
- INTEGER NBINS,I,NBAD,NCR,NCD
- REAL TOL, DIFFS(NBINS)
- REAL ZVAL,T,TA,TB,HGCONT,FREQ,STUDIS
-C
-C NOTE: R is contents of ID1 = IDR = REFERENCE HISTOGRAM
-C D is contents of ID2 = IDD = DATA HISTOGRAM
-C SIGR is error bars of ID1 = IDR = REFERENCE HISTOGRAM
-C SIGD is error bars of ID2 = IDD = DATA HISTOGRAM
-C
- REAL R,D,SIGR,SIGD
-#include "hbook/hcprin.inc"
-#include "hbook/hcdifb.inc"
-C---------------------------------------------------------------------
-C Do the debug dump
-C---------------------------------------------------------------------
-C
- IF (OPTS(DEBUG).EQ.1) WRITE(DUMPDV,FMT=250)
-C
-C---------------------------------------------------------------------
-C Begin looping
-C---------------------------------------------------------------------
-C
- NBAD = 0
- DO 100 I=BEGINI,ENDI
-C
-C---------------------------------------------------------------------
-C by default the bin passes
-C---------------------------------------------------------------------
-C
- IF (OPTS(AOPTN).EQ.1) THEN
- DIFFS(I)=0.0
-C ! A option pass
- ELSE
- DIFFS(I)=1.0
-C ! S or C opt pass
- ENDIF
-C
-C---------------------------------------------------------------------
-C Get some commonly used values from the histogram
-C---------------------------------------------------------------------
-C
- R = HGCONT(IDR,I,0,1)
- D = HGCONT(IDD,I,0,1)
- SIGR = HGCONT(IDR,I,0,2)
- SIGD = HGCONT(IDD,I,0,2)
- NCR = HGCONT(IDR,I,0,3) + .5
- NCD = HGCONT(IDD,I,0,3) + .5
-C
-C---------------------------------------------------------------------
-C Display the dubug info
-C---------------------------------------------------------------------
-C
- IF (OPTS(DEBUG).EQ.1) WRITE(DUMPDV,FMT=450) R,D,SIGR,SIGD
-C
-C---------------------------------------------------------------------
-C Special case checks
-C If reference bin = 0 and Z opt, SKIP it
-C---------------------------------------------------------------------
-C
- IF ((OPTS(ZEROS).EQ.1).AND. R.EQ.0.0) THEN
- IF (OPTS(DEBUG).EQ.1) WRITE(DUMPDV,FMT=400) I,0
- GO TO 90
- ENDIF
-C
-C=====================================================================
-C S option
-C=====================================================================
-C
- IF (OPTS(SOPTN).EQ.1) THEN
-C
-C---------------------------------------------------------------------
-C S option with Z option, skip if D = 0
-C---------------------------------------------------------------------
-C
- IF ((OPTS(ZEROS).EQ.1).AND. D.EQ.0.0) THEN
- IF (OPTS(DEBUG).EQ.1) WRITE(DUMPDV,FMT=410) I,0
- GO TO 90
- ENDIF
-C
-C---------------------------------------------------------------------
-C We need to check if both error bars =0.
-C---------------------------------------------------------------------
-C
- IF ((SIGR+SIGD.EQ.0).AND.(R.NE.D)) THEN
- DIFFS(I)=0.0
-C ! Absolute fail
- IF(OPTS(DEBUG).EQ.1) WRITE(DUMPDV,FMT=480) I
- GOTO 90
-C
-C---------------------------------------------------------------------
-C We need to check if R or D =0, must pass bin in this case
-C---------------------------------------------------------------------
-C
- ELSE IF ((R.EQ.0.).OR.(D.EQ.0.)) THEN
- IF(OPTS(DEBUG).EQ.1) WRITE(DUMPDV,FMT=490) I
- GOTO 90
- ELSE
- IF(NCR+NCD.LE.2)THEN
-C
-C---------------------------------------------------------------------
-C We need to make sure number dof>0, if not must pass it
-C---------------------------------------------------------------------
-C
- IF(OPTS(DEBUG).EQ.1) WRITE(DUMPDV,FMT=490) I
- GOTO 90
- ELSE
- TA = (REAL(NCR+NCD)/REAL(NCR*NCD))
- ENDIF
-C
-C---------------------------------------------------------------------
-C Check type of error bar, must have rms (spread) and not
-C std. dev. of mean for Student's t-Test
-C---------------------------------------------------------------------
-C
- IF (PSDMR) SIGR=SQRT(REAL(NCR))*SIGR
- IF (PSDMD) SIGD=SQRT(REAL(NCD))*SIGD
- ENDIF
-C
-C---------------------------------------------------------------------
-C Compute Test statistic for Student's t-Test
-C---------------------------------------------------------------------
-C
- TB = REAL((NCR-1)*SIGR**2+(NCD-1)*SIGD**2)/REAL(NCR+NCD-2)
- T = ABS(R-D)/SQRT(TA*TB)
-C
-C Find the DIFFS values using Cern Lib G104
- DIFFS(I) = 2*(1.0 - STUDIS(T, NCR+NCD-2))
-C
-C=====================================================================
-C C option
-C=====================================================================
-C
- ELSEIF (OPTS(COPTN).EQ.1) THEN
- IF ((R.EQ.0.).OR.(D.EQ.0.)) THEN
- IF (OPTS(DEBUG).EQ.1) WRITE(DUMPDV,FMT=500) I
- GOTO 90
- ENDIF
-C
-C---------------------------------------------------------------------
-C If error bar on R is zero in C opt, fail it if R.NE.D
-C---------------------------------------------------------------------
-C
- IF ( SIGR.EQ.0) THEN
- IF(R.NE.D)THEN
- DIFFS(I)=0.0
-C ! Absolute fail
- IF (OPTS(DEBUG).EQ.1) WRITE(DUMPDV,FMT=470) I
- ELSE
- IF(OPTS(DEBUG).EQ.1) WRITE(DUMPDV,FMT=420) 'C',I
- ENDIF
- GOTO 90
- ENDIF
-C
-C---------------------------------------------------------------------
-C Check type of error bar
-C---------------------------------------------------------------------
-C
- IF (PSDMR) SIGR=SQRT(REAL(NCR))*SIGR
-C ! MUST HAVE RMS
- SIGD=SIGR/SQRT(REAL(NCD))
- IF (OPTS(DEBUG).EQ.1) THEN
- WRITE(DUMPDV,FMT=800) 'C OPTION: SD OF MEAN =',SIGD
- ENDIF
-C
-C---------------------------------------------------------------------
-C Compute the ZVAL value (how many sigmas)
-C---------------------------------------------------------------------
-C
- ZVAL = ABS((D-R)/SIGD)
-C
-C---------------------------------------------------------------------
-C Find the DIFFS value using the FREQ routine
-C---------------------------------------------------------------------
-C
- DIFFS(I) = 2.-2.*FREQ(ZVAL)
-C ! CERNLIB C300
-C
-C---------------------------------------------------------------------
-C Do a debugging dump if optioned
-C---------------------------------------------------------------------
-C
- IF (OPTS(DEBUG).EQ.1) THEN
- WRITE(DUMPDV,FMT=650) I, ZVAL**2, DIFFS(I)
- ENDIF
-C
-C=====================================================================
-C A Option
-C=====================================================================
-C
- ELSEIF (OPTS(AOPTN).EQ.1) THEN
-C
-C---------------------------------------------------------------------
-C If error bar on R is zero in A opt, fail it if R.NE.D
-C---------------------------------------------------------------------
-C
- IF ( SIGR.EQ.0) THEN
- IF(R.NE.D)THEN
- DIFFS(I)=ABS(BIGP)
-C ! Absolute fail
- IF (OPTS(DEBUG).EQ.1) WRITE(DUMPDV,FMT=460) I
- GO TO 90
- ELSE
- IF(OPTS(DEBUG).EQ.1) WRITE(DUMPDV,FMT=420) 'A',I
- ENDIF
- GOTO 90
- ENDIF
- DIFFS(I) = (D-R)/SIGR
-C ! Value depends on user's
-C ! error bar spec. in HBPROF
- ENDIF
- 90 CONTINUE
-C
-C=====================================================================
-C Check DIFFS
-C=====================================================================
-C
- IF (OPTS(AOPTN).EQ.1) THEN
- IF(ABS(DIFFS(I)).GT.TOL) NBAD=NBAD+1
- ELSE
- IF(DIFFS(I).LT.TOL) NBAD=NBAD+1
- ENDIF
-C Debug dump area
- IF (OPTS(DEBUG) .EQ. 1) THEN
- WRITE(DUMPDV,FMT=750) I, DIFFS(I), NBAD
- ENDIF
- 100 CONTINUE
-C
-C=====================================================================
-C Formats
-C=====================================================================
-C
-C---------------------------------------------------------------------
-C Initialization messages
-C---------------------------------------------------------------------
-C
- 250 FORMAT(1X,'Both histograms are of profile type.')
-C
-C---------------------------------------------------------------------
-C Special case indicators
-C---------------------------------------------------------------------
-C
- 400 FORMAT('0','Reference bin ',I5,',',I3,
- + '=0, Z opt, so bin passed')
- 410 FORMAT('0','Data bin ',I5,',',I3,
- + '=0, Z opt and S option, so bin passed')
- 420 FORMAT('0','Ref.=Data with opts ',A,' in bin ',I3)
- 450 FORMAT('0',' h(y)',E10.4,' h(x)',E10.4,' e(y)',E10.4,' e(x)',
- + E10.4)
- 460 FORMAT('0','A opt and Ref. error bar= 0, thus bin ',I5,
- + ' fails.')
- 470 FORMAT('0','C opt and Ref. error bar= 0, thus bin ',I5,
- + ' fails.')
- 480 FORMAT('0','S opt, Ref.=Data error bar=0 thus bin ',I5,
- + ' fails.')
- 490 FORMAT('0','Ref or Dat=0 with S opt so bin ',I3, ' passes
- + (no DATA is consistent with anything in this case)')
- 500 FORMAT('0','Ref or Dat=0 with C opt so bin ',I3, ' passes
- + (no DATA is consistent with anything in this case)')
-C
- 650 FORMAT(1X,'BIN',I5,' CHISQ',E10.4,' DIFFS',E10.4)
- 750 FORMAT(1X,'BIN',I5,' DIFFS',E10.4,' NBAD',I5)
- 800 FORMAT(A,E10.4,' (SEE HBPROF)')
-C
- END
diff --git a/src/packlib/hbook/hdiff/hdbsop.F b/src/packlib/hbook/hdiff/hdbsop.F
deleted file mode 100644
index 666be4e..0000000
--- a/src/packlib/hbook/hdiff/hdbsop.F
+++ /dev/null
@@ -1,296 +0,0 @@
-*
-* $Id: hdbsop.F,v 1.1.1.1 1996/01/16 17:07:56 mclareni Exp $
-*
-* $Log: hdbsop.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:56 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.17/02 16/12/92 15.25.28 by Rene Brun
-*-- Author : R. J. Genik II 23/10/92
- SUBROUTINE HDBSOP(TOL,NBINS,NBAD,DIFFS)
-C----------------------------------------------------------------------
-C-
-C- Purpose and Methods : Statistical comparison of 2 histograms
-C- bin by bin (HDIFFB S option)
-C-
-C- Inputs : TOL,NBINS max total number of bins
-C- Outputs : NBAD,DIFFS If DEBUG option on, various messages
-C- Controls: ACDIGT controls the number of significant digits in the
-C- small stat calc. Its default is 2, set in HDBINI
-C- (see below for more info)
-C-
-C- Created 3-DEC-1990 James T. McKinley
-C Michigan State University, USA
-C-
-C- MODIFIED: 24-SEPT-92 R. J. Genik II
-C- Michigan State University, USA
-C-
-C----------------------------------------------------------------------
-C
-C Local and passed variable declarations for HDIFFB S option
-C
-C----------------------------------------------------------------------
-C
-C
-C
- INTEGER NBINS,NBAD,I,J,INDEX,N,NR
- REAL TOL,DIFFS(NBINS),SMLNUM,SUMRD
- REAL MEANR,MEAND,ERRR,ERRD,CHI,HGCONT,FREQ
-C
-C NOTE: R is contents of ID1 = IDR = REFERENCE HISTOGRAM
-C D is contents of ID2 = IDD = DATA HISTOGRAM
-C SIGR is error bars of ID1 = IDR = REFERENCE HISTOGRAM
-C SIGD is error bars of ID2 = IDD = DATA HISTOGRAM
-C
- REAL R,D,SIGR,SIGD
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION DL,DU,P,QQQ,HBNSUM
-#endif
-#include "hbook/hcdifb.inc"
-C
-C
-C======================================================================
-C Do comparisons
-C======================================================================
-C
-C----------------------------------------------------------------------
-C Find the P and Q values used for binomial calculations.
-C----------------------------------------------------------------------
-C
- P=DBLE(1./(1.+LAMBDA))
- QQQ = 1.-P
-C
- NBAD=0
- CHI=0.0
-C
-C
- DO 110 J = BEGINJ, ENDJ
- DO 100 I = BEGINI, ENDI
- R = HGCONT(IDR, I, J, 1)
-C ! Get value from Ref HG
- D = HGCONT(IDD, I, J, 1)
-C ! Value from Dat HG
-C
-C----------------------------------------------------------------------
-C Compute position in DIFFS
-C----------------------------------------------------------------------
-C
- INDEX = I - BEGINI + 1
- IF (TWODIM) INDEX = INDEX + XSIZ*(J - BEGINJ)
-C
-C----------------------------------------------------------------------
-C Default is to pass
-C----------------------------------------------------------------------
- DIFFS(INDEX) = 1.0
-
-C----------------------------------------------------------------------
-C
-C Do actual comparisons. NOTE: R = contents ID1 = IDR = REFERENCE HISTOGRAM
-C D = contents ID2 = IDD = DATA HISTOGRAM
-C
-C----------------------------------------------------------------------
-C Check for negative contents
-C----------------------------------------------------------------------
-C
- IF(R.LT.0.)THEN
- DIFFS(INDEX) = 0.0
-C !absolute fail
- WRITE(DUMPDV,FMT=900) I,J,IDR
- GOTO 90
- ENDIF
- IF(D.LT.0.)THEN
- DIFFS(INDEX) = 0.0
-C !absolute fail
- WRITE(DUMPDV,FMT=900) I,J,IDD
- GOTO 90
- ENDIF
-C
-C
-C----------------------------------------------------------------------
-C If option Z has been selected and Ref or Dat bin = 0, skip bin
-C----------------------------------------------------------------------
-C
- IF((OPTS(ZEROS).EQ.1).AND.((R.EQ.0.).OR.(D.EQ.0))) THEN
- IF (OPTS(DEBUG).EQ.1) WRITE(DUMPDV,FMT=400) I,J
-C ! Debug opt
- GO TO 90
- ENDIF
-C
-C----------------------------------------------------------------------
-C If R=D=0 then skip the comp.
-C----------------------------------------------------------------------
-C
- IF((R+D).EQ.0.) THEN
- IF (OPTS(DEBUG).EQ.1) WRITE(DUMPDV,FMT=410) 'S', I,J
- GO TO 90
- ENDIF
-C
-C======================================================================
-C Large Statistics (R>25 + D>25) + TOL > .001 or WEIGHTED
-C======================================================================
-C
- IF(((R.GE.25).AND.(D.GE.25).AND.(TOL.GE.0.001))
- + .OR.WEIGHR.OR.WEIGHD)THEN
-C
-C----------------------------------------------------------------------
-C Compute mean values for R and D
-C----------------------------------------------------------------------
-C
- MEANR = (R + D)/(1. + LAMBDA)
- MEAND = (R + D)/(1. + 1./LAMBDA)
-C
-C----------------------------------------------------------------------
-C Compute SIGR and SIGD
-C----------------------------------------------------------------------
-C
- SIGR = HGCONT(IDR,I,J,2)
-C ! Get error bar for bin I for Ref
- SIGD = HGCONT(IDD,I,J,2)
-C ! Get error bar for bin I for Data
-C
-C----------------------------------------------------------------------
-C Compute the error values
-C----------------------------------------------------------------------
-C
- ERRR = SQRT((SIGR**2 + SIGD**2)/(1. + LAMBDA**2))
- ERRD = SQRT((SIGR**2 + SIGD**2)/(1. + 1./LAMBDA**2))
-C
-C
-C
-C----------------------------------------------------------------------
-C Trap the case ERRR or ERRD=0
-C----------------------------------------------------------------------
-C
- IF((ERRR.EQ.0.).OR.(ERRD.EQ.0.))THEN
- IF(R.EQ.MEANR.AND.D.EQ.MEAND)THEN
-C ! Absolute pass
- IF(OPTS(DEBUG).EQ.1) WRITE(DUMPDV,FMT=480) 'S',I,J
- GOTO 90
- ELSE
- DIFFS(INDEX)=0.0
-C ! Absolute fail
- IF(OPTS(DEBUG).EQ.1) WRITE(DUMPDV,FMT=490) I,J
- GOTO 90
- ENDIF
-C
-C----------------------------------------------------------------------
-C Compute CHI = sqrt(chisq)
-C----------------------------------------------------------------------
-C
- ELSE
- CHI = SQRT(((R-MEANR)/ERRR)**2 + ((D-MEAND)/ERRD)**2)
- ENDIF
-C
-C----------------------------------------------------------------------
-C Find the probabilities.
-C----------------------------------------------------------------------
-C
- DIFFS(INDEX) = 2.-2.*FREQ(CHI)
-C ! From CERNLIB C300
-C
-C----------------------------------------------------------------------
-C Display debugging information if desired
-C----------------------------------------------------------------------
-C
- IF (OPTS(DEBUG). EQ. 1) THEN
- WRITE(DUMPDV,FMT=500) R, MEANR, ERRR
- WRITE(DUMPDV,FMT=510) D, MEAND, ERRD
- WRITE(DUMPDV,FMT=800) I,J,CHI**2,DIFFS(INDEX)
- ENDIF
- ELSE
-C
-C
-C======================================================================
-C Small Statistics (R<=25 or D<=25) OR TOL < .001
-C======================================================================
-C
-C SUMRD is used in debug dump, but not in calc.
-C
- SUMRD = R+D
-C ! Find the total # of trials
- N = INT(R + D + 0.5)
-C ! for rounding
- NR = INT(R + 0.5)
-C
-C----------------------------------------------------------------------
-C Find either the DL or the DU value (One with fewest terms)
-C----------------------------------------------------------------------
-C
-C Small Num is sent to HBNSUM as the requested accuracy
-C for the returned sum. (see HBNSUM for more details on
-C how this is accomplished)
-C
-C----------------------------------------------------------------------
-C
- SMLNUM = TOL/(2.*10.**(ACDIGT+1.))
- DL=0.0
- DU=0.0
- IF (D.GT.R) THEN
- DL = HBNSUM(NR,0,N,P,QQQ,SMLNUM)
- DU = 1. + HBNSUM(NR,NR,N,P,QQQ,SMLNUM) - DL
- ELSE
- DU = HBNSUM(NR,N,N,P,QQQ,SMLNUM)
- DL = 1. + HBNSUM(NR,NR,N,P,QQQ,SMLNUM) - DU
- ENDIF
-C
-C----------------------------------------------------------------------
-C Calculate the DIFFS value
-C----------------------------------------------------------------------
-C
- DIFFS(INDEX) = 2*MIN(DL,DU)
-C
-C----------------------------------------------------------------------
-C Do the debugging dump
-C----------------------------------------------------------------------
-C
- IF (OPTS(DEBUG).EQ.1) THEN
- WRITE(DUMPDV,FMT=520) R,D,SUMRD
- WRITE(DUMPDV,FMT=530) DL,DU,P
- ENDIF
- ENDIF
- 90 CONTINUE
- IF (DIFFS(INDEX).LT.TOL) NBAD=NBAD+1
- IF (OPTS(DEBUG).EQ.1) THEN
- WRITE(DUMPDV,FMT=810) I,J,DIFFS(INDEX),NBAD
- ENDIF
-C
- 100 CONTINUE
- 110 CONTINUE
-C
-C======================================================================
-C Formats
-C======================================================================
-C----------------------------------------------------------------------
-C Special case indicators
-C----------------------------------------------------------------------
-C
- 400 FORMAT('0','Reference bin ',I5,',',I3,
- + '=0, Z opt, so bin passed')
- 410 FORMAT('0','Ref=Dat=0 with opts ',A,' in bin ',I3,',',I3)
- 480 FORMAT('0','Ref=Dat with opts ',A,' in bin ',I3,',',I3)
- 490 FORMAT('0','S opt, Ref=Data error bar=0, thus bin ',I6,
- + I6, ' fails.')
-C
-C----------------------------------------------------------------------
-C S option data
-C----------------------------------------------------------------------
-C
- 500 FORMAT('0','REF: Cont',E10.4,' Expect',E10.4,' EBar',E10.4)
- 510 FORMAT(1X,'DAT: Cont',E10.4,' Expect',E10.4,' EBar',E10.4)
- 520 FORMAT('0','REF',E10.4,' DAT',E10.4,' SumRD',E10.4)
- 530 FORMAT(1X,' L',E10.4,' U',E10.4,' P',E10.4)
- 540 FORMAT(1X,'The ERR',A,' term = 0, thus only the ',A,
- + ' term is computed.')
-C
-C----------------------------------------------------------------------
-C Result for each bin
-C----------------------------------------------------------------------
-C
- 800 FORMAT(1X,'Bin ',I5,',',I4,': CHISQ',E10.4,' Diffs',E10.4)
- 810 FORMAT(1X,'Bin ',I5,',',I4,': DIFFS',E10.4,' No. Bad',I4)
- 900 FORMAT(1X,'Negative bin contents for BIN=',I6,',',I6,'ID=',I6,
- + 5X,'Negative bin contents not allowed for S and C options')
-C
- END
diff --git a/src/packlib/hbook/hdiff/hdiff.F b/src/packlib/hbook/hdiff/hdiff.F
deleted file mode 100644
index eb85ef3..0000000
--- a/src/packlib/hbook/hdiff/hdiff.F
+++ /dev/null
@@ -1,356 +0,0 @@
-*
-* $Id: hdiff.F,v 1.2 1997/02/21 12:11:51 couet Exp $
-*
-* $Log: hdiff.F,v $
-* Revision 1.2 1997/02/21 12:11:51 couet
-* In the comparison of two scatter plots, if OPT=F1 or OPT=F2
-* the Kolmogoroff probability can become anamalously large.
-* Bug fixed by Garry Levman levman at physics.utoronto.ca
-*
-* Revision 1.1.1.1 1996/01/16 17:07:56 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.23/01 20/02/95 10.13.44 by Julian Bunn
-*-- Author : Fred James, Inc.
- SUBROUTINE HDIFF(ID1,ID2,PRB,CHOPT)
-*.==========>
-*. Statistical test of compatibility in shape between
-*. histograms ID1 and ID2, using Kolmogorov test.
-*. Default: Ignore under- and overflow bins in comparison
-*.
-*. CHOPT is a character string to specify options
-*. 'U' include Underflows in test (also for 2-dim)
-*. 'O' include Overflows (also valid for 2-dim)
-*. 'N' include comparison of normalizations
-*. 'D' Put out a line of 'Debug' printout
-*. 'F1' Histogram 1 has no error (is a function)
-*. 'F2' Histogram 2 has no error (is a function)
-*. and for 2-dim scattergrams only:
-*. 'L'=Left: include x-underflows
-*. 'R'=Right: include x-overflows
-*. 'T'=Top: include y-overflows
-*. 'B'=Bottom: include y-underflows
-*. for example: 'OB' means x- and y-overflows and y-underflows !!
-*.
-*. PRB output parameter : probability of test
-*. (PRB much less than one means NOT compatible)
-*.
-*..=========> ( F.James, March, 1987 )
-#include "hbook/hcbook.inc"
-#include "hbook/hcflag.inc"
-#include "hbook/hcunit.inc"
- LOGICAL AFUNC1, AFUNC2
- CHARACTER*(*) CHOPT
- DIMENSION IOPT(11)
-*.___________________________________________
- PRB = 0.
-* Find addresses of ID1 and ID2
- CALL HFIND(ID1,'HDIFF ')
- IF(LCID.EQ.0)GO TO 99
- LCID1=LCID
- CALL HFIND(ID2,'HDIFF ')
- IF(LCID.EQ.0)GO TO 99
- LCID2=LCID
- NCX1=IQ(LCID1+KNCX)
- NCX2=IQ(LCID2+KNCX)
-*
-* Decode options
- CALL HUOPTC(CHOPT,'UONDLRTBF12',IOPT)
-*
-* Check consistency in number of channels
- IF(NCX1.NE.NCX2)THEN
- CALL HBUG('Number of channels is different','HDIFF',ID1)
- GO TO 99
- ENDIF
-* Check consistency in channel edges
- DIFPREC=1.E-5
- DIFF1=ABS(Q(LCID1+KXMIN)-Q(LCID2+KXMIN))
- DIFF2=ABS(Q(LCID1+KXMAX)-Q(LCID2+KXMAX))
- IF (DIFF1.GT.DIFPREC .OR. DIFF2.GT.DIFPREC) THEN
- CALL HBUG('Different binning','HDIFF',ID1)
- GO TO 99
- ENDIF
-* Check if histograms are in fact functions
- AFUNC1 = .FALSE.
- AFUNC2 = .FALSE.
- IF (IOPT(9) .NE. 0) THEN
- IF (IOPT(10) .NE. 0) AFUNC1 = .TRUE.
- IF (IOPT(11) .NE. 0) AFUNC2 = .TRUE.
- ENDIF
- IF (AFUNC1 .AND. AFUNC2) THEN
- CALL HBUG('Cannot compare two functions','HDIFF',ID1)
- GO TO 99
- ENDIF
- IF (JBIT(IQ(LCID1+KBITS),1).NE. JBIT(IQ(LCID2+KBITS),1)) THEN
- CALL HBUG('Cannot compare 1-dim and 2-dim','HDIFF',ID1)
- GO TO 99
- ENDIF
- IF(JBIT(IQ(LCID1+KBITS),1).EQ.0)GO TO 100
-*
-* 1-DIM HIST ...........................................
- IBEGIN = 1
- IEND = NCX1
- IF (IOPT(1) .NE. 0) IBEGIN = 0
- IF (IOPT(2) .NE. 0) IEND = IEND + 1
-*
- SUM2=0.
- DO 10 I=IBEGIN,IEND
- SUM2=SUM2+HCX(I,1)
- 10 CONTINUE
- TSUM2 = SUM2
- IF (IOPT(1) .EQ. 0) TSUM2 = TSUM2 + HCX(0,1)
- IF (IOPT(2) .EQ. 0) TSUM2 = TSUM2 + HCX(IEND+1,1)
-* Sums for second histogram
- LCONT=LQ(LCID1-1)
- SUM1=0.
- DO 20 I=IBEGIN,IEND
- SUM1=SUM1+HCX(I,1)
- 20 CONTINUE
- TSUM1 = SUM1
- IF (IOPT(1) .EQ. 0) TSUM1 = TSUM1 + HCX(0,1)
- IF (IOPT(2) .EQ. 0) TSUM1 = TSUM1 + HCX(IEND+1,1)
-* Error if one or both histograms is empty
- IF (SUM1.EQ.0.) CALL HBUG('Integral is zero','HDIFF',ID1)
- IF (SUM2.EQ.0.) CALL HBUG('Integral is zero','HDIFF',ID2)
- IF (SUM1.EQ.0. .OR. SUM2.EQ.0.) GO TO 99
- ESUM1 = SUM1
- IF (.NOT. AFUNC1) THEN
-* Check if histogram 1 is weighted.
-* If (number of entries=number of channels) then
-* we assume HPAK has been called
- CALL HNOENT(ID1,NDD)
- DIFSUM1=(REAL(NDD)-TSUM1)/TSUM1
- IF ((DIFSUM1.GT.DIFPREC).AND.(NDD.NE.NCX1)) THEN
- IF (IOPT(1)+IOPT(2) .NE. 0) THEN
- CALL HBUG('U/O option with weighted events',
- + 'HDIFF',ID1)
- GO TO 99
- ENDIF
- IF (LQ(LQ(LCID1-1)) .EQ. 0) THEN
- CALL HBUG('Weighted events and no HBARX','HDIFF',ID1)
- GO TO 99
- ELSE
- ESUM1 = HSTATI(ID1,3,'HIST',1)
- ENDIF
- ENDIF
- ENDIF
-* Look at second histogram
- ESUM2 = SUM2
- IF (.NOT. AFUNC2) THEN
-* Check if histogram 2 is weighted.
- CALL HNOENT(ID2,NDD)
- DIFSUM2=(REAL(NDD)-TSUM2)/TSUM2
- IF ((DIFSUM2.GT.DIFPREC).AND.(NDD.NE.NCX1)) THEN
- IF (IOPT(1)+IOPT(2) .NE. 0) THEN
- CALL HBUG('U/O option with weighted events',
- + 'HDIFF',ID2)
- GO TO 99
- ENDIF
- IF (LQ(LQ(LCID2-1)) .EQ. 0) THEN
- CALL HBUG('Weighted events and no HBARX','HDIFF',ID2)
- GO TO 99
- ELSE
- ESUM2 = HSTATI(ID2,3,'HIST',1)
- ENDIF
- ENDIF
- ENDIF
-*
- S1 = 1.0/SUM1
- S2 = 1.0/SUM2
-*
-* Find largest difference for Kolmogorov Test
- DFMAX = 0.
- RSUM1 = 0.
- RSUM2 = 0.
-*
- DO 30 IBIN= IBEGIN,IEND
- LCONT = LQ(LCID1-1)
- RSUM1 = RSUM1 + S1*HCX(IBIN,1)
- LCONT = LQ(LCID2-1)
- RSUM2 = RSUM2 + S2*HCX(IBIN,1)
- DFMAX = MAX(DFMAX,ABS(RSUM1-RSUM2))
- 30 CONTINUE
-* Get Kolmogorov probability
- IF (AFUNC1) THEN
- Z = DFMAX*SQRT(ESUM2)
- ELSE IF (AFUNC2) THEN
- Z = DFMAX*SQRT(ESUM1)
- ELSE
- Z = DFMAX*SQRT(ESUM1*ESUM2/(ESUM1+ESUM2))
- ENDIF
- PRB = HDIPKL(Z)
- IF (IOPT(3) .NE. 0) THEN
-* Combine probabilities for shape and normalization,
- PRB1 = PRB
- RESUM1 = ESUM1
- IF (AFUNC1) RESUM1 = 0.
- RESUM2 = ESUM2
- IF (AFUNC2) RESUM2 = 0.
- CHISQ = (ESUM1-ESUM2)**2 / (RESUM1+RESUM2)
- PRB2 = PROB(CHISQ,1)
-* see Eadie et al., section 11.6.2
- IF (PRB.GT.0. .AND. PRB2.GT.0.) THEN
- PRB = PRB*PRB2*(1.0-LOG(PRB*PRB2))
- ELSE
- PRB = 0.
- ENDIF
- ENDIF
-* debug printout
- IF (IOPT(4) .NE. 0) THEN
- WRITE (LOUT,2001) ID1,SUM1,CHOPT,PRB,ID2,SUM2,DFMAX
- IF (IOPT(3) .NE. 0) WRITE (LOUT,2002) PRB1,PRB2
- ENDIF
-*
- 2001 FORMAT (/' HDIFF OPTIONS PROB ID1=',I10,' SUM1=',E14.7,
- + ' MAX DIST'/3X,A10,F8.5,' ID2=',I10,' SUM2=',E14.7,
- + 2X,2F8.5)
- 2002 FORMAT (' PROB=',F8.5,' FOR SHAPE ALONE, ',
- + F8.5,' FOR NORMALIZATION ALONE.')
-*
-* This numerical error condition should never occur:
- IF (ABS(RSUM1-1.0) .GT. 0.002)
- + CALL HBUG('Numerical problems','HDIFF',ID1)
- IF (ABS(RSUM2-1.0) .GT. 0.002)
- + CALL HBUG('Numerical problems','HDIFF',ID2)
- GO TO 99
-*
-* 2-DIM HIST .......................................
-*
- 100 CONTINUE
-* Check if number of Y-bins is the same
- NCY1=IQ(LCID1+KNCY)
- NCY2=IQ(LCID2+KNCY)
- IF(NCY1.NE.NCY2)THEN
- CALL HBUG('Number of Y channels is different','HDIFF',ID1)
- GO TO 99
- ENDIF
-* Check consistency in Y-channel edges
- DIFF1=ABS(Q(LCID1+KYMIN)-Q(LCID2+KYMIN))
- DIFF2=ABS(Q(LCID1+KYMAX)-Q(LCID2+KYMAX))
- IF (DIFF1.GT.DIFPREC .OR. DIFF2.GT.DIFPREc) THEN
- CALL HBUG('Different binning in Y','HDIFF',ID1)
- GO TO 99
- ENDIF
-* Should we include Uflows, Oflows?
- IBEG = 1
- IF (IOPT(1).NE.0 .OR. IOPT(5).NE.0) IBEG = 0
- IEND = NCX1
- IF (IOPT(2).NE.0 .OR. IOPT(6).NE.0) IEND = NCX1+1
- JBEG = 1
- IF (IOPT(1).NE.0 .OR. IOPT(8).NE.0) JBEG = 0
- JEND = NCY1
- IF (IOPT(2).NE.0 .OR. IOPT(7).NE.0) JEND = NCY1+1
-*
- LSCAT=LQ(LCID2-1)
- SUM2=0.
- TSUM2 = 0.
- DO 120 I=0,NCX1+1
- DO 110 J=0,NCY1+1
- HSAV = HCXY(I,J,1)
- TSUM2 = TSUM2 + HSAV
- IF (I.GE.IBEG.AND.I.LE.IEND.AND.J.GE.JBEG.AND.
- + J.LE.JEND) SUM2=SUM2+HSAV
- 110 CONTINUE
- 120 CONTINUE
-*
- LSCAT=LQ(LCID1-1)
- SUM1 = 0.
- TSUM1 = 0.
- DO 140 I=0,NCX1+1
- DO 130 J=0,NCY1+1
- HSAV = HCXY(I,J,1)
- TSUM1 = TSUM1 + HSAV
- IF (I.GE.IBEG.AND.I.LE.IEND.AND.J.GE.JBEG.AND.
- + J.LE.JEND) SUM1=SUM1+HSAV
- 130 CONTINUE
- 140 CONTINUE
-* Check that both scatterplots contain events
- IF (SUM1 .EQ. 0.) THEN
- CALL HBUG('Integral is zero','HDIFF',ID1)
- GO TO 99
- ENDIF
- IF (SUM2 .EQ. 0.) THEN
- CALL HBUG('Integral is zero','HDIFF',ID2)
- GO TO 99
- ENDIF
-* Check that scatterplots are not weighted or saturated
- CALL HNOENT(ID1,NUM1)
- IF (REAL(NUM1) .NE. TSUM1) THEN
- CALL HBUG('Saturation or weighted events','HDIFF',ID1)
- GO TO 99
- ENDIF
- CALL HNOENT(ID2,NUM2)
- IF (REAL(NUM2) .NE. TSUM2) THEN
- CALL HBUG('Saturation or weighted events','HDIFF',ID2)
- GO TO 99
- ENDIF
-* Find first Kolmogorov distance for scatterplots
- S1 = 1.0/SUM1
- S2 = 1.0/SUM2
- DFMAX = 0.
- RSUM1 = 0.
- RSUM2 = 0.
- DO 160 I=IBEG,IEND
- DO 150 J= JBEG,JEND
- LSCAT = LQ(LCID1-1)
- RSUM1 = RSUM1 + S1*HCXY(I,J,1)
- LSCAT = LQ(LCID2-1)
- RSUM2 = RSUM2 + S2*HCXY(I,J,1)
- DFMAX = MAX(DFMAX,ABS(RSUM1-RSUM2))
- 150 CONTINUE
- 160 CONTINUE
-* Find second Kolmogorov distance for scatterplots
- DFMAX2 = DFMAX
- DFMAX = 0.
- RSUM1 = 0.
- RSUM2 = 0.
- DO 180 J=JBEG,JEND
- DO 170 I= IBEG,IEND
- LSCAT = LQ(LCID1-1)
- RSUM1 = RSUM1 + S1*HCXY(I,J,1)
- LSCAT = LQ(LCID2-1)
- RSUM2 = RSUM2 + S2*HCXY(I,J,1)
- DFMAX = MAX(DFMAX,ABS(RSUM1-RSUM2))
- 170 CONTINUE
- 180 CONTINUE
-* Get Kolmogorov probability for scatterplot
- IF (AFUNC1) THEN
- FACTNM = SQRT(SUM2)
- ELSE IF (AFUNC2) THEN
- FACTNM = SQRT(SUM1)
- ELSE
- FACTNM = SQRT(SUM1*SUM2/(SUM1+SUM2))
- ENDIF
- Z = DFMAX * FACTNM
- Z2= DFMAX2* FACTNM
- PRB = HDIPKL(0.5*(Z+Z2))
- IF (IOPT(3) .NE. 0) THEN
-* Combine probabilities for shape and normalization,
- PRB1 = PRB
- RESUM1 = SUM1
- IF (AFUNC1) RESUM1 = 0.
- RESUM2 = SUM2
- IF (AFUNC2) RESUM2 = 0.
- CHISQ = (SUM1-SUM2)**2 / (RESUM1+RESUM2)
- PRB2 = PROB(CHISQ,1)
-* see Eadie et al., section 11.6.2
- IF (PRB.GT.0. .AND. PRB2.GT.0.) THEN
- PRB = PRB*PRB2*(1.0-LOG(PRB*PRB2))
- ELSE
- PRB = 0.
- ENDIF
- ENDIF
-* debug printout
- IF (IOPT(4) .NE. 0) THEN
- WRITE (LOUT,2001) ID1,SUM1,CHOPT,PRB,ID2,SUM2,DFMAX,DFMAX2
- IF (IOPT(3) .NE. 0) WRITE (LOUT,2002) PRB1,PRB2
- ENDIF
- IF (ABS(RSUM1-1.0) .GT. 0.002)
- + CALL HBUG('Numerical problems','HDIFF',ID1)
- IF (ABS(RSUM2-1.0) .GT. 0.002)
- + CALL HBUG('Numerical problems','HDIFF',ID2)
- 99 CONTINUE
- IDLAST = 0
- END
diff --git a/src/packlib/hbook/hdiff/hdiffb.F b/src/packlib/hbook/hdiff/hdiffb.F
deleted file mode 100644
index 588388e..0000000
--- a/src/packlib/hbook/hdiff/hdiffb.F
+++ /dev/null
@@ -1,459 +0,0 @@
-*
-* $Id: hdiffb.F,v 1.1.1.1 1996/01/16 17:07:56 mclareni Exp $
-*
-* $Log: hdiffb.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:56 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.20/00 11/06/93 08.28.24 by Rene Brun
-*-- Author : R. J. Genik II 23/10/92
- SUBROUTINE HDIFFB(ID1,ID2,TOL,NBINS,CHOPT,NBAD,DIFFS)
-C------------------------------------------------------------------------
-C-
-C- Purpose and Methods : A bin-by-bin comparator for the HBOOK utility.
-C-
-C- Inputs : ID1 First histogram to compare (Reference)
-C- ID2 Second histogram ID (Data)
-C- TOL Tolerence for passing a test
-C- NBINS Number of bins in comparison
-C- CHOPT String holding the function options
-C- N Use absolute contents of histogram
-C- D Debug printout
-C- O Use overflow bins
-C- U Use underflow bins
-C- S Statistical comparison
-C- C Compatibility test
-C- A Absolute test
-C- Z Zero supress and pass
-C- R Right overflow bin
-C- L Left underflow bin
-C- T Top overflow bin
-C- B Bottom underflow bin
-C-
-C- Outputs : NBAD Number of bins failing test
-C- DIFFS Array holding the individual bin results
-C- Controls: None
-C-
-C- Created 30-JUN-1989 Jason McCampbell
-C- Michigan State University, USA
-C- MODIFIED 20-AUG-1990 James T. McKinley
-C- Michigan State University, USA
-C- MODIFIED 23-AUG-1992 R. J. Genik II
-C- Michigan State University, USA
-C- MODIFIED 8-MAR-1993 R. J. Genik II
-C- Michigan State University, USA
-C-
-C- A-OPTION Now returns signed DIFFS values
-C-
-C----------------------------------------------------------------------
-C NOTE: DIFFS is treated as a 1-d array, even with 2-d output.
-C----------------------------------------------------------------------
-C
-C
-C NOTES ON USE: production release October 1992, D-zero version.
-C
-C The 4 libraries required are: HBOOK4 (Or later version), GENLIB,
-C KERNLIB, and PACKLIB.
-C
-C----------------------------------------------------------------------
-C
-C Local variable declarations for top HDIFFB routine
-C
-C----------------------------------------------------------------------
-C
-#if defined(CERNLIB_HDIFFBDOC)
- --------------------
-
- CALL HDIFFB(ID1,ID2,TOL,NBINS,CHOPT,NBAD*,DIFFS*)
-
-
-Action: Compare two histograms, bin by bin. For each bin, return the
- probability that the contents are from the same distribution. For
- details of the method see below.
-
- The comparison may be done between two 1-dimensional histograms, two
- 2-dimensional histograms, or between two profile histograms.
-
-Input Parameters:
-
- ID1 the first histogram to be compared. The "reference" histogram
- in options A and C.
-
- ID2 the second histogram to be compared. The "data" histogram in
- options A and C.
-
- ID1, ID2 are a pair of histograms, scatterplots, or profile
- histograms booked with the same number of bins.
-
- TOL is the tolerance for a passing the test.
-
- Under options S and C, TOL is a number between 0 and 1 which
- represents the smallest probability considered as an acceptable
- match. TOL = 0.05 will cause DIFFS to reject the bin as bad
- if there is less than a 5% probability the two bins came
- from the same distribution.
-
- Under option A, TOL is the degree of precision of match
- required for the test to be considered as passed. TOL=2.0
- means that a data bin differing from the reference mean by
- less than 2.0 times the reference error is compatible.
-
- NBINS is the number of bins in the comparison. For a 1-dimensional
- histogram, this is the number of bins plus 0, 1 or 2, depending
- on whether the overflow and underflow channels are included.
- For a 2-dimensional histogram, this will have the total number of
- bins plus room for overflow bins along any of the axes requested.
- For more detail, see the discussion of DIFFS below.
-
- CHOPT is a string allowing specification of the following options:
-
- N Use the absolute contents of each histogram, thus including the
- normalization of the histogram as well as its shape in the
- comparison. By default, for the S and C options, in 1- and
- 2-dimensional histograms, the means are adjusted for the
- relative numbers of entries (including any overflow or
- underflow bins requested) in ID1 and ID2. No adjustment is
- ever made for profile histograms.
-
- O Overflow, requests that overflow bins be taken into account.
-
- U Underflow, requests that underflow bins be taken into account.
-
- R Right overflow bin. For a 2-dimensional histogram, it includes
- the X-Axis overflow bin in the comparisons. If the O option
- is used, this is automatic.
-
- L Left underflow bin. Same as above, but the X-Axis underflow is
- used. The U option uses this automatically.
-
- T Top overflow bin. Same as R but for the Y-Axis
-
- B Bottom underflow bin. Option L for the Y-Axis
-
- S Statistical comparison. Calculates the probability that both
- bins were produced from a distribution with the same
- mean. This probability is referred to in TOL and DIFFS.
-
- C Compatibility test. Considers bins of the reference histogram
- (ID1) as perfectly describing the true distribution.
- Calculates the probability that the data (from ID2) was
- produced from that distribution. For 1- or 2-dimensional
- histograms, the Poisson mean is deduced from ID1. For profile
- histograms, the test assumes a Gaussian with mean and standard
- deviation given by the ID1. The C option should be used when
- comparing data to a function, a well-known reference, or a
- calibration distribution.
-
- A Absolute test. Like the C test, except that TOL and DIFFS are in
- terms of the number of standard deviations, rather probability.
- The test is on the number of standard deviations by which the
- data from ID2 deviates from the mean. Both the mean and the
- standard deviation are deduced from ID1 .
-
- Error bars must be on for this option. This forbids overflow
- bins, underflow bins, and 2-dimensional histograms. The A
- option ignores bins with zero contents in reference histogram.
-
- Z Ignores bins with zero contents in the comparison. For the S
- option, ignores bins with zero contents in either histogram.
- For the C and A option, ignores bins with zero contents in the
- reference histogram. The default action is to consider all
- bins as significant.
-
- D Debug printout, dumps the critical variables in the comparisons,
- along with indicators of its weight, etc.
-
- The default (no options selected) does the S option (statistical
- comparison), ignores underflow and overflow bins, and automatically
- corrects for the difference in entries between ID1 and ID2.
-
-
-Output Parameters:
-
- NBAD* is the number of bins failing the comparison according to the
- criteria defined by TOL and CHOPT.
-
- DIFFS* is an array of length the number of bins being compared, which
- gives the results of the test bin by bin (confidence levels for
- options S and C, deviations for A). The results are passed back
- in the form:
-
- 1-dimensional:
- DIFFS(NX) for no over or under flow, or for profile histogram
- DIFFS(0:NX), for underflow
- DIFFS(NX+1), for overflow
- DIFFS(0:NX+1), for overflow and underflow
- 2-dimensional:
- DIFFS(NX,NY) or similarly to above depending on
- which overflow/underflow options selected
-
- The input array must be dimensioned this way in order to be able to
- find the results for each bin.
-
- Note: The calculation of DIFFS is dependent upon the choice of TOL,
- and the contents of each bin, in addition to the type of
- histograms and the test selected (see technical notes).
-
-
-When to use HDIFFB instead of HDIFF
-
- HDIFFB treats the histogram bins individually, while HDIFF treats the
-histogram as a whole. In HDIFF, one is comparing the overall shapes of a
-probability distribution. Typically, an event is entered only in one
-channel, and the choice of channel depends on a measured value of a continuous
-coordinate, so that it makes sense for downward fluctuations in one bin to be
-considered as compensated by upward fluctuations in another bin. In HDIFFB,
-each bin is considered independently, except, perhaps, for an overall
-normalization factor which is the sum over all bins.
-
-Thus HDIFFB is appropriate when
- - it makes sense to identify a single channel as "bad", for example if the
- bin contents correspond to hits in a given detector element
- - the data is heterogeneous, for example if the contents are counts vs
- trigger bit
- - you have already found a discrepancy on a shape with HDIFF and wish to
- focus on where disagreement is worst.
-
- A plot of hits vs detector element, where the detector elements cover some
-angular range is an example of a histogram which might be considered with either
-comparison utility. The choice depends on the question you wish to answer:
-
- - If you want to know if the angular distribution looks the same, use HDIFF.
- - If you want a report on bad detector elements, use HDIFFB.
-
-
-Choice of TOL
-
- If you choose .05 for TOL, you should expect 5 or so bad bins per trial
-from a histogram with 100 channels. For monitoring, you must compromise
-between the number of false messages you can tolerate (based on the total
-number of channels you monitor), and the amount of data you will need to
-collect to claim a channel is bad. In general, a somewhat smaller fraction of
-channels than TOL will be flagged as bad, since for discrete distributions
-(Poisson statistics), the probability is quantized. For example, the
-probability might be .053 for 4 entries, and .021 for 3. If TOL=0.05,
-only bins with 3 or fewer entries would be flagged as bad.
-
-When to use the S option
-
- The S option should be used when both histograms are filled with statistical
-data, for example a momentum distribution from two successive data runs. Using
-the S option when comparing data to a function or known reference yields poor
-results because it attributes errors to both histograms. In this case, the
-C option should be selected.
-
-When to use the C option
-
- The C option assumes that the reference histogram contains the theoretically
-expected values with no (or negligible) errors. Examples might be a flat
-distribution hand-inserted as the expectation for a phi distribution, or
-a long data run to be compared with shorter data runs.
-
-When to use the A option
-
- The A option can be used as an equivalent to the C test by choosing TOL
-in terms of standard deviations instead of probability, and returns z values
-in DIFFS for each bin.
-
- The A option is intended for setting by hand absolute minima and maxima.
-To restrict an efficiency between 80 and 100 %, load the reference histogram
-with a mean of .9 (by HPAK) and the error bar of .1 (via HPAKE), and use HDIFFB
-with TOL = 1.0 and the A option. The N option should also be selected for this
-application.
-
-Comparison of Weighted vs Unweighted events
-
- This is in general undesirable, as it forces you into the less accurate
- Gaussian approximation. Thus it is preferable, for example, to have
- unweighted Monte Carlo events if you need to use HDIFFB to compare with
- data. The only useful case is if the weighted histogram is the reference
- histogram in the C comparison, which only makes sense if you have much
- better accuracy than your data.
-
-Using Profile histograms
-
- The N option is irrelevant for profile histograms. The overflow/underflow
- options are illegal for profile histograms because insufficient information
- is stored to calculate the error bars. None of the test options (S, C, or
- A) check on the number of entries in a profile histogram bin. To do that,
- make a separate 1-dimensional histogram. This has an unexpected effect
- when the number of entries are small. Bins with no entries always pass the
- S and C options (no data is compatible with any distribution), so in such
- cases more bins pass than called for by TOL.
-
-Values of DIFFS
-
- The value of DIFFS may depend somewhat on the value of TOL chosen, as
- the approximation chosen to calculate DIFFS depends on both the number of
- entries and on the size of TOL (how accurately DIFFS must be calcuated).
-
- The S-option sometimes returns a confidence level of 1.0 in the small
- statistics calculation, i.e. there is no probability that the two numbers
- came from different distributions. This is due to finite precision.
- Values slightly higher than 1.0 will be returned when the two content
- values are identical, since no statistical test could claim they came from
- different distributions.
-
-Other notes
-
- The normalization scaling (used unless N option selected) is based on
- channel contents for all channels requested (including overflow/underflow),
- provided you select one of the overflow/underflow options.
-
- Negative bin contents are flagged as bad bins in S, C options.
-
-Statistical methods and numerical notes:
-
- (For simplicity, this is written as if the N option were in effect.)
-
- The methods used for the S and C mode are correct for unweighted events and
- Poisson statistics for 1- or 2- dimensional histograms. Errors may result
- in either the S and C options for small tolerances if bin contents are
- greater than the largest allowed integer.
-
- For the S test with unweighted events, the test (which is uniformly most
- powerful) treats N = sum of the two bin contents as having chosen via a
- binomial distibution which histogram to enter. The binomial parameter p is
- given by the relative normalization of the histograms (.5 if the total
- number of entries in each histogram was the same). For DIFFS values greater
- than TOL, the first two digits are correct. For values less than TOL, the
- two digits to the right of the first non-zero TOL digit are significant.
- i.e. for TOL=0.0001, 0.000xxx are significant. One can force higher
- accuracy by setting TOL smaller (or even 0), but calculation time will
- increase, and warning messages will be issued. A Gaussian approximation is
- used when there are 25 or more events in each bin, and TOL > .001 .
-
- The C test for unweighted events in the data histogram simply calculates
- the Poisson probability of finding n, the ID2 bin value, given a mean
- equal to the bin value of ID1. A Gaussian approximation is used when the
- the mean is 10**6 or larger, and TOL is .001 or larger. Given the
- expected mean, the choice of TOL implies bounds (n<,n>) on n. An error
- occurs when the approximations in calculating DIFFS give an incorrect value
- for n< or n>. No such errors occur for mean < 10**5 and TOL > 10**-15.
- The errors in n< or n> are less than 2 for mean < 10**6, TOL > 10**-6, or
- mean < 10**7, TOL > 10**-5. There is a maximum n beyond which DIFFS
- returns zero, so bins with n > nmax always pass. For mean < 10**7, this
- is irrelevant for values of TOL > 10**-9 .
-
- For the profile histogram S test, HDIFFB calculates the t test
- probability that both bin means were produced from a population with the
- same mean. The C test calculates the probability of finding the
- value in ID1 given a Gaussian with mean and sigma given by the ID2 contents.
- Small numbers of entries for either test give DIFFS values which are
- too large, and HDIFFB will reject too many events in profile histograms.
-
- For weighted events, the S and C tests use a Gaussian approximation.
- This results in DIFFS values which are too low. HDIFFB rejects too many
- bins for weighted events, particularly for small numbers of equivalent
- events.
-
-
-
-
-
-Errors reported by HDIFFB:
-
-Warning: Zero tolerance.
- The passed value TOL is less than or equal to 0. TOL = 0. can be
- used to force highest accuracy in the S-option.
-
-Warning: Only one comparison at a time, please.
- More than one type of comparison was selected. Only one of options S, C,
- and A may be used. The defaults S option will be used.
-
-Warning: Different binning.
- The XMin values for a 1-dimensional histogram or the XMin and/or YMin
- values on a 2-dimensional histogram are different. This may give
- inaccurate results.
-
-Warning: Weighted or saturated events in 2-dimensions.
- HBOOK does not compute error bars for two dimensional histograms, thus
- weighted event are not allowed, and HDIFFB can not compute the correct
- statistics. An answer is still given, but it is probably not right.
- The only reliable case is a weighted 2-dimenension histogram as the
- reference histogram for the C test.
-
-Sum of histogram contents is zero!
- The sum of the content bins is zero.
-
-Both histograms must be the same dimension.
- A 1-dimensional and a 2-dimensional histogram have been specified. In
- order for the routine to work, both must be the same dimensionality.
-
-Both histograms must be the standard or profile type.
- Two different types of histograms have been specified. Both must be
- profile or non-profile. You cannot mix types.
-
-Not enough bins DIFF to hold result.
- The parameter NBINS is less that the number of bins in the histograms.
-
-Number of channels is different.
- The number of channels in the two histograms to compare are different. They
- must be the same before the routine will process the data.
-
-U/O/L/R/T/B Option with weighted events.
- HBOOK does not compute an error bar for over-/under-flow bins, thus it may
- not be used with weighted events.
-
-U/O/L/R/T/B Option with profile histograms.
- HBOOK does not compute an error bar for over-/under-flow bins, thus it may
- not be used with profile histograms.
-
-Weighted options and no HBARX.
- The user had not told HBOOK to figure the error bars for the histograms.
- Therefore, the operations will not be valid.
-
-A-option with no error bars on reference histogram.
- The user has not told HBOOK to compute error bars for the reference
- histogram. This error is also returned when the user attempts to select
- A-option to compare 2-dimensional histograms.
-
-
-Authors:
-
- R. J. Genik II, J. McKinley, J. McCampbell, J. Linnemann, D. Gilliland
- Michigan State University. J. Linnemann (LINNEMAN at MSUPA is the contact
- person)
-#endif
-#include "hbook/hcdifb.inc"
- INTEGER ID1, ID2, NBAD, NBINS
- REAL TOL, DIFFS(NBINS)
- CHARACTER*(*) CHOPT
- LOGICAL ERRORS
-C
-C
-C=====================================================================
-C Call initialization and error checking routine HDBINI
-C=====================================================================
-C
-C
-C
- CALL HDBINI(ID1,ID2,TOL,NBINS,CHOPT,ERRORS)
- IF(ERRORS) GOTO 999
-C
-C
-C=====================================================================
-C Do actual comparisons.
-C=====================================================================
-C
- IF (PROFIL) THEN
- CALL HDBPRF(TOL,NBINS,NBAD,DIFFS)
-C ! Profile S,C,or A
- ELSEIF (OPTS(COPTN).EQ.1) THEN
-C ! C option
- CALL HDBCOP(TOL,NBINS,NBAD,DIFFS)
- ELSEIF (OPTS(AOPTN).EQ.1) THEN
-C ! A option
- CALL HDBAOP(TOL,NBINS,NBAD,DIFFS)
- ELSE
-C ! S option
- CALL HDBSOP(TOL,NBINS,NBAD,DIFFS)
- ENDIF
-C
-C=====================================================================
-C Go back from whence we came...
-C=====================================================================
- 999 RETURN
- END
diff --git a/src/packlib/hbook/hdiff/hgcont.F b/src/packlib/hbook/hdiff/hgcont.F
deleted file mode 100644
index 0887743..0000000
--- a/src/packlib/hbook/hdiff/hgcont.F
+++ /dev/null
@@ -1,81 +0,0 @@
-*
-* $Id: hgcont.F,v 1.1.1.1 1996/01/16 17:07:56 mclareni Exp $
-*
-* $Log: hgcont.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:56 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.23/01 20/02/95 10.16.43 by Julian Bunn
-*-- Author : R. J. Genik II 23/10/92
- FUNCTION HGCONT(IDDD, IX, IY, FUNC)
-C----------------------------------------------------------------------
-C-
-C- Purpose and Methods : Returns the content of the histogram IDDD at
-C- bin (IX,IY).
-C-
-C- Returned value : Real value with content of (IX,IY)
-C- Inputs : IDDD HBook ID pointer for histogram.
-C- IX X bin of point
-C- IY Y bin of point
-C- Func Specified function to perform
-C- 1 = Get 1-D content
-C- 2 = Get 1-D error bar
-C- 3 = Get # entries from profile hist
-C- Outputs : None
-C- Controls: TWODIM from /HDBCOM/
-C-
-C- Created 24-JUL-1989 Jason McCampbell (MSU)
-C- Updated 17-SEP-1992 James T. Linnemann IX, IY; add profile hist; allow
-C- for errors on histos w/o error bars
-C-
-C----------------------------------------------------------------------
-C
-C
-#include "hbook/hcbook.inc"
-#include "hbook/hcdifb.inc"
-C---------------------------------------------------------------------
-C Local and passed declarations
-C---------------------------------------------------------------------
-C
- INTEGER IDDD, IX, IY, FUNC
- INTEGER LW, LN
- REAL HGCONT, HCX, HCXY
-C
-C=====================================================================
-C Get contents...
-C=====================================================================
-C
- CALL HFIND(IDDD,'HGCONT')
- IF ( TWODIM ) THEN
- HGCONT = HCXY(IX, IY, 1)
- IF (FUNC.EQ.2) HGCONT = HCXY(IX, IY, 2)
- ELSE
- IF (FUNC.EQ.1) THEN
- HGCONT = HCX(IX,1)
- ELSEIF (FUNC.EQ.2) THEN
-C
-C---------------------------------------------------------------------
-C...check if the histogram had an error bar; if not use sqrt errors
-C---------------------------------------------------------------------
-C
- IF ( LQ(LQ(LCID-1)).NE.0) THEN
- HGCONT = HCX(IX, FUNC)
- ELSE
- HGCONT = HCX(IX,1)
- HGCONT = SQRT(ABS(HGCONT))
- ENDIF
- ELSE
-C
-C---------------------------------------------------------------------
-C want profile # of counts; Find the pointers
-C---------------------------------------------------------------------
-C
- LCONT=LQ(LCID-1)
- LW=LQ(LCONT)
- LN=LQ(LW)
- HGCONT = Q(LN+IX)
- ENDIF
- ENDIF
- END
diff --git a/src/packlib/hbook/hdiff/hlbino.F b/src/packlib/hbook/hdiff/hlbino.F
deleted file mode 100644
index 8c30a1e..0000000
--- a/src/packlib/hbook/hdiff/hlbino.F
+++ /dev/null
@@ -1,65 +0,0 @@
-*
-* $Id: hlbino.F,v 1.1.1.1 1996/01/16 17:07:56 mclareni Exp $
-*
-* $Log: hlbino.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:56 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.17/01 23/10/92 11.51.54 by R. J. Genik II
-*-- Author : R. J. Genik II 23/10/92
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION FUNCTION HLBINO(N,IR)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- REAL FUNCTION HLBINO(N,IR)
-#endif
-C----------------------------------------------------------------------
-C-
-C- Purpose and Methods : CALCULATE LOG OF BINOMIAL COEFFICIENTS
-C-
-C- Returned value : (DOUBLE PRECISION) LOG OF BINOMIAL COEFFICIENT
-C- Inputs : N,R integers
-C- Outputs : NONE
-C-
-C- Created 21-OCT-1992 R. J. Genik II
-C----------------------------------------------------------------------
-C
- INTEGER N,IR
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION HLNFCT,DBINOM
-#endif
-#if !defined(CERNLIB_DOUBLE)
- REAL BINOM
-#endif
-C
-#include "hbook/hcdifb.inc"
-C
-C======================================================================
-C
-C GET LOG(BC)
-C
-C USE STIRLING TO CHECK FOR O-FLOW, FIRST ORDER CORRECTION => 6 DIGITS
-C FOR X! AT X=100, MORE FOR X GREATER. (CF BEYER, GAMMA FUNCT)
-C----------------------------------------------------------------------
-C
-C
- HLBINO = HLNFCT(N) - HLNFCT(IR) - HLNFCT(N-IR)
-C
-C----------------------------------------------------------------------
-C IF WE ARE WITHIN MACHINE LIMITS, GET THE MORE ACCURATE NUMBER, DBINOM
-C AND SET IT EQUAL TO HLBINO, ON 64 BIT MACHINES, USE BINOM.
-C (CERNLIB B100)
-C----------------------------------------------------------------------
-C
-C
-#if defined(CERNLIB_DOUBLE)
- IF (HLBINO.LT.LNBIGP) HLBINO = LOG(DBINOM(DBLE(N),IR))
-#endif
-#if !defined(CERNLIB_DOUBLE)
- IF (HLBINO.LT.LNBIGP) HLBINO = LOG(BINOM(REAL(N),IR))
-#endif
-C
-C----------------------------------------------------------------------
- END
diff --git a/src/packlib/hbook/hdiff/hlnfct.F b/src/packlib/hbook/hdiff/hlnfct.F
deleted file mode 100644
index 8b4f63f..0000000
--- a/src/packlib/hbook/hdiff/hlnfct.F
+++ /dev/null
@@ -1,54 +0,0 @@
-*
-* $Id: hlnfct.F,v 1.1.1.1 1996/01/16 17:07:56 mclareni Exp $
-*
-* $Log: hlnfct.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:56 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.17/01 23/10/92 11.51.54 by R. J. Genik II
-*-- Author : R. J. Genik II 23/10/92
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION FUNCTION HLNFCT(X)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- REAL FUNCTION HLNFCT(X)
-#endif
-C----------------------------------------------------------------------
-C-
-C- Purpose : CALCULATES LOG OF X! WITH 1ST ORDER CORREECTION
-C- TO STIRLING APPROXIMATION
-C-
-C- Returned value : (DOUBLE PRECISION) LOG OF X!
-C- Inputs : X integers
-C- Outputs : NONE
-C- Controls: NONE
-C-
-C- Created 17-OCT-1992 R. J. Genik II
-C----------------------------------------------------------------------
-C
- INTEGER X
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION DXPHLF,DXPONE,DLRT2P
-#endif
- PARAMETER (DLRT2P = 0.9189385332047)
-C
-C----------------------------------------------------------------------
-C
-C DLRT2P = LOG(SQRT(2*pi)), used in Stirling
-C First check if we need to calc, else return 1 for x=0,1, or
-C zero for x<0
-C----------------------------------------------------------------------
-C
- IF (X.GT.1) THEN
- DXPHLF = X + 0.5
- DXPONE = X+1.
- HLNFCT = DXPHLF*LOG(DXPONE) - DXPONE + DLRT2P
- + + LOG(1. + 1./(12.*DXPONE))
- ELSEIF (X.LT.0) THEN
- HLNFCT = 0.
- ELSE
- HLNFCT = 1.
- ENDIF
- END
diff --git a/src/packlib/hbook/hglobal/Imakefile b/src/packlib/hbook/hglobal/Imakefile
deleted file mode 100644
index 0a5b7d2..0000000
--- a/src/packlib/hbook/hglobal/Imakefile
+++ /dev/null
@@ -1,4 +0,0 @@
-SRCS_F= hcreateg.F hfreeg.F hlnxtg.F hlnxtg1.F hmapg.F hopengbl.F hplisg.F \ @@\
- hplisg1.F hresetg.F hresetg1.F hrez0g.F hrzing.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/hbook/hglobal/hcreateg.F b/src/packlib/hbook/hglobal/hcreateg.F
deleted file mode 100644
index 6064bb8..0000000
--- a/src/packlib/hbook/hglobal/hcreateg.F
+++ /dev/null
@@ -1,155 +0,0 @@
-*
-* $Id: hcreateg.F,v 1.1.1.1 1996/01/16 17:08:09 mclareni Exp $
-*
-* $Log: hcreateg.F,v $
-* Revision 1.1.1.1 1996/01/16 17:08:09 mclareni
-* First import
-*
-*
-#if defined(CERNLIB_VAX)
-#include "hbook/pilot.h"
-*CMZ : 4.22/09 21/07/94 18.55.55 by Fons Rademakers
-*-- Author :
- FUNCTION hcreateg(global_name,base_common,size)
-*
-* J.G. Loken 1/11/87
-*
-* Last modification: 16/11/93 - cater for variable size
-* pages on AXP (JDS)
-*
-* Function to create and map a global section.
-*
-* This function first opens a file with UFO option (using HST_OPEN_GBL),
-* then creates and maps the global section using SYS$CRMPSC.
-* Open the file using SYS$SETDFPROT to set protection loose.
-*
-* GLOBAL_NAME is the name of the section to be mapped.
-* BASE_COMMON is the first word of the COMMON to be mapped.
-* SIZE is the size of the common in words.
-* HCREATEG is returned equal to the global section length (pages) if OK,
-* or as an error if not (< 0).
-*
-* HCREATEG$DIR is a logical which, if defined, gives the directory
-* for the mapping file of the global section.
-* In this case, the file is not deleted upon closing.
-*
- INCLUDE '($SECDEF)/NOLIST'
- INCLUDE '($SSDEF)/NOLIST'
-* INCLUDE '($SYIDEF)/NOLIST'
-*
-* Hard code item code for pre V5.5 systems
-*
- PARAMETER (SYI$_PAGE_SIZE=4452)
-*
- CHARACTER*(*) global_name
- CHARACTER*255 ERRMSG
- CHARACTER*80 name
- CHARACTER*80 file_dir
- CHARACTER*7 open_status
- INTEGER*4 len_dir,istat,lib$sys_trnlog,length
- INTEGER*4 base_common,size
- INTEGER*4 inad(2),rtad(2),flag,inchan,npages,apages
- INTEGER*4 hcreateg,iprot,jprot
- INTEGER*4 str$trim,sys$getsyiw
-*
- INTEGER*4 hopen_gbl
- EXTERNAL hopen_gbl
- COMMON/opencom/inchan,apages
- INTEGER*4 gbl_lun
-*
-* System services
-*
- INTEGER*4 sys$crmpsc,sys$getsyi,sys$setdfprot
- INTEGER*4 sys$getmsg
- INTEGER*4 sec$m_temp/0/ !test replacement for perm
-
- STRUCTURE /ITMLST/
- UNION
- MAP
- INTEGER*2 BUFFER_LENGTH
- INTEGER*2 ITEM_CODE
- INTEGER*4 BUFFER_ADDRESS
- INTEGER*4 RETURN_LENGTH_ADDRESS
- ENDMAP
- MAP
- INTEGER*4 END_LIST /0/
- ENDMAP
- END UNION
- END STRUCTURE
-
- RECORD /ITMLST/ SYI_LIST(2)
-
- INTEGER IOSB(2)
-*
-*
-***************************************************************************
-*
- istat = str$trim(name,global_name,length)
- npages=(size+127)/128
-*
-* Look for directory for mapping file.
-*
-*
- istat = lib$sys_trnlog ('HCREATEG$DIR',len_dir,file_dir)
- IF (istat .EQ. SS$_NORMAL) THEN
- open_status = 'UNKNOWN'
- ELSE
- file_dir = ' '
- len_dir = 0
- open_status = 'SCRATCH'
- ENDIF
-*
-* Setup histogram global section.
-*
- istat = lib$get_lun(gbl_lun)
- iprot = 0
- istat = sys$setdfprot(iprot,jprot)
-*
- OPEN(UNIT=gbl_lun,STATUS=open_status,
- & FILE=file_dir(1:len_dir)//name(1:length)//'.GBL',
- & RECL=512,RECORDTYPE='FIXED',NOSPANBLOCKS,INITIALSIZE=NPAGES,
- & EXTENDSIZE=512,CARRIAGECONTROL='NONE',USEROPEN=hopen_gbl)
-*
- istat = sys$setdfprot(jprot,iprot)
-*
- npages=min(npages,apages)
- inad(1)=%loc(base_common)
- if ( mod(inad(1),512) .ne. 0) then
- call hbug('Start address of global section '''//name(1:length)//
- + ''' is not PAGE aligned','HCREATEG',0)
- endif
-*
-* Get page size of this machine
-*
- SYI_LIST(1).BUFFER_LENGTH = 4
- SYI_LIST(1).ITEM_CODE = SYI$_PAGE_SIZE
- SYI_LIST(1).BUFFER_ADDRESS = %LOC(ISIZE)
- SYI_LIST(1).RETURN_LENGTH_ADDRESS = %LOC(LSIZE)
-
- SYI_LIST(2).END_LIST = 0
-
- ISTAT = SYS$GETSYIW(,,,SYI_LIST,IOSB,,)
-*
-* Assume that we are on a VAX in case of problems
-* (e.g. unknown item code)
-*
- IF(.NOT.ISTAT.OR..NOT.IOSB(1)) ISIZE = 512
-
- inad(2)=inad(1)+ISIZE*npages-1
- flag=sec$m_gbl+sec$m_wrt+sec$m_temp
- hcreateg=sys$crmpsc(inad,rtad,,%val(flag)
- & ,name(1:length),,,%VAL(inchan),%VAL(npages),,,)
- IF((hcreateg.AND.1).EQ.0) THEN
-*
-* Get error message
-*
- istat = sys$getmsg(%val(hcreateg),lenmsg,errmsg,,)
- CALL HBUG(ERRMSG(1:LENMSG),'HCREATEG',0)
- hcreateg=-hcreateg
- ELSE
- hcreateg=(rtad(2)-rtad(1)+1)/ISIZE
- ENDIF
-*
- RETURN
- END
-#endif
diff --git a/src/packlib/hbook/hglobal/hfreeg.F b/src/packlib/hbook/hglobal/hfreeg.F
deleted file mode 100644
index b227d80..0000000
--- a/src/packlib/hbook/hglobal/hfreeg.F
+++ /dev/null
@@ -1,45 +0,0 @@
-*
-* $Id: hfreeg.F,v 1.1.1.1 1996/01/16 17:08:09 mclareni Exp $
-*
-* $Log: hfreeg.F,v $
-* Revision 1.1.1.1 1996/01/16 17:08:09 mclareni
-* First import
-*
-*
-#if defined(CERNLIB_VAX)
-#include "hbook/pilot.h"
-*CMZ : 4.10/05 29/03/89 14.35.22 by Rene Brun
-*-- Author :
- FUNCTION hfreeg(global_size,base_common,off_set)
-*
-* J.G. Loken 1/11/87
-*
-* Function to dynamically delete/unmap global section space
-* using the service SYS$DELTVA.
-*
-* GLOBAL_SIZE is the size of the section to be freed (pages).
-* BASE_COMMON is the first word of reference COMMON.
-* OFF_SET is the offset from BASE_COMMON of the mapped section in words.
-* i.e., BASE_COMMON(OFF_SET) is the first word.
-* HFREEG is returned equal to the global section length (pages) if OK,
-* or as an error if not (< 0).
-*
- INTEGER*4 global_size,base_common,off_set,hfreeg,sys$deltva
- INTEGER*4 inad(2)
- DIMENSION base_common(*)
-*
-*
-******************************************************************************
-*
- inad(1)=%loc(base_common(off_set))
- inad(2)=inad(1)+global_size*512-1
- hfreeg = sys$deltva(inad,,)
- IF((hfreeg.AND.1).EQ.0) THEN
- hfreeg=-hfreeg
- ELSE
- hfreeg=global_size
- ENDIF
- RETURN
- END
-
-#endif
diff --git a/src/packlib/hbook/hglobal/hlnxtg.F b/src/packlib/hbook/hglobal/hlnxtg.F
deleted file mode 100644
index 9a340c0..0000000
--- a/src/packlib/hbook/hglobal/hlnxtg.F
+++ /dev/null
@@ -1,59 +0,0 @@
-*
-* $Id: hlnxtg.F,v 1.1.1.1 1996/01/16 17:08:09 mclareni Exp $
-*
-* $Log: hlnxtg.F,v $
-* Revision 1.1.1.1 1996/01/16 17:08:09 mclareni
-* First import
-*
-*
-#if defined(CERNLIB_VAX)
-#include "hbook/pilot.h"
-*CMZ : 4.21/06 06/12/93 18.28.53 by Rene Brun
-*-- Author : Rene Brun 06/12/93
- SUBROUTINE HLNXTG(IPAWD,IDH,CHTYPE,CHTITL,CHOPT)
-*.==========>
-*. To return next object from global section IPAWD
-*..=========> ( R.Brun)
-#include "hbook/hcdire.inc"
- CHARACTER*(*) CHTYPE,CHTITL,CHOPT
- DIMENSION IHDIR(4)
- DIMENSION IPAWD(100)
- SAVE NEXT
-*.___________________________________________
- JR1=IPAWD(11)
-*
-* Search levels down
-*
- IF(NLPAT.GT.1)THEN
- DO 50 IL=2,NLPAT
- CALL UCTOH(CHPAT(IL),IHDIR,4,16)
- JR1=IPAWD(JR1+9)
- 30 IF(JR1.EQ.0)GO TO 99
- DO 40 I=1,4
- IF(IHDIR(I).NE.IPAWD(JR1+I+18))THEN
- JR1=IPAWD(JR1+10)
- GO TO 30
- ENDIF
- 40 CONTINUE
- 50 CONTINUE
- ENDIF
-*
- JCDIR = JR1
- JTAB = IPAWD(JCDIR+7)
-*
- NTOT =IPAWD(JTAB+17)
- IF(IDH.EQ.0)NEXT=0
- 60 NEXT=NEXT+1
- IF(NEXT.GT.NTOT)THEN
- IDH=0
- GO TO 99
- ENDIF
- JCID=IPAWD(JTAB-NEXT+10)
- IF(JCID.EQ.0)GO TO 60
- ID1=IPAWD(JTAB+NEXT+18)
- CALL HLNXTG1(IPAWD(19),IPAWD(11),ID1,JCID,IDH,CHTYPE,CHTITL,CHOPT)
- IF(IDH.EQ.0)GO TO 60
-*
- 99 RETURN
- END
-#endif
diff --git a/src/packlib/hbook/hglobal/hlnxtg1.F b/src/packlib/hbook/hglobal/hlnxtg1.F
deleted file mode 100644
index 603c6f3..0000000
--- a/src/packlib/hbook/hglobal/hlnxtg1.F
+++ /dev/null
@@ -1,75 +0,0 @@
-*
-* $Id: hlnxtg1.F,v 1.1.1.1 1996/01/16 17:08:09 mclareni Exp $
-*
-* $Log: hlnxtg1.F,v $
-* Revision 1.1.1.1 1996/01/16 17:08:09 mclareni
-* First import
-*
-*
-#if defined(CERNLIB_VAX)
-#include "hbook/pilot.h"
-*CMZ : 27/07/95 17.20.16 by Julian Bunn
-*-- Author : Rene Brun 06/12/93
- SUBROUTINE HLNXTG1(IB,LB,ID1,JCID,IDH,CHTYPE,CHTITL,CHOPT)
-*.==========>
-*. Auxiliary for HLNXTG
-*..=========> ( R.Brun)
-#include "hbook/hcbook.inc"
-#include "hbook/hcflag.inc"
-#include "hbook/hcntpar.inc"
- CHARACTER*(*) CHTYPE,CHTITL,CHOPT
- DIMENSION IB(1),LB(1)
-*.___________________________________________
-#include "hbook/jbyt.inc"
- I123=JBYT(IB(JCID+KBITS),1,3)
- I230=JBYT(IB(JCID+KBITS),2,2)
- I1 =JBIT(I123,1)
- I4 =JBIT(IB(JCID+KBITS),4)
-*
-*
- IF(I1.NE.0)THEN
- NWTITL=IB(JCID-1)-KTIT1+1
- IF(INDEX(CHOPT,'1').NE.0) THEN
- IDH=ID1
- CHTYPE='1'
- CHTITL=' '
- CALL UHTOC(IB(JCID+KTIT1),4,CHTITL,NWTITL*4)
- RETURN
- ENDIF
- ELSEIF(I230.NE.0)THEN
- NWTITL=IB(JCID-1)-KTIT2+1
- IF(INDEX(CHOPT,'2').NE.0) THEN
- IDH=ID1
- CHTYPE='2'
- CHTITL=' '
- CALL UHTOC(IB(JCID+KTIT2),4,CHTITL,NWTITL*4)
- RETURN
- ENDIF
- ELSEIF(I4.NE.0)THEN
- IF (IB(JCID-2) .EQ. 2) THEN
- ITIT1=JCID+IB(JCID+9)
- NWTITL=IB(JCID+8)
- ELSE
- ITIT1=JCID+IB(JCID+ZITIT1)
- NWTITL=IB(JCID+ZNWTIT)
- ENDIF
- IF(INDEX(CHOPT,'N').NE.0) THEN
- IDH=ID1
- CHTYPE='N'
- CHTITL=' '
- CALL UHTOC(IB(ITIT1),4,CHTITL,NWTITL*4)
- RETURN
- ENDIF
- ELSE
- IF(INDEX(CHOPT,'?').NE.0) THEN
- IDH=-1
- CHTYPE='?'
- CHTITL='??? '
- RETURN
- ENDIF
- GO TO 99
- ENDIF
-*
- 99 RETURN
- END
-#endif
diff --git a/src/packlib/hbook/hglobal/hmapg.F b/src/packlib/hbook/hglobal/hmapg.F
deleted file mode 100644
index c2fba90..0000000
--- a/src/packlib/hbook/hglobal/hmapg.F
+++ /dev/null
@@ -1,65 +0,0 @@
-*
-* $Id: hmapg.F,v 1.1.1.1 1996/01/16 17:08:09 mclareni Exp $
-*
-* $Log: hmapg.F,v $
-* Revision 1.1.1.1 1996/01/16 17:08:09 mclareni
-* First import
-*
-*
-#if defined(CERNLIB_VAX)
-#include "hbook/pilot.h"
-*CMZ : 4.10/05 29/03/89 14.37.04 by Rene Brun
-*-- Author :
- FUNCTION hmapg(global_name,base_common,off_set)
-*
-* J.G. Loken 1/11/87
-*
-* Function to dynamically map to an existing global section.
-*
-* This function maps to the global section using SYS$MGBLSC,
-* allocating pages in the p0 region with the sec$m_expreg option.
-*
-* GLOBAL_NAME is the name of the section to be mapped.
-* BASE_COMMON is the first word of reference COMMON.
-* OFF_SET is the offset from BASE_COMMON of the mapped section in words.
-* i.e., BASE_COMMON(OFF_SET) is the first word.
-* HMAPG is returned equal to the global section length (pages) if OK,
-* or as an error if not (< 0).
-*
- CHARACTER*(*) global_name
- CHARACTER*80 name
- INTEGER*4 base_common,off_set,new_addr,old_addr
- INTEGER*4 inad(2),rtad(2),flag
- INTEGER*4 hmapg
-*
- INTEGER*4 sys$mgblsc
-*
- INCLUDE '($SECDEF)/NOLIST'
-*
-***************************************************************************
-*
- CALL str$trim(name,global_name,length)
- inad(1)=0
- inad(2)=0
-*
-* Give read/write access to mapped section.
-* Also, use the expreg option to get its own VM space.
-*
- flag=sec$m_gbl+sec$m_wrt+sec$m_expreg
-*
- hmapg=sys$mgblsc(inad,rtad,,%val(flag),name(1:length),,)
- IF((hmapg.AND.1).EQ.0) THEN
- hmapg=-hmapg
- RETURN
- ELSE
- hmapg=(rtad(2)-rtad(1)+1)/512
- ENDIF
-*
- new_addr=rtad(1)
- old_addr=%loc(base_common)
- off_set=1+(new_addr-old_addr)/4
-*
- RETURN
- END
-
-#endif
diff --git a/src/packlib/hbook/hglobal/hopengbl.F b/src/packlib/hbook/hglobal/hopengbl.F
deleted file mode 100644
index 1b9cc4b..0000000
--- a/src/packlib/hbook/hglobal/hopengbl.F
+++ /dev/null
@@ -1,42 +0,0 @@
-*
-* $Id: hopengbl.F,v 1.1.1.1 1996/01/16 17:08:09 mclareni Exp $
-*
-* $Log: hopengbl.F,v $
-* Revision 1.1.1.1 1996/01/16 17:08:09 mclareni
-* First import
-*
-*
-#if defined(CERNLIB_VAX)
-#include "hbook/pilot.h"
-*CMZ : 4.10/05 21/02/89 16.14.55 by Rene Brun
-*-- Author :
- FUNCTION HOPEN_GBL(FAB,RAB,IUNIT)
-*
-* J.G. Loken 1/11/87
-*
-* This function sets the UFO option, opens the file,
-* and returns the channel number and allocated space.
-*
- COMMON/OPENCOM/INCHAN,APAGES
-*
- INCLUDE '($FABDEF)/NOLIST'
- RECORD/FABDEF/FAB
-*
- INTEGER*4 HOPEN_GBL,RET_STATUS,SYS$CREATE,APAGES
-*
-*********************************************************************
-*
-* Set User File Open option.
-*
- FAB.FAB$L_FOP=FAB.FAB$L_FOP.OR.FAB$M_UFO
-*
-* Create/Open file, return channel number and allocated pages.
-*
- RET_STATUS=SYS$CREATE(FAB,,)
- INCHAN=FAB.FAB$L_STV
- APAGES=FAB.FAB$L_ALQ
-*
- HOPEN_GBL=RET_STATUS
- RETURN
- END
-#endif
diff --git a/src/packlib/hbook/hglobal/hplisg.F b/src/packlib/hbook/hglobal/hplisg.F
deleted file mode 100644
index e4bd65d..0000000
--- a/src/packlib/hbook/hglobal/hplisg.F
+++ /dev/null
@@ -1,51 +0,0 @@
-*
-* $Id: hplisg.F,v 1.1.1.1 1996/01/16 17:08:09 mclareni Exp $
-*
-* $Log: hplisg.F,v $
-* Revision 1.1.1.1 1996/01/16 17:08:09 mclareni
-* First import
-*
-*
-#if defined(CERNLIB_VAX)
-#include "hbook/pilot.h"
-*CMZ : 4.20/09 16/09/93 09.10.57 by Rene Brun
-*-- Author :
- SUBROUTINE HPLISG(IPAWD)
-*.==========>
-*. To list histograms in global section IPAWD
-*..=========> ( R.Brun)
-#include "hbook/hcdire.inc"
- DIMENSION IHDIR(4)
- DIMENSION IPAWD(100)
-*.___________________________________________
- JR1=IPAWD(11)
-*
-* Search levels down
-*
- IF(NLPAT.GT.1)THEN
- DO 50 IL=2,NLPAT
- CALL UCTOH(CHPAT(IL),IHDIR,4,16)
- JR1=IPAWD(JR1+9)
- 30 IF(JR1.EQ.0)GO TO 99
- DO 40 I=1,4
- IF(IHDIR(I).NE.IPAWD(JR1+I+18))THEN
- JR1=IPAWD(JR1+10)
- GO TO 30
- ENDIF
- 40 CONTINUE
- 50 CONTINUE
- ENDIF
-*
- JCDIR = JR1
- JTAB = IPAWD(JCDIR+7)
-*
- NTOT =IPAWD(JTAB+17)
- DO 60 I=1,NTOT
- IF(IPAWD(JTAB-I+10).EQ.0)GO TO 60
- ID1=IPAWD(JTAB+I+18)
- CALL HPLISG1(IPAWD(19),IPAWD(11),ID1,JTAB)
- 60 CONTINUE
-*
- 99 RETURN
- END
-#endif
diff --git a/src/packlib/hbook/hglobal/hplisg1.F b/src/packlib/hbook/hglobal/hplisg1.F
deleted file mode 100644
index fbd871c..0000000
--- a/src/packlib/hbook/hglobal/hplisg1.F
+++ /dev/null
@@ -1,62 +0,0 @@
-*
-* $Id: hplisg1.F,v 1.1.1.1 1996/01/16 17:08:09 mclareni Exp $
-*
-* $Log: hplisg1.F,v $
-* Revision 1.1.1.1 1996/01/16 17:08:09 mclareni
-* First import
-*
-*
-#if defined(CERNLIB_VAX)
-#include "hbook/pilot.h"
-*CMZ : 4.20/09 16/09/93 11.02.44 by Rene Brun
-*-- Author : Rene Brun 27/07/93
- SUBROUTINE HPLISG1(IB,LB,ID1,JTAB)
-*.==========>
-*. Auxiliary for HPLISG
-*..=========> ( R.Brun)
-#include "hbook/hcbook.inc"
-#include "hbook/hcflag.inc"
-#include "hbook/hcunit.inc"
-#include "hbook/hcntpar.inc"
- DIMENSION IB(1),LB(1)
-*.___________________________________________
-#include "hbook/jbyt.inc"
- NH=IB(JTAB-1)
- DO 10 I=1,NH
- IF(IB(JTAB+I).EQ.ID1)GO TO 20
- 10 CONTINUE
- GO TO 99
-*
- 20 CONTINUE
-C ID=ID1
- JCID=LB(JTAB-I)
- NTOT=IB(JCID+KNTOT)
- I123=JBYT(IB(JCID+KBITS),1,3)
- I230=JBYT(IB(JCID+KBITS),2,2)
- I1 =JBIT(I123,1)
- I4 =JBIT(IB(JCID+KBITS),4)
-*
-*
- IF(I1.NE.0)THEN
- NWTITL=IB(JCID-1)-KTIT1+1
- ITIT1=JCID+KTIT1
- ELSEIF(I230.NE.0)THEN
- NWTITL=IB(JCID-1)-KTIT2+1
- ITIT1=JCID+KTIT2
- ELSEIF(I4.NE.0)THEN
- IF (IB(JCID-2) .EQ. 2) THEN
- ITIT1=JCID+IB(JCID+9)
- NWTITL=IB(JCID+8)
- ELSE
- ITIT1=JCID+IB(JCID+ZITIT1)
- NWTITL=IB(JCID+ZNWTIT)
- ENDIF
- ELSE
- GO TO 99
- ENDIF
- WRITE (LOUT,1001) ID1,(IB(KK),KK=ITIT1,ITIT1+NWTITL-1)
-1001 FORMAT(1X,I12,2X,15A4)
-*
- 99 RETURN
- END
-#endif
diff --git a/src/packlib/hbook/hglobal/hresetg.F b/src/packlib/hbook/hglobal/hresetg.F
deleted file mode 100644
index d622441..0000000
--- a/src/packlib/hbook/hglobal/hresetg.F
+++ /dev/null
@@ -1,56 +0,0 @@
-*
-* $Id: hresetg.F,v 1.1.1.1 1996/01/16 17:08:09 mclareni Exp $
-*
-* $Log: hresetg.F,v $
-* Revision 1.1.1.1 1996/01/16 17:08:09 mclareni
-* First import
-*
-*
-#if defined(CERNLIB_VAX)
-#include "hbook/pilot.h"
-*CMZ : 4.10/05 21/02/89 16.14.55 by Rene Brun
-*-- Author :
- SUBROUTINE HRESETG(ID,IPAWD)
-*.==========>
-*. To reset histogram ID in global section IPAWD
-*. If ID=0 reset all histograms
-*..=========> ( R.Brun)
-#include "hbook/hcdire.inc"
- DIMENSION IHDIR(4)
- DIMENSION IPAWD(100)
-*.___________________________________________
- JR1=IPAWD(11)
-*
-* Search levels down
-*
- IF(NLPAT.GT.1)THEN
- DO 50 IL=2,NLPAT
- CALL UCTOH(CHPAT(IL),IHDIR,4,16)
- JR1=IPAWD(JR1+9)
- 30 IF(JR1.EQ.0)GO TO 99
- DO 40 I=1,4
- IF(IHDIR(I).NE.IPAWD(JR1+I+18))THEN
- JR1=IPAWD(JR1+10)
- GO TO 30
- ENDIF
- 40 CONTINUE
- 50 CONTINUE
- ENDIF
-*
- JCDIR = JR1
- JTAB = IPAWD(JCDIR+7)
-*
- IF(ID.NE.0)THEN
- CALL HRESETG1(IPAWD(19),IPAWD(11),ID,JTAB)
- ELSE
- NTOT =IPAWD(JTAB+17)
- DO 60 I=1,NTOT
- IF(IPAWD(JTAB-I+10).EQ.0)GO TO 60
- ID1=IPAWD(JTAB+I+18)
- CALL HRESETG1(IPAWD(19),IPAWD(11),ID1,JTAB)
- 60 CONTINUE
- ENDIF
-*
- 99 RETURN
- END
-#endif
diff --git a/src/packlib/hbook/hglobal/hresetg1.F b/src/packlib/hbook/hglobal/hresetg1.F
deleted file mode 100644
index 06cbd5f..0000000
--- a/src/packlib/hbook/hglobal/hresetg1.F
+++ /dev/null
@@ -1,112 +0,0 @@
-*
-* $Id: hresetg1.F,v 1.1.1.1 1996/01/16 17:08:09 mclareni Exp $
-*
-* $Log: hresetg1.F,v $
-* Revision 1.1.1.1 1996/01/16 17:08:09 mclareni
-* First import
-*
-*
-#if defined(CERNLIB_VAX)
-#include "hbook/pilot.h"
-*CMZ : 4.19/00 13/04/93 08.48.23 by Rene Brun
-*-- Author :
- SUBROUTINE HRESETG1(IB,LB,ID1,JTAB)
-*.==========>
-*. Auxiliary for HRESETG
-*. Reset histogram ID1 in a global section
-*..=========> ( R.Brun)
-#include "hbook/hcbook.inc"
-#include "hbook/hcflag.inc"
- DIMENSION IB(1),LB(1)
-*.___________________________________________
-#include "hbook/jbyt.inc"
- NH=IB(JTAB-1)
- DO 10 I=1,NH
- IF(IB(JTAB+I).EQ.ID1)GO TO 20
- 10 CONTINUE
- GO TO 99
-*
- 20 CONTINUE
- ID=ID1
- JCID=LB(JTAB-I)
- NTOT=IB(JCID+KNTOT)
- I123=JBYT(IB(JCID+KBITS),1,3)
- I230=JBYT(IB(JCID+KBITS),2,2)
- I1 =JBIT(I123,1)
- IF(I123.EQ.0)THEN
- CALL HBUG('Object is not an histogram','HRESEG',ID1)
- GO TO 99
- ENDIF
-*
-* Reset contents
-*
-*======> Array
-*
- IF(I123.EQ.0)THEN
- CALL VZERO(IB(JCID+1),IB(JCID-1))
- GO TO 90
- ENDIF
-*
-*======> 1-DIM histogram
-*
- IF(I1.NE.0)THEN
- CALL HREZ0G(IB,LB,LB(JCID-1))
- GO TO 90
- ENDIF
-*
-*=====> 2-DIM histogram
-*
- IF(I230.NE.0)THEN
- JSCAT=LB(JCID-1)
- CALL VZERO(IB(JSCAT+KNOENT),IB(JSCAT-1)-1)
-*
-* PROX
-*
- CALL HREZ0G(IB,LB,LB(JCID-2))
-*
-* PROY
-*
- CALL HREZ0G(IB,LB,LB(JCID-3))
-*
-* SLIX
-*
- JSLIX=LB(JCID-4)
- IF(JSLIX.NE.0)THEN
- DO 40 I=1,IB(JSLIX-2)
- CALL HREZ0G(IB,LB,LB(JSLIX-I))
- 40 CONTINUE
- ENDIF
-*
-* SLIY
-*
- JSLIY=LB(JCID-5)
- IF(JSLIY.NE.0)THEN
- DO 50 I=1,IB(JSLIY-2)
- CALL HREZ0G(IB,LB,LB(JSLIY-I))
- 50 CONTINUE
- ENDIF
-*
-* BANX
-*
- JBANX=LB(JCID-6)
- 60 IF(LBANX.NE.0)THEN
- CALL HREZ0G(IB,LB,LB(JBANX-1))
- JBANX=LB(JBANX)
- IF(JBANX.NE.0)GO TO 60
- ENDIF
-*
-* BANY
-*
- JBANY=LB(JCID-7)
- 70 IF(LBANY.NE.0)THEN
- CALL HREZ0G(IB,LB,LB(JBANY-1))
- JBANY=LB(JBANY)
- IF(JBANY.NE.0)GO TO 70
- ENDIF
- ENDIF
-*
- 90 CONTINUE
-*
- 99 RETURN
- END
-#endif
diff --git a/src/packlib/hbook/hglobal/hrez0g.F b/src/packlib/hbook/hglobal/hrez0g.F
deleted file mode 100644
index 0f72f6b..0000000
--- a/src/packlib/hbook/hglobal/hrez0g.F
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: hrez0g.F,v 1.1.1.1 1996/01/16 17:08:09 mclareni Exp $
-*
-* $Log: hrez0g.F,v $
-* Revision 1.1.1.1 1996/01/16 17:08:09 mclareni
-* First import
-*
-*
-#if defined(CERNLIB_VAX)
-#include "hbook/pilot.h"
-*CMZ : 4.10/05 21/02/89 16.14.55 by Rene Brun
-*-- Author :
- SUBROUTINE HREZ0G(IB,LB,JBANK)
-*.==========>
-*. RESETS TO 0. DATA STRUCTURE POINTED BY JBANK
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
- DIMENSION IB(1),LB(1)
-*.___________________________________________
- IF(JBANK.NE.0)THEN
- CALL VZERO(IB(JBANK+KNOENT),IB(JBANK-1)-1)
- LW=LB(JBANK)
- IF(LW.NE.0)THEN
- CALL VZERO(IB(LW+1),IB(LW-1))
- LN=LB(LW)
- IF(LN.NE.0)THEN
- CALL VZERO(IB(LN+1),IB(LN-1))
- ENDIF
- ENDIF
- JFUNC=LB(JBANK-1)
- IF(JFUNC.NE.0)CALL VZERO(IB(JFUNC+3),IB(JFUNC-1)-2)
- ENDIF
- END
-#endif
diff --git a/src/packlib/hbook/hglobal/hrzing.F b/src/packlib/hbook/hglobal/hrzing.F
deleted file mode 100644
index 2985330..0000000
--- a/src/packlib/hbook/hglobal/hrzing.F
+++ /dev/null
@@ -1,55 +0,0 @@
-*
-* $Id: hrzing.F,v 1.1.1.1 1996/01/16 17:08:09 mclareni Exp $
-*
-* $Log: hrzing.F,v $
-* Revision 1.1.1.1 1996/01/16 17:08:09 mclareni
-* First import
-*
-*
-#if defined(CERNLIB_VAX)
-#include "hbook/pilot.h"
-*CMZ : 4.21/06 08/12/93 13.18.03 by Rene Brun
-*-- Author : Rene Brun 06/12/93
- SUBROUTINE HRZING(IPAWD,IDH,JCID)
-*.==========>
-*. To return pointer JCID for IDH in global section IPAWD
-*..=========> ( R.Brun)
-#include "hbook/hcdire.inc"
- DIMENSION IHDIR(4)
- DIMENSION IPAWD(100)
-*.___________________________________________
- JR1=IPAWD(11)
- JCID=0
-*
-* Search levels down
-*
- IF(NLPAT.GT.1)THEN
- DO 50 IL=2,NLPAT
- CALL UCTOH(CHPAT(IL),IHDIR,4,16)
- JR1=IPAWD(JR1+9)
- 30 IF(JR1.EQ.0)GO TO 99
- DO 40 I=1,4
- IF(IHDIR(I).NE.IPAWD(JR1+I+18))THEN
- JR1=IPAWD(JR1+10)
- GO TO 30
- ENDIF
- 40 CONTINUE
- 50 CONTINUE
- ENDIF
-*
- JCDIR = JR1
- JTAB = IPAWD(JCDIR+7)
-*
- NTOT =IPAWD(JTAB+17)
- DO 60 I=1,NTOT
- IF(IPAWD(JTAB-I+10).EQ.0)GO TO 60
- ID1=IPAWD(JTAB+I+18)
- IF(ID1.EQ.IDH)THEN
- JCID=IPAWD(JTAB-I+10)
- GO TO 99
- ENDIF
- 60 CONTINUE
-*
- 99 RETURN
- END
-#endif
diff --git a/src/packlib/hbook/hmcstat/Imakefile b/src/packlib/hbook/hmcstat/Imakefile
deleted file mode 100644
index 67c8f27..0000000
--- a/src/packlib/hbook/hmcstat/Imakefile
+++ /dev/null
@@ -1,3 +0,0 @@
-SRCS_F= hadjust.F hfcnmin.F hmcini.F hmclnl.F hmclno.F hmcmll.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/hbook/hmcstat/hadjust.F b/src/packlib/hbook/hmcstat/hadjust.F
deleted file mode 100644
index 90b63ae..0000000
--- a/src/packlib/hbook/hmcstat/hadjust.F
+++ /dev/null
@@ -1,138 +0,0 @@
-*
-* $Id: hadjust.F,v 1.1.1.1 1996/01/16 17:08:07 mclareni Exp $
-*
-* $Log: hadjust.F,v $
-* Revision 1.1.1.1 1996/01/16 17:08:07 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.20/13 19/10/93 15.35.31 by Roger Barlow, Christine Beeston
-*-- Author : Roger Barlow, Christine Beeston 24/09/93
-
- SUBROUTINE HADJUST(TI,I,P,KZERO,AKI)
-
-C Subroutine which given a set of Pj (answer), solves for the ti
-C (ti = 1 - di/fi, where di is the number of data events in bin i,
-C and fi is the number of mc events predicted in bin i, given the Pj
-C provided. fi = Nd * sum over j of (Pj aji/Nj), where Nd = total data
-C events, Nj is total number of mc events from source j, aji is number
-C of mc events from source j in bin i.
-
-#include "hbook/hcmcpm.inc"
-
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION TI,P(NSRCMX),WPMAX,TMIN,AKI,
- + STEP,FUNC,DERIV,D,DELTA,WJI,WKI
-#endif
-#if !defined(CERNLIB_DOUBLE)
- REAL TI,P(NSRCMX),WPMAX,TMIN,AKI,
- + STEP,FUNC,DERIV,D,DELTA,WJI,WKI
-#endif
-
- INTEGER I,KZERO,IMAX,J,NPMAX,APMAXS
-
-
-C set up largest step value
- STEP=0.2D0
-
-C First case - di=0 -> ti=1
- IF(NINT(HI(IDD,I)).EQ.0)THEN
- TI=1.0D0
- KZERO=0
- RETURN
- ENDIF
-
-C Find the largest pj (for case when one or more of the aji are zero)
- WPMAX=HI(IDW(1),I)*P(1)
- IMAX=1
- DO 10 J=2,NMCSRC
- WJI=HI(IDW(J),I)
- IF(WJI*P(J).GT.WPMAX)THEN
- WPMAX=WJI*P(J)
- IMAX=J
- ENDIF
-10 CONTINUE
-C count the number of sources having p=pmax, and the sum of their aji
- NPMAX=0
- APMAXS=0
- DO 20J=1,NMCSRC
- WJI=HI(IDW(J),I)
- IF(WJI*P(J).EQ.WPMAX)THEN
- NPMAX=NPMAX+1
- APMAXS=APMAXS+HI(IDM(J),I)
- ENDIF
-C check that none of the p(j) are zero as this causes crashes
- IF(WJI*P(J).EQ.0.0D0)THEN
- WRITE(6,*)'ADJUST: P(',J,') =',P(J),' - zero
- + fractions cause crashes'
- WRITE(6,*)'ADJUST: dont set starting values
- + to zero - if you didnt then'
- WRITE(6,*)'ADJUST: try setting limits on the P(J)
- + (0<P(J)<1) before any SCAN or MIGRad calls'
- ENDIF
-20 CONTINUE
-
- TMIN=-1./WPMAX
-
-
- KZERO=IMAX
- IF(APMAXS.EQ.0)THEN
- AKI=HI(IDD,I)/(1+WPMAX)
- WKI=HI(IDW(KZERO),I)
- DO 30 J=1,NMCSRC
- IF(J.NE.KZERO)THEN
- WJI=HI(IDW(J),I)
- IF(WKI*P(KZERO).NE.WJI*P(J))THEN
- AKI=AKI-HI(IDM(J),I)*WJI*P(J)/
- + (WKI*P(KZERO)-WJI*P(J))
- ENDIF
- ENDIF
-30 CONTINUE
- IF(AKI.GT.0)THEN
- AKI=AKI/NPMAX
- TI=TMIN
- RETURN
- ENDIF
- ENDIF
- KZERO=0
-
-C Now zero cases have been sorted out, solve for the ti using
-C Newton's method
- TI=0.
-
-11 CONTINUE
-
-C check starting value for ti is sensible, if not then zero is a good
-C place to start.
- IF(TI.GE.1.0.OR.TI.LE.TMIN)THEN
- STEP=STEP/10.0
- TI=0.
- ENDIF
-C value of function
- FUNC=-HI(IDD,I)/(1.0D0-TI)
- DERIV=FUNC/(1.0D0-TI)
-
- DO 40 J=1,NMCSRC
- WJI=HI(IDW(J),I)
- D=1.0D0/(TI+1.0D0/(WJI*P(J)))
- FUNC=FUNC+HI(IDM(J),I)*D
- DERIV=DERIV-HI(IDM(J),I)*D**2
-40 CONTINUE
-
-C check convergence - require either F small or step small
- IF(ABS(FUNC).GT.1.0D-12)THEN
- DELTA=-FUNC/DERIV
-C limit the step size
- IF(DABS(DELTA).GT.STEP)THEN
- DELTA=DSIGN(STEP,DELTA)
- ENDIF
- TI=TI+DELTA
- IF(DABS(DELTA).GT.1.0D-13)THEN
- GOTO 11
- ENDIF
- ENDIF
-
- RETURN
- END
-
diff --git a/src/packlib/hbook/hmcstat/hfcnmin.F b/src/packlib/hbook/hmcstat/hfcnmin.F
deleted file mode 100644
index f7756eb..0000000
--- a/src/packlib/hbook/hmcstat/hfcnmin.F
+++ /dev/null
@@ -1,42 +0,0 @@
-*
-* $Id: hfcnmin.F,v 1.1.1.1 1996/01/16 17:08:07 mclareni Exp $
-*
-* $Log: hfcnmin.F,v $
-* Revision 1.1.1.1 1996/01/16 17:08:07 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.22/02 26/04/94 22.25.05 by Unknown
-*-- Author : Roger Barlow, Christine Beeston 24/09/93
-
- SUBROUTINE HFCNMIN(NPAR,GRAD,FVAL,XVAL,IFLAG,FUTIL)
-
-#include "hbook/hcmcpm.inc"
-
- INTEGER NPAR,IFLAG
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION GRAD(*),FVAL,XVAL(*),FUTIL
- DOUBLE PRECISION HMCLNL
-#endif
-#if !defined(CERNLIB_DOUBLE)
- REAL GRAD(*),FVAL,XVAL(*),FUTIL
- REAL HMCLNL
-#endif
- EXTERNAL HMCLNL
-
- IF(IFLAG.EQ.1)THEN
- RETURN
- ENDIF
-
- FVAL=-HMCLNL(IDD,IDM,IDW,NMCSRC,XVAL)
-
-C termination code here.
- IF(IFLAG.EQ.3)THEN
- WRITE(6,*)'HFCNMIN: FCN termination for MINUIT'
- WRITE(6,*)'HFCNMIN: END VALUES OF PARAMETERS'
- WRITE(6,*)'HFCNMIN: ',(XVAL(JSRC),JSRC=1,NMCSRC)
- ENDIF
-
- RETURN
- END
diff --git a/src/packlib/hbook/hmcstat/hmcini.F b/src/packlib/hbook/hmcstat/hmcini.F
deleted file mode 100644
index 17b6e85..0000000
--- a/src/packlib/hbook/hmcstat/hmcini.F
+++ /dev/null
@@ -1,268 +0,0 @@
-*
-* $Id: hmcini.F,v 1.1.1.1 1996/01/16 17:08:07 mclareni Exp $
-*
-* $Log: hmcini.F,v $
-* Revision 1.1.1.1 1996/01/16 17:08:07 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.22/11 23/08/94 14.05.57 by Rene Brun
-*-- Author : Roger Barlow, Christine Beeston 24/09/93
-
- SUBROUTINE HMCINI(IDDATA,IDMC,IDWT,NSRC,CHOPT,IERR)
-
-* Initialisation routine for function HMCLNL, needs to be called
-* each time a new set of histograms is introduced (generally once at the
-* beginning of each fit). Performs some error checking and sets up a dummy
-* weight histogram if necessary. Normalises the weight histograms (once
-* only, so the same weight histogram may be used for 2 simultaneous
-* fits and calculates the overall normalisation constants bj - these are
-* stored with the histograms using HNORMA. Ids of the weight histograms
-* are returned in IDWT.
-
-* Input parameters:
-* ----------------
-* IDDATA Data histogram identifier.
-* IDMC Array of dimension NMCSRC containing Monte Carlo histogram
-* identifiers.
-* IDWT Array of dimension NMCSRC containing weight histogram
-* identifiers. ('W' option only).
-* NMCSRC Number of Monte Carlo sources.
-* CHOPT...
-* 'W' Use the weight histograms provided. For non existent weight
-* histograms, and if the W option is not requested, a dummy weight histogram
-* in which all entries are 1 is booked.
-* IERR - 0 if initialisation fine, 1 if parameters sent to HMCINI were
-* not useable (e.g. number of sources 0 or 1)
-
-#include "hbook/hcbook.inc"
-#include "hbook/hcmcpm.inc"
-
-C Passed to the routine..
- INTEGER IDDATA,IDMC(*),IDWT(*),NSRC,IERR,IBIN
- CHARACTER*(*) CHOPT
-
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION WJI,AJI,WASUM
-#endif
-#if !defined(CERNLIB_DOUBLE)
- REAL WJI,AJI,WASUM
-#endif
-
-C Some variables for use with HGIVE
- CHARACTER*80 CHTITL
- INTEGER NY,NWT,LOC
- REAL XMI,XMA,YMI,YMA
-
- LOGICAL LWTHIS
- INTEGER IDWTH,NWTHIS,NCXD,NCXM,JSRC,JWT
- PARAMETER(IDWTH=12345)
- REAL DUMWT,CNORM,FACT
- PARAMETER(DUMWT=1.0)
-
- INTEGER IRET,INORM,IFIRST
-
- LOGICAL HEXIST
- EXTERNAL HEXIST
- DATA IFIRST/0/
-
- IF(IFIRST.EQ.0)THEN
- WRITE(6,*)' *********************************************'
- WRITE(6,*)' *** THERE IS A NEW VERSION OF HMCLNL ***'
- WRITE(6,*)' *** YOU MUST NOW PASS THE HISTOGRAM IDS ***'
- WRITE(6,*)' *** TO ALLOW FOR MULTIPLE SIMULTANEOUS ***'
- WRITE(6,*)' *** FITS - HMCINI MUST ALSO BE CALLED ***'
- WRITE(6,*)' *** FOR EACH SET OF HISTOGRAMS IF A ***'
- WRITE(6,*)' *** SIMULTANEOUS FIT IS BEING PERFORMED ***'
- WRITE(6,*)' *** THE NEW HMCLNL IS USED LIKE THIS: ***'
- WRITE(6,*)' *** ***'
- WRITE(6,*)' *** RLNL=HMCLNL(IDDATA,IDMC,IDWT,NSRC,PJ) ***'
- WRITE(6,*)' *** ***'
- WRITE(6,*)' *** THE OLD VERSION WILL CONTINUE TO BE ***'
- WRITE(6,*)' *** AVAILABLE AS HMCLNO(PJ) FOR A COUPLE ***'
- WRITE(6,*)' *** OF MONTHS. ***'
- WRITE(6,*)' *** ***'
- WRITE(6,*)' *** REPORT PROBLEMS TO BEESTON at CERNVM ***'
- WRITE(6,*)' *********************************************'
- IFIRST=0
- ENDIF
-C Initialise error flag
- IERR=0
-C put number of sources in common
- NMCSRC=NSRC
-
- LWTHIS=.FALSE.
-
-C Decode options
- CALL HUOPTC(CHOPT,'FLWSNPE',IOPT)
-
-
-C Initial checks - first check number of MC histos doesnt exceed NSRCMX
- IF(NMCSRC.GT.NSRCMX)THEN
- CALL HBUG('Number of MC histograms exceeds maximum of 20',
- +'HMCINI',0)
- IERR=1
- GOTO 99
- ENDIF
- IF(NMCSRC.LT.NSRCMN)THEN
- CALL HBUG('Number of MC histograms less than minimum of 2',
- +'HMCINI',0)
- IERR=1
- GOTO 99
- ENDIF
-
-C Next get links to histos, stop if any histo cant be found
- IF(HEXIST(IDDATA))THEN
- IDD=IDDATA
- ELSE
- CALL HBUG('Data histogram missing','HMCINI',IDDATA)
- IERR=1
- GOTO 99
- ENDIF
- DO 140 JSRC=1,NMCSRC
- IF(HEXIST(IDMC(JSRC)))THEN
- IDM(JSRC)=IDMC(JSRC)
- ELSE
- CALL HBUG('MC histogram missing','HMCINI',IDMC(JSRC))
- IERR=1
- GOTO 99
- ENDIF
-140 CONTINUE
-C check all histos have entries
- NDATEV=NINT(HSUM(IDD))
- IF(NDATEV.LE.0)THEN
- CALL HBUG('Data histogram has no entries - cant fit',
- +'HMCINI',IDD)
- IERR=1
- GOTO 99
- ENDIF
- DO 150 JSRC=1,NMCSRC
- NMCEV(JSRC)=NINT(HSUM(IDM(JSRC)))
- IF(NMCEV(JSRC).LE.0)THEN
- CALL HBUG('MC histogram has no entries - cant fit',
- +'HMCINI',IDM(JSRC))
- IERR=1
- GOTO 99
- ENDIF
-150 CONTINUE
-
-
-C check all histos have the same number of bins
-
- CALL HGIVE(IDD,CHTITL,NCXD,XMI,XMA,NY,YMI,YMA,NWT,LOC)
- DO 160 JSRC=1,NMCSRC
- CALL HGIVE(IDM(JSRC),CHTITL,NCXM,XMI,XMA,NY,YMI,YMA,NWT,LOC)
- IF(NCXM.NE.NCXD)THEN
- CALL HBUG(
- +'MC histo has different number of bins to data histo',
- +'HMCINI',IDM(JSRC))
- IERR=1
- GOTO 99
- ENDIF
-160 CONTINUE
- NTOT=NCXD
-
-C Weight histograms - check existence, if histograms not provided then
-C use 12345+jwt (filled with 1). If 'W' option but no histos provided, use
-C 12345 for all but issue warning message
-C ..first find an unused id for the dummy weight histogram
- JWT=0
-165 IF(HEXIST(IDWTH+JWT))THEN
- JWT=JWT+1
- GOTO 165
- ENDIF
-
-C now check existence of histograms if weight option chosen
- IF(IOPT(3).EQ.1)THEN
- NWTHIS=0
- DO 170 JSRC=1,NMCSRC
- IF(.NOT.HEXIST(IDWT(JSRC)))THEN
- CALL HBUG(
- +'Weight histo does not exist - using default',
- +'HMCINI',IDW(JSRC))
- IDW(JSRC)=IDWTH+JWT
- LWTHIS=.TRUE.
- ELSE
- IDW(JSRC)=IDWT(JSRC)
- NWTHIS=NWTHIS+1
- ENDIF
-170 CONTINUE
- ELSE
- DO 180 JSRC=1,NMCSRC
- IDW(JSRC)=IDWTH+JWT
- LWTHIS=.TRUE.
-180 CONTINUE
- ENDIF
-C Put new wt histo ids in idwt to pass back to user
- DO 185 JSRC=1,NMCSRC
- IDWT(JSRC)=IDW(JSRC)
-185 CONTINUE
-
-C book + fill the default weights histogram.
- IF(LWTHIS)THEN
- CALL HBOOK1(IDWTH+JWT,'Dummy weight histo',NTOT,0.5,
- + FLOAT(NTOT)+0.5,0.)
- DO 190 JBIN=1,NTOT
- CALL HFILL(IDWTH+JWT,FLOAT(JBIN),0.,DUMWT)
-190 CONTINUE
- ENDIF
-
-C Check all weights histos have right number of bins
- DO 200 JSRC=1,NMCSRC
- CALL HGIVE(IDW(JSRC),CHTITL,NCXM,XMI,XMA,NY,YMI,YMZ,NWT,LOC)
- IF(NCXM.NE.NTOT)THEN
- CALL HBUG(
- +'Weight histo has different number of bins to data histo',
- +'HMCINI',IDM(JSRC))
- IERR=1
- GOTO 99
- ENDIF
-200 CONTINUE
-
-C Now normalise weight histograms - first calculate overall normalisation
-C factors
- DO 210 JSRC=1,NMCSRC
- IRET=3
- CALL HLOOP(IDW(JSRC),'HMCINI',IRET)
- IF(IRET.EQ.0)THEN
- CALL HBUG(
- +'Weight histogram does not exist ','HMCINI',IDW(JSRC))
- STOP
- ELSE
- INORM=JBIT(IQ(LCID+KBITS),18)
- ENDIF
-
-* only normalise histograms once!
- IF(INORM.EQ.0)THEN
- WASUM=0.0D0
- DO 220 IBIN=1,NTOT
- WJI=HI(IDW(JSRC),IBIN)
- AJI=HI(IDM(JSRC),IBIN)
- WASUM=WASUM+WJI*AJI
-220 CONTINUE
- BJ(JSRC)=WASUM/FLOAT(NMCEV(JSRC))
- IF(BJ(JSRC).LE.0.0)THEN
- IERR=1
- CALL HBUG(
- +'Normalisation constant for weight histo negative or zero',
- +'HMCINI',IDW(JSRC))
- GOTO 99
- ENDIF
- CNORM=1.0/(BJ(JSRC))
- CALL HOPERA(IDW(JSRC),'+',IDW(JSRC),IDW(JSRC),CNORM,0.0)
-* musnt pass double precision to hnorma
- FACT=BJ(JSRC)
-C Pack normalisation constant bj in histogram using HNORMA
- CALL HNORMA(IDW(JSRC),FACT)
-
- ENDIF
-210 CONTINUE
-
-99 CONTINUE
-
-
-
- RETURN
- END
-
diff --git a/src/packlib/hbook/hmcstat/hmclnl.F b/src/packlib/hbook/hmcstat/hmclnl.F
deleted file mode 100644
index d694431..0000000
--- a/src/packlib/hbook/hmcstat/hmclnl.F
+++ /dev/null
@@ -1,151 +0,0 @@
-*
-* $Id: hmclnl.F,v 1.1.1.1 1996/01/16 17:08:07 mclareni Exp $
-*
-* $Log: hmclnl.F,v $
-* Revision 1.1.1.1 1996/01/16 17:08:07 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.22/02 11/05/94 11.29.07 by Unknown
-*-- Author : Roger Barlow, Christine Beeston 24/09/93
-
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION FUNCTION HMCLNL(IDDATA,IDMC,IDWT,NSRC,PJ)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- REAL FUNCTION HMCLNL(IDDATA,IDMC,IDWT,NSRC,PJ)
-#endif
-
-* HMCLNL returns the log likelihood (including effect of both data
-* and Monte Carlo statistics) that the data distribution arose from a
-* distribution given by combining the Monte Carlo distributions, weighted
-* by the weights provided, using the fractions given in FRAC.
-* HMCINI must be called before this function may be used.
-*
-* Input parameters:
-* ----------------
-* FRAC: Double precision array of dimension NMCSRC containing the
-* fraction of each Monte Carlo distribution you wish to assume is in the data
-* distribution, in order to calculate the log likelihood.
-
-#include "hbook/hcbook.inc"
-#include "hbook/hcbits.inc"
-#include "hbook/hcmcpm.inc"
-
- INTEGER IDDATA,IDMC(NSRCMX),IDWT(NSRCMX),NSRC
-
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION ANSWER(NSRCMX), X(NSRCMX), AKI, TI,
- + F,AJI,WJI,PJ(NSRCMX),PJSUM,BPJSUM
-#endif
-#if !defined(CERNLIB_DOUBLE)
- REAL ANSWER(NSRCMX), X(NSRCMX), AKI, TI,
- + F,AJI,WJI,PJ(NSRCMX),PJSUM,BPJSUM
-#endif
-
- INTEGER KZERO,I,J,IRET,IFIRST
- DATA IFIRST/0/
-
-C Warning that this is new version!!
- IF(IFIRST.EQ.0)THEN
- WRITE(6,*)' ************************************************'
- WRITE(6,*)' *** YOU ARE USING THE NEW VERSION ***'
- WRITE(6,*)' *** OF HMCLNL - HISTO IDS MUST BE PASSED ***'
- WRITE(6,*)' *** TO ALLOW FOR >1 INDEPENDENT FIT ***'
- WRITE(6,*)' *** HMCINI MUST BE CALLED ONCE FOR EACH SET ***'
- WRITE(6,*)' *** OF HISTOGRAMS. THEN LOG L IS GIVEN BY ***'
- WRITE(6,*)' *** ***'
- WRITE(6,*)' *** RLNL = HMCLNL(IDDATA,IDMC,IDWT,NSRC,PJ) ***'
- WRITE(6,*)' *** ***'
- WRITE(6,*)' *** THE OLD VERSION OF HMCLNL IS STILL ***'
- WRITE(6,*)' *** AVAILABLE - HMCLNO(PJ). THIS WILL ***'
- WRITE(6,*)' *** BE REMOVED IN A COUPLE OF MONTHS ***'
- WRITE(6,*)' *** PLEASE REPORT PROBLEMS TO BEESTON at CERNVM ***'
- WRITE(6,*)' ************************************************'
- IFIRST=1
- ENDIF
-
-C put ids in common
- IDD=IDDATA
- NMCSRC=NSRC
- DO 10 J=1,NMCSRC
- IDM(J)=IDMC(J)
- IDW(J)=IDWT(J)
-10 CONTINUE
-
-C retrieve histogram normalisation factors(bj) from weight histograms
- DO 20 J=1,NMCSRC
- BJ(J)=1.
- IRET=3
- CALL HLOOP(IDW(J),'HMCLNL',IRET)
- IF(IRET.EQ.0)THEN
- STOP
- ENDIF
- IF(I18.NE.0)THEN
- BJ(J)=Q(LCID+KNORM)
- ENDIF
-20 CONTINUE
-C get total numbers of events in histograms - ignoring under + overflows
- NDATEV=NINT(HSUM(IDD))
- DO 25 J=1,NMCSRC
- NMCEV(J)=NINT(HSUM(IDM(J)))
-25 CONTINUE
-
-C first convert Pj to Pj'
- PJSUM=0.0D0
- BPJSUM=0.0D0
- DO 30 J=1,NMCSRC
- PJSUM=PJSUM+PJ(J)
- BPJSUM=BPJSUM+BJ(J)*PJ(J)
-30 CONTINUE
- DO 40 J=1,NMCSRC
- ANSWER(J)=BJ(J)*PJ(J)*PJSUM/BPJSUM
-40 CONTINUE
-
-C convert ANSWER to normalised fractions in X
- DO 50 J=1,NMCSRC
- X(J)=ANSWER(J)*NDATEV/NMCEV(J)
-50 CONTINUE
-
- HMCLNL=0.0D0
-
- DO 80 I=1,NTOT
-
- CALL HADJUST(TI,I,X,KZERO,AKI)
- F=0.0
- DO 70 J=1,NMCSRC
- WJI=HI(IDW(J),I)
-C now get AJI from the aji and the Ti
- IF(KZERO.NE.0.AND.X(J).EQ.X(KZERO))THEN
- AJI=AKI
- ELSE
- AJI=0
- IF(NINT(HI(IDM(J),I)).NE.0)THEN
- AJI=HI(IDM(J),I)/(1.0D0+X(J)*WJI*TI)
- ENDIF
- ENDIF
-
- F=F+X(J)*WJI*AJI
-
- IF(NINT(HI(IDM(J),I)).NE.0)THEN
- IF(AJI.LE.0.0)THEN
- CONTINUE
- ELSE
- HMCLNL=HMCLNL+HI(IDM(J),I)*DLOG(AJI)
- ENDIF
- ENDIF
-
- HMCLNL=HMCLNL-AJI
-70 CONTINUE
-
- IF(NINT(HI(IDD,I)).NE.0)THEN
- HMCLNL=HMCLNL+HI(IDD,I)*DLOG(F)
- ENDIF
-
- HMCLNL=HMCLNL-F
-
-80 CONTINUE
-
- RETURN
- END
diff --git a/src/packlib/hbook/hmcstat/hmclno.F b/src/packlib/hbook/hmcstat/hmclno.F
deleted file mode 100644
index 566f76d..0000000
--- a/src/packlib/hbook/hmcstat/hmclno.F
+++ /dev/null
@@ -1,141 +0,0 @@
-*
-* $Id: hmclno.F,v 1.1.1.1 1996/01/16 17:08:07 mclareni Exp $
-*
-* $Log: hmclno.F,v $
-* Revision 1.1.1.1 1996/01/16 17:08:07 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.22/02 26/04/94 21.56.24 by Unknown
-*-- Author : Roger Barlow, Christine Beeston 24/09/93
-
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION FUNCTION HMCLNO(PJ)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- REAL FUNCTION HMCLNO(PJ)
-#endif
-
-* HMCLNO returns the log likelihood (including effect of both data
-* and Monte Carlo statistics) that the data distribution arose from a
-* distribution given by combining the Monte Carlo distributions, weighted
-* by the weights provided, using the fractions given in FRAC.
-* HMCINI must be called before this function may be used.
-*
-* Input parameters:
-* ----------------
-* FRAC: Double precision array of dimension NMCSRC containing the
-* fraction of each Monte Carlo distribution you wish to assume is in the data
-* distribution, in order to calculate the log likelihood.
-
-#include "hbook/hcbook.inc"
-#include "hbook/hcbits.inc"
-#include "hbook/hcmcpm.inc"
-
-
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION ANSWER(NSRCMX), X(NSRCMX), AKI, TI,
- + F,AJI,WJI,PJ(NSRCMX),PJSUM,BPJSUM
-#endif
-#if !defined(CERNLIB_DOUBLE)
- REAL ANSWER(NSRCMX), X(NSRCMX), AKI, TI,
- + F,AJI,WJI,PJ(NSRCMX),PJSUM,BPJSUM
-#endif
-
- INTEGER KZERO,I,J,IRET,IFIRST
- DATA IFIRST/0/
-
- IF(IFIRST.EQ.0)THEN
- WRITE(6,*)' ************************************************'
- WRITE(6,*)' *** THIS IS THE OLD VERSION OF ***'
- WRITE(6,*)' *** HMCLNL: IT WILL BE DELETED IN ***'
- WRITE(6,*)' *** A COUPLE OF MONTHS. THE NEW ***'
- WRITE(6,*)' *** VERSION IS NO SLOWER AND ***'
- WRITE(6,*)' *** ALLOWS FOR MULTIPLE SIMULTANEOUS ***'
- WRITE(6,*)' *** FITS. THE HISTOGRAM IDS MUST BE ***'
- WRITE(6,*)' *** PASSED AS FOLLOWS: ***'
- WRITE(6,*)' *** ***'
- WRITE(6,*)' *** RLNL=HMCLNL(IDDATA,IDMC,IDWT,NSRC,PJ) ***'
- WRITE(6,*)' *** ***'
- WRITE(6,*)' *** PLEASE REPORT PROBLEMS TO BEESTON at CERNVM ***'
- WRITE(6,*)' ************************************************'
- IFIRST=1
- ENDIF
-
-C retrieve histogram normalisation factors(bj) from weight histograms
- DO 20 J=1,NMCSRC
- BJ(J)=1.
- IRET=3
- CALL HLOOP(IDW(J),'HMCLNO',IRET)
- IF(IRET.EQ.0)THEN
- STOP
- ENDIF
- IF(I18.NE.0)THEN
- BJ(J)=Q(LCID+KNORM)
- ENDIF
-20 CONTINUE
-C get total numbers of events in histograms - ignoring under + overflows
- NDATEV=NINT(HSUM(IDD))
- DO 25 J=1,NMCSRC
- NMCEV(J)=NINT(HSUM(IDM(J)))
-25 CONTINUE
-
-C first convert Pj to Pj'
- PJSUM=0.0D0
- BPJSUM=0.0D0
- DO 30 J=1,NMCSRC
- PJSUM=PJSUM+PJ(J)
- BPJSUM=BPJSUM+BJ(J)*PJ(J)
-30 CONTINUE
-
- DO 40 J=1,NMCSRC
- ANSWER(J)=BJ(J)*PJ(J)*PJSUM/BPJSUM
-40 CONTINUE
-
-C convert ANSWER to normalised fractions in X
- DO 50 J=1,NMCSRC
- X(J)=ANSWER(J)*NDATEV/NMCEV(J)
-50 CONTINUE
-
- HMCLNO=0.0D0
-
- DO 80 I=1,NTOT
-
- CALL HADJUST(TI,I,X,KZERO,AKI)
- F=0.0
- DO 70 J=1,NMCSRC
- WJI=HI(IDW(J),I)
-C now get AJI from the aji and the Ti
- IF(KZERO.NE.0.AND.X(J).EQ.X(KZERO))THEN
- AJI=AKI
- ELSE
- AJI=0
- IF(NINT(HI(IDM(J),I)).NE.0)THEN
- AJI=HI(IDM(J),I)/(1.0D0+X(J)*WJI*TI)
- ENDIF
- ENDIF
-
- F=F+X(J)*WJI*AJI
-
- IF(NINT(HI(IDM(J),I)).NE.0)THEN
- IF(AJI.LE.0.0)THEN
- CONTINUE
- ELSE
- HMCLNO=HMCLNO+HI(IDM(J),I)*DLOG(AJI)
- ENDIF
- ENDIF
-
- HMCLNO=HMCLNO-AJI
-70 CONTINUE
-
- IF(NINT(HI(IDD,I)).NE.0)THEN
- HMCLNO=HMCLNO+HI(IDD,I)*DLOG(F)
- ENDIF
-
- HMCLNO=HMCLNO-F
-
-80 CONTINUE
-
- RETURN
- END
diff --git a/src/packlib/hbook/hmcstat/hmcmll.F b/src/packlib/hbook/hmcstat/hmcmll.F
deleted file mode 100644
index 0feb32d..0000000
--- a/src/packlib/hbook/hmcstat/hmcmll.F
+++ /dev/null
@@ -1,271 +0,0 @@
-*
-* $Id: hmcmll.F,v 1.1.1.1 1996/01/16 17:08:07 mclareni Exp $
-*
-* $Log: hmcmll.F,v $
-* Revision 1.1.1.1 1996/01/16 17:08:07 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 18/07/95 11.45.16 by Julian Bunn
-*-- Author : Roger Barlow, Christine Beeston 24/09/93
-
- SUBROUTINE HMCMLL(IDDATA,IDMC,IDWT,NSRC,CHOPT,
- + IFIXMC,FIXFRA,FLIM,START,STEP,UP,
- + ANSMIG,DANSMIG)
-
-* Fits the given Monte Carlo distributions to the data distribution, using
-* a binned maximum likelihood fit which includes the effect of both data and
-* Monte Carlo statistics, and allows weights to be
-* provided for each Monte Carlo distribution. The data and Monte Carlo
-* distributions must be presented in 1 dimensional histograms.
-* The best estimate of the fraction of each Monte
-* Carlo distribution present in the data distribution is returned, with an
-* error estimate where required.
-
-* Input parameters:
-* -----------------
-* IDDATA Data histogram identifier.
-* IDMC Array of dimension NMCSRC containing Monte Carlo histogram
-* identifiers.
-* IDWT Array of dimension NMCSRC containing weight histogram
-* identifiers. ('W' option only).
-* NMCSRC Number of Monte Carlo sources.
-* CHOPT - character options as follows 1 2 3 4 5 6 7
-* F L W S N P E
-* 'F' Fix one or more of the fractions.
-* 'L' Set limits on the fractions as given in FLIM.
-* 'W' Use the weight histograms provided. For non existent weight
-* histograms, and if the W option is not requested, a dummy weight histogram
-* in which all entries are 1 is booked.
-* 'S' Scan the likelihood function with respect to each fit parameter,
-* before and after the fit. If the 'N' option is specified, the function
-* will only be scanned once for each parameter.
-* 'N' Do not perform the fit.
-* 'P' Use the parameter start points and initial step sizes
-* provided in START and STEP. If negative values are provided the
-* defaults are used.
-* If the P option is
-* not specified then the start point for each free parameter is
-* 1.-sum of fixed fractions/nsrc-number of fixed fractions and the initial
-* step size is 0.01.
-* 'E' Perform a detailed error analysis using the MINUIT routines
-* HESSE and MINOS.
-
-* IFIXMC Array of dimension NMCSRC containing '1' if a
-* parameter is to be fixed in the fit, '0' otherwise. ('F' option
-* only).
-* FRAC Array of dimension NMCSRC with the values at which
-* parameters are to be fixed. ('F' option only).
-* FLIM Array of dimension (NMCSRC,2) with the lower, then
-* upper limits on the parameters. ('L' option only).
-* START Array of dimension NMCSRC with the start values for
-* each parameter. ('P' option only).
-* STEP Array of dimension NMCSRC with initial step sizes for the
-* parameters ('P' option only).
-* UP 'UP' value for the error estimate ('E' option only). See the Minuit
-* manual for definition of UP.
-
-* Output parameters:
-* -----------------
-* PAR Array of dimension NMCSRC with the final fitted values
-* of the parameters.
-* DPAR Array of dimension NMCSRC with the errors
-* on the final fitted values of the parameters.
-
-#include "hbook/hcmcpm.inc"
-
-C Passed to the routine..
- INTEGER IDDATA,IDMC(*),IDWT(*),NSRC,IFIXMC(*)
- CHARACTER*(*) CHOPT
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION FLIM(2,*),START(*),STEP(*),UP,FIXFRA(*)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- REAL FLIM(2,*),START(*),STEP(*),UP,FIXFRA(*)
-#endif
-
-C Number of free MC sourceS, Sum of fixed MC fractions
- INTEGER MCFREE
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION FRACSM
-#endif
-#if !defined(CERNLIB_DOUBLE)
- REAL FRACSM
-#endif
- COMMON/HMCFIX/FRACSM,MCFREE
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION ANSMIG(NSRCMX),DANSMIG(NSRCMX)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- REAL ANSMIG(NSRCMX),DANSMIG(NSRCMX)
-#endif
-
- CHARACTER*10 PNAME(NSRCMX)
-
-C Stuff for Minuit
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION PSTART(NSRCMX),PSTEP(NSRCMX)
- DOUBLE PRECISION ARGLIS(10),BLO,BHI,BND1,BND2,VAL,ERROR
-#endif
-#if !defined(CERNLIB_DOUBLE)
- REAL PSTART(NSRCMX),PSTEP(NSRCMX)
- REAL ARGLIS(10),BLO,BHI,BND1,BND2,VAL,ERROR
-#endif
-
- LOGICAL HEXIST
-
- INTEGER JSRC,IFAIL,IVARBL,IERR
-
- EXTERNAL HFCNMIN,HEXIST
-
- DATA PNAME/'P1','P2','P3','P4','P5','P6','P7','P8','P9','P10',
- + 'P11','P12','P13','P14','P15','P16','P17','P18','P19','P20'/
- DATA DEFSTP/0.01D0/
-
-C Initialisation - HMCINI checks existence and compatibility of
-C Data, MC and Weight histograms.
- CALL HMCINI(IDDATA,IDMC,IDWT,NSRC,CHOPT,IERR)
- IF(IERR.EQ.1)THEN
- CALL HBUG('Returning from HMCMLL - HMCINI error',
- + 'HMCMLL',0)
- RETURN
- ENDIF
-
- CALL MNINIT(5,6,7)
-
-C number of free mc sources
- MCFREE=0
- FRACSM=0.0D0
- DO 90 JSRC=1,NMCSRC
- IF(IOPT(1).EQ.0.OR.IFIXMC(JSRC).EQ.0)THEN
- MCFREE=MCFREE+1
- ELSE
- FRACSM=FRACSM+FIXFRA(JSRC)
- ENDIF
-90 CONTINUE
- WRITE(6,1000)MCFREE,NMCSRC-MCFREE
-1000 FORMAT(' HMCMLL: You have ',I2,' free fractions and ',
- + I2,' fixed')
-
-C set up start values for parameter start points, limits, step sizes
- DO 100 JSRC =1,NMCSRC
- IF(IOPT(2).EQ.1)THEN
- BLO=FLIM(1,JSRC)
- BHI=FLIM(2,JSRC)
- ELSE
- BLO=0.0D0
- BHI=0.0D0
- ENDIF
-
- IF(IOPT(6).EQ.1)THEN
- IF(START(JSRC).LT.0.0)THEN
- WRITE(6,*)
- +' HMCMLL: Using default for start value source ',JSRC
- PSTART(JSRC)=(1.-FRACSM)/FLOAT(MCFREE)
- ELSE
- PSTART(JSRC)=START(JSRC)
- ENDIF
- IF(STEP(JSRC).LT.0.0)THEN
- WRITE(6,*)
- +' HMCMLL: Using default for step value source',JSRC
- PSTEP(JSRC)=DEFSTP
- ELSE
- PSTEP(JSRC)=STEP(JSRC)
- ENDIF
- ELSE
- PSTART(JSRC)=(1.-FRACSM)/FLOAT(MCFREE)
- PSTEP(JSRC)=DEFSTP
- ENDIF
- IF(IOPT(1).EQ.1.AND.IFIXMC(JSRC).EQ.1)THEN
- PSTART(JSRC)=FIXFRA(JSRC)
- ENDIF
-
-C Initialise Minuit parameters
- CALL MNPARM(JSRC,PNAME(JSRC),PSTART(JSRC),PSTEP(JSRC),
- + BLO,BHI,IFAIL)
- IF(IFAIL.NE.0)THEN
- CALL HBUG(
- +'Unable to define a parameter in MNPARM call','HMCMLL',0)
- STOP
- ENDIF
-100 CONTINUE
-
-C set title
- CALL MNSETI('*** HBOOK New ll maximisation')
-
-C initialisation call to FCN
- ARGLIS(1)=1.
- CALL MNEXCM(HFCNMIN,'CALL FCN',ARGLIS,1,IFAIL,0)
-
-C fix chosen fractions
- DO 110 JSRC=1,NMCSRC
- IF(IOPT(1).EQ.1.AND.IFIXMC(JSRC).EQ.1)THEN
- ARGLIS(1)=FLOAT(JSRC)
- CALL MNEXCM(HFCNMIN,'FIX',ARGLIS,1,IFAIL,0)
- WRITE(6,3000)JSRC,FIXFRA(JSRC)
- ENDIF
-110 CONTINUE
-3000 FORMAT(' HMCMLL: Fixed parameter number ',I2,' at ',F8.5)
-
-C Set initial UP value to 0.5
- ARGLIS(1)=0.5
- CALL MNEXCM(HFCNMIN,'SET ERR',ARGLIS,1,IFAIL,0)
-
-C scan log likelihood around start
- IF(IOPT(4).EQ.1)THEN
- CALL MNEXCM(HFCNMIN,'SCAN',ARGLIS,0,IFAIL,0)
- ENDIF
-
-C maximise log - likelihood
- IF(IOPT(5).NE.1)THEN
- IFAIL=0
- CALL MNEXCM(HFCNMIN,'MIGRAD',ARGLIS,0,IFAIL,0)
- IF(IFAIL.NE.0)THEN
- WRITE(6,3500)IFAIL
- ENDIF
-3500 FORMAT(' HMCMLL: MIGRAD ERROR FLAG ',I2)
-
-C scan log likelihood around end point
- IF(IOPT(4).EQ.1)THEN
- CALL MNEXCM(HFCNMIN,'SCAN',ARGLIS,0,IFAIL,0)
- ENDIF
- ENDIF
-
-C calculate minos errors
-C First set UP value as appropriate for parameters
- IF(IOPT(7).EQ.1)THEN
- IFAIL=0
- IF(UP.LE.0)THEN
- CALL HBUG(
- +'+Negative or zero UP value given - using 0.5',
- + 'HMCMLL',0)
- ARGLIS(1)=0.5
- ELSE
- ARGLIS(1)=UP
- ENDIF
- CALL MNEXCM(HFCNMIN,'SET ERR',ARGLIS,1,IFAIL,0)
- IF(IFAIL.EQ.0)THEN
- WRITE(6,4000)ARGLIS(1),MCFREE
- ENDIF
-4000 FORMAT(' HMCMLL: SET UP VALUE TO ',F5.2,/,
- + ' HMCMLL: FOR ',I2,' FREE PARAMETERS')
-
- IFAIL=0
- CALL MNEXCM(HFCNMIN,'MINOS',ARGLIS,0,IFAIL,0)
- IF(IFAIL.NE.0)THEN
- WRITE(6,5000)IFAIL
- ENDIF
-5000 FORMAT(' HMCMLL: MINOS ERROR FLAG ',I2)
- ENDIF
-
-C termination
- DO 130 JSRC=1,NMCSRC
- CALL MNPOUT(JSRC,PNAME(JSRC),VAL,ERROR,BND1,BND2,IVARBL)
- ANSMIG(JSRC)=VAL
- DANSMIG(JSRC)=ERROR
-130 CONTINUE
-
- RETURN
- END
-
diff --git a/src/packlib/hbook/hmerge/Imakefile b/src/packlib/hbook/hmerge/Imakefile
deleted file mode 100644
index 03caf42..0000000
--- a/src/packlib/hbook/hmerge/Imakefile
+++ /dev/null
@@ -1,3 +0,0 @@
-SRCS_F= hmerge.F hmerge1.F hmerge2.F hmerge3.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/hbook/hmerge/hmerg.F b/src/packlib/hbook/hmerge/hmerg.F
deleted file mode 100644
index c70bc2d..0000000
--- a/src/packlib/hbook/hmerge/hmerg.F
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: hmerg.F,v 1.1.1.1 1996/01/16 17:08:10 mclareni Exp $
-*
-* $Log: hmerg.F,v $
-* Revision 1.1.1.1 1996/01/16 17:08:10 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-#if defined(CERNLIB_MAIN)
-*CMZ : 4.22/07 28/06/94 16.52.36 by Rene Brun
-*-- Author : Rene Brun, J.C. Marin and Fons Rademakers 26/05/94
- PROGRAM HMERG
-*.==========>
-*.
-*. This program can be used to merge HBOOK files with identical objects
-*. and directories.
-*.
-*..=========> (Rene Brun, J.C. Marin, A.A.Rademakers )
-*
- INTEGER MXBOOK
- PARAMETER (MXBOOK=1000000)
- REAL PAW
- COMMON/PAWC/ PAW(MXBOOK)
-*
- CALL HLIMIT(MXBOOK)
-*
- CALL HMERGIN
-*
- END
-#endif
diff --git a/src/packlib/hbook/hmerge/hmerge.F b/src/packlib/hbook/hmerge/hmerge.F
deleted file mode 100644
index 6afbe90..0000000
--- a/src/packlib/hbook/hmerge/hmerge.F
+++ /dev/null
@@ -1,102 +0,0 @@
-*
-* $Id: hmerge.F,v 1.1.1.1 1996/01/16 17:08:10 mclareni Exp $
-*
-* $Log: hmerge.F,v $
-* Revision 1.1.1.1 1996/01/16 17:08:10 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.22/07 28/06/94 16.53.03 by Rene Brun
-*-- Author : Rene Brun, J.C. Marin and Fons Rademakers 26/05/94
- SUBROUTINE HMERGE(NFILES,FILES,FILOUT)
-*.==========>
-*.
-*. Subroutine to merge the NFILES HBOOK files with identical objects
-*. and directories into FILOUT.
-*.
-*..=========> (Rene Brun, J.C. Marin, A.A.Rademakers )
-*
- INTEGER IQUEST
- COMMON/QUEST/ IQUEST(100)
-*
- INTEGER NFILES
- CHARACTER*(*) FILES(*), FILOUT
-*
- INTEGER LRECL, ISTAT
- INTEGER LENOCC
-*
- EXTERNAL HMERGE1, HMERGE2
-*____________________________________________________________________
-*
- IF (NFILES .LE. 0) THEN
- WRITE(6,'('' No INPUT file. Job aborted'')')
- GOTO 99
- ENDIF
-*
-* Open 1st file to get record length
-*
-* Auto-record length detection does not work without option X
-* on Alpha/OSF/VMS
-*
- LRECL = 0
- CALL HROPEN(21,'FILE',FILES(1),'X',LRECL,ISTAT)
- IF (ISTAT .NE. 0) THEN
- PRINT *, 'Cannot open file ', FILES(1)(1:LENOCC(FILES(1)))
- GOTO 99
- ENDIF
- CALL HRENDC('FILE')
-*
-* Create big file
-*
- IQUEST(10) = 64000
- CALL HROPEN(22,'BIGF',FILOUT(1:LENOCC(FILOUT)),'QN',LRECL,ISTAT)
- IF (ISTAT .NE. 0) THEN
- PRINT *, 'Cannot create file ', FILOUT(1:LENOCC(FILOUT))
- GOTO 99
- ENDIF
-*
-* Open 1st file to read characteristics
-*
- CALL HROPEN(21,'FILE',FILES(1),' ',LRECL,ISTAT)
- IF (ISTAT .NE. 0) THEN
- PRINT *, 'Cannot open file ', FILES(1)(1:LENOCC(FILES(1)))
- GOTO 99
- ENDIF
- CALL RZSCAN('//FILE', HMERGE1)
- CALL HRENDC('FILE')
-*
-* Loop on all files
-*
- DO 50 IFILE = 1, NFILES
- CALL HROPEN(21,'FILE',FILES(IFILE),' ',LRECL,ISTAT)
- IF (ISTAT .NE. 0) THEN
- PRINT *, 'Cannot open file ',
- + FILES(IFILE)(1:LENOCC(FILES(IFILE)))
- GOTO 99
- ENDIF
- PRINT *, 'Processing file ',
- + FILES(IFILE)(1:LENOCC(FILES(IFILE)))
- CALL RZSCAN(' ', HMERGE2)
- CALL HRENDC('FILE')
-50 CONTINUE
-*
-* Save into the big file and close file
-*
- CALL HCDIR('//BIGF',' ')
- CALL HROUT(0,ICYCLE,'T')
- IF (IQUEST(1) .NE. 0) THEN
- PRINT *, 'Error saving merged file'
- GOTO 99
- ENDIF
- CALL HRENDC('BIGF')
- PRINT *, 'Merge completed successfully'
- IQUEST(1)=0
- GO TO 999
-*
-* Abnormal end
-*
-99 CONTINUE
- IQUEST(1)=1
-*
-999 END
diff --git a/src/packlib/hbook/hmerge/hmerge1.F b/src/packlib/hbook/hmerge/hmerge1.F
deleted file mode 100644
index 3a6ea7e..0000000
--- a/src/packlib/hbook/hmerge/hmerge1.F
+++ /dev/null
@@ -1,81 +0,0 @@
-*
-* $Id: hmerge1.F,v 1.3 1997/02/21 12:15:42 couet Exp $
-*
-* $Log: hmerge1.F,v $
-* Revision 1.3 1997/02/21 12:15:42 couet
-* -previous commit was wrong
-*
-* Revision 1.2 1997/02/21 12:12:33 couet
-* *** empty log message ***
-*
-* Revision 1.1.1.1 1996/01/16 17:08:10 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.22/04 07/06/94 09.07.24 by Rene Brun
-*-- Author : Rene Brun,Fons Rademakers 26/05/94
- SUBROUTINE HMERGE1(CDIR)
-*
-#include "hbook/hcbook.inc"
-*
- INTEGER IQUEST
- COMMON/QUEST/ IQUEST(100)
-*
- CHARACTER*(*) CDIR
- CHARACTER*80 MDIR, RDIR
- LOGICAL HEXIST
- INTEGER I, NKEY, IDN, JLS, IOFSET
- INTEGER LENOCC
-*
- PRINT *, 'Initializing directory ', CDIR(1:LENOCC(CDIR))
-*
- MDIR = CDIR
- MDIR(3:6) = 'PAWC'
- RDIR = CDIR
- RDIR(3:6) = 'BIGF'
- JLS = ICFILA('/', CDIR, 1, LENOCC(CDIR))
- IF (JLS .GT. 2) THEN
- CALL HMDIR(RDIR, ' ')
- CALL HMDIR(MDIR, 'S')
- ENDIF
- CALL HCDIR(CDIR, ' ')
-*
- NKEY = 50000
- DO 20 I = 1, NKEY
- CALL RZINK(I, 0, 'S')
- IF (IQUEST(1) .NE. 0) GOTO 999
- IF (JBIT (IQUEST(14),4) .NE. 0) GOTO 20
- IDN = IQUEST(21)
- IOFSET = 100
-30 CONTINUE
- IF (HEXIST(IDN+IOFSET)) THEN
- IOFSET = IOFSET + 1
- GOTO 30
- ENDIF
- CALL HRIN(IDN,999,IOFSET)
- IF (IQUEST(1) .NE. 0) THEN
- PRINT *, 'Cannot read object ', IDN
- GOTO 99
- ENDIF
- ID = IDN + IOFSET
- IF (JBIT(IQ(LCID+KBITS),4) .NE. 0) THEN
-*
-* Create copy of Ntuple IDN
-*
- CALL HCDIR(RDIR, ' ')
- CALL HNTDUP(ID, IDN, .FALSE., ' ', 'D')
- CALL HCDIR(CDIR, ' ')
- ENDIF
-*
- CALL HDELET(ID)
-*
-20 CONTINUE
-*
- GOTO 999
-*
-* Abnormal end
-*
-99 CONTINUE
-*
-999 END
diff --git a/src/packlib/hbook/hmerge/hmerge2.F b/src/packlib/hbook/hmerge/hmerge2.F
deleted file mode 100644
index 3db5101..0000000
--- a/src/packlib/hbook/hmerge/hmerge2.F
+++ /dev/null
@@ -1,142 +0,0 @@
-*
-* $Id: hmerge2.F,v 1.1.1.1 1996/01/16 17:08:10 mclareni Exp $
-*
-* $Log: hmerge2.F,v $
-* Revision 1.1.1.1 1996/01/16 17:08:10 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.22/04 07/06/94 09.07.24 by Rene Brun
-*-- Author : Rene Brun, J.C. Marin, Fons Rademakers 26/05/94
- SUBROUTINE HMERGE2(CDIR)
-*
-#include "hbook/hcbook.inc"
-#include "hbook/hcntpar.inc"
-#include "hbook/hcntpaw.inc"
-*
- INTEGER IQUEST
- COMMON/QUEST/ IQUEST(100)
-*
- CHARACTER*(*) CDIR
- INTEGER MXENU
- PARAMETER (MXENU=512)
- CHARACTER*80 MDIR, RDIR
- CHARACTER*32 VAR
- CHARACTER*8 BLOCK
- REAL X(MXENU)
- LOGICAL HEXIST, NTOLD
- INTEGER I, NKEY, IDN, IOFSET
- INTEGER LENOCC
-*
- PRINT *, 'Merging directory ', CDIR(1:LENOCC(CDIR))
-*
- MDIR = CDIR
- MDIR(3:6) = 'PAWC'
- RDIR = CDIR
- RDIR(3:6) = 'BIGF'
- CALL HCDIR(MDIR, ' ')
- IF (IQUEST (1) .NE. 0) THEN
- PRINT *, 'New directory ', CDIR(1:LENOCC(CDIR))
- CALL HCDIR(CDIR, ' ')
- CALL HMERGE1(CDIR)
- ENDIF
- CALL HCDIR(CDIR, ' ')
-*
- NKEY = 50000
- DO 40 I = 1, NKEY
- CALL RZINK(I, 0, 'S')
- IF (IQUEST(1) .NE. 0) GOTO 999
- IF (JBIT (IQUEST(14),4) .NE. 0) GOTO 40
- IDN = IQUEST(21)
- IOFSET = 100
-20 CONTINUE
- IF (HEXIST(IDN+IOFSET)) THEN
- IOFSET = IOFSET + 1
- GOTO 20
- ENDIF
- CALL HRIN(IDN,999,IOFSET)
- IF (IQUEST(1) .NE. 0) THEN
- PRINT *, 'Cannot read object ', IDN
- GOTO 99
- ENDIF
- ID = IDN + IOFSET
- IF (JBIT (IQ(LCID+KBITS),4) .NE. 0) THEN
-*
-* Merge Ntuples
-*
- NTOLD = .FALSE.
- IF (IQ(LCID-2) .EQ. 2) NTOLD = .TRUE.
-*
-* Set addresses for CWN's
-*
- IF (.NOT. NTOLD) THEN
- NDIM = IQ(LCID+ZNDIM)
- DO 10 J = 1, NDIM
- CALL HNTVAR(IDN, J, VAR, BLOCK, NS, IT, IS, IE)
- CALL HNTGET(IDN, VAR, INDX, IT, IS, IE, IER)
- CALL HNTGET(ID, VAR, INDX, IT, IS, IE, IER)
- IF (IER .NE. 0) THEN
- PRINT *, 'Error accessing variable: ',
- + VAR(1:LENOCC(VAR)),' from Ntuple ', IDN
- GOTO 99
- ENDIF
-10 CONTINUE
- ENDIF
-*
- CALL HNOENT(ID, NENTRY)
- DO 30 IEVENT = 1, NENTRY
- IF (NTOLD) THEN
- CALL HMERGE3(ID,IOFSET,IEVENT,X,IER)
- IF (IER .NE. 0) THEN
- PRINT *, 'Error reading event ', IEVENT,
- + ' from Ntuple ', IDN
- GOTO 99
- ENDIF
- CALL HFN(IDN,X)
- IF (IQUEST(1) .NE. 0) THEN
- PRINT *, 'Error filling Ntuple ', IDN
- GOTO 99
- ENDIF
- ELSE
- IF (IEVENT .EQ. 1) THEN
- CALL HGNT(ID, IEVENT, IER)
- ELSE
- CALL HGNTF(ID, IEVENT, IER)
- ENDIF
- IF (IER .NE. 0) THEN
- PRINT *, 'Error reading event ', IEVENT,
- + ' from Ntuple ', IDN
- GOTO 99
- ENDIF
- CALL HFNT(IDN)
- ENDIF
-*
-30 CONTINUE
-*
- ELSE
-*
-* Merge histograms
-*
- IF (HEXIST(IDN)) THEN
- CALL HOPERA(IDN, '+', ID, IDN, 1., 1.)
- ELSE
- CALL HRIN(IDN, 999, 0)
- IF (IQUEST(1) .NE. 0) THEN
- PRINT *, 'Cannot read histogram ', IDN
- GOTO 99
- ENDIF
- ENDIF
- ENDIF
-*
- CALL HDELET(ID)
-*
-40 CONTINUE
-*
- GOTO 999
-*
-* Abnormal end
-*
-99 CONTINUE
-*
-999 END
diff --git a/src/packlib/hbook/hmerge/hmerge3.F b/src/packlib/hbook/hmerge/hmerge3.F
deleted file mode 100644
index e9d33db..0000000
--- a/src/packlib/hbook/hmerge/hmerge3.F
+++ /dev/null
@@ -1,83 +0,0 @@
-*
-* $Id: hmerge3.F,v 1.1.1.1 1996/01/16 17:08:10 mclareni Exp $
-*
-* $Log: hmerge3.F,v $
-* Revision 1.1.1.1 1996/01/16 17:08:10 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.22/04 07/06/94 09.07.24 by Rene Brun
-*-- Author : Rene Brun 26/05/94
- SUBROUTINE HMERGE3(IDN,IOFSET,IDNEVT,X,IERROR)
-*.==========>
-*. Return in array X the variables of event IDNEVT
-*.
-*..=========> ( R.Brun )
-*
-#include "hbook/hcbook.inc"
-#include "hbook/hcdire.inc"
-*
- COMMON/QUEST/IQUEST(100)
- DIMENSION KEYS(2)
- DIMENSION X(*)
-*.___________________________________________
-*
- LCIDN=0
- NIDN=LOCATI(IQ(LTAB+1),IQ(LCDIR+KNRH),IDN)
- IF(NIDN.LE.0)THEN
- CALL HRIN(IDN-IOFSET,99999,IOFSET)
- NIDN=LOCATI(IQ(LTAB+1),IQ(LCDIR+KNRH),IDN)
- IF(NIDN.LE.0)GO TO 90
- ENDIF
- LCIDN=LQ(LTAB-NIDN)
- IF(LCIDN.LE.0)GO TO 90
-*
- IF(IDNEVT.LE.0)GO TO 90
- IF(IDNEVT.GT.IQ(LCIDN+3))THEN
- IERROR=-1
- RETURN
- ENDIF
- LC=LQ(LCIDN-1)
- NEVB=IQ(LC-1)/IQ(LCIDN+2)
- IBANK=(IDNEVT-1)/NEVB + 1
-*
-* Load bank containing this event
-*
- IF(IQ(LCIDN+11).EQ.0)THEN
- DO 10 I=2,IBANK
- IF(LQ(LC).NE.0)LC=LQ(LC)
- 10 CONTINUE
- ELSE
- IF(IQ(LCIDN).EQ.IBANK.OR.IQ(LCIDN+6).EQ.0)GO TO 20
- IF(IBANK.LE.IQ(LCIDN+6))THEN
- IF(ICHTYP(ICDIR).EQ.1)THEN
- KEYS(1) = IDN+10000*IBANK-IOFSET
- KEYS(2) = 0
- ELSE
- KEYS(1) = IDN-IOFSET
- KEYS(2) = IBANK
- ENDIF
- CALL HRZIN(IHDIV,LCIDN,-1,KEYS,99999,'R')
- IF(IQUEST(1).NE.0)GO TO 90
- ELSE
- CALL HDELET(IDN)
- CALL HRIN(IDN-IOFSET,99999,IOFSET)
- NIDN=LOCATI(IQ(LTAB+1),IQ(LCDIR+KNRH),IDN)
- LCIDN=LQ(LTAB-NIDN)
- ENDIF
- LC=LQ(LCIDN-1)
- IQ(LCIDN)=IBANK
- ENDIF
-*
- 20 IERROR=0
- IAD=IQ(LCIDN+2)*(IDNEVT-NEVB*(IBANK-1)-1)
- DO 30 I=1,IQ(LCIDN+2)
- X(I)=Q(LC+IAD+I)
- 30 CONTINUE
- RETURN
-*
-* Error
-*
- 90 IERROR=1
- END
diff --git a/src/packlib/hbook/hmerge/hmergin.F b/src/packlib/hbook/hmerge/hmergin.F
deleted file mode 100644
index 4481f89..0000000
--- a/src/packlib/hbook/hmerge/hmergin.F
+++ /dev/null
@@ -1,57 +0,0 @@
-*
-* $Id: hmergin.F,v 1.1.1.1 1996/01/16 17:08:10 mclareni Exp $
-*
-* $Log: hmergin.F,v $
-* Revision 1.1.1.1 1996/01/16 17:08:10 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.22/11 23/08/94 14.21.16 by Rene Brun
-*-- Author : Rene Brun, J.C. Marin and Fons Rademakers 26/05/94
- SUBROUTINE HMERGIN
-*.==========>
-*.
-*. Main subroutine to merge HBOOK files with identical objects
-*. and directories.
-*.
-*..=========> (Rene Brun, J.C. Marin, A.A.Rademakers )
-*
- INTEGER MXFILES
- PARAMETER (MXFILES=99)
- INTEGER NFILES
- CHARACTER*80 FILES
- COMMON /FILES/ NFILES, FILES(MXFILES)
-*
- CHARACTER*80 FILOUT
-*____________________________________________________________________
-*
-* Get output file name
-*
- FILOUT = ' '
- WRITE(6,1000)
- 1000 FORMAT(' Give output file name ===>')
- READ(5,'(A)') FILOUT
- IF (LENOCC(FILOUT) .LE. 0) THEN
- WRITE(6,'('' No OUTPUT file. Job aborted'')')
- GOTO 99
- ENDIF
-*
-* Get all input file names
-*
- NFILES = 0
- 5 WRITE(6,2000)
- 2000 FORMAT(' Give input file name or terminate with a blank ==>')
- FILES(NFILES+1) = ' '
- READ(5,'(A)') FILES(NFILES+1)
- NCH = LENOCC(FILES(NFILES+1))
- IF (NCH .GT. 0) THEN
- NFILES = NFILES + 1
- IF(NFILES.LT.MXFILES)GOTO 5
- ENDIF
-*
-* call the main merger
-*
- CALL HMERGE(NFILES,FILES,FILOUT)
-*
- 99 END
diff --git a/src/packlib/hbook/hmmap/Imakefile b/src/packlib/hbook/hmmap/Imakefile
deleted file mode 100644
index dfb55a8..0000000
--- a/src/packlib/hbook/hmmap/Imakefile
+++ /dev/null
@@ -1,4 +0,0 @@
-SRCS_F= hcreatem.F hlimap.F hlnxtm.F hlnxtm1.F hmapm.F hplism.F hplism1.F \ @@\
- hrdirm.F hresetm.F hresetm1.F hrez0m.F hrzinm.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/hbook/hmmap/hcreatem.F b/src/packlib/hbook/hmmap/hcreatem.F
deleted file mode 100644
index 6c37e8c..0000000
--- a/src/packlib/hbook/hmmap/hcreatem.F
+++ /dev/null
@@ -1,100 +0,0 @@
-*
-* $Id: hcreatem.F,v 1.2 1996/03/13 10:13:20 couet Exp $
-*
-* $Log: hcreatem.F,v $
-* Revision 1.2 1996/03/13 10:13:20 couet
-* Mods for ALPHA_OSF: William Badgett, Univ of Wisconsin <BADGETT at vxdesy.desy.de>
-*
-* Revision 1.1.1.1 1996/01/16 17:08:09 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 14/09/95 10.00.05 by Julian Bunn
-*-- Author : Fons Rademakers 20/03/91
-*-- Modified : Wojtek Burkot 02/03/91
- INTEGER FUNCTION HCREATEM(MFILE, IBASE, ISIZE, IOFFST)
-************************************************************************
-* *
-* HCREATEM *
-* *
-* Create a global section. This routine causes the pages at ICOMAD *
-* and continuing for at most ISIZE words (1 word = 4 bytes) to be *
-* mapped from file MFILE. MFILE will be created in the /tmp directory. *
-* IOFFST is the offset between the address of the common starting at *
-* IBASE and the address of ICOMAD. The space in ICOMAD can then be *
-* addressed like: IBASE(IOFFST+1,...). *
-* On successful completion this function returns 0. In case of an *
-* error -ERRNO is returned. *
-* HCREATEM is an interface routine that calls the C routine HCREATEI. *
-* *
-* After a global section has been created by this function, other *
-* processes can use the data in this global section via the functions *
-* HMAPM and HFREEM. *
-* On BSD machines, the shared memory is automatically deleted when *
-* the process who has created it terminates. *
-* On non-BSD machines, the user has to delete the shared memory via *
-* CALL HFREEM(0) *
-* *
-************************************************************************
-*
- CHARACTER*(*) MFILE
-#if !defined(CERNLIB_ALPHA_OSF)
- INTEGER ICOMAD(1), ISIZE, IBASE(1), HCREATEI
- SAVE ICOMAD
-#endif
-#if defined(CERNLIB_ALPHA_OSF)
- INTEGER ISIZE, IBASE(1), HCREATEI
- INTEGER*8 ICOMAD(1)
- SAVE ICOMAD
-#endif
-*
-#if defined(CERNLIB_BSD)||defined(CERNLIB_WINNT)
- MFLEN = LENOCC(MFILE)
- HCREATEM = HCREATEI(MFILE, MFLEN, IBASE, ISIZE, ICOMAD)
-#endif
-#if defined(CERNLIB_SYS5)
- PARAMETER (MFEN=100000000)
- CALL UCTOH(MFILE,MKEY,4,4)
-************************************************************************
-* modification: change ICOMAD(1) on input to required address of *
-* mapping. MUST! be higher in memory than PAW common to assure *
-* proper action of MZSTORE *
-************************************************************************
- ICOMAD(1) = 0
-#endif
-#if (defined(CERNLIB_DECS))&&(!defined(CERNLIB_ALPHA))
- ICOMAD(1) = 4*LOCF(ICOMAD(1)) + MFEN
- ICOMAD(1) = ((ICOMAD(1)+4095)/4096)*4096
-#endif
-#if (defined(CERNLIB_DECS))&&(defined(CERNLIB_ALPHA))
- ICOMAD(1) = 4*LOCF(ICOMAD(1)) + MFEN
-C Pages on the AXP are 8k !
- ICOMAD(1) = ((ICOMAD(1)+8191)/8192)*8192
-#endif
-#if defined(CERNLIB_SGI)
- ICOMAD(1) = 4*LOCF(IBASE(1)) + MFEN
- ICOMAD(1) = ((ICOMAD(1)+4095)/4096)*4096
-#endif
-#if defined(CERNLIB_ALPHA_OSF)
- ICOMAD(1) = %loc(IBASE(1)) + MFEN
- ICOMAD(1) = ((ICOMAD(1)+8191)/8192)*8192
- HCREATEM = HCREATEI(MKEY, ISIZE, %val(ICOMAD(1)) )
-#endif
-#if defined(CERNLIB_HPUXBUG)
- HCREATEM = -1
- CALL HBUG('Cannot use HLIMAP on HPUX: Waiting for f77 fix',
- + 'HLIMAP',0)
-#endif
-#if defined(CERNLIB_SYS5) && !defined(CERNLIB_ALPHA_OSF)
- HCREATEM = HCREATEI(MKEY, ISIZE, ICOMAD)
-#endif
-
-#if !defined(CERNLIB_ALPHA_OSF)
- IOFFST = ICOMAD(1) - LOCF(IBASE(1))
-#endif
-#if defined(CERNLIB_ALPHA_OSF)
- IOFFST = ( ICOMAD(1) - %LOC(IBASE(1)) ) / 4
-#endif
-*
- END
diff --git a/src/packlib/hbook/hmmap/hlimap.F b/src/packlib/hbook/hmmap/hlimap.F
deleted file mode 100644
index 29001fa..0000000
--- a/src/packlib/hbook/hmmap/hlimap.F
+++ /dev/null
@@ -1,185 +0,0 @@
-*
-* $Id: hlimap.F,v 1.5 2003/06/04 15:01:57 couet Exp $
-*
-* $Log: hlimap.F,v $
-* Revision 1.5 2003/06/04 15:01:57 couet
-* - New COMMON block MMPSHR in order to share the variable IGOFF with the
-* PAW routine PAHIO. Without this, the reset of the histograms (via
-* GRESET) in shared memory, does not work.
-*
-* Revision 1.4 2001/10/10 08:10:08 couet
-* - Call MZFROM to initialise IOCC which is used later in HLABEL to create
-* alphamuneric labels data bank in histograms.
-*
-* Revision 1.3 1998/04/08 14:12:20 couet
-* - VIDQQ was not used, and was initialised as a wrong "what" string.
-*
-* Revision 1.2 1996/05/08 10:04:26 couet
-* - Fix a typo
-*
-* Revision 1.1.1.1 1996/01/16 17:08:09 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.22/12 13/09/94 12.32.24 by Rene Brun
-*-- Author : Rene Brun 20/03/91
- SUBROUTINE HLIMAP(LIMIT,NAME)
-*.==========>
-*. Initialization routine for HBOOK
-*.
-*. The routine maps the file NAME to memory
-* using the routine HCREATEM.
-*
-* Note that HBOOK does not delete the shared memory when the job
-* finishes. It is the user responsability to do it:
-* on SYSTEM 5 machines, one can list the current active shared memories
-* with the system command ipcs -m
-* A shared memory can be deleted on these systems by:
-* ipcrm -m ID
-* If the size of the shared memory is increased, one must delete
-* first the old memory.
-*
-* The ZEBRA store is created between the address
-* at the start of /PAWC/ and the end of the mapped region.
-*
-* In case ZEBRA is not initialized, a dummy primary store
-* is created (BIDON)
-*
-*. IF(LIMIT>0) CALL MZEBRA and MZPAW
-*. and create a shared memory of size LIMIT
-*. IF(LIMIT=0) no calls to MZEBRA and MZPAW (HLIMIT already called)
-*. only attach shared memory
-*. IF(LIMIT<0) Do not initialize ZEBRA (already done)
-*. and create a shared memory of size -LIMIT
-*..=========> ( R.Brun )
- COMMON/BIDON/IBID,FENBID(5),LQBID(10000)
-*
-#include "hbook/hcbook.inc"
-#include "hbook/hcform.inc"
-#include "hbook/hcdire.inc"
-#include "hbook/hcunit.inc"
- CHARACTER*(*) NAME
- INTEGER HCREATEM,HMAPM,HFREEM
- CHARACTER*4 GNAME
- CHARACTER*64 CHGLOB
- SAVE CHGLOB
- COMMON /MMPSHR/ IGSIZE,IGOFF
- DATA IGSIZE,IGOFF/0,0/
-*.___________________________________________
-*
-*. CASE LIMIT=0 only attach shared memory
-*. =========================================
- IF(LIMIT.EQ.0)THEN
- IF(IGOFF.GT.0) THEN
- IERROR=HFREEM(IGOFF)
- CALL HREND(CHGLOB)
- ENDIF
- NCH=LENOCC(NAME)
- IGSIZE=HMAPM(NAME,LQ,IGOFF)
- IF(IGSIZE.NE.0) THEN
- IGOFF=0
- IERROR=-IGSIZE
- WRITE(LERR,1000)IERROR,NAME(1:NCH)
-1000 FORMAT(' ***** HLIMAP Error',I6,' mapping memory ',A)
- GO TO 99
- ENDIF
-*
-* Connect Global Memory as a virtual HBOOK file.
-*
- NCHT=NCHTOP
- CALL HRFILE(LQ(IGOFF+1),NAME,'M')
- IF(NCHTOP.NE.NCHT)THEN
- HFNAME(NCHTOP)='Global memory : '//NAME(1:NCH)
- CHGLOB=CHTOP(NCHTOP)
- ENDIF
- GO TO 99
- ENDIF
-*.
-*. All other cases create a new shared memory
-*. ==========================================
- CALL HMACHI
-*
- NHBOOK=IABS(LIMIT)
- IF(LIMIT.GE.0)THEN
- CALL MZEBRA(-3)
- CALL MZSTOR(IBID,'/BIDON/',' ',FENBID,LQBID,LQBID,LQBID,
- + LQBID(2000),LQBID(10000))
-*
- ENDIF
-*
- GNAME=NAME
- IS = HCREATEM(GNAME, LQ, NHBOOK, IOFFST)
- IF (IS .EQ. 0) THEN
- PRINT *, 'GLOBAL MEMORY CREATED, offset from LQ =', IOFFST
- ELSE
- PRINT *, 'GLOBAL MEMORY ERROR = ',IS
- RETURN
- ENDIF
-*
-* Option ':' disables checking of overlapping stores
- CALL MZSTOR (IXPAWC,'/PAWC/',':',FENC,LQ(1),LQ(1),LQ(1),
- + LQ(IOFFST+10),LQ(IOFFST+NHBOOK-10))
- NWPAW = NHBOOK
- CALL MZWORK(IXPAWC,LQ(2),LQ(IOFFST),0)
-*
- IHDIV = 0
- IXHIGZ = 0
- IXKU = 0
-*
- CALL MZLINK(IXPAWC,'/HCBOOK/',LHBOOK,LCDIR,LCIDN)
- ILAST=IOFFST+NHBOOK
- CALL MZLINK(IXPAWC,'HCMAP',LQ(ILAST),LQ(ILAST),LQ(ILAST))
-*
-***************************************************************
-* *
-*-- Structural links in LHBOOK and LCDIR *
-* *
-* lq(lcdir-1)= lsdir : pointer to subdirectory *
-* lq(lcdir-2)= lids : pointer to 1st ID in directory *
-* lq(lcdir-3)= ltab : pointer to list of ordered IDs *
-* lq(lcdir-4)= lbuf : pointer to ntuple buffers *
-* lq(lcdir-5)= ltmp : pointer to ntuple buffers *
-* lq(lcdir-6)= lhquad: pointer to HQUAD buffers *
-* lq(lcdir-7)= : free *
-* lq(lcdir-8)= labl : used by HPLOT routine HPLABL *
-* R lq(lcdir-9)= llid : pointer to last ID in directory *
-* R lq(lcdir-10)= : free *
-***************************************************************
-*
-*
- IHWORK=IXPAWC+1
- IHDIV =IXPAWC+2
-*
- CALL MZFORM('HDIR','4H -I',IODIR)
- CALL MZFORM('HID1','1B 2I 6F -H',IOH1)
- CALL MZFORM('HID2','1B 2I 3F 1I 4F -H',IOH2)
- CALL MZFORM('HIDN','11I -H',IOHN)
- CALL MZFORM('HIDT','13I -H',IONT)
- CALL MZFORM('HBLK','7I -H',IOBL)
- CALL MZFORM('HCF1','2I 2F 4D -F',IOCF1)
- CALL MZFORM('HCB1','2I 2F 4D -B',IOCB1)
- CALL MZFORM('HCF2','2I -F',IOCF2)
- CALL MZFORM('HCF4','4I -F',IOCF4)
- CALL MZFORM('HCB2','2I -B',IOCB2)
- CALL MZFORM('HFIT','10I -F',IOFIT)
- CALL MZFORM('LCHX','2I -H',IOCC)
- CALL MZBOOK(IHDIV,LCDIR,LHBOOK, 1,'HDIR',50,8,10,IODIR,0)
- CALL UCTOH('PAWC ',IQ(LCDIR+1),4,16)
- CALL MZBOOK(IHDIV,LTAB ,LHBOOK,-3,'HTAB',500,0,500,2,0)
-*
- LMAIN =LHBOOK
- LQ(ILAST)=LMAIN
- LQ(IOFFST+1)=NHBOOK
- LQ(IOFFST+2)=IOFFST
- NLCDIR=1
- NLPAT =1
- CHCDIR(1)='PAWC'
- NCHTOP=1
- CHTOP(1)='PAWC'
- HFNAME(1)='COMMON /PAWC/ in memory'
- ICHTOP(1)=0
- ICHLUN(1)=0
- ICDIR=1
-*
- 99 END
diff --git a/src/packlib/hbook/hmmap/hlnxtm.F b/src/packlib/hbook/hmmap/hlnxtm.F
deleted file mode 100644
index 2ec1428..0000000
--- a/src/packlib/hbook/hmmap/hlnxtm.F
+++ /dev/null
@@ -1,61 +0,0 @@
-*
-* $Id: hlnxtm.F,v 1.1.1.1 1996/01/16 17:08:09 mclareni Exp $
-*
-* $Log: hlnxtm.F,v $
-* Revision 1.1.1.1 1996/01/16 17:08:09 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.21/06 06/12/93 18.28.53 by Rene Brun
-*-- Author : Rene Brun 06/12/93
- SUBROUTINE HLNXTM(IPAWD,IDH,CHTYPE,CHTITL,CHOPT)
-*.==========>
-*. To return next object in shared memory IPAWD
-*..=========> ( R.Brun)
-#include "hbook/hcdire.inc"
- CHARACTER*(*) CHTYPE,CHTITL,CHOPT
- DIMENSION IHDIR(4)
- DIMENSION IPAWD(100)
- SAVE NEXT
-*.___________________________________________
- NW=IPAWD(1)
- KOF=IPAWD(2)
- ILAST=IPAWD(NW)
- JR1=ILAST-KOF
-*
-* Search levels down
-*
- IF(NLPAT.GT.1)THEN
- DO 50 IL=2,NLPAT
- CALL UCTOH(CHPAT(IL),IHDIR,4,16)
- JR1=IPAWD(JR1-1)-KOF
- 30 IF(JR1.EQ.0)GO TO 99
- DO 40 I=1,4
- IF(IHDIR(I).NE.IPAWD(JR1+I+8))THEN
- JR1=IPAWD(JR1)-KOF
- GO TO 30
- ENDIF
- 40 CONTINUE
- 50 CONTINUE
- ENDIF
-*
- JCDIR = JR1
- JTAB = IPAWD(JCDIR-3)-KOF
-*
- NTOT =IPAWD(JTAB+7)
- IF(IDH.EQ.0)NEXT=0
- 60 NEXT=NEXT+1
- IF(NEXT.GT.NTOT)THEN
- IDH=0
- GO TO 99
- ENDIF
- IF(IPAWD(JTAB-NEXT).EQ.0)GO TO 60
- ID1=IPAWD(JTAB+NEXT+8)
- JCID=IPAWD(JTAB-NEXT)-KOF
- CALL HLNXTM1(IPAWD(9),IPAWD(1),ID1,JCID,IDH,CHTYPE,CHTITL
- + ,CHOPT)
- IF(IDH.EQ.0)GO TO 60
-*
- 99 RETURN
- END
diff --git a/src/packlib/hbook/hmmap/hlnxtm1.F b/src/packlib/hbook/hmmap/hlnxtm1.F
deleted file mode 100644
index afe37e7..0000000
--- a/src/packlib/hbook/hmmap/hlnxtm1.F
+++ /dev/null
@@ -1,73 +0,0 @@
-*
-* $Id: hlnxtm1.F,v 1.1.1.1 1996/01/16 17:08:09 mclareni Exp $
-*
-* $Log: hlnxtm1.F,v $
-* Revision 1.1.1.1 1996/01/16 17:08:09 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.21/06 06/12/93 16.49.08 by Rene Brun
-*-- Author : Rene Brun 06/12/93
- SUBROUTINE HLNXTM1(IB,LB,ID1,JCID,IDH,CHTYPE,CHTITL,CHOPT)
-*.==========>
-*. Auxiliary for HLNXTM
-*..=========> ( R.Brun)
-#include "hbook/hcbook.inc"
-#include "hbook/hcflag.inc"
-#include "hbook/hcntpar.inc"
- CHARACTER*(*) CHTYPE,CHTITL,CHOPT
- DIMENSION IB(1),LB(1)
-*.___________________________________________
-#include "hbook/jbyt.inc"
- I123=JBYT(IB(JCID+KBITS),1,3)
- I230=JBYT(IB(JCID+KBITS),2,2)
- I1 =JBIT(I123,1)
- I4 =JBIT(IB(JCID+KBITS),4)
-*
-*
- IF(I1.NE.0)THEN
- NWTITL=IB(JCID-1)-KTIT1+1
- IF(INDEX(CHOPT,'1').NE.0) THEN
- IDH=ID1
- CHTYPE='1'
- CHTITL=' '
- CALL UHTOC(IB(JCID+KTIT1),4,CHTITL,NWTITL*4)
- RETURN
- ENDIF
- ELSEIF(I230.NE.0)THEN
- NWTITL=IB(JCID-1)-KTIT2+1
- IF(INDEX(CHOPT,'2').NE.0) THEN
- IDH=ID1
- CHTYPE='2'
- CHTITL=' '
- CALL UHTOC(IB(JCID+KTIT2),4,CHTITL,NWTITL*4)
- RETURN
- ENDIF
- ELSEIF(I4.NE.0)THEN
- IF (IB(JCID-2) .EQ. 2) THEN
- ITIT1=JCID+IB(JCID+9)
- NWTITL=IB(JCID+8)
- ELSE
- ITIT1=JCID+IB(JCID+ZITIT1)
- NWTITL=IB(JCID+ZNWTIT)
- ENDIF
- IF(INDEX(CHOPT,'N').NE.0) THEN
- IDH=ID1
- CHTYPE='N'
- CHTITL=' '
- CALL UHTOC(IB(ITIT1),4,CHTITL,NWTITL*4)
- RETURN
- ENDIF
- ELSE
- IF(INDEX(CHOPT,'?').NE.0) THEN
- IDH=-1
- CHTYPE='?'
- CHTITL='??? '
- RETURN
- ENDIF
- GO TO 99
- ENDIF
-*
- 99 RETURN
- END
diff --git a/src/packlib/hbook/hmmap/hmapm.F b/src/packlib/hbook/hmmap/hmapm.F
deleted file mode 100644
index 1961298..0000000
--- a/src/packlib/hbook/hmmap/hmapm.F
+++ /dev/null
@@ -1,107 +0,0 @@
-*
-* $Id: hmapm.F,v 1.3 2001/10/02 09:06:15 couet Exp $
-*
-* $Log: hmapm.F,v $
-* Revision 1.3 2001/10/02 09:06:15 couet
-* - The following program didn't work. It could not access the shared memory
-* area named 'ASA'.
-*
-* Program shm_read
-* Common /PAWC/ A(100000)
-* Call Hlimit(100000)
-* Call Hlimap(0,'ASA')
-* End
-*
-* To make it work the shared memory name had to be put in a character
-* variable, ie:
-*
-* Program shm_read
-* Common /PAWC/ A(100000)
-* Character*8 C
-* Call Hlimit(100000)
-* C = 'ASA'
-* Call Hlimap(0,C)
-* End
-*
-* Revision 1.2 1996/05/14 10:28:52 couet
-* - Mods for ALPHA OSF
-*
-* Revision 1.1.1.1 1996/01/16 17:08:09 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.21/08 05/01/94 09.03.21 by Rene Brun
-*-- Author : Fons Rademakers 20/03/91
-*-- Modified: Wojtek Burkot 01/03/92
- INTEGER FUNCTION HMAPM(MFILE, IBASE, IOFFST)
-************************************************************************
-* *
-* HMAPM *
-* *
-* Create a global section. This routine causes the pages at ICOMAD *
-* to be mapped from file MFILE. MFILE must have been created in the *
-* /tmp directory. It returns in IOFFST the offset between ICOMAD and *
-* a base common IBASE (typically the PAWC). On successful completion *
-* this function returns 0. In case of an error -ERRNO is returned. *
-* *
-* HMAPM is an interface routine that calls the C routine HMAPI. *
-* *
-* After a global section has been created by HCREATEM, other *
-* processes can use the data in the global section via this function *
-* and HFREEM. *
-* *
-************************************************************************
-*
- CHARACTER*(*) MFILE
-#if !defined(CERNLIB_ALPHA_OSF)
- INTEGER ICOMAD(1), IBASE(1), HMAPI
- SAVE ICOMAD
-#endif
-#if defined(CERNLIB_ALPHA_OSF)
- INTEGER IBASE(1), HMAPI
- INTEGER*8 ICOMAD(1)
- SAVE ICOMAD
-#endif
-*
-#if defined(CERNLIB_BSD)||defined(CERNLIB_WINNT)
- MFLEN = LENOCC(MFILE)
- HMAPM = HMAPI(MFILE, MFLEN, IBASE, ICOMAD)
-#endif
-#if defined(CERNLIB_SYS5)
-************************************************************************
-* modification: set ICOMAD in input to required starting address of *
-* mapping. Actual mapping address will be returned in IOFFST. *
-* This requires also a change in C routine HMAPI. *
-* 02/03/1992 W.B. *
-************************************************************************
- CHARACTER*(128) MFILE2
- PARAMETER (MFEN=100000000)
- MFILE2 = MFILE
- CALL UCTOH(MFILE2,MKEY,4,4)
- ICOMAD(1) = 0
-#endif
-#if defined(CERNLIB_DECS)
- ICOMAD(1) = 4*LOCF(ICOMAD(1)) + MFEN
- ICOMAD(1) = ((ICOMAD(1)+4095)/4096)*4096
-#endif
-#if defined(CERNLIB_SGI)
- ICOMAD(1) = 4*LOCF(IBASE(1)) + MFEN
- ICOMAD(1) = ((ICOMAD(1)+4095)/4096)*4096
-#endif
-#if defined(CERNLIB_ALPHA_OSF)
- ICOMAD(1) = %loc(IBASE(1)) + MFEN
- ICOMAD(1) = ((ICOMAD(1)+8191)/8192)*8192
- HMAPM = HMAPI(MKEY, %val(ICOMAD(1)) )
-#endif
-#if defined(CERNLIB_SYS5) && !defined(CERNLIB_ALPHA_OSF)
- HMAPM = HMAPI(MKEY, ICOMAD)
-#endif
-#if !defined(CERNLIB_ALPHA_OSF)
- IOFFST = ICOMAD(1) - LOCF(IBASE(1))
-#endif
-#if defined(CERNLIB_ALPHA_OSF)
- IOFFST = ( ICOMAD(1) - %LOC(IBASE(1)) ) / 4
-#endif
-*
- END
diff --git a/src/packlib/hbook/hmmap/hplism.F b/src/packlib/hbook/hmmap/hplism.F
deleted file mode 100644
index ca629d4..0000000
--- a/src/packlib/hbook/hmmap/hplism.F
+++ /dev/null
@@ -1,53 +0,0 @@
-*
-* $Id: hplism.F,v 1.1.1.1 1996/01/16 17:08:09 mclareni Exp $
-*
-* $Log: hplism.F,v $
-* Revision 1.1.1.1 1996/01/16 17:08:09 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.20/10 11/10/93 08.36.36 by Rene Brun
-*-- Author : Rene Brun 27/07/93
- SUBROUTINE HPLISM(IPAWD)
-*.==========>
-*. To list histograms in shared memory IPAWD
-*..=========> ( R.Brun, W.Bruckner)
-#include "hbook/hcdire.inc"
- DIMENSION IHDIR(4)
- DIMENSION IPAWD(100)
-*.___________________________________________
- NW=IPAWD(1)
- KOF=IPAWD(2)
- ILAST=IPAWD(NW)
- JR1=ILAST-KOF
-*
-*
-* Search levels down
-*
- IF(NLPAT.GT.1)THEN
- DO 50 IL=2,NLPAT
- CALL UCTOH(CHPAT(IL),IHDIR,4,16)
- JR1=IPAWD(JR1-1)-KOF
- 30 IF(JR1.EQ.0)GO TO 99
- DO 40 I=1,4
- IF(IHDIR(I).NE.IPAWD(JR1+I+8))THEN
- JR1=IPAWD(JR1)-KOF
- GO TO 30
- ENDIF
- 40 CONTINUE
- 50 CONTINUE
- ENDIF
-*
- JCDIR = JR1
- JTAB = IPAWD(JCDIR-3)-KOF
-*
- NTOT =IPAWD(JTAB+7)
- DO 60 I=1,NTOT
- IF(IPAWD(JTAB-I).EQ.0)GO TO 60
- ID1=IPAWD(JTAB+I+8)
- CALL HPLISM1(IPAWD(9),IPAWD(1),ID1,JTAB,KOF)
- 60 CONTINUE
-*
- 99 RETURN
- END
diff --git a/src/packlib/hbook/hmmap/hplism1.F b/src/packlib/hbook/hmmap/hplism1.F
deleted file mode 100644
index a3d7e9a..0000000
--- a/src/packlib/hbook/hmmap/hplism1.F
+++ /dev/null
@@ -1,61 +0,0 @@
-*
-* $Id: hplism1.F,v 1.1.1.1 1996/01/16 17:08:09 mclareni Exp $
-*
-* $Log: hplism1.F,v $
-* Revision 1.1.1.1 1996/01/16 17:08:09 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.21/00 23/10/93 17.04.39 by Rene Brun
-*-- Author : Rene Brun 27/07/93
- SUBROUTINE HPLISM1(IB,LB,ID1,JTAB,KOF)
-*.==========>
-*. Auxiliary for HPLISM
-*..=========> ( R.Brun, W.Bruckner)
-#include "hbook/hcbook.inc"
-#include "hbook/hcunit.inc"
-#include "hbook/hcntpar.inc"
- DIMENSION IB(1),LB(1)
-*.___________________________________________
-#include "hbook/jbyt.inc"
- NH=IB(JTAB-1)
- DO 10 I=1,NH
- IF(IB(JTAB+I).EQ.ID1)GO TO 20
- 10 CONTINUE
- GO TO 99
-*
- 20 CONTINUE
-C ID=ID1
- JCID=LB(JTAB-I)-KOF
- NTOT=IB(JCID+KNTOT)
- I123=JBYT(IB(JCID+KBITS),1,3)
- I230=JBYT(IB(JCID+KBITS),2,2)
- I1 =JBIT(I123,1)
- I4 =JBIT(IB(JCID+KBITS),4)
-*
- IF(I1.NE.0)THEN
- NWTITL=IB(JCID-1)-KTIT1+1
- ITIT1=JCID+KTIT1
- ELSEIF(I230.NE.0)THEN
- NWTITL=IB(JCID-1)-KTIT2+1
- ITIT1=JCID+KTIT2
- ELSEIF(I4.NE.0)THEN
- IF (IB(JCID-2) .EQ. 2) THEN
- ITIT1=JCID+IB(JCID+9)
- NWTITL=IB(JCID+8)
- ELSE
- ITIT1=JCID+IB(JCID+ZITIT1)
- NWTITL=IB(JCID+ZNWTIT)
- ENDIF
- ELSE
- GO TO 99
- ENDIF
- WRITE (LOUT,1001) ID1,(IB(KK),KK=ITIT1,ITIT1+NWTITL-1)
-1001 FORMAT(1X,I12,2X,15A4)
-*
-*
- 90 CONTINUE
-*
- 99 RETURN
- END
diff --git a/src/packlib/hbook/hmmap/hrdirm.F b/src/packlib/hbook/hmmap/hrdirm.F
deleted file mode 100644
index fa93d6f..0000000
--- a/src/packlib/hbook/hmmap/hrdirm.F
+++ /dev/null
@@ -1,54 +0,0 @@
-*
-* $Id: hrdirm.F,v 1.1.1.1 1996/01/16 17:08:10 mclareni Exp $
-*
-* $Log: hrdirm.F,v $
-* Revision 1.1.1.1 1996/01/16 17:08:10 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.21/07 20/12/93 10.24.13 by Rene Brun
-*-- Author : Rene Brun 20/12/93
- SUBROUTINE HRDIRM(IPAWD,MAXDIR,CHDIR,NDIR)
-*.==========>
-*. To return list of subdirectories in shared memory IPAWD
-*..=========> ( R.Brun)
-#include "hbook/hcdire.inc"
- CHARACTER*(*) CHDIR(*)
- DIMENSION IHDIR(4)
- DIMENSION IPAWD(100)
-*.___________________________________________
- NW=IPAWD(1)
- KOF=IPAWD(2)
- ILAST=IPAWD(NW)
- JR1=ILAST-KOF
-*
-* Search levels down
-*
- IF(NLPAT.GT.1)THEN
- DO 50 IL=2,NLPAT
- CALL UCTOH(CHPAT(IL),IHDIR,4,16)
- JR1=IPAWD(JR1-1)-KOF
- 30 IF(JR1.EQ.0)GO TO 99
- DO 40 I=1,4
- IF(IHDIR(I).NE.IPAWD(JR1+I+8))THEN
- JR1=IPAWD(JR1)-KOF
- GO TO 30
- ENDIF
- 40 CONTINUE
- 50 CONTINUE
- ENDIF
-*
- JCDIR = JR1
- NDIR=0
- LF=IPAWD(JCDIR-1)
- IF(LF.NE.0)THEN
- 60 IF(NDIR.GE.MAXDIR)GO TO 99
- NDIR=NDIR+1
- CHDIR(NDIR)=' '
- LF=LF-KOF
- CALL UHTOC(IPAWD(LF+9),4,CHDIR(NDIR),16)
- LF=IPAWD(LF)
- IF(LF.NE.0)GO TO 60
- ENDIF
- 99 END
diff --git a/src/packlib/hbook/hmmap/hresetm.F b/src/packlib/hbook/hmmap/hresetm.F
deleted file mode 100644
index aeb1e0a..0000000
--- a/src/packlib/hbook/hmmap/hresetm.F
+++ /dev/null
@@ -1,58 +0,0 @@
-*
-* $Id: hresetm.F,v 1.1.1.1 1996/01/16 17:08:09 mclareni Exp $
-*
-* $Log: hresetm.F,v $
-* Revision 1.1.1.1 1996/01/16 17:08:09 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.20/03 27/07/93 10.02.38 by Rene Brun
-*-- Author : Rene Brun 27/07/93
- SUBROUTINE HRESETM(ID,IPAWD)
-*.==========>
-*. To reset histogram ID in shared memory IPAWD
-*. If ID=0 reset all histograms
-*..=========> ( R.Brun, W.Bruckner)
-#include "hbook/hcdire.inc"
- DIMENSION IHDIR(4)
- DIMENSION IPAWD(100)
-*.___________________________________________
- NW=IPAWD(1)
- KOF=IPAWD(2)
- ILAST=IPAWD(NW)
- JR1=ILAST-KOF
-*
-*
-* Search levels down
-*
- IF(NLPAT.GT.1)THEN
- DO 50 IL=2,NLPAT
- CALL UCTOH(CHPAT(IL),IHDIR,4,16)
- JR1=IPAWD(JR1+9)
- 30 IF(JR1.EQ.0)GO TO 99
- DO 40 I=1,4
- IF(IHDIR(I).NE.IPAWD(JR1+I+18))THEN
- JR1=IPAWD(JR1+10)
- GO TO 30
- ENDIF
- 40 CONTINUE
- 50 CONTINUE
- ENDIF
-*
- JCDIR = JR1
- JTAB = IPAWD(JCDIR-3)-KOF
-*
- IF(ID.NE.0)THEN
- CALL HRESETM1(IPAWD(9),IPAWD(1),ID,JTAB,KOF)
- ELSE
- NTOT =IPAWD(JTAB+7)
- DO 60 I=1,NTOT
- IF(IPAWD(JTAB-I).EQ.0)GO TO 60
- ID1=IPAWD(JTAB+I+8)
- CALL HRESETM1(IPAWD(9),IPAWD(1),ID1,JTAB,KOF)
- 60 CONTINUE
- ENDIF
-*
- 99 RETURN
- END
diff --git a/src/packlib/hbook/hmmap/hresetm1.F b/src/packlib/hbook/hmmap/hresetm1.F
deleted file mode 100644
index 81c5382..0000000
--- a/src/packlib/hbook/hmmap/hresetm1.F
+++ /dev/null
@@ -1,113 +0,0 @@
-*
-* $Id: hresetm1.F,v 1.1.1.1 1996/01/16 17:08:09 mclareni Exp $
-*
-* $Log: hresetm1.F,v $
-* Revision 1.1.1.1 1996/01/16 17:08:09 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.22/11 17/08/94 12.45.54 by Rene Brun
-*-- Author : Rene Brun 27/07/93
- SUBROUTINE HRESETM1(IB,LB,ID1,JTAB,KOF)
-*.==========>
-*. Auxiliary for HRESETM
-*. Reset histogram ID1 in a global section
-*..=========> ( R.Brun, W.Bruckner)
-#include "hbook/hcbook.inc"
- DIMENSION IB(1),LB(1)
-*.___________________________________________
-#include "hbook/jbyt.inc"
- NH=IB(JTAB-1)
- DO 10 I=1,NH
- IF(IB(JTAB+I).EQ.ID1)GO TO 20
- 10 CONTINUE
- GO TO 99
-*
- 20 CONTINUE
-C ID=ID1
- JCID=LB(JTAB-I)-KOF
- NTOT=IB(JCID+KNTOT)
- I123=JBYT(IB(JCID+KBITS),1,3)
- I230=JBYT(IB(JCID+KBITS),2,2)
- I1 =JBIT(I123,1)
- IF(I123.EQ.0)THEN
- CALL HBUG('Object is not histogram','HRESEM',ID1)
- GO TO 99
- ENDIF
-*
-* Reset contents
-*
-*======> Array
-*
- IF(I123.EQ.0)THEN
- CALL VZERO(IB(JCID+1),IB(JCID-1))
- GO TO 90
- ENDIF
-*
-*======> 1-DIM histogram
-*
- IF(I1.NE.0)THEN
- CALL HREZ0M(IB,LB,LB(JCID-1),KOF)
- GO TO 90
- ENDIF
-*
-*=====> 2-DIM histogram
-*
- IF(I230.NE.0)THEN
- JSCAT=LB(JCID-1)-KOF
- CALL VZERO(IB(JSCAT+KNOENT),IB(JSCAT-1)-1)
-*
-* PROX
-*
- IF(LB(JCID-2).NE.0) THEN
- CALL HREZ0M(IB,LB,LB(JCID-2),KOF)
- ENDIF
-*
-* PROY
-*
- IF(LB(JCID-3).NE.0)THEN
- CALL HREZ0M(IB,LB,LB(JCID-3),KOF)
- ENDIF
-*
-* SLIX
-*
- JSLIX=LB(JCID-4)
- IF(JSLIX.NE.0)THEN
- DO 40 I=1,IB(JSLIX-2-KOF)
- CALL HREZ0M(IB,LB,LB(JSLIX-KOF-I),KOF)
- 40 CONTINUE
- ENDIF
-*
-* SLIY
-*
- JSLIY=LB(JCID-5)
- IF(JSLIY.NE.0)THEN
- DO 50 I=1,IB(JSLIY-KOF-2)
- CALL HREZ0M(IB,LB,LB(JSLIY-KOF-I),KOF)
- 50 CONTINUE
- ENDIF
-*
-* BANX
-*
- JBANX=LB(JCID-6)
- 60 IF(LBANX.NE.0)THEN
- CALL HREZ0M(IB,LB,LB(JBANX-KOF-1),KOF)
- JBANX=LB(JBANX-KOF)
- IF(JBANX.NE.0)GO TO 60
- ENDIF
-*
-* BANY
-*
- JBANY=LB(JCID-7)
- 70 IF(LBANY.NE.0)THEN
- CALL HREZ0M(IB,LB,LB(JBANY-KOF-1),KOF)
- JBANY=LB(JBANY-KOF)
- IF(JBANY.NE.0)GO TO 70
- ENDIF
- ENDIF
-*
- 90 CONTINUE
-*
- 99 RETURN
- END
diff --git a/src/packlib/hbook/hmmap/hrez0m.F b/src/packlib/hbook/hmmap/hrez0m.F
deleted file mode 100644
index 7370bad..0000000
--- a/src/packlib/hbook/hmmap/hrez0m.F
+++ /dev/null
@@ -1,36 +0,0 @@
-*
-* $Id: hrez0m.F,v 1.2 1997/02/25 14:09:18 couet Exp $
-*
-* $Log: hrez0m.F,v $
-* Revision 1.2 1997/02/25 14:09:18 couet
-* - The GRESET command didn't work.
-*
-* Revision 1.1.1.1 1996/01/16 17:08:09 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.22/11 17/08/94 12.45.54 by Rene Brun
-*-- Author : Rene Brun 27/07/93
- SUBROUTINE HREZ0M(IB,LB,JBANK,KOF)
-*.==========>
-*. RESETS TO 0. DATA STRUCTURE POINTED BY JBANK
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
- DIMENSION IB(1),LB(1)
-*.___________________________________________
- JB=JBANK-KOF
- IF(JB.NE.0)THEN
- CALL VZERO(IB(JB+KNOENT),IB(JB-1)-1)
- LW=LB(JB)
- IF(LW.NE.0)THEN
- CALL VZERO(IB(LW+1),IB(LW-1))
- LN=LB(LW)
- IF(LN.NE.0)THEN
- CALL VZERO(IB(LN+1),IB(LN-1))
- ENDIF
- ENDIF
- JFUNC=LB(JB-1)
- IF(JFUNC.NE.0)CALL VZERO(IB(JFUNC+3),IB(JFUNC-1)-2)
- ENDIF
- END
diff --git a/src/packlib/hbook/hmmap/hrzinm.F b/src/packlib/hbook/hmmap/hrzinm.F
deleted file mode 100644
index f46d2e9..0000000
--- a/src/packlib/hbook/hmmap/hrzinm.F
+++ /dev/null
@@ -1,56 +0,0 @@
-*
-* $Id: hrzinm.F,v 1.1.1.1 1996/01/16 17:08:10 mclareni Exp $
-*
-* $Log: hrzinm.F,v $
-* Revision 1.1.1.1 1996/01/16 17:08:10 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.21/06 08/12/93 13.18.27 by Rene Brun
-*-- Author : Rene Brun 06/12/93
- SUBROUTINE HRZINM(IPAWD,IDH,JCID)
-*.==========>
-*. To return pointer JCID for IDH in shared memory IPAWD
-*..=========> ( R.Brun)
-#include "hbook/hcdire.inc"
- DIMENSION IHDIR(4)
- DIMENSION IPAWD(100)
-*.___________________________________________
- NW=IPAWD(1)
- KOF=IPAWD(2)
- ILAST=IPAWD(NW)
- JR1=ILAST-KOF
- JCID=0
-*
-* Search levels down
-*
- IF(NLPAT.GT.1)THEN
- DO 50 IL=2,NLPAT
- CALL UCTOH(CHPAT(IL),IHDIR,4,16)
- JR1=IPAWD(JR1-1)-KOF
- 30 IF(JR1.EQ.0)GO TO 99
- DO 40 I=1,4
- IF(IHDIR(I).NE.IPAWD(JR1+I+8))THEN
- JR1=IPAWD(JR1)-KOF
- GO TO 30
- ENDIF
- 40 CONTINUE
- 50 CONTINUE
- ENDIF
-*
- JCDIR = JR1
- JTAB = IPAWD(JCDIR-3)-KOF
-*
- NTOT =IPAWD(JTAB+7)
- DO 60 I=1,NTOT
- IF(IPAWD(JTAB-I).EQ.0)GO TO 60
- ID1=IPAWD(JTAB+I+8)
- IF(ID1.EQ.IDH)THEN
- JCID=IPAWD(JTAB-I)-KOF
- GO TO 99
- ENDIF
- 60 CONTINUE
-*
- 99 RETURN
- END
diff --git a/src/packlib/hbook/hntup/Imakefile b/src/packlib/hbook/hntup/Imakefile
deleted file mode 100644
index 95a9ec4..0000000
--- a/src/packlib/hbook/hntup/Imakefile
+++ /dev/null
@@ -1,12 +0,0 @@
-SRCS_F= hballoc.F hbnam.F hbnamc.F hbname.F hbnt.F hbset.F hcleft.F \ @@\
- hcompr.F hcpoff.F hfnt.F hfnt1.F hfnt2.F hfntb.F hgnt.F hgnt1.F \ @@\
- hgnt2.F hgntb.F hgntbf.F hgntf.F hgntv.F hgtdir.F hicton.F hitoc.F \ @@\
- hnbent.F hnbfwr.F hnbmin.F hnbptr.F hnbuf.F hnbufd.F hnbuff.F \ @@\
- hnbufr.F hndesc.F hnform.F hnhdwr.F hnmadr.F hnmptr.F hnmset.F \ @@\
- hnpart.F hnsize.F hntdel.F hntdim.F hntdup.F hntget.F hntgeti.F \ @@\
- hntmp.F hntmpd.F hntmpf.F hntnam.F hntnew.F hntrd.F hntrng.F \ @@\
- hntrset.F hntsav.F hnttok.F hntvar.F hntvdef.F hntwrt.F hparnt.F \ @@\
- hprnt.F hprnts.F hreco1.F hreco2.F hrecov.F hrzfra.F hrztoa.F \ @@\
- huwfun.F hvxist.F hwbnam.F hwdecl.F hwpdcl.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/hbook/hntup/hballoc.F b/src/packlib/hbook/hntup/hballoc.F
deleted file mode 100644
index 3c61f97..0000000
--- a/src/packlib/hbook/hntup/hballoc.F
+++ /dev/null
@@ -1,44 +0,0 @@
-*
-* $Id: hballoc.F,v 1.1.1.1 1996/01/16 17:07:56 mclareni Exp $
-*
-* $Log: hballoc.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:56 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.22/09 22/07/94 12.48.52 by Fons Rademakers
-*-- Author : Fons Rademakers 05/10/92
- SUBROUTINE HBALLOC(IDN,CHDIR,VAR,BLOCK,ITYPE,ISIZE,IFIRST,NELEM,
- + IBASE,IOFF,NUSE)
-*.==========>
-*.
-*. Dynamically allocate ISIZE*NELEM bytes for the storage of column
-*. VAR1 in BLOCK1 in Ntuple IDN. The allocated space can be accessed
-*. using IOFF, which is the offset from the base address IBASE.
-*. The first element of allocated space is IBASE(IOFF+1). If IOFF=0
-*. then there was not enough memory to allocate the space. When
-*. NUSE=1 then the buffer has been allocated for the first time and
-*. needs to be filled. If NUSE>1 then the buffer has already been
-*. used before and does not need to be filled again.
-*.
-*..=========> ( A.A.Rademakers )
-*
- CHARACTER*(*) CHDIR, VAR, BLOCK
- INTEGER IDN, ITYPE, ISIZE, NELEM, IBASE(1), IBUF(1)
- INTEGER IOFF, NUSE, IFIRST
-*
- LC = LENOCC(CHDIR)
- LV = LENOCC(VAR)
- LB = LENOCC(BLOCK)
-*
- CALL HBALLO1(IDN, CHDIR, LC, VAR, LV, BLOCK, LB, ITYPE, ISIZE,
- + IFIRST, NELEM, IBUF, NUSE)
-*
- IF (NUSE .EQ. 0) THEN
- IOFF = 0
- ELSE
- IOFF = IBUF(1) - LOCF(IBASE(1))
- ENDIF
-*
- END
diff --git a/src/packlib/hbook/hntup/hbnam.F b/src/packlib/hbook/hntup/hbnam.F
deleted file mode 100644
index 7bb1bc5..0000000
--- a/src/packlib/hbook/hntup/hbnam.F
+++ /dev/null
@@ -1,202 +0,0 @@
-*
-* $Id: hbnam.F,v 1.1.1.1 1996/01/16 17:07:56 mclareni Exp $
-*
-* $Log: hbnam.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:56 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.23/02 10/04/95 14.47.02 by Julian Bunn
-*-- Author : Fons Rademakers 17/12/91
- SUBROUTINE HBNAM(IDD, BLKNA1, ADDRES, FORM1, ISCHAR)
-*.==========>
-*.
-*. Describing the variables to be stored in the new
-*. (variable row length) n-tuple.
-*. For the data-structure description see routine HBNT.
-*.
-*..=========> ( A.A.Rademakers )
-*
-#include "hbook/hcntpar.inc"
-#include "hbook/hcflag.inc"
-#include "hbook/hcbook.inc"
-#include "hbook/hcform.inc"
-*
- INTEGER IDD, ADDRES, HNBPTR
- CHARACTER*(*) BLKNA1, FORM1
- PARAMETER (MAXTOK = 50)
- CHARACTER*8 BLKNAM
- CHARACTER*40 SFORM
- CHARACTER*80 TOK(MAXTOK)
- CHARACTER*1300 FORM
- LOGICAL ISCHAR
-*
-*-- check if ID already in table, if not HBNT should be called first
-*
- IF (IDD .NE. IDLAST) THEN
- ID = IDD
- IDPOS = LOCATI(IQ(LTAB+1),IQ(LCDIR+KNRH),ID)
- IF (IDPOS .LE. 0) THEN
- CALL HBUG('nTuple does not exist.','HBNAME',IDD)
- RETURN
- ENDIF
- IDLAST = ID
- LCID = LQ(LTAB-IDPOS)
- I4 = JBIT(IQ(LCID+KBITS),4)
- IF (I4 .EQ. 0) RETURN
- IF (IQ(LCID-2) .NE. ZLINK) THEN
- CALL HBUG('HBNAME cannot be used for Row-wise nTuples',
- + 'HBNAME',IDD)
- RETURN
- ENDIF
- ENDIF
-*
-*-- check length of BLKNAM
-*
- BLKNAM = BLKNA1
- IF (LENOCC(BLKNA1) .GT. LEN(BLKNAM)) THEN
- PRINT *, '*** Warning: Block name truncated to: ', BLKNAM
- ENDIF
- CALL CLTOU(BLKNAM)
-*
-*-- check length of FORM
-*
- IF (LENOCC(FORM1) .GT. LEN(FORM)) THEN
- CALL HBUG('CHFORM string too long','HBNAME',IDD)
- RETURN
- ENDIF
- FORM = FORM1
-*
- IADD = ADDRES
-*
-*-- set pointers
-*
- LBLOK = LQ(LCID-1)
- LCHAR = LQ(LCID-2)
- LINT = LQ(LCID-3)
- LREAL = LQ(LCID-4)
-*
- SFORM = FORM
- CALL CLTOU(SFORM)
- IF (SFORM(1:6) .EQ. '$CLEAR') THEN
- CALL HNMSET(IDD, ZNADDR, 0)
- CALL SBIT0(IQ(LBLOK),3)
- RETURN
- ELSEIF (SFORM(1:4).EQ.'$SET' .OR. SFORM(1:4).EQ.'!SET') THEN
-*
-*-- !SET: Super dirty trick to tell HBOOK that we access the Ntuple from PAW.
-*-- HBOOK needs to know this to restore character array columns in
-*-- the correct way (i.e. as an array of character*32 variables instead of
-*-- an array of the defined length). All due to an early design error.
-*
- IF (SFORM(1:1) .EQ. '!') CALL SBIT1(IQ(LBLOK),3)
- LBLOK = HNBPTR(BLKNAM)
- IF (LBLOK .EQ. 0) THEN
- CALL HBUG('Unknown block '//BLKNAM,'HBNAME',IDD)
- RETURN
- ENDIF
- LNAME = LQ(LBLOK-1)
-*
- LSF = LENOCC(SFORM)
- I = INDEX(SFORM,':')
- IF (I.GT.0 .AND. LSF.GT.5) THEN
- CALL HNMADR(SFORM(I+1:LSF), IADD, ISCHAR)
- ELSE
- CALL HNMADR('*', IADD, ISCHAR)
- ENDIF
- RETURN
- ENDIF
-*
- LNAME = LQ(LBLOK-1)
-*
- NWID = IQ(LBLOK-1)
- NWN = IQ(LNAME-1)
-*
-*-- find the pointer to the block with BLKNAM
-*-- if the BLKNAM was not found create new block data structure
-*-- (the data structure for the first block has already been created
-*-- in HBNT)
-*
- IF (IQ(LBLOK+ZIBLOK) .NE. 0) THEN
- LBLOK = HNBPTR(BLKNAM)
- IF (LBLOK .EQ. 0) THEN
- NTOT = NWID+NWN+2*33
- CALL HSPACE(NTOT+1000,'HBNAME',IDD)
- IF (IERR .NE. 0) GOTO 99
- IDLAST = IDD
- LLBLK = LQ(LCID-7)
- CALL MZBOOK(IHDIV,LBLOK,LLBLK, 0, 'HBLK',ZLINK,ZLINK-2,
- + NWID,IOBL,0)
- LQ(LCID-7) = LBLOK
-*
- CALL MZBOOK(IHDIV,LNAME,LBLOK,-1,'HNAM',1,0,NWN,2,0)
-*
- IQ(LBLOK+ZIFNAM) = 1
-*
- CALL UCTOH(BLKNAM,IQ(LBLOK+ZIBLOK),4,8)
- IQ(LCID+ZNBLOK) = IQ(LCID+ZNBLOK) + 1
- ELSE
- LNAME = LQ(LBLOK-1)
- ENDIF
- ELSE
- CALL UCTOH(BLKNAM,IQ(LBLOK+ZIBLOK),4,8)
- IQ(LCID+ZNBLOK) = IQ(LCID+ZNBLOK) + 1
- ENDIF
-*
-*-- HBNAME may not be called anymore once filling of a block has started
-*
- IF (IQ(LBLOK+ZNOENT) .NE. 0) THEN
- CALL HBUG('Filling started, cannot extend block definition',
- + 'HBNAME',IDD)
- RETURN
- ENDIF
-*
-*-- parse FORM to find all tokens
-*
- CALL HNTTOK(FORM, TOK, NTOK, MAXTOK, IERR)
- IF (IERR .EQ. 1) THEN
- CALL HBUG('Incomplete format description','HBNAME',IDD)
- RETURN
- ELSEIF (IERR .EQ. 2) THEN
- CALL HBUG('Too many variables in format (>50)',
- + 'HBNAME',IDD)
- RETURN
- ENDIF
-*
-*-- make sure there is at least enough space for NTOK variables in LNAME
-*
- INEED = ZNADDR*NTOK
- IMAX = IQ(LBLOK+ZIFNAM)-1 + INEED
- IF (IMAX .GT. IQ(LNAME-1)) THEN
- CALL MZPUSH(IHDIV, LNAME, 0, INEED, 'I')
- ENDIF
-*
-*-- loop over all tokens and fill the LNAME structure
-*
- DO 10 I = 1, NTOK
- CALL HNTNAM(TOK(I), IADD)
- IF (IERR .EQ. 1) THEN
- PRINT *, 'Format: ', FORM(1:LENOCC(FORM))
- IF (I .EQ. 1) THEN
- CALL HBUG('Error in first token of format description',
- + 'HBNAME', IDD)
- ELSE
- PRINT *, 'Token ', TOK(I-1)(1:LENOCC(TOK(I-1)))
- CALL HBUG('Error after above token in format '//
- + 'description','HBNAME',IDD)
- ENDIF
- RETURN
- ENDIF
-10 CONTINUE
-*
-*-- Ntuple structure has been changed.
-*- Bit 1 is set for any change and bit 2 for a change in the number of columns
-*
- LBLOK = LQ(LCID-1)
- CALL SBIT1(IQ(LBLOK),1)
- CALL SBIT1(IQ(LBLOK),2)
-*
-99 RETURN
-*
- END
diff --git a/src/packlib/hbook/hntup/hbnamc.F b/src/packlib/hbook/hntup/hbnamc.F
deleted file mode 100644
index efc0a72..0000000
--- a/src/packlib/hbook/hntup/hbnamc.F
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: hbnamc.F,v 1.1.1.1 1996/01/16 17:07:56 mclareni Exp $
-*
-* $Log: hbnamc.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:56 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.17/02 18/12/92 15.29.11 by Unknown
-*-- Author : Fons Rademakers 17/12/91
- SUBROUTINE HBNAMC(ID, BLKNAM, ADDRES, FORM)
-*.==========>
-*.
-*. Describing the variables to be stored in the new
-*. (variable row length) n-tuple.
-*. ADDRES must be the address of a character variable.
-*. For the data-structure description see routine HBNT.
-*.
-*..=========> ( A.A.Rademakers )
-*
- INTEGER ID
- CHARACTER*(*) BLKNAM, ADDRES(1), FORM
-*
-#if !defined(CERNLIB_VAX)
- IADD = LOCB(ADDRES(1))
-#endif
-#if defined(CERNLIB_VAX)
- IADD = %LOC(ADDRES(1))
-#endif
-*
- CALL HBNAM(ID, BLKNAM, IADD, FORM, .TRUE.)
-*
- END
diff --git a/src/packlib/hbook/hntup/hbname.F b/src/packlib/hbook/hntup/hbname.F
deleted file mode 100644
index 5fa3a8a..0000000
--- a/src/packlib/hbook/hntup/hbname.F
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: hbname.F,v 1.1.1.1 1996/01/16 17:07:56 mclareni Exp $
-*
-* $Log: hbname.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:56 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.17/00 26/05/92 19.39.53 by Fons Rademakers
-*-- Author : Fons Rademakers 17/12/91
- SUBROUTINE HBNAME(ID, BLKNAM, ADDRES, FORM)
-*.==========>
-*.
-*. Describing the variables to be stored in the new
-*. (variable row length) n-tuple.
-*. ADDRES must be the address of a integer or real variable.
-*. For the data-structure description see routine HBNT.
-*.
-*..=========> ( A.A.Rademakers )
-*
- INTEGER ID, ADDRES(1)
- CHARACTER*(*) BLKNAM, FORM
-*
- IADD = LOCB(ADDRES(1))
-*
- CALL HBNAM(ID, BLKNAM, IADD, FORM, .FALSE.)
-*
- END
diff --git a/src/packlib/hbook/hntup/hbnt.F b/src/packlib/hbook/hntup/hbnt.F
deleted file mode 100644
index 043d063..0000000
--- a/src/packlib/hbook/hntup/hbnt.F
+++ /dev/null
@@ -1,422 +0,0 @@
-*
-* $Id: hbnt.F,v 1.1.1.1 1996/01/16 17:07:56 mclareni Exp $
-*
-* $Log: hbnt.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:56 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.22/14 07/10/94 15.04.56 by Fons Rademakers
-*-- Author : Fons Rademakers 16/12/91
- SUBROUTINE HBNT(IDD, CHTITL, CHOPT1)
-*.==========>
-*. Booking of a new (variable row length) n-tuple
-*.
-*.
-*..=========> ( A.A.Rademakers )
-#if defined(CERNLIB_HNTUPDOC)
-New Ntuple data structure (Fig. A).
-
- |
- | LCID (master is LCDIR-2)
- |
- -6 -5 -4 -3 -2 -1 V
- +-------------------------------------------------------------------+
- | | | | | | | BITS, NDIM, NOENT, etc (see T.A) |-->
- +-------------------------------------------------------------------+
- | | | | | | -7 LLBLK pointer to last block
- ...|.....|....|....|....|....|...............................
- | | | | | | .
- V | | | | V LBLOK V
- struc | | | | +----------------------------+ +------------+
- link | | | | | Ntuple block bank (see F.B)|-->| next block |
- reserved| | | | +----------------------------+ +------------+
- | | | |
- | | | | LCHAR
- V | | | +----------------------------------------------+
- LFUNC | | +--->| char bank pointed at by variable description |
- used | | +----------------------------------------------+
- for | | LINT
- quadric| | +-------------------------------------------------+
- fit | +--->| integer bank pointed at by variable description |
- | +-------------------------------------------------+
- | LREAL
- | +----------------------------------------------+
- +--->| real bank pointed at by variable description |
- +----------------------------------------------+
-
- Total of 12 links, 6 structural and 6 reference links.
- Reference link -8 is used by HFNTB and HGNTB and points to last used LBLOK.
- Reference links -9 to -12 are reserved.
-
-
- Table A
- ************************************************************************
- * word * tag * content *
- ************************************************************************
- * * * *
- * 1 * BITS * Status word (1) *
- * 2 * NDIM * Number of variables in the Ntuple *
- * 3 * NOENT * Total number of entries *
- * 4 * NPRIME * Number of words for primary allocation (2) *
- * 5 * IFCHAR * Pointer to 1st free word in LCHAR *
- * 6 * IFINT * Pointer to 1st free word in LINT *
- * 7 * IFREAL * Pointer to 1st free word in LREAL *
- * 8 * NWTITL * Number of words in the title *
- * 9 * ITIT1 * Internal pointer to the first word of title *
- * 10 * NBLOK * Number of blocks in the Ntuple *
- * 11 * IFTMP * Pointer to 1st free word in LTMP *
- * 12 * ID * Id used to write Ntuple extensions to disk *
- * 13 * NCHRZ * Number of characters in RZ dir *
- * 14 * CHRZ1 * 1st word of RZ directory *
- * 15 * CHRZ2 * 2nd word, etc *
- * * ... * *
- * ITIT1 * TITLE1 * 1st word of title *
- * * ... * *
- ************************************************************************
-
- (1) Status word: bit 4: 1 if Ntuple
- bit 5,6,7: Number of arrays in ONTs
- bit 8: if Character block in ONTs
- (2) If NPRIME < 0 then memory resident Ntuple.
- (*) Bit 1 in status word of first LBLOK is set when the Ntuple header
- has been modified and has to be written to disk.
- (**) Bit 2 in status word of first LBLOK is set when the Ntuple header
- has been extended with new columns and has to be written to disk.
- (***) Bit 3 is set when Ntuple is read back by PAW.
-
-
-
-Ntuple block (column) data structure (Fig B).
-
- |
- |
- | LBLOK
- -6 -5 -4 -3 -2 -1 V
- +-----------------------------------------------------------+
- | | | | | | | BITS, NDIM, etc (see T.B) |-->
- +-----------------------------------------------------------+
- | | | | | |
- | | | | | +----------+
- | | | | | | LNAME
- V V V V V -NDIM...-1 V
- ref link struc link +------------------------------------------------+
- reserved reserved | | | Ntuple variable description (see T.C)|
- +------------------------------------------------+
- NDIM reference links to the corresponding
- contents banks in LBUF
-
-
-
- Table B
- ************************************************************************
- * word * tag * content *
- ************************************************************************
- * * * *
- * 1 * BITS * Status word *
- * 2 * NDIM * Number of variables in the block *
- * 3 * NOENT * Number of entries in block *
- * 4 * IFNAME * Pointer to 1st free word in LNAME *
- * 5 * * Reserved *
- * 6 * * Reserved *
- * 7 * * Reserved *
- * 8 * IBLOK1 * 1 word of block name *
- * 9 * IBLOK2 * 2 word of block name *
- ************************************************************************
-
-
-
- Table C
- ************************************************************************
- * word * tag * content *
- ************************************************************************
- * * * *
- * 1 * DESC * Variable descriptor (see T.D) *
- * 2 * LNAME * Length of variable name *
- * 3 * NAME * Pointer to the variable name in LCHAR *
- * 4 * RANGE * Pointer to the variable range, for a real *
- * * * two reals in LREAL for an (unsigned) integer *
- * * * two integers in LINT *
- * 5 * NRZB * Number of RZ records or memory blocks *
- * 6 * LCONT * Link position of contents bank in LBUF *
- * 7 * IFCONT * Pointer to 1st (partially) free word in the *
- * * * contents bank *
- * 8 * IFBIT * Pointer to 1st free bit in IFCONT *
- * 9 * IBANK * Contents buffer currently in memory *
- * 10 * ITMP * Pointer to tmp storage in LTMP *
- * 11 * ARIND * Pointer to the array indices (as many as the *
- * * * variable has dimensions) in LINT. If the *
- * * * dimension <0 then fixed length dimension, *
- * * * otherwise a pointer to the descriptor of the *
- * * * index variable *
- * 12 * NADDR * Address of first word of variable *
- ************************************************************************
-
-
-
- Table D: Variable descriptor
- +----------------------------------------------------------------+
- | status | | dimension | type | size | packing bits |
- +----------------------------------------------------------------+
- | | | | | | |
- bits 32 28 21 18 14 8 1
-
-
- status bit 1 1 if index variable
- bit 2-5 unused
-
- dimension <=7 number of dimensions if variable is an array
-
- type 1 floating-point variable
- 2 integer variable
- 3 unsigned integer variable
- 4 logical variable
- 5 character variable
-
- size 1-63 size of the variable in bytes (size of
- single element in case of vector)
-
- packing bits <=8*size number of bits in which the variable can be packed
-
-
-
- LBUF buffer management structure. LCDIR-4 is the master pointer.
- LBUF points to the buffer structure of the current Ntuple (Fig. C).
-
- |
- |
- | LBUF
- -NDIM ... ... -3 -2 -1 V
- +-----------------------------------------------------+
- | | | | | | | BITS, NDIM (see T.E) |-->
- +-----------------------------------------------------+
- | | | | | |
- | | | | | |
- | | | | | |
- | V V V | |
- | | | +------------------------+
- | | +-->| Contents of variable 1 |-->(when memory
- | | +------------------------+ resident)
- | |
- | | +------------------------+
- | +--->| Contents of variable 2 |-->
- | +------------------------+
- |
- | +---------------------------+
- +------>| Contents of variable NDIM |-->
- +---------------------------+
-
- ID is in IQ(LBUF-5)
- Bit 1 in the status word of every contents buffer is set when the buffer
- has not yet been written to disk.
-
-
- Table E
- ************************************************************************
- * word * tag * content *
- ************************************************************************
- * * * *
- * 1 * * Reserved *
- * 2 * * Reserved *
- ************************************************************************
-
-
- LCDIR-5 is the master pointer of the temporary workspace used during
- reading of the Ntuple. LTMP points to the tmp buffer of the current
- Ntuple. LQ(LTMP-1) is used by the fast reading routine HGNTF (Fig. D).
-
- |
- |
- | LTMP
- -2 -1 V
- +----------------------------------------------------------------------+
- | | | Temporary data used during filling and reading (see T.F) |-->
- +----------------------------------------------------------------------+
- | |
- | |
- V +-----------+
- ref. link | LTMP1
- to LCID -NDIM...-1 V
- of current +--------------------------------------------------------+
- Ntuple | | | Variable index and offset in LNAME (see T.G) |
- +--------------------------------------------------------+
- NDIM reference links to the corresponding LBLOK banks
-
-
- ID is in IQ(LTMP-5)
-
-
- Table F
- ************************************************************************
- * word * tag * content *
- ************************************************************************
- * * * *
- * 1 * * Last handled event *
- * * * *** For every variable 6 words (ZNTMP) *** *
- * 2 * * Contents bank currently in memory (reading) *
- * 3 * * Pointer to first free word in current bank (r) *
- * 4 * * Pointer to the first free bit in free word (r) *
- * 5 * * Number of bits left in bank (r) *
- * 6 * * When index variable value of previous row (r) *
- * 7 * * When index variable value of current row (r) *
- ************************************************************************
-
-
- Table G
- ************************************************************************
- * word * tag * content *
- ************************************************************************
- * * * *
- * 1 * * Number of variables to be read out *
- * * * *** For every variable 3 words (ZNTMP1) *** *
- * 2 * * Index of variable in LNAME bank *
- * 3 * * Offset of variable in LNAME bank (INDX-1)*ZNADDR*
- * 4 * * Offset in dynamically allocated buffer (only *
- * * * used via HGNTBF) otherwise 0 *
- ************************************************************************
-#endif
-*
-#include "hbook/hcntpar.inc"
-#include "hbook/hcflag.inc"
-#include "hbook/hcbook.inc"
-#include "hbook/hcform.inc"
-#include "hbook/hcset.inc"
-*
- INTEGER IDD
- CHARACTER*(*) CHTITL, CHOPT1
- CHARACTER*80 CHRZ
- CHARACTER*8 CHOPT
-*
- IERR = 0
- IF (IDD.LE.0) THEN
- CALL HBUG('ID<1 is an illegal identifier','HBNT',IDD)
- RETURN
- ENDIF
- IF (IDD.GE.10000) THEN
- CALL HBUG('ID>9999 is an illegal identifier','HBNT',IDD)
- RETURN
- ENDIF
-*
- IF (CHOPT1 .EQ. ' ') THEN
- CHOPT = 'D'
- ELSE
- CHOPT = CHOPT1
- ENDIF
-*
-* Check if ID already in the table
-*
- ID = IDD
- NRHIST = IQ(LCDIR+KNRH)
- IDPOS = LOCATI(IQ(LTAB+1),NRHIST,ID)
- IF (IDPOS.GT.0) THEN
- CALL HBUG('+Already existing N-tuple replaced','HBNT',IDD)
- CALL HDELET(IDD)
- NRHIST = IQ(LCDIR+KNRH)
- IDPOS = -IDPOS+1
- ENDIF
-*
-* Title transform from various accepted formats
-*
- CALL HBTIT(CHTITL,NWTITL,NCHT)
-*
- CALL HCDIR(CHRZ, 'R')
- IF (INDEX(CHOPT,'M') .NE. 0) THEN
- NCHRZ = 0
- ELSE
- NCHRZ = LENOCC(CHRZ)
- ENDIF
- NCHR = 20
- ITIT1 = ZNCHRZ+1+NCHR
-*
- NWPRIM = IBSIZE
-*
- NWID = NWTITL+ITIT1-1
- NWID2 = ZIBLOK+1
- NWH = 128
- NWN = 128
- NTOT = NWID+NWID2+3*NWH+NWN+6*33
-*
-* Enough space left ?
-*
- CALL HSPACE(NTOT+1000,'HBNT',IDD)
- IF (IERR.NE.0) GOTO 99
-*
-* Enter ID in the list of ordered IDs
-*
- IDPOS=-IDPOS+1
- IF (NRHIST.GE.IQ(LTAB-1)) THEN
- CALL MZPUSH(IHDIV,LTAB,500,500,'I')
- ENDIF
- DO 10 I = NRHIST, IDPOS, -1
- IQ(LTAB+I+1) = IQ(LTAB+I)
- LQ(LTAB-I-1) = LQ(LTAB-I)
- 10 CONTINUE
-*
-* Build ntuple data structure
-*
- IF (LIDS.EQ.0) THEN
- CALL MZBOOK(IHDIV,LIDS,LCDIR,-2,'HIDT',ZLINK+6,ZLINK,
- + NWID,IONT,0)
- LCID = LIDS
- ELSE
- LLID = LQ(LCDIR-9)
- CALL MZBOOK(IHDIV,LCID,LLID, 0,'HIDT',ZLINK+6,ZLINK,
- + NWID,IONT,0)
- ENDIF
- LQ(LCDIR-9) = LCID
-*
- CALL MZBOOK(IHDIV,LBLOK,LCID,-1,'HBLK',ZLINK,ZLINK-2,NWID2,IOBL,0)
- CALL MZBOOK(IHDIV,LCHAR,LCID,-2,'HCHA',0,0,NWH,5,0)
- CALL MZBOOK(IHDIV,LINT, LCID,-3,'HINT',0,0,NWH,2,0)
- CALL MZBOOK(IHDIV,LREAL,LCID,-4,'HREA',0,0,NWH,3,0)
- LQ(LCID-7) = LBLOK
-*
- CALL MZBOOK(IHDIV,LNAME,LBLOK,-1,'HNAM',1,0,NWN,2,0)
-*
- IQ(LCID-5) = ID
- IQ(LTAB+IDPOS) = ID
- LQ(LTAB-IDPOS) = LCID
-*
- CALL SBIT1(IQ(LCID+ZBITS),4)
- IQ(LCID+ZNPRIM) = NWPRIM
- IF (INDEX(CHOPT,'M') .NE. 0) THEN
- IQ(LCID+ZNPRIM) = -NWPRIM
- ENDIF
- IQ(LCID+ZIFCHA) = 1
- IQ(LCID+ZIFINT) = 1
- IQ(LCID+ZIFREA) = 1
- IQ(LCID+ZIFTMP) = 2
- IQ(LCID+ZID) = ID
- IQ(LCID+ZNWTIT) = NWTITL
- IQ(LCID+ZITIT1) = ITIT1
- IQ(LCID+ZNCHRZ) = NCHRZ
-*
- IQ(LBLOK+ZIFNAM) = 1
-*
-* Copy RZ path and title
-*
- IF (NCHRZ.NE.0) THEN
- IF (CHRZ(1:6).EQ.'//PAWC') THEN
- IQ(LCID+ZNPRIM) = -NWPRIM
- IQ(LCID+ZNCHRZ) = 0
- CHRZ = ' '
- PRINT *, '*** Warning: N-tuple will be memory resident'
- GOTO 20
- ENDIF
- CALL UCTOH(CHRZ,IQ(LCID+ZNCHRZ+1),4,80)
- ENDIF
- 20 IF (NWTITL.NE.0) THEN
- CALL UCTOH(CHTITL,IQ(LCID+ITIT1),4,NCHT)
- ENDIF
-*
-*-- set bit 1 in LBLOK status word when the N-tuple has changed
-*-- when this bit is set disk resident N-tuple should be updated on disk
-*
- CALL SBIT1(IQ(LBLOK),1)
-*
- NRHIST = NRHIST+1
- IQ(LCDIR+KNRH) = NRHIST
-*
- 99 RETURN
- END
diff --git a/src/packlib/hbook/hntup/hbset.F b/src/packlib/hbook/hntup/hbset.F
deleted file mode 100644
index 8e78a0d..0000000
--- a/src/packlib/hbook/hntup/hbset.F
+++ /dev/null
@@ -1,36 +0,0 @@
-*
-* $Id: hbset.F,v 1.1.1.1 1996/01/16 17:07:57 mclareni Exp $
-*
-* $Log: hbset.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:57 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.21/08 20/12/93 18.16.58 by Fons Rademakers
-*-- Author : Fons Rademakers 02/06/92
- SUBROUTINE HBSET(OPTION, IVAL, IERROR)
-*.==========>
-*. N-tuple option setting
-*.
-*.
-*..=========> ( A.A.Rademakers )
-*
-#include "hbook/hcset.inc"
-*
- CHARACTER*(*) OPTION
- CHARACTER*8 OPT
-*
- IERROR = 0
-*
- OPT = OPTION
- CALL CLTOU(OPT)
-*
- IF (OPT .EQ. 'BSIZE') THEN
- IBSIZE = IVAL
- ELSE
- CALL HBUG('Illegal option','HBSET',0)
- IERROR = 1
- ENDIF
-*
- END
diff --git a/src/packlib/hbook/hntup/hcleft.F b/src/packlib/hbook/hntup/hcleft.F
deleted file mode 100644
index 78f1735..0000000
--- a/src/packlib/hbook/hntup/hcleft.F
+++ /dev/null
@@ -1,61 +0,0 @@
-*
-* $Id: hcleft.F,v 1.3 1997/09/05 09:02:59 couet Exp $
-*
-* $Log: hcleft.F,v $
-* Revision 1.3 1997/09/05 09:02:59 couet
-* - Previous fixe where not enough: the returned string could be equal to '.'
-* which is not a valid number.
-*
-* Revision 1.2 1997/08/20 15:54:47 couet
-* This routine now remove the useless zeros a the end of the floating point
-* numbers. This causes problems in the hntdup routine because the first token of
-* a ntuple variable declaration may be too long and the user may received the
-* following error message:
-*
-* ***** ERROR in HBNAME : Error in token : ID= 4
-*
-* Revision 1.1.1.1 1996/01/16 17:07:57 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.17/00 28/01/92 17.49.21 by Fons Rademakers
-*-- Author : Fons Rademakers 28/01/92
- SUBROUTINE HCLEFT(STR, IBEG, IEND)
-************************************************************************
-* *
-* CLEFT (vsn 1.00) *
-* *
-* 1) Left adjust a character string between IBEG and IEND. *
-* 2) Supress the useless 0 *
-* *
-************************************************************************
-*
- CHARACTER*(*) STR
- CHARACTER*80 ST
- INTEGER IBEG, IEND, I
-*
- ST = STR(IBEG:IEND)
-*
-* Left adjust
-*
- DO 10 I = 1, IEND-IBEG+1
- IF (ST(I:I) .NE. ' ') THEN
- STR(IBEG:IEND) = ST(I:)
- GOTO 20
- ENDIF
- 10 CONTINUE
-*
-* Supress the useless 0
-*
- 20 ILAST = LENOCC(STR)
- 30 IF (STR(ILAST:ILAST).EQ.'0') THEN
- STR(ILAST:ILAST) = ' '
- ILAST = ILAST-1
- GOTO 30
- ENDIF
- IF (STR(1:1).EQ.'.'.AND.LENOCC(STR).EQ.1) THEN
- STR='0.'
- ENDIF
-*
- END
diff --git a/src/packlib/hbook/hntup/hcompr.F b/src/packlib/hbook/hntup/hcompr.F
deleted file mode 100644
index cf223ab..0000000
--- a/src/packlib/hbook/hntup/hcompr.F
+++ /dev/null
@@ -1,48 +0,0 @@
-*
-* $Id: hcompr.F,v 1.1.1.1 1996/01/16 17:07:57 mclareni Exp $
-*
-* $Log: hcompr.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:57 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.17/00 17/12/91 17.49.06 by Fons Rademakers
-*-- Author : Fons Rademakers
- SUBROUTINE HCOMPR(STR,I2)
-************************************************************************
-* *
-* HCOMPR *
-* *
-* Removes all blanks from a string. *
-* *
-* INPUT: *
-* STR (C) Character string with possible blanks *
-* I2 (I) Length of STR *
-* *
-* OUTPUT: *
-* STR (C) Same character string without any blanks *
-* I2 (I) Length of modified STR *
-* *
-************************************************************************
-*
- CHARACTER*(*) STR
-*
- INTEGER I1, I2, I
-*
- I1 = 1
-*
- 10 IF (STR(I1:I1) .EQ. ' ') THEN
- DO 20 I = I1+1, I2
- STR(I-1:I-1) = STR(I:I)
- 20 CONTINUE
- STR(I2:I2) = ' '
- I2 = I2 - 1
- IF (I1 .LT. I2) GOTO 10
- ELSE
- I1 = I1 + 1
- IF (I1 .LT. I2) GOTO 10
- ENDIF
-*
- END
-
diff --git a/src/packlib/hbook/hntup/hcpoff.F b/src/packlib/hbook/hntup/hcpoff.F
deleted file mode 100644
index d8ace2f..0000000
--- a/src/packlib/hbook/hntup/hcpoff.F
+++ /dev/null
@@ -1,88 +0,0 @@
-*
-* $Id: hcpoff.F,v 1.1.1.1 1996/01/16 17:08:00 mclareni Exp $
-*
-* $Log: hcpoff.F,v $
-* Revision 1.1.1.1 1996/01/16 17:08:00 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.22/09 27/07/94 14.26.12 by Fons Rademakers
-*-- Author : Fons Rademakers 22/07/94
- SUBROUTINE HCPOFF(IDD,VAR1,NVAR,IVOFF,IER)
-*.==========>
-*.
-*. Copy in array IVOFF the current offsets in the dynamic
-*. memory buffers.
-*. In case of error IER <> 0.
-*. This routine is used by the chain mechanism in PAW.
-*.
-*..=========> ( A.A.Rademakers )
-*
-#include "hbook/hcntpar.inc"
-#include "hbook/hcbook.inc"
-#include "hbook/hcflag.inc"
-#include "hbook/hntcur.inc"
-*
- CHARACTER*(*) VAR1(*)
- CHARACTER*32 VAR
- INTEGER IVOFF(*), HNMPTR
-*
- IER = 0
-*
- IF (NVAR .EQ. 0) RETURN
-*
-*-- Minimal test for maximum speed. Just set the pointers to the
-*-- buffer and tmp structures. The N-tuple header must already be in memory.
-*-- No reading from disk will be done.
-*
- IF (NTCUR.NE.IDD .OR. NTCUR.EQ.0) THEN
- CALL HNBUFF(IDD, .FALSE.)
- IF (IERR .NE. 0) RETURN
- IF (IQ(LTMP1+1) .EQ. 0) RETURN
- NTCUR = IDD
- ENDIF
-*
- IDLAST = IDD
-*
-*-- basic test
-*
- IF (NVAR .NE. IQ(LTMP1+1)) THEN
- IER = 1
- RETURN
- ENDIF
-*
- LCID = LQ(LTMP-2)
-*
- LBLOK = LQ(LCID-1)
- LCHAR = LQ(LCID-2)
- LINT = LQ(LCID-3)
- LREAL = LQ(LCID-4)
-*
-*-- simulate the loop HGNT1 makes over HGNT2 to get the offsets back in
-*-- the right order
-*
- IVAR = 0
-*
- 10 LNAME = LQ(LBLOK-1)
-*
- DO 20 I = 1, NVAR
-*
- VAR = VAR1(I)
- IOFF = HNMPTR(VAR)
- IF (IOFF .LT. 0) GOTO 20
-*
- IVAR = IVAR + 1
- JTMP = ZNTMP1*(IVAR-1) + 2
- IVOFF(I) = IQ(LTMP1+JTMP+2)
-*
- 20 CONTINUE
-*
- LBLOK = LQ(LBLOK)
- IF (LBLOK .NE. 0) GOTO 10
-*
-*-- another sanity check
-*
- IF (IVAR .NE. NVAR) IER = 2
-*
- END
diff --git a/src/packlib/hbook/hntup/hfnt.F b/src/packlib/hbook/hntup/hfnt.F
deleted file mode 100644
index ff1d7ec..0000000
--- a/src/packlib/hbook/hntup/hfnt.F
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: hfnt.F,v 1.1.1.1 1996/01/16 17:07:57 mclareni Exp $
-*
-* $Log: hfnt.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:57 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.17/00 27/02/92 21.23.06 by Fons Rademakers
-*-- Author : Fons Rademakers 06/01/92
- SUBROUTINE HFNT(IDD)
-*.==========>
-*.
-*. Filling of a new (variable row length) n-tuple.
-*. For the data-structure description see routine HBNT.
-*.
-*. This routine calls HFNT1. HFNT1 checks the IDD and scans over all
-*. blocks calling for each block HFNT2. HFNT2 does the actual filling.
-*.
-*..=========> ( A.A.Rademakers )
-*
- CALL HFNT1(IDD, '*')
-*
- END
diff --git a/src/packlib/hbook/hntup/hfnt1.F b/src/packlib/hbook/hntup/hfnt1.F
deleted file mode 100644
index b327021..0000000
--- a/src/packlib/hbook/hntup/hfnt1.F
+++ /dev/null
@@ -1,150 +0,0 @@
-*
-* $Id: hfnt1.F,v 1.1.1.1 1996/01/16 17:07:57 mclareni Exp $
-*
-* $Log: hfnt1.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:57 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 05/09/95 16.22.10 by Julian Bunn
-*-- Author : Fons Rademakers 06/01/92
- SUBROUTINE HFNT1(IDD, BLKNA1)
-*.==========>
-*.
-*. Filling of a new (variable row length) n-tuple.
-*. For the data-structure description see routine HBNT.
-*.
-*. This routine loops over all blocks when BLKNA1 = '*', otherwise
-*. it only fills block BLKNA1.
-*.
-*..=========> ( A.A.Rademakers )
-*
-#include "hbook/hcntpar.inc"
-#include "hbook/hcflag.inc"
-#include "hbook/hcbook.inc"
-#include "hbook/hntcur.inc"
-#include "hbook/hcsave.inc"
-C
- COMMON /QUEST/ IQUEST(100)
-*
- CHARACTER*(*) BLKNA1
- CHARACTER*8 BLKNAM, BLKSAV
- INTEGER HNBPTR, HNBMIN
- LOGICAL ALLBLK
-*
- SAVE BLKSAV
- DATA BLKSAV /' '/
-*
- IQUEST(1) = 0
- IERR = 0
- NTCUR = 0
- NTSAVE = .FALSE.
-*
- IF (IDD .NE. IDLAST) THEN
- ID = IDD
- IDPOS = LOCATI(IQ(LTAB+1),IQ(LCDIR+KNRH),ID)
- IF (IDPOS .LE. 0) THEN
- CALL HBUG('N-tuple does not exist, create it with HBNT',
- + 'HFNT',IDD)
- RETURN
- ENDIF
- LCID = LQ(LTAB-IDPOS)
- I4 = JBIT(IQ(LCID+KBITS),4)
- IF (I4 .EQ. 0) RETURN
- IF (IQ(LCID-2) .NE. ZLINK) THEN
- CALL HBUG('Old N-tuple, fill it with HFN',
- + 'HFNT',IDD)
- RETURN
- ENDIF
- IDLAST = ID
- BLKSAV = ' '
- ENDIF
-*
-*-- create or update buffer manager structure
-*
- CALL HNBUF(IDD)
- IF (IERR .NE. 0) GOTO 99
-*
- BLKNAM = BLKNA1
- ALLBLK = .FALSE.
-*
-*-- fill all blocks or only block BLKNAM
-*--
-*-- to optimize the filling of one block store a pointer to
-*-- this block in reference link -8
-*
- IF (BLKNAM(1:1) .EQ. '*') THEN
- ALLBLK = .TRUE.
- LBLOK = LQ(LCID-1)
-*** IF (IQ(LCID+ZNOENT) .NE. HNBMIN()) THEN
-*** CALL HBUG('Not all blocks contain the'//
-*** + 'same number of events, use HFNTB','HFNT',IDD)
-*** RETURN
-*** ENDIF
- ELSEIF (BLKSAV .NE. BLKNAM) THEN
- LBLOK = HNBPTR(BLKNAM)
- IF (LBLOK .EQ. 0) THEN
- CALL HBUG('Block does not exist','HFNTB',IDD)
- RETURN
- ENDIF
- BLKSAV = BLKNAM
- LQ(LCID-8) = LBLOK
- ELSE
- LBLOK = LQ(LCID-8)
- ENDIF
-*
- LCHAR = LQ(LCID-2)
- LINT = LQ(LCID-3)
- LREAL = LQ(LCID-4)
-*
- IF (ALLBLK) THEN
- 40 CALL HFNT2
-c
-c The following needs un-commenting when it is understood how
-c the rzcdir in HNTWRT causes iquest(1) non-zero in ostensibly
-c valid cases ...
-c IF(IQUEST(1).NE.0) THEN
-c CALL HBUG('An error has occured whilst filling nT Blocks',
-c & 'HFNT1',IDD)
-c GOTO 99
-c ENDIF
- LBLOK = LQ(LBLOK)
- IF (LBLOK .NE. 0) GOTO 40
- IQ(LCID+ZNOENT) = IQ(LCID+ZNOENT) + 1
- ELSE
- CALL HFNT2
- IF(IQUEST(1).NE.0) THEN
- CALL HBUG('An error has occured whilst filling an nT Block',
- & 'HFNT1',IDD)
- GOTO 99
- ENDIF
-*
-*-- set global event counter equal to the lowest block event counter
-*--
-*-- check for lowest block event counter only when current block event
-*-- counter is one larger than the global event counter
-*
- IF (IQ(LBLOK+ZNOENT) .LE. IQ(LCID+ZNOENT)+1) THEN
- IQ(LCID+ZNOENT) = HNBMIN()
- ENDIF
-* Instead of above we could make this test
-*
-*-- set global event counter equal to the lowest block event counter
-*-- but never decrease the global event counter
-*
-*** IM = HNBMIN()
-*** IF (IM .GT. IQ(LCID+ZNOENT)) IQ(LCID+ZNOENT) = IM
- ENDIF
-*
-*-- flush RZ file
-*
- IF (NTSAVE) CALL HNTSAV
-*
-*-- N-tuple structure has been changed
-*
- LBLOK = LQ(LCID-1)
- CALL SBIT1(IQ(LBLOK),1)
-*
-99 RETURN
- END
diff --git a/src/packlib/hbook/hntup/hfnt2.F b/src/packlib/hbook/hntup/hfnt2.F
deleted file mode 100644
index 2c711f2..0000000
--- a/src/packlib/hbook/hntup/hfnt2.F
+++ /dev/null
@@ -1,430 +0,0 @@
-*
-* $Id: hfnt2.F,v 1.8 1999/03/23 14:34:23 couet Exp $
-*
-* $Log: hfnt2.F,v $
-* Revision 1.8 1999/03/23 14:34:23 couet
-* - With some CWNs containing REAL*8, an error message saying that
-* the number was invalid (NaN) was displayed. This was a side
-* effect of the word swapping problem fixed previously.
-*
-* Revision 1.7 1999/03/05 15:42:32 couet
-* - Bug fixed to handle properly the word swapping of REAL*8 machines on little
-* endian machines
-*
-* Revision 1.6 1998/12/02 09:05:30 couet
-* - clean up
-*
-* Revision 1.5 1998/09/25 09:28:34 mclareni
-* Modifications for the Mklinux port flagged by CERNLIB_PPC
-*
-* Revision 1.4 1998/03/20 09:43:59 couet
-* - When filling a CWNtuple and using a 24bit packing of a real, for each entry
-* equal to the maximum value XMAX the value actually stored into the CWN is
-* XMIN. This only seems to happen with 24 to 30 bit packing. This error occured
-* with the CERNLIB 98 and 96a on hpux and irix (at least).
-*
-* Revision 1.3 1997/07/07 09:34:43 couet
-* - Error message changed in case of NaN filling to make it more clear.
-*
-* Revision 1.2 1996/07/11 15:44:14 couet
-* - Bug fix from: Rainer Bartoldus <bartoldu at opalr6.physik.uni-bonn.de>
-*
-* The problem occurred with a job that reads in a list of CW ntuples,
-* corrects some entries and writes out a list of new ntuples.
-*
-* After we observed problems with the output files, we discovered that
-* even without any correction the output was different from the input.
-*
-* The symptom affected only signed integer variables. It looked as if
-* their sign had been written randomly.
-*
-* However, this happened only after a certain number of input files
-* depending on the size of the PAWC common block (The larger the common
-* was the later the files were corrupted).
-*
-* Revision 1.1.1.1 1996/01/16 17:07:57 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 07/08/95 13.11.08 by Julian Bunn
-*-- Author : Fons Rademakers 06/01/92
- SUBROUTINE HFNT2
-*.==========>
-*.
-*. Filling of a new (variable row length) n-tuple.
-*. For the data-structure description see routine HBNT.
-*.
-*. This routine does the actual filling of the variables in block LBLOK.
-*.
-*. The first word of every physical record is, for the time being, only
-*. used for the storage of intermadiate results of index variables.
-*.
-*..=========> ( A.A.Rademakers )
-*
-#include "hbook/hcntpar.inc"
-#include "hbook/hcnt.inc"
-#include "hbook/hcflag.inc"
-#include "hbook/hcbook.inc"
-*
-
- CHARACTER*80 MSG
-
- INTEGER ILOGIC
- LOGICAL LOGIC, INDVAR, RANGE
- CHARACTER*32 NAME
- CHARACTER*96 MESS
- EQUIVALENCE (LOGIC, ILOGIC)
-*-* FMIN,FMAX must be saved on HP (compiler bug)
- SAVE FMIN, FMAX
-*
-#include "hbook/jbyt.inc"
-*
- LNAME = LQ(LBLOK-1)
-*
- NDIM = IQ(LBLOK+ZNDIM)
-*
-*-- when this routine is called for the first time for a specific block
-*-- create a reference link area in the LNAME bank that will contain
-*-- pointers to the corresponding contents banks in the LBUF structure
-*
- IF (IQ(LBLOK+ZNOENT).EQ.0 .AND. IQ(LNAME-3).EQ.1) THEN
- CALL MZPUSH(IHDIV, LNAME, NDIM, 0, ' ')
- ENDIF
-*
- IQ(LBLOK+ZNOENT) = IQ(LBLOK+ZNOENT) + 1
-*
- IOFF = 0
-*
- DO 50 I = 1, NDIM
- NSUB = JBYT(IQ(LNAME+IOFF+ZDESC), 18, 3)
- ITYPE = JBYT(IQ(LNAME+IOFF+ZDESC), 14, 4)
- ISIZE = JBYT(IQ(LNAME+IOFF+ZDESC), 8, 6)
- NBITS = JBYT(IQ(LNAME+IOFF+ZDESC), 1, 7)
-*
- INDVAR = .FALSE.
- IF (JBIT(IQ(LNAME+IOFF+ZDESC),28) .EQ. 1) INDVAR = .TRUE.
-*
- IF (IQ(LNAME+IOFF+ZNADDR) .EQ. 0) GOTO 40
-*
-*-- fix the NBITS for character variables (7 bits was not enough)
-*
- IF (ITYPE .EQ. 5) NBITS = IBIPB*ISIZE
-*
-*-- when a range has been specified enable range checking
-*
- RANGE = .FALSE.
- LRAN = IQ(LNAME+IOFF+ZRANGE)
- IF (LRAN .NE. 0) THEN
- RANGE = .TRUE.
- IF (ITYPE .EQ. 1) THEN
- FMIN = Q(LREAL+LRAN)
- FMAX = Q(LREAL+LRAN+1)
- ELSEIF (ITYPE.EQ.2 .OR. ITYPE.EQ.3) THEN
- IMIN = IQ(LINT+LRAN)
- IMAX = IQ(LINT+LRAN+1)
- ELSE
- CALL HBUG('Type can not have range specification',
- + 'HFNT',ID)
- GOTO 40
- ENDIF
- ENDIF
-*
- LCIND = IQ(LNAME+IOFF+ZLCONT)
- IF (LQ(LNAME-I) .EQ. 0) THEN
- LQ(LNAME-I) = LQ(LBUF-LCIND)
- ENDIF
-*
-*-- make sure that LQ(LNAME-I) points to the right (i.e. last) bank
-*-- when filling resumes (after, e.g., a call to HGNT)
-*
- IF (IQ(LNAME+IOFF+ZIBANK) .NE. IQ(LNAME+IOFF+ZNRZB)) THEN
- CALL HNTRD(I, IOFF, IQ(LNAME+IOFF+ZNRZB), IER)
- IF (IER .NE. 0) THEN
- CALL HBUG('Error resuming filling','HFNT',ID)
- GOTO 40
- ENDIF
- ENDIF
-*
- LR2 = LQ(LNAME-I)
- IFIRST = IQ(LNAME+IOFF+ZIFCON)
- NB = IQ(LNAME+IOFF+ZIFBIT) - 1
-*
- LRECL = IQ(LR2-1) - 1
- NLEFT = LRECL - IFIRST + 2
- NLEFT = NLEFT*IBIPW - NB
-*
- IELEM = 1
- DO 10 J = 1, NSUB
- LP = IQ(LINT+IQ(LNAME+IOFF+ZARIND)+(J-1))
- IF (LP .LT. 0) THEN
- IE = -LP
- ELSE
- IF (IQ(LNAME+LP-1+ZNADDR) .EQ. 0) THEN
- CALL HBUG('Address of index variable not set',
- + 'HFNT',ID)
- GOTO 40
- ENDIF
- IE = IQ(IQ(LNAME+LP-1+ZNADDR)+1)
- ENDIF
- IELEM = IELEM*IE
- 10 CONTINUE
-*
- DO 30 J = 1, IELEM
-*
-*-- if next item does not fit in the left over bits start with new word
-*
-*** IM = MOD(NB, IBIPW)
- IM = IAND(NB, IBIPW-1)
- IF (IM.NE.0 .AND. NBITS.GT.IBIPW-IM) THEN
- NB = 0
- NLEFT = NLEFT - IBIPW+IM
- IFIRST = IFIRST + 1
- ENDIF
-*
-*-- if next item does not fit in current buffer, write buffer
-*
- IF (NBITS .GT. NLEFT) THEN
- IF (INDVAR) ISAVE = IQ(LR2+LRECL+1)
- CALL HNTWRT(I, IOFF, IER)
- IF (IER .NE. 0) GOTO 60
- IF (INDVAR) IQ(LR2+1) = ISAVE
- CALL SBIT1(IQ(LQ(LBUF-LCIND)),1)
- NB = 0
- NLEFT = LRECL*IBIPW
- IFIRST = 2
- ENDIF
-*
-*-- store REAL
-*
- IF (ITYPE .EQ. 1) THEN
- IF (ISIZE .EQ. 4) THEN
- IF (RANGE) THEN
- QVAL = Q(IQ(LNAME+IOFF+ZNADDR)+J)
-
-#if defined(CERNLIB_SUN)||defined(CERNLIB_SOLARIS)||defined(CERNLIB_SGI)||defined(CERNLIB_DECS)||defined(CERNLIB_ALPHA)||defined(CERNLIB_HPUX)||defined(CERNLIB_IBMRT)
-* test the floating point
- JX=IFPS(QVAL)
- IF(JX .EQ. 0) THEN
- WRITE(MSG,'(A,I10,A,I10)')
- + 'HFNT bad float in column:',IOFF/ZNADDR,' line:',J
- CALL HFPBUG(QVAL,MSG,ID)
- ENDIF
-*
-#endif
-
- IF (QVAL .LT. FMIN .OR. QVAL .GT. FMAX) THEN
- LL = IQ(LNAME+IOFF+ZLNAME)
- LV = IQ(LNAME+IOFF+ZNAME)
- CALL UHTOC(IQ(LCHAR+LV), 4, NAME, LL)
- WRITE(MESS,1000) NAME(1:LL), IQ(LBLOK+ZNOENT),
- + QVAL
- CALL HBUG(MESS,'HFNT',ID)
- ENDIF
- IF (QVAL .LT. FMIN) QVAL = FMIN
- IF (QVAL .GT. FMAX) QVAL = FMAX
- ENDIF
- IF (NBITS .EQ. 32) THEN
-#if defined(CERNLIB_NO_IEEE)
- CALL IE3FOS(Q(IQ(LNAME+IOFF+ZNADDR)+J),
- + Q(LR2+IFIRST),1,K)
-#endif
-#if !defined(CERNLIB_NO_IEEE)
- Q(LR2+IFIRST) = Q(IQ(LNAME+IOFF+ZNADDR)+J)
-
-* test the floating point
- JX=IFPS(Q(LR2+IFIRST))
- IF(JX .EQ. 0) THEN
- WRITE(MSG,'(A,I10,A,I10)')
- + 'HFNT bad float in column:',IOFF/ZNADDR,' line:',J
- CALL HFPBUG(Q(LR2+IFIRST),MSG,ID)
- ENDIF
-*
-#endif
-
- ELSE
- IBITF = ISHFT(1,NBITS)-1
- IF (QVAL.EQ.FMAX) THEN
- IPACK = IBITF
- ELSE
- IPACK = (QVAL-FMIN)/(FMAX-FMIN)*IBITF+0.5
- ENDIF
- CALL SBYT(IPACK, IQ(LR2+IFIRST), NB+1, NBITS)
- ENDIF
- ELSEIF (ISIZE .EQ. 8) THEN
- IF (NBITS .EQ. 64) THEN
-#if defined(CERNLIB_NO_IEEE)
- CALL IE3FOD(Q(IQ(LNAME+IOFF+ZNADDR)+2*J-1),
- + Q(LR2+IFIRST),1,K)
-#endif
-#if !defined(CERNLIB_NO_IEEE)
-#if defined(CERNLIB_VAX)||defined(CERNLIB_DECS)||(defined(CERNLIB_LINUX) && !defined(CERNLIB_PPC))||defined(CERNLIB_WINNT)
- Q(LR2+IFIRST) = Q(IQ(LNAME+IOFF+ZNADDR)+2*J)
- Q(LR2+IFIRST+1) = Q(IQ(LNAME+IOFF+ZNADDR)+2*J-1)
- JX=IFPD(Q(LR2+IFIRST+1))
-#else
- Q(LR2+IFIRST) = Q(IQ(LNAME+IOFF+ZNADDR)+2*J-1)
- Q(LR2+IFIRST+1) = Q(IQ(LNAME+IOFF+ZNADDR)+2*J)
- JX=IFPD(Q(LR2+IFIRST))
-#endif
-
-* test the floating point
- IF(JX .EQ. 0) THEN
- WRITE(MSG,'(A,I10,A,I10)')
- + 'HFNT bad float in column:',IOFF/ZNADDR,' line:',2*J-1
- CALL HFPBUG(Q(LR2+IFIRST),'HFNT',ID)
- ENDIF
-#endif
-
- ELSE
-*-- no double precision packed reals yet
- ENDIF
- ENDIF
-*
-*-- store INTEGER
-*
- ELSEIF (ITYPE .EQ. 2) THEN
- IF (ISIZE .EQ. 2) THEN
-
- ELSEIF (ISIZE .EQ. 4) THEN
- IF (.NOT.RANGE .AND. NBITS.NE.32) THEN
-*** IMAX = 2**(NBITS-1) - 1
- IMAX = ISHFT(1,NBITS-1) - 1
- IMIN = -IMAX
- RANGE = .TRUE.
- ENDIF
- IF (RANGE) THEN
- IVAL = IQ(IQ(LNAME+IOFF+ZNADDR)+J)
- IF (IVAL .LT. IMIN .OR. IVAL .GT. IMAX) THEN
- LL = IQ(LNAME+IOFF+ZLNAME)
- LV = IQ(LNAME+IOFF+ZNAME)
- CALL UHTOC(IQ(LCHAR+LV), 4, NAME, LL)
- WRITE(MESS,1010) NAME(1:LL), IQ(LBLOK+ZNOENT),
- + IVAL
- CALL HBUG(MESS,'HFNT',ID)
- ENDIF
- IF (IVAL .LT. IMIN) IVAL = IMIN
- IF (IVAL .GT. IMAX) IVAL = IMAX
- ENDIF
- IF (INDVAR) THEN
- IQ(LR2+IFIRST) = IQ(LR2+IFIRST-1) +
- + IQ(IQ(LNAME+IOFF+ZNADDR)+J)
- ELSEIF (NBITS .EQ. 32) THEN
- IQ(LR2+IFIRST) = IQ(IQ(LNAME+IOFF+ZNADDR)+J)
- ELSE
- IF (IVAL .LT. 0) THEN
- CALL SBIT1(IQ(LR2+IFIRST), NB+NBITS)
- CALL SBYT(-IVAL, IQ(LR2+IFIRST), NB+1, NBITS-1)
- ELSE
-*
-* Mods from Rainer Bartoldus
-* The previous version was:
-* CALL SBYT(IVAL, IQ(LR2+IFIRST), NB+1, NBITS-1)
-*
- CALL SBYT(IVAL, IQ(LR2+IFIRST), NB+1, NBITS)
-*
- ENDIF
- ENDIF
- ELSEIF (ISIZE .EQ. 8) THEN
- IF (NBITS .EQ. 64) THEN
- IQ(LR2+IFIRST) =IQ(IQ(LNAME+IOFF+ZNADDR)+2*J-1)
- IQ(LR2+IFIRST+1)=IQ(IQ(LNAME+IOFF+ZNADDR)+2*J)
- ELSE
-*-- no double precision packed integers yet
- ENDIF
- ENDIF
-*
-*-- store UNSIGNED INTEGER
-*
- ELSEIF (ITYPE .EQ. 3) THEN
- IF (ISIZE .EQ. 2) THEN
-
- ELSEIF (ISIZE .EQ. 4) THEN
- IF (.NOT.RANGE .AND. NBITS.NE.32) THEN
-*** IMAX = 2**(NBITS) - 1
- IMAX = ISHFT(1,NBITS) - 1
- IMIN = 0
- RANGE = .TRUE.
- ENDIF
- IF (RANGE) THEN
- IVAL = IQ(IQ(LNAME+IOFF+ZNADDR)+J)
- IF (IVAL .LT. IMIN .OR. IVAL .GT. IMAX) THEN
- LL = IQ(LNAME+IOFF+ZLNAME)
- LV = IQ(LNAME+IOFF+ZNAME)
- CALL UHTOC(IQ(LCHAR+LV), 4, NAME, LL)
- WRITE(MESS,1010) NAME(1:LL), IQ(LBLOK+ZNOENT),
- + IVAL
- CALL HBUG(MESS,'HFNT',ID)
- ENDIF
- IF (IVAL .LT. IMIN) IVAL = IMIN
- IF (IVAL .GT. IMAX) IVAL = IMAX
- ENDIF
- IF (NBITS .EQ. 32) THEN
- IQ(LR2+IFIRST) = IQ(IQ(LNAME+IOFF+ZNADDR)+J)
- ELSE
- CALL SBYT(IVAL, IQ(LR2+IFIRST), NB+1, NBITS)
- ENDIF
- ELSEIF (ISIZE .EQ. 8) THEN
- IF (NBITS .EQ. 64) THEN
- IQ(LR2+IFIRST) =IQ(IQ(LNAME+IOFF+ZNADDR)+2*J-1)
- IQ(LR2+IFIRST+1)=IQ(IQ(LNAME+IOFF+ZNADDR)+2*J)
- ELSE
-*-- no double precision packed unsigned integers yet
- ENDIF
- ENDIF
-*
-*-- store LOGICAL
-*
- ELSEIF (ITYPE .EQ. 4) THEN
- IF (ISIZE .EQ. 1) THEN
-
- ELSEIF (ISIZE .EQ. 2) THEN
-
- ELSEIF (ISIZE .EQ. 4) THEN
- ILOGIC = IQ(IQ(LNAME+IOFF+ZNADDR)+J)
- IF (LOGIC) THEN
- CALL SBYT(1, IQ(LR2+IFIRST), NB+1, NBITS)
- ELSE
- CALL SBYT(0, IQ(LR2+IFIRST), NB+1, NBITS)
- ENDIF
- ENDIF
-*
-*-- store CHARACTER string
-*
- ELSEIF (ITYPE .EQ. 5) THEN
- MXBY = ISHFT(ISIZE,-2)
- DO 20 K = 1, MXBY
- IQ(LR2+IFIRST+K-1) =
- + IQ(IQ(LNAME+IOFF+ZNADDR)+MXBY*(J-1)+K)
- 20 CONTINUE
-#if defined(CERNLIB_IBM)||defined(CERNLIB_VAX)||defined(CERNLIB_DECS)||defined(CERNLIB_MSDOS)||(defined(CERNLIB_LINUX) && !defined(CERNLIB_PPC))||defined(CERNLIB_WINNT)
- CALL HRZTOA(IQ(LR2+IFIRST),MXBY)
-#endif
- ENDIF
-*
- NB = NB + NBITS
- IF (ISHBIT .NE. 0) THEN
- IFIRST = IFIRST + ISHFT(NB,-ISHBIT)
- ELSE
- IFIRST = IFIRST + NB/IBIPW
- ENDIF
-*** NB = MOD(NB, IBIPW)
- NB = IAND(NB, IBIPW-1)
- NLEFT = NLEFT - NBITS
- IF (J .EQ. 1) CALL SBIT1(IQ(LQ(LBUF-LCIND)),1)
- 30 CONTINUE
-*
-*-- update pointers
-*
- IQ(LNAME+IOFF+ZIFCON) = IFIRST
- IQ(LNAME+IOFF+ZIFBIT) = NB + 1
-*
- 40 IOFF = IOFF + ZNADDR
- 50 CONTINUE
-*
- 60 RETURN
-*
-1000 FORMAT(A,': Value out of range, event ',I10,' value ',G14.7)
-1010 FORMAT(A,': Value out of range, event ',I10,' value ',I11)
-*
- END
diff --git a/src/packlib/hbook/hntup/hfntb.F b/src/packlib/hbook/hntup/hfntb.F
deleted file mode 100644
index 323bf25..0000000
--- a/src/packlib/hbook/hntup/hfntb.F
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: hfntb.F,v 1.1.1.1 1996/01/16 17:07:57 mclareni Exp $
-*
-* $Log: hfntb.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:57 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.17/00 27/02/92 21.25.32 by Fons Rademakers
-*-- Author : Fons Rademakers 06/01/92
- SUBROUTINE HFNTB(IDD, BLKNAM)
-*.==========>
-*.
-*. Filling of a new (variable row length) n-tuple.
-*. For the data-structure description see routine HBNT.
-*.
-*. This routine calls HFNT1. HFNT1 checks the IDD and finds block BLKNAM
-*. and calls HFNT2. HFNT2 does the actual filling.
-*.
-*..=========> ( A.A.Rademakers )
-*
- CHARACTER*(*) BLKNAM
-*
- CALL HFNT1(IDD, BLKNAM)
-*
- END
diff --git a/src/packlib/hbook/hntup/hgnt.F b/src/packlib/hbook/hntup/hgnt.F
deleted file mode 100644
index badbf82..0000000
--- a/src/packlib/hbook/hntup/hgnt.F
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: hgnt.F,v 1.1.1.1 1996/01/16 17:07:57 mclareni Exp $
-*
-* $Log: hgnt.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:57 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.22/09 21/07/94 16.12.17 by Fons Rademakers
-*-- Author : Fons Rademakers 29/01/92
- SUBROUTINE HGNT(IDN,IDNEVT,IERROR)
-*.==========>
-*.
-*. Return in the preset addresses (set by HBNAME)
-*. the variables of event (row) IDNEVT.
-*.
-*. This routine calls HGNT1. HGNT1 checks the IDD and scans over all
-*. blocks, calling for each block HGNT2. HGNT2 does the actual retrieval.
-*.
-*..=========> ( A.A.Rademakers )
-*
- CALL HGNT1(IDN, '*', '*', 0, 0, IDNEVT, IERROR)
-*
- END
diff --git a/src/packlib/hbook/hntup/hgnt1.F b/src/packlib/hbook/hntup/hgnt1.F
deleted file mode 100644
index 619f74f..0000000
--- a/src/packlib/hbook/hntup/hgnt1.F
+++ /dev/null
@@ -1,114 +0,0 @@
-*
-* $Id: hgnt1.F,v 1.1.1.1 1996/01/16 17:07:57 mclareni Exp $
-*
-* $Log: hgnt1.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:57 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.22/09 21/07/94 16.18.13 by Fons Rademakers
-*-- Author : Fons Rademakers 29/01/92
- SUBROUTINE HGNT1(IDD,BLKNA1,VAR,IOFFST,NVAR,IDNEVT,IERROR)
-*.==========>
-*.
-*. Return in the preset addresses (set by HBNAME)
-*. the variables of event (row) IDNEVT.
-*.
-*. This routine loops over all blocks when BLKNA1 = '*', otherwise
-*. it only retrieves data from block BLKNA1.
-*.
-*..=========> ( A.A.Rademakers )
-*
-#include "hbook/hcntpar.inc"
-#include "hbook/hcflag.inc"
-#include "hbook/hcbook.inc"
-#include "hbook/hntcur.inc"
-*
- CHARACTER*(*) BLKNA1, VAR(*)
- CHARACTER*8 BLKNAM, BLKSAV
- INTEGER HNBPTR, IOFFST(*)
- LOGICAL ALLBLK
-*
- SAVE BLKSAV
- DATA BLKSAV /' '/
-*
- IERR = 0
- IERR1 = 0
- IERROR = 0
- IF (IDD.NE.IDLAST .OR. NTCUR.EQ.0) THEN
-*
-*-- find in memory or read from disk N-tuple IDD
-*
- CALL HPARNT(IDD,'HGNT')
- IF (IDD .EQ. 0) GOTO 20
- IDLAST = IDD
- BLKSAV = ' '
- ENDIF
- IF (LCID .LE. 0) GOTO 20
-*
-*-- create or find buffer manager structure for IDD
-*
- CALL HNBUFR(IDD)
- IF (IERR .NE. 0) GOTO 20
-*
- NTCUR = IDD
-*
- IF (IDNEVT .LE. 0) GOTO 20
-*
- BLKNAM = BLKNA1
- ALLBLK = .FALSE.
-*
-*-- read all blocks or only block BLKNAM
-*--
-*-- to optimize the reading of one block store a pointer to
-*-- this block in reference link -8
-*
- IF (BLKNAM(1:1) .EQ. '*') THEN
- ALLBLK = .TRUE.
- LBLOK = LQ(LCID-1)
- IF (IDNEVT .GT. IQ(LCID+ZNOENT)) GOTO 20
- ELSEIF (BLKSAV .NE. BLKNAM) THEN
- LBLOK = HNBPTR(BLKNAM)
- IF (LBLOK .EQ. 0) THEN
- CALL HBUG('Block does not exist','HGNTB',IDD)
- GOTO 20
- ENDIF
- BLKSAV = BLKNAM
- LQ(LCID-8) = LBLOK
- IF (IDNEVT .GT. IQ(LBLOK+ZNOENT)) GOTO 20
- ELSE
- LBLOK = LQ(LCID-8)
- IF (IDNEVT .GT. IQ(LBLOK+ZNOENT)) GOTO 20
- ENDIF
-*
- LCHAR = LQ(LCID-2)
- LINT = LQ(LCID-3)
- LREAL = LQ(LCID-4)
-*
- IQ(LTMP1+1) = 0
-*
- IF (ALLBLK) THEN
- 10 CALL HGNT2(VAR, IOFFST, NVAR, IDNEVT, IERROR)
- IF (IERROR .NE. 0) IERR1 = 1
- LBLOK = LQ(LBLOK)
- IF (LBLOK .NE. 0) GOTO 10
- ELSE
- CALL HGNT2(VAR, IOFFST, NVAR, IDNEVT, IERROR)
- IF (IERROR .NE. 0) IERR1 = 1
- ENDIF
-*
- IF (IERR1 .EQ. 0) THEN
- IQ(LTMP+1) = IDNEVT
- ELSE
- IQ(LTMP+1) = 0
- IERROR = 2
- ENDIF
-*
- RETURN
-*
-*-- error
-*
- 20 IERROR = 1
-*
- END
diff --git a/src/packlib/hbook/hntup/hgnt2.F b/src/packlib/hbook/hntup/hgnt2.F
deleted file mode 100644
index d460865..0000000
--- a/src/packlib/hbook/hntup/hgnt2.F
+++ /dev/null
@@ -1,472 +0,0 @@
-*
-* $Id: hgnt2.F,v 1.3 1999/03/05 15:42:35 couet Exp $
-*
-* $Log: hgnt2.F,v $
-* Revision 1.3 1999/03/05 15:42:35 couet
-* - Bug fixed to handle properly the word swapping of REAL*8 machines on little
-* endian machines
-*
-* Revision 1.2 1998/09/25 09:28:38 mclareni
-* Modifications for the Mklinux port flagged by CERNLIB_PPC
-*
-* Revision 1.1.1.1 1996/01/16 17:07:57 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.22/14 06/10/94 23.19.37 by Fons Rademakers
-*-- Author : Fons Rademakers 29/01/92
- SUBROUTINE HGNT2(VAR1,IVOFF,NVAR1,IDNEVT,IERROR)
-*.==========>
-*.
-*. Return in the preset addresses (set by HBNAME) or
-*. in IQ(IVOFF(n)+1) (if NVAR<0) the values of the variables in
-*. the current block for the event (row) IDNEVT.
-*.
-*. This routine does the actual reading of the variables in block LBLOK.
-*.
-*..=========> ( A.A.Rademakers )
-*
-#include "hbook/hcntpar.inc"
-#include "hbook/hcnt.inc"
-#include "hbook/hcbook.inc"
-#include "hbook/hcflag.inc"
-#include "hbook/hcrecv.inc"
-*
- CHARACTER*(*) VAR1(*)
- INTEGER IVOFF(*)
- CHARACTER*32 VAR
- INTEGER ILOGIC, HNMPTR
- LOGICAL LOGIC, INDVAR, ALLVAR, USEBUF, CHKOFF
- EQUIVALENCE (LOGIC, ILOGIC)
-*
-#include "hbook/jbyt.inc"
-*
- IERROR = 0
- IERR1 = 0
-*
- LNAME = LQ(LBLOK-1)
-*
- CHKOFF = .FALSE.
- USEBUF = .FALSE.
- NVAR = NVAR1
- IF (NVAR .LT. 0) THEN
- NVAR = -NVAR
- CHKOFF = .TRUE.
- ENDIF
-*
-*-- read all variables in the block or only variables in VAR
-*
- IF (NVAR .EQ. 0) THEN
- ALLVAR = .TRUE.
- IOFF = 0
- NDIM = IQ(LBLOK+ZNDIM)
- ELSE
- ALLVAR = .FALSE.
- NDIM = NVAR
- ENDIF
-*
- DO 40 I = 1, NDIM
- IF (.NOT.ALLVAR) THEN
- VAR = VAR1(I)
- IOFF = HNMPTR(VAR)
- IF (IOFF .LT. 0) GOTO 40
- INDX = IOFF/ZNADDR + 1
- IF (CHKOFF) THEN
- IF (IVOFF(I) .NE. 0) THEN
- USEBUF = .TRUE.
- IOFFST = IVOFF(I)
- ELSE
- USEBUF = .FALSE.
- IOFFST = 0
- ENDIF
- ENDIF
- ELSE
- INDX = I
- ENDIF
-*
- NSUB = JBYT(IQ(LNAME+IOFF+ZDESC), 18, 3)
- ITYPE = JBYT(IQ(LNAME+IOFF+ZDESC), 14, 4)
- ISIZE = JBYT(IQ(LNAME+IOFF+ZDESC), 8, 6)
- NBITS = JBYT(IQ(LNAME+IOFF+ZDESC), 1, 7)
-*
- INDVAR = .FALSE.
- IF (JBIT(IQ(LNAME+IOFF+ZDESC),28) .EQ. 1) INDVAR = .TRUE.
-*
- IF (.NOT.NRECOV .AND. IQ(LNAME+IOFF+ZNADDR).EQ.0) GOTO 35
-*
-*-- fix the NBITS for character variables (7 bits was not enough)
-*
- IF (ITYPE .EQ. 5) THEN
- NBITS = IBIPB*ISIZE
-*
-*-- in case called from PAW destination is character*32 array and not the
-*-- natural size (design mistake, but to late to make clean fix)
-*
- MXBY = ISHFT(ISIZE,-2)
- MXBY1 = MXBY
- IF (JBIT(IQ(LQ(LCID-1)),3) .NE. 0) MXBY1 = 8
- ENDIF
-*
- IF (IQ(LNAME+IOFF+ZITMP) .EQ. 0) THEN
- IQ(LNAME+IOFF+ZITMP) = IQ(LCID+ZIFTMP)
- IQ(LCID+ZIFTMP) = IQ(LCID+ZIFTMP) + ZNTMP
- ENDIF
- ITMP = IQ(LNAME+IOFF+ZITMP)
-*
- IEDIF = 0
- IELEM = 1
- NELEM = 1
- INEVT = IDNEVT
- DO 10 J = 1, NSUB
- LP = IQ(LINT+IQ(LNAME+IOFF+ZARIND)+(J-1))
- IF (LP .LT. 0) THEN
- IELEM = IELEM*(-LP)
- NELEM = IELEM
- ELSE
-*
-*-- for variable length arrays calculate the start address using the
-*-- sum of the index variable which is stored in IQ(LTMP+IPTMP+4).
-*-- The start address of the N'th event of an M element array is
-*-- found by looking for the NxM'th event of a 1 element array
-*
- IF (IQ(LNAME+LP-1+ZNADDR) .EQ. 0) THEN
- CALL HBUG('Address of index variable not set',
- + 'HGNT',ID)
- GOTO 35
- ENDIF
- LL = IQ(LNAME+LP-1+ZRANGE)
- IEMAX = IELEM*IQ(LINT+LL+1)
-*
- IPTMP = IQ(LNAME+LP-1+ZITMP)
- INEVT = (IQ(LTMP+IPTMP+4) * IELEM) + 1
- IELEM = IELEM*IQ(LTMP+IPTMP+5)
- NELEM = 1
-*
- IEDIF = IEMAX - IELEM
- ENDIF
- 10 CONTINUE
-*
-*-- load bank containing the event
-*
- LCIND = IQ(LNAME+IOFF+ZLCONT)
- LRECL = IABS(IQ(LCID+ZNPRIM)) - 1
-*
- IF (IQ(LTMP+1).NE.0 .AND. IDNEVT.EQ.IQ(LTMP+1)+1) THEN
- IBANK = IQ(LTMP+ITMP)
- IFIRST = IQ(LTMP+ITMP+1)
- NB = IQ(LTMP+ITMP+2)
- NLEFT = IQ(LTMP+ITMP+3)
- ELSE
-*
-*-- NW is number of full words occupied by one data item
-*-- IPW is data Items Per Word
-*-- NWRD is the Number of WoRDs occupied by IDNEVT events
-*-- IBANK is the bank in which IDNEVT is stored
-*-- IFIRST is the word offset in IBANK for the first word of IDNEVT
-*-- NB is the bit offset in IFIRST for the first word of IDNEVT
-*
- IB = NBITS
- NW = 1
- IF (ISIZE .GT. IBYPW) THEN
- NW = ISIZE/IBYPW
- IB = NBITS/NW
- ENDIF
- IPW = IBIPW/IB
- NWRD = (INEVT-1)*NELEM*NW/IPW
- IBANK = NWRD/LRECL + 1
- IFIRST = MOD(NWRD+2, LRECL)
- IF (IFIRST .EQ. 0) IFIRST = LRECL
- IF (IFIRST .EQ. 1) IFIRST = LRECL + 1
- NB = (INEVT-1)*NELEM*NW*IB - NWRD*IB*IPW
-*
- NLEFT = LRECL - IFIRST + 2
- NLEFT = NLEFT*IBIPW - NB
-*
- ENDIF
-*
-*-- let LR2 point to the correct contents bank in the buffer structure
-*
- IF (IELEM .GT. 0) THEN
- IF (IQ(LNAME+IOFF+ZIBANK) .EQ. IBANK) THEN
- LR2 = LQ(LNAME-INDX)
- ELSE
- CALL HNTRD(INDX, IOFF, IBANK, IER)
- IF (IER .NE. 0) THEN
- IERR1 = 1
- GOTO 32
- ENDIF
- ENDIF
- ENDIF
-*
- DO 30 J = 1, IELEM
-*** IM = MOD(NB, IBIPW)
- IM = IAND(NB, IBIPW-1)
- IF (IM.NE.0 .AND. NBITS.GT.IBIPW-IM) THEN
- NB = 0
- NLEFT = NLEFT - IBIPW+IM
- IFIRST = IFIRST + 1
- ENDIF
-*
-*-- if next item is not in current bank load next bank
-*
- IF (NBITS .GT. NLEFT) THEN
- IBANK = IBANK + 1
- CALL HNTRD(INDX, IOFF, IBANK, IER)
- IF (IER .NE. 0) THEN
- IERR1 = 1
- GOTO 32
- ENDIF
- NB = 0
- NLEFT = LRECL*IBIPW
- IFIRST = 2
- ENDIF
-*
- IF (NRECOV .AND. .NOT.INDVAR) GOTO 25
-*
-*-- Restoring REALs
-*
- IF (ITYPE .EQ. 1) THEN
- IF (ISIZE .EQ. 4) THEN
- IF (NBITS .EQ. 32) THEN
- IF (USEBUF) THEN
-#if defined(CERNLIB_NO_IEEE)
- CALL IE3TOS(Q(LR2+IFIRST),Q(IOFFST+1),1,K)
-#endif
-#if !defined(CERNLIB_NO_IEEE)
- Q(IOFFST+1) = Q(LR2+IFIRST)
-#endif
- ELSE
-#if defined(CERNLIB_NO_IEEE)
- CALL IE3TOS(Q(LR2+IFIRST),
- + Q(IQ(LNAME+IOFF+ZNADDR)+J),1,K)
-#endif
-#if !defined(CERNLIB_NO_IEEE)
- Q(IQ(LNAME+IOFF+ZNADDR)+J) = Q(LR2+IFIRST)
-#endif
- ENDIF
- ELSE
- RMIN = Q(LREAL+IQ(LNAME+IOFF+ZRANGE))
- RMAX = Q(LREAL+IQ(LNAME+IOFF+ZRANGE)+1)
- IPACK = JBYT(IQ(LR2+IFIRST), NB+1, NBITS)
- IF (USEBUF) THEN
- Q(IOFFST+1) = IPACK *
-*** + (RMAX - RMIN)/(2**NBITS - 1) + RMIN
- + (RMAX - RMIN)/(ISHFT(1,NBITS)-1) + RMIN
- ELSE
- Q(IQ(LNAME+IOFF+ZNADDR)+J) = IPACK *
-*** + (RMAX - RMIN)/(2**NBITS - 1) + RMIN
- + (RMAX - RMIN)/(ISHFT(1,NBITS)-1) + RMIN
- ENDIF
- ENDIF
- ELSEIF (ISIZE .EQ. 8) THEN
- IF (NBITS .EQ. 64) THEN
- IF (USEBUF) THEN
-#if defined(CERNLIB_NO_IEEE)
- CALL IE3TOD(Q(LR2+IFIRST),Q(IOFFST+1),1,K)
-#endif
-#if !defined(CERNLIB_NO_IEEE)
-#if defined(CERNLIB_VAX)||defined(CERNLIB_DECS)||(defined(CERNLIB_LINUX) && !defined(CERNLIB_PPC))||defined(CERNLIB_WINNT)
- Q(IOFFST+1) = Q(LR2+IFIRST+1)
- Q(IOFFST+2) = Q(LR2+IFIRST)
-#else
- Q(IOFFST+1) = Q(LR2+IFIRST)
- Q(IOFFST+2) = Q(LR2+IFIRST+1)
-#endif
-#endif
- ELSE
-#if defined(CERNLIB_NO_IEEE)
- CALL IE3TOD(Q(LR2+IFIRST),
- + Q(IQ(LNAME+IOFF+ZNADDR)+2*J-1),1,K)
-#endif
-#if !defined(CERNLIB_NO_IEEE)
-#if defined(CERNLIB_VAX)||defined(CERNLIB_DECS)||(defined(CERNLIB_LINUX) && !defined(CERNLIB_PPC))||defined(CERNLIB_WINNT)
- Q(IQ(LNAME+IOFF+ZNADDR)+2*J-1) = Q(LR2+IFIRST+1)
- Q(IQ(LNAME+IOFF+ZNADDR)+2*J) = Q(LR2+IFIRST)
-#else
- Q(IQ(LNAME+IOFF+ZNADDR)+2*J-1) = Q(LR2+IFIRST)
- Q(IQ(LNAME+IOFF+ZNADDR)+2*J) = Q(LR2+IFIRST+1)
-#endif
-#endif
- ENDIF
- ELSE
-*-- no double precision packed reals yet
- ENDIF
- ENDIF
-*
-*-- Restoring INTEGERs
-*
- ELSEIF (ITYPE .EQ. 2) THEN
- IF (ISIZE .EQ. 2) THEN
-
- ELSEIF (ISIZE .EQ. 4) THEN
- IF (INDVAR) THEN
- IF (USEBUF) THEN
- IQ(IOFFST+1) = IQ(LR2+IFIRST) -
- + IQ(LR2+IFIRST-1)
- IQ(LTMP+ITMP+5) = IQ(IOFFST+1)
- ELSE
- IQ(IQ(LNAME+IOFF+ZNADDR)+J) = IQ(LR2+IFIRST) -
- + IQ(LR2+IFIRST-1)
- IQ(LTMP+ITMP+5) = IQ(IQ(LNAME+IOFF+ZNADDR)+J)
- ENDIF
- IQ(LTMP+ITMP+4) = IQ(LR2+IFIRST-1)
- ELSEIF (NBITS .EQ. 32) THEN
- IF (USEBUF) THEN
- IQ(IOFFST+1) = IQ(LR2+IFIRST)
- ELSE
- IQ(IQ(LNAME+IOFF+ZNADDR)+J) = IQ(LR2+IFIRST)
- ENDIF
- ELSE
- IF (JBIT(IQ(LR2+IFIRST), NB+NBITS) .EQ. 1) THEN
- IF (USEBUF) THEN
- IQ(IOFFST+1) =
- + -JBYT(IQ(LR2+IFIRST), NB+1, NBITS-1)
- ELSE
- IQ(IQ(LNAME+IOFF+ZNADDR)+J) =
- + -JBYT(IQ(LR2+IFIRST), NB+1, NBITS-1)
- ENDIF
- ELSE
- IF (USEBUF) THEN
- IQ(IOFFST+1) =
- + JBYT(IQ(LR2+IFIRST), NB+1, NBITS-1)
- ELSE
- IQ(IQ(LNAME+IOFF+ZNADDR)+J) =
- + JBYT(IQ(LR2+IFIRST), NB+1, NBITS-1)
- ENDIF
- ENDIF
- ENDIF
- ELSEIF (ISIZE .EQ. 8) THEN
- IF (NBITS .EQ. 64) THEN
- IF (USEBUF) THEN
- IQ(IOFFST+1) = IQ(LR2+IFIRST)
- IQ(IOFFST+2) = IQ(LR2+IFIRST+1)
- ELSE
- IQ(IQ(LNAME+IOFF+ZNADDR)+2*J-1)=IQ(LR2+IFIRST)
- IQ(IQ(LNAME+IOFF+ZNADDR)+2*J)=IQ(LR2+IFIRST+1)
- ENDIF
- ELSE
-*-- no double precision packed integers yet
- ENDIF
- ENDIF
-*
-*-- Restoring UNSIGNED INTEGERs
-*
- ELSEIF (ITYPE .EQ. 3) THEN
- IF (ISIZE .EQ. 2) THEN
-
- ELSEIF (ISIZE .EQ. 4) THEN
- IF (NBITS .EQ. 32) THEN
- IF (USEBUF) THEN
- IQ(IOFFST+1) = IQ(LR2+IFIRST)
- ELSE
- IQ(IQ(LNAME+IOFF+ZNADDR)+J) = IQ(LR2+IFIRST)
- ENDIF
- ELSE
- IF (USEBUF) THEN
- IQ(IOFFST+1) =
- + JBYT(IQ(LR2+IFIRST), NB+1, NBITS)
- ELSE
- IQ(IQ(LNAME+IOFF+ZNADDR)+J) =
- + JBYT(IQ(LR2+IFIRST), NB+1, NBITS)
- ENDIF
- ENDIF
- ELSEIF (ISIZE .EQ. 8) THEN
- IF (NBITS .EQ. 64) THEN
- IF (USEBUF) THEN
- IQ(IOFFST+1)=IQ(LR2+IFIRST)
- IQ(IOFFST+2)=IQ(LR2+IFIRST+1)
- ELSE
- IQ(IQ(LNAME+IOFF+ZNADDR)+2*J-1)=IQ(LR2+IFIRST)
- IQ(IQ(LNAME+IOFF+ZNADDR)+2*J)=IQ(LR2+IFIRST+1)
- ENDIF
- ELSE
-*-- no double precision packed unsigned integers yet
- ENDIF
- ENDIF
-*
-*-- Restoring LOGICALs
-*
- ELSEIF (ITYPE .EQ. 4) THEN
- IF (ISIZE .EQ. 1) THEN
-
- ELSEIF (ISIZE .EQ. 2) THEN
-
- ELSEIF (ISIZE .EQ. 4) THEN
- ILOGI = JBYT(IQ(LR2+IFIRST), NB+1, NBITS)
- IF (ILOGI .EQ. 1) THEN
- LOGIC = .TRUE.
- ELSE
- LOGIC = .FALSE.
- ENDIF
- IF (USEBUF) THEN
- IQ(IOFFST+1) = ILOGIC
- ELSE
- IQ(IQ(LNAME+IOFF+ZNADDR)+J) = ILOGIC
- ENDIF
- ENDIF
-*
-*-- Restoring CHARACTERs
-*
- ELSEIF (ITYPE .EQ. 5) THEN
-#if defined(CERNLIB_IBM)||defined(CERNLIB_VAX)||defined(CERNLIB_DECS)||defined(CERNLIB_MSDOS)||(defined(CERNLIB_LINUX) && !defined(CERNLIB_PPC))||defined(CERNLIB_WINNT)
- IF (USEBUF) THEN
- CALL HRZFRA(IQ(LR2+IFIRST),IQ(IOFFST+1),MXBY)
- ELSE
- CALL HRZFRA(IQ(LR2+IFIRST),
- + IQ(IQ(LNAME+IOFF+ZNADDR)+MXBY1*(J-1)+1),
- + MXBY)
- ENDIF
-#endif
-#if (!defined(CERNLIB_IBM))&&(!defined(CERNLIB_VAX))&&(!defined(CERNLIB_DECS))&&(!defined(CERNLIB_MSDOS))&&(!(defined(CERNLIB_LINUX) && !defined(CERNLIB_PPC)))&&(!defined(CERNLIB_WINNT))
- DO 20 K = 1, MXBY
- IF (USEBUF) THEN
- IQ(IOFFST+K) = IQ(LR2+IFIRST+K-1)
- ELSE
- IQ(IQ(LNAME+IOFF+ZNADDR)+MXBY1*(J-1)+K) =
- + IQ(LR2+IFIRST+K-1)
- ENDIF
- 20 CONTINUE
-#endif
- ENDIF
-*
- 25 NB = NB + NBITS
- IF (ISHBIT .NE. 0) THEN
- IFIRST = IFIRST + ISHFT(NB,-ISHBIT)
- ELSE
- IFIRST = IFIRST + NB/IBIPW
- ENDIF
- NB = IAND(NB, IBIPW-1)
- NLEFT = NLEFT - NBITS
- IF (USEBUF) IOFFST = IOFFST + ISHFT(ISIZE,-2)
- 30 CONTINUE
-*
- IQ(LTMP+ITMP) = IBANK
- IQ(LTMP+ITMP+1) = IFIRST
- IQ(LTMP+ITMP+2) = NB
- IQ(LTMP+ITMP+3) = NLEFT
-*
- 32 IQ(LTMP1+1) = IQ(LTMP1+1) + 1
- JTMP = ZNTMP1*(IQ(LTMP1+1)-1) + 2
- IQ(LTMP1+JTMP) = INDX
- IQ(LTMP1+JTMP+1) = IOFF
- IF (USEBUF) THEN
- IF (IEDIF .EQ. 0) THEN
- IQ(LTMP1+JTMP+2) = IOFFST
- ELSE
- IQ(LTMP1+JTMP+2) = IOFFST + (IEDIF*ISHFT(ISIZE,-2))
- ENDIF
- ELSE
- IQ(LTMP1+JTMP+2) = 0
- ENDIF
- LQ(LTMP1-IQ(LTMP1+1)) = LBLOK
-*
- 35 IOFF = IOFF + ZNADDR
-*
- 40 CONTINUE
-*
- IF (IERR1 .NE. 0) THEN
- IERROR = 1
- ENDIF
-*
- END
diff --git a/src/packlib/hbook/hntup/hgntb.F b/src/packlib/hbook/hntup/hgntb.F
deleted file mode 100644
index da63751..0000000
--- a/src/packlib/hbook/hntup/hgntb.F
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: hgntb.F,v 1.1.1.1 1996/01/16 17:07:57 mclareni Exp $
-*
-* $Log: hgntb.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:57 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.22/09 21/07/94 16.13.43 by Fons Rademakers
-*-- Author : Fons Rademakers 29/01/92
- SUBROUTINE HGNTB(IDN,BLKNAM,IDNEVT,IERROR)
-*.==========>
-*.
-*. Return in the preset addresses (set by HBNAME)
-*. the variables of block BLKNAM of event (row) IDNEVT.
-*.
-*. This routine calls HGNT1. HGNT1 checks the IDD and scans over all
-*. blocks, calling for each block HGNT2. HGNT2 does the actual retrieval.
-*.
-*..=========> ( A.A.Rademakers )
-*
- CHARACTER*(*) BLKNAM
-*
- CALL HGNT1(IDN, BLKNAM, '*', 0, 0, IDNEVT, IERROR)
-*
- END
diff --git a/src/packlib/hbook/hntup/hgntbf.F b/src/packlib/hbook/hntup/hgntbf.F
deleted file mode 100644
index 50a61b9..0000000
--- a/src/packlib/hbook/hntup/hgntbf.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: hgntbf.F,v 1.1.1.1 1996/01/16 17:07:57 mclareni Exp $
-*
-* $Log: hgntbf.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:57 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.22/09 21/07/94 16.19.59 by Fons Rademakers
-*-- Author : Fons Rademakers 29/01/92
- SUBROUTINE HGNTBF(IDN,VAR,IOFFST,NVAR,IDNEVT,IERROR)
-*.==========>
-*.
-*. Return in the preset addresses (set by HBNAME) or
-*. in the dynamically allocated buffers accessible
-*. via offsets iq(ioffst(i)+idnevt) the variable
-*. VAR(NVAR) of event IDNEVT.
-*.
-*..=========> ( A.A.Rademakers )
-*
- CHARACTER*(*) VAR(*)
- INTEGER IOFFST(*)
-*
- NVAR1 = -NVAR
- CALL HGNT1(IDN, '*', VAR, IOFFST, NVAR1, IDNEVT, IERROR)
-*
- END
diff --git a/src/packlib/hbook/hntup/hgntf.F b/src/packlib/hbook/hntup/hgntf.F
deleted file mode 100644
index 465b857..0000000
--- a/src/packlib/hbook/hntup/hgntf.F
+++ /dev/null
@@ -1,464 +0,0 @@
-*
-* $Id: hgntf.F,v 1.3 1999/03/05 15:42:35 couet Exp $
-*
-* $Log: hgntf.F,v $
-* Revision 1.3 1999/03/05 15:42:35 couet
-* - Bug fixed to handle properly the word swapping of REAL*8 machines on little
-* endian machines
-*
-* Revision 1.2 1998/09/25 09:28:40 mclareni
-* Modifications for the Mklinux port flagged by CERNLIB_PPC
-*
-* Revision 1.1.1.1 1996/01/16 17:07:57 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.22/14 06/10/94 23.19.37 by Fons Rademakers
-*-- Author : Fons Rademakers 29/01/92
- SUBROUTINE HGNTF(IDD,IDNEVT,IERROR)
-*.==========>
-*.
-*. Return in the preset addresses (set by HBNAME)
-*. the values of the variables as used in the last call
-*. to HGNT, HGNTB, or HGNTV for the event (row) IDNEVT.
-*.
-*. This routine does the actual reading of the variables in LTMP1.
-*.
-*..=========> ( A.A.Rademakers )
-*
-#include "hbook/hcntpar.inc"
-#include "hbook/hcnt.inc"
-#include "hbook/hcbook.inc"
-#include "hbook/hcflag.inc"
-#include "hbook/hntcur.inc"
-#include "hbook/hcrecv.inc"
-*
- INTEGER ILOGIC
- LOGICAL LOGIC, INDVAR, USEBUF
- EQUIVALENCE (LOGIC, ILOGIC)
-*
-#include "hbook/jbyt.inc"
-*
- IERROR = 0
-*
-*-- Minimal test for maximum speed. Just set the pointers to the
-*-- buffer and tmp structures. The N-tuple header must already be in memory.
-*-- No reading from disk will be done.
-*
- IF (NTCUR.NE.IDD .OR. NTCUR.EQ.0) THEN
- CALL HNBUFF(IDD, .TRUE.)
- IF (IERR .NE. 0) THEN
- CALL HBUG('Cannot find Ntuple buffer structure',
- + 'HGNTF',IDD)
- GOTO 50
- ENDIF
- IF (IQ(LTMP1+1) .EQ. 0) THEN
- CALL HBUG('No variables selected for reading',
- + 'HGNTF',IDD)
- GOTO 50
- ENDIF
- NTCUR = IDD
- ENDIF
-*
- IDLAST = IDD
-*
- LCID = LQ(LTMP-2)
-*
- LINT = LQ(LCID-3)
- LREAL = LQ(LCID-4)
-*
- NVAR = IQ(LTMP1+1)
-*
- DO 40 I = 1, NVAR
-*
- JTMP = ZNTMP1*(I-1) + 2
- INDX = IQ(LTMP1+JTMP)
- IOFF = IQ(LTMP1+JTMP+1)
- IOFFST = IQ(LTMP1+JTMP+2)
- IF (IOFFST .EQ. 0) THEN
- USEBUF = .FALSE.
- ELSE
- USEBUF = .TRUE.
- ENDIF
- LBLOK = LQ(LTMP1-I)
- LNAME = LQ(LBLOK-1)
-*
- NSUB = JBYT(IQ(LNAME+IOFF+ZDESC), 18, 3)
- ITYPE = JBYT(IQ(LNAME+IOFF+ZDESC), 14, 4)
- ISIZE = JBYT(IQ(LNAME+IOFF+ZDESC), 8, 6)
- NBITS = JBYT(IQ(LNAME+IOFF+ZDESC), 1, 7)
-*
- INDVAR = .FALSE.
- IF (JBIT(IQ(LNAME+IOFF+ZDESC),28) .EQ. 1) INDVAR = .TRUE.
-*
- IF (.NOT.NRECOV .AND. IQ(LNAME+IOFF+ZNADDR).EQ.0) GOTO 40
-*
-*-- fix the NBITS for character variables (7 bits was not enough)
-*
- IF (ITYPE .EQ. 5) THEN
- NBITS = IBIPB*ISIZE
-*
-*-- in case called from PAW destination is character*32 array and not the
-*-- natural size (design mistake, but to late to make clean fix)
-*
- MXBY = ISHFT(ISIZE,-2)
- MXBY1 = MXBY
- IF (JBIT(IQ(LQ(LCID-1)),3) .NE. 0) MXBY1 = 8
- ENDIF
-*
- IF (IQ(LNAME+IOFF+ZITMP) .EQ. 0) THEN
- IQ(LNAME+IOFF+ZITMP) = IQ(LCID+ZIFTMP)
- IQ(LCID+ZIFTMP) = IQ(LCID+ZIFTMP) + ZNTMP
- ENDIF
- ITMP = IQ(LNAME+IOFF+ZITMP)
-*
- IEDIF = 0
- IELEM = 1
- NELEM = 1
- INEVT = IDNEVT
- DO 10 J = 1, NSUB
- LP = IQ(LINT+IQ(LNAME+IOFF+ZARIND)+(J-1))
- IF (LP .LT. 0) THEN
- IELEM = IELEM*(-LP)
- NELEM = IELEM
- ELSE
-*
-*-- for variable length arrays calculate the start address using the
-*-- sum of the index variable which is stored in IQ(LTMP+IPTMP+4).
-*-- The start address of the N'th event of an M element array is
-*-- found by looking for the NxM'th event of a 1 element array
-*
- IF (IQ(LNAME+LP-1+ZNADDR) .EQ. 0) THEN
- CALL HBUG('Address of index variable not set',
- + 'HGNT',ID)
- GOTO 40
- ENDIF
- LL = IQ(LNAME+LP-1+ZRANGE)
- IEMAX = IELEM*IQ(LINT+LL+1)
-*
- IPTMP = IQ(LNAME+LP-1+ZITMP)
- INEVT = (IQ(LTMP+IPTMP+4) * IELEM) + 1
- IELEM = IELEM*IQ(LTMP+IPTMP+5)
- NELEM = 1
-*
- IEDIF = IEMAX - IELEM
- ENDIF
- 10 CONTINUE
-*
-*-- load bank containing the event
-*
- LCIND = IQ(LNAME+IOFF+ZLCONT)
- LRECL = IABS(IQ(LCID+ZNPRIM)) - 1
-*
- IF (IQ(LTMP+1).NE.0 .AND. IDNEVT.EQ.IQ(LTMP+1)+1) THEN
- IBANK = IQ(LTMP+ITMP)
- IFIRST = IQ(LTMP+ITMP+1)
- NB = IQ(LTMP+ITMP+2)
- NLEFT = IQ(LTMP+ITMP+3)
- ELSE
-*
-*-- NW is number of full words occupied by one data item
-*-- IPW is data Items Per Word
-*-- NWRD is the Number of WoRDs occupied by IDNEVT events
-*-- IBANK is the bank in which IDNEVT is stored
-*-- IFIRST is the word offset in IBANK for the first word of IDNEVT
-*-- NB is the bit offset in IFIRST for the first word of IDNEVT
-*
- IB = NBITS
- NW = 1
- IF (ISIZE .GT. IBYPW) THEN
- NW = ISIZE/IBYPW
- IB = NBITS/NW
- ENDIF
- IPW = IBIPW/IB
- NWRD = (INEVT-1)*NELEM*NW/IPW
- IBANK = NWRD/LRECL + 1
- IFIRST = MOD(NWRD+2, LRECL)
- IF (IFIRST .EQ. 0) IFIRST = LRECL
- IF (IFIRST .EQ. 1) IFIRST = LRECL + 1
- NB = (INEVT-1)*NELEM*NW*IB - NWRD*IB*IPW
-*
- NLEFT = LRECL - IFIRST + 2
- NLEFT = NLEFT*IBIPW - NB
-*
- ENDIF
-*
-*-- let LR2 point to the correct contents bank in the buffer structure
-*
- IF (IELEM .GT. 0) THEN
- IF (IQ(LNAME+IOFF+ZIBANK) .EQ. IBANK) THEN
- LR2 = LQ(LNAME-INDX)
- ELSE
- CALL HNTRD(INDX, IOFF, IBANK, IER)
- IF (IER .NE. 0) GOTO 50
- ENDIF
- ENDIF
-*
- DO 30 J = 1, IELEM
-*** IM = MOD(NB, IBIPW)
- IM = IAND(NB, IBIPW-1)
- IF (IM.NE.0 .AND. NBITS.GT.IBIPW-IM) THEN
- NB = 0
- NLEFT = NLEFT - IBIPW+IM
- IFIRST = IFIRST + 1
- ENDIF
-*
-*-- if next item is not in current bank load next bank
-*
- IF (NBITS .GT. NLEFT) THEN
- IBANK = IBANK + 1
- CALL HNTRD(INDX, IOFF, IBANK, IER)
- IF (IER .NE. 0) GOTO 50
- NB = 0
- NLEFT = LRECL*IBIPW
- IFIRST = 2
- ENDIF
-*
- IF (NRECOV .AND. .NOT.INDVAR) GOTO 25
-*
-*-- Restoring REALs
-*
- IF (ITYPE .EQ. 1) THEN
- IF (ISIZE .EQ. 4) THEN
- IF (NBITS .EQ. 32) THEN
- IF (USEBUF) THEN
-#if defined(CERNLIB_NO_IEEE)
- CALL IE3TOS(Q(LR2+IFIRST),Q(IOFFST+1),1,K)
-#endif
-#if !defined(CERNLIB_NO_IEEE)
- Q(IOFFST+1) = Q(LR2+IFIRST)
-#endif
- ELSE
-#if defined(CERNLIB_NO_IEEE)
- CALL IE3TOS(Q(LR2+IFIRST),
- + Q(IQ(LNAME+IOFF+ZNADDR)+J),1,K)
-#endif
-#if !defined(CERNLIB_NO_IEEE)
- Q(IQ(LNAME+IOFF+ZNADDR)+J) = Q(LR2+IFIRST)
-#endif
- ENDIF
- ELSE
- RMIN = Q(LREAL+IQ(LNAME+IOFF+ZRANGE))
- RMAX = Q(LREAL+IQ(LNAME+IOFF+ZRANGE)+1)
- IPACK = JBYT(IQ(LR2+IFIRST), NB+1, NBITS)
- IF (USEBUF) THEN
- Q(IOFFST+1) = IPACK *
-*** + (RMAX - RMIN)/(2**NBITS - 1) + RMIN
- + (RMAX - RMIN)/(ISHFT(1,NBITS)-1) + RMIN
- ELSE
- Q(IQ(LNAME+IOFF+ZNADDR)+J) = IPACK *
-*** + (RMAX - RMIN)/(2**NBITS - 1) + RMIN
- + (RMAX - RMIN)/(ISHFT(1,NBITS)-1) + RMIN
- ENDIF
- ENDIF
- ELSEIF (ISIZE .EQ. 8) THEN
- IF (NBITS .EQ. 64) THEN
- IF (USEBUF) THEN
-#if defined(CERNLIB_NO_IEEE)
- CALL IE3TOD(Q(LR2+IFIRST),Q(IOFFST+1),1,K)
-#endif
-#if !defined(CERNLIB_NO_IEEE)
-#if defined(CERNLIB_VAX)||defined(CERNLIB_DECS)||(defined(CERNLIB_LINUX) && !defined(CERNLIB_PPC))||defined(CERNLIB_WINNT)
- Q(IOFFST+1) = Q(LR2+IFIRST+1)
- Q(IOFFST+2) = Q(LR2+IFIRST)
-#else
- Q(IOFFST+1) = Q(LR2+IFIRST)
- Q(IOFFST+2) = Q(LR2+IFIRST+1)
-#endif
-#endif
- ELSE
-#if defined(CERNLIB_NO_IEEE)
- CALL IE3TOD(Q(LR2+IFIRST),
- + Q(IQ(LNAME+IOFF+ZNADDR)+2*J-1),1,K)
-#endif
-#if !defined(CERNLIB_NO_IEEE)
-#if defined(CERNLIB_VAX)||defined(CERNLIB_DECS)||(defined(CERNLIB_LINUX) && !defined(CERNLIB_PPC))||defined(CERNLIB_WINNT)
- Q(IQ(LNAME+IOFF+ZNADDR)+2*J-1) = Q(LR2+IFIRST+1)
- Q(IQ(LNAME+IOFF+ZNADDR)+2*J) = Q(LR2+IFIRST)
-#else
- Q(IQ(LNAME+IOFF+ZNADDR)+2*J-1) = Q(LR2+IFIRST)
- Q(IQ(LNAME+IOFF+ZNADDR)+2*J) = Q(LR2+IFIRST+1)
-#endif
-#endif
- ENDIF
- ELSE
-*-- no double precision packed reals yet
- ENDIF
- ENDIF
-*
-*-- Restoring INTEGERs
-*
- ELSEIF (ITYPE .EQ. 2) THEN
- IF (ISIZE .EQ. 2) THEN
-
- ELSEIF (ISIZE .EQ. 4) THEN
- IF (INDVAR) THEN
- IF (USEBUF) THEN
- IQ(IOFFST+1) = IQ(LR2+IFIRST) -
- + IQ(LR2+IFIRST-1)
- IQ(LTMP+ITMP+5) = IQ(IOFFST+1)
- ELSE
- IQ(IQ(LNAME+IOFF+ZNADDR)+J) = IQ(LR2+IFIRST) -
- + IQ(LR2+IFIRST-1)
- IQ(LTMP+ITMP+5) = IQ(IQ(LNAME+IOFF+ZNADDR)+J)
- ENDIF
- IQ(LTMP+ITMP+4) = IQ(LR2+IFIRST-1)
- ELSEIF (NBITS .EQ. 32) THEN
- IF (USEBUF) THEN
- IQ(IOFFST+1) = IQ(LR2+IFIRST)
- ELSE
- IQ(IQ(LNAME+IOFF+ZNADDR)+J) = IQ(LR2+IFIRST)
- ENDIF
- ELSE
- IF (JBIT(IQ(LR2+IFIRST), NB+NBITS) .EQ. 1) THEN
- IF (USEBUF) THEN
- IQ(IOFFST+1) =
- + -JBYT(IQ(LR2+IFIRST), NB+1, NBITS-1)
- ELSE
- IQ(IQ(LNAME+IOFF+ZNADDR)+J) =
- + -JBYT(IQ(LR2+IFIRST), NB+1, NBITS-1)
- ENDIF
- ELSE
- IF (USEBUF) THEN
- IQ(IOFFST+1) =
- + JBYT(IQ(LR2+IFIRST), NB+1, NBITS-1)
- ELSE
- IQ(IQ(LNAME+IOFF+ZNADDR)+J) =
- + JBYT(IQ(LR2+IFIRST), NB+1, NBITS-1)
- ENDIF
- ENDIF
- ENDIF
- ELSEIF (ISIZE .EQ. 8) THEN
- IF (NBITS .EQ. 64) THEN
- IF (USEBUF) THEN
- IQ(IOFFST+1) = IQ(LR2+IFIRST)
- IQ(IOFFST+2) = IQ(LR2+IFIRST+1)
- ELSE
- IQ(IQ(LNAME+IOFF+ZNADDR)+2*J-1)=IQ(LR2+IFIRST)
- IQ(IQ(LNAME+IOFF+ZNADDR)+2*J)=IQ(LR2+IFIRST+1)
- ENDIF
- ELSE
-*-- no double precision packed integers yet
- ENDIF
- ENDIF
-*
-*-- Restoring UNSIGNED INTEGERs
-*
- ELSEIF (ITYPE .EQ. 3) THEN
- IF (ISIZE .EQ. 2) THEN
-
- ELSEIF (ISIZE .EQ. 4) THEN
- IF (NBITS .EQ. 32) THEN
- IF (USEBUF) THEN
- IQ(IOFFST+1) = IQ(LR2+IFIRST)
- ELSE
- IQ(IQ(LNAME+IOFF+ZNADDR)+J) = IQ(LR2+IFIRST)
- ENDIF
- ELSE
- IF (USEBUF) THEN
- IQ(IOFFST+1) =
- + JBYT(IQ(LR2+IFIRST), NB+1, NBITS)
- ELSE
- IQ(IQ(LNAME+IOFF+ZNADDR)+J) =
- + JBYT(IQ(LR2+IFIRST), NB+1, NBITS)
- ENDIF
- ENDIF
- ELSEIF (ISIZE .EQ. 8) THEN
- IF (NBITS .EQ. 64) THEN
- IF (USEBUF) THEN
- IQ(IOFFST+1)=IQ(LR2+IFIRST)
- IQ(IOFFST+2)=IQ(LR2+IFIRST+1)
- ELSE
- IQ(IQ(LNAME+IOFF+ZNADDR)+2*J-1)=IQ(LR2+IFIRST)
- IQ(IQ(LNAME+IOFF+ZNADDR)+2*J)=IQ(LR2+IFIRST+1)
- ENDIF
- ELSE
-*-- no double precision packed unsigned integers yet
- ENDIF
- ENDIF
-*
-*-- Restoring LOGICALs
-*
- ELSEIF (ITYPE .EQ. 4) THEN
- IF (ISIZE .EQ. 1) THEN
-
- ELSEIF (ISIZE .EQ. 2) THEN
-
- ELSEIF (ISIZE .EQ. 4) THEN
- ILOGI = JBYT(IQ(LR2+IFIRST), NB+1, NBITS)
- IF (ILOGI .EQ. 1) THEN
- LOGIC = .TRUE.
- ELSE
- LOGIC = .FALSE.
- ENDIF
- IF (USEBUF) THEN
- IQ(IOFFST+1) = ILOGIC
- ELSE
- IQ(IQ(LNAME+IOFF+ZNADDR)+J) = ILOGIC
- ENDIF
- ENDIF
-*
-*-- Restoring CHARACTERs
-*
- ELSEIF (ITYPE .EQ. 5) THEN
-#if defined(CERNLIB_IBM)||defined(CERNLIB_VAX)||defined(CERNLIB_DECS)||defined(CERNLIB_MSDOS)||(defined(CERNLIB_LINUX) && !defined(CERNLIB_PPC))||defined(CERNLIB_WINNT)
- IF (USEBUF) THEN
- CALL HRZFRA(IQ(LR2+IFIRST),IQ(IOFFST+1),MXBY)
- ELSE
- CALL HRZFRA(IQ(LR2+IFIRST),
- + IQ(IQ(LNAME+IOFF+ZNADDR)+MXBY1*(J-1)+1),
- + MXBY)
- ENDIF
-#endif
-#if (!defined(CERNLIB_IBM))&&(!defined(CERNLIB_VAX))&&(!defined(CERNLIB_DECS))&&(!defined(CERNLIB_MSDOS))&&(!(defined(CERNLIB_LINUX) && !defined(CERNLIB_PPC)))&&(!defined(CERNLIB_WINNT))
- DO 20 K = 1, MXBY
- IF (USEBUF) THEN
- IQ(IOFFST+K) = IQ(LR2+IFIRST+K-1)
- ELSE
- IQ(IQ(LNAME+IOFF+ZNADDR)+MXBY1*(J-1)+K) =
- + IQ(LR2+IFIRST+K-1)
- ENDIF
- 20 CONTINUE
-#endif
- ENDIF
-*
- 25 NB = NB + NBITS
- IF (ISHBIT .NE. 0) THEN
- IFIRST = IFIRST + ISHFT(NB,-ISHBIT)
- ELSE
- IFIRST = IFIRST + NB/IBIPW
- ENDIF
-*** NB = MOD(NB, IBIPW)
- NB = IAND(NB, IBIPW-1)
- NLEFT = NLEFT - NBITS
- IF (USEBUF) IOFFST = IOFFST + ISHFT(ISIZE,-2)
- 30 CONTINUE
-*
- IQ(LTMP+ITMP) = IBANK
- IQ(LTMP+ITMP+1) = IFIRST
- IQ(LTMP+ITMP+2) = NB
- IQ(LTMP+ITMP+3) = NLEFT
-*
- IF (USEBUF) THEN
- IF (IEDIF .EQ. 0) THEN
- IQ(LTMP1+JTMP+2) = IOFFST
- ELSE
- IQ(LTMP1+JTMP+2) = IOFFST + (IEDIF*ISHFT(ISIZE,-2))
- ENDIF
- ELSE
- IQ(LTMP1+JTMP+2) = 0
- ENDIF
-*
- 40 CONTINUE
-*
- IQ(LTMP+1) = IDNEVT
-*
- RETURN
-*
-*-- error
-*
- 50 IQ(LTMP+1) = 0
- IERROR = 1
-*
- END
diff --git a/src/packlib/hbook/hntup/hgntv.F b/src/packlib/hbook/hntup/hgntv.F
deleted file mode 100644
index 684772e..0000000
--- a/src/packlib/hbook/hntup/hgntv.F
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: hgntv.F,v 1.1.1.1 1996/01/16 17:07:57 mclareni Exp $
-*
-* $Log: hgntv.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:57 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.22/09 21/07/94 16.14.43 by Fons Rademakers
-*-- Author : Fons Rademakers 29/01/92
- SUBROUTINE HGNTV(IDN,VAR,NVAR,IDNEVT,IERROR)
-*.==========>
-*.
-*. Return in the preset addresses (set by HBNAME)
-*. the variables VAR(NVAR) of event (row) IDNEVT.
-*.
-*. This routine calls HGNT1. HGNT1 checks the IDD and scans over all
-*. blocks, calling for each block HGNT2. HGNT2 does the actual retrieval.
-*.
-*..=========> ( A.A.Rademakers )
-*
- CHARACTER*(*) VAR(*)
-*
- CALL HGNT1(IDN, '*', VAR, 0, NVAR, IDNEVT, IERROR)
-*
- END
diff --git a/src/packlib/hbook/hntup/hgtdir.F b/src/packlib/hbook/hntup/hgtdir.F
deleted file mode 100644
index e752ef6..0000000
--- a/src/packlib/hbook/hntup/hgtdir.F
+++ /dev/null
@@ -1,38 +0,0 @@
-*
-* $Id: hgtdir.F,v 1.1.1.1 1996/01/16 17:07:57 mclareni Exp $
-*
-* $Log: hgtdir.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:57 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.19/00 07/04/93 18.32.23 by Fons Rademakers
-*-- Author : Fons Rademakers 19/09/92
- SUBROUTINE HGTDIR(CHDIR)
-*.==========>
-*.
-*. Returns in CHDIR the directory of the Ntuple currently in memory.
-*.
-*..=========> ( A.A.Rademakers )
-*
-#include "hbook/hcntpar.inc"
-#include "hbook/hcbook.inc"
-*
- CHARACTER*(*) CHDIR
-*
- CHDIR = ' '
- IF (IQ(LCID-2) .EQ. ZLINK) THEN
-*-- new ntuple
- NCHRZ = IQ(LCID+ZNCHRZ)
- IDIR1 = ZNCHRZ+1
- ELSE
-*-- old ntuple
- NCHRZ = IQ(LCID+11)
- IDIR1 = 12
- ENDIF
- IF (NCHRZ.GT.0.AND.NCHRZ.LE.80) THEN
- CALL UHTOC(IQ(LCID+IDIR1),4,CHDIR,NCHRZ)
- ENDIF
-*
- END
diff --git a/src/packlib/hbook/hntup/hicton.F b/src/packlib/hbook/hntup/hicton.F
deleted file mode 100644
index 23ae104..0000000
--- a/src/packlib/hbook/hntup/hicton.F
+++ /dev/null
@@ -1,119 +0,0 @@
-*
-* $Id: hicton.F,v 1.1.1.1 1996/01/16 17:07:57 mclareni Exp $
-*
-* $Log: hicton.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:57 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.22/11 23/08/94 14.19.39 by Rene Brun
-*-- Author :
- SUBROUTINE HICTON(CVAL,IVAL,RVAL)
-*.==========>
-* Convert character string CVAL into integer value IVAL or real value RVAL
-*
-* IQUEST(1) is returned <> 0 if a conversion error occurred
-* IQUEST(2) is returned <> 0 if the number is out of the integer range
-* (i.e. it can be read only from RVAL and not from IVAL)
-*
-*..=========> ( P.Zanarini (KUIP routine KICTON))
-*
- CHARACTER*(*) CVAL
- INTEGER IVAL
- REAL RVAL
- COMMON /QUEST/ IQUEST(100)
-*
- PARAMETER (MAXDIG=15)
- CHARACTER*(MAXDIG) CHTEMP,BLANK
- PARAMETER (MAXINT=2147483647)
-*
- IQUEST(1)=0
- IQUEST(2)=0
- IQUEST(14)=0
-
- L=LENOCC(CVAL)
- IF (L.EQ.0) GO TO 999
-
- IF (L.GT.MAXDIG) GO TO 900
-
- BLANK=' '
- IF (L.EQ.MAXDIG) THEN
- CHTEMP=CVAL
- ELSE
- CHTEMP=BLANK(:MAXDIG-L)//CVAL
- ENDIF
-
- CALL CLTOU(CHTEMP)
-
- I1=INDEX(CHTEMP(MAXDIG-L+1:),'E')
-
- IF (I1.EQ.1) I1=0
- IF (I1.GT.0) THEN
- DO 10 I=MAXDIG-L+1,MAXDIG-L+I1-1
- IF ((CHTEMP(I:I).LT.'0'.OR.CHTEMP(I:I).GT.'9').AND. CHTEMP(
- + I:I).NE.'+'.AND.CHTEMP(I:I).NE.'-'.AND. CHTEMP(I:I).NE.' '
- + .AND.CHTEMP(I:I).NE.'.') GO TO 900
- 10 CONTINUE
- ENDIF
-
- I2=INDEX(CHTEMP(MAXDIG-L+1:),'+')
- I3=INDEX(CHTEMP(MAXDIG-L+1:),'-')
- IF (I2.GT.1.AND.I1.EQ.0) GO TO 900
- IF (I3.GT.1.AND.I1.EQ.0) GO TO 900
-
- IF (L.EQ.1) THEN
- IF (CHTEMP(MAXDIG:MAXDIG).EQ.'E') GO TO 900
- IF (CHTEMP(MAXDIG:MAXDIG).EQ.'-') GO TO 900
- IF (CHTEMP(MAXDIG:MAXDIG).EQ.',') GO TO 900
- IF (CHTEMP(MAXDIG:MAXDIG).EQ.'.') GO TO 900
- IF (CHTEMP(MAXDIG:MAXDIG).EQ.'+') GO TO 900
- ENDIF
-
- L=MAXDIG
-
- I1 =INDEX(CHTEMP,'.')
- II1=0
- IF (I1.LT.L) II1=INDEX(CHTEMP(I1+1:),'.')
- I2=INDEX(CHTEMP,'E')
- II2=0
- IF (I2.LT.L) II2=INDEX(CHTEMP(I2+1:),'E')
-
- IF (II1+II2.NE.0) GO TO 900
-
- IF (I1+I2.EQ.0) THEN
- CALL HICTOI(CHTEMP,IVAL)
- IQUEST(14)=2
- RVAL=IVAL
- GO TO 999
- ENDIF
-
- IF (I1.EQ.L.AND.I2.EQ.0) THEN
- CALL HICTOI(CHTEMP(:I1-1),IVAL)
- IQUEST(14)=2
- RVAL=IVAL
- GO TO 999
- ENDIF
-
- IF (I2.GT.0.AND.I1.EQ.0) THEN
- BLANK(:I2-2)=CHTEMP(2:I2-1)
- BLANK(I2-1:I2-1)='.'
- BLANK(I2:)=CHTEMP(I2:)
- CHTEMP=BLANK
- ENDIF
-
- READ (CHTEMP,'(G15.7)',END=999,ERR=900) RVAL
- IQUEST(14)=1
- IF (ABS(RVAL).LT.MAXINT) THEN
- IVAL=RVAL
- ELSE
- IQUEST(2)=1
- ENDIF
- GO TO 999
-
- 900 IQUEST(1)=1
- GO TO 999
-
- 999 CONTINUE
-
- END
diff --git a/src/packlib/hbook/hntup/hitoc.F b/src/packlib/hbook/hntup/hitoc.F
deleted file mode 100644
index 97dbf1e..0000000
--- a/src/packlib/hbook/hntup/hitoc.F
+++ /dev/null
@@ -1,50 +0,0 @@
-*
-* $Id: hitoc.F,v 1.1.1.1 1996/01/16 17:07:57 mclareni Exp $
-*
-* $Log: hitoc.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:57 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.17/00 28/01/92 17.40.00 by Fons Rademakers
-*-- Author : Fons Rademakers 28/01/92
- SUBROUTINE HITOC(IVAL, VALC, NCSTR, IERR)
-*.==========>
-*.
-*. Converts the integer IVAL to the character string VALC
-*.
-*. Input: IVAL integer number
-*.
-*. Output: VALC character string
-*. NCSTR length of VALC
-*.
-*. Errors: IERR <> 0 error during conversion
-*.
-*..=========> ( A.A.Rademakers )
-*
- CHARACTER*(*) VALC
- INTEGER IVAL, IERR
-*
- CHARACTER*32 TT
- INTEGER I, J, NCSTR, NCH, LENOCC
-*
- IERR = 0
- WRITE(TT,'(I32)',ERR=20) IVAL
- J = 0
- DO 10 I = 1, LENOCC(TT)
- IF (TT(I:I) .EQ. ' ') GOTO 10
- J = J + 1
- TT(J:J) = TT(I:I)
- 10 CONTINUE
- NCSTR = J
- TT = TT(1:NCSTR)
-*
- NCH = LEN(VALC)
- IF (NCH .LT. NCSTR) IERR = -1
- VALC(1:NCH) = TT
- GOTO 999
-*
- 20 IERR = 1
-*
- 999 END
diff --git a/src/packlib/hbook/hntup/hnbent.F b/src/packlib/hbook/hntup/hnbent.F
deleted file mode 100644
index 3c1efed..0000000
--- a/src/packlib/hbook/hntup/hnbent.F
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: hnbent.F,v 1.1.1.1 1996/01/16 17:07:57 mclareni Exp $
-*
-* $Log: hnbent.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:57 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.19/01 11/05/93 10.30.35 by Fons Rademakers
-*-- Author : Fons Rademakers 18/02/93
- SUBROUTINE HNBENT(IDD,BLOCK,NUMB)
-*.==========>
-*.
-*. Returns the number of entries in block BLOCK of Ntuple IDD.
-*.
-*..=========> ( A.A.Rademakers )
-*
-#include "hbook/hcbook.inc"
-#include "hbook/hcntpar.inc"
-*
- CHARACTER*(*) BLOCK
- CHARACTER*8 BLKNAM
- INTEGER HNBPTR
-*
- NUMB = -1
- BLKNAM = BLOCK
-*
- CALL HFIND(IDD,'HNBENT')
-*
- I4 = JBIT(IQ(LCID+KBITS),4)
- IF (I4.NE.0 .AND. IQ(LCID-2).EQ.ZLINK) THEN
- LBLOK = HNBPTR(BLKNAM)
- IF (LBLOK .EQ. 0) THEN
- CALL HBUG('Block does not exist','HNBENT',IDD)
- RETURN
- ENDIF
- NUMB = IQ(LBLOK+ZNOENT)
- ENDIF
-*
- END
diff --git a/src/packlib/hbook/hntup/hnbfwr.F b/src/packlib/hbook/hntup/hnbfwr.F
deleted file mode 100644
index a516d56..0000000
--- a/src/packlib/hbook/hntup/hnbfwr.F
+++ /dev/null
@@ -1,99 +0,0 @@
-*
-* $Id: hnbfwr.F,v 1.1.1.1 1996/01/16 17:07:58 mclareni Exp $
-*
-* $Log: hnbfwr.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:58 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.21/07 17/12/93 17.49.48 by Rene Brun
-*-- Author : Fons Rademakers 01/05/92
- SUBROUTINE HNBFWR(IDD)
-*.==========>
-*.
-*. Write all buffers from the buffer structure for N-tuple IDD.
-*. For the data-structure description see routine HBNT.
-*.
-*. This routine assumes that LCID is pointing to the right N-tuple.
-*.
-*..=========> ( A.A.Rademakers )
-*
-#include "hbook/hcntpar.inc"
-#include "hbook/hcflag.inc"
-#include "hbook/hcbook.inc"
-*
- CHARACTER*128 CHWOLD, CHDIR, CWDRZ
- INTEGER KEYS(2)
-*
- IERR = 0
-*
-*-- Make sure the LBUF pointer points to the right buffer structure.
-*-- If buffer structure does not exist then there is also nothing to write.
-*
- CALL HNBUFF(IDD, .FALSE.)
- IF (IERR .NE. 0) GOTO 99
-*
-*-- goto the correct RZ directory
-*
- NCHRZ = IQ(LCID+ZNCHRZ)
- IF(NCHRZ.NE.0)THEN
- CALL RZCDIR(CWDRZ,'R')
- CALL HCDIR(CHWOLD,'R')
- CHDIR = ' '
- CALL UHTOC(IQ(LCID+ZNCHRZ+1),4,CHDIR,NCHRZ)
- IF (CHDIR .NE. CWDRZ) THEN
- CALL HCDIR(CHDIR,' ')
- ENDIF
- ENDIF
-*
- KEYS(1) = IDD
- KEYS(2) = 0
-*
-*-- loop over all blocks
-*
- LBLOK = LQ(LCID-1)
- LCHAR = LQ(LCID-2)
- LINT = LQ(LCID-3)
- LREAL = LQ(LCID-4)
-*
-10 LNAME = LQ(LBLOK-1)
-*
- IOFF = 0
- NDIM = IQ(LBLOK+ZNDIM)
-*
-*-- loop over all variables in every block
-*
- DO 20 I = 1, NDIM
- LCIND = IQ(LNAME+IOFF+ZLCONT)
- LB = LQ(LBUF-LCIND)
- IF (LB .EQ. 0) GOTO 15
- IF (JBIT(IQ(LB),1) .EQ. 0) GOTO 15
- CALL SBIT0(IQ(LB),1)
- KEYS(2) = IQ(LNAME+IOFF+ZNRZB)*10000 + IQ(LNAME+IOFF+ZLCONT)
-*
- IF (IQ(LCID+ZNPRIM) .GT. 0) THEN
- CALL HRZOUT(IHDIV,LB,KEYS,ICYCLE,'A')
- ELSE
- CALL HRZOUT(IHDIV,LB,KEYS,ICYCLE,'LA')
- ENDIF
-*
-15 IOFF = IOFF + ZNADDR
-20 CONTINUE
-*
- LBLOK = LQ(LBLOK)
- IF (LBLOK .NE. 0) GOTO 10
-*
-*-- set header save bit if at least one buffer has been written
-*
- IF (KEYS(2) .NE. 0) CALL SBIT1(IQ(LQ(LCID-1)),1)
-*
- IF (NCHRZ.NE.0.AND.CHDIR .NE. CWDRZ) THEN
- CALL HCDIR(CHWOLD,' ')
- IF (CHWOLD .NE. CWDRZ) THEN
- CALL RZCDIR(CWDRZ,' ')
- ENDIF
- ENDIF
-*
-99 RETURN
- END
diff --git a/src/packlib/hbook/hntup/hnbmin.F b/src/packlib/hbook/hntup/hnbmin.F
deleted file mode 100644
index bab2599..0000000
--- a/src/packlib/hbook/hntup/hnbmin.F
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: hnbmin.F,v 1.1.1.1 1996/01/16 17:07:58 mclareni Exp $
-*
-* $Log: hnbmin.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:58 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.19/00 18/03/93 17.10.44 by Fons Rademakers
-*-- Author : Fons Rademakers 18/03/93
- INTEGER FUNCTION HNBMIN()
-*.==========>
-*.
-*. Return the number of entries in the block with the
-*. lowest number of entries.
-*.
-*..=========> ( A.A.Rademakers )
-*
-#include "hbook/hcntpar.inc"
-#include "hbook/hcbook.inc"
-*
- LL = LQ(LCID-1)
- HNBMIN = IQ(LL+ZNOENT)
-*
-10 HNBMIN = MIN(HNBMIN, IQ(LL+ZNOENT))
-*
- LL = LQ(LL)
- IF (LL .NE. 0) GOTO 10
-*
- END
diff --git a/src/packlib/hbook/hntup/hnbptr.F b/src/packlib/hbook/hntup/hnbptr.F
deleted file mode 100644
index 316fe42..0000000
--- a/src/packlib/hbook/hntup/hnbptr.F
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: hnbptr.F,v 1.1.1.1 1996/01/16 17:07:58 mclareni Exp $
-*
-* $Log: hnbptr.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:58 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.17/00 27/05/92 15.58.16 by Fons Rademakers
-*-- Author : Fons Rademakers 27/02/92
- INTEGER FUNCTION HNBPTR(BLKNA1)
-*.==========>
-*.
-*. Return the LBLOK of the block with name BLKNAM
-*.
-*..=========> ( A.A.Rademakers )
-*
-#include "hbook/hcntpar.inc"
-#include "hbook/hcbook.inc"
-*
- CHARACTER*(*) BLKNA1
- CHARACTER*8 BLKNAM
- INTEGER IBLKN(2)
-*
- BLKNAM = BLKNA1
- CALL CLTOU(BLKNAM)
- HNBPTR = 0
-*
- CALL UCTOH(BLKNAM, IBLKN, 4, 8)
-*
- LL = LQ(LCID-1)
-10 IF (IBLKN(1).EQ.IQ(LL+ZIBLOK) .AND.
- + IBLKN(2).EQ.IQ(LL+ZIBLOK+1)) THEN
- HNBPTR = LL
- RETURN
- ENDIF
- LL = LQ(LL)
- IF (LL .NE. 0) GOTO 10
-*
- END
diff --git a/src/packlib/hbook/hntup/hnbuf.F b/src/packlib/hbook/hntup/hnbuf.F
deleted file mode 100644
index e928ac3..0000000
--- a/src/packlib/hbook/hntup/hnbuf.F
+++ /dev/null
@@ -1,119 +0,0 @@
-*
-* $Id: hnbuf.F,v 1.1.1.1 1996/01/16 17:07:58 mclareni Exp $
-*
-* $Log: hnbuf.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:58 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.21/08 28/01/94 15.14.26 by Fons Rademakers
-*-- Author : Fons Rademakers 28/04/92
- SUBROUTINE HNBUF(IDD)
-*.==========>
-*.
-*. Buffer manager for new (variable row length) N-tuples.
-*. For the data-structure description see routine HBNT.
-*.
-*. This routine creates and finds the contents buffers for N-tuple ID.
-*.
-*..=========> ( A.A.Rademakers )
-*
-#include "hbook/hcntpar.inc"
-#include "hbook/hcflag.inc"
-#include "hbook/hcbook.inc"
-*
-*-- create LBUF structure and the contents banks for N-tuple IDD
-*
- NDIM = IQ(LCID+ZNDIM)
- NWP = IABS(IQ(LCID+ZNPRIM))
-*
- IF (LQ(LCDIR-4) .EQ. 0) THEN
-*
-*-- enough space left?
-*
- NTOT = NDIM+2+NDIM*NWP+(NDIM+1)*33
- CALL HSPACE(NTOT,'HNBUF',IDD)
- IF (IERR.NE.0) GOTO 70
- IDLAST = IDD
-*
- CALL MZBOOK(IHDIV,LBUFM,LCDIR,-4,'HBUF',NDIM,NDIM,2,2,0)
- LBUF = LBUFM
- IQ(LBUF-5) = IDD
-*
-*-- Attention: first word needs to be zeroed
-*
- DO 10 I = 1, NDIM
- CALL MZBOOK(IHDIV,L,LBUF,-I,'HCON',0,0,NWP,1,1)
- 10 CONTINUE
- ELSEIF (IQ(LBUF-5) .NE. IDD) THEN
-*
-*-- find buffer bank for ntuple IDD
-*
- LBUF = LQ(LCDIR-4)
- 20 IF (IQ(LBUF-5) .EQ. IDD) GOTO 40
- IF (LQ(LBUF) .NE. 0) THEN
- LBUF = LQ(LBUF)
- GOTO 20
- ENDIF
-*
-*-- no buffer structure and contents banks for this ntuple; create them
-*-- first check if there is enough space left?
-*
- NTOT = NDIM+2+NDIM*NWP+(NDIM+1)*33
- CALL HSPACE(NTOT,'HNBUF',IDD)
- IF (IERR.NE.0) GOTO 70
- IDLAST = IDD
-*
- CALL MZBOOK(IHDIV,LBUF,LBUF,0,'HBUF',NDIM,NDIM,2,2,0)
- IQ(LBUF-5) = IDD
-*
-*-- Attention: first word needs to be zeroed
-*
- DO 30 I = 1, NDIM
- CALL MZBOOK(IHDIV,L,LBUF,-I,'HCON',0,0,NWP,1,1)
- 30 CONTINUE
- ENDIF
-*
-*-- check if new variables (in new blocks) were defined since
-*-- previous call
-*
- 40 IF (NDIM .GT. IQ(LBUF-2)) THEN
- LOLD = IQ(LBUF-2)
- LNEED = NDIM - LOLD
-*
-*-- enough space?
-*
- NTOT = LNEED+(NWP+33)*LNEED
- CALL HSPACE(NTOT,'HNBUF',IDD)
- IF (IERR.NE.0) GOTO 70
- IDLAST = IDD
-*
- CALL MZPUSH(IHDIV, LBUF, LNEED, 0, 'I')
-*
-*-- Attention: first word needs to be zeroed
-*
- DO 50 I = LOLD+1, NDIM
- CALL MZBOOK(IHDIV,L,LBUF,-I,'HCON',0,0,NWP,1,1)
- 50 CONTINUE
- ENDIF
-*
-*-- check if the buffer size of the buffer corresponds with the buffer
-*-- size in the N-tuple description. If not change the buffers accordingly
-*
- L = LQ(LBUF-1)
- NW = IQ(L-1)
- IF (NWP .NE. NW) THEN
- ND = NWP - NW
- DO 60 I = 1, NDIM
- CALL MZPUSH(IHDIV, LQ(LBUF-I), 0, ND, ' ')
- 60 CONTINUE
- ENDIF
-*
-*-- create and set TMP buffers
-*
- CALL HNTMP(IDD)
-*
- 70 RETURN
- END
-
diff --git a/src/packlib/hbook/hntup/hnbufd.F b/src/packlib/hbook/hntup/hnbufd.F
deleted file mode 100644
index 916372c..0000000
--- a/src/packlib/hbook/hntup/hnbufd.F
+++ /dev/null
@@ -1,53 +0,0 @@
-*
-* $Id: hnbufd.F,v 1.1.1.1 1996/01/16 17:07:58 mclareni Exp $
-*
-* $Log: hnbufd.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:58 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.21/08 28/01/94 17.02.04 by Fons Rademakers
-*-- Author : Fons Rademakers 28/04/92
- SUBROUTINE HNBUFD(IDD)
-*.==========>
-*.
-*. Drop buffer manager buffers.
-*. For the data-structure description see routine HBNT.
-*.
-*. This routine drops the contents buffers for N-tuple ID.
-*.
-*..=========> ( A.A.Rademakers )
-*
-#include "hbook/hcbook.inc"
-*
- CALL HNTMPD(IDD)
-*
- IF (LQ(LCDIR-4) .EQ. 0) RETURN
-*
- IF (IDD .EQ. 0) THEN
- CALL MZDROP(IHDIV,LQ(LCDIR-4),'L')
- LQ(LCDIR-4) = 0
- LBUFM = 0
- LBUF = 0
- ELSE
-*
-*-- find buffer bank for ntuple IDD
-*
- LBUF = LQ(LCDIR-4)
- 20 IF (IQ(LBUF-5) .EQ. IDD) THEN
- CALL MZDROP(IHDIV,LBUF,' ')
- LBUF = LQ(LCDIR-4)
- GOTO 40
- ENDIF
- LBUF = LQ(LBUF)
- IF (LBUF .NE. 0) GOTO 20
-*
-*-- if buffers not found do not complain
-*
-** CALL HBUG('Unknown N-tuple','HNBUFD',IDD)
- RETURN
- ENDIF
-*
- 40 END
-
diff --git a/src/packlib/hbook/hntup/hnbuff.F b/src/packlib/hbook/hntup/hnbuff.F
deleted file mode 100644
index efc6501..0000000
--- a/src/packlib/hbook/hntup/hnbuff.F
+++ /dev/null
@@ -1,64 +0,0 @@
-*
-* $Id: hnbuff.F,v 1.1.1.1 1996/01/16 17:07:58 mclareni Exp $
-*
-* $Log: hnbuff.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:58 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.17/02 16/12/92 16.29.18 by Fons Rademakers
-*-- Author : Fons Rademakers 28/04/92
- SUBROUTINE HNBUFF(IDD, FATAL)
-*.==========>
-*.
-*. Fast finding of buffer manager structure for new
-*. (variable row length) N-tuples. This routine may only
-*. be called by HGNTF and HNBFWR. It assumes that the buffers
-*. have not been changed between calls.
-*. For the data-structure description see routine HBNT.
-*.
-*. This routine finds the contents buffers for N-tuple ID.
-*.
-*..=========> ( A.A.Rademakers )
-*
-#include "hbook/hcflag.inc"
-#include "hbook/hcbook.inc"
-*
- LOGICAL FATAL
-*
- IF (LQ(LCDIR-4) .EQ. 0) THEN
-*
-*-- this may not happen in HNBUFF
-*
- IF (FATAL) THEN
- CALL HBUG('Buffer structure not initialized.','HNBUFF',IDD)
- ENDIF
- IERR = 1
- RETURN
- ELSEIF (IQ(LBUF-5) .NE. IDD) THEN
-*
-*-- find buffer bank for ntuple IDD
-*
- LBUF = LQ(LCDIR-4)
- 20 IF (IQ(LBUF-5) .EQ. IDD) GOTO 40
- IF (LQ(LBUF) .NE. 0) THEN
- LBUF = LQ(LBUF)
- GOTO 20
- ENDIF
-*
-*-- this may not happen either
-*
- IF (FATAL) THEN
- CALL HBUG('Buffer structure not found.','HNBUFF',IDD)
- ENDIF
- IERR = 1
- RETURN
- ENDIF
-*
-*-- create and set TMP buffers
-*
- 40 CALL HNTMPF(IDD, FATAL)
-*
- END
-
diff --git a/src/packlib/hbook/hntup/hnbufr.F b/src/packlib/hbook/hntup/hnbufr.F
deleted file mode 100644
index c63924b..0000000
--- a/src/packlib/hbook/hntup/hnbufr.F
+++ /dev/null
@@ -1,184 +0,0 @@
-*
-* $Id: hnbufr.F,v 1.2 2002/01/30 15:03:04 couet Exp $
-*
-* $Log: hnbufr.F,v $
-* Revision 1.2 2002/01/30 15:03:04 couet
-* - typo fixed
-*
-* Revision 1.1.1.1 1996/01/16 17:07:58 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.21/08 28/01/94 15.14.11 by Fons Rademakers
-*-- Author : Fons Rademakers 28/04/92
- SUBROUTINE HNBUFR(IDD)
-*.==========>
-*.
-*. Buffer manager for new (variable row length) read/only N-tuples.
-*. This routine creates buffers for variables that have
-*. an address (ZNADDR) set, and deletes the buffers for variables
-*. where the address is zero. In case of memory resident Ntuples
-*. read the buffers from disk (?!?!?!).
-*. For the data-structure description see routine HBNT.
-*.
-*. This routine restores the contents buffers for a memory resident
-*. N-tuple ID.
-*.
-*..=========> ( A.A.Rademakers )
-*
-#include "hbook/hcntpar.inc"
-#include "hbook/hcflag.inc"
-#include "hbook/hcbook.inc"
-*
- COMMON/QUEST/IQUEST(100)
- CHARACTER*128 CHWOLD, CHDIR, CWDRZ
- INTEGER KEYS(2)
- LOGICAL MEMORY
-*
- IERR = 0
- ICYCLE = 9999
-*
-*-- create LBUF structure and the contents banks for N-tuple IDD
-*
- NDIM = IQ(LCID+ZNDIM)
- NWP = IABS(IQ(LCID+ZNPRIM))
-*
- IF (LQ(LCDIR-4) .EQ. 0) THEN
-*
-*-- enough space left for buffer header structure?
-*
- NTOT = NDIM+2+33
- CALL HSPACE(NTOT,'HNBUFR',IDD)
- IF (IERR.NE.0) GOTO 50
-*
- CALL MZBOOK(IHDIV,LBUFM,LCDIR,-4,'HBUF',NDIM,NDIM,2,2,0)
- LBUF = LBUFM
- IQ(LBUF-5) = IDD
-*
- ELSEIF (IQ(LBUF-5) .NE. IDD) THEN
-*
-*-- find buffer bank for ntuple IDD
-*
- LBUF = LQ(LCDIR-4)
- 10 IF (IQ(LBUF-5) .EQ. IDD) GOTO 20
- IF (LQ(LBUF) .NE. 0) THEN
- LBUF = LQ(LBUF)
- GOTO 10
- ENDIF
-*
-*-- no buffer structure for this ntuple; create it but
-*-- first check if there is enough space left?
-*
- NTOT = NDIM+2+33
- CALL HSPACE(NTOT,'HNBUFR',IDD)
- IF (IERR.NE.0) GOTO 50
-*
- CALL MZBOOK(IHDIV,LBUF,LBUF,0,'HBUF',NDIM,NDIM,2,2,0)
- IQ(LBUF-5) = IDD
- ENDIF
-*
-*-- Create contents banks for the variables that will be retrieved
-*-- (i.e. for all variables of which the restore address is set).
-*--
-*-- If the Ntuple is memory resident read the whole column from disk
-*-- (memory resident means that the Ntuple columns were stored completely
-*-- in memory and then written in one piece to disk).
-*
- 20 MEMORY = IQ(LCID+ZNPRIM) .LE. 0
-*
-*-- if memory resident goto correct RZ directory
-*
- IF (MEMORY) THEN
- NCHRZ = IQ(LCID+ZNCHRZ)
- CALL RZCDIR(CWDRZ,'R')
- CALL HCDIR(CHWOLD,'R')
- CHDIR = ' '
- CALL UHTOC(IQ(LCID+ZNCHRZ+1),4,CHDIR,NCHRZ)
- IF (CHDIR.NE.CWDRZ) THEN
- CALL HCDIR(CHDIR,' ')
- ENDIF
- KEYS(1) = IQ(LCID+ZID)
- ENDIF
-*
-*-- loop over all blocks
-*
- LBLOK = LQ(LCID-1)
- LCHAR = LQ(LCID-2)
- LINT = LQ(LCID-3)
- LREAL = LQ(LCID-4)
-*
- 30 LNAME = LQ(LBLOK-1)
-*
- IOFF = 0
- NDIM = IQ(LBLOK+ZNDIM)
-*
-*-- loop over all variables in every block
-*
- DO 40 I = 1, NDIM
- LCIND = IQ(LNAME+IOFF+ZLCONT)
- IADD = IQ(LNAME+IOFF+ZNADDR)
- LB = LQ(LBUF-LCIND)
-*
- IF (IADD .EQ. 0) THEN
-*
-*-- drop existing bank at LB, only when modify bit is not set
-*
- IF (LB .NE. 0) THEN
- IF (JBIT(IQ(LB),1) .EQ. 0) THEN
- CALL MZDROP(IHDIV,LB,' ')
- LQ(LBUF-LCIND) = 0
- ENDIF
- ENDIF
-*
- ELSEIF (MEMORY .AND. LB.EQ.0) THEN
- KEYS(2) = IQ(LNAME+IOFF+ZNRZB)*10000 +
- + IQ(LNAME+IOFF+ZLCONT)
-*
-*-- check if there is enough space to read in the entire structure
-*
- CALL HRZIN(IHDIV,0,0,KEYS,ICYCLE,'C')
- IF (IQUEST(1) .NE. 0) THEN
- CALL HBUG('Error reading contents bank', 'HNBUFR', IDD)
- IERR = 1
- GOTO 50
- ENDIF
- NWORDS = IQUEST(12)
- CALL HSPACE(NWORDS+1000,'HNBUFR',IDD)
- IF (IERR .NE. 0) GOTO 50
-*
-*-- read in contents
-*
- CALL HRZIN(IHDIV,LBUF,-LCIND,KEYS,ICYCLE,' ')
-*
- ELSEIF (LB .EQ. 0) THEN
- NTOT = NWP+33
- CALL HSPACE(NTOT,'HNBUFR',IDD)
- IF (IERR.NE.0) GOTO 50
-*
- CALL MZBOOK(IHDIV,L,LBUF,-LCIND,'HCON',0,0,NWP,1,-1)
-*
- ENDIF
-*
- IOFF = IOFF + ZNADDR
- 40 CONTINUE
-*
- LBLOK = LQ(LBLOK)
- IF (LBLOK .NE. 0) GOTO 30
-*
- IF (MEMORY) THEN
- IF (CHDIR.NE.CWDRZ) THEN
- CALL HCDIR(CHWOLD,' ')
- IF (CHWOLD .NE. CWDRZ) THEN
- CALL RZCDIR(CWDRZ,' ')
- ENDIF
- ENDIF
- ENDIF
-*
-*-- create and set TMP buffers
-*
- CALL HNTMP(IDD)
-*
- 50 RETURN
- END
-
diff --git a/src/packlib/hbook/hntup/hndesc.F b/src/packlib/hbook/hntup/hndesc.F
deleted file mode 100644
index 3437c90..0000000
--- a/src/packlib/hbook/hntup/hndesc.F
+++ /dev/null
@@ -1,39 +0,0 @@
-*
-* $Id: hndesc.F,v 1.1.1.1 1996/01/16 17:07:59 mclareni Exp $
-*
-* $Log: hndesc.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:59 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.20/08 07/09/93 19.44.33 by Fons Rademakers
-*-- Author : Fons Rademakers 07/09/93
- SUBROUTINE HNDESC(IOFF, NSUB, ITYPE, ISIZE, NBITS, INDVAR)
-*.==========>
-*.
-*. Return information stored in the Ntuple descriptor word.
-*.
-*..=========> ( A.A.Rademakers )
-*
-#include "hbook/hcntpar.inc"
-#include "hbook/hcnt.inc"
-#include "hbook/hcbook.inc"
-*
- LOGICAL INDVAR
-*
-#include "hbook/jbyt.inc"
-*
- NSUB = JBYT(IQ(LNAME+IOFF+ZDESC), 18, 3)
- ITYPE = JBYT(IQ(LNAME+IOFF+ZDESC), 14, 4)
- ISIZE = JBYT(IQ(LNAME+IOFF+ZDESC), 8, 6)
- NBITS = JBYT(IQ(LNAME+IOFF+ZDESC), 1, 7)
-*
- INDVAR = .FALSE.
- IF (JBIT(IQ(LNAME+IOFF+ZDESC),28) .EQ. 1) INDVAR = .TRUE.
-*
-*-- fix the NBITS for character variables (7 bits was not enough)
-*
- IF (ITYPE .EQ. 5) NBITS = IBIPB*ISIZE
-*
- END
diff --git a/src/packlib/hbook/hntup/hnform.F b/src/packlib/hbook/hntup/hnform.F
deleted file mode 100644
index adc8365..0000000
--- a/src/packlib/hbook/hntup/hnform.F
+++ /dev/null
@@ -1,309 +0,0 @@
-*
-* $Id: hnform.F,v 1.3 1996/10/11 13:23:44 cernlib Exp $
-*
-* $Log: hnform.F,v $
-* Revision 1.3 1996/10/11 13:23:44 cernlib
-* replace tabs by equivalent spaces
-*
-* Revision 1.2 1996/09/27 07:30:10 cernlib
-* Linux mods in string concatenation calling HBUG
-*
-* Revision 1.1.1.1 1996/01/16 17:08:00 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 10/11/95 12.04.30 by Julian Bunn
-*-- Author : Julian Bunn 06/04/95
- SUBROUTINE HNFORM(CHFORM,CHNAME,LDIM,CHTYPE,XLOW,XHIGH)
-C----------------------------------------------------------------------
-C! -
-C!
-C! Author :- Julian J. Bunn 3-APR-1995
-C!
-C! Inputs:
-C! - CHFORM : Character string to be started or appended to
-C! CHNAME : Name of the Fortran variable to be described
-C! Can include dimensions with placeholders, e.g.
-C! FRED() will be translated to FRED([LDIM])
-C! FRED(*) will be translated to FRED([LDIM])
-C! FRED(*,NY) will be translated to FRED([LDIM],NY)
-C! FRED(10,10) will be left as-is
-C! For each * placeholder, there must be a integer
-C! value passed in the array LDIM.
-C! LDIM : Dimension(s) of the variable (if not in CHNAME)
-C! 0 ==> not dimensioned
-C! Pass an array of integers if there is more than
-C! one * placeholder in CHNAME
-C! CHTYPE : Type and range of the variable
-C! [R,I,U,L,C] [*[4,,32]] [:n]
-C! ' ' ==> Fortran default will be used
-C! XLOW : Lower limit on the range of the Fortran variable
-C! XHIGH : Upper limit on the range of the Fortran variable
-C! If XHIGH <= XLOW no range will be encoded
-C!
-C! Outputs:
-C! -
-C! CHFORM : New character string with the extra information for
-C! HBNAME, HBNAMC appended (after a comma if necessary)
-C!
-C! Externals required: LENOCC HBUG
-C!
-C! Description
-C! ===========
-C!
-C! Assists the formation of the CHFORM character string for HBNAME/HBNAMC
-C! E.g. for COMMON /EVENT/ NEVT,TRACK(20)
-C!
-C! CHFORM = ' '
-C!
-C! CALL HNFORM(CHFORM,'TRACK()',20,'R',0.,0.)
-C! results in CHFORM = 'TRACK(20):R'
-C!
-C! CALL HNFORM(CHFORM,'NEVT',0,'I:5',0.,100.)
-C! results in CHFORM = 'TRACK(20):R,NEVT[0.,100.]:I:5'
-C!
-C! For a full description, see the HBOOK manual
-C?
-C!======================================================================
- PARAMETER (LFMAX=15)
- CHARACTER*(*) CHFORM,CHNAME
- CHARACTER*(*) CHTYPE
- CHARACTER*(LFMAX) CUSER
- CHARACTER*100 CTEMP,CTEMP1
- INTEGER LDIM(*)
- LOGICAL ISINT
- REAL XLOW,XHIGH
-C
- LFORM = LENOCC(CHFORM)
- LAVAIL = LEN(CHFORM)
- LTYPE = LENOCC(CHTYPE)
-C
-C CHECK FOR SUFFICIENT SPACE IN CHFORM STRING
-C
- IF(LAVAIL.LE.LFORM) THEN
- CALL HBUG('+Insufficient space in CHFORM','HNFORM',0)
- GOTO 999
- ENDIF
-C
-C CHECK RECOGNIZED CHTYPE
-C
- IF(LTYPE.GT.0.AND.INDEX('RIULCriulc',CHTYPE(:1)).EQ.0) THEN
- CTEMP=CHTYPE
- CALL HBUG('+Unrecognised type '//CTEMP(:LTYPE),'HNFORM',0)
- GOTO 999
- ENDIF
-C
-C CHECK ALLOWED SIZE
-C
- IF(LTYPE.GT.1) THEN
- IF(CHTYPE(2:2).NE.'*'.AND.CHTYPE(2:2).NE.':') THEN
- CALL HBUG('+Invalid size descriptor','HNFORM',0)
- GOTO 999
- ENDIF
-C
-C TAKE CARE OF PACKING SPECS
-C
- LTC = INDEX(CHTYPE,':')-1
- IF(LTC.EQ.-1) LTC = LTYPE
- IF(LTC.EQ.3) THEN
- READ(CHTYPE(3:3),'(I1)') NBYTE
- ELSE IF(LTC.EQ.4) THEN
- READ(CHTYPE(3:4),'(I2)') NBYTE
- ELSE
- CTEMP=CHTYPE
- CALL HBUG('+Cannot find byte length '//CTEMP(:LTYPE),
- & 'HNFORM',0)
- GOTO 999
- ENDIF
- IF(MOD(NBYTE,4).NE.0.OR.NBYTE.GT.32) THEN
- CTEMP=CHTYPE
- CALL HBUG('+Byte length is bad in '//CTEMP(:LTYPE),
- & 'HNFORM',0)
- GOTO 999
- ENDIF
- IF((CHTYPE(1:1).NE.'C'.AND.CHTYPE(1:1).NE.'c').AND.
- & NBYTE.GT.8) THEN
- CALL HBUG('+Only *4 or *8 size is allowed','HNFORM',0)
- GOTO 999
- ENDIF
- ENDIF
-C
-C APPEND A COMMA IF NOT THE FIRST DESCRIPTOR AND ENOUGH SPACE
-C
- IF(LFORM.NE.0) THEN
- CHFORM = CHFORM(:LFORM)//','
- LFORM = LFORM+1
- ENDIF
-C
-C TAKE THE BLANKS OUT OF CHNAME
-C
- LNAME = 0
- DO 4 I=1,LENOCC(CHNAME)
- IF(CHNAME(I:I).NE.' ') THEN
- LNAME = LNAME+1
- CTEMP(LNAME:LNAME) = CHNAME(I:I)
- ENDIF
- 4 CONTINUE
-C
-C DETERMINE IF AN INTEGER (FOR RANGE FORMATTING)
-C
- ISINT = .FALSE.
- IF(INDEX(CHTYPE,'U').NE.0.OR.INDEX(CHTYPE,'u').NE.0) THEN
- ISINT = .TRUE.
- ELSE IF(INDEX(CHTYPE,'I').NE.0.OR.INDEX(CHTYPE,'i').NE.0) THEN
- ISINT = .TRUE.
- ELSE
- ISINT = LGE(CTEMP(1:1),'I').AND.LLE(CTEMP(1:1),'N')
- ISINT = ISINT.OR.(LGE(CTEMP(1:1),'i').AND.LLE(CTEMP(1:1),'n'))
- ENDIF
-C
-C GET THE DIMENSIONALITY
-C
- NDIM = 0
- IBRAB = INDEX(CTEMP(:LNAME),'(')
- IBRAE = INDEX(CTEMP(:LNAME),')')
- IF(IBRAB.GT.0) THEN
- IF(IBRAE.EQ.0) THEN
- CALL HBUG('+Missing end bracket in variable '
- & //CTEMP(:LNAME),'HNFORM',0)
- GOTO 999
- ENDIF
- IF(LFORM+IBRAB.GT.LAVAIL) THEN
- CALL HBUG('+Insufficient space in CHFORM','HNFORM',0)
- GOTO 999
- ENDIF
- CHFORM = CHFORM(:LFORM)//CTEMP(:IBRAB)
- LFORM = LFORM + IBRAB
-C
-C FIND THE NUMBER OF DIMENSIONS FOR THE VARIABLE
-C
- NDIM = 1
- DO 1 IPOS=IBRAB+1,IBRAE-1
- IF(CTEMP(IPOS:IPOS).EQ.',') NDIM = NDIM+1
- 1 CONTINUE
- IPOS = IBRAB+1
-C
-C NOW INTERPRET EACH DIMENSION AS FIXED OR VARIABLE
-C
- IDIM = 0
- IDIMG = 0
- 2 IDIM = IDIM + 1
- IF(IDIM.LE.NDIM) THEN
- IEND = INDEX(CTEMP(IPOS:LNAME),',') + IPOS - 2
- IF(IEND.EQ.IPOS-2) IEND = IBRAE-1
- IF(LFORM+IEND-IPOS+1.GT.LAVAIL) THEN
- CALL HBUG('+Insufficient space in CHFORM','HNFORM',0)
- GOTO 999
- ENDIF
- IF(CTEMP(IPOS:IEND).EQ.'*'.OR.IPOS.EQ.IEND+1) THEN
-C
-C THE USER WANTS US TO CALCULATE THE DIMENSION STRING ...
-C
- IDIMG = IDIMG + 1
- IVAL = LDIM(IDIMG)
- WRITE(CUSER,'(I15.15)') IVAL
- INZ = 0
- 3 INZ = INZ+1
- IF(INZ.LT.LFMAX) THEN
- IF(CUSER(INZ:INZ).EQ.'0') GOTO 3
- ENDIF
- CHFORM = CHFORM(:LFORM)//CUSER(INZ:LFMAX)//
- & CTEMP(IEND+1:IEND+1)
- LFORM = LFORM + LFMAX + 2 - INZ
- ELSE
-C
-C CHECK WHETHER THE GIVEN DIMENSION IS A VARIABLE OR NUMERIC
-C
- IF((LLT(CTEMP(IPOS:IPOS),'0').OR.
- & LGT(CTEMP(IPOS:IPOS),'9')).AND.IDIM.NE.NDIM) THEN
- CALL HBUG('+Only the last dimension may vary in '//
- & CTEMP(:LNAME),'HNFORM',0)
- GOTO 999
- ENDIF
- CHFORM = CHFORM(:LFORM)//CTEMP(IPOS:IEND+1)
- LFORM = LFORM + IEND - IPOS + 2
- ENDIF
- IPOS = IEND + 2
- GOTO 2
- ENDIF
- ELSE
-C
-C THE VARIABLE IS NOT DIMENSIONED
-C
- IF(LFORM+LNAME.GT.LAVAIL) THEN
- CALL HBUG('+Insufficient space in CHFORM','HNFORM',0)
- GOTO 999
- ENDIF
- CHFORM = CHFORM(:LFORM)//CTEMP(:LNAME)
- LFORM = LFORM+LNAME
- ENDIF
-C
- IF(XHIGH.GT.XLOW) THEN
-C
-C LIMITS HAVE BEEN SPECIFIED
-C
- IF(ISINT) THEN
- WRITE(CUSER,'(I15.15)') NINT(XLOW)
- INZ = 0
- 6 INZ = INZ+1
- IF(INZ.LT.LFMAX) THEN
- IF(CUSER(INZ:INZ).EQ.'0') GOTO 6
- ENDIF
- CTEMP1 = '['//CUSER(INZ:)//','
- LTEMP1 = LFMAX - INZ + 3
- WRITE(CUSER,'(I15.15)') NINT(XHIGH)
- INZ = 0
- 7 INZ = INZ+1
- IF(INZ.LT.LFMAX) THEN
- IF(CUSER(INZ:INZ).EQ.'0') GOTO 7
- ENDIF
- CTEMP1 = CTEMP1(:LTEMP1)//CUSER(INZ:)//']'
- LTEMP1 = LTEMP1 + LFMAX - INZ + 2
- ELSE
- WRITE(CUSER,'(F15.5)') XLOW
- INZ = 0
- 8 INZ = INZ+1
- IF(INZ.LT.10) THEN
- IF(CUSER(INZ:INZ).EQ.' ') GOTO 8
- ENDIF
- INU = LFMAX + 1
- 9 INU = INU-1
- IF(INU.GT.10) THEN
- IF(CUSER(INU:INU).EQ.'0') GOTO 9
- ENDIF
- CTEMP1 = '['//CUSER(INZ:INU)//','
- LTEMP1 = 3 + INU-INZ
- WRITE(CUSER,'(F15.5)') XHIGH
- INZ = 0
- 10 INZ = INZ+1
- IF(INZ.LT.10) THEN
- IF(CUSER(INZ:INZ).EQ.' ') GOTO 10
- ENDIF
- INU = LFMAX + 1
- 11 INU = INU-1
- IF(INU.GT.10) THEN
- IF(CUSER(INU:INU).EQ.'0') GOTO 11
- ENDIF
- CTEMP1 = CTEMP1(:LTEMP1)//CUSER(INZ:INU)//']'
- LTEMP1 = LTEMP1 + INU-INZ + 2
- ENDIF
- IF(LFORM+LTEMP1.GT.LAVAIL) THEN
- CALL HBUG('+Insufficient space in CHFORM','HNFORM',0)
- GOTO 999
- ENDIF
- CHFORM = CHFORM(:LFORM)//CTEMP1(:LTEMP1)
- LFORM = LFORM+LTEMP1
- ENDIF
-C
-C APPEND THE TYPE IF ENOUGH SPACE
-C
- IF(CHTYPE.NE.' ') THEN
- IF(LFORM+LTYPE.GT.LAVAIL) THEN
- CALL HBUG('+Insufficient space in CHFORM','HNFORM',0)
- GOTO 999
- ENDIF
- CHFORM = CHFORM(:LFORM)//':'//CHTYPE(:LTYPE)
- ENDIF
- 999 CONTINUE
- END
diff --git a/src/packlib/hbook/hntup/hnhdwr.F b/src/packlib/hbook/hntup/hnhdwr.F
deleted file mode 100644
index fc2ce21..0000000
--- a/src/packlib/hbook/hntup/hnhdwr.F
+++ /dev/null
@@ -1,61 +0,0 @@
-*
-* $Id: hnhdwr.F,v 1.1.1.1 1996/01/16 17:07:59 mclareni Exp $
-*
-* $Log: hnhdwr.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:59 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.19/02 14/05/93 14.05.15 by Fons Rademakers
-*-- Author : Fons Rademakers 14/05/93
- SUBROUTINE HNHDWR(IDD)
-*.==========>
-*.
-*. Write header structure of N-tuple IDD.
-*. For the data-structure description see routine HBNT.
-*.
-*. This routine assumes that LCID is pointing to the right Ntuple.
-*.
-*..=========> ( A.A.Rademakers )
-*
-#include "hbook/hcntpar.inc"
-#include "hbook/hcflag.inc"
-#include "hbook/hcbook.inc"
-*
- CHARACTER*128 CHWOLD, CHDIR, CWDRZ
- INTEGER KEYS(2)
-*
- IERR = 0
-*
-*-- goto the correct RZ directory
-*
- NCHRZ = IQ(LCID+ZNCHRZ)
- CALL RZCDIR(CWDRZ,'R')
- CALL HCDIR(CHWOLD,'R')
- CHDIR = ' '
- CALL UHTOC(IQ(LCID+ZNCHRZ+1),4,CHDIR,NCHRZ)
- IF (CHDIR.NE.CWDRZ) THEN
- CALL HCDIR(CHDIR,' ')
- ENDIF
-*
- LC = LQ(LCID-1)
- IF (JBIT(IQ(LC),1) .NE. 0) THEN
- CALL SBIT0(IQ(LC),1)
- CALL SBIT0(IQ(LC),2)
- KEYS(1) = IDD
- KEYS(2) = 0
- CALL HRZOUT(IHDIV,LCID,KEYS,ICYCLE,' ')
- CALL RZSAVE
- ENDIF
-*
-*-- go back to current working directory
-*
- IF (CHDIR.NE.CWDRZ) THEN
- CALL HCDIR(CHWOLD,' ')
- IF (CHWOLD .NE. CWDRZ) THEN
- CALL RZCDIR(CWDRZ,' ')
- ENDIF
- ENDIF
-*
- END
diff --git a/src/packlib/hbook/hntup/hnmadr.F b/src/packlib/hbook/hntup/hnmadr.F
deleted file mode 100644
index e8459ff..0000000
--- a/src/packlib/hbook/hntup/hnmadr.F
+++ /dev/null
@@ -1,81 +0,0 @@
-*
-* $Id: hnmadr.F,v 1.1.1.1 1996/01/16 17:07:58 mclareni Exp $
-*
-* $Log: hnmadr.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:58 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.20/08 07/09/93 19.26.34 by Fons Rademakers
-*-- Author : Fons Rademakers 19/12/91
- SUBROUTINE HNMADR(VAR1, IADD, ISCHAR)
-*.==========>
-*.
-*. Set the address for the variable VAR in the LNAME bank starting
-*. at address IADD. If VAR='*' set the addresses of all variables
-*. in the LNAME bank. If ISCHAR is TRUE set the addresses for
-*. character variables.
-*.
-*..=========> ( A.A.Rademakers )
-*
-#include "hbook/hcntpar.inc"
-#include "hbook/hcnt.inc"
-#include "hbook/hcbook.inc"
-*
- CHARACTER*(*) VAR1
- CHARACTER*32 NAME, VAR
- INTEGER IADD
- LOGICAL ISCHAR, ALL, LDUM
-*
- VAR = VAR1
- CALL CLTOU(VAR)
- LVAR = LENOCC(VAR)
- ALL = .FALSE.
- IF (VAR(1:1).EQ.'*' .AND. LVAR.EQ.1) ALL = .TRUE.
-*
- IOFF = 0
- NDIM = IQ(LBLOK+ZNDIM)
-*
- DO 30 I = 1, NDIM
- CALL HNDESC(IOFF, NSUB, ITYPE, ISIZE, NBITS, LDUM)
- LL = IQ(LNAME+IOFF+ZLNAME)
- LV = IQ(LNAME+IOFF+ZNAME)
- NAME = ' '
- CALL UHTOC(IQ(LCHAR+LV), 4, NAME, LL)
- CALL CLTOU(NAME)
-*
- IF (.NOT.ALL .AND. VAR(1:LVAR).NE.NAME(1:LL)) GOTO 20
- IF (ISCHAR .AND. ITYPE.NE.5) GOTO 20
- IF (.NOT.ISCHAR .AND. ITYPE.EQ.5) GOTO 20
-*
- IELEM = 1
- DO 10 J = 1, NSUB
- LP = IQ(LINT+IQ(LNAME+IOFF+ZARIND)+(J-1))
- IF (LP .LT. 0) THEN
- IE = -LP
- ELSE
- LL = IQ(LNAME+LP-1+ZRANGE)
- IE = IQ(LINT+LL+1)
- ENDIF
- IELEM = IELEM*IE
- 10 CONTINUE
-*
- IADDW = ISHFT(IADD, -2)
- IBYOF = IAND(IADD, IBYPW-1)
-*
- IF (IBYOF .NE. 0) GOTO 40
-*
- IQ(LNAME+IOFF+ZNADDR) = IADDW - LOCF(IQ(1))
- IADD = IADD + IELEM*ISIZE
-*
- 20 IOFF = IOFF + ZNADDR
- 30 CONTINUE
-*
- RETURN
-*
- 40 PRINT *, 'Variable ', NAME(1:LENOCC(NAME))
- CALL HBUG('Address not word aligned','HBNAME',ID)
- RETURN
-*
- END
diff --git a/src/packlib/hbook/hntup/hnmptr.F b/src/packlib/hbook/hntup/hnmptr.F
deleted file mode 100644
index 3aef1b4..0000000
--- a/src/packlib/hbook/hntup/hnmptr.F
+++ /dev/null
@@ -1,47 +0,0 @@
-*
-* $Id: hnmptr.F,v 1.1.1.1 1996/01/16 17:07:58 mclareni Exp $
-*
-* $Log: hnmptr.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:58 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.17/00 26/05/92 18.44.33 by Fons Rademakers
-*-- Author : Fons Rademakers 19/12/91
- INTEGER FUNCTION HNMPTR(TVAR)
-*.==========>
-*.
-*. Return a pointer to the first word of the variable VAR
-*. in the LNAME bank. If VAR is not found then return -1.
-*.
-*..=========> ( A.A.Rademakers )
-*
-#include "hbook/hcntpar.inc"
-#include "hbook/hcbook.inc"
-*
- CHARACTER*(*) TVAR
- CHARACTER*32 VAR, NAME
-*
- VAR = TVAR
- CALL CLTOU(VAR)
- LVAR = LENOCC(VAR)
- NDIM = IQ(LBLOK+ZNDIM)
- IOFF = 0
-*
- DO 10 I = 1, NDIM
- LL = IQ(LNAME+IOFF+ZLNAME)
- LV = IQ(LNAME+IOFF+ZNAME)
- NAME = ' '
- CALL UHTOC(IQ(LCHAR+LV), 4, NAME, LL)
- CALL CLTOU(NAME)
- IF (VAR(1:LVAR) .EQ. NAME(1:LL)) THEN
- HNMPTR = IOFF
- RETURN
- ENDIF
- IOFF = IOFF + ZNADDR
-10 CONTINUE
-*
- HNMPTR = -1
-*
- END
diff --git a/src/packlib/hbook/hntup/hnmset.F b/src/packlib/hbook/hntup/hnmset.F
deleted file mode 100644
index c54c321..0000000
--- a/src/packlib/hbook/hntup/hnmset.F
+++ /dev/null
@@ -1,57 +0,0 @@
-*
-* $Id: hnmset.F,v 1.1.1.1 1996/01/16 17:07:58 mclareni Exp $
-*
-* $Log: hnmset.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:58 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.17/00 13/05/92 11.23.56 by Fons Rademakers
-*-- Author : Fons Rademakers 19/12/91
- SUBROUTINE HNMSET(IDD, ITEM, IVAL)
-*.==========>
-*.
-*. Set in N-tuple IDD in the LNAME banks in all blocks
-*. the ITEM to IVAL.
-*.
-*..=========> ( A.A.Rademakers )
-*
-#include "hbook/hcntpar.inc"
-#include "hbook/hcflag.inc"
-#include "hbook/hcbook.inc"
-*
- ID = IDD
- IDPOS = LOCATI(IQ(LTAB+1),IQ(LCDIR+KNRH),ID)
- IF (IDPOS .LE. 0) THEN
- CALL HBUG('Unknown N-tuple','HNMSET',IDD)
- RETURN
- ENDIF
-*
- LCID=LQ(LTAB-IDPOS)
-*
-*-- loop over all blocks
-*
- LBLOK = LQ(LCID-1)
- LCHAR = LQ(LCID-2)
- LINT = LQ(LCID-3)
- LREAL = LQ(LCID-4)
-*
-10 LNAME = LQ(LBLOK-1)
-*
-*-- loop over all variables in LNAME
-*
- IOFF = 0
- NDIM = IQ(LBLOK+ZNDIM)
-*
- DO 20 I = 1, NDIM
-*
- IQ(LNAME+IOFF+ITEM) = IVAL
-*
- IOFF = IOFF + ZNADDR
-20 CONTINUE
-*
- LBLOK = LQ(LBLOK)
- IF (LBLOK .NE. 0) GOTO 10
-*
- END
diff --git a/src/packlib/hbook/hntup/hnpart.F b/src/packlib/hbook/hntup/hnpart.F
deleted file mode 100644
index b106ffa..0000000
--- a/src/packlib/hbook/hntup/hnpart.F
+++ /dev/null
@@ -1,73 +0,0 @@
-*
-* $Id: hnpart.F,v 1.1.1.1 1996/01/16 17:07:58 mclareni Exp $
-*
-* $Log: hnpart.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:58 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.17/00 27/02/92 14.44.30 by Fons Rademakers
-*-- Author : Fons Rademakers 17/12/91
- SUBROUTINE HNPART(DESC, PART, NPART, MAXPAR, IERR)
-*.==========>
-*.
-*. Decode a variable description in its individual parts.
-*. There can be maximal 4 parts for reals and (un)signed integers
-*. IVAR:TYPE*SIZE:BITS:[range]
-*. and 2 parts for logicals and characters:
-*. CVAR:TYPE*SIZE
-*.
-*..=========> ( A.A.Rademakers )
-*
- CHARACTER*(*) DESC, PART(*)
- INTEGER NPART, MAXPAR, IERR
- CHARACTER*1 DELIM
- PARAMETER (DELIM = ':')
- LOGICAL PAREN
-*
- IERR = 0
- NPART = 0
- PAREN = .FALSE.
-*
- LD = LENOCC(DESC)
-*
- I1 = 1
- DO 10 I = 1, LD
- IF (DESC(I:I) .EQ. '(') PAREN = .TRUE.
- IF (DESC(I:I) .EQ. ')') PAREN = .FALSE.
- IF (DESC(I:I) .EQ. DELIM) THEN
- IF (PAREN) THEN
- IERR = 1
- RETURN
- ELSE
- NPART = NPART + 1
- IF (NPART .GT. MAXPAR) THEN
- IERR = 2
- RETURN
- ENDIF
- IF (I1 .EQ. I) THEN
- PART(NPART) = ' '
- ELSE
- PART(NPART) = DESC(I1:I-1)
- ENDIF
- IF (I .EQ. LD) GOTO 10
- I1 = I + 1
- ENDIF
- ENDIF
- IF (I .EQ. LD) THEN
- IF (PAREN) THEN
- IERR = 1
- RETURN
- ELSE
- NPART = NPART + 1
- IF (NPART .GT. MAXPAR) THEN
- IERR = 2
- RETURN
- ENDIF
- PART(NPART) = DESC(I1:LD)
- ENDIF
- ENDIF
-10 CONTINUE
-*
- END
diff --git a/src/packlib/hbook/hntup/hnsize.F b/src/packlib/hbook/hntup/hnsize.F
deleted file mode 100644
index 269a71a..0000000
--- a/src/packlib/hbook/hntup/hnsize.F
+++ /dev/null
@@ -1,85 +0,0 @@
-*
-* $Id: hnsize.F,v 1.1.1.1 1996/01/16 17:07:58 mclareni Exp $
-*
-* $Log: hnsize.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:58 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.20/08 07/09/93 19.35.57 by Fons Rademakers
-*-- Author : Fons Rademakers 28/01/93
- SUBROUTINE HNSIZE(ICOL, LCOL, CCOL)
-*.==========>
-*.
-*. Returns the number of columns currently stored in the
-*. Ntuple. ICOL is the number of real, (unsigned) integer
-*. and logical columns, LCOL is the number of real*8 columns
-*. and CCOL is the number of character variable columns.
-*. This routine is used in HNTNAM to see if the user does not
-*. define more columns than can be analyzed by PAW. Hbook itself
-*. does not impose any Ntuple size limits.
-*.
-*..=========> ( A.A.Rademakers )
-*
-#include "hbook/hcntpar.inc"
-#include "hbook/hcbook.inc"
-*
- INTEGER ICOL, LCOL, CCOL
- LOGICAL LDUM
-*
-*-- save block address (not in link area but in this routine no
-*-- relocation should happen so it will be ok)
-*
- LOLDBL = LBLOK
-*
- LBLOK = LQ(LCID-1)
-*
- ICOL = 0
- LCOL = 0
- CCOL = 0
-*
-*-- loop over all blocks
-*
- 10 LNAME = LQ(LBLOK-1)
-*
- NDIM = IQ(LBLOK+ZNDIM)
- IOFF = 0
-*
- DO 20 I = 1, NDIM
-*
- CALL HNDESC(IOFF, NSUB, ITYPE, ISIZE, NBITS, LDUM)
- IELEM = 1
- DO 25 J = 1, NSUB
- LP = IQ(LINT+IQ(LNAME+IOFF+ZARIND)+(J-1))
- IF (LP .LT. 0) THEN
- IE = -LP
- ELSE
- LL = IQ(LNAME+LP-1+ZRANGE)
- IE = IQ(LINT+LL+1)
- ENDIF
- IELEM = IELEM*IE
- 25 CONTINUE
-*
- IOFF = IOFF + ZNADDR
-*
- IF (ITYPE .NE. 5) THEN
- IF (ISIZE .EQ. 4) THEN
- ICOL = ICOL + IELEM
- ELSEIF (ISIZE .EQ. 8) THEN
- LCOL = LCOL + IELEM
- ENDIF
- ELSE
- CCOL = CCOL + IELEM
- ENDIF
- 20 CONTINUE
-*
- LBLOK = LQ(LBLOK)
- IF (LBLOK .NE. 0) GOTO 10
-*
-*-- restore block address
-*
- LBLOK = LOLDBL
- LNAME = LQ(LBLOK-1)
-*
- END
diff --git a/src/packlib/hbook/hntup/hntdel.F b/src/packlib/hbook/hntup/hntdel.F
deleted file mode 100644
index 53d5257..0000000
--- a/src/packlib/hbook/hntup/hntdel.F
+++ /dev/null
@@ -1,69 +0,0 @@
-*
-* $Id: hntdel.F,v 1.1.1.1 1996/01/16 17:07:59 mclareni Exp $
-*
-* $Log: hntdel.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:59 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.22/13 28/09/94 08.25.32 by Fons Rademakers
-*-- Author : Fons Rademakers 28/01/94
- SUBROUTINE HNTDEL(CHDIR)
-*.==========>
-*.
-*. Delete from //PAWC all Ntuple headers from Ntuples that
-*. reside in file CHDIR. Don't remove memory resident
-*. Ntuples. This routine does not (yet) scan all subdirectories
-*. in //PAWC.
-*.
-*..=========> ( A.A.Rademakers )
-*
-#include "hbook/hcntpar.inc"
-#include "hbook/hcbook.inc"
-#include "hbook/hcflag.inc"
-*
- CHARACTER*(*) CHDIR
- CHARACTER*128 CHRZ
-*
-*-- Loop over all objects in the current directory in memory
-*
- LC = LENOCC(CHDIR)
- IDPOS=0
-*
- 10 IDPOS=IDPOS+1
- IF(IDPOS.GT.IQ(LCDIR+KNRH))RETURN
- ID =IQ(LTAB+IDPOS)
- LCID=LQ(LTAB-IDPOS)
- IF(ID.EQ.0.OR.LCID.EQ.0)RETURN
-*
- IF (JBIT(IQ(LCID+KBITS),4) .EQ. 0) GOTO 10
-*
- IF (IQ(LCID-2) .NE. ZLINK) THEN
-*
-*-- RWNtuple
-*
- NCHRZ = IQ(LCID+11)
- ICHRZ = 12
- ELSE
-*
-*-- CWNtuple
-*
- NCHRZ = IQ(LCID+ZNCHRZ)
- ICHRZ = ZNCHRZ+1
- ENDIF
-*
-*-- Memory resident
-*
- IF (NCHRZ .LE. 0) GOTO 10
-*
- CHRZ = ' '
- CALL UHTOC(IQ(LCID+ICHRZ),4,CHRZ,NCHRZ)
- IF (CHDIR(1:LC) .EQ. CHRZ(3:LC+2)) THEN
- CALL HDELET(ID)
- IDPOS=IDPOS-1
- ENDIF
-*
- GOTO 10
-*
- END
diff --git a/src/packlib/hbook/hntup/hntdim.F b/src/packlib/hbook/hntup/hntdim.F
deleted file mode 100644
index 1039abd..0000000
--- a/src/packlib/hbook/hntup/hntdim.F
+++ /dev/null
@@ -1,81 +0,0 @@
-*
-* $Id: hntdim.F,v 1.1.1.1 1996/01/16 17:07:59 mclareni Exp $
-*
-* $Log: hntdim.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:59 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.19/00 31/03/93 14.36.19 by Fons Rademakers
-*-- Author : Fons Rademakers 31/03/93
- SUBROUTINE HNTDIM(TVAR, NVDIM, IVDIM, MXVDIM)
-*.==========>
-*.
-*. Returns the number of dimensions (NVDIM) and the
-*. dimensions (IVDIM) of the variable TVAR.
-*. MXVDIM gives the size of the array IVDIM (the maximum
-*. number of dimensions an Ntuple variable may have is 7).
-*.
-*..=========> ( A.A.Rademakers )
-*
-#include "hbook/hcntpar.inc"
-#include "hbook/hcbook.inc"
-*
- CHARACTER*(*) TVAR
- CHARACTER*32 VAR, NAME
- INTEGER IVDIM(*)
-*
-*-- save block address (not in link area but in this routine no
-*-- relocation should happen so it will be ok)
-*
- LOLDBL = LBLOK
-*
- VAR = TVAR
- CALL CLTOU(VAR)
- LVAR = LENOCC(VAR)
- LBLOK = LQ(LCID-1)
-*
- CALL VZERO(IVDIM, MXVDIM)
- NVDIM = 0
-*
-*-- loop over all blocks
-*
- 10 LNAME = LQ(LBLOK-1)
-*
- NDIM = IQ(LBLOK+ZNDIM)
- IOFF = 0
-*
- DO 20 I = 1, NDIM
- LL = IQ(LNAME+IOFF+ZLNAME)
- LV = IQ(LNAME+IOFF+ZNAME)
- NAME = ' '
- CALL UHTOC(IQ(LCHAR+LV), 4, NAME, LL)
- CALL CLTOU(NAME)
- IF (VAR(1:LVAR) .EQ. NAME(1:LL)) THEN
-*
- NSUB = JBYT(IQ(LNAME+IOFF+ZDESC), 18, 3)
- DO 25 J = 1, NSUB
- IF (J .GT. MXVDIM) GOTO 25
- LP = IQ(LINT+IQ(LNAME+IOFF+ZARIND)+(J-1))
- IF (LP .LT. 0) THEN
- IVDIM(J) = -LP
- ELSE
- LL = IQ(LNAME+LP-1+ZRANGE)
- IVDIM(J) = IQ(LINT+LL+1)
- ENDIF
- 25 CONTINUE
-*
- NVDIM = NSUB
- GOTO 30
- ENDIF
- IOFF = IOFF + ZNADDR
- 20 CONTINUE
-*
- LBLOK = LQ(LBLOK)
- IF (LBLOK .NE. 0) GOTO 10
-*
- 30 LBLOK = LOLDBL
- LNAME = LQ(LBLOK-1)
-*
- END
diff --git a/src/packlib/hbook/hntup/hntdup.F b/src/packlib/hbook/hntup/hntdup.F
deleted file mode 100644
index 4dce72c..0000000
--- a/src/packlib/hbook/hntup/hntdup.F
+++ /dev/null
@@ -1,207 +0,0 @@
-*
-* $Id: hntdup.F,v 1.3 1997/02/21 12:15:48 couet Exp $
-*
-* $Log: hntdup.F,v $
-* Revision 1.3 1997/02/21 12:15:48 couet
-* -previous commit was wrong
-*
-* Revision 1.2 1997/02/21 12:12:48 couet
-* *** empty log message ***
-*
-* Revision 1.1.1.1 1996/01/16 17:07:59 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.23/01 09/01/95 13.00.35 by Fons Rademakers
-*-- Author : Fons Rademakers 31/05/94
- SUBROUTINE HNTDUP(ID1, ID2, NEWBUF, CHTITL, CHOPT1)
-*.==========>
-*.
-*. Duplicate definition of an Ntuple. A new Ntuple ID2 is created
-*. with the same definitions as ID1, but with 0 entries.
-*.
-*. ID1 is the original id, ID2 the new
-*. NEWBUF <0 use buffer size of ID1
-*. NEWBUF =0 use current buffer size(10000 for RWN's)
-*. NEWBUF >0 use NEWBUF as buffer size
-*. CHTITL the new title, when blank use original,
-*. CHOPT1=' ' use original value (disk or memory resident)
-*. CHOPT1='M' to make the Ntuple memory resident
-*. CHOPT1='A' interactive mode: Sets addresses to /PAWCR4/
-*.
-*..=========> ( A.A.Rademakers )
-*
-#include "hbook/hcntpar.inc"
-#include "hbook/hcflag.inc"
-#include "hbook/hcbook.inc"
-#include "hbook/hcset.inc"
-*
- INTEGER ID1, ID2, MXVAR,NEWBUF
- PARAMETER (MXVAR = 512)
- REAL RLOW(MXVAR), RHIGH(MXVAR)
- REAL*8 IDUM
- CHARACTER*(*) CHTITL, CHOPT1
- CHARACTER*4 CDUM
- CHARACTER*8 CHOPT,CHOPT2, BLOCK, TAGS(MXVAR)
- CHARACTER*80 CHTIT, CHRZ
- LOGICAL MEMORY, NTOLD
- DIMENSION IOPT(3)
- EQUIVALENCE (IOPT(1),IOPTA),(IOPT(2),IOPTM)
-*
-*-- check if ID1 already in table, if not it should be read in first
-*
- CHOPT2=CHOPT1
- CALL HUOPTC(CHOPT2,'AM',IOPT)
- CALL HFIND(ID1,'HNTDUP')
- IF(LCID.EQ.0)RETURN
- ID=ID1
- I4 = JBIT(IQ(LCID+KBITS),4)
- IF (I4 .EQ. 0) RETURN
- IF (IQ(LCID-2) .NE. ZLINK) THEN
- NTOLD = .TRUE.
- ELSE
- NTOLD = .FALSE.
- ENDIF
-*
-*-- Ntuple will be created in the current directory
-*
- CALL HCDIR(CHRZ, 'R')
-*
-*-- Handle RWN's
-*
- IF (NTOLD) THEN
-*
- NCHRZ = IQ(LCID+11)
- NWPRIM = IQ(LCID+4)
- MEMORY = .FALSE.
- IF (NCHRZ .EQ. 0) MEMORY = .TRUE.
-*
-*-- get type (disk or memory resident)
-*
- IF (IOPTM.EQ.0) THEN
- IF (MEMORY) CHRZ = ' '
- ELSE
- CHRZ = ' '
- ENDIF
-*
-*-- set primary allocation
-*
- IF (NEWBUF.EQ.0) NWPRIM = 10000
- IF (NEWBUF.GT.0) NWPRIM = NEWBUF
-*
-*-- get title and column definition
-*
- NVAR = MXVAR
- CALL HGIVEN(ID1, CHTIT, NVAR, TAGS, RLOW, RHIGH)
- IF (CHTITL .NE. ' ') CHTIT = CHTITL
-*
-*-- define RWN
-*
- CALL HBOOKN(ID2, CHTIT, NVAR, CHRZ, NWPRIM, TAGS)
-*
- RETURN
- ENDIF
-*
-*-- Handle CWN's
-*
-*-- Duplicate disk resident Ntuple may not have the same ID (without offset)
-*-- as the original when in the same directory. A memory resident Ntuple
-*-- may not have the same ID (since we can't control where it will be written
-*-- and we want to prevent the user from overwriting the original).
-*
- NDIM = IQ(LCID+ZNDIM)
- NCHRZ = IQ(LCID+ZNCHRZ)
- NWPRIM = IQ(LCID+ZNPRIM)
- IF (NCHRZ.NE.0 .AND. NWPRIM.GT.0) THEN
- MEMORY = .FALSE.
- CHTIT = ' '
- CALL UHTOC(IQ(LCID+ZNCHRZ+1), 4, CHTIT, NCHRZ)
- IF (CHTIT.EQ.CHRZ .AND. IQ(LCID+ZID).EQ.ID2) THEN
- CALL HBUG('Duplicate can not have given ID','HNTDUP',ID2)
- RETURN
- ENDIF
- ELSE
- MEMORY = .TRUE.
- IF (IQ(LCID+ZID) .EQ. ID2) THEN
- CALL HBUG('Duplicate can not have given ID','HNTDUP',ID2)
- RETURN
- ENDIF
- ENDIF
-*
-*-- get title if not overriden
-*
- IF (CHTITL .EQ. ' ') THEN
- CHTIT = ' '
- ITIT1 = IQ(LCID+ZITIT1)
- NWTIT = IQ(LCID+ZNWTIT)
- CALL UHTOC(IQ(LCID+ITIT1), 4, CHTIT, 4*NWTIT)
- ELSE
- CHTIT = CHTITL
- ENDIF
-*
-*-- get type (disk or memory resident)
-*
- IF (IOPTM.EQ.0) THEN
- IF (MEMORY) THEN
- CHOPT = 'M'
- ELSE
- CHOPT = 'D'
- ENDIF
- ELSE
- CHOPT = CHOPT1
- ENDIF
-*
-*-- Set the buffer size
-*
- IBOLD=IBSIZE
- IF (NEWBUF.EQ.0) NWPRIM = IBSIZE
- IF (NEWBUF.GT.0) NWPRIM = NEWBUF
- IF (NEWBUF.GE.0) IBSIZE = NWPRIM
-*
-*-- create duplicate Ntuple header
-*
- CALL HBNT(ID2, CHTIT, CHOPT)
- IBSIZE=IBOLD
-*
-*-- get pointer to new Ntuple
-*
- IDPOS = LOCATI(IQ(LTAB+1),IQ(LCDIR+KNRH),ID2)
- IF (IDPOS .LE. 0) THEN
- CALL HBUG('Unknown Ntuple','HNTDUP',ID2)
- RETURN
- ENDIF
- LR2 = LQ(LTAB-IDPOS)
-*
-*-- use the original buffer size
-*
- IF (NEWBUF.LT.0) THEN
- IF (CHOPT .EQ. 'D') THEN
- IQ(LR2+ZNPRIM) = IABS(NWPRIM)
- ELSE
- IQ(LR2+ZNPRIM) = -IABS(NWPRIM)
- ENDIF
- ENDIF
-*
-*-- get definition of original columns and call HBNAME for each of them
-*-- NOTE: addresses are dummy and need to be reset before using the Ntuple
-*
- DO 10 I = 1, NDIM
- CALL HNTVDEF(ID1, I, CHTIT, BLOCK, ITYPE)
- IF (ITYPE .NE. 5) THEN
- CALL HBNAME(ID2, BLOCK, IDUM, CHTIT)
- ELSE
- CALL HBNAMC(ID2, BLOCK, CDUM, CHTIT)
- ENDIF
- IF(IOPTA.NE.0)THEN
- CALL HNTVAR(ID1, I, CHTIT, BLOCK, NSUB, IT, IS, IE)
- CALL HNTGET(ID1, CHTIT, INDD, IT, IS, IE, IERROR)
- CALL HNTGET(ID2, CHTIT, INDD, IT, IS, IE, IERROR)
- ENDIF
-10 CONTINUE
-*
-*-- reset addresses
-*
- IF(IOPTA.EQ.0)CALL HNMSET(ID2, ZNADDR, 0)
-*
- END
diff --git a/src/packlib/hbook/hntup/hntget.F b/src/packlib/hbook/hntup/hntget.F
deleted file mode 100644
index 2e0fc72..0000000
--- a/src/packlib/hbook/hntup/hntget.F
+++ /dev/null
@@ -1,112 +0,0 @@
-*
-* $Id: hntget.F,v 1.1.1.1 1996/01/16 17:07:58 mclareni Exp $
-*
-* $Log: hntget.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:58 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.22/14 06/10/94 16.48.31 by Fons Rademakers
-*-- Author : Fons Rademakers 24/06/92
- SUBROUTINE HNTGET(ID1, TVAR, INDX, ITYPE, ISIZE, IELEM, IER)
-*.==========>
-*.
-*. Returns for variable VAR in N-tuple ID the array index INDX
-*. in one of the arrays PAWCR8, PAWCR4, PAWC32 depending on the
-*. type ITYPE and the size ISIZE (in bytes) of the variable.
-*. IELEM returns the number of words taken by the variable.
-*. IELEM=1 for a scalar and >1 for an array.
-*. If the variable VAR does not exist then IER<>0.
-*.
-*..=========> ( A.A.Rademakers )
-*
-#include "hbook/hcntpar.inc"
-#include "hbook/hcntpaw.inc"
-#include "hbook/hcbits.inc"
-#include "hbook/hcflag.inc"
-#include "hbook/hcbook.inc"
-*
- CHARACTER*(*) TVAR
- CHARACTER*8 BLOCK
- CHARACTER*32 VAR, NAME
- INTEGER INDCR4, INDCR8, INDC32
-*
- ID = ID1
- IDPOS = LOCATI(IQ(LTAB+1),IQ(LCDIR+KNRH),ID)
- IF (IDPOS .LE. 0) THEN
- CALL HBUG('Unknown N-tuple','HNTGET',ID1)
- IER = 1
- RETURN
- ENDIF
- LCID = LQ(LTAB-IDPOS)
- I4 = JBIT(IQ(LCID+KBITS),4)
- IF (I4 .EQ. 0) THEN
- CALL HBUG('Not an N-tuple','HNTGET',ID)
- IER = 1
- RETURN
- ENDIF
- IF (IQ(LCID-2) .NE. ZLINK) THEN
- CALL HBUG('Old N-tuple, cannot use HNTGET','HNTGET',ID)
- IER = 1
- RETURN
- ENDIF
-*
- IER = 0
- VAR = TVAR
- CALL CLTOU(VAR)
-*
- INDCR4 = 1
- INDCR8 = 1
- INDC32 = 1
-*
- NDIM = IQ(LCID+ZNDIM)
-*
-*-- Loop over all variables till we find the one we want.
-*
-*-- Increment in the meanwhile the INDC.. counters in the same way as we
-*-- do in HWPDCL (so there is a correct match between the COMMON
-*-- statements in the routine produced by HUWFUN and the actual COMMON blocks
-*-- in which the variables are returned
-*
- DO 10 I = 1, NDIM
-*
- CALL HNTVAR(ID, I, NAME, BLOCK, NSUB, ITYPE, ISIZE, IELEM)
- CALL CLTOU(NAME)
-*
- IF (VAR .EQ. NAME) THEN
- IF (ITYPE .NE. 5) THEN
- IF (ISIZE .EQ. 4) THEN
- CALL HBNAME(ID, BLOCK, RVAR4(INDCR4), '$SET:'//VAR)
- INDX = INDCR4
- ELSEIF (ISIZE .EQ. 8) THEN
- CALL HBNAME(ID, BLOCK, RVAR8(INDCR8), '$SET:'//VAR)
- INDX = INDCR8
- ENDIF
- ELSE
- DO 5 J = 1, IELEM
- CVAR32(INDC32+J-1) = ' '
- 5 CONTINUE
- CALL HBNAMC(ID, BLOCK, CVAR32(INDC32), '!SET:'//VAR)
- INDX = INDC32
- ENDIF
-*
- RETURN
-*
- ELSE
- IF (ITYPE .NE. 5) THEN
- IF (ISIZE .EQ. 4) THEN
- INDCR4 = INDCR4 + IELEM
- ELSEIF (ISIZE .EQ. 8) THEN
- INDCR8 = INDCR8 + IELEM
- ENDIF
- ELSE
- INDC32 = INDC32 + IELEM
- ENDIF
- ENDIF
-*
- 10 CONTINUE
-*
- IER = 2
-*
- END
diff --git a/src/packlib/hbook/hntup/hntgeti.F b/src/packlib/hbook/hntup/hntgeti.F
deleted file mode 100644
index f06168c..0000000
--- a/src/packlib/hbook/hntup/hntgeti.F
+++ /dev/null
@@ -1,113 +0,0 @@
-*
-* $Id: hntgeti.F,v 1.1.1.1 1996/01/16 17:07:59 mclareni Exp $
-*
-* $Log: hntgeti.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:59 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.21/08 23/01/94 18.26.37 by Fons Rademakers
-*-- Author : Fons Rademakers 23/01/94
- SUBROUTINE HNTGETI(ID1,ICOM,INDX,TVAR,ITYPE,ISIZE,IELEM,IER)
-*.==========>
-*.
-*. Depending on the common (PAWCR8, PAWCR4, PAWC32) and the
-*. array index in this common this routine returns the variable
-*. VAR in Ntuple ID and the type ITYPE and the size ISIZE
-*. (in bytes) of the variable. IELEM returns the number of words
-*. taken by the variable. IELEM=1 for a scalar and >1 for an array.
-*. If index is not legal for this common and Ntuple then IER<>0.
-*.
-*..=========> ( A.A.Rademakers )
-*
-#include "hbook/hcntpar.inc"
-#include "hbook/hcntpaw.inc"
-#include "hbook/hcbits.inc"
-#include "hbook/hcflag.inc"
-#include "hbook/hcbook.inc"
-*
- CHARACTER*(*) TVAR
- CHARACTER*8 BLOCK
- CHARACTER*32 VAR
- INTEGER INDCR4, INDCR8, INDC32
-*
- ID = ID1
- IDPOS = LOCATI(IQ(LTAB+1),IQ(LCDIR+KNRH),ID)
- IF (IDPOS .LE. 0) THEN
- CALL HBUG('Unknown Ntuple','HNTGETI',ID1)
- IER = 1
- RETURN
- ENDIF
- LCID = LQ(LTAB-IDPOS)
- I4 = JBIT(IQ(LCID+KBITS),4)
- IF (I4 .EQ. 0) THEN
- CALL HBUG('Not an Ntuple','HNTGETI',ID)
- IER = 1
- RETURN
- ENDIF
- IF (IQ(LCID-2) .NE. ZLINK) THEN
- CALL HBUG('Old Ntuple, cannot use HNTGETI','HNTGETI',ID)
- IER = 1
- RETURN
- ENDIF
-*
- IF (ICOM.NE.4 .AND. ICOM.NE.8 .AND. ICOM.NE.32) THEN
- CALL HBUG('Illegal value for ICOM','HNTGETI',ID)
- IER = 1
- RETURN
- ENDIF
-*
- IER = 0
-*
- INDCR4 = 1
- INDCR8 = 1
- INDC32 = 1
-*
- NDIM = IQ(LCID+ZNDIM)
-*
-*-- Loop over all variables till we find the index we want.
-*
-*-- Increment in the meanwhile the INDC.. counters in the same way as we
-*-- do in HWPDCL (so there is a correct match between the COMMON
-*-- statements in the routine produced by HUWFUN and the actual COMMON blocks
-*-- in which the variables are returned
-*
- DO 10 I = 1, NDIM
-*
- CALL HNTVAR(ID, I, VAR, BLOCK, NSUB, ITYPE, ISIZE, IELEM)
- CALL CLTOU(VAR)
-*
- IF (ITYPE .NE. 5) THEN
- IF (ISIZE .EQ. 4) THEN
- IF (ICOM .NE. 4) GOTO 10
- IF (INDX .EQ. INDCR4) THEN
- TVAR = VAR
- RETURN
- ELSE
- INDCR4 = INDCR4 + IELEM
- ENDIF
- ELSEIF (ISIZE .EQ. 8) THEN
- IF (ICOM .NE. 8) GOTO 10
- IF (INDX .EQ. INDCR8) THEN
- TVAR = VAR
- RETURN
- ELSE
- INDCR8 = INDCR8 + IELEM
- ENDIF
- ENDIF
- ELSE
- IF (ICOM .NE. 32) GOTO 10
- IF (INDX .EQ. INDC32) THEN
- TVAR =VAR
- RETURN
- ELSE
- INDC32 = INDC32 + IELEM
- ENDIF
- ENDIF
-*
- 10 CONTINUE
-*
- IER = 2
-*
- END
diff --git a/src/packlib/hbook/hntup/hntmp.F b/src/packlib/hbook/hntup/hntmp.F
deleted file mode 100644
index a3a834d..0000000
--- a/src/packlib/hbook/hntup/hntmp.F
+++ /dev/null
@@ -1,88 +0,0 @@
-*
-* $Id: hntmp.F,v 1.1.1.1 1996/01/16 17:07:58 mclareni Exp $
-*
-* $Log: hntmp.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:58 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.21/08 28/01/94 15.15.22 by Fons Rademakers
-*-- Author : Fons Rademakers 28/04/92
- SUBROUTINE HNTMP(IDD)
-*.==========>
-*.
-*. Temporary buffers for new (variable row length) N-tuples.
-*. For the data-structure description see routine HBNT.
-*.
-*. This routine creates and finds the tmp buffers for N-tuple ID.
-*.
-*..=========> ( A.A.Rademakers )
-*
-#include "hbook/hcntpar.inc"
-#include "hbook/hcflag.inc"
-#include "hbook/hcbook.inc"
-*
- NDIM = IQ(LCID+ZNDIM)
- NW = 1 + ZNTMP*NDIM
-*
-*-- create LTMP structure for N-tuple IDD
-*
- IF (LQ(LCDIR-5) .EQ. 0) THEN
-*
-*-- enough space left?
-*
- NW1 = 1 + ZNTMP1*NDIM
- NTOT = NW + NW1 + NDIM + 2*33
- CALL HSPACE(NTOT,'HNTMP',IDD)
- IF (IERR.NE.0) GOTO 70
- IDLAST = IDD
-*
- CALL MZBOOK(IHDIV,LTMPM,LCDIR,-5,'HTMP',2,1,NW,2,1)
- LTMP = LTMPM
- IQ(LTMP-5) = IDD
- CALL MZBOOK(IHDIV,LTMP1,LTMP,-1,'HTMP1',NDIM,0,NW1,2,-1)
-*
- ELSEIF (IQ(LTMP-5) .NE. IDD) THEN
-*
-*-- find tmp bank for ntuple IDD
-*
- LTMP = LQ(LCDIR-5)
- 20 IF (IQ(LTMP-5) .EQ. IDD) GOTO 40
- IF (LQ(LTMP) .NE. 0) THEN
- LTMP = LQ(LTMP)
- GOTO 20
- ENDIF
-*
-*-- no tmp structure for this ntuple; create them
-*-- first check if there is enough space left?
-*
- NW1 = 1 + ZNTMP1*NDIM
- NTOT = NW + NW1 + NDIM + 2*33
- CALL HSPACE(NTOT,'HNTMP',IDD)
- IF (IERR.NE.0) GOTO 70
- IDLAST = IDD
-*
- CALL MZBOOK(IHDIV,LTMP,LTMP,0,'HTMP',2,1,NW,2,1)
- IQ(LTMP-5) = IDD
- CALL MZBOOK(IHDIV,LTMP1,LTMP,-1,'HTMP1',NDIM,0,NW1,2,-1)
- ENDIF
-*
-*-- check if new variables were defined since previous call
-*
- 40 LTMP1 = LQ(LTMP-1)
- LQ(LTMP-2) = LCID
- NWP = IQ(LTMP-1)
- IF (NWP .NE. NW) THEN
- ND = NW - NWP
- CALL MZPUSH(IHDIV, LTMP, 0, ND, 'I')
- NWP = IQ(LTMP1-1)
- ND = 1+ZNTMP1*NDIM - NWP
- NLP = IQ(LTMP1-3)
- NL = NDIM - NLP
- CALL MZPUSH(IHDIV, LTMP1, NL, ND, 'I')
- ENDIF
-*
- 70 RETURN
- END
-
diff --git a/src/packlib/hbook/hntup/hntmpd.F b/src/packlib/hbook/hntup/hntmpd.F
deleted file mode 100644
index 86b1699..0000000
--- a/src/packlib/hbook/hntup/hntmpd.F
+++ /dev/null
@@ -1,51 +0,0 @@
-*
-* $Id: hntmpd.F,v 1.1.1.1 1996/01/16 17:07:58 mclareni Exp $
-*
-* $Log: hntmpd.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:58 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.21/08 28/01/94 17.02.41 by Fons Rademakers
-*-- Author : Fons Rademakers 28/04/92
- SUBROUTINE HNTMPD(IDD)
-*.==========>
-*.
-*. Drop temporary buffers.
-*. For the data-structure description see routine HBNT.
-*.
-*. This routine drops the temporary buffers for N-tuple ID.
-*.
-*..=========> ( A.A.Rademakers )
-*
-#include "hbook/hcbook.inc"
-*
- IF (LQ(LCDIR-5) .EQ. 0) RETURN
-*
- IF (IDD .EQ. 0) THEN
- CALL MZDROP(IHDIV,LQ(LCDIR-5),'L')
- LQ(LCDIR-5) = 0
- LTMPM = 0
- LTMP = 0
- ELSE
-*
-*-- find tmp buffer bank for ntuple IDD
-*
- LTMP = LQ(LCDIR-5)
- 20 IF (IQ(LTMP-5) .EQ. IDD) THEN
- CALL MZDROP(IHDIV,LTMP,' ')
- LTMP = LQ(LCDIR-5)
- GOTO 40
- ENDIF
- LTMP = LQ(LTMP)
- IF (LTMP .NE. 0) GOTO 20
-*
-*-- if buffers not found don't complain
-*
-** CALL HBUG('Unknown N-tuple','HNTMPD',IDD)
- RETURN
- ENDIF
-*
- 40 END
-
diff --git a/src/packlib/hbook/hntup/hntmpf.F b/src/packlib/hbook/hntup/hntmpf.F
deleted file mode 100644
index 8bd53db..0000000
--- a/src/packlib/hbook/hntup/hntmpf.F
+++ /dev/null
@@ -1,64 +0,0 @@
-*
-* $Id: hntmpf.F,v 1.1.1.1 1996/01/16 17:07:58 mclareni Exp $
-*
-* $Log: hntmpf.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:58 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.20/00 19/06/93 14.01.33 by Fons Rademakers
-*-- Author : Fons Rademakers 28/04/92
- SUBROUTINE HNTMPF(IDD, FATAL)
-*.==========>
-*.
-*. Fast finding of temporary buffers for new
-*. (variable row length) N-tuples. This routine may
-*. only be called by HNBUFF. It assumes that no new variables
-*. have been declared since the last call.
-*. For the data-structure description see routine HBNT.
-*.
-*. This routine finds the tmp buffers for N-tuple ID.
-*.
-*..=========> ( A.A.Rademakers )
-*
-#include "hbook/hcflag.inc"
-#include "hbook/hcbook.inc"
-*
- LOGICAL FATAL
-*
- IF (LQ(LCDIR-5) .EQ. 0) THEN
-*
-*-- this may not happen in HNTMPF
-*
- IF (FATAL) THEN
- CALL HBUG('Tmp structure not initialized.','HNTMPF',IDD)
- ENDIF
- IERR = 1
- RETURN
-*
- ELSEIF (IQ(LTMP-5) .NE. IDD) THEN
-*
-*-- find tmp bank for ntuple IDD
-*
- LTMP = LQ(LCDIR-5)
- 20 IF (IQ(LTMP-5) .EQ. IDD) THEN
- LTMP1 = LQ(LTMP-1)
- RETURN
- ENDIF
- IF (LQ(LTMP) .NE. 0) THEN
- LTMP = LQ(LTMP)
- GOTO 20
- ENDIF
-*
-*-- this may not happen either
-*
- IF (FATAL) THEN
- CALL HBUG('Tmp structure not found.','HNTMPF',IDD)
- ENDIF
- IERR = 1
- RETURN
- ENDIF
-*
- END
-
diff --git a/src/packlib/hbook/hntup/hntnam.F b/src/packlib/hbook/hntup/hntnam.F
deleted file mode 100644
index f53af08..0000000
--- a/src/packlib/hbook/hntup/hntnam.F
+++ /dev/null
@@ -1,606 +0,0 @@
-*
-* $Id: hntnam.F,v 1.2 1999/02/18 09:52:25 couet Exp $
-*
-* $Log: hntnam.F,v $
-* Revision 1.2 1999/02/18 09:52:25 couet
-* - the PART character array and related variables were too small (32).
-* They are now 80 characters. The error message generated was:
-*
-* ***** ERROR in HBNAME : Error in token
-*
-* Revision 1.1.1.1 1996/01/16 17:07:58 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 05/09/95 19.04.50 by Julian Bunn
-*-- Author : Fons Rademakers 17/12/91
- SUBROUTINE HNTNAM(TOK, IADD)
-*.==========>
-*.
-*. Decode a format token and store the information
-*. in the LNAME bank (and also LCHAR, LINT and LREAL banks).
-*.
-*..=========> ( A.A.Rademakers )
-*
-#include "hbook/hcntpar.inc"
-#include "hbook/hcnt.inc"
-#include "hbook/hcflag.inc"
-#include "hbook/hcbook.inc"
-#include "hbook/hcntpaw.inc"
-*
- COMMON /QUEST/ IQUEST(100)
-*
- CHARACTER*(*) TOK
- INTEGER IADD, ICOL, LCOL, CCOL
- CHARACTER*80 INDVAR
- PARAMETER (MAXPAR = 10)
- CHARACTER*80 PART(MAXPAR), NAME, RANGE, SUBS(MAXPAR), CDUM
- CHARACTER*8 BLOCK
- CHARACTER*12 STRINT
- PARAMETER (STRINT = 'IJKLMNijklmn')
- INTEGER NDIM, IOFF, LT, LP, IP, IB, IP2, IB2, ITYPE, ISIZE
- INTEGER NBITS, IMIN, IMAX, IDUM, IELEM, IS, I, LL, NSUB
- INTEGER L, J, IE, HNMPTR
- REAL FMIN, FMAX
-*
-#include "hbook/jbyt.inc"
-*
- IERR = 0
-*
- NDIM = IQ(LBLOK+ZNDIM)
- IOFF = IQ(LBLOK+ZIFNAM) - 1
-*
- LT = LENOCC(TOK)
- IF (LT .EQ. 0) GOTO 901
-*
- FMIN = 0.0
- FMAX = 0.0
- IMIN = 0
- IMAX = 0
- NSUB = 0
- IELEM = 1
- INDVAR = ' '
- RANGE = ' '
- DO 5 I = 1, 10
- PART(I) = ' '
- SUBS(I) = ' '
-5 CONTINUE
-*
-*-- get current size of Ntuple, print warning when more than MAXC..
-*-- columns are defined for any of the three sizes. This is a limit
-*-- imposed by PAW not HBOOK.
-*
- CALL HNSIZE(ICOL, LCOL, CCOL)
-*
-*-- find the different parts of the format token
-*
- CALL HNPART(TOK, PART, NPART, MAXPAR, IERR)
- IF (IERR .EQ. 1) GOTO 902
- IF (IERR .EQ. 2) GOTO 903
-*
-*-- too many parts
-*
- IF (NPART .GT. 4) GOTO 903
-*
-*-- part 1: contains the variable name and, possibly, an array
-*-- specification (either a number or a index variable) or
-*-- in case of an integer a range
-*
- LP = LENOCC(PART(1))
- IF (LP .EQ. 0) GOTO 904
-*
- IP = INDEX(PART(1), '(')
- IP2 = INDEX(PART(1), ')')
- IB = INDEX(PART(1), '[')
- IB2 = INDEX(PART(1), ']')
- IF (IP.EQ.0 .AND. IB.EQ.0) THEN
- NAME = PART(1)
- ENDIF
- IF (IP .NE. 0) THEN
- NAME = PART(1)(1:IP-1)
- IF (IP2.EQ.0 .OR. IP2.EQ.IP+1) GOTO 904
- INDVAR = PART(1)(IP+1:IP2-1)
- ENDIF
- IF (IB .NE. 0) THEN
- IF (IP2 .GT. IB) GOTO 904
- IF (IP .EQ. 0) NAME = PART(1)(1:IB-1)
- IF (IB2.EQ.0 .OR. IB2.EQ.IB+1) GOTO 904
- RANGE = PART(1)(IB+1:IB2-1)
- ENDIF
-*
-*-- has name already been defined in this Ntuple?
-*
- CALL HVXIST(NAME,BLOCK,CDUM,IDUM1,IDUM2,IDUM3)
- IF (IDUM3.NE.0) GOTO 913
-*
-*-- part 2: contains the type and size of the variable
-*
- LP = LENOCC(PART(2))
- IF (LP .EQ. 0) THEN
-*
-*-- take defaults depending on NAME
-*
- IF (INDEX(STRINT, NAME(1:1)) .NE. 0) THEN
- ITYPE = 2
- ISIZE = 4
- ELSE
- ITYPE = 1
- ISIZE = 4
- ENDIF
- ELSE
- CALL CLTOU(PART(2))
- IS = INDEX(PART(2), '*')
- IF ((IS.NE.0 .AND. IS.NE.2) .OR. IS.EQ.LP) GOTO 904
- IF (PART(2)(1:1) .EQ. 'R') THEN
- ITYPE = 1
- ELSEIF (PART(2)(1:1) .EQ. 'I') THEN
- ITYPE = 2
- ELSEIF (PART(2)(1:1) .EQ. 'U') THEN
- ITYPE = 3
- ELSEIF (PART(2)(1:1) .EQ. 'L') THEN
- ITYPE = 4
- ELSEIF (PART(2)(1:1) .EQ. 'C') THEN
- ITYPE = 5
- ELSE
- GOTO 905
- ENDIF
-*
- IF (IS .EQ. 0) THEN
- IF (LENOCC(PART(2)) .GT. 1) GOTO 925
- IF (ITYPE .EQ. 1) ISIZE = 4
- IF (ITYPE .EQ. 2) ISIZE = 4
- IF (ITYPE .EQ. 3) ISIZE = 4
- IF (ITYPE .EQ. 4) ISIZE = 4
- IF (ITYPE .EQ. 5) ISIZE = 4
- ELSE
- CALL HICTOI(PART(2)(IS+1:LP), ISIZE)
- ENDIF
- IF (ITYPE.EQ.1 .AND. (ISIZE.NE.4 .AND. ISIZE.NE.8)) GOTO 906
- IF (ITYPE.EQ.2 .AND. (ISIZE.NE.4 .AND. ISIZE.NE.8)) GOTO 906
- IF (ITYPE.EQ.3 .AND. (ISIZE.NE.4 .AND. ISIZE.NE.8)) GOTO 906
- IF (ITYPE.EQ.4 .AND. (ISIZE.NE.4)) GOTO 906
- IF (ITYPE.EQ.5 .AND. (ISIZE.LT.1 .OR. ISIZE.GT.32 .OR.
- + IAND(ISIZE, 3).NE.0)) GOTO 906
- ENDIF
-*
-*-- part 3: contains the packing bits (not for logicals or characters,
-*-- logicals are always packed in one bit)
-*
- LP = LENOCC(PART(3))
- IF (LP .EQ. 0) THEN
- NBITS = IBIPB*ISIZE
- IF (ITYPE .EQ. 4) NBITS = 1
- ELSE
- IF (ITYPE.EQ.4 .OR. ITYPE.EQ.5) GOTO 907
- CALL HICTOI(PART(3), NBITS)
- ENDIF
- IF (NBITS .GT. IBIPB*ISIZE) GOTO 919
-*
-*-- following features currently not implemented in HFNT2 and HGNT2:
-*-- Real, integer and unsigned integer packed double precision
-*
- IF (ITYPE.EQ.1 .AND. ISIZE.EQ.8 .AND. NBITS.LT.64) GOTO 918
- IF (ITYPE.EQ.2 .AND. ISIZE.EQ.8 .AND. NBITS.LT.64) GOTO 918
- IF (ITYPE.EQ.3 .AND. ISIZE.EQ.8 .AND. NBITS.LT.64) GOTO 918
-*
-*-- part 4: in case of an integer or real this part can contain the range
-* in case of a real the range may only be set when NBITS is set
-* for logical and characters this part may not be set
-*
- LP = LENOCC(PART(4))
- IF (LP .NE. 0) THEN
- IF (ITYPE.EQ.4 .OR. ITYPE.EQ.5) GOTO 908
- IF (ITYPE.EQ.1 .AND. NBITS.EQ.IBIPB*ISIZE) GOTO 910
- IB = INDEX(PART(4), '[')
- IF (IB .EQ. 0) GOTO 904
- IB2 = INDEX(PART(4),']')
- IF (IB2.EQ.0 .OR. IB2.EQ.IB-1) GOTO 904
- RANGE = PART(4)(IB+1:IB2-1)
- ENDIF
-*
-*-- check the range
-*
- IF (RANGE .NE. ' ') THEN
- IF (ITYPE.EQ.4 .OR. ITYPE.EQ.5) GOTO 908
- LP = LENOCC(RANGE)
- IS = INDEX(RANGE, ',')
- IF (IS.EQ.0 .OR. IS.EQ.1 .OR. IS.EQ.LP) GOTO 904
- IF (ITYPE .EQ. 1) THEN
- IF (NBITS .EQ. IBIPB*ISIZE) GOTO 910
- CALL HICTON(RANGE(1:IS-1), IDUM, FMIN)
- IF (IQUEST(1) .NE. 0) GOTO 904
- CALL HICTON(RANGE(IS+1:LP), IDUM, FMAX)
- IF (IQUEST(1) .NE. 0) GOTO 904
- IF (FMIN .GT. FMAX) GOTO 917
- ELSE
- CALL HICTOI(RANGE(1:IS-1), IMIN)
- CALL HICTOI(RANGE(IS+1:LP), IMAX)
-*
- IF (IABS(IMAX) .GT. IABS(IMIN)) THEN
- IMX = IABS(IMAX)
- ELSE
- IMX = IABS(IMIN)
- ENDIF
-*
- IF (IMIN .GT. IMAX) GOTO 917
-*
-*-- if manifest positive make it an unsigned integer
-*
- IF (IMIN.GE.0 .AND. IMAX.GE.0) ITYPE = 3
-*
- IF (ITYPE .EQ. 2) THEN
- ISIGN = 1
- ELSE
- ISIGN = 0
- IF (IMIN.LT.0 .OR. IMAX.LT.0) GOTO 916
- ENDIF
-*
- DO 10 I = 1, 32
- IF (IMX .LE. 2**I-1) GOTO 20
-10 CONTINUE
-20 IF (NBITS .EQ. IBIPB*ISIZE) NBITS = I + ISIGN
- IF (NBITS .LT. I+ISIGN) GOTO 911
- ENDIF
- ELSE
- IF (ITYPE.EQ.1 .AND. NBITS.NE.IBIPB*ISIZE) GOTO 929
- ENDIF
-*
-*-- check INDVAR (either a number or an index variable)
-*-- in case an index variable it must already be defined: find it
-*
- IF (INDVAR .NE. ' ') THEN
- CALL HNTTOK(INDVAR, SUBS, NSUB, MAXPAR, IERR)
- IF (IERR .NE. 0) GOTO 904
- IF (NSUB .GT. 7) GOTO 920
-*
-*-- check space in LINT bank
-*
- JMAX = IQ(LCID+ZIFINT)-1 + NSUB
- IF (JMAX .GT. IQ(LINT-1)) THEN
- CALL MZPUSH(IHDIV, LINT, 0, NSUB, 'I')
- ENDIF
-*
- J = IQ(LCID+ZIFINT)
- IQ(LNAME+IOFF+ZARIND) = J
- DO 25 I = 1, NSUB
- LP = LENOCC(SUBS(I))
- IF (ICHAR(SUBS(I)(1:1)) .GE. ICHAR('0') .AND.
- + ICHAR(SUBS(I)(1:1)) .LE. ICHAR('9')) THEN
- CALL HICTOI(SUBS(I), IE)
- IF (IQUEST(1) .NE. 0) GOTO 904
- IQ(LINT+J+(I-1)) = -IE
- IELEM = IELEM*IE
- ELSE
-*
-*-- only last dimension may be an index variable
-*
- IF (I .NE. NSUB) GOTO 921
-*
-*-- find the index variable
-*
- L = HNMPTR(SUBS(I)(1:LP))
- IF (L .LT. 0) GOTO 909
-*
-*-- check validity of index variable definition
-*-- 1) must be of type int (if type was unsigned over-rule)
-*-- 2) must be at least 4 bytes
-*-- 3) no array
-*-- 4) no packing allowed (if packing was specified over-rule)
-*
- ITIND = JBYT(IQ(LNAME+L+ZDESC), 14, 4)
- IF (ITIND .NE. 2 .AND. ITIND .NE. 3) GOTO 914
- IF (ITIND .EQ. 3) CALL SBYT(2, IQ(LNAME+L+ZDESC), 14, 4)
- ISIND = JBYT(IQ(LNAME+L+ZDESC), 8, 6)
- IF (ISIND .LT. 4) GOTO 915
- ISUIND = JBYT(IQ(LNAME+L+ZDESC), 18, 3)
- IF (ISUIND .GT. 0) GOTO 924
- CALL SBYT(IBIPB*ISIND, IQ(LNAME+L+ZDESC), 1, 7)
-*
-*-- set index variable bit
-*
- CALL SBIT1(IQ(LNAME+L+ZDESC), 28)
- IQ(LINT+J+(I-1)) = L+ZDESC
-*
-*-- get the the range of the index variable and add to IELEM
-*
- LL = IQ(LNAME+L+ZRANGE)
- IF (LL .EQ. 0) GOTO 922
-*
-*-- old version required lower limit to be 1, to be backward compatible
-*-- print a warning and change 1 to 0 (the new required lower limit)
-*
- IF (IQ(LINT+LL) .EQ. 1) THEN
- IQ(LINT+LL) = 0
- PRINT *, 'Variable ', SUBS(I)(1:LP)
- CALL HBUG('+Lower limit of range of index variable'//
- + ' changed from 1 to 0', 'HBNAME',ID)
- ENDIF
- IF (IQ(LINT+LL) .NE. 0) GOTO 923
- JMAX = IQ(LINT+LL+1)
- IELEM = IELEM*JMAX
- ENDIF
-25 CONTINUE
- IQ(LCID+ZIFINT) = IQ(LCID+ZIFINT) + NSUB
- ELSE
- IQ(LNAME+IOFF+ZARIND) = 0
- ENDIF
-*
-*-- print error when Ntuple gets too large to be analyzed by PAW
-*
- IF (ITYPE .NE. 5) THEN
- IF (ISIZE.EQ.4 .AND. ICOL+IELEM.GT.MAXCR4) GOTO 926
- IF (ISIZE.EQ.8 .AND. LCOL+IELEM.GT.MAXCR8) GOTO 927
- ELSE
- IF (CCOL+IELEM.GT.MAXC32) GOTO 928
- ENDIF
-*
-*-- make sure there is enough space in the LCHAR, LREAL and LINT banks
-*
- INEED = LENOCC(NAME)
- JMAX = IQ(LCID+ZIFCHA)-1 + INEED
- IF (JMAX .GT. IQ(LCHAR-1)) THEN
- CALL MZPUSH(IHDIV, LCHAR, 0, INEED, 'I')
- ENDIF
- INEED = 2
- JMAX = IQ(LCID+ZIFREA)-1 + INEED
- IF (JMAX .GT. IQ(LREAL-1)) THEN
- CALL MZPUSH(IHDIV, LREAL, 0, INEED, 'I')
- ENDIF
- JMAX = IQ(LCID+ZIFINT)-1 + INEED
- IF (JMAX .GT. IQ(LINT-1)) THEN
- CALL MZPUSH(IHDIV, LINT, 0, INEED, 'I')
- ENDIF
-*
-*-- fill the LNAME data structure for this variable
-*
-*-- in ZDESC: the ITYPE, ISIZE and NBITS
-*
-40 CALL SBYT(NSUB, IQ(LNAME+IOFF+ZDESC), 18, 3)
- CALL SBYT(ITYPE, IQ(LNAME+IOFF+ZDESC), 14, 4)
- CALL SBYT(ISIZE, IQ(LNAME+IOFF+ZDESC), 8, 6)
- CALL SBYT(NBITS, IQ(LNAME+IOFF+ZDESC), 1, 7)
-*
-*-- in ZLNAME: the length of the variable name
-*
- LL = LENOCC(NAME)
- IQ(LNAME+IOFF+ZLNAME) = LL
-*
-*-- in ZNAME: the pointer to the name in LCHAR
-*
- I = IQ(LCID+ZIFCHA)
- IQ(LNAME+IOFF+ZNAME) = I
- CALL UCTOH(NAME, IQ(LCHAR+I), 4, LL)
- IQ(LCID+ZIFCHA) = IQ(LCID+ZIFCHA) + (LL+3)/4
-*
-*-- in ZRANGE: the pointer to the range in the LREAL bank for reals
-*-- and in the LINT bank for integers
-*
- IF (RANGE.NE.' ' .AND. ITYPE.EQ.1) THEN
- I = IQ(LCID+ZIFREA)
- IQ(LNAME+IOFF+ZRANGE) = I
- Q(LREAL+I) = FMIN
- Q(LREAL+I+1) = FMAX
- IQ(LCID+ZIFREA) = IQ(LCID+ZIFREA) + 2
- ELSEIF (RANGE.NE.' ' .AND. (ITYPE.EQ.2 .OR. ITYPE.EQ.3)) THEN
- I = IQ(LCID+ZIFINT)
- IQ(LNAME+IOFF+ZRANGE) = I
- IQ(LINT+I) = IMIN
- IQ(LINT+I+1) = IMAX
- IQ(LCID+ZIFINT) = IQ(LCID+ZIFINT) + 2
- ELSE
- IQ(LNAME+IOFF+ZRANGE) = 0
- ENDIF
-*
-*-- number of RZ records or memory blocks used
-*
- IQ(LNAME+IOFF+ZNRZB) = 1
-*
-*-- contents buffer currently in memory
-*
- IQ(LNAME+IOFF+ZIBANK) = 1
-*
-*-- link position of contents bank in LBUF
-*
- IQ(LNAME+IOFF+ZLCONT) = IQ(LCID+ZNDIM) + 1
-*
-*-- pointer to first free word in contents bank
-*
- IQ(LNAME+IOFF+ZIFCON) = 2
-*
-*-- pointer to first free bit in first free word in contents bank
-*
- IQ(LNAME+IOFF+ZIFBIT) = 1
-*
-*-- in ZNADDR: the address of the first word of the variable
-*
- IF (ISIZE.EQ.8 .AND. ITYPE.NE.5) THEN
- IBYOF = IAND(IADD, (2*IBYPW)-1)
- IF (IBYOF .NE. 0) GOTO 930
- ELSE
- IBYOF = IAND(IADD, IBYPW-1)
- IF (IBYOF .NE. 0) GOTO 912
- ENDIF
-*
- IADDW = ISHFT(IADD, -2)
- IQ(LNAME+IOFF+ZNADDR) = IADDW - LOCF(IQ(1))
- IADD = IADD + IELEM*ISIZE
-*
- IQ(LBLOK+ZIFNAM) = IQ(LBLOK+ZIFNAM) + ZNADDR
- IQ(LBLOK+ZNDIM) = IQ(LBLOK+ZNDIM) + 1
- IQ(LCID+ZNDIM) = IQ(LCID+ZNDIM) + 1
-*
- RETURN
-*
-901 IERR = 1
- RETURN
-*
-902 IERR = 2
- PRINT *, 'Token ', TOK(1:LENOCC(TOK))
- CALL HBUG('Error in token','HBNAME',ID)
- RETURN
-*
-903 IERR = 3
- PRINT *, 'Token ', TOK(1:LENOCC(TOK))
- CALL HBUG('Error in token','HBNAME',ID)
- RETURN
-*
-904 IERR = 4
- PRINT *, 'Token ', TOK(1:LENOCC(TOK))
- CALL HBUG('Error in token','HBNAME',ID)
- RETURN
-*
-905 IERR = 5
- PRINT *, 'Variable ', NAME(1:LENOCC(NAME))
- CALL HBUG('Illegal variable type','HBNAME',ID)
- RETURN
-*
-906 IERR = 6
- PRINT *, 'Variable ', NAME(1:LENOCC(NAME))
- CALL HBUG('Illegal variable size','HBNAME',ID)
- RETURN
-*
-907 IERR = 7
- PRINT *, 'Variable ', NAME(1:LENOCC(NAME))
- CALL HBUG('Packing bits are not allowed for this type',
- + 'HBNAME',ID)
- RETURN
-*
-908 IERR = 8
- PRINT *, 'Variable ', NAME(1:LENOCC(NAME))
- CALL HBUG('Range description not allowed for this type',
- + 'HBNAME',ID)
- RETURN
-*
-909 IERR = 9
- PRINT *, 'Variable ', NAME(1:LENOCC(NAME))
- CALL HBUG('Index variable not yet defined',
- + 'HBNAME',ID)
- RETURN
-*
-910 IERR = 10
- PRINT *, 'Variable ', NAME(1:LENOCC(NAME))
- CALL HBUG('No packing bits have been specified',
- + 'HBNAME',ID)
- RETURN
-*
-911 IERR = 11
- PRINT *, 'Variable ', NAME(1:LENOCC(NAME))
- CALL HBUG('No. of packing bits incompatible with range '//
- + 'limits','HBNAME',ID)
- RETURN
-*
-912 IERR = 12
- PRINT *, 'Variable ', NAME(1:LENOCC(NAME))
- CALL HBUG('Address not word aligned','HBNAME',ID)
- RETURN
-*
-913 IERR = 13
- PRINT *, 'Variable ', NAME(1:LENOCC(NAME))
- CALL HBUG('Variable name already used in this Ntuple',
- + 'HBNAME',ID)
- RETURN
-*
-914 IERR = 14
- PRINT *, 'Variable ', SUBS(I)(1:LP)
- CALL HBUG('Index variable must be an integer','HBNAME',ID)
- RETURN
-*
-915 IERR = 15
- PRINT *, 'Variable ', SUBS(I)(1:LP)
- CALL HBUG('Index variable must be, at least, 4 bytes',
- + 'HBNAME',ID)
- RETURN
-*
-916 IERR = 16
- PRINT *, 'Variable ', NAME(1:LENOCC(NAME))
- CALL HBUG('Negative range limit not allowed for unsigned '//
- + 'integer','HBNAME',ID)
- RETURN
-*
-917 IERR = 17
- PRINT *, 'Variable ', NAME(1:LENOCC(NAME))
- CALL HBUG('Lower limit of range bigger than upper limit',
- + 'HBNAME',ID)
- RETURN
-*
-918 IERR = 18
- PRINT *, 'Variable ', NAME(1:LENOCC(NAME))
- CALL HBUG('Packed double precision not yet implemented',
- + 'HBNAME',ID)
- RETURN
-*
-919 IERR = 19
- PRINT *, 'Variable ', NAME(1:LENOCC(NAME))
- CALL HBUG('Packing bit specification incompatible with size',
- + 'HBNAME',ID)
- RETURN
-*
-920 IERR = 20
- PRINT *, 'Variable ', NAME(1:LENOCC(NAME))
- CALL HBUG('Variable may not have more than 7 dimensions',
- + 'HBNAME',ID)
- RETURN
-*
-921 IERR = 21
- PRINT *, 'Variable ', NAME(1:LENOCC(NAME))
- CALL HBUG('Only last dimension may be an index variable',
- + 'HBNAME',ID)
- RETURN
-*
-922 IERR = 22
- PRINT *, 'Variable ', SUBS(I)(1:LP)
- CALL HBUG('Index variable must have a range specification',
- + 'HBNAME',ID)
- RETURN
-*
-923 IERR = 23
- PRINT *, 'Variable ', SUBS(I)(1:LP)
- CALL HBUG('Lower limit of range of index variable must be 0',
- + 'HBNAME',ID)
- RETURN
-*
-924 IERR = 24
- PRINT *, 'Variable ', SUBS(I)(1:LP)
- CALL HBUG('Index variable may not be an array',
- + 'HBNAME',ID)
- RETURN
-*
-925 IERR = 25
- PRINT *, 'Variable ', NAME(1:LENOCC(NAME))
- CALL HBUG('Illegal variable size specification, use * separator',
- + 'HBNAME',ID)
- RETURN
-*
-926 IERR = 26
- PRINT *, 'Variable ', NAME(1:LENOCC(NAME))
- CALL HBUG('Ntuple can not have more than 50000 real*4, integer'//
- + ' or logical columns', 'HBNAME',ID)
- RETURN
-*
-927 IERR = 27
- PRINT *, 'Variable ', NAME(1:LENOCC(NAME))
- CALL HBUG('Ntuple can not have more than 1000 real*8 '//
- + 'columns', 'HBNAME',ID)
- RETURN
-*
-928 IERR = 28
- PRINT *, 'Variable ', NAME(1:LENOCC(NAME))
- CALL HBUG('Ntuple can not have more than 1000 character*32 '//
- + 'columns', 'HBNAME',ID)
- RETURN
-*
-929 IERR = 29
- PRINT *, 'Variable ', NAME(1:LENOCC(NAME))
- CALL HBUG('Packing bits specified without range',
- + 'HBNAME',ID)
- RETURN
-*
-930 IERR = 30
- PRINT *, 'Variable ', NAME(1:LENOCC(NAME))
- CALL HBUG('Address not double-word aligned','HBNAME',ID)
- RETURN
-*
- END
-
-
diff --git a/src/packlib/hbook/hntup/hntnew.F b/src/packlib/hbook/hntup/hntnew.F
deleted file mode 100644
index 60d8352..0000000
--- a/src/packlib/hbook/hntup/hntnew.F
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: hntnew.F,v 1.1.1.1 1996/01/16 17:07:58 mclareni Exp $
-*
-* $Log: hntnew.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:58 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.17/01 19/09/92 16.34.02 by Fons Rademakers
-*-- Author : Fons Rademakers 19/09/92
- LOGICAL FUNCTION HNTNEW(IDN)
-*.==========>
-*.
-*. Returns .TRUE. when new N-tuple, otherwise false.
-*.
-*..=========> ( A.A.Rademakers )
-*
-#include "hbook/hcntpar.inc"
-#include "hbook/hcbook.inc"
-*
- NIDN = LOCATI(IQ(LTAB+1),IQ(LCDIR+KNRH),IDN)
- IF (IQ(LQ(LTAB-NIDN)-2) .EQ. ZLINK) THEN
- HNTNEW = .TRUE.
- ELSE
- HNTNEW = .FALSE.
- ENDIF
-*
- END
diff --git a/src/packlib/hbook/hntup/hntrd.F b/src/packlib/hbook/hntup/hntrd.F
deleted file mode 100644
index 4339980..0000000
--- a/src/packlib/hbook/hntup/hntrd.F
+++ /dev/null
@@ -1,119 +0,0 @@
-*
-* $Id: hntrd.F,v 1.1.1.1 1996/01/16 17:07:58 mclareni Exp $
-*
-* $Log: hntrd.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:58 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.21/08 11/02/94 16.52.42 by Fons Rademakers
-*-- Author : Fons Rademakers 30/01/92
- SUBROUTINE HNTRD(INDX, IOFF, IBANK, IERROR)
-*.==========>
-*.
-*. Read the IBANK contents buffer from RZ file or from memory.
-*. For the data-structure description see routine HBNT.
-*.
-*..=========> ( A.A.Rademakers )
-*
-#include "hbook/hcntpar.inc"
-#include "hbook/hcbook.inc"
-#include "hbook/hcrecv.inc"
-*
- COMMON/QUEST/IQUEST(100)
- CHARACTER*128 CHWOLD, CHDIR, CWDRZ
- INTEGER KEYS(2)
-*
- IF (IQ(LNAME+IOFF+ZIBANK) .EQ. IBANK) THEN
- LR2 = LQ(LNAME-INDX)
- RETURN
- ENDIF
-*
- IERROR = 0
- IDD = IQ(LBUF-5)
- LCIND = IQ(LNAME+IOFF+ZLCONT)
-*
-* Load bank containing this event
-*
- IF (IQ(LCID+ZNPRIM) .LT. 0) THEN
- LR2 = LQ(LBUF-LCIND)
- DO 10 I = 2, IBANK
- IF (LQ(LR2) .NE. 0) LR2 = LQ(LR2)
- 10 CONTINUE
- IF (LR2 .EQ. 0) THEN
- CALL HBUG('Bank does not exist', 'HGNT', IDD)
- GOTO 90
- ENDIF
- ELSE
- IF (.NOT.NRECOV .AND. IBANK.GT.IQ(LNAME+IOFF+ZNRZB)) THEN
- CALL HBUG('Bank does not exist', 'HGNT', IDD)
- GOTO 90
- ENDIF
-*
-*-- goto the RZ directory where this N-tuple is stored
-*
- NCHRZ = IQ(LCID+ZNCHRZ)
- IF(NCHRZ.NE.0)THEN
- CALL RZCDIR(CWDRZ,'R')
- CALL HCDIR(CHWOLD,'R')
- CHDIR = ' '
- CALL UHTOC(IQ(LCID+ZNCHRZ+1),4,CHDIR,NCHRZ)
- IF (CHDIR.NE.CWDRZ) THEN
- CALL HCDIR(CHDIR,' ')
- ENDIF
- ENDIF
-*
- KEYS(1) = IQ(LCID+ZID)
- KEYS(2) = IBANK*10000 + IQ(LNAME+IOFF+ZLCONT)
-*
- IF (NRECOV) THEN
- CALL RZINK(KEYS,99999,'R')
- IF (IQUEST(1) .NE. 0) GOTO 90
- IQ(LNAME+IOFF+ZNRZB) = IBANK
-*
-*-- if index variable we have to read the buffer
-*
- IF (JBIT(IQ(LNAME+IOFF+ZDESC),28) .EQ. 1) THEN
- CALL HRZIN(IHDIV,LBUF,-LCIND,KEYS,99999,'R')
- IF (IQUEST(1) .NE. 0) GOTO 90
- ENDIF
- ELSE
-*
- CALL HRZIN(IHDIV,LBUF,-LCIND,KEYS,99999,'R')
-*-- Let us make another tentative (if written by a bad version of HBOOK)
- IF (IQUEST(1) .NE. 0) THEN
- KEYS(1) = 0
- IQUEST(1) = 0
- CALL HRZIN(IHDIV,LBUF,-LCIND,KEYS,99999,'R')
- ENDIF
- IF (IQUEST(1) .NE. 0) GOTO 90
-*-- Status word should be 0 when buffer comes from disk. However, in one
-*-- strange case (when coming from Piaf) it was not 0. Just to make sure
-*-- it is 0 add following statement.
- IQ(LQ(LBUF-LCIND)) = 0
- ENDIF
-*
-*-- go back to current directory
-*
- IF (NCHRZ.NE.0.AND.CHDIR .NE. CWDRZ) THEN
- CALL HCDIR(CHWOLD,' ')
- IF (CHWOLD .NE. CWDRZ) THEN
- CALL RZCDIR(CWDRZ,' ')
- ENDIF
- ENDIF
-*
- LR2 = LQ(LBUF-LCIND)
-*
- ENDIF
-*
- IQ(LNAME+IOFF+ZIBANK) = IBANK
- LQ(LNAME-INDX) = LR2
-*
- RETURN
-*
-*-- error
-*
-90 IERROR = 1
-*
-99 END
diff --git a/src/packlib/hbook/hntup/hntrng.F b/src/packlib/hbook/hntup/hntrng.F
deleted file mode 100644
index 1363d6c..0000000
--- a/src/packlib/hbook/hntup/hntrng.F
+++ /dev/null
@@ -1,86 +0,0 @@
-*
-* $Id: hntrng.F,v 1.1.1.1 1996/01/16 17:08:00 mclareni Exp $
-*
-* $Log: hntrng.F,v $
-* Revision 1.1.1.1 1996/01/16 17:08:00 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.23/01 26/10/94 17.36.14 by Fons Rademakers
-*-- Author : Fons Rademakers 26/10/94
- SUBROUTINE HNTRNG(TVAR, ILOW, IUP, IER)
-*.==========>
-*.
-*. Return the range of an integer VAR in this N-tuple.
-*. Returns IER=0 if range exists, IER=1, if (unsigned) integer
-*. but no range and IER=2 if not an (unsigned) integer.
-*. ILOW = IUP = 0 in case IER<>0.
-*.
-*..=========> ( A.A.Rademakers )
-*
-#include "hbook/hcntpar.inc"
-#include "hbook/hcbook.inc"
-*
- CHARACTER*(*) TVAR
- CHARACTER*32 VAR, NAME
- LOGICAL LDUM
-*
-*-- save block address (not in link area but in this routine no
-*-- relocation should happen so it will be ok)
-*
- LOLDBL = LBLOK
-*
- VAR = TVAR
- CALL CLTOU(VAR)
- LVAR = LENOCC(VAR)
- LBLOK = LQ(LCID-1)
- LCHAR = LQ(LCID-2)
- LINT = LQ(LCID-3)
- LREAL = LQ(LCID-4)
-*
- ILOW = 0
- IUP = 0
- IER = 0
-*
-*-- loop over all blocks
-*
- 10 LNAME = LQ(LBLOK-1)
-*
- NDIM = IQ(LBLOK+ZNDIM)
- IOFF = 0
-*
- DO 20 I = 1, NDIM
- LL = IQ(LNAME+IOFF+ZLNAME)
- LV = IQ(LNAME+IOFF+ZNAME)
- NAME = ' '
- CALL UHTOC(IQ(LCHAR+LV), 4, NAME, LL)
- CALL CLTOU(NAME)
- IF (VAR(1:LVAR) .EQ. NAME(1:LL)) THEN
-*
- CALL HNDESC(IOFF, NSUB, ITYPE, ISIZE, NBITS, LDUM)
-*
- IF (ITYPE.EQ.2 .OR. ITYPE.EQ.3) THEN
- LL = IQ(LNAME+IOFF+ZRANGE)
- IF (LL .NE. 0) THEN
- ILOW = IQ(LINT+LL)
- IUP = IQ(LINT+LL+1)
- ELSE
- IER = 1
- ENDIF
- ELSE
- IER = 2
- ENDIF
-*
- GOTO 30
- ENDIF
- IOFF = IOFF + ZNADDR
- 20 CONTINUE
-*
- LBLOK = LQ(LBLOK)
- IF (LBLOK .NE. 0) GOTO 10
-*
- 30 LBLOK = LOLDBL
- LNAME = LQ(LBLOK-1)
-*
- END
diff --git a/src/packlib/hbook/hntup/hntrset.F b/src/packlib/hbook/hntup/hntrset.F
deleted file mode 100644
index a390d54..0000000
--- a/src/packlib/hbook/hntup/hntrset.F
+++ /dev/null
@@ -1,103 +0,0 @@
-*
-* $Id: hntrset.F,v 1.1.1.1 1996/01/16 17:07:59 mclareni Exp $
-*
-* $Log: hntrset.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:59 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.22/06 27/06/94 18.44.21 by Rene Brun
-*-- Author : Fons Rademakers 23/06/94
- SUBROUTINE HNTRSET(ID1, CHTITL)
-*.==========>
-*.
-*. Duplicate definition of CWN.
-*.
-*. Reset the header of a CWN. Assumes LCID is correctly set (called
-*. from HRESET).
-*.
-*..=========> ( A.A.Rademakers )
-*
-#include "hbook/hcntpar.inc"
-#include "hbook/hcbook.inc"
-#include "hbook/hntcur.inc"
-*
- CHARACTER*(*) CHTITL
- CHARACTER*80 CHRZ
- LOGICAL MEMORY
-*
-* Reset Table A (see HBNT)
-*
- IQ(LCID+ZNOENT) = 0
- IQ(LCID+ZID) = ID1
- IQ(LCID+ZIFTMP) = 2
-*
- MEMORY = .FALSE.
- IF (IQ(LCID+ZNPRIM) .LT. 0) MEMORY = .TRUE.
-*
- CALL HCDIR(CHRZ, 'R')
- IF (CHRZ(1:6) .EQ. '//PAWC') THEN
- IQ(LCID+ZNPRIM) = -IABS(IQ(LCID+ZNPRIM))
- IQ(LCID+ZNCHRZ) = 0
- CHRZ = ' '
- ELSE
- IQ(LCID+ZNCHRZ) = LENOCC(CHRZ)
- ENDIF
- CALL UCTOH(CHRZ,IQ(LCID+ZNCHRZ+1),4,80)
-*
- CALL HBTIT(CHTITL,NWTITL,NCHT)
- IF (NWTITL .NE. 0) THEN
- NMORE = NWTITL - IQ(LCID+ZNWTIT)
- IF(NMORE.NE.0)THEN
- CALL MZPUSH(IHDIV,LCID,0,NMORE,' ')
- ENDIF
- ITIT1 = IQ(LCID+ZITIT1)
- CALL UCTOH(CHTITL,IQ(LCID+ITIT1),4,NCHT)
- ENDIF
- IQ(LCID+ZNWTIT) = NWTITL
-*
-* For memory resident Ntuples drop all content buffers
-*
- IF (MEMORY) CALL HNBUFD(ID1)
-*
-* Reset table B for each block (see HBNT)
-*
- LBLOK = LQ(LCID-1)
-*
-10 IQ(LBLOK+ZNOENT) = 0
-*
-* Reset all reference links that were pointing to the dropped content buffers.
-* For disk resident Ntuples the content buffers were not dropped so no
-* need to reset the reference links.
-*
- IF (MEMORY) THEN
- LNAME = LQ(LBLOK-1)
- NDIM = IQ(LBLOK+ZNDIM)
-* Only if reference links were allocated (done in HFNT2) (one link to many
-* is allocated, therefore the .GE. test)
- IF (IQ(LNAME-3) .GE. NDIM) THEN
- DO 20 I = 1, NDIM
- LQ(LNAME-I) = 0
-20 CONTINUE
- ENDIF
- ENDIF
-*
- LBLOK = LQ(LBLOK)
- IF (LBLOK .NE. 0) GOTO 10
-*
-* Reset table C for each block (see HBNT)
-*
- CALL HNMSET(ID1,ZNRZB,1)
- CALL HNMSET(ID1,ZIBANK,1)
- CALL HNMSET(ID1,ZITMP,0)
- CALL HNMSET(ID1,ZIFCON,2)
- CALL HNMSET(ID1,ZIFBIT,1)
-*
-* Reset misc
-*
- NTCUR = 0
- LBLOK = LQ(LCID-1)
- CALL SBIT1(IQ(LBLOK),1)
-*
- END
diff --git a/src/packlib/hbook/hntup/hntsav.F b/src/packlib/hbook/hntup/hntsav.F
deleted file mode 100644
index e334477..0000000
--- a/src/packlib/hbook/hntup/hntsav.F
+++ /dev/null
@@ -1,52 +0,0 @@
-*
-* $Id: hntsav.F,v 1.1.1.1 1996/01/16 17:07:59 mclareni Exp $
-*
-* $Log: hntsav.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:59 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.19/02 14/05/93 14.05.15 by Fons Rademakers
-*-- Author : Fons Rademakers 14/05/93
- SUBROUTINE HNTSAV
-*.==========>
-*.
-*. Flush RZ directory of current Ntuple to disk.
-*. For the data-structure description see routine HBNT.
-*.
-*. This routine assumes that LCID is pointing to the right Ntuple.
-*.
-*..=========> ( A.A.Rademakers )
-*
-#include "hbook/hcntpar.inc"
-#include "hbook/hcflag.inc"
-#include "hbook/hcbook.inc"
-*
- CHARACTER*128 CHWOLD, CHDIR, CWDRZ
-*
- IERR = 0
-*
-*-- goto the correct RZ directory
-*
- NCHRZ = IQ(LCID+ZNCHRZ)
- CALL RZCDIR(CWDRZ,'R')
- CALL HCDIR(CHWOLD,'R')
- CHDIR = ' '
- CALL UHTOC(IQ(LCID+ZNCHRZ+1),4,CHDIR,NCHRZ)
- IF (CHDIR.NE.CWDRZ) THEN
- CALL HCDIR(CHDIR,' ')
- ENDIF
-*
- CALL RZSAVE
-*
-*-- go back to current working directory
-*
- IF (CHDIR.NE.CWDRZ) THEN
- CALL HCDIR(CHWOLD,' ')
- IF (CHWOLD .NE. CWDRZ) THEN
- CALL RZCDIR(CWDRZ,' ')
- ENDIF
- ENDIF
-*
- END
diff --git a/src/packlib/hbook/hntup/hnttok.F b/src/packlib/hbook/hntup/hnttok.F
deleted file mode 100644
index bd045ac..0000000
--- a/src/packlib/hbook/hntup/hnttok.F
+++ /dev/null
@@ -1,61 +0,0 @@
-*
-* $Id: hnttok.F,v 1.1.1.1 1996/01/16 17:07:58 mclareni Exp $
-*
-* $Log: hnttok.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:58 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.17/00 26/02/92 18.17.24 by Fons Rademakers
-*-- Author : Fons Rademakers 17/12/91
- SUBROUTINE HNTTOK(FORM, TOK, NTOK, MAXTOK, IERR)
-*.==========>
-*.
-*. Find the different tokens in the HBNAME format.
-*.
-*..=========> ( A.A.Rademakers )
-*
- CHARACTER*(*) FORM, TOK(*)
- INTEGER NTOK, IERR
- LOGICAL BRACK, PAREN
-*
- NTOK = 0
- IERR = 0
- BRACK = .FALSE.
- PAREN = .FALSE.
-*
- LF = LENOCC(FORM)
- IF (LF .EQ. 0) RETURN
- CALL HCOMPR(FORM, LF)
-*
- I1 = 1
- DO 10 I = 1, LF
- IF (FORM(I:I) .EQ. '[') BRACK = .TRUE.
- IF (FORM(I:I) .EQ. ']') BRACK = .FALSE.
- IF (FORM(I:I) .EQ. '(') PAREN = .TRUE.
- IF (FORM(I:I) .EQ. ')') PAREN = .FALSE.
- IF (FORM(I:I).EQ.',' .AND. .NOT.BRACK .AND. .NOT.PAREN) THEN
- NTOK = NTOK + 1
- IF (NTOK .GT. MAXTOK) THEN
- IERR = 2
- RETURN
- ENDIF
- TOK(NTOK) = FORM(I1:I-1)
- I1 = I + 1
- ENDIF
- IF (I .EQ. LF) THEN
- IF (BRACK .OR. PAREN) THEN
- IERR = 1
- ELSE
- NTOK = NTOK + 1
- IF (NTOK .GT. MAXTOK) THEN
- IERR = 2
- RETURN
- ENDIF
- TOK(NTOK) = FORM(I1:LF)
- ENDIF
- ENDIF
-10 CONTINUE
-*
- END
diff --git a/src/packlib/hbook/hntup/hntvar.F b/src/packlib/hbook/hntup/hntvar.F
deleted file mode 100644
index febe12e..0000000
--- a/src/packlib/hbook/hntup/hntvar.F
+++ /dev/null
@@ -1,114 +0,0 @@
-*
-* $Id: hntvar.F,v 1.1.1.1 1996/01/16 17:07:58 mclareni Exp $
-*
-* $Log: hntvar.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:58 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.22/06 27/06/94 17.41.54 by Fons Rademakers
-*-- Author : Fons Rademakers 14/08/92
- SUBROUTINE HNTVAR(ID1,IVAR,CHTAG,BLOCK,NSUB,ITYPE,ISIZE,IELEM)
-*.==========>
-*.
-*. Returns the tag, block, type, size and array length of the
-*. variable with index IVAR in N-tuple ID1.
-*. N-tuple must already be in memory.
-*.
-*..=========> ( A.A.Rademakers )
-*
-#include "hbook/hcntpar.inc"
-#include "hbook/hcflag.inc"
-#include "hbook/hcbook.inc"
-#include "hbook/hcbits.inc"
-*
- CHARACTER*(*) CHTAG, BLOCK
- CHARACTER*32 NAME
- LOGICAL NEWTUP, LDUM
-*
- ID = ID1
- IDPOS = LOCATI(IQ(LTAB+1),IQ(LCDIR+KNRH),ID)
- IF (IDPOS .LE. 0) THEN
- CALL HBUG('Unknown N-tuple','HNTVAR',ID1)
- RETURN
- ENDIF
- LCID = LQ(LTAB-IDPOS)
- I4 = JBIT(IQ(LCID+KBITS),4)
- IF (I4 .EQ. 0) RETURN
- NEWTUP = .TRUE.
- IF (IQ(LCID-2) .NE. ZLINK) NEWTUP = .FALSE.
-*
- CHTAG = ' '
- NAME = ' '
- BLOCK = ' '
- NSUB = 0
- ITYPE = 0
- ISIZE = 0
- IELEM = 0
-*
- ICNT = 0
-*
- IF (NEWTUP) THEN
-*
- IF (IVAR .GT. IQ(LCID+ZNDIM)) RETURN
-*
- LBLOK = LQ(LCID-1)
- LCHAR = LQ(LCID-2)
- LINT = LQ(LCID-3)
- LREAL = LQ(LCID-4)
-*
-*-- loop over all blocks
-*
- 5 LNAME = LQ(LBLOK-1)
-*
- IOFF = 0
- NDIM = IQ(LBLOK+ZNDIM)
-*
- DO 10 I = 1, NDIM
- ICNT = ICNT + 1
- IF (ICNT .EQ. IVAR) THEN
-*
- CALL HNDESC(IOFF, NSUB, ITYPE, ISIZE, NBITS, LDUM)
-*
- LL = IQ(LNAME+IOFF+ZLNAME)
- LV = IQ(LNAME+IOFF+ZNAME)
- CALL UHTOC(IQ(LCHAR+LV), 4, NAME, LL)
- CALL UHTOC(IQ(LBLOK+ZIBLOK), 4, BLOCK, 8)
-*
- IELEM = 1
- DO 25 J = 1, NSUB
- LP = IQ(LINT+IQ(LNAME+IOFF+ZARIND)+(J-1))
- IF (LP .LT. 0) THEN
- IE = -LP
- ELSE
- LL = IQ(LNAME+LP-1+ZRANGE)
- IE = IQ(LINT+LL+1)
- ENDIF
- IELEM = IELEM*IE
- 25 CONTINUE
-*
- CHTAG = NAME
- RETURN
-*
- ENDIF
-*
- IOFF = IOFF + ZNADDR
- 10 CONTINUE
-*
- LBLOK = LQ(LBLOK)
- IF (LBLOK .NE. 0) GOTO 5
-*
- ELSE
-*
- IF (IVAR .GT. IQ(LCID+2)) RETURN
- ITAG1 = IQ(LCID+10)
- CALL UHTOC(IQ(LCID+ITAG1+2*(IVAR-1)), 4, NAME, 8)
- CHTAG = NAME
- ITYPE = 1
- ISIZE = 4
- IELEM = 1
-*
- ENDIF
-*
- END
diff --git a/src/packlib/hbook/hntup/hntvdef.F b/src/packlib/hbook/hntup/hntvdef.F
deleted file mode 100644
index 7074365..0000000
--- a/src/packlib/hbook/hntup/hntvdef.F
+++ /dev/null
@@ -1,174 +0,0 @@
-*
-* $Id: hntvdef.F,v 1.1.1.1 1996/01/16 17:07:59 mclareni Exp $
-*
-* $Log: hntvdef.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:59 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.22/06 27/06/94 17.42.49 by Fons Rademakers
-*-- Author : Fons Rademakers 14/08/92
- SUBROUTINE HNTVDEF(ID1,IVAR,CHTAG,BLOCK,ITYPE)
-*.==========>
-*.
-*. Returns the variable definition as given in HBNAME for
-*. variable with index IVAR in N-tuple ID1.
-*. N-tuple must already be in memory.
-*.
-*..=========> ( A.A.Rademakers )
-*
-#include "hbook/hcntpar.inc"
-#include "hbook/hcflag.inc"
-#include "hbook/hcbook.inc"
-#include "hbook/hcbits.inc"
-#include "hbook/hcnt.inc"
-*
- CHARACTER*(*) CHTAG, BLOCK
- CHARACTER*80 VAR
- CHARACTER*32 NAME, SUBS, RANGE,SMIN, SMAX
- CHARACTER*2 SIZE, BITS
- CHARACTER*1 TYPE
- LOGICAL NEWTUP, LDUM
-*
- ID = ID1
- IDPOS = LOCATI(IQ(LTAB+1),IQ(LCDIR+KNRH),ID)
- IF (IDPOS .LE. 0) THEN
- CALL HBUG('Unknown N-tuple','HNTVAR',ID1)
- RETURN
- ENDIF
- IDLAST = ID
- LCID = LQ(LTAB-IDPOS)
- I4 = JBIT(IQ(LCID+KBITS),4)
- IF (I4 .EQ. 0) RETURN
- NEWTUP = .TRUE.
- IF (IQ(LCID-2) .NE. ZLINK) NEWTUP = .FALSE.
-*
- CHTAG = ' '
- NAME = ' '
- BLOCK = ' '
- NSUB = 0
- ITYPE = 0
- ISIZE = 0
-*
- ICNT = 0
-*
- IF (NEWTUP) THEN
-*
- IF (IVAR .GT. IQ(LCID+ZNDIM)) RETURN
-*
- LBLOK = LQ(LCID-1)
- LCHAR = LQ(LCID-2)
- LINT = LQ(LCID-3)
- LREAL = LQ(LCID-4)
-*
-*-- loop over all blocks
-*
- 5 LNAME = LQ(LBLOK-1)
-*
- IOFF = 0
- NDIM = IQ(LBLOK+ZNDIM)
-*
- DO 10 I = 1, NDIM
- ICNT = ICNT + 1
- IF (ICNT .EQ. IVAR) THEN
-*
- CALL HNDESC(IOFF, NSUB, ITYPE, ISIZE, NBITS, LDUM)
-*
- LL = IQ(LNAME+IOFF+ZLNAME)
- LV = IQ(LNAME+IOFF+ZNAME)
- CALL UHTOC(IQ(LCHAR+LV), 4, NAME, LL)
- CALL UHTOC(IQ(LBLOK+ZIBLOK), 4, BLOCK, 8)
-*
- IF (NSUB .GT. 0) THEN
- VAR = NAME(1:LL)//'('
- DO 25 J = 1, NSUB
- LP = IQ(LINT+IQ(LNAME+IOFF+ZARIND)+(J-1))
- IF (LP .LT. 0) THEN
- IE = -LP
- CALL HITOC(IE, SUBS, LL, IERR)
- ELSE
- LL = IQ(LNAME+LP-1+ZLNAME)
- LV = IQ(LNAME+LP-1+ZNAME)
- CALL UHTOC(IQ(LCHAR+LV), 4, SUBS, LL)
- ENDIF
-*
- IF (J .EQ. 1) THEN
- VAR = VAR(1:LENOCC(VAR))//SUBS(1:LL)
- ELSE
- VAR = VAR(1:LENOCC(VAR))//','//SUBS(1:LL)
- ENDIF
- 25 CONTINUE
- VAR = VAR(1:LENOCC(VAR))//')'
- ELSE
- VAR = NAME(1:LL)
- ENDIF
-*
- IF (IQ(LNAME+IOFF+ZRANGE) .EQ. 0) THEN
- RANGE = ' '
- ELSE
- LP = IQ(LNAME+IOFF+ZRANGE)
- IF (ITYPE .EQ. 1) THEN
- FMIN = Q(LREAL+LP)
- FMAX = Q(LREAL+LP+1)
- WRITE(SMIN, '(F15.4)') FMIN
- WRITE(SMAX, '(F15.4)') FMAX
- CALL HCLEFT(SMIN, 1, 15)
- CALL HCLEFT(SMAX, 1, 15)
- LSI = LENOCC(SMIN)
- LSA = LENOCC(SMAX)
- ELSEIF (ITYPE.EQ.2 .OR. ITYPE.EQ.3) THEN
- IMIN = IQ(LINT+LP)
- IMAX = IQ(LINT+LP+1)
- CALL HITOC(IMIN, SMIN, LSI, IERR)
- CALL HITOC(IMAX, SMAX, LSA, IERR)
- ENDIF
- RANGE = '['//SMIN(1:LSI)//','//SMAX(1:LSA)//']'
- ENDIF
- VAR = VAR(1:LENOCC(VAR))//RANGE
-*
- IF (ITYPE .EQ. 1) THEN
- TYPE = 'R'
- ELSEIF (ITYPE .EQ. 2) THEN
- TYPE = 'I'
- ELSEIF (ITYPE .EQ. 3) THEN
- TYPE = 'U'
- ELSEIF (ITYPE .EQ. 4) THEN
- TYPE = 'L'
- ELSEIF (ITYPE .EQ. 5) THEN
- TYPE = 'C'
- ENDIF
- CALL HITOC(ISIZE, SIZE, LS, IERR)
- IF (NBITS .EQ. IBIPB*ISIZE) THEN
- BITS = ' '
- ELSE
- CALL HITOC(NBITS, BITS, LS, IERR)
- ENDIF
-*
- VAR = VAR(1:LENOCC(VAR))//':'//TYPE//'*'//SIZE
- IF (BITS.NE.' ' .AND. ITYPE.NE.4 .AND. ITYPE.NE.5) THEN
- VAR = VAR(1:LENOCC(VAR))//':'//BITS
- ENDIF
-*
- CHTAG = VAR
- RETURN
-*
- ENDIF
-*
- IOFF = IOFF + ZNADDR
- 10 CONTINUE
-*
- LBLOK = LQ(LBLOK)
- IF (LBLOK .NE. 0) GOTO 5
-*
- ELSE
-*
- IF (IVAR .GT. IQ(LCID+2)) RETURN
- ITAG1 = IQ(LCID+10)
- CALL UHTOC(IQ(LCID+ITAG1+2*(IVAR-1)), 4, NAME, 8)
- ITYPE = 1
- CHTAG = NAME(1:LENOCC(NAME))//':R*4'
-*
- ENDIF
-*
- END
diff --git a/src/packlib/hbook/hntup/hntwrt.F b/src/packlib/hbook/hntup/hntwrt.F
deleted file mode 100644
index 08325d1..0000000
--- a/src/packlib/hbook/hntup/hntwrt.F
+++ /dev/null
@@ -1,120 +0,0 @@
-*
-* $Id: hntwrt.F,v 1.1.1.1 1996/01/16 17:07:58 mclareni Exp $
-*
-* $Log: hntwrt.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:58 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 05/09/95 16.22.10 by Julian Bunn
-*-- Author : Fons Rademakers 08/01/92
- SUBROUTINE HNTWRT(INDX, IOFF, IER)
-*.==========>
-*.
-*. Write the contents bank to RZ file or lift a new
-*. bank when Ntuple is stored in memory.
-*. For the data-structure description see routine HBNT.
-*.
-*..=========> ( A.A.Rademakers )
-*
-#include "hbook/hcntpar.inc"
-#include "hbook/hcflag.inc"
-#include "hbook/hcbook.inc"
-#include "hbook/hcsave.inc"
-*
- COMMON/QUEST/IQUEST(100)
- CHARACTER*128 CHWOLD,CHDIR,CWDRZ
- INTEGER IDRZ(2)
-*
-*-- Memory bank full ?
-*-- Allocate a new block if memory resident Ntuple
-*-- Write current block when disk resident Ntuple and clear same block
-*
- IDD = IDLAST
- IER = 0
- NWP = IQ(LR2-1)
-*
-5 IF (IQ(LCID+ZNPRIM) .LT. 0) THEN
-*
-*-- Memory resident
-*
- CALL HSPACE(NWP+10,'HFNT',IDD)
- IF (IERR .NE. 0) GOTO 99
- CALL MZBOOK(IHDIV,LR2,LR2,0,'HCON',0,0,NWP,1,0)
- IQ(LNAME+IOFF+ZNRZB) = IQ(LNAME+IOFF+ZNRZB) + 1
- IQ(LNAME+IOFF+ZIBANK) = IQ(LNAME+IOFF+ZNRZB)
- LQ(LNAME-INDX) = LR2
- ELSE
-*
-*-- Disk resident
-*
- LCIND = IQ(LNAME+IOFF+ZLCONT)
- LB = LQ(LBUF-LCIND)
- IF (JBIT(IQ(LB),1) .EQ. 0) GOTO 10
-*
-*-- Before writing buffer check if header needs to be written.
-*-- Only write header if bit 2 is set in status word of first block.
-*-- Set number of entries to -1 in header. This header is only
-*-- supposed to be used by the error recovery routine HRECOV.
-*
- IF (JBIT(IQ(LQ(LCID-1)),2) .NE. 0) THEN
- N = IQ(LCID+ZNOENT)
- IQ(LCID+ZNOENT) = -1
- CALL HNHDWR(IDD)
- IQ(LCID+ZNOENT) = N
- ENDIF
-*
- LB = LQ(LBUF-LCIND)
- CALL SBIT0(IQ(LB),1)
- NTSAVE = .TRUE.
- NCHRZ = IQ(LCID+ZNCHRZ)
- IDRZ(1) = IDD
- IDRZ(2) = IQ(LNAME+IOFF+ZNRZB)*10000 + IQ(LNAME+IOFF+ZLCONT)
- CALL RZCDIR(CWDRZ,'R')
- CALL HCDIR(CHWOLD,'R')
- CHDIR = ' '
- CALL UHTOC(IQ(LCID+ZNCHRZ+1),4,CHDIR,NCHRZ)
- IF (CHDIR .EQ. CWDRZ) THEN
- CALL HRZOUT(IHDIV,LR2,IDRZ,ICYCLE,'A')
-C
-C CHECK FOR AN ERROR, INDICATED BY IQUEST(1) NON-ZERO
-C
- IF(IQUEST(1).NE.0) THEN
- CALL HBUG('An error has occured for '//
- & CHDIR(:LENOCC(CHDIR)),'HNTWRT',IQUEST(1))
- GOTO 99
- ENDIF
- ELSE
- CALL HCDIR(CHDIR,' ')
- IF (IQUEST(1) .NE. 0) THEN
- CALL HBUG('+Switch to memory mode','HNTWRT',IDD)
- IQ(LCID+ZNPRIM) = -IQ(LCID+ZNPRIM)
- GOTO 5
- ENDIF
- CALL HRZOUT(IHDIV,LR2,IDRZ,ICYCLE,'A')
-C
-C CHECK FOR AN ERROR, INDICATED BY IQUEST(1) NON-ZERO
-C
- IF(IQUEST(1).NE.0) THEN
- CALL HBUG('An error has occured for '//
- & CHDIR(:LENOCC(CHDIR)),'HNTWRT',IQUEST(1))
- GOTO 99
- ENDIF
- CALL HCDIR(CHWOLD,' ')
- IF (CHWOLD .NE. CWDRZ) THEN
- CALL RZCDIR(CWDRZ,' ')
- ENDIF
- ENDIF
-*
-10 CALL VZERO(IQ(LR2+1), NWP)
- IQ(LNAME+IOFF+ZNRZB) = IQ(LNAME+IOFF+ZNRZB) + 1
- IQ(LNAME+IOFF+ZIBANK) = IQ(LNAME+IOFF+ZNRZB)
- ENDIF
-*
- IDLAST = IDD
- RETURN
-*
- 99 IER = 1
- RETURN
- END
diff --git a/src/packlib/hbook/hntup/hparnt.F b/src/packlib/hbook/hntup/hparnt.F
deleted file mode 100644
index 66db8ee..0000000
--- a/src/packlib/hbook/hntup/hparnt.F
+++ /dev/null
@@ -1,57 +0,0 @@
-*
-* $Id: hparnt.F,v 1.1.1.1 1996/01/16 17:07:58 mclareni Exp $
-*
-* $Log: hparnt.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:58 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.19/02 14/05/93 12.07.43 by Fons Rademakers
-*-- Author : Fons Rademakers 28/01/92
- SUBROUTINE HPARNT(IDN, CHROUT)
-*.==========>
-*.
-*. Get address and parameters of new Ntuple IDN.
-*.
-*..=========> ( A.A.Rademakers )
-*
-#include "hbook/hcntpar.inc"
-#include "hbook/hcbook.inc"
-*
- CHARACTER*(*) CHROUT
-*
- LCID = 0
- NIDN = LOCATI(IQ(LTAB+1),IQ(LCDIR+KNRH),IDN)
- IF (NIDN .LE. 0) THEN
- CALL HRIN(IDN,9999,0)
- NIDN = LOCATI(IQ(LTAB+1),IQ(LCDIR+KNRH),IDN)
- IF (NIDN .LE. 0) THEN
- CALL HBUG('Unknown N-tuple',CHROUT,IDN)
- IDN = 0
- RETURN
- ENDIF
- ENDIF
- LCID = LQ(LTAB-NIDN)
- I4 = JBIT(IQ(LCID+KBITS),4)
- IF (I4 .EQ. 0) THEN
- CALL HBUG('Not a N-tuple',CHROUT,IDN)
- IDN = 0
- RETURN
- ENDIF
- IF (IQ(LCID-2) .NE. ZLINK) THEN
- CALL HBUG('Old N-tuple, this routine works only for new '//
- + 'N-tuples',CHROUT,IDN)
- IDN = 0
- RETURN
- ENDIF
-*
-*-- when disk resident N-tuple make sure that all the buffers
-*-- and the header are flushed on disk
-*
- IF (IQ(LCID+ZNPRIM) .GT. 0) THEN
- CALL HNBFWR(IDN)
- CALL HNHDWR(IDN)
- ENDIF
-*
- END
diff --git a/src/packlib/hbook/hntup/hprnt.F b/src/packlib/hbook/hntup/hprnt.F
deleted file mode 100644
index 03384f2..0000000
--- a/src/packlib/hbook/hntup/hprnt.F
+++ /dev/null
@@ -1,202 +0,0 @@
-*
-* $Id: hprnt.F,v 1.1.1.1 1996/01/16 17:07:59 mclareni Exp $
-*
-* $Log: hprnt.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:59 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.22/06 27/06/94 17.42.22 by Fons Rademakers
-*-- Author : Fons Rademakers 28/01/92
- SUBROUTINE HPRNT(ID1)
-*.==========>
-*.
-*. To print statistics about a new N-tuple
-*.
-*..=========> ( A.A.Rademakers )
-*
-#include "hbook/hcntpar.inc"
-#include "hbook/hcnt.inc"
-#include "hbook/hcflag.inc"
-#include "hbook/hcbook.inc"
-#include "hbook/hcbits.inc"
-#include "hbook/hcunit.inc"
-*
- CHARACTER*80 VAR, TITLE
- CHARACTER*32 NAME, SUBS, RANGE, SMIN, SMAX
- CHARACTER*8 BLKNAM
- CHARACTER*9 SNOENT
- CHARACTER*5 SID, SCOL
- CHARACTER*4 SBLOK, SDIM
- CHARACTER*2 SIZE, BITS
- CHARACTER*1 TYPE
- LOGICAL VTUP, LDUM
-*
- ID = ID1
- IDPOS = LOCATI(IQ(LTAB+1),IQ(LCDIR+KNRH),ID)
- IF (IDPOS .LE. 0) THEN
- CALL HBUG('Unknown N-tuple','HPRNT',ID1)
- RETURN
- ENDIF
- LCID = LQ(LTAB-IDPOS)
- I4 = JBIT(IQ(LCID+KBITS),4)
- IF (I4 .EQ. 0) RETURN
- IF (IQ(LCID-2) .NE. ZLINK) THEN
- CALL HBUG('Old N-tuple, print statistics with HPRNTU',
- + 'HPRNT',ID)
- RETURN
- ENDIF
-*
- VAR = ' '
- TITLE = ' '
- ICOLS = 0
- VTUP = .FALSE.
-*
- LBLOK = LQ(LCID-1)
- LCHAR = LQ(LCID-2)
- LINT = LQ(LCID-3)
- LREAL = LQ(LCID-4)
-*
- NOENT = IQ(LCID+ZNOENT)
- ITIT1 = IQ(LCID+ZITIT1)
- NWTIT = IQ(LCID+ZNWTIT)
-*
- CALL HITOC(ID1, SID, LL, IERR)
- CALL HITOC(NOENT, SNOENT, LL, IERR)
- CALL UHTOC(IQ(LCID+ITIT1), 4, TITLE, NWTIT*4)
- WRITE(LOUT,1000) SID, SNOENT, TITLE(1:LENOCC(TITLE))
- WRITE(LOUT,2000)
-*
-*-- loop over all blocks
-*
- 5 LNAME = LQ(LBLOK-1)
-*
- IOFF = 0
- NDIM = IQ(LBLOK+ZNDIM)
- CALL UHTOC(IQ(LBLOK+ZIBLOK), 4, BLKNAM, 8)
-*
- DO 10 I = 1, NDIM
- CALL HNDESC(IOFF, NSUB, ITYPE, ISIZE, NBITS, LDUM)
- LL = IQ(LNAME+IOFF+ZLNAME)
- LV = IQ(LNAME+IOFF+ZNAME)
- CALL UHTOC(IQ(LCHAR+LV), 4, NAME, LL)
- IELEM = 1
- IF (NSUB .GT. 0) THEN
- VAR = NAME(1:LL)//'('
- DO 20 J = 1, NSUB
- LP = IQ(LINT+IQ(LNAME+IOFF+ZARIND)+(J-1))
- IF (LP .LT. 0) THEN
- IE = -LP
- CALL HITOC(IE, SUBS, LL, IERR)
- ELSE
- LL = IQ(LNAME+LP-1+ZLNAME)
- LV = IQ(LNAME+LP-1+ZNAME)
- CALL UHTOC(IQ(LCHAR+LV), 4, SUBS, LL)
- LL1 = IQ(LNAME+LP-1+ZRANGE)
- IE = IQ(LINT+LL1+1)
- VTUP = .TRUE.
- ENDIF
- IELEM = IELEM*IE
-*
- IF (J .EQ. 1) THEN
- VAR = VAR(1:LENOCC(VAR))//SUBS(1:LL)
- ELSE
- VAR = VAR(1:LENOCC(VAR))//','//SUBS(1:LL)
- ENDIF
- 20 CONTINUE
- VAR = VAR(1:LENOCC(VAR))//')'
- ELSE
- VAR = NAME(1:LL)
- ENDIF
-*
- IF (IQ(LNAME+IOFF+ZRANGE) .EQ. 0) THEN
- RANGE = ' '
- ELSE
- LP = IQ(LNAME+IOFF+ZRANGE)
- IF (ITYPE .EQ. 1) THEN
- FMIN = Q(LREAL+LP)
- FMAX = Q(LREAL+LP+1)
- WRITE(SMIN, '(F15.4)') FMIN
- WRITE(SMAX, '(F15.4)') FMAX
- CALL HCLEFT(SMIN, 1, 15)
- CALL HCLEFT(SMAX, 1, 15)
- LSI = LENOCC(SMIN)
- LSA = LENOCC(SMAX)
- ELSEIF (ITYPE.EQ.2 .OR. ITYPE.EQ.3) THEN
- IMIN = IQ(LINT+LP)
- IMAX = IQ(LINT+LP+1)
- CALL HITOC(IMIN, SMIN, LSI, IERR)
- CALL HITOC(IMAX, SMAX, LSA, IERR)
- ENDIF
- RANGE = '['//SMIN(1:LSI)//','//SMAX(1:LSA)//']'
- ENDIF
-*
- IF (ITYPE .EQ. 1) THEN
- TYPE = 'R'
- ELSEIF (ITYPE .EQ. 2) THEN
- TYPE = 'I'
- ELSEIF (ITYPE .EQ. 3) THEN
- TYPE = 'U'
- ELSEIF (ITYPE .EQ. 4) THEN
- TYPE = 'L'
- ELSEIF (ITYPE .EQ. 5) THEN
- TYPE = 'C'
- ENDIF
- CALL HITOC(ISIZE, SIZE, LS, IERR)
- IF (NBITS .EQ. IBIPB*ISIZE) THEN
- BITS = ' '
- ELSE
- CALL HITOC(NBITS, BITS, LS, IERR)
- ENDIF
-*
- WRITE(LOUT,3000) I, TYPE//'*'//SIZE, BITS, RANGE(1:12),
- + BLKNAM, VAR(1:LENOCC(VAR))
-*
- ICOLS = ICOLS + IELEM
- IOFF = IOFF + ZNADDR
- 10 CONTINUE
-*
- LBLOK = LQ(LBLOK)
- IF (LBLOK .NE. 0) GOTO 5
-*
- CALL HITOC(IQ(LCID+ZNBLOK), SBLOK, LL, IERR)
- CALL HITOC(IQ(LCID+ZNDIM), SDIM, LL, IERR)
- CALL HITOC(ICOLS, SCOL, LL, IERR)
- CALL HPRNTS
- IF (VTUP) THEN
- WRITE(LOUT,4000) SBLOK, SDIM, SCOL
- ELSE
- WRITE(LOUT,4010) SBLOK, SDIM, SCOL
- ENDIF
-*
- 1000 FORMAT(//,
- + ' *********************************************************',
- + '*********',/,
- + ' * Ntuple ID = ',A,' Entries = ',A,1X,A)
- 2000 FORMAT(
- + ' *********************************************************',
- + '*********',/,
- + ' * Var numb * Type * Packing * Range * Block * ',
- + 'Name *',/,
- + ' *********************************************************',
- + '*********')
- 3000 FORMAT(
- + ' *',4X,I3,2X,' * ',A,' * ',3X,A,2X,' * ',A,' * ',A,' * ',A)
- 4000 FORMAT(
- + ' *********************************************************',
- + '*********',/,
- + ' * Blocks = ',A,' Variables = ',A,' Max. Column',
- + 's = ',A,' *',/,
- + ' *********************************************************',
- + '*********',/)
- 4010 FORMAT(
- + ' *********************************************************',
- + '*********',/,
- + ' * Blocks = ',A,' Variables = ',A,' Column',
- + 's = ',A,' *',/,
- + ' *********************************************************',
- + '*********',/)
-*
- 99 RETURN
- END
diff --git a/src/packlib/hbook/hntup/hprnts.F b/src/packlib/hbook/hntup/hprnts.F
deleted file mode 100644
index 4193dc8..0000000
--- a/src/packlib/hbook/hntup/hprnts.F
+++ /dev/null
@@ -1,131 +0,0 @@
-*
-* $Id: hprnts.F,v 1.1.1.1 1996/01/16 17:07:59 mclareni Exp $
-*
-* $Log: hprnts.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:59 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.20/08 07/09/93 19.30.59 by Fons Rademakers
-*-- Author : Fons Rademakers 06/01/92
- SUBROUTINE HPRNTS
-*.==========>
-*.
-*. Print space usage statistics.
-*. This routine assumes that LCID is correctly set.
-*.
-*..=========> ( A.A.Rademakers )
-*
-#include "hbook/hcntpar.inc"
-#include "hbook/hcnt.inc"
-#include "hbook/hcbook.inc"
-#include "hbook/hcunit.inc"
-*
- CHARACTER*6 SNPW, SNPWT
- CHARACTER*8 BLKNAM, SNW, SNWT, SNOENT
- LOGICAL VARSIZ, VARTOT, INDVAR
-*
- LBLOK = LQ(LCID-1)
- LCHAR = LQ(LCID-2)
- LINT = LQ(LCID-3)
- LREAL = LQ(LCID-4)
-*
- VARTOT = .FALSE.
- NWTOT = 0
- NPWTOT = 0
-*
- WRITE(LOUT,1000)
-*
-*-- loop over all blocks
-*
- 5 LNAME = LQ(LBLOK-1)
-*
- NW = 0
- NPW = 0
- VARSIZ = .FALSE.
- IOFF = 0
- NDIM = IQ(LBLOK+ZNDIM)
- CALL UHTOC(IQ(LBLOK+ZIBLOK), 4, BLKNAM, 8)
-*
- DO 10 I = 1, NDIM
- CALL HNDESC(IOFF, NSUB, ITYPE, ISIZE, NBITS, INDVAR)
-*
- IF (INDVAR) THEN
- VARSIZ = .TRUE.
- VARTOT = .TRUE.
- ENDIF
-*
- IELEM = 1
- DO 20 J = 1, NSUB
- LP = IQ(LINT+IQ(LNAME+IOFF+ZARIND)+(J-1))
- IF (LP .LT. 0) THEN
- IE = -LP
- ELSE
- LL = IQ(LNAME+LP-1+ZRANGE)
- IE = IQ(LINT+LL+1)
- ENDIF
- IELEM = IELEM*IE
-20 CONTINUE
-*
- NW = NW + IELEM*ISIZE
-*
- NPW = NPW + IELEM*NBITS
-*
- IOFF = IOFF + ZNADDR
-10 CONTINUE
-*
- NPW = FLOAT(NPW)/IBIPB + (IBIPB-1.)/IBIPB
- CALL HITOC(NW, SNW, LL, IERR)
- CALL HITOC(NPW, SNPW, LL, IERR)
- CALL HITOC(IQ(LBLOK+ZNOENT), SNOENT, LL, IERR)
-*
- IF (VARSIZ) THEN
- WRITE(LOUT,2000) BLKNAM, SNOENT, SNW, 'Var. '
- ELSE
- IF (NPW .EQ. 0) THEN
- RP = 0.0
- ELSE
- RP = FLOAT(NW)/NPW
- ENDIF
- WRITE(LOUT,2500) BLKNAM, SNOENT, SNW, SNPW, RP
- ENDIF
-*
- NWTOT = NWTOT + NW
- NPWTOT = NPWTOT + NPW
-*
- LBLOK = LQ(LBLOK)
- IF (LBLOK .NE. 0) GOTO 5
-*
- CALL HITOC(NWTOT, SNWT, LL, IERR)
- CALL HITOC(NPWTOT, SNPWT, LL, IERR)
- IF (VARTOT) THEN
- WRITE(LOUT,3000) SNWT, 'Var. '
- ELSE
- IF (NPWTOT .EQ. 0) THEN
- RP = 0.0
- ELSE
- RP = FLOAT(NWTOT)/NPWTOT
- ENDIF
- WRITE(LOUT,3500) SNWT, SNPWT, RP
- ENDIF
-*
-1000 FORMAT(
- + ' *********************************************************',
- + '*********',/
- + ' * Block * Entries * Unpacked * Packed * Packing Fact',
- + 'or *',/
- + ' *********************************************************',
- + '*********')
-2000 FORMAT(
- + ' * ',A,' * ',A,' * ',A,' * ',A,' * Variable *')
-2500 FORMAT(
- + ' * ',A,' * ',A,' * ',A,' * ',A,' * ',F8.3,' *')
-3000 FORMAT(
- + ' * Total * --- * ',A,' * ',A,' * Variable',
- + ' *')
-3500 FORMAT(
- + ' * Total * --- * ',A,' * ',A,' * ',F8.3,
- + ' *')
-*
- END
diff --git a/src/packlib/hbook/hntup/hreco1.F b/src/packlib/hbook/hntup/hreco1.F
deleted file mode 100644
index 8f23673..0000000
--- a/src/packlib/hbook/hntup/hreco1.F
+++ /dev/null
@@ -1,57 +0,0 @@
-*
-* $Id: hreco1.F,v 1.1.1.1 1996/01/16 17:07:59 mclareni Exp $
-*
-* $Log: hreco1.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:59 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.19/03 26/05/93 16.09.31 by Fons Rademakers
-*-- Author : Fons Rademakers 26/05/93
- SUBROUTINE HRECO1(ID1)
-*.==========>
-*.
-*. Sets the receiving addresses for index variables in
-*. the current block. To be able to recover an Ntuple
-*. we must read the index variables so we can calculate
-*. the number of elements to be recovered of array columns
-*. depending on the index variables.
-*.
-*..=========> ( A.A.Rademakers )
-*
-#include "hbook/hcntpar.inc"
-#include "hbook/hcntpaw.inc"
-#include "hbook/hcbook.inc"
-*
- CHARACTER*8 BLOCK
- CHARACTER*32 VAR
- LOGICAL INDVAR
-*
- INDCR4 = 1
-*
- IOFF = 0
- NDIM = IQ(LBLOK+ZNDIM)
- LNAME = LQ(LBLOK-1)
- CALL UHTOC(IQ(LBLOK+ZIBLOK), 4, BLOCK, 8)
-*
-*-- loop over all variables in this block
-*
- DO 40 I = 1, NDIM
- INDVAR = .FALSE.
- IF (JBIT(IQ(LNAME+IOFF+ZDESC),28) .EQ. 1) INDVAR = .TRUE.
-*
- IF (INDVAR) THEN
- LL = IQ(LNAME+IOFF+ZLNAME)
- LV = IQ(LNAME+IOFF+ZNAME)
- VAR = ' '
- CALL UHTOC(IQ(LCHAR+LV), 4, VAR, LL)
- CALL HBNAME(ID1, BLOCK, RVAR4(INDCR4), '$SET:'//VAR)
- INDCR4 = INDCR4 + 1
- ENDIF
-*
- IOFF = IOFF + ZNADDR
-*
- 40 CONTINUE
-*
- END
diff --git a/src/packlib/hbook/hntup/hreco2.F b/src/packlib/hbook/hntup/hreco2.F
deleted file mode 100644
index 84eb79c..0000000
--- a/src/packlib/hbook/hntup/hreco2.F
+++ /dev/null
@@ -1,40 +0,0 @@
-*
-* $Id: hreco2.F,v 1.1.1.1 1996/01/16 17:07:59 mclareni Exp $
-*
-* $Log: hreco2.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:59 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.19/03 26/05/93 17.11.25 by Fons Rademakers
-*-- Author : Fons Rademakers 26/05/93
- SUBROUTINE HRECO2
-*.==========>
-*.
-*. Update the LNAME bank for this block.
-*.
-*..=========> ( A.A.Rademakers )
-*
-#include "hbook/hcntpar.inc"
-#include "hbook/hcbook.inc"
-*
- IOFF = 0
- NDIM = IQ(LBLOK+ZNDIM)
- LNAME = LQ(LBLOK-1)
-*
-*-- loop over all variables in this block
-*
- DO 40 I = 1, NDIM
-*
- ITMP = IQ(LNAME+IOFF+ZITMP)
-*
- IQ(LNAME+IOFF+ZIFCON) = IQ(LTMP+ITMP+1)
- IQ(LNAME+IOFF+ZIFBIT) = IQ(LTMP+ITMP+2)
- IQ(LNAME+IOFF+ZIBANK) = 0
-*
- IOFF = IOFF + ZNADDR
-*
- 40 CONTINUE
-*
- END
diff --git a/src/packlib/hbook/hntup/hrecov.F b/src/packlib/hbook/hntup/hrecov.F
deleted file mode 100644
index 3d629e9..0000000
--- a/src/packlib/hbook/hntup/hrecov.F
+++ /dev/null
@@ -1,229 +0,0 @@
-*
-* $Id: hrecov.F,v 1.1.1.1 1996/01/16 17:07:59 mclareni Exp $
-*
-* $Log: hrecov.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:59 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.22/11 23/08/94 14.19.39 by Rene Brun
-*-- Author : Rene Brun 13/05/93
- SUBROUTINE HRECOV(ID1,CHOPT)
-*.==========>
-*. Recovery routine for Ntuples.
-*. HRECOV attempts to read the latest saved header. From the header
-*. information, it looks at all Ntuple extensions to reconstruct
-*. the maximum number of blocks/events.
-*. If successful, the new header is written to the file.
-*..=========> ( R.Brun )
-*
-#include "hbook/hcbook.inc"
-#include "hbook/hcflag.inc"
-#include "hbook/hcunit.inc"
-#include "hbook/hcdire.inc"
-#include "hbook/hntcur.inc"
-#include "hbook/hcntpar.inc"
-#include "hbook/hcrecv.inc"
-*
- COMMON/PAWIDN/IDNEVT,VIDN1,VIDN2,VIDN3,X(522)
- COMMON/QUEST/IQUEST(100)
-*
- PARAMETER (MXSTEP = 16384)
- CHARACTER*(*) CHOPT
- CHARACTER*8 BLOCK
- INTEGER HNBMIN
-*.___________________________________________
-*
-*-* Get highest cycle of header
-*
- CALL HRIN(ID1,99999,0)
- IF(LCID.LE.0)GO TO 999
- LCIDN=LCID
- CALL RZINK(1,9999,'SC')
- NKEYS=IQUEST(7)
- NWKEY=IQUEST(8)
- IF(NWKEY.NE.2)THEN
- CALL HBUG('Cannot recover old HBOOK files','HRECOV',ID1)
- GO TO 999
- ENDIF
- CALL HUOPTC(CHOPT,'F',IOPTF)
-*
-*-* COLUMN-Wise Ntuple case
-*
- IF (IQ(LCID-2) .EQ. ZLINK) THEN
-*
- IF (IQ(LCID+ZNOENT) .NE. -1) THEN
- CALL HBUG('Ntuple looks healthy, nothing to recover',
- + 'HRECOV',ID1)
- GOTO 999
- ENDIF
-*
-*-- turn recovery flag on
-*
- NRECOV = .TRUE.
-*
-*-- loop over all blocks
-*
- LBLOK = LQ(LCID-1)
- LCHAR = LQ(LCID-2)
- LINT = LQ(LCID-3)
- LREAL = LQ(LCID-4)
-*
- 10 IBEVT = 0
- ISTEP = MXSTEP
- IFIRST = 0
- CALL UHTOC(IQ(LBLOK+ZIBLOK), 4, BLOCK, 8)
-*
-*-- save current block pointer and set all receiving addresses to 0
-*
- LR2 = LBLOK
- CALL HNMSET(ID1, ZNADDR, 0)
-*
-*-- we have to read index variables, so set receiving addresses for them
-*
- LBLOK = LR2
- CALL HRECO1(ID1)
-*
-*-- create or find buffer manager structure for ID1
-*
- CALL HNBUFR(ID1)
- IF (IERR .NE. 0) GOTO 40
- NTCUR = ID1
-*
- LBLOK = LR2
-*
-*-- use binary search to find contents for each block
-*
- 20 IF (IFIRST .EQ. 0) THEN
- IQ(LTMP1+1) = 0
- CALL HGNT2(' ', 0, 0, IBEVT+ISTEP, IERROR)
- IF (IERROR .EQ. 0) THEN
- IQ(LTMP+1) = IBEVT+ISTEP
- ELSE
- IQ(LTMP+1) = 0
- ENDIF
- IFIRST = 1
- ELSE
- CALL HGNTF(ID1, IBEVT+ISTEP, IERROR)
- ENDIF
- IF (IERROR .NE. 0) GOTO 25
-*
- CALL HGNTF(ID1, IBEVT+ISTEP+1, IERRO1)
-*
- 25 IF (IERROR .NE. 0) THEN
- IF (ISTEP .EQ. 0) THEN
- WRITE(LOUT,10300)
- RETURN
- ENDIF
- ISTEP = ISTEP/2
- ELSEIF (IERRO1 .EQ. 0) THEN
- IBEVT = IBEVT + ISTEP
- ELSE
- CALL HGNTF(ID1, IBEVT+ISTEP, IERROR)
-*
-*-- update the LNAME structure for this block and set the block event counter
-*
- CALL HRECO2
- IQ(LBLOK+ZNOENT) = IBEVT+ISTEP
-*
- GOTO 30
-*
- ENDIF
-*
- GOTO 20
-*
-*-- next block
-*
- 30 LBLOK = LQ(LBLOK)
- WRITE(LOUT,10100) IBEVT+ISTEP, BLOCK
- IF (LBLOK .NE. 0) GOTO 10
-*
-*-- after looping over all blocks set global event counter to the
-*-- minimum of all block counters
-*
- IQ(LCID+ZNOENT) = HNBMIN()
- WRITE(LOUT,10200) IQ(LCID+ZNOENT)
-*
-*-- Ntuple structure has been changed
-*
- LBLOK = LQ(LCID-1)
- CALL SBIT1(IQ(LBLOK),1)
-*
- NRECOV = .FALSE.
- GOTO 90
-*
- 40 NRECOV = .FALSE.
- CALL HBUG('Cannot recover Ntuple','HRECOV',ID1)
- GOTO 999
-*
- ELSE
-*
-*-* ROW-Wise Ntuple case
-*
-*-* Find highest extension number
-*
- MAXEXT=0
- DO 50 I=1,NKEYS
- CALL RZINK(I,1,'SC')
- IDN=IQUEST(21)
- IEXT=IQUEST(22)
- IF(IDN.EQ.ID1.AND.IEXT.GT.MAXEXT)MAXEXT=IEXT
- 50 CONTINUE
- IF(MAXEXT.LE.IQ(LCID+6))THEN
- CALL HBUG('Cannot recover more than current header',
- + 'HRECOV',ID1)
- GO TO 999
- ENDIF
- NDIM=IQ(LCID+2)
- NPRIME=IQ(LCID+4)
- NOENT=MAXEXT*(NPRIME/NDIM)
- IQ(LCID+3)=NOENT
- IQ(LCID+6)=MAXEXT
- IQ(LCID+7)=NPRIME+1
-*
-*-* Rebuild the LCONT and LIMS structures
-*
- LQ(LCDIR-9)=LCID
- IF(LQ(LCID-1).EQ.0)THEN
- CALL MZBOOK(IHDIV,LCONT,LCID,-1,'HCON',0,0,NPRIME,3,0)
- IQ(LCID)=0
- ENDIF
- LQ(LCID-3)=LCONT
- LLIMS=LQ(LCID-2)
- IF(LLIMS.LE.0)THEN
- CALL MZBOOK(IHDIV,LLIMS,LCID,-2,'HLIM',0,0,2*NDIM,3,0)
- ENDIF
- DO 60 I=1,NDIM
- Q(LLIMS+2*I-1)=1.E31
- Q(LLIMS+2*I )=-1.E31
- 60 CONTINUE
-*
-*-* If not option option 'F' recompute MIN/MAX info
-*
- IF(IOPTF.EQ.0)THEN
- DO 80 IDNEVT=1,NOENT
- CALL HGNF(ID1,IDNEVT,X,IERROR)
- DO 70 I=1,NDIM
- IF(X(I).LT.Q(LLIMS+2*I-1))Q(LLIMS+2*I-1)=X(I)
- IF(X(I).GT.Q(LLIMS+2*I ))Q(LLIMS+2*I )=X(I)
- 70 CONTINUE
- 80 CONTINUE
- ENDIF
-*
- WRITE(LOUT,10000) NOENT
-*
- ENDIF
-*
-*-* Now write new header to file
-*
- 90 CALL HROUT(ID1,ICYCLE,' ')
-*
-10000 FORMAT(' HRECOV:',I8,' entries correctly recovered')
-10100 FORMAT(' HRECOV:',I8,' entries in block ',A,
- + ' correctly recovered')
-10200 FORMAT(' HRECOV:',I8,' complete entries correctly recovered')
-10300 FORMAT(' HRECOV: cannot recover,',
- + ' something is very seriously wrong')
-*
- 999 END
diff --git a/src/packlib/hbook/hntup/hrzfra.F b/src/packlib/hbook/hntup/hrzfra.F
deleted file mode 100644
index 56bfe6a..0000000
--- a/src/packlib/hbook/hntup/hrzfra.F
+++ /dev/null
@@ -1,61 +0,0 @@
-*
-* $Id: hrzfra.F,v 1.2 1998/09/25 09:28:48 mclareni Exp $
-*
-* $Log: hrzfra.F,v $
-* Revision 1.2 1998/09/25 09:28:48 mclareni
-* Modifications for the Mklinux port flagged by CERNLIB_PPC
-*
-* Revision 1.1.1.1 1996/01/16 17:07:59 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.22/11 23/08/94 14.19.39 by Rene Brun
-*-- Author : Rene Brun 17/10/92
- SUBROUTINE HRZFRA(IH,IOH,NW)
-*
-***********************************************************************
-*
-* Converts array of NW ASCII words into EBCDIC hollerith
-*
-* Author : R.Brun CN/AS
-* Written : 17/10/92
-* Last mod: 17/10/92
-*
-***********************************************************************
-#if defined(CERNLIB_IBM)
- DIMENSION IH(1), IOH(1)
- PARAMETER (NCHAR = 126)
- DIMENSION IEB(NCHAR)
- DATA IEB /8*0,5,22*0,
- + 64, 90,127,123, 91,108, 80,125, 77, 93, 92, 78,107, 96, 75, 97,
- +240,241,242,243,244,245,246,247,248,249,122, 94, 76,126,110,111,
- +124,193,194,195,196,197,198,199,200,201,209,210,211,212,213,214,
- +215,216,217,226,227,228,229,230,231,232,233,173,224,189, 95,109,
- +121,129,130,131,132,133,134,135,136,137,145,146,147,148,149,150,
- +151,152,153,162,163,164,165,166,167,168,169,192, 79,208,161/
-*-----------------------------------
-*
- DO 20 IW=1,NW
- DO 10 I=1,25,8
- IBYTE=JBYT(IH(IW),I,8)
- IF(IBYTE.GT.126)IBYTE=32
- CALL SBYT(IEB(IBYTE),IOH(IW),I,8)
- 10 CONTINUE
- 20 CONTINUE
-#endif
-#if defined(CERNLIB_VAX)||defined(CERNLIB_DECS)||defined(CERNLIB_MSDOS)||(defined(CERNLIB_LINUX) && !defined(CERNLIB_PPC))||defined(CERNLIB_WINNT)
- DIMENSION IH(1), IOH(1)
-*
- DO 20 IW=1,NW
- IB1=JBYT(IH(IW), 1,8)
- IB2=JBYT(IH(IW), 9,8)
- IB3=JBYT(IH(IW),17,8)
- IB4=JBYT(IH(IW),25,8)
- IOH(IW)=IB4
- CALL SBYT(IB3,IOH(IW), 9,8)
- CALL SBYT(IB2,IOH(IW),17,8)
- CALL SBYT(IB1,IOH(IW),25,8)
- 20 CONTINUE
-#endif
- END
diff --git a/src/packlib/hbook/hntup/hrztoa.F b/src/packlib/hbook/hntup/hrztoa.F
deleted file mode 100644
index 11faf51..0000000
--- a/src/packlib/hbook/hntup/hrztoa.F
+++ /dev/null
@@ -1,61 +0,0 @@
-*
-* $Id: hrztoa.F,v 1.2 1998/09/25 09:28:54 mclareni Exp $
-*
-* $Log: hrztoa.F,v $
-* Revision 1.2 1998/09/25 09:28:54 mclareni
-* Modifications for the Mklinux port flagged by CERNLIB_PPC
-*
-* Revision 1.1.1.1 1996/01/16 17:07:59 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.22/11 23/08/94 14.19.39 by Rene Brun
-*-- Author : Rene Brun 17/10/92
- SUBROUTINE HRZTOA(IH,NW)
-*
-***********************************************************************
-*
-* Converts array of NW EBCDIC hollerith words into ASCII
-*
-* Author : R.Brun CN/AS
-* Written : 17/10/92
-* Last mod: 17/10/92
-*
-***********************************************************************
-#if defined(CERNLIB_IBM)
- DIMENSION IH(1)
- PARAMETER (NCHAR = 256)
- DIMENSION IASCI(NCHAR)
- DATA IASCI/
- +4*32,9,58*32,32,10*32,46,60,40,43,124,38,9*32,33,36,42,41,59,94,
- +45,47,9*32,44,37,95,62,63,9*32,96,58,35,64,39,61,34,32,97,98,99,
- +100,101,102,103,104,105,7*32,106,107,108,109,110,111,112,113,114,
- +7*32,126,115,116,117,118,119,120,121,122,3*32,91,15*32,93,32,32,
- +123,65,66,67,68,69,70,71,72,73,6*32,125,74,75,76,77,78,79,80,81,
- +82,6*32,92,32,83,84,85,86,87,88,89,90,6*32,48,49,50,51,52,53,54,
- +55,56,57,7*32/
-*-----------------------------------
-*
- DO 20 IW=1,NW
- DO 10 I=1,25,8
- IBYTE=JBYT(IH(IW),I,8)
- CALL SBYT(IASCI(IBYTE),IH(IW),I,8)
- 10 CONTINUE
- 20 CONTINUE
-#endif
-#if defined(CERNLIB_VAX)||defined(CERNLIB_DECS)||defined(CERNLIB_MSDOS)||(defined(CERNLIB_LINUX) && !defined(CERNLIB_PPC))||defined(CERNLIB_WINNT)
- DIMENSION IH(1)
-*
- DO 20 IW=1,NW
- IB1=JBYT(IH(IW), 1,8)
- IB2=JBYT(IH(IW), 9,8)
- IB3=JBYT(IH(IW),17,8)
- IB4=JBYT(IH(IW),25,8)
- IH(IW)=IB4
- CALL SBYT(IB3,IH(IW), 9,8)
- CALL SBYT(IB2,IH(IW),17,8)
- CALL SBYT(IB1,IH(IW),25,8)
- 20 CONTINUE
-#endif
- END
diff --git a/src/packlib/hbook/hntup/huwfun.F b/src/packlib/hbook/hntup/huwfun.F
deleted file mode 100644
index 960d91c..0000000
--- a/src/packlib/hbook/hntup/huwfun.F
+++ /dev/null
@@ -1,215 +0,0 @@
-*
-* $Id: huwfun.F,v 1.6 2000/01/25 17:04:47 couet Exp $
-*
-* $Log: huwfun.F,v $
-* Revision 1.6 2000/01/25 17:04:47 couet
-* - Bug introduced during the Y2K changes
-*
-* Revision 1.5 1998/11/09 13:37:25 couet
-* - mods for Y2K
-*
-* Revision 1.4 1996/09/25 09:27:29 couet
-* - () was missing in the uwfunc generated function
-*
-* Revision 1.3 1996/05/13 10:11:14 couet
-* - The XDUMMY parameter is not put in the generated function.
-*
-* Revision 1.2 1996/02/13 15:29:46 couet
-* The VDINx variables (1 to 13) are now replaced by OBS(13).
-*
-* Revision 1.1.1.1 1996/01/16 17:07:59 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 11/10/95 17.51.26 by Julian Bunn
-*-- Author : Fons Rademakers 22/05/92
- SUBROUTINE HUWFUN(LUN, ID1, RNAME1, ITRUN, CHOPT)
-*.==========>
-*.
-*. Write user function to access N-tuple ID1.
-*. The user function will get name RNAME.
-*. The file will be written using unit LUN.
-*. All variable names will be truncated to ITRUN
-*. characters (ITRUN=0 is no truncation). CHOPT can be 'B'
-*. to make a file for Batch usage (i.e. with HBNAME calls).
-*. Or 'P' to make a PAW selection function. Option 'B' is
-*. the default.
-*. If option 'I' generates only INCLUDE file
-*.
-*..=========> ( A.A.Rademakers )
-*
-#include "hbook/hcntpar.inc"
-#include "hbook/hcflag.inc"
-#include "hbook/hcbook.inc"
-#include "hbook/hcbits.inc"
-*
- COMMON /SLATE/ ISL(40)
-*
- CHARACTER*(*) RNAME1, CHOPT
- CHARACTER*80 TITLE, RNAME
- CHARACTER*10 DATE
- CHARACTER*8 HOUR
- CHARACTER*5 SID
- LOGICAL BATCH
-*
- ID = ID1
- IDPOS = LOCATI(IQ(LTAB+1),IQ(LCDIR+KNRH),ID)
- IF (IDPOS .LE. 0) THEN
- CALL HBUG('Unknown N-tuple','HUWFUN',ID1)
- RETURN
- ENDIF
- LCID = LQ(LTAB-IDPOS)
- I4 = JBIT(IQ(LCID+KBITS),4)
- IF (I4 .EQ. 0) RETURN
- IF (IQ(LCID-2) .NE. ZLINK) THEN
- CALL HBUG('This routine does not work for old N-tuples',
- + 'HUWFUN',ID)
- RETURN
- ENDIF
-*
- ITRUNC = ITRUN
- IF (ITRUNC .LE. 0) ITRUNC = 9999
- RNAME = RNAME1(1:MIN(LENOCC(RNAME1),ITRUNC))
-*
- BATCH = .TRUE.
- IF (CHOPT(1:1) .EQ. 'B') BATCH = .TRUE.
- IF (CHOPT(1:1) .EQ. 'P') BATCH = .FALSE.
- IOPTI=INDEX(CHOPT,'I')
-*
- TITLE = ' '
-*
- LBLOK = LQ(LCID-1)
- LCHAR = LQ(LCID-2)
- LINT = LQ(LCID-3)
- LREAL = LQ(LCID-4)
-*
- ITIT1 = IQ(LCID+ZITIT1)
- NWTIT = IQ(LCID+ZNWTIT)
-*
-*-- write routine header
-*
- CALL HITOC(ID1, SID, LL, IERR)
- CALL UHTOC(IQ(LCID+ITIT1), 4, TITLE, NWTIT*4)
-*
- CALL DATIME(IIDATE,IITIME)
- IYEAR = ISL(1)
- IMONTH = ISL(2)
- IDAY = ISL(3)
- IHOUR = ISL(4)
- IMIN = ISL(5)
- ISEC = ISL(6)
- WRITE (DATE(1:2),'(I2.2)') IDAY
- DATE(3:3) = '/'
- WRITE (DATE(4:5),'(I2.2)') IMONTH
- DATE(6:6) = '/'
- WRITE (DATE(7:10),'(I4.4)') IYEAR
- WRITE (HOUR(1:2),'(I2.2)') IHOUR
- HOUR(3:3) = '.'
- WRITE (HOUR(4:5),'(I2.2)') IMIN
- HOUR(6:6) = '.'
- WRITE (HOUR(7:8),'(I2.2)') ISEC
-*
- IF (BATCH) THEN
- IF(IOPTI.EQ.0)WRITE(LUN,1000) RNAME(1:LENOCC(RNAME))
- WRITE(LUN,1001) SID, TITLE(1:LENOCC(TITLE)),
- + DATE, HOUR
- ELSE
- IF(IOPTI.EQ.0)WRITE(LUN,1500) RNAME(1:LENOCC(RNAME))
- WRITE(LUN,1501) SID, TITLE(1:LENOCC(TITLE)),
- + DATE, HOUR
- WRITE(LUN,1600)
- ENDIF
-*
-*-- write declaration and common blocks
-*
- IF (BATCH) THEN
- CALL HWDECL(LUN,ITRUNC)
- ELSE
- CALL HWPDCL(LUN,ITRUNC)
- ENDIF
-*
-*-- write HBNAME definitions
-*
- IF(IOPTI.EQ.0) THEN
- IF (BATCH) THEN
- WRITE(LUN,2000) '*'
- CALL HWBNAM(LUN,ITRUNC)
- ENDIF
- ENDIF
-*
-*-- write trailer
-*
- IF(IOPTI.EQ.0)THEN
- IF (BATCH) THEN
- WRITE(LUN,3000)
- ELSE
- WRITE(LUN,3500) RNAME(1:LENOCC(RNAME))
- ENDIF
- ENDIF
-*
-*-- formats
-*
- 1000 FORMAT(' SUBROUTINE ',A)
- 1001 FORMAT(
- + '*********************************************************',/,
- + '* *',/,
- + '* This file was generated by HUWFUN. *',/,
- + '* *',/,
- + '*********************************************************',/,
- + '*',/,
- + '* Ntuple Id: ',A,/,
- + '* Ntuple Title: ',A,/,
- + '* Creation: ',A,' ',A,/,
- + '*',/,
- + '*********************************************************',/,
- + '*')
- 1500 FORMAT(' REAL FUNCTION ',A,'()')
- 1501 FORMAT(
- + '*********************************************************',/,
- + '* *',/,
- + '* This file was generated by HUWFUN. *',/,
- + '* *',/,
- + '*********************************************************',/,
- + '*',/,
- + '* Ntuple Id: ',A,/,
- + '* Ntuple Title: ',A,/,
- + '* Creation: ',A,' ',A,/,
- + '*',/,
- + '*********************************************************',/,
- + '*')
- 1600 FORMAT(
- + ' LOGICAL CHAIN',/,
- + ' CHARACTER*128 CFILE',/,
- + ' INTEGER IDNEVT,NCHEVT,ICHEVT',/,
- + ' REAL OBS(13)',/,
- + '*',/,
- + ' COMMON /PAWIDN/ IDNEVT,OBS',/,
- + ' COMMON /PAWCHN/ CHAIN, NCHEVT, ICHEVT',/,
- + ' COMMON /PAWCHC/ CFILE',/,
- + '*',/,
- + '*-- Ntuple Variable Declarations',/,
- + '*')
- 2000 FORMAT(A)
- 3000 FORMAT(
- + '*',/,
- + /,
- + '*',/,
- + '*-- Enter user code here',/,
- + '*',/,
- + /,
- + '*',/,
- + ' END')
- 3500 FORMAT(
- + '*',/,
- + /,
- + '*',/,
- + '*-- Enter user code here',/,
- + '*',/,
- + /,
- + ' ',A,' = 1.',/,
- + '*',/,
- + ' END')
-*
- RETURN
- END
diff --git a/src/packlib/hbook/hntup/hvxist.F b/src/packlib/hbook/hntup/hvxist.F
deleted file mode 100644
index 9b1f553..0000000
--- a/src/packlib/hbook/hntup/hvxist.F
+++ /dev/null
@@ -1,93 +0,0 @@
-*
-* $Id: hvxist.F,v 1.1.1.1 1996/01/16 17:07:59 mclareni Exp $
-*
-* $Log: hvxist.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:59 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.22/04 06/06/94 20.02.51 by Fons Rademakers
-*-- Author : Fons Rademakers 19/12/91
- SUBROUTINE HVXIST(TVAR, BLOCK, CIVAR, ITYPE, ISIZE, IELEM)
-*.==========>
-*.
-*. Checks if VAR exists in this N-tuple.
-*. Returns IELEM=0 if it does not exist.
-*. Also returns the block, name of index variable, type, size
-*. and array length of the variable.
-*. These fields are ' ' or 0 when var does not exist.
-*.
-*..=========> ( A.A.Rademakers )
-*
-#include "hbook/hcntpar.inc"
-#include "hbook/hcbook.inc"
-*
- CHARACTER*(*) TVAR, BLOCK, CIVAR
- CHARACTER*32 VAR, NAME
- LOGICAL LDUM
-*
-*-- save block address (not in link area but in this routine no
-*-- relocation should happen so it will be ok)
-*
- LOLDBL = LBLOK
-*
- VAR = TVAR
- CALL CLTOU(VAR)
- LVAR = LENOCC(VAR)
- LBLOK = LQ(LCID-1)
- LCHAR = LQ(LCID-2)
- LINT = LQ(LCID-3)
- LREAL = LQ(LCID-4)
-*
- BLOCK = ' '
- CIVAR = ' '
- ITYPE = 0
- ISIZE = 0
- IELEM = 0
-*
-*-- loop over all blocks
-*
- 10 LNAME = LQ(LBLOK-1)
-*
- NDIM = IQ(LBLOK+ZNDIM)
- IOFF = 0
-*
- DO 20 I = 1, NDIM
- LL = IQ(LNAME+IOFF+ZLNAME)
- LV = IQ(LNAME+IOFF+ZNAME)
- NAME = ' '
- CALL UHTOC(IQ(LCHAR+LV), 4, NAME, LL)
- CALL CLTOU(NAME)
- IF (VAR(1:LVAR) .EQ. NAME(1:LL)) THEN
-*
- CALL UHTOC(IQ(LBLOK+ZIBLOK), 4, BLOCK, 8)
-*
- CALL HNDESC(IOFF, NSUB, ITYPE, ISIZE, NBITS, LDUM)
- IELEM = 1
- DO 25 J = 1, NSUB
- LP = IQ(LINT+IQ(LNAME+IOFF+ZARIND)+(J-1))
- IF (LP .LT. 0) THEN
- IE = -LP
- ELSE
- LL = IQ(LNAME+LP-1+ZRANGE)
- IE = IQ(LINT+LL+1)
- LL = IQ(LNAME+LP-1+ZLNAME)
- LV = IQ(LNAME+LP-1+ZNAME)
- CALL UHTOC(IQ(LCHAR+LV), 4, CIVAR, LL)
- ENDIF
- IELEM = IELEM*IE
- 25 CONTINUE
-*
- GOTO 30
- ENDIF
- IOFF = IOFF + ZNADDR
- 20 CONTINUE
-*
- LBLOK = LQ(LBLOK)
- IF (LBLOK .NE. 0) GOTO 10
-*
- 30 LBLOK = LOLDBL
- LNAME = LQ(LBLOK-1)
-*
- END
diff --git a/src/packlib/hbook/hntup/hwbnam.F b/src/packlib/hbook/hntup/hwbnam.F
deleted file mode 100644
index 7b6f4a0..0000000
--- a/src/packlib/hbook/hntup/hwbnam.F
+++ /dev/null
@@ -1,94 +0,0 @@
-*
-* $Id: hwbnam.F,v 1.1.1.1 1996/01/16 17:07:59 mclareni Exp $
-*
-* $Log: hwbnam.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:59 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.20/08 07/09/93 19.32.32 by Fons Rademakers
-*-- Author : Fons Rademakers 28/01/92
- SUBROUTINE HWBNAM(LUN, ITRUNC)
-*.==========>
-*.
-*. Write HBNAME calls for the user function.
-*. Truncate variable name to ITRUNC characters.
-*.
-*..=========> ( A.A.Rademakers )
-*
-#include "hbook/hcntpar.inc"
-#include "hbook/hcflag.inc"
-#include "hbook/hcbook.inc"
-*
- CHARACTER*80 BNAM, BNAMC
- CHARACTER*32 NAME
- CHARACTER*8 BLKNAM
- CHARACTER*5 SID
- LOGICAL LDUM
-*
- LBLOK = LQ(LCID-1)
-*
- CALL HITOC(ID, SID, LS, IERR)
- WRITE(LUN,1000) ' CALL HBNAME('//SID(1:LS)//','//
- + ''' '',0,''$CLEAR'')'
-*
-*-- loop over all blocks
-*
- 5 LNAME = LQ(LBLOK-1)
-*
- IOFF = 0
- NDIM = IQ(LBLOK+ZNDIM)
- CALL UHTOC(IQ(LBLOK+ZIBLOK), 4, BLKNAM, 8)
-*
- IFBN = 0
- BNAM = ' CALL HBNAME('//SID(1:LS)//','//''''//
- + BLKNAM(1:LENOCC(BLKNAM))//''''//','
- LPBN = LENOCC(BNAM)
-*
- IFBNC = 0
- BNAMC = ' CALL HBNAMC('//SID(1:LS)//','//''''//
- + BLKNAM(1:LENOCC(BLKNAM))//''''//','
- LPBNC = LENOCC(BNAMC)
-*
- DO 10 I = 1, NDIM
- CALL HNDESC(IOFF, NSUB, ITYPE, ISIZE, NBITS, LDUM)
- LL = IQ(LNAME+IOFF+ZLNAME)
- LV = IQ(LNAME+IOFF+ZNAME)
- NAME = ' '
- CALL UHTOC(IQ(LCHAR+LV), 4, NAME, LL)
- LL = MIN(ITRUNC,LL)
-*
-*-- construct HBNAME statement
-*
- IF (ITYPE .NE. 5) THEN
- IF (IFBN .EQ. 0) THEN
- BNAM = BNAM(1:LPBN)//NAME(1:LL)//',''$SET'')'
- IFBN = 1
- ENDIF
-*
-*-- construct HBNAMC statement
-*
- ELSE
- IF (IFBNC .EQ. 0) THEN
- BNAMC = BNAMC(1:LPBNC)//NAME(1:LL)//',''$SET'')'
- IFBNC = 1
- ENDIF
- ENDIF
-*
- IOFF = IOFF + ZNADDR
- 10 CONTINUE
-*
- IF (IFBN .NE. 0) WRITE(LUN,1000) BNAM(1:LENOCC(BNAM))
- IF (IFBNC .NE. 0) WRITE(LUN,1000) BNAMC(1:LENOCC(BNAMC))
-*
- LBLOK = LQ(LBLOK)
- IF (LBLOK .NE. 0) THEN
- WRITE(LUN,1000) '*'
- GOTO 5
- ENDIF
-*
- 1000 FORMAT(A)
-*
- END
-
diff --git a/src/packlib/hbook/hntup/hwdecl.F b/src/packlib/hbook/hntup/hwdecl.F
deleted file mode 100644
index 68c6493..0000000
--- a/src/packlib/hbook/hntup/hwdecl.F
+++ /dev/null
@@ -1,245 +0,0 @@
-*
-* $Id: hwdecl.F,v 1.1.1.1 1996/01/16 17:07:59 mclareni Exp $
-*
-* $Log: hwdecl.F,v $
-* Revision 1.1.1.1 1996/01/16 17:07:59 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.20/08 07/09/93 19.33.43 by Fons Rademakers
-*-- Author : Fons Rademakers 28/01/92
- SUBROUTINE HWDECL(LUN, ITRUNC)
-*.==========>
-*.
-*. Write integer/real common block definition for the user
-*. function. Truncate common block names and variable names
-*. to ITRUNC characters.
-*.
-*..=========> ( A.A.Rademakers )
-*
-#include "hbook/hcntpar.inc"
-#include "hbook/hcflag.inc"
-#include "hbook/hcbook.inc"
-*
- CHARACTER*80 DECLR(19),DECLR8(19),DECLI(19),DECLL(19),DECLC(19)
- CHARACTER*80 CMN(19), CMNC(19), VAR
- CHARACTER*32 NAME, SUBS
- CHARACTER*8 BLKNAM
- CHARACTER*2 SIZE
- LOGICAL LDUM
-*
- LBLOK = LQ(LCID-1)
-*
-*-- loop over all blocks
-*
- 5 LNAME = LQ(LBLOK-1)
-*
- IOFF = 0
- NDIM = IQ(LBLOK+ZNDIM)
- CALL UHTOC(IQ(LBLOK+ZIBLOK), 4, BLKNAM, 8)
-*
- IFCMN = 0
- ILCMN = 1
- CMN(ILCMN) = ' COMMON /'//
- + BLKNAM(1:MIN(ITRUNC,LENOCC(BLKNAM)))//'/'
- LPCMN = LENOCC(CMN(ILCMN)) + 1
-*
- IFCMNC = 0
- ILCMNC = 1
- CMNC(ILCMNC) = ' COMMON /'//
- + BLKNAM(1:MIN(ITRUNC-1,LENOCC(BLKNAM)))//'1/'
- LPCMNC = LENOCC(CMNC(ILCMNC)) + 1
-*
- IFDR = 0
- ILDR = 1
- DECLR(ILDR) = ' REAL'
- LPDR = LENOCC(DECLR(ILDR)) + 1
-*
- IFDR8 = 0
- ILDR8 = 1
- DECLR8(ILDR8) = ' REAL*8'
- LPDR8 = LENOCC(DECLR8(ILDR8)) + 1
-*
- IFDI = 0
- ILDI = 1
- DECLI(ILDI) = ' INTEGER'
- LPDI = LENOCC(DECLI(ILDI)) + 1
-*
- IFDL = 0
- ILDL = 1
- DECLL(ILDL) = ' LOGICAL'
- LPDL = LENOCC(DECLL(ILDL)) + 1
-*
- IFDC = 0
- ILDC = 1
- DECLC(ILDC) = ' CHARACTER'
- LPDC = LENOCC(DECLC(ILDC)) + 1
-*
- DO 10 I = 1, NDIM
- CALL HNDESC(IOFF, NSUB, ITYPE, ISIZE, NBITS, LDUM)
- LL = IQ(LNAME+IOFF+ZLNAME)
- LV = IQ(LNAME+IOFF+ZNAME)
- NAME = ' '
- CALL UHTOC(IQ(LCHAR+LV), 4, NAME, LL)
- LL = MIN(ITRUNC,LL)
- IF (NSUB .GT. 0) THEN
- VAR = NAME(1:LL)//'('
- DO 20 J = 1, NSUB
- LP = IQ(LINT+IQ(LNAME+IOFF+ZARIND)+(J-1))
- IF (LP .LT. 0) THEN
- IE = -LP
- CALL HITOC(IE, SUBS, LL, IERR)
- ELSE
- LL = IQ(LNAME+LP-1+ZRANGE)
- IMAX = IQ(LINT+LL+1)
- CALL HITOC(IMAX, SUBS, LL, IERR)
- ENDIF
- IF (J .EQ. 1) THEN
- VAR = VAR(1:LENOCC(VAR))//SUBS(1:LL)
- ELSE
- VAR = VAR(1:LENOCC(VAR))//','//SUBS(1:LL)
- ENDIF
- 20 CONTINUE
- VAR = VAR(1:LENOCC(VAR))//')'
- ELSE
- VAR = NAME(1:LL)
- ENDIF
-*
- LL = MIN(ITRUNC,LENOCC(NAME))
- LV = LENOCC(VAR)
-*
-*-- construct declaration statements
-*
- IF (ITYPE .EQ. 1) THEN
- IF (ISIZE .EQ. 4) THEN
- IF (LPDR+LL+1 .GT. 72) THEN
- ILDR = ILDR + 1
- DECLR(ILDR) = ' + ,'//NAME(1:LL)
- ELSE
- IF (IFDR .EQ. 0) THEN
- DECLR(ILDR) = DECLR(ILDR)(1:LPDR)//NAME(1:LL)
- ELSE
- DECLR(ILDR) = DECLR(ILDR)(1:LPDR)//','//NAME(1:LL)
- ENDIF
- IFDR = 1
- ENDIF
- LPDR = LENOCC(DECLR(ILDR))
- ELSEIF (ISIZE .EQ. 8) THEN
- IF (LPDR8+LL+1 .GT. 72) THEN
- ILDR8 = ILDR8 + 1
- DECLR8(ILDR8) = ' + ,'//NAME(1:LL)
- ELSE
- IF (IFDR8 .EQ. 0) THEN
- DECLR8(ILDR8) = DECLR8(ILDR8)(1:LPDR8)//NAME(1:LL)
- ELSE
- DECLR8(ILDR8) = DECLR8(ILDR8)(1:LPDR8)//','//
- + NAME(1:LL)
- ENDIF
- IFDR8 = 1
- ENDIF
- LPDR8 = LENOCC(DECLR8(ILDR8))
- ENDIF
- ELSEIF (ITYPE .EQ. 2 .OR. ITYPE .EQ. 3) THEN
- IF (LPDI+LL+1 .GT. 72) THEN
- ILDI = ILDI + 1
- DECLI(ILDI) = ' + ,'//NAME(1:LL)
- ELSE
- IF (IFDI .EQ. 0) THEN
- DECLI(ILDI) = DECLI(ILDI)(1:LPDI)//NAME(1:LL)
- ELSE
- DECLI(ILDI) = DECLI(ILDI)(1:LPDI)//','//NAME(1:LL)
- ENDIF
- IFDI = 1
- ENDIF
- LPDI = LENOCC(DECLI(ILDI))
- ELSEIF (ITYPE .EQ. 4) THEN
- IF (LPDL+LL+1 .GT. 72) THEN
- ILDL = ILDL + 1
- DECLL(ILDL) = ' + ,'//NAME(1:LL)
- ELSE
- IF (IFDL .EQ. 0) THEN
- DECLL(ILDL) = DECLL(ILDL)(1:LPDL)//NAME(1:LL)
- ELSE
- DECLL(ILDL) = DECLL(ILDL)(1:LPDL)//','//NAME(1:LL)
- ENDIF
- IFDL = 1
- ENDIF
- LPDL = LENOCC(DECLL(ILDL))
- ELSEIF (ITYPE .EQ. 5) THEN
- CALL HITOC(ISIZE, SIZE, LS, IERR)
- IF (LPDC+LL+LS+2 .GT. 72) THEN
- ILDC = ILDC + 1
- DECLC(ILDC) = ' + ,'//NAME(1:LL)//
- + '*'//SIZE(1:LS)
- ELSE
- IF (IFDC .EQ. 0) THEN
- DECLC(ILDC) = DECLC(ILDC)(1:LPDC)//NAME(1:LL)//
- + '*'//SIZE(1:LS)
- ELSE
- DECLC(ILDC) = DECLC(ILDC)(1:LPDC)//','//NAME(1:LL)//
- + '*'//SIZE(1:LS)
- ENDIF
- IFDC = 1
- ENDIF
- LPDC = LENOCC(DECLC(ILDC))
- ENDIF
-*
-*-- construct common statements
-*
- IF (ITYPE .NE. 5) THEN
- IF (LPCMN+LV+1 .GT. 72) THEN
- ILCMN = ILCMN + 1
- CMN(ILCMN) = ' + ,'//VAR(1:LV)
- ELSE
- IF (IFCMN .EQ. 0) THEN
- CMN(ILCMN) = CMN(ILCMN)(1:LPCMN)//VAR(1:LV)
- ELSE
- CMN(ILCMN) = CMN(ILCMN)(1:LPCMN)//','//VAR(1:LV)
- ENDIF
- IFCMN = 1
- ENDIF
- LPCMN = LENOCC(CMN(ILCMN))
- ELSE
- IF (LPCMNC+LV+1 .GT. 72) THEN
- ILCMNC = ILCMNC + 1
- CMNC(ILCMNC) = ' + ,'//VAR(1:LV)
- ELSE
- IF (IFCMNC .EQ. 0) THEN
- CMNC(ILCMNC) = CMNC(ILCMNC)(1:LPCMNC)//VAR(1:LV)
- ELSE
- CMNC(ILCMNC) = CMNC(ILCMNC)(1:LPCMNC)//','//
- + VAR(1:LV)
- ENDIF
- IFCMNC = 1
- ENDIF
- LPCMNC = LENOCC(CMNC(ILCMNC))
- ENDIF
-*
- IOFF = IOFF + ZNADDR
- 10 CONTINUE
-*
- IF (IFDR .NE. 0) WRITE(LUN,1000) (DECLR(I)(1:LENOCC(DECLR(I))),
- + I = 1, ILDR)
- IF (IFDR8.NE. 0) WRITE(LUN,1000) (DECLR8(I)(1:LENOCC(DECLR8(I))),
- + I = 1, ILDR8)
- IF (IFDI .NE. 0) WRITE(LUN,1000) (DECLI(I)(1:LENOCC(DECLI(I))),
- + I = 1, ILDI)
- IF (IFDL .NE. 0) WRITE(LUN,1000) (DECLL(I)(1:LENOCC(DECLL(I))),
- + I = 1, ILDL)
- IF (IFDC .NE. 0) WRITE(LUN,1000) (DECLC(I)(1:LENOCC(DECLC(I))),
- + I = 1, ILDC)
- IF (IFCMN .NE. 0) WRITE(LUN,1000) (CMN(I)(1:LENOCC(CMN(I))),
- + I = 1, ILCMN)
- IF (IFCMNC .NE. 0) WRITE(LUN,1000) (CMNC(I)(1:LENOCC(CMNC(I))),
- + I = 1, ILCMNC)
-*
- LBLOK = LQ(LBLOK)
- IF (LBLOK .NE. 0) THEN
- WRITE(LUN,1000) '*'
- GOTO 5
- ENDIF
-*
- 1000 FORMAT(A)
-*
- END
diff --git a/src/packlib/hbook/hntup/hwpdcl.F b/src/packlib/hbook/hntup/hwpdcl.F
deleted file mode 100644
index 70df256..0000000
--- a/src/packlib/hbook/hntup/hwpdcl.F
+++ /dev/null
@@ -1,342 +0,0 @@
-*
-* $Id: hwpdcl.F,v 1.3 1999/03/23 14:39:52 couet Exp $
-*
-* $Log: hwpdcl.F,v $
-* Revision 1.3 1999/03/23 14:39:52 couet
-* - previous commit was wrong ...
-*
-* Revision 1.2 1999/03/23 14:38:04 couet
-* - ?
-*
-* Revision 1.1.1.1 1996/01/16 17:07:59 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.22/04 30/05/94 22.34.21 by Rene Brun
-*-- Author : Fons Rademakers 28/01/92
- SUBROUTINE HWPDCL(LUN, ITRUNC)
-*.==========>
-*.
-*. Write integer, real, logical, character declarations for
-*. the PAW user function. Truncate variable names
-*. to ITRUNC characters.
-*.
-*..=========> ( A.A.Rademakers )
-*
-#include "hbook/hcntpar.inc"
-#include "hbook/hcflag.inc"
-#include "hbook/hcbook.inc"
-*
- PARAMETER (MAXCON = 19, MAXCMN = 50)
- CHARACTER*80 DECLR(MAXCON),DECLR8(MAXCON),DECLI(MAXCON)
- CHARACTER*80 DECLL(MAXCON),DECLC(MAXCON)
- CHARACTER*80 CMNR4(MAXCMN), CMNR8(MAXCMN), CMNC32(MAXCMN), VAR
- CHARACTER*32 NAME, SUBS
- CHARACTER*8 BLKNAM
- LOGICAL INITR, INITR8, INITI, INITL, INITC,
- + INICM4, INICM8, INIC32, LDUM
-*
- INITR = .TRUE.
- INITR8 = .TRUE.
- INITI = .TRUE.
- INITL = .TRUE.
- INITC = .TRUE.
- INICM4 = .TRUE.
- INICM8 = .TRUE.
- INIC32 = .TRUE.
- IFDR = 0
- IFDR8 = 0
- IFDI = 0
- IFDL = 0
- IFDC = 0
- IFCM4 = 0
- IFCM8 = 0
- IFCM32 = 0
-*
- LBLOK = LQ(LCID-1)
-*
-*-- loop over all blocks
-*
- 5 LNAME = LQ(LBLOK-1)
-*
- IOFF = 0
- NDIM = IQ(LBLOK+ZNDIM)
- CALL UHTOC(IQ(LBLOK+ZIBLOK), 4, BLKNAM, 8)
-*
- DO 10 I = 1, NDIM
-*
- IF (INITR) THEN
- IF (IFDR .NE. 0) WRITE(LUN,1000)
- + (DECLR(II)(1:LENOCC(DECLR(II))), II = 1, ILDR)
- IFDR = 0
- ILDR = 1
- DECLR(ILDR) = ' REAL'
- LPDR = LENOCC(DECLR(ILDR)) + 1
- INITR = .FALSE.
- ENDIF
-*
- IF (INITR8) THEN
- IF (IFDR8.NE. 0) WRITE(LUN,1000)
- + (DECLR8(II)(1:LENOCC(DECLR8(II))), II = 1, ILDR8)
- IFDR8 = 0
- ILDR8 = 1
- DECLR8(ILDR8) = ' DOUBLE PRECISION'
- LPDR8 = LENOCC(DECLR8(ILDR8)) + 1
- INITR8 = .FALSE.
- ENDIF
-*
- IF (INITI) THEN
- IF (IFDI .NE. 0) WRITE(LUN,1000)
- + (DECLI(II)(1:LENOCC(DECLI(II))), II = 1, ILDI)
- IFDI = 0
- ILDI = 1
- DECLI(ILDI) = ' INTEGER'
- LPDI = LENOCC(DECLI(ILDI)) + 1
- INITI = .FALSE.
- ENDIF
-*
- IF (INITL) THEN
- IF (IFDL .NE. 0) WRITE(LUN,1000)
- + (DECLL(II)(1:LENOCC(DECLL(II))), II = 1, ILDL)
- IFDL = 0
- ILDL = 1
- DECLL(ILDL) = ' LOGICAL'
- LPDL = LENOCC(DECLL(ILDL)) + 1
- INITL = .FALSE.
- ENDIF
-*
- IF (INITC) THEN
- IF (IFDC .NE. 0) WRITE(LUN,1000)
- + (DECLC(II)(1:LENOCC(DECLC(II))), II = 1, ILDC)
- IFDC = 0
- ILDC = 1
- DECLC(ILDC) = ' CHARACTER*32'
- LPDC = LENOCC(DECLC(ILDC)) + 1
- INITC = .FALSE.
- ENDIF
-*
- IF (INICM4) THEN
- IF (IFCM4 .NE. 0) THEN
- PRINT *,' HUWFUN: Not space to store COMMON definition'
- GOTO 30
- ENDIF
- IFCM4 = 0
- ILCM4 = 1
- CMNR4(ILCM4) = ' COMMON /PAWCR4/'
- LPCM4 = LENOCC(CMNR4(ILCM4)) + 1
- INICM4 = .FALSE.
- ENDIF
-*
- IF (INICM8) THEN
- IF (IFCM8 .NE. 0) THEN
- PRINT *,' HUWFUN: Not space to store COMMON definition'
- GOTO 30
- ENDIF
- IFCM8 = 0
- ILCM8 = 1
- CMNR8(ILCM8) = ' COMMON /PAWCR8/'
- LPCM8 = LENOCC(CMNR8(ILCM8)) + 1
- INICM8 = .FALSE.
- ENDIF
-*
- IF (INIC32) THEN
- IF (IFCM32 .NE. 0) THEN
- PRINT *,' HUWFUN: Not space to store COMMON definition'
- GOTO 30
- ENDIF
- IFCM32 = 0
- ILCM32 = 1
- CMNC32(ILDC) = ' COMMON /PAWC32/'
- LPCM32 = LENOCC(CMNC32(ILCM32)) + 1
- INIC32 = .FALSE.
- ENDIF
-*
- CALL HNDESC(IOFF, NSUB, ITYPE, ISIZE, NBITS, LDUM)
- LL = IQ(LNAME+IOFF+ZLNAME)
- LV = IQ(LNAME+IOFF+ZNAME)
- NAME = ' '
- CALL UHTOC(IQ(LCHAR+LV), 4, NAME, LL)
- LL = MIN(ITRUNC,LL)
- IF (NSUB .GT. 0) THEN
- VAR = NAME(1:LL)//'('
- DO 20 J = 1, NSUB
- LP = IQ(LINT+IQ(LNAME+IOFF+ZARIND)+(J-1))
- IF (LP .LT. 0) THEN
- IE = -LP
- CALL HITOC(IE, SUBS, LL, IERR)
- ELSE
- LL = IQ(LNAME+LP-1+ZRANGE)
- IMAX = IQ(LINT+LL+1)
- CALL HITOC(IMAX, SUBS, LL, IERR)
- ENDIF
- IF (J .EQ. 1) THEN
- VAR = VAR(1:LENOCC(VAR))//SUBS(1:LL)
- ELSE
- VAR = VAR(1:LENOCC(VAR))//','//SUBS(1:LL)
- ENDIF
- 20 CONTINUE
- VAR = VAR(1:LENOCC(VAR))//')'
- ELSE
- VAR = NAME(1:LL)
- ENDIF
-*
- LL = MIN(ITRUNC,LENOCC(NAME))
- LV = LENOCC(VAR)
-*
-*-- construct declaration statements
-*
- IF (ITYPE .EQ. 1) THEN
- IF (ISIZE .EQ. 4) THEN
- IF (LPDR+LV+1 .GT. 72) THEN
- ILDR = ILDR + 1
- DECLR(ILDR) = ' + ,'//VAR(1:LV)
- ELSE
- IF (IFDR .EQ. 0) THEN
- DECLR(ILDR) = DECLR(ILDR)(1:LPDR)//VAR(1:LV)
- ELSE
- DECLR(ILDR) = DECLR(ILDR)(1:LPDR)//','//VAR(1:LV)
- ENDIF
- IFDR = 1
- ENDIF
- LPDR = LENOCC(DECLR(ILDR))
- IF (ILDR .EQ. MAXCON) INITR = .TRUE.
- ELSEIF (ISIZE .EQ. 8) THEN
- IF (LPDR8+LV+1 .GT. 72) THEN
- ILDR8 = ILDR8 + 1
- DECLR8(ILDR8) = ' + ,'//VAR(1:LV)
- ELSE
- IF (IFDR8 .EQ. 0) THEN
- DECLR8(ILDR8) = DECLR8(ILDR8)(1:LPDR8)//VAR(1:LV)
- ELSE
- DECLR8(ILDR8) = DECLR8(ILDR8)(1:LPDR8)//','//
- + VAR(1:LV)
- ENDIF
- IFDR8 = 1
- ENDIF
- LPDR8 = LENOCC(DECLR8(ILDR8))
- IF (ILDR8 .EQ. MAXCON) INITR8 = .TRUE.
- ENDIF
- ELSEIF (ITYPE .EQ. 2 .OR. ITYPE .EQ. 3) THEN
- IF (LPDI+LV+1 .GT. 72) THEN
- ILDI = ILDI + 1
- DECLI(ILDI) = ' + ,'//VAR(1:LV)
- ELSE
- IF (IFDI .EQ. 0) THEN
- DECLI(ILDI) = DECLI(ILDI)(1:LPDI)//VAR(1:LV)
- ELSE
- DECLI(ILDI) = DECLI(ILDI)(1:LPDI)//','//VAR(1:LV)
- ENDIF
- IFDI = 1
- ENDIF
- LPDI = LENOCC(DECLI(ILDI))
- IF (ILDI .EQ. MAXCON) INITI = .TRUE.
- ELSEIF (ITYPE .EQ. 4) THEN
- IF (LPDL+LV+1 .GT. 72) THEN
- ILDL = ILDL + 1
- DECLL(ILDL) = ' + ,'//VAR(1:LV)
- ELSE
- IF (IFDL .EQ. 0) THEN
- DECLL(ILDL) = DECLL(ILDL)(1:LPDL)//VAR(1:LV)
- ELSE
- DECLL(ILDL) = DECLL(ILDL)(1:LPDL)//','//VAR(1:LV)
- ENDIF
- IFDL = 1
- ENDIF
- LPDL = LENOCC(DECLL(ILDL))
- IF (ILDL .EQ. MAXCON) INITL = .TRUE.
- ELSEIF (ITYPE .EQ. 5) THEN
- IF (LPDC+LV+1 .GT. 72) THEN
- ILDC = ILDC + 1
- DECLC(ILDC) = ' + ,'//VAR(1:LV)
- ELSE
- IF (IFDC .EQ. 0) THEN
- DECLC(ILDC) = DECLC(ILDC)(1:LPDC)//VAR(1:LV)
- ELSE
- DECLC(ILDC) = DECLC(ILDC)(1:LPDC)//','//VAR(1:LV)
- ENDIF
- IFDC = 1
- ENDIF
- LPDC = LENOCC(DECLC(ILDC))
- IF (ILDC .EQ. MAXCON) INITC = .TRUE.
- ENDIF
-*
-*-- construct COMMON statements
-*
- IF (ITYPE .NE. 5) THEN
- IF (ISIZE .EQ. 4) THEN
- IF (LPCM4+LL+1 .GT. 72) THEN
- ILCM4 = ILCM4 + 1
- CMNR4(ILCM4) = ' + ,'//NAME(1:LL)
- ELSE
- IF (IFCM4 .EQ. 0) THEN
- CMNR4(ILCM4) = CMNR4(ILCM4)(1:LPCM4)//NAME(1:LL)
- ELSE
- CMNR4(ILCM4) = CMNR4(ILCM4)(1:LPCM4)//','//
- + NAME(1:LL)
- ENDIF
- IFCM4 = 1
- ENDIF
- LPCM4 = LENOCC(CMNR4(ILCM4))
- IF (ILCM4 .EQ. MAXCMN) INICM4 = .TRUE.
- ELSEIF (ISIZE .EQ. 8) THEN
- IF (LPCM8+LL+1 .GT. 72) THEN
- ILCM8 = ILCM8 + 1
- CMNR8(ILCM8) = ' + ,'//NAME(1:LL)
- ELSE
- IF (IFCM8 .EQ. 0) THEN
- CMNR8(ILCM8) = CMNR8(ILCM8)(1:LPCM8)//NAME(1:LL)
- ELSE
- CMNR8(ILCM8) = CMNR8(ILCM8)(1:LPCM8)//','//
- + NAME(1:LL)
- ENDIF
- IFCM8 = 1
- ENDIF
- LPCM8 = LENOCC(CMNR8(ILCM8))
- IF (ILCM8 .EQ. MAXCMN) INICM8 = .TRUE.
- ENDIF
- ELSE
- IF (LPCM32+LL+1 .GT. 72) THEN
- ILCM32 = ILCM32 + 1
- CMNC32(ILCM32) = ' + ,'//NAME(1:LL)
- ELSE
- IF (IFCM32 .EQ. 0) THEN
- CMNC32(ILCM32) = CMNC32(ILCM32)(1:LPCM32)//NAME(1:LL)
- ELSE
- CMNC32(ILCM32) = CMNC32(ILCM32)(1:LPCM32)//','//
- + NAME(1:LL)
- ENDIF
- IFCM32 = 1
- ENDIF
- LPCM32 = LENOCC(CMNC32(ILCM32))
- IF (ILCM32 .EQ. MAXCMN) INIC32 = .TRUE.
- ENDIF
-*
- IOFF = IOFF + ZNADDR
- 10 CONTINUE
-*
- LBLOK = LQ(LBLOK)
- IF (LBLOK .NE. 0) GOTO 5
-*
- 30 IF (IFDR .NE. 0) WRITE(LUN,1000) (DECLR(I)(1:LENOCC(DECLR(I))),
- + I = 1, ILDR)
- IF (IFDR8.NE. 0) WRITE(LUN,1000) (DECLR8(I)(1:LENOCC(DECLR8(I))),
- + I = 1, ILDR8)
- IF (IFDI .NE. 0) WRITE(LUN,1000) (DECLI(I)(1:LENOCC(DECLI(I))),
- + I = 1, ILDI)
- IF (IFDL .NE. 0) WRITE(LUN,1000) (DECLL(I)(1:LENOCC(DECLL(I))),
- + I = 1, ILDL)
- IF (IFDC .NE. 0) WRITE(LUN,1000) (DECLC(I)(1:LENOCC(DECLC(I))),
- + I = 1, ILDC)
- WRITE(LUN,1000) '*'
- IF (IFCM4 .NE. 0) WRITE(LUN,1000)(CMNR4(I)(1:LENOCC(CMNR4(I))),
- + I = 1, ILCM4)
- IF (IFCM8 .NE. 0) WRITE(LUN,1000)(CMNR8(I)(1:LENOCC(CMNR8(I))),
- + I = 1, ILCM8)
- IF (IFCM32 .NE. 0)WRITE(LUN,1000)(CMNC32(I)(1:LENOCC(CMNC32(I))),
- + I = 1, ILCM32)
-*
- 1000 FORMAT(A)
-*
- END
-
diff --git a/src/packlib/hbook/hquad/Imakefile b/src/packlib/hbook/hquad/Imakefile
deleted file mode 100644
index 5f7911c..0000000
--- a/src/packlib/hbook/hquad/Imakefile
+++ /dev/null
@@ -1,9 +0,0 @@
-SRCS_F= hqbin.F hqd.F hqdd.F hqddj.F hqddjn.F hqdj.F hqdjn.F hqdn.F \ @@\
- hqend.F hqf.F hqfer.F hqfnl.F hqfpl.F hqgetf.F hqgiv.F hqin.F \ @@\
- hqinit.F hqlif1.F hqlif2.F hqlif3.F hqlsqc.F hqlsqu.F hqmxa1.F \ @@\
- hqmxa2.F hqmxa3.F hqmxb1.F hqmxb2.F hqmxb3.F hqmxc1.F hqmxc2.F \ @@\
- hqmxc3.F hqmxli.F hqout.F hqpois.F hqputf.F hqsig.F hqsig1.F \ @@\
- hqsig2.F hqsig3.F hqsiga.F hqsolv.F hqssv.F hquad.F hqwave.F \ @@\
- hqwrif.F hqxi.F hqmnu.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/hbook/hquad/hqbin.F b/src/packlib/hbook/hquad/hqbin.F
deleted file mode 100644
index 48b0584..0000000
--- a/src/packlib/hbook/hquad/hqbin.F
+++ /dev/null
@@ -1,227 +0,0 @@
-*
-* $Id: hqbin.F,v 1.2 1997/09/18 07:24:23 couet Exp $
-*
-* $Log: hqbin.F,v $
-* Revision 1.2 1997/09/18 07:24:23 couet
-* - Bug fixed by Pierre Astier <astier at lpnax1.in2p3.fr>
-*
-* " I experienced a crash (floating invalid) in hqpois called by hquad when i
-* running on a large ntuple. This was due to a division by zero which should
-* not happen given the preprocessing done by hqbin. hqbin takes copies of
-* links belonging to a link area (l1v,l1h,...) into local variables (lv,lh).
-* Then in case of an ntuple, it scans the tuple. Finally it does some
-* postprocessing using lv and lh to index the data. My crash was due to the
-* fact that the tuple scan is causing some bank displacements, which are
-* reflected in l1v,l1h ... but not in their local copies. As far as I know
-* this is a very common trap when using zebra. I fixed the problem and my
-* crash disappeared."
-*
-* Revision 1.1.1.1 1996/01/16 17:08:00 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.17/03 13/01/93 12.14.18 by John Allison
-*-- Author : John Allison 12/09/92
- SUBROUTINE HQBIN (NN, IVMODE, IHQERR)
- INTEGER NN (*), IVMODE, IHQERR
-* Makes the MQ histogram in L1H or L2H etc.:
-* (a) from HBOOK histogram or
-* (b) MQ "eventogram".
-*
-* NN is a vector of nos. of bins in each coordinate (normally equal to NX etc.).
-* (Note: (a) NN must be compatible with the HBOOK histogram or
-* (b) its elements must be less than or equal to those notified to
-* HQINIT at initialisation.)
-* IVMODE = 0, do NOT set variance of empty bins (i.e., for HQSIG etc.).
-* = 1, set variance of empty bins equal to square of mean variance, i.e.,
-* the variance it should have in the "extreme gaussian
-* approximation", for the purpose of least squares fitting.
-* IHQERR = 0 if all's OK.
-
-#include "hbook/hcqcom.inc"
-#include "hbook/hcbook.inc"
-#include "hbook/hcunit.inc"
-
- CHARACTER*80 CHQMES
- INTEGER NNX, NNY, NNZ, NNBTOT
- INTEGER I, IX, IY, IZ, L, LH, LV
- INTEGER NOUT
- REAL H, WEIGHT
-* Note: V has to be big enough to accept all variables, but only 1st 3 are used.
-* (No. is checked in HQUAD.)
- REAL V (NSMAX), X, Y, Z
- EQUIVALENCE (X, V(1)), (Y, V(2)), (Z, V(3))
-
- IHQERR = 0
-
- IF (NDIM .EQ. 1) THEN
- NNX = NN (1)
- NNBTOT = NNX
- LH = L1H
- LV = L1V
- ELSE IF (NDIM .EQ. 2) THEN
- NNX = NN (1)
- NNY = NN (2)
- NNBTOT = NNX * NNY
- LH = L2H
- LV = L2V
- ELSE IF (NDIM .EQ. 3) THEN
- NNX = NN (1)
- NNY = NN (2)
- NNZ = NN (3)
- NNBTOT = NNX * NNY * NNZ
- LH = L3H
- LV = L3V
- ELSE
- GO TO 80
- END IF
-
- IF (NTUPLE) THEN
- CALL HGNPAR (IDMQ, 'HQBIN')
- IF (LCIDN .LE. 0) GO TO 90
- CALL UZERO (Q, LH + 1, LH + NNBTOT)
- CALL UZERO (Q, LV + 1, LV + NNBTOT)
- NOUT = 0
- IF (NDIM .EQ. 1) THEN
- DO 10 I = 1, NMQEVS
- CALL HGNF (IDMQ, I, V, IHQERR)
- IF (IHQERR .NE. 0) GO TO 100
- IF (X .LT. XMI .OR. X .GT. XMA) THEN
- NOUT = NOUT + 1
- ELSE
- IX = NNX * (X - XMI) / DXT
- IF (IX .GE. NNX) IX = NNX - 1
- L = IX + 1
- WEIGHT = 1.
- Q (L1H + L) = Q (L1H + L) + WEIGHT
- Q (L1V + L) = Q (L1V + L) + WEIGHT ** 2
- END IF
- 10 CONTINUE
- ELSE IF (NDIM .EQ. 2) THEN
- DO 20 I = 1, NMQEVS
- CALL HGNF (IDMQ, I, V, IHQERR)
- IF (IHQERR .NE. 0) GO TO 100
- IF (X .LT. XMI .OR. X .GT. XMA .OR.
- + Y .LT. YMI .OR. Y .GT. YMA) THEN
- NOUT = NOUT + 1
- ELSE
- IX = NNX * (X - XMI) / DXT
- IY = NNY * (Y - YMI) / DYT
- IF (IX .GE. NNX) IX = NNX - 1
- IF (IY .GE. NNY) IY = NNY - 1
- L = NNX * IY + IX + 1
- WEIGHT = 1.
- Q (L2H + L) = Q (L2H + L) + WEIGHT
- Q (L2V + L) = Q (L2V + L) + WEIGHT ** 2
- END IF
- 20 CONTINUE
- ELSE IF (NDIM .EQ. 3) THEN
- DO 30 I = 1, NMQEVS
- CALL HGNF (IDMQ, I, V, IHQERR)
- IF (IHQERR .NE. 0) GO TO 100
- IF (X .LT. XMI .OR. X .GT. XMA .OR.
- + Y .LT. YMI .OR. Y .GT. YMA .OR.
- + Z .LT. ZMI .OR. Z .GT. ZMA) THEN
- NOUT = NOUT + 1
- ELSE
- IX = NNX * (X - XMI) / DXT
- IY = NNY * (Y - YMI) / DYT
- IZ = NNZ * (Z - ZMI) / DZT
- IF (IX .GE. NNX) IX = NNX - 1
- IF (IY .GE. NNY) IY = NNY - 1
- IF (IZ .GE. NNZ) IZ = NNZ - 1
- L = NNX * NNY * IZ + NNX * IY + IX + 1
- WEIGHT = 1.
- Q (L3H + L) = Q (L3H + L) + WEIGHT
- Q (L3V + L) = Q (L3V + L) + WEIGHT ** 2
- END IF
- 30 CONTINUE
- ELSE
- GO TO 80
- END IF
- IF (NOUT .GT. 0) WRITE (LOUT, 10000) NOUT
- ELSE
- CALL HUNPAK (IDMQ, Q (LH + 1), 'HIST', 0)
- CALL HUNPKE (IDMQ, Q (LV + 1), 'HIST', 0)
-* Note: although it says ' ' is equivalent to 'HIST' for HUNPAK, it isn't
-* for the undocumented routine HUNPKE. For the latter, to get stored
-* errors, one must specify 'HIST'.
- DO 40 L = 1, NNBTOT
- Q (LV + L) = VSCALE * Q (LV + L) ** 2
- 40 CONTINUE
- END IF
-*
-* Bug fixed by: Pierre Astier <astier at lpnax1.in2p3.fr>
-*
-* HGNF may have changed l{1,2,3}{V,H} for large ntuples,
-* copy LV, LH once again.
-*
-* >>>>
- IF (NDIM .EQ. 1) THEN
- LH = L1H
- LV = L1V
- ELSE IF (NDIM .EQ. 2) THEN
- LH = L2H
- LV = L2V
- ELSE IF (NDIM .EQ. 3) THEN
- LH = L3H
- LV = L3V
- END IF
-* <<<<
-
-* Find HQMIN, HQMAX and NMQFUL.
- HQMIN = 1.E20
- HQMAX = -1.E20
- NMQFUL = 0
- DO 50 L = 1, NNBTOT
- H = Q (LH + L)
- IF (H .NE. 0.) NMQFUL = NMQFUL + 1
- IF (HQMIN .GT. H) HQMIN = H
- IF (HQMAX .LT. H) HQMAX = H
- 50 CONTINUE
-
-* Compute mean variance.
- WMQEVS = 0.
- VMEAN1 = 0.
- DO 60 L = 1, NNBTOT
- WMQEVS = WMQEVS + Q (LH + L)
- VMEAN1 = VMEAN1 + Q (LV + L)
- 60 CONTINUE
- IF (WMQEVS .EQ. 0.) GO TO 110
- VMEAN1 = VMEAN1 / WMQEVS
- VMEAN2 = VMEAN1 ** 2
-
-* Set variances of empty bins to VMEAN2 if requested.
- IF (IVMODE .EQ. 1) THEN
- DO 70 L = 1, NNBTOT
- IF (Q (LV + L) .EQ. 0.) Q (LV + L) = VMEAN2
- 70 CONTINUE
- END IF
-
- GO TO 130
-
- 80 CONTINUE
- WRITE (CHQMES, '(I3, '' dimensions not programmed yet.'')') NDIM
- IHQERR = 1
- GO TO 120
- 90 CONTINUE
- WRITE (CHQMES, '(''Invalid link'', I10, '' from HGNPAR.'')')
- +LCIDN
- GO TO 120
- 100 CONTINUE
- WRITE (CHQMES, '(''Error'', I3, '' in HGNF.'')') IHQERR
- GO TO 120
- 110 CONTINUE
- CHQMES = 'No events.'
- IHQERR = 2
- GO TO 120
-
- 120 CONTINUE
- CALL HBUG (CHQMES, 'HQBIN', IDMQ)
-
- 130 CONTINUE
-
-10000 FORMAT (1X, 'HQBIN: Warning -', I10, ' events outside range.')
-
- END
diff --git a/src/packlib/hbook/hquad/hqd.F b/src/packlib/hbook/hquad/hqd.F
deleted file mode 100644
index 2ab1709..0000000
--- a/src/packlib/hbook/hquad/hqd.F
+++ /dev/null
@@ -1,39 +0,0 @@
-*
-* $Id: hqd.F,v 1.1.1.1 1996/01/16 17:08:00 mclareni Exp $
-*
-* $Log: hqd.F,v $
-* Revision 1.1.1.1 1996/01/16 17:08:00 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.17/01 22/11/92 12.11.50 by John Allison
-*-- Author :
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION FUNCTION HQD (V)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- REAL FUNCTION HQD (V)
-#endif
- REAL V (*)
-* Determines sum of multiquadrics.
-* V is coordinate vector in plot coordinates.
-
-#include "hbook/hcqcom.inc"
-#include "hbook/hcqcor.inc"
-
- INTEGER J
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION HQDJ
-#endif
-#if !defined(CERNLIB_DOUBLE)
- REAL HQDJ
-#endif
-
- HQD = 0.
-
- DO 10 J = 1, NSIG
- HQD = HQD + SIGA (J) * HQDJ (V, J)
- 10 CONTINUE
-
- END
diff --git a/src/packlib/hbook/hquad/hqdd.F b/src/packlib/hbook/hquad/hqdd.F
deleted file mode 100644
index aad983a..0000000
--- a/src/packlib/hbook/hquad/hqdd.F
+++ /dev/null
@@ -1,40 +0,0 @@
-*
-* $Id: hqdd.F,v 1.1.1.1 1996/01/16 17:08:00 mclareni Exp $
-*
-* $Log: hqdd.F,v $
-* Revision 1.1.1.1 1996/01/16 17:08:00 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.17/01 22/11/92 12.11.50 by John Allison
-*-- Author :
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION FUNCTION HQDD (V)
- DOUBLE PRECISION V (*)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- REAL FUNCTION HQDD (V)
- REAL V (*)
-#endif
-* Determines sum of multiquadrics.
-* V is DOUBLE PRECISION coordinate vector in plot coordinates.
-
-#include "hbook/hcqcom.inc"
-#include "hbook/hcqcor.inc"
-
- INTEGER J
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION HQDDJ
-#endif
-#if !defined(CERNLIB_DOUBLE)
- REAL HQDDJ
-#endif
-
- HQDD = 0.
-
- DO 10 J = 1, NSIG
- HQDD = HQDD + SIGA (J) * HQDDJ (V, J)
- 10 CONTINUE
-
- END
diff --git a/src/packlib/hbook/hquad/hqddj.F b/src/packlib/hbook/hquad/hqddj.F
deleted file mode 100644
index 479cc25..0000000
--- a/src/packlib/hbook/hquad/hqddj.F
+++ /dev/null
@@ -1,42 +0,0 @@
-*
-* $Id: hqddj.F,v 1.1.1.1 1996/01/16 17:08:00 mclareni Exp $
-*
-* $Log: hqddj.F,v $
-* Revision 1.1.1.1 1996/01/16 17:08:00 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.17/01 22/11/92 12.11.50 by John Allison
-*-- Author :
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION FUNCTION HQDDJ (V, J)
- DOUBLE PRECISION V (*)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- REAL FUNCTION HQDDJ (V, J)
- REAL V (*)
-#endif
- INTEGER J
-* Determines J'th multiquadric.
-* V is DOUBLE PRECISION coordinate vector in plot coordinates.
-
-#include "hbook/hcqcom.inc"
-
- INTEGER IDIM
-* V1 is coordinate vector in NORMALISED coordinates.
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION V1 (NDMAX), HQDDJN
-#endif
-#if !defined(CERNLIB_DOUBLE)
- REAL V1 (NDMAX), HQDDJN
-#endif
-
- DO 10 IDIM = 1, NDIM
- V1 (IDIM) = (V (IDIM) - DBLE (SIGVMI (IDIM))) /
- + DBLE (SIGVT (IDIM))
- 10 CONTINUE
-
- HQDDJ = HQDDJN (V1, J)
-
- END
diff --git a/src/packlib/hbook/hquad/hqddjn.F b/src/packlib/hbook/hquad/hqddjn.F
deleted file mode 100644
index 71ace03..0000000
--- a/src/packlib/hbook/hquad/hqddjn.F
+++ /dev/null
@@ -1,39 +0,0 @@
-*
-* $Id: hqddjn.F,v 1.1.1.1 1996/01/16 17:08:00 mclareni Exp $
-*
-* $Log: hqddjn.F,v $
-* Revision 1.1.1.1 1996/01/16 17:08:00 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.17/01 22/11/92 12.11.50 by John Allison
-*-- Author :
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION FUNCTION HQDDJN (V, J)
- DOUBLE PRECISION V (*)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- REAL FUNCTION HQDDJN (V, J)
- REAL V (*)
-#endif
- INTEGER J
-* Determines J'th multiquadric.
-* V is DOUBLE PRECISION coordinate vector in NORMALISED coordinates.
-
-#include "hbook/hcqcom.inc"
-
- INTEGER I
-
- HQDDJN = 0.
-
- DO 10 I = 1, NDIM
- HQDDJN = HQDDJN +
- + (V (I) - DBLE (SIGV (J, I))) ** 2
- 10 CONTINUE
-
- HQDDJN = HQDDJN + DBLE (SIGDEL (J)) ** 2
-
- HQDDJN = SQRT (HQDDJN)
-
- END
diff --git a/src/packlib/hbook/hquad/hqdj.F b/src/packlib/hbook/hquad/hqdj.F
deleted file mode 100644
index 8508882..0000000
--- a/src/packlib/hbook/hquad/hqdj.F
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: hqdj.F,v 1.1.1.1 1996/01/16 17:08:00 mclareni Exp $
-*
-* $Log: hqdj.F,v $
-* Revision 1.1.1.1 1996/01/16 17:08:00 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.17/01 22/11/92 12.11.50 by John Allison
-*-- Author :
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION FUNCTION HQDJ (V, J)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- REAL FUNCTION HQDJ (V, J)
-#endif
- REAL V (*)
- INTEGER J
-* Determines J'th multiquadric.
-* V is coordinate vector in plot coordinates.
-
-#include "hbook/hcqcom.inc"
-
- INTEGER IDIM
-* V1 is coordinate vector in NORMALISED coordinates.
- REAL V1 (NDMAX)
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION HQDJN
-#endif
-#if !defined(CERNLIB_DOUBLE)
- REAL HQDJN
-#endif
-
- DO 10 IDIM = 1, NDIM
- V1 (IDIM) = (V (IDIM) - SIGVMI (IDIM)) / SIGVT (IDIM)
- 10 CONTINUE
-
- HQDJ = HQDJN (V1, J)
-
- END
diff --git a/src/packlib/hbook/hquad/hqdjn.F b/src/packlib/hbook/hquad/hqdjn.F
deleted file mode 100644
index 6437cc6..0000000
--- a/src/packlib/hbook/hquad/hqdjn.F
+++ /dev/null
@@ -1,38 +0,0 @@
-*
-* $Id: hqdjn.F,v 1.1.1.1 1996/01/16 17:08:00 mclareni Exp $
-*
-* $Log: hqdjn.F,v $
-* Revision 1.1.1.1 1996/01/16 17:08:00 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.17/01 22/11/92 12.11.50 by John Allison
-*-- Author :
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION FUNCTION HQDJN (V, J)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- REAL FUNCTION HQDJN (V, J)
-#endif
- REAL V (*)
- INTEGER J
-* Determines J'th multiquadric.
-* V is coordinate vector in NORMALISED coordinates.
-
-#include "hbook/hcqcom.inc"
-
- INTEGER I
-
- HQDJN = 0.
-
- DO 10 I = 1, NDIM
- HQDJN = HQDJN +
- + (DBLE (V (I)) - DBLE (SIGV (J, I))) ** 2
- 10 CONTINUE
-
- HQDJN = HQDJN + DBLE (SIGDEL (J)) ** 2
-
- HQDJN = SQRT (HQDJN)
-
- END
diff --git a/src/packlib/hbook/hquad/hqdn.F b/src/packlib/hbook/hquad/hqdn.F
deleted file mode 100644
index 6553720..0000000
--- a/src/packlib/hbook/hquad/hqdn.F
+++ /dev/null
@@ -1,39 +0,0 @@
-*
-* $Id: hqdn.F,v 1.1.1.1 1996/01/16 17:08:00 mclareni Exp $
-*
-* $Log: hqdn.F,v $
-* Revision 1.1.1.1 1996/01/16 17:08:00 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.17/01 22/11/92 12.11.50 by John Allison
-*-- Author :
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION FUNCTION HQDN (V)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- REAL FUNCTION HQDN (V)
-#endif
- REAL V (*)
-* Determines sum of multiquadrics.
-* V is coordinate vector in NORMALISED coordinates.
-
-#include "hbook/hcqcom.inc"
-#include "hbook/hcqcor.inc"
-
- INTEGER J
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION HQDJN
-#endif
-#if !defined(CERNLIB_DOUBLE)
- REAL HQDJN
-#endif
-
- HQDN = 0.
-
- DO 10 J = 1, NSIG
- HQDN = HQDN + SIGA (J) * HQDJN (V, J)
- 10 CONTINUE
-
- END
diff --git a/src/packlib/hbook/hquad/hqend.F b/src/packlib/hbook/hquad/hqend.F
deleted file mode 100644
index 6e60f24..0000000
--- a/src/packlib/hbook/hquad/hqend.F
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: hqend.F,v 1.1.1.1 1996/01/16 17:08:00 mclareni Exp $
-*
-* $Log: hqend.F,v $
-* Revision 1.1.1.1 1996/01/16 17:08:00 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.17/01 22/11/92 10.20.38 by John Allison
-*-- Author : John Allison 12/09/92
- SUBROUTINE HQEND
-* End operations.
-
-#include "hbook/hcqcom.inc"
-#include "hbook/hcbook.inc"
-
-* Drop HQ banks and release link area.
- LHQUAD = LQ (LCDIR - 6)
- IF (LHQUAD .NE. 0) THEN
- CALL MZDROP (IHDIV, LHQUAD, ' ')
- LAREA (1) = 0
- END IF
-
- END
diff --git a/src/packlib/hbook/hquad/hqf.F b/src/packlib/hbook/hquad/hqf.F
deleted file mode 100644
index 67b2430..0000000
--- a/src/packlib/hbook/hquad/hqf.F
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: hqf.F,v 1.1.1.1 1996/01/16 17:08:00 mclareni Exp $
-*
-* $Log: hqf.F,v $
-* Revision 1.1.1.1 1996/01/16 17:08:00 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.17/02 18/12/92 15.47.59 by John Allison
-*-- Author :
- REAL FUNCTION HQF (V)
- REAL V (*)
-* Determines sum of multiquadrics.
-* V is coordinate vector in plot coordinates.
-
-#include "hbook/hcqcom.inc"
-
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION HQD
-#endif
-#if !defined(CERNLIB_DOUBLE)
- REAL HQD
-#endif
-
- HQF = 0.
- IF (IMQFUN .EQ. 1) THEN
- HQF = HQD (V)
- ELSE IF (IMQFUN .EQ. 2) THEN
- HQF = VCONST * EXP (HQD (V))
- END IF
-
- END
diff --git a/src/packlib/hbook/hquad/hqfer.F b/src/packlib/hbook/hquad/hqfer.F
deleted file mode 100644
index a3d8d76..0000000
--- a/src/packlib/hbook/hquad/hqfer.F
+++ /dev/null
@@ -1,109 +0,0 @@
-*
-* $Id: hqfer.F,v 1.1.1.1 1996/01/16 17:08:00 mclareni Exp $
-*
-* $Log: hqfer.F,v $
-* Revision 1.1.1.1 1996/01/16 17:08:00 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.17/02 21/12/92 08.35.00 by John Allison
-*-- Author :
- REAL FUNCTION HQFER (V)
- REAL V (*)
-* Determines error on sum of multiquadrics.
-* V is coordinate vector in plot coordinates.
-
-#include "hbook/hcqcom.inc"
-#include "hbook/hcqcor.inc"
-#include "hbook/hcbook.inc"
-
- CHARACTER*4 NAME
- INTEGER L
- INTEGER ISIG, JSIG, NWW
-#if defined(CERNLIB_DOUBLE)
- PARAMETER (NWW = 2)
- DOUBLE PRECISION HQD
- DOUBLE PRECISION VAR, D0, D1, SS
- DOUBLE PRECISION RSIG, DSIG, SIGTMP
-#endif
-#if !defined(CERNLIB_DOUBLE)
- PARAMETER (NWW = 1)
- REAL HQD
- REAL VAR, D0, D1, SS
- REAL RSIG, DSIG, SIGTMP
-#endif
- DATA RSIG /1.D-3/
-
- HQFER = 0.
-
-* Needs covariances from LHFIT bank.
- LCONT = LQ (LCID - 1)
- IF (LCONT .LE. 0) RETURN
- LFUNC = LQ (LCONT - 1)
- IF (LFUNC .LE. 0) RETURN
- LHFIT = LQ (LFUNC - 1)
- IF (LHFIT .LE. 0) RETURN
- LHFCO = 0
- L = LQ (LHFIT)
- 10 CONTINUE
- IF (L. NE. 0)THEN
- CALL UHTOC (IQ (L - 4), 4, NAME, 4)
- IF (NAME .EQ. 'HFCO')THEN
- LHFCO = L
- ELSE
- GO TO 10
- END IF
- END IF
- IF (LHFCO .EQ. 0) RETURN
-
-* Calculate gradients (take constraints, if any, into account).
- IF (IMQFUN .EQ. 1) THEN
- D0 = HQD (V)
- ELSE
- D0 = VCONST * EXP (HQD (V))
- END IF
- DO 20 ISIG = 1, NFREE
-* Store fitted value temporarily.
- SIGTMP = SIGA (ISIG)
-* Make a small change.
- DSIG = SIGA (ISIG) * RSIG
- SIGA (ISIG) = SIGA (ISIG) + DSIG
-* Constrain parameters again if required.
- IF (NFREE .LT. NSIG) CALL HQSSV
-* Calculate new value of function.
- IF (IMQFUN .EQ. 1) THEN
- D1 = HQD (V)
- ELSE
- D1 = VCONST * EXP (HQD (V))
- END IF
-* Calculate gradient of function w.r.t. parameter.
- SIGGRD (ISIG) = (D1 - D0) / DSIG
-* Restore original parameter.
- SIGA (ISIG) = SIGTMP
- 20 CONTINUE
-* Restore constraints if required.
- IF (NFREE .LT. NSIG) CALL HQSSV
-
-* Calculate variance. Assume matrix is symmetric.
- VAR = 0.
-* Diagonal terms.
- DO 30 ISIG = 1, NFREE
- CALL UCOPY
- + (Q (LHFCO + NWW * (ISIG * (ISIG + 1) / 2 - 1) + 1),
- + SS, NWW)
- VAR = VAR + SS * SIGGRD (ISIG) ** 2
- 30 CONTINUE
-* Off-diagonal terms.
- DO 50 ISIG = 2, NFREE
- DO 40 JSIG = 1, ISIG - 1
- CALL UCOPY
- + (Q (LHFCO + NWW*(ISIG*(ISIG-1) / 2 + JSIG - 1) + 1),
- + SS, NWW)
- VAR = VAR + 2. * SS * SIGGRD (ISIG) * SIGGRD (JSIG)
- 40 CONTINUE
- 50 CONTINUE
-
- HQFER = SQRT (ABS (VAR))
-
- END
diff --git a/src/packlib/hbook/hquad/hqfnl.F b/src/packlib/hbook/hquad/hqfnl.F
deleted file mode 100644
index 38f86f0..0000000
--- a/src/packlib/hbook/hquad/hqfnl.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: hqfnl.F,v 1.1.1.1 1996/01/16 17:08:01 mclareni Exp $
-*
-* $Log: hqfnl.F,v $
-* Revision 1.1.1.1 1996/01/16 17:08:01 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.17/01 02/09/92 19.10.43 by John Allison
-*-- Author :
- REAL FUNCTION HQFNL (V)
- REAL V (*)
-* Determines negative 1 standard deviation limit of
-* sum of multiquadrics.
-
- REAL HQF, HQFER
-
- HQFNL = HQF (V) - HQFER (V)
-
- END
diff --git a/src/packlib/hbook/hquad/hqfpl.F b/src/packlib/hbook/hquad/hqfpl.F
deleted file mode 100644
index 4c714b6..0000000
--- a/src/packlib/hbook/hquad/hqfpl.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: hqfpl.F,v 1.1.1.1 1996/01/16 17:08:01 mclareni Exp $
-*
-* $Log: hqfpl.F,v $
-* Revision 1.1.1.1 1996/01/16 17:08:01 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.17/01 02/09/92 19.10.43 by John Allison
-*-- Author :
- REAL FUNCTION HQFPL (V)
- REAL V (*)
-* Determines positive 1 standard deviation limit of
-* sum of 1-D multiquadrics.
-
- REAL HQF, HQFER
-
- HQFPL = HQF (V) + HQFER (V)
-
- END
diff --git a/src/packlib/hbook/hquad/hqgetf.F b/src/packlib/hbook/hquad/hqgetf.F
deleted file mode 100644
index 36931c5..0000000
--- a/src/packlib/hbook/hquad/hqgetf.F
+++ /dev/null
@@ -1,132 +0,0 @@
-*
-* $Id: hqgetf.F,v 1.1.1.1 1996/01/16 17:08:02 mclareni Exp $
-*
-* $Log: hqgetf.F,v $
-* Revision 1.1.1.1 1996/01/16 17:08:02 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.17/01 22/11/92 12.13.37 by John Allison
-*-- Author : John Allison 12/09/92
- SUBROUTINE HQGETF (LFIT)
- INTEGER LFIT
-* Get Multiquadric parameters from bank 'HFIT' and place in /HCQCOM/.
-* See HSUPIS for banks definitions.
-
-#include "hbook/hcbook.inc"
-#include "hbook/hcbits.inc"
-#include "hbook/hcqcom.inc"
-#include "hbook/hcqcor.inc"
-
- INTEGER I, II, NBLOCK, LLIMS
- INTEGER NWW
-#if defined(CERNLIB_DOUBLE)
- PARAMETER (NWW = 2)
- DOUBLE PRECISION SS
-#endif
-#if !defined(CERNLIB_DOUBLE)
- PARAMETER (NWW = 1)
- REAL SS
-#endif
-
- NSIG = 0
-
- IF (LFIT .LE. 0) RETURN
-
- NSIG = IQ (LFIT + 2)
-
- IF (I1 .NE. 0) THEN
- NDIM = 1
-* NX = IQ (LCID + KNCX)
- XMI = Q (LCID + KXMIN)
- XMA = Q (LCID + KXMAX)
- DXT = XMA - XMI
- ELSE IF (I230 .NE. 0) THEN
- NDIM = 2
-* NX = IQ (LCID + KNCX)
- XMI = Q (LCID + KXMIN)
- XMA = Q (LCID + KXMAX)
- DXT = XMA - XMI
- NY = IQ (LCID + KNCY)
- YMI = Q (LCID + KYMIN)
- YMA = Q (LCID + KYMAX)
- DYT = YMA - YMI
- ELSE IF (I4 .NE. 0) THEN
- NDIM = IQ (LCID + 2)
- IF (NDIM .GT. 3) GO TO 60
- LLIMS = LQ (LCID - 2)
- XMI = Q (LLIMS + 1)
- XMA = Q (LLIMS + 2)
- DXT = XMA - XMI
- IF (NDIM .GE. 2) THEN
- YMI = Q (LLIMS + 3)
- YMA = Q (LLIMS + 4)
- DYT = YMA - YMI
- END IF
- IF (NDIM .GE. 3) THEN
- ZMI = Q (LLIMS + 5)
- ZMA = Q (LLIMS + 6)
- DZT = ZMA - ZMI
- END IF
- ELSE
- GO TO 50
- END IF
-
- HQFMIN = Q (LFIT + 7)
- HQFMAX = Q (LFIT + 8)
-
-* LFIT bank: NSIG fitted parameters,
-* 5 special parameters,
-* (NDIM + 1) * NSIG fixed parameters,
- NBLOCK = NWW * NSIG
- II = 11
- CALL UCOPY (Q (LFIT + II), SIGA, NBLOCK)
- II = II + NBLOCK
- CALL UCOPY (Q (LFIT + II), SS, NWW)
- IMQFUN = SS
- II = II + NWW
- CALL UCOPY (Q (LFIT + II), SS, NWW)
- VCONST = SS
- II = II + 4 *NWW
- DO 10 I = 1, NSIG
- CALL UCOPY (Q (LFIT + II), SS, NWW)
- SIGV (I, 1) = SS
- II = II + NWW
- 10 CONTINUE
- IF (NDIM .GE. 2) THEN
- DO 20 I = 1, NSIG
- CALL UCOPY (Q (LFIT + II), SS, NWW)
- SIGV (I, 2) = SS
- II = II + NWW
- 20 CONTINUE
- END IF
- IF (NDIM .GE. 3) THEN
- DO 30 I = 1, NSIG
- CALL UCOPY (Q (LFIT + II), SS, NWW)
- SIGV (I, 3) = SS
- II = II + NWW
- 30 CONTINUE
- END IF
- IF (NDIM .GE. 4) THEN
- GO TO 60
- END IF
- DO 40 I = 1, NSIG
- CALL UCOPY (Q (LFIT + II), SS, NWW)
- SIGDEL (I) = SS
- II = II + NWW
- 40 CONTINUE
-
- GO TO 70
-
- 50 CONTINUE
- CALL HBUG ('Unrecognised structure', 'HQGETF', IDMQ)
- GO TO 70
-
- 60 CONTINUE
- CALL HBUG ('Only programmed for 1- and 2-D', 'HQGETF', IDMQ)
- GO TO 70
-
- 70 CONTINUE
-
- END
diff --git a/src/packlib/hbook/hquad/hqgiv.F b/src/packlib/hbook/hquad/hqgiv.F
deleted file mode 100644
index 17976da..0000000
--- a/src/packlib/hbook/hquad/hqgiv.F
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: hqgiv.F,v 1.1.1.1 1996/01/16 17:08:02 mclareni Exp $
-*
-* $Log: hqgiv.F,v $
-* Revision 1.1.1.1 1996/01/16 17:08:02 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.17/01 22/11/92 12.11.50 by John Allison
-*-- Author :
- SUBROUTINE HQGIV (ND, NC, RMIN, RMAX)
- INTEGER ND, NC (*)
- REAL RMIN (*), RMAX (*)
-* On input ND is dimension of NC, RMIN, RMAX.
-* On output, it returns the following parameters after a multiquadric fit:
-* ND = no. of dimensions.
-* NC (1) = no. of channels in MQ histogram in x coordinate.
-* NC (2) = no. of channels in MQ histogram in y coordinate.
-* etc.
-* RMIN (1) = minimum of x range.
-* RMIN (2) = minimum of y range.
-* etc.
-* RMAX (1) = maximum of x range.
-* RMAX (2) = maximum of y range.
-* etc.
-* If ND < NDIM, only ND elements are filled but ND is set equal to NDIM.
-
-#include "hbook/hcqcom.inc"
-
- INTEGER I, N
-
- N = MIN (ND, NDIM)
- DO 10 I = 1, N
- NC (I) = NBINS (I)
- RMIN (I) = SIGVMI (I)
- RMAX (I) = SIGVMA (I)
- 10 CONTINUE
- ND = NDIM
-
- END
diff --git a/src/packlib/hbook/hquad/hqin.F b/src/packlib/hbook/hquad/hqin.F
deleted file mode 100644
index 2b90df7..0000000
--- a/src/packlib/hbook/hquad/hqin.F
+++ /dev/null
@@ -1,91 +0,0 @@
-*
-* $Id: hqin.F,v 1.1.1.1 1996/01/16 17:08:03 mclareni Exp $
-*
-* $Log: hqin.F,v $
-* Revision 1.1.1.1 1996/01/16 17:08:03 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.17/02 15/12/92 21.48.30 by Rene Brun
-*-- Author :
- SUBROUTINE HQIN (LHQIN)
- INTEGER LHQIN
-* Reads multiquadric parameters from unit LHQIN
-*!!!!! Warning...
-* The pair of routines - HQIN, HQOUT - must be used with care. In particular
-* HQIN recreates the LHQUAD bank structure, at least partially. Moreover,
-* only the HQD... functions will have access to the paramaters (the HQF...
-* routines pick them up from HBOOK LHFIT banks). Finally, after you have
-* finished using the parameters, CALL HQEND to drop the banks.
-
-#include "hbook/hcqcom.inc"
-#include "hbook/hcqcor.inc"
-#include "hbook/hcbook.inc"
-#include "hbook/hcunit.inc"
-
- INTEGER I, II, J, L, NWW, IHQERR
-
-#if defined(CERNLIB_DOUBLE)
- PARAMETER (NWW = 2)
- DOUBLE PRECISION SS
-#endif
-#if !defined(CERNLIB_DOUBLE)
- PARAMETER (NWW = 1)
- REAL SS
-#endif
-
- READ (LHQIN, '(8I10)') NSIG, NDIM, IMQFUN,
- +(NBINS (I), I = 1, NDIM)
- WRITE (LOUT, 10000) NSIG
-
-* Allocate working space needed....
- CALL HQINIT (NSIG, NDIM, NBINS, IHQERR)
- IF (IHQERR. NE. 0) GO TO 60
-
-* Lift LHQCOV bank, etc...
- CALL HQLIF2 (IHQERR)
- IF (IHQERR .NE. 0) GO TO 60
-
- READ (LHQIN, '(4G20.13)') VCONST, HQFMIN, HQFMAX
- WRITE (LOUT, 10100) HQFMIN, HQFMAX
-
- READ (LHQIN, '(4G20.13)') (SIGVMI (I), SIGVMA (I), I = 1, NDIM)
- DO 10 I = 1, NDIM
- SIGVT (I) = SIGVMA (I) - SIGVMI (I)
- 10 CONTINUE
-
- DO 20 I = 1, NSIG
- READ (LHQIN, '(I5, 3G20.13 / (5X, 3G20.13))')
- + II, SIGA (I), (SIGV (I, J), J = 1, NDIM), SIGDEL (I)
- 20 CONTINUE
-
-* Covariances.
-* (Allow for fact that LHQCOV data has to start on 8-byte boundary.)
- DO 40 I = 1, NSIG
- DO 30 J = 1, I
- READ (LHQIN, '(G20.13)', END = 50) SS
- L = LHQCOV + MOD (LHQCOV, NWW)
- CALL UCOPY (SS,
- + Q (L + NWW * ((J - 1) * NSIG + I - 1) + 1), NWW)
- CALL UCOPY (SS,
- + Q (L + NWW * ((I - 1) * NSIG + J - 1) + 1), NWW)
- 30 CONTINUE
- 40 CONTINUE
-
- GO TO 70
-
- 50 CONTINUE
- WRITE (LOUT, '(1X, ''No covariances.'')')
- GO TO 70
-
- 60 CONTINUE
- CALL HBUG('Not enough space in /PAWC/.', 'HQIN', 0)
- GO TO 70
-
- 70 CONTINUE
-
-10000 FORMAT (1X, 'Reading ', I5, ' multiquadric parameters.')
-10100 FORMAT (1X, 'Function range', G12.5, ' to', G12.5)
-
- END
diff --git a/src/packlib/hbook/hquad/hqinit.F b/src/packlib/hbook/hquad/hqinit.F
deleted file mode 100644
index 77a0b02..0000000
--- a/src/packlib/hbook/hquad/hqinit.F
+++ /dev/null
@@ -1,127 +0,0 @@
-*
-* $Id: hqinit.F,v 1.1.1.1 1996/01/16 17:08:03 mclareni Exp $
-*
-* $Log: hqinit.F,v $
-* Revision 1.1.1.1 1996/01/16 17:08:03 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.17/02 15/12/92 21.48.30 by Rene Brun
-*-- Author : John Allison 02/09/92
- SUBROUTINE HQINIT (NSIG0, NVHQ, NNXYZ, IHQERR)
- INTEGER NSIG0, NVHQ, NNXYZ (*), IHQERR
-* Initialise HQ working space for multiquadric smoothing.
-* NSIG0 is the number of existing significant points - usually 0.
-* NVHQ = no. of variables, i.e., dimemsion of space being smothed/fitted.
-* NNXYZ is a vector of no. of bins to be used in each dimension. This is
-* either the actual no. of bins in the histogram being smoothed, or it is the
-* no. of bins to be used in the trial histogram for ntuple smoothing.
-* The parent LHQUAD bank is created here.
-* The LQ (LHQUAD - 1) chain (L1H, etc.) is created in HQLIF1.
-* The LQ (LHQUAD - 2) chain is created in HQLIF2, when the number of significant
-* points is known. Note they contain DOUBLE PRECISION words, so since
-* arithmetic operations are made on them in situ, the data MUST begin on an
-* 8-byte boundary. So HQLIF2 allows an extra word for this.
-* The LQ (LHQUAD - 3) chain is created in HQLIF3.
-* These banks are deleted at the end of operations, but relevant variables are
-* first copied into the LFUNC and LHFIT banks of the histogram or ntuple as
-* required.
-*
-* |
-* | LHQUAD = LQ (LCDIR - 6)
-* V
-* *********************************
-* * -5 * -4 * -3 * -2 * -1 * HQUA *
-* *********************************
-* | | | | |
-* (reserved) | | V L1H L1V
-* | | *********************** ************************
-* | | * HQ1H * 1-D contents *-->* HQ1V * 1-D variances *--I
-* | | *********************** ************************ |
-* | | |
-* | | I-------------------------------------------I
-* | | |
-* | | V L2H
-* | | ***********************
-* | | * HQ2H * 2-D contents *--> etc.
-* | | ***********************
-* | |
-* | |
-* | V LHQCOV LHQDER
-* | ********************** **********************
-* | * HQCO * Covariances *-->* HQDE * Derivatives *--I
-* | ********************** ********************** |
-* | |
-* | I----------------------------------------I
-* | |
-* | V LHQWK1
-* | ********************** **********************
-* | * HQW1 * Workspace 1 *-->* HQW2 * Workspace 2 *-->etc.
-* | ********************** **********************
-* |
-* |
-* V LHQDJN (if space in /PAWC/)
-* *************************************************
-* * HQDJ * Function values for max. lik. fitting. *
-* *************************************************
-*
-
-#include "hbook/hcqcom.inc"
-#include "hbook/hcbook.inc"
-#include "hbook/hcflag.inc"
-
- INTEGER I
-
-* Clear error flag.
- IHQERR = 0
-
-* IMQFUN function flag: = 0, no function evaluated yet.
-* = 1, linear sum of multiquadrics.
-* = 2, exponential of linear sum of multiquadrics.
-* (Note: HQF... routines take account of this, HQD... always calculate the
-* simple sum of multiquadrics.)
- IMQFUN = 0
-
-* Set NSIG
- NSIG = NSIG0
-
-* Clear HQMIN etc.
- HQMIN = 0.
- HQMAX = 0.
- HQFMIN = 0.
- HQFMAX = 0.
-
-* Fill NDIM, NX, NY,...
- NDIM = NVHQ
- DO 10 I = 1, NDIM
- NBINS (I) = NNXYZ (I)
- 10 CONTINUE
-
-* Drop any HQ banks which might have been left over after, e.g., CTRL-C,
-* and release link area.
- LHQUAD = LQ (LCDIR - 6)
- IF (LHQUAD .NE. 0) THEN
- CALL MZDROP (IHDIV, LHQUAD, ' ')
- LAREA (1) = 0
- END IF
-
-* Inquire if there's spacein /PAWC/ for "parent" bank LHQUAD.
- CALL HSPACE (13, 'HQINIT', IDMQ)
- IF (IERR .NE. 0) GO TO 20
-
-* Establish temporary link area.
- CALL MZLINT (IXPAWC, '/HCQCOM/', LAREA, LLAST, LAREA)
-
-* Book parent bank LHQUAD.
- CALL MZBOOK (IHDIV, LHQUAD, LCDIR, -6, 'HQUA', 5, 5, 0, 0, 0)
-
- GO TO 30
-
- 20 CONTINUE
- CALL HBUG ('Not enough working space in /PAWC/.', 'HQINIT', IDMQ)
- IHQERR = 100
-
- 30 CONTINUE
-
- END
diff --git a/src/packlib/hbook/hquad/hqlif1.F b/src/packlib/hbook/hquad/hqlif1.F
deleted file mode 100644
index 1d5e4c3..0000000
--- a/src/packlib/hbook/hquad/hqlif1.F
+++ /dev/null
@@ -1,84 +0,0 @@
-*
-* $Id: hqlif1.F,v 1.1.1.1 1996/01/16 17:08:03 mclareni Exp $
-*
-* $Log: hqlif1.F,v $
-* Revision 1.1.1.1 1996/01/16 17:08:03 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.17/02 18/12/92 14.21.59 by John Allison
-*-- Author : John Allison 06/09/92
- SUBROUTINE HQLIF1 (IHQERR)
- INTEGER IHQERR
-* Lifts LQ (LHQUAD - 1) chain, L1H etc.
-* See HQINIT for description of bank structure.
-
-#include "hbook/hcqcom.inc"
-#include "hbook/hcbook.inc"
-#include "hbook/hcflag.inc"
-
- INTEGER IQUEST
- COMMON /QUEST/ IQUEST (100)
-
- CHARACTER*80 CHQMES
- INTEGER NTOT, NW1, NW2, NW3
-
-* Calculate space required.
- NW1 = 0
- NW2 = 0
- NW3 = 0
- IF (NDIM .EQ. 1) THEN
- NW1 = NX
- ELSE IF (NDIM .EQ. 2) THEN
- NW1 = MAX (NX, NY)
- NW2 = NX * NY
- ELSE IF (NDIM .EQ. 3) THEN
- NW1 = MAX (NX, NY, NZ)
- NW2 = MAX (NX * NY, NY * NZ, NZ * NX)
- NW3 = NX * NY * NZ
- ELSE
- GO TO 10
- END IF
- NTOT = 2 * (NW1 + NW2 + NW3) + 10 * NDIM
-
-* Inquire if there's space.
- CALL HSPACE (NTOT, 'HQLIF1', IDMQ)
- IF (IERR .NE. 0) GO TO 20
-
-* Book 1st bank of contents/variances linear structure:
-* 1-D histogram contents.
- CALL MZBOOK (IHDIV, L1H, LHQUAD, -1, 'HQ1H', 0, 0, NW1, 3, -1)
-* Book 2nd bank - 1-D variances.
- CALL MZBOOK (IHDIV, L1V, L1H, 0, 'HQ1V', 0, 0, NW1, 3, -1)
-* Similarly for 2-D histograms.
- IF (NDIM .GE. 2) THEN
- CALL MZBOOK (IHDIV, L2H, L1V, 0, 'HQ2H', 0, 0, NW2, 3, -1)
- CALL MZBOOK (IHDIV, L2V, L2H, 0, 'HQ2V', 0, 0, NW2, 3, -1)
- END IF
-* Similarly for 3-D histograms.
- IF (NDIM .GE. 3) THEN
- CALL MZBOOK (IHDIV, L3H, L2V, 0, 'HQ3H', 0, 0, NW3, 3, -1)
- CALL MZBOOK (IHDIV, L3V, L3H, 0, 'HQ3V', 0, 0, NW3, 3, -1)
- END IF
- IF (NDIM .GE. 4) GO TO 10
-
- GO TO 40
-
- 10 CONTINUE
- WRITE (CHQMES, '(''Not programmed for'', I3,
- +'' dimensions.'')') NDIM
- IHQERR = 100
- GO TO 30
- 20 CONTINUE
- WRITE (CHQMES, '(''Need'', I8, '', short by'', I8)')
- +NTOT, -IQUEST(11)
- IHQERR = 200
- GO TO 30
-
- 30 CONTINUE
- CALL HBUG (CHQMES, 'HQLIF1', IDMQ)
-
- 40 CONTINUE
-
- END
diff --git a/src/packlib/hbook/hquad/hqlif2.F b/src/packlib/hbook/hquad/hqlif2.F
deleted file mode 100644
index 2ea6a4f..0000000
--- a/src/packlib/hbook/hquad/hqlif2.F
+++ /dev/null
@@ -1,68 +0,0 @@
-*
-* $Id: hqlif2.F,v 1.1.1.1 1996/01/16 17:08:03 mclareni Exp $
-*
-* $Log: hqlif2.F,v $
-* Revision 1.1.1.1 1996/01/16 17:08:03 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.17/02 12/09/92 13.07.41 by John Allison
-*-- Author : John Allison 02/09/92
- SUBROUTINE HQLIF2 (IHQERR)
- INTEGER IHQERR
-* Lifts LQ (LHQUAD - 2) chain once no. of significant points is known.
-* See HQINIT for description of bank structure.
-
-#include "hbook/hcqcom.inc"
-#include "hbook/hcbook.inc"
-#include "hbook/hcflag.inc"
-
- INTEGER IQUEST
- COMMON /QUEST/ IQUEST (100)
-
- CHARACTER*80 CHQMES
- INTEGER NTOT, NWCOV, NWDER, NWWK1, NWWK2, NWWK3
- INTEGER NWW, NIO
-#if defined(CERNLIB_DOUBLE)
- PARAMETER (NWW = 2, NIO = 4)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- PARAMETER (NWW = 1, NIO = 3)
-#endif
-
-* Calculate space needed (allow for aligning on 8-byte boundary).
- NWCOV = NWW * NSIG ** 2 + 1
- NWDER = NWW * NSIG ** 2 + 1
- NWWK1 = NWW * NSIG + 1
- NWWK2 = NWW * NSIG + 1
- NWWK3 = NWW * NSIG + 1
- NTOT = NWCOV + NWDER + NWWK1 + NWWK2 + NWWK3 + 50
- CALL HSPACE (NTOT, 'HQLIF2', IDMQ)
- IF (IERR .NE. 0) GO TO 10
-
-* Lift LQ (LHQUAD - 2) chain.
- CALL MZBOOK (IHDIV, LHQCOV, LHQUAD, -2, 'HQCO', 0, 0, NWCOV,
- +NIO, -1)
- CALL MZBOOK (IHDIV, LHQDER, LHQCOV, 0, 'HQDE', 0, 0, NWDER,
- +NIO, -1)
- CALL MZBOOK (IHDIV, LHQWK1, LHQDER, 0, 'HQW1', 0, 0, NWWK1,
- +NIO, -1)
- CALL MZBOOK (IHDIV, LHQWK2, LHQWK1, 0, 'HQW2', 0, 0, NWWK2,
- +NIO, -1)
- CALL MZBOOK (IHDIV, LHQWK3, LHQWK2, 0, 'HQW3', 0, 0, NWWK3,
- +NIO, -1)
-
- GO TO 20
-
- 10 CONTINUE
- WRITE (CHQMES, '(''Need'', I8, '', short by'', I8)')
- +NTOT, -IQUEST(11)
- CALL HBUG (CHQMES, 'HQLIF2', IDMQ)
- IHQERR = 200
- GO TO 20
-
- 20 CONTINUE
-
- END
-
diff --git a/src/packlib/hbook/hquad/hqlif3.F b/src/packlib/hbook/hquad/hqlif3.F
deleted file mode 100644
index d7bdef7..0000000
--- a/src/packlib/hbook/hquad/hqlif3.F
+++ /dev/null
@@ -1,43 +0,0 @@
-*
-* $Id: hqlif3.F,v 1.1.1.1 1996/01/16 17:08:03 mclareni Exp $
-*
-* $Log: hqlif3.F,v $
-* Revision 1.1.1.1 1996/01/16 17:08:03 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.17/02 12/09/92 16.41.49 by John Allison
-*-- Author : John Allison 06/09/92
- SUBROUTINE HQLIF3
-* Lifts LQ (LHQUAD - 3) chain - optional banks, i.e., only created if plenty
-* of space, namely twice as much as needed.
-* See HQINIT for description of bank structure.
-
-#include "hbook/hcqcom.inc"
-#include "hbook/hcbook.inc"
-
- INTEGER IQUEST
- COMMON /QUEST/ IQUEST (100)
-
- INTEGER NWDJN, NAVAIL
- INTEGER NWW, NIO
-#if defined(CERNLIB_DOUBLE)
- PARAMETER (NWW = 2, NIO = 4)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- PARAMETER (NWW = 1, NIO = 3)
-#endif
-
-* Lift LHQDJN if pleny of space.
- NWDJN = NWW * NBTOT * NSIG
- NAVAIL = 2 * NWDJN + 10
- CALL MZNEED (IHDIV, NAVAIL, ' ')
- IF (IQUEST(11) .LT. 0) CALL MZNEED (IHDIV, NAVAIL, 'G')
- IF (IQUEST(11) .GE. 0) THEN
- CALL MZBOOK (IHDIV, LHQDJN, LHQUAD, -3, 'HQDJ', 0, 0, NWDJN,
- + NIO, -1)
- END IF
-
- END
-
diff --git a/src/packlib/hbook/hquad/hqlsqc.F b/src/packlib/hbook/hquad/hqlsqc.F
deleted file mode 100644
index c464ee3..0000000
--- a/src/packlib/hbook/hquad/hqlsqc.F
+++ /dev/null
@@ -1,152 +0,0 @@
-*
-* $Id: hqlsqc.F,v 1.1.1.1 1996/01/16 17:08:03 mclareni Exp $
-*
-* $Log: hqlsqc.F,v $
-* Revision 1.1.1.1 1996/01/16 17:08:03 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.17/01 22/11/92 15.16.56 by John Allison
-*-- Author :
- SUBROUTINE HQLSQC ( SIGCOV, DW, N, CHISQ, IHQERR)
- INTEGER N
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION SIGCOV (N, N)
- DOUBLE PRECISION DW (N)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- REAL SIGCOV (N, N)
- REAL DW (N)
-#endif
- INTEGER IHQERR
- REAL CHISQ
-* Perform least squares fit constrained for zero asymptotes.
-* For asymptotic zero everywhere NFREE = NSIG - NDIM - 1 and the sum and
-* sum (v*w) is zeroed in HQSSV.
-* CHISQ is chi-squared.
-* IHQERR = 0 if all's OK.
-
-***************************************************************
-*
-* Change to avoid MINUIT. Note: HQMNU no longer exists!!! (It is
-* attached here for reference.)
-*
-******************************************************************
-
-#include "hbook/hcqcom.inc"
-#include "hbook/hcqcor.inc"
-#include "hbook/hcbook.inc"
-
- CHARACTER*80 CHQMES
- INTEGER ISIG, JSIG, JMQFUN, L, IX, IY, IZ
- REAL V (NDMAX)
- REAL X, Y, Z
- EQUIVALENCE (X, V (1)), (Y, V(2)), (Z, V(3))
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION DCHISQ, HQDN
-#endif
-#if !defined(CERNLIB_DOUBLE)
- REAL DCHISQ, HQDN
-#endif
-* EXTERNAL HQMNU
-
- IHQERR = 0
-
-* Preserve IMQFUN
- JMQFUN = IMQFUN
-
- IMQFUN = 1
- NFREE = NSIG - NDIM - 1
-
-* Use HQSOLV for starting values.
- CALL HQSOLV (SIGCOV, DW, N, CHISQ, IHQERR)
- IF (IHQERR .NE. 0) GO TO 130
-
-* Initialise MINUIT.
-* CALL MNINIT (5, 6, 7)
-
-* Printing from MINUIT?
-* IF (.NOT. TPRINT) THEN
-* CALL MNEXCM (HQMNU, 'SET PRINTOUT', -1.D0, 1, IHQERR, 0)
-* IF (IHQERR .NE. 0) GO TO 10
-* END IF
-
-* Define parameters and starting values for MINUIT.
- DO 10 ISIG = 1, NFREE
-* CALL MNPARM (ISIG, 'SIGA', SIGA (ISIG),
-* + 1.D-3, 0.D0, 0.D0, IHQERR)
- IF (IHQERR .NE. 0) GO TO 120
- 10 CONTINUE
-
-* Minimise.
-* CALL MNEXCM (HQMNU, 'MINIMISE', 0, 0, IHQERR, 0)
- IF (IHQERR .NE. 0) GO TO 120
-
-* Get chi-squared.
- DCHISQ = 0.
- IF (NDIM .EQ. 1) THEN
- DO 20 IX = 1, NX
- X = (IX - 0.5) / NX
- L = IX
- DCHISQ = DCHISQ + (Q (L1H + L) - HQDN (V)) ** 2 /
- + Q (L1V + L)
- 20 CONTINUE
- ELSE IF (NDIM .EQ. 2) THEN
- DO 40 IX = 1, NX
- X = (IX - 0.5) / NX
- DO 30 IY = 1, NY
- Y = (IY - 0.5) / NY
- L = (IY - 1) * NX + IX
- DCHISQ = DCHISQ + (Q (L2H + L) - HQDN (V)) ** 2 /
- + Q (L2V + L)
- 30 CONTINUE
- 40 CONTINUE
- ELSE IF (NDIM .EQ. 3) THEN
- DO 70 IX = 1, NX
- X = (IX - 0.5) / NX
- DO 60 IY = 1, NY
- Y = (IY - 0.5) / NY
- DO 50 IZ = 1, NZ
- Z = (IZ - 0.5) / NZ
- L = (IZ - 1) * NX * NY + (IY - 1) * NX + IX
- DCHISQ = DCHISQ + (Q (L3H + L) - HQDN (V)) ** 2 /
- + Q (L3V + L)
- 50 CONTINUE
- 60 CONTINUE
- 70 CONTINUE
- ELSE
- GO TO 120
- END IF
- CHISQ = DCHISQ
-
-* Get covariance matrix
-* CALL MNEMAT (SIGCOV, NSIG)
-
-* Clear rest if covariance matrix and error vector (should these be considered
-* derived quantities?).
- DO 90 ISIG = NFREE + 1, NSIG
- DO 80 JSIG = 1, NSIG
- SIGCOV (ISIG, JSIG) = 0.
- 80 CONTINUE
- 90 CONTINUE
- DO 110 ISIG = NFREE + 1, NSIG
- DO 100 JSIG = 1, NSIG
- SIGCOV (JSIG, ISIG) = 0.
- 100 CONTINUE
- 110 CONTINUE
-
- GO TO 130
-
-* Errors.
- 120 CONTINUE
- WRITE (CHQMES, '(''Error'', I3, '' in MINUIT'')') IHQERR
- CALL HBUG (CHQMES, 'HQLSQC', IDMQ)
-
- 130 CONTINUE
-
-*Restore IMQFUN.
- IF (JMQFUN .GT. 0) IMQFUN = JMQFUN
-
- END
-
diff --git a/src/packlib/hbook/hquad/hqlsqu.F b/src/packlib/hbook/hquad/hqlsqu.F
deleted file mode 100644
index 1883bad..0000000
--- a/src/packlib/hbook/hquad/hqlsqu.F
+++ /dev/null
@@ -1,221 +0,0 @@
-*
-* $Id: hqlsqu.F,v 1.1.1.1 1996/01/16 17:08:03 mclareni Exp $
-*
-* $Log: hqlsqu.F,v $
-* Revision 1.1.1.1 1996/01/16 17:08:03 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.17/02 18/12/92 11.31.51 by Rene Brun
-*-- Author :
- SUBROUTINE HQLSQU (SIGCOV, DJN, N, CHISQ, IHQERR)
- INTEGER N
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION SIGCOV (N, N)
- DOUBLE PRECISION DJN (N)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- REAL SIGCOV (N, N)
- REAL DJN (N)
-#endif
- INTEGER IHQERR
- REAL CHISQ
-* Perform unconstrained least squares fit to bin contents.
-* IHQERR = 0 if all's OK.
-* CHISQ is chi-squared.
-
-#include "hbook/hcqcom.inc"
-#include "hbook/hcqcor.inc"
-#include "hbook/hcbook.inc"
-#include "hbook/hcunit.inc"
-
- CHARACTER*80 CHQMES
- LOGICAL PPRINT
- INTEGER J, K, L, IX, IY, IZ, NSECS, JMQFUN, NWW
- REAL OPS, UFACT
-* REAL T
- REAL V (NDMAX)
- REAL X, Y, Z
- EQUIVALENCE (X, V (1)), (Y, V(2)), (Z, V(3))
-#if defined(CERNLIB_DOUBLE)
- PARAMETER (NWW = 2)
- DOUBLE PRECISION DCHISQ
- DOUBLE PRECISION HQDJN, HQDN
-#endif
-#if !defined(CERNLIB_DOUBLE)
- PARAMETER (NWW = 1)
- REAL DCHISQ
- REAL HQDJN, HQDN
-#endif
-
- DATA UFACT /330000./
-
- IHQERR = 0
-
-* Preserve IMQFUN
- JMQFUN = IMQFUN
-
- IMQFUN = 1
-
- OPS = FLOAT (NSIG ** 2) * FLOAT (NBTOT)
- PPRINT = (JMQFUN .EQ. 1).AND.VPRINT
- IF (PPRINT) THEN
- WRITE (LOUT, 10000) NSIG, NBTOT
- NSECS = OPS / UFACT
- WRITE (LOUT, 10100) NSECS
-* CALL TIMED (T)
- END IF
-
-* Evaluate the matrices A and B (use SIGCOV and SIGA respectively).
-* Clear SIGA and SIGCOV lower triangle.
- CALL UZERO (SIGA, 1, NWW * NSIG)
- CALL UZERO (SIGCOV, 1, NWW * NSIG ** 2)
-* Calculate SIGA and SIGCOV lower triangle.
- IF (NDIM .EQ. 1) THEN
- DO 30 IX = 1, NX
- X = (IX - 0.5) / NX
- L = IX
- DO 20 K = 1, NSIG
- DJN (K) = HQDJN (V, K)
- SIGA (K) = SIGA (K) +
- + Q (L1H + L) * DJN (K) / Q (L1V + L)
- DO 10 J = 1, K
- SIGCOV (J, K) = SIGCOV (J, K) +
- + DJN (J) * DJN (K) / Q (L1V + L)
- 10 CONTINUE
- 20 CONTINUE
- 30 CONTINUE
- ELSE IF (NDIM .EQ. 2) THEN
- DO 70 IX = 1, NX
- X = (IX - 0.5) / NX
- DO 60 IY = 1, NY
- Y = (IY - 0.5) / NY
- L = (IY - 1) * NX + IX
- DO 50 K = 1, NSIG
- DJN (K) = HQDJN (V, K)
- SIGA (K) = SIGA (K) +
- + Q (L2H + L) * DJN (K) / Q (L2V + L)
- DO 40 J = 1, K
- SIGCOV (J, K) = SIGCOV (J, K) +
- + DJN (J) * DJN (K) / Q (L2V + L)
- 40 CONTINUE
- 50 CONTINUE
- 60 CONTINUE
- 70 CONTINUE
- ELSE IF (NDIM .EQ. 3) THEN
- DO 120 IX = 1, NX
- X = (IX - 0.5) / NX
- DO 110 IY = 1, NY
- Y = (IY - 0.5) / NY
- DO 100 IZ = 1, NZ
- Z = (IZ - 0.5) / NZ
- L = (IZ - 1) * NX * NY + (IY - 1) * NX + IX
- DO 90 K = 1, NSIG
- DJN (K) = HQDJN (V, K)
- SIGA (K) = SIGA (K) + Q (L3H + L) * DJN (K) / Q
- + (L3V + L)
- DO 80 J = 1, K
- SIGCOV (J, K) = SIGCOV (J, K) + DJN (J) * DJN
- + (K) / Q (L3V + L)
- 80 CONTINUE
- 90 CONTINUE
- 100 CONTINUE
- 110 CONTINUE
- 120 CONTINUE
- ELSE
- GO TO 210
- END IF
-* Fill SIGCOV upper triangle.
- DO 140 K = 1, NSIG
- DO 130 J = 1, K - 1
- SIGCOV (K, J) = SIGCOV (J, K)
- 130 CONTINUE
- 140 CONTINUE
-
-* Call CERN library routine for simultaneous equations to solve A * SIGA = B.
-* Try DEQINV (F010).
-#if defined(CERNLIB_DOUBLE)
- CALL DEQINV (NSIG, SIGCOV, NSIG, DJN, IHQERR, 1, SIGA)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- CALL REQINV (NSIG, SIGCOV, NSIG, DJN, IHQERR, 1, SIGA)
-#endif
- IF (IHQERR .NE. 0) GO TO 220
-* Try DSEQN (F012) (our matrix is symmetric).
-* CALL DSEQN (NSIG, SIGCOV, NSIG, IHQERR, 1, SIGA)
-#if defined(CERNLIB_DOUBLE)
-* CALL DSEQN (NSIG, SIGCOV, NSIG, IHQERR, 1, SIGA)
-#endif
-#if !defined(CERNLIB_DOUBLE)
-* CALL RSEQN (NSIG, SIGCOV, NSIG, IHQERR, 1, SIGA)
-#endif
-* IF (IHQERR .NE. 0) GO TO 20
-* CALL DSFINV (NSIG, SIGCOV, NSIG)
-
-* Get chi-squared.
- DCHISQ = 0.
- IF (NDIM .EQ. 1) THEN
- DO 150 IX = 1, NX
- X = (IX - 0.5) / NX
- L = IX
- DCHISQ = DCHISQ + (Q (L1H + L) - HQDN (V)) ** 2 /
- + Q (L1V + L)
- 150 CONTINUE
- ELSE IF (NDIM .EQ. 2) THEN
- DO 170 IX = 1, NX
- X = (IX - 0.5) / NX
- DO 160 IY = 1, NY
- Y = (IY - 0.5) / NY
- L = (IY - 1) * NX + IX
- DCHISQ = DCHISQ + (Q (L2H + L) - HQDN (V)) ** 2 /
- + Q (L2V + L)
- 160 CONTINUE
- 170 CONTINUE
- ELSE IF (NDIM .EQ. 3) THEN
- DO 200 IX = 1, NX
- X = (IX - 0.5) / NX
- DO 190 IY = 1, NY
- Y = (IY - 0.5) / NY
- DO 180 IZ = 1, NZ
- Z = (IZ - 0.5) / NZ
- L = (IZ - 1) * NX * NY + (IY - 1) * NX + IX
- DCHISQ = DCHISQ + (Q (L3H + L) - HQDN (V)) ** 2 /
- + Q (L3V + L)
- 180 CONTINUE
- 190 CONTINUE
- 200 CONTINUE
- ELSE
- GO TO 210
- END IF
- CHISQ = DCHISQ
-* IF (PPRINT) THEN
-* CALL TIMED (T)
-* WRITE (LOUT, '(3X, ''Took'', G12.5, '' secs.'')') T
-* END IF
-
- GO TO 240
-
-* Errors.
- 210 CONTINUE
- WRITE (CHQMES, '(I3, '' dimensions not programmed yet.'')') NDIM
- IHQERR = 1
- GO TO 230
- 220 CONTINUE
- WRITE (CHQMES, '(''Error'', I5, '' in DEQINV'')') IHQERR
-* WRITE (CHQMES, '(''Error'', I5, '' in DSEQN'')') IHQERR
- GO TO 230
-
- 230 CONTINUE
- CALL HBUG (CHQMES, 'HQLSQU', IDMQ)
-
- 240 CONTINUE
-
-*Restore IMQFUN.
- IF (JMQFUN .GT. 0) IMQFUN = JMQFUN
-
-10000 FORMAT (1X, 'Multiquadric unconstrained least squares fit with',
- +I5, ' parameters for', I7, ' bins.')
-10100 FORMAT (3X, 'This will take about', I10, ' CERN-unit-secs.')
-
- END
diff --git a/src/packlib/hbook/hquad/hqmnu.F b/src/packlib/hbook/hquad/hqmnu.F
deleted file mode 100644
index 16e2a47..0000000
--- a/src/packlib/hbook/hquad/hqmnu.F
+++ /dev/null
@@ -1,117 +0,0 @@
-*=========================================================================
-*
-* $Id: hqmnu.F,v 1.1.1.1 1996/01/16 17:08:07 mclareni Exp $
-*
-* $Log: hqmnu.F,v $
-* Revision 1.1.1.1 1996/01/16 17:08:07 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.17/01 22/11/92 15.16.56 by John Allison
-*-- Author :
-
- SUBROUTINE HQMNU (NPAR, GRAD, DCHISQ, SIGAA, IFLAG)
- INTEGER NPAR, IFLAG
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION GRAD (*), DCHISQ, SIGAA (*)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- REAL GRAD (*), DCHISQ, SIGAA (*)
-#endif
-* For MINUIT minimisation of chi-squared.
-* Fit to histogram contents.
-* Work in NORMALISED coordinates.
-
-#include "hbook/hcqcom.inc"
-#include "hbook/hcqcor.inc"
-#include "hbook/hcbook.inc"
-
- CHARACTER*80 CHQMES
- INTEGER J, L, IX, IY, IZ
- REAL V (NDMAX)
- REAL X, Y, Z
- EQUIVALENCE (X, V (1)), (Y, V(2)), (Z, V(3))
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION DCHI, HQDN, DN
-#endif
-#if !defined(CERNLIB_DOUBLE)
- REAL DCHI, HQDN, DN
-#endif
-
- DO 10 J = 1, NPAR
- SIGA (J) = SIGAA (J)
- 10 CONTINUE
-
-* For constrained fit...
- IF (NPAR .LT. NSIG) CALL HQSSV
-
- DCHISQ = 0.
-
-* WRITE (LOUT, 10000)
-
- IF (NDIM .EQ. 1) THEN
- DO 20 IX = 1, NX
- X = (IX - 0.5) / NX
- L = IX
- IF (IMQFUN .EQ. 1) THEN
- DN = HQDN (V)
- ELSE
- DN = VCONST * EXP (HQDN (V))
- END IF
- DCHISQ = DCHISQ +
- + (Q (L1H + L) - DN)**2 / Q (L1V + L)
- 20 CONTINUE
- ELSE IF (NDIM .EQ. 2) THEN
- DO 40 IX = 1, NX
- X = (IX - 0.5) / NX
- DO 30 IY = 1, NY
- Y = (IY - 0.5) / NY
- L = (IY - 1) * NX + IX
- IF (IMQFUN .EQ. 1) THEN
- DN = HQDN (V)
- ELSE
- DN = VCONST * EXP (HQDN (V))
- END IF
- DCHISQ = DCHISQ +
- + (Q (L2H + L) - DN)**2 / Q (L2V + L)
- 30 CONTINUE
- 40 CONTINUE
- ELSE IF (NDIM .EQ. 3) THEN
- DO 70 IX = 1, NX
- X = (IX - 0.5) / NX
- DO 60 IY = 1, NY
- Y = (IY - 0.5) / NY
- DO 50 IZ = 1, NZ
- Z = (IZ - 0.5) / NZ
- L = (IZ - 1) * NX * NY + (IY - 1) * NX + IX
- IF (IMQFUN .EQ. 1) THEN
- DN = HQDN (V)
- ELSE
- DN = VCONST * EXP (HQDN (V))
- END IF
- DCHI = (Q (L3H + L) - DN) ** 2 / Q (L3V + L)
-* WRITE (LOUT, 10100) X, Y, Z, Q (L3H + L), Q (L3V + L),
-* + DN, DCHI
- DCHISQ = DCHISQ + DCHI
- 50 CONTINUE
- 60 CONTINUE
- 70 CONTINUE
- ELSE
- GO TO 80
- END IF
-
-
- GO TO 90
-
- 80 CONTINUE
- WRITE (CHQMES, '(''HQMNU:'', I3, '' dimensions not programmed '
- +//'yet.'')') NDIM
- CALL HBUG (CHQMES, 'HQMNU', IDMQ)
-
- 90 CONTINUE
-
-10000 FORMAT (1X, 'HQMNU: X, Y, Z, H, V, FIT, DCHI:')
-10100 FORMAT (1X, 7G11.4)
-
- END
diff --git a/src/packlib/hbook/hquad/hqmxa1.F b/src/packlib/hbook/hquad/hqmxa1.F
deleted file mode 100644
index 8cf9402..0000000
--- a/src/packlib/hbook/hquad/hqmxa1.F
+++ /dev/null
@@ -1,39 +0,0 @@
-*
-* $Id: hqmxa1.F,v 1.1.1.1 1996/01/16 17:08:03 mclareni Exp $
-*
-* $Log: hqmxa1.F,v $
-* Revision 1.1.1.1 1996/01/16 17:08:03 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.17/01 22/11/92 12.11.50 by John Allison
-*-- Author :
- SUBROUTINE HQMXA1 (M, U, F, X)
- INTEGER M
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION U (M), F (M), X (*)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- REAL U (M), F (M), X (*)
-#endif
-* Used by MaXimum likelihood routines for Gaussian integration in 1-D
-* with routines D110 (CERN library).
-* A) Integrand is sum of multiquadrics.
-
-#include "hbook/hcqcom.inc"
-
- INTEGER I
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION HQDD
-#endif
-#if !defined(CERNLIB_DOUBLE)
- REAL HQDD
-#endif
-
- DO 10 I = 1, M
- X (1) = U (I)
- F (I) = HQDD (X)
- 10 CONTINUE
-
- END
diff --git a/src/packlib/hbook/hquad/hqmxa2.F b/src/packlib/hbook/hquad/hqmxa2.F
deleted file mode 100644
index 65619a5..0000000
--- a/src/packlib/hbook/hquad/hqmxa2.F
+++ /dev/null
@@ -1,46 +0,0 @@
-*
-* $Id: hqmxa2.F,v 1.1.1.1 1996/01/16 17:08:04 mclareni Exp $
-*
-* $Log: hqmxa2.F,v $
-* Revision 1.1.1.1 1996/01/16 17:08:04 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.17/01 22/11/92 12.11.50 by John Allison
-*-- Author :
- SUBROUTINE HQMXA2 (M, U, F, X)
- INTEGER M
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION U (M), F (M), X (*)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- REAL U (M), F (M), X (*)
-#endif
-* Used by MaXimum likelihood routines for Gaussian integration in 2-D
-* with routines D110 (CERN library).
-* A) Integrand is sum of multiquadrics.
-
-#include "hbook/hcqcom.inc"
-
- INTEGER I
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION DGMLT1
-#endif
-#if !defined(CERNLIB_DOUBLE)
- REAL RGMLT1
-#endif
- EXTERNAL HQMXA1
-
- DO 10 I = 1, M
- X (2) = U (I)
-#if defined(CERNLIB_DOUBLE)
- F (I) = DGMLT1 (HQMXA1, DBLE (XMI), DBLE (XMA),
- + NINTVS, NQUADS, X)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- F (I) = RGMLT1 (HQMXA1, XMI, XMA, NINTVS, NQUADS, X)
-#endif
- 10 CONTINUE
-
- END
diff --git a/src/packlib/hbook/hquad/hqmxa3.F b/src/packlib/hbook/hquad/hqmxa3.F
deleted file mode 100644
index edd7e92..0000000
--- a/src/packlib/hbook/hquad/hqmxa3.F
+++ /dev/null
@@ -1,46 +0,0 @@
-*
-* $Id: hqmxa3.F,v 1.1.1.1 1996/01/16 17:08:04 mclareni Exp $
-*
-* $Log: hqmxa3.F,v $
-* Revision 1.1.1.1 1996/01/16 17:08:04 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.17/01 22/11/92 12.11.50 by John Allison
-*-- Author :
- SUBROUTINE HQMXA3 (M, U, F, X)
- INTEGER M
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION U (M), F (M), X (*)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- REAL U (M), F (M), X (*)
-#endif
-* Used by MaXimum likelihood routines for Gaussian integration in 3-D
-* with routines D110 (CERN library).
-* A) Integrand is sum of multiquadrics.
-
-#include "hbook/hcqcom.inc"
-
- INTEGER I
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION DGMLT2
-#endif
-#if !defined(CERNLIB_DOUBLE)
- REAL RGMLT2
-#endif
- EXTERNAL HQMXA2
-
- DO 10 I = 1, M
- X (3) = U (I)
-#if defined(CERNLIB_DOUBLE)
- F (I) = DGMLT2 (HQMXA2, DBLE (YMI), DBLE (YMA),
- + NINTVS, NQUADS, X)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- F (I) = RGMLT2 (HQMXA2, YMI, YMA, NINTVS, NQUADS, X)
-#endif
- 10 CONTINUE
-
- END
diff --git a/src/packlib/hbook/hquad/hqmxb1.F b/src/packlib/hbook/hquad/hqmxb1.F
deleted file mode 100644
index 4bcda9c..0000000
--- a/src/packlib/hbook/hquad/hqmxb1.F
+++ /dev/null
@@ -1,39 +0,0 @@
-*
-* $Id: hqmxb1.F,v 1.1.1.1 1996/01/16 17:08:04 mclareni Exp $
-*
-* $Log: hqmxb1.F,v $
-* Revision 1.1.1.1 1996/01/16 17:08:04 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.17/01 22/11/92 12.11.50 by John Allison
-*-- Author :
- SUBROUTINE HQMXB1 (M, U, F, X)
- INTEGER M
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION U (M), F (M), X (*)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- REAL U (M), F (M), X (*)
-#endif
-* Used by MaXimum likelihood routines for Gaussian integration in 1-D
-* with routines D110 (CERN library).
-* B) Integrand is e^s phi_k.
-
-#include "hbook/hcqcom.inc"
-
- INTEGER I
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION HQDD, HQDDJ
-#endif
-#if !defined(CERNLIB_DOUBLE)
- REAL HQDD, HQDDJ
-#endif
-
- DO 10 I = 1, M
- X (1) = U (I)
- F (I) = EXP (HQDD (X)) * HQDDJ (X, KMQ)
- 10 CONTINUE
-
- END
diff --git a/src/packlib/hbook/hquad/hqmxb2.F b/src/packlib/hbook/hquad/hqmxb2.F
deleted file mode 100644
index 075e71f..0000000
--- a/src/packlib/hbook/hquad/hqmxb2.F
+++ /dev/null
@@ -1,46 +0,0 @@
-*
-* $Id: hqmxb2.F,v 1.1.1.1 1996/01/16 17:08:04 mclareni Exp $
-*
-* $Log: hqmxb2.F,v $
-* Revision 1.1.1.1 1996/01/16 17:08:04 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.17/01 22/11/92 12.11.50 by John Allison
-*-- Author :
- SUBROUTINE HQMXB2 (M, U, F, X)
- INTEGER M
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION U (M), F (M), X (*)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- REAL U (M), F (M), X (*)
-#endif
-* Used by MaXimum likelihood routines for Gaussian integration in 1-D
-* with routines D110 (CERN library).
-* B) Integrand is e^s phi_k.
-
-#include "hbook/hcqcom.inc"
-
- INTEGER I
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION DGMLT1
-#endif
-#if !defined(CERNLIB_DOUBLE)
- REAL RGMLT1
-#endif
- EXTERNAL HQMXB1
-
- DO 10 I = 1, M
- X (2) = U (I)
-#if defined(CERNLIB_DOUBLE)
- F (I) = DGMLT1 (HQMXB1, DBLE (XMI), DBLE (XMA),
- + NINTVS, NQUADS, X)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- F (I) = RGMLT1 (HQMXB1, XMI, XMA, NINTVS, NQUADS, X)
-#endif
- 10 CONTINUE
-
- END
diff --git a/src/packlib/hbook/hquad/hqmxb3.F b/src/packlib/hbook/hquad/hqmxb3.F
deleted file mode 100644
index 174faca..0000000
--- a/src/packlib/hbook/hquad/hqmxb3.F
+++ /dev/null
@@ -1,46 +0,0 @@
-*
-* $Id: hqmxb3.F,v 1.1.1.1 1996/01/16 17:08:04 mclareni Exp $
-*
-* $Log: hqmxb3.F,v $
-* Revision 1.1.1.1 1996/01/16 17:08:04 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.17/01 22/11/92 12.11.50 by John Allison
-*-- Author :
- SUBROUTINE HQMXB3 (M, U, F, X)
- INTEGER M
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION U (M), F (M), X (*)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- REAL U (M), F (M), X (*)
-#endif
-* Used by MaXimum likelihood routines for Gaussian integration in 1-D
-* with routines D110 (CERN library).
-* B) Integrand is e^s phi_k.
-
-#include "hbook/hcqcom.inc"
-
- INTEGER I
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION DGMLT2
-#endif
-#if !defined(CERNLIB_DOUBLE)
- REAL RGMLT2
-#endif
- EXTERNAL HQMXB2
-
- DO 10 I = 1, M
- X (3) = U (I)
-#if defined(CERNLIB_DOUBLE)
- F (I) = DGMLT2 (HQMXB2, DBLE (YMI), DBLE (YMA),
- + NINTVS, NQUADS, X)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- F (I) = RGMLT2 (HQMXB2, YMI, YMA, NINTVS, NQUADS, X)
-#endif
- 10 CONTINUE
-
- END
diff --git a/src/packlib/hbook/hquad/hqmxc1.F b/src/packlib/hbook/hquad/hqmxc1.F
deleted file mode 100644
index a5109d3..0000000
--- a/src/packlib/hbook/hquad/hqmxc1.F
+++ /dev/null
@@ -1,39 +0,0 @@
-*
-* $Id: hqmxc1.F,v 1.1.1.1 1996/01/16 17:08:04 mclareni Exp $
-*
-* $Log: hqmxc1.F,v $
-* Revision 1.1.1.1 1996/01/16 17:08:04 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.17/01 22/11/92 12.11.50 by John Allison
-*-- Author :
- SUBROUTINE HQMXC1 (M, U, F, X)
- INTEGER M
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION U (M), F (M), X (*)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- REAL U (M), F (M), X (*)
-#endif
-* Used by MaXimum likelihood routines for Gaussian integration in 1-D
-* with routines D110 (CERN library).
-* C) Integrand is e^s phi_j phi_k.
-
-#include "hbook/hcqcom.inc"
-
- INTEGER I
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION HQDD, HQDDJ
-#endif
-#if !defined(CERNLIB_DOUBLE)
- REAL HQDD, HQDDJ
-#endif
-
- DO 10 I = 1, M
- X (1) = U (I)
- F (I) = EXP (HQDD (X)) * HQDDJ (X, JMQ) * HQDDJ (X, KMQ)
- 10 CONTINUE
-
- END
diff --git a/src/packlib/hbook/hquad/hqmxc2.F b/src/packlib/hbook/hquad/hqmxc2.F
deleted file mode 100644
index 9c5f2df..0000000
--- a/src/packlib/hbook/hquad/hqmxc2.F
+++ /dev/null
@@ -1,46 +0,0 @@
-*
-* $Id: hqmxc2.F,v 1.1.1.1 1996/01/16 17:08:04 mclareni Exp $
-*
-* $Log: hqmxc2.F,v $
-* Revision 1.1.1.1 1996/01/16 17:08:04 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.17/01 22/11/92 12.11.50 by John Allison
-*-- Author :
- SUBROUTINE HQMXC2 (M, U, F, X)
- INTEGER M
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION U (M), F (M), X (*)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- REAL U (M), F (M), X (*)
-#endif
-* Used by MaXimum likelihood routines for Gaussian integration in 1-D
-* with routines D110 (CERN library).
-* B) Integrand is e^s phi_k.
-
-#include "hbook/hcqcom.inc"
-
- INTEGER I
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION DGMLT1
-#endif
-#if !defined(CERNLIB_DOUBLE)
- REAL RGMLT1
-#endif
- EXTERNAL HQMXC1
-
- DO 10 I = 1, M
- X (2) = U (I)
-#if defined(CERNLIB_DOUBLE)
- F (I) = DGMLT1 (HQMXC1, DBLE (XMI), DBLE (XMA),
- + NINTVS, NQUADS, X)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- F (I) = RGMLT1 (HQMXC1, XMI, XMA, NINTVS, NQUADS, X)
-#endif
- 10 CONTINUE
-
- END
diff --git a/src/packlib/hbook/hquad/hqmxc3.F b/src/packlib/hbook/hquad/hqmxc3.F
deleted file mode 100644
index a864254..0000000
--- a/src/packlib/hbook/hquad/hqmxc3.F
+++ /dev/null
@@ -1,46 +0,0 @@
-*
-* $Id: hqmxc3.F,v 1.1.1.1 1996/01/16 17:08:04 mclareni Exp $
-*
-* $Log: hqmxc3.F,v $
-* Revision 1.1.1.1 1996/01/16 17:08:04 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.17/01 22/11/92 12.11.50 by John Allison
-*-- Author :
- SUBROUTINE HQMXC3 (M, U, F, X)
- INTEGER M
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION U (M), F (M), X (*)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- REAL U (M), F (M), X (*)
-#endif
-* Used by MaXimum likelihood routines for Gaussian integration in 1-D
-* with routines D110 (CERN library).
-* B) Integrand is e^s phi_k.
-
-#include "hbook/hcqcom.inc"
-
- INTEGER I
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION DGMLT2
-#endif
-#if !defined(CERNLIB_DOUBLE)
- REAL RGMLT2
-#endif
- EXTERNAL HQMXC2
-
- DO 10 I = 1, M
- X (3) = U (I)
-#if defined(CERNLIB_DOUBLE)
- F (I) = DGMLT2 (HQMXC2, DBLE (YMI), DBLE (YMA),
- + NINTVS, NQUADS, X)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- F (I) = RGMLT2 (HQMXC2, YMI, YMA, NINTVS, NQUADS, X)
-#endif
- 10 CONTINUE
-
- END
diff --git a/src/packlib/hbook/hquad/hqmxli.F b/src/packlib/hbook/hquad/hqmxli.F
deleted file mode 100644
index 6f0dfb1..0000000
--- a/src/packlib/hbook/hquad/hqmxli.F
+++ /dev/null
@@ -1,308 +0,0 @@
-*
-* $Id: hqmxli.F,v 1.1.1.1 1996/01/16 17:08:05 mclareni Exp $
-*
-* $Log: hqmxli.F,v $
-* Revision 1.1.1.1 1996/01/16 17:08:05 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.17/02 18/12/92 11.32.44 by Rene Brun
-*-- Author :
- SUBROUTINE HQMXLI (SIGCOV, DWK1, DSIGA, N, CHISQ, ALOGLI, IHQERR)
- INTEGER N
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION SIGCOV (N, N)
- DOUBLE PRECISION DWK1 (N), DSIGA (N)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- REAL SIGCOV (N, N)
- REAL DWK1 (N), DSIGA (N)
-#endif
- INTEGER IHQERR
- REAL CHISQ, ALOGLI
-* Performs maximum likelihood fit to events using extended likelihood method.
-* Assumes good starting values have already been calculated.
-* CHISQ is calculated by comparing the maximum likelihood solution to the trial
-* histogram data; hence it is not the minimum chi-squared.
-* ALOGLI is log likelihood.
-* IHQERR = 0 of all's OK.
-
-#include "hbook/hcqcom.inc"
-#include "hbook/hcqcor.inc"
-#include "hbook/hcbook.inc"
-#include "hbook/hcunit.inc"
-
- CHARACTER*80 CHQMES
- LOGICAL PPRINT
- INTEGER I, J, K, NSECS, ITER, ITERMX, NWW, L, IX, IY, IZ
- REAL T, OPS, UFACT, STEP, STEPMI
- REAL V (NDMAX)
- REAL X, Y, Z
- EQUIVALENCE (X, V (1)), (Y, V(2)), (Z, V(3))
-#if defined(CERNLIB_DOUBLE)
- PARAMETER (NWW = 2)
- DOUBLE PRECISION DCHISQ, DLOGLI, DLOGL0
- DOUBLE PRECISION DCHEK1, DCHEK2
- DOUBLE PRECISION INTGRG, HQD, HQDJ, HQDN
- DOUBLE PRECISION DV (NDMAX), DGMLT1, DGMLT2, DGMLT3
-#endif
-#if !defined(CERNLIB_DOUBLE)
- PARAMETER (NWW = 1)
- REAL DCHISQ, DLOGLI, DLOGL0
- REAL DCHEK1, DCHEK2
- REAL INTGRG, HQD, HQDJ, HQDN
- REAL DV (NDMAX), RGMLT1, RGMLT2, RGMLT3
-#endif
- EXTERNAL HQMXA1, HQMXA2, HQMXA3
- EXTERNAL HQMXB1, HQMXB2, HQMXB3
- EXTERNAL HQMXC1, HQMXC2, HQMXC3
-
- PARAMETER (ITERMX = 20)
- PARAMETER (UFACT = 40000.)
- PARAMETER (DCHEK1 = 1.E-3)
- PARAMETER (DCHEK2 = 100. * DCHEK1)
- PARAMETER (STEPMI = 1. / 32.)
-
- CHISQ = 0.
- ALOGLI = 0.
- IHQERR = 0
-
-* Set function flag for exponential function.
- IMQFUN = 2
-
- OPS = FLOAT (NSIG ** 2) * FLOAT (NBTOT)
- PPRINT = VPRINT
- IF (PPRINT) THEN
- WRITE (LOUT, 10000) NSIG, NBTOT
- NSECS = OPS / UFACT
- WRITE (LOUT, 10100) NSECS
- CALL TIMED (T)
- END IF
-
-* Begin iterating.
- DLOGL0 = -1.D30
- STEP = 1.
- ITER = 0
- GO TO 90
-
-* Start of iteration loop
- 10 CONTINUE
- ITER = ITER + 1
- IF (ITER .GT. ITERMX) GO TO 190
-
-* Evaluate the matrices A and B (use SIGCOV and SIGA respectively) and
-* solve A * SIGA = B.
- CALL UZERO (DSIGA, 1, NWW * NSIG)
- CALL UZERO (SIGCOV, 1, NWW * NSIG ** 2)
-
-* Calculate SIGA and SIGCOV lower triangle.
- DO 40 K = 1, NSIG
-* Sum over events of phi_j...
- DO 20 I = 1, NMQEVS
- CALL HGNF (IDMQ, I, V, IHQERR)
- IF (IHQERR .NE. 0) GO TO 200
- DSIGA (K) = DSIGA (K) + HQDJ (V, K)
- 20 CONTINUE
-* Integral e^s phi_j dx...
- KMQ = K
-#if defined(CERNLIB_DOUBLE)
- IF (NDIM .EQ. 1) THEN
- INTGRG = DGMLT1 (HQMXB1, DBLE (XMI), DBLE (XMA), NINTVS,
- + NQUADS, DV)
- ELSE IF (NDIM .EQ. 2) THEN
- INTGRG = DGMLT2 (HQMXB2, DBLE (YMI), DBLE (YMA), NINTVS,
- + NQUADS, DV)
- ELSE IF (NDIM .EQ. 3) THEN
- INTGRG = DGMLT3 (HQMXB3, DBLE (ZMI), DBLE (ZMA), NINTVS,
- + NQUADS, DV)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- IF (NDIM .EQ. 1) THEN
- INTGRG = RGMLT1 (HQMXB1, XMI, XMA, NINTVS, NQUADS, DV)
- ELSE IF (NDIM .EQ. 2) THEN
- INTGRG = RGMLT2 (HQMXB2, YMI, YMA, NINTVS, NQUADS, DV)
- ELSE IF (NDIM .EQ. 3) THEN
- INTGRG = RGMLT3 (HQMXB3, ZMI, ZMA, NINTVS, NQUADS, DV)
-#endif
- ELSE
- GO TO 180
- END IF
- DSIGA (K) = DSIGA (K) - INTGRG
- DO 30 J = 1, K
-* Integral e^s phi_j phi_k dx...
- JMQ = J
-#if defined(CERNLIB_DOUBLE)
- IF (NDIM .EQ. 1) THEN
- INTGRG = DGMLT1 (HQMXC1, DBLE (XMI), DBLE (XMA), NINTVS,
- + NQUADS, DV)
- ELSE IF (NDIM .EQ. 2) THEN
- INTGRG = DGMLT2 (HQMXC2, DBLE (YMI), DBLE (YMA), NINTVS,
- + NQUADS, DV)
- ELSE IF (NDIM .EQ. 3) THEN
- INTGRG = DGMLT3 (HQMXC3, DBLE (ZMI), DBLE (ZMA), NINTVS,
- + NQUADS, DV)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- IF (NDIM .EQ. 1) THEN
- INTGRG = RGMLT1 (HQMXC1, XMI, XMA, NINTVS, NQUADS, DV)
- ELSE IF (NDIM .EQ. 2) THEN
- INTGRG = RGMLT2 (HQMXC2, YMI, YMA, NINTVS, NQUADS, DV)
- ELSE IF (NDIM .EQ. 3) THEN
- INTGRG = RGMLT3 (HQMXC3, ZMI, ZMA, NINTVS, NQUADS, DV)
-#endif
- ELSE
- GO TO 180
- END IF
- SIGCOV (J, K) = SIGCOV (J, K) + INTGRG
- 30 CONTINUE
- 40 CONTINUE
-
-* Fill SIGCOV upper triangle.
- DO 60 K = 1, NSIG
- DO 50 J = 1, K - 1
- SIGCOV (K, J) = SIGCOV (J, K)
- 50 CONTINUE
- 60 CONTINUE
-
-* Call CERN library routine DEQINV (F010) for simultaneous equations to
-* solve A * SIGA = B.
-#if defined(CERNLIB_DOUBLE)
- CALL DEQINV (NSIG, SIGCOV, NSIG, DWK1, IHQERR, 1, DSIGA)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- CALL REQINV (NSIG, SIGCOV, NSIG, DWK1, IHQERR, 1, DSIGA)
-#endif
- IF (IHQERR .NE. 0) GO TO 230
-* Update SIGA.
- 70 CONTINUE
- DO 80 J = 1, NSIG
- SIGA (J) = SIGA (J) + STEP * DSIGA (J)
- 80 CONTINUE
-
-* Evaluate log likelihood for convergence testing.
- 90 CONTINUE
- DLOGLI = 0.
- DO 100 I = 1, NMQEVS
- CALL HGNF (IDMQ, I, V, IHQERR)
- IF (IHQERR .NE. 0) GO TO 200
- DLOGLI = DLOGLI + HQD (V)
- 100 CONTINUE
-* Integral s dx, where s = sum of multiquadrics.
-#if defined(CERNLIB_DOUBLE)
- IF (NDIM .EQ. 1) THEN
- INTGRG = DGMLT1 (HQMXA1, DBLE (XMI), DBLE (XMA),
- + NINTVS, NQUADS, DV)
- ELSE IF (NDIM .EQ. 2) THEN
- INTGRG = DGMLT2 (HQMXA2, DBLE (YMI), DBLE (YMA),
- + NINTVS, NQUADS, DV)
- ELSE IF (NDIM .EQ. 3) THEN
- INTGRG = DGMLT3 (HQMXA3, DBLE (ZMI), DBLE (ZMA),
- + NINTVS, NQUADS, DV)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- IF (NDIM .EQ. 1) THEN
- INTGRG = RGMLT1 (HQMXA1, XMI, XMA, NINTVS, NQUADS, DV)
- ELSE IF (NDIM .EQ. 2) THEN
- INTGRG = RGMLT2 (HQMXA2, YMI, YMA, NINTVS, NQUADS, DV)
- ELSE IF (NDIM .EQ. 3) THEN
- INTGRG = RGMLT3 (HQMXA3, ZMI, ZMA, NINTVS, NQUADS, DV)
-#endif
- ELSE
- GO TO 180
- END IF
- DLOGLI = DLOGLI - INTGRG
-
-* Check convergence.
- IF (DLOGLI - DLOGL0 .GT. DCHEK1) THEN
- DLOGL0 = DLOGLI
- IF (STEP .LT. 1.) STEP = 2. * STEP
- GO TO 10
- ELSE IF (DLOGLI - DLOGL0 .LT. -DCHEK2) THEN
-* Decreasing log liklelihood - back up and try smaller step
- IF (STEP .LT. STEPMI) GO TO 210
- DO 110 J = 1, NSIG
- SIGA (J) = SIGA (J) - STEP * DSIGA (J)
- 110 CONTINUE
- STEP = 0.5 * STEP
- GO TO 70
- END IF
-
-* Check convergence.
- IF (DLOGLI - DLOGL0 .GT. DCHEK1) THEN
- DLOGL0 = DLOGLI
- GO TO 10
- ELSE IF (DLOGLI - DLOGL0 .LT. -DCHEK2) THEN
- GO TO 210
- END IF
-
-* Get chi-squared.
- DCHISQ = 0.
- IF (NDIM .EQ. 1) THEN
- DO 120 IX = 1, NX
- X = (IX - 0.5) / NX
- L = IX
- DCHISQ = DCHISQ + (Q (L1H + L) - HQDN (V)) ** 2 /
- + Q (L1V + L)
- 120 CONTINUE
- ELSE IF (NDIM .EQ. 2) THEN
- DO 140 IX = 1, NX
- X = (IX - 0.5) / NX
- DO 130 IY = 1, NY
- Y = (IY - 0.5) / NY
- L = (IY - 1) * NX + IX
- DCHISQ = DCHISQ + (Q (L2H + L) - HQDN (V)) ** 2 /
- + Q (L2V + L)
- 130 CONTINUE
- 140 CONTINUE
- ELSE IF (NDIM .EQ. 3) THEN
- DO 170 IX = 1, NX
- X = (IX - 0.5) / NX
- DO 160 IY = 1, NY
- Y = (IY - 0.5) / NY
- DO 150 IZ = 1, NZ
- Z = (IZ - 0.5) / NZ
- L = (IZ - 1) * NX * NY + (IY - 1) * NX + IX
- DCHISQ = DCHISQ + (Q (L3H + L) - HQDN (V)) ** 2 /
- + Q (L3V + L)
- 150 CONTINUE
- 160 CONTINUE
- 170 CONTINUE
- ELSE
- GO TO 10
- END IF
- CHISQ = DCHISQ
- ALOGLI = DLOGLI
-* IF (PPRINT) THEN
-* CALL TIMED (T)
-* WRITE (LOUT, '(3X, ''Took'', G12.5, '' secs.'')') T
-* END IF
-
- GO TO 230
-
- 180 CONTINUE
- WRITE (CHQMES, '(I3, '' dimensions not programmed yet.'')') NDIM
- IHQERR = 10
- GO TO 220
- 190 CONTINUE
- WRITE (CHQMES, '(''More than'', I4, '' iterations.'')') ITERMX
- IHQERR = 20
- GO TO 220
- 200 CONTINUE
- WRITE (CHQMES, '(''Error'', I3, '' in HGNF.'')') IHQERR
- GO TO 220
- 210 CONTINUE
- WRITE (CHQMES, '(''Likelihood decreasing!'')')
- IHQERR = 30
- GO TO 220
-
- 220 CONTINUE
- CALL HBUG (CHQMES, 'HQMXLI', IDMQ)
-
- 230 CONTINUE
-
-10000 FORMAT (1X, 'Multiquadric unbinned maximum likelihood fit to ',
- +'events with', I5, ' parameters for', I7, ' bins.')
-10100 FORMAT (3X, 'This will take about', I10, ' CERN-unit-secs.')
-
- END
diff --git a/src/packlib/hbook/hquad/hqout.F b/src/packlib/hbook/hquad/hqout.F
deleted file mode 100644
index 525a109..0000000
--- a/src/packlib/hbook/hquad/hqout.F
+++ /dev/null
@@ -1,64 +0,0 @@
-*
-* $Id: hqout.F,v 1.1.1.1 1996/01/16 17:08:05 mclareni Exp $
-*
-* $Log: hqout.F,v $
-* Revision 1.1.1.1 1996/01/16 17:08:05 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.17/01 22/11/92 15.16.56 by John Allison
-*-- Author :
- SUBROUTINE HQOUT (LHQOUT, ICOVAR)
- INTEGER LHQOUT, ICOVAR
-* Writes multiquadric parameters to unit LHQOUT
-* ICOVAR = 0, no covariance matrix elements.
-* ICOVAR = 1, write covariance matrix elements.
-*!!!!! Use with care! See warning in HQIN header.
-
-#include "hbook/hcqcom.inc"
-#include "hbook/hcqcor.inc"
-#include "hbook/hcbook.inc"
-#include "hbook/hcunit.inc"
-
- INTEGER I, J, L, NWW
-
-#if defined(CERNLIB_DOUBLE)
- PARAMETER (NWW = 2)
- DOUBLE PRECISION SS
-#endif
-#if !defined(CERNLIB_DOUBLE)
- PARAMETER (NWW = 1)
- REAL SS
-#endif
-
- WRITE (LOUT, 10000) NSIG
-
- WRITE (LHQOUT, '(8I10)') NSIG, NDIM, IMQFUN,
- +(NBINS (I), I = 1, NDIM)
-
- WRITE (LHQOUT, '(4G20.13)') VCONST, HQFMIN, HQFMAX
-
- WRITE (LHQOUT, '(4G20.13)') (SIGVMI (I), SIGVMA (I), I = 1, NDIM)
-
- DO 10 I = 1, NSIG
- WRITE (LHQOUT, '(I5, 3G20.13 / (5X, 3G20.13))')
- + I, SIGA (I), (SIGV (I, J), J = 1, NDIM), SIGDEL (I)
- 10 CONTINUE
-
-* Covariances.
-* (Allow for fact that LHQCOV data has been made to start on 8-byte boundary.)
- IF (ICOVAR .EQ. 1) THEN
- L = LHQCOV + MOD (LHQCOV, NWW)
- DO 30 I = 1, NSIG
- DO 20 J = 1, I
- CALL UCOPY (Q (L + NWW * ((J - 1) * NSIG + I - 1) + 1),
- + SS, NWW)
- WRITE (LHQOUT, '(G20.13)') SS
- 20 CONTINUE
- 30 CONTINUE
- END IF
-
-10000 FORMAT (1X, 'Writing ', I5, ' multiquadric parameters.')
-
- END
diff --git a/src/packlib/hbook/hquad/hqpois.F b/src/packlib/hbook/hquad/hqpois.F
deleted file mode 100644
index 45050c2..0000000
--- a/src/packlib/hbook/hquad/hqpois.F
+++ /dev/null
@@ -1,494 +0,0 @@
-*
-* $Id: hqpois.F,v 1.1.1.1 1996/01/16 17:08:05 mclareni Exp $
-*
-* $Log: hqpois.F,v $
-* Revision 1.1.1.1 1996/01/16 17:08:05 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.17/02 18/12/92 14.23.02 by John Allison
-*-- Author :
- SUBROUTINE HQPOIS (SIGCOV, DDERIV, DJN, DSIGA, DDSIGA, N, CHISQ,
- +ALOGLI, IHQERR)
- INTEGER N
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION SIGCOV (N, N)
- DOUBLE PRECISION DDERIV (N, N)
- DOUBLE PRECISION DJN (N), DSIGA (N), DDSIGA (N)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- REAL SIGCOV (N, N)
- REAL DDERIV (N, N)
- REAL DJN (N), DSIGA (N), DDSIGA (N)
-#endif
- INTEGER IHQERR
- REAL CHISQ, ALOGLI
-* Perform unconstrained Poisson (binned) likelihood fit to bin contents.
-* IHQERR = 0 if all's OK.
-* CHISQ is calculated by comparing the maximum likelihood solution to the trial
-* histogram data; hence it is not the minimum chi-squared.
-* ALOGLI is log likelihood.
-
-#include "hbook/hcqcom.inc"
-#include "hbook/hcqcor.inc"
-#include "hbook/hcbook.inc"
-#include "hbook/hcunit.inc"
-
- CHARACTER*80 CHQMES
- LOGICAL PPRINT
- LOGICAL EVALDD, DESPRT
- INTEGER J, K, L, LB, LB0, NWW
- INTEGER IX, IY, IZ
- INTEGER NSECS, ITER, ITERDD, ITRMX0, ITERMX, IDDINT
- REAL OPS, UFACT
- REAL V (NDMAX)
- REAL X, Y, Z, FF, FFMIN, STEP, STEPMI
- EQUIVALENCE (X, V (1)), (Y, V(2)), (Z, V(3))
-#if defined(CERNLIB_DOUBLE)
- PARAMETER (NWW = 2)
- DOUBLE PRECISION DCHISQ, DLOGLI, DLOGL0, DCHEK1, DCHEK2, DN
- DOUBLE PRECISION VEXPDN
- DOUBLE PRECISION HQDN, HQDJN
- DOUBLE PRECISION SS
-#endif
-#if !defined(CERNLIB_DOUBLE)
- PARAMETER (NWW = 1)
- REAL DCHISQ, DLOGLI, DLOGL0, DCHEK1, DCHEK2, DN
- REAL VEXPDN
- REAL HQDN, HQDJN
- REAL SS
-#endif
-
- PARAMETER (ITRMX0 = 50, IDDINT = 3)
- PARAMETER (UFACT = 110000.)
- PARAMETER (DCHEK1 = 1.D-3)
- PARAMETER (DCHEK2 = 10. * DCHEK1)
- PARAMETER (STEPMI = 1. / 32.)
-
-
-
- CHISQ = 0.
- ALOGLI = 0.
- IHQERR = 0
-
-* Set function flag for exponential function.
- IMQFUN = 2
-
-* Calculate constant factor.
- VCONST = VOLBIN
-
- OPS = FLOAT (NSIG ** 2) * FLOAT (NBTOT)
- PPRINT = VPRINT
- IF (PPRINT) THEN
- WRITE (LOUT, 10000) IDMQ
- IF (NDIM .EQ. 1) THEN
- WRITE (LOUT, 10100) NSIG, NBTOT
- ELSE IF (NDIM .EQ. 2) THEN
- WRITE (LOUT, 10200) NSIG, NBTOT, NX, NY
- ELSE IF (NDIM .EQ. 3) THEN
- WRITE (LOUT, 10300) NSIG, NBTOT, NX, NY, NZ
- ELSE
- GO TO 430
- END IF
- NSECS = OPS / UFACT
- WRITE (LOUT, 10400) NSECS, 10 * NSECS
- WRITE (LOUT, 10500) ITRMX0
- END IF
-
-* Estimate starting values.
-* First a least squares fit to linear sum of multiquadrics to get function
-* values (actually only needed for empty bins).
- IF (PPRINT) WRITE (LOUT,10600)
- CALL HQLSQU (SIGCOV, DJN, N, CHISQ, IHQERR)
- IF (IHQERR .NE. 0) GO TO 470
- IF (PPRINT) WRITE (LOUT, 10700) CHISQ
-* Rebin.
- CALL HQBIN (NBINS, 1, IHQERR)
- IF (IHQERR .NE. 0) GO TO 470
-* Unconstrained, linear least squares fit to log of (contents/VCONST) for
-* starting values. This is an ad hoc method of getting starting values.
-* Some of the parameters were tuned by experience, and do not have much
-* foundation. E.g., FFMIN is the minimum value substituted for empty bins
-* (to avoid log (0) = -INF) - otherwise a value from the previous step is
-* used. Also I tried various algorithms for the variance of empty bins but
-* leaving it at 1 seems OK.
- IF (PPRINT) WRITE (LOUT, 10800)
- FFMIN = 1. / NMQFUL
- IF (NDIM .EQ. 1) THEN
- DO 10 IX = 1, NX
- X = (IX - 0.5) / NX
- L = IX
- IF (Q (L1H + L) .EQ. 0.) THEN
- FF = HQDN (V)
- FF = MAX (FFMIN, FF)
- Q (L1H + L) = LOG (FF / VCONST)
-* Q (L1V + L) is already 1., as required.
- ELSE
- Q (L1V + L) = Q (L1V + L) / (Q (L1H + L)) ** 2
- Q (L1H + L) = LOG (Q (L1H + L) / VCONST)
- END IF
- 10 CONTINUE
- ELSE IF (NDIM .EQ. 2) THEN
- DO 30 IX = 1, NX
- X = (IX - 0.5) / NX
- DO 20 IY = 1, NY
- Y = (IY - 0.5) / NY
- L = (IY - 1) * NX + IX
- IF (Q (L2H + L) .EQ. 0.) THEN
- FF = HQDN (V)
- FF = MAX (FFMIN, FF)
- FF = MIN (1., FF)
- Q (L2H + L) = LOG (FF / VCONST)
-* Q (L2V + L) is already 1., as required.
- ELSE
- Q (L2V + L) = Q (L2V + L) / (Q (L2H + L)) ** 2
- Q (L2H + L) = LOG (Q (L2H + L) / VCONST)
- END IF
- 20 CONTINUE
- 30 CONTINUE
- ELSE IF (NDIM .EQ. 3) THEN
- DO 60 IX = 1, NX
- X = (IX - 0.5) / NX
- DO 50 IY = 1, NY
- Y = (IY - 0.5) / NY
- DO 40 IZ = 1, NZ
- Z = (IZ - 0.5) / NZ
- L = (IZ - 1) * NX * NY + (IY - 1) * NX + IX
- IF (Q (L3H + L) .EQ. 0.) THEN
- FF = HQDN (V)
- FF = MAX (FFMIN, FF)
- Q (L3H + L) = LOG (FF / VCONST)
-* Q (L3V + L) is already 1., as required.
- ELSE
- Q (L3V + L) = Q (L3V + L) / (Q (L3H + L)) ** 2
- Q (L3H + L) = LOG (Q (L3H + L) / VCONST)
- END IF
- 40 CONTINUE
- 50 CONTINUE
- 60 CONTINUE
- ELSE
- GO TO 430
- END IF
- CALL HQLSQU (SIGCOV, DJN, N, CHISQ, IHQERR)
- IF (IHQERR .NE. 0) GO TO 470
- IF (PPRINT) WRITE (LOUT, 10900) CHISQ
-* Rebin.
- CALL HQBIN (NBINS, 1, IHQERR)
- IF (IHQERR .NE. 0) GO TO 470
-
-* OK, let's go.
- IF (PPRINT) WRITE (LOUT,11000)
-
- IF (LHQDJN .NE. 0) THEN
-* Fill working space with phi_j for each bin.
- IF (PPRINT) WRITE (LOUT, 11100)
- IF (NDIM .EQ. 1) THEN
- DO 80 IX = 1, NX
- X = (IX - 0.5) / NX
- L = IX
- LB0 = NSIG * (L - 1)
- DO 70 K = 1, NSIG
- LB = NWW * (LB0 + K - 1) + 1
- SS = HQDJN (V, K)
- CALL UCOPY (SS, Q (LHQDJN + LB), NWW)
- 70 CONTINUE
- 80 CONTINUE
- ELSE IF (NDIM .EQ. 2) THEN
- DO 110 IX = 1, NX
- X = (IX - 0.5) / NX
- DO 100 IY = 1, NY
- Y = (IY - 0.5) / NY
- L = (IY - 1) * NX + IX
- LB0 = NSIG * (L - 1)
- DO 90 K = 1, NSIG
- LB = NWW * (LB0 + K - 1) + 1
- SS = HQDJN (V, K)
- CALL UCOPY (SS, Q (LHQDJN + LB), NWW)
- 90 CONTINUE
- 100 CONTINUE
- 110 CONTINUE
- ELSE IF (NDIM .EQ. 3) THEN
- DO 150 IX = 1, NX
- X = (IX - 0.5) / NX
- DO 140 IY = 1, NY
- Y = (IY - 0.5) / NY
- DO 130 IZ = 1, NZ
- Z = (IZ - 0.5) / NZ
- L = (IZ - 1) * NX * NY + (IY - 1) * NX + IX
- LB0 = NSIG * (L - 1)
- DO 120 K = 1, NSIG
- LB = NWW * (LB0 + K - 1) + 1
- SS = HQDJN (V, K)
- CALL UCOPY (SS, Q (LHQDJN + LB), NWW)
- 120 CONTINUE
- 130 CONTINUE
- 140 CONTINUE
- 150 CONTINUE
- ELSE
- GO TO 430
- END IF
- END IF
-
-* Begin iterating.
- DESPRT = .FALSE.
- DLOGL0 = -1.D30
- STEP = 1.
- ITER = 0
- ITERMX = ITRMX0
- ITERDD = IDDINT
- GO TO 340
-
-* Start of iteration loop
- 160 CONTINUE
- ITER = ITER + 1
- ITERDD = ITERDD + 1
- IF (ITER .GT. ITERMX) THEN
- WRITE (LOUT, 11200)
- GO TO 420
- END IF
- 170 CONTINUE
- EVALDD = ITERDD .GE. IDDINT .OR. STEP .LT. 1.
- IF (EVALDD) ITERDD = 0
-
-* Evaluate the matrices A and B and solve A * SIGA = B.
- CALL UZERO (DDSIGA, 1, NWW * NSIG)
- IF (EVALDD) CALL UZERO (DDERIV, 1, NWW * NSIG ** 2)
-* Calculate DDSIGA and DDERIV lower triangle.
- IF (NDIM .EQ. 1) THEN
- DO 200 IX = 1, NX
- X = (IX - 0.5) / NX
- L = IX
- VEXPDN = VCONST * EXP (HQDN (V))
- LB0 = NSIG * (L - 1)
- DO 190 K = 1, NSIG
- IF (LHQDJN .NE. 0) THEN
- LB = NWW * (LB0 + K - 1) + 1
- CALL UCOPY (Q (LHQDJN + LB), SS, NWW)
- ELSE
- SS = HQDJN (V, K)
- END IF
- DDSIGA (K) = DDSIGA (K) + (Q (L1H + L) - VEXPDN) * SS
- IF (EVALDD) THEN
- DJN (K) = SS
- DO 180 J = 1, K
- DDERIV (J, K) = DDERIV (J, K) + VEXPDN * DJN (K) *
- + DJN (J)
- 180 CONTINUE
- END IF
- 190 CONTINUE
- 200 CONTINUE
- ELSE IF (NDIM .EQ. 2) THEN
- DO 240 IX = 1, NX
- X = (IX - 0.5) / NX
- DO 230 IY = 1, NY
- Y = (IY - 0.5) / NY
- L = (IY - 1) * NX + IX
- VEXPDN = VCONST * EXP (HQDN (V))
- LB0 = NSIG * (L - 1)
- DO 220 K = 1, NSIG
- IF (LHQDJN .NE. 0) THEN
- LB = NWW * (LB0 + K - 1) + 1
- CALL UCOPY (Q (LHQDJN + LB), SS, NWW)
- ELSE
- SS = HQDJN (V, K)
- END IF
- DDSIGA (K) = DDSIGA (K) + (Q (L2H + L) - VEXPDN) * SS
- IF (EVALDD) THEN
- DJN (K) = SS
- DO 210 J = 1, K
- DDERIV (J, K) = DDERIV (J, K) + VEXPDN * DJN
- + (K) * DJN (J)
- 210 CONTINUE
- END IF
- 220 CONTINUE
- 230 CONTINUE
- 240 CONTINUE
- ELSE IF (NDIM .EQ. 3) THEN
- DO 290 IX = 1, NX
- X = (IX - 0.5) / NX
- DO 280 IY = 1, NY
- Y = (IY - 0.5) / NY
- DO 270 IZ = 1, NZ
- Z = (IZ - 0.5) / NZ
- L = (IZ - 1) * NX * NY + (IY - 1) * NX + IX
- VEXPDN = VCONST * EXP (HQDN (V))
- LB0 = NSIG * (L - 1)
- DO 260 K = 1, NSIG
- IF (LHQDJN .NE. 0) THEN
- LB = NWW * (LB0 + K - 1) + 1
- CALL UCOPY (Q (LHQDJN + LB), SS, NWW)
- ELSE
- SS = HQDJN (V, K)
- END IF
- DDSIGA (K) = DDSIGA (K) + (Q (L3H + L) - VEXPDN) *
- + SS
- IF (EVALDD) THEN
- DJN (K) = SS
- DO 250 J = 1, K
- DDERIV (J, K) = DDERIV (J, K) + VEXPDN *
- + DJN (K) * DJN (J)
- 250 CONTINUE
- END IF
- 260 CONTINUE
- 270 CONTINUE
- 280 CONTINUE
- 290 CONTINUE
- ELSE
- GO TO 430
- END IF
-* Fill DDERIV upper triangle.
- IF (EVALDD) THEN
- DO 310 K = 1, NSIG
- DO 300 J = 1, K - 1
- DDERIV (K, J) = DDERIV (J, K)
- 300 CONTINUE
- 310 CONTINUE
- END IF
-* Copy to DSIGA and SIGCOV ready for inversion.
- CALL UCOPY (DDSIGA, DSIGA, NWW * NSIG)
- CALL UCOPY (DDERIV, SIGCOV, NWW * NSIG ** 2)
-
-* Call CERN library routine DEQINV (F010) for simultaneous equations to
-* solve A * DSIGA = B.
-#if defined(CERNLIB_DOUBLE)
- CALL DEQINV (NSIG, SIGCOV, NSIG, DJN, IHQERR, 1, DSIGA)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- CALL REQINV (NSIG, SIGCOV, NSIG, DJN, IHQERR, 1, DSIGA)
-#endif
- IF (IHQERR .NE. 0) GO TO 440
-
-* Update SIGA.
- 320 CONTINUE
- DO 330 J = 1, NSIG
- SIGA (J) = SIGA (J) + STEP * DSIGA (J)
- 330 CONTINUE
-
-* Evaluate log likelihood for convergence testing, and chi-squared.
- 340 CONTINUE
- DLOGLI = 0.
- DCHISQ = 0.
- IF (NDIM .EQ. 1) THEN
- DO 350 IX = 1, NX
- X = (IX - 0.5) / NX
- L = IX
- DN = HQDN (V)
- VEXPDN = VCONST * EXP (DN)
- DLOGLI = DLOGLI + Q (L1H + L) * DN - VEXPDN
- DCHISQ = DCHISQ + (Q (L1H + L) - VEXPDN) ** 2 /
- + Q (L1V + L)
- 350 CONTINUE
- ELSE IF (NDIM .EQ. 2) THEN
- DO 370 IX = 1, NX
- X = (IX - 0.5) / NX
- DO 360 IY = 1, NY
- Y = (IY - 0.5) / NY
- L = (IY - 1) * NX + IX
- DN = HQDN (V)
- VEXPDN = VCONST * EXP (DN)
- DLOGLI = DLOGLI + Q (L2H + L) * DN - VEXPDN
- DCHISQ = DCHISQ + (Q (L2H + L) - VEXPDN) ** 2 /
- + Q (L2V + L)
- 360 CONTINUE
- 370 CONTINUE
- ELSE IF (NDIM .EQ. 3) THEN
- DO 400 IX = 1, NX
- X = (IX - 0.5) / NX
- DO 390 IY = 1, NY
- Y = (IY - 0.5) / NY
- DO 380 IZ = 1, NZ
- Z = (IZ - 0.5) / NZ
- L = (IZ - 1) * NX * NY + (IY - 1) * NX + IX
- DN = HQDN (V)
- VEXPDN = VCONST * EXP (DN)
- DLOGLI = DLOGLI + Q (L3H + L) * DN - VEXPDN
- DCHISQ = DCHISQ + (Q (L3H + L) - VEXPDN) ** 2 /
- + Q (L3V + L)
- 380 CONTINUE
- 390 CONTINUE
- 400 CONTINUE
- ELSE
- GO TO 430
- END IF
- IF (PPRINT) THEN
- IF (ITER .EQ. 0) WRITE (LOUT, 11300)
- WRITE (LOUT, 11400) ITER, DLOGLI, DCHISQ
- END IF
-
-* Check convergence.
- IF (DLOGLI - DLOGL0 .GT. DCHEK1) THEN
- DLOGL0 = DLOGLI
- IF (STEP .LT. 1.) STEP = 2. * STEP
- GO TO 160
- ELSE IF (DLOGLI - DLOGL0 .LT. -DCHEK2) THEN
-* Decreasing log liklelihood - back up...
- DO 410 J = 1, NSIG
- SIGA (J) = SIGA (J) - STEP * DSIGA (J)
- 410 CONTINUE
- IF (STEP .GE. STEPMI) THEN
-* ...and try smaller step, re-evaluating 2nd derivative matrix next time...
- STEP = 0.5 * STEP
- GO TO 320
- ELSE
- IF (DESPRT) THEN
- GO TO 450
- ELSE
-* ...or, indesperation, re-evaluate 2nd derivative now.
- DESPRT = .TRUE.
- GO TO 170
- END IF
- END IF
- END IF
-
-* Set output variables.
- 420 CONTINUE
- CHISQ = DCHISQ
- ALOGLI = DLOGLI
-
- GO TO 470
-
- 430 CONTINUE
- WRITE (CHQMES, '(I3, '' dimensions not programmed yet.'')') NDIM
- IHQERR = 20
- GO TO 460
- 440 CONTINUE
- WRITE (CHQMES, '(''Error'', I5, '' in DEQINV'')') IHQERR
- GO TO 460
- 450 CONTINUE
- WRITE (CHQMES, '(''Likelihood decreasing in spite of rescue'',
- +'' operations!'')')
- IHQERR = 40
- GO TO 460
-
- 460 CONTINUE
- CALL HBUG (CHQMES, 'HQPOIS', IDMQ)
-
- 470 CONTINUE
-
-10000 FORMAT (1X, 'Multiquadric smoothing of histogram/ntuple', I7)
-10100 FORMAT (I6, ' parameters for', I7, ' bins.')
-10200 FORMAT (I6, ' parameters for', I7, ' bins (', I3, ' x', I3, ').')
-10300 FORMAT (I6, ' parameters for', I7, ' bins (', I3, ' x', I3, ' x',
- +I3, ').')
-10400 FORMAT (3X, 'This will take anything from', I10, ' to', I10,
- +' CERN-unit-secs.')
-10500 FORMAT (3X, 'We allow, initially,', I4, ' iterations.')
-10600 FORMAT (1X, 'First a least squares fit to a sum of multiquadrics'/
- +3X, '(to get function values for next step).')
-10700 FORMAT (3X, 'Chi-squared was:', G12.5)
-10800 FORMAT (
- +1X, 'Next a least squares fit of log of contents to a sum of '/
- +3X, 'multiquadrics (with help of function values derived above).')
-10900 FORMAT (3X, 'Chi-squared was:', G12.5)
-11000 FORMAT (
- +1X, 'Now an unconstrained Poisson likelihood fit of binned'/
- +3X, 'data to exponential of sum of multiquadrics.')
-11100 FORMAT (3X, '(Storing function values to speed subsequent ',
- +'calculation.)')
-11200 FORMAT (1X, 'Not converged - result accepted nevertheless.')
-11300 FORMAT (1X,
- +'HQPOIS: Iteration log likelihood chi-squared')
-11400 FORMAT (I16, 2X, 2G20.13)
-
- END
diff --git a/src/packlib/hbook/hquad/hqputf.F b/src/packlib/hbook/hquad/hqputf.F
deleted file mode 100644
index 4c27914..0000000
--- a/src/packlib/hbook/hquad/hqputf.F
+++ /dev/null
@@ -1,108 +0,0 @@
-*
-* $Id: hqputf.F,v 1.1.1.1 1996/01/16 17:08:05 mclareni Exp $
-*
-* $Log: hqputf.F,v $
-* Revision 1.1.1.1 1996/01/16 17:08:05 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.17/01 22/11/92 12.13.37 by John Allison
-*-- Author : John Allison 12/09/92
- SUBROUTINE HQPUTF (LFIT)
- INTEGER LFIT
-* Take multiquadric parameters from /HCQCOM/ and place in bank 'HFIT'.
-* See HSUPIS for banks definitions.
-
-#include "hbook/hcbook.inc"
-#include "hbook/hcqcom.inc"
-#include "hbook/hcqcor.inc"
-
- CHARACTER*4 NAME
- INTEGER I, II, JJ, L, NBLOCK, NBLOJJ
- INTEGER LFCOV, LCOV
- INTEGER NWW
-#if defined(CERNLIB_DOUBLE)
- PARAMETER (NWW = 2)
- DOUBLE PRECISION SS
-#endif
-#if !defined(CERNLIB_DOUBLE)
- PARAMETER (NWW = 1)
- REAL SS
-#endif
-
- IF (LFIT .LE. 0) RETURN
- LFCOV = 0
- L = LQ (LFIT)
- 10 CONTINUE
- IF (L. NE. 0)THEN
- CALL UHTOC (IQ (L - 4), 4, NAME, 4)
- IF (NAME .EQ. 'HFCO')THEN
- LFCOV = L
- ELSE
- GO TO 10
- END IF
- END IF
-
- Q (LFIT + 7) = HQFMIN
- Q (LFIT + 8) = HQFMAX
-
- NBLOCK = NWW * NSIG
-
-* LFIT bank: NSIG fitted parameters,
-* 5 special parameters,
-* (NDIM + 1) * NSIG fixed parameters,
- II = 11
- CALL UCOPY (SIGA, Q (LFIT + II), NBLOCK)
- II = II + NBLOCK
- SS = IMQFUN
- CALL UCOPY (SS, Q (LFIT + II), NWW)
- II = II + NWW
- SS = VCONST
- CALL UCOPY (SS, Q (LFIT + II), NWW)
- II = II + 4 *NWW
- DO 20 I = 1, NSIG
- SS = SIGV (I, 1)
- CALL UCOPY (SS, Q (LFIT + II), NWW)
- II = II + NWW
- 20 CONTINUE
- IF (NDIM .GE. 2) THEN
- DO 30 I = 1, NSIG
- SS = SIGV (I, 2)
- CALL UCOPY (SS, Q (LFIT + II), NWW)
- II = II + NWW
- 30 CONTINUE
- END IF
- IF (NDIM .GE. 3) THEN
- DO 40 I = 1, NSIG
- SS = SIGV (I, 3)
- CALL UCOPY (SS, Q (LFIT + II), NWW)
- II = II + NWW
- 40 CONTINUE
- END IF
- IF (NDIM .GE. 4) THEN
- CALL HBUG ('Not programmed for >=4 dimensions.', 'HQPUTF',
- + IDMQ)
- END IF
- DO 50 I = 1, NSIG
- SS = SIGDEL (I)
- CALL UCOPY (SS, Q (LFIT + II), NWW)
- II = II + NWW
- 50 CONTINUE
-
-* Lower triangle of covariance bank (if it exists).
-* (Allow for fact that LHQCOV data has been made to start on 8-byte boundary.)
- IF (LFCOV .GT. 0) THEN
- LCOV = LHQCOV + MOD (LHQCOV, NWW)
- II = 1
- JJ = 1
- NBLOJJ = NWW * NSIG
- DO 60 I = 1, NSIG
- NBLOCK = NWW * I
- CALL UCOPY (Q (LCOV + JJ), Q (LFCOV + II), NBLOCK)
- II = II + NBLOCK
- JJ = JJ + NBLOJJ
- 60 CONTINUE
- END IF
-
- END
diff --git a/src/packlib/hbook/hquad/hqsig.F b/src/packlib/hbook/hquad/hqsig.F
deleted file mode 100644
index 727a4b4..0000000
--- a/src/packlib/hbook/hquad/hqsig.F
+++ /dev/null
@@ -1,79 +0,0 @@
-*
-* $Id: hqsig.F,v 1.1.1.1 1996/01/16 17:08:05 mclareni Exp $
-*
-* $Log: hqsig.F,v $
-* Revision 1.1.1.1 1996/01/16 17:08:05 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.17/03 13/01/93 15.32.49 by John Allison
-*-- Author :
- SUBROUTINE HQSIG (IEDGE, IHQERR)
- INTEGER IEDGE, IHQERR
-* Finds significant points which will become centres of the radial basis
-* functions.
-
-#include "hbook/hcqcom.inc"
-#include "hbook/hcunit.inc"
-
- CHARACTER*80 CHQMES
-
- IHQERR = 0
-
- IF (NDIM .EQ. 1) THEN
- NDIMC = 1
- NDIMWH (1) = 1
- CALL HQSIG1 (NX, 1. / NX, IEDGE, IHQERR)
- IF (IHQERR .NE. 0) GO TO 50
- ELSE IF (NDIM .EQ. 2) THEN
- NDIMC = 2
- NDIMWH (1) = 1
- NDIMWH (2) = 2
- CALL HQSIG2 (NX, NY, 1. / (NX * NY), IEDGE, IHQERR)
- IF (IHQERR .NE. 0) GO TO 50
- ELSE IF (NDIM .EQ. 3) THEN
- NDIMC = 3
- NDIMWH (1) = 1
- NDIMWH (2) = 2
- NDIMWH (3) = 3
- CALL HQSIG3 (NX, NY, NZ, 1. / (NX * NY * NZ),
- + IEDGE, IHQERR)
- IF (IHQERR .NE. 0) GO TO 50
- ELSE
- GO TO 10
- END IF
-
- IF (NSIG .LT. NSMIN) GO TO 20
- IF (NSIG .GT. NBTOT) GO TO 30
-
- GO TO 50
-
- 10 CONTINUE
- WRITE (CHQMES, '(I3, '' dimensions not programmed yet.'')') NDIM
- IHQERR = 10
- GO TO 40
- 20 CONTINUE
- WRITE (CHQMES, '(''Only'', I5,
- +'' significant points found - minimum'', I3)') NSIG, NSMIN
- CALL HBUG (CHQMES, 'HQSIG', IDMQ)
- WRITE (LOUT,10000)
- IHQERR = 20
- GO TO 50
- 30 CONTINUE
- WRITE (CHQMES, '(I5, '' significant '
- +//'points found - near to no. of bins ('', I5, '').'')')
- +NSIG, NBTOT
- IHQERR = 30
- GO TO 40
-
- 40 CONTINUE
- CALL HBUG (CHQMES, 'HQSIG', IDMQ)
-
- 50 CONTINUE
-
-10000 FORMAT (
- +3X, 'Data of insufficient statistical significance and/or'/
- +3X, 'errors overestimated and/or SENSIT parameter too small?')
-
- END
diff --git a/src/packlib/hbook/hquad/hqsig1.F b/src/packlib/hbook/hquad/hqsig1.F
deleted file mode 100644
index 16b8223..0000000
--- a/src/packlib/hbook/hquad/hqsig1.F
+++ /dev/null
@@ -1,216 +0,0 @@
-*
-* $Id: hqsig1.F,v 1.1.1.1 1996/01/16 17:08:05 mclareni Exp $
-*
-* $Log: hqsig1.F,v $
-* Revision 1.1.1.1 1996/01/16 17:08:05 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.17/12 13/05/93 19.32.11 by John Allison
-*-- Author : John Allison 12/09/92
- SUBROUTINE HQSIG1 (NX0, VOLB0, IEDGE, IHQERR)
- INTEGER NX0, IEDGE, IHQERR
- REAL VOLB0
-* Finds significant points which will become centres of the radial basis
-* functions for 1-D histogram.
-*
-* Histogram contents and variances are in Q (L1H +1,...) and Q (L1V + 1,...).
-***** Note: this routine overwrites histogram contents and variances.
-*
-* NX0 = number of bins.
-* VOLB0 = volume of bins (normalised coordinate space).
-* IEDGE = 0, normal.
-* = 2, zero extremities (i.e., constrained fit recommended).
-* = <0, special case - no significant points found this pass.
-* IHQERR = 0 if all's OK.
-*
-* We want significant points where the rate of change of slope,
-* or in N-dimensions, the N-dimensional Laplacian, is statistically
-* significant.
-*
-* The coordinates of significant points - stored in HCQCOM - are in a
-* "normalised" system in which the plot variables are mapped to the
-* range 0 -> 1.
-*
-* Note: NDIMC, the "current" no. of dimensions, must always be 1 when entering
-* this routine.
-
-#include "hbook/hcqcom.inc"
-#include "hbook/hcbook.inc"
-
-* Miscellaneous local variables.
- LOGICAL ANY, THIS, EDGED
- INTEGER NBTOT1, NX1, NSLRMS
- INTEGER IX
- INTEGER L, L1M, L1P, LJ
- REAL DXN1, VOLB1
- REAL AL, SL, V, V1M, V1P, VL, DELTA
- REAL DEDGE
-
-* Check NDIMC
- IF (NDIMC .NE. 1) GO TO 40
-
-* Clear parameters.
- IEDGE = 0
- IHQERR = 0
-
-* Set edge parameter - edge points this many bins from edge.
- IF (NDIMC .LT. NDIM) THEN
- DEDGE = 0.5
- ELSE
- DEDGE = 0.
- END IF
-
-* DXN1 and NBTOT1 are current values of bin size and total no. of bins.
- NX1 = NX0
- DXN1 = 1. / NX1
- NBTOT1 = NX1
- VOLB1 = VOLB0
-
-* Search histogram to find significant points. Look for
-* statistically significant values of Laplacian, AL. When
-* all have been found at this resolution, rebin and look again.
-* The first time any have been found, add edge points.
- ANY = .FALSE.
- EDGED = .FALSE.
-* (Loop back here after rebinning.)
- 10 CONTINUE
-
-* Determine cut so that probability of purely statistical fluctuation is
-* small. The probability of an x standard deviation fluctuation is
-* approximately exp(-(x/1.2)**2) (a crude fit to data in PDB). So to
-* make the probability of a stat. fluctn. less than 1 / (no. of bins)
-* (say) (SENSIT is a user factor that adjusts the sensitivity of the cut
-* - normally SENSIT = 1.).
-* (Experience shows the above is too strict - relax by extra factor of 0.7.)
- SLCUT = 0.7 * 1.2 * SQRT (ALOG (FLOAT (NBTOT1))) / SENSIT
-
-* Record whether any significant points have been found THIS loop.
- THIS = .FALSE.
-
-* Scale parameter is bin size in normalised coords.
- DELTA = DXN1
- NSLRMS = 0
- SLRMS = 0.
- DO 20 IX = 2, NX1 - 1
-* Bin centre on scale 0 -> 1, i.e., normalised coords.
- XBIN = (IX - 0.5) * DXN1
-* Pointers...
- L = IX
- L1M = L - 1
- L1P = L + 1
-* Scale parameter is half bin size in normalised coords. (approx.)
- DELTA = DXN1
-* Calculate statistical significance of Laplacian, i.e.,
-* finite difference Laplacian / error.
- AL = Q (L1H + L1M) + Q (L1H + L1P) - 2. * Q (L1H + L)
- V = Q (L1V + L)
- V1M = Q (L1V + L1M)
- V1P = Q (L1V + L1P)
- IF (V .EQ. 0.) V = VMEAN2
- IF (V1M .EQ. 0.) V1M = VMEAN2
- IF (V1P .EQ. 0.) V1P = VMEAN2
- VL = V1M + V1P + 4. * V
- SL = ABS (AL / SQRT (VL))
- IF (SL .GT. 1.E-6) THEN
- SLRMS = SLRMS + SL ** 2
- NSLRMS = NSLRMS + 1
- END IF
-* It is significant?
- IF (SL .GE. SLCUT) THEN
-* Add significant point.
- CALL HQSIGA (BINV, Q (L1H + L), VOLB1, DELTA, SL, IHQERR)
- IF (IHQERR .EQ. 0) THEN
- ANY = .TRUE.
- THIS = .TRUE.
- ELSE IF (IHQERR .LT. 0) THEN
- IHQERR = 0
- ELSE
- GO TO 50
- END IF
- END IF
- 20 CONTINUE
- SLRMS = SQRT (SLRMS / NSLRMS)
-
-* If this is the first time any significant points have been found...
- IF ((ANY .AND. .NOT. EDGED) .OR. (NDIMC .NE. NDIM)) THEN
- EDGED = .TRUE.
-* Record bin size.
- IF (NDIM .EQ. NDIMC) THEN
- NXN = NX1
- END IF
-******************************************************************
-* Note: the following has been modified to force the adding of corner points.
-******************************************************************
-* Are the extremities zero?
- IF (Q (L1H + 1) .EQ. 0. .AND. Q (L1H + NX1) .EQ. 0.) THEN
-* If so, mark for zero asyptotic constrained fit.
- IEDGE = 2
- END IF
-*************** IF (IEDGE .NE. 2) THEN
-* Add small-DELTA significant points at ends. ("Small", rather
-* than zero, to avoid 2 sig. points at same location.)
- XBIN = DEDGE * DXN1
- CALL HQSIGA (BINV, Q (L1H + 1), VOLB1, SMALLD, SLCUT, IHQERR)
- IF (IHQERR .EQ. 0) THEN
- ANY = .TRUE.
- THIS = .TRUE.
- ELSE IF (IHQERR .LT. 0) THEN
- IHQERR = 0
- ELSE
- GO TO 50
- END IF
- XBIN = 1.0 - DEDGE * DXN1
- CALL HQSIGA (BINV, Q (L1H + NX1), VOLB1, SMALLD, SLCUT,
- + IHQERR)
- IF (IHQERR .EQ. 0) THEN
- ANY = .TRUE.
- THIS = .TRUE.
- ELSE IF (IHQERR .LT. 0) THEN
- IHQERR = 0
- ELSE
- GO TO 50
- END IF
-*************** END IF
- END IF
-
-* If no points have been found, or points have been found this time round (i.e.,
-* cease searching if points have been found but not this time round).
-**** (Not sure about the wisdom of this (why did I introduce it?) so disable for
-**** now.)
-* IF (.NOT. ANY .OR. THIS) THEN
-* Rebin - double up.
-***** NOTE: bin doubling leaves the odd bin over. Not knowing what to do with
-***** it I simply leave it - possibly a significant point might be missed but
-***** the above code gave it at least one chance. When it comes to choosing
-***** bins for finding significant points for N-tuples, choose 2**N bins.
- IF (NX1 .GE. 20) THEN
- NX1 = NX1 / 2
- DXN1 = 2. * DXN1
- VOLB1 = 2. * VOLB1
- NBTOT1 = NX1
- DO 30 IX = 1, NX1
- L = 2 * (IX - 1) + 1
- L1P = L + 1
- LJ = IX
- Q (L1H + LJ) = Q (L1H + L) + Q (L1H + L1P)
- Q (L1V + LJ) = Q (L1V + L) + Q (L1V + L1P)
- 30 CONTINUE
- GO TO 10
- END IF
-* END IF
-
-* If no points have been found this pass, use IEDGE as a flag.
- IF (.NOT. ANY) IEDGE = -1
-
- GO TO 50
-
-* Errors.
- 40 CONTINUE
- CALL HBUG ('NDIMC not 1.', 'HQSIG1', IDMQ)
- IHQERR = 10
-
- 50 CONTINUE
-
- END
diff --git a/src/packlib/hbook/hquad/hqsig2.F b/src/packlib/hbook/hquad/hqsig2.F
deleted file mode 100644
index ec46bd8..0000000
--- a/src/packlib/hbook/hquad/hqsig2.F
+++ /dev/null
@@ -1,434 +0,0 @@
-*
-* $Id: hqsig2.F,v 1.1.1.1 1996/01/16 17:08:05 mclareni Exp $
-*
-* $Log: hqsig2.F,v $
-* Revision 1.1.1.1 1996/01/16 17:08:05 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.17/13 14/05/93 09.08.25 by John Allison
-*-- Author :
- SUBROUTINE HQSIG2 (NX0, NY0, VOLB0, IEDGE, IHQERR)
- INTEGER NX0, NY0, IEDGE, IHQERR
- REAL VOLB0
-* Finds significant points which will become centres of the radial basis
-* functions for 2-D histograms.
-*
-* Histogram contents and variances are in Q (L2H +1,...) and Q (L2V + 1,...).
-***** Note: this routine overwrites histogram contents and variances.
-*
-* NX0 = number of x bins.
-* NY0 = number of y bins.
-* VOLB0 = volume of bins (normalised coordinate space).
-* IEDGE = 0, normal.
-* = 2, zero extremities (i.e., constrained fit recommended).
-* = <0, special case - no significant points found this pass.
-* IHQERR = 0 if all's OK.
-*
-* We want significant points where the rate of change of slope,
-* or in N-dimensions, the N-dimensional Laplacian, is statistically
-* significant.
-*
-* The coordinates of significant points - stored in HCQCOM - are in a
-* "normalised" system in which the plot variables are mapped to the
-* range 0 -> 1.
-*
-* This routine must be called with NDIMC (the current no. of dimensions) = 2.
-
-#include "hbook/hcqcom.inc"
-#include "hbook/hcbook.inc"
-
-* Miscellaneous local variables.
- LOGICAL ANY, THIS, EDGED
- INTEGER NX00, NBTOT1, NBINS1 (NDMAX), NX1, NY1, NSLRMS
- EQUIVALENCE (NX1, NBINS1 (1)), (NY1, NBINS1 (2))
- INTEGER L, IDIM, NFACTR
- INTEGER L1M, L1P, L2M, L2P, L2PP, IX, IY, LJ
- INTEGER NDIMW2 (NDMAX)
- INTEGER IXE, IYE, IEDX (2), IEDY (2)
- REAL DXN1, DYN1, VOLB1, FACTOR
- REAL AL, SL, V, V1M, V1P, V2M, V2P, VL, DELTA
- REAL AS, VS, SS
- REAL DEDGE, EDGEN (2)
-
- DATA EDGEN /0., 1./
-
-* Check NDIMC
- IF (NDIMC .NE. 2) GO TO 230
-
-* Clear parameters.
- IEDGE = 0
- IHQERR = 0
-
-* Set edge parameter - edge points this many bins from edge.
- IF (NDIMC .LT. NDIM) THEN
- DEDGE = 0.5
- ELSE
- DEDGE = 0.
- END IF
-
-* DXN1, etc. and NBTOT1 are current values of bin sizes and total no. of bins.
- NX1 = NX0
- NY1 = NY0
- DXN1 = 1. / NX1
- DYN1 = 1. / NY1
- NBTOT1 = NX1 * NY1
- VOLB1 = VOLB0
-
-* Search histogram to find significant points. Look for
-* statistically significant values of Laplacian, AL. When
-* all have been found at this resolution, rebin and look again.
-* The first time any have been found, add edge points.
- ANY = .FALSE.
- EDGED = .FALSE.
-* (Loop back here after rebinning.)
- 10 CONTINUE
-
-* Determine cut so that probability of purely statistical fluctuation is
-* small. The probability of an x standard deviation fluctuation is
-* approximately exp(-(x/1.2)**2) (a crude fit to data in PDB). So to
-* make the probability of a stat. fluctn. less than 1 / (no. of bins)
-* (say) (SENSIT is a user factor that adjusts the sensitivity of the cut
-* - normally SENSIT = 1.).
-* Relax by factor 0.7 for 2-D.
- SLCUT = 0.7 * 1.2 * SQRT (ALOG (FLOAT (NBTOT1))) / SENSIT
-
-* Record whether any significant points have been found THIS loop.
- THIS = .FALSE.
-
-* A convention here is that the pointers for the 4 points surrounding the point
-* of interest (whose pointer is L) are:
-* L1M, L1P for 1st dimension Minus and Plus one bin.
-* L2M, L2P for 2nd dimension Minus and Plus one bin.
- DELTA = MIN (DXN1, DYN1)
- SLRMS = 0.
- NSLRMS = 0
- DO 30 IY = 2, NY1 - 1
- YBIN = (IY - 0.5) * DYN1
- DO 20 IX = 2, NX1 - 1
- XBIN = (IX - 0.5) * DXN1
- L = (IY - 1) * NX1 + IX
- L1M = L - 1
- L1P = L + 1
- L2M = L - NX1
- L2P = L + NX1
- AL = Q (L2H + L1M) + Q (L2H + L1P) +
- + Q (L2H + L2M) + Q (L2H + L2P) - 4. * Q (L2H + L)
- V = Q (L2V + L)
- V1M = Q (L2V + L1M)
- V1P = Q (L2V + L1P)
- V2M = Q (L2V + L2M)
- V2P = Q (L2V + L2P)
- IF (V .EQ. 0.) V = VMEAN2
- IF (V1M .EQ. 0.) V1M = VMEAN2
- IF (V1P .EQ. 0.) V1P = VMEAN2
- IF (V2M .EQ. 0.) V2M = VMEAN2
- IF (V2P .EQ. 0.) V2P = VMEAN2
- VL = V1M + V1P + V2M + V2P + 16. * V
- SL = ABS (AL / SQRT (VL))
- IF (SL .GT. 1.E-6) THEN
- SLRMS = SLRMS + SL ** 2
- NSLRMS = NSLRMS + 1
- END IF
- IF (SL .GE. SLCUT) THEN
- CALL HQSIGA (BINV, Q (L2H + L), VOLB1, DELTA, SL, IHQERR)
- IF (IHQERR .EQ. 0) THEN
- ANY = .TRUE.
- THIS = .TRUE.
- ELSE IF (IHQERR .LT. 0) THEN
- IHQERR = 0
- ELSE
- GO TO 240
- END IF
- END IF
- 20 CONTINUE
- 30 CONTINUE
- SLRMS = SQRT (SLRMS / NSLRMS)
-
-* If this is the first time any significant points have been found...
- IF ((ANY .AND. .NOT. EDGED) .OR. (NDIMC .NE. NDIM)) THEN
- EDGED = .TRUE.
-* Record bin size.
- IF (NDIM .EQ. NDIMC) THEN
- NXN = NX1
- NYN = NY1
- END IF
-*************************************************************
-* New strategy - add points if slope is significant.
-* Low x...
- IX = 1
- XBIN = 0.
- DO 40 IY = 1, NY1
- YBIN = (IY - 0.5) * DYN1
- L = (IY - 1) * NX1 + IX
- L1P = L + 1
- AS = Q (L2H + L1P) - Q (L2H + L)
- V = Q (L2V + L)
- V1P = Q (L2V + L1P)
- IF (V .EQ. 0.) V = VMEAN2
- IF (V1P .EQ. 0.) V1P = VMEAN2
- VS = V1P + V
- SS = ABS (AS / SQRT (VS))
- IF (SS .GE. SLCUT) THEN
- CALL HQSIGA (BINV, Q (L2H + L), VOLB1, DELTA,
- + SS, IHQERR)
- IF (IHQERR .EQ. 0) THEN
- ANY = .TRUE.
- THIS = .TRUE.
- ELSE IF (IHQERR .LT. 0) THEN
- IHQERR = 0
- ELSE
- GO TO 240
- END IF
- END IF
- 40 CONTINUE
-* High x...
- IX = NX1
- XBIN = 1.
- DO 50 IY = 1, NY1
- YBIN = (IY - 0.5) * DYN1
- L = (IY - 1) * NX1 + IX
- L1M = L - 1
- AS = Q (L2H + L1M) - Q (L2H + L)
- V = Q (L2V + L)
- V1M = Q (L2V + L1M)
- IF (V .EQ. 0.) V = VMEAN2
- IF (V1M .EQ. 0.) V1M = VMEAN2
- VS = V1M + V
- SS = ABS (AS / SQRT (VS))
- IF (SS .GE. SLCUT) THEN
- CALL HQSIGA (BINV, Q (L2H + L), VOLB1, DELTA,
- + SS, IHQERR)
- IF (IHQERR .EQ. 0) THEN
- ANY = .TRUE.
- THIS = .TRUE.
- ELSE IF (IHQERR .LT. 0) THEN
- IHQERR = 0
- ELSE
- GO TO 240
- END IF
- END IF
- 50 CONTINUE
-* Low y...
- IY = 1
- YBIN = 0.
- DO 60 IX = 1, NX1
- XBIN = (IX - 0.5) * DXN1
- L = (IY - 1) * NX1 + IX
- L2P = L + NX1
- AS = Q (L2H + L2P) - Q (L2H + L)
- V = Q (L2V + L)
- V2P = Q (L2V + L2P)
- IF (V .EQ. 0.) V = VMEAN2
- IF (V2P .EQ. 0.) V2P = VMEAN2
- VS = V2P + V
- SS = ABS (AS / SQRT (VS))
- IF (SS .GE. SLCUT) THEN
- CALL HQSIGA (BINV, Q (L2H + L), VOLB1, DELTA,
- + SS, IHQERR)
- IF (IHQERR .EQ. 0) THEN
- ANY = .TRUE.
- THIS = .TRUE.
- ELSE IF (IHQERR .LT. 0) THEN
- IHQERR = 0
- ELSE
- GO TO 240
- END IF
- END IF
- 60 CONTINUE
-* High y...
- IY = NY1
- YBIN = 1.
- DO 70 IX = 1, NX1
- XBIN = (IX - 0.5) * DXN1
- L = (IY - 1) * NX1 + IX
- L2M = L - NX1
- AS = Q (L2H + L2M) - Q (L2H + L)
- V = Q (L2V + L)
- V2M = Q (L2V + L2M)
- IF (V .EQ. 0.) V = VMEAN2
- IF (V2M .EQ. 0.) V2M = VMEAN2
- VS = V2M + V
- SS = ABS (AS / SQRT (VS))
- IF (SS .GE. SLCUT) THEN
- CALL HQSIGA (BINV, Q (L2H + L), VOLB1, DELTA,
- + SS, IHQERR)
- IF (IHQERR .EQ. 0) THEN
- ANY = .TRUE.
- THIS = .TRUE.
- ELSE IF (IHQERR .LT. 0) THEN
- IHQERR = 0
- ELSE
- GO TO 240
- END IF
- END IF
- 70 CONTINUE
-* End of new strategy.
-*************************************************************************
-******************************************************************
-* Note: the following has been modified by commenting out some statements
-* to suppress calls to other HQSIGn routines. This also has the effect
-* of to forcing the adding of corner points.
-******************************************************************
-* Now we are going to present HQSIG1 with the faces of this 2-D histogram.
-* HQSIG1 will think it's a 1-D histogram. When it comes to adding a point,
-* however, HQSIGA must know:
-* (a) the original dimensionality, NDIM,
-* (b) the current dimensionality, NDIMC,
-* (c) the coordinate(s) being treated, (NDIMWH (I), I = 1, NDIMC) and
-* (d) the value of the remaining coordinates,
-* (BINV (I), I = NDIMC + 1, NDIM), if any, destined for
-* (SIGV (NSIG, (NDIMWH(I))), I = NDIMC + 1, NDIM).
-* Preserve current values of NDIMWH (NDIMC is assumed to be 2 at this point).
- DO 80 IDIM = 1, NDIMC
- NDIMW2 (IDIM) = NDIMWH (IDIM)
- 80 CONTINUE
-* Find sig. points along the 4 edges...
- NDIMC = 1
-* x edges...
- DO 100 IX = 1, NX1, NX1 - 1
- IXE = IX / NX1 + 1
- DO 90 IY = 1, NY1
- L = (IY - 1) * NX1 + IX
- Q (L1H + IY) = Q (L2H + L)
- Q (L1V + IY) = Q (L2V + L)
- 90 CONTINUE
- NDIMWH (1) = NDIMW2 (2)
- NDIMWH (2) = NDIMW2 (1)
- BINV (2) = EDGEN (IXE) -
- + (2. * EDGEN (IXE) - 1.) * DEDGE * DXN1
- IEDX (IXE) = 0
-************** CALL HQSIG1 (NY1, VOLB1, IEDX (IXE), IHQERR)
- IF (IHQERR .NE. 0) GO TO 240
- 100 CONTINUE
-* y edges...
- DO 120 IY = 1, NY1, NY1 - 1
- IYE = IY / NY1 + 1
- DO 110 IX = 1, NX1
- L = (IY - 1) * NX1 + IX
- Q (L1H + IX) = Q (L2H + L)
- Q (L1V + IX) = Q (L2V + L)
- 110 CONTINUE
- NDIMWH (1) = NDIMW2 (1)
- NDIMWH (2) = NDIMW2 (2)
- BINV (2) = EDGEN (IYE) -
- + (2. * EDGEN (IYE) - 1.) * DEDGE * DYN1
- IEDY (IYE) = 0
-*************** CALL HQSIG1 (NX1, VOLB1, IEDY (IYE), IHQERR)
- IF (IHQERR .NE. 0) GO TO 240
- 120 CONTINUE
-* Restore current values of NDIMWH.
- NDIMC = 2
- DO 130 IDIM = 1, NDIMC
- NDIMWH (IDIM) = NDIMW2 (IDIM)
- 130 CONTINUE
-* Add corner points if adjacent edges have points.
- DO 150 IX = 1, NX1, NX1 - 1
- IXE = IX / NX1 + 1
- DO 140 IY = 1, NY1, NY1 - 1
- IYE = IY / NY1 + 1
- IF (IEDX (IXE) .GE. 0 .AND. IEDY (IYE) .GE. 0) THEN
- XBIN = EDGEN (IXE) -
- + (2. * EDGEN (IXE) - 1.) * DEDGE * DXN1
- YBIN = EDGEN (IYE) -
- + (2. * EDGEN (IYE) - 1.) * DEDGE * DYN1
- L = (IY - 1) * NX1 + IX
- CALL HQSIGA (BINV, Q (L2H + L), VOLB1, SMALLD,
- + SLCUT, IHQERR)
- IF (IHQERR .EQ. 0) THEN
- ANY = .TRUE.
- THIS = .TRUE.
- ELSE IF (IHQERR .LT. 0) THEN
- IHQERR = 0
- ELSE
- GO TO 240
- END IF
- END IF
- 140 CONTINUE
- 150 CONTINUE
-* Are the extremities zero?
- DO 170 IX = 1, NX1, NX1 - 1
- DO 160 IY = 1, NY1, NY1 - 1
- L = (IY - 1) * NX1 + IX
- IF (Q (L2H + L) .NE. 0) GO TO 200
- 160 CONTINUE
- 170 CONTINUE
- DO 180 IXE = 1, 2
- IF (IEDX (IXE) .GE. 0) GO TO 200
- 180 CONTINUE
- DO 190 IYE = 1, 2
- IF (IEDY (IYE) .GE. 0) GO TO 200
- 190 CONTINUE
-* If so, mark for zero asyptotic constrained fit.
- IEDGE = 2
- 200 CONTINUE
- END IF
-
-* If no points have been found, or points have been found this time round (i.e.,
-* cease searching if points have been found but not this time round).
-**** (Not sure about the wisdom of this (why did I introduce it?) so disable for
-**** now.)
-* IF (.NOT. ANY .OR. THIS) THEN
- IF (NTUPLE) THEN
-* Rebin - the data is from an ntuple. This simplifies things immensely.
-* Double significance by increasing bin size by cube root of 2.
- FACTOR = 1.5
- NFACTR = 10. * FACTOR
- IF (NX1 .GE. NFACTR .AND. NY1 .GE. NFACTR) THEN
- NX1 = NX1 / FACTOR
- NY1 = NY1 / FACTOR
- NBTOT1 = NX1 * NY1
- DXN1 = 1. / NX1
- DYN1 = 1. / NY1
- VOLB1 = DXN1 * DYN1
-* Get contents and errors.
- CALL HQBIN (NBINS1, 0, IHQERR)
- IF (IHQERR. NE. 0) GO TO 240
- GO TO 10
- END IF
- ELSE
-* Rebin - double up.
-***** NOTE: bin doubling leaves the odd bin over. Not knowing what to do with
-***** it I simply leave it - possibly a significant point might be missed but
-***** the above code gave it at least one chance. When it comes to choosing
-***** bins for finding significant points for N-tuples, choose 2**N bins.
- IF (NX1 .GE. 20 .AND. NY1 .GE. 20) THEN
- NX00 = NX1
- NX1 = NX1 / 2
- NY1 = NY1 / 2
- DXN1 = 2. * DXN1
- DYN1 = 2. * DYN1
- VOLB1 = 4. * VOLB1
- NBTOT1 = NX1 * NY1
- DO 220 IY = 1, NY1
- DO 210 IX = 1, NX1
- L = 2 * (IY - 1) * NX00 + 2 * (IX - 1) + 1
- L1P = L + 1
- L2P = L + NX00
- L2PP = L + NX00 + 1
- LJ = (IY - 1) * NX1 + IX
- Q (L2H + LJ) = Q (L2H + L) + Q (L2H + L1P) + Q (L2H +
- + L2P) + Q (L2H + L2PP)
- Q (L2V + LJ) = Q (L2V + L) + Q (L2V + L1P) + Q (L2V +
- + L2P) + Q (L2V + L2PP)
- 210 CONTINUE
- 220 CONTINUE
- GO TO 10
- END IF
- END IF
-* END IF
-
-* If no points have been found this pass, use IEDGE as a flag.
- IF (.NOT. ANY) IEDGE = -1
-
- GO TO 240
-
-* Errors.
- 230 CONTINUE
- CALL HBUG ('NDIMC not 2.', 'HQSIG2', IDMQ)
- IHQERR = 10
-
- 240 CONTINUE
-
- END
diff --git a/src/packlib/hbook/hquad/hqsig3.F b/src/packlib/hbook/hquad/hqsig3.F
deleted file mode 100644
index 025dd86..0000000
--- a/src/packlib/hbook/hquad/hqsig3.F
+++ /dev/null
@@ -1,585 +0,0 @@
-*
-* $Id: hqsig3.F,v 1.1.1.1 1996/01/16 17:08:05 mclareni Exp $
-*
-* $Log: hqsig3.F,v $
-* Revision 1.1.1.1 1996/01/16 17:08:05 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.17/13 14/05/93 09.08.25 by John Allison
-*-- Author :
- SUBROUTINE HQSIG3 (NX0, NY0, NZ0, VOLB0, IEDGE, IHQERR)
- INTEGER NX0, NY0, NZ0, IEDGE, IHQERR
- REAL VOLB0
-* Finds significant points which will become centres of the radial basis
-* functions for 3-D histograms.
-*
-* Histogram contents and variances are in Q (L3H +1,...) and Q (L3V + 1,...).
-***** Note: this routine overwrites histogram contents and variances.
-*
-* NX0 = number of x bins.
-* NY0 = number of y bins.
-* NZ0 = number of z bins.
-* VOLB0 = volume of bins (normalised coordinate space).
-* IEDGE = 0, normal.
-* = 2, zero extremities (i.e., constrained fit recommended).
-* = <0, special case - no significant points found this pass.
-* IHQERR = 0 if all's OK.
-*
-* We want significant points where the rate of change of slope,
-* or in N-dimensions, the N-dimensional Laplacian, is statistically
-* significant.
-*
-* The coordinates of significant points - stored in HCQCOM - are in a
-* "normalised" system in which the plot variables are mapped to the
-* range 0 -> 1.
-*
-* This routine must be called with NDIMC (the current no. of dimensions) = 3.
-
-#include "hbook/hcqcom.inc"
-#include "hbook/hcbook.inc"
-
-* Miscellaneous local variables.
- LOGICAL ANY, THIS, EDGED
- INTEGER NFACTR
- INTEGER NBTOT1, NBINS1 (NDMAX), NX1, NY1, NZ1, NSLRMS
- EQUIVALENCE (NX1, NBINS1 (1)), (NY1, NBINS1 (2)),
- +(NZ1, NBINS1 (3))
- INTEGER IDIM, NX00, NY00
- INTEGER L, LF, LJ
- INTEGER L1M, L1P, L2M, L2P, l2PP,L3M, L3P, L3PP, L3PPP, L3PPPP
- INTEGER IX, IY, IZ
- INTEGER NDIMW2 (NDMAX)
- INTEGER IXE, IYE, IZE, IEDX (2), IEDY (2), IEDZ (2)
- REAL DXN1, DYN1, DZN1, VOLB1
- REAL AL, SL, V, V1M, V1P, V2M, V2P, V3M, V3P, VL, DELTA
- REAL AS, VS, SS
- REAL DEDGE, EDGEN (2)
- REAL FACTOR
-
- DATA EDGEN /0., 1./
-
-* Check NDIMC
- IF (NDIMC .NE. 3) GO TO 410
-
-* Clear parameters.
- IEDGE = 0
- IHQERR = 0
-
-* Set edge parameter - edge points this many bins from edge.
- IF (NDIMC .LT. NDIM) THEN
- DEDGE = 0.5
- ELSE
- DEDGE = 0.
- END IF
-
-* DXN1, etc. and NBTOT1 are current values of bin sizes and total no. of bins.
- NX1 = NX0
- NY1 = NY0
- NZ1 = NZ0
- DXN1 = 1. / NX1
- DYN1 = 1. / NY1
- DZN1 = 1. / NZ1
- NBTOT1 = NX1 * NY1 * NZ1
- VOLB1 = VOLB0
-
-* Search histogram to find significant points. Look for
-* statistically significant values of Laplacian, AL. When
-* all have been found at this resolution, rebin and look again.
-* The first time any have been found, add edge points.
- ANY = .FALSE.
- EDGED = .FALSE.
-* (Loop back here after rebinning.)
- 10 CONTINUE
-
-* Determine cut so that probability of purely statistical fluctuation is
-* small. The probability of an x standard deviation fluctuation is
-* approximately exp(-(x/1.2)**2) (a crude fit to data in PDB). So to
-* make the probability of a stat. fluctn. less than 1 / (no. of bins)
-* (say) (SENSIT is a user factor that adjusts the sensitivity of the cut
-* - normally SENSIT = 1.).
-* Relax by factor 0.5 for 3-D.
- SLCUT = 0.5 * 1.2 * SQRT (ALOG (FLOAT (NBTOT1))) / SENSIT
-
-* Record whether any significant points have been found THIS loop.
- THIS = .FALSE.
-
-* A convention here is that the pointers for the 6 points surrounding the point
-* of interest (whose pointer is L) are:
-* L1M, L1P for 1st dimension Minus and Plus one bin.
-* L2M, L2P for 2nd dimension Minus and Plus one bin.
-* L3M, L3P for 3rd dimension Minus and Plus one bin.
- DELTA = MIN (DXN1, DYN1, DZN1)
- SLRMS = 0.
- NSLRMS = 0
- DO 40 IX = 2, NX1 - 1
- XBIN = (IX - 0.5) * DXN1
- DO 30 IY = 2, NY1 - 1
- YBIN = (IY - 0.5) * DYN1
- DO 20 IZ = 2, NZ1 - 1
- ZBIN = (IZ - 0.5) * DZN1
- L = (IZ - 1) * NX1 * NY1 + (IY - 1) * NX1 + IX
- L1M = L - 1
- L1P = L + 1
- L2M = L - NX1
- L2P = L + NX1
- L3M = L - NX1 * NY1
- L3P = L + NX1 * NY1
- AL = Q (L3H + L1M) + Q (L3H + L1P) + Q (L3H + L2M) + Q
- + (L3H + L2P) + Q (L3H + L3M) + Q (L3H + L3P) - 6. * Q
- + (L3H + L)
- V = Q (L3V + L)
- V1M = Q (L3V + L1M)
- V1P = Q (L3V + L1P)
- V2M = Q (L3V + L2M)
- V2P = Q (L3V + L2P)
- V3M = Q (L3V + L3M)
- V3P = Q (L3V + L3P)
- IF (V .EQ. 0.) V = VMEAN2
- IF (V1M .EQ. 0.) V1M = VMEAN2
- IF (V1P .EQ. 0.) V1P = VMEAN2
- IF (V2M .EQ. 0.) V2M = VMEAN2
- IF (V2P .EQ. 0.) V2P = VMEAN2
- IF (V3M .EQ. 0.) V3M = VMEAN2
- IF (V3P .EQ. 0.) V3P = VMEAN2
- VL = V1M + V1P + V2M + V2P + V3M + V3P + 36. * V
- SL = ABS (AL / SQRT (VL))
- IF (SL .GT. 1.E-6) THEN
- SLRMS = SLRMS + SL ** 2
- NSLRMS = NSLRMS + 1
- END IF
- IF (SL .GE. SLCUT) THEN
- CALL HQSIGA (BINV, Q (L3H + L), VOLB1, DELTA, SL,
- + IHQERR)
- IF (IHQERR .EQ. 0) THEN
- ANY = .TRUE.
- THIS = .TRUE.
- ELSE IF (IHQERR .LT. 0) THEN
- IHQERR = 0
- ELSE
- GO TO 420
- END IF
- END IF
- 20 CONTINUE
- 30 CONTINUE
- 40 CONTINUE
- SLRMS = SQRT (SLRMS / NSLRMS)
-
-* If this is the first time any significant points have been found...
- IF ((ANY .AND. .NOT. EDGED) .OR. (NDIMC .NE. NDIM)) THEN
- EDGED = .TRUE.
-* Record bin size.
- IF (NDIM .EQ. NDIMC) THEN
- NXN = NX1
- NYN = NY1
- NZN = NZ1
- END IF
-*************************************************************
-* New strategy - add points if slope is significant.
-* Low x...
- IX = 1
- XBIN = 0.
- DO 60 IY = 1, NY1
- YBIN = (IY - 0.5) * DYN1
- DO 50 IZ = 1, NZ1
- ZBIN = (IZ - 0.5) * DZN1
- L = (IZ - 1) * NX1 * NY1 + (IY - 1) * NX1 + IX
- L1P = L + 1
- AS = Q (L3H + L1P) - Q (L3H + L)
- V = Q (L3V + L)
- V1P = Q (L3V + L1P)
- IF (V .EQ. 0.) V = VMEAN2
- IF (V1P .EQ. 0.) V1P = VMEAN2
- VS = V1P + V
- SS = ABS (AS / SQRT (VS))
- IF (SS .GE. SLCUT) THEN
- CALL HQSIGA (BINV, Q (L3H + L), VOLB1, DELTA,
- + SS, IHQERR)
- IF (IHQERR .EQ. 0) THEN
- ANY = .TRUE.
- THIS = .TRUE.
- ELSE IF (IHQERR .LT. 0) THEN
- IHQERR = 0
- ELSE
- GO TO 420
- END IF
- END IF
- 50 CONTINUE
- 60 CONTINUE
-* High x...
- IX = NX1
- XBIN = 1.
- DO 80 IY = 1, NY1
- YBIN = (IY - 0.5) * DYN1
- DO 70 IZ = 1, NZ1
- ZBIN = (IZ - 0.5) * DZN1
- L = (IZ - 1) * NX1 * NY1 + (IY - 1) * NX1 + IX
- L1M = L - 1
- AS = Q (L3H + L1M) - Q (L3H + L)
- V = Q (L3V + L)
- V1M = Q (L3V + L1M)
- IF (V .EQ. 0.) V = VMEAN2
- IF (V1M .EQ. 0.) V1M = VMEAN2
- VS = V1M + V
- SS = ABS (AS / SQRT (VS))
- IF (SS .GE. SLCUT) THEN
- CALL HQSIGA (BINV, Q (L3H + L), VOLB1, DELTA,
- + SS, IHQERR)
- IF (IHQERR .EQ. 0) THEN
- ANY = .TRUE.
- THIS = .TRUE.
- ELSE IF (IHQERR .LT. 0) THEN
- IHQERR = 0
- ELSE
- GO TO 420
- END IF
- END IF
- 70 CONTINUE
- 80 CONTINUE
-* Low y...
- IY = 1
- YBIN = 0.
- DO 100 IX = 1, NX1
- XBIN = (IX - 0.5) * DXN1
- DO 90 IZ = 1, NZ1
- ZBIN = (IZ - 0.5) * DZN1
- L = (IZ - 1) * NX1 * NY1 + (IY - 1) * NX1 + IX
- L2P = L + NX1
- AS = Q (L3H + L2P) - Q (L3H + L)
- V = Q (L3V + L)
- V2P = Q (L3V + L2P)
- IF (V .EQ. 0.) V = VMEAN2
- IF (V2P .EQ. 0.) V2P = VMEAN2
- VS = V2P + V
- SS = ABS (AS / SQRT (VS))
- IF (SS .GE. SLCUT) THEN
- CALL HQSIGA (BINV, Q (L3H + L), VOLB1, DELTA,
- + SS, IHQERR)
- IF (IHQERR .EQ. 0) THEN
- ANY = .TRUE.
- THIS = .TRUE.
- ELSE IF (IHQERR .LT. 0) THEN
- IHQERR = 0
- ELSE
- GO TO 420
- END IF
- END IF
- 90 CONTINUE
- 100 CONTINUE
-* High y...
- IY = NY1
- YBIN = 1.
- DO 120 IX = 1, NX1
- XBIN = (IX - 0.5) * DXN1
- DO 110 IZ = 1, NZ1
- ZBIN = (IZ - 0.5) * DZN1
- L = (IZ - 1) * NX1 * NY1 + (IY - 1) * NX1 + IX
- L2M = L - NX1
- AS = Q (L3H + L2M) - Q (L3H + L)
- V = Q (L3V + L)
- V2M = Q (L3V + L2M)
- IF (V .EQ. 0.) V = VMEAN2
- IF (V2M .EQ. 0.) V2M = VMEAN2
- VS = V2M + V
- SS = ABS (AS / SQRT (VS))
- IF (SS .GE. SLCUT) THEN
- CALL HQSIGA (BINV, Q (L3H + L), VOLB1, DELTA,
- + SS, IHQERR)
- IF (IHQERR .EQ. 0) THEN
- ANY = .TRUE.
- THIS = .TRUE.
- ELSE IF (IHQERR .LT. 0) THEN
- IHQERR = 0
- ELSE
- GO TO 420
- END IF
- END IF
- 110 CONTINUE
- 120 CONTINUE
-* Low z...
- IZ = 1
- ZBIN = 0.
- DO 140 IX = 1, NX1
- XBIN = (IX - 0.5) * DXN1
- DO 130 IY = 1, NY1
- YBIN = (IY - 0.5) * DYN1
- L = (IZ - 1) * NX1 * NY1 + (IY - 1) * NX1 + IX
- L3P = L + NX1 * NY1
- AS = Q (L3H + L3P) - Q (L3H + L)
- V = Q (L3V + L)
- V3P = Q (L3V + L3P)
- IF (V .EQ. 0.) V = VMEAN2
- IF (V3P .EQ. 0.) V3P = VMEAN2
- VS = V3P + V
- SS = ABS (AS / SQRT (VS))
- IF (SS .GE. SLCUT) THEN
- CALL HQSIGA (BINV, Q (L3H + L), VOLB1, DELTA,
- + SS, IHQERR)
- IF (IHQERR .EQ. 0) THEN
- ANY = .TRUE.
- THIS = .TRUE.
- ELSE IF (IHQERR .LT. 0) THEN
- IHQERR = 0
- ELSE
- GO TO 420
- END IF
- END IF
- 130 CONTINUE
- 140 CONTINUE
-* High z...
- IZ = NZ1
- ZBIN = 1.
- DO 160 IX = 1, NX1
- XBIN = (IX - 0.5) * DXN1
- DO 150 IY = 1, NY1
- YBIN = (IY - 0.5) * DYN1
- L = (IZ - 1) * NX1 * NY1 + (IY - 1) * NX1 + IX
- L3M = L - NX1 * NY1
- AS = Q (L3H + L3M) - Q (L3H + L)
- V = Q (L3V + L)
- V3M = Q (L3V + L3M)
- IF (V .EQ. 0.) V = VMEAN2
- IF (V3M .EQ. 0.) V3M = VMEAN2
- VS = V3M + V
- SS = ABS (AS / SQRT (VS))
- IF (SS .GE. SLCUT) THEN
- CALL HQSIGA (BINV, Q (L3H + L), VOLB1, DELTA,
- + SS, IHQERR)
- IF (IHQERR .EQ. 0) THEN
- ANY = .TRUE.
- THIS = .TRUE.
- ELSE IF (IHQERR .LT. 0) THEN
- IHQERR = 0
- ELSE
- GO TO 420
- END IF
- END IF
- 150 CONTINUE
- 160 CONTINUE
-* End of new strategy.
-*************************************************************************
-******************************************************************
-* Note: the following has been modified by commenting out some statements
-* to suppress calls to other HQSIGn routines. This also has the effect
-* of to forcing the adding of corner points.
-******************************************************************
-* Now we are going to present HQSIG2 with the faces of this 3-D histogram.
-* HQSIG2 will think it's a 2-D histogram. When it comes to adding a point,
-* however, HQSIGA must know:
-* (a) the original dimensionality, NDIM,
-* (b) the current dimensionality, NDIMC,
-* (c) the coordinate(s) being treated, (NDIMWH (I), I = 1, NDIMC) and
-* (d) the value of the remaining coordinates,
-* (BINV (I), I = NDIMC + 1, NDIM), if any, destined for
-* (SIGV (NSIG, (NDIMWH(I))), I = NDIMC + 1, NDIM).
-* Preserve current values of NDIMWH (NDIMC is assumed to be 3 at this point).
- DO 170 IDIM = 1, NDIMC
- NDIMW2 (IDIM) = NDIMWH (IDIM)
- 170 CONTINUE
-* Find sig. points along the 6 faces...
- NDIMC = 2
-* x faces...
- DO 200 IX = 1, NX1, NX1 - 1
- IXE = IX / NX1 + 1
- DO 190 IY = 1, NY1
- DO 180 IZ = 1, NZ1
- L = (IZ - 1) * NX1 * NY1 + (IY - 1) * NX1 + IX
- LF = (IZ - 1) * NY1 + IY
- Q (L2H + LF) = Q (L3H + L)
- Q (L2V + LF) = Q (L3V + L)
- 180 CONTINUE
- 190 CONTINUE
- NDIMWH (1) = NDIMW2 (2)
- NDIMWH (2) = NDIMW2 (3)
- NDIMWH (3) = NDIMW2 (1)
- BINV (3) = EDGEN (IXE) -
- + (2. * EDGEN (IXE) - 1.) * DEDGE * DXN1
- IEDX (IXE) = 0
-************ CALL HQSIG2 (NY1, NZ1, VOLB1, IEDX (IXE), IHQERR)
- IF (IHQERR .NE. 0) GO TO 420
- 200 CONTINUE
-* y faces...
- DO 230 IY = 1, NY1, NY1 - 1
- IYE = IY / NY1 + 1
- DO 220 IX = 1, NX1
- DO 210 IZ = 1, NZ1
- L = (IZ - 1) * NX1 * NY1 + (IY - 1) * NX1 + IX
- LF = (IZ - 1) * NX1 + IX
- Q (L2H + LF) = Q (L3H + L)
- Q (L2V + LF) = Q (L3V + L)
- 210 CONTINUE
- 220 CONTINUE
- NDIMWH (1) = NDIMW2 (1)
- NDIMWH (2) = NDIMW2 (3)
- NDIMWH (3) = NDIMW2 (2)
- BINV (3) = EDGEN (IYE) -
- + (2. * EDGEN (IYE) - 1.) * DEDGE * DYN1
- IEDY (IYE) = 0
-************ CALL HQSIG2 (NX1, NZ1, VOLB1, IEDY (IYE), IHQERR)
- IF (IHQERR .NE. 0) GO TO 420
- 230 CONTINUE
-* z faces...
- DO 260 IZ = 1, NZ1, NZ1 - 1
- IZE = IZ / NZ1 + 1
- DO 250 IX = 1, NX1
- DO 240 IY = 1, NY1
- L = (IZ - 1) * NX1 * NY1 + (IY - 1) * NX1 + IX
- LF = (IY - 1) * NX1 + IX
- Q (L2H + LF) = Q (L3H + L)
- Q (L2V + LF) = Q (L3V + L)
- 240 CONTINUE
- 250 CONTINUE
- NDIMWH (1) = NDIMW2 (1)
- NDIMWH (2) = NDIMW2 (2)
- NDIMWH (3) = NDIMW2 (3)
- BINV (3) = EDGEN (IZE) -
- + (2. * EDGEN (IZE) - 1.) * DEDGE * DZN1
- IEDZ (IZE) = 0
-************ CALL HQSIG2 (NX1, NY1, VOLB1, IEDZ (IZE), IHQERR)
- IF (IHQERR .NE. 0) GO TO 420
- 260 CONTINUE
-* Restore current values of NDIMWH.
- NDIMC = 3
- DO 270 IDIM = 1, NDIMC
- NDIMWH (IDIM) = NDIMW2 (IDIM)
- 270 CONTINUE
-* Add corner points if adjacent faces have points.
- DO 300 IX = 1, NX1, NX1 - 1
- IXE = IX / NX1 + 1
- DO 290 IY = 1, NY1, NY1 - 1
- IYE = IY / NY1 + 1
- DO 280 IZ = 1, NZ1, NZ1 - 1
- IZE = IZ / NZ1 + 1
- IF (IEDX (IXE) .GE. 0 .AND. IEDY (IYE) .GE. 0 .AND.
- + IEDZ (IZE) .GE. 0) THEN
- ANY = .TRUE.
- XBIN = EDGEN (IXE) - (2. * EDGEN (IXE) - 1.) *
- + DEDGE * DXN1
- YBIN = EDGEN (IYE) - (2. * EDGEN (IYE) - 1.) *
- + DEDGE * DYN1
- ZBIN = EDGEN (IZE) - (2. * EDGEN (IZE) - 1.) *
- + DEDGE * DZN1
- L = (IZ - 1) * NX1 * NY1 + (IY - 1) * NX1 + IX
- CALL HQSIGA (BINV, Q (L3H + L), VOLB1, SMALLD,
- + SLCUT, IHQERR)
- IF (IHQERR .EQ. 0) THEN
- ANY = .TRUE.
- THIS = .TRUE.
- ELSE IF (IHQERR .LT. 0) THEN
- IHQERR = 0
- ELSE
- GO TO 420
- END IF
- END IF
- 280 CONTINUE
- 290 CONTINUE
- 300 CONTINUE
-* Are the extremities zero?
- DO 330 IX = 1, NX1, NX1 - 1
- DO 320 IY = 1, NY1, NY1 - 1
- DO 310 IZ = 1, NZ1, NZ1 - 1
- L = (IZ - 1) * NX1 * NY1 + (IY - 1) * NX1 + IX
- IF (Q (L3H + L) .NE. 0) GO TO 370
- 310 CONTINUE
- 320 CONTINUE
- 330 CONTINUE
- DO 340 IXE = 1, 2
- IF (IEDX (IXE) .GE. 0) GO TO 370
- 340 CONTINUE
- DO 350 IYE = 1, 2
- IF (IEDY (IYE) .GE. 0) GO TO 370
- 350 CONTINUE
- DO 360 IZE = 1, 2
- IF (IEDZ (IZE) .GE. 0) GO TO 370
- 360 CONTINUE
-* If so, mark for zero asyptotic constrained fit.
- IEDGE = 2
- 370 CONTINUE
- END IF
-
-* If no points have been found, or points have been found this time round (i.e.,
-* cease searching if points have been found but not this time round).
-**** (Not sure about the wisdom of this (why did I introduce it?) so disable for
-**** now.)
-* IF (.NOT. ANY .OR. THIS) THEN
- IF (NTUPLE) THEN
-* Rebin - the data is from an ntuple. This simplifies things immensely.
-* Double significance by increasing bin size by cube root of 2.
- FACTOR = 1.3
- NFACTR = 10. * FACTOR
- IF (NX1 .GE. NFACTR .AND. NY1 .GE. NFACTR .AND. NZ1 .GE.
- + NFACTR) THEN
- NX1 = NX1 / FACTOR
- NY1 = NY1 / FACTOR
- NZ1 = NZ1 / FACTOR
- NBTOT1 = NX1 * NY1 * NZ1
- DXN1 = 1. / NX1
- DYN1 = 1. / NY1
- DZN1 = 1. / NZ1
- VOLB1 = DXN1 * DYN1 * DZN1
-* Get contents and errors.
- CALL HQBIN (NBINS1, 0, IHQERR)
- IF (IHQERR. NE. 0) GO TO 420
- GO TO 10
- END IF
- ELSE
-* Rebin - double up.
-***** NOTE: bin doubling leaves the odd bin over. Not knowing what to do with
-***** it I simply leave it - possibly a significant point might be missed but
-***** the above code gave it at least one chance. When it comes to choosing
-***** bins for finding significant points for N-tuples, choose 2**N bins.
- IF (NX1 .GE. 20 .AND. NY1 .GE. 20 .AND. NZ1 .GE. 20) THEN
- NX00 = NX1
- NY00 = NY1
- NX1 = NX1 / 2
- NY1 = NY1 / 2
- NZ1 = NZ1 / 2
- DXN1 = 2. * DXN1
- DYN1 = 2. * DYN1
- DZN1 = 2. * DZN1
- VOLB1 = 8. * VOLB1
- NBTOT1 = NX1 * NY1 * NZ1
- DO 400 IZ = 1, NZ1
- DO 390 IY = 1, NY1
- DO 380 IX = 1, NX1
- L = 2 * (IZ - 1) * NX00 * NY00 + 2 * (IY - 1) *
- + NX00 + 2 * (IX - 1) + 1
- L1P = L + 1
- L2P = L + NX00
- L2PP = L + NX00 + 1
- L3P = L + NX00 * NY00
- L3PP = L + NX00 * NY00 + 1
- L3PPP = L + NX00 * NY00 + NX00
- L3PPPP = L + NX00 * NY00 + NX00 + 1
- LJ = (IZ - 1) * NX1 * NY1 + (IY - 1) * NX1 +
- + IX
- Q (L3H + LJ) = Q (L3H + L) + Q (L3H + L1P) +
- + Q (L3H + L2P) + Q (L3H + L2PP) + Q (L3H + L3P)
- + + Q (L3H + L3PP) + Q (L3H + L3PPP) + Q (L3H +
- + L3PPPP)
- Q (L3V + LJ) = Q (L3V + L) + Q (L3V + L1P) +
- + Q (L3V + L2P) + Q (L3V + L2PP) + Q (L3V + L3P)
- + + Q (L3V + L3PP) + Q (L3V + L3PPP) + Q (L3V +
- + L3PPPP)
- 380 CONTINUE
- 390 CONTINUE
- 400 CONTINUE
- GO TO 10
- END IF
- END IF
-* END IF
-
-* If no points have been found this pass, use IEDGE as a flag.
- IF (.NOT. ANY) IEDGE = -1
-
- GO TO 420
-
-* Errors.
- 410 CONTINUE
- CALL HBUG ('NDIMC not 3.', 'HQSIG3', IDMQ)
- IHQERR = 10
-
- 420 CONTINUE
-
- END
diff --git a/src/packlib/hbook/hquad/hqsiga.F b/src/packlib/hbook/hquad/hqsiga.F
deleted file mode 100644
index 37d4308..0000000
--- a/src/packlib/hbook/hquad/hqsiga.F
+++ /dev/null
@@ -1,90 +0,0 @@
-*
-* $Id: hqsiga.F,v 1.1.1.1 1996/01/16 17:08:06 mclareni Exp $
-*
-* $Log: hqsiga.F,v $
-* Revision 1.1.1.1 1996/01/16 17:08:06 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.17/01 22/11/92 12.23.42 by John Allison
-*-- Author :
- SUBROUTINE HQSIGA (V, H, VOL, DELTA, SL, IHQERR)
- REAL V (*), H, VOL, DELTA, SL
- INTEGER IHQERR
-* Adds significant point at V, bin height H, bin "volume" VOL,
-* scale parameter DELTA. SL is significance in standard deviations.
-* Note: VOL is in normalised coordinates, so convert.
-* IHQERR = -1 if it's rejected as being too close to existing point.
-* = 0 if all's OK.
-* HQSIGA needs:
-* (a) the original dimensionality, NDIM,
-* (b) the current dimensionality, NDIMC,
-* (c) the coordinate(s) being treated, (NDIMWH (I), I = 1, NDIMC) and
-* (d) the value of the remaining coordinates,
-* (BINV (I), I = NDIMC + 1, NDIM), if any, destined for
-* (SIGV (NSIG, (NDIMWH(I))), I = NDIMC + 1, NDIM).
-
-#include "hbook/hcqcom.inc"
-
- CHARACTER*80 CHQMES
- INTEGER IDIM, ISIG
-
-* SL was introduced so that the scale parameter could be made to depend on
-* the significance of the Laplacian. However, it was found that if the
-* scale parameters of two nearby multiquadrics differed slightly a beat
-* effect could affect far off regions, or rather, far off regions affected
-* the values of the coefficients. Thus, this strategy was abandoned so SL
-* is no longer used, but rather than delete it from the argument list here
-* in at all points called, I decided to leave it for possible future use.
-* (To keep CMZ's UNDEFINED command happy there follows a useless statement.)
- IHQERR = SL
- IHQERR = 0
-
-* Check it's not too close to an existing point.
- DO 40 ISIG = 1, NSIG
- DO 10 IDIM = 1, NDIMC
- IF (ABS (V (IDIM) - SIGV (ISIG, NDIMWH (IDIM))) .GE.
- + 0.99 * DELTA) GO TO 30
- 10 CONTINUE
- DO 20 IDIM = NDIMC + 1, NDIM
- IF (ABS (BINV (IDIM) - SIGV (ISIG, NDIMWH (IDIM))) .GE.
- + 0.99 * DELTA) GO TO 30
- 20 CONTINUE
- IHQERR = -1
- GO TO 80
- 30 CONTINUE
- 40 CONTINUE
-
- NSIG = NSIG + 1
- IF (NSIG .GT. NSMAX) GO TO 70
-
-* Record position.
- DO 50 IDIM = 1, NDIMC
- SIGV (NSIG, NDIMWH (IDIM)) = V (IDIM)
- 50 CONTINUE
- DO 60 IDIM = NDIMC + 1, NDIM
- SIGV (NSIG, NDIMWH (IDIM)) = BINV (IDIM)
- 60 CONTINUE
-
-* Record density.
- SIGDEN (NSIG) = H / (VOL * VOLTOT)
-
-* Record scale parameter - default is 2 x bin size.
- IF (NDIMC .EQ. NDIM) THEN
- SIGDEL (NSIG) = SPREAD * 2. * DELTA
- ELSE
- SIGDEL (NSIG) = 1.E-6
- END IF
-
- GO TO 80
-
- 70 CONTINUE
- WRITE (CHQMES,
- +'(''More than'', I4, '' significant points found.'')') NSMAX
- IHQERR = 1
- CALL HBUG (CHQMES, 'HQSIGA', IDMQ)
-
- 80 CONTINUE
-
- END
diff --git a/src/packlib/hbook/hquad/hqsolv.F b/src/packlib/hbook/hquad/hqsolv.F
deleted file mode 100644
index fe6aa3d..0000000
--- a/src/packlib/hbook/hquad/hqsolv.F
+++ /dev/null
@@ -1,125 +0,0 @@
-*
-* $Id: hqsolv.F,v 1.1.1.1 1996/01/16 17:08:06 mclareni Exp $
-*
-* $Log: hqsolv.F,v $
-* Revision 1.1.1.1 1996/01/16 17:08:06 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.17/01 22/11/92 12.13.37 by John Allison
-*-- Author :
- SUBROUTINE HQSOLV (SIGCOV, DW, N, CHISQ, IHQERR)
- INTEGER N
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION SIGCOV (N, N)
- DOUBLE PRECISION DW (N)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- REAL SIGCOV (N, N)
- REAL DW (N)
-#endif
- REAL CHISQ
- INTEGER IHQERR
-* Solves for coefficients SIGA given SIGDEN, the estimates of the density at the
-* significant points (converts to bin heights with VOLBIN).
-* Works in NORMALISED coordinates.
-* CHISQ is chi-squared.
-* IHQERR = 0 if all's OK.
-
-#include "hbook/hcqcom.inc"
-#include "hbook/hcqcor.inc"
-#include "hbook/hcbook.inc"
-
- CHARACTER*80 CHQMES
- INTEGER I, J, K, NWW, L, IX, IY, IZ
- REAL V (NDMAX)
- REAL X, Y, Z
- EQUIVALENCE (X, V (1)), (Y, V(2)), (Z, V(3))
-#if defined(CERNLIB_DOUBLE)
- PARAMETER (NWW = 2)
- DOUBLE PRECISION HQDJN, DCHISQ, HQDN
-#endif
-#if !defined(CERNLIB_DOUBLE)
- PARAMETER (NWW = 1)
- REAL HQDJN, DCHISQ, HQDN
-#endif
-
- IHQERR = 0
- IMQFUN = 1
-
-* Evaluate the multiquadrics at the significant points (use the covariance
-* matrix SIGCOV to store these and DW as working space).
- DO 30 K = 1, NSIG
- DO 10 I = 1, NDIM
- V (I) = SIGV (K, I)
- 10 CONTINUE
- DO 20 J = 1, NSIG
- SIGCOV (K, J) = HQDJN (V, J)
- 20 CONTINUE
- 30 CONTINUE
-
-* Transfer the data to SIGA for DEQN, converting to bin heights.
- DO 40 J = 1, NSIG
- SIGA (J) = SIGDEN (J) * VOLBIN
- 40 CONTINUE
-
-* Call CERN library F010 for simultaneous equations.
-#if defined(CERNLIB_DOUBLE)
- CALL DEQN (NSIG, SIGCOV, NSIG, DW, IHQERR, 1, SIGA)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- CALL REQN (NSIG, SIGCOV, NSIG, DW, IHQERR, 1, SIGA)
-#endif
- IF (IHQERR .NE. 0) GO TO 110
-
-* Clear covariance matrix (it was used as working space) as it has no meaning
-* for interpolation.
- CALL UZERO (SIGCOV, 1, NWW * NSIG ** 2)
-
-* Get chi-squared.
- DCHISQ = 0.
- IF (NDIM .EQ. 1) THEN
- DO 50 IX = 1, NX
- X = (IX - 0.5) / NX
- L = IX
- DCHISQ = DCHISQ + (Q (L1H + L) - HQDN (V)) ** 2 /
- + Q (L1V + L)
- 50 CONTINUE
- ELSE IF (NDIM .EQ. 2) THEN
- DO 70 IX = 1, NX
- X = (IX - 0.5) / NX
- DO 60 IY = 1, NY
- Y = (IY - 0.5) / NY
- L = (IY - 1) * NX + IX
- DCHISQ = DCHISQ + (Q (L2H + L) - HQDN (V)) ** 2 /
- + Q (L2V + L)
- 60 CONTINUE
- 70 CONTINUE
- ELSE IF (NDIM .EQ. 3) THEN
- DO 100 IX = 1, NX
- X = (IX - 0.5) / NX
- DO 90 IY = 1, NY
- Y = (IY - 0.5) / NY
- DO 80 IZ = 1, NZ
- Z = (IZ - 0.5) / NZ
- L = (IZ - 1) * NX * NY + (IY - 1) * NX + IX
- DCHISQ = DCHISQ + (Q (L3H + L) - HQDN (V)) ** 2 /
- + Q (L3V + L)
- 80 CONTINUE
- 90 CONTINUE
- 100 CONTINUE
- ELSE
- GO TO 110
- END IF
- CHISQ = DCHISQ
-
- GO TO 120
-
- 110 CONTINUE
- WRITE (CHQMES, '(''Error'', I3, '' in DEQN'')') IHQERR
- CALL HBUG (CHQMES, 'HQSOLV', IDMQ)
-
- 120 CONTINUE
-
- END
diff --git a/src/packlib/hbook/hquad/hqssv.F b/src/packlib/hbook/hquad/hqssv.F
deleted file mode 100644
index 1c7611b..0000000
--- a/src/packlib/hbook/hquad/hqssv.F
+++ /dev/null
@@ -1,78 +0,0 @@
-*
-* $Id: hqssv.F,v 1.1.1.1 1996/01/16 17:08:06 mclareni Exp $
-*
-* $Log: hqssv.F,v $
-* Revision 1.1.1.1 1996/01/16 17:08:06 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.17/01 22/11/92 12.13.37 by John Allison
-*-- Author :
- SUBROUTINE HQSSV
-* Calculate the NDIM + 1 dependent variables, the ones that
-* ensure sum and sum (strength * position) are zero.
-
-#include "hbook/hcqcom.inc"
-#include "hbook/hcqcor.inc"
-
- CHARACTER*80 CHQMES
- INTEGER ISIG
- INTEGER J1, J2, J3
-#if defined(CERNLIB_DOUBLE)
- DOUBLE PRECISION A, B, C, D
-#endif
-#if !defined(CERNLIB_DOUBLE)
- REAL A, B, C, D
-#endif
-
- IF (NDIM .EQ. 1) THEN
-
- A = 0.
- B = 0.
- DO 10 ISIG = 1, NSIG - 2
- A = A + SIGA (ISIG)
- B = B + SIGA (ISIG) * SIGX (ISIG)
- 10 CONTINUE
- J1 = NSIG - 1
- J2 = J1 + 1
- D = SIGX (J2) - SIGX (J1)
- SIGA (J1) = (B - A * SIGX (J2)) / D
- SIGA (J2) = -(B - A * SIGX (J1)) / D
-
- ELSE IF (NDIM .EQ. 2) THEN
-
- A = 0.
- B = 0.
- C = 0.
- DO 20 ISIG = 1, NSIG - 3
- A = A + SIGA (ISIG)
- B = B + SIGA (ISIG) * SIGX (ISIG)
- C = C + SIGA (ISIG) * SIGY (ISIG)
- 20 CONTINUE
- J1 = NSIG - 2
- J2 = J1 + 1
- J3 = J2 + 1
- D = SIGX (J2) * SIGY (J3) - SIGX (J3) * SIGY (J2) +
- + SIGX (J3) * SIGY (J1) - SIGX (J1) * SIGY (J3) +
- + SIGX (J1) * SIGY (J2) - SIGX (J2) * SIGY (J1)
- SIGA (J1) = - (SIGX (J3) * C - B * SIGY (J3) +
- + B * SIGY (J2) - SIGX (J2) * C +
- + A * (SIGX (J2) * SIGY (J3) - SIGX (J3) * SIGY (J2))) / D
- SIGA (J2) = (B * SIGY (J1) - SIGX (J1) * C +
- + A * (SIGX (J1) * SIGY (J3) - SIGX (J3) * SIGY (J1)) +
- + SIGX (J3) * C - B * SIGY (J3)) / D
- SIGA (J3) = - (A * (SIGX (J1) * SIGY (J2) -
- + SIGX (J2) * SIGY (J1)) +
- + SIGX (J2) * C - B * SIGY (J2) +
- + B * SIGY (J1) - SIGX (J1) * C) / D
-
- ELSE
-
- WRITE (CHQMES, '(''Not programmed for'', I3,'
- + //' '' dimensions.'')') NDIM
- CALL HBUG (CHQMES, 'HQSSV', IDMQ)
-
- END IF
-
- END
diff --git a/src/packlib/hbook/hquad/hquad.F b/src/packlib/hbook/hquad/hquad.F
deleted file mode 100644
index 6090bc5..0000000
--- a/src/packlib/hbook/hquad/hquad.F
+++ /dev/null
@@ -1,549 +0,0 @@
-*
-* $Id: hquad.F,v 1.1.1.1 1996/01/16 17:08:07 mclareni Exp $
-*
-* $Log: hquad.F,v $
-* Revision 1.1.1.1 1996/01/16 17:08:07 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.22/08 04/07/94 08.55.16 by Rene Brun
-*-- Author :
- SUBROUTINE HQUAD (IDHQ, CHOPTQ, IMODE, SENSI0, SMOOT0, NSIG1,
- +CHISQ, NDF, FMIN1, FMAX1, IHQERR)
- INTEGER IDHQ, IMODE, NSIG1, NDF, IHQERR
- CHARACTER*(*) CHOPTQ
- REAL SENSI0, SMOOT0, CHISQ, FMIN1, FMAX1
-* Peform no-nonsense fit with multiquadric radial basis functions.
-* 1- and 2-D histograms and ntuples with up to NDMAX variables.
-*
-* Writes Fortran77 function to unit PLUN if set by HSETPR.
-*
-* Input variables:
-* IDHQ = histogram or ntuple ID.
-* CHOPTQ = contains option characters:
-* 0 or 1: replace original histogram by smoothed.
-* 2: store values of smoothed function and its parameters
-* without replacing original histogram - results are
-* available as superimposed curve (1-D) or otherwise
-* when editing (displaying) - see HPLOT options.
-* V: verbose.
-* F: write FORTRAN function on unit given by HSETPR.
-* IMODE is synonymous with MODE.
-* MODE < 0, use existing significant points.
-*****************************************************************************
-************* Note: MODE < 0 needs re-thinking. Existing points can now only
-************* be picked up from an already fitted histogram or ntuple.
-*****************************************************************************
-* MODE = 0, equivalent to MODE = 3.
-* MODE0 = ABS (MODE) = 10 * MODE2 + MODE1, where
-* MODE1 = 1, simply fill MQ histogram banks (L1H, L1V, etc.).
-* = 2, find significant points and interpolate.
-* = 3, find significant points and perform unconstrained fit. If the
-* histogram or ntuple is unweighted (mean variance = 1.)
-* perform a Poisson likelihood fit, otherwise a least squares
-* fit.
-* = 4, find significant points and perform unconstrained least squares
-* fit. (This is a linear least squares problem and therefore
-* the most efficient possible since it allows a single step
-* calculation of the best fit and covariances. But note it
-* assumes gaussian errors, including the error on zero is equal
-* to 1.)
-* = 5, find significant points and perform least squares constrained
-* fit, constrained for zero asyptotes, if possible, otherwise
-* default to unconstrained fit. (Not currently implemented.)
-* = 6, find significant points and perform unconstrained Poisson
-* likelihood fit.
-* MODE2 = 0, do not perform maximum likelihood fit to events.
-* > 0, perform maximum likelihood fit to events (ntuple only).
-*
-* SENSI0 = SENSIT, a sensitivity parameter (if = 0., SENSIT = default (1.)).
-* SMOOT0 = SPREAD, a smoothness parameter (if = 0., SPREAD = default (1.)).
-*
-* Output variables:
-* NSIG1 = no. of significant points found.
-* CHISQ = chi-squared of result.
-* NDF = no. of degrees of freedom.
-* FMIN1, FMAX1 = minimum and maximum function values, i.e., event densities.
-* IHQERR = 0 if all's OK.
-
-#include "hbook/hcqcom.inc"
-#include "hbook/hcbook.inc"
-#include "hbook/hcfits.inc"
-#include "hbook/hcunit.inc"
-#include "hbook/hcpar0.inc"
-
-* Miscellaneous variables.
- CHARACTER*80 CHQMES
- CHARACTER*8 TAGS (NDMAX)
- LOGICAL HEXIST
- CHARACTER*80 TITLE
- INTEGER MODE, MODE0, MODE1, MODE2, IDN, ISEL
- INTEGER NVAR, NSMINN, NNBINN, NFACTR, NTRIES
- INTEGER IEDGE, NWT, LOC, LCOV, LDER, LWK1, LWK2, LWK3, NWW
- INTEGER I, IDIM, IX, IY, IZ
- REAL FACTOR
- REAL V (NDMAX)
- REAL X, Y, Z
- EQUIVALENCE (X, V (1)), (Y, V (2)), (Z, V (3))
- REAL F, HQF, ALOGLI, CHI2
- EXTERNAL HQF
-#if defined(CERNLIB_DOUBLE)
- PARAMETER (NWW = 2)
-#endif
-#if !defined(CERNLIB_DOUBLE)
- PARAMETER (NWW = 1)
-#endif
-
-* Store requested ID in /HCQCOM/.
- IDMQ = IDHQ
-
-* Check option characters.
- IF (INDEX (CHOPTQ, '0') .NE. 0 .OR. INDEX (CHOPTQ, '1') .NE. 0)
- +THEN
- ISEL = 1
- ELSE
- ISEL = 2
- END IF
- IF (INDEX (CHOPTQ, 'V') .NE. 0 .OR. INDEX (CHOPTQ, 'v') .NE. 0)
- +THEN
- VPRINT = .TRUE.
- ELSE
- VPRINT = .FALSE.
- END IF
-
-* Check MODE.
- MODE = IMODE
- IF (MODE .LT. 0) GO TO 100
-* MODE = 0 is equivalent to MODE = 3.
- IF (MODE. EQ. 0) MODE = 3
- MODE0 = ABS (MODE)
- MODE1 = MOD (MODE0, 10)
- MODE2 = MOD (MODE0 / 10, 10)
- IF (MODE1. GT. 6) GO TO 110
-* Constrained fit not currently implemented.
- IF (MODE1 .EQ. 5) GO TO 120
-
-* Clear IHQERR and other variables.
- NSIG1 = 0
- CHISQ = 0.
- NDF = 0
- IHQERR = 0
-
-* Set some /HCQCOM/ parameters.
- IF (SENSI0 .EQ. 0.) THEN
- SENSIT = 1.
- ELSE
- SENSIT = SENSI0
- END IF
- IF (SMOOT0 .EQ. 0.) THEN
- SPREAD = 1.
- ELSE
- SPREAD = SMOOT0
- END IF
- SMALLD = 1.E-6
- VSCALE = 1.
-
-* Check existence of histogram or ntuple and fill related parameters
-* in /HCQCOM/.
- NTUPLE = .FALSE.
- IDN = IDHQ
- NVAR = NDMAX
- CALL HGIVEN (IDN, TITLE, NVAR, TAGS, SIGVMI, SIGVMA)
- IF (NVAR .GT. 0) THEN
- NTUPLE = .TRUE.
- IF (NVAR .GT. NSMAX) GO TO 140
- CALL HNOENT (IDN, NMQEVS)
- NDIM = NVAR
- IF (NDIM .EQ. 1) THEN
- NSMINN = NSMIN1
- NNBINN = NNBIN1
- ELSE IF (NDIM .EQ. 2) THEN
- NSMINN = NSMIN2
- NNBINN = NNBIN2
- ELSE IF (NDIM .EQ. 3) THEN
- NDIM = 3
- NSMINN = NSMIN3
- NNBINN = NNBIN3
- ELSE
- WRITE (LOUT, '(3X, ''Taking 1st 3 variables.'')')
- NDIM = 3
- NSMINN = NSMIN3
- NNBINN = NNBIN3
- END IF
- NSMIN = NSMINN
- NBTOT = 1
- VOLTOT = 1.
- VOLBIN = 1.
- DO 10 IDIM = 1, NDIM
- NBTOT = NBTOT * NNBINN
- NBINS (IDIM) = NNBINN
- NBINSN (IDIM) = NNBINN
- SIGVT (IDIM) = SIGVMA (IDIM) - SIGVMI (IDIM)
- SIGVBI (IDIM) = SIGVT (IDIM) / NBINS (IDIM)
- VOLTOT = VOLTOT * SIGVT (IDIM)
- VOLBIN = VOLBIN * SIGVBI (IDIM)
- 10 CONTINUE
- ELSE IF (HEXIST (IDHQ)) THEN
- CALL HGIVE (IDHQ, TITLE, NX, XMI, XMA, NY, YMI, YMA, NWT, LOC)
- IF (NY .EQ. 0) THEN
- NDIM = 1
- NSMIN = NSMIN1
- NBTOT = NX
- DXT = XMA - XMI
- DX = DXT / NX
- VOLTOT = DXT
- VOLBIN = DX
- ELSE
- NDIM = 2
- NSMIN = NSMIN2
- NBTOT = NX * NY
- DXT = XMA - XMI
- DX = DXT / NX
- DYT = YMA - YMI
- DY = DYT / NY
- VOLTOT = DXT * DYT
- VOLBIN = DX * DY
- END IF
- ELSE
- GO TO 130
- END IF
- IDMQ = IDHQ
-
-* Allocate working space needed....
- NSIG = 0
- CALL HQINIT (NSIG, NDIM, NBINS, IHQERR)
- IF (IHQERR. NE. 0) GO TO 170
-
-* Lift LQ (LHQUAD - 1) chain, L1H etc.
- CALL HQLIF1 (IHQERR)
- IF (IHQERR. NE. 0) GO TO 170
-
-* Get contents and errors.
- NTRIES = 0
- 20 CONTINUE
- CALL HQBIN (NBINS, 0, IHQERR)
- IF (IHQERR. NE. 0) GO TO 170
- NTRIES = NTRIES + 1
-
-* MODE1 = 1 work finished.
- IF (MODE1 .EQ. 1) GO TO 170
-
-* Find significant points (HQSIG overwrites data).
- CALL HQSIG (IEDGE, IHQERR)
- IF (IHQERR .NE. 0) THEN
- IF (NTRIES .GT. 10) GO TO 170
-* If too few points found, check mean significance.
- IF (IHQERR .EQ. 20) THEN
-* Suspect errors incorrectly assigned (HBARX not called) - scale.
- IF (NTRIES .EQ. 1) THEN
-* First guess - experience shows...
- VSCALE = VSCALE * SLRMS ** 2 / 4.
- NSMIN = 2 * NSMIN
- ELSE
- VSCALE = VSCALE / 4.
- END IF
- WRITE (LOUT, 10000) SQRT (VSCALE)
- IHQERR = 0
- NSIG = 0
- GO TO 20
-* If too many points, reduce bins and sensitivity (ntuples only).
- ELSE IF (NTUPLE .AND. (IHQERR .EQ. 1 .OR. IHQERR .EQ. 30))
- + THEN
- FACTOR = 1.1
- NFACTR = 10. * FACTOR
- NBTOT = 1
- VOLBIN = 1.
- DO 30 IDIM = 1, NDIM
- IF (NBINS (IDIM) .LT. NFACTR) GO TO 170
- NBINS (IDIM) = NBINS (IDIM) / FACTOR
- NBINSN (IDIM) = NBINS (IDIM)
- NBTOT = NBTOT * NBINS (IDIM)
- SIGVBI (IDIM) = SIGVT (IDIM) / NBINS (IDIM)
- VOLBIN = VOLBIN * SIGVBI (IDIM)
- 30 CONTINUE
- SENSIT = SENSIT / FACTOR
- IF (VPRINT) THEN
- WRITE (LOUT, 10100) SENSIT
- IF (NDIM .EQ. 1) THEN
- WRITE (LOUT, 10200) NX
- ELSE IF (NDIM .EQ. 2) THEN
- WRITE (LOUT, 10300) NX, NY
- ELSE IF (NDIM .EQ. 3) THEN
- WRITE (LOUT, 10400) NX, NY, NZ
- ELSE
- GO TO 150
- END IF
- END IF
- IHQERR = 0
- NSIG = 0
- GO TO 20
- END IF
- END IF
-
-* Adjust to "best" histogram (no. of bins NXN, etc., possibly changed by HQSIG1,
-* etc.) to get starting values for maximum likelihood fit to events.
-* (Note: you get into trouble if you try fitting a coarser histogram to sig.
-* points which have been determined with a finer one.)
-* (The above is nonsense. The Poisson likelihood works very well for sparse
-* histograms! Comment out!)
-* IF (NTUPLE) THEN
-* NBTOT = 1
-* VOLBIN = 1.
-* DO xx IDIM = 1, NDIM
-* NBINS (IDIM) = NBINSN (IDIM)
-* NBTOT = NBTOT * NBINS (IDIM)
-* SIGVBI (IDIM) = SIGVT (IDIM) / NBINS (IDIM)
-* VOLBIN = VOLBIN * SIGVBI (IDIM)
-* xx CONTINUE
-* END IF
-
-* Lift LHQCOV bank, etc...
- CALL HQLIF2 (IHQERR)
- IF (IHQERR. NE. 0) GO TO 170
-* ...and optional banks LHQDJN, etc.
- CALL HQLIF3
-
-* Get contents and errors again, and compute variances.
-* Set variance of empty bins equal to square of mean variance for least squares
-* fitting in "extreme gaussian approximation" (2nd argument of HQBIN = 1).
-* (For unweighted histograms, Vmean = 1. For histograms which are simply
-* scaled unweighted histograms, e.g., normalised histograms, the scale
-* factor is 1./Vmean. In both cases, the "variance of empty bins in the
-* extreme gaussian approximation" is Vmean**2. For other weighted histograms
-* with empty bins, this may not be a good assumption.)
- CALL HQBIN (NBINS, 1, IHQERR)
- IF (IHQERR. NE. 0) GO TO 170
-
-* Perform fit/interpolation. All parameters are free unless
-* otherwise changed by these routines.
- NFREE = NSIG
-
-* IF = DOUBLE, make sure pointers are even so arrays start on 8-byte boundary.
- LCOV = LHQCOV + MOD (LHQCOV, NWW)
- LDER = LHQDER + MOD (LHQDER, NWW)
- LWK1 = LHQWK1 + MOD (LHQWK1, NWW)
- LWK2 = LHQWK2 + MOD (LHQWK2, NWW)
- LWK3 = LHQWK3 + MOD (LHQWK3, NWW)
-
- IF (MODE1 .EQ. 2) THEN
-
-* Interpolate from bin heights at the significant points.
- CALL HQSOLV (Q (LCOV + 1), Q (LWK1 + 1), NSIG, CHISQ, IHQERR)
-
- ELSE IF (MODE1 .EQ. 3) THEN
-
- IF (ABS (VMEAN1 - 1.) .LT. 1.E-3) THEN
-* Unconstrained Poisson likelihood fit.
- CALL HQPOIS (Q (LCOV + 1), Q (LDER + 1), Q (LWK1 + 1),
- + Q (LWK2 + 1), Q (LWK3 + 1), NSIG, CHISQ, ALOGLI, IHQERR)
- ELSE
-* Unconstrained, linear least squares fit.
- CALL HQLSQU (Q (LCOV + 1), Q (LWK1 + 1), NSIG, CHISQ,
- + IHQERR)
- END IF
-
- ELSE IF (MODE1 .EQ. 4) THEN
-
-* Unconstrained, linear least squares fit.
- CALL HQLSQU (Q (LCOV + 1), Q (LWK1 + 1), NSIG, CHISQ, IHQERR)
-
- ELSE IF (MODE1 .EQ. 5) THEN
-
-* Constrained fitting if edges are zero (IEDGE .NE. 0), otherwise default to
-* unconstrained fit.
-***** No contsrained fitting yet.
-* IF (IEDGE .EQ. 0) THEN
- CALL HQLSQU (Q (LCOV + 1), Q (LWK1 + 1), NSIG, CHISQ, IHQERR)
-* ELSE
-* Perform least squares fit constrained for zero asymptotes.
-* CALL HQLSQC (Q (LCOV + 1), Q (LWK1 + 1), NSIG, CHISQ,
-* + IHQERR)
-* END IF
-
- ELSE IF (MODE1 .EQ. 6) THEN
-
-* Unconstrained Poisson likelihood fit.
- CALL HQPOIS (Q (LCOV + 1), Q (LDER + 1), Q (LWK1 + 1),
- + Q (LWK2 + 1), Q (LWK3 + 1), NSIG, CHISQ, ALOGLI, IHQERR)
-
- END IF
-
-* Check for error.
- IF (IHQERR .NE. 0) GO TO 170
-
-* Perform unbinned maximum likelihood fit to events.
-* (Not currently implemented.)
- IF (MODE2 .GT. 0) THEN
- WRITE (LOUT, 10500)
- MODE2 = 0
- END IF
-
- IF (NTUPLE .AND. MODE2 .GT. 0) THEN
-
- IF (IMQFUN .LE. 1) THEN
-
- WRITE (LOUT, 10600)
-
- ELSE
-
-* Maximise the event likelihood.
-* CALL HQMXLI (Q (LCOV + 1), Q (LWK1 + 1), Q (LWK2 + 1), NSIG,
-* + CHISQ, ALOGLI, IHQERR)
- IF (IHQERR .NE. 0) GO TO 160
-
- END IF
-
- END IF
-
-* Replace contents (use Q (LnH.. as workspace) or store as function.
- HQFMIN = 1.E20
- HQFMAX = -1.E20
- IF (NDIM .EQ. 1) THEN
- DO 40 IX = 1, NX
- X = XMI + (IX - 0.5) * DX
- I = IX
- F = HQF (V)
- IF (HQFMIN .GT. F) HQFMIN = F
- IF (HQFMAX .LT. F) HQFMAX = F
- Q (L1H + I) = F
- 40 CONTINUE
- IF (.NOT. NTUPLE .AND. ISEL .LE. 1) THEN
- CALL HPAK (IDMQ, Q (L1H + 1))
- END IF
- ELSE IF (NDIM .EQ. 2) THEN
- DO 60 IX = 1, NX
- X = XMI + (IX - 0.5) * DX
- DO 50 IY = 1, NY
- Y = YMI + (IY - 0.5) * DY
- I = (IY - 1) * NX + IX
- F = HQF (V)
- IF (HQFMIN .GT. F) HQFMIN = F
- IF (HQFMAX .LT. F) HQFMAX = F
- Q (L2H + I) = F
- 50 CONTINUE
- 60 CONTINUE
- IF (.NOT. NTUPLE .AND. ISEL .LE. 1) THEN
- CALL HPAK (IDMQ, Q (L2H + 1))
- END IF
- ELSE IF (NDIM .EQ. 3) THEN
- DO 90 IX = 1, NX
- X = XMI + (IX - 0.5) * DX
- DO 80 IY = 1, NY
- Y = YMI + (IY - 0.5) * DY
- DO 70 IZ = 1, NZ
- Z = ZMI + (IZ - 0.5) * DZ
- F = HQF (V)
- IF (HQFMIN .GT. F) HQFMIN = F
- IF (HQFMAX .LT. F) HQFMAX = F
- 70 CONTINUE
- 80 CONTINUE
- 90 CONTINUE
- ELSE
- GO TO 150
- END IF
- IF (.NOT. NTUPLE .AND. ISEL .LE. 1) THEN
- HQMIN = HQFMIN
- HQMAX = HQFMAX
- END IF
-
-* Fill output variables.
- IF (VSCALE .NE. 1.) CHISQ = 0.
- NSIG1 = NSIG
- NDF = NBTOT - NSIG
- FMIN1 = HQFMIN
- FMAX1 = HQFMAX
-
-* Fill LHFIT banks.
-* To conform to PAW conventions, quote chi-squared per degree of freedom.
- IF (NDF .GT. 0) CHI2 = CHISQ / NDF
-* Store fit parameters.
- NFPAR=NSIG1
- NPFITS=NFPAR+NDF
- FITCHI=CHI2
- FITNAM(1)='MQuadric'
- IF (NTUPLE) THEN
- CALL HSUPIN(0)
- CALL HSUPIN(1)
- CALL HSUPIN(3)
- ELSE IF (ISEL .GT. 1) THEN
- CALL HSUPIS(HQF,0,0,0)
- CALL HSUPIS(HQF,1,0,0)
- CALL HSUPIS(HQF,3,0,0)
- END IF
-* Note: the above call to HSUPIS with 2nd arg = 3 causes it to store values of
-* the fit at bin centres in the LFUNC bank for both 1- and 2-D histograms. It
-* also stores the fit parameters and their errors in the LHFIT bank. A
-* typical 40x40 2-D histogram needing, say, 148 multiquadric basis functions
-* to describe it in an low-bias way requires:
-* words
-* LFUNC bank 1600
-* LHFIT banks (double precision):
-* 148 coefficients of basis function 148
-* other parameters - 148 * (NDIM + 1) 444
-* errors on coefficients 148
-* lower triangle of covariance matrix 11026
-* -----
-* 11766 = 25352
-* -----
-
-* Write Fortran77 function to unit PLUN if set by HSETPR.
- IF (PLUN .GT. 0. .AND. PLUN .LT. 100.) THEN
- CALL HQWRIF (INT (PLUN))
- END IF
-
- GO TO 170
-
-* Errors
- 100 CONTINUE
- CHQMES = 'MODE < 0 not implemented.'
- IHQERR = 100
- GO TO 160
- 110 CONTINUE
- WRITE (CHQMES, '(''Mode'', I2, '' not implemented.'')') MODE
- IHQERR = 200
- GO TO 160
- 120 CONTINUE
- WRITE (CHQMES,
- + '(''Mode'', I2, '' not currently implemented.'')') MODE
- IHQERR = 400
- GO TO 160
- 130 CONTINUE
- WRITE (CHQMES, '(''No histogram or ntuple with id ='', I7)')
- +IDHQ
- IHQERR = 500
- GO TO 160
- 140 CONTINUE
- WRITE (CHQMES, '(''Ntuple has more than'', I3, '' variables.'')')
- +NDMAX
- IHQERR = 600
- GO TO 160
- 150 CONTINUE
- WRITE (CHQMES, '(''Not programmed for'', I3,
- +'' dimensions.'')') NDIM
- IHQERR = 700
- GO TO 160
-
- 160 CONTINUE
- CALL HBUG (CHQMES, 'HQUAD', IDMQ)
-
- 170 CONTINUE
-
-* Drop banks, etc.
- CALL HQEND
-
-10000 FORMAT (1X, 'Warning: statistically insignificant.'/
- +3X, 'Errors being scaled by', G10.3)
-10100 FORMAT (1X, 'Trying to reduce no. of significant points:'/
- +3X, 'A) by reducing sensitivity parameter to', F10.4)
-10200 FORMAT (3X, 'B) by reducing no. of bins to', I5)
-10300 FORMAT (3X, 'B) by reducing no. of bins to', I3, ' x', I3)
-10400 FORMAT (3X, 'B) by reducing no. of bins to', I3, ' x', I3,
- +' x', I3)
-10500 FORMAT (1X, 'Unbinned maximum likelihood still under development',
- +' - try later!')
-10600 FORMAT (
- +1X, 'HQUADN: weighted event likelihood not programmed yet.'/
- +3X, 'Fit is result of least squares fit to the MQ histogram.')
-
- END
diff --git a/src/packlib/hbook/hquad/hqwave.F b/src/packlib/hbook/hquad/hqwave.F
deleted file mode 100644
index 6923d4b..0000000
--- a/src/packlib/hbook/hquad/hqwave.F
+++ /dev/null
@@ -1,263 +0,0 @@
-*
-* $Id: hqwave.F,v 1.1.1.1 1996/01/16 17:08:07 mclareni Exp $
-*
-* $Log: hqwave.F,v $
-* Revision 1.1.1.1 1996/01/16 17:08:07 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.18/00 02/02/93 09.32.29 by John Allison
-*-- Author :
- SUBROUTINE HQWAVE (CHID, TAGS, CHISQ, ALOGLI, NNX, NNY, NNZ,
- +LUWAVE, LUAVSH, LUAVSF)
- CHARACTER*(*) CHID, TAGS (*)
- INTEGER NNX, NNY, NNZ, LUWAVE, LUAVSH, LUAVSF
- REAL CHISQ, ALOGLI
-* Output 3-D histogram and fitted function in Wavefront's Data Visualiser
-* format. Also write an AVS .fld files (one for the histogram, one for the
-* function) to read it.
-* If you have just completed multiquadric smoothing and it will write out the
-* histogram contents. If you pick up a previously smoothed ntuple from a
-* .hbook file, the histogram will not be present. If you smooth one ntuple,
-* then pick another up from a .hbook file, you may get the wrong histogram
-* contents.
-* CHID is a character identification, which (it is suggested) should be the
-* filename "basename".
-* LUWAVE, LUAVSH and LUAVSF are the logical nos. It is suggested that files are
-* named (with the OPEN statement in the calling routine) to:
-* LUWAVE: filename = basename.wave
-* LUAVSH: filename = basename_hist.fld
-* LUAVSF: filename = basename_func.fld
-* If NNX, etc. is different to NX, etc., the function is written on a
-* grid defined by NNX, etc., and the histogram is not written.
-
-#include "hbook/hcqcom.inc"
-#include "hbook/hcbook.inc"
-
- CHARACTER*80 CHQMES, CHID1
- LOGICAL HTHERE, FTHERE
- CHARACTER*40 CHTITL
- INTEGER L, IX, IY, IZ, NCHX, NCHY, NCHZ
- INTEGER LENOCC, LCHID, LCHTIT, NLINES
- REAL V (3), X, Y, Z, DDX, DDY, DDZ
- EQUIVALENCE (X, V (1)), (Y, V(2)), (Z, V(3))
- REAL HQF
-
- IF (NDIM .NE. 3) GO TO 70
-
- IF (NSIG .GT. 0) THEN
- FTHERE = .TRUE.
- ELSE
- FTHERE = .FALSE.
- END IF
-
- IF (NNX .EQ. NX .AND. NNY .EQ. NY .AND. NNZ .EQ. NZ) THEN
- HTHERE = .TRUE.
- ELSE
- HTHERE = .FALSE.
- END IF
-
- IF (.NOT. HTHERE .AND. .NOT. FTHERE) GO TO 80
-
- DDX = DXT / NNX
- DDY = DYT / NNY
- DDZ = DZT / NNZ
-
- LCHID = LENOCC (CHID)
- CHID1 = CHID
-
- NCHZ = LENOCC (TAGS (1))
- NCHY = LENOCC (TAGS (2))
- NCHX = LENOCC (TAGS (3))
- CHTITL = TAGS (3) (1: NCHZ) // '%' // TAGS (2) (1: NCHY)
- +// '%' // TAGS (1) (1: NCHX)
- LCHTIT = LENOCC (CHTITL)
-
-#if defined(CERNLIB_UNIX)
- CALL CUTOL (CHID1)
- CALL CUTOL (CHTITL)
-#endif
-
-* Write .wave file for Wavefront's Data Visualiser.
- WRITE (LUWAVE,
- +'(''# Multiquadric data for Wavefront''''s Data Visualiser.'')')
- WRITE (LUWAVE, '(''# Identifier '', A)') CHID1 (1: LCHID)
- WRITE (LUWAVE, '(''# Tags '', A)') CHTITL (1: LCHTIT)
- WRITE (LUWAVE, '(''# No. of multiquadric parameters'', I6)') NSIG
- WRITE (LUWAVE, '(''# Chi-squared'', G12.5, '' for'', I6,
- +'' degrees of freedom.'')') CHISQ, NBTOT - NSIG
- WRITE (LUWAVE, '(''# Log likelihood'', G12.5)') ALOGLI
-
- WRITE (LUWAVE, '(/)')
- WRITE (LUWAVE, '(''define mesh mquad_'', A)') CHTITL (1: LCHTIT)
- WRITE (LUWAVE, '('' mesh_topology mquad_topology'')')
- WRITE (LUWAVE, '('' mesh_grid mquad_grid'')')
-
- WRITE (LUWAVE, '(/)')
- WRITE (LUWAVE, '(''define reg_grid mquad_grid'')')
- WRITE (LUWAVE, '('' grid_samp'', 3I5)') NNX, NNY, NNZ
- WRITE (LUWAVE, '('' origin'', 3G12.5)') XMI + DX / 2.,
- + YMI + DY / 2., ZMI + DZ / 2.
- WRITE (LUWAVE, '('' step'', 3G12.5)') DDX, DDY, DDZ
-
- WRITE (LUWAVE, '(/)')
- WRITE (LUWAVE, '(''define reg_topology mquad_topology'')')
- WRITE (LUWAVE, '('' elem_samp'', 3I5)') NNX - 1, NNY - 1, NNZ - 1
-
- NLINES = 21
-
- IF (HTHERE) THEN
- WRITE (LUWAVE, '(/)')
- WRITE (LUWAVE, '(''define volume mquad_histogram'')')
- WRITE (LUWAVE, '('' volume_mesh mquad_'', A)')
- + CHTITL (1: LCHTIT)
- WRITE (LUWAVE, '('' volume_vdata mquad_histogram_contents'')')
- NLINES = NLINES + 5
- END IF
-
- IF (FTHERE) THEN
- WRITE (LUWAVE, '(/)')
- WRITE (LUWAVE, '(''define volume mquad_function'')')
- WRITE (LUWAVE, '('' volume_mesh mquad_'', A)')
- + CHTITL (1: LCHTIT)
- WRITE (LUWAVE, '('' volume_vdata mquad_function_value'')')
- NLINES = NLINES + 5
- END IF
-
- IF (HTHERE .AND. .NOT. FTHERE) THEN
- WRITE (LUWAVE, '(/)')
- WRITE (LUWAVE, '(''define vdata 1 mquad_histogram_contents'')')
- WRITE (LUWAVE, '('' data list'')')
- WRITE (LUWAVE, '(G15.8)') (Q (L3H + L), L = 1, NBTOT)
- ELSE IF (HTHERE .AND. FTHERE) THEN
- WRITE (LUWAVE, '(/)')
- WRITE (LUWAVE, '(''define vdata 2 mquad_histogram_contents'',
- + '' mquad_function_value'')')
- WRITE (LUWAVE, '('' data list'')')
- DO 30 IZ = 1, NNZ
- Z = ZMI + (IZ - 0.5) * DDZ
- DO 20 IY = 1, NNY
- Y = YMI + (IY - 0.5) * DDY
- DO 10 IX = 1, NNX
- X = XMI + (IX - 0.5) * DDX
- L = (IZ - 1) * NNX * NNY + (IY - 1) * NNX + IX
- WRITE (LUWAVE, '(2G15.8)') Q (L3H + L), HQF (V)
- 10 CONTINUE
- 20 CONTINUE
- 30 CONTINUE
- ELSE IF (.NOT. HTHERE .AND. FTHERE) THEN
- WRITE (LUWAVE, '(/)')
- WRITE (LUWAVE, '(''define vdata 1 mquad_function_value'')')
- WRITE (LUWAVE, '('' data list'')')
- DO 60 IZ = 1, NNZ
- Z = ZMI + (IZ - 0.5) * DDZ
- DO 50 IY = 1, NNY
- Y = YMI + (IY - 0.5) * DDY
- DO 40 IX = 1, NNX
- X = XMI + (IX - 0.5) * DDX
- L = (IZ - 1) * NNX * NNY + (IY - 1) * NNX + IX
- WRITE (LUWAVE, '(G15.8)') HQF (V)
- 40 CONTINUE
- 50 CONTINUE
- 60 CONTINUE
- END IF
- NLINES = NLINES + 4
-
-* Write AVS _hist.fld file.
- IF (HTHERE) THEN
- WRITE (LUAVSH, '(''# AVS field file.'')')
- WRITE (LUAVSH, '(''# Identifier '', A)') CHID1 (1: LCHID) //
- + ' (histogram)'
- WRITE (LUAVSH, '(/''######################################'')')
- WRITE (LUAVSH, '(''# (Note: you may have to edit the .wave '
- + //'filename below.)'')')
- WRITE (LUAVSH, '(''######################################''/)')
- WRITE (LUAVSH, '(''# Tags '', A)') CHTITL (1: LCHTIT)
- WRITE (LUAVSH, '(''# No. of multiquadric parameters'', I6)')
- + NSIG
- WRITE (LUAVSH, '(''# Chi-squared'', G12.5, '' for'', I6,'
- + //''' degrees of freedom.'')') CHISQ, NBTOT - NSIG
- WRITE (LUAVSH, '(''# Log likelihood'', G12.5)') ALOGLI
-
- WRITE (LUAVSH, '(/)')
- WRITE (LUAVSH, '(''ndim = 3'')')
- WRITE (LUAVSH, '(''dim1 = '', I3)') NNX
- WRITE (LUAVSH, '(''dim2 = '', I3)') NNX
- WRITE (LUAVSH, '(''dim3 = '', I3)') NNX
- WRITE (LUAVSH, '(''nspace = 3'')')
- WRITE (LUAVSH, '(''veclen = 1'')')
- WRITE (LUAVSH, '(''data = float'')')
- WRITE (LUAVSH, '(''field = uniform'')')
- WRITE (LUAVSH, '(''min_ext = '', 3F15.7)') XMI + DX / 2.,
- + YMI + DY / 2., ZMI + DZ / 2.
- WRITE (LUAVSH, '(''max_ext = '', 3F15.7)') XMA - DX / 2.,
- + YMA - DY / 2., ZMA - DZ / 2.
- WRITE (LUAVSH, '(''label = histogram'')')
- IF (FTHERE) THEN
- WRITE (LUAVSH, '(''variable 1 file='', A, ''.wave '
- + //'filetype=ascii skip='', I5, '' stride=2'')')
- + CHID1 (1: LCHID), NLINES
- ELSE
- WRITE (LUAVSH, '(''variable 1 file='', A, ''.wave '
- + //'filetype=ascii skip='', I5)') CHID1 (1: LCHID), NLINES
- END IF
- END IF
-
-* Write AVS _func.fld file.
- IF (FTHERE) THEN
- WRITE (LUAVSF, '(''# AVS field file.'')')
- WRITE (LUAVSF, '(''# Identifier '', A)') CHID1 (1: LCHID) //
- + ' (function)'
- WRITE (LUAVSF, '(/''######################################'')')
- WRITE (LUAVSF, '(''# (Note: you may have to edit the .wave '
- + //'filename below.)'')')
- WRITE (LUAVSF, '(''######################################''/)')
- WRITE (LUAVSF, '(''# Tags '', A)') CHTITL (1: LCHTIT)
- WRITE (LUAVSF, '(''# No. of multiquadric parameters'', I6)')
- + NSIG
- WRITE (LUAVSF, '(''# Chi-squared'', G12.5, '' for'', I6,'
- + //''' degrees of freedom.'')') CHISQ, NBTOT - NSIG
- WRITE (LUAVSF, '(''# Log likelihood'', G12.5)') ALOGLI
-
- WRITE (LUAVSF, '(/)')
- WRITE (LUAVSF, '(''ndim = 3'')')
- WRITE (LUAVSF, '(''dim1 = '', I3)') NNX
- WRITE (LUAVSF, '(''dim2 = '', I3)') NNX
- WRITE (LUAVSF, '(''dim3 = '', I3)') NNX
- WRITE (LUAVSF, '(''nspace = 3'')')
- WRITE (LUAVSF, '(''veclen = 1'')')
- WRITE (LUAVSF, '(''data = float'')')
- WRITE (LUAVSF, '(''field = uniform'')')
- WRITE (LUAVSF, '(''min_ext = '', 3F15.7)') XMI + DX / 2.,
- + YMI + DY / 2., ZMI + DZ / 2.
- WRITE (LUAVSF, '(''max_ext = '', 3F15.7)') XMA - DX / 2.,
- + YMA - DY / 2., ZMA - DZ / 2.
- IF (HTHERE) THEN
- WRITE (LUAVSF, '(''variable 1 file='', A, ''.wave '
- + //'filetype=ascii skip='', I5, '' offset=1 stride=2'')')
- + CHID1 (1: LCHID), NLINES
- ELSE
- WRITE (LUAVSF, '(''variable 1 file='', A, ''.wave '
- + //'filetype=ascii skip='', I5)') CHID1 (1: LCHID), NLINES
- END IF
- END IF
-
-
- GO TO 100
-
- 70 CONTINUE
- WRITE (CHQMES, '(''Wrong dimensions ('', I2,
- +'') - only 3-D programmed.'')') NDIM
- GO TO 90
-
- 80 CONTINUE
- CHQMES = 'Neither histogram nor function exist.'
- GO TO 90
-
- 90 CONTINUE
- CALL HBUG (CHQMES, 'HQWAVE', IDMQ)
-
- 100 CONTINUE
-
- END
diff --git a/src/packlib/hbook/hquad/hqwrif.F b/src/packlib/hbook/hquad/hqwrif.F
deleted file mode 100644
index 7167863..0000000
--- a/src/packlib/hbook/hquad/hqwrif.F
+++ /dev/null
@@ -1,90 +0,0 @@
-*
-* $Id: hqwrif.F,v 1.1.1.1 1996/01/16 17:08:07 mclareni Exp $
-*
-* $Log: hqwrif.F,v $
-* Revision 1.1.1.1 1996/01/16 17:08:07 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.21/00 23/10/93 17.10.41 by Rene Brun
-*-- Author : John Allison 18/12/92
- SUBROUTINE HQWRIF (LUN)
-*
-* Write Fortran77 function to unit LUN.
-
-#include "hbook/hcqcom.inc"
-#include "hbook/hcqcor.inc"
-#include "hbook/hcbook.inc"
-
- WRITE (LUN, 10000) NDIM, NDIM, NDIM, NSIG, NDIM, NSIG, NSIG
- WRITE (LUN, 10100) NSIG, NDIM, IMQFUN
- WRITE (LUN, 10200) VCONST
- IF (NDIM .EQ.1) THEN
- WRITE (LUN, 10300) (SIGVMI (I), I = 1, NDIM)
- WRITE (LUN, 10400) (SIGVT (I), I = 1, NDIM)
- ELSE
- WRITE (LUN, 10500) (SIGVMI (I), I = 1, NDIM)
- WRITE (LUN, 10600)
- WRITE (LUN, 10700) (SIGVT (I), I = 1, NDIM)
- WRITE (LUN, 10600)
- END IF
- WRITE (LUN, 10800) ((SIGV (J, I), J = 1, NSIG), I = 1, NDIM)
- WRITE (LUN, 10600)
- WRITE (LUN, 10900) (SIGDEL (I), I = 1, NSIG)
- WRITE (LUN, 10600)
- WRITE (LUN, 11000) (SIGA (I), I = 1, NSIG)
- WRITE (LUN, 10600)
- WRITE (LUN, 11100)
- WRITE (LUN, 11200)
- WRITE (LUN, 11300)
-
-10000 FORMAT (
-#if defined(CERNLIB_DOUBLE)
- +6X, 'DOUBLE PRECISION FUNCTION HQUADF(V)'/
- +6X, 'DOUBLE PRECISION V(', I2, ')'/
- +6X, 'INTEGER NPAR, NDIM, IMQFUN, I, J'/
- +6X, 'DOUBLE PRECISION HQDJ, VV, VCONST'/
- +6X, 'DOUBLE PRECISION SIGVMI(', I2, '), SIGVT(', I2, ')'/
- +6X, 'DOUBLE PRECISION SIGV(', I4, ',', I2, ')'/
- +6X, 'DOUBLE PRECISION SIGDEL(', I4, ')'/
- +6X, 'DOUBLE PRECISION SIGA(', I4, ')')
-#endif
-#if !defined(CERNLIB_DOUBLE)
- +6X, 'REAL FUNCTION HQUADF(V)'/
- +6X, 'REAL V(', I2, ')'/
- +6X, 'INTEGER NPAR, NDIM, IMQFUN, I, J'/
- +6X, 'REAL HQDJ, VV, VCONST'/
- +6X, 'REAL SIGVMI(', I2, '), SIGVT(', I2, ')'/
- +6X, 'REAL SIGV(', I4, ',', I2, ')'/
- +6X, 'REAL SIGDEL(', I4, ')'/
- +6X, 'REAL SIGA(', I4, ')')
-#endif
-10100 FORMAT (
- +6X, 'DATA NPAR, NDIM, IMQFUN /', I5, ',', I5, ',', I5, '/')
-10200 FORMAT (6X, 'DATA VCONST /', G20.13, '/')
-10300 FORMAT (6X, 'DATA SIGVMI /', G20.13, '/')
-10400 FORMAT (6X, 'DATA SIGVT /', G20.13, '/')
-10500 FORMAT (6X, 'DATA SIGVMI /', G20.13/ (5X, '+,', G20.13))
-10600 FORMAT (5X, '+/')
-10700 FORMAT (6X, 'DATA SIGVT /', G20.13/ (5X, '+,', G20.13))
-10800 FORMAT (6X, 'DATA SIGV /', G20.13/ (5X, '+,', G20.13))
-10900 FORMAT (6X, 'DATA SIGDEL /', G20.13/ (5X, '+,', G20.13))
-11000 FORMAT (6X, 'DATA SIGA /', G20.13/ (5X, '+,', G20.13))
-11100 FORMAT (
- +6X, 'HQUADF = 0.'/
- +6X, 'DO 20 J = 1, NPAR'/
- +9X, 'HQDJ = 0.'/
- +9X, 'DO 10 I = 1, NDIM'/
- +12X, 'VV = (V (I) - SIGVMI (I)) / SIGVT (I)'/
- +12X, 'HQDJ = HQDJ + (VV - SIGV (J, I)) ** 2'/
- +3X, '10 ', 3X, 'CONTINUE'/
- +9X, 'HQDJ = HQDJ + SIGDEL (J) ** 2'/
- +9X, 'HQDJ = SQRT (HQDJ)'/
- +9X, 'HQUADF = HQUADF + SIGA (J) * HQDJ'/
- +3X, '20 CONTINUE')
-11200 FORMAT (
- +6X, 'IF (IMQFUN .EQ. 2) HQUADF = VCONST * EXP (HQUADF)')
-11300 FORMAT (6X, 'END')
-
- END
diff --git a/src/packlib/hbook/hquad/hqxi.F b/src/packlib/hbook/hquad/hqxi.F
deleted file mode 100644
index af49204..0000000
--- a/src/packlib/hbook/hquad/hqxi.F
+++ /dev/null
@@ -1,52 +0,0 @@
-*
-* $Id: hqxi.F,v 1.1.1.1 1996/01/16 17:08:07 mclareni Exp $
-*
-* $Log: hqxi.F,v $
-* Revision 1.1.1.1 1996/01/16 17:08:07 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.17/01 02/09/92 19.10.43 by John Allison
-*-- Author :
- REAL FUNCTION HQXI (IA)
- INTEGER IA (*)
-* Returns contents of MQ histogram indexed by IA, which is a vector of
-* channel numbers - IA (1) is x-channel, IA (2) is y-channel, etc.
-
-#include "hbook/hcqcom.inc"
-#include "hbook/hcbook.inc"
-
- CHARACTER*80 CHQMES
-
- INTEGER L, IX, IY, IZ
-
- IF (NDIM .EQ. 1) THEN
- IX = IA (1)
- L = IX
- HQXI = Q (L1H + L)
- ELSE IF (NDIM .EQ. 2) THEN
- IX = IA (1)
- IY = IA (2)
- L = (IY - 1) * NX + IX
- HQXI = Q (L2H + L)
- ELSE IF (NDIM .EQ. 3) THEN
- IX = IA (1)
- IY = IA (2)
- IZ = IA (3)
- L = (IZ - 1) * NX * NY + (IY - 1) * NX + IX
- HQXI = Q (L3H + L)
- ELSE
- GO TO 10
- END IF
-
- GO TO 20
-
-* Errors.
- 10 CONTINUE
- WRITE (CHQMES, '(I3, '' dimensions not programmed yet.'')') NDIM
- CALL HBUG (CHQMES, 'HQXI', IDMQ)
-
- 20 CONTINUE
-
- END
diff --git a/src/packlib/hbook/hrz/Imakefile b/src/packlib/hbook/hrz/Imakefile
deleted file mode 100644
index 28dfa2d..0000000
--- a/src/packlib/hbook/hrz/Imakefile
+++ /dev/null
@@ -1,5 +0,0 @@
-SRCS_F= hrendc.F hrendf.F hrenid.F hrfile.F hrget.F hrin.F hrmake.F \ @@\
- hrmdir.F hropen.F hrout.F hrput.F hrsort.F hrzcd.F hrzin.F \ @@\
- hrzkey.F hrzld.F hrzout.F hscr.F hreadonedir.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/hbook/hrz/hreadonedir.F b/src/packlib/hbook/hrz/hreadonedir.F
deleted file mode 100644
index cfeef38..0000000
--- a/src/packlib/hbook/hrz/hreadonedir.F
+++ /dev/null
@@ -1,40 +0,0 @@
-*
-* $Id:
-*
-* $Log:
-*
-#include "hbook/pilot.h"
- SUBROUTINE HREADONEDIR(CDIR)
-*.==========>
-* Service routine for Hrget.
-* This routine is called by the Zebra/RZ routine RZSCAN while scanning
-* a RZ directory tree.
-* Creates a directory in memory with the same name as the directory on file.
-* Reads histograms in memory
-*..=========> ( R.Brun )
- character *(*) cdir
- character *80 diskdir,pawcdir
- character*256 directory
- common /hrgetdir/ directory, lendir
-*
- nch = lenocc(cdir)
-* Search last slash in directory
- do 10 i=nch,7,-1
- if (cdir(i:i).eq.'/') then
- if (i.gt.8) then
- diskdir = cdir(1:i-1)
-c pawcdir = '//PAWC'//cdir(8:i-1)
- pawcdir = directory(1:lendir)//cdir(8:i-1)
- else
- diskdir = '//HRGET'
-c pawcdir = '//PAWC'
- pawcdir = directory(1:lendir)
- endif
- call hcdir(pawcdir,' ')
- call hmdir(cdir(i+1:),'S')
- call hcdir(cdir,' ')
- call hrin(0,999,0)
- return
- endif
- 10 continue
- end
diff --git a/src/packlib/hbook/hrz/hrendc.F b/src/packlib/hbook/hrz/hrendc.F
deleted file mode 100644
index 6c30e15..0000000
--- a/src/packlib/hbook/hrz/hrendc.F
+++ /dev/null
@@ -1,58 +0,0 @@
-*
-* $Id: hrendc.F,v 1.3 1998/03/18 17:02:52 couet Exp $
-*
-* $Log: hrendc.F,v $
-* Revision 1.3 1998/03/18 17:02:52 couet
-* - FORTRAN I/O default for VMS
-*
-* Revision 1.2 1997/05/13 15:21:00 couet
-* - default is now C/IO for all machines. To have fortran IO the option F should
-* be given to HROPEN and the file should be close with HRENDF. HREND is now
-* equivalent to HRENDC.
-*
-* Revision 1.1.1.1 1996/01/16 17:08:08 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
- SUBROUTINE HRENDC(CHDIR)
-#if !defined(CERNLIB_VAXVMS)
- ENTRY HREND(CHDIR)
-#endif
-*.==========>
-*. Close an HBOOK/RZ file. Via RZCLOS the unit is also correctly
-*. closed in case of C I/O.
-*. This routine is a copy of HRENDF, make changes in both at the
-*. same time.
-*. C/IO is now the default (except VMS). Calling HREND is the same
-*. as calling HREND. To have FORTRAN IO, HROPEN must be called with
-*. option F and HRENDF must be called instead of HREND/HRENDC.
-*..=========>
-#include "hbook/hcdire.inc"
- CHARACTER*(*) CHDIR
-*.___________________________________________
-*
-*
- NCHMAX=NCHTOP
- DO 20 I=2,NCHMAX
- IF(CHTOP(I).EQ.CHDIR)THEN
- IF(ICHTOP(I).GT.0.AND.ICHTOP(I).LT.1000)THEN
- CALL RZCLOS(CHDIR,' ')
- CALL HBFREE(ICHTOP(I))
- ENDIF
- CALL HNTDEL(CHDIR)
-*
- DO 10 J=I+1,NCHTOP
- ICHTOP(J-1)=ICHTOP(J)
- ICHLUN(J-1)=ICHLUN(J)
- ICHTYP(J-1)=ICHTYP(J)
- CHTOP(J-1)=CHTOP(J)
- HFNAME(J-1)=HFNAME(J)
- 10 CONTINUE
- NCHTOP=NCHTOP-1
- ENDIF
- 20 CONTINUE
-*
- CALL HCDIR('//PAWC',' ')
-*
- END
diff --git a/src/packlib/hbook/hrz/hrendf.F b/src/packlib/hbook/hrz/hrendf.F
deleted file mode 100644
index 0d5b45a..0000000
--- a/src/packlib/hbook/hrz/hrendf.F
+++ /dev/null
@@ -1,43 +0,0 @@
-*
-* $Id:
-*
-* $Log:
-*
-#include "hbook/pilot.h"
- SUBROUTINE HRENDF(CHDIR)
-#if defined(CERNLIB_VAXVMS)
- ENTRY HREND(CHDIR)
-#endif
-*.==========>
-*. Close an HBOOK/RZ file.
-*. This routine is a copy of HRENDC, make changes in both at the
-*. same time.
-*..=========>
-#include "hbook/hcdire.inc"
- CHARACTER*(*) CHDIR
-*.___________________________________________
-*
-*
- NCHMAX=NCHTOP
- DO 20 I=2,NCHMAX
- IF(CHTOP(I).EQ.CHDIR)THEN
- IF(ICHTOP(I).GT.0.AND.ICHTOP(I).LT.1000)THEN
- CALL RZEND(CHDIR)
- CALL HBFREE(ICHTOP(I))
- ENDIF
- CALL HNTDEL(CHDIR)
-*
- DO 10 J=I+1,NCHTOP
- ICHTOP(J-1)=ICHTOP(J)
- ICHLUN(J-1)=ICHLUN(J)
- ICHTYP(J-1)=ICHTYP(J)
- CHTOP(J-1)=CHTOP(J)
- HFNAME(J-1)=HFNAME(J)
- 10 CONTINUE
- NCHTOP=NCHTOP-1
- ENDIF
- 20 CONTINUE
-*
- CALL HCDIR('//PAWC',' ')
-*
- END
diff --git a/src/packlib/hbook/hrz/hrenid.F b/src/packlib/hbook/hrz/hrenid.F
deleted file mode 100644
index d3f3f42..0000000
--- a/src/packlib/hbook/hrz/hrenid.F
+++ /dev/null
@@ -1,67 +0,0 @@
-*
-* $Id: hrenid.F,v 1.2 1997/01/17 09:10:41 couet Exp $
-*
-* $Log: hrenid.F,v $
-* Revision 1.2 1997/01/17 09:10:41 couet
-* - This routine didn't work for more that one histogram because some
-* initialisation was missing. Note that the problem was not vissible on
-* HPUX 9 but was on all other platforms.
-*
-* Revision 1.1.1.1 1996/01/16 17:08:08 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 24/10/95 14.32.18 by Julian Bunn
-*-- Author : Rene Brun 13/11/91
- SUBROUTINE HRENID(IDOLD,IDNEW)
-*.==========>
-*. To Rename Object IDOLD to IDNEW in the current
-*. directory on RZ file
-*..=========> ( R.Brun )
-#include "hbook/hcdire.inc"
- COMMON/QUEST/IQUEST(100)
- DIMENSION KIDOLD(2),KIDNEW(2)
-*.___________________________________________
-*
-* Check if IDOLD exists
-*
- KIDOLD(1)=IDOLD
- KIDOLD(2)=0
- CALL RZINK(KIDOLD,99999,' ')
- IF(IQUEST(1).NE.0)THEN
- CALL HBUG('Unknown histogram','HRENID',IDOLD)
- GO TO 99
- ENDIF
-*
-* Check if IDNEW already exists
-*
- KIDNEW(1)=IDNEW
- KIDNEW(2)=0
- CALL RZINK(KIDNEW,99999,' ')
- IF(IQUEST(1).EQ.0)THEN
- CALL HBUG('Already existing identifier: cannot rename',
- + 'HRENID',IDNEW)
- IQUEST(1)=0
- GO TO 99
- ENDIF
-*
-* Rename top object
-* Check if ntuple extensions exist, if YES must loop
-*
- CALL RZCDIR(' ',' ')
- NKEYS = IQUEST(7)
- DO 10 IKEY=1,NKEYS
- CALL RZINK(IKEY,99999,'SC')
- IF(IQUEST(1).NE.0)GO TO 90
- IF(IQUEST(21).NE.IDOLD)GO TO 10
- KIDOLD(1)=IDOLD
- KIDOLD(2)=IQUEST(22)
- KIDNEW(1)=IDNEW
- KIDNEW(2)=IQUEST(22)
- CALL RZRENK(KIDOLD,KIDNEW)
- IF(IQUEST(1).NE.0)GO TO 90
- 10 CONTINUE
-*
- 90 CALL RZSAVE
- 99 END
diff --git a/src/packlib/hbook/hrz/hrfile.F b/src/packlib/hbook/hrz/hrfile.F
deleted file mode 100644
index c53dc4d..0000000
--- a/src/packlib/hbook/hrz/hrfile.F
+++ /dev/null
@@ -1,123 +0,0 @@
-*
-* $Id: hrfile.F,v 1.2 2001/12/12 16:21:52 couet Exp $
-*
-* $Log: hrfile.F,v $
-* Revision 1.2 2001/12/12 16:21:52 couet
-* - New option E. Used with the option Q, this option gives the possibility to
-* create HBOOK files with up to 2**32 records. This uses of the option N
-* of RZMAKE. This option (E) is also available via HROPEN. For example:
-*
-* IQUEST(10)=256 000
-* CALL HROPEN(1,'EXAMPLE','example.rz','NQE',LREC,ISTAT)
-*
-* Revision 1.1.1.1 1996/01/16 17:08:08 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.22/13 22/09/94 16.21.15 by Rene Brun
-*-- Author :
- SUBROUTINE HRFILE(LUN,CHDIR,CHOPT)
-*.==========>
-*. OPEN a new HBOOK/RZ file if CHOPT='N'
-*. OPEN an existing HBOOK/RZ file if CHOPT=' '
-*. If option 'G' assumes Global section being defined
-*. Global section start at address LUN
-*. If option 'M' assumes Global memory being defined
-*. Global memory start at address LUN
-*. If option 'Q' the allocation for the file is
-*. given by user in IQUEST(10)
-*. If option 'QE' the allocation for the file is
-*. given by user in IQUEST(10) but in an Extended way ie:
-*. the file can have up to 2**32 records instead of 2**16
-*. with the option Q
-*. If option 'C' the record length is given via IQUEST(99)
-*..=========> ( R.Brun )
-#include "hbook/hcdire.inc"
-#include "hbook/hcmail.inc"
- COMMON/QUEST/IQUEST(100)
- CHARACTER*(*) CHDIR,CHOPT
- CHARACTER*8 TAGS(2),CHOPTT
- DIMENSION IOPT(6)
- EQUIVALENCE (IOPTN,IOPT(1)),(IOPTG,IOPT(2)),(IOPTQ,IOPT(3))
- EQUIVALENCE (IOPTM,IOPT(4)),(IOPTO,IOPT(5)),(IOPTE,IOPT(6))
-*.___________________________________________
-*
- IF(NCHTOP.GE.MXFILES)THEN
- CALL HBUG('Too many open files','HRFILE',LUN)
- GO TO 99
- ENDIF
-*
- CALL HUOPTC(CHOPT,'NGQMOE',IOPT)
- IF(IOPTM.NE.0)IOPTG=1
-*
- IQUEST(1)=0
- IF(IOPTG.EQ.0)THEN
- IF(IOPTN.NE.0)THEN
- IF(IOPTQ.NE.0)THEN
- NQUOT=IQUEST(10)
- IF(NQUOT.LT.100)NQUOT=100
- IF(NQUOT.GT.65000.AND.IOPTE.EQ.0)NQUOT=65000
- ELSE
- NQUOT=32000
- ENDIF
- TAGS(1) = 'HBOOK-ID'
- TAGS(2) = 'VARIABLE'
- NCH=LENOCC(CHOPT)
- IF(NCH.EQ.0)THEN
- CHOPTT='X'
- ELSE
- CHOPTT='X'//CHOPT(1:NCH)
- ENDIF
- CALL CLTOU(CHOPTT)
-*-* option 'N' is a new option in ZEBRA (new format with 7 words/key)
- I=INDEX(CHOPTT,'N')
- IF(I.NE.0)CHOPTT(I:I)='?'
-*-* option 'E' correspond to option 'N' in RZMAKE (to have 2**32 records)
- I=INDEX(CHOPTT,'E')
- IF(I.NE.0)CHOPTT(I:I)='N'
- IF(IOPTO.NE.0)THEN
- NWK=1
- CHOPTT(1:1)='?'
- ELSE
- NWK=2
- ENDIF
-*-- what a mess using IQUEST(10) for two different things
-*-- the guy who invented that should be punished (rdm)
- IQ10=IQUEST(10)
- IF(INDEX(CHOPT,'C').NE.0) IQUEST(10)=IQUEST(99)
- CALL RZMAKE(LUN,CHDIR,NWK,'II',TAGS,NQUOT,CHOPTT)
- IQUEST(10)=IQ10
- ELSE
- IQ10=IQUEST(10)
- IF(INDEX(CHOPT,'C').NE.0) IQUEST(10)=IQUEST(99)
- CALL RZFILE(LUN,CHDIR,CHOPT)
- IQUEST(10)=IQ10
- IF(IQUEST(1).EQ.2)IQUEST(1)=0
- NWK=IQUEST(8)
- ENDIF
- ENDIF
- IF(IQUEST(1).NE.0)RETURN
-*
- NCHTOP=NCHTOP+1
- CHTOP(NCHTOP)=CHDIR
- ICHLUN(NCHTOP)=0
- IF(IOPTG.EQ.0)THEN
- ICHTOP(NCHTOP)=LUN
- ICHTYP(NCHTOP)=NWK
- HFNAME(NCHTOP)=CHDIR
- ELSE
- ICHTOP(NCHTOP)=-LOCF(LUN)
- ICHTYP(NCHTOP)=0
- IF(IOPTM.EQ.0)THEN
- HFNAME(NCHTOP)='Global section - '//CHDIR
- ELSE
- HFNAME(NCHTOP)='Global memory - '//CHDIR
- ENDIF
- ENDIF
-*
- 10 CHMAIL='//'//CHTOP(NCHTOP)
- CALL HCDIR(CHMAIL,' ')
-*
- 99 RETURN
- END
diff --git a/src/packlib/hbook/hrz/hrget.F b/src/packlib/hbook/hrz/hrget.F
deleted file mode 100644
index b8abee1..0000000
--- a/src/packlib/hbook/hrz/hrget.F
+++ /dev/null
@@ -1,65 +0,0 @@
-*
-* $Id: hrget.F,v 1.4 1997/01/21 13:19:06 couet Exp $
-*
-* $Log: hrget.F,v $
-* Revision 1.4 1997/01/21 13:19:06 couet
-* - Call hrendc instead of hrend
-*
-* Revision 1.3 1996/03/14 08:33:55 couet
-* Mods from Detlef Irmscher <irmscher at rnchp3.lbl.gov> it now puts the tree into
-* the directory one is presently in.
-*
-* Revision 1.2 1996/02/22 09:10:48 couet
-* Mod suggested by Rene Brun to reconstruct a file structure in memory.
-*
-* Revision 1.1.1.1 1996/01/16 17:08:08 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.10/05 11/07/90 18.37.27 by Rene Brun
-*-- Author :
- SUBROUTINE HRGET(ID,CHFILE,CHOPT)
-*.==========>
-*. To get histogram(s) from file CHFILE
-*. CHOPT='T' Get complete Tree
-*. CHOPT='A' Add to current histogram in memory
-*..=========> ( R.Brun )
- CHARACTER*(*) CHFILE,CHOPT
- CHARACTER*256 DIRECTORY
- COMMON /HRGETDIR/ DIRECTORY, LENDIR
- DIMENSION IOPT(2)
- EQUIVALENCE (IOPTT,IOPT(1)),(IOPTA,IOPT(2))
- EXTERNAL HREADONEDIR
-*.___________________________________________
-*
- CALL HUOPTC(CHOPT,'TA',IOPT)
- IF(ID.NE.0)IOPTT=0
- IF(IOPTT.NE.0)THEN
- ICYCLE=9999
- ELSE
- ICYCLE=999
- ENDIF
- IF(IOPTA.NE.0)THEN
- IOF=99999
- ELSE
- IOF=0
- ENDIF
- NCH=LENOCC(CHFILE)
- CALL HCDIR (DIRECTORY, 'R')
- LENDIR = LENOCC(DIRECTORY)
- IF(NCH.GT.0)THEN
- CALL HROPEN(88,'HRGET',CHFILE,' ',1024,ISTAT)
- IF(ISTAT.NE.0)GO TO 99
- CALL HRIN(ID,ICYCLE,IOF)
- IF (ICYCLE.EQ.9999) THEN
- CALL RZSCAN(' ',HREADONEDIR)
- ENDIF
- CALL HRENDC('HRGET')
- CLOSE(88)
- ELSE
- CALL HRIN(ID,ICYCLE,IOF)
- ENDIF
-*
- CALL HCDIR (DIRECTORY, ' ')
- 99 END
diff --git a/src/packlib/hbook/hrz/hrin.F b/src/packlib/hbook/hrz/hrin.F
deleted file mode 100644
index 7e5bf6e..0000000
--- a/src/packlib/hbook/hrz/hrin.F
+++ /dev/null
@@ -1,265 +0,0 @@
-*
-* $Id: hrin.F,v 1.1.1.1 1996/01/16 17:08:08 mclareni Exp $
-*
-* $Log: hrin.F,v $
-* Revision 1.1.1.1 1996/01/16 17:08:08 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.22/14 06/10/94 15.43.19 by Fons Rademakers
-*-- Author :
- SUBROUTINE HRIN(IDD,ICYCLE,KOFSET)
-*.==========>
-*. Read histogram IDD from current directory (RZ or GLOBAL)
-*. The histogram stored in memory will be IDD+IOFSET
-*..=========> ( R.Brun )
-#include "hbook/hcntpar.inc"
-#include "hbook/hntcur.inc"
-#include "hbook/hcbook.inc"
-#include "hbook/hcflag.inc"
-#include "hbook/hcdire.inc"
-*
- COMMON/QUEST/IQUEST(100)
- CHARACTER*128 CHWOLD
- INTEGER KEYS(2)
- DATA KHIDE,KHID1,KHID2,KHCO1,KHCO2/4HHIDE,4HHID1,4HHID2,
- + 4hHCO1,4HHCO2/
-*.___________________________________________
-*
-* Check if directory in GLOBAL SECTION
-*
- IOFSET=KOFSET
- IF(ICHTOP(ICDIR).LT.0)THEN
- IF(INDEX(HFNAME(ICDIR),'memory').NE.0)THEN
- LOCQ=1-LOCF(IQUEST(1))-ICHTOP(ICDIR)
- CALL HCOPYU(IDD,IQUEST(LOCQ),IOFSET)
- ELSE
- LOCQ=1-LOCF(IQUEST(1))-ICHTOP(ICDIR)
- CALL HCOPYM(IDD,IQUEST(LOCQ),IOFSET)
- ENDIF
- CALL SBIT1(IQ(LCID),5)
- GO TO 80
- ENDIF
- IF(ICYCLE.GT.1000.AND.IDD.EQ.0)THEN
- CALL HPAFF(CHCDIR,NLCDIR,CHWOLD)
- LQ(LHBOOK-NLPAT-10)=LCDIR
- ENDIF
-*
- NRHIST=IQ(LCDIR+KNRH)
- IF(KOFSET.EQ.99999.AND.NRHIST.GT.0)THEN
- IF(IQ(LTAB+NRHIST).GE.KOFSET)IOFSET=IQ(LTAB+NRHIST)+1000000
- ENDIF
- KEYS(2) = 0
- IQ42=0
-*
-* If IDD=0 find first ID in the RZ directory
-*
- IDN=IDD
- IF(IDD.EQ.0)THEN
- KEYS(1) = 1
- CALL HRZIN(IHDIV,0,0,KEYS,9999,'SC')
- IDN=IQUEST(21)
- IQ42=IQUEST(22)
- ENDIF
-
-* Check if ID already in the table
-*
- 10 ID=IDN+IOFSET
- NRHIST=IQ(LCDIR+KNRH)
- IDPOS=LOCATI(IQ(LTAB+1),NRHIST,ID)
- INMEM=0
- IF(IDPOS.GT.0)THEN
- LC=LQ(LTAB-IDPOS)
- IF(JBIT(IQ(LC),5).EQ.0)THEN
- INMEM=1
- ELSE
- CALL HBUG('+Already existing histogram replaced','HRIN',ID)
- CALL HDELET(ID)
- NRHIST=IQ(LCDIR+KNRH)
- IDPOS=-IDPOS+1
- ENDIF
- ENDIF
-*
-* Enough space left ?
-*
- KEYS(1) = IDN
- KEYS(2) = IQ42
- CALL HRZIN(IHDIV,0,0,KEYS,ICYCLE,'NC')
- IF(IQUEST(1).NE.0)GO TO 70
- IQ40=IQUEST(40)
- IQ41=IQUEST(41)
- IQ42=IQUEST(42)
- NWORDS=IQUEST(12)
- IOPTA=JBIT(IQUEST(14),4)
- IF(IOPTA.NE.0)GO TO 60
- IF(INMEM.NE.0)GO TO 60
- CALL HSPACE(NWORDS+1000,'HRIN ',IDD)
- IF(IERR.NE.0) GO TO 70
-*
-* Enter ID in the list of ordered IDs
-*
- IDPOS=-IDPOS+1
- IF(NRHIST.GE.IQ(LTAB-1))THEN
- CALL MZPUSH(IHDIV,LTAB,500,500,' ')
- ENDIF
- DO 20 I=NRHIST,IDPOS,-1
- IQ(LTAB+I+1)=IQ(LTAB+I)
- LQ(LTAB-I-1)=LQ(LTAB-I)
- 20 CONTINUE
-*
-* Read histogram data structure
-*
- IF(LIDS.EQ.0)THEN
- KEYS(1) = IDN
- CALL HRZIN(IHDIV,LCDIR,-2,KEYS,ICYCLE,'ND')
- IF(IQUEST(1).NE.0)THEN
- CALL HBUG('Bad sequence for RZ','HRIN',IDN)
- GO TO 70
- ENDIF
- LIDS=LQ(LCDIR-2)
- LCID=LIDS
- ELSE
- LLID=LQ(LCDIR-9)
- KEYS(1) = IDN
- CALL HRZIN(IHDIV,LLID, 0,KEYS,ICYCLE,'ND')
- IF(IQUEST(1).NE.0)THEN
- CALL HBUG('Bad sequence for RZ','HRIN',IDN)
- GO TO 70
- ENDIF
- LCID=LQ(LLID)
- ENDIF
- IQ(LCID-5)=ID
- LQ(LCDIR-9)=LCID
- IQ(LCDIR+KNRH)=IQ(LCDIR+KNRH)+1
- IQ(LTAB+IDPOS)=ID
- LQ(LTAB-IDPOS)=LCID
- CALL SBIT1(IQ(LCID),5)
- IF(JBIT(IQ(LCID+KBITS),1).NE.0)THEN
- IF(IQ(LCID-4).EQ.KHIDE)THEN
- IQ(LCID-4)=KHID1
- L=LQ(LCID-1)
- IF(L.NE.0)IQ(L-4)=KHCO1
- ENDIF
- ENDIF
- IF(JBYT(IQ(LCID+KBITS),2,2).NE.0)THEN
- IF(IQ(LCID-4).EQ.KHIDE)THEN
- IQ(LCID-4)=KHID2
- L=LQ(LCID-1)
- IF(L.NE.0)IQ(L-4)=KHCO2
- ENDIF
-*-- check old style convention for KMIN2/KMAX2
-*** This code can only be introduced when version 4.19 or later
-* will be largely disseminated
-*** IOLD2=0
-*** J20=JBIT(IQ(LCID+KBITS),20)
-*** J21=JBIT(IQ(LCID+KBITS),21)
-*** IF(J20.EQ.0.AND.Q(LCID+KMAX2).NE.0.)IOLD2=1
-*** IF(J21.EQ.0.AND.Q(LCID+KMIN2).NE.0.)IOLD2=1
-*** IF(IOLD2.NE.0)THEN
-*** Q(LCID+KMAX2)=0.
-*** Q(LCID+KMIN2)=0.
-*** IF(J20.NE.0)Q(LCID+KMAX2)=Q(LCID+KSCAL2)
-*** IF(J21.NE.0)Q(LCID+KMIN2)=Q(LCID+KSCAL2)
-*** ENDIF
- ENDIF
- IF(JBIT(IQ(LCID+KBITS),4).NE.0)THEN
-*
-*-- old n-tuple
-*
- IF (IQ(LCID-2) .EQ. 2) THEN
-** IF(IOFSET.NE.0)THEN
-** CALL HDELET(ID)
-** CALL HBUG('IOFSET must be 0 for ntuples','HRIN',ID)
-** GO TO 60
-** ENDIF
- NCHRZ=IQ(LCID+11)
- IF(NCHRZ.LE.0)GO TO 30
- ITAG1=IQ(LCID+10)
- NW=IQ(LCID-1)-ITAG1+1
- NPLUS=32-ITAG1
- IF(NPLUS.GT.0)THEN
- CALL MZPUSH(IHDIV,LCID,0,NPLUS,' ')
- CALL UCOPY2(IQ(LCID+ITAG1),IQ(LCID+32),NW)
- IQ(LCID+9)=IQ(LCID+9)+NPLUS
- IQ(LCID+10)=32
- ENDIF
- CALL HPAFF(CHCDIR,NLCDIR,CHWOLD)
- NCHRZ=LENOCC(CHWOLD)
- CALL UCTOH(CHWOLD,IQ(LCID+12),4,NCHRZ)
- IQ(LCID+11)=NCHRZ
- 30 IQ(LCID)=9999
- LC=LQ(LCID-1)
- CALL SBIT0(IQ(LC),1)
-* If memory-resident Ntuple, compute pointers to banks
- IF(NCHRZ.LE.0)THEN
- NMORE=IQ(LCID+5)+3-IQ(LCID-3)
- IF(NMORE.GT.0)THEN
- CALL MZPUSH(IHDIV,LCID,NMORE,0,' ')
- ENDIF
- IF(IQ(LCID+5).GE.1)THEN
- DO 40 IB=1,IQ(LCID+5)
- LQ(LCID-3-IB)=LC
- LC=LQ(LC)
- IF(LC.EQ.0)THEN
- LC=LQ(LCID-1)
- GO TO 60
- ENDIF
- 40 CONTINUE
- LC=LQ(LCID-1)
- ENDIF
- ELSE
-* If disk-resident Ntuple, compute pointers to KEYS
- IF(ICHTOP(ICDIR).LT.1000)CALL HRZKEY(IDN)
-* save ID in data structure in case of offset
- IQ(LCID+5)=IDN
- ENDIF
- GO TO 60
-*
-*-- new n-tuple
-*
- ELSE
- NCHRZ=IQ(LCID+ZNCHRZ)
- IF(NCHRZ.LE.0)GO TO 50
- ITIT1=IQ(LCID+ZITIT1)
- NW=IQ(LCID-1)-ITIT1+1
- NPLUS=34-ITIT1
- IF(NPLUS.GT.0)THEN
- CALL MZPUSH(IHDIV,LCID,0,NPLUS,' ')
- CALL UCOPY2(IQ(LCID+ITIT1),IQ(LCID+34),NW)
- IQ(LCID+ZITIT1)=34
- ENDIF
- CALL HPAFF(CHCDIR,NLCDIR,CHWOLD)
- NCHRZ=LENOCC(CHWOLD)
- CALL UCTOH(CHWOLD,IQ(LCID+ZNCHRZ+1),4,NCHRZ)
- IQ(LCID+ZNCHRZ)=NCHRZ
- 50 IQ(LCID)=9999
- LC = LQ(LCID-1)
- CALL SBIT0(IQ(LC),1)
- CALL SBIT0(IQ(LC),2)
- CALL SBIT0(IQ(LC),3)
- CALL HNMSET(ID,ZIBANK,0)
- CALL HNMSET(ID,ZITMP,0)
- IQ(LCID+ZIFTMP) = 2
- IQ(LCID+ZID) = IDN
- NTCUR = 0
- GO TO 60
- ENDIF
- ENDIF
-*
-* Add option ?
-*
- IF(KOFSET.EQ.99999)THEN
- ID2=ID
- CALL HOPERA(IDN,'+',ID2,IDN,1.,1.)
- CALL HDELET(ID2)
- ENDIF
-*
- 60 IF(IQ40.EQ.0)GO TO 80
- IDN=IQ41
- IF(IDD.EQ.0)GO TO 10
-*
- 70 CONTINUE
-*
- 80 RETURN
- END
diff --git a/src/packlib/hbook/hrz/hrmake.F b/src/packlib/hbook/hrz/hrmake.F
deleted file mode 100644
index 8b114d7..0000000
--- a/src/packlib/hbook/hrz/hrmake.F
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: hrmake.F,v 1.1.1.1 1996/01/16 17:08:08 mclareni Exp $
-*
-* $Log: hrmake.F,v $
-* Revision 1.1.1.1 1996/01/16 17:08:08 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.17/01 08/10/92 18.35.45 by Fons Rademakers
-*-- Author :
- SUBROUTINE HRMAKE(LUN,CHDIR,NREC,CHOPT)
-*.==========>
-*. Create a HBOOK/RZ file
-*..=========> ( R.Brun )
- CHARACTER*(*) CHDIR,CHOPT
- CHARACTER*8 TAGS(2)
-*.___________________________________________
-*
- TAGS(1) = 'HBOOK-ID'
- TAGS(2) = 'VARIABLE'
- CALL RZMAKE(LUN,CHDIR,2,'II',TAGS,NREC,CHOPT)
-*
- END
diff --git a/src/packlib/hbook/hrz/hrmdir.F b/src/packlib/hbook/hrz/hrmdir.F
deleted file mode 100644
index 2dd9633..0000000
--- a/src/packlib/hbook/hrz/hrmdir.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: hrmdir.F,v 1.1.1.1 1996/01/16 17:08:08 mclareni Exp $
-*
-* $Log: hrmdir.F,v $
-* Revision 1.1.1.1 1996/01/16 17:08:08 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.17/04 20/01/93 08.08.58 by Rene Brun
-*-- Author :
- SUBROUTINE HRMDIR(CHDIR,CHOPT)
-*.==========>
-*. Create an HBOOK/RZ subdirectory
-*..=========> ( R.Brun )
- CHARACTER*(*) CHDIR
- CHARACTER*8 TAGS(2)
-#include "hbook/hcdire.inc"
-*.___________________________________________
-*
- TAGS(1) = 'HBOOK-ID'
- TAGS(2) = 'VARIABLE'
- NWK=ICHTYP(ICDIR)
- CALL RZMDIR(CHDIR,NWK,'II',TAGS)
-*
- END
diff --git a/src/packlib/hbook/hrz/hropen.F b/src/packlib/hbook/hrz/hropen.F
deleted file mode 100644
index 85821e8..0000000
--- a/src/packlib/hbook/hrz/hropen.F
+++ /dev/null
@@ -1,82 +0,0 @@
-*
-* $Id: hropen.F,v 1.5 1998/03/18 16:59:41 couet Exp $
-*
-* $Log: hropen.F,v $
-* Revision 1.5 1998/03/18 16:59:41 couet
-* - FORTRAN I/O is the default for VMS
-*
-* Revision 1.4 1997/05/13 15:21:01 couet
-* - default is now C/IO for all machines. To have fortran IO the option F should
-* be given to HROPEN and the file should be close with HRENDF. HREND is now
-* equivalent to HRENDC.
-*
-* Revision 1.3 1997/01/24 17:00:11 gunter
-* add passing on of eXchange format
-*
-* Revision 1.2 1996/08/28 09:49:17 couet
-* - Option C to call rzopen
-*
-* Revision 1.1.1.1 1996/01/16 17:08:08 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.21/11 04/03/94 19.35.51 by Fons Rademakers
-*-- Author :
- SUBROUTINE HROPEN(LUN,CHDIR,CFNAME,CHOPTT,LRECL,ISTAT)
-*.==========>
-*. Open an HBOOK/RZ file
-*..=========> ( R.Brun )
-#include "hbook/hcdire.inc"
- COMMON/QUEST/IQUEST(100)
- CHARACTER*(*) CFNAME,CHDIR,CHOPTT
- CHARACTER*8 CHOPT
-*.___________________________________________
-*
- CHOPT=CHOPTT
- CALL CLTOU(CHOPT)
-*
- DO 10 I=1,NCHTOP
- IF(CFNAME.EQ.HFNAME(I))THEN
- CALL HBUG('File already connected','HROPEN',0)
- GO TO 99
- ENDIF
- 10 CONTINUE
-*
- IQ10=IQUEST(10)
-#if !defined(CERNLIB_VAXVMS)
-* C/IO is the default. Option F set FORTRAN IO.
- IF (INDEX(CHOPT,'F').EQ.0) THEN
- IC = MIN(LENOCC(CHOPT)+1,8)
- CHOPT(IC:IC) = 'C'
- ENDIF
-#endif
-*
- CALL RZOPEN(LUN,CHDIR,CFNAME,CHOPT,LRECL,ISTAT)
- 90 IF(ISTAT.NE.0)THEN
- CALL HBUG('Cannot open file','HROPEN',0)
- GO TO 99
- ENDIF
-
- IF (IQUEST(12).NE.0 ) THEN
-* file is in exchange mode, this to hrfile/rzfile
- IC = MIN(LENOCC(CHOPT)+1,8)
- CHOPT(IC:IC) = 'X'
- ENDIF
-
- LRE=IQUEST(10)
-*
- IQUEST(10)=IQ10
- IQUEST(99)=LRE
- CALL HRFILE(LUN,CHDIR,CHOPT)
- IF(IQUEST(1).NE.0)THEN
- ISTAT=IQUEST(1)
- CALL RZEND(CHDIR)
- CLOSE(LUN)
- GO TO 90
- ENDIF
- IF(ICDIR.GT.0)HFNAME(ICDIR)=CFNAME
- IF(INDEX(CHOPT,'Q').EQ.0)IQUEST(10)=LRE
-*
-99 RETURN
- END
diff --git a/src/packlib/hbook/hrz/hrout.F b/src/packlib/hbook/hrz/hrout.F
deleted file mode 100644
index bd38f85..0000000
--- a/src/packlib/hbook/hrz/hrout.F
+++ /dev/null
@@ -1,195 +0,0 @@
-*
-* $Id: hrout.F,v 1.1.1.1 1996/01/16 17:08:08 mclareni Exp $
-*
-* $Log: hrout.F,v $
-* Revision 1.1.1.1 1996/01/16 17:08:08 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.23/01 07/02/95 09.07.24 by Rene Brun
-*-- Author :
- SUBROUTINE HROUT(IDD,ICYCLE,CHOPT)
-*.==========>
-*. Store histogram IDD on RZ file at current directory
-*. If option 'T' and IDD=0 save all subdirectories as well
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
-#include "hbook/hcflag.inc"
-#include "hbook/hcdire.inc"
-#include "hbook/hcntpar.inc"
- COMMON/QUEST/IQUEST(100)
- CHARACTER*(*) CHOPT
- CHARACTER*128 CHWOLD
- CHARACTER*128 CHOLD, CHDIR, CWDRZ
- INTEGER IOPT(2), KEYS(2)
- EQUIVALENCE (IOPTT,IOPT(1)),(IOPTN,IOPT(2))
-*.___________________________________________
-*
- IQUEST(1)=0
- IF(ICHTOP(ICDIR).LE.0)THEN
- CALL HBUG('Current Directory must be a RZ file','HROUT',IDD)
- IQUEST(1)=1
- RETURN
- ENDIF
-*
- CALL HUOPTC (CHOPT,'TN',IOPT)
- IF(IDD.NE.0)IOPTT=0
- IF(IOPTT.NE.0)THEN
- CALL HPAFF(CHCDIR,NLCDIR,CHWOLD)
- KLPAT0=NLPAT
- KLPAT=NLPAT
- LQ(LHBOOK-10-KLPAT)=LCDIR
- ENDIF
-*
- KEYS(2) = 0
-*
- IRET = 3
-*
-* Save Histogram(s) in Current Directory
-*
- 10 CALL HLOOP (IDD,'HROUT ',IRET)
- IF (IRET .EQ. 0) GO TO 15
- I4=JBIT(IQ(LCID+KBITS),4)
- IF(I4.NE.0)THEN
- LC=LQ(LCID-1)
- IF (IQ(LCID-2) .NE. 2) THEN
-*-- new N-tuple: write buffers and header
- CALL HNBFWR(ID)
- LC=LQ(LCID-1)
- IF (JBIT(IQ(LC),1) .EQ. 0) THEN
- IRET = 2
- GOTO 10
- ENDIF
-*-- goto the correct RZ directory
- NCHRZ = IQ(LCID+ZNCHRZ)
- IF(NCHRZ.NE.0)THEN
- CALL RZCDIR(CWDRZ,'R')
- CALL HCDIR(CHOLD,'R')
- CHDIR = ' '
- CALL UHTOC(IQ(LCID+ZNCHRZ+1),4,CHDIR,NCHRZ)
- IF (CHDIR .NE. CWDRZ) THEN
- CALL HCDIR(CHDIR,' ')
- ENDIF
- ENDIF
- LC=LQ(LCID-1)
- ENDIF
- CALL SBIT0(IQ(LC),1)
- ENDIF
- KEYS(1) = ID
- CALL HRZOUT(IHDIV,LCID,KEYS,ICYCLE,' ')
- IF(I4.NE.0)THEN
- IF (IQ(LCID-2) .EQ. 2) THEN
- LC=LQ(LCID-1)
- CALL SBIT1(IQ(LC),1)
- ELSE
-*-- go back to the current directory
- IF (NCHRZ.NE.0.AND.CHDIR .NE. CWDRZ) THEN
- CALL HCDIR(CHOLD,' ')
- IF (CHOLD .NE. CWDRZ) THEN
- CALL RZCDIR(CWDRZ,' ')
- ENDIF
- ENDIF
- ENDIF
- ENDIF
- IRET = 2
- IF(IQUEST(1).EQ.0)GO TO 10
-*
- CALL HBUG('Problems with file','HROUT',ID)
- GO TO 99
-*
-* Save Histogram(s) in Subdirectories if option 'T'
-*
- 15 IF(IOPTT.NE.0)THEN
- 20 KLPAT=KLPAT+1
- IRET=3
- LCDIR=LQ(LCDIR-1)
- 30 LQ(LHBOOK-10-KLPAT)=LCDIR
- IF(LCDIR.EQ.0)THEN
- KLPAT=KLPAT-1
- NLCDIR = KLPAT
- LCDIR=LQ(LHBOOK-10-KLPAT)
- IF(KLPAT.LE.KLPAT0)GO TO 90
- LCDIR=LQ(LCDIR)
-#if !defined(CERNLIB_BSLASH)
- CALL RZCDIR('\',' ')
-#endif
-#if defined(CERNLIB_BSLASH)
- CALL RZCDIR('\\',' ')
-#endif
- GO TO 30
- ENDIF
- CALL UHTOC(IQ(LCDIR+1),4,CHCDIR(KLPAT),16)
- LIDS = LQ(LCDIR-2)
- LTAB = LQ(LCDIR-3)
- LBUFM = LQ(LCDIR-4)
- LTMPM = LQ(LCDIR-5)
- IF(IOPTN.NE.0)THEN
- CALL HMDIR(CHCDIR(KLPAT),'S')
- ELSE
- CALL HCDIR(CHCDIR(KLPAT),' ')
- IF(IQUEST(1).EQ.-1)THEN
- CALL HMDIR(CHCDIR(KLPAT),'S')
- ENDIF
- ENDIF
- IF(IQUEST(1).NE.0)GO TO 90
-*
- 40 CALL HLOOP (IDD,'HROUT ',IRET)
- IF (IRET .EQ. 0) GO TO 20
- I4=JBIT(IQ(LCID+KBITS),4)
- IF(I4.NE.0)THEN
- LC=LQ(LCID-1)
- IF (IQ(LCID-2) .NE. 2) THEN
-*-- new N-tuple: write buffers and header
- CALL HNBFWR(ID)
- LC=LQ(LCID-1)
- IF (JBIT(IQ(LC),1) .EQ. 0) THEN
- IRET = 2
- GOTO 40
- ENDIF
-*-- goto the correct RZ directory
- NCHRZ = IQ(LCID+ZNCHRZ)
- IF(NCHRZ.NE.0)THEN
- CALL RZCDIR(CWDRZ,'R')
- CALL HCDIR(CHOLD,'R')
- CHDIR = ' '
- CALL UHTOC(IQ(LCID+ZNCHRZ+1),4,CHDIR,NCHRZ)
- IF (CHDIR .NE. CWDRZ) THEN
- CALL HCDIR(CHDIR,' ')
- ENDIF
- ENDIF
- LC=LQ(LCID-1)
- CALL SBIT0(IQ(LC),2)
- ENDIF
- CALL SBIT0(IQ(LC),1)
- ENDIF
- KEYS(1) = ID
- CALL HRZOUT(IHDIV,LCID,KEYS,ICYCLE,' ')
- IF(I4.NE.0)THEN
- IF (IQ(LCID-2) .EQ. 2) THEN
- LC=LQ(LCID-1)
- CALL SBIT1(IQ(LC),1)
- ELSE
-*-- go back to the current directory
- IF (NCHRZ.NE.0.AND.CHDIR .NE. CWDRZ) THEN
- CALL HCDIR(CHOLD,' ')
- IF (CHOLD .NE. CWDRZ) THEN
- CALL RZCDIR(CWDRZ,' ')
- ENDIF
- ENDIF
- ENDIF
- ENDIF
- IRET = 2
- IF(IQUEST(1).EQ.0)GO TO 40
-*
- CALL HBUG('Problems with file','HROUT',ID)
- GO TO 99
-*
-* Restore Current Directory
-*
- 90 CALL HCDIR(CHWOLD,' ')
-*
- ENDIF
-*
- 99 RETURN
- END
diff --git a/src/packlib/hbook/hrz/hrput.F b/src/packlib/hbook/hrz/hrput.F
deleted file mode 100644
index 7e81ec2..0000000
--- a/src/packlib/hbook/hrz/hrput.F
+++ /dev/null
@@ -1,56 +0,0 @@
-*
-* $Id: hrput.F,v 1.2 1996/12/18 11:06:55 couet Exp $
-*
-* $Log: hrput.F,v $
-* Revision 1.2 1996/12/18 11:06:55 couet
-* - call now hrendc instead of hrend.
-*
-* Revision 1.1.1.1 1996/01/16 17:08:08 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.16/00 27/05/92 10.32.08 by Unknown
-*-- Author :
- SUBROUTINE HRPUT(ID,CHFILE,CHOPT)
-*.==========>
-*. To save histogram(s) on file CHFILE
-*. CHOPT='N' Create a New file
-*. ='U' Update existing file
-*. ='T' Save complete Tree
-*..=========> ( R.Brun )
- CHARACTER*(*) CHFILE,CHOPT
- CHARACTER*255 CHSAVE
- CHARACTER*1 CHOPT1
- CHARACTER*2 CHOPT2
- DIMENSION IOPT(3)
- EQUIVALENCE (IOPTT,IOPT(1)),(IOPTN,IOPT(2)),(IOPTU,IOPT(3))
-*.___________________________________________
-*
- CALL HUOPTC (CHOPT,'TNU',IOPT)
- IF(IOPTU.EQ.0)IOPTN=1
- IF(IOPTN.NE.0)THEN
- CHOPT1='N'
- ELSE
- CHOPT1='U'
- ENDIF
- IF(IOPTT.NE.0)THEN
- CHOPT2=CHOPT1//'T'
- ELSE
- CHOPT2=CHOPT1
- ENDIF
- NCH=LENOCC(CHFILE)
- IF(NCH.GT.0)THEN
- CALL RZCDIR(CHSAVE,'R')
- LSAVE = LENOCC(CHSAVE)
- CALL HROPEN(88,'HRPUT',CHFILE,CHOPT1,1024,ISTAT)
- IF(ISTAT.NE.0)GO TO 99
- CALL HROUT(ID,ICYCLE,CHOPT2)
- CALL HRENDC('HRPUT')
- CLOSE(88)
- CALL RZCDIR(CHSAVE(1:LSAVE),' ')
- ELSE
- CALL HROUT(ID,ICYCLE,CHOPT2)
- ENDIF
-*
- 99 END
diff --git a/src/packlib/hbook/hrz/hrsort.F b/src/packlib/hbook/hrz/hrsort.F
deleted file mode 100644
index 8263794..0000000
--- a/src/packlib/hbook/hrz/hrsort.F
+++ /dev/null
@@ -1,91 +0,0 @@
-*
-* $Id: hrsort.F,v 1.1.1.1 1996/01/16 17:08:08 mclareni Exp $
-*
-* $Log: hrsort.F,v $
-* Revision 1.1.1.1 1996/01/16 17:08:08 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.22/11 23/08/94 14.12.30 by Rene Brun
-*-- Author : Rene Brun 25/08/93
- SUBROUTINE HRSORT(CHOPT)
-*.==========>
-*. To sort the current RZ directory in increasing order of IDs
-*. If option 'S' directory in memory saved on file
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
-#include "hbook/hcdire.inc"
- COMMON /ZEBQ/ IQFENC(4), LQZ(100)
- DIMENSION IQZ(92)
- EQUIVALENCE (IQZ(1),LQZ(9))
- COMMON /MZCA/ NQSTOR,NQOFFT(16),NQOFFS(16),NQALLO(16), NQIAM
- +, LQATAB,LQASTO,LQBTIS, LQWKTB,NQWKTB,LQWKFZ
- +, MQKEYS(3),NQINIT,NQTSYS,NQM99,NQPERM,NQFATA,NQCASE
- +, NQTRAC,MQTRAC(48)
- EQUIVALENCE (KQSP,NQOFFS(1))
- COMMON/QUEST/IQUEST(100)
- CHARACTER*(*) CHOPT
-*.___________________________________________
-*
- CALL HUOPTC (CHOPT,'S',IOPTS)
- CALL RZCDIR(' ',' ')
-*
-*-- Get the pointers to the RZ directory
-*-- WARNING!! LCDIRZ might point in a primary store different from /PAWC/
- LCDIRZ=IQUEST(11)
- IF(LCDIRZ.EQ.0)GO TO 99
-*
- NKEYS = IQUEST(7)
- NWKEY = IQUEST(8)
- LK = IQUEST(13)
-*
-*-- store list of IDs in temporary bank in working space
- CALL MZBOOK(IHWORK,LHWORK,LHWORK,1,'HWOR',0,0,NKEYS,2,0)
- DO 20 I=1,NKEYS
- KI=LK+(NWKEY+1)*(I-1)
- IQ(LHWORK+I)=IQZ(KQSP+LCDIRZ+KI+1)
- 20 CONTINUE
-*
-*-- Sort IDs in increasing order
- NMODS=0
- DO 50 I=1,NKEYS-1
- KI=LK+(NWKEY+1)*(I-1)
- IPINT=IQZ(KQSP+LCDIRZ+KI)
- IF(JBIT(IQZ(KQSP+LCDIRZ+IPINT+1),4).NE.0)GO TO 50
- J =I+1
- 30 CONTINUE
- IF(IQ(LHWORK+I).GT.IQ(LHWORK+J))THEN
- KJ=LK+(NWKEY+1)*(J-1)
- NMODS=NMODS+1
- IDS =IQ(LHWORK+J)
- IQ(LHWORK+J)=IQ(LHWORK+I)
- IQ(LHWORK+I)=IDS
- IPINT=IQZ(KQSP+LCDIRZ+KJ)
- IQZ(KQSP+LCDIRZ+KJ ) =IQZ(KQSP+LCDIRZ+KI)
- IQZ(KQSP+LCDIRZ+KI ) =IPINT
- DO 40 II = 1,NWKEY
- IKD = IQZ(KQSP+LCDIRZ+KJ+II)
- IQZ(KQSP+LCDIRZ+KJ+II) = IQZ(KQSP+LCDIRZ+KI+II)
- IQZ(KQSP+LCDIRZ+KI+II) = IKD
- 40 CONTINUE
- ENDIF
- IF(J.EQ.NKEYS)GO TO 50
- J=J+1
- GO TO 30
- 50 CONTINUE
-*
- CALL MZDROP(IHWORK,LHWORK,' ')
-*
-*-- save directory in memory on RZ file
- LHWORK=0
- IF(NMODS.EQ.0)GO TO 99
- IF(JBIT(IQZ(KQSP+LCDIRZ),1).NE.0)GO TO 99
- IF(IOPTS.NE.0)THEN
- IFLAG=0
- CALL RZMODS('HRSORT',IFLAG)
- IF(IFLAG.NE.0)GO TO 99
- CALL RZSAVE
- ENDIF
-*
- 99 END
diff --git a/src/packlib/hbook/hrz/hrzcd.F b/src/packlib/hbook/hrz/hrzcd.F
deleted file mode 100644
index bc7f8f3..0000000
--- a/src/packlib/hbook/hrz/hrzcd.F
+++ /dev/null
@@ -1,37 +0,0 @@
-*
-* $Id: hrzcd.F,v 1.1.1.1 1996/01/16 17:08:08 mclareni Exp $
-*
-* $Log: hrzcd.F,v $
-* Revision 1.1.1.1 1996/01/16 17:08:08 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.21/08 28/01/94 15.21.52 by Fons Rademakers
-*-- Author :
- SUBROUTINE HRZCD(CHDIR,CHOPT)
-*.==========>
-*. to change the Current Directory of a RZ file
-*..=========> ( R.Brun )
-#include "hbook/hcdire.inc"
-#if defined(CERNLIB_CZ)
-#include "hbook/czsock.inc"
-#endif
- CHARACTER*(*)CHDIR,CHOPT
-*.___________________________________________
-*
- IF(ICHTOP(ICDIR).GT.1000)THEN
-#if defined(CERNLIB_CZ)
-*
- ISKIN =MOD(ICHTOP(ICDIR),10000)
- ISKOUT=(ICHTOP(ICDIR)-ISKIN)/10000
-#endif
-#if !defined(CERNLIB_CZ)
- CALL HBUG('CZ option not active','HRZCD',0)
-#endif
- RETURN
- ENDIF
-*
- CALL RZCDIR(CHDIR,CHOPT)
-*
- END
diff --git a/src/packlib/hbook/hrz/hrzin.F b/src/packlib/hbook/hrz/hrzin.F
deleted file mode 100644
index 5c9dc26..0000000
--- a/src/packlib/hbook/hrz/hrzin.F
+++ /dev/null
@@ -1,68 +0,0 @@
-*
-* $Id: hrzin.F,v 1.1.1.1 1996/01/16 17:08:08 mclareni Exp $
-*
-* $Log: hrzin.F,v $
-* Revision 1.1.1.1 1996/01/16 17:08:08 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.21/08 13/02/94 17.37.14 by Fons Rademakers
-*-- Author :
- SUBROUTINE HRZIN(IXDIV,LBANK,JBIAS,KEYS,ICYCLE,CHOPT)
-*.==========>
-*. to read a record from a RZ file
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
-#include "hbook/hcdire.inc"
-#include "hbook/hcmail.inc"
- COMMON/QUEST/IQUEST(100)
- DIMENSION LBANK(1),JBIAS(1)
-#if defined(CERNLIB_CZ)
- DIMENSION IQSAVE(100)
-#endif
- INTEGER KEYS(2)
- CHARACTER*(*)CHOPT
- CHARACTER*1 FCHOPT
- CHARACTER*8 CHOPT1
-*.___________________________________________
-*
- IF(ICHTOP(ICDIR).GT.1000)THEN
-#if defined(CERNLIB_CZ)
-*
-* Send message to the host
-*
- IF(LBANK(1).EQ.0.AND.JBIAS(1).LE.0)THEN
- FCHOPT='S'
- ELSE
- FCHOPT=' '
- ENDIF
- CHOPT1=CHOPT
- IF(CHOPT(1:1).EQ.'R')THEN
- CALL MZDROP(IXDIV,LQ(LBANK(1)+JBIAS(1)),' ')
- LQ(LBANK(1)+JBIAS(1))=0
- CHOPT1=' '
- ENDIF
- WRITE(CHMAIL,1000)KEYS(1),KEYS(2),ICYCLE,CHOPT1
- 1000 FORMAT('CZIN ',2I10,I10,2X,A)
- CALL CZPUTA(CHMAIL,ISTAT)
- IF (ISTAT .NE. 0) THEN
- IQUEST(1) = ISTAT
- RETURN
- ENDIF
-*
-* Read the ZEBRA data structure from host
-*
- NUH=100
- CALL FZIN(999,IXDIV,LBANK,JBIAS,FCHOPT,NUH,IQSAVE)
- CALL UCOPY(IQSAVE,IQUEST,100)
-#endif
-#if !defined(CERNLIB_CZ)
- CALL HBUG('CZ option not active','HRZIN',0)
-#endif
- RETURN
- ENDIF
-*
- CALL RZIN(IXDIV,LBANK,JBIAS,KEYS,ICYCLE,CHOPT)
-*
- END
diff --git a/src/packlib/hbook/hrz/hrzkey.F b/src/packlib/hbook/hrz/hrzkey.F
deleted file mode 100644
index dfd8531..0000000
--- a/src/packlib/hbook/hrz/hrzkey.F
+++ /dev/null
@@ -1,58 +0,0 @@
-*
-* $Id: hrzkey.F,v 1.1.1.1 1996/01/16 17:08:08 mclareni Exp $
-*
-* $Log: hrzkey.F,v $
-* Revision 1.1.1.1 1996/01/16 17:08:08 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.21/09 19/02/94 18.20.45 by Rene Brun
-*-- Author : Rene Brun 24/11/93
- SUBROUTINE HRZKEY(IDN)
-*.==========>
-*. Fill data structure with key serial numbers corresponding
-*. to ntuple extensions.
-*..=========> ( R.Brun )
-#include "hbook/hcbook.inc"
-#include "hbook/hcdire.inc"
- COMMON/QUEST/IQUEST(100)
- EQUIVALENCE (LK1,LHDUM(8))
- EQUIVALENCE (LK2,LHDUM(9))
-*.___________________________________________
-*
- CALL HRZIN(IHDIV,0,0,1,9999,'SC')
- NKEYS=IQUEST(7)
- NEXT=IQ(LCID+6)
-*-* do not built the structure if too few extensions or
-*-* if the ratio extensions/keys is too small
- IF(NEXT.LT.20)GO TO 99
- IF(10*NEXT.LT.NKEYS)GO TO 99
-*-* create (or extend) structure to store key serial numbers
- LK1=LQ(LCID-1)
- LK2=LQ(LK1)
- IF(LK2.LE.0)THEN
- CALL MZBOOK(IHDIV,LK2,LK1,0,'HKEY',0,0,NEXT,2,0)
- ELSE
- IF(IQ(LK2-1).LT.NEXT)THEN
- CALL MZPUSH(IHDIV,LK2,0,NEXT-IQ(LK2-1),' ')
- ENDIF
- ENDIF
-*
-*-* Now scan current RZ directory
-*
- DO 10 KEYRZ=1,NKEYS
- CALL HRZIN(IHDIV,0,0,KEYRZ,9999,'SC')
- IF(ICHTYP(ICDIR).EQ.1)THEN
- IEXT1=MOD(IQUEST(21),10000)
- IF(IEXT1.NE.IDN)GO TO 10
- IEXT=(IQUEST(21)-IEXT1)/10000
- ELSE
- IF(IQUEST(21).NE.IDN)GO TO 10
- IEXT=IQUEST(22)
- ENDIF
- IF(IEXT.LE.0.OR.IEXT.GT.NEXT)GO TO 10
- IQ(LK2+IEXT)=KEYRZ
- 10 CONTINUE
-*
- 99 END
diff --git a/src/packlib/hbook/hrz/hrzld.F b/src/packlib/hbook/hrz/hrzld.F
deleted file mode 100644
index 12c4c30..0000000
--- a/src/packlib/hbook/hrz/hrzld.F
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: hrzld.F,v 1.1.1.1 1996/01/16 17:08:08 mclareni Exp $
-*
-* $Log: hrzld.F,v $
-* Revision 1.1.1.1 1996/01/16 17:08:08 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.10/05 21/02/89 16.14.55 by Rene Brun
-*-- Author :
- SUBROUTINE HRZLD(CHDIR,CHOPT)
-*.==========>
-*. to list the Current Directory of a RZ file
-*..=========> ( R.Brun )
- CHARACTER*(*)CHDIR,CHOPT
-#include "hbook/hcdire.inc"
-*.___________________________________________
-*
- IF(ICHTOP(ICDIR).GT.1000)THEN
-#if defined(CERNLIB_CZ)
- CALL HBUG('Function not implemented for remote files',
- + 'HRZLD',0)
-#endif
-#if !defined(CERNLIB_CZ)
- CALL HBUG('CZ option not active','HRZLD',0)
-#endif
- RETURN
- ENDIF
-*
- CALL RZLDIR(CHDIR,CHOPT)
-*
- END
diff --git a/src/packlib/hbook/hrz/hrzout.F b/src/packlib/hbook/hrz/hrzout.F
deleted file mode 100644
index 1e2dc98..0000000
--- a/src/packlib/hbook/hrz/hrzout.F
+++ /dev/null
@@ -1,68 +0,0 @@
-*
-* $Id: hrzout.F,v 1.2 1996/03/08 13:03:30 julian Exp $
-*
-* $Log: hrzout.F,v $
-* Revision 1.2 1996/03/08 13:03:30 julian
-* Set iquest(1) to zero before call to rz. Avoids redundant error messages.
-*
-* Revision 1.1.1.1 1996/01/16 17:08:08 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.23/02 23/02/95 09.47.27 by Julian Bunn
-*-- Author :
- SUBROUTINE HRZOUT(IXDIV,LBANK,KEYS,ICYCLE,CHOPT)
-*.==========>
-*. to write a record to a RZ file r
-*..=========> ( R.Brun )
-#include "hbook/hcdire.inc"
-#include "hbook/hcmail.inc"
- COMMON/QUEST/IQUEST(100)
-#if defined(CERNLIB_CZ)
- DIMENSION IQSAVE(100)
-#endif
- CHARACTER*(*) CHOPT
- INTEGER KEYS(2)
-*.___________________________________________
-*
- IF(ICHTOP(ICDIR).GT.1000)THEN
-#if defined(CERNLIB_CZ)
-*
-* Send message to the host
-*
- WRITE(CHMAIL,1000)KEYS(1),KEYS(2),ICYCLE,CHOPT
- 1000 FORMAT('CZOUT ',2I10,I10,A)
- CALL CZPUTA(CHMAIL,ISTAT)
- IF (ISTAT .NE. 0) THEN
- IQUEST(1) = ISTAT
- RETURN
- ENDIF
-*
-* Write the ZEBRA data structure to the host
-*
- NUH=0
- CALL FZOUT(998,IXDIV,LBANK,1,' ',0,NUH,IQSAVE)
- IF(IQUEST(1).NE.0)GO TO 99
-*
-* Read the IQUEST vector
-*
- NUH=100
- CALL FZIN(999,IXDIV,0,1,' ',NUH,IQSAVE)
- CALL UCOPY(IQSAVE,IQUEST,100)
-#endif
-#if !defined(CERNLIB_CZ)
- CALL HBUG('CZ option not active','HRZOUT',0)
-#endif
- RETURN
- ENDIF
-*
- IQUEST(1) = 0
- CALL RZOUT(IXDIV,LBANK,KEYS,ICYCLE,CHOPT)
- IF(IQUEST(1).NE.0) THEN
- CALL HBUG('An error has occured whilst writing data',
- & 'HRZOUT',IQUEST(1))
- ENDIF
-*
- 99 RETURN
- END
diff --git a/src/packlib/hbook/hrz/hscr.F b/src/packlib/hbook/hrz/hscr.F
deleted file mode 100644
index ec70ef0..0000000
--- a/src/packlib/hbook/hrz/hscr.F
+++ /dev/null
@@ -1,44 +0,0 @@
-*
-* $Id: hscr.F,v 1.1.1.1 1996/01/16 17:08:08 mclareni Exp $
-*
-* $Log: hscr.F,v $
-* Revision 1.1.1.1 1996/01/16 17:08:08 mclareni
-* First import
-*
-*
-#include "hbook/pilot.h"
-*CMZ : 4.22/08 06/07/94 19.10.02 by Rene Brun
-*-- Author :
- SUBROUTINE HSCR(IDD,ICYCLE,CHOPT)
-*.==========>
-*. To scratch histogram ID from current directory
-*. on the RZ file.
-*..=========> ( R.Brun )
-#include "hbook/hcdire.inc"
- CHARACTER*(*) CHOPT
- COMMON/QUEST/IQUEST(100)
- DIMENSION KEYRZ(2)
-*.___________________________________________
-*
- IF(ICHTOP(ICDIR).EQ.0)THEN
- CALL HDELET(IDD)
- GO TO 99
- ENDIF
-*
- IF(IDD.EQ.0)THEN
- CALL RZDELK(IDD,ICYCLE,'K')
- ELSE
- IKS=0
- 10 IKS=IKS+1
- 20 CALL RZINK(IKS,ICYCLE,'S')
- IF(IQUEST(1).NE.0)GO TO 90
- KEYRZ(1)=IQUEST(21)
- KEYRZ(2)=IQUEST(22)
- IF(KEYRZ(1).NE.IDD)GO TO 10
- CALL RZDELK(KEYRZ,ICYCLE,CHOPT)
- IF(IQUEST(1).NE.0)GO TO 99
- GO TO 20
- ENDIF
- 90 CALL RZSAVE
- 99 RETURN
- END
diff --git a/src/packlib/hbook/obsolete/hbont.F b/src/packlib/hbook/obsolete/hbont.F
deleted file mode 100644
index b1de6a4..0000000
--- a/src/packlib/hbook/obsolete/hbont.F
+++ /dev/null
@@ -1,120 +0,0 @@
-*
-* $Id: hbont.F,v 1.1.1.1 1996/01/16 17:08:11 mclareni Exp $
-*
-* $Log: hbont.F,v $
-* Revision 1.1.1.1 1996/01/16 17:08:11 mclareni
-* First import
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_hbook/pilot.h"
-*CMZ : 4.21/08 17/01/94 12.31.07 by Rene Brun
-*-- Author :
- SUBROUTINE HBONT(ID,CHTITL,FORMP,CHOPT)
-*.==========>
-*. Creates an Omnipurpose Ntuple
-*.
-*. An Omnipurpose Ntuple is a Column-Wise-Ntuple. Each row of an ONT
-*. may contain up to 4 arrays depending on FORMP.
-*. Ex:
-*. CALL HBONT(ID,'Example','Z',' ')
-*. will create an ONT with the 3 arrays XONT,YONT,YONT in one ROW.
-*.
-*. Via FORMP the following, predefined, columns can be activated:
-*. X uses array X only
-*. Y uses arrays X and Y
-*. Z uses arrays X, Y and Z
-*. W uses arrays X, Y, Z and W
-*. C uses array CHONT (char*4)
-*.
-*. NB. Options X,Y,Z,W are mutual exclusive
-*. The (scalar) column KONTYP is always present.
-*.
-*. CHOPT has the same meaning as for HBNT. CHOPT='M' defines a
-*. memory resident Ntuple.
-*.
-*. To avoid users declaring the above structure, a set of service
-*. routines is provided to fill the internal HBOOK commons /HCBONT/.
-*. HFONTR(NONT,XONT,YONT,ZONT,WONT)
-*. HFONTC(NCHONT,CHONT)
-*.
-*. Once /HCBONT/ is filled via the above routines, the routine HFONT
-* must be used to fill the ONT.
-*. CALL HFONT(ID,KONTYP)
-*.
-*. In a symetric way, the ONT may be read with the following sequence:
-*. CALL HGONT(ID,KONTYP)
-*. CALL HGONTR(NONT,XONT,YONT,ZONT,WONT)
-*. HGONTC(NCHONT,CHONT)
-*.
-*. Description of the HCBONT common blocks
-*. ======================================
-*. KONTYP type of record
-*. XONT array of NONT elements (real)
-*. YONT array of NONT elements (real)
-*. ZONT array of NONT elements (real)
-*. WONT array of NONT elements (real)
-*. CHONT array of NCHONT elements (character*4)
-*.
-*. NB. The arrays XONT, etc have a maximum dimension of 1000 words.
-*.
-*. Bits 5,6,7 and 8 are used by the ONT.
-*.
-*..=========> ( R. Brun )
-*
-#include "hcbook.inc"
-#include "hcntpar.inc"
-#include "hcbont.inc"
-*
- CHARACTER*(*) CHTITL, FORMP, CHOPT
- CHARACTER*32 FORM
- CHARACTER*80 CHFORM
-*___________________________________________________________________
-*
- CALL HBNT(ID,CHTITL,CHOPT)
-*
-*-- TODO: handle packing and the creation of the range of the index
-*-- variables depending on MAXNP
-*
- FORM=FORMP
- CALL CLTOU(FORM)
- NAR=0
- IF(INDEX(FORM,'X').NE.0)NAR=1
- IF(INDEX(FORM,'Y').NE.0)NAR=2
- IF(INDEX(FORM,'Z').NE.0)NAR=3
- IF(INDEX(FORM,'W').NE.0)NAR=4
- CHFORM='KONTYP,NONT[0,1000]'
- IC=20
- IF(NAR.GE.0)THEN
- CALL SBYT(NAR,IQ(LCID+ZBITS),5,3)
- ENDIF
- IF(NAR.GE.1)THEN
- CHFORM(IC:)=',XONT(NONT)'
- IC=IC+11
- ENDIF
- IF(NAR.GE.2)THEN
- CHFORM(IC:)=',YONT(NONT)'
- IC=IC+11
- ENDIF
- IF(NAR.GE.3)THEN
- CHFORM(IC:)=',ZONT(NONT)'
- IC=IC+11
- ENDIF
- IF(NAR.GE.4)THEN
- CHFORM(IC:)=',WONT(NONT)'
- IC=IC+11
- ENDIF
-*
- CALL HBNAME(ID,'HCBONTR',KONTYP,CHFORM)
-*
- IF(INDEX(FORM,'C').NE.0)THEN
- CALL HBNAME(ID,'HCBONTC',NCHONT,'NCHONT[0,100]')
- CALL HBNAMC(ID,'HCBONTC',CHONT ,'CHONT(NCHONT):C')
- CALL SBIT1(IQ(LCID+ZBITS),8)
- ENDIF
-*
- KONTYP = 0
- NCHONT = 0
- NONT = 0
-*
- END
diff --git a/src/packlib/hbook/obsolete/hbookt.F b/src/packlib/hbook/obsolete/hbookt.F
deleted file mode 100644
index 6d5ce1b..0000000
--- a/src/packlib/hbook/obsolete/hbookt.F
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: hbookt.F,v 1.1.1.1 1996/01/16 17:08:12 mclareni Exp $
-*
-* $Log: hbookt.F,v $
-* Revision 1.1.1.1 1996/01/16 17:08:12 mclareni
-* First import
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_hbook/pilot.h"
-*CMZ : 4.10/05 19/02/90 11.18.30 by Rene Brun
-*-- Author :
- SUBROUTINE HBOOKT ( LUN)
-*.==========>
-*. PRINT PAM TITLE ON LUN
-*..=========> ( R.Brun )
-*.
- WRITE (LUN,1000)
- 1000 FORMAT ('0PACKAGE COMPILED FROM PAM FILE= ',
- + 40H CPP_TITLE
- +/)
- END
-#include "TITLE.hbook"
diff --git a/src/packlib/hbook/obsolete/hexp.F b/src/packlib/hbook/obsolete/hexp.F
deleted file mode 100644
index 92cd06b..0000000
--- a/src/packlib/hbook/obsolete/hexp.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: hexp.F,v 1.1.1.1 1996/01/16 17:08:12 mclareni Exp $
-*
-* $Log: hexp.F,v $
-* Revision 1.1.1.1 1996/01/16 17:08:12 mclareni
-* First import
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_hbook/pilot.h"
-*CMZ : 4.10/05 21/02/89 16.14.47 by Rene Brun
-*-- Author :
- FUNCTION HEXP (ARGUM)
-*.==========>
-*. CALCULATES VALUE OF THE FUNCTION
-*. F(X)=EXP(A+B*X)
-*. AND ITS DERIVATIVES
-*..=========> ( R.Brun )
-#include "hcfit3.inc"
-#include "hcbook.inc"
-*.___________________________________________
- TEMP=EXP(Q(IPARAM)+Q(IPARAM+1)*ARGUM)
- Q(IDERIV)=TEMP
- Q(IDERIV+1)=TEMP*ARGUM
- HEXP=TEMP
- END
diff --git a/src/packlib/hbook/obsolete/hfont.F b/src/packlib/hbook/obsolete/hfont.F
deleted file mode 100644
index ad42081..0000000
--- a/src/packlib/hbook/obsolete/hfont.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: hfont.F,v 1.1.1.1 1996/01/16 17:08:12 mclareni Exp $
-*
-* $Log: hfont.F,v $
-* Revision 1.1.1.1 1996/01/16 17:08:12 mclareni
-* First import
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_hbook/pilot.h"
-*CMZ : 4.21/08 17/01/94 13.15.11 by Rene Brun
-*-- Author :
- SUBROUTINE HFONT(ID,KTYP)
-*.==========>
-*. To fill an ONT from the /HCBONT/ data structure
-*..=========> ( R. Brun )
-*
-#include "hcbont.inc"
-*___________________________________________________________________
-*
- KONTYP = KTYP
- CALL HFNT1(ID, '*')
-*
- KONTYP = 0
- NCHONT = 0
- NONT = 0
-*
- END
diff --git a/src/packlib/hbook/obsolete/hfontc.F b/src/packlib/hbook/obsolete/hfontc.F
deleted file mode 100644
index e6a7733..0000000
--- a/src/packlib/hbook/obsolete/hfontc.F
+++ /dev/null
@@ -1,46 +0,0 @@
-*
-* $Id: hfontc.F,v 1.1.1.1 1996/01/16 17:08:11 mclareni Exp $
-*
-* $Log: hfontc.F,v $
-* Revision 1.1.1.1 1996/01/16 17:08:11 mclareni
-* First import
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_hbook/pilot.h"
-*CMZ : 4.21/08 17/01/94 12.37.34 by Rene Brun
-*-- Author :
- SUBROUTINE HFONTC(ID,N,IC,CHOPT)
-*.==========>
-*. To copy user array IC into /HCBONTC/ if CHOPT=' '
-*. To copy /HCBONTC/ in IC if CHOPT='R'
-*..=========> ( R. Brun )
-*
-#include "hcbook.inc"
-#include "hcbont.inc"
- CHARACTER*(*) IC(1)
- CHARACTER*(*) CHOPT
-*___________________________________________________________________
-*
- IDPOS=LOCATI(IQ(LTAB+1),IQ(LCDIR+KNRH),ID)
- IF(IDPOS.LE.0)THEN
- CALL HBUG('Unknown histogram','HFONTC',ID)
- RETURN
- ENDIF
- LC=LQ(LTAB-IDPOS)
- IOPTC=JBIT(IQ(LC+KBITS),8)
- IF(INDEX(CHOPT,'R').NE.0)GO TO 15
-*
- IF(IOPTC.EQ.0)RETURN
- NCHONT=MIN(N,MAXNC)
- DO 10 I=1,NCHONT
- CHONT(I)=IC(I)
- 10 CONTINUE
- RETURN
-*
- 15 N=NCHONT
- IF(IOPTC.EQ.0)N=0
- DO 20 I=1,NCHONT
- IC(I)=CHONT(I)
- 20 CONTINUE
- END
diff --git a/src/packlib/hbook/obsolete/hfontr.F b/src/packlib/hbook/obsolete/hfontr.F
deleted file mode 100644
index 5a444a9..0000000
--- a/src/packlib/hbook/obsolete/hfontr.F
+++ /dev/null
@@ -1,52 +0,0 @@
-*
-* $Id: hfontr.F,v 1.1.1.1 1996/01/16 17:08:11 mclareni Exp $
-*
-* $Log: hfontr.F,v $
-* Revision 1.1.1.1 1996/01/16 17:08:11 mclareni
-* First import
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_hbook/pilot.h"
-*CMZ : 4.21/08 17/01/94 12.37.34 by Rene Brun
-*-- Author :
- SUBROUTINE HFONTR(ID,N,X,Y,Z,W,CHOPT)
-*.==========>
-*. To fill /HCBONT/ if CHOPT=' '
-*. To copy /HCBONT/ in X,Y,Z,W if CHOPT='R'
-*..=========> ( R. Brun )
-*
-#include "hcbook.inc"
-#include "hcbont.inc"
- DIMENSION X(1),Y(1),Z(1),W(1)
- CHARACTER*(*) CHOPT
-*___________________________________________________________________
-*
- IDPOS=LOCATI(IQ(LTAB+1),IQ(LCDIR+KNRH),ID)
- IF(IDPOS.LE.0)THEN
- CALL HBUG('Unknown histogram','HFONTR',ID)
- RETURN
- ENDIF
- LC=LQ(LTAB-IDPOS)
- NAR=JBYT(IQ(LC+KBITS),5,3)
- IF(INDEX(CHOPT,'R').NE.0)GO TO 15
-*
- IF(NAR.LE.0)RETURN
- NONT=MIN(N,MAXNP)
- DO 10 I=1,NONT
- IF(NAR.GE.1)XONT(I)=X(I)
- IF(NAR.GE.2)YONT(I)=Y(I)
- IF(NAR.GE.3)ZONT(I)=Z(I)
- IF(NAR.GE.4)WONT(I)=W(I)
- 10 CONTINUE
- RETURN
-*
- 15 N=NONT
- IF(NAR.LE.0)N=0
- DO 20 I=1,NONT
- IF(NAR.GE.1)X(I)=XONT(I)
- IF(NAR.GE.2)Y(I)=YONT(I)
- IF(NAR.GE.3)Z(I)=ZONT(I)
- IF(NAR.GE.4)W(I)=WONT(I)
- 20 CONTINUE
- END
diff --git a/src/packlib/hbook/obsolete/hgauss.F b/src/packlib/hbook/obsolete/hgauss.F
deleted file mode 100644
index 3e3773b..0000000
--- a/src/packlib/hbook/obsolete/hgauss.F
+++ /dev/null
@@ -1,30 +0,0 @@
-*
-* $Id: hgauss.F,v 1.1.1.1 1996/01/16 17:08:12 mclareni Exp $
-*
-* $Log: hgauss.F,v $
-* Revision 1.1.1.1 1996/01/16 17:08:12 mclareni
-* First import
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_hbook/pilot.h"
-*CMZ : 4.10/05 21/02/89 16.14.49 by Rene Brun
-*-- Author :
- FUNCTION HGAUSS(ARGUM)
-*.==========>
-*. CALCULATES VALUE OF THE GAUSSIAN
-*. G(X)=COEFF*EXP(-0.5*((X-AVERAG)/SIGMA)**2)
-*. AND ITS DERIVATIVES ON COEFF,AVERAG,SIGMA
-*..=========> ( I.Ivanchenko )
-#include "hcfit3.inc"
-#include "hcbook.inc"
- COMMON/HCGARB/R1GAUS,R2GAUS,GA(15)
-*.___________________________________________
- R1GAUS=(ARGUM-Q(IPARAM+1))/Q(IPARAM+2)
- R2GAUS=R1GAUS**2
- Q(IDERIV)=0.
- IF(R2GAUS.LT.100.)Q(IDERIV)=EXP(-0.5*R2GAUS)
- HGAUSS=Q(IPARAM)*Q(IDERIV)
- Q(IDERIV+1)=HGAUSS*R1GAUS/Q(IPARAM+2)
- Q(IDERIV+2)=HGAUSS*R2GAUS/Q(IPARAM+2)
- END
diff --git a/src/packlib/hbook/obsolete/hpoly.F b/src/packlib/hbook/obsolete/hpoly.F
deleted file mode 100644
index 9fd44f0..0000000
--- a/src/packlib/hbook/obsolete/hpoly.F
+++ /dev/null
@@ -1,51 +0,0 @@
-*
-* $Id: hpoly.F,v 1.1.1.1 1996/01/16 17:08:12 mclareni Exp $
-*
-* $Log: hpoly.F,v $
-* Revision 1.1.1.1 1996/01/16 17:08:12 mclareni
-* First import
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_hbook/pilot.h"
-*CMZ : 4.10/05 21/02/89 16.14.52 by Rene Brun
-*-- Author :
- FUNCTION HPOLY (ARGUM)
-*.==========>
-*. CALCULATES VALUE OF THE POLYNOMIAL
-*. AND ITS DERIVATIVES
-*..=========> ( D.Lienart )
-#include "hcfit1.inc"
-#include "hcfit2.inc"
-#include "hcfit3.inc"
-#include "hcbook.inc"
-*.___________________________________________
- EPS=0.01
-*
- IF(LINEAR.EQ.2)GO TO 20
-*
- Q(IDERIV)=1.
- HPOLY =Q(IPARAM)
- IF(NPOLYN.EQ.0)RETURN
- DO 10 I=1,NPOLYN
- Q(IDERIV+I)=Q(IDERIV+I-1)*ARGUM
- HPOLY =HPOLY +Q(IPARAM+I)*Q(IDERIV+I)
- 10 CONTINUE
- RETURN
-*
-* CHEBYSCHEV EXPANSION
-*
- 20 Q(IDERIV)=1.
- HPOLY=Q(IPARAM)*0.5
- IF(NPOLYN.EQ.0) GO TO 40
- Q(IDERIV+1)=ARGUM
- HPOLY=HPOLY+Q(IPARAM+1)*Q(IDERIV+1)
- IF(NPOLYN.EQ.1)GO TO 40
-*
- DO 30 I=2,NPOLYN
- Q(IDERIV+I)=Q(IDERIV+I-1)*2.*ARGUM-Q(IDERIV+I-2)
- HPOLY=HPOLY+Q(IPARAM+I)*Q(IDERIV+I)
- 30 CONTINUE
- 40 CONTINUE
- Q(IDERIV)=0.5
- END
diff --git a/src/packlib/hbook/tests/Imakefile b/src/packlib/hbook/tests/Imakefile
deleted file mode 100644
index 2dc5b71..0000000
--- a/src/packlib/hbook/tests/Imakefile
+++ /dev/null
@@ -1,9 +0,0 @@
-#if 0
-/* this is not yet understood */
-CernlibFortranProgramTarget(hbtest,test_fp.o,$(PACKAGE_LIB),$(PACKAGE_LIB),NullParameter)
-
-
-TestTarget(hbtest)
-#else
-test::
-#endif
diff --git a/src/packlib/hbook/tests/test_fp.F b/src/packlib/hbook/tests/test_fp.F
deleted file mode 100644
index 92d33f5..0000000
--- a/src/packlib/hbook/tests/test_fp.F
+++ /dev/null
@@ -1,478 +0,0 @@
-*
-* $Id: test_fp.F,v 1.1.1.1 1996/01/16 17:08:12 mclareni Exp $
-*
-* $Log: test_fp.F,v $
-* Revision 1.1.1.1 1996/01/16 17:08:12 mclareni
-* First import
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_hbook/pilot.h"
-#if defined(CERNLIB_TESTS)
-*CMZ : 21/06/95 14.24.56 by Julian Bunn
-*-- Author :
-
-****************************************************************
-*program test fortran for double precision and floating points *
-****************************************************************
-
- PROGRAM FPMAIN
- INTEGER DENORM , SIGNAL_NAN
- DOUBLE PRECISION M , D
- REAL R , L , K
-
-*********************************************
-*test the accurate classification of doubles*
-*********************************************
-
- PRINT '(A)' , 'THE TEST CONCERNING IFPDCL IS STARTING'
- IFLAG=1
-*positive normalized 0
- M =10.
- I = IFPDCL(M)
- IF (I .EQ. 0) THEN
- PRINT '(A)', ' test on positive normalized succeeds'
- ELSE
- PRINT '(A)' ,' test on positive normalized doesn t succeed'
- IFLAG=0
- ENDIF
-
-*negative normalized 1
- D = -10.
- I = IFPDCL(D)
- IF (I .EQ. 1) THEN
- PRINT '(A)', ' test on negative normalized succeeds'
- ELSE
- PRINT '(A)' ,' test on negative normalized doesn t succeed'
- IFLAG=0
- ENDIF
-
-*positive zero 2
- D = 0.
- I = IFPDCL(D)
- IF (I .EQ. 2) THEN
- PRINT '(A)', ' test on positive zero succeeds'
- ELSE
- PRINT '(A)' ,' test on positive zero doesn t succeed'
- IFLAG=0
- ENDIF
-
-*negative zero 3
- M = -1.
- DO 1 I = 1,100
- J = IFPDCL(M)
- M = M /1000000000000000.
- 1 CONTINUE
- IF (J .EQ. 3) THEN
- PRINT '(A)', ' test on negative zero succeeds'
- ELSE
- PRINT '(A)' ,' test on negative zero doesn t succeed'
- IFLAG=0
- ENDIF
-
-*positive infinity 4
- M = 1.
- DO 2 I = 1,100
- M = M * 1000000000000000.
- J = IFPDCL(M)
- 2 CONTINUE
- IF (J .EQ. 4) THEN
- PRINT '(A)', ' test on positive infinity succeeds'
- ELSE
- PRINT '(A)' ,' test on positive infinity doesn t succeed'
- IFLAG=0
- ENDIF
-
-*negative infinity 5
- M = -1.
- DO 3 I = 1,100
- J = IFPDCL(M)
- M = M *100000000000000000.
-3 CONTINUE
- IF (J .EQ. 5) THEN
- PRINT '(A)', ' test on negative infinity succeeds'
- ELSE
- PRINT '(A)' ,' test on negative infinity doesn t succeed'
- IFLAG=0
- ENDIF
-
-*positive denormalized 6
-*approximation when you pass a parameter < 10**-45
-*impossible to have a subnormal number
- J=0
- I = DENORM(J)
- IF (I .EQ. 6) THEN
- PRINT '(A)', ' test on positive denormalized succeeds'
- ELSE
- PRINT '(A)' ,' test on positive denormalized doesn t succeed'
- IFLAG=0
- ENDIF
-
-*negative denormalized 7
- J = 1
- I = DENORM(J)
- IF (I .EQ. 7) THEN
- PRINT '(A)', ' test on negative denormalized succeeds'
- ELSE
- PRINT '(A)' ,' test on negative denormalized doesn t succeed'
- IFLAG=0
- ENDIF
-
-*signaling nan 8
- I = SIGNAL_NAN()
- IF (I .EQ. 8) THEN
- PRINT '(A)', ' test on signaling nan succeeds'
- ELSE
- PRINT '(A)' ,' test on signaling nan doesn t succeed'
- IFLAG=0
- ENDIF
-
-
-*quiet nan 9
- D = M * 0.
- I = IFPDCL(D)
- IF (I .EQ. 9) THEN
- PRINT '(A)', ' test on quiet nan succeeds'
- ELSE
- PRINT '(A)' ,' test on quiet nan doesn t succeed'
- IFLAG=0
- ENDIF
-
- IF(IFLAG .EQ. 1) THEN
- PRINT '(A)', 'TEST ON IFPDCL IS FINISHED AND SUCCEEDS'
- ELSE
- PRINT '(A)','TEST ON IFPDCL IS FINISHED AND DOESN T SUCCEED'
- ENDIF
- PRINT '(A)', ' '
-
-********************************************
-*test the accurate classification of floats*
-********************************************
-
- PRINT '(A)' ,'THE TEST CONCERNING IFPSCL IS STARTING'
- IFLAG=1
-*positive normalized 0
- K =10.
- J = IFPSCL(K)
- IF (J .EQ. 0) THEN
- PRINT '(A)', ' test on positive normalized succeeds'
- ELSE
- PRINT '(A)' ,' test on positive normalized doesn t succeed'
- IFLAG=0
- ENDIF
-
-*negative normalized 1
- K = -10.
- J = IFPSCL(K)
- IF (J .EQ. 1) THEN
- PRINT '(A)', ' test on negative normalized succeeds'
- ELSE
- PRINT '(A)' ,' test on negative normalized doesn t succeed'
- IFLAG=0
- ENDIF
-
-*positive zero 2
- K = 0.
- J = IFPSCL(K)
- IF (J .EQ. 2) THEN
- PRINT '(A)', ' test on positive zero succeeds'
- ELSE
- PRINT '(A)' ,' test on positive zero doesn t succeed'
- IFLAG=0
- ENDIF
-
-*negative zero 3
- R = -1.
- DO 10 I = 1,100
- J = IFPSCL(R)
- R = R /1000000000000000.
- 10 CONTINUE
- IF (J .EQ. 3) THEN
- PRINT '(A)', ' test on negative zero succeeds'
- ELSE
- PRINT '(A)' ,' test on negative zero doesn t succeed'
- IFLAG=0
- ENDIF
-
-*positive infinity 4
- R = 1.
- DO 20 I = 1,100
- R = R * 1000000000000000.
- J = IFPSCL(R)
- 20 CONTINUE
- IF (J .EQ. 4) THEN
- PRINT '(A)', ' test on positive infinity succeeds'
- ELSE
- PRINT '(A)' ,' test on positive infinity doesn t succeed'
- IFLAG=0
- ENDIF
-
-*negative infinity 5
- L = -1.
- DO 30 I = 1,100
- J = IFPSCL(L)
- L = L *100000000000000000.
- 30 CONTINUE
- IF (J .EQ. 5) THEN
- PRINT '(A)', ' test on negative infinity succeeds'
- ELSE
- PRINT '(A)' ,' test on negative infinity doesn t succeed'
- IFLAG=0
- ENDIF
-#if defined(CERNLIB_HPUX)||defined(CERNLIB_SGI)
-*positive denormalized 6
-
- K = 0.1*2.**(-126.)
- J = IFPSCL(K)
- IF (J .EQ. 6) THEN
- PRINT '(A)', ' test on positive denormalized succeeds'
- ELSE
- PRINT '(A)' ,' test on positive denormalized doesn t succeed'
- IFLAG=0
- ENDIF
-
-*negative denormalized 7
- K = -0.1*2.**(-126.)
- J = IFPSCL(K)
- IF (J .EQ. 7) THEN
- PRINT '(A)', ' test on negative denormalized succeeds'
- ELSE
- PRINT '(A)' ,' test on negative denormalized doesn t succeed'
- IFLAG=0
- ENDIF
-
-*signaling nan 8
-*I pass a quiet nan in a double variable
- M = R * 0.
- J = IFPSCL(M)
- IF (J .EQ. 8) THEN
- PRINT '(A)', ' test on signaling nan succeeds'
- ELSE
- PRINT '(A)' ,' test on signaling nan doesn t succeed'
- IFLAG=0
- ENDIF
-
-#endif
-*quiet nan 9
- K = R * 0.
- J = IFPSCL(K)
- IF (J .EQ. 9) THEN
- PRINT '(A)', ' test on quiet nan succeeds'
- ELSE
- PRINT '(A)' ,' test on quiet nan doesn t succeed'
- IFLAG=0
- ENDIF
-
- IF(IFLAG .EQ. 1) THEN
- PRINT '(A)', 'TEST ON IFPSCL IS FINISHED AND SUCCEEDS'
- ELSE
- PRINT '(A)','TEST ON IFPSCL IS FINISHED AND DOESN T SUCCEED'
- ENDIF
- PRINT '(A)', ' '
-
-*******************************************
-*test the simple classification of doubles*
-*******************************************
-
- PRINT '(A)' ,'THE TEST CONCERNING IFPD IS STARTING'
- IFLAG=1
-*positive normalized 1
- M =10.
- I = IFPD(M)
- IF (I .EQ. 1) THEN
- PRINT '(A)', ' test on positive normalized succeeds'
- ELSE
- PRINT '(A)' ,' test on positive normalized doesn t succeed'
- IFLAG=0
- ENDIF
-
-
-*negative normalized 1
- D = -10.
- I = IFPD(D)
- IF (I .EQ. 1) THEN
- PRINT '(A)', ' test on negative normalized succeeds'
- ELSE
- PRINT '(A)' ,' test on negative normalized doesn t succeed'
- IFLAG=0
- ENDIF
-
-*positive zero 1
- D = 0.
- I = IFPD(D)
- IF (I .EQ. 1) THEN
- PRINT '(A)', ' test on positive zero succeeds'
- ELSE
- PRINT '(A)' ,' test on positive zero doesn t succeed'
- IFLAG=0
- ENDIF
-
-*negative zero 1
- M = -1.
- DO 100 I = 1,100
- J = IFPD(M)
- M = M /1000000000000000.
- 100 CONTINUE
- IF (J .EQ. 1) THEN
- PRINT '(A)', ' test on negative zero succeeds'
- ELSE
- PRINT '(A)' ,' test on negative zero doesn t succeed'
- IFLAG=0
- ENDIF
-
-*positive infinity 0
- M = 1.
- DO 200 I = 1,100
- M = M * 1000000000000000.
- J = IFPD(M)
- 200 CONTINUE
- IF (J .EQ. 0) THEN
- PRINT '(A)', ' test on positive infinity succeeds'
- ELSE
- PRINT '(A)' ,' test on positive infinity doesn t succeed'
- IFLAG=0
- ENDIF
-
-*negative infinity 0
- M = -1.
- DO 300 I = 1,100
- J = IFPD(M)
- M = M *100000000000000000.
- 300 CONTINUE
- IF (J .EQ. 0) THEN
- PRINT '(A)', ' test on negative infinity succeeds'
- ELSE
- PRINT '(A)' ,' test on negative infinity doesn t succeed'
- IFLAG=0
- ENDIF
-
-
-*quiet nan 0
- D = M * 0.
- I = IFPD(D)
- IF (I .EQ. 0) THEN
- PRINT '(A)', ' test on quiet nan succeeds'
- ELSE
- PRINT '(A)' ,' test on quiet nan doesn t succeed'
- IFLAG=0
- ENDIF
-
- IF(IFLAG .EQ. 1) THEN
- PRINT '(A)', 'TEST ON IFPD IS FINISHED AND SUCCEEDS'
- ELSE
- PRINT '(A)','TEST IFPD IS FINISHED AND DOESN T SUCCEED'
- ENDIF
- PRINT '(A)', ' '
-
-*******************************************
-*test the simple classification of floats*
-*******************************************
-
- PRINT '(A)' ,'THE TEST CONCERNING IFPS IS STARTING'
- IFLAG=1
-*positive normalized 1
- K =10.
- J = IFPS(K)
- IF (J .EQ. 1) THEN
- PRINT '(A)', ' test on positive normalized succeeds'
- ELSE
- PRINT '(A)' ,' test on positive normalized doesn t succeed'
- IFLAG=0
- ENDIF
-
-*negative normalized 1
- K = -10.
- J = IFPS(K)
- IF (J .EQ. 1) THEN
- PRINT '(A)', ' test on negative normalized succeeds'
- ELSE
- PRINT '(A)' ,' test on negative normalized doesn t succeed'
- IFLAG=0
- ENDIF
-
-*positive zero 1
- K = 0.
- J = IFPS(K)
- IF (J .EQ. 1) THEN
- PRINT '(A)', ' test on positive zero succeeds'
- ELSE
- PRINT '(A)' ,' test on positive zero doesn t succeed'
- IFLAG=0
- ENDIF
-
-*negative zero 1
- R = -1.
- DO 1000 I = 1,100
- J = IFPS(R)
- R = R /1000000000000000.
- 1000 CONTINUE
- IF (J .EQ. 1) THEN
- PRINT '(A)', ' test on negative zero succeeds'
- ELSE
- PRINT '(A)' ,' test on negative zero doesn t succeed'
- IFLAG=0
- ENDIF
-
-*positive infinity 0
- R = 1.
- DO 2000 I = 1,100
- R = R * 1000000000000000.
- J = IFPS(R)
- 2000 CONTINUE
- IF (J .EQ. 0) THEN
- PRINT '(A)', ' test on positive infinity succeeds'
- ELSE
- PRINT '(A)' ,' test on positive infinity doesn t succeed'
- IFLAG=0
- ENDIF
-
-*negative infinity 0
- L = -1.
- DO 3000 I = 1,100
- J = IFPS(L)
- L = L *100000000000000000.
- 3000 CONTINUE
- IF (J .EQ. 0) THEN
- PRINT '(A)', ' test on negative infinity succeeds'
- ELSE
- PRINT '(A)' ,' test on negative infinity doesn t succeed'
- IFLAG=0
- ENDIF
-
-
-*signaling nan 0
-*I pass a quiet nan in a double variable
- M = R * 0.
- J = IFPS(M)
- IF (J .EQ. 0) THEN
- PRINT '(A)', ' test on signaling nan succeeds'
- ELSE
- PRINT '(A)' ,' test on signaling nan doesn t succeed'
- IFLAG=0
- ENDIF
-
-
-*quiet nan 0
- K = R * 0.
- J = IFPS(K)
- IF (J .EQ. 0) THEN
- PRINT '(A)', ' test on quiet nan succeeds'
- ELSE
- PRINT '(A)' ,' test on quiet nan doesn t succeed'
- IFLAG=0
- ENDIF
-
- IF(IFLAG .EQ. 1) THEN
- PRINT '(A)', 'TEST ON IFPS IS FINISHED AND SUCCEEDS'
- ELSE
- PRINT '(A)','TEST ON IFPS IS FINISHED AND DOESN T SUCCEED'
- ENDIF
-
- END
-
-
-
-
-
-
-#endif
diff --git a/src/packlib/hbook/versions/history.dat b/src/packlib/hbook/versions/history.dat
deleted file mode 100644
index d868e98..0000000
--- a/src/packlib/hbook/versions/history.dat
+++ /dev/null
@@ -1,284 +0,0 @@
-*
-* $Id: history.dat,v 1.1.1.1 1996/01/16 17:08:11 mclareni Exp $
-*
-* $Log: history.dat,v $
-* Revision 1.1.1.1 1996/01/16 17:08:11 mclareni
-* First import
-*
-*
-* This directory was created from hbook.car patch history
-*CMZ : 4.10/05 16/08/90 10.35.58 by Rene Brun
-*-- Author :
-*
-* VERSION 4.10 (16/08/90)
-*
-* COMMON/HCDIRE/ modified. Number of possible directories
-* has been changed from 20 to 100.
-* This changes implies recompilation of HPLOT,PAW.
-* Note that a similar change has been made in RZEBRA.
-* Argument to user functions copied before calling
-* the function in HBFUN1/HBFUN2 to prevent cases
-* where a bad user is changing the argument.
-* Bug corrected in HFIND for HBOOKB case
-* Correction in HFITH in case of HFITGA (Sigma>0)
-* Added IQUEST(1)=1 in HCDIR if directory not found (M.Guan..)
-* Slight changes for OS9/RTF compiler (Equivalence order)
-* Bug corrected in HSPLI2 (A.Nathaniel)
-* Mods in HCOPYN calling a new routine HCOPYT (copy Ntuples)
-* Mods in HSCALE and HMAXIM. HMAXIM may be called for a 2-Dim
-* HMAXIM uses KSCAL2 word
-*
-*
-* VERSION 4.09 (11/04/90)
-*
-* Mods in HDIFF (for HPAK case)
-* New routine HPAKAD
-* Changes in machine PATCHY flags
-* Routine HROPEN based on new ZEBRA routine RZOPEN
-* New routine HFNOV to fill a "cyclic Ntuple"
-* Double precision variables in HSTATI and HPRST
-* Bug corrected in HOPER1 for Number of equivalent events
-* Changes in HFN (HCDIR+RZCDIR) when RZ is used together
-* with HBOOK.
-* Changes in HCREATEG
-* New DECK H0MPW introduced for MACMPW to force a new segment
-* Bug fixed in HLDIR (M.Guanziroli)
-*
-* VERSION 4.08 (18/12/89)
-*
-* SET EPS=0.0000002 in HMINUT
-* New routine HFITHN introduced
-* + internal routines HICTOI,HFITF,HFITHC
-* + new Patchy sequence HCFITF
-* Bug corrected in HINDEX for slices
-* Changes in HFITH1 and HSUPIS to take care of histograms
-* with non-equidistant bins
-* In HCOPY set bit 5 =0
-* In HRIN look at bit 5 before deleting histogram in memory
-* In HIDOPT, option SHOW implemented
-*
-* VERSION 4.07 (29/09/89)
-*
-* Mods in HHIPAR. Do not force IWEIGH=1 if HPAKE.
-* Mods in HMINUI. (if PARAM=0.)
-* Mods in HFCN
-* Protection in HMDIR against CHDIR with more than 16 characters
-* Sequences HCFIT4,HCFIT5 deleted.
-* Bug corrected in HRNDM2
-* MAXLEN changed to 110 in HPAFF
-* HGN returns IERROR=-1 if event nr > number of events
-* Mods in HCREATEG (Jim Loken)
-* Protection in HDIPKL
-* Minor change in HMINUI
-* Minor change in HEXAM5
-* Maximum number of variables in a Ntuple changed to 512
-* Change in HFITGA. Parameter COEFF in phase with documentation
-* HDIFF writes on LOUT instead of 6.
-* Text of message changed in HUNPAK/HUNPKE
-* Bug corrected in HFINOP for BANY
-* SAVE statement added in HRNDM1/HRNDM2
-* Array FITDER added in sequence /HCFITS/.
-* Variable EPSIH renamed EPSIF in /HCFIT6/.
-* Format changed in HPTIT (I4 instead of I3)
-* DEFT changed to SETD in HIDOPT.
-* Epsil shift (1.e-6) in booking routines removed.
-* Change in HDELET (clear link for HCOPYM)
-* Change in HSIFLA (status word bit 5 set for PAW)
-* Changes in all routines modifying histogram structure
-* (call sbit0(iq(lcid),5) for PAW
-* Set IQUEST(1)=0 in HSPACE (problems with the ZEBRA server)
-* Correct HCOPYN for profile histograms with option S
-* New version of HCREATEG from J.Loken
-* Changes in HINDEX for printing limits of slices and bands*
-* New fitting routines HFITH and HFITV introduced
-* Routines HFITPO,HFITEX,HFITGA interfaced to HFITH
-* Added calls to interactive Minuit if option 'M'
-* Examples modified
-* Fit parameters now stored with histogram data structure.
-* Variable IOFIT in /HCFORM/
-*
-* VERSION 4.06 (30/06/89)
-*
-* INOT replaced by INNOT in printing routines
-* Current Directory set to //PAWC at the end of HREND
-* Bug corrected in HNORMA (C.ERD)
-* Bug corrected in HSTATI
-* HRDIR implemented for subdirs of a global section
-* Change to standard intrinsic functions of Fortran 77
-* CONVEX version introduced
-* Version of HROPEN for IBMMVS introduced.
-* New routine HDERIV (user callable)
-* HDERIV is a replacement for the dummy routines
-* HDERI1,HDERI2,HDERIN
-* HEXAM modified
-* Report bug in HBOOKN for ID>9999
-* Bug corrected in HRZIN for Ntuples (CZ mode)
-*
-* New interface to MINUIT introduced (with E.Lessner FNAL)
-* Changes in fitting routines for IWEIGH.NE.0
-*
-* Changes in HBARX/HBARY
-* When HBARX/Y is called, the routine fills the sum of
-* the square of the weights from the actual contents
-* This is introduced to make easier the computation
-* of error bars by HOPERA.
-*
-* VERSION 4.05 (29/03/89)
-*
-* Sequence JBIT replaced for Apollo
-* Unused sequences removed
-* Bugs corrected in HPROJ1(2) ISEL not used
-* Routines HRZIN/HRZOUT changed (New CZ and ZS)
-* New routine HRDIR
-* Bug corrected in HPR1H
-* Remove limitation for CHRZPA<3 in HBOOKN
-* Protection added in HFILPF (overflows)
-* DOUBLE PRECISION kept on CRAY in HF1,HPRST and HSTATI
-* Bug corrected in HPR1V for INTE and many parts
-* Bug corrected in HARRAY
-* Bug corrected in HF1AUT
-* Bug corrected in HMONIT
-* sequence HCDIRE modified. New array HFNAME containing
-* the file name
-* Mods in HBOOKN. 80 characters always allocated to CHRZPA.
-* Mods in HRIN to change CHRZPA to current directory.
-* Bug corrected in HBCDI (RETURN missing)
-* Patchy flag SAVE removed (default)
-*
-* Mods in HBOOKN (Limit to 120)
-* Protection in HTERM
-* Mods in HCOPYN (add profiles)
-* Mods in HRZIN
-* Mods in HRGET and HRPUT when CHFILE=' '
-* Add option 'A' in HRGET (JOFSET=99999 in HRIN)
-* Bug corrected in HLDIR2
-* Bug corrected in HEXAM5 (array EY not defined)
-* Unused variables removed (FTN on DN10000)
-* Calls to UCTOH1 replaced by UCTOH
-* Bug corrected in HSPFUN (Annette Frenkel)
-* HSPLI1 always return CHISQ
-* New options 'F1 and F2' in HDIFF
-* Routine HISTDO now calls HPDIR('//PAWC','TI')
-* Option 'I' added in HPDIR
-* Routines HRZFIL and HRZEND removed
-* Changes in HRFILE,HRZCD for communication mode
-* Change IQUEST(1)=0 in HCDIR
-* Bug corrected in HSTATI (LCONT set to IFW removed)
-* IDLAST always set to 0 in HLOOP
-* Bug corrected in HPHIST/HPROT for slices in X
-* Routines for Vax Global sections rewritten by J.Loken
-*
-* VERSION 4.04 (10/11/88)
-*
-* Changes in all booking routines (31-->16)
-* Mods in HROUT
-* Mods in HFF1,HIPAK1,HF1,HF2
-* Patchy flag SAVE introduced
-* New routines HGNPAR and HGNF
-* Routines HPROJ1 and HPROJ2 modified
-*
-* VERSION 4.03 (05/09/88)
-*
-* Routine HCX modified to solve a CRAY compiler problem
-* Routines HFETCH,HFETC1 corrected for same problem as HCX
-* Routine HF1 corrected for non-equidistant bins histograms
-* Argument IDD added in HSPACE
-* Argument KCASE in HUNPAK declared type CHARACTER
-* Argument KNAME in HPHIST and HPROT declared type CHARACTER
-* NOARG removed from HPHIST and HPROT
-* Bug corrected in HPHIST affecting HPR1V
-* Routines HPROJ1,HPROJ2 modified to handle MASK logic in PAW
-* and HGN
-* Routine HFILPF changed to take W into account
-* COMMON/PAWIDN/IDNEVT,X(127) added.
-* UNIX version introduced.
-* Changes in HMACHI,HPCHAN,HPATH.
-* Bugs corrected in HFILPR and HPR1V.
-* Bank LHBOOK changed to 50 links (10 struct.)
-* Automatic binning algorithm modified (HF1AUT)
-* Routine HROUT accepts option 'T'
-* New routines HROPEN,HRGET and HRPUT
-* Routine HRIN modified to simulate option 'T'
-* If ICYCLE>1000 and ID=0 implies option 'T'
-* Routines HBOOK1 and HF1 changed. Accumulate the 100 first
-* entries instead of just 50.
-* Mods in all routines using NBIT
-* Check for space left in HLDIR
-* Changes in HMAPG (J.Loken)
-*
-* VERSION 4.02 (28/04/88)
-*
-* Bugs corrected in routine HFF1,HFF2,HIPAK1,HIPAK2 (Kevin Einsweiler)
-* Bugs corrected in HIDOPT (Helmut Burkhardt)
-* Bugs corrected in HPROJ1,HPROJ2 (V.Journe)
-* Option I implemented in HLDIR (HINDEX format)
-* New routine HUNPKE to unpack errors (same calling as HUNPAK)
-* Bug corrected in HSTATI(C.Onions)
-* Bug corrected in HOPER1 (calculation of errors)(V.Gibson,A.Parker)
-* Bugs corrected in HSPFUN,HSPLI1,HSPLI2
-* Bug corrected in HFETCH (D.Schlatter)
-* ALLIANT version introduced
-* New facility to access remote files across a network
-* An implementation with TCP/IP is available
-* (Works together with the new option FZCHANNEL of ZEBRA)
-* Correction in HFETCH (problem on NORD) (A.Read)
-* Changes in HRFILE for global sections (IQUEST)
-* LOUT changed to 6 for Apollo and Alliant
-* Y scale factor better computed when HMAXIM is called (V.Palladino)
-* Operations between profile histograms implemented (suggested by H.Chan
-* Modification of algorithm to print integrated contents (P.O.Hulth)
-* Routine HGN optimized
-* New routine HGIVEN (same as HGIVE for N-tuples) (R.Namjoshi)
-* Routine HSCR implemented as described in the documentation
-* Mods in HBANDX and HBANDY (reverse booking order)
-* Set a limitation for NVAR<129 in HBOOKN
-* Changes in HFN and HCDIR for N-tuples in memory
-* Protection in booking routines in case HDELET is called
-* IDLAST reset in all printing routines
-* Bugs corrected in HLDIR and HPDIR
-*
-* VERSION 4.01 (18/02/88)
-*
-* Bugs corrected in routine HGN (Rohit + Iversen)
-* Bug corrected in HFINOP (affected HSTATI and HUNPAK)
-* Bugs corrected in HPROJ1,HPROJ2
-* Protection in HROUT
-*
-* VERSION 4.00 (08/02/88)
-*
-* New version based on ZEBRA. (version 3.54 needed)
-* Storage area is the COMMON/PAWC/H(ispace)
-* The user has to dimension this common block and
-* initialize the HBOOK package by CALL HLIMIT(ispace)
-*
-* Only character strings or variables are accepted for titles
-*
-* With the new version one must always specified
-* the correct number of arguments in subroutine calls. The
-* facility to miss some arguments will be withdrawn from HBOOK
-* in a few monthes.
-* HFILL must have 4 arguments
-* HSTORE and HFETCH are dummy. Use HRFILE,HRIN,HROUT,HREND instead
-*
-* A set of new routines is available for
-* - Structuring IDs in memory.
-* - Statistical comparison of histograms (HDIFF)
-* - Give options
-* - Sequential I/O
-* - Random access I/O (PATCH,HRZ)
-* - N-tuples
-* - New routine HFILPR to fill existing projections
-* - New routine HGSTAT to get statistics
-* - New routines HBPROF and HFILPF to book and fill
-* profile histograms
-* - New functionality for HLIMIT
-* without initialization of ZEBRA
-* - New routine HBUG to print error messages
-* - Using shared areas (Online) HCOPYM
-* - New routine HBOOKB (histos with non-equidistant bins)
-* - New routine HREP1 to replace contents of one channel
-* - New routine HGN to return one event from a N-tuple
-* - New routine HPSTAT to print statistics about ID
-* - PATCH,HGLOBAL for shared global sections on VAX
-* (See new documentation)
-*
diff --git a/src/packlib/hbook/versions/v4_10 b/src/packlib/hbook/versions/v4_10
deleted file mode 100644
index 812e74b..0000000
--- a/src/packlib/hbook/versions/v4_10
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: v4_10,v 1.1.1.1 1996/01/16 17:08:11 mclareni Exp $
-*
-* $Log: v4_10,v $
-* Revision 1.1.1.1 1996/01/16 17:08:11 mclareni
-* First import
-*
-*
-*CMZ : 4.10/06 10/02/91 16.53.12 by Rene Brun
-*-- Author : Rene Brun 07/11/90
-*
-*::> VERSION 4.10/06 910210 16.53
-*
-*
-*::> VERSION 4.10/05 901107 16.37
-*
-* COMMON/HCDIRE/ modified. Number of possible directories
-* has been changed from 20 to 100.
-* This changes implies recompilation of HPLOT,PAW.
-* Note that a similar change has been made in RZEBRA.
-* Argument to user functions copied before calling
-* the function in HBFUN1/HBFUN2 to prevent cases
-* where a bad user is changing the argument.
-* Bug corrected in HFIND for HBOOKB case
-* Correction in HFITH in case of HFITGA (Sigma>0)
-* Added IQUEST(1)=1 in HCDIR if directory not found (M.Guan..)
-* Slight changes for OS9/RTF compiler (Equivalence order)
-* Bug corrected in HSPLI2 (A.Nathaniel)
-* Mods in HCOPYN calling a new routine HCOPYT (copy Ntuples)
-* Mods in HSCALE and HMAXIM. HMAXIM may be called for a 2-Dim
-* HMAXIM uses KSCAL2 word
-*
-*
diff --git a/src/packlib/hbook/versions/v4_11 b/src/packlib/hbook/versions/v4_11
deleted file mode 100644
index 6e1d732..0000000
--- a/src/packlib/hbook/versions/v4_11
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: v4_11,v 1.1.1.1 1996/01/16 17:08:11 mclareni Exp $
-*
-* $Log: v4_11,v $
-* Revision 1.1.1.1 1996/01/16 17:08:11 mclareni
-* First import
-*
-*
-*CMZ : 4.11/01 15/02/91 18.07.12 by Rene Brun
-*-- Author : Rene Brun 10/02/91
-*
-*::> VERSION 4.11/01 910215 18.07
-*
-* Flag NEWLIB introduced in HMACHI
-*
-*::> VERSION 4.11/00 910210 16.55
-*
-*
-* Remove the test in HFCNV on TEST (same as HFCNH)
-* Bugs corrected in HFETCH and HREAD
-* Bug corrected in HLDIR2 (IOFSET not initialized: W.Brueckner)
-* Bug corrected in HX/HPR1H for non-equidistant bins (G.Maringer)
-* SAVE statement added in HFF2 (W.Brueckner)
-* Correction in HAUTO (LW not computed)
-* Introduce HPUX version
-*
-
diff --git a/src/packlib/hbook/versions/v4_12 b/src/packlib/hbook/versions/v4_12
deleted file mode 100644
index b98ba30..0000000
--- a/src/packlib/hbook/versions/v4_12
+++ /dev/null
@@ -1,15 +0,0 @@
-*
-* $Id: v4_12,v 1.1.1.1 1996/01/16 17:08:11 mclareni Exp $
-*
-* $Log: v4_12,v $
-* Revision 1.1.1.1 1996/01/16 17:08:11 mclareni
-* First import
-*
-*
-*CMZ : 4.12/00 17/04/91 08.17.57 by Rene Brun
-*-- Author : Rene Brun 17/04/91
-*
-*::> VERSION 4.12/00 910417 8.17
-*
-* Changes in FORMAT in routine HDIFF
-*
diff --git a/src/packlib/hbook/versions/v4_13 b/src/packlib/hbook/versions/v4_13
deleted file mode 100644
index 71d671e..0000000
--- a/src/packlib/hbook/versions/v4_13
+++ /dev/null
@@ -1,37 +0,0 @@
-*
-* $Id: v4_13,v 1.1.1.1 1996/01/16 17:08:11 mclareni Exp $
-*
-* $Log: v4_13,v $
-* Revision 1.1.1.1 1996/01/16 17:08:11 mclareni
-* First import
-*
-*
-*CMZ : 4.13/01 06/09/91 13.59.22 by Rene Brun
-*-- Author : Rene Brun 02/09/91
-*
-*::> VERSION 4.13/01 910906 13.59
-*
-* Routines HPROJ1 and HPROJ2 changed with the correct /PAWIDN/
-*
-*::> VERSION 4.13/00 910902 17.07
-*
-*
-* This version of HBOOK requires ZEBRA version 3.66/8
-* Changes in PILOT,PATCH for IBMMVS and NEWLIB.
-* Changes in HEXAM for IBMMVS.
-* Changes in HMAXIM/HMINIM
-* SET EPS changed to 1.E-14 in HMINUT
-* New option 'E' in Fitting routines
-* Option 'E' selects a better error evaluation
-* New routine HGFIT returning fit parameters
-* Changes in HPR1H,HPR1V (reset I20,I21 for 2-Dim case)
-* New PATCH,CHBOOK (in C) for memory mapping)
-* Routine HLDIR can list a RZ tree in histo format.
-* Mods in HLDIR to call RZSCAN (new ZEBRA routine) and HLDIRT
-* Routine HLDIR2 deleted.
-* Protection in HPDIR when trying to print a RZ directory.
-* Routine HMDIR modified to allow creation of a directory
-* in a directory which is not the current directory
-* Bug corrected in HFUNC
-* Protection in HPAFF (same as RZPAFF by M.Marquina)
-*
diff --git a/src/packlib/hbook/versions/v4_14 b/src/packlib/hbook/versions/v4_14
deleted file mode 100644
index ed731eb..0000000
--- a/src/packlib/hbook/versions/v4_14
+++ /dev/null
@@ -1,59 +0,0 @@
-*
-* $Id: v4_14,v 1.1.1.1 1996/01/16 17:08:11 mclareni Exp $
-*
-* $Log: v4_14,v $
-* Revision 1.1.1.1 1996/01/16 17:08:11 mclareni
-* First import
-*
-*
-*CMZ : 4.14/05 21/03/92 10.52.54 by Unknown
-*-- Author : Rene Brun 22/10/91
-*
-*::> VERSION 4.14/05 920321 10.52
-*
-* Protection introduced in HPR1V (P.Lanius)
-*
-*
-*::> VERSION 4.14/04 920309 23.16
-* Ntuple saga again. The procedure to speed-up memory-resident
-* ntuples had several consequences. Changes made in HGNPAR.
-*
-*
-*::> VERSION 4.14/03 920308 8.33
-*
-* Change logic in HRIN for memory-resident ntuples.
-* Previous algorithm affected also disk-resident ntuples
-*
-*
-*::> VERSION 4.14/02 920306 11.04
-*
-* Bug corrected in HRIN for memory-resident ntuples (1 block)
-*
-*
-*::> VERSION 4.14/01 920302 16.31
-*
-* Bug corrected in HOPER1 for functions (A.Nathaniel)
-* Changes in UNIX memory mapping routines.
-* Note that HLIMAP cannot be used under HPUX with the current
-* version of f77 (crash in MZSTOR).
-*
-*
-*::> VERSION 4.14/00 911022 9.25
-*
-* Protections in HRNDM1 and HRNDM2
-* Changes in HFCNV
-* Format change in HPTIT
-* New routine HRENID to rename IDS on a RZ file
-* Bug corrected in HFUNC (shift by 1 channel)
-* Format change (I6 to I8) in HINDEX and HINPRX
-* Mods in HPR1H for BIBBI case
-* Bug corrected in HSTATI/HPRST in case of negative contents
-* Save IQUEST(10) in HROPEN due to changes in RZOPEN
-* New routine HGDIRE(LUN,CHDIR) to return TOPDIR name corresponding
-* to LUN.
-*
-* Option 'I' changed to ' ' in all calls to MZPUSH
-* Speed-up of HGN and HGNF
-* Changes in HRIN to speed up HGN/HGNF
-* New fast filling routine HF1N (called by PAW)
-*
diff --git a/src/packlib/hbook/versions/v4_15 b/src/packlib/hbook/versions/v4_15
deleted file mode 100644
index 469667c..0000000
--- a/src/packlib/hbook/versions/v4_15
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: v4_15,v 1.1.1.1 1996/01/16 17:08:11 mclareni Exp $
-*
-* $Log: v4_15,v $
-* Revision 1.1.1.1 1996/01/16 17:08:11 mclareni
-* First import
-*
-*
-*CMZ : 02/06/92 17.55.07 by Rene Brun
-*-- Author : Rene Brun 17/04/92
-*
-*::> VERSION 4.15/00 920417 17.05
-*
-*
-* Bug fixed in HCREATEM/HMAPM (SYS5) by Chip Watson Cebaf.
-*
-* Bug fixed in HRESET in case of ntuples (J.Colas)
-*
-* Set error criterion properly for Chi**2 or Liklihood fits
-* routine HMINUT corrected (John Marraffino)
-*
-* Changes in HCDES. New sequence HCFITD.
-* HCFITD introduced in HFCNH,HFCNV,HGAUS,HDEXPO and HPOLYN.
-* COMMON/HCFITD/FITPAD(25) may be used in user routine FUTIL
-* instead of single precision parameters.
-*
-* Bug fixed in HFITHN (return array PARAM) Ian Scott
-*
diff --git a/src/packlib/hbook/versions/v4_16 b/src/packlib/hbook/versions/v4_16
deleted file mode 100644
index 49d1321..0000000
--- a/src/packlib/hbook/versions/v4_16
+++ /dev/null
@@ -1,15 +0,0 @@
-*
-* $Id: v4_16,v 1.1.1.1 1996/01/16 17:08:11 mclareni Exp $
-*
-* $Log: v4_16,v $
-* Revision 1.1.1.1 1996/01/16 17:08:11 mclareni
-* First import
-*
-*
-*CMZ : 4.16/00 24/07/92 08.20.42 by Rene Brun
-*-- Author : Rene Brun 24/07/92
-*
-*::> VERSION 4.16/00 920724 8.20
-*
-* New routine HLNEXT to scan the content of a HBOOK, RZ directory
-*
diff --git a/src/packlib/hbook/versions/v4_17 b/src/packlib/hbook/versions/v4_17
deleted file mode 100644
index 24172cb..0000000
--- a/src/packlib/hbook/versions/v4_17
+++ /dev/null
@@ -1,138 +0,0 @@
-*
-* $Id: v4_17,v 1.1.1.1 1996/01/16 17:08:11 mclareni Exp $
-*
-* $Log: v4_17,v $
-* Revision 1.1.1.1 1996/01/16 17:08:11 mclareni
-* First import
-*
-*
-*CMZ : 4.17/09 16/02/93 10.01.47 by Rene Brun
-*-- Author : Rene Brun 31/07/92
-*
-*::> VERSION 4.17/09 930216 10.01
-*
-* Names of some ZEBRA banks modified. DDL implemented.
-* Mods in routines to list directories.
-* Bug fixed in HFNT2 in case a CWN is filled again (Dave Rees)
-*
-*::> VERSION 4.17/08 930204 11.57
-*
-* Nasty bug found in HNTWRT. When routine HCDIR is called,
-* then IDLAST is reset to 0. If HNTWRT was called again,
-* in the same call to HFNT, then IDRZ(1)=0 !
-*
-* Bug fixed in HLABEL and HLPOS (found by M.Goossens).
-*
-*::> VERSION 4.17/07 930201 14.06
-*
-* Changes in the Ntuple handling routines for ntuples with arrays
-* and substructures.
-*
-*::> VERSION 4.17/06 930126 18.16
-*
-* Changes in HGNT2 and HGNTF for ntuples with arrays.
-* Protection in case of large ntuples that could not be processed
-* by PAW.
-*
-*::> VERSION 4.17/05 930124 13.19
-*
-* Protections in HROPEN if filename already attached.
-* Change in HRFILE for option 'O' (exchange mode not used)
-* Bug fix in HRMDIR, HMDIR, HGN and HGNF.
-* Bug fix in HALLOC (wrong memory allocation when the new buffer
-* is bigger than the previous one for the same column)
-*
-*::> VERSION 4.17/04 930120 8.10
-*
-* The following problems fixed after the release:
-* Implement option 'O' in HRFILE to create old format files
-* Corresponding changes in HREND,HRIN,HRMDIR,HMDIR,HFN
-* Bug fixes when merging old-format with new-format ntuples
-* Bug fixed in HLABEL for 2-D case.
-* Bug fixed in HLNEXT,HLDIR2 to access the first key of a file.
-* Replace BIGP in HBOOKN by 1.E30 to avoid overflow on IBM.
-*
-*
-*::> VERSION 4.17/03 930115 17.09
-*
-* Version released for cernlib 93a
-*
-*
-*::> VERSION 4.17/02 921221 17.56
-*
-* Implement option 'E' in HOPERA.
-*
-* Changes in HSCR to delete ntuples
-*
-* New routine HDDIR to delete directories (memory or RZ)
-*
-* Bug fixed in HMINUT when option 'E' given
-* COMMON/HCFITD/FITPAD(25) may be used in user fcn routine (DOUBLE P)
-*
-* New example HEXAM8 in patch,HEXAM
-* Example HEXAM6 modified.
-* New ZEBRA pointers LHFIT,LFUNC,LHFCO,LHFNA introduced in HCBOOK
-* Changes in HSUPIN,HSUPIS
-*
-*::> VERSION 4.17/01 921207 16.54
-*
-*
-*
-* New set of routines to store alphanumeric labels on the axes.
-* Corresponding routines (HFC1,HFC2) to fill histograms with labels
-* (implementation by P.Aubert)
-*
-* New routine HFINAM to store the names of the parameters after HFIT..
-*
-* Modifications in HRZIN for PAWSERV
-*
-* Reorganization of LHBOOK and LCDIR links (See HLIMIT)
-* Link 8 of LHBOOK/LCDIR reserved for HPLTAB (instead of link 4)
-*
-* New Patch,HDIFF introduced (Rich Genik from D0)
-* New routine HDIFFB to compare histograms bin by bin
-* Existing routine HDIFF moved to this patch from patch,HBOOK.
-*
-* New Patch,HQUAD introduced (Author John Allison Manchester)
-* HQUAD (see routine HQUAD) performs a fit with multiquadric radial
-* basis functions on 1- and 2-D histograms and ntuples with up to
-* NDMAX variables.
-*
-*::> VERSION 4.17/00 920731 15.54
-*
-*
-* New PATCH,HNTUP introduced
-* All routines referencing ntuples modified, including I/O routines.
-* See new HBOOK manual for a complete description of the new ntuples.
-* Sequences /HCBOOK/, /HCDIRE/ modified.
-* Same sequences used by HPLOT and PAW (must be recompiled).
-*
-*
-* Protection in HOPER1 (divide by 0) (D.Sanders)
-*
-* Routine HFITHC modified. DOUBLE PRECISION added.
-* Option 'L' added in HFITHN
-*
-* Changes in HPAK,HFCX,HFCXY to increment the number of entries
-* following the sum of the contents in case of integer contents
-*
-* Bug corrected in HGNPAR for memory-resident ntuples (title garbled)
-* Bug corrected in HRIN for memory-resident ntuples (title garbled)
-*
-* Bug in output format in routine HWRITF corrected (Janusz Chwastowski)
-*
-*
-* ! ! ! ! W A R N I N G ! ! ! !
-*
-* HBOOK/RZ file format is changed. New version of HBOOK can still read
-* old format files. The change consists in adding a new key.
-* KEY(1)=ID as in old format
-* KEY(2)=ntuple extension number (0 for histograms)
-* The new array ICHTYP(20) in HCDIRE contains the type of HBOOK file.
-* ICHTYP(ICDIR)=1 for old format HBOOK files
-* =5 for new files
-* The new HBOOK files are machine independent and can be transported
-* across all architectures with normal binary FTP.
-* Maximum number of records in HBOOK file changed from 4000 to 16000
-* 'X' EXchange mode is now set automatically
-*
diff --git a/src/packlib/hbook/versions/v4_18 b/src/packlib/hbook/versions/v4_18
deleted file mode 100644
index be02bd6..0000000
--- a/src/packlib/hbook/versions/v4_18
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: v4_18,v 1.1.1.1 1996/01/16 17:08:11 mclareni Exp $
-*
-* $Log: v4_18,v $
-* Revision 1.1.1.1 1996/01/16 17:08:11 mclareni
-* First import
-*
-*
-*CMZ : 4.18/00 26/02/93 08.35.02 by Rene Brun
-*-- Author : Rene Brun 26/02/93
-*
-*::> VERSION 4.18/00 930226 8.35
-*
-* Routine HLATTR rewritten
-* New version of routine HQWAVE by John Allison
-* Mods in HFNT2
-*
diff --git a/src/packlib/hbook/versions/v4_19 b/src/packlib/hbook/versions/v4_19
deleted file mode 100644
index 97decb3..0000000
--- a/src/packlib/hbook/versions/v4_19
+++ /dev/null
@@ -1,116 +0,0 @@
-*
-* $Id: v4_19,v 1.1.1.1 1996/01/16 17:08:11 mclareni Exp $
-*
-* $Log: v4_19,v $
-* Revision 1.1.1.1 1996/01/16 17:08:11 mclareni
-* First import
-*
-*
-*CMZ : 4.19/05 08/06/93 12.17.57 by Rene Brun
-*-- Author : Rene Brun 29/04/93
-*
-*::> VERSION 4.19/05 08/06/93 12.17.57
-*
-*
-* Add new sequence /CZCBUF/IZCBUF
-* Changes in HMACHI,HRDIR and HLOGPF to use JUMPT2 to call CZGETC
-*
-*::> VERSION 4.19/04 07/06/93 08.48.10
-*
-*
-* Changes in HLNEXT (implement client/server for PIAF)
-* Routine HCREATEM modified for SYSV systems (ICOMAD(1) set to 0)
-* HRECOV improved for CWN. Recovery time faster.
-* Problem fixed in handling of chains (1st event was missed occasionally)
-*
-*::> VERSION 4.19/03 27/05/93 15.28.21
-*
-* LINUX version introduced (from V.Balashov and A.Lomov)
-*
-* Changes to HRECOV. New routines HRECO1 and HRECO2
-*
-*::> VERSION 4.19/02 26/05/93 16.00.03
-*
-*
-* New routine HRECOV to recover ntuples missing the last header info.
-* HRECOV attempts to read the latest saved header. From the header
-* information, it looks at all ntuple extensions to reconstruct
-* the maximum number of blocks/events.
-* If successful, the new header is written to the file
-* Header of CWM Ntuple is written the first time a content buffer
-* is written. The header is written again whenever a column has
-* been added to the Ntuple. After every HFNT2 call that caused
-* buffers to be written the RZ directory structure is flushed to disk.
-* These intermediate Ntuple headers are used by the HRECOV routine.
-* They can be recognized by the fact that IQ(LCID+ZNOENT) = -1.
-*
-* Protection added in HBFUN2 (for HRNDM2) (O.Perdereau)
-*
-* Improvements to HQSIG1/2/3. (J.Allison)
-*
-* Mods in HROPEN. An already open file in U mode cannot be attached
-* if another process is also attaching the file in U mode. RZEND now
-* called to delete the ZEBRA structure.
-*
-*::> VERSION 4.19/01 11/05/93 15.19.34
-*
-* New sequences $CZBUFF and $CZSOCK in HCDES
-* Changes in HCDIR, HRDIR and HLOGPF for the PIAF server case
-*
-* Routine HFN saves now the ntuple header and calls RZSAVE everytime
-* the RZ buffer is written to the file. This changes enables recovery
-* in case the job writing the ntuple crashes before HROUT/HREND.
-*
-* HRIN modified for the ADD option (IOFSET=99999)
-* A user reported a case where ID1+IOFSET=ID of an existing histogram.
-* When IOFSET=99999, the internal offset is now chosen to avoid a conflict.
-*
-* Bug corrected in HXE for variable bin size histograms
-*
-* Mods in Memory mapping routines HCREATEM and HALLOC
-*
-*::> VERSION 4.19/00 930429 8.34
-*
-* WARNING!!!. Patch HCDES split into individual sequences.
-*
-* New sequences JBYT3,JBYT4 introduced for MSDOS.
-* New sequence HCRLF (Carriage Return, Line Feed).
-* Several routines modified to introduce the flags MSDOS,NDP and GNU.
-* In printing formats, several '1' replaced by CRLF from HCRLF.
-*
-* Sequence $HCK modified. Parameters KBWIDX,KBWIDY deleted.
-* Parameters KMIN,KMAX renamed KMIN1 and KMIN2.
-* New Parameters KMIN2,KMAX2.
-* Logic to support HMINIM AND HMAXIM for 2-DIM implemented.
-* As a consequence the inverse of the binwidth is not stored
-* anymore in the LCID structure.
-* The position Q(LCID+KBWIDX) is now occupied by Q(LCID+KMIN2)
-* The position Q(LCID+KBWIDY) is now occupied by Q(LCID+KMAX2)
-* Routines HMAXIM/HMINIM modified.
-* All HBOOK/HPLOT routines dealing with the binwidth are changed.
-*
-* Bug fixed in HMINUT. In case of loglikelihood fits, the
-* MINUIT ERRDEF was incorrectly set to 0.5
-*
-* Sequence /HCFITD/ has been modified to FITPAD(24),FITFUN
-* When the option 'U' is given in the fit routines, the application
-* must store the value of the function in FITFUN (Double Precision).
-* By default, HFITGA,PO,EX use the 'U' option.
-*
-* Change in routine HOPER1 to prevent INTEGER Overflows in HFCX.
-* Number of entries in LC3 set to -1
-*
-* Logic to handle ntuple chains introduced.
-*
-* Bug corrected in HRZFRA (VAX version only)
-*
-* Changes in HBUG (CHMESS(1:1)=+ prints Warning instead of Error
-*
-* KEEP,HCFITR modified (added IFYLOW,IFYUP, renamed IFXLOW,IFXUP)
-* Introduce subrange in Y in all fitting routines
-*
-* HBFUN1: Change LCONT to LFUNC. LCONT recomputed if user function
-* calls HFIND.
-* HRZIN: Change LBANK-JBIAS to LBANK+JBIAS
-* New routines for chains
-* New option 'A' in HDIFFB
diff --git a/src/packlib/hbook/versions/v4_20 b/src/packlib/hbook/versions/v4_20
deleted file mode 100644
index 3903228..0000000
--- a/src/packlib/hbook/versions/v4_20
+++ /dev/null
@@ -1,231 +0,0 @@
-*
-* $Id: v4_20,v 1.1.1.1 1996/01/16 17:08:11 mclareni Exp $
-*
-* $Log: v4_20,v $
-* Revision 1.1.1.1 1996/01/16 17:08:11 mclareni
-* First import
-*
-*
-*CMZ : 4.20/14 22/10/93 11.19.43 by Rene Brun
-*-- Author : Rene Brun 21/06/93
-*
-*::> VERSION 4.20/14 22/10/93 11.19.43
-*
-* Remove IOFSET limitation in HRIN for ntuples
-*
-*::> VERSION 4.20/13 21/10/93 15.10.39
-*
-* Introduce WINNT flag in nearly all routines with the LINUX flag.
-*
-* Large array T removed in HMCLNL (C.Beeston)
-*
-*::> VERSION 4.20/12 18/10/93 17.48.08
-*
-*
-*::> VERSION 4.20/11 15/10/93 16.56.03
-*
-*
-* Routine HGNTBF: fixed bug in case an index variable fit in memory
-* while the variable depending on that index variable did not fit in
-* memory.
-*
-*::> VERSION 4.20/10 13/10/93 18.01.16
-*
-*
-* Implement possibility to list/plot histograms in a subdirectory
-* of a shared memory section. Mods in HCOPYU and HPLISM.
-*
-* Routine HMCMLL: put DATA statement after declarations.
-*
-* Routine HCDIR: don't allow to CD to server connection point (like
-* cd //piaf1) this does not make sense plus it causes conflicts when
-* a chain is named piaf1.
-*
-* Routine HNBUF: first word of contents back must be zeroed. Fixes bug
-* when filling different Ntuples with index variables in the same job.
-*
-* KEEP,HCMPCM contained +SELFs: OK for CMZ not for Patchy.
-* New KEEPs,HCMPCM1 and 2.
-*
-*::> VERSION 4.20/09 28/09/93 16.39.40
-*
-*
-* New PATCH,HMCSTAT from Christine Beeston, R.Barlow from OPAL.
-* Fits the given Monte Carlo distributions to the data distribution, using
-* a binned maximum likelihood fit which includes the effect of both data
-* and Monte Carlo statistics, and allows weights to be
-* provided for each Monte Carlo distribution. The data and Monte Carlo
-* distributions must be presented in 1 dimensional histograms.
-* The best estimate of the fraction of each Monte
-* Carlo distribution present in the data distribution is returned, with an
-* error estimate where required.
-*
-* Common /PAWIDN/ : X(512) changed to X(522)
-*
-* New routines HPLISG,HPLISG1 in patch HGLOBAL.
-* Routine HLDIR modified to call new routine HPLISG (VAX only).
-* HPLISH can do a Histo/List in Global sections.
-*
-* Replace line with TEST.GT.1.5 by TEST.GE.0. in HFCN
-*
-*::> VERSION 4.20/08 12/09/93 18.57.43
-*
-*
-* Histogram directory bank LTAB created and MZPUSHed with 500 words
-* and links instead of 50. This speeds up considerably programs
-* using a large number of histograms.
-*
-* New deck HRNGPF in patch HBOOK
-* New deck HNDESC in patch HNTUP
-* Corrections in CWN filling and GET routines for character type columns
-*
-* Ulrich Mueller changes for IEEE computers in filling routines.
-* There is an unpleasant feature in HBOOK on computers with IEEE 754
-* floating point arithmetic (in our case on DECstations under Ultrix
-* 4.3a, CERNLIB 93b or 93d).
-*
-* Calculations on these machines can give as result Infinity or
-* Not-a-Number (NaN). If one tries to fill these numbers into histograms
-* (and this happens in real-world applications, especially during the
-* development phase of a program), some problems may arise:
-*
-* 1) Filling of +/- infinity as value. This case is handled properly by
-* the checks for over/underflow and the value is counted as such.
-*
-* 2) Filling of NaN as value. The over/underflow checks fail because
-* relations like .LT. or .GE. are always false if one of the operands
-* is NaN. Then the value is converted to a bin address, which is an
-* undefined integer and finally results in either a segmentation
-* fault or an overwriting of memory somewhere.
-*
-* However, this could easily be fixed, for example in HF1 (the other
-* routines are analogous):
-*
-* IF(X.LT.Q(LPRX+1))THEN
-* ICHAN=0
-* ELSEIF(.NOT.(X.LT.Q(LPRX+2)))THEN
-* ICHAN=IQ(LPRX)+1
-* ELSE
-* ... calculate bin address ...
-* ENDIF
-*
-* By changing the overflow check from .GE. to .NOT. .LT. the NaN
-* value will be counted as overflow. Another approach would be a
-* separate check for NaN, something like
-* IF (.NOT. (X.LT.0. .OR. X.GE.0.))
-* together with an appropriate error message.
-* ====> This changes has been made in all filling routines
-*
-* 3) Filling of Infinity or NaN as a weight. This is maybe the worst
-* case. The value is added to the bin, and this results in a crash
-* when the ZEBRA structure is written to a file, or in a crash of PAW
-* if one tries to plot the bad histogram.
-*
-* I propose to add a check for the finiteness of the weight. On most
-* machines a (C-)function "finite" is available for that purpose.
-* =====> This suggested change is not yet implemented.
-* Ulrich Mueller Exp. WA89, Div. PPE, CERN, CH-1211 Geneva 23
-* ulm at vsnhd1.cern.ch Phone +41-22-767-8658, FAX +41-22-7850314
-*
-*::> VERSION 4.20/07 07/09/93 12.09.33
-*
-* Optimization in HGNTBF in case of running on Piaf slave server
-*
-* Introduced the deck HRNGPF (formerly PFRANGE in the Paw source)
-*
-* Optimize logic of HCDIR for PIAF connections
-*
-*::> VERSION 4.20/06 06/09/93 12.20.45
-*
-* Optimize logic for sorting IDs in HRSORT
-*
-*::> VERSION 4.20/05 29/08/93 10.08.32
-*
-*
-* New routine HRSORT(CHOPT) to sort IDs in a RZ directory
-* HRSORT is automatically called by HLDIR if option 'S' given
-* Routine HLNEXT automatically sorts IDs in increasing order
-* HLNEXT is the routine called by the PAW++ browser
-*
-* New definition of $HCPIAF for parallel PIAF
-* Changes in HLOGPF,HINPF,HOUTPF for parallel PIAF
-*
-* Changes in LINUX version in HSHM
-*
-* Changes for Windows/NT (HMMAP in particular)
-*
-* Sequence/common/HCRECO renamed HCRECV to avoid clash with L3 programs
-*
-*::> VERSION 4.20/04 05/08/93 15.06.25
-*
-* Protections introduced in case of empty arrays in HGNT2,HGNTBF.
-*
-* Changes in Unix mapping memory routines.
-* SGI moved from BSD to SYS5 class.
-*
-*::> VERSION 4.20/03 03/08/93 15.30.17
-*
-*
-* Bug fix in HGNTBF for indexed variables in ntuples.
-*
-* Protection in HRESET to not reset ntuples.
-*
-* Protection in HRIN if IOFSET is not 0 for RWN ntuples.
-*
-* Changes in sequence HCNTPAW. MAXCOL=1000 replaced by:
-* MAXCR8=1000, MAXCR4=5000, MAXC32=1000
-*
-* Maximum number of files extended to 50.
-*
-* New routine HPROF2 to make profile histograms from 2-D histograms
-*
-* Mods in HMINUT to call a user routine (via JUMPX2) to read
-* MINUIT commands. (In paw the user routine is PMNCOMD)
-*
-* Decks HCDIR and HROUT: update LBUF and LTMP when switching between
-* different directories in memory.
-*
-* New routines HRESETM,HRESETM1,HREZ0M to reset histograms
-* in shared memory (from W.Bruckner).
-* New routines HPLISM,HPLISM1 to list histograms in shared memory (W.B.)
-* Mods in HLDIR to call HPLISM.
-*
-* Remove WARNING in HDIFFB in case of identical histograms (HDBINI)
-*
-*::> VERSION 4.20/02 23/07/93 10.44.48
-*
-* Mods in HRESET to reset HFIT structure
-*
-* Deck HFNT2: when value is out of range substitute max or min value,
-* also check range when only number of bits is specified.
-*
-* Deck HALLOC: moved code from PVMEM (PAW) into HBPRNT.
-*
-*::> VERSION 4.20/01 28/06/93 11.48.27
-*
-* Mods in HMINUT to call the new MINUIT routine MNCOMD.
-* The new routine MNCOMD is temporarily introduced as a DECK,MNCOMND
-* in the HBOOK file. This should be removed for the next release.
-* In particular MNCOMD will not work as it is on CRAYs.
-*
-*
-*::> VERSION 4.20/00 21/06/93 18.17.17
-*
-* Fix problem in HRIN (IOFSET moved to 1st statement)
-*
-* Deck HNTNAM: correct call to HBUG.
-*
-* Save in word 12 (ZID) of the CWN header the Ntuple ID used
-* to write the Ntuple extensions on disk. This ID necessary when an
-* Ntuple has been loaded in memory with on offset. Decks changed:
-* HRIN, HBNT, HNBUFR, HNTRD.
-*
-* Deck HGNTF: changed some error checks.
-*
-* Deck HNTMPF: forgot to set LTMP1 (caused problems reading and
-* writing CWN's at the same time).
-*
-* Deck HRECOV: set NTCUR=0 and fixed special case of endless loop.
-*
-* Fixed bug in HALLOC (block names of 8 characters were overwriting
-* on VMS systems the first character of the column name)
diff --git a/src/packlib/hbook/versions/v4_21 b/src/packlib/hbook/versions/v4_21
deleted file mode 100644
index 4fd309f..0000000
--- a/src/packlib/hbook/versions/v4_21
+++ /dev/null
@@ -1,194 +0,0 @@
-*
-* $Id: v4_21,v 1.1.1.1 1996/01/16 17:08:11 mclareni Exp $
-*
-* $Log: v4_21,v $
-* Revision 1.1.1.1 1996/01/16 17:08:11 mclareni
-* First import
-*
-*
-*CMZ : 4.21/13 17/03/94 10.36.58 by Rene Brun
-*-- Author : Rene Brun 26/10/93
-*
-*::> VERSION 4.21/13 17/03/94 10.36.57
-*
-* Routine HNTDEL has been rewritten (cannot call HLOOP if HDELET is called)
-*
-*::> VERSION 4.21/12 16/03/94 17.42.29
-*
-* Correct bug in HNTDEL (see after HDELET the 2 lines commented)
-*
-* Mods in HGIVE to return TITLE in case of ntuples
-*
-* HRESET can reset memory resident ntuples
-*
-*::> VERSION 4.21/11 12/03/94 15.48.34
-*
-* New routine HRENDC
-* C I/O option implemented in HRFILE/HROPEN
-*
-*::> VERSION 4.21/10 03/03/94 16.00.31
-*
-* Maximum size of PAWCR4 increased from 5000 to 50000 words
-*
-*::> VERSION 4.21/09 28/02/94 18.55.39
-*
-* Option 'W' can be specified with option 'L' (log likelihood)
-* When option W is given, bins with errors=0 are not used in the fit.
-*
-* New option 'Z' added in HFITV.
-* When option 'Z' is given, UFCN is the user fitting model
-* UFCN is a subroutine with the calling sequence:
-* Subroutine UFCN(N,X,Y,EY,NPAR,IFLAG,NPFITS)
-* where X(N),Y(N),EY(N) are the input vectors,
-* NPAR the number of parameters
-* NPFITS is an output parameter= Number of points used in the fit
-* The user must declare the common/HCFITD/FITPAD(24),FITFUN in UFCN
-*
-* Change name of routine HBIBNIT to HBINIT1 to avoid clash with OPAL.
-*
-* New routine HKIND returning the type of ID.
-*
-* Bug corrected in HFITV: variable BINWID not set. (Reported by W.Mueller)
-*
-* Argument missing in CALL MZPUSH in routine HRZKEY.
-*
-* bug corrected in HGNTBF:
-* return as negative error the number of columns that we load from disk
-*
-*::> VERSION 4.21/08 17/02/94 16.41.07
-*
-* Change DLOG, DSIGN and DABS to SIGN,LOG and ABS in patch HMCSTAT.
-*
-* New routines HKFILL, HKF1, HKFF1, HKF2, HKFF2, HKFILPF,HKFI1,HKFFI1.
-* These routines are fast filling routines called in teh context of PAW
-* by the new COMIS translator facility.
-*
-* Packing of floating points in CWN was not correct.
-* Fixes are in routines HFNT2, HGNT2, HGNTF, HNTNAM.
-*
-* Set IQUEST(1) in HRZIN/HRZOUT.
-*
-* Clear buffers in HREND.
-*
-* Changes in HCDIR/HLDIR and HLNEXT for PIAF files.
-*
-* Changes in HROUT and HNTRD:
-* Status word should be 0 when buffer comes from disk. However, in one
-* strange case (when coming from Piaf) it was not 0.
-*
-* New routine HF1E(id,x,w,e) to fill a 1-D histogram
-* ID contents incremented by W
-* ID errors incremented by E**2
-*
-* New routine HBOOKNC. This new routine has a calling sequence
-* very close to HBOOKN and creates a CWN instead.
-*
-* Changes in pilot patch for WINNT and MSDOS versions.
-*
-* Don't reset LBUF and LTMP in HCDIR and HROUT. Only update the
-* master pointer LBUFM and LTMPM. Other routines involved: HNBUF,
-* HNBUFD, HNBUFR, HNTMP, HNTMPD. This fixed a bug reported
-* by M. Dahlinger.
-*
-* New routine HNTDEL. This routine is called by HREND and deletes
-* all Ntuple headers of non-memory resident Ntuples related to the
-* closed unit from //PAWC.
-*
-* In HRZCD used sequence $CZSOCK.
-*
-* Compute binomial errors in HOPERA if option B is given.
-*
-* New routines HBONT,HFONT,HFONTR,HFONTCX to create and fill
-* an Omnipurpose Column-Wise-ntuple.
-* NEW sequence /HCBONT/
-*
-* Optimisation in HRZKEY
-*
-* In HNTNAM a protection was missing
-* and in HBSET ierror was not initialized
-*
-*::> VERSION 4.21/07 20/12/93 13.01.27
-*
-* Changes in HRDIR for Unix shared memory.
-* New routine HRDIRM in patch HMMAP called by HRDIR.
-*
-* Bug corrected in HLATTR for global sections
-*
-* Bug corrected in HBNT and HROUT for CWN memory-resident ntuples in
-* the case of subdirectories in RZ file.
-* Same bug in HNBFWR and HNTRD.
-*
-* Bug corrected in HPAKAD
-*
-* Bug fixed in HGNTF in case of packing and multiple ntuples
-*
-* Protection in HBNAME (HNTNAM)
-*
-*::> VERSION 4.21/06 09/12/93 08.56.15
-*
-* Bug found in the hmcstats code and fixed. The bug would have
-* caused slightly different results for people using VERY low monte carlo
-* statistics, with lots of empty bins (Christine Beeston).
-*
-* New routines HLNXTG and HLNXTG1 in HGLOBAL.
-* New routines HLNXTM and HLNXTM1 in HMMAP.
-* New routines HRZING and HRZINM called from HLATTR.
-* These new routines are called by HLNEXT to return the next
-* object from a global section or shared memory.
-*
-*::> VERSION 4.21/05 29/11/93 17.23.14
-*
-* New routine HOPTPF to send /HCOPT/ to PIAF.
-*
-*::> VERSION 4.21/04 29/11/93 08.15.23
-*
-* New routine HSTAF(CHOPT).
-* If CHOPT='YES' ststistics are computed at filling time.
-* routines modified: HBOOK1, HBOOK2, HBPROF, HMACHI.
-* new sequence /HCOPT/
- HSTAF is automatically called by the HPLOT options 'HSTA' and 'HNST'
-*
-*::> VERSION 4.21/03 25/11/93 15.47.53
-*
-* New routine HRZKEY called by HRIN. The new routine may speed up
-* considerably the routines HGN and HGNF. It computes the serial key
-* number for each ntuple extension and stores it in a bank which
-* is the next of LCONT.
-* Routines HGN and HGNF modified accordingly.
-*
-*::> VERSION 4.21/02 17/11/93 13.06.05
-*
-* Problem in HCDIR preventing the RLOGIN command in PAW is fixed.
-*
-* Modify HRENID to process old/new RWNs and CWNs
-*
-* Changes in HCREATEG to support ALPHA/VMS global sections.
-*
-*::> VERSION 4.21/01 16/11/93 08.52.59
-*
-* Add type declarations in HUWFUN
-*
-* In HINDEX, change format from I6 to I7.
-*
-* Mods in HCDIR for the old PIAF/PAWSERV.
-*
-* Mods in HDELET/HIDPOS for PIAF (add new sequence $HCACHE).
-*
-* Implement possibility to add 1-D histograms with alphanumeric labels
-* Mods in HOPERA. New routine HOPER1A.
-*
-* Protection in routine HDBCOP (R.J.Genik). See comments in routine.
-*
-* Set bit 5 to 0 in HLABEL
-*
-*::> VERSION 4.21/00 26/10/93 15.39.39
-*
-* Unused parameters deleted in the following routines:
-* HRESETM1,HREZ0M,HCOPYN,HCOPYT.
-*
-* The following obsolete routines from HBOOK version 3 have been deleted:
-* HCORE,HDISKF,HFNEXT,HISTGO,HLCM,HLCM3,HLOK,HSTORE,HUNLOK,HWRITE.
-*
-* Change format in HFNT2 error message (mail from Yves Roblin)
-*
-* Remove unused variables or common blocks
diff --git a/src/packlib/hbook/versions/v4_22 b/src/packlib/hbook/versions/v4_22
deleted file mode 100644
index a8d0378..0000000
--- a/src/packlib/hbook/versions/v4_22
+++ /dev/null
@@ -1,234 +0,0 @@
-*
-* $Id: v4_22,v 1.1.1.1 1996/01/16 17:08:11 mclareni Exp $
-*
-* $Log: v4_22,v $
-* Revision 1.1.1.1 1996/01/16 17:08:11 mclareni
-* First import
-*
-*
-*CMZ : 4.22/14 14/10/94 12.20.44 by Rene Brun
-*-- Author : Rene Brun 30/03/94
-*
-*::> VERSION 4.22/14 14/10/94 12.20.44
-*
-* Due to some early design mistake PAW expects all character columns to
-* be returned in character*32 variables instead of in variables of the
-* original size. For single character variables this was fine, however
-* character array columns were not restored correctly (unless they had
-* an original size of 32). To fix this HBOOK has to know if the Ntuple
-* is read back by PAW. Bit 3 in the status word of the first block is
-* set in this case (in HBNAM). HGNT2 and HGNTF check this bit in case
-* of character arrays. Routines modified: HBNAM, HGNT2, HGNTF, HNTGET,
-* HRIN.
-*
-*::> VERSION 4.22/13 28/09/94 08.40.30
-*
-* Change in HBUG. When LERR.LE.0 error messagse are not printed.
-*
-* HNTDEL: fix UHTOC call (don't multiply NCHRZ by 4).
-*
-* Change default quota to 32000 records in HRFILE
-*
-*::> VERSION 4.22/12 19/09/94 11.16.36
-*
-* Move VIDQQ sattement in HLIMAP to avoid problem with F2C.
-*
-*::> VERSION 4.22/11 05/09/94 13.36.29
-*
-* Many decks indented.
-*
-* New option in HLIMAP.
-* When the first parameter LIMIT=0, an existing shared memory
-* is attached as the current directory. In this case, HLIMIT must have been
-* called before.
-*
-* Changes in HDIFF to solve numerical problems (precision).
-*
-* Extend range of formats in HINDEX and HINPRX.
-*
-* Bug corrected in HRESETM1 and HREZ0M in case of profile histograms
-* or histograms with error bars (bug reported by W.Brueckner)
-*
-* Protection in HFCXY for large real numbers
-*
-*::> VERSION 4.22/10 04/08/94 14.58.02
-*
-* Routine HALLOC:
-* Free all Ntuple buffers or all buffers belonging to Ntuples in
-* the same unit.
-* If lun<0 free all Ntuple buffers that are in use (do this from an
-* exception handler in case the filling of the buffers was
-* interrupted).
-*
-* Modification in HREBIN. If IFIRST<0 then do not normalize Y values
-*
-* Bug corrected in HMINUT when option 'E' is specified.
-* NARGS must be set to 0 before calling MNEXCM in this case.
-* (Problem reported by Marcos Dracos)
-*
-* Profile histograms can be filled with weights (mods in HFILPF)
-*
-*::> VERSION 4.22/09 27/07/94 18.45.44
-*
-* Implement calculation of errors in HOPERA for 2-D histograms
-*
-* Deck HALLOC: force refill of Ntuple cache also when event range changes.
-* added new routine HBFREEC to free cache associated
-* with chains.
-*
-* Routine HBALLOC: pass also first event (to define event range).
-*
-* Routine HGNT1: accepts dynamic buffer offsets as argument (used by
-* HGNTBF).
-*
-* Routines HGNT, HGNTV, HGNTB: changed call to HGNT1 accordingly.
-*
-* Routine HGNT2: check for the usage of the cache for each variable
-* instead of only once.
-*
-* Routine HGNTBF: completely re-written. Does not read a whole column
-* in cache anymore. Is now a convenient front-end for HGNT2 with the
-* IVOFF cache offsets set.
-*
-* New routine HCPOFF: copy cache offsets into an array IVOFF. This array
-* is used in case of chains in PAW to continue filling the cache in the
-* place where the last call to HGNTF stoped.
-*
-*::> VERSION 4.22/08 15/07/94 09.31.43
-*
-* Modify calling sequence of HNTDUP (new convention for NEWBUF)
-*
-* New routine HBGMAX in HALLOC to return the maximum amount of memory
-* that may be malloced.
-*
-* Protection in HSCR in file in READ only mode
-*
-* New routine HCONVOL introduced (Per Steinar Iversen)
-* See comments in routine
-*
-* Modify dummy calls to HFUNC,HSUPIM,HSUPIS to avoid intercompilation
-* analysis message on Alpha/VMS.
-*
-*::> VERSION 4.22/07 28/06/94 17.44.26
-*
-* New routine HMERGE(Nfiles,Files,Filout)
-* New Routine HMERGIN calls HMERGE
-*
-*::> VERSION 4.22/06 28/06/94 08.25.18
-*
-* Mods in HRFILE to take into account possible new option 'N' in RZMAKE
-*
-* HRESET can reset ntuples
-* New routine HNTRSET called by HRESET for CWNtuples
-*
-* Implement new option 'K' in HMINUT
-*
-*::> VERSION 4.22/05 21/06/94 18.38.39
-*
-* Deck HALLOC: fix in case malloc and realloc fail.
-*
-* Routine HMERGE: need option X in HROPEN for auto-record length
-* detection to work on Alpha/OSF/VMS.
-*
-* Routine HNTDUP: updated some comments.
-*
-* Mods in HMINUT.
-* Set the FNIX and FEPS parameters in agreement with the MINUIT definition.
-* Defaults are unchanged. FNIX and FEPS can be modified via
-* the routine HSETPR or PAW command HSETPR.
-*
-* New routine HBAR2 to store errors for 2-D histograms
-* Routines HF2,HPAKE,HUNPKE,HFITH1 modified in consequence
-*
-* hfithc - protection against deviation being 0 is introduced
-*
-* hminut - correction MINUIT save file ISAV=7
-*
-* Protection in HNTNAM in case of misalignement (INTEGER*4 mixed
-* with REAL*8 variables in the same block).
-*
-*::> VERSION 4.22/04 08/06/94 11.38.01
-*
-* Routine HRENAME: works now also for CWN's.
-*
-* Routine HBNT: in case of memory resident Ntuple set IQ(LCID+ZNCHRZ)=0.
-*
-* Routine HUWFUN: cosmetic change.
-*
-* New routine HNTDUP: duplicates a complete Ntuple header. Works for
-* CWN's as well as RWN's.
-*
-* New routine HNTVDEF: returns a complete variable definition. Used
-* by HNTDUP (works for CWN's and RWN's).
-*
-* New patch HMERGE: this patch contains the program HMERG that can merge
-* hbook files with identical objects. Histograms are added and
-* Ntuples are combined. Works for CWN's and RWN's.
-* HMERG is the main program (to be selected with option MAIN). It calls
-* the main control routine HMERGE (user callable).
-*
-* Implement proposal from Stephane Coutu for the computation of errors
-* for profile histograms (see routine HBPROF)
-*
-* Add TYPE declaration to several sequences
-*
-* Changes in HIDOPT for option SHOW
-* Options PROS or PROE are displayed with option SHOW
-*
-* Mods in HCX for the computation of errors for profile histograms.
-* With the previous versions, channels with one entry only had
-* an error=0. Now the error is teh sqrt(abs(content)).
-*
-* Mystyping in HWPDCL (PAWR8 instead of PAWCR8
-*
-*::> VERSION 4.22/03 30/05/94 14.10.33
-*
-* Routine HLNEXT supports RLOGIN directories
-*
-* New routine HRENAME(ID,CHOLD,CHNEW) to rename columns of ntuples
-*
-* Bug fixed in HCDIR in case of subdirectories (hrout, option T, then HREND)
-*
-*::> VERSION 4.22/02 19/05/94 12.07.56
-*
-* Several changes in patch HMCSTAT (Christine Beeston)
-* >1) I've fixed the bug with the number of entries - I now use HSUM instead
-* >of HNOENT to get the number of entries in a histogram, since including
-* >the underflows and overflows messes up the normalisation of the result.
-* >
-* >2) The user can now do multiple simultaneous fits (this was requested and
-* >seems useful) - to do this they must call HMCINI once for each set of
-* >histograms (each fit will have a data histogram and a set of monte carlo
-* >and weight histograms), and then
-* >HMCLNL must be called with the histogram identifiers and number of MC
-* >sources, as well as the fractions.
-* >
-* >HMCMLL already uses the new HMCLNL, I have left the old HMCLNL as HMCLNO,
-* >but will delete it in a couple of months.
-* >
-* >HMCINI and the new and old versions of HMCLNL both contain a banner
-* >announcing the change, as it's not backwards compatible.
-* >
-* >The weight histograms may be used for more than one of the
-* >fits if necessary - a check is made to make sure that they are not
-* >normalised more than once.
-*
-* Minor change in HRENDC (nchmax=nchtop before loop)
-*
-* Mods in HMINUT to compute an equivalent chisquare in case
-* of a log-likelihood fit
-*
-* Bug fixed in HPAK in case weights <1.e-5 (number of entries was wrong)
-*
-* Protection in HREND (NCHTOP was changed in the loop)
-*
-*::> VERSION 4.22/01 07/04/94 09.04.32
-*
-* Bug corrected in HFC1 in case of empty histograms with one bin only
-*
-*::> VERSION 4.22/00 30/03/94 09.53.07
-*
-* Bug fixed in HBOOKN (IQ(LCIDN+5) set to ID) for disk-resident tuples
-* This bug affected HBOOK jobs calling HPROJ1,HPROJ2, HGN or HGNF when
-* the ntuple header was not written to the file
-*
diff --git a/src/packlib/hbook/versions/v4_23 b/src/packlib/hbook/versions/v4_23
deleted file mode 100644
index 58caffc..0000000
--- a/src/packlib/hbook/versions/v4_23
+++ /dev/null
@@ -1,51 +0,0 @@
-*
-* $Id: v4_23,v 1.1.1.1 1996/01/16 17:08:11 mclareni Exp $
-*
-* $Log: v4_23,v $
-* Revision 1.1.1.1 1996/01/16 17:08:11 mclareni
-* First import
-*
-*
-*CMZ : 27/07/95 17.22.32 by Julian Bunn
-*-- Author : Rene Brun 05/11/94
-*
-*::> VERSION 4.23/02 05/05/95 11.19.28
-*
-*
-*::> VERSION 4.23/01 22/02/95 14.34.06
-*
-* New user routines HIJE and HXYE for returning errors on cells in
-* 2D histograms a la HIE,HXE.
-*
-* New routine HBVERS in the C patch, that returns the version string.
-*
-* Some error checking and extra calls to HBUG in the HFNT tree.
-*
-* Modification to HCX to fix a bug produced when the routine was
-* called with option 2 (get error) for a histogram without the
-* required bank.
-*
-* Extra argument IOPT added to HCXY in order to allow the caller
-* to specify whether the contents (IOPT=1) or the error (IOPT=2)
-* on the given cell is returned.
-*
-* Bug corrected in HROUT. Problem was appearing in case of many
-* subdirectories. Variable NLCDIR was not correctly set when returning
-* to the parent level.
-*
-* Deck HNTDUP: declare IDUM to be REAL*8 to make it double-word aligned.
-*
-* Introduce DOUBLE PRECISION in HCX for Profile histograms
-*
-* Adjust HREBIN to allow for non-equiwidth bins.
-*
-*::> VERSION 4.23/00 05/11/94 09.36.29
-*
-* HLDIR with CHOPT='N' works now also for disk directories.
-*
-* Protect HMINUT when option Z is given (LINEAR was set to zero)
-*
-* Protection in HFN in case HGIVEN is called immediatly before.
-* LCONT pointer is now always recomputed.
-*
-* Implement ../ style in HPATH.
diff --git a/src/packlib/hbook/versions/v4_24 b/src/packlib/hbook/versions/v4_24
deleted file mode 100644
index 8088222..0000000
--- a/src/packlib/hbook/versions/v4_24
+++ /dev/null
@@ -1,68 +0,0 @@
-*
-* $Id: v4_24,v 1.1.1.1 1996/01/16 17:08:11 mclareni Exp $
-*
-* $Log: v4_24,v $
-* Revision 1.1.1.1 1996/01/16 17:08:11 mclareni
-* First import
-*
-*
-*CMZ : 24/10/95 14.32.46 by Julian Bunn
-*-- Author : Unknown 05/05/95
-*
-* 24/10/95 14.32.19
-*
-* Remove redundant option in HRENID
-*
-* 11/10/95 19.56.41
-*
-* Correct bug in HFILPR that was causing X values equal to the
-* end of the scale not to be filled in the overflow bin correctly.
-*
-* 11/10/95 17.51.27
-*
-* Modify HUWFUN so that option I does not cause calls to HBNAME to appear.
-*
-* 26/09/95 11.16.42
-*
-* Correction in hoper1 which previously was accessing non-existant
-* error banks for some histogram operations. (Sent by Mike Redmond)
-*
-* Removal of trigraph ???' in routines HLATTR HLNEXT and HLNXTG1
-*
-* Correction in HMCMLL for wrong number of args in call to MNEXCM
-*
-* 30/06/95
-*
-* Correction by Rene in HBIN for "big integers".
-*
-* 21/06/95
-*
-* Add test program for FPCLASSC patch. New directory TESTS for HBOOK
-* test programs ...
-*
-* 17/05/95
-*
-* Mod to HMDIR so that identically named sub-directories are not
-* created in memory.
-*
-* 16/05/95 10.30.55
-* Mods in HMINIM and HMAXIM to reset the min and the max when
-* the min is greater than the max for 2d histos (it was implemented
-* only for 1D).
-*
-* 05/05/95 14.57.05
-* FPCLASSC selected in *HBOOK
-*
-*::> VERSION 4.24/00 05/05/95 11.48.44
-*
-*
-* New patch FPCLASSC by Francois Dardare. This interfaces to the
-* system routines on the various platforms that identify the
-* IEEE NaNs (where appropriate), and classifies them in a general
-* way. The routines are called in HFILL, HFN and HFNT2 to check
-* user arguments, and warnings are issued where appropriate.
-*
-* New routine HNFORM for assiting users in creating the character
-* string that describes CW nTuple variables that is used as an
-* argument to HBNAME or HBNAMC.
-*
diff --git a/src/packlib/hepdb/Imakefile b/src/packlib/hepdb/Imakefile
deleted file mode 100644
index 3e13db0..0000000
--- a/src/packlib/hepdb/Imakefile
+++ /dev/null
@@ -1,25 +0,0 @@
-
-#define IHaveSubdirs
-#define PassCDebugFlags
-
-LIBDIRS= cddict cdfzup cdinit cdmdir cdofflin cdpack \ @@\
- cdpurge cdread cdroot cdstore cdunpack cdutil
-
-#if defined(CERNLIB_UNIX)
-LIBDIRS:= $(LIBDIRS) cdc
-#endif
-
-PROGRAMDIRS= programs
-
-SUBDIRS= $(LIBDIRS) $(PROGRAMDIRS) hepdb
-
-TopOfPackage(cdlib)
-
-SubdirLibraryTarget(cdlib,$(LIBDIRS))
-
-InstallBinSubdirs($(PROGRAMDIRS))
-
-test::
-
-
-InstallIncludeSubdirs(hepdb)
diff --git a/src/packlib/hepdb/cdc/Imakefile b/src/packlib/hepdb/cdc/Imakefile
deleted file mode 100644
index 249a1a9..0000000
--- a/src/packlib/hepdb/cdc/Imakefile
+++ /dev/null
@@ -1,3 +0,0 @@
-SRCS_C= cdhstc.c cduser.c
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/hepdb/cdc/cdhstc.c b/src/packlib/hepdb/cdc/cdhstc.c
deleted file mode 100644
index 8b46f2e..0000000
--- a/src/packlib/hepdb/cdc/cdhstc.c
+++ /dev/null
@@ -1,84 +0,0 @@
-/*
- * $Id: cdhstc.c,v 1.3 1997/09/02 13:12:44 mclareni Exp $
- *
- * $Log: cdhstc.c,v $
- * Revision 1.3 1997/09/02 13:12:44 mclareni
- * WINNT correction
- *
- * Revision 1.2 1997/03/14 17:07:30 mclareni
- * WNT mods
- *
- * Revision 1.1.1.1.2.1 1997/01/21 11:28:39 mclareni
- * All mods for Winnt 96a on winnt branch
- *
- * Revision 1.1.1.1 1996/02/28 16:24:07 mclareni
- * Hepdb, cdlib, etc
- *
- */
-#if defined(CERNLIB_UNIX)
-#include "hepdb/pilot.h"
-#include <stdio.h>
-#include <string.h>
-#if (!defined(CERNLIB_NEXT))&&(!defined(CERNLIB_WINNT))&&(!defined(CERNLIB_MSDOS))
-#include <sys/utsname.h>
-#endif
-
-#if defined(CERNLIB_WINNT)
-#include <windows.h>
-#endif
-
-#if defined(CERNLIB_NEXT)
-struct utsname{
- char sysname[9];
- char nodename[9];
- char nodeext[65-9];
- char release[9];
- char version[9];
- char machine[9];
- };
-#endif
-
-#define MAXHOST 8
-
-#if defined(CERNLIB_QXCAPT)
-# ifndef CERNLIB_MSSTDCALL
- int CDHSTC(hnf)
-# else
- int __stdcall CDHSTC(hnf,len_hnf)
-# endif
-#endif
-
-#if defined(CERNLIB_QXNO_SC)
-int cdhstc(hnf)
-#endif
-
-#if defined(CERNLIB_QX_SC)
-int cdhstc_(hnf)
-#endif
-
-char *hnf;
-
-#ifdef CERNLIB_MSSTDCALL
-int len_hnf;
-#endif
-{
-#ifdef MSDOS
- strncpy(hnf,"IBM PC",6);
-#else
-#ifdef WIN32
- int i = MAX_COMPUTERNAME_LENGTH+1;
- char q[MAX_COMPUTERNAME_LENGTH+1];
- GetComputerName(q,&i);
-#else
- int i = MAXHOST;
- struct utsname u;
- char q[MAXHOST+1];
-
- if (uname(&u) < 0) return(-1);
- sprintf(q,"%-*s",MAXHOST,u.nodename);
-#endif
- strncpy(hnf,q,i);
-#endif
- return(0);
-}
-#endif
diff --git a/src/packlib/hepdb/cdc/cduser.c b/src/packlib/hepdb/cdc/cduser.c
deleted file mode 100644
index 02f618d..0000000
--- a/src/packlib/hepdb/cdc/cduser.c
+++ /dev/null
@@ -1,87 +0,0 @@
-/*
- * $Id: cduser.c,v 1.3 1997/09/02 13:12:45 mclareni Exp $
- *
- * $Log: cduser.c,v $
- * Revision 1.3 1997/09/02 13:12:45 mclareni
- * WINNT correction
- *
- * Revision 1.2 1997/03/14 17:07:31 mclareni
- * WNT mods
- *
- * Revision 1.1.1.1.2.1 1997/01/21 11:28:40 mclareni
- * All mods for Winnt 96a on winnt branch
- *
- * Revision 1.1.1.1 1996/02/28 16:24:07 mclareni
- * Hepdb, cdlib, etc
- *
- */
-#if defined(CERNLIB_UNIX)
-#include "hepdb/pilot.h"
-#include <stdio.h>
-#include <string.h>
-#ifdef WIN32
-#include <windows.h>
-#else
-#ifndef MSDOS
-#include <pwd.h>
-#endif
-#endif
-
-#define MAXNAME 8
-
-#if defined(CERNLIB_QXCAPT)
-# ifndef CERNLIB_MSSTDCALL
- int CDUSER(sf)
-# else
- int __stdcall CDUSER(sf, len_sf, irc)
-# endif
-#endif
-
-#if defined(CERNLIB_QXNO_SC)
-int cduser(sf)
-#endif
-#if defined(CERNLIB_QX_SC)
-int cduser_(sf)
-#endif
-char *sf;
-#ifdef CERNLIB_MSSTDCALL
-int len_sf;
-int *irc;
-#endif
-{
-#ifdef MSDOS
- lname = 8
- strncpy(sf,"IBM PC",6);
-#else
- char *p;
- int lname;
- int i;
-#ifdef WIN32
- i = 0;
- p = (char *) malloc(MAXNAME+1);
- while(!GetUserName(p,&lname)) {
- free(p); i++;
- p = (char *) malloc(i*MAXNAME+1);
- }
-#else
- int ruid;
- struct passwd *pw;
-
- ruid = getuid();
- pw = getpwuid(ruid);
- lname = strlen(pw->pw_name);
-#endif
- if (lname > MAXNAME)
- lname = MAXNAME;
-#ifdef WIN32
- strncpy(sf,p,lname);
- free(p);
-#else
- strncpy(sf,pw->pw_name,lname);
-#endif
- for (i=lname; i < MAXNAME; i++)
- *(sf+i) = ' ';
-#endif
- return(lname);
-}
-#endif
diff --git a/src/packlib/hepdb/cdcdf/Imakefile b/src/packlib/hepdb/cdcdf/Imakefile
deleted file mode 100644
index 36c4469..0000000
--- a/src/packlib/hepdb/cdcdf/Imakefile
+++ /dev/null
@@ -1,5 +0,0 @@
-#define IHaveCDF
-
-SRCS_CDF= cdcdf.cdf
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/hepdb/cdcdf/cdcdf.cdf b/src/packlib/hepdb/cdcdf/cdcdf.cdf
deleted file mode 100644
index 082c6d3..0000000
--- a/src/packlib/hepdb/cdcdf/cdcdf.cdf
+++ /dev/null
@@ -1,480 +0,0 @@
-*
-* $Id: cdcdf.cdf,v 1.1.1.1 1996/02/28 16:24:08 mclareni Exp $
-*
-* $Log: cdcdf.cdf,v $
-* Revision 1.1.1.1 1996/02/28 16:24:08 mclareni
-* Hepdb, cdlib, etc
-*
-*
-*----------------------------------------------------------------
-*
-* HEPDB command definition file (CDF)
-*
-*----------------------------------------------------------------
->NAME CDCDF
->MENU HEPDB
->Guidance
-HEPDB shell commands
-
-*----------------------------------------------------------------
->command ALIAS
->Action CDKALI
->PARAMETERS
-+
-PATH 'Pathname ' C D=' '
-ALIAS 'Alias ' C D=' '
-CHOPT 'Options ' C D=' '
--D 'delete the alias definition for the specified path'
--P 'print the alias definition for the specified path'
--R 'retrieve and print the equivalence name for the specified alias'
--S 'set the alias for the specified path for the current session'
--U 'as S, but also update database'
->Guidance
-
-Use the ALIAS command to delete, print, retrieve, set or update
-alias definitions. The action of the command depends on the option
-specified by the CHOPT argument.
-
-*----------------------------------------------------------------
->command CDHELP
->Action CDKHLP
->PARAMETERS
-+
-PATH 'Pathname ' C D=' '
-FILE 'File ' C D=' '
-CHOPT 'Options ' C D=' '
--D 'delete the help information for the specified path'
--P 'print the help information for the specified path'
--R 'read the help information for specified path and enter into database'
--W 'write the help information for specified path into the file'
-
-*----------------------------------------------------------------
->command CDTEXT
->Action CDKTXT
->PARAMETERS
-+
-PATH 'Pathname ' C D=' '
-FILE 'File ' C D=' '
-CHOPT 'Options ' C D=' '
--D 'delete the text information for the specified path'
--P 'print the text information for the specified path'
--R 'read the text information for specified path and enter into database'
--W 'write the text information for specified path into the file'
-
-*----------------------------------------------------------------
->command COUNT
->Action CDOBJC
->PARAMETERS
-+
-PATH 'Pathname ' C D=' '
-CHOPT 'Options ' C D=' '
--D 'display number of subdirectories at each level'
--O 'display number of objects at each level'
--L 'display lowest level only, i.e. directories with no subdirectories'
--Z 'display only directories with no (zero) objects'
->Guidance
-Use the COUNT command to count the number of objects in the specified
-directory or directories.
-
-*----------------------------------------------------------------
->command FILES
->Action CDFILC
->Guidance
-Use the FILES command to display information on the database files
-that are currently open.
-
-*----------------------------------------------------------------
->command LOGLEVEL
->Action CDLOGC
->PARAMETERS
-+
-PATH 'Pathname' C D=' '
-LEVEL 'Loglevel' I D=0
-CHOPT 'Options ' C D=' '
->GUIDANCE
-Use the LOGLEVEL command to set the HEPDB logging level.
-.
-Syntax: LOGLEVEL path loglevel options
-
-*----------------------------------------------------------------
->command OPEN
->Action CDOPNC
->PARAMETERS
-PREFIX 'Prefix ' C D=' '
-+
-FILE 'Filename' C D=' '
-CHOPT 'Options ' C D='X'
--X 'The specified file is in Zebra RZ exchange data format
--N 'The specified file is in Zebra RZ native data format
->GUIDANCE
-Use the OPEN command to open a HEPDB file by specifying the database
-prefix.
-.
-Syntax: OPEN PREFIX FILENAME CHOPT
-
-*----------------------------------------------------------------
->command CLOSE
->Action CDCLSH
->PARAMETERS
-PREFIX 'Prefix of database file' C D=' '
-+
-CHOPT 'Options ' C D=' '
--A 'Close all files (prefix is ignored)'
->guidance
-Use the CLOSE command to close a HEPDB file opened by the OPEN
-command.
-*----------------------------------------------------------------
->command RZOPEN
->Action CDRZOP
->PARAMETERS
-NAME 'Topdir ' C D=' '
-FILE 'Filename' C D=' '
-+
-CHOPT 'Options ' C D='X'
--X 'The specified file is in Zebra RZ exchange data format
--N 'The specified file is in Zebra RZ native data format
->GUIDANCE
-Use the OPEN command to open any RZ file, including an HEPDB file
-.
-Syntax: RZOPEN TOPDIR FILENAME CHOPT
-
-*----------------------------------------------------------------
->command RZCLOSE
->Action CDCLSR
->PARAMETERS
-+
-NAME 'Topdir ' C D=' '
-CHOPT 'Options ' C D=' '
->GUIDANCE
-Use the CLOSE command to close a file opened with RZOPEN
-Syntax: CLOSE NAME FILE CHOPT
-
-*----------------------------------------------------------------
->command OUTPUT
->Action CDOUTP
->PARAMETERS
-+
-FILE 'Filename' C D=' '
-CHOPT 'Options ' C D=' '
--C 'close file and redirect output to terminal'
--P 'preserve case of file'
--R 'replace existing file'
--S 'switch back to previously opened file'
--T 'redirect output back to terminal'
->GUIDANCE
-Use the OUTPUT command to redirect output to a specified file.
-.
-Syntax: OUTPUT FILE
-
-*----------------------------------------------------------------
->command WINDOW
->Guidance
-Use the WINDOW command to set the insertion time window.
-Objects that were inserted outside the specified window
-will be invisible via the LS command.
-
-Syntax: WINDOW start-end
-
-The start and end times should be specified in the format
-
-yymmdd.hhmm
-
-Use the command WINDOW -R to reset to the default behaviour
-of no check on insertion time.
-
->Action CDWIND
->Parameters
-+
-RANGE 'date and time range' C D='-'
-CHOPT 'options ' C D=' '
--R 'Reset the time window to the default (no check)'
-*----------------------------------------------------------------
->command VERSION
->Guidance
-Use the VERSION command to display the version of the HEPDB
-software that you are running.
-Syntax: VERSION
->Action CDVERC
-
->MENU \HDBCAT
->Guidance
-Commands to manipulate HEPDB databases
-
-*----------------------------------------------------------------
->command CD
->Guidance
-Use the CD command to change the current default directory.
-.
-Syntax: CD path
->Action CDCDRC
->PARAMETERS
-PATH 'path' C D=' '
-+
-CHOPT 'options ' C D=' '
--A 'all of below'
--Q 'show quota for new directory'
--S 'show number of subdirectories'
--T 'show creation & modification times'
--U 'show usage information'
-
-*----------------------------------------------------------------
->command LD
->Action CDLDC
->PARAMETERS
-+
-PATH 'Pathname ' C D='*'
-NLEVEL 'Number of levels to display' I D=1
-CHOPT 'Options' C D=' '
--H 'Write a header showing the command and options'
--C 'List the creation date & time of the directory/ies'
--M 'List the modification date & time of the directory/ies'
--O 'Display the number of objects'
--R 'List subdirectories recursively'
--S 'Display number of subdirectories'
--T 'Display the tags for the directory/ies'
--V 'Generate a "very wide" listing (132 columns)'
--W 'Generate a "wide" listing (80 columns)'
->GUIDANCE
-Use the LD command to display subdirectories below the specified
-level.
-
-*----------------------------------------------------------------
->command LS
->Action CDLSC
->PARAMETERS
-+
-PATH 'Pathname ' C D=' '
-KSN 'Key serial number' I D=0
-BANK 'Bankname ' C D=' '
-ILNK1 'Index of the first link to be printed' I D=0
-ILNK2 'Index of the last link to be printed' I D=0
-IDAT1 'Index of the first word to be printed' I D=0
-IDAT2 'Index of the last word to be printed' I D=0
-CHOPT 'Options ' C D=' '
--C 'display object count'
--D 'display key definitions'
--E 'display the experiment keys'
--G 'display keys in a generic fashion (RZPRNK)'
--K 'display all keys'
--L 'list only lowest level (end node) directories (D)'
--M 'show maxima and minima of validity range pairs'
--N 'display number of data words'
--P 'display pathname (D)'
--S 'display the system keys'
--T 'display insertion date and time (RZ value)'
--U 'display user keys'
--V 'display validity range pairs'
--Z 'dump ZEBRA bank with DZSHOW'
->GUIDANCE
-Use the LS command to display the contents of a directory
-If option Z is specified, the name of the bank(s) to display
-may be given. If multiple banks are to be displayed, their names
-should be separated by commas. Wild cards are permitted in
-bank names.
-.
-Syntax: LS <options>
-
-*----------------------------------------------------------------
->command PWD
->Guidance
-Use the PWD command to print the current (working) directory.
-Syntax: PWD
->Action CDKPWD
->PARAMETERS
-+
-CHOPT 'Options ' C D=' '
--A 'Display alias name of current directory'
-
-*----------------------------------------------------------------
->command SEARCH
->Action CDSEAC
->Guidance
-Use the SEARCH command to search for something
->PARAMETERS
-PATH 'path name' C D='*'
-+
-CHOPT 'Options ' C D=' '
-
-*----------------------------------------------------------------
->command STATUS
->Guidance
-Use the STATUS command to print usage statistics on the
-specified directory down NLEVEL levels.
-Syntax: STATUS path nlevel
->Action CDRZST
->Parameters
-+
-PATH 'Path name ' C D=' '
-NLEVEL 'number of levels' I D=99
-CHOPT 'Options ' C D=' '
-
-*----------------------------------------------------------------
->command TREE
->Guidance
-Use the TREE command to draw a directory tree starting at the
-specified directory down NLEVEL levels.
-Syntax: TREE path nlevel
->Action CDTREE
->Parameters
-+
-PATH 'Path name ' C D=' '
-NLEVEL 'number of levels' I D=99
-CHOPT 'options ' C D=' '
--A 'show alias name (if any) for each directory'
--N 'show the number of objects for each directory if non-zero'
--O 'show the number of objects for each directory'
--S 'show the number of subdirectories for each directory'
--C 'show the date and time the directory was created'
--M 'show the date and time of the last modification (RZ)'
-
-*----------------------------------------------------------------
->command SELECT
->Guidance
-Use the SELECT command to specify the instant of validity for which
-objects are required.
-Syntax: SELECT
->Action CDSELE
->Parameters
-ISEL1 'Primary selection' I D=0
-+
-ISEL2 'Secondary selection' I D=0
-ISEL3 'Tertiary selection' I D=0
-
-*----------------------------------------------------------------
->command ZOOM
->Action CDZOOM
->PARAMETERS
-+
-PATH 'Pathname' C D=' '
->Guidance
-Use the ZOOM command to descend the specified (wild-carded)
-directory tree to the first lowest level directory that
-contains one or more entries
-.
-e.g. ZOOM DATA
-.
- ZOOM *DST/*/P88*
-.
->MENU \HDBMAN
->Guidance
-Utility commands
-
-*----------------------------------------------------------------
->command DIR
->Guidance
-Use the DIR command to issue a call to RZLDIR for the specified
-path. This command is normally used for debug purposes only.
-.
->Action CDRZLD
->Parameters
-+
-PATH 'path-name' C D=' '
-CHOPT 'options ' C D=' '
--T 'list also subdirectory tree'
--X 'eXtended listing - show also OFFSET,REC1,REC2'
-
-*----------------------------------------------------------------
->command EXTRACT
->Action CDEXTQ
->PARAMETERS
-+
-PATH 'Pathname' C D='*/*'
-OUTPUT 'Output filename' C D=' '
-CHOPT 'Options ' C D='C'
->GUIDANCE
-Use the EXTRACT command to copy a subset of the HEPDB catalogue
-
-*----------------------------------------------------------------
->command MERGE
->Action CDMERG
->PARAMETERS
-+
-INPUT 'Input filename' C D=' '
-PATH 'Pathname' C D='*/*'
-CHOPT 'Options ' C D='C'
->GUIDANCE
-Use the MERGE command to merge an update file created by
-the EXTRACT command into the specified path.
-
-*----------------------------------------------------------------
->command MKDIR
->Guidance
-Use the MKDIR command to create a directory
-Syntax: MKDIR directory_name.
->Action CDMKDR
->PARAMETERS
-DIRNAM 'directory' C D=' '
-
-*----------------------------------------------------------------
->command RM
->Guidance
-Use the RM command to logically remove an entry from the catalogue
-Syntax: RM
->Action CDRMC
->PARAMETERS
-+
-
-*----------------------------------------------------------------
->command RMDIR
->Guidance
-Use the RMDIR command to remove a directory from the catalogue.
-.
-N.B. directories can only be removed if
-.
- 1) They contain no subdirectories
-.
- 2) They contain no entries
-.
-If you wish to remove a complete directory tree that contains
-no entries, use the RMTREE command.
-.
-Syntax: RMDIR PATH
->Action CDRMDC
->PARAMETERS
-PATH 'directory' C D=' '
-
-*----------------------------------------------------------------
->command RMTREE
->Guidance
-Use the RMTREE command to remove a complete directory tree.
-.
-N.B. if any of the directories below the named directory
-contain entries, then the command will be refused.
-.
-Syntax: RMTREE PATH
->Action CDRMTC
->PARAMETERS
-PATH 'directory' C D=' '
-
-*----------------------------------------------------------------
->command PACK
->Guidance
-Use the PACK command to convert a date/time combination into
-its packed representation.
-.
-If IDATE=ITIME=0, then the current date and time will be used.
-.
-Syntax: PACK YYMMDD HHMM[SS]
->Action CDKPAK
->PARAMETERS
-+
-DATE 'date in YYMMDD format' I D='0'
-TIME 'time in HHMM/HHMMSS format' I D='0'
-CHOPT 'options ' C D='M'
--M 'pack date/time using CDPKTM (default)'
--S 'pack date/time using CDPKTS'
-
-*----------------------------------------------------------------
->command UNPACK
->Guidance
-Use the UNPACK command to convert a date/time combination into
-its packed representation
-.
-Syntax: UNPACK packed-time
->Action CDKUPK
->PARAMETERS
-PACK 'packed date/date' I D='0'
-CHOPT 'options ' C D='M'
--M 'unpack date/time using CDPKTM (default)'
--S 'unpack date/time using CDPKTS'
-
diff --git a/src/packlib/hepdb/cddict/Imakefile b/src/packlib/hepdb/cddict/Imakefile
deleted file mode 100644
index 1172187..0000000
--- a/src/packlib/hepdb/cddict/Imakefile
+++ /dev/null
@@ -1,9 +0,0 @@
-SRCS_F= cdalia.F cddinf.F cdeali.F cdehlp.F cdenam.F cdgali.F \ @@\
- cdgnam.F cdgpid.F cdhelp.F cdmdic.F cdname.F cdrali.F \ @@\
- cdrdic.F cdrhlp.F cdrnam.F cdsnam.F cdudic.F
-
-#if !defined(CERNLIB_P3CHILD)
-SRCS_F := $(SRCS_F) cdcdic.F
-#endif
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/hepdb/cddict/cdalia.F b/src/packlib/hepdb/cddict/cdalia.F
deleted file mode 100644
index 3ee6e1f..0000000
--- a/src/packlib/hepdb/cddict/cdalia.F
+++ /dev/null
@@ -1,74 +0,0 @@
-*
-* $Id: cdalia.F,v 1.1.1.1 1996/02/28 16:24:08 mclareni Exp $
-*
-* $Log: cdalia.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:08 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDALIA (CHPATH, CHALIA, CHOPT, IRC)
-*
-* Enter, retrieve, delete or print an alias definition
-*
- CHARACTER*(*) CHPATH,CHALIA
- CHARACTER*255 CHDIR
- CHARACTER*8 ALIAS
-#include "hepdb/cduscm.inc"
-#include "hepdb/quest.inc"
-#include "hepdb/hdbopts.inc"
-
- IRC = 0
-*
-* Save current directory
-*
- CALL RZCDIR(CHDIR,'R')
- LDIR = LENOCC(CHDIR)
-
- IF(IOPTD.NE.0) THEN
- CALL CDEALI (CHPATH, ' ', 1, IRC)
- ELSEIF(IOPTP.NE.0) THEN
- LPATH = LENOCC(CHPATH)
- CALL CDGALI (CHPATH, ALIAS, IRC)
- LALIAS = LENOCC(ALIAS)
- IF(IRC.EQ.0) THEN
- IF(LALIAS.EQ.0) THEN
- WRITE(LPRTCD,9001) CHPATH(1:LPATH)
-9001 FORMAT(' CDALIA. no alias found for path ',A)
- ELSE
- WRITE(LPRTCD,9002) CHPATH(1:LPATH),
- + ALIAS(1:LALIAS)
-9002 FORMAT(' CDALIA. alias for path ',A,' is ',A)
- ENDIF
- ENDIF
- ELSEIF(IOPTG.NE.0) THEN
-*
-* Get the alias definition for the specified path
-*
- CALL CDGALI (CHPATH, CHALIA, IRC)
- ELSEIF(IOPTR.NE.0) THEN
-*
-* Retrieve the equivalence name for the specified alias
-*
- CALL CDRALI (CHALIA, CHPATH, IRC)
- ELSEIF(IOPTS.NE.0) THEN
- CALL CDEALI (CHPATH, CHALIA, 0, IRC)
- LPATH = LENOCC(CHPATH)
- IF(IRC.EQ.0) WRITE(LPRTCD,9003) CHPATH(1:LPATH),
- + CHALIA(1:LENOCC(CHALIA))
-9003 FORMAT(' CDALIA. alias for path ',A,' is ',A,
- + ' (for this session)')
- ELSEIF(IOPTU.NE.0) THEN
- CALL CDEALI (CHPATH, CHALIA, 1, IRC)
- LPATH = LENOCC(CHPATH)
- IF(IRC.EQ.0) WRITE(LPRTCD,9004) CHPATH(1:LPATH),
- + CHALIA(1:LENOCC(CHALIA))
-9004 FORMAT(' CDALIA. alias for path ',A,' is ',A,
- + ' (entered into database)')
- ENDIF
-*
-* Restore current directory
-*
- CALL RZCDIR(CHDIR(1:LDIR),' ')
-* END CDALIA
- END
diff --git a/src/packlib/hepdb/cddict/cdcdic.F b/src/packlib/hepdb/cddict/cdcdic.F
deleted file mode 100644
index b74308d..0000000
--- a/src/packlib/hepdb/cddict/cdcdic.F
+++ /dev/null
@@ -1,207 +0,0 @@
-*
-* $Id: cdcdic.F,v 1.2 1999/08/17 12:42:31 mclareni Exp $
-*
-* $Log: cdcdic.F,v $
-* Revision 1.2 1999/08/17 12:42:31 mclareni
-* Y2k mods submitted by Rob Komar
-*
-* Revision 1.1.1.1 1996/02/28 16:24:08 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
-#if !defined(CERNLIB__P3CHILD)
- SUBROUTINE CDCDIC (PATHX, ICMPF, IPREC, DELTA, IRC)
-* ===================================================
-*
-************************************************************************
-* *
-* SUBR. CDCDIC (PATHX, ICMPF, IPREC, DELTA, IRC*) *
-* *
-* Create or updates the dictionary table for the Data base file *
-* *
-* Arguments : *
-* *
-* PATHX Path name of the subdirectory *
-* ICMPF Compression flag (0 no compression; 1 standard *
-* compression using IPREC; 2 compression with zero *
-* supression with DELTA) *
-* IPREC Precision word; (If IPREC > 0, data are stored with *
-* IPREC significant digits right to the decimal points; *
-* if IPREC < 0, data are stored with IPREC insignificant *
-* digits left to the decimal point.) *
-* DELTA Variable specifying the absolute value below which data *
-* is treated as zero *
-* IRC Return code (see below) *
-* *
-* Called by CDMKDI *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* =142 : Error in RZ in writing the dictionary object *
-* =143 : Error in RZ in purging the dictionary directory *
-* =144 : Dictionary directory cannot be loaded *
-* =145 : Pathname already exists in dictionary *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
-#include "hepdb/ckkeys.inc"
-#include "hepdb/ctpath.inc"
- CHARACTER PATHD*80, PATHX*(*)
-*
-* ------------------------------------------------------------------
-*
-* *** The top directory information is assumed to be loaded
-* Top directory name is TOPNCD and LBUPCD the address of UPCD bank
-*
- CALL RZCDIR (PAT3CT, 'R')
-*
-* *** Get the name of the name of directory without top name
-*
- NCH = LENOCC (PAT3CT)
- PAT3CT = PAT3CT(1:NCH)//'/'//PATHX
- CALL CDWTOP (PAT3CT, PAT2CT, NCHR)
- PATHD = '//'//TOPNCD(1:NCHRCD)//'/'//'DICTIONARY'
- IF (IOUTCD.EQ.0) IOPSCD = 0
-*
-* *** Load the dictionary directory again just as a safe measure
-*
- CALL RZCDIR (PATHD, ' ')
- IF (IQUEST(1).NE.0) THEN
- IRC = 144
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDCDIC : Cannot '//
- + 'set current directory to '//PATHD//''')', IARGCD, 0)
-#endif
- GO TO 999
- ENDIF
-*
- NKEYCK = IQUEST(7)
- NWKYCK = IQUEST(8)
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- ISTP = NWKYCK + 1
- IF (NKEYCK.GT.0) THEN
- IPNT = KOFSCD + LCDRCD + IKDRCD
- IMIN = IUHUNT (-1, IQ(IPNT+IDHKSN), NKEYCK*ISTP, ISTP)
- IF (IMIN.GT.0) THEN
- IMIN = (IMIN - IDHKSN) / ISTP + 1
- CALL CDKEYT
- CALL CDKEYR (IMIN, NWKYCK, KEYNCK)
- LFIXCD = LQ(KOFUCD+LBUPCD-KLDICD)
- IF (LFIXCD.NE.0) CALL MZDROP (IDIVCD, LFIXCD, ' ')
- ICYCL = 9999
- CALL CDRZIN (IDIVCD, LBUPCD, -KLDICD, IMIN, ICYCL, PATHD, IRC)
- IF (IRC.NE.0) GO TO 999
- LFIXCD = LQ(KOFUCD+LBUPCD-KLDICD)
- NDWD = IQ(KOFUCD+LFIXCD-1)
- GO TO 10
- ENDIF
- ENDIF
-*
-* *** Recreate the dictionary directory
-*
- CALL VZERO (KEYNCK, NSYSCK)
- KEYNCK(IDHKSN) = -1
- KEYNCK(IDHFLG) = 1
- CALL DATIME (IDATE, ITIME)
- CALL CDPKTM (IDATE, ITIME, KEYNCK(IDHINS), IRC)
- LFIXCD = LQ(KOFUCD+LBUPCD-KLDICD)
- IF (LFIXCD.NE.0) CALL MZDROP (IDIVCD, LFIXCD, ' ')
- NDWD = NPUSCD*NWITCD + 1
- CALL CDBANK (IDIVCD, LFIXCD, LBUPCD, -KLDICD, 'DICD', 0, 0, NDWD,
- + IODICD, 0, IRC)
- IF (IRC.NE.0) GO TO 999
-*
-* *** Check if the path name already exists in the dictionary
-*
- 10 NITEM = IQ(KOFUCD+LFIXCD+MDCNTM)
- NKEEP = (NDWD - 1) / NWITCD
- NFREE = 0
- IF (NITEM.GT.0) THEN
- DO 50 I = 1, NITEM
- IPNT = KOFUCD + LFIXCD + (I - 1) * NWITCD + 1
- NCHF = IQ(IPNT+MDCNCH)
- IF (IQ(IPNT+MDCITM).LE.0) THEN
- IF (NFREE.EQ.0) NFREE = I
- ELSE
- IF (NCHR.EQ.NCHF) THEN
- CALL UHTOC (IQ(IPNT+MDCNAM), 4, PAT3CT, NCHF)
- IF (PAT2CT(1:NCHR).EQ.PAT3CT(1:NCHF)) THEN
- IRC = 145
- IQUEST(11) = I
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDCDIC :'//
- + ' Path name '//PAT2CT//' already in dictionary'')',IQ,0)
-#endif
- GO TO 999
- ENDIF
- ENDIF
- ENDIF
- 50 CONTINUE
- ENDIF
-*
-* *** Enter the new path name in the dictionary
-*
- IF (NFREE.EQ.0) THEN
- NITEM = NITEM + 1
- NFREE = NITEM
- IF (NITEM.GT.NKEEP) THEN
- CALL ZSHUNT (IDIVCD, LFIXCD, LBDACD, 2, 0)
- LBDACD = LFIXCD
- LFIXCD = 0
- ND = NDWD + NPUSCD * NWITCD
- CALL CDBANK (IDIVCD, LFIXCD, LBUPCD, -KLDICD, 'DICD', 0,0, ND,
- + IODICD, -1, IRC)
- IF (IRC.NE.0) THEN
- CALL MZDROP (IDIVCD, LBDACD, ' ')
- GO TO 999
- ENDIF
- CALL UCOPY (IQ(KOFUCD+LBDACD+1), IQ(KOFUCD+LFIXCD+1), NDWD)
- CALL MZDROP (IDIVCD, LBDACD, ' ')
- ENDIF
- IQ(KOFUCD+LFIXCD+MDCNTM) = NITEM
- ENDIF
- IPNT = KOFUCD + LFIXCD + (NFREE - 1) * NWITCD + 1
- IQ(IPNT+MDCITM) = NFREE
- IQ(IPNT+MDCNCH) = NCHR
- IQ(IPNT+MDCLUP) = 0
- IQ(IPNT+MDCCMP) = ICMPF
- IQ(IPNT+MDCPRC) = IPREC
- Q(IPNT+MDCDEL) = DELTA
- CALL UCTOH (' ', IQ(IPNT+MDCALI), 4, 8)
- CALL UCTOH (PAT2CT, IQ(IPNT+MDCNAM), 4, MAXLCD)
-*
-* *** Now update the disk file
-*
- IF (IOPSCD.NE.0) CALL RZLOCK ('CDCDIC')
- CALL RZOUT (IDIVCD, LFIXCD, KEYNCK, ICYCLE, 'S')
- IF (IQUEST(1).NE.0) THEN
- IF (IOPSCD.NE.0) CALL RZFREE ('CDCDIC')
- IRC = 142
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDCDIC : RZOUT '//
- + 'error for path name '//PATHD//''')', IARGCD, 0)
-#endif
- GO TO 999
- ENDIF
- IKDRCD = IQ(KOFSCD+LCDRCD+KLKDCD)
- NKEYCK = IQ(KOFSCD+LCDRCD+KNKDCD)
- CALL RZPURG (0)
- IERR = IQUEST(1)
- IF (IOPSCD.NE.0) CALL RZFREE ('CDCDIC')
- IF (IERR.NE.0) THEN
- IRC = 143
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDCDIC : RZPURG '//
- + 'error for path name '//PATHD//''')', IARGCD, 0)
-#endif
- GO TO 999
- ENDIF
-*
- 998 IRC = 0
-* END CDCDIC
- 999 END
-#endif
diff --git a/src/packlib/hepdb/cddict/cddinf.F b/src/packlib/hepdb/cddict/cddinf.F
deleted file mode 100644
index 4098189..0000000
--- a/src/packlib/hepdb/cddict/cddinf.F
+++ /dev/null
@@ -1,67 +0,0 @@
-*
-* $Id: cddinf.F,v 1.1.1.1 1996/02/28 16:24:08 mclareni Exp $
-*
-* $Log: cddinf.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:08 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDDINF (IFLG, PATHN, IRC)
-* ====================================
-*
-************************************************************************
-* *
-* SUBR. CDDINF (PATHN, NW, CHTAG, IRC*) *
-* *
-* Deletes help information or names of the data elements of a given *
-* directory from the stored information in the data base. *
-* *
-* Arguments : *
-* *
-* IFLG Flag for help information(1) or name of data elements(2)*
-* PATHN Character string describing the path name *
-* IRC Return Code (See below) *
-* *
-* Called by CDHELP, CDNAME *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* =146 : Illegal path name *
-* *
-************************************************************************
-*
-#include "hepdb/caopts.inc"
-#include "hepdb/cdcblk.inc"
-#include "hepdb/ctpath.inc"
- CHARACTER PATHN*(*), PATHY*80
-*
-* ------------------------------------------------------------------
-*
-* *** Load the top directory information
-*
- CALL CDOPTS (' ', IRC)
- IOPDCA = 1
- CALL CDLDUP (PATHN, 0, IRC)
- IF (IRC.NE.0) GO TO 999
- PATHY = PAT1CT
-*
-* *** Find the unique directory identifier from the pathname
-*
- CALL CDGPID (PATHY, IDN)
- IF (IDN.LE.0) THEN
- IRC = 146
-#if defined(CERNLIB__DEBUG)
- NCHAR = LENOCC (PATHY)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDDINF : Illegal'//
- + ' path name '//PATHY(1:NCHAR)//''')', IARGCD, 0)
-#endif
- GO TO 999
- ENDIF
-*
-* *** Now store the information inside data base
-*
- CALL CDSNAM (IFLG, IDN, 0, 0, IRC)
-* END CDDINF
- 999 END
diff --git a/src/packlib/hepdb/cddict/cdeali.F b/src/packlib/hepdb/cddict/cdeali.F
deleted file mode 100644
index 413fb02..0000000
--- a/src/packlib/hepdb/cddict/cdeali.F
+++ /dev/null
@@ -1,273 +0,0 @@
-*
-* $Id: cdeali.F,v 1.1.1.1 1996/02/28 16:24:08 mclareni Exp $
-*
-* $Log: cdeali.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:08 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
-#if defined(CERNLIB__P3CHILD)
-* Ignoring t=dummy
-#endif
- SUBROUTINE CDEALI (PATHN, ALIAS, IFLAG, IRC)
-* ============================================
-*
-************************************************************************
-* *
-* SUBR. CDEALI (PATHN, ALIAS, IFLAG, IRC*) *
-* *
-* Enter the alias name of a given directory either only for this *
-* session or permanently in the data base. *
-* *
-* Arguments : *
-* *
-* PATHN Character string specifying the directory path name *
-* ALIAS Character string specifying the alias name *
-* IFLAG Flag (0 if to be entered only for this session; *
-* 1 if to be entered for this session and D.B.) *
-* IRC Return Code (See below) *
-* *
-* Called by CDALIA, CDFZUP *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* =146 : Illegal path name *
-* =147 : Dictionary directory not found in memory *
-* =148 : FZOUT fails to write on the sequential file *
-* =149 : Error in RZ for writing to the R.A. file *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
-#include "hepdb/cfzlun.inc"
-#include "hepdb/ckkeys.inc"
-#include "hepdb/ctpath.inc"
-#if defined(CERNLIB__P3CHILD)
-#include "hepdb/p3dbl3.inc"
-#endif
- CHARACTER PATHN*(*), ALIAS*(*), CALI*8, PATHY*80, PATHL*80
-*
-* ------------------------------------------------------------------
-*
-* *** Load the top directory information
-*
- CALL CDLDUP (PATHN, 0, IRC)
- IF (IRC.NE.0) GO TO 999
- CALI = ALIAS
- PATHL = ' '
- PATHY = PAT1CT
- NCHAR = LENOCC (PATHY)
-*
-* *** Find the unique directory identifier from the pathname
-*
- CALL CDGPID (PATHY, IDN)
- IF (IDN.LE.0) THEN
- IRC = 146
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDEALI : Illegal'//
- + ' pathname '//PATHY//''')', IARGCD, 0)
-#endif
- GO TO 999
- ENDIF
-*
-* *** Modify in memory
-*
- LUFZCF = LUFZCD
- LFIXCD = LQ(KOFUCD+LBUPCD-KLDICD)
- IF (LFIXCD.EQ.0) THEN
- IRC = 147
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDEALI : DICTION'//
- + 'ARY not found for '//TOPNCD//''')', IARGCD, 0)
-#endif
- GO TO 999
- ENDIF
-*
- IPNT = KOFUCD + LFIXCD + (IDN - 1) * NWITCD + 1
- CALL UCTOH (CALI, IQ(IPNT+MDCALI), 4, 8)
- IF (IFLAG.EQ.0) THEN
- LFIXCD = 0
- GO TO 999
- ENDIF
-#if (defined(CERNLIB_UNIX)||defined(CERNLIB_IBMVM)||defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))
-*
- IF (IOPPCD.NE.0) THEN
- LFIXCD = 0
- IRC = 0
-#endif
-#if (defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))&&(!defined(CERNLIB__P3CHILD))&&(defined(CERNLIB__ONLINE))
- CALL CDWLOK (IRC)
-#endif
-#if (defined(CERNLIB_UNIX)||defined(CERNLIB_IBMVM)||defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))&&(!defined(CERNLIB__P3CHILD))&&(!defined(CERNLIB__ONLINE))
- CALL CDSTSV (TOPNCD, 0, IRC)
-#endif
-#if defined(CERNLIB__P3CHILD)
- LUFZCF = LODBP3
-#endif
-#if (defined(CERNLIB_UNIX)||defined(CERNLIB_IBMVM)||defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))
- IF (IRC.NE.0) GO TO 999
- ENDIF
-#endif
-*
-* *** Get the name of the correct DICTIONARY directory
-*
- PAT2CT = '//'//TOPNCD(1:NCHRCD)//'/DICTIONARY'
- NCHRD = NCHRCD + 13
-*
- IF (LUFZCF.GT.0) THEN
-*
-* ** Prepare the header containing all the information
-*
- NCHD = (NCHRD + 3) / 4
- NCHP = (NCHAR + 3) / 4
- CALL MZIOCH (IOFMCF, NWFMCF, '6I -H')
- IHEDCF(MACTCF) = 7
- IHEDCF(MNKYCF) = 0
- IHEDCF(MOPTCF) = 0
- IHEDCF(MPATCF) = NCHD
- IHEDCF(MFLGCF) = IFLAG
- IHEDCF(MWDPCF) = NCHP
- NPNT1 = NCHD + MWDPCF + 1
- NPNT2 = NPNT1 + 2
- CALL UCTOH (PAT2CT, IHEDCF(MWDPCF+1), 4, 4*NCHD)
- CALL UCTOH (CALI, IHEDCF(NPNT1), 4, 8)
- CALL UCTOH (PATHY, IHEDCF(NPNT2), 4, 4*NCHP)
- NWDH = NPNT2 + NCHP - 1
-*
-* ** Now write on the sequential output
-*
-#if defined(CERNLIB__P3CHILD)
- RNDBP3 = 'CDEALI '
- NWDBP3 = 2
- CALL UCTOH ('JOURNAL ',IWDBP3, 4, 8)
- CALL CDCHLD
- IRC = IQDBP3
- IF (IRC.NE.0) GO TO 999
-#endif
- CALL FZOUT (LUFZCF, IDIVCD, 0, 1, 'Z', IOFMCF, NWDH, IHEDCF)
- IF (IQUEST(1).NE.0) THEN
- LFIXCD = 0
- IRC = 148
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDEALI : FZOUT'//
- + ' error for path name '//PATHY//''')', IARGCD, 0)
-#endif
- GO TO 999
- ENDIF
- ENDIF
-*
- IRC = 0
-#if (defined(CERNLIB_UNIX)||defined(CERNLIB_IBMVM)||defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))
-*
-* *** Server environment, Public mode
-*
- IF (IOPPCD.NE.0) THEN
-#endif
-#if (defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))&&(!defined(CERNLIB__P3CHILD))&&(defined(CERNLIB__ONLINE))
- IOPBCA = 0
- CALL CDCWSV (IRC)
-#endif
-#if (defined(CERNLIB_UNIX)||defined(CERNLIB_IBMVM)||defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))
- GO TO 999
- ENDIF
-#endif
-#if !defined(CERNLIB__P3CHILD)
-*
-* *** Now save this information in the data base
-*
- CALL RZCDIR (PAT2CT, ' ')
- IF (IQUEST(1).NE.0) THEN
- LFIXCD = 0
- IRC = 147
-#endif
-#if (defined(CERNLIB__DEBUG))&&(!defined(CERNLIB__P3CHILD))
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDEALI : DICTION'//
- + 'ARY not found for '//TOPNCD//''')', IARGCD, 0)
-#endif
-#if !defined(CERNLIB__P3CHILD)
- GO TO 999
- ENDIF
- NKEYCK = IQUEST(7)
- NWKYCK = IQUEST(8)
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- ISTP = NWKYCK + 1
-*
-* *** Lock the directory if necessary
-*
- IF (IOPSCD.NE.0) THEN
- CALL RZCDIR (PAT2CT, ' ')
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- CALL RZLOCK ('CDEALI')
- PATHL = PAT2CT
- ENDIF
-*
- IF (NKEYCK.GT.0) THEN
- IPNT = KOFSCD + LCDRCD + IKDRCD
- IMIN = IUHUNT (-1, IQ(IPNT+IDHKSN), NKEYCK*ISTP, ISTP)
- IF (IMIN.GT.0) THEN
- IMIN = (IMIN - IDHKSN) / ISTP + 1
- CALL CDKEYT
- CALL CDKEYR (IMIN, NWKYCK, KEYNCK)
- ISTEP = 1
- CALL RZOUT (IDIVCD, LFIXCD, KEYNCK, ICYCLE, 'S')
- LFIXCD = 0
- IF (IQUEST(1).NE.0) THEN
- IRC = 149
- IQUEST(11) = ISTEP
-#endif
-#if (defined(CERNLIB__DEBUG))&&(!defined(CERNLIB__P3CHILD))
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDEALI : RZ '//
- + 'error in step '',I3,'' for path name '//PAT2CT//''')',
- + IQUEST(11), 1)
-#endif
-#if !defined(CERNLIB__P3CHILD)
- GO TO 998
- ENDIF
- IKDRCD = IQ(KOFSCD+LCDRCD+KLKDCD)
- NKEYCK = IQ(KOFSCD+LCDRCD+KNKDCD)
- ISTEP = 2
- CALL RZPURG (0)
- IF (IQUEST(1).NE.0) THEN
- IRC = 149
- IQUEST(11) = ISTEP
-#endif
-#if (defined(CERNLIB__DEBUG))&&(!defined(CERNLIB__P3CHILD))
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDEALI : RZ '//
- + 'error in step '',I3,'' for path name '//PAT2CT//''')',
- + IQUEST(11), 1)
-#endif
-#if !defined(CERNLIB__P3CHILD)
- GO TO 998
- ENDIF
- ENDIF
- ELSE
- IMIN = 0
- ENDIF
- LFIXCD = 0
- IF (IMIN.EQ.0) THEN
- IRC = 147
-#endif
-#if (defined(CERNLIB__DEBUG))&&(!defined(CERNLIB__P3CHILD))
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDEALI : DICTION'//
- + 'ARY not found for '//TOPNCD//''')', IARGCD, 0)
-#endif
-#if !defined(CERNLIB__P3CHILD)
- ELSE
- IRC = 0
- ENDIF
-*
-* *** Free the locked directory
-*
- 998 IF (PATHL.NE.' ') THEN
- CALL RZCDIR (PATHL, ' ')
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- CALL RZFREE ('CDEALI')
- ENDIF
-#endif
-* END CDEALI
- 999 END
diff --git a/src/packlib/hepdb/cddict/cdehlp.F b/src/packlib/hepdb/cddict/cdehlp.F
deleted file mode 100644
index 56081eb..0000000
--- a/src/packlib/hepdb/cddict/cdehlp.F
+++ /dev/null
@@ -1,78 +0,0 @@
-*
-* $Id: cdehlp.F,v 1.1.1.1 1996/02/28 16:24:09 mclareni Exp $
-*
-* $Log: cdehlp.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:09 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDEHLP (PATHN, LUN, IRC)
-* ===================================
-*
-************************************************************************
-* *
-* SUBR. CDEHLP (PATHN, LUN, IRC*) *
-* *
-* Encode the help information from an ASCII disk file specified by *
-* the logical unit number LUN with subroutine CDLINC and enter it *
-* into the data base. *
-* *
-* Arguments : *
-* *
-* PATHN Path name of the help subdirectory *
-* LUN Logical unit number of the file where ASCII help *
-* information reside *
-* IRC Return Code (See below) *
-* *
-* Called by CDHELP *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* =146 : Illegal path name *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
-#include "hepdb/clinks.inc"
-#include "hepdb/ctpath.inc"
- CHARACTER PATHN*(*), PATHY*80
-*
-* ------------------------------------------------------------------
-*
-* *** Load the top directory information
-*
- CALL CDOPTS (' ', IRC)
- CALL CDLDUP (PATHN, 0, IRC)
- IF (IRC.NE.0) GO TO 999
- PATHY = PAT1CT
-*
-* *** Find the unique directory identifier from the pathname
-*
- CALL CDGPID (PATHY, IDN)
- IF (IDN.LE.0) THEN
- IRC = 146
-#if defined(CERNLIB__DEBUG)
- NCHAR = LENOCC (PATHY)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDEHLP : Illegal'//
- + ' pathname '//PATHY(1:NCHAR)//''')', IARGCD, 0)
-#endif
- GO TO 999
- ENDIF
-*
-* *** Read the data part
-*
- CALL CDATOI (LUN, LSTRCL(1), IRC)
- IF (IRC.NE.0) GO TO 10
-*
-* *** Now save the bank into the database and drop the bank
-*
- CALL CDSNAM (1, IDN, LSTRCL(1), 0, IRC)
-*
- 10 IF (LSTRCL(1).NE.0) THEN
- CALL MZDROP (IDIVCD, LSTRCL(1), 'L')
- LSTRCL(1) = 0
- ENDIF
-* END CDEHLP
- 999 END
diff --git a/src/packlib/hepdb/cddict/cdenam.F b/src/packlib/hepdb/cddict/cdenam.F
deleted file mode 100644
index 7ff9429..0000000
--- a/src/packlib/hepdb/cddict/cdenam.F
+++ /dev/null
@@ -1,101 +0,0 @@
-*
-* $Id: cdenam.F,v 1.1.1.1 1996/02/28 16:24:09 mclareni Exp $
-*
-* $Log: cdenam.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:09 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDENAM (PATHN, NW, CHTAG, IRC)
-* =========================================
-*
-************************************************************************
-* *
-* SUBR. CDENAM (PATHN, NW, CHTAG, IRC*) *
-* *
-* Enters the name of the data elements of a given directory inside *
-* the data base. The stored information goes in the DICTIONARY *
-* directory with KEY(1) set to the unique identifier of this *
-* directory. *
-* *
-* Arguments : *
-* *
-* PATHN Character string describing the path name *
-* NW Number of data elements *
-* CHTAG Name of each data element (assumed to be 8 character) *
-* IRC Return Code (See below) *
-* *
-* Called by CDNAME *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* =146 : Illegal path name *
-* =150 : Illegal number of data words *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
-#include "hepdb/ckkeys.inc"
-#include "hepdb/clinks.inc"
-#include "hepdb/ctpath.inc"
- CHARACTER*(*) CHTAG(*)
- CHARACTER CTAG*8, PATHN*(*), PATHY*80
-*
-* ------------------------------------------------------------------
-*
-* *** Load the top directory information
-*
- CALL CDOPTS (' ', IRC)
- CALL CDLDUP (PATHN, 0, IRC)
- IF (IRC.NE.0) GO TO 999
- PATHY = PAT1CT
-*
-* *** Find the unique directory identifier from the pathname
-*
- CALL CDGPID (PATHY, IDN)
- IF (IDN.LE.0) THEN
- IRC = 146
-#if defined(CERNLIB__DEBUG)
- NCHAR = LENOCC (PATHY)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDENAM : Illegal'//
- + ' path name '//PATHY(1:NCHAR)//''')', IARGCD, 0)
-#endif
- GO TO 999
- ENDIF
-*
- IF (NW.LE.0) THEN
- IRC = 150
- IQUEST(11) = NW
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDENAM : Illegal'//
- + ' number of data words '',I12)', IQUEST(11), 1)
-#endif
- GO TO 999
- ENDIF
-*
-* *** Book the bank and fill it up with appropriate information
-*
- NUM = 2 * NW
- IF (LSTRCL(1).NE.0) THEN
- CALL MZDROP (IDISCD, LSTRCL(1), 'L')
- LSTRCL(1) = 0
- ENDIF
- CALL CDBANK (IDISCD, LSTRCL(1), LSTRCL(1), 2, 'DNAM', 0, 0, NUM,
- + 5, -1, IRC)
- IF (IRC.NE.0) GO TO 999
- IPNT = KOFUCD + LSTRCL(1)
- DO 10 I = 1, NW
- CTAG = CHTAG(I)
- CALL UCTOH (CTAG, IQ(IPNT+1), 4, 8)
- IPNT = IPNT + 2
- 10 CONTINUE
-*
-* *** Now store the information inside data base
-*
- CALL CDSNAM (2, IDN, LSTRCL(1), 0, IRC)
- CALL MZDROP (IDISCD, LSTRCL(1), 'L')
- LSTRCL(1) = 0
-* END CDENAM
- 999 END
diff --git a/src/packlib/hepdb/cddict/cdgali.F b/src/packlib/hepdb/cddict/cdgali.F
deleted file mode 100644
index 1936050..0000000
--- a/src/packlib/hepdb/cddict/cdgali.F
+++ /dev/null
@@ -1,86 +0,0 @@
-*
-* $Id: cdgali.F,v 1.1.1.1 1996/02/28 16:24:10 mclareni Exp $
-*
-* $Log: cdgali.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:10 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
-#if defined(CERNLIB__P3CHILD)
-* Ignoring t=dummy
-#endif
- SUBROUTINE CDGALI (PATHN, ALIAS, IRC)
-* =====================================
-*
-************************************************************************
-* *
-* SUBR. CDGALI (PATHN, ALIAS*, IRC*) *
-* *
-* Get the alias name of a given directory *
-* *
-* Arguments : *
-* *
-* PATHN Character string specifying the directory path name *
-* ALIAS Character string specifying the alias name *
-* IRC Return Code (See below) *
-* *
-* Called by CDALIA *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* =146 : Illegal path name *
-* =147 : Dictionary directory not found in memory *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
-#include "hepdb/cfzlun.inc"
-#include "hepdb/ckkeys.inc"
-#include "hepdb/ctpath.inc"
-#if defined(CERNLIB__P3CHILD)
-#include "hepdb/p3dbl3.inc"
-#endif
- CHARACTER PATHN*(*), ALIAS*(*), PATHY*80, PATHL*80
-*
-* ------------------------------------------------------------------
-*
-* *** Load the top directory information
-*
- CALL CDLDUP (PATHN, 0, IRC)
- IF (IRC.NE.0) GO TO 999
- PATHL = ' '
- PATHY = PAT1CT
- NCHAR = LENOCC (PATHY)
-*
-* *** Find the unique directory identifier from the pathname
-*
- CALL CDGPID (PATHY, IDN)
- IF (IDN.LE.0) THEN
- IRC = 146
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDGALI : Illegal'//
- + ' pathname '//PATHY//''')', IARGCD, 0)
-#endif
- GO TO 999
- ENDIF
-*
-* *** Modify in memory
-*
- LUFZCF = LUFZCD
- LFIXCD = LQ(KOFUCD+LBUPCD-KLDICD)
- IF (LFIXCD.EQ.0) THEN
- IRC = 147
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDGALI : DICTION'//
- + 'ARY not found for '//TOPNCD//''')', IARGCD, 0)
-#endif
- GO TO 999
- ENDIF
-*
- IPNT = KOFUCD + LFIXCD + (IDN - 1) * NWITCD + 1
- ALIAS = ' '
- CALL UHTOC (IQ(IPNT+MDCALI), 4, ALIAS, 8)
-* END CDGALI
- 999 END
diff --git a/src/packlib/hepdb/cddict/cdgnam.F b/src/packlib/hepdb/cddict/cdgnam.F
deleted file mode 100644
index 80d1d5d..0000000
--- a/src/packlib/hepdb/cddict/cdgnam.F
+++ /dev/null
@@ -1,132 +0,0 @@
-*
-* $Id: cdgnam.F,v 1.1.1.1 1996/02/28 16:24:09 mclareni Exp $
-*
-* $Log: cdgnam.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:09 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDGNAM (PATHN, CHTAG, IOBJ, IRC)
-* ===========================================
-*
-************************************************************************
-* *
-* SUBR. CDGNAM (PATHN, CHTAG, IOBJ*, IRC*) *
-* *
-* Identifies the object element number from its name and the name *
-* of the directory path name *
-* *
-* Arguments : *
-* *
-* PATHN Character string describing the pathname *
-* CHTAG Name of the data element *
-* IOBJ Object element number (0 if not found) *
-* IRC Return Code (See below) *
-* *
-* Called by user *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* =146 : Illegal path name *
-* =147 : DICTIONARY directory not found *
-* =151 : No description of data elements for the given *
-* path name exists in the data base *
-* *
-************************************************************************
-*
-#include "hepdb/caopts.inc"
-#include "hepdb/cdcblk.inc"
-#include "hepdb/ckkeys.inc"
-#include "hepdb/clinks.inc"
-#include "hepdb/ctpath.inc"
- CHARACTER PATHN*(*), CHTAG*(*), CTAG*8, PATHY*80
-*
-* ------------------------------------------------------------------
-*
-* *** Load the top directory information
-*
- IOBJ = 0
- CALL CDLDUP (PATHN, 0, IRC)
- IF (IRC.NE.0) GO TO 999
- PATHY = PAT1CT
- NCHAR = LENOCC (PATHY)
-*
-* *** Find the unique directory identifier from the pathname
-*
- CALL CDGPID (PATHY, IDN)
- IF (IDN.LE.0) THEN
- IRC = 146
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDGNAM : Illegal'//
- + ' path name '//PATHY(1:NCHAR)//''')', IARGCD, 0)
-#endif
- GO TO 999
- ENDIF
-*
-* *** Set the current directory to DICTIONARY and retrieve object
-*
- PAT2CT = '//'//TOPNCD(1:NCHRCD)//'/DICTIONARY'
- CALL RZCDIR (PAT2CT, ' ')
- IF (IQUEST(1).NE.0) THEN
- IRC = 147
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDGNAM : Path na'//
- + 'me '//PAT2CT(1:NCHRCD+13)//' not found'')', IARGCD, 0)
-#endif
- GO TO 999
- ENDIF
- NKEYCK = IQUEST(7)
- NWKYCK = IQUEST(8)
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- CALL CDKEYT
- ISTP = NWKYCK + 1
- IPNT = KOFSCD + LCDRCD + IKDRCD
- KPNT = IUHUNT (IDN, IQ(IPNT+IDHKSN), NKEYCK*ISTP, ISTP)
- IF (KPNT.LE.0) THEN
- IRC = 151
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDGNAM : No info'//
- + 'rmation for '//PATHY(1:NCHAR)//' inside Data Base'')',IARGCD,0)
-#endif
- GO TO 999
- ENDIF
- KEY1S = (KPNT - IDHKSN) / ISTP + 1
- CALL VZERO (KEYVCK, NWKYCK)
- KEYVCK(1) = KEY1S
- IF (LSTRCL(1).NE.0) THEN
- CALL MZDROP (IDISCD, LSTRCL(1), 'L')
- LSTRCL(1) = 0
- ENDIF
- IOLD1 = IOKYCA(IDHKSN)
- IOLDK = IOPKCA
- IOPKCA = 0
- IOKYCA(IDHKSN) = 1
- ITIME = 1
- CALL CDKXIN (ITIME, IDISCD, LSTRCL(1), LSTRCL(1), 2, NWKYCK,
- + KEYVCK, IPREC, IRC)
- IOPKCA = IOLDK
- IOKYCA(IDHKSN) = IOLD1
- IF (IRC.NE.0) THEN
- CALL MZDROP (IDISCD, LSTRCL(1), 'L')
- GO TO 999
- ENDIF
-*
-* *** Now store the information in the user array
-*
- IPNT = KOFUCD + LSTRCL(1)
- NWDS = IQ(IPNT-1) / 2
- DO 10 I = 1, NWDS
- CALL UHTOC (IQ(IPNT+1), 4, CTAG, 8)
- IF (CTAG.EQ.CHTAG) THEN
- IOBJ = I
- GO TO 20
- ENDIF
- IPNT = IPNT + 2
- 10 CONTINUE
- 20 CALL MZDROP (IDISCD, LSTRCL(1), 'L')
- LSTRCL(1) = 0
-* END CDGNAM
- 999 END
diff --git a/src/packlib/hepdb/cddict/cdgpid.F b/src/packlib/hepdb/cddict/cdgpid.F
deleted file mode 100644
index a3d837f..0000000
--- a/src/packlib/hepdb/cddict/cdgpid.F
+++ /dev/null
@@ -1,68 +0,0 @@
-*
-* $Id: cdgpid.F,v 1.1.1.1 1996/02/28 16:24:09 mclareni Exp $
-*
-* $Log: cdgpid.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:09 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDGPID (PATHN, IDN)
-* ==============================
-*
-************************************************************************
-* *
-* SUBR. CDGPID (PATHN, IDN*) *
-* *
-* Finds the unique directory identifier from the path name *
-* *
-* Arguments : *
-* *
-* PATHN Character string describing the pathname *
-* IDN Unique directory identifier *
-* *
-* Called by CDDINF, CDEALI, CDEHLP, CDENAM, CDRHLP, CDRNAM, CDGNAM *
-* *
-* Error Condition : *
-* *
-* IDN > 0 : No error *
-* = 0 : No dictionary for directory identifier *
-* < 0 : Illegal path name *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
-#include "hepdb/ctpath.inc"
- CHARACTER PATHN*(*)
-*
-* ------------------------------------------------------------------
-*
-* *** Extract the top directory and the trailing part from the path name
-*
- IDN = 0
- CALL CDWTOP (PATHN, PAT2CT, NCHR)
- IF (NCHR.LE.0) GO TO 999
-*
-* *** Find the appropriate dictionary for the directory path name
-*
- IF (LBUPCD.LE.0) GO TO 999
- LDIC = LQ(KOFUCD+LBUPCD-KLDICD)
- IF (LDIC.LE.0) GO TO 999
- NITEM = IQ(KOFUCD+LDIC+MDCNTM)
-*
-* *** Look up the current path in the dictionary
-*
- DO 10 ITEM = 1, NITEM
- IPNT = KOFUCD + LDIC + (ITEM - 1) * NWITCD + 1
- IF (IQ(IPNT+MDCITM).GT.0) THEN
- IF (NCHR.EQ.IQ(IPNT+MDCNCH)) THEN
- CALL UHTOC (IQ(IPNT+MDCNAM), 4, PAT3CT, NCHR)
- IF (PAT2CT(1:NCHR).EQ.PAT3CT(1:NCHR)) THEN
- IDN = IQ(IPNT+MDCITM)
- GO TO 999
- ENDIF
- ENDIF
- ENDIF
- 10 CONTINUE
-* END CDGPID
- 999 END
diff --git a/src/packlib/hepdb/cddict/cdhelp.F b/src/packlib/hepdb/cddict/cdhelp.F
deleted file mode 100644
index 0e43ce3..0000000
--- a/src/packlib/hepdb/cddict/cdhelp.F
+++ /dev/null
@@ -1,59 +0,0 @@
-*
-* $Id: cdhelp.F,v 1.1.1.1 1996/02/28 16:24:09 mclareni Exp $
-*
-* $Log: cdhelp.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:09 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDHELP(LUN,CHFILE,CHPATH,CHOPT,IRC)
-*
-* Help file manipulation
-*
- CHARACTER*(*) CHFILE,CHPATH
-#include "hepdb/cduscm.inc"
-#include "hepdb/quest.inc"
-#include "hepdb/hdbopts.inc"
-
- IRC = 0
-
- IF(IOPTD.NE.0) THEN
-*
-* Delete help information
-*
- CALL CDDINF( 1, CHPATH, IRC)
- ELSEIF(IOPTP.NE.0) THEN
-*
-* Print help information
-*
- CALL CDRHLP(CHPATH, LUN, 'C', IRC)
- ELSEIF(IOPTR.NE.0) THEN
-*
-* Read help information from LUN and write to database
-*
- IF(IOPTA.EQ.0) THEN
-*
-* File already open?
-*
- CALL CDOPNF(LUN,CHFILE,LRECL,'FI',IRC)
- IF(IRC.NE.0) GOTO 99
- ENDIF
- CALL CDEHLP(CHPATH, LUN, IRC)
- ELSEIF(IOPTW.NE.0) THEN
-*
-* Read help information from database and write to LUN
-*
- IF(IOPTA.EQ.0) THEN
-*
-* File already open?
-*
- CALL CDOPNF(LUN,CHFILE,LRECL,'FO',IRC)
- IF(IRC.NE.0) GOTO 99
- ENDIF
- CALL CDRHLP(CHPATH,LUN,' ',IRC)
- ENDIF
-
-99 CONTINUE
-* END CDHELP
- END
diff --git a/src/packlib/hepdb/cddict/cdmdic.F b/src/packlib/hepdb/cddict/cdmdic.F
deleted file mode 100644
index 6793c92..0000000
--- a/src/packlib/hepdb/cddict/cdmdic.F
+++ /dev/null
@@ -1,215 +0,0 @@
-*
-* $Id: cdmdic.F,v 1.1.1.1 1996/02/28 16:24:10 mclareni Exp $
-*
-* $Log: cdmdic.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:10 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDMDIC (TOPN, LTOP, JBIAS, IRC)
-* ==========================================
-*
-************************************************************************
-* *
-* SUBR. CDMDIC (TOPN, LTOP, JBIAS, IRC*) *
-* *
-* Updates the dictionary information if not yet available in the *
-* disk file *
-* *
-* Arguments : *
-* *
-* TOPN Name of the top directory *
-* LTOP Support link for the dictionary bank *
-* JBIAS Bias for the creating the dictionary bank in memory *
-* IRC Return code (see below) *
-* *
-* Called by CDRDIC, CDUDIC *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* =140 : Illegal Top directory name *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
-#include "hepdb/ckkeys.inc"
-#include "hepdb/ctpath.inc"
-#include "hepdb/cuserf.inc"
- CHARACTER TOPN*(*)
- PARAMETER (NLEVM=20)
- DIMENSION LTOP(9), IHDIR(4), NCHD(NLEVM), ISDI(NLEVM)
- DIMENSION NKEY(NLEVM), IOPT(NLEVM), NSDI(NLEVM)
-#include "zebra/q_jbit.inc"
-* Ignoring t=pass
-*
-* ------------------------------------------------------------------
-*
- LREFCD(3) = LTOP(1)
- IRC = 0
- NLEV = 1
- PAT4CT = '//'//TOPN
- NCHD(NLEV) = LENOCC (PAT4CT)
- CALL RZCDIR (PAT4CT, 'Q')
- IF (IQUEST(1).NE.0) THEN
- IRC = 140
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDMDIC : Illegal'//
- + ' top directory '//PAT4CT//''')', IARGCD, 0)
-#endif
- GO TO 999
- ENDIF
- NKEYCK = IQUEST(7)
- NWKYCK = IQUEST(8)
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- IOPTP = 0
- IF (JBIAS.LE.0) THEN
- LFIXCD = LQ(KOFUCD+LREFCD(3)+JBIAS)
- IF (LFIXCD.NE.0) CALL MZDROP (IDIVCD, LFIXCD, ' ')
- ENDIF
- NDWD = NPUSCD*NWITCD + 1
- CALL CDBANK (IDIVCD, LFIXCD, LREFCD(3), JBIAS, 'DICD', 0, 0, NDWD,
- + IODICD, 0, IRC)
- IF (IRC.NE.0) GO TO 999
- NITEM = 0
- NKEEP = NPUSCD
-*
-* *** Now scan down to find all the subdirectories
-*
- 10 IF (NLEV.GT.1) THEN
- PAT4CT = PAT4CT(1:NCHD(NLEV-1))//'/'//TOP1CT
- NCHD(NLEV) = NCHD(NLEV-1) + NCHR + 1
- CALL RZCDIR (PAT4CT, ' ')
- NKEYCK = IQUEST(7)
- NWKYCK = IQUEST(8)
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- IF (NKEYCK.GT.0) THEN
- IOPTP = JBIT (IQ(KOFSCD+LCDRCD+IKDRCD+IDHFLG), JPRTCD)
- ELSE
- IOPTP = 0
- ENDIF
- ENDIF
- NKEY(NLEV) = NKEYCK
- IOPT(NLEV) = IOPTP
- ISDI(NLEV) = 0
- NSDI(NLEV) = IQ(KOFSCD+LCDRCD+KNSDCD)
-*
- 20 ISDI(NLEV) = ISDI(NLEV) + 1
- IF (ISDI(NLEV).LE.NSDI(NLEV)) THEN
-*
-* ** If a new subdirectory go down one level
-*
- LS = IQ(KOFSCD+LCDRCD+KLSDCD)
- IPNT = LS + 7 * (ISDI(NLEV) - 1)
- CALL ZITOH (IQ(KOFSCD+LCDRCD+IPNT), IHDIR, 4)
- CALL UHTOC (IHDIR, 4, TOP1CT, 16)
- NCHR = INDEX (TOP1CT, ' ') - 1
- IF (NCHR.LE.0.OR.NCHR.GT.16) NCHR = 16
- IF (IOPTP.NE.0) THEN
- DO 35 IK = 1, NKEYCK
- KK = IK
- IDIG = 0
- 30 IF (KK.GT.0) THEN
- KK = KK / 10
- IDIG = IDIG + 1
- GO TO 30
- ENDIF
- IF (NCHR.EQ.IDIG) THEN
-#if !defined(CERNLIB_IBM)||!defined(CERNLIB__P3CHILD)
- WRITE (PAT2CT, '(I8)') IK
-#endif
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB__P3CHILD))
- PAT2CT = ' '
- CALL UTWRIT (PAT2CT, '(I8)', IK ,1)
-#endif
- I1 = 8 - IDIG + 1
- IF (PAT2CT(I1:8).EQ.TOP1CT) GO TO 20
- ENDIF
- 35 CONTINUE
- ELSE IF (NLEV.EQ.1) THEN
- IF (NCHR.EQ.10) THEN
- IF (TOP1CT.EQ.'DICTIONARY') GO TO 20
- ENDIF
- ENDIF
- NLEV = NLEV +1
- GO TO 10
-*
- ELSE
-*
-* ** Check if the name is to be entered
-*
- IF (NLEV.EQ.1) GO TO 60
- IF (NLEV.EQ.2) THEN
- IF ((NCHD(2)-NCHD(1)-1).EQ.10) THEN
- IF (PAT4CT(NCHD(1)+2:NCHD(2)).EQ.'DICTIONARY') GO TO 50
- ENDIF
- ENDIF
- PAT2CT = PAT4CT(NCHD(1)+1:NCHD(NLEV))
- NCHR = NCHD(NLEV) - NCHD(1)
- NFREE = 0
- IF (NITEM.GT.0) THEN
- DO 40 I = 1, NITEM
- IPNT = KOFUCD + LFIXCD + (I - 1) * NWITCD + 1
- NCHF = IQ(IPNT+MDCNCH)
- IF (IQ(IPNT+MDCITM).GT.0) THEN
- IF (NCHR.EQ.NCHF) THEN
- CALL UHTOC (IQ(IPNT+MDCNAM), 4, PAT3CT, NCHF)
- PAT3CT = PAT3CT(1:NCHF)
- IF (PAT2CT.EQ.PAT3CT) GO TO 50
- ENDIF
- ELSE
- IF (NFREE.EQ.0) NFREE = I
- ENDIF
- 40 CONTINUE
- ENDIF
-*
-* ** Enter the new path name in the dictionary
-*
- IF (NFREE.EQ.0) THEN
- NITEM = NITEM + 1
- NFREE = NITEM
- IF (NITEM.GT.NKEEP) THEN
- CALL ZSHUNT (IDIVCD, LFIXCD, LBDACD, 2, 0)
- LBDACD = LFIXCD
- LFIXCD = 0
- ND = NDWD + NPUSCD * NWITCD
- CALL CDBANK (IDIVCD, LFIXCD, LREFCD(3), JBIAS, 'DICD', 0, 0,
- + ND, IODICD, -1, IRC)
- IF (IRC.NE.0) THEN
- CALL MZDROP (IDIVCD, LBDACD, ' ')
- GO TO 999
- ENDIF
- CALL UCOPY (IQ(KOFUCD+LBDACD+1), IQ(KOFUCD+LFIXCD+1), NDWD)
- CALL MZDROP (IDIVCD, LBDACD, ' ')
- NDWD = IQ(KOFUCD+LFIXCD-1)
- NKEEP = NKEEP + NPUSCD
- ENDIF
- IQ(KOFUCD+LFIXCD+MDCNTM) = NITEM
- ENDIF
- IPNT = KOFUCD + LFIXCD + (NFREE - 1) * NWITCD + 1
- IQ(IPNT+MDCITM) = NFREE
- IQ(IPNT+MDCNCH) = NCHR
- IQ(IPNT+MDCLUP) = 0
- IQ(IPNT+MDCCMP) = IDCMCU
- IQ(IPNT+MDCPRC) = IPRECU
- Q(IPNT+MDCDEL) = DELTCU
- CALL UCTOH (' ', IQ(IPNT+MDCALI), 4, 8)
- CALL UCTOH (PAT2CT, IQ(IPNT+MDCNAM), 4, NCHR)
-*
- 50 NLEV = NLEV - 1
- IF (NLEV.GE.1) THEN
- LUP = LQ(KOFSCD+LCDRCD+1)
- CALL MZDROP (0, LCDRCD, ' ')
- LCDRCD = LUP
- NKEYCK = NKEY(NLEV)
- IOPTP = IOPT(NLEV)
- GO TO 20
- ENDIF
- ENDIF
-*
- 60 IRC = 0
-* END CDMDIC
- 999 END
diff --git a/src/packlib/hepdb/cddict/cdname.F b/src/packlib/hepdb/cddict/cdname.F
deleted file mode 100644
index 1866e87..0000000
--- a/src/packlib/hepdb/cddict/cdname.F
+++ /dev/null
@@ -1,39 +0,0 @@
-*
-* $Id: cdname.F,v 1.1.1.1 1996/02/28 16:24:09 mclareni Exp $
-*
-* $Log: cdname.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:09 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDNAME(CHPATH,NW,CHTAG,CHOPT,IRC)
-
- CHARACTER*(*) CHPATH,CHTAG(*)
- PARAMETER (MAXTAG=100)
- CHARACTER*8 TAGS(MAXTAG)
-
-#include "hepdb/quest.inc"
-#include "hepdb/cduscm.inc"
-#include "hepdb/hdbopts.inc"
-
- IRC = 0
-
- IF(IOPTD.NE.0) THEN
- CALL CDDINF( 2, CHPATH, IRC)
- ELSEIF(IOPTP.NE.0) THEN
- NW = MAXTAG
- CALL CDRNAM(CHPATH, NW, TAGS, IRC)
- IF(IRC.EQ.0) THEN
- LPATH = LENOCC(CHPATH)
- WRITE(LPRTCD,*) 'CDNAME. mnemonic names for ',
- + CHPATH(1:LPATH)
- WRITE(LPRTCD,*) (TAGS(I),I=1,NW)
- ENDIF
- ELSEIF(IOPTR.NE.0) THEN
- CALL CDRNAM(CHPATH, NW, CHTAG, IRC)
- ELSEIF(IOPTU.NE.0) THEN
- CALL CDENAM(CHPATH, NW, CHTAG, IRC)
- ENDIF
-* END CDNAME
- END
diff --git a/src/packlib/hepdb/cddict/cdrali.F b/src/packlib/hepdb/cddict/cdrali.F
deleted file mode 100644
index 02eac05..0000000
--- a/src/packlib/hepdb/cddict/cdrali.F
+++ /dev/null
@@ -1,77 +0,0 @@
-*
-* $Id: cdrali.F,v 1.1.1.1 1996/02/28 16:24:10 mclareni Exp $
-*
-* $Log: cdrali.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:10 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDRALI (ALIAS, PATH, IRC)
-* ====================================
-*
-************************************************************************
-* *
-* SUBR. CDRALI (ALIAS, PATH*, IRC*) *
-* *
-* Retrieve the complete path name from the alias name *
-* *
-* Arguments : *
-* *
-* ALIAS Character string specifying the alias name *
-* PATH Character string specifying the directory path name *
-* IRC Return Code (See below) *
-* *
-* Called by CDALIA *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* =154 : Not a valid alias name *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
- CHARACTER PATH*(*), ALIAS*(*), CALI*8, PATHN*80, TOPN*16
-*
-* ------------------------------------------------------------------
-*
- PATH = ' '
- IRC = 0
-*
-* *** Loop over all the top directories
-*
- LTOP = LTOPCD
- 10 IF (LTOP.NE.0) THEN
- LDIC = LQ(KOFUCD+LTOP-KLDICD)
- IF (LDIC.NE.0) THEN
- NITEM = IQ(KOFUCD+LDIC+MDCNTM)
- DO 20 I = 1, NITEM
- IPNT = KOFUCD + LDIC + (I - 1) * NWITCD + 1
- IF (IQ(IPNT+MDCITM).GT.0) THEN
- CALL UHTOC (IQ(IPNT+MDCALI), 4, CALI, 8)
- IF (ALIAS.EQ.CALI) THEN
- NCHF = IQ(IPNT+MDCNCH)
- CALL UHTOC (IQ(IPNT+MDCNAM), 4, PATHN, NCHF)
- NCHT = IQ(KOFUCD+LTOP+MUPNCH)
- CALL UHTOC (IQ(KOFUCD+LTOP+MUPNAM), 4, TOPN, NCHT)
- PATH = '//'//TOPN(1:NCHT)//PATHN(1:NCHF)
- GO TO 999
- ENDIF
- ENDIF
- 20 CONTINUE
- ENDIF
- LTOP = LQ(KOFUCD+LTOP)
- GO TO 10
- ELSE
- IRC = 154
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) THEN
- CALI = ALIAS
- CALL CDPRNT (LPRTCD, '(/,'' CDRALI : Alias name '//CALI//
- + ' not found'')', IARGCD, 0)
- ENDIF
-#endif
- ENDIF
-* END CDRALI
- 999 END
diff --git a/src/packlib/hepdb/cddict/cdrdic.F b/src/packlib/hepdb/cddict/cdrdic.F
deleted file mode 100644
index 938a8a9..0000000
--- a/src/packlib/hepdb/cddict/cdrdic.F
+++ /dev/null
@@ -1,239 +0,0 @@
-*
-* $Id: cdrdic.F,v 1.1.1.1 1996/02/28 16:24:10 mclareni Exp $
-*
-* $Log: cdrdic.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:10 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
-#if defined(CERNLIB__P3CHILD)
-* Ignoring t=dummy
-#endif
- SUBROUTINE CDRDIC (TOPN, IRC)
-* =============================
-*
-************************************************************************
-* *
-* SUBR. CDRDIC (TOPN, IRC*) *
-* *
-* Recreates the dictionary information and stores it into database *
-* *
-* Arguments : *
-* *
-* TOPN Name of the top directory *
-* IRC Return code (see below) *
-* *
-* Called by user, CDFZUP *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* =141 : Error in creating the DICTIONARY directory *
-* =142 : Error in RZ in writing the dictionary object *
-* =143 : Error in RZ in purging the dictionary directory *
-* =148 : Error in FZOUT for saving the journal file *
-* *
-************************************************************************
-*
-#include "hepdb/caopti.inc"
-#include "hepdb/cdcblk.inc"
-#include "hepdb/cfzlun.inc"
-#include "hepdb/ckkeys.inc"
-#include "hepdb/ctpath.inc"
-#if defined(CERNLIB__P3CHILD)
-#include "hepdb/p3dbl3.inc"
-#endif
- CHARACTER TOPN*(*), PATHN*80, CFOR*32
-* ------------------------------------------------------------------
-*
-* *** Load the directory information
-*
- CALL CDOPTS (' ', IRC)
- PATHN = '//'//TOPN
- CALL CDLDUP (PATHN, 0, IRC)
- IF (IRC.NE.0) GO TO 999
- PATHN = PAT1CT
- NCHR = LENOCC (PAT1CT)
- LUFZCF = LUFZCD
-#if (defined(CERNLIB_UNIX)||defined(CERNLIB_IBMVM)||defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))
-*
- IF (IOPPCD.NE.0) THEN
- IRC = 0
-#endif
-#if (defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))&&(!defined(CERNLIB__P3CHILD))&&(defined(CERNLIB__ONLINE))
- CALL CDWLOK (IRC)
-#endif
-#if (defined(CERNLIB_UNIX)||defined(CERNLIB_IBMVM)||defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))&&(!defined(CERNLIB__P3CHILD))&&(!defined(CERNLIB__ONLINE))
- CALL CDSTSV (TOPNCD, 0, IRC)
-#endif
-#if (defined(CERNLIB__P3CHILD))&&(defined(CERNLIB__SERVER))
- LUFZCF = LODBP3
-#endif
-#if (defined(CERNLIB_UNIX)||defined(CERNLIB_IBMVM)||defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))
- IF (IRC.NE.0) GO TO 999
- ENDIF
-#endif
-*
-* *** Prepare the journal file if needed
-*
- IF (LUFZCF.GT.0) THEN
- NWDP = (NCHR + 3) / 4
- IHEDCF(MACTCF) = 10
- IHEDCF(MNKYCF) = 0
- IHEDCF(MOPTCF) = 0
- IHEDCF(MPATCF) = NWDP
- NWDH = MPATCF
- CALL UCTOH (PATHN, IHEDCF(NWDH+1), 4, 4*NWDP)
- NWDH = NWDH + NWDP
- CALL MZIOCH (IOFMCF, NWFMCF, '4I -H')
-*
-* ** Now write on the sequential output
-*
-#if defined(CERNLIB__P3CHILD)
- RNDBP3 = 'CDRDIC '
- NWDBP3 = 2
- CALL UCTOH ('JOURNAL ', IWDBP3, 4, 8)
- CALL CDCHLD
- IRC = IQDBP3
- IF (IRC.NE.0) GO TO 999
-#endif
- CALL FZOUT (LUFZCF, IDIVCD, 0, 1, 'Z', IOFMCF, NWDH, IHEDCF)
- IF (IQUEST(1).NE.0) THEN
- IRC = 148
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDRDIC : FZOUT'//
- + ' error for path name '//PATHN(1:NCHR)//''')', IARGCD, 0)
-#endif
- GO TO 999
- ENDIF
- ENDIF
-*
- IRC = 0
-#if (defined(CERNLIB_UNIX)||defined(CERNLIB_IBMVM)||defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))
-*
-* *** Server environment, Public mode
-*
- IF (IOPPCD.NE.0) THEN
-#endif
-#if (defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))&&(!defined(CERNLIB__P3CHILD))&&(defined(CERNLIB__ONLINE))
- CALL CDCWSV (IRC)
-#endif
-#if (defined(CERNLIB_UNIX)||defined(CERNLIB_IBMVM)||defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))
- GO TO 999
- ENDIF
-#endif
-#if !defined(CERNLIB__P3CHILD)
- IF (IOUTCD.EQ.0) GO TO 999
- PAT1CT = PATHN(1:NCHR)//'/DICTIONARY'
-*
-* *** Try to load the dictionary information if it exists
-*
- CALL RZCDIR (PAT1CT, 'Q')
- IF (IQUEST(1).NE.0) THEN
- CFOR = CHFTCK(1:NSYSCK)
- DO I = 1, NSYSCK
- CTAGCK(I) = CHTGCK(I)
- ENDDO
- DO I = 1, NPARCD
- CFOR(NOF1CK+2*I-1:NOF1CK+2*I-1) = 'I'
- CFOR(NOF1CK+2*I :NOF1CK+2*I ) = 'I'
- CTAGCK(NOF1CK+2*I-1) = 'STR_VAL'//CALFCA(27+I)
- CTAGCK(NOF1CK+2*I) = 'END_VAL'//CALFCA(27+I)
- ENDDO
- CALL RZCDIR (PATHN, ' ')
- IF (IOPSCD.NE.0) CALL RZLOCK ('CDRDIC')
- CALL RZMDIR ('DICTIONARY', NSYSCK, CFOR, CTAGCK)
- IERR = IQUEST(1)
- IF (IOPSCD.NE.0) THEN
- CALL RZCDIR (PATHN, ' ')
- CALL RZFREE ('CDRDIC')
- ENDIF
- IF (IERR.NE.0) THEN
- IRC = 141
-#endif
-#if (!defined(CERNLIB__P3CHILD))&&(defined(CERNLIB__DEBUG))
- IF (IDEBCD.GT.0) THEN
- NCHD = LENOCC (PAT1CT)
- CALL CDPRNT (LPRTCD, '(/,'' CDRDIC : RZMDIR error for pat'//
- + 'h name '//PAT1CT(1:NCHD)//''')', IARGCD, 0)
- ENDIF
-#endif
-#if !defined(CERNLIB__P3CHILD)
- GO TO 999
- ENDIF
- CALL RZCDIR (PAT1CT, 'Q')
- ENDIF
- NKEYCK = IQUEST(7)
- NWKYCK = IQUEST(8)
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
-*
- IF (NKEYCK.GT.0) THEN
- IPNT = KOFSCD + LCDRCD + IKDRCD
- ISTP = NWKYCK + 1
- IMIN = IUHUNT (-1, IQ(IPNT+IDHKSN), NKEYCK*ISTP, ISTP)
- IF (IMIN.GT.0) THEN
- IMIN = (IMIN - IDHKSN) / ISTP + 1
- CALL CDKEYT
- CALL CDKEYR (IMIN, NWKYCK, KEYNCK)
- ENDIF
- ELSE
- IMIN = 0
- ENDIF
- IF (IMIN.LE.0) THEN
- CALL VZERO (KEYNCK, NSYSCK)
- KEYNCK(IDHKSN) = -1
- KEYNCK(IDHFLG) = 1
- CALL DATIME (IDATE, ITIME)
- CALL CDPKTM (IDATE, ITIME, KEYNCK(IDHINS), IRC)
- ENDIF
- CALL CDMDIC (TOPN, LBUPCD, -KLDICD, IRC)
- IF (IRC.NE.0) GO TO 999
- LFIXCD = LQ(KOFUCD+LBUPCD-KLDICD)
-*
-* *** All subdirectories looked at; now store dictionary if permitted
-*
- IF (IOUTCD.NE.0) THEN
- CALL RZCDIR (PAT1CT, 'Q')
- LCDRCD = IQUEST(11)
- IF (IOPSCD.NE.0) CALL RZLOCK ('CDRDIC')
- CALL RZOUT (IDIVCD, LFIXCD, KEYNCK, ICYCLE, 'S')
- IKDRCD = IQ(KOFSCD+LCDRCD+KLKDCD)
- NKEYCK = IQ(KOFSCD+LCDRCD+KNKDCD)
- IF (IQUEST(1).NE.0) THEN
- IF (IOPSCD.NE.0) CALL RZFREE ('CDRDIC')
- IRC = 142
-#endif
-#if (!defined(CERNLIB__P3CHILD))&&(defined(CERNLIB__DEBUG))
- IF (IDEBCD.GT.0) THEN
- NCHD = LENOCC (PAT1CT)
- CALL CDPRNT (LPRTCD, '(/,'' CDRDIC : RZOUT error for path'//
- + ' name '//PAT1CT(1:NCHD)//''')', IARGCD, 0)
- ENDIF
-#endif
-#if !defined(CERNLIB__P3CHILD)
- GO TO 999
- ENDIF
- CALL RZPURG (0)
- IERR = IQUEST(1)
- IF (IOPSCD.NE.0) CALL RZFREE ('CDRDIC')
- IF (IERR.NE.0) THEN
- IRC = 143
-#endif
-#if (!defined(CERNLIB__P3CHILD))&&(defined(CERNLIB__DEBUG))
- IF (IDEBCD.GT.0) THEN
- NCHD = LENOCC (PAT1CT)
- CALL CDPRNT (LPRTCD, '(/,'' CDRDIC : RZPURG error for pat'//
- + 'h name '//PAT1CT(1:NCHD)//''')', IARGCD, 0)
- ENDIF
-#endif
-#if !defined(CERNLIB__P3CHILD)
- GO TO 999
- ENDIF
- ENDIF
-*
- IRC = 0
-#endif
-* END CDRDIC
- 999 END
diff --git a/src/packlib/hepdb/cddict/cdrhlp.F b/src/packlib/hepdb/cddict/cdrhlp.F
deleted file mode 100644
index 416481a..0000000
--- a/src/packlib/hepdb/cddict/cdrhlp.F
+++ /dev/null
@@ -1,136 +0,0 @@
-*
-* $Id: cdrhlp.F,v 1.1.1.1 1996/02/28 16:24:10 mclareni Exp $
-*
-* $Log: cdrhlp.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:10 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDRHLP (PATHN, LUN, CHOPT, IRC)
-* ==========================================
-*
-************************************************************************
-* *
-* SUBR. CDRHLP (PATH, LUN, IRC*) *
-* *
-* Retrieve the help information from data base and translate it *
-* with Subroutine CDLIND and also write the ASCII format on a *
-* given file specified by logical unit number LUN. *
-* *
-* Arguments : *
-* *
-* PATH Character string describing the pathname *
-* LUN Logical unit number of the file with ASCII data *
-* CHOPT Character options *
-* IRC Return Code (See below) *
-* *
-* Called by CDHELP *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* = 66 : Illegal logical unit number *
-* =146 : The pathname specified does not exist *
-* =155 : No help directory inside the data base *
-* =156 : No help information for this path stored yet *
-* *
-************************************************************************
-*
-#include "hepdb/caopts.inc"
-#include "hepdb/cdcblk.inc"
-#include "hepdb/ckkeys.inc"
-#include "hepdb/clinks.inc"
-#include "hepdb/ctpath.inc"
- CHARACTER PATHN*(*), PATHY*80
- CHARACTER*(*) CHOPT
-*
-* ------------------------------------------------------------------
-*
-* *** Load the top directory information
-*
- CALL CDLDUP (PATHN, 0, IRC)
- IF (IRC.NE.0) GO TO 999
- PATHY = PAT1CT
-*
-* *** Find the unique directory identifier from the pathname
-*
- CALL CDGPID (PATHY, IDN)
- IF (IDN.LE.0) THEN
- IRC = 146
-#if defined(CERNLIB__DEBUG)
- NCHAR = LENOCC (PATHY)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDRHLP : Illegal'//
- + ' pathname '//PATHY(1:NCHAR)//''')', IARGCD, 0)
-#endif
- GO TO 999
- ENDIF
-*
- IF (LUN.LE.0) THEN
- IRC = 66
- IQUEST(11) = LUN
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDRHLP : Illegal'//
- + ' unit number '',I10,'' for ASCII file'')', IQUEST(11), 1)
-#endif
- GO TO 999
- ENDIF
-*
-* *** Set the current directory to HELP and retrieve object
-*
- PAT2CT = '//'//TOPNCD(1:NCHRCD)//'/HELP'
- CALL RZCDIR (PAT2CT, ' ')
- IF (IQUEST(1).NE.0) THEN
- IRC = 155
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDRHLP : Path na'//
- + 'me '//PAT2CT(1:NCHRCD+7)//' not found'')', IARGCD, 0)
-#endif
- GO TO 999
- ENDIF
- NKEYCK = IQUEST(7)
- NWKYCK = IQUEST(8)
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- CALL CDKEYT
- ISTP = NWKYCK + 1
- IPNT = KOFSCD + LCDRCD + IKDRCD
- KPNT = IUHUNT (IDN, IQ(IPNT+IDHKSN), NKEYCK*ISTP, ISTP)
- IF (KPNT.LE.0) THEN
- IRC = 156
-#if defined(CERNLIB__DEBUG)
- NCHAR = LENOCC (PATHY)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDRHLP : No help'//
- + ' information for '//PATHY(1:NCHAR)//' available'')', IARGCD, 0)
-#endif
- GO TO 999
- ENDIF
- KEY1S = (KPNT - IDHKSN) / ISTP + 1
- CALL VZERO (KEYVCK, NWKYCK)
- KEYVCK(IDHKSN) = KEY1S
- IF (LSTRCL(1).NE.0) THEN
- CALL MZDROP (IDISCD, LSTRCL(1), 'L')
- LSTRCL(1) = 0
- ENDIF
- IOLD1 = IOKYCA(IDHKSN)
- IOLDK = IOPKCA
- IOPKCA = 0
- IOKYCA(IDHKSN) = 1
- ITIME = 1
- CALL CDKXIN (ITIME, IDISCD, LSTRCL(1), LSTRCL(1), 2, NWKYCK,
- + KEYVCK, IPREC, IRC)
- IOPKCA = IOLDK
- IOKYCA(IDHKSN) = IOLD1
- IF (IRC.NE.0) THEN
- CALL MZDROP (IDISCD, LSTRCL(1), 'L')
- GO TO 999
- ENDIF
-*
- CALL CDAFRI (LUN, LSTRCL(1), CHOPT, IRC)
-*
- IF (LSTRCL(1).NE.0) THEN
- CALL MZDROP (IDISCD, LSTRCL(1), 'L')
- LSTRCL(1) = 0
- ENDIF
-* END CDRHLP
- 999 END
diff --git a/src/packlib/hepdb/cddict/cdrnam.F b/src/packlib/hepdb/cddict/cdrnam.F
deleted file mode 100644
index 6e48964..0000000
--- a/src/packlib/hepdb/cddict/cdrnam.F
+++ /dev/null
@@ -1,131 +0,0 @@
-*
-* $Id: cdrnam.F,v 1.1.1.1 1996/02/28 16:24:10 mclareni Exp $
-*
-* $Log: cdrnam.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:10 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDRNAM (PATHN, NWMAX, CHTAG, IRC)
-* ============================================
-*
-************************************************************************
-* *
-* SUBR. CDRNAM (PATHN, *NWMAX*, CHTAG*, IRC*) *
-* *
-* Retrieves the names of the data elements of a given directory *
-* from the data base *
-* *
-* Arguments : *
-* *
-* PATHN Character string describing the pathname *
-* NWMAX Maximum number of data word elements for CHTAG *
-* (on return it contains the number of CHTAG filled in) *
-* CHTAG Name of the data elements *
-* IRC Return Code (See below) *
-* *
-* Called by CDNAME *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* =146 : Illegal path name *
-* =147 : DICTIONARY directory not found *
-* =151 : No description of data elements for the given *
-* path name exists in the data base *
-* *
-************************************************************************
-*
-#include "hepdb/caopts.inc"
-#include "hepdb/cdcblk.inc"
-#include "hepdb/ckkeys.inc"
-#include "hepdb/clinks.inc"
-#include "hepdb/ctpath.inc"
- CHARACTER PATHN*(*), CTAG*8, PATHY*80
- CHARACTER*(*) CHTAG(*)
-*
-* ------------------------------------------------------------------
-*
-* *** See if the path name is correct
-*
- CALL CDLDUP (PATHN, 0, IRC)
- IF (IRC.NE.0) GO TO 999
- PATHY = PAT1CT
-*
-* *** Find the unique directory identifier from the pathname
-*
- CALL CDGPID (PATHY, IDN)
- IF (IDN.LE.0) THEN
- IRC = 146
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDRNAM : Illegal'//
- + ' path name '//PATHY//''')', IARGCD, 0)
-#endif
- GO TO 999
- ENDIF
-*
-* *** Set the current directory to DICTIONARY and retrieve object
-*
- PAT2CT = '//'//TOPNCD(1:NCHRCD)//'/DICTIONARY'
- CALL RZCDIR (PAT2CT, ' ')
- IF (IQUEST(1).NE.0) THEN
- IRC = 147
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDRNAM : Path na'//
- + 'me '//PAT2CT(1:NCHRCD+13)//' not found'')', IARGCD, 0)
-#endif
- GO TO 999
- ENDIF
- NKEYCK = IQUEST(7)
- NWKYCK = IQUEST(8)
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- CALL CDKEYT
- ISTP = NWKYCK + 1
- IPNT = KOFSCD + LCDRCD + IKDRCD
- KPNT = IUHUNT (IDN, IQ(IPNT+IDHKSN), NKEYCK*ISTP, ISTP)
- IF (KPNT.LE.0) THEN
- IRC = 151
-#if defined(CERNLIB__DEBUG)
- NCHAR = LENOCC (PATHY)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDRNAM : No info'//
- + 'rmation for '//PATHY(1:NCHAR)//' inside Data Base'')',IARGCD,0)
-#endif
- GO TO 999
- ENDIF
- KEY1S = (KPNT - IDHKSN) / ISTP + 1
- CALL VZERO (KEYVCK, NWKYCK)
- KEYVCK(IDHKSN) = KEY1S
- IF (LSTRCL(1).NE.0) THEN
- CALL MZDROP (IDISCD, LSTRCL(1), 'L')
- LSTRCL(1) = 0
- ENDIF
- IOLD1 = IOKYCA(IDHKSN)
- IOLDK = IOPKCA
- IOPKCA = 0
- IOKYCA(IDHKSN) = 1
- ITIME = 1
- CALL CDKXIN (ITIME, IDISCD, LSTRCL(1), LSTRCL(1), 2, NWKYCK,
- + KEYVCK, IPREC, IRC)
- IOPKCA = IOLDK
- IOKYCA(IDHKSN) = IOLD1
- IF (IRC.NE.0) THEN
- CALL MZDROP (IDISCD, LSTRCL(1), 'L')
- GO TO 999
- ENDIF
-*
-* *** Now store the information in the user array
-*
- IPNT = KOFUCD + LSTRCL(1)
- NWDS = IQ(IPNT-1) / 2
- NWMAX = MIN0 (NWDS, NWMAX)
- DO 10 I = 1, NWMAX
- CALL UHTOC (IQ(IPNT+1), 4, CTAG, 8)
- CHTAG(I) = CTAG
- IPNT = IPNT + 2
- 10 CONTINUE
- CALL MZDROP (IDISCD, LSTRCL(1), 'L')
- LSTRCL(1) = 0
-* END CDRNAM
- 999 END
diff --git a/src/packlib/hepdb/cddict/cdsnam.F b/src/packlib/hepdb/cddict/cdsnam.F
deleted file mode 100644
index 329fdca..0000000
--- a/src/packlib/hepdb/cddict/cdsnam.F
+++ /dev/null
@@ -1,278 +0,0 @@
-*
-* $Id: cdsnam.F,v 1.1.1.1 1996/02/28 16:24:10 mclareni Exp $
-*
-* $Log: cdsnam.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:10 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
-#if defined(CERNLIB__P3CHILD)
-* Ignoring t=dummy
-#endif
- SUBROUTINE CDSNAM (IFLG, KEYS, LBK, LUNFZ, IRC)
-* ===============================================
-*
-************************************************************************
-* *
-* SUBR. CDSNAM (IFLG, KEYS, LBK, LUNFZ, IRC*) *
-* *
-* Saves the help file or name of the data objects in the journal *
-* file or/and in the data base. The data part contains the encoded *
-* data and the header contains Action code (6), number of keys, *
-* number of characters for option (0) and pathname, followed by the *
-* flag (1 for help file; 2 for data names), the keys and the path *
-* name. *
-* *
-* Arguments : *
-* *
-* IFLG Flag for help information(1) or name of data elements(2)*
-* KEYS Vector of keys *
-* LBK Address of the data bank to be stored (or 0) *
-* LUNFZ Logical unit number of FZ file (or 0) *
-* IRC Return Code (See below) *
-* *
-* Called by CDDINF, CDEHLP, CDENAM, CDFZUP *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* =148 : FZOUT fails to write on the sequential file *
-* =149 : Error in RZ for writing to the R.A. file *
-* =152 : Illegal flag (IFLAG) *
-* =153 : FZIN error for reading the data structure *
-* *
-************************************************************************
-*
-#include "hepdb/caopts.inc"
-#include "hepdb/cdcblk.inc"
-#include "hepdb/cfzlun.inc"
-#include "hepdb/ckkeys.inc"
-#if defined(CERNLIB__P3CHILD)
-#include "hepdb/p3dbl3.inc"
-#endif
- CHARACTER PATHN*32, PATHL*80, CHOP*4
- DIMENSION KEYO(MXDMCK), LBK(9), KEYS(9)
-#include "zebra/q_sbit.inc"
-* Ignoring t=pass
-*
-* ------------------------------------------------------------------
-*
-* *** Find the path name for storing the information
-*
- LREFCD(2) = LBK(1)
- PATHL = ' '
- IF (IFLG.EQ.1) THEN
- PATHN = '//'//TOPNCD(1:NCHRCD)//'/HELP'
- NCHAR = NCHRCD + 7
- ELSE IF (IFLG.EQ.2) THEN
- PATHN = '//'//TOPNCD(1:NCHRCD)//'/DICTIONARY'
- NCHAR = NCHRCD + 13
- ELSE
- IRC = 152
- IQUEST(11) = IFLG
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDSNAM : Illegal'//
- + ' flag '',I12)', IQUEST(11), 1)
-#endif
- GO TO 999
- ENDIF
-*
-* *** Fill up the key vector
-*
- IF (LUNFZ.GT.0) THEN
- CALL UCOPY (KEYS(1), KEYNCK, NSYSCK)
- ELSE
- CALL VZERO (KEYNCK, NSYSCK)
- KEYNCK(IDHKSN) = KEYS(1)
- CALL DATIME (IDATE, ITIME)
- KEYNCK(IDHFLG) = MSBIT1 (KEYNCK(IDHFLG), JRZUCD)
- IF (IFLG.EQ.1) KEYNCK(IDHFLG) = MSBIT1 (KEYNCK(IDHFLG), JASFCD)
- CALL CDPKTM (IDATE, ITIME, KEYNCK(IDHINS), IRC)
- ENDIF
-*
- LUFZCF = LUFZCD
-#if (defined(CERNLIB_UNIX)||defined(CERNLIB_IBMVM)||defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))
-*
- IF (IOPPCD.NE.0) THEN
- IRC = 0
-#endif
-#if (defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))&&(!defined(CERNLIB__P3CHILD))&&(defined(CERNLIB__ONLINE))
- CALL CDWLOK (IRC)
-#endif
-#if (defined(CERNLIB_UNIX)||defined(CERNLIB_IBMVM)||defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))&&(!defined(CERNLIB__P3CHILD))&&(!defined(CERNLIB__ONLINE))
- CALL CDSTSV (TOPNCD, 0, IRC)
-#endif
-#if (defined(CERNLIB_UNIX)||defined(CERNLIB_IBMVM)||defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))&&(!defined(CERNLIB__P3CHILD))&&(!defined(CERNLIB__ONLINE))
- IRC = IQUEST(1)
-#endif
-#if defined(CERNLIB__P3CHILD)
- LUFZCF = LODBP3
-#endif
-#if (defined(CERNLIB_UNIX)||defined(CERNLIB_IBMVM)||defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))
- IF (IRC.NE.0) GO TO 999
- ENDIF
-#endif
-*
-* *** Now get the bank (either supplied by user or from FZ file)
-*
- IF (IOPDCA.NE.0) THEN
- LBDACD = 0
- ELSE IF (LUNFZ.EQ.0) THEN
- LBDACD = LREFCD(2)
- ELSE
-#if defined(CERNLIB__P3CHILD)
- RNDBP3 = 'CDSNAM '
- NWDBP3 = 1
- IWDBP3(1) = LUNFZ
- CALL CDCHLD
- IRC = IQDBP3
- IF (IRC.NE.0) GO TO 999
-#endif
- CALL FZIN (LUNFZ, IDISCD, LBDACD, 2, 'A', 0, 0)
- IF (IQUEST(1).GT.0) THEN
- IRC = -1
- GO TO 999
- ELSE IF (IQUEST(1).NE.0) THEN
- IQUEST(11) = IQUEST(1)
- IRC = 153
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDSNAM : FZIN '//
- + ' error type '',I12)', IQUEST(11), 1)
-#endif
- GO TO 999
- ENDIF
- ENDIF
-*
- IF (LUFZCF.GT.0) THEN
-*
-* ** Prepare the header containing all the information
-*
- NCHD = (NCHAR + 3) / 4
- IF (IOPDCA.NE.0) THEN
- CHOP = 'D'
- NDOP = 1
- ELSE
- NDOP = 0
- CHOP = ' '
- ENDIF
- CALL MZIOCH (IOFMCF, NWFMCF, '12I -H')
- IHEDCF(MACTCF) = 6
- IHEDCF(MNKYCF) = NSYSCK
- IHEDCF(MOPTCF) = NDOP
- IHEDCF(MPATCF) = NCHD
- IHEDCF(MFLGCF) = IFLG
- CALL UCOPY (KEYNCK, IHEDCF(MFLGCF+1), NSYSCK)
- NPNT = NSYSCK + MFLGCF + 1
- IF (NDOP.GT.0) THEN
- CALL UCTOH (CHOP, IHEDCF(NPNT), 4, 4*NDOP)
- NPNT = NPNT + NDOP
- ENDIF
- CALL UCTOH (PATHN, IHEDCF(NPNT), 4, 4*NCHD)
- NWDH = NPNT + NCHD - 1
-*
-* ** Now write on the sequential output
-*
-#if defined(CERNLIB__P3CHILD)
- RNDBP3 = 'CDSNAM '
- NWDBP3 = 2
- CALL UCTOH ('JOURNAL ', IWDBP3, 4, 8)
- CALL CDCHLD
- IRC = IQDBP3
- IF (IRC.NE.0) GO TO 999
-#endif
- IF (IOPDCA.NE.0) THEN
- CHOP = 'Z'
- ELSE
- CHOP = ' '
- ENDIF
- CALL FZOUT (LUFZCF, IDISCD, LBDACD, 1,CHOP, IOFMCF, NWDH,IHEDCF)
- IF (IQUEST(1).NE.0) THEN
- IF (LUNFZ.NE.0.AND.LBDACD.GT.0) CALL MZDROP(IDISCD,LBDACD,'L')
- IRC = 148
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDSNAM : FZOUT'//
- + ' error for path name '//PATHN//''')', IARGCD, 0)
-#endif
- GO TO 999
- ENDIF
- ENDIF
-*
- IRC = 0
-#if (defined(CERNLIB_UNIX)||defined(CERNLIB_IBMVM)||defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))
-*
-* *** Server environment, Public mode
-*
- IF (IOPPCD.NE.0) THEN
-#endif
-#if (defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))&&(!defined(CERNLIB__P3CHILD))&&(defined(CERNLIB__ONLINE))
- ISAVW = IQUEST(9)
-#endif
-#if (defined(CERNLIB_UNIX)||defined(CERNLIB_IBMVM)||defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))&&(!defined(CERNLIB__ONLINE))
- IF (LUNFZ.NE.0.AND.LBDACD.GT.0) CALL MZDROP (IDISCD,LBDACD,'L')
-#endif
-#if (defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))&&(!defined(CERNLIB__P3CHILD))&&(defined(CERNLIB__ONLINE))
- IQUEST(9) = ISAVW
- IOPBCA = 0
- CALL CDCWSV (IRC)
-#endif
-#if (defined(CERNLIB_UNIX)||defined(CERNLIB_IBMVM)||defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))
- GO TO 999
- ENDIF
-#endif
-#if !defined(CERNLIB__P3CHILD)
-*
-* *** Enter the bank into data base
-*
- ISTEP = 1
- CALL RZCDIR (PATHN, ' ')
- IF (IQUEST(1).NE.0) GO TO 900
- NKEYCK = IQUEST(7)
- NWKYCK = IQUEST(8)
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- IF (IOPSCD.NE.0) THEN
- CALL RZLOCK ('CDSNAM')
- PATHL = PATHN
- ENDIF
- CALL CDKEYT
- ISTP = NWKYCK + 1
- ISTEP = 2
- KPNT = IUHUNT (KEYNCK(IDHKSN), IQ(KOFSCD+LCDRCD+IKDRCD+IDHKSN),
- + NKEYCK*ISTP, ISTP)
- IF (KPNT.GT.0) THEN
- IK = (KPNT - IDHKSN) / ISTP + 1
- CALL CDKEYR (IK, NWKYCK, KEYO)
- CALL RZDELK (KEYO, ICDUM, 'C')
- IF (IQUEST(1).NE.0) GO TO 800
- ENDIF
- ISTEP = 3
- IF (IOPDCA.EQ.0) CALL RZOUT (IDISCD, LBDACD, KEYNCK, ICYCLE, 'S')
-*
- 800 IF (PATHL.NE.' ') THEN
- IERR = IQUEST(1)
- CALL RZCDIR (PATHL, ' ')
- NKEYCK = IQUEST(7)
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- CALL RZFREE ('CDSNAM')
- IQUEST(1) = IERR
- ELSE
- IKDRCD = IQ(KOFSCD+LCDRCD+KLKDCD)
- NKEYCK = IQ(KOFSCD+LCDRCD+KNKDCD)
- ENDIF
- 900 IERR = IQUEST(1)
- IF (LUNFZ.NE.0) CALL MZDROP (IDISCD, LBDACD, 'L')
- IF (IERR.NE.0) THEN
- IRC = 149
- IQUEST(11) = ISTEP
-#endif
-#if (defined(CERNLIB__DEBUG))&&(!defined(CERNLIB__P3CHILD))
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDSNAM : RZ erro'//
- + 'r in step '',I3,'' for path name '//PATHN//''')', IQUEST(11),1)
-#endif
-#if !defined(CERNLIB__P3CHILD)
- ENDIF
-#endif
-* END CDSNAM
- 999 END
diff --git a/src/packlib/hepdb/cddict/cdudic.F b/src/packlib/hepdb/cddict/cdudic.F
deleted file mode 100644
index ad5574c..0000000
--- a/src/packlib/hepdb/cddict/cdudic.F
+++ /dev/null
@@ -1,211 +0,0 @@
-*
-* $Id: cdudic.F,v 1.1.1.1 1996/02/28 16:24:10 mclareni Exp $
-*
-* $Log: cdudic.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:10 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
-#if defined(CERNLIB__P3CHILD)
-* Ignoring t=dummy
-#endif
- SUBROUTINE CDUDIC (IRC)
-* =======================
-*
-************************************************************************
-* *
-* SUBR. CDUDIC (IRC*) *
-* *
-* Updates the dictionary information if not yet available in the *
-* disk file *
-* *
-* Arguments : *
-* *
-* IRC Return code (see below) *
-* *
-* Called by CDINIT *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* =140 : Illegal Top directory name *
-* =141 : Error in creating the DICTIONARY/HELP directory *
-* =142 : Error in RZ in writing the dictionary object *
-* =143 : Error in RZ in purging the dictionary directory *
-* *
-************************************************************************
-*
-#include "hepdb/caopti.inc"
-#include "hepdb/cdcblk.inc"
-#include "hepdb/ckkeys.inc"
-#include "hepdb/ctpath.inc"
- CHARACTER PATHD*80, CFOR*32
-#include "zebra/q_jbit.inc"
-* Ignoring t=pass
-* ------------------------------------------------------------------
-*
- IRC = 0
- IOUT = IOUTCD
- NSYSCK = NOF2CK + 2*NPARCD
- IF (IOPPCD.NE.0) IOUT = 0
- PAT1CT = '//'//TOPNCD
- NCHR = NCHRCD + 2
- PATHD = PAT1CT(1:NCHR)//'/DICTIONARY'
- CALL RZCDIR (PAT1CT, ' ')
- IF (IQUEST(1).NE.0) THEN
- IRC = 140
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDUDIC : Illegal'//
- + ' top directory '//PAT1CT//''')', IARGCD, 0)
-#endif
- GO TO 999
- ENDIF
-#if !defined(CERNLIB__P3CHILD)
-*
-* *** Create the help file if it does not exist
-*
- IF (IOUT.NE.0) THEN
- PAT2CT = PAT1CT(1:NCHR)//'/HELP'
- CALL RZCDIR (PAT2CT, 'Q')
- IF (IQUEST(1).NE.0) THEN
- CFOR = CHFTCK(1:NSYSCK)
- DO I = 1, NSYSCK
- CTAGCK(I) = CHTGCK(I)
- ENDDO
- DO I = 1, NPARCD
- CFOR(NOF1CK+2*I-1:NOF1CK+2*I-1) = 'I'
- CFOR(NOF1CK+2*I :NOF1CK+2*I ) = 'I'
- CTAGCK(NOF1CK+2*I-1) = 'STR_VAL'//CALFCA(27+I)
- CTAGCK(NOF1CK+2*I) = 'END_VAL'//CALFCA(27+I)
- ENDDO
- CALL RZCDIR (PAT1CT, ' ')
- IF (IOPSCD.NE.0) CALL RZLOCK ('CDUDIC')
- CALL RZMDIR ('HELP', NSYSCK, CFOR, CTAGCK)
- IERR = IQUEST(1)
- IF (IOPSCD.NE.0) THEN
- CALL RZCDIR (PAT1CT, ' ')
- CALL RZFREE ('CDUDIC')
- ENDIF
- IF (IERR.NE.0) THEN
- IRC = 141
-#endif
-#if (defined(CERNLIB__DEBUG))&&(!defined(CERNLIB__P3CHILD))
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDUDIC : RZM'//
- + 'DIR error for path name '//PAT2CT//''')', IARGCD, 0)
-#endif
-#if !defined(CERNLIB__P3CHILD)
- GO TO 999
- ENDIF
- ENDIF
- ENDIF
-#endif
-*
-* *** Try to load the dictionary information if it exists
-*
- CALL RZCDIR (PATHD, 'Q')
- IF (IQUEST(1).NE.0) THEN
- IQUEST(1) = 0
-#if !defined(CERNLIB__P3CHILD)
- IF (IOUT.NE.0) THEN
- CFOR = CHFTCK(1:NSYSCK)
- DO I = 1, NSYSCK
- CTAGCK(I) = CHTGCK(I)
- ENDDO
- DO I = 1, NPARCD
- CFOR(NOF1CK+2*I-1:NOF1CK+2*I-1) = 'I'
- CFOR(NOF1CK+2*I :NOF1CK+2*I ) = 'I'
- CTAGCK(NOF1CK+2*I-1) = 'STR_VAL'//CALFCA(27+I)
- CTAGCK(NOF1CK+2*I) = 'END_VAL'//CALFCA(27+I)
- ENDDO
- CALL RZCDIR (PAT1CT, ' ')
- IF (IOPSCD.NE.0) CALL RZLOCK ('CDUDIC')
- CALL RZMDIR ('DICTIONARY', NSYSCK, CFOR, CTAGCK)
- IERR = IQUEST(1)
- IF (IOPSCD.NE.0) THEN
- CALL RZCDIR (PAT1CT, ' ')
- CALL RZFREE ('CDUDIC')
- ENDIF
- IF (IERR.NE.0) THEN
- IRC = 141
-#endif
-#if (defined(CERNLIB__DEBUG))&&(!defined(CERNLIB__P3CHILD))
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDUDIC : RZM'//
- + 'DIR error for path name '//PATHD//''')', IARGCD, 0)
-#endif
-#if !defined(CERNLIB__P3CHILD)
- GO TO 999
- ENDIF
- ENDIF
-#endif
- GO TO 5
- ENDIF
- NKEYCK = IQUEST(7)
- NWKYCK = IQUEST(8)
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- ISTP = NWKYCK + 1
- IF (NKEYCK.GT.0) THEN
- IPNT = KOFSCD + LCDRCD + IKDRCD
- IMIN = IUHUNT (-1, IQ(IPNT+IDHKSN), NKEYCK*ISTP, ISTP)
- IF (IMIN.GT.0) THEN
- IMIN = (IMIN - IDHKSN) / ISTP + 1
- CALL CDKEYT
- CALL CDKEYR (IMIN, NWKYCK, KEYNCK)
- LFIXCD = LQ(KOFUCD+LBUPCD-KLDICD)
- IF (LFIXCD.NE.0) CALL MZDROP (IDIVCD, LFIXCD, ' ')
- CALL CDRZIN (IDIVCD, LBUPCD, -KLDICD, IMIN, ICYCL, PATHD, IRC)
- IF (IRC.EQ.0) GO TO 999
- IOUT = 0
- ENDIF
- ENDIF
-*
- 5 CALL VZERO (KEYNCK, NSYSCK)
- KEYNCK(IDHKSN) = -1
- KEYNCK(IDHFLG) = 1
- CALL DATIME (IDATE, ITIME)
- CALL CDPKTM (IDATE, ITIME, KEYNCK(IDHINS), IRC)
- CALL CDMDIC (TOPNCD, LBUPCD, -KLDICD, IRC)
- IF (IRC.NE.0) GO TO 999
- LFIXCD = LQ(KOFUCD+LBUPCD-KLDICD)
-#if !defined(CERNLIB__P3CHILD)
-*
-* *** All subdirectories looked at; now store dictionary if permitted
-*
- IF (IOUT.NE.0) THEN
- CALL RZCDIR (PATHD, ' ')
- LCDRCD = IQUEST(11)
- IF (IOPSCD.NE.0) CALL RZLOCK ('CDUDIC')
- CALL RZOUT (IDIVCD, LFIXCD, KEYNCK, ICYCLE, 'S')
- IKDRCD = IQ(KOFSCD+LCDRCD+KLKDCD)
- NKEYCK = IQ(KOFSCD+LCDRCD+KNKDCD)
- IF (IQUEST(1).NE.0) THEN
- IF (IOPSCD.NE.0) CALL RZFREE ('CDUDIC')
- IRC = 142
-#endif
-#if (defined(CERNLIB__DEBUG))&&(!defined(CERNLIB__P3CHILD))
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDUDIC : RZOUT'//
- + ' error for path name '//PATHD//''')', IARGCD, 0)
-#endif
-#if !defined(CERNLIB__P3CHILD)
- GO TO 999
- ENDIF
- CALL RZPURG (0)
- IERR = IQUEST(1)
- IF (IOPSCD.NE.0) CALL RZFREE ('CDUDIC')
- IF (IERR.NE.0) THEN
- IRC = 143
-#endif
-#if (defined(CERNLIB__DEBUG))&&(!defined(CERNLIB__P3CHILD))
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDUDIC : RZPUR'//
- + 'G error for path name '//PATHD//''')', IARGCD, 0)
-#endif
-#if !defined(CERNLIB__P3CHILD)
- GO TO 999
- ENDIF
- ENDIF
-#endif
-*
- 100 IRC = 0
-* END CDUDIC
- 999 END
diff --git a/src/packlib/hepdb/cdfzup/Imakefile b/src/packlib/hepdb/cdfzup/Imakefile
deleted file mode 100644
index 96a403d..0000000
--- a/src/packlib/hepdb/cdfzup/Imakefile
+++ /dev/null
@@ -1,7 +0,0 @@
-SRCS_F= cdextr.F cdfzop.F cdfzwr.F cdrtfz.F
-
-#if !defined(CERNLIB_P3CHILD)
-SRCS_F := $(SRCS_F) cdfzup.F cdildf.F cdildu.F
-#endif
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/hepdb/cdfzup/cdextr.F b/src/packlib/hepdb/cdfzup/cdextr.F
deleted file mode 100644
index 9acccff..0000000
--- a/src/packlib/hepdb/cdfzup/cdextr.F
+++ /dev/null
@@ -1,114 +0,0 @@
-*
-* $Id: cdextr.F,v 1.1.1.1 1996/02/28 16:24:12 mclareni Exp $
-*
-* $Log: cdextr.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:12 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDEXTR (PATHI, LUNFZ, K1MIN, K1MAX, CHOPT,IRC)
-* =========================================================
-*
-************************************************************************
-* *
-* SUBR. CDEXTR (PATHI, LUNFZ, K1MIN, K1MAX, CHOPT) *
-* *
-* Copies a part of the directory tree from the current level *
-* downwards (in the range K1MIN-K1MAX or with insertion time > K1MIN *
-* for specified CHOPT) into a sequential file in the format of the *
-* journal file *
-* *
-* Arguments : *
-* *
-* PATHI Path name describing the directory tree *
-* LUNFZ Logical unit number of the output FZ file *
-* K1MIN Minumum serial number (Key 1 value) to be copied, or *
-* Minimum date (YYMMDD) for insertion time to be copied *
-* (Depends on CHOPT supplied) *
-* K1MAX Maximum serial number (Key 1 value) to be copied, or *
-* Minimum time (HHMM) for insertion time to be copied *
-* (Depends on CHOPT supplied) *
-* CHOPT Character string with any of the following characters *
-* F Updates with a fully matched data object (in user keys) *
-* I Copies objects with insertion time > (K1MIN/K1MAX) *
-* R Copied objects with RZ insertion time > (K1MIN/K1MAX) *
-* IRC Return code (see below) *
-* *
-* Called by user *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* = 75 : Dictionary is not loaded *
-* *
-* If IRC = 0, IQUEST(2) carries information on number of data *
-* objects transfered to the FZ file *
-* *
-************************************************************************
-*
-#include "hepdb/caopts.inc"
-#include "hepdb/cdcblk.inc"
-#include "hepdb/ctpath.inc"
- CHARACTER PATHN*80, PATHY*80, PATHF*80, PROOT*80
- CHARACTER PATHI*80, CHOPT*(*)
-*
-* ------------------------------------------------------------------
-*
-* *** Load the current directory
-*
- PATHN = PATHI
- CALL CDOPTS (' ', IRC)
- CALL CDLDUP (PATHN, 1, IRC)
- IF (IRC.NE.0) GO TO 999
- PATHN = PAT1CT
- NCHR = LENOCC (PATHN)
- PATHF = '//'//TOPNCD(1:NCHRCD)//'/DICTIONARY'
- IF (PATHN.EQ.PATHF) GO TO 999
- PATHF = '//'//TOPNCD(1:NCHRCD)//'/HELP'
- IF (PATHN.EQ.PATHF) GO TO 999
- IF (NCHRCD.GE.NCHR-2) THEN
- PROOT = ' '
- NROOT = 0
- ELSE
- PROOT = PATHN(NCHRCD+3:NCHR)
- NROOT = NCHR - NCHRCD - 2
- ENDIF
-*
-* *** Find the dictionary record
-*
- LFIXCD = LQ(KOFUCD+LBUPCD-KLDICD)
- IF (LFIXCD.EQ.0) THEN
- IRC = 75
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDEXTR : DICTION'//
- + 'ARY not found for '//TOPNCD//''')', IARGCD, 0)
-#endif
- GO TO 999
- ENDIF
-*
-* *** Loop over all items
-*
- NITEM = IQ(KOFUCD+LFIXCD+MDCNTM)
- NTOTL = 0
- DO 20 I = 1, NITEM
- IPNT = KOFUCD + LFIXCD + (I - 1) * NWITCD + 1
- NCHF = IQ(IPNT+MDCNCH)
- IF (IQ(IPNT+MDCITM).GT.0) THEN
- CALL UHTOC (IQ(IPNT+MDCNAM), 4, PATHF, NCHF)
- PATHF = PATHF(1:NCHF)
- IF (PATHF.EQ.'/HELP'.OR.PATHF.EQ.'/DICTIONARY') GO TO 20
- IF (NROOT.GT.0) THEN
- IF (PATHF(1:NROOT).NE.PROOT(1:NROOT)) GO TO 20
- IF (PATHF(NROOT+1:NROOT+1).NE.' '.AND.
- + PATHF(NROOT+1:NROOT+1).NE.'/') GO TO 20
- ENDIF
- PATHY = '//'//TOPNCD(1:NCHRCD)//PATHF
- CALL CDRTFZ (PATHY, LUNFZ, K1MIN, K1MAX, CHOPT, IRC)
- IF (IRC.NE.0) GO TO 999
- NTOTL = NTOTL + IQUEST(2)
- ENDIF
- 20 CONTINUE
- IQUEST(2) = NTOTL
-* END CDEXTR
- 999 END
diff --git a/src/packlib/hepdb/cdfzup/cdfzop.F b/src/packlib/hepdb/cdfzup/cdfzop.F
deleted file mode 100644
index c4f2d42..0000000
--- a/src/packlib/hepdb/cdfzup/cdfzop.F
+++ /dev/null
@@ -1,87 +0,0 @@
-*
-* $Id: cdfzop.F,v 1.1.1.1 1996/02/28 16:24:11 mclareni Exp $
-*
-* $Log: cdfzop.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:11 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDFZOP (LUNFZ, TOPN, CHOPT, IRC)
-* ===========================================
-*
-************************************************************************
-* *
-* SUBR. CDFZOP (LUNFZ, TOPN, CHOPT, IRC*) *
-* *
-* Sets the output FZ file number as the sequential backup file for *
-* a given top directory. One can have up to two backup files, one *
-* for standard journaling, the other for special backups. *
-* *
-* Arguments : *
-* *
-* LUNFZ Logical unit number of the FZ file *
-* TOPN Top directory name to which the FZ file refers *
-* CHOPT Character string with any of the following characters *
-* B Specify a special backup file *
-* IRC Return code (see below) *
-* *
-* Called by user *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* =135 : Illegal top directory name *
-* *
-************************************************************************
-*
-#include "hepdb/caopts.inc"
-#include "hepdb/cdcblk.inc"
-#include "hepdb/cfzlun.inc"
-#include "hepdb/ctpath.inc"
- CHARACTER TOPN*(*), CHOPT*(*)
-*
-* ------------------------------------------------------------------
-*
-* *** Decode the character option
-*
- CALL CDOPTS (CHOPT, IRC)
- IF (IRC.NE.0) GO TO 999
- CALL CDSBLC (TOPN, TOPNCD, NCHRCD)
-*
-* *** Check if the topname matches with any of the existing topnames
-*
- LBUPCD = LTOPCD
- 10 IF (LBUPCD.GT.0) THEN
- NCHR = IQ(KOFUCD+LBUPCD+MUPNCH)
- CALL UHTOC (IQ(KOFUCD+LBUPCD+MUPNAM), 4, TOP1CT, NCHR)
- TOP1CT = TOP1CT(1:NCHR)
- IF (TOPNCD.NE.TOP1CT) THEN
- LBUPCD = LQ(KOFUCD+LBUPCD)
- GO TO 10
- ELSE
- IF (IOPBCA.EQ.0) THEN
- IOFF = MUPJFL
- ELSE
- IOFF = MUPBAK
- ENDIF
- LUNOL = IQ(KOFUCD+LBUPCD+IOFF)
- IQ(KOFUCD+LBUPCD+IOFF) = LUNFZ
- IF (LUNOL.LE.0.AND.LUNFZ.GT.0) THEN
- INC = 1
- ELSE IF (LUNOL.GT.0.AND.LUNFZ.LE.0) THEN
- INC =-1
- ELSE
- INC = 0
- ENDIF
- NUFZCF = NUFZCF + INC
- ENDIF
- ELSE
- IRC = 135
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDFZOP : Illegal'//
- + ' top directory name '//TOPNCD//''')', IARGCD, 0)
-#endif
- ENDIF
-* END CDFZOP
- 999 END
diff --git a/src/packlib/hepdb/cdfzup/cdfzup.F b/src/packlib/hepdb/cdfzup/cdfzup.F
deleted file mode 100644
index 87cc7dd..0000000
--- a/src/packlib/hepdb/cdfzup/cdfzup.F
+++ /dev/null
@@ -1,586 +0,0 @@
-*
-* $Id: cdfzup.F,v 1.1.1.1 1996/02/28 16:24:11 mclareni Exp $
-*
-* $Log: cdfzup.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:11 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
-#if !defined(CERNLIB__P3CHILD)
- SUBROUTINE CDFZUP (LUNFZ, CHOPT, IRC)
-* =====================================
-*
-************************************************************************
-* *
-* SUBR. CDFZUP (LUNFZ, CHOPT, IRC*) *
-* *
-* Updates the data base from transcript file from unit LUNFZ *
-* *
-* Arguments : *
-* *
-* LUNFZ Logical unit number of the FZ file *
-* CHOPT Character string with any of the following characters *
-* F Force continuation beyond errors *
-* O Updating journal file is an external source *
-* S Updating journal file in a single record mode *
-* IRC Return code (see below) *
-* *
-* Called by user *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* = 71 : Illegal path name in the transcript file *
-* = 72 : Read error on the FZ file *
-* = 76 : Cannot form the IO descriptor for the FZ header *
-* = 78 : Illegal number of keys in journal file *
-* = 79 : Top directory name illegal in the transcript *
-* file *
-* *
-************************************************************************
-*
-#include "hepdb/caopts.inc"
-#include "hepdb/cdcblk.inc"
-#include "hepdb/cfzlun.inc"
-#include "hepdb/cinitl.inc"
-#include "hepdb/ckkeys.inc"
-#include "hepdb/ctpath.inc"
-#if (defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))&&(defined(CERNLIB__ONLINE))
-#include "hepdb/cbsrvrn.inc"
-#endif
- PARAMETER (NLEVM=20, JBIAS=2)
- DIMENSION NLCUR(NLEVM), KEYN(MXDMCK), IMASK(MXDMCK)
- DIMENSION ITIME(MXPACD)
- CHARACTER ALIAS*8, PATHN*255, PATHD*255, CHOPT*(*)
- CHARACTER CHFOR*100, CFORM(6)*1, CHOPF*255, CHCUR(NLEVM)*1
- DATA CFORM / 'B', 'I', 'F', 'D', 'H', 'A' /
-*
-* ------------------------------------------------------------------
-*
- PATHD = ' '
- CALL UOPTC (CHOPT, 'F', IOPTF)
- CALL UOPTC (CHOPT, 'O', IOVRD)
- CALL UOPTC (CHOPT, 'S', ISNGR)
-*
-* *** Read the header record from the FZ file
-*
- 10 NWHDCF = NHEDCF
- CALL FZIN (LUNFZ, IDISCD, 0, 0, 'S', NWHDCF, IHEDCF)
- IF (IQUEST(1).GT.0) GO TO 997
- IF (IQUEST(1).NE.0) THEN
- IQUEST(11) = IQUEST(1)
- IRC = 72
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDFZUP : FZ '
- + //'error type '',I12)', IQUEST(11), 1)
-#endif
- IF (LUNFZ.EQ.LUFMCD.OR.IOPTF.EQ.0.OR.ISNGR.NE.0) GO TO 998
- IRC = 0
- GO TO 10
- ENDIF
- IACT = IHEDCF(MACTCF)
- NWKEY = IHEDCF(MNKYCF)
- NDOP = IHEDCF(MOPTCF)
- NWDP = IHEDCF(MPATCF)
- NCFO = (NWKEY + 3) / 4
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.1) CALL CDPRNT (LPRTCD, '(/,'' CDFZUP : ' //
- +'action code '',I12)', IHEDCF(MACTCF), 1)
-#endif
- IF (IACT.EQ.1) THEN
- NPNT1 = MPRECF + NWKEY + 1
- NPNT2 = NPNT1 + NDOP
- ELSE IF (IACT.EQ.2) THEN
- NPNT1 = MRECCF + 1
- NPNT2 = NPNT1 + NDOP + NCFO + 2 * NWKEY
- ELSE IF (IACT.EQ.3) THEN
- KEY7CK = IHEDCF(MINSCF)
- NPARS = IHEDCF(MPARCF)
- IF (NPARS.GT.0) THEN
- NPNT1 = MTIMCF + 2*NWKEY + NPARS
- ELSE
- NPNT1 = MTIMCF + NWKEY
- ENDIF
- NPNT2 = NPNT1 + NDOP
- ELSE IF (IACT.EQ.4) THEN
- KEY7CK = IHEDCF(MINSCF)
- NPNT1 = MINSCF + 1
- NPNT2 = NPNT1 + NDOP
- ELSE IF (IACT.EQ.5) THEN
- KEY7CK = 0
- NPNT1 = MPRECF + 2*NWKEY + 1
- NPNT2 = NPNT1
- ELSE IF (IACT.EQ.6) THEN
- KEY7CK = 0
- NPNT1 = MFLGCF + NWKEY + 1
- NPNT2 = NPNT1 + NDOP
-* NPNT2 = NPNT1
- ELSE IF (IACT.EQ.7) THEN
- KEY7CK = 0
- NPNT1 = MWDPCF + 1
- NPNT2 = NPNT1
- ELSE IF (IACT.EQ.8) THEN
- KEY7CK = IHEDCF(MDELCF)
- NPNT1 = MKEPCF + 1
- NPNT2 = NPNT1 + NDOP
- ELSE IF (IACT.EQ.9) THEN
- NPNT1 = MPRECF + NWKEY + 1
- NPNT2 = NPNT1 + NDOP
- ELSE IF (IACT.EQ.10) THEN
- NPNT1 = MPATCF + NWKEY + 1
- NPNT2 = NPNT1 + NDOP
- ELSE
- IF (LUNFZ.EQ.LUFMCD.OR.ISNGR.NE.0) GO TO 997
- GO TO 10
- ENDIF
-*
- IF (IACT.GT.0.AND.IACT.LE.6.AND.IACT.NE.4) THEN
- IF (NWKEY.LT.NOF2CK.OR.NWKEY.GT.MXDMCK) THEN
- IRC = 78
- IQUEST(11) = NWKEY
- IQUEST(12) = NOF2CK
- IQUEST(13) = MXDMCK
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDFZUP : '
- + //'Illegal number of keys '',I10,'' permitted range '
- + //''',2I6)', IQUEST(11), 3)
-#endif
- IF (LUNFZ.EQ.LUFMCD.OR.IOPTF.EQ.0.OR.ISNGR.NE.0) GO TO 998
- IRC = 0
- GO TO 10
- ENDIF
- ENDIF
-*
- IF (NDOP.GT.0) THEN
- NDOP = MIN0 (NDOP, MAXLCD/4)
- CALL UHTOC (IHEDCF(NPNT1), 4, CHOPF, 4*NDOP)
- CHOPF = CHOPF(1:4*NDOP)
- ELSE
- CHOPF = ' '
- ENDIF
- CALL CDOPTS (CHOPF, IRC)
- IF (IRC.GT.0) THEN
- IF (LUNFZ.EQ.LUFMCD.OR.IOPTF.EQ.0.OR.ISNGR.NE.0) GO TO 998
- IRC = 0
- GO TO 10
- ENDIF
-*
- CALL UHTOC (IHEDCF(NPNT2), 4, PATHN, 4*NWDP)
- PATHN = PATHN(1:4*NWDP)
- NCH = LENOCC (PATHN)
-#if (defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))&&(defined(CERNLIB__ONLINE))
- LPNUCB = 4*NWDP
- PNUPCB = PATHN
- IAUPCB = IACT
-#endif
-*
-* *** Extract the top directory name from the pathname
-*
- CALL CDTOPN (PATHN, TOPNCD, NCHRCD)
- IF (NCHRCD.EQ.0) THEN
- IRC = 79
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDFZUP : '
- + //'Illegal top directory name '//PATHN//''')', IARGCD, 0)
-#endif
- IF (LUNFZ.EQ.LUFMCD.OR.IOPTF.EQ.0.OR.ISNGR.NE.0) GO TO 998
- IRC = 0
- GO TO 10
- ENDIF
-*
-* *** Check if the topname matches with any of the existing topnames
-*
- IPRBCA = 0
- IPRECA = 0
- LBUPCD = LTOPCD
- 20 IF (LBUPCD.NE.0) THEN
- NCHR = IQ(KOFUCD+LBUPCD+MUPNCH)
- CALL UHTOC (IQ(KOFUCD+LBUPCD+MUPNAM), 4, TOP1CT, NCHR)
- IF (TOP1CT(1:NCHR).NE.TOPNCD) THEN
- LBUPCD = LQ(KOFUCD+LBUPCD)
- GO TO 20
- ELSE
- LURZCD = IQ(KOFUCD+LBUPCD+MUPLUN)
- IOUTCD = IQ(KOFUCD+LBUPCD+MUPFLG)
- IOPPCD = IQ(KOFUCD+LBUPCD+MUPSRV)
- IOPSCD = IQ(KOFUCD+LBUPCD+MUPSHR)
- NPARCD = IQ(KOFUCD+LBUPCD+MUPAIR)
- ITOPCD = IQ(KOFUCD+LBUPCD+MUPDIC)
- MXINCD = IQ(KOFUCD+LBUPCD+MUPKIN)
- LUFZCD = IQ(KOFUCD+LBUPCD+MUPJFL)
- LUBKCD = IQ(KOFUCD+LBUPCD+MUPBAK)
- IHFLCD = IQ(KOFUCD+LBUPCD+MUPHFL)
- ENDIF
-*
- ELSE
- IRC = 79
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDFZUP : '
- + //'Illegal top directory name '//PATHN//''')', IARGCD, 0)
-#endif
- IF (LUNFZ.EQ.LUFMCD.OR.IOPTF.EQ.0.OR.ISNGR.NE.0) GO TO 998
- IRC = 0
- GO TO 10
- ENDIF
-*
- LREFCD(1) = LQ(KOFUCD+LBUPCD-KLFZCD)
- IF (IOPBCA.EQ.0) THEN
- LUFZCF = LUFZCD
- ELSE
- LUFZCF = LUBKCD
- ENDIF
-*
-* *** Check if the directory is one in the list
-*
- IF (LREFCD(1).NE.0) THEN
- NCUR = IQ(KOFUCD+LREFCD(1)-5)
- DO 30 I = 1, NCUR
- IPNT = KOFUCD + LREFCD(1) + MFZDIR + (I - 1) * (MXLWCD + 1)
- NCHZ = IQ(IPNT)
- CALL UHTOC (IQ(IPNT+1), 4, PAT1CT, NCHZ)
- IF ((PAT1CT(1:NCHZ).EQ.PATHN(1:NCHZ)).AND. (PATHN(NCHZ+1:
- + NCHZ+1).EQ.'/'.OR. PATHN(NCHZ+1:NCHZ+1).EQ.' ')) GO TO 35
- 30 CONTINUE
- IRC = 0
- IF (LUNFZ.EQ.LUFMCD.OR.IOPTF.EQ.0.OR.ISNGR.NE.0) GO TO 998
- GO TO 10
- ENDIF
-*
-* *** Decide overriding flag
-*
- 35 IOVRCD = IOVRD
- IF (LBAFCD.NE.0) THEN
- NCUR = IQ(KOFUCD+LBAFCD-5)
- DO 40 I = 1, NCUR
- IPNT = KOFUCD + LBAFCD + (I - 1) * (MXLWCD + 1) + 1
- NCHZ = IQ(IPNT)
- CALL UHTOC (IQ(IPNT+1), 4, PAT1CT, NCHZ)
- IF ((PAT1CT(1:NCHZ).EQ.PATHN(1:NCHZ)).AND.(NCHZ.EQ.NCH))
- + THEN
- IOVRCD = 1
- GO TO 45
- ENDIF
- 40 CONTINUE
- ENDIF
-*
- 45 CONTINUE
-*
-* *** call RZCDIR as the current directory is new or already updated
-*
- IF (IACT.NE.2) THEN
- PAT1CT = PATHN
- ELSE
- PAT1CT = '//'//TOPNCD
- ENDIF
- CALL RZCDIR (PAT1CT, ' ')
- IF (IQUEST(1).NE.0) THEN
- IRC = 71
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDFZUP : '
- + //'Illegal path name '//PAT1CT//''')', IARGCD, 0)
-#endif
- IF (LUNFZ.EQ.LUFMCD.OR.IOPTF.EQ.0.OR.ISNGR.NE.0) GO TO 998
- IRC = 0
- GO TO 10
- ENDIF
- NKEYCK = IQUEST(7)
- NWKYCK = IQUEST(8)
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- PATHD = PATHN
-*
-* ** Get the IO descriptor for the header
-*
- IF (LUFZCF.GT.0.AND.IACT.EQ.1) THEN
- CALL CDKEYT
- NLEV = 1
- NCUR = 5
- IFORO = 2
- CHCUR(NLEV) = CFORM(IFORO)
- DO 50 I = 1, NWKYCK
- IFORM = IOTYCK(I)
- IF (IFORM.EQ.6) IFORM = 5
- IF (IFORM.EQ.IFORO) THEN
- NCUR = NCUR + 1
- ELSE
- NLCUR(NLEV) = NCUR
- IF (NLEV.GE.NLEVM) THEN
- IRC = 76
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' '
- + //'CDFZUP : Cannot get IO descriptor '// PATHN//''')'
- + , IARGCD, 0)
-#endif
- IF (LUNFZ.EQ.LUFMCD.OR.IOPTF.EQ.0.OR.ISNGR.NE.0)
- + GO TO 998
- IRC = 0
- GO TO 10
- ENDIF
- NLEV = NLEV + 1
- CHCUR(NLEV) = CFORM(IFORM)
- NCUR = 1
- IFORO = IFORM
- ENDIF
- 50 CONTINUE
- NLCUR(NLEV) = NCUR
-*
-#if !defined(CERNLIB_IBM)||!defined(CERNLIB__P3CHILD)
- WRITE (CHFOR, 2001) (NLCUR(I), CHCUR(I), I = 1, NLEV)
-#endif
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB__P3CHILD))
- CHFOR = ' '
- II = 1
- DO 55 I = 1, NLEV
- CALL UTWRIT (CHFOR(II:II+1), '(I2)', NLCUR(I))
- II = II + 2
- CHFOR(II:II) = CHCUR(I)
- II = II + 2
- 55 CONTINUE
-#endif
- II = 4 *NLEV
- CHFOR = CHFOR(1:II)//' -H'
- CALL MZIOCH (IOFMCF, NWFMCF, CHFOR(1:II+3))
- ENDIF
-*
-* *** Take appropriate action as directed by IACT
-*
- IF (IACT.EQ.1) THEN
-*
-* ** Enter data
-*
- CALL CDENFZ (PATHN, LUNFZ, IRC)
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) THEN
- CALL CDUPTM (IARGCD(1),IARGCD(2),IHEDCF(MPRECF+IDHINS),IRC0)
- IARGCD(3) = IRC
- CALL CDPRNT (LPRTCD, '('' CDFZUP : enter object in '//
- + PATHN(1:60)//' time '',2I8,'' return code '',I6)', IARGCD,
- + 3)
- ENDIF
-#endif
- IF (IRC.LT.0) GO TO 997
-*
- ELSE IF (IACT.EQ.2) THEN
-*
-* ** Create a new directory
-*
- IOKYCA(IDHKSN) = 1
- KEY7CK = IHEDCF(MINSCF)
- NPNTF = NPNT1 + NDOP
- CALL UHTOC (IHEDCF(NPNTF), 4, CHFOR, NWKEY)
- CHFOR = CHFOR(1:NWKEY)
- NPNTF = NPNTF + NCFO
- DO 60 IK = 1, NWKEY
- CALL UHTOC (IHEDCF(NPNTF), 4, CTAGCK(IK), 8)
- NPNTF = NPNTF + 2
- 60 CONTINUE
- CALL FZIN (LUNFZ, IDISCD, LFIXCD, JBIAS, 'A', 0, 0)
- IF (IQUEST(1).GT.0) GO TO 997
- IF (IQUEST(1).NE.0) THEN
- IQUEST(11) = IQUEST(1)
- IRC = 72
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDFZUP : FZ '
- + //'error type '',I12)', IQUEST(11), 1)
-#endif
- IF (LUNFZ.EQ.LUFMCD.OR.IOPTF.EQ.0.OR.ISNGR.NE.0) GO TO 998
- IRC = 0
- GO TO 10
- ENDIF
- IPREC = IQ(KOFUCD+LFIXCD-5)
- DELTA = Q(KOFUCD+LFIXCD+1)
- MXKP = IHEDCF(MXKPCF)
- CALL MZDROP (IDISCD, LFIXCD, 'L')
- CALL CDMKDI (PATHN, NWKEY, CHFOR, CTAGCK, MXKP, IPREC, DELTA,
- + CHOPF, IRC)
- IOKYCA(IDHKSN) = 0
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) THEN
- CALL CDUPTM (IARGCD(1), IARGCD(2), IHEDCF(MINSCF), IRC0)
- IARGCD(3) = IRC
- CALL CDPRNT (LPRTCD, '('' CDFZUP : enter new directory '//
- + PATHN(1:60)//' time '',2I8,'' return code '',I6)', IARGCD,
- + 3)
- ENDIF
-#endif
-*
- ELSE IF (IACT.EQ.3) THEN
-*
-* ** Delete data objects
-*
- IF (NPARS.GT.0) THEN
- CALL UCOPY (IHEDCF(MTIMCF), ITIME, NPARS)
- CALL UCOPY (IHEDCF(MTIMCF+NPARS+NWKEY), KEYVCK, NWKEY)
- CALL UCOPY (IHEDCF(MTIMCF+NPARS), IMASK, NWKEY)
- CALL CDPURK (PATHN, ITIME, IMASK, KEYVCK, CHOPF, IRC)
- ELSE
- KYDAT = IHEDCF(MTIMCF+IDHKSN-1)
- KYTIM = IHEDCF(MTIMCF+IDHPTR-1)
- CALL CDPURG (PATHN, KYDAT, KYTIM, CHOPF, IRC)
- ENDIF
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) THEN
- CALL CDUPTM (IARGCD(1), IARGCD(2), IHEDCF(MINSCF), IRC0)
- IARGCD(3) = IRC
- IARGCD(4) = IQUEST(2)
- CALL CDPRNT (LPRTCD, '('' CDFZUP : purge data from '//
- + PATHN(1:60)//' time '',2I8,'' return code '',I4,I6)',
- + IARGCD, 4)
- ENDIF
-#endif
-*
- ELSE IF (IACT.EQ.4) THEN
-*
-* ** Delete an entire tree
-*
- CALL CDDDIR (PATHN, CHOPF, IRC)
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) THEN
- CALL CDUPTM (IARGCD(1), IARGCD(2), IHEDCF(MINSCF), IRC0)
- IARGCD(3) = IRC
- CALL CDPRNT (LPRTCD, '('' CDFZUP : delete the tree '//
- + PATHN(1:60)//' time '',2I8,'' return code '',I6)', IARGCD,
- + 3)
- ENDIF
-#endif
- IF (IRC.EQ.171) IRC = 0
-*
- ELSE IF (IACT.EQ.5) THEN
-*
-* ** Rename the keys
-*
- CALL UCOPY (IHEDCF(MPRECF+1), KEYVCK, NWKEY)
- CALL UCOPY (IHEDCF(MPRECF+NWKEY+1), KEYN, NWKEY)
- CALL CDRENK (PATHN, KEYVCK, KEYN, IRC)
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) THEN
- CALL CDUPTM (IARGCD(1), IARGCD(2), IHEDCF(MPRECF+IDHINS),
- + IRC0)
- IARGCD(3) = IRC
- CALL CDPRNT (LPRTCD, '('' CDFZUP : rename keys in '//
- + PATHN(1:60)//' time '',2I8,'' return code '',I6)', IARGCD,
- + 3)
- ENDIF
-#endif
- IF (IRC.EQ.192) IRC = 0
-*
- ELSE IF (IACT.EQ.6) THEN
-*
-* ** Enter the name or help information
-*
- IFLG = IHEDCF(MFLGCF)
- CALL UCOPY (IHEDCF(MFLGCF+1), KEYVCK, NWKEY)
- CALL CDSNAM (IFLG, KEYVCK, 0, LUNFZ, IRC)
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) THEN
- IARGCD(1) = IHEDCF(MFLGCF+IDHKSN)
- CALL CDUPTM (IARGCD(2), IARGCD(3), IHEDCF(MFLGCF+IDHINS),
- + IRC0)
- IARGCD(4) = IRC
- IF (IFLG.EQ.1) THEN
- CALL CDPRNT (LPRTCD, '('' CDFZUP : enter help '
- + //'information for path code '',I6,'' time '',2I8,'
- + //''' return code '',I6)', IARGCD, 4)
- ELSE
- CALL CDPRNT (LPRTCD, '('' CDFZUP : enter name '
- + //'information for path code '',I6,'' time '',2I8,'
- + //''' return code '',I6)', IARGCD, 4)
- ENDIF
- ENDIF
-#endif
-*
- ELSE IF (IACT.EQ.7) THEN
-*
-* ** Rename alias name of a given directory
-*
- IFLG = IHEDCF(MFLGCF)
- NWDF = IHEDCF(MWDPCF)
- ALIAS = ' '
- CALL UHTOC (IHEDCF(MWDPCF+NWDP+1), 4, ALIAS, 8)
- CALL UHTOC (IHEDCF(MWDPCF+NWDP+3), 4, CHOPF, 4*NWDF)
- CHOPF = CHOPF(1:4*NWDF)
- CALL CDEALI (CHOPF, ALIAS, IFLG, IRC)
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) THEN
- CALL CDPRNT (LPRTCD, '('' CDFZUP : enter alias name for '
- + //'path '//CHOPF(1:60)//' return code '',I6)', IRC, 1)
- ENDIF
-#endif
- IRC = 0
-*
- ELSE IF (IACT.EQ.8) THEN
-*
-* ** Delete a few partitions in a partitioned directory
-*
- IKEEP = IHEDCF(MKEPCF)
- CALL CDPURP (PATHN, IKEEP, CHOPF, IRC)
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) THEN
- IARGCD(1) = IKEEP
- IARGCD(2) = IRC
- CALL CDPRNT (LPRTCD, '('' CDFZUP : delete all but '',I6,'' '
- + // 'partitions in '//PATHN(1:60)//' return code '',I6)',
- + IARGCD, 2)
- ENDIF
-#endif
- IRC = 0
-*
- ELSE IF (IACT.EQ.9) THEN
-*
-* ** Use the forbidden path for updating data base (replace object)
-*
- CALL FZIN (LUNFZ, IDISCD, LFIXCD, 2, 'A', 0, 0)
- IF (IQUEST(1).GT.0) GO TO 997
- IF (IQUEST(1).NE.0) THEN
- IQUEST(11) = IQUEST(1)
- IRC = 72
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDFZUP : FZ '
- + //'error type '',I12)', IQUEST(11), 1)
-#endif
- GO TO 991
- ENDIF
- CALL UCOPY (IHEDCF(MPRECF+1), KEYN, NWKEY)
- CALL CDDONT (PATHN, IDISCD, LFIXCD, KEYN, CHOPF, IRC)
- CALL MZDROP (IDISCD, LFIXCD, 'L')
- LFIXCD = 0
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) THEN
- IARGCD(1) = IRC
- CALL CDPRNT (LPRTCD, '('' CDFZUP : updated data base in '//
- + 'replace mode for '//PATHN(1:60)//' return code '',I6)',
- + IARGCD, 1)
- ENDIF
-#endif
-*
- ELSE IF (IACT.EQ.10) THEN
-*
-* ** Recreate the dictionary record
-*
- CALL CDRDIC (TOPNCD, IRC)
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) THEN
- IARGCD(1) = IRC
- CALL CDPRNT (LPRTCD, '('' CDFZUP : recreates dictionary d'//
- + 'irectory for '//TOPNCD//' return code '',I6)', IARGCD, 1)
- ENDIF
-#endif
-*
- ENDIF
- 991 IF (IRC.GT.0) THEN
- IF (LUNFZ.EQ.LUFMCD.OR.IOPTF.EQ.0.OR.ISNGR.NE.0) GO TO 998
- IRC = 0
- GO TO 10
- ENDIF
- IF (LUNFZ.NE.LUFMCD.AND.ISNGR.EQ.0) GO TO 10
-*
- 997 IRC = 0
- 998 CONTINUE
-#if !defined(CERNLIB_IBM)||!defined(CERNLIB__P3CHILD)
-*
- 2001 FORMAT (20(I2,A1,1X))
-#endif
-* END CDFZUP
- END
-#endif
diff --git a/src/packlib/hepdb/cdfzup/cdfzwr.F b/src/packlib/hepdb/cdfzup/cdfzwr.F
deleted file mode 100644
index aef9bc3..0000000
--- a/src/packlib/hepdb/cdfzup/cdfzwr.F
+++ /dev/null
@@ -1,136 +0,0 @@
-*
-* $Id: cdfzwr.F,v 1.1.1.1 1996/02/28 16:24:11 mclareni Exp $
-*
-* $Log: cdfzwr.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:11 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
-#if defined(CERNLIB__P3CHILD)
-* Ignoring t=dummy
-#endif
- SUBROUTINE CDFZWR (IPREC, CHOPT, IRC)
-* =====================================
-*
-************************************************************************
-* *
-* SUBR. CDFZWR (IPREC, CHOPT, IRC*) *
-* *
-* Copies the current data structure in memory into the journal file *
-* *
-* Arguments : *
-* *
-* IPREC Precision word used in the packing algorithm *
-* CHOPT Character string to be written in the journal file *
-* IRC Return code (see below) *
-* *
-* Called by CDRTFZ *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* = 76 : Cannot form the IO descriptor for the FZ header *
-* = 77 : FZOUT fails to write on to the sequential file *
-* *
-************************************************************************
-*
-#include "hepdb/caopts.inc"
-#include "hepdb/cdcblk.inc"
-#include "hepdb/cfzlun.inc"
-#include "hepdb/ckkeys.inc"
-#include "hepdb/csavbk.inc"
-#include "hepdb/czpack.inc"
- PARAMETER (NLEVM=20)
- INTEGER NLCUR(NLEVM)
- CHARACTER CHCUR(NLEVM)*1, CHFRM*100, CFORM(6)*1, CHOP0*4
- CHARACTER CHOPT*(*)
- DATA CFORM /'B', 'I', 'F', 'D', 'H', 'A'/
-*
-* ------------------------------------------------------------------
-*
-* *** Write the sequential output if needed
-*
- IF (IOPFCA.EQ.0) THEN
- CHOP0 = CHOPT
- ELSE
- CHOP0 = 'F'//CHOPT
- ENDIF
-*
-* ** Find the IO descriptor of the header
-*
- NLEV = 1
- NCUR = 5
- IFORO = 2
- CHCUR(NLEV) = CFORM(IFORO)
- IF (INDEX(CHOP0,'Z').NE.0) THEN
- NLCUR(NLEV) = 4
- IFORO = 3
- NCUR = 1
- NLEV = NLEV + 1
- CHCUR(NLEV) = CFORM(IFORO)
- CALL UCOPY (PRECCZ, IHEDCF(MPRECF), 1)
- ELSE
- IHEDCF(MPRECF) = IPREC
- ENDIF
- DO 10 I = 1, NWKYCK
- IFORM = IOTYCK(I)
- IF (IFORM.EQ.6) IFORM = 5
- IF (IFORM.EQ.IFORO) THEN
- NCUR = NCUR + 1
- ELSE
- NLCUR(NLEV) = NCUR
- IF (NLEV.GE.NLEVM) THEN
- IRC = 76
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDFZWR : Can'//
- + 'not get IO descriptor '')', IARGCD, 0)
-#endif
- GO TO 999
- ENDIF
- NLEV = NLEV + 1
- CHCUR(NLEV) = CFORM(IFORM)
- NCUR = 1
- IFORO = IFORM
- ENDIF
- 10 CONTINUE
- NLCUR(NLEV) = NCUR
-#if !defined(CERNLIB_IBM)||!defined(CERNLIB__P3CHILD)
- WRITE (CHFRM, 2001) (NLCUR(I), CHCUR(I), I = 1, NLEV)
-#endif
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB__P3CHILD))
- CHFRM = ' '
- II = 1
- DO 15 I = 1, NLEV
- CALL UTWRIT (CHFRM(II:II+1), '(I2)', NLCUR(I))
- II = II + 2
- CHFRM(II:II) = CHCUR(I)
- II = II + 2
- 15 CONTINUE
-#endif
- II = 4 *NLEV
- CHFRM = CHFRM(1:II)//' -H'
- CALL MZIOCH (IOFMCF, NWFMCF, CHFRM(1:II+3))
-*
-* ** Write on the FZ file
-*
- CALL UCTOH (CHOP0, IHEDCF(MPRECF+NWKYCK+1), 4, 4)
- CALL UCOPY (KEYSCS(1,1), IHEDCF(MPRECF+1), NWKYCK)
- CALL FZOUT (LUFZCF, IDISCD, LOBJCS(1), 1, 'L', IOFMCF,
- + NWHDCF, IHEDCF)
- IF (IQUEST(1).NE.0) THEN
- IRC = 77
- IQUEST(11) = 1
- IQUEST(12) = 1
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDFZWR : Error '//
- + 'in FZOUT while writing Data'')', IARGCD, 0)
-#endif
- GO TO 999
- ENDIF
-#if !defined(CERNLIB_IBM)||!defined(CERNLIB__P3CHILD)
-*
- 2001 FORMAT (20(I2,A1,1X))
-#endif
-* END CDFZWR
- 999 END
diff --git a/src/packlib/hepdb/cdfzup/cdildf.F b/src/packlib/hepdb/cdfzup/cdildf.F
deleted file mode 100644
index 3fa1352..0000000
--- a/src/packlib/hepdb/cdfzup/cdildf.F
+++ /dev/null
@@ -1,134 +0,0 @@
-*
-* $Id: cdildf.F,v 1.1.1.1 1996/02/28 16:24:11 mclareni Exp $
-*
-* $Log: cdildf.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:11 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
-#if !defined(CERNLIB__P3CHILD)
- SUBROUTINE CDILDF (LUNI, CHOPT, IRC)
-* ====================================
-*
-************************************************************************
-* *
-* SUBR. CDILDF (LUNI, CHOPT, IRC*) *
-* *
-* Initializes the List of Directories to be always updated from the *
-* journal file (ignore the check of the key 1). *
-* *
-* Arguments : *
-* *
-* LUNI Logical unit number from which the list is read off *
-* CHOPT Character string with any of the following characters *
-* A Add to the previous information *
-* I Ignore all previous information (also current file) *
-* Default Overwrite previous information with the current list *
-* IRC Return code (see below) *
-* *
-* Called by user *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* =136 : Illegal logical unit number *
-* *
-************************************************************************
-*
-#include "hepdb/caopts.inc"
-#include "hepdb/cdcblk.inc"
-#include "hepdb/ctpath.inc"
- PARAMETER (NWDS=50)
- CHARACTER CHOPT*(*)
-*
-* ------------------------------------------------------------------
-*
-* *** Decode the character option
-*
- CALL CDOPTS (CHOPT, IRC)
- IF (IRC.NE.0) GO TO 999
-*
-* *** Find the address of the bank containing the list of directory
-*
- LREFCD(1) = LBAFCD
- IF (LREFCD(1).EQ.0) THEN
- JBIAS = 1
- ND = NWDS * (MXLWCD + 1)
- CALL CDBANK (IDIVCD, LBAFCD, LBAFCD, JBIAS, 'FDDB', 0, 0, ND,
- + IOFDCD, -1, IRC)
- IF (IRC.NE.0) GO TO 999
- IQ(KOFUCD+LBAFCD-5) = 0
- LREFCD(1) = LBAFCD
- ENDIF
-*
-* *** Reset the counter if not needed
-*
- IF (IOPICA.NE.0.OR.IOPACA.EQ.0) THEN
- IQ(KOFUCD+LREFCD(1)-5) = 0
- IF (IOPICA.NE.0) GO TO 999
- ENDIF
-*
-* *** Check input file number
-*
- IF (LUNI.LE.0) THEN
- IRC = 136
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDILDF : Illegal'//
- + ' logical unit number'',I12)', LUNI, 1)
-#endif
- GO TO 999
- ENDIF
-*
-* *** Now read in the file
-*
- NWMX = IQ(KOFUCD+LREFCD(1)-1) / (MXLWCD + 1)
- NCNT = 0
- 10 READ (LUNI, 1000, ERR=20, END=20) PAT2CT
- CALL CDSBLC (PAT2CT, PAT3CT, NCHR)
- IF (NCHR.LE.0) GO TO 10
- CALL CLTOU (PAT3CT)
- NCUR = IQ(KOFUCD+LREFCD(1)-5) + 1
- NCNT = NCNT + 1
- IF (NCUR.GT.NWMX) THEN
- CALL ZSHUNT (IDIVCD, LREFCD(1), LREFCD(3), 2, 0)
- ND = IQ(KOFUCD+LREFCD(3)-1) + NWDS * (MXLWCD + 1)
- JBIAS = 1
- CALL CDBANK (IDIVCD, LBAFCD, LBAFCD, JBIAS, 'FDDB', 0, 0, ND,
- + IOFDCD, -1, IRC)
- IF (IRC.NE.0) THEN
- CALL MZDROP (IDIVCD, LREFCD(3), ' ')
- GO TO 999
- ENDIF
- CALL UCOPY (IQ(KOFUCD+LREFCD(3)+1), IQ(KOFUCD+LBAFCD+1),
- + IQ(KOFUCD+LREFCD(3)-1))
- LREFCD(1) = LBAFCD
- CALL MZDROP (IDIVCD, LREFCD(3), ' ')
- IQUEST(1) = 0
- NWMX = NWMX + NWDS
- ENDIF
- IQ(KOFUCD+LREFCD(1)-5) = NCUR
- IPNT = KOFUCD + LREFCD(1) + (NCUR - 1) * (MXLWCD + 1) + 1
- IQ(IPNT) = NCHR
- CALL UCTOH (PAT3CT, IQ(IPNT+1), 4, 80)
- GO TO 10
-*
- 20 IQUEST(11)= NCNT
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.3) THEN
- NCUR = IQ(KOFUCD+LREFCD(1)-5)
- CALL CDPRNT (LPRTCD, '(/,'' CDILDF : '',I8,'' directory names'//
- + ' stored for forced updating'')', NCUR, 1)
- DO 30 I = 1, NCUR
- IPNT = KOFUCD + LREFCD(1) + (I - 1) * (MXLWCD + 1) + 1
- CALL UHTOC (IQ(IPNT+1), 4, PAT2CT, 80)
- CALL CDPRNT (LPRTCD, '(10X,''Directory '',I5,'' '//PAT2CT//
- + ''')', I, 1)
- 30 CONTINUE
- ENDIF
-#endif
-*
- 1000 FORMAT (A80)
-* END CDILDF
- 999 END
-#endif
diff --git a/src/packlib/hepdb/cdfzup/cdildu.F b/src/packlib/hepdb/cdfzup/cdildu.F
deleted file mode 100644
index f9f1511..0000000
--- a/src/packlib/hepdb/cdfzup/cdildu.F
+++ /dev/null
@@ -1,173 +0,0 @@
-*
-* $Id: cdildu.F,v 1.1.1.1 1996/02/28 16:24:12 mclareni Exp $
-*
-* $Log: cdildu.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:12 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
-#if !defined(CERNLIB__P3CHILD)
- SUBROUTINE CDILDU (LUNI, TOPNM, CHOPT, IRC)
-* ===========================================
-*
-************************************************************************
-* *
-* SUBR. CDILDU (LUNI, TOPNM, CHOPT, IRC*) *
-* *
-* Initializes the List of Directories to be Updated from the *
-* journal file. *
-* *
-* Arguments : *
-* *
-* LUNI Logical unit number from which the list is read off *
-* TOPNM Name of the Top Directory *
-* CHOPT Character string with any of the following characters *
-* A Add to the previous information *
-* I Ignore all previous information (also current file) *
-* Default Overwrite previous information with the current list *
-* IRC Return code (see below) *
-* *
-* Called by user *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* =135 : Illegal top directory name *
-* =136 : Illegal logical unit number *
-* *
-************************************************************************
-*
-#include "hepdb/caopts.inc"
-#include "hepdb/cdcblk.inc"
-#include "hepdb/ctpath.inc"
- PARAMETER (NWDS=50)
- CHARACTER CHOPT*(*), TOPNM*(*)
-*
-* ------------------------------------------------------------------
-*
-* *** Decode the character option and analyse the top directory name
-*
- CALL CDOPTS (CHOPT, IRC)
- IF (IRC.NE.0) GO TO 999
- CALL CDSBLC (TOPNM, TOP1CT, NCHT)
- IF (NCHT.LE.0) THEN
- IRC = 135
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDILDU : Illegal'//
- + ' top directory name'')', IARGCD, 0)
-#endif
- GO TO 999
- ENDIF
-*
-* *** Find the address of the bank containing the list of directory
-* ** for the given topdirectory
-*
- LREFCD(1) = 0
- LREFCD(2) = 0
- LTOP = LTOPCD
- 10 IF (LTOP.GT.0) THEN
- NCHR = IQ(KOFUCD+LTOP+MUPNCH)
- CALL UHTOC (IQ(KOFUCD+LTOP+MUPNAM), 4, TOP2CT, NCHR)
- IF (TOP2CT(1:NCHR).NE.TOP1CT(1:NCHT)) THEN
- LTOP = LQ(KOFUCD+LTOP)
- GO TO 10
- ELSE
- LREFCD(1) = LQ(KOFUCD+LTOP-KLFZCD)
- LREFCD(2) = LTOP
- ENDIF
- ENDIF
-*
- IF (LREFCD(1).EQ.0) THEN
- LREFCD(1) = LBADCD
- 20 IF (LREFCD(1).GT.0) THEN
- CALL UHTOC (IQ(KOFUCD+LREFCD(1)+MFZTOP), 4, TOP2CT, 16)
- IF (TOP1CT.NE.TOP2CT) THEN
- LREFCD(1) = LQ(KOFUCD+LREFCD(1))
- GO TO 20
- ENDIF
- ELSE
- JBIAS = 1
- ND = NWDS * (MXLWCD + 1) + MFZDIR - 1
- CALL CDBANK (IDIVCD, LBADCD, LBADCD, JBIAS, 'FZDB', 0, 0, ND,
- + IOFZCD, -1, IRC)
- IF (IRC.NE.0) GO TO 999
- IQ(KOFUCD+LBADCD-5) = 0
- LREFCD(1) = LBADCD
- IF (LREFCD(2).GT.0) LQ(KOFUCD+LREFCD(2)-KLFZCD) = LBADCD
- CALL UCTOH (TOP1CT, IQ(KOFUCD+LBADCD+MFZTOP), 4, 16)
- ENDIF
- ENDIF
-*
-* *** Reset the counter if not needed
-*
- IF (IOPICA.NE.0.OR.IOPACA.EQ.0) THEN
- IQ(KOFUCD+LREFCD(1)-5) = 0
- IF (IOPICA.NE.0) GO TO 999
- ENDIF
-*
-* *** Check input file number
-*
- IF (LUNI.LE.0) THEN
- IRC = 136
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDILDU : Illegal'//
- + ' logical unit number'',I12)', LUNI, 1)
-#endif
- GO TO 999
- ENDIF
-*
-* *** Now read in the file
-*
- NWMX = (IQ(KOFUCD+LREFCD(1)-1) - MFZDIR + 1) / (MXLWCD + 1)
- NCNT = 0
- 25 READ (LUNI, 1000, ERR=30, END=30) PAT2CT
- CALL CDSBLC (PAT2CT, PAT3CT, NCHR)
- IF (NCHR.LE.0) GO TO 25
- CALL CLTOU (PAT3CT)
- NCUR = IQ(KOFUCD+LREFCD(1)-5) + 1
- NCNT = NCNT + 1
- IF (NCUR.GT.NWMX) THEN
- CALL ZSHUNT (IDIVCD, LREFCD(1), LREFCD(3), 2, 0)
- ND = IQ(KOFUCD+LREFCD(3)-1) + NWDS * (MXLWCD + 1)
- JBIAS = 1
- CALL CDBANK (IDIVCD, LBADCD, LBADCD, JBIAS, 'FZDB', 0, 0, ND,
- + IOFZCD, -1, IRC)
- IF (IRC.NE.0) THEN
- CALL MZDROP (IDIVCD, LREFCD(3), ' ')
- IF (LREFCD(2).GT.0) LQ(KOFUCD+LREFCD(2)-KLFZCD) = 0
- GO TO 999
- ENDIF
- CALL UCOPY (IQ(KOFUCD+LREFCD(3)+1), IQ(KOFUCD+LBADCD+1),
- + IQ(KOFUCD+LREFCD(3)-1))
- LREFCD(1) = LBADCD
- IF (LREFCD(2).GT.0) LQ(KOFUCD+LREFCD(2)-KLFZCD) = LBADCD
- CALL MZDROP (IDIVCD, LREFCD(3), ' ')
- NWMX = NWMX + NWDS
- ENDIF
- IQ(KOFUCD+LREFCD(1)-5) = NCUR
- IPNT = KOFUCD + LREFCD(1) + MFZDIR + (NCUR - 1) * (MXLWCD + 1)
- IQ(IPNT) = NCHR
- CALL UCTOH (PAT3CT, IQ(IPNT+1), 4, 80)
- GO TO 25
-*
- 30 IQUEST(11)= NCNT
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.3) THEN
- NCUR = IQ(KOFUCD+LREFCD(1)-5)
- CALL UHTOC (IQ(KOFUCD+LREFCD(1)+MFZTOP), 4, TOP2CT, 16)
- CALL CDPRNT (LPRTCD, '(/,'' CDILDU : '',I8,'' directory names'//
- + ' stored for top directory '//TOP2CT//''')', NCUR, 1)
- DO 40 I = 1, NCUR
- IPNT = KOFUCD + LREFCD(1) + MFZDIR + (I - 1) * (MXLWCD + 1)
- CALL UHTOC (IQ(IPNT+1), 4, PAT2CT, 80)
- CALL CDPRNT (LPRTCD, '(10X,''Directory '',I5,'' '//PAT2CT//
- + ''')', I, 1)
- 40 CONTINUE
- ENDIF
-#endif
-*
- 1000 FORMAT (A80)
-* END CDILDU
- 999 END
-#endif
diff --git a/src/packlib/hepdb/cdfzup/cdrtfz.F b/src/packlib/hepdb/cdfzup/cdrtfz.F
deleted file mode 100644
index 2cbf558..0000000
--- a/src/packlib/hepdb/cdfzup/cdrtfz.F
+++ /dev/null
@@ -1,323 +0,0 @@
-*
-* $Id: cdrtfz.F,v 1.1.1.1 1996/02/28 16:24:12 mclareni Exp $
-*
-* $Log: cdrtfz.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:12 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDRTFZ (PATHI, LUNFZ, K1MIN, K1MAX, CHOPT, IRC)
-* ==========================================================
-*
-************************************************************************
-* *
-* SUBR. CDRTFZ (PATHI, LUNFZ, K1MIN, K1MAX, CHOPT, IRC*) *
-* *
-* Copies a part of the directory (in the range K1MIN-K1MAX or with *
-* insertion time > K1MIN for specified CHOPT) into a sequential file *
-* in the format of the journal file *
-* *
-* Arguments : *
-* *
-* PATHI Character string describing the input pathname *
-* LUNFZ Logical unit number of the output FZ file *
-* K1MIN Minumum serial number (Key 1 value) to be copied, or *
-* Minimum date (YYMMDD) for insertion time to be copied *
-* (Depends on CHOPT supplied) *
-* K1MAX Maximum serial number (Key 1 value) to be copied, or *
-* Minimum time (HHMM) for insertion time to be copied *
-* (Depends on CHOPT supplied) *
-* CHOPT Character string with any of the following characters *
-* F Updates with a fully matched data object (in user keys) *
-* I Copies objects with insertion time > (K1MIN/K1MAX) *
-* R Copied objects with RZ insertion time > (K1MIN/K1MAX) *
-* IRC Return code (see below) *
-* *
-* Called by user, CDEXTR *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* = 71 : Illegal path name *
-* *
-* If IRC = 0, IQUEST(2) carries information on number of data *
-* objects transfered to the FZ file *
-* *
-************************************************************************
-*
-#include "hepdb/caopts.inc"
-#include "hepdb/cdcblk.inc"
-#include "hepdb/cfzlun.inc"
-#include "hepdb/ckkeys.inc"
-#include "hepdb/clinks.inc"
-#include "hepdb/csavbk.inc"
-#include "hepdb/ctpath.inc"
-#include "hepdb/czpack.inc"
- PARAMETER (JBIAS=2)
- CHARACTER PATHI*(*), CHOPT*(*), PATHN*80, CHOPS*4
- DIMENSION ITIME(MXPACD)
-#include "zebra/q_jbit.inc"
-* Ignoring t=pass
-*
-* ------------------------------------------------------------------
-*
-* *** Suppress blanks from the path name
-*
- ICOPY = 0
- CALL CDOPTS (' ', IRC)
- IF (IRC.NE.0) GO TO 999
- CALL UOPTC (CHOPT, 'F', IOPFCA)
- CALL UOPTC (CHOPT, 'I', IOPI)
- CALL UOPTC (CHOPT, 'R', IOPR)
- LUFZCF = LUNFZ
- IF (LUFZCF.LE.0) GO TO 999
- IF (IOPI.NE.0) THEN
- CALL CDPKTM (K1MIN, K1MAX, KY7MI, IRC)
- KYMIN = 1
- ELSE IF (IOPR.NE.0) THEN
- CALL RZDATE (ICOPY, K1MIN, K1MAX, 3)
- KY7MI = JBYT (ICOPY, 9, 24)
- KYMIN = 1
- ELSE
- KY7MI = 0
- IF (K1MIN.LT.1) THEN
- KYMIN = 1
- ELSE
- KYMIN = K1MIN
- ENDIF
- IF (K1MAX.LT.KYMIN) THEN
- KYMAX = KYMIN + 100000
- ELSE
- KYMAX = K1MAX
- ENDIF
- ENDIF
-*
-* *** Load top directory information; gets in PAT1CT complete path name
-*
- ICOPY = 0
- CALL CDLDUP (PATHI, 1, IRC)
- IF (IRC.NE.0) GO TO 999
- IF (NKEYCK.LE.0) GO TO 999
- PATHN = PAT1CT
- NCHRI = LENOCC (PATHN)
- KST = NWKYCK + 1
- CALL CDKEYT
- IOPTP = JBIT (IQ(KOFSCD+LCDRCD+IKDRCD+IDHFLG), JPRTCD)
-*
-* *** Load IPREC/DELTA from dictionary; choose the transcript file
-*
- CALL CDLDIC (PATHN, 1, IRC)
- IF (IRC.NE.0) GO TO 999
-*
-* *** Partially fill up the header
-*
- NDOP = 1
- NWDP = (NCHRI + 3) / 4
- NWHDCF = NWDP + NDOP + NWKYCK + 5
- IHEDCF(MACTCF) = 1
- IHEDCF(MNKYCF) = NWKYCK
- IHEDCF(MOPTCF) = NDOP
- IHEDCF(MPATCF) = NWDP
- CALL UCTOH (PATHN, IHEDCF(MPRECF+NWKYCK+NDOP+1), 4, 4*NWDP)
-*
-* *** Start reading in records from the input file
-*
- NOBJCS = 0
- DO 10 I = 1, NPARCD
- ITIME(I) = 1
- 10 CONTINUE
- IF (IOPTP.EQ.0) THEN
- DO 20 IK = 1, NKEYCK
- IF (KY7MI.EQ.0) THEN
- KEY1 = IQ(KOFSCD+LCDRCD+IKDRCD+(IK-1)*KST+IDHKSN)
- IF (KEY1.LT.KYMIN.OR.KEY1.GT.KYMAX) GO TO 20
- ELSE
- IF (IOPI.NE.0) THEN
- KEY7 = IQ(KOFSCD+LCDRCD+IKDRCD+(IK-1)*KST+IDHINS)
- ELSE
- LCYC = IQ(KOFSCD+LCDRCD+IKDRCD+(IK-1)*KST)
- KEY7 = JBYT (IQ(KOFSCD+LCDRCD+LCYC+1), 9, 24)
- ENDIF
- IF (KEY7.LE.KY7MI) GO TO 20
- ENDIF
- IOPKCA = 0
- PACKCZ = .FALSE.
- NOBJCS = 1
- KEYSCS(IDHKSN,NOBJCS) = IK
- IOKYCA(IDHKSN) = 1
- CALL CDKXIN (ITIME, IDISCD, LOBJCS(NOBJCS), LOBJCS(NOBJCS),
- + JBIAS, NWKEY, KEYSCS(1,NOBJCS), IPREC, IRC)
- IOKYCA(IDHKSN) = 0
- IF (IRC.NE.0) GO TO 997
- IF (JBIT(KEYSCS(IDHFLG,NOBJCS),JRZUCD).NE.0) THEN
- IF (JBIT(KEYSCS(IDHFLG,NOBJCS),JASFCD).NE.0) THEN
- CHOPS = 'HTY'
- ELSE
- CHOPS = 'HY'
- ENDIF
- ELSE
- CALL CDRZIN (IDISCD, LSTRCL(2), 2, IK, ICYCL, PATHN, IRC)
- IF (IRC.NE.0) THEN
- CALL MZDROP (IDISCD, LSTRCL(2), 'L')
- GO TO 997
- ENDIF
- CALL UCOPY (Q(KOFUCD+LSTRCL(2)+3), IXX, 1)
- IF (IQ(KOFUCD+LSTRCL(2)+1).EQ.0) THEN
- IF (KEYSCS(IDHPTR,NOBJCS).EQ.0) THEN
- CHOPS = 'H'
- ELSE
- CHOPS = 'HD'
- ENDIF
- ELSE
- PACKCZ = (JBIT(IXX,32).EQ.0)
- IF (PACKCZ) THEN
- IDTY = ICDTYP (LSTRCL(2))
- IF (IDTY.EQ.3) THEN
- PRECCZ = Q(KOFUCD+LSTRCL(2)+2)
- ELSE
- PRECCZ = IQ(KOFUCD+LSTRCL(2)+2)
- ENDIF
- IF (KEYSCS(IDHPTR,NOBJCS).EQ.0) THEN
- CHOPS = 'HZ'
- ELSE
- CHOPS = 'HZD'
- ENDIF
- ELSE
- IF (KEYSCS(IDHPTR,NOBJCS).EQ.0) THEN
- CHOPS = 'HP'
- ELSE
- CHOPS = 'HPD'
- ENDIF
- ENDIF
- ENDIF
- CALL MZDROP (IDISCD, LSTRCL(2), 'L')
- ENDIF
- CALL CDFZWR (IPREC, CHOPS, IRC)
- CALL MZDROP (IDISCD, LOBJCS(NOBJCS), 'L')
- NOBJCS = 0
- IF (IRC.NE.0) GO TO 997
- ICOPY = ICOPY + 1
- 20 CONTINUE
-*
- ELSE
-*
-* ** Partitioned directory
-*
- NKEYS = NKEYCK
- DO 30 IKK = 1, NKEYS
- KPNT = IUHUNT (IKK, IQ(KOFSCD+LCDRCD+IKDRCD+MPSRCD),
- + NKEYS*KST, KST)
- IF (KPNT.GT.0) THEN
- KPNT = KOFSCD + LCDRCD + IKDRCD + KPNT - MPSRCD
- ELSE
- KPNT = KOFSCD + LCDRCD + IKDRCD + (IKK - 1) * KST
- ENDIF
- IF (KY7MI.EQ.0) THEN
- KYMP = IQ(KPNT+MOBJCD)
- IF (KYMP.GT.KYMAX) GO TO 30
- ENDIF
- CALL CDPATH (TOP1CT, IKK)
- PAT2CT = PATHN(1:NCHRI)//'/'//TOP1CT
- CALL RZCDIR (PAT2CT, ' ')
- IF (IQUEST(1).NE.0) THEN
- IRC = 71
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDRTFZ : Ill'//
- + 'egal Path Name '//PAT2CT//''')', IARGCD, 0)
-#endif
- GO TO 999
- ENDIF
- NKEYCK = IQUEST(7)
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- DO 25 IK = 1, NKEYCK
- IF (KY7MI.EQ.0) THEN
- KEY1 = IQ(KOFSCD+LCDRCD+IKDRCD+(IK-1)*KST+IDHKSN)
- IF (KEY1.LT.KYMIN.OR.KEY1.GT.KYMAX) GO TO 25
- ELSE
- IF (IOPI.NE.0) THEN
- KEY7 = IQ(KOFSCD+LCDRCD+IKDRCD+(IK-1)*KST+IDHINS)
- ELSE
- LCYC = IQ(KOFSCD+LCDRCD+IKDRCD+(IK-1)*KST)
- KEY7 = JBYT (IQ(KOFSCD+LCDRCD+LCYC+1), 9, 24)
- ENDIF
- IF (KEY7.LE.KY7MI) GO TO 25
- ENDIF
- IOPKCA = 0
- PACKCZ = .FALSE.
- NOBJCS = 1
- KEYSCS(IDHKSN,NOBJCS) = IK
- IOKYCA(IDHKSN) = 1
- CALL CDKXIN (ITIME, IDISCD, LOBJCS(NOBJCS),LOBJCS(NOBJCS),
- + JBIAS, NWKEY, KEYSCS(1,NOBJCS), IPREC, IRC)
- IOKYCA(IDHKSN) = 0
- IF (IRC.NE.0) GO TO 997
- IF (JBIT(KEYSCS(IDHFLG,NOBJCS),JRZUCD).NE.0) THEN
- IF (JBIT(KEYSCS(IDHFLG,NOBJCS),JASFCD).NE.0) THEN
- CHOPS = 'HTY'
- ELSE
- CHOPS = 'HY'
- ENDIF
- ELSE
- CALL CDRZIN (IDISCD, LSTRCL(2), 2,IK, ICYCL, PAT2CT,IRC)
- IF (IRC.NE.0) THEN
- CALL MZDROP (IDISCD, LSTRCL(2), 'L')
- GO TO 997
- ENDIF
- CALL UCOPY (Q(KOFUCD+LSTRCL(2)+3), IXX, 1)
- IF (IQ(KOFUCD+LSTRCL(2)+1).EQ.0) THEN
- IF (KEYSCS(IDHPTR,NOBJCS).EQ.0) THEN
- CHOPS = 'H'
- ELSE
- CHOPS = 'HD'
- ENDIF
- ELSE
- PACKCZ = (JBIT(IXX,32).EQ.0)
- IF (PACKCZ) THEN
- IDTY = ICDTYP (LSTRCL(2))
- IF (IDTY.EQ.3) THEN
- PRECCZ = Q(KOFUCD+LSTRCL(2)+2)
- ELSE
- PRECCZ = IQ(KOFUCD+LSTRCL(2)+2)
- ENDIF
- IF (KEYSCS(IDHPTR,NOBJCS).EQ.0) THEN
- CHOPS = 'HZ'
- ELSE
- CHOPS = 'HZD'
- ENDIF
- ELSE
- IF (KEYSCS(IDHPTR,NOBJCS).EQ.0) THEN
- CHOPS = 'HP'
- ELSE
- CHOPS = 'HPD'
- ENDIF
- ENDIF
- ENDIF
- CALL MZDROP (IDISCD, LSTRCL(2), 'L')
- ENDIF
- CALL CDFZWR (IPREC, CHOPS, IRC)
- CALL MZDROP (IDISCD, LOBJCS(NOBJCS), 'L')
- NOBJCS = 0
- IF (IRC.NE.0) GO TO 997
- ICOPY = ICOPY + 1
- 25 CONTINUE
-*
- CALL RZCDIR (PATHN, ' ')
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- 30 CONTINUE
-*
- ENDIF
-*
-* *** Drop the stored banks
-*
- 997 IF (NOBJCS.GT.0) THEN
- DO 998 IOBJ = 1, NOBJCS
- CALL MZDROP (IDISCD, LOBJCS(IOBJ), 'L')
- 998 CONTINUE
- NOBJCS = 0
- ENDIF
- 999 IQUEST(2) = ICOPY
-* END CDRTFZ
- END
diff --git a/src/packlib/hepdb/cdinit/Imakefile b/src/packlib/hepdb/cdinit/Imakefile
deleted file mode 100644
index 84053af..0000000
--- a/src/packlib/hepdb/cdinit/Imakefile
+++ /dev/null
@@ -1,4 +0,0 @@
-SRCS_F= cdexpd.F cdfrst.F cdinit.F cdjour.F cdnew.F cdopen.F \ @@\
- cdpaw.F cdshar.F cdudiv.F cdupdt.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/hepdb/cdinit/cdexpd.F b/src/packlib/hepdb/cdinit/cdexpd.F
deleted file mode 100644
index 0d56798..0000000
--- a/src/packlib/hepdb/cdinit/cdexpd.F
+++ /dev/null
@@ -1,53 +0,0 @@
-*
-* $Id: cdexpd.F,v 1.1.1.1 1996/02/28 16:24:14 mclareni Exp $
-*
-* $Log: cdexpd.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:14 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDEXPD (MAXD, NDMX)
-* ==============================
-*
-************************************************************************
-* *
-* SUBR. CDEXPD (MAXD, MAXG) *
-* *
-* Expands the system division by lifting a large bank & dropping it *
-* *
-* Arguments : *
-* *
-* MAXD To be expanded by MAXD words (if < 0, Expand by upto *
-* 4/5th of the total store space) *
-* NDMX* Number of words by which system division was expanded *
-* 0 = no expansion *
-* *
-* Called by user *
-* *
-************************************************************************
-*
-#include "zebra/mzcb.inc"
-#include "zebra/mzcc.inc"
- COMMON /QUEST/ IQUEST(100)
- PARAMETER (NTRY=10)
-* ------------------------------------------------------------------
-*
- CALL MZSDIV (0, -1)
- IDIVS = IQTABV (KQT+9)
- LARGE = 4*NQDMAX(KQT+1)/5
- IF (MAXD.GT.0) LARGE = MIN (MAXD, LARGE)
- NDMX = 0
- DO I = 1, NTRY
- NDTRY = (I * LARGE) / NTRY
- CALL MZNEED (IDIVS, NDTRY, 'G')
- ND = NDTRY + IQUEST(11) - 20
- IF (ND.GT.NDTRY) ND = NDTRY
- IF (ND.GT.NDMX) NDMX = ND
- ENDDO
- IF (NDMX.GT.0) THEN
- CALL MZBOOK (IDIVS, L, 0, 2, 'DUMY', 0, 0, NDMX, 2, -1)
- CALL MZDROP (IDIVS, L, ' ')
- ENDIF
-* END CDEXPD
- END
diff --git a/src/packlib/hepdb/cdinit/cdfrst.F b/src/packlib/hepdb/cdinit/cdfrst.F
deleted file mode 100644
index a0ce02b..0000000
--- a/src/packlib/hepdb/cdinit/cdfrst.F
+++ /dev/null
@@ -1,180 +0,0 @@
-*
-* $Id: cdfrst.F,v 1.1.1.1 1996/02/28 16:24:14 mclareni Exp $
-*
-* $Log: cdfrst.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:14 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
-#if defined(CERNLIB__P3CHILD)
-* Ignoring t=dummy
-#endif
- SUBROUTINE CDFRST (IDIV)
-* ========================
-*
-************************************************************************
-* *
-* SUBR. CDFRST (IDIV) *
-* *
-* Initializes of the Data Base Package (for each file) *
-* *
-* Arguments : *
-* *
-* IDIV User Division *
-* *
-* Called by CDINIT *
-* *
-************************************************************************
-*
- PARAMETER (MNSYS = 10000)
-*
-* ZEBRA system common blocks
-*
-#include "zebra/zunit.inc"
-#include "zebra/mzcb.inc"
-#include "zebra/mzcc.inc"
- COMMON /ZEBQ/ IQFENC(4), LQZEB(100)
-*
-#include "hepdb/caopti.inc"
-#include "hepdb/caopts.inc"
-#include "hepdb/cdcblk.inc"
-#include "hepdb/cfzlun.inc"
-#include "hepdb/cinitl.inc"
-#include "hepdb/ckkeys.inc"
-#include "hepdb/clinks.inc"
-#include "hepdb/csavbk.inc"
-#include "hepdb/cuserf.inc"
-#if defined(CERNLIB__P3CHILD)
-#include "hepdb/p3dbl3.inc"
-#endif
- CHARACTER CHFOR*11, CHTAG(TENCK)*8, CHFRM*20
- CHARACTER CHNAM*62
- LOGICAL DONE
- SAVE DONE
-*
- DATA CHFOR /'IIIIIIIIIII'/, DONE /.FALSE./
-*
-* Reserved fields in lower case
-*
- DATA CHTAG /'SERIAL_#', 'POINTER ', 'FLAGS ',
- + 'INS_TIME', 'key 5 ', 'SOURCEID',
- + 'SW_REF_#', 'key 8 ', 'key 9 ',
- + 'key 10 '/
-
-* DATA CHTAG /'SERIAL_#', 'POINTER ', 'STR_VALI',
-* + 'END_VALI', 'PRG_VERS', 'FLAGS ',
-* + 'INS_TIME', 'KEY 8 ', 'KEY 9 '/
- DATA CHNAM
- +/'ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789abcdefghijklmnopqrstuvwxyz'/
-*
-* ------------------------------------------------------------------
-*
-* *** DB System initialization
-*
- IF (DONE) GO TO 999
- DONE = .TRUE.
- LPRTCD = IQPRNT
- IDIVCD = IDIV
- IDEBCD = 0
- LQST = LOCF(LQ(1)) - 1
- LQZB = LQST + 1 - LOCF(LQZEB(1))
- CALL MZSDIV (0, -1)
- KOFSCD = KQS - LQZB
- CALL MZSDIV (IDIVCD, -1)
- KOFUCD = KQS - LQZB
- MXSYS = 4*NQDMAX(KQT+1)/5
- CALL MZDIV (IDIVCD, IDISCD, 'DB-SYSTM', MNSYS, MXSYS, 'LCM')
- CALL MZLINK (IDIVCD, '/CLINKS/', LSTRCL(1), LSTRCL(1),
- + LREFCL(10))
- CALL MZLINK (IDIVCD, '/CDUSCM/', LTOPCD, LBDACD, LBUPCD)
- CALL MZLINK (IDISCD, '/CSAVBK/', LOBJCS(1), LOBJCS(1),
- + LOBJCS(NSVMCS))
- CALL MZLINK (0, '/CDCBLK/', LCDRCD, LCDRCD, LJNKCD)
-*
-* *** Initialize the IO descriptors
-*
- ICHR0 = ICHAR ('0')
- CHFRM = '4I '//CHAR(NWNOCD/10+ICHR0)//
- + CHAR(MOD(NWNOCD,10)+ICHR0)//'B -H'
- CALL MZFORM ('NOCD', CHFRM, IONOCD)
- CALL MZFORM ('UPCD', '10I 4H -I', IOUPCD)
- CALL MZFORM ('DICD', '1I / 5I 1F 22H', IODICD)
- CALL UCTOH ('KYCD', IHKYCD, 4, 4)
- CHFRM = CHAR(MFZDIR+ICHR0-1)//'H / 1I 20H'
- CALL MZFORM ('FZDB', CHFRM, IOFZCD)
- CALL MZFORM ('FDDB', '/ 1I 20H', IOFDCD)
-*
- INSRCD = 0
- LTOPCD = 0
- NTOPCD = 0
- CALL CDPKTS (991231, 235959, IBIGCD, IRC)
-*
- NUFZCF = 0
- KEY7CK = 0
- CHFTCK = CHFOR
- DO 10 I = 1, TENCK
- 10 CHTGCK(I) = CHTAG(I)
-*
-* *** Character string
-*
- DO 15 K = 1, 62
- 15 CALFCA(K) = CHNAM(K:K)
- CALL VZERO (IOPACA, MXKYCA+26)
- MPAKCA(1) = 8
- MPAKCA(2) = 4
-#if !defined(CERNLIB_MIP)
- CSTRCA( 32: 47) = ' !"#$%&''()*+,-./'
-#endif
-#if defined(CERNLIB_MIP)
- CSTRCA( 32: 47) = ' "#$%&''()*+,-./'
- CSTRCA( 33: 33) = '21'X
-#endif
- CSTRCA( 48: 57) = '0123456789'
- CSTRCA( 58: 64) = ':;<=>?@'
- CSTRCA( 65: 90) = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
-#if defined(CERNLIB_IBM)
- CSTRCA( 91: 96) = '[\]^_`'
-#endif
-#if defined(CERNLIB_BSLASH)||defined(CERNLIB_IBMRT)||defined(CERNLIB_MIP)
- CSTRCA( 91: 96) = '[\\]^_`'
-#endif
-#if (!defined(CERNLIB_BSLASH))&&(!defined(CERNLIB_IBM))&&(!defined(CERNLIB_IBMRT))&&(!defined(CERNLIB_MIP))
- CSTRCA( 91: 96) = '[ ]^_`'
- CSTRCA( 92: 92) = CHAR(92)
-#endif
- CSTRCA( 97:122) = 'abcdefghijklmnopqrstuvwxyz'
- CSTRCA(123:126) = '{|}~'
-#if !defined(CERNLIB_IBM)
- CSTRCA(127:127) = CHAR(186)
-#endif
-#if defined(CERNLIB_IBM)
- CSTRCA(127:127) = CHAR(106)
-#endif
-*
- TOPLCI = ' '
-#if defined(CERNLIB__P3CHILD)
-*
- NWDBP3 = 0
- LIDBP3 = 0
- LODBP3 = 0
- IXDBP3 = IDIVCD
- CALL MZLINK (IXDBP3, '/P3DBL3/', LNK1P3, LNK1P3, LNK9P3)
- IPASP3 = 0
- NDIRP3 = 0
- NBKDP3 = 0
- NBKYP3 = 0
- INDXP3 = 1
- CALL MZBOOK (IDISCD, LNK1P3, 0, 2, 'DBP3', 0, 0, 122, 2, 0)
- CALL MZBOOK (IXDBP3, LNK2P3, 0, 2, 'P3LK', 100, 0, 100, 2, 0)
-#endif
-*
-* *** User common block reset only if IFLGCU .ne. -1
-*
- IF (IFLGCU.NE.-1) THEN
- IDCMCU = 0
- IPRECU = 0
- DELTCU = 0.
- ENDIF
-* END CDFRST
- 999 END
diff --git a/src/packlib/hepdb/cdinit/cdinit.F b/src/packlib/hepdb/cdinit/cdinit.F
deleted file mode 100644
index 35827a7..0000000
--- a/src/packlib/hepdb/cdinit/cdinit.F
+++ /dev/null
@@ -1,554 +0,0 @@
-*
-* $Id: cdinit.F,v 1.1.1.1 1996/02/28 16:24:13 mclareni Exp $
-*
-* $Log: cdinit.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:13 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
-#if defined(CERNLIB__P3CHILD)
-* Ignoring t=dummy
-#endif
- SUBROUTINE CDINIT(IDIV,LURZ,LUFZ,TOPN,NPAIR,NREC,NTOP,CHOP,IRC)
-* ===============================================================
-*
-************************************************************************
-* *
-* SUBR. CDINIT (IDIV,LURZ,LUFZ,TOPN,NPAIR,NREC,NTOP,CHOP,IRC*) *
-* *
-* Initializes of the Data Base Package (for each file) *
-* *
-* Arguments : *
-* *
-* IDIV User Division *
-* LURZ RZ file unit *
-* LUFZ FZ file unit *
-* TOPN Name of the Top Directory *
-* NPAIR Number of key pairs used for setting validity range of *
-* objects (to be given while creating new database) *
-* NREC Number of records for primary allocation (for RZMAKE) *
-* If less than or equal to 0 use existing RZ file (RZFILE)*
-* NTOP Serial number of top directory (if 0, automatically *
-* given by the package) *
-* CHOP Character Option : Same as in RZFILE / RZMAKE *
-* A All validity range key pairs on equal footing *
-* (default is to assume hierarchy among the keys) *
-* Z Reinitialize the random access file (use RZMAKE) *
-* (also NREC > 0 is required) *
-* IRC Return code (see below) *
-* *
-* Called by CDNEW, CDOPEN *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* = -1 : Invalid top directory name *
-* = -2 : The file is already open with correct LURZ and *
-* TOPN *
-* = -3 : The file is already open with wrong LURZ or TOPN*
-#if (defined(CERNLIB_VAX))&&(defined(CERNLIB__ONLINE))&&(defined(CERNLIB__SERVER))&&(!defined(CERNLIB__P3CHILD))
-* = -5 : Invalid process name in Online context *
-* = -6 : Error in IC_BOOK for booking the CACHE *
-* = -7 : Error in CC_SETUP for reserving the CLUSCOM *
-#endif
-#if defined(CERNLIB__P3CHILD)
-* = -9 : Unable to open FZ communication channel *
-* = -10: Host unable to open RZ file *
-#endif
-* *
-************************************************************************
-*
-#include "zebra/zunit.inc"
-*
-#include "hepdb/caopti.inc"
-#include "hepdb/cdcblk.inc"
-#include "hepdb/cinitl.inc"
-#include "hepdb/ckkeys.inc"
-#include "hepdb/ctpath.inc"
-#if defined(CERNLIB__P3CHILD)
-#include "hepdb/p3dbl3.inc"
-#endif
-#if (defined(CERNLIB_VAX))&&(defined(CERNLIB__ONLINE))&&(defined(CERNLIB__SERVER))
-#include "hepdb/cbsrvr.inc"
-#include "hepdb/crccom.inc"
-* Cache stuff
- INTEGER ICACH(4)
- BYTE BCACH(16)
- EQUIVALENCE (BCACH, ICACH)
- CHARACTER DBCSN*2, DBCLN*4, DBCCM*9
-#endif
- PARAMETER (NOPRZ=8)
- CHARACTER CHOP*(*), TOPN*(*)
- CHARACTER CHOPT*8, COPRZ(NOPRZ)*1, CFOR*32
- INTEGER IOPRZ(NOPRZ), IACRZ(NOPRZ)
- SAVE INIT, COPRZ, IACRZ
-*
- DATA INIT /0/
-* Valid RZ options
- DATA COPRZ /'1', 'D', 'L', 'M', 'S', 'U', 'X', 'C'/
-* Valid RZ options for public mode
- DATA IACRZ / 0, 0, 1, 0, 0, 0, 1, 1/
-*
-* ------------------------------------------------------------------
-*
-C ACP_data_retrieval_start
-
- IQ10 = IQUEST(10)
- IQ11 = IQUEST(11)
- LURZCD = LURZ
- IOPTO = 0
-* CALL UOPTC (CHOP, 'Z', IOPTZ)
- IOPTZ = INDEX(CHOP,'Z')
- IF (NREC.GT.0.AND.IOPTZ.NE.0) THEN
- NRECS = NREC
- IOPTN = 1
- ELSE
- IOPTN = 0
- NRECS = 0
- ENDIF
- DO I = 1, NOPRZ
- IF (I.EQ.1) THEN
- CHOPT = COPRZ(I)
- ELSE
- CHOPT = CHOPT(1:I-1)//COPRZ(I)
- ENDIF
- ENDDO
- CALL UOPTC (CHOP, CHOPT(1:NOPRZ), IOPRZ)
- IF (IOPRZ(1).NE.0.OR.IOPRZ(6).NE.0) IOPTO = 1
-*
-* *** Remove imbedded blanks from the top directory name
-*
- CALL CDSBLC (TOPN, TOPNCD, NCHRCD)
- IF (NCHRCD.EQ.0) THEN
- IRC = -1
-#if defined(CERNLIB__DEBUG)
- TOPNCD = TOPN
- CALL CDPRNT (IQPRNT, '(/,'' CDINIT : Illegal Top Directory '//
- + 'Name '//TOPNCD//''')', IARGCD, 0)
-#endif
- GO TO 999
- ENDIF
-*
-* *** First pass initialization
-*
- IF (INIT.EQ.0) THEN
-
- CALL UOPTC (CHOP, 'E', IOPTE)
- CALL UOPTC (CHOP, 'Q', IOPTQ)
-*
-* ** DB System initialization
-*
- CALL CDFRST (IDIV)
-
- IF(IOPTQ.EQ.0) CALL CDVERS(' ',' ','P')
-*
-* ** Request expansion of system division
-*
- IF(IOPTE.NE.0) CALL CDEXPD(0,NDMX)
-
- INIT = 1
- ENDIF
-*
- IOPPCD = 0
- CALL UOPTC (CHOP, 'S', IOPSCD)
-#if (defined(CERNLIB_IBMVM)||defined(CERNLIB_UNIX)||defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))
-*
-* *** Check if it is Server environment
-*
- CALL UOPTC (CHOP, 'O', IOPO)
- CALL UOPTC (CHOP, 'P', IOPPCD)
- CALL UOPTC (CHOP, 'R', IOPR)
-#endif
-#if defined(CERNLIB__P3CHILD)
- IF (IOPTO.NE.0.OR.IOPTN.NE.0) IOPPCD = 1
-#endif
-#if (defined(CERNLIB_IBMVM)||defined(CERNLIB_UNIX)||defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))
- IF (INSRCD.EQ.0) THEN
-#endif
-#if (defined(CERNLIB_IBMVM)||defined(CERNLIB_UNIX)||defined(CERNLIB_VAX)||defined(CERNLIB__P3CHILD))&&(defined(CERNLIB__SERVER))&&(!defined(CERNLIB_ONLINE))
-*
-* *** Server environment, Public mode
-*
- IF (IOPPCD.NE.0.AND.IOPR.EQ.0) THEN
-#endif
-#if defined(CERNLIB__P3CHILD)
-*
-* ** Open the FZ Communication Channel
-*
- CALL APOPCH (LODBP3, 1, IRET)
- IF (IRET.NE.0) THEN
- IRC = -9
- IQUEST(11) = IRET
-#endif
-#if (defined(CERNLIB__P3CHILD))&&(defined(CERNLIB__DEBUG))
- CALL CDPRNT (LPRTCD, '(/,'' CDINIT : Cannot open FZ '//
- + 'channel'')', IRET, 0)
-#endif
-#if defined(CERNLIB__P3CHILD)
- ENDIF
- INSRCD = 1
- ENDIF
-#endif
-#if (defined(CERNLIB_IBMVM)||defined(CERNLIB_UNIX)||defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))&&(!defined(CERNLIB__P3CHILD))&&(!defined(CERNLIB__ONLINE))
-*
-* ** Open the journal file to DBSERVER
-*
- LUF = LUFZ
- LUFMCD = LUFZ
- CALL CDFZLO (LUF, IFND)
- IF (IFND.EQ.0) THEN
- CALL CDFOPN (LUF, IRC)
- IF (IRC.NE.0) THEN
- IF (IDEBCD.GE.0) CALL CDPRNT (LPRTCD, '(/,'' CDINIT : '//
- + 'Error in CDFOPN'')', IARGCD, 0)
- GO TO 999
- ENDIF
- CALL FZFILE (LUF, 0, 'AOQ')
- ENDIF
- INSRCD = 1
- ENDIF
-#endif
-#if (defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))&&(!defined(CERNLIB__P3CHILD))&&(defined(CERNLIB__ONLINE))
-*
-* *** Server environment, Owner mode
-*
- IF (IOPO.NE.0) THEN
-*
-* ** Open a flat memory for communication via FZ
-*
- CALL FZFILE (LUFMCD, 0, 'MNUIQ')
- CALL FZMEMO (LUFMCD, QVECCR, NMAXCR)
- INSRCD = 1
-*
-* *** Server environment, Public mode
-*
- ELSE IF (IOPPCD.NE.0) THEN
-*
-* ** Open a flat memory for communication via FZ
-*
- CALL FZFILE (LUFMCD, 0, 'MNUOQ')
- CALL FZMEMO (LUFMCD, QVECCR, NMAXCR)
-*
-* ** Book cache as a client
-*
- CALL CD_CHK_CLIENT (DBCSN, DBCLN, DBCCM, IERR)
- IF (IERR.NE.0) THEN
- IRC = -5
-#endif
-#if (defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))&&(defined(CERNLIB__DEBUG))&&(!defined(CERNLIB__P3CHILD))&&(defined(CERNLIB__ONLINE))
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDINIT : Ill'//
- + 'egal Cluscom name '//DBCCM//''')', IARGCD, 0)
-#endif
-#if (defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))&&(!defined(CERNLIB__P3CHILD))&&(defined(CERNLIB__ONLINE))
- GO TO 999
- ENDIF
-*
-* ** Directory name for MAPCOM files is defined through
-* ** db long name. Example 'MUCH$DBMCOM:
-*
- DIRECB = DBCLN//'$DBMCOM:'
-*
-* ** Cache name is the same for the server and its clients
-* ** Example H__DB_CACHE (always 11 characters)
-*
- CACHCB = DBCSN(1:1)//'__DB_CACHE'
- CALL IC_BOOK (CACHCB, ICACH, 'C', IERR)
- IF (IERR.NE.0) THEN
- IRC = -6
- IQUEST(11) = IERR
-#endif
-#if (defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))&&(defined(CERNLIB__DEBUG))&&(!defined(CERNLIB__P3CHILD))&&(defined(CERNLIB__ONLINE))
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDINIT : Err'//
- + 'or '',I10,'' in IC_BOOK'')', IQUEST(11), 1)
-#endif
-#if (defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))&&(!defined(CERNLIB__P3CHILD))&&(defined(CERNLIB__ONLINE))
- GO TO 999
- ENDIF
-*
-* ** Define the filename from client process name
-* ** Example: HCAL$DBMCOM:H__DBC_UR.DBMCOM
-*
- FILECB(1:12) = DIRECB
- FILECB(13:21) = DBCCM
- FILECB(22:) = '.DBMCOM'
-* For time being map the whole common to disk
- CALL CC_SETUP ('CRCCOM', FILECB, IFRSCR, ILSTCR, 'M', IERR)
- IF (IERR.NE.0) THEN
- IRC = -7
- IQUEST(11) = IERR
-#endif
-#if (defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))&&(defined(CERNLIB__DEBUG))&&(!defined(CERNLIB__P3CHILD))&&(defined(CERNLIB__ONLINE))
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDINIT : Err'//
- + 'or '',I10,'' in CC_SETUP'')', IQUEST(11), 1)
-#endif
-#if (defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))&&(!defined(CERNLIB__P3CHILD))&&(defined(CERNLIB__ONLINE))
- GO TO 999
- ENDIF
- INSRCD = 1
- ENDIF
-#endif
-#if (defined(CERNLIB_IBMVM)||defined(CERNLIB_UNIX)||defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))
- ENDIF
-#endif
-*
-* *** Construct the character option
-*
- CHOPT = ' '
- II = 0
- DO 30 I = 1, NOPRZ
- IF (IOPRZ(I).NE.0) THEN
-#if (defined(CERNLIB_IBMVM)||defined(CERNLIB_UNIX)||defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))
- IF (IOPPCD.NE.0) THEN
- IF (IACRZ(I).EQ.0) GO TO 30
- ENDIF
-#endif
- II = II + 1
- CHOPT(II:II) = COPRZ(I)
- ENDIF
- 30 CONTINUE
- IOUTCD = 0
- IF (IOPTO.NE.0.OR.IOPTN.NE.0) IOUTCD = 1
-#if (defined(CERNLIB_IBMVM)||defined(CERNLIB_UNIX)||defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))
- IF (IOPPCD.NE.0) IOPTN = 0
-#endif
- IOPTT = INDEX(CHOP,'T')
- IF (IOPTT.NE.0.OR.IOUTCD.NE.0.OR.IOPRZ(5).NE.0) THEN
- MXINCD = 0
- ELSE
- CALL DATIME (IDATE, ITIME)
- CALL CDPKTM (IDATE, ITIME, MXINCD, IRC)
- ENDIF
-*
-* ** Check whether the RZ file has already been initialized
-*
- IF (LTOPCD.NE.0) THEN
- LBUPCD = LTOPCD
- 40 LUN = IQ(KOFUCD+LBUPCD+MUPLUN)
- NCH = IQ(KOFUCD+LBUPCD+MUPNCH)
- CALL UHTOC (IQ(KOFUCD+LBUPCD+MUPNAM), 4, TOP1CT, NCH)
- IF (TOP1CT(1:NCH).EQ.TOPNCD.AND.LUN.EQ.LURZCD) THEN
- IRC = -2
- LBUPCD = 0
-#if defined(CERNLIB__DEBUG)
- CALL CDPRNT (LPRTCD, '(/,'' CDINIT : Top Directory '//TOPNCD//
- + ' is already open on unit '',I4)', LURZCD, 1)
-#endif
- GO TO 999
- ENDIF
- IF (TOP1CT(1:NCH).EQ.TOPNCD.OR.LUN.EQ.LURZCD) THEN
- IRC = -3
- LBUPCD = 0
-#if defined(CERNLIB__DEBUG)
- IARGCD(1) = LUN
- IARGCD(2) = LURZCD
- CALL CDPRNT (LPRTCD, '(/,'' CDINIT : Top Directory '//
- + TOP1CT(1:NCH)//' open on unit '',I4,'' is in conflict'//
- + ' with'',/,'' Requested Top Directory '//TOPNCD//' on '//
- + 'unit '',5X,I4)', IARGCD, 2)
-#endif
- GO TO 999
- ENDIF
-*
- LBFXCD = LBUPCD
- LBUPCD = LQ(KOFUCD+LBFXCD)
- IF (LBUPCD.NE.0) GO TO 40
-*
-* ** Create linear structure of the top-directories
-*
- CALL MZBOOK (IDIVCD, LBUPCD, LBFXCD, 0, 'UPCD', NLUPCD, NSUPCD,
- + NDUPCD, IOUPCD, -1)
- ELSE
- CALL MZBOOK (IDIVCD, LTOPCD, LTOPCD, 1, 'UPCD', NLUPCD, NSUPCD,
- + NDUPCD, IOUPCD, -1)
- LBUPCD = LTOPCD
- ENDIF
-*
-* ** Fill up the top directory bank with user data
-*
- NTOPCD = NTOPCD + 1
- LUFZCD = 0
- LUBKCD = 0
- IF (IOUTCD.EQ.0) IOPSCD = 0
- IQ(KOFUCD+LBUPCD+MUPLUN) = LURZCD
- IQ(KOFUCD+LBUPCD+MUPFLG) = IOUTCD
- IQ(KOFUCD+LBUPCD+MUPSRV) = IOPPCD
- IQ(KOFUCD+LBUPCD+MUPSHR) = IOPSCD
- IQ(KOFUCD+LBUPCD+MUPKIN) = MXINCD
- IQ(KOFUCD+LBUPCD+MUPJFL) = LUFZCD
- IQ(KOFUCD+LBUPCD+MUPBAK) = LUBKCD
- IQ(KOFUCD+LBUPCD+MUPNCH) = NCHRCD
- CALL UCTOH (TOPNCD, IQ(KOFUCD+LBUPCD+MUPNAM), 4, 16)
-*
- IRC = 0
-#if defined(CERNLIB__P3CHILD)
- IF (IOPPCD.NE.0) THEN
-*
-* ** Request host to open the RZ file
-*
- RNDBP3 = 'CDINIT'
- NWDBP3 = 8
- IWDBP3(1) = LURZCD
- CALL UCTOH (TOPNCD, IWDBP3(2), 4, 16)
- IWDBP3(6) = NREC
- MSDBP3 = CHOP
- CALL UCTOH (MSDBP3, IWDBP3(7), 4, 8)
- CALL CDCHLD
- IF (IQDBP3.NE.0) THEN
- CALL MZDROP (IDIVCD, LBUPCD, ' ')
- IRC =-10
- IQUEST(11) = IQDBP3
-#endif
-#if (defined(CERNLIB__P3CHILD))&&(defined(CERNLIB__DEBUG))
- CALL CDPRNT (LPRTCD, '(/,'' CDINIT : Host unable to open '//
- + 'directory '//TOPNCD//' on unit '',I4)', LURZCD, 1)
-#endif
-#if defined(CERNLIB__P3CHILD)
- GO TO 60
- ENDIF
- ENDIF
-*
-#endif
- IF (IOPTN.EQ.0) THEN
-*
-* ** Reopen the RZ-file on the mass storage for read and write
-*
- IQUEST(10) = IQ10
- IQUEST(11) = IQ11
- CALL RZFILE (LURZCD, TOPNCD, CHOPT)
- IF(IQUEST(1).NE.0) THEN
- CALL RZEND (TOPNCD)
- IQUEST(10) = IQ10
- IQUEST(11) = IQ11
- CALL RZFILE (LURZCD, TOPNCD, CHOPT)
- ENDIF
-*
- ELSE
-*
-* ** Create file on mass storage and create the 1st pass directories
-*
- NSYS = NOF2CK + NPAIR * 2
- CFOR = CHFTCK(1:NSYS)
- DO I = 1, NSYS
- CTAGCK(I) = CHTGCK(I)
- ENDDO
- DO I = 1, NPAIR
- CFOR(NOF1CK+2*I-1:NOF1CK+2*I-1) = 'I'
- CFOR(NOF1CK+2*I :NOF1CK+2*I ) = 'I'
- CTAGCK(NOF1CK+2*I-1) = 'STR_VAL'//CALFCA(27+I)
- CTAGCK(NOF1CK+2*I) = 'END_VAL'//CALFCA(27+I)
- ENDDO
-*
-* New RZ format?
-*
- IOPT7 = INDEX(CHOP,'7')
- IF(IOPT7.NE.0) CHOPT(II+1:II+1) = 'N'
- CALL RZMAKE (LURZCD, TOPNCD, NSYS, CFOR, CTAGCK, NRECS, CHOPT)
-*
- ENDIF
-*
- IF (IQUEST(1).NE.0) THEN
- CALL MZDROP (IDIVCD, LBUPCD, ' ')
- CALL RZEND (TOPNCD)
- IRC = -2
-#if defined(CERNLIB__DEBUG)
- CALL CDPRNT (LPRTCD, '(/,'' CDINIT : Top Directory '//TOPNCD//
- + ' is already open on unit '',I4)', LURZ, 1)
-#endif
- ELSE
-*
- PAT1CT = '//'//TOPNCD
- LBFXCD = 0
- IF (IOPTN.EQ.0) THEN
-*
-* * Get the version number
-*
- CALL RZCDIR (PAT1CT, ' ')
- IF (IQUEST(1).EQ.0) THEN
- NKEYCK = IQUEST(7)
- NWKYCK = IQUEST(8)
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- IF (NKEYCK.GT.0) THEN
- IPNT = KOFSCD + LCDRCD + IKDRCD
- ITOPCD = IQ(IPNT+IDHKSN)
- NPARCD = IQ(IPNT+IDHPTR)
- IHFLCD = MOD(IQ(IPNT+IDHFLG)/64, 2)
- IERR = 0
- ELSE
- IERR = 1
- ENDIF
- ELSE
- IERR = IQUEST(1)
- ENDIF
-*
- ELSE
-*
-* * Create the version number
-*
- CALL UOPTC (CHOP, 'A', IHFLCD)
- CALL VZERO (KEYVCK, NSYS)
- KEYVCK(IDHKSN) = NTOP
- KEYVCK(IDHPTR) = NPAIR
- KEYVCK(IDHFLG) = IHFLCD*64
- CALL CDBANK (IDIVCD, LBFXCD, LBFXCD, 2, 'UPCD', 0, 0, NSYS,
- + 2, 0, IERR)
- IF (IERR.EQ.0) THEN
- CALL UCOPY (KEYVCK, IQ(KOFUCD+LBFXCD+1), NSYS)
- CALL RZOUT (IDIVCD, LBFXCD, KEYVCK, ICYCLE, 'S')
- IERR = IQUEST(1)
- CALL MZDROP (IDIVCD, LBFXCD, ' ')
- ENDIF
- ITOPCD = NTOP
- NPARCD = NPAIR
- LBFXCD = 0
-*
- ENDIF
-*
- IF (IERR.NE.0) THEN
- CALL MZDROP (IDIVCD, LBUPCD, ' ')
- CALL RZEND (TOPNCD)
- IRC = IERR
- GO TO 60
- ENDIF
-*
- IQ(KOFUCD+LBUPCD+MUPDIC) = ITOPCD
- IQ(KOFUCD+LBUPCD+MUPAIR) = NPARCD
- IQ(KOFUCD+LBUPCD+MUPHFL) = IHFLCD
-*
-* * Load the dictionary directory
-*
- CALL CDUDIC (IRC)
-#if (defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))&&(defined(CERNLIB__ONLINE))
- IRC = 0
-#endif
- IF (IRC.NE.0) THEN
- CALL MZDROP (IDIVCD, LBUPCD, ' ')
- CALL RZEND (TOPNCD)
- GO TO 60
- ENDIF
-*
-* * Link it to the list of directory names to be updated
-*
- LREFCD(1) = LBADCD
- 50 IF (LREFCD(1).NE.0) THEN
- CALL UHTOC (IQ(KOFUCD+LREFCD(1)+MFZTOP), 4, TOP1CT, 16)
- IF (TOPNCD.EQ.TOP1CT) THEN
- LQ(KOFUCD+LBUPCD-KLFZCD) = LREFCD(1)
- ELSE
- LREFCD(1) = LQ(KOFUCD+LREFCD(1))
- GO TO 50
- ENDIF
- ENDIF
-*
- ENDIF
-*
- 60 LBUPCD = 0
-*
-* * Reset top directory
-*
- CALL CDCDIR (PAT1CT, ' ',IRC)
-* END CDINIT
- 999 CONTINUE
-C ACP_data_retrieval_end
- END
diff --git a/src/packlib/hepdb/cdinit/cdjour.F b/src/packlib/hepdb/cdinit/cdjour.F
deleted file mode 100644
index 8c667b8..0000000
--- a/src/packlib/hepdb/cdinit/cdjour.F
+++ /dev/null
@@ -1,39 +0,0 @@
-*
-* $Id: cdjour.F,v 1.1.1.1 1996/02/28 16:24:14 mclareni Exp $
-*
-* $Log: cdjour.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:14 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDJOUR(LUNFZ,CHTOP,CHFILE,LRECL,CHOPT,IRC)
-*
-* Open a journal file for the database accessed via
-* name CHTOP
-*
-* Options for CDSOPN:
-*
-* A ASCII file format
-* O Output file (default is input)
-* X Exchange binary format
-* Z File to be overwritten if exists
-*
-* Options for CDFZOP:
-* B Special backup file
-*
-*
- CHARACTER*(*) CHTOP,CHFILE,CHOPT
-
- IRC = 0
- IF(LUNFZ.LE.0) THEN
- IRC = 136
- GOTO 99
- ENDIF
-
- CALL CDSOPN(LUNFZ, CHOPT, CHFILE, LRECL, IRC)
- IF(IRC.NE.0) GOTO 99
-
- CALL CDFZOP(LUNFZ, CHTOP, CHOPT, IRC)
-
-99 END
diff --git a/src/packlib/hepdb/cdinit/cdnew.F b/src/packlib/hepdb/cdinit/cdnew.F
deleted file mode 100644
index 91df176..0000000
--- a/src/packlib/hepdb/cdinit/cdnew.F
+++ /dev/null
@@ -1,140 +0,0 @@
-*
-* $Id: cdnew.F,v 1.1.1.1 1996/02/28 16:24:14 mclareni Exp $
-*
-* $Log: cdnew.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:14 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDNEW(LUNCD,CHTOP,CHFILE,IDIV,NPAIR,NQUO,NPRE,NTOP,
- + LRECL,CHOPT,IRC)
-
-#include "hepdb/cduscm.inc"
-
-#if defined(CERNLIB_IBMVM)
- CHARACTER*80 CHLINE,CHNAME
- CHARACTER*20 WORD
- CHARACTER*6 CHBLOK,CHFREE
- DIMENSION IBUF(8192)
-#endif
- CHARACTER*(*) CHTOP,CHFILE,CHOPT
- CHARACTER*20 CHRZOP,CHCDOP
-
- CHARACTER*10 RZOPTS
- CHARACTER*14 CDOPTS
-
- DIMENSION IOPTRZ(10)
- DIMENSION IOPTCD(14)
-
- DATA RZOPTS/'LNSU1WYCXP'/
- DATA CDOPTS/'SU1LDCXMZQEFA7'/
-
- IRC = 0
-*
-* Default record length is 1024 words
-*
- IF(LRECL.EQ.0) LRECL = 1024
-*
-* Build options for RZOPEN: X, N default
-*
- CALL UOPTC(CHOPT,RZOPTS,IOPTRZ)
- IOPTN = IOPTRZ(2)
- IF(IOPTN.EQ.0) IOPTRZ(9) = 1
- IOPTRZ(2) = 1
-
- CHRZOP = ' '
- J = 0
-
- DO 10 I=1,LEN(RZOPTS)
- IF(IOPTRZ(I).NE.0) THEN
- J = J + 1
- CHRZOP(J:J) = RZOPTS(I:I)
- ENDIF
- 10 CONTINUE
-*
-* Open the database file
-*
-#if defined(CERNLIB_IBMVM)
- LFILE = LENOCC(CHFILE)
- CHNAME = CHFILE(1:LFILE)
- CALL CTRANS('.',' ',CHNAME,1,LFILE)
- IF(INDEX(CHNAME(1:LFILE),' ').EQ.
- + INDEXB(CHNAME(1:LFILE),' ')) THEN
- CHNAME(LFILE+1:LFILE+3) = ' A6'
- LFILE = LFILE + 3
- ENDIF
- CALL RZOPEN(LUNCD,CHTOP,CHNAME,CHRZOP,LRECL,IRC)
-#endif
-#if !defined(CERNLIB_IBMVM)
- CALL RZOPEN(LUNCD,CHTOP,CHFILE,CHRZOP,LRECL,IRC)
-#endif
- IF(IRC.NE.0) GOTO 999
-*
-* Build options for CDINIT
-*
- CALL UOPTC(CHOPT,CDOPTS,IOPTCD)
- IF(IOPTN.EQ.0) IOPTCD(7) = 1
- IOPTCD(9) = 1
-
- CHCDOP = ' '
- J = 0
- DO 30 I=1,LEN(CDOPTS)
- IF(IOPTCD(I).NE.0) THEN
- J = J + 1
- CHCDOP(J:J) = CDOPTS(I:I)
- ENDIF
- 30 CONTINUE
-#if defined(CERNLIB_IBMVM)
-*
-* Preformat NPRE records
-*
- IF(IOPTCD(12).NE.0) THEN
- CHNAME = ' '
- INQUIRE(LUNCD,NAME=CHNAME)
- LNAME = LENOCC(CHNAME) -1
- CALL VMCMS('QUERY DISK '//CHNAME(LNAME:LNAME)//' (LIFO',IRC)
-*
-* Get number of free blocks, blocksize
-*
- CALL VMRTRM(CHLINE,NCH)
- CALL WORDSEP(' ')
- CHFREE = WORD(CHLINE(1:NCH),7)
- CHBLOK = WORD(CHLINE(1:NCH),11)
- LBLOCK = ICDECI(CHBLOK,1,6)
- LFREE = ICDECI(CHFREE,1,6)
-*
-* Clear stack
-*
- CALL VMRTRM(CHLINE,NCH)
-*
-* Check if we have the room to write NPRE records
-*
- NBYTES = LRECL * 4 * NPRE
- NFREE = LBLOCK * LFREE
- IF(NBYTES.GT.NFREE) THEN
- NDO = NFREE/(LRECL*4)
- IF(IDEBCD.GE.0) THEN
- PRINT *,'CDNEW. disk ',CHNAME(LNAME:LNAME),
- + ' has ',LFREE,' free blocks of size ',LBLOCK,' bytes'
- PRINT *,'CDNEW. preformatting of ',NPRE,
- + ' records of length ',LRECL*4,' bytes requested'
- PRINT *,'CDNEW. request reduced to ',NDO,' records'
- ENDIF
- ELSE
- NDO = NPRE
- ENDIF
-*
-* Write the records
-*
- DO 20 IREC=1,NDO
- CALL RZOPHD(LUNCD,LRECL,IREC,IBUF,IRC)
- 20 CONTINUE
- ENDIF
-#endif
-*
-* Initialise HEPDB for this file
-*
- CALL CDINIT(IDIV,LUNCD,0,CHTOP,NPAIR,NQUO,NTOP,CHCDOP,IRC)
-
- 999 END
diff --git a/src/packlib/hepdb/cdinit/cdopen.F b/src/packlib/hepdb/cdinit/cdopen.F
deleted file mode 100644
index fb05ca0..0000000
--- a/src/packlib/hepdb/cdinit/cdopen.F
+++ /dev/null
@@ -1,141 +0,0 @@
-*
-* $Id: cdopen.F,v 1.4 1996/03/11 09:53:25 jamie Exp $
-*
-* $Log: cdopen.F,v $
-* Revision 1.4 1996/03/11 09:53:25 jamie
-* opt R
-*
-* Revision 1.3 1996/03/11 09:09:01 jamie
-* option R bug
-*
-* Revision 1.2 1996/03/04 10:16:11 jamie
-* suppress r/o warning if opt R is specified
-*
-* Revision 1.1.1.1 1996/02/28 16:24:14 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDOPEN(LUNDB,LUNFZ,CHTOP,CHFILE,LRECL,IDIV,CHOPT,IRC)
-
- CHARACTER*(*) CHTOP,CHFILE,CHOPT
-#if defined(CERNLIB_VAXVMS)
- CHARACTER*16 RECTYP
- LOGICAL CDCIO
-#endif
- CHARACTER*20 CHRZOP,CHCDOP
- CHARACTER*10 RZOPTS
- CHARACTER*15 CDOPTS
- PARAMETER (NRZOPT=10)
- PARAMETER (NCDOPT=15)
- DIMENSION IOPTRZ(NRZOPT)
- DIMENSION IOPTCD(NCDOPT)
-#include "hepdb/cduscm.inc"
-#include "hepdb/quest.inc"
-
- DATA RZOPTS/'LNSU1WYCXP'/
- DATA CDOPTS/'SU1LDCXMZQEPRTA'/
-
- IRC = 0
-*
-* Build options for RZOPEN: X default, N means native, not NEW
-*
- CALL UOPTC(CHOPT,RZOPTS,IOPTRZ)
-
- IOPTN = IOPTRZ(2)
- IF(IOPTN.EQ.0) IOPTRZ(9) = 1
-*
-* Disallowed options, New, Update, 1=single user
-*
- IOPTRZ(2) = 0
- IOPTRZ(4) = 0
- IOPTRZ(5) = 0
-*
-* Compulsory options: Shared
-*
- IOPTRZ(3) = 1
-*
-* Check access rights
-*
- CALL CDACL(LUNDB,CHTOP(3:4),IOPTRR,IOPTWW,' ',IRC)
- IF(IOPTRR+IOPTWW.EQ.0) THEN
- IF(IDEBCD.GE.0) WRITE(LPRTCD,9001) CHTOP
- 9001 FORMAT(' CDOPEN. access to database ',A,' denied.')
- IRC = -11
- GOTO 999
- ENDIF
-*
-* Read only?
-*
- IF(IOPTWW.EQ.0) THEN
- IOPTCD(13) = 1
- IF(INDEX(CHOPT,'R').EQ.0.AND.IDEBCD.GE.0)
- + WRITE(LPRTCD,9002) CHTOP
- 9002 FORMAT(' CDOPEN. access to database ',A,' will be READONLY')
- ENDIF
-
- CHRZOP = ' '
- J = 0
-
- DO 10 I=1,NRZOPT
- IF(IOPTRZ(I).NE.0) THEN
- J = J + 1
- CHRZOP(J:J) = RZOPTS(I:I)
- ENDIF
- 10 CONTINUE
-#if defined(CERNLIB_VAXVMS)
-*
-* If the database file has record type STREAM_LF
-* use C I/O
-*
- CDCIO = .FALSE.
- INQUIRE(FILE=CHFILE,RECORDTYPE=RECTYP)
- IF(INDEX(RECTYP,'STREAM_LF').NE.0) THEN
- J = J + 1
- CHRZOP(J:J) = 'C'
- CDCIO = .TRUE.
- ENDIF
-#endif
-*
-* Open the database file
-*
- CALL RZOPEN(LUNDB,CHTOP,CHFILE,CHRZOP,LRECL,IRC)
- IF(IRC.NE.0) GOTO 999
-*
-* Save IQUEST(10-11)
-*
- IQ10 = IQUEST(10)
- IQ11 = IQUEST(11)
-*
-* Build options for CDINIT
-*
- CALL UOPTC(CHOPT,CDOPTS,IOPTCD)
- IF(IOPTN.EQ.0) IOPTCD(7) = 1
-*
-* Public mode is compulsory
-*
- IOPTCD(12) = 1
-#if defined(CERNLIB_VAXVMS)
-*
-* Signal C I/O
-*
- IF(CDCIO) IOPTCD(6) = 1
-#endif
-
- CHCDOP = ' '
- J = 0
-
- DO 20 I=1,NCDOPT
- IF(IOPTCD(I).NE.0) THEN
- J = J + 1
- CHCDOP(J:J) = CDOPTS(I:I)
- ENDIF
- 20 CONTINUE
-*
-* Initialise HEPDB for this file
-*
- IQUEST(10) = IQ10
- IQUEST(11) = IQ11
- CALL CDINIT(IDIV,LUNDB,LUNFZ,CHTOP,NPAIR,NRECS,NTOP,CHCDOP,IRC)
-
- 999 END
diff --git a/src/packlib/hepdb/cdinit/cdpaw.F b/src/packlib/hepdb/cdinit/cdpaw.F
deleted file mode 100644
index 89d65af..0000000
--- a/src/packlib/hepdb/cdinit/cdpaw.F
+++ /dev/null
@@ -1,56 +0,0 @@
-*
-* $Id: cdpaw.F,v 1.1.1.1 1996/02/28 16:24:14 mclareni Exp $
-*
-* $Log: cdpaw.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:14 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDPAW(JWPAW,JHBOOK,IDIV,CHNAME,JW,JWMAX,CHOPT,IRC)
-
-*
-* Initialise (optionally) Zebra, HBOOK and HEPDB
-*
-
- CHARACTER*(*) CHNAME
- COMMON /PAWC/ NWPAWC,IXPAWC,IHBOOK,IXHIGZ,IXKU,IFENCE(5)
- +, LMAIN, IPAW(9989)
-*
-* chopt: Z - zebra
-* P - paw
-* H - hbook
-*
-#include "hepdb/hdbopts.inc"
-
- IRC = 0
-
- NWPAW = JWPAW
- NHBOOK = JHBOOK
- NW = JW
- NWMAX = JWMAX
-*
-* Zebra?
-*
- IF(IOPTZ.NE.0) THEN
- CALL MZEBRA(-1)
- IF(NHBOOK.GT.0) NHBOOK = -NHBOOK
- ENDIF
-*
-* MZPAW?
-*
- IF(IOPTP.NE.0) THEN
- CALL MZPAW(NWPAW,CHOPT)
- NHBOOK = 0
- ENDIF
-*
-* HBOOK?
-*
- IF(IOPTH.NE.0) THEN
- CALL HLIMIT(NHBOOK)
- ENDIF
-
- CALL MZDIV(IXPAWC,IDIV,CHNAME,NW,NWMAX,'LCM')
- CALL CDFRST(IDIV)
-*
- END
diff --git a/src/packlib/hepdb/cdinit/cdshar.F b/src/packlib/hepdb/cdinit/cdshar.F
deleted file mode 100644
index 2942c35..0000000
--- a/src/packlib/hepdb/cdinit/cdshar.F
+++ /dev/null
@@ -1,93 +0,0 @@
-*
-* $Id: cdshar.F,v 1.1.1.1 1996/02/28 16:24:15 mclareni Exp $
-*
-* $Log: cdshar.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:15 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDSHAR(LUNDB,LUNFZ,CHTOP,CHFILE,LRECL,IDIV,CHOPT,IRC)
-
- CHARACTER*(*) CHTOP,CHFILE,CHOPT
-
- CHARACTER*20 CHRZOP,CHCDOP
-
- CHARACTER*10 RZOPTS
- CHARACTER*13 CDOPTS
-
- PARAMETER (NRZOPT=10)
- PARAMETER (NCDOPT=13)
-
- DIMENSION IOPTRZ(NRZOPT)
- DIMENSION IOPTCD(NCDOPT)
-
- DATA RZOPTS/'LNSU1WYCXP'/
- DATA CDOPTS/'SU1LDCXMZQEPA'/
-*
-* As CDUPDT, but forcing Shared Update mode (i.e. locks)
-*
- IRC = 0
-*
-* Build options for RZOPEN: X default, N means native, not NEW
-*
- CALL UOPTC(CHOPT,RZOPTS,IOPTRZ)
-
- IOPTN = IOPTRZ(2)
- IF(IOPTN.EQ.0) IOPTRZ(9) = 1
-*
-* Compulsory options: Shared, Update
-*
- IOPTRZ(3) = 1
- IOPTRZ(4) = 1
-*
-* Forbidden options: New
-*
- IOPTRZ(2) = 0
-
- CHRZOP = ' '
- J = 0
-
- DO 10 I=1,NRZOPT
- IF(IOPTRZ(I).NE.0) THEN
- J = J + 1
- CHRZOP(J:J) = RZOPTS(I:I)
- ENDIF
- 10 CONTINUE
-*
-* Open the database file
-*
- CALL RZOPEN(LUNDB,CHTOP,CHFILE,CHRZOP,LRECL,IRC)
-
- IF(IRC.NE.0) GOTO 99
-*
-* Build options for CDINIT
-*
- CALL UOPTC(CHOPT,CDOPTS,IOPTCD)
- IF(IOPTN.EQ.0) IOPTCD(7) = 1
-*
-* Public mode is forbidden
-*
- IOPTCD(12) = 0
-*
-* Shared update mode is compulsory
-*
- IOPTCD(1) = 1
- IOPTCD(2) = 1
-
- CHCDOP = ' '
- J = 0
-
- DO 20 I=1,NCDOPT
- IF(IOPTCD(I).NE.0) THEN
- J = J + 1
- CHCDOP(J:J) = CDOPTS(I:I)
- ENDIF
- 20 CONTINUE
-*
-* Initialise HEPDB for this file
-*
- CALL CDINIT(IDIV,LUNDB,LUNFZ,CHTOP,NPAIR,NRECS,NTOP,CHCDOP,IRC)
-
-99 END
-
diff --git a/src/packlib/hepdb/cdinit/cdudiv.F b/src/packlib/hepdb/cdinit/cdudiv.F
deleted file mode 100644
index 25cbcba..0000000
--- a/src/packlib/hepdb/cdinit/cdudiv.F
+++ /dev/null
@@ -1,35 +0,0 @@
-*
-* $Id: cdudiv.F,v 1.1.1.1 1996/02/28 16:24:15 mclareni Exp $
-*
-* $Log: cdudiv.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:15 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDUDIV(IXSTR,IUDIV,CHNAME,NWINI,NWMAX)
-* ------------------------=====--------------------
-*
-***************************************************************
-* Booking HEPDB divisions into an indicated store *
-* *
-* Called by CDPAW or from User's program *
-* *
-* Arguments: *
-* IXSTR -any division index from the requested *
-* store or ISHFT(nstore,26) *
-* IUDIV -returned index of the User Division *
-* CHNAME -name of the User Division *
-* NWINI -initial size of the User Division *
-* NWMAX -maximal size of the User Division *
-* *
-* Author: Boris Khomenko *
-***************************************************************
-
- CHARACTER*(*) CHNAME
-*
- CALL MZDIV(IXSTR,IUDIV,CHNAME,NWINI,NWMAX,'LCM')
-*
- CALL CDFRST(IUDIV)
-*
- END
diff --git a/src/packlib/hepdb/cdinit/cdupdt.F b/src/packlib/hepdb/cdinit/cdupdt.F
deleted file mode 100644
index 5e6f265..0000000
--- a/src/packlib/hepdb/cdinit/cdupdt.F
+++ /dev/null
@@ -1,96 +0,0 @@
-*
-* $Id: cdupdt.F,v 1.1.1.1 1996/02/28 16:24:15 mclareni Exp $
-*
-* $Log: cdupdt.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:15 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDUPDT(LUNDB,LUNFZ,CHTOP,CHFILE,LRECL,IDIV,CHOPT,IRC)
-
- CHARACTER*(*) CHTOP,CHFILE,CHOPT
-
- CHARACTER*20 CHRZOP,CHCDOP
-
- CHARACTER*10 RZOPTS
- CHARACTER*13 CDOPTS
-
- PARAMETER (NRZOPT=10)
- PARAMETER (NCDOPT=13)
-
- DIMENSION IOPTRZ(NRZOPT)
- DIMENSION IOPTCD(NCDOPT)
-
- DATA RZOPTS/'LNSU1WYCXP'/
- DATA CDOPTS/'SU1LDCXMZQEPA'/
-*
-* As CDOPEN, but for server use.
-*
- IRC = 0
-*
-* Build options for RZOPEN: X default, N means native, not NEW
-*
- CALL UOPTC(CHOPT,RZOPTS,IOPTRZ)
-
- IOPTN = IOPTRZ(2)
- IF(IOPTN.EQ.0) IOPTRZ(9) = 1
-*
-* Compulsory options: Shared, Update
-*
- IOPTRZ(3) = 1
- IOPTRZ(4) = 1
-*
-* Forbidden options: New
-*
- IOPTRZ(2) = 0
-
- CHRZOP = ' '
- J = 0
-
- DO 10 I=1,NRZOPT
- IF(IOPTRZ(I).NE.0) THEN
- J = J + 1
- CHRZOP(J:J) = RZOPTS(I:I)
- ENDIF
- 10 CONTINUE
-*
-* Open the database file
-*
- CALL RZOPEN(LUNDB,CHTOP,CHFILE,CHRZOP,LRECL,IRC)
- IF(IRC.NE.0) GOTO 99
-*
-* Build options for CDINIT
-*
- CALL UOPTC(CHOPT,CDOPTS,IOPTCD)
- IF(IOPTN.EQ.0) IOPTCD(7) = 1
-*
-* Public mode is forbidden
-*
- IOPTCD(12) = 0
-*
-* Update mode is compulsory
-*
- IOPTCD(2) = 1
-*
-* Request reset of locks
-*
- IOPTCD(4) = 1
- IOPTCD(5) = 1
-
- CHCDOP = ' '
- J = 0
-
- DO 20 I=1,NCDOPT
- IF(IOPTCD(I).NE.0) THEN
- J = J + 1
- CHCDOP(J:J) = CDOPTS(I:I)
- ENDIF
- 20 CONTINUE
-*
-* Initialise HEPDB for this file
-*
- CALL CDINIT(IDIV,LUNDB,LUNFZ,CHTOP,NPAIR,NRECS,NTOP,CHCDOP,IRC)
-
-99 END
-
diff --git a/src/packlib/hepdb/cdmdir/Imakefile b/src/packlib/hepdb/cdmdir/Imakefile
deleted file mode 100644
index 8b732cc..0000000
--- a/src/packlib/hepdb/cdmdir/Imakefile
+++ /dev/null
@@ -1,4 +0,0 @@
-SRCS_F= cdddir.F cdfpat.F cdkeep.F cdmdir.F cdmkdi.F cdpart.F \ @@\
- cdsdir.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/hepdb/cdmdir/cdddir.F b/src/packlib/hepdb/cdmdir/cdddir.F
deleted file mode 100644
index e5bca5b..0000000
--- a/src/packlib/hepdb/cdmdir/cdddir.F
+++ /dev/null
@@ -1,506 +0,0 @@
-*
-* $Id: cdddir.F,v 1.1.1.1 1996/02/28 16:24:15 mclareni Exp $
-*
-* $Log: cdddir.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:15 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
-#if defined(CERNLIB__P3CHILD)
-* Ignoring t=dummy
-#endif
- SUBROUTINE CDDDIR (PATHN, CHOPT, IRC)
-* =====================================
-*
-************************************************************************
-* *
-* SUBR. CDDDIR (PATHN, CHOPT, IRC*) *
-* *
-* Deletes the directory from the current level downwards as given *
-* in the path name *
-* *
-* Arguments : *
-* *
-* PATHN Path name to be deleted *
-* CHOPT Character string with any of the following characters *
-* B Save in the special backup file; not in standard Journal*
-* IRC Return Code (See below) *
-* *
-* Called by user, CDFZUP, CDKEEP *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* =171 : Illegal Path name *
-* =172 : Cannot find the top directory for the path name *
-* =173 : Error in RZ for reading the dictionary object *
-* =174 : Error in FZOUT for saving the journal file *
-* =175 : Error in RZ in writing the dictionary object *
-* =176 : Error in RZ in purging the dictionary directory *
-* =177 : Error in RZ in deleting the tree *
-* =178 : Error in RZ in deleting Name/Help information *
-* *
-************************************************************************
-*
-#include "hepdb/caopts.inc"
-#include "hepdb/cdcblk.inc"
-#include "hepdb/cfzlun.inc"
-#include "hepdb/ckkeys.inc"
-#include "hepdb/ctpath.inc"
-#if defined(CERNLIB__P3CHILD)
-#include "hepdb/p3dbl3.inc"
-#endif
- PARAMETER (NLEVM=20)
- DIMENSION NCHD(NLEVM), ISDI(NLEVM)
- DIMENSION NKEY(NLEVM), IOPT(NLEVM), NSDI(NLEVM)
- DIMENSION IHDIR(4)
- CHARACTER PATHN*(*), CHOPT*(*), PATHY*255, PATHL*255
-#include "zebra/q_jbit.inc"
-* Ignoring t=pass
-*
-* ------------------------------------------------------------------
-*
-* *** Decode the character option
-*
- CALL CDOPTS (CHOPT, IRC)
- IF (IRC.NE.0) GO TO 999
- KEY7 = KEY7CK
- KEY7CK = 0
- PATHL = ' '
-*
-* *** Load the top directory information
-*
- CALL CDLDUP (PATHN, 0, IRC)
- IF (IRC.NE.0) GO TO 999
- PATHY = PAT1CT
- NCHR = LENOCC (PATHY)
- PAT3CT = '//'//TOPNCD(1:NCHRCD)//'/HELP'
- IF (PATHY.EQ.PAT3CT) GO TO 999
- PAT2CT = '//'//TOPNCD(1:NCHRCD)//'/DICTIONARY'
- IF (PATHY.EQ.PAT2CT) GO TO 999
- IF (IOPBCA.EQ.0) THEN
- LUFZCF = LUFZCD
- ELSE
- LUFZCF = LUBKCD
- ENDIF
-*
-* *** Find the dictionary record
-*
- CALL RZCDIR (PAT2CT, ' ')
- IF (IQUEST(1).NE.0) THEN
- LFIXCD = 0
- IRC = 173
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDDDIR : '//
- + 'RZCDIR error for path name '//PAT2CT//''')', IARGCD, 0)
-#endif
- GO TO 999
- ENDIF
- NKEYCK = IQUEST(7)
- NWKYCK = IQUEST(8)
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- ISTP = NWKYCK + 1
- IF (NKEYCK.GT.0) THEN
- IPNT = KOFSCD + LCDRCD + IKDRCD
- IMIN = IUHUNT (-1, IQ(IPNT+IDHKSN), NKEYCK*ISTP, ISTP)
- IF (IMIN.GT.0) THEN
- IMIN = (IMIN - IDHKSN) / ISTP + 1
- CALL CDKEYT
- CALL CDKEYR (IMIN, NWKYCK, KEYVCK)
- IF (LQ(KOFUCD+LBUPCD-KLDICD).LE.0) THEN
- CALL CDRZIN (IDIVCD, LBUPCD,-KLDICD, IMIN,ICYCL, PAT2CT,IRC)
- IF (IRC.NE.0) GO TO 999
- ENDIF
- LFIXCD = LQ(KOFUCD+LBUPCD-KLDICD)
- ELSE
- LFIXCD = 0
- ENDIF
- ELSE
- LFIXCD = 0
- ENDIF
-#if (defined(CERNLIB_UNIX)||defined(CERNLIB_IBMVM)||defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))
-*
- IF (IOPPCD.NE.0) THEN
- IRC = 0
-#endif
-#if (defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))&&(!defined(CERNLIB__P3CHILD))&&(defined(CERNLIB__ONLINE))
- CALL CDWLOK (IRC)
-#endif
-#if (defined(CERNLIB_UNIX)||defined(CERNLIB_IBMVM)||defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))&&(!defined(CERNLIB__P3CHILD))&&(!defined(CERNLIB__ONLINE))
- CALL CDSTSV (TOPNCD, 0, IRC)
-#endif
-#if (defined(CERNLIB__P3CHILD))&&(defined(CERNLIB__SERVER))
- LUFZCF = LODBP3
-#endif
-#if (defined(CERNLIB_UNIX)||defined(CERNLIB_IBMVM)||defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))
- IF (IRC.NE.0) GO TO 999
- ENDIF
-#endif
-*
-* *** Prepare the journal file if needed
-*
- IF (LUFZCF.GT.0) THEN
- IF (IOPBCA.EQ.0) THEN
- NWDOP = 0
- ELSE
- NWDOP = 1
- ENDIF
- NDOP = (NCHR + 3) / 4
- IHEDCF(MACTCF) = 4
- IHEDCF(MNKYCF) = 0
- IHEDCF(MOPTCF) = NWDOP
- IHEDCF(MPATCF) = NDOP
- IHEDCF(MPRECF) = 0
- IF (KEY7.LE.0) THEN
- CALL DATIME (IDATE, ITIME)
- CALL CDPKTM (IDATE, ITIME, KEY7, IRC)
- ENDIF
- IHEDCF(MINSCF) = KEY7
- IF (NWDOP.EQ.1) CALL UCTOH ('B ', IHEDCF(MINSCF+1), 4, 4)
- CALL UCTOH (PATHY, IHEDCF(MINSCF+NWDOP+1), 4, 4*NDOP)
- CALL MZIOCH (IOFMCF, NWFMCF, '6I -H')
- NWDH = NWDOP + NDOP + MINSCF
-*
-* ** Now write on the sequential output
-*
-#if defined(CERNLIB__P3CHILD)
- RNDBP3 = 'CDDDIR '
- NWDBP3 = 2
- CALL UCTOH ('JOURNAL ', IWDBP3, 4, 8)
- CALL CDCHLD
- IRC = IQDBP3
- IF (IRC.NE.0) GO TO 999
-#endif
- CALL FZOUT (LUFZCF, IDIVCD, 0, 1, 'Z', IOFMCF, NWDH, IHEDCF)
- IF (IQUEST(1).NE.0) THEN
- IRC = 174
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDDDIR : FZOUT'//
- + ' error for path name '//PATHY(1:NCHR)//''')', IARGCD, 0)
-#endif
- GO TO 999
- ENDIF
- ENDIF
-*
- IRC = 0
-#if (defined(CERNLIB_UNIX)||defined(CERNLIB_IBMVM)||defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))
-*
-* *** Server environment, Public mode
-*
- IF (IOPPCD.NE.0) THEN
-#endif
-#if (defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))&&(!defined(CERNLIB__P3CHILD))&&(defined(CERNLIB__ONLINE))
- CALL CDCWSV (IRC)
-#endif
-#if (defined(CERNLIB_UNIX)||defined(CERNLIB_IBMVM)||defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))
- GO TO 999
- ENDIF
-#endif
-#if !defined(CERNLIB__P3CHILD)
-*
-* *** Find the level below which all directories are deleted
-*
- NLEV = 1
- NCHD(NLEV) = NCHR
- NCHL = 0
- DO 10 I = 1, NCHR
- NCH = NCHR - I + 1
- IF (PATHY(NCH:NCH).EQ.'/') THEN
- NCHL = NCH
- GO TO 15
- ENDIF
- 10 CONTINUE
- 15 IF (NCHL.LE.2) GO TO 999
- CALL RZCDIR (PATHY, ' ')
- IF (IQUEST(1).NE.0) THEN
- IRC = 171
-#endif
-#if (defined(CERNLIB__DEBUG))&&(!defined(CERNLIB__P3CHILD))
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDDDIR : Illegal'//
- + ' path name '//PATHY(1:NCHR)//''')', IARGCD, 0)
-#endif
-#if !defined(CERNLIB__P3CHILD)
- GO TO 999
- ENDIF
- NKEYCK = IQUEST(7)
- NWKYCK = IQUEST(8)
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- IF (KEY7.GT.0) THEN
- CALL CDPKTM (IQUEST(16), IQUEST(17), KEY7N, IRC)
- IF (KEY7.LT.KEY7N) GO TO 999
- ENDIF
-*
-* *** Update the dictionary information if it exists
-*
- IF (LFIXCD.GT.0) THEN
- NITEM = IQ(KOFUCD+LFIXCD+MDCNTM)
- NCHAR = 0
- CALL VZERO (IPURCK, NITEM)
- NDEL = 0
- IF (NKEYCK.GT.0) THEN
- IOPTP = JBIT (IQ(KOFSCD+LCDRCD+IKDRCD+IDHFLG), JPRTCD)
- ELSE
- IOPTP = 0
- ENDIF
-*
-* ** Now scan down to find all the subdirectories
-*
- 20 IF (NLEV.GT.1) THEN
- PATHY = PATHY(1:NCHD(NLEV-1))//'/'//TOP1CT
- NCHD(NLEV) = NCHD(NLEV-1) + NCHAR + 1
- CALL RZCDIR (PATHY, ' ')
- NKEYCK = IQUEST(7)
- NWKYCK = IQUEST(8)
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- IF (NKEYCK.GT.0) THEN
- IOPTP = JBIT (IQ(KOFSCD+LCDRCD+IKDRCD+IDHFLG), JPRTCD)
- ELSE
- IOPTP = 0
- ENDIF
- ENDIF
- NKEY(NLEV) = NKEYCK
- IOPT(NLEV) = IOPTP
- ISDI(NLEV) = 0
- NSDI(NLEV) = IQ(KOFSCD+LCDRCD+KNSDCD)
-*
- 25 ISDI(NLEV) = ISDI(NLEV) + 1
- IF (ISDI(NLEV).LE.NSDI(NLEV)) THEN
-*
-* ** If a new subdirectory go down one level
-*
- LS = IQ(KOFSCD+LCDRCD+KLSDCD)
- IPNT = LS + 7 * (ISDI(NLEV) - 1)
- CALL ZITOH (IQ(KOFSCD+LCDRCD+IPNT), IHDIR, 4)
- CALL UHTOC (IHDIR, 4, TOP1CT, 16)
- NCHAR = LENOCC (TOP1CT)
- IF (IOPTP.NE.0) THEN
- DO 35 IK = 1, NKEYCK
- KK = IK
- IDIG = 0
- 30 IF (KK.GT.0) THEN
- KK = KK / 10
- IDIG = IDIG + 1
- GO TO 30
- ENDIF
- IF (NCHAR.EQ.IDIG) THEN
- WRITE (PAT4CT, '(I8)') IK
- I1 = 8 - IDIG + 1
- TOP2CT = PAT4CT(I1:8)
- IF (TOP1CT.EQ.TOP2CT) GO TO 25
- ENDIF
- 35 CONTINUE
- ENDIF
- NLEV = NLEV +1
- GO TO 20
-*
- ELSE
-*
-* ** Check if the name is to be deleted
-*
- PAT1CT = PATHY(NCHRCD+3:NCHD(NLEV))
- NCHRU = NCHD(NLEV) - NCHRCD - 2
- IF (NITEM.GT.0) THEN
- DO 40 I = 1, NITEM
- IPNT = KOFUCD + LFIXCD + (I - 1) * NWITCD + 1
- NCHF = IQ(IPNT+MDCNCH)
- IF (NCHRU.EQ.NCHF) THEN
- CALL UHTOC (IQ(IPNT+MDCNAM), 4, PAT4CT, NCHF)
- PAT4CT = PAT4CT(1:NCHF)
- IF (PAT1CT.EQ.PAT4CT) THEN
- IF (IQ(IPNT+MDCITM).GT.0) THEN
- NDEL = NDEL + 1
- IPURCK(NDEL) = IQ(IPNT+MDCITM)
- ENDIF
- IQ(IPNT+MDCITM) = -1
- GO TO 45
- ENDIF
- ENDIF
- 40 CONTINUE
- ENDIF
-*
- 45 NLEV = NLEV - 1
- IF (NLEV.GE.1) THEN
- LUP = LQ(KOFSCD+LCDRCD+1)
- CALL MZDROP (0, LCDRCD, ' ')
- LCDRCD = LUP
- NKEYCK = NKEY(NLEV)
- IOPTP = IOPT(NLEV)
- GO TO 25
- ENDIF
- ENDIF
-*
-* ** Delete help information if any
-*
- IF (NDEL.GT.0) THEN
- CALL RZCDIR (PAT3CT, ' ')
- IF (IQUEST(1).EQ.0) THEN
- NKEYCK = IQUEST(7)
- NWKYCK = IQUEST(8)
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- ISTP = NWKYCK + 1
- IF (NKEYCK.GT.0) THEN
- IPNT = KOFSCD + LCDRCD + IKDRCD
- NKEYS = 0
- DO 50 I = 1, NDEL
- IMIN = IUHUNT (IPURCK(I), IQ(IPNT+IDHKSN),
- + NKEYCK*ISTP, ISTP)
- IF (IMIN.GT.0) THEN
- NKEYS = NKEYS + 1
- KEY1CK(NKEYS) = (IMIN - IDHKSN) / ISTP + 1
- ENDIF
- 50 CONTINUE
- IF (NKEYS.GT.0) THEN
- CALL SORTZV (KEY1CK(1), KEY1CK(NKEYS+1), NKEYS, -1, 0,0)
- IF (IOPSCD.NE.0) THEN
- CALL RZLOCK ('CDDDIR')
- PATHL = PAT3CT
- ENDIF
- CALL CDKEYT
- DO 55 I = 1, NKEYS
- II = KEY1CK(2*NKEYS-I+1)
- IK = KEY1CK(II)
- CALL CDKEYR (IK, NWKYCK, KEYNCK)
- CALL RZDELK (KEYNCK, ICDUM, 'C')
- IF (IQUEST(1).NE.0) THEN
- IRC = 178
-#endif
-#if (defined(CERNLIB__DEBUG))&&(!defined(CERNLIB__P3CHILD))
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD,
- + '(/,'' CDDDIR : RZDELK error for path name '//PAT3CT
- + //''')', IARGCD, 0)
-#endif
-#if !defined(CERNLIB__P3CHILD)
- GO TO 998
- ENDIF
- 55 CONTINUE
- ENDIF
- ENDIF
- ENDIF
- ENDIF
-*
-* ** Lock the dictionary directory if necessary
-*
- CALL RZCDIR (PAT2CT, ' ')
- NKEYCK = IQUEST(7)
- NWKYCK = IQUEST(8)
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- ISTP = NWKYCK + 1
- IF (IOPSCD.NE.0) THEN
- CALL RZLOCK ('CDDDIR')
- PATHL = PAT2CT
- ENDIF
-*
-* ** Delete name information if any
-*
- IF (NDEL.GT.0.AND.NKEYCK.GT.0) THEN
- IPNT = KOFSCD + LCDRCD + IKDRCD
- NKEYS = 0
- DO 60 I = 1, NDEL
- IMIN = IUHUNT (IPURCK(I), IQ(IPNT+IDHKSN), NKEYCK*ISTP,
- + ISTP)
- IF (IMIN.GT.0) THEN
- NKEYS = NKEYS + 1
- KEY1CK(NKEYS) = (IMIN - IDHKSN) / ISTP + 1
- ENDIF
- 60 CONTINUE
- IF (NKEYS.GT.0) THEN
- CALL SORTZV (KEY1CK(1), KEY1CK(NKEYS+1), NKEYS, -1, 0, 0)
- CALL CDKEYT
- DO 65 I = 1, NKEYS
- II = KEY1CK(2*NKEYS-I+1)
- IK = KEY1CK(II)
- CALL CDKEYR (IK, NWKYCK, KEYNCK)
- CALL RZDELK (KEYNCK, ICDUM, 'C')
- IF (IQUEST(1).NE.0) THEN
- IRC = 178
-#endif
-#if (defined(CERNLIB__DEBUG))&&(!defined(CERNLIB__P3CHILD))
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDDDIR :'//
- + 'RZDELK error for path name '//PAT2CT//''')', IARGCD, 0)
-#endif
-#if !defined(CERNLIB__P3CHILD)
- GO TO 998
- ENDIF
- 65 CONTINUE
- ENDIF
- ENDIF
-*
-* ** All subdirectories looked at; now store dictionary
-*
- CALL RZOUT (IDIVCD, LFIXCD, KEYVCK, ICYCLE, 'S')
- IF (IQUEST(1).NE.0) THEN
- IRC = 175
-#endif
-#if (defined(CERNLIB__DEBUG))&&(!defined(CERNLIB__P3CHILD))
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDDDIR : RZOUT'//
- + ' error for path name '//PAT2CT//''')', IARGCD, 0)
-#endif
-#if !defined(CERNLIB__P3CHILD)
- GO TO 998
- ENDIF
- IKDRCD = IQ(KOFSCD+LCDRCD+KLKDCD)
- NKEYCK = IQ(KOFSCD+LCDRCD+KNKDCD)
- CALL RZPURG (0)
- IF (IQUEST(1).NE.0) THEN
- IRC = 176
-#endif
-#if (defined(CERNLIB__DEBUG))&&(!defined(CERNLIB__P3CHILD))
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDDDIR : RZPUR'//
- + 'G error for path name '//PAT2CT//''')', IARGCD, 0)
-#endif
-#if !defined(CERNLIB__P3CHILD)
- GO TO 998
- ENDIF
-*
-* ** Free the directory if locked
-*
- IF (PATHL.NE.' ') THEN
- CALL RZCDIR (PATHL, ' ')
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- CALL RZFREE ('CDDDIR')
- PATHL = ' '
- ENDIF
- ENDIF
-*
- 100 IQUEST(1) = 0
- PAT4CT = PATHY(NCHL+1:NCHR)
- PAT1CT = PATHY(1:NCHL-1)
-*
-* ** Lock the directory if necessary
-*
- CALL RZCDIR (PAT1CT, ' ')
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- IF (IOPSCD.NE.0) THEN
- CALL RZLOCK ('CDDDIR')
- PATHL = PAT1CT
- ENDIF
- CALL RZDELT (PAT4CT)
- IF (IQUEST(1).NE.0) THEN
- IRC = 177
-#endif
-#if (defined(CERNLIB__DEBUG))&&(!defined(CERNLIB__P3CHILD))
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDDDIR : RZDELT '//
- + 'error for path name '//PATHY(1:NCHR)//''')', IARGCD, 0)
-#endif
-#if !defined(CERNLIB__P3CHILD)
- ENDIF
-*
-* *** Free the directory if locked
-*
- 998 IF (PATHL.NE.' ') THEN
- CALL RZCDIR (PATHL, ' ')
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- CALL RZFREE ('CDDDIR')
- ENDIF
-#endif
-* END CDDDIR
- 999 END
diff --git a/src/packlib/hepdb/cdmdir/cdfpat.F b/src/packlib/hepdb/cdmdir/cdfpat.F
deleted file mode 100644
index 525dfbb..0000000
--- a/src/packlib/hepdb/cdmdir/cdfpat.F
+++ /dev/null
@@ -1,318 +0,0 @@
-*
-* $Id: cdfpat.F,v 1.1.1.1 1996/02/28 16:24:15 mclareni Exp $
-*
-* $Log: cdfpat.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:15 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
-#if (defined(CERNLIB__P3CHILD))&&(defined(CERNLIB_IBM))
-* Ignoring t=dummy
-#endif
- SUBROUTINE CDFPAT (PATHN, LEVMX, LAD, IRC)
-* ==========================================
-*
-************************************************************************
-* *
-* SUBR. CDFPAT (PATHN, LEVMX, LAD*, IRC*) *
-* *
-* Store the information of the directory tree PATHN in a bank *
-* *
-* Arguments : *
-* *
-* PATHN The pathname of the directory tree about which the *
-* information has to be provided *
-* LEVMX Number of levels below PATHN about which information *
-* has to be accumulated *
-* LAD Address of the bank containing the information *
-* IRC Return Code (See below) *
-* *
-* Called by CDKEEP *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* =212 : Illegal path name *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
-#include "hepdb/ckkeys.inc"
-#include "hepdb/ctpath.inc"
- PARAMETER (NLEVM=20, NWITM=28, NPUSH=10)
- PARAMETER (NWLEV=8, NWNOD=6)
- DIMENSION NKEY(NLEVM), NCHD(NLEVM), ISDI(NLEVM)
- DIMENSION NSDI(NLEVM), IOPT(NLEVM)
- DIMENSION NODES(NLEVM), IHDIR(4), LAD(9)
- CHARACTER PATHN*(*), PATHY*255
-#include "zebra/q_jbit.inc"
-* Ignoring t=pass
-*
-* ------------------------------------------------------------------
-*
- IF (LAD(1).NE.0) THEN
- CALL MZDROP (IDIVCD, LAD(1), 'L')
- LAD(1) = 0
- ENDIF
- IF (LEVMX.LE.0) THEN
- LEVEL = NLEVM
- ELSE
- LEVEL = LEVMX
- ENDIF
- CALL VZERO (NODES, NLEVM)
- CALL CDSBLC (PATHN, PATHY, NCHAR)
- CALL RZCDIR (PAT4CT, 'R')
- CALL RZCDIR (PATHY, ' ')
- IF (IQUEST(1).NE.0) THEN
- IRC = 212
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDFPAT : Illegal'//
- + ' path name '//PATHY//''')', IARGCD, 0)
-#endif
- GO TO 100
- ENDIF
- NKEYCK = IQUEST(7)
- NWKYCK = IQUEST(8)
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- IF (NKEYCK.LE.0) THEN
- IOPTP = 0
- ELSE
- IOPTP = JBIT (IQ(KOFSCD+LCDRCD+IKDRCD+IDHFLG), JPRTCD)
- ENDIF
- CALL RZCDIR (PATHY, 'R')
- NCHR = LENOCC (PATHY)
- NLEV = 1
- NCHD(NLEV) = NCHR
-*
-* *** Create a temporary bank for storing information
-*
- NDWD = NPUSH * NWITM
- NKEEP = NPUSH
- NITEM = 0
- NLEVT = NLEV
- NWDSN = 0
- CALL CDBANK (IDIVCD, LFIXCD, LFIXCD, 2, 'TEMP', 0, 0, NDWD, 0, -1,
- + IRC)
- IF (IRC.NE.0) GO TO 100
-*
-* *** Now scan down to find all the subdirectories
-*
- 10 IF (NLEV.GT.1) THEN
- PATHY = PATHY(1:NCHD(NLEV-1))//'/'//TOP1CT
- NCHD(NLEV) = NCHD(NLEV-1) + NCHR + 1
- CALL RZCDIR (PATHY, ' ')
- NKEYCK = IQUEST(7)
- NWKYCK = IQUEST(8)
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- IF (NKEYCK.GT.0) THEN
- IOPTP = JBIT (IQ(KOFSCD+LCDRCD+IKDRCD+IDHFLG), JPRTCD)
- ELSE
- IOPTP = 0
- ENDIF
- ENDIF
- NKEY(NLEV) = NKEYCK
- IOPT(NLEV) = IOPTP
- ISDI(NLEV) = 0
- NSDI(NLEV) = IQ(KOFSCD+LCDRCD+KNSDCD)
- IF (NLEV.EQ.LEVEL) NSDI(NLEV) = 0
-*
- 20 ISDI(NLEV) = ISDI(NLEV) + 1
- IF (ISDI(NLEV).LE.NSDI(NLEV)) THEN
-*
-* ** If a new subdirectory go down one level
-*
- LS = IQ(KOFSCD+LCDRCD+KLSDCD)
- IPNT = LS + 7 * (ISDI(NLEV) - 1)
- CALL ZITOH (IQ(KOFSCD+LCDRCD+IPNT), IHDIR, 4)
- CALL UHTOC (IHDIR, 4, TOP1CT, 16)
- NCHR = LENOCC (TOP1CT)
- IF (IOPTP.NE.0) THEN
- DO 30 IK = 1, NKEYCK
- KK = IK
- IDIG = 0
- 25 IF (KK.GT.0) THEN
- KK = KK / 10
- IDIG = IDIG + 1
- GO TO 25
- ENDIF
- IF (NCHR.EQ.IDIG) THEN
-#if !defined(CERNLIB_IBM)||!defined(CERNLIB__P3CHILD)
- WRITE (PAT2CT, '(I8)') IK
-#endif
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB__P3CHILD))
- CALL UTWRIT (PAT2CT, '(I8)', IK, 1)
-#endif
- I1 = 8 - IDIG + 1
- TOP2CT = PAT2CT(I1:8)
- IF (TOP2CT.EQ.TOP1CT) GO TO 20
- ENDIF
- 30 CONTINUE
- ENDIF
- NLEV = NLEV +1
- IF (NLEV.GT.NLEVT) NLEVT = NLEV
- GO TO 10
-*
- ELSE
-*
-* ** Enter the new path name in the temporary space
-*
- IF (NLEV.EQ.1) THEN
- NSTR = 2
- DO 35 I = 3, NCHD(1)
- IF (PATHY(I:I).EQ.'/') NSTR = I
- 35 CONTINUE
- TOP2CT = PATHY(NSTR+1:NCHD(NLEV))
- NCHR = NCHD(NLEV) - NSTR
- NCHRT = NSTR - 1
- PAT3CT = PATHY(1:NCHRT)
- ELSE
- TOP2CT = PATHY(NCHD(NLEV-1)+2:NCHD(NLEV))
- NCHR = NCHD(NLEV) - NCHD(NLEV-1) - 1
- PAT3CT = PATHY(1:NCHD(NLEV-1))
- NCHRT = NCHD(NLEV-1)
- ENDIF
- NODES(NLEV) = NODES(NLEV) + 1
-*
- NITEM = NITEM + 1
- IF (NITEM.GT.NKEEP) THEN
- LBDACD = LFIXCD
- LFIXCD = 0
- ND = NDWD + NPUSH * NWITM
- CALL CDBANK (IDIVCD, LFIXCD, LFIXCD, 2, 'TEMP', 0,0, ND, 0,-1,
- + IRC)
- IF (IRC.NE.0) THEN
- CALL MZDROP (IDIVCD, LBDACD, ' ')
- GO TO 100
- ENDIF
- CALL UCOPY (IQ(KOFUCD+LBDACD+1), IQ(KOFUCD+LFIXCD+1), NDWD)
- CALL MZDROP (IDIVCD, LBDACD, ' ')
- NDWD = IQ(KOFUCD+LFIXCD-1)
- NKEEP = NKEEP + NPUSH
- ENDIF
- NWDN = (NCHR + 3) / 4
- NWDSN = NWDSN + NWDN
- IPNT = KOFUCD + LFIXCD + (NITEM - 1) * NWITM
- IQ(IPNT+1) = NLEV
- IQ(IPNT+2) = NODES(NLEV)
- IQ(IPNT+3) = NCHR
- IQ(IPNT+4) = NCHRT
- CALL UCTOH (TOP2CT, IQ(IPNT+5), 4, 16)
- CALL UCTOH (PAT3CT, IQ(IPNT+9), 4, 80)
-*
- 50 NLEV = NLEV - 1
- IF (NLEV.GE.1) THEN
- LUP = LQ(KOFSCD+LCDRCD+1)
- CALL MZDROP (0, LCDRCD, ' ')
- LCDRCD = LUP
- NKEYCK = NKEY(NLEV)
- IOPTP = IOPT(NLEV)
- GO TO 20
- ENDIF
- ENDIF
-*
-* *** All subdirectories looked at; now store dictionary if permitted
-*
- 60 IF (NLEVT.GT.0) THEN
- ND = 3 + NWLEV*NLEVT + NWNOD*NITEM + NWDSN
- CALL CDBANK (IDIVCD, LAD(1), LAD(1), 2, 'NAME', 0, 0, ND, 0, -1,
- + IRC)
- IF (IRC.NE.0) THEN
- CALL MZDROP (IDIVCD, LFIXCD, ' ')
- GO TO 100
- ENDIF
- IOFF = KOFUCD + LAD(1)
- KPNTL = 3
- IPNTL = KPNTL
- IQ(IOFF+MPNLCD) = KPNTL
- IQ(IOFF+MNLVCD) = NLEVT
- Q(IOFF+MHFMCD) = 0.
- IQ(IOFF+KPNTL+MPPLCD) = 0
- DO 90 ILEV = 1, NLEVT
- KPNTN = KPNTL + NWLEV
- IPNTN = KPNTN
- NODET = 0
- DO 80 IN = 1, NITEM
- IPNT = KOFUCD + LFIXCD + (IN - 1) * NWITM
- IF (IQ(IPNT+1).NE.ILEV) GO TO 80
- NODE = IQ(IPNT+2)
- NCHR = IQ(IPNT+3)
- NCHRT = IQ(IPNT+4)
- CALL UHTOC (IQ(IPNT+5), 4, TOP1CT, 16)
- CALL UHTOC (IQ(IPNT+9), 4, PAT2CT, 80)
- PAT3CT = PAT2CT(1:NCHRT)//'/'//TOP1CT
- NCHRP = NCHRT + NCHR + 1
- IUP = 0
- IF (ILEV.GT.1) THEN
- DO 65 IM = 1, NITEM
- IPNT = KOFUCD + LFIXCD + (IM - 1) * NWITM
- IF (IQ(IPNT+1).NE.ILEV-1) GO TO 65
- NCHRU = IQ(IPNT+3)
- NCHRF = IQ(IPNT+4)
- IF (NCHRT.EQ.NCHRU+NCHRF+1) THEN
- CALL UHTOC (IQ(IPNT+5), 4, TOP2CT, 16)
- CALL UHTOC (IQ(IPNT+9), 4, PAT2CT, 80)
- PAT2CT = PAT2CT(1:NCHRF)//'/'//TOP2CT
- IF (PAT3CT(1:NCHRT).EQ.PAT2CT(1:NCHRT)) THEN
- IUP = IQ(IPNT+2)
- GO TO 70
- ENDIF
- ENDIF
- 65 CONTINUE
- ENDIF
- 70 NDOWN = 0
- IF (ILEV.LT.NLEVT) THEN
- DO 75 IM = 1, NITEM
- IPNT = KOFUCD + LFIXCD + (IM - 1) * NWITM
- IF (IQ(IPNT+1).NE.ILEV+1) GO TO 75
- NCHRU = IQ(IPNT+4)
- IF (NCHRP.EQ.NCHRU) THEN
- CALL UHTOC (IQ(IPNT+9), 4, PAT2CT, 80)
- IF (PAT3CT(1:NCHRP).EQ.PAT2CT(1:NCHRP)) NDOWN=NDOWN+1
- ENDIF
- 75 CONTINUE
- ENDIF
- NWDN = (NCHR + 3) / 4
- NTOT = NWDN + NWNOD
- NODET = NODET + 1
- IPNTN = KPNTN
- KPNTN = IPNTN + NTOT
- IQ(IOFF+IPNTN+MPNLCD) = KPNTN
- IQ(IOFF+IPNTN+MNNUCD) = NODE
- IQ(IOFF+IPNTN+MNFNCD) = IUP
- IQ(IOFF+IPNTN+MNDWCD) = NDOWN
- IQ(IOFF+IPNTN+MNCHCD) = NCHR
- Q(IOFF+IPNTN+MYFNCD) = 0.
- CALL UCTOH (TOP1CT, IQ(IOFF+IPNTN+MNAMCD), 4, NCHR)
- 80 CONTINUE
- IPNTL = KPNTL
- KPNTL = KPNTN
- IQ(IOFF+IPNTN+MPNLCD) = 0
- IQ(IOFF+IPNTL+MLEVCD) = ILEV
- IQ(IOFF+IPNTL+MNODCD) = NODET
- Q(IOFF+IPNTL+MXOFCD) = 0.
- Q(IOFF+IPNTL+MXWDCD) = 0.
- Q(IOFF+IPNTL+MYFLCD) = 0.
- IF (ILEV.LT.NLEVT) IQ(IOFF+KPNTL+MPPLCD) = IPNTL
- IF (NODET.GT.0) THEN
- IQ(IOFF+IPNTL+MPNNCD) = IPNTL + NWLEV
- IQ(IOFF+IPNTL+MPNLCD) = KPNTL
- ELSE
- IQ(IOFF+IPNTL+MPNNCD) = 0
- IQ(IOFF+IPNTL+MPNLCD) = KPNTL
- ENDIF
- 90 CONTINUE
- IQ(IOFF+IPNTL+MPNLCD) = 0
- ENDIF
- IF (LFIXCD.GT.0) CALL MZDROP (IDIVCD, LFIXCD, ' ')
-*
- IRC = 0
- 100 CALL RZCDIR (PAT4CT, ' ')
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- NKEYCK = IQUEST(7)
- NWKYCK = IQUEST(8)
-* END CDFPAT
- 999 END
diff --git a/src/packlib/hepdb/cdmdir/cdkeep.F b/src/packlib/hepdb/cdmdir/cdkeep.F
deleted file mode 100644
index c897b51..0000000
--- a/src/packlib/hepdb/cdmdir/cdkeep.F
+++ /dev/null
@@ -1,235 +0,0 @@
-*
-* $Id: cdkeep.F,v 1.1.1.1 1996/02/28 16:24:16 mclareni Exp $
-*
-* $Log: cdkeep.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:16 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDKEEP (PATHS, NPATH, CHOPT, IRC)
-* ============================================
-*
-************************************************************************
-* *
-* SUBR. CDKEEP (PATHS, NPATH, CHOPT, IRC*) *
-* *
-* Deletes all directory trees from the data base except the ones *
-* specified by the user *
-* *
-* Arguments : *
-* *
-* PATHS Path names to be kept *
-* NPATH Number of paths to be kept *
-* CHOPT Character string with any of the following characters *
-* B Save in the special backup file; not in standard Journal*
-* IRC Return Code (See below) *
-* *
-* Called by user *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* =211 : Illegal number of paths *
-* =212 : Illegal path name *
-* =213 : Conflicting top directory names *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
-#include "hepdb/ckkeys.inc"
-#include "hepdb/ctpath.inc"
- PARAMETER (NLEVM=20)
- DIMENSION NCHL(NLEVM)
- CHARACTER PATHY*255
- CHARACTER CNODE(NLEVM)*16
- CHARACTER*(*) PATHS(*), CHOPT
-*
-* ------------------------------------------------------------------
-*
-* *** Find the top directory name
-*
- IF (NPATH.LE.0) THEN
- IRC = 211
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDKEEP : Illegal'//
- + ' number of paths to be kept '',I12)', NPATH, 1)
-#endif
- GO TO 999
- ENDIF
- TOP1CT = ' '
- DO 10 IP = 1, NPATH
- CALL CDLDDI (PATHS(IP), PATHY, NCHR)
- IF (NCHR.LT.3.OR.PATHY(1:2).NE.'//') THEN
- IRC = 212
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDKEEP : Illeg'//
- + 'al path name '//PATHY//''')', IARGCD, 0)
-#endif
- GO TO 999
- ENDIF
- NCHRT = INDEX (PATHY(3:NCHR), '/') - 1
- IF (NCHRT.LE.0) NCHRT = NCHR - 2
- TOP2CT = PATHY(3:NCHRT+2)
- IF (TOP1CT.EQ.' ') THEN
- TOP1CT = TOP2CT
- ELSE IF (TOP2CT.NE.TOP1CT) THEN
- IRC = 213
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDKEEP : Confl'//
- + 'icting top-directories '//TOP1CT//' and '//TOP2CT//''')',
- + IARGCD, 0)
-#endif
- GO TO 999
- ENDIF
- 10 CONTINUE
-*
-* *** Now prepare the bank with all node names
-*
- LEVM = NLEVM
- PATHY = '//'//TOP1CT
- LSAVCD = 0
- CALL CDFPAT (PATHY, LEVM, LSAVCD, IRC)
- IF (IRC.NE.0) GO TO 100
- IF (LSAVCD.EQ.0) THEN
- IRC = 212
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDKEEP : Illegal'//
- + ' path name '//PATHY//''')', IARGCD, 0)
-#endif
- GO TO 999
- ENDIF
- NLEV = IQ(KOFUCD+LSAVCD+MNLVCD)
- IF (NLEV.LE.0) GO TO 100
-*
-* *** Loop over all the paths to be kept
-*
- DO 50 IP = 1, NPATH
- CALL CDLDDI (PATHS(IP), PATHY, NCHR)
-*
-* ** Find all the nodes in the path name
-*
- CALL CDPARS (PATHY, NLEVM, CNODE, NCHL, NODES)
-*
-* ** Now look up the complete list and mark the nodes to be kept
-*
- IPNL = IQ(KOFUCD+LSAVCD+MPNLCD)
- NLEV0 = MIN0 (NLEV, NODES)
- IUPN = 0
- DO 40 ILEV = 1, NLEV0
- NNODE = IQ(KOFUCD+LSAVCD+IPNL+MNODCD)
- IPNN = IQ(KOFUCD+LSAVCD+IPNL+MPNNCD)
- DO 20 INOD = 1, NNODE
- IF ((IQ(KOFUCD+LSAVCD+IPNN+MNCHCD).EQ.NCHL(ILEV)) .AND.
- + (IQ(KOFUCD+LSAVCD+IPNN+MNFNCD).EQ.IUPN)) THEN
- CALL UHTOC (IQ(KOFUCD+LSAVCD+IPNN+MNAMCD), 4, TOP2CT,
- + NCHL(ILEV))
- IF (TOP2CT(1:NCHL(ILEV)).EQ.CNODE(ILEV)) THEN
- IUPN = INOD
- Q(KOFUCD+LSAVCD+IPNN+MYFNCD) = 1.0
- GO TO 30
- ENDIF
- ENDIF
- IPNN = IQ(KOFUCD+LSAVCD+IPNN+MPNLCD)
- 20 CONTINUE
- GO TO 50
- 30 IPNL = IQ(KOFUCD+LSAVCD+IPNL+MPNLCD)
- 40 CONTINUE
-*
- 50 CONTINUE
-*
-* *** Now delete the unmarked directories
-*
- IPNL = IQ(KOFUCD+LSAVCD+MPNLCD)
- DO 90 ILEV =1, NLEV
- NNODE = IQ(KOFUCD+LSAVCD+IPNL+MNODCD)
- IPNN = IQ(KOFUCD+LSAVCD+IPNL+MPNNCD)
- DO 85 INOD = 1, NNODE
- IF (Q(KOFUCD+LSAVCD+IPNN+MYFNCD).EQ.0.) THEN
- IF (ILEV.EQ.2) THEN
- NCHR = IQ(KOFUCD+LSAVCD+IPNN+MNCHCD)
- CALL UHTOC (IQ(KOFUCD+LSAVCD+IPNN+MNAMCD), 4, TOP2CT,NCHR)
- IF ((NCHR.EQ.10.AND.TOP2CT(1:NCHR).EQ.'DICTIONARY').OR.
- + (NCHR.EQ.4 .AND.TOP2CT(1:NCHR).EQ.'HELP')) GO TO 80
- ENDIF
-*
-* ** Delete the tree from here; construct the path name first
-*
- IUPN = INOD
- NCHRT = 0
- PAT4CT = ' '
- DO 65 KLEV = 1, ILEV
- JLEV = ILEV + 1 - KLEV
- IPNLC = IQ(KOFUCD+LSAVCD+MPNLCD)
- IF (JLEV.GT.1) THEN
- DO 55 IL = 2, JLEV
- 55 IPNLC = IQ(KOFUCD+LSAVCD+IPNLC+MPNLCD)
- ENDIF
- IPNNC = IQ(KOFUCD+LSAVCD+IPNLC+MPNNCD)
- IF (IUPN.GT.1) THEN
- DO 60 IN = 2, IUPN
- 60 IPNNC = IQ(KOFUCD+LSAVCD+IPNNC+MPNLCD)
- ENDIF
- NCHR = IQ(KOFUCD+LSAVCD+IPNNC+MNCHCD)
- IUPN = IQ(KOFUCD+LSAVCD+IPNNC+MNFNCD)
- CALL UHTOC (IQ(KOFUCD+LSAVCD+IPNNC+MNAMCD), 4,TOP2CT,NCHR)
- PAT1CT = '/'//TOP2CT(1:NCHR)
- NCHR = NCHR + 1
- IF (NCHRT.GT.0) THEN
- PATHY = PAT1CT(1:NCHR)//PAT4CT(1:NCHRT)
- ELSE
- PATHY = PAT1CT
- ENDIF
- PAT4CT = PATHY
- NCHRT = NCHRT + NCHR
- 65 CONTINUE
- PATHY = '/'//PAT4CT
-*
-* ** Now delete the tree
-*
- CALL CDDDIR (PATHY, CHOPT, IRC)
- IF (IRC.NE.0) GO TO 100
-*
-* ** Now mark all down nodes from here to be nonexistent
-*
- NND = IQ(KOFUCD+LSAVCD+IPNN+MNDWCD)
- IF (ILEV.LT.NLEV.AND.NND.GT.0) THEN
- IPNLC = IQ(KOFUCD+LSAVCD+IPNL+MPNLCD)
- KLEV = ILEV + 1
- NCHL(KLEV) = INOD
- 70 IF (KLEV.GT.ILEV) THEN
- NODES = IQ(KOFUCD+LSAVCD+IPNLC+MNODCD)
- IPNNC = IQ(KOFUCD+LSAVCD+IPNLC+MPNNCD)
- DO 75 IN = 1, NODES
- IF ((Q(KOFUCD+LSAVCD+IPNNC+MYFNCD).EQ.0.0) .AND.
- + (NCHL(KLEV).EQ.IQ(KOFUCD+LSAVCD+IPNNC+MNFNCD)))THEN
- Q(KOFUCD+LSAVCD+IPNNC+MYFNCD) = 1.0
- NND = IQ(KOFUCD+LSAVCD+IPNNC+MNDWCD)
- IF (KLEV.LT.NLEV.AND.NND.GT.0) THEN
- KLEV = KLEV + 1
- IPNLC = IQ(KOFUCD+LSAVCD+IPNLC+MPNLCD)
- NCHL(KLEV) = IN
- GO TO 70
- ENDIF
- ENDIF
- IPNNC = IQ(KOFUCD+LSAVCD+IPNNC+MPNLCD)
- 75 CONTINUE
- KLEV = KLEV - 1
- IPNLC = IQ(KOFUCD+LSAVCD+IPNLC+MPPLCD)
- GO TO 70
- ENDIF
- ENDIF
-*
- ENDIF
- 80 IPNN = IQ(KOFUCD+LSAVCD+IPNN+MPNLCD)
- 85 CONTINUE
- IPNL = IQ(KOFUCD+LSAVCD+IPNL+MPNLCD)
- 90 CONTINUE
- IRC = 0
-*
- 100 IF (LSAVCD.NE.0) THEN
- CALL MZDROP (IDIVCD, LSAVCD, 'L')
- LSAVCD = 0
- ENDIF
-* END CDKEEP
- 999 END
diff --git a/src/packlib/hepdb/cdmdir/cdmdir.F b/src/packlib/hepdb/cdmdir/cdmdir.F
deleted file mode 100644
index e05afa4..0000000
--- a/src/packlib/hepdb/cdmdir/cdmdir.F
+++ /dev/null
@@ -1,187 +0,0 @@
-*
-* $Id: cdmdir.F,v 1.1.1.1 1996/02/28 16:24:16 mclareni Exp $
-*
-* $Log: cdmdir.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:16 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDMDIR (PATH, NKEX, CHFOR, CHTAG, MXKP, IPREC, DELTA,
- + CHOPT, IRC)
-* ================================================================
-*
-************************************************************************
-* *
-* SUBR. CDMDIR (PATH, NKEX, CHFOR, CHTAG, MXKP, IPREC, DELTA, *
-* CHOPT, IRC*) *
-* *
-* Creates a HEPDB directory with standard keys plus NKEX extra keys *
-* *
-* Arguments : *
-* *
-* PATH Character string describing the pathname *
-* NKEX Number of user keys *
-* CHFOR Character string specifying the user key type *
-* CHTAG String of 8-character tags for the user key elements *
-* MXKP Maximum number of objects in a partitioned directory *
-* IPREC Precision word sepcifying the number of significant *
-* digits to be stored; (If IPREC > 0, data are stored *
-* with IPREC significant digits right to the decimal *
-* points; if IPREC < 0, data are stored with IPREC *
-* insignificant digits left to the decimal point.) *
-* DELTA Variable specifying the absolute value below which data *
-* is treated as zero *
-* CHOPT Character string with any of the following characters *
-* C Data in the directory will be compressed by default *
-* P Create partitioned subdirectories for the pathname *
-* IRC Return code (see below) *
-* *
-* Called by user *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* = 43 : Illegal number of user keys *
-* = 44 : Cannot find the top directory name *
-* (wrong initialisation) *
-* = 45 : Illegal Path name *
-* *
-************************************************************************
-*
-#include "hepdb/caopti.inc"
-#include "hepdb/caopts.inc"
-#include "hepdb/cdcblk.inc"
-#include "hepdb/ckkeys.inc"
-#include "hepdb/ctpath.inc"
- CHARACTER*(*) PATH, CHTAG(*), CHFOR, CHOPT
- CHARACTER PATHN*80, CFOR*100
-*
-* ------------------------------------------------------------------
-*
-* *** Decode the character option
-*
- CALL CDOPTS (CHOPT, IRC)
- IF (IRC.NE.0) GO TO 999
- KEY7CK = 0
-*
-* *** Remove imbedded blanks from the path name
-*
- CALL CDSBLC (PATH, PAT2CT, NCH)
- IF (NCH.EQ.0) THEN
- IRC = 45
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) THEN
- PAT2CT = PATH
- CALL CDPRNT (LPRTCD, '(/,'' CDMDIR : Illegal path name '//
- + PAT2CT//''')', IARGCD, 0)
- ENDIF
-#endif
- GO TO 999
- ENDIF
-*
-* *** Load top directory information
-*
- IF (PAT2CT(1:2).EQ.'//') THEN
- CALL CDTOPN (PAT2CT, TOP2CT, NCHAR)
- PAT3CT = '//'//TOP2CT(1:NCHAR)
- CALL CDLDUP (PAT3CT, 1, IRC)
- ELSE IF (PAT2CT(1:1).EQ.'~' .OR. PAT2CT(1:1).EQ.'_') THEN
- CALL RZNDIR (PAT3CT, 'R')
- IF (IQUEST(1).NE.0) THEN
- IRC = 44
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT(LPRTCD, '(/,'' CDMDIR : Cannot'//
- + ' find the top directory '')', IARGCD, 0)
-#endif
- GO TO 999
- ENDIF
- CALL CDLDUP (PAT3CT, 1, IRC)
- ELSE
- CALL CDLDUP (PAT2CT, -1, IRC)
- ENDIF
- IF (IRC.NE.0) GO TO 999
-*
-* *** Get the complete path name
-*
- IF (PAT2CT(1:2).EQ.'//') THEN
-*
- PATHN = PAT2CT
- ELSE IF (PAT2CT(1:1).EQ.'/') THEN
-*
- PATHN = '//'//TOPNCD(1:NCHRCD)//PAT2CT
-#if defined(CERNLIB_APOF77)||defined(CERNLIB_BSLASH)||defined(CERNLIB_HPUX)||defined(CERNLIB_IBMRT)||defined(CERNLIB_QMALPH)||defined(CERNLIB_QMVAOS)
- ELSE IF (PAT2CT(1:1).EQ.'\\') THEN
-#endif
-#if (!defined(CERNLIB_APOF77))&&(!defined(CERNLIB_BSLASH))&&(!defined(CERNLIB_HPUX))&&(!defined(CERNLIB_IBMRT))&&(!defined(CERNLIB_QMALPH))&&(!defined(CERNLIB_QMVAOS))
- ELSE IF (PAT2CT(1:1).EQ.CSTRCA(92:92)) THEN
-#endif
- IL = 0
- DO 10 I0 = 1, MAXLCD
- IF (PAT1CT(I0:I0).EQ.'/') IL = I0
- 10 CONTINUE
- IF (IL.LE.1) THEN
- IRC = 45
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDMDIR : '//
- + 'Illegal path name '//PAT2CT//''')', IARGCD, 0)
-#endif
- GO TO 999
- ENDIF
- PATHN = PAT1CT(1:IL-1)//'/'//PAT2CT(2:NCH)
- ELSE IF (PAT2CT(1:1).EQ.'~' .OR. PAT2CT(1:1).EQ.'_') THEN
-*
- IL = LENOCC (PAT1CT)
- PATHN = PAT1CT(1:IL)//'/'//PAT2CT(2:NCH)
- ELSE
-*
- IL = LENOCC (PAT1CT)
- PATHN = PAT1CT(1:IL)//'/'//PAT2CT(1:NCH)
- ENDIF
-*
-* *** Check the number of user keys
-*
- IF (NKEX.LT.0.OR.NKEX+2*NPARCD.GT.MXDMCK-NOF2CK) THEN
- IRC = 43
- IQUEST(11) = NKEX
- IQUEST(12) = MXDMCK - NOF2CK - 2*NPARCD
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) THEN
- CALL CDPRNT (LPRTCD, '(/,'' CDMDIR : Illegal number of user'//
- + ' keys '',2I12,'' for '',/,'' '//PAT2CT//''')',
- + IQUEST(11), 2)
- ENDIF
-#endif
- GO TO 999
- ENDIF
-*
-* *** Prepare the Tag and Type of the keys
-*
- NSYS = NOF2CK + NPARCD * 2
- CFOR = CHFTCK(1:NSYS)
- DO I = 1, NSYS
- CTAGCK(I) = CHTGCK(I)
- ENDDO
- DO I = 1, NPARCD
- CFOR(NOF1CK+2*I-1:NOF1CK+2*I-1) = 'I'
- CFOR(NOF1CK+2*I :NOF1CK+2*I ) = 'I'
- CTAGCK(NOF1CK+2*I-1) = 'STR_VAL'//CALFCA(27+I)
- CTAGCK(NOF1CK+2*I) = 'END_VAL'//CALFCA(27+I)
- ENDDO
- DO K = 1, NKEX
- CTAGCK(NSYS+K) = CHTAG(K)
- CFOR(NSYS+K:NSYS+K) = CHFOR(K:K)
- ENDDO
- NWKEY = NOF2CK + 2*NPARCD + NKEX
-*
-* *** Now create the directory
-*
- IF (MXKP.LE.0) THEN
- MXKPU = MXKPCK
- ELSE
- MXKPU = MXKP
- ENDIF
- CALL CDMKDI (PATHN, NWKEY, CFOR, CTAGCK, MXKPU, IPREC, DELTA,
- + CHOPT, IRC)
-* END CDMDIR
- 999 END
diff --git a/src/packlib/hepdb/cdmdir/cdmkdi.F b/src/packlib/hepdb/cdmdir/cdmkdi.F
deleted file mode 100644
index 68af185..0000000
--- a/src/packlib/hepdb/cdmdir/cdmkdi.F
+++ /dev/null
@@ -1,334 +0,0 @@
-*
-* $Id: cdmkdi.F,v 1.1.1.1 1996/02/28 16:24:16 mclareni Exp $
-*
-* $Log: cdmkdi.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:16 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
-#if defined(CERNLIB__P3CHILD)
-* Ignoring t=dummy
-#endif
- SUBROUTINE CDMKDI (PATHN, NWKEY, CHFOR, CHTAG, MXKP, IPREC, DELTA,
- + CHOPT, IRC)
-* ==================================================================
-*
-************************************************************************
-* *
-* SUBR. CDMKDI (PATHN, NWKEY, CHFOR, CHTAG, MXKP, IPREC, DELTA, *
-* CHOPT, IRC*) *
-* *
-* Creates Directories with the conventions of HEPDB package for *
-* partitioned and normal data sets *
-* *
-* Arguments : *
-* *
-* PATHN Path name of the directory *
-* NWKEY Number of words associated to the keys at the lowest *
-* level (If some directory in the pathname at a higher *
-* level does not exist, it is created with 9 keys) *
-* CHFOR Character variable describing each element of the key *
-* vector at the lowest level (at higher level it is set *
-* to default, i.e., 'IIIIIIIII') *
-* CHTAG Character array defined as CHARACTER*8 (NWKEY) *
-* MXKP Maximum number of objects in each partition *
-* IPREC Precision word sepcifying the number of significant *
-* digits to be stored; (If IPREC > 0, data are stored *
-* with IPREC significant digits right to the decimal *
-* points; if IPREC < 0, data are stored with IPREC *
-* insignificant digits left to the decimal point.) *
-* DELTA Variable specifying the absolute value below which data *
-* is treated as zero *
-* CHOPT Character string with any of the following characters *
-* C Data in the directory will be compressed by default *
-* P Create partitioned subdirectories for the pathname *
-* IRC Return code (see below) *
-* *
-* Called by CDDONT, CDENFZ, CDENTB, CDFZUP, CDMDIR, CDKOUT, CDPART *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* = 47 : The Directory already exists *
-* = 48 : Error in directory search sequence *
-* *
-************************************************************************
-*
-#include "hepdb/caopts.inc"
-#include "hepdb/cdcblk.inc"
-#include "hepdb/cinitl.inc"
-#include "hepdb/ckkeys.inc"
-#include "hepdb/clinks.inc"
-#include "hepdb/ctpath.inc"
- PARAMETER (JBIAS=2)
- CHARACTER*(*) PATHN, CHFOR, CHOPT, CHTAG(*)
- CHARACTER PATHL*255
-#include "zebra/q_jbit.inc"
-* Ignoring t=pass
-#include "zebra/q_sbit.inc"
-* Ignoring t=pass
-*
-* ------------------------------------------------------------------
-*
-* *** Assumes the top directory information is already loaded
-*
- KEY7 = KEY7CK
- KEY7CK = 0
- PATHL = ' '
- IRC = 0
- ICMPF = IOPCCA
- MXK = MXKP
- NSYS = NOF2CK + 2*NPARCD
- IF (MXK.LT.1) MXK = MXKPCK
- IF (IOPZCA.EQ.1) ICMPF = 2
-*
-* *** Check if the directory exists as yet
-*
- IENCH = NCHRCD + 1
- I = NCHRCD + 2
- IP = NCHRCD + 3
- ISTCH = IP
- NCH = LENOCC (PATHN)
- IPART = 0
- IF (IP.LE.NCH) THEN
- CALL RZCDIR (PATHN, 'Q')
- IF (IQUEST(1).EQ.0) THEN
- NKEYCK = IQUEST(7)
- NWKYCK = IQUEST(8)
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- IF (NKEYCK.GT.0)
- + IPART = JBIT (IQ(KOFSCD+LCDRCD+IKDRCD+IDHFLG), JPRTCD)
- IF (IOKYCA(IDHKSN).EQ.0) THEN
- IF (IPART.EQ.0) THEN
- IRC = 47
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) THEN
- PAT3CT = PATHN
- CALL CDPRNT (LPRTDB, '(/,'' CDMKDI : Existing directo'//
- + 'ry is in conflict with Path name '',/,9X,'' '//
- + PAT3CT//' '')', IARGDB, 0)
- ENDIF
-#endif
-#if !defined(CERNLIB__P3CHILD)
- ELSE IF (IOPPCD.EQ.0) THEN
- GO TO 30
-#endif
- ENDIF
- ENDIF
- GO TO 999
- ELSE
- IPART = IOPPCA
- ENDIF
- ENDIF
-*
-* *** Save the Directory creation information in the FZ file
-*
- CALL CDSDIR (PATHN, NWKEY, CHFOR, CHTAG, MXK, IPREC, DELTA,
- + CHOPT, IRC)
- IF (IOPPCD.NE.0.OR.IRC.NE.0) GO TO 999
-#if defined(CERNLIB__P3CHILD)
- GO TO 999
-#endif
-#if !defined(CERNLIB__P3CHILD)
-*
-* *** Create a new (tree of) director(ies) - from the first
-* *** non-existing name
-* *** Go down to the lowest existing directory in PATHN
-*
- 10 I = I + 1
- IF (PATHN(I:I).EQ.'/') THEN
- CALL RZCDIR (PATHN(1:I-1), 'Q')
- IF (IQUEST(1).NE.0) GO TO 15
- IENCH = I -1
- ELSE IF (I.GE.NCH) THEN
- CALL RZCDIR (PATHN(1:I), 'Q')
- IF (IQUEST(1).NE.0) GO TO 15
- GO TO 30
- ENDIF
- GO TO 10
-*
-* *** Lock the directory if needed
-*
- 15 IF (IOPSCD.NE.0) THEN
- PATHL = PATHN(1:IENCH)
- CALL RZCDIR (PATHL, ' ')
- CALL RZLOCK ('CDMKDI')
- ENDIF
-*
-* *** Create new directories
-*
- ISTCH = IENCH + 2
- IF (ISTCH.GT.NCH) GO TO 90
- TOP1CT = PATHN(ISTCH:ISTCH)
- J = 0
- ISTCH = ISTCH + 1
- I = ISTCH
- 20 IF (PATHN(I:I).EQ.'/') THEN
- CALL RZCDIR (PATHN(1:IENCH), ' ')
-*
-* ** Create the intermediate level directory with default values
-*
- CALL RZMDIR (TOP1CT, NSYS, CHFOR, CHTAG)
- IF (IQUEST(1).NE.0) GO TO 90
- IF (PATHL.NE.' ') THEN
- CALL RZCDIR (PATHL, ' ')
- CALL RZFREE ('CDMKDI')
- PATHL = ' '
- CALL RZCDIR (PATHN(1:IENCH), ' ')
- ENDIF
- CALL CDCDIC (TOP1CT, ICMPF, IPREC, DELTA, IRC)
- IF (IRC.NE.0) GO TO 95
- IF (IOPSCD.NE.0) THEN
- PATHL = PATHN(1:IENCH)
- CALL RZCDIR (PATHL, ' ')
- CALL RZLOCK ('CDMKDI')
- ENDIF
-#endif
-#if (defined(CERNLIB__DEBUG))&&(!defined(CERNLIB__P3CHILD))
- IF (IDEBCD.GT.2) CALL RZLDIR (' ', ' ')
-#endif
-#if !defined(CERNLIB__P3CHILD)
- IENCH = I - 1
- I = I + 1
- TOP1CT = PATHN(I:I)
- J = 0
-*
- ELSE
- J = J + 1
- TOP1CT = TOP1CT(1:J)//PATHN(I:I)
- ENDIF
- IF (I.LT.NCH) THEN
- I = I + 1
- GO TO 20
- ENDIF
-*
- IF (IENCH.GE.0) CALL RZCDIR (PATHN(1:IENCH),' ')
- CALL RZMDIR (TOP1CT, NWKEY, CHFOR, CHTAG)
- IF (IQUEST(1).NE.0) GO TO 90
- IF (PATHL.NE.' ') THEN
- CALL RZCDIR (PATHL, ' ')
- CALL RZFREE ('CDMKDI')
- PATHL = ' '
- IF (IENCH.GE.0) CALL RZCDIR (PATHN(1:IENCH), ' ')
- ENDIF
- CALL CDCDIC (TOP1CT, ICMPF, IPREC, DELTA, IRC)
- IF (IRC.NE.0) GO TO 95
- IF (IOPSCD.NE.0) THEN
- PATHL = PATHN(1:IENCH)
- CALL RZCDIR (PATHL, ' ')
- CALL RZLOCK ('CDMKDI')
- ENDIF
-#endif
-#if (defined(CERNLIB__DEBUG))&&(!defined(CERNLIB__P3CHILD))
- IF (IDEBCD.GT.2) CALL RZLDIR (' ', ' ')
-#endif
-#if !defined(CERNLIB__P3CHILD)
- CALL RZCDIR (PATHN, ' ')
- IF (IQUEST(1).NE.0) GO TO 90
- IF (IPART.EQ.0) GO TO 95
-*
-* *** Now create Partitioned subdirectory
-*
- 30 NK = IQUEST(7)
- CALL VZERO (KEYNCK, NSYS)
- IF (NK.GT.0) THEN
-*
-* ** Get the keys of the last data inserted
-*
- CALL CDPATH (TOP1CT, NK)
- CALL RZCDIR (TOP1CT, ' ')
- IF (IQUEST(1).NE.0) GO TO 90
- NKEYCK = IQUEST(7)
- NWKYCK = IQUEST(8)
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- ISTP = NWKYCK + 1
- IPNT = KOFSCD + LCDRCD + IKDRCD
- KEYNCK(MOBJCD) = IQ(IPNT+IDHKSN)
- IF (NKEYCK.GT.1) THEN
- DO 35 IK = 2, NKEYCK
- IPNT = IPNT + ISTP
- IF (KEYNCK(MOBJCD).LT.IQ(IPNT+IDHKSN))
- + KEYNCK(MOBJCD) = IQ(IPNT+IDHKSN)
- 35 CONTINUE
- ENDIF
- ENDIF
-*
-* ** Fill up the remaining keys
-*
- KEYNCK(MPSRCD) = NK + 1
- KEYNCK(MXKPCD) = MXK
- DO 40 I = 1, NPARCD
- KEYNCK(NOF1CK+2*I-1) = IBIGCD
- KEYNCK(NOF1CK+2*I) = 0
- 40 CONTINUE
- KEYNCK(IDHFLG) = MSBIT1 (KEYNCK(IDHFLG), JPRTCD)
- IF (KEY7.EQ.0) THEN
- CALL DATIME (IDATE, ITIME)
- CALL CDPKTM (IDATE, ITIME, KEYNCK(IDHINS), IRC)
- ELSE
- KEYNCK(IDHINS) = KEY7
- ENDIF
- IF (NWKEY.GT.NSYS) THEN
- DO 50 IK = NSYS+1, NWKEY
- IF (CHFOR(IK:IK).EQ.'A'.OR.CHFOR(IK:IK).EQ.'H') THEN
- CALL UCTOH (' ', KEYNCK(IK), 4, 4)
- ELSE
- KEYNCK(IK) = 0
- ENDIF
- 50 CONTINUE
- ENDIF
-*
-* ** Insert a keyname for the new partition
-*
- CALL RZCDIR (PATHN, ' ')
- IF (IOPSCD.NE.0) THEN
- IF (PATHL.EQ.' ') THEN
- PATHL = PATHN
- CALL RZLOCK ('CDMKDI')
- ENDIF
- ENDIF
- IF (LSTRCL(3).NE.0) CALL MZDROP (IDISCD, LSTRCL(3), ' ')
- CALL CDBANK (IDISCD, LSTRCL(3), LSTRCL(3), JBIAS, 'SAME', 0, 0, 0,
- + 2, 0, IRC)
- IF (IRC.NE.0) GO TO 95
- CALL RZOUT (IDISCD, LSTRCL(3), KEYNCK, ICYCLE, 'S')
- CALL MZDROP (IDISCD, LSTRCL(3), ' ')
- LSTRCL(3) = 0
- CALL CDPATH (TOP1CT, KEYNCK(MPSRCD))
- CALL RZMDIR (TOP1CT, NWKEY, CHFOR, CHTAG)
- IF (IQUEST(1).NE.0) THEN
- CALL RZDELK (KEYNCK, ICYCLE, 'C')
- GO TO 90
- ENDIF
-#endif
-#if (defined(CERNLIB__DEBUG))&&(!defined(CERNLIB__P3CHILD))
- IF (IDEBCD.GT.2) CALL RZLDIR (' ', ' ')
-#endif
-#if !defined(CERNLIB__P3CHILD)
- GO TO 95
-*
-* *** Error Messages
-*
- 90 IRC = 48
- IQUEST(11) = ISTCH
- IQUEST(12) = NCH
-#endif
-#if (defined(CERNLIB__DEBUG))&&(!defined(CERNLIB__P3CHILD))
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDMKDI : Error in '//
- + 'Directory Search - ISTCH = '',I5,'' NCH = '',I5)', IQUEST(11),
- + 2)
-#endif
-#if !defined(CERNLIB__P3CHILD)
-*
-* *** Unlock the directory if required
-*
- 95 IF (PATHL.NE.' ') THEN
- CALL RZCDIR (PATHL, ' ')
- CALL RZFREE ('CDMKDI')
- ENDIF
-#endif
-* END CDMKDI
- 999 END
diff --git a/src/packlib/hepdb/cdmdir/cdpart.F b/src/packlib/hepdb/cdmdir/cdpart.F
deleted file mode 100644
index f810ee2..0000000
--- a/src/packlib/hepdb/cdmdir/cdpart.F
+++ /dev/null
@@ -1,684 +0,0 @@
-*
-* $Id: cdpart.F,v 1.1.1.1 1996/02/28 16:24:16 mclareni Exp $
-*
-* $Log: cdpart.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:16 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
-#if defined(CERNLIB__P3CHILD)
-* Ignoring t=dummy
-#endif
- SUBROUTINE CDPART (PATHI, PATHO, MXKP0, CHOPT, IRC)
-* ===================================================
-*
-************************************************************************
-* *
-* SUBR. CDPART (PATHI, PATHO, MXKP0, CHOPT, IRC*) *
-* *
-* Transforms the contents of a non-partitioned directory to a *
-* partitioned directory. *
-* *
-* Arguments : *
-* *
-* PATHI Character string describing the input pathname *
-* PATHO Character string describing the output pathname *
-* MXKP0 Maximum number of objects in the partitioned directory *
-* CHOPT Character string with any of the following characters *
-* B Save in the special backup file; not in standard Journal*
-* F Updates with a fully matched data object (in user keys) *
-* IRC Return code (see below) *
-* *
-* Called by user *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* = 68 : Input directory is partitioned *
-* = 71 : Illegal path name *
-* = 73 : RZOUT fails to write on disk *
-* = 74 : Error in RZRENK in updating key values for *
-* partitioned data set *
-* = 76 : Cannot form the IO descriptor for the FZ header *
-* = 77 : FZOUT fails to write on to the sequential file *
-* *
-************************************************************************
-*
-#include "hepdb/caopts.inc"
-#include "hepdb/cdcblk.inc"
-#include "hepdb/cfzlun.inc"
-#include "hepdb/cinitl.inc"
-#include "hepdb/ckkeys.inc"
-#include "hepdb/clinks.inc"
-#include "hepdb/csavbk.inc"
-#include "hepdb/ctpath.inc"
-#include "hepdb/czpack.inc"
-#if defined(CERNLIB__P3CHILD)
-#include "hepdb/p3dbl3.inc"
-#endif
- PARAMETER (NLEVM=20, JBIAS=2)
- INTEGER NLCUR(NLEVM), ITIME(MXPACD)
- CHARACTER PATHY*255, PATHN*255, PATHX*16, CHFOR*100, CHOP0*4
- CHARACTER CHCUR(NLEVM)*1, CHOPS(NSVMCS)*4, CFORM(6)*1
- CHARACTER PATHI*(*), PATHO*(*), CHOPT*(*), CHOP*2, CHFRM*100
- DATA CFORM /'B', 'I', 'F', 'D', 'H', 'A'/
-#include "zebra/q_jbit.inc"
-* Ignoring t=pass
-*
-* ------------------------------------------------------------------
-*
-* *** Decode character option etc.
-*
- CALL CDOPTS (' ', IRC)
- CALL UOPTC (CHOPT, 'B', IOPBCA)
- CALL CDSBLC (PATHO, PATHY, NCHAR)
-*
-* *** Load top directory information; gets in PAT1CT complete path name
-*
- CALL CDLDUP (PATHI, 1, IRC)
- IF (IRC.NE.0) GO TO 999
- PATHN = PAT1CT
- PATHX = ' '
-*
-* *** Set the current directory for input path name
-*
- CALL RZCDIR (PATHN, ' ')
- NKEYCK = IQUEST(7)
- NWKYCK = IQUEST(8)
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- KST = NWKYCK + 1
- NWKEY = NWKYCK
- CALL CDKYTG
- IF (NKEYCK.NE.0) THEN
- IOPTP = JBIT (IQ(KOFSCD+LCDRCD+IKDRCD+IDHFLG), JPRTCD)
- ELSE
- IOPTP = 0
- ENDIF
- IF (IOPTP.NE.0) THEN
- IRC = 68
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDPART : Directo'//
- + 'ry '//PATHN//' is partitioned '')', IARGCD, 0)
-#endif
- GO TO 999
- ENDIF
-*
-* *** Load IPREC/DELTA from dictionary; choose the transcript file
-*
- CALL CDLDIC (PATHN, 1, IRC)
- IF (IRC.NE.0) GO TO 999
-*
-* *** Prepare the partitioned directory
-*
- NKEYS = NKEYCK
- CHFOR = ' '
- DO 10 IK = 1, NWKEY
- IF (IOTYCK(IK).GT.0.AND.IOTYCK(IK).LT.7) THEN
- CHFOR(IK:IK) = CFORM(IOTYCK(IK))
- ELSE
- CHFOR(IK:IK) = CFORM(2)
- ENDIF
- 10 CONTINUE
- IF (ICMPCD.EQ.2) THEN
- CHOP = 'ZP'
- ELSE IF (ICMPCD.NE.0) THEN
- CHOP = 'CP'
- ELSE
- CHOP = 'P '
- ENDIF
- CALL CDMKDI (PATHY, NWKEY, CHFOR, CTAGCK, MXKP0, IPRECD,
- + DELTCD, CHOP, IRC)
- IF (IRC.NE.0) GO TO 999
- IF (NKEYS.LE.0) GO TO 999
-*
-* *** Find the appropriate FZ file number
-*
- IF (IOPBCA.EQ.0) THEN
- LUFZCF = LUFZCD
- ELSE
- LUFZCF = LUBKCD
- ENDIF
-#if (defined(CERNLIB_IBMVM)||defined(CERNLIB_UNIX)||defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))
-*
- IF (IOPPCD.NE.0) THEN
-#endif
-#if (defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))&&(!defined(CERNLIB__P3CHILD))&&(defined(CERNLIB__ONLINE))
- LUFZCF = LUFMCD
-#endif
-#if (defined(CERNLIB_IBMVM)||defined(CERNLIB_UNIX)||defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))&&(!defined(CERNLIB__P3CHILD))&&(!defined(CERNLIB__ONLINE))
- CALL CDSTSV (TOPNCD, 0, IRC)
- IF (IRC.NE.0) GO TO 999
-#endif
-#if defined(CERNLIB__P3CHILD)
- LUFZCF = LODBP3
-#endif
-#if (defined(CERNLIB_IBMVM)||defined(CERNLIB_UNIX)||defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))
- ENDIF
-#endif
-*
-* *** Partially fill up the header
-*
- NDOP = 1
- IF (LUFZCF.GT.0) THEN
- NCHR = LENOCC (PATHY)
- NWDP = (NCHR + 3) / 4
- NWDH = NWDP + NDOP + NWKYCK + 5
- IHEDCF(MACTCF) = 1
- IHEDCF(MNKYCF) = NWKYCK
- IHEDCF(MOPTCF) = NDOP
- IHEDCF(MPATCF) = NWDP
- CALL UCTOH (PATHY, IHEDCF(NWKYCK+NDOP+MPRECF+1), 4, 4*NWDP)
- ENDIF
-*
-* *** Start reading in records from the input file
-*
- ISTR = 0
- DO 15 I = 1, NPARCD
- ITIME(I) = 1
- 15 CONTINUE
- 20 NOBJCS = 0
- IOPKCA = 0
- PACKCZ = .FALSE.
- CALL RZCDIR (PATHN, ' ')
- NKEYCK = IQUEST(7)
- NWKYCK = IQUEST(8)
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- DO 25 IK = 1, NSVMCS
- ISTR = ISTR + 1
- IF (ISTR.LE.NKEYS) THEN
- NOBJCS = NOBJCS + 1
- KEYSCS(IDHKSN,NOBJCS) = ISTR
- IOKYCA(IDHKSN) = 1
- CALL CDKXIN (ITIME, IDISCD, LOBJCS(NOBJCS), LOBJCS(NOBJCS),
- + JBIAS, NWKEY, KEYSCS(1,NOBJCS), IPREC, IRC)
- IOKYCA(IDHKSN) = 0
- IF (IRC.NE.0) GO TO 997
- IF (JBIT(KEYSCS(IDHFLG,NOBJCS),JRZUCD).NE.0) THEN
- IF (JBIT(KEYSCS(IDHFLG,NOBJCS),JASFCD).NE.0) THEN
- CHOPS(NOBJCS) = 'HTY'
- ELSE
- CHOPS(NOBJCS) = 'HY'
- ENDIF
- ELSE
- CALL CDRZIN (IDISCD, LSTRCL(2), 2, ISTR, ICYCL, PATHN, IRC)
- IF (IRC.NE.0) THEN
- CALL MZDROP (IDISCD, LSTRCL(2), 'L')
- GO TO 997
- ENDIF
- CALL UCOPY (Q(KOFUCD+LSTRCL(2)+3), IXX, 1)
- IF (IQ(KOFUCD+LSTRCL(2)+1).EQ.0) THEN
- IF (KEYSCS(IDHPTR,NOBJCS).EQ.0) THEN
- CHOPS(NOBJCS) = 'H'
- ELSE
- CHOPS(NOBJCS) = 'HD'
- ENDIF
- ELSE
- PACKCZ = (JBIT(IXX,32).EQ.0)
- IF (PACKCZ) THEN
- IDTY = ICDTYP (LSTRCL(2))
- IF (IDTY.EQ.3) THEN
- PRECCZ = Q(KOFUCD+LSTRCL(2)+2)
- ELSE
- PRECCZ = IQ(KOFUCD+LSTRCL(2)+2)
- ENDIF
- IF (KEYSCS(IDHPTR,NOBJCS).EQ.0) THEN
- CHOPS(NOBJCS) = 'HZ'
- ELSE
- CHOPS(NOBJCS) = 'HZD'
- ENDIF
- ELSE
- IF (KEYSCS(IDHPTR,NOBJCS).EQ.0) THEN
- CHOPS(NOBJCS) = 'HP'
- ELSE
- CHOPS(NOBJCS) = 'HPD'
- ENDIF
- ENDIF
- ENDIF
- CALL MZDROP (IDISCD, LSTRCL(2), 'L')
- ENDIF
- ENDIF
- 25 CONTINUE
-*
-* *** Set the current directory to the output directory
-*
- CALL RZCDIR (PATHY, ' ')
- NKEYCK = IQUEST(7)
- NWKYCK = IQUEST(8)
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- KPNT = IUHUNT (NKEYCK, IQ(KOFSCD+LCDRCD+IKDRCD+MPSRCD),
- + NKEYCK*KST, KST)
- IF (KPNT.NE.0) THEN
- NK = (KPNT - MPSRCD) / KST + 1
- ELSE
- NK = NKEYCK
- ENDIF
- CALL CDKEYR (NK, NWKYCK, KYP1CK)
- KOBJ = KYP1CK(MOBJCD)
- MXKP = KYP1CK(MXKPCD)
- NWKYS = NWKYCK
- CALL UCOPY (KYP1CK, KYP2CK, NWKYCK)
-*
- CALL CDPATH (PATHX, NKEYCK)
- CALL RZCDIR (PATHX, ' ')
- IF (IQUEST(1).NE.0) GO TO 991
- NKEYCK = IQUEST(7)
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
-*
-* *** Get the Serial number of the last object inserted
-*
- LOBJ = KOBJ
- IF (NKEYCK.GT.0) THEN
- DO 30 IK = 1, NKEYCK
- IP = KOFSCD + LCDRCD + IKDRCD + (IK-1)*KST + IDHKSN
- IF (IQ(IP).GT.LOBJ) LOBJ = IQ(IP)
- 30 CONTINUE
- ENDIF
- NINS = NKEYCK
-*
-* *** Loop over all the objects
-*
- DO 50 IOBJ = 1, NOBJCS
- LOBJ = LOBJ + 1
- NINS = NINS + 1
- CHOP0 = CHOPS(IOBJ)
-*
-* ** Fill up Key vectors 1,2
-*
- KEYSCS(1,IOBJ) = LOBJ
- KEYSCS(IDHPTR,IOBJ) = 0
-#if (defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))&&(!defined(CERNLIB__P3CHILD))&&(defined(CERNLIB__ONLINE))
-*
- IF (IOPPCD.NE.0) THEN
- CALL CDWLOK (IRC)
- IF (IRC.NE.0) GO TO 999
- ENDIF
-#endif
-*
-* ** Write the sequential output if needed
-*
- IF (LUFZCF.GT.0) THEN
- NLEV = 1
- NCUR = 5
- IFORO = 2
- CHCUR(NLEV) = CFORM(IFORO)
- IF (INDEX(CHOP0,'Z').NE.0) THEN
- NLCUR(NLEV) = 4
- IFORO = 3
- NCUR = 1
- NLEV = NLEV + 1
- CHCUR(NLEV) = CFORM(IFORO)
- CALL UCOPY (PRECCZ, IHEDCF(MPRECF), 1)
- ELSE
- IHEDCF(MPRECF) = IPREC
- ENDIF
- DO 40 I = 1, NWKYCK
- IFORM = IOTYCK(I)
- IF (IFORM.EQ.6) IFORM = 5
- IF (IFORM.EQ.IFORO) THEN
- NCUR = NCUR + 1
- ELSE
- NLCUR(NLEV) = NCUR
- IF (NLEV.GE.NLEVM) THEN
- IRC = 76
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDPART :'//
- + ' Cannot get IO descriptor '//PATHY//''')', IARGCD, 0)
-#endif
- GO TO 995
- ENDIF
- NLEV = NLEV + 1
- CHCUR(NLEV) = CFORM(IFORM)
- NCUR = 1
- IFORO = IFORM
- ENDIF
- 40 CONTINUE
- NLCUR(NLEV) = NCUR
-#if !defined(CERNLIB_IBM)||!defined(CERNLIB__P3CHILD)
- WRITE (CHFRM, 2001) (NLCUR(I), CHCUR(I), I = 1, NLEV)
-#endif
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB__P3CHILD))
- CHFRM = ' '
- II = 1
- DO 41 I = 1, NLEV
- CALL UTWRIT (CHFRM(II:II+1), '(I2)', NLCUR(I))
- II = II + 2
- CHFRM(II:II) = CHCUR(I)
- II = II + 2
- 41 CONTINUE
-#endif
- II = 4 *NLEV
- CHFRM = CHFRM(1:II)//' -H'
- CALL MZIOCH (IOFMCF, NWFMCF, CHFRM(1:II+3))
- CALL UCTOH (CHOP0, IHEDCF(NWKYCK+MPRECF+1), 4, 4*NDOP)
- CALL UCOPY (KEYSCS(1,IOBJ), IHEDCF(MPRECF+1), NWKYCK)
-#if (defined(CERNLIB_IBMVM)||defined(CERNLIB_UNIX)||defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))
- IF (IOPPCD.NE.0) IHEDCF(MPRECF+IDHKSN) = 0
-#endif
-#if defined(CERNLIB__P3CHILD)
- RNDBP3 = 'CDPART '
- NWDBP3 = 2
- CALL UCTOH ('JOURNAL ', IWDBP3, 4, 8)
- CALL CDCHLD
- IRC = IQDBP3
- IF (IRC.NE.0) GO TO 995
-#endif
- CALL FZOUT (LUFZCF, IDISCD, LOBJCS(IOBJ), 1, 'L', IOFMCF,
- + NWDH, IHEDCF)
- IF (IQUEST(1).NE.0) THEN
- IRC = 77
- IQUEST(11) = IOBJ
- IQUEST(12) = NOBJCS
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDPART : Err'//
- + 'or in FZOUT while writing Data for '',2I12)', IQUEST(11),2)
-#endif
- GO TO 995
- ENDIF
- ENDIF
-#if (defined(CERNLIB_IBMVM)||defined(CERNLIB_UNIX)||defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))
-*
- IF (IOPPCD.NE.0) THEN
-#endif
-#if (defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))&&(!defined(CERNLIB__P3CHILD))&&(defined(CERNLIB__ONLINE))
- CALL CDCWSV (IRC)
- IF (IRC.NE.0) GO TO 997
-#endif
-#if (defined(CERNLIB_IBMVM)||defined(CERNLIB_UNIX)||defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))
- GO TO 50
- ENDIF
-#endif
-#if !defined(CERNLIB__P3CHILD)
-*
-* ** Make a different subdirectory if there are too many keys
-*
- IF (NINS.GT.MXKP) THEN
- CALL RZCDIR (PATHY, ' ')
- PATHX = ' '
- IF (IQUEST(1).NE.0) GO TO 991
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- NKEYCK = IQUEST(7)
-*
-* ** Rename Keys 3 and 4 of the latest subdirectory
-*
- IF (IOPSCD.NE.0) CALL RZLOCK ('CDPART')
- CALL RZRENK (KYP1CK, KYP2CK)
- IERR = IQUEST(1)
- IF (IOPSCD.NE.0) CALL RZFREE ('CDPART')
- IF (IERR.NE.0) THEN
- IRC = 74
-#endif
-#if (defined(CERNLIB__DEBUG))&&(!defined(CERNLIB__P3CHILD))
- IF (IDEBCD.GT.0) THEN
- CALL UCOPY (KYP1CK, IARGCD(1), NSYSCK)
- CALL UCOPY (KYP2CK, IARGCD(NSYSCK+1), NSYSCK)
- CALL CDPRNT (LPRTCD, '(/,'' CDPART : Error in RZRENK '//
- + 'while writing data for '//PATHY//''',/(10X,7I12))',
- + IARGCD, 2*NSYSCK)
- ENDIF
-#endif
-#if !defined(CERNLIB__P3CHILD)
- GO TO 997
- ENDIF
-*
-* ** Make a different subdirectory if there are too many keys
-*
- KEY7CK = KEYSCS(IDHINS,IOBJ)
- IF (ICMPCD.EQ.2) THEN
- CHOP = 'ZP'
- ELSE IF (ICMPCD.NE.0) THEN
- CHOP = 'CP'
- ELSE
- CHOP = 'P '
- ENDIF
- CALL CDMKDI (PATHY, NWKYS, CHFOR, CTAGCK, MXKP, IPRECD,
- + DELTCD, CHOP, IRC)
- IF (IRC.NE.0) GO TO 997
- CALL RZCDIR (PATHY, ' ')
- NKEYCK = IQUEST(7)
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- KPNT = IUHUNT (NKEYCK, IQ(KOFSCD+LCDRCD+IKDRCD+MPSRCD),
- + NKEYCK*KST, KST)
- IF (KPNT.NE.0) THEN
- NK = (KPNT - MPSRCD) / KST + 1
- ELSE
- NK = NKEYCK
- ENDIF
- CALL CDKEYR (NK, NWKYCK, KYP1CK)
- CALL CDPATH (PATHX, NKEYCK)
- CALL RZCDIR (PATHX, ' ')
- IF (IQUEST(1).NE.0) GO TO 991
- NKEYCK = IQUEST(7)
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- NINS = NKEYCK + 1
- CALL UCOPY (KYP1CK, KYP2CK, NWKYCK)
- ENDIF
-*
- IDB = ICDTYP (LOBJCS(IOBJ))
- IF (IDB.EQ.2.OR.IDB.EQ.3) THEN
- IOPTR = 0
- ELSE
- IOPTR = 1
- ENDIF
-*
- IF (IOPSCD.NE.0) CALL RZLOCK ('CDPART')
- IF (JBIT(KEYSCS(IDHFLG,IOBJ),JRZUCD).NE.0. OR. IOPTR.NE.0) THEN
-*
-* ** RZ mode output
-*
- IF (JBIT(KEYSCS(IDHFLG,IOBJ),JASFCD).NE.0) THEN
- CHOP = 'S'
- ELSE IF (JBIT(KEYSCS(IDHFLG,IOBJ),JRZUCD).NE.0) THEN
- CHOP = 'L'
- ELSE
- CHOP = ' '
- ENDIF
-*
-#endif
-#if (defined(CERNLIB__DEBUG))&&(!defined(CERNLIB__P3CHILD))
- IF (IDEBCD.GT.2) CALL RZLDIR (' ', ' ')
-#endif
-#if !defined(CERNLIB__P3CHILD)
- CALL RZOUT (IDISCD, LOBJCS(IOBJ), KEYSCS(1,IOBJ), ICYCLE,CHOP)
-*
- ELSE
-*
-* ** Copy data to DB internal store
-*
-* ** 0 Data word : do not pack
-*
- CALL CDFRUS (LOBJCS(IOBJ), LSTRCL(1), IPRECD, IRC)
- IF (IRC.NE.0) GO TO 995
-*
-* ** Compress the data if requested
-*
- IF (IQ(KOFUCD+LOBJCS(IOBJ)-1).EQ.0 .OR.
- + (INDEX(CHOP0,'P').EQ.0.AND.INDEX(CHOP0,'Z').EQ.0)) THEN
- LREFCL(1) = LSTRCL(1)
- ELSE
- IF (INDEX(CHOP0,'D').NE.0) THEN
- IOPDCA = 1
- ELSE
- IOPDCA = 0
- ENDIF
- IF (INDEX(CHOP0,'Z').NE.0) THEN
- IOPPCA = 0
- IOPZCA = 1
- PACKCZ = .TRUE.
- ELSE
- IOPPCA = 1
- IOPZCA = 0
- PACKCZ = .FALSE.
- ENDIF
- NOLD = NKEYCK
- NKEYCK = NINS - 1
- CALL CDCOMP (LSTRCL(1), LREFCL(1), KEYSCS(1,IOBJ), IRC)
- IOPDCA = 0
- IOPPCA = 0
- IOPZCA = 0
- NKEYCK = NOLD
- ENDIF
- IF (IRC.NE.0) GO TO 995
-*
-* ** Drop the uncompressed data
-*
- IF (LREFCL(1).NE.LSTRCL(1)) CALL MZDROP (IDISCD,LSTRCL(1),'L')
-*
-* ** Write on to disk
-*
-#endif
-#if (defined(CERNLIB__DEBUG))&&(!defined(CERNLIB__P3CHILD))
- IF (IDEBCD.GT.2) CALL RZLDIR (' ', ' ')
-#endif
-#if !defined(CERNLIB__P3CHILD)
- CALL RZOUT (IDISCD, LREFCL(1), KEYSCS(1,IOBJ), ICYCLE, 'S')
- IER = IQUEST(1)
- CALL MZDROP (IDISCD, LREFCL(1), 'L')
- IQUEST(1) = IER
- ENDIF
-*
- IKDRCD = IQ(KOFSCD+LCDRCD+KLKDCD)
- NKEYCK = IQ(KOFSCD+LCDRCD+KNKDCD)
-*
- IF (IOPSCD.NE.0) THEN
- IER = IQUEST(1)
- CALL RZFREE ('CDPART')
- IQUEST(1) = IER
- ENDIF
-*
- CALL CDPVAL (KEYSCS(1,IOBJ))
- IF (IQUEST(1).NE.0) GO TO 993
-#endif
-#if (defined(CERNLIB__DEBUG))&&(!defined(CERNLIB__P3CHILD))
- IF (IDEBCD.GT.1) THEN
- CALL UCOPY (KEYSCS(1,IOBJ), KEYNCK, NWKYCK)
- CALL CDUPTM (IARGCD(1), IARGCD(2), KEYNCK(IDHINS), IRC)
- CALL CDPRNT (LPRTCD, '(/,'' CDPART : Data was inserted into'//
- + ' '//PATHY//''',/,10X,''on the '',I8,'' at '',I6,'' '//
- + 'with Key-Vector '')', IARGCD, 2)
- CALL CDKEYT
- CALL CDPRKY (NWKYCK, KEYNCK, IOTYCK, IRC)
- ENDIF
-#endif
- 50 CONTINUE
- IF (ISTR.GE.NKEYS) GO TO 995
- DO 60 IOBJ = 1, NOBJCS
- IF (LOBJCS(IOBJ).NE.0) CALL MZDROP (IDISCD, LOBJCS(IOBJ), 'L')
- 60 CONTINUE
-*
-* ** Rename Keys 3 and 4 of the latest subdirectory
-*
-#if (defined(CERNLIB_IBMVM)||defined(CERNLIB_UNIX)||defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))&&(!defined(CERNLIB__P3CHILD))
- IF (IOPPCD.EQ.0) THEN
-#endif
-#if !defined(CERNLIB__P3CHILD)
- CALL RZCDIR (PATHY, ' ')
- PATHX = ' '
- IF (IQUEST(1).NE.0) GO TO 991
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- NKEYCK = IQUEST(7)
- IF (IOPSCD.NE.0) CALL RZLOCK ('CDPART')
- CALL RZRENK (KYP1CK, KYP2CK)
- IERR = IQUEST(1)
- IF (IOPSCD.NE.0) CALL RZFREE ('CDPART')
- IF (IERR.NE.0) THEN
- IRC = 74
-#endif
-#if (defined(CERNLIB__DEBUG))&&(!defined(CERNLIB__P3CHILD))
- IF (IDEBCD.GT.0) THEN
- CALL UCOPY (KYP1CK, IARGCD(1), NSYSCK)
- CALL UCOPY (KYP2CK, IARGCD(NSYSCK+1), NSYSCK)
- CALL CDPRNT (LPRTCD, '(/,'' CDPART : Error in RZRENK '//
- + 'while writing data for '//PATHY//''',/(10X,7I12))',
- + IARGCD, 2*NSYSCK)
- ENDIF
-#endif
-#if !defined(CERNLIB__P3CHILD)
- GO TO 997
- ENDIF
-#endif
-#if (defined(CERNLIB_IBMVM)||defined(CERNLIB_UNIX)||defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))&&(!defined(CERNLIB__P3CHILD))
- ENDIF
-#endif
- GO TO 20
-*
-* *** Error messages
-*
- 991 IRC = 71
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDPART : Illegal '//
- + 'Path Name '//PATHY//PATHX(1:8)//''')', IARGCD, 0)
-#endif
- GO TO 997
-#if !defined(CERNLIB__P3CHILD)
-*
- 993 IRC = 73
-#endif
-#if (defined(CERNLIB__DEBUG))&&(!defined(CERNLIB__P3CHILD))
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDPART : Error in '//
- + 'RZOUT while writing Data for '//PATHY//PATHX(1:8)//''')',
- + IARGCD, 0)
-#endif
-*
- 995 CONTINUE
-#if (defined(CERNLIB_IBMVM)||defined(CERNLIB_UNIX)||defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))
- IF (IOPPCD.NE.0) GO TO 997
-#endif
-#if !defined(CERNLIB__P3CHILD)
- IF (NINS.GT.0) THEN
- CALL RZCDIR (PATHY, ' ')
- IF (IQUEST(1).NE.0) THEN
- IF (IRC.EQ.0) GO TO 991
- ELSE
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- NKEYCK = IQUEST(7)
-*
-* ** Rename Keys 3 and 4 of the latest subdirectory
-*
- IF (IRC.EQ.0) THEN
- IF (IOPSCD.NE.0) CALL RZLOCK ('CDPART')
- CALL RZRENK (KYP1CK, KYP2CK)
- IERR = IQUEST(1)
- IF (IOPSCD.NE.0) CALL RZFREE ('CDPART')
- IF (IERR.NE.0) THEN
- IRC = 74
-#endif
-#if (defined(CERNLIB__DEBUG))&&(!defined(CERNLIB__P3CHILD))
- IF (IDEBCD.GT.0) THEN
- CALL UCOPY (KYP1CK, IARGCD(1), NSYSCK)
- CALL UCOPY (KYP2CK, IARGCD(NSYSCK+1), NSYSCK)
- CALL CDPRNT (LPRTCD, '(/,'' CDPART : Error in RZRENK '//
- + 'while writing data for '//PATHY//''',/(10X,7I12))'
- +, IARGCD, 2*NSYSCK)
- ENDIF
-#endif
-#if !defined(CERNLIB__P3CHILD)
- ENDIF
- ENDIF
- ENDIF
- ENDIF
-#endif
-*
-* *** Drop the stored banks
-*
- 997 IF (NOBJCS.GT.0) THEN
- DO 998 IOBJ = 1, NOBJCS
- CALL MZDROP (IDISCD, LOBJCS(IOBJ), 'L')
- 998 CONTINUE
- NOBJCS = 0
- ENDIF
-#if !defined(CERNLIB_IBM)||!defined(CERNLIB__P3CHILD)
-*
- 2001 FORMAT (20(I2,A1,1X))
-#endif
-* END CDPART
- 999 END
diff --git a/src/packlib/hepdb/cdmdir/cdsdir.F b/src/packlib/hepdb/cdmdir/cdsdir.F
deleted file mode 100644
index 1ec25c5..0000000
--- a/src/packlib/hepdb/cdmdir/cdsdir.F
+++ /dev/null
@@ -1,174 +0,0 @@
-*
-* $Id: cdsdir.F,v 1.1.1.1 1996/02/28 16:24:16 mclareni Exp $
-*
-* $Log: cdsdir.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:16 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
-#if defined(CERNLIB__P3CHILD)
-* Ignoring t=dummy
-#endif
- SUBROUTINE CDSDIR (PATHN, NWKEY, CHFOR, CHTAG, MXKP, IPREC, DELTA,
- + CHOPT, IRC)
-* ==================================================================
-*
-************************************************************************
-* *
-* SUBR. CDSDIR (PATHN, NWKEY, CHFOR, CHTAG, MXKP, IPREC, DELTA, *
-* CHOPT, IRC*) *
-* *
-* Saves the directory creation information in the Journal file. *
-* It creates a header record (with data bank containing IPREC and *
-* DELTA) for each entry. *
-* The header contains Action Code (2), Number of keys, numbers of *
-* charcaters for option and pathname, MXKP, followed by Character *
-* option, CHFOR, CHTAG and the pathname *
-* *
-* Arguments : *
-* *
-* PATHN Character string describing the pathname *
-* NWKEY Number of key elements *
-* CHFOR Character variable describing each element of the key *
-* vector *
-* CHTAG Character array defined as CHARACTER*8 (NWKEY) *
-* MXKP Maximum number of objects in each partition *
-* IPREC Precision word sepcifying the number of significant *
-* digits to be stored; (If IPREC > 0, data are stored *
-* with IPREC significant digits right to the decimal *
-* points; if IPREC < 0, data are stored with IPREC *
-* insignificant digits left to the decimal point.) *
-* DELTA Variable specifying the absolute value below which data *
-* is treated as zero *
-* CHOPT Character string with any of the following characters *
-* C Data in the directory will be compressed by default *
-* P Create partitioned subdirectories for the pathname *
-* IRC Return code (see below) *
-* *
-* Called by CDMKDI *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* = 49 : FZOUT fails to write on the sequential file *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
-#include "hepdb/cfzlun.inc"
-#include "hepdb/ckkeys.inc"
-#include "hepdb/clinks.inc"
-#include "hepdb/ctpath.inc"
-#if defined(CERNLIB__P3CHILD)
-#include "hepdb/p3dbl3.inc"
-#endif
- PARAMETER (JBIAS=2)
- CHARACTER CTAG*8, PATHN*(*), CHFOR*(*), CHOPT*(*)
- CHARACTER*(*) CHTAG(*)
-*
-* ------------------------------------------------------------------
-*
-* *** Find the logical unit number of the Journal file
-*
- KEY7 = KEY7CK
- KEY7CK = 0
- IRC = 0
- LUFZCF = LUFZCD
-#if (defined(CERNLIB_UNIX)||defined(CERNLIB_IBMVM)||defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))
-*
- IF (IOPPCD.NE.0) THEN
- IRC = 0
-#endif
-#if (defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))&&(!defined(CERNLIB__P3CHILD))&&(defined(CERNLIB__ONLINE))
- CALL CDWLOK (IRC)
-#endif
-#if (defined(CERNLIB_UNIX)||defined(CERNLIB_IBMVM)||defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))&&(!defined(CERNLIB__P3CHILD))&&(!defined(CERNLIB__ONLINE))
- CALL CDSTSV (TOPNCD, 0, IRC)
-#endif
-#if defined(CERNLIB__P3CHILD)
- LUFZCF = LODBP3
-#endif
-#if (defined(CERNLIB_UNIX)||defined(CERNLIB_IBMVM)||defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))
- IF (IRC.NE.0) GO TO 999
- ENDIF
-#endif
-*
- IF (LUFZCF.GT.0) THEN
-*
-* ** Prepare the header containing all the information
-*
- NCH = LENOCC (PATHN)
- NCHD = (NCH + 3) / 4
- NCHP = LENOCC (CHOPT)
- NCHPD = (NCHP + 3) / 4
- CALL MZIOCH (IOFMCF, NWFMCF, '7I -H')
- IHEDCF(MACTCF) = 2
- IHEDCF(MNKYCF) = NWKEY
- IHEDCF(MPATCF) = NCHD
- IHEDCF(MOPTCF) = NCHPD
- IHEDCF(MXKPCF) = MXKP
-* IF (NCHPD.GT.0) CALL UCTOH (CHOPT, IHEDCF(MRECCF+1), 4, 4*NCHPD)
- IF (NCHPD.GT.0) CALL UCTOH (CHOPT, IHEDCF(MRECCF+1), 4, NCHP)
- IF (KEY7.LE.0) THEN
- CALL DATIME (IDATE, ITIME)
- CALL CDPKTM (IDATE, ITIME, KEY7, IRC)
- ENDIF
- IHEDCF(MINSCF) = KEY7
- IHEDCF(MRECCF) = 0
- NCFO = (NWKEY + 3) / 4
- NPNT = IHEDCF(MOPTCF) + MRECCF + 1
- CALL UCTOH (CHFOR, IHEDCF(NPNT), 4, NWKEY)
- NPNT = NPNT + NCFO
- DO 10 I = 1, NWKEY
- CTAG = CHTAG(I)
- CALL UCTOH (CTAG, IHEDCF(NPNT), 4, 8)
- NPNT = NPNT + 2
- 10 CONTINUE
- CALL UCTOH (PATHN, IHEDCF(NPNT), 4, 4*NCHD)
- NWDH = NPNT + NCHD - 1
-*
-* ** Now write on the sequential output
-*
-#if defined(CERNLIB__P3CHILD)
- RNDBP3 = 'CDSDIR '
- NWDBP3 = 2
- CALL UCTOH ('JOURNAL ', IWDBP3, 4, 8)
- CALL CDCHLD
- IRC = IQDBP3
- IF (IRC.NE.0) GO TO 999
-#endif
- IF (LSTRCL(3).NE.0) CALL MZDROP (IDISCD, LSTRCL(3), ' ')
- CALL CDBANK (IDISCD, LSTRCL(3), LSTRCL(3), JBIAS, 'SAME', 0, 0,
- + 1, 3, 0, IRC)
- IF (IRC.NE.0) GO TO 999
- IQ(KOFUCD+LSTRCL(3)-5) = IPREC
- Q(KOFUCD+LSTRCL(3)+1) = DELTA
- CALL FZOUT (LUFZCF, IDISCD, LSTRCL(3), 1, 'S', IOFMCF, NWDH,
- + IHEDCF)
- IERR = IQUEST(1)
- CALL MZDROP (IDISCD, LSTRCL(3), ' ')
- IF (IERR.NE.0) THEN
- IRC = 49
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) THEN
- PAT3CT = PATHN
- CALL CDPRNT (LPRTCD, '(/,'' CDSDIR : FZOUT error for path'//
- + ' name '//PAT3CT//''')', IARGCD, 0)
- ENDIF
-#endif
- GO TO 999
- ENDIF
- ENDIF
-#if (defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))&&(!defined(CERNLIB__P3CHILD))&&(defined(CERNLIB__ONLINE))
-*
-* *** Server environment, Public mode
-*
- IF (IOPPCD.NE.0) THEN
- IOPBCA = 0
- CALL CDCWSV (IRC)
- GO TO 999
- ENDIF
-#endif
-* END CDSDIR
- 999 END
diff --git a/src/packlib/hepdb/cdofflin/Imakefile b/src/packlib/hepdb/cdofflin/Imakefile
deleted file mode 100644
index 35b23d8..0000000
--- a/src/packlib/hepdb/cdofflin/Imakefile
+++ /dev/null
@@ -1,3 +0,0 @@
-SRCS_F= cdfopn.F cdfsnd.F cdfzlo.F cdsave.F cdstsv.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/hepdb/cdofflin/cdfopn.F b/src/packlib/hepdb/cdofflin/cdfopn.F
deleted file mode 100644
index 0366526..0000000
--- a/src/packlib/hepdb/cdofflin/cdfopn.F
+++ /dev/null
@@ -1,104 +0,0 @@
-*
-* $Id: cdfopn.F,v 1.1.1.1 1996/02/28 16:24:17 mclareni Exp $
-*
-* $Log: cdfopn.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:17 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDFOPN (LUN, IRC)
-* ============================
-*
-************************************************************************
-* *
-* SUBR. CDFOPN (LUN, IRC*) *
-* *
-* Opens an file ascii file on the specified unit *
-* with time upto second embedded in it to ensure a unique filename *
-* *
-* Arguments : *
-* *
-* LUN Unit number for opening the file *
-* IRC Return code (see below) *
-* *
-* Called by CDINIT, CDSTSV *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* = -8 : Error in opening file *
-* *
-************************************************************************
-*
-#include "hepdb/cduscm.inc"
- INTEGER YEAR, MONTH, DAY, HOUR, MINUTE, SECOND
- CHARACTER CYEAR*2, CMON*2, CDAY*2, CHOUR*2
- CHARACTER CMIN*2, CSEC*2, FNAME*80
-#if defined(CERNLIB_IBMVM)
- CHARACTER*1 CHMODE,CMXDSK
-#endif
- LOGICAL EXIST
-*
-* ------------------------------------------------------------------
-*
-#if defined(CERNLIB_IBMVM)
- CHMODE = CMXDSK()
-#endif
-*
-* *** Get date and time for constructing the file name
-*
- 10 CALL CDUVTX (IDAY, ITIM)
- YEAR = MOD (IDAY/10000, 100)
- MONTH = MOD (IDAY/100 , 100)
- DAY = MOD (IDAY , 100)
- HOUR = MOD (ITIM/3600 , 100)
- MINUTE = MOD (ITIM/60 , 60)
- SECOND = MOD (ITIM , 60)
-*
- WRITE (CYEAR, '(I2.2)') YEAR
- WRITE (CMON, '(I2.2)') MONTH
- WRITE (CDAY, '(I2.2)') DAY
- WRITE (CHOUR, '(I2.2)') HOUR
- WRITE (CMIN, '(I2.2)') MINUTE
- WRITE (CSEC, '(I2.2)') SECOND
-#if defined(CERNLIB_UNIX)||defined(CERNLIB_VAX)
- FNAME = 'qq'//CYEAR//CMON//CDAY//'.t'//CHOUR//CMIN//CSEC
-#endif
-#if defined(CERNLIB_IBMVM)
- FNAME = '/QQ'//CYEAR//CMON//CDAY//' T'//CHOUR//CMIN//CSEC
- + // ' ' // CHMODE
-#endif
-*
-* ** If file already exists then go back to get a new time
-*
- INQUIRE (FILE=FNAME, EXIST=EXIST)
- IF (EXIST) GO TO 10
-*
-* *** Open the file with an Open Statement
-*
- OPEN (UNIT=LUN, ACCESS='SEQUENTIAL',
- + FORM='FORMATTED', STATUS ='NEW', IOSTAT=ISTAT,
-#if defined(CERNLIB_IBMVM)
- + ACTION='READWRITE',
-#endif
- + FILE = FNAME)
- IF (ISTAT .NE. 0) THEN
-#if defined(CERNLIB_IBMVM)
-#endif
- IRC = -8
- IF(IDEBCD.GE.0) THEN
- WRITE(LPRTCD,9001) ISTAT,FNAME(1:LENOCC(FNAME)),LUN
- 9001 FORMAT(' CDFOPN. error ',I10,' opening journal file ',A,
- + ' on unit ',I2)
- WRITE(LPRTCD,9002)
- 9002 FORMAT(' CDFOPN. check quota, file permissions (and tokens',
- + ' for AFS/DFS file systems)')
- ENDIF
- ELSE
- IF(IDEBCD.GE.1) WRITE(LPRTCD,9003) FNAME(1:LENOCC(FNAME)),LUN
- 9003 FORMAT(' CDFOPN. opened journal file ',A,' on unit ',I2)
- IRC = 0
- ENDIF
-* END CDFOPN
- END
diff --git a/src/packlib/hepdb/cdofflin/cdfsnd.F b/src/packlib/hepdb/cdofflin/cdfsnd.F
deleted file mode 100644
index c98bdda..0000000
--- a/src/packlib/hepdb/cdofflin/cdfsnd.F
+++ /dev/null
@@ -1,284 +0,0 @@
-*
-* $Id: cdfsnd.F,v 1.4 1997/03/14 17:07:32 mclareni Exp $
-*
-* $Log: cdfsnd.F,v $
-* Revision 1.4 1997/03/14 17:07:32 mclareni
-* WNT mods
-*
-* Revision 1.3.2.1 1997/01/21 11:28:42 mclareni
-* All mods for Winnt 96a on winnt branch
-*
-* Revision 1.3 1996/04/12 10:36:11 jamie
-* booboo
-*
-* Revision 1.2 1996/04/12 07:39:58 jamie
-* check write acl in cdfsnd
-*
-* Revision 1.1.1.1 1996/02/28 16:24:17 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDFSND (LUN, CTOP, IRC)
-* ===================================
-*
-************************************************************************
-* *
-* SUBR. CDFSND (LUN, CTOP, IRC*) *
-* *
-* Close current update file on the specified unit and mv/rename *
-* to the input queue directory of the server. *
-* *
-* Arguments : *
-* *
-* LUN Logical unit number where the file sits *
-* CTOP First 2 characters of the file after being moved *
-* IRC Error code (0 if no error) *
-* *
-* Requires : *
-* *
-* CDSERV variable must be set *
-* *
-* Called by CDSTSV *
-* *
-************************************************************************
-*
- LOGICAL OPEN
- CHARACTER*2 CTOP,CH2
- CHARACTER*255 NAMEO,NAMEN,ARGS
-#if defined(CERNLIB_VAXVMS)
- CHARACTER*255 CHTMP
-#endif
-#include "hepdb/slate.inc"
-#include "hepdb/cduscm.inc"
-#include "hepdb/cdnamc.inc"
- CHARACTER*255 CHQUED,CHFILE,CHDIR
- CHARACTER*20 CHIN(2,1)
- CHARACTER*255 CHOUT(2,1)
-#if defined(CERNLIB_IBMVM)
- CHARACTER*8 FNAME,FTYPE
-#endif
- INTEGER SYSTEMF
-
- DATA NENTRY/0/
- SAVE NENTRY,CHDIR,LDIR
-
-* ------------------------------------------------------------------
-*
-* ** Get the name of the file and close it
-*
- IRC = 0
- INQUIRE (LUN, OPENED=OPEN, NAME=NAMEO)
- IF (.NOT.OPEN) GO TO 999
- CLOSE (LUN)
-
- IF(NENTRY.EQ.0) THEN
- NENTRY = 1
-*
-* Find the location of the names file and process
-*
- CALL GETENVF('CDSERV',CHDIR)
- LDIR = IS(1)
-#if defined(CERNLIB_WINNT)
- CHFILE = CHDIR(1:LDIR) // '\\hepdb.names'
- LFILE = LDIR + 12
- CALL CUTOL(CHFILE(1:LFILE))
-#endif
-#if defined(CERNLIB_MSDOS)
- CHFILE = CHDIR(1:LDIR) // '\\hepdb.nam'
- LFILE = LDIR + 10
- CALL CUTOL(CHFILE(1:LFILE))
-#endif
-#if (defined(CERNLIB_UNIX))&&(!defined(CERNLIB_WINNT))&&(!defined(CERNLIB_MSDOS))
- CHFILE = CHDIR(1:LDIR) // '/hepdb.names'
- LFILE = LDIR + 12
- CALL CUTOL(CHFILE(1:LFILE))
-#endif
-#if defined(CERNLIB_VAXVMS)
- CHFILE = CHDIR(1:LDIR) // 'hepdb.names'
- LFILE = LDIR + 11
-#endif
-#if defined(CERNLIB_IBMVM)
-* LDOT = INDEX(CHDIR(1:LDIR),'.')
-* IF(LDOT.NE.0) LDIR = LDOT - 1
- CHFILE = 'HEPDB NAMES '//CDMODE
- LFILE = 13
-#endif
- ENDIF
-
- NCH = LENOCC (NAMEO)
- CH2 = CTOP
- CALL CUTOL (CH2)
- NCH2 = LENOCC (CH2)
-
-#if defined(CERNLIB_VAXVMS)
- I1 = INDEX(NAMEO(1:NCH),']') + 1
-*
-* Strip off version number
-*
- ICOLON = INDEX(NAMEO(1:NCH),';')
- IF(ICOLON.NE.0) NCH = ICOLON - 1
-#endif
-#if (!defined(CERNLIB_VAXVMS))&&(!defined(CERNLIB_MSDOS))&&(!defined(CERNLIB_WINNT))
- DO 10 I = NCH, 1, -1
- IF (NAMEO(I:I).EQ.'/') THEN
- I1 = I + 1
- GO TO 20
- ENDIF
- 10 CONTINUE
- I1 = 1
- 20 CONTINUE
-#endif
-#if defined(CERNLIB_MSDOS)||defined(CERNLIB_WINNT)
- DO 10 I = NCH, 1, -1
-#ifdef CERNLIB_BSLASH
- IF (NAMEO(I:I).EQ.'\\' .OR.
-#else
- IF (NAMEO(I:I).EQ. '\' .OR.
-#endif
- * NAMEO(I:I).EQ. ':' .OR.
- * NAMEO(I:I).EQ. '/') THEN
- I1 = I + 1
- GO TO 20
- ENDIF
- 10 CONTINUE
- I1 = 1
- 20 CONTINUE
-#endif
-* IF (NCH2.GT.0.AND.NCH.GT.I1+1) THEN
-* NAMEN = CH2(1:NCH2)//NAMEO(I1+2:NCH)
-* ELSE IF (NCH2.GT.0) THEN
-* NAMEN = CH2(1:NCH2)//NAMEO(I1:NCH)
-* ELSE
-* NAMEN = NAMEO(I1:NCH)
-* ENDIF
-*
-* Ensure mv-ed filename is unique
-*
- CALL CDUNIQ(NAMEN,IRC)
- NCHN = LENOCC (NAMEN)
- NAMEN(1:2) = CH2
-*
-* Get the file name and list of servers for this database
-*
- NIN = 1
- NOUT = 1
- CHIN(1,1) = ':nick'
- CHIN(2,1) = 'config'
-
- CHOUT(1,1) = ':queue'
- CHOUT(2,1) = ' '
-
- CALL NAMEFD(LUN,CHFILE(1:LFILE),CHIN,NIN,CHOUT,NOUT,IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBCD.GE.0)
- + PRINT *,'CDCONF. error ',IRC,' processing names file ',
- + CHFILE(1:LFILE),' for entry ',CH2
- RETURN
- ENDIF
-
- CHQUED = CHOUT(2,1)
- LQUED = LENOCC(CHQUED)
-*
-* *** check to see if the user has write privileges to the database file
-*
- CALL CDACL(LUN,CH2,IOPTRR,IOPTWW,' ',IRC)
- IF (IOPTWW .EQ. 0) THEN
- IF(IDEBCD.GE.0)
- + PRINT *,'CDFSND. Write access denied to database file ',
- + 'with prefix ',CH2,'.'
- IRC = -13
- RETURN
- ENDIF
-
-#if defined(CERNLIB_VAXVMS)
-*
-* map UNIX path to VMS path
-*
-* /a/b/c/d/e/f/g maps to a:[b.c.d.e.f.g]
-*
- ISLASH = INDEX(CHQUED(1:LQUED),'/')
-
- IF(ISLASH.NE.0) THEN
-
- JSLASH = INDEX(CHQUED(ISLASH+1:LQUED),'/')
- IF(JSLASH.EQ.0) THEN
- IF(IDEBCD.GE.-3) WRITE(LPRTCD,7001) CHQUED(1:LQUED)
- 7001 FORMAT(' CDFSND. error translating ',A,' to VMS format')
- IRC = -12
- GOTO 999
- ENDIF
-
- CHTMP = CHQUED(ISLASH+1:ISLASH+JSLASH-1) // ':[' //
- + CHQUED(ISLASH+JSLASH:LQUED) // ']'
-
- LOLD = LQUED
- LQUED = LENOCC(CHTMP)
-
- CALL CTRANS(CHTMP,'/','.',1,LQUED)
-
- WRITE(6,9001) CHQUED(1:LOLD),CHTMP(1:LQUED)
- 9001 FORMAT(' CDFSND. queue directory ',A,' mapped to ',A)
- CHQUED = CHTMP
-
- ENDIF
-
-#endif
-#if (defined(CERNLIB_UNIX))&&(!defined(CERNLIB_WINNT))&&(!defined(CERNLIB_MSDOS))
-*
-* *** mv the file
-*
- ARGS = 'mv '//NAMEO(I1:NCH)//' '//CHQUED(1:LQUED)//'/'
- + //NAMEN(1:NCHN)
-#endif
-#if defined(CERNLIB_WINNT)||defined(CERNLIB_MSDOS)
-*
-* *** move the file (since MsDOS 6.0 or Windows/NT)
-*
- ARGS = 'move '//NAMEO(I1:NCH)//' '//CHQUED(1:LQUED)//'\\'
- + //NAMEN(1:NCHN)
-#endif
-#if defined(CERNLIB_UNIX)
- IRC = SYSTEMF(ARGS)
-#endif
-#if defined(CERNLIB_VAXVMS)
-*
-* move the file
-*
- CALL CDMOVF(NAMEO(I1:NCH),
- + CHQUED(1:LQUED)//'ZZ'//NAMEN(3:NCHN),' ',IRC)
- IF(IRC.NE.0) GOTO 999
-*
-* *** rename the file
-*
- IERR = LIB$RENAME_FILE(CHQUED(1:LQUED)//'ZZ'//NAMEN(3:NCHN),
- + CHQUED(1:LQUED)//NAMEN(1:NCHN),,,,,,,,,,)
- IF(.NOT.IERR) THEN
- IRC = -1
- ELSE
- IRC = 0
- ENDIF
-#endif
-#if defined(CERNLIB_IBMVM)
-*
-* New file name is prefix//random_number $CDSERV
-*
- LEND = LDIR
- LBLA = INDEXB(CHDIR(1:LDIR),' ')
- IF(LBLA.NE.0) LEND = LBLA - 1
- FTYPE = CHDIR(1:LEND)
- CALL CDRAND(FNAME,IRC)
- NAMEN = CH2(1:NCH2) // FNAME(3:) // ' ' // FTYPE // ' ' //
- + NAMEO(NCH-1:NCH)
- NCHN = LENOCC(NAMEN)
- CALL CLTOU(NAMEN(1:NCHN))
- CALL VMCMS('RENAME '//NAMEO(I1:NCH)//' '//NAMEN(1:NCHN),IRC)
-*
-* Now send the file to the server pointed to be the :queue tag
-*
- CALL VMCMS('EXEC SENDFILE '//NAMEN(1:NCHN)
- + //' TO '//CHQUED(1:LQUED),IRC)
- CALL VMCMS('ERASE '//NAMEN(1:NCHN),IRC)
-#endif
-* END CDFSND
- 999 END
diff --git a/src/packlib/hepdb/cdofflin/cdfzlo.F b/src/packlib/hepdb/cdofflin/cdfzlo.F
deleted file mode 100644
index b6e06d9..0000000
--- a/src/packlib/hepdb/cdofflin/cdfzlo.F
+++ /dev/null
@@ -1,47 +0,0 @@
-*
-* $Id: cdfzlo.F,v 1.1.1.1 1996/02/28 16:24:17 mclareni Exp $
-*
-* $Log: cdfzlo.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:17 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDFZLO (LUN, IFND)
-* =============================
-*
-************************************************************************
-* *
-* SUBR. CDFZLO (LUN, IFND*) *
-* *
-* Sees if the FZ file is already opened *
-* *
-* Arguments : *
-* *
-* LUN Logical unit number *
-* IFND Return flag (0 if not found; 1 if found) *
-* *
-* Called by CDINIT *
-* *
-************************************************************************
-*
-#include "zebra/mqsys.inc"
-#include "zebra/eqlqf.inc"
-*
-* ------------------------------------------------------------------
-*
-* *** Loop over control banks
-*
- LQFF = LQFS
- 10 IF (LQFF.NE.0) THEN
- IF (IQ(KQSP+LQFF-5).EQ.LUN) THEN
- IFND = 1
- ELSE
- LQFF = LQ(KQSP+LQFF)
- GO TO 10
- ENDIF
- ELSE
- IFND = 0
- ENDIF
-* END CDFZLO
- END
diff --git a/src/packlib/hepdb/cdofflin/cdsave.F b/src/packlib/hepdb/cdofflin/cdsave.F
deleted file mode 100644
index 4acb722..0000000
--- a/src/packlib/hepdb/cdofflin/cdsave.F
+++ /dev/null
@@ -1,102 +0,0 @@
-*
-* $Id: cdsave.F,v 1.1.1.1 1996/02/28 16:24:18 mclareni Exp $
-*
-* $Log: cdsave.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:18 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDSAVE (TOPN,CHOPT,IRC)
-* ==================================
-*
-************************************************************************
-* *
-* SUBR. CDSAVE (TOPN,CHOPT,IRC*) *
-* *
-* Sends the journal file to the server for updating the data base. *
-* *
-* Arguments : *
-* *
-* CHOPT *
-* C Journal file to be closed, else reopened *
-* P Purge pending updates *
-* S Send signal to server *
-* W Wait for response from server (not yet implemented) *
-* *
-* IRC Return code (see below) *
-* *
-* Called by user *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* =225 : Error in sending the file to the server *
-* - or - error deleting journal file (IOPTP) *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
-#include "hepdb/cfzlun.inc"
-#include "hepdb/cinitl.inc"
-#include "zebra/fzstat.inc"
- CHARACTER TOPN*(*)
- LOGICAL IOPEN
-#include "hepdb/hdbopts.inc"
-*
-* ------------------------------------------------------------------
-*
- LUFZCF = LUFMCD
- IF (TOPN.NE.TOPLCI.AND.TOPLCI(1:1).NE.' ') THEN
- CALL FZINFO (LUFZCF)
- CALL FZENDO (LUFZCF, 'QTE')
-*
-* Send journal file only if some updates have been made
-*
- IF(IOPTP.NE.0.OR.(LUFZCF.EQ.INFLUN.AND.INFOFZ(2).EQ.0)) THEN
- CLOSE(LUFZCF,STATUS='DELETE',IOSTAT=IRC1)
- ELSE
- CALL CDFSND (LUFZCF, TOPLCI(3:4), IRC1)
-#if defined(CERNLIB_UNIX)
-*
-* Send signal
-*
- IF(IOPTS.NE.0) THEN
- CALL CDGETP(LUFZCF,IPID,IRC)
- IF(IRC.EQ.0) CALL CDALARM(IPID,IRC)
- ENDIF
-#endif
- ENDIF
-
- IF (IOPTC.EQ.0) THEN
- CALL CDFOPN (LUFZCF, IRC2)
- IF (IRC1.EQ.0) IRC1 = IRC2
- CALL FZFILE (LUFZCF, 0, 'AOQ')
- ENDIF
-
- IF (IRC1.NE.0) THEN
- IRC = 225
- IQUEST(11) = IRC1
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '('' CDSTSV : Error'/
- + / ' '',I6,'' in sending file to server for '//TOPLCI//''')'
- + , IQUEST(11), 1)
-#endif
- TOPLCI = ' '
- GO TO 999
- ENDIF
- IRC = 0
- ELSE
- IRC = 0
- IF (IOPTC.NE.0) THEN
- INQUIRE(LUFZCF,OPENED=IOPEN)
- IF(IOPEN.AND.LUFZCF.GT.0) CLOSE (LUFZCF, STATUS='DELETE')
- ENDIF
- ENDIF
- IF (IOPTC.EQ.0) THEN
- TOPLCI = TOPN
- ELSE
- TOPLCI = ' '
- ENDIF
-* END CDSAVE
- 999 END
diff --git a/src/packlib/hepdb/cdofflin/cdstsv.F b/src/packlib/hepdb/cdofflin/cdstsv.F
deleted file mode 100644
index 2254b33..0000000
--- a/src/packlib/hepdb/cdofflin/cdstsv.F
+++ /dev/null
@@ -1,88 +0,0 @@
-*
-* $Id: cdstsv.F,v 1.1.1.1 1996/02/28 16:24:17 mclareni Exp $
-*
-* $Log: cdstsv.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:17 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDSTSV (TOPN, IFL, IRC)
-* ==================================
-*
-************************************************************************
-* *
-* SUBR. CDSTSV (TOPN, IFL, IRC*) *
-* *
-* Sends the journal file to the offline server if required *
-* *
-* Arguments : *
-* *
-* TOPN Name of the top directory for the current update *
-* IFL Flag (0 if journal file to be reopened; -1 if not) *
-* IRC Return code (see below) *
-* *
-* Called by CDDDIR, CDDONT, CDEALI, CDEND, CDENFZ, CDENTB, CDKOUT, *
-* CDPART, CDPURP, CDRENK, CDSAVE, CDSDIR, CDSNAM, CDSPUR *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* =225 : Error in sending the spool file to the server *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
-#include "hepdb/cfzlun.inc"
-#include "hepdb/cinitl.inc"
-#include "zebra/fzstat.inc"
- CHARACTER TOPN*(*)
- LOGICAL IOPEN
-*
-* ------------------------------------------------------------------
-*
- LUFZCF = LUFMCD
- IF (TOPN.NE.TOPLCI.AND.TOPLCI(1:1).NE.' ') THEN
- CALL FZINFO (LUFZCF)
- CALL FZENDO (LUFZCF, 'QTE')
-*
-* Send journal file only if some updates have been made
-*
- IF(LUFZCF.EQ.INFLUN.AND.INFOFZ(2).EQ.0) THEN
- CLOSE(LUFZCF,STATUS='DELETE')
- ELSE
- CALL CDFSND (LUFZCF, TOPLCI(3:4), IRC1)
- ENDIF
-
- IF (IFL.EQ.0) THEN
- CALL CDFOPN (LUFZCF, IRC2)
- IF (IRC1.EQ.0) IRC1 = IRC2
- CALL FZFILE (LUFZCF, 0, 'AOQ')
- ENDIF
-
- IF (IRC1.NE.0) THEN
- IRC = 225
- IQUEST(11) = IRC1
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '('' CDSTSV : Error'//
- + ' '',I6,'' in sending file to server for '//TOPLCI//''')',
- + IQUEST(11), 1)
-#endif
- TOPLCI = ' '
- GO TO 999
- ENDIF
- IRC = 0
- ELSE
- IRC = 0
- IF (IFL.EQ.-1) THEN
- INQUIRE(LUFZCF,OPENED=IOPEN)
- IF(IOPEN.AND.LUFZCF.GT.0) CLOSE (LUFZCF, STATUS='DELETE')
- ENDIF
- ENDIF
- IF (IFL.EQ.0) THEN
- TOPLCI = TOPN
- ELSE
- TOPLCI = ' '
- ENDIF
-* END CDSTSV
- 999 END
diff --git a/src/packlib/hepdb/cdonline/Imakefile b/src/packlib/hepdb/cdonline/Imakefile
deleted file mode 100644
index 59318f2..0000000
--- a/src/packlib/hepdb/cdonline/Imakefile
+++ /dev/null
@@ -1,4 +0,0 @@
-SRCS_F= cdchkcli.F cdcwsv.F cdgimgna.F cdgname.F cdgnode.F \ @@\
- cdwlok.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/hepdb/cdonline/cdchkcli.F b/src/packlib/hepdb/cdonline/cdchkcli.F
deleted file mode 100644
index 030c200..0000000
--- a/src/packlib/hepdb/cdonline/cdchkcli.F
+++ /dev/null
@@ -1,96 +0,0 @@
-*
-* $Id: cdchkcli.F,v 1.1.1.1 1996/02/28 16:24:18 mclareni Exp $
-*
-* $Log: cdchkcli.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:18 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CD_CHK_CLIENT (CD_CURRENT_SNAME, CD_CURRENT_LNAME,
- + CD_CLUSCOM_NAME, IERR)
-* =============================================================
-*
-************************************************************************
-* *
-* SUBR. CD_CHK_CLIENT (CD_CURRENT_SNAME*, CD_CURRENT_LNAME*, *
-* CD_CLUSCOM_NAME*, IERR*) *
-* *
-* Finds the short, long names and the CLUSCOM name for the task *
-* *
-* Arguments : *
-* *
-* CD_CURRENT_SNAME(*) Short name *
-* CD_CURRENT_LNAME(*) Long name *
-* CD_CLUSCOM_NAME(*) Name of the CLUSCOM *
-* IERR(*) Error code (0 if no error) *
-* *
-* Called by CDINIT *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
- CHARACTER*2 CD_CURRENT_SNAME
- CHARACTER*4 CD_CURRENT_LNAME
- CHARACTER*9 CD_CLUSCOM_NAME
- CHARACTER*2 CLIENT_LABEL
-* Process names stuff
- CHARACTER P_NODENAME*31, P_PRCNAME*31, P_IMGNAME*80
- INTEGER*4 P_NODEN_L , P_PRCN_L, P_IMGN_L
- LOGICAL VALID_PRC , VALID_IMG
-* Database Ids for logical names
- PARAMETER (NUM_CD=9)
- CHARACTER*2 CD_SNAME(NUM_CD)
- CHARACTER*4 CD_LNAME(NUM_CD)
- DATA CD_SNAME /'TE', 'EC', 'HC', 'MU', 'FL', 'JT',
- + 'L3', 'SC', 'VS'/
- DATA CD_LNAME /'TECH', 'ECAL', 'HCAL', 'MUCH', 'FLUM',
- + 'TRIG', 'L3RC', 'SCNT', 'VSMD'/
-*
-* ------------------------------------------------------------------
-*
- VALID_IMG = .FALSE.
- VALID_PRC = .FALSE.
- CLIENT_LABEL = 'XX'
- CALL CD_G_NODE (P_NODENAME, P_NODEN_L)
- CALL CD_G_NAME (P_PRCNAME , P_PRCN_L)
- CALL CD_G_IMGNAME (P_IMGNAME , P_IMGN_L)
- K_CD_P = 0
- K_CD_I = 0
- DO 10 I = 1, NUM_CD
- IF (P_IMGNAME(1:1).EQ.CD_SNAME(I)(1:1)) THEN
- VALID_IMG = .TRUE.
- K_CD_I = I
- ENDIF
- 10 CONTINUE
- IF (.NOT.VALID_IMG) THEN
- CALL CDPRNT (L3PRDB, '('' CD_CHK_CLIENT (CDINIT) NON FATAL ER'//
- + 'ROR -Incorrect Image Name: '//P_IMGNAME(1:P_IMGN_L)//''')'
- +, IARGCD, 0)
- DO 15 I = 1, NUM_CD
- IF (P_PRCNAME(1:1).EQ.CD_SNAME(I)(1:1)) THEN
- VALID_PRC = .TRUE.
- K_CD_P = I
- ENDIF
- 15 CONTINUE
- IF (VALID_PRC) THEN
- CD_CURRENT_SNAME = CD_SNAME(K_CD_P)
- CD_CURRENT_LNAME = CD_LNAME(K_CD_P)
- IF (P_PRCN_L.EQ.9) CLIENT_LABEL = P_PRCNAME(8:9)
- ENDIF
- ELSE
- CD_CURRENT_SNAME = CD_SNAME(K_CD_I)
- CD_CURRENT_LNAME = CD_LNAME(K_CD_I)
- IF(P_IMGN_L.EQ.9) CLIENT_LABEL = P_IMGNAME(8:9)
- ENDIF
- IF (VALID_PRC.OR.VALID_IMG) THEN
- CD_CLUSCOM_NAME(1:2) = CD_CURRENT_SNAME
- CD_CLUSCOM_NAME(3:7) = '_CDC_'
- CD_CLUSCOM_NAME(8:9) = CLIENT_LABEL
- IERR = 0
- ELSE
- CD_CLUSCOM_NAME = 'WRONGNAME'
- IERR = 1
- ENDIF
-* END CD_CHK_CLIENT
- END
diff --git a/src/packlib/hepdb/cdonline/cdcwsv.F b/src/packlib/hepdb/cdonline/cdcwsv.F
deleted file mode 100644
index c83a7fa..0000000
--- a/src/packlib/hepdb/cdonline/cdcwsv.F
+++ /dev/null
@@ -1,81 +0,0 @@
-*
-* $Id: cdcwsv.F,v 1.1.1.1 1996/02/28 16:24:19 mclareni Exp $
-*
-* $Log: cdcwsv.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:19 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDCWSV (IRC)
-* =======================
-*
-************************************************************************
-* *
-* SUBR. CDCWSV (IRC*) *
-* *
-* Releases the CLUSCOM and communicates with the server *
-* *
-* Arguments : *
-* *
-* IRC Return code (see below) *
-* *
-* Called by CDDDIR, CDDONT, CDEALI, CDENFZ, CDENTB, CDKOUT, CDPART, *
-* CDPURP, CDRENK, CDSDIR, CDSNAM, CDSPUR *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* =222 : Error in CC_RELEASE for releasing the CLUSCOM *
-* =223 : Error in ICSIGNAL for signalling the VAX server *
-* *
-************************************************************************
-*
-#include "hepdb/caopts.inc"
-#include "hepdb/cdcblk.inc"
-#include "hepdb/cfzlun.inc"
-#include "hepdb/cinitl.inc"
-#include "hepdb/ckkeys.inc"
-#include "hepdb/cbsrvr.inc"
-#include "hepdb/crccom.inc"
- INTEGER ICACHE(4)
- BYTE BCACHE(16)
- EQUIVALENCE (BCACHE, ICACHE)
-*
-* ------------------------------------------------------------------
-*
- IWORCR(1) = IQUEST(9)
- CALL CC_RELEASE ('CRCCOM', ' ', IERR)
- IF (IERR.NE.0) THEN
- IRC = 222
- IQUEST(11) = IERR
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDCWSV : Error'//
- + ' '',I10,'' in CC_RELEASE'')', IQUEST(11), 1)
-#endif
- GO TO 999
- ENDIF
- TIMEOUT = 100
-*
-* ** First 2 bytes of the cache contain identifier
-* ** of calling client; last word contains a flag
-* ** to be changed by the server.
-*
- BCACHE(1) = ICHAR(FILECB(20:20))
- BCACHE(2) = ICHAR(FILECB(21:21))
- ICACHE(3) = IOPBCA
- ICACHE(4) = -1
- CALL IC_SIGNAL (CACHCB, ICACHE, TIMEOUT, ' ', IERR)
- IF (IERR.NE.0) THEN
- IRC = 223
- IQUEST(11) = IERR
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDCWSV : Error'//
- + ' '',I10,'' in IC_SIGNAL'')', IQUEST(11), 1)
-#endif
- GO TO 999
- ENDIF
- IRC = ICACHE(3)
- IQUEST(2) = ICACHE(2)
-* END CDCWSV
- 999 END
diff --git a/src/packlib/hepdb/cdonline/cdgimgna.F b/src/packlib/hepdb/cdonline/cdgimgna.F
deleted file mode 100644
index cc8f867..0000000
--- a/src/packlib/hepdb/cdonline/cdgimgna.F
+++ /dev/null
@@ -1,73 +0,0 @@
-*
-* $Id: cdgimgna.F,v 1.1.1.1 1996/02/28 16:24:18 mclareni Exp $
-*
-* $Log: cdgimgna.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:18 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CD_G_IMGNAME (NAME, LENGTH)
-* ======================================
-*
-************************************************************************
-* *
-* SUBR. CD_G_IMGNAME (NAME*, LENGTH*) *
-* *
-* Finds the executing image name in the character variable NAME *
-* *
-* Arguments : *
-* *
-* NAME Name of the task *
-* LENGTH Length of the character string NAME *
-* *
-* Called by CD_CHK_CLIENT *
-* *
-************************************************************************
-*
- CHARACTER*(*) NAME
- INCLUDE '($JPIDEF)'
- STRUCTURE /ITMLST/
- UNION
- MAP
- INTEGER*2 BUFLEN
- INTEGER*2 CODE
- INTEGER*4 BUFADR
- INTEGER*4 RETLENADR
- END MAP
- MAP
- INTEGER*4 END_LIST
- END MAP
- END UNION
- END STRUCTURE
- RECORD /ITMLST/ JPI_LIST(2)
- INTEGER*4 STATUS,SYS$GETJPIW
-*
-* ------------------------------------------------------------------
-*
- JPI_LIST(1).BUFLEN = 80
- JPI_LIST(1).CODE = JPI$_IMAGNAME
- JPI_LIST(1).BUFADR = %LOC(NAME)
- JPI_LIST(1).RETLENADR = %LOC(LENGTH)
- JPI_LIST(2).END_LIST = 0
-
- STATUS = SYS$GETJPIW (,,,JPI_LIST,,,)
- IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL(STATUS))
-*
-* *** Parse full image name and strip off device,directory,file type
-* *** and version.
-*
- CALL STR$UPCASE ( NAME(1:LENGTH), NAME(1:LENGTH) )
- DO 10 J=1,LENGTH
- IF(NAME(J:J).EQ.']') LOC_OFFSET = J
- 10 CONTINUE
- DO 20 J=LOC_OFFSET+1,LENGTH
- IF(NAME(J:J).EQ.'.') LOC_BORDER = J
- 20 CONTINUE
- LENGTH1 = LOC_BORDER - LOC_OFFSET - 1
- DO 30 J=1,LENGTH1
- NAME(J:J) = NAME(LOC_OFFSET+J:LOC_OFFSET+J)
- 30 CONTINUE
- LENGTH = LENGTH1
-* END CD_G_IMGNAME
- END
diff --git a/src/packlib/hepdb/cdonline/cdgname.F b/src/packlib/hepdb/cdonline/cdgname.F
deleted file mode 100644
index 47a7f5a..0000000
--- a/src/packlib/hepdb/cdonline/cdgname.F
+++ /dev/null
@@ -1,60 +0,0 @@
-*
-* $Id: cdgname.F,v 1.1.1.1 1996/02/28 16:24:18 mclareni Exp $
-*
-* $Log: cdgname.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:18 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CD_G_NAME (NAME, LENGTH)
-* ===================================
-*
-************************************************************************
-* *
-* SUBR. CD_G_NAME (NAME*, LENGTH*) *
-* *
-* Finds the task name in the character variable NAME *
-* *
-* Arguments : *
-* *
-* NAME Name of the task *
-* LENGTH Length of the character string NAME *
-* *
-* Called by CD_CHK_CLIENT *
-* *
-************************************************************************
-*
- CHARACTER*(*) NAME
- INCLUDE '($JPIDEF)'
- STRUCTURE /ITMLST/
- UNION
- MAP
- INTEGER*2 BUFLEN
- INTEGER*2 CODE
- INTEGER*4 BUFADR
- INTEGER*4 RETLENADR
- END MAP
- MAP
- INTEGER*4 END_LIST
- END MAP
- END UNION
- END STRUCTURE
- RECORD /ITMLST/ JPI_LIST(2)
- INTEGER*4 STATUS,SYS$GETJPIW
-*
-* ------------------------------------------------------------------
-*
- JPI_LIST(1).BUFLEN = 15
- JPI_LIST(1).CODE = JPI$_PRCNAM
- JPI_LIST(1).BUFADR = %LOC(NAME)
- JPI_LIST(1).RETLENADR = %LOC(LENGTH)
- JPI_LIST(2).END_LIST = 0
-*
- STATUS = SYS$GETJPIW (,,,JPI_LIST,,,)
- IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL(STATUS))
-*
- STATUS = SYS$GETJPIW (,,,JPI_LIST,,,)
- IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL(STATUS))
-* END CD_G_NAME
- END
diff --git a/src/packlib/hepdb/cdonline/cdgnode.F b/src/packlib/hepdb/cdonline/cdgnode.F
deleted file mode 100644
index 691852d..0000000
--- a/src/packlib/hepdb/cdonline/cdgnode.F
+++ /dev/null
@@ -1,57 +0,0 @@
-*
-* $Id: cdgnode.F,v 1.1.1.1 1996/02/28 16:24:18 mclareni Exp $
-*
-* $Log: cdgnode.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:18 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CD_G_NODE (NAME, LENGTH)
-* ===================================
-*
-************************************************************************
-* *
-* SUBR. CD_G_NODE (NAME*, LENGTH*) *
-* *
-* Finds the name of the node where the program is running *
-* *
-* Arguments : *
-* *
-* NAME Name of the node *
-* LENGTH Length of the character string NAME *
-* *
-* Called by CD_CHK_CLIENT *
-* *
-************************************************************************
-*
- CHARACTER*(*) NAME
- INCLUDE '($LNMDEF)'
- STRUCTURE /ITMLST/
- UNION
- MAP
- INTEGER*2 BUFLEN
- INTEGER*2 CODE
- INTEGER*4 BUFADR
- INTEGER*4 RETLENADR
- END MAP
- MAP
- INTEGER*4 END_LIST
- END MAP
- END UNION
- END STRUCTURE
- RECORD /ITMLST/ TRN_LIST(2)
- INTEGER*4 STATUS,SYS$TRNLNM
-*
-* ------------------------------------------------------------------
-*
- TRN_LIST(1).BUFLEN = 15
- TRN_LIST(1).CODE = LNM$_STRING
- TRN_LIST(1).BUFADR = %LOC(NAME)
- TRN_LIST(1).RETLENADR = %LOC(LENGTH)
- TRN_LIST(2).END_LIST = 0
-*
- STATUS = SYS$TRNLNM (,'LNM$SYSTEM_TABLE','SYS$NODE',,TRN_LIST)
- IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL(STATUS))
-* END CD_G_NODE
- END
diff --git a/src/packlib/hepdb/cdonline/cdwlok.F b/src/packlib/hepdb/cdonline/cdwlok.F
deleted file mode 100644
index 289b49d..0000000
--- a/src/packlib/hepdb/cdonline/cdwlok.F
+++ /dev/null
@@ -1,53 +0,0 @@
-*
-* $Id: cdwlok.F,v 1.1.1.1 1996/02/28 16:24:18 mclareni Exp $
-*
-* $Log: cdwlok.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:18 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDWLOK (IRC)
-* =======================
-*
-************************************************************************
-* *
-* SUBR. CDWLOK (IRC*) *
-* *
-* Locks the CLUSCOM before writing onto it and communicating to the *
-* server *
-* *
-* Arguments : *
-* *
-* IRC Return code (see below) *
-* *
-* Called by CDDDIR, CDDONT, CDEALI, CDENFZ, CDENTB, CDKOUT, CDPART, *
-* CDPURP, CDRENK, CDSDIR, CDSNAM, CDSPUR *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* =221 : Error in CC_WRITELOCK for locking the CLUSCOM *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
-#include "hepdb/cfzlun.inc"
-#include "hepdb/cbsrvr.inc"
-#include "hepdb/crccom.inc"
-*
-* ------------------------------------------------------------------
-*
- LUFZCF = LUFMCD
-*
- CALL CC_WRITELOCK ('CRCCOM', ' ', IRC)
- IF (IRC.NE.0) THEN
- IQUEST(11) = IRC
- IRC = 221
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDWLOK : Error'//
- + ' '',I10,'' in CC_WRITELOCK '')', IQUEST(11), 1)
-#endif
- ENDIF
-* END CDWLOK
- END
diff --git a/src/packlib/hepdb/cdpack/Imakefile b/src/packlib/hepdb/cdpack/Imakefile
deleted file mode 100644
index 80ba990..0000000
--- a/src/packlib/hepdb/cdpack/Imakefile
+++ /dev/null
@@ -1,8 +0,0 @@
-SRCS_F= cdcmpr.F cdcmpz.F cdcomp.F cdflin.F cdfrus.F cdfzin.F \ @@\
- cdifch.F cdifrc.F cdinin.F cdizin.F cdpack.F
-
-#if !defined(CERNLIB_P3CHILD)
-SRCS_F := $(SRCS_F) cdlinc.F
-#endif
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/hepdb/cdpack/cdcmpr.F b/src/packlib/hepdb/cdpack/cdcmpr.F
deleted file mode 100644
index 5970988..0000000
--- a/src/packlib/hepdb/cdpack/cdcmpr.F
+++ /dev/null
@@ -1,177 +0,0 @@
-*
-* $Id: cdcmpr.F,v 1.2 1996/04/25 10:23:46 cernlib Exp $
-*
-* $Log: cdcmpr.F,v $
-* Revision 1.2 1996/04/25 10:23:46 cernlib
-* Comment the include for zebra/q_cbyt.inc; this files no longer is in zebra
-*
-* Revision 1.1.1.1 1996/02/28 16:24:20 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDCMPR (LB, IADS, IER, IRC)
-* ======================================
-*
-************************************************************************
-* *
-* SUBR. CDCMPR (LB, IADS*, IER*, IRC*) *
-* *
-* Compresses data bank defined by LB in the Data Base *
-* *
-* Arguments : *
-* *
-* LB Address of the bank to be compressed *
-* IADS Address of the compressed bank as LAUXCL(IADS) *
-* IER Error Code : 0 No error *
-* 1-3 As in CDFLIN/CDININ *
-* 4 Not enough precision for packing *
-* 5 Nonstandard Data type *
-* IRC Return code (see below) *
-* *
-* Called by CDCOMP *
-* *
-* Error Condition : *
-* *
-* IER = 0 : No error (see above) *
-* IRC = 0 : No error *
-* Could be set to nonzero by some routines called *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
-#include "hepdb/clinks.inc"
- PARAMETER (JBIAS=2)
- DIMENSION LB(9)
- SAVE IWMX
- DATA IWMX /1073741824/
-#include "zebra/q_sbit.inc"
-* Ignoring t=pass
-*#include "zebra/q_cbyt.inc"
-* Ignoring t=pass
-*
-* ------------------------------------------------------------------
-*
-* *** Data type ?
-*
- LREFCD(5) = LB(1)
- IDTYP = ICDTYP(LREFCD(5))
- NDA = IQ(KOFUCD+LREFCD(5)-1)
- CALL CDBANK (IDISCD, LAUXCL(IADS), LAUXCL(IADS), JBIAS, 'AUX1', 0,
- + 0, NDA, 2, 0, IRC)
- IF (IRC.NE.0) GO TO 999
- LAUX1 = LAUXCL(IADS)
- IF (IDTYP.EQ.3) THEN
-*
-* ** Convert real to integer data and truncate according to precision
-*
- CALL CDFLIN (Q(KOFUCD+LREFCD(5)+1), IQ(KOFUCD+LAUX1+1), NDA,
- + IPREC, IER)
- IF (IER.NE.0) THEN
- CALL MZDROP (IDISCD, LAUX1, ' ')
- GO TO 999
- ENDIF
-*
- ELSE IF (IDTYP.EQ.2.OR.IDTYP.EQ.5) THEN
-*
-* ** Truncate integer data according to the given precision
-*
- CALL CDININ (IQ(KOFUCD+LREFCD(5)+1), IQ(KOFUCD+LAUX1+1), NDA,
- + IPREC, IER)
- IF (IER.NE.0) THEN
- CALL MZDROP (IDISCD, LAUX1, ' ')
- GO TO 999
- ENDIF
- ELSE
-*
-* ** Nonstandard data type
-*
- IER = 5
- CALL MZDROP (IDISCD, LAUX1, ' ')
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.1) CALL CDPRNT (LPRTCD, '(/,'' CDCMPR : Data-Ty'//
- + 'pe '',I4,'' incompatible for packing'')', IDTYP, 1)
-#endif
- GO TO 999
- ENDIF
-*
-* *** Convert signed integer to positive integers
-*
- ND2 = NDA - 2
- LAU12 = KOFUCD + LAUX1 + 2
- IVM = IQ(LAU12+1)
- MVM = IQ(LAU12+1)
- DO 10 I = 2, ND2
- IF (IQ(LAU12+I).LT.IVM) IVM = IQ(LAU12+I)
- IF (IQ(LAU12+I).GT.MVM) MVM = IQ(LAU12+I)
- 10 CONTINUE
-*
- IF (MVM.GT.IWMX.OR.-IVM.GT.IWMX) THEN
- IER = 4
- CALL MZDROP (IDISCD, LAUXCL(IADS), ' ')
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.1) CALL CDPRNT (LPRTCD, '(/,'' CDCMPR : Packing'//
- + ' Bit Length is '',I4,'' - No Compression !'')', LBITL, 1)
-#endif
- GO TO 999
- ENDIF
-*
- IF (IVM.LT.0) THEN
- IVM = - IVM
- DO 20 I = 1, ND2
- IQ(LAU12+I) = IQ(LAU12+I) + IVM
- 20 CONTINUE
- ELSE
- IVM = 0
- ENDIF
-*
-* *** Pack the positive integers into bit-string choosing optimum
-* *** bit-length
-*
- ND3 = ND2 + 3
- CALL CDBANK (IDISCD, LAUXCL(IADS+1), LAUXCL(IADS+1), JBIAS, 'AUX2'
- + , 0, 0, ND3, 1, 0, IRC)
- IF (IRC.NE.0) GO TO 999
- CALL CDBANK (IDISCD, LSTRCL(5), LSTRCL(5), JBIAS, 'WKSP', 0, 0
- + , ND3, 1, -1, IRC)
- IF (IRC.NE.0) GO TO 999
- LAUX1 = LAUXCL(IADS)
- LAU13 = LAUX1 + 3
- LAUX2 = LAUXCL(IADS+1)
- CALL CDPACK (IQ(KOFUCD+LAU13), ND2, NDO, NAU, LBITL
- + , IQ(KOFUCD+LAUX2+4), IQ(KOFUCD+LSTRCL(5)+1))
- CALL MZDROP (IDISCD, LSTRCL(5), ' ')
-*
- IF (LBITL.EQ.32) THEN
- IER = 4
- CALL MZDROP (IDISCD, LAUXCL(IADS), ' ')
- CALL MZDROP (IDISCD, LAUXCL(IADS+1), ' ')
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.1) CALL CDPRNT (LPRTCD, '(/,'' CDCMPR : Packing'//
- + ' Bit Length is '',I4,'' - No Compression !'')', LBITL, 1)
-#endif
- GO TO 999
- ENDIF
-*
- IPREC = IPREC + 100
- IQ(KOFUCD+LAUX2+1) = 10000*ND2 + 1000*IDTYP + IPREC
- IQ(KOFUCD+LAUX2+2) = IVM
- LAU = LAUX2 + 3
- IQ(KOFUCD+LAU) = NAU
- IQ(KOFUCD+LAU) = MCBYT (LBITL, 1, IQ(KOFUCD+LAU), 27, 5)
- IQ(KOFUCD+LAU) = MSBIT1 (IQ(KOFUCD+LAU), 32)
-*
-* *** Rebook AUX1 bank with reduced datalength
-*
- ND3 = NDO + 3
- CALL MZDROP (IDISCD, LAUX1, ' ')
- CALL CDBANK (IDISCD, LAUXCL(IADS), LAUXCL(IADS), JBIAS, 'AU11', 0,
- + 0, ND3, 1, 0, IRC)
- IF (IRC.NE.0) GO TO 999
- LAUX1 = LAUXCL(IADS)
- LAUX2 = LAUXCL(IADS+1)
- CALL UCOPY (IQ(KOFUCD+LAUX2+1), IQ(KOFUCD+LAUX1+1), ND3)
- CALL MZDROP (IDISCD, LAUX2, ' ')
- IER = 0
-* END CDCMPR
- 999 END
diff --git a/src/packlib/hepdb/cdpack/cdcmpz.F b/src/packlib/hepdb/cdpack/cdcmpz.F
deleted file mode 100644
index ece5a46..0000000
--- a/src/packlib/hepdb/cdpack/cdcmpz.F
+++ /dev/null
@@ -1,129 +0,0 @@
-*
-* $Id: cdcmpz.F,v 1.1.1.1 1996/02/28 16:24:20 mclareni Exp $
-*
-* $Log: cdcmpz.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:20 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDCMPZ (LB, IADS, IER, IRC)
-* ======================================
-*
-************************************************************************
-* *
-* SUBR. CDCMPZ (LB, IADS*, IER*, IRC*) *
-* *
-* Compresses data bank defined by LB in the Data Base *
-* *
-* Arguments : *
-* *
-* LB Address of the bank to be compressed *
-* IADS Address of the compressed bank as LAUXCL(IADS) *
-* IER Error Code : 0 No error *
-* 1 Compression does not result in gaining*
-* space *
-* 5 Nonstandard Data type *
-* IRC Return code (see below) *
-* *
-* Called by CDCOMP *
-* *
-* Error Condition : *
-* *
-* IER = 0 : No error (see above) *
-* IRC = 0 : No error *
-* Could be set to nonzero by some routines called *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
-#include "hepdb/clinks.inc"
-#include "hepdb/czpack.inc"
- PARAMETER (JBIAS=2)
- DIMENSION LB(9)
-*
-* ------------------------------------------------------------------
-*
-* *** Data type ?
-*
- LREFCD(5) = LB(1)
- IDTYP = ICDTYP (LREFCD(5))
- NDA = IQ(KOFUCD+LREFCD(5)-1)
- ND2 = NDA - 2
- CALL CDBANK (IDISCD, LAUXCL(IADS), LAUXCL(IADS), JBIAS, 'AUX1', 0,
- + 0, NDA, IDTYP, 0, IRC)
- IF (IRC.NE.0) GO TO 999
- LAUX1 = LAUXCL(IADS)
-*
- IF (IDTYP.EQ.3) THEN
-*
-* ** Compress non-0 real data
-*
- CALL CDFZIN (Q(KOFUCD+LREFCD(5)+3), ND2, Q(KOFUCD+LAUX1+1), NDO,
- + PRECCZ, IER)
- IF (IER.NE.0) THEN
- CALL MZDROP (IDISCD, LAUX1, ' ')
- GO TO 999
- ENDIF
-*
-* ** Copy compressed data into reduced array with appropriate header
-*
- ND3 = NDO + 3
- CALL CDBANK (IDISCD, LAUXCL(IADS+1), LAUXCL(IADS+1), JBIAS,
- + 'AUX2', 0, 0, ND3, IDTYP, 0, IRC)
- IF (IRC.NE.0) GO TO 999
- LAUX1 = LAUXCL(IADS)
- LAUX2 = LAUXCL(IADS+1)
-*
- Q(KOFUCD+LAUX2+1) = ND2
- Q(KOFUCD+LAUX2+2) = PRECCZ
- Q(KOFUCD+LAUX2+3) = NDO
- CALL UCOPY (Q(KOFUCD+LAUX1+1), Q(KOFUCD+LAUX2+4), NDO)
- CALL MZDROP (IDISCD, LAUX1, ' ')
- LAUXCL(IADS) = LAUXCL(IADS+1)
- LAUXCL(IADS+1) = 0
-*
- ELSE IF (IDTYP.EQ.2.OR.IDTYP.EQ.5) THEN
-*
-* ** Compress non-0 integer data
-*
- CALL CDIZIN (IQ(KOFUCD+LREFCD(5)+3), ND2, IQ(KOFUCD+LAUX1+1),
- + NDO, PRECCZ, IER)
- IF (IER.NE.0) THEN
- CALL MZDROP (IDISCD, LAUX1, ' ')
- GO TO 999
- ENDIF
-*
-* ** Copy compressed data into reduced array with appropriate header
-*
- ND3 = NDO + 3
- CALL CDBANK (IDISCD, LAUXCL(IADS+1), LAUXCL(IADS+1), JBIAS,
- + 'AUX2', 0, 0, ND3, IDTYP, 0, IRC)
- IF (IRC.NE.0) GO TO 999
- LAUX1 = LAUXCL(IADS)
- LAUX2 = LAUXCL(IADS+1)
-*
- IQ(KOFUCD+LAUX2+1) = ND2
- IQ(KOFUCD+LAUX2+2) = PRECCZ
- IQ(KOFUCD+LAUX2+3) = NDO
- CALL UCOPY (IQ(KOFUCD+LAUX1+1), IQ(KOFUCD+LAUX2+4), NDO)
- CALL MZDROP (IDISCD, LAUX1, ' ')
- LAUXCL(IADS) = LAUXCL(IADS+1)
- LAUXCL(IADS+1) = 0
-*
- ELSE
-*
-* ** Nonstandard Data type
-*
- IER = 5
- CALL MZDROP (IDISCD, LAUX1, ' ')
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.1) CALL CDPRNT (LPRTCD, '(/,'' CDCMPZ : Data-Ty'//
- + 'pe'',I4,'' incompatible for packing'')', IDTYP, 1)
-#endif
- GO TO 999
- ENDIF
-*
- IER = 0
-* END CDCMPZ
- 999 END
diff --git a/src/packlib/hepdb/cdpack/cdcomp.F b/src/packlib/hepdb/cdpack/cdcomp.F
deleted file mode 100644
index 8260335..0000000
--- a/src/packlib/hepdb/cdpack/cdcomp.F
+++ /dev/null
@@ -1,216 +0,0 @@
-*
-* $Id: cdcomp.F,v 1.1.1.1 1996/02/28 16:24:20 mclareni Exp $
-*
-* $Log: cdcomp.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:20 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDCOMP (LSUP, LUPDA, KEYS, IRC)
-* ==========================================
-*
-************************************************************************
-* *
-* SUBR. CDCOMP (LSUP, LUPDA*, *KEYS*, IRC*) *
-* *
-* Compresses data bank defined by LSUP in the Data Base *
-* *
-* Arguments : *
-* *
-* LSUP Address of the bank to be compressed *
-* LUPDA Address of the compressed bank *
-* KEYS Vector of keys; Key 2 on return will contain the *
-* pointer to the Key 1 of the object with reference *
-* to which the current object has been updated *
-* IRC Return code (see below) *
-* *
-* Called by CDENFZ, CDENTB, CDKOUT, CDPART *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* Could be set to nonzero by some routines called *
-* *
-************************************************************************
-*
-#include "hepdb/caopts.inc"
-#include "hepdb/cdcblk.inc"
-#include "hepdb/ckkeys.inc"
-#include "hepdb/clinks.inc"
-#include "hepdb/czpack.inc"
- PARAMETER (JBIAS=2, MXNEI=5)
- DIMENSION LSUP(9), LUPDA(9), KEYS(9)
-#include "zebra/q_jbit.inc"
-* Ignoring t=pass
-*
-* ------------------------------------------------------------------
-*
- KEYS(IDHPTR) = 0
- IADS = 1
- LREFCD(3) = LSUP(1)
-*
-* *** If data is of mixed type, data cannot be compressed !
-*
- ITYP = ICDTYP (LREFCD(3))
- IF (ITYP.NE.2.AND.ITYP.NE.3) THEN
- LUPDA(1) = LREFCD(3)
- GO TO 999
- ENDIF
-*
-* *** Compress the data
-*
- IF (PACKCZ) THEN
- CALL CDCMPZ (LSUP(1), IADS, IER, IRC)
- ELSE
- CALL CDCMPR (LSUP(1), IADS, IER, IRC)
- ENDIF
- IF (IRC.NE.0) GO TO 999
-*
-* *** If IER .ne. 0 ----> Data cannot be compressed !
-*
- IF (IER.EQ.0) THEN
- LUPDA(1) = LAUXCL(IADS)
- ELSE
- LUPDA(1) = LREFCD(3)
- GO TO 999
- ENDIF
-*
- IF (IOPDCA.EQ.0) GO TO 999
- IF (NKEYCK.EQ.0) GO TO 999
-*
-* *** Can we compress better by taking the difference of the present and
-* *** neighbouring objects ?
-*
- ISTP = NWKYCK + 1
-*
- LREFCD(4) = LUPDA(1)
- MINWD = IQ(KOFUCD+LREFCD(4)-1)
- IADS = 9
- NEIGH = 0
- DO 50 I = 1, NKEYCK
- J = NKEYCK + 1 - I
- IPNT = KOFSCD + LCDRCD + IKDRCD + (J-1) * ISTP
- KEY2 = IQ(IPNT+IDHPTR)
- IF (KEY2.NE.0) GO TO 50
- KEY6 = IQ(IPNT+IDHFLG)
- IF (JBIT(KEY6,JRZUCD).NE.0) GO TO 50
- IF (IOPFCA.NE.0) THEN
- CALL CDKEYR (J, NWKYCK, KEYNCK)
- DO 10 K = NSYSCK+1, NWKYCK
- IF (KEYS(K).NE.KEYNCK(K)) GO TO 50
- 10 CONTINUE
- ENDIF
- NEIGH = NEIGH + 1
- IF (NEIGH.GT.MXNEI) GO TO 60
-*
- IF (LSTRCL(4).NE.0) CALL MZDROP (IDISCD, LSTRCL(4), 'L')
- LSTRCL(4) = 0
- CALL CDRZIN (IDISCD, LSTRCL(4), JBIAS, J, ICYCL, ' ', IRC)
- IF (IRC.NE.0) THEN
- IF (LSTRCL(4).NE.0) CALL MZDROP (IDISCD, LSTRCL(4), 'L')
- GO TO 50
- ENDIF
-*
- CALL CDKEYR (J, NWKYCK, KEYNCK)
- LREFCL(7) = LSTRCL(4)
-*
-* ** Uncompress ?
-*
- IF (IQ(KOFUCD+LREFCL(7)+1).NE.0) THEN
- CALL CDUNCP (LSTRCL(4), LREFCL(2), 0, IRC)
- CALL MZDROP (IDISCD, LSTRCL(4), 'L')
- IF (IRC.NE.0) GO TO 999
- LREFCL(7) = LREFCL(2)
- ENDIF
-*
-* ** Look if the data are similar - take the most similar master
-*
- ND1 = IQ(KOFUCD+LREFCD(3) - 1)
- ND2 = IQ(KOFUCD+LREFCL(7) - 1)
- IF (ND2.EQ.0) THEN
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.1) CALL CDPRNT (LPRTCD, '(/,'' CDCOMP : The '//
- + 'Data Structure does not contain data'',/)', IARGCD, 0)
-#endif
- CALL MZDROP (IDISCD, LREFCL(7), ' ')
- GO TO 50
- ENDIF
-*
- IT1 = ICDTYP(LREFCD(3))
- IT2 = ICDTYP(LREFCL(7))
- IF (IT1.NE.IT2) THEN
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.1) THEN
- IARGCD(1) = IT1
- IARGCD(2) = IT2
- CALL CDPRNT (LPRTCD, '(/,'' CDCOMP : The 2 Structures hav'//
- + 'e different data type '',2I4)', IARGCD, 2)
- ENDIF
-#endif
- CALL MZDROP (IDISCD, LREFCL(7), ' ')
- GO TO 50
- ENDIF
- IF (ND1.NE.ND2) THEN
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.1) THEN
- IARGCD(1) = ND1
- IARGCD(2) = ND2
- CALL CDPRNT (LPRTCD, '(/,'' CDCOMP : The 2 Structures hav'//
- + 'e different # of data'',2I4)', IARGCD, 2)
- ENDIF
-#endif
- CALL MZDROP (IDISCD, LREFCL(7), ' ')
- GO TO 50
- ENDIF
- IF (IT1.EQ.2.OR.IT1.EQ.5) THEN
- IQ(KOFUCD+LREFCL(7)+2) = IQ(KOFUCD+LREFCD(3)+2)
- DO 20 ID = 3, ND1
- IQ(KOFUCD+LREFCL(7)+ID) = IQ(KOFUCD+LREFCL(7)+ID)
- + - IQ(KOFUCD+LREFCD(3)+ID)
- 20 CONTINUE
- ELSE
- Q(KOFUCD+LREFCL(7)+2) = Q(KOFUCD+LREFCD(3)+2)
- DO 30 ID = 3, ND1
- Q(KOFUCD+LREFCL(7)+ID) = Q(KOFUCD+LREFCL(7)+ID)
- + - Q(KOFUCD+LREFCD(3)+ID)
- 30 CONTINUE
- ENDIF
-*
- 40 CONTINUE
- IF (PACKCZ) THEN
- CALL CDCMPZ (LREFCL(7), IADS, IER, IRC)
- ELSE
- CALL CDCMPR (LREFCL(7), IADS, IER, IRC)
- ENDIF
- IF (IRC.NE.0) THEN
- CALL MZDROP (IDISCD, LREFCL(7), ' ')
- GO TO 999
- ENDIF
- IF (IER.NE.0) THEN
- CALL MZDROP (IDISCD, LREFCL(7), ' ')
- GO TO 50
- ENDIF
-*
- NWORD = IQ(KOFUCD+LAUXCL(IADS)-1)
- IF (NWORD.GE.MINWD) THEN
- CALL MZDROP (IDISCD, LREFCL(7), ' ')
- CALL MZDROP (IDISCD, LAUXCL(IADS), ' ')
- GO TO 50
- ENDIF
- KEYS(IDHPTR)= KEYNCK(IDHKSN)
- MINWD = NWORD
- CALL MZDROP (IDISCD, LREFCL(7), ' ')
- CALL MZDROP (IDISCD, LREFCD(4), ' ')
- LREFCD(4) = LAUXCL(IADS)
- IF (IADS.EQ.1) THEN
- IADS = 9
- ELSE IF (IADS.EQ.9) THEN
- IADS = 1
- ENDIF
- 50 CONTINUE
- 60 CONTINUE
- LUPDA(1) = LREFCD(4)
- IRC = 0
-* END CDCOMP
- 999 END
diff --git a/src/packlib/hepdb/cdpack/cdflin.F b/src/packlib/hepdb/cdpack/cdflin.F
deleted file mode 100644
index eb549cb..0000000
--- a/src/packlib/hepdb/cdpack/cdflin.F
+++ /dev/null
@@ -1,127 +0,0 @@
-*
-* $Id: cdflin.F,v 1.1.1.1 1996/02/28 16:24:20 mclareni Exp $
-*
-* $Log: cdflin.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:20 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDFLIN (A, IA, N, IPREC, IER)
-* ========================================
-*
-************************************************************************
-* *
-* SUBR. CDFLIN (A, IA*, N, IPREC, IER*) *
-* *
-* Converts floating to signed integer according to the given *
-* precision *
-* *
-* Arguments : *
-* *
-* A Input array of real numbers *
-* IA Output array of signed integers *
-* N Length of the array *
-* IPREC Signed precision word; the data are truncated after *
-* having multiplied by 10**IPREC *
-* IER Error Code : 0 No error *
-* 1 Precision not given or not correct *
-* 2 Data exceeds 32 bits *
-* 3 Data is not uncompressed *
-* *
-* Called by CDCMPR *
-* *
-* Error Condition : *
-* *
-* IER = 0 : No error (see above) *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
- DIMENSION A(N), IA(N)
- DATA TOOBIG /2.1474E9/
-*
-* ------------------------------------------------------------------
-*
- IER = 0
-*
-* *** Is data uncompressed ?
-*
- IF (A(1).NE.0.) THEN
- IER = 3
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.1) CALL CDPRNT (LPRTCD, '(/,'' CDFLIN : Data is'//
- + ' not uncompressed !'')', IARGCD, 0)
-#endif
- GO TO 999
- ENDIF
-*
-* *** Precision ?
-*
- IPREC = A(2)
- IF (IPREC.LT.-99.OR.IPREC.GT.99) THEN
- IER = 1
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.1) CALL CDPRNT (LPRTCD, '(/,'' CDFLIN : Precisi'//
- + 'on is not correctly given - no compression'',/)', IARGCD, 0)
-#endif
- GO TO 999
- ENDIF
- IF (IPREC.EQ.0) THEN
- IER = 1
-#if defined(CERNLIB__DEBUG)
-CCC IF (IDEBCD.GT.1) CALL CDPRNT (LPRTCD, '(/,'' CDFLIN : Precisi'//
-CCC + 'on is not given - Compression cannot be made'',/)', IARGCD, 0)
-#endif
- GO TO 999
- ENDIF
- IPR1 = 0
- IPR2 = 0
- IF (IPREC.GT.0) IPR2 = IPREC
- IF (IPREC.LT.0) IPR1 = -IPREC
-*
- IF (IPR1.NE.0) THEN
- XMULT = 1./10.**IPR1
- DO 10 I = 3, N
- XXX = A(I)*XMULT
-*
-* ** Test overflow of IA - if overflow occurs, do not pack !
-*
- IF (ABS(XXX).GT.TOOBIG) THEN
- IER = 2
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.1) CALL CDPRNT (LPRTCD, '(/,'' CDFLIN : Qua'//
- + 'ntity to be packed exceeds 32-Bit Integer size - no pack'//
- + 'ing'',/)', IARGCD, 0)
-#endif
- GO TO 999
- ENDIF
-*
- IA(I) = XXX
- 10 CONTINUE
- ELSE
- XMULT = 10.**IPR2
- DO 20 I = 3, N
- XXX = A(I)*XMULT
-*
-* ** Test overflow of IA - if overflow occurs, do not pack !
-*
- IF (ABS(XXX).GT.TOOBIG) THEN
- IER = 2
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.1) CALL CDPRNT (LPRTCD, '(/,'' CDFLIN : Qua'//
- + 'ntity to be packed exceeds 32-Bit Integer size - no pack'//
- + 'ing'',/)', IARGCD, 0)
-#endif
- GO TO 999
- ENDIF
-*
- IF (XXX.GE.0.) THEN
- IA(I) = IFIX (XXX + 0.5)
- ELSE
- IA(I) = IFIX (XXX - 0.5)
- ENDIF
- 20 CONTINUE
- ENDIF
-* END CDFLIN
- 999 END
diff --git a/src/packlib/hepdb/cdpack/cdfrus.F b/src/packlib/hepdb/cdpack/cdfrus.F
deleted file mode 100644
index e95f085..0000000
--- a/src/packlib/hepdb/cdpack/cdfrus.F
+++ /dev/null
@@ -1,81 +0,0 @@
-*
-* $Id: cdfrus.F,v 1.1.1.1 1996/02/28 16:24:20 mclareni Exp $
-*
-* $Log: cdfrus.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:20 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDFRUS (LC, LU, IPREC, IRC)
-* ======================================
-*
-************************************************************************
-* *
-* SUBR. CDFRUS (LC, LU*, IPREC, IRC*) *
-* *
-* Copies bank of LC from the user system to bank at LU of the Data *
-* Base internal system (where 1st word = 0, 2nd word = IPREC) *
-* *
-* Arguments : *
-* *
-* LC Address of the input bank *
-* LU Address of the output bank *
-* IPREC Signed precision word; the data are truncated after *
-* having multiplied by 10**IPREC *
-* IRC Return code (see below) *
-* *
-* Called by CDENFZ, CDENTB, CDKOUT, CDPART *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* = 92 : Nonstandard IO descriptor *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
-#include "hepdb/czpack.inc"
- PARAMETER (JBIAS=2)
- DIMENSION LC(9), LU(9)
-*
-* ------------------------------------------------------------------
-*
- LREFCD(4) = LC(1)
- NDU = IQ(KOFUCD+LREFCD(4)-1) + 2
- ITU = ICDTYP (LREFCD(4))
- IF (ITU.NE.2 .AND. ITU.NE.3 .AND. ITU.NE.5) THEN
- IRC = 92
- IQUEST(11) = ITU
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDFRUS : Illegal'//
- + ' Data-type '',I5,/)', IQUEST(11), 1)
-#endif
- GO TO 999
- ENDIF
- CALL CDBANK (IDISCD, LU(1), LU(1), JBIAS, 'BASE', 0, 0, NDU, ITU,
- + 0, IRC)
- IF (IRC.NE.0) GO TO 999
- IF (ITU.EQ.3) THEN
- CALL UCOPY (Q(KOFUCD+LREFCD(4)+1), Q(KOFUCD+LU(1)+3), NDU-2)
- Q (KOFUCD+LU(1)+1) = 0.
- IF (PACKCZ) THEN
- Q (KOFUCD+LU(1)+2) = 0.
- ELSE
- Q (KOFUCD+LU(1)+2) = IPREC
- ENDIF
- ELSE IF (ITU.EQ.2) THEN
- CALL UCOPY (IQ(KOFUCD+LREFCD(4)+1), IQ(KOFUCD+LU(1)+3), NDU-2)
- IQ(KOFUCD+LU(1)+1) = 0
- IF (PACKCZ) THEN
- IQ(KOFUCD+LU(1)+2) = 0
- ELSE
- IQ(KOFUCD+LU(1)+2) = IPREC
- ENDIF
- ELSE IF (ITU.EQ.5) THEN
- CALL UCOPY (IQ(KOFUCD+LREFCD(4)+1), IQ(KOFUCD+LU(1)+3), NDU-2)
- IQ(KOFUCD+LU(1)+1) = 0
- IQ(KOFUCD+LU(1)+2) = 0
- ENDIF
-* END CDFRUS
- 999 END
diff --git a/src/packlib/hepdb/cdpack/cdfzin.F b/src/packlib/hepdb/cdpack/cdfzin.F
deleted file mode 100644
index c19f134..0000000
--- a/src/packlib/hepdb/cdpack/cdfzin.F
+++ /dev/null
@@ -1,61 +0,0 @@
-*
-* $Id: cdfzin.F,v 1.1.1.1 1996/02/28 16:24:20 mclareni Exp $
-*
-* $Log: cdfzin.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:20 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDFZIN (AI, NDI, AO, NDO, EPSIL, IER)
-* ================================================
-*
-************************************************************************
-* *
-* SUBR. CDFZIN (AI, NDI, AO*, NDO*, EPSIL, IER*) *
-* *
-* Compress floating point data (only nonzero elements are stored). *
-* Data are set to 0 if their absolute value is less than EPSIL *
-* *
-* Arguments : *
-* *
-* AI Input array to be compressed *
-* NDI Number of elements in AI *
-* AO Output array of the nonzero elements *
-* NDO Number of elements in AO *
-* EPSIL Cutoff value *
-* IER Error Code : 0 No error *
-* 1 NDO .ge. NDI *
-* *
-* Called by CDCMPZ *
-* *
-* Error Condition : *
-* *
-* IER = 0 : No error (see above) *
-* *
-************************************************************************
-*
- DIMENSION AI(NDI), AO(NDI)
-*
-* ------------------------------------------------------------------
-*
- IER = 0
-*
- NDO = 0
- DO 10 I = 1, NDI
- IF (ABS(AI(I)).LE.EPSIL) GO TO 10
- NDO = NDO + 1
- IF (NDO.GE.NDI) THEN
- IER = 1
- GO TO 999
- ENDIF
- AO(NDO) = I
- NDO = NDO + 1
- IF (NDO.GE.NDI) THEN
- IER = 1
- GO TO 999
- ENDIF
- AO(NDO) = AI(I)
- 10 CONTINUE
-* END CDFZIN
- 999 END
diff --git a/src/packlib/hepdb/cdpack/cdifch.F b/src/packlib/hepdb/cdpack/cdifch.F
deleted file mode 100644
index d5c4c1d..0000000
--- a/src/packlib/hepdb/cdpack/cdifch.F
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: cdifch.F,v 1.1.1.1 1996/02/28 16:24:20 mclareni Exp $
-*
-* $Log: cdifch.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:20 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDIFCH (CH, I)
-* =========================
-*
-************************************************************************
-* *
-* SUBR. CDIFCH (CH, I*) *
-* *
-* Converts single character CH (of type character) to an output *
-* integer I via the look-up table stored in CSTRCA *
-* (Adapted from CHTOI from CERN Library) *
-* *
-* Called by CDLINC *
-* *
-************************************************************************
-*
-#include "hepdb/caopti.inc"
- CHARACTER CH*1
-* ------------------------------------------------------------------
-*
- I = INDEX (CSTRCA(32:127), CH)
- I = I + 31
-* END CDIFCH
- END
diff --git a/src/packlib/hepdb/cdpack/cdifrc.F b/src/packlib/hepdb/cdpack/cdifrc.F
deleted file mode 100644
index 4933731..0000000
--- a/src/packlib/hepdb/cdpack/cdifrc.F
+++ /dev/null
@@ -1,43 +0,0 @@
-*
-* $Id: cdifrc.F,v 1.1.1.1 1996/02/28 16:24:20 mclareni Exp $
-*
-* $Log: cdifrc.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:20 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDIFRC (CH, IAR, NWD, NCH)
-* =====================================
-*
-************************************************************************
-* *
-* SUBR. CDIFRC (CH, IAR*, NWD, NCH) *
-* *
-* Converts character string CH (of type character and NCH long) *
-* to an output integer array IAR (of length NWD) via the look-up *
-* table stored in CSTRCA *
-* *
-* Called by CDLINC *
-* *
-************************************************************************
-*
-#include "hepdb/caopti.inc"
- CHARACTER CH*(*)
- DIMENSION IAR(9), IB(4)
-* ------------------------------------------------------------------
-*
- DO 10 J = 1, NWD
- K = 4*J - 4
- DO 5 L = 1, 4
- IF (K+L.LE.NCH) THEN
- I = INDEX (CSTRCA(32:127), CH(K+L:K+L))
- IB(L) = I + 31
- ELSE
- IB(L) = 31
- ENDIF
- 5 CONTINUE
- CALL PKBYT (IB, IAR(J), 1, 4, MPAKCA)
- 10 CONTINUE
-* END CDIFRC
- 999 END
diff --git a/src/packlib/hepdb/cdpack/cdinin.F b/src/packlib/hepdb/cdpack/cdinin.F
deleted file mode 100644
index 397526c..0000000
--- a/src/packlib/hepdb/cdpack/cdinin.F
+++ /dev/null
@@ -1,81 +0,0 @@
-*
-* $Id: cdinin.F,v 1.1.1.1 1996/02/28 16:24:21 mclareni Exp $
-*
-* $Log: cdinin.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:21 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDININ (IA1, IA2, N, IPREC, IER)
-* ===========================================
-*
-************************************************************************
-* *
-* SUBR. CDININ (IA1, IA2*, N, IPREC, IER*) *
-* *
-* Truncates integer to signed integer according to the given *
-* precision *
-* *
-* Arguments : *
-* *
-* IA1 Input array of integer numbers *
-* IA2 Output array of signed integers *
-* N Length of the array *
-* IPREC Signed precision word; the data are truncated after *
-* having multiplied by 10**IPREC *
-* IER Error Code : 0 No error *
-* 1 Precision not given or not correct *
-* 3 Data is not uncompressed *
-* *
-* Called by CDCMPR *
-* *
-* Error Condition : *
-* *
-* IER = 0 : No error (see above) *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
- DIMENSION IA1(N), IA2(N)
-*
-* ------------------------------------------------------------------
-*
- IER = 0
-*
-* *** Is data uncompressed ?
-*
- IF (IA1(1).NE.0) THEN
- IER = 3
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.1) CALL CDPRNT (LPRTCD, '(/,'' CDININ : Data is'//
- + ' not uncompressed - no compression'')', IARGCD, 0)
-#endif
- GO TO 999
- ENDIF
-*
-* *** Precision ?
-*
- IPREC = IA1(2)
-*
- IF (IPREC.GT.0) THEN
- IER = 1
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.1) CALL CDPRNT (LPRTCD, '(/,'' CDININ : Precisi'//
- + 'on is not correctly given - no compression'')', IARGCD, 0)
-#endif
- GO TO 999
- ENDIF
- IPR1 = -IPREC
-*
- IF (IPR1.EQ.0) THEN
- CALL UCOPY (IA1, IA2, N)
- GO TO 999
- ENDIF
- XMULT = 1./10**IPR1
- DO 10 I = 3, N
- 10 IA2(I) = IA1(I)*XMULT
- IA2(1) = IA1(1)
- IA2(2) = IA1(2)
-* END CDININ
- 999 END
diff --git a/src/packlib/hepdb/cdpack/cdizin.F b/src/packlib/hepdb/cdpack/cdizin.F
deleted file mode 100644
index b1b12d9..0000000
--- a/src/packlib/hepdb/cdpack/cdizin.F
+++ /dev/null
@@ -1,62 +0,0 @@
-*
-* $Id: cdizin.F,v 1.1.1.1 1996/02/28 16:24:21 mclareni Exp $
-*
-* $Log: cdizin.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:21 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDIZIN (IAI, NDI, IAO, NDO, EPSIL, IER)
-* ==================================================
-*
-************************************************************************
-* *
-* SUBR. CDIZIN (IAI, NDI, IAO*, NDO*, EPSIL, IER*) *
-* *
-* Compress integer data (only nonzero elements are stored). *
-* Data are set to 0 if their absolute value is less than EPSIL *
-* *
-* Arguments : *
-* *
-* IAI Input array to be compressed *
-* NDI Number of elements in IAI *
-* IAO Output array of the nonzero elements *
-* NDO Number of elements in IAO *
-* EPSIL Cutoff value *
-* IER Error Code : 0 No error *
-* 1 NDO .ge. NDI *
-* *
-* Called by CDCMPZ *
-* *
-* Error Condition : *
-* *
-* IER = 0 : No error (see above) *
-* *
-************************************************************************
-*
- DIMENSION IAI(NDI), IAO(NDI)
-*
-* ------------------------------------------------------------------
-*
- IER = 0
- IEPSI = EPSIL
-*
- NDO = 0
- DO 10 I = 1, NDI
- IF (IABS(IAI(I)).LE.IEPSI) GO TO 10
- NDO = NDO + 1
- IF (NDO.GE.NDI) THEN
- IER = 1
- GO TO 999
- ENDIF
- IAO(NDO) = I
- NDO = NDO + 1
- IF (NDO.GE.NDI) THEN
- IER = 1
- GO TO 999
- ENDIF
- IAO(NDO) = IAI(I)
- 10 CONTINUE
-* END CDIZIN
- 999 END
diff --git a/src/packlib/hepdb/cdpack/cdlinc.F b/src/packlib/hepdb/cdpack/cdlinc.F
deleted file mode 100644
index 2c005dd..0000000
--- a/src/packlib/hepdb/cdpack/cdlinc.F
+++ /dev/null
@@ -1,402 +0,0 @@
-*
-* $Id: cdlinc.F,v 1.3 1998/09/25 09:29:12 mclareni Exp $
-*
-* $Log: cdlinc.F,v $
-* Revision 1.3 1998/09/25 09:29:12 mclareni
-* Modifications for the Mklinux port flagged by CERNLIB_PPC
-*
-* Revision 1.2 1996/07/01 06:52:09 jamie
-* Linux support in CDLINC
-*
-* Revision 1.1.1.1 1996/02/28 16:24:21 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
-#if !defined(CERNLIB__P3CHILD)
- SUBROUTINE CDLINC (CLINE, LENGTH, IDATA, NDATA)
-* ===============================================
-*
-************************************************************************
-* *
-* SUBR. CDLINC (CLINE, LENGTH, IDATA*, *NDATA*) *
-* *
-* Encodes a character string into a buffer IDATA *
-* *
-* Arguments : *
-* *
-* CLINE Character string of maximum 80 characters *
-* LENGTH Length of the string *
-* IDATA Array to contain the encoded information *
-* NDATA Length of the array IDATA used so far *
-* *
-* Called by CDATOI *
-* *
-* Original Code : CPLINE in CMZ Package *
-* *
-************************************************************************
-*
- CHARACTER CLINE*(*)
- CHARACTER*4 FWORD(5), KBLANK
- CHARACTER*1 KONE, CAR, KTWO*(3)
- CHARACTER*80 KLINE
- DIMENSION LINE(20), ILINE(20)
-#if defined(CERNLIB_VAX)||defined(CERNLIB_DECS)||defined(CERNLIB_QMCVY)||(defined(CERNLIB_LINUX) && !defined(CERNLIB_PPC))
- PARAMETER (IND1=2, IND2=1)
-*.
-#endif
-#if (!defined(CERNLIB_VAX))&&(!defined(CERNLIB_DECS))&&(!defined(CERNLIB_QMCVY))&&(!(defined(CERNLIB_LINUX) && !defined(CERNLIB_PPC)))
- PARAMETER (IND1=1, IND2=2)
-#endif
- CHARACTER KENDIF*5, KELSE*4, KEND*3, KEYW*8, KCONT*8, KRET*6
-#if (!defined(CERNLIB_CRAY))&&(!defined(CERNLIB_F90))
- INTEGER*2 IWD1(2), IWD2(2)
-#endif
-#if (!defined(CERNLIB_CRAY))&&(defined(CERNLIB_F90))
- INTEGER(2) IWD1(2), IWD2(2)
-#endif
-#if !defined(CERNLIB_CRAY)
- EQUIVALENCE (IWORD1, IWD1(1))
- EQUIVALENCE (IWORD2, IWD2(1))
-#endif
-#if defined(CERNLIB_CRAY)
- INTEGER IWD1(2), IWD2(2)
-#endif
- DIMENSION IDATA(9), ICODE(6)
- SAVE KBLAN, IFIRST
-*
- DATA FWORD /'+DEC','+KEE','+SEQ','+CDE','+SEL'/
- DATA ICODE / 125, 124, 123, 122, 121, 120/
- DATA KENDIF, KEND, KRET /'ENDIF', 'END', 'RETURN'/
- DATA KELSE, KCONT /'ELSE', 'CONTINUE'/
- DATA KBLANK /' '/
- DATA IFIRST /0/
-#include "zebra/q_sbit.inc"
-* Ignoring t=pass
-#include "zebra/q_sbyt.inc"
-* Ignoring t=pass
-*
-* ------------------------------------------------------------------
-*
- IF (IFIRST.EQ.0) THEN
- IFIRST = 1
- CALL UCTOH (KBLANK, KBLAN, 4, 4)
- ENDIF
-*
- KLINE = CLINE
- CALL UCTOH (CLINE, LINE, 4, 80)
- IF (LENGTH.EQ.0) THEN
- NDATA = NDATA +1
- IDATA(NDATA)=0
- GO TO 999
- ENDIF
-#if !defined(CERNLIB_CRAY)
- IWORD2 = 0
-#endif
-#if defined(CERNLIB_CRAY)
- IWD1(1) = 0
- IWD1(2) = 0
- IWD2(1) = 0
- IWD2(2) = 0
-#endif
- KONE = KLINE(:1)
- KTWO = KLINE(2:4)
- CALL CDIFCH (KONE, IKONE)
-#if !defined(CERNLIB_CRAY)
- IWORD1 = IKONE
-#endif
-#if defined(CERNLIB_CRAY)
- IWD1(2) = IKONE
-#endif
- ILASTW = (LENGTH+3)/4
-*
-* *** Treatment of special cases : +DECK, +KEEP, +SEQ, +CDE,+SELF,+SELF.
-*
- IF (KONE.EQ.'+') THEN
- DO 10 NCAS = 1, 4
- IF (KLINE(1:4).EQ.FWORD(NCAS)) THEN
- IWD1(IND1) = ICODE(NCAS)*128
- GO TO 20
- ENDIF
- 10 CONTINUE
- IF (KLINE(1:4).NE.FWORD(5)) GO TO 40
- IWD1(IND1) = ICODE(5)*128
- IF (KLINE(6:6).EQ.'.'.AND.LENGTH.EQ.6) THEN
- IWD1(IND1) = ICODE(6)*128
-#if !defined(CERNLIB_CRAY)
- IDATA(NDATA+1) = IWORD1
-#endif
-#if defined(CERNLIB_CRAY)
- IDATA(NDATA+1) = IWD1(2)
- IDATA(NDATA+1) = MSBYT (IWD1(1), IDATA(NDATA+1), 17, 16)
-#endif
- NDATA = NDATA + 1
- GO TO 999
- ENDIF
- 20 IWD1(IND1) = IWD1(IND1) + ILASTW
- CALL CDIFRC (CLINE, ILINE, ILASTW, 4*ILASTW)
- DO 30 IW = 2, ILASTW
- IDATA(NDATA+IW) = ILINE(IW)
- 30 CONTINUE
-#if !defined(CERNLIB_CRAY)
- IDATA(NDATA+1) = IWORD1
-#endif
-#if defined(CERNLIB_CRAY)
- IDATA(NDATA+1) = IWD1(2)
- IDATA(NDATA+1) = MSBYT (IWD1(1), IDATA(NDATA+1), 17, 16)
-#endif
- NDATA = NDATA + ILASTW
- GO TO 999
- ENDIF
-*
- 40 NWI = 1
- IFIRW = 1
- IF (ILASTW.EQ.1) GO TO 80
- DO 50 I = 2, 20
- IF (LINE(I).EQ.KBLAN) GO TO 50
- IFIRW = I
- GO TO 60
- 50 CONTINUE
- 60 CONTINUE
-*
-* *** For ENDIF , ELSE , END (without label) and RETURN (without label),
-* *** use code in bits 24 to 30 = 127, 126, 118, 116
-*
- IF (KLINE(:6).EQ.' ') THEN
- NC1 = (IFIRW-1)*4+1
- 70 IF (KLINE(NC1:NC1).EQ.'.') THEN
- NC1 = NC1 + 1
- GO TO 70
- ENDIF
- IF (LENGTH-NC1.GT.5) GO TO 170
- KEYW = KLINE(NC1:LENGTH)
- CALL CLTOU (KEYW(:LENGTH-NC1+1))
- IF (KEYW.EQ.KENDIF) THEN
- IWD1(IND1) = 127*128 + NC1
- ELSE IF (KEYW.EQ.KELSE) THEN
- IWD1(IND1) = 126*128 + NC1
- ELSE IF (KEYW.EQ.KEND) THEN
- IWD1(IND1) = 118*128 + NC1
- ELSE IF (KEYW.EQ.KRET) THEN
- IWD1(IND1) = 116*128 + NC1
- ELSE
- GO TO 170
- ENDIF
- NDATA = NDATA + 1
-#if !defined(CERNLIB_CRAY)
- IDATA(NDATA) = IWORD1
-#endif
-#if defined(CERNLIB_CRAY)
- IDATA(NDATA) = IWD1(2)
- IDATA(NDATA) = MSBYT (IWD1(1), IDATA(NDATA), 17, 16)
-#endif
- GO TO 999
- ENDIF
-*
- 80 IF (KTWO.NE.' ') THEN
-*
-* *** Bit 31 = 1
-*
- IWD1(IND1) = 16384
- NWI = 2
- CALL CDIFRC (KTWO, IDATA(NDATA+2), 1, 3)
- ENDIF
-*
- IF (KONE.EQ.'C') THEN
- ICOM = 4
- ELSE IF (KONE.EQ.'c') THEN
- ICOM = 8
- ELSE IF (KONE.EQ.'*') THEN
- ICOM = 12
- ELSE
- ICOM = 0
- ENDIF
- IF (ICOM.NE.0) THEN
-*
-* *** Bit 32 = 1 and bits 1-4 = 4 or 8 or 12 depending
-* *** upon KONE = C or c or *
-*
-#if (!defined(CERNLIB_CRAY))&&(!defined(CERNLIB_DECS))&&(!defined(CERNLIB_IBMVM))&&(!defined(CERNLIB_LENDIAN))&&(!defined(CERNLIB_SUN))&&(!defined(CERNLIB_VAXVMS))
- IWD1(IND1) = IWD1(IND1) + 32768
-#endif
-#if defined(CERNLIB_DECS)||defined(CERNLIB_IBMVM)||defined(CERNLIB_LENDIAN)||defined(CERNLIB_SUN)||defined(CERNLIB_VAXVMS)
- IWORD1 = MSBIT1 (IWORD1, 32)
-#endif
-#if defined(CERNLIB_CRAY)
- IWD1(1) = MSBIT1 (IWD1(1), 16)
-#endif
-*
- IWD1(IND2) = ICOM
-*
- IF (KTWO.EQ.'.')THEN
-*
-* *** Bit 2 =1 and Bit 31 = 0
-*
-#if (!defined(CERNLIB_CRAY))&&(!defined(CERNLIB_DECS))&&(!defined(CERNLIB_IBMVM))&&(!defined(CERNLIB_LENDIAN))&&(!defined(CERNLIB_SUN))&&(!defined(CERNLIB_VAXVMS))
- IWD1(IND1) = 32768
-#endif
-#if defined(CERNLIB_DECS)||defined(CERNLIB_IBMVM)||defined(CERNLIB_LENDIAN)||defined(CERNLIB_SUN)||defined(CERNLIB_VAXVMS)
- IWORD1 = MSBIT0 (IWORD1, 31)
-#endif
-#if defined(CERNLIB_CRAY)
- IWD1(1) = MSBIT0 (IWD1(1), 15)
-#endif
- NWI = 1
- IWD1(IND2) = IWD1(IND2) + 2
- ENDIF
- IF (ILASTW.LE.2) GO TO 170
-*
-* ** Is there a box ?
-* ** Look for last isolated character
-*
- LEN2 = LENOCC (KLINE(:(LENGTH-1)))
- IF ((LENGTH-LEN2).GT.7) THEN
-*
-* ** A box is there ====> Bit 1 =1
-*
- IWD1(IND2) = IWD1(IND2) + 1
- ILASTW = (LEN2+3)/4
- CALL CDIFCH (KLINE(LENGTH:LENGTH), IKLIN)
- IWD2(IND2) = LENGTH*256 + IKLIN
-*
-* ** Look for the first isolated character
-*
- NC1 = (IFIRW-1)*4+1
- NC2 = NC1+3
- IPOS = NC1
- NKAR = 0
- DO 90 IC = NC1, NC2
- IF (KLINE(IC:IC).EQ.' ') GO TO 90
- IPOS = IC
- NKAR = NKAR+1
- 90 CONTINUE
- IF (NKAR.EQ.1) THEN
- DO 100 IST = IFIRW+1, ILASTW
- IF (LINE(IST).EQ.KBLAN) GO TO 100
- IFIRW = IST
- CALL CDIFCH (KLINE(IPOS:IPOS), IKLIN)
- IWD2(IND1) = IPOS*256 + IKLIN
- GO TO 110
- 100 CONTINUE
- ENDIF
- 110 NWI=NWI+1
-#if !defined(CERNLIB_CRAY)
- IDATA(NDATA+NWI) = IWORD2
-#endif
-#if defined(CERNLIB_CRAY)
- IDATA(NDATA+NWI) = IWD2(2)
- IDATA(NDATA+NWI) = MSBYT (IWD2(1), IDATA(NDATA+NWI), 17, 16)
-#endif
- ENDIF
-*
-* ** Is any character repeated ?
-*
- IF (ILASTW.EQ.1) GO TO 170
- DO 120 I = IFIRW+2, ILASTW-1
- IF (LINE(I).NE.LINE(I-1)) GO TO 170
- 120 CONTINUE
-*
-* ** Are the characters identical ?
-* ** NFCOL2 = first column number of the second non-blank character
-* ** NLCOL2 = last " " " " "
-*
- NFCOL2 = IFIRW*4+1
- NLCOL2 = NFCOL2+3
- DO 130 I = NFCOL2+1, NLCOL2
- IF (KLINE(I:I).NE.KLINE(I-1:I-1)) GO TO 170
- 130 CONTINUE
- CAR = KLINE(NFCOL2:NFCOL2)
-*
-* ** Check whether the non-blank characters in the first and
-* ** the last word are also identical to CAR
-*
- NFCOL = (IFIRW-1)*4 + 1
- NLCOL = NFCOL + 3
- NFIRST = NFCOL
- NLAST = NFCOL
- DO 150 J = 1, 2
- DO 140 I = NFCOL, NLCOL
- IF (KLINE(I:I).EQ.' ') THEN
- IF (J.EQ.1) NFIRST = I + 1
- GO TO 140
- ENDIF
- IF (KLINE(I:I).NE.CAR) GO TO 170
- NLAST = I
- 140 CONTINUE
- NFCOL = (ILASTW-1)*4 + 1
- NLCOL = NFCOL + 3
- 150 CONTINUE
-*
-* ** All characters are identical
-* ** NFIRST = number of the first non-blank character
-* ** NLAST = " last " "
-*
- IWD1(IND1) = IWD1(IND1) + NLAST*128 + NFIRST
- CALL CDIFCH (CAR, IKLIN)
- IWD1(IND2) = IWD1(IND2) + 256*IKLIN
-#if !defined(CERNLIB_CRAY)
- IDATA(NDATA+1) = IWORD1
-#endif
-#if defined(CERNLIB_CRAY)
- IDATA(NDATA+1) = IWD1(2)
- IDATA(NDATA+1) = MSBYT (IWD1(1), IDATA(NDATA+1), 17, 16)
-#endif
- NDATA = NDATA + NWI
- GO TO 999
- ELSE IF (KONE.NE.'%' .AND. KONE.NE.'+' .AND. KLINE(6:6).EQ.' '
- + .AND. LENGTH.GT.7) THEN
-*
-* ** For cases : CONTINUE , END and RETURN preceded by a label,
-* ** use code in bits 24 to 30 = 117 , 119 or 115
-*
- NC1 = 7
- 160 IF (KLINE(NC1:NC1).EQ.' ') THEN
- NC1 = NC1 + 1
- GO TO 160
- ENDIF
- IF (LENGTH-NC1.GT.7) GO TO 170
- KEYW = KLINE(NC1:LENGTH)
- CALL CLTOU (KEYW(:LENGTH-NC1+1))
- IF (KEYW.EQ.KEND) THEN
- IWD1(IND1) = IWD1(IND1) + 119*128 + NC1
- ELSE IF(KEYW.EQ.KCONT) THEN
- IWD1(IND1) = IWD1(IND1) + 117*128 + NC1
- ELSE IF(KEYW.EQ.KRET) THEN
- IWD1(IND1) = IWD1(IND1) + 115*128 + NC1
- ELSE
- GO TO 170
- ENDIF
- CALL CDIFCH (KLINE(5:5), IKLIN)
- IWD1(IND2) = IWD1(IND2) + 256*IKLIN
-#if !defined(CERNLIB_CRAY)
- IDATA(NDATA+1) = IWORD1
-#endif
-#if defined(CERNLIB_CRAY)
- IDATA(NDATA+1) = IWD1(2)
- IDATA(NDATA+1) = MSBYT (IWD1(1), IDATA(NDATA+1), 17, 16)
-#endif
- NDATA = NDATA+NWI
- GO TO 999
- ENDIF
- 170 CONTINUE
- IWD1(IND1) = IWD1(IND1) + ILASTW*128 + IFIRW
-#if !defined(CERNLIB_CRAY)
- IDATA(NDATA+1) = IWORD1
-#endif
-#if defined(CERNLIB_CRAY)
- IDATA(NDATA+1) = IWD1(2)
- IDATA(NDATA+1) = MSBYT (IWD1(1), IDATA(NDATA+1), 17, 16)
-#endif
- IF (ILASTW.EQ.1) THEN
- NDATA = NDATA + NWI
- GO TO 999
- ENDIF
- CALL CDIFRC (CLINE, ILINE, ILASTW, 4*ILASTW)
- DO 180 IW = IFIRW, ILASTW
- JW = NDATA + NWI + IW - IFIRW + 1
- IDATA(JW) = ILINE(IW)
- 180 CONTINUE
- NDATA = NDATA + NWI + ILASTW - IFIRW + 1
-* END CDLINC
- 999 END
-#endif
diff --git a/src/packlib/hepdb/cdpack/cdpack.F b/src/packlib/hepdb/cdpack/cdpack.F
deleted file mode 100644
index a2e2149..0000000
--- a/src/packlib/hepdb/cdpack/cdpack.F
+++ /dev/null
@@ -1,138 +0,0 @@
-*
-* $Id: cdpack.F,v 1.2 1996/05/01 13:47:10 cernlib Exp $
-*
-* $Log: cdpack.F,v $
-* Revision 1.2 1996/05/01 13:47:10 cernlib
-* do not try to include zebra/q_cbyt.inc. This no longer exists
-*
-* Revision 1.1.1.1 1996/02/28 16:24:21 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDPACK (IAIN, LIN, LOU, LAUX, LBITL, IAOU, IAUX)
-* ===========================================================
-*
-************************************************************************
-* *
-* SUBR. CDPACK (IAIN, LIN, LOU*, LAUX*, LBITL, IAOU*, IAUX) *
-* *
-* Compresses data from 32 to LBITL bit size *
-* *
-* Arguments : *
-* *
-* IAIN Input array *
-* LIN Length of the input array *
-* LOU Length of the output array *
-* LAUX Number of words exceeding the length LBITL and therefore*
-* are stored in 32 bits with locations given *
-* LBITL Number of bits to be used for storing *
-* IAOU Output array *
-* IAUX Auxiliary array for internal working space *
-* *
-* Called by CDCMPR *
-* *
-************************************************************************
-*
- DIMENSION IAIN(LIN), IAOU(LIN), IAUX(LIN)
- DIMENSION IHB(33), LHB(32), AHB(32)
- DATA MINBIT /2/ , IBIG /9999999/
-#include "zebra/q_jbit.inc"
-* Ignoring t=pass
-#include "zebra/q_sbyt.inc"
-* Ignoring t=pass
-*#include "zebra/q_cbyt.inc"
-* Ignoring t=pass
-*
-* ------------------------------------------------------------------
-*
- CALL VZERO (IHB, 33)
- CALL VZERO (IAOU, LIN)
- CALL VFILL (LHB, 32, IBIG)
-*
-* *** Histogram of the input stream bit-length
-*
- DO 3 I = 1, LIN
- DO 1 J = 1, 32
- J1 = 33 - J
- IF (JBIT(IAIN(I),J1).EQ.1) GO TO 2
- 1 CONTINUE
- 2 IHB(J1) = IHB(J1) + 1
- 3 CONTINUE
-*
-* *** Look for the minimum storage length
-*
- NW = 0
- JJ = 33 - MINBIT
- DO 4 J = 1, JJ
- J1 = 33 - J
- NW = NW + IHB(J1+1)
- LHB(J1) = (LIN*J1-1)/32 + 2*NW
- 4 CONTINUE
-*
- CALL VFLOAT (LHB, AHB, 32)
- LBITL = LVMIN (AHB, 32)
- IF (LHB(LBITL)+1.GE.LIN) GO TO 991
-*
- ICOMP = LBITL + 1
- NCOMP = 32 - LBITL
-*
-* *** Pack the input with LBITL byte size
-* *** (If input is longer then LBITL, write it in a separate
-* *** output word at the end of the buffer)
-*
- LAUX = 0
- LOU = 1
- IN = 1
- IB = 1
- 11 CONTINUE
- IF (NCOMP.GT.0) THEN
- ICHECK = JBYT (IAIN(IN), ICOMP, NCOMP)
- ELSE
- ICHECK = 0
- ENDIF
- IBA = IB + LBITL
- IF (IBA.LE.32) THEN
- IF (LBITL.GT.0)
- + IAOU(LOU) = MSBYT (IAIN(IN), IAOU(LOU), IB, LBITL)
- IB = IBA
- ELSE
- LBIT1 = 32 - IB + 1
- IF (LBIT1.GT.0)
- + IAOU(LOU) = MSBYT (IAIN(IN), IAOU(LOU), IB, LBIT1)
-* ITEST = JBYT (IAOU(LOU), IB, LBIT1)
- IB = IBA - 32
- LOU = LOU + 1
- IF (IB.GT.1)
- + IAOU(LOU) = MCBYT (IAIN(IN), LBIT1+1, IAOU(LOU), 1, IB-1)
-* ITEST = MSBYT (IAOU(LOU), ITEST, LBIT1+1, IB-1)
- ENDIF
- IF (ICHECK.NE.0) THEN
- IF (LAUX+2.GT.LIN) GO TO 991
- IAUX(LAUX+1) = IN
- IAUX(LAUX+2) = IAIN(IN)
- LAUX = LAUX + 2
- ENDIF
- IF (IN.LT.LIN) THEN
- IN = IN + 1
- GO TO 11
- ENDIF
-*
- ICAR = 0
- IF (IAOU(LOU+1).NE.0) ICAR = IAOU(LOU+1)
- IF (LAUX.GT.0) THEN
- IF (LOU+LAUX.GT.LIN) GO TO 991
- DO 21 I = 1, LAUX
- 21 IAOU(LOU+I) = IAUX(I)
- IF (ICAR.NE.0) IAOU(LIN) = ICAR
- LOU = LOU + LAUX
- ENDIF
- GO TO 999
-*
- 991 CONTINUE
- CALL UCOPY (IAIN, IAOU, LIN)
- LOU = LIN
- LBITL = 32
- LAUX = 0
-* END CDPACK
- 999 END
diff --git a/src/packlib/hepdb/cdplot/Imakefile b/src/packlib/hepdb/cdplot/Imakefile
deleted file mode 100644
index 80c9874..0000000
--- a/src/packlib/hepdb/cdplot/Imakefile
+++ /dev/null
@@ -1,4 +0,0 @@
-SRCS_F= cdioty.F cdntpl.F cdplbk.F cdplob.F cdplov.F cdplti.F \ @@\
- cdtimc.F cdtimm.F cdtims.F cdusin.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/hepdb/cdplot/cdioty.F b/src/packlib/hepdb/cdplot/cdioty.F
deleted file mode 100644
index 2ee29ae..0000000
--- a/src/packlib/hepdb/cdplot/cdioty.F
+++ /dev/null
@@ -1,102 +0,0 @@
-*
-* $Id: cdioty.F,v 1.1.1.1 1996/02/28 16:24:22 mclareni Exp $
-*
-* $Log: cdioty.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:22 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDIOTY (LAD, NOBJ, KOBJ, IOTY)
-* =========================================
-*
-************************************************************************
-* *
-* SUBR. CDIOTY (LAD, NOBJ, KOBJ, IOTY*) *
-* *
-* Prepares the IO format of a list of elements in a bank from the *
-* bank IO descriptor *
-* *
-* Arguments : *
-* *
-* LAD Address of the data in CDSTOR *
-* NOBJ Number of elements to be considered *
-* KOBJ Indices of the elements *
-* IOTY Variable type (2 for integer, 3 for floating point,..) *
-* *
-* Called by CDNTPL, CDPLOB, CDPLOV *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
-#include "zebra/mzioc.inc"
- DIMENSION KOBJ(9), IOTY(9)
-#include "zebra/q_jbit.inc"
-* Ignoring t=pass
-*
-* ------------------------------------------------------------------
-*
-* ** No data to display
-*
- IF (NOBJ.LE.0) GO TO 999
- DO 5 I = 1, NOBJ
- 5 IOTY(I) = 3
- IF (LAD.LE.0) GO TO 999
- NDAT = IQ(KOFUCD+LAD-1)
- IF (NDAT.LE.0) GO TO 999
-*
-* ** Crack I/O Words into the character description
-*
- LIO = LAD - IQ(KOFUCD+LAD-3) - JBYT(IQ(KOFUCD+LAD),19,4) - 1
- CALL MZIOCR (LQ(KOFUCD+LIO))
-*
-* ** This part (upto the RETURN) is by courtesy of J. Zoll
-*
- NDONE = 0
- JFOCUR = 0
- 10 ITYPE = MFO(JFOCUR+1)
- IF (ITYPE.EQ.7) GO TO 15
- NWSEC = MFO(JFOCUR+2)
- NDO = NWSEC
- IT = ITYPE
- IF (NDO.GT.0) GO TO 30
-*
- IF (NDO.LT.0) THEN
-*
-* * Rest of the bank
-*
- NDO = NDAT
- ELSE
-*
-* * Dynamic sector
-*
- NDONE = NDONE + 1
- NDO = IQ(KOFUCD+LAD+NDONE)
- ENDIF
- GO TO 20
-*
-* ** Self-describing sector
-*
- 15 NDONE = NDONE + 1
- IWORD = IQ(KOFUCD+LAD+NDONE)
- IT = MOD (IWORD,16)
- NDO = IWORD/16
-*
- 20 IF (IT.GE.8) GO TO 999
- IF (NDO.LT.0) GO TO 999
- IF (NDO.EQ.0) GO TO 999
-*
- 30 JS = NDONE + 1
- JE = MIN (NDONE+NDO, NDAT)
- DO 35 I = 1, NOBJ
- IF (KOBJ(I).GE.JS.AND.KOBJ(I).LE.JE) IOTY(I) = IT
- 35 CONTINUE
- NDONE = JE
- IF (NDONE.GE.NDAT) GO TO 999
-*
- JFOCUR = JFOCUR + 2
- IF (JFOCUR.LT.JFOEND) GO TO 10
- JFOCUR = JFOREP
- GO TO 10
-* END CDIOTY
- 999 END
diff --git a/src/packlib/hepdb/cdplot/cdntpl.F b/src/packlib/hepdb/cdplot/cdntpl.F
deleted file mode 100644
index 2b42bdc..0000000
--- a/src/packlib/hepdb/cdplot/cdntpl.F
+++ /dev/null
@@ -1,779 +0,0 @@
-*
-* $Id: cdntpl.F,v 1.1.1.1 1996/02/28 16:24:22 mclareni Exp $
-*
-* $Log: cdntpl.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:22 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDNTPL (NTUP, PATHS, NPATH, NOBJS, KOBJS, NKEYX,
- + KEYXS, MASK, KEYS, CHOPT, IRC)
-* ===========================================================
-*
-************************************************************************
-* *
-* SUBR. CDNTPL (NTUP, PATHS, NPATH, NOBJS, KOBJS, NKEYX, *
-* KEYXS, MASK, KEYS, CHOPT, IRC*) *
-* *
-* Fills an N-tuple with data and key elements from multiple *
-* directories as requested by the user. *
-* Selects objects with validity range as specified in KEYS(NOF1CK..) *
-* if the proper masks are used. It sees the object in data base has *
-* lower range smaller than and higher range larger than the value *
-* specified. Selection on insertion time demands data base object *
-* to be inserted before the value supplied in selection *
-* *
-* Arguments : *
-* *
-* NTUP Integer identifier of the ntuple *
-* PATHS Character array describing the path names *
-* NPATH Number of paths given in PATHS *
-* NOBJS Array giving the number of data elements to be stored *
-* for PATHS(i) *
-* KOBJS Vector specifying the element indices to be stored for *
-* PATHS(i) *
-* NKEYX Array giving the number of key elements to be stored *
-* with data for PATHS(i) *
-* KEYXS Array giving key element indices to be stored with the *
-* data. For a given path, data elements follow the key *
-* elements *
-* MASK Integer vector indicating which elements of KEYS are *
-* significant for selection. If MASK corresponding to *
-* one of the fields of 'Beginning' validity range is set, *
-* it will select objects with start validity larger than *
-* those requested in KEYS. If MASK corresponding to one *
-* of the fields of 'End' validity range is set, it will *
-* select objects with start validity smaller than those *
-* in the KEYS vector (in the fields corresponding to end *
-* validity). If MASK corresponding to time of insertion *
-* is set, objects inserted earlier than KEYS(IDHINS) are *
-* selected *
-* KEYS Vector of keys. Only the elements declared in CHOPT are *
-* considered to contain useful information. The vector as *
-* well as CHOPT refers to the PATHS(1). Selections for *
-* all subsequent paths is done on the basis of start *
-* validity period from path 1 and a correlation table *
-* between the user keys. *
-* CHOPT Character string with any of the following characters *
-* T Transforms the time keys (insertion and validity time) *
-* to seconds/minutes passed since midnight January 1,1980 *
-* X Assumes validity range packed time ala CDPKTS *
-* IRC Return code (see below) *
-* *
-* Called by Interactive interface *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* =161 : Illegal path name *
-* =162 : No keys or data in the directory *
-* =163 : Illegal number of objects *
-* =164 : Illegal number of path names *
-* =165 : Illegal object element indices *
-* =166 : Illegal key element indices *
-* *
-************************************************************************
-*
-#include "hepdb/caopts.inc"
-#include "hepdb/cdcblk.inc"
-#include "hepdb/cinitl.inc"
-#include "hepdb/ckkeys.inc"
-#include "hepdb/clinks.inc"
-#include "hepdb/cplots.inc"
-#include "hepdb/ctpath.inc"
- PARAMETER (JBIAS=2)
- CHARACTER PATHY*80, PATHN*80, CTAG(25)*16
- CHARACTER*(*) PATHS(*), CHOPT
- DIMENSION KEYS(9), KEYXS(9), KOBJS(9), NKEYX(9), NOBJS(9)
- DIMENSION MASK(9), KEYU(MXDMCK), ITIME(MXPACD)
- DOUBLE PRECISION DVAL
-#include "zebra/q_jbit.inc"
-* Ignoring t=pass
-*
-* ------------------------------------------------------------------
-*
-* *** Prepare object and key vector specifiers for different paths
-*
- IF (NPATH.LT.1.OR.NPATH.GT.NPMXCP) THEN
- IRC = 164
- IQUEST(11) = NPATH
- IQUEST(12) = NPMXCP
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDNTPL : Illegal'//
- + ' number of path names '',2I10)', IQUEST(11), 2)
-#endif
- GO TO 999
- ENDIF
-*
- NDSMCP(1) = 0
- NKSMCP(1) = 0
- NKSTCP(1) = 0
- DO 10 J = 1, NPATH
- IF (NKEYX(J).LT.0.OR.NOBJS(J).LT.0.OR.NKEYX(J)+NOBJS(J).LE.0)
- + THEN
- IRC = 163
- IQUEST(11) = MIN0 (NKEYX(J), NOBJS(J))
- IQUEST(12) = NOBMCP
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) THEN
- PATHY = PATHS(J)
- CALL CDPRNT (LPRTCD, '(/,'' CDNTPL : Illegal number of ob'//
- + 'ject '',2I9,'' for '//PATHY(1:40)//''')',IQUEST(11),2)
- ENDIF
-#endif
- GO TO 999
- ENDIF
- IF (J.GT.1) THEN
- NDSMCP(J) = NDSMCP(J-1) + NOBJS(J-1)
- NKSMCP(J) = NKSMCP(J-1) + NKEYX(J-1)
- NKSTCP(J) = NDSTCP(J-1) + NOBJS(J-1)
- ENDIF
- NDSTCP(J) = NKSTCP(J) + NKEYX(J)
- IBEGCP(J) = 0
- NDEMCP(J) = 0
- DO 5 I = 1, NOBJS(J)
- IOBJ = KOBJS(NDSMCP(J)+I)
- IF (IOBJ.LT.1) THEN
- IRC = 165
- IQUEST(11) = IOBJ
- IQUEST(12) = I
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) THEN
- PATHY = PATHS(J)
- CALL CDPRNT (LPRTCD, '(/,'' CDNTPL : Illegal data eleme'//
- + 'nt index '',2I9,'' for '//PATHY(1:40)//''')',
- + IQUEST(11), 2)
- ENDIF
-#endif
- GO TO 999
- ENDIF
- IF (IOBJ.GT.NDEMCP(J)) NDEMCP(J) = IOBJ
- 5 CONTINUE
- 10 CONTINUE
- NTOT = NDSTCP(NPATH) + NOBJS(NPATH)
- IF (NTOT.LE.0.OR.NTOT.GT.NOBMCP) THEN
- IRC = 163
- IQUEST(11) = NTOT
- IQUEST(12) = NOBMCP
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDNTPL : Illegal'//
- + ' number of objects '',2I9,'' for All Paths'')', IQUEST(11), 2)
-#endif
- GO TO 999
- ENDIF
- CALL VZERO (IOTYCP, NTOT)
- NPLM = NPLMCP
- CALL HCDIR (PATHN, 'R')
-*
-* *** Decode the character option
-*
- CALL CDOPTS (CHOPT, IRC)
- IF (IRC.NE.0) GO TO 999
- CALL UCOPY (MASK, IOKYCA, MXDMCK)
-*
-* *** Find the keys on the basis of which selection is to be made
-*
- DO 35 NPT = 1, NPATH
-*
-* ** Suppress blanks from the pathname and set current directory
-*
- CALL CDLDUP (PATHS(NPT), 0, IRC)
- IF (IRC.NE.0) GO TO 999
- PATHY = PAT1CT
- CALL CDKYTG
-*
- IF (NKEYCK.LE.0) THEN
- IRC = 162
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDNTPL : No '//
- + 'keys in directory '//PATHY//''')', IARGCD, 0)
-#endif
- GO TO 999
- ENDIF
-*
-* ** Load number of user keys to be tested for selection
-* ** for each path and their indices
-*
- NSKYCP(NPT) = 0
- IF (NPT.EQ.1) THEN
- DO 15 I = NSYSCK+1, NWKYCK
- IF (IOKYCA(I).NE.0) THEN
- NSKYCP(NPT) = NSKYCP(NPT) + 1
- NKEYCP(NSKYCP(NPT),NPT) = I
- KKEYCP(NSKYCP(NPT),NPT) = I
- CTAG(NSKYCP(NPT)) = CTAGCK(I)
- ENDIF
- 15 CONTINUE
- ELSE IF (NSKYCP(1).GT.0) THEN
- DO 25 I = 1, NSKYCP(1)
- DO 20 J = NSYSCK+1, NWKYCK
- IF (CTAG(I).EQ.CTAGCK(J)) THEN
- NSKYCP(NPT) = NSKYCP(NPT) + 1
- NKEYCP(NSKYCP(NPT),NPT) = J
- KKEYCP(NSKYCP(NPT),NPT) = NKEYCP(I,1)
- GO TO 25
- ENDIF
- 20 CONTINUE
- 25 CONTINUE
- ENDIF
-*
-* ** Load the IO type of the keys
-*
- DO 30 I = 1, NKEYX(NPT)
- IK = KEYXS(NKSMCP(NPT)+I)
- IF (IK.LT.1.OR.IK.GT.NWKYCK) THEN
- IRC = 166
- IQUEST(11) = I
- IQUEST(12) = IK
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDNTPL : Ill'//
- + 'egal key element index'',2I9,'' for '//PATHY(1:40)//''')',
- + IQUEST(11), 2)
-#endif
- GO TO 999
- ENDIF
- IF (IOTYCK(IK).NE.6) THEN
- IOTYCP(NKSTCP(NPT)+I) = IOTYCK(IK)
- ELSE
- IOTYCP(NKSTCP(NPT)+I) = 5
- ENDIF
- 30 CONTINUE
-*
-* ** Find maximum number of objects from Path 1
-*
- IF (NPT.EQ.1) THEN
- IOPTP = JBIT (IQ(KOFSCD+LCDRCD+IKDRCD+IDHFLG), JPRTCD)
- NPAIR = NPARCD
- IF (IOPTP.EQ.0) THEN
- IF (NKEYCK.LT.NPLM) NPLM = NKEYCK
- ENDIF
- ENDIF
- 35 CONTINUE
-*
-* *** Prepare temporary storage
-*
- CALL DATIME (IDATX, ITIMX)
- CALL CDPKTS (IDATX, ITIMX*100, INOWS, IRC)
- ND = (NTOT + NPAIR) * NPLM
- IF (LAUXCL(10).NE.0) CALL MZDROP (IDISCD, LAUXCL(10), 'L')
- CALL CDBANK (IDISCD, LAUXCL(10), LAUXCL(10), 2, 'TEMP', 0, 0, ND,
- + 0, -1, IRC)
- IF (IRC.NE.0) GO TO 999
- NCUR = 0
- NCURD = 0
- NBAD = 0
- NOLD = 0
- NOLDD = 0
-*
-* *** Load useful data in the temp bank from Path 1
-*
- 40 NPL = 0
- CALL CDLDUP (PATHS(1), 0, IRC)
- IF (IRC.NE.0) GO TO 999
- PATHY = PAT1CT
- NCHR = LENOCC (PATHY)
- CALL CDKEYT
- IOPTP = JBIT (IQ(KOFSCD+LCDRCD+IKDRCD+IDHFLG), JPRTCD)
- IF (LAUXCL(9).NE.0) THEN
- CALL MZDROP (IDISCD, LAUXCL(9), 'L')
- LAUXCL(9) = 0
- ENDIF
- IPRBCA = ISIGN (IPRBCA, -1)
- IPRECA = ISIGN (IPRECA, -1)
- IF (IPRBCA.EQ.0.AND.IPRECA.EQ.0) THEN
- IFLG = 99
- ELSE
- IFLG = 0
- ENDIF
- DO 45 I = 1, NPAIR
- ITIME(I) = 1
- 45 CONTINUE
- IF (NWKYCK.GT.NSYSCK) THEN
- DO 50 I = NSYSCK+1, NWKYCK
- IOKYCA(I) = MASK(I)
- 50 CONTINUE
- ENDIF
-*
- IF (IOPTP.EQ.0) THEN
-*
-* ** For non-parttioned directories
-*
- DO 70 IK = NCUR+1, NKEYCK
- CALL CDKEYR (IK, NWKYCK, KEYVCK)
-*
-* ** Store the time values for the subsequent loop runs
-*
- CALL CDKSEL (ITIME, KEYS, KEYVCK, IFLG, ISEL, INBR)
- IF (ISEL.NE.0) GO TO 70
- IF (IOPXCA.NE.0.AND.KEYVCK(NOF1CK+1).GT.INOWS) GO TO 70
- IF (NOBJS(1).GT.0) THEN
- LAUXCL(9) = 0
- CALL VZERO (KEYVCK, NWKYCK)
- KEYVCK(IDHKSN) = IK
- IOKYCA(IDHKSN) = 1
- CALL CDKXIN (ITIME, IDISCD, LAUXCL(9), LAUXCL(9), JBIAS,
- + NWKYCK, KEYVCK, IPREC, IRC)
- IOKYCA(IDHKSN) = 0
- IF (IRC.NE.0) THEN
- IF (LAUXCL(9).NE.0) CALL MZDROP (IDISCD, LAUXCL(9), 'L')
- IRC = 0
- GO TO 70
- ENDIF
- IF (NDEMCP(1).GT.IQ(KOFUCD+LAUXCL(9)-1)) THEN
- NBAD = NBAD +1
- CALL MZDROP (IDISCD, LAUXCL(9), 'L')
- GO TO 70
- ENDIF
- IF (IBEGCP(1).EQ.0) THEN
- IBEGCP(1) = 1
- CALL CDIOTY (LAUXCL(9), NOBJS(1), KOBJS(NDSMCP(1)+1),
- + IOTYCP(NDSTCP(1)+1))
- ENDIF
- ENDIF
- NPL = NPL + 1
- IF (NPL.GT.NPLM) THEN
- NPL = NPLM
- NCUR = IK - 1
- GO TO 100
- ENDIF
-*
-* ** Load the requested keys and the begin validity
-*
- IPNT = KOFUCD + LAUXCL(10) + (NPL - 1) * (NTOT + NPAIR)
- DO 55 I = 1, NPAIR
- IQ(IPNT+I) = KEYVCK(NOF1CK+I)
- 55 CONTINUE
- DO 60 I = 1, NKEYX(1)
- IND = KEYXS(NKSMCP(1)+I)
- IF (IOPTCA.NE.0.AND.IND.NE.IDHINS) THEN
- CALL CDTIMM (KEYVCK(IND), IVAL)
- Q(IPNT+NKSTCP(1)+I+NPAIR) = IVAL
- ELSE IF (IOPTCA.NE.0.AND.IOPXCA.NE.0.AND.(IND.GT.NOF1CK.AND.
- + IND.LE.NOF1CK+2*NPARCD)) THEN
- CALL CDTIMS (KEYVCK(IND), IVAL)
- Q(IPNT+NKSTCP(1)+I+NPAIR) = IVAL
- ELSE
- Q(IPNT+NKSTCP(1)+I+NPAIR) = KEYVCK(IND)
- ENDIF
- 60 CONTINUE
- DO 65 I = 1, NOBJS(1)
- ID = NDSTCP(1) + I
- II = KOBJS(NDSMCP(1)+I)
- IF (IOTYCP(ID).EQ.1.OR.IOTYCP(ID).EQ.2.OR.IOTYCP(ID).EQ.5)
- + THEN
- IVAL = IQ(KOFUCD+LAUXCL(9)+II)
- Q(IPNT+ID+NPAIR) = IVAL
- ELSE IF (IOTYCP(ID).EQ.4) THEN
- CALL UCOPY (Q(KOFUCD+LAUXCL(9)+II), DVAL, 2)
- Q(IPNT+ID+NPAIR) = DVAL
- ELSE
- Q(IPNT+ID+NPAIR) = Q(KOFUCD+LAUXCL(9)+II)
- ENDIF
- 65 CONTINUE
- CALL MZDROP (IDISCD, LAUXCL(9), 'L')
- 70 CONTINUE
-*
- ELSE
-*
-* ** Partitioned directory
-*
- KST = NWKYCK + 1
- NKEYS = NKEYCK
- NCUS = NCUR
- DO 95 IKK = NCURD+1, NKEYS
- KPNT = IUHUNT (IKK, IQ(KOFSCD+LCDRCD+IKDRCD+MPSRCD),
- + NKEYS*KST, KST)
- IF (KPNT.GT.0) THEN
- KPNT = KOFSCD + LCDRCD + IKDRCD +KPNT - MPSRCD
- ELSE
- KPNT = KOFSCD + LCDRCD + IKDRCD + (IKK - 1) * KST
- ENDIF
- CALL CDPSEL (ITIME, KEYS, IQ(KPNT+1), IFLG, ISEL)
- IF (ISEL.NE.0) GO TO 95
- IF (IOPXCA.NE.0.AND.IQ(KPNT+NOF1CK+1).GT.INOWS) GO TO 95
-*
- CALL CDPATH (TOP1CT, IKK)
- PAT2CT = PATHY(1:NCHR)//'/'//TOP1CT
- CALL RZCDIR (PAT2CT, ' ')
- IF (IQUEST(1).NE.0) THEN
- CALL MZDROP (IDISCD, LAUXCL(10), 'L')
- IRC = 161
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDNTPL :'//
- + ' Illegal pathname '//PAT2CT//''')', IARGCD, 0)
-#endif
- GO TO 999
- ENDIF
- NKEYCK = IQUEST(7)
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
-*
- DO 90 IK = NCUS+1, NKEYCK
- CALL CDKEYR (IK, NWKYCK, KEYVCK)
-*
-* ** Store the time values for the subsequent loop runs
-*
- CALL CDKSEL (ITIME, KEYS, KEYVCK, IFLG, ISEL, INBR)
- IF (ISEL.NE.0) GO TO 90
- IF (IOPXCA.NE.0.AND.KEYVCK(NOF1CK+1).GT.INOWS) GO TO 90
- IF (NOBJS(1).GT.0) THEN
- LAUXCL(9) = 0
- CALL VZERO (KEYVCK, NWKYCK)
- KEYVCK(IDHKSN) = IK
- IOKYCA(IDHKSN) = 1
- CALL CDKXIN (ITIME, IDISCD, LAUXCL(9), LAUXCL(9), JBIAS,
- + NWKYCK, KEYVCK, IPREC, IRC)
- IOKYCA(IDHKSN) = 0
- IF (IRC.NE.0) THEN
- IF (LAUXCL(9).NE.0) CALL MZDROP (IDISCD, LAUXCL(9), 'L')
- IRC = 0
- GO TO 90
- ENDIF
- IF (NDEMCP(1).GT.IQ(KOFUCD+LAUXCL(9)-1)) THEN
- NBAD = NBAD +1
- CALL MZDROP (IDISCD, LAUXCL(9), 'L')
- GO TO 90
- ENDIF
- IF (IBEGCP(1).EQ.0) THEN
- IBEGCP(1) = 1
- CALL CDIOTY (LAUXCL(9), NOBJS(1), KOBJS(NDSMCP(1)+1),
- + IOTYCP(NDSTCP(1)+1))
- ENDIF
- ENDIF
- NPL = NPL + 1
- IF (NPL.GT.NPLM) THEN
- NPL = NPLM
- NCUR = IK - 1
- NCURD = IKK - 1
- GO TO 100
- ENDIF
-*
-* ** Load the requested keys and key(3)
-*
- IPNT = KOFUCD + LAUXCL(10) + (NPL - 1) * (NTOT + NPAIR)
- DO 75 I = 1, NPAIR
- IQ(IPNT+I) = KEYVCK(NOF1CK+I)
- 75 CONTINUE
- DO 80 I = 1, NKEYX(1)
- IND = KEYXS(NKSMCP(1)+I)
- IF (IOPTCA.NE.0.AND.IND.NE.IDHINS) THEN
- CALL CDTIMM (KEYVCK(IND), IVAL)
- Q(IPNT+NKSTCP(1)+I+NPAIR) = IVAL
- ELSE IF (IOPTCA.NE.0.AND.IOPXCA.NE.0.AND.(IND.GT.NOF1CK
- + .AND.IND.LE.NOF1CK+2*NPARCD)) THEN
- CALL CDTIMS (KEYVCK(IND), IVAL)
- Q(IPNT+NKSTCP(1)+I+NPAIR) = IVAL
- ELSE
- Q(IPNT+NKSTCP(1)+I+NPAIR) = KEYVCK(IND)
- ENDIF
- 80 CONTINUE
- DO 85 I = 1, NOBJS(1)
- ID = NDSTCP(1) + I
- II = KOBJS(NDSMCP(1)+I)
- IF (IOTYCP(ID).EQ.1.OR.IOTYCP(ID).EQ.2.OR.IOTYCP(ID).EQ.5)
- + THEN
- IVAL = IQ(KOFUCD+LAUXCL(9)+II)
- Q(IPNT+ID+NPAIR) = IVAL
- ELSE IF (IOTYCP(ID).EQ.4) THEN
- CALL UCOPY (Q(KOFUCD+LAUXCL(9)+II), DVAL, 2)
- Q(IPNT+ID+NPAIR) = DVAL
- ELSE
- Q(IPNT+ID+NPAIR) = Q(KOFUCD+LAUXCL(9)+II)
- ENDIF
- 85 CONTINUE
- CALL MZDROP (IDISCD, LAUXCL(9), 'L')
- 90 CONTINUE
-*
- NCUS = 0
- CALL RZCDIR (PATHY, ' ' )
- IF (IQUEST(1).NE.0) THEN
- CALL MZDROP (IDISCD, LAUXCL(10), 'L')
- IRC = 161
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDNTPL :'//
- + ' Illegal pathname '//PATHY//''')', IARGCD, 0)
-#endif
- GO TO 999
- ENDIF
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- 95 CONTINUE
- ENDIF
-*
-* ** Check if objects collected
-*
- 100 IF (NPL.EQ.0) THEN
- CALL MZDROP (IDISCD, LAUXCL(10), 'L')
- IRC = 0
- GO TO 999
- ENDIF
-*
-* *** Loop over the secondary directories and fill the rest
-*
- DO 105 I = 1, NSYSCK
- KEYU(I) = KEYS(I)
- 105 CONTINUE
- DO 180 NPT = 2, NPATH
- CALL CDLDUP (PATHS(NPT), 0, IRC)
- IF (IRC.NE.0) GO TO 999
- PATHY = PAT1CT
- NCHR = LENOCC (PATHY)
- CALL CDKEYT
- IOPTP = JBIT (IQ(KOFSCD+LCDRCD+IKDRCD+IDHFLG), JPRTCD)
- IF (NWKYCK.GT.NSYSCK) THEN
- DO 110 I = NSYSCK+1, NWKYCK
- IOKYCA(I) = 0
- 110 CONTINUE
- ENDIF
- DO 115 I = 1, NSKYCP(NPT)
- IOKYCA(NKEYCP(I,NPT)) = 1
- KEYU (NKEYCP(I,NPT)) = KEYS(KKEYCP(I,NPT))
- 115 CONTINUE
- IPRBCA = 0
- IPRECA = 0
-*
- DO 170 IO = 1, NPL
- IPNT = KOFUCD + LAUXCL(10) + (IO - 1) * (NTOT + NPAIR)
- IF (IQ(IPNT+1).LT.0) GO TO 170
- DO 120 I = 1, NPAIR
- ITIME(I) = IQ(IPNT+I)
- 120 CONTINUE
- IF (IOPTP.EQ.0) THEN
-*
-* ** For non-parttioned directories
-*
- DO 135 JK = 1, NKEYCK
- IK = NKEYCK + 1 - JK
- CALL CDKEYR (IK, NWKYCK, KEYVCK)
-*
-* ** Select on the basis of start validity from Path 1
-*
- CALL CDKSEL (ITIME, KEYU, KEYVCK, 0, ISEL, INBR)
- IF (ISEL.NE.0) GO TO 135
- IF (NOBJS(NPT).GT.0) THEN
- LAUXCL(9) = 0
- CALL VZERO (KEYVCK, NWKYCK)
- KEYVCK(IDHKSN) = IK
- IOKYCA(IDHKSN) = 1
- CALL CDKXIN (ITIME, IDISCD, LAUXCL(9), LAUXCL(9), JBIAS,
- + NWKYCK, KEYVCK, IPREC, IRC)
- IOKYCA(IDHKSN) = 0
- IF (IRC.NE.0) THEN
- NBAD = NBAD + 1
- IF (LAUXCL(9).NE.0)
- + CALL MZDROP (IDISCD, LAUXCL(9), 'L')
- IRC = 0
- IPNT = KOFUCD + LAUXCL(10) + (IO - 1)*(NTOT + NPAIR)
- IQ(IPNT+1) = -1
- GO TO 170
- ENDIF
- IF (NDEMCP(NPT).GT.IQ(KOFUCD+LAUXCL(9)-1)) THEN
- NBAD = NBAD +1
- CALL MZDROP (IDISCD, LAUXCL(9), 'L')
- IPNT = KOFUCD + LAUXCL(10) + (IO - 1)*(NTOT + NPAIR)
- IQ(IPNT+1) = -1
- GO TO 170
- ENDIF
- IF (IBEGCP(NPT).EQ.0) THEN
- IBEGCP(NPT) = 1
- CALL CDIOTY (LAUXCL(9), NOBJS(NPT),
- + KOBJS(NDSMCP(NPT)+1), IOTYCP(NDSTCP(NPT)+1))
- ENDIF
- ENDIF
-*
-* ** Load the requested keys and data elements
-*
- IPNT = KOFUCD + LAUXCL(10) + (IO - 1) * (NTOT + NPAIR)
- DO 125 I = 1, NKEYX(NPT)
- IND = KEYXS(NKSMCP(NPT)+I)
- IF (IOPTCA.NE.0.AND.IND.NE.IDHINS) THEN
- CALL CDTIMM (KEYVCK(IND), IVAL)
- Q(IPNT+NKSTCP(NPT)+I+NPAIR) = IVAL
- ELSE IF (IOPTCA.NE.0.AND.IOPXCA.NE.0.AND.(IND.GT.NOF1CK
- + .AND.IND.LE.NOF1CK+2*NPARCD)) THEN
- CALL CDTIMS (KEYVCK(IND), IVAL)
- Q(IPNT+NKSTCP(NPT)+I+NPAIR) = IVAL
- ELSE
- Q(IPNT+NKSTCP(NPT)+I+NPAIR) = KEYVCK(IND)
- ENDIF
- 125 CONTINUE
- DO 130 I = 1, NOBJS(NPT)
- ID = NDSTCP(NPT) + I
- II = KOBJS(NDSMCP(NPT)+I)
- IF (IOTYCP(ID).EQ.1.OR.IOTYCP(ID).EQ.2.OR.
- + IOTYCP(ID).EQ.5) THEN
- IVAL = IQ(KOFUCD+LAUXCL(9)+II)
- Q(IPNT+ID+NPAIR) = IVAL
- ELSE IF (IOTYCP(ID).EQ.4) THEN
- CALL UCOPY (Q(KOFUCD+LAUXCL(9)+II), DVAL, 2)
- Q(IPNT+ID+NPAIR) = DVAL
- ELSE
- Q(IPNT+ID+NPAIR) = Q(KOFUCD+LAUXCL(9)+II)
- ENDIF
- 130 CONTINUE
- IF (LAUXCL(9).NE.0) CALL MZDROP (IDISCD, LAUXCL(9), 'L')
- GO TO 170
- 135 CONTINUE
- IPNT = KOFUCD + LAUXCL(10) + (IO - 1) * (NTOT + NPAIR)
- IQ(IPNT+1) = -1
- GO TO 170
-*
- ELSE
-*
-* ** Partitioned directory
-*
- KST = NWKYCK + 1
- NKEYS = NKEYCK
- DO 155 JKK = 1, NKEYS
- IKK = NKEYS + 1 - JKK
- KPNT = IUHUNT (IKK, IQ(KOFSCD+LCDRCD+IKDRCD+MPSRCD),
- + NKEYS*KST, KST)
- IF (KPNT.GT.0) THEN
- KPNT = KOFSCD + LCDRCD + IKDRCD +KPNT - MPSRCD
- ELSE
- KPNT = KOFSCD + LCDRCD + IKDRCD + (IKK - 1) * KST
- ENDIF
- CALL CDPSEL (ITIME, KEYU, IQ(KPNT+1), 0, ISEL)
- IF (ISEL.NE.0) GO TO 155
-*
- CALL CDPATH (TOP1CT, IKK)
- PAT2CT = PATHY(1:NCHR)//'/'//TOP1CT
- CALL RZCDIR (PAT2CT, ' ')
- IF (IQUEST(1).NE.0) THEN
- CALL MZDROP (IDISCD, LAUXCL(10), 'L')
- IRC = 161
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDNTPL :'//
- + ' Illegal pathname '//PAT2CT//''')', IARGCD, 0)
-#endif
- GO TO 999
- ENDIF
- NKEYCK = IQUEST(7)
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
-*
- DO 150 JK = 1, NKEYCK
- IK = NKEYCK + 1 -JK
- CALL CDKEYR (IK, NWKYCK, KEYVCK)
-*
-* ** Select on the basis of start validity from Path 1
-*
- CALL CDKSEL (ITIME, KEYU, KEYVCK, 0, ISEL, INBR)
- IF (ISEL.NE.0) GO TO 150
- IF (NOBJS(NPT).GT.0) THEN
- LAUXCL(9) = 0
- CALL VZERO (KEYVCK, NWKYCK)
- KEYVCK(IDHKSN) = IK
- IOKYCA(IDHKSN) = 1
- CALL CDKXIN (ITIME, IDISCD, LAUXCL(9), LAUXCL(9),
- + JBIAS, NWKYCK, KEYVCK, IPREC, IRC)
- IOKYCA(IDHKSN) = 0
- IF (IRC.NE.0) THEN
- NBAD = NBAD + 1
- IF (LAUXCL(9).NE.0)
- + CALL MZDROP (IDISCD, LAUXCL(9), 'L')
- IRC = 0
- IPNT = KOFUCD + LAUXCL(10) + (IO -1)*(NTOT +NPAIR)
- IQ(IPNT+1) = -1
- GO TO 160
- ENDIF
- IF (NDEMCP(NPT).GT.IQ(KOFUCD+LAUXCL(9)-1)) THEN
- NBAD = NBAD +1
- CALL MZDROP (IDISCD, LAUXCL(9), 'L')
- IPNT = KOFUCD + LAUXCL(10) + (IO -1)*(NTOT +NPAIR)
- IQ(IPNT+1) = -1
- GO TO 160
- ENDIF
- IF (IBEGCP(NPT).EQ.0) THEN
- IBEGCP(NPT) = 1
- CALL CDIOTY (LAUXCL(9), NOBJS(NPT),
- + KOBJS(NDSMCP(NPT)+1), IOTYCP(NDSTCP(NPT)+1))
- ENDIF
- ENDIF
-*
-* ** Load the requested keys and object elements
-*
- IPNT = KOFUCD + LAUXCL(10) + (NPL - 1) * (NTOT + NPAIR)
- DO 140 I = 1, NKEYX(NPT)
- IND = KEYXS(NKSMCP(NPT)+I)
- IF (IOPTCA.NE.0.AND.IND.NE.IDHINS) THEN
- CALL CDTIMM (KEYVCK(IND), IVAL)
- Q(IPNT+NKSTCP(NPT)+I+NPAIR) = IVAL
- ELSE IF (IOPTCA.NE.0.AND.IOPXCA.NE.0.AND.
- + (IND.GT.NOF1CK.AND.IND.LE.NOF1CK+2*NPARCD)) THEN
- CALL CDTIMS (KEYVCK(IND), IVAL)
- Q(IPNT+NKSTCP(NPT)+I+NPAIR) = IVAL
- ELSE
- Q(IPNT+NKSTCP(NPT)+I+NPAIR) = KEYVCK(IND)
- ENDIF
- 140 CONTINUE
- DO 145 I = 1, NOBJS(1)
- ID = NDSTCP(1) + I
- II = KOBJS(NDSMCP(1)+I)
- IF (IOTYCP(ID).EQ.1.OR.IOTYCP(ID).EQ.2.OR.
- + IOTYCP(ID).EQ.5) THEN
- IVAL = IQ(KOFUCD+LAUXCL(9)+II)
- Q(IPNT+ID+NPAIR) = IVAL
- ELSE IF (IOTYCP(ID).EQ.4) THEN
- CALL UCOPY (Q(KOFUCD+LAUXCL(9)+II), DVAL, 2)
- Q(IPNT+ID+NPAIR) = DVAL
- ELSE
- Q(IPNT+ID+NPAIR) = Q(KOFUCD+LAUXCL(9)+II)
- ENDIF
- 145 CONTINUE
- IF (LAUXCL(9).NE.0) CALL MZDROP (IDISCD, LAUXCL(9), 'L')
- GO TO 160
- 150 CONTINUE
-*
- CALL RZCDIR (PATHY, ' ' )
- IF (IQUEST(1).NE.0) THEN
- CALL MZDROP (IDISCD, LAUXCL(10), 'L')
- IRC = 161
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDNTPL :'//
- + ' Illegal pathname '//PATHY//''')', IARGCD, 0)
-#endif
- GO TO 999
- ENDIF
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- 155 CONTINUE
- ENDIF
- IPNT = KOFUCD + LAUXCL(10) + (NPL - 1) * (NTOT + NPAIR)
- IQ(IPNT+1) = -1
-*
- 160 CALL RZCDIR (PATHY, ' ' )
- IF (IQUEST(1).NE.0) THEN
- CALL MZDROP (IDISCD, LAUXCL(10), 'L')
- IRC = 161
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDNTPL :'//
- + ' Illegal pathname '//PATHY//''')', IARGCD, 0)
-#endif
- GO TO 999
- ENDIF
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- 170 CONTINUE
- 180 CONTINUE
-*
-* *** Fill the N-tuples
-*
- CALL HCDIR (PATHN, ' ')
- DO 190 IP = 1, NPL
- IPNT = KOFUCD + LAUXCL(10) + (IP - 1) * (NTOT + NPAIR)
- IF (IQ(IPNT+1).GT.0) THEN
- CALL HFN (NTUP, Q(IPNT+NPAIR+1))
- ENDIF
- 190 CONTINUE
-*
-* *** Go back and repeat if not yet completed
-*
- IF (NOLD.NE.NCUR.OR.NOLDD.NE.NCURD) THEN
- NOLD = NCUR
- NOLDD = NCURD
- GO TO 40
- ENDIF
-* END CDNTPL
- 999 END
diff --git a/src/packlib/hepdb/cdplot/cdplbk.F b/src/packlib/hepdb/cdplot/cdplbk.F
deleted file mode 100644
index 0b38ed5..0000000
--- a/src/packlib/hepdb/cdplot/cdplbk.F
+++ /dev/null
@@ -1,332 +0,0 @@
-*
-* $Id: cdplbk.F,v 1.1.1.1 1996/02/28 16:24:22 mclareni Exp $
-*
-* $Log: cdplbk.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:22 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDPLBK (LAD, IRC)
-* ============================
-*
-************************************************************************
-* *
-* SUBR. CDPLBK (LAD, IRC*) *
-* *
-* Draw the nodes on the screen as given in the bank at address LAD. *
-* This bank is usually prepared by a call to the routine CDFPAT. *
-* *
-* Arguments : *
-* *
-* LAD Address of the bank containing the information *
-* IRC Return code (see below) *
-* *
-* Called by Interactive interface *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
- CHARACTER CHVAR*16
- DIMENSION X(5), Y(5), LAD(9)
- PARAMETER (XRNG=24.0, YRNG=24.0, HIGH=0.5, SMARG=1.0)
- PARAMETER (CSIZ=0.6, HSIZ=1.5, GAP=3.5, FRAM=1.2)
-*
-* ------------------------------------------------------------------
-*
-* *** Derive the number of tree structure levels
-*
- IRC = 0
- LREFCD(1) = LAD(1)
- NLEV = IQ(KOFUCD+LREFCD(1)+MNLVCD)
- IF (NLEV.LE.0) GO TO 999
-*
-* *** Set the default values first
-*
- SIZH = HSIZ
- SIZC = CSIZ
- GAPH = GAP
- GAPV = HIGH
- SGAP = SMARG
-*
-* *** Find the X- and Y- ranges in each level
-*
- IPNL = IQ(KOFUCD+LREFCD(1)+MPNLCD)
- YSIZM = FRAM*25+GAPV*24+SGAP*2+SIZH
- XSIZE = 0.
- NTEMP = 0
- KMAX = 1
- DO 15 ILEV =1, NLEV
- NODES = IQ(KOFUCD+LREFCD(1)+IPNL+MNODCD)
- IPNN = IQ(KOFUCD+LREFCD(1)+IPNL+MPNNCD)
- MXNCH = 0
- DO 10 INOD =1, NODES
- NCHRN = IQ(KOFUCD+LREFCD(1)+IPNN+MNCHCD)
- IF (NCHRN.GT.MXNCH) MXNCH = NCHRN
- IPNN = IQ(KOFUCD+LREFCD(1)+IPNN+MPNLCD)
- 10 CONTINUE
- XSIZE = XSIZE + SIZC*MXNCH
- Q(KOFUCD+LREFCD(1)+IPNL+MYFLCD) = NODES*FRAM + (NODES-1)*GAPV
- + + SGAP*2
- IF (NTEMP.LT.NODES) THEN
- NTEMP = NODES
- KMAX = ILEV
- ENDIF
- IPNL = IQ(KOFUCD+LREFCD(1)+IPNL+MPNLCD)
- 15 CONTINUE
- XSIZE = XSIZE+(NLEV-1)*GAPH+SGAP*2
- NTEMP = NTEMP + 6
- YSIZE = FRAM*NTEMP + GAPV*(NTEMP-1) + SGAP*2 + SIZH
- IF (YSIZE.LT.YSIZM) YSIZE = YSIZM
-*
-* *** Now choose the scaling factor
-*
- SCAL = XRNG/XSIZE
- SCL0 = YRNG/YSIZE
- IF (SCAL.GT.SCL0) THEN
- SCAL = SCL0
- XOFF = 0.5*(XRNG-SCAL*XSIZE)
- ELSE
- XOFF = 0.
- ENDIF
- SIZH = SCAL*SIZH
- SIZC = SCAL*SIZC
- SGAP = SCAL*SGAP
- GAPH = SCAL*GAPH
- GAPV = SCAL*GAPV
- HFRAM = SCAL*FRAM
- XVAL = XOFF+SGAP
- Q(KOFUCD+LREFCD(1)+MHFMCD) = HFRAM
- IPNL = IQ(KOFUCD+LREFCD(1)+MPNLCD)
- DO 25 ILEV =1, NLEV
- NODES = IQ(KOFUCD+LREFCD(1)+IPNL+MNODCD)
- IPNN = IQ(KOFUCD+LREFCD(1)+IPNL+MPNNCD)
- MXNCH = 0
- DO 20 INOD =1, NODES
- NCHRN = IQ(KOFUCD+LREFCD(1)+IPNN+MNCHCD)
- IF (NCHRN.GT.MXNCH) MXNCH = NCHRN
- IPNN = IQ(KOFUCD+LREFCD(1)+IPNN+MPNLCD)
- 20 CONTINUE
- YSIZV = Q(KOFUCD+LREFCD(1)+IPNL+MYFLCD)
- Q(KOFUCD+LREFCD(1)+IPNL+MXOFCD) = XVAL
- Q(KOFUCD+LREFCD(1)+IPNL+MYFLCD) = YRNG - 2*SGAP
- + - 0.5*(YRNG-SCAL*YSIZV)
- Q(KOFUCD+LREFCD(1)+IPNL+MXWDCD) = SIZC*MXNCH
- XVAL = XVAL + Q(KOFUCD+LREFCD(1)+IPNL+MXWDCD) + GAPH
- IPNL = IQ(KOFUCD+LREFCD(1)+IPNL+MPNLCD)
- 25 CONTINUE
-*
-* *** Now set the range; choose colour, line style, line width
-*
- CALL IGRNG (XRNG, YRNG)
- CALL ISPLCI (7)
- CALL ISLN (1)
- CALL ISLWSC (2.0)
-*
-* *** Now draw the box and title
-*
- CALL IGBOX (0., XRNG, 0.,YRNG)
- CALL IGTEXT (0.5*XRNG, SGAP, 'DBL3 Tree Structure', SIZH, 0., 'C')
-*
-* *** Now arrange the node places into the tree
-*
- YOFF1 = 0.
-*
-* ** Start with the level with maximum number of nodes
-*
- LPNL = IQ(KOFUCD+LREFCD(1)+MPNLCD)
- IF (KMAX.GT.1) THEN
- DO 30 I = 2, KMAX
- 30 LPNL = IQ(KOFUCD+LREFCD(1)+LPNL+MPNLCD)
- ENDIF
- YOFFN = Q(KOFUCD+LREFCD(1)+LPNL+MYFLCD)
- IPNN = IQ(KOFUCD+LREFCD(1)+LPNL+MPNNCD)
- NODES = IQ(KOFUCD+LREFCD(1)+LPNL+MNODCD)
- DO 35 INOD = 1, NODES
- NDOWN = IQ(KOFUCD+LREFCD(1)+IPNN+MNDWCD)
- IF (NDOWN.GT.0) THEN
- IF (YOFF1.GT.0) THEN
- IF (YOFFN.GT.YOFF1) YOFFN = YOFF1
- ENDIF
- Q(KOFUCD+LREFCD(1)+IPNN+MYFNCD) = YOFFN
- HH = 0.5 * (NDOWN*HFRAM + (NDOWN-1)*GAPV)
- YOFF1 = YOFFN - HH - GAPV - HFRAM*0.5
- YOFFN = YOFFN - HFRAM - GAPV
- ELSE
- Q(KOFUCD+LREFCD(1)+IPNN+MYFNCD) = YOFFN
- YOFFN = YOFFN - HFRAM - GAPV
- ENDIF
- IPNN = IQ(KOFUCD+LREFCD(1)+IPNN+MPNLCD)
- 35 CONTINUE
-*
-* ** Go up with level number from one with maximum nodes
-*
- YOFFP = 0.
- KPNL = LPNL
- DO 55 ILEV = KMAX+1, NLEV
- IPNL = IQ(KOFUCD+LREFCD(1)+KPNL+MPNLCD)
- IPNNU = IQ(KOFUCD+LREFCD(1)+KPNL+MPNNCD)
- KDOWN = 1
- NODES = IQ(KOFUCD+LREFCD(1)+KPNL+MNODCD)
- NODEH = IQ(KOFUCD+LREFCD(1)+IPNL+MNODCD)
- DO 45 IUP = 1, NODES
- NDOWN = IQ(KOFUCD+LREFCD(1)+IPNNU+MNDWCD)
- IF (NDOWN.GT.0) THEN
- HH = 0.5 * (NDOWN*HFRAM + (NDOWN-1)*GAPV)
- YOFFN = HH + Q(KOFUCD+LREFCD(1)+IPNNU+MYFNCD) - HFRAM*0.5
- IF (KDOWN.GT.1) THEN
- IF (YOFFN.GT.YOFFP) YOFFN = YOFFP
- ENDIF
- IPNN = IQ(KOFUCD+LREFCD(1)+IPNL+MPNNCD)
- DO 40 INOD = 1, NODEH
- IF (IQ(KOFUCD+LREFCD(1)+IPNN+MNFNCD).EQ.IUP) THEN
- Q(KOFUCD+LREFCD(1)+IPNN+MYFNCD) = YOFFN
- YOFFN = YOFFN - HFRAM - GAPV
- KDOWN = KDOWN + 1
- ENDIF
- IPNN = IQ(KOFUCD+LREFCD(1)+IPNN+MPNLCD)
- 40 CONTINUE
- IF (KDOWN.GT.NODEH) GO TO 50
- YOFFP = YOFFN
- ENDIF
- IPNNU = IQ(KOFUCD+LREFCD(1)+IPNNU+MPNLCD)
- 45 CONTINUE
- 50 KPNL = IPNL
- 55 CONTINUE
-*
-* ** Now go down with level number from one with maximum nodes
-*
- KPNL = LPNL
- DO 75 ILEV = 1, KMAX-1
- IPNL = IQ(KOFUCD+LREFCD(1)+KPNL+MPPLCD)
- IPNNU = IQ(KOFUCD+LREFCD(1)+IPNL+MPNNCD)
- YOFFP = 0.
- NODES = IQ(KOFUCD+LREFCD(1)+IPNL+MNODCD)
- NODEH = IQ(KOFUCD+LREFCD(1)+KPNL+MNODCD)
- KCOUN = 0
- LCOUN = 0
- DO 65 IUP = 1, NODES
- NDOWN = IQ(KOFUCD+LREFCD(1)+IPNNU+MNDWCD)
- IF (NDOWN.GT.0) THEN
- ICOUN = 0
- IPNN = IQ(KOFUCD+LREFCD(1)+KPNL+MPNNCD)
- YSTRT = 0.
- YSTOP = 0.
- DO 60 INOD = 1, NODEH
- IF (IQ(KOFUCD+LREFCD(1)+IPNN+MNFNCD).EQ.IUP) THEN
- ICOUN = ICOUN + 1
- IF (ICOUN.EQ.1) YSTRT = Q(KOFUCD+LREFCD(1)+IPNN+MYFNCD)
- YSTOP = Q(KOFUCD+LREFCD(1)+IPNN+MYFNCD)
- ENDIF
- IPNN = IQ(KOFUCD+LREFCD(1)+IPNN+MPNLCD)
- 60 CONTINUE
- YOFFN = (YSTRT+YSTOP)*0.5
- Q(KOFUCD+LREFCD(1)+IPNNU+MYFNCD) = YOFFN
- KCOUN = KCOUN + 1
- IF (KCOUN.EQ.1) YOFFP = YOFFN
- ELSE
- IF (KCOUN.GT.0) THEN
- YOFFN = YOFFN - GAPV - HFRAM
- Q(KOFUCD+LREFCD(1)+IPNNU+MYFNCD) = YOFFN
- ELSE
- LCOUN = LCOUN + 1
- ENDIF
- ENDIF
- IPNNU = IQ(KOFUCD+LREFCD(1)+IPNNU+MPNLCD)
- 65 CONTINUE
- YOFFN = YOFFP
- IPNNU = IQ(KOFUCD+LREFCD(1)+IPNL+MPNNCD)
- DO 70 I = 1, LCOUN
- Q(KOFUCD+LREFCD(1)+IPNNU+MYFNCD) = YOFFP
- + + (LCOUN-I+1)*(HFRAM+GAPV)
- IPNNU = IQ(KOFUCD+LREFCD(1)+IPNNU+MPNLCD)
- 70 CONTINUE
- KPNL = IPNL
- 75 CONTINUE
-*
-* *** Now draw the tree structure for DBL3
-*
- IPNL = IQ(KOFUCD+LREFCD(1)+MPNLCD)
- DO 95 ILEV = 1, NLEV
- IPNN = IQ(KOFUCD+LREFCD(1)+IPNL+MPNNCD)
- NODES = IQ(KOFUCD+LREFCD(1)+IPNL+MNODCD)
- XOFF = Q(KOFUCD+LREFCD(1)+IPNL+MXOFCD)
- XWID = Q(KOFUCD+LREFCD(1)+IPNL+MXWDCD)
- IF (ILEV.LT.NLEV) THEN
- LPNL = IQ(KOFUCD+LREFCD(1)+IPNL+MPNLCD)
- XOFFL = Q(KOFUCD+LREFCD(1)+LPNL+MXOFCD)
- NODEH = IQ(KOFUCD+LREFCD(1)+LPNL+MNODCD)
- ELSE
- XOFFL = 0.
- NODEH = 0
- ENDIF
- DO 90 INOD = 1, NODES
- NCH = IQ(KOFUCD+LREFCD(1)+IPNN+MNCHCD)
- NDOWN = IQ(KOFUCD+LREFCD(1)+IPNN+MNDWCD)
- YOFF = Q(KOFUCD+LREFCD(1)+IPNN+MYFNCD)
- X(1) = XOFF
- X(2) = X(1) + XWID
- X(3) = X(2)
- X(4) = X(1)
- X(5) = X(1)
- XCEN = 0.5 * (X(1) + X(2))
- Y(1) = YOFF
- Y(2) = Y(1)
- Y(3) = Y(1) + HFRAM
- Y(4) = Y(3)
- Y(5) = Y(1)
- YCEN = Y(1) + 0.5*(HFRAM-SIZC)
- CALL IPL (5,X,Y)
- CALL UHTOC (IQ(KOFUCD+LREFCD(1)+IPNN+MNAMCD), 4, CHVAR, NCH)
- CALL IGTEXT (XCEN, YCEN, CHVAR(1:NCH), SIZC, 0., 'C')
- IF (ILEV.LT.NLEV.AND.NDOWN.GT.0) THEN
- IPNND = IQ(KOFUCD+LREFCD(1)+LPNL+MPNNCD)
- YUP = Q(KOFUCD+LREFCD(1)+IPNN+MYFNCD) + HFRAM*0.5
- XUP = XOFF + XWID
- YDOW1 = -1
- XDOWN = XOFFL
- XLINE = XDOWN - GAPH/6.
- DO 80 IDOWN = 1, NODEH
- ITEMP =IQ(KOFUCD+LREFCD(1)+IPNND+MNFNCD)
- IF (INOD.EQ.ITEMP) THEN
- YDOW2 = Q(KOFUCD+LREFCD(1)+IPNND+MYFNCD) + HFRAM*0.5
- IF (YDOW1.LT.0.) THEN
- YDOW1 = YDOW2
- YFRST = YDOW1
- Y(1) = YDOW1
- Y(2) = Y(1)
- X(1) = XDOWN
- X(2) = XLINE
- CALL IPL (2, X, Y)
- ELSE
- Y(1) = YDOW1
- Y(2) = YDOW2
- Y(3) = Y(2)
- X(1) = XLINE
- X(2) = X(1)
- X(3) = XDOWN
- CALL IPL (3, X, Y)
- YDOW1 = YDOW2
- ENDIF
- ENDIF
- IPNND = IQ(KOFUCD+LREFCD(1)+IPNND+MPNLCD)
- 80 CONTINUE
- YEND = YDOW1
- 85 IF (YDOW1.GE.0) THEN
- Y(1) = YUP
- Y(2) = (YFRST+YEND)*0.5
- X(1) = XUP
- X(2) = XLINE
- CALL IPL (2, X, Y)
- ENDIF
- ENDIF
- IPNN = IQ(KOFUCD+LREFCD(1)+IPNN+MPNLCD)
- 90 CONTINUE
- IPNL = IQ(KOFUCD+LREFCD(1)+IPNL+MPNLCD)
- 95 CONTINUE
-* END CDPLBK
- 999 END
diff --git a/src/packlib/hepdb/cdplot/cdplob.F b/src/packlib/hepdb/cdplot/cdplob.F
deleted file mode 100644
index daa3fd8..0000000
--- a/src/packlib/hepdb/cdplot/cdplob.F
+++ /dev/null
@@ -1,535 +0,0 @@
-*
-* $Id: cdplob.F,v 1.1.1.1 1996/02/28 16:24:22 mclareni Exp $
-*
-* $Log: cdplob.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:22 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
-#if (defined(CERNLIB__P3CHILD))&&(defined(CERNLIB_IBM))
-* Ignoring t=dummy
-#endif
- SUBROUTINE CDPLOB (PATHN,MASK,KEYS, NOBJ,KOBJ,KEX,NST,CHOPT,IRC)
-* ================================================================
-*
-************************************************************************
-* *
-* SUBR. CDPLOB (PATHN, MASK,KEYS, NOBJ,KOBJ,KEX,NST,CHOPT, IRC*)*
-* *
-* Plots data elemnet(s) versus a key element for a given path name *
-* Selects objects with validity range as specified in KEYS(NOF1CK..) *
-* if the proper masks are used. It sees the object in data base has *
-* lower range smaller than and higher range larger than the value *
-* specified. Selection on insertion time demands data base object *
-* to be inserted before the value supplied in selection *
-* *
-* Arguments : *
-* *
-* PATHN Character string describing the pathname *
-* MASK Integer vector indicating which elements of KEYS are *
-* significant for selection. If MASK corresponding to *
-* one of the fields of 'Beginning' validity range is set, *
-* it will select objects with start validity larger than *
-* those requested in KEYS. If MASK corresponding to one *
-* of the fields of 'End' validity range is set, it will *
-* select objects with start validity smaller than those *
-* in the KEYS vector (in the fields corresponding to end *
-* validity). If MASK corresponding to time of insertion *
-* is set, objects inserted earlier than KEYS(IDHINS) are *
-* selected *
-* MASK Integer vector indicating which elements of KEYS are *
-* significant for selection *
-* NOBJ Number of data objects to be plotted *
-* KOBJ Vector specifying the element numbers to be plotted *
-* KEX Key index for the abcissa *
-* NST Step size for selection of object number *
-* CHOPT Character string with any of the following characters *
-* L a line to be drawn through the points *
-* (needed only when symbol and line both to be drawn) *
-* P a symbol to be drawn at each point *
-* (Default is a line to be drawn through the points) *
-* S all elements shown on the same plot *
-* (Default is a seperate plot for each variable) *
-* X Assumes validity range packed time ala CDPKTS *
-* IRC Return code (see below) *
-* *
-* Called by Interactive interface *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* =161 : Illegal path name *
-* =162 : No keys or data in the directory *
-* =163 : Illegal number of objects *
-* *
-************************************************************************
-*
-#include "hepdb/caopts.inc"
-#include "hepdb/cdcblk.inc"
-#include "hepdb/ckkeys.inc"
-#include "hepdb/clinks.inc"
-#include "hepdb/cplots.inc"
-#include "hepdb/ctpath.inc"
- PARAMETER (MXSYM=12, JBIAS=2)
- LOGICAL HEXIST
- CHARACTER PATHN*(*), CHOPT*(*), PATHY*255, CTAG*16, CEXT*5
- DIMENSION KEYS(9),MASK(9),KOBJ(9),ITIME(MXPACD),ISYMB(MXSYM)
- DOUBLE PRECISION DVAL
- DATA ISYMB /20,21,22,23,24,25,26,27,28,29,30,31/
-#include "zebra/q_jbit.inc"
-* Ignoring t=pass
-*
-* ------------------------------------------------------------------
-*
-* *** Decode the character option
-*
- CALL CDOPTS (CHOPT, IRC)
- IF (IRC.NE.0) GO TO 999
- CALL UCOPY (MASK, IOKYCA, MXDMCK)
-*
-* *** Load the top level directory
-*
- CALL CDLDUP (PATHN, 0, IRC)
- IF (IRC.NE.0) GO TO 999
-*
- PATHY = PAT1CT
- NCHR = LENOCC (PATHY)
- IF (NKEYCK.LE.0) THEN
- IRC = 162
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDPLOB : No keys'//
- + ' in directory '//PATHY//''')', IARGCD, 0)
-#endif
- GO TO 999
- ENDIF
- CALL CDKYTG
-*
- IF ((KEX.GT.NOF1CK.AND.KEX.LE.NOF1CK+2*NPARCD).OR.KEX.EQ.IDHINS)
- + THEN
- KABS = KEX
- ELSE
- KABS = IDHINS
- ENDIF
- IF (NST.GT.0) THEN
- NSTEP = NST
- ELSE
- NSTEP = 1
- ENDIF
- IF (NOBJ.LT.1.OR.NOBJ.GT.NOBMCP) THEN
- IRC = 163
- IQUEST(11) = NOBJ
- IQUEST(12) = NOBMCP
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDPLOB : Illegal'//
- + ' number of objects '',2I12)', IQUEST(11), 2)
-#endif
- GO TO 999
- ENDIF
- NOBM = KOBJ(1)
- DO 5 I = 2, NOBJ
- IF (KOBJ(I).GT.NOBM) NOBM = KOBJ(I)
- 5 CONTINUE
-*
- IOPTP = JBIT (IQ(KOFSCD+LCDRCD+IKDRCD+IDHFLG), JPRTCD)
- NTOT = 0
- IF (KEX.GT.0.AND.KEX.LE.NWKYCK) THEN
- KPEX = KEX
- ELSE
- KPEX = IDHINS
- ENDIF
- CTAG = CTAGCK(KPEX)
-*
-* *** Prepare a temporary storage for useful information
-*
- CALL DATIME (IDATX, ITIMX)
- CALL CDPKTS (IDATX, ITIMX*100, INOWS, IRC)
- IF (KABS.EQ.IDHINS) THEN
- CALL CDPKTM (IDATX, ITIMX, ITNOW, IRC)
- ELSE
- ITNOW = INOWS
- ENDIF
- NPLM = NPLMCP
- IF (IOPTP.EQ.0) THEN
- IF (NKEYCK.LT.NPLM) NPLM = NKEYCK
- ENDIF
- ND = (NOBJ + 1) * NPLM
-#if defined(CERNLIB__DEBUG)
- NBAD = 0
-#endif
- IF (LAUXCL(10).NE.0) CALL MZDROP (IDISCD, LAUXCL(10), 'L')
- CALL CDBANK (IDISCD, LAUXCL(10), LAUXCL(10), 2, 'TEMP', 0, 0, ND,
- + 0, -1, IRC)
- IF (IRC.NE.0) GO TO 999
- VMINCP = 9.0E20
- VMAXCP =-9.0E20
- IF (LAUXCL(9).NE.0) THEN
- CALL MZDROP (IDISCD, LAUXCL(9), 'L')
- LAUXCL(9) = 0
- ENDIF
-*
-* *** Load useful data in the temporary bank
-*
- IMIN = IBIGCD
- IMAX = -1
- NPL = 0
- IPRBCA = ISIGN (IPRBCA, -1)
- IPRECA = ISIGN (IPRECA, -1)
- IF (IPRBCA.EQ.0.AND.IPRECA.EQ.0) THEN
- IFLG = 99
- ELSE
- IFLG = 0
- ENDIF
- DO 10 I = 1, NPARCD
- ITIME(I) = 1
- 10 CONTINUE
- IF (IOPTP.EQ.0) THEN
- DO 20 JK = 1, NKEYCK
- IK = NKEYCK + 1 - JK
- CALL CDKEYR (IK, NWKYCK, KEYVCK)
- CALL CDKSEL (ITIME, KEYS, KEYVCK, IFLG, ISEL, INBR)
- IF (ISEL.NE.0) GO TO 20
- IF (IOPXCA.NE.0.AND.KEYVCK(NOF1CK+1).GT.INOWS) GO TO 20
- NTOT = NTOT + 1
- IF (NSTEP.GT.1) THEN
- IF (MOD(NTOT,NSTEP).NE.1) GO TO 20
- ENDIF
- LAUXCL(9) = 0
- KTIME = KEYVCK(KABS)
- KYVAL = KEYVCK(KPEX)
- CALL VZERO (KEYVCK, NWKYCK)
- KEYVCK(IDHKSN) = IK
- IOKYCA(IDHKSN) = 1
- CALL CDKXIN (ITIME, IDISCD, LAUXCL(9), LAUXCL(9), JBIAS,
- + NWKYCK, KEYVCK, IPREC, IRC)
- IOKYCA(IDHKSN) = 0
- IF (IRC.NE.0) THEN
- IF (LAUXCL(9).NE.0)
- + CALL MZDROP (IDISCD, LAUXCL(9), 'L')
-#if defined(CERNLIB__DEBUG)
- NBAD = NBAD + 1
-#endif
- IRC = 0
- GO TO 20
- ENDIF
- IF (NOBM.GT.IQ(KOFUCD+LAUXCL(9)-1)) THEN
-#if defined(CERNLIB__DEBUG)
- NBAD = NBAD + 1
-#endif
- CALL MZDROP (IDISCD, LAUXCL(9), 'L')
- GO TO 20
- ENDIF
- IF (NPL.EQ.0) CALL CDIOTY (LAUXCL(9), NOBJ, KOBJ, IOTYCP)
- NPL = NPL + 1
- IF (NPL.LE.NPLM) THEN
- IPNT = KOFUCD + LAUXCL(10) + (NPL - 1) * (NOBJ + 1)
- IQ(IPNT+1) = KYVAL
- DO 15 I = 1, NOBJ
- IF (IOTYCP(I).EQ.1.OR.IOTYCP(I).EQ.2.OR.IOTYCP(I).EQ.5)
- + THEN
- IVAL = IQ(KOFUCD+LAUXCL(9)+KOBJ(I))
- Q(IPNT+I+1) = IVAL
- ELSE IF (IOTYCP(I).EQ.4) THEN
- CALL UCOPY (Q(KOFUCD+LAUXCL(9)+KOBJ(I)), DVAL, 2)
- Q(IPNT+I+1) = DVAL
- ELSE
- Q(IPNT+I+1) = Q(KOFUCD+LAUXCL(9)+KOBJ(I))
- ENDIF
- IF (Q(IPNT+I+1).GT.VMAXCP) VMAXCP = Q(IPNT+I+1)
- IF (Q(IPNT+I+1).LT.VMINCP) VMINCP = Q(IPNT+I+1)
- 15 CONTINUE
- IF (KTIME.LT.IMIN) IMIN = KTIME
- IF (KTIME.GT.IMAX) IMAX = KTIME
- ENDIF
- CALL MZDROP (IDISCD, LAUXCL(9), 'L')
- 20 CONTINUE
-*
- ELSE
- KST = NWKYCK + 1
- NKEYS = NKEYCK
- DO 40 JKK = 1, NKEYS
- IKK = NKEYS + 1 - JKK
- KPNT = IUHUNT (IKK, IQ(KOFSCD+LCDRCD+IKDRCD+MPSRCD),
- + NKEYS*KST, KST)
- IF (KPNT.GT.0) THEN
- KPNT = KOFSCD + LCDRCD + IKDRCD + KPNT - MPSRCD
- ELSE
- KPNT = KOFSCD + LCDRCD + IKDRCD + (IKK - 1) * KST
- ENDIF
- CALL CDPSEL (ITIME, KEYS, IQ(KPNT+1), IFLG, ISEL)
- IF (ISEL.NE.0) GO TO 40
- IF (IOPXCA.NE.0.AND.IQ(KPNT+NOF1CK+1).GT.INOWS) GO TO 40
-*
- CALL CDPATH (TOP1CT, IKK)
- PAT2CT = PATHY(1:NCHR)//'/'//TOP1CT
- CALL RZCDIR (PAT2CT, ' ')
- IF (IQUEST(1).NE.0) THEN
- CALL MZDROP (IDISCD, LAUXCL(10), ' ')
- IRC = 161
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDPLOB : Ill'//
- + 'egal pathname '//PAT2CT//''')', IARGCD, 0)
-#endif
- GO TO 999
- ENDIF
- NKEYCK = IQUEST(7)
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- DO 35 JK = 1, NKEYCK
- IK = NKEYCK + 1 - JK
- CALL CDKEYR (IK, NWKYCK, KEYVCK)
- CALL CDKSEL (ITIME, KEYS, KEYVCK, IFLG, ISEL, INBR)
- IF (ISEL.NE.0) GO TO 35
- IF (IOPXCA.NE.0.AND.KEYVCK(NOF1CK+1).GT.INOWS) GO TO 35
- IF (NWKYCK.GT.NSYSCK) THEN
- DO 25 I = NSYSCK+1, NWKYCK
- IF (IOKYCA(I).NE.0.AND.KEYVCK(I).NE.KEYS(I)) GO TO 35
- 25 CONTINUE
- ENDIF
- NTOT = NTOT + 1
- IF (NSTEP.GT.1) THEN
- IF (MOD(NTOT,NSTEP).NE.1) GO TO 35
- ENDIF
- LAUXCL(9) = 0
- KTIME = KEYVCK(KABS)
- KYVAL = KEYVCK(KPEX)
- CALL VZERO (KEYVCK, NWKYCK)
- KEYVCK(IDHKSN) = IK
- IOKYCA(IDHKSN) = 1
- CALL CDKXIN (ITIME, IDISCD, LAUXCL(9), LAUXCL(9), JBIAS,
- + NWKYCK, KEYVCK, IPREC, IRC)
- IOKYCA(IDHKSN) = 0
- IF (IRC.NE.0) THEN
- IF (LAUXCL(9).NE.0)
- + CALL MZDROP (IDISCD, LAUXCL(9), 'L')
-#if defined(CERNLIB__DEBUG)
- NBAD = NBAD + 1
-#endif
- IRC = 0
- GO TO 35
- ENDIF
- IF (NOBM.GT.IQ(KOFUCD+LAUXCL(9)-1)) THEN
-#if defined(CERNLIB__DEBUG)
- NBAD = NBAD + 1
-#endif
- CALL MZDROP (IDISCD, LAUXCL(9), 'L')
- GO TO 35
- ENDIF
- IF (NPL.EQ.0) CALL CDIOTY (LAUXCL(9), NOBJ, KOBJ, IOTYCP)
- NPL = NPL + 1
- IF (NPL.LE.NPLM) THEN
- IPNT = KOFUCD + LAUXCL(10) + (NPL - 1) * (NOBJ + 1)
- IQ(IPNT+1) = KYVAL
- DO 30 I = 1, NOBJ
- IF (IOTYCP(I).EQ.1.OR.IOTYCP(I).EQ.2.OR.IOTYCP(I).EQ.5)
- + THEN
- IVAL = IQ(KOFUCD+LAUXCL(9)+KOBJ(I))
- Q(IPNT+I+1) = IVAL
- ELSE IF (IOTYCP(I).EQ.4) THEN
- CALL UCOPY (Q(KOFUCD+LAUXCL(9)+KOBJ(I)), DVAL, 2)
- Q(IPNT+I+1) = DVAL
- ELSE
- Q(IPNT+I+1) = Q(KOFUCD+LAUXCL(9)+KOBJ(I))
- ENDIF
- IF (Q(IPNT+I+1).GT.VMAXCP) VMAXCP = Q(IPNT+I+1)
- IF (Q(IPNT+I+1).LT.VMINCP) VMINCP = Q(IPNT+I+1)
- 30 CONTINUE
- IF (KTIME.LT.IMIN) IMIN = KTIME
- IF (KTIME.GT.IMAX) IMAX = KTIME
- ENDIF
- CALL MZDROP (IDISCD, LAUXCL(9), 'L')
- 35 CONTINUE
- CALL RZCDIR (PATHY, ' ')
- IF (IQUEST(1).NE.0) THEN
- CALL MZDROP (IDISCD, LAUXCL(10), ' ')
- IRC = 161
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDPLOB : Ill'//
- + 'egal pathname '//PATHY//''')', IARGCD, 0)
-#endif
- GO TO 999
- ENDIF
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- IF (NPL.GT.NPLM) GO TO 45
- 40 CONTINUE
-*
- ENDIF
-*
-* *** All points collected
-*
- 45 CONTINUE
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.1) CALL CDPRNT (LPRTCD, '(/,'' CDPLOB : Number of'//
- + ' bad objects '',I12)', NBAD, 1)
-#endif
- IF (NPL.EQ.0) THEN
- CALL MZDROP (IDISCD, LAUXCL(10), ' ')
- GO TO 999
- ENDIF
- IF (NPL.GT.NPLM) THEN
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) THEN
- IARGCD(1) = NPL
- IARGCD(2) = NPLM
- CALL CDPRNT (LPRTCD, '(/,'' CDPLOB : Too many objects '','//
- + 'I6,'' only '',I6,'' shown'')', IARGCD, 2)
- ENDIF
-#endif
- NPL = NPLM
- ENDIF
-*
-* *** Sort the objects in increasing time
-*
- CALL CDBANK (IDISCD, LAUXCL(9), LAUXCL(9), 2, 'TIME', 0, 0, 4*NPL,
- + 0, -1, IRC)
- IF (IRC.NE.0) THEN
- CALL MZDROP (IDISCD, LAUXCL(10), ' ')
- GO TO 999
- ENDIF
- DO 50 IK = 1, NPL
- IQ(KOFUCD+LAUXCL(9)+IK) = IQ(KOFUCD+LAUXCL(10)+(IK-1)*(NOBJ+1)
- + +1)
- 50 CONTINUE
- CALL SORTZV (IQ(KOFUCD+LAUXCL(9)+1), IQ(KOFUCD+LAUXCL(9)+NPL+1),
- + NPL, -1, 0, 0)
-*
-* *** Set up the header
-*
- IF (KABS.EQ.IDHINS.OR.IOPXCA.NE.0) THEN
- IF (IMAX.GT.ITNOW) IMAX = ITNOW
- IF (KABS.EQ.IDHINS) THEN
- CALL CDUPTM (IDATX, ITIMX, IMIN, IRC)
- ITIMX = ITIMX * 100
- ELSE
- CALL CDUPTS (IDATX, ITIMX, IMIN, IRC)
- ENDIF
- CALL CDTIMC (IDATX, ITIMX)
- IBINCP(3) = IDATX/10000 + 1900
- IBINCP(2) = MOD (IDATX/100, 100)
- IBINCP(1) = MOD (IDATX , 100)
- CALL CALDAT (101, CHRPCP, IBINCP, IRET)
- DYSTCP = CHRPCP(26:34)
- IF (KABS.EQ.IDHINS) THEN
- CALL CDUPTM (IDATX, ITIMX, IMAX, IRC)
- ITIMX = ITIMX * 100
- ELSE
- CALL CDUPTS (IDATX, ITIMX, IMAX, IRC)
- ENDIF
- CALL CDTIMC (IDATX, ITIMX)
- IBINCP(3) = IDATX/10000 + 1900
- IBINCP(2) = MOD (IDATX/100, 100)
- IBINCP(1) = MOD (IDATX , 100)
- CALL CALDAT (101, CHRPCP, IBINCP, IRET)
- DYENCP = CHRPCP(26:34)
- ELSE
-#if !defined(CERNLIB_IBM)||!defined(CERNLIB__P3CHILD)
- WRITE (DYSTCP, '(I10)') IMIN
- WRITE (DYENCP, '(I10)') IMAX
-#endif
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB__P3CHILD))
- CALL UTWRIT (DYSTCP, '(I10)', IMIN, 1)
- CALL UTWRIT (DYENCP, '(I10)', IMAX, 1)
-#endif
- ENDIF
- IDAY1 = 0
-*
-* *** Now setup the x-scale
-*
- DO 55 IK = 1, NPL
- IPNT = IQ(KOFUCD+LAUXCL(9)+NPL+IK)
- KYVAL = IQ(KOFUCD+LAUXCL(9)+IPNT)
- IF (KPEX.EQ.IDHINS.OR.IOPXCA.NE.0) THEN
- IF (KPEX.EQ.IDHINS) THEN
- CALL CDUPTM (IDATX, ITIMX, KYVAL, IRC)
- ITIMX = ITIMX * 100
- ELSE
- CALL CDUPTS (IDATX, ITIMX, KYVAL, IRC)
- ENDIF
- CALL CDTIMC (IDATX, ITIMX)
- NHOUR = ITIMX / 10000
- NMIN = MOD (ITIMX/100, 100)
- NSEC = MOD (ITIMX , 100)
- HOUR = NHOUR + FLOAT(NMIN)/60.0 + FLOAT(NSEC)/3600.0
- IBINCP(3) = IDATX/10000 + 1900
- IBINCP(2) = MOD (IDATX/100, 100)
- IBINCP(1) = MOD (IDATX , 100)
- CALL CALDAT (101, CHRPCP, IBINCP, IRET)
- IF (IK.EQ.1) IDAY1 = IBINCP(6)
- IDAY = IBINCP(6) - IDAY1
- HOUR = HOUR + 24.0 * IDAY
- Q(KOFUCD+LAUXCL(9)+2*NPL+IK) = HOUR
- ELSE
- Q(KOFUCD+LAUXCL(9)+2*NPL+IK) = KYVAL
- ENDIF
- 55 CONTINUE
- IF (KPEX.EQ.IDHINS.OR.IOPXCA.NE.0) THEN
- XMIN = Q(KOFUCD+LAUXCL(9)+2*NPL+1) - 0.1
- XMAX = Q(KOFUCD+LAUXCL(9)+3*NPL) + 0.1
- ELSE
- XMIN = Q(KOFUCD+LAUXCL(9)+2*NPL+1) - 0.5
- XMAX = Q(KOFUCD+LAUXCL(9)+3*NPL) + 0.5
- ENDIF
- CALL HTITLE (PATHY)
-*
-* *** Now plot the object elements
-*
- YRAN = 0.1 * (VMAXCP - VMINCP)
- YMIN = VMINCP - YRAN
- YMAX = VMAXCP + YRAN
- IF (IOPSCA.NE.0) THEN
- CEXT = ' ... '
- NCEXT = 5
- ELSE
- CEXT = ' '
- NCEXT = 1
- ENDIF
- DO 70 IK = 1, NOBJ
- IF (IOPSCA.EQ.0.OR.IK.EQ.1) THEN
-#if !defined(CERNLIB_IBM)||!defined(CERNLIB__P3CHILD)
- WRITE (CTTLCP, 2001) KOBJ(IK),CEXT(1:NCEXT),CTAG,DYSTCP,DYENCP
-#endif
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB__P3CHILD))
- CALL UTWRIT (CITLCP, '(''Object '',I6,'''//CEXT(1:NCEXT)//
- + 'vs. '//CTAG//' '//DYSTCP//' - '//DYENCP//''')',
- + KOBJ(IK), 1)
-#endif
- IF (HEXIST(-101)) CALL HDELET (-101)
- CALL HBOOK1 (-101, CTTLCP, 2, XMIN, XMAX, 0.)
- CALL HPLOPT ('HORI', 1)
- CALL HMINIM (-101, YMIN)
- CALL HMAXIM (-101, YMAX)
- CALL HPLOT (-101, ' ', 'HIST', 0)
- ENDIF
- KSYM = MOD (IK, MXSYM)
- IF (KSYM.EQ.0) THEN
- ISYM = ISYMB(MXSYM)
- ELSE
- ISYM = ISYMB(KSYM)
- ENDIF
- DO 60 JK = 1, NPL
- IPNT = IQ(KOFUCD+LAUXCL(9)+NPL+JK)
- KPNT = (IPNT - 1) * (NOBJ + 1)
- Q(KOFUCD+LAUXCL(9)+3*NPL+JK) = Q(KOFUCD+LAUXCL(10)+KPNT+IK+1)
- 60 CONTINUE
- IF (IOPPCA.NE.0) THEN
- CALL HPLSYM (Q(KOFUCD+LAUXCL(9)+2*NPL+1),
- + Q(KOFUCD+LAUXCL(9)+3*NPL+1), NPL, ISYM, 0.1, ' ')
- ENDIF
- IF (IOPPCA.EQ.0.OR.IOPLCA.NE.0) THEN
- CALL HPLINE (Q(KOFUCD+LAUXCL(9)+2*NPL+1),
- + Q(KOFUCD+LAUXCL(9)+3*NPL+1), NPL, ' ')
- ENDIF
- IF (IOPSCA.EQ.0.AND.IK.NE.NOBJ) CALL CDUSIN
- 70 CONTINUE
-*
- 80 IF (LAUXCL(10).NE.0) CALL MZDROP (IDISCD, LAUXCL(10), ' ')
- IF (LAUXCL(9) .NE.0) CALL MZDROP (IDISCD, LAUXCL(9), ' ')
- IF (HEXIST(-101)) CALL HDELET (-101)
- IRC = 0
-#if !defined(CERNLIB_IBM)||!defined(CERNLIB__P3CHILD)
-*
- 2001 FORMAT ('Object ',I6,A,'vs. ',A,' ',A,' - ',A)
-#endif
-* END CDPLOB
- 999 END
diff --git a/src/packlib/hepdb/cdplot/cdplov.F b/src/packlib/hepdb/cdplot/cdplov.F
deleted file mode 100644
index a7ccf25..0000000
--- a/src/packlib/hepdb/cdplot/cdplov.F
+++ /dev/null
@@ -1,478 +0,0 @@
-*
-* $Id: cdplov.F,v 1.1.1.1 1996/02/28 16:24:22 mclareni Exp $
-*
-* $Log: cdplov.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:22 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
-#if (defined(CERNLIB__P3CHILD))&&(defined(CERNLIB_IBM))
-* Ignoring t=dummy
-#endif
- SUBROUTINE CDPLOV (PATHN, MASK, KEYS, NOBJ, KOBJ, NST, CHOPT, IRC)
-* ==================================================================
-*
-************************************************************************
-* *
-* SUBR. CDPLOV (PATHN, MASK, KEYS, NOBJ, KOBJ, NST, CHOPT, IRC*)*
-* *
-* Plots data elemnet(s) versus data element(s) for a given path name *
-* Selects objects with validity range as specified in KEYS(NOF1CK..) *
-* if the proper masks are used. It sees the object in data base has *
-* lower range smaller than and higher range larger than the value *
-* specified. Selection on insertion time demands data base object *
-* to be inserted before the value supplied in selection *
-* *
-* Arguments : *
-* *
-* PATHN Character string describing the pathname *
-* MASK Integer vector indicating which elements of KEYS are *
-* significant for selection. If MASK corresponding to *
-* one of the fields of 'Beginning' validity range is set, *
-* it will select objects with start validity larger than *
-* those requested in KEYS. If MASK corresponding to one *
-* of the fields of 'End' validity range is set, it will *
-* select objects with start validity smaller than those *
-* in the KEYS vector (in the fields corresponding to end *
-* validity). If MASK corresponding to time of insertion *
-* is set, objects inserted earlier than KEYS(IDHINS) are *
-* selected *
-* KEYS Vector of keys. Only the elements declared in CHOPT are *
-* assumed to contain useful information. *
-* NOBJ Number of data objects to be plotted *
-* KOBJ Vector specifying the element numbers to be plotted *
-* NST Step size for selection of object number *
-* CHOPT Character string with any of the following characters *
-* L line to be drawn through the points *
-* P a symbol to be drawn at each point *
-* (If L or P not chosen, a default marker to be drawn *
-* at each point) *
-* X Assumes validity range packed time ala CDPKTS *
-* IRC Return code (see below) *
-* *
-* Called by Interactive interface *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* =161 : Illegal path name *
-* =162 : No keys or data in the directory *
-* =163 : Illegal number of objects *
-* *
-************************************************************************
-*
-#include "hepdb/caopts.inc"
-#include "hepdb/cdcblk.inc"
-#include "hepdb/cinitl.inc"
-#include "hepdb/ckkeys.inc"
-#include "hepdb/clinks.inc"
-#include "hepdb/cplots.inc"
-#include "hepdb/ctpath.inc"
- PARAMETER (JBIAS=2)
- LOGICAL HEXIST
- CHARACTER PATHN*(*), CHOPT*(*), PATHY*80
- DIMENSION KEYS(9), MASK(9), KOBJ(2,9), ITIME(MXPACD)
- DOUBLE PRECISION DVAL
-#include "zebra/q_jbit.inc"
-* Ignoring t=pass
-*
-* ------------------------------------------------------------------
-*
-* *** Decode the character option
-*
- CALL CDOPTS (CHOPT, IRC)
- IF (IRC.NE.0) GO TO 999
- CALL UCOPY (MASK, IOKYCA, MXDMCK)
-*
-* *** Load the top level directory
-*
- CALL CDLDUP (PATHN, 0, IRC)
- IF (IRC.NE.0) GO TO 999
-*
- PATHY = PAT1CT
- NCHR = LENOCC (PATHY)
- IF (NKEYCK.LE.0) THEN
- IRC = 162
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDPLOV : No keys'//
- + ' in directory '//PATHY//''')', IARGCD, 0)
-#endif
- GO TO 999
- ENDIF
- CALL CDKEYT
-*
- IF (IOPXCA.EQ.0) THEN
- KABS = IDHINS
- ELSE
- KABS = NOF1CK + 1
- ENDIF
- IF (NST.GT.0) THEN
- NSTEP = NST
- ELSE
- NSTEP = 1
- ENDIF
- IF (NOBJ.LT.1.OR.NOBJ.GT.NOBMCP) THEN
- IRC = 163
- IQUEST(11) = NOBJ
- IQUEST(12) = NOBMCP
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDPLOV : Illegal'//
- + ' number of objects '',2I12)', IQUEST(11), 2)
-#endif
- GO TO 999
- ENDIF
- NOBJD = 0
- NOBM = KOBJ(1,1)
- DO 5 IK = 1, NOBJ
- II = IUCOMP (KOBJ(1,IK), KOBJCP, NOBJD)
- IF (II.EQ.0) THEN
- NOBJD = NOBJD + 1
- II = NOBJD
- KOBJCP(II) = KOBJ(1,IK)
- IF (KOBJCP(II).GT.NOBM) NOBM = KOBJCP(II)
- ENDIF
- INDXCP(1,IK) = II
- II = IUCOMP (KOBJ(2,IK), KOBJCP, NOBJD)
- IF (II.EQ.0) THEN
- NOBJD = NOBJD + 1
- II = NOBJD
- KOBJCP(II) = KOBJ(2,IK)
- ENDIF
- INDXCP(2,IK) = II
- 5 CONTINUE
-*
- IOPTP = JBIT (IQ(KOFSCD+LCDRCD+IKDRCD+IDHFLG), JPRTCD)
- NTOT = 0
-#if defined(CERNLIB__DEBUG)
- NBAD = 0
-#endif
-*
-* *** Prepare a temporary storage for useful information
-*
- CALL DATIME (IDATX, ITIMX)
- CALL CDPKTS (IDATX, ITIMX*100, INOWS, IRC)
- IF (KABS.EQ.IDHINS) THEN
- CALL CDPKTM (IDATX, ITIMX, ITNOW, IRC)
- ELSE
- ITNOW = INOWS
- ENDIF
- NPLM = NPLMCP
- IF (IOPTP.EQ.0) THEN
- IF (NKEYCK.LT.NPLM) NPLM = NKEYCK
- ENDIF
- ND = (NOBJD + 1) * NPLM
- IF (LAUXCL(10).NE.0) CALL MZDROP (IDISCD, LAUXCL(10), 'L')
- CALL CDBANK (IDISCD, LAUXCL(10), LAUXCL(10), 2, 'TEMP', 0, 0, ND,
- + 0, -1, IRC)
- IF (IRC.NE.0) GO TO 999
- VMINCP = 9.0E20
- VMAXCP =-9.0E20
- IF (LAUXCL(9).NE.0) THEN
- CALL MZDROP (IDISCD, LAUXCL(9), 'L')
- LAUXCL(9) = 0
- ENDIF
-*
-* *** Load useful data in the temporary bank
-*
- IMIN = IBIGCD
- IMAX = -1
- NPL = 0
- IPRBCA = ISIGN (IPRBCA, -1)
- IPRECA = ISIGN (IPRECA, -1)
- IF (IPRBCA.EQ.0.AND.IPRECA.EQ.0) THEN
- IFLG = 99
- ELSE
- IFLG = 0
- ENDIF
- DO 10 I = 1, NPARCD
- ITIME(I) = 1
- 10 CONTINUE
- IF (IOPTP.EQ.0) THEN
- DO 20 JK = 1, NKEYCK
- IK = NKEYCK + 1 - JK
- CALL CDKEYR (IK, NWKYCK, KEYVCK)
- CALL CDKSEL (ITIME, KEYS, KEYVCK, IFLG, ISEL, INBR)
- IF (ISEL.NE.0) GO TO 20
- IF (IOPXCA.NE.0.AND.KEYVCK(NOF1CK+1).GT.INOWS) GO TO 20
- NTOT = NTOT + 1
- IF (NSTEP.GT.1) THEN
- IF (MOD(NTOT,NSTEP).NE.1) GO TO 20
- ENDIF
- LAUXCL(9) = 0
- KTIME = KEYVCK(KABS)
- CALL VZERO (KEYVCK, NWKYCK)
- KEYVCK(IDHKSN) = IK
- IOKYCA(IDHKSN) = 1
- CALL CDKXIN (ITIME, IDISCD, LAUXCL(9), LAUXCL(9), JBIAS,
- + NWKYCK, KEYVCK, IPREC, IRC)
- IOKYCA(IDHKSN) = 0
- IF (IRC.NE.0) THEN
- IF (LAUXCL(9).NE.0) CALL MZDROP (IDISCD, LAUXCL(9), 'L')
- IRC = 0
-#if defined(CERNLIB__DEBUG)
- NBAD = NBAD + 1
-#endif
- GO TO 20
- ENDIF
- IF (NOBM.GT.IQ(KOFUCD+LAUXCL(9)-1)) THEN
-#if defined(CERNLIB__DEBUG)
- NBAD = NBAD + 1
-#endif
- CALL MZDROP (IDISCD, LAUXCL(9), 'L')
- GO TO 20
- ENDIF
- IF (NPL.EQ.0) CALL CDIOTY (LAUXCL(9), NOBJD, KOBJCP, IOTYCP)
- NPL = NPL + 1
- IF (NPL.LE.NPLM) THEN
- IPNT = KOFUCD + LAUXCL(10) + (NPL - 1) * (NOBJD + 1)
- IQ(IPNT+1) = KTIME
- DO 15 I = 1, NOBJD
- IF (IOTYCP(I).EQ.1.OR.IOTYCP(I).EQ.2.OR.IOTYCP(I).EQ.5)
- + THEN
- IVAL = IQ(KOFUCD+LAUXCL(9)+KOBJCP(I))
- Q(IPNT+I+1) = IVAL
- ELSE IF (IOTYCP(I).EQ.4) THEN
- CALL UCOPY (Q(KOFUCD+LAUXCL(9)+KOBJCP(I)), DVAL, 2)
- Q(IPNT+I+1) = DVAL
- ELSE
- Q(IPNT+I+1) = Q(KOFUCD+LAUXCL(9)+KOBJCP(I))
- ENDIF
- IF (Q(IPNT+I+1).GT.VMAXCP) VMAXCP = Q(IPNT+I+1)
- IF (Q(IPNT+I+1).LT.VMINCP) VMINCP = Q(IPNT+I+1)
- 15 CONTINUE
- IF (KTIME.LT.IMIN) IMIN = KTIME
- IF (KTIME.GT.IMAX) IMAX = KTIME
- ENDIF
- CALL MZDROP (IDISCD, LAUXCL(9), ' ')
- 20 CONTINUE
-*
- ELSE
- KST = NWKYCK + 1
- NKEYS = NKEYCK
- DO 40 JKK = 1, NKEYS
- IKK = NKEYS + 1 - JKK
- KPNT = IUHUNT (IKK, IQ(KOFSCD+LCDRCD+IKDRCD+MPSRCD),
- + NKEYS*KST, KST)
- IF (KPNT.GT.0) THEN
- KPNT = KOFSCD + LCDRCD + IKDRCD + KPNT - MPSRCD
- ELSE
- KPNT = KOFSCD + LCDRCD + IKDRCD + (IKK - 1) * KST
- ENDIF
- CALL CDPSEL (ITIME, KEYS, IQ(KPNT+1), IFLG, ISEL)
- IF (ISEL.NE.0) GO TO 40
- IF (IOPXCA.NE.0.AND.IQ(KPNT+NOF1CK+1).GT.INOWS) GO TO 40
-*
- CALL CDPATH (TOP1CT, IKK)
- PAT2CT = PATHY(1:NCHR)//'/'//TOP1CT
- CALL RZCDIR (PAT2CT, ' ')
- IF (IQUEST(1).NE.0) THEN
- CALL MZDROP (IDISCD, LAUXCL(10), ' ')
- IRC = 161
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDPLOV : Ill'//
- + 'egal pathname '//PAT2CT//''')', IARGCD, 0)
-#endif
- GO TO 999
- ENDIF
- NKEYCK = IQUEST(7)
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- DO 35 JK = 1, NKEYCK
- IK = NKEYCK + 1 - JK
- CALL CDKEYR (IK, NWKYCK, KEYVCK)
- CALL CDKSEL (ITIME, KEYS, KEYVCK, IFLG, ISEL, INBR)
- IF (ISEL.NE.0) GO TO 35
- IF (IOPXCA.NE.0.AND.KEYVCK(NOF1CK+1).GT.INOWS) GO TO 35
- NTOT = NTOT + 1
- IF (NSTEP.GT.1) THEN
- IF (MOD(NTOT,NSTEP).NE.1) GO TO 35
- ENDIF
- LAUXCL(9) = 0
- KTIME = KEYVCK(KABS)
- CALL VZERO (KEYVCK, NWKYCK)
- KEYVCK(IDHKSN) = IK
- IOKYCA(IDHKSN) = 1
- CALL CDKXIN (ITIME, IDISCD, LAUXCL(9), LAUXCL(9), JBIAS,
- + NWKYCK, KEYVCK, IPREC, IRC)
- IOKYCA(IDHKSN) = 0
- IF (IRC.NE.0) THEN
- IF (LAUXCL(9).NE.0) CALL MZDROP (IDISCD, LAUXCL(9), 'L')
- IRC = 0
-#if defined(CERNLIB__DEBUG)
- NBAD = NBAD + 1
-#endif
- GO TO 35
- ENDIF
- IF (NOBM.GT.IQ(KOFUCD+LAUXCL(9)-1)) THEN
-#if defined(CERNLIB__DEBUG)
- NBAD = NBAD + 1
-#endif
- CALL MZDROP (IDISCD, LAUXCL(9), 'L')
- GO TO 35
- ENDIF
- IF (NPL.EQ.0) CALL CDIOTY (LAUXCL(9), NOBJD, KOBJCP, IOTYCP)
- NPL = NPL + 1
- IF (NPL.LE.NPLM) THEN
- IPNT = KOFUCD + LAUXCL(10) + (NPL - 1) * (NOBJD + 1)
- IQ(IPNT+1) = KTIME
- DO 30 I = 1, NOBJD
- IF (IOTYCP(I).EQ.1.OR.IOTYCP(I).EQ.2.OR.IOTYCP(I).EQ.5)
- + THEN
- IVAL = IQ(KOFUCD+LAUXCL(9)+KOBJCP(I))
- Q(IPNT+I+1) = IVAL
- ELSE IF (IOTYCP(I).EQ.4) THEN
- CALL UCOPY (Q(KOFUCD+LAUXCL(9)+KOBJCP(I)), DVAL, 2)
- Q(IPNT+I+1) = DVAL
- ELSE
- Q(IPNT+I+1) = Q(KOFUCD+LAUXCL(9)+KOBJCP(I))
- ENDIF
- IF (Q(IPNT+I+1).GT.VMAXCP) VMAXCP = Q(IPNT+I+1)
- IF (Q(IPNT+I+1).LT.VMINCP) VMINCP = Q(IPNT+I+1)
- 30 CONTINUE
- IF (KTIME.LT.IMIN) IMIN = KTIME
- IF (KTIME.GT.IMAX) IMAX = KTIME
- ENDIF
- CALL MZDROP (IDISCD, LAUXCL(9), ' ')
- 35 CONTINUE
- CALL RZCDIR (PATHY, ' ')
- IF (IQUEST(1).NE.0) THEN
- CALL MZDROP (IDISCD, LAUXCL(10), ' ')
- IRC = 161
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDPLOV : Ill'//
- + 'egal pathname '//PATHY//''')', IARGCD, 0)
-#endif
- GO TO 999
- ENDIF
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- IF (NPL.GT.NPLM) GO TO 45
- 40 CONTINUE
-*
- ENDIF
-*
-* *** All points collected
-*
- 45 CONTINUE
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.1) CALL CDPRNT (LPRTCD, '(/,'' CDPLOV : Number of'//
- + ' bad objects '',I12)', NBAD, 1)
-#endif
- IF (NPL.EQ.0) THEN
- CALL MZDROP (IDISCD, LAUXCL(10), ' ')
- GO TO 999
- ENDIF
- IF (NPL.GT.NPLM) THEN
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) THEN
- IARGCD(1) = NPL
- IARGCD(1) = NPLM
- CALL CDPRNT (LPRTCD, '(/,'' CDPLOV : Too many objects '','//
- + 'I6,'' only '',I6,'' shown'')', IARGCD, 2)
- ENDIF
-#endif
- NPL = NPLM
- ENDIF
-*
-* *** Sort the objects in increasing time
-*
- CALL CDBANK (IDISCD, LAUXCL(9), LAUXCL(9), 2, 'TIME', 0, 0, 4*NPL,
- + 0, -1, IRC)
- IF (IRC.NE.0) THEN
- CALL MZDROP (IDISCD, LAUXCL(10), ' ')
- GO TO 999
- ENDIF
- DO 50 IK = 1, NPL
- IQ(KOFUCD+LAUXCL(9)+IK) = IQ(KOFUCD+LAUXCL(10)+(IK-1)*(NOBJD+1)
- + +1)
- 50 CONTINUE
- CALL SORTZV (IQ(KOFUCD+LAUXCL(9)+1), IQ(KOFUCD+LAUXCL(9)+NPL+1),
- + NPL, -1, 0, 0)
-*
-* *** Set up the header
-*
- IF (IMAX.GT.ITNOW) IMAX = ITNOW
- IF (KABS.EQ.IDHINS) THEN
- CALL CDUPTM (IDATX, ITIMX, IMIN, IRC)
- ITIMX = ITIMX * 100
- ELSE
- CALL CDUPTS (IDATX, ITIMX, IMIN, IRC)
- ENDIF
- CALL CDTIMC (IDATX, ITIMX)
- IBINCP(3) = IDATX/10000 + 1900
- IBINCP(2) = MOD (IDATX/100, 100)
- IBINCP(1) = MOD (IDATX , 100)
- CALL CALDAT (101, CHRPCP, IBINCP, IRET)
- DYSTCP = CHRPCP(26:34)
- IF (KABS.EQ.IDHINS) THEN
- CALL CDUPTM (IDATX, ITIMX, IMAX, IRC)
- ITIMX = ITIMX * 100
- ELSE
- CALL CDUPTS (IDATX, ITIMX, IMAX, IRC)
- ENDIF
- CALL CDTIMC (IDATX, ITIMX)
- IBINCP(3) = IDATX/10000 + 1900
- IBINCP(2) = MOD (IDATX/100, 100)
- IBINCP(1) = MOD (IDATX , 100)
- CALL CALDAT (101, CHRPCP, IBINCP, IRET)
- DYENCP = CHRPCP(26:34)
- CALL HTITLE (PATHY)
- CALL HPLOPT ('HORI', 1)
-*
-* *** Now make the plots
-*
- DO 70 JK = 1, NOBJ
- IK1 = INDXCP(1,JK)
- IK2 = INDXCP(2,JK)
-#if !defined(CERNLIB_IBM)||!defined(CERNLIB__P3CHILD)
- WRITE (CTTLCP, 2000) KOBJCP(IK2), KOBJCP(IK1), DYSTCP, DYENCP
-#endif
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB__P3CHILD))
- IARGCD(1) = KOBJCP(IK2)
- IARGCD(2) = KOBJCP(IK1)
- CALL UTWRIT (CTTLCP, '(''Object '',I5,'' vs. Object '',I5,'' '//
- + ' '//DYSTCP//' - '//DYENCP//''')', IARGCD, 2)
-#endif
- XRAN = 0.1 * (VMAXCP - VMINCP)
- IF (XRAN.EQ.0.0) XRAN = 0.01
- XMIN = VMINCP - XRAN
- XMAX = VMAXCP + XRAN
- YRAN = 0.1 * (VMAXCP - VMINCP)
- IF (YRAN.EQ.0.0) YRAN = 0.01
- YMIN = VMINCP - YRAN
- YMAX = VMAXCP + YRAN
- IF (HEXIST(-101)) CALL HDELET (-101)
- CALL HBOOK1 (-101, CTTLCP, 2, XMIN, XMAX, 0.)
- CALL HMINIM (-101, YMIN)
- CALL HMAXIM (-101, YMAX)
- DO 60 IK = 1, NPL
- IPNT = IQ(KOFUCD+LAUXCL(9)+NPL+IK)
- KPNT = KOFUCD + LAUXCL(10) + (IPNT - 1) * (NOBJD + 1) + 1
- Q(KOFUCD+LAUXCL(9)+2*NPL+IK) = Q(KPNT+IK1)
- Q(KOFUCD+LAUXCL(9)+3*NPL+IK) = Q(KPNT+IK2)
- 60 CONTINUE
- CALL HPLOT (-101, ' ', 'HIST', 0)
- IF (IOPPCA.NE.0) THEN
- CALL HPLSYM (Q(KOFUCD+LAUXCL(9)+2*NPL+1),
- + Q(KOFUCD+LAUXCL(9)+3*NPL+1), NPL, 31, 0.1, ' ')
- ELSE IF (IOPLCA.NE.0) THEN
- CALL HPLINE (Q(KOFUCD+LAUXCL(9)+2*NPL+1),
- + Q(KOFUCD+LAUXCL(9)+3*NPL+1), NPL, ' ')
- ELSE
- CALL HPLSYM (Q(KOFUCD+LAUXCL(9)+2*NPL+1),
- + Q(KOFUCD+LAUXCL(9)+3*NPL+1), NPL, 24, 0.05, ' ')
- ENDIF
- IF (JK.NE.NOBJ) CALL CDUSIN
- 70 CONTINUE
-*
- 80 IF (LAUXCL(10).NE.0) CALL MZDROP (IDISCD, LAUXCL(10), ' ')
- IF (LAUXCL(9) .NE.0) CALL MZDROP (IDISCD, LAUXCL(9), ' ')
- IF (HEXIST(-101)) CALL HDELET (-101)
- IRC = 0
-#if !defined(CERNLIB_IBM)||!defined(CERNLIB__P3CHILD)
-*
- 2000 FORMAT ('Object ',I5,' vs. Object ',I5,' ',A,' - ',A)
-#endif
-* END CDPLOV
- 999 END
diff --git a/src/packlib/hepdb/cdplot/cdplti.F b/src/packlib/hepdb/cdplot/cdplti.F
deleted file mode 100644
index 97ff4a7..0000000
--- a/src/packlib/hepdb/cdplot/cdplti.F
+++ /dev/null
@@ -1,327 +0,0 @@
-*
-* $Id: cdplti.F,v 1.1.1.1 1996/02/28 16:24:23 mclareni Exp $
-*
-* $Log: cdplti.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:23 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
-#if (defined(CERNLIB__P3CHILD))&&(defined(CERNLIB_IBM))
-* Ignoring t=dummy
-#endif
- SUBROUTINE CDPLTI (PATHN, MASK, KEYS, CHOPT, IRC)
-* =================================================
-*
-************************************************************************
-* *
-* SUBR. CDPLTI (PATHN, MASK, KEYS, CHOPT, IRC*) *
-* *
-* Plots the validity time of data objects in a given directory. *
-* It works only when there is one pair of validity range for DB. *
-* Selects objects with validity range as specified in KEYS(NOF1CK..) *
-* if the proper masks are used. It sees the object in data base has *
-* lower range smaller than and higher range larger than the value *
-* specified. Selection on insertion time demands data base object *
-* to be inserted before the value supplied in selection *
-* *
-* Arguments : *
-* *
-* PATHN Character string describing the pathname *
-* MASK Integer vector indicating which elements of KEYS are *
-* significant for selection. If MASK corresponding to *
-* one of the fields of 'Beginning' validity range is set, *
-* it will select objects with start validity larger than *
-* those requested in KEYS. If MASK corresponding to one *
-* of the fields of 'End' validity range is set, it will *
-* select objects with start validity smaller than those *
-* in the KEYS vector (in the fields corresponding to end *
-* validity). If MASK corresponding to time of insertion *
-* is set, objects inserted earlier than KEYS(IDHINS) are *
-* selected *
-* KEYS Vector of keys. Only the elements declared in CHOPT are *
-* assumed to contain useful information. *
-* CHOPT Character string with any of the following characters *
-* X Assumes validity range packed time ala CDPKTS *
-* IRC Return code (see below) *
-* *
-* Called by Interactive interface *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* =161 : Illegal path name *
-* =162 : No keys or data in the directory *
-* *
-************************************************************************
-*
-#include "hepdb/caopts.inc"
-#include "hepdb/cdcblk.inc"
-#include "hepdb/ckkeys.inc"
-#include "hepdb/clinks.inc"
-#include "hepdb/cplots.inc"
-#include "hepdb/ctpath.inc"
- PARAMETER (JBIAS=2)
- LOGICAL HEXIST
- CHARACTER PATHN*(*), CHOPT*(*), PATHY*80
- DIMENSION KEYS(9), MASK(9), ITIME(MXPACD), XU(2), YU(2)
-#include "zebra/q_jbit.inc"
-* Ignoring t=pass
-*
-* ------------------------------------------------------------------
-*
-* *** Decode the character option
-*
- CALL CDOPTS (CHOPT, IRC)
- IF (IRC.NE.0) GO TO 999
- CALL UCOPY (MASK, IOKYCA, MXDMCK)
-*
-* *** Load the top level directory
-*
- CALL CDLDUP (PATHN, 0, IRC)
- IF (IRC.NE.0) GO TO 999
- IF (NPARCD.NE.1) GO TO 999
-*
- PATHY = PAT1CT
- NCHR = LENOCC (PATHY)
- IF (NKEYCK.LE.0) THEN
- IRC = 162
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDPLOB : No keys'//
- + ' in directory '//PATHY//''')', IARGCD, 0)
-#endif
- GO TO 999
- ENDIF
-*
- CALL CDKEYT
- IOPTP = JBIT (IQ(KOFSCD+LCDRCD+IKDRCD+IDHFLG), JPRTCD)
-*
-* *** Prepare a temporary storage for useful information
-*
- CALL DATIME (IDATX, ITIMX)
- CALL CDPKTS (IDATX, ITIMX*100, INOWS, IRC)
- NPLM = NPLMCP
- IF (IOPTP.EQ.0) THEN
- IF (NKEYCK.LT.NPLM) NPLM = NKEYCK
- ENDIF
- ND = 3 * NPLM
- IF (LAUXCL(10).NE.0) CALL MZDROP (IDISCD, LAUXCL(10), 'L')
- CALL CDBANK (IDISCD, LAUXCL(10), LAUXCL(10), 2, 'TEMP', 0, 0, ND,
- + 2, -1, IRC)
- IF (IRC.NE.0) GO TO 999
-*
-* *** Load useful data in the temporary bank
-*
- IMIN = IBIGCD
- IMAX = -1
- NPL = 0
- IKMAX = 0
- IPRBCA = ISIGN (IPRBCA, -1)
- IPRECA = ISIGN (IPRECA, -1)
- IF (IPRBCA.EQ.0.AND.IPRECA.EQ.0) THEN
- IFLG = 99
- ELSE
- IFLG = 0
- ENDIF
- DO 10 I = 1, NPARCD
- ITIME(I) = 1
- 10 CONTINUE
- IF (IOPTP.EQ.0) THEN
- DO 15 JK = 1, NKEYCK
- IK = NKEYCK + 1 - JK
- CALL CDKEYR (IK, NWKYCK, KEYVCK)
- CALL CDKSEL (ITIME, KEYS, KEYVCK, IFLG, ISEL, INBR)
- IF (ISEL.NE.0) GO TO 15
- IF (IOPXCA.NE.0.AND.KEYVCK(NOF1CK+1).GT.INOWS) GO TO 15
- NPL = NPL + 1
- IF (NPL.LE.NPLM) THEN
- IPNT = KOFUCD + LAUXCL(10) + (NPL - 1) * 3
- IQ(IPNT+1) = KEYVCK(IDHKSN)
- IQ(IPNT+2) = KEYVCK(NOF1CK+2*NPARCD-1)
- IQ(IPNT+3) = KEYVCK(NOF1CK+2*NPARCD)
- IF (KEYVCK(NOF1CK+2*NPARCD) .GT.IMAX)
- + IMAX = KEYVCK(NOF1CK+2*NPARCD)
- IF (KEYVCK(NOF1CK+2*NPARCD-1).LT.IMIN)
- + IMIN = KEYVCK(NOF1CK+2*NPARCD-1)
- IF (IKMAX.LT.KEYVCK(IDHKSN)) IKMAX = KEYVCK(IDHKSN)
- ENDIF
- 15 CONTINUE
-*
- ELSE
- KST = NWKYCK + 1
- NKEYS = NKEYCK
- DO 30 JKK = 1, NKEYS
- IKK = NKEYS + 1 - JKK
- KPNT = IUHUNT (IKK, IQ(KOFSCD+LCDRCD+IKDRCD+MPSRCD),
- + NKEYS*KST, KST)
- IF (KPNT.GT.0) THEN
- KPNT = KOFSCD + LCDRCD + IKDRCD + KPNT - MPSRCD
- ELSE
- KPNT = KOFSCD + LCDRCD + IKDRCD + (IKK - 1) * KST
- ENDIF
- CALL CDPSEL (ITIME, KEYS, IQ(KPNT+1), IFLG, ISEL)
- IF (ISEL.NE.0) GO TO 30
- IF (IOPXCA.NE.0.AND.IQ(KPNT+NOF1CK+1).GT.INOWS) GO TO 30
-*
- CALL CDPATH (TOP1CT, IKK)
- PAT2CT = PATHY(1:NCHR)//'/'//TOP1CT
- CALL RZCDIR (PAT2CT, ' ')
- IF (IQUEST(1).NE.0) THEN
- CALL MZDROP (IDISCD, LAUXCL(10), ' ')
- IRC = 161
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDPLTI : Ill'//
- + 'egal pathname '//PAT2CT//''')', IARGCD, 0)
-#endif
- GO TO 999
- ENDIF
- NKEYCK = IQUEST(7)
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- DO 25 JK = 1, NKEYCK
- IK = NKEYCK + 1 - JK
- CALL CDKEYR (IK, NWKYCK, KEYVCK)
- CALL CDKSEL (ITIME, KEYS, KEYVCK, IFLG, ISEL, INBR)
- IF (ISEL.NE.0) GO TO 25
- IF (IOPXCA.NE.0.AND.KEYVCK(NOF1CK+1).GT.INOWS) GO TO 25
- NPL = NPL + 1
- IF (NPL.LE.NPLM) THEN
- IPNT = KOFUCD + LAUXCL(10) + (NPL - 1) * 3
- IQ(IPNT+1) = KEYVCK(IDHKSN)
- IQ(IPNT+2) = KEYVCK(NOF1CK+2*NPARCD-1)
- IQ(IPNT+3) = KEYVCK(NOF1CK+2*NPARCD)
- IF (KEYVCK(NOF1CK+2*NPARCD) .GT.IMAX)
- + IMAX = KEYVCK(NOF1CK+2*NPARCD)
- IF (KEYVCK(NOF1CK+2*NPARCD-1).LT.IMIN)
- + IMIN = KEYVCK(NOF1CK+2*NPARCD-1)
- IF (IKMAX.LT.KEYVCK(IDHKSN)) IKMAX = KEYVCK(IDHKSN)
- ENDIF
- 25 CONTINUE
- CALL RZCDIR (PATHY, ' ')
- IF (IQUEST(1).NE.0) THEN
- CALL MZDROP (IDISCD, LAUXCL(10), ' ')
- IRC = 161
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDPLTI : Ill'//
- + 'egal pathname '//PATHY//''')', IARGCD, 0)
-#endif
- GO TO 999
- ENDIF
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- IF (NPL.GT.NPLM) GO TO 35
- 30 CONTINUE
-*
- ENDIF
-*
-* *** All points collected; now decide the scale and header
-*
- 35 IF (NPL.EQ.0) THEN
- CALL MZDROP (IDISCD, LAUXCL(10), ' ')
- GO TO 999
- ENDIF
- IF (NPL.GT.NPLM) THEN
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) THEN
- IARGCD(1) = NPL
- IARGCD(2) = NPLM
- CALL CDPRNT (LPRTCD, '(/,'' CDPLTI : Too many objects '','//
- + 'I6,'' only '',I6,'' shown'')', IARGCD, 2)
- ENDIF
-#endif
- NPL = NPLM
- ENDIF
- IF (IOPXCA.NE.0) THEN
- IF (IMAX.GT.INOWS) IMAX = INOWS
- CALL CDUPTS (IDATX, ITIMX, IMIN, IRC)
- CALL CDTIMC (IDATX, ITIMX)
- IBINCP(3) = IDATX/10000 + 1900
- IBINCP(2) = MOD (IDATX/100, 100)
- IBINCP(1) = MOD (IDATX , 100)
- CALL CALDAT (101, CHRPCP, IBINCP, IRET)
- DYSTCP = CHRPCP(26:34)
- IDAY1 = IBINCP(6)
- CALL CDUPTS (IDATX, ITIMX, IMAX, IRC)
- CALL CDTIMC (IDATX, ITIMX)
- IBINCP(3) = IDATX/10000 + 1900
- IBINCP(2) = MOD (IDATX/100, 100)
- IBINCP(1) = MOD (IDATX , 100)
- CALL CALDAT (101, CHRPCP, IBINCP, IRET)
- DYENCP = CHRPCP(26:34)
- IDAY2 = IBINCP(6) - IDAY1 + 1
- TMAX = 24.0 * IDAY2
- ELSE
- TMAX = (IMAX - IMIN) + 1.
-#if !defined(CERNLIB_IBM)||!defined(CERNLIB__P3CHILD)
- WRITE (DYSTCP, '(I10)') IMIN
- WRITE (DYENCP, '(I10)') IMAX
-#endif
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB__P3CHILD))
- CALL UTWRIT (DYSTCP, '(I10)', IMIN, 1)
- CALL UTWRIT (DYENCP, '(I10)', IMAX, 1)
-#endif
- ENDIF
-#if !defined(CERNLIB_IBM)||!defined(CERNLIB__P3CHILD)
- WRITE (CTTLCP, 2000) DYSTCP, DYENCP
-#endif
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB__P3CHILD))
- CALL UTWRIT (CITLDP, '(''Object Validity Range during '//DYSTCP//
- + ' - '//DYENCP//''')', IARGCD, 0)
-#endif
- IF (HEXIST(-101)) CALL HDELET (-101)
- CALL HBOOK1 (-101, CTTLCP, 2, 0., TMAX, 0.)
- CALL HMINIM (-101, 0.)
- CALL HMAXIM (-101, FLOAT(IKMAX)+2.)
- CALL HTITLE (PATHY)
- CALL HPLOPT ('HORI', 1)
- CALL HPLOT (-101, ' ', 'HIST', 0)
-*
-* *** Now plot the keys
-*
- DO 40 JK = 1, NPL
- IPNT = KOFUCD + LAUXCL(10) + (JK - 1) * 3
- IK = IQ(IPNT+1)
- IF (IOPXCA.NE.0) THEN
- CALL CDUPTS (IDATX, ITIMX, IQ(IPNT+2), IRC)
- CALL CDTIMC (IDATX, ITIMX)
- IBINCP(3) = IDATX/10000 + 1900
- IBINCP(2) = MOD (IDATX/100, 100)
- IBINCP(1) = MOD (IDATX , 100)
- CALL CALDAT (101, CHRPCP, IBINCP, IRET)
- IDAY = IBINCP(6) - IDAY1
- NHOUR = ITIMX / 10000
- NMIN = MOD (ITIMX/100, 100)
- NSEC = MOD (ITIMX , 100)
- HOURS = NHOUR + FLOAT(NMIN)/60. + FLOAT(NSEC)/3600.
- XU(1) = HOURS + 24.0 * IDAY
- CALL CDUPTS (IDATX, ITIMX, IQ(IPNT+3), IRC)
- CALL CDTIMC (IDATX, ITIMX)
- IBINCP(3) = IDATX/10000 + 1900
- IBINCP(2) = MOD (IDATX/100, 100)
- IBINCP(1) = MOD (IDATX , 100)
- CALL CALDAT (101, CHRPCP, IBINCP, IRET)
- IDAY = IBINCP(6) - IDAY1
- NHOUR = ITIMX / 10000
- NMIN = MOD (ITIMX/100, 100)
- NSEC = MOD (ITIMX , 100)
- HOURS = NHOUR + FLOAT(NMIN)/60. + FLOAT(NSEC)/3600.
- XU(2) = HOURS + 24.0 * IDAY
- ELSE
- XU(1) = IQ(IPNT+2) - IMIN
- XU(2) = IQ(IPNT+3) - IMIN
- ENDIF
- IF (XU(2).GT.TMAX) XU(2) = TMAX
- YU(1) = FLOAT(IK)
- YU(2) = YU(1)
- CALL HPLINE (XU, YU, 2, ' ')
- 40 CONTINUE
-*
- 50 IF (LAUXCL(10).NE.0) CALL MZDROP (IDISCD, LAUXCL(10), ' ')
- IF (HEXIST(-101)) CALL HDELET (-101)
- IRC = 0
-#if !defined(CERNLIB_IBM)||!defined(CERNLIB__P3CHILD)
-*
- 2000 FORMAT ('Object Validity Range during ',A,' - ',A)
-#endif
-* END CDPLTI
- 999 END
diff --git a/src/packlib/hepdb/cdplot/cdtimc.F b/src/packlib/hepdb/cdplot/cdtimc.F
deleted file mode 100644
index e7ee0bc..0000000
--- a/src/packlib/hepdb/cdplot/cdtimc.F
+++ /dev/null
@@ -1,70 +0,0 @@
-*
-* $Id: cdtimc.F,v 1.1.1.1 1996/02/28 16:24:23 mclareni Exp $
-*
-* $Log: cdtimc.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:23 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDTIMC (IDATX, ITIMX)
-* ================================
-*
-************************************************************************
-* *
-* SUBR. CDTIMC (*IDATX*, *ITIMX*) *
-* *
-* Checks the date and time for plotting purpose *
-* *
-* Arguments : *
-* *
-* IDATX Date : 6 Decimal integer : YYMMDD *
-* ITIMX Time : 6 Decimal integer : HHMMSS *
-* *
-* Called by CDPLOB, CDPLOV, CDPLTI *
-* *
-************************************************************************
-*
- DIMENSION IDAYM(12)
- DATA IDAYM /31, 28, 31, 30, 31, 30,
- + 31, 31, 30, 31, 30, 31/
-*
-* ------------------------------------------------------------------
-*
- ISEC = MOD (ITIMX, 100)
- IMIN = MOD (ITIMX/100, 100)
- IHOU = MOD (ITIMX/10000, 100)
-*
- IDAY = MOD (IDATX, 100)
- IMON = MOD (IDATX/100, 100)
- IYEA = MOD (IDATX/10000, 100)
-*
- IF (ISEC.GT.59) THEN
- ISEC = 59
- ELSE IF (ISEC.LT.0) THEN
- ISEC = 0
- ENDIF
- IF (IMIN.GT.59) THEN
- IMIN = 59
- ELSE IF (IMIN.LT.0) THEN
- IMIN = 0
- ENDIF
- IF (IHOU.GT.23) THEN
- IHOU = 23
- ELSE IF (IHOU.LT.0) THEN
- IHOU = 0
- ENDIF
- IF (IMON.LT.1) THEN
- IMON = 1
- ELSE IF (IMON.GT.12) THEN
- IMON = 12
- ENDIF
- IF (IDAY.LT.1) THEN
- IDAY = 1
- ELSE IF (IDAY.GT.IDAYM(IMON)) THEN
- IDAY = IDAYM(IMON)
- ENDIF
- IDATX = IYEA*10000 + IMON*100 + IDAY
- ITIMX = IHOU*10000 + IMIN*100 + ISEC
-* END CDTIMC
- END
diff --git a/src/packlib/hepdb/cdplot/cdtimm.F b/src/packlib/hepdb/cdplot/cdtimm.F
deleted file mode 100644
index 532b359..0000000
--- a/src/packlib/hepdb/cdplot/cdtimm.F
+++ /dev/null
@@ -1,60 +0,0 @@
-*
-* $Id: cdtimm.F,v 1.1.1.1 1996/02/28 16:24:23 mclareni Exp $
-*
-* $Log: cdtimm.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:23 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDTIMM (IDATM, IMINS)
-* ================================
-*
-************************************************************************
-* *
-* SUBR. CDTIMM (IDATM, IMINS*) *
-* *
-* Computes number of minutes passed since midnight of January 1,1980 *
-* from the packed date and time (ala CDPKTM) *
-* *
-* Arguments : *
-* *
-* IDATM Packed date-time *
-* IMINS* Number of minutes passed from 00.00 on Jan 1, 1980 *
-* *
-* Called by CDNTPL *
-* *
-************************************************************************
-*
-#include "hepdb/ctmpak.inc"
-* ------------------------------------------------------------------
-*
- III = IDATM
- IMIN = MOD (III, MXMIN)
- III = (III-IMIN)/MXMIN
- IHOU = MOD (III, MXHOU)
- III = (III-IHOU)/MXHOU
- IDAY = MOD (III, MXDAY)
- III = (III-IDAY)/MXDAY
- IMON = MOD (III, MXMON)
- IYEA = (III-IMON)/MXMON - 80
- IF (IYEA.LT.1) THEN
- IADD = 0
- ITYP = 2
- ELSE IF (IYEA.GT.20) THEN
- IADD = IDAYY(20)
- ITYP = 2
- ELSE
- IADD = IDAYY(IYEA)
- ITYP = MOD (IYEA, 4)
- IF (ITYP.EQ.0) THEN
- ITYP = 2
- ELSE
- ITYP = 1
- ENDIF
- ENDIF
-*
- IDAYS = IDAY + IADD + IDAYM(IMON,ITYP)
- IMINS = IMIN + 60*(IHOU + 24*IDAYS)
-* END CDTIMM
- END
diff --git a/src/packlib/hepdb/cdplot/cdtims.F b/src/packlib/hepdb/cdplot/cdtims.F
deleted file mode 100644
index ee15d77..0000000
--- a/src/packlib/hepdb/cdplot/cdtims.F
+++ /dev/null
@@ -1,62 +0,0 @@
-*
-* $Id: cdtims.F,v 1.1.1.1 1996/02/28 16:24:24 mclareni Exp $
-*
-* $Log: cdtims.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:24 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDTIMS (IDATM, ISECS)
-* ================================
-*
-************************************************************************
-* *
-* SUBR. CDTIMS (IDATM, ISECS*) *
-* *
-* Computes number of seconds passed since midnight of January 1,1980 *
-* from the packed date and time (ala CDPKTS) *
-* *
-* Arguments : *
-* *
-* IDATM Packed date-time *
-* IMINS* Number of seconds passed from 00.00 on Jan 1, 1980 *
-* *
-* Called by CDNTPL *
-* *
-************************************************************************
-*
-#include "hepdb/ctmpak.inc"
-* ------------------------------------------------------------------
-*
- III = IDATM
- ISEC = MOD (III, MXSEC)
- III = (III-ISEC)/MXSEC
- IMIN = MOD (III, MXMIN)
- III = (III-IMIN)/MXMIN
- IHOU = MOD (III, MXHOU)
- III = (III-IHOU)/MXHOU
- IDAY = MOD (III, MXDAY)
- III = (III-IDAY)/MXDAY
- IMON = MOD (III, MXMON)
- IYEA = (III-IMON)/MXMON
- IF (IYEA.LT.1) THEN
- IADD = 0
- ITYP = 2
- ELSE IF (IYEA.GT.20) THEN
- IADD = IDAYY(20)
- ITYP = 2
- ELSE
- IADD = IDAYY(IYEA)
- ITYP = MOD (IYEA, 4)
- IF (ITYP.EQ.0) THEN
- ITYP = 2
- ELSE
- ITYP = 1
- ENDIF
- ENDIF
-*
- IDAYS = IDAY + IADD + IDAYM(IMON,ITYP)
- ISECS = ISEC + 60*(IMIN + 60*(IHOU + 24*IDAYS))
-* END CDTIMS
- END
diff --git a/src/packlib/hepdb/cdplot/cdusin.F b/src/packlib/hepdb/cdplot/cdusin.F
deleted file mode 100644
index f2be844..0000000
--- a/src/packlib/hepdb/cdplot/cdusin.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: cdusin.F,v 1.1.1.1 1996/02/28 16:24:24 mclareni Exp $
-*
-* $Log: cdusin.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:24 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDUSIN
-* =================
-*
-************************************************************************
-* *
-* SUBR. CDUSIN *
-* *
-* Default user routine for action needed in between 2 plots *
-* *
-* Called by CDPLOB, CDPLOV *
-* *
-************************************************************************
-*
- IWKST = 1
- CALL IGSA (IWKST)
-* END CDUSIN
- END
diff --git a/src/packlib/hepdb/cdpurge/Imakefile b/src/packlib/hepdb/cdpurge/Imakefile
deleted file mode 100644
index 6937b5a..0000000
--- a/src/packlib/hepdb/cdpurge/Imakefile
+++ /dev/null
@@ -1,7 +0,0 @@
-SRCS_F= cdpurg.F cdpurk.F cdpurp.F cdspur.F
-
-#if !defined(CERNLIB_P3CHILD)
-SRCS_F := $(SRCS_F) cddelk.F
-#endif
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/hepdb/cdpurge/cddelk.F b/src/packlib/hepdb/cdpurge/cddelk.F
deleted file mode 100644
index 409f392..0000000
--- a/src/packlib/hepdb/cdpurge/cddelk.F
+++ /dev/null
@@ -1,77 +0,0 @@
-*
-* $Id: cddelk.F,v 1.1.1.1 1996/02/28 16:24:24 mclareni Exp $
-*
-* $Log: cddelk.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:24 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
-#if !defined(CERNLIB__P3CHILD)
- SUBROUTINE CDDELK (IRC)
-* =======================
-*
-************************************************************************
-* *
-* SUBR. CDDELK (IRC*) *
-* *
-* Deletes objects in a given directory taking care the objects with *
-* IPURCK(n) set to 2 and those on which these objects depend are *
-* preserved *
-* *
-* Arguments : *
-* *
-* IRC Return Code (See below) *
-* *
-* Called by CDPURG, CDPURK *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
-#include "hepdb/ckkeys.inc"
-*
-* ------------------------------------------------------------------
-*
- IRC = 0
-*
-* *** Label by '1' those objects one should not delete
-*
- IF (IOPSCD.NE.0) CALL RZLOCK ('CDDELK')
- IPNT = KOFSCD + LCDRCD + IKDRCD
- ISTP = NWKYCK + 1
- I1 = 1
- NDEL = 0
- 10 IF (I1.LE.NKEYCK) THEN
- NN = NKEYCK - I1 + 1
- II = IUCOMP (2, IPURCK(I1), NN)
- IF (II.GT.0) THEN
- II = II + I1 - 1
- I1 = II + 1
- 15 IP = IPNT + (II - 1) * ISTP
- NO1 = IQ(IP+IDHPTR)
- II = IUCOMP (NO1, KEY1CK, NKEYCK)
- IF (II.GT.0.AND.NO1.NE.0) THEN
- IF (IPURCK(II).NE.2) IPURCK(II) = 1
- GO TO 15
- ENDIF
- GO TO 10
- ENDIF
- ENDIF
-*
- DO 20 IK1 = 1, NKEYCK
- IK = NKEYCK + 1 - IK1
- IF (IPURCK(IK).LE.0) THEN
- CALL CDKEYR (IK, NWKYCK, KEYNCK)
- CALL RZDELK (KEYNCK, ICDUM, 'C')
- NDEL = NDEL + 1
- ENDIF
- 20 CONTINUE
- IF (IOPSCD.NE.0) CALL RZFREE ('CDDELK')
- IQUEST(2) = NDEL
-* END CDDELK
- 999 END
-#endif
diff --git a/src/packlib/hepdb/cdpurge/cdpurg.F b/src/packlib/hepdb/cdpurge/cdpurg.F
deleted file mode 100644
index a1e3706..0000000
--- a/src/packlib/hepdb/cdpurge/cdpurg.F
+++ /dev/null
@@ -1,764 +0,0 @@
-*
-* $Id: cdpurg.F,v 1.1.1.1 1996/02/28 16:24:24 mclareni Exp $
-*
-* $Log: cdpurg.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:24 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
-#if defined(CERNLIB__P3CHILD)
-* Ignoring t=dummy
-#endif
- SUBROUTINE CDPURG (PATHN, KYDAT, KYTIM, CHOPT, IRC)
-* ===================================================
-*
-************************************************************************
-* *
-* SUBR. CDPURG (PATHN, KYDAT, KYTIM, CHOPT, IRC*) *
-* *
-* Purges/Deletes objects in a directory PATHN *
-* *
-* Arguments : *
-* *
-* PATHN Character string describing the pathname *
-* KYDAT Key element number (for option K in CHOPT) or *
-* Minimum value of Key 1 to be deleted (for option S) *
-* KYTIM Cutoff value for the key (for option K) or *
-* Maximum value of Key 1 to be deleted (for option S) *
-* CHOPT Character string with any of the following characters *
-* A Deletes all data objects *
-* B Save in the special backup file; not in standard Journal*
-* K Deletes all data objects for which KEY(KYDAT) .lt. KYTIM*
-* L Deletes all but the last (one with highest KEY(1) value)*
-* data objects *
-* P Deletes all data objects with identical keys (default: *
-* E+V+U keys, see below) but those having the highest *
-* Program Version number (i.e., KEY(6) value). *
-* ** The same may be done for KEY(1) instead of KEY(6) ** *
-* ** if KYDAT=1 !!! ** *
-* Additional options for keys range for identity test: *
-* - default: E+V+U keys ( E means Key8-Key10) *
-* V - val.keys only *
-* VE or E - E+V keys *
-* VX or X - E+V+Key7 (or Key6-Key7 if KYDAT=1) *
-* VU or U - V+U keys *
-* VEU or EU - same as default *
-* VXU or XU - the maximum range *
-* *
-* S Deletes all data objects with Serial number (KEY(1)) in *
-* the range KYDAT-KYTIM (the terminal points included) *
-* IRC Return Code (See below) *
-* *
-* Called by user, CDFZUP *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* =111 : Illegal path name *
-* =112 : No key or data for the path name *
-* *
-* If IRC = 0, IQUEST(2) carries information on number of data *
-* objects deleted in the disk *
-* *
-************************************************************************
-*
-#include "hepdb/caopts.inc"
-#include "hepdb/cdcblk.inc"
-#include "hepdb/clinks.inc"
-#include "hepdb/ckkeys.inc"
-#include "hepdb/hdbkeys.inc"
-#include "hepdb/ctpath.inc"
- CHARACTER PATHN*(*), CHOPT*(*), PATHY*80
- INTEGER KEYS(MXDMCK)
-#include "zebra/q_jbit.inc"
-* Ignoring t=pass
-*
-* ------------------------------------------------------------------
-*
- KEY7 = KEY7CK
- KEY7CK = 0
- NDEL = 0
- CALL CDOPTS (CHOPT, IRC)
- IF (IRC.NE.0) GO TO 999
-*
-* *** Set the current directory
-*
- CALL CDLDUP (PATHN, 0, IRC)
- IF (IRC.NE.0) GO TO 999
- PATHY = PAT1CT
- NCHAR = LENOCC (PATHY)
- CALL CDKEYT
- IOPTP = JBIT (IQ(KOFSCD+LCDRCD+IKDRCD+IDHFLG), JPRTCD)
-*
-* *** Check the number of keys
-*
- IF (NKEYCK.EQ.0) THEN
- IRC = 112
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDPURG : No key '//
- + 'or data for Path Name '//PATHY(1:NCHAR)//''')', IARGCD, 0)
-#endif
- GO TO 999
- ENDIF
-*
-* *** Save the command in the journal file
-*
- CALL VZERO (KEYS, NSYSCK)
- KEYS(IDHKSN) = KYDAT
- KEYS(IDHPTR) = KYTIM
- KEY7CK = KEY7
- CALL CDSPUR (PATHY, NWKYCK, -1, KEYS, 0, IRC)
- KEY7CK = 0
- IF (IRC.NE.0) GO TO 999
- IF (IOPPCD.NE.0) GO TO 999
-#if !defined(CERNLIB__P3CHILD)
-*
- IF (IOPACA.NE.0) THEN
-*
-* *** Delete all keys
-*
- IF (IOPTP.EQ.0) THEN
- IF (KEY7.LE.0) THEN
- IF (IOPSCD.NE.0) CALL RZLOCK ('CDPURG')
- CALL RZDELK (KDUM, ICDUM, 'K')
- IF (IOPSCD.NE.0) CALL RZFREE ('CDPURG')
- NDEL = NKEYCK
- ELSE
- CALL VZERO (IPURCK, NKEYCK)
- IPNT = KOFSCD + LCDRCD + IKDRCD
- ISTP = NWKYCK + 1
- NKEEP = 0
- DO 10 JK = 1, NKEYCK
- IP = IPNT + (JK - 1) * ISTP
- KEY1CK(JK) = IQ(IP+MPSRCD)
- IF (IQ(IP+IDHINS).GT.KEY7) THEN
- IPURCK(JK) = 2
- NKEEP = NKEEP +1
- ENDIF
- 10 CONTINUE
- IF (NKEEP.GT.0) THEN
- CALL CDDELK (IRC)
- NDEL = IQUEST(2)
- ELSE
- IF (IOPSCD.NE.0) CALL RZLOCK ('CDPURG')
- CALL RZDELK (KDUM, ICDUM, 'K')
- IF (IOPSCD.NE.0) CALL RZFREE ('CDPURG')
- NDEL = NKEYCK
- ENDIF
- ENDIF
- ELSE
- NKEYS = NKEYCK
- DO 20 IK = 1, NKEYS
- CALL CDPATH (TOP1CT, IK)
- PAT2CT = PATHY(1:NCHAR)//'/'//TOP1CT
- CALL RZCDIR (PAT2CT, ' ')
- IF (IQUEST(1).NE.0) THEN
- IRC = 111
-#endif
-#if (defined(CERNLIB__DEBUG))&&(!defined(CERNLIB__P3CHILD))
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDPURG : '//
- + 'Illegal Path Name '//PAT2CT//''')', IARGCD, 0)
-#endif
-#if !defined(CERNLIB__P3CHILD)
- GO TO 999
- ENDIF
- NKEYCK = IQUEST(7)
- IF (NKEYCK.GT.0) THEN
- IF (KEY7.LE.0) THEN
- IF (IOPSCD.NE.0) CALL RZLOCK ('CDPURG')
- CALL RZDELK (KDUM, ICDUM, 'K')
- IF (IOPSCD.NE.0) CALL RZFREE ('CDPURG')
- NDEL = NDEL + NKEYCK
- ELSE
- NWKYCK = IQUEST(8)
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- IPNT = KOFSCD + LCDRCD + IKDRCD
- ISTP = NWKYCK + 1
- CALL VZERO (IPURCK, NKEYCK)
- NKEEP = 0
- DO 15 JK = 1, NKEYCK
- IP = IPNT + (JK - 1) * ISTP
- KEY1CK(JK) = IQ(IP+MPSRCD)
- IF (IQ(IP+IDHINS).GT.KEY7) THEN
- IPURCK(JK) = 2
- NKEEP = NKEEP +1
- ENDIF
- 15 CONTINUE
- IF (NKEEP.GT.0) THEN
- CALL CDDELK (IRC)
- NDEL = NDEL + IQUEST(2)
- ELSE
- IF (IOPSCD.NE.0) CALL RZLOCK ('CDPURG')
- CALL RZDELK (KDUM, ICDUM, 'K')
- IF (IOPSCD.NE.0) CALL RZFREE ('CDPURG')
- NDEL = NDEL + NKEYCK
- ENDIF
- ENDIF
- ENDIF
- 20 CONTINUE
- ENDIF
-*
- ELSE IF (IOPLCA.NE.0) THEN
-*
-* *** Delete all but last keys (except those another key may depend
-* ** on) Highest number of KEY(1)
-*
- IF (IOPTP.EQ.0) THEN
- CALL VZERO (IPURCK, NKEYCK)
- NO1 = 0
- IPNT = KOFSCD + LCDRCD + IKDRCD
- ISTP = NWKYCK + 1
- DO 25 IK = 1, NKEYCK
- IP = IPNT + (IK - 1) * ISTP
- KEY1CK(IK) = IQ(IP+IDHKSN)
- IF (KEY7.LE.0) THEN
- IF (KEY1CK(IK).GT.NO1) NO1 = KEY1CK(IK)
- ELSE
- IF (IQ(IP+IDHINS).GT.KEY7) THEN
- IPURCK(IK) = 2
- ELSE
- IF (KEY1CK(IK).GT.NO1) NO1 = KEY1CK(IK)
- ENDIF
- ENDIF
- 25 CONTINUE
-*
- II = IUCOMP (NO1, KEY1CK, NKEYCK)
- IF (II.GT.0) IPURCK(II) = 2
- CALL CDDELK (IRC)
- NDEL = IQUEST(2)
-*
- ELSE
-*
- NKEYS = NKEYCK
- IFLG = 0
- DO 35 JK1 = 1, NKEYS
- JK = NKEYS + 1 - JK1
- CALL CDPATH (TOP1CT, JK)
- PAT2CT = PATHY(1:NCHAR)//'/'//TOP1CT
- CALL RZCDIR (PAT2CT, ' ')
- IF (IQUEST(1).NE.0) THEN
- IRC = 111
-#endif
-#if (defined(CERNLIB__DEBUG))&&(!defined(CERNLIB__P3CHILD))
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDPURG : '//
- + 'Illegal Path Name '//PAT2CT//''')', IARGCD, 0)
-#endif
-#if !defined(CERNLIB__P3CHILD)
- GO TO 999
- ENDIF
- NKEYCK = IQUEST(7)
- IF (NKEYCK.GT.0.AND.IFLG.EQ.0) THEN
- NWKYCK = IQUEST(8)
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- IPNT = KOFSCD + LCDRCD + IKDRCD
- ISTP = NWKYCK + 1
-*
- CALL VZERO (IPURCK, NKEYCK)
- NO1 = 0
- DO 30 IK = 1, NKEYCK
- IP = IPNT + (IK - 1) * ISTP
- KEY1CK(IK) = IQ(IP+IDHKSN)
- IF (KEY7.LE.0) THEN
- IF (KEY1CK(IK).GT.NO1) NO1 = KEY1CK(IK)
- ELSE
- IF (IQ(IP+IDHINS).GT.KEY7) THEN
- IPURCK(IK) = 2
- ELSE
- IF (KEY1CK(IK).GT.NO1) NO1 = KEY1CK(IK)
- ENDIF
- ENDIF
- 30 CONTINUE
-*
- II = IUCOMP (NO1, KEY1CK, NKEYCK)
- IF (II.GT.0) THEN
- IPURCK(II) = 2
- IFLG = 1
- ENDIF
- CALL CDDELK (IRC)
- NDEL = NDEL + IQUEST(2)
-*
- ELSE IF (NKEYCK.GT.0) THEN
-*
-* * Delete all keys in the remaining subdirectories
-*
- IF (IOPSCD.NE.0) CALL RZLOCK ('CDPURG')
- CALL RZDELK (KDUM, ICDUM, 'K')
- IF (IOPSCD.NE.0) CALL RZFREE ('CDPURG')
- NDEL = NDEL + NKEYCK
-*
- ENDIF
- 35 CONTINUE
- ENDIF
-*
- ELSE IF (IOPPCA.NE.0) THEN
-*
-* *** Delete all objects with identical start and end validity but
-* *** those having the highest program version #, i.e. the highest
-* *** KEY(6)
-*
-* +++ a) Additional variant: If KYDAT=1,
-* +++ then Key1 will be looked instead of Key6 ! (BKh)
-* +++ b) Variable keys range for identity test with options V,E,U,
-* +++ which may be added to "P" (BKh)
-*
- NKLAST=IDHUSI
- IF(KYDAT.EQ.1) NKLAST=KYDAT
-*
-* - select K-s for identity test with IOKYCA
-*
- N1=KOFEX1
- N2=NWKYCK
- IF(IOPXCA.NE.0) IOPECA=1
- IF(IOPVCA.NE.0) THEN
- N1=KOFVAL
- N2=NSYSCK
- IF(IOPECA.NE.0) N1=KOFEX1
- IF(IOPUCA.NE.0) N2=NWKYCK
- ELSE IF(IOPECA*IOPUCA.EQ.0) THEN
- IF(IOPECA.NE.0) N2=NSYSCK
- IF(IOPUCA.NE.0) N1=KOFVAL
- ENDIF
- IF(IOPXCA.NE.0) N1=MAX0(KOFUSI,NKLAST+1)
-*
- CALL VZERO (IOKYCA,NWKYCK)
- DO IK=N1,N2
- IOKYCA(IK)=1
- ENDDO
-*
- IF (IOPTP.EQ.0) THEN
- CALL VZERO (IPURCK, NKEYCK)
-*
-* ** Label by '2' the object of the highest program version #
-*
- DO 50 IK = 1, NKEYCK
- IPURCK(IK) = 2
- CALL CDKEYR (IK, NWKYCK, KEYVCK)
- KEY1CK(IK) = KEYVCK(IDHKSN)
- IF (KEY7.GT.0) THEN
- IF (KEYVCK(IDHINS).GT.KEY7) GO TO 50
- ENDIF
- DO 45 JK = 1, NKEYCK
- IF (IK.EQ.JK.OR.IPURCK(JK).EQ.-1) GO TO 45
- CALL CDKEYR (JK, NWKYCK, KEYNCK)
- DO 40 K = 1, NWKYCK
- IF (IOKYCA(K).NE.0.AND.KEYNCK(K).NE.KEYVCK(K))
- + GO TO 45
- 40 CONTINUE
- IF (KEYNCK(NKLAST).GT.KEYVCK(NKLAST)) THEN
- IPURCK(IK) = -1
- GO TO 50
- ENDIF
- 45 CONTINUE
- 50 CONTINUE
- CALL CDDELK (IRC)
- NDEL = IQUEST(2)
-*
- ELSE
-*
- NKEYS = NKEYCK
- DO 70 JK2 = 1, NKEYS
- JK1 = NKEYS + 1 - JK2
- CALL CDPATH (TOP1CT, JK1)
- PAT2CT = PATHY(1:NCHAR)//'/'//TOP1CT
- CALL RZCDIR (PAT2CT, ' ')
- IF (IQUEST(1).NE.0) THEN
- IRC = 111
-#endif
-#if (defined(CERNLIB__DEBUG))&&(!defined(CERNLIB__P3CHILD))
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDPURG : '//
- + 'Illegal Path Name '//PAT2CT//''')', IARGCD, 0)
-#endif
-#if !defined(CERNLIB__P3CHILD)
- GO TO 999
- ENDIF
- NKEYCK = IQUEST(7)
- IF (NKEYCK.LE.0) GO TO 70
- NWKYCK = IQUEST(8)
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
-*
- CALL VZERO (IPURCK, NKEYCK)
-*
-* ** Label by '2' the object of the highest program version #
-*
- DO 65 IK = 1, NKEYCK
- IPURCK(IK) = 2
- CALL CDKEYR (IK, NWKYCK, KEYVCK)
- KEY1CK(IK) = KEYVCK(IDHKSN)
- IF (KEY7.GT.0) THEN
- IF (KEYVCK(IDHINS).GT.KEY7) GO TO 65
- ENDIF
- DO 60 JK = 1, NKEYCK
- IF (IK.EQ.JK.OR.IPURCK(JK).EQ.-1) GO TO 60
- CALL CDKEYR (JK, NWKYCK, KEYNCK)
- DO 55 K = 1, NWKYCK
- IF (IOKYCA(K).NE.0.AND.KEYNCK(K).NE.KEYVCK(K))
- + GO TO 60
- 55 CONTINUE
- IF (KEYNCK(NKLAST).GT.KEYVCK(NKLAST)) THEN
- IPURCK(IK) = -1
- GO TO 65
- ENDIF
- 60 CONTINUE
- 65 CONTINUE
- CALL CDDELK (IRC)
- NDEL = NDEL + IQUEST(2)
- 70 CONTINUE
-*
-* * Now delete in one subdirectory from results of other
-*
-C\\\ JK2 = NKEYS + 1
-C\\\ 75 IF (JK2.GT.2) THEN
-C\\\ JK2 = JK2 - 1
-*
-* - master directories loop
-*
- DO 118 JK2=NKEYS,1,-1
- CALL CDPATH (TOP1CT, JK2)
- PAT3CT = PATHY(1:NCHAR)//'/'//TOP1CT
- CALL RZCDIR (PAT3CT, ' ')
- IF (IQUEST(1).NE.0) THEN
- IRC = 111
-#endif
-#if (defined(CERNLIB__DEBUG))&&(!defined(CERNLIB__P3CHILD))
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDPURG : '//
- + 'Illegal Path Name '//PAT3CT//''')', IARGCD, 0)
-#endif
-#if !defined(CERNLIB__P3CHILD)
- GO TO 999
- ENDIF
- NKEY2 = IQUEST(7)
- IF (NKEY2.EQ.0) GO TO 118
- NWKYCK = IQUEST(8)
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
-*
-* * Get the master object names in the master subdirectory
-*
- CALL VZERO (INDKCK, NKEY2)
- DO 90 IK = 1, NKEY2
- INDKCK(IK) = 2
-C\\\ CALL CDKEYR (IK, NWKYCK, KEYVCK)
-C\\\ IF (KEY7.GT.0) THEN
-C\\\ IF (KEYVCK(IDHINS).GT.KEY7) GO TO 90
-C\\\ ENDIF
-C\\\ DO 85 JK = 1, NKEY2
-C\\\ IF (IK.EQ.JK.OR.INDKCK(JK).EQ.1) GO TO 85
-C\\\ CALL CDKEYR (JK, NWKYCK, KEYNCK)
-C\\\ DO 80 K = 1, NWKYCK
-C\\\ IF (IOKYCA(K).NE.0.AND.KEYVCK(K).NE.KEYNCK(K))
-C\\\ + GO TO 85
-C\\\ 80 CONTINUE
-C\\\ IF (KEYNCK(NKLAST).GT.KEYVCK(NKLAST)) THEN
-C\\\ INDKCK(IK) = 1
-C\\\ GO TO 90
-C\\\ ENDIF
-C\\\ 85 CONTINUE
- 90 CONTINUE
-C\\\ II = IUCOMP (2, INDKCK, NKEY2)
-C\\\ IF (II.EQ.0) GO TO 75
-C\\\\ I1 = 1
-*
-* * Loop over slave subdirectories
-*
- DO 115 JK3 = 1, JK2-1
- JK1 = JK2 - JK3
- CALL CDPATH (TOP1CT, JK1)
- PAT2CT = PATHY(1:NCHAR)//'/'//TOP1CT
-*
- CALL RZCDIR (PAT2CT, ' ')
- IF (IQUEST(1).NE.0) THEN
- IRC = 111
-#endif
-#if (defined(CERNLIB__DEBUG))&&(!defined(CERNLIB__P3CHILD))
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDPURG :'//
- + ' Illegal Path Name '//PAT2CT//''')', IARGCD, 0)
-#endif
-#if !defined(CERNLIB__P3CHILD)
- GO TO 999
- ENDIF
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- NKEYCK = IQUEST(7)
- IF (NKEYCK.EQ.0) GO TO 115
-*
- DO 95 IK = 1, NKEYCK
- IPURCK(IK) = 2
- 95 CONTINUE
-*
-* - loop over objects in the master directory
- DO 112 II=1,NKEY2
- IF(INDKCK(II).EQ.2) THEN
- CALL RZCDIR (PAT3CT, ' ')
- IF (IQUEST(1).NE.0) THEN
- IRC = 111
-#endif
-#if (defined(CERNLIB__DEBUG))&&(!defined(CERNLIB__P3CHILD))
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' DBPU'//
- + 'RG : Illegal Path Name '//PAT3CT//''')', IARGCD, 0)
-#endif
-#if !defined(CERNLIB__P3CHILD)
- GO TO 999
- ENDIF
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- CALL CDKEYR (II, NWKYCK, KEYVCK)
- IF (KEY7.GT.0) THEN
- IF (KEYVCK(IDHINS).GT.KEY7) GO TO 112
- ENDIF
-*
- CALL RZCDIR (PAT2CT, ' ')
- IF (IQUEST(1).NE.0) THEN
- IRC = 111
-#endif
-#if (defined(CERNLIB__DEBUG))&&(!defined(CERNLIB__P3CHILD))
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' DBPU'//
- + 'RG : Illegal Path Name '//PAT2CT//''')', IARGCD, 0)
-#endif
-#if !defined(CERNLIB__P3CHILD)
- GO TO 999
- ENDIF
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
-*
-* * Check all key elements in the slave subdirectory
-*
- DO 110 IK = 1, NKEYCK
- CALL CDKEYR (IK, NWKYCK, KEYNCK)
- KEY1CK(IK) = KEYNCK(IDHKSN)
- IF (KEY7.GT.0) THEN
- IF (KEYNCK(IDHINS).GT.KEY7) GO TO 110
- ENDIF
- DO 105 K = 1, NWKYCK
- IF (IOKYCA(K).NE.0.AND.KEYVCK(K).NE.KEYNCK(K))
- + GO TO 110
- 105 CONTINUE
- IF (KEYNCK(NKLAST).LE.KEYVCK(NKLAST)) THEN
- IPURCK(IK) = 0
- ELSE
- INDKCK(II) = 0
- ENDIF
-*
- 110 CONTINUE
- ENDIF
-* v-- end of loop over objects in the master directory
- 112 CONTINUE
-* - delete flagged objects in the slave directory
- CALL CDDELK (IRC)
- NDEL = NDEL + IQUEST(2)
-*
-* v-- end of loop over slave subdirectories
- 115 CONTINUE
-* - delete flagged objects in the master directory
- NKEYCK=NKEY2
- CALL UCOPY(INDKCK,IPURCK,NKEYCK)
- CALL RZCDIR (PAT3CT, ' ')
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- CALL CDDELK (IRC)
- NDEL = NDEL + IQUEST(2)
-C\\\ GO TO 75
-C\\\ ENDIF
- 118 CONTINUE
-*
- ENDIF
-*
- ELSE IF (IOPKCA.NE.0) THEN
-*
-* ** Delete all keys for which KEY(KYDAT).le.KYTIM
-*
- IF (IOPTP.EQ.0) THEN
-*
- CALL VZERO (IPURCK, NKEYCK)
-*
-* ** Label by '2' the objects for which KEY(KYDAT).le.KYTIM
-*
- DO 120 IK = 1, NKEYCK
- CALL CDKEYR (IK, NWKYCK, KEYNCK)
- KEY1CK(IK) = KEYNCK(IDHKSN)
- IF (KEY7.LE.0) THEN
- IF (KEYNCK(KYDAT).GE.KYTIM) IPURCK(IK) = 2
- ELSE
- IF (KEYNCK(IDHINS).GT.KEY7) THEN
- IPURCK(IK) = 2
- ELSE
- IF (KEYNCK(KYDAT).GE.KYTIM) IPURCK(IK) = 2
- ENDIF
- ENDIF
- 120 CONTINUE
- CALL CDDELK (IRC)
- NDEL = IQUEST(2)
-*
- ELSE
-*
- NKEYS = NKEYCK
- DO 130 JK1 = 1, NKEYS
- JK = NKEYS + 1 - JK1
- CALL CDPATH (TOP1CT, JK)
- PAT2CT = PATHY(1:NCHAR)//'/'//TOP1CT
- CALL RZCDIR (PAT2CT, ' ')
- IF (IQUEST(1).NE.0) THEN
- IRC = 111
-#endif
-#if (defined(CERNLIB__DEBUG))&&(!defined(CERNLIB__P3CHILD))
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDPURG : '//
- + 'Illegal Path Name '//PAT2CT//''')', IARGCD, 0)
-#endif
-#if !defined(CERNLIB__P3CHILD)
- GO TO 999
- ENDIF
- NKEYCK = IQUEST(7)
- IF (NKEYCK.LE.0) GO TO 130
- NWKYCK = IQUEST(8)
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- CALL CDKEYT
-*
- CALL VZERO (IPURCK, NKEYCK)
-*
-* ** Label by '2' the object for which KEY(KYDAT).le.KYTIM
-*
- DO 125 IK = 1, NKEYCK
- CALL CDKEYR (IK, NWKYCK, KEYNCK)
- KEY1CK(IK) = KEYNCK(IDHKSN)
- IF (KEY7.LE.0) THEN
- IF (KEYNCK(KYDAT).GE.KYTIM) IPURCK(IK) = 2
- ELSE
- IF (KEYNCK(IDHINS).GT.KEY7) THEN
- IPURCK(IK) = 2
- ELSE
- IF (KEYNCK(KYDAT).GE.KYTIM) IPURCK(IK) = 2
- ENDIF
- ENDIF
- 125 CONTINUE
- CALL CDDELK (IRC)
- NDEL = NDEL + IQUEST(2)
- 130 CONTINUE
-*
- ENDIF
-*
- ELSE IF (IOPSCA.NE.0) THEN
-*
-* ** Delete all keys for with KEY(IDHKSN) in the range KYDAT-KYTIM
-*
- IF (IOPTP.EQ.0) THEN
-*
- IPNT = KOFSCD + LCDRCD + IKDRCD
- ISTP = NWKYCK + 1
-*
-* ** Label by '2' objects for which KEY(1) not in range KYDAT-KYTIM
-*
- DO 140 IK = 1, NKEYCK
- KEY1CK(IK) = IQ(IPNT+(IK-1)*ISTP+IDHKSN)
- IF (KEY7.LE.0) THEN
- IF (KEY1CK(IK).GE.KYDAT.AND.KEY1CK(IK).LE.KYTIM) THEN
- IPURCK(IK) = 0
- ELSE
- IPURCK(IK) = 2
- ENDIF
- ELSE
- IF (IQ(IPNT+(IK-1)*ISTP+IDHINS).GT.KEY7) THEN
- IPURCK(IK) = 2
- ELSE
- IF (KEY1CK(IK).GE.KYDAT.AND.KEY1CK(IK).LE.KYTIM) THEN
- IPURCK(IK) = 0
- ELSE
- IPURCK(IK) = 2
- ENDIF
- ENDIF
- ENDIF
- 140 CONTINUE
- CALL CDDELK (IRC)
- NDEL = IQUEST(2)
-*
- ELSE
-*
- NKEYS = NKEYCK
- KST = NWKYCK + 1
- MAXKY = -1
- DO 160 JK1 = 1, NKEYS
- JK = NKEYS + 1 - JK1
- IPNT = KOFSCD + LCDRCD + IKDRCD
- KPNT = IUHUNT (JK, IQ(IPNT+MPSRCD), NKEYS*KST, KST)
- IF (KPNT.GT.0) THEN
- KPNT = KPNT + IPNT - MPSRCD
- ELSE
- KPNT = IPNT + (JK - 1) * KST
- ENDIF
- MINKY = IQ(KPNT+MOBJCD) + 1
- IF (KYTIM.LT.MINKY) GO TO 155
- IF (MAXKY.GT.0.AND.KYDAT.GT.MAXKY) GO TO 155
- CALL CDPATH (TOP1CT, JK)
- PAT2CT = PATHY(1:NCHAR)//'/'//TOP1CT
- CALL RZCDIR (PAT2CT, ' ')
- IF (IQUEST(1).NE.0) THEN
- IRC = 111
-#endif
-#if (defined(CERNLIB__DEBUG))&&(!defined(CERNLIB__P3CHILD))
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDPURG : '//
- + 'Illegal Path Name '//PAT2CT//''')', IARGCD, 0)
-#endif
-#if !defined(CERNLIB__P3CHILD)
- GO TO 999
- ENDIF
- NKEYCK = IQUEST(7)
- IF (NKEYCK.LE.0) GO TO 150
- NWKYCK = IQUEST(8)
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- CALL CDKEYT
- IPNT = KOFSCD + LCDRCD + IKDRCD
- ISTP = NWKYCK + 1
-*
-* ** Label by '2' objects with KEY(1) not in range KYDAT-KYTIM
-*
- DO 145 IK = 1, NKEYCK
- KEY1CK(IK) = IQ(IPNT+(IK-1)*ISTP+IDHKSN)
- IF (KEY7.LE.0) THEN
- IF (KEY1CK(IK).GE.KYDAT.AND.KEY1CK(IK).LE.KYTIM) THEN
- IPURCK(IK) = 0
- ELSE
- IPURCK(IK) = 2
- ENDIF
- ELSE
- IF (IQ(IPNT+(IK-1)*ISTP+IDHINS).GT.KEY7) THEN
- IPURCK(IK) = 2
- ELSE
- IF (KEY1CK(IK).GE.KYDAT.AND.KEY1CK(IK).LE.KYTIM) THEN
- IPURCK(IK) = 0
- ELSE
- IPURCK(IK) = 2
- ENDIF
- ENDIF
- ENDIF
- 145 CONTINUE
- CALL CDDELK (IRC)
- NDEL = NDEL + IQUEST(2)
-*
- 150 CALL RZCDIR (PATHY, ' ')
- IF (IQUEST(1).NE.0) THEN
- IRC = 111
-#endif
-#if (defined(CERNLIB__DEBUG))&&(!defined(CERNLIB__P3CHILD))
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDPURG : '//
- + 'Illegal Path Name '//PATHY//''')', IARGCD, 0)
-#endif
-#if !defined(CERNLIB__P3CHILD)
- GO TO 999
- ENDIF
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- 155 MAXKY = MINKY - 1
- 160 CONTINUE
-*
- ENDIF
-*
- ENDIF
-#endif
-*
- IQUEST(2) = NDEL
-* END CDPURG
- 999 END
diff --git a/src/packlib/hepdb/cdpurge/cdpurk.F b/src/packlib/hepdb/cdpurge/cdpurk.F
deleted file mode 100644
index 6187445..0000000
--- a/src/packlib/hepdb/cdpurge/cdpurk.F
+++ /dev/null
@@ -1,308 +0,0 @@
-*
-* $Id: cdpurk.F,v 1.1.1.1 1996/02/28 16:24:24 mclareni Exp $
-*
-* $Log: cdpurk.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:24 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
-#if defined(CERNLIB__P3CHILD)
-* Ignoring t=dummy
-#endif
- SUBROUTINE CDPURK (PATHN, ITIME, MASK, KEYI, CHOPT, IRC)
-* ========================================================
-*
-************************************************************************
-* *
-* SUBR. CDPURK (PATHN, ITIME, MASK, KEYI, CHOPT, IRC*) *
-* *
-* Deletes objects in a directory path name steered by a selection *
-* on a number of key elements *
-* *
-* Arguments : *
-* *
-* PATHN Character string describing the pathname *
-* ITIME Time of validity of the object *
-* MASK Integer vector indicating which elements of KEYS are *
-* significant for selection. If MASK corresponding to *
-* one of the fields of 'Beginning' validity range is set, *
-* it will select objects with start validity smaller than *
-* those requested in KEYS. If MASK corresponding to one *
-* of the fields of 'End' validity range is set, it will *
-* select objects with end validity larger than those in *
-* KEYS. If MASK corresponding to time of insertion is set,*
-* objects inserted earlier than KEYS(IDHINS) are selected *
-* KEYI Vector of keys. Only the elements declared in CHOPT are *
-* assumed to contain useful information. *
-* CHOPT Character string with any of the following characters *
-* B Save in the special backup file; not in standard Journal*
-* F Require a full match of the entire KEYI vector; MASK *
-* is ignored *
-* K Delete object with key serial number as given in KEYI; *
-* MASK is ignored *
-* S expect multiple Key banks satisfying selection on a *
-* number of keys (not compatible with options F or K) *
-* IRC Return Code (See below) *
-* *
-* Called by user, CDFZUP *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* =111 : Illegal path name *
-* =112 : No key for the path name satisfying the Key *
-* assignments *
-* =113 : Illegal character option *
-* =114 : Valid data objects in the Node/Key structure *
-* *
-* If IRC = 0, IQUEST(2) carries information on number of data *
-* objects deleted in the disk *
-* *
-************************************************************************
-*
-#include "hepdb/caopts.inc"
-#include "hepdb/cdcblk.inc"
-#include "hepdb/ckkeys.inc"
-#include "hepdb/ctpath.inc"
- DIMENSION ITIME(9), KEYI(9), MASK(9), KEYS(MXDMCK)
- CHARACTER CHOPT*(*), PATHN*(*), PATHY*255
-#include "zebra/q_jbit.inc"
-* Ignoring t=pass
-*
-* ------------------------------------------------------------------
-*
-* *** Initialize options
-*
- KEY7 = KEY7CK
- KEY7O = 0
- KEY7CK = 0
- NDEL = 0
- CALL CDOPTS (CHOPT, IRC)
- IF (IRC.NE.0) GO TO 999
- IF (IOPMCA.NE.0) THEN
- IRC = 113
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDPURK : Illegal'//
- + ' Character option '')', IARGCD, 0)
-#endif
- GO TO 999
- ENDIF
- CALL UCOPY (MASK, IOKYCA, MXDMCK)
-*
-* *** Set the current directory
-*
- CALL CDLDUP (PATHN, 0, IRC)
- IF (IRC.NE.0) GO TO 999
- PATHY = PAT1CT
- NCHAR = LENOCC (PATHY)
- IF (NKEYCK.LE.0) THEN
- IRC = 112
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDPURK : No vali'//
- + 'd object for Path Name '//PATHY//''')', IARGCD, 0)
-#endif
- GO TO 999
- ENDIF
-*
-* *** Overwrite MASK option for certain CHOPT
-*
- IF (IOPKCA.NE.0) THEN
- CALL VZERO (IOKYCA, NWKYCK)
- IOKYCA(IDHKSN) = 1
- IOPSCA = 0
- ELSE IF (IOPFCA.NE.0) THEN
- DO 5 I = 1, NWKYCK
- IF (I.EQ.IDHKSN.OR.I.EQ.IDHPTR.OR.
- + (I.GT.NOF1CK.AND.I.LE.(NOF1CK+2*NPARCD))) THEN
- IOKYCA(I) = 0
- ELSE
- IOKYCA(I) = 1
- ENDIF
- 5 CONTINUE
- IOPSCA = 0
- ELSE
- IOKYCA(IDHKSN) = 0
- ENDIF
-*
-* *** Save the command in the journal file
-*
- CALL CDKEYT
- IOPTP = JBIT (IQ(KOFSCD+LCDRCD+IKDRCD+IDHFLG), JPRTCD)
- CALL UCOPY (KEYI, KEYS, NWKYCK)
- KEY7CK = KEY7
- CALL CDSPUR (PATHY, NWKYCK, ITIME, KEYS, 1, IRC)
- KEY7CK = 0
- IF (IRC.NE.0) GO TO 999
- IF (IOPPCD.NE.0) GO TO 999
-#if !defined(CERNLIB__P3CHILD)
-*
-* *** Prepare the Key banks in memory
-*
- CALL CDNODE (PATHY, IRC)
- IF (IRC.NE.0) GO TO 999
- IF (LQ(KOFUCD+LBNOCD-KLKYCD).NE.0) THEN
- IRC = 114
-#endif
-#if (defined(CERNLIB__DEBUG))&&(!defined(CERNLIB__P3CHILD))
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDPURK : Valid '//
- + 'KYCD exists for Path Name '//PATHY//''')', IARGCD, 0)
-#endif
-#if !defined(CERNLIB__P3CHILD)
- GO TO 999
- ENDIF
-*
- IF (KEY7.GT.0) THEN
- IF (IOKYCA(IDHINS).NE.0) THEN
- KEYS(IDHINS) = MIN0 (KEYS(IDHINS), KEY7)
- ELSE
- KEYS(IDHINS) = KEY7
- IOKYCA(IDHINS) = 1
- ENDIF
- ENDIF
- CALL CDKEYB (KEYS, LBDACD, ITIME, IRC)
- IF (IRC.NE.0) GO TO 999
- IF (LQ(KOFUCD+LBNOCD-KLKYCD).LE.0) THEN
- IRC = 112
-#endif
-#if (defined(CERNLIB__DEBUG))&&(!defined(CERNLIB__P3CHILD))
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDPURK : No vali'//
- + 'd object for Path Name '//PATHY//''')', IARGCD, 0)
-#endif
-#if !defined(CERNLIB__P3CHILD)
- GO TO 999
- ENDIF
- LBKYCD = LQ(KOFUCD+LBNOCD-KLKYCD)
- ITEMP = IOPKCA
- IOPKCA = 1
- 10 IF (IOPSCA.EQ.0 .AND. LBKYCD.GT.0) THEN
- DO 15 I = 1, NWKYCK
- IF (IOKYCA(I).NE.0) THEN
- IF (I.EQ.IDHKSN.OR.I.EQ.IDHINS.OR.
- + (I.GT.NOF1CK.AND.I.LE.(NOF1CK+2*NPARCD))) THEN
- KEYVCK(I) = KEYS(I)
- ELSE
- KEYVCK(I) = IQ(KOFUCD+LBKYCD+I)
- ENDIF
- ELSE
- KEYVCK(I) = 0
- ENDIF
- 15 CONTINUE
- CALL CDKXIN (ITIME, IDIVCD, LBDACD, LBKYCD, -1, NWKYCK, KEYVCK,
- + IPREC, IRC)
- IF (IRC.NE.0) GO TO 100
- CALL UCOPY (KEYVCK(1), IQ(KOFUCD+LBKYCD+1), NWKYCK)
- LBKYCD = LQ(KOFUCD+LBKYCD)
- GO TO 10
- ENDIF
- IOPKCA = ITEMP
-*
-* *** Now mark the objects which are in the Key banks to be deleted
-*
- IF (IOPTP.EQ.0) THEN
-*
- IPNT = KOFSCD + LCDRCD + IKDRCD
- ISTP = NWKYCK + 1
- DO 20 IK = 1, NKEYCK
- KEY1CK(IK) = IQ(IPNT+(IK-1)*ISTP+IDHKSN)
- IPURCK(IK) = 2
- 20 CONTINUE
- LBKYCD = LQ(KOFUCD+LBNOCD-KLKYCD)
- 25 IF (LBKYCD.GT.0) THEN
- II = IUCOMP (IQ(KOFUCD+LBKYCD+IDHKSN), KEY1CK, NKEYCK)
- IF (II.GT.0) IPURCK(II) = 0
- LBKYCD = LQ(KOFUCD+LBKYCD)
- GO TO 25
- ENDIF
- CALL CDDELK (IRC)
- NDEL = IQUEST(2)
-*
- ELSE
-*
- NKEYS = NKEYCK
- KST = NWKYCK + 1
- MAXKY = -1
- LBKYCD = LQ(KOFUCD+LBNOCD-KLKYCD)
- MINK = IQ(KOFUCD+LBKYCD+IDHKSN)
- MAXK = IQ(KOFUCD+LBKYCD+IDHKSN)
- 30 LBKYCD = LQ(KOFUCD+LBKYCD)
- IF (LBKYCD.GT.0) THEN
- MINK = MIN0 (MINK, IQ(KOFUCD+LBKYCD+IDHKSN))
- MAXK = MAX0 (MAXK, IQ(KOFUCD+LBKYCD+IDHKSN))
- GO TO 30
- ENDIF
-*
- DO 55 JK1 = 1, NKEYS
- JK = NKEYS + 1 - JK1
- IPNT = KOFSCD + LCDRCD + IKDRCD
- KPNT = IUHUNT (JK, IQ(IPNT+MPSRCD), NKEYS*KST, KST)
- IF (KPNT.GT.0) THEN
- KPNT = KPNT + IPNT - MPSRCD
- ELSE
- KPNT = IPNT + (JK - 1) * KST
- ENDIF
- MINKY = IQ(KPNT+MOBJCD) + 1
- IF (MAXK.LT.MINKY) GO TO 50
- IF (MAXKY.GT.0.AND.MINK.GT.MAXKY) GO TO 50
- CALL CDPATH (TOP1CT, JK)
- PAT2CT = PATHY(1:NCHAR)//'/'//TOP1CT
- CALL RZCDIR (PAT2CT, ' ')
- IF (IQUEST(1).NE.0) THEN
- IRC = 111
-#endif
-#if (defined(CERNLIB__DEBUG))&&(!defined(CERNLIB__P3CHILD))
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDPURK : Ill'//
- + 'egal Path Name '//PAT2CT//''')', IARGCD, 0)
-#endif
-#if !defined(CERNLIB__P3CHILD)
- GO TO 100
- ENDIF
- NKEYCK = IQUEST(7)
- IF (NKEYCK.LE.0) GO TO 45
- NWKYCK = IQUEST(8)
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- IPNT = KOFSCD + LCDRCD + IKDRCD
- ISTP = NWKYCK + 1
-*
- DO 35 IK = 1, NKEYCK
- KEY1CK(IK) = IQ(IPNT+(IK-1)*ISTP+IDHKSN)
- IPURCK(IK) = 2
- 35 CONTINUE
- LBKYCD = LQ(KOFUCD+LBNOCD-KLKYCD)
- 40 IF (LBKYCD.GT.0) THEN
- II = IUCOMP (IQ(KOFUCD+LBKYCD+IDHKSN), KEY1CK, NKEYCK)
- IF (II.GT.0) IPURCK(II) = 0
- LBKYCD = LQ(KOFUCD+LBKYCD)
- GO TO 40
- ENDIF
- CALL CDDELK (IRC)
- NDEL = NDEL + IQUEST(2)
-*
- 45 CALL RZCDIR (PATHY, ' ')
- IF (IQUEST(1).NE.0) THEN
- IRC = 111
-#endif
-#if (defined(CERNLIB__DEBUG))&&(!defined(CERNLIB__P3CHILD))
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDPURK : Ill'//
- + 'egal Path Name '//PATHY//''')', IARGCD, 0)
-#endif
-#if !defined(CERNLIB__P3CHILD)
- GO TO 100
- ENDIF
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- 50 MAXKY = MINKY - 1
- 55 CONTINUE
-*
- ENDIF
-*
- 100 LBKYCD = LQ(KOFUCD+LBNOCD-KLKYCD)
- IF (LBKYCD.GT.0) CALL MZDROP (IDIVCD, LBKYCD, 'L')
-#endif
-#if defined(CERNLIB__P3CHILD)
- IRC = 0
-#endif
- IF (IRC.EQ.0) IQUEST(2) = NDEL
-* END CDPURK
- 999 END
diff --git a/src/packlib/hepdb/cdpurge/cdpurp.F b/src/packlib/hepdb/cdpurge/cdpurp.F
deleted file mode 100644
index f14aca6..0000000
--- a/src/packlib/hepdb/cdpurge/cdpurp.F
+++ /dev/null
@@ -1,427 +0,0 @@
-*
-* $Id: cdpurp.F,v 1.1.1.1 1996/02/28 16:24:25 mclareni Exp $
-*
-* $Log: cdpurp.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:25 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
-#if defined(CERNLIB__P3CHILD)
-* Ignoring t=dummy
-#endif
- SUBROUTINE CDPURP (PATHN, IKEEP, CHOPT, IRC)
-* ============================================
-*
-************************************************************************
-* *
-* SUBR. CDPURP (PATHN, IKEEP, CHOPT, IRC*) *
-* *
-* Deletes partitions in a partitioned directory except the last *
-* (first) few ones. *
-* *
-* Arguments : *
-* *
-* PATHN Character string describing the pathname *
-* IKEEP Number of partitions to be preserved *
-* (If -ve the last -IKEEP partitions deleted) *
-* CHOPT Character string with any of the following characters *
-* B Save in the special backup file; not in standard Journal*
-* IRC Return Code (See below) *
-* *
-* Called by user, CDFZUP *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* = 69 : Input directory is not partitioned *
-* = 70 : Error in deleting a partition *
-* = 71 : Illegal path name *
-* = 73 : RZOUT fails to write on disk *
-* = 74 : Error in RZRENK in updating key values for *
-* partitioned data set *
-* = 77 : FZOUT fails to write on to the sequential file *
-* *
-************************************************************************
-*
-#include "hepdb/caopts.inc"
-#include "hepdb/cdcblk.inc"
-#include "hepdb/cfzlun.inc"
-#include "hepdb/ckkeys.inc"
-#include "hepdb/csavbk.inc"
-#include "hepdb/ctpath.inc"
-#if defined(CERNLIB__P3CHILD)
-#include "hepdb/p3dbl3.inc"
-#endif
- PARAMETER (JBIAS=2)
- CHARACTER PATHN*(*), CHOPT*(*), PATHY*80, PATHL*80
-#include "zebra/q_jbit.inc"
-* Ignoring t=pass
-*
-* ------------------------------------------------------------------
-*
-* *** Initialize options, insertion time cutoffs, etc.
-*
- PATHL = ' '
- CALL CDOPTS (' ', IRC)
- CALL UOPTC (CHOPT, 'B', IOPBCA)
- NKEEP = IKEEP
- KEY7 = KEY7CK
- KEY7CK = 0
- IF (NKEEP.EQ.0) NKEEP = 1
- IF (KEY7.LE.0) THEN
- CALL DATIME (IDATE, ITIME)
- CALL CDPKTM (IDATE, ITIME, KEY7, IRC)
- ENDIF
-*
-* *** Set the current directory for input path name
-*
- CALL CDLDUP (PATHN, 0, IRC)
- IF (IRC.NE.0) GO TO 999
- KST = NWKYCK + 1
- PATHY = PAT1CT
- NCHAR = LENOCC (PATHY)
- CALL CDKEYT
- IF (NKEYCK.NE.0) THEN
- IOPTP = JBIT (IQ(KOFSCD+LCDRCD+IKDRCD+IDHFLG), JPRTCD)
- ELSE
- IOPTP = 0
- ENDIF
- IF (IOPTP.EQ.0) THEN
- IRC = 69
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDPURP : Directo'//
- + 'ry '//PATHY//' is not partitioned '')', IARGCD, 0)
-#endif
- GO TO 999
- ENDIF
- IF (NKEYCK.LE.NKEEP.AND.NKEEP.GT.0) GO TO 999
-*
-* *** Find the appropriate FZ file number
-*
- IF (IOPBCA.EQ.0) THEN
- LUFZCF = LUFZCD
- ELSE
- LUFZCF = LUBKCD
- ENDIF
-#if (defined(CERNLIB_UNIX)||defined(CERNLIB_IBMVM)||defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))
-*
- IF (IOPPCD.NE.0) THEN
-#endif
-#if (defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))&&(!defined(CERNLIB__P3CHILD))&&(defined(CERNLIB__ONLINE))
- CALL CDWLOK (IRC)
-#endif
-#if (defined(CERNLIB_UNIX)||defined(CERNLIB_IBMVM)||defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))&&(!defined(CERNLIB__P3CHILD))&&(!defined(CERNLIB__ONLINE))
- CALL CDSTSV (TOPNCD, 0, IRC)
-#endif
-#if defined(CERNLIB__P3CHILD)
- LUFZCF = LODBP3
-#endif
-#if (defined(CERNLIB_UNIX)||defined(CERNLIB_IBMVM)||defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))
- IF (IRC.NE.0) GO TO 999
- ENDIF
-#endif
-*
-* *** Partially fill up the header
-*
- IF (LUFZCF.GT.0) THEN
- IF (IOPBCA.EQ.0) THEN
- NDOP = 0
- ELSE
- NDOP = 1
- ENDIF
- NWDP = (NCHAR + 3) / 4
- NWDH = NDOP + NWDP + 6
- IHEDCF(MACTCF) = 8
- IHEDCF(MNKYCF) = 0
- IHEDCF(MOPTCF) = NDOP
- IHEDCF(MPATCF) = NWDP
- IHEDCF(MDELCF) = KEY7
- IHEDCF(MKEPCF) = NKEEP
- IF (NDOP.EQ.1) CALL UCTOH ('B ', IHEDCF(MKEPCF+1), 4, 4)
- CALL UCTOH (PATHY, IHEDCF(MKEPCF+NDOP+1), 4, 4*NWDP)
- CALL MZIOCH (IOFMCF, NWFMCF, '6I -H')
-*
-* ** Now write on the sequential file
-*
-#if defined(CERNLIB__P3CHILD)
- RNDBP3 = 'CDPURP '
- NWDBP3 = 2
- CALL UCTOH ('JOURNAL ', IWDBP3, 4, 8)
- CALL CDCHLD
- IRC = IQDBP3
- IF (IRC.NE.0) GO TO 999
-#endif
- CALL FZOUT (LUFZCF, IDISCD, 0, 1, 'Z', IOFMCF, NWDH, IHEDCF)
- IF (IQUEST(1).NE.0) THEN
- IRC = 77
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDPURP : Error'//
- + ' in FZOUT while writing Data for '//PATHY//''')', IARGCD, 0)
-#endif
- GO TO 999
- ENDIF
-#if (defined(CERNLIB_UNIX)||defined(CERNLIB_IBMVM)||defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))
-*
- IF (IOPPCD.NE.0) THEN
- IRC = 0
-#endif
-#if (defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))&&(!defined(CERNLIB__P3CHILD))&&(defined(CERNLIB__ONLINE))
- CALL CDCWSV (IRC)
-#endif
-#if (defined(CERNLIB_UNIX)||defined(CERNLIB_IBMVM)||defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))
- GO TO 999
- ENDIF
-#endif
- ENDIF
-#if !defined(CERNLIB__P3CHILD)
-*
-* *** Check if the directory updated after KEY7
-*
- NKEYS = NKEYCK
- CALL CDPATH (TOP1CT, NKEYS)
- PAT2CT = PATHY(1:NCHAR)//'/'//TOP1CT
- CALL RZCDIR (PAT2CT, ' ')
- IF (IQUEST(1).NE.0) THEN
- IRC = 71
-#endif
-#if (defined(CERNLIB__DEBUG))&&(!defined(CERNLIB__P3CHILD))
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDPURP : Illeg'//
- + 'al Path Name '//PAT2CT//''')', IARGCD, 0)
-#endif
-#if !defined(CERNLIB__P3CHILD)
- GO TO 999
- ENDIF
- NKEYCK = IQUEST(7)
- NWKYCK = IQUEST(8)
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- IF (IQ(KOFSCD+LCDRCD+IKDRCD+(NKEYCK-1)*KST+IDHINS).GT.KEY7)
- + GO TO 999
-*
-* *** Lock the directory in shared mode
-*
- IF (IOPSCD.NE.0) THEN
- PATHL = PATHY(1:NCHAR)
- CALL RZCDIR (PATHL, ' ')
- CALL RZLOCK ('CDPURP')
- ENDIF
- IF (NKEEP.LT.0) GO TO 55
-*
-* *** Now delete all objects in the first few subdirectories
-*
- DO 15 JKK = NKEEP+1, NKEYS
- IKK = JKK - NKEEP
- CALL CDPATH (TOP1CT, IKK)
- PAT2CT = PATHY(1:NCHAR)//'/'//TOP1CT
- CALL RZCDIR (PAT2CT, ' ')
- IF (IQUEST(1).NE.0) THEN
- IRC = 71
-#endif
-#if (defined(CERNLIB__DEBUG))&&(!defined(CERNLIB__P3CHILD))
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDPURP : Illeg'//
- + 'al Path Name '//PAT2CT//''')', IARGCD, 0)
-#endif
-#if !defined(CERNLIB__P3CHILD)
- GO TO 998
- ENDIF
- NKEYCK = IQUEST(7)
- IF (NKEYCK.GT.0) CALL RZDELK (KDUM, ICDUM, 'K')
- 15 CONTINUE
-*
-* *** Now transfer data from the last partitions to the first
-* *** NKEEP partitions
-*
- NOBJCS = 0
- DO 50 JKK = 1, NKEEP
- IKK = NKEYS - NKEEP + JKK
- ISTR = 0
-*
-* ** Set the current directory to the input directory
-*
- 20 CALL CDPATH (TOP1CT, IKK)
- PAT2CT = PATHY(1:NCHAR)//'/'//TOP1CT
- CALL RZCDIR (PAT2CT, ' ')
- IF (IQUEST(1).NE.0) THEN
- IRC = 71
-#endif
-#if (defined(CERNLIB__DEBUG))&&(!defined(CERNLIB__P3CHILD))
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDPURP : Illeg'//
- + 'al Path Name '//PAT2CT//''')', IARGCD, 0)
-#endif
-#if !defined(CERNLIB__P3CHILD)
- GO TO 996
- ENDIF
- NKEYCK = IQUEST(7)
- NWKYCK = IQUEST(8)
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- DO 25 IK = 1, NSVMCS
- ISTR = ISTR + 1
- IF (ISTR.LE.NKEYCK) THEN
- NOBJCS = NOBJCS + 1
- KEYSCS(IDHKSN,NOBJCS) = ISTR
- ICYCL = 9999
- CALL CDRZIN (IDISCD, LOBJCS(NOBJCS), JBIAS, ISTR, ICYCL,
- + PAT2CT, IRC)
- IF (IRC.NE.0) GO TO 996
- CALL CDKEYR (ISTR, NWKYCK, KEYSCS(1,NOBJCS))
- ENDIF
- 25 CONTINUE
- IF (NOBJCS.EQ.0) GO TO 40
-*
-* ** Set the current directory to the output directory
-*
- CALL CDPATH (TOP1CT, JKK)
- PAT2CT = PATHY(1:NCHAR)//'/'//TOP1CT
- CALL RZCDIR (PAT2CT, ' ')
- IF (IQUEST(1).NE.0) THEN
- IRC = 71
-#endif
-#if (defined(CERNLIB__DEBUG))&&(!defined(CERNLIB__P3CHILD))
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDPURP : Illeg'//
- + 'al Path Name '//PAT2CT//''')', IARGCD, 0)
-#endif
-#if !defined(CERNLIB__P3CHILD)
- GO TO 996
- ENDIF
- NWKYCK = IQUEST(8)
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- DO 30 IK = 1, NOBJCS
-#endif
-#if (defined(CERNLIB__DEBUG))&&(!defined(CERNLIB__P3CHILD))
- IF (IDEBCD.GT.2) CALL RZLDIR (' ', ' ')
-#endif
-#if !defined(CERNLIB__P3CHILD)
- CALL RZOUT (IDISCD, LOBJCS(IK), KEYSCS(1,IK), ICYCLE, 'L')
- IF (IQUEST(1).NE.0) THEN
- IRC = 73
-#endif
-#if (defined(CERNLIB__DEBUG))&&(!defined(CERNLIB__P3CHILD))
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDPURP : Err'//
- + 'or in RZOUT while writing Data for '//PAT2CT//''')',
- + IARGCD, 0)
-#endif
-#if !defined(CERNLIB__P3CHILD)
- GO TO 996
- ENDIF
-#endif
-#if (defined(CERNLIB__DEBUG))&&(!defined(CERNLIB__P3CHILD))
- IF (IDEBCD.GT.1) THEN
- CALL UCOPY (KEYSCS(1,IK), KEYNCK, NWKYCK)
- CALL CDUPTM (IARGCD(1), IARGCD(2), KEYNCK(IDHINS), IRC)
- CALL CDPRNT (LPRTCD, '(/,'' CDPURP : Data was inserted in'//
- + 'to '//PAT2CT//''',/,10X,''on the '',I8,'' at '','//
- + 'I6,'' with Key-Vector '')', IARGCD, 2)
- CALL CDPRKY (NWKYCK, KEYNCK, IOTYCK, IRC)
- ENDIF
-#endif
-#if !defined(CERNLIB__P3CHILD)
- 30 CONTINUE
- DO 35 IK = 1, NOBJCS
- IF (LOBJCS(IK).NE.0) CALL MZDROP (IDISCD, LOBJCS(IK), 'L')
- 35 CONTINUE
- NOBJCS = 0
- IF (ISTR.LT.NKEYCK) GO TO 20
-*
-* ** Now update the keys of the main directory
-*
- 40 CALL RZCDIR (PATHY, ' ')
- NKEYCK = IQUEST(7)
- NWKYCK = IQUEST(8)
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- KPNT = IUHUNT (JKK, IQ(KOFSCD+LCDRCD+IKDRCD+MPSRCD),
- + NKEYCK*KST, KST)
- IF (KPNT.NE.0) THEN
- NK = (KPNT - MPSRCD) / KST + 1
- ELSE
- NK = JKK
- ENDIF
- CALL CDKEYR (NK, NWKYCK, KYP1CK)
- KPNT = IUHUNT (IKK, IQ(KOFSCD+LCDRCD+IKDRCD+MPSRCD),
- + NKEYCK*KST, KST)
- IF (KPNT.NE.0) THEN
- NK = (KPNT - MPSRCD) / KST + 1
- ELSE
- NK = IKK
- ENDIF
- CALL CDKEYR (NK, NWKYCK, KYP2CK)
- KYP2CK(MPSRCD) = KYP1CK(MPSRCD)
- CALL RZRENK (KYP1CK, KYP2CK)
- IF (IQUEST(1).NE.0) THEN
- IRC = 74
-#endif
-#if (defined(CERNLIB__DEBUG))&&(!defined(CERNLIB__P3CHILD))
- IF (IDEBCD.GT.0) THEN
- CALL UCOPY (KYP1CK, IARGCD(1), NSYSCK)
- CALL UCOPY (KYP2CK, IARGCD(NSYSCK+1), NSYSCK)
- CALL CDPRNT (LPRTCD, '(/,'' CDPURP : Error in RZRENK whil'//
- + 'e writing data for '//PATHY//''',/(10X,7I12))',
- + IARGCD, 2*NSYSCK)
- ENDIF
-#endif
-#if !defined(CERNLIB__P3CHILD)
- GO TO 996
- ENDIF
- 50 CONTINUE
-*
-* *** Now delete the keys and subdirectories beyond NKEEP
-*
- 55 IF (NKEEP.GT.0) THEN
- NK1 = NKEEP + 1
- ELSE
- NK1 = NKEYS + NKEEP + 1
- IF (NK1.LT.2) NK1 = 2
- NOBJCS = 0
- ENDIF
- DO 60 JKK = NK1, NKEYS
- IKK = NKEYS + NK1 - JKK
- CALL RZCDIR (PATHY, ' ')
- NKEYCK = IQUEST(7)
- NWKYCK = IQUEST(8)
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- KPNT = IUHUNT (IKK, IQ(KOFSCD+LCDRCD+IKDRCD+MPSRCD),
- + NKEYCK*KST, KST)
- IF (KPNT.NE.0) THEN
- NK = (KPNT - MPSRCD) / KST + 1
- ELSE
- NK = IKK
- ENDIF
- CALL CDKEYR (NK, NWKYCK, KYP2CK)
- CALL RZDELK (KYP2CK, ICDUM, 'C')
- CALL CDPATH (TOP1CT, IKK)
- CALL RZDELT (TOP1CT)
- IF (IQUEST(1).NE.0) THEN
- IRC = 70
-#endif
-#if (defined(CERNLIB__DEBUG))&&(!defined(CERNLIB__P3CHILD))
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDPURP : Error'//
- + ' in deleting partition '//TOP1CT(1:8)//' in '//PATHY//''')',
- + IARGCD, 0)
-#endif
-#if !defined(CERNLIB__P3CHILD)
- GO TO 996
- ENDIF
- 60 CONTINUE
-#endif
-*
- IRC = 0
-#if !defined(CERNLIB__P3CHILD)
-*
-* *** Drop the stored banks
-*
- 996 IF (NOBJCS.GT.0) THEN
- DO 997 IK = 1, NOBJCS
- IF (LOBJCS(IK).NE.0) CALL MZDROP (IDISCD, LOBJCS(IK), 'L')
- 997 CONTINUE
- ENDIF
- 998 IF (PATHL.NE.' ') THEN
- CALL RZCDIR (PATHL, ' ')
- CALL RZFREE ('CDPURP')
- ENDIF
-#endif
-* END CDPURP
- 999 END
diff --git a/src/packlib/hepdb/cdpurge/cdspur.F b/src/packlib/hepdb/cdpurge/cdspur.F
deleted file mode 100644
index 57da46c..0000000
--- a/src/packlib/hepdb/cdpurge/cdspur.F
+++ /dev/null
@@ -1,238 +0,0 @@
-*
-* $Id: cdspur.F,v 1.1.1.1 1996/02/28 16:24:25 mclareni Exp $
-*
-* $Log: cdspur.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:25 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
-#if defined(CERNLIB__P3CHILD)
-* Ignoring t=dummy
-#endif
- SUBROUTINE CDSPUR (PATHN, NWKEY, ITIME, KEYS, ICALL, IRC)
-* =========================================================
-*
-************************************************************************
-* *
-* SUBR. CDSPUR (PATHN, NWKEY, ITIME, KEYS, ICALL, IRC*) *
-* *
-* Saves the object purging information in the Journal file. *
-* It creates a single header record (with zero data) for each entry. *
-* The header contains Action Code (3), Number of keys, numbers of *
-* charcaters for option and pathname, ITIME, current time (like Key *
-* 7), followed by KEYS, Character option and the pathname. *
-* *
-* Arguments : *
-* *
-* PATHN Character string describing the pathname *
-* NWKEY Number of key elements *
-* ITIME Flag (If > 0, ITIME value as indicated in CDPURK, or *
-* < 0, a call from CDPURG) *
-* KEYS Vector of keys, if called from CDPURK *
-* Vector containing KYDAT, KYTIM, if called from CDPURG *
-* ICALL Called from CDPURG (0) or from CDPURK (1) *
-* IRC Return Code (See below) *
-* *
-* Called by CDPURG, CDPURK *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* =115 : Cannot form the IO descriptor for the FZ header *
-* =116 : FZOUT fails to write on the sequential file *
-* *
-************************************************************************
-*
-#include "hepdb/caopti.inc"
-#include "hepdb/caopts.inc"
-#include "hepdb/cdcblk.inc"
-#include "hepdb/cfzlun.inc"
-#include "hepdb/ckkeys.inc"
-#if defined(CERNLIB__P3CHILD)
-#include "hepdb/p3dbl3.inc"
-#endif
- PARAMETER (NLEVM=20)
- CHARACTER CHCUR(NLEVM)*1, CHFOR*110, CFORM(6)*1
- CHARACTER CHOPF*80, PATHN*(*)
- DIMENSION ITIME(9), KEYS(9), NLCUR(NLEVM), IOPTS(26)
- EQUIVALENCE (IOPACA, IOPTS(1))
- DATA CFORM /'B', 'I', 'F', 'D', 'H', 'A'/
-*
-* ------------------------------------------------------------------
-*
-* *** Find the logical unit number of the Journal file
-*
- KEY7 = KEY7CK
- KEY7CK = 0
- NCH = LENOCC (PATHN)
- IRC = 0
-*
- IF (IOPBCA.EQ.0) THEN
- LUFZCF = LUFZCD
- ELSE
- LUFZCF = LUBKCD
- ENDIF
-#if (defined(CERNLIB_UNIX)||defined(CERNLIB_IBMVM)||defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))
-*
- IF (IOPPCD.NE.0) THEN
-#endif
-#if (defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))&&(!defined(CERNLIB__P3CHILD))&&(defined(CERNLIB__ONLINE))
- CALL CDWLOK (IRC)
-#endif
-#if (defined(CERNLIB_UNIX)||defined(CERNLIB_IBMVM)||defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))&&(!defined(CERNLIB__P3CHILD))&&(!defined(CERNLIB__ONLINE))
- CALL CDSTSV (TOPNCD, 0, IRC)
-#endif
-#if defined(CERNLIB__P3CHILD)
- LUFZCF = LODBP3
-#endif
-#if (defined(CERNLIB_UNIX)||defined(CERNLIB_IBMVM)||defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))
- IF (IRC.NE.0) GO TO 999
- ENDIF
-#endif
-*
- IF (LUFZCF.GT.0) THEN
-*
-* ** Prepare the header containing all the information
-*
- NCHD = (NCH + 3) / 4
- IHEDCF(MACTCF) = 3
- IHEDCF(MNKYCF) = NWKEY
- IHEDCF(MPATCF) = NCHD
- IF (ICALL.GT.0) THEN
- IHEDCF(MPARCF) = NPARCD
- CALL UCOPY (ITIME, IHEDCF(MTIMCF), NPARCD)
- CALL UCOPY (IOKYCA(1), IHEDCF(MTIMCF+NPARCD), NWKEY)
- NPNT = MTIMCF + 2*NWKEY + NPARCD
- ELSE
- NPNT = MTIMCF + NWKEY
- IHEDCF(MPARCF) = -1
- ENDIF
- IF (KEY7.GT.0) THEN
- IHEDCF(MINSCF) = KEY7
- ELSE
- CALL DATIME (IDATX, ITIMX)
- CALL CDPKTM (IDATX, ITIMX, IHEDCF(MINSCF), IRC)
- ENDIF
- NCHOP = 0
- DO 10 I = 1, 26
- IF (IOPTS(I).NE.0) THEN
- IF (NCHOP.EQ.0) THEN
- CHOPF = CALFCA(I)
- ELSE
- CHOPF = CHOPF(1:NCHOP)//CALFCA(I)
- ENDIF
- NCHOP = NCHOP + 1
- ENDIF
- 10 CONTINUE
- NWDOP = (NCHOP + 3) / 4
- IHEDCF(MOPTCF) = NWDOP
- IF (NWDOP.GT.0) THEN
- CALL UCTOH (CHOPF, IHEDCF(NPNT), 4, 4*NWDOP)
- NPNT = NPNT + NWDOP
- ENDIF
- CALL UCTOH (PATHN, IHEDCF(NPNT), 4, 4*NCHD)
- NWDH = NPNT + NCHD - 1
-*
-* ** Get the IO format for the header
-*
- NLEV = 1
- IF (ICALL.GT.0) THEN
- NCUR = MTIMCF + NPARCD + NWKEY - 1
- ELSE
- NCUR = MTIMCF - 1
- ENDIF
- IFORO = 2
- CHCUR(NLEV) = CFORM(IFORO)
- DO 20 I = 1, NWKEY
- IFORM = IOTYCK(I)
- IF (IFORM.EQ.6) IFORM = 5
- IF (IFORM.EQ.IFORO) THEN
- NCUR = NCUR + 1
- ELSE
- NLCUR(NLEV) = NCUR
- IF (NLEV.GE.NLEVM) THEN
- IRC = 115
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) THEN
- CHFOR = PATHN
- CALL CDPRNT (LPRTCD, '(/,'' CDSPUR : Cannot form IO '//
- + 'descriptor '//CHFOR(1:NCH)//''')', IARGCD, 0)
- ENDIF
-#endif
- GO TO 999
- ENDIF
- NLEV = NLEV + 1
- CHCUR(NLEV) = CFORM(IFORM)
- NCUR = 1
- IFORO = IFORM
- ENDIF
- IF (ICALL.NE.0) THEN
- IHEDCF(MTIMCF+NPARCD+NWKEY+I-1) = KEYS(I)
- ELSE
- IF (I.LE.NSYSCK) THEN
- IHEDCF(MTIMCF+I-1) = KEYS(I)
- ELSE IF (IFORM.EQ.5) THEN
- CALL UCTOH (' ', IHEDCF(MTIMCF+I-1), 4, 4)
- ELSE
- IHEDCF(MTIMCF+I-1) = 0
- ENDIF
- ENDIF
- 20 CONTINUE
- NLCUR(NLEV) = NCUR
-*
-#if !defined(CERNLIB_IBM)||!defined(CERNLIB__P3CHILD)
- WRITE (CHFOR, 2001) (NLCUR(I), CHCUR(I), I = 1, NLEV)
-#endif
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB__P3CHILD))
- CHFOR = ' '
- II = 1
- DO 30 I = 1, NLEV
- CALL UTWRIT (CHFOR(II:II+1), '(I3)', NLCUR(I))
- II = II + 3
- CHFOR(II:II) = CHCUR(I)
- II = II + 2
- 30 CONTINUE
-#endif
- II = 5 * NLEV
- CHFOR = CHFOR(1:II)//' -H'
- CALL MZIOCH (IOFMCF, NWFMCF, CHFOR(1:II+3))
-*
-* ** Now write on the sequential output
-*
-#if defined(CERNLIB__P3CHILD)
- RNDBP3 = 'CDSPUR '
- NWDBP3 = 2
- CALL UCTOH ('JOURNAL ', IWDBP3, 4, 8)
- CALL CDCHLD
- IRC = IQDBP3
- IF (IRC.NE.0) GO TO 999
-#endif
- CALL FZOUT (LUFZCF, IDIVCD, 0, 1, 'Z', IOFMCF, NWDH, IHEDCF)
- IF (IQUEST(1).NE.0) THEN
- IRC = 116
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) THEN
- CHFOR = PATHN
- CALL CDPRNT (LPRTCD, '(/,'' CDSPUR : FZOUT error for path'//
- + ' name '//CHFOR(1:NCH)//''')', IARGCD, 0)
- ENDIF
-#endif
- GO TO 999
- ENDIF
- ENDIF
-#if (defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))&&(defined(CERNLIB__ONLINE))
-*
-* *** Server environment, Public mode
-*
- IF (IOPPCD.NE.0) THEN
- CALL CDCWSV (IRC)
- GO TO 999
- ENDIF
-#endif
-#if !defined(CERNLIB_IBM)||!defined(CERNLIB__P3CHILD)
-*
- 2001 FORMAT (20(I3,A1,1X))
-#endif
-* END CDSPUR
- 999 END
diff --git a/src/packlib/hepdb/cdread/Imakefile b/src/packlib/hepdb/cdread/Imakefile
deleted file mode 100644
index f9b0c07..0000000
--- a/src/packlib/hepdb/cdread/Imakefile
+++ /dev/null
@@ -1,10 +0,0 @@
-SRCS_F= cdafri.F cdbkks.F cdbook.F cdcfri.F cdchck.F cdchky.F \ @@\
- cdfree.F cdget.F cdgetdb.F cdkeyb.F cdkmld.F cdkmul.F cdksel.F \ @@\
- cdkxin.F cdkydb.F cdkyse.F cdnode.F cdprdt.F cdprin.F cdpsel.F \ @@\
- cdseky.F cduse.F cdusedb.F cdusem.F
-
-#if defined(CERNLIB_P3CHILD)
-SRCS_F := $(SRCS_F) cdstp3.F cdusp3.F
-#endif
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/hepdb/cdread/cdafri.F b/src/packlib/hepdb/cdread/cdafri.F
deleted file mode 100644
index b0a4a52..0000000
--- a/src/packlib/hepdb/cdread/cdafri.F
+++ /dev/null
@@ -1,117 +0,0 @@
-*
-* $Id: cdafri.F,v 1.1.1.1 1996/02/28 16:24:25 mclareni Exp $
-*
-* $Log: cdafri.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:25 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
-#if defined(CERNLIB__P3CHILD)
-* Ignoring t=dummy
-#endif
- SUBROUTINE CDAFRI (LUN, LBD, CHOPT, IRC)
-* ========================================
-*
-************************************************************************
-* *
-* SUBR. CDAFRI (LUN, LBD, IRC*) *
-* *
-* Decodes the content of the bank from packed bits to ASCII set and *
-* writes it out into a file already opened *
-* *
-* Arguments : *
-* *
-* LUN Logical unit number of the file with ASCII data *
-* LBD Address of the data bank *
-* CHOPT Character options *
-* IRC Return code (see below) *
-* *
-* Called by CDHELP *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* IRC =199 : Corrupted data *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
-#if defined(CERNLIB__P3CHILD)
-#include "hepdb/p3dbl3.inc"
-#endif
- DIMENSION LBD(9)
- CHARACTER KLINE*80
- CHARACTER*(*) CHOPT
-*
-* ------------------------------------------------------------------
-*
-* *** Initialize options
-*
- IRC = 0
- IOPTC = INDEX(CHOPT,'C')
- LREFCD(5) = LBD(1)
- IF (LUN.GT.0.AND.LREFCD(5).GT.0) THEN
- NDATA = IQ(KOFUCD+LREFCD(5)-1)
- IF (NDATA.GT.0) THEN
-#if !defined(CERNLIB__P3CHILD)
-*
-* ** Display data if exists, if it does not, display dummy data
-*
- NTOT = 0
-#endif
-#if (defined(CERNLIB__DEBUG))&&(!defined(CERNLIB__P3CHILD))
- NREC = 0
-#endif
-#if !defined(CERNLIB__P3CHILD)
- 10 IF (NTOT.LT.NDATA) THEN
- MTOT=NTOT
- CALL CDLIND (IQ(KOFUCD+LREFCD(5)+1), NTOT, KLINE, LENG)
- IF (LENG.GT.0) THEN
- IF(IOPTC.EQ.0) THEN
- WRITE (LUN, 1000) KLINE(1:LENG)
- ELSE
- WRITE (LUN, 1001) KLINE(1:LENG)
- ENDIF
- ELSE IF(NTOT.GT.MTOT) THEN
- WRITE (LUN, *)
- ELSE
-* -- a case of corrupted data, force end of scan
- NTOT=NDATA
- IRC=199
- WRITE (LUN, *) ' ### Corrupted data ###'
- IF (IDEBCD.GT.-3)
- + CALL CDPRNT (LPRTCD, '(/,'' CDAFRI : corrupted data '')',1)
- ENDIF
-#endif
-#if (defined(CERNLIB__DEBUG))&&(!defined(CERNLIB__P3CHILD))
- NREC = NREC + 1
-#endif
-#if !defined(CERNLIB__P3CHILD)
- GO TO 10
- ENDIF
-#endif
-#if (defined(CERNLIB__DEBUG))&&(!defined(CERNLIB__P3CHILD))
- IF (IDEBCD.GT.1) THEN
- CALL CDPRNT (LPRTCD, '(/,'' CDAFRI : '',I10,'' records '//
- + 'written for the current set '')', NREC, 1)
- ENDIF
-#endif
-#if defined(CERNLIB__P3CHILD)
- RNDBP3 = 'CDAFRI'
- NWDBP3 = 2
- IWDBP3(1) = LUN
- IWDBP3(2) = NDATA
- CALL CDCHLD
- IF (IQDBP3.EQ.0)
- + CALL APFZUT (LODBP3, IDIVCD, LREFCD(5), 1, 'S', 0, 0, 0)
-#endif
- ENDIF
- ENDIF
-#if !defined(CERNLIB__P3CHILD)
-*
- 1000 FORMAT (A)
- 1001 FORMAT (1X,A)
-#endif
-* END CDAFRI
- 999 END
diff --git a/src/packlib/hepdb/cdread/cdbkks.F b/src/packlib/hepdb/cdread/cdbkks.F
deleted file mode 100644
index 255ebe9..0000000
--- a/src/packlib/hepdb/cdread/cdbkks.F
+++ /dev/null
@@ -1,214 +0,0 @@
-*
-* $Id: cdbkks.F,v 1.1.1.1 1996/02/28 16:24:25 mclareni Exp $
-*
-* $Log: cdbkks.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:25 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDBKKS (KEYS, LBK, ITIME, IRC)
-* =========================================
-*
-************************************************************************
-* *
-* SUBR. CDBKKS (KEYS, LBK*, ITIME, IRC*) *
-* *
-* Creates or completes the Key banks supported as next of same type *
-* to the Node bank with S option *
-* *
-* Arguments : *
-* *
-* KEYS Vector of keys *
-* LBK Address(es) of Keys bank(s) KYCD *
-* ITIME Time for which the valid keys are required *
-* (in option S) *
-* IRC Return code (see below) *
-* *
-* Called by CDKEYB, CDKYDB, CDUSEDB,CDUSEM *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* = 24 : No Key bank created satisfying key options for *
-* option S *
-* = 25 : Illegal Path Name *
-* *
-************************************************************************
-*
-#include "hepdb/caopts.inc"
-#include "hepdb/cdcblk.inc"
-#include "hepdb/ckkeys.inc"
-#include "hepdb/ctkxin.inc"
-#include "hepdb/ctpath.inc"
- PARAMETER (NZ=0)
- DIMENSION KEYS(9), LBK(9), ITIME(9)
- CHARACTER PATHN*80
-#include "zebra/q_jbit.inc"
-* Ignoring t=pass
-*
-* ------------------------------------------------------------------
-*
- IRC = 0
-*
-* ** Start from the end of the existing chain
-*
- IF (LQ(KOFUCD+LBNOCD-KLKYCD).NE.0) THEN
- LFIXCD = LZLAST (IDIVCD, LQ(KOFUCD+LBNOCD-KLKYCD))
- IF (LFIXCD.EQ.0) LFIXCD = LQ(KOFUCD+LBNOCD-KLKYCD)
- ELSE
- LFIXCD = LBNOCD
- ENDIF
-*
-* ** Loop over all keys
-*
- IF (NKEYCK.LE.0) THEN
- IRC = 24
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDBKKS : No comp'//
- + 'atible object for specified options'')', IARGCD, 0)
-#endif
- GO TO 999
- ENDIF
- LSAVCD = LFIXCD
- CALL CDKEYT
- IOPTP = JBIT (IQ(KOFSCD+LCDRCD+IKDRCD+IDHFLG), JPRTCD)
-*
- IF (IOPTP.EQ.0) THEN
- CALL CDKYSE (KEYS, ITIME, IRC)
- ELSE
- CALL RZCDIR (PATHN, 'R')
- MAXL = LENOCC (PATHN)
- NKEYS = NKEYCK
- KST = NWKYCK + 1
-*
-* ** Loop over all subdirectories
-*
- DO 10 IK = 1, NKEYS
- ICURCT = NKEYS + 1 - IK
-*
-* * Fast selection
-*
- IF (IK.NE.1) THEN
- CALL RZCDIR (PATHN, ' ')
- IF (IQUEST(1).NE.0) THEN
- IRC = 25
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.NE.0) CALL CDPRNT (LPRTCD, '(/,'' CDBKKS : I'//
- + 'llegal Path name '//PATHN//''')', IARGCD, 0)
-#endif
- GO TO 999
- ENDIF
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- NWKYCK = IQUEST(8)
- ENDIF
-*
- KPNT = IUHUNT (ICURCT, IQ(KOFSCD+LCDRCD+IKDRCD+MPSRCD),
- + NKEYS*KST, KST)
- IF (KPNT.NE.0) THEN
- IPNT = KOFSCD + LCDRCD + IKDRCD + KPNT - MPSRCD
- ELSE
- IPNT = KOFSCD + LCDRCD + IKDRCD + (ICURCT - 1) * KST
- ENDIF
- CALL CDPSEL (ITIME, KEYS, IQ(IPNT+1), 0, ISEL)
- IF (ISEL.NE.0) GO TO 10
-*
- CALL CDPATH (TOP2CT, ICURCT)
- PAT2CT = PATHN(1:MAXL)//'/'//TOP2CT
- CALL RZCDIR (PAT2CT, ' ')
- IF (IQUEST(1).NE.0) THEN
- IQUEST(1) = 25
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.NE.0) CALL CDPRNT (LPRTCD, '(/,'' CDBKKS : Ill'//
- + 'egal Path name '//PAT2CT//''')', IARGCD, 0)
-#endif
- GO TO 30
- ENDIF
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- NKEYCK = IQUEST(7)
- NWKYCK = IQUEST(8)
- CALL CDKEYT
- CALL CDKYSE (KEYS, ITIME, IRC)
- IF (IRC.NE.0) GO TO 30
- 10 CONTINUE
- ENDIF
-*
-* *** Discard all keys with discard bit set
-*
- LSAVCD = LFIXCD
- IF (LFIXCD.EQ.LBNOCD) THEN
- LBKYCD = LQ(KOFUCD+LSAVCD-KLKYCD)
- ELSE
- LBKYCD = LQ(KOFUCD+LSAVCD)
- ENDIF
- 15 IF (LBKYCD.NE.0) THEN
- IF (JBIT(IQ(KOFUCD+LBKYCD+IDHFLG),JIGNCD).NE.0) THEN
- CALL MZDROP (IDIVCD, LBKYCD, ' ')
- ELSE
- LSAVCD = LBKYCD
- IF (IPRBCA.EQ.0.AND.IPRECA.EQ.0) THEN
- IF (IHFLCD.EQ.0) THEN
- KYEN = 0
- DO 20 I = 1, NPARCD
- IF (KYEN.EQ.0) THEN
- IF (IQ(KOFUCD+LBKYCD+NOF1CK+2*I).LT.KYENCD(I)) KYEN=-1
- IF (IQ(KOFUCD+LBKYCD+NOF1CK+2*I).GT.KYENCD(I)) KYEN= 1
- ENDIF
- 20 CONTINUE
- DO I = 1, NPARCD
- IF (KYEN.LT.0) THEN
- IQ(KOFUCD+LBKYCD+NWKYCK+I) =
- + IQ(KOFUCD+LBKYCD+NOF1CK+2*I)
- ELSE
- IQ(KOFUCD+LBKYCD+NWKYCK+I) = KYENCD(I)
- ENDIF
- ENDDO
- ELSE
- DO 25 I = 1, NPARCD
- IQ(KOFUCD+LBKYCD+NWKYCK+I) =
- + MIN (IQ(KOFUCD+LBKYCD+NOF1CK+2*I), KYENCD(I))
- 25 CONTINUE
- ENDIF
- ENDIF
- ENDIF
- LBKYCD = LQ(KOFUCD+LSAVCD)
- GO TO 15
- ENDIF
-*
-* *** Reset the current directory if needed
-*
- 30 IF (IOPTP.NE.0) THEN
- CALL RZCDIR (PATHN, ' ')
- IF (IQUEST(1).NE.0) THEN
- IF (IRC.EQ.0) THEN
- IRC = 25
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.NE.0) CALL CDPRNT (LPRTCD, '(/,'' CDBKKS : Ill'//
- + 'egal Path name '//PATHN//''')', IARGCD, 0)
-#endif
- ENDIF
- ELSE
- NKEYCK = IQUEST(7)
- NWKYCK = IQUEST(8)
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- CALL CDKEYT
- ENDIF
- ENDIF
-*
- IF (LFIXCD.EQ.LBNOCD) THEN
- LBK(1) = LQ(KOFUCD+LFIXCD-KLKYCD)
- ELSE
- LBK(1) = LQ(KOFUCD+LFIXCD)
- ENDIF
- IF (LBK(1).EQ.0) THEN
- IRC = 24
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDBKKS : No comp'//
- + 'atible object for specified options'')', IARGCD, 0)
-#endif
- ENDIF
-* END CDBKKS
- 999 END
diff --git a/src/packlib/hepdb/cdread/cdbook.F b/src/packlib/hepdb/cdread/cdbook.F
deleted file mode 100644
index 3afb748..0000000
--- a/src/packlib/hepdb/cdread/cdbook.F
+++ /dev/null
@@ -1,79 +0,0 @@
-*
-* $Id: cdbook.F,v 1.1.1.1 1996/02/28 16:24:25 mclareni Exp $
-*
-* $Log: cdbook.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:25 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDBOOK (PATHN, LBK, NBANK, CHOPT, IRC)
-* =================================================
-*
-************************************************************************
-* *
-* SUBR. CDBOOK (PATHN, LBK*, NBANK, CHOPT, IRC*) *
-* *
-* Creates a chain of NBANK Key banks supported as next of same type *
-* to the Node bank for a given pathname *
-* *
-* Arguments : *
-* *
-* PATHN Character string describing the pathname *
-* LBK Address(es) of Keys bank(s) KYCD *
-* NBANK Number of banks to be created *
-* CHOPT Character string with any of the following characters *
-* IRC Return code (see below) *
-* *
-* Called by user, CDREPL, CDSTOR *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* Could be set to nonzero by some routines called *
-* *
-************************************************************************
-*
-#include "hepdb/caopts.inc"
-#include "hepdb/cdcblk.inc"
- PARAMETER (NZ=0)
- DIMENSION LBK(9)
- CHARACTER PATHN*(*), CHOPT*(*)
-*
-* ------------------------------------------------------------------
-*
- CALL CDOPTS (CHOPT, IRC)
- IF (IRC.NE.0) GO TO 999
-*
-* *** Find the address of the node bank
-*
- CALL CDNODE (PATHN, IRC)
- IF (IRC.NE.0) GO TO 999
-*
-* *** Loop to create the Key Banks
-*
- IF (LQ(KOFUCD+LBNOCD-KLKYCD).NE.0) THEN
- LFIXCD = LZLAST (IDIVCD, LQ(KOFUCD+LBNOCD-KLKYCD))
- JBINI = 0
- ELSE
- LFIXCD = LBNOCD
- JBINI = -KLKYCD
- ENDIF
- LBKYCD = LFIXCD
- JBIAS = JBINI
- ND = IQ(KOFUCD+LBNOCD+MNDNWD)
-*
- DO 10 NK = 1, NBANK
- CALL UCOPY (IQ(KOFUCD+LBNOCD+MNDIOF), IOKYCD, NWNOCD)
- LSAVCD = LBKYCD
- CALL CDBANK (IDIVCD, LBKYCD, LSAVCD, JBIAS, 'KYCD', NLKYCD,
- + NSKYCD, ND, IOKYCD, NZ, IRC)
- JBIAS = 0
- IF (IRC.NE.0) GO TO 999
- LQ(KOFUCD+LBKYCD-KLNOCD) = LBNOCD
- LQ(KOFUCD+LBKYCD-KLUPCD) = LBUPCD
- 10 CONTINUE
-*
- LBK(1) = LQ(KOFUCD+LFIXCD+JBINI)
-* END CDBOOK
- 999 END
diff --git a/src/packlib/hepdb/cdread/cdcfri.F b/src/packlib/hepdb/cdread/cdcfri.F
deleted file mode 100644
index 0f60134..0000000
--- a/src/packlib/hepdb/cdread/cdcfri.F
+++ /dev/null
@@ -1,111 +0,0 @@
-*
-* $Id: cdcfri.F,v 1.1.1.1 1996/02/28 16:24:27 mclareni Exp $
-*
-* $Log: cdcfri.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:27 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
-#if defined(CERNLIB__P3CHILD)
-* Ignoring t=dummy
-#endif
- SUBROUTINE CDCFRI (CHTEXT, NTEXT, LTEXT, LBD, IRC)
-* =================================================
-*
-************************************************************************
-* *
-* SUBR. CDCFRI (CHTEXT, *NTEXT*, LTEXT, LDB, IRC*) *
-* *
-* Decodes the content of the bank from packed bits to ASCII set and *
-* copies it to a character buffer *
-* *
-* Arguments : *
-* *
-* CHTEXT Character buffer to which data is copied *
-* *NTEXT* On input, number of elements of CHTEXT *
-* On output, number of elements that have been filled *
-* LTEXT Maximum length of an element that can be accepted *
-* LBD Address of the data bank *
-* IRC Return code (see below) *
-* *
-* Called by CDCHAR *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* = ? : data has been truncated *
-* = ? : buffer overflow : see IQUEST(1) *
-* IQUEST(1) = number of elements in data bank *
-* *
-************************************************************************
-*
- CHARACTER*(*) CHTEXT(NTEXT)
-#include "hepdb/cdcblk.inc"
-#if defined(CERNLIB__P3CHILD)
-#include "hepdb/p3dbl3.inc"
-#endif
- DIMENSION LBD(9)
- CHARACTER KLINE*80
-*
-* ------------------------------------------------------------------
-*
-* *** Initialize options
-*
- IRC = 0
- LREFCD(5) = LBD(1)
- IF (LREFCD(5).GT.0) THEN
- NDATA = IQ(KOFUCD+LREFCD(5)-1)
- IF (NDATA.GT.0) THEN
-#if !defined(CERNLIB__P3CHILD)
-*
-* ** Display data if exists, if it does not, display dummy data
-*
- NTOT = 0
-#endif
-#if (defined(CERNLIB__DEBUG))&&(!defined(CERNLIB__P3CHILD))
- NREC = 0
-#endif
-#if !defined(CERNLIB__P3CHILD)
- 10 IF (NTOT.LT.NDATA) THEN
- CALL CDLIND (IQ(KOFUCD+LREFCD(5)+1), NTOT, KLINE, LENG)
- NREC = NREC + 1
- IF(NREC.LE.NTEXT) THEN
- IF (LENG.GT.0) THEN
- IF(LENG.GT.LTEXT) THEN
- IRC = 2
- LENG = LTEXT
- ENDIF
- CHTEXT(NREC) = KLINE(1:LENG)
- ELSE
- CHTEXT(NREC) = ' '
- ENDIF
- GO TO 10
- ENDIF
- ENDIF
- IQUEST(1) = NREC
- NTEXT = MIN(NTEXT,NREC)
-#endif
-#if (defined(CERNLIB__DEBUG))&&(!defined(CERNLIB__P3CHILD))
- IF (IDEBCD.GT.1) THEN
- CALL CDPRNT (LPRTCD, '(/,'' CDCFRI : '',I10,'' records '//
- + 'copied for the current set '')', NREC, 1)
- ENDIF
-#endif
-#if defined(CERNLIB__P3CHILD)
- RNDBP3 = 'CDCFRI'
- NWDBP3 = 2
- IWDBP3(1) = LUN
- IWDBP3(2) = NDATA
- CALL CDCHLD
- IF (IQDBP3.EQ.0)
- + CALL APFZUT (LODBP3, IDIVCD, LREFCD(5), 1, 'S', 0, 0, 0)
-#endif
- ENDIF
- ENDIF
-#if !defined(CERNLIB__P3CHILD)
-*
- 1000 FORMAT (A)
-#endif
-* END CDCFRI
- 999 END
diff --git a/src/packlib/hepdb/cdread/cdchck.F b/src/packlib/hepdb/cdread/cdchck.F
deleted file mode 100644
index 2fa3b2d..0000000
--- a/src/packlib/hepdb/cdread/cdchck.F
+++ /dev/null
@@ -1,565 +0,0 @@
-*
-* $Id: cdchck.F,v 1.1.1.1 1996/02/28 16:24:25 mclareni Exp $
-*
-* $Log: cdchck.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:25 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
-#if defined(CERNLIB__P3CHILD)
-* Ignoring t=dummy
-#endif
- SUBROUTINE CDCHCK (LBK, ITIME, KEYS, LBD, IRC)
-* ==============================================
-*
-************************************************************************
-* *
-* SUBR. CDCHCK (LBK, ITIME, KEYS, *LBD*, IRC*) *
-* *
-* Loads data from disk according to validity time and Key values *
-* *
-* Arguments : *
-* *
-* LBK Address of the bank containing the keys *
-* ITIME Time for which the valid data are required *
-* KEYS Vector of keys *
-* LBD Address of the bank containing the data *
-* IRC Return code (see below) *
-* *
-* Called by CDUSE, CDUSEDB,CDUSEM *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* = 31 : Path name in Node bank is wrong *
-* = 32 : No keys/data in this directory *
-* = 36 : Data bank address zero on return from CDKXIN *
-* = 37 : Insufficient space in USER store array *
-* *
-************************************************************************
-*
-#include "hepdb/caopts.inc"
-#include "hepdb/cdcblk.inc"
-#include "hepdb/ckkeys.inc"
-#include "hepdb/clinks.inc"
-#include "hepdb/ctkxin.inc"
-#include "hepdb/ctpath.inc"
-#if defined(CERNLIB__P3CHILD)
-#include "hepdb/p3dbl3.inc"
-#endif
- PARAMETER (JBIAS=2)
- DIMENSION LBK(9), LBD(9), KEYS(9), ITIME(9)
- CHARACTER PATHN*255
-#include "zebra/q_jbit.inc"
-* Ignoring t=pass
-*
-* ------------------------------------------------------------------
-*
-* *** Lock the bank
-*
- LREFCD(2) = LBK(1)
- IQ2 = IQUEST(2)
- NDK = IQ(KOFUCD+LREFCD(2)-1)
- IQ(KOFUCD+LREFCD(2)+NDK+MKYFRI) = 0
- IQ(KOFUCD+LREFCD(2)+NDK+MKYCRU) = IQ(KOFUCD+LREFCD(2)+NDK+MKYCRU)
- + + 1
- IQ(KOFUCD+LREFCD(2)+NDK+MKYCEV) = IQ(KOFUCD+LREFCD(2)+NDK+MKYCEV)
- + + 1
-*
-* *** Get the pathname
-*
- LBNOCD = LQ(KOFUCD+LREFCD(2)-KLNOCD)
- NCHAR = IQ(KOFUCD+LBNOCD+MNDNCH)
- CALL UHTOC (IQ(KOFUCD+LBNOCD+MNDNAM), 4, PAT4CT, NCHAR)
- PATHN = PAT4CT(1:NCHAR)
-*
-* *** Set the current directory
-*
- CALL RZCDIR (PATHN, ' ')
- IF (IQUEST(1).NE.0) THEN
- IRC = 31
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDCHCK : '//
- + 'Path name '//PATHN//' from node bank illegal'')', IQ, 0)
-#endif
- GO TO 998
- ENDIF
- NKEYCK = IQUEST(7)
- NWKYCK = IQUEST(8)
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- CALL CDKEYT
-*
-* *** Check the number of keys
-*
- IF (NKEYCK.EQ.0) THEN
- IRC = 32
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDCHCK : No key '//
- + 'or data for Path Name '//PATHN//''')', IARGCD, 0)
-#endif
- GO TO 998
- ENDIF
-*
- IRC = 0
- IF (IOPKCA.NE.0 .AND. IOPSCA.NE.0) THEN
- GO TO 998
- ENDIF
-*
-* *** Force retrieval
-*
- IF (IOPFCA.NE.0) THEN
- LBD(1) = LQ(KOFUCD+LREFCD(2)-KLDACD)
- IF (LBD(1).NE.0) THEN
- CALL MZDROP (IDIVCD, LBD(1), 'L')
- LBD(1) = 0
- ENDIF
- ENDIF
-*
- IF (LQ(KOFUCD+LREFCD(2)-KLDACD).EQ.0) THEN
-*
-* ** The bank does not exist yet - retrieve data from the Data Base
-* ** Check which keys are to be used
-*
- IF (IOPSCA.EQ.0) THEN
- DO 10 I = 1, NWKYCK
- IF (IOKYCA(I).NE.0) THEN
- IF (I.EQ.IDHINS.OR.(I.GE.NOF1CK.AND.I.LE.NOF1CK+2*NPARCD))
- + THEN
- KEYVCK(I) = KEYS(I)
- ELSE
- KEYVCK(I) = IQ(KOFUCD+LREFCD(2)+I)
- ENDIF
- ELSE
- KEYVCK(I) = 0
- ENDIF
- 10 CONTINUE
- ELSE
- CALL UCOPY (IQ(KOFUCD+LREFCD(2)+1), KEYVCK, NWKYCK)
- ENDIF
-*
-* ** Retrieve data
-*
- CALL CDKXIN (ITIME, IDIVCD, LBD(1), LBK(1), -KLDACD, NWKEY,
- + KEYVCK, IPREC, IRC)
- IF (IRC.NE.0) GO TO 998
- LREFCD(2) = LBK(1)
- LREFCD(3) = LBD(1)
- IF (IOPSCA.EQ.0) THEN
- IF (IQ(KOFUCD+LREFCD(2)+IDHKSN).NE.KEYVCK(IDHKSN)) IQ2 = 1
- ELSE
- IQ2 = 1
- ENDIF
-*
-* * Overwrite keys in key-bank
-*
- CALL UCOPY (KEYVCK(1), IQ(KOFUCD+LREFCD(2)+1), NWKYCK)
- IQ(KOFUCD+LREFCD(2)+NDK+MKYPRE) = IPREC
- IQ(KOFUCD+LREFCD(2)+NDK+MKYRID) =IQ(KOFUCD+LREFCD(2)+NDK+MKYRID)
- + + 1
- IF (IOPSCA.EQ.0) THEN
- IF (IPRBCA+IPRECA.EQ.0) THEN
- IF (IHFLCD.EQ.0) THEN
- KYEN = 0
- DO 20 I = 1, NPARCD
- IF (KYEN.EQ.0) THEN
- IF (IQ(KOFUCD+LREFCD(2)+NOF1CK+2*I).LT.KYENCD(I))
- + KYEN = -1
- IF (IQ(KOFUCD+LREFCD(2)+NOF1CK+2*I).GT.KYENCD(I))
- + KYEN = 1
- ENDIF
- 20 CONTINUE
- DO I = 1, NPARCD
- IF (KYEN.LT.0) THEN
- IQ(KOFUCD+LREFCD(2)+NWKYCK+I) =
- + IQ(KOFUCD+LREFCD(2)+NOF1CK+2*I)
- ELSE
- IQ(KOFUCD+LREFCD(2)+NWKYCK+I) = KYENCD(I)
- ENDIF
- ENDDO
- ELSE
- DO 25 I = 1, NPARCD
- IQ(KOFUCD+LREFCD(2)+NWKYCK+I) =
- + MIN (IQ(KOFUCD+LREFCD(2)+NOF1CK+2*I), KYENCD(I))
- 25 CONTINUE
- ENDIF
- ELSE
- DO 30 I = 1, NPARCD-1
- IQ(KOFUCD+LREFCD(2)+NWKYCK+I) =
- + IQ(KOFUCD+LREFCD(2)+NOF1CK+2*I-1)
- 30 CONTINUE
- IQ(KOFUCD+LREFCD(2)+NWKYCK+NPARCD) =
- + IQ(KOFUCD+LREFCD(2)+NOF1CK+2*NPARCD-1) + 1
- ENDIF
- ENDIF
-*
- ELSE
-*
-* ** The data bank exists already
-*
- LBD(1) = LQ(KOFUCD+LREFCD(2)-KLDACD)
- LREFCD(3) = LBD(1)
-*
-* ** Check if data are valid
-*
- KEY6 = IQ(KOFUCD+LREFCD(2)+IDHFLG)
- IF (IOPACA.NE.0) THEN
- IBEG = 0
- IEND = 0
- DO 35 I = 1, NPARCD
- IF (IHFLCD.EQ.0) THEN
- IF (IBEG.EQ.0) THEN
- IF (ITIME(I).LT.IQ(KOFUCD+LREFCD(2)+NOF1CK+2*I-1))
- + IBEG =-I
- IF (ITIME(I).GT.IQ(KOFUCD+LREFCD(2)+NOF1CK+2*I-1))
- + IBEG = I
- ENDIF
- IF (IEND.EQ.0) THEN
- IF (ITIME(I).GT.IQ(KOFUCD+LREFCD(2)+NWKYCK+I)) IEND =-I
- IF (ITIME(I).LT.IQ(KOFUCD+LREFCD(2)+NWKYCK+I)) IEND = I
- ENDIF
- ELSE
- IF (IBEG.EQ.0) THEN
- IF (ITIME(I).LT.IQ(KOFUCD+LREFCD(2)+NOF1CK+2*I-1))
- + IBEG =-I
- ENDIF
- IF (IEND.EQ.0) THEN
- IF (ITIME(I).GT.IQ(KOFUCD+LREFCD(2)+NWKYCK+I)) IEND =-I
- ENDIF
- ENDIF
- 35 CONTINUE
- IF (IBEG.GE.0.AND.IEND.GE.0) GO TO 998
-*
- ELSE
-*
- IBEG = 0
- IEND = 0
- DO 40 I = 1, NPARCD
- IF (IHFLCD.EQ.0) THEN
- IF (IBEG.EQ.0) THEN
- IF (ITIME(I).LT.IQ(KOFUCD+LREFCD(2)+NOF1CK+2*I-1))
- + IBEG =-I
- IF (ITIME(I).GT.IQ(KOFUCD+LREFCD(2)+NOF1CK+2*I-1))
- + IBEG = I
- ENDIF
- IF (IEND.EQ.0) THEN
- IF (ITIME(I).GT.IQ(KOFUCD+LREFCD(2)+NWKYCK+I)) IEND =-I
- IF (ITIME(I).LT.IQ(KOFUCD+LREFCD(2)+NWKYCK+I)) IEND = I
- ENDIF
- ELSE
- IF (IBEG.EQ.0) THEN
- IF (ITIME(I).LT.IQ(KOFUCD+LREFCD(2)+NOF1CK+2*I-1))
- + IBEG =-I
- ENDIF
- IF (IEND.EQ.0) THEN
- IF (ITIME(I).GT.IQ(KOFUCD+LREFCD(2)+NWKYCK+I)) IEND =-I
- ENDIF
- ENDIF
- 40 CONTINUE
- IF (IBEG.LT.0.OR.IEND.LT.0) GO TO 85
- ISTP = NWKYCK + 1
- IPNT = KOFSCD + LCDRCD + IKDRCD
- MNKYCT = -998
- KEY1 = IQ(KOFUCD+LREFCD(2)+IDHKSN)
- KEY6CT = 0
- IMINCT = 1
- IOPTP = JBIT (IQ(IPNT+IDHFLG), JPRTCD)
-*
- IF (IOPTP.EQ.0) THEN
-*
-* * For non-partitioned data
-*
- IMIN = IUHUNT (KEY1, IQ(IPNT+IDHKSN), NKEYCK*ISTP, ISTP)
- IF (IMIN.GT.0) THEN
- IMINCT = (IMIN - IDHKSN) / ISTP + 1
- ELSE
- IMINCT = 1
- ENDIF
- CALL CDKEYR (IMINCT, NWKYCK, KEYVCK)
- DO 45 I = 1, NWKYCK
- IF (KEYVCK(I).NE.IQ(KOFUCD+LREFCD(2)+I)) GO TO 85
- 45 CONTINUE
- 50 IF (IMINCT.EQ.NKEYCK) GO TO 998
- ICURCT = 1
- CALL CDCHKY (ITIME, KEYS)
- IF (KEY1.EQ.MNKYCT.AND.JBIT(KEY6CT,JIGNCD).EQ.0) GO TO 998
-*
- ELSE
-*
-* * For partitioned data
-*
- NKEYS = NKEYCK
- KST = NWKYCK + 1
- ICUR = NKEYS
- DO 55 JK = 1, NKEYS
- KPNT = IUHUNT (JK, IQ(IPNT+MPSRCD), NKEYS*KST, KST)
- IF (KPNT.GT.0) THEN
- KPNT = KPNT + IPNT - MPSRCD
- ELSE
- KPNT = IPNT + (JK - 1) * KST
- ENDIF
- IF (IQ(KPNT+MOBJCD).GT.KEY1) THEN
- ICUR = IQ(KPNT+MPSRCD) - 1
- GO TO 60
- ENDIF
- 55 CONTINUE
-*
- 60 CALL CDPATH (TOP2CT, ICUR)
- PAT2CT = PATHN(1:NCHAR)//'/'//TOP2CT
- CALL RZCDIR (PAT2CT, ' ')
- IF (IQUEST(1).NE.0) THEN
- IRC = 31
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDCHCK : '//
- + 'Path name '//PAT2CT//' from node bank illegal'')', IQ, 0)
-#endif
- GO TO 998
- ENDIF
- NKEYCK = IQUEST(7)
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- IPNT = KOFSCD + LCDRCD + IKDRCD
- ISTP = NWKYCK + 1
-*
- IF (NKEYCK.GT.0) THEN
- IMIN = IUHUNT (KEY1, IQ(IPNT+IDHKSN), NKEYCK*ISTP, ISTP)
- IF (IMIN.GT.0) THEN
- IMINCT = (IMIN - IDHKSN) / ISTP + 1
- ELSE
- IMINCT = 1
- ENDIF
- ENDIF
- CALL CDKEYR (IMINCT, NWKYCK, KEYVCK)
- DO 65 I = 1, NWKYCK
- IF (KEYVCK(I).NE.IQ(KOFUCD+LREFCD(2)+I)) GO TO 85
- 65 CONTINUE
-*
- 70 IF (ICUR.EQ.NKEYS.AND.IMINCT.EQ.NKEYCK) GO TO 998
- IMIN = IMINCT
- MNKYCT = KEY1
- IUSECT = ICUR
-*
- DO 75 JK = ICUR, NKEYS
- ICURCT = NKEYS + ICUR - JK
-*
- CALL RZCDIR (PATHN, ' ')
- IF (IQUEST(1).NE.0) THEN
- IRC = 31
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDCHCK :'//
- + ' Path name '//PATHN//' from node bank illegal'')',IQ,0)
-#endif
- GO TO 998
- ENDIF
- NKEYCK = IQUEST(7)
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- KPNT = IUHUNT (ICURCT, IQ(KOFSCD+LCDRCD+IKDRCD+MPSRCD),
- + NKEYS*KST, KST)
- IF (KPNT.NE.0) THEN
- IPNT = KOFSCD + LCDRCD + IKDRCD + KPNT - MPSRCD
- ELSE
- IPNT = KOFSCD + LCDRCD + IKDRCD + (ICURCT - 1) * KST
- ENDIF
- CALL CDPSEL (ITIME, KEYS, IQ(IPNT+1), 0, ISEL)
- IF (ISEL.NE.0) GO TO 75
-*
- CALL CDPATH (TOP2CT, ICURCT)
- PAT2CT = PATHN(1:NCHAR)//'/'//TOP2CT
- CALL RZCDIR (PAT2CT, ' ')
- IF (IQUEST(1).NE.0) THEN
- IRC = 31
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDCHCK :'//
- + ' Path name '//PAT2CT//' from node bank illegal'')',IQ
- + ,0)
-#endif
- GO TO 998
- ENDIF
- NKEYCK = IQUEST(7)
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- IF (ICURCT.EQ.ICUR) THEN
- IMINCT = IMIN
- ELSE
- IMINCT = 1
- ENDIF
-*
- IF (NKEYCK.GE.IMINCT) THEN
- CALL CDCHKY (ITIME, KEYS)
- IF (IUSECT.NE.ICUR.OR.MNKYCT.NE.KEY1) GO TO 80
- ENDIF
- 75 CONTINUE
-*
- 80 CALL RZCDIR (PATHN, ' ')
- IF (IQUEST(1).NE.0) THEN
- IRC = 31
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDCHCK : '//
- + 'Path name '//PATHN//' from node bank illegal'')', IQ, 0)
-#endif
- GO TO 998
- ENDIF
- NKEYCK = IQUEST(7)
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- IF (IUSECT.EQ.ICUR.AND.KEY1.EQ.MNKYCT.AND.
- + JBIT(KEY6CT,JIGNCD).EQ.0) GO TO 998
-*
- ENDIF
-*
- ENDIF
-*
-* * Data should be refreshed
-* * Check which keys are to be used
-*
- 85 IF (IOPSCA.EQ.0) THEN
- DO 90 I = 1, NWKYCK
- IF (IOKYCA(I).NE.0) THEN
- IF (I.EQ.IDHINS.OR.(I.GE.NOF1CK.AND.I.LE.NOF1CK+2*NPARCD))
- + THEN
- KEYVCK(I) = KEYS(I)
- ELSE
- KEYVCK(I) = IQ(KOFUCD+LREFCD(2)+I)
- ENDIF
- ELSE
- KEYVCK(I) = 0
- ENDIF
- 90 CONTINUE
- ELSE
- CALL UCOPY (IQ(KOFUCD+LREFCD(2)+1), KEYVCK, NWKYCK)
- ENDIF
-*
-* * Retrieve data
-*
- IDTYP = ICDTYP (LREFCD(2))
- IF (IOPVCA.NE.0.OR. JBIT(KEY6,JRZUCD).NE.0 . OR.
- + (IDTYP.NE.2.AND.IDTYP.NE.3.AND.IDTYP.NE.5)) THEN
-*
-* * Variable data length - attach data to a new bank
-*
- CALL MZDROP (IDIVCD, LREFCD(3), 'L')
- CALL CDKXIN (ITIME, IDIVCD, LBD(1), LBK(1), -KLDACD, NWKEY,
- + KEYVCK, IPREC, IRC)
- IF (IRC.NE.0) GO TO 998
- LREFCD(3) = LBD(1)
- IF (IOPSCA.EQ.0) THEN
- IF (IQ(KOFUCD+LREFCD(2)+IDHKSN).NE.KEYVCK(IDHKSN)) IQ2 = 1
- ELSE
- IQ2 = 1
- ENDIF
-*
- ELSE
-*
-* * Fixed length data - overwrite existing data
-*
- IF (LAUXCL(7).NE.0) THEN
- CALL MZDROP (IDISCD, LAUXCL(7), 'L')
- LAUXCL(7) = 0
- ENDIF
- NDAT = IQ(KOFUCD+LREFCD(3)-1)
- CALL CDKXIN (ITIME, IDISCD, LAUXCL(7), LAUXCL(7), JBIAS,
- + NWKEY, KEYVCK, IPREC, IRC)
- IF (IRC.NE.0) GO TO 998
- IF (IOPSCA.EQ.0) THEN
- IF (IQ(KOFUCD+LREFCD(2)+IDHKSN).NE.KEYVCK(IDHKSN)) IQ2 = 1
- ELSE
- IQ2 = 1
- ENDIF
-#if defined(CERNLIB__P3CHILD)
- IF (IPASP3.EQ.1) GO TO 200
-#endif
-*
- IF (LAUXCL(7).EQ.0) THEN
- IRC = 36
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDCHCK : Ill'//
- + 'egal Bank address from CDKXIN'')', IARGCD, 0)
-#endif
- GO TO 998
-*
- ELSE
-*
-* ** See if the old bank size is sufficient to store the data
-*
- ND = IQ(KOFUCD+LAUXCL(7)-1)
- IF (ND.GT.NDAT) THEN
-*
-* * Insufficient space
-*
- CALL MZDROP (IDISCD, LAUXCL(7), 'L')
- IRC = 37
- IQUEST(11) = NDAT
- IQUEST(12) = ND
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) THEN
- CALL CDPRNT (LPRTCD, '(/,'' CDCHCK : Insufficient spa'//
- + 'ce '',I10,'' to store data - a minimum of '','//
- + 'I10,'' storage is needed'')', IQUEST(11), 2)
- ENDIF
-#endif
- GO TO 998
-*
- ELSE
-*
-* * Everything is OK
-*
- CALL UCOPY (Q(KOFUCD+LAUXCL(7)+1), Q(KOFUCD+LREFCD(3)+1),
- + ND)
- CALL MZDROP (IDISCD, LAUXCL(7), 'L')
- IRC = 0
-*
- ENDIF
-*
- ENDIF
-*
- ENDIF
-*
-* * Overwrite keys in key-bank
-*
- 200 CALL UCOPY (KEYVCK(1), IQ(KOFUCD+LREFCD(2)+1), NWKYCK)
- IQ(KOFUCD+LREFCD(2)+NDK+MKYPRE) = IPREC
- IQ(KOFUCD+LREFCD(2)+NDK+MKYRID) =IQ(KOFUCD+LREFCD(2)+NDK+MKYRID)
- + + 1
- IF (IOPSCA.EQ.0) THEN
- IF (IPRBCA+IPRECA.EQ.0) THEN
- IF (IHFLCD.EQ.0) THEN
- KYEN = 0
- DO 205 I = 1, NPARCD
- IF (KYEN.EQ.0) THEN
- IF (IQ(KOFUCD+LREFCD(2)+NOF1CK+2*I).LT.KYENCD(I))
- + KYEN = -1
- IF (IQ(KOFUCD+LREFCD(2)+NOF1CK+2*I).GT.KYENCD(I))
- + KYEN = 1
- ENDIF
- 205 CONTINUE
- DO 210 I = 1, NPARCD
- IF (KYEN.LT.0) THEN
- IQ(KOFUCD+LREFCD(2)+NWKYCK+I) =
- + IQ(KOFUCD+LREFCD(2)+NOF1CK+2*I)
- ELSE
- IQ(KOFUCD+LREFCD(2)+NWKYCK+I) = KYENCD(I)
- ENDIF
- 210 CONTINUE
- ELSE
- DO 215 I = 1, NPARCD
- IQ(KOFUCD+LREFCD(2)+NWKYCK+I) =
- + MIN (IQ(KOFUCD+LREFCD(2)+NOF1CK+2*I), KYENCD(I))
- 215 CONTINUE
- ENDIF
- ELSE
- DO 220 I = 1, NPARCD-1
- IQ(KOFUCD+LREFCD(2)+NWKYCK+I) =
- + IQ(KOFUCD+LREFCD(2)+NOF1CK+2*I-1)
- 220 CONTINUE
- IQ(KOFUCD+LREFCD(2)+NWKYCK+NPARCD) =
- + IQ(KOFUCD+LREFCD(2)+NOF1CK+2*NPARCD-1) + 1
- ENDIF
- ENDIF
-*
- ENDIF
-*
- 998 IQUEST(2) = IQ2
-* END CDCHCK
- 999 END
diff --git a/src/packlib/hepdb/cdread/cdchky.F b/src/packlib/hepdb/cdread/cdchky.F
deleted file mode 100644
index dfa6c8a..0000000
--- a/src/packlib/hepdb/cdread/cdchky.F
+++ /dev/null
@@ -1,48 +0,0 @@
-*
-* $Id: cdchky.F,v 1.1.1.1 1996/02/28 16:24:26 mclareni Exp $
-*
-* $Log: cdchky.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:26 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDCHKY (ITIME, KEYS)
-* ===============================
-*
-************************************************************************
-* *
-* SUBR. CDCHKY (ITIME, KEYS) *
-* *
-* Checks if the current key bank is still valid *
-* *
-* Arguments : *
-* *
-* ITIME Time for which the valid data are required *
-* KEYS Vector of keys *
-* *
-* Called by CDCHCK *
-* *
-************************************************************************
-*
-#include "hepdb/caopts.inc"
-#include "hepdb/cdcblk.inc"
-#include "hepdb/ckkeys.inc"
-#include "hepdb/ctkxin.inc"
- DIMENSION ITIME(9), KEYS(9)
-*
-* ------------------------------------------------------------------
-*
-* *** Loop over the keys
-*
- DO 10 IK = IMINCT, NKEYCK
- CALL CDKEYR (IK, NWKYCK, KEYVCK)
- CALL CDKSEL (ITIME, KEYS, KEYVCK, 0, ISEL, INBR)
- IF (ISEL.EQ.0.AND.MNKYCT.LE.KEYVCK(IDHKSN)) THEN
- MNKYCT = KEYVCK(IDHKSN)
- KEY6CT = KEYVCK(IDHFLG)
- IUSECT = ICURCT
- ENDIF
- 10 CONTINUE
-* END CDCHKY
- 999 END
diff --git a/src/packlib/hepdb/cdread/cdfree.F b/src/packlib/hepdb/cdread/cdfree.F
deleted file mode 100644
index a04b43b..0000000
--- a/src/packlib/hepdb/cdread/cdfree.F
+++ /dev/null
@@ -1,321 +0,0 @@
-*
-* $Id: cdfree.F,v 1.1.1.1 1996/02/28 16:24:27 mclareni Exp $
-*
-* $Log: cdfree.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:27 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDFREE (PATHN, LBK, MASK, KEYS, CHOPT, IRC)
-* ======================================================
-*
-************************************************************************
-* *
-* SUBR. CDFREE (PATHN, LBK, MASK, KEYS, CHOPT, IRC*) *
-* *
-* Declares the given data bank(s) as candidates to be dropped in *
-* case space is needed in the database division. Optionally it *
-* deletes the Data bank(s) (with option D) or the Keys as well as *
-* the Data bank(s) (with option K). *
-* *
-* Arguments : *
-* *
-* PATHN Character string describing the pathname *
-* LBK Address(es) of Keys bank(s) KYCD *
-* MASK Integer vector indicating which elements of KEYS are *
-* significant for selection. If MASK corresponding to *
-* one of the fields of 'Beginning' validity range is set, *
-* it will select objects with start validity smaller than *
-* those requested in KEYS. If MASK corresponding to one *
-* of the fields of 'End' validity range is set, it will *
-* select objects with end validity larger than those in *
-* KEYS. If MASK corresponding to time of insertion is set,*
-* objects inserted earlier than KEYS(IDHINS) are selected *
-* KEYS Vector of keys *
-* CHOPT Character string with any of the following characters *
-* A trust LBK address(es) if non-zero *
-* D drop the Data bank(s) supported at link 1 of Key bank(s)*
-* K drop the Key bank(s) as well as Data bank(s) *
-* M expect multiple Key banks *
-* S Key/data was retrieved using 'S' option in DBUSE *
-* IRC Return code (see below) *
-* *
-* Called by user *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* = 51 : Illegal character option *
-* = 52 : No access to the Key banks *
-* = 54 : Pathname not matched to that found in bank NOCD *
-* = 57 : Illegal pathname *
-* = 58 : Database structure in memory clobbered *
-* = 59 : Some of the expected key banks not found *
-* *
-************************************************************************
-*
-#include "hepdb/caopts.inc"
-#include "hepdb/cdcblk.inc"
-#include "hepdb/ckkeys.inc"
-#include "hepdb/cmulop.inc"
-#include "hepdb/ctpath.inc"
- PARAMETER (NLEVM=20)
- CHARACTER PATHN*(*), CHOPT*(*), PATHY*80, CNODE(NLEVM)*16
- DIMENSION LBK(9), KEYS(9), MASK(9), NCHL(NLEVM)
-*
-* ------------------------------------------------------------------
-*
-* *** Decode all the options
-*
- LREFCD(1) = LBK(1)
- CALL CDOPTS (CHOPT, IRC)
- IF (IRC.NE.0) GO TO 999
- CALL UCOPY (MASK, IOKYCA, MXDMCK)
- IF (IOPMCA.NE.0 .AND. IOPSCA.NE.0) THEN
- IRC = 51
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDFREE : Illegal'//
- + ' character option -- Options S/M are mutually exclusive'')',
- + IARGCD, 0)
-#endif
- GO TO 999
- ENDIF
-*
-* *** Check if Key bank address is usable
-*
- NCHAR = LENOCC (PATHN)
- IF (PATHN(1:1).EQ.'*'.OR.NCHAR.EQ.0) THEN
- IPUSE = 0
- ELSE
- IPUSE = 1
- ENDIF
- IF (LREFCD(1).NE.0.AND.IOPACA.NE.0) THEN
- IKUSE = 1
- ELSE
- IKUSE = 0
- ENDIF
-*
-* *** Check if the options are consistent
-*
- IF (IPUSE+IKUSE.EQ.0) THEN
- IRC = 52
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDFREE : Illegal'//
- + ' entry -- No access to Key bank '')', IARGCD, 0)
-#endif
- GO TO 999
- ENDIF
-*
-* *** Load top directory information
-*
- IF (IKUSE.NE.0) THEN
- LBNOCD = LQ(KOFUCD+LREFCD(1)-KLNOCD)
- NWKYCK = IQ(KOFUCD+LBNOCD+MNDNWK)
- NCHAR = IQ(KOFUCD+LBNOCD+MNDNCH)
- IF (NCHAR.GT.MAXLCD) NCHAR = MAXLCD
- CALL UHTOC (IQ(KOFUCD+LBNOCD+MNDNAM), 4, PAT1CT, NCHAR)
- PATHY = PAT1CT(1:NCHAR)
- CALL CDLDUP (PATHY, 0, IRC)
- ELSE
- CALL CDLDUP (PATHN, 0, IRC)
- PATHY = PAT1CT
- NCHAR = LENOCC (PATHY)
- ENDIF
-*
- IF (IDEBCD.GT.0.AND.(IPUSE.NE.0.AND.IKUSE.NE.0)) THEN
- CALL CDSBLC (PATHN, PAT2CT, NCHR)
- NF1 = NCHAR - NCHR + 1
- IF (NF1.LE.0.OR.PATHY(NF1:NCHAR).NE.PAT2CT) THEN
- IRC = 54
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDFREE : Pathn'//
- + 'ame '//PAT2CT//' not matched to '',/,18X,'' '//PATHY//' fo'//
- + 'und in bank NOCD'')', IARGCD, 0)
-#endif
- GO TO 999
- ENDIF
- ENDIF
-*
-* *** Get number of key banks needed
-*
- CALL CDKMUL (KEYS, NKYMX, IRC)
- IF (IRC.NE.0) GO TO 999
-*
-* *** Get the L-address of the first Key bank
-*
- IF (IKUSE.NE.0) THEN
- LBNOCD = LQ(KOFUCD+LREFCD(1)-KLNOCD)
- LBKYCD = LQ(KOFUCD+LBNOCD-KLKYCD)
- ND = IQ(KOFUCD+LBNOCD+MNDNWD)
- ELSE
-*
-* ** Get it from the pathname
-* ** First find the list of Nodes
-*
- CALL CDPARS (PATHY, NLEVM, CNODE, NCHL, NODES)
-*
-* ** Number of Nodes found should be nonzero
-*
- IF (NODES.EQ.0) THEN
- IRC = 57
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDFREE : Illeg'//
- + 'al pathname '//PATHY//''')', IARGCD, 0)
-#endif
- GO TO 999
- ENDIF
-*
-* ** Go through the Nodes to reach the bottom level
-*
- IN = 0
- 10 IN = IN + 1
-*
-* * Construct the pathname from the Node names
-*
- NCHR = 1
- DO 20 I = 1, IN
- NMAX = NCHL (I)
- IF (NCHR+NMAX .GT. MAXLCD) THEN
- NMAX = MAXLCD - NCHR - 1
- IF (NMAX.LE.0) GO TO 20
- ENDIF
- NCHR = NCHR + NMAX + 1
- IF (NCHR.EQ.MAXLCD) GO TO 30
- 20 CONTINUE
- 30 PAT4CT = PATHY(1:NCHR)
-*
-* * The first Node should be at the top directory
-*
- I0 = 0
- IF (IN.EQ.1) THEN
- NMAX = 1
- ELSE
- NMAX = IQ(KOFUCD+LBNOCD-2)
- ENDIF
-*
- 40 I0 = I0 + 1
-*
-* * No link left for the Node bank
-*
- IF (I0.GT.NMAX) THEN
- IRC = 58
- IQUEST(11) = IN
- IQUEST(12) = NODES
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDFREE : Node'//
- + ' '//CNODE(IN)//' at level '',I3,'' out of '',I3,'' not fou'//
- + 'nd'')', IQUEST(11), 2)
-#endif
- GO TO 999
- ENDIF
-*
- IF (IN.EQ.1) THEN
- LSAVCD = LQ(KOFUCD+LBUPCD-1)
- ELSE
- LSAVCD = LQ(KOFUCD+LBNOCD-I0)
- ENDIF
-*
-* * Check the full pathname in the Node bank name against
-* * the current pathname
-*
- IF (LSAVCD.NE.0) THEN
- MCHAR = IQ(KOFUCD+LSAVCD+MNDNCH)
- IF (MCHAR.GT.MAXLCD) MCHAR = MAXLCD
- CALL UHTOC (IQ(KOFUCD+LSAVCD+MNDNAM), 4, PAT2CT, MCHAR)
- PAT2CT = PAT2CT(1:MCHAR)
- IF (PAT2CT.NE.PAT4CT) GO TO 40
- LBNOCD = LSAVCD
- IF (IN.LT.NODES) GO TO 10
- ELSE
- GO TO 40
- ENDIF
-*
- LBKYCD = LQ(KOFUCD+LBNOCD-KLKYCD)
- ND = IQ(KOFUCD+LBNOCD+MNDNWD)
- ENDIF
-*
-* *** Number of Key banks to be serviced with option S
-*
- IF (IOPSCA.NE.0) THEN
- NKYMX = NZBANK (IDIVCD, LBKYCD)
-*
- IF (IPRBCA.EQ.0.AND.IPRECA.EQ.0) THEN
- IFLG = 99
- ELSE
- IFLG = 0
- ENDIF
- ENDIF
-*
-* *** Loop over all possible Key Banks
-*
- NK = 0
- 50 NK = NK + 1
-*
-* ** For option 'M', find the corresponding key values
-*
- CALL CDKMLD (NK, KEYS)
-*
-* ** Check if this Key bank already exists
-*
- IF (IOPSCA.EQ.0) LBKYCD = LQ(KOFUCD+LBNOCD-KLKYCD)
- 60 CONTINUE
- IF (LBKYCD.NE.0) THEN
- IF (IOPSCA.EQ.0) THEN
- CALL CDKSEL (ITIME,KYVMCK,IQ(KOFUCD+LBKYCD+1),99,ISEL,INBR)
- IF (ISEL.NE.0) GO TO 70
-*
- ELSE
-*
- CALL CDKSEL (ITIME,KYVMCK,IQ(KOFUCD+LBKYCD+1),IFLG,ISEL,INBR)
- IF (ISEL.NE.0) GO TO 70
- ENDIF
-*
-* ** Take proper action according to character option
-*
- IF (IOPKCA.NE.0) THEN
-*
-* * Drop the Key bank
-*
- LKEY = LBKYCD
- LBKYCD = LQ(KOFUCD+LKEY+2)
- CALL MZDROP (IDIVCD, LKEY, ' ')
- ELSE IF (IOPDCA.NE.0) THEN
-*
-* * Drop the data bank
-*
- CALL MZDROP (IDIVCD, LBKYCD, 'V')
- ELSE
-*
-* * Set the free bit
-*
- IQ(KOFUCD+LBKYCD+ND+MKYFRI) = 1
- ENDIF
- GO TO 80
- 70 LBKYCD = LQ(KOFUCD+LBKYCD)
- GO TO 60
-*
- ELSE
-*
- IF (IOPSCA.EQ.0) THEN
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0.AND.IRC.EQ.0) CALL CDPRNT (LPRTCD,'(/,'' '//
- + 'CDFREE : At least one of the required key bank(s) not '//
- + 'found'')', IARGCD, 0)
-#endif
- IRC = 59
- IF (IOPMCA.NE.0) LBKYCD = LQ(KOFUCD+LBNOCD-KLKYCD)
- ELSE
- GO TO 999
- ENDIF
- ENDIF
-*
- 80 CONTINUE
- IF (IOPSCA.EQ.0) THEN
- IF (NK.LT.NKYMX) GO TO 50
- ELSE
- IF (LBKYCD.NE.0) LBKYCD = LQ(KOFUCD+LBKYCD)
- IF (LBKYCD.NE.0) GO TO 50
- ENDIF
-* END CDFREE
- 999 END
diff --git a/src/packlib/hepdb/cdread/cdget.F b/src/packlib/hepdb/cdread/cdget.F
deleted file mode 100644
index 91e50d5..0000000
--- a/src/packlib/hepdb/cdread/cdget.F
+++ /dev/null
@@ -1,51 +0,0 @@
-*
-* $Id: cdget.F,v 1.1.1.1 1996/02/28 16:24:27 mclareni Exp $
-*
-* $Log: cdget.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:27 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
-#if defined(CERNLIB__P3CHILD)
-* Ignoring t=dummy
-#endif
- SUBROUTINE CDGET(CHPATH,IXDIV,LSUP,JBIAS,ISEL,KEYS,CHOPT,IRC)
- DIMENSION ISEL(9), KEYS(9)
- DIMENSION MASK(100)
- CHARACTER*(*) CHPATH,CHOPT
-#include "hepdb/cdcblk.inc"
- DATA NENTRY/0/
- SAVE NENTRY,MASK
-*
-* Zero mask vector
-*
- IF(NENTRY.EQ.0) THEN
- CALL VZERO(MASK,100)
- NENTRY = 1
- ENDIF
-*
-* Retrieve data structure in standard way
-*
- CALL CDUSE(CHPATH,LKEYS,ISEL,CHOPT,IRC)
- IF(IRC.EQ.0) THEN
-
- IF(INDEX(CHOPT,'K').EQ.0) THEN
-*
-* Shunt data bank over
-*
- IFLAG = 1
- LDATA = LQ(LKEYS)
- CALL ZSHUNT(IXDIV,LKEYS,LSUP,JBIAS,IFLAG)
- ENDIF
-*
-* Copy keys bank into keys vector
-*
- CALL UCOPY(IQ(LKEYS+1),KEYS,IQ(LKEYS-1))
-*
-* Free d/s
-*
- CALL CDFREE(CHPATH,LKEYS,MASK,KEYS,' ',IRC)
- ENDIF
-
- END
diff --git a/src/packlib/hepdb/cdread/cdgetdb.F b/src/packlib/hepdb/cdread/cdgetdb.F
deleted file mode 100644
index 4f5061e..0000000
--- a/src/packlib/hepdb/cdread/cdgetdb.F
+++ /dev/null
@@ -1,340 +0,0 @@
-*
-* $Id: cdgetdb.F,v 1.1.1.1 1996/02/28 16:24:26 mclareni Exp $
-*
-* $Log: cdgetdb.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:26 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
-#if defined(CERNLIB__P3CHILD)
-* Ignoring t=dummy
-#endif
- SUBROUTINE CDGETDB (PATHN, LBK, MASK,KEYS, KYSR,KYINM, CHOPT, IRC)
-* ==================================================================
-*
-************************************************************************
-* *
-* SUBR. CDGETDB (PATHN, LBK*, MASK,KEYS, KYSR,KYINM, CHOPT,IRC*)*
-* *
-* Prepares the database data structure in memory for any required *
-* Pathname and set of Keys, unless already done. Returns the *
-* in memory for the corresponding Key bank(s) with a selection on *
-* a range of start validity time and user keys. *
-* Selects objects with validity range as specified in KEYS(NOF1CK..) *
-* if the proper masks are used. It sees the object in data base has *
-* the start validity period within the range specified by the user. *
-* Selection on insertion time demands data base object was inserted *
-* before the selected time. *
-* *
-* Arguments : *
-* *
-* PATHN Character string describing the pathname *
-* LBK Address(es) of Keys bank(s) KYCD. The data bank address *
-* can be obtained as LQ(LBK-1) *
-* For option 'S' it is the support address of the linear *
-* structure *
-* MASK Integer vector indicating which elements of KEYS are *
-* significant for selection. If MASK corresponding to *
-* one of the fields of 'Beginning' validity range is set, *
-* it will select objects with start validity larger than *
-* those requested in KEYS. If MASK corresponding to one *
-* of the fields of 'End' validity range is set, it will *
-* select objects with start validity smaller than those *
-* in the KEYS vector (in the fields corresponding to end *
-* validity). If MASK corresponding to time of insertion *
-* is set, objects inserted earlier than KEYS(IDHINS) are *
-* selected *
-* KEYS Vector of keys. Only the elements declared in CHOPT are *
-* assumed to contain useful information. *
-* KYSR The limits on the serial number for option R *
-* KYINM The lower limit on insertion time used with option I *
-* CHOPT Character string with any of the following characters *
-* I ignore objects inserted before KYINM *
-* K read only the keys (no data is required) *
-* R select on range of serial number given in KYSR(1:2) *
-* S expect multiple Key banks satisfying selection on a *
-* number of keys *
-* IRC Return code (see below) *
-* *
-* Called by user *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* = 2 : Illegal path name *
-* = 32 : No keys/data in this directory *
-* *
-* If IRC = 0, IQUEST(2) carries information on number of data *
-* objects selected by CDGETDB *
-* *
-************************************************************************
-*
-#include "hepdb/caopts.inc"
-#include "hepdb/cdcblk.inc"
-#include "hepdb/cinitl.inc"
-#include "hepdb/ckkeys.inc"
-#include "hepdb/clinks.inc"
-#include "hepdb/ctpath.inc"
-#if defined(CERNLIB__P3CHILD)
-#include "hepdb/p3dbl3.inc"
-#endif
- PARAMETER (NZ=0)
- DIMENSION KEYS(9), MASK(9), KYSR(2), LBK(9)
- CHARACTER CHOPT*(*), PATHN*(*), PATHY*255
-#include "zebra/q_jbit.inc"
-* Ignoring t=pass
-*
-* ------------------------------------------------------------------
-*
-* *** Initialize options
-*
- CALL CDOPTS (CHOPT, IRC)
- IF (IRC.NE.0) GO TO 999
- CALL UCOPY (MASK, IOKYCA, MXDMCK)
- IOPMCA = 0
- LBK(1) = 0
-*
-* *** Create (or complete) database skeleton in memory
-*
- CALL CDNODE (PATHN, IRC)
- IF (IRC.NE.0) GO TO 999
- PATHY = PAT1CT
-*
-* ** Start from the end of the existing chain
-*
- IF (LQ(KOFUCD+LBNOCD-KLKYCD).NE.0) THEN
- LFIXCD = LZLAST (IDIVCD, LQ(KOFUCD+LBNOCD-KLKYCD))
- IF (LFIXCD.EQ.0) THEN
- LFIXCD = LBNOCD
- JBIAS =-KLKYCD
- ELSE
- JBIAS = 0
- ENDIF
- ELSE
- LFIXCD = LBNOCD
- JBIAS =-KLKYCD
- ENDIF
- NDK = IQ(KOFUCD+LBNOCD+MNDNWD)
- CALL UCOPY (IQ(KOFUCD+LBNOCD+MNDIOF), IOKYCD, NWNOCD)
-*
-* *** Set the current directory
-*
- CALL RZCDIR (PATHY, ' ')
- IF (IQUEST(1).NE.0) THEN
- IRC = 2
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDGETDB : Illega'//
- + 'l path name '//PATHY//''')', IARGCD, 0)
-#endif
- GO TO 999
- ENDIF
- NKEYCK = IQUEST(7)
- NWKYCK = IQUEST(8)
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- CALL CDKEYT
-*
- IF (NKEYCK.LE.0) THEN
- IRC = 32
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDGETDB : No key'//
- + 's/data for '//PATHY//''')', IARGCD, 0)
-#endif
- GO TO 999
- ENDIF
-*
- NCHR = LENOCC (PATHY)
- IOPTP = JBIT (IQ(KOFSCD+LCDRCD+IKDRCD+IDHFLG), JPRTCD)
-*
-* *** Now create the key bank(s) and optionally the data bank
-*
- NKB = 0
- IPRBCA = ISIGN (IPRBCA, -1)
- IPRECA = ISIGN (IPRECA, -1)
- IF (IPRBCA.EQ.0.AND.IPRECA.EQ.0) THEN
- IFLG = 99
- ELSE
- IFLG = 0
- ENDIF
-#if defined(CERNLIB__P3CHILD)
- LCOND = (IOPSCA.NE.0.AND.IOPKCA.EQ.0)
- CALL CDSTP3 (1, LCOND, NBKP3, 0)
-#endif
- IF (IOPTP.EQ.0) THEN
- DO 20 JK = 1, NKEYCK
- IK = NKEYCK + 1 - JK
- CALL CDKEYR (IK, NWKYCK, KEYVCK)
- CALL CDKSEL (ITIME, KEYS, KEYVCK, IFLG, ISEL, INBR)
- IF (ISEL.NE.0) GO TO 20
- IF ((KEYVCK(IDHKSN).LT.KYSR(1).OR.KEYVCK(IDHKSN).GT.KYSR(2))
- + .AND.(IOPRCA.NE.0)) GO TO 20
- IF (IOPICA.NE.0.AND.KEYVCK(IDHINS).LT.KYINM) GO TO 20
- IF (JBIT(KEYVCK(IDHFLG),JIGNCD).NE.0) GO TO 20
- CALL CDBANK (IDIVCD, LBKYCD, LFIXCD, JBIAS, 'KYCD', NLKYCD,
- + NSKYCD, NDK, IOKYCD, NZ, IRC)
- IF (IRC.NE.0) GO TO 999
- LQ(KOFUCD+LBKYCD-KLNOCD) = LBNOCD
- LQ(KOFUCD+LBKYCD-KLUPCD) = LBUPCD
- IQ(KOFUCD+LBKYCD+NDK+MKYFRI) = 0
- IQ(KOFUCD+LBKYCD+NDK+MKYCRU) = IQ(KOFUCD+LBKYCD+NDK+MKYCRU) +1
- IQ(KOFUCD+LBKYCD+NDK+MKYCEV) = IQ(KOFUCD+LBKYCD+NDK+MKYCEV) +1
- NKB = NKB + 1
- IF (NKB.EQ.1) LBK(1) = LBKYCD
- LFIXCD = LBKYCD
- JBIAS = 0
- IF (IOPKCA.EQ.0) THEN
-#if defined(CERNLIB__P3CHILD)
- IF (IPASP3.EQ.1) CALL CDSTP3 (2, LCOND, NBKYP3, 0)
-#endif
- CALL VZERO (KEYVCK, NWKYCK)
- KEYVCK(IDHKSN) = IK
- IOKYCA(IDHKSN) = 1
- CALL CDKXIN (ITIME, IDIVCD, LAUXCL(9), LBKYCD, -KLDACD,
- + NWKEY, KEYVCK, IPREC, IRC)
- IOKYCA(IDHKSN) = 0
- LAUXCL(9) = 0
- IQ(KOFUCD+LBKYCD+NDK+MKYPRE) = IPREC
- IQ(KOFUCD+LBKYCD+NDK+MKYRID) = IQ(KOFUCD+LBKYCD+NDK+MKYRID)
- + + 1
- ENDIF
- CALL UCOPY (KEYVCK(1), IQ(KOFUCD+LBKYCD+1), NWKYCK)
- DO 10 I = 1, NPARCD-1
- IQ(KOFUCD+LBKYCD+NWKYCK+I) = IQ(KOFUCD+LBKYCD+NOF1CK+2*I-1)
- 10 CONTINUE
- IQ(KOFUCD+LBKYCD+NWKYCK+NPARCD) =
- + IQ(KOFUCD+LBKYCD+NOF1CK+2*NPARCD-1) + 1
- IF (IRC.NE.0) GO TO 999
- IF (IOPSCA.EQ.0) THEN
- IQUEST(2) = NKB
- GO TO 999
- ENDIF
- 20 CONTINUE
-*
- ELSE
- KST = NWKYCK + 1
- NKEYS = NKEYCK
- KSERL = -1
- KINSL = 0
- DO 40 JKK = 1, NKEYS
- IKK = NKEYS + 1 - JKK
- KPNT = IUHUNT (IKK, IQ(KOFSCD+LCDRCD+IKDRCD+MPSRCD),
- + NKEYS*KST, KST)
- IF (KPNT.GT.0) THEN
- KPNT = KOFSCD + LCDRCD + IKDRCD + KPNT - MPSRCD
- ELSE
- KPNT = KOFSCD + LCDRCD + IKDRCD + (IKK - 1) * KST
- ENDIF
- IF (IOPICA.NE.0) THEN
- IF (JKK.GT.1.AND.KINSL.LT.KYINM) GO TO 40
- KINSL = IQ(KPNT+IDHINS)
- ENDIF
- IF (IOPRCA.NE.0) THEN
- IF (IQ(KPNT+MOBJCD).GT.KYSR(2)) GO TO 40
- IF (KSERL.GE.0.AND.KSERL.LT.KYSR(1)) GO TO 40
- KSERL = IQ(KPNT+MOBJCD)
- ENDIF
- CALL CDPSEL (ITIME, KEYS, IQ(KPNT+1), IFLG, ISEL)
- IF (ISEL.NE.0) GO TO 40
-*
- CALL CDPATH (TOP2CT, IKK)
- PAT2CT = PATHY(1:NCHR)//'/'//TOP2CT
- CALL RZCDIR (PAT2CT, ' ')
- IF (IQUEST(1).NE.0) THEN
- IQUEST(1) = 2
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDGETDB : Il'//
- + 'legal path name '//PAT2CT//''')', IARGCD, 0)
-#endif
- GO TO 999
- ENDIF
- NKEYCK = IQUEST(7)
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
-#if defined(CERNLIB__P3CHILD)
- NKBP3 = 0
-#endif
- DO 30 JK = 1, NKEYCK
- IK = NKEYCK + 1 - JK
- CALL CDKEYR (IK, NWKYCK, KEYVCK)
- CALL CDKSEL (ITIME, KEYS, KEYVCK, IFLG, ISEL, INBR)
- IF (ISEL.NE.0) GO TO 30
- IF ((KEYVCK(IDHKSN).LT.KYSR(1).OR.KEYVCK(IDHKSN).GT.KYSR(2))
- + .AND.(IOPRCA.NE.0)) GO TO 30
- IF (IOPICA.NE.0.AND.KEYVCK(IDHINS).LT.KYINM) GO TO 30
- IF (JBIT(KEYVCK(IDHFLG),JIGNCD).NE.0) GO TO 30
- CALL CDBANK (IDIVCD, LBKYCD, LFIXCD, JBIAS, 'KYCD', NLKYCD,
- + NSKYCD, NDK, IOKYCD, NZ, IRC)
- IF (IRC.NE.0) GO TO 999
- LQ(KOFUCD+LBKYCD-KLNOCD) = LBNOCD
- LQ(KOFUCD+LBKYCD-KLUPCD) = LBUPCD
- IQ(KOFUCD+LBKYCD+NDK+MKYFRI) = 0
- IQ(KOFUCD+LBKYCD+NDK+MKYCRU) = IQ(KOFUCD+LBKYCD+NDK+MKYCRU)
- + + 1
- IQ(KOFUCD+LBKYCD+NDK+MKYCEV) = IQ(KOFUCD+LBKYCD+NDK+MKYCEV)
- + + 1
- NKB = NKB + 1
- IF (NKB.EQ.1) LBK(1) = LBKYCD
- LFIXCD = LBKYCD
- JBIAS = 0
- IF (IOPKCA.EQ.0) THEN
-#if defined(CERNLIB__P3CHILD)
- IF (IPASP3.EQ.1) CALL CDSTP3 (2, LCOND, NBKYP3, 0)
-#endif
- CALL VZERO (KEYVCK, NWKYCK)
- KEYVCK(IDHKSN) = IK
- IOKYCA(IDHKSN) = 1
- CALL CDKXIN (ITIME, IDIVCD, LAUXCL(9), LBKYCD, -KLDACD,
- + NWKEY, KEYVCK, IPREC, IRC)
- IOKYCA(IDHKSN) = 0
- LAUXCL(9) = 0
- IQ(KOFUCD+LBKYCD+NDK+MKYPRE) = IPREC
- IQ(KOFUCD+LBKYCD+NDK+MKYRID) =IQ(KOFUCD+LBKYCD+NDK+MKYRID)
- + + 1
- ENDIF
- CALL UCOPY (KEYVCK(1), IQ(KOFUCD+LBKYCD+1), NWKYCK)
- DO 25 I = 1, NPARCD-1
- IQ(KOFUCD+LBKYCD+NWKYCK+I) =IQ(KOFUCD+LBKYCD+NOF1CK+2*I-1)
- 25 CONTINUE
- IQ(KOFUCD+LBKYCD+NWKYCK+NPARCD) =
- + IQ(KOFUCD+LBKYCD+NOF1CK+2*NPARCD-1) + 1
- IOKYCA(IDHKSN) = 0
- IF (IRC.NE.0) GO TO 999
- IF (IOPSCA.EQ.0) THEN
- IQUEST(2) = NKB
- GO TO 999
- ENDIF
- 30 CONTINUE
- CALL RZCDIR (PATHY, ' ')
- IF (IQUEST(1).NE.0) THEN
- IRC = 2
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDGETDB : Il'//
- + 'legal path name '//PATHY//''')', IARGCD, 0)
-#endif
- GO TO 999
- ENDIF
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- 40 CONTINUE
-*
- ENDIF
-*
- 998 IQUEST(2) = NKB
-#if defined(CERNLIB__P3CHILD)
-*
- CALL CDUSP3 ('CDGETDB', ITIME, IRC)
-#endif
-*
- 999 CONTINUE
-#if defined(CERNLIB__P3CHILD)
- IF (LNK3P3.NE.0) CALL MZDROP (IXDBP3, LNK3P3, '....')
- LNK3P3 = 0
- LNK4P3 = 0
- LNK5P3 = 0
- NBKYP3 = 0
- NDIRP3 = 0
- IPASP3 = 0
-#endif
-* END CDGETDB
- END
diff --git a/src/packlib/hepdb/cdread/cdkeyb.F b/src/packlib/hepdb/cdread/cdkeyb.F
deleted file mode 100644
index 9a2f883..0000000
--- a/src/packlib/hepdb/cdread/cdkeyb.F
+++ /dev/null
@@ -1,97 +0,0 @@
-*
-* $Id: cdkeyb.F,v 1.1.1.1 1996/02/28 16:24:27 mclareni Exp $
-*
-* $Log: cdkeyb.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:27 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDKEYB (KEYS, LBK, ITIME, IRC)
-* =========================================
-*
-************************************************************************
-* *
-* SUBR. CDKEYB (KEYS, LBK*, ITIME, IRC*) *
-* *
-* Creates or completes the Key banks supported as next of same type *
-* to the Node bank *
-* *
-* Arguments : *
-* *
-* KEYS Vector of keys *
-* LBK Address(es) of Keys bank(s) KYCD *
-* ITIME Time for which the valid keys are required *
-* (in option S) *
-* IRC Return code (see below) *
-* *
-* Called by CDUSEM *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* Could be set to nonzero by some routines called *
-* *
-************************************************************************
-*
-#include "hepdb/caopts.inc"
-#include "hepdb/cdcblk.inc"
-#include "hepdb/ckkeys.inc"
- PARAMETER (NZ=0)
- DIMENSION KEYS(9), LBK(9), ITIME(9)
-*
-* ------------------------------------------------------------------
-*
- IRC = 0
- IF (IOPMCA.NE.0) THEN
-*
-* *** For M option no action to be taken
-*
- ELSE IF (IOPSCA.NE.0) THEN
-*
-* *** For S-Option call CDBKKS
-*
- CALL CDBKKS (KEYS, LBK, ITIME, IRC)
-*
- ELSE
-*
-* *** Book a single bank if does not exist
-*
- LSAVCD = LBNOCD
- JBIAS = -KLKYCD
- ND = IQ(KOFUCD+LSAVCD+MNDNWD)
- LBKYCD = LQ(KOFUCD+LSAVCD-KLKYCD)
- 10 IF (LBKYCD.NE.0) THEN
- IF (NWKYCK.GT.NSYSCK) THEN
- DO 15 I = NSYSCK+1, NWKYCK
- IF (IOKYCA(I).NE.0) THEN
- IF (KEYS(I).NE.IQ(KOFUCD+LBKYCD+I)) GO TO 20
- ENDIF
- 15 CONTINUE
- GO TO 25
- ELSE
- GO TO 25
- ENDIF
- 20 LSAVCD = LBKYCD
- LBKYCD = LQ(KOFUCD+LSAVCD)
- JBIAS = 0
- GO TO 10
- ELSE
-*
-* * The Key bank does not exist, create it
-*
- CALL UCOPY (IQ(KOFUCD+LBNOCD+MNDIOF), IOKYCD, NWNOCD)
- CALL CDBANK (IDIVCD, LBKYCD, LSAVCD, JBIAS, 'KYCD', NLKYCD,
- + NSKYCD, ND, IOKYCD, NZ, IRC)
- IF (IRC.NE.0) GO TO 999
- LQ(KOFUCD+LBKYCD-KLNOCD) = LBNOCD
- LQ(KOFUCD+LBKYCD-KLUPCD) = LBUPCD
- ENDIF
-*
- 25 LBK(1) = LBKYCD
- DO 30 I = 1, NWKYCK
- IF (IOKYCA(I).NE.0) IQ(KOFUCD+LBKYCD+I) = KEYS(I)
- 30 CONTINUE
- ENDIF
-* END CDKEYB
- 999 END
diff --git a/src/packlib/hepdb/cdread/cdkmld.F b/src/packlib/hepdb/cdread/cdkmld.F
deleted file mode 100644
index 624da99..0000000
--- a/src/packlib/hepdb/cdread/cdkmld.F
+++ /dev/null
@@ -1,61 +0,0 @@
-*
-* $Id: cdkmld.F,v 1.1.1.1 1996/02/28 16:24:26 mclareni Exp $
-*
-* $Log: cdkmld.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:26 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDKMLD (NK, KEYS)
-* ============================
-*
-************************************************************************
-* *
-* SUBR. CDKMLD (NK, KEYS) *
-* *
-* Loads the key vector in KYVMCK in the context of M option *
-* *
-* Arguments : *
-* *
-* NK Occurence number of the object *
-* KEYS Vector of keys *
-* *
-* Called by CDFREE, CDKYDB *
-* *
-************************************************************************
-*
-#include "hepdb/ckkeys.inc"
-#include "hepdb/cmulop.inc"
- DIMENSION KEYS(9)
-*
-* ------------------------------------------------------------------
-*
- IF (NMULCM.GT.0) THEN
-*
-* ** For option 'M', find the corresponding key values
-*
- CALL UCOPY (KEYS, KYVMCK, NSYSCK)
- DO 20 I = 1, NMULCM
- NK0 = NK
- NU = KTYPCM(I)
- IF (I.NE.1) THEN
- DO 10 J = 1, I-1
- NK0 = (NK0 - INDXCM(J)) / NOCCCM(J) + 1
- 10 CONTINUE
- ENDIF
- NK0 = MOD (NK0, NOCCCM(I))
- IF (NK0.EQ.0) NK0 = NOCCCM(I)
- INDXCM(I) = NK0
- KYVMCK(NU) = KEYS(LFKYCM(I)+NK0)
- 20 CONTINUE
-*
- ELSE
-*
-* ** For standard option, copy the KEYS vector
-*
- CALL UCOPY (KEYS, KYVMCK, NWKYCK)
-*
- ENDIF
-* END CDKMLD
- END
diff --git a/src/packlib/hepdb/cdread/cdkmul.F b/src/packlib/hepdb/cdread/cdkmul.F
deleted file mode 100644
index ab7a311..0000000
--- a/src/packlib/hepdb/cdread/cdkmul.F
+++ /dev/null
@@ -1,103 +0,0 @@
-*
-* $Id: cdkmul.F,v 1.1.1.1 1996/02/28 16:24:26 mclareni Exp $
-*
-* $Log: cdkmul.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:26 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDKMUL (KEYS, NKYMX, IRC)
-* ====================================
-*
-************************************************************************
-* *
-* SUBR. CDKMUL (KEYS, NKYMX*, IRC*) *
-* *
-* Computes total number of objects to be retrieved in the context *
-* of M option *
-* *
-* Arguments : *
-* *
-* KEYS Vector of keys *
-* NKYMX Total number of banks to be retrieved *
-* IRC Return code (see below) *
-* *
-* Called by CDFREE, CDKYDB *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* = 21 : Too many keys with option M *
-* = 22 : Illegal key option *
-* *
-************************************************************************
-*
-#include "hepdb/caopts.inc"
-#include "hepdb/cdcblk.inc"
-#include "hepdb/ckkeys.inc"
-#include "hepdb/cmulop.inc"
- PARAMETER (NZ=0)
- DIMENSION KEYS(9)
-*
-* ------------------------------------------------------------------
-*
- IRC = 0
- NKYMX = 1
-*
-* *** Get number of key banks needed
-*
- NMULCM = 0
- ISTKY = NWKYCK
- IF (IOPMCA.NE.0) THEN
- IF (NWKYCK.GT.NSYSCK) THEN
- DO 10 I = NSYSCK+1, NWKYCK
- IF (IOKYCA(I).NE.0) THEN
- IF (NMULCM.GE.NMLMCM) THEN
-*
-* ** Too many keys with option M
-*
- IRC = 21
- IQUEST(11) = NMLMCM + 1
- IQUEST(12) = I
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDKMUL :'//
- + ' Too many keys '',I3,'' with M option - Last Key'',I3)'
- +, IQUEST(11), 2)
-#endif
- GO TO 999
- ENDIF
-*
- IF (KEYS(I).LE.0) THEN
-*
-* ** Illegal key option
-*
- IRC = 22
- IQUEST(11) = I
- IQUEST(12) = KEYS(I)
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) THEN
- IARGCD(1) = IQUEST(12)
- IARGCD(2) = IQUEST(11)
- CALL CDPRNT (LPRTCD, '(/,'' CDKMUL : Illegal key op'//
- + 'tion '',I3,'' for key '',I3,'' with option M'')'
- +, IARGCD, 2)
- ENDIF
-#endif
- GO TO 999
- ENDIF
-*
-* ** Build up the array of keys used for option M
-*
- NMULCM = NMULCM + 1
- NOCCCM(NMULCM) = KEYS(I)
- LFKYCM(NMULCM) = ISTKY
- KTYPCM(NMULCM) = I
- ISTKY = ISTKY + KEYS(I)
- NKYMX = NKYMX * KEYS(I)
- ENDIF
- 10 CONTINUE
- ENDIF
- ENDIF
-* END CDKMUL
- 999 END
diff --git a/src/packlib/hepdb/cdread/cdksel.F b/src/packlib/hepdb/cdread/cdksel.F
deleted file mode 100644
index eb84247..0000000
--- a/src/packlib/hepdb/cdread/cdksel.F
+++ /dev/null
@@ -1,240 +0,0 @@
-*
-* $Id: cdksel.F,v 1.1.1.1 1996/02/28 16:24:26 mclareni Exp $
-*
-* $Log: cdksel.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:26 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDKSEL (ITIME, KEYS, KEYV, IFLG, ISEL, INBR)
-* =======================================================
-*
-************************************************************************
-* *
-* SUBR. CDKSEL (ITIME, KEYS, KEYV, IFLG, ISEL*, INBR*) *
-* *
-* Select an object depending on the options *
-* *
-* Arguments : *
-* *
-* ITIME Vector with the selection time *
-* KEYS User key vector for selection *
-* KEYV Key vector of the partition *
-* IFLG 0 if selection required only; -1 if logical end of *
-* validity to be done; 1 if also neighbours needed; *
-* 99 no selection on range of validity *
-* ISEL 0 if the object is selected; 1 if not *
-* INBR 0 if the object is the nearest neighbour; 1 if not *
-* *
-* Called by CDCHKY, CDGETDB,CDKYSE, CDSEKY *
-* *
-************************************************************************
-*
-#include "hepdb/caopts.inc"
-#include "hepdb/cdcblk.inc"
-#include "hepdb/ckkeys.inc"
-#include "hepdb/ctkxin.inc"
- DIMENSION ITIME(10), KEYS(10), KEYV(10), ICLOS(MXPACD)
-#include "zebra/q_jbit.inc"
-* Ignoring t=pass
-* ------------------------------------------------------------------
-*
-* *** Decide if the partitition keys to be updated
-*
- ISEL = 1
- INBR = 1
-*
-* Selection on insertion time
-*
- IF (IOKYCA(IDHINS).NE.0.AND.KEYV(IDHINS).GT.KEYS(IDHINS))GO TO 999
-*
-* Selection on 'experiment' keys
-*
- IF (IOKYCA(IDHUSI).NE.0.AND.KEYV(IDHUSI).NE.KEYS(IDHUSI))GO TO 999
- IF (IOKYCA(IDHSRN).NE.0.AND.KEYV(IDHSRN).NE.KEYS(IDHSRN))GO TO 999
- IF (IOKYCA(IDHEX1).NE.0.AND.KEYV(IDHEX1).NE.KEYS(IDHEX1))GO TO 999
- IF (IOKYCA(IDHEX2).NE.0.AND.KEYV(IDHEX2).NE.KEYS(IDHEX2))GO TO 999
- IF (IOKYCA(IDHEX3).NE.0.AND.KEYV(IDHEX3).NE.KEYS(IDHEX3))GO TO 999
-*
- IF (MXINCD.GT.0 .AND.KEYV(IDHINS).GT.MXINCD) GO TO 999
-*
- IF (NWKYCK.GT.NSYSCK) THEN
- DO 10 J = NSYSCK+1, NWKYCK
- IF (IOKYCA(J).NE.0.AND.KEYV(J).NE.KEYS(J)) GO TO 999
- 10 CONTINUE
- ENDIF
- IF (IFLG.EQ.99) GO TO 100
-*
- IF (IPRBCA.EQ.0.AND.IPRECA.EQ.0) THEN
-*
- IBEG = 0
- IEND = 0
- DO 15 I = 1, NPARCD
- IF (IHFLCD.EQ.0) THEN
- IF (IBEG.EQ.0) THEN
- IF (ITIME(I).LT.KEYV(NOF1CK+2*I-1)) IBEG =-I
- IF (ITIME(I).GT.KEYV(NOF1CK+2*I-1)) IBEG = I
- ENDIF
- IF (IEND.EQ.0) THEN
- IF (ITIME(I).GT.KEYV(NOF1CK+2*I)) IEND =-I
- IF (ITIME(I).LT.KEYV(NOF1CK+2*I)) IEND = I
- ENDIF
- ELSE
- IF (IBEG.EQ.0) THEN
- IF (ITIME(I).LT.KEYV(NOF1CK+2*I-1)) IBEG =-I
- ENDIF
- IF (IEND.EQ.0) THEN
- IF (ITIME(I).GT.KEYV(NOF1CK+2*I)) IEND =-I
- ENDIF
- ENDIF
- 15 CONTINUE
- IF (IFLG.EQ.0.AND.(IBEG.LT.0.OR.IEND.LT.0)) GO TO 999
-*
-* ** If satisfied on end-validity criteria, use it for determining
-* ** logical end-validity
-*
- IF (IBEG.LT.0.AND.IEND.GE.0) THEN
- IF (IHFLCD.EQ.0) THEN
- KYEN = 0
- DO 20 I = 1, NPARCD
- IF (KYEN.EQ.0) THEN
- IF (KYENCD(I).LT.KEYV(NOF1CK+2*I-1)) KYEN =-1
- IF (KYENCD(I).GT.KEYV(NOF1CK+2*I-1)) KYEN = 1
- ENDIF
- 20 CONTINUE
- IF (KYEN.GE.0) THEN
- DO 25 I = 1, NPARCD
- KYENCD(I) = KEYV(NOF1CK+2*I-1)
- 25 CONTINUE
- ENDIF
- ELSE
- DO 30 I = 1, NPARCD
- IF (KYENCD(I).GT.KEYV(NOF1CK+2*I-1)) THEN
- KYENCD(I) = KEYV(NOF1CK+2*I-1)
- ENDIF
- 30 CONTINUE
- ENDIF
- ENDIF
- IF (IFLG.LT.0.AND.(IBEG.LT.0.OR.IEND.LT.0)) GO TO 999
-*
-* ** Closest neighbour if not selected
-*
- IF (IBEG.LT.0.OR.IEND.LT.0) THEN
- IF (JBIT(KEYNCK(IDHFLG),JIGNCD).NE.0) GO TO 999
- IF (IBEG.LT.0) THEN
- IBG1 = -IBEG
- ELSE
- IBG1 = MXPACD
- ENDIF
- IF (IEND.LT.0) THEN
- IEN1 = -IEND
- ELSE
- IEN1 = MXPACD
- ENDIF
- DO 35 I = 1, MIN(IBG1,IEN1)
- ICLOS(I) = 0
- 35 CONTINUE
- IF (IBG1.GT.IEN1) THEN
- ICLOS(IEN1) = ITIME(IEN1) - KEYV(NOF1CK+2*IEN1)
- ELSE IF (IBG1.LT.IEN1) THEN
- ICLOS(IBG1) = KEYV(NOF1CK+2*IBG1-1) - ITIME(IBG1)
- ELSE
- ICLOS(IBG1) = MIN ((KEYV(NOF1CK+2*IBG1-1) - ITIME(IBG1)),
- + (ITIME(IEN1) - KEYV(NOF1CK+2*IEN1)) )
- ENDIF
- DO 40 I = 1, NPARCD
- IF (ICLOS(I).LT.INRSCT(I)) INBR = 0
- 40 CONTINUE
- IF (INBR.EQ.0) THEN
- DO 45 I = 1, NPARCD
- INRSCT(I) = ICLOS(I)
- 45 CONTINUE
- ENDIF
- GO TO 999
- ENDIF
-*
- ELSE IF (IPRBCA.GT.0.AND.IPRECA.EQ.0) THEN
-*
- IF (IHFLCD.EQ.0) THEN
- IBEG = 0
- DO 50 I = 1, NPARCD
- IF (IBEG.EQ.0) THEN
- IF (KEYV(NOF1CK+2*I-1).GT.KEYS(NOF1CK+2*I-1)) GO TO 999
- IF (KEYV(NOF1CK+2*I-1).LT.KEYS(NOF1CK+2*I-1)) IBEG = 1
- ENDIF
- 50 CONTINUE
- ELSE
- DO 55 I = 1, NPARCD
- IF (KEYV(NOF1CK+2*I-1).GT.KEYS(NOF1CK+2*I-1)) GO TO 999
- 55 CONTINUE
- ENDIF
-*
- ELSE IF (IPRBCA.EQ.0.AND.IPRECA.GT.0) THEN
-*
- IF (IHFLCD.EQ.0) THEN
- IEND = 0
- DO 60 I = 1, NPARCD
- IF (IEND.EQ.0) THEN
- IF (KEYV(NOF1CK+2*I) .LT.KEYS(NOF1CK+2*I)) GO TO 999
- IF (KEYV(NOF1CK+2*I) .GT.KEYS(NOF1CK+2*I)) IEND = 1
- ENDIF
- 60 CONTINUE
- ELSE
- DO 65 I = 1, NPARCD
- IF (KEYV(NOF1CK+2*I) .LT.KEYS(NOF1CK+2*I)) GO TO 999
- 65 CONTINUE
- ENDIF
-*
- ELSE IF (IPRBCA.GT.0.AND.IPRECA.GT.0) THEN
-*
- IF (IHFLCD.EQ.0) THEN
- IBEG = 0
- IEND = 0
- DO 70 I = 1, NPARCD
- IF (IBEG.EQ.0) THEN
- IF (KEYV(NOF1CK+2*I-1).GT.KEYS(NOF1CK+2*I-1)) GO TO 999
- IF (KEYV(NOF1CK+2*I-1).LT.KEYS(NOF1CK+2*I-1)) IBEG = 1
- ENDIF
- IF (IEND.EQ.0) THEN
- IF (KEYV(NOF1CK+2*I) .LT.KEYS(NOF1CK+2*I)) GO TO 999
- IF (KEYV(NOF1CK+2*I) .GT.KEYS(NOF1CK+2*I)) IEND = 1
- ENDIF
- 70 CONTINUE
- ELSE
- DO 75 I = 1, NPARCD
- IF (KEYV(NOF1CK+2*I-1).GT.KEYS(NOF1CK+2*I-1)) GO TO 999
- IF (KEYV(NOF1CK+2*I) .LT.KEYS(NOF1CK+2*I)) GO TO 999
- 75 CONTINUE
- ENDIF
-*
- ELSE
-*
- IF (IHFLCD.EQ.0) THEN
- IBEG = 0
- IEND = 0
- DO 80 I = 1, NPARCD
- IF (IBEG.EQ.0.AND.IPRBCA.NE.0) THEN
- IF (KEYV(NOF1CK+2*I-1).LT.KEYS(NOF1CK+2*I-1)) GO TO 999
- IF (KEYV(NOF1CK+2*I-1).GT.KEYS(NOF1CK+2*I-1)) IBEG = 1
- ENDIF
- IF (IEND.EQ.0.AND.IPRECA.NE.0) THEN
- IF (KEYV(NOF1CK+2*I-1).GT.KEYS(NOF1CK+2*I)) GO TO 999
- IF (KEYV(NOF1CK+2*I-1).LT.KEYS(NOF1CK+2*I)) IEND = 1
- ENDIF
- 80 CONTINUE
- ELSE
- DO 85 I = 1, NPARCD
- IF (IPRBCA.NE.0) THEN
- IF (KEYV(NOF1CK+2*I-1).LT.KEYS(NOF1CK+2*I-1)) GO TO 999
- ENDIF
- IF (IPRECA.NE.0) THEN
- IF (KEYV(NOF1CK+2*I-1).GT.KEYS(NOF1CK+2*I)) GO TO 999
- ENDIF
- 85 CONTINUE
- ENDIF
- ENDIF
-*
- 100 ISEL = 0
-* END CDKSEL
- 999 END
diff --git a/src/packlib/hepdb/cdread/cdkxin.F b/src/packlib/hepdb/cdread/cdkxin.F
deleted file mode 100644
index 3b52cc1..0000000
--- a/src/packlib/hepdb/cdread/cdkxin.F
+++ /dev/null
@@ -1,387 +0,0 @@
-*
-* $Id: cdkxin.F,v 1.1.1.1 1996/02/28 16:24:26 mclareni Exp $
-*
-* $Log: cdkxin.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:26 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
-#if defined(CERNLIB__P3CHILD)
-* Ignoring t=dummy
-#endif
- SUBROUTINE CDKXIN (ITIME, IUDIV, LU, LSUP, JBIAS, NWKEY, KEY,
- + IPREC, IRC)
-* =============================================================
-*
-************************************************************************
-* *
-* SUBR. CDKXIN (ITIME, IUDIV, LU*, LSUP, JBIAS, NWKEY*, *KEY*, *
-* IPREC*, IRC*) *
-* *
-* Fetches from disk to a ZEBRA bank data valid for a given time *
-* *
-* Restrictions : This routine is called internally by other routines *
-* in HEPDB. One should be very careful in using this *
-* routine. For example, the character option for *
-* special selection scheme like options S or N in *
-* CDUSEM is not present in this routine and they can *
-* be switched on or off only by a prior call to CDUSEM*
-* *
-* Arguments : *
-* *
-* ITIME Time for which data are required to be valid *
-* IUDIV Division index where bank is expected *
-* LU Address of the bank in memory *
-* LSUP Supporting link of the bank (see MZBOOK) *
-* JBIAS Link bias for creating the data bank (see MZBOOK) *
-* NWKEY Number of key elements *
-* KEY Vector of keys (On input if any key beyond element 8 or *
-* element 5 is nonzero,data are retrieved according to its*
-* content; on output it contains the key elements for the *
-* current data) *
-* IPREC Precision word; (If IPREC > 0, data are stored with *
-* IPREC significant digits right to the decimal points; if*
-* IPREC < 0, data are stored with IPREC insignificant *
-* digits left to the decimal point.) *
-* IRC Return code (see below) *
-* *
-* Called by CDCHCK, CDGETDB,CDGNAM, CDPART, CDPRDT, CDPURK, CDRHLP, *
-* CDRNAM, CDRTFZ, CDUSP3 *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* = 31 : Illegal Pathname *
-* = 33 : No valid data for the given set of keys and *
-* program version number *
-* = 35 : Wrong reference to data objects in update mode *
-* *
-************************************************************************
-*
-#include "hepdb/caopts.inc"
-#include "hepdb/cdcblk.inc"
-#include "hepdb/ckkeys.inc"
-#include "hepdb/clinks.inc"
-#include "hepdb/ctkxin.inc"
-#include "hepdb/ctpath.inc"
-#if defined(CERNLIB__P3CHILD)
-#include "hepdb/p3dbl3.inc"
-#endif
- DIMENSION ITIME(9), KEY(9), LSUP(9), LU(9)
- CHARACTER PATHN*80
-#include "zebra/q_jbit.inc"
-* Ignoring t=pass
-*
-* ------------------------------------------------------------------
-*
-#if defined(CERNLIB__P3CHILD)
- IF (IPASP3.GT.1) THEN
- IKYLCT = KEY(IDHKSN)
- IPRVCT = IKYLCT
- NWKYCK = NWKEY
- CALL UCOPY (KEY, KEYNCK, NWKEY)
- GO TO 5
- ENDIF
-#endif
- IPRVCT = KEY(IDHUSI)
- NWKEY = NWKYCK
- NKEYS = NKEYCK
- CALL RZCDIR (PATHN, 'R')
- MAXL = LENOCC (PATHN)
-*
-* *** Check the validity limits from the Keys
-*
- 5 NTIMCT = 0
- MNKYCT = -999
- DO 10 I = 1, NPARCD
- KYENCD(I) = IBIGCD
- INRSCT(I) = 100000
- 10 CONTINUE
- IDNRCT = 0
- KEY6CT = 0
- KY6NCT = 0
- ICURCT = 1
- ISTP = NWKYCK + 1
-#if defined(CERNLIB__P3CHILD)
- IF (IPASP3.GT.1) GO TO 40
-#endif
- IOPTP = JBIT (IQ(KOFSCD+LCDRCD+IKDRCD+IDHFLG), JPRTCD)
-*
-* *** Select by the key number
-*
- IF (IOKYCA(IDHKSN).NE.0) THEN
- IKYLCT = KEY(IDHKSN)
- IPRVCT = IKYLCT
-*
- IF (IOPTP.EQ.0) THEN
-*
- IF (IKYLCT.GT.0 .AND. IKYLCT.LE.NKEYCK) THEN
- GO TO 35
- ELSE
- GO TO 993
- ENDIF
-*
- ELSE
-*
- DO 15 JK = 1, NKEYCK
- IK = NKEYCK + 1 - JK
- KPNT = IUHUNT (IK, IQ(KOFSCD+LCDRCD+IKDRCD+MPSRCD),
- + NKEYCK*ISTP, ISTP)
- IF (KPNT.NE.0) THEN
- IPNT = KOFSCD + LCDRCD + IKDRCD + KPNT - MPSRCD
- ELSE
- IPNT = KOFSCD + LCDRCD + IKDRCD + (IK - 1) * ISTP
- ENDIF
- KEY5 = IQ(IPNT+MOBJCD)
- IF (IKYLCT.GT.KEY5) GO TO 20
- 15 CONTINUE
- GO TO 993
- 20 KOFF = KEY5
- CALL CDPATH (TOP2CT, IK)
- CALL RZCDIR (TOP2CT, ' ')
- IF (IQUEST(1).NE.0) GO TO 991
- IKYLCT = KEY(IDHKSN) - KOFF
-*
-* Check not valid in case of deleted keys
-*
-* IF (IKYLCT.GT.IQUEST(7)) THEN
-* GO TO 993
-* ELSE
- NKEYCK = IQUEST(7)
- NWKYCK = IQUEST(8)
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- CALL CDKEYT
- ISTP = NWKYCK + 1
- GO TO 35
-* ENDIF
- ENDIF
-*
- ENDIF
-*
-* *** Select by the Key values
-*
- IF (IOPTP.EQ.0) THEN
-*
- CALL CDSEKY (ITIME, KEY)
-*
- ELSE
-*
- DO 25 JK = 1, NKEYS
- ICURCT = NKEYS + 1 - JK
- CALL CDPATH (TOP2CT, ICURCT)
- IF (JK.NE.1) THEN
- CALL RZCDIR (PATHN, ' ')
- IF (IQUEST(1).NE.0) GO TO 991
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- ENDIF
- KPNT = IUHUNT (ICURCT, IQ(KOFSCD+LCDRCD+IKDRCD+MPSRCD),
- + NKEYS*ISTP, ISTP)
- IF (KPNT.NE.0) THEN
- IPNT = KOFSCD + LCDRCD + IKDRCD + KPNT - MPSRCD
- ELSE
- IPNT = KOFSCD + LCDRCD + IKDRCD + (ICURCT - 1) * ISTP
- ENDIF
- CALL CDPSEL (ITIME, KEY, IQ(IPNT+1), 0, ISEL)
- IF (ISEL.NE.0) GO TO 25
-*
- CALL RZCDIR (TOP2CT, ' ')
- IF (IQUEST(1).NE.0) GO TO 991
- NKEYCK = IQUEST(7)
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- CALL CDSEKY (ITIME, KEY)
- IF (NTIMCT.NE.0 .AND. JBIT(KEY6CT,JIGNCD).EQ.0) GO TO 30
-*
- 25 CONTINUE
-*
- ENDIF
-*
-* *** Check if valid data exist
-*
- 30 ISTP = NWKYCK + 1
- IF (NTIMCT.EQ.0 .OR. JBIT(KEY6CT,JIGNCD).NE.0) THEN
-*
- IF (KY6NCT.NE.0) THEN
- IKYLCT = KY6NCT
-*
- ELSE IF (IOPNCA.NE.0 .AND. IDNRCT.NE.0) THEN
-*
-* ** Take the nearest neighbour
-*
- NTIMCT = -1
- IKYLCT = IDNRCT
- IF (IOPTP.NE.0 .AND. IUSECT.NE.ICURCT) THEN
- CALL CDPATH (TOP2CT, IUSECT)
- PAT2CT = PATHN(1:MAXL)//'/'//TOP2CT
- CALL RZCDIR (PAT2CT, ' ')
- IF (IQUEST(1).NE.0) GO TO 991
- NKEYCK = IQUEST(7)
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- ENDIF
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.1) THEN
- IPNT = KOFSCD + LCDRCD + IKDRCD + (IDNRCT - 1) * ISTP
- IARGCD(1) = ITIME(1)
- IARGCD(2) = IQ(IPNT+NOF1CK+1)
- IARGCD(3) = IQ(IPNT+NOF1CK+2)
- CALL CDPRNT (LPRTCD, '(/,'' CDKXIN : Warning --> Data val'//
- + 'id at time '',I10,'' does not exist. Data valid bet'//
- + 'ween '',2I10,'' are returned'')', IARGCD, 3)
- ENDIF
-#endif
-*
- ELSE
-*
-* ** None exists; return with error message
-*
- GO TO 993
-*
- ENDIF
-*
- ENDIF
-*
-* *** Read in the data
-*
- 35 ICYCL = 9999
- CALL CDKEYR (IKYLCT, NWKYCK, KEYNCK)
- 40 KEY6CT = KEYNCK(IDHFLG)
- IF (JBIT(KEY6CT,JIGNCD).NE.0) GO TO 993
- KEY(IDHKSN) = IKYLCT
- LSTRCL(2) = 0
- IF (NTIMCT.EQ.-1) THEN
- DO 45 I = 1, NPARCD-1
- KYENCD(I) = KEYNCK(NOF1CK+2*I-1)
- 45 CONTINUE
- KYENCD(NPARCD) = KEYNCK(NOF1CK+2*NPARCD-1) + 1
- ENDIF
-*
- IF (IOPKCA.NE.0) THEN
-*
-* ** Only the keys are needed
-*
- CALL UCOPY (KEYNCK, KEY, NWKYCK)
-*
- ELSE IF (JBIT(KEY6CT,JRZUCD) .NE. 0) THEN
-*
-* ** Data are stored in RZ way
-*
- LSTRCL(2) = LSUP(1)
- CALL CDRZIN (IUDIV, LSTRCL(2), JBIAS, KEY, ICYCL, PATHN, IRC)
- LSUP(1) = LSTRCL(2)
- LSTRCL(2) = 0
- IF (JBIAS.GT.0) THEN
- LU(1) = LSUP(1)
- ELSE
- LU(1) = LQ(KOFUCD+LSUP(1)+JBIAS)
- ENDIF
- IF (IRC.NE.0) GO TO 998
-*
- CALL UCOPY (KEYNCK, KEY, NWKYCK)
-*
- ELSE
-*
-* ** Read in standard DB format
-*
- CALL CDRZIN (IDISCD, LSTRCL(2), 2, KEY, ICYCL, PATHN, IRC)
- IF (IRC.NE.0) GO TO 998
- CALL UCOPY (KEYNCK, KEY, NWKYCK)
-*
-* ** If the data is update - uncompress and proceed updating
-*
- IF (KEY(IDHPTR).NE.0) THEN
-#if defined(CERNLIB__P3CHILD)
- IF (IPASP3.EQ.2) THEN
- IK = 1
- GO TO 55
- ENDIF
-#endif
- DO 50 I = 1, NKEYCK
- IPNT = KOFSCD + LCDRCD + IKDRCD + ISTP * (I-1)
- IF (KEY(IDHPTR).EQ.IQ(IPNT+IDHKSN)) THEN
- IK = I
-#if defined(CERNLIB__P3CHILD)
- IF (IPASP3.EQ.1) THEN
- IRC = 0
- CALL CDRZIN (IDISCD, LREFCD(5), 2, IK, ' ', IRC)
- GO TO 998
- ENDIF
-#endif
- GO TO 55
- ENDIF
- 50 CONTINUE
- GO TO 995
-*
- 55 CALL CDUNCP (LSTRCL(2), LREFCL(3), IK, IRC)
- ELSE
-#if defined(CERNLIB__P3CHILD)
- IF (IPASP3.EQ.1) THEN
- IRC = 0
- GO TO 998
- ENDIF
-#endif
- CALL CDUNCP (LSTRCL(2), LREFCL(3), 0, IRC)
- ENDIF
-*
-* ** Drop the compressed data
-*
- CALL MZDROP (IDISCD, LSTRCL(2), ' ')
- IF (IRC.NE.0) GO TO 998
-*
-* ** Copy from internal Data Base system to user format
-*
- CALL CDTOUS (LREFCL(3), IUDIV, LU(1), LSUP(1),JBIAS, IPREC, IRC)
-*
- CALL MZDROP (IDISCD, LREFCL(3), ' ')
- IF (IRC.NE.0) GO TO 998
-*
- ENDIF
- GO TO 998
-*
-* *** Error messages
-*
- 991 IRC = 31
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDKXIN : Illegal '//
- + 'path name '//PATHN//TOP2CT(1:8)//''')', IARGCD, 0)
-#endif
- GO TO 999
-*
- 993 IRC = 33
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) THEN
- IARGCD(1) = IPRVCT
- CALL UCOPY (ITIME, IARGCD(2), NPARCD)
- NARG = MIN (4, NPARCD+1)
- CALL CDPRNT (LPRTCD, '(/,'' CDKXIN : No valid data can be fou'//
- + 'nd for Program Version'',I6,'' and ISEL'',3I10)', IARGCD,
- + NARG)
- ENDIF
-#endif
- GO TO 998
-*
- 995 IRC = 35
- IQUEST(11)= KEY(IDHPTR)
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDKXIN : Key 2 ref'//
- + 'erence '',I4,'' cannot be found among the Key 1 values'')',
- + IQUEST(11), 1)
-#endif
- GO TO 998
-*
- 998 IF (IOPTP.NE.0) THEN
- CALL RZCDIR (PATHN, ' ')
- IF (IQUEST(1).NE.0) THEN
- IF (IRC.EQ.0) GO TO 991
- ELSE
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- NKEYCK = IQUEST(7)
- NWKYCK = IQUEST(8)
- ENDIF
- ENDIF
-* END CDKXIN
- 999 END
diff --git a/src/packlib/hepdb/cdread/cdkydb.F b/src/packlib/hepdb/cdread/cdkydb.F
deleted file mode 100644
index a417fee..0000000
--- a/src/packlib/hepdb/cdread/cdkydb.F
+++ /dev/null
@@ -1,109 +0,0 @@
-*
-* $Id: cdkydb.F,v 1.1.1.1 1996/02/28 16:24:26 mclareni Exp $
-*
-* $Log: cdkydb.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:26 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDKYDB (KEYS, LBK, ITIME, IRC)
-* =========================================
-*
-************************************************************************
-* *
-* SUBR. CDKYDB (KEYS, LBK*, ITIME, IRC*) *
-* *
-* Creates or completes the Key banks supported as next of same type *
-* to the Node bank *
-* *
-* Arguments : *
-* *
-* KEYS Vector of keys *
-* LBK Address(es) of Keys bank(s) KYCD *
-* ITIME Time for which the valid keys are required *
-* (in option S) *
-* IRC Return code (see below) *
-* *
-* Called by CDUSEDB *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* Could be set to nonzero by some routines called *
-* *
-************************************************************************
-*
-#include "hepdb/caopts.inc"
-#include "hepdb/cdcblk.inc"
-#include "hepdb/cinitl.inc"
-#include "hepdb/ckkeys.inc"
-#include "hepdb/cmulop.inc"
-#include "hepdb/ctkxin.inc"
- PARAMETER (NZ=0)
- DIMENSION KEYS(9), LBK(9), ITIME(9)
-*
-* ------------------------------------------------------------------
-*
-* *** Get rid of S option first
-*
- IF (IOPSCA.NE.0) THEN
- CALL CDBKKS (KEYS, LBK, ITIME, IRC)
- GO TO 999
- ENDIF
-*
-* *** Get number of key banks needed
-*
- CALL CDKMUL (KEYS, NKYMX, IRC)
- IF (IRC.NE.0) GO TO 999
-*
-* *** Loop over all possible Key Banks
-*
- NK = 0
- 10 NK = NK + 1
-*
-* ** Load the key values to be compared
-*
- CALL CDKMLD (NK, KEYS)
-*
-* ** Check if this Key bank already exists
-*
- LSAVCD = LBNOCD
- JBIAS = -KLKYCD
- ND = IQ(KOFUCD+LSAVCD+MNDNWD)
- LBKYCD = LQ(KOFUCD+LSAVCD-KLKYCD)
- 15 IF (LBKYCD.NE.0) THEN
- IF (NWKYCK.GT.NSYSCK) THEN
- DO 20 I = NSYSCK+1, NWKYCK
- IF (IOKYCA(I).NE.0) THEN
- IF (KYVMCK(I).NE.IQ(KOFUCD+LBKYCD+I)) GO TO 25
- ENDIF
- 20 CONTINUE
- ENDIF
- GO TO 30
- 25 LSAVCD = LBKYCD
- LBKYCD = LQ(KOFUCD+LSAVCD)
- JBIAS = 0
- GO TO 15
- ELSE
-*
-* * The Key bank does not exist, create it
-*
- CALL UCOPY (IQ(KOFUCD+LBNOCD+MNDIOF), IOKYCD, NWNOCD)
- CALL CDBANK (IDIVCD, LBKYCD, LSAVCD, JBIAS, 'KYCD', NLKYCD,
- + NSKYCD, ND, IOKYCD, NZ, IRC)
- IF (IRC.NE.0) GO TO 999
- LQ(KOFUCD+LBKYCD-KLNOCD) = LBNOCD
- LQ(KOFUCD+LBKYCD-KLUPCD) = LBUPCD
- ENDIF
-*
-* *** Copy the key vector into Key bank
-*
- 30 LBK(NK) = LBKYCD
- DO 35 I = 1, NWKYCK
- IF (IOKYCA(I).NE.0) IQ(KOFUCD+LBKYCD+I) = KYVMCK(I)
- 35 CONTINUE
-*
- IF (NK.LT.NKYMX) GO TO 10
-* END CDKYDB
- 999 END
diff --git a/src/packlib/hepdb/cdread/cdkyse.F b/src/packlib/hepdb/cdread/cdkyse.F
deleted file mode 100644
index a68474d..0000000
--- a/src/packlib/hepdb/cdread/cdkyse.F
+++ /dev/null
@@ -1,111 +0,0 @@
-*
-* $Id: cdkyse.F,v 1.1.1.1 1996/02/28 16:24:26 mclareni Exp $
-*
-* $Log: cdkyse.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:26 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDKYSE (KEYS, ITIME, IRC)
-* ====================================
-*
-************************************************************************
-* *
-* SUBR. CDKYSE (KEYS, ITIME, IRC*) *
-* *
-* Creates or completes the Key banks supported as next of same type *
-* to the Node bank for 'S' option *
-* *
-* Arguments : *
-* *
-* KEYS Vector of keys *
-* ITIME Time for which the valid keys are required *
-* IRC Return code (see below) *
-* *
-* Called by CDBKKS *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* Could be set to nonzero by some routines called *
-* *
-************************************************************************
-*
-#include "hepdb/caopts.inc"
-#include "hepdb/cdcblk.inc"
-#include "hepdb/ckkeys.inc"
- PARAMETER (NZ=0)
- DIMENSION KEYS(9), ITIME(9)
-#include "zebra/q_jbit.inc"
-* Ignoring t=pass
-*
-* ------------------------------------------------------------------
-*
- IRC = 0
- IF (LFIXCD.EQ.LBNOCD) THEN
- JBIAS = -KLKYCD
- ELSE
- JBIAS = 0
- ENDIF
- LBKYCD = LSAVCD
- ND = IQ(KOFUCD+LBNOCD+MNDNWD)
- DO 25 JK = 1, NKEYCK
-*
-* * Load the keys for this serial number
-*
- IK = NKEYCK + 1 - JK
- CALL CDKEYR (IK, NWKYCK, KEYNCK)
-*
-* * Use the selection
-*
- CALL CDKSEL (ITIME, KEYS, KEYNCK, -1, ISEL, INBR)
- IF (ISEL.NE.0) GO TO 25
- IF (IPRBCA.EQ.0.AND.IPRECA.EQ.0) THEN
-*
-* ** S option with time validity (Last inserted ones only)
-* ** See if such Key bank already exists
-*
- LBKYCD = LFIXCD
- 10 LBKYCD = LQ(KOFUCD+LBKYCD)
- IF (LBKYCD.NE.0) THEN
- DO 15 I = NOF3CK, NWKYCK
- IF (I.GT.NOF1CK.AND.I.LE.NOF1CK+2*NPARCD) THEN
- GO TO 15
- ELSE IF (I.EQ.IDHFLG.OR.I.EQ.IDHINS) THEN
- GO TO 15
- ELSE
- IF (KEYNCK(I).NE.IQ(KOFUCD+LBKYCD+I)) GO TO 10
- ENDIF
- 15 CONTINUE
- IF (IQ(KOFUCD+LBKYCD+IDHKSN).LT.KEYNCK(IDHKSN)) THEN
- CALL UCOPY (KEYNCK, IQ(KOFUCD+LBKYCD+1), NWKYCK)
- ENDIF
- GO TO 25
- ENDIF
-*
- ELSE
- IF (JBIT(KEYNCK(IDHFLG),JIGNCD).NE.0) GO TO 25
- ENDIF
-*
-* * Create a new Key bank
-*
- CALL UCOPY (IQ(KOFUCD+LBNOCD+MNDIOF), IOKYCD, NWNOCD)
- CALL CDBANK (IDIVCD, LBKYCD, LFIXCD, JBIAS, 'KYCD', NLKYCD,
- + NSKYCD, ND, IOKYCD, NZ, IRC)
- IF (IRC.NE.0) GO TO 999
-*
- LQ(KOFUCD+LBKYCD-KLNOCD) = LBNOCD
- LQ(KOFUCD+LBKYCD-KLUPCD) = LBUPCD
- CALL UCOPY (KEYNCK, IQ(KOFUCD+LBKYCD+1), NWKYCK)
- IF (IPRBCA.EQ.0.AND.IPRECA.EQ.0) THEN
- ELSE
- DO 20 I = 1, NPARCD-1
- IQ(KOFUCD+LBKYCD+NWKYCK+I) = IQ(KOFUCD+LBKYCD+NOF1CK+2*I-1)
- 20 CONTINUE
- IQ(KOFUCD+LBKYCD+NWKYCK+NPARCD) = KEYNCK(NOF1CK+2*NPARCD-1) +1
- ENDIF
-*
- 25 CONTINUE
-* END CDKYSE
- 999 END
diff --git a/src/packlib/hepdb/cdread/cdnode.F b/src/packlib/hepdb/cdread/cdnode.F
deleted file mode 100644
index b481a96..0000000
--- a/src/packlib/hepdb/cdread/cdnode.F
+++ /dev/null
@@ -1,316 +0,0 @@
-*
-* $Id: cdnode.F,v 1.1.1.1 1996/02/28 16:24:26 mclareni Exp $
-*
-* $Log: cdnode.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:26 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
-#if defined(CERNLIB__P3CHILD)
-* Ignoring t=dummy
-#endif
- SUBROUTINE CDNODE (PATHN, IRC)
-* ==============================
-*
-************************************************************************
-* *
-* SUBR. CDNODE (PATHN, IRC*) *
-* *
-* Creates a Node structure in memory for given directory pathname *
-* *
-* Arguments : *
-* *
-* PATHN Character string describing the pathname *
-* IRC Return code (see below) *
-* *
-* Called by CDBOOK, CDGETDB,CDPURK, CDUSE, CDUSEDB,CDUSEM *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* = 12 : Illegal pathname *
-* = 13 : Not enough structural link to support a new Node*
-* = 15 : Cannot define IO descriptor for Key bank *
-* *
-************************************************************************
-*
-#include "hepdb/caopts.inc"
-#include "hepdb/cdcblk.inc"
-#include "hepdb/ckkeys.inc"
-#include "hepdb/ctpath.inc"
- PARAMETER (NLEVM=20, NWFXM=5, MAXD=1)
- CHARACTER CHFRM(5)*1, CFORM*80, CHCUR(NLEVM)*1
- CHARACTER PATHN*(*), PATHY*255, CNODE(NLEVM)*16
- INTEGER NUCUR(NLEVM), NCHL(NLEVM)
- DATA CHFRM / 'B', 'I', 'F', 'D', 'H'/, NZ / 0/
-#include "zebra/q_jbit.inc"
-* Ignoring t=pass
-*
-* ------------------------------------------------------------------
-*
-* *** Sets current directory and Get the full pathname
-*
- CALL CDLDUP (PATHN, 0, IRC)
- IF (IRC.NE.0) GO TO 999
- PATHY = PAT1CT
- MAXL = LENOCC (PATHY)
-*
-* *** Get list of Nodes
-*
- CALL CDPARS (PATHY, NLEVM, CNODE, NCHL, NODES)
-*
-* *** Number of Nodes found should be nonzero
-*
- IF (NODES.EQ.0) THEN
- IRC = 12
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDNODE : Illegal'//
- + ' pathname '//PATHY//''')', IARGCD, 0)
-#endif
- GO TO 999
- ENDIF
-*
-* *** Find the dictionary bank
-*
- IF (LBUPCD.GT.0) THEN
- LBKYCD = LQ(KOFUCD+LBUPCD-KLDICD)
- ELSE
- LBKYCD = 0
- ENDIF
- IF (LBKYCD.NE.0) THEN
- NITEM = IQ(KOFUCD+LBKYCD+MDCNTM)
- ELSE
- NITEM = 0
- ENDIF
-*
-* ** Check if all Nodes already exist in memory
-*
- IN = 0
- 10 IN = IN + 1
-*
-* ** Construct the pathname from the Node names
-*
- NCHAR = 1
- DO 15 I = 1, IN
- NMAX = NCHL (I)
- IF (NCHAR+NMAX .GT. MAXLCD) THEN
- NMAX = MAXLCD - NCHAR - 1
- IF (NMAX.LE.0) GO TO 15
- ENDIF
- NCHAR = NCHAR + NMAX + 1
- IF (NCHAR.EQ.MAXLCD) GO TO 20
- 15 CONTINUE
- 20 PAT4CT = PATHY(1:NCHAR)
-*
-* ** The first Node should be at the top directory
-*
- I0 = 0
- IF (IN.EQ.1) THEN
- NMAX = 1
- ELSE
- NMAX = IQ(KOFUCD+LBNOCD-2)
- ENDIF
-*
- 25 I0 = I0 + 1
-*
-* * No link left to insert a new Node bank
-*
- IF (I0.GT.NMAX) THEN
- IF (IN.EQ.1.OR.IOUTCD.EQ.0) THEN
- IRC = 13
- IQUEST(11) = IN
- IQUEST(12) = NODES
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDNODE : No li'//
- + 'nk left to insert the Node '//CNODE(IN)//' at level '',I3'//
- + ','' out of '',I3)', IQUEST(11), 2)
-#endif
- GO TO 999
-*
- ELSE
-*
- CALL MZPUSH (IDIVCD, LBNOCD, 1, 0, ' ')
- LSAVCD = LBNOCD
- JBIAS = -I0
- IDIC = 0
- GO TO 40
- ENDIF
- ENDIF
-*
- IF (IN.EQ.1) THEN
- LSAVCD = LQ(KOFUCD+LBUPCD-1)
- ELSE
- LSAVCD = LQ(KOFUCD+LBNOCD-I0)
- ENDIF
-*
-* * Check the full pathname in the Node bank name against
-* * the current pathname
-*
- IF (LSAVCD.NE.0) THEN
- MCHAR = IQ(KOFUCD+LSAVCD+MNDNCH)
- IF (MCHAR.GT.MAXLCD) MCHAR = MAXLCD
- CALL UHTOC (IQ(KOFUCD+LSAVCD+MNDNAM), 4, PAT2CT, MCHAR)
- PAT2CT = PAT2CT(1:MCHAR)
- IF (PAT2CT.NE.PAT4CT) GO TO 25
- LBNOCD = LSAVCD
- IF (IN.EQ.NODES) THEN
- CALL RZCDIR (PAT4CT, ' ')
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- NKEYCK = IQUEST(7)
- NWKYCK = IQUEST(8)
- ENDIF
- GO TO 60
- ELSE
-*
-* * Find the dictionary number
-*
- IF (IN.EQ.1) THEN
- IDIC = ITOPCD * 10000
- LSAVCD = LBUPCD
- JBIAS = -1
- ELSE
- LSAVCD = LBNOCD
- JBIAS = -I0
- IDIC = ITOPCD * 10000
- IF (NITEM.GT.0) THEN
- PAT2CT = PAT4CT(NCHL(1)+3:NCHAR)
- MCHAR = NCHAR - NCHL(1) - 2
- DO 30 ITEM = 1, NITEM
- IPNT = KOFUCD + LBKYCD + (ITEM - 1) * NWITCD + 1
- IF (IQ(IPNT+MDCITM).GT.0) THEN
- IF (MCHAR.EQ.IQ(IPNT+MDCNCH)) THEN
- CALL UHTOC (IQ(IPNT+MDCNAM), 4, PAT3CT, MCHAR)
- PAT3CT = PAT3CT(1:MCHAR)
- IF (PAT2CT.EQ.PAT3CT) THEN
- IDIC = IDIC + IQ(IPNT+MDCITM)
- GO TO 35
- ENDIF
- ENDIF
- ENDIF
- 30 CONTINUE
- ENDIF
- 35 CONTINUE
- ENDIF
- ENDIF
-*
-* * The Node bank does not exist; create it
-*
- 40 ND = (NCHAR + 3) / 4
- ND = ND + NWNOCD + 4
- CALL RZCDIR (PAT4CT, ' ')
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- NKEYCK = IQUEST(7)
- NWKYCK = IQUEST(8)
- CALL RZRDIR (MAXD, PAT3CT, NL)
- IF (IQUEST(1).EQ.1) NL = IQUEST(11)
- IF (NKEYCK.GT.0) THEN
- IOPTP = IQ(KOFSCD+LCDRCD+IKDRCD+IDHFLG)
- IOPTP = JBIT (IOPTP, JPRTCD)
- IF (IOPTP.NE.0) THEN
- NL = NL - NKEYCK
- IF (NL.LT.0) NL = 0
- ENDIF
- ENDIF
-*
- CALL CDBANK (IDIVCD, LBNOCD, LSAVCD, JBIAS, 'NOCD', NL, NL, ND,
- + IONOCD, NZ, IRC)
- IF (IRC.NE.0) GO TO 999
-*
-* * Find IO descriptor for the Key banks attached to this Node
-*
- NLEV = 0
- NCUR = 0
- IFORO = 0
- CALL CDKEYT
- DO 50 I = 1, NWKYCK
- IFORM = IOTYCK(I)
- IF (IFORM.EQ.6) IFORM = 5
- IF (IFORM.EQ.IFORO) THEN
- NCUR = NCUR + 1
- ELSE
- IF (NLEV.GT.0) NUCUR(NLEV) = NCUR
- IF (NLEV.GE.NLEVM) THEN
- IRC = 15
- IQUEST(11) = NLEVM
- IQUEST(12) = I
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) THEN
- CALL CDPRNT (LPRTCD, '(/,'' CDNODE : Too many type of'//
- + ' variables for IO descriptor of Key bank at Key'//
- + ' '',I3,'' Maximum level '',I3)', IQUEST(11), 2)
- ENDIF
-#endif
- GO TO 999
- ENDIF
- NLEV = NLEV + 1
- CHCUR(NLEV) = CHFRM(IFORM)
- NCUR = 1
- IFORO = IFORM
- ENDIF
- 50 CONTINUE
-*
- IF (NLEV.GT.0) THEN
- NUCUR(NLEV) = NCUR
- IF (CHCUR(NLEV).EQ.CHFRM(2)) THEN
- NUCUR(NLEV) = NCUR + NWFXM + NPARCD
- ELSE
- IF (NLEV.GE.NLEVM) THEN
- IRC = 15
- IQUEST(11) = NLEVM
- IQUEST(12) = NWKYCK + 1
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) THEN
- CALL CDPRNT (LPRTCD, '(/,'' CDNODE : Too many type of'//
- + ' variables for IO descriptor of Key bank at Key'//
- + ' '',I3,'' Maximum level '',I3)', IQUEST(11), 2)
- ENDIF
-#endif
- GO TO 999
- ENDIF
- NLEV = NLEV + 1
- CHCUR(NLEV) = CHFRM(2)
- NUCUR(NLEV) = NWFXM + NPARCD
- ENDIF
- ELSE
- NLEV = 1
- CHCUR(NLEV) = CHFRM(2)
- NUCUR(NLEV) = NWFXM + NPARCD
- ENDIF
-*
-#if !defined(CERNLIB_IBM)||!defined(CERNLIB__P3CHILD)
- WRITE (CFORM, 2001) (NUCUR(I), CHCUR(I), I = 1, NLEV)
-#endif
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB__P3CHILD))
- CFORM = ' '
- II = 1
- DO 55 I = 1, NLEV
- CALL UTWRIT (CFORM(II:II+1), '(I2)', NUCUR(I))
- II = II + 2
- CFORM(II:II) = CHCUR(I)
- II = II + 2
- 55 CONTINUE
-#endif
- I = 4*NLEV
-*
- IQ(KOFUCD+LBNOCD+MNDNWK) = NWKYCK
- IQ(KOFUCD+LBNOCD+MNDNWD) = NWKYCK + NWFXM + NPARCD
- IQ(KOFUCD+LBNOCD+MNDNCH) = NCHAR
- IQ(KOFUCD+LBNOCD+MNDDIC) = IDIC
- CALL MZIOCH (IQ(KOFUCD+LBNOCD+MNDIOF), NWNOCD, CFORM(1:I))
- CALL UCTOH (PAT4CT, IQ(KOFUCD+LBNOCD+MNDNAM), 4, NCHAR)
-*
- 60 LSAVCD = 0
- IF (IN.LT.NODES) GO TO 10
-*
-* *** The Node exists; Normal return
-*
- 100 IRC = 0
-#if !defined(CERNLIB_IBM)||!defined(CERNLIB__P3CHILD)
-*
- 2001 FORMAT (20(I2,A1,1X))
-#endif
-* END CDNODE
- 999 END
diff --git a/src/packlib/hepdb/cdread/cdprdt.F b/src/packlib/hepdb/cdread/cdprdt.F
deleted file mode 100644
index 35c710c..0000000
--- a/src/packlib/hepdb/cdread/cdprdt.F
+++ /dev/null
@@ -1,134 +0,0 @@
-*
-* $Id: cdprdt.F,v 1.1.1.1 1996/02/28 16:24:26 mclareni Exp $
-*
-* $Log: cdprdt.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:26 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDPRDT (IRC)
-* =======================
-*
-************************************************************************
-* *
-* SUBR. CDPRDT (IRC*) *
-* *
-* Prints all objects for the current subdirectory *
-* *
-* Arguments : *
-* *
-* IRC Return code (see below) *
-* *
-* Called by CDPRIN *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* = 38 : Read error in getting the RZ date and time *
-* *
-************************************************************************
-*
-#include "hepdb/hdbkeys.inc"
-#include "hepdb/caopts.inc"
-#include "hepdb/cdcblk.inc"
-#include "hepdb/ckkeys.inc"
-#include "hepdb/clinks.inc"
- PARAMETER (JBIAS=2)
- DIMENSION ITIME(MXPACD)
-#include "zebra/q_jbit.inc"
-* Ignoring t=pass
-* ------------------------------------------------------------------
-*
-* *** Find the objects to be printed
-*
- IRC = 0
- IOKYCA(IDHKSN) = 1
- DO 5 I = 1, NPARCD
- ITIME(I) = 1
- 5 CONTINUE
- CALL VZERO (INDKCK, NKEYCK)
- IL = 1
- 10 IN = IL
- MNKYCT = 0
- KEY6CT = 0
- DO 20 IK = 1, NKEYCK
- IF (INDKCK(IK).NE.0) GO TO 20
- CALL CDKEYR (IK, NWKYCK, KEYVCK)
- IF (MNKYCT.EQ.0) THEN
- MNKYCT = KEYVCK(IDHKSN)
- KEY6CT = KEYVCK(IDHFLG)
- CALL UCOPY (KEYVCK, KEYNCK, NWKYCK)
- ELSE
- IF (KEYVCK(IDHUSI).NE.KEYNCK(IDHUSI)) GO TO 20
- DO 15 I = 1, NWKYCK
- IF ((I.GT.NOF1CK.AND.I.LE.NOF1CK+2*NPARCD).OR.
- + (I.GT.NOF2CK+2*NPARCD)) THEN
- IF (KEYVCK(I).NE.KEYNCK(I)) GO TO 20
- ENDIF
- 15 CONTINUE
- IF (MNKYCT.LT.KEYNCK(IDHKSN)) THEN
- MNKYCT = KEYNCK(IDHKSN)
- KEY6CT = KEYNCK(IDHFLG)
- ENDIF
- ENDIF
- INDKCK(IK) = 1
- 20 CONTINUE
-*
-* *** Now print the objects
-*
- IF (MNKYCT.NE.0) THEN
- KEY6 = JBIT (KEY6CT, JIGNCD)
- IFLG = 0
- DO 30 IK = IN, NKEYCK
- IF (INDKCK(IK).NE.1) THEN
- IFLG = 1
- ELSE
- INDKCK(IK) = 2
- IF (IFLG.EQ.0) IL = IK + 1
- IF (KEY6.EQ.0) THEN
- CALL CDKEYR (IK, NWKYCK, KEYNCK)
- IF (IOPDCA.NE.0) CALL CDPRNT (LPRTCD, '(//,15X,''======'//
- + '====== Keys and Time ============'',/)', IARGCD, 0)
- CALL CDPRKY (NWKYCK, KEYNCK, IOTYCK, IRC)
- IF (IRC.NE.0) GO TO 990
- IF (IOPICA.NE.0) THEN
- CALL RZIN (IDISCD, LDUMM, JBIAS, KEYNCK, 9999, 'C')
- IF (IQUEST(1).NE.0) THEN
- IRC = 38
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDPRDT'//
- + ' : RZIN error in getting the cycle information'')',
- + IARGCD, 0)
-#endif
- GO TO 990
- ENDIF
- INSTM = IQUEST(14)
- CALL RZDATE (INSTM, IARGCD(1), IARGCD(2), 1)
- CALL CDPRNT (LPRTCD, '(12X,''Date : '',I10,'' Time '//
- + ': '',I10)', IARGCD, 2)
- ENDIF
- IF (IOPDCA.NE.0) THEN
- LAUXCL(8) = 0
- CALL VZERO (KEYVCK, NWKYCK)
- KEYVCK(IDHKSN) = IK
- CALL CDKXIN (ITIME, IDISCD, LAUXCL(8), LAUXCL(8),
- + JBIAS, NWKEY, KEYVCK, IPREC, IRC)
- IF (LAUXCL(8).NE.0) THEN
- CALL DZSHOW ('*CDPRDT*', IDISCD, LAUXCL(8), 'BLV',
- + 0, 0, 0, 0)
- CALL MZDROP (IDISCD, LAUXCL(8), 'L')
- ENDIF
- IF (IRC.NE.0) GO TO 990
- ENDIF
- ENDIF
- ENDIF
- 30 CONTINUE
-*
- IF (IL.EQ.IN) IL = IN + 1
- IF (IL.LE.NKEYCK) GO TO 10
- ENDIF
-*
- 990 IOKYCA(IDHKSN) = 0
-* END CDPRDT
- 999 END
diff --git a/src/packlib/hepdb/cdread/cdprin.F b/src/packlib/hepdb/cdread/cdprin.F
deleted file mode 100644
index c798c62..0000000
--- a/src/packlib/hepdb/cdread/cdprin.F
+++ /dev/null
@@ -1,131 +0,0 @@
-*
-* $Id: cdprin.F,v 1.1.1.1 1996/02/28 16:24:27 mclareni Exp $
-*
-* $Log: cdprin.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:27 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDPRIN (PATHN, CHOPT, IRC)
-* =====================================
-*
-************************************************************************
-* *
-* SUBR. CDPRIN (PATHN, CHOPT, IRC*) *
-* *
-* Prints all objects attached to the directory PATHN *
-* *
-* Arguments : *
-* *
-* PATHN Character string describing the pathname *
-* CHOPT Character string with any of the following characters *
-* I Print the insertion time as well *
-* K Print only the keys *
-* D Print all data as well as the keys *
-* IRC Return code (see below) *
-* *
-* Called by user *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* = 31 : Illegal path name *
-* = 32 : No key or data for the path name *
-* *
-************************************************************************
-*
-#include "hepdb/caopts.inc"
-#include "hepdb/cdcblk.inc"
-#include "hepdb/ckkeys.inc"
-#include "hepdb/ctpath.inc"
- CHARACTER PATHN*(*), CHOPT*(*), PATHY*80, CFMT*130
-#include "zebra/q_jbit.inc"
-* Ignoring t=pass
-*
-* ------------------------------------------------------------------
-* *** Decode the character option
-*
- CALL CDOPTS (CHOPT, IRC)
- IF (IRC.NE.0) GO TO 999
-*
-* *** Suppress blanks from the path name
-*
- CALL CDLDUP (PATHN, 0, IRC)
- IF (IRC.NE.0) GO TO 999
- PATHY = PAT1CT
- NCHAR = LENOCC (PATHY)
- CALL CDKYTG
-*
-* *** Check the number of keys
-*
- IF (NKEYCK.EQ.0) THEN
- IRC = 32
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDPRIN : No key '//
- + 'or data for Path Name '//PATHY//''')', IARGCD, 0)
-#endif
- GO TO 999
- ENDIF
-*
-* ** Print keys
-*
- IOPTP = JBIT (IQ(KOFSCD+LCDRCD+IKDRCD+IDHFLG), JPRTCD)
- IF (IOPKCA.NE.0) IOPDCA = 0
- IF (IOPKCA.NE.0 .OR. IOPDCA.NE.0) THEN
-*
- IF (IOPKCA.NE.0) THEN
- CALL CDPRNT (LPRTCD, '(/,'' Keys with Insertion Time in Di'//
- + 'rectory '//PATHY//''')', IARGCD, 0)
- ELSE IF (IOPDCA.NE.0) THEN
- CALL CDPRNT (LPRTCD, '(/,'' Keys and Data with Insertion T'//
- + 'ime in Directory '//PATHY//''')', IARGCD, 0)
- ENDIF
- CFMT(1:5) = '(7X,'''
- CFMT(129:130) = ''')'
- DO 10 I1 = 1, NWKYCK, 10
- I2 = I1 + 9
- IF (I2.GT.NWKYCK) I2 = NWKYCK
- CFMT(6:128) = ' '
- IFLD = 6
- DO 5 I = I1, I2
- CFMT(IFLD:IFLD+7) = CTAGCK(I)
- IFLD = IFLD + 12
- 5 CONTINUE
- CALL CDPRNT (LPRTCD, CFMT, IARGCD, 0)
- 10 CONTINUE
- CALL CDPRNT (LPRTCD, '(//)', IARGCD, 0)
-*
- IF (IOPTP.EQ.0) THEN
- CALL CDPRDT (IRC)
- IF (IRC.NE.0) GO TO 999
- ELSE
-*
-* ** Loop over subdirectories
-*
- NKEYS = NKEYCK
- DO 20 IK = 1, NKEYS
- CALL CDPATH (TOP1CT, IK)
- PAT2CT = PATHY(1:NCHAR)//'/'//TOP1CT
- CALL RZCDIR (PAT2CT, ' ')
- IF (IQUEST(1).NE.0) THEN
- IRC = 31
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDPRIN : '//
- + 'Illegal Path Name '//PAT2CT//''')', IARGCD, 0)
-#endif
- GO TO 999
- ENDIF
- NKEYCK = IQUEST(7)
- NWKYCK = IQUEST(8)
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- CALL CDKEYT
- CALL CDPRDT (IRC)
- IF (IRC.NE.0) GO TO 999
- 20 CONTINUE
- ENDIF
-*
- ENDIF
-* END CDPRIN
- 999 END
diff --git a/src/packlib/hepdb/cdread/cdpsel.F b/src/packlib/hepdb/cdread/cdpsel.F
deleted file mode 100644
index f394cc5..0000000
--- a/src/packlib/hepdb/cdread/cdpsel.F
+++ /dev/null
@@ -1,170 +0,0 @@
-*
-* $Id: cdpsel.F,v 1.1.1.1 1996/02/28 16:24:27 mclareni Exp $
-*
-* $Log: cdpsel.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:27 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDPSEL (ITIME, KEYS, KEYP, IFLG, ISEL)
-* =================================================
-*
-************************************************************************
-* *
-* SUBR. CDPSEL (ITIME, KEYS, KEYP, IFLG, ISEL*) *
-* *
-* Select a partitition depending on the options *
-* *
-* Arguments : *
-* *
-* ITIME Vector with the selection time *
-* KEYS User key vector for selection *
-* KEYP Key vector of the partition *
-* IFLG 0 selection on range of validity; *
-* 99 no selection on range of validity *
-* ISEL 0 if the partition is selected; 1 if not *
-* *
-* Called by CDBKKS, CDCHCK, CDGETDB,CDKXIN *
-* *
-************************************************************************
-*
-#include "hepdb/caopts.inc"
-#include "hepdb/cdcblk.inc"
-#include "hepdb/ckkeys.inc"
- DIMENSION ITIME(9), KEYS(9), KEYP(9)
-* ------------------------------------------------------------------
-*
-* *** Decide if the partition keys to be updated
-*
- ISEL = 1
- IF (IOKYCA(IDHINS).NE.0.AND.KEYP(IDHINS).GT.KEYS(IDHINS))GO TO 999
- IF (MXINCD.GT.0 .AND.KEYP(IDHINS).GT.MXINCD) GO TO 999
- IF (IFLG.EQ.99) GO TO 100
- IF (IPRBCA.EQ.0.AND.IPRECA.EQ.0) THEN
-*
- IBEG = 0
- IF (IHFLCD.EQ.0) THEN
- IEND = 0
- DO 10 I = 1, NPARCD
- IF (IBEG.EQ.0) THEN
- IF (ITIME(I).LT.KEYP(NOF1CK+2*I-1)) IBEG =-1
- IF (ITIME(I).GT.KEYP(NOF1CK+2*I-1)) IBEG = 1
- ENDIF
- IF (IEND.EQ.0) THEN
- IF (ITIME(I).GT.KEYP(NOF1CK+2*I)) GO TO 999
- IF (ITIME(I).LT.KEYP(NOF1CK+2*I)) IEND = 1
- ENDIF
- 10 CONTINUE
- ELSE
- DO 15 I = 1, NPARCD
- IF (ITIME(I).LT.KEYP(NOF1CK+2*I-1)) IBEG =-1
- IF (ITIME(I).GT.KEYP(NOF1CK+2*I)) GO TO 999
- 15 CONTINUE
- ENDIF
-*
- IF (IBEG.LT.0) THEN
- IF (IHFLCD.EQ.0) THEN
- KYEN = 0
- DO 20 I = 1, NPARCD
- IF (KYEN.EQ.0) THEN
- IF (KYENCD(I).LT.KEYP(NOF1CK+2*I-1)) GO TO 999
- IF (KYENCD(I).GT.KEYP(NOF1CK+2*I-1)) KYEN = 1
- ENDIF
- 20 CONTINUE
- ELSE
- DO 25 I = 1, NPARCD
- IF (KYENCD(I).LT.KEYP(NOF1CK+2*I-1)) GO TO 999
- 25 CONTINUE
- ENDIF
- DO 30 I = 1, NPARCD
- KYENCD(I) = KEYP(NOF1CK+2*I-1)
- 30 CONTINUE
- GO TO 999
- ENDIF
-*
- ELSE IF (IPRBCA.GT.0.AND.IPRECA.EQ.0) THEN
-*
- IF (IHFLCD.EQ.0) THEN
- IBEG = 0
- DO 35 I = 1, NPARCD
- IF (IBEG.EQ.0) THEN
- IF (KEYP(NOF1CK+2*I-1).GT.KEYS(NOF1CK+2*I-1)) GO TO 999
- IF (KEYP(NOF1CK+2*I-1).LT.KEYS(NOF1CK+2*I-1)) IBEG = 1
- ENDIF
- 35 CONTINUE
- ELSE
- DO 40 I = 1, NPARCD
- IF (KEYP(NOF1CK+2*I-1).GT.KEYS(NOF1CK+2*I-1)) GO TO 999
- 40 CONTINUE
- ENDIF
-*
- ELSE IF (IPRBCA.EQ.0.AND.IPRECA.GT.0) THEN
-*
- IF (IHFLCD.EQ.0) THEN
- IEND = 0
- DO 45 I = 1, NPARCD
- IF (IEND.EQ.0) THEN
- IF (KEYP(NOF1CK+2*I) .LT.KEYS(NOF1CK+2*I)) GO TO 999
- IF (KEYP(NOF1CK+2*I) .GT.KEYS(NOF1CK+2*I)) IEND = 1
- ENDIF
- 45 CONTINUE
- ELSE
- DO 50 I = 1, NPARCD
- IF (KEYP(NOF1CK+2*I) .LT.KEYS(NOF1CK+2*I)) GO TO 999
- 50 CONTINUE
- ENDIF
-*
- ELSE IF (IPRBCA.GT.0.AND.IPRECA.GT.0) THEN
-*
- IF (IHFLCD.EQ.0) THEN
- IBEG = 0
- IEND = 0
- DO 55 I = 1, NPARCD
- IF (IBEG.EQ.0) THEN
- IF (KEYP(NOF1CK+2*I-1).GT.KEYS(NOF1CK+2*I-1)) GO TO 999
- IF (KEYP(NOF1CK+2*I-1).LT.KEYS(NOF1CK+2*I-1)) IBEG = 1
- ENDIF
- IF (IEND.EQ.0) THEN
- IF (KEYP(NOF1CK+2*I) .LT.KEYS(NOF1CK+2*I)) GO TO 999
- IF (KEYP(NOF1CK+2*I) .GT.KEYS(NOF1CK+2*I)) IEND = 1
- ENDIF
- 55 CONTINUE
- ELSE
- DO 60 I = 1, NPARCD
- IF (KEYP(NOF1CK+2*I-1).GT.KEYS(NOF1CK+2*I-1)) GO TO 999
- IF (KEYP(NOF1CK+2*I) .LT.KEYS(NOF1CK+2*I)) GO TO 999
- 60 CONTINUE
- ENDIF
-*
- ELSE
-*
- IF (IHFLCD.EQ.0) THEN
- IBEG = 0
- IEND = 0
- DO 65 I = 1, NPARCD
- IF (IBEG.EQ.0.AND.IPRBCA.NE.0) THEN
- IF (KEYP(NOF1CK+2*I) .LT.KEYS(NOF1CK+2*I-1)) GO TO 999
- IF (KEYP(NOF1CK+2*I) .GT.KEYS(NOF1CK+2*I-1)) IBEG = 1
- ENDIF
- IF (IEND.EQ.0.AND.IPRECA.NE.0) THEN
- IF (KEYP(NOF1CK+2*I-1).GT.KEYS(NOF1CK+2*I)) GO TO 999
- IF (KEYP(NOF1CK+2*I-1).LT.KEYS(NOF1CK+2*I)) IEND = 1
- ENDIF
- 65 CONTINUE
- ELSE
- DO 70 I = 1, NPARCD
- IF (IPRBCA.NE.0) THEN
- IF (KEYP(NOF1CK+2*I) .LT.KEYS(NOF1CK+2*I-1)) GO TO 999
- ENDIF
- IF (IPRECA.NE.0) THEN
- IF (KEYP(NOF1CK+2*I-1).GT.KEYS(NOF1CK+2*I)) GO TO 999
- ENDIF
- 70 CONTINUE
- ENDIF
-*
- ENDIF
-*
- 100 ISEL = 0
-* END CDPSEL
- 999 END
diff --git a/src/packlib/hepdb/cdread/cdseky.F b/src/packlib/hepdb/cdread/cdseky.F
deleted file mode 100644
index a4e4fc6..0000000
--- a/src/packlib/hepdb/cdread/cdseky.F
+++ /dev/null
@@ -1,80 +0,0 @@
-*
-* $Id: cdseky.F,v 1.1.1.1 1996/02/28 16:24:27 mclareni Exp $
-*
-* $Log: cdseky.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:27 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDSEKY (ITIME, KEY)
-* ==============================
-*
-************************************************************************
-* *
-* SUBR. CDSEKY (ITIME, KEY) *
-* *
-* Select on the values of key elements *
-* *
-* Arguments : *
-* *
-* ITIME Time for which data are required to be valid *
-* KEY Vector of keys (on the basis of which selection is to *
-* be made) *
-* *
-* Called by CDKXIN *
-* *
-************************************************************************
-*
-#include "hepdb/caopts.inc"
-#include "hepdb/cdcblk.inc"
-#include "hepdb/ckkeys.inc"
-#include "hepdb/ctkxin.inc"
- DIMENSION ITIME(9), KEY(9)
-#include "zebra/q_jbit.inc"
-* Ignoring t=pass
-*
-* ------------------------------------------------------------------
-*
-* *** Look at all the keys in the subdirectory
-*
- IF (IOPSCA.NE.0) THEN
- IPNT = KOFSCD + LCDRCD + IKDRCD
- ISTP = NWKYCK + 1
- KPNT = IUHUNT (KEY(IDHKSN), IQ(IPNT+IDHKSN), NKEYCK*ISTP,ISTP)
- IF (KPNT.GT.0) THEN
- IK = (KPNT - IDHKSN)/ ISTP + 1
- ELSE
- GO TO 999
- ENDIF
- CALL CDKEYR (IK, NWKYCK, KEYNCK)
- NTIMCT = NTIMCT + 1
- KEY1CK(NTIMCT) = KEYNCK(IDHKSN)
- IF (MNKYCT.LE.KEYNCK(IDHKSN)) THEN
- IKYLCT = IK
- MNKYCT = KEYNCK(IDHKSN)
- KEY6CT = KEYNCK(IDHFLG)
- ENDIF
-*
- ELSE
-*
- DO 20 IK = 1, NKEYCK
- CALL CDKEYR (IK, NWKYCK, KEYNCK)
- CALL CDKSEL (ITIME, KEY, KEYNCK, 1, ISEL, INBR)
- IF (ISEL.EQ.0) THEN
- NTIMCT = NTIMCT + 1
- KEY1CK(NTIMCT) = KEYNCK(IDHKSN)
- IF (MNKYCT.LE.KEYNCK(IDHKSN)) THEN
- IKYLCT = IK
- MNKYCT = KEYNCK(IDHKSN)
- KEY6CT = KEYNCK(IDHFLG)
- IF (JBIT(KEY6CT,JIGNCD).EQ.0) KY6NCT = IK
- ENDIF
- ELSE IF (INBR.EQ.0) THEN
- IDNRCT = IK
- IUSECT = ICURCT
- ENDIF
- 20 CONTINUE
- ENDIF
-* END CDSEKY
- 999 END
diff --git a/src/packlib/hepdb/cdread/cdstp3.F b/src/packlib/hepdb/cdread/cdstp3.F
deleted file mode 100644
index 9d10864..0000000
--- a/src/packlib/hepdb/cdread/cdstp3.F
+++ /dev/null
@@ -1,65 +0,0 @@
-*
-* $Id: cdstp3.F,v 1.1.1.1 1996/02/28 16:24:27 mclareni Exp $
-*
-* $Log: cdstp3.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:27 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
-#if defined(CERNLIB__P3CHILD)
- SUBROUTINE CDSTP3 (IFLG, LCOND, NBKP3, IND)
-* ===========================================
-*
-************************************************************************
-* *
-* SUBR. CDSTP3 (IFLG, LCOND, NBKP3, IND) *
-* *
-* Stores the several KYCD banks in a stack to be sorted out at the *
-* end of the pass. *
-* *
-* Arguments : *
-* *
-* IFLG Flag (1 for initialization; 2 for storage in stack) *
-* LCOND Condition for single or multiple retrieval *
-* NBKP3 Object number restored in the host *
-* IND Index for the keybank *
-* *
-* Called by CDGETDB,CDUSE, CDUSEDB,CDUSEM *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
-#include "hepdb/p3dbl3.inc"
- LOGICAL LCOND
- SAVE NKBP3
-*
-* ------------------------------------------------------------------
-*
- IF (IFLG.EQ.1) THEN
-*
-* ** Initialization
-*
- IF (LCOND) THEN
- IPASP3 = 1
- NDIRP3 = 0
- NBKDP3 = 0
- NBKYP3 = 0
- INDXP3 = 1
- ELSE
- IPASP3 = 0
- ENDIF
- NKBP3 = 0
- ELSE
-*
-* ** Storage
-*
- NKBP3 = NKBP3 + 1
- IF (NKBP3.GT.IQ(KOFUCD+LNK2P3-1))
- + CALL MZPUSH (IXDBP3, LNK2P3, 100, 100, '....')
- LQ(KOFUCD+LNK2P3-NKBP3) = LBKYCD
- IQ(KOFUCD+LNK2P3+NKBP3) = NBKP3 + IND*1000000
- ENDIF
-* END CDSTP3
- END
-#endif
diff --git a/src/packlib/hepdb/cdread/cduse.F b/src/packlib/hepdb/cdread/cduse.F
deleted file mode 100644
index 670eb30..0000000
--- a/src/packlib/hepdb/cdread/cduse.F
+++ /dev/null
@@ -1,157 +0,0 @@
-*
-* $Id: cduse.F,v 1.1.1.1 1996/02/28 16:24:27 mclareni Exp $
-*
-* $Log: cduse.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:27 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
-#if defined(CERNLIB__P3CHILD)
-* Ignoring t=dummy
-#endif
- SUBROUTINE CDUSE (PATHN, LBK, ISEL, CHOPT, IRC)
-* ================================================
-*
-************************************************************************
-* *
-* SUBR. CDUSE (PATHN, *LBK*, ISEL, CHOPT, IRC*) *
-* *
-* Prepares the database data structure in memory for any required *
-* Pathname and set of Keys, unless already done. *
-* Returns the address in memory for the corresponding Key bank after *
-* checking its validity. *
-* *
-* Arguments : *
-* *
-* PATHN Character string describing the pathname *
-* LBK Address(es) of Keys bank(s) KYCD (INPUT or OUTPUT) *
-* Address of the databank can be obtained from the actual *
-* key-address as LBD = LQ(LBK-1) *
-* ISEL Instant of validity, e.g. data acquisition time *
-* CHOPT Character string with any of the following characters *
-* A trust LBK address(es) if non-zero *
-* D drop data structure at LBK before retrieving new data *
-* structure *
-* F force retrieval of new data structure *
-* K read only the keys (no data is required) *
-* IRC Return code (see below) *
-* *
-* Called by user *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* = 2 : Illegal path name *
-* = 3 : Data base structure in memory clobbered *
-* = 4 : Illegal key option *
-* *
-* If IRC = 0, IQUEST(2) carries information whether data part has *
-* been actually read from the disk or not *
-* IQUEST(2) = 0 : No disk i/o has been performed *
-* = 1 : Data have been refreshed from the disk *
-* *
-************************************************************************
-*
-#include "hepdb/caopts.inc"
-#include "hepdb/cdcblk.inc"
-#include "hepdb/ckkeys.inc"
-#include "hepdb/ctpath.inc"
-#if defined(CERNLIB__P3CHILD)
-#include "hepdb/p3dbl3.inc"
-#endif
-* (Arbitary dimension 9 to force transmission by address for scalar)
- PARAMETER (NZ=0)
- DIMENSION ISEL(9), KEYS(9), LBK(9)
-#if defined(CERNLIB__P3CHILD)
- LOGICAL LCOND
-#endif
- CHARACTER CHOPT*(*), PATHN*(*)
-*
-* ------------------------------------------------------------------
-*
-* *** Initialize options
-*
-C ACP_data_retrieval_start
- LREFCD(1) = LBK(1)
- CALL CDOPTS (CHOPT, IRC)
- IF (IRC.NE.0) GO TO 999
- IOPVCA = 1
-*
-* *** Create (or complete) database skeleton in memory
-* (banks NOCD and KYCD)
-*
- IF (IOPACA.EQ.0. OR. LREFCD(1).EQ.0) THEN
-*
- CALL CDNODE (PATHN, IRC)
- IF (IRC.NE.0) GO TO 999
-*
- LBKYCD =LQ(KOFUCD+LBNOCD-KLKYCD)
- IF (LBKYCD.EQ.0) THEN
- ND = IQ(KOFUCD+LBNOCD+MNDNWD)
- CALL UCOPY (IQ(KOFUCD+LBNOCD+MNDIOF), IOKYCD, NWNOCD)
- CALL CDBANK (IDIVCD, LBKYCD, LBNOCD, -KLKYCD, 'KYCD', NLKYCD,
- + NSKYCD, ND, IOKYCD, NZ, IRC)
- IF (IRC.NE.0) GO TO 999
- LQ(KOFUCD+LBKYCD-KLNOCD) = LBNOCD
- LQ(KOFUCD+LBKYCD-KLUPCD) = LBUPCD
- ENDIF
- LBK(1) = LBKYCD
- LREFCD(1) = LBK(1)
-*
- ELSE
-*
- CALL CDLDUP (PATHN, 0, IRC)
- IF (IRC.NE.0) GO TO 999
- CALL RZCDIR (PAT1CT, ' ')
- NKEYCK = IQUEST(7)
- NWKYCK = IQUEST(8)
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- LBNOCD = LQ(KOFUCD+LREFCD(1)-KLNOCD)
-*
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) THEN
- NF = IQ(KOFUCD+LBNOCD+MNDNCH)
- CALL UHTOC (IQ(KOFUCD+LBNOCD+MNDNAM), 4, PAT3CT, NF)
- PAT3CT = PAT3CT(1:NF)
- N = LENOCC (PAT1CT) + 1
-*
- 50 N = N -1
- IF (PAT1CT(N:N).NE.PAT3CT(NF:NF)) THEN
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDUSE : Da'//
- + 'ta-base structure in memory clobbered'')', IARGCD, 0)
- IRC = 3
- IQUEST(11) = N
- GO TO 999
- ELSE IF (N.NE.1) THEN
- NF = NF -1
- GO TO 50
- ENDIF
- ENDIF
-#endif
- ENDIF
-*
-* *** Create (or update) Data bank(s)
-*
-#if defined(CERNLIB__P3CHILD)
- LCOND = .FALSE.
- CALL CDSTP3 (1, LCOND, NBKP3, 0)
-#endif
- IQUEST(2) = 0
- LBDACD = LQ(KOFUCD+LREFCD(1)-KLDACD)
- CALL CDCHCK (LREFCD(1), ISEL, KEYS, LBDACD, IRC)
-*
- 999 CONTINUE
-#if defined(CERNLIB__P3CHILD)
- IF (LNK3P3.NE.0) CALL MZDROP (IXDBP3, LNK3P3, '....')
- LNK3P3 = 0
- LNK4P3 = 0
- LNK5P3 = 0
- NBKYP3 = 0
- NDIRP3 = 0
- IPASP3 = 0
-#endif
-* END CDUSE
-C ACP_data_retrieval_end
- END
diff --git a/src/packlib/hepdb/cdread/cdusedb.F b/src/packlib/hepdb/cdread/cdusedb.F
deleted file mode 100644
index 0aa29cb..0000000
--- a/src/packlib/hepdb/cdread/cdusedb.F
+++ /dev/null
@@ -1,289 +0,0 @@
-*
-* $Id: cdusedb.F,v 1.1.1.1 1996/02/28 16:24:27 mclareni Exp $
-*
-* $Log: cdusedb.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:27 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
-#if defined(CERNLIB__P3CHILD)
-* Ignoring t=dummy
-#endif
- SUBROUTINE CDUSEDB (PATHN, LBK, ITIME, MASK, KEYS, CHOPT, IRC)
-* ==============================================================
-*
-************************************************************************
-* *
-* SUBR. CDUSEDB (PATHN, *LBK*, ITIME, MASK, KEYS, CHOPT, IRC*) *
-* *
-* Prepares the database data structure in memory for any required *
-* Pathname and set of Keys, unless already done. *
-* Returns (optionally) the addresses in memory for the corresponding *
-* Key banks and Data banks after checking their validity for the *
-* given time and keys. *
-* *
-* Arguments : *
-* *
-* PATHN Character string describing the pathname *
-* LBK Address(es) of Keys bank(s) KYCD (INPUT or OUTPUT) *
-* For option 'S' it is the support address of the linear *
-* structure *
-* For option 'M' with selection on user keys 8 and 9, *
-* LBK(k) is the address corresponding to the ith Key-8 *
-* and the jth Key-9 value, where k = KEYS(8) * (j-1) + i *
-* Address(es) of Data bank(s) DADB can be obtained from *
-* the actual key-address as LBD = LQ(LBK-1) *
-* ITIME Event data acquisition time (or 0, if Data not wanted) *
-* MASK Integer vector indicating which elements of KEYS are *
-* significant for selection. If MASK corresponding to *
-* one of the fields of 'Beginning' validity range is set, *
-* it will select objects with start validity smaller than *
-* those requested in KEYS. If MASK corresponding to one *
-* of the fields of 'End' validity range is set, it will *
-* select objects with end validity larger than those in *
-* KEYS. If MASK corresponding to time of insertion is set,*
-* objects inserted earlier than KEYS(IDHINS) are selected *
-* KEYS Vector of keys. Only the elements declared in CHOPT are *
-* assumed to contain useful information. *
-* When option 'M' is declared KEYS(n) (when user Key n *
-* is selected should contain the number of data objects *
-* to be retrieved according to the KEYS(n) values and *
-* the values of the key elements for Key-n to be matched *
-* should be stored in successive KEYS(i) elements, with *
-* i starting from NWKEY+1 (NWKEY is the number of key *
-* elements for this directory) *
-* CHOPT Character string with any of the following characters *
-* A trust LBK address(es) if non-zero *
-* K read only the keys (no data is required) *
-* M expect multiple Key banks to be returned (only up to *
-* a maximum of 5 user keys) *
-* S expect multiple Key banks satisfying selection on a *
-* number of keys (Options S and M are mutually exclusive) *
-* V declare the Data as being different in size to what is *
-* already resident in memory *
-* IRC Return code (see below) *
-* *
-* Called by user *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* = 1 : Illegal character option *
-* = 3 : Data base structure in memory clobbered *
-* = 4 : Illegal key option *
-* *
-* If IRC = 0, IQUEST(2) carries information whether data part has *
-* been actually read from the disk or not *
-* IQUEST(2) = 0 : No disk i/o has been performed *
-* = 1 : Data have been refreshed from the disk *
-* and IQUEST(3) gives the total number of data banks *
-* *
-************************************************************************
-*
-#include "hepdb/caopts.inc"
-#include "hepdb/cdcblk.inc"
-#include "hepdb/ckkeys.inc"
-#include "hepdb/ctpath.inc"
-#if defined(CERNLIB__P3CHILD)
-#include "hepdb/p3dbl3.inc"
-#endif
- DIMENSION ITIME(9), KEYS(9), MASK(9), LBK(9)
-#if defined(CERNLIB__P3CHILD)
- LOGICAL LCOND
-#endif
- CHARACTER CHOPT*(*), PATHN*(*), PATHY*80
-*
-* ------------------------------------------------------------------
-*
-* *** Initialize options
-*
-C ACP_data_retrieval_start
- LREFCD(1) = LBK(1)
- CALL CDOPTS (CHOPT, IRC)
- IF (IRC.NE.0) THEN
- IQUEST(3) = 0
- GO TO 999
- ELSE IF (IOPMCA.NE.0 .AND. IOPSCA.NE.0) THEN
- IRC = 1
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDUSEDB : Illega'//
- + 'l Character option - S/M options are mutually exclusive'')',
- + IARGCD, 0)
-#endif
- IQUEST(3) = 0
- GO TO 999
- ENDIF
- CALL UCOPY (MASK, IOKYCA, MXDMCK)
-*
-* *** Create (or complete) database skeleton in memory
-* (banks NOCD and KYCD)
-*
- IF (ITIME(1).EQ.0 .OR. IOPACA.EQ.0 .OR.
- + (IOPACA.NE.0.AND.LREFCD(1).EQ.0) ) THEN
-*
- CALL CDNODE (PATHN, IRC)
- IF (IRC.NE.0) THEN
- IQUEST(3) = 0
- GO TO 999
- ENDIF
- PATHY = PAT1CT
-*
- CALL CDKYDB (KEYS, LBK, ITIME, IRC)
- IF (IRC.NE.0) THEN
- IQUEST(3) = 0
- GO TO 999
- ENDIF
- LREFCD(1) = LBK(1)
-*
-* * That's it, when only initialisation required
-*
- IF (ITIME(1).EQ.0) THEN
- IQUEST(2) = 0
- IQUEST(3) = 0
- GO TO 999
- ENDIF
-*
- ELSE
-*
- CALL CDLDUP (PATHN, 0, IRC)
- IF (IRC.NE.0) THEN
- IQUEST(3) = 0
- GO TO 999
- ENDIF
- PATHY = PAT1CT
- CALL RZCDIR (PATHY, ' ')
- NKEYCK = IQUEST(7)
- NWKYCK = IQUEST(8)
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- LBNOCD = LQ(KOFUCD+LREFCD(1)-KLNOCD)
-*
- IF (IOPSCA.NE.0) THEN
- CALL CDBKKS (KEYS, LBK, ITIME, IRC)
- IF (IRC.NE.0) THEN
- IQUEST(3) = 0
- GO TO 999
- ENDIF
- LREFCD(1) = LBK(1)
- ENDIF
-*
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) THEN
- NF = IQ(KOFUCD+LBNOCD+MNDNCH)
- CALL UHTOC (IQ(KOFUCD+LBNOCD+MNDNAM), 4, PAT3CT, NF)
- PAT3CT = PAT3CT(1:NF)
- N = LENOCC (PATHY) + 1
-*
- 50 N = N -1
- IF (PATHY(N:N).NE.PAT3CT(NF:NF)) THEN
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDUSEDB : Da'//
- + 'ta-base structure in memory clobbered'')', IARGCD, 0)
- IRC = 3
- IQUEST(3) = 0
- IQUEST(11) = N
- GO TO 999
- ELSE IF (N.NE.1) THEN
- NF = NF -1
- GO TO 50
- ENDIF
- ENDIF
-#endif
- ENDIF
-*
-* *** Get number of Data banks needed
-*
- NKYMX = 1
- IF (IOPMCA.NE.0) THEN
- IF (NWKYCK.GT.NSYSCK) THEN
- DO 60 I = NSYSCK+1, NWKYCK
- IF (IOKYCA(I).NE.0) THEN
- IF (KEYS(I).LE.0) THEN
-*
-* ** Illegal key option
-*
- IRC = 4
- IQUEST(3) = 0
- IQUEST(11) = KEYS(I)
- IQUEST(12) = I
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDUSEDB '//
- + ': Illegal key option '',I3,'' for key '',I3,'' with '//
- + 'option M'')', IQUEST(11), 2)
-#endif
- GO TO 999
- ENDIF
-*
- NKYMX = NKYMX * KEYS(I)
- ENDIF
- 60 CONTINUE
- ENDIF
- ENDIF
-*
-* *** Number of Key banks in S mode
-*
- IF (IOPSCA.NE.0) THEN
- LBKYCD = LREFCD(1)
- NKYMX = NZBANK (IDIVCD, LBKYCD)
- ENDIF
-*
-* *** Create (or update) Data bank(s)
-*
- IQUEST(2) = 0
-#if defined(CERNLIB__P3CHILD)
- LCOND = (NKYMX.GT.1)
- CALL CDSTP3 (1, LCOND, NBKP3, 0)
-#endif
- I = 0
- 100 I = I + 1
- IF (IOPSCA.EQ.0) THEN
- LBKYCD = LBK(I)
- ENDIF
- LBDACD = LQ(KOFUCD+LBKYCD-KLDACD)
-#if defined(CERNLIB__P3CHILD)
- NBKP3 = NBKYP3
-#endif
- CALL CDCHCK (LBKYCD, ITIME, KEYS, LBDACD, IRC)
-#if defined(CERNLIB__P3CHILD)
- IF (IPASP3.EQ.1.AND.IRC.EQ.0) CALL CDSTP3 (2, LCOND, NBKP3, I)
-#endif
-#if defined(CERNLIB__DEBUG)
- IF (IRC.EQ.99) THEN
- IF (IDEBCD.GT.0) THEN
- IARGCD(1) = I
- IARGCD(2) = NKYMX
- CALL CDPRNT (LPRTCD, '(/,'' CDUSEDB : Fatal error - No mor'//
- + 'e space available to lift bank for'',/,'' '//PATHY//
- + ''',2I10)', IARGCD, 2)
- ENDIF
- ENDIF
-#endif
- IF (IOPSCA.EQ.0) THEN
- IF (I.LT.NKYMX) GO TO 100
- ELSE
- IF (IRC.NE.0) THEN
- IQUEST(3) = NKYMX
- GO TO 999
- ENDIF
- LBKYCD = LQ(KOFUCD+LBKYCD)
- IF (LBKYCD.NE.0) GO TO 100
- ENDIF
- IQUEST(3) = NKYMX
-#if defined(CERNLIB__P3CHILD)
-*
- CALL CDUSP3 ('CDUSEDB', ITIME, IRC)
-#endif
-*
- 999 CONTINUE
-#if defined(CERNLIB__P3CHILD)
- IF (LNK3P3.NE.0) CALL MZDROP (IXDBP3, LNK3P3, '....')
- LNK3P3 = 0
- LNK4P3 = 0
- LNK5P3 = 0
- NBKYP3 = 0
- NDIRP3 = 0
- IPASP3 = 0
-#endif
-* END CDUSEDB
-C ACP_data_retrieval_end
- END
diff --git a/src/packlib/hepdb/cdread/cdusem.F b/src/packlib/hepdb/cdread/cdusem.F
deleted file mode 100644
index dc3d808..0000000
--- a/src/packlib/hepdb/cdread/cdusem.F
+++ /dev/null
@@ -1,226 +0,0 @@
-*
-* $Id: cdusem.F,v 1.1.1.1 1996/02/28 16:24:27 mclareni Exp $
-*
-* $Log: cdusem.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:27 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
-#if defined(CERNLIB__P3CHILD)
-* Ignoring t=dummy
-#endif
- SUBROUTINE CDUSEM (PATHN, LBK, ITIME, MASK, KEYS, CHOPT, IRC)
-* =============================================================
-*
-************************************************************************
-* *
-* SUBR. CDUSEM (PATHN, *LBK*, ITIME, MASK, KEYS, CHOPT, IRC*) *
-* *
-* Prepares the database data structure in memory for any required *
-* Pathname and set of Keys, unless already done. *
-* Returns the addresses in memory for the corresponding Key banks *
-* after checking their validity for the given time and keys. *
-* The address of the databank can only be obtained from the actual *
-* key-address of the linear structure as LBD = LQ(LBK-1) *
-* *
-* Arguments : *
-* *
-* PATHN Character string describing the pathname *
-* LBK Address of the first Key bank KYCD of a linear structure*
-* (INPUT or OUTPUT) *
-* ITIME Event data acquisition time *
-* MASK Integer vector indicating which elements of KEYS are *
-* significant for selection. If MASK corresponding to *
-* one of the fields of 'Beginning' validity range is set, *
-* it will select objects with start validity smaller than *
-* those requested in KEYS. If MASK corresponding to one *
-* of the fields of 'End' validity range is set, it will *
-* select objects with end validity larger than those in *
-* KEYS. If MASK corresponding to time of insertion is set,*
-* objects inserted earlier than KEYS(IDHINS) are selected *
-* KEYS Vector of keys. Only the elements declared in CHOPT are *
-* assumed to contain useful information. *
-* When option 'M' is declared, KEYS vector is ignored. *
-* CHOPT Character string with any of the following characters *
-* A trust LBK address(es) if non-zero *
-* D drop data structure at LBK before retrieving new data *
-* structure *
-* F force retrieval of new data structure *
-* K read only the keys (no data is required) *
-* M expect multiple Key banks to be returned (only up to *
-* a maximum of 5 user keys) *
-* N If data do not exist for ITIME, take the nearest data *
-* object in time *
-* S expect multiple Key banks satisfying selection on a *
-* number of keys (Options S and M are mutually exclusive) *
-* IRC Return code (see below) *
-* *
-* Called by user *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* = 1 : Illegal character option *
-* = 2 : Illegal path name *
-* = 3 : Data base structure in memory clobbered *
-* = 4 : Illegal key option *
-* *
-* If IRC = 0, IQUEST(2) carries information whether data part has *
-* been actually read from the disk or not *
-* IQUEST(2) = 0 : No disk i/o has been performed *
-* = 1 : Data have been refreshed from the disk *
-* *
-************************************************************************
-*
-#include "hepdb/caopts.inc"
-#include "hepdb/cdcblk.inc"
-#include "hepdb/ckkeys.inc"
-#include "hepdb/ctpath.inc"
-#if defined(CERNLIB__P3CHILD)
-#include "hepdb/p3dbl3.inc"
-#endif
-*
- DIMENSION ITIME(9), MASK(9), KEYS(9), LBK(9)
-#if defined(CERNLIB__P3CHILD)
- LOGICAL LCOND
-#endif
- CHARACTER CHOPT*(*), PATHN*(*), PATHY*80
-*
-* ------------------------------------------------------------------
-*
-* *** Initialize options
-*
-C ACP_data_retrieval_start
- LREFCD(1) = LBK(1)
- CALL CDOPTS (CHOPT, IRC)
- IF (IRC.NE.0) GO TO 999
- IF ((IOPMCA.NE.0.AND.IOPSCA.NE.0) .OR.
- + (IOPMCA.NE.0.AND.LREFCD(1).EQ.0)) THEN
- IRC = 1
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) THEN
- PATHY = CHOPT
- NCH = LENOCC (PATHY)
- CALL CDPRNT (LPRTCD, '(/,'' CDUSEM : Illegal Character opti'//
- + 'on '//PATHY(1:NCH)//' '')', IARGCD, 0)
- ENDIF
-#endif
- GO TO 999
- ENDIF
- IOPVCA = 1
- CALL UCOPY (MASK, IOKYCA, MXDMCK)
-*
-* *** Create (or complete) database skeleton in memory
-*
- IF (IOPMCA.EQ.0 .AND. (IOPACA.EQ.0 .OR. LREFCD(1).EQ.0)) THEN
-*
- CALL CDNODE (PATHN, IRC)
- IF (IRC.NE.0) GO TO 999
- PATHY = PAT1CT
-*
- ELSE
-*
- CALL CDLDUP (PATHN, 0, IRC)
- IF (IRC.NE.0) GO TO 999
- PATHY = PAT1CT
- CALL RZCDIR (PATHY, ' ')
- NKEYCK = IQUEST(7)
- NWKYCK = IQUEST(8)
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- LBNOCD = LQ(KOFUCD+LREFCD(1)-KLNOCD)
-#if defined(CERNLIB__DEBUG)
-*
- IF (IDEBCD.GT.0) THEN
- NF = IQ(KOFUCD+LBNOCD+MNDNCH)
- CALL UHTOC (IQ(KOFUCD+LBNOCD+MNDNAM), 4, PAT3CT, NF)
- PAT3CT = PAT3CT(1:NF)
- N = LENOCC (PATHY) + 1
-*
- 50 N = N -1
- IF (PATHY(N:N).NE.PAT3CT(NF:NF)) THEN
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDUSEM : Da'//
- + 'ta-base structure in memory clobbered'')', IARGCD, 0)
- IRC = 3
- IQUEST(11) = N
- GO TO 999
- ELSE IF (N.NE.1) THEN
- NF = NF -1
- GO TO 50
- ENDIF
- ENDIF
-#endif
- ENDIF
-*
- IF (IOPMCA.EQ.0 .AND. (IOPACA.EQ.0 .OR. LREFCD(1).EQ.0)) THEN
-*
- CALL CDKEYB (KEYS, LBK, ITIME, IRC)
- IF (IRC.NE.0) GO TO 999
- LREFCD(1) = LBK(1)
-*
- ELSE IF (IOPSCA.NE.0) THEN
- CALL CDBKKS (KEYS, LBK, ITIME, IRC)
- IF (IRC.NE.0) GO TO 999
- ENDIF
-*
-* *** Get number of Data banks needed
-*
- LBKYCD = LREFCD(1)
- IF (IOPSCA.NE.0.OR.IOPMCA.NE.0) THEN
- NKYMX = NZBANK (IDIVCD, LBKYCD)
- ELSE
- NKYMX = 1
- ENDIF
-*
-* *** Create (or update) Data bank(s)
-*
- IQUEST(2) = 0
-#if defined(CERNLIB__P3CHILD)
- LCOND = (NKYMX.GT.1)
- CALL CDSTP3 (1, LCOND, NBKP3, 0)
-#endif
- I = 0
- 100 I = I + 1
- LBDACD = LQ(KOFUCD+LBKYCD-KLDACD)
-#if defined(CERNLIB__P3CHILD)
- NBKP3 = NBKYP3
-#endif
- CALL CDCHCK (LBKYCD, ITIME, KEYS, LBDACD, IRC)
-#if defined(CERNLIB__P3CHILD)
- IF (IPASP3.EQ.1.AND.IRC.EQ.0) CALL CDSTP3 (2, LCOND, NBKP3, I)
-#endif
-#if defined(CERNLIB__DEBUG)
- IF (IRC.EQ.99) THEN
- IF (IDEBCD.GT.0) THEN
- IARGCD(1) = I
- IARGCD(2) = NKYMX
- CALL CDPRNT (LPRTCD, '(/,'' CDUSEM : Fatal error - No mor'//
- + 'e space available to lift bank for'',/,'' '//PATHY//
- + ''',2I10)', IARGCD, 2)
- ENDIF
- ENDIF
-#endif
- IF (IOPSCA.NE.0.AND.IRC.NE.0) GO TO 999
- IF (IOPSCA.NE.0.OR.IOPMCA.NE.0) THEN
- LBKYCD = LQ(KOFUCD+LBKYCD)
- IF (LBKYCD.NE.0) GO TO 100
- ENDIF
-#if defined(CERNLIB__P3CHILD)
-*
- CALL CDUSP3 ('CDUSEM', ITIME, IRC)
-#endif
-*
- 999 CONTINUE
-#if defined(CERNLIB__P3CHILD)
- IF (LNK3P3.NE.0) CALL MZDROP (IXDBP3, LNK3P3, '....')
- LNK3P3 = 0
- LNK4P3 = 0
- LNK5P3 = 0
- NBKYP3 = 0
- NDIRP3 = 0
- IPASP3 = 0
-#endif
-* END CDUSEM
-C ACP_data_retrieval_end
- END
diff --git a/src/packlib/hepdb/cdread/cdusp3.F b/src/packlib/hepdb/cdread/cdusp3.F
deleted file mode 100644
index 69cc970..0000000
--- a/src/packlib/hepdb/cdread/cdusp3.F
+++ /dev/null
@@ -1,120 +0,0 @@
-*
-* $Id: cdusp3.F,v 1.1.1.1 1996/02/28 16:24:27 mclareni Exp $
-*
-* $Log: cdusp3.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:27 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
-#if defined(CERNLIB__P3CHILD)
- SUBROUTINE CDUSP3 (CROOT, ITIME, IRC)
-* =====================================
-*
-************************************************************************
-* *
-* SUBR. CDUSP3 (CROOT, ITIME, *IRC*) *
-* *
-* Retrieves several objects in memory in one transaction from host *
-* to child in P3 context *
-* *
-* Arguments : *
-* *
-* CROOT Name of the calling routine *
-* ITIME Event data acquisition time *
-* IRC Return code (see below) *
-* *
-* Called by CDGETDB,CDUSEDB,CDUSEM *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* = 5 : Error in CDCHLD in P3 communication *
-* *
-************************************************************************
-*
-#include "hepdb/caopts.inc"
-#include "hepdb/cdcblk.inc"
-#include "hepdb/ctpath.inc"
-#include "hepdb/clinks.inc"
-#include "hepdb/p3dbl3.inc"
-#include "zebra/mzbits.inc"
-*
- DIMENSION ITIME(9)
- CHARACTER CROOT*(*)
-*
-* ------------------------------------------------------------------
-*
- IQ1 = IRC
- IQ2 = IQUEST(2)
- IQ3 = IQUEST(3)
- IF (IPASP3.NE.1) GO TO 30
-*
-* *** Request the host to load the data objects from the RZ file
-*
- IF (NBKYP3.EQ.0) THEN
- IQ2 = 0
- IQ3 = 0
- GO TO 30
- ENDIF
-*
- RNDBP3 = 'CDRZIN '
- PAT1CT = CROOT
- CALL UCTOH (PAT1CT, IWDBP3, 4, 8)
- CALL CDCHLD
- IF (IQDBP3.NE.0) THEN
- IQ1 = 5
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDUSP3 : Error '//
- + 'code'',I6,'' from CDCHLD'')', IQDBP3, 1)
-#endif
- GO TO 30
- ENDIF
-*
-* *** Relocate the objects
-*
- IPASP3 = 2
- LNK6P3 = LQ(KOFUCD+LNK3P3-1)
- LNK7P3 = LQ(KOFUCD+LNK3P3-2)
-*
- DO 20 JK = 1, NKBP3
- IP3NEW = IQ(KOFUCD+LNK2P3+JK)
- I = IP3NEW/1000000
- IP3NEW = MOD (IP3NEW,1000000)
- IF (JK.GT.1) THEN
- IF (IP3NEW.EQ.IP3OLD) GO TO 20
- DO 10 IP3 = IP3OLD, IP3NEW-1
- LNK4P3 = LQ(KOFUCD+LNK6P3)
- LNK5P3 = LQ(KOFUCD+LNK7P3)
- CALL MZDROP (IXDBP3, LNK6P3, 'BV..')
- CALL MZDROP (IXDBP3, LNK7P3, 'BV..')
- LNK6P3 = LNK4P3
- LNK7P3 = LNK5P3
- 10 CONTINUE
- ELSE
- LNK4P3 = LNK6P3
- LNK5P3 = LNK7P3
- ENDIF
- IP3OLD = IP3NEW
-*
- LBKYCD = LQ(KOFUCD+LNK2P3-JK)
- LBDACD = LQ(KOFUCD+LBKYCD-KLDACD)
- NDK = IQ(KOFUCD+LBKYCD-1)
- IF (LBDACD.NE.0) CALL MZDROP (IDIVCD, LBDACD, 'L...')
-*
- NWKEY = IQ(KOFUCD+LBKYCD-1)
- CALL UCOPY (IQ(KOFUCD+LBKYCD+1), KEYVCK, NWKEY)
- CALL CDKXIN (ITIME, IDIVCD, LAUXCL(9), LBKYCD, -KLDACD, NWKEY,
- + KEYVCK, IPREC, IRC)
- LAUXCL(9) = 0
-*
- IF (IRC.EQ.0) IQ(KOFUCD+LBKYCD+NDK+MKYPRE) = IPREC
- IF (IRC.NE.0.AND.IQ1.EQ.0) IQ1 = IRC
- 20 CONTINUE
-*
- 30 IRC = IQ1
- IQUEST(2) = IQ2
- IQUEST(3) = IQ3
-* END CDUSP3
- END
-#endif
diff --git a/src/packlib/hepdb/cdroot/Imakefile b/src/packlib/hepdb/cdroot/Imakefile
deleted file mode 100644
index ea897cf..0000000
--- a/src/packlib/hepdb/cdroot/Imakefile
+++ /dev/null
@@ -1,6 +0,0 @@
-SRCS_F= cdbank.F cdkeyr.F cdkeyt.F cdkytg.F cdlddi.F cdldic.F \ @@\
- cdldup.F cdopts.F cdpars.F cdpath.F cdprky.F cdprnt.F cdropn.F \ @@\
- cdrzin.F cdsblc.F cdsopn.F cdtopn.F cduvtx.F cdvers.F cdwtop.F \ @@\
- icdtyp.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/hepdb/cdroot/cdbank.F b/src/packlib/hepdb/cdroot/cdbank.F
deleted file mode 100644
index 6623e23..0000000
--- a/src/packlib/hepdb/cdroot/cdbank.F
+++ /dev/null
@@ -1,91 +0,0 @@
-*
-* $Id: cdbank.F,v 1.1.1.1 1996/02/28 16:24:28 mclareni Exp $
-*
-* $Log: cdbank.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:28 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDBANK (IDIV,LAD,LSUP,JBIAS,CHID,NL,NS,ND,NIO,NZ,IRC)
-* ================================================================
-*
-************************************************************************
-* *
-* SUBR. CDBANK (IDIV,LAD*,LSUP,JBIAS,CHID,NL,NS,ND,NIO,NZ,IRC*) *
-* *
-* Creates a bank taking care of total ammount of space available in *
-* the division. When not enough space is available after garbage *
-* collection, the banks freed by DBFREE are dropped. *
-* *
-* Arguments : *
-* *
-* IDIV Division number where the object is to be created *
-* LAD L-address of the bank created *
-* LSUP L-address of the supporting bank *
-* JBIAS Link bias as described in ZEBRA manual *
-* CHID Character string to specify the bank name *
-* NL,NS, Total number of links, number of structural links, *
-* ND,NIO, number of data words, I/O characteristics flag *
-* NZ for initialising the bank (MZBOOK standard) *
-* IRC Return code (see below) *
-* *
-* Called by various routines in the HEPDB package *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* = 99 : No space in memory for creating the bank *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
- CHARACTER CHID*(*), CHID0*4
- DIMENSION NL(9), NS(9), ND(9), NIO(9), LSUP(9), LAD(9)
-*
-* ------------------------------------------------------------------
-*
-* *** See if enough space is available in memory
-*
- NEEDW = NL(1) + ND(1) + 20
- CALL MZNEED (IDIV, NEEDW, ' ')
- IF (IQUEST(11).LT.0) THEN
- CALL MZNEED (IDIV, NEEDW, 'G')
- IF (IQUEST(11).LT.0) THEN
- LGO = 0
- 10 LBFYCD = LZFIDH (IDIV, IHKYCD, LGO)
- IF (LBFYCD.NE.0) THEN
- ND0 = IQ(KOFUCD+LBFYCD-1)
- IF (IQ(KOFUCD+LBFYCD+ND0+MKYFRI).GT.0) THEN
- LDAT = LQ(KOFUCD+LBFYCD-KLDACD)
- IF (LDAT.GT.0) CALL MZDROP (IDIV, LDAT, 'L')
- ENDIF
- LGO = LBFYCD
- GO TO 10
- ENDIF
- CALL MZNEED (IDIV, NEEDW, 'G')
- IF (IQUEST(11).LT.0) THEN
- IRC = 99
- IQUEST(1) = 99
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) THEN
- CHID0 = CHID
- CALL CDPRNT (LPRTCD, '(/,'' CDBANK : No space left for '//
- + 'creating bank '//CHID0//' space needed '',I12)',
- + IQUEST(11), 1)
- ENDIF
-#endif
- GO TO 999
- ENDIF
- ENDIF
- ENDIF
-*
-* *** Create the bank as desired
-*
- CALL MZBOOK (IDIV, LAD(1), LSUP(1), JBIAS, CHID, NL, NS, ND, NIO,
- + NZ)
- IRC = 0
- IQUEST(1) = 0
- IQ(KOFUCD+LAD(1)-5) = 0
-* END CDBANK
- 999 END
diff --git a/src/packlib/hepdb/cdroot/cdkeyr.F b/src/packlib/hepdb/cdroot/cdkeyr.F
deleted file mode 100644
index 80ed1ec..0000000
--- a/src/packlib/hepdb/cdroot/cdkeyr.F
+++ /dev/null
@@ -1,50 +0,0 @@
-*
-* $Id: cdkeyr.F,v 1.1.1.1 1996/02/28 16:24:28 mclareni Exp $
-*
-* $Log: cdkeyr.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:28 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDKEYR (IKEY, NWKEY, KEY)
-* ====================================
-*
-************************************************************************
-* *
-* SUBR. CDKEYR (IKEY, NWKEY, KEY*) *
-* *
-* Loads the Key vector in the array KEY *
-* *
-* Arguments : *
-* *
-* IKEY Index of the key *
-* NWKEY Number of key elements to be fetched *
-* KEY The Key vector which will contain the Key elements *
-* for key IKEY on output *
-* *
-* Called by CDCDIC, CDCHCK, CDCHKY, CDCOMP, CDDDIR, CDDELK, CDDONT, *
-* CDEALI, CDENFZ, CDENTB, CDGETDB,CDHUNT, CDKOUT, CDKXIN, *
-* CDKYSE, CDPART, CDPRDT, CDPURG, CDPURP, CDRENK, CDSEKY, *
-* CDSNAM, CDUDIC, CDUNCP *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
-#include "hepdb/ckkeys.inc"
- DIMENSION KEY(9)
-*
-* ------------------------------------------------------------------
-* *** Retrieve the keys
-*
- ISTP = NWKYCK + 1
- IPNT = KOFSCD + LCDRCD + IKDRCD + (IKEY - 1) * ISTP
- DO 10 I = 1, NWKEY
- IF (IOTYCK(I).EQ.5 .OR. IOTYCK(I).EQ.6) THEN
- CALL ZITOH (IQ(IPNT+I), KEY(I), 1)
- ELSE
- KEY(I) = IQ(IPNT+I)
- ENDIF
- 10 CONTINUE
-* END CDKEYR
- 999 END
diff --git a/src/packlib/hepdb/cdroot/cdkeyt.F b/src/packlib/hepdb/cdroot/cdkeyt.F
deleted file mode 100644
index 4684eaf..0000000
--- a/src/packlib/hepdb/cdroot/cdkeyt.F
+++ /dev/null
@@ -1,47 +0,0 @@
-*
-* $Id: cdkeyt.F,v 1.1.1.1 1996/02/28 16:24:28 mclareni Exp $
-*
-* $Log: cdkeyt.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:28 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDKEYT
-* =================
-*
-************************************************************************
-* *
-* SUBR. CDKEYT *
-* *
-* Retrieves the I/O descriptor for the current directory *
-* *
-* Called by various routines in the HEPDB package *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
-#include "hepdb/ckkeys.inc"
-#include "zebra/q_jbit.inc"
-* Ignoring t=pass
-*
-* ------------------------------------------------------------------
-*
- DO 10 I = 1, NWKYCK
- IN = (I - 1) / 10
- JB = 3*I - 30*IN - 2
- IWD = IQ(KOFSCD+LCDRCD+IKTYCD+IN)
- IFORM = JBYT (IWD, JB, 3)
- IF (IFORM.EQ.3) THEN
- IFORM = 5
- ELSE IF (IFORM.EQ.4) THEN
- IFORM = 6
- ELSE IF (IFORM.EQ.5) THEN
- IFORM = 3
- ELSE IF (IFORM.LT.1.OR.IFORM.GT.5) THEN
- IFORM = 2
- ENDIF
- IOTYCK(I) = IFORM
- 10 CONTINUE
-* END CDKEYT
- 999 END
diff --git a/src/packlib/hepdb/cdroot/cdkytg.F b/src/packlib/hepdb/cdroot/cdkytg.F
deleted file mode 100644
index 0045b98..0000000
--- a/src/packlib/hepdb/cdroot/cdkytg.F
+++ /dev/null
@@ -1,52 +0,0 @@
-*
-* $Id: cdkytg.F,v 1.1.1.1 1996/02/28 16:24:29 mclareni Exp $
-*
-* $Log: cdkytg.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:29 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDKYTG
-* =================
-*
-************************************************************************
-* *
-* SUBR. CDKYTG *
-* *
-* Retrieves the I/O descriptor and the Tags of the Key elements *
-* of the current directory *
-* *
-* Called by CDDONT, CDENFZ, CDENTB, CDKOUT, CDPART, CDPRIN *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
-#include "hepdb/ckkeys.inc"
- DIMENSION IHTAG(2)
-#include "zebra/q_jbit.inc"
-* Ignoring t=pass
-*
-* ------------------------------------------------------------------
-*
- KTAG = IKTYCD + (NWKYCK-1)/10 + 1
- DO 10 I = 1, NWKYCK
- CALL ZITOH (IQ(KOFSCD+LCDRCD+KTAG+2*I-2), IHTAG, 2)
- CALL UHTOC (IHTAG, 4, CTAGCK(I), 8)
- IN = (I - 1) / 10
- JB = 3*I - 30*IN - 2
- IWD = IQ(KOFSCD+LCDRCD+IKTYCD+IN)
- IFORM = JBYT (IWD, JB, 3)
- IF (IFORM.EQ.3) THEN
- IFORM = 5
- ELSE IF (IFORM.EQ.4) THEN
- IFORM = 6
- ELSE IF (IFORM.EQ.5) THEN
- IFORM = 3
- ELSE IF (IFORM.LT.1.OR.IFORM.GT.5) THEN
- IFORM = 2
- ENDIF
- IOTYCK(I) = IFORM
- 10 CONTINUE
-* END CDKYTG
- 999 END
diff --git a/src/packlib/hepdb/cdroot/cdlddi.F b/src/packlib/hepdb/cdroot/cdlddi.F
deleted file mode 100644
index c38388c..0000000
--- a/src/packlib/hepdb/cdroot/cdlddi.F
+++ /dev/null
@@ -1,49 +0,0 @@
-*
-* $Id: cdlddi.F,v 1.1.1.1 1996/02/28 16:24:32 mclareni Exp $
-*
-* $Log: cdlddi.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:32 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDLDDI (PATHI, PATHO, NCHAR)
-* =======================================
-*
-************************************************************************
-* *
-* SUBR. CDLDDI (PATHI, PATHO*, NCHAR*) *
-* *
-* Checks the directory name, if alias returns the complete pathname; *
-* otherewise returns the original name in upper case *
-* *
-* Arguments : *
-* *
-* PATHI Input pathname (could be alias name with '%' prefix) *
-* PATHO Output pathname (in upper case) *
-* NCHAR Number of characters in PATHO *
-* *
-* Called by CDKEEP, CDLDIR, CDLDUP, CDLIST *
-* *
-************************************************************************
-*
-#include "hepdb/ctpath.inc"
- CHARACTER PATHI*(*), PATHO*(*), CSALI*1
- DATA CSALI /'%'/
-*
-* ------------------------------------------------------------------
-*
-* *** Remove blanks in the path name and set current directory
-*
- CALL CDSBLC (PATHI, PATHO, NCHAR)
- IF (PATHO(1:1).EQ.CSALI) THEN
- PAT2CT = PATHO(2:NCHAR)
- CALL CDRALI (PAT2CT, PAT3CT, IRC)
- IF (IRC.EQ.0) THEN
- PATHO = PAT3CT
- NCHAR = LENOCC (PATHO)
- ENDIF
- ENDIF
- CALL CLTOU (PATHO(1:NCHAR))
-* END CDLDDI
- END
diff --git a/src/packlib/hepdb/cdroot/cdldic.F b/src/packlib/hepdb/cdroot/cdldic.F
deleted file mode 100644
index 61c7dbb..0000000
--- a/src/packlib/hepdb/cdroot/cdldic.F
+++ /dev/null
@@ -1,79 +0,0 @@
-*
-* $Id: cdldic.F,v 1.1.1.1 1996/02/28 16:24:29 mclareni Exp $
-*
-* $Log: cdldic.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:29 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDLDIC (PATHN, IFLG, IRC)
-* ====================================
-*
-************************************************************************
-* *
-* SUBR. CDLDIC (*PATHN*, IFLG, IRC*) *
-* *
-* Gets information of the specified pathname from the dictionary *
-* *
-* Arguments : *
-* *
-* PATHN Character string describing the pathname *
-* If flag < 0, current directory name is set to PATHN *
-* IFLG Flag (< 0 if PATHN to be obtained from the name of the *
-* current set directory) *
-* IRC Return Code (See below) *
-* *
-* Called by CDDONT, CDENFZ, CDENTB, CDKOUT, CDPART, CDRTFZ *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* = 95 : Description not found in the dictionary *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
-#include "hepdb/ctpath.inc"
- CHARACTER PATHN*(*)
-*
-* ------------------------------------------------------------------
-*
-* *** Remove the top directory part from the current directory
-*
- IF (IFLG.LT.0) CALL RZCDIR (PATHN, 'R')
- CALL CDWTOP (PATHN, PAT2CT, NCHR)
-*
-* *** Load the UPDB bank content for this top directory
-*
- LFIXCD = LQ(KOFUCD+LBUPCD-KLDICD)
- IF (LBUPCD.NE.0.AND.LFIXCD.NE.0) THEN
- NITEM = IQ(KOFUCD+LFIXCD+MDCNTM)
- DO 10 I = 1, NITEM
- IPNT = KOFUCD + LFIXCD + (I - 1) * NWITCD + 1
- NCHF = IQ(IPNT+MDCNCH)
- IF (IQ(IPNT+MDCITM).GT.0.AND.NCHR.EQ.NCHF) THEN
- CALL UHTOC (IQ(IPNT+MDCNAM), 4, PAT3CT, NCHF)
- IF (PAT2CT(1:NCHR).EQ.PAT3CT(1:NCHF)) THEN
- ITNUCD = IQ(IPNT+MDCITM)
- LUPDCD = IQ(IPNT+MDCLUP)
- ICMPCD = IQ(IPNT+MDCCMP)
- IPRECD = IQ(IPNT+MDCPRC)
- DELTCD = Q(IPNT+MDCDEL)
- CALL UHTOC (IQ(IPNT+MDCALI), 4, CALICD, 8)
- IRC = 0
- GO TO 999
- ENDIF
- ENDIF
- 10 CONTINUE
- ENDIF
-*
- IRC = 95
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) THEN
- CALL CDPRNT (LPRTCD, '(/,'' CDLDIC : Cannot find the entry '//
- + PAT2CT(1:NCHR)//' in the dictionary '')', IARGCD, 0)
- ENDIF
-#endif
-* END CDLDIC
- 999 END
diff --git a/src/packlib/hepdb/cdroot/cdldup.F b/src/packlib/hepdb/cdroot/cdldup.F
deleted file mode 100644
index 16a057d..0000000
--- a/src/packlib/hepdb/cdroot/cdldup.F
+++ /dev/null
@@ -1,116 +0,0 @@
-*
-* $Id: cdldup.F,v 1.1.1.1 1996/02/28 16:24:29 mclareni Exp $
-*
-* $Log: cdldup.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:29 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDLDUP (PATHN, IFLG, IRC)
-* ====================================
-*
-************************************************************************
-* *
-* SUBR. CDLDUP (PATHN, IFLG, IRC*) *
-* *
-* Sets current directory to PATHN and loads /CDUPDB/ with information*
-* about the top directory *
-* *
-* Arguments : *
-* *
-* PATHN Character string describing the pathname *
-* IFLG Flag (< 0 if current directory is already set; then *
-* PATHN is ignored) *
-* IRC Return Code (See below) *
-* *
-* Called by CDDONT, CDENTB, CDKOUT, CDMDIR, CDNODE, CDPART, CDPRIN, *
-* CDRENK, CDRTFZ, CDUSE, CDUSEM, CDUSEDB *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* = 96 : RZCDIR fails to set to the current directory *
-* = 97 : The corresponding UPCD bank not found *
-* *
-************************************************************************
-*
-#include "hepdb/caopts.inc"
-#include "hepdb/cdcblk.inc"
-#include "hepdb/ckkeys.inc"
-#include "hepdb/ctpath.inc"
- CHARACTER PATHN*(*)
-*
-* ------------------------------------------------------------------
-*
-* *** Remove blanks in the path name and set current directory
-*
- IF (IFLG.GE.0) THEN
- CALL CDLDDI (PATHN, PAT1CT, NCH)
- CALL RZCDIR (PAT1CT, ' ')
- IF (IQUEST(1).NE.0) THEN
- IRC = 96
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) THEN
- IF (NCH.EQ.0) NCH = MAXLCD
- CALL CDPRNT (LPRTCD, '(/,'' CDLDUP : Cannot set current '//
- + 'directory to '//PAT1CT(1:NCH)//' '')', IARGCD, 0)
- ENDIF
-#endif
- GO TO 999
- ENDIF
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- NKEYCK = IQUEST(7)
- NWKYCK = IQUEST(8)
- ENDIF
-*
-* *** Now get the top directory name
-*
- CALL RZCDIR (PAT1CT, 'R')
- CALL CDTOPN (PAT1CT, TOPNCD, NCHRCD)
-*
-* *** Load the UPDB bank content for this top directory
-*
- IPRBCA = 0
- IPRECA = 0
- LBUPCD = LTOPCD
- 10 IF (LBUPCD.NE.0) THEN
- NCHR = IQ(KOFUCD+LBUPCD+MUPNCH)
- CALL UHTOC (IQ(KOFUCD+LBUPCD+MUPNAM), 4, TOP1CT, NCHR)
- IF (TOP1CT(1:NCHR).NE.TOPNCD) THEN
- LBUPCD = LQ(KOFUCD+LBUPCD)
- GO TO 10
- ELSE
- LURZCD = IQ(KOFUCD+LBUPCD+MUPLUN)
- IOUTCD = IQ(KOFUCD+LBUPCD+MUPFLG)
- IOPPCD = IQ(KOFUCD+LBUPCD+MUPSRV)
- IOPSCD = IQ(KOFUCD+LBUPCD+MUPSHR)
- NPARCD = IQ(KOFUCD+LBUPCD+MUPAIR)
- ITOPCD = IQ(KOFUCD+LBUPCD+MUPDIC)
- MXINCD = IQ(KOFUCD+LBUPCD+MUPKIN)
- LUFZCD = IQ(KOFUCD+LBUPCD+MUPJFL)
- LUBKCD = IQ(KOFUCD+LBUPCD+MUPBAK)
- IHFLCD = IQ(KOFUCD+LBUPCD+MUPHFL)
- IRC = 0
-*
- NSYSCK = NOF2CK + 2*NPARCD
- DO 15 I = 1, NPARCD
- IF (IOKYCA(NOF1CK+2*I-1).NE.0) IPRBCA = IPRBCA + 1
- IF (IOKYCA(NOF1CK+2*I) .NE.0) IPRECA = IPRECA + 1
- 15 CONTINUE
- ENDIF
-*
- ELSE
- IRC = 97
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) THEN
- CALL CDPRNT (LPRTCD, '(/,'' CDLDUP : Cannot find the UPCD '//
- + 'bank for '//TOPNCD(1:NCHRCD)//' in the path '//PAT1CT//
- + ' '')', IARGCD, 0)
- ENDIF
-#endif
- GO TO 999
- ENDIF
-* END CDLDUP
- 999 END
diff --git a/src/packlib/hepdb/cdroot/cdopts.F b/src/packlib/hepdb/cdroot/cdopts.F
deleted file mode 100644
index b6d64ad..0000000
--- a/src/packlib/hepdb/cdroot/cdopts.F
+++ /dev/null
@@ -1,91 +0,0 @@
-*
-* $Id: cdopts.F,v 1.1.1.1 1996/02/28 16:24:31 mclareni Exp $
-*
-* $Log: cdopts.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:31 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDOPTS (CHOPT, IRC)
-* ==============================
-*
-************************************************************************
-* *
-* SUBR. CDOPTS (CHOPT, IRC*) *
-* *
-* Decode the character option and fill up the common block /CAOPTS/ *
-* *
-* Arguments : *
-* *
-* CHOPT Character option supplied by user *
-* IRC Return code (see below) *
-* *
-* Called by various routines in the HEPDB package *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* = 91 : Illegal Character Option *
-* *
-************************************************************************
-*
-#include "hepdb/caopti.inc"
-#include "hepdb/caopts.inc"
-#include "hepdb/cdcblk.inc"
- CHARACTER CHOPT*(*), CTEST*1, BLANK*1, CTMP*80
- DIMENSION ICOPT(300), IALFA(MXKYCA+28)
- EQUIVALENCE (IALFA(1), IOPACA)
- DATA BLANK / ' '/
-*
-* ------------------------------------------------------------------
-*
- IRC = 0
- DO 5 K = 1, MXKYCA+28
- IALFA(K) = 0
- 5 CONTINUE
-*
-* *** Convert CHOPT into a list of integer variables
-*
- MAXL = LEN (CHOPT)
- I1 = 0
- DO 20 I0 = 1, MAXL
- CTEST = CHOPT(I0:I0)
- DO 10 I = 1, 62
- IF (CTEST.EQ.CALFCA(I)) GO TO 15
- 10 CONTINUE
- IF (CTEST.NE.BLANK) GO TO 991
- GO TO 20
- 15 I1 = I1 + 1
- IF (I.GT.36) I = I - 36
- ICOPT(I1) = I
- 20 CONTINUE
- MAXU = I1
-*
-* *** Now fill up the common /CAOPTS/
-*
- I0 = 0
- 30 I0 = I0 + 1
- IF (I0.GT.MAXU) GO TO 999
- I = ICOPT(I0)
-*
-* ** Alphabetic options
-*
- IF (I.LE.26) THEN
- IALFA(I) = 1
- GO TO 30
- ENDIF
-*
-* *** Illegal Character option
-*
- 991 IRC = 91
- IQUEST(11) = I0
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) THEN
- CTMP = CHOPT
- CALL CDPRNT (LPRTCD, '('' CDOPTS : Illegal Character option a'//
- + 'fter '',I2,'' in '//CTMP//''')', IQUEST(11), 1)
- ENDIF
-#endif
-* END CDOPTS
- 999 END
diff --git a/src/packlib/hepdb/cdroot/cdpars.F b/src/packlib/hepdb/cdroot/cdpars.F
deleted file mode 100644
index 71b2cf5..0000000
--- a/src/packlib/hepdb/cdroot/cdpars.F
+++ /dev/null
@@ -1,60 +0,0 @@
-*
-* $Id: cdpars.F,v 1.1.1.1 1996/02/28 16:24:32 mclareni Exp $
-*
-* $Log: cdpars.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:32 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDPARS (PATHY, NMAX, CNODE, NCHL, NODES)
-* ===================================================
-*
-************************************************************************
-* *
-* SUBR. CDPARS (PATHY, NMAX, CNODE*, NCHL*, NODES*) *
-* *
-* Splits a pathname into its component pieces (nodes) *
-* *
-* Arguments : *
-* *
-* PATHY Input path name *
-* NMAX Maximum number of nodes *
-* CNODE Node names *
-* NCHL Number of characters in CNODE *
-* NODES Number of nodes in PATHY *
-* *
-* Called by CDFREE, CDKEEP, CDNODE *
-* *
-************************************************************************
-*
- CHARACTER*(*) PATHY, CNODE(9)
- DIMENSION NCHL(9)
-* ------------------------------------------------------------------
-*
-* *** Get list of Nodes
-*
- NODES = 0
- MAXL = LEN (PATHY)
- I0 = 0
- 10 I1 = I0 + 1
- IF (I1.LE.MAXL) THEN
- DO I0 = I1, MAXL
- IF (PATHY(I0:I0).EQ.' ') GO TO 20
- IF (PATHY(I0:I0).EQ.'/') GO TO 15
- ENDDO
- I0 = MAXL + 1
- 15 I2 = I0 - 1
- GO TO 30
- 20 I2 = I0 - 1
- I0 = MAXL + 1
- 30 IF (I2.LT.I1) GO TO 10
- NODES = NODES + 1
- IF (NODES.LE.NMAX) THEN
- CNODE(NODES) = PATHY(I1:I2)
- NCHL (NODES) = I2 - I1 + 1
- ENDIF
- GO TO 10
- ENDIF
-* END CDPARS
- END
diff --git a/src/packlib/hepdb/cdroot/cdpath.F b/src/packlib/hepdb/cdroot/cdpath.F
deleted file mode 100644
index 20b3a3f..0000000
--- a/src/packlib/hepdb/cdroot/cdpath.F
+++ /dev/null
@@ -1,54 +0,0 @@
-*
-* $Id: cdpath.F,v 1.1.1.1 1996/02/28 16:24:31 mclareni Exp $
-*
-* $Log: cdpath.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:31 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
-#if (defined(CERNLIB__P3CHILD))&&(defined(CERNLIB_IBM))
-* Ignoring t=dummy
-#endif
- SUBROUTINE CDPATH (PATHX, IK)
-* =============================
-*
-************************************************************************
-* *
-* SUBR. CDPATH (PATHX*, IK) *
-* *
-* Get the subdirectory address of a partitioned data set *
-* from the Subdirectory number *
-* *
-* Arguments : *
-* *
-* PATHX(*) Character string specifying the subdirectory path name *
-* IK Subdirectory number *
-* *
-* Called by various routines in the HEPDB package *
-* *
-************************************************************************
-*
- CHARACTER PATHX*(*)
- DATA I2 / 8/
- SAVE I2
-*
-* ------------------------------------------------------------------
-*
-#if !defined(CERNLIB_IBM)||!defined(CERNLIB__P3CHILD)
- WRITE (PATHX, '(I8)') IK
-#endif
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB__P3CHILD))
- CALL UTWRIT (PATHX, '(I8)', IK, 1)
-#endif
- I3 = 10
- DO 10 I = 1, I2
- IF (IK.LT.I3) THEN
- I1 = I2 + 1 - I
- PATHX = PATHX(I1:I2)
- GO TO 999
- ENDIF
- I3 = I3 * 10
- 10 CONTINUE
-* END CDPATH
- 999 END
diff --git a/src/packlib/hepdb/cdroot/cdprky.F b/src/packlib/hepdb/cdroot/cdprky.F
deleted file mode 100644
index e494c0c..0000000
--- a/src/packlib/hepdb/cdroot/cdprky.F
+++ /dev/null
@@ -1,124 +0,0 @@
-*
-* $Id: cdprky.F,v 1.1.1.1 1996/02/28 16:24:31 mclareni Exp $
-*
-* $Log: cdprky.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:31 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
-#if (defined(CERNLIB__P3CHILD))&&(defined(CERNLIB_IBM))
-* Ignoring t=dummy
-#endif
- SUBROUTINE CDPRKY (NW, KY, KT, IRC)
-* ===================================
-*
-************************************************************************
-* *
-* SUBR. CDPRKY (NW, KY, KT, IRC*) *
-* *
-* Prints a vector KY of elements NW according to its type KT *
-* *
-* Arguments : *
-* *
-* NW Number of elements in the array KY (and KT) *
-* KY Vector to be printed *
-* KT Type of the vector elements *
-* 1 - Binary *
-* 2 Integer *
-* 3 Floating *
-* 4 Double Precision (not yet implemented) *
-* 5 Hollerith *
-* IRC Return code (see below) *
-* *
-* Called by CDENFZ, CDENTB, CDKOUT, CDPART, CDPRDT, CDPURP *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* = 39 : Illegal data type *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
- CHARACTER CHPRT*132
- DIMENSION KY(NW), KT(NW)
-*
-* ------------------------------------------------------------------
-*
- I1 = 3
- IRC = 0
- CHPRT = ' '
- DO 10 I = 1, NW
- IF (I1.GT.120) THEN
- CALL CDPRNT (LPRTCD, '('''//CHPRT//''')', IARGCD, 0)
- I1 = 3
- CHPRT = ' '
- ENDIF
-*
- IF (KT(I).EQ.1) THEN
-*
-* ** Binary
-*
- I2 = I1 + 11
-#if !defined(CERNLIB_IBM)||!defined(CERNLIB__P3CHILD)
- WRITE (CHPRT(I1:I2), '(2X,Z10)') KY(I)
-#endif
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB__P3CHILD))
- CALL UTWRIT (CHPRT(I1:I2), '(2X,Z10)', KY(I), 1)
-#endif
-*
- ELSE IF (KT(I).EQ.2) THEN
-*
-* ** Integer
-*
- I2 = I1 + 11
-#if !defined(CERNLIB_IBM)||!defined(CERNLIB__P3CHILD)
- WRITE (CHPRT(I1:I2), '(2X,I10)') KY(I)
-#endif
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB__P3CHILD))
- CALL UTWRIT (CHPRT(I1:I2), '(2X,I10)', KY(I), 1)
-#endif
-*
- ELSE IF (KT(I).EQ.3) THEN
-*
-* ** Floating
-*
- I2 = I1 + 11
-#if !defined(CERNLIB_IBM)||!defined(CERNLIB__P3CHILD)
- WRITE (CHPRT(I1:I2), '(G12.4)') KY(I)
-#endif
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB__P3CHILD))
- CALL UTWRIT (CHPRT(I1:I2), '(G12.4)', KY(I), 1)
-#endif
-*
- ELSE IF (KT(I).EQ.5.OR.KT(I).EQ.6) THEN
-*
-* ** Hollerith
-*
- I2 = I1 + 11
-#if !defined(CERNLIB_IBM)||!defined(CERNLIB__P3CHILD)
- WRITE (CHPRT(I1:I2), '(8X,A4)') KY(I)
-#endif
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB__P3CHILD))
- CALL UTWRIT (CHPRT(I1:I2), '(8X,A4)', KY(I), 1)
-#endif
-*
- ELSE
-*
-* ** Error
-*
- IRC = 39
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDPRKY : '//
- + 'Illegal data type to be printed = '',I10/)', KT(I), 1)
-#endif
- GO TO 999
-*
- ENDIF
- I1 = I2 + 1
-*
- 10 CONTINUE
- IF (I1.GT.3) CALL CDPRNT (LPRTCD, '('''//CHPRT//''')', IARGCD, 0)
-* END CDPRKY
- 999 END
diff --git a/src/packlib/hepdb/cdroot/cdprnt.F b/src/packlib/hepdb/cdroot/cdprnt.F
deleted file mode 100644
index 0d9799c..0000000
--- a/src/packlib/hepdb/cdroot/cdprnt.F
+++ /dev/null
@@ -1,49 +0,0 @@
-*
-* $Id: cdprnt.F,v 1.1.1.1 1996/02/28 16:24:31 mclareni Exp $
-*
-* $Log: cdprnt.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:31 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
-#if defined(CERNLIB__P3CHILD)
-* Ignoring t=dummy
-#endif
- SUBROUTINE CDPRNT (LUN, CFORM, IARG, NARG)
-* ==========================================
-*
-************************************************************************
-* *
-* SUBR. CDPRNT (LUN, CFORM, IARG, NARG) *
-* *
-* Prints a vector IARG of NARG elements on logical unit LUN *
-* *
-* Arguments : *
-* *
-* LUN Logical unit number of the output *
-* CFORM Format specification *
-* IARG Array of numbers to be printed *
-* NARG Number of elements in array IARG *
-* *
-* Called by various routines in the HEPDB package *
-* *
-************************************************************************
-*
- CHARACTER CFORM*(*)
- DIMENSION IARG(9)
-*
-* ------------------------------------------------------------------
-*
-#if !defined(CERNLIB__P3CHILD)
- IF(NARG.LE.0) THEN
- WRITE (LUN, CFORM, ERR=999)
- ELSE
- WRITE (LUN, CFORM, ERR=999) (IARG(I), I = 1, NARG)
- ENDIF
-#endif
-#if defined(CERNLIB__P3CHILD)
- CALL UTPRNT (LUN, CFORM, IARG, NARG)
-#endif
-* END CDPRNT
- 999 END
diff --git a/src/packlib/hepdb/cdroot/cdropn.F b/src/packlib/hepdb/cdroot/cdropn.F
deleted file mode 100644
index 8ffa96d..0000000
--- a/src/packlib/hepdb/cdroot/cdropn.F
+++ /dev/null
@@ -1,171 +0,0 @@
-*
-* $Id: cdropn.F,v 1.1.1.1 1996/02/28 16:24:31 mclareni Exp $
-*
-* $Log: cdropn.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:31 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
-#if defined(CERNLIB__P3CHILD)
-* Ignoring t=dummy
-#endif
- SUBROUTINE CDROPN (LUN, CHOPT, CFNAM, NRECL, IOERR)
-* ===================================================
-*
-************************************************************************
-* *
-* SUBR. CDROPN (LUN, CHOPT, CFNAM, NRECL, IOERR*) *
-* *
-* Opens a random access file *
-* *
-* Arguments : *
-* *
-* LUN Logical unit number *
-* CHOPT Character string with any of the following characters *
-* O Output file (default is input) *
-* Z File to be overwritten if exists *
-* CFNAM File name *
-* NRECL Record length in bytes *
-* IOERR Error code (0 if no error) *
-* *
-* Called by DBEXAMn *
-* *
-************************************************************************
-*
- DIMENSION IOPT(2)
- CHARACTER CHOPT*(*), CFNAM*(*), NAME*80, STATE*10
- EQUIVALENCE (IOPTO, IOPT(1)), (IOPTZ, IOPT(2))
-#if defined(CERNLIB_IBM)
- CHARACTER CHACT*10
-#endif
-#if defined(CERNLIB_SGI)||defined(CERNLIB_DECS)
- PARAMETER (JBYTES=4)
-#endif
-#if (defined(CERNLIB_WINNT))&&(!defined(CERNLIB_F2C))
- PARAMETER (JBYTES=4)
-#endif
-#if (!defined(CERNLIB_SGI))&&(!defined(CERNLIB_DECS))&&(!defined(CERNLIB_WINNT)||defined(CERNLIB_F2C))
- PARAMETER (JBYTES=1)
-#endif
-*
-* ------------------------------------------------------------------
-*
-* *** Check if Filename is meaningful
-*
- NCH = LENOCC (CFNAM)
- IF (NCH.LT.1) GO TO 999
- NCHM = MIN (50, NCH)
-#if (defined(CERNLIB_IBM))&&(!defined(CERNLIB__P3CHILD))
- NAME = '/'//CFNAM
-#endif
-#if defined(CERNLIB__P3CHILD)
- NAME = CFNAM
-#endif
-#if defined(CERNLIB_IBM)||defined(CERNLIB__P3CHILD)
- 10 L = INDEX (NAME, '.')
- IF (L.NE.0) THEN
- NAME(L:L) = ' '
- GO TO 10
- ENDIF
-#endif
-#if (!defined(CERNLIB_IBM))&&(!defined(CERNLIB__P3CHILD))
- NAME = CFNAM
-#endif
-#if (defined(CERNLIB_UNIX))&&(!defined(CERNLIB__P3CHILD))
- CALL CUTOL (NAME)
-#endif
-#if !defined(CERNLIB__P3CHILD)
-*
-* *** Analyse the option
-*
- CALL UOPTC (CHOPT, 'OZ', IOPT)
- IF (IOPTZ.NE.0) IOPTO = 1
-*
-* *** Decide on the record length
-*
- IF (NRECL.GT.0) THEN
- NREC = NRECL
- ELSE
- NREC = 4096
- ENDIF
-#endif
-#if (defined(CERNLIB_VAX))&&(!defined(CERNLIB__P3CHILD))
- NBLK = NREC
- NREC = NREC/4
-#endif
-#if !defined(CERNLIB__P3CHILD)
-*
-* *** Decide on state and form
-*
- IF (IOPTO.EQ.0) THEN
-#endif
-#if (defined(CERNLIB_APOLLO))&&(!defined(CERNLIB__P3CHILD))
- STATE = 'READONLY'
-#endif
-#if (defined(CERNLIB_IBM))&&(!defined(CERNLIB__P3CHILD))
- CHACT = 'READ'
-#endif
-#if (!defined(CERNLIB_APOLLO))&&(!defined(CERNLIB__P3CHILD))
- STATE = 'OLD'
-#endif
-#if !defined(CERNLIB__P3CHILD)
- ELSE
- STATE = 'UNKNOWN'
-#endif
-#if (defined(CERNLIB_IBM))&&(!defined(CERNLIB__P3CHILD))
- CHACT = 'READWRITE'
-#endif
-#if !defined(CERNLIB__P3CHILD)
- ENDIF
-*
-* *** Now open the file
-*
-#endif
-#if (defined(CERNLIB_IBM))&&(!defined(CERNLIB__P3CHILD))
- CALL FILEINF (IOERR, 'MAXREC', 2)
- IF (IOERR.NE.0) GO TO 50
- IF (IOPTZ.NE.0) THEN
- OPEN (UNIT=LUN, FILE=NAME, FORM='UNFORMATTED', RECL=NREC,
- + ACTION=CHACT, ACCESS='DIRECT', STATUS=STATE, IOSTAT=IOERR)
- IF (IOERR.NE.0) GO TO 50
- CLOSE (LUN)
- ENDIF
- CALL FILEINF (IOERR, 'MAXREC', 16777215)
- IF (IOERR.NE.0) GO TO 50
- OPEN (UNIT=LUN, FILE=NAME, FORM='UNFORMATTED', RECL=NREC,
- + ACTION=CHACT, ACCESS='DIRECT', STATUS=STATE, IOSTAT=IOERR)
- IF (IOERR.NE.0) GO TO 50
-#endif
-#if (!defined(CERNLIB_IBM))&&(!defined(CERNLIB_VAX))&&(!defined(CERNLIB__P3CHILD))
- OPEN (UNIT=LUN, FILE=NAME, ACCESS='DIRECT', STATUS=STATE,
- + RECL=NREC/JBYTES, FORM='UNFORMATTED', ERR=50, IOSTAT=IOERR)
-#endif
-#if (defined(CERNLIB_VAX))&&(!defined(CERNLIB__P3CHILD))
- IF (IOPTO.EQ.0) THEN
- OPEN (UNIT=LUN, FILE=NAME, ACCESS='DIRECT', STATUS=STATE,
- + READONLY, SHARED, FORM='UNFORMATTED', ERR=50,
- + IOSTAT=IOERR)
- ELSE
- OPEN (UNIT=LUN, FILE=NAME, ACCESS='DIRECT', STATUS=STATE,
- + SHARED, RECL=NREC, FORM='UNFORMATTED', ERR=50,
- + IOSTAT=IOERR)
- ENDIF
-#endif
-#if defined(CERNLIB__P3CHILD)
- CALL APOPNF (LUN, NAME, 'DIRECT', 'UNFORMATTED', 'F', NREC, 0,
- + IOERR)
- IF (IOERR.NE.0) GO TO 50
-#endif
- IOPT(1) = LUN
- IOPT(2) = NREC
- CALL CDPRNT (6, '('' CDROPN : '//NAME(1:NCHM)//' opened on Unit'//
- + ' '',I4,'' with RECL '',I8)', IOPT, 2)
- GO TO 999
-*
- 50 IOPT(1) = IOERR
- IOPT(2) = LUN
- CALL CDPRNT (6, '('' CDROPN Error : IOSTAT = '',I11,'' in openi'//
- + 'ng '//NAME(1:NCHM)//' on unit '',I4)', IOPT, 2)
-* END CDROPN
- 999 END
diff --git a/src/packlib/hepdb/cdroot/cdrzin.F b/src/packlib/hepdb/cdroot/cdrzin.F
deleted file mode 100644
index 1c3bcdf..0000000
--- a/src/packlib/hepdb/cdroot/cdrzin.F
+++ /dev/null
@@ -1,176 +0,0 @@
-*
-* $Id: cdrzin.F,v 1.1.1.1 1996/02/28 16:24:31 mclareni Exp $
-*
-* $Log: cdrzin.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:31 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
-#if defined(CERNLIB__P3CHILD)
-* Ignoring t=dummy
-#endif
- SUBROUTINE CDRZIN (IDIV, LAD, JBIAS, ICUR, ICYCL, PATHN, IRC)
-* =============================================================
-*
-************************************************************************
-* *
-* SUBR. CDRZIN (IDIV, *LAD*, JBIAS, ICUR, ICYCL*, PATHN, IRC*) *
-* *
-* Checks if enough space is left in memory before loading the data *
-* part of an object. When not enough space is available after *
-* garbage collection, the banks freed by DBFREE are dropped. *
-* *
-* Arguments : *
-* *
-* IDIV Division number where the object is to be created *
-* LAD Address of the data bank as returned by RZIN *
-* JBIAS Link bias as supplied to RZIN *
-* ICUR RZ key number of the object to be loaded *
-* ICYCL Cycle number of the data object *
-* PATHN Path name (only needed in the printout) *
-* IRC Return code (see below) *
-* *
-* Called by CDCDIC, CDCOMP, CDDDIR, CDKXIN, CDPART, CDPURP, CDRTFZ, *
-* CDUDIC, CDUNCP *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* = 34 : Error in RZ for reading the object *
-* = 99 : No space in memory for creating the bank *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
-#include "hepdb/ckkeys.inc"
-#if defined(CERNLIB__P3CHILD)
-#include "hepdb/p3dbl3.inc"
- CHARACTER RZDIP3*80
-#endif
- DIMENSION LAD(9)
- CHARACTER PATHD*80, PATHN*(*)
-#include "zebra/q_jbit.inc"
-* Ignoring t=pass
-* ------------------------------------------------------------------
-#if defined(CERNLIB__P3CHILD)
-*
- IF (IPASP3.EQ.1) THEN
-*
-* *** Stack the directory names and the key sequence numbers
-*
- MSDBP3 = ' '
- CALL RZCDIR (MSDBP3, 'R...')
- IF (NDIRP3.EQ.0.OR.MSDBP3.NE.RZDIP3) THEN
-* New directory
- NDIRP3 = NDIRP3+1
- RZDIP3 = MSDBP3
- IF (NDIRP3.EQ.1) THEN
- INDXP3 = 1
- ELSE
- INDXP3 = INDXP3+IQ(KOFUCD+LNK1P3+INDXP3+1)+21
- ENDIF
- IF (INDXP3+22.GT.IQ(KOFUCD+LNK1P3-1))
- + CALL MZPUSH (IXDBP3, LNK1P3, 0, 122, '....')
- CALL UCTOH (RZDIP3, IWDBP3, 4, 80)
- CALL ZHTOI (IWDBP3, IQ(KOFUCD+LNK1P3+INDXP3+2), 20)
- NBKDP3 = 0
- ENDIF
-* New key in this directory
- NBKDP3 = NBKDP3+1
- IQ(KOFUCD+LNK1P3+INDXP3+1) = NBKDP3
- IND = INDXP3+NBKDP3+21
- IF (IND.GT.IQ(KOFUCD+LNK1P3-1)-20)
- + CALL MZPUSH (IDISCD, LNK1P3, 0, 100, '....')
- IQ(KOFUCD+LNK1P3+IND) = ICUR
-*
- NBKYP3 = NBKYP3+1
- IRC = 0
- GO TO 999
-*
- ELSE IF (IPASP3.EQ.2) THEN
- IF (LNK4P3.EQ.0.OR.LNK5P3.EQ.0) THEN
- IRC = 34
- GO TO 990
- ENDIF
-* Get size of data object
- NWDS = IQ(KOFUCD+LNK4P3-1)
- GO TO 5
-*
- ENDIF
-#endif
-*
-* *** Find number of data words
-*
- IPNT = KOFSCD + LCDRCD + IKDRCD + (ICUR - 1) * (NWKYCK + 1)
- LCYC = IQ(IPNT)
- NWDS = JBYT (IQ(KOFSCD+LCDRCD+LCYC+3), 1, 20)
- IRC = 0
-*
-* *** See if enough space is available in memory
-*
- 5 NEEDW = NWDS + 100
- CALL MZNEED (IDIV, NEEDW, ' ')
- IF (IQUEST(11).LT.0) THEN
- CALL MZNEED (IDIV, NEEDW, 'G')
- IF (IQUEST(11).LT.0) THEN
- LGO = 0
- 10 LBFYCD = LZFIDH (IDIV, IHKYCD, LGO)
- IF (LBFYCD.NE.0) THEN
- ND0 = IQ(KOFUCD+LBFYCD-1)
- IF (IQ(KOFUCD+LBFYCD+ND0+MKYFRI).GT.0) THEN
- LDAT = LQ(KOFUCD+LBFYCD-KLDACD)
- IF (LDAT.GT.0) CALL MZDROP (IDIV, LDAT, 'L')
- ENDIF
- LGO = LBFYCD
- GO TO 10
- ENDIF
- CALL MZNEED (IDIV, NEEDW, 'G')
- IF (IQUEST(11).LT.0) THEN
- IRC = 99
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) THEN
- CALL CDPRNT (LPRTCD, '(/,'' CDRZIN : No space left for '//
- + 'loading object from disk == space needed '',I12)',
- + IQUEST(11), 1)
- ENDIF
-#endif
- GO TO 999
- ENDIF
- ENDIF
- ENDIF
-*
-* *** Now call RZIN
-*
-#if defined(CERNLIB__P3CHILD)
- IF (IPASP3.EQ.2) THEN
- CALL MZCOPY (IXDBP3, LNK4P3, IDIV, LAD(1), JBIAS, 'P...')
- CALL UCOPY (IQ(KOFUCD+LNK5P3+1), IQUEST(96), 5)
- LNK4P3 = LQ(KOFUCD+LNK4P3)
- LNK5P3 = LQ(KOFUCD+LNK5P3)
- IF (IRC.NE.0) GO TO 999
- IF (JBIAS.GT.0) THEN
- LBANK = LAD(1)
- ELSE
- LBANK = LQ(KOFUCD+LAD(1)+JBIAS)
- ENDIF
- IQUEST(11) = LBANK
- GO TO 999
- ENDIF
-*
-#endif
- ICYCL = 999999
- CALL RZIN (IDIV, LAD(1), JBIAS, ICUR, ICYCL, 'S')
- 990 IF (IQUEST(1).NE.0) THEN
- IRC = 34
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) THEN
- PATHD = PATHN
- NCH = LENOCC (PATHD)
- CALL CDPRNT (LPRTCD, '(/,'' CDRZIN : RZIN error for path '//
- + 'name '//PATHD(1:NCH)//''')', IARGCD, 0)
- ENDIF
-#endif
- ENDIF
-* END CDRZIN
- 999 END
diff --git a/src/packlib/hepdb/cdroot/cdsblc.F b/src/packlib/hepdb/cdroot/cdsblc.F
deleted file mode 100644
index 68a1794..0000000
--- a/src/packlib/hepdb/cdroot/cdsblc.F
+++ /dev/null
@@ -1,62 +0,0 @@
-*
-* $Id: cdsblc.F,v 1.1.1.1 1996/02/28 16:24:32 mclareni Exp $
-*
-* $Log: cdsblc.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:32 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDSBLC (PATHN, PATH, NCHAR)
-* ======================================
-*
-************************************************************************
-* *
-* SUBR. CDSBLC (PATHN, PATH*, NCHAR*) *
-* *
-* Suppresses the blank characters in a string *
-* *
-* Arguments : *
-* *
-* PATHN Input character string *
-* PATH Output character string with all blank characters *
-* removed *
-* NCHAR Number of non-blank characters in PATH *
-* *
-* Called by various routines in the HEPDB package *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
- CHARACTER PATHN*(*), PATH*(*)
-*
-* ------------------------------------------------------------------
-*
-* *** Suppress blanks from the path name
-*
- MAXL = MIN (MAXLCD, LEN (PATHN)) + 1
- NCHAR = 0
- ISWT = 0
- I11 = 1
- DO 10 I = 1, MAXL
- LBLK = 1
- IF (I.EQ.MAXL) GO TO 5
- IF (PATHN(I:I).NE.' ') LBLK = 0
- IF (ISWT.EQ.0.AND.LBLK.EQ.0) THEN
- ISWT = 1
- I11 = I
- ENDIF
- 5 IF (ISWT.NE.0.AND.LBLK.NE.0) THEN
- IF (NCHAR.EQ.0) THEN
- PATH = PATHN(I11:I-1)
- NCHAR = I - I11
- ELSE
- PATH = PATH(1:NCHAR)//PATHN(I11:I-1)
- NCHAR = NCHAR + I - I11
- ENDIF
- ISWT = 0
- ENDIF
- 10 CONTINUE
- IF (NCHAR.EQ.0) PATH = ' '
-* END CDSBLC
- END
diff --git a/src/packlib/hepdb/cdroot/cdsopn.F b/src/packlib/hepdb/cdroot/cdsopn.F
deleted file mode 100644
index d9952a4..0000000
--- a/src/packlib/hepdb/cdroot/cdsopn.F
+++ /dev/null
@@ -1,189 +0,0 @@
-*
-* $Id: cdsopn.F,v 1.1.1.1 1996/02/28 16:24:32 mclareni Exp $
-*
-* $Log: cdsopn.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:32 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
-#if defined(CERNLIB__P3CHILD)
-* Ignoring t=dummy
-#endif
- SUBROUTINE CDSOPN (LUN, CHOPT, CFNAM, NRECL, IOERR)
-* ===================================================
-*
-************************************************************************
-* *
-* SUBR. CDSOPN (LUN, CHOPT, CFNAM, NRECL, IOERR*) *
-* *
-* Opens a sequential FZ file *
-* *
-* Arguments : *
-* *
-* LUN Logical unit number *
-* CHOPT Character string with any of the following characters *
-* A ASCII file format *
-* O Output file (default is input) *
-* X Exchange binary format *
-* Z File to be overwritten if exists *
-* CFNAM File name *
-* NRECL Record length in bytes *
-* IOERR Error code (0 if no error) *
-* *
-* Called by DBEXAMn *
-* *
-************************************************************************
-*
- DIMENSION IOPT(5)
- CHARACTER CHOPT*(*), CFNAM*(*), NAME*80, STATE*10, FORMT*12
- CHARACTER CHOP*8
- EQUIVALENCE (IOPTA, IOPT(1)), (IOPTI, IOPT(2))
- + , (IOPTO, IOPT(3)), (IOPTX, IOPT(4))
- + , (IOPTZ, IOPT(5))
- CHARACTER*80 CHFMAT
-#if defined(CERNLIB_IBMVM)
- CHARACTER FILE*96, CHLUN*2, CHREC*5, CHFIL*96
-#endif
-#if defined(CERNLIB_SGI)||defined(CERNLIB_DECS)
- PARAMETER (JBYTES=4)
-#endif
-#if (defined(CERNLIB_WINNT))&&(!defined(CERNLIB_F2C))
- PARAMETER (JBYTES=4)
-#endif
-#if (!defined(CERNLIB_SGI))&&(!defined(CERNLIB_DECS))&&(!defined(CERNLIB_WINNT)||defined(CERNLIB_F2C))
- PARAMETER (JBYTES=1)
-#endif
-*
-* ------------------------------------------------------------------
-*
-* *** Access the file name, etc.
-*
- NCH = LENOCC (CFNAM)
- IF (NCH.LT.1) GO TO 999
- NCHM = MIN (50, NCH)
- NAME = CFNAM
-#if defined(CERNLIB_IBMVM)||defined(CERNLIB__P3CHILD)
- 10 L = INDEX (NAME, '.')
- IF (L.NE.0) THEN
- NAME(L:L) = ' '
- GO TO 10
- ENDIF
-#endif
-#if (defined(CERNLIB_UNIX))&&(!defined(CERNLIB__P3CHILD))
- CALL CUTOL (NAME)
-#endif
-*
-* *** Analyse the option
-*
- CALL UOPTC (CHOPT, 'AIOXZ', IOPT)
-*
-* *** Decide on the record length
-*
- IF (NRECL.GT.0) THEN
- NREC = NRECL
- ELSE IF (IOPTX.NE.0) THEN
- NREC = 3600
- ELSE IF (IOPTA.NE.0) THEN
- NREC = 80
- ELSE
- NREC = 10000
- ENDIF
- CHOP = CHOPT
-#if defined(CERNLIB_CRAY)
- LREC = NREC/8
-#endif
-#if !defined(CERNLIB_CRAY)
- LREC = NREC/4
-#endif
-*
-* *** Decide on state and form
-*
- IF (IOPTO.EQ.0) THEN
- STATE = 'OLD'
- ELSE
-#if defined(CERNLIB_VAX)
- IF (IOPTZ.EQ.0) THEN
- STATE = 'NEW'
- ELSE
- STATE = 'UNKNOWN'
- ENDIF
-#endif
-#if !defined(CERNLIB_VAX)
- STATE = 'UNKNOWN'
-#endif
- ENDIF
- IF (IOPTA.NE.0) THEN
- FORMT = 'FORMATTED'
- ELSE
- FORMT = 'UNFORMATTED'
- ENDIF
-*
-* *** Now open the file
-*
-#if (defined(CERNLIB_IBMVM))&&(!defined(CERNLIB__P3CHILD))
- WRITE (CHLUN, '(I2.2)') LUN
- WRITE (CHREC, '(I5)') NREC
- IF (IOPTX.NE.0) THEN
- FILE = 'FILEDEF IOFILE'//CHLUN//' DISK '//NAME
- NCH = LENOCC (FILE)
- CHFIL = FILE(1:NCH)//' (RECFM U BLKSIZE '//CHREC//' PERM'
- CHOP = 'Y'//CHOPT
- ELSE
- FILE = 'FILEDEF '//CHLUN//' DISK '//NAME
- NCH = LENOCC (FILE)
- IF (IOPTA.NE.0) THEN
- CHFIL = FILE(1:NCH)//' (RECFM FB BLKSIZE '//CHREC//' PERM'
- ELSE
- CHFIL = FILE(1:NCH)//' (RECFM U BLKSIZE '//CHREC//' PERM'
- ENDIF
- ENDIF
- CALL VMCMS (CHFIL, IOERR)
- IF (IOERR.NE.0) GO TO 50
- OPEN (UNIT=LUN, FORM=FORMT)
-#endif
-#if (defined(CERNLIB_APOLLO))&&(!defined(CERNLIB__P3CHILD))
- OPEN (UNIT=LUN, FILE=NAME, FORM=FORMT, STATUS=STATE,
- + RECL=NREC/JBYTES, ERR=50, IOSTAT=IOERR)
-#endif
-#if (defined(CERNLIB_UNIX))&&(!defined(CERNLIB_APOLLO))&&(!defined(CERNLIB__P3CHILD))
- OPEN (UNIT=LUN, FILE=NAME, FORM=FORMT, STATUS=STATE,
- + ERR=50, IOSTAT=IOERR)
-#endif
-#if (defined(CERNLIB_VAX))&&(!defined(CERNLIB__P3CHILD))
- IF (STATE.EQ.'OLD') THEN
- OPEN (UNIT=LUN, FILE=NAME, FORM=FORMT, STATUS=STATE,
- + READONLY, SHARED, ERR=50, IOSTAT=IOERR)
- ELSE IF (IOPTX.NE.0) THEN
- OPEN (UNIT=LUN, FILE=NAME, FORM=FORMT, STATUS=STATE,
- + RECORDTYPE='FIXED', RECL=LREC, BLOCKSIZE=NREC, ERR=50,
- + IOSTAT=IOERR)
- ELSE
- OPEN (UNIT=LUN, FILE=NAME, FORM=FORMT, STATUS='UNKNOWN',
- + RECL=NREC, ERR=50, IOSTAT=IOERR)
- ENDIF
-#endif
-#if defined(CERNLIB__P3CHILD)
- CALL APOPNF (LUN, NAME, 'SEQUENTIAL', FORMT, 'F', NREC, 0, IOERR)
- IF (IOERR.NE.0) GO TO 50
-#endif
- IOPT(1) = LUN
- IOPT(2) = NREC
-
- CHFMAT= ' ''('''' CDSOPN : '//NAME(1:NCHM)//' opened on Unit'//
- & ' '''',I4,'''' with RECL '''',I8)'' '
- CALL CDPRNT (6, CHFMAT, IOPT, 2)
-
-* CALL CDPRNT (6, '('' CDSOPN : '//NAME(1:NCHM)//' opened on Unit'//
-* + ' '',I4,'' with RECL '',I8)', IOPT, 2)
-*
- CALL FZFILE (LUN, LREC, CHOP)
- GO TO 999
-*
- 50 IOPT(1) = IOERR
- IOPT(2) = LUN
- CHFMAT = ' ''('''' CDSOPN Error : IOSTAT = '''',I11,//
- + '''' in opening '//NAME(1:NCHM)//' on unit '''',I4)'' '
- CALL CDPRNT (6, CHFMAT, IOPT, 2)
-* END CDSOPN
- 999 END
diff --git a/src/packlib/hepdb/cdroot/cdtopn.F b/src/packlib/hepdb/cdroot/cdtopn.F
deleted file mode 100644
index 95ee994..0000000
--- a/src/packlib/hepdb/cdroot/cdtopn.F
+++ /dev/null
@@ -1,57 +0,0 @@
-*
-* $Id: cdtopn.F,v 1.1.1.1 1996/02/28 16:24:32 mclareni Exp $
-*
-* $Log: cdtopn.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:32 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDTOPN (PATHN, TOPN, NCH)
-* ====================================
-*
-************************************************************************
-* *
-* SUBR. CDTOPN (PATHN, TOPN*, NCH*) *
-* *
-* Extracts the top directory name from the path name *
-* *
-* Arguments : *
-* *
-* PATHN Character string describing the pathname *
-* TOPN Name of the top directory *
-* NCH Number of characters in TOPN *
-* *
-* Called by CDFZUP, CDLDUP, CDMDIR *
-* *
-************************************************************************
-*
- CHARACTER PATHN*(*), TOPN*(*)
-*
-* ------------------------------------------------------------------
-*
- NCTOT = LENOCC (PATHN)
- I1 = 0
- I11 = 0
- DO 10 I0 = 1, NCTOT
- IF (PATHN(I0:I0).EQ.'/') THEN
- IF (I1.GT.0) THEN
- TOPN = PATHN(I11:I0-1)
- NCH = I0 - I11
- GO TO 15
- ENDIF
- ELSE
- IF (I1.EQ.0) I11 = I0
- I1 = I1 +1
- ENDIF
- 10 CONTINUE
- IF (I1.GT.0) THEN
- TOPN = PATHN(I11:NCTOT)
- NCH = NCTOT - I11 + 1
- ELSE
- NCH = 0
- TOPN = ' '
- ENDIF
- 15 CONTINUE
-* END CDTOPN
- END
diff --git a/src/packlib/hepdb/cdroot/cduvtx.F b/src/packlib/hepdb/cdroot/cduvtx.F
deleted file mode 100644
index c7f0683..0000000
--- a/src/packlib/hepdb/cdroot/cduvtx.F
+++ /dev/null
@@ -1,46 +0,0 @@
-*
-* $Id: cduvtx.F,v 1.1.1.1 1996/02/28 16:24:32 mclareni Exp $
-*
-* $Log: cduvtx.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:32 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDUVTX (IDAY, ITIM)
-* ==============================
-*
-************************************************************************
-* *
-* SUBR. CDUVTX (IDAY*, ITIM*) *
-* *
-* Returns the current date and time *
-* *
-* Arguments : *
-* *
-* IDAY Date in YYMMDD *
-* ITIM Time in seconds *
-* *
-* Called by CDFOPN, DBxxxx in the Example patches *
-* *
-************************************************************************
-*
-#if !defined(CERNLIB_VAX)
- COMMON /SLATE/ ISLAT(40)
-#endif
- INTEGER IDAY, ITIM
-*
-* ------------------------------------------------------------------
-*
-* ** Get date and time for constructing the return arguments
-*
-#if !defined(CERNLIB_VAX)
- CALL DATIME (IDAY, ITIM)
- IDAY = MOD (IDAY, 1000000)
- ITIM = ISLAT(4) * 3600 + ISLAT(5) * 60 + ISLAT(6)
-#endif
-#if defined(CERNLIB_VAX)
- CALL LIB$DAY (IDAY,,ITIM)
-#endif
-* END CDUVTX
- END
diff --git a/src/packlib/hepdb/cdroot/cdvers.F b/src/packlib/hepdb/cdroot/cdvers.F
deleted file mode 100644
index 43e88f0..0000000
--- a/src/packlib/hepdb/cdroot/cdvers.F
+++ /dev/null
@@ -1,58 +0,0 @@
-*
-* $Id: cdvers.F,v 1.4 1996/04/12 09:42:21 cernlib Exp $
-*
-* $Log: cdvers.F,v $
-* Revision 1.4 1996/04/12 09:42:21 cernlib
-* New handling of title
-*
-* Revision 1.3 1996/03/29 11:18:12 jamie
-* qftitlch
-*
-* Revision 1.2 1996/03/28 10:37:20 jamie
-* update IDATQQ/ITIMQQ
-*
-* Revision 1.1.1.1 1996/02/28 16:24:32 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDVERS(CHTITL,CHCOMP,CHOPT)
-*
-* Print or return HEPDB version number
-*
- CHARACTER*(*) CHTITL,CHCOMP,CHOPT
- CHARACTER*80 CTITLE,CCOMPL
-
-#include "hepdb/cduscm.inc"
-#include "zebra/zunit.inc"
-
- IDATQQ = 960328
- ITIMQQ = 1130
-*
-* Clear title and compilation date/time
-*
- CTITLE = ' '
- CCOMPL = ' '
-
-#include "hepdb/qftitlch.inc"
- CTITLE =
- + HepdbTitleFortranString
- WRITE(CCOMPL,9001) IDATQQ,ITIMQQ
-9001 FORMAT(' This version created on ',I6,' at ',I4)
-
- LTITLE = LENOCC(CTITLE)
- LCOMPL = LENOCC(CCOMPL)
-
- IF(INDEX(CHOPT,'P').NE.0) THEN
-
- WRITE(LPRTCD,*) CTITLE(1:LTITLE)
- WRITE(LPRTCD,*) CCOMPL(1:LCOMPL)
-
- ELSE
-
- CHTITL = CTITLE(1:LTITLE)
- CHCOMP = CCOMPL(1:LCOMPL)
-
- ENDIF
-
- END
diff --git a/src/packlib/hepdb/cdroot/cdwtop.F b/src/packlib/hepdb/cdroot/cdwtop.F
deleted file mode 100644
index e03d242..0000000
--- a/src/packlib/hepdb/cdroot/cdwtop.F
+++ /dev/null
@@ -1,50 +0,0 @@
-*
-* $Id: cdwtop.F,v 1.1.1.1 1996/02/28 16:24:32 mclareni Exp $
-*
-* $Log: cdwtop.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:32 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDWTOP (PATHN, WTOP, NCH)
-* ====================================
-*
-************************************************************************
-* *
-* SUBR. CDWTOP (PATHN, WTOP*, NCH*) *
-* *
-* Extracts the name without the top directory from the path name *
-* *
-* Arguments : *
-* *
-* PATHN Character string describing the pathname *
-* WTOP Name without the top directory *
-* NCH Number of characters in WTOP *
-* *
-* Called by CDCDIC, CDLDIC *
-* *
-************************************************************************
-*
- CHARACTER PATHN*(*), WTOP*(*)
-*
-* ------------------------------------------------------------------
-*
- NCTOT = LENOCC (PATHN)
- I1 = 0
- DO 10 I0 = 1, NCTOT
- IF (PATHN(I0:I0).EQ.'/') THEN
- IF (I1.GT.0) THEN
- WTOP = PATHN(I0:NCTOT)
- NCH = NCTOT - I0 + 1
- GO TO 15
- ENDIF
- ELSE
- I1 = I1 +1
- ENDIF
- 10 CONTINUE
- NCH = 0
- WTOP = ' '
- 15 CONTINUE
-* END CDWTOP
- END
diff --git a/src/packlib/hepdb/cdroot/icdtyp.F b/src/packlib/hepdb/cdroot/icdtyp.F
deleted file mode 100644
index 4c68eb1..0000000
--- a/src/packlib/hepdb/cdroot/icdtyp.F
+++ /dev/null
@@ -1,39 +0,0 @@
-*
-* $Id: icdtyp.F,v 1.1.1.1 1996/02/28 16:24:32 mclareni Exp $
-*
-* $Log: icdtyp.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:32 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- FUNCTION ICDTYP (L)
-* ===================
-*
-************************************************************************
-* *
-* FUNC. ICDTYP (L) *
-* *
-* Gets the bank I/O type from the address of L *
-* *
-* Arguments : *
-* *
-* L Address of the bank *
-* *
-* Called by various routines in the HEPDB package *
-* *
-* ICDTYP = I/O descriptor (see MZBOOK/MZFORM) *
-* < 7 = simple bank *
-* > 7 = self describing *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
-#include "zebra/q_jbit.inc"
-* Ignoring t=pass
-*
-* ------------------------------------------------------------------
-*
- LST = L - IQ(KOFUCD+L-3) - JBYT(IQ(KOFUCD+L),19,4) - 1
- ICDTYP = JBYT (LQ(KOFUCD+LST), 17, 16)
-* END ICDTYP
- END
diff --git a/src/packlib/hepdb/cdstore/Imakefile b/src/packlib/hepdb/cdstore/Imakefile
deleted file mode 100644
index 8485060..0000000
--- a/src/packlib/hepdb/cdstore/Imakefile
+++ /dev/null
@@ -1,8 +0,0 @@
-SRCS_F= cdatoi.F cdctoi.F cddont.F cdentb.F cdhunt.F cdkout.F \ @@\
- cdpval.F cdrenk.F cdrepl.F cdstom.F cdstor.F
-
-#if !defined(CERNLIB_P3CHILD)
-SRCS_F := $(SRCS_F) cdenfz.F
-#endif
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/hepdb/cdstore/cdatoi.F b/src/packlib/hepdb/cdstore/cdatoi.F
deleted file mode 100644
index aecf5b5..0000000
--- a/src/packlib/hepdb/cdstore/cdatoi.F
+++ /dev/null
@@ -1,120 +0,0 @@
-*
-* $Id: cdatoi.F,v 1.1.1.1 1996/02/28 16:24:33 mclareni Exp $
-*
-* $Log: cdatoi.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:33 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
-#if defined(CERNLIB__P3CHILD)
-* Ignoring t=dummy
-#endif
- SUBROUTINE CDATOI (LUN, LBD, IRC)
-* =================================
-*
-************************************************************************
-* *
-* SUBR. CDATOI (LUN, LBD*, IRC*) *
-* *
-* Reads in from a file already opened and converts the ASCII file *
-* to packed bits in a zebra bank *
-* *
-* Arguments : *
-* *
-* LUN Logical unit number of the file with ASCII data *
-* LBD Address of the data bank *
-* IRC Return code (see below) *
-* *
-* Called by CDCHAR *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* = 66 : Illegal logical unit number *
-* = 67 : File too long; no space in buffer *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
-#include "hepdb/clinks.inc"
-#if defined(CERNLIB__P3CHILD)
-#include "hepdb/p3dbl3.inc"
-#endif
- PARAMETER (JBIAS=2)
- DIMENSION LBD(9)
- CHARACTER CHID*4, KLINE*80
-*
-* ------------------------------------------------------------------
-*
- LBD(1) = 0
- IRC = 0
-*
-* *** Check on logical unit number
-*
- IF (LUN.LE.0) THEN
- IRC = 66
- IQUEST(11) = LUN
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDATOI : Illegal'//
- + ' unit number '',I10,'' for ASCII file'')', IQUEST(11), 1)
-#endif
- GO TO 999
- ENDIF
-*
-* *** Read in the file and store the content in a bank
-*
- NDATA = NDMXCB
-#if !defined(CERNLIB__P3CHILD)
- IF (LBFXCD.NE.0) THEN
- CALL UHTOC (IQ(KOFUCD+LBFXCD-4), 4, CHID, 4)
- IF (CHID.EQ.'USER') CALL MZDROP (IDIVCD, LBFXCD, ' ')
- ENDIF
- CALL CDBANK (IDIVCD, LBFXCD, LBFXCD, JBIAS, 'USER', 0, 0, NDATA,
- + 1, -1, IRC)
- IF (IRC.NE.0) GO TO 999
-*
-* ** Now read the file
-*
- NDAT = 0
- NREC = 0
- 10 READ (LUN, 1000, ERR=20, END=20) KLINE
- NREC = NREC + 1
- LENG = LENOCC (KLINE)
- CALL CDLINC (KLINE, LENG, IQ(KOFUCD+LBFXCD+1), NDAT)
- IF (NDAT.GT.NDATA-20) THEN
- IRC = 67
- LBD(1) = LBFXCD
- IQUEST(11) = NREC
-#endif
-#if (defined(CERNLIB__DEBUG))&&(!defined(CERNLIB__P3CHILD))
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDATOI : Buffer '//
- + 'full after '',I8,'' records'')', IQUEST(11), 1)
-#endif
-#if !defined(CERNLIB__P3CHILD)
- GO TO 999
- ENDIF
- GO TO 10
-*
- 20 NDP = NDAT - NDATA
- IF (NDP.LT.0) CALL MZPUSH (IDIVCD, LBFXCD, 0, NDP, 'I')
- LBD(1) = LBFXCD
-#endif
-#if defined(CERNLIB__P3CHILD)
- RNDBP3 = 'CDATOI'
- NWDBP3 = 1
- IWDBP3(1) = LUN
- CALL CDCHLD
- IF (IQDBP3.NE.0) THEN
- IRC = IQDBP3
- GO TO 999
- ENDIF
- CALL APFZIN (LIDBP3, IDIVCD, LBFXCD, JBIAS, 'E', 0, IWDBP3)
- LBD(1) = LBFXCD
-#endif
-#if !defined(CERNLIB__P3CHILD)
-*
- 1000 FORMAT (A80)
-#endif
-* END CDATOI
- 999 END
diff --git a/src/packlib/hepdb/cdstore/cdctoi.F b/src/packlib/hepdb/cdstore/cdctoi.F
deleted file mode 100644
index a29fba8..0000000
--- a/src/packlib/hepdb/cdstore/cdctoi.F
+++ /dev/null
@@ -1,85 +0,0 @@
-*
-* $Id: cdctoi.F,v 1.1.1.1 1996/02/28 16:24:34 mclareni Exp $
-*
-* $Log: cdctoi.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:34 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDCTOI (CHTEXT, NTEXT, LTEXT, LBD, IRC)
-* ==================================================
-*
-************************************************************************
-* *
-* SUBR. CDCTOI (CHTEXT, NTEXT, LTEXT, LBD, IRC) *
-* *
-* Copy character data to packed bits in a zebra bank *
-* *
-* Arguments : *
-* *
-* CHTEXT Character array containing the data *
-* NTEXT Number of elements to be stored *
-* LTEXT Maximum length to take from each element (ignored) *
-* LBD Address of the data bank *
-* IRC Return code (see below) *
-* *
-* Called by CDCHAR *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* = 66 : Illegal logical unit number *
-* = 67 : File too long; no space in buffer *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
-#include "hepdb/clinks.inc"
- CHARACTER*(*) CHTEXT(NTEXT)
- PARAMETER (JBIAS=2)
- DIMENSION LBD(9)
- CHARACTER CHID*4, KLINE*80
-*
-* ------------------------------------------------------------------
-*
- LBD(1) = 0
- IRC = 0
-*
-* *** Copy character data into a bank
-*
- NDATA = NDMXCB
- IF (LBFXCD.NE.0) THEN
- CALL UHTOC (IQ(KOFUCD+LBFXCD-4), 4, CHID, 4)
- IF (CHID.EQ.'USER') CALL MZDROP (IDIVCD, LBFXCD, ' ')
- ENDIF
- CALL CDBANK (IDIVCD, LBFXCD, LBFXCD, JBIAS, 'USER', 0, 0, NDATA,
- + 1, -1, IRC)
- IF (IRC.NE.0) GO TO 999
-*
-* ** Now copy the data
-*
- NDAT = 0
- NREC = 0
- DO 10 I=1,NTEXT
- KLINE = CHTEXT(I)
- NREC = NREC + 1
- LENG = LENOCC (KLINE)
- CALL CDLINC (KLINE, LENG, IQ(KOFUCD+LBFXCD+1), NDAT)
- IF (NDAT.GT.NDATA-20) THEN
- IRC = 67
- LBD(1) = LBFXCD
- IQUEST(11) = NREC
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDCTOI : Buffe'//
- + 'r full after '',I8,'' records'')', IQUEST(11), 1)
-#endif
- GO TO 999
- ENDIF
- 10 CONTINUE
-*
- 20 NDP = NDAT - NDATA
- IF (NDP.LT.0) CALL MZPUSH (IDIVCD, LBFXCD, 0, NDP, 'I')
- LBD(1) = LBFXCD
-* END CDCTOI
- 999 END
diff --git a/src/packlib/hepdb/cdstore/cddont.F b/src/packlib/hepdb/cdstore/cddont.F
deleted file mode 100644
index 87277e0..0000000
--- a/src/packlib/hepdb/cdstore/cddont.F
+++ /dev/null
@@ -1,410 +0,0 @@
-*
-* $Id: cddont.F,v 1.1.1.1 1996/02/28 16:24:33 mclareni Exp $
-*
-* $Log: cddont.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:33 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
-#if defined(CERNLIB__P3CHILD)
-* Ignoring t=dummy
-#endif
- SUBROUTINE CDDONT (PATHN, IUDIV, LSUP, KEY, CHOPT, IRC)
-* =======================================================
-*
-************************************************************************
-* *
-* SUBR. CDDONT (PATHN, IUDIV, LSUP, KEY, CHOPT, IRC*) *
-* *
-* Stores data from memory to disk. If data exist with the same user *
-* keys, the old object is physically replaced. This mode is not *
-* recommended for all calibration data. *
-* *
-* Arguments : *
-* *
-* PATHN Character string describing the pathname *
-* IUDIV Division index of the user data bank *
-* LSUP Address of bank in memory where data reside *
-* KEY Vector of keys *
-* CHOPT Character string with any of the following characters *
-* B Save in the special backup file; not in standard Journal*
-* H Insertion time as supplied by user to be honoured *
-* IRC Return code (see below) *
-* *
-* Called by user, CDFZUP *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* = 71 : Illegal path name *
-* = 73 : RZ error during writing to disk *
-* = 76 : Cannot form the IO descriptor for the FZ header *
-* = 77 : FZOUT fails to write on to the sequential file *
-* *
-************************************************************************
-*
-#include "hepdb/caopts.inc"
-#include "hepdb/cdcblk.inc"
-#include "hepdb/cfzlun.inc"
-#include "hepdb/ckkeys.inc"
-#include "hepdb/ctpath.inc"
-#if defined(CERNLIB__P3CHILD)
-#include "hepdb/p3dbl3.inc"
-#endif
- PARAMETER (NLEVM=20)
- DIMENSION KEY(9), LSUP(9), KEYV(MXDMCK), NLCUR(NLEVM)
- CHARACTER CHOPT*(*), PATHN*(*), CHOPF*4, PATHY*80, PATHL*80
- CHARACTER CFORM(6)*1, CHFOR*100, CHCUR(NLEVM)*1
- DATA CFORM /'B', 'I', 'F', 'D', 'H', 'A'/
-#include "zebra/q_jbit.inc"
-* Ignoring t=pass
-#include "zebra/q_sbit.inc"
-* Ignoring t=pass
-*
-* ------------------------------------------------------------------
-*
-* *** Decode the character option (no compression of data)
-*
- LREFCD(1) = LSUP(1)
- CALL CDOPTS (CHOPT, IRC)
- IF (IRC.NE.0) GO TO 999
- IOPYCA = 1
-*
-* *** Load top directory information; gets in PAT1CT complete path name
-*
- CALL CDLDUP (PATHN, 1, IRC)
- IF (IRC.NE.0) GO TO 999
- PATHY = PAT1CT
- NCHAR = LENOCC (PATHY)
- NWKEY = NWKYCK
- PATHL = ' '
- KST = NWKYCK + 1
- CALL CDKYTG
- IF (NKEYCK.NE.0) THEN
- IOPTP = JBIT (IQ(KOFSCD+LCDRCD+IKDRCD+IDHFLG), JPRTCD)
- ELSE
- IOPTP = 0
- ENDIF
-*
-* *** Load IPREC/DELTA from dictionary; choose the transcript file
-*
- CALL CDLDIC (PATHY, 1, IRC)
- IF (IRC.NE.0) GO TO 999
- IF (IOPBCA.EQ.0) THEN
- LUFZCF = LUFZCD
- ELSE
- LUFZCF = LUBKCD
- ENDIF
-*
-* *** Prepare the Key vector array
-*
- CALL VZERO (KEYVCK, MXDMCK)
- DO 10 I = 1, NPARCD
- KEYVCK(NOF1CK+2*I-1) = KEY(NOF1CK+2*I-1)
- KEYVCK(NOF1CK+2*I) = KEY(NOF1CK+2*I)
- 10 CONTINUE
- KEYVCK(IDHUSI) = KEY(IDHUSI)
- IF (IOPHCA.NE.0) THEN
- KEYVCK(IDHINS) = KEY(IDHINS)
- ELSE
- CALL DATIME (IDATE, ITIME)
- CALL CDPKTM (IDATE, ITIME, KEYVCK(IDHINS), IRC)
- ENDIF
- IF (NWKYCK.GT.NSYSCK) THEN
- DO 15 NK = NSYSCK+1, NWKYCK
- IOKYCA(NK) = 1
- KEYVCK(NK) = KEY(NK)
- 15 CONTINUE
- ENDIF
-*
-* *** Encode the character option, IO descriptor for the header
-*
- IF (IOPPCD.NE.0.OR.LUFZCF.GT.0) THEN
- IF (IOPHCA.NE.0) THEN
- CHOPF = 'H'//CHOPT
- ELSE
- CHOPF = CHOPT
- ENDIF
- NDOP = LENOCC (CHOPF)
- NDOP = (NDOP + 3) / 4
-*
- NLEV = 1
- NCUR = 5
- IFORO = 2
- CHCUR(NLEV) = CFORM(IFORO)
- DO 20 I = 1, NWKYCK
- IFORM = IOTYCK(I)
- IF (IFORM.EQ.6) IFORM = 5
- IF (IFORM.EQ.IFORO) THEN
- NCUR = NCUR + 1
- ELSE
- NLCUR(NLEV) = NCUR
- IF (NLEV.GE.NLEVM) THEN
- IRC = 76
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDDONT : '//
- + 'Cannot get IO descriptor '//PATHY//''')', IARGCD, 0)
-#endif
- GO TO 999
- ENDIF
- NLEV = NLEV + 1
- CHCUR(NLEV) = CFORM(IFORM)
- NCUR = 1
- IFORO = IFORM
- ENDIF
- 20 CONTINUE
- NLCUR(NLEV) = NCUR
-*
-#if !defined(CERNLIB_IBM)||!defined(CERNLIB__P3CHILD)
- WRITE (CHFOR, 2001) (NLCUR(I), CHCUR(I), I = 1, NLEV)
-#endif
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB__P3CHILD))
- CHFOR = ' '
- II = 1
- DO 25 I = 1, NLEV
- CALL UTWRIT (CHFOR(II:II+1), '(I2)', NLCUR(I))
- II = II + 2
- CHFOR(II:II) = CHCUR(I)
- II = II + 2
- 25 CONTINUE
-#endif
- II = 4 *NLEV
- CHFOR = CHFOR(1:II)//' -H'
- CALL MZIOCH (IOFMCF, NWFMCF, CHFOR(1:II+3))
-*
-* ** Complete the header
-*
- NWDP = (NCHAR + 3) / 4
- NWDH = NWDP + NDOP + NWKYCK + 5
- IHEDCF(MACTCF) = 9
- IHEDCF(MNKYCF) = NWKYCK
- IHEDCF(MOPTCF) = NDOP
- IHEDCF(MPATCF) = NWDP
- IHEDCF(MPRECF) = 0
- IF (NDOP.GT.0)
- + CALL UCTOH (CHOPF, IHEDCF(MPRECF+NWKYCK+1), 4, 4*NDOP)
- CALL UCTOH (PATHY, IHEDCF(MPRECF+NWKYCK+NDOP+1), 4, 4*NWDP)
- CALL UCOPY (KEYVCK, IHEDCF(MPRECF+1), NWKYCK)
- ENDIF
-#if (defined(CERNLIB_UNIX)||defined(CERNLIB_IBMVM)||defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))
-*
- IF (IOPPCD.NE.0) THEN
-#endif
-#if (defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))&&(!defined(CERNLIB__P3CHILD))&&(defined(CERNLIB__ONLINE))
- LUFZCF = LUFMCD
- CALL CDWLOK (IRC)
-#endif
-#if (defined(CERNLIB_UNIX)||defined(CERNLIB_IBMVM)||defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))&&(!defined(CERNLIB__P3CHILD))&&(!defined(CERNLIB__ONLINE))
- CALL CDSTSV (TOPNCD, 0, IRC)
-#endif
-#if defined(CERNLIB__P3CHILD)
- LUFZCF = LODBP3
- RNDBP3 = 'CDDONT '
- NWDBP3 = 2
- CALL UCTOH ('JOURNAL ', IWDBP3, 4, 8)
- CALL CDCHLD
- IRC = IQDBP3
-#endif
-#if (defined(CERNLIB_UNIX)||defined(CERNLIB_IBMVM)||defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))
- IF (IRC.NE.0) GO TO 999
- ENDIF
-#endif
-*
-* ** Write the sequential output if needed
-*
- IF (LUFZCF.GT.0) THEN
- CALL FZOUT (LUFZCF, IUDIV, LREFCD(1), 1, 'L', IOFMCF, NWDH,
- + IHEDCF)
- IF (IQUEST(1).NE.0) THEN
- IRC = 77
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDDONT : Error'//
- + ' in FZOUT while writing Data for '//PATHY//''')', IARGCD, 0)
-#endif
- GO TO 999
- ENDIF
- ENDIF
-#if (defined(CERNLIB_UNIX)||defined(CERNLIB_IBMVM)||defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))
-*
- IF (IOPPCD.NE.0) THEN
-#endif
-#if (defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))&&(!defined(CERNLIB__P3CHILD))&&(defined(CERNLIB__ONLINE))
-*
- CALL CDCWSV (IRC)
-#endif
-#if (defined(CERNLIB_UNIX)||defined(CERNLIB_IBMVM)||defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))
- GO TO 999
- ENDIF
-#endif
-#if !defined(CERNLIB__P3CHILD)
-*
-* *** Lock the directory if necessary
-*
- IF (IOPPCD.EQ.0.AND.IOPSCD.NE.0) THEN
- CALL RZLOCK ('CDDONT')
- PATHL = PATHY
- ENDIF
-*
-* *** Look if object already exists with similar user keys
-*
- IF (IOPTP.EQ.0) THEN
- CALL CDHUNT (KEYV)
-*
- ELSE
-*
- NKEYS = NKEYCK
- DO 30 JK = 1, NKEYS
- ICURCT = NKEYS + 1 - JK
- CALL CDPATH (TOP1CT, ICURCT)
- IF (JK.NE.1) THEN
- CALL RZCDIR (PATHY, ' ')
- IF (IQUEST(1).NE.0) GO TO 991
- ENDIF
-*
- CALL RZCDIR (TOP1CT, ' ')
- IF (IQUEST(1).NE.0) GO TO 991
- NKEYCK = IQUEST(7)
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- CALL CDHUNT (KEYV)
- IF (KEYV(1).GT.0) GO TO 35
-*
- 30 CONTINUE
-*
- ENDIF
-*
-* *** Either update an old record
-*
- 35 IF (KEYV(1).GT.0) THEN
- CALL RZOUT (IUDIV, LREFCD(1), KEYV, ICYCLE, 'L')
- IER = IQUEST(1)
- IKDRCD = IQ(KOFSCD+LCDRCD+KLKDCD)
- NKEYCK = IQ(KOFSCD+LCDRCD+KNKDCD)
- CALL RZPURG (0)
- IF (IER.NE.0) IQUEST(1) = IER
-*
-* *** Or enter a new one
-*
- ELSE
-*
-* ** Take necessary action for partitioned and nonpartitioned dataset
-*
- IF (IOPTP.EQ.0) THEN
- KOBJ = 0
- ELSE
- CALL RZCDIR (PATHY, ' ')
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- KPNT = IUHUNT (NKEYS, IQ(KOFSCD+LCDRCD+IKDRCD+MPSRCD),
- + NKEYS*KST, KST)
- IF (KPNT.NE.0) THEN
- NK = (KPNT - MPSRCD) / KST + 1
- ELSE
- NK = NKEYS
- ENDIF
- CALL CDKEYR (NK, NWKYCK, KYP1CK)
- KOBJ = KYP1CK(MOBJCD)
- MXKP = KYP1CK(MXKPCD)
- CALL CDPATH (TOP1CT, NKEYS)
- CALL RZCDIR (TOP1CT, ' ')
- IF (IQUEST(1).NE.0) GO TO 991
- NKEYCK = IQUEST(7)
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
-*
-* ** Make a different subdirectory if there are too many keys
-*
- IF (NKEYCK.GE.MXKP) THEN
- CHFOR = ' '
- DO 40 I = 1, NWKYCK
- IF (I.EQ.1) THEN
- CHFOR = CFORM(IOTYCK(I))
- ELSE
- CHFOR = CHFOR(1:I-1)//CFORM(IOTYCK(I))
- ENDIF
- 40 CONTINUE
- KEY7CK = KEYVCK(IDHINS)
- IF (ICMPCD.EQ.2) THEN
- CHOPF = 'ZP'
- ELSE IF (ICMPCD.NE.0) THEN
- CHOPF = 'CP'
- ELSE
- CHOPF = 'P '
- ENDIF
- CALL CDMKDI (PATHY, NWKEY, CHFOR, CTAGCK, MXKP, IPRECD,
- + DELTCD, CHOPF, IRC)
- IF (IRC.NE.0) GO TO 999
- CALL RZCDIR (PATHY, ' ')
- NKEYCK = IQUEST(7)
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- KPNT = IUHUNT (NKEYCK, IQ(KOFSCD+LCDRCD+IKDRCD+MPSRCD),
- + NKEYCK*KST, KST)
- IF (KPNT.NE.0) THEN
- NK = (KPNT - MPSRCD) / KST + 1
- ELSE
- NK = NKEYCK
- ENDIF
- CALL CDKEYR (NK, NWKYCK, KYP1CK)
- KOBJ = KYP1CK(MOBJCD)
- CALL CDPATH (TOP1CT, NKEYCK)
- CALL RZCDIR (TOP1CT, ' ')
- IF (IQUEST(1).NE.0) GO TO 991
- NKEYCK = IQUEST(7)
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- ENDIF
- CALL UCOPY (KYP1CK, KYP2CK, NWKYCK)
-*
- ENDIF
-*
-* ** Check the number of keys
-*
- LOBJ = KOBJ
- DO 45 IK = 1, NKEYCK
- IP = KOFSCD + LCDRCD + IKDRCD + (IK-1)*KST + IDHKSN
- IF (IQ(IP).GT.LOBJ) LOBJ = IQ(IP)
- 45 CONTINUE
- KEYVCK(IDHKSN) = LOBJ + 1
- KEYVCK(IDHFLG) = MSBIT1 (KEYVCK(IDHFLG), JRZUCD)
- CALL RZOUT (IUDIV, LREFCD(1), KEYVCK, ICYCLE, 'L')
- IKDRCD = IQ(KOFSCD+LCDRCD+KLKDCD)
- NKEYCK = IQ(KOFSCD+LCDRCD+KNKDCD)
- IER = IQUEST(1)
- CALL CDPVAL (KEYVCK(1))
- CALL RZRENK (KYP1CK, KYP2CK)
- IF (IER.NE.0) IQUEST(1) = IER
- ENDIF
- IF (IQUEST(1).NE.0) THEN
- IRC = 73
-#endif
-#if (defined(CERNLIB__DEBUG))&&(!defined(CERNLIB__P3CHILD))
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDDONT : Error i'//
- + 'n RZ while writing Data for '//PATHY//TOP1CT(1:8)//''')',I,0)
-#endif
-#if !defined(CERNLIB__P3CHILD)
- ENDIF
- GO TO 998
-#endif
-*
-* *** Error messages
-*
- 991 IRC = 71
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDDONT : Illegal '//
- + 'Path Name '//PATHY//TOP1CT(1:8)//''')', IARGCD, 0)
-#endif
-#if !defined(CERNLIB__P3CHILD)
-*
- 998 IF (PATHL.NE.' ') THEN
- CALL RZCDIR (PATHL, ' ')
- CALL RZFREE ('CDDONT')
- ENDIF
-#endif
-#if !defined(CERNLIB_IBM)||!defined(CERNLIB__P3CHILD)
-*
- 2001 FORMAT (20(I2,A1,1X))
-#endif
-* END CDDONT
- 999 END
diff --git a/src/packlib/hepdb/cdstore/cdenfz.F b/src/packlib/hepdb/cdstore/cdenfz.F
deleted file mode 100644
index 8021d71..0000000
--- a/src/packlib/hepdb/cdstore/cdenfz.F
+++ /dev/null
@@ -1,445 +0,0 @@
-*
-* $Id: cdenfz.F,v 1.1.1.1 1996/02/28 16:24:33 mclareni Exp $
-*
-* $Log: cdenfz.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:33 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
-#if !defined(CERNLIB__P3CHILD)
- SUBROUTINE CDENFZ (PATHN, LUNFZ, IRC)
-* =====================================
-*
-************************************************************************
-* *
-* SUBR. CDENFZ (PATHN, LUNFZ, IRC*) *
-* *
-* Enters data objects using either data residing in a FZ file or *
-* data hung at address LFIXCD *
-* *
-* Arguments : *
-* *
-* PATHN Character string describing the pathname *
-* LUNFZ Logical unit number of the FZ file *
-* or 0 if data does not reside on FZ file *
-* IRC Return code (see below) *
-* *
-* Called by CDFZUP *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* = 71 : Illegal path name in the transcript file *
-* = 72 : Read error on the FZ file *
-* = 73 : Error in RZ for saving the data object *
-* = 74 : Error in RZ for renaming the keys *
-* = 77 : FZOUT fails to write on to the sequential file *
-* *
-************************************************************************
-*
-#include "hepdb/caopts.inc"
-#include "hepdb/cdcblk.inc"
-#include "hepdb/cfzlun.inc"
-#include "hepdb/cinitl.inc"
-#include "hepdb/ckkeys.inc"
-#include "hepdb/clinks.inc"
-#include "hepdb/ctpath.inc"
-#include "hepdb/czpack.inc"
- PARAMETER (JBIAS=2)
- CHARACTER PATHN*(*), PATHX*16, CHFOR*100, CHOP*1
- CHARACTER CFORM(6)*1, CHOPT*4
- DATA CFORM / 'B', 'I', 'F', 'D', 'H', 'A' /
-#include "zebra/q_jbit.inc"
-* Ignoring t=pass
-#include "zebra/q_sbit.inc"
-* Ignoring t=pass
-*
-* ------------------------------------------------------------------
-*
- NCH = LENOCC (PATHN)
-*
-* *** Load IPREC/DELTA from dictionary; choose the transcript file
-*
- CALL CDLDIC (PATHN, 1, IRC)
- IF (IRC.NE.0) GO TO 999
- IF (ICMPCD.EQ.0) THEN
- IOPYCA = 1
- PACKCZ = .FALSE.
- ELSE IF (ICMPCD.EQ.2.AND.IOPZCA.NE.0) THEN
- PACKCZ = .TRUE.
- PRECCZ = DELTCD
- ELSE
- PACKCZ = .FALSE.
- ENDIF
-*
-* *** Check if the object already exists in the data base
-*
- IPNT = KOFSCD + LCDRCD + IKDRCD
- ISTP = NWKYCK + 1
- IF (NKEYCK.GT.0) THEN
- IOPTP = JBIT (IQ(IPNT+IDHFLG), JPRTCD)
- ELSE
- IOPTP = 0
- ENDIF
- KEY1 = IHEDCF(MPRECF+IDHKSN)
- IF (IOVRCD.NE.0) KEY1 = 0
- IF (IOPTP.EQ.0) THEN
- IF (KEY1.GT.0) THEN
- IFND = IUHUNT (KEY1, IQ(IPNT+IDHKSN), NKEYCK*ISTP, ISTP)
- IF (IFND.NE.0) GO TO 998
- ENDIF
- KOBJ = 0
- PAT2CT = PATHN
- ELSE
- MXKP = IQ(IPNT+MXKPCD)
- NKEYS = NKEYCK
- CALL CDKYTG
- DO 15 JK = 1, NKEYS
- IK = NKEYS + 1 - JK
- KPNT = IUHUNT (IK, IQ(IPNT+MPSRCD), NKEYS*ISTP, ISTP)
- IF (KPNT.NE.0) THEN
- KPNT = IPNT + KPNT - MPSRCD
- ELSE
- KPNT = IPNT + (IK - 1) * ISTP
- ENDIF
- IF (KEY1.GT.0) THEN
- IF (IQ(KPNT+MOBJCD).GE.KEY1) GO TO 15
- ENDIF
-*
-* ** Get the appropriate sub-directory
-*
- NK = (KPNT - IPNT) / ISTP + 1
- CALL CDKEYR (NK, NWKYCK, KYP1CK)
- CALL CDPATH (PATHX, IK)
- PAT2CT = PATHN(1:NCH)//'/'//PATHX
- CALL RZCDIR (PAT2CT, ' ')
- IF (IQUEST(1).NE.0) THEN
- IRC = 71
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDENFZ : Ill'//
- + 'egal path name '//PAT2CT//''')', IARGCD, 0)
-#endif
- GO TO 999
- ENDIF
- NKEYCK = IQUEST(7)
- NWKYCK = IQUEST(8)
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- IPNT = KOFSCD + LCDRCD + IKDRCD
- IF (KEY1.NE.0) THEN
- IFND = IUHUNT (KEY1, IQ(IPNT+IDHKSN), NKEYCK*ISTP, ISTP)
- IF (IFND.NE.0) THEN
- PAT2CT = PATHN(1:NCH)
- CALL RZCDIR (PAT2CT, ' ')
- IF (IQUEST(1).NE.0) THEN
- IRC = 71
- GO TO 999
- ENDIF
- NKEYCK = IQUEST(7)
- NWKYCK = IQUEST(8)
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- GO TO 998
- ENDIF
- ENDIF
-*
-* ** Create a new subdirectory if needed
-*
- IF (IOPPCD.EQ.0.AND.NKEYCK.GE.MXKP) THEN
- IF (IK.EQ.NKEYS) THEN
- CHFOR = ' '
- IF (KEY1.NE.0) THEN
- KEY7CK = IHEDCF(MPRECF+IDHINS)
- ELSE
- KEY7CK = 0
- ENDIF
- DO 10 I = 1, NWKYCK
- IF (I.EQ.1) THEN
- CHFOR = CFORM(IOTYCK(I))
- ELSE
- CHFOR = CHFOR(1:I-1)//CFORM(IOTYCK(I))
- ENDIF
- 10 CONTINUE
- IF (ICMPCD.EQ.2) THEN
- CHOPT = 'ZP'
- ELSE IF (ICMPCD.NE.0) THEN
- CHOPT = 'CP'
- ELSE
- CHOPT = 'P '
- ENDIF
- CALL CDMKDI (PATHN, NWKYCK, CHFOR, CTAGCK, MXKP, IPRECD,
- + DELTCD, CHOPT, IRC)
- IF (IRC.NE.0) GO TO 999
- CALL RZCDIR (PATHN, ' ')
- IF (IQUEST(1).NE.0) THEN
- IRC = 71
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) THEN
- PAT2CT = PATHN
- CALL CDPRNT (LPRTCD, '(/,'' CDENFZ : Illegal path '//
- + 'name '//PAT2CT//''')', IARGCD, 0)
- ENDIF
-#endif
- GO TO 999
- ENDIF
- NKEYCK = IQUEST(7)
- NWKYCK = IQUEST(8)
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- IPNT = KOFSCD + LCDRCD + IKDRCD
- NK = IUHUNT (NKEYCK, IQ(IPNT+MPSRCD),NKEYCK*ISTP,ISTP)
- IF (NK.GT.0) THEN
- NK = (NK - MPSRCD) / ISTP + 1
- ELSE
- NK = NKEYCK
- ENDIF
- CALL CDKEYR (NK, NWKYCK, KYP1CK)
- CALL CDPATH (PATHX, NKEYCK)
- PAT2CT = PATHN(1:NCH)//'/'//PATHX
- CALL RZCDIR (PAT2CT, ' ')
- IF (IQUEST(1).NE.0) THEN
- IRC = 71
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDENFZ :'//
- + ' Illegal path name '//PAT2CT//''')', IARGCD, 0)
-#endif
- GO TO 999
- ENDIF
- NKEYCK = IQUEST(7)
- NWKYCK = IQUEST(8)
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- ENDIF
- ENDIF
- GO TO 20
- 15 CONTINUE
- 20 CALL UCOPY (KYP1CK, KYP2CK, NWKYCK)
- KOBJ = KYP1CK(MOBJCD)
- ENDIF
-*
- IF (KEY1.LE.0.AND.IOPPCD.EQ.0) THEN
- IF (NKEYCK.GT.0) THEN
- DO 25 IK = 1, NKEYCK
- IP = KOFSCD + LCDRCD + IKDRCD + (IK-1)*ISTP + IDHKSN
- IF (IQ(IP).GT.KOBJ) KOBJ = IQ(IP)
- 25 CONTINUE
- ENDIF
- KOBJ = KOBJ + 1
- IHEDCF(MPRECF+IDHKSN) = KOBJ
- ENDIF
- IHEDCF(MPRECF+IDHPTR) = 0
- IHEDCF(MPRECF+IDHFLG) = MSBIT0 (IHEDCF(MPRECF+IDHFLG), JRZUCD)
- IHEDCF(MPRECF+IDHFLG) = MSBIT0 (IHEDCF(MPRECF+IDHFLG), JPRTCD)
- IHEDCF(MPRECF+IDHFLG) = MSBIT0 (IHEDCF(MPRECF+IDHFLG), JASFCD)
- IF (IOPICA.EQ.0) THEN
- IHEDCF(MPRECF+IDHFLG) = MSBIT0 (IHEDCF(MPRECF+IDHFLG), JIGNCD)
- ELSE
- IHEDCF(MPRECF+IDHFLG) = MSBIT1 (IHEDCF(MPRECF+IDHFLG), JIGNCD)
- ENDIF
- IF (IOPHCA.EQ.0.AND.IHEDCF(MPRECF+IDHINS).LE.0) THEN
- CALL DATIME (IDATE, ITIME)
- CALL CDPKTM (IDATE, ITIME, IHEDCF(MPRECF+IDHINS), IRC)
- ENDIF
-*
-* *** Now read the data part of the transcript file
-*
- IF (LUNFZ.GT.0) THEN
- CALL FZIN (LUNFZ, IDISCD, LFIXCD, JBIAS, 'A', 0, 0)
- IF (IQUEST(1).GT.0) THEN
- IRC = -1
- GO TO 999
- ELSE IF (IQUEST(1).NE.0) THEN
- IQUEST(11) = IQUEST(1)
- IRC = 72
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDENFZ : FZ er'//
- + 'ror type '',I12)', IQUEST(11), 1)
-#endif
- GO TO 999
- ENDIF
- ENDIF
-*
- IDB = ICDTYP (LFIXCD)
- IF (IDB.EQ.2.OR.IDB.EQ.3) THEN
- IOPTR = 0
- ELSE
- IOPTR = 1
- ENDIF
-*
- IF (IOPYCA.NE.0 .OR. IOPTR.NE.0 .OR. IOPTCA.NE.0) THEN
- IF (IOPTCA.NE.0) THEN
- CHOP = 'S'
- ELSE IF (IOPYCA.NE.0) THEN
- CHOP = 'L'
- ELSE
- CHOP = ' '
- ENDIF
- ELSE
- CHOP = 'S'
- ENDIF
-#if (defined(CERNLIB_UNIX)||defined(CERNLIB_IBMVM)||defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))
-*
- IF (IOPPCD.NE.0) THEN
-#endif
-#if (defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))&&(defined(CERNLIB__ONLINE))
- CALL CDWLOK (IRC)
-#endif
-#if (defined(CERNLIB_UNIX)||defined(CERNLIB_IBMVM)||defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))&&(!defined(CERNLIB__ONLINE))
- CALL CDSTSV (TOPNCD, 0, IRC)
-#endif
-#if (defined(CERNLIB_UNIX)||defined(CERNLIB_IBMVM)||defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))
- IF (IRC.NE.0) THEN
- CALL MZDROP (IDISCD, LFIXCD, 'L')
- GO TO 999
- ENDIF
- ENDIF
-#endif
-*
-* ** Write the sequential output if needed
-*
- IF (LUFZCF.GT.0) THEN
- CALL FZOUT (LUFZCF, IDISCD, LFIXCD, 1, CHOP, IOFMCF, NWHDCF,
- + IHEDCF)
- IF (IQUEST(1).NE.0) THEN
- CALL MZDROP (IDISCD, LFIXCD, 'L')
- IRC = 77
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) THEN
- PAT2CT = PATHN
- CALL CDPRNT (LPRTCD, '(/,'' CDENFZ : Error in FZOUT for'//
- + ' '//PAT2CT//''')', IARGCD, 0)
- ENDIF
-#endif
- GO TO 999
- ENDIF
- ENDIF
-#if (defined(CERNLIB_UNIX)||defined(CERNLIB_IBMVM)||defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))
-*
- IF (IOPPCD.NE.0) THEN
-#endif
-#if (defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))&&(defined(CERNLIB__ONLINE))
- ISAVW = IQUEST(9)
-#endif
-#if (defined(CERNLIB_UNIX)||defined(CERNLIB_IBMVM)||defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))
- CALL MZDROP (IDISCD, LFIXCD, 'L')
-#endif
-#if (defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))&&(defined(CERNLIB__ONLINE))
- IQUEST(9) = ISAVW
- CALL CDCWSV (IRC)
-#endif
-#if (defined(CERNLIB_UNIX)||defined(CERNLIB_IBMVM)||defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))
- GO TO 999
- ENDIF
-#endif
-*
-* *** Compress the data if needed
-*
- IF (IOPYCA.NE.0 .OR. IOPTR.NE.0 .OR. IOPTCA.NE.0) THEN
- IHEDCF(MPRECF+IDHFLG) = MSBIT1 (IHEDCF(MPRECF+IDHFLG), JRZUCD)
- IF (IOPTCA.NE.0)
- + IHEDCF(MPRECF+IDHFLG) = MSBIT1 (IHEDCF(MPRECF+IDHFLG), JASFCD)
- ELSE
- LBDACD = LFIXCD
- LFIXCD = 0
- IF (IQ(KOFUCD+LBDACD-1).EQ.0) THEN
- IRSET = 1
- IOPPS = IOPPCA
- IOPZS = IOPZCA
- IOPPCA = 0
- IOPZCA = 0
- ELSE
- IRSET = 0
- ENDIF
- CALL CDFRUS (LBDACD, LSTRCL(1), IPRECD, IRC)
- CALL MZDROP (IDISCD, LBDACD, 'L')
- IF (IRC.NE.0) THEN
- IF (IRSET.NE.0) THEN
- IOPPCA = IOPPS
- IOPZCA = IOPZS
- ENDIF
- GO TO 999
- ENDIF
- IF (IOPPCA.EQ.0.AND.IOPZCA.EQ.0) THEN
- LFIXCD = LSTRCL(1)
- IF (IRSET.NE.0) THEN
- IOPPCA = IOPPS
- IOPZCA = IOPZS
- ENDIF
- ELSE
- CALL CDCOMP (LSTRCL(1), LFIXCD, IHEDCF(MPRECF+1), IRC)
- IF (LSTRCL(1).NE.LFIXCD) CALL MZDROP (IDISCD, LSTRCL(1),'L')
- IF (IRC.NE.0) GO TO 999
- ENDIF
- ENDIF
-*
-* *** Save the record on data base
-*
- IF (IOPSCD.NE.0) CALL RZLOCK ('CDENFZ')
- CALL RZOUT (IDISCD, LFIXCD, IHEDCF(MPRECF+1), ICYCL, CHOP)
- IER = IQUEST(1)
- IF (IOPSCD.NE.0) CALL RZFREE ('CDENFZ')
- IKDRCD = IQ(KOFSCD+LCDRCD+KLKDCD)
- NKEYCK = IQ(KOFSCD+LCDRCD+KNKDCD)
- CALL MZDROP (IDISCD, LFIXCD, 'L')
- IF (IER.NE.0) THEN
- IRC = 73
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) THEN
- PAT2CT = PATHN
- CALL CDPRNT (LPRTCD, '(/,'' CDENFZ : RZOUT error for path '//
- + 'name '//PAT2CT//''')', IARGCD, 0)
- ENDIF
-#endif
- GO TO 999
- ELSE
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.1) THEN
- CALL UCOPY (IHEDCF(MPRECF+1), KEYNCK, NWKYCK)
- CALL CDUPTM (IARGCD(1), IARGCD(2), KEYNCK(IDHINS), IRC)
- CALL CDPRNT (LPRTCD, '(/,'' CDENFZ : Data was inserted into'//
- + ' '//PAT2CT//''',/,10X,''on the '',I8,'' at '',I6'//
- + ','' with Key-Vector '')', IARGCD, 2)
- CALL CDKEYT
- CALL CDPRKY (NWKYCK, KEYNCK, IOTYCK, IRC)
- ENDIF
-#endif
- IF (IOPTP.NE.0) THEN
- CALL CDPVAL (IHEDCF(MPRECF+1))
- CALL RZCDIR (PATHN, ' ')
- IF (IQUEST(1).NE.0) THEN
- IRC = 71
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) THEN
- PAT2CT = PATHN
- CALL CDPRNT (LPRTCD, '(/,'' CDENFZ : Illegal path name'//
- + ' '//PAT2CT//''')', IARGCD, 0)
- ENDIF
-#endif
- GO TO 999
- ENDIF
- NKEYCK = IQUEST(7)
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- IF (IOPSCD.NE.0) CALL RZLOCK ('CDENFZ')
- CALL RZRENK (KYP1CK, KYP2CK)
- IERR = IQUEST(1)
- IF (IOPSCD.NE.0) CALL RZFREE ('CDENFZ')
- IF (IERR.NE.0) THEN
- IQUEST(1) = 74
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) THEN
- PAT2CT = PATHN
- CALL CDPRNT (LPRTCD, '(/,'' CDENFZ : RZRENK error for '//
- + 'path name '//PAT2CT//''')', IARGCD, 0)
- ENDIF
-#endif
- GO TO 999
- ENDIF
- ENDIF
- ENDIF
-*
- 998 IQUEST(1) = 0
-* END CDENFZ
- 999 END
-#endif
diff --git a/src/packlib/hepdb/cdstore/cdentb.F b/src/packlib/hepdb/cdstore/cdentb.F
deleted file mode 100644
index bca828b..0000000
--- a/src/packlib/hepdb/cdstore/cdentb.F
+++ /dev/null
@@ -1,685 +0,0 @@
-*
-* $Id: cdentb.F,v 1.1.1.1 1996/02/28 16:24:33 mclareni Exp $
-*
-* $Log: cdentb.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:33 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
-#if defined(CERNLIB__P3CHILD)
-* Ignoring t=dummy
-#endif
- SUBROUTINE CDENTB (PATHN, LSUP,IUDIV, NWDIM,NOBJ, KEY, CHOPT, IRC)
-* ==================================================================
-*
-************************************************************************
-* *
-* SUBR. CDENTB (PATHN, LSUP,IUDIV, NWDIM,NOBJ,KEY, CHOPT, IRC*) *
-* CHOPT) *
-* *
-* Stores data from memory to disk for a number of objects in a go. *
-* It is useful in a Batch operation to save real time spent *
-* *
-* Arguments : *
-* *
-* PATHN Character string describing the pathname *
-* LSUP Vector containing the addresses of the banks where *
-* data reside *
-* IUDIV Division index where the data reside *
-* NWDIM First dimension of the array KEY *
-* NOBJ Number of objects to be inserted *
-* KEY Two dimensional array with the first dimension NWDIM, *
-* specifying the key elements for each object and the *
-* secod dimension NOBJ, specifying the number of objects *
-* (Keys 3,4,5 and 8 onwards to be filled in by user on *
-* input; the DB system keys will be filled in here at the *
-* time of output) *
-* CHOPT Character string with any of the following characters *
-* B Save in the special backup file; not in standard Journal*
-* D Store only the differences from an existing object *
-* F Updates with a fully matched data object (in user keys) *
-* K Store data only inside the keys (not yet installed) *
-* H Insertion time as supplied by user to be honoured *
-* P Store data compressed (bit packing) *
-* T Special text type of data (to be used with R) *
-* Y Store with full RZ option (No compression to be made) *
-* Z Store only nonzero elements. An element is considered to*
-* to be zero if its absolute value is less than DELTA *
-* IRC Return code (see below) *
-* *
-* Called by user, CDSTOM *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* = 61 : Illegal number of keys (NWDIM < NWKEY) *
-* = 71 : Illegal path name *
-* = 73 : RZOUT fails to write on disk *
-* = 74 : Error in RZRENK in updating key values for *
-* partitioned data set *
-* = 76 : Cannot form the IO descriptor for the FZ header *
-* = 77 : FZOUT fails to write on to the sequential file *
-* *
-************************************************************************
-*
-#include "hepdb/caopts.inc"
-#include "hepdb/cdcblk.inc"
-#include "hepdb/cfzlun.inc"
-#include "hepdb/cinitl.inc"
-#include "hepdb/ckkeys.inc"
-#include "hepdb/clinks.inc"
-#include "hepdb/ctpath.inc"
-#include "hepdb/czpack.inc"
-#if defined(CERNLIB__P3CHILD)
-#include "hepdb/p3dbl3.inc"
-#endif
- PARAMETER (NLEVM=20)
- INTEGER NLCUR(NLEVM)
- DIMENSION KEY(NWDIM,2), LSUP(9)
- CHARACTER PATHY*80, PATHX*16, CHFOR*100, CFORM(6)*1
- CHARACTER CHCUR(NLEVM)*1, CHOP*1
- CHARACTER PATHN*(*), CHOPT*(*), CHOP0*80, PATHL*80
- DATA CFORM /'B', 'I', 'F', 'D', 'H', 'A'/
-#include "zebra/q_jbit.inc"
-* Ignoring t=pass
-#include "zebra/q_sbit.inc"
-* Ignoring t=pass
-*
-* ------------------------------------------------------------------
-*
-* *** Decode the character option
-*
- CALL CDOPTS (CHOPT, IRC)
- IF (IRC.NE.0) GO TO 999
-*
- IF (IOPFCA.NE.0) IOPDCA = 1
- IF (IOPTCA.NE.0) IOPYCA = 1
- IF (IOPYCA.NE.0) THEN
- IOPPCA = 0
- IOPZCA = 0
- ENDIF
- IF (IOPPCA.NE.0) IOPZCA = 0
-*
-* *** Load top directory information; gets in PAT1CT complete path name
-*
- CALL CDLDUP (PATHN, 1, IRC)
- IF (IRC.NE.0) GO TO 999
-*
-* *** Set the current directory path name
-*
- PATHL = ' '
- PATHY = PAT1CT
- PATHX = ' '
- CALL RZCDIR (PATHY, ' ')
- NKEYCK = IQUEST(7)
- NWKYCK = IQUEST(8)
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- KST = NWKYCK + 1
- CALL CDKYTG
- IF (NKEYCK.NE.0) THEN
- IOPTP = JBIT (IQ(KOFSCD+LCDRCD+IKDRCD+IDHFLG), JPRTCD)
- ELSE
- IOPTP = 0
- ENDIF
-*
-* *** Load IPREC/DELTA from dictionary; choose the transcript file
-*
- CALL CDLDIC (PATHY, 1, IRC)
- IF (IRC.NE.0) GO TO 999
- IF (ICMPCD.EQ.0) THEN
- IOPYCA = 1
- PACKCZ = .FALSE.
- ELSE IF (ICMPCD.EQ.2.AND.IOPZCA.NE.0) THEN
- PACKCZ = .TRUE.
- PRECCZ = DELTCD
- ELSE
- PACKCZ = .FALSE.
- ENDIF
- IF (IOPBCA.EQ.0) THEN
- LUFZCF = LUFZCD
- ELSE
- LUFZCF = LUBKCD
- ENDIF
-*
-* *** Check the number of keys
-*
- IF (NWDIM.LT.NWKYCK) THEN
- IRC = 61
- IQUEST(11) = NWKYCK
- IQUEST(12) = NWDIM
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDENTB : Too man'//
- + 'y keys '',I6,'' maximum permitted '',I6)', IQUEST(11), 2)
-#endif
- GO TO 999
- ENDIF
-#if (defined(CERNLIB_UNIX)||defined(CERNLIB_IBMVM)||defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))
-*
-* *** Setup the server
-*
- IF (IOPPCD.NE.0) THEN
-#endif
-#if (defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))&&(!defined(CERNLIB__P3CHILD))&&(defined(CERNLIB__ONLINE))
- LUFZCF = LUFMCD
-#endif
-#if (defined(CERNLIB_UNIX)||defined(CERNLIB_IBMVM)||defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))&&(!defined(CERNLIB__P3CHILD))&&(!defined(CERNLIB__ONLINE))
- CALL CDSTSV (TOPNCD, 0, IRC)
- IF (IRC.NE.0) GO TO 999
-#endif
-#if defined(CERNLIB__P3CHILD)
- LUFZCF = LODBP3
-#endif
-#if (defined(CERNLIB_UNIX)||defined(CERNLIB_IBMVM)||defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))
- ENDIF
-#endif
-*
-* *** Get the IO descriptor for the header
-*
- IF (LUFZCF.GT.0) THEN
- NDOPC = LENOCC (CHOPT)
- IF (INDEX (CHOPT, 'H') .EQ. 0) THEN
- CHOP0 = 'H'//CHOPT
- NDOPC = NDOPC + 1
- ELSE
- CHOP0 = CHOPT
- ENDIF
- NDOP = (NDOPC + 3) / 4
- NLEV = 1
- NCUR = 5
- IFORO = 2
- CHCUR(NLEV) = CFORM(IFORO)
- IF (PACKCZ.AND.IOPUCA.EQ.0) THEN
- NLCUR(NLEV) = 4
- IFORO = 3
- NCUR = 1
- NLEV = NLEV + 1
- CHCUR(NLEV) = CFORM(IFORO)
- CALL UCOPY (PRECCZ, IHEDCF(MPRECF), 1)
- ELSE
- IHEDCF(MPRECF) = IPRECD
- ENDIF
- DO 25 I = 1, NWKYCK
- IFORM = IOTYCK(I)
- IF (IFORM.EQ.6) IFORM = 5
- IF (IFORM.EQ.IFORO) THEN
- NCUR = NCUR + 1
- ELSE
- NLCUR(NLEV) = NCUR
- IF (NLEV.GE.NLEVM) THEN
- IRC = 76
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDENTB : '//
- + 'Cannot get IO descriptor '//PATHY//''')', IARGCD, 0)
-#endif
- GO TO 999
- ENDIF
- NLEV = NLEV + 1
- CHCUR(NLEV) = CFORM(IFORM)
- NCUR = 1
- IFORO = IFORM
- ENDIF
- 25 CONTINUE
- NLCUR(NLEV) = NCUR
-*
-#if !defined(CERNLIB_IBM)||!defined(CERNLIB__P3CHILD)
- WRITE (CHFOR, 2001) (NLCUR(I), CHCUR(I), I = 1, NLEV)
-#endif
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB__P3CHILD))
- CHFOR = ' '
- II = 1
- DO 26 I = 1, NLEV
- CALL UTWRIT (CHFOR(II:II+1), '(I2)', NLCUR(I))
- II = II + 2
- CHFOR(II:II) = CHCUR(I)
- II = II + 2
- 26 CONTINUE
-#endif
- II = 4 *NLEV
- CHFOR = CHFOR(1:II)//' -H'
- CALL MZIOCH (IOFMCF, NWFMCF, CHFOR(1:II+3))
-*
-* ** Partially fill up the header
-*
- NCHR = LENOCC (PATHY)
- NWDP = (NCHR + 3) / 4
- NWDH = NWDP + NDOP + NWKYCK + 5
- IHEDCF(MACTCF) = 1
- IHEDCF(MNKYCF) = NWKYCK
- IHEDCF(MOPTCF) = NDOP
- IHEDCF(MPRECF) = NWDP
- IF (NDOP.GT.0)
- + CALL UCTOH (CHOP0, IHEDCF(NWKYCK+MPRECF+1), 4, 4*NDOP)
- CALL UCTOH (PATHY, IHEDCF(NWKYCK+NDOP+MPRECF+1), 4, 4*NWDP)
- ENDIF
-*
-* *** Take necessary action for partitioned and nonpartiitined datasets
-*
- IF (IOPTP.EQ.0) THEN
- KOBJ = 0
- ELSE
- KPNT = IUHUNT (NKEYCK, IQ(KOFSCD+LCDRCD+IKDRCD+MPSRCD),
- + NKEYCK*KST, KST)
- IF (KPNT.NE.0) THEN
- NK = (KPNT - MPSRCD) / KST + 1
- ELSE
- NK = NKEYCK
- ENDIF
- CALL CDKEYR (NK, NWKYCK, KYP1CK)
- KOBJ = KYP1CK(MOBJCD)
- MXKP = KYP1CK(MXKPCD)
- NWKYS = NWKYCK
- CHFOR = ' '
- DO 30 I = 1, NWKYS
- IF (I.EQ.1) THEN
- CHFOR = CFORM(IOTYCK(I))
- ELSE
- CHFOR = CHFOR(1:I-1)//CFORM(IOTYCK(I))
- ENDIF
- 30 CONTINUE
-*
- CALL CDPATH (PATHX, NKEYCK)
- CALL RZCDIR (PATHX, ' ')
- IF (IQUEST(1).NE.0) GO TO 991
- NKEYCK = IQUEST(7)
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
-*
-* ** Make a different subdirectory if there are too many keys
-*
- IF (NKEYCK.GE.MXKP) THEN
- IF (IOPHCA.EQ.0.OR.KEY(IDHINS,1).LE.0) THEN
- KEY7CK = 0
- ELSE
- KEY7CK = KEY(IDHINS,1)
- ENDIF
- IF (ICMPCD.EQ.2) THEN
- CHOP0 = 'ZP'
- ELSE IF (ICMPCD.NE.0) THEN
- CHOP0 = 'CP'
- ELSE
- CHOP0 = 'P '
- ENDIF
- CALL CDMKDI (PATHY, NWKYS, CHFOR, CTAGCK, MXKP, IPRECD,
- + DELTCD, CHOP0, IRC)
- IF (IRC.NE.0) GO TO 999
- CALL RZCDIR (PATHY, ' ')
- NKEYCK = IQUEST(7)
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- KPNT = IUHUNT (NKEYCK, IQ(KOFSCD+LCDRCD+IKDRCD+MPSRCD),
- + NKEYCK*KST, KST)
- IF (KPNT.NE.0) THEN
- NK = (KPNT - MPSRCD) / KST + 1
- ELSE
- NK = NKEYCK
- ENDIF
- CALL CDKEYR (NK, NWKYCK, KYP1CK)
- KOBJ = KYP1CK(MOBJCD)
- CALL CDPATH (PATHX, NKEYCK)
- CALL RZCDIR (PATHX, ' ')
- IF (IQUEST(1).NE.0) GO TO 991
- NKEYCK = IQUEST(7)
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- ENDIF
- CALL UCOPY (KYP1CK, KYP2CK, NWKYCK)
-*
- ENDIF
-*
-* *** Get the Serial number of the last object inserted
-*
- LOBJ = KOBJ
- IF (NKEYCK.GT.0) THEN
- ISTP = NWKYCK + 1
- DO 35 IK = 1, NKEYCK
- IP = KOFSCD + LCDRCD + IKDRCD + (IK-1)*ISTP + IDHKSN
- IF (IQ(IP).GT.LOBJ) LOBJ = IQ(IP)
- 35 CONTINUE
- ENDIF
- NINS = NKEYCK
-*
-* *** Lock the directory if necessary
-*
- IF (IOPPCD.EQ.0.AND.IOPSCD.NE.0) THEN
- CALL RZCDIR (PATHY, ' ')
- NKEYCK = IQUEST(7)
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- CALL RZLOCK ('CDENTB')
- PATHL = PATHY
- IF (IOPTP.NE.0) THEN
- CALL RZCDIR (PATHX, ' ')
- NKEYCK = IQUEST(7)
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- ENDIF
- ENDIF
-*
-* *** Loop over all the objects
-*
- DO 50 IOBJ = 1, NOBJ
- LOBJ = LOBJ + 1
- NINS = NINS + 1
-*
- IDB = ICDTYP (LSUP(IOBJ))
- IF (IDB.EQ.2.OR.IDB.EQ.3) THEN
- IOPTR = 0
- ELSE
- IOPTR = 1
- ENDIF
-*
- IF (IOPYCA.NE.0 .OR. IOPTR.NE.0 .OR. IOPTCA.NE.0) THEN
- IF (IOPTCA.NE.0) THEN
- CHOP = 'S'
- ELSE IF (IOPYCA.NE.0) THEN
- CHOP = 'L'
- ELSE
- CHOP = ' '
- ENDIF
- ELSE
- CHOP = 'S'
- ENDIF
-*
-* ** Fill up Key vectors 1,2,6,7
-*
- KEY(IDHKSN,IOBJ) = LOBJ
- KEY(IDHPTR,IOBJ) = 0
- KEY(IDHFLG,IOBJ) = MSBIT0 (KEY(IDHFLG,IOBJ), JRZUCD)
- KEY(IDHFLG,IOBJ) = MSBIT0 (KEY(IDHFLG,IOBJ), JPRTCD)
- KEY(IDHFLG,IOBJ) = MSBIT0 (KEY(IDHFLG,IOBJ), JASFCD)
- KEY(IDHFLG,IOBJ) = MSBIT0 (KEY(IDHFLG,IOBJ), JIGNCD)
- IF (IOPHCA.EQ.0.OR.KEY(IDHINS,IOBJ).LE.0) THEN
- CALL DATIME (IDATE, ITIME)
- CALL CDPKTM (IDATE, ITIME, IDATM, IRC)
- KEY(IDHINS,IOBJ) = IDATM
- ENDIF
-#if (defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))&&(!defined(CERNLIB__P3CHILD))&&(defined(CERNLIB__ONLINE))
-*
- IF (IOPPCD.NE.0) THEN
- CALL CDWLOK (IRC)
- IF (IRC.NE.0) GO TO 999
- ENDIF
-#endif
-*
-* ** Write the sequential output if needed
-*
- IF (LUFZCF.GT.0) THEN
- CALL UCOPY (KEY(1,IOBJ), IHEDCF(MPRECF+1), NWKYCK)
-#if (defined(CERNLIB_UNIX)||defined(CERNLIB_IBMVM)||defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))
- IF (IOPPCD.NE.0) IHEDCF(MPRECF+IDHKSN) = 0
-#endif
-#if defined(CERNLIB__P3CHILD)
- RNDBP3 = 'CDENTB '
- NWDBP3 = 2
- CALL UCTOH ('JOURNAL ', IWDBP3, 4, 8)
- CALL CDCHLD
- IRC = IQDBP3
- IF (IRC.NE.0) GO TO 997
-#endif
- CALL FZOUT (LUFZCF, IUDIV, LSUP(IOBJ), 1, CHOP, IOFMCF,
- + NWDH, IHEDCF)
- IF (IQUEST(1).NE.0) THEN
- IRC = 77
- IQUEST(11) = IOBJ
- IQUEST(12) = NOBJ
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDENTB : Err'//
- + 'or in FZOUT while writing Data for '',2I12)', IQUEST(11),2)
-#endif
- GO TO 997
- ENDIF
- ENDIF
-#if (defined(CERNLIB_UNIX)||defined(CERNLIB_IBMVM)||defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))
-*
- IF (IOPPCD.NE.0) THEN
-#endif
-#if (defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))&&(!defined(CERNLIB__P3CHILD))&&(defined(CERNLIB__ONLINE))
- CALL CDCWSV (IRC)
-#endif
-#if (defined(CERNLIB_UNIX)||defined(CERNLIB_IBMVM)||defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))
- GO TO 50
- ENDIF
-#endif
-#if !defined(CERNLIB__P3CHILD)
-*
- IF (IOPYCA.NE.0 .OR. IOPTR.NE.0 .OR. IOPTCA.NE.0) THEN
-*
-* ** RZ mode output
-*
- KEY(IDHFLG,IOBJ) = MSBIT1 (KEY(IDHFLG,IOBJ), JRZUCD)
- IF (IOPTCA.NE.0)
- + KEY(IDHFLG,IOBJ) = MSBIT1 (KEY(IDHFLG,IOBJ), JASFCD)
-*
-#endif
-#if (defined(CERNLIB__DEBUG))&&(!defined(CERNLIB__P3CHILD))
- IF (IDEBCD.GT.2) CALL RZLDIR (' ', ' ')
-#endif
-#if !defined(CERNLIB__P3CHILD)
- CALL RZOUT (IUDIV, LSUP(IOBJ), KEY(1,IOBJ), ICYCLE, CHOP)
-*
- ELSE
-*
-* ** Copy data to DB internal store
-*
-* ** 0 Data word : do not pack
-*
- IF (IQ(KOFUCD+LSUP(IOBJ)-1).EQ.0) THEN
- IRSET = 1
- IOPPS = IOPPCA
- IOPZS = IOPZCA
- IOPPCA = 0
- IOPZCA = 0
- ELSE
- IRSET = 0
- ENDIF
- CALL CDFRUS (LSUP(IOBJ), LSTRCL(1), IPRECD, IRC)
- IF (IRC.NE.0) THEN
- IF (IRSET.NE.0) THEN
- IOPPCA = IOPPS
- IOPZCA = IOPZS
- ENDIF
- GO TO 997
- ENDIF
-*
-* ** Compress the data if requested
-*
- IF (IOPPCA.EQ.0.AND.IOPZCA.EQ.0) THEN
- LREFCL(1) = LSTRCL(1)
- IF (IRSET.NE.0) THEN
- IOPPCA = IOPPS
- IOPZCA = IOPZS
- ENDIF
- ELSE
- NOLD = NKEYCK
- NKEYCK = NINS - 1
- CALL CDCOMP (LSTRCL(1), LREFCL(1), KEY(1,IOBJ), IRC)
- NKEYCK = NOLD
- ENDIF
- IF (IRC.NE.0) GO TO 997
-*
-* ** Drop the uncompressed data
-*
- IF (LREFCL(1).NE.LSTRCL(1)) CALL MZDROP (IDISCD,LSTRCL(1),'L')
-*
-* ** Write on to disk
-*
-#endif
-#if (defined(CERNLIB__DEBUG))&&(!defined(CERNLIB__P3CHILD))
- IF (IDEBCD.GT.2) CALL RZLDIR (' ', ' ')
-#endif
-#if !defined(CERNLIB__P3CHILD)
- CALL RZOUT (IDISCD, LREFCL(1), KEY(1,IOBJ), ICYCLE, 'S')
- IRC = IQUEST(1)
- CALL MZDROP (IDISCD, LREFCL(1), 'L')
- IQUEST(1) = IRC
- IF (IRC.EQ.77) GO TO 997
-*
- ENDIF
-*
- IKDRCD = IQ(KOFSCD+LCDRCD+KLKDCD)
- NKEYCK = IQ(KOFSCD+LCDRCD+KNKDCD)
- IF (IOPTP.NE.0) THEN
- CALL CDPVAL (KEY(1,IOBJ))
- ENDIF
- IF (IQUEST(1).NE.0) GO TO 993
-#endif
-#if (defined(CERNLIB__DEBUG))&&(!defined(CERNLIB__P3CHILD))
- IF (IDEBCD.GT.1) THEN
- CALL UCOPY (KEY(1,IOBJ), KEYNCK, NWKYCK)
- IARGCD(1) = IDATE
- IARGCD(2) = ITIME
- CALL CDPRNT (LPRTCD, '(/,'' CDENTB : Data was inserted into'//
- + ' '//PATHY//''',/,10X,''on the '',I8,'' at '',I6,'' '//
- + 'with Key-Vector '')', IARGCD, 2)
- CALL CDKEYT
- CALL CDPRKY (NWKYCK, KEYNCK, IOTYCK, IRC)
- ENDIF
-#endif
-#if !defined(CERNLIB__P3CHILD)
- IF (IOPTP.NE.0) THEN
- IF (NINS.GE.MXKP.AND.IOBJ.LT.NOBJ) THEN
- CALL RZCDIR (PATHY, ' ')
- IF (IQUEST(1).NE.0) GO TO 991
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- NKEYCK = IQUEST(7)
-*
-* ** Rename Keys 3 and 4 of the latest subdirectory
-*
- CALL RZRENK (KYP1CK, KYP2CK)
- IF (IQUEST(1).NE.0) THEN
- IRC = 74
-#endif
-#if (defined(CERNLIB__DEBUG))&&(!defined(CERNLIB__P3CHILD))
- IF (IDEBCD.GT.0) THEN
- CALL UCOPY (KYP1CK, IARGCD(1), NSYSCK)
- CALL UCOPY (KYP2CK, IARGCD(NSYSCK+1), NSYSCK)
- CALL CDPRNT (LPRTCD, '(/,'' CDENTB : Error in RZREN'//
- + 'K while writing data for '//PATHY//''',/(10X,'//
- + '7I12))', IARGCD, 2*NSYSCK)
- ENDIF
-#endif
-#if !defined(CERNLIB__P3CHILD)
- GO TO 998
- ENDIF
-*
-* ** Make a different subdirectory if there are too many keys
-*
- IF (IOPHCA.EQ.0.OR.KEY(IDHINS,IOBJ+1).LE.0) THEN
- KEY7CK = 0
- ELSE
- KEY7CK = KEY(IDHINS,IOBJ+1)
- ENDIF
- IF (ICMPCD.EQ.2) THEN
- CHOP0 = 'ZP'
- ELSE IF (ICMPCD.NE.0) THEN
- CHOP0 = 'CP'
- ELSE
- CHOP0 = 'P '
- ENDIF
- CALL CDMKDI (PATHY, NWKYS, CHFOR, CTAGCK, MXKP, IPRECD,
- + DELTCD, CHOP0, IRC)
- IF (IRC.NE.0) GO TO 998
- CALL RZCDIR (PATHY, ' ')
- NKEYCK = IQUEST(7)
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- KPNT = IUHUNT (NKEYCK, IQ(KOFSCD+LCDRCD+IKDRCD+MPSRCD),
- + NKEYCK*KST, KST)
- IF (KPNT.NE.0) THEN
- NK = (KPNT - MPSRCD) / KST + 1
- ELSE
- NK = NKEYCK
- ENDIF
- CALL CDKEYR (NK, NWKYCK, KYP1CK)
- CALL CDPATH (PATHX, NKEYCK)
- CALL RZCDIR (PATHX, ' ')
- IF (IQUEST(1).NE.0) GO TO 991
- NKEYCK = IQUEST(7)
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- NINS = 0
- CALL UCOPY (KYP1CK, KYP2CK, NWKYCK)
- ENDIF
- ENDIF
-#endif
- 50 CONTINUE
- GO TO 997
-*
-* *** Error messages
-*
- 991 IRC = 71
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDENTB : Illegal '//
- + 'Path Name '//PATHY//PATHX(1:8)//''')', IARGCD, 0)
-#endif
- GO TO 998
-#if !defined(CERNLIB__P3CHILD)
-*
- 993 IRC = 73
-#endif
-#if (defined(CERNLIB__DEBUG))&&(!defined(CERNLIB__P3CHILD))
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDENTB : Error in '//
- + 'RZOUT while writing Data for '//PATHY//PATHX(1:8)//''')',
- + IARGCD, 0)
-#endif
-*
- 997 CONTINUE
-#if (defined(CERNLIB_UNIX)||defined(CERNLIB_IBMVM)||defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))
- IF (IOPPCD.NE.0) GO TO 999
-#endif
-#if !defined(CERNLIB__P3CHILD)
- IF (IOPTP.NE.0) THEN
- IF (NINS.GT.0) THEN
- CALL RZCDIR (PATHY, ' ')
- IF (IQUEST(1).NE.0) THEN
- IF (IRC.EQ.0) GO TO 991
- ELSE
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- NKEYCK = IQUEST(7)
-*
-* ** Rename Keys 3 and 4 of the latest subdirectory
-*
- IF (IRC.EQ.0) THEN
- CALL RZRENK (KYP1CK, KYP2CK)
- IF (IQUEST(1).NE.0) THEN
- IRC = 74
-#endif
-#if (defined(CERNLIB__DEBUG))&&(!defined(CERNLIB__P3CHILD))
- IF (IDEBCD.GT.0) THEN
- CALL UCOPY (KYP1CK, IARGCD(1), NSYSCK)
- CALL UCOPY (KYP2CK, IARGCD(NSYSCK+1), NSYSCK)
- CALL CDPRNT (LPRTCD, '(/,'' CDENTB : Error in RZREN'//
- + 'K while writing data for '//PATHY//''',/(10X,'//
- + '7I12))', IARGCD, 2*NSYSCK)
- ENDIF
-#endif
-#if !defined(CERNLIB__P3CHILD)
- ENDIF
- ENDIF
- ENDIF
- ENDIF
- ENDIF
-*
-* ** Free the locked directory if any
-*
-#endif
- 998 CONTINUE
-#if !defined(CERNLIB__P3CHILD)
- IF (PATHL.NE.' ') THEN
- CALL RZCDIR (PATHL, ' ')
- NKEYCK = IQUEST(7)
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- CALL RZFREE ('CDENTB')
- ENDIF
-#endif
-#if !defined(CERNLIB_IBM)||!defined(CERNLIB__P3CHILD)
-*
- 2001 FORMAT (20(I2,A1,1X))
-#endif
-* END CDENTB
- 999 END
diff --git a/src/packlib/hepdb/cdstore/cdhunt.F b/src/packlib/hepdb/cdstore/cdhunt.F
deleted file mode 100644
index 34f5096..0000000
--- a/src/packlib/hepdb/cdstore/cdhunt.F
+++ /dev/null
@@ -1,52 +0,0 @@
-*
-* $Id: cdhunt.F,v 1.1.1.1 1996/02/28 16:24:33 mclareni Exp $
-*
-* $Log: cdhunt.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:33 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDHUNT (KEYV)
-* ========================
-*
-************************************************************************
-* *
-* SUBR. CDHUNT (KEYV*) *
-* *
-* Returns the key elements of an object with matching user keys as *
-* in KEYVCK and with Key(2) = 0 (not updated) *
-* *
-* Arguments : *
-* *
-* KEYV(*) Key vector found (if none found, set KEYV(1) = 0) *
-* *
-* Called by CDDONT *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
-#include "hepdb/ckkeys.inc"
- DIMENSION KEYV(9)
-#include "zebra/q_jbit.inc"
-* Ignoring t=pass
-*
-* ------------------------------------------------------------------
-*
-* *** Look at all the keys in the subdirectory
-*
- DO 20 IK1 = 1, NKEYCK
- IK = NKEYCK - IK1 + 1
- CALL CDKEYR (IK, NWKYCK, KEYV)
-*
- IF (KEYV(IDHPTR).NE.0) GO TO 20
- IF (KEYV(IDHUSI).NE.KEYVCK(IDHUSI)) GO TO 20
- DO 10 I = NSYSCK+1, NWKYCK
- IF (KEYV(I).NE.KEYVCK(I)) GO TO 20
- 10 CONTINUE
- IF (JBIT(KEYV(IDHFLG),JRZUCD).EQ.0) GO TO 20
- GO TO 999
- 20 CONTINUE
- KEYV(1) = 0
-* END CDHUNT
- 999 END
diff --git a/src/packlib/hepdb/cdstore/cdkout.F b/src/packlib/hepdb/cdstore/cdkout.F
deleted file mode 100644
index 3e55047..0000000
--- a/src/packlib/hepdb/cdstore/cdkout.F
+++ /dev/null
@@ -1,585 +0,0 @@
-*
-* $Id: cdkout.F,v 1.1.1.1 1996/02/28 16:24:33 mclareni Exp $
-*
-* $Log: cdkout.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:33 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
-#if defined(CERNLIB__P3CHILD)
-* Ignoring t=dummy
-#endif
- SUBROUTINE CDKOUT (PATHN, LADDR, IUDIV, KEYI, KEYO, IRC)
-* ========================================================
-*
-************************************************************************
-* *
-* SUBR. CDKOUT (PATHN, LADDR, IUDIV, KEYI, KEYO*, IRC*) *
-* *
-* Stores data from memory to disk *
-* Data structure refered by LREFCD(2); set up by the calling routine *
-* *
-* Arguments : *
-* *
-* PATHN Character string describing the pathname *
-* IUDIV Division index where the data reside *
-* KEYI Input vector of keys (validity ranges, user and special *
-* user keys to be filled in by the user) *
-* KEYO Output vector of keys (copy of KEYI +system keys filled *
-* in by the HEPDB package) *
-* IRC Return code (see below) *
-* *
-* Called by CDREPL, CDSTOR *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* = 71 : Illegal path name *
-* = 73 : RZOUT fails to write on disk *
-* = 74 : Error in RZRENK in updating key values for *
-* partitioned data set *
-* = 76 : Cannot form the IO descriptor for the FZ header *
-* = 77 : FZOUT fails to write on to the sequential file *
-* = 78 : Illegal number of keys in data base *
-* *
-************************************************************************
-*
-#include "hepdb/caopti.inc"
-#include "hepdb/caopts.inc"
-#include "hepdb/cdcblk.inc"
-#include "hepdb/cfzlun.inc"
-#include "hepdb/cinitl.inc"
-#include "hepdb/ckkeys.inc"
-#include "hepdb/clinks.inc"
-#include "hepdb/ctpath.inc"
-#include "hepdb/czpack.inc"
-#if defined(CERNLIB__P3CHILD)
-#include "hepdb/p3dbl3.inc"
-#endif
- PARAMETER (NLEVM=20)
- CHARACTER PATHN*(*), PATHY*80, PATHX*16, PATHL*80, CHOPT*28
- CHARACTER CFORM(6)*1, CHCUR(NLEVM)*1, CHFOR*100, CHOP*1
- INTEGER KEYI(9), KEYO(9), LADDR(9), NLCUR(NLEVM),IOPTS(26)
- EQUIVALENCE (IOPACA, IOPTS(1))
- DATA CFORM /'B', 'I', 'F', 'D', 'H', 'A'/
-#include "zebra/q_jbit.inc"
-* Ignoring t=pass
-#include "zebra/q_sbit.inc"
-* Ignoring t=pass
-*
-* ------------------------------------------------------------------
-*
- LREFCD(2) = LADDR(1)
-*
-* *** Load top directory information; gets in PAT1CT complete path name
-*
- CALL CDLDUP (PATHN, 1, IRC)
- IF (IRC.NE.0) GO TO 999
-*
-* *** Set the current directory path name
-*
- PATHL = ' '
- PATHY = PAT1CT
- CALL RZCDIR (PATHY, ' ')
- NKEYCK = IQUEST(7)
- NWKYCK = IQUEST(8)
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- KST = NWKYCK + 1
- CALL CDKYTG
- IF (NKEYCK.NE.0) THEN
- IOPTP = JBIT (IQ(KOFSCD+LCDRCD+IKDRCD+IDHFLG), JPRTCD)
- ELSE
- IOPTP = 0
- ENDIF
-*
-* *** Load IPREC/DELTA from dictionary; choose the transcript file
-*
- CALL CDLDIC (PATHY, 1, IRC)
- IF (IRC.NE.0) GO TO 999
- IF (ICMPCD.EQ.0) THEN
- IOPYCA = 1
- PACKCZ = .FALSE.
- ELSE IF (ICMPCD.EQ.2.AND.IOPZCA.NE.0) THEN
- PACKCZ = .TRUE.
- PRECCZ = DELTCD
- ELSE
- PACKCZ = .FALSE.
- ENDIF
- IF (IOPBCA.EQ.0) THEN
- LUFZCF = LUFZCD
- ELSE
- LUFZCF = LUBKCD
- ENDIF
-*
-* *** Fill up Key Serial number, pointer, insertion time
-*
- CALL UCOPY (KEYI, KEYO, NWKYCK)
- KEYO(IDHKSN) = 0
- KEYO(IDHPTR) = 0
- IF (IOPHCA.EQ.0.OR.KEYO(IDHINS).LE.0) THEN
- CALL DATIME (IDATE, ITIME)
- CALL CDPKTM (IDATE, ITIME, IDATM, IRC)
- KEYO(IDHINS) = IDATM
- ENDIF
-*
- IDB = ICDTYP (LREFCD(2))
- IF (IDB.EQ.2.OR.IDB.EQ.3) THEN
- IOPTR = 0
- ELSE
- IOPTR = 1
- ENDIF
-*
- IF (IOPYCA.NE.0 .OR. IOPTR.NE.0 .OR. IOPTCA.NE.0) THEN
- IF (IOPTCA.NE.0) THEN
- CHOP = 'S'
- ELSE IF (IOPYCA.NE.0) THEN
- CHOP = 'L'
- ELSE
- CHOP = ' '
- ENDIF
- ELSE
- CHOP = 'S'
- ENDIF
-*
-* *** Encode the character option, IO descriptor for the header
-*
- IF (IOPPCD.NE.0.OR.LUFZCF.GT.0) THEN
- CHOPT = 'H'
- NDOP = 1
- DO 10 I = 1, 26
- IF (IOPTS(I).NE.0.AND.I.NE.8) THEN
- IF (NDOP.EQ.0) THEN
- CHOPT = CALFCA(I)
- ELSE
- CHOPT = CHOPT(1:NDOP)//CALFCA(I)
- ENDIF
- NDOP = NDOP + 1
- ENDIF
- 10 CONTINUE
- NDOP = (NDOP + 3) / 4
-*
- NLEV = 1
- NCUR = 5
- IFORO = 2
- CHCUR(NLEV) = CFORM(IFORO)
- IF (PACKCZ) THEN
- NLCUR(NLEV) = 4
- IFORO = 3
- NCUR = 1
- NLEV = NLEV + 1
- CHCUR(NLEV) = CFORM(IFORO)
- CALL UCOPY (PRECCZ, IHEDCF(MPRECF), 1)
- ELSE
- IHEDCF(MPRECF) = IPRECD
- ENDIF
- DO 15 I = 1, NWKYCK
- IFORM = IOTYCK(I)
- IF (IFORM.EQ.6) IFORM = 5
- IF (IFORM.EQ.IFORO) THEN
- NCUR = NCUR + 1
- ELSE
- NLCUR(NLEV) = NCUR
- IF (NLEV.GE.NLEVM) THEN
- IRC = 76
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDKOUT : '//
- + 'Cannot get IO descriptor '//PATHY//''')', IARGCD, 0)
-#endif
- GO TO 999
- ENDIF
- NLEV = NLEV + 1
- CHCUR(NLEV) = CFORM(IFORM)
- NCUR = 1
- IFORO = IFORM
- ENDIF
- 15 CONTINUE
- NLCUR(NLEV) = NCUR
-*
-#if !defined(CERNLIB_IBM)||!defined(CERNLIB__P3CHILD)
- WRITE (CHFOR, 2001) (NLCUR(I), CHCUR(I), I = 1, NLEV)
-#endif
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB__P3CHILD))
- CHFOR = ' '
- II = 1
- DO 20 I = 1, NLEV
- CALL UTWRIT (CHFOR(II:II+1), '(I2)', NLCUR(I))
- II = II + 2
- CHFOR(II:II) = CHCUR(I)
- II = II + 2
- 20 CONTINUE
-#endif
- II = 4 *NLEV
- CHFOR = CHFOR(1:II)//' -H'
- CALL MZIOCH (IOFMCF, NWFMCF, CHFOR(1:II+3))
-*
-* ** Complete the header
-*
- NCHR = LENOCC (PATHY)
- NWDP = (NCHR + 3) / 4
- NWDH = NWDP + NDOP + NWKYCK + 5
- IHEDCF(MACTCF) = 1
- IHEDCF(MNKYCF) = NWKYCK
- IHEDCF(MOPTCF) = NDOP
- IHEDCF(MPATCF) = NWDP
- IF (NDOP.GT.0)
- + CALL UCTOH (CHOPT, IHEDCF(MPRECF+NWKYCK+1), 4, 4*NDOP)
- CALL UCTOH (PATHY, IHEDCF(MPRECF+NWKYCK+NDOP+1), 4, 4*NWDP)
- CALL UCOPY (KEYO, IHEDCF(MPRECF+1), NWKYCK)
- ENDIF
-#if (defined(CERNLIB_UNIX)||defined(CERNLIB_IBMVM)||defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))
-*
- IF (IOPPCD.NE.0) THEN
-#endif
-#if (defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))&&(!defined(CERNLIB__P3CHILD))&&(defined(CERNLIB__ONLINE))
- CALL CDWLOK (IRC)
-#endif
-#if (defined(CERNLIB_UNIX)||defined(CERNLIB_IBMVM)||defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))&&(!defined(CERNLIB__P3CHILD))&&(!defined(CERNLIB__ONLINE))
- CALL CDSTSV (TOPNCD, 0, IRC)
-#endif
-#if defined(CERNLIB__P3CHILD)
- LUFZCF = LODBP3
- RNDBP3 = 'CDKOUT '
- NWDBP3 = 2
- CALL UCTOH ('JOURNAL ', IWDBP3, 4, 8)
- CALL CDCHLD
- IRC = IQDBP3
-#endif
-#if (defined(CERNLIB_UNIX)||defined(CERNLIB_IBMVM)||defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))
- IF (IRC.NE.0) GO TO 999
-*
-* ** Copy the record to CLUSCOM or SPOOL
-*
-#endif
-#if (defined(CERNLIB_UNIX)||defined(CERNLIB_IBMVM)||defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))&&(defined(CERNLIB__DEBUG))
- IF (IDEBCD.GE.1) CALL CDPRNT (LPRTCD, '(/,'' CDKOUT : Call'//
- + ' FZOUT with option '//CHOP//''')', IARGCD, 0)
-#endif
-#if (defined(CERNLIB_UNIX)||defined(CERNLIB_IBMVM)||defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))
- CALL FZOUT (LUFZCF, IUDIV, LREFCD(2), 1, CHOP, IOFMCF, NWDH,
- + IHEDCF)
- IF (IQUEST(1).NE.0) THEN
- IRC = 77
-#endif
-#if (defined(CERNLIB_UNIX)||defined(CERNLIB_IBMVM)||defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))&&(defined(CERNLIB__DEBUG))
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDKOUT : Error'//
- + ' in FZOUT while writing Data for '//PATHY//''')', IARGCD, 0)
-#endif
-#if (defined(CERNLIB_UNIX)||defined(CERNLIB_IBMVM)||defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))
- GO TO 999
- ENDIF
-#endif
-#if (defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))&&(!defined(CERNLIB__P3CHILD))&&(defined(CERNLIB__ONLINE))
-*
- CALL CDCWSV (IRC)
-#endif
-#if (defined(CERNLIB_UNIX)||defined(CERNLIB_IBMVM)||defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))
- GO TO 999
- ENDIF
-#endif
-#if !defined(CERNLIB__P3CHILD)
-*
-* *** Take necessary action for partitioned and nonpartitioned datasets
-*
- IF (IOPTP.EQ.0) THEN
- KOBJ = 0
- ELSE
- KPNT = IUHUNT (NKEYCK, IQ(KOFSCD+LCDRCD+IKDRCD+MPSRCD),
- + NKEYCK*KST, KST)
- IF (KPNT.NE.0) THEN
- NK = (KPNT - MPSRCD) / KST + 1
- ELSE
- NK = NKEYCK
- ENDIF
- CALL CDKEYR (NK, NWKYCK, KYP1CK)
- KOBJ = KYP1CK(MOBJCD)
- MXKP = KYP1CK(MXKPCD)
- CALL CDPATH (PATHX, NKEYCK)
- CALL RZCDIR (PATHX, ' ')
- IF (IQUEST(1).NE.0) THEN
- IRC = 71
-#endif
-#if (defined(CERNLIB__DEBUG))&&(!defined(CERNLIB__P3CHILD))
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDKOUT : '//
- + 'Illegal Path Name '//PATHY//PATHX(1:8)//''')', IARGCD, 0)
-#endif
-#if !defined(CERNLIB__P3CHILD)
- GO TO 999
- ENDIF
- NKEYCK = IQUEST(7)
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
-*
-* ** Make a different subdirectory if there are too many keys
-*
- IF (NKEYCK.GE.MXKP) THEN
- NWKEY = NWKYCK
- CHFOR = ' '
- DO 30 I = 1, NWKEY
- IF (I.EQ.1) THEN
- CHFOR = CFORM(IOTYCK(I))
- ELSE
- CHFOR = CHFOR(1:I-1)//CFORM(IOTYCK(I))
- ENDIF
- 30 CONTINUE
- IF (IOPHCA.EQ.0.OR.KEYO(IDHINS).LE.0) THEN
- KEY7CK = 0
- ELSE
- KEY7CK = KEYO(IDHINS)
- ENDIF
- IF (ICMPCD.EQ.2) THEN
- CHOPT = 'ZP'
- ELSE IF (ICMPCD.NE.0) THEN
- CHOPT = 'CP'
- ELSE
- CHOPT = 'P '
- ENDIF
- CALL CDMKDI (PATHY, NWKEY, CHFOR, CTAGCK, MXKP, IPRECD,
- + DELTCD, CHOPT, IRC)
- IF (IRC.NE.0) GO TO 999
- CALL RZCDIR (PATHY, ' ')
- NKEYCK = IQUEST(7)
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- KPNT = IUHUNT (NKEYCK, IQ(KOFSCD+LCDRCD+IKDRCD+MPSRCD),
- + NKEYCK*KST, KST)
- IF (KPNT.NE.0) THEN
- NK = (KPNT - MPSRCD) / KST + 1
- ELSE
- NK = NKEYCK
- ENDIF
- CALL CDKEYR (NK, NWKYCK, KYP1CK)
- KOBJ = KYP1CK(MOBJCD)
- CALL CDPATH (PATHX, NKEYCK)
- CALL RZCDIR (PATHX, ' ')
- IF (IQUEST(1).NE.0) THEN
- IRC = 71
-#endif
-#if (defined(CERNLIB__DEBUG))&&(!defined(CERNLIB__P3CHILD))
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDKOUT : '//
- + 'Illegal Path Name '//PATHY//PATHX(1:8)//''')', IARGCD,0)
-#endif
-#if !defined(CERNLIB__P3CHILD)
- GO TO 999
- ENDIF
- NKEYCK = IQUEST(7)
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- ENDIF
- CALL UCOPY (KYP1CK, KYP2CK, NWKYCK)
-*
- ENDIF
-*
-* *** Find the unique serial number of the object
-*
- LOBJ = KOBJ
- IF (NKEYCK.GT.0) THEN
- ISTP = NWKYCK + 1
- DO 40 IK = 1, NKEYCK
- IP = KOFSCD + LCDRCD + IKDRCD + (IK-1)*ISTP + IDHKSN
- IF (IQ(IP).GT.LOBJ) LOBJ = IQ(IP)
- 40 CONTINUE
- ENDIF
- LOBJ = LOBJ + 1
-*
-* ** Write the sequential output if needed
-*
- IF (LUFZCF.GT.0) THEN
- IHEDCF(MPRECF+IDHKSN) = LOBJ
- CALL FZOUT (LUFZCF, IUDIV, LREFCD(2), 1, CHOP, IOFMCF, NWDH,
- + IHEDCF)
- IF (IQUEST(1).NE.0) THEN
- IRC = 77
-#endif
-#if (defined(CERNLIB__DEBUG))&&(!defined(CERNLIB__P3CHILD))
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDKOUT : Error'//
- + ' in FZOUT while writing Data for '//PATHY//''')', IARGCD, 0)
-#endif
-#if !defined(CERNLIB__P3CHILD)
- GO TO 50
- ENDIF
- ENDIF
-*
-* *** Fill up Key vectors 1,2,6,7
-*
- KEYO(IDHKSN) = LOBJ
- KEYO(IDHFLG) = MSBIT0 (KEYO(IDHFLG), JRZUCD)
- KEYO(IDHFLG) = MSBIT0 (KEYO(IDHFLG), JPRTCD)
- KEYO(IDHFLG) = MSBIT0 (KEYO(IDHFLG), JASFCD)
- IF (IOPICA.EQ.0) THEN
- KEYO(IDHFLG) = MSBIT0 (KEYO(IDHFLG), JIGNCD)
- ELSE
- KEYO(IDHFLG) = MSBIT1 (KEYO(IDHFLG), JIGNCD)
- ENDIF
-*
-* *** Lock the directory if necessary
-*
- IF (IOPPCD.EQ.0.AND.IOPSCD.NE.0) THEN
- CALL RZCDIR (PATHY, ' ')
- NKEYCK = IQUEST(7)
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- CALL RZLOCK ('CDKOUT')
- PATHL = PATHY
- IF (IOPTP.NE.0) THEN
- CALL RZCDIR (PATHX, ' ')
- NKEYCK = IQUEST(7)
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- ENDIF
- ENDIF
-*
- IF (IOPYCA.NE.0 .OR. IOPTR.NE.0 .OR. IOPTCA.NE.0) THEN
-*
-* ** RZ mode output
-*
- KEYO(IDHFLG) = MSBIT1 (KEYO(IDHFLG), JRZUCD)
- IF (IOPTCA.NE.0) KEYO(IDHFLG) = MSBIT1 (KEYO(IDHFLG), JASFCD)
-*
-#endif
-#if (defined(CERNLIB__DEBUG))&&(!defined(CERNLIB__P3CHILD))
- IF (IDEBCD.GT.2) CALL RZLDIR (' ', ' ')
-#endif
-#if !defined(CERNLIB__P3CHILD)
- CALL RZOUT (IUDIV, LREFCD(2), KEYO, ICYCLE, CHOP)
-*
- ELSE
-*
-* ** Copy data to DB internal store
-*
-* ** 0 Data word : do not pack
-*
- IF (IQ(KOFUCD+LREFCD(2)-1).EQ.0) THEN
- IRSET = 1
- IOPPS = IOPPCA
- IOPZS = IOPZCA
- IOPPCA = 0
- IOPZCA = 0
- ELSE
- IRSET = 0
- ENDIF
- CALL CDFRUS (LREFCD(2), LSTRCL(1), IPRECD, IRC)
- IF (IRC.NE.0) THEN
- IF (IRSET.NE.0) THEN
- IOPPCA = IOPPS
- IOPZCA = IOPZS
- ENDIF
- GO TO 50
- ENDIF
-*
-* ** Compress the data if requested
-*
- IF (IOPPCA.EQ.0.AND.IOPZCA.EQ.0) THEN
- LREFCL(1) = LSTRCL(1)
- IF (IRSET.NE.0) THEN
- IOPPCA = IOPPS
- IOPZCA = IOPZS
- ENDIF
- ELSE
- CALL CDCOMP (LSTRCL(1), LREFCL(1), KEYO(1), IRC)
- ENDIF
- IF (IRC.NE.0) GO TO 50
-*
-* ** Drop the uncompressed data
-*
- IF (LREFCL(1).NE.LSTRCL(1)) CALL MZDROP (IDISCD, LSTRCL(1), 'L')
-*
-* ** Write on to disk
-*
-#endif
-#if (defined(CERNLIB__DEBUG))&&(!defined(CERNLIB__P3CHILD))
- IF (IDEBCD.GT.2) CALL RZLDIR (' ', ' ')
-#endif
-#if !defined(CERNLIB__P3CHILD)
- CALL RZOUT (IDISCD, LREFCL(1), KEYO, ICYCLE, 'S')
- IER = IQUEST(1)
- CALL MZDROP (IDISCD, LREFCL(1), 'L')
- IQUEST(1) = IER
-*
- ENDIF
- CALL UCOPY (KEYO, KEYNCK, NWKYCK)
- IKDRCD = IQ(KOFSCD+LCDRCD+KLKDCD)
- NKEYCK = IQ(KOFSCD+LCDRCD+KNKDCD)
-*
- IF (IQUEST(1).NE.0) THEN
- IRC = 73
-#endif
-#if (defined(CERNLIB__DEBUG))&&(!defined(CERNLIB__P3CHILD))
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDKOUT : Error '//
- + 'in RZOUT while writing Data for '//PATHY//PATHX(1:8)//''')',
- + IRC, 0)
-#endif
-#if !defined(CERNLIB__P3CHILD)
- GO TO 50
- ENDIF
-#endif
-#if (defined(CERNLIB__DEBUG))&&(!defined(CERNLIB__P3CHILD))
- IF (IDEBCD.GT.1) THEN
- IARGCD(1) = IDATE
- IARGCD(2) = ITIME
- CALL CDPRNT (LPRTCD, '(/,'' CDKOUT : Data was inserted into'//
- + ' '//PATHY//''',/,10X,''on the '',I8,'' at '',I6,'' '//
- + 'with Key-Vector '')', IARGCD, 2)
- CALL CDKEYT
- CALL CDPRKY (NWKYCK, KEYNCK, IOTYCK, IRC)
- ENDIF
-#endif
-#if !defined(CERNLIB__P3CHILD)
-*
- 50 IF (IOPTP.NE.0) THEN
- CALL RZCDIR (PATHY, ' ')
- IF (IQUEST(1).NE.0) THEN
- IF (IRC.EQ.0) THEN
- IF (PATHL.NE.' ') THEN
- CALL RZCDIR (PATHL, ' ')
- CALL RZFREE ('CDKOUT')
- ENDIF
- IRC = 71
-#endif
-#if (defined(CERNLIB__DEBUG))&&(!defined(CERNLIB__P3CHILD))
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDKOUT : '//
- + 'Illegal Path Name '//PATHY//''')', IARGCD, 0)
-#endif
-#if !defined(CERNLIB__P3CHILD)
- GO TO 999
- ENDIF
- ELSE
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- NKEYCK = IQUEST(7)
-*
-* ** Rename Keys 3 and 4 of the latest subdirectory
-*
- IF (IRC.EQ.0) THEN
- CALL CDPVAL (KEYO(1))
- CALL RZRENK (KYP1CK, KYP2CK)
- IF (IQUEST(1).NE.0) THEN
- IRC = 74
-#endif
-#if (defined(CERNLIB__DEBUG))&&(!defined(CERNLIB__P3CHILD))
- IF (IDEBCD.GT.0) THEN
- CALL UCOPY (KYP1CK, IARGCD(1), NSYSCK)
- CALL UCOPY (KYP2CK, IARGCD(NSYSCK+1), NSYSCK)
- CALL CDPRNT (LPRTCD, '(/,'' CDKOUT : Error in RZRENK '//
- + 'while writing data for '//PATHY//''',/(10X,7I12))'
- +, IARGCD, 2*NSYSCK)
- ENDIF
-#endif
-#if !defined(CERNLIB__P3CHILD)
- ENDIF
- ENDIF
- ENDIF
- ENDIF
-*
- IF (PATHL.NE.' ') THEN
- CALL RZCDIR (PATHL, ' ')
- CALL RZFREE ('CDKOUT')
- ENDIF
-#endif
-#if !defined(CERNLIB_IBM)||!defined(CERNLIB__P3CHILD)
-*
- 2001 FORMAT (20(I2,A1,1X))
-#endif
-* END CDKOUT
- 999 END
diff --git a/src/packlib/hepdb/cdstore/cdpval.F b/src/packlib/hepdb/cdstore/cdpval.F
deleted file mode 100644
index da1edb1..0000000
--- a/src/packlib/hepdb/cdstore/cdpval.F
+++ /dev/null
@@ -1,83 +0,0 @@
-*
-* $Id: cdpval.F,v 1.1.1.1 1996/02/28 16:24:34 mclareni Exp $
-*
-* $Log: cdpval.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:34 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDPVAL (KEYS)
-* ========================
-*
-************************************************************************
-* *
-* SUBR. CDPVAL (KEYS) *
-* *
-* Sets the validity range of the partition (assumed to be in KYP2CK) *
-* from the current object *
-* *
-* Arguments : *
-* *
-* KEYS Vector of keys for the current object *
-* *
-* Called by CDDONT, CDENFZ, CDENTB, CDKOUT, CDPART, CDRTFZ *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
-#include "hepdb/ckkeys.inc"
- DIMENSION KEYS(9)
-* ------------------------------------------------------------------
-*
-* *** For hierarchial validity range keys
-*
- IF (IHFLCD.EQ.0) THEN
-*
-* *** Decide if the partitition keys to be updated
-*
- IBEG = 0
- IEND = 0
- DO 10 I = 1, NPARCD
- IF (IBEG.EQ.0) THEN
- IF (KEYS(NOF1CK+2*I-1).LT.KYP2CK(NOF1CK+2*I-1)) THEN
- IBEG = 1
- ELSE IF (KEYS(NOF1CK+2*I-1).GT.KYP2CK(NOF1CK+2*I-1)) THEN
- IBEG = -1
- ENDIF
- ENDIF
- IF (IEND.EQ.0) THEN
- IF (KEYS(NOF1CK+2*I) .GT.KYP2CK(NOF1CK+2*I) ) THEN
- IEND = 1
- ELSE IF (KEYS(NOF1CK+2*I) .GT.KYP2CK(NOF1CK+2*I) ) THEN
- IEND = -1
- ENDIF
- ENDIF
- 10 CONTINUE
-*
-* *** Take action now
-*
- IF (IBEG.GT.0) THEN
- DO 15 I = 1, NPARCD
- KYP2CK(NOF1CK+2*I-1) = KEYS(NOF1CK+2*I-1)
- 15 CONTINUE
- ENDIF
- IF (IEND.GT.0) THEN
- DO 20 I = 1, NPARCD
- KYP2CK(NOF1CK+2*I) = KEYS(NOF1CK+2*I)
- 20 CONTINUE
- ENDIF
-*
- ELSE
-*
-* *** For flat validity range keys
-*
- DO 30 I = 1, NPARCD
- IF (KEYS(NOF1CK+2*I-1).LT.KYP2CK(NOF1CK+2*I-1))
- + KYP2CK(NOF1CK+2*I-1) = KEYS(NOF1CK+2*I-1)
- IF (KEYS(NOF1CK+2*I) .GT.KYP2CK(NOF1CK+2*I) )
- + KYP2CK(NOF1CK+2*I) = KEYS(NOF1CK+2*I)
- 30 CONTINUE
- ENDIF
-* END CDPVAL
- END
diff --git a/src/packlib/hepdb/cdstore/cdrenk.F b/src/packlib/hepdb/cdstore/cdrenk.F
deleted file mode 100644
index b9138dd..0000000
--- a/src/packlib/hepdb/cdstore/cdrenk.F
+++ /dev/null
@@ -1,343 +0,0 @@
-*
-* $Id: cdrenk.F,v 1.1.1.1 1996/02/28 16:24:34 mclareni Exp $
-*
-* $Log: cdrenk.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:34 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
-#if defined(CERNLIB__P3CHILD)
-* Ignoring t=dummy
-#endif
- SUBROUTINE CDRENK (PATHN, KEYO, KEYN, IRC)
-* ==========================================
-*
-************************************************************************
-* *
-* SUBR. CDRENK (PATHN, KEYO, KEYN, IRC*) *
-* *
-* Changes the key elements of an existing object to new values *
-* *
-* Arguments : *
-* *
-* PATHN Character string describing the pathname *
-* KEYO Array containing the old key elements *
-* KEYN Array containing the new key elements *
-* IRC Return code (see below) *
-* *
-* Called by user, CDFZUP *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* =191 : Illegal path name *
-* =192 : Illegal KEYO values (no matching object) *
-* =194 : Error in getting the IO descriptor *
-* =195 : Error in FZOUT in saving the journal file *
-* =196 : Error in RZRENK in renaming key values *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
-#include "hepdb/cfzlun.inc"
-#include "hepdb/cinitl.inc"
-#include "hepdb/ckkeys.inc"
-#include "hepdb/ctpath.inc"
-#if defined(CERNLIB__P3CHILD)
-#include "hepdb/p3dbl3.inc"
-#endif
- PARAMETER (NLEVM=20)
- DIMENSION KEYO(9), KEYN(9), NLCUR(NLEVM)
- CHARACTER PATHN*(*), PATHY*80, CHFOR*100, CFORM(6)*1
- CHARACTER CHCUR(NLEVM)*1
- DATA CFORM /'B', 'I', 'F', 'D', 'H', 'A'/
-#include "zebra/q_jbit.inc"
-* Ignoring t=pass
-*
-* ------------------------------------------------------------------
-*
-* *** Set the current directory path name
-*
- CALL CDLDUP (PATHN, 0, IRC)
- IF (IRC.NE.0) GO TO 999
- PATHY = PAT1CT
- NCHAR = LENOCC (PATHY)
- KST = NWKYCK + 1
- CALL CDKEYT
- IF (NKEYCK.NE.0) THEN
- IOPTP = JBIT (IQ(KOFSCD+LCDRCD+IKDRCD+IDHFLG), JPRTCD)
- ELSE
- IRC = 192
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDRENK : Illegal'//
- + ' key in Path '//PATHY(1:NCHAR)//''')', IARGCD, 0)
-#endif
- GO TO 999
- ENDIF
-*
-* *** See if the key matches with one existing
-*
- IF (IOPTP.EQ.0) THEN
- KPNT = IUHUNT (KEYO(IDHKSN), IQ(KOFSCD+LCDRCD+IKDRCD+IDHKSN),
- + NKEYCK*KST, KST)
- IF (KPNT.EQ.0) THEN
- IRC = 192
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDRENK : Illeg'//
- + 'al key in Path '//PATHY(1:NCHAR)//''')', IARGCD, 0)
-#endif
- GO TO 999
- ELSE
- NK = (KPNT - IDHKSN) / KST + 1
- CALL CDKEYR (NK, NWKYCK, KEYNCK)
- DO 10 IK = 1, NWKYCK
- IF (KEYNCK(IK).NE.KEYO(IK)) THEN
- IRC = 192
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDRENK : I'//
- + 'llegal key in Path '//PATHY(1:NCHAR)//''')', IARGCD, 0)
-#endif
- GO TO 999
- ENDIF
- 10 CONTINUE
- ENDIF
-*
- ELSE
- NKEYS = NKEYCK
- DO 20 JK = 1, NKEYS
- IK = NKEYS - JK + 1
- KPNT = IUHUNT (IK, IQ(KOFSCD+LCDRCD+IKDRCD+MPSRCD),
- + NKEYS*KST, KST)
- IF (KPNT.GT.0) THEN
- KPNT = KOFSCD + LCDRCD + IKDRCD + KPNT - MPSRCD
- ELSE
- KPNT = KOFSCD + LCDRCD + IKDRCD + (IK - 1) * KST
- ENDIF
- IF (KEYO(IDHKSN).LE.IQ(KPNT+MOBJCD)) GO TO 20
- NK = (KPNT - KOFSCD - LCDRCD -IKDRCD) / KST + 1
- CALL CDKEYR (NK, NWKYCK, KYP1CK)
- CALL UCOPY (KYP1CK, KYP2CK, NWKYCK)
- CALL CDPATH (TOP1CT, IK)
- CALL RZCDIR (TOP1CT, ' ')
- IF (IQUEST(1).NE.0) THEN
- IRC = 191
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDRENK : Ill'//
- + 'egal Path Name '//PATHY(1:NCHAR)//TOP1CT(1:8)//''')', IQ,0)
-#endif
- GO TO 999
- ENDIF
- NKEYCK = IQUEST(7)
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- KPNT = IUHUNT (KEYO(IDHKSN),IQ(KOFSCD+LCDRCD+IKDRCD+IDHKSN),
- + NKEYCK*KST, KST)
- IF (KPNT.EQ.0) THEN
- IRC = 192
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDRENK : Ill'//
- + 'egal key in Path '//PATHY(1:NCHAR)//TOP1CT(1:8)//''')',
- + IARGCD, 0)
-#endif
- GO TO 999
- ELSE
- NK = (KPNT - IDHKSN) / KST + 1
- CALL CDKEYR (NK, NWKYCK, KEYNCK)
- DO 15 IK = 1, NWKYCK
- IF (KEYNCK(IK).NE.KEYO(IK)) THEN
- IRC = 192
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDRENK :'//
- + ' Illegal key in Path '//PATHY(1:NCHAR)//TOP1CT(1:8)//
- + ''')', IARGCD, 0)
-#endif
- GO TO 999
- ENDIF
- 15 CONTINUE
- GO TO 25
- ENDIF
- 20 CONTINUE
- IRC = 192
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDRENK : Illegal'//
- + ' key in Path '//PATHY(1:NCHAR)//TOP1CT(1:8)//''')', IARGCD, 0)
-#endif
- GO TO 999
- ENDIF
-*
-* *** Find the appropriate FZ file number
-*
- 25 LUFZCF = LUFZCD
-#if (defined(CERNLIB_UNIX)||defined(CERNLIB_IBMVM)||defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))
- IF (IOPPCD.NE.0) THEN
-#endif
-#if (defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))&&(!defined(CERNLIB__P3CHILD))&&(defined(CERNLIB__ONLINE))
- LUFZCF = LUFMCD
-#endif
-#if (defined(CERNLIB_UNIX)||defined(CERNLIB_IBMVM)||defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))&&(!defined(CERNLIB__P3CHILD))&&(!defined(CERNLIB__ONLINE))
- CALL CDSTSV (TOPNCD, 0, IRC)
- IF (IRC.NE.0) GO TO 999
-#endif
-#if defined(CERNLIB__P3CHILD)
- LUFZCF = LODBP3
-#endif
-#if (defined(CERNLIB_UNIX)||defined(CERNLIB_IBMVM)||defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))
- ENDIF
-#endif
-*
-* *** Get the IO descriptor for the header
-*
- IF (LUFZCF.GT.0) THEN
- NLEV = 1
- NCUR = 5
- IFORO = 2
- CHCUR(NLEV) = CFORM(IFORO)
- DO 40 J = 1, 2
- DO 30 I = 1, NWKYCK
- IFORM = IOTYCK(I)
- IF (IFORM.EQ.6) IFORM = 5
- IF (IFORM.EQ.IFORO) THEN
- NCUR = NCUR + 1
- ELSE
- NLCUR(NLEV) = NCUR
- IF (NLEV.GE.NLEVM) THEN
- IRC = 194
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDRENK :'//
- + ' Cannot get IO descriptor '//PATHY//''')', IARGCD, 0)
-#endif
- GO TO 999
- ENDIF
- NLEV = NLEV + 1
- CHCUR(NLEV) = CFORM(IFORM)
- NCUR = 1
- IFORO = IFORM
- ENDIF
- 30 CONTINUE
- 40 CONTINUE
- NLCUR(NLEV) = NCUR
-*
-#if !defined(CERNLIB_IBM)||!defined(CERNLIB__P3CHILD)
- WRITE (CHFOR, 2001) (NLCUR(I), CHCUR(I), I = 1, NLEV)
-#endif
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB__P3CHILD))
- CHFOR = ' '
- II = 1
- DO 45 I = 1, NLEV
- CALL UTWRIT (CHFOR(II:II+1), '(I2)', NLCUR(I))
- II = II + 2
- CHFOR(II:II) = CHCUR(I)
- II = II + 2
- 45 CONTINUE
-#endif
- II = 4 *NLEV
- CHFOR = CHFOR(1:II)//' -H'
- CALL MZIOCH (IOFMCF, NWFMCF, CHFOR(1:II+3))
-*
-* ** Fill up the header
-*
- NWDP = (NCHAR + 3) / 4
- NWDH = NWDP + 2 * NWKYCK + 5
- IHEDCF(MACTCF) = 5
- IHEDCF(MNKYCF) = NWKYCK
- IHEDCF(MOPTCF) = 0
- IHEDCF(MPATCF) = NWDP
- IHEDCF(MPRECF) = 0
- CALL UCOPY (KEYO, IHEDCF(MPRECF+1), NWKYCK)
- CALL UCOPY (KEYN, IHEDCF(MPRECF+NWKYCK+1), NWKYCK)
- CALL UCTOH (PATHY, IHEDCF(MPRECF+2*NWKYCK+1), 4, 4*NWDP)
- ENDIF
-#if (defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))&&(!defined(CERNLIB__P3CHILD))&&(defined(CERNLIB__ONLINE))
-*
- IF (IOPPCD.NE.0) THEN
- CALL CDWLOK (IRC)
- IF (IRC.NE.0) GO TO 999
- ENDIF
-#endif
-*
-* ** Write the sequential output if needed
-*
- IF (LUFZCF.GT.0) THEN
-#if defined(CERNLIB__P3CHILD)
- RNDBP3 = 'CDRENK '
- NWDBP3 = 2
- CALL UCTOH ('JOURNAL ', IWDBP3, 4, 8)
- CALL CDCHLD
- IRC = IQDBP3
- IF (IRC.NE.0) GO TO 999
-#endif
- CALL FZOUT (LUFZCF, IDISCD, 0, 1, 'Z', IOFMCF, NWDH, IHEDCF)
- IF (IQUEST(1).NE.0) THEN
- IRC = 195
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDRENK : Error'//
- + ' in FZOUT while writing Data for '//PATHY(1:60)//''')',
- + IARGCD, 0)
-#endif
- GO TO 999
- ENDIF
- ENDIF
-#if (defined(CERNLIB_UNIX)||defined(CERNLIB_IBMVM)||defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))
-*
- IF (IOPPCD.NE.0) GO TO 998
-#endif
-#if !defined(CERNLIB__P3CHILD)
-*
-* *** Take necessary action for partitioned and nonpartitioned datasets
-*
- IF (IOPSCD.NE.0) CALL RZLOCK ('CDRENK')
- CALL RZRENK (KEYO, KEYN)
- IERR = IQUEST(1)
- IF (IOPSCD.NE.0) CALL RZFREE ('CDRENK')
- IF (IERR.NE.0) THEN
- IRC = 196
-#endif
-#if (defined(CERNLIB__DEBUG))&&(!defined(CERNLIB__P3CHILD))
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDRENK : Error'//
- + ' in RZRENK while writing data for '//PATHY(1:60)//''')',
- + IARGCD, 0)
-#endif
-#if !defined(CERNLIB__P3CHILD)
- GO TO 999
- ENDIF
- IF (IOPTP.NE.0) THEN
- CALL CDPVAL (KEYN)
- CALL RZCDIR (PATHY, ' ')
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- NKEYCK = IQUEST(7)
-*
-* ** Rename Keys 3 and 4 of the latest subdirectory
-*
- IF (IOPSCD.NE.0) CALL RZLOCK ('CDRENK')
- CALL RZRENK (KYP1CK, KYP2CK)
- IERR = IQUEST(1)
- IF (IOPSCD.NE.0) CALL RZFREE ('CDRENK')
- IF (IERR.NE.0) THEN
- IRC = 196
-#endif
-#if (defined(CERNLIB__DEBUG))&&(!defined(CERNLIB__P3CHILD))
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDRENK : Error'//
- + ' in RZRENK while writing data for '//PATHY(1:60)//''')',
- + IARGCD, 0)
-#endif
-#if !defined(CERNLIB__P3CHILD)
- GO TO 999
- ENDIF
- ENDIF
-#endif
-*
- 998 CONTINUE
-#if (defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))&&(!defined(CERNLIB__P3CHILD))&&(defined(CERNLIB__ONLINE))
- IF (IOPPCD.NE.0) THEN
- IOPBCA = 0
- CALL CDCWSV (IRC)
- ENDIF
-#endif
-#if !defined(CERNLIB_IBM)||!defined(CERNLIB__P3CHILD)
-*
- 2001 FORMAT (20(I2,A1,1X))
-#endif
-* END CDRENK
- 999 END
diff --git a/src/packlib/hepdb/cdstore/cdrepl.F b/src/packlib/hepdb/cdstore/cdrepl.F
deleted file mode 100644
index 3b4e106..0000000
--- a/src/packlib/hepdb/cdstore/cdrepl.F
+++ /dev/null
@@ -1,180 +0,0 @@
-*
-* $Id: cdrepl.F,v 1.1.1.1 1996/02/28 16:24:34 mclareni Exp $
-*
-* $Log: cdrepl.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:34 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDREPL (PATHN, LSUP, LBK, IUDIV, KEYO,KEYN, CHOPT, IRC)
-* ==================================================================
-*
-************************************************************************
-* *
-* SUBR. CDREPL (PATHN, LSUP,*LBK*,IUDIV, KEYO,KEYN,CHOPT, IRC*) *
-* *
-* Stores data from memory to disk and also enters in the memory ala *
-* DBUSE in NODE/KEY structure. Also replaces an Old set of keys in *
-* KEYO by a new set of keys in KEYN *
-* *
-* Arguments : *
-* *
-* PATHN Character string describing the pathname *
-* LSUP Address of bank in memory where data reside *
-* LBK Address of Keys bank KYCD (INPUT or OUTPUT) *
-* IUDIV Division index of the user data bank *
-* KEYO Vector of old keys *
-* KEYN Vector of new keys *
-* CHOPT Character string with any of the following characters *
-* A trust LBK address if non-zero *
-* B Save in the special backup file; not in standard Journal*
-* C create Node/Key data structure ala DBUSE *
-* D Store only the differences from an existing object *
-* F Updates with a fully matched data object (in user keys) *
-* K Store data only inside the keys (not yet installed) *
-* H Insertion time as supplied by user to be honoured *
-* P Store data compressed (bit packing) *
-* R Replace existing object as specified by the vector KEYO *
-* T Special text type of data (to be used with Y) *
-* Y Store with full RZ option (No compression to be made) *
-* Z Store only nonzero elements. An element is considered to*
-* to be zero if its absolute value is less than DELTA *
-* IRC Return code (see below) *
-* *
-* Called by user, CDSTOM *
-* *
-* Error Condition : *
-* *
-* IQUEST(1) = 0 : No error *
-* = 61 : Too many keys *
-* = 62 : Too many keys with option N *
-* = 63 : Data base structure in memory clobbered *
-* = 64 : Error in MZCOPY while copying Data bank *
-* *
-************************************************************************
-*
-#include "hepdb/caopts.inc"
-#include "hepdb/cdcblk.inc"
-#include "hepdb/ckkeys.inc"
-#include "hepdb/clinks.inc"
-#include "hepdb/ctpath.inc"
- PARAMETER (JBIAS=2)
- DIMENSION KEYN(9), KEYO(9), LBK(9), LSUP(9)
- CHARACTER CHOPT*(*), PATHN*(*), PATHY*80, CHOP*2
-*
-* ------------------------------------------------------------------
-*
-* *** Decode the character option
-*
- LREFCD(1) = LBK(1)
- CALL CDOPTS (CHOPT, IRC)
- IF (IRC.NE.0) GO TO 999
-*
- IF (IOPFCA.NE.0) IOPDCA = 1
- IF (IOPTCA.NE.0) IOPYCA = 1
- IF (IOPYCA.NE.0) THEN
- IOPPCA = 0
- IOPZCA = 0
- ENDIF
- IF (IOPPCA.NE.0) IOPZCA = 0
-*
-* *** Prepare the output with the old keys
-*
- IOPICA = 1
- IF (LSTRCL(3).NE.0) CALL MZDROP (IDISCD, LSTRCL(3), 'L')
- CALL CDBANK (IDISCD, LSTRCL(3), LSTRCL(3), JBIAS, 'SAME', 0, 0, 0,
- + 2, 0, IRC)
- IF (IRC.NE.0) GO TO 999
-*
- CALL CDKOUT (PATHN, LSTRCL(3), IDISCD, KEYO, KEYVCK, IRC)
- IF (LSTRCL(3).NE.0) THEN
- CALL MZDROP (IDISCD, LSTRCL(3), 'L')
- LSTRCL(3) = 0
- ENDIF
- IF (IRC.NE.0) GO TO 999
- CALL RZCDIR (PATHY, 'R')
-*
-* *** Prepare the Key vector array of the new object
-*
- IOPICA = 0
- CALL CDKOUT (PATHY, LSUP(1), IUDIV, KEYN, KEYVCK, IRC)
- IF (IRC.NE.0) GO TO 999
-*
-* *** Create data bank in memory ala DBUSE
-*
- IF (IOPCCA.NE.0) THEN
-*
-* ** Create database skeleton in memory (banks NOCD and KYCD)
-*
- IF (IOPACA.EQ.0. OR. (IOPACA.NE.0. AND. LREFCD(1).EQ.0) ) THEN
-*
- CALL CDBOOK (PATHY, LBK, 1, CHOPT, IRC)
- IF (IRC.NE.0) GO TO 999
- LREFCD(1) = LBK(1)
- CALL UCOPY (KEYVCK(1), IQ(KOFUCD+LREFCD(1)+1), NWKYCK)
- NDK = IQ(KOFUCD+LREFCD(1)-1)
- IQ(KOFUCD+LREFCD(1)+NDK+MKYFRI) = 0
- DO 20 I = 1, NPARCD
- IQ(KOFUCD+LREFCD(1)+NWKYCK+I) = KEYVCK(NOF1CK+2*I)
- 20 CONTINUE
-*
- ELSE
-#if defined(CERNLIB__DEBUG)
-*
- IF (IDEBCD.GT.0) THEN
- LBNOCD = LQ(KOFUCD+LREFCD(1)-KLNOCD)
- NF = IQ(KOFUCD+LBNOCD+MNDNCH)
- CALL UHTOC (IQ(KOFUCD+LBNOCD+MNDNAM), 4, PAT2CT, NF)
- PAT2CT = PAT2CT (1:NF)
- N = LENOCC (PATHY) + 1
-*
- 25 N = N -1
- IF (PATHY(N:N).NE.PAT2CT(NF:NF)) THEN
- IQUEST(1) = 63
- IQUEST(11)= N
- CALL CDPRNT (LPRTCD, '(/,'' CDREPL : Database structure'//
- + ' in memory clobbered'')', IARGCD, 0)
- GO TO 999
- ELSE IF (N.NE.1) THEN
- NF = NF -1
- GO TO 25
- ENDIF
- ENDIF
-#endif
-*
- CALL UCOPY (KEYVCK(1), IQ(KOFUCD+LREFCD(1)+1), NWKYCK)
- NDK = IQ(KOFUCD+LREFCD(1)-1)
- IQ(KOFUCD+LREFCD(1)+NDK+MKYFRI) = 0
- DO 30 I = 1, NPARCD
- IQ(KOFUCD+LREFCD(1)+NWKYCK+I) = KEYVCK(NOF1CK+2*I)
- 30 CONTINUE
- ENDIF
-*
-* ** Now copy the data banks appended at LSUP to the key bank
-*
- IF (IOPYCA.EQ.0) THEN
- CHOP = 'NP'
- ELSE
- CHOP = 'LP'
- ENDIF
-*
- LBD = LQ(KOFUCD+LREFCD(1)-KLDACD)
- IF (LBD.NE.0) CALL MZDROP (IDIVCD, LBD, 'L')
- IF (IOPKCA.EQ.0 .AND. LSUP(1).NE.0) THEN
- CALL MZCOPY (IUDIV, LSUP(1), IDIVCD, LREFCD(1), -KLDACD, CHOP)
- ENDIF
-*
- IF (IQUEST(1).NE.0) THEN
- IQUEST(11) = IQUEST(1)
- IRC = 64
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDREPL : Error'//
- + ' '',I6,'' while copying the Data bank in the Node/Key stru'//
- + 'cture'')', IQUEST(11), 1)
-#endif
- ENDIF
-*
- ENDIF
-* END CDREPL
- 999 END
diff --git a/src/packlib/hepdb/cdstore/cdstom.F b/src/packlib/hepdb/cdstore/cdstom.F
deleted file mode 100644
index d9dc2cc..0000000
--- a/src/packlib/hepdb/cdstore/cdstom.F
+++ /dev/null
@@ -1,103 +0,0 @@
-*
-* $Id: cdstom.F,v 1.1.1.1 1996/02/28 16:24:34 mclareni Exp $
-*
-* $Log: cdstom.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:34 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDSTOM (PATHN, LADDR, LKYBK, IUDIV, NWDIM, NOBJ, KEYO,
- + KEYN, CHOPT, IRC)
-* =================================================================
-*
-************************************************************************
-* *
-* SUBR. CDSTOM (PATHN, LADDR, *LKYBK*, IUDIV, NWDIM, NOBJ, KEYO,*
-* KEYN, CHOPT, IRC*) *
-* *
-* Stores data from memory to disk and also enters in the memory ala *
-* DBUSE in NODE/KEY structure *
-* *
-* Arguments : *
-* *
-* PATHN Character string describing the pathname *
-* LADDR Vector of NOBJ bank addresses *
-* LKYBK Address of the first Key bank KYCD (INPUT or OUTPUT) *
-* IUDIV Division index of the user data bank *
-* NWDIM First dimension of the array KEY *
-* NOBJ Number of objects to be inserted. The key vectors KEYO *
-* and KEYN must be dimensioned (NWDIM,NOBJ) *
-* KEYO Vector/matrix of old keys *
-* KEYN Vector/matrix of new keys *
-* CHOPT Character string with any of the following characters *
-* A Trust LBK address if non-zero *
-* B Save in the special backup file; not in standard Journal*
-* C Create Node/Key data structure ala DBUSE *
-* D Store only the differences from an existing object *
-* F Updates with a fully matched data object (in user keys) *
-* K Store data only inside the keys (not yet installed) *
-* H Insertion time as supplied by user to be honoured *
-* P Store data compressed (bit packing) *
-* R Replace existing object as specified by the vector KEYO *
-* T Special text type of data (to be used with R) *
-* Y Store with full RZ option (No compression to be made) *
-* Z Store only nonzero elements. An element is considered to*
-* to be zero if its absolute value is less than DELTA *
-* IRC Return code (see below) *
-* *
-* Called by user *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* = 62 : Illegal character option *
-* = 65 : Illegal number of objects *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
-#include "hepdb/ctpath.inc"
- DIMENSION LADDR(9), LKYBK(9), KEYO(NWDIM,2), KEYN(NWDIM,2)
- CHARACTER CHOPT*(*), PATHN*(*)
-*
-* ------------------------------------------------------------------
-*
-* *** Branch according to NOBJ and R option
-*
- IOPR = INDEX (CHOPT, 'R')
- IOPC = INDEX (CHOPT, 'C')
-*
- IF (NOBJ.EQ.1) THEN
-*
- IF (IOPR.NE.0) THEN
- CALL CDREPL (PATHN, LADDR,LKYBK, IUDIV, KEYO,KEYN, CHOPT, IRC)
- ELSE
- CALL CDSTOR (PATHN, LADDR,LKYBK, IUDIV, KEYN, CHOPT, IRC)
- ENDIF
-*
- ELSE IF (NOBJ.GT.1) THEN
-*
- IF (IOPR.EQ.0.AND.IOPC.EQ.0) THEN
- CALL CDENTB (PATHN, LADDR,IUDIV, NWDIM,NOBJ, KEYN, CHOPT, IRC)
- ELSE
- IRC = 62
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) THEN
- TOP1CT = CHOPT
- CALL CDPRNT (LPRTCD, '(/,'' CDSTOM : Character option '//
- + TOP1CT//' incompatible with NOBJ '',I12)', NOBJ, 1)
- ENDIF
-#endif
- ENDIF
-*
- ELSE
-*
- IRC = 65
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDSTOM : Too few'//
- + ' objects '',I12)', NOBJ, 1)
-#endif
- ENDIF
-* END CDSTOM
- END
diff --git a/src/packlib/hepdb/cdstore/cdstor.F b/src/packlib/hepdb/cdstore/cdstor.F
deleted file mode 100644
index 9dcd216..0000000
--- a/src/packlib/hepdb/cdstore/cdstor.F
+++ /dev/null
@@ -1,159 +0,0 @@
-*
-* $Id: cdstor.F,v 1.1.1.1 1996/02/28 16:24:34 mclareni Exp $
-*
-* $Log: cdstor.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:34 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDSTOR (PATHN, LADDR, LBK, IUDIV, KEY, CHOPT, IRC)
-* =============================================================
-*
-************************************************************************
-* *
-* SUBR. CDSTOR (PATHN, LADDR, *LBK*, IUDIV, KEY, CHOPT, IRC*) *
-* *
-* Stores data from memory to disk and also enters in the memory ala *
-* DBUSE in NODE/KEY structure *
-* *
-* Arguments : *
-* *
-* PATHN Character string describing the pathname *
-* LADDR Address of bank in memory where data reside *
-* LBK Address of Keys bank KYCD (INPUT or OUTPUT) *
-* IUDIV Division index of the user data bank *
-* KEY Vector of keys *
-* CHOPT Character string with any of the following characters *
-* B Save in the special backup file; not in standard Journal*
-* C Create Node/Key data structure ala CDUSE *
-* D Store only the differences from an existing object *
-* F Updates with a fully matched data object (in user keys) *
-* K Store data only inside the keys (not yet installed) *
-* H Insertion time as supplied by user to be honoured *
-* P Store data compressed (bit packing) *
-* T Special text type of data (to be used with R) *
-* (was for DBAIWR - no longer needed?) *
-* Y Store with full RZ option (No compression to be made) *
-* Z Store only nonzero elements. An element is considered *
-* to be zero if its absolute value is less than DELTA *
-* IRC Return code (see below) *
-* *
-* Called by user, CDSTOM *
-* *
-* Error Condition : *
-* *
-* IQUEST(1) = 0 : No error *
-* = 63 : Data base structure in memory clobbered *
-* = 64 : Error in MZCOPY while copying Data bank *
-* *
-************************************************************************
-*
-#include "hepdb/caopts.inc"
-#include "hepdb/cdcblk.inc"
-#include "hepdb/ckkeys.inc"
-#include "hepdb/clinks.inc"
-#include "hepdb/ctpath.inc"
- DIMENSION KEY(9), LADDR(9), LBK(9)
- CHARACTER CHOPT*(*), PATHN*(*), CHOP*2, PATHY*80
-*
-* ------------------------------------------------------------------
-*
-* *** Decode the character option
-*
- LREFCD(1) = LBK(1)
- CALL CDOPTS (CHOPT, IRC)
- IF (IRC.NE.0) GO TO 999
-*
- IF (IOPFCA.NE.0) IOPDCA = 1
- IF (IOPTCA.NE.0) IOPYCA = 1
- IF (IOPYCA.NE.0) THEN
- IOPPCA = 0
- IOPZCA = 0
- ENDIF
- IF (IOPPCA.NE.0) IOPZCA = 0
-*
-* *** Write out the data
-*
- CALL CDKOUT (PATHN, LADDR, IUDIV, KEY, KEYVCK, IRC)
- IF (IRC.NE.0) GO TO 999
- CALL RZCDIR (PATHY, 'R')
-*
-* *** Create data bank in memory ala DBUSE
-*
- IF (IOPCCA.NE.0) THEN
-*
-* ** Create database skeleton in memory (banks NOCD and KYCD)
-*
- IF (IOPACA.EQ.0. OR. (IOPACA.NE.0. AND. LREFCD(1).EQ.0) ) THEN
-*
- CALL CDBOOK (PATHY, LBK, 1, CHOPT, IRC)
- IF (IRC.NE.0) GO TO 999
- LREFCD(1) = LBK(1)
- CALL UCOPY (KEYVCK(1), IQ(KOFUCD+LREFCD(1)+1), NWKYCK)
- NDK = IQ(KOFUCD+LREFCD(1)-1)
- IQ(KOFUCD+LREFCD(1)+NDK+MKYFRI) = 0
- DO 20 I = 1, NPARCD
- IQ(KOFUCD+LREFCD(1)+NWKYCK+I) = KEYVCK(NOF1CK+2*I)
- 20 CONTINUE
-*
- ELSE
-#if defined(CERNLIB__DEBUG)
-*
- IF (IDEBCD.GT.0) THEN
- LBNOCD = LQ(KOFUCD+LREFCD(1)-KLNOCD)
- NF = IQ(KOFUCD+LBNOCD+MNDNCH)
- CALL UHTOC (IQ(KOFUCD+LBNOCD+MNDNAM), 4, PAT2CT, NF)
- PAT2CT = PAT2CT (1:NF)
- N = LENOCC (PATHY) + 1
-*
- 25 N = N -1
- IF (PATHY(N:N).NE.PAT2CT(NF:NF)) THEN
- IRC = 63
- IQUEST(11) = N
- CALL CDPRNT (LPRTCD, '(/,'' CDSTOR : Database structure'//
- + ' in memory clobbered'')', IARGCD, 0)
- GO TO 999
- ELSE IF (N.NE.1) THEN
- NF = NF -1
- GO TO 25
- ENDIF
- ENDIF
-#endif
-*
- CALL UCOPY (KEYVCK(1), IQ(KOFUCD+LREFCD(1)+1), NWKYCK)
- NDK = IQ(KOFUCD+LREFCD(1)-1)
- IQ(KOFUCD+LREFCD(1)+NDK+MKYFRI) = 0
- DO 30 I = 1, NPARCD
- IQ(KOFUCD+LREFCD(1)+NWKYCK+I) = KEYVCK(NOF1CK+2*I)
- 30 CONTINUE
- ENDIF
-*
-* ** Now copy the data banks appended at LADDR to the key bank
-*
- IF (IOPYCA.EQ.0) THEN
- CHOP = 'NP'
- ELSE
- CHOP = 'LP'
- ENDIF
-*
- LBD = LQ(KOFUCD+LREFCD(1)-KLDACD)
- IF (LBD.NE.0) CALL MZDROP (IDIVCD, LBD, 'L')
- IF (IOPKCA.EQ.0 .AND. LADDR(1).NE.0) THEN
- CALL MZCOPY (IUDIV, LADDR(1), IDIVCD, LREFCD(1), -KLDACD,
- + CHOP)
-*
- IF (IQUEST(1).NE.0) THEN
- IQUEST(11) = IQUEST(1)
- IRC = 64
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDSTOR : Err'//
- + 'or '',I6,'' while copying the Data bank in the Node/Key '//
- + 'structure'')', IQUEST(11), 1)
-#endif
- ENDIF
- ENDIF
-*
- ENDIF
-* END CDSTOR
- 999 END
diff --git a/src/packlib/hepdb/cdunpack/Imakefile b/src/packlib/hepdb/cdunpack/Imakefile
deleted file mode 100644
index 2d98071..0000000
--- a/src/packlib/hepdb/cdunpack/Imakefile
+++ /dev/null
@@ -1,8 +0,0 @@
-SRCS_F= cdchfi.F cditoc.F cdtous.F cducmp.F cducmz.F \ @@\
- cduncp.F cdupck.F cdupfz.F cdupiz.F
-
-#if !defined(CERNLIB_P3CHILD)
-SRCS_F := $(SRCS_F) cdlind.F
-#endif
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/hepdb/cdunpack/cdchfi.F b/src/packlib/hepdb/cdunpack/cdchfi.F
deleted file mode 100644
index 8b00776..0000000
--- a/src/packlib/hepdb/cdunpack/cdchfi.F
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: cdchfi.F,v 1.1.1.1 1996/02/28 16:24:35 mclareni Exp $
-*
-* $Log: cdchfi.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:35 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDCHFI (I, CH)
-* =========================
-*
-************************************************************************
-* *
-* SUBR. CDCHFI (I, CH*) *
-* *
-* Converts an integer I to an output single character CH (of type *
-* Character) via the look-up table stored in CSTRCA *
-* (Adapted from CHTOI from CERN Library) *
-* *
-* Called by CDLIND *
-* *
-************************************************************************
-*
-#include "hepdb/caopti.inc"
- CHARACTER CH*1
-* ------------------------------------------------------------------
-*
- CH = CSTRCA(63:63)
- IF (I.LT.32.OR.I.GT.127) GO TO 999
- CH = CSTRCA(I:I)
-* END CDCHFI
- 999 END
diff --git a/src/packlib/hepdb/cdunpack/cditoc.F b/src/packlib/hepdb/cdunpack/cditoc.F
deleted file mode 100644
index 433fbcf..0000000
--- a/src/packlib/hepdb/cdunpack/cditoc.F
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: cditoc.F,v 1.1.1.1 1996/02/28 16:24:37 mclareni Exp $
-*
-* $Log: cditoc.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:37 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDITOC (IAR, CH, NWD, NCH)
-* =====================================
-*
-************************************************************************
-* *
-* SUBR. CDITOC (IAR, CH*, NWD, NCH) *
-* *
-* Converts integer array IAR (of length NWD) to an output character *
-* string CH (of type character and NCH long) via the look-up *
-* table stored in CSTRCA *
-* *
-* Called by CDLIND *
-* *
-************************************************************************
-*
-#include "hepdb/caopti.inc"
- CHARACTER CH*(*), CH1*1
- DIMENSION IAR(9), IB(4)
-* ------------------------------------------------------------------
-*
- DO 10 J = 1, NWD
- K = 4*J - 4
- CALL UPKBYT (IAR(J), 1, IB, 4, MPAKCA)
- DO 5 I = 1, 4
- IF (K+I.GT.NCH) GO TO 999
- CH1 = CSTRCA(63:63)
- IF (IB(I).GE.32.AND.IB(I).LE.127) CH1 = CSTRCA(IB(I):IB(I))
- CH(K+I:K+I) = CH1
- 5 CONTINUE
- 10 CONTINUE
-* END CDITOC
- 999 END
diff --git a/src/packlib/hepdb/cdunpack/cdlind.F b/src/packlib/hepdb/cdunpack/cdlind.F
deleted file mode 100644
index c626a7f..0000000
--- a/src/packlib/hepdb/cdunpack/cdlind.F
+++ /dev/null
@@ -1,249 +0,0 @@
-*
-* $Id: cdlind.F,v 1.1.1.1 1996/02/28 16:24:35 mclareni Exp $
-*
-* $Log: cdlind.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:35 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
-#if !defined(CERNLIB__P3CHILD)
- SUBROUTINE CDLIND (IDATA, NTOT, CLINE, LENGTH)
-* ==============================================
-*
-************************************************************************
-* *
-* SUBR. CDLIND (IDATA, *NTOT*, CLINE*, LENGTH*) *
-* *
-* Decodes an encdoed array into a string of characters *
-* *
-* Arguments : *
-* *
-* IDATA Array containing the encoded information *
-* NTOT Current location of the array IDATA to be decoded *
-* CLINE Character string of maximum 80 characters *
-* LENGTH Length of the string *
-* *
-* Called by CDAFRI *
-* *
-* Original Code : DPLINE in CMZ Package *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
-#include "hepdb/ckkeys.inc"
- CHARACTER CLINE*(*), KLINE*80
- DIMENSION LINE(20), IDATA(9)
- CHARACTER*8 KEYW(13)
- CHARACTER*1 CAR, KONE, KTWO*(3)
- DIMENSION NCHKEY(13)
-*
- DATA KEYW /'RETURN','RETURN','CONTINUE','END','END',
- + '+SELF.','+SEL','+CDE','+SEQ','+KEE','+DEC',
- + 'ELSE','ENDIF'/
- DATA NCHKEY /6, 6, 8, 3, 3, 6, 4, 4, 4, 4, 4, 4, 5/
-#include "zebra/q_jbit.inc"
-* Ignoring t=pass
-*
-* ------------------------------------------------------------------
-*
- ICADRE = 0
- IWORD = IDATA(NTOT+1)
- IF (IWORD.EQ.0) THEN
- LENGTH = 0
- CLINE = ' '
- NTOT = NTOT + 1
- GO TO 999
- ENDIF
-*
- LENGTH = 0
- KLINE = ' '
- IBIT31 = JBIT (IWORD, 31)
- IBIT32 = JBIT (IWORD, 32)
- IF (IBIT31.NE.0) THEN
- ITWO = IDATA(NTOT+2)
- NWI = 2
- CALL CDITOC (ITWO, KTWO, 1, 3)
- ELSE
- KTWO = ' '
- NWI = 1
- ENDIF
- KCODE = JBYT (IWORD, 1, 8)
- IF (IBIT32.NE.0) THEN
-*
-* *** Study the comment cards
-*
- ICODE = KCODE
- ICADRE = MOD (ICODE, 2)
- IPOINT = MOD (ICODE, 4)
- ICMMNT = ICODE/4
- IF (ICMMNT.EQ.1) THEN
- KONE = 'C'
- ELSE IF (ICMMNT.EQ.2) THEN
- KONE = 'c'
- ELSE
- KONE = '*'
- ENDIF
- IF (IPOINT.GT.1) THEN
- KTWO = '.'
- ENDIF
- KLINE = KONE//KTWO
- LENGTH = 4
-*
-* ** Is there a box ?
-*
- IF (ICADRE.NE.0) THEN
- NWI = NWI + 1
- IPOS1 = JBYT (IDATA(NTOT+NWI), 25, 8)
- IPOS2 = JBYT (IDATA(NTOT+NWI), 9, 8)
- IKLIN = JBYT(IDATA(NTOT+NWI),1,8)
- CALL CDCHFI (IKLIN, KLINE(IPOS2:IPOS2))
- LENGTH = IPOS2
- IF (IPOS1.NE.0) THEN
- IKLIN = JBYT(IDATA(NTOT+NWI),17,8)
- CALL CDCHFI (IKLIN, KLINE(IPOS1:IPOS1))
- ENDIF
- ENDIF
-*
-* *** Is there a character to repeat?
-*
- ICAR = JBYT (IWORD, 9, 8)
- IF (ICAR.EQ.0) THEN
-*
-* ** No character to repeat.
-*
- IFWORD = JBYT (IWORD, 17, 7)
- ILASTW = JBYT (IWORD, 24, 7)
- IF (ILASTW.EQ.1) THEN
- NTOT = NTOT + NWI
- GO TO 70
- ENDIF
-*
- IF (ILASTW.GT.20 .OR. IFWORD.GT.ILASTW) GO TO 100
-*
- DO 10 IW = IFWORD, ILASTW
- JW = NTOT + NWI + IW - IFWORD + 1
- LINE(IW) = IDATA(JW)
- 10 CONTINUE
- NTOT = NTOT + NWI + ILASTW - IFWORD + 1
- GO TO 60
- ELSE
-*
-* ** Character must be repeated.
-*
- CALL CDCHFI (ICAR, CAR)
- IFIRST = JBYT (IWORD, 17, 7)
- ILAST = JBYT (IWORD, 24, 7)
-*
- IF (ILAST.GT.80 .OR. IFIRST.GT.ILAST) GO TO 100
-*
- DO 20 I = IFIRST, ILAST
- KLINE(I:I) = CAR
- 20 CONTINUE
- NTOT = NTOT + NWI
- IF (ICADRE.EQ.0) LENGTH = ILAST
- GO TO 70
- ENDIF
- ELSE
-*
-* *** Special cases
-*
- ICODE = JBYT (IWORD, 24, 7)
- ICOD = ICODE - 114
-*
-* ** Case ENDIF or ELSE or END or CONTINUE or RETURN
-* ** Case +PATCH,+DECK,+KEEP,+SEQ,+CDE,+SELF
-*
-* ICODE = 115 ICOD = 1 'RETURN with label'
-* = 116 = 2 'RETURN without label'
-* = 117 3 'CONTINUE'
-* = 118 4 'END without label'
-* = 119 5 'END with label'
-* = 120 6 '+SELF.'
-* = 121 7 '+SELF,'
-* = 122 8 '+CDE'
-* = 123 9 '+SEQ'
-* = 124 10 '+KEEP,'
-* = 125 11 '+DECK,'
-* = 126 12 'ELSE'
-* = 127 13 'ENDIF'
-*
- IF (ICOD.LE.0) GO TO 40
- IF (ICOD.LT.6 .OR. ICOD.GT.11) THEN
- IFIRST = JBYT (IWORD, 17, 7)
- CLINE(1:IFIRST) = ' '
- IF (ICOD.EQ.1 .OR. ICOD.EQ.3 .OR. ICOD.EQ.5) THEN
- CALL CDCHFI (KCODE, KONE)
- IKLIN = JBYT (IWORD, 9, 8)
- CALL CDCHFI (IKLIN, CLINE(5:5))
- CLINE(:4) = KONE//KTWO
- ENDIF
- LENGTH = IFIRST+NCHKEY(ICOD)-1
- CLINE(IFIRST:LENGTH) = KEYW(ICOD)
- NTOT = NTOT + NWI
- GO TO 900
- ENDIF
-*
-* *** Case +PATCH,+DECK,+KEEP,+SEQ,+CDE,+SELF
-*
- IF (ICOD .EQ. 6) THEN
- CLINE(:6) = '+SELF.'
- NTOT = NTOT + 1
- LENGTH = 6
- GO TO 900
- ENDIF
-*
- IFWORD = 2
- KLINE(1:4) = KEYW(ICOD)
- ILASTW = JBYT (IWORD, 17, 7)
- DO 30 IW = 2, ILASTW
- LINE(IW) = IDATA(NTOT+IW)
- 30 CONTINUE
- NTOT = NTOT + ILASTW
- GO TO 60
- ENDIF
-*
- 40 CONTINUE
-*
-* *** Normal instructions
-*
- CALL CDCHFI (KCODE, KONE)
- KLINE = KONE//KTWO
- ILASTW = ICODE
- IF (ILASTW.LT.2) THEN
- NTOT = NTOT+NWI
- LENGTH = 4
- GO TO 70
- ENDIF
- IFWORD = JBYT (IWORD, 17, 7)
-*
- IF (ILASTW.GT.20 .OR. IFWORD.GT.ILASTW) GO TO 100
-*
- DO 50 IW = IFWORD, ILASTW
- JW = NTOT + NWI + IW - IFWORD + 1
- LINE(IW) = IDATA(JW)
- 50 CONTINUE
- NTOT = NTOT + NWI + ILASTW - IFWORD + 1
- 60 CONTINUE
- NC = (IFWORD-1)*4 + 1
- LENGW = ILASTW-IFWORD+1
- LENG = 4*LENGW
- CALL CDITOC (LINE(IFWORD), KLINE(NC:), LENGW, LENG)
- IF (ICADRE.EQ.0) LENGTH = ILASTW*4
- 70 I1 = LENGTH
- DO 80 I = I1, 1, -1
- IF (KLINE(I:I).NE.' ') GO TO 90
- LENGTH = LENGTH - 1
- 80 CONTINUE
-*
- 90 CLINE = KLINE(1:LENGTH)
- GO TO 900
-*
- 100 CALL CDPRNT (LPRTCD, '('' **** WARNING : Data in deck is corrup'//
- + 'ted ****'')', IARGCD, 0)
- CLINE = ' '
- LENGTH = 0
- 900 CONTINUE
-* END CDLIND
- 999 END
-#endif
diff --git a/src/packlib/hepdb/cdunpack/cdtous.F b/src/packlib/hepdb/cdunpack/cdtous.F
deleted file mode 100644
index 1288732..0000000
--- a/src/packlib/hepdb/cdunpack/cdtous.F
+++ /dev/null
@@ -1,58 +0,0 @@
-*
-* $Id: cdtous.F,v 1.1.1.1 1996/02/28 16:24:35 mclareni Exp $
-*
-* $Log: cdtous.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:35 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDTOUS (LC, IUDIV, LU, LSUP, JBIAS, IPREC, IRC)
-* ==========================================================
-*
-************************************************************************
-* *
-* SUBR. CDTOUS (LC, IUDIV, LU*, LSUP, JBIAS, IPREC*, IRC*) *
-* *
-* Copies Single Bank at LC from the Data Base system into Bank at LU *
-* in the user division in the user system *
-* *
-* Arguments : *
-* *
-* LC Address of the bank to be copied *
-* IUDIV Division index of the user division *
-* LU Address of the copied bank *
-* LSUP Address of the supporting bank (see MZBOOK) *
-* JBIAS Link Bias (see MZBOOK) *
-* IPREC Signed precision word; the data are truncated after *
-* having multiplied by 10**IPREC *
-* IRC Return code (see below) *
-* *
-* Called by CDKXIN *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
- DIMENSION LC(9), LSUP(9), LU(9)
-*
-* ------------------------------------------------------------------
-*
- LREFCD(4) = LC(1)
- NDU = IQ(KOFUCD+LREFCD(4)-1) - 2
- ITU = ICDTYP (LREFCD(4))
- CALL CDBANK (IUDIV, LU(1), LSUP(1), JBIAS, 'USER', 0, 0, NDU, ITU,
- + 0, IRC)
- IF (IRC.NE.0) GO TO 999
- IF (ITU.EQ.3) THEN
- CALL UCOPY (Q(KOFUCD+LREFCD(4)+3), Q(KOFUCD+LU(1)+1), NDU)
- IPREC = Q(KOFUCD+LREFCD(4)+2)
- ELSE
- CALL UCOPY (IQ(KOFUCD+LREFCD(4)+3), IQ(KOFUCD+LU(1)+1), NDU)
- IPREC = IQ(KOFUCD+LREFCD(4)+2)
- ENDIF
-* END CDTOUS
- 999 END
diff --git a/src/packlib/hepdb/cdunpack/cducmp.F b/src/packlib/hepdb/cdunpack/cducmp.F
deleted file mode 100644
index bf9b028..0000000
--- a/src/packlib/hepdb/cdunpack/cducmp.F
+++ /dev/null
@@ -1,133 +0,0 @@
-*
-* $Id: cducmp.F,v 1.1.1.1 1996/02/28 16:24:35 mclareni Exp $
-*
-* $Log: cducmp.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:35 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDUCMP (LB, IADS, IRC)
-* =================================
-*
-************************************************************************
-* *
-* SUBR. CDUCMP (LB, IADS*, IRC*) *
-* *
-* Uncompresses data bank defined by LB in the Data Base *
-* *
-* Arguments : *
-* *
-* LB Address of the bank to be uncompressed *
-* IADS Address of the uncompressed bank as LAUXCL(IADS) *
-* IRC Return code (see below) *
-* *
-* Called by CDUNCP *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* = 81 : Precision is not correctly given *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
-#include "hepdb/clinks.inc"
- PARAMETER (JBIAS = 2)
- DIMENSION LB(9)
-#include "zebra/q_jbit.inc"
-* Ignoring t=pass
-*
-* ------------------------------------------------------------------
-*
- LREFCD(7) = LB(1)
- NDI = IQ(KOFUCD+LREFCD(7)-1) - 3
- LB3 = LREFCD(7) + 3
- NAU = JBYT (IQ(KOFUCD+LB3), 1, 26)
- LBITL = JBYT (IQ(KOFUCD+LB3), 27, 5)
- IVM = IQ(KOFUCD+LREFCD(7)+2)
- LB1 = LREFCD(7) + 1
- NDO = IQ(KOFUCD+LB1)/10000
- IDT = MOD (IQ(KOFUCD+LB1), 10000)
- IPREC = MOD (IDT, 1000)
- IDT = IDT/1000
- IPREC = IPREC - 100
-*
- ND2 = NDO + 2
- CALL CDBANK (IDISCD, LAUXCL(IADS), LAUXCL(IADS), JBIAS, 'AUX3', 0,
- + 0, ND2, 2, 0, IRC)
- IF (IRC.NE.0) GO TO 999
-*
- LAUX3 = LAUXCL(IADS)
- LAU33 = LAUX3 + 3
- CALL CDUPCK (IQ(KOFUCD+LREFCD(7)+4), NDI, NDO, NAU, LBITL,
- + IQ(KOFUCD+LAU33))
-*
- LAU32 = KOFUCD + LAUX3 + 2
- IF (IVM.GT.0) THEN
- DO 10 I = 1, NDO
- IQ(LAU32+I) = IQ(LAU32+I) - IVM
- 10 CONTINUE
- ENDIF
-*
-* *** Precision
-*
- IF (IPREC.LT.-99.OR.IPREC.GT.99) THEN
- IRC = 81
- IQUEST(11) = IPREC
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDUCMP : Precisi'//
- + 'on is not correctly given -'',I8,'' no uncompression'')',
- + IQUEST(11), 1)
-#endif
- GO TO 999
- ENDIF
- IPR1 = 0
- IPR2 = 0
- IF (IPREC.GT.0) IPR2 = IPREC
- IF (IPREC.LT.0) IPR1 = -IPREC
-*
- IF (IDT.EQ.3) THEN
- CALL VFLOAT (IQ(KOFUCD+LAU33), Q(KOFUCD+LAU33), NDO)
- IF (IPR1.GT.0) THEN
- XMULT = 10.**IPR1
- CALL VSCALE (Q(KOFUCD+LAU33), XMULT, Q(KOFUCD+LAU33), NDO)
- ELSE IF (IPR2.GT.0) THEN
- XMULT = 1./10.**IPR2
- CALL VSCALE (Q(KOFUCD+LAU33), XMULT, Q(KOFUCD+LAU33), NDO)
- ENDIF
-*
- CALL CDBANK (IDISCD, LAUXCL(IADS-1), LAUXCL(IADS-1), JBIAS,
- + 'AUX4', 0, 0, ND2, 3, 0, IRC)
- IF (IRC.NE.0) GO TO 999
- LAUX3 = LAUXCL(IADS)
- LAU33 = LAUX3 + 3
- LAUX4 = LAUXCL(IADS-1)
- Q(KOFUCD+LAUX4+2) = IPREC
- CALL UCOPY (Q(KOFUCD+LAU33), Q(KOFUCD+LAUX4+3), NDO)
- CALL MZDROP (IDISCD, LAUX3, ' ')
- ELSE IF (IDT.EQ.2 .OR. IDT.EQ.5) THEN
- IF (IPR1.GT.0) THEN
- IMULT = 10**IPR1
- DO 20 I = 1, NDO
- IQ(LAU32+I) = IQ(LAU32+I) * IMULT
- 20 CONTINUE
- ELSE IF (IPR2.GT.0) THEN
- XMULT = 1./10**IPR2
- DO 30 I = 1, NDO
- IQ(LAU32+I) = IQ(LAU32+I) * XMULT
- 30 CONTINUE
- ENDIF
-*
- CALL CDBANK (IDISCD, LAUXCL(IADS-1), LAUXCL(IADS-1), JBIAS,
- + 'AUX4', 0, 0, ND2, IDT, 0, IRC)
- IF (IRC.NE.0) GO TO 999
- LAUX3 = LAUXCL(IADS)
- LAU33 = LAUX3 + 3
- LAUX4 = LAUXCL(IADS-1)
- IQ(KOFUCD+LAUX4+2) = IPREC
- CALL UCOPY (Q(KOFUCD+LAU33), IQ(KOFUCD+LAUX4+3), NDO)
- CALL MZDROP (IDISCD, LAUX3, ' ')
- ENDIF
-* END CDUCMP
- 999 END
diff --git a/src/packlib/hepdb/cdunpack/cducmz.F b/src/packlib/hepdb/cdunpack/cducmz.F
deleted file mode 100644
index 8691a99..0000000
--- a/src/packlib/hepdb/cdunpack/cducmz.F
+++ /dev/null
@@ -1,84 +0,0 @@
-*
-* $Id: cducmz.F,v 1.1.1.1 1996/02/28 16:24:35 mclareni Exp $
-*
-* $Log: cducmz.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:35 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDUCMZ (LB, IADS, IRC)
-* =================================
-*
-************************************************************************
-* *
-* SUBR. CDUCMZ (LB, IADS*, IRC*) *
-* *
-* Uncompresses data bank defined by LB in the Data Base *
-* *
-* Arguments : *
-* *
-* LB Address of the bank to be uncompressed *
-* IADS Address of the uncompressed bank as LAUXCL(IADS) *
-* IRC Return code (see below) *
-* *
-* Called by CDUNCP *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* = 82 : Illegal Data Type *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
-#include "hepdb/clinks.inc"
-#include "hepdb/czpack.inc"
- PARAMETER (JBIAS = 2)
- DIMENSION LB(9)
-*
-* ------------------------------------------------------------------
-*
- LREFCD(7) = LB(1)
- IDTYP = ICDTYP (LREFCD(7))
-*
- IF (IDTYP.EQ.3) THEN
- NDI = IQ(KOFUCD+LREFCD(7)-1) - 3
- NDO = Q(KOFUCD+LREFCD(7)+1)
- PRECCZ = Q(KOFUCD+LREFCD(7)+2)
- ND2 = NDO + 2
- CALL CDBANK (IDISCD, LAUXCL(IADS), LAUXCL(IADS), JBIAS, 'AUX3',
- + 0, 0, ND2, IDTYP, 0, IRC)
- IF (IRC.NE.0) GO TO 999
- LAUX3 = LAUXCL(IADS)
- LAU33 = LAUX3 + 3
- IF (NDI.LE.0) THEN
- CALL VZERO (Q(KOFUCD+LAU33), NDO)
- ELSE
- CALL CDUPFZ (Q(KOFUCD+LREFCD(7)+4), NDI, Q(KOFUCD+LAU33), NDO)
- ENDIF
- ELSE IF (IDTYP.EQ.2.OR.IDTYP.EQ.5) THEN
- NDI = IQ(KOFUCD+LREFCD(7)-1) - 3
- NDO = IQ(KOFUCD+LREFCD(7)+1)
- PRECCZ = IQ(KOFUCD+LREFCD(7)+2)
- ND2 = NDO + 2
- CALL CDBANK (IDISCD, LAUXCL(IADS), LAUXCL(IADS), JBIAS, 'AUX3',
- + 0, 0, ND2, IDTYP, 0, IRC)
- IF (IRC.NE.0) GO TO 999
- LAUX3 = LAUXCL(IADS)
- LAU33 = LAUX3 + 3
- IF (NDI.LE.0) THEN
- CALL VZERO (IQ(KOFUCD+LAU33), NDO)
- ELSE
- CALL CDUPIZ (IQ(KOFUCD+LREFCD(7)+4),NDI, IQ(KOFUCD+LAU33),NDO)
- ENDIF
- ELSE
- IRC = 82
- IQUEST(11) = IDTYP
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDUCMZ : Data-ty'//
- + 'pe '',I4,'' illegal for uncompression'')', IQUEST(11), 1)
-#endif
- ENDIF
-* END CDUCMZ
- 999 END
diff --git a/src/packlib/hepdb/cdunpack/cduncp.F b/src/packlib/hepdb/cdunpack/cduncp.F
deleted file mode 100644
index 89002b1..0000000
--- a/src/packlib/hepdb/cdunpack/cduncp.F
+++ /dev/null
@@ -1,206 +0,0 @@
-*
-* $Id: cduncp.F,v 1.1.1.1 1996/02/28 16:24:36 mclareni Exp $
-*
-* $Log: cduncp.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:36 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
-#if defined(CERNLIB__P3CHILD)
-* Ignoring t=dummy
-#endif
- SUBROUTINE CDUNCP (LC, LU, IK, IRC)
-* ===================================
-*
-************************************************************************
-* *
-* SUBR. CDUNCP (LC, LU*, IK, IRC*) *
-* *
-* Uncompresses data bank defined by LC in the Data Base *
-* *
-* Arguments : *
-* *
-* LC Address of the bank to be uncompressed *
-* LU Address of the uncompressed bank *
-* IK If nonzero the Key 1 of the master bank with reference *
-* to which the bank is to be updated *
-* IRC Return code (see below) *
-* *
-* Called by CDCOMP, CDKXIN *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* = 83 : Data update but uncompreseed *
-* = 84 : The update structure has different number of *
-* data words *
-* = 85 : No data in the structure *
-* = 86 : The update structure has different data type *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
-#include "hepdb/ckkeys.inc"
-#include "hepdb/clinks.inc"
-#include "hepdb/czpack.inc"
-#if defined(CERNLIB__P3CHILD)
-#include "hepdb/p3dbl3.inc"
-#endif
- PARAMETER (JBIAS = 2)
- DIMENSION LC(9), LU(9), KEY(MXDMCK)
-#include "zebra/q_jbit.inc"
-* Ignoring t=pass
-*
-* ------------------------------------------------------------------
-*
- LREFCD(5) = LC(1)
- ITU = ICDTYP (LREFCD(5))
-#if defined(CERNLIB__P3CHILD)
-*
-* *** Compression parameters are put by RZIN in IQUEST(96 .. 100)
-*
- IF (ITU.EQ.5) THEN
- CALL UCOPY (IQUEST(96), IQ(KOFUCD+LREFCD(5)+1), 2)
- ENDIF
-#endif
-*
-* *** Data uncompressed ?
-*
- NWKEY = MIN (NWKYCK, NSYSCK)
- IF (IQ(KOFUCD+LREFCD(5)+1).EQ.0) THEN
- IF (IK.NE.0) THEN
- IRC = 83
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDUNCP : Incom'//
- + 'patibility - Data is an update but uncompressed'')',IRC,0)
-#endif
- GO TO 999
- ENDIF
- NDU = IQ(KOFUCD+LREFCD(5)-1)
- CALL CDBANK (IDISCD, LU(1), LU(1), JBIAS, 'SAME', 0, 0, NDU,
- + ITU, 0, IRC)
- IF (IRC.NE.0) GO TO 999
- IF (ITU.EQ.3) THEN
- CALL UCOPY (Q(KOFUCD+LREFCD(5)+1), Q(KOFUCD+LU(1)+1), NDU)
- ELSE
- CALL UCOPY (IQ(KOFUCD+LREFCD(5)+1), IQ(KOFUCD+LU(1)+1), NDU)
- ENDIF
- GO TO 999
- ENDIF
-*
-* *** Uncompress data
-* *** Which packing mode ?
-*
- CALL UCOPY (Q(KOFUCD+LREFCD(5)+3), IXX, 1)
-#if defined(CERNLIB__P3CHILD)
- IF (ITU.EQ.5) IXX = IQUEST(98)
-#endif
- PACKCZ = (JBIT (IXX, 32)) .EQ. 0
-*
- IADS = 5
-*
- IF (PACKCZ) THEN
- CALL CDUCMZ (LREFCD(5), IADS, IRC)
- LU(1) = LAUXCL(IADS)
- ELSE
-#if defined(CERNLIB__P3CHILD)
- CALL UCOPY (IQUEST(96), IQ(KOFUCD+LC(1)+1), 3)
-#endif
- CALL CDUCMP (LREFCD(5), IADS, IRC)
- LU(1) = LAUXCL(IADS-1)
- ENDIF
- IF (IRC.NE.0) GO TO 999
-*
- IF (IK.EQ.0) GO TO 999
- IF (NKEYCK.EQ.0) GO TO 999
-*
- CALL MZDROP (IDISCD, LREFCD(5), ' ')
-*
- LREFCD(5) = 0
- LREFCD(6) = LU(1)
- LC(1) = 0
- CALL CDRZIN (IDISCD, LREFCD(5), JBIAS, IK, ICYCL, ' ', IRC)
- IF (IRC.NE.0) GO TO 999
- LC(1) = LREFCD(5)
-#if defined(CERNLIB__P3CHILD)
-*
-* *** Compression parameters are put by RZIN in IQUEST(96 .. 100)
-*
- ITU = ICDTYP (LREFCD(5))
- IF (ITU.EQ.5) THEN
- CALL UCOPY (IQUEST(96), IQ(KOFUCD+LREFCD(5)+1), 2)
- ENDIF
- IF (IPASP3.GT.1) GO TO 10
-#endif
- CALL CDKEYR (IK, NWKEY, KEY)
- 10 LCC = LREFCD(5)
-*
-* *** Uncompress master ?
-*
- IF (IQ(KOFUCD+LREFCD(5)+1).NE.0) THEN
- IADS = 5
- IF (PACKCZ) THEN
- CALL CDUCMZ (LREFCD(5), IADS, IRC)
- LCC = LAUXCL(IADS)
- ELSE
-#if defined(CERNLIB__P3CHILD)
- CALL UCOPY (IQUEST(96), IQ(KOFUCD+LC(1)+1), 3)
-#endif
- CALL CDUCMP (LREFCD(5), IADS, IRC)
- LCC = LAUXCL(IADS-1)
- ENDIF
- ENDIF
- IF (IRC.NE.0) GO TO 999
-*
-* *** Update
-* *** Look if the data are similar - STOP if they are not
-*
- ND1 = IQ(KOFUCD+LREFCD(6) - 1)
- ND2 = IQ(KOFUCD+LCC - 1)
- IF (ND1.NE.ND2) THEN
- IRC = 84
- IQUEST(11) = ND1
- IQUEST(12) = ND2
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDUNCP : The 2 '//
- + 'structures have different number of data = '',2I4)',
- + IQUEST(11), 2)
-#endif
- GO TO 999
- ENDIF
- IF (ND1.EQ.0) THEN
- IRC = 85
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDUNCP : The dat'//
- + 'a structure does not have data'')', IARGCD, 0)
-#endif
- GO TO 999
- ENDIF
-*
- IT1 = ICDTYP (LREFCD(6))
- IT2 = ICDTYP (LCC)
- IF (IT1.NE.IT2) THEN
- IRC = 86
- IQUEST(11) = IT1
- IQUEST(12) = IT2
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDUNCP : The 2 '//
- + 'Structures have different data type '',2I4)', IQUEST(11), 2)
-#endif
- GO TO 999
- ENDIF
- IF (IT1.EQ.2.OR.IT1.EQ.5) THEN
- DO 20 ID = 3, ND1
- IQ(KOFUCD+LREFCD(6)+ID) = IQ(KOFUCD+LCC+ID)
- + - IQ(KOFUCD+LREFCD(6)+ID)
- 20 CONTINUE
- ELSE
- DO 30 ID = 3, ND1
- Q(KOFUCD+LREFCD(6)+ID) = Q(KOFUCD+LCC+ID)
- + - Q(KOFUCD+LREFCD(6)+ID)
- 30 CONTINUE
- ENDIF
- 40 IF (LREFCD(5).NE.LCC) CALL MZDROP (IDISCD, LCC, ' ')
-* END CDUNCP
- 999 END
diff --git a/src/packlib/hepdb/cdunpack/cdupck.F b/src/packlib/hepdb/cdunpack/cdupck.F
deleted file mode 100644
index b042545..0000000
--- a/src/packlib/hepdb/cdunpack/cdupck.F
+++ /dev/null
@@ -1,75 +0,0 @@
-*
-* $Id: cdupck.F,v 1.1.1.1 1996/02/28 16:24:36 mclareni Exp $
-*
-* $Log: cdupck.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:36 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDUPCK (IAIN, LIN, LOU, LAUX, LBITL, IAOU)
-* =====================================================
-*
-************************************************************************
-* *
-* SUBR. CDUPCK (IAIN, LIN, LOU*, LAUX, LBITL, IAOU*) *
-* *
-* Uncompresses data from LBITL to 32 bit size *
-* *
-* Arguments : *
-* *
-* IAIN Input array *
-* LIN Length of the input array *
-* LOU Length of the output array *
-* LAUX Number of words exceeding the length LBITL and therefore*
-* are stored in 32 bits with locations given *
-* LBITL Number of bits to be used for storing *
-* IAOU Output array *
-* *
-* Called by CDUCMP *
-* *
-************************************************************************
-*
- DIMENSION IAIN(LIN), IAOU(LIN)
- LOGICAL AUXI, AUXIL
-#include "zebra/q_jbit.inc"
-* Ignoring t=pass
-#include "zebra/q_sbyt.inc"
-* Ignoring t=pass
-*
-* ------------------------------------------------------------------
-*
- CALL VZERO (IAOU, LOU)
-*
- AUXI = LAUX.GT.0
-*
- LAUX = LIN - LAUX + 1
- IN = 1
- IB = 1
- IO = 1
- 10 CONTINUE
- AUXIL = (AUXI.AND.(IAIN(LAUX).EQ.IO))
- IF (AUXIL) THEN
- LAUX = LAUX + 1
- IAOU(IO) = IAIN(LAUX)
- LAUX = LAUX + 1
- ENDIF
- AUXIL = .NOT.AUXIL
- IBA = IB + LBITL
- IF (IBA.LE.32) THEN
- IF (AUXIL.AND.LBITL.GT.0) IAOU(IO) = JBYT (IAIN(IN), IB, LBITL)
- IB = IBA
- ELSE
- LBIT1 = 32 - IB + 1
- IF (AUXIL.AND.LBIT1.GT.0) IAOU(IO) = JBYT (IAIN(IN), IB, LBIT1)
- IB = IBA - 32
- IN = IN + 1
- IF (AUXIL.AND.IB.GT.1)
- + IAOU(IO) = MSBYT (IAIN(IN), IAOU(IO), LBIT1+1, IB-1)
- ENDIF
- IF (IO.LT.LOU) THEN
- IO = IO + 1
- GO TO 10
- ENDIF
-* END CDUPCK
- END
diff --git a/src/packlib/hepdb/cdunpack/cdupfz.F b/src/packlib/hepdb/cdunpack/cdupfz.F
deleted file mode 100644
index a17b24e..0000000
--- a/src/packlib/hepdb/cdunpack/cdupfz.F
+++ /dev/null
@@ -1,44 +0,0 @@
-*
-* $Id: cdupfz.F,v 1.1.1.1 1996/02/28 16:24:36 mclareni Exp $
-*
-* $Log: cdupfz.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:36 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDUPFZ (AI, NDI, AO, NDO)
-* ====================================
-*
-************************************************************************
-* *
-* SUBR. CDUPFZ (AI, NDI, AO*, NDO) *
-* *
-* Unompress floating point data when only nonzero elements are *
-* stored *
-* *
-* Arguments : *
-* *
-* AI Input array to be uncompressed *
-* NDI Number of elements in AI *
-* AO Output array of the uncompressed elements *
-* NDO Number of elements in AO *
-* *
-* Called by CDUCMZ *
-* *
-************************************************************************
-*
- DIMENSION AI(NDO), AO(NDO)
-*
-* ------------------------------------------------------------------
-*
- CALL VZERO (AO(1), NDO)
-*
- DO 10 I = 1, NDI
- I2 = 2*I
- I1 = I2 - 1
- J = AI(I1)
- AO(J) = AI(I2)
- 10 CONTINUE
-* END CDUPFZ
- END
diff --git a/src/packlib/hepdb/cdunpack/cdupiz.F b/src/packlib/hepdb/cdunpack/cdupiz.F
deleted file mode 100644
index 5969cca..0000000
--- a/src/packlib/hepdb/cdunpack/cdupiz.F
+++ /dev/null
@@ -1,43 +0,0 @@
-*
-* $Id: cdupiz.F,v 1.1.1.1 1996/02/28 16:24:36 mclareni Exp $
-*
-* $Log: cdupiz.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:36 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDUPIZ (IAI, NDI, IAO, NDO)
-* ======================================
-*
-************************************************************************
-* *
-* SUBR. CDUPIZ (IAI, NDI, IAO*, NDO) *
-* *
-* Uncompress integer data when only nonzero elements are stored *
-* *
-* Arguments : *
-* *
-* IAI Input array to be uncompressed *
-* NDI Number of elements in IAI *
-* IAO Output array of the uncompressed elements *
-* NDO Number of elements in IAO *
-* *
-* Called by CDUCMZ *
-* *
-************************************************************************
-*
- DIMENSION IAI(NDO), IAO(NDO)
-*
-* ------------------------------------------------------------------
-*
- CALL VZERO (IAO(1), NDO)
-*
- DO 10 I = 1, NDI
- I2 = 2*I
- I1 = I2 - 1
- J = IAI(I1)
- IAO(J) = IAI(I2)
- 10 CONTINUE
-* END CDUPIZ
- END
diff --git a/src/packlib/hepdb/cdutil/Imakefile b/src/packlib/hepdb/cdutil/Imakefile
deleted file mode 100644
index 332544b..0000000
--- a/src/packlib/hepdb/cdutil/Imakefile
+++ /dev/null
@@ -1,29 +0,0 @@
-SRCS_F= cdacl.F cdaclc.F cdalarm.F cdbfor.F cdcdir.F cdchar.F \ @@\
- cdcoun.F cddtrn.F cdend.F cdfixf.F cdflun.F cdglun.F \ @@\
- cdhost.F cdinct.F cdinfo.F cdinic.F cdlast.F cdldir.F \ @@\
- cdlist.F cdlkey.F cdlls.F cdlmod.F cdlogl.F cdls.F cdlupp.F \ @@\
- cdlupu.F cdmovf.F cdmtch.F cdnwrd.F cdobjx.F cdopnf.F cdoptc.F \ @@\
- cdpaff.F cdpktm.F cdpkts.F cdpref.F cdrand.F cdscan.F \ @@\
- cdselp.F cdsetu.F cdshow.F cdstat.F cdsumy.F cdtext.F cdtrek.F \ @@\
- cduniq.F cduptm.F cdupts.F cdvalid.F cdvect.F \ @@\
- cdword.F cdzoo1.F
-
-#if defined(CERNLIB_UNIX)
-SRCS_F := $(SRCS_F) cdgetp.F
-#else
-SRCS_F := $(SRCS_F) cduser.F
-#endif
-
-#if defined(CERNLIB_VAXVMS)
-SRCS_F := $(SRCS_F) cdgtlg.F
-#endif
-
-#if defined(CERNLIB_OLD)
-SRCS_F := $(SRCS_F) cdsave.F
-#endif
-
-#if defined(CERNLIB_HPUX)
-SpecialFortranLibObjectRule(cdopnf,cdopnf,'-WF,-P',NullParameter)
-#endif
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/hepdb/cdutil/cdacl.F b/src/packlib/hepdb/cdutil/cdacl.F
deleted file mode 100644
index e31b839..0000000
--- a/src/packlib/hepdb/cdutil/cdacl.F
+++ /dev/null
@@ -1,189 +0,0 @@
-*
-* $Id: cdacl.F,v 1.1.1.1 1996/02/28 16:24:44 mclareni Exp $
-*
-* $Log: cdacl.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:44 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDACL(LUNACL,CHPREF,IOPTRR,IOPTWW,CHOPT,IRC)
-* =======================================================
-*
-************************************************************************
-* *
-* SUBR. CDACL (LUNACL, CHPREF, IOPTRR*, IOPTWW*, CHOPT, IRC*) *
-* *
-* Check if user has read or write access to database *
-* *
-* Arguments : *
-* *
-* LUNACL Unit on which names file is to be read *
-* CHPREF Two character database prefix *
-* IOPTRR 0 if no read access *
-* IOPTWW 0 if no write access *
-* CHOPT Options *
-* IRC Return Code (See below) *
-* *
-* Called by CDOPEN *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* = ? : Other errors as for NAMEFD *
-* *
-* :nick.ch *
-* :file./hepdb/cdchorus/chorus.dbs *
-* :desc.CHORUS (geometry) database *
-* :servers.cernvm vxcrna xantia *
-* :read.* *
-* :write.brunner meinhard *
-* *
-************************************************************************
-*
- CHARACTER*(*) CHPREF
- CHARACTER*2 PREFIX
- CHARACTER*80 CHLINE
- CHARACTER*12 CHUSER
- CHARACTER*255 CHFILE,CHDIR
- CHARACTER*20 CHIN(2,1)
- CHARACTER*255 CHOUT(2,1)
- INTEGER LUNACL,IRC
-#if defined(CERNLIB_IBMVM)
- CHARACTER*1 CDMODE
-#endif
-#include "hepdb/cduscm.inc"
-#include "hepdb/slate.inc"
-#include "hepdb/hdbopts.inc"
-
- IRC = 0
-
- IOPTRR = 0
- IOPTWW = 0
-*
-* Get username
-*
- CHUSER = ' '
- CALL CDUSER(CHUSER,IRC)
- IF(IRC.NE.0) GOTO 999
-
- IF(LEN(CHPREF).NE.2) THEN
- IF(IDEBCD.GE.0) WRITE(LPRTCD,9001) CHPREF
- 9001 FORMAT(' CDACL. illegal database prefix ',A)
- IRC = 301
- GOTO 999
- ENDIF
-
- PREFIX = CHPREF
- CALL CLTOU(PREFIX)
-*
-* Find the location of the names file and process
-*
- CALL GETENVF('CDSERV',CHDIR)
- LDIR = IS(1)
- IF(LDIR.EQ.0) THEN
- IF(IDEBCD.GE.0) WRITE(LPRTCD,9002)
- 9002 FORMAT(' CDACL. variable CDSERV not defined')
- IRC = 311
- GOTO 999
- ENDIF
-#if defined(CERNLIB_IBMVM)
-*
-* Link to server disk
-*
- LDOT = INDEX(CHDIR(1:LDIR),'.')
- IF(LDOT.NE.0) CHDIR(LDOT:LDOT) = ' '
-*
-* Translate <> & [] characters
-*
- IBRA = INDEX(CHDIR(1:LDIR),'<')
- IF(IBRA.NE.0) CHDIR(IBRA:IBRA) = ' '
- IBRA = INDEX(CHDIR(1:LDIR),'>')
- IF(IBRA.NE.0) CHDIR(IBRA:IBRA) = ' '
- IBRA = INDEX(CHDIR(1:LDIR),'[')
- IF(IBRA.NE.0) CHDIR(IBRA:IBRA) = ' '
- IBRA = INDEX(CHDIR(1:LDIR),']')
- IF(IBRA.NE.0) CHDIR(IBRA:IBRA) = ' '
-*
-* Remove leading and trailing blanks
-*
- JX = ICFNBL(CHDIR,1,LDIR)
- CHFILE = CHDIR(JX:LDIR)
- LDIR = LENOCC(CHFILE)
- CHDIR = CHFILE(1:LDIR)
- CALL VMCMS('EXEC GIME '//CHDIR(1:LDIR) //' (QUIET NONOTICE '
- +//'STACK)',ICODE)
- IF(ICODE.GT.4) THEN
- IF(IDEBCD.GE.0) WRITE(LPRTCD,9003) ICODE,CHDIR(1:LDIR)
- 9003 FORMAT(' CDACL. return code ',I10,' from EXEC GIME ',A)
- GOTO 999
- ENDIF
- CALL VMRTRM(CHLINE,LLINE)
- CDMODE = CHLINE(1:1)
- CHFILE = 'HEPDB NAMES '//CDMODE
- LFILE = 14
-#endif
-#if defined(CERNLIB_WINNT)
- CHFILE = CHDIR(1:LDIR) // '\\hepdb.names'
- LFILE = LDIR + 12
- CALL CUTOL(CHFILE(1:LFILE))
-#endif
-#if defined(CERNLIB_MSDOS)
- CHFILE = CHDIR(1:LDIR) // '\\hepdb.nam'
- LFILE = LDIR + 10
- CALL CUTOL(CHFILE(1:LFILE))
-#endif
-#if (defined(CERNLIB_UNIX))&&(!defined(CERNLIB_WINNT))&&(!defined(CERNLIB_MSDOS))
- CHFILE = CHDIR(1:LDIR) // '/hepdb.names'
- LFILE = LDIR + 12
- CALL CUTOL(CHFILE(1:LFILE))
-#endif
-#if defined(CERNLIB_VAXVMS)
- CHFILE = CHDIR(1:LDIR) // 'hepdb.names'
- LFILE = LDIR + 11
-#endif
-*
-* Check the :read tag
-*
- NIN = 1
- NOUT = 1
- CHIN(1,1) = ':nick'
- CHIN(2,1) = PREFIX
-
- CHOUT(1,1) = ':read'
- CHOUT(2,1) = ' '
-
- CALL NAMEFD(LUNACL,CHFILE(1:LFILE),CHIN,NIN,CHOUT,NOUT,IRC)
- IF(IRC.EQ.0) THEN
- CALL CDACLC(CHUSER,CHOUT(2,1),IOPTRR)
- ELSEIF(IRC.EQ.4) THEN
- IOPTRR = 1
- IRC = 0
- ELSE
- IF(IDEBCD.GE.0)
- + WRITE(LPRTCD,9004) IRC,CHFILE(1:LFILE),CHPREF
- 9004 FORMAT(' CDCONF. error ',I10,' processing names file ',A,
- + ' for entry ',A)
- GOTO 999
- ENDIF
-*
-* Check the :write tag
-*
- CHOUT(1,1) = ':write'
- CHOUT(2,1) = ' '
-
- CALL NAMEFD(LUNACL,CHFILE(1:LFILE),CHIN,NIN,CHOUT,NOUT,IRC)
- IF(IRC.EQ.0) THEN
- CALL CDACLC(CHUSER,CHOUT(2,1),IOPTWW)
- ELSEIF(IRC.EQ.4) THEN
- IOPTWW = 1
- IRC = 0
- ELSE
- IF(IDEBCD.GE.0)
- + WRITE(LPRTCD,9004) IRC,CHFILE(1:LFILE),CHPREF
- GOTO 999
- ENDIF
-
- IF(IOPTWW.NE.0) IOPTRR = 1
-
- 999 END
diff --git a/src/packlib/hepdb/cdutil/cdaclc.F b/src/packlib/hepdb/cdutil/cdaclc.F
deleted file mode 100644
index 9cde354..0000000
--- a/src/packlib/hepdb/cdutil/cdaclc.F
+++ /dev/null
@@ -1,51 +0,0 @@
-*
-* $Id: cdaclc.F,v 1.1.1.1 1996/02/28 16:24:45 mclareni Exp $
-*
-* $Log: cdaclc.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:45 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDACLC(CHUSER,CHLIST,IRC)
-
- CHARACTER*(*) CHUSER,CHLIST
- CHARACTER*255 USER,LIST,TEMP
-
- IRC = 0
-*
-* Wild-card: anything goes
-*
- IF(CHLIST.EQ.'*') GOTO 10
-*
-* No list: access denied
-*
- LLIST = LENOCC(CHLIST)
- IF(LLIST.EQ.0) GOTO 20
-
- LIST = CHLIST(1:LLIST)
- CALL CLTOU(LIST(1:LLIST))
-
- LUSER = LENOCC(CHUSER)
-
- USER = CHUSER(1:LUSER)
- CALL CLTOU(USER(1:LUSER))
-*
-* Single user
-*
- LBLNK = INDEX(LIST(1:LLIST),' ')
- IF(LBLNK.EQ.0.AND.USER(1:LUSER).NE.LIST(1:LLIST)) GOTO 20
-*
-* General case
-*
- CALL CDNWRD(' ',LIST(1:LLIST),NWORDS)
-
- DO 30 N=0,NWORDS-1
- CALL CDWORD(TEMP,N,' ',LIST(1:LLIST),IRC)
- IF(TEMP(1:LENOCC(TEMP)).EQ.USER(1:LUSER)) GOTO 10
-30 CONTINUE
- GOTO 20
-
-10 IRC = 1
-
-20 END
diff --git a/src/packlib/hepdb/cdutil/cdalarm.F b/src/packlib/hepdb/cdutil/cdalarm.F
deleted file mode 100644
index bd80e86..0000000
--- a/src/packlib/hepdb/cdutil/cdalarm.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: cdalarm.F,v 1.1.1.1 1996/02/28 16:24:45 mclareni Exp $
-*
-* $Log: cdalarm.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:45 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDALARM(IPID,IRC)
-
-#if defined(CERNLIB_UNIX)
- INTEGER KILLF
-*
-* Send NOHUP signal to server process
-*
-
- IRC = KILLF(IPID,1)
-#endif
-
- END
diff --git a/src/packlib/hepdb/cdutil/cdbfor.F b/src/packlib/hepdb/cdutil/cdbfor.F
deleted file mode 100644
index 9e7e98f..0000000
--- a/src/packlib/hepdb/cdutil/cdbfor.F
+++ /dev/null
@@ -1,69 +0,0 @@
-*
-* $Id: cdbfor.F,v 1.1.1.1 1996/02/28 16:24:41 mclareni Exp $
-*
-* $Log: cdbfor.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:41 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDBFOR (TOPN, IDATE, ITIME, IRC)
-* ===========================================
-*
-************************************************************************
-* *
-* SUBR. CDBFOR (TOPN, IDATE, ITIME, IRC*) *
-* *
-* Set the maximum insertion time for retrieval of all subsequent *
-* data objects for a given top directory *
-* *
-* Arguments : *
-* *
-* TOPN Name of the top directory ('*' means all) *
-* IDATE Date : 6 Decimal integer : YYMMDD *
-* ITIME Time : 4 Decimal integer : HHMM *
-* IRC Return code (see below) *
-* *
-* Called by user *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
-#include "hepdb/cinitl.inc"
- CHARACTER TOPN*(*), TOP*16
-*
-* ------------------------------------------------------------------
-*
- IRC = 0
- CALL CDPKTM (IDATE, ITIME, KY7M, IRC)
- CALL CDSBLC (TOPN, TOPNCI, NCHR)
-*
-* *** Insert the KY7M value for the appropriate
-*
- LFIXCD = LTOPCD
- 10 IF (LFIXCD.GT.0) THEN
- NCH = IQ(KOFUCD+LFIXCD+MUPNCH)
- IF (NCH.EQ.NCHR) THEN
- CALL UHTOC (IQ(KOFUCD+LFIXCD+MUPNAM), 4, TOP, NCH)
- IF (TOPNCI.EQ.'*'.OR.TOP(1:NCH).EQ.TOPNCI) THEN
- IQ(KOFUCD+LFIXCD+MUPKY7) = KY7M
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) THEN
- IARGCD(1) = IDATE
- IARGCD(2) = ITIME
- CALL CDPRNT (LPRTCD, '(/,'' CDBFOR : All subsequent ret'//
- + 'rievals of data objects for '//TOP(1:NCH)//' will'//
- + ' test on insertion time before '',2I7)', IARGCD, 2)
- ENDIF
-#endif
- ENDIF
- LFIXCD = LQ(KOFUCD+LFIXCD)
- GO TO 10
- ENDIF
- ENDIF
-* END CDBFOR
- END
diff --git a/src/packlib/hepdb/cdutil/cdcdir.F b/src/packlib/hepdb/cdutil/cdcdir.F
deleted file mode 100644
index 297447b..0000000
--- a/src/packlib/hepdb/cdutil/cdcdir.F
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: cdcdir.F,v 1.1.1.1 1996/02/28 16:24:43 mclareni Exp $
-*
-* $Log: cdcdir.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:43 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDCDIR(CHPATH,CHOPT,IRC)
- CHARACTER*(*) CHPATH,CHOPT
-#include "hepdb/cdcblk.inc"
-#include "hepdb/cdkeys.inc"
-#include "hepdb/ckkeys.inc"
- DATA NENTRY/0/
- SAVE NENTRY
-
- IF(NENTRY.EQ.0) THEN
- NSYSCD = NOFSCK
- NEXPCD = NOFECK
- NPAICD = NPARCD
- NENTRY = 1
- ENDIF
-
- CALL RZCDIR(CHPATH,CHOPT)
- IRC = IQUEST(1)
- IF(IRC.EQ.0) THEN
- NUSRCD = IQUEST(7) - NSYSCD - NEXPCD - NPAICD * 2
- ELSE
- NUSRCD = 0
- ENDIF
-
- END
diff --git a/src/packlib/hepdb/cdutil/cdchar.F b/src/packlib/hepdb/cdutil/cdchar.F
deleted file mode 100644
index deae58b..0000000
--- a/src/packlib/hepdb/cdutil/cdchar.F
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: cdchar.F,v 1.1.1.1 1996/02/28 16:24:41 mclareni Exp $
-*
-* $Log: cdchar.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:41 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDCHAR(CHTEXT,NTEXT,LTEXT,CHPATH,LBANK,CHOPT,IRC)
-
- CHARACTER*(*) CHPATH
- CHARACTER*(*) CHTEXT(NTEXT)
-
-#include "hepdb/cduscm.inc"
-#include "hepdb/quest.inc"
-#include "hepdb/hdbopts.inc"
-
- IRC = 0
-*
-* Read text file
-*
- IF(IOPTR.NE.0) THEN
- CALL CDCTOI(CHTEXT,NTEXT,LTEXT,LBANK,IRC)
-*
-* Write text file
-*
- ELSEIF(IOPTW.NE.0) THEN
- CALL CDCFRI(CHTEXT,NTEXT,LTEXT,LBANK,IRC)
-*
-* Print
-*
- ELSEIF(IOPTP.NE.0) THEN
- CALL CDAFRI(LPRTCD,LBANK,'C',IRC)
-*
-* Delete
-*
- ELSEIF(IOPTD.NE.0) THEN
- ENDIF
-
- END
diff --git a/src/packlib/hepdb/cdutil/cdcoun.F b/src/packlib/hepdb/cdutil/cdcoun.F
deleted file mode 100644
index 9cf3d1b..0000000
--- a/src/packlib/hepdb/cdutil/cdcoun.F
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: cdcoun.F,v 1.1.1.1 1996/02/28 16:24:37 mclareni Exp $
-*
-* $Log: cdcoun.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:37 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDCOUN(ICOUNT)
-*
-* Count the that files are currently attached
-*
-#include "zebra/rzcl.inc"
-#include "zebra/zunit.inc"
-
- ICOUNT = 0
- IF(LQRS.EQ.0) GOTO 30
- LRZ = LQRS
- 10 IF(LRZ.EQ.0) GOTO 30
- LUNDB = IQ(KQSP+LRZ-5)
- IF(LUNDB.EQ.0) GOTO 20
- ICOUNT = ICOUNT + 1
- 20 CONTINUE
- LRZ=LQ(KQSP+LRZ)
- GO TO 10
- 30 CONTINUE
-
- END
diff --git a/src/packlib/hepdb/cdutil/cddtrn.F b/src/packlib/hepdb/cdutil/cddtrn.F
deleted file mode 100644
index e15f8bb..0000000
--- a/src/packlib/hepdb/cdutil/cddtrn.F
+++ /dev/null
@@ -1,58 +0,0 @@
-*
-* $Id: cddtrn.F,v 1.1.1.1 1996/02/28 16:24:43 mclareni Exp $
-*
-* $Log: cddtrn.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:43 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDDTRN(CHRAN,IDATE,ITIME,JDATE,JTIME,IC)
-* Convert character date & time range into integer format
-* yymmdd = yymmdd until now
-* -yymmdd = beginning of time until yymmdd
-* .hhmm = hhmm on first day of Universe/today depending on position
-*
- CHARACTER*(*) CHRAN
-
- IC = 0
- IDATE = 0
- ITIME = 0
- CALL DATIME(JDATE,JTIME)
-
- LCHRAN = LENOCC(CHRAN)
-
- IF(LCHRAN.EQ.0) THEN
- IC = -1
- RETURN
- ENDIF
-*
-* Start date and time?
-*
- IMINUS = INDEX(CHRAN(1:LCHRAN),'-')
-
- IF(IMINUS.EQ.1) GOTO 10
-
- IF(IMINUS.EQ.0) THEN
- IDOT = INDEX(CHRAN(1:LCHRAN),'.')
- ELSE
- IDOT = INDEX(CHRAN(1:IMINUS-1),'.')
- ENDIF
-
- IDATE = ICDECI(CHRAN,1,LCHRAN)
-
- IF(IDOT.NE.0) ITIME = ICDECI(CHRAN,IDOT+1,LCHRAN)
- IF((IMINUS.EQ.0).OR.(IMINUS.EQ.LCHRAN)) RETURN
-
-10 CONTINUE
-
- ISTART = IMINUS + 1
- JDOT = INDEX(CHRAN(ISTART:LCHRAN),'.')
- IF(JDOT.NE.1) JDATE = ICDECI(CHRAN,ISTART,LCHRAN)
- IF(JDOT.NE.0) THEN
- JTIME = ICDECI(CHRAN,ISTART+JDOT,LCHRAN)
- ELSE
- JTIME = 0
- ENDIF
-
- END
diff --git a/src/packlib/hepdb/cdutil/cdend.F b/src/packlib/hepdb/cdutil/cdend.F
deleted file mode 100644
index 04bba6c..0000000
--- a/src/packlib/hepdb/cdutil/cdend.F
+++ /dev/null
@@ -1,97 +0,0 @@
-*
-* $Id: cdend.F,v 1.1.1.1 1996/02/28 16:24:41 mclareni Exp $
-*
-* $Log: cdend.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:41 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
-#if defined(CERNLIB__P3CHILD)
-* Ignoring t=dummy
-#endif
- SUBROUTINE CDEND (CHPATH, CHOPT, IRC)
-* =====================================
-*
-************************************************************************
-* *
-* SUBR. CDEND (CHPATH, CHOPT, IRC*) *
-* *
-* Terminates the Data Base utility package *
-* *
-* Arguments : *
-* *
-* CHPATH Name of the top directory *
-* CHOPT Character option *
-* A Closes all directories *
-* C Journal file is closed and deleted (default: reopen) *
-* - pending updates will be sent *
-* P Journal file is purged *
-* S Server mode - don't call CDSAVE *
-* IRC Return code (see below) *
-* *
-* Called by user *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* *
-************************************************************************
-*
- CHARACTER*(*) CHPATH
-#include "hepdb/cdcblk.inc"
-#include "hepdb/cinitl.inc"
- CHARACTER TOP*16, TOPN*16, PATH*20
-
-#include "hepdb/hdbopts.inc"
-*
-* ------------------------------------------------------------------
-*
-
- IRC = 0
- LPATH = LENOCC(CHPATH)
-* ICLOSE = 0
-* IF(IOPTA.NE.0.OR.IOPTC.NE.0) ICLOSE = -1
-
-#if (defined(CERNLIB_IBMVM)||defined(CERNLIB_UNIX)||defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))&&(!defined(CERNLIB__P3CHILD))&&(!defined(CERNLIB__ONLINE))
-*
-* Close and send journal file
-*
- IF(IOPTS.EQ.0) CALL CDSAVE (CHPATH,CHOPT,IRC)
-* CALL CDSTSV (' ', ICLOSE, IRC)
- INSRCD = 0
-#endif
-*
-* *** Call RZEND for all the files opened (option A) or just the
-* file specified
-*
- LFIXCD = LTOPCD
- 10 IF (LFIXCD.EQ.0) GO TO 20
- NCH = IQ(KOFUCD+LFIXCD+MUPNCH)
- CALL UHTOC (IQ(KOFUCD+LFIXCD+MUPNAM), 4, TOP, NCH)
- IF (IOPTA.NE.0.OR.TOP(1:NCH).EQ.CHPATH(1:LPATH)) THEN
- TOPN = TOP(1:NCH)
- PATH = '//'//TOPN
- CALL RZCDIR (PATH,' ')
- CALL RZCLOS (TOPN,' ')
- IF (LTOPCD.EQ.LFIXCD) LTOPDB = LQ(KOFUCD+LFIXCD)
-*
-* Drop also specified bank
-*
- IF (TOP(1:NCH).EQ.CHPATH(1:LPATH)) THEN
- CALL MZDROP (IDIVCD, LFIXCD, ' ')
- ENDIF
- ENDIF
- LFIXCD = LQ(KOFUCD+LFIXCD)
- GO TO 10
-*
- 20 CONTINUE
-*
-* Drop top bank if IOPTA
-*
- IF (IOPTA.GT.0.AND.LTOPCD.GT.0) THEN
- CALL MZDROP (IDIVCD, LTOPCD, 'L')
- LTOPCD = 0
- ENDIF
-* END CDEND
- 999 END
diff --git a/src/packlib/hepdb/cdutil/cdfixf.F b/src/packlib/hepdb/cdutil/cdfixf.F
deleted file mode 100644
index 567d9d7..0000000
--- a/src/packlib/hepdb/cdutil/cdfixf.F
+++ /dev/null
@@ -1,74 +0,0 @@
-*
-* $Id: cdfixf.F,v 1.1.1.1 1996/02/28 16:24:37 mclareni Exp $
-*
-* $Log: cdfixf.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:37 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDFIXF(FNAME,FULLN)
-#include "hepdb/cdunit.inc"
- CHARACTER*(*) FNAME,FULLN
- CHARACTER*255 CHPATH,FNAME2
- CHARACTER*20 PAFF
- PARAMETER (MAXLEV=20)
-*
-* Filename is in current directory, if full path name not specified
-*
- LFNAME = LENOCC(FNAME)
- FNAME2 = FNAME
-
- IF (FNAME(1:2) .NE. '//') THEN
-*
-* Add CD to start of FNAME
-*
- CALL RZCDIR(CHPATH,'R')
- LC = LENOCC(CHPATH)
- IF (LFNAME .EQ. 0) THEN
- FULLN=CHPATH(1:LC)
- RETURN
- ENDIF
-
- FULLN = CHPATH(1:LC) // '/' // FNAME2(1:LFNAME)
- ELSE
-
- FULLN = FNAME
-
- ENDIF
-*
-* Now handle '..' characters
-*
- CHPATH = FULLN
- LPATH = LENOCC(CHPATH)
- CALL CDNWRD('/',CHPATH(3:LPATH),NWORDS)
- IF(NWORDS.GT.MAXLEV) THEN
- IF(LLOGCD.GE.0) WRITE(LPRTCD,*) 'CDFIXF. error - more than ',
- + MAXLEV,' elements found in path name'
- RETURN
- ENDIF
-
- IF(LLOGCD.GE.3) WRITE(LPRTCD,*) 'CDFIXF. ',NWORDS,
- + ' words found in ',CHPATH(3:LPATH)
-
- FULLN = '/'
- LF = 1
-
- DO 10 I=1,MIN(MAXLEV,NWORDS)
- PAFF = ' '
- CALL CDWORD(PAFF,I-1,'/',CHPATH(3:LPATH),IC)
- LP = LENOCC(PAFF)
- IF(PAFF(1:LP).NE.'..') THEN
- FULLN(LF+1:LF+LP+1) = '/'//PAFF
- IF(LLOGCD.GE.3) WRITE(LPRTCD,*)
- + 'CDFIXF. word ',I,' = ',PAFF(1:LP)
- LF = LF + LP + 1
- ELSE
- IF(LLOGCD.GE.3) WRITE(LPRTCD,*) 'CDFIXF. word .. discarded'
- LF = INDEXB(FULLN,'/') - 1
- ENDIF
-10 CONTINUE
-
- FULLN(LF+1:) = ' '
-
- END
diff --git a/src/packlib/hepdb/cdutil/cdflun.F b/src/packlib/hepdb/cdutil/cdflun.F
deleted file mode 100644
index c0d7a0f..0000000
--- a/src/packlib/hepdb/cdutil/cdflun.F
+++ /dev/null
@@ -1,30 +0,0 @@
-*
-* $Id: cdflun.F,v 1.1.1.1 1996/02/28 16:24:39 mclareni Exp $
-*
-* $Log: cdflun.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:39 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDFLUN(LUN,IRC)
-*
-* Free a previously allocated FORTRAN logical unit
-*
-#include "hepdb/hdbpara.inc"
-#include "hepdb/hdblun.inc"
- IRC = 0
- DO 10 I=1,KMXLUN
- IF(MCDLUN(I).EQ.LUN) THEN
- MCDLUA(I) = -1
- GOTO 20
- ENDIF
-10 CONTINUE
- IRC = -1
-20 CONTINUE
-#if defined(CERNLIB_VAXVMS)
- IF(IRC.NE.0) THEN
- CALL LIB$FREE_LUN(LUN)
- ENDIF
-#endif
- END
diff --git a/src/packlib/hepdb/cdutil/cdgetp.F b/src/packlib/hepdb/cdutil/cdgetp.F
deleted file mode 100644
index 584b071..0000000
--- a/src/packlib/hepdb/cdutil/cdgetp.F
+++ /dev/null
@@ -1,85 +0,0 @@
-*
-* $Id: cdgetp.F,v 1.1.1.1 1996/02/28 16:24:45 mclareni Exp $
-*
-* $Log: cdgetp.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:45 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
-#if defined(CERNLIB_UNIX)
- SUBROUTINE CDGETP(LUN,IPID,IRC)
-
- CHARACTER*80 CHSERV,CHLINE,CHLOG
- CHARACTER*8 CHHOST,CHNODE
-
-#include "hepdb/slate.inc"
-
- IPID = 0
- IRC = 0
-
- CALL GETENVF('CDSERV',CHSERV)
-
- IF(IS(1).EQ.0) THEN
- IRC = -3
- GOTO 99
- ENDIF
-*
-* Names file is $CDSERV/hepdb.names
-*
- OPEN(LUN,FILE=CHSERV(1:IS(1))//'/hepdb.names',
- + STATUS='OLD',FORM='FORMATTED',ACCESS='SEQUENTIAL',
- + IOSTAT=IRC)
- IF(IRC.NE.0) GOTO 99
-*
-* Read all records until :log. found
-*
-10 CONTINUE
- READ(LUN,'(A)',END=98,ERR=98) CHLINE
- LLINE = LENOCC(CHLINE)
-
- LLOG = INDEX(CHLINE(1:LLINE),':log.')
- IF(LLOG.EQ.0) GOTO 10
-
- CLOSE(LUN)
- CHLOG = CHLINE(LLOG+5:LLINE)
- LLOG = LLINE - 4
- LBLA = INDEX(CHLOG(1:LLOG),' ')
- IF(LBLA.NE.0) LLOG = LBLA -1
-
- OPEN(LUN,FILE=CHLOG(1:LLOG)//'/hepdb.log',
- + STATUS='OLD',FORM='FORMATTED',ACCESS='SEQUENTIAL',
- + IOSTAT=IRC)
- IF(IRC.NE.0) GOTO 99
-
-20 CONTINUE
- READ(LUN,'(A)',END=98,ERR=98) CHLINE
- LLINE = LENOCC(CHLINE)
-
- LPID = INDEX(CHLINE(1:LLINE),'CDSERV. PID = ')
- IF(LPID.EQ.0) GOTO 20
-
- LNODE = INDEX(CHLINE(1:LLINE),' HOST = ')
- IF(LNODE.EQ.0) GOTO 20
-
- CHNODE = CHLINE(LNODE+8:LNODE+16)
- LBLA = INDEX(CHNODE,' ')
- IF(LBLA.NE.0) THEN
- LNODE = LBLA - 1
- ELSE
- LNODE = 8
- ENDIF
-
- CALL CDHOST(CHHOST,IRC)
- IF(IRC.NE.0) GOTO 98
-
- LHOST = LENOCC(CHHOST)
-
- IF(CHHOST(1:LHOST).NE.CHNODE(1:LNODE)) GOTO 98
-
- IPID = ICDECI(CHLINE,LPID+14,LLINE)
-
-98 CLOSE(LUN)
-
-99 END
-#endif
diff --git a/src/packlib/hepdb/cdutil/cdglun.F b/src/packlib/hepdb/cdutil/cdglun.F
deleted file mode 100644
index 60d09c5..0000000
--- a/src/packlib/hepdb/cdutil/cdglun.F
+++ /dev/null
@@ -1,37 +0,0 @@
-*
-* $Id: cdglun.F,v 1.1.1.1 1996/02/28 16:24:39 mclareni Exp $
-*
-* $Log: cdglun.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:39 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDGLUN(LUN,IRC)
-#include "hepdb/hdbpara.inc"
-#include "hepdb/hdblun.inc"
-*
-* Get a currently unused FORTRAN logical unit
-*
- LUN = 0
- IRC = 0
- DO 10 I=1,KMXLUN
- IF((MCDLUN(I).NE.-1).AND.(MCDLUA(I).EQ.-1)) THEN
- MCDLUA(I) = MCDLUN(I)
- LUN = MCDLUN(I)
- GOTO 20
- ENDIF
-10 CONTINUE
- IRC = -1
-20 CONTINUE
-#if defined(CERNLIB_VAXVMS)
- IF(LUN.EQ.0) THEN
- CALL LIB$GET_LUN(LUN)
- IF(LUN.EQ.-1) THEN
- IRC = LUN
- ELSE
- IRC = 0
- ENDIF
- ENDIF
-#endif
- END
diff --git a/src/packlib/hepdb/cdutil/cdgtlg.F b/src/packlib/hepdb/cdutil/cdgtlg.F
deleted file mode 100644
index f04cf8d..0000000
--- a/src/packlib/hepdb/cdutil/cdgtlg.F
+++ /dev/null
@@ -1,59 +0,0 @@
-*
-* $Id: cdgtlg.F,v 1.1.1.1 1996/02/28 16:24:44 mclareni Exp $
-*
-* $Log: cdgtlg.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:44 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
-#if defined(CERNLIB_VAXVMS)
- SUBROUTINE CDGTLG(LOGNAM,EQUNAM,TABNAM,IRC)
- IMPLICIT INTEGER (S)
-#include "hepdb/slate.inc"
- CHARACTER*(*) LOGNAM,EQUNAM,TABNAM
-
- STRUCTURE /ITMLST/
- UNION
- MAP
- INTEGER*2 BUFFER_LENGTH
- INTEGER*2 ITEM_CODE
- INTEGER*4 BUFFER_ADDRESS
- INTEGER*4 RETURN_LENGTH_ADDRESS
- ENDMAP
- MAP
- INTEGER*4 END_LIST /0/
- ENDMAP
- END UNION
- END STRUCTURE
-
- RECORD /ITMLST/ LNM_LIST(2)
-
- INCLUDE '($LNMDEF)'
- INCLUDE '($SSDEF)'
-*
- IRC = 0
-
- LBUF = 255
- LNM_LIST(1).BUFFER_LENGTH = LBUF
- LNM_LIST(1).ITEM_CODE = LNM$_STRING
- LNM_LIST(1).BUFFER_ADDRESS = %LOC(EQUNAM)
- LNM_LIST(1).RETURN_LENGTH_ADDRESS = %LOC(LNAM)
-
- LNM_LIST(2).END_LIST = 0
-
- LENLOG = LENOCC(LOGNAM)
- LENTAB = LENOCC(TABNAM)
-
- STATUS = SYS$TRNLNM(,TABNAM(1:LENTAB)
- + ,LOGNAM(1:LENLOG),,LNM_LIST)
- IF (.NOT. STATUS) THEN
- IRC = 1
- IS(1) = 0
- ELSE
- IS(1) = LNAM
- ENDIF
-
- END
-
-#endif
diff --git a/src/packlib/hepdb/cdutil/cdhost.F b/src/packlib/hepdb/cdutil/cdhost.F
deleted file mode 100644
index d6c7125..0000000
--- a/src/packlib/hepdb/cdutil/cdhost.F
+++ /dev/null
@@ -1,89 +0,0 @@
-*
-* $Id: cdhost.F,v 1.1.1.1 1996/02/28 16:24:43 mclareni Exp $
-*
-* $Log: cdhost.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:43 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDHOST(CHHOST,IRC)
-*
-* Return host name of current machine
-*
- CHARACTER*(*) CHHOST
-#if defined(CERNLIB_VAXVMS)||defined(CERNLIB_UNIX)
- CHARACTER*8 CHTEMP
-#include "hepdb/slate.inc"
-#endif
-#if defined(CERNLIB_IBMVM)
- CHARACTER*80 CHLINE
-
- CHHOST = '??????'
-
- CALL VMCMS('QUERY USERID (STACK LIFO',IRC)
- IF(IRC.NE.0) RETURN
- CALL VMRTRM(CHLINE,LLINE)
- ISTART = INDEXB(CHLINE(1:LLINE),' ') + 1
- CHHOST = CHLINE(ISTART:LLINE)
-
-#endif
-#if defined(CERNLIB_VAXVMS)
-
- CHARACTER*15 CHNODE
-
- INTEGER SYS$GETSYIW
-
- STRUCTURE /ITMLST/
- UNION
- MAP
- INTEGER*2 BUFFER_LENGTH
- INTEGER*2 ITEM_CODE
- INTEGER*4 BUFFER_ADDRESS
- INTEGER*4 RETURN_LENGTH_ADDRESS
- ENDMAP
- MAP
- INTEGER*4 END_LIST /0/
- ENDMAP
- END UNION
- END STRUCTURE
-
- RECORD /ITMLST/ LNM_LIST(2)
-
- INCLUDE '($SYIDEF)'
- INCLUDE '($SSDEF)'
-
- LNM_LIST(1).BUFFER_LENGTH = LEN(CHNODE)
- LNM_LIST(1).ITEM_CODE = SYI$_NODENAME
- LNM_LIST(1).BUFFER_ADDRESS = %LOC(CHNODE)
- LNM_LIST(1).RETURN_LENGTH_ADDRESS = %LOC(LNODE)
-
- LNM_LIST(2).END_LIST = 0
-
- IRC = 0
- CHHOST = '??????'
-
- ISTAT=SYS$GETSYIW(,,,LNM_LIST,,,)
- IF(ISTAT.NE.SS$_NORMAL) THEN
- IRC = 42
- RETURN
- ENDIF
-
- LHOST = MIN(LEN(CHHOST),LNODE)
-
- CHHOST = CHNODE(1:LHOST)
-
-#endif
-#if defined(CERNLIB_UNIX)
-
- CALL CDHSTC(CHHOST)
-
-#endif
-#if defined(CERNLIB_VAXVMS)||defined(CERNLIB_UNIX)
-*
-* Use value of environmental variable CDHOST if set
-*
- CALL GETENVF('CDHOST',CHTEMP)
- IF(IS(1).NE.0) CHHOST = CHTEMP(1:IS(1))
-#endif
- END
diff --git a/src/packlib/hepdb/cdutil/cdinct.F b/src/packlib/hepdb/cdutil/cdinct.F
deleted file mode 100644
index e881c41..0000000
--- a/src/packlib/hepdb/cdutil/cdinct.F
+++ /dev/null
@@ -1,131 +0,0 @@
-*
-* $Id: cdinct.F,v 1.2 1999/08/17 12:42:38 mclareni Exp $
-*
-* $Log: cdinct.F,v $
-* Revision 1.2 1999/08/17 12:42:38 mclareni
-* Y2k mods submitted by Rob Komar
-*
-* Revision 1.1.1.1 1996/02/28 16:24:40 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDINCT (IDTMI, ISADD, IDTMO, IRC)
-* ============================================
-*
-************************************************************************
-* *
-* SUBR. CDINCT (IDTMI, ISADD, IDTMO*, IRC*) *
-* *
-* Converts packed date and time (ala CDPKTS) to a similar packed *
-* number after adding a fixed time in seconds *
-* *
-* Arguments : *
-* *
-* IDTMI Packed date-time (ala CDPKTS) on input *
-* ISADD Incremental time to IDTMI in seconds *
-* IDTMO Packed date-time (ala CDPKTS) on output *
-* IRC Return Code (See below) *
-* *
-* Called by user *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* *
-************************************************************************
-*
-#include "hepdb/ctmpak.inc"
-* ------------------------------------------------------------------
-*
-* *** Get the real Year/Month/Date Hour/Minute/Second
-*
- IRC = 0
- III = IDTMI
- ISEC = MOD (III, MXSEC)
- III = (III-ISEC)/MXSEC
- IMIN = MOD (III, MXMIN)
- III = (III-IMIN)/MXMIN
- IHOU = MOD (III, MXHOU)
- III = (III-IHOU)/MXHOU
- IDAY = MOD (III, MXDAY)
- III = (III-IDAY)/MXDAY
- IMON = MOD (III, MXMON)
- IYEA = (III-IMON)/MXMON
-*
-* *** Add the second to real seconds in the day
-*
- ISECS = ISEC + 60*(IMIN + 60*IHOU)
- ISECS = ISECS + ISADD
- IF (ISECS.GE.0.AND.ISECS.LT.86400) THEN
- ISEC = MOD (ISECS, 60)
- ISECS = (ISECS-ISEC)/60
- IMIN = MOD (ISECS, 60)
- IHOU = (ISECS-IMIN)/60
- ELSE
- IF (ISECS.LT.0) THEN
- III = -ISECS
- IDADD = -(III/86400 + 1)
- ELSE
- IDADD = ISECS/86400
- ENDIF
- ISECS = ISECS - IDADD*86400
- ISEC = MOD (ISECS, 60)
- ISECS = (ISECS-ISEC)/60
- IMIN = MOD (ISECS, 60)
- IHOU = (ISECS-IMIN)/60
- IF (IYEA.LT.1) THEN
- IADD = 0
- ITYP = 2
- ELSE IF (IYEA.GT.55) THEN
- IADD = IDAYY(55)
- ITYP = 2
- ELSE
- IADD = IDAYY(IYEA)
- ITYP = MOD (IYEA, 4)
- IF (ITYP.EQ.0) THEN
- ITYP = 2
- ELSE
- ITYP = 1
- ENDIF
- ENDIF
- IDAYS = IDAY + IADD + IDAYM(IMON,ITYP) + IDADD
- DO 10 I = 1, 55
- IF (IDAYS.LE.IDAYY(I)) THEN
- IYEA = I - 1
- IF (IYEA.GT.0) IDAYS = IDAYS - IDAYY(IYEA)
- GO TO 15
- ENDIF
- 10 CONTINUE
- IYEA = 55
- IDAYS = 365
- 15 IF (MOD(IYEA,4).EQ.0) THEN
- ITYP = 2
- ELSE
- ITYP = 1
- ENDIF
- DO 20 I = 2, 12
- IF (IDAYS.LE.IDAYM(I,ITYP)) THEN
- IMON = I - 1
- GO TO 25
- ENDIF
- 20 CONTINUE
- IMON = 12
- 25 IDAY = IDAYS - IDAYM(IMON,ITYP)
- ENDIF
-*
-* *** Now reconvert into a packed time
-*
- IDTMO = ISEC
- MAXX = MXSEC
- IDTMO = IDTMO + MAXX*IMIN
- MAXX = MAXX*MXMIN
- IDTMO = IDTMO + MAXX*IHOU
- MAXX = MAXX*MXHOU
- IDTMO = IDTMO + MAXX*IDAY
- MAXX = MAXX*MXDAY
- IDTMO = IDTMO + MAXX*IMON
- MAXX = MAXX*MXMON
- IDTMO = IDTMO + MAXX*IYEA
-* END CDINCT
- END
diff --git a/src/packlib/hepdb/cdutil/cdinfo.F b/src/packlib/hepdb/cdutil/cdinfo.F
deleted file mode 100644
index 4a67b50..0000000
--- a/src/packlib/hepdb/cdutil/cdinfo.F
+++ /dev/null
@@ -1,133 +0,0 @@
-*
-* $Id: cdinfo.F,v 1.1.1.1 1996/02/28 16:24:41 mclareni Exp $
-*
-* $Log: cdinfo.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:41 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDINFO (IUDIV, LAD, LSUP, JBIAS, IRC)
-* ================================================
-*
-************************************************************************
-* *
-* SUBR. CDINFO (IUDIV, LAD*, LSUP, JBIAS, IRC*) *
-* *
-* Creates DBTB bank with information of the data base objects used *
-* for this event (till the last call to CDINFO). It stores 2 words *
-* per object used, a unique identifier corresponding to the path *
-* name and the serial number of the object (KEY(1) value) *
-* *
-* Arguments : *
-* *
-* IUDIV User division where the DBTB bank has to be created *
-* LAD Address of the DBTB bank (should be in the same store *
-* as all DB objects) *
-* LSUP Address of the supporting bank *
-* JBIAS Link bias as described in ZEBRA manual *
-* IRC Return code (see below) *
-* *
-* Called by user *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
- PARAMETER (NLEVM=20, NDMAX=100)
- DIMENSION LSUP(9), LAD(9), ISDI(NLEVM), NSDI(NLEVM)
-*
-* ------------------------------------------------------------------
-*
-* *** Loop over all top directories
-*
- LREFCD(1) = LSUP(1)
- NDAT = 0
- IRC = 0
- LBUPCD = LTOPCD
- 10 IF (LBUPCD.GT.0) THEN
- NLEV = 0
- LBNOCD = LQ(KOFUCD+LBUPCD-1)
-*
-* ** Scan down the nodes to find all the subdirectories
-*
- 15 IF (LBNOCD.GT.0) THEN
- NLEV = NLEV + 1
- ISDI(NLEV) = 0
- NSDI(NLEV) = IQ(KOFUCD+LBNOCD-KLNOCD)
-*
- 20 ISDI(NLEV) = ISDI(NLEV) + 1
- IF (ISDI(NLEV).LE.NSDI(NLEV)) THEN
-*
-* ** If a new subdirectory go down one level
-*
- LBD = LQ(KOFUCD+LBNOCD-ISDI(NLEV))
- IF (LBD.GT.0) THEN
- LBNOCD = LBD
- GO TO 15
- ELSE
- GO TO 20
- ENDIF
-*
- ELSE
-*
-* ** Loop over all the key banks
-*
- NDK = IQ(KOFUCD+LBNOCD+MNDNWD)
- IDIC = IQ(KOFUCD+LBNOCD+MNDDIC)
- LBKYCD = LQ(KOFUCD+LBNOCD-KLKYCD)
- 25 IF (LBKYCD.GT.0) THEN
- IF (IQ(KOFUCD+LBKYCD+NDK+MKYCEV).GT.0) THEN
- IF (NDAT.EQ.0) THEN
- NDTOT = NDMAX
- CALL CDBANK (IUDIV, LAD(1), LREFCD(1), JBIAS, 'DBTB',
- + 0, 0, NDTOT, 2, -1, IRC)
- IF (IRC.NE.0) GO TO 999
- LREFCD(2) = LAD(1)
- ELSE IF (NDAT.GE.NDTOT) THEN
- NDTOT = NDTOT + NDMAX
- CALL CDBANK (IUDIV, LAD(1), LREFCD(1), JBIAS, 'DBTB',
- + 0, 0, NDTOT, 2, -1, IRC)
- IF (IRC.NE.0) GO TO 999
- LREFCD(2) = LAD(1)
- LBD = LQ(KOFUCD+LREFCD(1))
- CALL UCOPY (IQ(KOFUCD+LBD+1), IQ(KOFUCD+LREFCD(2)+1),
- + NDAT)
- CALL MZDROP (IUDIV, LBD, 'L')
- ENDIF
- IQ(KOFUCD+LREFCD(2)+NDAT+1) = IDIC
- IQ(KOFUCD+LREFCD(2)+NDAT+2) = IQ(KOFUCD+LBKYCD+IDHKSN)
- NDAT = NDAT + 2
- IQ(KOFUCD+LBKYCD+NDK+MKYCEV) = 0
- ENDIF
- LBKYCD = LQ(KOFUCD+LBKYCD)
- GO TO 25
- ENDIF
-*
-* ** Now go up one level
-*
- 30 NLEV = NLEV - 1
- IF (NLEV.GT.0) THEN
- LBNOCD = LQ(KOFUCD+LBNOCD+1)
- GO TO 20
- ENDIF
- ENDIF
- ENDIF
-*
- LBUPCD = LQ(KOFUCD+LBUPCD)
- GO TO 10
- ENDIF
-*
-* *** Now shrink DBTB bank if needed
-*
- IF (NDAT.GT.0) THEN
- IF (NDAT.LT.NDTOT) THEN
- NDPUS = NDAT - NDTOT
- CALL MZPUSH (IUDIV, LREFCD(2), 0, NDPUS, 'I')
- ENDIF
- ENDIF
-* END CDINFO
- 999 END
diff --git a/src/packlib/hepdb/cdutil/cdinic.F b/src/packlib/hepdb/cdutil/cdinic.F
deleted file mode 100644
index 987e51a..0000000
--- a/src/packlib/hepdb/cdutil/cdinic.F
+++ /dev/null
@@ -1,48 +0,0 @@
-*
-* $Id: cdinic.F,v 1.1.1.1 1996/02/28 16:24:43 mclareni Exp $
-*
-* $Log: cdinic.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:43 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDINIC
-#include "hepdb/cdtime.inc"
-#include "hepdb/cdunit.inc"
-#include "hepdb/hdbpara.inc"
-#include "hepdb/hdblun.inc"
-#include "hepdb/hdbpha.inc"
-#include "zebra/zunit.inc"
-*
-* General initialisation routine
-*
-* Set default log level
-*
- LLOGCD = 0
-*
-* Set units for output
-*
- LPRTCD = IQPRNT
- LOUTCD = IQPRNT
- LFILCD = 9
-*
-* Clear logical units
-*
- DO 10 I=1,KMXLUN
- MCDLUN(I) = -1
- MCDLUA(I) = -1
- 10 CONTINUE
-*
-* Set program phas
-*
- MCDPHA = 0
-*
-* Date and time range
-*
- IDATCD = 0
- ITIMCD = 0
- JDATCD = 0
- JTIMCD = 0
-
- END
diff --git a/src/packlib/hepdb/cdutil/cdlast.F b/src/packlib/hepdb/cdutil/cdlast.F
deleted file mode 100644
index ba32752..0000000
--- a/src/packlib/hepdb/cdutil/cdlast.F
+++ /dev/null
@@ -1,124 +0,0 @@
-*
-* $Id: cdlast.F,v 1.1.1.1 1996/02/28 16:24:41 mclareni Exp $
-*
-* $Log: cdlast.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:41 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- LOGICAL FUNCTION CDLAST (LBK, IRC)
-* ==================================
-*
-************************************************************************
-* *
-* FUNC. CDLAST (LBK, IRC*) *
-* *
-* Checks if the Key bank corresponds to the last inserted object *
-* *
-* Arguments : *
-* *
-* LBK Address of the key bank *
-* IRC Return code (see below) *
-* *
-* Called by user *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* =131 : Illegal pathname in the Key bank *
-* =132 : Illegal number of keys in the directory *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
-#include "hepdb/ckkeys.inc"
-#include "hepdb/ctpath.inc"
- CHARACTER PATHN*255
- DIMENSION LBK(9)
-#include "zebra/q_jbit.inc"
-* Ignoring t=pass
-*
-* ------------------------------------------------------------------
-*
-* *** Get the path name from the key bank
-*
- LREFCD(1) = LBK(1)
- CDLAST = .FALSE.
- LBNOCD = LQ(KOFUCD+LREFCD(1)-KLNOCD)
- NCH = IQ(KOFUCD+LBNOCD+MNDNCH)
- CALL UHTOC (IQ(KOFUCD+LBNOCD+MNDNAM), 4, PATHN, NCH)
- PATHN = PATHN(1:NCH)
-*
-* *** Set the current directory
-*
- CALL RZCDIR (PATHN, ' ')
- IF (IQUEST(1).NE.0) THEN
- IRC = 131
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDLAST : Ill'//
- + 'egal path name '//PATHN//''')', IARGCD, 0)
-#endif
- GO TO 999
- ENDIF
- IF (IQUEST(7).LE.0) THEN
- IRC = 132
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDLAST : Illegal'//
- + ' number of keys for '//PATHN//''')', IARGCD, 0)
-#endif
- GO TO 999
- ENDIF
-*
- NKEYCK = IQUEST(7)
- NWKYCK = IQUEST(8)
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- IPNT = KOFSCD + LCDRCD + IKDRCD
- ISTP = NWKYCK + 1
- IOPTP = JBIT (IQ(IPNT+IDHFLG), JPRTCD)
-*
-* *** Take different action for partitioned and non-partitioned cases
-*
- IF (IOPTP.EQ.0) THEN
- KPNT = IPNT + (NKEYCK-1) * ISTP
- KMAX = IQ(KPNT+IDHKSN)
- DO 10 I = 2, NKEYCK
- KPNT = KPNT - ISTP
- IF (IQ(KPNT+IDHKSN).GT.KMAX) KMAX = IQ(KPNT+IDHKSN)
- 10 CONTINUE
- ELSE
-*
- KMAX = 0
- DO 20 IK = 1, NKEYCK
- JK = NKEYCK + 1 - IK
- CALL CDPATH (TOP1CT, JK)
- PATHN = PATHN(1:NCH)//'/'//TOP1CT
- CALL RZCDIR (PATHN, ' ')
- IF (IQUEST(1).NE.0) THEN
- IRC = 131
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDLAST : Ill'//
- + 'egal path name '//PATHN//''')', IARGCD, 0)
-#endif
- GO TO 999
- ENDIF
- NKEYS = IQUEST(7)
- IF (NKEYS.GT.0) THEN
- KPNT = KOFSCD + IQUEST(11) + IQUEST(13) + (NKEYS-1) * ISTP
- KMAX = IQ(KPNT+IDHKSN)
- DO 15 I = 2, NKEYS
- KPNT = KPNT - ISTP
- IF (IQ(KPNT+IDHKSN).GT.KMAX) KMAX = IQ(KPNT+IDHKSN)
- 15 CONTINUE
- GO TO 30
- ENDIF
- 20 CONTINUE
- ENDIF
-*
-* *** Now compare last Key 1 with that in the Key bank
-*
- 30 IF (IQ(KOFUCD+LREFCD(1)+IDHKSN).EQ.KMAX) CDLAST = .TRUE.
- IRC = 0
-* END CDLAST
- 999 END
diff --git a/src/packlib/hepdb/cdutil/cdldir.F b/src/packlib/hepdb/cdutil/cdldir.F
deleted file mode 100644
index 47061c5..0000000
--- a/src/packlib/hepdb/cdutil/cdldir.F
+++ /dev/null
@@ -1,351 +0,0 @@
-*
-* $Id: cdldir.F,v 1.1.1.1 1996/02/28 16:24:44 mclareni Exp $
-*
-* $Log: cdldir.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:44 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDLDIR(PATH,LWRITE,NLEVEL,CHOPT,IRC)
-*
-************************************************************************
-*
-* To traverse the HEPDB directory tree starting from
-* the specified pathname.
-* Modified from the RZ routine RZSTAT / RZSCAN
-*
-* Input:
-* CHPATH The pathname of the starting directory
-* LWRITE The logical unit on which the information is written
-* NLEVEL Number of levels below CHPATH to descend
-*
-* Output:
-* IQUEST(11) = number of directories found
-* IQUEST(12) = number of directories that match
-*
-* Called by CDLDC
-* <user>
-*
-*
-************************************************************************
-#include "zebra/rzcl.inc"
-#include "zebra/rzdir.inc"
-#include "zebra/rzch.inc"
-#include "zebra/rzk.inc"
- CHARACTER*(*) PATH
- CHARACTER*255 CHPATH
- CHARACTER*255 OLDDIR
- CHARACTER*132 CHLINE
- PARAMETER (MAXLEV=20)
- CHARACTER*16 DIRNAM(MAXLEV),CHDIR
- DIMENSION ISD(MAXLEV),NSD(MAXLEV),IHDIR(4)
- DIMENSION IHTAG(2)
- CHARACTER*8 CHTAG(KNMAX)
-#include "hepdb/slate.inc"
-#include "hepdb/cdunit.inc"
-#include "hepdb/cdrnge.inc"
-#include "hepdb/hdbopts.inc"
-*
-*-----------------------------------------------------------------------
-*
-*
- IRC=0
- IQUEST(1) = 0
- IQUEST(11) = 0
- IWIDTH = 0
- JWIDTH = 78
- IF(IOPTV.NE.0) JWIDTH = 132
- CALL CDLDDI (PATH, CHPATH, LPATH)
- LPATHI = LPATH
-*
-* Split input path name into its component pieces
-* (this is the opposite of RZPAFF which glues them together)
-*
- CALL CDPAFF(CHPATH(1:LPATH),DIRNAM,MAXLEV,IRET)
-*
-* Find first wild card in generic name
-*
- IF(LLOGCD.GE.3)
- +WRITE(LPRTCD,*) 'CDLDIR. enter for PATH = ',CHPATH(1:LPATH),
- + ' nlevel = ',NLEVEL,' chopt = ',CHOPT
- IWILD = ICFMUL('*%(<>[]',CHPATH,1,LPATH)
- IF(IWILD.LE.LPATH) THEN
- LPATH = INDEXB(CHPATH(1:IWILD),'/') - 1
- ENDIF
-*
- ITIME=0
- NLEV=NLEVEL
- IF(NLEV.LE.0)NLEV=99
- NFOUND = 0
- NMATCH = 0
- ITEMP = 0
- CALL RZCDIR(CHWOLD,'R')
- OLDDIR = ' '
- LOLD = 1
-*
-* Set CWD to the current level
-*
- 10 CONTINUE
- IF(ITIME.NE.0)THEN
- CALL RZPAFF(CHPAT,NLPAT,CHL)
- CALL RZCDIR(CHL,' ')
- ELSE
- CALL RZCDIR(CHPATH(1:LPATH),' ')
- IF(IQUEST(1).NE.0)GO TO 80
- IF(IQ(KQSP+LCDIR+KNSD).GT.0) WRITE(LWRITE,*)
- + 'List of subdirectories...'
- NLPAT0=NLPAT
- CHL = CHPATH(1:LPATH)
- ENDIF
- IF(IQUEST(1).NE.0)GO TO 70
-*
-* Set IQUEST
-*
- IQUEST(12) = IQ(KQSP+LCDIR+KNSD)
- IQUEST(13) = NLPAT
- IQUEST(14) = IQ(KQSP+LCDIR+KNKEYS)
- IQUEST(15) = IQ(KQSP+LCDIR+KNWKEY)
-*
-* Ensure that entire path name matches before printing
-*
- NFOUND = NFOUND + 1
- CALL CDMTCH(CHL,CHPATH(1:LPATHI),IRC)
- IF(IRC.EQ.0) THEN
- NMATCH = NMATCH + 1
- LCHL = LENOCC(CHL)
- ISLASH = INDEXB(CHL(1:LCHL),'/')
-
- IF(IOPTV+IOPTW.EQ.0) THEN
-*
-* Dates and times
-*
- WRITE(LWRITE,*) CHL(1:LCHL)
-
- IF(IOPTC.NE.0) THEN
- CALL RZDATE(IQ(KQSP+LCDIR+KDATEC),IDC,ITC,1)
- WRITE(LWRITE,*) ' Created :',IDC,ITC
- ENDIF
- IF(IOPTM.NE.0) THEN
- CALL RZDATE(IQ(KQSP+LCDIR+KDATEM),IDM,ITM,1)
- WRITE(LWRITE,*) ' Modified :',IDM,ITM
- ENDIF
-
- IF(IOPTO.NE.0) THEN
- WRITE(LWRITE,*) ' Objects :',IQ(KQSP+LCDIR+KNKEYS)
- ENDIF
-
- IF(IOPTS.NE.0) THEN
- WRITE(LWRITE,*) ' Subdirectories :',IQ(KQSP+LCDIR+KNSD)
- ENDIF
-
- IF(IOPTT.NE.0) THEN
- NWKEY=IQ(KQSP+LCDIR+KNWKEY)
- KTAGS=KKDES+(NWKEY-1)/10+1
- DO 20 J=1,NWKEY
- CALL ZITOH(IQ(KQSP+LCDIR+KTAGS+2*J-2),IHTAG,2)
- CALL UHTOC(IHTAG,4,CHTAG(J),8)
- 20 CONTINUE
- WRITE(LWRITE,*) ' Tags :'
- WRITE(LWRITE,9001) (CHTAG(J),J=1,NWKEY)
- 9001 FORMAT(8(2X,A8))
- ENDIF
-
- IF(IOPTC+IOPTM+IOPTS+IOPTO+IOPTT.NE.0) WRITE(LWRITE,*)
-
- ELSE
- IF(CHL(1:ISLASH-1).NE.OLDDIR(1:LOLD)) THEN
-* flush current buffer
- IF(IWIDTH.NE.0) THEN
- WRITE(LWRITE,'(1X,A)') CHLINE(1:IWIDTH)
- IWIDTH = 0
- ENDIF
-
- WRITE(LWRITE,*)
- WRITE(LWRITE,'(1X,A,A)') 'Directory: ',CHL(1:ISLASH-1)
- WRITE(LWRITE,*)
- LOLD = ISLASH - 1
- OLDDIR = CHL(1:LOLD)
-
- ENDIF
-
- LF = LCHL - ISLASH
- IF(IWIDTH+LF.GE.JWIDTH) THEN
-* flush current buffer
- WRITE(LWRITE,'(1X,A)') CHLINE(1:IWIDTH)
- IWIDTH = 0
- ENDIF
- IF(IWIDTH.EQ.0) THEN
- CHLINE = CHL(ISLASH+1:LCHL) // ' '
- ELSE
- CHLINE = CHLINE(1:IWIDTH) // CHL(ISLASH+1:LCHL) // ' '
- ENDIF
- IWIDTH = IWIDTH + LF + 1
- ENDIF
- ENDIF
-
- ISD(NLPAT)=0
- NSD(NLPAT)=IQ(KQSP+LCDIR+KNSD)
-*
-* If there is a <> at this level, perform matching
-* and follow only that path
-*
- ILT = INDEX(DIRNAM(NLPAT+1),'<')
- IGT = INDEX(DIRNAM(NLPAT+1),'>')
- NCRNGE(NLPAT+1) = 0
-
- IF((ILT.NE.0).AND.(IGT.NE.0)) THEN
- IF(LLOGCD.GE.-3) WRITE(LWRITE,9002) NLPAT,DIRNAM(NLPAT+1)
- 9002 FORMAT(' CDLDIR. invalid wild-carding at level ',I6,
- + ' in pathname - ',A)
- IF(LLOGCD.GE.-3) WRITE(LWRITE,9003)
- 9003 FORMAT(' CDLDIR. only one of < or > may be specified')
- IQUEST(1) = -1
- GOTO 70
- ENDIF
-
- IF(ILT+IGT.NE.0) THEN
-*
-* Is there a [mm:nn] syle range?
-*
- JR = LENOCC(DIRNAM(NLPAT+1))
- ISQ = INDEX(DIRNAM(NLPAT+1)(1:JR),'[')
- IF(ISQ.NE.0) THEN
- ILOW = ICDECI(DIRNAM(NLPAT+1),ISQ+1,JR)
- IF(IS(1).EQ.0) THEN
- IRC = -1
- IF(LLOGCD.GE.-3) WRITE(LWRITE,9004)
- + DIRNAM(NLPAT+1)(ISQ:JR)
- 9004 FORMAT(' CDLDIR. error reading decimal value from ',A/
- + ' Only integer ranges are supported',
- + ' between [] characters, e.g. [10:20]')
- GOTO 80
- ENDIF
- IHIGH = ICDECI(DIRNAM(NLPAT+1),
- + INDEX(DIRNAM(NLPAT+1),':') + 1,JR)
- IF(IS(1).EQ.0) THEN
- IRC = -1
- IF(LLOGCD.GE.-3) WRITE(LWRITE,9004)
- + DIRNAM(NLPAT+1)(ISQ:JR)
- GOTO 80
- ENDIF
- IF(LLOGCD.GE.3) WRITE(LWRITE,9005) ILOW,IHIGH
- 9005 FORMAT(' CDLDIR. ilow/ihigh = ',I6,'/',I6)
- NCRNGE(NLPAT+1) = 0
- IF(IHIGH-ILOW+1.GT.100) THEN
- IF(LLOGCD.GE.-3) WRITE(LWRITE,9006)
- 9006 FORMAT(' CDLDIR. maximum range is 100',
- + ' - excess elements will be ignored')
- IHIGH = ILOW + 99
- ENDIF
- DO 30 JJ=ILOW,IHIGH
- NCRNGE(NLPAT+1) = NCRNGE(NLPAT+1) + 1
- ICRNGE(NCRNGE(NLPAT+1),NLPAT+1) = JJ
- ICELEM(NCRNGE(NLPAT+1),NLPAT+1) = -1
- IF(ILT.NE.0) THEN
- ICVAL(NCRNGE(NLPAT+1),NLPAT+1) = 999999
- ELSE
- ICVAL(NCRNGE(NLPAT+1),NLPAT+1) = -1
- ENDIF
- 30 CONTINUE
- ENDIF
-*
-* Loop over all subdirectories at this level
-*
- DO 40 JJ=1,NSD(NLPAT)
- LS=IQ(KQSP+LCDIR+KLS)
- IH=LS+7*(JJ-1)
- CALL ZITOH(IQ(KQSP+LCDIR+IH),IHDIR,4)
- CALL UHTOC(IHDIR,4,CHDIR,16)
- CALL CDSELP(CHDIR,DIRNAM(NLPAT+1),JJ,NSD(NLPAT),JINDEX,IRC)
- 40 CONTINUE
- IF(JINDEX.GT.0) THEN
- IF(NCRNGE(NLPAT+1).EQ.0) THEN
- IF(LLOGCD.GE.3) THEN
- LS=IQ(KQSP+LCDIR+KLS)
- IH=LS+7*(JINDEX-1)
- CALL ZITOH(IQ(KQSP+LCDIR+IH),IHDIR,4)
- CALL UHTOC(IHDIR,4,CHDIR,16)
- WRITE(LWRITE,9007) CHDIR
- 9007 FORMAT(' CDLDIR. selected subdirectory ',A)
- ENDIF
- NSD(NLPAT) = JINDEX
- ISD(NLPAT) = JINDEX - 1
- ELSE
- LS=IQ(KQSP+LCDIR+KLS)
- IF(LLOGCD.GE.3) WRITE(LWRITE,9008)
- 9008 FORMAT(' CDLDIR. selected following subdirectories...')
- JMIN = 999999
- JMAX = 0
- DO 50 II=1,NCRNGE(NLPAT+1)
- JJ=ICELEM(II,NLPAT+1)
- IF(JJ.LE.0) GOTO 50
- IF(JJ.LT.JMIN) JMIN = JJ
- IF(JJ.GT.JMAX) JMAX = JJ
- IF(LLOGCD.GE.3) THEN
- IH=LS+7*(JJ-1)
- CALL ZITOH(IQ(KQSP+LCDIR+IH),IHDIR,4)
- CALL UHTOC(IHDIR,4,CHDIR,16)
- WRITE(LWRITE,9009) CHDIR
- 9009 FORMAT(1X,A)
- ENDIF
- 50 CONTINUE
- NSD(NLPAT) = JMAX
- ISD(NLPAT) = JMIN - 1
- ENDIF
- ELSE
- IF(LLOGCD.GE.2) WRITE(LWRITE,9010)
- 9010 FORMAT(' CDLDIR. no subdirectory matches')
- NSD(NLPAT) = 0
- ENDIF
- ELSE
- JINDEX = -1
- ENDIF
-*
-* Process possible down directories
-*
- 60 ISD(NLPAT)=ISD(NLPAT)+1
-
- IF((ISD(NLPAT).LE.NSD(NLPAT)).AND.
- + (NLPAT.LT.(NLPAT0+NLEV))) THEN
- IF(NCRNGE(NLPAT+1).NE.0
- + .AND.IUFIND(ISD(NLPAT),
- + ICELEM(1,NLPAT+1),1,NCRNGE(NLPAT+1)).GT.
- + NCRNGE(NLPAT+1)) GOTO 60
- NLPAT=NLPAT+1
- LS=IQ(KQSP+LCDIR+KLS)
- IH=LS+7*(ISD(NLPAT-1)-1)
- CALL ZITOH(IQ(KQSP+LCDIR+IH),IHDIR,4)
- CALL UHTOC(IHDIR,4,CHPAT(NLPAT),16)
- ITIME=ITIME+1
- GO TO 10
- ELSE
-*
-* Write information on current directory
-*
- CALL RZPAFF(CHPAT,NLPAT,CHL)
-* IF(NLPAT.LE.(NLPAT0+NLEV))THEN
-* ENDIF
- NLPAT=NLPAT-1
- IF(NLPAT.GE.NLPAT0)THEN
- LUP=LQ(KQSP+LCDIR+1)
- CALL MZDROP(JQPDVS,LCDIR,' ')
- LCDIR=LUP
- GO TO 60
- ENDIF
- ENDIF
-*
-* Reset CWD
-*
- 70 CALL RZCDIR(CHWOLD,' ')
-
- IF((IWIDTH.NE.0).AND.(IOPTV+IOPTW.NE.0)) THEN
- WRITE(LWRITE,'(1X,A)') CHLINE(1:IWIDTH)
- ENDIF
-*
- 80 CONTINUE
- IRC = IQUEST(1)
- IQUEST(11) = MAX(NFOUND -1,0)
- IQUEST(12) = NMATCH
- END
-
diff --git a/src/packlib/hepdb/cdutil/cdlist.F b/src/packlib/hepdb/cdutil/cdlist.F
deleted file mode 100644
index 09443ff..0000000
--- a/src/packlib/hepdb/cdutil/cdlist.F
+++ /dev/null
@@ -1,68 +0,0 @@
-*
-* $Id: cdlist.F,v 1.1.1.1 1996/02/28 16:24:44 mclareni Exp $
-*
-* $Log: cdlist.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:44 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDLIST(PATH,KSN,CHBANC,JLNK1,JLNK2,JDAT1,JDAT2,
- + CHOPT,IRC)
- CHARACTER PATH*(*),CHBANC*(*),CHOPT*(*),CHPATH*255
-#include "hepdb/cdlscm.inc"
-#include "hepdb/cduscm.inc"
-#include "hepdb/hdbopt.inc"
- EXTERNAL CDLS
-#include "hepdb/hdboptd.inc"
-*
-* Interface to CDLS routine
-*
- CALL CDLDDI (PATH, CHPATH, LPATH)
- LBANK = LENOCC(CHBANC)
- IF(LBANK.EQ.0) THEN
- CHBANK = ' '
- ELSE
- CHBANK = CHBANC(1:MIN(LEN(CHBANK),LBANK))
- ENDIF
-
- LCHOPT = LENOCC(CHOPT)
- IF(LCHOPT.EQ.0) THEN
- CHOPTT = ' '
- ELSE
- CHOPTT = CHOPT(1:LCHOPT)
- ENDIF
-
- ILNK1 = JLNK1
- ILNK2 = JLNK2
- IDAT1 = JDAT1
- IDAT2 = JDAT2
- NKEYSN = KSN
-
-#include "hepdb/hdboptc.inc"
-*
-* Look for objects in specified path
-*
- IF(IDEBCD.GE.2) PRINT *,'CDLIST. enter for ',CHPATH(1:LPATH),
- + ',',CHOPT
-*
- IF(IOPTH.NE.0) THEN
- WRITE(LPRTCD,*) '>>> Command: LS ',
- + 'Options: ',CHOPT(1:LCHOPT),' key serial number: ',KSN
- WRITE(LPRTCD,*) '>>> Path: ',CHPATH(1:LPATH)
- WRITE(LPRTCD,*) '>>> Bank name: ',CHBANK,
- + ' first/last links,data words = ',ILNK1,ILNK2,IDAT1,IDAT2
- ENDIF
-*
- IF(ICFMUL('*%(<>[]',CHPATH,1,LPATH).GT.LPATH) THEN
- CALL RZCDIR(CHPATH(1:LPATH),' ')
- CALL CDLS(CHPATH(1:LPATH),IRC)
- ELSE
- CALL CDSCAN(CHPATH(1:LPATH),99,CDLS,IRC)
- ENDIF
-
- WRITE(LPRTCD,9001) NOBJT,NDIRT,NOBJM
- 9001 FORMAT(' Total of ',I6,' objects in ',I6,' directories',
- + ' of which ',I6,' match selection criteria')
-
- END
diff --git a/src/packlib/hepdb/cdutil/cdlkey.F b/src/packlib/hepdb/cdutil/cdlkey.F
deleted file mode 100644
index de3eb5d..0000000
--- a/src/packlib/hepdb/cdutil/cdlkey.F
+++ /dev/null
@@ -1,134 +0,0 @@
-*
-* $Id: cdlkey.F,v 1.1.1.1 1996/02/28 16:24:42 mclareni Exp $
-*
-* $Log: cdlkey.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:42 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDLKEY (PATHN, KEYS, IDATE, ITIME, CHOPT, IRC)
-* =========================================================
-*
-************************************************************************
-* *
-* SUBR. CDLKEY (PATHN, KEYS*, IDATE*, ITIME*, CHOPT, IRC*) *
-* *
-* Finds the latest inserted object for a given directory *
-* (Adapted from P.Bagnaia) *
-* *
-* Arguments : *
-* *
-* PATHN Character string describing the pathname *
-* KEYS The key of the last modified object (see below) *
-* IDATE Date (YYMMDD) of the insertion of the last element *
-* ITIME Time (HHMM) " " " " " " " *
-* CHOPT Character option *
-* ' ' Returns only serial number in KEYS(1) *
-* 'K' Returns the entire key vector *
-* IRC Return code (see below) *
-* *
-* Called by user *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* =131 : Illegal pathname *
-* =132 : Illegal number of keys in the directory *
-* *
-************************************************************************
-*
-#include "hepdb/caopts.inc"
-#include "hepdb/cdcblk.inc"
-#include "hepdb/ckkeys.inc"
-#include "hepdb/ctpath.inc"
- DIMENSION KEYS(9)
- CHARACTER PATHN*(*), PATHY*255, PATHX*16, CHOPT*(*)
-#include "zebra/q_jbit.inc"
-* Ignoring t=pass
-*
-* ------------------------------------------------------------------
-*
- CALL CDOPTS (CHOPT, IRC)
- IF (IRC.NE.0) GO TO 999
-*
-* *** Set the current directory path name
-*
- CALL CDLDUP (PATHN, 0, IRC)
- IF (IRC.NE.0) GO TO 999
-*
- PATHY = PAT1CT
- IF (NKEYCK.LE.0) THEN
- IRC = 132
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDLKEY : Illegal'//
- + ' number of keys for '//PATHY//''')', IARGCD, 0)
-#endif
- GO TO 999
- ENDIF
- CALL CDKEYT
- IPNT = KOFSCD + LCDRCD + IKDRCD
- ISTP = NWKYCK + 1
- IOPTP = JBIT (IQ(IPNT+IDHFLG), JPRTCD)
-*
-* *** Take different action for partitioned and non-partitioned cases
-*
- IF (IOPTP.EQ.0) THEN
- KPNT = IPNT + (NKEYCK-1) * ISTP
- KMAX = IQ(KPNT+IDHKSN)
- JMAX = NKEYCK
- DO 10 I = 2, NKEYCK
- KPNT = KPNT - ISTP
- IF (IQ(KPNT+IDHKSN).GT.KMAX) THEN
- KMAX = IQ(KPNT+IDHKSN)
- JMAX = I - 1
- ENDIF
- 10 CONTINUE
- KEY7 = IQ(IPNT+(JMAX-1)*ISTP+IDHINS)
- IF (IOPKCA.NE.0) CALL CDKEYR (JMAX, NWKYCK, KEYS)
- ELSE
-*
- NCH = LENOCC (PATHY)
- KMAX = 0
- DO 20 IK = 1, NKEYCK
- JK = NKEYCK + 1 - IK
- CALL CDPATH (PATHX, JK)
- PAT1CT = PATHY(1:NCH)//'/'//PATHX
- CALL RZCDIR (PAT1CT, ' ')
- IF (IQUEST(1).NE.0) THEN
- IRC = 131
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDLKEY : Ill'//
- + 'egal path name '//PAT1CT//''')', IARGCD, 0)
-#endif
- GO TO 999
- ENDIF
- NKEYS = IQUEST(7)
- NWKYCK = IQUEST(8)
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- IF (NKEYS.GT.0) THEN
- IPNT = KOFSCD + IQUEST(11) + IQUEST(13)
- KPNT = IPNT + (NKEYS-1) * ISTP
- KMAX = IQ(KPNT+IDHKSN)
- JMAX = NKEYS
- DO 15 I = 2, NKEYS
- KPNT = KPNT - ISTP
- IF (IQ(KPNT+IDHKSN).GT.KMAX) THEN
- KMAX = IQ(KPNT+IDHKSN)
- JMAX = I - 1
- ENDIF
- 15 CONTINUE
- KEY7 = IQ(IPNT+(JMAX-1)*ISTP+IDHINS)
- IF (IOPKCA.NE.0) CALL CDKEYR (JMAX, NWKYCK, KEYS)
- GO TO 30
- ENDIF
- 20 CONTINUE
- ENDIF
-*
-* *** and get the date
-*
- 30 CALL CDUPTM (IDATE, ITIME, KEY7, IRC)
- IF (IOPKCA.EQ.0) KEYS(1) = KMAX
-* END CDLKEY
- 999 END
diff --git a/src/packlib/hepdb/cdutil/cdlls.F b/src/packlib/hepdb/cdutil/cdlls.F
deleted file mode 100644
index 5e2e9fa..0000000
--- a/src/packlib/hepdb/cdutil/cdlls.F
+++ /dev/null
@@ -1,185 +0,0 @@
-*
-* $Id: cdlls.F,v 1.2 1996/03/08 16:40:39 jamie Exp $
-*
-* $Log: cdlls.F,v $
-* Revision 1.2 1996/03/08 16:40:39 jamie
-* Fix array bound problem for VMS
-*
-* Revision 1.1.1.1 1996/02/28 16:24:40 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDLLS(LUNCDI,CHPATT,FILES,NMAX,NFOUND,ICONT,IRC)
- CHARACTER*(*) FILES(NMAX)
- CHARACTER*(*) CHPATT
- CHARACTER*255 CHLIST
- CHARACTER*255 CHFILE,CHDEF
- CHARACTER*255 COMM
- CHARACTER*255 CHLOG,CHERR
- CHARACTER*255 CHCWD
- COMMON/SLATE/IS(40)
- INTEGER SYSTEMF
- SAVE NDONE
-*
-#if defined(CERNLIB_VAXVMS)
- INCLUDE '($RMSDEF)'
- INTEGER SYS$GETMSG
- CHARACTER*255 CHDIR
-#endif
-#if defined(CERNLIB_UNIX)
- LOGICAL IEXIST
-#endif
-*
-* Return files matching pattern CHPATT
-*
- IRC = 0
- LPATT = LENOCC(CHPATT)
- IF(LPATT.EQ.0) THEN
-#if defined(CERNLIB_IBM)||defined(CERNLIB_UNIX)
- LPATT = 1
- CHLIST = ' '
- ELSE
- CHLIST = CHPATT(1:LPATT)
-#endif
-#if defined(CERNLIB_VAXVMS)
- LPATT = 3
- CHLIST = '*.*'
- ELSE
- CHLIST = CHPATT(1:LPATT)
- IF((CHPATT(LPATT:LPATT).EQ.':').OR.
- + (CHPATT(LPATT:LPATT).EQ.'>').OR.
- + (CHPATT(LPATT:LPATT).EQ.']')) THEN
- CHLIST(LPATT+1:LPATT+3) = '*.*'
- LPATT = LPATT + 3
- ENDIF
-#endif
- ENDIF
-#if defined(CERNLIB_UNIX)
- CALL CUTOL(CHLIST)
-#endif
- NFOUND = 0
- ICONT = 0
- COMM = ' '
-#if defined(CERNLIB_UNIX)
- CALL GETWDF(CHCWD)
- LCWD = IS(1)
- CHLOG = CHCWD(1:LCWD)//'/hepdb.tmp'
- CHERR = CHCWD(1:LCWD)//'/hepdb.err'
- LLOG = LENOCC(CHLOG)
- LERR = LLOG
- WRITE(COMM,9001) CHLIST(1:LPATT),CHLOG(1:LLOG),CHERR(1:LERR)
- 9001 FORMAT('ls ',A,' >',A,' 2>',A)
- IC = SYSTEMF(COMM)
- INQUIRE(FILE=CHLOG(1:LLOG),EXIST=IEXIST)
- IF(.NOT.IEXIST) THEN
- IRC = -2
- GOTO 999
- ENDIF
- OPEN(LUNCDI,FILE=CHLOG(1:LLOG),FORM='FORMATTED',STATUS='OLD')
- ISKIP = 0
- IF(ICONT.EQ.0) NDONE = 0
- 10 CONTINUE
- READ(LUNCDI,'(A)',END=20) CHFILE
- ISKIP = ISKIP + 1
- IF(ISKIP.LT.NDONE) THEN
- GOTO 10
- ENDIF
- NFOUND = NFOUND + 1
- IF(NFOUND.GT.NMAX) THEN
- NFOUND = NMAX
- IRC = -1
- ICONT = 1
- GOTO 20
- ENDIF
- FILES(NFOUND) = CHFILE(1:LENOCC(CHFILE))
- GOTO 10
-#endif
-#if (defined(CERNLIB_UNIX))&&(!defined(CERNLIB_APOLLO))
- 20 CLOSE(LUNCDI,STATUS='DELETE')
-#endif
-#if (defined(CERNLIB_UNIX))&&(defined(CERNLIB_APOLLO))
- 20 CLOSE(LUNCDI)
-#endif
-#if defined(CERNLIB_VAXVMS)
- CHDEF = ' '
- CALL GETDEF(CHDEF)
- LDEF = LENOCC(CHDEF)
- 10 CONTINUE
- CHFILE = ' '
- IF ((LDEF.NE.0) .AND.
- + (INDEX(CHPATT(1:LPATT),':').EQ.0).AND.
- + (INDEX(CHPATT(1:LPATT),'>').EQ.0).AND.
- + (INDEX(CHPATT(1:LPATT),'-').EQ.0)) THEN
- ISTAT = LIB$FIND_FILE(CHDEF(1:LDEF)//
- + CHLIST(1:LPATT),CHFILE,ICONT)
- ELSE
- ISTAT = LIB$FIND_FILE(CHLIST(1:LPATT),CHFILE,ICONT)
- ENDIF
-*
-* Check for RMS$_DNF - directory not found
-* RMS$_FNF - file not found
-* RMS$_NMF - no more files
-*
- IF(ISTAT.EQ.RMS$_DNF) THEN
- IRC = ISTAT
- CALL LIB$FIND_FILE_END(ICONT)
- ICONT = 0
- GOTO 999
- ELSEIF(ISTAT.EQ.RMS$_FNF) THEN
- CALL LIB$FIND_FILE_END(ICONT)
- ICONT = 0
- GOTO 999
- ELSEIF(ISTAT.EQ.RMS$_NMF) THEN
- CALL LIB$FIND_FILE_END(ICONT)
- ICONT = 0
- GOTO 999
- ENDIF
-
- IF(.NOT.ISTAT) THEN
- IRC = SYS$GETMSG(%VAL(ISTAT),LFILE,CHFILE,,)
- PRINT 9002,CHFILE(1:LFILE)
- 9002 FORMAT(' CDLLS. error from LIB$FIND_FILE = ',A)
- IRC = ISTAT
- ISTAT = LIB$FIND_FILE_END(ICONT)
- GOTO 999
- ELSE
- NFOUND = NFOUND + 1
- IF(NFOUND.GT.NMAX) THEN
- NFOUND = NMAX
- IRC = -1
- GOTO 999
- ENDIF
- FILES(NFOUND) = CHFILE(1:LENOCC(CHFILE))
- GOTO 10
- ENDIF
-
-#endif
-#if defined(CERNLIB_IBMVM)
- IF(ICONT.EQ.0) NDONE = 0
- CALL CTRANS('.',' ',CHPATT,1,LPATT)
- CALL VMCMS('LISTFILE '//CHPATT(1:LPATT)//'(STACK',IRC)
- CALL VMCMS('SENTRIES',NFOUND)
- DO 10 I=1,NFOUND
- CALL VMRTRM(CHFILE,LFILE)
- IF(I.LE.NDONE) GOTO 10
- IF(I.GT.NMAX) THEN
- IRC = -1
- ICONT = 1
- GOTO 999
- ENDIF
- FILES(I) = CHFILE(1:LFILE)
- NDONE = NDONE + 1
- 10 CONTINUE
-#endif
-#if defined(CERNLIB_IBMMVS)
-*
-* N.B. these routines not yet copied from CSPACK
-*
- CALL CDMVSD(CHPATT,CHLIST,LLIST,ICUT,IRC)
-
- IFLAG = 0
- IFILL = 0
- CALL CDLCAT(CHLIST(1:LLIST),FILES,NMAX,NDONE,ICONT)
-#endif
- 999 END
diff --git a/src/packlib/hepdb/cdutil/cdlmod.F b/src/packlib/hepdb/cdutil/cdlmod.F
deleted file mode 100644
index 4c1eceb..0000000
--- a/src/packlib/hepdb/cdutil/cdlmod.F
+++ /dev/null
@@ -1,140 +0,0 @@
-*
-* $Id: cdlmod.F,v 1.1.1.1 1996/02/28 16:24:42 mclareni Exp $
-*
-* $Log: cdlmod.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:42 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDLMOD (PATHN, IDATE, ITIME, CHOPT, IRC)
-* ===================================================
-*
-************************************************************************
-* *
-* SUBR. CDLMOD (PATHN, IDATE*, ITIME*, CHOPT, IRC*) *
-* *
-* Finds the modification date and time for the specified directory *
-* *
-* Arguments : *
-* *
-* PATHN Character string describing the pathname *
-* IDATE Date (YYMMDD) of the insertion of the last element *
-* ITIME Time (HHMM) " " " " " " " *
-* CHOPT ' ' - HEPDB date and time *
-* 'R' - RZ date and time (not yet implemented) *
-* IRC Return code (see below) *
-* *
-* Called by user *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* =131 : Illegal pathname *
-* =132 : Illegal number of keys in the directory *
-* *
-************************************************************************
-*
-#include "hepdb/caopts.inc"
-#include "hepdb/cdcblk.inc"
-#include "hepdb/ckkeys.inc"
-#include "hepdb/ctpath.inc"
- CHARACTER PATHN*(*), PATHY*80, PATHX*16, CHOPT*(*)
- CHARACTER*255 CHTEMP
-#include "zebra/q_jbit.inc"
-* Ignoring t=pass
-*
-* ------------------------------------------------------------------
-*
-*
-* *** Save current directory
-*
- CALL RZCDIR(CHTEMP,'R')
-*
-* *** Crack options
-*
- CALL CDOPTS (CHOPT, IRC)
- IF (IRC.NE.0) GO TO 999
-*
-* *** Set the current directory path name
-*
- CALL CDLDUP (PATHN, 0, IRC)
- IF (IRC.NE.0) GO TO 999
-*
- PATHY = PAT1CT
- IF (IOPRCA.NE.0) THEN
- IDATE = IQUEST(16)
- ITIME = IQUEST(17)
- GO TO 999
- ENDIF
- IF (NKEYCK.LE.0) THEN
- IRC = 132
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDLMOD : Illegal'//
- + ' number of keys for '//PATHY//''')', IARGCD, 0)
-#endif
- GO TO 999
- ENDIF
- IPNT = KOFSCD + LCDRCD + IKDRCD
- ISTP = NWKYCK + 1
- IOPTP = JBIT (IQ(IPNT+IDHFLG), JPRTCD)
-*
-* *** Take different action for partitioned and non-partitioned cases
-*
- IF (IOPTP.EQ.0) THEN
- KPNT = IPNT + (NKEYCK-1) * ISTP
- KMAX = IQ(KPNT+IDHINS)
- JMAX = NKEYCK
- DO 10 I = 2, NKEYCK
- KPNT = KPNT - ISTP
- IF (IQ(KPNT+IDHINS).GT.KMAX) THEN
- KMAX = IQ(KPNT+IDHINS)
- JMAX = I - 1
- ENDIF
- 10 CONTINUE
- KEY7 = IQ(IPNT+(JMAX-1)*ISTP+IDHINS)
- ELSE
-*
- NCH = LENOCC (PATHY)
- DO 20 IK = 1, NKEYCK
- JK = NKEYCK + 1 - IK
- CALL CDPATH (PATHX, JK)
- PAT1CT = PATHY(1:NCH)//'/'//PATHX
- CALL RZCDIR (PAT1CT, ' ')
- IF (IQUEST(1).NE.0) THEN
- IRC = 131
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDLMOD : Ill'//
- + 'egal path name '//PAT1CT//''')', IARGCD, 0)
-#endif
- GO TO 999
- ENDIF
- NKEYS = IQUEST(7)
- NWKYCK = IQUEST(8)
- IF (NKEYS.GT.0) THEN
- IPNT = KOFSCD + IQUEST(11) + IQUEST(13)
- KPNT = IPNT + (NKEYS-1) * ISTP
- KMAX = IQ(KPNT+IDHINS)
- JMAX = NKEYS
- DO 15 I = 2, NKEYS
- KPNT = KPNT - ISTP
- IF (IQ(KPNT+IDHKSN).GT.KMAX) THEN
- KMAX = IQ(KPNT+IDHINS)
- JMAX = I - 1
- ENDIF
- 15 CONTINUE
- KEY7 = IQ(IPNT+(JMAX-1)*ISTP+IDHINS)
- GO TO 30
- ENDIF
- 20 CONTINUE
- ENDIF
-*
-* *** and get the date
-*
- 30 IRC = 0
- CALL CDUPTM (IDATE, ITIME, KEY7, IRC)
-* END CDLMOD
-* Reset current directory
-*
- 999 CALL RZCDIR(CHTEMP,' ')
- END
diff --git a/src/packlib/hepdb/cdutil/cdlogl.F b/src/packlib/hepdb/cdutil/cdlogl.F
deleted file mode 100644
index 3ea6fc3..0000000
--- a/src/packlib/hepdb/cdutil/cdlogl.F
+++ /dev/null
@@ -1,44 +0,0 @@
-*
-* $Id: cdlogl.F,v 1.1.1.1 1996/02/28 16:24:42 mclareni Exp $
-*
-* $Log: cdlogl.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:42 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDLOGL (CHPATH,LOGL,CHOPT,IRC)
-*
-* Set the RZ loglevel for the specified path (or all if 'A')
-* and the CD loglevel
-*
- CHARACTER*(*) CHPATH
-#include "hepdb/cdcblk.inc"
-#include "hepdb/cinitl.inc"
- CHARACTER TOP*16, TOPN*16, PATH*20
-
-#include "hepdb/hdbopts.inc"
-*
-* ------------------------------------------------------------------
-*
-
- IRC = 0
- LPATH = LENOCC(CHPATH)
- ISTART = 1
- IF(CHPATH(1:2).EQ.'//') ISTART = 3
-*
- LFIXCD = LTOPCD
- 10 IF (LFIXCD.EQ.0) GO TO 20
- NCH = IQ(KOFUCD+LFIXCD+MUPNCH)
- CALL UHTOC (IQ(KOFUCD+LFIXCD+MUPNAM), 4, TOP, NCH)
- IF(IOPTA.NE.0.OR.TOP(1:NCH).EQ.CHPATH(ISTART:LPATH)) THEN
- LUN = IQ(KOFUCD+LFIXCD+MUPLUN)
- CALL RZLOGL (LUN, LOGL)
- ENDIF
- LFIXCD = LQ(KOFUCD+LFIXCD)
- GO TO 10
-*
- 20 CONTINUE
- IDEBCD = LOGL
-* END CDLOGL
- 999 END
diff --git a/src/packlib/hepdb/cdutil/cdls.F b/src/packlib/hepdb/cdutil/cdls.F
deleted file mode 100644
index e592be3..0000000
--- a/src/packlib/hepdb/cdutil/cdls.F
+++ /dev/null
@@ -1,328 +0,0 @@
-*
-* $Id: cdls.F,v 1.2 1999/08/17 12:42:39 mclareni Exp $
-*
-* $Log: cdls.F,v $
-* Revision 1.2 1999/08/17 12:42:39 mclareni
-* Y2k mods submitted by Rob Komar
-*
-* Revision 1.1.1.1 1996/02/28 16:24:39 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDLS(CHPATH,IRC)
-
- CHARACTER*(*) CHPATH
- CHARACTER*80 CHLINE
-#include "hepdb/nwpaw.inc"
- COMMON /PAWC/ NWPAWC,IXPAWC,IHBOOK,IXHIGZ,IXKU,IFENCE(5)
- +, LMAIN, IPAW(NWPAW)
-#include "zebra/zunit.inc"
-#include "zebra/rzcl.inc"
-#include "zebra/rzdir.inc"
-#include "zebra/rzch.inc"
-#include "zebra/rzk.inc"
- DIMENSION IHTAG(2)
- CHARACTER*8 CHTAG(KNMAX)
- DIMENSION KEYS(KNMAX),KEYT(KNMAX)
- CHARACTER*36 CHOPT
- CHARACTER*4 CHID
- INTEGER IDATE,ITIME
- INTEGER MIDATE,MIDAT,MJDAT
- PARAMETER (JBIAS=2)
- DIMENSION MINVAL(10),MAXVAL(10)
-#include "hepdb/cdtime.inc"
-#include "hepdb/cdkeys.inc"
-#include "hepdb/ckkeys.inc"
-#include "hepdb/cdunit.inc"
-#include "hepdb/cdulnk.inc"
-#include "hepdb/hdbkeys.inc"
-#include "hepdb/cdlscm.inc"
-#include "hepdb/hdbopt.inc"
-#include "hepdb/hdboptd.inc"
-#include "zebra/q_jbit.inc"
-* Ignoring t=pass
- CHOPT = CHOPTT
-#include "hepdb/hdboptc.inc"
-*
-* C - display object count
-* D - display key definitions
-* E - display the experiment keys
-* G - display keys using generic routine (RZPRNK)
-* K - display all keys
-* L - list only lowest level (end node) directories (D)
-* M - show maxima and minima of validity ranges
-* N - display number of data words
-* P - display pathname (D)
-* S - display the system keys
-* T - display insertion date and time (RZ value)
-* U - display user keys
-* V - display validity range pairs
-* Z - dump ZEBRA bank with DZSHOW.
-*
- IRC = 0
-
- LPATH = LENOCC(CHPATH)
- IDATE = 0
- ITIME = 0
- NSHOW = 0
-
-*
-* Use modified Window dates such that post-millenium dates are
-* larger than pre-millenium dates.
-*
- IF(IDATCD.GT.350000) THEN
- MIDAT = IDATCD
- ELSE IF(IDATCD.EQ.0) THEN
- MIDAT = 0
- ELSE
- MIDAT = IDATCD + 1000000
- ENDIF
- IF(JDATCD.GT.350000) THEN
- MJDAT = JDATCD
- ELSE IF(JDATCD.EQ.0) THEN
- MJDAT = 0
- ELSE
- MJDAT = JDATCD + 1000000
- ENDIF
-
- DO 10 I=1,NPAICD
- MINVAL(I) = 999999999
- MAXVAL(I) = -999999999
- 10 CONTINUE
-*
-* Bump directory & object count
-*
- NOBJ = IQ(LCDIR+KQSP+KNKEYS)
- NWKEY = IQ(LCDIR+KQSP+KNWKEY)
- NDIRT = NDIRT + 1
- NOBJT = NOBJT + NOBJ
-*
-* Lowest level directory?
-*
- IF(IOPTL.NE.0.AND.IQ(KQSP+LCDIR+KNSD).NE.0) RETURN
-*
-* Keys
-*
- IF(IOPTK.NE.0) THEN
- IOPTE = 1
- IOPTS = 1
- IOPTU = 1
- IOPTV = 1
- ENDIF
-
- WRITE(LOUTCD,*)
-*
-* Pathname
-*
- IF(IOPTP.NE.0) WRITE(LOUTCD,*) 'Directory: ',CHPATH(1:LPATH)
-*
-* Get tags
-*
- NWKEY=IQ(KQSP+LCDIR+KNWKEY)
- KTAGS=KKDES+(NWKEY-1)/10+1
- DO 20 J=1,NWKEY
- CALL ZITOH(IQ(KQSP+LCDIR+KTAGS+2*J-2),IHTAG,2)
- CALL UHTOC(IHTAG,4,CHTAG(J),8)
- 20 CONTINUE
-*
-* Select and display specified objects
-*
- IF(IOPTC.NE.0) WRITE(LOUTCD,*) 'Objects : ',NOBJ
-*
-* Key definitions
-*
- IF(IOPTD.NE.0) THEN
- WRITE(LOUTCD,*) ' Tags :'
- WRITE(LOUTCD,9001) (CHTAG(J),J=1,NWKEY)
- 9001 FORMAT(8(2X,A8))
- ENDIF
-
- LK = IQ(KQSP+LCDIR+KLK)
-*
-* Loop over objects
-*
- DO 60 I=1,NOBJ
-*
-* Extract KEYS vector for this object
-*
- K = LK+(NWKEY+1)*(I-1)
-*
-* Selection on key serial number
-*
- IF(IOPTM.EQ.0.AND.
- + NKEYSN.NE.0.AND.IQ(KQSP+LCDIR+K+1).NE.NKEYSN) GOTO 60
- DO 30 J=1,NWKEY
- IKDES=(J-1)/10
- IKBIT1=3*J-30*IKDES-2
- IKTYPE = JBYT(IQ(KQSP+LCDIR+KKDES+IKDES),IKBIT1,3)
- KEYT(J) = IKTYPE
- IF(IKTYPE.LT.3)THEN
- KEYS(J)=IQ(KQSP+LCDIR+K+J)
- ELSE
- CALL ZITOH(IQ(KQSP+LCDIR+K+J),KEYS(J),1)
- ENDIF
- 30 CONTINUE
-*
-* Selection on validity ranges
-*
- J = 0
- DO 40 K=KOFVAL,NSYSCK,2
- J = J + 1
- IF(KEYS(K) .LT.MINVAL(J)) MINVAL(J) = KEYS(K)
- IF(KEYS(K+1).GT.MAXVAL(J)) MAXVAL(J) = KEYS(K+1)
- 40 CONTINUE
-*
-* Selection on key serial number
-*
- IF(NKEYSN.NE.0.AND.KEYS(1).NE.NKEYSN) GOTO 60
-*
-* Selection on insertion date and time
-*
- CALL CDUPTM(IDATE,ITIME,KEYS(KOFINS),IRC)
- IF(IDATE.GT.350000) THEN
- MIDATE = IDATE
- ELSE IF(IDATE.EQ.0) THEN
- MIDATE = 0
- ELSE
- MIDATE = IDATE + 1000000
- ENDIF
-*
-* Insertion date outside range
-* (fixed to include post-millenium dates)
-*
- IF(MIDATE.LT.MIDAT.OR.
- + (MIDATE.GT.MJDAT.AND.MJDAT.NE.0)) GOTO 60
-*
-* Insertion date matches - check insertion time
-*
- IF(IDATE.EQ.IDATCD) THEN
- IF(ITIME.LT.ITIMCD) GOTO 60
- IF(ITIME.GT.JTIMCD.AND.JTIMCD.NE.0) GOTO 60
- ENDIF
-
- IF(IOPTZ.NE.0) THEN
- CALL RZIN(IXPAWC,LINK01,JBIAS,KEYS,ICYCLE,' ')
- CALL UHTOC(IQ(KQSP+LINK01-4),4,CHID,4)
-*
-* Check bank name
-*
- LNAME = LENOCC(CHBANK)
- IF(LNAME.EQ.0.OR.CHBANK.EQ.CHID) THEN
- CALL DZSHOW('HEPDB',IXPAWC,LINK01,'LV',ILNK1,ILNK2,
- + IDAT1,IDAT2)
- NOBJM = NOBJM + 1
- ENDIF
- CALL MZDROP(IXPAWC,LINK01,'L')
- LINK01 = 0
- ELSE
- NOBJM = NOBJM + 1
- ENDIF
-*
-* Pointer to cycles
-*
- LKC=LK+(NWKEY+1)*(I-1)
- LCYC=IQ(KQSP+LCDIR+LKC)
-*
-* Generic
-*
- IF(IOPTG.NE.0) THEN
- IQPRSV = IQPRNT
- IQPRNT = LOUTCD
- ICYC = JBYT(IQ(KQSP+LCDIR+LCYC+3),21,12)
- CALL RZPRNK(CHPATH,I,ICYC,' ')
- IQPRNT = IQPRSV
- ENDIF
-*
-* System keys
-*
- IF(IOPTS.NE.0) THEN
-*
-* Unpack insertion time
-*
- WRITE(LOUTCD,9002) (CHTAG(K),KEYS(K),K=KOFSYS,KOFPTR),
- + CHTAG(KOFFLG),KEYS(KOFFLG), CHTAG(KOFINS),IDATE,ITIME,
- + CHTAG(KOFSY1),KEYS(KOFSY1)
- 9002 FORMAT(' System keys: ',2(A8,1X,I11,1X),A8,1X,Z8/
- + 18X,A8,1X,I6,1X,I4,1X,A8,1X,I11)
- ENDIF
-*
-* Experiment keys
-*
- IF(IOPTE.NE.0) THEN
- WRITE(LOUTCD,9003) (CHTAG(K),KEYS(K),K=KOFEXP, KOFEXP+
- + NOFEXP-1)
- 9003 FORMAT(' Experiment keys: ',3(A8,1X,I11,1X)/
- + ' ',2(A8,1X,I11,1X))
- ENDIF
-*
-* Validity range pairs
-*
- IF(IOPTV.NE.0) THEN
- WRITE(LOUTCD,9004) (CHTAG(K),KEYS(K),K=KOFVAL,NSYSCK)
- 9004 FORMAT(' Validity pairs : ',2(A8,1X,I11,1X)/
- + (' ',2(A8,1X,I11,1X)))
- ENDIF
-*
-* User keys
-*
- KOFUSR = NSYSCK + 1
- IF(IOPTU.NE.0) THEN
- IF(KOFUSR.LE.NWKEY) THEN
-* WRITE(LOUTCD,9005) (CHTAG(K),KEYS(K),K=KOFUSR,NWKEY)
-*9005 FORMAT(' User keys : ',2(A8,1X,I11,1X)/
-* + (' ',2(A8,1X,I11,1X)))
- CHLINE = ' User keys : '
- IOFF = 19
- DO 50 K=KOFUSR,NWKEY
- IF(KEYT(K).LT.3) THEN
- WRITE(CHLINE(IOFF:),'(A8,1X,I11)') CHTAG(K),
- + KEYS(K)
- ELSE
- WRITE(CHLINE(IOFF:),'(A8)') CHTAG(K)
- CALL UHTOC(KEYS(K),4,CHLINE(IOFF+10:),4)
- ENDIF
- IOFF = IOFF + 21
- IF(IOFF.GT.60) THEN
- WRITE(LOUTCD,'(A)') CHLINE(1:IOFF-1)
- CHLINE = ' '
- IOFF = 19
- ENDIF
- 50 CONTINUE
- IF(IOFF.GT.19) WRITE(LOUTCD,'(A)') CHLINE(1:IOFF-1)
- ELSE
- IF(NSHOW.EQ.0) THEN
- WRITE(LOUTCD,9005) CHPATH(1:LPATH)
- 9005 FORMAT(' No user keys in directory : ',A)
- NSHOW = 1
- ENDIF
- ENDIF
- ENDIF
-*
-* Number of data words
-*
- IF(IOPTN.NE.0) THEN
- NW = JBYT(IQ(KQSP+LCDIR+LCYC+3),1,20)
- WRITE(LOUTCD,*) '# words : ',NW
- ENDIF
-*
-* Insertion date & time
-*
- IF(IOPTT.NE.0) THEN
- CALL RZDATE(IQ(KQSP+LCDIR+LCYC+1),IDATE,ITIME,1)
- WRITE(LOUTCD,*) 'Inserted : ',IDATE,ITIME
- ENDIF
-
- 60 CONTINUE
-
- IF(IOPTM.NE.0) THEN
- DO 70 I=1,NPAICD
- WRITE(LOUTCD,9006) I,MINVAL(I),MAXVAL(I)
- 9006 FORMAT(' Minimum/maximum values for validity pair # ',I3,
- + ' = ',I10,' / ',I10)
- 70 CONTINUE
-
- ENDIF
-
- END
-
diff --git a/src/packlib/hepdb/cdutil/cdlupp.F b/src/packlib/hepdb/cdutil/cdlupp.F
deleted file mode 100644
index 615c19c..0000000
--- a/src/packlib/hepdb/cdutil/cdlupp.F
+++ /dev/null
@@ -1,35 +0,0 @@
-*
-* $Id: cdlupp.F,v 1.1.1.1 1996/02/28 16:24:44 mclareni Exp $
-*
-* $Log: cdlupp.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:44 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDLUPP(CHTOP,CHPATH,ID,IT,IRC)
- CHARACTER*(*) CHTOP,CHPATH
- CHARACTER*6 TOPDIR
-#include "hepdb/cdlupc.inc"
- EXTERNAL CDLUPU
-
- IRC = 0
- IDMAXU = 0
- ITMAXU = 0
- CHDIRU = ' '
-
- LTOP = LENOCC(CHTOP)
- IF(LTOP.EQ.2) THEN
- WRITE(TOPDIR,9001) CHTOP(1:LTOP)
-9001 FORMAT('//CD',A2)
- ELSEIF(LTOP.EQ.4) THEN
- WRITE(TOPDIR,9002) CHTOP(1:LTOP)
-9002 FORMAT('//',A4)
- ELSE
- TOPDIR = CHTOP
- ENDIF
-
- CALL CDSCAN(TOPDIR,99,CDLUPU,IRC)
-
- END
-
diff --git a/src/packlib/hepdb/cdutil/cdlupu.F b/src/packlib/hepdb/cdutil/cdlupu.F
deleted file mode 100644
index 74ad8b4..0000000
--- a/src/packlib/hepdb/cdutil/cdlupu.F
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: cdlupu.F,v 1.1.1.1 1996/02/28 16:24:44 mclareni Exp $
-*
-* $Log: cdlupu.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:44 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDLUPU(CHPATH,IRC)
- CHARACTER*(*) CHPATH
-#include "hepdb/quest.inc"
-#include "hepdb/cdlupc.inc"
-
- IF(IQUEST(14).EQ.0) RETURN
- CALL CDLMOD(CHPATH,ID,IT,' ',IRC)
-
- IF(ID.GT.IDMAXU) THEN
- IDMAXU = ID
- ITMAXU = IT
- CHDIRU = CHPATH(1:LENOCC(CHPATH))
- ELSEIF(ID.EQ.IDMAXU.AND.IT.GT.ITMAXU) THEN
- ITMAXU = IT
- CHDIRU = CHPATH(1:LENOCC(CHPATH))
- ENDIF
-
- END
diff --git a/src/packlib/hepdb/cdutil/cdmovf.F b/src/packlib/hepdb/cdutil/cdmovf.F
deleted file mode 100644
index fda15df..0000000
--- a/src/packlib/hepdb/cdutil/cdmovf.F
+++ /dev/null
@@ -1,81 +0,0 @@
-*
-* $Id: cdmovf.F,v 1.1.1.1 1996/02/28 16:24:44 mclareni Exp $
-*
-* $Log: cdmovf.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:44 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDMOVF(CHOLD,CHNEW,CHOPT,IRC)
- CHARACTER*(*) CHOLD,CHNEW
- CHARACTER*80 CHLINE,CHTYPE,CHDEV,CHLOG
-#include "hepdb/hdbopts.inc"
-
- IRC = 0
-
-* Move file from CHOLD to CHNEW.
-* If IOPTK = 0 then CHOLD will be deleted
-
-#if defined(CERNLIB_VAXVMS)
-
- ISTAT = LIB$GET_LUN(LUNIN)
- IF(.NOT.ISTAT) CALL LIB$SIGNAL(%VAL(ISTAT))
- ISTAT = LIB$GET_LUN(LUNOU)
- IF(.NOT.ISTAT) CALL LIB$SIGNAL(%VAL(ISTAT))
-
- LOLD = LENOCC(CHOLD)
- LNEW = LENOCC(CHNEW)
-
- CHTYPE = 'VARIABLE'
- ICOLON = INDEX(CHNEW(1:LNEW),':')
- IF(ICOLON.NE.0) THEN
- CHDEV = CHNEW(1:ICOLON-1)
- CALL CLTOU(CHDEV(1:ICOLON-1))
- CALL CDGTLG(CHDEV,CHLOG,'LNM$SYSTEM',IRC)
-#endif
-#if (defined(CERNLIB_VAXVMS))&&(defined(CERNLIB_UCX))
- IF(IRC.EQ.0.AND.INDEX(CHLOG,'DNFS').NE.0)
- + CHTYPE='STREAM_LF'
-#endif
-#if (defined(CERNLIB_VAXVMS))&&(!defined(CERNLIB_UCX))
- IF(IRC.EQ.0.AND.INDEX(CHLOG,'_NFS').NE.0)
- + CHTYPE='STREAM_LF'
-#endif
-#if defined(CERNLIB_VAXVMS)
-
- ENDIF
-
- OPEN(LUNIN,ACCESS='SEQUENTIAL',STATUS='OLD',
- + FILE=CHOLD(1:LOLD),
- + FORM='FORMATTED',IOSTAT=IRC)
- IF(IRC.NE.0) GOTO 99
-
- OPEN(LUNOU,ACCESS='SEQUENTIAL',STATUS='NEW',
- + FILE=CHNEW(1:LNEW),
- + RECORDTYPE=CHTYPE,
- + FORM='FORMATTED',IOSTAT=IRC)
- IF(IRC.NE.0) GOTO 99
-
-10 CONTINUE
-
- READ(LUNIN,'(A)',END=90) CHLINE
- LLINE = LENOCC(CHLINE)
- WRITE(LUNOU,'(A)') CHLINE(1:LLINE)
- GOTO 10
-
-90 CONTINUE
- IF(IOPTK.EQ.0) THEN
- CLOSE(LUNIN,STATUS='DELETE')
- ELSE
- CLOSE(LUNIN)
- ENDIF
- CLOSE(LUNOU)
-
- ISTAT = LIB$FREE_LUN(LUNIN)
- IF(.NOT.ISTAT) CALL LIB$SIGNAL(%VAL(ISTAT))
- ISTAT = LIB$FREE_LUN(LUNOU)
- IF(.NOT.ISTAT) CALL LIB$SIGNAL(%VAL(ISTAT))
-#endif
-99 CONTINUE
- END
diff --git a/src/packlib/hepdb/cdutil/cdmtch.F b/src/packlib/hepdb/cdutil/cdmtch.F
deleted file mode 100644
index 28edf52..0000000
--- a/src/packlib/hepdb/cdutil/cdmtch.F
+++ /dev/null
@@ -1,295 +0,0 @@
-*
-* $Id: cdmtch.F,v 1.1.1.1 1996/02/28 16:24:37 mclareni Exp $
-*
-* $Log: cdmtch.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:37 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDMTCH(CHFILE,CHMTCH,IRC)
-#include "hepdb/cdunit.inc"
-#include "hepdb/quest.inc"
-*
-* This routine performs wild card file name matching
-* a la VM/CMS (FILELIST/LISTFILE) and VAX/VMS (DIRECTORY)
-* Thus: % corresponds to a single arbitrary character,
-* * corresponds to n (n>=0) arbitrary characters
-* Numeric ranges are also supported, thus (9:12) will
-* match strings 09,10,11,12.
-*
-* IRC = 1 - trailing unmatched characters in MATCH
-* IQUEST(1)-IQUEST(2) first/last unmatched characters
-* 2 - trailing unmatched characters in FILE
-* IQUEST(1)-IQUEST(2) first/last unmatched characters
-* 3 - substring mismatch
-* IQUEST(1)-IQUEST(2) first/last characters of substring in FILE
-* IQUEST(3)-IQUEST(4) first/last characters of substring in MATCH
-* 4 - cannot find character
-* IQUEST(1)-IQUEST(2) character in MATCH
-* IQUEST(3)-IQUEST(4) substring of FILE being searched
-* 5 - range mismatch
-* 6 - character mismatch
-* IQUEST(1) - character in FILE
-* IQUEST(2) - character in MATCH
-*
- COMMON /SLATE/ NDSLAT,NESLAT, DUMMY(38)
- CHARACTER*(*) CHFILE,CHMTCH
- CHARACTER*255 FILE,MATCH
- CHARACTER*10 CHLOW,CHHIGH,CHMAT
- CHARACTER*3 WILD
- DATA WILD/'%*('/
-
- ILOW = 0
- IHIGH = 0
- ISTART = 0
- JSTART = 0
- IRC = 0
- MATCH = ' '
- FILE = ' '
- IEND = LENOCC(CHMTCH)
- JEND = LENOCC(CHFILE)
- MATCH = CHMTCH(1:IEND)
- FILE = CHFILE(1:JEND)
-*
-* Convert <> characters to *
-*
- IF(ICFMUL('<>',MATCH,1,IEND).LE.IEND) THEN
- IF(LLOGCD.GE.3) PRINT *,
- + 'CDMTCH. translating <> characters to *'
- CALL CTRANS('<','*',MATCH,1,IEND)
- CALL CTRANS('>','*',MATCH,1,IEND)
- ENDIF
-*
-* Convert [] to ()
-*
- CALL CTRANS('[','(',MATCH,1,IEND)
- CALL CTRANS(']',')',MATCH,1,IEND)
-*
-* Remove multiple *'s
-*
- NESLAT = IEND
- CALL CSQMCH(MATCH,'*',1,IEND)
- IF(NESLAT.LT.IEND) IEND = NESLAT
- IF(LLOGCD.GE.3) PRINT *,'CDMTCH. Compare ',MATCH(1:IEND),
- + ' against ',FILE(1:JEND)
-
- IF(MATCH(1:IEND).EQ.FILE(1:JEND)) RETURN
-*
-* Process all characters in FILE
-*
-10 CONTINUE
-*
-* Have reached the end of both match and file and all is ok
-*
- IF((ISTART.EQ.IEND).AND.(JSTART.EQ.JEND)) RETURN
- ISTART = ISTART + 1
- JSTART = JSTART + 1
-*
-* Have processed all characters in FILE...
-*
- IF(JSTART.GT.JEND) THEN
-*
-* but there are unmatched characters in MATCH...
-*
- IF(ISTART.LE.IEND) THEN
- IF(LLOGCD.GE.3) PRINT *,'CDMTCH. MATCH contains ',
- + 'trailing unmatched characters - ',MATCH(ISTART:IEND)
- IRC = 1
- IQUEST(1) = ISTART
- IQUEST(2) = IEND
- GOTO 99
- ENDIF
- ENDIF
-*
-* Have processed all characters in MATCH and all compare
-*
- IF(ISTART.GT.IEND) THEN
-*
-* but FILE is longer than MATCH...
-*
- IF(ISTART.LE.JEND) THEN
- IF(LLOGCD.GE.3) PRINT *,'CDMTCH. FILE contains ',
- + 'trailing unmatched characters - ',FILE(JSTART:JEND)
- IRC = 2
- IQUEST(1) = JSTART
- IQUEST(2) = JEND
- GOTO 99
- ENDIF
- ENDIF
-*
-* Look down MATCH for a * or %
-*
- IX = ICFMUL(WILD,MATCH,ISTART,IEND)
- IF(IX.GT.IEND) IX = 0
-*
-* Match any characters up until first wild card
-*
- IF(IX.GT.ISTART) THEN
- LWORD = IX - ISTART - 1
- IF(FILE(JSTART:JSTART+LWORD).NE.
- + MATCH(ISTART:ISTART+LWORD)) THEN
- IF(LLOGCD.GE.4) PRINT *,'CDMTCH. substring mismatch ',
- + FILE(JSTART:JSTART+LWORD),' ',
- + MATCH(ISTART:ISTART+LWORD)
- IRC = 3
- IQUEST(1) = JSTART
- IQUEST(2) = JSTART + LWORD
- IQUEST(3) = ISTART
- IQUEST(4) = ISTART + LWORD
- GOTO 99
- ENDIF
- ISTART = ISTART + LWORD
- JSTART = JSTART + LWORD
- GOTO 10
- ENDIF
-
- IF(MATCH(IX:IX).EQ.'*') THEN
-*
-* Current character is a *
-* Find first non-wild character in MATCH and find
-* in FILE.
-*
- IF(IX.EQ.IEND) RETURN
- DO 20 I=ISTART+1,IEND
- IF((MATCH(I:I).NE.'*').AND.(MATCH(I:I).NE.'%') .AND.
- + (MATCH(I:I).NE.'(')) GOTO 30
-20 CONTINUE
-*
-* MATCH only contains * followed by other wild-cards - ok
-*
- IF(LLOGCD.GT.3)
- + PRINT *,'CDMTCH. Match pattern contains only wild-cards'
- RETURN
-30 CONTINUE
-*
-* Look for current word in FILE and reset JSTART
-* Word is delimited by two wild-chars or end of string.
-*
- IWILD = ICFMUL(WILD,MATCH,I,IEND)
- IF(IWILD.LE.IEND) THEN
- II = IWILD - 1
- ELSE
- II = IEND
- ENDIF
-* II = MIN(IEND,ICFMUL(WILD,MATCH,I,IEND))
-* JFIND = INDEX(FILE(JSTART:JEND),MATCH(I:I))
- JFIND = INDEX(FILE(JSTART:JEND),MATCH(I:II))
- IF(JFIND.EQ.0) THEN
-* IF(LLOGCD.GE.4) PRINT *,'CDMTCH. cannot find ',MATCH(I:I),
- IF(LLOGCD.GE.4) PRINT *,'CDMTCH. cannot find ',MATCH(I:II),
- + ' in ',FILE(JSTART:JEND)
- IRC = 4
- IQUEST(1) = I
- IQUEST(2) = II
- IQUEST(3) = JSTART
- IQUEST(4) = JEND
- GOTO 99
- ENDIF
-
- ISTART = I
- JSTART = JSTART+JFIND-1
- GOTO 10
-
- ELSEIF(MATCH(IX:IX).EQ.'%') THEN
-*
-* Current character is a %
-*
- ELSEIF(MATCH(IX:IX).EQ.'(') THEN
-*
-* Found a range delimiter
-*
- IF(LLOGCD.GT.3)
- + PRINT *,'CDMTCH. range encountered in MATCH pattern'
- IBRA = INDEX(MATCH(IX:IEND),')')
- IF(IBRA.EQ.0) THEN
- IF(LLOGCD.GE.-3) PRINT *,'CDMTCH. no trailing delimiter',
- + ' for range pattern'
- IRC = -4
- RETURN
- ENDIF
-
- ICOL = INDEX(MATCH(IX:IEND),':')
- IF(ICOL.EQ.0) THEN
- IF(LLOGCD.GE.-3) PRINT *,'CDMTCH. missing colon in ',
- + 'range pattern'
- IRC = -4
- RETURN
- ENDIF
-
- CHLOW = MATCH(IX+1:IX+ICOL-2)
- CHHIGH = MATCH(IX+ICOL:IX+IBRA-2)
- LNHIGH = LENOCC(CHHIGH)
-
- IF(IX+IBRA.LT.IEND) THEN
- IF(LLOGCD.GE.4)
- + PRINT *,'Looking for ',MATCH(IX+IBRA:IX+IBRA),' in ',
- + FILE(JSTART:JEND)
- LNMAT = INDEX(FILE(JSTART:JEND),
- + MATCH(IX+IBRA:IX+IBRA))
- IF(LNMAT.EQ.0) THEN
- IF(LLOGCD.GE.3) PRINT *,'CDMTCH. no match after',
- + ' range pattern'
- IRC = -4
- RETURN
- ENDIF
- LNMAT = LNMAT - 1
- ELSE
- LNMAT = LNHIGH
- ENDIF
-*
-* Extend CHLOW on the left with blanks
-*
- CALL CRIGHT(CHLOW,1,LNHIGH)
-*
-* And convert to zeroes
-*
- CALL CTRANS(' ','0',CHLOW,1,LNHIGH)
- LNLOW = LNHIGH
- IF(LLOGCD.GT.3)
- + PRINT *,'CDMTCH. range = ',CHLOW,' to ',CHHIGH
- CHMAT = FILE(JSTART:JSTART+LNMAT-1)
-*
-* Extend CHMAT on the left with blanks
-*
- CALL CRIGHT(CHMAT,1,LNHIGH)
-*
-* And convert to zeroes
-*
- CALL CTRANS(' ','0',CHMAT,1,LNHIGH)
- IF(LLOGCD.GT.3)
- + PRINT *,'CDMTCH. match = ',CHMAT
- IF(LLT(CHMAT(1:LNHIGH),CHLOW(1:LNLOW)) .OR.
- + LGT(CHMAT(1:LNHIGH),CHHIGH(1:LNHIGH))) THEN
- IF(LLOGCD.GE.4) PRINT *,'CDMTCH. range mismatch ',
- + 'CHLOW/CHHIGH/CHMAT = ',CHLOW(1:LNLOW),
- + ' ',CHHIGH(1:LNHIGH),' ',CHMAT(1:LNHIGH)
- IRC = 5
- GOTO 99
- ENDIF
-
- ISTART = ISTART + IBRA - 1
-* JSTART = JSTART + LNHIGH - 1
- JSTART = JSTART + LNMAT - 1
- GOTO 10
-
- ELSE
-*
-* Current character is a not a wild card
-*
- IF(FILE(JSTART:JSTART).NE.MATCH(ISTART:ISTART)) THEN
- IF(LLOGCD.GT.3) PRINT *,'CDMTCH. mismatch at ',
- + FILE(JSTART:JSTART),JSTART,MATCH(ISTART:ISTART),ISTART
- IRC = 6
- IQUEST(1) = ISTART
- IQUEST(2) = JSTART
- GOTO 99
- ENDIF
-
- ENDIF
-
- GOTO 10
-
-99 CONTINUE
- END
-
diff --git a/src/packlib/hepdb/cdutil/cdnwrd.F b/src/packlib/hepdb/cdutil/cdnwrd.F
deleted file mode 100644
index 0a1284a..0000000
--- a/src/packlib/hepdb/cdutil/cdnwrd.F
+++ /dev/null
@@ -1,35 +0,0 @@
-*
-* $Id: cdnwrd.F,v 1.1.1.1 1996/02/28 16:24:40 mclareni Exp $
-*
-* $Log: cdnwrd.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:40 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDNWRD(DELIM,SOURCE,IRC)
- CHARACTER*(*) SOURCE,DELIM
- IRC = 0
-*
-* Find the number of words in SOURCE delimited by DELIM
-*
- IR = LENOCC(SOURCE)
-* If string is non-blank, at least one word exists...
- IF(IR.EQ.0) THEN
- IRC = -1
- RETURN
- ENDIF
-
- IRC = 1
- IL = 1
- IC = 1
-10 CONTINUE
- IL = INDEX(SOURCE(IC:IR),DELIM)
- IF(IL.EQ.0) GOTO 99
- IC = IC + IL
- IL = IL + 1
- IRC = IRC + 1
- IF(IC.GE.IR) GOTO 99
- GOTO 10
-
-99 END
diff --git a/src/packlib/hepdb/cdutil/cdobjx.F b/src/packlib/hepdb/cdutil/cdobjx.F
deleted file mode 100644
index 29717ba..0000000
--- a/src/packlib/hepdb/cdutil/cdobjx.F
+++ /dev/null
@@ -1,49 +0,0 @@
-*
-* $Id: cdobjx.F,v 1.1.1.1 1996/02/28 16:24:38 mclareni Exp $
-*
-* $Log: cdobjx.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:38 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDOBJX(PATH,IRC)
-*
- CHARACTER*(*) PATH
-#include "hepdb/cdunit.inc"
-#include "hepdb/quest.inc"
-#include "hepdb/cdoccm.inc"
- LPATH = LENOCC(PATH)
-*
-* Bump directory count
-*
- NDIRT = NDIRT + 1
- NFIL = 0
- IRC = 0
-*
-* Get number of directories below CWD (filled by CDSCAN)
-*
- NDIR = IQUEST(12)
- NFIL = IQUEST(14)
- NFOUND = NFOUND + NFIL
-*
-* Display only empty (zero files) directories
-*
- IF((IOPTZ.NE.0).AND.(NFIL.NE.0)) RETURN
-*
-* Display only lowest level directories
-*
- IF((IOPTL.NE.0).AND.(NDIR.NE.0)) RETURN
-
- IF((IOPTD.NE.0).OR.(IOPTF.NE.0)) THEN
- WRITE(LOUTCD,*)
- WRITE(LOUTCD,*) 'Directory: ',PATH(1:LPATH)
- ENDIF
-
- IF(IOPTD.NE.0) WRITE(LOUTCD,*) ' subdirectories: ',NDIR
-*
-* Number of objects
-*
- IF(IOPTF.NE.0) WRITE(LOUTCD,*) ' objects: ',NFIL
-
- END
diff --git a/src/packlib/hepdb/cdutil/cdopnf.F b/src/packlib/hepdb/cdutil/cdopnf.F
deleted file mode 100644
index 7ebc6df..0000000
--- a/src/packlib/hepdb/cdutil/cdopnf.F
+++ /dev/null
@@ -1,332 +0,0 @@
-*
-* $Id: cdopnf.F,v 1.1.1.1 1996/02/28 16:24:42 mclareni Exp $
-*
-* $Log: cdopnf.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:42 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDOPNF(LUN,FILEN,LRECL,CHOPT,IRC)
- CHARACTER*(*) FILEN
- CHARACTER*80 FNAME,CHNAME
- CHARACTER*80 MVSDSN
- CHARACTER*12 CHFORM
- CHARACTER*8 CHSTAT,CHREC,CHTYPE
- CHARACTER*80 FILEDEF
-#include "hepdb/cduscm.inc"
-*
-* JBYTES: conversion factor for open statement
-* RECL = lrecl / jbytes
-*
-* On most machines, the record length is specified in bytes
-* except VAX: bytes for unformatted files, 4-byte words otherwise
-* SGI: 4-byte words
-* DECS: 4-byte words
-* Windows/NT: 4-byte words (with DEC Fortran only, 1-byte for F2C version)
-*
-*
-#if defined(CERNLIB_SGI)||defined(CERNLIB_DECS)
- PARAMETER (JBYTES=4)
-#endif
-#if (defined(CERNLIB_WINNT))&&(!defined(CERNLIB_F2C))
- PARAMETER (JBYTES=4)
-#endif
-#if (!defined(CERNLIB_SGI))&&(!defined(CERNLIB_DECS))&&(!defined(CERNLIB_WINNT))
- PARAMETER (JBYTES=1)
-#endif
-#if defined(CERNLIB_IBMMVS)
- CHARACTER*3 CHRECFM
- CHARACTER*10 CHACTION
- LOGICAL OPN,EXS
-#endif
-#if defined(CERNLIB_IBMVM)
- CHARACTER*20 CHGIME
- CHARACTER*80 CHLINE
- CHARACTER*1 MODE
-#endif
- LOGICAL IEXIST
-#include "hepdb/quest.inc"
-*
-* Open file on unit LUN.
-* CHOPT: C - respect case
-* D - D/A file, LRECL must be specified if N is also given
-* I - open for input
-* O - open for output
-*--> R - RELATIVE organisation (VAX only) <-- Not yet implemented!
-* P - PAM file format
-* F - formatted file (default=unformatted)
-* N - new file
-* V - variable length records (do not specify RECFM=variable on VAX)
-*
-* Return codes: 28 - file already exists & New specified
-* 1 - open failed - IOSTAT in IQUEST(1)
-*
-#include "hepdb/hdbopts.inc"
- IF((IOPTI.EQ.0).AND.(IOPTO.EQ.0)) IOPTI=1
- IRC = 0
- LF = LENOCC(FILEN)
- FNAME = FILEN(1:LF)
-#if defined(CERNLIB_IBMVM)
-*
-* Crack <user.addr>fn.ft
-*
- IF((INDEX(FNAME(1:LF),'<').NE.0).OR.
- + (INDEX(FNAME(1:LF),'[').NE.0)) THEN
- CALL CTRANS('[','<',FNAME,1,LF)
- CALL CTRANS(']','>',FNAME,1,LF)
- ISTART = INDEX(FNAME(1:LF),'<') + 1
- IEND = INDEX(FNAME(1:LF),'>') - 1
- ICOL = INDEX(FNAME(1:LF),':')
-*
-* SFS?
-*
- IF(ICOL.EQ.0) THEN
- CHGIME = FNAME(ISTART:IEND)
- IDOT = INDEX(CHGIME,'.')
- IF(IDOT.NE.0) CHGIME(IDOT:IDOT) = ' '
- LCHG = IEND - ISTART + 1
- ELSE
- CHGIME = FNAME(1:ICOL) // FNAME(ISTART:IEND)
- LCHG = IEND - ISTART + 1 + ICOL
- ENDIF
- CALL VMCMS(CHGIME(1:LCHG)//' (QUIET NONOTICE STACK)',IRC)
-
- IF(IRC.GT.4) RETURN
-
- CALL VMRTRM(CHLINE,LENGTH)
- MODE = CHLINE(1:1)
- FNAME = FILEN(IEND+2:LF) // ' ' // MODE
- LF = LF + 2
- ENDIF
-
- IF(INDEX(FNAME(1:LF),'/').EQ.0) THEN
- FNAME = '/'//FILEN(1:LF)
- LF = LF + 1
- ENDIF
-
- DO 1 I=1,LF
- 1 IF(FNAME(I:I).EQ.'.') FNAME(I:I) = ' '
-*
-* If file exists, find full name and hence file mode
-*
- INQUIRE(FILE=FNAME(1:LF),EXIST=IEXIST,NAME=CHNAME)
- LMODE = LENOCC(CHNAME)
- IF(IEXIST) MODE = CHNAME(LMODE:LMODE)
-
-#endif
-#if defined(CERNLIB_UNIX)
- IF(IOPTC.EQ.0) CALL CUTOL(FNAME)
-#endif
-#if defined(CERNLIB_IBMMVS)
- CHACTION = 'READWRITE'
- IF(IOPTI.NE.0) CHACTION = 'READ'
- IF(IOPTO.NE.0) CHACTION = 'WRITE'
- CALL XZMVSD(FILEN(1:LF),MVSDSN,LF,ICUT,IRC)
- FNAME = MVSDSN
- FNAME(1:1) = '/'
-#endif
- CHSTAT = 'UNKNOWN'
- IF(IOPTN.NE.0) THEN
- CHSTAT = 'NEW'
- IOPTO = 1
-#if !defined(CERNLIB_VAXVMS)
- INQUIRE(FILE=FNAME(1:LF),EXIST=IEXIST)
- IF(IEXIST) THEN
- IRC = 28
- RETURN
- ENDIF
-#endif
- ENDIF
- IF(IOPTI.NE.0) CHSTAT = 'OLD'
-#if defined(CERNLIB_APOLLO)
- IF(IOPTO.EQ.0) CHSTAT = 'READONLY'
-#endif
- CHFORM = 'UNFORMATTED'
-*
-* LRECL on VAX is in words for unformatted files, but bytes otherwise
-*
- NBYTES = 4
- IF(IOPTF.NE.0) THEN
- CHFORM = 'FORMATTED'
- NBYTES = 1
- ENDIF
-
- CHREC = 'FIXED'
- IF(IOPTP.NE.0) IOPTV = 1
- IF(IOPTV.NE.0) CHREC = 'VARIABLE'
- LCHREC = LENOCC(CHREC)
- IF(IOPTD.EQ.0) THEN
-#if defined(CERNLIB_IBMMVS)
- ITRK = 10
-
- ISECOND = 10
-
- IDIR = 0
- IF ( INDEX(FNAME,'(') .NE. 0 ) IDIR = 28
-
- CHRECFM = 'FB'
- IF(IOPTP.NE.0) CHRECFM = 'VBS'
- IF(IOPTV.NE.0) CHRECFM = 'VB'
-
- IF(IOPTP.NE.0) LRECL = -1
-
- IBLKSIZE = 4000
- IF(IOPTP.NE.0) IBLKSIZE = 6232
-*------------------------------ check file existence
- INQUIRE ( FILE='/'//FNAME(1:LF), IOSTAT=ISTAT
- +, EXIST=EXS, OPENED=OPN, NUMBER=LUNOLD )
- IF (IRC .NE. 0) GO TO 110
-
- IF((.NOT. EXS ).AND.(IOPTI.NE.0)) GOTO 150
-*------------------------- ---- input dataset exists not
-
- IF ( .NOT. EXS ) THEN
-*------------------------------ define dataset parameters
- CALL FILEINF ( ISTAT,'DEVICE' , '33XX' , 'TRK' , ITRK ,
- + 'SECOND' , ISECOND , 'DIR' , IDIR ,
- + 'RECFM' , CHRECFM , 'LRECL' , LRECL ,
- + 'BLKSIZE', IBLKSIZE )
- IF (ISTAT .NE. 0) GO TO 120
-
- ELSE
-*------------------------------ dataset is an old one
- IF (OPN) THEN
-*------------------------------ dataset is open
- CLOSE(UNIT=LUNOLD,STATUS='KEEP',IOSTAT=ISTAT)
- IF (ISTAT .NE. 0) GO TO 140
- ENDIF
-
- ENDIF
-
- IF (IOPTD .EQ. 0) THEN
-*------------------------------ open dataset
- OPEN(LUN,FILE='/'//FNAME(1:LF),FORM=CHFORM,STATUS=CHSTAT,
- + ACTION=CHACTION,IOSTAT=ISTAT)
- IF (ISTAT .NE. 0) GO TO 130
-
- ELSE
-*------------------------------ open dataset, accsess = direct
- OPEN(LUN,FILE='/'//FNAME(1:LF),FORM=CHFORM,STATUS=CHSTAT,
- + RECL=LRECL,ACCESS='DIRECT',
- + ACTION=CHACTION,IOSTAT=ISTAT)
- IF (ISTAT .NE. 0) GO TO 130
-
- ENDIF
-
- RETURN
-
-*------------------------------ error handling
- 110 WRITE(6,*) 'CDOPNF - INQUIRE ERROR - IOSTAT = ',ISTAT
- GO TO 99
-
- 120 WRITE(6,*) 'CDOPNF - FILEINF ERROR - ISTAT = ',ISTAT
- GO TO 99
-
- 130 WRITE(6,*) 'CDOPNF - OPEN ERROR - IOSTAT = ',ISTAT
- GO TO 99
-
- 140 WRITE(6,*) 'CDOPNF - CLOSE ERROR - IOSTAT = ',ISTAT
- GO TO 99
-
- 150 WRITE(6,*) 'CDOPNF - INPUT DATASET NOT ON DISK '
- GO TO 99
-#endif
-#if defined(CERNLIB_IBMVM)
- IF(IOPTP.NE.0) THEN
-*
-* PAM file - issue FILEDEF then open by UNIT
-* (Open by name uses different style DDNAME)
-*
- WRITE(FILEDEF,8001) LUN,FNAME(1:LF)
- 8001 FORMAT('FILEDEF ',I3,' DISK ',A,
- + ' (RECFM VBS LRECL 32756 BLOCK 800 PERM)')
- LENF = LENOCC(FILEDEF)
- CALL CTRANS('.',' ',FILEDEF,1,LENF)
- CALL CTRANS('/',' ',FILEDEF,1,LENF)
- CALL VMCMS(FILEDEF(1:LENF),IRC)
- CALL VMCMS('Q FILEDEF',IRC)
- OPEN(LUN,FORM=CHFORM,STATUS=CHSTAT, ERR=99,IOSTAT=ISTAT)
- RETURN
- ELSE
- LENF = LENOCC(FILEDEF)
- CALL CTRANS('.',' ',FILEDEF,1,LENF)
-*
-* Only call FILEINF for new files...
-*
- IF(IOPTN.NE.0) THEN
- CALL FILEINF(IRC,'RECFM','F','LRECL',LRECL)
- ELSE
- IF(MODE.EQ.'4') CALL FILEINF(IRC,'RECFM','F')
- ENDIF
- ENDIF
-#endif
-#if !defined(CERNLIB_VAXVMS)
- OPEN(LUN,FILE=FNAME(1:LF),FORM=CHFORM,STATUS=CHSTAT,
- + ERR=99,IOSTAT=ISTAT)
-#endif
-#if defined(CERNLIB_VAXVMS)
- INQUIRE(FILE=FNAME(1:LF),EXIST=IEXIST,RECORDTYPE=CHTYPE)
- IF(IEXIST.AND.CHTYPE(1:8).EQ.'VARIABLE') IOPTV = 1
- IF(IOPTO.EQ.0) THEN
-*
-* Add READONLY so that files in other people's directories
-* can be accessed...
-*
- IF((IOPTN.EQ.0).AND.(IOPTV.EQ.0)) THEN
- OPEN(LUN,FILE=FNAME(1:LF),FORM=CHFORM,STATUS=CHSTAT,
- + SHARED,BUFFERCOUNT=127,RECORDTYPE=CHREC(1:LCHREC),
- + RECL=LRECL/NBYTES,IOSTAT=ISTAT,ERR=99,READONLY)
- ELSEIF((IOPTN.NE.0).AND.(IOPTV.EQ.0)) THEN
- OPEN(LUN,FILE=FNAME(1:LF),FORM=CHFORM,STATUS=CHSTAT,
- + BUFFERCOUNT=127,RECORDTYPE=CHREC(1:LCHREC), RECL=
- + LRECL/NBYTES,IOSTAT=ISTAT,ERR=99,READONLY)
- ELSE
- OPEN(LUN,FILE=FNAME(1:LF),FORM=CHFORM,STATUS=CHSTAT,
- + BUFFERCOUNT=127,IOSTAT=ISTAT,ERR=99,READONLY)
- ENDIF
- ELSE
- IF((IOPTN.EQ.0).AND.(IOPTV.EQ.0)) THEN
- OPEN(LUN,FILE=FNAME(1:LF),FORM=CHFORM,STATUS=CHSTAT,
- + SHARED,BUFFERCOUNT=127,RECORDTYPE=CHREC(1:LCHREC), RECL=
- + LRECL/NBYTES,IOSTAT=ISTAT, ERR=99)
- ELSEIF((IOPTN.NE.0).AND.(IOPTV.EQ.0)) THEN
- OPEN(LUN,FILE=FNAME(1:LF),FORM=CHFORM,STATUS=CHSTAT,
- + BUFFERCOUNT=127,RECORDTYPE=CHREC(1:LCHREC), RECL=
- + LRECL/NBYTES,IOSTAT=ISTAT, ERR=99)
- ELSE
- OPEN(LUN,FILE=FNAME(1:LF),FORM=CHFORM,STATUS=CHSTAT,
- + BUFFERCOUNT=127,IOSTAT=ISTAT, ERR=99)
-* + SHARED,BUFFERCOUNT=127, IOSTAT=ISTAT, ERR=99)
- ENDIF
- ENDIF
-#endif
-*
-* Direct-access files...
-*
- ELSE
-#if defined(CERNLIB_IBMVM)
- CALL FILEINF(ISTAT,'MAXREC',2)
- IF(ISTAT.NE.0)GO TO 99
- OPEN(UNIT=LUN,FILE=FNAME(1:LF),FORM='UNFORMATTED', RECL=LRECL,
- + ACCESS='DIRECT',STATUS=CHSTAT,IOSTAT=ISTAT)
- IF(ISTAT.NE.0)GO TO 99
- CLOSE(LUN)
- CALL FILEINF(ISTAT,'MAXREC',16777215)
- IF(ISTAT.NE.0)GO TO 99
-#endif
-#if !defined(CERNLIB_VAXVMS)
- OPEN(LUN,FILE=FNAME(1:LF),FORM=CHFORM,STATUS=CHSTAT,ERR=99,
- + RECL=LRECL/JBYTES,
-#endif
-#if defined(CERNLIB_VAXVMS)
- OPEN(LUN,FILE=FNAME(1:LF),FORM=CHFORM,STATUS=CHSTAT,ERR=99,
- + SHARED,
- + RECL=LRECL/NBYTES,
-#endif
- + ACCESS='DIRECT',IOSTAT=ISTAT)
- ENDIF
- RETURN
- 99 IRC = 1
- IQUEST(1) = ISTAT
- END
diff --git a/src/packlib/hepdb/cdutil/cdoptc.F b/src/packlib/hepdb/cdutil/cdoptc.F
deleted file mode 100644
index 0361e3e..0000000
--- a/src/packlib/hepdb/cdutil/cdoptc.F
+++ /dev/null
@@ -1,38 +0,0 @@
-*
-* $Id: cdoptc.F,v 1.1.1.1 1996/02/28 16:24:39 mclareni Exp $
-*
-* $Log: cdoptc.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:39 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDOPTC(CHOPT,CHPOSS,IOPT)
-*
-* Decode character option string ignoring case
-*
- CHARACTER*(*) CHOPT,CHPOSS
- CHARACTER*255 CAPOPT
- DIMENSION IOPT(2)
-
- LCHOPT = LEN(CHOPT)
- IF(LCHOPT.EQ.0) THEN
- CALL VZERO(IOPT,LEN(CHPOSS))
- RETURN
- ENDIF
-
- CAPOPT = CHOPT(1:LCHOPT)
-
- CALL CLTOU(CAPOPT(1:LCHOPT))
-
- DO 10 JOPT=1,LEN(CHPOSS)
-
- IF(INDEX(CAPOPT(1:LCHOPT),CHPOSS(JOPT:JOPT)).NE.0) THEN
- IOPT(JOPT) = 1
- ELSE
- IOPT(JOPT) = 0
- ENDIF
-
-10 CONTINUE
-
- END
diff --git a/src/packlib/hepdb/cdutil/cdpaff.F b/src/packlib/hepdb/cdutil/cdpaff.F
deleted file mode 100644
index c7851cd..0000000
--- a/src/packlib/hepdb/cdutil/cdpaff.F
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: cdpaff.F,v 1.1.1.1 1996/02/28 16:24:38 mclareni Exp $
-*
-* $Log: cdpaff.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:38 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDPAFF(CHPATH,CHPAFF,NLEVEL,IRC)
-*
-* Split the pathname in CHPATH into an array of component names
-* in CHPAFF
-*
- CHARACTER*20 PATH
- CHARACTER*(*) CHPATH,CHPAFF(NLEVEL)
-
-#include "hepdb/cdunit.inc"
- IRC = 0
-
- LPATH = LENOCC(CHPATH)
- CALL CDNWRD('/',CHPATH(3:LPATH),NWORDS)
- IF(NWORDS.GT.NLEVEL) IRET = -1
- IF(LLOGCD.GE.3) PRINT *,'CDPAFF. ',NWORDS,' words found in ',
- + CHPATH(3:LPATH)
-
- J = 0
- DO 10 I=1,MIN(NLEVEL,NWORDS)
- PATH = ' '
- CALL CDWORD(PATH,I-1,'/',CHPATH(3:LPATH),IC)
- IF(PATH.NE.'..') THEN
- J = J + 1
- CHPAFF(J) = PATH
- IF(LLOGCD.GE.3) PRINT *,'CDPAFF. word ',J,' = ',CHPAFF(J)
- ELSE
- IF(LLOGCD.GE.3) PRINT *,'CDPAFF. word .. discarded'
- J = J - 1
- ENDIF
-10 CONTINUE
-
- END
diff --git a/src/packlib/hepdb/cdutil/cdpktm.F b/src/packlib/hepdb/cdutil/cdpktm.F
deleted file mode 100644
index 919201f..0000000
--- a/src/packlib/hepdb/cdutil/cdpktm.F
+++ /dev/null
@@ -1,75 +0,0 @@
-*
-* $Id: cdpktm.F,v 1.2 1999/08/17 12:42:41 mclareni Exp $
-*
-* $Log: cdpktm.F,v $
-* Revision 1.2 1999/08/17 12:42:41 mclareni
-* Y2k mods submitted by Rob Komar
-*
-* Revision 1.1.1.1 1996/02/28 16:24:40 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDPKTM (IDATE, ITIME, IDATM, IRC)
-* ============================================
-*
-************************************************************************
-* *
-* SUBR. CDPKTM (IDATE, ITIME, IDATM*, IRC*) *
-* *
-* Packs date and time into one word *
-* *
-* Arguments : *
-* *
-* IDATE Date : 6 Decimal integer : YYMMDD *
-* ITIME Time : 4 Decimal integer : HHMM *
-* IDATM Packed date-time *
-* IRC Return Code (See below) *
-* *
-* Modified from original DBPKTM 19/03/90 JDS *
-* *
-* Called by user, CDBFOR, CDCDIC, CDDDIR, CDDONT, CDENFZ, CDENTB, *
-* CDINIT, CDKOUT, CDMKDI, CDPURP, CDSDIR, CDSNAM, CDSPUR, *
-* CDUDIC *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* = 93 : Illegal time *
-* *
-************************************************************************
-*
-#include "hepdb/cdunit.inc"
-#include "hepdb/ctmpak.inc"
-* ------------------------------------------------------------------
-*
- IRC = 0
-
- IMIN = MOD(ITIME,100)
- IHOU = ITIME/100
-*
- IDAY = MOD(IDATE,100)
- IYEA = IDATE/100
- IMON = MOD(IYEA,100)
- IYEA = IYEA/100
- IF(IYEA.LT.35) IYEA = IYEA + 100
-*
- IDATM = IMIN
- MAXX = MXMIN
- IDATM = IDATM + MAXX*IHOU
- MAXX = MAXX*MXHOU
- IDATM = IDATM + MAXX*IDAY
- MAXX = MAXX*MXDAY
- IDATM = IDATM + MAXX*IMON
- MAXX = MAXX*MXMON
- IDATM = IDATM + MAXX*IYEA
-
- IF((IYEA.GT.MXYEA) .OR. (IMON.GE.MXMON) .OR. (IDAY.GE.MXDAY) .OR.
- + (IHOU.GE.MXHOU) .OR. (IMIN.GE.MXMIN)) THEN
- IF(LLOGCD.GE.2)
- + PRINT *,'CDPKTM. Invalid date/time - IPACK set to zero'
- IRC = 93
- IDATM = 0
- ENDIF
-* END CDPKTM
- END
diff --git a/src/packlib/hepdb/cdutil/cdpkts.F b/src/packlib/hepdb/cdutil/cdpkts.F
deleted file mode 100644
index 47cde56..0000000
--- a/src/packlib/hepdb/cdutil/cdpkts.F
+++ /dev/null
@@ -1,75 +0,0 @@
-*
-* $Id: cdpkts.F,v 1.2 1999/08/17 12:42:42 mclareni Exp $
-*
-* $Log: cdpkts.F,v $
-* Revision 1.2 1999/08/17 12:42:42 mclareni
-* Y2k mods submitted by Rob Komar
-*
-* Revision 1.1.1.1 1996/02/28 16:24:40 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDPKTS (IDATE, ITIME, IDATM, IRC)
-* ============================================
-*
-************************************************************************
-* *
-* SUBR. CDPKTS (IDATE, ITIME, IDATM*, IRC*) *
-* *
-* Packs date and time into one word *
-* *
-* Arguments : *
-* *
-* IDATE Date : 6 Decimal integer : YYMMDD *
-* (Only Year > 80 allowed) *
-* ITIME Time : 6 Decimal integer : HHMMSS *
-* IDATM Packed date-time *
-* IRC Return Code (See below) *
-* *
-* Called by user *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* = 93 : Illegal time *
-* *
-************************************************************************
-*
-#include "hepdb/cdunit.inc"
-#include "hepdb/ctmpak.inc"
-* ------------------------------------------------------------------
-*
- IRC = 0
- ISEC = MOD(ITIME,100)
- IHOU = ITIME/100
- IMIN = MOD(IHOU,100)
- IHOU = IHOU/100
-*
- IDAY = MOD(IDATE,100)
- IYEA = IDATE/100
- IMON = MOD(IYEA,100)
- IYEA = IYEA/100 - 80
- IF(IYEA.LT.0) IYEA = IYEA + 100
-*
- IDATM = ISEC
- MAXX = MXSEC
- IDATM = IDATM + MAXX*IMIN
- MAXX = MAXX*MXMIN
- IDATM = IDATM + MAXX*IHOU
- MAXX = MAXX*MXHOU
- IDATM = IDATM + MAXX*IDAY
- MAXX = MAXX*MXDAY
- IDATM = IDATM + MAXX*IMON
- MAXX = MAXX*MXMON
- IDATM = IDATM + MAXX*IYEA
-
- IF((IYEA.GT.55) .OR. (IMON.GE.MXMON) .OR. (IDAY.GE.MXDAY) .OR.
- + (IHOU.GE.MXHOU) .OR. (IMIN.GE.MXMIN)) THEN
- IF(LLOGCD.GE.2)
- + PRINT *,'CDPKTS. Invalid date/time - IPACK set to zero'
- IRC = 93
- IDATM = 0
- ENDIF
-* END CDPKTS
- END
diff --git a/src/packlib/hepdb/cdutil/cdpref.F b/src/packlib/hepdb/cdutil/cdpref.F
deleted file mode 100644
index ba332c5..0000000
--- a/src/packlib/hepdb/cdutil/cdpref.F
+++ /dev/null
@@ -1,205 +0,0 @@
-*
-* $Id: cdpref.F,v 1.1.1.1 1996/02/28 16:24:40 mclareni Exp $
-*
-* $Log: cdpref.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:40 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDPREF(LUN,CHPREF,CHTOP,CHDBFL,IRC)
-* =============================================
-*
-************************************************************************
-* *
-* SUBR. CDPREF (LUN, CHPREF, CHTOP*, CHDBFL*, IRC*) *
-* *
-* Find top directory and file name from database prefix *
-* *
-* Arguments : *
-* *
-* LUN Unit on which names file is to be read *
-* CHPREF Two character database prefix *
-* CHTOP 4 character top directory name ('CD' // CHPREF) *
-* CHDBFL File name of database file (for CDOPEN) *
-* IRC Return Code (See below) *
-* *
-* Called by <USER> *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* = 4 : Prefix not found in NAMES file *
-* = ? : Other errors as for NAMEFD *
-* =-12 : Error translating filename to VAX format *
-* *
-************************************************************************
-*
- CHARACTER*(*) CHPREF,CHTOP,CHDBFL
- CHARACTER*2 PREFIX
-#include "hepdb/slate.inc"
-#include "hepdb/cduscm.inc"
-#include "hepdb/cdnamc.inc"
- CHARACTER*80 CHLINE
- CHARACTER*255 CHQUED,CHFILE,CHDIR
- CHARACTER*20 CHIN(2,1)
- CHARACTER*255 CHOUT(2,1)
-
- DATA NENTRY/0/
- SAVE NENTRY,CHDIR,LDIR,CHFILE,LFILE
-
- IRC = 0
- CHTOP = ' '
-
- IF(LEN(CHPREF).NE.2) THEN
- IF(IDEBCD.GE.0) PRINT *,'CDPREF. illegal database prefix ',
- + CHPREF
- IRC = 301
- RETURN
- ENDIF
-
- PREFIX = CHPREF
- CALL CLTOU(PREFIX)
-*
-* Reserved prefix
-*
- IF(PREFIX.EQ.'ZZ') THEN
- IF(IDEBCD.GT.-3) WRITE(LPRTCD,9001) CHPREF
- 9001 FORMAT(' CDPREF. ',A,' is a reserved database prefix.')
- IRC = 302
- RETURN
- ENDIF
-
- IF(NENTRY.EQ.0) THEN
- NENTRY = 1
- CHFILE = ' '
-*
-* Find the location of the names file and process
-*
- CALL GETENVF('CDSERV',CHDIR)
- LDIR = IS(1)
- IF(LDIR.EQ.0) THEN
- IF(IDEBCD.GE.0) PRINT *,'CDPREF. variable CDSERV ',
- + 'not defined'
- IRC = 311
- RETURN
- ENDIF
-#if defined(CERNLIB_IBMVM)
-*
-* Link to server disk
-*
- LDOT = INDEX(CHDIR(1:LDIR),'.')
- IF(LDOT.NE.0) CHDIR(LDOT:LDOT) = ' '
-*
-* Translate <> & [] characters
-*
- IBRA = INDEX(CHDIR(1:LDIR),'<')
- IF(IBRA.NE.0) CHDIR(IBRA:IBRA) = ' '
- IBRA = INDEX(CHDIR(1:LDIR),'>')
- IF(IBRA.NE.0) CHDIR(IBRA:IBRA) = ' '
- IBRA = INDEX(CHDIR(1:LDIR),'[')
- IF(IBRA.NE.0) CHDIR(IBRA:IBRA) = ' '
- IBRA = INDEX(CHDIR(1:LDIR),']')
- IF(IBRA.NE.0) CHDIR(IBRA:IBRA) = ' '
-*
-* Remove leading and trailing blanks
-*
- JX = ICFNBL(CHDIR,1,LDIR)
- CHFILE = CHDIR(JX:LDIR)
- LDIR = LENOCC(CHFILE)
- CHDIR = CHFILE(1:LDIR)
- CALL VMCMS('EXEC GIME '//CHDIR(1:LDIR) //' (QUIET NONOTICE '
- + //'STACK)',ICODE)
- IF(ICODE.GT.4) THEN
- IF(IDEBCD.GE.0) PRINT *,'CDPREF. return code ',ICODE,
- + ' from EXEC GIME '//CHDIR(1:LDIR)
- RETURN
- ENDIF
- CALL VMRTRM(CHLINE,LLINE)
- CDMODE = CHLINE(1:1)
- CHFILE = 'HEPDB NAMES '//CDMODE
- LFILE = 14
-#endif
-#if defined(CERNLIB_WINNT)
- CHFILE = CHDIR(1:LDIR) // '\\hepdb.names'
- LFILE = LDIR + 12
- CALL CUTOL(CHFILE(1:LFILE))
-#endif
-#if defined(CERNLIB_MSDOS)
- CHFILE = CHDIR(1:LDIR) // '\\hepdb.nam'
- LFILE = LDIR + 10
- CALL CUTOL(CHFILE(1:LFILE))
-#endif
-#if (defined(CERNLIB_UNIX))&&(!defined(CERNLIB_WINNT))&&(!defined(CERNLIB_MSDOS))
- CHFILE = CHDIR(1:LDIR) // '/hepdb.names'
- LFILE = LDIR + 12
- CALL CUTOL(CHFILE(1:LFILE))
-#endif
-#if defined(CERNLIB_VAXVMS)
- CHFILE = CHDIR(1:LDIR) // 'hepdb.names'
- LFILE = LDIR + 11
-#endif
- ENDIF
-*
-* Get the file name and list of servers for this database
-*
- NIN = 1
- NOUT = 1
- CHIN(1,1) = ':nick'
- CHIN(2,1) = PREFIX
-
- CHOUT(1,1) = ':file'
- CHOUT(2,1) = ' '
-
- CALL NAMEFD(LUN,CHFILE(1:LFILE),CHIN,NIN,CHOUT,NOUT,IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBCD.GE.0)
- + PRINT *,'CDCONF. error ',IRC,' processing names file ',
- + CHFILE(1:LFILE),' for entry ',CHPREF
- RETURN
- ENDIF
-
- CHTOP = 'CD'
- CHTOP(3:4) = CHPREF(1:2)
-#if !defined(CERNLIB_IBMVM)
- CHDBFL = CHOUT(2,1)
-#endif
-#if defined(CERNLIB_VAXVMS)
- LDBFL = LENOCC(CHDBFL)
- IF(INDEX(CHDBFL(1:LDBFL),'/').NE.0) THEN
- CALL FTOVAX(CHDBFL(1:LDBFL),LDBFL)
- IF(IS(1).NE.1) THEN
- IF(IDEBCD.GE.-3) WRITE(LPRTCD,7001)
- + CHOUT(2,1)(1:LENOCC(CHOUT(2,1)))
-7001 FORMAT(' CDPREF. error converting ',A,' to VMS format')
- IRC = -12
- GOTO 999
- ENDIF
- ENDIF
-#endif
-#if defined(CERNLIB_IBMVM)
-*
-* File syntax is <user.addr>filename.filetype
-*
- LOUT = LENOCC(CHOUT(2,1))
- LGT = INDEX(CHOUT(2,1),'>')
- IF(LGT.EQ.0) THEN
- CHDBFL = CHOUT(2,1)
- ELSE
- CHLINE = ' '
- CHLINE = CHOUT(2,1)(2:LGT-1)
- LDOT = INDEX(CHLINE,'.')
- IF(LDOT.NE.0) CHLINE(LDOT:LDOT) = ' '
- LLINE = LENOCC(CHLINE)
- CALL VMCMS('EXEC GIME '//CHLINE(1:LLINE) //' (QUIET NONOTICE '
- + //'STACK)',ICODE)
- IF(ICODE.GT.4) THEN
- IF(IDEBCD.GE.0) PRINT *,'CDPREF. return code ',ICODE,
- + ' from EXEC GIME '//CHLINE(1:LLINE)
- RETURN
- ENDIF
- CALL VMRTRM(CHLINE,LLINE)
- CHDBFL = CHOUT(2,1)(LGT+1:LOUT) // '.' // CHLINE(1:1)
- ENDIF
-#endif
-999 END
diff --git a/src/packlib/hepdb/cdutil/cdrand.F b/src/packlib/hepdb/cdutil/cdrand.F
deleted file mode 100644
index 072df61..0000000
--- a/src/packlib/hepdb/cdutil/cdrand.F
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: cdrand.F,v 1.1.1.1 1996/02/28 16:24:43 mclareni Exp $
-*
-* $Log: cdrand.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:43 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDRAND(CHRAND,IRC)
- CHARACTER*(*) CHRAND
- CHARACTER*9 CHTEMP
-#include "hepdb/slate.inc"
- DATA NENTRY/0/
- SAVE NENTRY
-
- IRC = 0
-
- IF(NENTRY.EQ.0) THEN
- CALL DATIME(ID,IT)
- I = 0
- J = 0
- CALL RMARIN(IT*100+IS(6),I,J)
- NENTRY = 1
- ENDIF
-
- CALL RANMAR(X,1)
-
- WRITE(CHTEMP,'(F9.8)') X
- CHRAND = CHTEMP(2:)
-
- END
diff --git a/src/packlib/hepdb/cdutil/cdsave.F b/src/packlib/hepdb/cdutil/cdsave.F
deleted file mode 100644
index 2416fcf..0000000
--- a/src/packlib/hepdb/cdutil/cdsave.F
+++ /dev/null
@@ -1,45 +0,0 @@
-*
-* $Id: cdsave.F,v 1.1.1.1 1996/02/28 16:24:42 mclareni Exp $
-*
-* $Log: cdsave.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:42 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
-#if defined(CERNLIB_OLD)
-#if defined(CERNLIB__P3CHILD)
-* Ignoring t=dummy
-#endif
- SUBROUTINE CDSAVE (IRC)
-* =======================
-*
-************************************************************************
-* *
-* SUBR. CDSAVE (IRC*) *
-* *
-* Sends the spool file to the server for updating the data base. *
-* Useful only for interactive programs running on IBM *
-* *
-* Arguments : *
-* *
-* IRC Return code (see below) *
-* *
-* Called by user *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
-* ------------------------------------------------------------------
-*
- IRC = 0
-#if (defined(CERNLIB_IBMVM)||defined(CERNLIB_UNIX)||defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))&&(!defined(CERNLIB__P3CHILD))&&(!defined(CERNLIB__ONLINE))
- CALL CDSTSV (' ', 0, IRC)
-#endif
-* END CDSAVE
- END
-#endif
diff --git a/src/packlib/hepdb/cdutil/cdscan.F b/src/packlib/hepdb/cdutil/cdscan.F
deleted file mode 100644
index 13ea457..0000000
--- a/src/packlib/hepdb/cdutil/cdscan.F
+++ /dev/null
@@ -1,288 +0,0 @@
-*
-* $Id: cdscan.F,v 1.1.1.1 1996/02/28 16:24:38 mclareni Exp $
-*
-* $Log: cdscan.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:38 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDSCAN(PATH,NLEVEL,UROUT,IRC)
-*
-************************************************************************
-*
-* To traverse the HEPDB directory tree starting from
-* the specified pathname.
-* Modified from the RZ routine RZSTAT / RZSCAN
-*
-*
-* Input:
-* CHPATH The pathname of the starting directory
-* NLEVEL Number of levels below CHPATH to descend
-* UROUT External user routine to be called for each pathname
-*
-* Output:
-* IQUEST(10) = number of elements in initial path
-* IQUEST(11) = number of directories found
-*
-* IQUEST(12) = number of subdirectories at this level
-* IQUEST(13) = number of elements in path name
-* IQUEST(14) = number of keys
-* IQUEST(15) = number of words per key
-*
-* Called by <USER>
-*
-*
-************************************************************************
-#include "hepdb/slate.inc"
-#include "zebra/rzcl.inc"
-#include "zebra/rzdir.inc"
-#include "zebra/rzch.inc"
-#include "zebra/rzk.inc"
- CHARACTER*(*) PATH
- CHARACTER*255 CHPATH
- PARAMETER (MAXLEV=20)
- CHARACTER*16 DIRNAM(MAXLEV),CHDIR
- DIMENSION ISD(MAXLEV),NSD(MAXLEV),IHDIR(4)
- DIMENSION IOPTV(2)
- EQUIVALENCE (IOPTQ,IOPTV(1)), (IOPTX,IOPTV(2))
- EXTERNAL UROUT
-#include "hepdb/cdrnge.inc"
-#include "hepdb/cdunit.inc"
-*
-*-----------------------------------------------------------------------
-*
-*
- IRC=0
- IQUEST(1) = 0
- IQUEST(11) = 0
- LPATH = LENOCC(PATH)
- LPATHI = LPATH
- CHPATH = PATH(1:LPATH)
- CALL CLTOU(CHPATH(1:LPATH))
-*
- ITIME = 0
- NLEV = NLEVEL
- IF(NLEV.LE.0) NLEV=99
- NFOUND = 0
- ITEMP = 0
- CALL RZCDIR(CHWOLD,'R')
- LOLD = LENOCC(CHWOLD)
-*
-* Split input path name into its component pieces
-* (this is the opposite of RZPAFF which glues them together)
-*
- CALL CDPAFF(CHPATH(1:LPATH),DIRNAM,MAXLEV,IRET)
-*
-* Find first wild card in generic name
-*
- IF(LLOGCD.GE.3)
- +PRINT *,'CDSCAN. enter for PATH = ',CHPATH(1:LPATH)
- CALL CDNWRD('/',CHPATH(3:LPATHI),NLEV0)
- IWILD = ICFMUL('*%(<>',CHPATH,1,LPATH)
- IF(IWILD.LE.LPATH) THEN
- LPATH = INDEXB(CHPATH(1:IWILD),'/') - 1
- CALL CDNWRD('/',CHPATH(LPATH+2:LPATHI),NLEV1)
- NLEV = MIN(99,NLEV+NLEV1)
-* ELSE
-* LPATHI = LPATHI + 2
-* CHPATH(LPATHI-1:LPATHI) = '/*'
- ENDIF
-
- IF(LLOGCD.GE.3) PRINT *,'CDSCAN. show directories ',
- + 'below ',CHPATH(1:LPATH),' down ',NLEV,' levels'
-*
-* Set CWD to the current level
-*
- 10 CONTINUE
- IF(ITIME.NE.0)THEN
- CALL RZPAFF(CHPAT,NLPAT,CHL)
- CALL RZCDIR(CHL,' ')
- ELSE
- CALL RZCDIR(CHPATH(1:LPATH),' ')
- IF(IQUEST(1).NE.0)GO TO 70
- NLPAT0=NLPAT
- CHL = CHPATH(1:LPATH)
- ENDIF
- IF(IQUEST(1).NE.0)GO TO 60
-*
-* Set IQUEST
-*
- IQUEST(10) = NLEV0
- IQUEST(12) = IQ(KQSP+LCDIR+KNSD)
- IQUEST(13) = NLPAT
- IQUEST(14) = IQ(KQSP+LCDIR+KNKEYS)
- IQUEST(15) = IQ(KQSP+LCDIR+KNWKEY)
-*
-* Ensure that entire path name matches before calling UROUT
-*
- CALL CDMTCH(CHL,CHPATH(1:LPATHI),IRC)
-*
-* Trailing unmatched characters in CHPATH
-* Accept if first character is a / and total length
-* of pathname is ok
-*
- IF(IRC.EQ.2.AND.CHL(IQUEST(1):IQUEST(1)).EQ.'/'
- + .AND.NLPAT.LE.NLEV0+NLEV) IRC = 0
-
- IF(IRC.EQ.0) THEN
- CALL UROUT(CHL,IURC)
- IF(IURC.NE.0) RETURN
- ENDIF
-
- ISD(NLPAT)=0
- NSD(NLPAT)=IQ(KQSP+LCDIR+KNSD)
-*
-* If there is a <> at this level, perform matching
-* and follow only that path
-*
- ILT = INDEX(DIRNAM(NLPAT+1),'<')
- IGT = INDEX(DIRNAM(NLPAT+1),'>')
- NCRNGE(NLPAT+1) = 0
-
- IF((ILT.NE.0).AND.(IGT.NE.0)) THEN
- IF(LLOGCD.GE.-3) PRINT *,'CDSCAN. invalid wild-carding ',
- + 'at level ',NLPAT,' in pathname - ',DIRNAM(NLPAT+1)
- IF(LLOGCD.GE.-3) PRINT *,'CDSCAN. only one of < or > ',
- + 'may be specified'
- IQUEST(1) = -1
- GOTO 60
- ENDIF
-
- IF(ILT+IGT.NE.0) THEN
-*
-* Is there a [mm:nn] syle range?
-*
- JR = LENOCC(DIRNAM(NLPAT+1))
- ISQ = INDEX(DIRNAM(NLPAT+1)(1:JR),'[')
- IF(ISQ.NE.0) THEN
- ILOW = ICDECI(DIRNAM(NLPAT+1),ISQ+1,JR)
- IF(IS(1).EQ.0) THEN
- IRC = -1
- IF(LLOGCD.GE.-3) PRINT *,'CDSCAN. error reading ',
- + 'decimal value from ',DIRNAM(NLPAT+1)(ISQ:JR)
- IF(LLOGCD.GE.-3) PRINT *,' Only integer ranges ',
- + 'are supported between [] characters, e.g. [10:20]'
- GOTO 70
- ENDIF
- IHIGH = ICDECI(DIRNAM(NLPAT+1),
- + INDEX(DIRNAM(NLPAT+1),':') + 1,JR)
- IF(IS(1).EQ.0) THEN
- IRC = -1
- IF(LLOGCD.GE.-3) PRINT *,'CDSCAN. error reading ',
- + 'decimal value from ',DIRNAM(NLPAT+1)(ISQ:JR)
- IF(LLOGCD.GE.-3) PRINT *,' Only integer ranges ',
- + 'are supported between [] characters, e.g. [10:20]'
- GOTO 70
- ENDIF
- IF(LLOGCD.GE.3) PRINT *,'CDSCAN. ilow/ihigh = ',ILOW,IHIGH
- NCRNGE(NLPAT+1) = 0
- IF(IHIGH-ILOW+1.GT.100) THEN
- IF(LLOGCD.GE.-3) PRINT *,'CDSCAN. maximum range is 100',
- + ' - excess elements will be ignored'
- IHIGH = ILOW + 99
- ENDIF
- DO 20 JJ=ILOW,IHIGH
- NCRNGE(NLPAT+1) = NCRNGE(NLPAT+1) + 1
- ICRNGE(NCRNGE(NLPAT+1),NLPAT+1) = JJ
- ICELEM(NCRNGE(NLPAT+1),NLPAT+1) = -1
- IF(ILT.NE.0) THEN
- ICVAL(NCRNGE(NLPAT+1),NLPAT+1) = 999999
- ELSE
- ICVAL(NCRNGE(NLPAT+1),NLPAT+1) = -1
- ENDIF
- 20 CONTINUE
- ENDIF
-*
-* Loop over all subdirectories at this level
-*
- DO 30 JJ=1,NSD(NLPAT)
- LS=IQ(KQSP+LCDIR+KLS)
- IH=LS+7*(JJ-1)
- CALL ZITOH(IQ(KQSP+LCDIR+IH),IHDIR,4)
- CALL UHTOC(IHDIR,4,CHDIR,16)
- CALL CDSELP(CHDIR,DIRNAM(NLPAT+1),JJ,NSD(NLPAT),JINDEX,IRC)
- 30 CONTINUE
- IF(JINDEX.GT.0) THEN
- IF(NCRNGE(NLPAT+1).EQ.0) THEN
- IF(LLOGCD.GE.3) THEN
- LS=IQ(KQSP+LCDIR+KLS)
- IH=LS+7*(JINDEX-1)
- CALL ZITOH(IQ(KQSP+LCDIR+IH),IHDIR,4)
- CALL UHTOC(IHDIR,4,CHDIR,16)
- PRINT *,'CDSCAN. selected subdirectory ',CHDIR
- ENDIF
- NSD(NLPAT) = JINDEX
- ISD(NLPAT) = JINDEX - 1
- ELSE
- LS=IQ(KQSP+LCDIR+KLS)
- IF(LLOGCD.GE.3)
- + PRINT *,'CDSCAN. selected following subdirectories...'
- JMIN = 999999
- JMAX = 0
- DO 40 II=1,NCRNGE(NLPAT+1)
- JJ=ICELEM(II,NLPAT+1)
- IF(JJ.LE.0) GOTO 40
- IF(JJ.LT.JMIN) JMIN = JJ
- IF(JJ.GT.JMAX) JMAX = JJ
- IF(LLOGCD.GE.3) THEN
- IH=LS+7*(JJ-1)
- CALL ZITOH(IQ(KQSP+LCDIR+IH),IHDIR,4)
- CALL UHTOC(IHDIR,4,CHDIR,16)
- PRINT *,CHDIR
- ENDIF
- 40 CONTINUE
- NSD(NLPAT) = JMAX
- ISD(NLPAT) = JMIN - 1
- ENDIF
- ELSE
- IF(LLOGCD.GE.2)
- + PRINT *,'CDSCAN. no subdirectory matches'
- NSD(NLPAT) = 0
- ENDIF
- ELSE
- JINDEX = -1
- ENDIF
-*
-* Process possible down directories
-*
- 50 ISD(NLPAT)=ISD(NLPAT)+1
- IF((ISD(NLPAT).LE.NSD(NLPAT)).AND.
- + (NLPAT.LT.(NLPAT0+NLEV))) THEN
- IF(NCRNGE(NLPAT+1).NE.0
- + .AND.IUFIND(ISD(NLPAT),
- + ICELEM(1,NLPAT+1),1,NCRNGE(NLPAT+1)).GT.
- + NCRNGE(NLPAT+1)) GOTO 50
- NLPAT=NLPAT+1
- LS=IQ(KQSP+LCDIR+KLS)
- IH=LS+7*(ISD(NLPAT-1)-1)
- CALL ZITOH(IQ(KQSP+LCDIR+IH),IHDIR,4)
- CALL UHTOC(IHDIR,4,CHPAT(NLPAT),16)
- ITIME=ITIME+1
- GO TO 10
- ELSE
-*
-* Write information on current directory
-*
- CALL RZPAFF(CHPAT,NLPAT,CHL)
- IF(NLPAT.LE.(NLPAT0+NLEV))THEN
- NFOUND = NFOUND + 1
- ENDIF
- NLPAT=NLPAT-1
- IF(NLPAT.GE.NLPAT0)THEN
- LUP=LQ(KQSP+LCDIR+1)
- CALL MZDROP(JQPDVS,LCDIR,' ')
- LCDIR=LUP
- GO TO 50
- ENDIF
- ENDIF
-*
-* Reset CWD
-*
- 60 CALL RZCDIR(CHWOLD(1:LOLD),' ')
-*
- 70 CONTINUE
- IRC = IQUEST(1)
- IQUEST(11) = NFOUND
- RETURN
- END
diff --git a/src/packlib/hepdb/cdutil/cdselp.F b/src/packlib/hepdb/cdutil/cdselp.F
deleted file mode 100644
index c49dfeb..0000000
--- a/src/packlib/hepdb/cdutil/cdselp.F
+++ /dev/null
@@ -1,312 +0,0 @@
-*
-* $Id: cdselp.F,v 1.1.1.1 1996/02/28 16:24:37 mclareni Exp $
-*
-* $Log: cdselp.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:37 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDSELP(CHFILE,CHMTCH,IFILE,NFILES,NMATCH,IRC)
-*
-* This routine performs wild card file name matching
-* a la VM/CMS (FILELIST/LISTFILE) and VAX/VMS (DIRECTORY)
-* Thus: % corresponds to a single arbitrary character,
-* * corresponds to n (n>=0) arbitrary characters
-* Numeric ranges are also supported, thus (9:12) will
-* match strings 09,10,11,12.
-*
-#include "hepdb/cdunit.inc"
-#include "hepdb/cdrnge.inc"
-#include "hepdb/quest.inc"
-*
- COMMON /SLATE/ NDSLAT,NESLAT, DUMMY(38)
- CHARACTER*(*) CHFILE,CHMTCH
- CHARACTER*255 FILE,MATCH
- CHARACTER*10 CHLOW,CHHIGH,CHMAT,CHPASS,CHPLOW,CHPHI
- CHARACTER*5 WILD
- CHARACTER*27 HUNT
- DATA WILD/'%*(<>'/
- DATA HUNT/'ABCDEFGHIJKLMNOPQRSTUVWXYZ/'/
- SAVE CHPLOW,CHPHI,JMATCH
-
-*
-* Reset if this is a new call
-*
- IF(IFILE.EQ.1) THEN
- CHPLOW = '9999999999'
- CHPHI = ' '
- JFOUND = 0
- JMATCH = 0
- NMATCH = 0
- ENDIF
-
- ISTART = 0
- JSTART = 0
- IRC = 0
- IFOUND = 0
- JELEM = 0
- IEND = LENOCC(CHMTCH)
- JEND = LENOCC(CHFILE)
- MATCH = CHMTCH(1:IEND)
- FILE = CHFILE(1:JEND)
-*
- ISQ = INDEX(MATCH(1:IEND),'[')
- ILOW = INDEX(MATCH(1:IEND),'<')
- IHIGH = INDEX(MATCH(1:IEND),'>')
-*
-* Convert [] to ()
-*
- CALL CTRANS('[','(',MATCH,1,IEND)
- CALL CTRANS(']',')',MATCH,1,IEND)
- NLPAT = IQUEST(13) + 1
-*
-* Remove multiple *'s
-*
- NESLAT = IEND
- CALL CSQMCH(MATCH,'*',1,IEND)
- IF(NESLAT.LT.IEND) IEND = NESLAT
- IF(LLOGCD.GT.2) PRINT *,'CDSELP. Compare ',MATCH(1:IEND),
- + ' against ',FILE(1:JEND),
- + ' (candidate # ',IFILE,' of ',NFILES,')'
-*
-* Process all characters in FILE
-*
-10 CONTINUE
-*
-* Have reached the end of both match and file and all is ok
-*
- IF((ISTART.EQ.IEND).AND.(JSTART.EQ.JEND)) GOTO 1
-
- ISTART = ISTART + 1
- JSTART = JSTART + 1
-*
-* Have processed all characters in MATCH and all compare
-*
- IF(ISTART.GT.IEND) THEN
-*
-* but FILE is longer than MATCH...
-*
- IF(ISTART.LE.JEND) IRC = 1
- GOTO 1
- ENDIF
-*
-* Look down MATCH for a * or %
-*
- IX = ICFMUL(WILD,MATCH,ISTART,IEND)
-*
-* Match any characters up until first wild card
-*
- IF(IX.GT.ISTART) THEN
- LWORD = IX-ISTART-1
- IF(FILE(JSTART:JSTART+LWORD).NE.MATCH(ISTART:ISTART+LWORD))
- + GOTO 99
- ISTART = ISTART + LWORD
- JSTART = JSTART + LWORD
- GOTO 10
- ENDIF
-
- IF(MATCH(IX:IX).EQ.'*') THEN
-*
-* Current character is a *
-* Find first non-wild character in MATCH and find
-* in FILE.
-*
- IF(IX.EQ.IEND) GOTO 1
- DO 20 I=ISTART+1,IEND
- IF((MATCH(I:I).NE.'*').AND.(MATCH(I:I).NE.'%') .AND.
- + (MATCH(I:I).NE.'(')) GOTO 30
-20 CONTINUE
-*
-* MATCH only contains * followed by other wild-cards - ok
-*
- IF(LLOGCD.GT.2)
- + PRINT *,'CDSELP. Match pattern contains only wild-cards'
- GOTO 1
-30 CONTINUE
-*
-* Look for current word in FILE and reset JSTART
-* Word is delimited by two wild-chars or end of string.
-*
- IWILD = ICFMUL(WILD,MATCH,I,IEND)
- IF(IWILD.LE.IEND) THEN
- II = IWILD - 1
- ELSE
- II = IEND
- ENDIF
-* II = MIN(IEND,ICFMUL(WILD,MATCH,I,IEND))
- JFIND = INDEX(FILE(JSTART:JEND),MATCH(I:II))
- IF(JFIND.EQ.0) GOTO 99
- ISTART = I
- JSTART = JSTART+JFIND-1
- GOTO 10
-
- ELSEIF(MATCH(IX:IX).EQ.'%') THEN
-*
-* Current character is a <
-*
- ELSEIF((MATCH(IX:IX).EQ.'<').OR.(MATCH(IX:IX).EQ.'>')) THEN
-*
-* Current character is a < or >
-* Look for a /, an alphabetic character or the end of the string
-*
- IF(LLOGCD.GT.2)
- + PRINT *,'CDSELP. Found a < or > character'
- JX = ICFMUL(HUNT,FILE,JSTART,JEND)
- IF(JX.GT.JEND) THEN
- JX = JEND
- ELSE
- JX = JX - 1
- ENDIF
-
- CHPASS = FILE(JSTART:JX)
-
- IF(MATCH(IX:IX).EQ.'<') THEN
-
- IF(LLT(CHPASS,CHPLOW)) THEN
- CHPLOW = CHPASS
- JFOUND = IFILE
- IFOUND = IFILE
-* IF(ISQ.NE.0.AND.JELEM.NE.0)
-* + ICELEM(JELEM,NLPAT) = IFILE
- ENDIF
-
- ELSE
-
- IF(LGT(CHPASS,CHPHI)) THEN
- CHPHI = CHPASS
- JFOUND = IFILE
- IFOUND = IFILE
-* IF(ISQ.NE.0.AND.JELEM.NE.0)
-* + ICELEM(JELEM,NLPAT) = IFILE
- ENDIF
-
- ENDIF
-
- IF(LLOGCD.GT.2)
- + PRINT 9001,CHPASS, CHPLOW, CHPHI
-9001 FORMAT(' CDSELP. CHPASS, CHPLOW, CHPHI = ',3A20)
- JSTART = JX
- GOTO 10
-*
-* Current character is a %
-*
- ELSEIF(MATCH(IX:IX).EQ.'(') THEN
-*
-* Found a range delimiter
-*
- IF(LLOGCD.GT.2)
- + PRINT *,'CDSELP. range encountered in MATCH pattern'
- IBRA = INDEX(MATCH(IX:IEND),')')
- ICOL = INDEX(MATCH(IX:IEND),':')
- IF(IBRA.EQ.0) THEN
- IF(LLOGCD.GE.-3) PRINT *,'CDSELP. no trailing delimiter',
- + ' for range pattern'
- IRC = -4
- RETURN
- ENDIF
-
- IF(IX+IBRA.LT.IEND) THEN
- IF(LLOGCD.GE.4)
- + PRINT *,'Looking for ',MATCH(IX+IBRA:IX+IBRA),' in ',
- + FILE(JSTART:JEND)
- LNMAT = INDEX(FILE(JSTART:JEND),
- + MATCH(IX+IBRA:IX+IBRA))
- IF(LNMAT.EQ.0) THEN
- IF(LLOGCD.GE.-3) PRINT *,'CDSELP. no match after',
- + ' range pattern'
- IRC = -4
- RETURN
- ENDIF
- LNMAT = LNMAT - 1
- ELSE
- LNMAT = IEND + 1
- ENDIF
-
- IF(ICOL.EQ.0) THEN
- IF(LLOGCD.GE.-3) PRINT *,'CDSELP. missing colon in ',
- + 'range pattern'
- IRC = -4
- RETURN
- ENDIF
-
- CHLOW = MATCH(IX+1:IX+ICOL-2)
- CHHIGH = MATCH(IX+ICOL:IX+IBRA-2)
- LNHIGH = LENOCC(CHHIGH)
-*
-* Extend CHLOW on the left with blanks
-*
- CALL CRIGHT(CHLOW,1,LNHIGH)
-*
-* And convert to zeroes
-*
- CALL CTRANS(' ','0',CHLOW,1,LNHIGH)
- IF(LLOGCD.GT.2)
- + PRINT *,'CDSELP. range = ',CHLOW,' to ',CHHIGH
- CHMAT = FILE(JSTART:JSTART+LNMAT-1)
-*
-* Extend CHMAT on the left with blanks
-*
- CALL CRIGHT(CHMAT,1,LNHIGH)
-*
-* And convert to zeroes
-*
- CALL CTRANS(' ','0',CHMAT,1,LNHIGH)
- IF(ISQ.NE.0) THEN
- IELEM = ICDECI(CHMAT,1,LNHIGH)
- IF(LLOGCD.GE.3) PRINT *,'CDSELP. IELEM = ',IELEM
- IF(IELEM.NE.0) THEN
- JELEM = IUFIND(IELEM,ICRNGE(1,NLPAT),1,
- + NCRNGE(NLPAT))
- IF(JELEM.GT.NCRNGE(NLPAT)) JELEM = 0
- ELSE
- JELEM = 0
- ENDIF
- IF(LLOGCD.GE.3) PRINT *,'CDSELP. JELEM = ',JELEM
- ENDIF
- IF(LLOGCD.GT.2)
- + PRINT *,'CDSELP. match = ',CHMAT
- IF(LLT(CHMAT(1:LNHIGH),CHLOW(1:LNHIGH)) .OR.
- + LGT(CHMAT(1:LNHIGH),CHHIGH(1:LNHIGH))) GOTO 99
- ISTART = ISTART + IBRA - 1
-* JSTART = JSTART + LNHIGH - 1
- JSTART = JSTART + LNMAT - 1
- GOTO 10
-
- ELSE
-*
-* Current character is a not a wild card
-*
- IF(FILE(JSTART:JSTART).NE.MATCH(ISTART:ISTART)) GOTO 99
-
- ENDIF
-
- GOTO 10
-
-99 CONTINUE
- IRC = 2
-1 CONTINUE
- IF(IRC.EQ.0) JMATCH = JFOUND
- IF(IFILE.EQ.NFILES) NMATCH = JMATCH
- IF(JELEM.NE.0) THEN
- IVALUE = ICDECI(CHPASS,1,LEN(CHPASS))
- IF(ILOW.NE.0) THEN
- IF(LLOGCD.GE.3) PRINT *,'CDSELP. looking for ',
- + 'lowest value. Current value = ',ICVAL(JELEM,NLPAT)
- IF(IVALUE.LT.ICVAL(JELEM,NLPAT)) THEN
- ICVAL(JELEM,NLPAT) = IVALUE
- ICELEM(JELEM,NLPAT) = IFILE
- ENDIF
- ELSEIF(IHIGH.NE.0) THEN
- IF(LLOGCD.GE.3) PRINT *,'CDSELP. looking for ',
- + 'highest value. Current value = ',ICVAL(JELEM,NLPAT)
- IF(IVALUE.GT.ICVAL(JELEM,NLPAT)) THEN
- ICVAL(JELEM,NLPAT) = IVALUE
- ICELEM(JELEM,NLPAT) = IFILE
- ENDIF
- ENDIF
- ENDIF
- IF(LLOGCD.GE.2) PRINT *,'CDSELP. best candidate so far = ',
- + JMATCH,' return code from this pass = ',IRC
- END
-
diff --git a/src/packlib/hepdb/cdutil/cdsetu.F b/src/packlib/hepdb/cdutil/cdsetu.F
deleted file mode 100644
index 006eb0c..0000000
--- a/src/packlib/hepdb/cdutil/cdsetu.F
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: cdsetu.F,v 1.1.1.1 1996/02/28 16:24:39 mclareni Exp $
-*
-* $Log: cdsetu.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:39 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDSETU(LUN,NLUN,IC)
-*
-* Routine to set the logical units that may be used by HEPDB
-*
- DIMENSION LUN(NLUN)
-#include "hepdb/hdbpara.inc"
-#include "hepdb/hdblun.inc"
-#include "hepdb/cdunit.inc"
- IC = 0
- NUMLUN = 0
- IF(NLUN.GT.KMXLUN) IC = 1
- DO 10 I=1,MIN(NLUN,KMXLUN)
- IF((LUN(I).LE.0).OR.(LUN(I).GT.99)) THEN
- IF(LLOGCD.GE.0) PRINT *,'CDSETU. Invalid logical unit ',LUN(I),
- + ' ignored. Logical units must be between 1-99'
- IC = 2
- GOTO 10
- ENDIF
- NUMLUN = NUMLUN + 1
- MCDLUN(NUMLUN) = LUN(I)
-10 CONTINUE
- END
diff --git a/src/packlib/hepdb/cdutil/cdshow.F b/src/packlib/hepdb/cdutil/cdshow.F
deleted file mode 100644
index ef74f03..0000000
--- a/src/packlib/hepdb/cdutil/cdshow.F
+++ /dev/null
@@ -1,141 +0,0 @@
-*
-* $Id: cdshow.F,v 1.1.1.1 1996/02/28 16:24:44 mclareni Exp $
-*
-* $Log: cdshow.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:44 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDSHOW (PATH, ISEL, IMASK, KEYS, CHBANK, IDBANK, ND1,
- + ND2, CHOPT, IRC)
-* ================================================================
-*
-************************************************************************
-* *
-* SUBR. CDSHOW (PATH, ISEL, IMASK, KEYS, CHBANK, IDBANK, ND1, *
-* ND2, CHOPT, IRCC*) *
-* *
-* Displays the objects in a given directory. One or all banks with *
-* the name CHBANK are displayed in a form similar to DZSHOW. If a *
-* specific bank is required. this may be specified by IDBANK. A *
-* range of data words specified by ND1 and ND2 may also be selected *
-* *
-* Arguments : *
-* *
-* PATHN Character string describing the pathname *
-* ISEL Integer vector specifying the instant of validity *
-* IMASK Integer vector indicating which elements of KEYS are *
-* significant for selection. If MASK corresponding to *
-* one of the fields of 'Beginning' validity range is set, *
-* it will select objects with start validity smaller than *
-* those requested in KEYS. If MASK corresponding to one *
-* of the fields of 'End' validity range is set, it will *
-* select objects with end validity larger than those in *
-* KEYS. If MASK corresponding to time of insertion is set,*
-* objects inserted earlier than KEYS(IDHINS) are selected *
-* KEYS Vector of keys. Only the elements declared in CHOPT are *
-* assumed to contain useful information. *
-* CHBANK ZEBRA bank name *
-* IDBANK ZEBRA numeric bank identifier *
-* ND1 First data word to be shown *
-* ND2 Last data word to be shown *
-* CHOPT Character string with any of the following characters *
-* ' ' find all banks with position in walk > IDBANK *
-* S find bank with ZEBRA ID = IDBANK *
-* IRC Return code (see below) *
-* *
-* Called by user *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* *
-************************************************************************
-*
-#include "hepdb/caopts.inc"
-#include "hepdb/cdcblk.inc"
-#include "hepdb/ckkeys.inc"
-#include "hepdb/csavbk.inc"
- CHARACTER PATH*(*), CHBANK*(*), CHOPT*(*)
- CHARACTER CHBK*4, CFMT*200
- DIMENSION ISEL(9), IMASK(9), KEYS(9)
-*
-* ------------------------------------------------------------------
-*
-* *** Retrieve the object first
-*
- IF (LOBJCS(1).NE.0) THEN
- CALL MZDROP (IDISCD, LOBJCS(1), 'L')
- LOBJCS(1) = 0
- ENDIF
- CALL CDUSEM (PATH, LOBJCS(1), ISEL, IMASK, KEYS, ' ', IRC)
- IF (IRC.NE.0) GO TO 100
-*
-* *** Now dump the bank(s)
-*
- CALL UOPTC (CHOPT, 'S', IOPTS)
- LBANK = LENOCC (CHBANK)
- IF (LBANK.EQ.0) THEN
- CHBK = ' '
- ELSE
- CHBK = CHBANK(1:MIN(LEN(CHBK),LBANK))
- ENDIF
- LOBJCS(2) = LQ(KOFUCD+LOBJCS(1)-KLDACD)
-*
- LPATH = LENOCC (PATH)
- CALL CDKYTG
- WRITE (LPRTCD, '('' Directory: '',A)') PATH(1:LPATH)
- WRITE (LPRTCD, '(8(4X,A8))') (CTAGCK(J), J = 1, NWKYCK)
- DO K1 = 1, NWKYCK, 8
- K2 = K1 + 7
- IF (K2.GT.NWKYCK) K2 = NWKYCK
- CFMT = '('
- NC1 = 2
- DO K = K1, K2
- IF (IOTYCK(K).LE.1) THEN
- CFMT(NC1:NC1+6) = ',2X,Z10'
- ELSE IF (IOTYCK(K).EQ.2) THEN
- CFMT(NC1:NC1+6) = ',1X,I11'
- ELSE
- CFMT(NC1:NC1+6) = ',4X,A8 '
- ENDIF
- NC1 = NC1 + 6
- ENDDO
- CFMT(NC1:NC1) = ')'
- WRITE (LPRTCD, CFMT) (IQ(KOFUCD+LOBJCS(1)+K), K = K1, K2)
- ENDDO
- IF (LOBJCS(2).EQ.0) GO TO 100
-*
- IF (LBANK.EQ.0) THEN
- CALL DZSNAP ('CDSHOW', IDISCD, LOBJCS(2), 'LV', 0, 0,
- + ND1, ND2)
- ELSE IF (IOPTS.NE.0) THEN
- CALL UCTOH (CHBK, ICHBK, 4, 4)
- LGO = 0
- LF = LZFID (IDISCD, ICHBK, IDBANK, LGO)
- IF (LF.GT.0) CALL DZSNAP ('CDSHOW', IDISCD, LF, 'B',
- + 0, 0, ND1, ND2)
- ELSE
- CALL UCTOH (CHBK, ICHBK, 4, 4)
- LGO = 0
- LF = LZFIDH (IDISCD, ICHBK, LGO)
- IF (LF.GT.0) THEN
- LGO = LZHEAD (IDISCD, LF)
- IBK = 0
- 10 IF (LGO.NE.0) THEN
- IBK = IBK + 1
- IF (IBK.GE.IDBANK.AND.IQ(KOFUCD+LGO-4).EQ.ICHBK)
- + CALL DZSNAP ('CDSHOW', IDISCD, LGO, 'B', 0, 0, ND1, ND2)
- LGO = LQ(KOFUCD+LGO)
- GO TO 10
- ENDIF
- ENDIF
- ENDIF
-*
- 100 IF (LOBJCS(1).NE.0) THEN
- CALL MZDROP (IDISCD, LOBJCS(1), 'L')
- LOBJCS(1) = 0
- ENDIF
-* END CDSHOW
- END
diff --git a/src/packlib/hepdb/cdutil/cdstat.F b/src/packlib/hepdb/cdutil/cdstat.F
deleted file mode 100644
index de55e97..0000000
--- a/src/packlib/hepdb/cdutil/cdstat.F
+++ /dev/null
@@ -1,193 +0,0 @@
-*
-* $Id: cdstat.F,v 1.1.1.1 1996/02/28 16:24:42 mclareni Exp $
-*
-* $Log: cdstat.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:42 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
-#if defined(CERNLIB__P3CHILD)
-* Ignoring t=dummy
-#endif
- SUBROUTINE CDSTAT (LUN, IRC)
-* ============================
-*
-************************************************************************
-* *
-* SUBR. CDSTAT (LUN, IRC*) *
-* *
-* Prints accumulated summary for the given run with the Data Base *
-* *
-* Arguments : *
-* *
-* LUN Logical unit on which statistics to be printed *
-* IRC Return code (see below) *
-* *
-* Called by user *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* = 98 : Invalid path name in Node bank *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
-#include "hepdb/ckkeys.inc"
-#include "hepdb/ctpath.inc"
- CHARACTER CHSTR*132, CFMT*136
-*
-* ------------------------------------------------------------------
-*
- IRC = 0
- IF (LUN.LE.0) GO TO 999
-*
-* *** Loop over all node banks
-*
- CALL CDPRNT (LUN, '(/,'' CDSTAT : Summary of Database Elements '//
- + 'used '',/,'' ========================================== '')'
- +, IARGCD, 0)
- CALL CDPRNT (LUN, '(/,20X,''Path name'',28X,''CDUSE Call/Data '//
- + 'Read So.ID'',5X,''User Keys'',/)', IARGCD, 0)
- CFMT(1:2) = '('''
- CFMT(135:136) = ''')'
- CFMT(3:134) = ' '
-*
- LBUPCD = LTOPCD
- 10 IF (LBUPCD.EQ.0) GO TO 80
- NPARCD = IQ(KOFUCD+LBUPCD+MUPAIR)
- IHFLCD = IQ(KOFUCD+LBUPCD+MUPHFL)
- NUSF = NOF2CK + 2*NPARCD + 1
-*
- LBNOCD = LQ(KOFUCD+LBUPCD-1)
- IF (LBNOCD.EQ.0) GO TO 70
-*
-* ** Store the number of structural links already looked
-* ** at bank number address
-*
- 20 IQ(KOFUCD+LBNOCD-5) = IQ(KOFUCD+LBNOCD-2)
-*
-* * If all the links have not been looked at; go the next link
-*
- 30 IF (IQ(KOFUCD+LBNOCD-5).NE.0) THEN
- IQ(KOFUCD+LBNOCD-5) = IQ(KOFUCD+LBNOCD-5) - 1
- N = IQ(KOFUCD+LBNOCD-2) - IQ(KOFUCD+LBNOCD-5)
- LBAD = LQ(KOFUCD+LBNOCD-N)
- IF (LBAD.NE.0) THEN
- LBNOCD = LBAD
- GO TO 20
- ELSE
- GO TO 30
- ENDIF
-*
-* * Otherwise look at this Node bank
-*
- ELSE
-*
- NDK = IQ(KOFUCD+LBNOCD+MNDNWD)
- NCHAR = IQ(KOFUCD+LBNOCD+MNDNCH)
- CALL UHTOC (IQ(KOFUCD+LBNOCD+MNDNAM), 4, PAT2CT, NCHAR)
- PAT2CT = PAT2CT(1:NCHAR)
-*
- CALL RZCDIR (PAT2CT, ' ')
- IF (IQUEST(1).NE.0) THEN
- IRC = 98
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDSTAT : Illeg'//
- + 'al Path name '//PAT2CT(1:60)//' in node bank'')', IARGCD, 0)
-#endif
- GO TO 999
- ENDIF
-*
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- NKEYCK = IQUEST(7)
- NWKYCK = IQUEST(8)
- CALL CDKEYT
-*
-* * Loop over all key banks at this Node
-*
- LBKYCD = LQ(KOFUCD+LBNOCD-KLKYCD)
- 40 IF (LBKYCD.EQ.0) GO TO 60
-*
-* * Prepare the header part
-*
-#if !defined(CERNLIB_IBM)||!defined(CERNLIB__P3CHILD)
- WRITE (CHSTR, 8001) PAT2CT, IQ(KOFUCD+LBKYCD+NDK+MKYCRU),
- + IQ(KOFUCD+LBKYCD+NDK+MKYRID),
- + IQ(KOFUCD+LBKYCD+IDHUSI)
-#endif
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB__P3CHILD))
- IARGCD(1) = IQ(KOFUCD+LBKYCD+NDK+MKYCRU)
- IARGCD(2) = IQ(KOFUCD+LBKYCD+NDK+MKYRID)
- IARGCD(3) = IQ(KOFUCD+LBKYCD+IDHUSI)
- CHSTR = ' '
- CALL UTWRIT (CHSTR,'('' '//PAT2CT(1:56)//''',2I10,I6)',IARGCD,3)
-#endif
- NS1 = 84
-*
-* * Loop over user keys
-*
- IF (NWKYCK.GE.NUSF) THEN
- DO 50 I = NUSF, NWKYCK
- IF (NS1.GT.120) THEN
- CFMT(3:134) = CHSTR
- CALL CDPRNT (LUN, CFMT, IARGCD, 0)
- CHSTR = ' '
- NS1 = 84
- ENDIF
- IF (IOTYCK(I).EQ.2) THEN
- NS2 = NS1 + 9
-#if !defined(CERNLIB_IBM)||!defined(CERNLIB__P3CHILD)
- WRITE (CHSTR(NS1:NS2), 8002) IQ(KOFUCD+LBKYCD+I)
-#endif
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB__P3CHILD))
- CALL UTWRIT (CHSTR(NS1:NS2), '(I10)',
- + IQ(KOFUCD+LBKYCD+I), 1)
-#endif
- ELSE IF (IOTYCK(I).EQ.5 .OR. IOTYCK(I).EQ.6) THEN
- NS2 = NS1 + 7
-#if !defined(CERNLIB_IBM)||!defined(CERNLIB__P3CHILD)
- WRITE (CHSTR(NS1:NS2), 8003) IQ(KOFUCD+LBKYCD+I)
-#endif
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB__P3CHILD))
- CALL UTWRIT (CHSTR(NS1:NS2), '(4X,A4)',
- + IQ(KOFUCD+LBKYCD+I), 1)
-#endif
- ELSE
- NS2 = NS1 + 9
-#if !defined(CERNLIB_IBM)||!defined(CERNLIB__P3CHILD)
- WRITE (CHSTR(NS1:NS2), 8004) IQ(KOFUCD+LBKYCD+I)
-#endif
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB__P3CHILD))
- CALL UTWRIT (CHSTR(NS1:NS2), '(Z10)',
- + IQ(KOFUCD+LBKYCD+I), 1)
-#endif
- ENDIF
- NS1 = NS1 + 12
- 50 CONTINUE
- ENDIF
-*
- CFMT(3:134) = CHSTR
- CALL CDPRNT (LUN, CFMT, IARGCD, 0)
-*
- LBKYCD = LQ(KOFUCD+LBKYCD)
- GO TO 40
-*
- 60 LBNOCD = LQ(KOFUCD+LBNOCD+1)
- IF (LBNOCD.NE.LBUPCD) GO TO 30
- ENDIF
-*
- 70 LBUPCD = LQ(KOFUCD+LBUPCD)
- GO TO 10
- 80 CONTINUE
-#if !defined(CERNLIB_IBM)||!defined(CERNLIB__P3CHILD)
-*
- 8001 FORMAT (1X,A56,2I10,I6)
- 8002 FORMAT (I10)
- 8003 FORMAT (4X,A4)
- 8004 FORMAT (Z10)
-#endif
-* END CDSTAT
- 999 END
diff --git a/src/packlib/hepdb/cdutil/cdsumy.F b/src/packlib/hepdb/cdutil/cdsumy.F
deleted file mode 100644
index 2742bda..0000000
--- a/src/packlib/hepdb/cdutil/cdsumy.F
+++ /dev/null
@@ -1,188 +0,0 @@
-*
-* $Id: cdsumy.F,v 1.1.1.1 1996/02/28 16:24:45 mclareni Exp $
-*
-* $Log: cdsumy.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:45 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDSUMY (PATH, NLEVL, IRC)
-* ====================================
-*
-************************************************************************
-* *
-* SUBR. CDSUMY (PATH, NLEVL, IRC*) *
-* *
-* Prints statistics of the directory tree given by PATH *
-* *
-* Arguments : *
-* *
-* PATH Pathname of the directory *
-* NLEVL Number of levels below PATH about which information *
-* has to be printed *
-* IRC Return code (see below) *
-* *
-* Called by user *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* =131 : Illegal pathname *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
-#include "hepdb/ckkeys.inc"
-#include "hepdb/ctpath.inc"
- PARAMETER (NLEVM=20, KRUSE=13, KWUSE=14, KMEGA=15)
- DIMENSION NCHL(NLEVM), ISDI(NLEVM), NSDI(NLEVM)
- DIMENSION NKEY(NLEVM), IOPT(NLEVM), NKUSE(NLEVM)
- DIMENSION NRUSE(NLEVM), NWUSE(NLEVM), IHDIR(4)
- CHARACTER PATHN*80, PATHX*16, PATHY*80, PATHZ*16
- CHARACTER CNODE(NLEVM)*16, PATH*(*)
-#include "zebra/q_jbit.inc"
-* Ignoring t=pass
-*
-* ------------------------------------------------------------------
-*
-* *** Set the current directory to pathname
-*
- NLEV = NLEVL
- IF (NLEV.LE.0) NLEV = 99
- CALL CDLDUP (PATH, 1, IRC)
- IF (IRC.NE.0) GO TO 999
- PATHN = PAT1CT
-*
-* *** Get list of Nodes
-*
- CALL CDPARS (PATHN, NLEVM, CNODE, NCHL, NODES)
- ITIME = 0
- DO 10 I = 1, NLEVM
- NRUSE(I) = 0
- NWUSE(I) = 0
- NKUSE(I) = 0
- 10 CONTINUE
- NLPAT0 = NODES
- CALL CDPRNT (LPRTDB, '(//,'' NREC NWORDS NOBJECT D'//
- + 'IR. NAME'')', IARGCD, 0)
-*
-* *** Now scan down to find all the subdirectories
-*
- 20 IF (ITIME.NE.0) THEN
- CALL RZPAFF (CNODE, NODES, PATHN)
- IF (IQUEST(1).NE.0) THEN
- NODES = NODES - 1
- GO TO 30
- ENDIF
- CALL RZCDIR (PATHN, 'Q')
- IF (IQUEST(1).NE.0) THEN
- NODES = NODES - 1
- GO TO 30
- ENDIF
- NKEYCK = IQUEST(7)
- NWKYCK = IQUEST(8)
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- ENDIF
- IF (NKEYCK.GT.0) THEN
- IOPTP = JBIT (IQ(KOFSCD+LCDRCD+IKDRCD+IDHFLG), JPRTCD)
- ELSE
- IOPTP = 0
- ENDIF
- NKEY(NODES) = NKEYCK
- IOPT(NODES) = IOPTP
- ISDI(NODES) = 0
- NSDI(NODES) = IQ(KOFSCD+LCDRCD+KNSDCD)
-*
- 30 IF (NODES.LE.0) GO TO 100
- ISDI(NODES) = ISDI(NODES) + 1
- IF (ISDI(NODES).LE.NSDI(NODES)) THEN
-*
-* ** If a new subdirectory go down one level
-*
- LS = IQ(KOFSCD+LCDRCD+KLSDCD)
- IPNT = LS + 7 * (ISDI(NODES) - 1)
- CALL ZITOH (IQ(KOFSCD+LCDRCD+IPNT), IHDIR, 4)
- CALL UHTOC (IHDIR, 4, PATHX, 16)
- NCHR = LENOCC (PATHX)
- IF (IOPT(NODES).NE.0) THEN
- NCHRM = LENOCC (PATHN)
- DO 45 IK = 1, NKEY(NODES)
- KK = IK
- IDIG = 0
- 35 IF (KK.GT.0) THEN
- KK = KK / 10
- IDIG = IDIG + 1
- GO TO 35
- ENDIF
- IF (NCHR.EQ.IDIG) THEN
- WRITE (PATHY, '(I8)') IK
- I1 = 8 - IDIG + 1
- PATHZ = PATHY(I1:8)
- IF (PATHZ.EQ.PATHX) THEN
- PATHY = PATHN(1:NCHRM)//'/'//PATHX
- CALL RZCDIR (PATHY, 'Q')
- IF (IQUEST(1).NE.0) GO TO 45
- NKEYDK = IQUEST(7)
- LCDRDB = IQUEST(11)
- IKDRDB = IQUEST(13)
- DO 40 K = NLPAT0, NODES
- NRUSE(K) = NRUSE(K) + IQ(KOFSCD+LCDRCD+KRUSE)
- NWUSE(K) = NWUSE(K) + IQ(KOFSCD+LCDRCD+KWUSE)
- + + 1000000 * IQ(KOFSCD+LCDRCD+KMEGA)
- 40 CONTINUE
- NKUSE(NODES) = NKUSE(NODES) + NKEYCK
- CALL RZCDIR (PATHN, 'Q')
- IF (IQUEST(1).NE.0) THEN
- NODES = NODES - 1
- ELSE
- NKEYCK = IQUEST(7)
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- ENDIF
- GO TO 30
- ENDIF
- ENDIF
- 45 CONTINUE
- ENDIF
- ITIME = ITIME + 1
- NODES = NODES + 1
- CNODE(NODES) = PATHX
- GO TO 20
-*
- ELSE
-*
-* ** Check if the name is to be entered
-*
- CALL RZPAFF (CNODE, NODES, PATHY)
- NCHR = LENOCC (PATHY)
- DO 50 K = NLPAT0, NODES
- NRUSE(K) = NRUSE(K) + IQ(KOFSCD+LCDRCD+KRUSE)
- NWUSE(K) = NWUSE(K) + IQ(KOFSCD+LCDRCD+KWUSE)
- + + 1000000 * IQ(KOFSCD+LCDRCD+KMEGA)
- 50 CONTINUE
- IF (IOPT(NODES).EQ.0) NKUSE(NODES) = NKEY(NODES)
- IF (NODES.LE.(NLPAT0+NLEV)) THEN
- IARGCD(1) = NRUSE(NODES)
- IARGCD(2) = NWUSE(NODES)
- IARGCD(3) = NKUSE(NODES)
- CALL CDPRNT (LPRTDB, '(I9,2I11,'' '//PATHY(1:NCHR)//' '')',
- + IARGCD, 3)
- ENDIF
- NRUSE(NODES) = 0
- NWUSE(NODES) = 0
- NKUSE(NODES) = 0
-*
- NODES = NODES - 1
- IF (NODES.GE.NLPAT0) THEN
- LUP = LQ(KOFSCD+LCDRCD+1)
- CALL MZDROP (0, LCDRCD, ' ')
- LCDRCD = LUP
- GO TO 30
- ENDIF
- ENDIF
-*
- 100 IRC = 0
-* END CDSUMY
- 999 END
diff --git a/src/packlib/hepdb/cdutil/cdtext.F b/src/packlib/hepdb/cdutil/cdtext.F
deleted file mode 100644
index 56d36d9..0000000
--- a/src/packlib/hepdb/cdutil/cdtext.F
+++ /dev/null
@@ -1,51 +0,0 @@
-*
-* $Id: cdtext.F,v 1.1.1.1 1996/02/28 16:24:42 mclareni Exp $
-*
-* $Log: cdtext.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:42 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDTEXT(LUN,CHFILE,CHPATH,LBANK,CHOPT,IRC)
-
- CHARACTER*(*) CHFILE,CHPATH
-
-#include "hepdb/cduscm.inc"
-#include "hepdb/quest.inc"
-#include "hepdb/hdbopts.inc"
-
- IRC = 0
-
-*
-* Read text file
-*
- IF(IOPTR.NE.0) THEN
- IF(IOPTA.EQ.0) THEN
- CALL CDOPNF(LUN,CHFILE,LRECL,'FI',IRC)
- IF(IRC.NE.0) GOTO 99
- ENDIF
- CALL CDATOI(LUN,LBANK,IRC)
-*
-* Write text file
-*
- ELSEIF(IOPTW.NE.0) THEN
- IF(IOPTA.EQ.0) THEN
- CALL CDOPNF(LUN,CHFILE,LRECL,'FO',IRC)
- IF(IRC.NE.0) GOTO 99
- ENDIF
- CALL CDAFRI(LUN,LBANK,' ',IRC)
-*
-* Print
-*
- ELSEIF(IOPTP.NE.0) THEN
- CALL CDAFRI(LPRTCD,LBANK,'C',IRC)
-*
-* Delete
-*
- ELSEIF(IOPTD.NE.0) THEN
- ENDIF
-
- 99 CONTINUE
-
- END
diff --git a/src/packlib/hepdb/cdutil/cdtrek.F b/src/packlib/hepdb/cdutil/cdtrek.F
deleted file mode 100644
index 59a0eb8..0000000
--- a/src/packlib/hepdb/cdutil/cdtrek.F
+++ /dev/null
@@ -1,160 +0,0 @@
-*
-* $Id: cdtrek.F,v 1.1.1.1 1996/02/28 16:24:37 mclareni Exp $
-*
-* $Log: cdtrek.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:37 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDTREK(CHPATH,NLEVEL,CHOPT,IRC)
-*
-************************************************************************
-*
-* To traverse the HEPDB directory tree starting from
-* the specified pathname.
-* Modified from the RZ routine RZSTAT / RZSCAN
-* Input:
-* CHPATH The pathname of the starting directory
-* NLEVEL Number of levels below CHPATH about which space information
-* has to be accumulated.
-* UROUT External user routine to be called for each pathname
-*
-* Output:
-* IQUEST(11) = number of directories found
-*
-* Called by <USER>
-*
-*
-************************************************************************
-#include "hepdb/cdunit.inc"
-#include "zebra/rzcl.inc"
-#include "zebra/rzdir.inc"
-#include "zebra/rzch.inc"
-#include "zebra/rzk.inc"
- CHARACTER*(*) CHPATH
- CHARACTER*8 CHALIA
- DIMENSION ISD(15),NSD(15),IHDIR(4)
-#include "hepdb/hdbopts.inc"
-*
-*-----------------------------------------------------------------------
-*
-*
-*
-* Incompatible options
-*
- IF(IOPTN.NE.0) IOPTO = 0
- ISPACE = IOPTO+IOPTS+IOPTC+IOPTM
-
- IRC = 0
- IQUEST(1) = 0
- IQUEST(11) = 0
-*
- ITIME=0
- NLEV=NLEVEL
- IF(NLEV.LE.0)NLEV=99
- NFOUND = 0
- ITEMP = 0
- CALL RZCDIR(CHWOLD,'R')
-*
-* Set CWD to the current level
-*
- 10 CONTINUE
- IF(ITIME.NE.0)THEN
- CALL RZPAFF(CHPAT,NLPAT,CHL)
- CALL RZCDIR(CHL,' ')
- ELSE
- CALL RZCDIR(CHPATH,' ')
- IF(IQUEST(1).NE.0)GO TO 99
- NLPAT0=NLPAT
- CHL = CHPATH
- ENDIF
- IF(IQUEST(1).NE.0) THEN
- NLPAT = NLPAT - 1
- GOTO 90
- ENDIF
-*
-* Print current directory
-*
- LCHL = LENOCC(CHL)
-
- IF(IOPTA.NE.0) THEN
- CALL CDGALI(CHL(1:LCHL),CHALIA,IRC)
- ENDIF
- IF(ITIME.NE.0) THEN
- ISTART = INDEXB(CHL(1:LCHL),'/')-1
- CALL CFILL(' ',CHL,1,ISTART)
- ENDIF
-
- IF(IOPTA.EQ.0) THEN
- WRITE (LOUTCD,*) CHL(1:LCHL)
- ELSE
- WRITE (LOUTCD,9001) CHALIA,CHL(1:LCHL)
-9001 FORMAT(1X,A8,1X,A)
- ENDIF
-*
-* Counters
-*
-*. IQUEST(7)=IQ(KQSP+LCDIR+KNKEYS)
-*. IQUEST(8)=IQ(KQSP+LCDIR+KNWKEY)
-*. IQUEST(9)=IQ(KQSP+LCDIR+KNSD)
-*. IQUEST(14)=IDATEC
-*. IQUEST(15)=ITIMEC
-*. IQUEST(16)=IDATEM
-*. IQUEST(17)=ITIMEM
-
- IF(IOPTN.NE.0.AND.IQUEST(7).GT.0) WRITE (LOUTCD,9002) IQUEST(7)
-9002 FORMAT(' Objects : ',I11)
- IF(IOPTO.NE.0) WRITE (LOUTCD,9002) IQUEST(7)
- IF(IOPTS.NE.0) WRITE (LOUTCD,9003) IQUEST(9)
-9003 FORMAT(' Subdirectories: ',I11)
- IF(IOPTC.NE.0) WRITE (LOUTCD,9004) IQUEST(14),IQUEST(15)
-9004 FORMAT(' Created : ',I6,1X,I4)
- IF(IOPTM.NE.0) WRITE (LOUTCD,9005) IQUEST(16),IQUEST(17)
-9005 FORMAT(' Modified : ',I6,1X,I4)
-
- JSPACE = ISPACE + IQUEST(7)
- IF(JSPACE.NE.0) WRITE(LOUTCD,*)
-
- ISD(NLPAT)=0
- NSD(NLPAT)=IQ(KQSP+LCDIR+KNSD)
-*
-* Process possible down directories
-*
- 20 ISD(NLPAT)=ISD(NLPAT)+1
- IF((ISD(NLPAT).LE.NSD(NLPAT)).AND.
- + (NLPAT.LT.(NLPAT0+NLEV))) THEN
- NLPAT=NLPAT+1
- LS=IQ(KQSP+LCDIR+KLS)
- IH=LS+7*(ISD(NLPAT-1)-1)
- CALL ZITOH(IQ(KQSP+LCDIR+IH),IHDIR,4)
- CALL UHTOC(IHDIR,4,CHPAT(NLPAT),16)
- ITIME=ITIME+1
- GO TO 10
- ELSE
-*
-* Write information on current directory
-*
- CALL RZPAFF(CHPAT,NLPAT,CHL)
- IF(NLPAT.LE.(NLPAT0+NLEV))THEN
- NFOUND = NFOUND + 1
- ENDIF
- 30 CONTINUE
- NLPAT=NLPAT-1
- IF(NLPAT.GE.NLPAT0)THEN
- LUP=LQ(KQSP+LCDIR+1)
- CALL MZDROP(JQPDVS,LCDIR,' ')
- LCDIR=LUP
- GO TO 20
- ENDIF
- ENDIF
-*
-* Reset CWD
-*
- 90 CALL RZCDIR(CHWOLD,' ')
-*
- 99 CONTINUE
- IRC = IQUEST(1)
- IQUEST(11) = NFOUND
- RETURN
- END
diff --git a/src/packlib/hepdb/cdutil/cduniq.F b/src/packlib/hepdb/cdutil/cduniq.F
deleted file mode 100644
index 753de09..0000000
--- a/src/packlib/hepdb/cdutil/cduniq.F
+++ /dev/null
@@ -1,58 +0,0 @@
-*
-* $Id: cduniq.F,v 1.1.1.1 1996/02/28 16:24:43 mclareni Exp $
-*
-* $Log: cduniq.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:43 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDUNIQ(FNAME,IRC)
-*
-* Generate unique name for journal file
-*
-#include "hepdb/slate.inc"
- CHARACTER*(*) FNAME
- CHARACTER*8 CHUSER,CHRAND
- CHARACTER*12 CHDATE
- CHARACTER*8 CHHOST
- CHARACTER*6 CHENT
- CHARACTER*1 CHDISK,CMXDSK
- INTEGER FMUSER
- SAVE NENTRY,CHUSER,CHHOST,LCHU,LCHH
- DATA NENTRY/0/
-
- IF(NENTRY.EQ.0) THEN
- CALL CDUSER(CHUSER,IRC)
- CALL CDHOST(CHHOST,IRC)
- LCHU = LENOCC(CHUSER)
- LCHH = LENOCC(CHHOST)
- ENDIF
-
- NENTRY = NENTRY + 1
- CALL DATIME(ID,IT)
-#if !defined(CERNLIB_IBM)
- WRITE(CHENT ,'(I6.6)') NENTRY
- CALL CDRAND(CHRAND,IRC)
-* WRITE(CHRAND,'(I8.8)') MOD(IRNDM(IDUMMY),100000000)
- WRITE(CHDATE,'(I6.6,I4.4,I2.2)') ID,IT,IS(6)
- FNAME = 'ZZ' // CHDATE // CHENT // CHRAND // '.' //
- + CHUSER(1:LCHU) // '_' // CHHOST(1:LCHH)
-#endif
-#if defined(CERNLIB_IBMMVS)
- WRITE(CHRAND,'(A1,I5.5,I2.2)') 'R',MOD(IRNDM(IDUMMY),100000),
- +IS(6)
- FNAME = CHUSER(1:LCHU) // '.' // CHHOST(1:LCHH) // '.' //
- + CHRAND
-#endif
-#if defined(CERNLIB_IBMVM)
- CALL CDRAND(CHRAND,IRC)
- CHDISK = CMXDSK()
- FNAME = 'ZZ' // CHRAND(3:) // ' ' // CHUSER(1:LCHU)
- + // ' ' // CHDISK
-#endif
-#if defined(CERNLIB_UNIX)
- CALL CUTOL(FNAME)
-#endif
-
- END
diff --git a/src/packlib/hepdb/cdutil/cduptm.F b/src/packlib/hepdb/cdutil/cduptm.F
deleted file mode 100644
index 165f528..0000000
--- a/src/packlib/hepdb/cdutil/cduptm.F
+++ /dev/null
@@ -1,70 +0,0 @@
-*
-* $Id: cduptm.F,v 1.3 1999/08/17 12:42:42 mclareni Exp $
-*
-* $Log: cduptm.F,v $
-* Revision 1.3 1999/08/17 12:42:42 mclareni
-* Y2k mods submitted by Rob Komar
-*
-* Revision 1.2 1999/01/04 08:14:55 jamie
-* y2k bug in cduptm
-*
-* Revision 1.1.1.1 1996/02/28 16:24:40 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDUPTM (IDATE, ITIME, IDATM, IRC)
-* ============================================
-*
-************************************************************************
-* *
-* SUBR. CDUPTM (IDATE*, ITIME*, IDATM, IRC*) *
-* *
-* Unpacks date and time from one word *
-* *
-* Arguments : *
-* *
-* IDATE Date : 6 Decimal integer : YYMMDD *
-* ITIME Time : 4 Decimal integer : HHMM *
-* IDATM Packed date-time *
-* IRC Return Code (See below) *
-* *
-* Called by <USER>, CDENFZ, CDFZUP, CDLKEY, CDPART, CDPURP *
-* Modified from original DBUPTM 19/03/90 JDS *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* = 93 : Illegal time *
-* *
-************************************************************************
-*
-#include "hepdb/cdunit.inc"
-#include "hepdb/ctmpak.inc"
-* ------------------------------------------------------------------
-*
- IRC = 0
- III = IDATM
- IMIN = MOD(III,MXMIN)
- III = (III-IMIN)/MXMIN
- IHOU = MOD(III,MXHOU)
- III = (III-IHOU)/MXHOU
- IDAY = MOD(III,MXDAY)
- III = (III-IDAY)/MXDAY
- IMON = MOD(III,MXMON)
- IYEA = (III-IMON)/MXMON
-
- IF((IYEA.GT.MXYEA) .OR. (IMON.GE.MXMON) .OR. (IDAY.GE.MXDAY) .OR.
- + (IHOU.GE.MXHOU) .OR. (IMIN.GE.MXMIN)) THEN
- IF(LLOGCD.GE.2)
- + PRINT *,'CDUPTM. Invalid PACKed time - IDATE/ITIME set to zero'
- IRC = 93
- IDATE = 0
- ITIME = 0
- ENDIF
-*
- IDATE = IDAY + 100*IMON + 10000*IYEA
- IDATE = MOD(IDATE,1000000)
- ITIME = IMIN + 100*IHOU
-* END CDUPTM
- END
diff --git a/src/packlib/hepdb/cdutil/cdupts.F b/src/packlib/hepdb/cdutil/cdupts.F
deleted file mode 100644
index bb91fe7..0000000
--- a/src/packlib/hepdb/cdutil/cdupts.F
+++ /dev/null
@@ -1,57 +0,0 @@
-*
-* $Id: cdupts.F,v 1.2 1999/08/17 12:42:43 mclareni Exp $
-*
-* $Log: cdupts.F,v $
-* Revision 1.2 1999/08/17 12:42:43 mclareni
-* Y2k mods submitted by Rob Komar
-*
-* Revision 1.1.1.1 1996/02/28 16:24:40 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDUPTS (IDATE, ITIME, IDATM, IRC)
-* ============================================
-*
-************************************************************************
-* *
-* SUBR. CDUPTS (IDATE*, ITIME*, IDATM) *
-* *
-* Unpacks date and time from one word *
-* *
-* Arguments : *
-* *
-* IDATE Date : 6 Decimal integer : YYMMDD *
-* ITIME Time : 6 Decimal integer : HHMMSS *
-* IDATM Packed date-time *
-* IRC Return Code (See below) *
-* *
-* Called by user *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* *
-************************************************************************
-*
-#include "hepdb/ctmpak.inc"
-* ------------------------------------------------------------------
-*
- IRC = 0
- III = IDATM
- ISEC = MOD(III,MXSEC)
- III = (III-ISEC)/MXSEC
- IMIN = MOD(III,MXMIN)
- III = (III-IMIN)/MXMIN
- IHOU = MOD(III,MXHOU)
- III = (III-IHOU)/MXHOU
- IDAY = MOD(III,MXDAY)
- III = (III-IDAY)/MXDAY
- IMON = MOD(III,MXMON)
- IYEA = (III-IMON)/MXMON
-*
- IDATE = IDAY + 100*IMON + 10000*(IYEA + 80)
- IDATE = MOD(IDATE,1000000)
- ITIME = ISEC + 100*IMIN + 10000*IHOU
-* END CDUPTS
- END
diff --git a/src/packlib/hepdb/cdutil/cduser.F b/src/packlib/hepdb/cdutil/cduser.F
deleted file mode 100644
index 213f744..0000000
--- a/src/packlib/hepdb/cdutil/cduser.F
+++ /dev/null
@@ -1,109 +0,0 @@
-*
-* $Id: cduser.F,v 1.1.1.1 1996/02/28 16:24:44 mclareni Exp $
-*
-* $Log: cduser.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:44 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
-#if !defined(CERNLIB_UNIX)
- SUBROUTINE CDUSER(CHUSER,IRC)
- CHARACTER*(*) CHUSER
-#if defined(CERNLIB_IBMVM)
- CHARACTER*80 CHLINE
-#endif
-#if (defined(CERNLIB_IBMVM))&&(defined(CERNLIB_HEPVM))
- DIMENSION SPACE(32)
- LOGICAL BATCH,JOB$VM
- CHARACTER*8 INFO(10)
- EQUIVALENCE (INFO(1),SPACE(1))
- EQUIVALENCE (TIME,SPACE(21))
- EQUIVALENCE (TNORM,SPACE(23))
- EQUIVALENCE (MACH,SPACE(25))
-C
- BATCH = JOB$VM(SPACE)
- CHUSER = INFO(1)
- IRC = 0
-#endif
-#if (defined(CERNLIB_IBMVM))&&(!defined(CERNLIB_VMBATCH))&&(!defined(CERNLIB_HEPVM))
- IRC = 0
- CALL VMCMS('IDENTIFY (STACK LIFO',IRC)
- CALL VMRTRM(CHLINE,LLINE)
- CHUSER = CHLINE(1:LLINE)
-#endif
-#if (defined(CERNLIB_IBMVM))&&(defined(CERNLIB_VMBATCH))
- IRC = 0
-*
-* Are we in batch?
-*
- CALL VMCMS('IDENTIFY (STACK LIFO',IRC)
- CALL VMRTRM(CHLINE,LLINE)
- IF(CHLINE(1:5).EQ.'VMBAT') THEN
- CALL VMCMS('VMBATCH SERVICE STACK $USER',IRC)
- IF(IRC.EQ.0) THEN
- CALL VMRTRM(CHLINE,LLINE)
- CHUSER = CHLINE(1:LLINE)
- ELSE
- IF(IDEBFA.GE.-3) PRINT *,'CDUSER. cannot determine ',
- + 'username. Using *UNKNOWN'
- CHUSER = '*UNKNOWN'
- IRC = 1
- ENDIF
- ELSE
- USER = CHLINE(1:LLINE)
- ENDIF
-#endif
-#if defined(CERNLIB_VAXVMS)
- INCLUDE '($JPIDEF)'
- INTEGER SYS$GETJPIW
- STRUCTURE /ITMLST/
- UNION
- MAP
- INTEGER*2 BUFFER_LENGTH
- INTEGER*2 ITEM_CODE
- INTEGER*4 BUFFER_ADDRESS
- INTEGER*4 RETURN_LENGTH_ADDRESS
- ENDMAP
- MAP
- INTEGER*4 END_LIST /0/
- ENDMAP
- END UNION
- END STRUCTURE
-
- RECORD /ITMLST/ JPI_LIST(2)
-
- JPI_LIST(1).BUFFER_LENGTH = LEN(CHUSER)
- JPI_LIST(1).ITEM_CODE = JPI$_USERNAME
- JPI_LIST(1).BUFFER_ADDRESS = %LOC(CHUSER)
- JPI_LIST(1).RETURN_LENGTH_ADDRESS = %LOC(LENU)
-
- JPI_LIST(2).END_LIST = 0
-
- ISTAT = SYS$GETJPIW(,,,JPI_LIST,,,)
- IF (.NOT. ISTAT) CALL LIB$SIGNAL(%VAL(ISTAT))
-#endif
-#if (defined(CERNLIB_IBMMVS))&&(defined(CERNLIB_NEWLIB))
- CHARACTER*16 NAMES
- CHARACTER*80 VARIABLE,VALUE
- CALL JOBNAM(NAMES)
- CHUSER(1:8) = NAMES
- IRC = 0
-#endif
-#if (defined(CERNLIB_IBMMVS))&&(!defined(CERNLIB_NEWLIB))
- LOGICAL INTRAC
- IF(INTRAC(DUMMY)) THEN
-*-- interactive mode
- NCH = 8
- IRC = ISPLNK('VCOPY','(ZUSER)',NCH,CHUSER,'MOVE')
- IF(IRC .NE.0) THEN
- CHUSER = 'unknown'
- ENDIF
- ELSE
-*-- batch mode
- CHUSER = 'MVSBATCH'
- ENDIF
-#endif
- RETURN
- END
-#endif
diff --git a/src/packlib/hepdb/cdutil/cdvalid.F b/src/packlib/hepdb/cdutil/cdvalid.F
deleted file mode 100644
index 868d680..0000000
--- a/src/packlib/hepdb/cdutil/cdvalid.F
+++ /dev/null
@@ -1,154 +0,0 @@
-*
-* $Id: cdvalid.F,v 1.1.1.1 1996/02/28 16:24:42 mclareni Exp $
-*
-* $Log: cdvalid.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:42 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDVALID (IVECT, IRC)
-* ===============================
-*
-************************************************************************
-* *
-* SUBR. CDVALID (IVECT*, IRC*) *
-* *
-* Finds the overlapping validity range of all data base objects *
-* used since the last call to CDINFO. *
-* *
-* Arguments : *
-* *
-* IVECT Vector returning the minimum and maximum values for the *
-* key pairs since the last call to CDINFO *
-* IRC Return code (see below) *
-* *
-* Called by user *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* = 94 : Non-matching NPAR in the different UPCD banks *
-* = 97 : No UPCD bank has been found *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
-#include "hepdb/ckkeys.inc"
- PARAMETER (NLEVM=20)
- DIMENSION ISDI(NLEVM), NSDI(NLEVM), IVECT(9)
-*
-* ------------------------------------------------------------------
-*
- NPARCD = -1
- IF (LTOPCD.EQ.0) THEN
- IRC = 97
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDVALID : Cannot'//
- + ' find the UPCD bank '')', IARGCD, 0)
-#endif
- GO TO 999
- ELSE
- IRC = 0
- ENDIF
-*
-* *** Loop over all top directories
-*
- LBUPCD = LTOPCD
- 10 IF (LBUPCD.GT.0) THEN
- IF (NPARCD.LT.0) THEN
- NPARCD = IQ(KOFUCD+LBUPCD+MUPAIR)
- IHFLCD = IQ(KOFUCD+LBUPCD+MUPHFL)
- DO 15 I = 1, NPARCD
- IVECT(2*I-1) = 0
- IVECT(2*I) = IBIGCD
- 15 CONTINUE
- ELSE IF (NPARCD.NE.IQ(KOFUCD+LBUPCD+MUPAIR)) THEN
- IRC = 94
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) THEN
- IARGCD(1) = NPARCD
- IARGCD(2) = IQ(KOFUCD+LBUPCD+MUPAIR)
- CALL CDPRNT (LPRTCD, '(/,'' CDVALID : Mismatching Npair'//
- + ' '',2I8)', IARGCD, 2)
- ENDIF
-#endif
- GO TO 999
- ENDIF
- NLEV = 0
- LBNOCD = LQ(KOFUCD+LBUPCD-1)
-*
-* ** Scan down the nodes to find all the subdirectories
-*
- 20 IF (LBNOCD.GT.0) THEN
- NLEV = NLEV + 1
- ISDI(NLEV) = 0
- NSDI(NLEV) = IQ(KOFUCD+LBNOCD-2)
-*
- 25 ISDI(NLEV) = ISDI(NLEV) + 1
- IF (ISDI(NLEV).LE.NSDI(NLEV)) THEN
-*
-* ** If a new subdirectory go down one level
-*
- LBD = LQ(KOFUCD+LBNOCD-ISDI(NLEV))
- IF (LBD.GT.0) THEN
- LBNOCD = LBD
- GO TO 20
- ELSE
- GO TO 25
- ENDIF
-*
- ELSE
-*
-* ** Loop over all the key banks
-*
- NDK = IQ(KOFUCD+LBNOCD+MNDNWD)
- LBKYCD = LQ(KOFUCD+LBNOCD)
- 30 IF (LBKYCD.GT.0) THEN
- IOFF = KOFUCD + LBKYCD + NOF1CK
- IF (IQ(KOFUCD+LBKYCD+NDK+MKYCEV).GT.0) THEN
- IF (IHFLCD.EQ.0) THEN
- IBEG = 0
- IEND = 0
- DO 35 I = 1, NPARCD
- IF (IBEG.EQ.0) THEN
- IF (IQ(IOFF+2*I-1).LT.IVECT(2*I-1)) IBEG =-I
- IF (IQ(IOFF+2*I-1).GT.IVECT(2*I-1)) IBEG = I
- ENDIF
- IF (IEND.EQ.0) THEN
- IF (IQ(IOFF+2*I) .GT.IVECT(2*I)) IEND =-I
- IF (IQ(IOFF+2*I) .LT.IVECT(2*I)) IEND = I
- ENDIF
- 35 CONTINUE
- DO 40 I = 1, NPARCD
- IF (IBEG.GT.0) IVECT(2*I-1) = IQ(IOFF+2*I-1)
- IF (IEND.GT.0) IVECT(2*I) = IQ(IOFF+2*I)
- 40 CONTINUE
- ELSE
- DO 45 I = 1, NPARCD
- IF (IQ(IOFF+2*I-1).GT.IVECT(2*I-1))
- + IVECT(2*I-1) = IQ(IOFF+2*I-1)
- IF (IQ(IOFF+2*I) .LT.IVECT(2*I))
- + IVECT(2*I) = IQ(IOFF+2*I)
- 45 CONTINUE
- ENDIF
- ENDIF
- LBKYCD = LQ(KOFUCD+LBKYCD)
- GO TO 30
- ENDIF
-*
-* ** Now go up one level
-*
- 50 NLEV = NLEV - 1
- IF (NLEV.GT.0) THEN
- LBNOCD = LQ(KOFUCD+LBNOCD+1)
- GO TO 20
- ENDIF
- ENDIF
- ENDIF
-*
- LBUPCD = LQ(KOFUCD+LBUPCD)
- GO TO 10
- ENDIF
-* END CDVALID
- 999 END
diff --git a/src/packlib/hepdb/cdutil/cdvect.F b/src/packlib/hepdb/cdutil/cdvect.F
deleted file mode 100644
index ff0a1a1..0000000
--- a/src/packlib/hepdb/cdutil/cdvect.F
+++ /dev/null
@@ -1,65 +0,0 @@
-*
-* $Id: cdvect.F,v 1.1.1.1 1996/02/28 16:24:43 mclareni Exp $
-*
-* $Log: cdvect.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:43 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDVECT(CHPATH,IVECT,LVECT,LBANK,CHOPT,IRC)
-
- CHARACTER*(*) CHPATH
- DIMENSION IVECT(LVECT)
-
- PARAMETER (JBIAS=2)
- DIMENSION LBD(9)
- CHARACTER*4 CHID
-#include "hepdb/cdcblk.inc"
-#include "hepdb/hdbopts.inc"
-
- IRC = 0
-*
-* I/O characteristic
-*
- IF(IOPTB.NE.0) IFORM = 1
- IF(IOPTI.NE.0) IFORM = 2
- IF(IOPTR.NE.0) IFORM = 3
- IF(IOPTD.NE.0) IFORM = 4
- IF(IOPTH.NE.0) IFORM = 5
-*
-* Get or put?
-*
- IF(IOPTG.EQ.0.AND.IOPTP.EQ.0) THEN
- IF(IDEBCD.GE.0) WRITE(LPRTCD,9001)
-9001 FORMAT(' CDVECT. please specify one of options G or P')
- IRC = -1
- RETURN
- ENDIF
-*
-* Get vector
-*
- IF(IOPTG.NE.0) THEN
-
- ND = IQ(KOFUCD+LBANK-1)
- IF(ND.GT.LVECT) IRC = 1
- CALL UCOPY(IQ(KOFUCD+LBANK+1),IVECT,MIN(ND,LVECT))
-*
-* Put vector
-*
- ELSEIF(IOPTP.NE.0) THEN
- IF (LBFXCD.NE.0) THEN
- CALL UHTOC (IQ(KOFUCD+LBFXCD-4), 4, CHID, 4)
- IF (CHID.EQ.'USER') CALL MZDROP (IDIVCD, LBFXCD, ' ')
- ENDIF
- NDATA = LVECT
- CALL CDBANK (IDIVCD, LBFXCD, LBFXCD, JBIAS, 'USER', 0, 0,
- + NDATA, IFORM, -1, IRC)
- IF (IRC.NE.0) GO TO 999
- CALL UCOPY(IVECT,IQ(KOFUCD+LBFXCD+1),NDATA)
- LBANK = LBFXCD
- LBFXCD = 0
- ENDIF
-
- 999 CONTINUE
- END
diff --git a/src/packlib/hepdb/cdutil/cdword.F b/src/packlib/hepdb/cdutil/cdword.F
deleted file mode 100644
index 61f2e89..0000000
--- a/src/packlib/hepdb/cdutil/cdword.F
+++ /dev/null
@@ -1,52 +0,0 @@
-*
-* $Id: cdword.F,v 1.1.1.1 1996/02/28 16:24:40 mclareni Exp $
-*
-* $Log: cdword.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:40 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDWORD(DEST,IELEM,DELIM,SOURCE,IRC)
-*
-* Routine to return a word delimited by the specified character
-* Word 0 is the text preceding the first delimiter etc.
-*
- CHARACTER*(*) DEST,SOURCE
- CHARACTER*1 DELIM
-*
- IF (IELEM .LT. 0) THEN
- DEST = ' '
- IRC = 1
- RETURN
- ENDIF
-*
- IF (IELEM .EQ. 0) THEN
- IEND = INDEX(SOURCE,DELIM)
- IF(IEND.EQ.0) THEN
- IEND = LENOCC(SOURCE)
- ELSE
- IEND = IEND - 1
- ENDIF
- DEST = SOURCE(1:IEND)
- RETURN
- ENDIF
-*
-* Find start and end of string
-*
- ISTART = 0
- IEND = LENOCC(SOURCE)
- ILOC = 1
-*
-* Word IELEM is between IELEM and IELEM+1th occurance of
-* DELIM in SOURCE
-*
- DO 10 I=1,IELEM+1
- ILOC = ISTART + 1
- ITEMP = INDEX(SOURCE(ILOC:IEND),DELIM)
- IF (I .LE. IELEM) ISTART = ISTART + ITEMP
- IF (I .EQ. IELEM+1) IEND = ISTART + ITEMP - 1
- 10 CONTINUE
- IF (ITEMP .EQ. 0) IEND = LENOCC(SOURCE)
- DEST = SOURCE(ISTART+1:IEND)
- END
diff --git a/src/packlib/hepdb/cdutil/cdzoo1.F b/src/packlib/hepdb/cdutil/cdzoo1.F
deleted file mode 100644
index ebe78cc..0000000
--- a/src/packlib/hepdb/cdutil/cdzoo1.F
+++ /dev/null
@@ -1,202 +0,0 @@
-*
-* $Id: cdzoo1.F,v 1.1.1.1 1996/02/28 16:24:38 mclareni Exp $
-*
-* $Log: cdzoo1.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:38 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDZOO1(PATH,IRC)
-*
-* To zoom down the HEPDB directory tree starting from
-* the specified pathname.
-*
-#include "hepdb/cdunit.inc"
-#include "zebra/rzcl.inc"
-#include "zebra/rzdir.inc"
-#include "zebra/rzch.inc"
-#include "zebra/rzk.inc"
- CHARACTER*(*) PATH
- CHARACTER*255 CHPATH
- PARAMETER (MAXLEV=20)
- CHARACTER*16 DIRNAM(MAXLEV),CHDIR
- DIMENSION ISD(15),NSD(15),IHDIR(4)
- DIMENSION IOPTV(2)
- EQUIVALENCE (IOPTQ,IOPTV(1)), (IOPTX,IOPTV(2))
-*
-*-----------------------------------------------------------------------
-*
-*
- IRC=0
- IQUEST(1) = 0
- IQUEST(11) = 0
- LPATH = LENOCC(PATH)
- LPATHI = LPATH
- CHPATH = PATH(1:LPATH)
- CALL CLTOU(CHPATH(1:LPATH))
-*
- ITIME = 0
-* NLEV = NLEVEL
-* IF(NLEV.LE.0) NLEV=99
- NLEV = 99
- NFOUND = 0
- ITEMP = 0
- CALL RZCDIR(CHWOLD,'R')
- LOLD = LENOCC(CHWOLD)
-*
-* Split input path name into its component pieces
-* (this is the opposite of RZPAFF which glues them together)
-*
- CALL CDPAFF(CHPATH(1:LPATH),DIRNAM,MAXLEV,IRET)
-*
-* Find first wild card in generic name
-*
- IF(LLOGCD.GE.3)
- +PRINT *,'CDZOO1. enter for PATH = ',CHPATH(1:LPATH)
- IWILD = ICFMUL('*%(<>',CHPATH,1,LPATH)
- IF(IWILD.LE.LPATH) THEN
- LPATH = INDEXB(CHPATH(1:IWILD),'/') - 1
- CALL CDNWRD('/',CHPATH(LPATH+2:LPATHI),NLEV0)
- NLEV = MIN(99,NLEV+NLEV0)
-* ELSE
-* LPATHI = LPATHI + 2
-* CHPATH(LPATHI-1:LPATHI) = '/*'
- ENDIF
-
- IF(LLOGCD.GE.3) PRINT *,'CDZOO1. zoom down ',
- + CHPATH(1:LPATH)
-*
-* Set CWD to the current level
-*
- 10 CONTINUE
- IF(ITIME.NE.0)THEN
- CALL RZPAFF(CHPAT,NLPAT,CHL)
- CALL RZCDIR(CHL,' ')
- ELSE
- CALL RZCDIR(CHPATH(1:LPATH),' ')
- IF(IQUEST(1).NE.0)GO TO 99
- NLPAT0=NLPAT
- CHL = CHPATH(1:LPATH)
- ENDIF
- IF(IQUEST(1).NE.0)GO TO 90
-*
-* Set IQUEST
-*
- IQUEST(12) = IQ(KQSP+LCDIR+KNSD)
- IQUEST(13) = NLPAT
- IQUEST(14) = IQ(KQSP+LCDIR+KNKEYS)
- IQUEST(15) = IQ(KQSP+LCDIR+KNWKEY)
-
- IF(LLOGCD.GE.3) PRINT *,'CDZOO1. directory ',CHL,
- + ' subdirectories: ',IQUEST(12),' files ',IQUEST(14)
-*
-* Ensure that entire path name matches ...
-*
- CALL CDMTCH(CHL,CHPATH(1:LPATHI),IRC)
-*
-* Trailing unmatched characters in CHPATH
-* Accept if first character is a / and total length
-* of pathname is ok
-*
- IF(IRC.EQ.2.AND.CHL(IQUEST(1):IQUEST(1)).EQ.'/'
- + .AND.NLPAT.LE.NLEV0+NLEV) IRC = 0
-
- IF(IRC.EQ.0) THEN
-*
-* If we have found a lowest level directory with 1 or more
-* files, then return
-*
- IF(IQUEST(12).EQ.0.AND.IQUEST(14).GT.0) RETURN
- ENDIF
-
- ISD(NLPAT)=0
- NSD(NLPAT)=IQ(KQSP+LCDIR+KNSD)
-*
-* If there is a <> at this level, perform matching
-* and follow only that path
-*
- ILT = INDEX(DIRNAM(NLPAT+1),'<')
- IGT = INDEX(DIRNAM(NLPAT+1),'>')
-
- IF((ILT.NE.0).AND.(IGT.NE.0)) THEN
- IF(LLOGCD.GE.-3) PRINT *,'CDZOO1. invalid wild-carding ',
- + 'at level ',NLPAT,' in pathname - ',DIRNAM(NLPAT+1)
- IF(LLOGCD.GE.-3) PRINT *,'CDZOO1. only one of < or > ',
- + 'may be specified'
- IQUEST(1) = -1
- GOTO 90
- ENDIF
-
- IF(ILT+IGT.NE.0) THEN
-*
-* Loop over all subdirectories at this level
-*
- DO 5 JJ=1,NSD(NLPAT)
- LS=IQ(KQSP+LCDIR+KLS)
- IH=LS+7*(JJ-1)
- CALL ZITOH(IQ(KQSP+LCDIR+IH),IHDIR,4)
- CALL UHTOC(IHDIR,4,CHDIR,16)
- CALL CDSELP(CHDIR,DIRNAM(NLPAT+1),JJ,NSD(NLPAT),JINDEX,IRC)
- 5 CONTINUE
- IF(JINDEX.GT.0) THEN
- IF(LLOGCD.GE.3) THEN
- LS=IQ(KQSP+LCDIR+KLS)
- IH=LS+7*(JINDEX-1)
- CALL ZITOH(IQ(KQSP+LCDIR+IH),IHDIR,4)
- CALL UHTOC(IHDIR,4,CHDIR,16)
- IF(LLOGCD.GE.2)
- + PRINT *,'CDZOO1. selected subdirectory ',CHDIR
- ENDIF
- NSD(NLPAT) = JINDEX
- ISD(NLPAT) = JINDEX - 1
- ELSE
- IF(LLOGCD.GE.2)
- + PRINT *,'CDZOO1. no subdirectory matches'
- NSD(NLPAT) = 0
- ENDIF
- ELSE
- JINDEX = -1
- ENDIF
-*
-* Process possible down directories
-*
- 20 ISD(NLPAT)=ISD(NLPAT)+1
- IF((ISD(NLPAT).LE.NSD(NLPAT)).AND.
- + (NLPAT.LT.(NLPAT0+NLEV))) THEN
- NLPAT=NLPAT+1
- LS=IQ(KQSP+LCDIR+KLS)
- IH=LS+7*(ISD(NLPAT-1)-1)
- CALL ZITOH(IQ(KQSP+LCDIR+IH),IHDIR,4)
- CALL UHTOC(IHDIR,4,CHPAT(NLPAT),16)
- ITIME=ITIME+1
- GO TO 10
- ELSE
-*
-* Write information on current directory
-*
- CALL RZPAFF(CHPAT,NLPAT,CHL)
- IF(NLPAT.LE.(NLPAT0+NLEV))THEN
- NFOUND = NFOUND + 1
- ENDIF
- 30 CONTINUE
- NLPAT=NLPAT-1
- IF(NLPAT.GE.NLPAT0)THEN
- LUP=LQ(KQSP+LCDIR+1)
- CALL MZDROP(JQPDVS,LCDIR,' ')
- LCDIR=LUP
- GO TO 20
- ENDIF
- ENDIF
-*
-* Reset CWD
-*
- 90 CALL RZCDIR(CHWOLD(1:LOLD),' ')
-*
- 99 CONTINUE
-*
-* No match
-*
- IRC = 1
- RETURN
- END
diff --git a/src/packlib/hepdb/cdxint/Imakefile b/src/packlib/hepdb/cdxint/Imakefile
deleted file mode 100644
index 6db2792..0000000
--- a/src/packlib/hepdb/cdxint/Imakefile
+++ /dev/null
@@ -1,9 +0,0 @@
-SRCS_F= cdacpl.F cdacti.F cdaird.F cdaiwr.F cdauxi.F cdchti.F \ @@\
- cdclfl.F cdconc.F cdcrdr.F cdctob.F cdctor.F cddckh.F cddckv.F \ @@\
- cddisd.F cddish.F cddisp.F cddisv.F cddkyh.F cddkyv.F cddprg.F \ @@\
- cdedas.F cdedky.F cdftio.F cdhead.F cdinxi.F cdjoin.F cdlook.F \ @@\
- cdopfl.F cdpeek.F cdpres.F cdproc.F cdrdda.F cdrdio.F cdrgck.F \ @@\
- cdrgcv.F cdrvnt.F cdrvpl.F cdsget.F cdtemp.F cdupky.F cdvhea.F \ @@\
- cdview.F cdvwpr.F cdwrdp.F cdxini.F cdxopt.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/hepdb/cdxint/cdacpl.F b/src/packlib/hepdb/cdxint/cdacpl.F
deleted file mode 100644
index 217f76b..0000000
--- a/src/packlib/hepdb/cdxint/cdacpl.F
+++ /dev/null
@@ -1,344 +0,0 @@
-*
-* $Id: cdacpl.F,v 1.1.1.1 1996/02/28 16:24:45 mclareni Exp $
-*
-* $Log: cdacpl.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:45 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDACPL
-* =================
-*
-************************************************************************
-* *
-* SUBR. CDACPL *
-* *
-* Action Routines for menu /HEPDB/PLOT *
-* *
-* Allowed Actions : *
-* *
-* CDHELP, CDPLOB, CDPLOT, CDPLOV, CDPLTI, CDREAD, CDTREE *
-* *
-* Called by KUIP routine *
-* *
-************************************************************************
-*
-#include "hepdb/caopts.inc"
-#include "hepdb/cdcblk.inc"
-#include "hepdb/ccdisp.inc"
-#include "hepdb/ckkeys.inc"
-#include "hepdb/cplots.inc"
-#include "hepdb/ctpath.inc"
-#include "hepdb/cxlink.inc"
- PARAMETER (L3WKST=1)
- DIMENSION KOBJ1(NOBMCP), KOBJ2(2,NOBMCP)
- CHARACTER CPATL*32, CHOPT*32, PATHN*80, TOPN*16
- CHARACTER CFNAM*80, ALIAS*8, CHTAG*8
- DATA PATHN /' '/, ALIAS /' '/, CHTAG /' '/
-*
-* ------------------------------------------------------------------
-*
- CALL KUPATL (CPATL, NPAR)
-*
- IF (CPATL.EQ.'CDHELP') THEN
-*
-* ** CDHELP
-*
- TOPN = '*'
- CALL KUGETC (TOPN, NCH)
- IF (LTOPCD.NE.0) THEN
- IF (TOPN(1:1).EQ.'*') THEN
- NCHR = IQ(KOFUCD+LTOPCD+MUPNCH)
- CALL UHTOC (IQ(KOFUCD+LTOPCD+MUPNAM), 4, TOPN, NCHR)
- TOPN = TOPN(1:NCHR)
- ENDIF
- PATHN = '//'//TOPN
- CALL CDFPAT (PATHN, 20, LFRSCX, IRC)
- IF (IRC.EQ.0.AND.LFRSCX.NE.0) THEN
- CALL IGSG (L3WKST)
- CALL ICLRWK (1, 1)
- CALL CDPLBK (LFRSCX, IRC0)
- CALL IRQLC (1, 1, IST, NT, X, Y)
- CALL IGSA (L3WKST)
- IF (IST.NE.0) THEN
- CALL CDLOOK (LFRSCX, X, Y, PATHN)
- CALL MZDROP (IDIVCD, LFRSCX, ' ')
- LFRSCX = 0
- IF (PATHN(1:1).NE.' ') THEN
- CALL KUGETC (CFNAM, NCF)
-#if defined(CERNLIB_UNIX)
- CALL CUTOL (CFNAM)
-#endif
- CALL CDOPFL (LUKYCX, CFNAM, 'UNKNOWN', ISTAT)
- IF (ISTAT.NE.0) THEN
- CALL CDPRNT (L3PRCX, '(/,'' CDACPL : Error '',I12'//
- + ','' in opening file '//CFNAM(1:NCF)//''')',
- + ISTAT, 1)
- GO TO 999
- ENDIF
- CALL CDRHLP (PATHN, LUKYCX, IERR)
- IF (IERR.NE.0) CALL CDPRNT (LUKYCX, '(/,'' CDACPL : '//
- + 'Error '',I12,'' in getting help info. for '',/,'' '//
- + PATHN(1:72)//''')', IERR, 1)
- CALL CDCLFL (LUKYCX)
- CALL KUEDIT (CFNAM, IST)
- ELSE
- CALL CDPRNT (L3PRCX, '(/,'' CDACPL : Cursor does not '//
- + 'point to any valid path'')', IARGCD, 0)
- ENDIF
- ELSE
- CALL CDPRNT (L3PRCX, '(/,'' CDACPL : Error '',I12,'' in'//
- + ' picking operation'')', IST, 1)
- ENDIF
- ELSE
- CALL CDPRNT (L3PRCX, '(/,'' CDACPL : Error '',I12,'' in '//
- + 'finding the tree for '//TOPN//''')', IRC, 1)
- ENDIF
- IF (LFRSCX.NE.0) THEN
- CALL MZDROP (IDIVCD, LFRSCX, ' ')
- LFRSCX = 0
- ENDIF
- ENDIF
-*
- ELSE IF (CPATL.EQ.'CDPLOB') THEN
-*
-* ** CDPLOB
-*
- CALL KUGETC (PATHN, NCH)
- CALL CDLDUP (PATHN, 0, IRC)
- IF (IRC.NE.0) THEN
- CALL CDPRNT (L3PRCX, '(/,'' CDACPL : Error in path name '//
- + PATHN(1:NCH)//''')', IARGCD, 0)
- GO TO 999
- ENDIF
- PATHN = PAT1CT
- CALL KUGETI (NOBJ)
- IF (NOBJ.LT.1) THEN
- NOBJ = 1
- ELSE IF (NOBJ.GT.NOBMCP) THEN
- NOBJ = NOBMCP
- ENDIF
- CALL KUGETI (NMASK)
- CALL KUGETI (KEX)
- CALL KUGETI (NST)
- CALL KUGETC (CHOPT, NCH)
- CALL CDOPTS (CHOPT, IRC)
- IF (IRC.NE.0) THEN
- CALL CDPRNT (L3PRCX, '(/,'' CDACPL : Error in decoding CHOP'//
- + 'T '//CHOPT(1:NCH)//''')', IARGCD, 0)
- GO TO 999
- ENDIF
- CALL VZERO (KEYSCX, 100)
- CALL VZERO (MASKCX, 100)
- CALL CDRVPL (1, NOBJ, NMASK, KOBJ1, KOBJ2, MASKCX, KEYSCX, IRC)
- IF (IRC.NE.0) GO TO 999
- CALL IGSG (L3WKST)
- CALL CDPLOB (PATHN, MASKCX,KEYSCX,NOBJ,KOBJ1,KEX,NST,CHOPT,IRC)
- IF (IRC.NE.0) CALL CDPRNT (L3PRCX, '(/,'' CDACPL : Error '','//
- + 'I12,'' in routine CDPLOB'')', IRC, 1)
- CALL IGSA (L3WKST)
-*
- ELSE IF (CPATL(1:6).EQ.'CDPLOT') THEN
-*
-* ** CDPLOT
-*
- CALL KUGETC (ALIAS, NCH)
- CALL CDRALI (ALIAS, PATHN, IRC)
- IF (IRC.NE.0) THEN
- CALL CDPRNT (L3PRCX, '(/,'' CDACPL : Error in the alias nam'//
- + 'e '//ALIAS//''')', IARGCD, 0)
- GO TO 999
- ENDIF
- CALL KUGETC (CHTAG, NCH)
- CALL CDGNAM (PATHN, CHTAG, IOBJ, IRC)
- IF (IRC.NE.0.OR.IOBJ.EQ.0) THEN
- CALL CDPRNT (L3PRCX, '(/,'' CDACPL : Error in the object '//
- + 'name '//CHTAG//''')', IARGCD, 0)
- GO TO 999
- ENDIF
- CALL CDLDUP (PATHN, 0, IRC)
- IF (IRC.NE.0) THEN
- CALL CDPRNT (L3PRCX, '(/,'' CDACPL : Error in path name '//
- + PATHN(1:NCH)//''')', IARGCD, 0)
- GO TO 999
- ENDIF
- PATHN = PAT1CT
- CALL KUGETI (NMASK)
- CALL KUGETC (CHOPT, NCH)
- CALL CDOPTS (CHOPT, IRC)
- IF (IRC.NE.0) THEN
- CALL CDPRNT (L3PRCX, '(/,'' CDACPL : Error in decoding CHOP'//
- + 'T '//CHOPT(1:NCH)//''')', IARGCD, 0)
- GO TO 999
- ENDIF
- CALL VZERO (KEYSCX, 100)
- CALL VZERO (MASKCX, 100)
- CALL CDRVPL (0, NOBJ, NMASK, KOBJ1, KOBJ2, MASKCX, KEYSCX, IRC)
- IF (IRC.NE.0) GO TO 999
- NOBJ = 1
- KEX = 3
- NST = 1
- CALL IGSG (L3WKST)
- CALL CDPLOB (PATHN, MASKCX,KEYSCX, NOBJ,IOBJ,KEX,NST, CHOPT,IRC)
- IF (IRC.NE.0) CALL CDPRNT (L3PRCX, '(/,'' CDACPL : Error '','//
- + 'I12,'' in routine CDPLOB'')', IRC, 1)
- CALL IGSA (L3WKST)
-*
- ELSE IF (CPATL.EQ.'CDPLOV') THEN
-*
-* ** CDPLOV
-*
- CALL KUGETC (PATHN, NCH)
- CALL CDLDUP (PATHN, 0, IRC)
- IF (IRC.NE.0) THEN
- CALL CDPRNT (L3PRCX, '(/,'' CDACPL : Error in path name '//
- + PATHN(1:NCH)//''')', IARGCD, 0)
- GO TO 999
- ENDIF
- PATHN = PAT1CT
- CALL KUGETI (NOBJ)
- IF (NOBJ.LT.1) THEN
- NOBJ = 1
- ELSE IF (NOBJ.GT.NOBMCP) THEN
- NOBJ = NOBMCP
- ENDIF
- CALL KUGETI (NMASK)
- CALL KUGETI (NST)
- CALL KUGETC (CHOPT, NCH)
- CALL CDOPTS (CHOPT, IRC)
- IF (IRC.NE.0) THEN
- CALL CDPRNT (L3PRCX, '(/,'' CDACPL : Error in decoding CHOP'//
- + 'T '//CHOPT(1:NCH)//''')', IARGCD, 0)
- GO TO 999
- ENDIF
- CALL VZERO (KEYSCX, 100)
- CALL VZERO (MASKCX, 100)
- CALL CDRVPL (2, NOBJ, NMASK, KOBJ1, KOBJ2, MASKCX, KEYSCX, IRC)
- IF (IRC.NE.0) GO TO 999
- CALL IGSG (L3WKST)
- CALL CDPLOV (PATHN, MASKCX,KEYSCX, NOBJ,KOBJ2, NST, CHOPT, IRC)
- IF (IRC.NE.0) CALL CDPRNT (L3PRCX, '(/,'' CDACPL : Error '','//
- + 'I12,'' in routine CDPLOV'')', IRC, 1)
- CALL IGSA (L3WKST)
-*
- ELSE IF (CPATL.EQ.'CDPLTI') THEN
-*
-* ** CDPLTI
-*
- CALL KUGETC (PATHN, NCH)
- CALL CDLDUP (PATHN, 0, IRC)
- IF (IRC.NE.0) THEN
- CALL CDPRNT (L3PRCX, '(/,'' CDACPL : Error in path name '//
- + PATHN(1:NCH)//''')', IARGCD, 0)
- GO TO 999
- ENDIF
- PATHN = PAT1CT
- CALL KUGETI (NMASK)
- CALL KUGETC (CHOPT, NCH)
- CALL CDOPTS (CHOPT, IRC)
- IF (IRC.NE.0) THEN
- CALL CDPRNT (L3PRCX, '(/,'' CDACPL : Error in decoding CHOP'//
- + 'T '//CHOPT(1:NCH)//''')', IARGCD, 0)
- GO TO 999
- ENDIF
- CALL VZERO (KEYSCX, 100)
- CALL VZERO (MASKCX, 100)
- CALL CDRVPL (0, NOBJ, NMASK, KOBJ1, KOBJ2, MASKCX, KEYSCX, IRC)
- IF (IRC.NE.0) GO TO 999
- CALL IGSG (L3WKST)
- CALL CDPLTI (PATHN, MASKCX, KEYSCX, CHOPT, IRC)
- IF (IRC.NE.0) CALL CDPRNT (L3PRCX, '(/,'' CDACPL : Error '','//
- + 'I12,'' in routine CDPLTI'')', IRC, 1)
- CALL IGSA (L3WKST)
-*
- ELSE IF (CPATL.EQ.'CDREAD') THEN
-*
-* ** CDREAD
-*
- TOPN = '*'
- CALL KUGETC (TOPN, NCH)
- IF (LTOPCD.NE.0) THEN
- IF (TOPN(1:1).EQ.'*') THEN
- NCHR = IQ(KOFUCD+LTOPCD+MUPNCH)
- CALL UHTOC (IQ(KOFUCD+LTOPCD+MUPNAM), 4, TOPN, NCHR)
- TOPN = TOPN(1:NCHR)
- ENDIF
- PATHN = '//'//TOPN
- CALL CDFPAT (PATHN, 20, LFRSCX, IRC)
- IF (IRC.EQ.0.AND.LFRSCX.NE.0) THEN
- CALL IGSG (L3WKST)
- CALL ICLRWK (1, 1)
- CALL CDPLBK (LFRSCX, IRC0)
- CALL IRQLC (1, 1, IST, NT, X, Y)
- CALL IGSA (L3WKST)
- IF (IST.NE.0) THEN
- CALL CDLOOK (LFRSCX, X, Y, PATHN)
- CALL MZDROP (IDIVCD, LFRSCX, ' ')
- LFRSCX = 0
- IF (PATHN(1:1).NE.' ') THEN
- CALL KUGETC (CFNAM, NCF)
-#if defined(CERNLIB_UNIX)
- CALL CUTOL (CFNAM)
-#endif
- CALL CDOPFL (LUKYCX, CFNAM, 'UNKNOWN', ISTAT)
- IF (ISTAT.NE.0) THEN
- CALL CDPRNT (L3PRCX, '(/,'' CDACPL : Error '',I12'//
- + ','' in opening file '//CFNAM(1:NCF)//''')',
- + ISTAT, 1)
- GO TO 999
- ENDIF
- CALL KUGETC (CHOPT, NCH)
- CALL UOPTC (CHOPT, 'H', IOPHCC)
- CALL UOPTC (CHOPT, 'X', IOPXCA)
- CALL CDPEEK (CFNAM, NCF, PATHN, IRC)
- ELSE
- CALL CDPRNT (L3PRCX, '(/,'' CDACPL : Cursor does not '//
- + 'point to any valid path'')', IARGCD, 0)
- ENDIF
- ELSE
- CALL CDPRNT (L3PRCX, '(/,'' CDACPL : Error '',I12,'' in'//
- + ' picking operation'')', IST, 1)
- ENDIF
- ELSE
- CALL CDPRNT (L3PRCX, '(/,'' CDACPL : Error '',I12,'' in '//
- + 'finding the tree for '//TOPN//''')', IRC, 1)
- ENDIF
- IF (LFRSCX.NE.0) THEN
- CALL MZDROP (IDIVCD, LFRSCX, ' ')
- LFRSCX = 0
- ENDIF
- ENDIF
-*
- ELSE IF (CPATL.EQ.'CDTREE') THEN
-*
-* ** CDTREE
-*
- TOPN = '*'
- CALL KUGETC (TOPN, NCH)
- IF (LTOPCD.NE.0) THEN
- IF (TOPN(1:1).EQ.'*') THEN
- NCHR = IQ(KOFUCD+LTOPCD+MUPNCH)
- CALL UHTOC (IQ(KOFUCD+LTOPCD+MUPNAM), 4, TOPN, NCHR)
- TOPN = TOPN(1:NCHR)
- ENDIF
- PATHN = '//'//TOPN
- CALL CDFPAT (PATHN, 20, LFRSCX, IRC)
- IF (IRC.EQ.0.AND.LFRSCX.NE.0) THEN
- CALL IGSG (L3WKST)
- CALL ICLRWK (1, 1)
- CALL CDPLBK (LFRSCX, IRC0)
- CALL IGSA (L3WKST)
- ELSE
- CALL CDPRNT (L3PRCX, '(/,'' CDACPL : Error '',I12,'' in '//
- + 'finding the tree for '//TOPN//''')', IRC, 1)
- ENDIF
- IF (LFRSCX.NE.0) THEN
- CALL MZDROP (IDIVCD, LFRSCX, ' ')
- LFRSCX = 0
- ENDIF
- ENDIF
-*
- ENDIF
-* END CDACPL
- 999 END
diff --git a/src/packlib/hepdb/cdxint/cdacti.F b/src/packlib/hepdb/cdxint/cdacti.F
deleted file mode 100644
index 03b8baf..0000000
--- a/src/packlib/hepdb/cdxint/cdacti.F
+++ /dev/null
@@ -1,277 +0,0 @@
-*
-* $Id: cdacti.F,v 1.1.1.1 1996/02/28 16:24:46 mclareni Exp $
-*
-* $Log: cdacti.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:46 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDACTI
-* =================
-*
-************************************************************************
-* *
-* SUBR. CDACTI *
-* *
-* Action Routines for menu /HEPDB/INITCLOSE *
-* *
-* Allowed Actions : *
-* *
-* CDCRDR, CDDDIR, CDBFOR, CDENFL, CDEND, CDFZOP, CDFZUP, CDILDF, *
-* CDILDU, CDINIT, CDLOGL, CDPART, CDSAVE, CDSETD *
-* *
-* Called by KUIP routine *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
-#include "hepdb/ccdisp.inc"
-#include "hepdb/cinitl.inc"
-#include "hepdb/cxlink.inc"
- PARAMETER (MXLUN=10)
- CHARACTER CPATL*32, CHOPT*32, TOPNM*32, PATHN*80, CHOP*32
- CHARACTER PATHI*80, CFNAM*80
- DIMENSION LUNRZ(MXLUN)
- DATA PATHN /' '/, TOPNM /' '/, CFNAM /' '/, PATHI /' '/
- DATA IDATE /800101/, ITIME /0/, LUNF /0/, LUNI /0/
-*
-* ------------------------------------------------------------------
-*
- CALL KUPATL (CPATL, NPAR)
-*
- IF (CPATL.EQ.'CDCRDR') THEN
-*
-* ** CDCRDR
-*
- CALL KUGETC (PATHN, NCH)
- CALL KUGETI (NKEX)
- CALL KUGETC (CHOPT, NCP)
- CALL CDCRDR (PATHN, NKEX, CHOPT, IRC)
- CALL CDPRNT (L3PRCX, '(/,'' CDACTI : Create directory for '//
- + PATHN(1:NCH)//''',/,'' return code '',I12)',
- + IRC, 1)
-*
- ELSE IF (CPATL.EQ.'CDDDIR') THEN
-*
-* ** CDDDIR
-*
- CALL KUGETC (PATHN, NCH)
- CALL CDDDIR (PATHN, ' ', IRC)
- CALL CDPRNT (L3PRCX, '(/,'' CDACTI : Delete the directory tre'//
- + 'e '//PATHN(1:NCH)//''',/,'' return code '',I12)',
- + IRC, 1)
-*
- ELSE IF (CPATL.EQ.'CDBFOR') THEN
-*
-* ** CDBFOR
-*
- CALL KUGETC (TOPNM, NCH)
- CALL KUGETI (IDATE)
- CALL KUGETI (ITIME)
- CALL CDBFOR (TOPNM, IDATE, ITIME, IRC)
- IARGCD(1) = IDATE
- IARGCD(2) = ITIME
- CALL CDPRNT (L3PRCX, '(/,'' CDACTI : Retrieve data for '//
- + TOPNM(1:NCH)//' before '',2I8)', IARGCD, 2)
-*
- ELSE IF (CPATL.EQ.'CDENFL') THEN
-*
-* ** CDENFL
-*
- CALL KUGETC (TOPNM, NCH)
- NLUNS = 0
- LTOP = LTOPCD
- 5 IF (LTOP.GT.0) THEN
- NCHR = IQ(KOFUCD+LTOP+MUPNCH)
- CALL UHTOC (IQ(KOFUCD+LTOP+MUPNAM), 4, TOPNCI, NCHR)
- TOPNCI = TOPNCI(1:NCHR)
- IF (TOPNCI.EQ.TOPNM) THEN
- NLUNS = NLUNS + 1
- LUNRZ(NLUNS) = IQ(KOFUCD+LTOP+MUPLUN)
- GO TO 10
- ELSE
- LTOP = LQ(KOFUCD+LTOP)
- GO TO 5
- ENDIF
- ENDIF
- 10 CALL CDEND (TOPNM, ' ', IRC)
- IF (NLUNS.GT.0) THEN
- DO 15 ILUN = 1, NLUNS
- CALL CDCLFL (LUNRZ(ILUN))
- 15 CONTINUE
- ENDIF
- CALL CDPRNT (L3PRCX, '(/,'' CDACTI : Close data base file for'//
- + ' '//TOPNM//''')', IARGCD, 0)
-*
- ELSE IF (CPATL.EQ.'CDEND') THEN
-*
-* ** CDEND
-*
- NLUNS = 0
- LTOP = LTOPCD
- 20 IF (LTOP.GT.0.AND.NLUNS.LT.MXLUN) THEN
- NLUNS = NLUNS + 1
- LUNRZ(NLUNS) = IQ(KOFUCD+LTOP+MUPLUN)
- LTOP = LQ(KOFUCD+LTOP)
- GO TO 20
- ENDIF
- CALL CDEND ('*', 'A', IRC)
- IF (NLUNS.GT.0) THEN
- DO 25 ILUN = 1, NLUNS
- CALL CDCLFL (LUNRZ(ILUN))
- 25 CONTINUE
- ENDIF
-*
- ELSE IF (CPATL.EQ.'CDFZOP') THEN
-*
-* ** CDFZOP
-*
- CALL KUGETC (TOPNM, NCH)
- CALL KUGETI (LUNF)
- CALL KUGETC (CHOPT, NCH)
- CALL CDFZOP (LUNF, TOPNM, CHOPT, IRC)
- IARGCD(1) = LUNF
- IARGCD(2) = IRC
- CALL CDPRNT (L3PRCX, '(/,'' CDACTI : Open Journal file '',I4'//
- + ','' for '//TOPNM(1:10)//CHOPT(1:2)//''',/,'' '//
- + 'return code '',I12)', IARGCD, 2)
-*
- ELSE IF (CPATL.EQ.'CDFZUP') THEN
-*
-* ** CDFZUP
-*
- CALL KUGETI (LUNF)
- CALL KUGETC (CHOPT, NCH)
- CALL CDFZUP (LUNF, CHOPT, IRC)
- IARGCD(1) = LUNF
- IARGCD(2) = IRC
- CALL CDPRNT (L3PRCX, '(/,'' CDACTI : Update from Journal file'//
- + ' '',I4,'' return code'',I12)', IARGCD, 2)
-*
- ELSE IF (CPATL.EQ.'CDILDF') THEN
-*
-* ** CDILDF
-*
- CALL KUGETI (LUNI)
- CALL KUGETC (CFNAM, NCH)
-#if defined(CERNLIB_UNIX)
- CALL CUTOL (CFNAM)
-#endif
- CALL CDOPFL (LUNI, CFNAM, 'OLD', ISTAT)
- IF (ISTAT.EQ.0) THEN
- CALL KUGETC (CHOPT, NCH)
- CALL CDILDF (LUNI, CHOPT, IRC)
- CALL CDCLFL (LUNI)
- IARGCD(1) = IQUEST(11)
- IARGCD(2) = IRC
- CALL CDPRNT (L3PRCX, '(/,'' CDACTI : list of'',I6,'' direct'//
- + 'ories read from '//CFNAM(1:40)//' error code'',I12)',
- + IARGCD, 2)
- ELSE
- CALL CDPRNT (L3PRCX, '(/,'' CDACTI : error in opening file '//
- + CFNAM(1:40)//' on unit '',I6)', LUNI, 1)
- ENDIF
-*
- ELSE IF (CPATL.EQ.'CDILDU') THEN
-*
-* ** CDILDU
-*
- CALL KUGETI (LUNI)
- CALL KUGETC (CFNAM, NCH)
-#if defined(CERNLIB_UNIX)
- CALL CUTOL (CFNAM)
-#endif
- CALL CDOPFL (LUNI, CFNAM, 'OLD', ISTAT)
- IF (ISTAT.EQ.0) THEN
- CALL KUGETC (TOPNM, NCH)
- CALL KUGETC (CHOPT, NCH)
- CALL CDILDU (LUNI, TOPNM, CHOPT, IRC)
- CALL CDCLFL (LUNI)
- IARGCD(1) = IQUEST(11)
- IARGCD(2) = IRC
- CALL CDPRNT (L3PRCX, '(/,'' CDACTI : list of'',I6,'' direct'//
- + 'ories read from '//CFNAM(1:40)//' error code'',I12)',
- + IARGCD, 2)
- ELSE
- CALL CDPRNT (L3PRCX, '(/,'' CDACTI : error in opening file '//
- + CFNAM(1:40)//' on unit '',I6)', LUNI, 1)
- ENDIF
-*
- ELSE IF (CPATL.EQ.'CDINIT') THEN
-*
-* ** CDINIT
-*
- CALL KUGETI (LUNRZ)
- CALL KUGETC (CFNAM, NCH)
- CALL KUGETC (TOPNM, NCH)
- CALL KUGETI (LRECL)
- CALL KUGETC (CHOP, NCH)
- CALL RZOPEN (LUNRZ, TOPNM, CFNAM, CHOP, LRECL, IRC)
- IF (IRC.NE.0) GO TO 999
- CALL KUGETI (IDIV)
- CALL KUGETI (NREC)
- IF (NREC.GT.0) THEN
- CHOPT = 'Z'//CHOP
- ELSE
- CHOPT = CHOP
- ENDIF
- CALL KUGETI (NPAIR)
- CALL KUGETI (NTOP)
- CALL CDINIT (IDIV, LUNRZ,0, TOPNM, NPAIR,NREC, NTOP, CHOPT, IRC)
- IF (IRC.NE.0) THEN
- CALL CDCLFL (LUNRZ)
- ENDIF
-*
- ELSE IF (CPATL.EQ.'CDLOGL') THEN
-*
-* ** CDLOGL
-*
- CALL KUGETC (TOPNM, NCH)
- CALL KUGETI (LOGL)
- CALL KUGETC (CHOP, NCH)
- CALL CDLOGL (TOPNM, LOGL, CHOPT, IRC)
-*
- ELSE IF (CPATL.EQ.'CDPART') THEN
-*
-* ** CDPART
-*
- CALL KUGETC (PATHI, NCHI)
- CALL KUGETC (PATHN, NCHO)
- CALL KUGETI (MXKP)
- CALL KUGETC (CHOPT, NCH)
- CALL CDPART (PATHI, PATHN, MXKP, CHOPT, IRC)
- CALL CDPRNT (L3PRCX, '(/,'' CDACTI : Copies '//PATHI(1:NCHI)//
- + ' to '',/,'' '//PATHN(1:NCHO)//' return '//
- + 'code '',I12)', IRC, 1)
-*
- ELSE IF (CPATL.EQ.'CDSAVE') THEN
-*
-* ** CDSAVE
-*
-#if (defined(CERNLIB_IBMVM)||defined(CERNLIB_UNIX)||defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))&&(!defined(CERNLIB__P3CHILD))&&(!defined(CERNLIB__ONLINE))
- CALL CDSTSV (' ', 0, IRC)
-#endif
-* CALL CDSAVE (IRC)
- CALL CDPRNT (L3PRCX, '(/,'' CDACTI : Saves the changes to '//
- + 'data base - return code'',I12)', IRC, 1)
-*
- ELSE IF (CPATL.EQ.'CDSETD') THEN
-*
-* ** CDSETD
-*
- CALL KUGETI (MXDIS)
- IF (MXDIS.LE.0) THEN
- MXDPCC = 80
- ELSE IF (MXDIS.GT.512) THEN
- MXDPCC = 512
- ELSE
- MXDPCC = MXDIS
- ENDIF
- WRITE (CFMTCC, '(''(A'',I3,'')'')') MXDPCC
- CALL CDPRNT (L3PRCX, '(/,'' CDACTI : MXDIS is set to '',I10)',
- + MXDPCC, 1)
-*
- ENDIF
-* END CDACTI
- 999 END
diff --git a/src/packlib/hepdb/cdxint/cdaird.F b/src/packlib/hepdb/cdxint/cdaird.F
deleted file mode 100644
index cc5ea69..0000000
--- a/src/packlib/hepdb/cdxint/cdaird.F
+++ /dev/null
@@ -1,89 +0,0 @@
-*
-* $Id: cdaird.F,v 1.1.1.1 1996/02/28 16:24:46 mclareni Exp $
-*
-* $Log: cdaird.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:46 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDAIRD (LUN, PATHN, KEYX, CHOPT, IRC)
-* ================================================
-*
-************************************************************************
-* *
-* SUBR. CDAIRD (LUN, PATHN, KEYX, CHOPT, IRC*) *
-* *
-* Display the data attached to the directory PATHN and KEY for *
-* ASCII type of data *
-* *
-* Arguments : *
-* *
-* LUN Unit number of file for display *
-* PATHN Character string describing the pathname *
-* KEYX Key-vector *
-* CHOPT Character option *
-* E Object already exists at LFRSCX *
-* L The last object to be shown *
-* IRC Return code (see below) *
-* *
-* Called by CDAIWR, CDPEEK *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* *
-************************************************************************
-*
-#include "hepdb/caopts.inc"
-#include "hepdb/cdcblk.inc"
-#include "hepdb/ckkeys.inc"
-#include "hepdb/ctpath.inc"
-#include "hepdb/cxlink.inc"
- DIMENSION KEYX(9), IOPTS(2)
- CHARACTER PATHN*(*), CHOPT*(*), PATHY*80
- EQUIVALENCE (IOPTS(1), IOPTE), (IOPTS(2), IOPTL)
-*
-* ------------------------------------------------------------------
-*
-* *** Set the current directory
-*
- CALL UOPTC (CHOPT, 'EL', IOPTS)
- IF (IOPTE.NE.0) GO TO 10
- CALL CDLDUP (PATHN, 0, IRC)
- IF (IRC.NE.0) GO TO 999
- PATHY = PAT1CT
- CALL CDKEYT
- IF (NKEYCK.LE.0) GO TO 20
-*
-* ** Find the appropriate object number
-*
- IF (IOPTL.NE.0) THEN
- IOPK = IOPKCA
- CALL CDLKEY (PATHY, KEYVCK, IDATE, ITIME, 'K', IRC)
- IOPKCA = IOPK
- IF (IRC.NE.0) GO TO 999
- KYSER = KEYVCK(IDHKSN)
- ELSE
- KYSER = KEYX(IDHKSN)
- ENDIF
- CALL CDSGET (KYSER, IDIVCD, LFRSCX, IRC)
- IF (IRC.NE.0) GO TO 999
- 10 IF (LFRSCX.EQ.0) GO TO 20
- NDATA = IQ(KOFUCD+LFRSCX-1)
- IF (NDATA.LE.0) GO TO 20
-*
-* ** Display data if exists, if it does not, display dummy data
-*
- CALL CDAFRI (LUN, LFRSCX, ' ', IRC)
- GO TO 30
-*
- 20 WRITE (LUN, 1001) 'There is no data '
- 30 IF (IOPTE.EQ.0) THEN
- IF (LFRSCX.NE.0) CALL MZDROP (IDIVCD, LFRSCX, 'L')
- ENDIF
- IRC = 0
-*
- 1001 FORMAT (A)
-* END CDAIRD
- 999 END
diff --git a/src/packlib/hepdb/cdxint/cdaiwr.F b/src/packlib/hepdb/cdxint/cdaiwr.F
deleted file mode 100644
index 3227e77..0000000
--- a/src/packlib/hepdb/cdxint/cdaiwr.F
+++ /dev/null
@@ -1,95 +0,0 @@
-*
-* $Id: cdaiwr.F,v 1.1.1.1 1996/02/28 16:24:46 mclareni Exp $
-*
-* $Log: cdaiwr.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:46 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDAIWR (KEYX, KEYO, PATHN, CHOPT, IRC)
-* =================================================
-*
-************************************************************************
-* *
-* SUBR. CDAIWR (KEYX, KEYO, PATHN, CHOPT, IRC) *
-* *
-* Insert/Update ASCII files in the current working directory *
-* *
-* Arguments : *
-* *
-* KEYX Key-Vector containing the new Key values *
-* KEYO Key-Vector containing the old Key values *
-* PATHN Pathname of the directory *
-* CHOPT Character options *
-* I Insert new Key *
-* X Replace (update) old key *
-* IRC Return code (see below) *
-* *
-* Called by CDEDKY *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* *
-************************************************************************
-*
-#include "hepdb/caopts.inc"
-#include "hepdb/cdcblk.inc"
-#include "hepdb/ckkeys.inc"
-#include "hepdb/cxlink.inc"
- DIMENSION IOPTS(2), KEYX(9), KEYO(9)
- CHARACTER PATHN*(*), CHOPT*(*), CFNAM*80, CHOPF*4
- EQUIVALENCE (IOPTI, IOPTS(1)), (IOPTX, IOPTS(2))
-*
-* ------------------------------------------------------------------
-*
-* ** Open the file to editing
-*
- IRC = 0
- CALL KUPROC ('Give Data File-Name (e.g. DFNAME) ',CFNAM, LFNAM)
-#if !defined(CERNLIB_IBMVM)
- CFNAM = CFNAM(1:LFNAM)//'.FILEXT'
-#endif
-#if defined(CERNLIB_UNIX)
- CALL CUTOL (CFNAM)
-#endif
-#if defined(CERNLIB_IBMVM)
- CFNAM = CFNAM(1:LFNAM)//'.FILEXT.A'
-#endif
- CALL CDOPFL (LUDACX, CFNAM, 'UNKNOWN', ISTAT)
- IF (ISTAT.NE.0) GO TO 999
-*
-* *** Decode the character option
-*
- CALL UOPTC (CHOPT, 'IX', IOPTS)
- IF (IOPTX.NE.0) THEN
- CALL CDAIRD (LUDACX, PATHN, KEYO, ' ', IRC)
- ELSE
- CALL CDAIRD (LUDACX, PATHN, KEYX, 'L', IRC)
- ENDIF
- CALL CDCLFL (LUDACX)
- IF (IRC.NE.0) GO TO 999
-*
-* ** Edits the file containing the data
-*
- CALL KUEDIT (CFNAM, IST)
- IF (IST.NE.0) GO TO 999
-*
-* ** Read the data part
-*
- CALL CDOPFL (LUDACX, CFNAM, 'OLD', ISTAT)
- IF (ISTAT.NE.0) GO TO 999
- CALL CDATOI (LUDACX, LFRSCX, IRC)
- CALL CDCLFL (LUDACX)
- IF (IRC.NE.0) GO TO 999
-*
- IF (IOPTX.NE.0) THEN
- CHOPF = 'RTY'
- ELSE
- CHOPF = 'TY'
- ENDIF
- CALL CDSTOM (PATHN, LFRSCX, LKVWCX(1), IDIVCD, NWKYCK, 1, KEYO,
- + KEYX, CHOPF, IRC)
-* END CDAIWR
- 999 END
diff --git a/src/packlib/hepdb/cdxint/cdauxi.F b/src/packlib/hepdb/cdxint/cdauxi.F
deleted file mode 100644
index 157b1d7..0000000
--- a/src/packlib/hepdb/cdxint/cdauxi.F
+++ /dev/null
@@ -1,721 +0,0 @@
-*
-* $Id: cdauxi.F,v 1.1.1.1 1996/02/28 16:24:46 mclareni Exp $
-*
-* $Log: cdauxi.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:46 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDAUXI
-* =================
-*
-************************************************************************
-* *
-* SUBR. CDAUXI *
-* *
-* Action Routines for menu /HEPDB/AUXILIARY *
-* *
-* Allowed Actions : *
-* *
-* CDASCI, CDDISP, CDEALI, CDEDIT, CDEHLP, CDENAM, CDEXTR, CDKEEP, *
-* CDNTPL, CDPEEK, CDPTIM, CDPURG, CDPURK, CDPURP, CDRALI, CDRDIC, *
-* CDRENK, CDRHLP, CDRNAM, CDRTFZ, CDSHOW, CDSUMY, CDUTIM, CDVIEW, *
-* CDWRITE *
-* *
-* Called by KUIP routine *
-* *
-************************************************************************
-*
-#include "hepdb/caopts.inc"
-#include "hepdb/cdcblk.inc"
-#include "hepdb/ccdisp.inc"
-#include "hepdb/ckkeys.inc"
-#include "hepdb/cplots.inc"
-#include "hepdb/ctpath.inc"
-#include "hepdb/cxlink.inc"
- PARAMETER (NOBJM=100)
- DIMENSION NKEYX(NPMXCP), NOBJS(NPMXCP)
- DIMENSION KEYXS(NOBJM), KOBJS(NOBJM), ISEL(20)
- CHARACTER CPATL*32, CHOPT*32, PATHN*80, CHPRO*32, CTEMP*5
- CHARACTER YESNO*4, CFNAM*80, PATHS(NPMXCP)*80
- CHARACTER CRZPA*80, CTITL*80, CTAG(NOBJM)*8, CHOP*32
- CHARACTER ALIAS*8, CHTAG*8, CFMT*120
- DATA PATHN /' '/, ALIAS /' '/, CTITL /' '/
- DATA NWDS /0/, NPATH /1/, IDN /0/, KYI /0/, KYEL /0/
- DATA LUNFZ /0/, IDATM /0/
-#include "zebra/q_jbit.inc"
-* Ignoring t=pass
-*
-* ------------------------------------------------------------------
-*
- CALL KUPATL (CPATL, NPAR)
-*
- IF (CPATL.EQ.'CDASCI') THEN
-*
-* ** CDASCI
-*
- CALL KUGETC (PATHN, NCH)
- CALL KUGETC (CFNAM, NCH)
-#if defined(CERNLIB_UNIX)
- CALL CUTOL (CFNAM)
-#endif
- CALL KUGETC (CHOPT, NCH)
- CALL UOPTC (CHOPT, 'X', IOPXCA)
- CALL CDEDAS (CFNAM, NCH, PATHN, IRC)
-*
- ELSE IF (CPATL.EQ.'CDDISP') THEN
-*
-* ** CDDISP
-*
- CALL KUGETC (PATHN, NCH)
- CALL KUGETC (CFNAM, NCF)
-#if defined(CERNLIB_UNIX)
- CALL CUTOL (CFNAM)
-#endif
- CALL CDOPFL (LUKYCX, CFNAM, 'UNKNOWN', ISTAT)
- IF (ISTAT.NE.0) THEN
- CALL CDPRNT (L3PRCX, '(/,'' CDAUXI : error '',I12,'' in ope'//
- + 'ning file '//CFNAM(1:NCF)//''')', ISTAT, 1)
- GO TO 999
- ENDIF
- CALL KUGETC (CHOPT, NCH)
- CALL UOPTC (CHOPT, 'H', IOPHCC)
- CALL UOPTC (CHOPT, 'X', IOPXCA)
- CHOP = 'K'//CHOPT
- CALL CDDISP (LUKYCX, PATHN, CHOP, IRC)
- CALL CDCLFL (LUKYCX)
- CALL KUEDIT (CFNAM, IST)
-*
- ELSE IF (CPATL.EQ.'CDEALI') THEN
-*
-* ** CDEALI
-*
- CALL KUGETC (PATHN, NCT)
- CALL KUGETC (ALIAS, NCH)
- CALL KUGETI (IFLAG)
- CALL CDEALI (PATHN, ALIAS, IFLAG, IRC)
- IF (IRC.EQ.0) THEN
- CALL CDPRNT (L3PRCX, '(/,'' CDAUXI : Alias name of '//
- + PATHN(1:NCT)//' is '//ALIAS//''')', IARGCD, 0)
- ELSE
- CALL CDPRNT (L3PRCX, '(/,'' CDAUXI : Error in entering alia'//
- + 's name for '//PATHN(1:NCT)//''')', IARGCD, 0)
- ENDIF
-*
- ELSE IF (CPATL.EQ.'CDEDIT') THEN
-*
-* ** CDEDIT
-*
- CALL KUGETC (PATHN, NCH)
- CALL KUGETC (CFNAM, NCF)
-#if defined(CERNLIB_UNIX)
- CALL CUTOL (CFNAM)
-#endif
- CALL KUGETC (CHOPT, NCH)
- CALL UOPTC (CHOPT, 'X', IOPXCA)
- CALL KUPROC ('Create Directory ? (Y/N)', YESNO, NCH)
- IF (YESNO(1:1).EQ.'Y') THEN
- CALL KUPROI ('Number of user keys ', NKEX)
- CALL KUPROC ('Character option ', CHOPT, NCP)
- CALL CDCRDR (PATHN, NKEX, CHOPT, IRC)
- IF (IRC.NE.0) GO TO 999
- ENDIF
- CALL KUPROC ('Keys Insert/Update ? (Y/N)', YESNO, NCH)
- IF (YESNO(1:1).EQ.'Y') THEN
- CALL KUPROC ('Horizontal or Vertical Mode ? (H/V)',
- + YESNO, NCH)
- CALL UOPTC (YESNO, 'H', IOPHCC)
- CALL CDEDKY (CFNAM, NCF, PATHN, 'S', IRC)
- ENDIF
-*
- ELSE IF (CPATL.EQ.'CDEHLP') THEN
-*
-* ** CDEHLP
-*
- CALL KUGETC (PATHN, NCT)
- CALL KUGETC (CFNAM, NCH)
-#if defined(CERNLIB_UNIX)
- CALL CUTOL (CFNAM)
-#endif
- CALL KUEDIT (CFNAM, IST)
- IF (IST.EQ.0) THEN
- CALL CDOPFL (LUKYCX, CFNAM, 'UNKNOWN', ISTAT)
- IF (ISTAT.EQ.0) THEN
- CALL CDEHLP (PATHN, LUKYCX, IRC)
- CALL CDCLFL (LUKYCX)
- IF (IRC.EQ.0) THEN
- CALL CDPRNT (L3PRCX, '(/,'' CDAUXI : Help info. for '//
- + PATHN(1:NCT)//' is stored'')', IARGCD, 0)
- ELSE
- CALL CDPRNT (L3PRCX, '(/,'' CDAUXI : error '',I6,'' in '//
- + 'storing Help info. for '//PATHN(1:NCT)//''')',
- + IRC, 1)
- ENDIF
- ELSE
- CALL CDPRNT (L3PRCX, '(/,'' CDAUXI : error '',I12,'' in o'//
- + 'pening file '//CFNAM(1:NCH)//''')', ISTAT, 1)
- ENDIF
- ELSE
- CALL CDPRNT (L3PRCX, '(/,'' CDAUXI : error '',I12,'' in ed'//
- + 'iting file '//CFNAM(1:NCH)//''')', IST, 1)
- ENDIF
-*
- ELSE IF (CPATL.EQ.'CDENAM') THEN
-*
-* ** CDENAM
-*
- CALL KUGETC (PATHN, NCT)
- CALL KUGETI (NWDS)
- IF (NWDS.GT.NOBJM) THEN
- IARGCD(1) = NWDS
- IARGCD(2) = NOBJM
- CALL CDPRNT (L3PRCX, '(/,'' CDAUXI : Too many data elements'//
- + ' '',I12,'' maximum '',I5,'' is allowed'')', IARGCD, 2)
- GO TO 999
- ENDIF
- IF (NWDS.GT.0) THEN
- DO 5 I = 1, NWDS
- WRITE (CHPRO, 1001) I
- CALL CDPROC (CHPRO(1:10), CHTAG, NCH)
- CTAG(I) = CHTAG
- 5 CONTINUE
- CALL CDENAM (PATHN, NWDS, CTAG, IRC)
- IF (IRC.EQ.0) THEN
- CALL CDPRNT (L3PRCX, '(/,'' CDAUXI : Tags of data for '//
- + PATHN(1:NCT)//' is stored'')', IARGCD, 0)
- ELSE
- CALL CDPRNT (L3PRCX, '(/,'' CDAUXI : error '',I6,'' in st'//
- + 'oring Tags of data for '//PATHN(1:NCT)//''')', IRC, 1)
- ENDIF
- ENDIF
-*
- ELSE IF (CPATL.EQ.'CDKEEP') THEN
-*
-* ** CDKEEP
-*
- CALL KUGETI (NPATH)
- CALL KUGETC (CHOPT, NCH)
- IF (NPATH.GT.0) THEN
- DO 10 IP = 1, NPATH
- WRITE (CHPRO, 1002) IP
- CALL KUPROC (CHPRO(1:15), PATHS(IP), NCH)
- 10 CONTINUE
- CALL CDKEEP (PATHS, NPATH, CHOPT, IRC)
- IARGCD(1) = NPATH
- IARGCD(2) = IRC
- CALL CDPRNT (L3PRCX, '(/,'' CDAUXI : All but '',I6,'' direc'//
- + 'tory trees deleted - return code '',I6)', IARGCD, 2)
- ENDIF
-*
- ELSE IF (CPATL.EQ.'CDNTPL') THEN
-*
-* ** CDNTPL
-*
- CALL KUGETI (NPATH)
- IF (NPATH.LT.1) THEN
- NPATH = 1
- ELSE IF (NPATH.GT.NPMXCP) THEN
- NPATH = NPMXCP
- ENDIF
- CALL KUGETI (NMASK)
- CALL KUGETC (CHOPT, NCH)
- CALL KUGETI (IDN)
- CALL KUGETC (CTITL, NCT)
- CALL KUGETC (CRZPA, NCR)
- CALL KUGETI (NPRIM)
- CALL HCDIR (PATHN, 'R')
- CALL HCDIR (CRZPA, ' ')
- IF (IQUEST(1).NE.0) THEN
- CALL CDPRNT (L3PRCX, '('' RZ-path '//CRZPA(1:NCR)//' for '//
- + 'N-tuple is illegal'')', IARGCD, 0)
- GO TO 999
- ENDIF
- CALL HCDIR (CRZPA, 'R')
- CALL CDOPTS (CHOPT, IRC)
- IF (IRC.NE.0) GO TO 999
- CALL VZERO (KEYSCX, 100)
- CALL VZERO (MASKCX, 100)
- CALL CDRVNT (NPATH, PATHS, NMASK, MASKCX, KEYSCX, NVAR, NKST,
- + NDST, NKEYX, KEYXS, NOBJS, KOBJS, CTAG, NOBJM, IRC)
- IF (IRC.NE.0) GO TO 999
- IF (NVAR.LT.1) THEN
- CALL CDPRNT (L3PRCX, '('' Too few variables for N-tuple'')',
- + IARGCD, 0)
- GO TO 999
- ENDIF
-* ** Book the N-tuple
- CALL HCDIR (PATHN, ' ')
- CALL HBOOKN (IDN, CTITL(1:NCT), NVAR, CRZPA, NPRIM, CTAG)
- CALL CDNTPL (IDN, PATHS, NPATH, NOBJS, KOBJS, NKEYX, KEYXS,
- + MASKCX, KEYSCX, CHOPT, IRC)
- IF (IRC.NE.0) CALL CDPRNT (L3PRCX, '(/,'' CDAUXI : error'','//
- + 'I12,'' in routine CDNTPL'')', IRC, 1)
- CALL HCDIR (PATHN, ' ')
-*
- ELSE IF (CPATL.EQ.'CDPEEK') THEN
-*
-* ** CDPEEK
-*
- CALL KUGETC (PATHN, NCH)
- CALL KUGETC (CFNAM, NCF)
-#if defined(CERNLIB_UNIX)
- CALL CUTOL (CFNAM)
-#endif
- CALL CDOPFL (LUKYCX, CFNAM, 'UNKNOWN', ISTAT)
- IF (ISTAT.NE.0) THEN
- CALL CDPRNT (L3PRCX, '(/,'' CDAUXI : error '',I12,'' in ope'//
- + 'ning file '//CFNAM(1:NCF)//''')', ISTAT, 1)
- GO TO 999
- ENDIF
- CALL KUGETC (CHOPT, NCH)
- CALL UOPTC (CHOPT, 'H', IOPHCC)
- CALL UOPTC (CHOPT, 'X', IOPXCA)
- CALL CDPEEK (CFNAM, NCF, PATHN, IRC)
-*
- ELSE IF (CPATL.EQ.'CDPTIM') THEN
-*
-* ** CDPTIM
-*
- CALL KUGETI (IDATE)
- CALL KUGETI (ITIME)
- CALL KUGETC (CHOPT, NCH)
- IOPTM = INDEX (CHOPT, 'M')
- IF (IOPTM.EQ.0) THEN
- CALL CDPKTS (IDATE, ITIME, IARGCD(1), IRC)
- ELSE
- CALL CDPKTM (IDATE, ITIME, IARGCD(1), IRC)
- ENDIF
- IARGCD(2) = IDATE
- IARGCD(3) = ITIME
- CALL CDPRNT (L3PRCX, '(/,2X,I10,'' is the packed integer for '//
- + 'date and time : '',2I10,/)', IARGCD, 3)
-*
- ELSE IF (CPATL.EQ.'CDPURG') THEN
-*
-* ** CDPURG
-*
- CALL KUGETC (PATHN, NCH)
- CALL KUGETI (KYDAT)
- CALL KUGETI (KYTIM)
- CALL KUGETC (CHOPT, NCH)
- CALL CDPURG (PATHN, KYDAT, KYTIM, CHOPT, IRC)
- NCH = LENOCC (PATHN)
- IF (NCH.GT.40) NCH = 40
- IARGCD(1) = IQUEST(2)
- IARGCD(2) = IRC
- CALL CDPRNT (L3PRCX, '(/,'' CDAUXI : CDPURG deletes '',I6,'' '//
- + 'objects in Path '//PATHN(1:NCH)//' return code '',I6)',
- + IARGCD, 2)
-*
- ELSE IF (CPATL.EQ.'CDPURK') THEN
-*
-* ** CDPURK
-*
- CALL KUGETC (PATHN, NCH)
- CALL KUGETC (CHOPT, NCH)
- CALL CLTOU (CHOPT)
- CALL VZERO (IOKYCA, MXDMCK)
- IOPTB = INDEX (CHOPT, 'B')
- IOPTF = INDEX (CHOPT, 'F')
- IOPTK = INDEX (CHOPT, 'K')
- IOPTS = INDEX (CHOPT, 'S')
- IOPTX = INDEX (CHOPT, 'X')
- CALL CDXOPT (CHOPT, IOKYCA)
- CHOPT = ' '
- I0 = 0
- IF (IOPTB.EQ.1) THEN
- I0 = I0 + 1
- CHOPT(I0:I0) = 'B'
- ENDIF
- IF (IOPTF.EQ.1) THEN
- I0 = I0 + 1
- CHOPT(I0:I0) = 'F'
- ENDIF
- IF (IOPTK.EQ.1) THEN
- I0 = I0 + 1
- CHOPT(I0:I0) = 'K'
- ENDIF
- IF (IOPTS.EQ.1) THEN
- I0 = I0 + 1
- CHOPT(I0:I0) = 'S'
- ENDIF
- CALL CDLDUP (PATHN, 0, IRC)
- IF (IRC.EQ.0) THEN
- PATHN = PAT1CT
- CALL CDKEYT
- IF (IOPTF.NE.0) THEN
- IPRBCA = 0
- IPRECA = 0
- ENDIF
- DO 25 I = 1, NPARCD
- IF (IOPTK.EQ.0.AND.(IPRBCA.EQ.0.AND.IPRECA.EQ.0)) THEN
- IF (IOPTX.NE.0) THEN
- WRITE (CHPRO, 1003) 'YYMMDD'
- CALL KUPROI (CHPRO, IDATE)
- WRITE (CHPRO, 1003) 'HHMMSS'
- CALL KUPROI (CHPRO, ITIME)
- CALL CDPKTS (IDATE, ITIME, ISEL(I), IRC)
- ELSE
- WRITE (CHPRO, '(''Selection Key '',I2)') I
- CALL KUPROI (CHPRO, ISEL(I))
- ENDIF
- ELSE
- ISEL(I) = 0
- IOKYCA(NOF1CK+2*I-1) = 0
- IOKYCA(NOF1CK+2*I) = 0
- ENDIF
- 25 CONTINUE
- IF (IOPTK.NE.0) THEN
- CALL VZERO (MASKCX, 100)
- MASKCX(IDHKSN) = 1
- ELSE
- CALL UCOPY (IOKYCA, MASKCX, NWKYCK)
- ENDIF
- DO 30 I = 1, MIN(NWKYCK,29)
- IF (MASKCX(I).NE.0) THEN
- IF (I.GT.NOF1CK.AND.I.LE.NOF1CK+2*NPARCD.AND.
- + IOPTX.NE.0) THEN
- IF (I.LE.NOF1CK+NPARCD) THEN
- CTEMP = 'Begin'
- ELSE
- CTEMP = 'End'
- ENDIF
- WRITE (CHPRO, 1004) 'YYMMDD', CTEMP
- CALL KUPROI (CHPRO, IDATE)
- WRITE (CHPRO, 1004) 'HHMMSS', CTEMP
- CALL KUPROI (CHPRO, ITIME)
- CALL CDPKTS (IDATE, ITIME, KEYSCX(I), IRC)
- ELSE IF (I.EQ.IDHINS) THEN
- WRITE (CHPRO, 1005) 'YYMMDD', CTEMP
- CALL KUPROI (CHPRO, IDATE)
- WRITE (CHPRO, 1005) 'HHMM', CTEMP
- CALL KUPROI (CHPRO, ITIME)
- CALL CDPKTM (IDATE, ITIME, KEYSCX(I), IRC)
- ELSE
- WRITE (CHPRO, 1006) I
- IF (IOTYCK(I).LE.2) THEN
- CALL KUPROI (CHPRO, KEYSCX(I))
- ELSE
- CALL KUPROC (CHPRO, CTEMP, NCH)
- CALL UCTOH (CTEMP, KEYSCX(I), 4, 4)
- ENDIF
- ENDIF
- ENDIF
- 30 CONTINUE
- CALL CDPURK (PATHN, ISEL, MASKCX, KEYSCX, CHOPT, IRC)
- NCH = LENOCC (PATHN)
- IF (NCH.GT.40) NCH = 40
- IARGCD(1) = IQUEST(2)
- IARGCD(2) = IRC
- CALL CDPRNT (L3PRDX, '(/,'' CDAUXI : CDPURK deletes '',I6'//
- + ','' objects in Path '//PATHN(1:NCH)//' return code'//
- + ' '',I6)', IARGCD, 2)
- ENDIF
-*
- ELSE IF (CPATL.EQ.'CDPURP') THEN
-*
-* ** CDPURP
-*
- CALL KUGETC (PATHN, NCH)
- CALL KUGETI (IKEEP)
- CALL CDPURP (PATHN, IKEEP, ' ', IRC)
- IARGCD(1) = IKEEP
- IARGCD(2) = IRC
- CALL CDPRNT (L3PRCX, '(/,'' CDAUXI : all but'',I6,'' partitio'//
- + 'ns deleted from '//PATHN(1:60)//' return code '',I6)',
- + IARGCD, 2)
-*
- ELSE IF (CPATL.EQ.'CDRALI') THEN
-*
-* ** CDRALI
-*
- CALL KUGETC (ALIAS, NCH)
- CALL CDRALI (ALIAS, PATHN, IRC)
- CALL CDPRNT (L3PRCX, '(/,'' CDAUXI : Path name for alias '//
- + ALIAS//' is '//PATHN//''')', IARGCD, 0)
-*
- ELSE IF (CPATL.EQ.'CDRDIC') THEN
-*
-* ** DBRDIC
-*
- CALL KUGETC (PATHN, NCH)
- CALL CDRDIC (PATHN, IRC)
- CALL CDPRNT (L3PRCX, '(/,'' CDAUXI : dictionary recreated for'//
- + ' '//PATHN(1:NCH)//' with return code '',I6)', IRC, 1)
-*
- ELSE IF (CPATL.EQ.'CDRENK') THEN
-*
-* ** CDRENK
-*
- CALL KUGETC (PATHN, NCH)
- CALL KUGETI (KYI)
- CALL KUGETI (KYEL)
- CALL KUGETC (CHOPT, NCH)
- IOPTX = INDEX (CHOPT, 'X')
- CALL CDLDUP (PATHN, 0, IRC)
- IF (IRC.EQ.0) THEN
- PATHN = PAT1CT
- KST = NWKYCK + 1
- CALL CDKEYT
- IF (NKEYCK.NE.0) THEN
- IOPTP = JBIT (IQ(KOFSCD+LCDRCD+IKDRCD+IDHFLG), JPRTCD)
- ELSE
- IOPTP = 0
- ENDIF
- IF (IOPTP.NE.0) THEN
- NCHAR = LENOCC (PATHN)
- NKEYS = NKEYCK
- DO 45 JK = 1, NKEYS
- IK = NKEYS + 1 - JK
- KPNT = IUHUNT (IK, IQ(KOFSCD+LCDRCD+IKDRCD+MPSRCD),
- + NKEYS*KST, KST)
- IF (KPNT.GT.0) THEN
- IPNT = KOFSCD + LCDRCD + IKDRCD + KPNT - MPSRCD
- ELSE
- IPNT = KOFSCD + LCDRCD + IKDRCD + (NKEYCK - 1) * KST
- ENDIF
- IF (IQ(IPNT+MOBJCD).GT.KYI) GO TO 45
- CALL CDPATH (TOP2CT, IK)
- CALL RZCDIR (TOP2CT, ' ')
- IF (IQUEST(1).NE.0) THEN
- PAT2CT = PATHN(1:NCHAR)//'/'//TOP2CT
- CALL CDPRNT (L3PRCX, '(/,'' CDAUXI : Illegal Path name '
- + //PAT2CT//''')', IARGCD, 0)
- GO TO 999
- ENDIF
- NKEYCK = IQUEST(7)
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- KK = IUHUNT (KYI, IQ(KOFSCD+LCDRCD+IKDRCD+IDHKSN),
- + NKEYCK*KST, KST)
- IF (KK.GT.0) THEN
- KK = (KK - IDHKSN) / KST + 1
- GO TO 50
- ELSE
- CALL CDPRNT (L3PRCX, '(/,'' CDAUXI : Object '',I12'//
- + ','' not found in '//PATHN//''')', KYI, 1)
- GO TO 999
- ENDIF
- 45 CONTINUE
- CALL CDPRNT (L3PRCX, '(/,'' CDAUXI : Object '',I12'//
- + ','' not found in '//PATHN//''')', KYI, 1)
- GO TO 999
- ELSE
- KK = IUHUNT (KYI, IQ(KOFSCD+LCDRCD+IKDRCD+IDHKSN),
- + NKEYCK*KST, KST)
- IF (KK.GT.0) THEN
- KK = (KK - IDHKSN) / KST + 1
- ELSE
- CALL CDPRNT (L3PRCX, '(/,'' CDAUXI : Object '',I12'//
- + ','' not found in '//PATHN//''')', KYI, 1)
- GO TO 999
- ENDIF
- ENDIF
- 50 CALL CDKEYR (KK, NWKYCK, KEYSCX)
- CALL UCOPY (KEYSCX, KEYXS, NWKYCK)
- IF (KYEL.GT.0.AND.KYEL.LE.NWKYCK.AND.KYEL.NE.IDHKSN.AND.
- + KYEL.NE.IDHPTR.AND.KYEL.NE.IDHFLG.AND.KYEL.NE.IDHINS) THEN
- IF (KYEL.GT.NOF1CK.AND.KYEL.LE.NOF1CK+2*NPARCD.AND.
- + IOPTX.NE.0) THEN
- IF (KYEL.LE.NOF1CK+NPARCD) THEN
- CTEMP = 'Begin'
- ELSE
- CTEMP = 'End'
- ENDIF
- WRITE (CHPRO, 1004) 'YYMMDD', CTEMP
- CALL KUPROI (CHPRO, IDATE)
- WRITE (CHPRO, 1004) 'HHMMSS', CTEMP
- CALL KUPROI (CHPRO, ITIME)
- CALL CDPKTS (IDATE, ITIME, KEYXS(KYEL), IRC)
- ELSE
- WRITE (CHPRO, 1006) KYEL
- IF (IOTYCK(KYEL).LE.2) THEN
- CALL KUPROI (CHPRO, KEYXS(KYEL))
- ELSE
- CALL KUPROC (CHPRO, CTEMP, NCH)
- CALL UCTOH (CTEMP, KEYXS(KYEL), 4, 4)
- ENDIF
- ENDIF
- CALL CDRENK (PATHN, KEYSCX, KEYXS, IRC)
- IARGCD(1) = KYEL
- IARGCD(2) = KYI
- IARGCD(3) = IRC
- CALL CDPRNT (L3PRCX, '(/,'' CDAUXI : Key '',I4,'' changed'//
- + ' for Object '',I12,'' in '//PATHN(1:40)//' return c'//
- + 'ode '',I6)', IARGCD, 3)
- ELSE
- IARGCD(1) = KYEL
- IARGCD(2) = NWKYCK
- CALL CDPRNT (L3PRCX, '(/,'' CDAUXI : Key '',I4,'' illegal'//
- + ' for CDRENK - NWKYCK '',I8)', IARGCD, 2)
- ENDIF
- ELSE
- CALL CDPRNT (L3PRCX, '(/,'' CDAUXI : Illegal Path name '//
- + PATHN//''')', IARGCD, 0)
- ENDIF
-*
- ELSE IF (CPATL.EQ.'CDRHLP') THEN
-*
-* ** CDRHLP
-*
- CALL KUGETC (PATHN, NCH)
- CALL KUGETC (CFNAM, NCH)
-#if defined(CERNLIB_UNIX)
- CALL CUTOL (CFNAM)
-#endif
- CALL CDOPFL (LUKYCX, CFNAM, 'UNKNOWN', ISTAT)
- IF (ISTAT.EQ.0) THEN
- CALL CDRHLP (PATHN, LUKYCX, IERR)
- IF (IERR.NE.0) CALL CDPRNT (LUKYCX, '(/,'' CDAUXI : Error'//
- + ' '',I12,'' in getting help info. for '',/,'' '//PATHN(1:72)
- + //''')', IERR, 1)
- CALL CDCLFL (LUKYCX)
- CALL KUEDIT (CFNAM, IST)
- ELSE
- CALL CDPRNT (L3PRCX, '(/,'' CDAUXI : error '',I12,'' in ope'//
- + 'ning file '//CFNAM(1:NCH)//''')', ISTAT, 1)
- ENDIF
-*
- ELSE IF (CPATL.EQ.'CDRNAM') THEN
-*
-* ** CDRNAM
-*
- CALL KUGETC (PATHN, NCH)
- NWMAX = NOBJM
- CALL CDRNAM (PATHN, NWMAX, CTAG, IRC)
- CFMT(1:1) = '('
- CFMT(120:120) = ')'
- DO 60 I1 = 1, NWMAX, 5
- I2 = I1 + 4
- IF (I2.GT.NWMAX) I2 = NWMAX
- CFMT(2:119) = ' '
- DO 55 I = I1, I2
- IARGCD(I-I1+1) = I
- K1 = (I - I1) * 23 + 2
- K2 = K1 + 22
- CFMT(K1:K2) = ''' Tag '',I2,'' '','
- CFMT(K1+13:K1+20) = CTAG(I)
- 55 CONTINUE
- NARG = I2 - I1 + 1
- CALL CDPRNT (L3PRCX, CFMT, IARGCD, NARG)
- 60 CONTINUE
-*
- ELSE IF (CPATL.EQ.'CDEXTR'.OR.CPATL.EQ.'CDRTFZ') THEN
-*
-* ** CDEXTR/CDRTFZ
-*
- CALL KUGETC (PATHN, NCH)
- CALL KUGETI (LUNFZ)
- CALL KUGETC (CHOPT, NCH)
- CALL UOPTC (CHOPT, 'R', IOPR)
- CALL UOPTC (CHOPT, 'I', IOPI)
- IF (IOPI.NE.0.OR.IOPR.NE.0) THEN
- CHPRO = 'Date of insertion (YYMMDD)'
- CHOP = 'Time of insertion (HHMM)'
- ELSE
- CHPRO = 'Serial # of fisrt object'
- CHOP = 'Serial # of last object'
- ENDIF
- CALL KUPROI (CHPRO, K1MIN)
- CALL KUPROI (CHOP, K1MAX)
- IF (CPATL.EQ.'CDRTFZ') THEN
- CALL CDRTFZ (PATHN, LUNFZ, K1MIN, K1MAX, CHOPT, IRC)
- ELSE
- CALL CDEXTR (PATHN, LUNFZ, K1MIN, K1MAX, CHOPT, IRC)
- ENDIF
- NCH = LENOCC (PATHN)
- IF (NCH.GT.36) NCH = 36
- NCD = LENOCC (CHOPT)
- IF (NCD.LT.1) NCD = 1
- IARGCD(1) = IQUEST(2)
- IARGCD(2) = K1MIN
- IARGCD(3) = K1MAX
- IARGCD(4) = LUNFZ
- IARGCD(5) = IRC
- CALL CDPRNT (L3PRCX, '(/,'' CDAUXI : Transfers '',I8,'' objec'//
- + 'ts from '//PATHN(1:NCH)//' with CHOPT '//CHOPT(1:NCD)//
- + ' in range '',I7,'' - '',I8,/,10X,''to unit '',I4'//
- + ','' return code '',I6)', IARGCD, 5)
-*
- ELSE IF (CPATL.EQ.'CDSHOW') THEN
-*
-* ** CDSHOW
-*
- CALL KUGETC (PATHN, NCH)
- CALL KUGETC (CHOPT, NCH)
- CALL CDPRIN (PATHN, CHOPT, IRC)
-*
- ELSE IF (CPATL.EQ.'CDSUMY') THEN
-*
-* ** CDSUMY
-*
- CALL KUGETC (PATHN, NCH)
- CALL KUGETI (NLEVL)
- CALL CDSUMY (PATHN, NLEVL, IRC)
-*
- ELSE IF (CPATL.EQ.'CDUTIM') THEN
-*
-* ** CDUTIM
-*
- CALL KUGETI (IDATM)
- CALL KUGETC (CHOPT, NCH)
- IOPTM = INDEX (CHOPT, 'M')
- IF (IOPTM.EQ.0) THEN
- CALL CDUPTS (IARGCD(2), IARGCD(3), IDATM, IRC)
- ELSE
- CALL CDUPTM (IARGCD(2), IARGCD(3), IDATM, IRC)
- ENDIF
- IARGCD(1) = IDATM
- CALL CDPRNT (L3PRCX, '(/,2X,I10,'' is the packed integer for '//
- + 'date and time : '',2I10,/)', IARGCD, 3)
-*
- ELSE IF (CPATL.EQ.'CDVIEW') THEN
-*
-* ** CDVIEW
-*
- CALL KUGETC (PATHN, NCH)
- CALL KUGETC (CFNAM, NCF)
-#if defined(CERNLIB_UNIX)
- CALL CUTOL (CFNAM)
-#endif
- CALL KUGETC (CHOPT, NCH)
- CALL UOPTC (CHOPT, 'X', IOPXCA)
- CALL CDVIEW (CFNAM, PATHN, IRC)
-*
- ELSE IF (CPATL.EQ.'CDWRITE') THEN
-*
-* ** CDWRITE
-*
- CALL KUGETC (PATHN, NCH)
- CALL KUGETC (CFNAM, NCF)
-#if defined(CERNLIB_UNIX)
- CALL CUTOL (CFNAM)
-#endif
- CALL KUGETC (CHOPT, NCH)
- CALL UOPTC (CHOPT, 'X', IOPXCA)
- CALL KUPROC ('Create Directory ? (Y/N)', YESNO, NCH)
- IF (YESNO(1:1).EQ.'Y') THEN
- CALL KUPROI ('Number of user keys ', NKEX)
- CALL KUPROC ('Character option ', CHOPT, NCP)
- CALL CDCRDR (PATHN, NKEX, CHOPT, IRC)
- IF (IRC.NE.0) GO TO 999
- ENDIF
- CALL KUPROC ('Keys Insert/Update ? (Y/N)', YESNO, NCH)
- IF (YESNO(1:1).EQ.'Y') THEN
- CALL KUPROC ('Horizontal or Vertical Mode ? (H/V)',
- + YESNO, NCH)
- CALL UOPTC (YESNO, 'H', IOPHCC)
- CALL CDEDKY (CFNAM, NCF, PATHN, 'A', IRC)
- ENDIF
-*
- ENDIF
-*
- 1001 FORMAT ('Tag(',I2,')')
- 1002 FORMAT (I2,'th Path name')
- 1003 FORMAT (A,' of Validity time')
- 1004 FORMAT (A,' of ',A,' Range')
- 1005 FORMAT (A,' of Insertion time')
- 1006 FORMAT ('Key(',I2,') ?')
-* END CDAUXI
- 999 END
diff --git a/src/packlib/hepdb/cdxint/cdchti.F b/src/packlib/hepdb/cdxint/cdchti.F
deleted file mode 100644
index 2774a48..0000000
--- a/src/packlib/hepdb/cdxint/cdchti.F
+++ /dev/null
@@ -1,60 +0,0 @@
-*
-* $Id: cdchti.F,v 1.1.1.1 1996/02/28 16:24:53 mclareni Exp $
-*
-* $Log: cdchti.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:53 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDCHTI (CVAL, IVAL, IRC)
-* ===================================
-*
-************************************************************************
-* *
-* SUBR. CDCHTI (CVAL, IVAL*, IRC*) *
-* *
-* Converts character string into integer value *
-* *
-* This routine is taken from R.Brun *
-* *
-* Arguments : *
-* *
-* CVAL Character string (input) *
-* IVAL Integer value (output) *
-* IRC Return code (see below) *
-* *
-* Called by CDCTOR, CDDCKH, CDDCKV, CDRDDA *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* =100 : Error in decoding *
-* *
-************************************************************************
-*
- PARAMETER (MXD=15)
- CHARACTER CVAL*(*)
- CHARACTER*(MXD) CTEMP, BLANK
- INTEGER IVAL
-*
-* ------------------------------------------------------------------
-*
- IRC = 0
- L = LENOCC(CVAL)
- IF (L.EQ.0) GO TO 999
- IF (L.GT.MXD) THEN
- IRC = 100
- GO TO 999
- ENDIF
- BLANK = ' '
- IF (L.EQ.MXD) THEN
- CTEMP = CVAL
- ELSE
- CTEMP = BLANK(1:MXD-L)//CVAL
- ENDIF
- READ (CTEMP, '(I15)', ERR=100) IVAL
- GO TO 999
- 100 IRC = 100
-* END CDCHTI
- 999 END
diff --git a/src/packlib/hepdb/cdxint/cdclfl.F b/src/packlib/hepdb/cdxint/cdclfl.F
deleted file mode 100644
index b4822ac..0000000
--- a/src/packlib/hepdb/cdxint/cdclfl.F
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: cdclfl.F,v 1.1.1.1 1996/02/28 16:24:46 mclareni Exp $
-*
-* $Log: cdclfl.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:46 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDCLFL (LUN)
-* =======================
-*
-************************************************************************
-* *
-* SUBR. CDCLFL (LUN) *
-* *
-* Closes unit LUN *
-* *
-* Arguments : *
-* *
-* LUN Logical unit number *
-* *
-* Called by CDACPL, CDACTI, CDAIWR, CDAUXI, CDEDAS, CDEDKY, CDPEEK, *
-* CDPRES, CDRDDA, CDRDIO *
-* *
-************************************************************************
-*
-#if defined(CERNLIB_IBM)
- CHARACTER CTEMP*20, CHLUN*3
-*
-#endif
-* ------------------------------------------------------------------
-*
- CLOSE (LUN)
-#if defined(CERNLIB_IBM)
- WRITE (CHLUN, '(I3)') LUN
- CTEMP = 'FILEDEF '//CHLUN//' CLEAR'
- CALL VMCMS (CTEMP, ISTAT)
-#endif
-* END CDCLFL
- 999 END
diff --git a/src/packlib/hepdb/cdxint/cdconc.F b/src/packlib/hepdb/cdxint/cdconc.F
deleted file mode 100644
index a945375..0000000
--- a/src/packlib/hepdb/cdxint/cdconc.F
+++ /dev/null
@@ -1,66 +0,0 @@
-*
-* $Id: cdconc.F,v 1.1.1.1 1996/02/28 16:24:46 mclareni Exp $
-*
-* $Log: cdconc.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:46 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDCONC (IOT, N, ICON, NSK)
-* =====================================
-*
-************************************************************************
-* *
-* SUBR. CDCONC (IOT, N, ICON*, NSK*) *
-* *
-* Routine to calculate the number of concatenated keys *
-* *
-* Arguments : *
-* *
-* IOT I/O Type of the keys *
-* N Length of the key-vector *
-* ICON Number of concatenated keys to present key *
-* NSK Total number of concatenated keys *
-* *
-* Called by CDDISP, CDEDAS, CDJOIN, CDVWPR *
-* *
-************************************************************************
-*
-#include "hepdb/cbconc.inc"
- DIMENSION ICON(9), IOT(9)
-*
-* ------------------------------------------------------------------
-*
- CALL VZERO (ICON(1), N)
- NSK = 0
- I = 0
- ISYS = 0
- IUSE = 0
- 5 CONTINUE
- I = I + 1
- J = 0
- IF (I.GT.N) GO TO 999
- IF (IOT(I).EQ.5) THEN
- ISYS = ISYS + 1
- IUSE = IUSE + 1
- IUSECB(ISYS) = IUSE
- ISYSCB(IUSE) = ISYS
- 10 K = I + J + 1
- IF (K.LE.N.AND.IOT(K).EQ.6) THEN
- ISYS = ISYS + 1
- IUSECB(ISYS) = IUSE
- J = J + 1
- GO TO 10
- ENDIF
- ICON(I) = J
- NSK = NSK + J
- ELSE
- ISYS = ISYS + 1
- IUSE = IUSE + 1
- IUSECB(ISYS) = IUSE
- ISYSCB(IUSE) = ISYS
- ENDIF
- GO TO 5
-* END CDCONC
- 999 END
diff --git a/src/packlib/hepdb/cdxint/cdcrdr.F b/src/packlib/hepdb/cdxint/cdcrdr.F
deleted file mode 100644
index 7476a31..0000000
--- a/src/packlib/hepdb/cdxint/cdcrdr.F
+++ /dev/null
@@ -1,77 +0,0 @@
-*
-* $Id: cdcrdr.F,v 1.1.1.1 1996/02/28 16:24:47 mclareni Exp $
-*
-* $Log: cdcrdr.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:47 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDCRDR (PATHN, NKEX, CHOPT, IRC)
-* ===========================================
-*
-************************************************************************
-* *
-* SUBR. CDCRDR (PATHN, NKEX, CHOPT, IRC*) *
-* *
-* Routine to create DB Directory interactively *
-* *
-* Arguments : *
-* *
-* PATHN Character string describing the pathname *
-* IRC Return code (see below) *
-* *
-* Called by CDACTI, CDAUXI *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* =161 : Illegal path name *
-* *
-************************************************************************
-*
-#include "hepdb/ckkeys.inc"
- CHARACTER PATHN*(*), CHOPT*(*)
- CHARACTER CTAG(MXDMCK)*8, CHKTY*100, CHPRO*32, KEYTP*1
-*
-* ------------------------------------------------------------------
-*
-* *** Check if it is a partitioned directory
-*
- IOPTC = INDEX (CHOPT, 'C')
- IOPTP = INDEX (CHOPT, 'P')
- IF (IOPTP.NE.0) THEN
- CALL KUPROI ('Maximum number of objects in a partition ', MXKP)
- IF (MXKP.LT.1.OR.MXKP.GT.MXKYCK) MXKP = MXKPCK
- ELSE
- MXKP = 0
- ENDIF
-*
-* *** Precisions for packing
-*
- IPREC = 0
- DELTA = 0.
- IF (IOPTC.NE.0) THEN
- CALL KUPROI ('IPREC : Precision for packing ', IPREC)
- CALL KUPROR ('DELTA : zero suppression limit ', DELTA)
- ENDIF
-*
-* ** Get the Users Keys (Name and Type)
-*
- CHKTY = ' '
- DO 20 I = 1, NKEX
- WRITE (CHPRO, 1001) I
- CALL KUPROC (CHPRO, CTAG(I), NCT)
- 10 CALL KUPROC ('Key-Type ? (I,H,B or A)', KEYTP, LKTP)
- IF (KEYTP.NE.'I'.AND.KEYTP.NE.'H'.AND.KEYTP.NE.'B'.AND.
- + KEYTP.NE.'A') GO TO 10
- CHKTY(I:I) = KEYTP
- 20 CONTINUE
-*
-* ** Create the Directory
-*
- CALL CDMDIR (PATHN, NKEX,CHKTY,CTAG, MXKP, IPREC,DELTA, CHOPT,IRC)
-*
- 1001 FORMAT ('Key Name for user key ',I2,' : ')
-* END CDCRDR
- 999 END
diff --git a/src/packlib/hepdb/cdxint/cdctob.F b/src/packlib/hepdb/cdxint/cdctob.F
deleted file mode 100644
index 917672a..0000000
--- a/src/packlib/hepdb/cdxint/cdctob.F
+++ /dev/null
@@ -1,60 +0,0 @@
-*
-* $Id: cdctob.F,v 1.1.1.1 1996/02/28 16:24:47 mclareni Exp $
-*
-* $Log: cdctob.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:47 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDCTOB (CVAL, ZVAL, IRC)
-* ===================================
-*
-************************************************************************
-* *
-* SUBR. CDCTOB (CVAL, ZVAL*, IRC*) *
-* *
-* Converts character string into hexadecimal bit string *
-* *
-* This routine is taken from R.Brun *
-* *
-* Arguments : *
-* *
-* CVAL Character string (input) *
-* ZVAL Hexadecimal bit string (output) *
-* IRC Return code (see below) *
-* *
-* Called by CDDCKH, CDDCKV, CDRDDA *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* =100 : Error in decoding *
-* *
-************************************************************************
-*
- PARAMETER (MXD=15)
- CHARACTER CVAL*(*)
- CHARACTER*(MXD) CTEMP, BLANK
- REAL*4 ZVAL
-*
-* ------------------------------------------------------------------
-*
- IRC = 0
- L = LENOCC(CVAL)
- IF (L.EQ.0) GO TO 999
- IF (L.GT.MXD) THEN
- IRC = 100
- GO TO 999
- ENDIF
- BLANK = ' '
- IF (L.EQ.MXD) THEN
- CTEMP = CVAL
- ELSE
- CTEMP = BLANK(1:MXD-L)//CVAL
- ENDIF
- READ (CTEMP, '(Z15)', ERR=100) ZVAL
- GO TO 999
- 100 IRC = 100
-* END CDCTOB
- 999 END
diff --git a/src/packlib/hepdb/cdxint/cdctor.F b/src/packlib/hepdb/cdxint/cdctor.F
deleted file mode 100644
index 1dd9524..0000000
--- a/src/packlib/hepdb/cdxint/cdctor.F
+++ /dev/null
@@ -1,78 +0,0 @@
-*
-* $Id: cdctor.F,v 1.1.1.1 1996/02/28 16:24:47 mclareni Exp $
-*
-* $Log: cdctor.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:47 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDCTOR (CVAL, RVAL, IRC)
-* ===================================
-*
-************************************************************************
-* *
-* SUBR. CDCTOR (CVAL, RVAL*, IRC*) *
-* *
-* Converts character string into real value *
-* *
-* This routine is taken from R.Brun *
-* *
-* Arguments : *
-* *
-* CVAL Character string (input) *
-* RVAL Real value (output) *
-* IRC Return code (see below) *
-* *
-* Called by CDDCKV, CDRDDA *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* =100 : Error in decoding *
-* *
-************************************************************************
-*
- PARAMETER (MXD=15)
- CHARACTER CVAL*(*)
- CHARACTER*(MXD) CTEMP, BLANK
- REAL RVAL
-*
-* ------------------------------------------------------------------
-*
- IRC = 0
- L = LENOCC(CVAL)
- IF (L.EQ.0) GO TO 999
- IF (L.GT.MXD) GO TO 900
- BLANK = ' '
- IF (L.EQ.MXD) THEN
- CTEMP = CVAL
- ELSE
- CTEMP = BLANK(1:MXD-L)//CVAL
- ENDIF
-*
- CALL CLTOU (CTEMP)
-*
- I1 = INDEX (CTEMP, '.')
- II1 = 0
- IF (I1.LT.L) II1 = INDEX (CTEMP(I1+1:MXD), '.')
- I2 = INDEX (CTEMP, 'E')
- II2 = 0
- IF (I2.LT.L) II2 = INDEX (CTEMP(I2+1:MXD), 'E')
-*
- IF (II1+II2.NE.0) GO TO 900
-*
- IF (I1+I2.EQ.0) THEN
- CALL CDCHTI (CTEMP, IVAL, IRC)
- RVAL = IVAL
- ELSE IF (I1.EQ.L.AND.I2.EQ.0) THEN
- CALL CDCHTI (CTEMP(:I1-1), IVAL, IRC)
- RVAL = IVAL
- ELSE
- READ (CTEMP, '(G15.9)', END=999, ERR=900) RVAL
- ENDIF
- GO TO 999
-*
- 900 IRC = 100
-* END CDCTOR
- 999 END
diff --git a/src/packlib/hepdb/cdxint/cddckh.F b/src/packlib/hepdb/cdxint/cddckh.F
deleted file mode 100644
index 59e4dd5..0000000
--- a/src/packlib/hepdb/cdxint/cddckh.F
+++ /dev/null
@@ -1,141 +0,0 @@
-*
-* $Id: cddckh.F,v 1.1.1.1 1996/02/28 16:24:47 mclareni Exp $
-*
-* $Log: cddckh.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:47 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDDCKH (CHPRT, KY, IKEY, IRC)
-* ========================================
-*
-************************************************************************
-* *
-* SUBR. CDDCKH (CHPRT, KY*, IKEY*, IRC*) *
-* *
-* Fills a vector KY of elements NWKYCK according to its type IOTYCC *
-* from the character string CHPRT in Horizontal Mode *
-* *
-* Arguments : *
-* *
-* CHPRT Character string containing the keys to be decoded *
-* KY Vector to be filled with the decoded elements *
-* IKEY Serial number of the key to be filled *
-* IRC Return code (see below) *
-* *
-* Other variables : *
-* *
-* IOTYCC Type of the vector elements *
-* 1 - Binary *
-* 2 Integer *
-* 3 Floating *
-* 4 Double Precision (not yet implemented) *
-* 5 Hollerith *
-* 6 Hollerith concatenetad to previous hollerith *
-* 7 Packed integer - time packed upto seconds *
-* 8 Packed integer - time packed upto minutes *
-* 9 Data which should not be displayed *
-* ICONCK Number of keys concatenated to the present one *
-* NWKYCK Number of elements in the array KY (and IOTYCC) *
-* *
-* Called by CDEDAS, CDEDKY *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
-#include "hepdb/ccdisp.inc"
-#include "hepdb/ckkeys.inc"
- CHARACTER CHPRT*(*)
- DIMENSION KY(9)
-*
-* ------------------------------------------------------------------
-*
- READ (CHPRT(2:9), '(I8)') IKEY
- CALL VZERO (KY(1), NWKYCK)
- ISTR = 12
- IRC = 0
- DO 10 I = 1, NWKYCK
- KK = IOTYCC(I)
- GO TO (1,2,10,10,5,10,7,8,10), KK
- 1 CONTINUE
-*
-* ** Binary
-*
- IEND = ISTR + NUMCCC(I) - 3
- CALL CDCTOB (CHPRT(ISTR:IEND), KY(I), IRC0)
- IF (IRC0.NE.0) IRC = IRC0
- ISTR = IEND + 3
- GO TO 10
- 2 CONTINUE
-*
-* ** Integer
-*
- IEND = ISTR + NUMCCC(I) - 3
- CALL CDCHTI (CHPRT(ISTR:IEND), KY(I), IRC0)
- IF (IRC0.NE.0) IRC = IRC0
- ISTR = IEND + 3
- GO TO 10
- 5 CONTINUE
-*
-* ** Hollerith
-*
- IEND = ISTR + NUMCCC(I) - 3
- IREP = ICONCK(I) + 1
- IF (IREP.EQ.1) THEN
- DO 51 J = ISTR, IEND
- IF (CHPRT(J:J).EQ.' ') THEN
- GO TO 51
- ELSE IF (CHPRT(J:J).EQ.'''') THEN
- IST = J + 1
- GO TO 52
- ELSE
- IST = J
- GO TO 52
- ENDIF
- 51 CONTINUE
- IST = IEND
- 52 ISTR = IST
- ENDIF
- CALL UCTOH (CHPRT(ISTR:IEND), KY(I), 4, 4*IREP)
- ISTR = IEND + 3
- GO TO 10
- 7 CONTINUE
-*
-* ** Packed Integer (upto seconds)
-*
- IEND = ISTR + NUMCCC(I) - 3
- I1 = ISTR
- I2 = I1 + 5
- READ (CHPRT(I1:I2), '(I6)') IDATE
- I1 = I2 + 2
- I2 = I1 + 5
- READ (CHPRT(I1:I2), '(I6)') ITIME
- ISTR = IEND + 3
- CALL CDPKTS (IDATE, ITIME, KY(I), IRC0)
- IF (IRC0.NE.0) IRC = IRC0
- GO TO 10
- 8 CONTINUE
-*
-* ** Packed Integer (upto minutes)
-*
- IEND = ISTR + NUMCCC(I) - 3
- I1 = ISTR
- I2 = I1 + 5
- READ (CHPRT(I1:I2), '(I6)') IDATE
- I1 = I2 + 2
- I2 = I1 + 5
- READ (CHPRT(I1:I2), '(I6)') ITIME
- ISTR = IEND + 3
- CALL CDPKTM (IDATE, ITIME, KY(I), IRC0)
- IF (IRC0.NE.0) IRC = IRC0
- GO TO 10
-*
- 10 CONTINUE
- GO TO 999
-* END CDDCKH
- 999 END
diff --git a/src/packlib/hepdb/cdxint/cddckv.F b/src/packlib/hepdb/cdxint/cddckv.F
deleted file mode 100644
index dc371ac..0000000
--- a/src/packlib/hepdb/cdxint/cddckv.F
+++ /dev/null
@@ -1,110 +0,0 @@
-*
-* $Id: cddckv.F,v 1.1.1.1 1996/02/28 16:24:47 mclareni Exp $
-*
-* $Log: cddckv.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:47 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDDCKV (LUN, IC, KY, IRC)
-* ====================================
-*
-************************************************************************
-* *
-* SUBR. CDDCKV (LUN, IC, KY*, IRC*) *
-* *
-* Decodes values of a key vector (KY) stored in Vertical mode *
-* (in NL lines on a file on unit LUN) *
-* *
-* Arguments : *
-* *
-* LUN Logical Unit number containing the file to be decoded *
-* IC Number of keys concatenated to the present one *
-* KY Vector containing the decoded elements *
-* IRC Return code (see below) *
-* *
-* Called by CDEDAS, CDEDKY *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* *
-************************************************************************
-*
-#include "hepdb/ckkeys.inc"
- CHARACTER LINE*80, CHFOR*1, CHVAL*80
- DIMENSION KY(9), IC(9)
-*
-* ------------------------------------------------------------------
-*
- IRC = 0
- J = 0
- 5 READ (LUN, '(A80)', END=999) LINE
-*
- NCH = LENOCC (LINE)
- IF (NCH.LE.0) GO TO 30
- CHVAL = ' '
- I = 13
- CHFOR = LINE(I:I)
- DO 6 K = I+1, NCH
- IF (LINE(K:K).NE.' ') THEN
- CHVAL = LINE(K:NCH)
- GO TO 20
- ENDIF
- 6 CONTINUE
-*
- 20 J = J + 1
- IF (CHFOR.EQ.'I') THEN
- CALL CDCHTI (CHVAL, KY(J), IRC0)
- IF (IRC0.NE.0) IRC = IRC0
- ELSE IF (CHFOR.EQ.'F') THEN
- CALL CDCTOR (CHVAL, KY(J), IRC0)
- IF (IRC0.NE.0) IRC = IRC0
- ELSE IF (CHFOR.EQ.'B') THEN
- CALL CDCTOB (CHVAL, KY(J), IRC0)
- IF (IRC0.NE.0) IRC = IRC0
- ELSE IF (CHFOR.EQ.'H') THEN
- NREP = IC(J)
- LCDAT = 4*(NREP+1)
- CALL UCTOH (CHVAL, KY(J), 4, LCDAT)
- J = J + NREP
- ELSE IF (CHFOR.EQ.'S') THEN
- NC = LENOCC (CHVAL)
- DO 21 K = 1, NC
- IF (CHVAL(K:K).EQ.' ') THEN
- KK = K
- GO TO 22
- ENDIF
- 21 CONTINUE
- KY(J) = 0
- GO TO 25
- 22 CONTINUE
- CALL CDCHTI (CHVAL(1:KK-1), IDATE, IRC0)
- IF (IRC0.NE.0) IRC = IRC0
- CALL CDCHTI (CHVAL(KK:NC), ITIME, IRC0)
- IF (IRC0.NE.0) IRC = IRC0
- CALL CDPKTS (IDATE, ITIME, KY(J), IRC0)
- IF (IRC0.NE.0) IRC = IRC0
- ELSE IF (CHFOR.EQ.'M') THEN
- NC = LENOCC (CHVAL)
- DO 23 K = 1, NC
- IF (CHVAL(K:K).EQ.' ') THEN
- KK = K
- GO TO 24
- ENDIF
- 23 CONTINUE
- KY(J) = 0
- GO TO 25
- 24 CONTINUE
- CALL CDCHTI (CHVAL(1:KK-1), IDATE, IRC0)
- IF (IRC0.NE.0) IRC = IRC0
- CALL CDCHTI (CHVAL(KK:NC), ITIME, IRC0)
- IF (IRC0.NE.0) IRC = IRC0
- CALL CDPKTM (IDATE, ITIME, KY(J), IRC0)
- IF (IRC0.NE.0) IRC = IRC0
- ENDIF
- 25 IF (J.LT.NWKYCK) GO TO 5
- 30 CONTINUE
-* END CDDCKV
- 999 END
diff --git a/src/packlib/hepdb/cdxint/cddisd.F b/src/packlib/hepdb/cdxint/cddisd.F
deleted file mode 100644
index 59c216e..0000000
--- a/src/packlib/hepdb/cdxint/cddisd.F
+++ /dev/null
@@ -1,129 +0,0 @@
-*
-* $Id: cddisd.F,v 1.1.1.1 1996/02/28 16:24:47 mclareni Exp $
-*
-* $Log: cddisd.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:47 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDDISD (LUN, PATHN, KEYX, CHOPT, IRC)
-* ================================================
-*
-************************************************************************
-* *
-* SUBR. CDDISD (LUN, PATHN, KEYX, CHOPT, IRC*) *
-* *
-* Display the data attached to the directory PATHN and KEY *
-* *
-* Arguments : *
-* *
-* LUN Unit number of file for display *
-* PATHN Character string describing the pathname *
-* KEYX Key-vector *
-* CHOPT Character option *
-* E Only example for display to be shown *
-* IRC Return code (see below) *
-* *
-* Called by CDRDIO *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* *
-************************************************************************
-*
-#include "hepdb/caopts.inc"
-#include "hepdb/cdcblk.inc"
-#include "hepdb/ccdisp.inc"
-#include "hepdb/ckkeys.inc"
-#include "hepdb/ctpath.inc"
-#include "hepdb/cxlink.inc"
- DIMENSION KEYX(29)
- CHARACTER PATHN*(*), CHOPT*(*), CHEAD*300, PATHY*80
- CHARACTER CB*1, CC*1, CI*1, CF*1, DC*4, BLANK*10
- INTEGER DB, DI
- DATA CB /'B'/, CC /'H'/, CI /'I'/, CF /'F'/
- DATA BLANK /' '/
- DATA DB /101/, DC /'DATA'/, DI /77/, DF /777.777/
-*
-* ------------------------------------------------------------------
-*
-* *** Set the current directory
-*
- CALL UOPTC (CHOPT, 'E', IOPTE)
- CALL CDLDUP (PATHN, 0, IRC)
- IF (IRC.NE.0) GO TO 999
- PATHY = PAT1CT
- CALL CDKYTG
-*
-* ** Display keys
-*
- NCHR = LENOCC (PATHY)
- WRITE (LUN, 1001) PATHY(1:NCHR)
- IF ((IOPTE.NE.0) .OR. (IOPHCC.EQ.0)) THEN
- WRITE (LUN, 1002) CTAGCK(1)
- ELSE
- CHEAD = ' '
- CALL CDHEAD (IOTYCC(1), NWKYCK, CHEAD)
- WRITE (LUN, 1003) CHEAD(1:MXDPCC)
- ENDIF
-*
- IF (IOPTE.NE.0) THEN
- IF (IOPXCA.NE.0) THEN
- CALL CDUPTS (IDV1, ITV1, KEYX(NOF1CK+1), IRC)
- CALL CDUPTS (IDV2, ITV2, KEYX(NOF1CK+NPARCD+1), IRC)
- WRITE (LUN, 1004) IDV1, ITV1, IDV2, ITV2
- ELSE
- WRITE (LUN, 1004) (KEYX(NOF1CK+I), I = 1, 2*NPARCD)
- ENDIF
-*
-* ** Write steering lines as format indication
-*
- WRITE (LUN, 1005) CB, DB, CC, DC, CI, DI, CF, DF
- ELSE
-*
-* ** Read in the data
-*
- IF (LFRSCX.NE.0) THEN
- CALL MZDROP (IDIVCD, LFRSCX, 'L')
- LFRSCX = 0
- ENDIF
- IF (NKEYCK.EQ.0) THEN
- CALL UCOPY (KEYX, KEYVCK, NWKYCK)
- GO TO 20
- ENDIF
- CALL CDSGET (KEYX(IDHKSN), IDIVCD, LFRSCX, IRC)
-*
- 20 IF (IOPHCC.EQ.0) THEN
- WRITE (LUN, 1006) KEYX(IDHKSN)
- ELSE
- CALL CDDKYH (LUN, NWKYCK, KEYVCK, IOTYCC, ICONCK, IKEY, IRC)
- ENDIF
-*
-* ** Display data if exists, if it does not, display dummy data
-*
- IF (IRC.EQ.0.AND.LFRSCX.GT.0.AND.IQ(KOFUCD+LFRSCX-1).GT.0) THEN
- CALL CDWRDP (LUN, LFRSCX)
- ELSE
- WRITE (LUN, 1005) CB, DB, CC, DC, CI, DI, CF, DF
- ENDIF
- IF (LFRSCX.NE.0) CALL MZDROP (IDIVCD, LFRSCX, ' ')
- IF (IRC.NE.0) GO TO 999
- ENDIF
-*
- WRITE (LUN, 1007)
-*
- 1001 FORMAT (' Data in Directory and Key-Vector'/A)
- 1002 FORMAT (/3X,A8,3X)
- 1003 FORMAT (/A)
- 1004 FORMAT ('Object inserted with validity range ',6I9)
- 1005 FORMAT (1X,A,4X,'1',4X,Z10,10X, 'This line is only an example !'
- + /,1X,A,4X,'2',4X,A4 ,16X, 'This line is only an example !'
- + /,1X,A,4X,'3',4X,I10,10X, 'This line is only an example !'
- + /,1X,A,4X,'4',4X,E12.4,8X,'This line is only an example !')
- 1006 FORMAT (I10)
- 1007 FORMAT (4X,'We have reached the End of File Position - ',
- + 'do not delete this line !!')
-* END CDDISD
- 999 END
diff --git a/src/packlib/hepdb/cdxint/cddish.F b/src/packlib/hepdb/cdxint/cddish.F
deleted file mode 100644
index c50d8ad..0000000
--- a/src/packlib/hepdb/cdxint/cddish.F
+++ /dev/null
@@ -1,145 +0,0 @@
-*
-* $Id: cddish.F,v 1.1.1.1 1996/02/28 16:24:47 mclareni Exp $
-*
-* $Log: cddish.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:47 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDDISH (LUN, PATHN, MINKY, MAXKY, IFLG, CHOPT, IRC)
-* ==============================================================
-*
-************************************************************************
-* *
-* SUBR. CDDISH (LUN, PATHN, MINKY, MAXKY, IFLG, CHOPT, IRC*) *
-* *
-* Displays the keys in horizontal mode *
-* *
-* Arguments : *
-* *
-* LUN Unit number of file for display *
-* PATHN Character string describing the pathname *
-* MINKY Minimum object number to be displayed (for IFLG=0) *
-* MAXKY Maximum object number to be displayed (for IFLG=0) *
-* IFLG Flag to decide if objects (=0) or only template (=1) *
-* to be shown *
-* CHOPT Character with any of the follwing characters *
-* K Display all the keys (Default) *
-* U Display only user keys and validities *
-* IRC Return code (see below) *
-* *
-* Called by CDDISP *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* *
-************************************************************************
-*
-#include "hepdb/caopts.inc"
-#include "hepdb/cdcblk.inc"
-#include "hepdb/ccdisp.inc"
-#include "hepdb/clinks.inc"
-#include "hepdb/ckkeys.inc"
- PARAMETER (JBIAS=2)
- CHARACTER PATHN*(*), CHOPT*(*), CHEAD*300
- DIMENSION IDPFL(100), ITIME(MXPACD)
-*
-* ------------------------------------------------------------------
-*
- NCHR = LENOCC (PATHN)
- IRC = 0
- WRITE (LUN, 1001) PATHN(1:NCHR)
- IF (IFLG.NE.0) GO TO 20
-*
-* *** Range of the keys to be displayed
-*
- 5 CONTINUE
- IF (CHOPT.EQ.'U') THEN
- CALL CDDPRG (IDPFL, NWKYCK, 'EDIT')
- ELSE
- CALL CDDPRG (IDPFL, NWKYCK, 'TERM')
- ENDIF
- CALL CDRGCK (IDPFL, NWKYCK, NDISP, IOTYCC)
- IF (NDISP.GT.MXDPCC) THEN
- CALL CDPRNT (LPRTCD, '('' CDDISH : Not enough space to disp'//
- + 'lay.'',/,'' Enlarge display range by CDSETD or use V-'//
- + 'mode.'')', IARGCD, 0)
- IF (CHOPT.EQ.'U') THEN
- WRITE (LUN, 1002)
- GO TO 999
- ENDIF
- GO TO 5
- ENDIF
-*
-* ** Display header with a template
-*
- CHEAD = ' '
- CALL CDHEAD (IOTYCC(1), NWKYCK, CHEAD)
- CALL CDTEMP (IOTYCC(1), NWKYCK, CHEAD)
- WRITE (LUN, 1003) CHEAD(1:MXDPCC)
-*
-* ** Display keys
-*
- IOLD1 = IOKYCA(IDHKSN)
- IOLDK = IOPKCA
- IOPKCA = 1
- IOKYCA(IDHKSN) = 1
- DO 10 I = 1, NPARCD
- ITIME(I) = 1
- 10 CONTINUE
- DO 15 IKEY = MINKY, MAXKY
- KEYVCK(IDHKSN) = IKEY
- CALL CDKXIN (ITIME, IDISCD, LAUXCL(7), LAUXCL(7), JBIAS, NWKEY,
- + KEYVCK, IPREC, IRC)
- IF (IRC.EQ.0) THEN
- CALL CDDKYH (LUN, NWKYCK, KEYVCK, IOTYCC, ICONCK, IKEY, IRC)
- ENDIF
- 15 CONTINUE
-*
- IRC = 0
- IOKYCA(IDHKSN) = IOLD1
- IOPKCA = IOLDK
- WRITE (LUN, 1004)
- GO TO 999
-*
-* *** Display the template
-*
- 20 CONTINUE
- CALL CDDPRG (IDPFL, NWKYCK, ' ')
- CALL CDRGCK (IDPFL, NWKYCK, NDISP, IOTYCC)
- IF (NDISP.GT.MXDPCC) THEN
- CALL CDPRNT (LPRTCD, '('' CDDISH : Not enough space to disp'//
- + 'lay.'',/,'' Enlarge display range by CDSETD or use V-'//
- + 'mode.'')', IARGCD, 0)
- WRITE (LUN, 1002)
- GO TO 999
- ENDIF
-*
-* ** Display header
-*
- CHEAD = ' '
- CALL CDHEAD (IOTYCC(1), NWKYCK, CHEAD)
- WRITE (LUN, 1003) CHEAD(1:MXDPCC)
-*
-* ** Display template
-*
- CHEAD = 'N'
- CHEAD(9:9) = '1'
- CALL CDTEMP (IOTYCC(1), NWKYCK, CHEAD)
- WRITE (LUN, 1003) CHEAD(1:MXDPCC)
- WRITE (LUN, 1005)
- IRC = 0
- WRITE (LUN, 1004)
-*
- 1001 FORMAT (' Keys in Directory to be displayed/updated: '/A)
- 1002 FORMAT (' CDDISH : Not enough space to display.'
- + /' Enlarge display range by CDSETD or use V-mode.')
- 1003 FORMAT (/A)
- 1004 FORMAT (' We have reached the End of File Position')
- 1005 FORMAT (' The Directory does not contain any object '
- + /' Insert the value of the keys for the first object'
- + /' between the vertical bars on the template')
-* END CDDISH
- 999 END
diff --git a/src/packlib/hepdb/cdxint/cddisp.F b/src/packlib/hepdb/cdxint/cddisp.F
deleted file mode 100644
index d7560c1..0000000
--- a/src/packlib/hepdb/cdxint/cddisp.F
+++ /dev/null
@@ -1,131 +0,0 @@
-*
-* $Id: cddisp.F,v 1.1.1.1 1996/02/28 16:24:48 mclareni Exp $
-*
-* $Log: cddisp.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:48 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDDISP (LUN, PATHN, CHOPT, IRC)
-* ==========================================
-*
-************************************************************************
-* *
-* SUBR. CDDISP (LUN, PATHN, *CHOPT*, IRC*) *
-* *
-* Displays objects attached to the directory PATHN *
-* *
-* Arguments : *
-* *
-* LUN Unit number of file for display *
-* PATHN Character string describing the pathname *
-* CHOPT Character with any of the follwing characters *
-* K Display all the keys (Default) *
-* U Display only user keys and validities *
-* I Display template to type in new keys (Return value) *
-* IRC Return code (see below) *
-* *
-* Called by CDAUXI, CDEDKY, CDPEEK *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* =101 : Illegal path name *
-* *
-************************************************************************
-*
-#include "hepdb/caopts.inc"
-#include "hepdb/cdcblk.inc"
-#include "hepdb/ccdisp.inc"
-#include "hepdb/ckkeys.inc"
-#include "hepdb/ctpath.inc"
- CHARACTER PATHN*(*), CHOPT*(*), PATHY*80, CFORM*67
- DATA MAXLN /1000/
-#include "zebra/q_jbit.inc"
-* Ignoring t=pass
-*
-* ------------------------------------------------------------------
-*
-* *** Set the current directory
-*
- CALL CDLDUP (PATHN, 0, IRC)
- IF (IRC.NE.0) GO TO 999
- PATHY = PAT1CT
- CALL CDKYTG
- CALL CDCONC (IOTYCK(1), NWKYCK, ICONCK(1), NSKPCK)
- CALL UCOPY (IOTYCK(1), IOTYCC(1), NWKYCK)
-*
-* *** Check the number of keys
-*
- IF (NKEYCK.EQ.0) THEN
- IFLG = 1
- ELSE
- IFLG = 0
- MINKY = 1
- IOPTP = JBIT (IQ(KOFSCD+LCDRCD+IKDRCD+IDHFLG), JPRTCD)
- IF (IOPTP.EQ.0) THEN
- MAXKY = NKEYCK
- ELSE
- KST = NWKYCK + 1
- KPNT = IUHUNT (NKEYCK, IQ(KOFSCD+LCDRCD+IKDRCD+MPSRCD),
- + NKEYCK*KST, KST)
- IF (KPNT.GT.0) THEN
- IPNT = KOFSCD + LCDRCD + IKDRCD + KPNT - MPSRCD
- ELSE
- IPNT = KOFSCD + LCDRCD + IKDRCD + (NKEYCK - 1) * KST
- ENDIF
- KOBJ = IQ(IPNT+MOBJCD)
- CALL CDPATH (TOP2CT, NKEYCK)
- CALL RZCDIR (TOP2CT, ' ')
- IF (IQUEST(1).NE.0) GO TO 991
- NKEYS = IQUEST(7)
- MAXKY = KOBJ + NKEYS
- IF (MAXKY.LE.0) IFLG = 1
- CALL RZCDIR (PATHY, ' ')
- IF (IQUEST(1).NE.0) GO TO 991
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- ENDIF
- IF (IOPHCC.NE.0) THEN
- LENOB = MAXKY
- ELSE
- LENOB = MAXKY * NWKYCK
- ENDIF
- IF (LENOB.GT.MAXLN) THEN
- WRITE (CFORM, 1000) MAXKY
- CALL KUPROI (CFORM, MINKY)
- IF (IOPHCC.NE.0) THEN
- MAXK = MINKY + MAXLN
- ELSE
- MAXK = MINKY + MAXLN/NWKYCK
- ENDIF
- MAXKY = MIN0 (MAXKY, MAXK)
- ENDIF
- ENDIF
-*
-* *** Now display the keys
-*
- IF (IOPHCC.NE.0) THEN
- CALL CDDISH (LUN, PATHN, MINKY, MAXKY, IFLG, CHOPT, IRC)
- ELSE
- CALL CDDISV (LUN, PATHN, MINKY, MAXKY, IFLG, CHOPT, IRC)
- ENDIF
- IRC = 0
- IF (IFLG.EQ.1) CHOPT = 'I'
- GO TO 999
-*
-* *** Error messages
-*
- 991 IRC = 101
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) THEN
- CALL CDPRNT (LPRTCD, '(/,'' CDDISP : Illegal Path Name '//PATHY
- + //''')', IARGCD, 0)
- ENDIF
-#endif
-*
- 1000 FORMAT ('Directory too Long --',I10,' Objects - First Object to'
- +,' Display ?')
-* END CDDISP
- 999 END
diff --git a/src/packlib/hepdb/cdxint/cddisv.F b/src/packlib/hepdb/cdxint/cddisv.F
deleted file mode 100644
index 851ba68..0000000
--- a/src/packlib/hepdb/cdxint/cddisv.F
+++ /dev/null
@@ -1,139 +0,0 @@
-*
-* $Id: cddisv.F,v 1.1.1.1 1996/02/28 16:24:48 mclareni Exp $
-*
-* $Log: cddisv.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:48 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDDISV (LUN, PATHN, MINKY, MAXKY, IFLG, CHOPT, IRC)
-* ==============================================================
-*
-************************************************************************
-* *
-* SUBR. CDDISV (LUN, PATHN, MINKY, MAXKY, IFLG, CHOPT, IRC*) *
-* *
-* Displays the keys in vertical mode *
-* *
-* Arguments : *
-* *
-* LUN Unit number of file for display *
-* PATHN Character string describing the pathname *
-* MINKY Minimum object number to be displayed (for IFLG=0) *
-* MAXKY Maximum object number to be displayed (for IFLG=0) *
-* IFLG Flag to decide if objects (=0) or only template (=1) *
-* to be shown *
-* CHOPT Character with any of the follwing characters *
-* K Display all the keys (Default) *
-* U Display only user keys and validities *
-* IRC Return code (see below) *
-* *
-* Called by CDDISP *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* *
-************************************************************************
-*
-#include "hepdb/caopts.inc"
-#include "hepdb/cdcblk.inc"
-#include "hepdb/ccdisp.inc"
-#include "hepdb/ckkeys.inc"
-#include "hepdb/clinks.inc"
- PARAMETER (JBIAS=2)
- CHARACTER DEFST(6)*20, CHPRT*40, CFORS(6)*1
- CHARACTER PATHN*(*), CHOPT*(*)
- DIMENSION ITIME(MXPACD)
-*
- DATA DEFST /' ',' 1 ',
- + ' ','810101 0 ',
- + '921231 235959 ',' '/
- DATA CHPRT /' Object Number : ==> D'/
- DATA CFORS /'B', 'I', 'H', 'S', 'M', 'U'/
-*
-* ------------------------------------------------------------------
-*
- NCHR = LEN (PATHN)
- WRITE (LUN, 1001) PATHN(1:NCHR)
-*
- IF (IOPXCA.NE.0) THEN
- INDXT = 7
- ELSE
- INDXT = 2
- ENDIF
- DO 5 I = 1, 2*NPARCD
- IOTYCC(NOF1CK+I) = INDXT
- 5 CONTINUE
- IOTYCC(IDHINS) = 8
- IF (CHOPT.EQ.'U'.OR.IFLG.NE.0) THEN
- IOTYCC(IDHKSN) = 9
- IOTYCC(IDHPTR) = 9
- IOTYCC(IDHFLG) = 9
- ENDIF
- IF (IFLG.NE.0) GO TO 20
-*
-* ** Display keys
-*
- CHPRT(40:40) = 'D'
- IOLD1 = IOKYCA(IDHKSN)
- IOLDK = IOPKCA
- IOPKCA = 1
- IOKYCA(IDHKSN) = 1
- DO 10 I = 1, NPARCD
- ITIME(I) = 1
- 10 CONTINUE
- DO 15 IKEY = MINKY, MAXKY
- KEYVCK(IDHKSN) = IKEY
- CALL CDKXIN (ITIME, IDISCD, LAUXCL(7), LAUXCL(7), JBIAS, NWKEY,
- + KEYVCK, IPREC, IRC)
- IF (IRC.EQ.0) THEN
- WRITE (CHPRT(21:30), 1002) IKEY
- WRITE (LUN, 1003) CHPRT
- CALL CDDKYV (LUN, NWKYCK, CTAGCK, KEYVCK, IOTYCC, ICONCK, IRC)
- ENDIF
- 15 CONTINUE
-*
- IRC = 0
- IOKYCA(IDHKSN) = IOLD1
- IOPKCA = IOLDK
- WRITE (LUN, 1004)
- GO TO 999
-*
-* *** No keys prepare the template
-*
- 20 IKEY = 1
- CHPRT(40:40) = 'N'
- WRITE (CHPRT(21:30), 1002) IKEY
- WRITE (LUN, 1003) CHPRT
- IPR = 1
- 25 IF (IPR.LE.NWKYCK) THEN
- NREP = 0
- IF (IOTYCC(IPR).EQ.1) THEN
- ITYP = 1
- ELSE IF (IOTYCC(IPR).EQ.5.OR.IOTYCC(IPR).EQ.6) THEN
- ITYP = 3
- NREP = ICONCK(IPR)
- ELSE IF (IOTYCC(IPR).GE.7.AND.IOTYCC(IPR).LE.9) THEN
- ITYP = IOTYCC(IPR) - 3
- ELSE
- ITYP = 2
- ENDIF
- WRITE (LUN, 1005) CTAGCK(IPR), CFORS(ITYP), DEFST(ITYP)
- IPR = IPR + NREP + 1
- GO TO 25
- ENDIF
- WRITE (LUN, 1006)
- IRC = 0
-*
- 1001 FORMAT (' Keys in Directory to be displayed/updated: '/A)
- 1002 FORMAT (I10)
- 1003 FORMAT (A)
- 1004 FORMAT (' We have reached the End of File Position')
- 1005 FORMAT (' ',A8,' ',A1,' ',A)
- 1006 FORMAT (' The Directory does not contain any object - '
- + /' The above line contains the default values for the'
- + /' system keys and a format specification for the others')
-* END CDDISV
- 999 END
diff --git a/src/packlib/hepdb/cdxint/cddkyh.F b/src/packlib/hepdb/cdxint/cddkyh.F
deleted file mode 100644
index b9baf6a..0000000
--- a/src/packlib/hepdb/cdxint/cddkyh.F
+++ /dev/null
@@ -1,151 +0,0 @@
-*
-* $Id: cddkyh.F,v 1.1.1.1 1996/02/28 16:24:48 mclareni Exp $
-*
-* $Log: cddkyh.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:48 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDDKYH (LUN, NW, KY, KT, ICON, IKEY, IRC)
-* ====================================================
-*
-************************************************************************
-* *
-* SUBR. CDDKYH (LUN, NW, KY, KT, ICON, IKEY, IRC*) *
-* *
-* Displays a vector KY of elements NW according to its type KT *
-* in Horizontal Mode *
-* *
-* Arguments : *
-* *
-* LUN Unit number of the file on which to display *
-* NW Number of elements in the array KY (and KT) *
-* KY Vector to be printed *
-* KT Type of the vector elements *
-* 1 - Binary *
-* 2 Integer *
-* 3 Floating *
-* 4 Double Precision (not yet implemented) *
-* 5 Hollerith *
-* 6 Hollerith concatenetad to previous hollerith *
-* 7 Packed integer - time packed upto seconds *
-* 8 Packed integer - time packed upto minutes *
-* 9 Data which should not be displayed *
-* ICON Number of keys concatenated to the present one *
-* IKEY Serial number of the key to be displayed *
-* IRC Return code (see below) *
-* *
-* Called by CDDISD, CDDISH, CDPRES *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* =103 : Illegal data type *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
-#include "hepdb/ccdisp.inc"
-#include "hepdb/ckkeys.inc"
- CHARACTER CHPRT*300, CFORM*5
- DIMENSION KY(9), KT(9), ICON(9)
-*
-* ------------------------------------------------------------------
-*
- CHPRT = ' '
- IF (IKEY.GT.0) THEN
- WRITE (CHPRT(2:9), 1001) IKEY
- ENDIF
- I1 = 11
- DO 10 I = 1, NW
- IF (KT(I).EQ.1) THEN
-*
-* ** Binary
-*
- I1 = I1 + 1
- I2 = I1 + NUMCCC(I) - 3
- CFORM(1:2) = '(Z'
- CFORM(5:5) = ')'
- WRITE (CFORM(3:4), 1002) NUMCCC(I)-2
- WRITE (CHPRT(I1:I2), CFORM) KY(I)
- I1 = I2 + 2
-*
- ELSE IF (KT(I).EQ.2) THEN
-*
-* ** Integer
-*
- I1 = I1 + 1
- I2 = I1 + NUMCCC(I) - 3
- CFORM(1:2) = '(I'
- CFORM(5:5) = ')'
- WRITE (CFORM(3:4), 1002) NUMCCC(I)-2
- WRITE (CHPRT(I1:I2), CFORM) KY(I)
- I1 = I2 + 2
-*
- ELSE IF (KT(I).EQ.5) THEN
-*
-* ** Hollerith
-*
- IREP = ICON(I) + 1
- I1 = I1 + 1
- DO 6 J = 1, IREP
- I2 = I1 + 3
- IF (IREP.EQ.1) THEN
- I1 = I1 + 2
- I2 = I2 + 2
- ENDIF
- WRITE (CHPRT(I1:I2), 1003) KY(I+J-1)
- I1 = I2 + 1
- 6 CONTINUE
- I1 = I1 + 1
-*
- ELSE IF (KT(I).EQ.7) THEN
-*
-* ** Packed Integer (upto seconds)
-*
- CALL CDUPTS (IDATE, ITIME, KY(I), IRC)
- I1 = I1 + 1
- I2 = I1 + 5
- WRITE (CHPRT(I1:I2), 1004) IDATE
- I1 = I2 + 2
- I2 = I1 + 5
- WRITE (CHPRT(I1:I2), 1004) ITIME
- I1 = I2 + 2
-*
- ELSE IF (KT(I).EQ.8) THEN
-*
-* ** Packed Integer (upto minutes)
-*
- CALL CDUPTM (IDATE, ITIME, KY(I), IRC)
- I1 = I1 + 1
- I2 = I1 + 5
- WRITE (CHPRT(I1:I2), 1004) IDATE
- I1 = I2 + 2
- I2 = I1 + 5
- WRITE (CHPRT(I1:I2), 1004) ITIME
- I1 = I2 + 2
-*
- ELSE IF (KT(I).EQ.3.OR.KT(I).EQ.6.OR.KT(I).EQ.9) THEN
-*
- ELSE
-*
- IRC = 103
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDDKYH : Illeg'//
- + 'al data type to be printed = '',I10,/)', KT(I), 1)
-#endif
- GO TO 999
- ENDIF
-*
- 10 CONTINUE
- WRITE (LUN, 2001) CHPRT(1:MXDPCC)
- IRC = 0
-*
- 1001 FORMAT (I8)
- 1002 FORMAT (I2)
- 1003 FORMAT (A4)
- 1004 FORMAT (I6)
- 2001 FORMAT (A)
-* END CDDKYH
- 999 END
diff --git a/src/packlib/hepdb/cdxint/cddkyv.F b/src/packlib/hepdb/cdxint/cddkyv.F
deleted file mode 100644
index af156f3..0000000
--- a/src/packlib/hepdb/cdxint/cddkyv.F
+++ /dev/null
@@ -1,164 +0,0 @@
-*
-* $Id: cddkyv.F,v 1.1.1.1 1996/02/28 16:24:48 mclareni Exp $
-*
-* $Log: cddkyv.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:48 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDDKYV (LUN, NW, CT, KY, KT, ICON, IRC)
-* ==================================================
-*
-************************************************************************
-* *
-* SUBR. CDDKYV (LUN, NW, CT, KY, KT, ICON, IRC*) *
-* *
-* Displays a vector KY of elements NW according to its type KT *
-* in Vertical Mode (Concatenated keys are printed in 1 line) *
-* *
-* Arguments : *
-* *
-* LUN Unit number of the file on which to display *
-* NW Number of elements in the array KY (and KT) *
-* CT Character-Name of the Key to be printed *
-* KY Vector to be printed *
-* KT Type of the vector elements *
-* 1 - Binary *
-* 2 Integer *
-* 3 Floating *
-* 4 Double Precision (not yet implemented) *
-* 5 Hollerith *
-* 6 Hollerith concatenetad to previous hollerith *
-* 7 Packed integer - time packed upto seconds *
-* 8 Packed integer - time packed upto minutes *
-* 9 Data which should not be displayed *
-* ICON Number of keys concatenated to the present one *
-* IRC Return code (see below) *
-* *
-* Called by CDDISV, CDPEEK, CDPRES *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* =103 : Illegal data type *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
- CHARACTER CHPRT*80, CT(*)*8
- DIMENSION KY(9), KT(9), ICON(9)
-*
-* ------------------------------------------------------------------
-*
- I = 1
- 10 CHPRT = ' '
- I1 = 20
- CHPRT(3:10) = CT(I)
- IF (KT(I).EQ.1) THEN
-*
-* ** Binary
-*
- CHPRT(13:13) = 'B'
- I1 = I1 + 2
- I2 = I1 + 9
- WRITE (CHPRT(I1:I2), 1001) KY(I)
- I = I + 1
-*
- ELSE IF (KT(I).EQ.2) THEN
-*
-* ** Integer
-*
- CHPRT(13:13) = 'I'
- I1 = I1 + 2
- I2 = I1 + 9
- WRITE (CHPRT(I1:I2), 1002) KY(I)
- I = I + 1
-*
- ELSE IF (KT(I).EQ.3) THEN
-*
-* ** Floating
-*
- CHPRT(13:13) = 'F'
- I1 = I1 + 1
- I2 = I1 + 11
- WRITE (CHPRT(I1:I2), 1003) KY(I)
- I = I + 1
-*
- ELSE IF (KT(I).EQ.5.OR.KT(I).EQ.6) THEN
-*
-* ** Hollerith
-*
- CHPRT(13:13) = 'H'
- I1 = I1 + 5
- I2 = I1 + 3
- WRITE (CHPRT(I1:I2), 1005) KY(I)
- I = I + 1
-* Is Key concatenated with the next one ?
- NCONC = ICON(I-1)
- IF (NCONC.EQ.0) GO TO 20
- DO 15 J = 1, NCONC
- I1 = I2 + 1
- I2 = I1 + 3
- WRITE (CHPRT(I1:I2), 1005) KY(I)
- I = I + 1
- 15 CONTINUE
-*
- ELSE IF (KT(I).EQ.7) THEN
-*
-* ** Packed Integer - Time packed upto seconds
-*
- CHPRT(13:13) = 'S'
- CALL CDUPTS (IDATE, ITIME, KY(I), IRC)
- I1 = I1 + 2
- I2 = I1 + 9
- WRITE (CHPRT(I1:I2), 1002) IDATE
- I1 = I2 + 2
- I2 = I1 + 9
- WRITE (CHPRT(I1:I2), 1002) ITIME
- I = I + 1
-*
- ELSE IF (KT(I).EQ.8) THEN
-*
-* ** Packed Integer - Time packed upto minutes
-*
- CHPRT(13:13) = 'M'
- CALL CDUPTM (IDATE, ITIME, KY(I), IRC)
- I1 = I1 + 2
- I2 = I1 + 9
- WRITE (CHPRT(I1:I2), 1002) IDATE
- I1 = I2 + 2
- I2 = I1 + 9
- WRITE (CHPRT(I1:I2), 1002) ITIME
- I = I + 1
-*
- ELSE IF (KT(I).EQ.9) THEN
-*
-* ** Key_value should not be visible
-*
- CHPRT = ' '
- CHPRT(13:13) = 'U'
- I = I + 1
-*
- ELSE
-*
- IRC = 103
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDDKYV : Illeg'//
- + 'al data type to be printed = '',I10,/)', KT(I), 1)
-#endif
- GO TO 999
- ENDIF
-*
- 20 CONTINUE
- WRITE (LUN, 2001) CHPRT
- IF (I.LE.NW) GO TO 10
- IRC = 0
-*
- 1001 FORMAT (Z10)
- 1002 FORMAT (I10)
- 1003 FORMAT (E12.4)
- 1005 FORMAT (A4)
- 2001 FORMAT (A)
-* END CDDKYV
- 999 END
diff --git a/src/packlib/hepdb/cdxint/cddprg.F b/src/packlib/hepdb/cdxint/cddprg.F
deleted file mode 100644
index 53a3680..0000000
--- a/src/packlib/hepdb/cdxint/cddprg.F
+++ /dev/null
@@ -1,95 +0,0 @@
-*
-* $Id: cddprg.F,v 1.1.1.1 1996/02/28 16:24:49 mclareni Exp $
-*
-* $Log: cddprg.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:49 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDDPRG (KDISP, NK, CHOPT)
-* ====================================
-*
-************************************************************************
-* *
-* SUBR. CDDPRG (KDISP*, NK, CHOPT) *
-* *
-* Sets flag to keys to be displayed (requested by the user) in the *
-* Horizontal Mode *
-* *
-* Arguments : *
-* *
-* KDISP Key Flag = 0 for No Display, = 1 for Key to be displayed*
-* NK Number of Keys *
-* CHOPT Character string specifying following options *
-* TERM Range of keys requested from terminal *
-* *
-* Called by CDDISH *
-* *
-************************************************************************
-*
-#include "hepdb/cbconc.inc"
-#include "hepdb/ckkeys.inc"
- CHARACTER CRANG*80, CUSE*2, CHOPT*(*)
- DIMENSION KDISP (NK)
-*
-* ------------------------------------------------------------------
-*
- CALL VZERO (KDISP, NK)
-*
- IF (CHOPT.EQ.'TERM') THEN
- CALL KUPROC ('Range of Keys to display: K1-K2,K3-K4,..',
- + CRANG, LCRNG)
- ELSE IF (CHOPT.EQ.'EDIT') THEN
- WRITE (CUSE, '(I2)') IUSECB(NK)
- CRANG = '3-5,8-'//CUSE
- LCRNG = 8
- ELSE
- WRITE (CUSE, '(I2)') IUSECB(NK)
- CRANG = '3-5,8-'//CUSE
- LCRNG = 8
- ENDIF
- IF ((CRANG.EQ.' ') .OR. (LCRNG.EQ.0)) GO TO 20
- NUMB = 0
- NUMB1 = 0
- NUMB2 = 0
- I = 0
- 5 CONTINUE
- I = I + 1
- IF ((I.LE.LCRNG) .AND. (CRANG(I:I).EQ.','.OR.CRANG.EQ.' ')
- + .OR. (I.GT.LCRNG)) THEN
- IF (NUMB.NE.0) THEN
- IF (NUMB1.EQ.0) THEN
- NUMB1 = NUMB
- ELSE
- NUMB2 = NUMB
- ENDIF
- IF (NUMB2.LT.NUMB1) NUMB2 = NUMB1
- NUMB2 = MIN0 (NUMB2, NK)
- NUMBF = ISYSCB(NUMB1)
- NUMBL = ISYSCB(NUMB2)
- NUMBL = NUMBL + ICONCK(NUMBL)
- DO 10 J = NUMBF, NUMBL
- KDISP(J) = 1
- 10 CONTINUE
- NUMB = 0
- NUMB1 = 0
- NUMB2 = 0
- ENDIF
- ELSE IF (CRANG(I:I).EQ.'-') THEN
- NUMB1 = NUMB
- NUMB = 0
- ELSE
- READ (CRANG(I:I), '(I1)') IMANT
- IF (IMANT.GE.0.AND.IMANT.LE.9) THEN
- NUMB = NUMB*10 + IMANT
- ENDIF
- ENDIF
- IF (I.LE.LCRNG) GO TO 5
- GO TO 999
- 20 CONTINUE
- DO 30 I = 1, NK
- KDISP(I) = 1
- 30 CONTINUE
-* END CDDPRG
- 999 END
diff --git a/src/packlib/hepdb/cdxint/cdedas.F b/src/packlib/hepdb/cdxint/cdedas.F
deleted file mode 100644
index 34ac3a5..0000000
--- a/src/packlib/hepdb/cdxint/cdedas.F
+++ /dev/null
@@ -1,112 +0,0 @@
-*
-* $Id: cdedas.F,v 1.1.1.1 1996/02/28 16:24:49 mclareni Exp $
-*
-* $Log: cdedas.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:49 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDEDAS (CFNAM, NCF, PATHN, IRC)
-* ==========================================
-*
-************************************************************************
-* *
-* SUBR. CDEDAS (CFNAM, NCF, PATHN, IRC*) *
-* *
-* Routine to insert objects from a pre-edited ascii file *
-* *
-* Arguments : *
-* *
-* CFNAM Character string describing the name of the file used *
-* for the editing *
-* NCF Number of characters in the string CFNAM *
-* PATHN Character string describing the pathname *
-* IRC Return code (see below) *
-* *
-* Called by CDAUXI *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* *
-************************************************************************
-*
-#include "hepdb/caopts.inc"
-#include "hepdb/cdcblk.inc"
-#include "hepdb/ccdisp.inc"
-#include "hepdb/clinks.inc"
-#include "hepdb/ckkeys.inc"
-#include "hepdb/ctpath.inc"
-#include "hepdb/cxlink.inc"
- CHARACTER CFNAM*(*), PATHN*(*), STRFL*300, PATHY*80
- CHARACTER CHOPT*4, YESNO*1
- DIMENSION KEYS(MXDMCK), KEYO(MXDMCK)
-*
-* ------------------------------------------------------------------
-*
-* *** Set the current directory
-*
- CALL CDLDUP (PATHN, 0, IRC)
- IF (IRC.NE.0) GO TO 999
- PATHY = PAT1CT
- CALL CDKYTG
- CALL CDCONC (IOTYCK(1), NWKYCK, ICONCK(1), NSKPCK)
-*
- CALL KUPROC ('Data is to be inserted ? (Y/N) ', YESNO, LYN)
- IF (YESNO.EQ.'Y') THEN
- CHOPT = 'IAD'
- ELSE
- CHOPT = 'IAW'
- ENDIF
- CALL CDOPFL (LUKYCX, CFNAM, 'OLD', ISTAT)
- IF (ISTAT.NE.0) GO TO 999
- CALL KUPROC ('Horizontal or Vertical Mode ? (H/V) ', YESNO, LYN)
- IF (YESNO.EQ.'H') THEN
- CHOPT(4:4) = 'H'
- READ (LUKYCX, 1001, ERR=20, END=20)
- CALL VZERO (KEYO, NWKYCK)
-*
- 10 CONTINUE
- READ (LUKYCX, CFMTCC, ERR=20, END=20) STRFL(1:MXDPCC)
- IF (STRFL(1:20).EQ.' ') THEN
- GO TO 20
- ELSE IF (STRFL(1:1).EQ.'D') THEN
-*
-* ** The object is to be inserted
-*
- CALL VZERO (KEYS, NWKYCK)
- CALL CDDCKH (STRFL, KEYS(1), IKEY, IRC)
- IF (IRC.NE.0) GO TO 20
- KEYS(IDHKSN) = IKEY
- IOPX = IOPXCA
- CALL CDUPKY (KEYS, KEYO, PATHN, CHOPT, IRC)
- IOPXCA = IOPX
- IF (IRC.NE.0) GO TO 20
- ENDIF
- GO TO 10
- ELSE
- CHOPT(4:4) = 'V'
- CALL VZERO (KEYS, NWKYCK)
- READ (LUKYCX, 1002, ERR=20, END=20)
- 15 CONTINUE
- READ (LUKYCX, '(A80)', ERR=20, END=20) STRFL(1:80)
- IF (STRFL(40:40).NE.'D') GO TO 20
- READ (STRFL(21:30), 1004, ERR=20) KEYS(IDHKSN)
- CALL CDDCKV (LUKYCX, ICONCK(1), KEYS(1), IRC)
- IF (IRC.NE.0) GO TO 20
- IOPX = IOPXCA
- CALL CDUPKY (KEYS, KEYO, PATHN, CHOPT, IRC)
- IOPXCA = IOPX
- IF (IRC.NE.0) GO TO 20
- GO TO 15
- ENDIF
-*
- 20 CALL CDCLFL (LUKYCX)
-*
- 1001 FORMAT (///)
- 1002 FORMAT (/)
- 1003 FORMAT (A)
- 1004 FORMAT (I10)
-* END CDEDAS
- 999 END
diff --git a/src/packlib/hepdb/cdxint/cdedky.F b/src/packlib/hepdb/cdxint/cdedky.F
deleted file mode 100644
index 745b3dc..0000000
--- a/src/packlib/hepdb/cdxint/cdedky.F
+++ /dev/null
@@ -1,162 +0,0 @@
-*
-* $Id: cdedky.F,v 1.1.1.1 1996/02/28 16:24:49 mclareni Exp $
-*
-* $Log: cdedky.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:49 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDEDKY (CFNAM, NCF, PATHN, CHOPT, IRC)
-* =================================================
-*
-************************************************************************
-* *
-* SUBR. CDEDKY (CFNAM, NCF, PATHN, CHOPT, IRC) *
-* *
-* Edits keys and data in an interactive session *
-* *
-* Arguments : *
-* *
-* CFNAM Character string describing the name of the file used *
-* for editing *
-* NCF Number of characters in the string CFNAM *
-* PATHN Character string describing the pathname *
-* CHOPT Character with any of the follwing characters *
-* A ASCII type data *
-* S Standard ZEBRA data bank (default) *
-* IRC Return code (see below) *
-* *
-* Called by CDAUXI *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* *
-************************************************************************
-*
-#include "hepdb/caopts.inc"
-#include "hepdb/cdcblk.inc"
-#include "hepdb/ccdisp.inc"
-#include "hepdb/ckkeys.inc"
-#include "hepdb/clinks.inc"
-#include "hepdb/cxlink.inc"
- PARAMETER (JBIAS=2)
- CHARACTER CFNAM*(*), PATHN*(*), CHOP1*1, CHOP2*1, CHOP0*4
- CHARACTER CHSLA*100, STRFL*300, CHOPT*(*), CFMT*20
- DIMENSION KEYS(MXDMCK), KEYO(MXDMCK), IOPTS(2),ITIME(MXPACD)
- EQUIVALENCE (IOPTS(1), IOPA), (IOPTS(2), IOPS)
-*
-* ------------------------------------------------------------------
-*
-* *** Open the file for editing
-*
- CALL CDOPFL (LUKYCX, CFNAM, 'UNKNOWN', IRC)
- CHOP1 = 'U'
- IF (IRC.NE.0) GO TO 999
- IF (IOPHCC.NE.0) THEN
- IMAX = MXDPCC
- IMRK = 1
- I1 = 2
- I2 = 9
- CFMT = CFMTCC
- ELSE
- IMAX = 80
- IMRK = 40
- I1 = 23
- I2 = 30
- CFMT = '(A80)'
- ENDIF
- CALL CDDISP (LUKYCX, PATHN, CHOP1, IRC)
- CALL CDCLFL (LUKYCX)
- CALL UOPTC (CHOPT, 'AS', IOPTS)
- IF (IRC.NE.0) GO TO 999
- CALL KUEDIT (CFNAM, IST)
-*
-* *** Read back the edited file
-*
- CALL CDOPFL (LUKYCX, CFNAM, 'OLD', ISTAT)
- IF (ISTAT.NE.0) GO TO 999
- CHOP2 = ' '
- CALL VZERO (KEYO, MXDMCK)
- CHSLA = ' '
- NINCR = NWKYCK - NSKPCK - 1
- IF (IOPHCC.NE.0) THEN
- READ (LUKYCX, 1001, ERR=20, END=20)
- ELSE
- READ (LUKYCX, 1002, ERR=20, END=20)
- CHSLA(1:1) = '('
- CHSLA(NINCR+2:NINCR+2) = ')'
- DO 5 I = 1, NINCR
- 5 CHSLA(I+1:I+1) = '/'
- ENDIF
- DO 10 I = 1, NPARCD
- ITIME(I) = 1
- 10 CONTINUE
-*
- 15 READ (LUKYCX, CFMT, ERR=20, END=20) STRFL(1:IMAX)
- IF ((IOPHCC.NE.0) .AND. (STRFL(1:20).EQ.' ')) THEN
- GO TO 20
- ELSE IF ((IOPHCC.EQ.0) .AND. (STRFL(IMRK:IMRK).EQ.'D')) THEN
- READ (LUKYCX, CHSLA(1:NINCR+2), ERR=20, END=20)
- GO TO 15
- ELSE IF (STRFL(IMRK:IMRK).EQ.'N') THEN
-*
-* ** The object is to be inserted
-*
- CALL VZERO (KEYS, NWKYCK)
- IF (IOPHCC.NE.0) THEN
- CALL CDDCKH (STRFL, KEYS(1), IKEY, IRC)
- KEYS(IDHKSN) = IKEY
- CHOP0 = 'V'
- ELSE
- READ (STRFL(21:30), 1004, ERR=20) KEYS(IDHKSN)
- CALL CDDCKV (LUKYCX, ICONCK(1), KEYS(1), IRC)
- CHOP0 = 'H'
- ENDIF
- IF (IRC.NE.0) GO TO 20
- IF (CHOP1.EQ.'I') THEN
- CHOP0 = CHOP0(1:1)//'EI'
- ELSE IF (CHOP2.EQ.'X') THEN
- CHOP0 = CHOP0(1:1)//CHOP2
- ELSE
- CHOP0 = CHOP0(1:1)//'I'
- ENDIF
- IOPX = IOPXCA
- IF (IOPA.EQ.0) THEN
- CALL CDUPKY (KEYS, KEYO, PATHN, CHOP0, IRC)
- ELSE
- CALL CDAIWR (KEYS, KEYO, PATHN, CHOP0, IRC)
- ENDIF
- IOPXCA = IOPX
- IF (IRC.NE.0) GO TO 20
- GO TO 15
- ELSE IF (STRFL(IMRK:IMRK).EQ.'R') THEN
-*
-* ** An existing object is modified
-*
- READ (STRFL(I1:I2), 1005, ERR=20) KEYO(IDHKSN)
- IOLD1 = IOKYCA(IDHKSN)
- IOLDK = IOPKCA
- IOPKCA = 1
- IOKYCA(IDHKSN) = 1
- CALL CDKXIN (ITIME, IDISCD, LAUXCL(7), LAUXCL(7), JBIAS, NWKEY,
- + KEYO, IPREC, IRC)
- IOPKCA = IOLDK
- IOKYCA(IDHKSN) = IOLD1
- CHOP2 = 'X'
- IF (IOPHCC.EQ.0) READ (LUKYCX, CHSLA(1:NINCR+2), ERR=20, END=20)
- GO TO 15
- ELSE IF (IOPHCC.NE.0) THEN
- GO TO 15
- ENDIF
-*
- 20 CALL CDCLFL (LUKYCX)
-*
- 1001 FORMAT (///)
- 1002 FORMAT (/)
- 1003 FORMAT (A)
- 1004 FORMAT (I10)
- 1005 FORMAT (I8)
-* END CDEDKY
- 999 END
diff --git a/src/packlib/hepdb/cdxint/cdftio.F b/src/packlib/hepdb/cdxint/cdftio.F
deleted file mode 100644
index 6d67602..0000000
--- a/src/packlib/hepdb/cdxint/cdftio.F
+++ /dev/null
@@ -1,81 +0,0 @@
-*
-* $Id: cdftio.F,v 1.1.1.1 1996/02/28 16:24:50 mclareni Exp $
-*
-* $Log: cdftio.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:50 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDFTIO (IODV, CHIDH)
-* ===============================
-*
-************************************************************************
-* *
-* SUBR. CDFTIO (IODV, CHIDH*) *
-* *
-* Routine to fetch the I/O characteristic of a bank from *
-* the IODV words into the character string CHIDH *
-* *
-* Arguments : *
-* *
-* IODV I/O word of the bank *
-* CHIDH I/O characteristics of the bank *
-* *
-* Called by user *
-* *
-************************************************************************
-*
-#include "zebra/zbcd.inc"
-#include "zebra/zunit.inc"
-#include "hepdb/quest.inc"
-#include "zebra/mzioc.inc"
-C------------------------- CDE -----------------------------------
-
- CHARACTER CHIDH*(*)
- DIMENSION IODV(20), MTR(500), INV(7)
- DATA INV / 2, 9, 6, 4, 8, 24, 19 /
-*
- CALL MZIOCR (IODV)
-*
- JT = 1
- 21 IF (JFOCUR.EQ.JFOREP) THEN
- MTR(JT) = IQSLAS
- MTR(JT+1) = 0
- JT = JT + 2
- ENDIF
-*
- JF = MFO(JFOCUR+1)
- JC = MFO(JFOCUR+2)
-*
- IF (JC) 24, 25, 26
- 24 MTR(JT) = IQMINS
- JT = JT + 1
- GO TO 28
-*
- 25 MTR(JT) = IQSTAR
- JT = JT + 1
- GO TO 28
-*
- 26 CALL USET (JC,MTR(JT),1,6)
- JT = JT + 6
-*
- 28 JF = INV(JF)
- MTR(JT) = IQLETT(JF)
- MTR(JT+1) = 0
- JT = JT + 2
-
- JFOCUR = JFOCUR + 2
- IF (JFOCUR.LT.JFOEND) GO TO 21
-*
- JT = JT - 2
- CALL ULEFT (MTR,1,JT)
- NT = IULAST (IQBLAN,MTR,JT)
-*
- DO 33 JT=1,NT
- IF (MTR(JT).NE.0) GO TO 33
- MTR(JT) = IQBLAN
- 33 CONTINUE
- CALL UH1TOC (MTR, CHIDH, NT)
-* END CDFTIO
- 99 END
diff --git a/src/packlib/hepdb/cdxint/cdhead.F b/src/packlib/hepdb/cdxint/cdhead.F
deleted file mode 100644
index 873ac2a..0000000
--- a/src/packlib/hepdb/cdxint/cdhead.F
+++ /dev/null
@@ -1,56 +0,0 @@
-*
-* $Id: cdhead.F,v 1.1.1.1 1996/02/28 16:24:50 mclareni Exp $
-*
-* $Log: cdhead.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:50 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDHEAD (IOKEY, NK, CHEAD)
-* ====================================
-*
-************************************************************************
-* *
-* SUBR. CDHEAD (IOKEY, NK, *CHEAD) *
-* *
-* Writes the Header of the Display in Horizontal Mode into the *
-* Character Variable CHEAD *
-* *
-* Arguments : *
-* *
-* IOKEY Type of the Key *
-* 1 - Binary *
-* 2 Integer *
-* 3 Floating *
-* 4 Double Precision (not yet implemented) *
-* 5 Hollerith *
-* 6 Hollerith concatenetad to previous hollerith *
-* 7 Packed integer - time packed upto seconds *
-* 8 Packed integer - time packed upto minutes *
-* 9 Data which should not be displayed *
-* NK Number of Keys *
-* CHEAD Character variable containing the header *
-* *
-* Called by CDDISD, CDDISH *
-* *
-************************************************************************
-*
-#include "hepdb/ckkeys.inc"
-#include "hepdb/ccdisp.inc"
- DIMENSION IOKEY(NK)
- CHARACTER CHEAD*(*)
-*
-* ------------------------------------------------------------------
-*
- IPOS = 11
- DO 5 I = 1,NK
- IF (IOKEY(I).NE.9) THEN
- NSP = MAX0 ((NUMCCC(I)-8)/2,1)
- IW = IPOS + NSP
- CHEAD(IW:IW+7) = CTAGCK(I)
- IPOS = IPOS + NUMCCC(I)
- ENDIF
- 5 CONTINUE
-* END CDHEAD
- END
diff --git a/src/packlib/hepdb/cdxint/cdinau.dat b/src/packlib/hepdb/cdxint/cdinau.dat
deleted file mode 100644
index 35d9ee2..0000000
--- a/src/packlib/hepdb/cdxint/cdinau.dat
+++ /dev/null
@@ -1,367 +0,0 @@
-*
-* $Id: cdinau.dat,v 1.1.1.1 1996/02/28 16:24:50 mclareni Exp $
-*
-* $Log: cdinau.dat,v $
-* Revision 1.1.1.1 1996/02/28 16:24:50 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#if defined(CERNLIB__CDF)
->Name CDINAU
-
->Menu /HEPDB
-
->Menu AUXILIARY
->Guidance
-Auxiliary HEPDB Utility menu
-
->Command CDASCI
->Parameters
-PATHN 'Pathname' C
-CFNAM 'Key-file name' C D='KFNAME.FILEXT'
-+
-CHOPT 'Character option' C D=' '
->Guidance
-Insert objects from a pre-edited file.
-The file contains only the values of the keys in the standard
-horizontal or vertical mode of display. There should be the
-letter N for every new key to be inserted in the appropriate
-column; column 1 in the line with the keys of a given object for
-Horizontal mode and column 20 in the first line describing the
-keys for Vertical mode. Data part can be optionally added when
-the program separately asks for the data.
- CHOPT = 'X' : Assumes validity range packed ala CDPKTS
->Action CDAUXI
-
->Command CDDISP
->Parameters
-PATHN 'Pathname' C
-CFNAM 'Display file name (.FILEXT)' C D='KFNAME.FILEXT'
-+
-CHOPT 'Character option' C D='H'
->Guidance
-Displays all objects (keys only) in a given directory, in Horizontal
-or in Vertical mode.
- CHOPT = 'H' : Displays data in horizontal mode
- = 'V' : Displays data in vertical mode
- = 'X' : Assumes validity range packed ala CDPKTS
->Action CDAUXI
-
->Command CDEALI
->Parameters
-PATHN 'Pathname' C
-ALIAS 'Alias name' C
-+
-IFLAG 'Flag (0 if temporary; 1 if permanent)' I D=0
->Guidance
-Give an alias name (limited to 8 characters) to a directory path name
->Action CDAUXI
-
->Command CDEDIT
->Parameters
-PATHN 'Pathname' C
-CFNAM 'Key-file name' C D='KFNAME.FILEXT'
-+
-CHOPT 'Character option' C D=' '
->Guidance
-Creates Directories, inserts or updates keys and data for a given
-path name. There are two possible modes of operation for inserting
-the key elements of the new object. In the horizontal mode, where
-all the key elements are displayed in a single line, one should
-insert 'N' in column 1 for every new object. To replace an existing
-object (option R in CDSTOM), one has to put 'R' in front of the existing
-object, followed by a new line with the keys of the new object with
-'N' in front. In the vertical mode, all the keys are displayed in
-seperate lines with one header line for every object. As in the
-horizontal mode, one should insert character 'N' or 'R' in the header
-line in column 20 (where the letter 'D' appears in the display).
-Data can be optionally added to the object as requested by the
-interactive program. Only vertical mode (one line for each data
-element) is so far envisaged in this program.
-Note : No compression of data is done.
- CHOPT = 'X' : Assumes validity range packed ala CDPKTS
->Action CDAUXI
-
->Command CDEHLP
->Parameters
-PATHN 'Pathname' C
-CFNAM 'File name' C D='KFNAME.FILEXT'
->Guidance
-Enter help information of a given directory into data base
->Action CDAUXI
-
->Command CDENAM
->Parameters
-PATHN 'Pathname' C
-NWDS 'Number of data words' I
->Guidance
-Enter names of data elements of a given directory into data base
->Action CDAUXI
-
->Command CDEXTR
->Parameters
-PATHN 'Pathname' C
-LUNFZ 'Logical unit number of the FZ file' I
-+
-CHOPT 'Character option' C D=' '
->Guidance
-Copies a part of the directory tree from the current level, as specified
-by the path name, downwards into a sequential file already opened in
-output mode. The objects to be copied could be specified by a range of
-serial number (default option) or by a minimum insertion time (option I
-for HEPDB insertion time or option R for RZ insertion time). The output
-is written in the format of the journal file, which can then be
-subsequently used for updating a copy of the data base. With character
-option 'F', the update mode of the compactification (when the journal
-file will later be used) will make use data objects with matching user
-keys. CHOPT will be followed by the range of serail numbers for default
-option or the date and time (in YYMMDD and HHMM) corresponding to the
-minimum insertion time.
->Action CDAUXI
-
->Command CDKEEP
->Parameters
-NPATH 'Number of paths to be kept' I
-+
-CHOPT 'Character option' C D=' '
->Guidance
-Deletes all directories from the data base except the ones specified
-by the user. The program will prompt for the path names. The user
-should type complete path names including top directory name. If the
-updates of this session are saved in journal files, the user can
-divert the updates in the special backup file using the character
-option 'B'.
->Action CDAUXI
-
->Command CDNTPL
->Parameters
-NPATH 'Number of directories to be scanned' I
-NMASK 'Number of keys used for selection' I D=0
-CHOPT 'Character option for selecting object' C D=' '
-IDN 'Numeric identifier of the N-tuple' I
-CTITL 'Ntuple title' C
-+
-CRZPA 'RZ path for the N-tuple' C D=' '
-NPRIM 'Primary allocation for the Ntuple' I D=1000
-LUNI 'Logical unit number of auxiliary file' I D=0
-CFNAM 'Name of the auxiliary file' C D=' '
->Guidance
-Prepares an N-tuple from the data element(s) belonging to one or more
-directories. The selection of the data objects is steered by CHOPT as
-applied to the first directory. For subsequent directories, it tries
-to match the time slot and selection on user keys is transmitted only
-when the TAG of the appropriate user key in the first path matches
-with the TAG of some user key in the current directory. The following
-assignments of CHOPT have been used.
- CHOPT = 'T' transforms the Keys 3,4,7 to seconds/minutes passed since
- midnight January 1, 1980
- = 'X' assumes validity range packed ala CDPKTS
-Creation of the Ntuple is guided by the parameters IDN, CTITL, CRZPA
-and NPRIM. The user should first set the current directory to the
-desired directory in memory by CDIR //pawc/mydir. One should also
-have a histgram RZ file opened and should give appropriate CRZPA
-to allow automatic overflow to that RZ file. The user is advised to
-read HBOOK manual for more information on Ntuples.
-Detail on data and key elements to be stored in the ntuples is by
-default obtained from interactive enquiry. Optionally the user can
-supply a file with contents of all these enquiries which are read
-in free format from the program.
->Action CDAUXI
-
->Command CDPEEK
->Parameters
-PATHN 'Pathname' C
-CFNAM 'Display file name (.FILEXT)' C D='KFNAME.FILEXT'
-+
-CHOPT 'Character option' C D='H'
->Guidance
-Displays the User Keys in the directory specified, in Horizontal
-or in Vertical mode. Displays data when the first column in mode
-'H' or 'D' in mode 'V' is overwritten by '*'.
- CHOPT = 'H' : Displays data in horizontal mode
- = 'V' : Displays data in vertical mode
- = 'X' : Assumes validity range packed ala CDPKTS
->Action CDAUXI
-
->Command CDPTIM
->Parameters
-IDATE 'Date in YYMMDD' I D=810101
-ITIME 'Time in HHMMSS or HHMM' I D=0
-+
-CHOPT 'Character option' C D=' '
->Guidance
-Packs date and time into one integer word. For default option,
- CALL CDPKTS (IDATE, ITIME, IDATIM, IRC)
-For option M
- CALL CDPKTM (IDATE, ITIME, IDATIM, IRC)
->Action CDAUXI
-
->Command CDPURG
->Parameters
-PATHN 'Pathname' C
-KYDAT 'Key element number' I D=7
-KYTIM 'Maximum value of the key' I D=9999999
-CHOPT 'Character option' C D='K'
->Guidance
-Purges objects in the given directory according to user specification.
- CHOPT = 'A' : Purges all data objects
- = 'K' : Purges data objects with KEY(kydat) < kytim
- = 'L' : Purges all but the last one (one with highest KEY1 value)
- = 'P' : Purges all data objects with the same validity period
- but the one with the highest KEY5 value
- = 'S' : Purges all data objects with KEY1 value in the range
- kydat-kytim
->Action CDAUXI
-
->Command CDPURK
->Parameters
-PATHN 'Pathname' C
-CHOPT 'Character option' C D=' '
->Guidance
-Deletes objects in a directory path name steered by a selection on a
-number of key elements.
- CHOPT = 'B' : Save in the special backup file; not in standard Journal
- = 'F' : Select data objects with all the user keys
- = 'K' : Select data objects with the serial number
- = 'S' : Expect multiple Key banks satisfying selection on a
- number of keys
- = 'X' : Assumes validity range packed ala CDPKTS
- = 'n' : Consider key element n (where 3 < n < 29 )
->Action CDAUXI
-
->Command CDPURP
->Parameters
-PATHN 'Pathname' C
-+
-IKEEP 'Number of partitions to be kept' I D=1
->Guidance
-Deletes all but the last IKEEP partitions in a partitioned directory.
-If IKEEP is negative, it deletes the last -IKEEP partitions.
->Action CDAUXI
-
->Command CDRALI
->Parameters
-ALIAS 'Alias name' C
->Guidance
-Retrieve the directory path name from the alias name
->Action CDAUXI
-
->Command CDRDIC
->Parameters
-PATHN 'Top directory name' C
->Guidance
-Recreate the basic dictionary record and save into the database
->Action CDAUXI
-
->Command CDRENK
->Parameters
-PATHN 'Pathname' C
-KYI 'Object number (Serial number)' I
-KYEL 'Key element to be changed' I
-+
-CHOPT 'Character option' C D=' '
->Guidance
-Rename a given key element of a given object in the specified path
- CHOPT = 'X' assumes validity range packed ala CDPKTS
->Action CDAUXI
-
->Command CDRHLP
->Parameters
-PATHN 'Pathname' C
-CFNAM 'File name' C D='KFNAME.FILEXT'
->Guidance
-Display help information of a given directory from data base
->Action CDAUXI
-
->Command CBRNAM
->Parameters
-PATHN 'Pathname' C
->Guidance
-Read names of data elements of a given directory from data base
->Action CDAUXI
-
->Command CDRTFZ
->Parameters
-PATHN 'Pathname' C
-LUNFZ 'Logical unit number of the FZ file' I
-+
-K1MIN 'Serial number of the first object' I D=1
-K1MAX 'Serial number of the last object' I D=100
-CHOPT 'Character option' C D=' '
->Guidance
-Copies a part of the directory specified by the path name with serial
-number in the range K1MIN to K1MAX into a sequential file already
-opened in output mode. The output is written in the format of the
-journal file, which can then be subsequently used for updating a copy
-of the data base. With character option 'F', the update mode of the
-compactification (when the journal file will later be used) will make
-use data objects with matching user keys.
->Action CDAUXI
-
->Command CDSHOW
->Parameters
-PATHN 'Pathname' C
-+
-CHOPT 'Character option' C D='K'
->Guidance
-Lists keys for all objects in the specified directory (CHOPT='K')
- keys and data for all objects (CHOPT='D')
->Action CDAUXI
-
->Command CDSUMY
->Parameters
-PATHN 'Pathname' C
-+
-NLEVL 'Number of levels' I D=999
->Guidance
-Print statistics of a directory tree specified by a pathname upto
-a certain number of levels.
->Action CDAUXI
-
->Command CDUTIM
->Parameters
-IDATM 'Date and time in one packed integer' I
-+
-CHOPT 'Character option' C D=' '
->Guidance
-Unpacks date and time from one integer word. For default option,
- CALL CDUPTS (IDATE, ITIME, IDATIM, IRC)
-For option M
- CALL CDUPTM (IDATE, ITIME, IDATIM, IRC)
->Action CDAUXI
-
->Command CDVIEW
->Parameters
-PATHN 'Pathname' C
-CFNAM 'Display Filename (.FILEXT)' C D='DPNAME.FILEXT'
-+
-CHOPT 'Character option' C D=' '
->Guidance
-Creates and displays a view a la ORACLE for valid data at a given time.
-Different tables (pathnames) can also be joined.
- CHOPT = 'X' assumes validity range packed ala CDPKTS
->Action CDAUXI
-
->Command CDWRITE
->Parameters
-PATHN 'Pathname' C
-CFNAM 'Key-file name' C D='KFNAME.FILEXT'
-+
-CHOPT 'Character option' C D=' '
->Guidance
-Creates Directories, inserts or updates ASCII data files.
-There are two possible modes of operation for inserting
-the key elements of the new object. In the horizontal mode, where
-all the key elements are displayed in a single line, one should
-insert 'N' in column 1 for every new object. To replace an existing
-object (option R in CDSTOM), one has to put 'R' in front of the existing
-object, followed by a new line with the keys of the new object with
-'N' in front. In the vertical mode, all the keys are displayed in
-seperate lines with one header line for every object. As in the
-horizontal mode, one should insert character 'N' or 'R' in the header
-line in column 20 (where the letter 'D' appears in the display).
-The data part is an ASCII file with a maximum of 80 characters per
-line.
- CHOPT = 'X' assumes validity range packed ala CDPKTS
->Action CDAUXI
-#endif
diff --git a/src/packlib/hepdb/cdxint/cdincd.dat b/src/packlib/hepdb/cdxint/cdincd.dat
deleted file mode 100644
index b115a3d..0000000
--- a/src/packlib/hepdb/cdxint/cdincd.dat
+++ /dev/null
@@ -1,169 +0,0 @@
-*
-* $Id: cdincd.dat,v 1.1.1.1 1996/02/28 16:24:53 mclareni Exp $
-*
-* $Log: cdincd.dat,v $
-* Revision 1.1.1.1 1996/02/28 16:24:53 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#if defined(CERNLIB__CDF)
->Name CDINCD
-
->Menu /HEPDB
-
->Menu INITCLOSE
->Guidance
-HEPDB Initializations or closing
-
->Command CDCRDR
->Parameters
-PATHN 'Pathname' C
-NKEX 'Number of user keys' I
-+
-CHOPT 'Character option' C D=' '
->Guidance
-Creates Directories interactively. It asks for the tags and types
-of user keys interactively.
- CHOPT = 'C' : Data in the directory will be compressed by default
- = 'P' : Create partitioned subdirectories for the pathname
->Action CDACTI
-
->Command CDDDIR
->Parameters
-PATHN 'Pathname' C
->Guidance
-Delete a directory or a directory tree interactively.
->Action CDACTI
-
->Command CDBFOR
->Parameters
-TOPNM 'Name of the top directory' C
-IDATE 'Last date of insertion in YYMMDD' I
-ITIME 'Last time of insertion in HHMM' I
->Guidance
-Sets a cutoff on the insertion time for a given RZ file. The RZ file
-is identified by its top directory name. All subsequent CDUSE calls
-will ignore data objects inserted at a later date/time.
->Action CDACTI
-
->Command CDENFL
->Parameters
-TOPNM 'Top directory name' C
->Guidance
-Close one HEPDB file specified by its top directory name.
->Action CDACTI
-
->Command CDEND
->Guidance
-Close all HEPDB files.
->Action CDACTI
-
->Command CDFZOP
->Parameters
-TOPNM 'Top directory name' C
-LUNF 'Logical unit number of the FZ file' I
-+
-CHOPT 'Character option' C D=' '
->Guidance
-Associates a journal file for a given data base. The journal file
-should be opened before hand using the command FZFILE in write mode.
- CHOPT = ' ' : Stnadard journal file
- = 'B' : Special backup file for objects entered with option B
->Action CDACTI
-
->Command CDFZUP
->Parameters
-LUNF 'Logical unit number of the FZ file' I
-+
-CHOPT 'Character option' C D=' '
->Guidance
-Update a data base from a journal file stored from a previous
-session. The stored file should be opened beforehand using the
-command FZFILE in read mode.
- CHOPT = ' ' : Update keeping KEY(1) value unchanged
- = 'O' : Update ignoring KEY(1) value which is recalculated
->Action CDACTI
-
->Command CDILDF
->Parameters
-LUNI 'Logical unit number of the ASCII file' I
-CFNAM 'Name of the file containing the list' C
-+
-CHOPT 'Character option' C D=' '
->Guidance
-Opens an ASCII file containing the list of directories to be updated
-from the journal file with the force option. This implies that all the
-objects in the journal file are entered in the data base as new objects.
->Action CDACTI
-
->Command CDILDU
->Parameters
-LUNI 'Logical unit number of the ASCII file' I
-CFNAM 'Name of the file containing the list' C
-TOPNM 'Name of the Top Directory' C
-+
-CHOPT 'Character option' C D=' '
->Guidance
-Opens an ASCII file containing the list of directories to be updated
-from the journal file. Reads the directory names. The user can
-supply the root names of the directories if all directories with that
-root name are acceptable.
->Action CDACTI
-
->Command CDINIT
->Parameters
-LUNRZ 'Logical Unit Number for Data Base file' I D=1
-CFNAM 'Name of the Data Base file' C D='DBTEST.DAT'
-TOPNM 'Name of the Top Directory' C D='HEPDB'
-LRECL 'Record length in words' I D=1000
-CHOPT 'Character option for RZFILE/RZMAKE' C D=' '
-IDIV 'HEPDB user Division Index' I D=20
-+
-NREC 'Flag if the file already exists or not' I D=0
-NPAIR 'Number of key pairs for validity range' I D=1
-NTOP 'Serial number of top directory' I D=1
->Guidance
-Open the data base file and initialize HEPDB package.
-NREC should be set to zero if the file already exists.
-Otherwise, NREC should contain maximum number of records in the file.
->Action CDACTI
-
->Command CDLOGL
->Parameters
-TOPNM 'Name of the Top Directory' C D='HEPDB'
-LOGL 'Log level' I D=1
-+
-CHOPT 'Character option' C D=' '
->Guidance
-Set the log level for HEPDB.
->Action CDACTI
-
->Command CDPART
->Parameters
-PATHI 'Input Pathname' C
-PATHN 'Output Pathname' C
-+
-MXKP 'Maximum objects in a partition' I D=50
-NSAV 'Number of objects entered in 1 go' I D=20
-CHOPT 'Character option' C D=' '
->Guidance
-Make partiotioned directory from a normal one.
- CHOPT = ' ' : Stnadard default for updating
- = 'F' : Updates with a fully matched data object (in user keys)
->Action CDACTI
-
->Command CDSAVE
->Guidance
-Saves the information on to the Random Access file through a call to
-CDSAVE. This is useful only when the database is opened with option
-P on IBM.
->Action CDACTI
-
->Command CDSETD
->Parameters
-MXDIS 'Horizontal Display range' I D=80
->Guidance
-Set the Horizontal Display range. At initialization the display
-range is limited to 80 characters per line.
->Action CDACTI
-#endif
diff --git a/src/packlib/hepdb/cdxint/cdinme.dat b/src/packlib/hepdb/cdxint/cdinme.dat
deleted file mode 100644
index 8e1e620..0000000
--- a/src/packlib/hepdb/cdxint/cdinme.dat
+++ /dev/null
@@ -1,15 +0,0 @@
-*
-* $Id: cdinme.dat,v 1.1.1.1 1996/02/28 16:24:50 mclareni Exp $
-*
-* $Log: cdinme.dat,v $
-* Revision 1.1.1.1 1996/02/28 16:24:50 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#if defined(CERNLIB__CDF)
->Name CDINME
-
->Menu HEPDB
->Guidance
-HEPDB Interactive commands
-#endif
diff --git a/src/packlib/hepdb/cdxint/cdinpl.dat b/src/packlib/hepdb/cdxint/cdinpl.dat
deleted file mode 100644
index 6bf51e6..0000000
--- a/src/packlib/hepdb/cdxint/cdinpl.dat
+++ /dev/null
@@ -1,150 +0,0 @@
-*
-* $Id: cdinpl.dat,v 1.1.1.1 1996/02/28 16:24:50 mclareni Exp $
-*
-* $Log: cdinpl.dat,v $
-* Revision 1.1.1.1 1996/02/28 16:24:50 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#if defined(CERNLIB__CDF)
->Name CDINPL
-
->Menu /HEPDB
-
->Menu PLOT
->Guidance
-Plotting facilities inside HEPDB
-
->Command CDHELP
->Parameters
-+
-TOPN 'Top directory name' C D='*'
-CFNAM 'File name' C D='KFNAME.FILEXT'
->Guidance
-Display help information of a given directory from data base. This
-command will show the tree of directory on the screen. The user is
-supposed to pick the directory for whose the help information is
-required by positioning the cursor on the appropriate box and then
-pressing the left mouse button (on Apollo) or space bar on a standard
-terminal. The help information if avialable will be put into a file
-and displayed to the user through the standard editor.
->Action CDACPL
-
->Command CDPLOB
->Parameters
-PATHN 'Pathname' C
-+
-NOBJ 'Number of data elements to be plotted' I D=1
-NMASK 'Number of keys used for selection' I D=0
-KEX 'Key index for the abcissa' I D=3
-NST 'Step size for selection of data object' I D=1
-CHOPT 'Character option' C D=' '
-LUNI 'Logical unit number of auxiliary file' I D=0
-CFNAM 'Name of the auxiliary file' C D=' '
->Guidance
-Plot data element(s) versus a key element for a given directory.
-CHOPT guides the selection of data objects in a directory, as well as
-the mode of display of the data objects.
- CHOPT = 'P' a symbol to be drawn at each point
- (Default is a line to be drawn through the points)
- = 'L' a line to be drawn through the points
- (needed only when symbol and line both to be drawn)
- = 'S' all elements shown on the same plot
- (Default is a seperate plot for each variable)
- = 'X' assumes validity range packed ala CDPKTS
-The list of key and object elements to be plotted and the specification
-of the selection on key values can be supplied through prompts or by
-an auxiliary file.
->Action CDACPL
-
->Command CDPLOT
->Parameters
-ALIAS 'Alias name' C
-CHTAG 'Name of the data element to be plotted' C
-+
-NMASK 'Number of keys used for selection' I D=0
-CHOPT 'Character option' C D=' '
-LUNI 'Logical unit number of auxiliary file' I D=0
-CFNAM 'Name of the auxiliary file' C D=' '
->Guidance
-Plot the time evolution of a given data element from a given directory.
-The directory is addressed by its alias name and the data element is
-addressed by a tag uniquely identifying the data element inside the
-directory. CHOPT guides the selection of data objects in a directory,
-as well as the mode of display of the data objects.
- CHOPT = 'P' a symbol to be drawn at each point
- (Default is a line to be drawn through the points)
- = 'X' assumes validity range packed ala CDPKTS
-The specification of the selection on key values can be supplied through
-prompts or by an auxiliary file.
->Action CDACPL
-
->Command CDPLOV
->Parameters
-PATHN 'Pathname' C
-+
-NOBJ 'Pair of elements to be plotted' I D=1
-NMASK 'Number of keys used for selection' I D=0
-NST 'Step size for selection of data object' I D=1
-CHOPT 'Character option' C D=' '
-LUNI 'Logical unit number of auxiliary file' I D=0
-CFNAM 'Name of the auxiliary file' C D=' '
->Guidance
-Plot data element(s) versus data element(s) for a given directory.
-CHOPT guides the selection of data objects in a directory, as well as
-the mode of display of the data objects.
- CHOPT = 'L' line to be drawn through the points
- = 'P' a symbol to be drawn at each point
- (If L or P not chosen, a default marker to be drawn
- at each point)
- = 'X' assumes validity range packed ala CDPKTS
-The list of pair of object elements to be plotted and the specification
-of the selection on key values can be supplied through prompts or by
-an auxiliary file.
->Action CDACPL
-
->Command CDPLTI
->Parameters
-PATHN 'Pathname' C
-+
-NMASK 'Number of keys used for selection' I D=0
-CHOPT 'Character option' C D=' '
-LUNI 'Logical unit number of auxiliary file' I D=0
-CFNAM 'Name of the auxiliary file' C D=' '
->Guidance
-Plot validity time of data objects in a directory.
-CHOPT guides the selection of data objects in a directory.
- CHOPT = 'X' assumes validity range packed ala CDPKTS
-Detail is given in the HEPDB documentation.
-The specification of the selection on key values can be supplied through
-prompts or by an auxiliary file.
->Action CDACPL
-
->Command CDREAD
->Parameters
-+
-TOPN 'Top Directory name' C D='*'
-CFNAM 'Display file name (.FILEXT)' C D='KFNAME.FILEXT'
-CHOPT 'Character option' C D='H'
->Guidance
-Displays the directory structure of the RZ-file as specified by
-the user through the Top directory name (by default it uses the
-first data base file opened). The user can then pick the wanted
-directory using the mouse button 1 by positioning on the last node.
-Displays the User Keys in the directory specified on the screen,
-in Horizontal or in Vertical mode. Displays data when the first
-column in mode 'H' or 'D' in mode 'V' is overwritten by '*'
- CHOPT = 'H' : Displays data in horizontal mode
- = 'V' : Displays data in vertical mode
- = 'X' : Assumes validity range packed ala CDPKTS
->Action CDACPL
-
->Command CDTREE
->Parameters
-+
-TOPN 'Top Directory name' C D='*'
->Guidance
-Draw the tree of directories in the file given by the top directory
-name.
->Action CDACPL
-#endif
diff --git a/src/packlib/hepdb/cdxint/cdinxi.F b/src/packlib/hepdb/cdxint/cdinxi.F
deleted file mode 100644
index ae26a4a..0000000
--- a/src/packlib/hepdb/cdxint/cdinxi.F
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: cdinxi.F,v 1.1.1.1 1996/02/28 16:24:50 mclareni Exp $
-*
-* $Log: cdinxi.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:50 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDINXI
-*
-************************************************************************
-*
-* SUBR. CDINXI
-*
-* Defines interactive Menus and Commands for HEPDB
-*
-* Called by DBMAIN
-*
-************************************************************************
-*
- CALL CDINME
- CALL CDINCD
- CALL CDINAU
- CALL CDINPL
-* END CDINXI
- END
diff --git a/src/packlib/hepdb/cdxint/cdjoin.F b/src/packlib/hepdb/cdxint/cdjoin.F
deleted file mode 100644
index f8e38f4..0000000
--- a/src/packlib/hepdb/cdxint/cdjoin.F
+++ /dev/null
@@ -1,263 +0,0 @@
-*
-* $Id: cdjoin.F,v 1.1.1.1 1996/02/28 16:24:50 mclareni Exp $
-*
-* $Log: cdjoin.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:50 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDJOIN (PATHN, IDATM, NI, NOBI, CHTI, IOTI, ICONI,
- + KEYI, NO, NOBO, CHTO, IOTO, ICONO, IRC)
-* =============================================================
-*
-************************************************************************
-* *
-* SUBR.CDJOIN (PATHN, IDATM, NI, NOBI, CHTI, IOTI, ICONI, *
-* KEYI, NO*, NOBO*, CHTO*, IOTO*, ICONO, IRC*) *
-* *
-* Routine to Join a Table of Name PATHN *
-* The values of the Keys to be presented can be found at *
-* IQ(LJOICX+1,..,NO,NO+1,...,NO*NOBO) *
-* *
-* Arguments : *
-* *
-* PATHN Pathname of the Table *
-* IDATM Packed Date and Time (or Run #) at which the table is *
-* valid *
-* NI Number of Coloumns to join *
-* NOBI Number of Rows (Data) to join *
-* CHTI Name of Keys to which to join *
-* IOTI Type of Keys to which to join *
-* ICONI Number of concatenated keys to join *
-* KEYI Value of Keys to which to join *
-* NO Number of Keys to be Presented *
-* NOBO Number of Objects to be presented *
-* CHTO Name of Keys used for Presentation *
-* IOTO Type of Keys used for Presentation *
-* ICONO Number of concatenated keys to present *
-* IRC Return code (see below) *
-* *
-* Called by CDVIEW *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
-#include "hepdb/clinks.inc"
-#include "hepdb/ckkeys.inc"
-#include "hepdb/cviews.inc"
-#include "hepdb/cxlink.inc"
- DIMENSION IOTI(NI), IOTO(9), KEYI(NI, NOBI)
- DIMENSION ICONI(9), ICONO(9), IFLAG(100), IDATM(9)
- CHARACTER PATHN*(*), CHTI(NI)*8, CHTO(*)*8, CHTG(100)*8
- CHARACTER KYNAM*8, KYVAL*20, BLANK*20
- CHARACTER KY10*10, CHPRO*50
- DATA BLANK /' '/
-*
-* ------------------------------------------------------------------
-*
-* *** Set the current directory
-*
- CALL CDLDUP (PATHN, 0, IRC)
- IF (IRC.NE.0) GO TO 999
- CALL CDKYTG
-*
-* ** Fill concatenation flag (if non-zero: number of concatenated keys
-*
- CALL CDCONC (IOTYCK(1), NWKYCK, ICONCK(1), NSKPCK)
-*
-* ** Get the Coloumn Names in the Table to Join
-*
- CALL VZERO (IFKYCV, NWKYCK)
- CALL VZERO (IFLAG, NWKYCK)
- CALL VZERO (MASKCX, NWKYCK)
- I = 1
- 1 I = I + 1
- IF (I.GT.NI) GO TO 7
- 2 I1 = I-1
- CHPRO = 'Give name for '//CHTI(I)
- CALL KUPROC (CHPRO(1:23), CHTG(I1), LCHT)
- IOTYCV(I1) = IOTI(I)
- DO 3 J = NSYSCK+1, NWKYCK
- IF (CHTG(I1).EQ.CTAGCK(J)) THEN
- JST = J
- IFKYCV(I1) = J
- MASKCX(J) = 1
- GO TO 5
- ENDIF
- 3 CONTINUE
- GO TO 2
- 5 CONTINUE
- IF (ICONI(I).EQ.0) GO TO 1
- NREP = ICONI(I)
- DO 6 J = 1, NREP
- I = I + 1
- K = JST + J
- I1 = I - 1
- IFKYCV(I1) = K
- IFLAG(K) = 1
- MASKCX(K) = 1
- IOTYCV(I1) = IOTYCK(K)
- CHTG(I1) = CTAGCK(K)
- 6 CONTINUE
- GO TO 1
- 7 CONTINUE
-*
-* ** Get additional Key-Names and Key-Values to Search
-*
- CALL VZERO (KEYSCV, NWKYCK)
- IK = NI-1
- 10 CONTINUE
- CALL KUPROC ('Key-Name to Search (if no more - |) ?', KYNAM, LKEY)
- IF (KYNAM.EQ.'|') GO TO 20
- I = NSYSCK+1
- 11 IF (I.GT.NWKYCK) GO TO 13
- IF (KYNAM.EQ.CTAGCK(I).AND.IFLAG(I).EQ.0) THEN
- IFLAG(I) = 1
- IKEY = I
- IK = IK + 1
- IFKYCV(IK) = I
- MASKCX(I) = 1
- CHTG(IK) = CTAGCK(I)
- IOTYCV(IK) = IOTYCK(I)
- ICONI(IK) = ICONCK(I)
- NREP = 0
- IF (ICONI(IK).GT.0) THEN
- NREP = ICONI(IK)
- DO 12 J = 1, NREP
- I = I + 1
- IFKYCV(IK+J) = I
- MASKCX(I) = 1
- CHTG(IK+J) = CTAGCK(I)
- IOTYCV(IK+J) = IOTYCK(I)
- ICONI(IK+J) = ICONCK(I)
- IFLAG(I) = 1
- 12 CONTINUE
- ENDIF
- GO TO 15
- ENDIF
- I = I + 1
- GO TO 11
- 13 CONTINUE
- GO TO 10
- 15 CONTINUE
- CALL KUPROC ('Key-Value ?', KYVAL, LKEY)
- IF (IOTYCK(IKEY).EQ.5) THEN
-* * Hollerith
- LCDAT = (NREP+1)*4
- CALL UCTOH (KYVAL(1:LCDAT), KEYSCV(IKEY), 4, LCDAT)
- IK = IK + NREP
- ELSE IF (IOTYCK(IKEY).EQ.2) THEN
-* * Integer
- LEN = MIN (10,LKEY)
- KY10 = BLANK(1:10-LEN)//KYVAL(1:LEN)
- READ (KY10(1:10), 1002) KEYSCV(IKEY)
- ELSE IF (IOTYCK(IKEY).EQ.1) THEN
-* * Bit-string
- LEN = MIN (8,LKEY)
- KY10 = BLANK(1:8-LEN)//KYVAL(1:LEN)
- READ (KY10(1:8), 1003) KEYSCV(IKEY)
- ENDIF
- GO TO 10
- 20 CONTINUE
-*
-* ** Loop on Input Objects
-*
- LKJNCX(1) = 0
- LKJNCX(2) = 0
- DO 23 I = 1, NOBI
-* * Key-Vector for CDUSEDB
- DO 22 J = 2, NI
- INDX = IFKYCV(J-1)
-* * The following equality can be later replaced by other relation:
- KEYSCV(INDX) = KEYI(J,I)
- 22 CONTINUE
-*
- IF (I.EQ.1) THEN
- CALL CDUSEDB (PATHN, LKJNCX(1),IDATM, MASKCX,KEYSCV,'VS', IRC)
- ELSE
- CALL CDUSEDB (PATHN, LKJNCX(2),IDATM, MASKCX,KEYSCV,'VS', IRC)
- IF (LKJNCX(1).EQ.0) LKJNCX(1) = LKJNCX(2)
- ENDIF
- 23 CONTINUE
-*
-* ** Get the Key-Names to Present
-*
- CALL VZERO (JFKYCV, NWKYCK)
- CALL VZERO (IFLAG, NWKYCK)
- IP = 1
- ICONO(I) = 0
- CHTO(1) = CTAGCK(IDHKSN)
- IOTO(1) = IOTYCK(IDHKSN)
- JFKYCV(1) = IDHKSN
- 25 CALL KUPROC ('Key-Name to Present (if no more: |) ?', KYNAM, LKEY)
- IF (KYNAM.EQ.'|') GO TO 30
- I = NSYSCK+1
- 26 IF (I.GT.NWKYCK) GO TO 28
- IF (KYNAM.EQ.CTAGCK(I).AND.IFLAG(I).EQ.0) THEN
- IFLAG(I) = 1
- IP = IP + 1
- CHTO(IP) = CTAGCK(I)
- IOTO(IP) = IOTYCK(I)
- ICONO(IP) = ICONCK(I)
- JFKYCV(IP) = I
- IF (ICONO(IP).LE.0) THEN
- GO TO 25
- ELSE
- NREP = ICONO(IP)
- DO 27 J = 1,NREP
- IP = IP + 1
- I = I + 1
- IFLAG(I) = 1
- CHTO(IP) = CTAGCK(I)
- IOTO(IP) = IOTYCK(I)
- ICONO(IP) = ICONCK(I)
- JFKYCV(IP) = I
- 27 CONTINUE
- ENDIF
- GO TO 25
- ENDIF
- I = I + 1
- GO TO 26
- 28 CONTINUE
- GO TO 25
- 30 CONTINUE
-*
-* ** Lift Bank for Output
-*
- NO = IP
- IF (NO.LE.0) GO TO 999
- NOBO = NZBANK (IDIVCD, LKJNCX(1))
- IF (NOBO.LE.0) GO TO 999
- NDAT = NO * NOBO
- CALL CDBANK (IDIVCD, LJOICX, LJOICX, 2, 'JOIN', 0, 0, NDAT, 2, 0,
- + IRC)
- IF (IRC.NE.0) GO TO 999
-*
-* ** Fill-Up 'JOIN' Bank and free LKJNCX
-*
- IPOIN = LJOICX
- NKOBJ = NZBANK (IDIVCD, LKJNCX(1))
- IF (NKOBJ.GT.0) THEN
- LFRSCX = LKJNCX(1)
- DO 40 K = 1, NKOBJ
- IF (LFRSCX.GT.0) THEN
- DO 35 J = 1, NO
- IPOIN = IPOIN + 1
- IQ(KOFUCD+IPOIN) = IQ(KOFUCD+LFRSCX+JFKYCV(J))
- 35 CONTINUE
- ENDIF
- LFRSCX = LQ(KOFUCD+LFRSCX)
- 40 CONTINUE
- ENDIF
- CALL MZDROP (IDIVCD, LKJNCX(1), 'L')
-*
- 1001 FORMAT (I2)
- 1002 FORMAT (I10)
- 1003 FORMAT (Z8)
-* END CDJOIN
- 999 END
diff --git a/src/packlib/hepdb/cdxint/cdlook.F b/src/packlib/hepdb/cdxint/cdlook.F
deleted file mode 100644
index 69727b2..0000000
--- a/src/packlib/hepdb/cdxint/cdlook.F
+++ /dev/null
@@ -1,114 +0,0 @@
-*
-* $Id: cdlook.F,v 1.1.1.1 1996/02/28 16:24:50 mclareni Exp $
-*
-* $Log: cdlook.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:50 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDLOOK (LAD, X, Y, PATH)
-* ===================================
-*
-************************************************************************
-* *
-* SUBR. CDLOOK (LAD, X, Y, PATH*) *
-* *
-* Returns the path name picked up by the cursor at x, y *
-* *
-* Arguments : *
-* *
-* LAD Address of the bank containing information about the *
-* tree structure starting from the top level *
-* X X coordinate of the cursor position *
-* Y Y coordinate of the cursor position *
-* PATH Complete path name as picked up by the user *
-* (Blank if no path is found) *
-* *
-* Called by CDACPL *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
-#include "hepdb/ckkeys.inc"
-#include "hepdb/ctpath.inc"
- DIMENSION LAD(9)
- CHARACTER PATH*(*)
-*
-* ------------------------------------------------------------------
-*
- PATH = ' '
- IF (LAD(1).LE.0) GO TO 999
- NLEV = IQ(KOFUCD+LAD(1)+MNLVCD)
- IF (NLEV.LE.0) GO TO 999
-*
-* *** Find the level number from the x coordinate
-*
- IPNL = IQ(KOFUCD+LAD(1)+MPNLCD)
- HFRAM = Q(KOFUCD+LAD(1)+MHFMCD)
- KLEV = 0
- DO 10 ILEV = 1, NLEV
- XDIST = X - Q(KOFUCD+LAD(1)+IPNL+MXOFCD)
- DELX = Q(KOFUCD+LAD(1)+IPNL+MXWDCD)
- IF (XDIST.GE.0.AND.XDIST.LE.DELX) THEN
- KLEV = ILEV
- ENDIF
- IPNL = IQ(KOFUCD+LAD(1)+IPNL+MPNLCD)
- 10 CONTINUE
- IF (KLEV.LE.0) GO TO 999
-*
-* *** Find the node number from the y coordinate
-*
- IPNL = IQ(KOFUCD+LAD(1)+MPNLCD)
- NODE = 0
- IF (KLEV.GT.1) THEN
- DO 15 ILEV = 2, KLEV
- IPNL = IQ(KOFUCD+LAD(1)+IPNL+MPNLCD)
- 15 CONTINUE
- ENDIF
- NODES = IQ(KOFUCD+LAD(1)+IPNL+MNODCD)
- IPNN = IQ(KOFUCD+LAD(1)+IPNL+MPNNCD)
- DO 20 INOD = 1, NODES
- YDIST = Y- Q(KOFUCD+LAD(1)+IPNN+MYFNCD)
- IF (YDIST.GE.0.AND.YDIST.LE.HFRAM) THEN
- NODE = INOD
- ENDIF
- IPNN = IQ(KOFUCD+LAD(1)+IPNN+MPNLCD)
- 20 CONTINUE
- IF (NODE.LE.0) GO TO 999
-*
-* *** Correct node is identified; now compute the Path
-*
- IUPN = NODE
- NCHRT = 0
- PAT2CT = ' '
- DO 40 ILEV = 1, KLEV
- JLEV = KLEV + 1 - ILEV
- IPNL = IQ(KOFUCD+LAD(1)+MPNLCD)
- IF (JLEV.GT.1) THEN
- DO 25 IL = 2, JLEV
- IPNL = IQ(KOFUCD+LAD(1)+IPNL+MPNLCD)
- 25 CONTINUE
- ENDIF
- IPNN = IQ(KOFUCD+LAD(1)+IPNL+MPNNCD)
- IF (IUPN.GT.1) THEN
- DO 30 INOD = 2, IUPN
- IPNN = IQ(KOFUCD+LAD(1)+IPNN+MPNLCD)
- 30 CONTINUE
- ENDIF
- NCHR = IQ(KOFUCD+LAD(1)+IPNN+MNCHCD)
- IUPN = IQ(KOFUCD+LAD(1)+IPNN+MNFNCD)
- CALL UHTOC (IQ(KOFUCD+LAD(1)+IPNN+MNAMCD), 4, TOP2CT, NCHR)
- PAT4CT = '/'//TOP2CT(1:NCHR)
- NCHR = NCHR+1
- IF (NCHRT.GT.0) THEN
- PAT3CT = PAT4CT(1:NCHR)//PAT2CT(1:NCHRT)
- ELSE
- PAT3CT = PAT4CT
- ENDIF
- PAT2CT = PAT3CT
- NCHRT = NCHRT + NCHR
- 40 CONTINUE
- PATH = '/'//PAT2CT
-* END CDLOOK
- 999 END
diff --git a/src/packlib/hepdb/cdxint/cdopfl.F b/src/packlib/hepdb/cdxint/cdopfl.F
deleted file mode 100644
index fc58f9f..0000000
--- a/src/packlib/hepdb/cdxint/cdopfl.F
+++ /dev/null
@@ -1,71 +0,0 @@
-*
-* $Id: cdopfl.F,v 1.1.1.1 1996/02/28 16:24:50 mclareni Exp $
-*
-* $Log: cdopfl.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:50 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDOPFL (LUN, CHNAM, STATE, ISTAT)
-* ============================================
-*
-************************************************************************
-* *
-* SUBR. CDOPFL (LUN, CHNAM, STATE, ISTAT*) *
-* *
-* Opens a sequential formatted file through a FOTRAN OPEN statement *
-* *
-* Arguments : *
-* *
-* LUN Logical unit number *
-* CHNAM Character string specifying the file name *
-* STATE Status of the file *
-* ISTAT Error code for opening the file (0 if no error) *
-* *
-* Called by CDACPL, CDAIWR, CDAUXI, CDEDAS, CDEDKY, CDPEEK, CDPRES, *
-* CDRDIO *
-* *
-************************************************************************
-*
- CHARACTER CHNAM*(*), STATE*(*)
-#if defined(CERNLIB_IBM)
- CHARACTER NAME*128
-#endif
-*
-* ------------------------------------------------------------------
-*
-* *** Open the file
-*
-#if (!defined(CERNLIB_IBM))&&(!defined(CERNLIB_VAX))
- OPEN (UNIT=LUN, FILE=CHNAM, ACCESS='SEQUENTIAL', STATUS=STATE,
- + FORM='FORMATTED', IOSTAT=ISTAT, ERR=20)
-#endif
-#if defined(CERNLIB_IBM)
- NAME = '/'//CHNAM
- 10 L = INDEX (NAME, '.')
- IF (L.NE.0) THEN
- NAME(L:L) = ' '
- GO TO 10
- ENDIF
- IF (STATE.EQ.'OLD') THEN
- OPEN (UNIT=LUN, FILE=NAME, ACCESS='SEQUENTIAL', STATUS=STATE,
- + ACTION='READ', FORM='FORMATTED', IOSTAT=ISTAT, ERR=20)
- ELSE
- OPEN (UNIT=LUN, FILE=NAME, ACCESS='SEQUENTIAL', STATUS=STATE,
- + ACTION='WRITE', FORM='FORMATTED', IOSTAT=ISTAT, ERR=20)
- ENDIF
-#endif
-#if defined(CERNLIB_VAX)
- IF (STATE.EQ.'OLD') THEN
- OPEN (UNIT=LUN, FILE=CHNAM, ACCESS='SEQUENTIAL', STATUS=STATE,
- + FORM='FORMATTED', READONLY, IOSTAT=ISTAT, ERR=20)
- ELSE
- OPEN (UNIT=LUN, FILE=CHNAM, ACCESS='SEQUENTIAL', STATUS=STATE,
- + FORM='FORMATTED', IOSTAT=ISTAT, ERR=20)
- ENDIF
-#endif
- ISTAT = 0
- 20 CONTINUE
-* END CDOPFL
- 999 END
diff --git a/src/packlib/hepdb/cdxint/cdpeek.F b/src/packlib/hepdb/cdxint/cdpeek.F
deleted file mode 100644
index acdf7e6..0000000
--- a/src/packlib/hepdb/cdxint/cdpeek.F
+++ /dev/null
@@ -1,194 +0,0 @@
-*
-* $Id: cdpeek.F,v 1.1.1.1 1996/02/28 16:24:50 mclareni Exp $
-*
-* $Log: cdpeek.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:50 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDPEEK (CFNAM, NCF, PATHN, IRC)
-* ==========================================
-*
-************************************************************************
-* *
-* SUBR. CDPEEK (CFNAM, NCF, PATHN, IRC*) *
-* *
-* Displays keys and data in an interactive session *
-* *
-* Arguments : *
-* *
-* CFNAM Character string describing the name of the file used *
-* NCF Number of characters in the string CFNAM *
-* PATHN Character string describing the pathname *
-* IRC Return code (see below) *
-* *
-* Called by CDACPL, CDAUXI *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* *
-************************************************************************
-*
-#include "hepdb/caopts.inc"
-#include "hepdb/cdcblk.inc"
-#include "hepdb/ccdisp.inc"
-#include "hepdb/ckkeys.inc"
-#include "hepdb/clinks.inc"
-#include "hepdb/cxlink.inc"
- PARAMETER (JBIAS=2)
- CHARACTER CFNAM*(*), PATHN*(*), CHOP1*1, CHSLA*100, STRFL*40
- CHARACTER DFNAM*20
- DIMENSION KEYX(MXDMCK), ITIME(MXPACD)
-#include "zebra/q_jbit.inc"
-* Ignoring t=pass
-*
-* ------------------------------------------------------------------
-*
-* *** Display the keys
-*
- IF (IOPHCC.NE.0) THEN
- IMRK = 1
- I1 = 2
- I2 = 9
- CHOP1 = 'K'
- ELSE
- IMRK = 40
- I1 = 23
- I2 = 30
- CHOP1 = 'U'
- ENDIF
- CALL CDDISP (LUKYCX, PATHN, CHOP1, IRC)
- CALL CDCLFL (LUKYCX)
- IF (IRC.NE.0) THEN
- CHSLA = PATHN
- NCH = LENOCC (CHSLA)
- CALL CDPRNT (LPRTCD, '(/,'' CDPEEK : Error '',I6,'' from CDDI'//
- + 'SP for '//CHSLA(1:NCH)//''')', IERR, 1)
- GO TO 999
- ENDIF
-*
-* *** Open the file for editing
-* *** If Data are to be displayed - replace 'D' by an asterix
-*
- CALL KUEDIT (CFNAM, IST)
- IF (IST.NE.0) THEN
- CHSLA = CFNAM
- NCH = LENOCC (CHSLA)
- IF (IST.NE.1)
- + CALL CDPRNT (LPRTCD, '(/,'' CDPEEK : Error '',I12,'' in edi'//
- + 'ting file '//CHSLA(1:NCH)//''')', IST, 1)
- GO TO 999
- ENDIF
-#if !defined(CERNLIB_IBMVM)
- DFNAM = 'DFNAME.FILEXT'
-#endif
-#if defined(CERNLIB_UNIX)
- CALL CUTOL (DFNAM)
-#endif
-#if defined(CERNLIB_IBMVM)
- DFNAM = 'DFNAME.FILEXT.A1'
-#endif
-*
-* *** Read back the edited file -- look for the '*'
-*
- CALL CDOPFL (LUKYCX, CFNAM, 'OLD', ISTAT)
- IF (ISTAT.NE.0) THEN
- CHSLA = CFNAM
- NCH = LENOCC (CHSLA)
- CALL CDPRNT (LPRTCD, '(/,'' CDPEEK : Error '',I12,'' in open'//
- + 'ing file '//CHSLA(1:NCH)//''')', ISTAT, 1)
- GO TO 999
- ENDIF
- CALL UCOPY (IOTYCK, IOTYCC, NWKYCK)
- IF (IOPXCA.NE.0) THEN
- DO 5 I = 1, 2*NPARCD
- IOTYCC(NOF1CK+I) = 7
- 5 CONTINUE
- ENDIF
- IOTYCC(IDHINS) = 8
- CHSLA = ' '
- IF (IOPHCC.NE.0) THEN
- READ (LUKYCX, 1001, ERR=30, END=30)
- NINCR = 0
- ELSE
- READ (LUKYCX, 1002, ERR=30, END=30)
- NINCR = NWKYCK - NSKPCK - 1
- CHSLA(1:1) = '('
- CHSLA(NINCR+2:NINCR+2) = ')'
- DO 10 I = 1, NINCR
- 10 CHSLA(I+1:I+1) = '/'
- ENDIF
- DO 15 I = 1, NPARCD
- ITIME(I) = 1
- 15 CONTINUE
-*
- 20 CONTINUE
- READ (LUKYCX, 1003, ERR=30, END=30) STRFL
- IF ((IOPHCC.NE.0) .AND. (STRFL(1:20).EQ.' ')) THEN
- GO TO 30
- ELSE IF ((IOPHCC.EQ.0) .AND. (STRFL(IMRK:IMRK).EQ.'D')) THEN
- READ (LUKYCX, CHSLA(1:NINCR+2), ERR=30, END=30)
- GO TO 20
- ELSE IF (STRFL(IMRK:IMRK).EQ.'*') THEN
-*
-* ** Fetch the data according to the key vector
-*
- READ (STRFL(I1:I2), 1004, ERR=30) KEYX(IDHKSN)
- IOLD = IOKYCA(IDHKSN)
- IOKYCA(IDHKSN) = 1
- CALL CDKXIN (ITIME, IDIVCD, LFRSCX, LFRSCX, JBIAS, NWKEY, KEYX,
- + IPREC, IRC)
- IOKYCA(IDHKSN) = IOLD
- IF (IRC.EQ.0.AND.IQ(KOFUCD+LFRSCX-1).GT.0) THEN
-*
-* * Display the data
-*
- CALL CDOPFL (LUDACX, DFNAM, 'UNKNOWN', IST1)
- IF (IST1.NE.0) THEN
- CHSLA = DFNAM
- NCH = LENOCC (CHSLA)
- CALL CDPRNT (LPRTCD, '(/,'' CDPEEK : Error '',I12,'' in '//
- + 'opening file '//CHSLA(1:NCH)//''')', IST1, 1)
- GO TO 30
- ENDIF
- IF (JBIT(KEYX(IDHFLG), JASFCD).EQ.0) THEN
- CALL CDDKYV (LUDACX, NWKYCK, CTAGCK, KEYX, IOTYCC, ICONCK,
- + IRC)
- CALL CDWRDP (LUDACX, LFRSCX)
- ELSE
- CALL UCOPY (KEYX, KEYVCK, NWKEY)
- CALL CDAIRD (LUDACX, PATHN, KEYX, 'E', IRC)
- ENDIF
- CALL CDCLFL (LUDACX)
- CALL KUEDIT (DFNAM, IST2)
- ELSE
- IF (IRC.NE.0) THEN
- IARGCD(1) = IRC
- IARGCD(2) = KEYX(IDHKSN)
- CALL CDPRNT (LPRTCD, '(/,'' CDPEEK : Error '',I12,'' in '//
- + 'reading data for '',I12)', IARGCD, 2)
- ELSE
- CALL CDPRNT (LPRTCD, '(/,'' CDPEEK : Empty data structure'//
- + ' for '',I12)', KEYX(IDHKSN), 1)
- ENDIF
- ENDIF
-*
- IF (LFRSCX.NE.0) CALL MZDROP (IDIVCD, LFRSCX, 'L')
- IF (IOPHCC.EQ.0) THEN
- READ (LUKYCX, CHSLA(1:NINCR+2), ERR=30, END=30)
- ENDIF
- GO TO 20
- ELSE IF (IOPHCC.NE.0) THEN
- GO TO 20
- ENDIF
-*
- 30 CALL CDCLFL (LUKYCX)
-*
- 1001 FORMAT (///)
- 1002 FORMAT (/)
- 1003 FORMAT (A40)
- 1004 FORMAT (I8)
-* END CDPEEK
- 999 END
diff --git a/src/packlib/hepdb/cdxint/cdpres.F b/src/packlib/hepdb/cdxint/cdpres.F
deleted file mode 100644
index 68585d9..0000000
--- a/src/packlib/hepdb/cdxint/cdpres.F
+++ /dev/null
@@ -1,163 +0,0 @@
-*
-* $Id: cdpres.F,v 1.1.1.1 1996/02/28 16:24:51 mclareni Exp $
-*
-* $Log: cdpres.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:51 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDPRES (PATHI, PATHO, IOTI, IOTO, CHTI, CHTO, KEYI,
- + KEYO, ICONI, ICONO, NI, NO, NOB, CFNAM, IRC)
-* ===============================================================
-*
-************************************************************************
-* *
-* SUBR. CDPRES (PATHI, PATHO, IOTI, IOTO, CHTI, CHTO, KEYI, *
-* KEYO, ICONI, ICONO, NI, NO, NOB, CFNAM, IRC*) *
-* *
-* Routine to Present the "View" *
-* *
-* Arguments : *
-* *
-* PATHI Pathname of the First Table *
-* PATHO Pathname of the Last Table *
-* IOTI Type of Keys used for Search *
-* IOTO Type of Keys used for Presentation *
-* CHTI Name of Keys used for Search *
-* CHTO Name of Keys used for Presentation *
-* KEYI Value of Keys used for Search *
-* KEYO Value of Keys to be presented *
-* ICONI Number of keys concatenated to this key *
-* ICONO Number of keys concatenated to this key *
-* NI Number of Keys used for Search *
-* NO Number of Keys to be Presented *
-* NOB Number of Objects to be presented *
-* CFNAM File Name used for presentation *
-* IRC Return code (see below) *
-* *
-* Called by CDVIEW *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
-#include "hepdb/ccdisp.inc"
-#include "hepdb/cxlink.inc"
- DIMENSION IDPFL(100)
- DIMENSION IOTI(NI), IOTO(NO), KEYI(NI), KEYO(NO,NOB)
- DIMENSION ICONI(NI), ICONO(NO)
- CHARACTER PATHI*(*), PATHO*(*), CFNAM*(*)
- CHARACTER CHTI(NI)*8, CHTO(NO)*8, CHEAD*300
-*
-* ------------------------------------------------------------------
-*
-* *** Open file for Presentation
-*
- LUN = LUKYCX
- CALL CDOPFL (LUN, CFNAM, 'UNKNOWN', ISTAT)
- IF (ISTAT.NE.0) GO TO 999
-*
-* *** Header Line
-*
- WRITE (LUN, 1001) PATHO
- IF (IOPHCC.NE.0) THEN
-*
-* ** Check if display is wide enough
-*
- NW = NO - 1
- IF (NW.GT.0) THEN
- DO 1 I = 1, NW
- 1 IDPFL(I) = 1
- CALL CDRGCV (IDPFL, NW, NDISP, IOTO(2))
- IF (NDISP.GT.MXDPCC) THEN
- CALL CDPRNT (LPRTCD, '(/,'' CDPRES : Not enough space to '//
- + 'display.'',/,'' Enlarge display range by CDSETD or '//
- + 'use V-mode.'')', IARGCD, 0)
- WRITE (LUN, 1007)
- GO TO 100
- ENDIF
-*
-* ** Display header
-*
- CHEAD = ' '
- CHEAD(4:9) = 'Serial'
- CALL CDVHEA (IOTO(2), CHTO(2), NW, CHEAD)
- WRITE (LUN, '(A/)') CHEAD(1:MXDPCC)
-*
-* ** Display the Objects if there is any
-*
- WRITE (LUN, 1003)
- IF (NOB.GT.0) THEN
- DO 5 I = 1, NOB
- CALL CDDKYH (LUN, NW, KEYO(2,I), IOTO(2), ICONO(2),
- + KEYO(1,I), IRC)
- 5 CONTINUE
- ENDIF
- ENDIF
- ELSE
- WRITE (LUN, '(/)')
-*
-* ** Display the Objects if there is any
-*
- IF (NOB.GT.0) THEN
- DO 10 I = 1, NOB
- WRITE (LUN, 1005) KEYO(1,I)
- CALL CDDKYV (LUN, NO-1, CHTO(2), KEYO(2,I), IOTO(2),
- + ICONO(2), IRC)
- 10 CONTINUE
- ENDIF
- ENDIF
-*
-* *** Closing Phrase
-*
- WRITE (LUN, 1004) PATHI
- IF (IOPHCC.NE.0) THEN
-*
-* * Check if display is wide enough
-*
- IF (NI.GT.0) THEN
- NW = NI
- DO 11 I = 1, NW
- 11 IDPFL(I) = 1
- CALL CDRGCV (IDPFL, NW, NDISP, IOTI(1))
- IF (NDISP.GT.MXDPCC) THEN
- CALL CDPRNT (LPRTCD, '(/,'' CDPRES : Not enough space to '//
- + 'display.'',/,'' Enlarge display range by CDSETD or '//
- + 'use V-mode.'')', IARGCD, 0)
- WRITE (LUN, 1007)
- GO TO 100
- ENDIF
-*
-* ** Display header
-*
- CHEAD = ' '
- CHEAD(4:9) = 'Serial'
- CALL CDVHEA (IOTI(1), CHTI(1), NW, CHEAD)
- WRITE (LUN, '(A/)') CHEAD(1:MXDPCC)
-*
- WRITE (LUN, 1003)
- CALL CDDKYH (LUN, NW, KEYI(1), IOTI(1), ICONI(1), -1, IRC)
- ENDIF
- ELSE
- WRITE (LUN, '(/)')
- IF (NI.GT.0) THEN
- CALL CDDKYV (LUN, NI, CHTI, KEYI(1), IOTI(1), ICONI(1), IRC)
- ENDIF
- ENDIF
-*
- 100 CALL CDCLFL (LUN)
- CALL KUEDIT (CFNAM, IST)
-*
- 1001 FORMAT (/2X,' Objects in Directory ',A/)
- 1002 FORMAT (/20(3X,A8,3X)/)
- 1003 FORMAT (/)
- 1004 FORMAT (////2X,' Satisfy the Search in Directory ',A//)
- 1005 FORMAT (/2X,' ---- Object-Serial : ',I10,' ----'/)
- 1007 FORMAT (/,' CDPRES : Not enough space to display.' /
- + ' Enlarge display range by CDSETD or use V-mode.')
-* END CDPRES
- 999 END
diff --git a/src/packlib/hepdb/cdxint/cdproc.F b/src/packlib/hepdb/cdxint/cdproc.F
deleted file mode 100644
index 807783e..0000000
--- a/src/packlib/hepdb/cdxint/cdproc.F
+++ /dev/null
@@ -1,55 +0,0 @@
-*
-* $Id: cdproc.F,v 1.1.1.1 1996/02/28 16:24:51 mclareni Exp $
-*
-* $Log: cdproc.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:51 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDPROC (CPRO, CPAR, NCH)
-* ===================================
-*
-************************************************************************
-* *
-* SUBR. CDPROC (CPRO, CPAR*, NCH*) *
-* *
-* Reads a character variable from the screen *
-* *
-* Arguments : *
-* *
-* CPRO Prompt to be printed on the screen *
-* CPAR Character variable as supplied by user *
-* NCH Length of the variable CPAR *
-* *
-* Called by CDAUXI *
-* *
-************************************************************************
-*
- PARAMETER (LUNI=5, LUNO=6)
- CHARACTER CPRO*(*), CPAR*(*), CHVAL*80
-*
-* ------------------------------------------------------------------
-*
-* ** Set default and write the prompt
-*
- CPAR = ' '
- NCH = 0
- WRITE (LUNO, 1001) CPRO
-*
-* ** Now read in the line
-*
- READ (LUNI, 1002, ERR=999, END=999) CHVAL
- CPAR = CHVAL
- NCH = LENOCC (CPAR)
- IF (NCH.GT.0) CALL CLTOU (CPAR(:NCH))
-*
-#if defined(CERNLIB_IBM)
- 1001 FORMAT (' ',A,':')
-#endif
-#if !defined(CERNLIB_IBM)
- 1001 FORMAT (' ',A,': ',$)
-#endif
- 1002 FORMAT (A80)
-* END CDPROC
- 999 END
diff --git a/src/packlib/hepdb/cdxint/cdrdda.F b/src/packlib/hepdb/cdxint/cdrdda.F
deleted file mode 100644
index f9601a7..0000000
--- a/src/packlib/hepdb/cdxint/cdrdda.F
+++ /dev/null
@@ -1,90 +0,0 @@
-*
-* $Id: cdrdda.F,v 1.1.1.1 1996/02/28 16:24:51 mclareni Exp $
-*
-* $Log: cdrdda.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:51 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDRDDA (DATA)
-* ========================
-*
-************************************************************************
-* *
-* SUBR. CDRDDA (DATA*) *
-* *
-* Routine to Decode the Data from the Display file *
-* *
-* Arguments : *
-* *
-* DATA Data Items *
-* *
-* Called by CDUPKY *
-* *
-************************************************************************
-*
-#include "hepdb/cxlink.inc"
- CHARACTER IOC*1, STRFIL*80, CHVAL*80
- DIMENSION DATA (9)
-*
-* ------------------------------------------------------------------
-*
-* ** Decode the Data part of the edited file
-*
- REWIND (LUDACX)
- READ (LUDACX, 1001, ERR=10, END=10)
-*
- I = 1
- 2 CONTINUE
- READ (LUDACX, 1002, ERR=10, END=10) STRFIL
- CHVAL = ' '
- NCH = LENOCC (STRFIL)
- NCH = MIN0 (NCH, 80)
- IF (NCH.EQ.0) GO TO 10
- DO 3 J = 1, NCH
- IF (STRFIL(J:J).NE.' ') THEN
- IOC = STRFIL(J:J)
- JST = J + 6
- GO TO 4
- ENDIF
- 3 CONTINUE
- IOC = ' '
- JST = 7
- 4 LCDAT = 4
- LWRDH = 1
- DO 5 J = JST, NCH
- IF (STRFIL(J:J).NE.' ') THEN
- CHVAL = STRFIL(J:NCH)
- LCDAT = NCH-J+1
- LWRDH = (LCDAT-1)/4 + 1
- GO TO 6
- ENDIF
- 5 CONTINUE
- 6 CONTINUE
- IF (IOC.EQ.'B') THEN
- CALL CDCTOB (CHVAL, DATA(I), IRC)
- I = I + 1
- ELSE IF (IOC.EQ.'I') THEN
- CALL CDCHTI (CHVAL, ISTR, IRC)
- CALL UCOPY (ISTR, DATA(I), 1)
- I = I + 1
- ELSE IF (IOC.EQ.'F') THEN
- CALL CDCTOR (CHVAL, DATA(I), IRC)
- I = I + 1
- ELSE IF (IOC.EQ.'H') THEN
- CALL UCTOH (CHVAL, DATA(I), 4, LCDAT)
- I = I + LWRDH
- ELSE
- DATA(I) = 0.
- I = I + 1
- ENDIF
- GO TO 2
- 10 CONTINUE
-*
- CALL CDCLFL (LUDACX)
-*
- 1001 FORMAT (////)
- 1002 FORMAT (A80)
-* END CDRDDA
- END
diff --git a/src/packlib/hepdb/cdxint/cdrdio.F b/src/packlib/hepdb/cdxint/cdrdio.F
deleted file mode 100644
index faad5e1..0000000
--- a/src/packlib/hepdb/cdxint/cdrdio.F
+++ /dev/null
@@ -1,142 +0,0 @@
-*
-* $Id: cdrdio.F,v 1.1.1.1 1996/02/28 16:24:51 mclareni Exp $
-*
-* $Log: cdrdio.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:51 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDRDIO (PATHN, KEYX, NDAT, CHIDH, LENCH, CHOPT, IRC)
-* ===============================================================
-*
-************************************************************************
-* *
-* SUBR. CDRDIO (PATHN, KEYX, NDAT*, CHIDH*, LENCH*, CHOPT, IRC*)*
-* *
-* Reads the I/O-Descriptor of the Data-Bank from the display-file *
-* *
-* Arguments : *
-* *
-* PATHN Character string describing the pathname *
-* KEYX Key-vector *
-* NDAT Number of Data in the Data-bank associated to the key *
-* CHIDH IO Characteristics of the Data-bank *
-* LENCH Length of CHIDH *
-* CHOPT Character string with any of the following characters *
-* E Display only example (template) *
-* IRC Return code (see below) *
-* *
-* Called by CDUPKY *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
-#include "hepdb/cxlink.inc"
- CHARACTER CFNAM*32, PATHN*(*), STRFIL*40
- CHARACTER IOO*1, ION*1, IOC*2, CHIDH*(*), CHOPT*(*)
- DIMENSION KEYX(100)
-*
-* ------------------------------------------------------------------
-*
- NDAT = 0
- IRC = 0
-*
-* ** Open the file to editing
-*
- CALL KUPROC ('Give Data File-Name (e.g. DFNAME) ',CFNAM, LFNAM)
-#if !defined(CERNLIB_IBMVM)
- CFNAM = CFNAM(1:LFNAM)//'.FILEXT'
-#endif
-#if defined(CERNLIB_UNIX)
- CALL CUTOL (CFNAM)
-#endif
-#if defined(CERNLIB_IBMVM)
- CFNAM = CFNAM(1:LFNAM)//'.FILEXT.A'
-#endif
- CALL CDOPFL (LUDACX, CFNAM, 'UNKNOWN', ISTAT)
- IF (ISTAT.NE.0) GO TO 999
-*
-* ** Prepares the Data file for PATHN and KEYX vector
-*
- CALL CDDISD (LUDACX, PATHN, KEYX, CHOPT, IRC)
- CALL CDCLFL (LUDACX)
- IF (IRC.NE.0) GO TO 999
-*
-* ** Edits the file containing the Data
-*
- CALL KUEDIT (CFNAM, IST)
-*
-* ** Decode the Key part of the edited file
-*
- LENCH = 0
- CALL CDOPFL (LUDACX, CFNAM, 'OLD', ISTAT)
- IF (ISTAT.NE.0) GO TO 999
- READ (LUDACX, 1001, ERR=20, END=20)
-*
-* ** Build-up I/O descriptor
-*
- IT = -1
- IOO = ' '
- 10 CONTINUE
- READ (LUDACX, 1002, ERR=20, END=20) STRFIL
- NCH = LENOCC (STRFIL)
- NCH = MIN0 (NCH, 80)
- ION = ' '
- DO 15 J = 1, NCH
- IF (STRFIL(J:J).NE.' ') THEN
- ION = STRFIL(J:J)
- JST = J + 6
- GO TO 16
- ENDIF
- 15 CONTINUE
- JST = 7
- ION = ' '
- 16 LWRDH = 1
- DO 17 J = JST, NCH
- IF (STRFIL(J:J).NE.' ') THEN
- LCDAT = NCH-J+1
- LWRDH = (LCDAT-1)/4 + 1
- GO TO 18
- ENDIF
- 17 CONTINUE
- 18 CONTINUE
- IF (IOO.NE.ION) THEN
- IF (IT.EQ.-1) THEN
- IT = 0
- IS = 1
- IF (ION.EQ.'H') IS = LWRDH
- ELSE
- WRITE (IOC, 1003) IS
- NDAT = NDAT + IS
- IF (IT.EQ.0) THEN
- CHIDH = IOC//IOO
- ELSE
- CHIDH = CHIDH(1:IT)//IOC//IOO
- ENDIF
- IF (ION.EQ.' ') GO TO 20
- IS = 1
- IF (ION.EQ.'H') IS = LWRDH
- CHIDH(IT+4:IT+4) = ' '
- IT = IT + 4
- ENDIF
- IOO = ION
- ELSE
- INCR = 1
- IF (ION.EQ.'H') INCR = LWRDH
- IS = IS + INCR
- ENDIF
- GO TO 10
- 20 CONTINUE
- LENCH = IT + 3
- IF (NDAT.EQ.0) CALL CDCLFL (LUDACX)
-*
- 1001 FORMAT (////)
- 1002 FORMAT (A40)
- 1003 FORMAT (I2)
-* END CDRDIO
- 999 END
diff --git a/src/packlib/hepdb/cdxint/cdrgck.F b/src/packlib/hepdb/cdxint/cdrgck.F
deleted file mode 100644
index 013d0e4..0000000
--- a/src/packlib/hepdb/cdxint/cdrgck.F
+++ /dev/null
@@ -1,89 +0,0 @@
-*
-* $Id: cdrgck.F,v 1.1.1.1 1996/02/28 16:24:51 mclareni Exp $
-*
-* $Log: cdrgck.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:51 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDRGCK (KDISP, NK, NTOT, IOKEY)
-* ==========================================
-*
-************************************************************************
-* *
-* SUBR. CDRGCK (KDISP, NK, NTOT*, *IOKEY*) *
-* *
-* Checks if the display Range is enough to display data *
-* in Horizontal Mode (except for CDVIEW action) *
-* *
-* Arguments : *
-* *
-* KDISP Key Flag = 0 for No Display, = 1 for Key to be displayed*
-* NK Number of Keys *
-* NTOT Place occupied by displaying the keys *
-* IOKEY Type of the Key *
-* 1 - Binary *
-* 2 Integer *
-* 3 Floating *
-* 4 Double Precision (not yet implemented) *
-* 5 Hollerith *
-* 6 Hollerith concatenetad to previous hollerith *
-* 7 Packed integer - time packed upto seconds *
-* 8 Packed integer - time packed upto minutes *
-* 9 Data which should not be displayed *
-* *
-* Called by CDDISH *
-* *
-************************************************************************
-*
-#include "hepdb/caopts.inc"
-#include "hepdb/cdcblk.inc"
-#include "hepdb/ccdisp.inc"
-#include "hepdb/ckkeys.inc"
- DIMENSION KDISP (NK), IOKEY(NK)
- DATA NUMBI /12/, NUMIN /12/, NUMHO / 6/, NUMTS /15/
-*
-* ------------------------------------------------------------------
-*
- NTOT = 10
-*
-* ** System Keys
-*
- IF (IOPXCA.NE.0) THEN
- INDXT = 7
- ELSE
- INDXT = 2
- ENDIF
- DO 5 I = 1, 2*NPARCD
- IOKEY(NOF1CK+I) = INDXT
- 5 CONTINUE
- IOKEY(IDHINS) = 8
-*
-* ** All Keys
-*
- DO 10 I = 1, NK
- IF (KDISP(I).NE.0) THEN
- IF (IOKEY(I).EQ.7.OR.IOKEY(I).EQ.8) THEN
- NUMCCC(I) = NUMTS
- ELSE IF (IOKEY(I).EQ.1) THEN
- NUMCCC(I) = NUMBI
- ELSE IF (IOKEY(I).EQ.6) THEN
- IOKEY(I) = 9
- NUMCCC(I) = 0
- ELSE IF (IOKEY(I).EQ.5) THEN
- NUMCCC(I) = NUMHO + 4*ICONCK(I)
- NUMCCC(I) = MAX0 (10, NUMCCC(I))
- ELSE IF (IOKEY(I).EQ.9) THEN
- NUMCCC(I) = 0
- ELSE
- NUMCCC(I) = NUMIN
- ENDIF
- NTOT = NTOT + NUMCCC(I)
- ELSE
- IOKEY(I) = 9
- NUMCCC(I) = 0
- ENDIF
- 10 CONTINUE
-* END CDRGCK
- END
diff --git a/src/packlib/hepdb/cdxint/cdrgcv.F b/src/packlib/hepdb/cdxint/cdrgcv.F
deleted file mode 100644
index 3cf4245..0000000
--- a/src/packlib/hepdb/cdxint/cdrgcv.F
+++ /dev/null
@@ -1,74 +0,0 @@
-*
-* $Id: cdrgcv.F,v 1.1.1.1 1996/02/28 16:24:51 mclareni Exp $
-*
-* $Log: cdrgcv.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:51 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDRGCV (KDISP, NK, NTOT, IOKEY)
-* ==========================================
-*
-************************************************************************
-* *
-* SUBR. CDRGCV (KDISP, NK, NTOT*, *IOKEY*) *
-* *
-* Checks if the display Range is enough to display data *
-* in Horizontal Mode (for CDVIEW action) *
-* *
-* Arguments : *
-* *
-* KDISP Key Flag = 0 for No Display, = 1 for Key to be displayed*
-* NK Number of Keys *
-* NTOT Place occupied by displaying the keys *
-* IOKEY Type of the Key *
-* 1 - Binary *
-* 2 Integer *
-* 3 Floating *
-* 4 Double Precision (not yet implemented) *
-* 5 Hollerith *
-* 6 Hollerith concatenetad to previous hollerith *
-* 7 Packed integer - time packed upto seconds *
-* 8 Packed integer - time packed upto minutes *
-* 9 Data which should not be displayed *
-* *
-* Called by CDPRES *
-* *
-************************************************************************
-*
-#include "hepdb/ccdisp.inc"
-#include "hepdb/ckkeys.inc"
- DIMENSION KDISP (NK), NUMBS(7), IOKEY(NK)
- DATA NUMBS /12, 12, 15, 15, 12, 12, 15/
- DATA NUMBI, NUMIN, NUMHO /12, 12, 6/
-*
-* ------------------------------------------------------------------
-*
- NTOT = 10
-*
-* ** Input Keys (cannot be system keys)
-*
- DO 10 I = 1,NK
- IF (KDISP(I).NE.0) THEN
- IF (IOKEY(I).EQ.6) THEN
- IOKEY(I) = 9
- NUMCCC(I) = 0
- ELSE IF (IOKEY(I).EQ.1) THEN
- NUMCCC(I) = NUMBI
- NTOT = NTOT + NUMBI
- ELSE IF (IOKEY(I).EQ.2) THEN
- NUMCCC(I) = NUMIN
- NTOT = NTOT + NUMIN
- ELSE IF (IOKEY(I).EQ.5) THEN
- NUMCCC(I) = NUMHO + 4*ICONCK(I)
- NUMCCC(I) = MAX0 (10, NUMCCC(I))
- NTOT = NTOT + NUMCCC(I)
- ENDIF
- ELSE
- IOKEY(I) = 9
- NUMCCC(I) = 0
- ENDIF
- 10 CONTINUE
-* END CDRGCV
- END
diff --git a/src/packlib/hepdb/cdxint/cdrvnt.F b/src/packlib/hepdb/cdxint/cdrvnt.F
deleted file mode 100644
index d548f63..0000000
--- a/src/packlib/hepdb/cdxint/cdrvnt.F
+++ /dev/null
@@ -1,291 +0,0 @@
-*
-* $Id: cdrvnt.F,v 1.1.1.1 1996/02/28 16:24:52 mclareni Exp $
-*
-* $Log: cdrvnt.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:52 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDRVNT (NPATH, PATHS, NMASK,MASK,KEYS, NVAR, NKST,NDST,
- + NKEYX, KEYXS, NOBJS, KOBJS, CTAG, NOBJM, IRC)
-* ==================================================================
-*
-************************************************************************
-* *
-* SUBR. CDRVNT (NPATH, PATHS*, NMASK, MASK*, KEYS*, NVAR*, *
-* NKST*, NDST*, NKEYX*, KEYXS*, NOBJS*, KOBJS*, *
-* CTAG*, NOBJM, IRC*) *
-* *
-* Reads variables for CDAUXI from command line or external file *
-* *
-* Argements : *
-* *
-* NPATH Number of pathnames for the directories *
-* PATHS Names of the directory paths *
-* NMASK Number of key elements to be selected upon *
-* MASK Integer vector indicating which elements of KEYS are *
-* significant for selection *
-* KEYS Vector of keys for character option *
-* NVAR Total number of variables *
-* NKST Number of key elements selected *
-* NDST Number of data elements selected *
-* NKEYX Number of key elements for each paths *
-* KEYXS Key element indices *
-* NOBJS Number of data elements for each paths *
-* KOBJS Data element indices *
-* CTAG Tag for each of the elements *
-* NOBJM Maximum number of variables *
-* IRC Return code (see below) *
-* *
-* Called by CDAUXI *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* =167 : Error in reading from the file *
-* *
-************************************************************************
-*
-#include "hepdb/caopts.inc"
-#include "hepdb/cdcblk.inc"
-#include "hepdb/ckkeys.inc"
-#include "hepdb/ctpath.inc"
-#include "hepdb/cxlink.inc"
- DIMENSION KEYS(9), NKEYX(9), KEYXS(9), KOBJS(9), NOBJS(9)
- DIMENSION MASK(9)
- CHARACTER CFNAM*80, CHPRO*32, PATHN*80, CTEMP*5
- CHARACTER*(*) PATHS(*), CTAG(*)
-*
-* ------------------------------------------------------------------
-*
- CALL KUGETI (LUNI)
- CALL KUGETC (CFNAM, NCF)
- NVAR = 0
- NKST = 0
- NDST = 0
-*
- IF (LUNI.GT.0.AND.CFNAM.NE.' ') THEN
-*
-* *** Read the information from an external file
-*
-#if defined(CERNLIB_UNIX)
- CALL CUTOL (CFNAM)
-#endif
- CALL CDOPFL (LUNI, CFNAM, 'OLD', ISTAT)
- IF (ISTAT.NE.0) THEN
- CALL CDPRNT (L3PRCX, '(/,'' CDRVNT : Error '',I12,'' in ope'//
- + 'ning file '//CFNAM(1:NCF)//''')', ISTAT, 1)
- IRC = 167
- GO TO 999
- ENDIF
-*
-* ** Read in the path names first
-*
- DO 5 I = 1, NPATH
- READ (LUNI, *, ERR=30, END=30) PATHS(I)
- PATHN = PATHS(I)
- CALL CDLDUP (PATHN, 0, IRC)
- IF (IRC.NE.0) THEN
- NCH = LENOCC (PATHN)
- CALL CDPRNT (L3PRCX, '('' DB-path '//PATHN(1:NCH)//' is '//
- + 'illegal'')', IARGCD, 0)
- GO TO 30
- ENDIF
- PATHS(I) = PAT1CT
- IF (I.EQ.1) NWKY1 = NWKYCK
- 5 CONTINUE
-*
-* ** Now read the key values
-*
- DO 10 II = 1, NMASK
- READ (LUNI, *, ERR=30, END=30) I
- IF (I.LT.1.OR.I.GT.NWKY1) GO TO 30
- MASK(I) = 1
- IF (I.EQ.IDHINS.OR.(I.GT.NOF1CK.AND.I.LE.NOF1CK+2*NPARCD.AND.
- + IOPXCA.NE.0)) THEN
- READ (LUNI, *, ERR=30, END=30) IDATE, ITIME
- IF (I.EQ.IDHINS) THEN
- CALL CDPKTM (IDATE, ITIME, KEYS(I), IRC)
- ELSE
- CALL CDPKTS (IDATE, ITIME, KEYS(I), IRC)
- ENDIF
- ELSE
- READ (LUNI, *, ERR=30, END=30) KEYS(I)
- ENDIF
- 10 CONTINUE
-*
-* ** Now read the items to be stored
-*
- DO 25 I = 1, NPATH
- PATHN = PATHS(I)
- CALL RZCDIR (PATHN, ' ')
- NKEYCK = IQUEST(7)
- NWKYCK = IQUEST(8)
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- CALL CDKYTG
- READ (LUNI, *, ERR=30, END=30) NKEYX(I)
- IF (NKEYX(I).LT.1) THEN
- NKEYX(I) = 0
- ELSE IF (NKEYX(I).GT.NWKYCK) THEN
- NKEYX(I) = NWKYCK
- ENDIF
- IF (NVAR+NKEYX(I).GT.NOBJM) THEN
- CALL CDPRNT (L3PRCX, '('' Too many variables for N-tuple'')'
- +, IARGCD, 0)
- IRC = 167
- GO TO 30
- ENDIF
- DO 15 J = 1, NKEYX(I)
- READ (LUNI, *, ERR=30, END=30) KEYXS(NKST+J)
- IF (KEYXS(NKST+J).LT.1.OR.KEYXS(NKST+J).GT.NWKYCK) THEN
- CALL CDPRNT (L3PRCX, '('' Invalid Key index'',I12)',
- + KEYXS(NKST+J), 1)
- IRC = 167
- GO TO 30
- ENDIF
- CTAG(NVAR+J) = CTAGCK(KEYXS(NKST+J))
- 15 CONTINUE
- NVAR = NVAR + NKEYX(I)
- NKST = NKST + NKEYX(I)
- READ (LUNI, *, ERR=30, END=30) NOBJS(I)
- IF (NOBJS(I).LT.1) NOBJS(I) = 0
- IF (NVAR+NOBJS(I).GT.NOBJM) THEN
- CALL CDPRNT (L3PRCX, '('' Too many variables for N-tuple'')'
- +, IARGCD, 0)
- IRC = 167
- GO TO 30
- ENDIF
- DO 20 J = 1, NOBJS(I)
- READ (LUNI, *, ERR=30, END=30) KOBJS(NDST+J), CTAG(NVAR+J)
- IF (KOBJS(NDST+J).LT.1) KOBJS(NDST+J) = 1
- 20 CONTINUE
- NVAR = NVAR + NOBJS(I)
- NDST = NDST + NOBJS(I)
- 25 CONTINUE
- IRC = 0
- GO TO 35
-*
- 30 CALL CDPRNT (L3PRCX, '(/,'' CDRVNT : Error in reading file '//
- + CFNAM(1:NCF)//''')', ISTAT, 0)
- IRC = 167
- 35 CALL CDCLFL (LUNI)
-*
- ELSE
-*
-* *** Read the information from the command line
-*
- DO 40 I = 1, NPATH
- WRITE (CHPRO, 1001) I
- CALL KUPROC (CHPRO, PATHN, NCH)
- CALL CDLDUP (PATHN, 0, IRC)
- IF (IRC.NE.0) THEN
- NCH = LENOCC (PATHN)
- CALL CDPRNT (L3PRCX, '('' DB-path '//PATHN(1:NCH)//' is '//
- + 'illegal'')', IARGCD, 0)
- GO TO 999
- ENDIF
- PATHS(I) = PAT1CT
- IF (I.EQ.1) NWKY1 = NWKYCK
- 40 CONTINUE
-*
-* ** Now read the key values
-*
- DO 50 II = 1, NMASK
- 45 CHPRO = 'Next key index to be selected upon'
- CALL KUPROI (CHPRO, I)
- IF (I.LT.1.OR.I.GT.NWKY1) THEN
- CALL CDPRNT (L3PRCX, '(/,'' CDRVNT : Incorrect key index '//
- + 'given '',I3,'' try once more'')', I, 1)
- GO TO 45
- ENDIF
- MASK(I) = 1
- IF (I.GT.NOF1CK.AND.I.LE.NOF1CK+2*NPARCD.AND.IOPXCA.NE.0) THEN
- IF (I.LE.NOF1CK+NPARCD) THEN
- CTEMP = 'Begin'
- ELSE
- CTEMP = 'End'
- ENDIF
- WRITE (CHPRO, 1002) 'YYMMDD', CTEMP
- CALL KUPROI (CHPRO, IDATE)
- WRITE (CHPRO, 1002) 'HHMMSS', CTEMP
- CALL KUPROI (CHPRO, ITIME)
- CALL CDPKTS (IDATE, ITIME, KEYS(I), IRC)
- ELSE IF (I.EQ.IDHINS) THEN
- WRITE (CHPRO, 1003) 'YYMMDD'
- CALL KUPROI (CHPRO, IDATE)
- WRITE (CHPRO, 1003) 'HHMM'
- CALL KUPROI (CHPRO, ITIME)
- CALL CDPKTM (IDATE, ITIME, KEYS(I), IRC)
- ELSE
- WRITE (CHPRO, 1004) I
- CALL KUPROI (CHPRO, KEYS(I))
- ENDIF
- 50 CONTINUE
-*
-* ** Now read the items to be stored
-*
- DO 70 I = 1, NPATH
- PATHN = PATHS(I)
- CALL RZCDIR (PATHN, ' ')
- NKEYCK = IQUEST(7)
- NWKYCK = IQUEST(8)
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- CALL CDKYTG
- WRITE (CHPRO, 1005) I
- CALL KUPROI (CHPRO, NKEYX(I))
- IF (NKEYX(I).LT.1) THEN
- NKEYX(I) = 0
- ELSE IF (NKEYX(I).GT.NWKYCK) THEN
- NKEYX(I) = NWKYCK
- ENDIF
- IF (NVAR+NKEYX(I).GT.NOBJM) THEN
- CALL CDPRNT (L3PRCX, '('' Too many variables for N-tuple'')'
- +, IARGCD, 0)
- IRC = 167
- GO TO 999
- ENDIF
- DO 60 J = 1, NKEYX(I)
- WRITE (CHPRO, 1006) J, I
- 55 CALL KUPROI (CHPRO, KEYXS(NKST+J))
- IF (KEYXS(NKST+J).LT.1.OR.KEYXS(NKST+J).GT.NWKYCK) GO TO 55
- CTAG(NVAR+J) = CTAGCK(KEYXS(NKST+J))
- 60 CONTINUE
- NVAR = NVAR + NKEYX(I)
- NKST = NKST + NKEYX(I)
- WRITE (CHPRO, 1007) I
- CALL KUPROI (CHPRO, NOBJS(I))
- IF (NOBJS(I).LT.1) NOBJS(I) = 0
- IF (NVAR+NOBJS(I).GT.NOBJM) THEN
- CALL CDPRNT (L3PRCX, '('' Too many variables for N-tuple'')'
- +, IARGCD, 0)
- IRC = 167
- GO TO 999
- ENDIF
- DO 65 J = 1, NOBJS(I)
- WRITE (CHPRO, 1008) J, I
- CALL KUPROI (CHPRO, KOBJS(NDST+J))
- IF (KOBJS(NDST+J).LT.1) KOBJS(NDST+J) = 1
- WRITE (CHPRO, 1009) KOBJS(NDST+J)
- CALL CDPROC (CHPRO, CTAG(NVAR+J), NCH)
- 65 CONTINUE
- NVAR = NVAR + NOBJS(I)
- NDST = NDST + NOBJS(I)
- 70 CONTINUE
- IRC = 0
-*
- ENDIF
-*
- 1001 FORMAT (I2,'th Path name')
- 1002 FORMAT (A,' of ',A,' Range')
- 1003 FORMAT (A,' of cut in insertion time')
- 1004 FORMAT ('Key(',I2,') ?')
- 1005 FORMAT ('No. of keys to store for path ',I2)
- 1006 FORMAT (I2,'th Key element for path ',I2)
- 1007 FORMAT ('No. of data to store for path ',I2)
- 1008 FORMAT (I2,'th data element for path ',I2)
- 1009 FORMAT ('Tag for',I3,'th data element')
-* END CDRVNT
- 999 END
diff --git a/src/packlib/hepdb/cdxint/cdrvpl.F b/src/packlib/hepdb/cdxint/cdrvpl.F
deleted file mode 100644
index 2d6d4b8..0000000
--- a/src/packlib/hepdb/cdxint/cdrvpl.F
+++ /dev/null
@@ -1,165 +0,0 @@
-*
-* $Id: cdrvpl.F,v 1.1.1.1 1996/02/28 16:24:52 mclareni Exp $
-*
-* $Log: cdrvpl.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:52 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDRVPL (INDX, NOBJ, NMASK, KOBJ1,KOBJ2, MASK,KEYS, IRC)
-* ==================================================================
-*
-************************************************************************
-* *
-* SUBR. CDRVPL (INDX,NOBJ,NMASK,KOBJ1*,KOBJ2*,MASK*,KEYS*,IRC*) *
-* *
-* Reads variables for CDACPL from command line or external file *
-* *
-* Argements : *
-* *
-* INDX Type of input (1 for CDPLOB; 2 for CDPLOV; 0 otherwise) *
-* NOBJ Number of objects *
-* NMASK Number of key elements to be selected upon *
-* KOBJ1 Array for object indices for CDPLOB *
-* KOBJ2 Array for pair of object indices for CDPLOV *
-* MASK Integer vector indicating which elements of KEYS are *
-* significant for selection *
-* KEYS Key indices *
-* IRC Return code (see below) *
-* *
-* Called by CDACPL *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* =167 : Error in reading from the file *
-* *
-************************************************************************
-*
-#include "hepdb/caopts.inc"
-#include "hepdb/cdcblk.inc"
-#include "hepdb/ckkeys.inc"
-#include "hepdb/cxlink.inc"
- DIMENSION KEYS(9), MASK(9), KOBJ2(2,9), KOBJ1(9)
- CHARACTER CFNAM*80, CHPRO*32, CTEMP*5
-*
-* ------------------------------------------------------------------
-*
- CALL KUGETI (LUNI)
- CALL KUGETC (CFNAM, NCF)
-*
- IF (LUNI.GT.0.AND.CFNAM.NE.' ') THEN
-*
-* *** Read the information from an external file
-*
-#if defined(CERNLIB_UNIX)
- CALL CUTOL (CFNAM)
-#endif
- CALL CDOPFL (LUNI, CFNAM, 'OLD', ISTAT)
- IF (ISTAT.NE.0) THEN
- CALL CDPRNT (L3PRCX, '(/,'' CDRVPL : Error '',I12,'' in ope'//
- + 'ning file '//CFNAM(1:NCF)//''')', ISTAT, 1)
- IRC = 167
- GO TO 999
- ENDIF
-*
-* ** Read the object indices first
-*
- IF (INDX.EQ.1) THEN
- DO 10 I = 1, NOBJ
- READ (LUNI, *, ERR=25, END=25) KOBJ1(I)
- 10 CONTINUE
- ELSE IF (INDX.EQ.2) THEN
- DO 15 I = 1, NOBJ
- READ (LUNI, *, ERR=25, END=25) KOBJ2(1,I), KOBJ2(2,I)
- 15 CONTINUE
- ENDIF
-*
-* ** Now read the key values
-*
- DO 20 II = 1, NMASK
- READ (LUNI, *, ERR=25, END=25) I
- IF (I.LT.1.OR.I.GT.NWKYCK) GO TO 25
- MASK(I) = 1
- IF (I.EQ.IDHINS.OR.(I.GT.NOF1CK.AND.I.LE.NOF1CK+2*NPARCD.AND.
- + IOPXCA.NE.0)) THEN
- READ (LUNI, *, ERR=25, END=25) IDATE, ITIME
- IF (I.EQ.IDHINS) THEN
- CALL CDPKTM (IDATE, ITIME, KEYS(I), IRC)
- ELSE
- CALL CDPKTS (IDATE, ITIME, KEYS(I), IRC)
- ENDIF
- ELSE
- READ (LUNI, *, ERR=25, END=25) KEYS(I)
- ENDIF
- 20 CONTINUE
- IRC = 0
- GO TO 30
-*
- 25 CALL CDPRNT (L3PRCX, '(/,'' CDRVPL : Error in reading file '//
- + CFNAM(1:NCF)//''')', ISTAT, 0)
- IRC = 167
- 30 CALL CDCLFL (LUNI)
-*
- ELSE
-*
-* *** Read the information from the command line
-*
- IF (INDX.EQ.1) THEN
- DO 35 I = 1, NOBJ
- WRITE (CHPRO, 1001) I
- CALL KUPROI (CHPRO, KOBJ1(I))
- 35 CONTINUE
- ELSE IF (INDX.EQ.2) THEN
- DO 40 I = 1, NOBJ
- WRITE (CHPRO, 1002) 'First ',I
- CALL KUPROI (CHPRO, KOBJ2(1,I))
- WRITE (CHPRO, 1002) 'Second',I
- CALL KUPROI (CHPRO, KOBJ2(2,I))
- 40 CONTINUE
- ENDIF
-*
-* ** Now read the key values
-*
- DO 50 II = 1, NMASK
- 45 CHPRO = 'Next key index to be selected upon'
- CALL KUPROI (CHPRO, I)
- IF (I.LT.1.OR.I.GT.NWKYCK) THEN
- CALL CDPRNT (L3PRCX, '(/,'' CDRVPL : Incorrect key index '//
- + 'given '',I3,'' try once more'')', I, 1)
- GO TO 45
- ENDIF
- MASK(I) = 1
- IF (I.GT.NOF1CK.AND.I.LE.NOF1CK+2*NPARCD.AND.IOPXCA.NE.0) THEN
- IF (I.LE.NOF1CK+NPARCD) THEN
- CTEMP = 'Begin'
- ELSE
- CTEMP = 'End'
- ENDIF
- WRITE (CHPRO, 1003) 'YYMMDD', CTEMP
- CALL KUPROI (CHPRO, IDATE)
- WRITE (CHPRO, 1003) 'HHMMSS', CTEMP
- CALL KUPROI (CHPRO, ITIME)
- CALL CDPKTS (IDATE, ITIME, KEYS(I), IRC)
- ELSE IF (I.EQ.IDHINS) THEN
- WRITE (CHPRO, 1004) 'YYMMDD'
- CALL KUPROI (CHPRO, IDATE)
- WRITE (CHPRO, 1004) 'HHMM'
- CALL KUPROI (CHPRO, ITIME)
- CALL CDPKTM (IDATE, ITIME, KEYS(I), IRC)
- ELSE
- WRITE (CHPRO, 1005) I
- CALL KUPROI (CHPRO, KEYS(I))
- ENDIF
- 50 CONTINUE
- IRC = 0
- ENDIF
-*
- 1001 FORMAT ('Index for Object',I2,' ?')
- 1002 FORMAT (A,' index for Object',I2,' ?')
- 1003 FORMAT (A,' of ',A,' Range')
- 1004 FORMAT (A,' of cut in insertion time')
- 1005 FORMAT ('Key(',I2,') ?')
-* END CDRVPL
- 999 END
diff --git a/src/packlib/hepdb/cdxint/cdsget.F b/src/packlib/hepdb/cdxint/cdsget.F
deleted file mode 100644
index c0493c8..0000000
--- a/src/packlib/hepdb/cdxint/cdsget.F
+++ /dev/null
@@ -1,126 +0,0 @@
-*
-* $Id: cdsget.F,v 1.1.1.1 1996/02/28 16:24:52 mclareni Exp $
-*
-* $Log: cdsget.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:52 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDSGET (KYSER, IUDIV, LADD, IRC)
-* ===========================================
-*
-************************************************************************
-* *
-* SUBR. CDSGET (KYSER, IUDIV, LADD*, IRC*) *
-* *
-* Retrievs one data object from the serial number *
-* (Assumes the current directory is set and on successful return *
-* KEYVCK contains the key vector) *
-* *
-* Arguments : *
-* *
-* KYSER Serial number of the object to be retrieved *
-* IUDIV Division where the object would reside in memory *
-* LADD Address of the object *
-* IRC Return code (see below) *
-* *
-* Called by CDAIRD, CDDISD *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* =101 : Illegal path name of partition *
-* *
-************************************************************************
-*
-#include "hepdb/caopts.inc"
-#include "hepdb/cdcblk.inc"
-#include "hepdb/ckkeys.inc"
-#include "hepdb/ctpath.inc"
- PARAMETER (JBIAS=2)
- DIMENSION LADD(9), ITIME(MXPACD)
- CHARACTER PATHY*80
-#include "zebra/q_jbit.inc"
-* Ignoring t=pass
-*
-* ------------------------------------------------------------------
-*
-* *** Iniatilize
-*
- IF (LADD(1).NE.0) THEN
- CALL MZDROP (IDIVCD, LADD(1), 'L')
- LADD(1) = 0
- ENDIF
- IRC = 0
- IF (NKEYCK.EQ.0) GO TO 999
- CALL RZCDIR (PATHY, 'R')
- IOPTP = JBIT (IQ(KOFSCD+LCDRCD+IKDRCD+IDHFLG), JPRTCD)
- ISTP = NWKYCK + 1
-*
-* *** Read in the data
-*
- DO 5 I = 1, NPARCD
- ITIME(I) = 1
- 5 CONTINUE
- IF (IOPTP.EQ.0) THEN
- IPNT = KOFSCD + LCDRCD + IKDRCD
- KPNT = IUHUNT (KYSER, IQ(IPNT+IDHKSN), ISTP*NKEYCK, ISTP)
- IF (KPNT.GT.0) THEN
- KEYVCK(IDHKSN) = (KPNT - IDHKSN) / ISTP + 1
- ELSE
- KEYVCK(IDHKSN) = NKEYCK
- ENDIF
- ELSE
- NKEYS = NKEYCK
- IPNT = KOFSCD + LCDRCD + IKDRCD
- NCHR = LENOCC (PATHY)
- DO 10 JK = 1, NKEYS
- IK = NKEYS + 1 - JK
- KPNT = IUHUNT (IK, IQ(IPNT+MPSRCD), NKEYS*ISTP, ISTP)
- IF (KPNT.GT.0) THEN
- KPNT = IPNT + KPNT - MPSRCD
- ELSE
- KPNT = IPNT + (IK - 1) * ISTP
- ENDIF
- IF (IQ(KPNT+MOBJCD).GT.KYSER) GO TO 10
- CALL CDPATH (TOP2CT, IK)
- PAT2CT = PATHY(1:NCHR)//'/'//TOP2CT
- CALL RZCDIR (PAT2CT, ' ')
- IF (IQUEST(1).NE.0) THEN
- IRC = 101
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDSGET : '//
- + 'Illegal Path Name '//PAT2CT//''')', IARGCD, 0)
-#endif
- GO TO 999
- ENDIF
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- NKEYCK = IQUEST(7)
- IPNT = KOFSCD + LCDRCD + IKDRCD
- KPNT = IUHUNT (KYSER, IQ(IPNT+IDHKSN), ISTP*NKEYCK, ISTP)
- IF (KPNT.GT.0) THEN
- KEYVCK(IDHKSN) = (KPNT - IDHKSN) / ISTP + 1
- ELSE
- KEYVCK(IDHKSN) = NKEYCK
- ENDIF
- GO TO 15
- 10 CONTINUE
- ENDIF
- 15 IOLD1 = IOKYCA(IDHKSN)
- IOLDK = IOPKCA
- IOKYCA(IDHKSN) = 1
- IOPKCA = 0
- CALL CDKXIN (ITIME, IUDIV, LADD(1), LADD(1), JBIAS, NWKYCK,
- + KEYVCK, IPREC, IRC)
- IOKYCA(IDHKSN) = IOLD1
- IOPKCA = IOLDK
- IF (IOPTP.NE.0) THEN
- CALL RZCDIR (PATHY, ' ')
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- NKEYCK = IQUEST(7)
- ENDIF
-* END CDSGET
- 999 END
diff --git a/src/packlib/hepdb/cdxint/cdtemp.F b/src/packlib/hepdb/cdxint/cdtemp.F
deleted file mode 100644
index 4180de8..0000000
--- a/src/packlib/hepdb/cdxint/cdtemp.F
+++ /dev/null
@@ -1,57 +0,0 @@
-*
-* $Id: cdtemp.F,v 1.1.1.1 1996/02/28 16:24:52 mclareni Exp $
-*
-* $Log: cdtemp.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:52 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDTEMP (IOKEY, NK, CHEAD)
-* ====================================
-*
-************************************************************************
-* *
-* SUBR. CDTEMP (IOKEY, NK, *CHEAD) *
-* *
-* Writes a Template of the Display in Horizontal Mode into *
-* the Character Variable CHEAD *
-* *
-* Arguments : *
-* *
-* IOKEY Type of the Key *
-* 1 - Binary *
-* 2 Integer *
-* 3 Floating *
-* 4 Double Precision (not yet implemented) *
-* 5 Hollerith *
-* 6 Hollerith concatenetad to previous hollerith *
-* 7 Packed integer - time packed upto seconds *
-* 8 Packed integer - time packed upto minutes *
-* 9 Data which should not be displayed *
-* NK Number of Keys *
-* CHEAD Character variable containing the header *
-* *
-* Called by CDDISH *
-* *
-************************************************************************
-*
-#include "hepdb/ccdisp.inc"
-#include "hepdb/ckkeys.inc"
- DIMENSION IOKEY(9)
- CHARACTER CHEAD*(*)
-*
-* ------------------------------------------------------------------
-*
- IPOS = 11
- DO 5 I = 1,NK
- IF (IOKEY(I).NE.9) THEN
- IW1 = IPOS
- IW2 = IPOS + NUMCCC(I) - 1
- CHEAD(IW1:IW1) = '|'
- CHEAD(IW2:IW2) = '|'
- IPOS = IPOS + NUMCCC(I)
- ENDIF
- 5 CONTINUE
-* END CDTEMP
- END
diff --git a/src/packlib/hepdb/cdxint/cdupky.F b/src/packlib/hepdb/cdxint/cdupky.F
deleted file mode 100644
index 020d482..0000000
--- a/src/packlib/hepdb/cdxint/cdupky.F
+++ /dev/null
@@ -1,105 +0,0 @@
-*
-* $Id: cdupky.F,v 1.1.1.1 1996/02/28 16:24:52 mclareni Exp $
-*
-* $Log: cdupky.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:52 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDUPKY (KEYX, KEYO, PATHN, CHOPT, IRC)
-* =================================================
-*
-************************************************************************
-* *
-* SUBR. CDUPKY (KEYX, KEYO, PATHN, CHOPT, IRC*) *
-* *
-* Insert/Update Keys in CWD *
-* *
-* Arguments : *
-* *
-* KEYX Key-Vector containing the new Key values *
-* KEYO Key-Vector containing the new Key values *
-* PATHN Pathname of the directory *
-* CHOPT Character options *
-* A Insert objects from Ascii file *
-* E Object is new - Data-template shown *
-* I Insert new Key *
-* W Insert objects from Ascii file without data *
-* X Replace (update) old key *
-* *
-* Called by CDEDAS, CDEDKY *
-* *
-************************************************************************
-*
-#include "hepdb/caopts.inc"
-#include "hepdb/cdcblk.inc"
-#include "hepdb/ccdisp.inc"
-#include "hepdb/ckkeys.inc"
-#include "hepdb/clinks.inc"
-#include "hepdb/cxlink.inc"
- DIMENSION IOPTS(5), KEYX(9), KEYO(9), IOWDS(16)
- CHARACTER YESNO*1, CHIDH*120
- CHARACTER PATHN*(*), CHOPT*(*), CHOP*1
- EQUIVALENCE (IOPTA, IOPTS(1)), (IOPTE, IOPTS(2)),
- + (IOPTI, IOPTS(3)), (IOPTW, IOPTS(4)),
- + (IOPTX, IOPTS(5))
-*
-* ------------------------------------------------------------------
-*
-* *** Decode the character option
-*
- CALL UOPTC (CHOPT, 'AEIWX', IOPTS)
- IF (IOPTA.NE.0.AND.IOPTW.NE.0) THEN
- NDAT = 0
- CALL CDBANK (IDIVCD, LASTCX, LASTCX, 2, 'USER', 0, 0, NDAT,
- + 2, 0,IRC)
- IF (IRC.NE.0) GO TO 999
- GO TO 10
- ENDIF
-*
-* ** Insert Data ?
-*
- CALL KUPROC ('Data Insert/Update ? (Y/N)', YESNO, LYN)
- IF (YESNO.EQ.'Y') THEN
- IF (IOPTE.NE.0) THEN
- CHOP = 'E'
- ELSE
- IF (IOPHCC.EQ.0) THEN
- CHOP = 'V'
- ELSE
- CHOP = 'H'
- ENDIF
- ENDIF
- CALL CDRDIO (PATHN, KEYX, NDAT, CHIDH, LCHID, CHOP, IRC)
- IF (IRC.NE.0) GO TO 999
- IF (NDAT.GT.0) THEN
- CALL MZIOCH (IOWDS, 16, CHIDH(1:LCHID))
- CALL CDBANK (IDIVCD, LASTCX, LASTCX, 2, 'USER', 0, 0, NDAT,
- + IOWDS, 0, IRC)
- IF (IRC.NE.0) GO TO 999
- CALL CDRDDA (Q(KOFUCD+LASTCX+1))
- ELSE
- NDAT = 0
- CALL CDBANK (IDIVCD, LASTCX, LASTCX, 2, 'USER', 0, 0, NDAT,
- + 2, 0, IRC)
- IF (IRC.NE.0) GO TO 999
- ENDIF
- ELSE
- NDAT = 0
- CALL CDBANK (IDIVCD, LASTCX, LASTCX, 2, 'USER', 0, 0, NDAT,
- + 2, 0, IRC)
- IF (IRC.NE.0) GO TO 999
- ENDIF
-*
- 10 CONTINUE
- IF (IOPTX.NE.0) THEN
- CALL CDSTOM (PATHN, LASTCX, LKVWCX(1), IDIVCD, NWKYCK, 1,
- + KEYO, KEYX, 0, 'PDR', IRC)
- ELSE IF (IOPTI.NE.0) THEN
- CALL CDSTOM (PATHN, LASTCX, LKVWCX(1), IDIVCD, NWKYCK, 1,
- + KEYO, KEYX, 0, 'PD', IRC)
- ENDIF
- CALL MZDROP (IDIVCD, LASTCX, ' ')
-* END CDUPKY
- 999 END
diff --git a/src/packlib/hepdb/cdxint/cdvhea.F b/src/packlib/hepdb/cdxint/cdvhea.F
deleted file mode 100644
index 88872f2..0000000
--- a/src/packlib/hepdb/cdxint/cdvhea.F
+++ /dev/null
@@ -1,56 +0,0 @@
-*
-* $Id: cdvhea.F,v 1.1.1.1 1996/02/28 16:24:52 mclareni Exp $
-*
-* $Log: cdvhea.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:52 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDVHEA (IOKEY, CHTG, NK, CHEAD)
-* ==========================================
-*
-************************************************************************
-* *
-* SUBR. CDVHEA (IOKEY, CHTG, NK, *CHEAD) *
-* *
-* Writes the Header of the Display in Horizontal Mode into the *
-* Character Variable CHEAD *
-* *
-* Arguments : *
-* *
-* IOKEY Type of the Key *
-* 1 - Binary *
-* 2 Integer *
-* 3 Floating *
-* 4 Double Precision (not yet implemented) *
-* 5 Hollerith *
-* 6 Hollerith concatenetad to previous hollerith *
-* 7 Packed integer - time packed upto seconds *
-* 8 Packed integer - time packed upto minutes *
-* 9 Data which should not be displayed *
-* CHTG Vector containing the names of the keys *
-* NK Number of Keys *
-* CHEAD Character variable containing the header *
-* *
-* Called by CDPRES *
-* *
-************************************************************************
-*
-#include "hepdb/ccdisp.inc"
- DIMENSION IOKEY(NK)
- CHARACTER CHEAD*(*), CHTG(*)*8
-*
-* ------------------------------------------------------------------
-*
- IPOS = 11
- DO 5 I = 1,NK
- IF (IOKEY(I).NE.9) THEN
- NSP = MAX0 ((NUMCCC(I)-8)/2,1)
- IW = IPOS + NSP
- CHEAD(IW:IW+7) = CHTG(I)
- IPOS = IPOS + NUMCCC(I)
- ENDIF
- 5 CONTINUE
-* END CDVHEA
- END
diff --git a/src/packlib/hepdb/cdxint/cdview.F b/src/packlib/hepdb/cdxint/cdview.F
deleted file mode 100644
index cd7063f..0000000
--- a/src/packlib/hepdb/cdxint/cdview.F
+++ /dev/null
@@ -1,122 +0,0 @@
-*
-* $Id: cdview.F,v 1.1.1.1 1996/02/28 16:24:53 mclareni Exp $
-*
-* $Log: cdview.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:53 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDVIEW (CFNAM, PATHI, IRC)
-* =====================================
-*
-************************************************************************
-* *
-* SUBR. CDVIEW (CFNAM, PATHI, IRC*) *
-* *
-* Routine to Create and Present "View" a la ORACLE *
-* *
-* Arguments : *
-* *
-* CFNAM File-Name for Presentation *
-* PATHI Pathname of the Table *
-* IRC Return code (see below) *
-* *
-* Called by CDAUXI *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* *
-************************************************************************
-*
-#include "hepdb/caopts.inc"
-#include "hepdb/cdcblk.inc"
-#include "hepdb/ckkeys.inc"
-#include "hepdb/ccdisp.inc"
-#include "hepdb/clinks.inc"
-#include "hepdb/ctpath.inc"
-#include "hepdb/cxlink.inc"
- DIMENSION KEYI(100), IOTI(100), IOTO(100), IOTJ(100)
- DIMENSION ICONI(100), ICONO(100), ICONJ(100), IDATM(MXPACD)
- CHARACTER PATHJ*80, PATHO*80, PATHY*80, CHPRO*32
- CHARACTER CHTI(100)*8, CHTO(100)*8, CHTJ(100)*8, CHMOD*1
- CHARACTER PATHI*(*), CFNAM*(*)
-*
-* ------------------------------------------------------------------
-*
-* *** Define the Mode to Present (Horizontal or Vertical)
-*
- CALL KUPROC ('Which Mode ? (H/V) ', CHMOD, LCMOD)
- IF (CHMOD.NE.'H') THEN
- CHMOD = 'V'
- IOPHCC = 0
- ELSE
- IOPHCC = 1
- ENDIF
-*
-* *** Set the current directory
-*
- CALL CDLDUP (PATHI, 0, IRC)
- IF (IRC.NE.0) GO TO 999
- PATHY = PAT1CT
-*
-* *** Get the date and time (or Run# or last version)
-*
- DO 5 I = 1, NPARCD
- IF (IOPXCA.NE.0) THEN
- IDATE = 0
- CALL KUPROI ('Date in YYMMDD ', IDATE)
- ITIME = 0
- CALL KUPROI ('Time in HHMMSS ', ITIME)
- CALL CDPKTS (IDATE, ITIME, IDATM(I), IRC)
- ELSE
- NRUN = 0
- WRITE (CHPRO, 1001) I
- CALL KUPROI (CHPRO, NRUN)
- IDATM(I) = NRUN
- ENDIF
- 5 CONTINUE
-*
-* *** Create the first view
-*
- CALL CDVWPR (PATHY, IDATM, NI, CHTI(1), IOTI(1), ICONI(1),
- + KEYI(1), NO, CHTO(1), IOTO(1), ICONO(1), NOBO, IRC)
- IF (IRC.NE.0) GO TO 999
-*
-* *** Present the View or Join New Tables before Presenting
-*
- PATHO = PATHY
- 10 CONTINUE
- CALL KUPROC ('Present view (|) or join Table (Pathname :) ',
- + PATHJ, LPJ)
- IF (PATHJ.EQ.'|') THEN
- IF (NO*NOBO.GT.0) THEN
- CALL CDPRES (PATHY, PATHO, IOTI(1), IOTO(1), CHTI(1),
- + CHTO(1), KEYI(1), IQ(KOFUCD+LVIWCX+1), ICONI(1),
- + ICONO(1), NI, NO, NOBO, CFNAM, IRC)
- CALL MZDROP (IDIVCD, LVIWCX, ' ')
- ENDIF
- ELSE
- IF (NO*NOBO.GT.0) THEN
- CALL CDJOIN (PATHJ, IDATM, NO, NOBO, CHTO(1), IOTO(1),
- + ICONO(1), IQ(KOFUCD+LVIWCX+1), NJ, NOBJ, CHTJ(1),
- + IOTJ(1), ICONJ(1), IRC)
- CALL MZDROP (IDIVCD, LVIWCX, ' ')
- IF (IRC.NE.0) GO TO 999
- LVIWCX = LJOICX
- NO = NJ
- NOBO = NOBJ
- DO 15 I = 1, NJ
- IOTO(I) = IOTJ(I)
- CHTO(I) = CHTJ(I)
- ICONO(I) = ICONJ(I)
- 15 CONTINUE
- PATHO = PATHJ
- GO TO 10
- ENDIF
- ENDIF
-*
- 1001 FORMAT ('Selection on Validity zone ',I2)
-* END CDVIEW
- 999 END
diff --git a/src/packlib/hepdb/cdxint/cdvwpr.F b/src/packlib/hepdb/cdxint/cdvwpr.F
deleted file mode 100644
index 827ff04..0000000
--- a/src/packlib/hepdb/cdxint/cdvwpr.F
+++ /dev/null
@@ -1,239 +0,0 @@
-*
-* $Id: cdvwpr.F,v 1.1.1.1 1996/02/28 16:24:53 mclareni Exp $
-*
-* $Log: cdvwpr.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:53 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDVWPR (PATHN, IDATM, NI, CHTI, IOTI, ICONI, KEYI,
- + NO, CHTO, IOTO, ICONO, NOBO, IRC)
-* ==================================================================
-*
-************************************************************************
-* *
-* SUBR. CDVWPR (PATHN, IDATM, NI*, CHTI*, IOTI*, ICONI, KEYI, *
-* NO*, CHTO*, IOTO*,ICONO*, NOBO*, IRC*) *
-* *
-* Routine to Prepare a View from a Table for Presentation or to *
-* Join to a another Table *
-* The values of the Keys to be presented/joined can be found at *
-* IQ(LVIWCX+1,..,NO,NO+1,...,NO*NOBO) *
-* *
-* Arguments : *
-* *
-* PATHN Pathname of the Table *
-* IDATM Packed Date and Time (or Run #) at which the Table is *
-* valid *
-* NI Number of Keys to search *
-* CHTI Name of Keys to search *
-* IOTI Type of Keys to search *
-* ICONI Number of concatenated keys in search *
-* KEYI Value of the Keys to search *
-* NOBO Number of Objects to be presented *
-* NO Number of Keys to be Presented *
-* CHTO Name of Keys to be presented *
-* IOTO Type of Keys to be presented *
-* ICONO Number of concatenated to be presented *
-* NOBO Number of Objects to be presented *
-* IRC Return code (see below) *
-* *
-* Called by CDVIEW *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* =101 : Illegal path name *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
-#include "hepdb/clinks.inc"
-#include "hepdb/ckkeys.inc"
-#include "hepdb/cviews.inc"
-#include "hepdb/cxlink.inc"
- DIMENSION IOTI(9), IOTO(9), KEYI(9), ICONI(9), ICONO(9)
- DIMENSION IFLAG(100), IDATM(9)
- CHARACTER PATHN*(*), CHTI(*)*8, CHTO(*)*8
- CHARACTER KYNAM*8, KYVAL*100, BLANK*20, KY10*10
- DATA BLANK /' '/
-*
-* ------------------------------------------------------------------
-*
-* ** Set the current directory
-*
- CALL RZCDIR (PATHN, ' ')
- IF (IQUEST(1).NE.0) THEN
- IRC = 101
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) THEN
- KYVAL = PATHN
- NCH = LENOCC (KYVAL)
- CALL CDPRNT (LPRTCD, '(/,'' CDVWPR : Illegal Path Name '//
- + KYVAL(1:NCH)//''')', IARGCD, 0)
- ENDIF
-#endif
- GO TO 999
- ENDIF
- NKEYCK = IQUEST(7)
- NWKYCK = IQUEST(8)
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- CALL CDKYTG
-*
-* ** Fill concatenation flag (if non-zero: number of concatenated keys
-*
- CALL CDCONC (IOTYCK(1), NWKYCK, ICONCK(1), NSKPCK)
-*
-* ** Get Key-Names and Key-Values to Search
-*
- CALL VZERO (KEYSCV, NWKYCK)
- CALL VZERO (MASKCX, NWKYCK)
- CALL VZERO (IFLAG, NWKYCK)
- IK = 0
- 10 CONTINUE
- CALL KUPROC ('Key-Name to Search (if no more - |) ?', KYNAM, LKEY)
- IF (KYNAM.EQ.'|') GO TO 20
- I = NSYSCK+1
- 11 IF (I.GT.NWKYCK) GO TO 13
- IF (KYNAM.EQ.CTAGCK(I).AND.IFLAG(I).EQ.0) THEN
- IFLAG(I) = 1
- IKEY = I
- IK = IK + 1
- IFKYCV(IK) = I
- MASKCX(I) = 1
- CHTI(IK) = CTAGCK(I)
- IOTI(IK) = IOTYCK(I)
- ICONI(IK) = ICONCK(I)
- NREP = 0
- IF (ICONI(IK).GT.0) THEN
- NREP = ICONI(IK)
- DO 12 J = 1, NREP
- I = I + 1
- IFKYCV(IK+J) = I
- MASKCX(I) = 1
- CHTI(IK+J) = CTAGCK(I)
- IOTI(IK+J) = IOTYCK(I)
- ICONI(IK+J) = ICONCK(I)
- IFLAG(I) = 1
- 12 CONTINUE
- ENDIF
- GO TO 15
- ENDIF
- I = I + 1
- GO TO 11
- 13 CONTINUE
- GO TO 10
- 15 CONTINUE
-* * Key-Vector for CDUSEDB
- CALL KUPROC ('Key-Value ?', KYVAL, LKEY)
- IF (IOTYCK(IKEY).EQ.5) THEN
-* * Hollerith
- LCDAT = (NREP+1)*4
- CALL UCTOH (KYVAL(1:LCDAT), KEYSCV(IKEY), 4, LCDAT)
- KEYI(IK) = KEYSCV(IKEY)
- IF (NREP.GT.0) THEN
- DO 16 J = 1, NREP
- IK = IK + 1
- KEYI(IK) = KEYSCV(IKEY+J)
- 16 CONTINUE
- ENDIF
- ELSE IF (IOTYCK(IKEY).EQ.2) THEN
-* * Integer
- LEN = MIN (10,LKEY)
- KY10 = BLANK(1:10-LEN)//KYVAL(1:LEN)
- READ (KY10(1:10), 1002) KEYSCV(IKEY)
- KEYI(IK) = KEYSCV(IKEY)
- ELSE IF (IOTYCK(IKEY).EQ.1) THEN
-* * Bit-string
- LEN = MIN (8,LKEY)
- KY10 = BLANK(1:8-LEN)//KYVAL(1:LEN)
- READ (KY10(1:8), 1003) KEYSCV(IKEY)
- KEYI(IK) = KEYSCV(IKEY)
- ENDIF
- GO TO 10
- 20 CONTINUE
- NI = IK
-*
-* ** Find the Objects Satisfying the Search
-*
- CALL CDUSEDB (PATHN, LKVWCX(1), IDATM, MASKCX, KEYSCV, 'VS', IRC)
- IF (IRC.NE.0) GO TO 100
-*
-* ** Get the Key-Names to Present
-*
- CALL VZERO (JFKYCV, NWKYCK)
- CALL VZERO (IFLAG, NWKYCK)
- IP = 1
- ICONO(I) = 0
- CHTO(1) = CTAGCK(1)
- IOTO(1) = IOTYCK(1)
- JFKYCV(1) = 1
- 25 CALL KUPROC ('Key-Name to Present (if no more: |) ?', KYNAM, LKEY)
- IF (KYNAM.EQ.'|') GO TO 30
- I = NSYSCK+1
- 26 IF (I.GT.NWKYCK) GO TO 28
- IF (KYNAM.EQ.CTAGCK(I).AND.IFLAG(I).EQ.0) THEN
- IFLAG(I) = 1
- IP = IP + 1
- CHTO(IP) = CTAGCK(I)
- IOTO(IP) = IOTYCK(I)
- ICONO(IP) = ICONCK(I)
- JFKYCV(IP) = I
- IF (ICONO(IP).LE.0) THEN
- GO TO 25
- ELSE
- NREP = ICONO(IP)
- DO 27 J = 1,NREP
- IP = IP + 1
- I = I + 1
- IFLAG(I) = 1
- CHTO(IP) = CTAGCK(I)
- IOTO(IP) = IOTYCK(I)
- ICONO(IP) = ICONCK(I)
- JFKYCV(IP) = I
- 27 CONTINUE
- ENDIF
- GO TO 25
- ENDIF
- I = I + 1
- GO TO 26
- 28 CONTINUE
- GO TO 25
- 30 CONTINUE
-*
-* ** Lift Bank for Output
-*
- NO = IP
- IF (NO.LE.0) GO TO 100
- NOBO = NZBANK (IDIVCD, LKVWCX(1))
- IF (NOBO.LE.0) GO TO 100
- NDAT = NO * NOBO
- CALL CDBANK (IDIVCD, LVIWCX, LVIWCX, 2, 'VIEW', 0, 0, NDAT, 2, 0,
- + IRC)
- IF (IRC.NE.0) GO TO 100
-*
-* ** Fill-Up 'VIEW' Bank and free LKVWCX
-*
- IPOIN = LVIWCX
- NKOBJ = NZBANK (IDIVCD, LKVWCX(1))
- IF (NKOBJ.GT.0) THEN
- LFRSCX = LKVWCX(1)
- DO 40 K = 1, NKOBJ
- IF (LFRSCX.GT.0) THEN
- DO 35 J = 1, NO
- IPOIN = IPOIN + 1
- IQ(KOFUCD+IPOIN) = IQ(KOFUCD+LFRSCX+JFKYCV(J))
- 35 CONTINUE
- ENDIF
- LFRSCX = LQ(KOFUCD+LFRSCX)
- 40 CONTINUE
- ENDIF
- 100 CALL MZDROP (IDIVCD, LKVWCX(1), 'L')
-*
- 1001 FORMAT (I2)
- 1002 FORMAT (I10)
- 1003 FORMAT (Z8)
-* END CDVWPR
- 999 END
diff --git a/src/packlib/hepdb/cdxint/cdwrdp.F b/src/packlib/hepdb/cdxint/cdwrdp.F
deleted file mode 100644
index 1a51da2..0000000
--- a/src/packlib/hepdb/cdxint/cdwrdp.F
+++ /dev/null
@@ -1,109 +0,0 @@
-*
-* $Id: cdwrdp.F,v 1.1.1.1 1996/02/28 16:24:53 mclareni Exp $
-*
-* $Log: cdwrdp.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:53 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDWRDP (LUN, LAD)
-* ============================
-*
-************************************************************************
-* *
-* SUBR. CDWRDP (LUN, LAD) *
-* *
-* Prepares the display the data on unit LUN and at address LAD *
-* *
-* Arguments : *
-* *
-* LUN Unit number of file for display *
-* LAD Address of the data in CDSTOR *
-* *
-* Called by CDDISD, CDPEEK *
-* *
-* Original Code : J. Zoll *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
-#include "zebra/mzioc.inc"
-#include "zebra/q_jbit.inc"
-* Ignoring t=pass
-*
-* ------------------------------------------------------------------
-*
-* ** No data to display
-*
- NDAT = IQ(KOFUCD+LAD-1)
- IF (NDAT.LE.0) GO TO 999
-*
-* ** Crack I/O Words into the character description
-*
- LIO = LAD - IQ(KOFUCD+LAD-3) - JBYT(IQ(KOFUCD+LAD),19,4) - 1
- CALL MZIOCR (LQ(KOFUCD+LIO))
-*
-* ** This part (upto the RETURN) is by courtesy of J. Zoll
-*
- NDONE = 0
- JFOCUR = 0
- 10 ITYPE = MFO(JFOCUR+1)
- IF (ITYPE.EQ.7) GO TO 31
- NWSEC = MFO(JFOCUR+2)
- NDO = NWSEC
- IT = ITYPE
- IF (NDO.GT.0) GO TO 41
-*
- IF (NDO.LT.0) THEN
-*
-* * Rest of the bank
-*
- NDO = NDAT
- ELSE
-*
-* * Dynamic sector
-*
- NDONE = NDONE + 1
- NDO = IQ(KOFUCD+LAD+NDONE)
- ENDIF
- GO TO 34
-*
-* ** Self-describing sector
-*
- 31 NDONE = NDONE + 1
- IWORD = IQ(KOFUCD+LAD+NDONE)
- IT = MOD (IWORD,16)
- NDO = IWORD/16
-*
- 34 IF (IT.GE.8) GO TO 999
- IF (NDO.LT.0) GO TO 999
- IF (NDO.EQ.0) GO TO 999
-*
- 41 JS = NDONE + 1
- JE = MIN (NDONE+NDO, NDAT)
- DO 47 J = JS, JE
- IF (IT.EQ.1) THEN
- WRITE (LUN, 1001) J, Q(KOFUCD+LAD+J)
- ELSE IF (IT.EQ.2) THEN
- WRITE (LUN, 1002) J,IQ(KOFUCD+LAD+J)
- ELSE IF (IT.EQ.3) THEN
- WRITE (LUN, 1003) J, Q(KOFUCD+LAD+J)
- ELSE IF (IT.EQ.5) THEN
- WRITE (LUN, 1004) J,IQ(KOFUCD+LAD+J)
- ENDIF
- 47 CONTINUE
- NDONE = JE
- IF (NDONE.GE.NDAT) GO TO 999
-*
- JFOCUR = JFOCUR + 2
- IF (JFOCUR.LT.JFOEND) GO TO 10
- JFOCUR = JFOREP
- GO TO 10
-*
- 1001 FORMAT (1X,'B',I5,4X,Z10)
- 1002 FORMAT (1X,'I',I5,4X,I10)
- 1003 FORMAT (1X,'F',I5,4X,E12.4)
- 1004 FORMAT (1X,'H',I5,4X,A4)
-* END CDWRDP
- 999 END
diff --git a/src/packlib/hepdb/cdxint/cdxini.F b/src/packlib/hepdb/cdxint/cdxini.F
deleted file mode 100644
index 21343c5..0000000
--- a/src/packlib/hepdb/cdxint/cdxini.F
+++ /dev/null
@@ -1,58 +0,0 @@
-*
-* $Id: cdxini.F,v 1.1.1.1 1996/02/28 16:24:53 mclareni Exp $
-*
-* $Log: cdxini.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:53 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDXINI (LCORE)
-* =========================
-*
-************************************************************************
-* *
-* SUBR. CDXINI (LCORE) *
-* *
-* Routine to Initialize the DB Interactive Run *
-* *
-* Arguments : *
-* *
-* LCORE Core Size of /GCBANK/ *
-* *
-* Called by CDMAIN *
-* *
-************************************************************************
-*
-#include "hepdb/cxlink.inc"
-#include "hepdb/ccdisp.inc"
- PARAMETER (NDIV1=5000, LCORQ=100000)
- COMMON /GCBANK/ FENCCD(22), LQ(LCORQ)
- DIMENSION IAR(3)
-*
-* ------------------------------------------------------------------
-*
- LURZCX = 1
- L3PRCX = 6
- LCORU = MAX (LCORE, LCORQ)
-*
- CALL MZSTOR (ISTOCX, '/GCBANK/', ' ', FENCCD(1), LQ(1), LQ(1),
- + LQ(1), LQ(NDIV1), LQ(LCORU))
- NDIV2 = 3*LCORU/4
-*
- CALL MZDIV (ISTOCX, IDIV, 'DB-USERS', NDIV2/2, NDIV2, 'LC')
- CALL MZLINK (ISTOCX, '/CXLINK/', LFRSCX, LFRSCX, LASTCX)
-*
- IAR(1) = LURZCX
- IAR(2) = ISTOCX
- IAR(3) = IDIV
- CALL CDPRNT (L3PRCX, '(/,'' ----- Interactive Session on HEPDB'//
- + ' Test-Run Starts -----'',//,10X,''RZ-Unit Number : '',I5'//
- + ','' HEPDB_Store :'',I10,'' User-Division :'',I10,/)',IAR,3)
-*
-* ** Set Default Display Range
-*
- MXDPCC = 80
- WRITE (CFMTCC, '(''(A'',I3,'')'')') MXDPCC
-* END CDXINI
- 999 END
diff --git a/src/packlib/hepdb/cdxint/cdxopt.F b/src/packlib/hepdb/cdxint/cdxopt.F
deleted file mode 100644
index d1375a4..0000000
--- a/src/packlib/hepdb/cdxint/cdxopt.F
+++ /dev/null
@@ -1,83 +0,0 @@
-*
-* $Id: cdxopt.F,v 1.1.1.1 1996/02/28 16:24:53 mclareni Exp $
-*
-* $Log: cdxopt.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:53 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDXOPT (CHOPT, MASK)
-* ===============================
-*
-************************************************************************
-* *
-* SUBR. CDXOPT (CHOPT, MASK*) *
-* *
-* Decode the character option and fill up the vector MASK *
-* *
-* Arguments : *
-* *
-* CHOPT Character option supplied by user *
-* MASK A vector set to 1 if the corresponding option is on *
-* (numeric part of CHOPT) *
-* *
-* Called by CDAUXI *
-* *
-************************************************************************
-*
-#include "hepdb/caopti.inc"
-#include "hepdb/cdcblk.inc"
- CHARACTER CHOPT*(*), CTEST*1, BLANK*1
- DIMENSION ICOPT(300), MASK(9)
- DATA BLANK / ' '/
-*
-* ------------------------------------------------------------------
-*
-* *** Convert CHOPT into a list of integer variables
-*
- MAXL = LEN (CHOPT)
- I1 = 0
- DO 20 I0 = 1, MAXL
- CTEST = CHOPT(I0:I0)
- DO 10 I = 1, 62
- IF (CTEST.EQ.CALFCA(I)) GO TO 15
- 10 CONTINUE
- IF (CTEST.NE.BLANK) GO TO 999
- GO TO 20
- 15 I1 = I1 + 1
- IF (I.GT.36) I = I - 36
- ICOPT(I1) = I
- 20 CONTINUE
- MAXU = I1
-*
-* *** Now fill up the common /CAOPTS/
-*
- I0 = 0
- 30 I0 = I0 + 1
- IF (I0.GT.MAXU) GO TO 999
- I = ICOPT(I0)
-*
-* ** Alphabetic options
-*
- IF (I.LE.26) GO TO 30
-*
-* ** Numeric options (at the moment 3-29 only)
-* ** If first digit = 1 or 2, it has to be a 2 digit number
-* ** = 3 .. 9, it can only be one digit number
-* ** First digit can never be 0.
-*
- I1 = I - 27
- IF (I1.EQ.0) GO TO 30
- IF (I1.GE.3.AND.I1.LE.9) THEN
- MASK(I1) = 1
- GO TO 30
- ENDIF
- IF (I0.GE.MAXU) GO TO 999
- I = ICOPT(I0+1) - 27
- IF (I.LT.0) GO TO 999
- MASK(I1*10+I) = 1
- I0 = I0 + 1
- GO TO 30
-* END CDXOPT
- 999 END
diff --git a/src/packlib/hepdb/dbcdif/Imakefile b/src/packlib/hepdb/dbcdif/Imakefile
deleted file mode 100644
index a03f867..0000000
--- a/src/packlib/hepdb/dbcdif/Imakefile
+++ /dev/null
@@ -1,13 +0,0 @@
-SRCS_F= dbabrd.F dbabwr.F dbcdes.F dbckey.F dbcrsd.F dbdelt.F \ @@\
- dbdont.F dbeali.F dbefor.F dbehlp.F dbenam.F dbend.F dbendf.F \ @@\
- dbentb.F dbentr.F dbfpat.F dbfree.F dbfzop.F dbfzup.F dbget.F \ @@\
- dbgets.F dbgnam.F dbildf.F dbildu.F dbin.F dbinct.F dbinit.F \ @@\
- dbkept.F dbkin.F dbktyp.F dbkvin.F dbkxin.F dblast.F dblkey.F \ @@\
- dblmod.F dblogl.F dbmdip.F dbmdir.F dbntop.F dboptm.F dbopts.F \ @@\
- dbout.F dbpktm.F dbpkts.F dbplbk.F dbplnt.F dbplob.F dbplov.F \ @@\
- dbplti.F dbprgd.F dbprin.F dbpurg.F dbpurk.F dbrali.F dbrenk.F \ @@\
- dbrepl.F dbrhlp.F dbrky1.F dbrnam.F dbropn.F dbrtfz.F dbsave.F \ @@\
- dbsrtm.F dbtbcr.F dbtbpr.F dbuptm.F dbupts.F dbuse.F dbuvtx.F \ @@\
- dbvin.F dbvldt.F dbvout.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/hepdb/dbcdif/dbabrd.F b/src/packlib/hepdb/dbcdif/dbabrd.F
deleted file mode 100644
index 5997ec8..0000000
--- a/src/packlib/hepdb/dbcdif/dbabrd.F
+++ /dev/null
@@ -1,115 +0,0 @@
-*
-* $Id: dbabrd.F,v 1.1.1.1 1996/02/28 16:24:54 mclareni Exp $
-*
-* $Log: dbabrd.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:54 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE DBABRD (PATHN, LBK, LUN, ITIME, KEYS, CHOPT)
-* ======================================================
-*
-************************************************************************
-* *
-* SUBR. DBABRD (PATHN, *LBK*, LUN, ITIME, KEYS, CHOPT) *
-* *
-* Prepares the database data structure in memory for any required *
-* Pathname (for ASCII objects) and set of Keys, unless already done. *
-* Returns (optionally) the addresses in memory for the corresponding *
-* Key banks after checking their validity for the given time and *
-* keys. Also writes the ASCII format on a given file specified. *
-* *
-* Arguments : *
-* *
-* PATHN Character string describing the pathname *
-* LBK(*) Address(es) of Keys bank(s) KYCD (INPUT or OUTPUT) *
-* For option 'S' it is the support address of the linear *
-* structure *
-* For option 'M' with selection on user keys 8 and 9, *
-* LBK(k) is the address corresponding to the ith Key-8 *
-* and the jth Key-9 value, where k = KEYS(8) * (j-1) + i *
-* LUN Logical unit number of the file with ASCII data *
-* (0 if no output conversion is required) *
-* ITIME Event data acquisition time (or 0, if Data not wanted) *
-* KEYS Vector of keys. Only the elements declared in CHOPT are *
-* assumed to contain useful information. *
-* When option 'M' is declared KEYS(n) (when user Key n *
-* is selected should contain the number of data objects *
-* to be retrieved according to the KEYS(n) values and *
-* the values of the key elements for Key-n to be matched *
-* should be stored in successive KEYS(i) elements, with *
-* i starting from NWKEY+1 (NWKEY is the number of key *
-* elements for this directory) *
-* CHOPT Character string with any of the following characters *
-* A trust LBK address(es) if non-zero *
-* K read only the keys (no data is required) *
-* M expect multiple Key banks to be returned (only up to *
-* a maximum of 5 user keys) *
-* S expect multiple Key banks satisfying selection on a *
-* number of keys (Options S and M are mutually exclusive) *
-* V declare the Data as being different in size to what is *
-* already resident in memory *
-* 3 selects objects with start validity time < KEYS(3) *
-* (with option S) *
-* 4 selects objects with end validity time > KEYS(4) *
-* (with option S) *
-* 5 specific Program version number required *
-* 7 select objects with insertion time < KEYS(7) *
-* n consider user key n (where 7 < n < 29 ) *
-* *
-* Called by user *
-* *
-* Error Condition : *
-* *
-* IQUEST(1) = 0 : No error *
-* = 1 : Illegal character option *
-* = 2 : Illegal path name *
-* = 4 : Illegal key option *
-* *
-* If IQUEST(1) =0, IQUEST(2) carries information whether data *
-* part had been actually read from the disk or not *
-* IQUEST(2) = 0 : No disk i/o has been performed *
-* = 1 : Data have been refreshed from the disk *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
-#include "dxused.inc"
- DIMENSION ITIME(9), KEYS(9), LBK(9)
- CHARACTER CHOPT*(*), PATHN*(*), CHOPF*28
-*
-* ------------------------------------------------------------------
-*
-* *** Reformat CHOPT
-*
- CALL DBOPTS (CHOPT, IRC)
- IF (IRC.NE.0) THEN
- IQUEST(1) = IRC
- GO TO 999
- ENDIF
- CALL DBOPTM (CHOPF)
- CALL DBCKEY (KEYS, KEYSDX, MXKYDX)
-*
-* *** Initialize options
-*
- CALL CDUSEDB (PATHN, LBK, ITIME, MASKDX, KEYSDX, CHOPF, IRC)
- IQUEST(1) = IRC
- IF (IRC.NE.0) THEN
- NKYMX = IQUEST(3)
- LBKS = LBK(1)
- DO 10 I = 1, NKYMX
- IF (IOPSDX.EQ.0) LBKS = LBK(I)
- IF (LBKS.NE.0) THEN
- LBDS = LQ(KOFUCD+LBKS-KLDACD)
- CALL CDAFRI (LUN, LBDS, ' ', IRC)
- IF (IRC.NE.0) THEN
- IQUEST(1) = IRC
- GO TO 999
- ENDIF
- ENDIF
- IF (IOPSDX.NE.0.AND.LBKS.NE.0) LBKS = LQ(KOFUCD+LBKS)
- 10 CONTINUE
- ENDIF
-* END DBABRD
- 999 END
diff --git a/src/packlib/hepdb/dbcdif/dbabwr.F b/src/packlib/hepdb/dbcdif/dbabwr.F
deleted file mode 100644
index 0de3967..0000000
--- a/src/packlib/hepdb/dbcdif/dbabwr.F
+++ /dev/null
@@ -1,105 +0,0 @@
-*
-* $Id: dbabwr.F,v 1.1.1.1 1996/02/28 16:24:54 mclareni Exp $
-*
-* $Log: dbabwr.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:54 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE DBABWR (PATHN, LBK, LUN, NWKEY, KEY, KEYO, CHOPT)
-* ============================================================
-*
-************************************************************************
-* *
-* SUBR. DBABWR (PATHN, *LBK*, LUN, NWKEY, KEY, KEYO, CHOPT) *
-* *
-* Stores ASCII data from a disk file to the data base and also enters*
-* in the memory ala DBUSE in NODE/KEY structure *
-* *
-* Arguments : *
-* *
-* PATHN Character string describing the pathname *
-* LBK(*) Address of Keys bank KYCD (INPUT or OUTPUT) *
-* LUN Logical unit number of the file where ASCII data reside *
-* NWKEY Number of keys associated with the data bank *
-* KEY Vector of keys *
-* KEYO Old vector of keys (for option X only) *
-* CHOPT Character string with any of the following characters *
-* A trust LBK address if non-zero *
-* B Save in the special backup file; not in standard Journal*
-* C create Node/Key data structure ala DBUSE *
-* X Replaces an old set of keys *
-* 7 Insertion time as supplied by user to be honoured *
-* *
-* Called by user *
-* *
-* Error Condition : *
-* *
-* IQUEST(1) = 0 : No error *
-* = 61 : Too many keys *
-* = 66 : Illegal logical unit number *
-* = 67 : File too long; no space in buffer *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
-#include "hepdb/clinks.inc"
-#include "dxused.inc"
- DIMENSION KEY(9), KEYO(9), LBK(9), KYXO(MXKYDX)
- CHARACTER CHOPT*(*), PATHN*(*), CHOP*28
-*
-* ------------------------------------------------------------------
-*
-* *** Decode the character option
-*
- CALL DBOPTS (CHOPT, IRC)
- IF (IRC.NE.0) THEN
- IQUEST(1) = IRC
- GO TO 999
- ENDIF
-*
-* *** Reformat CHOPT
-*
- IOPNDX = 0
- IOPTDX = 1
- IOPYDX = 1
- IF (IOPXDX.NE.0) THEN
- IOPRDX = 1
- ELSE
- IOPRDX = 0
- ENDIF
- IOPXDX = 0
- IOPPDX = 0
- IOPDDX = 0
- IOPSDX = 0
- IOPUDX = 0
- IF (IOKYDX(7).NE.0) THEN
- IOPHDX = 1
- ELSE
- IOPHDX = 0
- ENDIF
- CALL DBOPTM (CHOP)
- CALL DBCKEY (KEY, KEYSDX, MXKYDX)
- CALL DBCKEY (KEYO, KXYO, MXKYDX)
-*
-* *** Read in from the file
-*
- LSTRCL(4) = 0
- CALL CDATOI (LUN, LSTRCL(4), IRC)
- IF (IRC.NE.0) THEN
- IF (LSTRCL(4).NE.0) CALL MZDROP (IDIVCD, LSTRCL(4), ' ')
- IQUEST(1) = IRC
- GO TO 999
- ENDIF
-*
- IF (IOPRDX.NE.0) THEN
- CALL CDREPL (PATHN, LSTRCL(4), LBK, IDIVCD, KXYO, KEYSDX, CHOP,
- + IRC)
- ELSE
- CALL CDSTOR (PATHN, LSTRCL(4), LBK, IDIVCD, KEYSDX, CHOP, IRC)
- ENDIF
- IF (LSTRCL(4).NE.0) CALL MZDROP (IDIVCD, LSTRCL(4), ' ')
- IQUEST(1) = IRC
-* END DBABWR
- 999 END
diff --git a/src/packlib/hepdb/dbcdif/dbcdes.F b/src/packlib/hepdb/dbcdif/dbcdes.F
deleted file mode 100644
index a48c9fd..0000000
--- a/src/packlib/hepdb/dbcdif/dbcdes.F
+++ /dev/null
@@ -1,9 +0,0 @@
-*
-* $Id: dbcdes.F,v 1.1.1.1 1996/02/28 16:24:54 mclareni Exp $
-*
-* $Log: dbcdes.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:54 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
diff --git a/src/packlib/hepdb/dbcdif/dbckey.F b/src/packlib/hepdb/dbcdif/dbckey.F
deleted file mode 100644
index 26f1c9e..0000000
--- a/src/packlib/hepdb/dbcdif/dbckey.F
+++ /dev/null
@@ -1,55 +0,0 @@
-*
-* $Id: dbckey.F,v 1.1.1.1 1996/02/28 16:25:03 mclareni Exp $
-*
-* $Log: dbckey.F,v $
-* Revision 1.1.1.1 1996/02/28 16:25:03 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE DBCKEY (KEYS, KEYO, NWKEY)
-* =====================================
-*
-************************************************************************
-* *
-* SUBR. DBCKEY (KEYS, KEYO*, NWKEY) *
-* *
-* Changes the convention of KEYS and MASK vector between DB and CD *
-* It updates MASKDX in /DXUSED/ *
-* *
-* Arguments : *
-* *
-* KEYS Input key vector *
-* KEYO Output key vector *
-* NWKEY Number of key elements in KEYO *
-* *
-* Called by various routines in the patch DBCDFC *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
-#include "hepdb/ckkeys.inc"
-#include "dxused.inc"
- DIMENSION KEYS(29), KEYO(29)
-*
-* ------------------------------------------------------------------
-*
- NCOPY = MIN (MXDMCK-NOF2CK-2, NWKEY-NOF2CK-2)
- CALL UCOPY (KEYS(NSYSDX+1), KEYO(NOF2CK+3), NCOPY)
- KEYO(IDHKSN) = KEYS(1)
- KEYO(IDHPTR) = KEYS(2)
- KEYO(NOF1CK+1) = KEYS(3)
- KEYO(NOF1CK+2) = KEYS(4)
- KEYO(IDHUSI) = KEYS(5)
- KEYO(IDHFLG) = KEYS(6)
- KEYO(IDHINS) = KEYS(7)
- CALL UCOPY (IOKYDX(NSYSDX+1), MASKDX(NOF2CK+3), MXDMCK-NOF2CK-2)
- MASKDX(IDHKSN) = IOKYDX(1)
- MASKDX(IDHPTR) = IOKYDX(2)
- MASKDX(NOF1CK+1) = IOKYDX(3)
- MASKDX(NOF1CK+2) = IOKYDX(4)
- MASKDX(IDHUSI) = IOKYDX(5)
- MASKDX(IDHFLG) = IOKYDX(6)
- MASKDX(IDHINS) = IOKYDX(7)
-* END DBCKEY
- END
diff --git a/src/packlib/hepdb/dbcdif/dbcrsd.F b/src/packlib/hepdb/dbcdif/dbcrsd.F
deleted file mode 100644
index 93c93c4..0000000
--- a/src/packlib/hepdb/dbcdif/dbcrsd.F
+++ /dev/null
@@ -1,59 +0,0 @@
-*
-* $Id: dbcrsd.F,v 1.1.1.1 1996/02/28 16:24:54 mclareni Exp $
-*
-* $Log: dbcrsd.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:54 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE DBCRSD (PATH, NKEX, CHFOR, CHTAG, MXKP, CHOPT)
-* =========================================================
-*
-************************************************************************
-* *
-* SUBR. DBCRSD (PATH, NKEX, CHFOR, CHTAG, MXKP, CHOPT) *
-* *
-* Creates a L3 directory with standard keys plus NKEX extra keys *
-* *
-* Arguments : *
-* *
-* PATH Character string describing the pathname *
-* NKEX Number of user keys *
-* CHFOR Character string specifying the user key type *
-* CHTAG String of 8-character tags for the user key elements *
-* MXKP Maximum number of objects in a partitioned directory *
-* CHOPT Character string with any of the following characters *
-* P Create partitioned subdirectories for the pathname *
-* *
-* Called by user *
-* *
-* Error Condition : *
-* *
-* IQUEST(1) = 0 : No error *
-* = 43 : Illegal number of user keys *
-* *
-************************************************************************
-*
-#include "hepdb/cuserf.inc"
-#include "dxused.inc"
- COMMON /QUEST/ IQUEST(100)
- CHARACTER*(*) PATH, CHTAG(*), CHFOR, CHOPT
- CHARACTER CHOP*28
-*
-* ------------------------------------------------------------------
-*
-* *** Decode the character option
-*
- CALL DBOPTS (CHOPT, IRC)
- IF (IRC.NE.0) THEN
- IQUEST(1) = IRC
- GO TO 999
- ENDIF
- IOPCDX = 1
- CALL DBOPTM (CHOP)
-*
- CALL CDMDIR (PATH,NKEX, CHFOR,CHTAG,MXKP, IPRECU,DELTCU, CHOP,IRC)
- IQUEST(1) = IRC
-* END DBCRSD
- 999 END
diff --git a/src/packlib/hepdb/dbcdif/dbdelt.F b/src/packlib/hepdb/dbcdif/dbdelt.F
deleted file mode 100644
index fa0f557..0000000
--- a/src/packlib/hepdb/dbcdif/dbdelt.F
+++ /dev/null
@@ -1,49 +0,0 @@
-*
-* $Id: dbdelt.F,v 1.1.1.1 1996/02/28 16:24:54 mclareni Exp $
-*
-* $Log: dbdelt.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:54 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE DBDELT (PATHN, CHOPT)
-* ================================
-*
-************************************************************************
-* *
-* SUBR. DBDELT (PATHN, CHOPT) *
-* *
-* Deletes the directory from the current level downwards as given *
-* in the path name *
-* *
-* Arguments : *
-* *
-* PATHN Path name to be deleted *
-* CHOPT Character string with any of the following characters *
-* B Save in the special backup file; not in standard Journal*
-* *
-* Called by user, DBFZUP, DBKEPT, DBACTI *
-* *
-* Error Condition : *
-* *
-* IQUEST(1) = 0 : No error *
-* =171 : Illegal Path name *
-* =172 : Cannot find the top directory for the path name *
-* =173 : Error in RZ for reading the dictionary object *
-* =174 : Error in FZOUT for saving the journal file *
-* =175 : Error in RZ in writing the dictionary object *
-* =176 : Error in RZ in purging the dictionary directory *
-* =177 : Error in RZ in deleting the tree *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
- CHARACTER PATHN*(*), CHOPT*(*)
-*
-* ------------------------------------------------------------------
-*
- CALL CDDDIR (PATHN, CHOPT, IRC)
- IQUEST(1) = IRC
-* END DBDELT
- 999 END
diff --git a/src/packlib/hepdb/dbcdif/dbdont.F b/src/packlib/hepdb/dbcdif/dbdont.F
deleted file mode 100644
index db8e2ff..0000000
--- a/src/packlib/hepdb/dbcdif/dbdont.F
+++ /dev/null
@@ -1,67 +0,0 @@
-*
-* $Id: dbdont.F,v 1.1.1.1 1996/02/28 16:24:54 mclareni Exp $
-*
-* $Log: dbdont.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:54 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE DBDONT (PATHN, IUDIV, LSUP, NWKEY, KEY, CHOPT)
-* =========================================================
-*
-************************************************************************
-* *
-* SUBR. DBDONT (PATHN, IUDIV, LSUP, NWKEY, KEY, CHOPT) *
-* *
-* Stores data from memory to disk. If data exist with the same user *
-* keys, the old object is physically replaced. This mode is not *
-* recommended for all calibration data. *
-* *
-* Arguments : *
-* *
-* PATHN Character string describing the pathname *
-* IUDIV Division index of the user data bank *
-* LSUP Address of bank in memory where data reside *
-* NWKEY Number of keys associated with the data bank *
-* KEY Vector of keys *
-* CHOPT Character string with any of the following characters *
-* B Save in the special backup file; not in standard Journal*
-* 7 Insertion time as supplied by user to be honoured *
-* *
-* Called by user *
-* *
-* Error Condition : *
-* *
-* IQUEST(1) = 0 : No error *
-* = 61 : Too many keys *
-* = 71 : Illegal path name *
-* = 73 : RZ error during writing to disk *
-* = 75 : Cannot find the Top directory name in pathname *
-* = 76 : Cannot form the IO descriptor for the FZ header *
-* = 77 : FZOUT fails to write on to the sequential file *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
-#include "dxused.inc"
- DIMENSION KEY(9), LSUP(9)
- CHARACTER CHOPT*(*), PATHN*(*), CHOPF*28
-*
-* ------------------------------------------------------------------
-*
-* *** Decode the character option
-*
- CALL DBOPTS (CHOPT, IRC)
- IF (IRC.NE.0) THEN
- IQUEST(1) = IRC
- GO TO 999
- ENDIF
- IF (IOKYDX(7).NE.0) IOPHDX = 1
- CALL DBOPTM (CHOPF)
- CALL DBCKEY (KEY, KEYSDX, MXKYDX)
-*
- CALL CDDONT (PATHN, IUDIV, LSUP, KEYSDX, CHOPF, IRC)
- IQUEST(1) = IRC
-* END DBDONT
- 999 END
diff --git a/src/packlib/hepdb/dbcdif/dbeali.F b/src/packlib/hepdb/dbcdif/dbeali.F
deleted file mode 100644
index 4e94703..0000000
--- a/src/packlib/hepdb/dbcdif/dbeali.F
+++ /dev/null
@@ -1,47 +0,0 @@
-*
-* $Id: dbeali.F,v 1.1.1.1 1996/02/28 16:24:55 mclareni Exp $
-*
-* $Log: dbeali.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:55 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE DBEALI (PATH, ALIAS, IFLAG)
-* ======================================
-*
-************************************************************************
-* *
-* SUBR. DBEALI (PATH, ALIAS, IFLAG) *
-* *
-* Enter the alias name of a given directory either only for this *
-* session or permanently in the data base. *
-* *
-* Arguments : *
-* *
-* PATH Character string specifying the directory path name *
-* ALIAS Character string specifying the alias name *
-* IFLAG Flag (0 if to be entered only for this session; *
-* 1 if to be entered for this session and D.B.) *
-* *
-* Called by user, DBFZUP, DBAUXI *
-* *
-* Error Condition : *
-* *
-* IQUEST(1) = 0 : No error *
-* =182 : Illegal path name *
-* =185 : Illegal top directory name *
-* =187 : FZOUT fails to write on the sequential file *
-* =188 : Error in RZ for writing to the R.A. file *
-* =201 : Dictionary directory not found *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
- CHARACTER PATH*(*), ALIAS*(*)
-* ------------------------------------------------------------------
-*
- CALL CDEALI (PATH, ALIAS, IFLAG, IRC)
- IQUEST(1) = IRC
-* END DBEALI
- 999 END
diff --git a/src/packlib/hepdb/dbcdif/dbefor.F b/src/packlib/hepdb/dbcdif/dbefor.F
deleted file mode 100644
index e94b747..0000000
--- a/src/packlib/hepdb/dbcdif/dbefor.F
+++ /dev/null
@@ -1,36 +0,0 @@
-*
-* $Id: dbefor.F,v 1.1.1.1 1996/02/28 16:24:55 mclareni Exp $
-*
-* $Log: dbefor.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:55 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE DBEFOR (TOPN, IDATE, ITIME)
-* ======================================
-*
-************************************************************************
-* *
-* SUBR. DBEFOR (TOPN, IDATE, ITIME) *
-* *
-* Set the maximum insertion time for retrieval of all subsequent *
-* data objects for a given top directory *
-* *
-* Arguments : *
-* *
-* TOPN Name of the top directory ('*' means all) *
-* IDATE Date : 6 Decimal integer : YYMMDD *
-* ITIME Time : 4 Decimal integer : HHMM *
-* *
-* Called by user *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
- CHARACTER TOPN*(*)
-* ------------------------------------------------------------------
-*
- CALL CDBFOR (TOPN, IDATE, ITIME, IRC)
-* END DBEFOR
- END
diff --git a/src/packlib/hepdb/dbcdif/dbehlp.F b/src/packlib/hepdb/dbcdif/dbehlp.F
deleted file mode 100644
index c9f1452..0000000
--- a/src/packlib/hepdb/dbcdif/dbehlp.F
+++ /dev/null
@@ -1,45 +0,0 @@
-*
-* $Id: dbehlp.F,v 1.1.1.1 1996/02/28 16:24:55 mclareni Exp $
-*
-* $Log: dbehlp.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:55 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE DBEHLP (PATH, LUN)
-* =============================
-*
-************************************************************************
-* *
-* SUBR. DBEHLP (PATH, LUN) *
-* *
-* Encode the help information from an ASCII disk file specified by *
-* the logical unit number LUN with subroutine DBLINC and enter it *
-* into the data base. *
-* *
-* Arguments : *
-* *
-* PATH Path name of the help subdirectory *
-* LUN Logical unit number of the file where ASCII help *
-* information reside *
-* *
-* Called by user, DBAUXI *
-* *
-* Error Condition : *
-* *
-* IQUEST(1) = 0 : No error *
-* = 66 : Illegal logical unit number *
-* = 67 : File too long; no space in buffer *
-* =182 : Illegal path name *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
- CHARACTER PATH*(*)
-* ------------------------------------------------------------------
-*
- CALL CDEHLP (PATH, LUN, IRC)
- IQUEST(1) = IRC
-* END DBEHLP
- 999 END
diff --git a/src/packlib/hepdb/dbcdif/dbenam.F b/src/packlib/hepdb/dbcdif/dbenam.F
deleted file mode 100644
index bf6b88a..0000000
--- a/src/packlib/hepdb/dbcdif/dbenam.F
+++ /dev/null
@@ -1,45 +0,0 @@
-*
-* $Id: dbenam.F,v 1.1.1.1 1996/02/28 16:24:55 mclareni Exp $
-*
-* $Log: dbenam.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:55 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE DBENAM (PATH, NW, CHTAG)
-* ===================================
-*
-************************************************************************
-* *
-* SUBR. DBENAM (PATH, NW, CHTAG) *
-* *
-* Enters the name of the data elements of a given directory inside *
-* the data base. The stored information goes in the DICTIONARY *
-* directory with KEY(1) set to the unique identifier of this *
-* directory. *
-* *
-* Arguments : *
-* *
-* PATH Character string describing the path name *
-* NW Number of data elements *
-* CHTAG Name of each data element (assumed to be 8 character) *
-* *
-* Called by user, DBAUXI *
-* *
-* Error Condition : *
-* *
-* IQUEST(1) = 0 : No error *
-* =182 : Illegal path name *
-* =183 : Illegal number of data words *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
- CHARACTER*(*) CHTAG(*), PATH
-* ------------------------------------------------------------------
-*
- CALL CDENAM (PATH, NW, CHTAG, IRC)
- IQUEST(1) = IRC
-* END DBENAM
- 999 END
diff --git a/src/packlib/hepdb/dbcdif/dbend.F b/src/packlib/hepdb/dbcdif/dbend.F
deleted file mode 100644
index fd1723f..0000000
--- a/src/packlib/hepdb/dbcdif/dbend.F
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: dbend.F,v 1.1.1.1 1996/02/28 16:24:55 mclareni Exp $
-*
-* $Log: dbend.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:55 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE DBEND
-* ================
-*
-************************************************************************
-* *
-* SUBR. DBEND *
-* *
-* Terminates the Data Base utility package *
-* *
-* Called by user, DBMAIN, DBTERM, DBACTI *
-* *
-* Error Condition : *
-* *
-* IQUEST(1) = 0 : No error *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
-*
-* ------------------------------------------------------------------
-*
- CALL CDEND ('*', 'A', IRC)
- IQUEST(1) = IRC
-* END DBEND
- 999 END
diff --git a/src/packlib/hepdb/dbcdif/dbendf.F b/src/packlib/hepdb/dbcdif/dbendf.F
deleted file mode 100644
index 5a40323..0000000
--- a/src/packlib/hepdb/dbcdif/dbendf.F
+++ /dev/null
@@ -1,39 +0,0 @@
-*
-* $Id: dbendf.F,v 1.1.1.1 1996/02/28 16:24:55 mclareni Exp $
-*
-* $Log: dbendf.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:55 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE DBENDF (TOPN)
-* ========================
-*
-************************************************************************
-* *
-* SUBR. DBENDF (TOPN) *
-* *
-* Closes one data base file given by the top directory name *
-* *
-* Arguments : *
-* *
-* TOPN Name of the top directory *
-* *
-* Called by user *
-* *
-* Error Condition : *
-* *
-* IQUEST(1) = 0 : No error *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
- CHARACTER TOPN*(*)
-*
-* ------------------------------------------------------------------
-*
- CALL CDEND (TOPN, ' ', IRC)
- IQUEST(1) = IRC
-* END DBENDF
- END
diff --git a/src/packlib/hepdb/dbcdif/dbentb.F b/src/packlib/hepdb/dbcdif/dbentb.F
deleted file mode 100644
index 07d9a5b..0000000
--- a/src/packlib/hepdb/dbcdif/dbentb.F
+++ /dev/null
@@ -1,134 +0,0 @@
-*
-* $Id: dbentb.F,v 1.1.1.1 1996/02/28 16:24:56 mclareni Exp $
-*
-* $Log: dbentb.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:56 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE DBENTB (PATHN, IUDIV, LSUP, KEY, NWDIM, NTKEY, IPREC,
- + CHOPT)
-* ================================================================
-*
-************************************************************************
-* *
-* SUBR. DBENTB (PATHN, IUDIV, LSUP, *KEY*, NWDIM, NTKEY, IPREC, *
-* CHOPT) *
-* *
-* Stores data from memory to disk for a number of objects in a go. *
-* It is useful in a Batch operation to save real time spent *
-* *
-* Arguments : *
-* *
-* PATHN Character string describing the pathname *
-* IUDIV Division index where the data reside *
-* LSUP Vector containing the addresses of the banks where *
-* data reside *
-* KEY Two dimensional array with the first dimension NWDIM, *
-* specifying the key elements for each object and the *
-* secod dimension NTKEY, specifying the number of objects *
-* (Keys 3,4,5 and 8 onwards to be filled in by user on *
-* input; the DB system keys will be filled in here at the *
-* time of output) *
-* NWDIM First dimension of the array KEY *
-* NTKEY Number of objects to be inserted *
-* IPREC Precision word; (If IPREC > 0, data are stored with *
-* IPREC significant digits right to the decimal points; if*
-* IPREC < 0, data are stored with IPREC insignificant *
-* digits left to the decimal point.) *
-* CHOPT Character string with any of the following characters *
-* B Save in the special backup file; not in standard Journal*
-* F Updates with a fully matched data object (in user keys) *
-* R Store with full RZ option (No compression to be made) *
-* S Create stand alone (master) data *
-* T Special text type of data (to be used with R) *
-* U Store data uncompressed *
-* Z Store only nonzero elements. An element is considered to*
-* be zero if its absolute is less than IPREC *
-* 7 Insertion time as supplied by user to be honoured *
-* *
-* Called by user *
-* *
-* Error Condition : *
-* *
-* IQUEST(1) = 0 : No error *
-* = 61 : Too many keys *
-* = 65 : Illegal number of objects *
-* = 71 : Illegal path name *
-* = 72 : Number of keys does not match with that *
-* specified in the directory *
-* = 73 : RZOUT fails to write on disk *
-* = 74 : Error in RZRENK in updating key values for *
-* partitioned data set *
-* = 75 : Cannot find the Top directory name in pathname *
-* = 76 : Cannot form the IO descriptor for the FZ header *
-* = 77 : FZOUT fails to write on to the sequential file *
-* = 78 : Illegal number of keys in data base *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
-#include "hepdb/ckkeys.inc"
-#include "dxused.inc"
- PARAMETER (NWKYM=30, NOBJM=500)
- DIMENSION KEY(NWDIM,2), LSUP(9), KEYN(NWKYM,NOBJM)
- CHARACTER CHOPT*(*), PATHN*(*), CHOP*28
-*
-* ------------------------------------------------------------------
-*
-* *** Decode the character option
-*
- CALL DBOPTS (CHOPT, IRC)
- IF (IRC.NE.0) THEN
- IQUEST(1) = IRC
- GO TO 999
- ENDIF
-*
-* *** Reformat CHOPT
-*
- IOPCDX = 0
- IOPNDX = 0
- IF (IOPRDX.NE.0) THEN
- IOPYDX = 1
- IOPRDX = 0
- ENDIF
- IF (IOPYDX.NE.0.OR.IOPTDX.NE.0) THEN
- IOPPDX = 0
- ELSE
- IOPPDX = 1
- ENDIF
- IF (IOPSDX.NE.0) THEN
- IOPDDX = 0
- IOPSDX = 0
- ELSE
- IOPDDX = 1
- ENDIF
- IF (IOPUDX.NE.0) THEN
- IOPPDX = 0
- IOPUDX = 0
- ENDIF
- IF (IOKYDX(7).NE.0) THEN
- IOPHDX = 1
- ELSE
- IOPHDX = 0
- ENDIF
- CALL DBOPTM (CHOP)
-*
- IF (NWDIM+NOF2CK+2.GT.NWKYM+NSYSDX.OR.NTKEY.GT.NOBJM) THEN
- DO 10 I = 1, NTKEY
- CALL DBCKEY (KEY(1,I), KEYSDX, MXKYDX)
- LKEYDX = LSUP(I)
- CALL CDSTOR (PATHN, LKEYDX, LBK, IUDIV, KEYSDX, CHOP, IRC)
- IQUEST(1) = IRC
- IF (IQUEST(1).NE.0) GO TO 999
- 10 CONTINUE
- ELSE
- DO 20 I = 1, NTKEY
- CALL DBCKEY (KEY(1,I), KEYN(1,I), NWKYM)
- 20 CONTINUE
- CALL CDENTB (PATHN, LSUP, IUDIV, NWKYM, NTKEY, KEYN, CHOP, IRC)
- IQUEST(1) = IRC
- ENDIF
-* END DBENTB
- 999 END
diff --git a/src/packlib/hepdb/dbcdif/dbentr.F b/src/packlib/hepdb/dbcdif/dbentr.F
deleted file mode 100644
index 725f9c0..0000000
--- a/src/packlib/hepdb/dbcdif/dbentr.F
+++ /dev/null
@@ -1,118 +0,0 @@
-*
-* $Id: dbentr.F,v 1.1.1.1 1996/02/28 16:24:56 mclareni Exp $
-*
-* $Log: dbentr.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:56 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE DBENTR (PATHN, LBK, LBD, IUDIV, LSUP, NWKEY, KEY, IPREC
- + , CHOPT)
-* ==================================================================
-*
-************************************************************************
-* *
-* SUBR. DBENTR (PATHN, *LBK*, LBD*, IUDIV, LSUP, NWKEY, KEY, *
-* IPREC, CHOPT) *
-* *
-* Stores data from memory to disk and also enters in the memory ala *
-* DBUSE in NODE/KEY structure *
-* *
-* Arguments : *
-* *
-* PATHN Character string describing the pathname *
-* LBK(*) Address of Keys bank KYCD (INPUT or OUTPUT) *
-* LBD(*) Address of Data bank *
-* IUDIV Division index of the user data bank *
-* LSUP Address of bank in memory where data reside *
-* NWKEY Number of keys associated with the data bank *
-* KEY Vector of keys *
-* IPREC Precision word; (If IPREC > 0, data are stored with *
-* IPREC significant digits right to the decimal points; if*
-* IPREC < 0, data are stored with IPREC insignificant *
-* digits left to the decimal point.) *
-* CHOPT Character string with any of the following characters *
-* A Trust LBK address if non-zero *
-* B Save in the special backup file; not in standard Journal*
-* C Create Node/Key data structure ala DBUSE *
-* F Updates with a fully matched data object (in user keys) *
-* K Store data only inside the keys (not yet installed) *
-* N Create new (sub)directory(ies) *
-* P Create partitioned subdirectories for the pathname *
-* R Store with full RZ option (No compression to be made) *
-* S Create stand alone (master) data *
-* T Special text type of data (to be used with R) *
-* U Store data uncompressed *
-* Z Store only nonzero elements. An element is considered to*
-* be zero if its absolute value is less than IPREC (real) *
-* 7 Insertion time as supplied by user to be honoured *
-* *
-* Called by user, DBAIWR, DBUPKY *
-* *
-* Error Condition : *
-* *
-* IQUEST(1) = 0 : No error *
-* = 61 : Too many keys *
-* = 62 : Too many keys with option N *
-* = 63 : Data base structure in memory clobbered *
-* = 64 : Error in MZCOPY while copying Data bank *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
-#include "dxused.inc"
- DIMENSION KEY(9), LBD(9), LBK(9), LSUP(9)
- CHARACTER CHOPT*(*), PATHN*(*), CHOP*28
-*
-* ------------------------------------------------------------------
-*
-* *** Decode the character option
-*
- CALL DBOPTS (CHOPT, IRC)
- IF (IRC.NE.0) THEN
- IQUEST(1) = IRC
- GO TO 999
- ENDIF
-*
-* *** Reformat CHOPT
-*
- IOPNDX = 0
- IF (IOPRDX.NE.0) THEN
- IOPYDX = 1
- IOPRDX = 0
- ENDIF
- IF (IOPYDX.NE.0.OR.IOPTDX.NE.0) THEN
- IOPPDX = 0
- ELSE
- IOPPDX = 1
- ENDIF
- IF (IOPSDX.NE.0) THEN
- IOPDDX = 0
- IOPSDX = 0
- ELSE
- IOPDDX = 1
- ENDIF
- IF (IOPUDX.NE.0) THEN
- IOPPDX = 0
- IOPUDX = 0
- ENDIF
- IF (IOKYDX(7).NE.0) THEN
- IOPHDX = 1
- ELSE
- IOPHDX = 0
- ENDIF
- CALL DBOPTM (CHOP)
-*
- CALL DBCKEY (KEY, KEYSDX, MXKYDX)
- CALL CDSTOR (PATHN, LSUP, LBK, IUDIV, KEYSDX, CHOP, IRC)
- IQUEST(1) = IRC
- IF (IRC.EQ.0.AND.IOPCDX.NE.0) THEN
- IF (LBK(1).NE.0) THEN
- LBD(1) = LQ(KOFUCD+LBK(1)-KLDACD)
- ELSE
- LBD(1) = 0
- ENDIF
- ENDIF
-* END DBENTR
- 999 END
diff --git a/src/packlib/hepdb/dbcdif/dbfpat.F b/src/packlib/hepdb/dbcdif/dbfpat.F
deleted file mode 100644
index 601e627..0000000
--- a/src/packlib/hepdb/dbcdif/dbfpat.F
+++ /dev/null
@@ -1,45 +0,0 @@
-*
-* $Id: dbfpat.F,v 1.1.1.1 1996/02/28 16:24:56 mclareni Exp $
-*
-* $Log: dbfpat.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:56 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE DBFPAT (CPATH, LEVMX, LAD)
-* =====================================
-*
-************************************************************************
-* *
-* SUBR. DBFPAT (CPATH, LEVMX, LAD*) *
-* *
-* Store the information of the directory tree CPATH in a bank *
-* *
-* Arguments : *
-* *
-* CPATH The pathname of the directory tree about which the *
-* information has to be provided *
-* LEVMX Number of levels below CPATH about which information *
-* has to be accumulated *
-* LAD(*) Address of the bank containing the information *
-* *
-* Called by DBKEPT, DBACPL *
-* *
-* Error Condition : *
-* *
-* IQUEST(1) = 0 : No error *
-* =161 : Illegal path name *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
- DIMENSION LAD(9)
- CHARACTER CPATH*(*)
-*
-* ------------------------------------------------------------------
-*
- CALL CDFPAT (CPATH, LEVMX, LAD, IRC)
- IQUEST(1) = IRC
-* END DBFPAT
- 999 END
diff --git a/src/packlib/hepdb/dbcdif/dbfree.F b/src/packlib/hepdb/dbcdif/dbfree.F
deleted file mode 100644
index 31af4e8..0000000
--- a/src/packlib/hepdb/dbcdif/dbfree.F
+++ /dev/null
@@ -1,77 +0,0 @@
-*
-* $Id: dbfree.F,v 1.1.1.1 1996/02/28 16:24:57 mclareni Exp $
-*
-* $Log: dbfree.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:57 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE DBFREE (PATHN, LBK, KEYS, CHOPT)
-* ===========================================
-*
-************************************************************************
-* *
-* SUBR. DBFREE (PATHN, LBK, KEYS, CHOPT) *
-* *
-* Declares the given data bank(s) as candidates to be dropped in *
-* case space is needed in the database division. Optionally it *
-* deletes the Data bank(s) (with option D) or the Keys as well as *
-* the Data bank(s) (with option K). *
-* *
-* Arguments : *
-* *
-* PATHN Character string describing the pathname *
-* LBK(*) Address(es) of Keys bank(s) KYCD *
-* KEYS Vector of keys *
-* CHOPT Character string with any of the following characters *
-* A trust LBK address(es) if non-zero *
-* D drop the Data bank(s) supported at link 1 of Key bank(s)*
-* K drop the Key bank(s) as well as Data bank(s) *
-* M expect multiple Key banks *
-* S Key/data was retrieved using 'S' option in DBUSE *
-* 3 start valdity time to be < KEYS(3) (with option S) *
-* 4 end valdity time to be > KEYS(4) (with option S) *
-* 5 specific Program version number required *
-* 7 insertion time to be < KEYS(7) *
-* n consider user key n (7 < n < 29) *
-* *
-* Called by user *
-* *
-* Error Condition : *
-* *
-* IQUEST(1) = 0 : No error *
-* = 51 : Illegal character option *
-* = 52 : No access to the Key banks *
-* = 53 : Pathname not found in the RZ directory *
-* = 54 : Pathname not matched to that found in bank NOCD *
-* = 55 : Too many keys with option M *
-* = 56 : Illegal Key option *
-* = 57 : Illegal pathname *
-* = 58 : Database structure in memory clobbered *
-* = 59 : Some of the expected key banks not found *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
-#include "dxused.inc"
- CHARACTER PATHN*(*), CHOPT*(*), CHOP*28
- DIMENSION LBK(9), KEYS(9)
-*
-* ------------------------------------------------------------------
-*
-* *** Decode the character option
-*
- CALL DBOPTS (CHOPT, IRC)
- IF (IRC.NE.0) THEN
- IQUEST(1) = IRC
- GO TO 999
- ENDIF
- CALL DBOPTM (CHOP)
-*
- CALL DBCKEY (KEYS, KEYSDX, MXKYDX)
-*
- CALL CDFREE (PATHN, LBK, MASKDX, KEYSDX, CHOP, IRC)
- IQUEST(1) = IRC
-* END DBFREE
- 999 END
diff --git a/src/packlib/hepdb/dbcdif/dbfzop.F b/src/packlib/hepdb/dbcdif/dbfzop.F
deleted file mode 100644
index 7973aad..0000000
--- a/src/packlib/hepdb/dbcdif/dbfzop.F
+++ /dev/null
@@ -1,43 +0,0 @@
-*
-* $Id: dbfzop.F,v 1.1.1.1 1996/02/28 16:24:57 mclareni Exp $
-*
-* $Log: dbfzop.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:57 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE DBFZOP (LUNFZ, TOPN, CHOPT)
-* ======================================
-*
-************************************************************************
-* *
-* SUBR. DBFZOP (LUNFZ, TOPN, CHOPT) *
-* *
-* Sets the output FZ file number as the sequential backup file for *
-* a given top directory. One can have up to two backup files, one *
-* for standard journaling, the other for special backups. *
-* *
-* Arguments : *
-* *
-* LUNFZ Logical unit number of the FZ file *
-* TOPN Top directory name to which the FZ file refers *
-* CHOPT Character string with any of the following characters *
-* B Specify a special backup file *
-* *
-* Called by user, DBACTI *
-* *
-* Error Condition : *
-* *
-* IQUEST(1) = 0 : No error *
-* = 60 : Illegal top directory name *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
- CHARACTER TOPN*(*), CHOPT*(*)
-*
- CALL CDFZOP (LUNFZ, TOPN, CHOPT, IRC)
- IQUEST(1) = IRC
-*
- END
diff --git a/src/packlib/hepdb/dbcdif/dbfzup.F b/src/packlib/hepdb/dbcdif/dbfzup.F
deleted file mode 100644
index b93e6a0..0000000
--- a/src/packlib/hepdb/dbcdif/dbfzup.F
+++ /dev/null
@@ -1,49 +0,0 @@
-*
-* $Id: dbfzup.F,v 1.1.1.1 1996/02/28 16:24:57 mclareni Exp $
-*
-* $Log: dbfzup.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:57 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
-#if !defined(CERNLIB__P3CHILD)
- SUBROUTINE DBFZUP (LUNFZ, CHOPT)
-* ================================
-*
-************************************************************************
-* *
-* SUBR. DBFZUP (LUNFZ, CHOPT) *
-* *
-* Updates the data base from transcript file from unit LUNFZ *
-* *
-* Arguments : *
-* *
-* LUNFZ Logical unit number of the FZ file *
-* CHOPT Character string with any of the following characters *
-* F Force continuation beyond errors *
-* O Updating journal file is an external source *
-* S Updating journal file in a single record mode *
-* *
-* Called by user, DBACTI *
-* *
-* Error Condition : *
-* *
-* IQUEST(1) = 0 : No error *
-* = 76 : Cannot form the IO descriptor for the FZ header *
-* =141 : Read error on the FZ file *
-* =142 : Top directory name illegal in the transcript *
-* file *
-* =143 : Illegal path name in the transcript file *
-* = 78 : Illegal number of keys in journal file *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
- CHARACTER CHOPT*(*)
-*
- CALL CDFZUP (LUNFZ, CHOPT, IRC)
- IQUEST(1) = IRC
-*
- END
-#endif
diff --git a/src/packlib/hepdb/dbcdif/dbget.F b/src/packlib/hepdb/dbcdif/dbget.F
deleted file mode 100644
index 8ebb607..0000000
--- a/src/packlib/hepdb/dbcdif/dbget.F
+++ /dev/null
@@ -1,80 +0,0 @@
-*
-* $Id: dbget.F,v 1.1.1.1 1996/02/28 16:24:57 mclareni Exp $
-*
-* $Log: dbget.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:57 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE DBGET (PATHN, LBK, KEYS, CHOPT)
-* ==========================================
-*
-************************************************************************
-* *
-* SUBR. DBGET (PATHN, LBK*, KEYS, CHOPT) *
-* *
-* Prepares the database data structure in memory for any required *
-* Pathname and set of Keys, unless already done. Returns the *
-* in memory for the corresponding Key bank(s) with a selection on *
-* a range of start validity time and user keys. *
-* *
-* Arguments : *
-* *
-* PATHN Character string describing the pathname *
-* LBK(*) Address(es) of Keys bank(s) KYCD. The data bank address *
-* can be obtained as LQ(LBK-1) *
-* For option 'S' it is the support address of the linear *
-* structure *
-* KEYS Vector of keys. Only the elements declared in CHOPT are *
-* assumed to contain useful information. *
-* CHOPT Character string with any of the following characters *
-* K read only the keys (no data is required) *
-* S expect multiple Key banks satisfying selection on a *
-* number of keys *
-* 3 selects objects with start validity time > KEYS(3) *
-* 4 selects objects with start validity time < KEYS(4) *
-* 5 specific Program version number required *
-* 6 select objects with insertion time > KEYS(6) *
-* 7 select objects with insertion time < KEYS(7) *
-* n consider user key n (where 7 < n < 29 ) *
-* *
-* Called by user *
-* *
-* Error Condition : *
-* *
-* IQUEST(1) = 0 : No error *
-* = 2 : Illegal path name *
-* = 32 : No keys/data in this directory *
-* *
-* If IQUEST(1) =0, IQUEST(2) carries information on number of *
-* data objects selected by DBGET *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
-#include "dxused.inc"
- DIMENSION KEYS(9), LBK(9), KYSR(2)
- CHARACTER CHOPT*(*), PATHN*(*), CHOP*28
-*
-* ------------------------------------------------------------------
-*
-* *** Reformat character options
-*
- CALL DBOPTS (CHOPT, IRC)
- IF (IRC.NE.0) THEN
- IQUEST(1) = IRC
- GO TO 999
- ENDIF
- IOPRDX = 0
- CALL DBOPTM (CHOP)
-*
- CALL DBCKEY (KEYS, KEYSDX, MXKYDX)
-*
- KYINM = KEYS(6)
- KYSR(1) = 1
- KYSR(2) = IBIGCD
- CALL CDGETDB (PATHN, LBK, MASKDX, KEYSDX, KYSR, KYINM, CHOPT, IRC)
- IQUEST(1) = IRC
-* END DBGET
- 999 END
diff --git a/src/packlib/hepdb/dbcdif/dbgets.F b/src/packlib/hepdb/dbcdif/dbgets.F
deleted file mode 100644
index 51587d0..0000000
--- a/src/packlib/hepdb/dbcdif/dbgets.F
+++ /dev/null
@@ -1,75 +0,0 @@
-*
-* $Id: dbgets.F,v 1.1.1.1 1996/02/28 16:24:57 mclareni Exp $
-*
-* $Log: dbgets.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:57 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE DBGETS (PATHN, LBK, KEYS, CHOPT)
-* ===========================================
-*
-************************************************************************
-* *
-* SUBR. DBGETS (PATHN, LBK*, KEYS, CHOPT) *
-* *
-* Prepares the database data structure in memory for any required *
-* Pathname and serial number(s), unless already done. Returns the *
-* addresses in memory for the corresponding Key bank(s) and loads *
-* the data part at link 1 of the Key bank(s). *
-* *
-* Arguments : *
-* *
-* PATHN Character string describing the path name *
-* LBK(*) Address(es) of Keys bank(s) KYCD. The data bank address *
-* can be obtained as LQ(LBK-1). For several selected *
-* objects, the Keys banks appear in a linear structure *
-* KEYS Vector of keys. KEYS(1) and (2) should contain the *
-* two limits on the serial number *
-* CHOPT Character string with any of the following characters *
-* K read only the keys (no data is required) *
-* 5 specific Program version number required *
-* 6 select objects with insertion time > KEYS(6) *
-* 7 select objects with insertion time < KEYS(7) *
-* n consider user key n (where 7 < n < 29 ) *
-* *
-* Called by user *
-* *
-* Error Condition : *
-* *
-* IQUEST(1) = 0 : No error *
-* = 2 : Illegal path name *
-* = 32 : No keys/data in this directory *
-* *
-* If IQUEST(1) =0, IQUEST(2) carries information on number of *
-* data objects selected by DBGETS *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
-#include "dxused.inc"
- DIMENSION LBK(9), KEYS(9), KYSR(2)
- CHARACTER CHOPT*(*), PATHN*(*), CHOP*16
-*
-* ------------------------------------------------------------------
-*
-* *** Reformat character options
-*
- CALL DBOPTS (CHOPT, IRC)
- IF (IRC.NE.0) THEN
- IQUEST(1) = IRC
- GO TO 999
- ENDIF
- IOPRDX = 1
- CALL DBOPTM (CHOP)
-*
- CALL DBCKEY (KEYS, KEYSDX, MXKYDX)
-*
- KYINM = KEYS(6)
- KYSR(1) = KEYS(1)
- KYSR(2) = KEYS(2)
- CALL CDGETDB (PATHN, LBK, MASKDX, KEYSDX, KYSR, KYINM, CHOPT, IRC)
- IQUEST(1) = IRC
-* END DBGETS
- 999 END
diff --git a/src/packlib/hepdb/dbcdif/dbgnam.F b/src/packlib/hepdb/dbcdif/dbgnam.F
deleted file mode 100644
index 82915ed..0000000
--- a/src/packlib/hepdb/dbcdif/dbgnam.F
+++ /dev/null
@@ -1,46 +0,0 @@
-*
-* $Id: dbgnam.F,v 1.1.1.1 1996/02/28 16:24:57 mclareni Exp $
-*
-* $Log: dbgnam.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:57 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE DBGNAM (PATH, CHTAG, IOBJ)
-* =====================================
-*
-************************************************************************
-* *
-* SUBR. DBGNAM (PATH, CHTAG, IOBJ*) *
-* *
-* Identifies the object element number from its name and the name *
-* of the directory path name *
-* *
-* Arguments : *
-* *
-* PATH Character string describing the pathname *
-* CHTAG Name of the data element *
-* IOBJ(*) Object element number (0 if not found) *
-* *
-* Called by DBACPL *
-* *
-* Error Condition : *
-* *
-* IQUEST(1) = 0 : No error *
-* =182 : Illegal path name *
-* =201 : DICTIONARY directory not found *
-* =202 : No description of data elements for the given *
-* path name exists in the data base *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
- CHARACTER CHTAG*(*), PATH*(*)
-*
-* ------------------------------------------------------------------
-*
- CALL CDGNAM (PATH, CHTAG, IOBJ, IRC)
- IQUEST(1) = IRC
-* END DBGNAM
- 999 END
diff --git a/src/packlib/hepdb/dbcdif/dbildf.F b/src/packlib/hepdb/dbcdif/dbildf.F
deleted file mode 100644
index 7ce0237..0000000
--- a/src/packlib/hepdb/dbcdif/dbildf.F
+++ /dev/null
@@ -1,45 +0,0 @@
-*
-* $Id: dbildf.F,v 1.1.1.1 1996/02/28 16:24:57 mclareni Exp $
-*
-* $Log: dbildf.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:57 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE DBILDF (LUNI, CHOPT)
-* ===============================
-*
-************************************************************************
-* *
-* SUBR. DBILDF (LUNI, CHOPT) *
-* *
-* Initializes the List of Directories to be always updated from the *
-* journal file (ignore the check of the key 1). *
-* *
-* Arguments : *
-* *
-* LUNI Logical unit number from which the list is read off *
-* CHOPT Character string with any of the following characters *
-* A Add to the previous information *
-* I Ignore all previous information (also current file) *
-* Default Overwrite previous information with the current list *
-* *
-* Called by user, DBACTI *
-* *
-* Error Condition : *
-* *
-* IQUEST(1) = 0 : No error *
-* =232 : Illegal logical unit number *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
- CHARACTER CHOPT*(*)
-*
-* ------------------------------------------------------------------
-*
- CALL CDILDF (LUNI, CHOPT, IRC)
- IQUEST(1) = IRC
-* END DBILDF
- 999 END
diff --git a/src/packlib/hepdb/dbcdif/dbildu.F b/src/packlib/hepdb/dbcdif/dbildu.F
deleted file mode 100644
index cd7c47f..0000000
--- a/src/packlib/hepdb/dbcdif/dbildu.F
+++ /dev/null
@@ -1,47 +0,0 @@
-*
-* $Id: dbildu.F,v 1.1.1.1 1996/02/28 16:24:57 mclareni Exp $
-*
-* $Log: dbildu.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:57 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE DBILDU (LUNI, TOPNM, CHOPT)
-* ======================================
-*
-************************************************************************
-* *
-* SUBR. DBILDU (LUNI, TOPNM, CHOPT) *
-* *
-* Initializes the List of Directories to be Updated from the *
-* journal file. *
-* *
-* Arguments : *
-* *
-* LUNI Logical unit number from which the list is read off *
-* TOPNM Name of the Top Directory *
-* CHOPT Character string with any of the following characters *
-* A Add to the previous information *
-* I Ignore all previous information (also current file) *
-* Default Overwrite previous information with the current list *
-* *
-* Called by user, DBACTI *
-* *
-* Error Condition : *
-* *
-* IQUEST(1) = 0 : No error *
-* =231 : Illegal top directory name *
-* =232 : Illegal logical unit number *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
- CHARACTER CHOPT*(*), TOPNM*(*)
-*
-* ------------------------------------------------------------------
-*
- CALL CDILDU (LUNI, TOPNM, CHOPT, IRC)
- IQUEST(1) = IRC
-* END DBILDU
- 999 END
diff --git a/src/packlib/hepdb/dbcdif/dbin.F b/src/packlib/hepdb/dbcdif/dbin.F
deleted file mode 100644
index c366362..0000000
--- a/src/packlib/hepdb/dbcdif/dbin.F
+++ /dev/null
@@ -1,100 +0,0 @@
-*
-* $Id: dbin.F,v 1.1.1.1 1996/02/28 16:24:58 mclareni Exp $
-*
-* $Log: dbin.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:58 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE DBIN (PATHN, ITIME, IUDIV, LSUP, IPRVS, NWKEY, KEY,
- + IPREC, CHOPT)
-* ==============================================================
-*
-************************************************************************
-* *
-* SUBR. DBIN (PATHN, ITIME, IUDIV, LSUP*, IPRVS, NWKEY*, KEY*, *
-* IPREC*, CHOPT) *
-* *
-* Fetches from disk to memory data valid for a given time *
-* *
-* Restrictions : No selection on user keys can be made *
-* *
-* Arguments : *
-* *
-* PATHN Character string describing the pathname *
-* ITIME Time for which data are required to be valid *
-* IUDIV Division index where bank is expected to be returned *
-* LSUP Address of bank in memory where data have been stored *
-* IPRVS Version number of program used when data were created *
-* (if = 0, accept any) *
-* NWKEY Length of the key vector *
-* KEY Key vector elements *
-* IPREC Precision word; (If IPREC > 0, data are stored with *
-* IPREC significant digits right to the decimal points; if*
-* IPREC < 0, data are stored with IPREC insignificant *
-* digits left to the decimal point.) *
-* CHOPT Character string with any of the following characters *
-* N If data do not exist for ITIME, take the nearest data *
-* object in time *
-* *
-* Called by user *
-* *
-* Error Condition : *
-* *
-* IQUEST(1) = 0 : No error *
-* = 36 : Data bank address zero on return from DBKXIN *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
-#include "hepdb/ckkeys.inc"
-#include "dxused.inc"
- PARAMETER (JBIAS=2)
- DIMENSION KEY(9), LSUP(9), ITIME(9)
- CHARACTER CHOPT*(*), PATHN*(*), CHOPF*28
-*
-* ------------------------------------------------------------------
-*
-* *** Reformat option
-*
- CALL DBOPTS (CHOPT, IRC)
- IF (IRC.NE.0) THEN
- IQUEST(1) = IRC
- GO TO 999
- ENDIF
- IOPFDX = 1
- CALL DBOPTM (CHOPF)
-*
-* *** Setup a call to CDUSEM
-*
- CALL VZERO (MASKDX, MXCMCK)
- CALL VZERO (KEYSDX, MXCMCK)
- IF (IPRVS.NE.0) THEN
- KEYSDX(IDHUSI) = IPRVS
- MASKDX(IDHUSI) = 1
- ENDIF
- LKEYDX = 0
- CALL CDUSEM (PATHN, LKEYDX, ITIME, MASKDX, KEYSDX, CHOPF, IRC)
- IF (IRC.NE.0) THEN
- IQUEST(1) = IRC
- GO TO 999
- ELSE IF (LKEYDX.EQ.0.OR.LQ(KOFUCD+LKEYDX-KLDACD).EQ.0) THEN
- IQUEST(1) = 36
- GO TO 999
- ENDIF
-*
- LBN = LQ(KOFUCD+LKEYDX-KLNOCD)
- NDK = IQ(KOFUCD+LKEYDX-1)
- NWKEY = IQ(KOFUCD+LBN+MNDNWK)
- IPREC = IQ(KOFUCD+LKEYDX+NDK+MKYPRE)
- CALL UCOPY (IQ(KOFUCD+LKEYDX+1), KEY, NWKEY)
- LDATDX = LQ(KOFUCD+LKEYDX-KLDACD)
- IF (IDIVCD.NE.IUDIV) THEN
- CALL MZCOPY (IDIVCD, LDATDX, IUDIV, LSUP(1), JBIAS, 'LP')
- ELSE
- CALL ZSHUNT (IDIVCD, LDATDX, LSUP(1), JBIAS, 2, 0)
- IQUEST(1) = 0
- ENDIF
-* END DBIN
- 999 END
diff --git a/src/packlib/hepdb/dbcdif/dbinct.F b/src/packlib/hepdb/dbcdif/dbinct.F
deleted file mode 100644
index 40dc301..0000000
--- a/src/packlib/hepdb/dbcdif/dbinct.F
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: dbinct.F,v 1.1.1.1 1996/02/28 16:24:58 mclareni Exp $
-*
-* $Log: dbinct.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:58 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE DBINCT (IDTMI, ISADD, IDTMO)
-* =======================================
-*
-************************************************************************
-* *
-* SUBR. DBINCT (IDTMI, ISADD, IDTMO*) *
-* *
-* Converts packed date and time (ala DBPKTS) to a similar packed *
-* number after adding a fixed time in seconds *
-* *
-* Arguments : *
-* *
-* IDTMI Packed date-time (ala DBPKTS) on input *
-* ISADD Incremental time to IDTMI in seconds *
-* IDTMO Packed date-time (ala DBPKTS) on output *
-* *
-* Called by user *
-* *
-************************************************************************
-*
- CALL CDINCT (IDTMI, ISADD, IDTMO, IRC)
-* END DBINCT
- END
diff --git a/src/packlib/hepdb/dbcdif/dbinit.F b/src/packlib/hepdb/dbcdif/dbinit.F
deleted file mode 100644
index 03ab4cf..0000000
--- a/src/packlib/hepdb/dbcdif/dbinit.F
+++ /dev/null
@@ -1,82 +0,0 @@
-*
-* $Id: dbinit.F,v 1.1.1.1 1996/02/28 16:24:58 mclareni Exp $
-*
-* $Log: dbinit.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:58 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE DBINIT (IDIV, LUNRZ, TOPNM, LTOP, NRECS, CHOPT)
-* ==========================================================
-*
-************************************************************************
-* *
-* SUBR. DBINIT (IDIV, LUNRZ, TOPNM, LTOP*, NRECS, CHOPT) *
-* *
-* Initializes of the Data Base Package (for each file) *
-* *
-* Arguments : *
-* *
-* IDIV User Division *
-* LUNRZ RZ file unit *
-* TOPNM Name of the Top Directory *
-* LTOP Address of the top directory *
-* NRECS Number of records for primary allocation (for RZMAKE) *
-* If less than or equal to 0 use existing RZ file (RZFILE)*
-* CHOPT Character Option : Same as in RZFILE / RZMAKE *
-* Z Reinitialize the random access file (use RZMAKE) *
-* (also NRECS > 0 is required) *
-* *
-* Called by user, DBACTI *
-* *
-* Error Condition : *
-* *
-* IQUEST(1) = 0 : No error *
-* = -1 : Invalid top directory name *
-* = -2 : The file is already open with correct LUNRZ and *
-* TOPNM *
-* = -3 : The file is already open with wrong LUNRZ or *
-* TOPNM *
-* = -4 : Already a file is opened with the same unique *
-* identifier as requested for this TOPNM *
-#if (defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))&&(!defined(CERNLIB__P3CHILD))&&(defined(CERNLIB__ONLINE))
-* = -5 : Invalid process name in Online context *
-* = -6 : Error in IC_BOOK for booking the CACHE *
-* = -7 : Error in CC_SETUP for reserving the CLUSCOM *
-#endif
-#if (defined(CERNLIB_UNIX)||defined(CERNLIB_IBMVM)||defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))&&(!defined(CERNLIB__P3CHILD))&&(!defined(CERNLIB__ONLINE))
-* = -8 : Cannot open journal file in server context *
-#endif
-#if defined(CERNLIB__P3CHILD)
-* = -9 : Unable to open FZ communication channel *
-* = -10: Host unable to open RZ file *
-#endif
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
-#include "dxused.inc"
- CHARACTER CHOPT*(*), TOPNM*(*)
- DIMENSION LTOP(9)
- LOGICAL DONE
- SAVE DONE
- DATA DONE /.FALSE./
-*
-* ------------------------------------------------------------------
-*
- IF (.NOT.DONE) THEN
- DONE = .TRUE.
- CALL MZLINK (IDIV, '/DXUSER/', LDATDX, LDATDX, LKEYDX)
- CALL VZERO (MASKDX, MXKYDX)
- CALL VZERO (IOKYDX, MXKYDX)
- ENDIF
- NTOP = IQUEST(1)
- NPAIR = 1
- LUFZ = 0
- CALL CDINIT (IDIV, LUNRZ,LUFZ, TOPNM,NPAIR,NRECS,NTOP, CHOPT, IRC)
- LTOP(1) = 0
- IQUEST(1) = IRC
- IF (IQUEST(1).EQ.0) LTOP(1) = LBUPCD
-* END DBINIT
- END
diff --git a/src/packlib/hepdb/dbcdif/dbkept.F b/src/packlib/hepdb/dbcdif/dbkept.F
deleted file mode 100644
index eaa48e9..0000000
--- a/src/packlib/hepdb/dbcdif/dbkept.F
+++ /dev/null
@@ -1,46 +0,0 @@
-*
-* $Id: dbkept.F,v 1.1.1.1 1996/02/28 16:24:58 mclareni Exp $
-*
-* $Log: dbkept.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:58 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE DBKEPT (PATHS, NPATH, CHOPT)
-* =======================================
-*
-************************************************************************
-* *
-* SUBR. DBKEPT (PATHS, NPATH, CHOPT) *
-* *
-* Deletes all directory trees from the data base except the ones *
-* specified by the user *
-* *
-* Arguments : *
-* *
-* PATHS Path names to be kept *
-* NPATH Number of paths to be kept *
-* CHOPT Character string with any of the following characters *
-* B Save in the special backup file; not in standard Journal*
-* *
-* Called by user, DBAUXI *
-* *
-* Error Condition : *
-* *
-* IQUEST(1) = 0 : No error *
-* =211 : Illegal number of paths *
-* =212 : Illegal path name *
-* =213 : Conflicting top directory names *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
- CHARACTER*(*) PATHS(*), CHOPT
-*
-* ------------------------------------------------------------------
-*
- CALL CDKEEP (PATHS, NPATH, CHOPT, IRC)
- IQUEST(1) = IRC
-* END DBKEPT
- 999 END
diff --git a/src/packlib/hepdb/dbcdif/dbkin.F b/src/packlib/hepdb/dbcdif/dbkin.F
deleted file mode 100644
index 2553270..0000000
--- a/src/packlib/hepdb/dbcdif/dbkin.F
+++ /dev/null
@@ -1,86 +0,0 @@
-*
-* $Id: dbkin.F,v 1.1.1.1 1996/02/28 16:24:58 mclareni Exp $
-*
-* $Log: dbkin.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:58 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE DBKIN (PATHN, KEY1S, IUDIV, LBD, LSUP, JBIAS, IPREC)
-* ===============================================================
-*
-************************************************************************
-* *
-* SUBR. DBKIN (PATHN, KEY1S, IUDIV, LBD*, LSUP, JBIAS, IPREC*) *
-* *
-* Fetches from disk to a ZEBRA bank data valid for a given Key *
-* serial number (as stored inside the directory) *
-* *
-* Arguments : *
-* *
-* PATHN Character string describing the pathname *
-* KEY1S Serial number of the data to be fetched *
-* IUDIV Division index where bank is expected *
-* LBD(*) Address of the bank in memory *
-* LSUP Supporting link of the bank (see MZBOOK) *
-* JBIAS Link bias for creating the data bank (see MZBOOK) *
-* IPREC(*) Precision word; (If IPREC > 0, data are stored with *
-* IPREC significant digits right to the decimal points; if*
-* IPREC < 0, data are stored with IPREC insignificant *
-* digits left to the decimal point.) *
-* *
-* Called by user *
-* *
-* Error Condition : *
-* *
-* IQUEST(1) = 0 : No error *
-* = 31 : Illegal path name *
-* = 32 : No key or data in the path name *
-* *
-************************************************************************
-*
-#include "hepdb/caopts.inc"
-#include "hepdb/cdcblk.inc"
-#include "hepdb/ckkeys.inc"
-#include "hepdb/ctpath.inc"
- DIMENSION LSUP(9), LBD(9), ITIME(MXPACD)
- CHARACTER PATH*80, PATHN*(*)
-*
-* ------------------------------------------------------------------
-*
-* *** Set the character option
-*
- CALL CDOPTS (' ', IRC)
- IF (IRC.NE.0) GO TO 900
- IOKYCA(IDHKSN) = 1
-*
-* *** Set the current directory
-*
- CALL CDLDUP (PATHN, 0, IRC)
- IF (IRC.NE.0) GO TO 900
- DO 10 I = 1, NPARCD
- ITIME(I) = 1
- 10 CONTINUE
- CALL CDKEYT
-*
- IF (NKEYCK.LE.0) THEN
- IRC = 32
-#if defined(CERNLIB__DEBUG)
- NCHAR = LENOCC (PAT1CT)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' DBKIN : No key '//
- + 'or data for Path Name '//PAT1CT(1:NCHAR)//''')', IARGCD, 0)
-#endif
- GO TO 900
- ENDIF
-*
-* *** Read in the data
-*
- CALL VZERO (KEYVCK, NWKYCK)
- KEYVCK(IDHKSN) = KEY1S
- CALL CDKXIN (ITIME, IUDIV, LBD(1), LSUP(1), JBIAS, NWKEY, KEYVCK,
- + IPREC, IRC)
- 900 IQUEST(1) = IRC
- IOKYCA(IDHKSN) = 0
-* END DBKIN
- 999 END
diff --git a/src/packlib/hepdb/dbcdif/dbktyp.F b/src/packlib/hepdb/dbcdif/dbktyp.F
deleted file mode 100644
index a03aef8..0000000
--- a/src/packlib/hepdb/dbcdif/dbktyp.F
+++ /dev/null
@@ -1,64 +0,0 @@
-*
-* $Id: dbktyp.F,v 1.1.1.1 1996/02/28 16:24:59 mclareni Exp $
-*
-* $Log: dbktyp.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:59 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE DBKTYP (PATHN, NKEYS, IOTY, CTAG)
-* ============================================
-*
-************************************************************************
-* *
-* SUBR. DBKTYP (PATHN, *NKEYS*, IOTY*, CTAG*) *
-* *
-* Gets the key types and their tags for a given directory *
-* *
-* Arguments : *
-* *
-* PATHN Character string describing the pathname *
-* NKEYS On input it carries the maximum dimension of IOTY and *
-* CTAG; on output it carries number of key elements (if *
-* no error; -1 if error) *
-* IOTY Type of each key element *
-* CTAG Tag for each element *
-* *
-* Called by user *
-* *
-* Error Condition : *
-* *
-* IQUEST(1) = 0 : No error *
-* =101 : Illegal path name *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
-#include "hepdb/ckkeys.inc"
- CHARACTER*(*) CTAG(*)
- CHARACTER PATHN*(*), PATH*80
- DIMENSION IOTY(9)
-*
-* ------------------------------------------------------------------
-*
-* *** Set the current directory
-*
- CALL CDLDUP (PATHN, 0, IRC)
- IF (IRC.NE.0) THEN
- IQUEST(1) = IRC
- NKEYS = -1
- GO TO 999
- ENDIF
- CALL CDKYTG
-*
-* *** Fill up the user vectors
-*
- NKMAX = MIN0 (NKEYS, NWKYCK)
- DO 10 I = 1, NKMAX
- IOTY(I) = IOTYCK(I)
- CTAG(I) = CTAGCK(I)
- 10 CONTINUE
- NKEYS = NWKYCK
-* END DBKTYP
- 999 END
diff --git a/src/packlib/hepdb/dbcdif/dbkvin.F b/src/packlib/hepdb/dbcdif/dbkvin.F
deleted file mode 100644
index 877efdb..0000000
--- a/src/packlib/hepdb/dbcdif/dbkvin.F
+++ /dev/null
@@ -1,142 +0,0 @@
-*
-* $Id: dbkvin.F,v 1.1.1.1 1996/02/28 16:24:59 mclareni Exp $
-*
-* $Log: dbkvin.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:59 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE DBKVIN (PATHN, ITIME, USER, NDAT, IDTYP, IPRVS, NWKEY,
- + KEY, IPREC, CHOPT)
-* =================================================================
-*
-************************************************************************
-* *
-* SUBR. DBKVIN (PATHN, ITIME, USER*, *NDAT*, IDTYP*, IPRVS, *
-* NWKEY*, *KEY*, IPREC*, CHOPT) *
-* *
-* Fetches from disk to a FORTRAN array data valid for a given time *
-* *
-* Restrictions : USER should contain variables of the same type *
-* (Integer, Real or Holllereith) *
-* One should be very careful in using this routine. *
-* The use of character option should be handled with *
-* caution. *
-* *
-* Arguments : *
-* *
-* PATHN Character string describing the pathname *
-* ITIME Time for which data are required to be valid *
-* USER User array where data are stored *
-* NDAT Maximum dimension of USER array (on input) *
-* Number of data words fetched from disk (on output) *
-* IDTYP Type of the data (2 - integer; 3 - real; 5 - Hollereith)*
-* IPRVS Program version number for selecting the data *
-* (if 0 no selection on program version number to be made)*
-* NWKEY Length of the key vector *
-* KEY Key vector elements (If any User key or key 5 is nonzero*
-* at input, data are retrieved according to that key *
-* content; on output it contains key elements for the *
-* data) *
-* IPREC Precision word; (If IPREC > 0, data are stored with *
-* IPREC significant digits right to the decimal points; if*
-* IPREC < 0, data are stored with IPREC insignificant *
-* digits leftto the decimal point.) *
-* CHOPT Character string with any of the following characters *
-* N If data do not exist for ITIME, take the nearest data *
-* object in time *
-* *
-* Called by user *
-* *
-* Error Condition : *
-* *
-* IQUEST(1) = 0 : No error *
-* = 31 : Illegal path name *
-* = 32 : No keys/data in this directory *
-* = 36 : Data bank address zero on return from DBKXIN *
-* = 37 : Insufficient space in USER store array *
-* *
-************************************************************************
-*
-#include "hepdb/caopts.inc"
-#include "hepdb/cdcblk.inc"
-#include "hepdb/cinitl.inc"
-#include "hepdb/ckkeys.inc"
-#include "dxused.inc"
- DIMENSION KEY(9), USER(2)
- CHARACTER CHOPT*(*), PATHN*(*), CHOPF*28
-*
-* ------------------------------------------------------------------
-*
-* *** Reformat option
-*
- CALL DBOPTS (CHOPT, IRC)
- IF (IRC.NE.0) THEN
- IQUEST(1) = IRC
- GO TO 999
- ENDIF
- IOPFDX = 1
- CALL DBOPTM (CHOPF)
-*
- CALL DBCKEY (KEY, KEYSDX, MXKYDX)
- IF (IPRVS.NE.0) THEN
- KEYSDX(IDHUSI) = IPRVS
- MASKDX(IDHUSI) = 1
- ENDIF
- DO 10 I = NOF2CK+3, MXDMCK
- IF (KEYSDX(I).NE.0) MASKDX(I) = 1
- 10 CONTINUE
-*
-* *** Read in the data
-*
- LKEYDX = 0
- CALL CDUSEM (PATHN, LKEYDX, ITIME, MASKDX, KEYSDX, CHOPF, IRC)
- IF (IRC.NE.0) THEN
- IQUEST(1) = IRC
- GO TO 999
- ELSE IF (LKEYDX.EQ.0.OR.LQ(KOFUCD+LKEYDX-KLDACD).EQ.0) THEN
- IQUEST(1) = 36
- GO TO 999
- ENDIF
-*
- LBN = LQ(KOFUCD+LKEYDX-KLNOCD)
- NDK = IQ(KOFUCD+LKEYDX-1)
- NWKEY = IQ(KOFUCD+LBN+MNDNWK)
- IPREC = IQ(KOFUCD+LKEYDX+NDK+MKYPRE)
- CALL UCOPY (IQ(KOFUCD+LKEYDX+1), KEY, NWKEY)
- LDATDX = LQ(KOFUCD+LKEYDX-KLDACD)
-*
-* ** See if the USER array size is sufficient to store the data
-*
- ND = IQ(KOFUCD+LDATDX-1)
- IF (ND.GT.NDAT) THEN
-*
-* * Insufficient space
-*
- CALL MZDROP (IDIVCD, LDATDX, 'L')
- IQUEST(1) = 37
- IQUEST(11)= NDAT
- IQUEST(12)= ND
- NDAT = 0
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) THEN
- CALL CDPRNT (LPRTCD, '(/,'' DBKVIN : Insufficient space'//
- + ' '',I10,'' to store data - a minimum of '',I10,'' '//
- + 'storage is needed'')', IQUEST(11), 2)
- ENDIF
-#endif
-*
- ELSE
-*
-* * Every thing is OK
-*
- IDTYP = ICDTYP(LDATDX)
- CALL UCOPY (Q(KOFUCD+LDATDX+1), USER(1), ND)
- NDAT = ND
- CALL MZDROP (IDIVCD, LDATDX, 'L')
- IQUEST(1) = 0
-*
- ENDIF
-* END DBKVIN
- 999 END
diff --git a/src/packlib/hepdb/dbcdif/dbkxin.F b/src/packlib/hepdb/dbcdif/dbkxin.F
deleted file mode 100644
index 42129bd..0000000
--- a/src/packlib/hepdb/dbcdif/dbkxin.F
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: dbkxin.F,v 1.1.1.1 1996/02/28 16:24:59 mclareni Exp $
-*
-* $Log: dbkxin.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:59 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE DBKXIN (ITIME, IUDIV, LU, LSUP, JBIAS, NWKEY, KEY,
- + IPREC)
-#include "hepdb/cdcblk.inc"
- DIMENSION ITIME(9), KEY(9), LSUP(9), LU(9)
-*
- CALL CDKXIN (ITIME, IUDIV, LU, LSUP, JBIAS, NWKEY, KEY, IPREC,IRC)
- IQUEST(1) = IRC
-*
- END
diff --git a/src/packlib/hepdb/dbcdif/dblast.F b/src/packlib/hepdb/dbcdif/dblast.F
deleted file mode 100644
index 26fd5a3..0000000
--- a/src/packlib/hepdb/dbcdif/dblast.F
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: dblast.F,v 1.1.1.1 1996/02/28 16:25:00 mclareni Exp $
-*
-* $Log: dblast.F,v $
-* Revision 1.1.1.1 1996/02/28 16:25:00 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- LOGICAL FUNCTION DBLAST (LBK)
-* =============================
-*
-************************************************************************
-* *
-* FUNC. DBLAST (LBK) *
-* *
-* Checks if the Key bank corresponds to the last inserted object *
-* *
-* Arguments : *
-* *
-* LBK Address of the key bank *
-* *
-* Called by user *
-* *
-* Error Condition : *
-* *
-* IQUEST(1) = 0 : No error *
-* =131 : Illegal pathname in the Key bank *
-* =132 : Illegal number of keys in the directory *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
- LOGICAL CDLAST
- DIMENSION LBK(9)
-* ------------------------------------------------------------------
-*
- DBLAST = CDLAST (LBK, IRC)
- IQUEST(1) = IRC
-* END DBLAST
- 999 END
diff --git a/src/packlib/hepdb/dbcdif/dblkey.F b/src/packlib/hepdb/dbcdif/dblkey.F
deleted file mode 100644
index 1a900f2..0000000
--- a/src/packlib/hepdb/dbcdif/dblkey.F
+++ /dev/null
@@ -1,49 +0,0 @@
-*
-* $Id: dblkey.F,v 1.1.1.1 1996/02/28 16:25:00 mclareni Exp $
-*
-* $Log: dblkey.F,v $
-* Revision 1.1.1.1 1996/02/28 16:25:00 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE DBLKEY (PATHN, KEY1, IDATE, ITIME)
-* =============================================
-*
-************************************************************************
-* *
-* SUBR. DBLKEY (PATHN, KEY1*, IDATE*, ITIME*) *
-* *
-* Finds the latest inserted object for a given directory *
-* (Adapted from P.Bagnaia) *
-* *
-* Arguments : *
-* *
-* PATHN Character string describing the pathname *
-* KEY1 The highest key(1) of the directory *
-* IDATE Date (YYMMDD) of the insertion of the last element *
-* ITIME Time (HHMM) " " " " " " " *
-* *
-* Called by user *
-* *
-* Error Condition : *
-* *
-* IQUEST(1) = 0 : No error *
-* =131 : Illegal pathname *
-* =132 : Illegal number of keys in the directory *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
-#include "hepdb/ckkeys.inc"
-#include "dxused.inc"
- CHARACTER PATHN*(*)
- DIMENSION KEY(MXDMCK)
-*
-* ------------------------------------------------------------------
-*
- CALL CDLKEY (PATHN, KEYSDX, IDATE, ITIME, 'K', IRC)
- IQUEST(1) = IRC
- KEY1 = KEYSDX(IDHKSN)
-* END DBLKEY
- 999 END
diff --git a/src/packlib/hepdb/dbcdif/dblmod.F b/src/packlib/hepdb/dbcdif/dblmod.F
deleted file mode 100644
index bc78769..0000000
--- a/src/packlib/hepdb/dbcdif/dblmod.F
+++ /dev/null
@@ -1,42 +0,0 @@
-*
-* $Id: dblmod.F,v 1.1.1.1 1996/02/28 16:25:00 mclareni Exp $
-*
-* $Log: dblmod.F,v $
-* Revision 1.1.1.1 1996/02/28 16:25:00 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE DBLMOD (PATHN, IDATE, ITIME)
-* =======================================
-*
-************************************************************************
-* *
-* SUBR. DBLMOD (PATHN, IDATE*, ITIME*) *
-* *
-* Finds the date of last modification in a given directory *
-* *
-* Arguments : *
-* *
-* PATHN Character string describing the pathname *
-* IDATE(*) Date (YYMMDD) of last modification *
-* ITIME(*) Time (HHMM) for the last modification *
-* *
-* Called by user *
-* *
-* Error Condition : *
-* *
-* IQUEST(1) = 0 : No error *
-* =131 : Illegal pathname *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
- CHARACTER PATHN*(*)
-*
-* ------------------------------------------------------------------
-*
- CALL CDLMOD (PATHN, IDATE, ITIME, 'R', IRC)
- IQUEST(1) = IRC
-* END DBLMOD
- 999 END
diff --git a/src/packlib/hepdb/dbcdif/dblogl.F b/src/packlib/hepdb/dbcdif/dblogl.F
deleted file mode 100644
index a8af57e..0000000
--- a/src/packlib/hepdb/dbcdif/dblogl.F
+++ /dev/null
@@ -1,47 +0,0 @@
-*
-* $Id: dblogl.F,v 1.1.1.1 1996/02/28 16:25:00 mclareni Exp $
-*
-* $Log: dblogl.F,v $
-* Revision 1.1.1.1 1996/02/28 16:25:00 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE DBLOGL (LUNRZ, LOGLV)
-* ================================
-*
-************************************************************************
-* *
-* SUBR. DBLOGL (LUNRZ, LOGLV) *
-* *
-* Set the level of debug information *
-* *
-* Arguments : *
-* *
-* LUNRZ RZ file unit *
-* LOGLV Level of debug output *
-* *
-* Called by user, DBACTI *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
- CHARACTER TOPN*16
-*
-* ------------------------------------------------------------------
-*
- IQUEST(1) = 0
- IDEBCD = LOGLV
- LFIXCD = LTOPCD
- 10 IF (LFIXCD.EQ.0) GO TO 999
- IF (LUNRZ.NE.IQ(KOFUCD+LFIXCD+MUPLUN)) THEN
- LFIXCD = LQ(KOFUCD+LFIXCD)
- GO TO 10
- ENDIF
- NCH = IQ(KOFUCD+LFIXCD+MUPNCH)
- CALL UHTOC (IQ(KOFUCD+LFIXCD+MUPNAM), 4, TOPN, NCH)
- TOPN = TOPN(1:NCH)
- CALL CDLOGL (TOPN, LOGLV, ' ', IRC)
- IQUEST(1) = IRC
-* END DBLOGL
- 999 END
diff --git a/src/packlib/hepdb/dbcdif/dbmdip.F b/src/packlib/hepdb/dbcdif/dbmdip.F
deleted file mode 100644
index 69de124..0000000
--- a/src/packlib/hepdb/dbcdif/dbmdip.F
+++ /dev/null
@@ -1,78 +0,0 @@
-*
-* $Id: dbmdip.F,v 1.1.1.1 1996/02/28 16:25:00 mclareni Exp $
-*
-* $Log: dbmdip.F,v $
-* Revision 1.1.1.1 1996/02/28 16:25:00 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE DBMDIP (PATHN, NWKEY, CHFOR, CHTAG, MXKP)
-* ====================================================
-*
-************************************************************************
-* *
-* SUBR. DBMDIP (PATHN, NWKEY, CHFOR, CHTAG, MXKP) *
-* *
-* Creates Directories with the conventions of DB package for *
-* partitioned data sets *
-* *
-* Arguments : *
-* *
-* PATHN Path name of the directory *
-* NWKEY Number of words associated to the keys at the lowest *
-* level (If some directory in the pathname at a higher *
-* level does not exist, it is created with 9 keys) *
-* CHFOR Character variable describing each element of the key *
-* vector at the lowest level (at higher level it is set *
-* to default, i.e., 'IIIIIIIII') *
-* The first 7 characters should be 'I' *
-* CHTAG Character array defined as CHARACTER*8 (NWKEY) *
-* The first 7 elements should be : 'SERIAL_#' *
-* 'POINTER ' *
-* 'STR_VALI' *
-* 'END_VALI' *
-* 'PRG_VERS' *
-* 'FLAGS ' *
-* 'INS_TIME' *
-* MXKP Maximum number of objects in each partition *
-* *
-* Called by user *
-* *
-* Error Condition : *
-* *
-* IQUEST(1) = 0 : No error *
-* = 43 : Too many key elements *
-* = 44 : Cannot find the top directory name *
-* (wrong initialisation) *
-* = 45 : Illegal Path name *
-* = 48 : Error in directory search sequence *
-* *
-************************************************************************
-*
-#include "hepdb/ckkeys.inc"
-#include "hepdb/cuserf.inc"
-#include "dxused.inc"
- COMMON /QUEST/ IQUEST(100)
- CHARACTER CTAG(100)*8, CFOR*100, CHOPT*4
- CHARACTER*(*) CHFOR, PATHN, CHTAG(*)
-*
-* ------------------------------------------------------------------
-*
-* *** Check on format and tags of the DB system keys
-*
- NKEYS = NWKEY - NSYSDX
- DO I = NSYSDX+1, NWKEY
- CTAG(I-NSYSDX) = CHTAG(I)
- ENDDO
- NCF = LEN(CHFOR)
- IF (NCF.GT.NSYSDX) THEN
- CFOR = CHFOR(NSYSDX+1:NCF)
- ELSE
- CFOR = ' '
- ENDIF
- CHOPT = 'CP'
- CALL CDMDIR (PATHN,NKEYS, CFOR,CTAG,MXKP, IPRECU,DELTCU,CHOPT,IRC)
- IQUEST(1) = IRC
-* END DBMDIP
- 999 END
diff --git a/src/packlib/hepdb/dbcdif/dbmdir.F b/src/packlib/hepdb/dbcdif/dbmdir.F
deleted file mode 100644
index 95ab024..0000000
--- a/src/packlib/hepdb/dbcdif/dbmdir.F
+++ /dev/null
@@ -1,76 +0,0 @@
-*
-* $Id: dbmdir.F,v 1.1.1.1 1996/02/28 16:25:00 mclareni Exp $
-*
-* $Log: dbmdir.F,v $
-* Revision 1.1.1.1 1996/02/28 16:25:00 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE DBMDIR (PATHN, NWKEY, CHFOR, CHTAG)
-* ==============================================
-*
-************************************************************************
-* *
-* SUBR. DBMDIR (PATHN, NWKEY, CHFOR, CHTAG) *
-* *
-* Creates Directories with the conventions of DB package *
-* *
-* Arguments : *
-* *
-* PATHN Path name of the directory *
-* NWKEY Number of words associated to the keys at the lowest *
-* level (If some directory in the pathname at a higher *
-* level does not exist, it is created with 9 keys) *
-* CHFOR Character variable describing each element of the key *
-* vector at the lowest level (at higher level it is set *
-* to default, i.e., 'IIIIIIIII') *
-* The first 7 characters should be 'I' *
-* CHTAG Character array defined as CHARACTER*8 (NWKEY) *
-* The first 7 elements should be : 'SERIAL_#' *
-* 'POINTER ' *
-* 'STR_VALI' *
-* 'END_VALI' *
-* 'PRG_VERS' *
-* 'FLAGS ' *
-* 'INS_TIME' *
-* *
-* Called by user *
-* *
-* Error Condition : *
-* *
-* IQUEST(1) = 0 : No error *
-* = 43 : Too many key elements *
-* = 44 : Cannot find the top directory name *
-* (wrong initialisation) *
-* = 45 : Illegal Path name *
-* = 47 : The Directory already exists *
-* = 48 : Error in directory search sequence *
-* *
-************************************************************************
-*
-#include "hepdb/ckkeys.inc"
-#include "hepdb/cuserf.inc"
-#include "dxused.inc"
- COMMON /QUEST/ IQUEST(100)
- CHARACTER CTAG(100)*8, CFOR*100, CHOPT*4
- CHARACTER*(*) CHFOR, PATHN, CHTAG(*)
-*
-* ------------------------------------------------------------------
-*
- NKEYS = NWKEY - NSYSDX
- DO I = NSYSDX+1, NWKEY
- CTAG(I-NSYSDX) = CHTAG(I)
- ENDDO
- NCF = LEN(CHFOR)
- IF (NCF.GT.NSYSDX) THEN
- CFOR = CHFOR(NSYSDX+1:NCF)
- ELSE
- CFOR = ' '
- ENDIF
- CHOPT = 'C'
- MXKP = 0
- CALL CDMDIR (PATHN,NKEYS, CFOR,CTAG,MXKP, IPRECU,DELTCU,CHOPT,IRC)
- IQUEST(1) = IRC
-* END DBMDIR
- 999 END
diff --git a/src/packlib/hepdb/dbcdif/dbntop.F b/src/packlib/hepdb/dbcdif/dbntop.F
deleted file mode 100644
index 139fe19..0000000
--- a/src/packlib/hepdb/dbcdif/dbntop.F
+++ /dev/null
@@ -1,55 +0,0 @@
-*
-* $Id: dbntop.F,v 1.1.1.1 1996/02/28 16:25:01 mclareni Exp $
-*
-* $Log: dbntop.F,v $
-* Revision 1.1.1.1 1996/02/28 16:25:01 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE DBNTOP (PATHI, PATHO, MXKP0, NSAV, CHOPT)
-* ====================================================
-*
-************************************************************************
-* *
-* SUBR. DBNTOP (PATHI, PATHO, MXKP0, NSAV, CHOPT) *
-* *
-* Transforms the contents of a non-partitioned directory to a *
-* partitioned directory. *
-* *
-* Arguments : *
-* *
-* PATHI Character string describing the input pathname *
-* PATHO Character string describing the output pathname *
-* MXKP0 Maximum number of objects in the partitioned directory *
-* NSAV Maximum number of objects to be entered in one go *
-* (default is 20) *
-* CHOPT Character string with any of the following characters *
-* B Save in the special backup file; not in standard Journal*
-* F Updates with a fully matched data object (in user keys) *
-* *
-* Called by user, DBACTI *
-* *
-* Error Condition : *
-* *
-* IQUEST(1) = 0 : No error *
-* = 68 : Input directory is partitioned *
-* = 71 : Illegal path name *
-* = 73 : RZOUT fails to write on disk *
-* = 74 : Error in RZRENK in updating key values for *
-* partitioned data set *
-* = 75 : Cannot find the Top directory name in pathname *
-* = 76 : Cannot form the IO descriptor for the FZ header *
-* = 77 : FZOUT fails to write on to the sequential file *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
- CHARACTER PATHI*(*), PATHO*(*), CHOPT*(*)
-*
-* ------------------------------------------------------------------
-*
- CALL CDPART (PATHI, PATHO, MXKP0, CHOPT, IRC)
- IQUEST(1) = IRC
-* END DBNTOP
- 999 END
diff --git a/src/packlib/hepdb/dbcdif/dboptm.F b/src/packlib/hepdb/dbcdif/dboptm.F
deleted file mode 100644
index efae7b3..0000000
--- a/src/packlib/hepdb/dbcdif/dboptm.F
+++ /dev/null
@@ -1,48 +0,0 @@
-*
-* $Id: dboptm.F,v 1.1.1.1 1996/02/28 16:25:03 mclareni Exp $
-*
-* $Log: dboptm.F,v $
-* Revision 1.1.1.1 1996/02/28 16:25:03 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE DBOPTM (CHOPT)
-* =========================
-*
-************************************************************************
-* *
-* SUBR. DBOPTM (CHOPT*) *
-* *
-* Encode the content of DXUSED into a character option *
-* *
-* Arguments : *
-* *
-* CHOPT Character option to be supplied to HEPDB *
-* *
-* Called by various routines in the patch DBCDFC *
-* *
-************************************************************************
-*
-#include "hepdb/caopti.inc"
-#include "dxused.inc"
- DIMENSION IOPTS(26)
- EQUIVALENCE (IOPADX, IOPTS(1))
- CHARACTER CHOPT*(*)
-*
-* ------------------------------------------------------------------
-*
- NDOP = 0
- CHOPT = ' '
- DO 10 I = 1, 26
- IF (IOPTS(I).NE.0) THEN
- IF (NDOP.EQ.0) THEN
- CHOPT = CALFCA(I)
- ELSE
- CHOPT = CHOPT(1:NDOP)//CALFCA(I)
- ENDIF
- NDOP = NDOP + 1
- ENDIF
- 10 CONTINUE
-* END DBOPTM
- END
diff --git a/src/packlib/hepdb/dbcdif/dbopts.F b/src/packlib/hepdb/dbcdif/dbopts.F
deleted file mode 100644
index c27ee02..0000000
--- a/src/packlib/hepdb/dbcdif/dbopts.F
+++ /dev/null
@@ -1,109 +0,0 @@
-*
-* $Id: dbopts.F,v 1.1.1.1 1996/02/28 16:25:04 mclareni Exp $
-*
-* $Log: dbopts.F,v $
-* Revision 1.1.1.1 1996/02/28 16:25:04 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE DBOPTS (CHOPT, IRC)
-* ==============================
-*
-************************************************************************
-* *
-* SUBR. DBOPTS (CHOPT, IRC*) *
-* *
-* Decode the character option and fill up the common block /CAOPTS/ *
-* *
-* Arguments : *
-* *
-* CHOPT Character option supplied by user *
-* IRC Return code (see below) *
-* *
-* Called by various routines in the patch DBCDFC *
-* *
-* Error Condition : *
-* *
-* IRC = 0 : No error *
-* = 91 : Illegal Character Option *
-* *
-************************************************************************
-*
-#include "hepdb/caopti.inc"
-#include "hepdb/cdcblk.inc"
-#include "dxused.inc"
- CHARACTER CHOPT*(*), CTEST*1, BLANK*1, CTMP*80
- DIMENSION ICOPT(300), IALFA(55)
- EQUIVALENCE (IALFA(1), IOPADX)
- DATA BLANK / ' '/
-*
-* ------------------------------------------------------------------
-*
- IRC = 0
- DO 5 K = 1, 26+29
- IALFA(K) = 0
- 5 CONTINUE
-*
-* *** Convert CHOPT into a list of integer variables
-*
- MAXL = LEN (CHOPT)
- I1 = 0
- DO 20 I0 = 1, MAXL
- CTEST = CHOPT(I0:I0)
- DO 10 I = 1, 62
- IF (CTEST.EQ.CALFCA(I)) GO TO 15
- 10 CONTINUE
- IF (CTEST.NE.BLANK) GO TO 991
- GO TO 20
- 15 I1 = I1 + 1
- IF (I.GT.36) I = I - 36
- ICOPT(I1) = I
- 20 CONTINUE
- MAXU = I1
-*
-* *** Now fill up the common /CAOPTS/
-*
- I0 = 0
- 30 I0 = I0 + 1
- IF (I0.GT.MAXU) GO TO 999
- I = ICOPT(I0)
-*
-* ** Alphabetic options
-*
- IF (I.LE.26) THEN
- IALFA(I) = 1
- GO TO 30
- ENDIF
-*
-* ** Numeric options (at the moment 3-29 only)
-* ** If first digit = 1 or 2, it has to be a 2 digit number
-* ** = 3 .. 9, it can only be one digit number
-* ** First digit can never be 0.
-*
- I1 = I - 27
- IF (I1.EQ.0) GO TO 991
- IF (I1.GE.3.AND.I1.LE.9) THEN
- IOKYDX(I1) = 1
- GO TO 30
- ENDIF
- IF (I0.GE.MAXU) GO TO 991
- I = ICOPT(I0+1) - 27
- IF (I.LT.0) GO TO 991
- IOKYDX(I1*10+I) = 1
- I0 = I0 + 1
- GO TO 30
-*
-* *** Illegal Character option
-*
- 991 IRC = 91
- IQUEST(11) = I0
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) THEN
- CTMP = CHOPT
- CALL CDPRNT (LPRTCD, '('' DBOPTS : Illegal Character option a'//
- + 'fter '',I2,'' in '//CTMP//''')', IQUEST(11), 1)
- ENDIF
-#endif
-* END DBOPTS
- 999 END
diff --git a/src/packlib/hepdb/dbcdif/dbout.F b/src/packlib/hepdb/dbcdif/dbout.F
deleted file mode 100644
index 51560a6..0000000
--- a/src/packlib/hepdb/dbcdif/dbout.F
+++ /dev/null
@@ -1,114 +0,0 @@
-*
-* $Id: dbout.F,v 1.1.1.1 1996/02/28 16:25:01 mclareni Exp $
-*
-* $Log: dbout.F,v $
-* Revision 1.1.1.1 1996/02/28 16:25:01 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE DBOUT (PATHN, IVSTR, IVEND, LSUP, IPRVS, NKEXT, KEYXT,
- + IPREC, CHOPT)
-* =================================================================
-*
-************************************************************************
-* *
-* SUBR. DBOUT (PATHN, IVSTR, IVEND, LSUP, IPRVS, NKEXT, KEYXT, *
-* IPREC, CHOPT) *
-* *
-* Stores data from a ZEBRA bank to disk creating simultaneousely *
-* the directories if needed *
-* Restrictions : Only directories upto 9 keys can be created and *
-* keys should be of type INTEGER *
-* *
-* Arguments : *
-* *
-* PATHN Character string describing the pathname *
-* IVSTR Start of validity period *
-* IVEND End of validity period *
-* LSUP Address of bank in memory where data reside *
-* IPRVS Version number of program used for creating the data *
-* NKEXT Number of extra keys (Beyond key 5) *
-* KEYXT Vector of extra keys *
-* IPREC Precision word; (If IPREC > 0, data are stored with *
-* IPREC significant digits right to the decimal points; if*
-* IPREC < 0, data are stored with IPREC insignificant *
-* digits left to the decimal point.) *
-* CHOPT Character string with any of the following characters *
-* F Updates with a fully matched data object (in user keys) *
-* N Create new (sub)directory(ies) *
-* P Create partitioned subdirectories for the pathname *
-* R Store with full RZ option (No compression to be made) *
-* S Create stand alone (master) data *
-* U Store data uncompressed *
-* Z Store only nonzero elements. An element is considered to*
-* be zero if its absolute value is less than IPREC (real) *
-* *
-* Called by user *
-* *
-* Error Condition : *
-* *
-* IQUEST(1) = 0 : No error *
-* = 62 : Too many external keys with option N *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
-#include "hepdb/ckkeys.inc"
-#include "dxused.inc"
- DIMENSION KEYXT(9), LSUP(9)
- CHARACTER CHOPT*(*), PATHN*(*), CHOP*28
-*
-* ------------------------------------------------------------------
-*
-* *** Decode the character option
-*
- CALL DBOPTS (CHOPT, IRC)
- IF (IRC.NE.0) THEN
- IQUEST(1) = IRC
- GO TO 999
- ENDIF
-*
-* *** Reformat CHOPT
-*
- IOPNDX = 0
- IF (IOPRDX.NE.0) THEN
- IOPYDX = 1
- IOPRDX = 0
- ENDIF
- IF (IOPYDX.NE.0.OR.IOPTDX.NE.0) THEN
- IOPPDX = 0
- ELSE
- IOPPDX = 1
- ENDIF
- IF (IOPSDX.NE.0) THEN
- IOPDDX = 0
- IOPSDX = 0
- ELSE
- IOPDDX = 1
- ENDIF
- IF (IOPUDX.NE.0) THEN
- IOPPDX = 0
- IOPUDX = 0
- ENDIF
- IF (IOKYDX(7).NE.0) THEN
- IOPHDX = 1
- ELSE
- IOPHDX = 0
- ENDIF
- CALL DBOPTM (CHOP)
-*
-* *** Prepare the Key vector array
-*
- CALL VZERO (MASKDX, MXKYDX)
- IF (NKEXT.GT.2) CALL UCOPY (KEYXT(3), MASKDX(8), NKEXT-2)
- CALL DBCKEY (MASKDX, KEYSDX, MXKYDX)
- CALL VZERO (MASKDX, MXKYDX)
- KEYSDX(NOF1CK+1) = IVSTR
- KEYSDX(NOF1CK+2) = IVEND
- KEYSDX(IDHUSI) = IPRVS
-*
- CALL CDSTOR (PATHN, LSUP, LBK, IUDIV, KEYSDX, CHOP, IRC)
- IQUEST(1) = IRC
-* END DBOUT
- 999 END
diff --git a/src/packlib/hepdb/dbcdif/dbpktm.F b/src/packlib/hepdb/dbcdif/dbpktm.F
deleted file mode 100644
index 430d680..0000000
--- a/src/packlib/hepdb/dbcdif/dbpktm.F
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: dbpktm.F,v 1.1.1.1 1996/02/28 16:25:01 mclareni Exp $
-*
-* $Log: dbpktm.F,v $
-* Revision 1.1.1.1 1996/02/28 16:25:01 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE DBPKTM (IDATE, ITIME, IDATM)
-* =======================================
-*
-************************************************************************
-* *
-* SUBR. DBPKTM (IDATE, ITIME, IDATM*) *
-* *
-* Packs date and time into one word *
-* *
-* Arguments : *
-* *
-* IDATE Date : 6 Decimal integer : YYMMDD *
-* ITIME Time : 4 Decimal integer : HHMM *
-* IDATM* Packed date-time *
-* *
-* Called by user, DBDELT, DBEFOR, DBENTB, DBINIT, DBMDIP, DBPRGD, *
-* DBCDIC, DBENFZ, DBKOUT, DBSDIR, DBSNAM, DBSPUR, DBUDIC, *
-* DBPLOB, DBACPL, DBAUXI, DBDCKH, DBDCKV *
-* *
-************************************************************************
-*
- CALL CDPKTM (IDATE, ITIME, IDATM, IRC)
-* END DBPKTM
- END
diff --git a/src/packlib/hepdb/dbcdif/dbpkts.F b/src/packlib/hepdb/dbcdif/dbpkts.F
deleted file mode 100644
index 3dbcf25..0000000
--- a/src/packlib/hepdb/dbcdif/dbpkts.F
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: dbpkts.F,v 1.1.1.1 1996/02/28 16:25:01 mclareni Exp $
-*
-* $Log: dbpkts.F,v $
-* Revision 1.1.1.1 1996/02/28 16:25:01 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE DBPKTS (IDATE, ITIME, IDATM)
-* =======================================
-*
-************************************************************************
-* *
-* SUBR. DBPKTS (IDATE, ITIME, IDATM*) *
-* *
-* Packs date and time into one word *
-* *
-* Arguments : *
-* *
-* IDATE Date : 6 Decimal integer : YYMMDD *
-* (Only Year > 80 allowed) *
-* ITIME Time : 6 Decimal integer : HHMMSS *
-* IDATM* Packed date-time *
-* *
-* Called by user, DBINIT, DBCDIC, DBSNAM, DBUDIC, DBPLNT, DBPLOB, *
-* DBPLOV, DBPLTI, DBACPL, DBAUXI, DBDCKH, DBDCKV, DBVIEW *
-* *
-************************************************************************
-*
- CALL CDPKTS (IDATE, ITIME, IDATM, IRC)
-* END DBPKTS
- END
diff --git a/src/packlib/hepdb/dbcdif/dbplbk.F b/src/packlib/hepdb/dbcdif/dbplbk.F
deleted file mode 100644
index b9785c3..0000000
--- a/src/packlib/hepdb/dbcdif/dbplbk.F
+++ /dev/null
@@ -1,39 +0,0 @@
-*
-* $Id: dbplbk.F,v 1.1.1.1 1996/02/28 16:25:04 mclareni Exp $
-*
-* $Log: dbplbk.F,v $
-* Revision 1.1.1.1 1996/02/28 16:25:04 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE DBPLBK (LAD)
-* =======================
-*
-************************************************************************
-* *
-* SUBR. DBPLBK (LAD) *
-* *
-* Draw the nodes on the screen as given in the bank addressed by LAD *
-* *
-* Arguments : *
-* *
-* LAD Address of the bank containing the information *
-* *
-* Called by DBACPL *
-* *
-* Error Condition : *
-* *
-* IQUEST(1) = 0 : No error *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
- DIMENSION LAD(9)
-*
-* ------------------------------------------------------------------
-*
- CALL CDPLBK (LAD, IRC)
- IQUEST(1) = IRC
-* END DBPLBK
- 999 END
diff --git a/src/packlib/hepdb/dbcdif/dbplnt.F b/src/packlib/hepdb/dbcdif/dbplnt.F
deleted file mode 100644
index 30e418f..0000000
--- a/src/packlib/hepdb/dbcdif/dbplnt.F
+++ /dev/null
@@ -1,119 +0,0 @@
-*
-* $Id: dbplnt.F,v 1.1.1.1 1996/02/28 16:25:04 mclareni Exp $
-*
-* $Log: dbplnt.F,v $
-* Revision 1.1.1.1 1996/02/28 16:25:04 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE DBPLNT (NTUP, PATHS, NPATH, NOBJS, KOBJS, NKEYX,
- + KEYXS, KEYS, CHOPT)
-* ===========================================================
-*
-************************************************************************
-* *
-* SUBR. DBPLNT (NTUP, PATHS, NPATH, NOBJS, KOBJS, NKEYX, *
-* KEYXS, KEYS, CHOPT) *
-* *
-* Fills an N-tuple with data and key elements from multiple *
-* directories as requested by the user *
-* *
-* Arguments : *
-* *
-* NTUP Integer identifier of the ntuple *
-* PATHS Character array describing the path names *
-* NPATH Number of paths given in PATHS *
-* NOBJS Array giving the number of data elements to be stored *
-* for PATHS(i) *
-* KOBJS Vector specifying the element indices to be stored for *
-* PATHS(i) *
-* NKEYX Array giving the number of key elements to be stored *
-* with data for PATHS(i) *
-* KEYXS Array giving key element indices to be stored with the *
-* data. For a given path, data elements follow the key *
-* elements *
-* KEYS Vector of keys. Only the elements declared in CHOPT are *
-* considered to contain useful information. The vector as *
-* well as CHOPT refers to the PATHS(1). Selections for *
-* all subsequent paths is done on the basis of start *
-* validity period from path 1 and a correlation table *
-* between the user keys. *
-* CHOPT Character string with any of the following characters *
-* T Transforms the Keys 3,4,7 to seconds/minutes passed *
-* since midnight January 1, 1980 *
-* 3 selects objects with start validity time > KEYS(3) *
-* 4 selects objects with start validity time < KEYS(4) *
-* 5 specific Program version number required *
-* 7 selects objects with insertion time < KEYS(7) *
-* n consider user key n (where 7 < n < 30) *
-* *
-* Called by user, DBAUXI *
-* *
-* Error Condition : *
-* *
-* IQUEST(1) = 0 : No error *
-* =161 : Illegal path name *
-* =162 : No keys or data in the directory *
-* =163 : Illegal number of objects *
-* =164 : Illegal number of path names *
-* =165 : Illegal object element indices *
-* =166 : Illegal key element indices *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
-#include "hepdb/ckkeys.inc"
-#include "dxused.inc"
- PARAMETER (NKYMX=100)
- CHARACTER CHOPF*28
- CHARACTER*(*) PATHS(*), CHOPT
- DIMENSION KEYS(9), KEYXS(9), KOBJS(9), NKEYX(9), NOBJS(9)
- DIMENSION KEYXT(NKYMX)
-*
-* ------------------------------------------------------------------
-*
-* *** Reformat CHOPT
-*
- CALL DBOPTS (CHOPT, IRC)
- IF (IRC.NE.0) THEN
- IQUEST(1) = IRC
- GO TO 999
- ENDIF
- IOPXDX = 1
- CALL DBOPTM (CHOPF)
-*
-* *** Reformat the keys
-*
- CALL DBCKEY (KEYS, KEYSDX, MXKYDX)
- NKTOT = 0
- DO I = 1, NPATH
- NKTOT = NKTOT + NKEYX(I)
- ENDDO
- DO I = 1, NKTOT
- IF (KEYXS(I).EQ.1) THEN
- KEYXT(I) = IDHKSN
- ELSE IF (KEYXS(I).EQ.2) THEN
- KEYXT(I) = IDHPTR
- ELSE IF (KEYXS(I).EQ.3) THEN
- KEYXT(I) = NOF1CK + 1
- ELSE IF (KEYXS(I).EQ.4) THEN
- KEYXT(I) = NOF1CK + 2
- ELSE IF (KEYXS(I).EQ.5) THEN
- KEYXT(I) = IDHUSI
- ELSE IF (KEYXS(I).EQ.6) THEN
- KEYXT(I) = IDHFLG
- ELSE IF (KEYXS(I).EQ.7) THEN
- KEYXT(I) = IDHINS
- ELSE
- KEYXT(I) = KEYXS(I) - NSYSDX + NOF2CK + 2
- ENDIF
- ENDDO
-*
-* *** Prepare object and key vector specifiers for different paths
-*
- CALL CDNTPL (NTUP, PATHS, NPATH, NOBJS, KOBJS, NKEYX,
- + KEYXT, MASKDX, KEYSDX, CHOPF, IRC)
- IQUEST(1) = IRC
-* END DBPLNT
- 999 END
diff --git a/src/packlib/hepdb/dbcdif/dbplob.F b/src/packlib/hepdb/dbcdif/dbplob.F
deleted file mode 100644
index b558d98..0000000
--- a/src/packlib/hepdb/dbcdif/dbplob.F
+++ /dev/null
@@ -1,94 +0,0 @@
-*
-* $Id: dbplob.F,v 1.1.1.1 1996/02/28 16:25:05 mclareni Exp $
-*
-* $Log: dbplob.F,v $
-* Revision 1.1.1.1 1996/02/28 16:25:05 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE DBPLOB (PATHN, KEYS, NOBJ, KOBJ, KEX, NST, CHOPT)
-* ============================================================
-*
-************************************************************************
-* *
-* SUBR. DBPLOB (PATHN, KEYS, NOBJ, KOBJ, KEX, NST, CHOPT) *
-* *
-* Plots data elemnet(s) versus a key element for a given path name *
-* *
-* Arguments : *
-* *
-* PATHN Character string describing the pathname *
-* KEYS Vector of keys. Only the elements declared in CHOPT are *
-* assumed to contain useful information. *
-* NOBJ Number of data objects to be plotted *
-* KOBJ Vector specifying the element numbers to be plotted *
-* KEX Key index for the abcissa *
-* NST Step size for selection of object number *
-* CHOPT Character string with any of the following characters *
-* L a line to be drawn through the points *
-* (needed only when symbol and line both to be drawn) *
-* P a symbol to be drawn at each point *
-* (Default is a line to be drawn through the points) *
-* S all elements shown on the same plot *
-* (Default is a seperate plot for each variable) *
-* 3 selects objects with start validity time > KEYS(3) *
-* 4 selects objects with start validity time < KEYS(4) *
-* 5 specific Program version number required *
-* 7 selects objects with insertion time < KEYS(7) *
-* n consider user key n (where 7 < n < 30) *
-* *
-* Called by user, DBACPL *
-* *
-* Error Condition : *
-* *
-* IQUEST(1) = 0 : No error *
-* =161 : Illegal path name *
-* =162 : No keys or data in the directory *
-* =163 : Illegal number of objects *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
-#include "hepdb/ckkeys.inc"
-#include "dxused.inc"
- CHARACTER PATHN*(*), CHOPT*(*), CHOPF*28
- DIMENSION KEYS(9), KOBJ(9)
-*
-* ------------------------------------------------------------------
-*
-* *** Reformat CHOPT
-*
- CALL DBOPTS (CHOPT, IRC)
- IF (IRC.NE.0) THEN
- IQUEST(1) = IRC
- GO TO 999
- ENDIF
- IOPXDX = 1
- CALL DBOPTM (CHOPF)
-*
-* *** Reformat the keys
-*
- CALL DBCKEY (KEYS, KEYSDX, MXKYDX)
- IF (KEX.EQ.1) THEN
- KEYXT = IDHKSN
- ELSE IF (KEX.EQ.2) THEN
- KEYXT = IDHPTR
- ELSE IF (KEX.EQ.3) THEN
- KEYXT = NOF1CK + 1
- ELSE IF (KEX.EQ.4) THEN
- KEYXT = NOF1CK + 2
- ELSE IF (KEX.EQ.5) THEN
- KEYXT = IDHUSI
- ELSE IF (KEX.EQ.6) THEN
- KEYXT = IDHFLG
- ELSE IF (KEX.EQ.7) THEN
- KEYXT = IDHINS
- ELSE
- KEYXT = KEX - NSYSDX + NOF2CK + 2
- ENDIF
-*
- CALL CDPLOB (PATHN, MASKDX,KEYSDX, NOBJ,KOBJ,KEYXT,NST, CHOPF,IRC)
- IQUEST(1) = IRC
-* END DBPLOB
- 999 END
diff --git a/src/packlib/hepdb/dbcdif/dbplov.F b/src/packlib/hepdb/dbcdif/dbplov.F
deleted file mode 100644
index 258c0b4..0000000
--- a/src/packlib/hepdb/dbcdif/dbplov.F
+++ /dev/null
@@ -1,74 +0,0 @@
-*
-* $Id: dbplov.F,v 1.1.1.1 1996/02/28 16:25:05 mclareni Exp $
-*
-* $Log: dbplov.F,v $
-* Revision 1.1.1.1 1996/02/28 16:25:05 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE DBPLOV (PATHN, KEYS, NOBJ, KOBJ, NST, CHOPT)
-* =======================================================
-*
-************************************************************************
-* *
-* SUBR. DBPLOV (PATHN, KEYS, NOBJ, KOBJ, NST, CHOPT) *
-* *
-* Plots data elemnet(s) versus data element(s) for a given path name *
-* *
-* Arguments : *
-* *
-* PATHN Character string describing the pathname *
-* KEYS Vector of keys. Only the elements declared in CHOPT are *
-* assumed to contain useful information. *
-* NOBJ Number of data objects to be plotted *
-* KOBJ Vector specifying the element numbers to be plotted *
-* NST Step size for selection of object number *
-* CHOPT Character string with any of the following characters *
-* L line to be drawn through the points *
-* P a symbol to be drawn at each point *
-* (If L or P not chosen, a default marker to be drawn *
-* at each point) *
-* 3 selects objects with start validity time > KEYS(3) *
-* 4 selects objects with start validity time < KEYS(4) *
-* 5 specific Program version number required *
-* 7 selects objects with insertion time < KEYS(7) *
-* n consider user key n (where 7 < n < 30) *
-* *
-* Called by user, DBACPL *
-* *
-* Error Condition : *
-* *
-* IQUEST(1) = 0 : No error *
-* =161 : Illegal path name *
-* =162 : No keys or data in the directory *
-* =163 : Illegal number of objects *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
-#include "hepdb/ckkeys.inc"
-#include "dxused.inc"
- CHARACTER PATHN*(*), CHOPT*(*), CHOPF*28
- DIMENSION KEYS(9), KOBJ(2,9)
-*
-* ------------------------------------------------------------------
-*
-* *** Reformat CHOPT
-*
- CALL DBOPTS (CHOPT, IRC)
- IF (IRC.NE.0) THEN
- IQUEST(1) = IRC
- GO TO 999
- ENDIF
- IOPXDX = 1
- CALL DBOPTM (CHOPF)
-*
-* *** Reformat the keys
-*
- CALL DBCKEY (KEYS, KEYSDX, MXKYDX)
-*
- CALL CDPLOV (PATHN, MASKDX, KEYSDX, NOBJ, KOBJ, NST, CHOPF, IRC)
- IQUEST(1) = IRC
-* END DBPLOV
- 999 END
diff --git a/src/packlib/hepdb/dbcdif/dbplti.F b/src/packlib/hepdb/dbcdif/dbplti.F
deleted file mode 100644
index af653ae..0000000
--- a/src/packlib/hepdb/dbcdif/dbplti.F
+++ /dev/null
@@ -1,65 +0,0 @@
-*
-* $Id: dbplti.F,v 1.1.1.1 1996/02/28 16:25:05 mclareni Exp $
-*
-* $Log: dbplti.F,v $
-* Revision 1.1.1.1 1996/02/28 16:25:05 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE DBPLTI (PATHN, KEYS, CHOPT)
-* ======================================
-*
-************************************************************************
-* *
-* SUBR. DBPLTI (PATHN, KEYS, CHOPT) *
-* *
-* Plots the validity time of data objects in a given directory *
-* *
-* Arguments : *
-* *
-* PATHN Character string describing the pathname *
-* KEYS Vector of keys. Only the elements declared in CHOPT are *
-* assumed to contain useful information. *
-* CHOPT Character string with any of the following characters *
-* 3 selects objects with start validity time > KEYS(3) *
-* 4 selects objects with start validity time < KEYS(4) *
-* 5 specific Program version number required *
-* 7 selects objects with insertion time < KEYS(7) *
-* n consider user key n (where 7 < n < 30) *
-* *
-* Called by user, DBACPL *
-* *
-* Error Condition : *
-* *
-* IQUEST(1) = 0 : No error *
-* =161 : Illegal path name *
-* =162 : No keys or data in the directory *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
-#include "dxused.inc"
- CHARACTER PATHN*(*), CHOPT*(*), CHOPF*28
- DIMENSION KEYS(9)
-*
-* ------------------------------------------------------------------
-*
-* *** Reformat CHOPT
-*
- CALL DBOPTS (CHOPT, IRC)
- IF (IRC.NE.0) THEN
- IQUEST(1) = IRC
- GO TO 999
- ENDIF
- IOPXDX = 1
- CALL DBOPTM (CHOPF)
-*
-* *** Reformat the keys
-*
- CALL DBCKEY (KEYS, KEYSDX, MXKYDX)
-*
- CALL CDPLTI (PATHN, MASKDX, KEYSDX, CHOPF, IRC)
- IQUEST(1) = IRC
-* END DBPLTI
- 999 END
diff --git a/src/packlib/hepdb/dbcdif/dbprgd.F b/src/packlib/hepdb/dbcdif/dbprgd.F
deleted file mode 100644
index 37bb9ea..0000000
--- a/src/packlib/hepdb/dbcdif/dbprgd.F
+++ /dev/null
@@ -1,52 +0,0 @@
-*
-* $Id: dbprgd.F,v 1.1.1.1 1996/02/28 16:25:01 mclareni Exp $
-*
-* $Log: dbprgd.F,v $
-* Revision 1.1.1.1 1996/02/28 16:25:01 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE DBPRGD (PATHN, IKEEP, CHOPT)
-* =======================================
-*
-************************************************************************
-* *
-* SUBR. DBPRGD (PATHN, IKEEP, CHOPT) *
-* *
-* Deletes partitions in a partitioned directory except the last *
-* (first) few ones. *
-* *
-* Arguments : *
-* *
-* PATHN Character string describing the pathname *
-* IKEEP Number of partitions to be preserved *
-* (If -ve the last -IKEEP partitions deleted) *
-* CHOPT Character string with any of the following characters *
-* B Save in the special backup file; not in standard Journal*
-* *
-* Called by user, DBFZUP, DBAUXI *
-* *
-* Error Condition : *
-* *
-* IQUEST(1) = 0 : No error *
-* = 69 : Input directory is not partitioned *
-* = 70 : Error in deleting a partition *
-* = 71 : Illegal path name *
-* = 73 : RZOUT fails to write on disk *
-* = 74 : Error in RZRENK in updating key values for *
-* partitioned data set *
-* = 75 : Cannot find the Top directory name in pathname *
-* = 77 : FZOUT fails to write on to the sequential file *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
- CHARACTER PATHN*(*), CHOPT*(*)
-*
-* ------------------------------------------------------------------
-*
- CALL CDPURP (PATHN, IKEEP, CHOPT, IRC)
- IQUEST(1) = IRC
-* END DBPRGD
- 999 END
diff --git a/src/packlib/hepdb/dbcdif/dbprin.F b/src/packlib/hepdb/dbcdif/dbprin.F
deleted file mode 100644
index a586b38..0000000
--- a/src/packlib/hepdb/dbcdif/dbprin.F
+++ /dev/null
@@ -1,45 +0,0 @@
-*
-* $Id: dbprin.F,v 1.1.1.1 1996/02/28 16:25:01 mclareni Exp $
-*
-* $Log: dbprin.F,v $
-* Revision 1.1.1.1 1996/02/28 16:25:01 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE DBPRIN (PATHN, CHOPT)
-* ================================
-*
-************************************************************************
-* *
-* SUBR. DBPRIN (PATHN, CHOPT) *
-* *
-* Prints all objects attached to the directory PATHN *
-* *
-* Arguments : *
-* *
-* PATHN Character string describing the pathname *
-* CHOPT Character string with any of the following characters *
-* I Print the insertion time as well *
-* K Print only the keys *
-* D Print all data as well as the keys *
-* *
-* Called by user, DBAUXI *
-* *
-* Error Condition : *
-* *
-* IQUEST(1) = 0 : No error *
-* =101 : Illegal path name *
-* =102 : No key or data for the path name *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
- CHARACTER PATHN*(*), CHOPT*(*)
-*
-* ------------------------------------------------------------------
-*
- CALL CDPRIN (PATHN, CHOPT, IRC)
- IQUEST(1) = IRC
-* END DBPRIN
- 999 END
diff --git a/src/packlib/hepdb/dbcdif/dbpurg.F b/src/packlib/hepdb/dbcdif/dbpurg.F
deleted file mode 100644
index fc9b383..0000000
--- a/src/packlib/hepdb/dbcdif/dbpurg.F
+++ /dev/null
@@ -1,81 +0,0 @@
-*
-* $Id: dbpurg.F,v 1.1.1.1 1996/02/28 16:25:01 mclareni Exp $
-*
-* $Log: dbpurg.F,v $
-* Revision 1.1.1.1 1996/02/28 16:25:01 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE DBPURG (PATHN, KYDAT, KYTIM, CHOPT)
-* ==============================================
-*
-************************************************************************
-* *
-* SUBR. DBPURG (PATHN, KYDAT, KYTIM, CHOPT) *
-* *
-* Purges/Deletes objects in a directory PATHN *
-* *
-* Arguments : *
-* *
-* PATHN Character string describing the pathname *
-* KYDAT Key element number (for option K in CHOPT) or *
-* Minimum value of Key 1 to be deleted (for option S) *
-* KYTIM Cutoff value for the key (for option K) or *
-* Maximum value of Key 1 to be deleted (for option S) *
-* CHOPT Character string with any of the following characters *
-* A Deletes all data objects *
-* B Save in the special backup file; not in standard Journal*
-* K Deletes all data objects for which KEY(KYDAT) .lt. KYTIM*
-* L Deletes all but the last (one with highest KEY(1) value)*
-* data objects *
-* P Deletes all data objects with identical start and end *
-* validity but those having the highest Program Version *
-* number (i.e., KEY(5) value) *
-* S Deletes all data objects with Serial number (KEY(1)) in *
-* the range KYDAT-KYTIM (the terminal points included) *
-* *
-* Called by user, DBFZUP, DBAUXI *
-* *
-* Error Condition : *
-* *
-* IQUEST(1) = 0 : No error *
-* =111 : Illegal path name *
-* =112 : No key or data for the path name *
-* *
-* If IQUEST(1) =0, IQUEST(2) carries information on number of *
-* data objects deleted in the disk *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
-#include "hepdb/ckkeys.inc"
-#include "dxused.inc"
- CHARACTER PATHN*(*), CHOPT*(*)
- DIMENSION IOFF(NSYSDX)
- PARAMETER (ITIMB=NOF1CK+1, ITIME=NOF2CK+2)
- DATA IOFF / IDHKSN, IDHPTR, ITIMB, ITIME, IDHUSI,
- + IDHFLG, IDHINS/
-*
-* ------------------------------------------------------------------
-*
- CALL DBOPTS (CHOPT, IRC)
- IF (IRC.NE.0) THEN
- IQUEST(1) = IRC
- GO TO 999
- ENDIF
-*
- IF (IOPKDX.NE.0) THEN
- IF (KYDAT.GT.NSYSDX) THEN
- KYDTI = KYDAT + NOF2CK + 2 - NSYSDX
- ELSE
- KYDTI = IOFF(KYDAT)
- ENDIF
- ELSE
- KYDTI = KYDAT
- ENDIF
-*
- CALL CDPURG (PATHN, KYDTI, KYTIM, CHOPT, IRC)
- IQUEST(1) = IRC
-* END DBPURG
- 999 END
diff --git a/src/packlib/hepdb/dbcdif/dbpurk.F b/src/packlib/hepdb/dbcdif/dbpurk.F
deleted file mode 100644
index ec1a054..0000000
--- a/src/packlib/hepdb/dbcdif/dbpurk.F
+++ /dev/null
@@ -1,72 +0,0 @@
-*
-* $Id: dbpurk.F,v 1.1.1.1 1996/02/28 16:25:01 mclareni Exp $
-*
-* $Log: dbpurk.F,v $
-* Revision 1.1.1.1 1996/02/28 16:25:01 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE DBPURK (PATHN, ITIME, KEYS, CHOPT)
-* =============================================
-*
-************************************************************************
-* *
-* SUBR. DBPURK (PATHN, ITIME, KEYS, CHOPT) *
-* *
-* Deletes objects in a directory path name steered by a selection *
-* on a number of key elements *
-* *
-* Arguments : *
-* *
-* PATHN Character string describing the pathname *
-* ITIME Time of validity of the object *
-* KEYS Vector of keys. Only the elements declared in CHOPT are *
-* assumed to contain useful information. *
-* CHOPT Character string with any of the following characters *
-* B Save in the special backup file; not in standard Journal*
-* S expect multiple Key banks satisfying selection on a *
-* number of keys *
-* 3 selects objects with start validity time < KEYS(3) *
-* 4 selects objects with end validity time > KEYS(4) *
-* 5 specific Program version number required *
-* 7 select objects with insertion time < KEYS(7) *
-* n consider user key n (where 7 < n < 29 ) *
-* *
-* Called by user, DBFZUP *
-* *
-* Error Condition : *
-* *
-* IQUEST(1) = 0 : No error *
-* =111 : Illegal path name *
-* =112 : No key for the path name satisfying the Key *
-* assignments *
-* =113 : Illegal character option *
-* =114 : Valid data objects in the Node/Key structure *
-* *
-* If IQUEST(1) =0, IQUEST(2) carries information on number of *
-* data objects deleted in the disk *
-* *
-************************************************************************
-*
-#include "hepdb/caopts.inc"
-#include "hepdb/cdcblk.inc"
-#include "hepdb/ckkeys.inc"
-#include "dxused.inc"
- DIMENSION ITIME(9), KEYS(9)
- CHARACTER CHOPT*(*), PATHN*(*), CHOPF*28
-*
-* ------------------------------------------------------------------
-*
- CALL DBOPTS (CHOPT, IRC)
- IF (IRC.NE.0) THEN
- IQUEST(1) = IRC
- GO TO 999
- ENDIF
- CALL DBOPTM (CHOPF)
- CALL DBCKEY (KEY, KEYSDX, MXKYDX)
-*
- CALL CDPURK (PATHN, ITIME, MASKDX, KEYSDX, CHOPF, IRC)
- IQUEST(1) = IRC
-* END DBPURK
- 999 END
diff --git a/src/packlib/hepdb/dbcdif/dbrali.F b/src/packlib/hepdb/dbcdif/dbrali.F
deleted file mode 100644
index ca24125..0000000
--- a/src/packlib/hepdb/dbcdif/dbrali.F
+++ /dev/null
@@ -1,40 +0,0 @@
-*
-* $Id: dbrali.F,v 1.1.1.1 1996/02/28 16:25:01 mclareni Exp $
-*
-* $Log: dbrali.F,v $
-* Revision 1.1.1.1 1996/02/28 16:25:01 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE DBRALI (ALIAS, PATH)
-* ===============================
-*
-************************************************************************
-* *
-* SUBR. DBRALI (ALIAS, PATH*) *
-* *
-* Retrieve the complete path name from the alias name *
-* *
-* Arguments : *
-* *
-* ALIAS Character string specifying the alias name *
-* PATH(*) Character string specifying the directory path name *
-* *
-* Called by user, DBACPL, DBAUXI *
-* *
-* Error Condition : *
-* *
-* IQUEST(1) = 0 : No error *
-* =205 : Not a valid alias name *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
- CHARACTER PATH*(*), ALIAS*(*)
-* ------------------------------------------------------------------
-*
- CALL CDRALI (ALIAS, PATH, IRC)
- IQUEST(1) = IRC
-* END DBRALI
- 999 END
diff --git a/src/packlib/hepdb/dbcdif/dbrenk.F b/src/packlib/hepdb/dbcdif/dbrenk.F
deleted file mode 100644
index c748574..0000000
--- a/src/packlib/hepdb/dbcdif/dbrenk.F
+++ /dev/null
@@ -1,51 +0,0 @@
-*
-* $Id: dbrenk.F,v 1.1.1.1 1996/02/28 16:25:01 mclareni Exp $
-*
-* $Log: dbrenk.F,v $
-* Revision 1.1.1.1 1996/02/28 16:25:01 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE DBRENK (PATHN, KEYO, KEYN)
-* =====================================
-*
-************************************************************************
-* *
-* SUBR. DBRENK (PATHN, KEYO, KEYN) *
-* *
-* Changes the key elements of an existing object to new values *
-* *
-* Arguments : *
-* *
-* PATHN Character string describing the pathname *
-* KEYO Array containing the old key elements *
-* KEYN Array containing the new key elements *
-* *
-* Called by user, DBFZUP *
-* *
-* Error Condition : *
-* *
-* IQUEST(1) = 0 : No error *
-* =191 : Illegal path name *
-* =192 : Illegal KEYO values (no matching object) *
-* =193 : No top directory found *
-* =194 : Error in getting the IO descriptor *
-* =195 : Error in FZOUT in saving the journal file *
-* =196 : Error in RZRENK in renaming key values *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
-#include "dxused.inc"
- DIMENSION KEYO(9), KEYN(9), KEYSN(MXKYDX)
- CHARACTER PATHN*(*)
-*
-* ------------------------------------------------------------------
-*
- CALL DBCKEY (KEYO, KEYSDX, MXKYDX)
- CALL DBCKEY (KEYN, KEYSN, MXKYDX)
- CALL CDRENK (PATHN, KEYSDX, KEYSN, IRC)
- IQUEST(1) = IRC
-* END DBRENK
- 999 END
diff --git a/src/packlib/hepdb/dbcdif/dbrepl.F b/src/packlib/hepdb/dbcdif/dbrepl.F
deleted file mode 100644
index 66238d0..0000000
--- a/src/packlib/hepdb/dbcdif/dbrepl.F
+++ /dev/null
@@ -1,122 +0,0 @@
-*
-* $Id: dbrepl.F,v 1.1.1.1 1996/02/28 16:25:01 mclareni Exp $
-*
-* $Log: dbrepl.F,v $
-* Revision 1.1.1.1 1996/02/28 16:25:01 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE DBREPL (PATHN, LBK, LBD, IUDIV, LSUP, NWKEY, KEYO, KEYN
- + , IPREC, CHOPT)
-* ==================================================================
-*
-************************************************************************
-* *
-* SUBR. DBREPL (PATHN, *LBK*, LBD*, IUDIV, LSUP, NWKEY, KEYO, *
-* KEYN, IPREC, CHOPT) *
-* *
-* Stores data from memory to disk and also enters in the memory ala *
-* DBUSE in NODE/KEY structure. Also replaces an Old set of keys in *
-* KEYO by a new set of keys in KEYN *
-* *
-* Arguments : *
-* *
-* PATHN Character string describing the pathname *
-* LBK(*) Address of Keys bank KYCD (INPUT or OUTPUT) *
-* LBD(*) Address of Data bank *
-* IUDIV Division index of the user data bank *
-* LSUP Address of bank in memory where data reside *
-* NWKEY Number of keys associated with the data bank *
-* KEYO Vector of old keys *
-* KEYN Vector of new keys *
-* IPREC Precision word; (If IPREC > 0, data are stored with *
-* IPREC significant digits right to the decimal points; if*
-* IPREC < 0, data are stored with IPREC insignificant *
-* digits left to the decimal point.) *
-* CHOPT Character string with any of the following characters *
-* A trust LBK address if non-zero *
-* B Save in the special backup file; not in standard Journal*
-* C create Node/Key data structure ala DBUSE *
-* F Updates with a fully matched data object (in user keys) *
-* K Store data only inside the keys (not yet installed) *
-* N Create new (sub)directory(ies) *
-* P Create partitioned subdirectories for the pathname *
-* R Store with full RZ option (No compression to be made) *
-* S Create stand alone (master) data *
-* T Special text type of data (to be used with R) *
-* U Store data uncompressed *
-* Z Store only nonzero elements. An element is considered to*
-* be zero if its absolute value is less than IPREC (real) *
-* 7 Insertion time as supplied by user to be honoured *
-* *
-* Called by user, DBAIWR, DBUPKY *
-* *
-* Error Condition : *
-* *
-* IQUEST(1) = 0 : No error *
-* = 61 : Too many keys *
-* = 62 : Too many keys with option N *
-* = 63 : Data base structure in memory clobbered *
-* = 64 : Error in MZCOPY while copying Data bank *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
-#include "dxused.inc"
- DIMENSION KEYN(9), KEYO(9), LBD(9), LBK(9), LSUP(9)
- DIMENSION KEYSN(MXKYDX)
- CHARACTER CHOPT*(*), PATHN*(*), CHOP*28
-*
-* ------------------------------------------------------------------
-*
-* *** Decode the character option
-*
- CALL DBOPTS (CHOPT, IRC)
- IF (IRC.NE.0) THEN
- IQUEST(1) = IRC
- GO TO 999
- ENDIF
-*
-* *** Reformat CHOPT
-*
- IOPNDX = 0
- IF (IOPRDX.NE.0) THEN
- IOPYDX = 1
- IOPRDX = 0
- ENDIF
- IF (IOPYDX.NE.0.OR.IOPTDX.NE.0) THEN
- IOPPDX = 0
- ELSE
- IOPPDX = 1
- ENDIF
- IF (IOPSDX.NE.0) THEN
- IOPDDX = 0
- IOPSDX = 0
- ELSE
- IOPDDX = 1
- ENDIF
- IF (IOPUDX.NE.0) THEN
- IOPPDX = 0
- IOPUDX = 0
- ENDIF
- IF (IOKYDX(7).NE.0) THEN
- IOPHDX = 1
- ELSE
- IOPHDX = 0
- ENDIF
- CALL DBOPTM (CHOP)
-*
- CALL DBCKEY (KEYO, KEYSDX, MXKYDX)
- CALL DBCKEY (KEYN, KEYSN, MXKYDX)
- CALL CDREPL (PATHN, LSUP, LBK, IUDIV, KEYSDX,KEYSN, CHOPT, IRC)
- IQUEST(1) = IRC
- IF (IRC.EQ.0.AND.IOPCDX.NE.0) THEN
- IF (LBK(1).NE.0) THEN
- LBD(1) = LQ(KOFUCD+LBK(1)-KLDACD)
- ELSE
- LBD(1) = 0
- ENDIF
- ENDIF
-* END DBREPL
- 999 END
diff --git a/src/packlib/hepdb/dbcdif/dbrhlp.F b/src/packlib/hepdb/dbcdif/dbrhlp.F
deleted file mode 100644
index bdfb9ed..0000000
--- a/src/packlib/hepdb/dbcdif/dbrhlp.F
+++ /dev/null
@@ -1,45 +0,0 @@
-*
-* $Id: dbrhlp.F,v 1.1.1.1 1996/02/28 16:25:02 mclareni Exp $
-*
-* $Log: dbrhlp.F,v $
-* Revision 1.1.1.1 1996/02/28 16:25:02 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE DBRHLP (PATH, LUN)
-* =============================
-*
-************************************************************************
-* *
-* SUBR. DBRHLP (PATH, LUN) *
-* *
-* Retrieve the help information from data base and translate it *
-* with Subroutine DBLIND and also write the ASCII format on a *
-* given file specified by logical unit number LUN. *
-* *
-* Arguments : *
-* *
-* PATH Character string describing the pathname *
-* LUN Logical unit number of the file with ASCII data *
-* *
-* Called by user, DBACPL, DBAUXI *
-* *
-* Error Condition : *
-* *
-* IQUEST(1) = 0 : No error *
-* = 66 : Illegal logical unit number *
-* =182 : The pathname specified does not exist *
-* =203 : No help directory inside the data base *
-* =204 : No help information for this path stored yet *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
- CHARACTER PATH*(*)
-* ------------------------------------------------------------------
-*
- CALL CDRHLP (PATH, LUN, IRC)
- IQUEST(1) = IRC
-* END DBRHLP
- 999 END
diff --git a/src/packlib/hepdb/dbcdif/dbrky1.F b/src/packlib/hepdb/dbcdif/dbrky1.F
deleted file mode 100644
index 9e645ea..0000000
--- a/src/packlib/hepdb/dbcdif/dbrky1.F
+++ /dev/null
@@ -1,96 +0,0 @@
-*
-* $Id: dbrky1.F,v 1.1.1.1 1996/02/28 16:25:02 mclareni Exp $
-*
-* $Log: dbrky1.F,v $
-* Revision 1.1.1.1 1996/02/28 16:25:02 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE DBRKY1 (PATHN, KEY1S, NKEY1)
-* =======================================
-*
-************************************************************************
-* *
-* SUBR. DBRKY1 (PATHN, KEY1S*, *NKEY1*) *
-* *
-* Retrieves all the Key 1 values for the directory PATHN *
-* *
-* Arguments : *
-* *
-* PATHN Character string describing the pathname *
-* KEY1S Vector containing the Key 1 values *
-* NKEY1 On input contains the maximum number of elements to be *
-* stored in KEY1S; on return it will contain the true *
-* number of objects *
-* *
-* Called by user *
-* *
-* Error Condition : *
-* *
-* IQUEST(1) = 0 : No error *
-* =101 : Illegal path name *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
-#include "hepdb/ckkeys.inc"
-#include "hepdb/ctpath.inc"
- DIMENSION KEY1S(9)
- CHARACTER PATHN*(*), PATHY*80
-#include "zebra/q_jbit.inc"
-* Ignoring t=pass
-*
-* ------------------------------------------------------------------
-*
-* *** Set the current directory
-*
- NKMAX = NKEY1
- NKEY1 = 0
- CALL CDLDUP (PATHN, 0, IRC)
- IF (IRC.NE.0) GO TO 991
- PATHY = PAT1CT
- NCHR = LENOCC (PATHY)
- ISTP = NWKYCK + 1
- CALL CDKEYT
- IF (NKEYCK.EQ.0) GO TO 999
- IOPTP = JBIT (IQ(KOFSCD+LCDRCD+IKDRCD+IDHFLG), JPRTCD)
-*
-* ** Find all key 1 values
-*
- IF (IOPTP.EQ.0) THEN
- IPNT = KOFSCD + LCDRCD + IKDRCD
- DO 10 IK = 1, NKEYCK
- NKEY1 = NKEY1 + 1
- IF (NKEY1.LE.NKMAX) KEY1S(NKEY1) = IQ(IPNT+IDHKSN)
- IPNT = IPNT + ISTP
- 10 CONTINUE
- ELSE
- NKEYS = NKEYCK
- DO 20 IKK = 1, NKEYS
- CALL CDPATH (TOP1CT, IKK)
- PAT2CT = PATHY(1:NCHR)//'/'//TOP1CT
- CALL RZCDIR (PAT2CT, ' ')
- IF (IQUEST(1).NE.0) THEN
- IRC = 101
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' DBRKY1 : '//
- + 'Illegal Path Name '//PAT2CT//''')', IARGCD, 0)
-#endif
- GO TO 991
- ENDIF
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- NKEYCK = IQUEST(7)
- IPNT = KOFSCD + LCDRCD + IKDRCD
- DO 15 IK = 1, NKEYCK
- NKEY1 = NKEY1 + 1
- IF (NKEY1.LE.NKMAX) KEY1S(NKEY1) = IQ(IPNT+IDHKSN)
- IPNT = IPNT + ISTP
- 15 CONTINUE
- 20 CONTINUE
- ENDIF
-*
- 991 IQUEST(1) = IRC
-* END DBRKY1
- 999 END
diff --git a/src/packlib/hepdb/dbcdif/dbrnam.F b/src/packlib/hepdb/dbcdif/dbrnam.F
deleted file mode 100644
index 307aab1..0000000
--- a/src/packlib/hepdb/dbcdif/dbrnam.F
+++ /dev/null
@@ -1,46 +0,0 @@
-*
-* $Id: dbrnam.F,v 1.1.1.1 1996/02/28 16:25:02 mclareni Exp $
-*
-* $Log: dbrnam.F,v $
-* Revision 1.1.1.1 1996/02/28 16:25:02 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE DBRNAM (PATH, NWMAX, CHTAG)
-* ======================================
-*
-************************************************************************
-* *
-* SUBR. DBRNAM (PATH, *NWMAX*, CHTAG*) *
-* *
-* Retrieves the names of the data elements of a given directory *
-* from the data base *
-* *
-* Arguments : *
-* *
-* PATH Character string describing the pathname *
-* NWMAX Maximum number of data word elements for CHTAG *
-* (on return it contains the number of CHTAG filled in) *
-* CHTAG Name of the data elements *
-* *
-* Called by user, DBAUXI *
-* *
-* Error Condition : *
-* *
-* IQUEST(1) = 0 : No error *
-* =182 : Illegal path name *
-* =201 : DICTIONARY directory not found *
-* =202 : No description of data elements for the given *
-* path name exists in the data base *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
- CHARACTER*(*) CHTAG(*), PATH
-* ------------------------------------------------------------------
-*
- CALL CDRNAM (PATHN, NWMAX, CHTAG, IRC)
- IQUEST(1) = IRC
-* END DBRNAM
- 999 END
diff --git a/src/packlib/hepdb/dbcdif/dbropn.F b/src/packlib/hepdb/dbcdif/dbropn.F
deleted file mode 100644
index fa316e4..0000000
--- a/src/packlib/hepdb/dbcdif/dbropn.F
+++ /dev/null
@@ -1,37 +0,0 @@
-*
-* $Id: dbropn.F,v 1.1.1.1 1996/02/28 16:25:02 mclareni Exp $
-*
-* $Log: dbropn.F,v $
-* Revision 1.1.1.1 1996/02/28 16:25:02 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE DBROPN (LUN, CHOPT, CFNAM, NRECL, IOERR)
-* ===================================================
-*
-************************************************************************
-* *
-* SUBR. DBROPN (LUN, CHOPT, CFNAM, NRECL, IOERR*) *
-* *
-* Opens a random access file *
-* *
-* Arguments : *
-* *
-* LUN Logical unit number *
-* CHOPT Character string with any of the following characters *
-* O Output file (default is input) *
-* Z File to be overwritten if exists *
-* CFNAM File name *
-* NRECL Record length in bytes *
-* IOERR Error code (0 if no error) *
-* *
-* Called by DBEXAMn *
-* *
-************************************************************************
-*
- CHARACTER CHOPT*(*), CFNAM*(*)
-*
- CALL CDROPN (LUN, CHOPT, CFNAM, NRECL, IOERR)
-* END DBROPN
- END
diff --git a/src/packlib/hepdb/dbcdif/dbrtfz.F b/src/packlib/hepdb/dbcdif/dbrtfz.F
deleted file mode 100644
index f99532c..0000000
--- a/src/packlib/hepdb/dbcdif/dbrtfz.F
+++ /dev/null
@@ -1,46 +0,0 @@
-*
-* $Id: dbrtfz.F,v 1.1.1.1 1996/02/28 16:25:02 mclareni Exp $
-*
-* $Log: dbrtfz.F,v $
-* Revision 1.1.1.1 1996/02/28 16:25:02 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE DBRTFZ (PATHI, LUNFZ, K1MIN, K1MAX, CHOPT)
-* =====================================================
-*
-************************************************************************
-* *
-* SUBR. DBRTFZ (PATHI, LUNFZ, K1MIN, K1MAX, CHOPT) *
-* *
-* Copies a part of the directory (in the range K1MIN-K1MAX) into a *
-* sequential file in the format of the journal file *
-* *
-* Arguments : *
-* *
-* PATHI Character string describing the input pathname *
-* LUNFZ Logical unit number of the output FZ file *
-* K1MIN Minumum serial number (Key 1 value) to be copied *
-* K1MAX Maximum serial number (Key 1 value) to be copied *
-* CHOPT Character string with any of the following characters *
-* F Updates with a fully matched data object (in user keys) *
-* *
-* Called by user, DBAUXI *
-* *
-* Error Condition : *
-* *
-* IQUEST(1) = 0 : No error *
-* = 71 : Illegal path name *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
- CHARACTER PATHI*(*), CHOPT*(*)
-*
-* ------------------------------------------------------------------
-*
- CALL CDRTFZ (PATHI, LUNFZ, K1MIN, K1MAX, CHOPT, IRC)
- IQUEST(1) = IRC
-* END DBRTFZ
- 999 END
diff --git a/src/packlib/hepdb/dbcdif/dbsave.F b/src/packlib/hepdb/dbcdif/dbsave.F
deleted file mode 100644
index d369af8..0000000
--- a/src/packlib/hepdb/dbcdif/dbsave.F
+++ /dev/null
@@ -1,38 +0,0 @@
-*
-* $Id: dbsave.F,v 1.1.1.1 1996/02/28 16:25:02 mclareni Exp $
-*
-* $Log: dbsave.F,v $
-* Revision 1.1.1.1 1996/02/28 16:25:02 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE DBSAVE
-* =================
-*
-************************************************************************
-* *
-* SUBR. DBSAVE *
-* *
-* Sends the spool file to the server for updating the data base. *
-* Useful only for interactive programs running on IBM *
-* *
-* Called by user *
-* *
-* Error Condition : *
-* *
-* IQUEST(1) = 0 : No error *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
-* ------------------------------------------------------------------
-*
- IRC = 0
-#if (defined(CERNLIB_IBMVM)||defined(CERNLIB_UNIX)||defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))&&(!defined(CERNLIB__P3CHILD))&&(!defined(CERNLIB__ONLINE))
- CALL CDSTSV (' ', 0, IRC)
-#endif
-* CALL CDSAVE (IRC)
- IQUEST(1) = IRC
-* END DBSAVE
- END
diff --git a/src/packlib/hepdb/dbcdif/dbsrtm.F b/src/packlib/hepdb/dbcdif/dbsrtm.F
deleted file mode 100644
index dcaef3e..0000000
--- a/src/packlib/hepdb/dbcdif/dbsrtm.F
+++ /dev/null
@@ -1,263 +0,0 @@
-*
-* $Id: dbsrtm.F,v 1.1.1.1 1996/02/28 16:25:02 mclareni Exp $
-*
-* $Log: dbsrtm.F,v $
-* Revision 1.1.1.1 1996/02/28 16:25:02 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE DBSRTM (PATHN, MNDAT, MNTIM, MXDAT, MXTIM, IUDIV, LSUP,
- + IPREC)
-* ==================================================================
-*
-************************************************************************
-* *
-* SUBR. DBSRTM (PATHN, MNDAT, MNTIM, MXDAT, MXTIM, IUDIV, LSUP*,*
-* IPREC*) *
-* *
-* Fetches from disk to memory an object inserted between certain *
-* time *
-* *
-* Arguments : *
-* *
-* PATHN Character string describing the pathname *
-* MNDAT Minimum date for insertion *
-* MNTIM Minimum time for insertion *
-* MXDAT Maximum date for insertion *
-* MXTIM Maximum time for insertion *
-* IUDIV Division index where bank is expected *
-* LSUP Address of the bank in memory *
-* IPREC Precision word; (If IPREC > 0, data are stored with *
-* IPREC significant digits right to the decimal points; if*
-* IPREC < 0, data are stored with IPREC insignificant *
-* digits left to the decimal point.) *
-* *
-* Called by user *
-* *
-* Error Condition : *
-* *
-* IQUEST(1) = 0 : No error *
-* = 31 : Illegal path name *
-* = 32 : No keys/data in this directory *
-* = 33 : No valid data for the given range of insertion *
-* time *
-* *
-************************************************************************
-*
-#include "hepdb/caopts.inc"
-#include "hepdb/cdcblk.inc"
-#include "hepdb/ckkeys.inc"
-#include "hepdb/ctpath.inc"
- PARAMETER (JBIAS=2)
- DIMENSION LSUP(9), ITIME(MXPACD)
- CHARACTER PATHN*(*), PATHY*80
-#include "zebra/q_jbit.inc"
-* Ignoring t=pass
-*
-* ------------------------------------------------------------------
-*
-* *** Initialise the option array
-*
- CALL CDOPTS (' ', IRC)
- IF (IRC.NE.0) GO TO 900
- IOKYCA(IDHKSN) = 1
-*
-* *** Set the current directory
-*
- CALL CDLDUP (PATHN, 0, IRC)
- IF (IRC.NE.0) GO TO 900
- PATHY = PAT1CT
- NCHAR = LENOCC (PATHY)
- DO 10 I = 1, NPARCD
- ITIME(I) = 1
- 10 CONTINUE
- CALL CDKEYT
-*
-* *** Check the number of keys
-*
- IF (NKEYCK.LE.0) THEN
- IRC = 32
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' DBSRTM : No key '//
- + 'or data for Path Name '//PATHY//''')', IARGCD, 0)
-#endif
- GO TO 900
- ENDIF
-*
-* *** Check the validity limits from the Keys
-*
- MRET = 0
- IOPTP = JBIT (IQ(KOFSCD+LCDRCD+IKDRCD+IDHFLG), JPRTCD)
- ISTP = NWKYCK + 1
-*
- IF (IOPTP.EQ.0) THEN
-*
-* ** For non-partitioned dataset
-*
- DO 20 IK = 1, NKEYCK
-*
- IPNT = KOFSCD + LCDRCD + IKDRCD + (IK-1) * ISTP
- CALL CDUPTM (IDATE, ITIMX, IQ(IPNT+IDHINS), IRC)
- IF ((IDATE.GT.MNDAT.AND.IDATE.LT.MXDAT) .OR.
- + (IDATE.EQ.MNDAT.AND.ITIMX.GE.MNTIM.AND.MNDAT.NE.MXDAT).OR.
- + (IDATE.EQ.MXDAT.AND.ITIMX.LE.MXTIM.AND.MNDAT.NE.MXDAT).OR.
- + (IDATE.EQ.MNDAT.AND.ITIMX.GE.MNTIM.AND.ITIMX.LE.MXTIM.AND.
- + MNDAT.EQ.MXDAT)) THEN
-*
- IF (MRET.NE.0.AND.MRET.LT.IQ(IPNT+IDHINS)) THEN
- IF (LSUP(1).NE.0) THEN
- CALL MZDROP (IUDIV, LSUP, ' ')
- LSUP(1) = 0
- ENDIF
- CALL VZERO (KEYVCK, NWKYCK)
- KEYVCK(IDHKSN) = IK
- CALL CDKXIN (ITIME, IUDIV, LSUP(1), LSUP(1), JBIAS, NWKEY,
- + KEYVCK, IPREC, IRC)
-*
- IF (IRC.EQ.0) THEN
- MRET = KEYVCK(IDHINS)
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.1) THEN
- CALL UCOPY (KEYVCK(1), IARGCD, 5)
- IARGCD(6) = IDATE
- IARGCD(7) = ITIMX
- CALL CDPRNT (LPRTCD, '(/,'' DBSRTM : Data with Ke'//
- + 'y'',2I8,2I10,I6,'' retrieved for '//PATHY(1:40)
- + //''',/,10X,''Created on the '',I8,'' at '','//
- + 'I6)', IARGCD, 7)
- ENDIF
-#endif
-*
- ELSE
- MRET = 0
- IF (LSUP(1).NE.0) THEN
- CALL MZDROP (IUDIV, LSUP, ' ')
- LSUP(1) = 0
- ENDIF
- ENDIF
- ENDIF
-*
- ENDIF
-*
- 20 CONTINUE
-*
- ELSE
-*
-* ** For partitioned dataset
-*
- NKEYS = NKEYCK
- KST = NWKYCK + 1
- DO 40 JK = 1, NKEYS
- ICURCT = NKEYS + 1 - JK
-*
- CALL RZCDIR (PATHY(1:NCHAR), ' ')
- IF (IQUEST(1).NE.0) THEN
- IRC = 31
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' DBSRTM : '//
- + 'Illegal Path Name '//PATHY(1:NCHAR)//''')', IARGCD, 0)
-#endif
- GO TO 900
- ENDIF
- NWKYCK = IQUEST(8)
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- KPNT = IUHUNT (ICURCT, IQ(KOFSCD+LCDRCD+IKDRCD+MPSRCD),
- + NKEYS*KST, KST)
- IF (KPNT.NE.0) THEN
- IPNT = KOFSCD + LCDRCD + IKDRCD + KPNT - MPSRCD
- ELSE
- IPNT = KOFSCD + LCDRCD + IKDRCD + (ICURCT - 1) * KST
- ENDIF
- CALL CDUPTM (IDATE, ITIMX, IQ(IPNT+IDHINS), IRC)
- IF ((IDATE.LT.MNDAT).OR.(IDATE.EQ.MNDAT.AND.ITIMX.LT.MNTIM))
- + GO TO 40
-*
- CALL CDPATH (TOP1CT, ICURCT)
- PATHY = PATHY(1:NCHAR)//'/'//TOP1CT
- CALL RZCDIR (PATHY, ' ')
- IF (IQUEST(1).EQ.0) THEN
- IRC = 31
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' DBSRTM : '//
- + 'Illegal Path Name '//PATHY//''')', IARGCD, 0)
-#endif
- GO TO 900
- ENDIF
- NKEYCK = IQUEST(7)
- NWKYCK = IQUEST(8)
- LCDRCD = IQUEST(11)
- IKDRCD = IQUEST(13)
- ISTP = NWKYCK + 1
- CALL CDKEYT
- DO 30 IK = 1, NKEYCK
- IPNT = KOFSCD + LCDRCD + IKDRCD + (IK-1) * ISTP
- CALL CDUPTM (IDATE, ITIMX, IQ(IPNT+IDHINS), IRC)
- IF ((IDATE.GT.MNDAT.AND.IDATE.LT.MXDAT) .OR.
- + (IDATE.EQ.MNDAT.AND.ITIMX.GE.MNTIM.AND.MNDAT.NE.MXDAT)
- + .OR.(IDATE.EQ.MXDAT.AND.ITIMX.LE.MXTIM.AND.MNDAT.NE.MXDAT)
- + .OR.(IDATE.EQ.MNDAT.AND.ITIMX.GE.MNTIM.AND.ITIMX.LE.MXTIM
- + .AND.MNDAT.EQ.MXDAT)) THEN
-*
- IF (MRET.NE.0.AND.MRET.LT.IQ(IPNT+IDHINS)) THEN
- IF (LSUP(1).NE.0) THEN
- CALL MZDROP (IUDIV, LSUP, ' ')
- LSUP(1) = 0
- ENDIF
- CALL VZERO (KEYVCK, NWKYCK)
- KEYVCK(IDHKSN) = IK
- CALL CDKXIN (ITIME, IUDIV, LSUP(1), LSUP(1), JBIAS,
- + NWKEY, KEYVCK, IPREC, IRC)
-*
- IF (IRC.EQ.0) THEN
-*
- MRET = KEYVCK(IDHINS)
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.1) THEN
- CALL UCOPY (KEYVCK(1), IARGCD, 5)
- IARGCD(6) = IDATE
- IARGCD(7) = ITIMX
- CALL CDPRNT (LPRTCD, '(/,'' DBSRTM : Data with Ke'//
- + 'y'',2I8,2I10,I6,'' retrieved for '//PATHY(1:40)
- + //''',/,10X,''Created on the '',I8,'' at '','//
- + 'I6)', IARGCD, 7)
- ENDIF
-#endif
-*
- ELSE
-*
- MRET = 0
- IF (LSUP(1).NE.0) THEN
- CALL MZDROP (IUDIV, LSUP, ' ')
- LSUP(1) = 0
- ENDIF
- ENDIF
- ENDIF
-*
- ENDIF
-*
- 30 CONTINUE
-*
- IF (MRET.NE.0) GO TO 900
- 40 CONTINUE
-*
- ENDIF
-*
- 900 IOKYCA(IDHKSN) = 0
- IQUEST(1) = IRC
- IF (MRET.EQ.0) THEN
- IQUEST(1) = 33
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) THEN
- IARGCD(1) = MNDAT
- IARGCD(2) = MNTIM
- IARGCD(3) = MXDAT
- IARGCD(4) = MXTIM
- CALL CDPRNT (LPRTCD, '(/,'' DBSRTM : No data in '//PATHY(1:40)
- + //' inserted between '',2I8,'' and '',2I8)', IARGCD, 4)
- ENDIF
-#endif
- ENDIF
-* END DBSRTM
- 999 END
diff --git a/src/packlib/hepdb/dbcdif/dbtbcr.F b/src/packlib/hepdb/dbcdif/dbtbcr.F
deleted file mode 100644
index 6a26749..0000000
--- a/src/packlib/hepdb/dbcdif/dbtbcr.F
+++ /dev/null
@@ -1,46 +0,0 @@
-*
-* $Id: dbtbcr.F,v 1.1.1.1 1996/02/28 16:25:02 mclareni Exp $
-*
-* $Log: dbtbcr.F,v $
-* Revision 1.1.1.1 1996/02/28 16:25:02 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE DBTBCR (IUDIV, LAD, LSUP, JBIAS)
-* ===========================================
-*
-************************************************************************
-* *
-* SUBR. DBTBCR (IUDIV, LAD*, LSUP, JBIAS) *
-* *
-* Creates DBTB bank with information of the data base objects used *
-* for this event (till the last call to DBTBCR). It stores 2 words *
-* per object used, a unique identifier corresponding to the path *
-* name and the serial number of the object (KEY(1) value) *
-* *
-* Arguments : *
-* *
-* IUDIV User division where the DBTB bank has to be created *
-* LAD(*) Address of the DBTB bank (should be in the same store *
-* as all DB objects) *
-* LSUP Address of the supporting bank *
-* JBIAS Link bias as described in ZEBRA manual *
-* *
-* Called by user *
-* *
-* Error Condition : *
-* *
-* IQUEST(1) = 0 : No error *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
- DIMENSION LSUP(9), LAD(9)
-*
-* ------------------------------------------------------------------
-*
- CALL CDINFO (IUDIV, LAD, LSUP, JBIAS, IRC)
- IQUEST(1) = IRC
-* END DBTBCR
- 999 END
diff --git a/src/packlib/hepdb/dbcdif/dbtbpr.F b/src/packlib/hepdb/dbcdif/dbtbpr.F
deleted file mode 100644
index 877081a..0000000
--- a/src/packlib/hepdb/dbcdif/dbtbpr.F
+++ /dev/null
@@ -1,35 +0,0 @@
-*
-* $Id: dbtbpr.F,v 1.1.1.1 1996/02/28 16:25:02 mclareni Exp $
-*
-* $Log: dbtbpr.F,v $
-* Revision 1.1.1.1 1996/02/28 16:25:02 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE DBTBPR
-* =================
-*
-************************************************************************
-* *
-* SUBR. DBTBPR *
-* *
-* Prints accumulated summary for the given run with the Data Base *
-* *
-* Called by user *
-* *
-* Error Condition : *
-* *
-* IQUEST(1) = 0 : No error *
-* = 98 : Invalid path name in Node bank *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
-*
-* ------------------------------------------------------------------
-*
- CALL CDSTAT (LPRTCD, IRC)
- IQUEST(1) = IRC
-* END DBTBPR
- 999 END
diff --git a/src/packlib/hepdb/dbcdif/dbuptm.F b/src/packlib/hepdb/dbcdif/dbuptm.F
deleted file mode 100644
index e5f4092..0000000
--- a/src/packlib/hepdb/dbcdif/dbuptm.F
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: dbuptm.F,v 1.1.1.1 1996/02/28 16:25:02 mclareni Exp $
-*
-* $Log: dbuptm.F,v $
-* Revision 1.1.1.1 1996/02/28 16:25:02 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE DBUPTM (IDATE, ITIME, IDATM)
-* =======================================
-*
-************************************************************************
-* *
-* SUBR. DBUPTM (IDATE*, ITIME*, IDATM) *
-* *
-* Unpacks date and time from one word *
-* *
-* Arguments : *
-* *
-* IDATE Date : 6 Decimal integer : YYMMDD *
-* ITIME Time : 4 Decimal integer : HHMM *
-* IDATM Packed date-time *
-* *
-* Called by user, DBFZUP, DBLKEY, DBNTOP, DBPRGD, DBSRTM, DBENFZ, *
-* DBPLOB, DBDKYH, DBDKYV *
-* *
-************************************************************************
-*
- CALL CDUPTM (IDATE, ITIME, IDATM, IRC)
-* END DBUPTM
- END
diff --git a/src/packlib/hepdb/dbcdif/dbupts.F b/src/packlib/hepdb/dbcdif/dbupts.F
deleted file mode 100644
index 534418f..0000000
--- a/src/packlib/hepdb/dbcdif/dbupts.F
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: dbupts.F,v 1.1.1.1 1996/02/28 16:25:02 mclareni Exp $
-*
-* $Log: dbupts.F,v $
-* Revision 1.1.1.1 1996/02/28 16:25:02 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE DBUPTS (IDATE, ITIME, IDATM)
-* =======================================
-*
-************************************************************************
-* *
-* SUBR. DBUPTS (IDATE*, ITIME*, IDATM) *
-* *
-* Unpacks date and time from one word *
-* *
-* Arguments : *
-* *
-* IDATE Date : 6 Decimal integer : YYMMDD *
-* ITIME Time : 6 Decimal integer : HHMMSS *
-* IDATM Packed date-time *
-* *
-* Called by user, DBPLOB, DBPLOV, DBPLTI, DBAUXI, DBDISD, DBDKYH, *
-* DBDKYV *
-* *
-************************************************************************
-*
- CALL CDUPTS (IDATE, ITIME, IDATM, IRC)
-* END DBUPTS
- END
diff --git a/src/packlib/hepdb/dbcdif/dbuse.F b/src/packlib/hepdb/dbcdif/dbuse.F
deleted file mode 100644
index 92e017a..0000000
--- a/src/packlib/hepdb/dbcdif/dbuse.F
+++ /dev/null
@@ -1,110 +0,0 @@
-*
-* $Id: dbuse.F,v 1.1.1.1 1996/02/28 16:25:03 mclareni Exp $
-*
-* $Log: dbuse.F,v $
-* Revision 1.1.1.1 1996/02/28 16:25:03 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE DBUSE (PATHN, LBK, LBD, ITIME, KEYS, CHOPT)
-* ======================================================
-*
-************************************************************************
-* *
-* SUBR. DBUSE (PATHN, *LBK*, LBD*, ITIME, KEYS, CHOPT) *
-* *
-* Prepares the database data structure in memory for any required *
-* Pathname and set of Keys, unless already done. *
-* Returns (optionally) the addresses in memory for the corresponding *
-* Key banks and Data banks after checking their validity for the *
-* given time and keys. *
-* *
-* Arguments : *
-* *
-* PATHN Character string describing the pathname *
-* LBK Address(es) of Keys bank(s) KYCD (INPUT or OUTPUT) *
-* For option 'S' it is the support address of the linear *
-* structure *
-* For option 'M' with selection on user keys 8 and 9, *
-* LBK(k) is the address corresponding to the ith Key-8 *
-* and the jth Key-9 value, where k = KEYS(8) * (j-1) + i *
-* LBD Address(es) of Data bank(s) DADB *
-* For option 'S' the address of the databank can only be *
-* obtained from the actual key-address: LK of the linear *
-* structure as LBD = LQ(LBK-1) *
-* ITIME Event data acquisition time (or 0, if Data not wanted) *
-* KEYS Vector of keys. Only the elements declared in CHOPT are *
-* assumed to contain useful information. *
-* When option 'M' is declared KEYS(n) (when user Key n *
-* is selected should contain the number of data objects *
-* to be retrieved according to the KEYS(n) values and *
-* the values of the key elements for Key-n to be matched *
-* should be stored in successive KEYS(i) elements, with *
-* i starting from NWKEY+1 (NWKEY is the number of key *
-* elements for this directory) *
-* CHOPT Character string with any of the following characters *
-* A trust LBK address(es) if non-zero *
-* K read only the keys (no data is required) *
-* M expect multiple Key banks to be returned (only up to *
-* a maximum of 5 user keys) *
-* S expect multiple Key banks satisfying selection on a *
-* number of keys (Options S and M are mutually exclusive) *
-* V declare the Data as being different in size to what is *
-* already resident in memory *
-* 3 selects objects with start validity time < KEYS(3) *
-* (with option S) *
-* 4 selects objects with end validity time > KEYS(4) *
-* (with option S) *
-* 5 specific Program version number required *
-* 7 select objects with insertion time < KEYS(7) *
-* n consider user key n (where 7 < n < 29 ) *
-* *
-* Called by user, DBJOIN, DBVWPR *
-* *
-* Error Condition : *
-* *
-* IQUEST(1) = 0 : No error *
-* = 1 : Illegal character option *
-* = 2 : Illegal path name *
-* = 3 : Data base structure in memory clobbered *
-* = 4 : Illegal key option *
-* *
-* If IQUEST(1) =0, IQUEST(2) carries information whether data *
-* part had been actually read from the disk or not *
-* IQUEST(2) = 0 : No disk i/o has been performed *
-* = 1 : Data have been refreshed from the disk *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
-#include "dxused.inc"
- DIMENSION KEYS(9), LBD(9), LBK(9), ITIME(9)
- CHARACTER CHOPT*(*), PATHN*(*), CHOPF*28
-*
-* ------------------------------------------------------------------
-*
-* *** Reformat CHOPT
-*
- CALL DBOPTS (CHOPT, IRC)
- IF (IRC.NE.0) THEN
- IQUEST(1) = IRC
- GO TO 999
- ENDIF
- CALL DBOPTM (CHOPF)
- CALL DBCKEY (KEYS, KEYSDX, MXKYDX)
-*
-* *** Set up a callto CDUSEDB
-*
- CALL CDUSEDB (PATHN, LBK, ITIME, MASKDX, KEYSDX, CHOPF, IRC)
- IQUEST(1) = IRC
- IF (IOPSDX.NE.0) THEN
- IF (LBK(1).NE.0) LBD(1) = LQ(KOFUCD+LBK(1)-KLDACD)
- ELSE
- NKYMX = IQUEST(3)
- DO 10 I = 1, NKYMX
- IF (LBK(I).NE.0) LBD(I) = LQ(KOFUCD+LBK(I)-KLDACD)
- 10 CONTINUE
- ENDIF
-* END DBUSE
- 999 END
diff --git a/src/packlib/hepdb/dbcdif/dbuvtx.F b/src/packlib/hepdb/dbcdif/dbuvtx.F
deleted file mode 100644
index dfb420e..0000000
--- a/src/packlib/hepdb/dbcdif/dbuvtx.F
+++ /dev/null
@@ -1,30 +0,0 @@
-*
-* $Id: dbuvtx.F,v 1.1.1.1 1996/02/28 16:25:03 mclareni Exp $
-*
-* $Log: dbuvtx.F,v $
-* Revision 1.1.1.1 1996/02/28 16:25:03 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE DBUVTX (IDAY, ITIM)
-* ==============================
-*
-************************************************************************
-* *
-* SUBR. DBUVTX (IDAY*, ITIM*) *
-* *
-* Returns the current date and time *
-* *
-* Arguments : *
-* *
-* IDAY Date in YYMMDD *
-* ITIM Time in seconds *
-* *
-* Called by DBFOPN, DBxxxx in the Example patches *
-* *
-************************************************************************
-*
- CALL CDUVTX (IDAY, ITIM)
-* END DBUVTX
- 999 END
diff --git a/src/packlib/hepdb/dbcdif/dbvin.F b/src/packlib/hepdb/dbcdif/dbvin.F
deleted file mode 100644
index dc8b2de..0000000
--- a/src/packlib/hepdb/dbcdif/dbvin.F
+++ /dev/null
@@ -1,132 +0,0 @@
-*
-* $Id: dbvin.F,v 1.1.1.1 1996/02/28 16:25:03 mclareni Exp $
-*
-* $Log: dbvin.F,v $
-* Revision 1.1.1.1 1996/02/28 16:25:03 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE DBVIN (PATHN, ITIME, USER, NDAT, IDTYP, IPRVS, NWKEY,
- + KEY, IPREC, CHOPT)
-* ================================================================
-*
-************************************************************************
-* *
-* SUBR. DBVIN (PATHN, ITIME, USER*, *NDAT*, IDTYP*, IPRVS, *
-* , NWKEY*, KEY*, IPREC*, CHOPT) *
-* *
-* Fetches from disk to a FORTRAN array data valid for a given time *
-* *
-* Restrictions : No selection on user keys can be made *
-* USER should contain variables of the same type *
-* (Integer, Real or Holllerith) *
-* *
-* Arguments : *
-* *
-* PATHN Character string describing the pathname *
-* ITIME Time for which data are required to be valid *
-* NDAT Maximum dimension of USER array (on input) *
-* Number of data words fetched from disk (on output) *
-* USER User array where data are stored *
-* IDTYP Type of the data (2 - integer; 3 - real; 5 - Hollerith) *
-* IPRVS Version number of program used when data were created *
-* (if = 0, accept any) *
-* NWKEY Length of the key vector *
-* KEY Key vector elements *
-* IPREC Precision word; (If IPREC > 0, data are stored with *
-* IPREC significant digits right to the decimal points; if*
-* IPREC < 0, data are stored with IPREC insignificant *
-* digits left to the decimal point.) *
-* CHOPT Character string with any of the following characters *
-* N If data do not exist for ITIME, take the nearest data *
-* object in time *
-* *
-* Called by user *
-* *
-* Error Condition : *
-* *
-* IQUEST(1) = 0 : No error *
-* = 31 : Illegal path name *
-* = 32 : No keys/data in this directory *
-* = 36 : Data bank address zero on return from DBKXIN *
-* = 37 : Insufficient space in USER store array *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
-#include "hepdb/cinitl.inc"
-#include "hepdb/ckkeys.inc"
-#include "dxused.inc"
- DIMENSION KEY(9), USER(9), ITIME(9)
- CHARACTER CHOPT*(*), PATHN*(*), CHOPF*28
-*
-* ------------------------------------------------------------------
-*
-* *** Reformat CHOPT
-*
- CALL DBOPTS (CHOPT, IRC)
- IF (IRC.NE.0) THEN
- IQUEST(1) = IRC
- GO TO 999
- ENDIF
- IOPFDX = 1
- CALL VZERO (KEYSDX, MXCMCK)
- IF (IPRVS.NE.0) THEN
- KEYSDX(IDHUSI) = IPRVS
- IOKYDX(IDHUSI) = 1
- ENDIF
- CALL DBOPTM (CHOPF)
-*
-* *** Set up a call to CDUSEM
-*
- LKEYDX = 0
- CALL CDUSEM (PATHN, LKEYDX, ITIME, IOKYDX, KEYSDX, CHOPF, IRC)
- IF (IRC.NE.0) THEN
- IQUEST(1) = IRC
- GO TO 999
- ELSE IF (LKEYDX.EQ.0.OR.LQ(KOFUCD+LKEYDX-KLDACD).EQ.0) THEN
- IQUEST(1) = 36
- GO TO 999
- ENDIF
-*
- LBN = LQ(KOFUCD+LKEYDX-KLNOCD)
- NDK = IQ(KOFUCD+LKEYDX-1)
- NWKEY = IQ(KOFUCD+LBN+MNDNWK)
- IPREC = IQ(KOFUCD+LKEYDX+NDK+MKYPRE)
- CALL UCOPY (IQ(KOFUCD+LKEYDX+1), KEY, NWKEY)
- LDATDX = LQ(KOFUCD+LKEYDX-KLDACD)
-*
-* ** See if the USER array size is sufficient to store the data
-*
- ND = IQ(KOFUCD+LDATDX-1)
- IF (ND.GT.NDAT) THEN
-*
-* * Insufficient space
-*
- CALL MZDROP (IDIVCD, LDATDX, 'L')
- IQUEST(1) = 37
- IQUEST(11)= NDAT
- IQUEST(12)= ND
- NDAT = 0
-#if defined(CERNLIB__DEBUG)
- IF (IDEBCD.GT.0) THEN
- CALL CDPRNT (LPRTCD, '(/,'' DBVIN : Insufficient space'//
- + ' '',I10,'' to store data - a minimum of '',I10,'' '//
- + 'storage is needed'')', IQUEST(11), 2)
- ENDIF
-#endif
-*
- ELSE
-*
-* * Every thing is OK
-*
- IDTYP = ICDTYP(LDATDX)
- CALL UCOPY (Q(KOFUCD+LDATDX+1), USER(1), ND)
- NDAT = ND
- CALL MZDROP (IDIVCD, LDATDX, 'L')
- IQUEST(1) = 0
-*
- ENDIF
-* END DBVIN
- 999 END
diff --git a/src/packlib/hepdb/dbcdif/dbvldt.F b/src/packlib/hepdb/dbcdif/dbvldt.F
deleted file mode 100644
index 39bdcc6..0000000
--- a/src/packlib/hepdb/dbcdif/dbvldt.F
+++ /dev/null
@@ -1,43 +0,0 @@
-*
-* $Id: dbvldt.F,v 1.1.1.1 1996/02/28 16:25:03 mclareni Exp $
-*
-* $Log: dbvldt.F,v $
-* Revision 1.1.1.1 1996/02/28 16:25:03 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE DBVLDT (ITMIN, ITMAX)
-* ================================
-*
-************************************************************************
-* *
-* SUBR. DBVLDT (ITMIN*, ITMAX*) *
-* *
-* Finds the overlapping validity range of all data base objects *
-* used since the last call to DBTBCR. *
-* *
-* Arguments : *
-* *
-* ITMIN Lower bound of the validity range *
-* ITMAX Upper bound of the validity range *
-* *
-* Called by user *
-* *
-* Error Condition : *
-* *
-* IQUEST(1) = 0 : No error *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
- DIMENSION IVECT(2*MXPACD)
-*
-* ------------------------------------------------------------------
-*
- CALL CDVALID (IVECT, IRC)
- ITMAX = IVECT(2)
- ITMIN = IVECT(1)
- IQUEST(1) = IRC
-* END DBVLDT
- END
diff --git a/src/packlib/hepdb/dbcdif/dbvout.F b/src/packlib/hepdb/dbcdif/dbvout.F
deleted file mode 100644
index f696c6d..0000000
--- a/src/packlib/hepdb/dbcdif/dbvout.F
+++ /dev/null
@@ -1,129 +0,0 @@
-*
-* $Id: dbvout.F,v 1.1.1.1 1996/02/28 16:25:03 mclareni Exp $
-*
-* $Log: dbvout.F,v $
-* Revision 1.1.1.1 1996/02/28 16:25:03 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE DBVOUT (PATHN, IVSTR, IVEND, NDAT, USER, IPRVS, NKEXT,
- + KEYXT, IDTYP, IPREC, CHOPT)
-* =================================================================
-*
-************************************************************************
-* *
-* SUBR. DBVOUT (PATHN, IVSTR, IVEND, NDAT, USER, IPRVS, NKEXT, *
-* KEYXT, IDTYP, IPREC, CHOPT) *
-* *
-* Stores data from a FORTRAN array to disk creating simultaneousely *
-* the directories if needed *
-* Restrictions : Only directories upto 9 keys can be created and *
-* keys should be of type INTEGER *
-* USER should contain variables of the same type *
-* (Integer, Real or Holllereith) *
-* *
-* Arguments : *
-* *
-* PATHN Character string describing the pathname *
-* IVSTR Start of validity period *
-* IVEND End of validity period *
-* NDAT Number of data word in the user array *
-* USER Array of user data words *
-* IPRVS Version number of program used for creating the data *
-* NKEXT Number of extra keys (Beyond key 5) *
-* KEYXT Vector of extra keys *
-* IDTYP Type of data (2 - Integer; 3 - Real; 5 - Hollerith) *
-* IPREC Precision word; (If IPREC > 0, data are stored with *
-* IPREC significant digits right to the decimal points; if*
-* IPREC < 0, data are stored with IPREC insignificant *
-* digits left to the decimal point.) *
-* CHOPT Character string with any of the following characters *
-* F Updates with a fully matched data object (in user keys) *
-* N Create new (sub)directory(ies) *
-* P Create partitioned subdirectories for the pathname *
-* S Create stand alone (master) data *
-* U Store data uncompressed *
-* Z Store only nonzero elements. An element is considered to*
-* be zero if its absolute value is less than IPREC (real) *
-* *
-* Called by user, DBINIT *
-* *
-* Error Condition : *
-* *
-* IQUEST(1) = 0 : No error *
-* = 62 : Too many external keys with option N *
-* *
-************************************************************************
-*
-#include "hepdb/cdcblk.inc"
-#include "hepdb/ckkeys.inc"
-#include "hepdb/clinks.inc"
-#include "dxused.inc"
- PARAMETER (JBIAS=2)
- DIMENSION KEYXT(9), USER(2)
- CHARACTER CHOPT*(*), PATHN*(*), CHOP*28
-*
-* ------------------------------------------------------------------
-*
-* *** Decode the character option
-*
- CALL DBOPTS (CHOPT, IRC)
- IF (IRC.NE.0) THEN
- IQUEST(1) = IRC
- GO TO 999
- ENDIF
-*
-* *** Reformat CHOPT
-*
- IOPNDX = 0
- IF (IOPRDX.NE.0) THEN
- IOPYDX = 1
- IOPRDX = 0
- ENDIF
- IF (IOPYDX.NE.0.OR.IOPTDX.NE.0) THEN
- IOPPDX = 0
- ELSE
- IOPPDX = 1
- ENDIF
- IF (IOPSDX.NE.0) THEN
- IOPDDX = 0
- IOPSDX = 0
- ELSE
- IOPDDX = 1
- ENDIF
- IF (IOPUDX.NE.0) THEN
- IOPPDX = 0
- IOPUDX = 0
- ENDIF
- IF (IOKYDX(7).NE.0) THEN
- IOPHDX = 1
- ELSE
- IOPHDX = 0
- ENDIF
- CALL DBOPTM (CHOP)
-*
-* *** Prepare the Key vector array
-*
- CALL VZERO (MASKDX, MXKYDX)
- IF (NKEXT.GT.2) CALL UCOPY (KEYXT(3), MASKDX(8), NKEXT-2)
- CALL DBCKEY (MASKDX, KEYSDX, MXKYDX)
- CALL VZERO (MASKDX, MXKYDX)
- KEYSDX(NOF1CK+1) = IVSTR
- KEYSDX(NOF1CK+2) = IVEND
- KEYSDX(IDHUSI) = IPRVS
-*
-* *** Create a temporary bank with the data
-*
- CALL CDBANK (IDISCD, LAUXCL(7), LAUXCL(7), JBIAS, 'AUX7', 0, 0
- + , NDAT, IDTYP, 0, IRC)
- IF (IRC.NE.0) GO TO 999
- CALL UCOPY (USER(1), Q(KOFUCD+LAUXCL(7)+1), NDAT)
-*
-* *** Write out the data
-*
- CALL CDSTOR (PATHN, LSUP, LBK, IUDIV, KEYSDX, CHOP, IRC)
- CALL MZDROP (IDISCD, LAUXCL(7), ' ')
- IQUEST(1) = IRC
-* END DBVOUT
- 999 END
diff --git a/src/packlib/hepdb/dbcdif/dxused.inc b/src/packlib/hepdb/dbcdif/dxused.inc
deleted file mode 100644
index 51f6ed7..0000000
--- a/src/packlib/hepdb/dbcdif/dxused.inc
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: dxused.inc,v 1.1.1.1 1996/02/28 16:24:54 mclareni Exp $
-*
-* $Log: dxused.inc,v $
-* Revision 1.1.1.1 1996/02/28 16:24:54 mclareni
-* Hepdb, cdlib, etc
-*
-*
-*
-* dxused.inc
-*
- PARAMETER (NSYSDX=7, MXKYDX=100)
- COMMON /DXUSED/ LDATDX, LKEYDX, KEYSDX(MXKYDX), MASKDX(MXKYDX)
- + , IOPADX, IOPBDX, IOPCDX, IOPDDX, IOPEDX, IOPFDX
- + , IOPGDX, IOPHDX, IOPIDX, IOPJDX, IOPKDX, IOPLDX
- + , IOPMDX, IOPNDX, IOPODX, IOPPDX, IOPQDX, IOPRDX
- + , IOPSDX, IOPTDX, IOPUDX, IOPVDX, IOPWDX, IOPXDX
- + , IOPYDX, IOPZDX, IOKYDX(MXKYDX)
-
diff --git a/src/packlib/hepdb/doc/Pam_header b/src/packlib/hepdb/doc/Pam_header
deleted file mode 100644
index 1f039de..0000000
--- a/src/packlib/hepdb/doc/Pam_header
+++ /dev/null
@@ -1,611 +0,0 @@
-*
-* $Id: Pam_header,v 1.2 1996/04/12 07:40:03 jamie Exp $
-*
-* $Log: Pam_header,v $
-* Revision 1.2 1996/04/12 07:40:03 jamie
-* check write acl in cdfsnd
-*
-* Revision 1.1.1.1 1996/02/28 16:23:26 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#if defined(CERNLIB__DOC)
-#include "sys/CERNLIB_machine.h"
-#include "_hepdb/pilot.h"
-
-Current version number : 0.00 (see below)
-
-Coordinator for this PAM : J.Shiers
-
-This is a 'Utility' Pam file for the storage and retrieval of data
-in the HEPDB Data Base system.
-
-
-List of Patches :
----------------
-
- CDBHEAD Pam header and short history of successive versions
- *CDLIB Steering patch for creating HEPDB library
- *CDSERV Steering patch for creating the serverinteractive
- CDCDES Commons used in the package
- CDEXAMn Example how to create Database (n=1)
- CDEXAMn Example how to use HEPDB (n=2)
- CDEXAMn Example for testing HEPDB (n=9)
- CDINIT Routines to initialize database
- CDMDIR Routines to manipuate directories
- CDDICT Routines to manipulate the dictionary directory
- CDSTORE Routines to store data in the database
- CDFZUP Routines to update the database
- CDREAD Routines to read data from the database
- CDPURGE Routines to purge data in the database
- CDPACK Routines to pack data in the database
- CDUNPACK Routines to unpack data in the database
- CDROOT Basic routines for HEPDB
- CDP3 Routines related to the Host/A.P. environment
- CDONLINE Routines related to the online server
- CDOFFLIN Routines related to the offline server
- CDPLOT Routines related to the plotting fcailities of database
- package
- CDMAIN Main program for interactive usage and example of Logon
- macros
- CDXINT Routines related to interactive database accesses
-
-
-PATCHY Options :
---------------
-
- APOLLO, CRAY, HPUX,
- IBM, IBMRT, MIP,
- UNIX, VAX - To select machine dependent codes
- $P3CHILD - To select the child task dependent code
- $HIGZ - To select the plotting facilities in the interactive
- version.
- $DOC - To flag the (non-executable) documentation Patches
- $DEBUG - To switch on the debug print outs
- $SERVER - To activate the codes for servers
- $INIMODE - To switch on the initialisation mode in CDEXAM2
- $PARTDIR - To test partitioned directories in CDEXAM9
-
-
-Extra material required :
-
- CERN libraries KERNLIB, PACKLIB + GRAFLIB for the interactive package
-
-B. Error codes :
- -----------
-
- The following table summarizes the meanings of the error codes
-returned in IRC.
-
-
- +-----+------------------------------------------------+--------------+
- |Error| Meaning | Routine Name |
- |Code | | |
- +-----+------------------------------------------------+--------------+
- | -1 |Invalid top directory name | CDINIT |
- | | | |
- | -2 |The file is already open with correct LUNRZ and | CDINIT |
- | |TOPNM | |
- | | | |
- | -3 |The file is already open with wrong LUNRZ or | CDINIT |
- | |TOPNM | |
- | | | |
- | -5 |Invalid process name in Online context | CDINIT |
- | | | |
- | -6 |Error in IC_BOOK for booking the CACHE | CDINIT |
- | | | |
- | -7 |Error in CC_SETUP for reserving the CLUSCOM | CDINIT |
- | | | |
- | -8 |Error in opening journal file in server mode | CDFOPN |
- | | | |
- | -9 |Unable to open FZ communication channel | CDINIT |
- | | | |
- | -10 |Host unable to open RZ file | CDINIT |
- | | | |
- | -11 |Access to database file denied | CDOPEN |
- | | | |
- | -12 |Error mapping Unix path to VMS format |CDFSND/CDPREF |
- | | | |
- | -13 |Write access to DB denied - journal file not | CDFSND |
- | |sent to server | |
- +-----+------------------------------------------------+--------------+
- | 1 |Illegal character option |CDUSEDB/CDUSEM|
- | | | |
- | 2 |Illegal path name |CDGETDB/CDUSE/|
- | | |CDUSEM |
- | | | |
- | 3 |Data base structure in memory clobbered |CDUSE/CDUSEDB/|
- | | |CDUSEM |
- | | | |
- | 4 |Illegal key option |CDUSE/CDUSEDB/|
- | | |CDUSEM |
- | | | |
- | 5 |Error in CDCHLD in P3 communication | CDUSP3 |
- +-----+------------------------------------------------+--------------+
- | 12 |Illegal pathname | CDNODE |
- | | | |
- | 13 |Not enough structural link to support a new Node| CDNODE |
- | | | |
- | 15 |Cannot define IO descriptor for Key bank | CDNODE |
- +-----+------------------------------------------------+--------------+
- | 21 |Too many keys with option M | CDKMUL |
- | | | |
- | 22 |Illegal key option | CDKMUL |
- | | | |
- | 24 |No Key bank created satisfying key options for | CDBKKS |
- | |option S | |
- | | | |
- | 25 |Illegal Path Name | CDBKKS |
- +-----+------------------------------------------------+--------------+
- | 31 |Illegal path name or path name in node bank |CDCHCK/CDKXIN/|
- | |is wrong |CDPRIN |
- | | | |
- | 32 |No keys/data in this directory |CDCHCK/CDGETDB|
- | | |CDPRIN |
- | | | |
- | 33 |No valid data for the given range of insertion | CDKXIN |
- | |time or for the given set of keys and program | |
- | |version number | |
- | | | |
- | 34 |RZIN fails to read the data | CDRZIN |
- | | | |
- | 35 |Wrong reference to data objects in update mode | CDKXIN |
- | | | |
- | 36 |Data bank address zero on return from CDKXIN | CDCHCK |
- | | | |
- | 37 |Insufficient space in USER store array | CDCHCK |
- | | | |
- | 38 |Read error in getting the RZ date and time | CDPRDT |
- | | | |
- | 39 |Illegal data type in the key descriptor | CDPRKY |
- +-----+------------------------------------------------+--------------+
- | 43 |Too many key elements | CDMDIR |
- | | | |
- | 44 |Cannot find the top directory name | CDMDIR |
- | |(wrong initialization) | |
- | | | |
- | 45 |Illegal Path name | CDMDIR |
- | | | |
- | 47 |The Directory already exists | CDMKDI |
- | | | |
- | 48 |Error in directory search sequence | CDMKDI |
- | | | |
- | 49 |FZOUT fails to write on the sequential file | CDSDIR |
- +-----+------------------------------------------------+--------------+
- | 51 |Illegal character option | CDFREE |
- | | | |
- | 52 |No access to the Key banks | CDFREE |
- | | | |
- | 54 |Pathname not matched to that found in bank NODB | CDFREE |
- | | | |
- | 57 |Illegal pathname | CDFREE |
- | | | |
- | 58 |Database structure in memory clobbered | CDFREE |
- | | | |
- | 59 |Some of the expected key banks not found | CDFREE |
- +-----+------------------------------------------------+--------------+
- | 61 |Too many keys |CDENTB/CDREPL |
- | | | |
- | 62 |Illegal character option |CDREPL/CDSTOM |
- | | | |
- | 63 |Data base structure in memory clobbered |CDREPL/CDSTOR |
- | | | |
- | 64 |Error in MZCOPY while copying Data bank |CDREPL/CDSTOR |
- | | | |
- | 65 |Illegal number of data objects | CDSTOM |
- | | | |
- | 66 |Illegal logical unit number |CDATOI/CDRHLP |
- | | | |
- | 67 |File too long; no space in buffer | CDATOI |
- | | | |
- | 68 |Input directory is partitioned | CDPART |
- | | | |
- | 69 |Input directory is not partitioned | CDPURP |
- | | | |
- | 70 |Error in deleting a partition through RZDELT | CDPURP |
- +-----+------------------------------------------------+--------------+
- | 71 |Illegal path name |CDDONT/CDENFZ/
- | | |CDENTB/CDFZUP/|
- | | |CDKOUT/CDPART/|
- | | |CDPURP/CDRTFZ |
- | | | |
- | 72 |Read error on the FZ file (journal file) |CDENFZ/CDFZUP |
- | | | |
- | 73 |RZOUT fails to write on disk |CDDONT/CDENFZ/|
- | | |CDENTB/CDKOUT/|
- | | |CDPART/CDPURP |
- | | | |
- | 74 |Error in RZRENK in updating key values for |CDENFZ/CDENTB/|
- | |partitioned data set |CDKOUT/CDPART/|
- | | |CDPURP |
- | | | |
- | 76 |Cannot form the IO descriptor for the FZ header |CDDONT/CDENTB/|
- | | |CDFZUP/CDFZWR/|
- | | |CDKOUT/CDPART |
- | | | |
- | 77 |FZOUT fails to write on the sequential journal |CDDONT/CDENFZ/|
- | |file |CDENTB/CDFZWR/|
- | | |CDKOUT/CDPART/|
- | | |CDPURP |
- | | | |
- | 78 |Illegal number of keys on data base/journal file|CDFZUP/CDKOUT |
- | | | |
- | 79 |Top directory name illegal in the FZ file | CDFZUP |
- +-----+------------------------------------------------+--------------+
- | 81 |Precision is not correctly given | CDUCMP |
- | | | |
- | 82 |Illegal Data Type | CDUCMZ |
- | | | |
- | 83 |Data update but uncompreseed | CDUNCP |
- | | | |
- | 84 |The update structure has different number of | CDUNCP |
- | |data words | |
- | | | |
- | 85 |No data in the structure | CDUNCP |
- | | | |
- | 86 |The update structure has different data type | CDUNCP |
- +-----+------------------------------------------------+--------------+
- | 91 |Illegal Character Option | CDOPTS |
- | | | |
- | 92 |Nonstandard IO descriptor | CDFRUS |
- | | | |
- | 93 |Illegal time |CDPKTM/CDUPTM |
- | | | |
- | 94 |Nonmatching NPAR's in different UPCD banks | CDVALID |
- | | | |
- | 95 |Description not found in the dictionary | CDLDIC |
- | | | |
- | 96 |RZCDIR fails to set to the current directory | CDLDUP |
- | | | |
- | 97 |No matching UPCD bank found |CDLDUP/CDVALID|
- | | | |
- | 98 |Invalid path name in Node bank | CDSTAT |
- | | | |
- | 99 |No space in memory for creating the bank |CDBANK/CDRZIN |
- +-----+------------------------------------------------+--------------+
- | 111 |Illegal path name |CDPURG/CDPURK |
- | | | |
- | 112 |No key or data for the path name |CDPURG/CDPURK |
- | | | |
- | 113 |Illegal character option | CDPURK |
- | | | |
- | 114 |Valid data object(s) in the Node/Key structure | CDPURK |
- | | | |
- | 115 |Cannot form the IO descriptor for the FZ header | CDSPUR |
- | | | |
- | 116 |FZOUT fails to write on the sequential file | CDSPUR |
- +-----+------------------------------------------------+--------------+
- | 131 |Illegal pathname (in key bank for CDLAST) |CDLAST/CDLKEY/|
- | | |CDLMOD |
- | | | |
- | 132 |Illegal number of keys in the directory |CDLAST/CDLKEY |
- | | |CDLMOD |
- | | | |
- | 135 |Illgeal Top directory name |CDFZOP/CDILDU |
- | | | |
- | 136 |Illegal logical unit number |CDILDF/CDILDU/|
- | | |CDJOUR |
- +-----+------------------------------------------------+--------------+
- | 140 |Illegal top directory name |CDMDIC/CDUDIC |
- | | | |
- | 141 |Error in creating the DICTIONARY/HELP directory |CDRDIC/CDUDIC |
- | | | |
- | 142 |Error in RZ in writing the dictionary object |CDCDIC/CDRDIC/|
- | | |CDUDIC |
- | | | |
- | 143 |Error in RZ in purging the dictionary directory |CDCDIC/CDRDIC/|
- | | |CDUDIC |
- | | | |
- | 144 |Dictionary directory cannot be loaded | CDCDIC |
- | | | |
- | 145 |Pathname already exists in the dictionary | CDCDIC |
- | | | |
- | 146 |Illegal path name |CDDINF/CDEALI |
- | | |CDEHLP/CDENAM/|
- | | |CDGNAM/CDRHLP/|
- | | |CDRNAM |
- | | | |
- | 147 |Dictionary directory not found in memory |CDEALI/CDGNAM/|
- | | |CDRNAM |
- | | | |
- | 148 |FZOUT fails to write on the sequential file |CDEALI/CDRDIC/|
- | | |CDSNAM |
- | | | |
- | 149 |Error in RZ for writing to the R.A. file |CDEALI/CDSNAM |
- | | | |
- | 150 |Illegal number of data words | CDENAM |
- | | | |
- | 151 |No description of data elements for the given |CDGNAM/CDRNAM |
- | |path name exists in the data base | |
- | | | |
- | 152 |Illegal flag (IFLAG) | CDSNAM |
- | | | |
- | 153 |FZIN error for reading the data structure | CDSNAM |
- | | | |
- | 154 |Illegal alias name for a directory | CDRALI |
- | | | |
- | 155 |No HELP directory inside the data base | CDRHLP |
- | | | |
- | 156 |No help information for this path stored yet | CDRHLP |
- +-----+------------------------------------------------+--------------+
- | 171 |Illegal Path name | CDDDIR |
- | | | |
- | 172 |Cannot find the top directory for the path name | CDDDIR |
- | | | |
- | 173 |Error in RZ for reading the dictionary object | CDDDIR |
- | | | |
- | 174 |Error in FZOUT for saving the journal file | CDDDIR |
- | | | |
- | 175 |Error in RZ in writing the dictionary object | CDDDIR |
- | | | |
- | 176 |Error in RZ in purging the dictionary directory | CDDDIR |
- | | | |
- | 177 |Error in RZ in deleting the tree | CDDDIR |
- | | | |
- | 178 |Error in RZ in deleting Name/Help information | CDDDIR |
- +-----+------------------------------------------------+--------------+
- | 191 |Illegal path name | CDRENK |
- | | | |
- | 192 |Specified key elements do not match with any of | CDRENK |
- | |the existing set of keys | |
- | | | |
- | 194 |Cannot form the IO descriptor for the FZ header | CDRENK |
- | | | |
- | 195 |FZOUT fails to write on the sequential journal | CDRENK |
- | |file | |
- | | | |
- | 196 |Error in RZRENK in updating key values | CDRENK |
- | |partitioned data set | |
- | | | |
- | 199 |Corrupted data | CDAFRI |
- +-----+------------------------------------------------+--------------+
- | 211 |Illegal number of paths | CDKEEP |
- | | | |
- | 212 |Illegal path name |CDFPAT/CDKEEP |
- | | | |
- | 213 |Conflicting top directory names | CDKEEP |
- +-----+------------------------------------------------+--------------+
- | 221 |Error in CC_WRITELOCK for locking CLUSCOM (VAX);| CDWLOK |
- | | | |
- | 222 |Error in CC_RELEASE for releasing CLUSCOM (VAX) | CDCWSV |
- | | | |
- | 223 |Error in IC_SIGNAL for signalling the VAX Server| CDCWSV |
- | | | |
- | 225 |Error in sending spool file to the server (IBM | CDSTSV |
- | |or APOLLO) | |
- +-----+------------------------------------------------+--------------+
- | 301 |Illegal database prefix | CDPREF |
- | | | |
- | 302 |Reserved database prefix | CDPREF |
- | | | |
- | 311 |CDSERV variable not defined | CDPREF/CDACL |
- | | | |
- +-----+------------------------------------------------+--------------+
-
-
-
-C. Format for FZ output :
- --------------------
-
- HEPDB can create a journal file and can also update a data base from
-the corresponding journal file. The journal file format is defined as an
-FZ record consisting of a header and the data part. The format is
-general enough and can also be used for the communication betwen the
-server and a process which wants to update the data base.
-
- The data part of the FZ record is relevant for storage of data, help/
-name information and also for creation of the directory. For storage of
-data, the data part of the FZ record is exactly the same data structure
-as input to CDSTOR. For efficiency reason, HEPDB for its own journal
-file stores the data structure as input to the RZOUT call. This
-difference can be easily recognised from the value of KEY(1), which is
-zero for outside source and nonzero for HEPDB's own journal file.
-
- For creation of the directory, the data part consists of one bank
-containing IPREC for the directory in the numeric user identifier and
-the data word containing DELTA. For help/name information, the encoded
-information packed into one ZEBRA bank is stored in the journal file
-along with the header part with the directory/key information.
-
- The header part has very similar structure for the eight actions
-foreseen so far, e.g., entering data, creating new directories, deleting
-data objects, deleting a directory tree, renaming the keys, entering
-names of data elements or help information for a directory, entering
-alias name to a directory, deleting a few partitions in a partitioned
-directory. However, they differ in details and the eight different types
-of FZ headers are listed below.
-
- Header for entering data :
-
- +----------+----------+------+----------------------------------------+
- |Word Count| Mnemonic | Type | Content |
- +----------+----------+------+----------------------------------------+
- | 1 | IACT | I | Action code (=1) |
- | 2 | NWKEY | I | Number of key elements |
- | 3 | NWDOP | I | Number of words used to store CHOPT |
- | 4 | NDOP | I | Number of words used to to store the |
- | | | | path name |
- | 5 | IPREC | I | Precision chosen for packing |
- | | | | (see DBENTR) |
- | 6 | KEY(1) | I | Key element 1 |
- | .. | ... | .. | ........ |
- | NWKEY+5 |KEY(NWKEY)| .. | Key element NWKEY |
- | NWKEY+6 | CHOPT | H | Character option |
- | .. | .. | H | |
- | NWKEY+6 | PATHN | H | Path name |
- | +NWDOP | | | |
- | .. | .. | H | |
- +----------+----------+------+----------------------------------------+
-
- Header for creating directories :
-
- +----------+----------+------+----------------------------------------+
- |Word Count| Mnemonic | Type | Content |
- +----------+----------+------+----------------------------------------+
- | 1 | IACT | I | Action code (=2) |
- | 2 | NWKEY | I | Number of key elements |
- | 3 | NWDOP | I | Number of words used to store CHOPT |
- | 4 | NDOP | I | Number of words used to to store the |
- | | | | path name |
- | 5 | MXKP | I | Maximum number of objects inside one |
- | | | | partition (see DBMDIP) |
- | 6 | INSTM | I | Insertion time packed up to minutes |
- | | | | (see DBPKTM) |
- | 7 | NRECD | I | Unused at this moment |
- | 8 | CHOPT | H | Character option (e.g., 'P' for a |
- | .. | ... | .. | partitioned directory) |
- | NDOP+8 | CHFOR | H | Description of key element type. This |
- | .. | .. | .. | information is stored in NCFO = (NWKEY |
- | .. | .. | .. | +3)/4 words |
- | NDOP+8 | CHTAG | H | Tags for each key element. This info. |
- | +NCFO | .. | .. | is stored in NTAG = 2*NWKEY words. |
- |NDOP+NCFO | PATHN | H | Path name |
- | +NTAG+8 | | | |
- | .. | .. | H | |
- +----------+----------+------+----------------------------------------+
-
- Header for deleting objects :
-
- +----------+----------+------+----------------------------------------+
- |Word Count| Mnemonic | Type | Content |
- +----------+----------+------+----------------------------------------+
- | 1 | IACT | I | Action code (=3) |
- | 2 | NWKEY | I | Number of key elements |
- | 3 | NWDOP | I | Number of words used to store CHOPT |
- | 4 | NDOP | I | Number of words used to to store the |
- | | | | path name |
- | 5 | NPARS | I | Number of pairs of validity range (set |
- | | | | for CDPURK) or -1 for CDPURG |
- | 6 | INSTM | I | Deletion time packed up to minutes |
- | | | | (see DBPKTM) |
- | 7 | ISEL(1) | I | The objects to be selected using the |
- | .. | ... | | validity criteria in CDPURK |
- | NPARS+6 | ISEL(n) | I | |
- | NPARS+7 | KEY(1) | I | Key element 1 for CDURK |
- | | ... | .. | ......... |
- | NENDK | KEY(n) | .. | Key element NWKEY for CDPURK |
- | 7 | KYDAT | I | To be used for CDPURG |
- | 8 | KYTIM | I | To be used for CDPURG |
- | .. | ... | .. | |
- | NENDK | | | NWKEYth word following KYDAT for CDPURG|
- | NENDK+1 | CHOPT | H | Character option |
- | .. | ... | .. | |
- | NENDK+1 | PATHN | H | Path name |
- | +NWDOP | | | |
- | .. | .. | H | |
- +----------+----------+------+----------------------------------------+
-
- Header for deleting directories :
-
- +----------+----------+------+----------------------------------------+
- |Word Count| Mnemonic | Type | Content |
- +----------+----------+------+----------------------------------------+
- | 1 | IACT | I | Action code (=4) |
- | 2 | --- | I | Unused (set to 0) |
- | 3 | NWDOP | I | Number of words used to store CHOPT |
- | 4 | NDOP | I | Number of words used to to store the |
- | | | | path name |
- | 5 | --- | I | Unused (set to 0) |
- | 6 | INSTM | I | Deletion time packed up to minutes |
- | | | | (see DBPKTM) |
- | 7 | CHOPT | H | Character option |
- | NWDOP+7 | PATHN | H | Path name |
- | .. | .. | H | |
- +----------+----------+------+----------------------------------------+
-
- Header for renaming keys :
-
- +----------+----------+------+----------------------------------------+
- |Word Count| Mnemonic | Type | Content |
- +----------+----------+------+----------------------------------------+
- | 1 | IACT | I | Action code (=5) |
- | 2 | NWKEY | I | Number of key elements |
- | 3 | NWDOP | I | Number of words for CHOPT (= 0) |
- | 4 | NDOP | I | Number of words used to to store the |
- | | | | path name |
- | 5 | Unused | I | Set to zero |
- | 6 | KYO(1) | I | Old key element 1 |
- | .. | ... | .. | ........ |
- | NWKEY+5 |KYO(NWKEY)| .. | Old key element NWKEY |
- | NWKEY+6 | KYN(1) | I | New key element 1 |
- | .. | .. | .. | ........ |
- |2*NWKEY+5 |KYO(NWKEY)| .. | New key element NWKEY |
- |2*NWKEY+6 | PATHN | H | Path name |
- | .. | .. | H | |
- +----------+----------+------+----------------------------------------+
-
- Header for entering/deleting names or help information :
-
- +----------+----------+------+----------------------------------------+
- |Word Count| Mnemonic | Type | Content |
- +----------+----------+------+----------------------------------------+
- | 1 | IACT | I | Action code (=6) |
- | 2 | NWKEY | I | Number of key elements |
- | 3 | NWDOP | I | Number of words used to store CHOPT |
- | 4 | NDOP | I | Number of words used to to store the |
- | | | | path name (DICTIONARY or HELP) |
- | 5 | IFLAG | I | Flag (1 for help information; 2 for |
- | | | | names of the data elements) |
- | 6 | KEY(1) | I | Key element 1 ( = Identifier of path) |
- | .. | ... | .. | ........ |
- | NWKEY+5 |KEY(NWKEY)| .. | Key element NWKEY |
- | NWKEY+6 | CHOPT | H | Character option |
- | .. | ... | .. | ........ |
- | NWKEY+ | | | |
- | NWDOP+6 | PATHN | H | Path name (DICTIONARY or HELP) |
- | .. | .. | H | |
- +----------+----------+------+----------------------------------------+
-
- Header for entering the alias name :
-
- +----------+----------+------+----------------------------------------+
- |Word Count| Mnemonic | Type | Content |
- +----------+----------+------+----------------------------------------+
- | 1 | IACT | I | Action code (=7) |
- | 2 | --- | I | Unused (set to 0) |
- | 3 | NWDOP | I | Number of words used to store CHOPT(=0)|
- | 4 | NDOP | I | Number of words used to to store the |
- | | | | path name of the dictitionary |
- | 5 | IFLAG | I | Flag (0 means temporary; 1 permanent) |
- | 6 | NWDP | I | Number of words used to store the |
- | | | | path name |
- | 7 | PATHD | H | Path name of the dictionary |
- | .. | .. | H | |
- | NDOP+7 | ALIAS | H | Alias name |
- | .. | .. | H | |
- | NDOP+9 | PATHN | H | Path name of the directory |
- | .. | .. | H | |
- +----------+----------+------+----------------------------------------+
-
- Header for deleting a few partitions in a partitioned directory :
-
- +----------+----------+------+----------------------------------------+
- |Word Count| Mnemonic | Type | Content |
- +----------+----------+------+----------------------------------------+
- | 1 | IACT | I | Action code (=8) |
- | 2 | --- | I | Unused (set to 0) |
- | 3 | NWDOP | I | Number of words used to store CHOPT |
- | 4 | NDOP | I | Number of words used to to store the |
- | | | | path name |
- | 5 | INSTM | I | Deletion time packed up to minutes |
- | | | | (see CDPKTM) |
- | 6 | NKEEP | I | Number of partitions to be kept |
- | 7 | CHOPT | H | Character option |
- | NWDOP+7 | PATHN | H | Path name of the directory |
- | .. | .. | H | |
- +----------+----------+------+----------------------------------------+
-
- Header for recreation of dictionary record :
-
- +----------+----------+------+----------------------------------------+
- |Word Count| Mnemonic | Type | Content |
- +----------+----------+------+----------------------------------------+
- | 1 | IACT | I | Action code (=10) |
- | 2 | NWKEY | I | Number of key elements (=0) |
- | 3 | NWDOP | I | Number of words used to store CHOPT (0)|
- | 4 | NDOPI | I | Number of words used to store the |
- | | | | path name |
- | 5 | PATHN | H | Path name |
- +----------+----------+------+----------------------------------------+
-
-#endif
diff --git a/src/packlib/hepdb/doc/history b/src/packlib/hepdb/doc/history
deleted file mode 100644
index 52848a6..0000000
--- a/src/packlib/hepdb/doc/history
+++ /dev/null
@@ -1,229 +0,0 @@
-*
-* $Id: history,v 1.1.1.1 1996/02/28 16:23:25 mclareni Exp $
-*
-* $Log: history,v $
-* Revision 1.1.1.1 1996/02/28 16:23:25 mclareni
-* Hepdb, cdlib, etc
-*
-*
-* This directory was created from hepdb.car patch history
-
-Pam history in inverse chronological order:
--------------------------------------------
-
-*** WARNING CDMOVF must be compiled /NOOPT with old (e.g. V6.1)
- versions of DEC Fortran on OpenVMS
-
-Outstanding:
-============
-
-- CDPURG problems (WA97,NOMAD)
-
-- WA98 wishlist
-
-Version 1.20=CDPREF: use LDBFL rather than LFILE In FTOVAX call
- CDINIT/CDNEW: correct handling of new RZ format
- CDCHAR: lun should be LPRTCD
- CDFSND: use CDUNIQ to generate target filename
- CDMOVE: stop file can be tailored by env. CDSTOP
- RUN_HEPDB: vscrna no longer has vxcern cluster alias
- CDKPAK,CDKUPK: pack/unpack (time) commands
- CDLLS: limit NFOUND to NMAX (Rob Komar)
- CDHSTC,CDSOPN: mods from Doug Cowen - UPENN
- CDNEW: option 7 - new RZ format
- CDCTOI,CDATOI,CDVECT: correct UHTOC calls (missing KOFUCD)
- Mods to support
- (1) Hierarchy among the validity range keys (Default)
- (2) No hierarchy (option A) to be specified at the time
- of creation of the database
- Changes to:
- CDINIT and routines calling it : CDOPEN, CDNEW, CDUPDT, CDSHAR
- CDFRST, CDSTAT, CDFZUP, CDLDUP to access the flag
- CDVALID, CDPVAL, CDBKKS, CDCHCK, CDKSEL, CDPSEL for using it.
- (Sunanda Banerjee)
-Version 1.19=CDFSND,CDPREF: fix compile errors on VMS
- P=CDFZUP, CDPURG, mods from Boris Khomenko
- CDFSND, CDPREF: mods to handle Unix path/file names on VMS.
- CDMOVF. mods for UCX NFS. (This and above from Joseph Unger)
- CDDELF: use rm -f rather than rm.
- CDEX: add patches CDEX, CX77 for Boris Khomenko's "expert"
- interface.
- CDPKTM/S: minor bug fixes
- CDEXIT: call CDEND to close QQ files
- 94B
-Version 1.18=CDOPEN: increase CDOPTS string
- HDBSERV: process failed journal files
- P=CDINIT: mods from Boris Khomenko
- CDMOVF: add CHOPT: IOPTK - keep input file (else delete)
- CDSEND: use CDMOVF on VMS.
- CDSERV: skip 'last.kumac' files
- CDMOVE: include CZDUMM for VMS
- CDSNAM: call cdstsv also on VAX if=$server,if=-$online
- CDOPEN/CDINIT: option T: suppress check on maximum insertion time
- CDFZUP: previous change (1.17) resulted in IO descriptor
- for IACT=1 becoming undefined.
- CDSERV: skip also QQ files
- CDSERV: add z=slate
- CDEND: add option S for server - don't send journal file
- CDSERV: more printout, better protection
- CDGETP: get PID of server - only if nodename matches!
- CDMOVE: increase hostname from 20 to 80 characters
- CDSERV: add CDTRAP, CDWAKE to handle Unix signals.
- CDMAKE: correct handling for CDFILE & CDPAIR env. variables
- CDSERV: stop if < cdtmin secs left IF=VAX,IF=BATCH
- Fix bug in CDSEND for VMS (prefix was corrupted).
- 19/03/94 13:00
-Version 1.17=CDBACKUP: new program and script to backup all database
- files.
- CDACL: define CDMODE
- CDSERV: split print statement for unrecognised prefix
- CDHEPDB: correct bug in handling # RDR files
- CDMOVE: correct handling of remote queue directory
- CDLLS: call lib$find_file_end
- CDFZUP: handle insertion of multiple objects in same
- non-partitioned directory correctly (Boris Khomenko)
- CDMOVE: protect against no list of servers defined.
- CDFOPN: print suggestions in case of open errors
- Add CDACL(C) to process :read & :write tags on databases
- Convert calls to CDSAVE to CDSTSV so that name can be
- reused for user-callable routine. Add CDSAVE(CHTOP,CHOPT,IRC)
- to permit purging of pending updates.
- Mods from Sundanda to recreate DICTIONAIRY in case of
- corruption and to permit merging of two databases.
- CDLOGF: protect against problem with ACCESS='APPEND' in
- DEC Fortran 6.1
- CDAFRI: protection against corrupted data (Boris KHOMENKO)
- CDLINC: change flags for DECS and other little endian machines
- Add option C to CDEND - close permanently journal file
- regardless of option A.
-Version 1.16=Add header line to CDCHECK.COM
- Bug fixes to CDEXTR, CDRTFZ, CDCONF
- Delete CDCTOI from CDXINT
- New routines from Sunanda; updates to CDPURK
- Use CLEFT instead of CCOPYL for VIDQQ
- CDLKEY: set LCDRCD and IKDRCD in case of partitioned directories
- CDSERV: increase size of PAWC
- Add CDMOVE.COM and .sh
- CDSOPN: fix bug in OPEN for Unix
- CDMOVE: call CZDUMM (VMS) to avoid linking against system
- Generic Unix version (Sunanda Banerjee)
- Windows, MSDOS & Linux flags (Valery Fine)
-Version 1.15=CDEXAM1: correct call to CDNEW
- CDPAW: change IXDIV to IDIV in arg. list (Boris KHOMENKO)
- CDCONF: better diagnostics in case of bad HEPDB.NAMES
- VIDQQ identification
- CDOPNC: set IDIV to 0 on first entry. Set LTOP correctly
- Add QMVAOS flag for Alpha OSF
- CDHEPDB: extra protection against network problems
- CDLS,CDLIST,CDOPEN: correct placement of DATA statements
- Move LTOPCD to before KULOGN
- V93D (07/09/93)
- Reduce wait time in CDSEND.COM to 10 minutes (from 30)
-Version 1.14=CDMOVE: protect against NFOUND>MAXFIL
- Correct call to CDPWD in CDZOOM (add CHOPT)
- Save and restore current directory in CDLMOD.
- CDFSND. handle VAX correctly (cannot rename across devices)
- Add CDMOVF to 'mv' a file on VAX. Add CDGTLG (logname translation)
- CDSHOW: change LOUTCD to LPRTCD
- CDTEXT: write text to LPRTCD if IOPTP
- -A option on PWD (show alias). Extra options on TREE
- command. Alias support in CD.
- CDOUTP: reset also IQPRNT.
- CDDELF: correct flag for VM
- CDKOUT: correct +SELF for VAX server version, If=-$ONLINE
- CDSERV: mods to print statements in CDSEND/BACK/BAD
- Both above from Vitoria Bonaiti/NOMAD
- Mods from Sunanda Banerjee for alias support in Fortran interface
- Mods to following patches:
- CDCDES, CDUTIL, CDMDIR, CDDICT, CDSTORE, CDFZUP, CDREAD.
- CDPURGE, CDPACK, CDUNPACK, CDROOT, CDP3, CDPLOT.
- CDONLINE, CDXINT, DBCDIF.
- Checkpoint before including Sundanda's mods
-Version 1.13=CDSERV: protection against errors in CDUPDT.
- CDCONF: make local queue directories if they do not exist
- Bug fix in CDEXAM6 (length of PAWC).
- Add command CDHELP. Modify CDRHLP, CDAFRI and all calling
- routines to add CHOPT: 'C' = print carriage control in col1
- Save and restore current directory in CDALIA
- Bug fix in CDLDC for zero length options string
- Add patch CDMOVE - move journal files between servers
- a la FATSEND.
- Fix uninitialiased variables from HP installation
- Add CDJOUR exec to check for disk space on journal disk
- and cleanup if required. Modify CDBACK to call it.
- CDSERV, CDSTSV: send journal file only if file has been used
- HDBSERV.EXEC: exit 99 if timer expires
- CDSERV: skip active (ZZ) files
- 23/02/93 10:00
-Version 1.12=Change Z=CDUSER to Z=CDUSCM. CDUNIQ for VM.
- Add patch CDDUMP, to dump journal files (headers only)
- CDPREF: prefix ZZ is reserved - do not allow it
- CDSERV: print only fn.ft in CDSERV on VAX to avoid record overflow
- P=COM: fixes to CDCHECK, CDSEND
- CDSEND: copy file then rename with correct database prefix.
- CDHEPDB: protection against zero length files
- CDSERV: add CDDELF to delete original journal file (new file
- is always written by server)
- Sundry bug fixes in CDHEPDB, debug in CDSERV.
- CDOPEN: use C I/O if file is STREAM_LF
- CDINIT: permit also options X and C for RZFILE call in
- public mode
- CDLOGF: correct OPEN for VAX/VMS (avoid integer underflow!)
- CDPRNT: protect against 0 length array
- Add CDSEND.COM to move updates between 'master' and 'slave'
- across NFS (assumes correct UID/GID mapping)
- CDLLS: write temporary files in current directory
-Version 1.11=Add patch CDMAKE to build a new, empty database. Database
- parameters are taken from CDxxxx environmental variables.
- Add patch CDHEPDB: code to transfer updates cernvm<->hepdb
- CDKSEL: selection also on experiment keys (was just KOFUSI)
- Add CDLIST, CDLDIR routines (a la ls,ld HEPDB commands)
- Rework CDF for new KUIP.
- Master/slave concept for VM servers. :queue points directly
- to service machine who is master server or gateway machine
- e.g. for transfer to node HEPDB.
- Bad files are moved to directory pointed to by :bad.
- Server stops on bad files.
- CDSERV: master server is one where :todo and :queue
- directories are the same. Generally, :queue is client
- queue and :todo is server queue.
- Extend command string in CDLLS to 255
- Introduce master/slave server concept.
- The master server processes all updates allocating a
- unique KEY(1) per directory and setting the insertion
- date and time.
-Version 1.10=V93A 15/01/93 13:30
-Version 1.02=Increase size of Zebra store to 1M words in CDSERV
- Print user keys according to I/O char in CDLS
- Delete CDLAST from P=CDSERV
- Add selection in CDLS. Close LUNFZ in CDLOAD
- Modify CDLOGL to permit //CHTOP as well as CHTOP.
- Add patch CPLEAR containing example CPLEAR conversion programs.
- Change HEPDB close command to RZCLOSE.
- Corrections to CDEND - drop top bank if IOPTA,
- otherwise drop specified bank
- VAX version IF=$ONLINE uses CLUSCOM, otherwise standard
- updating mechanism (via files)
- Reset top directory in CDINIT
- 15/10/92. Reorganise PAM
-Version 1.01=Add P=REXX,D=HDBSERV (exec for VM server). Fix bugs
- in names file handling, case sensitivity in CDSERV.
-Version 1.00=V92B July 20 1992. First release...
-Version 0.05=July 07 1992.
- Conversion of flags to CERNLIB standard (partially)
- Install and test on VM. Add NPRE argument and F option to CDNEW
- (preformat NPRE records for VM only)
-Version 0.04=June 19 1992.
- Basic server functions checked out (except forwarding of
- updates to remote servers)
-Version 0.03=June 16 1992.
- CDSERV now uses NAMEFD etc.
-Version 0.02=May 27 1992.
- All patches converted. Interactive i/f still requires some
- work, as does server patch (CDSERV).
-Version 0.01=May 1992.
- Convert DB routines to new calling sequence. Reorganise pam.
- DBL3 compatibility mode interface routines in DBCDIF.
- All patches converted except DBXINT
-Version 0.00=April 1992
- First copy of DBL3 V3.11, Sunanda Banerjee
diff --git a/src/packlib/hepdb/examples/dbexam/cdex/Imakefile b/src/packlib/hepdb/examples/dbexam/cdex/Imakefile
deleted file mode 100644
index deb2a94..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdex/Imakefile
+++ /dev/null
@@ -1,7 +0,0 @@
-SRCS_F= blandeck.F cderrms.F cdex.F cdex_db.F cdex_ux.F \ @@\
- cdexe1.F cdi_mess.F cdx_end.F cdx_mess.F cdxini0.F cdxiniz.F \ @@\
- cdxseq.F cdzseq.F cxaaaa.F cxddir.F cxlist.F cxmdir.F cxnew.F \ @@\
- cxopen.F cxpaw.F cxpref.F cxpurg.F cxtext.F cxtime.F dbread.F \ @@\
- rzxchch.F rzxseq.F texpkj.F uxnewp.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/hepdb/examples/dbexam/cdex/blandeck.F b/src/packlib/hepdb/examples/dbexam/cdex/blandeck.F
deleted file mode 100644
index 2ddfed2..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdex/blandeck.F
+++ /dev/null
@@ -1,37 +0,0 @@
-*
-* $Id: blandeck.F,v 1.1.1.1 1996/02/28 16:23:37 mclareni Exp $
-*
-* $Log: blandeck.F,v $
-* Revision 1.1.1.1 1996/02/28 16:23:37 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
-#if defined(CERNLIB_COMMENT)
-*
-*-------------------------------------------------
-* Selection flags: IBMVM , UNIX , COMMENT
-* ================
-*-------------------------------------------------
-* Additional libraries:
-* =====================
-* CX77 (khomenko)
-* --------------
-* jsearc_ jseanc_ jlasnc_
-* texstr_ texins_ texnme_
-* ifsheqc_
-* encodi_ encodr_ hexenc_
-*
-* CERNLIB
-* -------
-* jbyt_ cltou_
-*
-* mzlink_
-* cdstat_ cdpref_ cdopen_ cdddir_ cdnew_
-* cdend_ cdmdir_ cdtext_ cdpaw_ cdpurg_
-* cdpkts_ cdpktm_ cdupts_ cduptm_ cdlist_
-* rzcdir_ rzndir_ rzldir_ rzclos_ rzdelt_ rzend_
-*-------------------------------------------------
-#endif
-*****************************************************
-* CDEX Version 1.0 * khomenko at cernvm.cern.ch *
diff --git a/src/packlib/hepdb/examples/dbexam/cdex/cderrms.F b/src/packlib/hepdb/examples/dbexam/cdex/cderrms.F
deleted file mode 100644
index 64d4d3d..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdex/cderrms.F
+++ /dev/null
@@ -1,301 +0,0 @@
-*
-* $Id: cderrms.F,v 1.1.1.1 1996/02/28 16:23:41 mclareni Exp $
-*
-* $Log: cderrms.F,v $
-* Revision 1.1.1.1 1996/02/28 16:23:41 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDERRMS(IRC,MESS)
-* -----------------------====-
-*
-c ***************************************
-c * This routine returns a message text *
-c * corresponding to a given IRC value *
-c * ................................... *
-c * Its code is generated by a special *
-c * program (Author: Boris Khomenko) *
-c * using the information about HEPDB *
-c * Return Codes from the deck CDBHEAD *
-c * Date of generation: 07/06/94 *
-c ***************************************
-*
- IMPLICIT NONE
- INTEGER IRC
- CHARACTER*(*) MESS
-*
- MESS='No assosiated message'
- IF(IRC.EQ.0) MESS='No error'
- IF(IRC.EQ. -1 ) MESS=
- + 'Invalid top directory name '
- IF(IRC.EQ. -2 ) MESS=
- + 'The file is already open with correct LUNRZ and '
- + //'TOPNM '
- IF(IRC.EQ. -3 ) MESS=
- + 'The file is already open with wrong LUNRZ or '
- + //'TOPNM '
- IF(IRC.EQ. -5 ) MESS=
- + 'Invalid process name in Online context '
- IF(IRC.EQ. -6 ) MESS=
- + 'Error in IC_BOOK for booking the CACHE '
- IF(IRC.EQ. -7 ) MESS=
- + 'Error in CC_SETUP for reserving the CLUSCOM '
- IF(IRC.EQ. -8 ) MESS=
- + 'Error in opening journal file on Apollo in the '
- + //'server mode '
- IF(IRC.EQ. -9 ) MESS=
- + 'Unable to open FZ communication channel '
- IF(IRC.EQ. -10 ) MESS=
- + 'Host unable to open RZ file '
- IF(IRC.EQ. -11 ) MESS=
- + 'Access to database file denied '
- IF(IRC.EQ. 1 ) MESS=
- + 'Illegal character option '
- IF(IRC.EQ. 2 ) MESS=
- + 'Illegal path name '
- IF(IRC.EQ. 3 ) MESS=
- + 'Data base structure in memory clobbered '
- IF(IRC.EQ. 4 ) MESS=
- + 'Illegal key option '
- IF(IRC.EQ. 5 ) MESS=
- + 'Error in CDCHLD in P3 communication '
- IF(IRC.EQ. 12 ) MESS=
- + 'Illegal pathname '
- IF(IRC.EQ. 13 ) MESS=
- + 'Not enough structural link to support a new Node '
- IF(IRC.EQ. 15 ) MESS=
- + 'Cannot define IO descriptor for Key bank '
- IF(IRC.EQ. 21 ) MESS=
- + 'Too many keys with option M '
- IF(IRC.EQ. 22 ) MESS=
- + 'Illegal key option '
- IF(IRC.EQ. 24 ) MESS=
- + 'No Key bank created satisfying key options for '
- + //'option S '
- IF(IRC.EQ. 25 ) MESS=
- + 'Illegal Path Name '
- IF(IRC.EQ. 31 ) MESS=
- + 'Illegal path name or path name in node bank '
- + //'is wrong '
- IF(IRC.EQ. 32 ) MESS=
- + 'No keys/data in this directory '
- IF(IRC.EQ. 33 ) MESS=
- + 'No valid data for the given range of insertion '
- + //'time or for the given set of keys and program '
- + //'version number '
- IF(IRC.EQ. 34 ) MESS=
- + 'RZIN fails to read the data '
- IF(IRC.EQ. 35 ) MESS=
- + 'Wrong reference to data objects in update mode '
- IF(IRC.EQ. 36 ) MESS=
- + 'Data bank address zero on return from CDKXIN '
- IF(IRC.EQ. 37 ) MESS=
- + 'Insufficient space in USER store array '
- IF(IRC.EQ. 38 ) MESS=
- + 'Read error in getting the RZ date and time '
- IF(IRC.EQ. 39 ) MESS=
- + 'Illegal data type in the key descriptor '
- IF(IRC.EQ. 43 ) MESS=
- + 'Too many key elements '
- IF(IRC.EQ. 44 ) MESS=
- + 'Cannot find the top directory name '
- + //'(wrong initialization) '
- IF(IRC.EQ. 45 ) MESS=
- + 'Illegal Path name '
- IF(IRC.EQ. 47 ) MESS=
- + 'The Directory already exists '
- IF(IRC.EQ. 48 ) MESS=
- + 'Error in directory search sequence '
- IF(IRC.EQ. 49 ) MESS=
- + 'FZOUT fails to write on the sequential file '
- IF(IRC.EQ. 51 ) MESS=
- + 'Illegal character option '
- IF(IRC.EQ. 52 ) MESS=
- + 'No access to the Key banks '
- IF(IRC.EQ. 54 ) MESS=
- + 'Pathname not matched to that found in bank NODB '
- IF(IRC.EQ. 57 ) MESS=
- + 'Illegal pathname '
- IF(IRC.EQ. 58 ) MESS=
- + 'Database structure in memory clobbered '
- IF(IRC.EQ. 59 ) MESS=
- + 'Some of the expected key banks not found '
- IF(IRC.EQ. 61 ) MESS=
- + 'Too many keys '
- IF(IRC.EQ. 62 ) MESS=
- + 'Illegal character option '
- IF(IRC.EQ. 63 ) MESS=
- + 'Data base structure in memory clobbered '
- IF(IRC.EQ. 64 ) MESS=
- + 'Error in MZCOPY while copying Data bank '
- IF(IRC.EQ. 65 ) MESS=
- + 'Illegal number of data objects '
- IF(IRC.EQ. 66 ) MESS=
- + 'Illegal logical unit number '
- IF(IRC.EQ. 67 ) MESS=
- + 'File too long; no space in buffer '
- IF(IRC.EQ. 68 ) MESS=
- + 'Input directory is partitioned '
- IF(IRC.EQ. 69 ) MESS=
- + 'Input directory is not partitioned '
- IF(IRC.EQ. 70 ) MESS=
- + 'Error in deleting a partition through RZDELT '
- IF(IRC.EQ. 71 ) MESS=
- + 'Illegal path name '
- IF(IRC.EQ. 72 ) MESS=
- + 'Read error on the FZ file (journal file) '
- IF(IRC.EQ. 73 ) MESS=
- + 'RZOUT fails to write on disk '
- IF(IRC.EQ. 74 ) MESS=
- + 'Error in RZRENK in updating key values for '
- + //'partitioned data set '
- IF(IRC.EQ. 76 ) MESS=
- + 'Cannot form the IO descriptor for the FZ header '
- IF(IRC.EQ. 77 ) MESS=
- + 'FZOUT fails to write on the sequential journal '
- + //'file '
- IF(IRC.EQ. 78 ) MESS=
- + 'Illegal number of keys on data base/journal file '
- IF(IRC.EQ. 79 ) MESS=
- + 'Top directory name illegal in the FZ file '
- IF(IRC.EQ. 81 ) MESS=
- + 'Precision is not correctly given '
- IF(IRC.EQ. 82 ) MESS=
- + 'Illegal Data Type '
- IF(IRC.EQ. 83 ) MESS=
- + 'Data update but uncompreseed '
- IF(IRC.EQ. 84 ) MESS=
- + 'The update structure has different number of '
- + //'data words '
- IF(IRC.EQ. 85 ) MESS=
- + 'No data in the structure '
- IF(IRC.EQ. 86 ) MESS=
- + 'The update structure has different data type '
- IF(IRC.EQ. 91 ) MESS=
- + 'Illegal Character Option '
- IF(IRC.EQ. 92 ) MESS=
- + 'Nonstandard IO descriptor '
- IF(IRC.EQ. 93 ) MESS=
- + 'Illegal time '
- IF(IRC.EQ. 94 ) MESS=
- + 'Nonmatching NPAR"s in different UPCD banks '
- IF(IRC.EQ. 95 ) MESS=
- + 'Description not found in the dictionary '
- IF(IRC.EQ. 96 ) MESS=
- + 'RZCDIR fails to set to the current directory '
- IF(IRC.EQ. 97 ) MESS=
- + 'No matching UPCD bank found '
- IF(IRC.EQ. 98 ) MESS=
- + 'Invalid path name in Node bank '
- IF(IRC.EQ. 99 ) MESS=
- + 'No space in memory for creating the bank '
- IF(IRC.EQ. 111 ) MESS=
- + 'Illegal path name '
- IF(IRC.EQ. 112 ) MESS=
- + 'No key or data for the path name '
- IF(IRC.EQ. 113 ) MESS=
- + 'Illegal character option '
- IF(IRC.EQ. 114 ) MESS=
- + 'Valid data object(s) in the Node/Key structure '
- IF(IRC.EQ. 115 ) MESS=
- + 'Cannot form the IO descriptor for the FZ header '
- IF(IRC.EQ. 116 ) MESS=
- + 'FZOUT fails to write on the sequential file '
- IF(IRC.EQ. 131 ) MESS=
- + 'Illegal pathname (in key bank for CDLAST) '
- IF(IRC.EQ. 132 ) MESS=
- + 'Illegal number of keys in the directory '
- IF(IRC.EQ. 135 ) MESS=
- + 'Illgeal Top directory name '
- IF(IRC.EQ. 136 ) MESS=
- + 'Illegal logical unit number '
- IF(IRC.EQ. 140 ) MESS=
- + 'Illegal top directory name '
- IF(IRC.EQ. 141 ) MESS=
- + 'Error in creating the DICTIONARY/HELP directory '
- IF(IRC.EQ. 142 ) MESS=
- + 'Error in RZ in writing the dictionary object '
- IF(IRC.EQ. 143 ) MESS=
- + 'Error in RZ in purging the dictionary directory '
- IF(IRC.EQ. 144 ) MESS=
- + 'Dictionary directory cannot be loaded '
- IF(IRC.EQ. 145 ) MESS=
- + 'Pathname already exists in the dictionary '
- IF(IRC.EQ. 146 ) MESS=
- + 'Illegal path name '
- IF(IRC.EQ. 147 ) MESS=
- + 'Dictionary directory not found in memory '
- IF(IRC.EQ. 148 ) MESS=
- + 'FZOUT fails to write on the sequential file '
- IF(IRC.EQ. 149 ) MESS=
- + 'Error in RZ for writing to the R.A. file '
- IF(IRC.EQ. 150 ) MESS=
- + 'Illegal number of data words '
- IF(IRC.EQ. 151 ) MESS=
- + 'No description of data elements for the given '
- + //'path name exists in the data base '
- IF(IRC.EQ. 152 ) MESS=
- + 'Illegal flag (IFLAG) '
- IF(IRC.EQ. 153 ) MESS=
- + 'FZIN error for reading the data structure '
- IF(IRC.EQ. 154 ) MESS=
- + 'Illegal alias name for a directory '
- IF(IRC.EQ. 155 ) MESS=
- + 'No HELP directory inside the data base '
- IF(IRC.EQ. 156 ) MESS=
- + 'No help information for this path stored yet '
- IF(IRC.EQ. 171 ) MESS=
- + 'Illegal Path name '
- IF(IRC.EQ. 172 ) MESS=
- + 'Cannot find the top directory for the path name '
- IF(IRC.EQ. 173 ) MESS=
- + 'Error in RZ for reading the dictionary object '
- IF(IRC.EQ. 174 ) MESS=
- + 'Error in FZOUT for saving the journal file '
- IF(IRC.EQ. 175 ) MESS=
- + 'Error in RZ in writing the dictionary object '
- IF(IRC.EQ. 176 ) MESS=
- + 'Error in RZ in purging the dictionary directory '
- IF(IRC.EQ. 177 ) MESS=
- + 'Error in RZ in deleting the tree '
- IF(IRC.EQ. 178 ) MESS=
- + 'Error in RZ in deleting Name/Help information '
- IF(IRC.EQ. 191 ) MESS=
- + 'Illegal path name '
- IF(IRC.EQ. 192 ) MESS=
- + 'Specified key elements do not match with any of '
- + //'the existing set of keys '
- IF(IRC.EQ. 194 ) MESS=
- + 'Cannot form the IO descriptor for the FZ header '
- IF(IRC.EQ. 195 ) MESS=
- + 'FZOUT fails to write on the sequential journal '
- + //'file '
- IF(IRC.EQ. 196 ) MESS=
- + 'Error in RZRENK in updating key values '
- + //'partitioned data set '
- IF(IRC.EQ. 199 ) MESS=
- + 'Corrupted data '
- IF(IRC.EQ. 211 ) MESS=
- + 'Illegal number of paths '
- IF(IRC.EQ. 212 ) MESS=
- + 'Illegal path name '
- IF(IRC.EQ. 213 ) MESS=
- + 'Conflicting top directory names '
- IF(IRC.EQ. 221 ) MESS=
- + 'Error in CC_WRITELOCK for locking CLUSCOM (VAX); '
- IF(IRC.EQ. 222 ) MESS=
- + 'Error in CC_RELEASE for releasing CLUSCOM (VAX) '
- IF(IRC.EQ. 223 ) MESS=
- + 'Error in IC_SIGNAL for signalling the VAX Server '
- IF(IRC.EQ. 225 ) MESS=
- + 'Error in sending spool file to the server (IBM '
- + //'or APOLLO) '
- IF(IRC.EQ. 301 ) MESS=
- + 'Illegal database prefix '
- IF(IRC.EQ. 302 ) MESS=
- + 'Reserved database prefix '
- IF(IRC.EQ. 311 ) MESS=
- + 'CDSERV variable not defined '
-*
- END
diff --git a/src/packlib/hepdb/examples/dbexam/cdex/cdex.F b/src/packlib/hepdb/examples/dbexam/cdex/cdex.F
deleted file mode 100644
index 6ead1a7..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdex/cdex.F
+++ /dev/null
@@ -1,346 +0,0 @@
-*
-* $Id: cdex.F,v 1.1.1.1 1996/02/28 16:23:39 mclareni Exp $
-*
-* $Log: cdex.F,v $
-* Revision 1.1.1.1 1996/02/28 16:23:39 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- PROGRAM CDEX
-* ------------
-*----------------------------------------------*
-* Test program for the CD (HEPDB) package *
-*----------------------------------------------*
-*
- PARAMETER (MWPAWC=100000)
- COMMON /PAWC/ IPAWC(MWPAWC)
-*
-* (ICDXDIV,LCDXDIV)
-#include "cdxdiv.inc"
-* (LUNINP,LUNOUT,LUNPRO,LUNCMD)
-#include "cdxluns.inc"
-#include "cdxfils.inc"
-#include "yeaaas.inc"
-*
- CHARACTER*8 FNAME,PRFX,ANSW
- CHARACTER INPL*80, LINE*80, CODE*11, PRF*8, CH2*2, CH*1
- CHARACTER IFLN(20)*80, IFANSW*12
- CHARACTER*60 FILNAME , FILNM(10)
- LOGICAL OK
- CHARACTER MESL*78
-*
- INTEGER IFNX , LPRF
-*
- CALL CDX_MESS(' ')
- CALL CDX_MESS('---- CDEX start ----')
-*
- YEAAAS=' '
- CALL CDXINI0
-*
- ILUN=LUNINP
- ILUF=0
- INPL=' '
-*
-* -- by default, call CDPAW
- INPL='CDPAW'
-*
-#if !defined(CERNLIB_IBMVM)
- FILNAME='cdex_init'
-#endif
-#if defined(CERNLIB_IBMVM)
- FILNAME='/CDEX INIT *'
-#endif
- INQUIRE(FILE=FILNAME,EXIST=OK)
- IF(OK) THEN
- CALL CDX_MESS('*** "cdex_init" exists')
- INPL='EXEC '//FILNAME
- ELSE
- CALL CDX_MESS('*** "cdex_init" NOT FOUND')
- ENDIF
-*
-* -- if there is a command, bypass the command reading
- JDIV=0
- JMAX=LNBLNK(INPL)
- IF(JMAX.GT.0) GOTO 11
-*
- 10 CONTINUE
- INPL=' '
- IF(ILUF.LE.0) THEN
- IF(ICDXDIV.LE.0) THEN
- CALL CDX_MESS('#####################')
- CALL CDX_MESS('Please call CDPAW !!!')
- CALL CDX_MESS('#####################')
- ENDIF
- CALL CDX_MESS('----')
- CODE='CDEX>'
- IF(YEAAAS.NE.' ') CODE(5:)='(Y)>'
- LL=LNBLNK(CODE)
-#if !defined(CERNLIB_IBMVM)
- WRITE(*,'(A,$)') CODE(:LL)
-#endif
-#if defined(CERNLIB_IBMVM)
- WRITE(*,'( A )') CODE(:LL)
-#endif
- ENDIF
- READ(ILUN,'(A)',END=77) INPL
- LTEX=MAX0(LNBLNK(INPL),1)
- IF(ILUF.GT.0) THEN
- CALL CDX_MESS('**>'//INPL(:LTEX)//'<**')
- ELSE
- CALL CDX_PROT(CODE(:LL)//INPL(:LTEX))
- IF(LTEX.EQ.1.AND.INPL(LTEX:LTEX).EQ.' ')
- + CALL CDX_MESS('Type: H -help, Q -quit')
- ENDIF
- IF(INPL(1:1).EQ.'*'.OR.INPL(1:2).EQ.' *') GOTO 10
- IF(INPL(1:1).EQ.'#'.OR.INPL(1:2).EQ.' #') GOTO 10
- JMAX=INDEX(INPL,'!')-1
- IF(JMAX.LT.0) JMAX=LTEX
- IF(JMAX.LE.0) GOTO 10
- JDIV=0
-*
- 11 CONTINUE
- IF(JDIV.GE.JMAX) GOTO 10
- J=JSEANC(INPL(JDIV+1:),' ')
- IF(J.LE.0) GOTO 10
- JDIV=JDIV+J-1
- LLIN=JSEARC(INPL(JDIV+1:JMAX),';$')-1
- IF(LLIN.LT.0) LLIN=INDEX(INPL(JDIV+1:JMAX),' ')-1
- IF(LLIN.LT.0) LLIN=JMAX-JDIV
- JDIV=JDIV+LLIN+1
- IF(LLIN.LE.0) GOTO 11
-*
- LINE=INPL(JDIV-LLIN:JDIV-1)
- JPAK=LLIN
- IFTX=0
- IFOK=1
- NXL=0
-*
- 12 CONTINUE
- CALL TEXINS(LINE,JPAK,IFTX,FNAME,NUMB,FNUM)
- IF(IFTX.LE.0) GOTO 11
- NXL=JBYT(IFTX,1,2)
-CCCC IF(NXL.EQ.3) JPAK=JPAK-200
- CALL CLTOU(FNAME)
- LFN=INDEX(FNAME,' ')-1
- IF(LFN.LT.0) LFN=LEN(FNAME)
-*
- IFEXE=0
- IF(IFSHEQC(FNAME(:LFN),'HELP').GT.0) THEN
- IFEXE=-1
-c*** 1 2 3 4
-c*** 1234567890123456789012345678901234567890
- CALL CDX_MESS( '=============================== Help for'
- + // ' CDEX ================================')
-*
-* call other routines to type their help for commands
- CALL CDEXE1(LINE,0,IFEXE)
-*
- CALL CDX_MESS('> CDPAW [par/val ...] [-opt]')
- CALL CDX_MESS('> CDNEW [par/val ...] [-opt] [chtop filename]')
- CALL CDX_MESS('> CDPREF ; CDOPEN')
- CALL CDX_MESS('> CDMDIR ; CDDDIR')
- CALL CDX_MESS('> CDTEXT [par/val ...] [LBANK] [filename]')
- CALL CDX_MESS('> CDPURG')
- CALL CDX_MESS('> CDLIST')
- CALL CDX_MESS('> CDTM ; CDTS')
- CALL CDX_MESS('> CDPKTM ; CDPKTS ; CDUPTM ; CDUPTS')
- CALL CDX_MESS('> CDERMS')
- CALL CDX_MESS('> CDSTAT ; CDEND ')
- CALL CDX_MESS('>')
- CALL CDX_MESS('> DBFiles DBREAD')
- CALL CDX_MESS('>')
- CALL CDX_MESS('> RZCDIR ; RZLDIR ; RZNDIR')
- CALL CDX_MESS('> RZDELT')
- CALL CDX_MESS('> RZCLOS ; RZCLOS')
- CALL CDX_MESS('>')
- CALL CDX_MESS('> EXEC filename ; CHAIN filename')
- CALL CDX_MESS('> SETYES ; SETASK ; PRON ; PROFF')
-*
-* type a concluding help for commands in the given routine
- CALL CDX_MESS('Help Quit EXit')
- CALL CDX_MESS('","=" " in commands. Use ";"'
- + //' or 3 spaces to separate commands in a line')
- CALL CDX_MESS('========================================'
- + // '======================================')
-*
- ELSE IF(FNAME.EQ.'CDPAW ') THEN
- IFEXE=1
- CALL CXPAW(MWPAWC,LINE,JPAK,IERR)
-*
- ELSE IF(FNAME.EQ.'CDNEW ') THEN
- IFEXE=1
- CALL CXNEW(LINE,JPAK,IERR)
-*
- ELSE IF(FNAME.EQ.'CDOPEN') THEN
- IFEXE=1
- CALL CXOPEN(LINE,JPAK,IERR)
-*
- ELSE IF(FNAME.EQ.'CDMDIR') THEN
- IFEXE=1
- CALL CXMDIR(LINE,JPAK,IERR)
-*
- ELSE IF(FNAME.EQ.'CDDDIR') THEN
- IFEXE=1
- CALL CXDDIR(LINE,JPAK,IERR)
-*
- ELSE IF(FNAME.EQ.'CDTEXT') THEN
- IFEXE=1
- CALL CXTEXT(LINE,JPAK,IERR)
-*
- ELSE IF(FNAME.EQ.'CDPKTM'.OR.FNAME.EQ.'CDPKTS'.OR.
- + FNAME.EQ.'CDUPTM'.OR.FNAME.EQ.'CDUPTS'.OR.
- + FNAME.EQ.'CDTM '.OR.FNAME.EQ.'CDTS ') THEN
- IFEXE=1
- CALL CXTIME(FNAME,LINE,JPAK,IERR)
-*
- ELSE IF(FNAME.EQ.'CDSTAT') THEN
- IFEXE=1
- CALL CDSTAT(LUNOUT,IRC)
- CALL UXIRCM('CDSTAT',IRC)
-*
- ELSE IF(FNAME.EQ.'CDERMS') THEN
- IFEXE=1
- CALL TEXINS(LINE,JPAK,IFTX,FNAME,NUMB,FNUM)
- CALL CDI_MESS('>>CALL CDERMS(0,errmes)',NUMB)
- CALL UXIRCM('errmes',NUMB)
-*
- ELSE IF(FNAME.EQ.'CDPURG') THEN
- IFEXE=1
- CALL CXPURG(LINE,JPAK,IERR)
-*
- ELSE IF(FNAME.EQ.'CDLIST') THEN
- IFEXE=1
- CALL CXLIST(LINE,JPAK,IERR)
-*
-* ............... DB part .................
-*
- ELSE IF(FNAME.EQ.'DBREAD') THEN
- IFEXE=1
- CALL DBREAD(LINE,JPAK,IERR)
-*
- ELSE IF(IFSHEQC(FNAME(:LFN),'DBF*ILES').GT.0) THEN
- IFEXE=1
- CALL UXFILLS
-*
- ELSE IF(IFSHEQC(FNAME(:LFN),'DBR*ECORD').GT.0) THEN
- IFEXE=1
-CC\\ CALL CDXDBR(LINE,JPAK,IERR)
-*
- ELSE IF(FNAME.EQ.'RZCDIR'.OR.
- + FNAME.EQ.'RZNDIR'.OR.
- + FNAME.EQ.'RZLDIR'.OR.
- + FNAME.EQ.'RZDELT'.OR.
- + FNAME.EQ.'RZEND '.OR.
- + FNAME.EQ.'RZCLOS' ) THEN
- IFEXE=1
- CALL RZXCHCH(FNAME,LINE,JPAK,IERR)
-
-*
- ELSE IF(FNAME.EQ.'EXEC') THEN
- IFEXE=1
- CALL TEXSTR(LINE,JPAK,IFTX,FILNAME)
- INQUIRE(FILE=FILNAME,EXIST=OK)
- IF(OK) THEN
- ILUF=ILUF+1
- ILUN=LUNCMD+ILUF-1
- OPEN(ILUN,FILE=FILNAME,STATUS='OLD')
- INQUIRE(ILUN,NAME=FILNAME)
- JJ=INDEX(FILNAME,']')
- LL=INDEX(FILNAME,';')
- IF(JJ.GT.0.AND.LL.GT.JJ+1) FILNAME=FILNAME(JJ+1:LL-1)
- FILNM(ILUF)=FILNAME
- LFLNM=LNBLNK(FILNM(ILUF))
- CALL CDX_MESS('*** Execute: "'//FILNM(ILUF)(:LFLNM)//'"')
- ELSE
- CALL CDX_MESS('*** Exec file NOT FOUND')
- IERR=9990+ILUF
- ENDIF
-*
- ELSE IF(FNAME.EQ.'CHAIN') THEN
- IFEXE=1
- CALL TEXSTR(LINE,JPAK,IFTX,FILNAME)
- INQUIRE(FILE=FILNAME,EXIST=OK)
- IF(OK) THEN
- LFLNM=LNBLNK(FILNM(ILUF))
- CALL CDX_MESS ('*** Closing "'//FILNM(ILUF)(:LFLNM)//'"')
- CLOSE(ILUN)
- OPEN(ILUN,FILE=FILNAME,STATUS='OLD')
- INQUIRE(ILUN,NAME=FILNAME)
- JJ=INDEX(FILNAME,']')
- LL=INDEX(FILNAME,';')
- IF(JJ.GT.0.AND.LL.GT.JJ+1) FILNAME=FILNAME(JJ+1:LL-1)
- FILNM(ILUF)=FILNAME
- LFLNM=LNBLNK(FILNM(ILUF))
- CALL CDX_MESS('*** Chain to "'//FILNM(ILUF)(:LFLNM)//'"')
- ELSE
- CALL CDX_MESS('*** Exec file NOT FOUND')
- IERR=9990+ILUF
- ENDIF
-*
- ELSE IF(FNAME.EQ.'SETYES') THEN
- IFEXE=1
- YEAAAS='Y'
-*
- ELSE IF(FNAME.EQ.'SETASK') THEN
- IFEXE=1
- YEAAAS=' '
-*
- ELSE IF(FNAME.EQ.'PRON') THEN
- IFEXE=1
- CALL CDX_SETPR(1)
- ELSE IF(FNAME.EQ.'PROFF') THEN
- IFEXE=1
- CALL CDX_SETPR(0)
- ELSE IF(FNAME.EQ.'PROCL') THEN
- IFEXE=1
- CALL CDX_SETPR(-1)
- ELSE IF(IFSHEQC(FNAME(:LFN),'Q*UIT').GT.0
- + .OR.IFSHEQC(FNAME(:LFN),'EX*IT').GT.0) THEN
- IFEXE=99
- ELSE
- CALL CDEXE1(LINE,0,IFEXE)
- ENDIF
- IF(IFEXE.EQ.0) CALL CDX_MESS
- + ('>>'//FNAME(:LFN)//'<< ignored. Type: H -help, Q -quit')
-*
- IF(ILUF.GT.0.AND.IERR.NE.0) THEN
-* -- stop file(s) execution (error) --
- CALL CDX_MESS('EXEC/CHAIN INTERRUPTED')
- DO I=ILUF,1,-1
- CLOSE(LUNCMD+I-1)
- LFLNM=LNBLNK(FILNM(I))
- CALL CDX_MESS('*** Closing "'//FILNM(I)(:LFLNM)//'"')
- ENDDO
- ILUF=0
- ILUN=LUNINP
- ENDIF
-*
- IF(IFEXE.EQ.99) GOTO 99
- GOTO 11
-*
- 77 CONTINUE
- IF(ILUF.GT.0) THEN
- LFLNM=LNBLNK(FILNM(ILUF))
- CALL CDX_MESS ('*** End of "'//FILNM(ILUF)(:LFLNM)//'"')
- CLOSE(ILUN)
- FILNM(ILUF)='-'
- ILUF=ILUF-1
- IF(ILUF.GT.0) THEN
- ILUN=LUNCMD+ILUF-1
- LFLNM=LNBLNK(FILNM(ILUF))
- CALL CDX_MESS('*** Back to "'//FILNM(ILUF)(:LFLNM))
- ELSE
- ILUF=0
- ILUN=LUNINP
- ENDIF
- ELSE
- CALL CDX_MESS('----End of TERM input----')
- ILUN=0
- ENDIF
- IF(ILUN.GT.0) GOTO 10
-*
- 99 CONTINUE
- CALL CDX_END
- CALL CDX_MESS('----- CDEX end -----')
- END
diff --git a/src/packlib/hepdb/examples/dbexam/cdex/cdex_db.F b/src/packlib/hepdb/examples/dbexam/cdex/cdex_db.F
deleted file mode 100644
index f2c7ee2..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdex/cdex_db.F
+++ /dev/null
@@ -1,50 +0,0 @@
-*
-* $Id: cdex_db.F,v 1.1.1.1 1996/02/28 16:23:39 mclareni Exp $
-*
-* $Log: cdex_db.F,v $
-* Revision 1.1.1.1 1996/02/28 16:23:39 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE DBLISF(CMND,NENT)
-* ----------------------------
-* -- Author : Boris Khomenko 10/02/94
- IMPLICIT NONE
-*
- CHARACTER CMND*(*)
- INTEGER NENT
-*
-#include "cdxfils.inc"
-*
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-CC
-CC+KEEP,CDXFILS.
-CC*
-CC INTEGER MCDXFIL
-CC PARAMETER (MCDXFIL = 10)
-CC COMMON /CDXFILS/ NCDXFIL,KCDXFIL,
-CC + ICXFSTA(10),CDXFPRF(10),CDXFTOP(10),CDXFNAM(10)
-CC INTEGER NCDXFIL, KCDXFIL, ICXFSTA
-CC CHARACTER CDXFPRF*2, CDXFTOP*8, CDXFNAM*40
-CC
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-*
-* -- externals --
- INTEGER LNBLNK
-*
-* -- local variables --
- CHARACTER MESL*78
- INTEGER LMES
-*
- INTEGER K , LL , LR
-*
- MESL=' '
- LL=MAX0(LNBLNK(CMND),1)
- LL=LL+4
- MESL(3:LL)=CMND//'>>'
- DO 111 K=0,NCDXFIL
- CALL UXFILLN(0,MESL(LL+2:),LR)
- LL=LL+LR
- 111 CONTINUE
- END
diff --git a/src/packlib/hepdb/examples/dbexam/cdex/cdex_ux.F b/src/packlib/hepdb/examples/dbexam/cdex/cdex_ux.F
deleted file mode 100644
index 7edaecb..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdex/cdex_ux.F
+++ /dev/null
@@ -1,280 +0,0 @@
-*
-* $Id: cdex_ux.F,v 1.1.1.1 1996/02/28 16:23:39 mclareni Exp $
-*
-* $Log: cdex_ux.F,v $
-* Revision 1.1.1.1 1996/02/28 16:23:39 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE UXCPARM(COMND,PNAME,LVNEW,CVNEW,LVOLD,CVOLD,CVDEF)
-* -------------------------------------------------------------
-*
-* -- Author : Boris Khomenko 10/02/94
- IMPLICIT NONE
-*
-* -- arguments --
- CHARACTER*(*) COMND,PNAME,CVNEW,CVOLD,CVDEF
- INTEGER LVNEW,LVOLD
-*
-* -- externals --
- INTEGER LNBLNK
-*
- CHARACTER*8 CMND,PARM
- CHARACTER*11 CNEW , COLD , CDEF
- CHARACTER*6 TXNEW , TXOLD , TXDEF
- CHARACTER MESL*78
- INTEGER LMES
- INTEGER JJ , LL
-*
- CMND=COMND
- PARM=' '
- LL=LNBLNK(PNAME)
- IF(LL.GT.0) THEN
- JJ=LEN(PARM)
- PARM(MAX0(JJ-LL,1):)=PNAME(:LL)
- PARM(JJ:JJ)='/'
- ENDIF
-*
- CNEW=CVNEW
- COLD=CVOLD
- CDEF=CVDEF
-*
- TXNEW=' (new)'
- TXOLD=' old='
- TXDEF=' * ='
- IF(LVNEW.EQ.1) TXNEW='(*new)'
- IF(LVOLD.EQ.1) TXOLD=' *old='
- IF(LVNEW.EQ.1.OR.LVOLD.EQ.1) TXDEF='$'
- IF(LVNEW.GT.0) THEN
- IF(LVOLD.LE.0) THEN
- TXNEW=' set:'
- IF(LVNEW.EQ.1) TXNEW=' *set:'
- TXOLD='#'
- ELSE IF(CNEW.EQ.COLD.AND.LVNEW.EQ.LVOLD) THEN
- TXNEW=' (old)'
- IF(LVNEW.EQ.1) TXNEW='(*old)'
- TXOLD='#'
- ENDIF
- IF(TXOLD.EQ.'#'.AND.LVNEW.EQ.1) TXOLD='$'
- ELSE IF(LVNEW.LE.0) THEN
- TXNEW='sorry?'
- TXOLD='$'
- ENDIF
-*
- IF(TXOLD(1:1).NE.'#') THEN
- MESL='>>'//CMND//' '//TXNEW//' '//PARM//CNEW//
- + TXOLD//COLD//TXDEF//CDEF
- ELSE
- MESL='>>'//CMND//' '//TXNEW//' '//PARM//CNEW//TXDEF//CDEF
- ENDIF
- LMES=INDEX(MESL,'$')-1
- IF(LMES.LE.0) LMES=LEN(MESL)
- CALL CDX_MESS(MESL(:LMES))
-*
- END
-*
-*
- SUBROUTINE UXIPARM(COMND,PNAME,LVNEW,IVNEW,LVOLD,IVOLD,IVDEF)
-* -------------------------------------------------------------
-*
-* -- Author : Boris Khomenko 10/02/94
- IMPLICIT NONE
-*
-* -- arguments --
- CHARACTER*(*) COMND,PNAME
- INTEGER IVNEW,IVOLD,IVDEF
- INTEGER LVNEW,LVOLD
-*
-* -- local variables --
- CHARACTER*11 CVNEW,CVOLD,CVDEF
- INTEGER LL
-*
- CALL ENCODI(IVNEW,-1,CVNEW,LL)
- CALL ENCODI(IVOLD,-1,CVOLD,LL)
- CALL ENCODI(IVDEF,-1,CVDEF,LL)
-*
- CALL UXCPARM(COMND,PNAME,LVNEW,CVNEW,LVOLD,CVOLD,CVDEF)
- END
-*
-*
- SUBROUTINE UXRPARM(COMND,PNAME,LVNEW,RVNEW,LVOLD,RVOLD,RVDEF)
-* -------------------------------------------------------------
-*
-* -- Author : Boris Khomenko 10/02/94
- IMPLICIT NONE
-*
-* -- arguments --
- CHARACTER*(*) COMND,PNAME
- INTEGER RVNEW,RVOLD,RVDEF
- INTEGER LVNEW,LVOLD
-*
-* -- local variables --
- CHARACTER*11 CVNEW,CVOLD,CVDEF
- INTEGER LL
-*
- INTEGER IRPREC
- DATA IRPREC/54/
-*
- CALL ENCODR(RVNEW,-IRPREC,CVNEW,LL)
- CALL ENCODR(RVOLD,-IRPREC,CVOLD,LL)
- CALL ENCODR(RVDEF,-IRPREC,CVDEF,LL)
-*
- CALL UXCPARM(COMND,PNAME,LVNEW,CVNEW,LVOLD,CVOLD,CVDEF)
- END
-*
-*
- SUBROUTINE UXFILLS
-* ------------------
-* -- Author : Boris Khomenko 10/02/94
-C IMPLICIT NONE
-*
-#include "cdxfils.inc"
-*
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-CC
-CC+KEEP,CDXFILS.
-CC*
-CC INTEGER MCDXFIL
-CC PARAMETER (MCDXFIL = 10)
-CC COMMON /CDXFILS/ NCDXFIL,KCDXFIL,
-CC + ICXFSTA(10),CDXFPRF(10),CDXFTOP(10),CDXFNAM(10)
-CC INTEGER NCDXFIL, KCDXFIL, ICXFSTA
-CC CHARACTER CDXFPRF*2, CDXFTOP*8, CDXFNAM*40
-CC
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-*
- CHARACTER MESL*78
- INTEGER LMES
-*
- INTEGER K
-*
- DO K=0,NCDXFIL
- CALL UXFILLN(K,MESL,LMES)
- CALL CDX_MESS(MESL(:LMES))
- ENDDO
-*
- END
-*
-*
- SUBROUTINE UXFILLN(JTAB,LINE,LRES)
-* ------------------------====-====-
-* -- Author : Boris Khomenko 10/02/94
-C IMPLICIT NONE
-*
-* --- arguments ---
- INTEGER JTAB,LRES
- CHARACTER LINE*(*)
-* -----------------
-*
-#include "cdxfils.inc"
-*
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-CC
-CC+KEEP,CDXFILS.
-CC*
-CC INTEGER MCDXFIL
-CC PARAMETER (MCDXFIL = 10)
-CC COMMON /CDXFILS/ NCDXFIL,KCDXFIL,
-CC + ICXFSTA(10),CDXFPRF(10),CDXFTOP(10),CDXFNAM(10)
-CC INTEGER NCDXFIL, KCDXFIL, ICXFSTA
-CC CHARACTER CDXFPRF*2, CDXFTOP*8, CDXFNAM*40
-CC
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-*
-* -- externals --
- INTEGER JLASNC
-*
- CHARACTER MESL*78
- INTEGER LMES
-*
- INTEGER NOPN , NERO , K
- CHARACTER ERRC*4
-*
-C INTEGER IRC , LR , LMAX , LFIL , LEN , JLASNC
-*
- LMAX=MIN0(LEN(MESL),LEN(LINE))
- MESL=' '
-*
- NOPN=0
- NERO=0
- IF(JTAB.EQ.0) THEN
- DO K=1,NCDXFIL
- IF(ICXFSTA(K).EQ.1) THEN
- NOPN=NOPN+1
- ELSE IF(ICXFSTA(K).GT.0) THEN
- NERO=NERO+1
- ENDIF
- ENDDO
- MESL=' --- DB files: 00/00 opened (+00 with errs.) ---$'
- J=INDEX(MESL,'/')
- CALL ENCODI(NOPN, 1,MESL(J-2:J-1),LR)
- CALL ENCODI(NCDXFIL,-1,MESL(J+1:J+2),LR)
- IF(NERO.LE.0) THEN
- LMES=INDEX(MESL,'(')-1
- ELSE
- J=INDEX(MESL,'+')
- CALL ENCODI(NOPN, 1,MESL(J+1:J+2),LR)
- LMES=INDEX(MESL,')')
- ENDIF
- MESL(LMES+1:LMES+4)=' ---'
- LMES=LMES+4
-*
- ELSE IF(JTAB.GT.0.AND.JTAB.LE.NCDXFIL) THEN
-*
- IRC=ICXFSTA(JTAB)
- IF(IRC.EQ.-1) THEN
- ERRC='ok'
- ELSE IF(IRC.EQ.1) THEN
- ERRC='Opnd'
- ELSE IF(IRC.EQ.0) THEN
- ERRC='?'
- ELSE
- IRC=IRC-ISIGN(1,IRC)
- CALL ENCODI(IRC,-1,ERRC,LR)
- ENDIF
-*
- WRITE(MESL,1111) JTAB,CDXFPRF(JTAB),ERRC,CDXFTOP(JTAB)
- 1111 FORMAT(I2,1H.,A2,' st=',A4,' top=',A8,' file:')
- LMES=INDEX(MESL,':')
- LFIL=JLASNC(CDXFNAM(JTAB),' ')
- IF(LFIL.GT.0) THEN
- MESL(LMES+2:)=CDXFNAM(JTAB)
- LMES=LMES+1+LFIL
- ENDIF
-*
- ELSE
- ENDIF
- LINE=MESL
- LRES=MIN0(LMES,LEN(LINE))
- END
-*
-*
- SUBROUTINE UXIRCM(COMND,IRC)
-* ---------------------------
-* -- Author : Boris Khomenko 10/02/94
- IMPLICIT NONE
-*
-* -- arguments --
- CHARACTER*(*) COMND
- INTEGER IRC
-*
-#include "cdxluns.inc"
-*
-* -- externals --
- INTEGER LNBLNK
-*
-* -- Local variables --
-*
- INTEGER LL , LR , LM
- CHARACTER CMND*20 , CODE*10 , MESL*78
-*
- CMND=COMND
- LL=LNBLNK(CMND)
- LL=MAX0(LL,6)
- CALL ENCODI(IRC,-1,CODE,LR)
- CALL CDERRMS(IRC,MESL)
- LM=LNBLNK(MESL)
- CALL CDX_MESS
- + ('=='//CMND(:LL)//'>> IRC='//CODE(:LR+1)//MESL(:LM))
- END
diff --git a/src/packlib/hepdb/examples/dbexam/cdex/cdexe1.F b/src/packlib/hepdb/examples/dbexam/cdex/cdexe1.F
deleted file mode 100644
index 955b726..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdex/cdexe1.F
+++ /dev/null
@@ -1,71 +0,0 @@
-*
-* $Id: cdexe1.F,v 1.1.1.1 1996/02/28 16:23:39 mclareni Exp $
-*
-* $Log: cdexe1.F,v $
-* Revision 1.1.1.1 1996/02/28 16:23:39 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDEXE1(INSTR,IFEXT,IFEXE)
-* ------------------------*****-*****-
-*
-* Subroutine for CD/hepdb calls
-*
-* -- passed instruction --
- CHARACTER*(*) INSTR
-*
-* -- local variables --
- CHARACTER LINE*80 , FNAME*8 , PREF*8
-*
- DATA IFINIT/0/
-*
-*
- IF(IFINIT.LE.0) THEN
-* ... initialization...
- IFINIT=1
- ENDIF
-*
-* -- IFEXE: if 0 -no command was executed yet
-* if 1 -a command was executed, don't try more
-* if -1 -a HELP command is being executed
- IF(IFEXE.EQ.-1) THEN
-c*** 1 2 3 4
-c*** 1234567890123456789012345678901234567890
-CC CALL CDX_MESS(' -------------------------------- CDxxxx-'
-CC + //'--------------------------------------')
-*
- ENDIF
- IF(IFEXE.NE.0) RETURN
-*
-*
- LINE=INSTR
- CALL CLTOU(LINE)
-*
- JPAK=0
- IFTX=0
-*
- 12 CONTINUE
- CALL TEXINS(LINE,JPAK,IFTX,FNAME,NUMB,FNUM)
- LFN=INDEX(FNAME,' ')-1
- IF(LFN.LE.0) LFN=LEN(FNAME)
- NXL=JBYT(IFTX,1,2)
-*
- IF(IFEXE.EQ.-1.OR.IFSHEQC(FNAME(:LFN),'HELP').GT.0) THEN
- IFEXE=-1
-CC to change...
-*
- ELSE IF(FNAME.EQ.'CDPREF') THEN
- IFEXE=1
- 21 CONTINUE
- CALL TEXINS(LINE,JPAK,IFTX,PREF,NUMB,FNUM)
- NXL=JBYT(IFTX,1,2)
- IF(PREF.NE.' ') CALL CXPREF(PREF)
- IF(NXL.GT.0) GOTO 21
-*
- ELSE
-* = = = = = it is a foreign instruction = = = = =
- ENDIF
-*
- 99 CONTINUE
- END
diff --git a/src/packlib/hepdb/examples/dbexam/cdex/cdi_mess.F b/src/packlib/hepdb/examples/dbexam/cdex/cdi_mess.F
deleted file mode 100644
index a96a526..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdex/cdi_mess.F
+++ /dev/null
@@ -1,227 +0,0 @@
-*
-* $Id: cdi_mess.F,v 1.1.1.1 1996/02/28 16:23:41 mclareni Exp $
-*
-* $Log: cdi_mess.F,v $
-* Revision 1.1.1.1 1996/02/28 16:23:41 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDI_MESS(MESS,NUMB)
-* ------------------------------
-#if defined(CERNLIB_COMMENT)
-*********************************************************
-* It is a nice subroutine which takes the *
-* message text from MESS, finds one or more *
-* zero ( 0 or 00 or 000000 etc.) and replaces *
-* this substring with encoded integer NUMB. *
-* Then CDX_MESS is called: output on LU=6 *
- and on DB protocol file (if requested). *
-* The same with @s, but then the field will *
-* be left filled with zeros (not blancs). *
-* Examples: MESS NUMB output *
-* *
-* 'A= 000cm' 12 'A= 12cm' *
-* 'A= @@@cm' 12 'A= 012cm' *
-* 'A= 000cm' 1234 'A= 1234cm' *
-* 'A=0cm' 1234 'A=1234cm' *
-* 'A0=0cm' 1234 'A1234=0cm' *
-* 'A`0=0cm' 1234 'A0=1234cm' *
-* 'N=0000*' 12 'N= 12*' *
-* 'N=000`*' 12 'N=12 *' *
-* *
-* Attention to double using of "`" (last examples): *
- a) `0 protects "0" from substitution; *
-* b) 000` , the number will be left shifted *
-*********************************************************
-#endif
-*
-* Author: Boris Khomenko
-*
- IMPLICIT NONE
-*
-* -- arguments --
- CHARACTER*(*) MESS
- INTEGER NUMB
- REAL RNUM
-*
-* -- externals --
- INTEGER JSEARC , JSEANC
- INTEGER LNBLNK
-*
-* -- local variables --
- INTEGER NNN
- REAL RRR
- EQUIVALENCE(NNN,RRR)
-*
- INTEGER IFI , IHX , IL , LS , LM , IP
- CHARACTER MESL*120 , CODE*10 , CH*1
- INTEGER JJ , LL , J1 , J2 , J , L
- INTEGER LN , LZ , LR
- CHARACTER SAVL*120
- INTEGER LSAV
-*
- DATA LSAV/0/
-*
-* - init integer number attribures
- NNN=NUMB
- IFI=1
-*
- 10 CONTINUE
-*
- IHX=0
- IL=0
-*
-* - JJ -copied part of MESS, LL -filled part of MESL
- JJ=0
- LL=0
-*
- IF(LSAV.GT.0) THEN
- MESL=SAVL(:LSAV)
- LL=LSAV
- LSAV=0
- ENDIF
-*
- 11 CONTINUE
-* - search for a "0" or "@"
- J1=JSEARC(MESS(JJ+1:),'0@')+JJ
- IF(J1.GT.JJ) THEN
-* - "0" (or "@") is found, but is it a "`0" ?
- CH=MESS(J1:J1)
- IF(J1.GT.1.AND.MESS(J1-1:J1-1).EQ.'`') THEN
-* - yes, it is a "`0", copy the scanned part of MESS but "`"
- L=J1-2-JJ
- IF(L.GT.0) THEN
- MESL(LL+1:)=MESS(JJ+1:JJ+L)
- JJ=JJ+L
- LL=LL+L
- ENDIF
- JJ=J1
- LL=LL+1
- MESL(LL:LL)=CH
- GOTO 11
- ENDIF
-*
-* - copy the previous text if any
- L=J1-1-JJ
- IF(L.GT.0) THEN
- MESL(LL+1:)=MESS(JJ+1:JJ+L)
- JJ=JJ+L
- LL=LL+L
- ENDIF
-*
-* - length of the number code (starting at J1)
- LN=JSEANC(MESS(J1:),'0@')-1
- IF(LN.LE.0) LN=LEN(MESS)-J1+1
-*
-* - point JJ to "the after number's char"
-* and check on "."(if float), "`" and "~"
- JJ=J1+LN
-*
- IF(IFI.EQ.0) THEN
- IF(MESS(JJ:JJ).EQ.'.') THEN
- IP=1
- LN=LN+1
- IF(MESS(JJ:JJ+1).EQ.'..') THEN
- IP=0
- LM=JSEANC(MESS(JJ+1:),'.')-1
- LM=LM+JSEANC(MESS(JJ+1+LM:),'0@')-1
- ELSE
- LM=JSEANC(MESS(JJ+1:),'0@')-1
- ENDIF
- LN=LN+LM
- JJ=J1+LN
- LM=MIN0(LM,9)
- ELSE
- IP=0
- LM=9
- ENDIF
-*
- LS=0
- DO J=J1,J1+LN-1
- IF(MESS(J:J).EQ.'@') LS=LS+1
- ENDDO
- IF(LS.EQ.1) LS=4
- IF(LS.LE.0) LS=6
-*
- ENDIF
-*
- IF(MESS(JJ:JJ).EQ.'`') THEN
- IL=1
- IP=0
- LN=LN+1
- IF(IFI.EQ.0.AND.LM.LT.9) LM=LM+1
- ELSE IF(MESS(JJ:JJ).EQ.'~') THEN
- LN=LN+1
- IHX=1
- ELSE
- JJ=JJ-1
- ENDIF
-* - now JJ is pointed to the last number's char
-*
- IF(IHX.NE.0) THEN
- CALL HEXENC(NNN,LN,CODE(:LN),LR)
- ELSE IF(IFI.NE.0) THEN
- LZ=1
- IF(CH.EQ.'@') LZ=LN
- CALL ENCODI(NNN,-LZ,CODE,LR)
- ELSE
- L=LN
- IF(L.EQ.1) L=LEN(CODE)
- IF(IP.NE.0) THEN
- CALL ENCODR(RRR,IP*100+LS*10+LM,CODE(:L),LR)
- LR=L
- ELSE
- CALL ENCODR(RRR,-(LS*10+LM),CODE(:L),LR)
- ENDIF
- ENDIF
- IF(LR.GE.LN) THEN
- MESL(LL+1:)=CODE
- LL=LL+LR
- ELSE IF(IL.GT.0) THEN
- MESL(LL+1:)=CODE
- LL=LL+LN
- ELSE
- MESL(LL+1+LN-LR:)=CODE
- LL=LL+LN
- ENDIF
- ENDIF
- IF(JJ.LT.LEN(MESS).AND.LL.LT.LEN(MESL)) MESL(LL+1:)=MESS(JJ+1:)
-*
- 66 CONTINUE
- LL=MAX0(LNBLNK(MESL),2)
- IF(MESL(LL-1:LL).EQ.'.>') THEN
- LL=LL-2
- IF(LL.GT.0) THEN
- SAVL=MESL(:LL)
- LSAV=LL
- ENDIF
- ELSE
- CALL CDX_MESS(MESL(:LNBLNK(MESL)))
- ENDIF
- RETURN
-*
-*
- ENTRY CDR_MESS(MESS,RNUM)
-* -------------------------
-*
- IFI=0
- RRR=RNUM
- GOTO 10
-*
-*
- ENTRY CDN_MESS(MESS)
-* --------------------
-*
- IF(LSAV.GT.0) THEN
- MESL=SAVL(:LSAV)
- LL=LSAV
- LSAV=0
- ELSE
- LL=0
- ENDIF
-*
- MESL(LL+1:)=MESS
- GOTO 66
-*
- END
diff --git a/src/packlib/hepdb/examples/dbexam/cdex/cdx_end.F b/src/packlib/hepdb/examples/dbexam/cdex/cdx_end.F
deleted file mode 100644
index 29db6b9..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdex/cdx_end.F
+++ /dev/null
@@ -1,67 +0,0 @@
-*
-* $Id: cdx_end.F,v 1.1.1.1 1996/02/28 16:23:40 mclareni Exp $
-*
-* $Log: cdx_end.F,v $
-* Revision 1.1.1.1 1996/02/28 16:23:40 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDX_END
-* ------------------
-* -- Author : Boris Khomenko 10/02/94
- IMPLICIT NONE
-*
-c\+CDE,CDXSTOR. (ICDXDIV)
-*
-#include "cdxluns.inc"
-*
-#include "cdxfils.inc"
-*
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-CC
-CC+KEEP,CDXFILS.
-CC*
-CC INTEGER MCDXFIL
-CC PARAMETER (MCDXFIL = 10)
-CC COMMON /CDXFILS/ NCDXFIL,KCDXFIL,
-CC + ICXFSTA(10),CDXFPRF(10),CDXFTOP(10),CDXFNAM(10)
-CC INTEGER NCDXFIL, KCDXFIL, ICXFSTA
-CC CHARACTER CDXFPRF*2, CDXFTOP*8, CDXFNAM*40
-CC
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-*
-* -- externals --
-*
-* -- Local variables --
-*
- INTEGER IRC
- INTEGER IFOPN , IFDCL
- INTEGER LR , JJ, K
- CHARACTER MESL*78
- INTEGER LMES
-*
-* -- Check everything is closed in the CDXFILS table --
- IFOPN=0
- IFDCL=0
- DO K=1,NCDXFIL
- IF(ICXFSTA(K).NE.0.OR.CDXFPRF(K).NE.' ') IFDCL=IFDCL+1
- IF(ICXFSTA(K).GT.0) THEN
- IFOPN=IFOPN+1
- ENDIF
- ENDDO
- 111 CONTINUE
- MESL='>>End CDEX: / DB files opened/declared<<'
- JJ=INDEX(MESL,'/')
- CALL ENCODI(IFOPN, 1,MESL(JJ-2:JJ-1),LR)
- CALL ENCODI(IFDCL,-1,MESL(JJ+1:JJ+2),LR)
- LMES=INDEX(MESL,'<<')+1
- CALL CDX_MESS(MESL(:LMES))
- IF(IFOPN.GT.0) THEN
- CALL CDX_MESS('>>CDEND(,''A'',) automatic call<<')
- CALL CDEND(' ','A',IRC)
- CALL UXIRCM('CDEND ',IRC)
- ELSE
- CALL CDX_MESS('>>No call to CDEND<<')
- ENDIF
- END
diff --git a/src/packlib/hepdb/examples/dbexam/cdex/cdx_mess.F b/src/packlib/hepdb/examples/dbexam/cdex/cdx_mess.F
deleted file mode 100644
index 3cdf69e..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdex/cdx_mess.F
+++ /dev/null
@@ -1,87 +0,0 @@
-*
-* $Id: cdx_mess.F,v 1.1.1.1 1996/02/28 16:23:39 mclareni Exp $
-*
-* $Log: cdx_mess.F,v $
-* Revision 1.1.1.1 1996/02/28 16:23:39 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDX_MESS(MESSAGE)
-* ----------------------------
-*
- CHARACTER*(*) MESSAGE
-*
-* (LUNINP,LUNOUT,LUNPRO,LUNCMD,...)
-#include "cdxluns.inc"
-*
- CHARACTER*20 PRONAME
- DATA IFPROTO/0/,IFPROPN/0/
-*
- IFTTOUT=1
- GOTO 10
-*
- ENTRY CDX_PROT(MESSAGE)
-* ------------------------
- IFTTOUT=0
-*
- 10 CONTINUE
-#if defined(CERNLIB_UNIX)
- IF(IFTTOUT.GT.0) WRITE(LUNOUT,1110) MESSAGE
- 1110 FORMAT (A)
-#endif
-#if !defined(CERNLIB_UNIX)
- IF(IFTTOUT.GT.0) WRITE(LUNOUT,1111) MESSAGE
-#endif
- IF(IFPROTO.GT.0) WRITE(LUNPRO,1111) MESSAGE
- 1111 FORMAT (1X,A)
- RETURN
-*
- ENTRY CDX_SETPR(IFPRO)
-* -----------------------
-*
- IF(IFPRO.GT.0) THEN
- IF(IFPROPN.LE.0) THEN
-#if !defined(CERNLIB_IBMVM)
- PRONAME='CDEX_PRO'
-#endif
-#if defined(CERNLIB_IBMVM)
- PRONAME='/CDX_PRO DATA *'
-#endif
- OPEN(LUNPRO,FILE=PRONAME,STATUS='UNKNOWN')
- IFPROPN=1
- IFPROTO=1
- WRITE(LUNOUT,*) '=== Protocol OPENED ==='
- WRITE(LUNPRO,*) '=== Protocol OPENED ==='
- ELSE IF(IFPROTO.LE.0) THEN
- IFPROTO=1
- WRITE(LUNOUT,*) '=== Protocol ON ==='
- WRITE(LUNPRO,*) '=== Protocol ON ==='
- ENDIF
- ELSE IF(IFPRO.LT.0) THEN
- IF(IFPROPN.GT.0) THEN
- WRITE(LUNOUT,*) '=== Protocol CLOSED ==='
- IF(IFPROTO.GT.0) WRITE(LUNPRO,*) '=== Protocol CLOSED ==='
- CLOSE(LUNPRO)
- ENDIF
- IFPROPN=0
- IFPROTO=0
- ELSE
- IF(IFPROTO.GT.0) THEN
- WRITE(LUNOUT,*) '=== Protocol OFF ==='
- WRITE(LUNPRO,*) '=== Protocol OFF ==='
- ENDIF
- IFPROTO=0
- ENDIF
- END
-*
-*
- SUBROUTINE CDX_ANSW(PROM,ANSW)
-* -------------------------====-
-* -- arguments --
- CHARACTER*(*) PROM,ANSW
-*
- CALL CDX_MESS(PROM(:LNBLNK(PROM)))
- READ (*,'(A)') ANSW
- CALL CLTOU(ANSW)
- END
diff --git a/src/packlib/hepdb/examples/dbexam/cdex/cdxdiv.inc b/src/packlib/hepdb/examples/dbexam/cdex/cdxdiv.inc
deleted file mode 100644
index 26d9265..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdex/cdxdiv.inc
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: cdxdiv.inc,v 1.1.1.1 1996/02/28 16:23:38 mclareni Exp $
-*
-* $Log: cdxdiv.inc,v $
-* Revision 1.1.1.1 1996/02/28 16:23:38 mclareni
-* Hepdb, cdlib, etc
-*
-*
-*
-* cdxdiv.inc
-*
-* - - - - - -/CDXDIV/- - - - - - - - - - - - - - - - - -
- COMMON /CDXDIV/ ICDXDIV , LCDXDIV
- INTEGER ICDXDIV , LCDXDIV
-* - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-*
diff --git a/src/packlib/hepdb/examples/dbexam/cdex/cdxfils.inc b/src/packlib/hepdb/examples/dbexam/cdex/cdxfils.inc
deleted file mode 100644
index a20e87c..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdex/cdxfils.inc
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: cdxfils.inc,v 1.1.1.1 1996/02/28 16:23:38 mclareni Exp $
-*
-* $Log: cdxfils.inc,v $
-* Revision 1.1.1.1 1996/02/28 16:23:38 mclareni
-* Hepdb, cdlib, etc
-*
-*
-*
-* cdxfils.inc
-*
-* - - - - - - /CDXFILS/ - - - - - - - - - - - - - - - - -
- INTEGER MCDXFIL
- PARAMETER (MCDXFIL = 10)
- COMMON /CDXFILS/ NCDXFIL,KCDXFIL,
- + ICXFSTA(10),CDXFPRF(10),CDXFTOP(10),CDXFNAM(10),
- + LOGLCDX(10)
- INTEGER NCDXFIL, KCDXFIL, ICXFSTA , LOGLCDX
- CHARACTER CDXFPRF*2, CDXFTOP*8, CDXFNAM*40
-* - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-*
-*
diff --git a/src/packlib/hepdb/examples/dbexam/cdex/cdxini0.F b/src/packlib/hepdb/examples/dbexam/cdex/cdxini0.F
deleted file mode 100644
index f4b7680..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdex/cdxini0.F
+++ /dev/null
@@ -1,40 +0,0 @@
-*
-* $Id: cdxini0.F,v 1.1.1.1 1996/02/28 16:23:39 mclareni Exp $
-*
-* $Log: cdxini0.F,v $
-* Revision 1.1.1.1 1996/02/28 16:23:39 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDXINI0
-* ------------------
-*
- IMPLICIT NONE
-*
-#include "cdxdiv.inc"
-*
-#include "cdxfils.inc"
-*
-#include "dbrinf.inc"
-*
-* -- local variables --
- INTEGER I
-*
-* -- init /CDUSDIV/ --
- ICDXDIV=0
- LCDXDIV=0
-*
-* -- init /CDXFILS/ --
- NCDXFIL=0
- KCDXFIL=0
- DO I=1,MCDXFIL
- ICXFSTA(I)=0
- CDXFPRF(I)=' '
- CDXFTOP(I)=' '
- CDXFNAM(I)=' '
- ENDDO
-*
-* -- init /DBRINF/ --
-*
- END
diff --git a/src/packlib/hepdb/examples/dbexam/cdex/cdxiniz.F b/src/packlib/hepdb/examples/dbexam/cdex/cdxiniz.F
deleted file mode 100644
index b5c01b4..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdex/cdxiniz.F
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: cdxiniz.F,v 1.1.1.1 1996/02/28 16:23:39 mclareni Exp $
-*
-* $Log: cdxiniz.F,v $
-* Revision 1.1.1.1 1996/02/28 16:23:39 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDXINIZ
-* ------------------
-* CDEX Z initialization after CDPAW call
-* Author : Boris Khomenko
- IMPLICIT NONE
-*
-#include "cdxdiv.inc"
-*
-#include "dbrinf.inc"
-*
-* - declare LINK areas
- CALL MZLINK(ICDXDIV,'/CDULNK/',LCDXDIV,LCDXDIV,LCDXDIV)
- IDBRDIV=ICDXDIV
- CALL MZLINK(IDBRDIV,'/DBRLNK/',LDBRKY, LDBRDA, LDBRKY)
-*
- END
diff --git a/src/packlib/hepdb/examples/dbexam/cdex/cdxluns.inc b/src/packlib/hepdb/examples/dbexam/cdex/cdxluns.inc
deleted file mode 100644
index ec10498..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdex/cdxluns.inc
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: cdxluns.inc,v 1.1.1.1 1996/02/28 16:23:38 mclareni Exp $
-*
-* $Log: cdxluns.inc,v $
-* Revision 1.1.1.1 1996/02/28 16:23:38 mclareni
-* Hepdb, cdlib, etc
-*
-*
-*
-* cdxluns.inc
-*
-* - - - - - Logical units - - - - - - - - - - - - - - - -
- INTEGER LUNINP
- PARAMETER (LUNINP=5)
-*
- INTEGER LUNOUT
- PARAMETER (LUNOUT=6)
-*
- INTEGER LUNPRO
- PARAMETER (LUNPRO=9)
-*
- INTEGER LUNCMD
- PARAMETER (LUNCMD=10)
-*
- INTEGER LUNAMES
- PARAMETER (LUNAMES=80)
-* - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-*
diff --git a/src/packlib/hepdb/examples/dbexam/cdex/cdxseq.F b/src/packlib/hepdb/examples/dbexam/cdex/cdxseq.F
deleted file mode 100644
index 6836d34..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdex/cdxseq.F
+++ /dev/null
@@ -1,9 +0,0 @@
-*
-* $Id: cdxseq.F,v 1.1.1.1 1996/02/28 16:23:38 mclareni Exp $
-*
-* $Log: cdxseq.F,v $
-* Revision 1.1.1.1 1996/02/28 16:23:38 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
diff --git a/src/packlib/hepdb/examples/dbexam/cdex/cdxstor.inc b/src/packlib/hepdb/examples/dbexam/cdex/cdxstor.inc
deleted file mode 100644
index 1d71807..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdex/cdxstor.inc
+++ /dev/null
@@ -1,37 +0,0 @@
-*
-* $Id: cdxstor.inc,v 1.1.1.1 1996/02/28 16:23:38 mclareni Exp $
-*
-* $Log: cdxstor.inc,v $
-* Revision 1.1.1.1 1996/02/28 16:23:38 mclareni
-* Hepdb, cdlib, etc
-*
-*
-*
-* cdxstor.inc
-*
-cc\\* - - - - - -/PAWC/ - - - - - - - - - - - - - - - - - - -
-cc\\ INTEGER NWPAWC , IPAWC
-cc\\ PARAMETER (NWPAWC = 100000)
-cc\\ COMMON /PAWC/ IPAWC(NWPAWC)
-cc\\* - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-cc\\*
-cc\\+KEEP,CDXLQIQ.
-cc\\* - - - - - - - LQIQ- - - - - - - - - - - - - - - - - - -
-cc\\ INTEGER LQ(8000) , IQ(2)
-cc\\ REAL Q(2)
-cc\\ EQUIVALENCE (LQ(1),IPAWC(11)),(IQ(1),LQ(9)),(Q(1),IQ(1))
-cc\\* - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-* - - - - - - - PAWLQIQ- - - - - - - - - - - - - - - - - - -
- COMMON /PAWC/ IPAWC(99)
- INTEGER IPAWC
- INTEGER LQ(88) , IQ(2)
- REAL Q(2)
- EQUIVALENCE (LQ(1),IPAWC(11)),(IQ(1),LQ(9)),(Q(1),IQ(1))
-* - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-*
-cc\\+KEEP,CDXULNK.
-cc\\* - - - - - -/CDULNK/- - - - - - - - - - - - - - - - - -
-cc\\ COMMON /CDULNK/ IUSDIV , LUSDIV
-cc\\ INTEGER IUSDIV , LUSDIV
-cc\\* - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-*
diff --git a/src/packlib/hepdb/examples/dbexam/cdex/cdzseq.F b/src/packlib/hepdb/examples/dbexam/cdex/cdzseq.F
deleted file mode 100644
index 7854ee8..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdex/cdzseq.F
+++ /dev/null
@@ -1,9 +0,0 @@
-*
-* $Id: cdzseq.F,v 1.1.1.1 1996/02/28 16:23:37 mclareni Exp $
-*
-* $Log: cdzseq.F,v $
-* Revision 1.1.1.1 1996/02/28 16:23:37 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
diff --git a/src/packlib/hepdb/examples/dbexam/cdex/cxaaaa.F b/src/packlib/hepdb/examples/dbexam/cdex/cxaaaa.F
deleted file mode 100644
index 2c8649f..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdex/cxaaaa.F
+++ /dev/null
@@ -1,248 +0,0 @@
-*
-* $Id: cxaaaa.F,v 1.1.1.1 1996/02/28 16:23:41 mclareni Exp $
-*
-* $Log: cxaaaa.F,v $
-* Revision 1.1.1.1 1996/02/28 16:23:41 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CXAAAA(LINE,JPAK,IFERR)
-* ---------------- ------****-====-
-* -- Author : Boris Khomenko 10/02/94
- IMPLICIT NONE
-*
- CHARACTER LINE*(*)
- INTEGER JPAK
-*
-*
-#include "cdxdiv.inc"
-*
-#include "cdxfils.inc"
-*
-#include "yeaaas.inc"
-*
-* -- externals --
- INTEGER JBYT , LNBLNK
- INTEGER IFSHEQC
-*
-* -- initialization flag --
- INTEGER IFINIT
-*
-* -- default/set parameters
-* for CDAAAA --
-*
-CC: 'NKeys' 'MXObj' 'IPRec' 'DELta' 'ChOpt'
-CC: LVKEYS LVMOBJ LVPREC LVDELT LVOPTN
-CC: NKEYS MPOBJ IPREC DELTA CHOPT
-CC: NDKEYS(2) NDMOBJ(2) NDPREC(2) RDDELT(2) CHOPTN(2)
-*
-* .... NKEYS ....
- INTEGER LVKEYS , NDKEYS(2) , NKEYS
-*
- CHARACTER*8 CHTAG(10) , CHFOR*10
-*
-* .... MPOBJ ....
- INTEGER LVMOBJ , NDMOBJ(2) , MPOBJ
-*
-* .... IPREC ....
- INTEGER LVPREC , NDPREC(2) , IPREC
-*
-* .... DELTA ....
- INTEGER LVDELT
- REAL RDDELT(2) , DELTA
-*
-* .... CHOPT ....
- INTEGER LVOPTN
- CHARACTER*6 CHOPTN(2) , CHOPT
-*
-#if !defined(CERNLIB_IBMVM)
- STATIC IFINIT
- STATIC LVKEYS , NDKEYS
- STATIC LVMOBJ , NDMOBJ
- STATIC LVPREC , NDPREC
- STATIC LVDELT , RDDELT
- STATIC LVOPTN , CHOPTN
-#endif
-* -- other parameters for CDAAAA --
- CHARACTER CHPAT*40
- INTEGER LPAT , LOPT
- INTEGER LUNDB , LUNFZ , IDIV
- INTEGER IRC
-* - - - - - - - - - - - - - -
- INTEGER LVNEW
-* ----------------------------
-*
-* -- Command string analyse variables --
- INTEGER JPK1
- INTEGER IFTX , IFNX , LPRF
- CHARACTER PRFX*8 , PRF*8
- INTEGER NUMB
- REAL FNUM
-*
-* -- Local variables --
-*
- INTEGER IFERR , IFQUI
- CHARACTER YES*1
- CHARACTER MESL*78
- INTEGER JJ , LR , LL
-*
- DATA IFINIT/0/
-*
- IF(IFINIT.EQ.0) THEN
- IFINIT=1
-*
- LVKEYS=1
- LVMOBJ=1
- LVPREC=1
- LVDELT=1
- LVOPTN=1
-*
- NDKEYS(1)=0
- NDMOBJ(1)=100
- NDPREC(1)=0
- RDDELT(1)=0.
- CHOPTN(1)='-'
-*
- CHFOR=' '
- DO JJ=1,10
- CHTAG(JJ)='UsKey'//CHAR(ICHAR('0')+JJ)//'a'
- ENDDO
- ENDIF
-*
- IFERR=0
- IFQUI=0
- YES=YEAAAS
-*
- CHPAT=' '
-*
- 12 CONTINUE
-* _ save the next item's pointer
- JPK1=JPAK
- CALL TEXINS(LINE,JPAK,IFTX,PRFX,NUMB,FNUM)
- IFNX=MOD(IFTX,4)
- CALL CLTOU(PRFX)
-*
- IF(IFTX.LE.0) THEN
-* -- it is a call without parameters
-* -- show the parameters setting --
- CALL CDX_MESS('>>CDAAAA --- parameters --- <<')
- CALL UXIPARM(' ','NKeys',LVKEYS,NDKEYS(LVKEYS),0, 0,NDKEYS(1))
- CALL UXIPARM(' ','MPObj',LVMOBJ,NDMOBJ(LVMOBJ),0, 0,NDMOBJ(1))
- CALL UXIPARM(' ','IPRec',LVPREC,NDPREC(LVPREC),0, 0,NDPREC(1))
- CALL UXRPARM(' ','DELta',LVDELT,RDDELT(LVDELT),0, 0,RDDELT(1))
- CALL UXCPARM(' ','opt ',LVOPTN,CHOPTN(LVOPTN),0,' ',CHOPTN(1))
-* -- show the call format --
- CALL CDX_MESS('Call format:')
- CALL CDX_MESS('> CDAAAA [par/val ...] [-opt] [path]')
- IFQUI=99
-*
- ELSE IF(PRFX.EQ.'YES') THEN
-* -- it is a "YES" --
- YES='Y'
- CALL CDX_MESS('>>CDAAAA: "YES"')
-*
- ELSE IF(PRFX.EQ.'ASK') THEN
-* -- it is a "ASK" --
- YES='-'
- CALL CDX_MESS('>>CDAAAA: "ASK"')
-*
- ELSE IF(PRFX(1:1).EQ.'-') THEN
-* -- it is an option --
- LVNEW=0
- IF(PRFX(1:2).EQ.'-=') LVNEW=1
- CALL UXNEWCP('CDAAAA','opt ',LVNEW,PRFX,LVOPTN,CHOPTN)
-*
- ELSE IF(PRFX.NE.' '.AND.IFNX.EQ.3) THEN
-* -- it seems to be a parameter (re)definition
-* NKEYS/n , MPOBJ/n , IPREC/n , DELTA/d
-*
- CALL TEXINS(LINE,JPAK,IFTX,PRF,NUMB,FNUM)
- IFNX=MOD(IFTX,4)
- CALL CLTOU(PRF)
-*
- LVNEW=0
- IF(PRF.EQ.'=') LVNEW=1
-*
- IF (IFSHEQC(PRFX,'NK*EYS').GT.0) THEN
- CALL UXNEWIP('CDAAAA','NKeys',LVNEW,NUMB,LVKEYS,NDKEYS)
-*
- ELSE IF(IFSHEQC(PRFX,'MPO*BJ').GT.0) THEN
- CALL UXNEWIP('CDAAAA','MPObj',LVNEW,NUMB,LVMOBJ,NDMOBJ)
-*
- ELSE IF(IFSHEQC(PRFX,'DEL*TA').GT.0) THEN
- CALL UXNEWRP('CDAAAA','DELta',LVNEW,FNUM,LVDELT,RDDELT)
-*
- ELSE
-* -- signal an INVALID SET PARAMETER --
- CALL UXCPARM('CDAAAA',PRFX,0,' ',0,' ',' ')
- IFERR=1
- ENDIF
-*
- ELSE IF(IFTX.EQ.3) THEN
-* -- it looks like a pathname (starts with "/")
-* -- get pathname with previously saved pointers
- JPAK=JPK1
- CALL TEXSTR(LINE,JPAK,IFTX,CHPAT)
- IFNX=MOD(IFTX,4)
- LPAT=LNBLNK(CHPAT)
- CALL CLTOU(CHPAT(:LPAT))
- IFQUI=1
-*
- ELSE
-* -- signal an INVALID item --
- IFERR=1
- CALL CDX_MESS('>>CDAAAA: Unrecognized item')
- ENDIF
- IF(IFNX.GT.0.AND.IFQUI.EQ.0.AND.IFERR.EQ.0) GOTO 12
-*
- IF(IFQUI.EQ.1.AND.IFERR.EQ.0) THEN
-* -- call parameters --
- NKEYS=NDKEYS(LVKEYS)
- MPOBJ=NDMOBJ(LVMOBJ)
- DELTA=RDDELT(LVDELT)
- CHOPT=CHOPTN(LVOPTN)
-*
-CCC CALL CDX_MESS('>>CDAAAA Auto Option: "'//CHOPT(:1)//'"')
-*
- IF(CHOPT(1:1).EQ.'-') CHOPT=CHOPT(2:)
- LOPT=MAX0(LNBLNK(CHOPT),1)
-*
- MESL='>>CALL CDAAAA('
- WRITE(MESL(15:),1111) NKEYS,MPOBJ,IPREC,CHOPT(:LOPT)
- 1111 FORMAT('CHPAT,',
- + 3(I5,','),'# ,"',A5,'",IRC)')
- JJ=INDEX(MESL,'#')
- CALL ENCODR(DELTA,44,MESL(JJ:JJ+6),LR)
- CALL CDX_MESS(MESL(:LNBLNK(MESL)))
-*
- MESL=' '
- MESL(15:)=' nkeys mpobj iprec delta chopt'
- CALL CDX_MESS(MESL(:LNBLNK(MESL)))
-*
- MESL(15:)=' chpath='//CHPAT(:LPAT)
- CALL CDX_MESS(MESL(:LNBLNK(MESL)))
-*
- CALL CDX_MESS('>>CDAAAA WARNING! Not a HEPDB top //CDxx[/...]')
-*
-CCC IF(CHOPT.EQ.'P') YES='Y'
- IF(YES.NE.'Y') CALL CDX_ANSW('OK ? (y/n , <cr>=y )',YES)
- IF(YES.EQ.' ') YES='Y'
- CALL CLTOU(YES)
-*
- IF(YES.EQ.'Y') THEN
-C.... CALL CDAAAA
-C....+ (CHPAT,NKEYS,CHFOR,CHTAG,MPOBJ,IPREC,DELTA,CHOPT,IRC)
-* -- report the Return Code --
- CALL UXIRCM('CDAAAA',IRC)
- ELSE
- CALL CDX_MESS('>>CDAAAA not called (NOK)')
- ENDIF
- ELSE IF(IFERR.NE.0) THEN
-* -- error end --
- CALL CDX_MESS('>>CDAAAA not called (instruction error)')
- ELSE IF(IFQUI.EQ.0) THEN
-* -- no path given --
- CALL CDX_MESS('>>CDAAAA not called (NO PATH given)')
- ENDIF
- END
diff --git a/src/packlib/hepdb/examples/dbexam/cdex/cxddir.F b/src/packlib/hepdb/examples/dbexam/cdex/cxddir.F
deleted file mode 100644
index 2de6c24..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdex/cxddir.F
+++ /dev/null
@@ -1,168 +0,0 @@
-*
-* $Id: cxddir.F,v 1.1.1.1 1996/02/28 16:23:39 mclareni Exp $
-*
-* $Log: cxddir.F,v $
-* Revision 1.1.1.1 1996/02/28 16:23:39 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CXDDIR(LINE,JPAK,IFERR)
-* ---------------- ------****-====-
-* -- Author : Boris Khomenko 10/02/94
- IMPLICIT NONE
-*
- CHARACTER LINE*(*)
- INTEGER JPAK
-*
-C\+CDE,CDXDIV. (ICDXDIV)
-*
-C\+CDE,CDXLUNS.
-*
-#include "cdxfils.inc"
-*
-#include "yeaaas.inc"
-*
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-CC
-CC+KEEP,CDXFILS.
-CC*
-CC INTEGER MCDXFIL
-CC PARAMETER (MCDXFIL = 10)
-CC COMMON /CDXFILS/ NCDXFIL,KCDXFIL,
-CC + ICXFSTA(10),CDXFPRF(10),CDXFTOP(10),CDXFNAM(10)
-CC INTEGER NCDXFIL, KCDXFIL, ICXFSTA
-CC CHARACTER CDXFPRF*2, CDXFTOP*8, CDXFNAM*40
-CC
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-*
-* -- externals --
- INTEGER JBYT , LNBLNK
- INTEGER IFSHEQC
-*
-* -- initialization flag --
- INTEGER IFINIT
-* -- default/set parameters
-* for CDDDIR --
-*
-CC: 'ChOpt'
-CC: LVOPTN
-CC: CHOPT
-CC: CHOPTN(2)
-*
-* .... CHOPT ....
- INTEGER LVOPTN
- CHARACTER*6 CHOPTN(2) , CHOPT
-*
-#if !defined(CERNLIB_IBMVM)
- STATIC IFINIT
- STATIC LVOPTN , CHOPTN
-#endif
-* -- other parameters for CDDDIR --
- CHARACTER CHPATH*40
- INTEGER LPATH
- INTEGER IRC
-* - - - - - - - - - - - - - -
- INTEGER LVNEW
-* ----------------------------
-*
-* -- Command string analyse variables --
- INTEGER JPK1
- INTEGER IFTX , IFNX , LPRF
- CHARACTER PRFX*8 , PRF*8
- INTEGER NUMB
- REAL FNUM
-*
-* -- Local variables --
-*
- INTEGER IFERR , IFQUI
- CHARACTER YES*1
- CHARACTER MESL*78
- INTEGER LMES
- INTEGER LL
-*
- DATA IFINIT/0/
-*
- IF(IFINIT.EQ.0) THEN
- IFINIT=1
- LVOPTN=1
- CHOPTN(1)='-'
- ENDIF
-*
- IFERR=0
- IFQUI=0
- YES=YEAAAS
-*
- 12 CONTINUE
-* _ save the next item's pointer
- JPK1=JPAK
- CALL TEXINS(LINE,JPAK,IFTX,PRFX,NUMB,FNUM)
- IFNX=JBYT(IFTX,1,2)
- CALL CLTOU(PRFX)
-*
- IF(IFTX.LE.0) THEN
-* -- it is a call without parameters
-* -- show the parameters setting --
- CALL CDX_MESS('>>CDDDIR --- parameters --- <<')
- CALL UXCPARM(' ','ChOpt',LVOPTN,CHOPTN(LVOPTN),0,' ',CHOPTN(1))
-* -- show the call format --
- CALL CDX_MESS('Call format:')
- CALL CDX_MESS('> CDDDIR [par/val] [-opt] [path]')
-*
- ELSE IF(PRFX.EQ.'YES') THEN
-* -- it is a "YES" --
- YES='Y'
- CALL CDX_MESS('>>CDDDIR: "YES"')
-*
- ELSE IF(PRFX.EQ.'ASK') THEN
-* -- it is a "ASK" --
- YES='-'
- CALL CDX_MESS('>>CDDDIR: "ASK"')
-*
- ELSE IF(PRFX(1:1).EQ.'-') THEN
-* -- it is an option --
- LVNEW=0
- IF(PRFX(1:2).EQ.'-=') LVNEW=1
- CALL UXNEWCP('CDDDIR','opt ',LVNEW,PRFX,LVOPTN,CHOPTN)
-*
- ELSE IF(IFTX.EQ.3) THEN
-* -- it looks like a pathname (starts with "/")
- IFQUI=1
-* -- get pathname with previously saved pointers
- CALL TEXSTR(LINE,JPK1,IFTX,CHPATH)
- LPATH=LNBLNK(CHPATH)
- CALL CLTOU(CHPATH(:LPATH))
-*
-* -- other call parameters --
- CHOPT=CHOPTN(LVOPTN)
- IF(CHOPT.EQ.'-') CHOPT=' '
- LL=MAX0(LNBLNK(CHOPT),1)
-*
- CALL CDX_MESS('>>CALL ...')
- MESL='>>CDDDIR(CHPATH,"'//CHOPT(:LL)//'",IRC)'
- LMES=INDEX(MESL,')')
- CALL CDX_MESS(MESL(:LMES))
-*
- CALL CDX_MESS(' chpath='//CHPATH(:LPATH))
-*
- IF(YES.NE.'Y') CALL CDX_ANSW('OK ? (y/n , <cr>=y )',YES)
- IF(YES.EQ.' ') YES='Y'
- CALL CLTOU(YES)
-*
- IF(YES.EQ.'Y') THEN
- CALL CDX_MESS('>>...... OK, delete '//CHPATH(:LPATH))
- CALL CDDDIR(CHPATH,CHOPT,IRC)
-* -- report the Return Code --
- CALL UXIRCM('CDDDIR',IRC)
- ELSE
- CALL CDX_MESS('>>CDDDIR not called (NOK)')
- ENDIF
-*
- ELSE
-* -- signal an INVALID item --
- IFERR=1
- CALL CDX_MESS('>>CDDDIR: Unrecognized item')
- ENDIF
- IF(IFNX.GT.0.AND.IFQUI.EQ.0.AND.IFERR.EQ.0) GOTO 12
-*
- END
diff --git a/src/packlib/hepdb/examples/dbexam/cdex/cxlist.F b/src/packlib/hepdb/examples/dbexam/cdex/cxlist.F
deleted file mode 100644
index 7628ba4..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdex/cxlist.F
+++ /dev/null
@@ -1,255 +0,0 @@
-*
-* $Id: cxlist.F,v 1.1.1.1 1996/02/28 16:23:41 mclareni Exp $
-*
-* $Log: cxlist.F,v $
-* Revision 1.1.1.1 1996/02/28 16:23:41 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CXLIST(LINE,JPAK,IFERR)
-* ---------------- ------****-====-
-* -- Author : Boris Khomenko 10/02/94
- IMPLICIT NONE
-*
- CHARACTER LINE*(*)
- INTEGER JPAK
-*
-*
-#include "cdxdiv.inc"
-*
-#include "cdxfils.inc"
-*
-#include "yeaaas.inc"
-*
-* -- externals --
- INTEGER JBYT , LNBLNK
- INTEGER IFSHEQC
-*
-* -- initialization flag --
- INTEGER IFINIT
-*
-* -- default/set parameters
-* for CDLIST --
-*
-CC: 'KSN' 'ChBank' 'LNK1' 'LNK2' 'DAT1' 'DAT2' 'ChOpt'
-CC: LVKYSN LVBANK LVLNK1 LVLNK2 LVDAT1 LVDAT2 LVOPTN
-CC: KEYSN CHBAN LINK1 LINK2 IDAT1 IDAT2 CHOPT
-CC: NDKYSN(2) CHBANK(2) NDLNK1(2) NDLNK2(2) NDDAT1(2) NDDAT2(2) CHOPTN(2)
-*
-* .... KSN ....
- INTEGER LVKYSN , NDKYSN(2) , KEYSN
-*
-* .... ChBank ....
- INTEGER LVBANK
- CHARACTER*4 CHBANK(2) , CHBAN
-*
-* .... LNK1 ....
- INTEGER LVLNK1 , NDLNK1(2) , LINK1
-*
-* .... LNK2 ....
- INTEGER LVLNK2 , NDLNK2(2) , LINK2
-*
-* .... DAT1 ....
- INTEGER LVDAT1 , NDDAT1(2) , IDAT1
-*
-* .... DAT2 ....
- INTEGER LVDAT2 , NDDAT2(2) , IDAT2
-*
-* .... CHOPT ....
- INTEGER LVOPTN
- CHARACTER*6 CHOPTN(2) , CHOPT
-*
-#if !defined(CERNLIB_IBMVM)
- STATIC IFINIT
- STATIC LVKYSN , NDKYSN
- STATIC LVBANK , CHBANK
- STATIC LVLNK1 , NDLNK1
- STATIC LVLNK2 , NDLNK2
- STATIC LVDAT1 , NDDAT1
- STATIC LVDAT2 , NDDAT2
- STATIC LVOPTN , CHOPTN
-#endif
-* -- other parameters for CDLIST --
- CHARACTER CHPAT*40
- INTEGER LPAT , LOPT , LBAN
- INTEGER IRC
-* - - - - - - - - - - - - - -
- INTEGER LVNEW
-* ----------------------------
-*
-* -- Command string analyse variables --
- INTEGER JPK1
- INTEGER IFTX , IFNX , LPRF
- CHARACTER PRFX*8 , PRF*8
- INTEGER NUMB
- REAL FNUM
-*
-* -- Local variables --
-*
- INTEGER IFERR , IFQUI
- CHARACTER YES*1
- CHARACTER MESL*78
- INTEGER JJ , LR , LL
-*
- DATA IFINIT/0/
-*
- IF(IFINIT.EQ.0) THEN
- IFINIT=1
-*
- LVKYSN=1
- LVBANK=1
- LVLNK1=1
- LVLNK2=1
- LVDAT1=1
- LVDAT2=1
- LVOPTN=1
-*
- NDKYSN(1)=0
- CHBANK(1)='-'
- NDLNK1(1)=0
- NDLNK2(1)=0
- NDDAT1(1)=0
- NDDAT2(1)=0
- CHOPTN(1)='-V'
- ENDIF
-*
- IFERR=0
- IFQUI=0
- YES=YEAAAS
-*
- CHPAT=' '
-*
- 12 CONTINUE
-* _ save the next item's pointer
- JPK1=JPAK
- CALL TEXNME(LINE,JPAK,IFTX,PRFX)
- IFNX=MOD(IFTX,4)
- CALL CLTOU(PRFX)
-*
- IF(IFTX.LE.0) THEN
-* -- it is a call without parameters
-* -- show the parameters setting --
- CALL CDX_MESS('>>CDLIST --- parameters --- <<')
- CALL UXIPARM(' ','KSN ',LVKYSN,NDKYSN(LVKYSN),0, 0,NDKYSN(1))
- CALL UXCPARM(' ','ChBnk',LVBANK,CHBANK(LVBANK),0,' ',CHBANK(1))
- CALL UXIPARM(' ','L1 ',LVLNK1,NDLNK1(LVLNK1),0, 0,NDLNK1(1))
- CALL UXIPARM(' ','L2 ',LVLNK2,NDLNK2(LVLNK2),0, 0,NDLNK2(1))
- CALL UXIPARM(' ','D1 ',LVDAT1,NDDAT1(LVDAT1),0, 0,NDDAT1(1))
- CALL UXIPARM(' ','D2 ',LVDAT2,NDDAT2(LVDAT2),0, 0,NDDAT2(1))
- CALL UXCPARM(' ','opt ',LVOPTN,CHOPTN(LVOPTN),0,' ',CHOPTN(1))
-* -- show the call format --
- CALL CDX_MESS('Call format:')
- CALL CDX_MESS('> CDLIST [par/val ...] [-opt] [path]')
- IFQUI=99
-*
- ELSE IF(PRFX.EQ.'YES') THEN
-* -- it is a "YES" --
- YES='Y'
- CALL CDX_MESS('>>CDLIST: "YES"')
-*
- ELSE IF(PRFX.EQ.'ASK') THEN
-* -- it is a "ASK" --
- YES='-'
- CALL CDX_MESS('>>CDLIST: "ASK"')
-*
- ELSE IF(PRFX(1:1).EQ.'-') THEN
-* -- it is an option --
- LVNEW=0
- IF(PRFX(1:2).EQ.'-=') LVNEW=1
- CALL UXNEWCP('CDLIST','opt ',LVNEW,PRFX,LVOPTN,CHOPTN)
-*
- ELSE IF(PRFX.NE.' '.AND.IFNX.EQ.3) THEN
-* -- it seems to be a parameter (re)definition
-* KSN/n , CHBnk/c , L1/n , L2/n , D1/n , D2/n
-*
- IF(PRFX(1:1).NE.'C') THEN
- CALL TEXINS(LINE,JPAK,IFTX,PRF,NUMB,FNUM)
- ELSE
- CALL TEXSTR(LINE,JPAK,IFTX,PRF)
- ENDIF
- IFNX=MOD(IFTX,4)
- CALL CLTOU(PRF)
-*
- LVNEW=0
- IF(PRF.EQ.'=') LVNEW=1
-*
- IF (IFSHEQC(PRFX,'K*SN').GT.0) THEN
- CALL UXNEWIP('CDLIST','Ksn ',LVNEW,NUMB,LVKYSN,NDKYSN)
-*
- ELSE IF(IFSHEQC(PRFX,'CHB*nk').GT.0) THEN
- CALL UXNEWCP('CDLIST','CHBnk',LVNEW,PRF ,LVBANK,CHBANK)
-*
- ELSE IF(PRFX.EQ.'L1') THEN
- CALL UXNEWIP('CDLIST','L1',LVNEW,NUMB,LVLNK1,NDLNK1)
-*
- ELSE IF(PRFX.EQ.'L2') THEN
- CALL UXNEWIP('CDLIST','L2',LVNEW,NUMB,LVLNK2,NDLNK2)
-*
- ELSE IF(PRFX.EQ.'D1') THEN
- CALL UXNEWIP('CDLIST','D1',LVNEW,NUMB,LVDAT1,NDDAT1)
-*
- ELSE IF(PRFX.EQ.'D2') THEN
- CALL UXNEWIP('CDLIST','D2',LVNEW,NUMB,LVDAT2,NDDAT2)
-*
- ELSE
-* -- signal an INVALID SET PARAMETER --
- CALL UXCPARM('CDLIST',PRFX,0,' ',0,' ',' ')
- IFERR=1
- ENDIF
-*
- ELSE IF(PRFX.EQ.'*'.OR.PRFX.EQ.'.') THEN
-* -- it is the current directory ("*" or ".")
- CHPAT=' '
- LPAT=1
- IFQUI=1
-*
- ELSE IF((PRFX.EQ.' '.AND.IFTX.EQ.3).OR.PRFX(1:1).EQ.'.') THEN
-* -- it looks like a pathname (starts with "/" or ".")
-* -- get pathname with previously saved pointers
- JPAK=JPK1
- CALL TEXSTR(LINE,JPAK,IFTX,CHPAT)
- IFNX=MOD(IFTX,4)
- LPAT=LNBLNK(CHPAT)
- CALL CLTOU(CHPAT(:LPAT))
- IFQUI=1
-*
- ELSE
-* -- signal an INVALID item --
- IFERR=1
- CALL CDX_MESS('>>CDLIST: Unrecognized item')
- ENDIF
- IF(IFNX.GT.0.AND.IFQUI.EQ.0.AND.IFERR.EQ.0) GOTO 12
-*
- IF(IFQUI.EQ.1.AND.IFERR.EQ.0) THEN
-* -- call parameters --
- KEYSN=NDKYSN(LVKYSN)
- CHBAN=CHBANK(LVBANK)
- LINK1=NDLNK1(LVLNK1)
- LINK2=NDLNK2(LVLNK2)
- IDAT1=NDDAT1(LVDAT1)
- IDAT2=NDDAT2(LVDAT2)
- CHOPT=CHOPTN(LVOPTN)
-*
- IF(CHOPT(1:1).EQ.'-') CHOPT=CHOPT(2:)
- LOPT=MAX0(LNBLNK(CHOPT),1)
- LBAN=MAX0(LNBLNK(CHBAN),1)
-*
- CALL CDI_MESS
- + ('>>CALL CDLIST(chpath,ksn=0,b="'//CHBAN(:LBAN)//'",.>',KEYSN)
- CALL CDI_MESS('l1=0,.>',LINK1)
- CALL CDI_MESS('l2=0,.>',LINK2)
- CALL CDI_MESS('d1=0,.>',IDAT1)
- CALL CDI_MESS('d2=0,opt="'//CHOPT(:LOPT)//'",IRC)',IDAT2)
-*
- CALL CDX_MESS(' chpath='//CHPAT(:LPAT))
-*
- CALL CDLIST
- + (CHPAT,KEYSN,CHBAN,LINK1,LINK2,IDAT1,IDAT2,CHOPT,IRC)
-* -- report the Return Code --
- IF(IRC.NE.0) CALL UXIRCM('CDLIST',IRC)
- ELSE IF(IFERR.NE.0) THEN
-* -- error end --
- CALL CDX_MESS('>>CDLIST not called (instruction error)')
- ENDIF
- END
diff --git a/src/packlib/hepdb/examples/dbexam/cdex/cxmdir.F b/src/packlib/hepdb/examples/dbexam/cdex/cxmdir.F
deleted file mode 100644
index 7d93f99..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdex/cxmdir.F
+++ /dev/null
@@ -1,249 +0,0 @@
-*
-* $Id: cxmdir.F,v 1.1.1.1 1996/02/28 16:23:40 mclareni Exp $
-*
-* $Log: cxmdir.F,v $
-* Revision 1.1.1.1 1996/02/28 16:23:40 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CXMDIR(LINE,JPAK,IFERR)
-* ---------------- ------****-====-
-* -- Author : Boris Khomenko 10/02/94
- IMPLICIT NONE
-*
- CHARACTER LINE*(*)
- INTEGER JPAK
-*
-#include "cdxfils.inc"
-*
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-CC
-CC+KEEP,CDXFILS.
-CC*
-CC INTEGER MCDXFIL
-CC PARAMETER (MCDXFIL = 10)
-CC COMMON /CDXFILS/ NCDXFIL,KCDXFIL,
-CC + ICXFSTA(10),CDXFPRF(10),CDXFTOP(10),CDXFNAM(10)
-CC INTEGER NCDXFIL, KCDXFIL, ICXFSTA
-CC CHARACTER CDXFPRF*2, CDXFTOP*8, CDXFNAM*40
-CC
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-*
-#include "yeaaas.inc"
-*
-* -- externals --
- INTEGER JBYT , LNBLNK
- INTEGER IFSHEQC
-*
-* -- initialization flag --
- INTEGER IFINIT
-* -- default/set parameters
-* for CDMDIR --
-*
-CC: 'NKeys' 'MXObj' 'IPRec' 'DELta' 'ChOpt'
-CC: LVKEYS LVMOBJ LVPREC LVDELT LVOPTN
-CC: NKEYS MPOBJ IPREC DELTA CHOPT
-CC: NDKEYS(2) NDMOBJ(2) NDPREC(2) RDDELT(2) CHOPTN(2)
-*
-* .... NKEYS ....
- INTEGER LVKEYS , NDKEYS(2) , NKEYS
-*
- CHARACTER*8 CHTAG(10) , CHFOR*10
-*
-* .... MPOBJ ....
- INTEGER LVMOBJ , NDMOBJ(2) , MPOBJ
-*
-* .... IPREC ....
- INTEGER LVPREC , NDPREC(2) , IPREC
-*
-* .... DELTA ....
- INTEGER LVDELT
- REAL RDDELT(2) , DELTA
-*
-* .... CHOPT ....
- INTEGER LVOPTN
- CHARACTER*6 CHOPTN(2) , CHOPT
-*
-#if !defined(CERNLIB_IBMVM)
- STATIC IFINIT
- STATIC LVKEYS , NDKEYS
- STATIC LVMOBJ , NDMOBJ
- STATIC LVPREC , NDPREC
- STATIC LVDELT , RDDELT
- STATIC LVOPTN , CHOPTN
-#endif
-* -- other parameters for CDMDIR --
- CHARACTER CHPATH*40
- INTEGER LPATH
- INTEGER LUNDB , LUNFZ , IDIV , IRC
-* - - - - - - - - - - - - - -
- INTEGER LVNEW
-* ----------------------------
-*
-* -- Command string analyse variables --
- INTEGER JPK1
- INTEGER IFTX , IFNX , LPRF
- CHARACTER PRFX*8 , PRF*8
- INTEGER NUMB
- REAL FNUM
-*
-* -- Local variables --
-*
- INTEGER IFERR , IFQUI
- CHARACTER YES*1
- CHARACTER MESL*78
- INTEGER JJ , LL , LR
-*
- DATA IFINIT/0/
-*
- IF(IFINIT.EQ.0) THEN
- IFINIT=1
-*
- LVKEYS=1
- LVMOBJ=1
- LVPREC=1
- LVDELT=1
- LVOPTN=1
-*
- NDKEYS(1)=0
- NDMOBJ(1)=100
- NDPREC(1)=0
- RDDELT(1)=0.
- CHOPTN(1)='-'
-*
- CHFOR=' '
- DO JJ=1,10
- CHTAG(JJ)='UsKey'//CHAR(ICHAR('0')+JJ)//'a'
- ENDDO
- ENDIF
-*
- IFERR=0
- IFQUI=0
- YES=YEAAAS
-*
- 12 CONTINUE
-* _ save the next item's pointer
- JPK1=JPAK
- CALL TEXINS(LINE,JPAK,IFTX,PRFX,NUMB,FNUM)
- IFNX=JBYT(IFTX,1,2)
- CALL CLTOU(PRFX)
-*
- IF(IFTX.LE.0) THEN
-* -- it is a call without parameters
-* -- show the parameters setting --
- CALL CDX_MESS('>>CDMDIR --- parameters --- <<')
- CALL UXIPARM(' ','NKeys',LVKEYS,NDKEYS(LVKEYS),0, 0,NDKEYS(1))
- CALL UXIPARM(' ','MPObj',LVMOBJ,NDMOBJ(LVMOBJ),0, 0,NDMOBJ(1))
- CALL UXIPARM(' ','IPRec',LVPREC,NDPREC(LVPREC),0, 0,NDPREC(1))
- CALL UXRPARM(' ','DELta',LVDELT,RDDELT(LVDELT),0, 0,RDDELT(1))
- CALL UXCPARM(' ','opt ',LVOPTN,CHOPTN(LVOPTN),0,' ',CHOPTN(1))
-* -- show the call format --
- CALL CDX_MESS('Call format:')
- CALL CDX_MESS('> CDMDIR [par/val -opt ...] [path]')
- IFQUI=99
-*
- ELSE IF(PRFX.EQ.'YES') THEN
-* -- it is a "YES" --
- YES='Y'
- CALL CDX_MESS('>>CDMDIR: "YES"')
-*
- ELSE IF(PRFX.EQ.'ASK') THEN
-* -- it is a "ASK" --
- YES='-'
- CALL CDX_MESS('>>CDMDIR: "ASK"')
-*
- ELSE IF(PRFX(1:1).EQ.'-') THEN
-* -- it is an option --
- LVNEW=0
- IF(PRFX(1:2).EQ.'-=') LVNEW=1
- CALL UXNEWCP('CDMDIR','opt ',LVNEW,PRFX,LVOPTN,CHOPTN)
-*
- ELSE IF(PRFX.NE.' '.AND.IFNX.EQ.3) THEN
-* -- it seems to be a parameter (re)definition
-* NKEYS/n , MPOBJ/n , IPREC/n , DELTA/d
-*
- CALL TEXINS(LINE,JPAK,IFTX,PRF,NUMB,FNUM)
- CALL CLTOU(PRF)
-*
- LVNEW=0
- IF(PRF.EQ.'=') LVNEW=1
-*
- IF (IFSHEQC(PRFX,'NK*EYS').GT.0) THEN
- CALL UXNEWIP('CDMDIR','NKeys',LVNEW,NUMB,LVKEYS,NDKEYS)
-*
- ELSE IF(IFSHEQC(PRFX,'MPO*BJ').GT.0) THEN
- CALL UXNEWIP('CDMDIR','MPObj',LVNEW,NUMB,LVMOBJ,NDMOBJ)
-*
- ELSE IF(IFSHEQC(PRFX,'IPR*EC').GT.0) THEN
- CALL UXNEWIP('CDMDIR','IPRec',LVNEW,NUMB,LVPREC,NDPREC)
-*
- ELSE IF(IFSHEQC(PRFX,'DEL*TA').GT.0) THEN
- CALL UXNEWRP('CDMDIR','DELta',LVNEW,FNUM,LVDELT,RDDELT)
-*
- ELSE
-* -- signal an INVALID SET PARAMETER --
- CALL UXCPARM('CDMDIR',PRFX,0,' ',0,' ',' ')
- IFERR=1
- ENDIF
-*
- ELSE IF(IFTX.EQ.3) THEN
-* -- it looks like a pathname (starts with "/")
- IFQUI=1
-* -- get pathname with previously saved pointers
- CALL TEXSTR(LINE,JPK1,IFTX,CHPATH)
- LPATH=LNBLNK(CHPATH)
- CALL CLTOU(CHPATH(:LPATH))
-*
- ELSE
-* -- signal an INVALID item --
- IFERR=1
- CALL CDX_MESS('>>CDMDIR: Neither "Par/Value" nor Path "/..."')
- ENDIF
- IF(IFNX.GT.0.AND.IFQUI.EQ.0.AND.IFERR.EQ.0) GOTO 12
-*
- IF(IFQUI.LE.1.AND.IFERR.EQ.0) THEN
-* -- call parameters --
- NKEYS=NDKEYS(LVKEYS)
- MPOBJ=NDMOBJ(LVMOBJ)
- IPREC=NDPREC(LVPREC)
- DELTA=RDDELT(LVDELT)
- CHOPT=CHOPTN(LVOPTN)
- IF(CHOPT(1:1).EQ.'-') CHOPT=CHOPT(2:)
-*
- MESL='>>CALL CDMDIR('
- WRITE(MESL(15:),1111) NKEYS,MPOBJ,IPREC,CHOPT
- 1111 FORMAT('CHPATH,',
- + 3(I5,','),'# ,"',A5,'",IRC)')
- JJ=INDEX(MESL,'#')
- CALL ENCODR(DELTA,44,MESL(JJ:JJ+6),LR)
- CALL CDX_MESS(MESL(:LNBLNK(MESL)))
-*
- MESL=' '
- MESL(15:)=' nkeys mpobj iprec delta chopt'
- CALL CDX_MESS(MESL(:LNBLNK(MESL)))
-*
- MESL(15:)=' chpath='//CHPATH(:LPATH)
- CALL CDX_MESS(MESL(:LNBLNK(MESL)))
-*
- IF(CHPATH(:4).NE.'//CD'.OR.LPATH.LT.6.OR.
- + LPATH.GT.6.AND.CHPATH(7:7).NE.'/')
- + CALL CDX_MESS('>>CDMDIR WARNING! Not a HEPDB top //CDxx[/...]')
-*
- IF(YES.NE.'Y') CALL CDX_ANSW('OK ? (y/n , <cr>=y )',YES)
- IF(YES.EQ.' ') YES='Y'
- CALL CLTOU(YES)
-*
- IF(YES.EQ.'Y') THEN
- CALL CDMDIR
- + (CHPATH,NKEYS,CHFOR,CHTAG,MPOBJ,IPREC,DELTA,CHOPT,IRC)
-* -- report the Return Code --
- CALL UXIRCM('CDMDIR',IRC)
- ELSE
- CALL CDX_MESS('>>CDMDIR not called (NOK)')
- ENDIF
- ELSE IF(IFERR.NE.0) THEN
-* -- error end --
- CALL CDX_MESS('>>CDMDIR not called (instruction error)')
- ENDIF
- END
diff --git a/src/packlib/hepdb/examples/dbexam/cdex/cxnew.F b/src/packlib/hepdb/examples/dbexam/cdex/cxnew.F
deleted file mode 100644
index a1114b3..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdex/cxnew.F
+++ /dev/null
@@ -1,261 +0,0 @@
-*
-* $Id: cxnew.F,v 1.1.1.1 1996/02/28 16:23:39 mclareni Exp $
-*
-* $Log: cxnew.F,v $
-* Revision 1.1.1.1 1996/02/28 16:23:39 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CXNEW(LINE,JPAK,IFERR)
-* ----------------------****-====-
-* -- Author : Boris Khomenko 10/02/94
- IMPLICIT NONE
-*
- CHARACTER LINE*(*)
- INTEGER JPAK
-*
-* (ICDXDIV)
-#include "cdxdiv.inc"
-*
-#include "cdxluns.inc"
-*
-#include "cdxfils.inc"
-*
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-CC
-CC+KEEP,CDXFILS.
-CC*
-CC INTEGER MCDXFIL
-CC PARAMETER (MCDXFIL = 10)
-CC COMMON /CDXFILS/ NCDXFIL,KCDXFIL,
-CC + ICXFSTA(10),CDXFPRF(10),CDXFTOP(10),CDXFNAM(10)
-CC INTEGER NCDXFIL, KCDXFIL, ICXFSTA
-CC CHARACTER CDXFPRF*2, CDXFTOP*8, CDXFNAM*40
-CC
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-*
-#include "yeaaas.inc"
-*
-* -- externals --
- INTEGER JBYT , LNBLNK
- INTEGER IFSHEQC
-*
-* -- initialization flag --
- INTEGER IFINIT
-* -- default/set parameters
-* for CDNEW --
-* .... NPAIR ....
- INTEGER LVPAIR , NDPAIR(2) , NPAIR
-*
-* .... NRECS ....
- INTEGER LVRECS , NDRECS(2) , NRECS
-*
-* .... NTOP ....
- INTEGER LVNTOP , NDNTOP(2) , NUTOP
-*
-* .... LRECL ....
- INTEGER LVLREC , NDLREC(2) , LRECL
-*
-* .... CHOPT ....
- INTEGER LVOPT
- CHARACTER CHDOPT(2)*6 , CHOPT*6
-*
-#if !defined(CERNLIB_IBMVM)
- STATIC IFINIT
- STATIC LVPAIR , NDPAIR
- STATIC LVRECS , NDRECS
- STATIC LVNTOP , NDNTOP
- STATIC LVLREC , NDLREC
- STATIC LVOPT,CHDOPT
-#endif
-* -- other parameters for CDNEW --
- CHARACTER CHTOP*8 , CHFILE*40
- INTEGER LUNDB , LUNFZ , IDIV , IRC
-* - - - - - - - - - - - - - -
- INTEGER LVNEW ,LVOLD
- INTEGER IPNEW , IVOLD
- REAL RVNEW , RVOLD
- CHARACTER*6 CVNEW , CVOLD
-* ----------------------------
-*
-* -- Command string analyse variables --
- INTEGER IFTX , IFNX , LPRF
- CHARACTER PRFX*8 , PRF*8
- INTEGER NUMB
- REAL FNUM
-*
-* -- Local variables --
-*
- INTEGER IFOPT , IFERR , IFQUI , IFTOP
- CHARACTER XX*2 , YES*1
- CHARACTER MESL*78
- INTEGER LMES
- INTEGER J1 , J2 , LR , LFIL , LL
- INTEGER KK , JJ , JE , K , J
-*
- DATA IFINIT/0/
-*
- IF(IFINIT.EQ.0) THEN
- IFINIT=1
-*
- LVPAIR=1
- LVRECS=1
- LVNTOP=1
- LVLREC=1
- LVOPT=1
- NDPAIR(1)=1
- NDRECS(1)=5000
- NDNTOP(1)=0
- NDLREC(1)=1024
- CHDOPT(1)='F'
- ENDIF
-*
- IFOPT=0
- IFERR=0
- IFQUI=0
- IFTOP=0
- YES=YEAAAS
-*
- 12 CONTINUE
- CALL TEXINS(LINE,JPAK,IFTX,PRFX,NUMB,FNUM)
- IFNX=JBYT(IFTX,1,2)
- CALL CLTOU(PRFX)
- LPRF=LNBLNK(PRFX)
-*
-* -- An item may be:
-* Name/Value (-set parameter) xxxx (-chtop, then ->) filename
- IF(LPRF.GT.0.AND.IFNX.EQ.3) THEN
-* -- it seems to be an item from:
-* NPAIR, NRECS, NUTOP, LRECL
- IFOPT=IFOPT+1
-*
- CALL TEXINS(LINE,JPAK,IFTX,PRF,NUMB,FNUM)
- CALL CLTOU(PRF)
-*
- LVNEW=0
- IF(PRF.EQ.'=') LVNEW=1
-*
- IF (IFSHEQC(PRFX,'NP*AIR').GT.0) THEN
- CALL UXNEWIP('CDNEW ','NPair',LVNEW,NUMB,LVPAIR,NDPAIR)
-*
- ELSE IF(IFSHEQC(PRFX,'NR*ECS').GT.0) THEN
- CALL UXNEWIP('CDNEW ','NRecs',LVNEW,NUMB,LVRECS,NDRECS)
-*
- ELSE IF(IFSHEQC(PRFX,'NU*TOP').GT.0) THEN
- CALL UXNEWIP('CDNEW ','NUtop',LVNEW,NUMB,LVNTOP,NDNTOP)
-*
- ELSE IF(IFSHEQC(PRFX,'LR*ECL').GT.0) THEN
- CALL UXNEWIP('CDNEW ','LRecl',LVNEW,NUMB,LVLREC,NDLREC)
-*
- ELSE IF(IFSHEQC(PRFX,'CHO*PT').GT.0.OR.
- + IFSHEQC(PRFX,'O*PT ').GT.0 ) THEN
- CALL UXNEWCP('CDNEW ','ChOpt',LVNEW, PRF,LVOPT,CHDOPT)
-*
- ELSE
-* -- signal an INVALID SET PARAMETER --
- CALL UXCPARM('CDNEW ',PRFX,0,' ',0,' ',' ')
- ENDIF
-*
- ELSE IF(PRFX.EQ.'YES') THEN
-* -- it is a "YES" --
- YES='Y'
- CALL CDX_MESS('>>CDNEW : "YES"')
-*
- ELSE IF(PRFX.EQ.'ASK') THEN
-* -- it is a "ASK" --
- YES='-'
- CALL CDX_MESS('>>CDNEW : "ASK"')
-*
- ELSE IF(LPRF.GT.0) THEN
-* -- it seems to be a new file's CHTOP (CH*4?)
- IFTOP=1
- ENDIF
- IF(IFNX.GT.0.AND.IFERR+IFQUI+IFTOP.EQ.0) GOTO 12
-*
- IF(IFOPT.LE.0.AND.IFTOP.LE.0) THEN
-* -- show the parameters setting --
- CALL CDX_MESS('>>CDNEW -- parameters -- <<')
- CALL UXIPARM(' ','NPair',LVPAIR,NDPAIR(LVPAIR),0, 0,NDPAIR(1))
- CALL UXIPARM(' ','NRecs',LVRECS,NDRECS(LVRECS),0, 0,NDRECS(1))
- CALL UXIPARM(' ','NUtop',LVNTOP,NDNTOP(LVNTOP),0, 0,NDNTOP(1))
- CALL UXIPARM(' ','LRecl',LVLREC,NDLREC(LVLREC),0, 0,NDLREC(1))
- CALL UXCPARM(' ','ChOpt',LVOPT ,CHDOPT(LVOPT ),0,' ',CHDOPT(1))
-* -- show the call format --
- CALL CDX_MESS('Call format:')
- CALL CDX_MESS('> CDNEW [ par/val ... ] [ chtop filename ]')
- ENDIF
-*
- IF(IFTOP.GT.0.AND.IFERR+IFQUI.EQ.0) THEN
- LL=LNBLNK(PRFX)
-* -- Find a place in the CDXFILS table
- KK=0
- DO K=1,MCDXFIL
- IF(KK.EQ.0.AND.CDXFPRF(K).EQ.' ') KK=K
- ENDDO
-*
- IF(KK.GT.0) THEN
-* -- OK with a place in CDXFILS table
-* -- make a specific prefix like "$x"
- XX='$'//CHAR(ICHAR('A')-1+KK)
- CHTOP =PRFX
-* -- get a file definition
- CALL TEXSTR(LINE,JPAK,IFTX,CHFILE)
- IF(IFTX/4.LE.0) THEN
- CHFILE=CHTOP(:LNBLNK(CHTOP))//'.rz'
- CALL CDX_MESS(
- + '>>CDNEW : EMPTY filename, CHTOP//".rz" generated')
- ENDIF
- LFIL=LNBLNK(CHFILE)
-*
-C ICXFSTA(KK)=-99
-* -- other call parameters --
- LUNDB=LUNAMES+KK
- NPAIR=NDPAIR(LVPAIR)
- NRECS=NDRECS(LVRECS)
- NUTOP=NDNTOP(LVNTOP)
- LRECL=NDLREC(LVLREC)
- CHOPT=CHDOPT(LVOPT)
-*
- CALL CDX_MESS('>>CALL ...')
- MESL='>>CDNEW('
- WRITE(MESL(9:),1111)
- + LUNDB,ICDXDIV,NPAIR,NRECS,NRECS,NUTOP,LRECL,CHOPT
- 1111 FORMAT(I3,',CHTOP,CHFILE,',
- + 6(I5,','),'"',A5,'",IRC)')
- LMES=INDEX(MESL,')')
- CALL CDX_MESS(MESL(:LMES))
-*
- CALL CDX_MESS(' lundb '//
- + ' idiv npair nrecs=nrfmt nutop lrecl chopt')
-*
- CALL CDX_MESS(' chtop='//CHTOP)
- CALL CDX_MESS
- + (' chfile='//CHFILE(:LFIL))
-*
- IF(YES.NE.'Y') CALL CDX_ANSW('OK ? (y/n , <cr>=y )',YES)
- IF(YES.EQ.' ') YES='Y'
- CALL CLTOU(YES)
-*
- IF(YES.EQ.'Y') THEN
- CALL CDNEW(LUNDB,CHTOP,CHFILE,
- + ICDXDIV,NPAIR,NRECS,NRECS,NUTOP,LRECL,CHOPT,IRC)
-* -- report the Return Code --
- CALL UXIRCM('CDNEW ',IRC)
-* -- store file info into DB files table --
- NCDXFIL=MAX0(NCDXFIL,KK)
- ICXFSTA(KK)=IABS(IRC)+1
- CDXFPRF(KK)=XX
- CDXFTOP(KK)=CHTOP
- CDXFNAM(KK)=CHFILE
- MESL=' CDNEW >>'
- CALL UXFILLN(KK,MESL(12:),LMES)
- CALL CDX_MESS(MESL(:LMES+11))
- ELSE
- CALL CDX_MESS('>>CDNEW not called (NOK)')
- ENDIF
- ELSE
- CALL CDX_MESS('>>CDNEW: too many DBFiles')
- ENDIF
- ENDIF
- END
diff --git a/src/packlib/hepdb/examples/dbexam/cdex/cxopen.F b/src/packlib/hepdb/examples/dbexam/cdex/cxopen.F
deleted file mode 100644
index c53ba3f..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdex/cxopen.F
+++ /dev/null
@@ -1,158 +0,0 @@
-*
-* $Id: cxopen.F,v 1.1.1.1 1996/02/28 16:23:39 mclareni Exp $
-*
-* $Log: cxopen.F,v $
-* Revision 1.1.1.1 1996/02/28 16:23:39 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CXOPEN(LINE,JPAK,IFERR)
-* -----------------------****-====-
-* -- Author : Boris Khomenko 10/02/94
- IMPLICIT NONE
-*
- CHARACTER LINE*(*)
- INTEGER JPAK
-*
-* (ICDXDIV)
-#include "cdxdiv.inc"
-*
-#include "cdxluns.inc"
-*
-#include "cdxfils.inc"
-*
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-CC
-CC+KEEP,CDXFILS.
-CC*
-CC INTEGER MCDXFIL
-CC PARAMETER (MCDXFIL = 10)
-CC COMMON /CDXFILS/ NCDXFIL,KCDXFIL,
-CC + ICXFSTA(10),CDXFPRF(10),CDXFTOP(10),CDXFNAM(10)
-CC INTEGER NCDXFIL, KCDXFIL, ICXFSTA
-CC CHARACTER CDXFPRF*2, CDXFTOP*8, CDXFNAM*40
-CC
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-*
-* -- externals --
- INTEGER JBYT
-*
-* -- initialization flag --
- INTEGER IFINIT
-* -- default/set parameters
-* for CDOPEN --
- INTEGER LVOPT
- CHARACTER CDOPT(2)*8
-#if !defined(CERNLIB_IBMVM)
- STATIC IFINIT
- STATIC LVOPT,CDOPT
-#endif
-*
-* -- other parameters for CDOPEN --
- CHARACTER CHTOP*8 , CHFILE*40 , CHOPT*6
- INTEGER LUNDB , LUNFZ , LRECL , IDIV , IRC
-* - - - - - - - - - - - - - -
- INTEGER LVNEW , LVOLD
- INTEGER IVNEW , IVOLD
- REAL RVNEW , RVOLD
- CHARACTER*6 CVNEW , CVOLD
-* ----------------------------
-*
-* -- Command string analyse variables --
- INTEGER IFTX , IFNX , LPRF
- CHARACTER PRFX*8 , PRF*8
- INTEGER NUMB
- REAL FNUM
-*
-* -- Local variables --
-*
- INTEGER IFERR
- CHARACTER XX*2
- CHARACTER MESL*78
- INTEGER LMES
- INTEGER J1 , J2 , LR , LFIL , LEN , JLASNC
- INTEGER KK , JJ , JE , K , J
-*
- DATA IFINIT/0/
-*
- IF(IFINIT.EQ.0) THEN
- IFINIT=1
- LVOPT=1
- CDOPT(1)='P'
- ENDIF
-*
- IFERR=0
- 12 CONTINUE
- CALL TEXINS(LINE,JPAK,IFTX,PRFX,NUMB,FNUM)
- IFNX=JBYT(IFTX,1,2)
- CALL CLTOU(PRFX)
- LPRF=JLASNC(PRFX,' ')
- IF((LPRF.GT.0.AND.LPRF.NE.2).OR.IFNX.EQ.3) THEN
- CALL TEXINS(LINE,JPAK,IFTX,PRF,NUMB,FNUM)
- CALL CLTOU(PRF)
- IF(PRFX(1:1).EQ.'C'.OR.PRFX(1:1).EQ.'O'.OR.PRFX.EQ.' ') THEN
- PRFX='CHOPT'
- LVOLD=LVOPT
- CVOLD=CDOPT(LVOLD)
- IF(PRF.EQ.' '.OR.PRF.EQ.'=') THEN
- LVNEW=1
- CVNEW=CDOPT(1)
- ELSE
- IF(PRF.EQ.CDOPT(1)) THEN
- LVNEW=1
- ELSE
- LVNEW=2
- CVNEW=PRF
- ENDIF
- ENDIF
- LVOPT=LVNEW
- IF(LVNEW.GT.1) CDOPT(LVNEW)=CVNEW
- CALL UXCPARM('CDOPEN',PRFX,LVNEW,CVNEW,LVOLD,CVOLD,CDOPT(1))
- ELSE
-* -- signal an invalid set parameter --
- CALL UXCPARM('CDOPEN',PRFX,0,' ',0,' ',' ')
- ENDIF
- ELSE
-* -- it is a database ID (prefix)
- XX=PRFX
-* -- Locate the XX in the CDXFILS table
- KK=0
- DO 111 K=1,NCDXFIL
- IF(KK.EQ.0.AND.CDXFPRF(K).EQ.XX ) KK=K
- 111 CONTINUE
- IF(KK.GT.0) THEN
- IF(ICXFSTA(KK).EQ.-1) THEN
-* -- OK, get file info from CDXFILS table
- CHTOP =CDXFTOP(KK)
- CHFILE=CDXFNAM(KK)
-* -- other call parameters --
- LUNDB=LUNAMES+KK
- LUNFZ=LUNDB+10
- LRECL=0
- IDIV=ICDXDIV
- CHOPT=CDOPT(LVOPT)
-*
- CALL CDX_MESS('>>CDOPEN call<<')
- CALL CDX_MESS(' chtop : '//CHTOP)
- CALL CDX_MESS(' chfile: '//CHFILE)
- CALL CDX_MESS(' ChOpt : '//CHOPT)
- CALL CDX_MESS(' lrecl : 0')
- MESL='>>CDOPEN('
- WRITE(MESL(10:),1111) LUNDB,LUNFZ,IDIV
- 1111 FORMAT(2(I3,','),'CHTOP,CHFILE,LRECL,',I4,',','CHOPT,IRC)')
- LMES=INDEX(MESL,')')
- CALL CDX_MESS(MESL(:LMES))
-*
- CALL CDOPEN(LUNDB,LUNFZ,CHTOP,CHFILE,LRECL,IDIV,CHOPT,IRC)
- CALL CDI_MESS('==CDOPEN>> LRECL:0',LRECL)
- IF(IRC.NE.0) CALL UXIRCM('CDOPEN',IRC)
-*
- ICXFSTA(KK)=IABS(IRC)+1
- ENDIF
- ELSE
- ENDIF
- ENDIF
- IF(IFNX.GT.0.AND.IFERR.EQ.0) GOTO 12
-*
- END
diff --git a/src/packlib/hepdb/examples/dbexam/cdex/cxpaw.F b/src/packlib/hepdb/examples/dbexam/cdex/cxpaw.F
deleted file mode 100644
index 16546d2..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdex/cxpaw.F
+++ /dev/null
@@ -1,240 +0,0 @@
-*
-* $Id: cxpaw.F,v 1.1.1.1 1996/02/28 16:23:40 mclareni Exp $
-*
-* $Log: cxpaw.F,v $
-* Revision 1.1.1.1 1996/02/28 16:23:40 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CXPAW(MWPAWC,LINE,JPAK,IFERR)
-* ---------------------- ------****-=====-
-* -- Author : Boris Khomenko 10/02/94
- IMPLICIT NONE
-*
- INTEGER MWPAWC,JPAK,IFERR
- CHARACTER LINE*(*)
-*
-#include "cdxdiv.inc"
-*
-#include "yeaaas.inc"
-*
-* -- externals --
- INTEGER JBYT , LNBLNK
- INTEGER IFSHEQC
-*
-* -- initialization flag --
- INTEGER IFINIT
-* -- default/set parameters
-* for CXPAW --
-*
-CC: 'NWPaw' 'NWHbk' 'UDNam' 'NWIni' 'NWMax' 'ChOpt'
-CC: LVNPAW LVNHBK LVUNAM LVNINI LVNMAX LVOPTN
-CC: NDNPAW(2) NDNHBK(2) CDUNAM(2) NDNINI(2) NDNMAX(2) CDOPTN(2)
-CC: NWPAW NWHBK UDNAM NWINI NWMAX CHOPT
-*
-* .... NWPAW ....
- INTEGER LVNPAW , NDNPAW(2) , NWPAW
-*
-* .... NWHBK ....
- INTEGER LVNHBK , NDNHBK(2) , NWHBK
-*
-* .... UDNAM ....
- INTEGER LVUNAM
- CHARACTER*8 CDUNAM(2) , UDNAM
-*
-* .... NWINI ....
- INTEGER LVNINI , NDNINI(2) , NWINI
-*
-* .... NWMAX ....
- INTEGER LVNMAX , NDNMAX(2) , NWMAX
-*
-* .... CHOPT ....
- INTEGER LVOPTN
- CHARACTER*6 CDOPTN(2) , CHOPT
-*
-#if !defined(CERNLIB_IBMVM)
- STATIC IFINIT
- STATIC LVNPAW , NDNPAW
- STATIC LVNHBK , NDNHBK
- STATIC LVUNAM , CDUNAM
- STATIC LVNINI , NDNINI
- STATIC LVNMAX , NDNMAX
- STATIC LVOPTN , CDOPTN
-#endif
-* -- other parameters for CDPAW --
- INTEGER IDIV , IRC
-* - - - - - - - - - - - - - -
- INTEGER LVNEW
-* ----------------------------
-*
-* -- Command string analyse variables --
- INTEGER IFTX , IFNX , LPRF
- CHARACTER PRFX*8 , PRF*8
- INTEGER NUMB
- REAL FNUM
- INTEGER JPK1, JTX, JNM, JNX, JMX
-*
-* -- Local variables --
-*
- INTEGER IFQUI
- CHARACTER CODE*11 , YES*1
- CHARACTER MESL*78
- INTEGER JJ , LR , LL
-*
- DATA IFINIT/0/
-*
- IF(IFINIT.EQ.0) THEN
- IFINIT=1
-*
- LVNPAW=1
- LVNHBK=1
- LVUNAM=1
- LVNINI=1
- LVNMAX=1
- LVOPTN=1
-*
- NDNPAW(1)=MWPAWC
- NDNHBK(1)=MWPAWC/10
- CDUNAM(1)='DBUSER'
- NDNINI(1)=MWPAWC/10
- NDNMAX(1)=MWPAWC/2
- CDOPTN(1)='-ZPHU'
- ENDIF
-*
- IFERR=0
- IFQUI=0
- YES=YEAAAS
-*
- 12 CONTINUE
-* _ save the next item's pointer
- JPK1=JPAK
- CALL TEXINS(LINE,JPAK,IFTX,PRFX,NUMB,FNUM)
- IFNX=JBYT(IFTX,1,2)
- CALL CLTOU(PRFX)
-*
- IF(IFTX.LE.0) THEN
-* -- it is a call without parameters
-* -- to do a CALL...
- IFQUI=1
-*
- ELSE IF(PRFX(1:1).EQ.'%') THEN
-* -- it is a Command Modificator --
-*
- ELSE IF(PRFX(1:1).EQ.'?') THEN
-* -- it is an info/help request --
-* -- show the parameters setting --
- CALL CDX_MESS('>>CDPAW --- parameters --- <<')
- CALL UXIPARM(' ','NWPaw',LVNPAW,NDNPAW(LVNPAW),0, 0,NDNPAW(1))
- CALL UXIPARM(' ','NWHbk',LVNHBK,NDNHBK(LVNHBK),0, 0,NDNHBK(1))
- CALL UXCPARM(' ','UDName',LVUNAM,CDUNAM(LVUNAM),0,' ',CDUNAM(1))
- CALL UXIPARM(' ','NWIni',LVNINI,NDNINI(LVNINI),0, 0,NDNINI(1))
- CALL UXIPARM(' ','NWMax',LVNMAX,NDNMAX(LVNMAX),0, 0,NDNMAX(1))
- CALL UXCPARM(' ','opt ',LVOPTN,CDOPTN(LVOPTN),0,' ',CDOPTN(1))
-* -- show the call format --
- CALL CDX_MESS('Call format:')
- CALL CDX_MESS('> CDPAW [?] [par/val ...] [-opt]')
- IFQUI=99
-*
- ELSE IF(PRFX.EQ.'YES') THEN
-* -- it is a "YES" --
- YES='Y'
- CALL CDX_MESS('>>CDPAW : "YES"')
-*
- ELSE IF(PRFX.EQ.'ASK') THEN
-* -- it is a "ASK" --
- YES='-'
- CALL CDX_MESS('>>CDPAW : "ASK"')
-*
- ELSE IF(PRFX(1:1).EQ.'-') THEN
-* -- it is an option --
- LVNEW=0
- IF(PRFX(1:2).EQ.'-=') LVNEW=1
- CALL UXNEWCP('CDPAW ','opt ',LVNEW,PRFX,LVOPTN,CDOPTN)
-*
- ELSE IF(PRFX.NE.' '.AND.IFNX.EQ.3) THEN
-* -- it seems to be a parameter (re)definition
-* NWPAW/n , NWHBK/n , UDNAM/cn NWINI/n , NWMAX/n
-*
- CALL TEXINS(LINE,JPAK,IFTX,PRF,NUMB,FNUM)
- CALL CLTOU(PRF)
-*
- LVNEW=0
- IF(PRF.EQ.'=') LVNEW=1
-*
- IF (IFSHEQC(PRFX,'NWP*aw').GT.0) THEN
- CALL UXNEWIP('CDPAW ','NWPaw',LVNEW,NUMB,LVNPAW,NDNPAW)
-*
- ELSE IF(IFSHEQC(PRFX,'NWH*bk').GT.0) THEN
- CALL UXNEWIP('CDPAW ','NWHbk',LVNEW,NUMB,LVNHBK,NDNHBK)
-*
- ELSE IF(IFSHEQC(PRFX,'UDN*am').GT.0) THEN
- CALL UXNEWCP('CDPAW ','UDNam',LVNEW, PRF,LVUNAM,CDUNAM)
-*
- ELSE IF(IFSHEQC(PRFX,'NWI*ni').GT.0) THEN
- CALL UXNEWIP('CDPAW ','NWIni',LVNEW,NUMB,LVNINI,NDNINI)
-*
- ELSE IF(IFSHEQC(PRFX,'NWM*ax').GT.0) THEN
- CALL UXNEWRP('CDPAW ','NWMax',LVNEW,NUMB,LVNMAX,NDNMAX)
-*
- ELSE
-* -- signal an INVALID SET PARAMETER --
- CALL UXCPARM('CDPAW ',PRFX,0,' ',0,' ',' ')
- IFERR=1
- ENDIF
-*
- ELSE
-* -- signal an INVALID item --
- IFERR=1
- CALL CDX_MESS('>>CDPAW : Neither "Par/Value" nor "-opt"')
- ENDIF
- IF(IFNX.GT.0.AND.IFQUI.EQ.0.AND.IFERR.EQ.0) GOTO 12
-*
- IF(IFQUI.LE.1.AND.IFERR.EQ.0) THEN
-* -- call parameters --
- NWPAW=NDNPAW(LVNPAW)
- NWHBK=NDNHBK(LVNHBK)
- UDNAM=CDUNAM(LVUNAM)
- NWINI=NDNINI(LVNINI)
- NWMAX=NDNMAX(LVNMAX)
- CHOPT=CDOPTN(LVOPTN)
- IF(CHOPT(1:1).EQ.'-') CHOPT=CHOPT(2:)
-*
- MESL='>>CALL CDPAW ('
- WRITE(MESL(15:),1111) NWPAW,NWHBK,UDNAM,NWINI,NWMAX,CHOPT
- 1111 FORMAT(I6,',',I5,',IDIV,"',A8,'"',2(','I5),',"',A6)
- LL=LNBLNK(MESL)
- MESL(LL+1:LL+6)='",IRC)'
- LL=LL+6
- CALL CDX_MESS(MESL(:LL))
-*
- MESL=' '
- MESL(15:)=' nwpaw nwhbk udname nwini nwmax opt'
- CALL CDX_MESS(MESL(:LNBLNK(MESL)))
-*
- IF(YES.NE.'Y') CALL CDX_ANSW('OK ? (y/n , <cr>=y )',YES)
- IF(YES.EQ.' ') YES='Y'
- CALL CLTOU(YES)
-*
- IF(YES.EQ.'Y') THEN
- CALL CDX_MESS('>>....................................')
- CALL CDPAW(NWPAW,NWHBK,IDIV,UDNAM,NWINI,NWMAX,CHOPT,IRC)
- CALL CDX_MESS('>>....................................')
-*
- ICDXDIV=IDIV
-* -- report the returned IDIV --
- CALL ENCODI(IDIV,-1,CODE,LR)
- CALL CDX_MESS('==CDPAW >> IDIV='//CODE(:LR))
-* -- report the Return Code --
- CALL UXIRCM('CDPAW ',IRC)
- CALL CDX_MESS('>>........more of Z init..............')
- CALL CDXINIZ
-CC CALL CDX_MESS('>>....................................')
- ELSE
- CALL CDX_MESS('>>CDPAW not called (NOK)')
- ENDIF
- ELSE IF(IFERR.NE.0) THEN
-* -- error end --
- CALL CDX_MESS('>>CDPAW not called (instruction error)')
- ENDIF
- END
diff --git a/src/packlib/hepdb/examples/dbexam/cdex/cxpref.F b/src/packlib/hepdb/examples/dbexam/cdex/cxpref.F
deleted file mode 100644
index d6405b9..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdex/cxpref.F
+++ /dev/null
@@ -1,82 +0,0 @@
-*
-* $Id: cxpref.F,v 1.1.1.1 1996/02/28 16:23:39 mclareni Exp $
-*
-* $Log: cxpref.F,v $
-* Revision 1.1.1.1 1996/02/28 16:23:39 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CXPREF(PF)
-* ---------------------
-* -- Author : Boris Khomenko 10/02/94
- IMPLICIT NONE
-*
- CHARACTER PF*(*)
-*
-#include "cdxluns.inc"
-*
-#include "cdxfils.inc"
-*
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-CC
-CC+KEEP,CDXFILS.
-CC*
-CC INTEGER MCDXFIL
-CC PARAMETER (MCDXFIL = 10)
-CC COMMON /CDXFILS/ NCDXFIL,KCDXFIL,
-CC + ICXFSTA(10),CDXFPRF(10),CDXFTOP(10),CDXFNAM(10)
-CC INTEGER NCDXFIL, KCDXFIL, ICXFSTA
-CC CHARACTER CDXFPRF*2, CDXFTOP*8, CDXFNAM*40
-CC
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-*
- CHARACTER MESL*78
- INTEGER LMES
-*
- CHARACTER XX*2 , CHTOP*8 , CHFILE*40
- INTEGER IRC , J1 , J2 , LR , LFIL , LEN , JLASNC
- INTEGER KK , JJ , JE , K , J
-*
- XX=PF
- CALL CLTOU(XX)
-*
- CHTOP='-'
- CHFILE='-'
- CALL CDPREF(LUNAMES,XX,CHTOP,CHFILE,IRC)
-*
-* -- Locate/add the XX in the CDXFILS table
- KK=0
- JJ=0
- JE=0
- DO 111 K=1,NCDXFIL
- IF(KK.EQ.0.AND.CDXFPRF(K).EQ.XX ) KK=K
- IF(JJ.EQ.0.AND.CDXFPRF(K).EQ.' ') JJ=K
- IF(JE.EQ.0.AND.ICXFSTA(K).NE.0.AND.ICXFSTA(K).NE.-1) JE=K
- 111 CONTINUE
- IF(KK.LE.0) THEN
- IF(JJ.GT.0) THEN
- KK=JJ
- ELSE IF(NCDXFIL.LT.MCDXFIL) THEN
- NCDXFIL=NCDXFIL+1
- KK=NCDXFIL
- ELSE IF(JE.GT.0) THEN
- KK=JE
- ELSE
- KK=NCDXFIL
- ENDIF
- ENDIF
-*
-* -- store result into CDXFILS table
- ICXFSTA(KK)=-IABS(IRC)-1
- CDXFPRF(KK)=XX
- CDXFTOP(KK)=CHTOP
- CDXFNAM(KK)=CHFILE
-*
- MESL=' CDPREF>>'
- J=12
- CALL UXFILLN(KK,MESL(J:),LMES)
- LMES=LMES+J-1
- CALL CDX_MESS(MESL(:LMES))
-*
- END
diff --git a/src/packlib/hepdb/examples/dbexam/cdex/cxpurg.F b/src/packlib/hepdb/examples/dbexam/cdex/cxpurg.F
deleted file mode 100644
index e0c284e..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdex/cxpurg.F
+++ /dev/null
@@ -1,167 +0,0 @@
-*
-* $Id: cxpurg.F,v 1.1.1.1 1996/02/28 16:23:41 mclareni Exp $
-*
-* $Log: cxpurg.F,v $
-* Revision 1.1.1.1 1996/02/28 16:23:41 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CXPURG(LINE,JPAK,IFERR)
-* -----------------------****-====-
-* -- Author : Boris Khomenko 10/02/94
- IMPLICIT NONE
-*
- CHARACTER LINE*(*)
- INTEGER JPAK
-*
-#include "zquest.inc"
-*
-#include "yeaaas.inc"
-*
-* -- externals --
- INTEGER JBYT , LNBLNK
- INTEGER IFSHEQC
-*
-* -- parameters for CDPURG --
- CHARACTER CHPAT*40
- CHARACTER CHOPT*4
- INTEGER LPAT , LOPT
- INTEGER KYNUM , KYLIM
- INTEGER IRC
-* ----------------------------
-*
-* -- Command string analyse variables --
- INTEGER JPK1
- INTEGER IFTX , IFNX , LPRF
- CHARACTER PRFX*8 , PRF*8
- INTEGER NUMB
- REAL FNUM
-*
-* -- Local variables --
-*
- INTEGER IFERR , IFQUI
- CHARACTER YES*1 , CODE*11
- CHARACTER MESL*78
- INTEGER JJ , LR , LL
-*
- CHPAT='-'
- CHOPT='-'
- KYNUM=0
- KYLIM=0
-*
- IFERR=0
- IFQUI=0
- YES=YEAAAS
-*
- 12 CONTINUE
-* _ save the next item's pointer
- JPK1=JPAK
- CALL TEXINS(LINE,JPAK,IFTX,PRFX,NUMB,FNUM)
- IFNX=MOD(IFTX,4)
- CALL CLTOU(PRFX)
-*
- IF(IFTX.LE.0) THEN
-* -- it is a call without parameters
-* -- show the call format --
- CALL CDX_MESS('Call format:')
- CALL CDX_MESS('> CDPURG [path] [-opt] [kynum/kylim]')
- IFQUI=99
-*
- ELSE IF(PRFX.EQ.'YES') THEN
-* -- it is a "YES" --
- YES='Y'
- CALL CDX_MESS('>>CDPURG: "YES"')
-*
- ELSE IF(PRFX.EQ.'ASK') THEN
-* -- it is a "ASK" --
- YES='-'
- CALL CDX_MESS('>>CDPURG: "ASK"')
-*
- ELSE IF(PRFX(1:1).EQ.'-') THEN
-* -- it is an option --
- CHOPT=PRFX
-*
- ELSE IF(PRFX.EQ.'*'.OR.PRFX.EQ.'.') THEN
-* -- it looks like a current directory ("*" or ".")
- CHPAT=' '
- LPAT=1
- IFQUI=1
-*
- ELSE IF(IFTX.EQ.3) THEN
-* -- it looks like a pathname (starts with "/")
-* -- get pathname with previously saved pointers
- JPAK=JPK1
- CALL TEXSTR(LINE,JPAK,IFTX,CHPAT)
- IFNX=MOD(IFTX,4)
- LPAT=LNBLNK(CHPAT)
- CALL CLTOU(CHPAT(:LPAT))
- IFQUI=1
-*
- ELSE IF(PRFX.EQ.' '.AND.NUMB.GT.0) THEN
-* -- it's an alone positive number;
-* must be KYNUM followed by KYLIM, if any
- KYNUM=NUMB
-* -- try to get KYLIM
- IF(IFNX.EQ.3) THEN
- CALL TEXINS(LINE,JPAK,IFTX,PRFX,NUMB,FNUM)
- IFNX=MOD(IFTX,4)
- KYLIM=NUMB
- ELSE
- KYLIM=0
- ENDIF
-*
- ELSE
-* -- signal an INVALID item --
- IFERR=1
- CALL CDX_MESS('>>CDPURG: unrecognized item')
- ENDIF
- IF(IFNX.GT.0.AND.IFQUI.EQ.0.AND.IFERR.EQ.0) GOTO 12
-*
- IF(IFQUI.EQ.1.AND.IFERR.EQ.0) THEN
-* -- call parameters --
-*
- IF(CHOPT(1:1).EQ.'-') CHOPT=CHOPT(2:)
- LOPT=MAX0(LNBLNK(CHOPT),1)
-*
- IF(CHOPT.EQ.'S') KYLIM=MAX0(KYLIM,KYNUM)
-*
- MESL='>>CALL CDPURG(CHPATH,'
- LL=LNBLNK(MESL)
- CALL ENCODI(KYNUM,-1,CODE,LR)
- MESL(LL+1:)=CODE
- LL=LNBLNK(MESL)
- CALL ENCODI(KYLIM,-1,CODE,LR)
- MESL(LL+1:)=','//CODE(:LR)//',"'//CHOPT(:LOPT)//'",IRC)'
- CALL CDX_MESS(MESL(:LNBLNK(MESL)))
-*
- MESL=' '
- MESL(15:)=' chpath='//CHPAT(:LPAT)
- CALL CDX_MESS(MESL(:LNBLNK(MESL)))
-*
- YES='-'
- IF(YES.NE.'Y') CALL CDX_ANSW('OK ? (y/n , <cr>=y )',YES)
- IF(YES.EQ.' ') YES='Y'
- CALL CLTOU(YES)
-*
- IF(YES.EQ.'Y') THEN
- CALL CDPURG(CHPAT,KYNUM,KYLIM,CHOPT,IRC)
- IF(IRC.EQ.0) THEN
- CALL ENCODI(IQUEST(2),-1,CODE,LR)
- CALL CDX_MESS('==CDPURG>> '//CODE(:LR)//' objects deleted')
- write(*,*) (iquest(jj),jj=1,20)
- ENDIF
-* -- report the Return Code --
- CALL UXIRCM('CDPURG',IRC)
- ELSE
- CALL CDX_MESS('>>CDPURG not called (NOK)')
- ENDIF
- ELSE IF(IFERR.NE.0) THEN
-* -- error end --
- CALL CDX_MESS('>>CDPURG not called (instruction error)')
-*
- ELSE IF(IFQUI.EQ.0) THEN
-* -- no path given --
- CALL CDX_MESS('>>CDPURG not called (no path given)')
- ENDIF
- END
diff --git a/src/packlib/hepdb/examples/dbexam/cdex/cxtext.F b/src/packlib/hepdb/examples/dbexam/cdex/cxtext.F
deleted file mode 100644
index a11597c..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdex/cxtext.F
+++ /dev/null
@@ -1,261 +0,0 @@
-*
-* $Id: cxtext.F,v 1.1.1.1 1996/02/28 16:23:40 mclareni Exp $
-*
-* $Log: cxtext.F,v $
-* Revision 1.1.1.1 1996/02/28 16:23:40 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CXTEXT(LINE,JPAK,IFERR)
-* ---------------- ------****-====-
-* -- Author : Boris Khomenko 10/02/94
- IMPLICIT NONE
-*
- CHARACTER LINE*(*)
- INTEGER JPAK
-*
-* (ICDXDIV)
-#include "cdxdiv.inc"
-CC*
-CC* - - - - - -/CDULNK/- - - - - - - - - - - - - - - - - -
-CC COMMON /CDULNK/ ICDXDIV , LCDXDIV,
-CC + LDBRKY(10),LDBRDA(10),LDBRXX
-CC INTEGER ICDXDIV , LCDXDIV
-CC INTEGER LDBRKY,LDBRDA,LDBRXX
-CC* - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-CC*
-*
-#include "dbrinf.inc"
-CC* - - - - - -/DBRINFO/- - - - - - - - - - - - - - - - - -
-CC COMMON /DBRIFIL/ LUDBRIN,NLDBRIN,DBRIFIL
-CC INTEGER LUDBRIN,NLDBRIN
-CC CHARACTER*60 DBRIFIL
-CC*
-CC COMMON /DBRHEAD/ IDBRTYP,IDBRMOD,LENGDBR,DBRTYPE,DBRPATH
-CC INTEGER IDBRTYP,IDBRMOD,LENGDBR
-CC CHARACTER DBRTYPE*4,DBRPATH*40
-CC*
-CC COMMON /DBRCMNT/ DBRCMNT
-CC CHARACTER DBRCMNT*72
-CC*
-CC COMMON /DBRINBF/ IDBRDIV,LDBRBUF,IDBRKEY(20),NDBRKEY
-CC INTEGER IDBRDIV,LDBRBUF,IDBRKEY ,NDBRKEY
-CC*
-CC COMMON /DBRLINK/ LDBRKYS,LDBRDAT
-CC INTEGER LDBRKYS,LDBRDAT
-CC* - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-*
-#include "cdxluns.inc"
-*
-#include "yeaaas.inc"
-*
-* -- externals --
- INTEGER LNBLNK
- INTEGER IFSHEQC
-*
-* -- initialization flag --
- INTEGER IFINIT
-* -- default/set parameters
-* for CDTEXT --
-*
-CC: 'LUnit' 'ChOpt'
-CC: LVUNIT
-CC: NDUNIT(2)
-CC: LUNIT
-*
-* .... LUNIT ....
- INTEGER LVUNIT , NDUNIT(2) , LUNIT
-*
-#if !defined(CERNLIB_IBMVM)
- STATIC IFINIT
- STATIC LVUNIT , NDUNIT
-#endif
-* -- other parameters for CDTEXT --
- CHARACTER CHFILE*40
- INTEGER LBANK
- CHARACTER CHOPT*6
- INTEGER IRC
-* - - - - - - - - - - - - - -
- INTEGER LVNEW
-* ----------------------------
-*
-* -- Command string analyse variables --
- INTEGER IFTX , IFNX , LPRF
- CHARACTER PRFX*8 , PRF*8
- INTEGER NUMB
- REAL FNUM
- INTEGER JPK1
-*
-* -- Local variables --
-*
- INTEGER IFERR , IFQUI
- INTEGER LFILE , LOPT
- CHARACTER YES*1 , CH*1
- CHARACTER MESL*78
- INTEGER JJ , LR , LL
- CHARACTER CODE*11
-*
- DATA IFINIT/0/
-*
- IF(IFINIT.EQ.0) THEN
- IFINIT=1
- LVUNIT=1
- NDUNIT(1)=2
- ENDIF
-*
- IFERR=0
- IFQUI=0
- YES=YEAAAS
-*
- CHFILE='-'
- LBANK=0
- CHOPT='-'
-*
- 12 CONTINUE
-* _ save the next item's pointer
- JPK1=JPAK
- CALL TEXINS(LINE,JPAK,IFTX,PRFX,NUMB,FNUM)
- IFNX=MOD(IFTX,4)
- CALL CLTOU(PRFX)
-*
- IF(IFTX.LE.0) THEN
-* -- it is a call without parameters
-* -- show the parameters setting --
- CALL CDX_MESS('>>CDTEXT --- parameters --- <<')
- CALL UXIPARM(' ','LUnit',LVUNIT,NDUNIT(LVUNIT),0, 0,NDUNIT(1))
-* -- show the call format --
- CALL CDX_MESS('Call format:')
- CALL CDX_MESS('> CDTEXT [par/val] [-opt] [* or LBANK] [file]')
- IFQUI=99
-*
- ELSE IF(PRFX.EQ.'YES') THEN
-* -- it is a "YES" --
- YES='Y'
- CALL CDX_MESS('>>CDTEXT: "YES"')
-*
- ELSE IF(PRFX.EQ.'ASK') THEN
-* -- it is a "ASK" --
- YES='-'
- CALL CDX_MESS('>>CDTEXT: "ASK"')
-*
- ELSE IF(PRFX(1:1).EQ.'-') THEN
-* -- it is an option set
- CHOPT=PRFX
-*
- ELSE IF(PRFX.NE.' '.AND.IFNX.EQ.3) THEN
-* -- it seems to be a parameter set (not option)
-* LUNIT/n
-*
- CALL TEXINS(LINE,JPAK,IFTX,PRF,NUMB,FNUM)
- CALL CLTOU(PRF)
-*
- LVNEW=0
- IF(PRF.EQ.'=') LVNEW=1
-*
- IF (IFSHEQC(PRFX,'LU*NIT').GT.0) THEN
- CALL UXNEWIP('CDTEXT','LUnit',LVNEW,NUMB,LVUNIT,NDUNIT)
-*
- ELSE
-* -- signal an INVALID SET PARAMETER --
- CALL UXCPARM('CDTEXT',PRFX,0,' ',0,' ',' ')
- IFERR=1
- ENDIF
-*
- ELSE IF(IFTX/4.EQ.2) THEN
-* -- it is an alone integer: LBANK
- LBANK=NUMB
-*
- ELSE IF(PRFX(1:1).EQ.'*') THEN
-* -- it is a reference to a current DB record --
- IF(LDBRDA.GT.0) THEN
- LBANK=LDBRDA
- ELSE
- CALL CDX_MESS('>>CDTEXT: No link to DB record !!!')
- IFERR=1
- ENDIF
-*
- ELSE
-* -- otherwise it is a filename
-* -- get filename with previously saved pointers
- JPAK=JPK1
- CALL TEXSTR(LINE,JPAK,IFTX,CHFILE)
- IF(CHFILE.EQ.' ') CHFILE='-'
- LFILE=LNBLNK(CHFILE)
- ENDIF
-*
- IF(IFNX.GT.0.AND.IFQUI.EQ.0.AND.IFERR.EQ.0) GOTO 12
-*
- IF(IFQUI.LE.1.AND.IFERR.EQ.0) THEN
-* -- make a call -------------------
-* -- call parameters
- LUNIT=NDUNIT(LVUNIT)
- IF(CHOPT.EQ.'-') THEN
-* -- automatic option
- IF(LBANK.EQ.0) THEN
- CHOPT='R'
- ELSE IF(CHFILE.NE.'-') THEN
- CHOPT='W'
- ELSE
- CHOPT='P'
- ENDIF
- CALL CDX_MESS('>>CDTEXT Auto Option: "'//CHOPT(:1)//'"')
- ENDIF
- IF(CHOPT(1:1).EQ.'-') CHOPT=CHOPT(2:)
- LOPT=MAX0(LNBLNK(CHOPT),1)
-*
- IF(CHOPT.EQ.'P') YES='Y'
-*
- CALL ENCODI(LUNIT,1,CODE(:3),LR)
- MESL='>>CALL CDTEXT('//CODE(:3)//',CHFILE,"-",LBANK,"'
- + //CHOPT(:LOPT)//'",IRC)'
- CALL CDX_MESS(MESL(:LNBLNK(MESL)))
-*
- MESL=' '
- MESL(15:)='lun chfile="'//CHFILE(:LFILE)//'"'
- CALL CDX_MESS(MESL(:LNBLNK(MESL)))
-*
- IF(LBANK.GT.0.OR.INDEX(CHOPT,'R').LE.0) THEN
-* -- report initial LBANK value if given (or assumed)
- CALL ENCODI(LBANK,-1,CODE,LR)
- IF(LDBRDA.GT.0) CODE=CODE(:LR)//'<*'
- CALL CDX_MESS(' LBank='//CODE)
- ENDIF
-*
- IF(YES.NE.'Y') CALL CDX_ANSW('OK ? (y/n , <cr>=y )',YES)
- IF(YES.EQ.' ') YES='Y'
- CALL CLTOU(YES)
-*
- IF(YES.EQ.'Y') THEN
- IF(INDEX(CHOPT,'P').GT.0)
- + CALL CDX_MESS('>>....................................')
-*
- CALL CDTEXT(LUNIT,CHFILE,'-',LBANK,CHOPT,IRC)
-*
- IF(INDEX(CHOPT,'P').GT.0)
- + CALL CDX_MESS('>>....................................')
-*
- IF(INDEX(CHOPT,'R').GT.0) THEN
-* -- return and report final LBANK value if has to be so
- CALL ENCODI(LBANK,-1,CODE,LR)
- LDBRDA=LBANK
- CODE=CODE(:LR)//'>*'
- CALL CDX_MESS('==CDTEXT>> Text is read into LBANK='//CODE)
- ENDIF
-* -- report the Return Code --
- CALL UXIRCM('CDTEXT',IRC)
- IF((INDEX(CHOPT,'R').GT.0.OR.
- + INDEX(CHOPT,'W').GT.0).AND.
- + INDEX(CHOPT,'A').LE.0) THEN
- CALL ENCODI(LUNIT,-1,CODE(:3),LR)
- CALL CDX_MESS('==CDTEXT>> Auto Close LUN='//CODE(:3))
- CLOSE(LUNIT)
- ENDIF
- ELSE
- CALL CDX_MESS('>>CDTEXT not called (NOK)')
- ENDIF
- ELSE IF(IFERR.NE.0) THEN
-* -- error end --
- CALL CDX_MESS('>>CDTEXT not called (instruction error)')
- ENDIF
- END
diff --git a/src/packlib/hepdb/examples/dbexam/cdex/cxtime.F b/src/packlib/hepdb/examples/dbexam/cdex/cxtime.F
deleted file mode 100644
index 010776c..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdex/cxtime.F
+++ /dev/null
@@ -1,80 +0,0 @@
-*
-* $Id: cxtime.F,v 1.1.1.1 1996/02/28 16:23:41 mclareni Exp $
-*
-* $Log: cxtime.F,v $
-* Revision 1.1.1.1 1996/02/28 16:23:41 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CXTIME(CHNAM,LINE,JPAK,IFERR)
-* ----------------------------------=====-
- CHARACTER*(*) CHNAM , LINE
- INTEGER JPAK , IFERR
-*
- CHARACTER CHNM*6 , CHPU*1 , CHMS*1
-*
- INTEGER IFTX , IFNX
- CHARACTER PRFX*8
- INTEGER NUM1 , NUM2 , IPACK
- REAL FNUM
-*
- IFERR=0
- CHNM=CHNAM
- CALL TEXINS(LINE,JPAK,IFTX,PRFX,NUM1,FNUM)
- IF(IFTX/4.LE.0) THEN
- IF(CHNM.EQ.'CDTM') CALL CDX_MESS
- + ('Call formats:> CDTM yymmdd hhmm or:> CDTM pktime')
- IF(CHNM.EQ.'CDTS') CALL CDX_MESS
- + ('Call formats:> CDTS yymmdd hhmmss or:> CDTS pktime')
- IF(CHNM(6:6).EQ.'M') CALL CDX_MESS
- + ('Call formats:> CDPKTM yymmdd hhmm vv:> CDUPTM pktime')
- IF(CHNM(6:6).EQ.'S') CALL CDX_MESS
- + ('Call formats:> CDPKTS yymmdd hhmmss vv:> CDUPTS pktime')
-*...........and return.....
- RETURN
- ENDIF
- IF(CHNM.EQ.'CDTM'.OR.CHNM.EQ.'CDTS') THEN
- CHMS=CHNM(4:4)
- IF(MOD(IFTX,4).GT.0) THEN
- CHPU='P'
- CALL CDX_MESS('>>CDTM/CDTS pack mode')
- ELSE
- CHPU='U'
- CALL CDX_MESS('>>CDTM/CDTS unpack mode')
- ENDIF
- ELSE
- CHPU=CHNM(3:3)
- CHMS=CHNM(6:6)
- ENDIF
- CHNM='CD'//CHPU//'KT'//CHMS
- IF(CHPU.EQ.'U') CHNM(4:4)='P'
- IF(CHPU.EQ.'P') THEN
- CALL TEXINS(LINE,JPAK,IFTX,PRFX,NUM2,FNUM)
- CALL CDI_MESS('>>CALL '//CHNM//'(d=@@@@@@,.>',NUM1)
- IF(CHMS.EQ.'S') THEN
- CALL CDI_MESS('t=@@@@@@,IPACK,irc)',NUM2)
- CALL CDPKTS(NUM1,NUM2,IPACK,IRC)
- ELSE
- CALL CDI_MESS('t=@@@@,IPACK,irc)',NUM2)
- CALL CDPKTM(NUM1,NUM2,IPACK,IRC)
- ENDIF
- IF(IRC.NE.0) CALL UXIRCM(CHNM,IRC)
- CALL CDI_MESS('=='//CHNM//'>> pktime=0',IPACK)
- ELSE
- IPACK=NUM1
- CALL CDI_MESS('>>CALL '//CHNM//'(IDATE,ITIME,pkt=0,irc)',IPACK)
- IF(CHMS.EQ.'S') THEN
- CALL CDUPTS(NUM1,NUM2,IPACK,IRC)
- ELSE
- CALL CDUPTM(NUM1,NUM2,IPACK,IRC)
- ENDIF
- IF(IRC.NE.0) CALL UXIRCM(CHNM,IRC)
- CALL CDI_MESS('=='//CHNM//'>> date=@@@@@@,.>',NUM1)
- IF(CHMS.EQ.'S') CALL CDI_MESS(' time=@@@@@@',NUM2)
- IF(CHMS.EQ.'M') CALL CDI_MESS(' time=@@@@',NUM2)
- ENDIF
-*
- END
-
-
diff --git a/src/packlib/hepdb/examples/dbexam/cdex/dbread.F b/src/packlib/hepdb/examples/dbexam/cdex/dbread.F
deleted file mode 100644
index ff6d144..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdex/dbread.F
+++ /dev/null
@@ -1,129 +0,0 @@
-*
-* $Id: dbread.F,v 1.1.1.1 1996/02/28 16:23:41 mclareni Exp $
-*
-* $Log: dbread.F,v $
-* Revision 1.1.1.1 1996/02/28 16:23:41 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE DBREAD(LINE,JPAK,IFERR)
-* ---------------- ------****-====-
-* -- Author : Boris Khomenko 11/03/94
- IMPLICIT NONE
-*
- CHARACTER LINE*(*)
- INTEGER JPAK
-*
-#include "dbrinf.inc"
-CC* - - - - - -/DBRINF/- - - - - - - - - - - - - - - - - -
-CC* - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-*
-#include "yeaaas.inc"
-*
-* -- externals --
- INTEGER LNBLNK
- INTEGER IFSHEQC
-*
-* -- NO default/set parameters
-* for DBREAD --
-*
-* -- other parameters for DBREAD --
- CHARACTER CHFILE*60
- INTEGER LFILE
- CHARACTER CHPATH*40
- INTEGER LPATH
-* ----------------------------
-*
-* -- Command string analyse variables --
- INTEGER JPK1 , IFT1
- INTEGER IFTX , IFNX , LPRF
- CHARACTER PRFX*8 , PRF*8
- INTEGER NUMB
- REAL FNUM
-*
-* -- Local variables --
-*
- INTEGER IFERR , IFQUI
- CHARACTER YES*1
- CHARACTER CH*1
- CHARACTER MESL*78
- INTEGER JJ , LR , LL
-*
- IFERR=0
- IFQUI=0
- YES=YEAAAS
-*
- 12 CONTINUE
-* _ save the next item's pointer
- JPK1=JPAK
- CALL TEXINS(LINE,JPAK,IFTX,PRFX,NUMB,FNUM)
- IFNX=MOD(IFTX,4)
- CALL CLTOU(PRFX)
-*
- IF(IFTX.LE.0) THEN
-* -- it is a call without parameters
-* DBR status will be displayed
- CALL CDX_MESS('>>DBREAD --- status --- <<')
-* -- show the call format --
- CALL CDX_MESS('Call format:')
- CALL CDX_MESS('> DBREAD [Close] [File filename]')
- CALL CDX_MESS('> DBREAD [All Rec Line/n Skip/n Put]')
- IFQUI=99
-*
-CCC ELSE IF(PRFX(1:1).EQ.'-') THEN
-CCC -- it is an option --
-*
- ELSE IF(PRFX.EQ.'YES') THEN
-* -- it is a "YES" --
- YES='Y'
- CALL CDX_MESS('>>DBREAD: "YES"')
-*
- ELSE IF(PRFX.EQ.'ASK') THEN
-* -- it is a "ASK" --
- YES='-'
- CALL CDX_MESS('>>DBREAD: "ASK"')
-*
- ELSE IF(IFSHEQC(PRFX,'C*lose').GT.0) THEN
-* -- it is a file closing command --
- IF(LUDBRIN.GT.0) THEN
- MESL=
- + '>>DBREAD: closing LUN=000 "'//DBRIFIL(:LNBLNK(DBRIFIL))//'"'
- JJ=INDEX(MESL,'=')
- CALL ENCODI(LUDBRIN,-1,MESL(JJ+1:JJ+3),LR)
- CALL CDX_MESS(MESL(:LNBLNK(MESL)))
- CLOSE(LUDBRIN)
- LUDBRIN=0
- ELSE IF(DBRIFIL.NE.'-') THEN
- CALL CDX_MESS('>>DBREAD: already closed file "'
- + //DBRIFIL(:LNBLNK(DBRIFIL))//'"')
- ELSE
- CALL CDX_MESS('>>DBREAD: Nothing to close')
- ENDIF
-*
-*
- ELSE IF(IFSHEQC(PRFX,'F*ile').GT.0) THEN
-* -- it is a file definition --
-*
- CALL TEXSTR(LINE,JPAK,IFTX,CHFILE)
- IFNX=MOD(IFTX,4)
-*
- IF(CHFILE.NE.' ') THEN
- ELSE
- ENDIF
-*
- ELSE
-* -- signal an INVALID item --
- IFERR=1
- CALL CDX_MESS('>>DBREAD: Unrecognized item')
- ENDIF
- IF(IFNX.GT.0.AND.IFQUI.EQ.0.AND.IFERR.EQ.0) GOTO 12
-*
- IF(IFQUI.LE.1.AND.IFERR.EQ.0) THEN
-CCC CALL DBRSTAT(KDBR)
-*
- ELSE IF(IFERR.NE.0) THEN
-* -- error end --
- CALL CDX_MESS('>>DBREAD instruction error')
- ENDIF
- END
diff --git a/src/packlib/hepdb/examples/dbexam/cdex/dbrinf.inc b/src/packlib/hepdb/examples/dbexam/cdex/dbrinf.inc
deleted file mode 100644
index f362839..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdex/dbrinf.inc
+++ /dev/null
@@ -1,47 +0,0 @@
-*
-* $Id: dbrinf.inc,v 1.1.1.1 1996/02/28 16:23:38 mclareni Exp $
-*
-* $Log: dbrinf.inc,v $
-* Revision 1.1.1.1 1996/02/28 16:23:38 mclareni
-* Hepdb, cdlib, etc
-*
-*
-*
-* dbrinf.inc
-*
-* - - - - - -/DBRINF/- - - - - - - - - - - - - - - - - -
- COMMON /DBRTIT/ DBRTYPE,DBRPAKM,DBRPATH
- CHARACTER DBRTYPE*4,DBRPAKM*4,DBRPATH*40
-*
- COMMON /DBRKYS/ NDBRKY,NDBRPR,KEYDBR(20)
- INTEGER NDBRKY,NDBRPR,KEYDBR
-*
- COMMON /DBRLNK/ IDBRDIV,LDBRKY,LDBRDA
- INTEGER IDBRDIV,LDBRKY,LDBRDA
-*
- COMMON /DBRINP/ LUDBRIN,NLDBRIN,DBRIFIL
- INTEGER LUDBRIN,NLDBRIN
- CHARACTER*60 DBRIFIL
-* - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-c\* - - - - - -/DBRINF/- - - - - - - - - - - - - - - - - -
-c\ COMMON /DBRINP/ LUDBRIN,NLDBRIN,DBRIFIL
-c\ INTEGER LUDBRIN,NLDBRIN
-c\ CHARACTER*60 DBRIFIL
-c\*
-c\ COMMON /DBRINF/ IDBRTYP,IDBRMOD,LENGDBR,DBRTYPE,DBRPATH
-c\ INTEGER IDBRTYP,IDBRMOD,LENGDBR
-c\ CHARACTER DBRTYPE*4,DBRPATH*40
-c\*
-c\ COMMON /DBRTIT/ DBRTIT
-c\ CHARACTER DBRTIT*72
-c\*
-c\ COMMON /DBRBUF/ IDBFDV,LDBRBF
-c\ INTEGER IDBFDV,LDBRBF
-c\*
-c\ COMMON /DBRKYS/ NDBRKY,NDBRPR,KEYDBR(20),KINDBR(20),KMSDBR(20)
-c\ INTEGER NDBRKY,NDBRPR,KEYDBR,KINDBR,KMSDBR
-c\*
-c\ COMMON /DBRLNK/ LDBRKY,LDBRDA
-c\ INTEGER LDBRKY,LDBRDA
-c\* - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-*
diff --git a/src/packlib/hepdb/examples/dbexam/cdex/rzxchch.F b/src/packlib/hepdb/examples/dbexam/cdex/rzxchch.F
deleted file mode 100644
index b9dafc0..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdex/rzxchch.F
+++ /dev/null
@@ -1,164 +0,0 @@
-*
-* $Id: rzxchch.F,v 1.1.1.1 1996/02/28 16:23:40 mclareni Exp $
-*
-* $Log: rzxchch.F,v $
-* Revision 1.1.1.1 1996/02/28 16:23:40 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE RZXCHCH(FNAME,LINE,JPAK,IFERR)
-* -----------------------------****-
-* ************************************
-* * This is an interface to call *
-* * several RZ routiunes of the type *
-* * RZxxxx(CHDIR,CHOPT) *
-* * or RZxxxx(CHDIR) *
-* * -- Author : Boris Khomenko *
-* ************************************
-*
- IMPLICIT NONE
-*
- CHARACTER FNAME*(*)
- CHARACTER LINE*(*)
- INTEGER JPAK
-*
-* -- general definitions --
-***+CDE, QUEST. " common /quest/ iquest(100) "
- COMMON /QUEST/ IQUEST(100)
- INTEGER IQUEST
-*
-* -- externals --
- INTEGER JBYT , LNBLNK
-*
-* -- parameters for RZXXXX calls --
- CHARACTER FNAM*8
- CHARACTER CHDIR*40
- CHARACTER CHOPT*6
- INTEGER LNAM , LDIR , LOPT
- INTEGER IRC
-*
-* -- Command string analyse variables --
- INTEGER IFTX , IFNX , LPRF
- CHARACTER PRFX*8 , PRF*8
- INTEGER NUMB
- REAL FNUM
- INTEGER JPK1, JTX, JNM, JNX, JMX
-*
-* -- Local variables --
-*
- INTEGER IFERR , IFOKY , IFCON
- CHARACTER YES*1
- CHARACTER MESL*78
- INTEGER LMES
- INTEGER JJ , LR , LL
-*
- IFERR=0
- IFOKY=0
-*
- FNAM=FNAME
- LNAM=MAX0(LNBLNK(FNAM),6)
- CHDIR=' '
- CHOPT=' '
-*
-* -- take pointers (the DIR/PATH starts at JNX)
- CALL TEXUPJ(JPAK,JTX,JNM,JNX,JMX)
- IF(JNX.LE.JMX) THEN
- IFOKY=1
-* ------ get a directory (path) ------
- JJ=JNX+INDEX(LINE(JNX:JMX),' ')-1
- IF(JJ.LT.JNX) JJ=JMX
- CHDIR=LINE(JNX:JJ)
- LDIR=JJ-JNX+1
- CALL CLTOU(CHDIR(:LDIR))
-* -- change JPAK with new JNX
- JNX=JJ+1
- CALL TEXPKJ(JTX,JNM,JNX,JMX,JPAK)
-*
-* ------ get options ------
- CALL TEXINS(LINE,JPAK,IFTX,PRFX,NUMB,FNUM)
- CALL CLTOU(PRFX)
- ELSE
-* -- it is a call without parameters
- IFOKY=1
- IF (FNAM.EQ.'RZCDIR') THEN
- CHOPT='P'
- ELSE IF(FNAM.EQ.'RZNDIR') THEN
- CHOPT='P'
- ELSE IF(FNAM.EQ.'RZLDIR') THEN
- CHOPT='-'
- ELSE IF(FNAM.EQ.'RZCLOS') THEN
- IFOKY=-1
- ELSE IF(FNAM.EQ.'RZDELT') THEN
- IFOKY=-1
- ELSE IF(FNAM.EQ.'RZEND ') THEN
- IFOKY=-1
- ELSE
- IFOKY=-1
- CALL CDX_MESS('>>'//FNAM//' inside RZXCHCH ???')
- ENDIF
- ENDIF
-*
- IF(IFOKY.GE.0.AND.IFERR.EQ.0) THEN
-* -- confirmation flag
- IFCON=0
- IF (FNAM.EQ.'RZCDIR') THEN
- IF(INDEX(CHOPT,'-').GT.0) IFCON=1
- IF(INDEX(CHOPT,'U').GT.0) IFCON=1
- ELSE IF(FNAM.EQ.'RZNDIR') THEN
- IF(INDEX(CHOPT,'-').GT.0) IFCON=1
- ELSE IF(FNAM.EQ.'RZLDIR') THEN
-* (not at all)
- ELSE IF(FNAM.EQ.'RZCLOS') THEN
- IFCON=1
- ELSE IF(FNAM.EQ.'RZDELT') THEN
- IFCON=1
- CHOPT='#'
- ELSE IF(FNAM.EQ.'RZEND ') THEN
- IFCON=1
- CHOPT='#'
- ENDIF
-*
- LDIR=MAX0(LNBLNK(CHDIR),1)
- LOPT=MAX0(LNBLNK(CHOPT),1)
-*
- MESL='>> call '//FNAM//'("'//CHDIR(:LDIR)//'")'
- LMES=INDEX(MESL,')')
- IF(CHOPT(1:1).NE.'#') THEN
- MESL(LMES:)=',"'//CHOPT(:LOPT)//'")'
- LMES=INDEX(MESL,')')
- ENDIF
- CALL CDX_MESS(MESL(:LMES))
-*
- IF(IFCON.GT.0) THEN
- CALL CDX_ANSW('OK ? (y/n , <cr>=y )',YES)
- IF(YES.EQ.' ') YES='Y'
- CALL CLTOU(YES)
- IF(YES.EQ.'Y') CALL CDX_MESS('>>...... OK, do it')
- ELSE
- YES='Y'
- ENDIF
-*
- IF(YES.EQ.'Y') THEN
- IF(CHOPT.EQ.'-') CHOPT=' '
- IF (FNAM.EQ.'RZCDIR') THEN
- CALL RZCDIR(CHDIR,CHOPT)
- ELSE IF(FNAM.EQ.'RZNDIR') THEN
- CALL RZNDIR(CHDIR,CHOPT)
- ELSE IF(FNAM.EQ.'RZLDIR') THEN
- CALL RZLDIR(CHDIR,CHOPT)
- ELSE IF(FNAM.EQ.'RZCLOS') THEN
- CALL RZCLOS(CHDIR,CHOPT)
- ELSE IF(FNAM.EQ.'RZDELT') THEN
- CALL RZDELT(CHDIR)
- ELSE IF(FNAM.EQ.'RZEND ') THEN
- CALL RZEND (CHDIR)
- ENDIF
-* -- report the Return Code --
- IRC=IQUEST(1)
- IF(IRC.NE.0) CALL UXIRCM(FNAM(:LNAM),IRC)
- ELSE
- CALL CDX_MESS('>>'//FNAM(:LNAM)//' not called ')
- ENDIF
- ENDIF
- END
diff --git a/src/packlib/hepdb/examples/dbexam/cdex/rzxkeyb.inc b/src/packlib/hepdb/examples/dbexam/cdex/rzxkeyb.inc
deleted file mode 100644
index 9a92cd1..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdex/rzxkeyb.inc
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: rzxkeyb.inc,v 1.1.1.1 1996/02/28 16:23:40 mclareni Exp $
-*
-* $Log: rzxkeyb.inc,v $
-* Revision 1.1.1.1 1996/02/28 16:23:40 mclareni
-* Hepdb, cdlib, etc
-*
-*
-*
-* rzxkeyb.inc
-*
-*
-* - - - - - -/RZXKEYB/- - - - - - - - - - - - - - - - - -
- INTEGER MAXKEYB
- PARAMETER ( MAXKEYD=20 , MAXKEYB=200 )
- COMMON /RZXKEYB/ NRZKEYS, NRZKEYB, IRZKEYB(MAXKEYD,MAXKEYB)
- INTEGER NRZKEYD, NRZKEYB, IRZKEYB
-* - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-*
diff --git a/src/packlib/hepdb/examples/dbexam/cdex/rzxkeyd.inc b/src/packlib/hepdb/examples/dbexam/cdex/rzxkeyd.inc
deleted file mode 100644
index 9dff3fb..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdex/rzxkeyd.inc
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: rzxkeyd.inc,v 1.1.1.1 1996/02/28 16:23:40 mclareni Exp $
-*
-* $Log: rzxkeyd.inc,v $
-* Revision 1.1.1.1 1996/02/28 16:23:40 mclareni
-* Hepdb, cdlib, etc
-*
-*
-*
-* rzxkeyd.inc
-*
-*
-* - - - - - -/RZXKEYD/- - - - - - - - - - - - - - - - - -
- COMMON /RZXKEYD/ NRZKEYD, CKEYFRM, CKEYTAG(100)
- INTEGER NRZKEYD
- CHARACTER*8 CKEYFRM*100 , CKEYTAG*8
-* - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-*
diff --git a/src/packlib/hepdb/examples/dbexam/cdex/rzxseq.F b/src/packlib/hepdb/examples/dbexam/cdex/rzxseq.F
deleted file mode 100644
index 0961660..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdex/rzxseq.F
+++ /dev/null
@@ -1,9 +0,0 @@
-*
-* $Id: rzxseq.F,v 1.1.1.1 1996/02/28 16:23:40 mclareni Exp $
-*
-* $Log: rzxseq.F,v $
-* Revision 1.1.1.1 1996/02/28 16:23:40 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
diff --git a/src/packlib/hepdb/examples/dbexam/cdex/texpkj.F b/src/packlib/hepdb/examples/dbexam/cdex/texpkj.F
deleted file mode 100644
index b689908..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdex/texpkj.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: texpkj.F,v 1.1.1.1 1996/02/28 16:23:40 mclareni Exp $
-*
-* $Log: texpkj.F,v $
-* Revision 1.1.1.1 1996/02/28 16:23:40 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE TEXPKJ(JTX,JNM,JNX,JMX,JPAK)
-* ----------------------------------====-
-* -- Help-to-TEXINS : pack and unpack --
-* -- string pointers to/from JPAK --
-*
- IMPLICIT NONE
- INTEGER JTX,JNM,JNX,JMX,JPAK
-*
- JPAK=((JTX*200+JNM)*200+JNX)*200+JMX
- RETURN
-*
-*-- Author : Boris Khomenko 28/02/94
- ENTRY TEXUPJ(JPAK,JTX,JNM,JNX,JMX)
-* -----------------------===-===-===-===-
- JTX=MOD(JPAK/8000000,200)
- JNM=MOD(JPAK/ 40000,200)
- JNX=MOD(JPAK/ 200,200)
- JMX=MOD(JPAK ,200)
- END
diff --git a/src/packlib/hepdb/examples/dbexam/cdex/uxnewp.F b/src/packlib/hepdb/examples/dbexam/cdex/uxnewp.F
deleted file mode 100644
index 8f87394..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdex/uxnewp.F
+++ /dev/null
@@ -1,121 +0,0 @@
-*
-* $Id: uxnewp.F,v 1.1.1.1 1996/02/28 16:23:40 mclareni Exp $
-*
-* $Log: uxnewp.F,v $
-* Revision 1.1.1.1 1996/02/28 16:23:40 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE UXNEWIP(COMND,PNAME,LVNEW,IPNEW,LVPAR,IPARM)
-* -------------------------------------------*****-*****-
-* -- Author : Boris Khomenko 10/02/94
- IMPLICIT NONE
-*
-* -- arguments --
- CHARACTER*(*) COMND , PNAME
- INTEGER LVNEW , LVPAR
- INTEGER IPNEW , IPARM(2)
-*
-* -- local variables --
- INTEGER LOLD , IOLD
- INTEGER INEW
-*
- LOLD=LVPAR
- IOLD=IPARM(LOLD)
- IF(LVNEW.NE.0) THEN
-* -- use LVNEW#0 to choose & take value from IPARM(LVNEW) --
-* but if LVNEW=-1, force the changing of default value with IPNEW !
- LVPAR=IABS(LVNEW)
- IF(LVNEW.EQ.-1) THEN
- INEW=IPNEW
- IPARM(1)=INEW
- ELSE
- IF(LVPAR.NE.1) LVPAR=2
- INEW=IPARM(LVPAR)
- ENDIF
- ELSE
-* -- use IPNEW as a new value --
- LVPAR=2
- IF(IPNEW.EQ.IPARM(1)) LVPAR=1
- INEW=IPNEW
- IF(LVPAR.EQ.2) IPARM(LVPAR)=INEW
- ENDIF
- CALL UXIPARM(COMND,PNAME,LVPAR,IPARM(LVPAR),LOLD,IOLD,IPARM(1))
- END
-*
-*
- SUBROUTINE UXNEWRP(COMND,PNAME,LVNEW,RPNEW,LVPAR,RPARM)
-* -------------------------------------------*****-*****-
-* -- Author : Boris Khomenko 10/02/94
- IMPLICIT NONE
-*
-* -- arguments --
- CHARACTER*(*) COMND , PNAME
- INTEGER LVNEW , LVPAR
- REAL RPNEW , RPARM(2)
-*
-* -- local variables --
- INTEGER LOLD
- REAL ROLD , RNEW
-*
- LOLD=LVPAR
- ROLD=RPARM(LOLD)
- IF(LVNEW.NE.0) THEN
-* -- use LVNEW#0 to choose & take value from RPARM(LVNEW) --
-* but if LVNEW=-1, force the changing of default value with RPNEW !
- LVPAR=IABS(LVNEW)
- IF(LVNEW.EQ.-1) THEN
- RNEW=RPNEW
- RPARM(1)=RNEW
- ELSE
- IF(LVPAR.NE.1) LVPAR=2
- RNEW=RPARM(LVPAR)
- ENDIF
- ELSE
-* -- use RPNEW as a new value --
- LVPAR=2
- IF(RPNEW.EQ.RPARM(1)) LVPAR=1
- RNEW=RPNEW
- IF(LVPAR.EQ.2) RPARM(LVPAR)=RNEW
- ENDIF
- CALL UXRPARM(COMND,PNAME,LVPAR,RPARM(LVPAR),LOLD,ROLD,RPARM(1))
- END
-*
-*
- SUBROUTINE UXNEWCP(COMND,PNAME,LVNEW,CPNEW,LVPAR,CPARM)
-* -------------------------------------------*****-*****-
-* -- Author : Boris Khomenko 10/02/94
- IMPLICIT NONE
-*
-* -- arguments --
- CHARACTER*(*) COMND , PNAME
- INTEGER LVNEW , LVPAR
- CHARACTER*(*) CPNEW , CPARM(2)
-*
-* -- local variables --
- INTEGER LOLD
- CHARACTER*10 COLD , CNEW
-*
- LOLD=LVPAR
- COLD=CPARM(LOLD)
- IF(LVNEW.NE.0) THEN
-* -- use LVNEW#0 to choose & take value from CPARM(LVNEW) --
-* but if LVNEW=-1, force the changing of default value with CPNEW !
- LVPAR=IABS(LVNEW)
- IF(LVNEW.EQ.-1) THEN
- CNEW=CPNEW
- CPARM(1)=CNEW
- ELSE
- IF(LVPAR.NE.1) LVPAR=2
- CNEW=CPARM(LVPAR)
- ENDIF
- ELSE
-* -- use CPNEW as a new value --
- LVPAR=2
- IF(CPNEW.EQ.CPARM(1)) LVPAR=1
- CNEW=CPNEW
- IF(LVPAR.EQ.2) CPARM(LVPAR)=CNEW
- ENDIF
- CALL UXCPARM(COMND,PNAME,LVPAR,CPARM(LVPAR),LOLD,COLD,CPARM(1))
- END
diff --git a/src/packlib/hepdb/examples/dbexam/cdex/yeaaas.inc b/src/packlib/hepdb/examples/dbexam/cdex/yeaaas.inc
deleted file mode 100644
index 3a78951..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdex/yeaaas.inc
+++ /dev/null
@@ -1,15 +0,0 @@
-*
-* $Id: yeaaas.inc,v 1.1.1.1 1996/02/28 16:23:38 mclareni Exp $
-*
-* $Log: yeaaas.inc,v $
-* Revision 1.1.1.1 1996/02/28 16:23:38 mclareni
-* Hepdb, cdlib, etc
-*
-*
-*
-* yeaaas.inc
-*
-* - - - - - -/YEAAAS/ - - - - - - - - - - - - - - - - - -
- COMMON /YEAAAS/ YEAAAS
- CHARACTER YEAAAS*1
-* - - - - - - - - - - - - - - - - - - - - - - - - - - - -
diff --git a/src/packlib/hepdb/examples/dbexam/cdex/zquest.inc b/src/packlib/hepdb/examples/dbexam/cdex/zquest.inc
deleted file mode 100644
index 89b3d1b..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdex/zquest.inc
+++ /dev/null
@@ -1,15 +0,0 @@
-*
-* $Id: zquest.inc,v 1.1.1.1 1996/02/28 16:23:37 mclareni Exp $
-*
-* $Log: zquest.inc,v $
-* Revision 1.1.1.1 1996/02/28 16:23:37 mclareni
-* Hepdb, cdlib, etc
-*
-*
-*
-* zquest.inc
-*
-* - - - - - -/QUEST/- - - - - - - - - - - - - - - - - - -
- COMMON /QUEST/ IQUEST(100)
- INTEGER IQUEST
-* - - - - - - - - - - - - - - - - - - - - - - - - - - - -
diff --git a/src/packlib/hepdb/examples/dbexam/cdexam01/Imakefile b/src/packlib/hepdb/examples/dbexam/cdexam01/Imakefile
deleted file mode 100644
index 90ebd8b..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdexam01/Imakefile
+++ /dev/null
@@ -1,3 +0,0 @@
-SRCS_F= cdcrmd.F cdcrmu.F cdexam01.F cexam01.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/hepdb/examples/dbexam/cdexam01/cdcrmd.F b/src/packlib/hepdb/examples/dbexam/cdexam01/cdcrmd.F
deleted file mode 100644
index a816459..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdexam01/cdcrmd.F
+++ /dev/null
@@ -1,60 +0,0 @@
-*
-* $Id: cdcrmd.F,v 1.1.1.1 1996/02/28 16:23:44 mclareni Exp $
-*
-* $Log: cdcrmd.F,v $
-* Revision 1.1.1.1 1996/02/28 16:23:44 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDCRMD
-* =================
-*
-************************************************************************
-* *
-* SUBR. CDCRMD *
-* *
-* Creates the directory structure of the immitation data base *
-* *
-* Called by CEXAM01 *
-* *
-************************************************************************
-*
-#include "cuser1.inc"
- CHARACTER CHTAG(2)*8
- DATA CHTAG /'Us_key_1', 'Us_key_2'/
-*
-* ------------------------------------------------------------------
-*
- CALL TIMEX (TIMINT)
- CALL CDUVTX (IDAY, ITIM1)
-*
- IPREC = 3
- DELTA = 0.
- CALL CDMDIR ('//DBL3/MUCH/MCALB/UVDS', 1, 'I', CHTAG, 0,
- + IPREC, DELTA, 'C', IRC)
- IPREC = 0
- CALL CDMDIR ('//DBL3/MUCH/MCALB/ALIG/HRAS', 2, 'II', CHTAG, 0,
- + IPREC, DELTA, 'C', IRC)
- CALL CDMDIR ('//DBL3/MUCH/MCALB/ALIG/BEAC', 1, 'I', CHTAG, 0,
- + IPREC, DELTA, 'C', IRC)
- CALL CDMDIR ('//DBL3/MUCH/MPARS/BWIR', 0, 'I', CHTAG, 0,
- + IPREC, DELTA, 'C', IRC)
- CALL CDMDIR ('//DBL3/MUCH/MPARS/MGEOM/XBRI', 2, 'II', CHTAG, 0,
- + IPREC, DELTA, 'C', IRC)
- CALL CDMDIR ('//DBL3/MUCH/MPARS/MGEOM/YPCH/YAPL', 1, 'I', CHTAG,
- + 0, IPREC, DELTA, 'C', IRC)
- CALL CDMDIR ('//DBL3/MUCH/MPARS/MGEOM/YPCH/YBRI', 1, 'I', CHTAG,
- + 0, IPREC, DELTA, 'C', IRC)
-*
- CALL TIMEX (TIMNOW)
- TIME = TIMNOW - TIMINT
- CALL CDUVTX (IDAY, ITIM2)
- ITIME = ITIM2 - ITIM1
- WRITE (LPRTCU, 1001) IDAY, ITIM1, ITIM2, ITIME
- WRITE (LPRTCU, 1002) TIMINT, TIMNOW, TIME
-*
- 1001 FORMAT (/,' CDCRMD : IDAY/ITIM1/ITIM2/ITIME ', 4I12)
- 1002 FORMAT (/,' CDCRMD : TIMINT/TIMNOW/TIME ',4G12.4)
-* END CDCRMD
- END
diff --git a/src/packlib/hepdb/examples/dbexam/cdexam01/cdcrmu.F b/src/packlib/hepdb/examples/dbexam/cdexam01/cdcrmu.F
deleted file mode 100644
index 65842d5..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdexam01/cdcrmu.F
+++ /dev/null
@@ -1,260 +0,0 @@
-*
-* $Id: cdcrmu.F,v 1.1.1.1 1996/02/28 16:23:44 mclareni Exp $
-*
-* $Log: cdcrmu.F,v $
-* Revision 1.1.1.1 1996/02/28 16:23:44 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDCRMU (ITIMB)
-* =========================
-*
-************************************************************************
-* *
-* SUBR. CDCRMU (ITIMB) *
-* *
-* Creates the imitation of the Muon Chamber Data Base *
-* *
-* Arguments : *
-* *
-* ITIMB Start time of validity *
-* *
-* Called by CEXAM01 *
-* *
-************************************************************************
-*
-#include "cstor1.inc"
-#include "cuser1.inc"
- PARAMETER (NOFF1=10, NOFF2=12, NOFFP=6)
- DIMENSION KEYS(20)
- DATA IPROG /1/, XRANG / 1000.0/, XCENT / 500.0/
-* ------------------------------------------------------------------
-*
- CALL TIMEX (TIMINT)
- CALL CDUVTX (IDAY, ITIM1)
- CALL CDPKTS (991231, 235959, INFIN, IRC)
-*
-* *** -------- UVDS ----------------------
-*
- NKEY8 = 16
- NDAT = 48
- NKEYS = NOFF2 + 1
- CALL VZERO (KEYS, NKEYS)
- KEYS(NOFF1+1) = ITIMB
- KEYS(NOFF1+2) = INFIN
- KEYS(NOFFP) = IPROG
- DO 10 K = 1, NKEY8
- CALL MZBOOK (IDIVCU, LUSECU, LUSECU, 2, 'UVDS', 0, 0, NDAT, 3,0)
- KEYS(NOFF2+1) = K
- DO 5 I = 1, NDAT
- Q(LUSECU+I) = XRANG*RNDM(Q) - XCENT
- 5 CONTINUE
- CALL CDSTOR ('//DBL3/MUCH/MCALB/UVDS', LUSECU, LKUVCU(K),
- + IDIVCU, KEYS, 'CDP', IRC)
-#if !defined(CERNLIB__DEBUG)
- IF (LUSECU.NE.0 .AND. K.EQ.NKEY8)
-#endif
-#if defined(CERNLIB__DEBUG)
- IF (LUSECU.NE.0)
-#endif
- + CALL DZSHOW ('UVDS ', IDIVCU, LUSECU, 'B', 0, 0, 0, 0)
- CALL MZDROP (IDIVCU, LUSECU, ' ')
- 10 CONTINUE
-#if defined(CERNLIB__DEBUG)
- K = 1
-#endif
-#if !defined(CERNLIB__DEBUG)
- K = NKEY8
-#endif
- CALL DZSHOW ('LKUVCU ', IDIVCU, LKUVCU(K), 'BLV', 0, 0, 0, 0)
- CALL MZDROP (IDIVCU, LKUVCU(1), 'L')
- LKUVCU(1) = 0
-*
-* *** -------- HRAS ----------------------
-*
- NKEY8 = 16
- NKEY9 = 5
- NDAT = 21
- NKEYS = NOFF2 + 2
- CALL VZERO (KEYS, NKEYS)
- KEYS(NOFF1+1) = ITIMB
- KEYS(NOFF1+2) = INFIN
- KEYS(NOFFP) = IPROG
- DO 25 L = 1, NKEY9
- DO 20 K = 1, NKEY8
- CALL MZBOOK (IDIVCU, LUSECU, LUSECU, 2, 'HRAS', 0,0, NDAT,3,0)
- KEYS(NOFF2+1) = K
- KEYS(NOFF2+2) = L
- DO 15 I = 1, NDAT
- Q(LUSECU+I) = XRANG*RNDM(Q) - XCENT
- 15 CONTINUE
- CALL CDSTOR ('//DBL3/MUCH/MCALB/ALIG/HRAS', LUSECU, LKUVCU(1),
- + IDIVCU, KEYS, 'DP', IRC)
-#if !defined(CERNLIB__DEBUG)
- IF (LUSECU.NE.0 .AND. K.EQ.NKEY8)
-#endif
-#if defined(CERNLIB__DEBUG)
- IF (LUSECU.NE.0)
-#endif
- + CALL DZSHOW ('HRAS ', IDIVCU, LUSECU, 'B', 0, 0, 0, 0)
- CALL MZDROP (IDIVCU, LUSECU, ' ')
- 20 CONTINUE
- 25 CONTINUE
- IF (LKUVCU(1).NE.0) CALL MZDROP (IDIVCU, LKUVCU(1), 'L')
- LKUVCU(1) = 0
-*
-* *** -------- BEAC ----------------------
-*
- NKEY8 = 16
- NDAT = 67
- NKEYS = NOFF2 + 1
- CALL VZERO (KEYS, NKEYS)
- KEYS(NOFF1+1) = ITIMB
- KEYS(NOFF1+2) = INFIN
- KEYS(NOFFP) = IPROG
- DO 35 K = 1, NKEY8
- CALL MZBOOK (IDIVCU, LUSECU, LUSECU, 2, 'BEAC', 0, 0, NDAT, 3,0)
- KEYS(NOFF2+1) = K
- DO 30 I = 1, NDAT
- Q(LUSECU+I) = XRANG*RNDM(Q) - XCENT
- 30 CONTINUE
- CALL CDSTOR ('//DBL3/MUCH/MCALB/ALIG/BEAC', LUSECU, LKUVCU(1),
- + IDIVCU, KEYS, 'DP', IRC)
-#if !defined(CERNLIB__DEBUG)
- IF (LUSECU.NE.0 .AND. K.EQ.NKEY8)
-#endif
-#if defined(CERNLIB__DEBUG)
- IF (LUSECU.NE.0)
-#endif
- + CALL DZSHOW ('BEAC ', IDIVCU, LUSECU, 'B', 0, 0, 0, 0)
- CALL MZDROP (IDIVCU, LUSECU, ' ')
- 35 CONTINUE
- IF (LKUVCU(1).NE.0) CALL MZDROP (IDIVCU, LKUVCU(1), 'L')
- LKUVCU(1) = 0
-*
-* *** -------- BWIR ----------------------
-*
- NDAT = 100
- NKEYS = NOFF2
- CALL VZERO (KEYS, NKEYS)
- KEYS(NOFF1+1) = ITIMB
- KEYS(NOFF1+2) = INFIN
- KEYS(NOFFP) = IPROG
- CALL MZBOOK (IDIVCU, LUSECU, LUSECU, 2, 'BWIR', 0, 0, NDAT, 2, 0)
- DO 40 I = 1, NDAT/4
- J = 4*(I-1)
- IQ(LUSECU+J+1) = 12
- IQ(LUSECU+J+2) = 5
- IQ(LUSECU+J+3) = -1
- IQ(LUSECU+J+4) = 1000*RNDM(Q)
- 40 CONTINUE
- CALL CDSTOR ('//DBL3/MUCH/MPARS/BWIR', LUSECU, LKUVCU(1),
- + IDIVCU, KEYS, 'DP', IRC)
- CALL DZSHOW ('BWIR ', IDIVCU, LUSECU, 'B', 0, 0, 0, 0)
- CALL MZDROP (IDIVCU, LUSECU, ' ')
- IF (LKUVCU(1).NE.0) CALL MZDROP (IDIVCU, LKUVCU(1), 'L')
- LKUVCU(1) = 0
-*
-* *** -------- XBRI ----------------------
-*
- NKEY8 = 17
- NKEY9 = 5
- NDAT = 30
- NKEYS = NOFF2 + 2
- CALL VZERO (KEYS, NKEYS)
- KEYS(NOFF1+1) = ITIMB
- KEYS(NOFF1+2) = INFIN
- KEYS(NOFFP) = IPROG
- DO 55 L = 1, NKEY9
- DO 50 K = 1, NKEY8
- CALL MZBOOK (IDIVCU, LUSECU, LUSECU, 2, 'XBRI', 0,0, NDAT,3,0)
- KEYS(NOFF2+1) = K
- KEYS(NOFF2+2) = L
- DO 45 I = 1, NDAT
- Q(LUSECU+I) = XRANG*RNDM(Q) - XCENT
- 45 CONTINUE
- CALL CDSTOR ('//DBL3/MUCH/MPARS/MGEOM/XBRI', LUSECU,
- + LKUVCU(1), IDIVCU, KEYS, 'DP', IRC)
-#if !defined(CERNLIB__DEBUG)
- IF (LUSECU.NE.0 .AND. K.EQ.NKEY8)
-#endif
-#if defined(CERNLIB__DEBUG)
- IF (LUSECU.NE.0)
-#endif
- + CALL DZSHOW ('XBRI ', IDIVCU, LUSECU, 'B', 0, 0, 0, 0)
- CALL MZDROP (IDIVCU, LUSECU, ' ')
- 50 CONTINUE
- 55 CONTINUE
- IF (LKUVCU(1).NE.0) CALL MZDROP (IDIVCU, LKUVCU(1), 'L')
- LKUVCU(1) = 0
-*
-* *** -------- YAPL ----------------------
-*
- NKEY8 = 17
- NDAT = 67
- NKEYS = NOFF2 + 1
- CALL VZERO (KEYS, NKEYS)
- KEYS(NOFF1+1) = ITIMB
- KEYS(NOFF1+2) = INFIN
- KEYS(NOFFP) = IPROG
- DO 65 K = 1, NKEY8
- CALL MZBOOK (IDIVCU, LUSECU, LUSECU, 2, 'YAPL', 0, 0, NDAT, 3,0)
- KEYS(NOFF2+1) = K
- DO 60 I = 1, NDAT
- Q(LUSECU+I) = XRANG*RNDM(Q) - XCENT
- 60 CONTINUE
- CALL CDSTOR ('//DBL3/MUCH/MPARS/MGEOM/YPCH/YAPL', LUSECU,
- + LKUVCU(1), IDIVCU, KEYS, 'DP', IRC)
-#if !defined(CERNLIB__DEBUG)
- IF (LUSECU.NE.0 .AND. K.EQ.NKEY8)
-#endif
-#if defined(CERNLIB__DEBUG)
- IF (LUSECU.NE.0)
-#endif
- + CALL DZSHOW ('YAPL ', IDIVCU, LUSECU, 'B', 0, 0, 0, 0)
- CALL MZDROP (IDIVCU, LUSECU, ' ')
- 65 CONTINUE
- IF (LKUVCU(1).NE.0) CALL MZDROP (IDIVCU, LKUVCU(1), 'L')
- LKUVCU(1) = 0
-*
-* *** -------- YBRI ----------------------
-*
- NKEY8 = 17
- NDAT = 43
- NKEYS = NOFF2 + 1
- CALL VZERO (KEYS, NKEYS)
- KEYS(NOFF1+1) = ITIMB
- KEYS(NOFF1+2) = INFIN
- KEYS(NOFFP) = IPROG
- DO 75 K = 1, NKEY8
- CALL MZBOOK (IDIVCU, LUSECU, LUSECU, 2, 'YBRI', 0, 0, NDAT, 3,0)
- KEYS(NOFF2+1) = K
- DO 70 I = 1, NDAT
- Q(LUSECU+I) = XRANG*RNDM(Q) - XCENT
- 70 CONTINUE
- CALL CDSTOR ('//DBL3/MUCH/MPARS/MGEOM/YPCH/YBRI', LUSECU,
- + LKUVCU(1), IDIVCU, KEYS, 'DP', IRC)
-#if !defined(CERNLIB__DEBUG)
- IF (LUSECU.NE.0 .AND. K.EQ.NKEY8)
-#endif
-#if defined(CERNLIB__DEBUG)
- IF (LUSECU.NE.0)
-#endif
- + CALL DZSHOW ('YBRI ', IDIVCU, LUSECU, 'B', 0, 0, 0, 0)
- CALL MZDROP (IDIVCU, LUSECU, ' ')
- 75 CONTINUE
- IF (LKUVCU(1).NE.0) CALL MZDROP (IDIVCU, LKUVCU(1), 'L')
- LKUVCU(1) = 0
-*
- CALL TIMEX (TIMNOW)
- TIME = TIMNOW - TIMINT
- CALL CDUVTX (IDAY, ITIM2)
- ITIME = ITIM2 - ITIM1
- WRITE (LPRTCU, 1001) IDAY, ITIM1, ITIM2, ITIME
- WRITE (LPRTCU, 1002) TIMINT, TIMNOW, TIME
-*
- 1001 FORMAT (/,' CDCRMU : IDAY/ITIM1/ITIM2/ITIME ', 4I12)
- 1002 FORMAT (/,' CDCRMU : TIMINT/TIMNOW/TIME ',4G12.4)
-* END CDCRMU
- END
diff --git a/src/packlib/hepdb/examples/dbexam/cdexam01/cdexam01.F b/src/packlib/hepdb/examples/dbexam/cdexam01/cdexam01.F
deleted file mode 100644
index f0f258d..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdexam01/cdexam01.F
+++ /dev/null
@@ -1,9 +0,0 @@
-*
-* $Id: cdexam01.F,v 1.1.1.1 1996/02/28 16:23:43 mclareni Exp $
-*
-* $Log: cdexam01.F,v $
-* Revision 1.1.1.1 1996/02/28 16:23:43 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
diff --git a/src/packlib/hepdb/examples/dbexam/cdexam01/cexam01.F b/src/packlib/hepdb/examples/dbexam/cdexam01/cexam01.F
deleted file mode 100644
index 698d05a..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdexam01/cexam01.F
+++ /dev/null
@@ -1,106 +0,0 @@
-*
-* $Id: cexam01.F,v 1.1.1.1 1996/02/28 16:23:43 mclareni Exp $
-*
-* $Log: cexam01.F,v $
-* Revision 1.1.1.1 1996/02/28 16:23:43 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- PROGRAM CEXAM01
-* ===============
-*
-************************************************************************
-* *
-* PROG. CEXAM01 *
-* *
-* Program to create a fictitious database to test CDMDIR, CDSTOR *
-* *
-* The Data Base structure is an extraction from the Muon Chamber *
-* database as proposed by B.Adeva and E.Gonzalez in L3 Report No.496 *
-* *
-************************************************************************
-*
- PARAMETER (NLAST=150000, NDIV1=5000)
- COMMON /GCBANK/ FENCCS(22), LQ(NLAST)
-*
-#include "cuser1.inc"
- CHARACTER CFNM1*80, CFNM2*80
-*
-* ------------------------------------------------------------------
-*
- CALL MZEBRA(-1)
-*
-* *** Open the 1 and only 1 Store used in the reconstruction
-*
- CALL MZSTOR (ISTOCU, '/GCBANK/', ' ', FENCCS(1), LQ(1), LQ(1)
- + , LQ(1), LQ(NDIV1), LQ(NLAST))
-*
-* *** Open the RZ-file with an Open Statement (or JCL, etc)
-*
- LUNRZ = 1
- LUNFZ = 2
- LPRTCU = 6
- NREC = 1000
- LREC = 1024
- NBYTE = 4*LREC
- NBYTF = 80
-#if defined(CERNLIB_IBM)
- CFNM1 = 'DBMUON.DATA.A4'
- CFNM2 = 'DBMUFZ.DATA.A'
-#endif
-#if !defined(CERNLIB_IBM)
- CFNM1 = 'DBMUON.DAT'
- CFNM2 = 'DBMUFZ.DAT'
-#endif
- CALL CDROPN (LUNRZ, 'ZO', CFNM1, NBYTE, IOERR)
- IF (IOERR.NE.0) GO TO 999
- CALL CDSOPN (LUNFZ, 'AZO', CFNM2, NBYTF, IOERR)
- IF (IOERR.NE.0) GO TO 999
-*
-* *** Log-Level
-*
-#if !defined(CERNLIB__DEBUG)
- CALL MZLOGL (ISTOCU, 0)
-#endif
-#if defined(CERNLIB__DEBUG)
- CALL MZLOGL (ISTOCU, 1)
-#endif
-*
-* *** Define user division and link area like:
-*
- CALL MZDIV (ISTOCU, IDIVCU, 'DB-USERS', 50000, 100000, 'L')
- CALL MZLINK (ISTOCU, '/CUSER1/', LDUVCU(1), LUSECU, LDUVCU(1))
-*
-* *** Initialize DB-Package
-*
- CALL TIMEST (999999.)
- NPAIR = 1
- LUFZ = 0
- NTOP = 0
- CALL CDINIT (IDIVCU, LUNRZ, LUFZ, 'DBL3', NPAIR, NREC, NTOP,
- + 'UZ', IRC)
-#if !defined(CERNLIB__DEBUG)
- CALL CDLOGL ('DBL3', 0, ' ', IRC)
-#endif
-#if defined(CERNLIB__DEBUG)
- CALL CDLOGL ('DBL3', 2, ' ', IRC)
-#endif
- CALL CDFZOP (LUNFZ, 'DBL3', ' ', IRC)
-*
-* *** Create the Muon Data Base
-*
- CALL CDCRMD
- IDATX = 800101
- DO 10 I = 1, 3
- CALL CDPKTS (IDATX, 0, ISTRV, IRC)
- CALL CDCRMU (ISTRV)
- IDATX = IDATX + 10000
- 10 CONTINUE
-*
-* *** Close Data Base
-*
- CALL FZENDO (LUNFZ, 'T')
- CALL CDEND ('*', 'A', IRC)
-* END CEXAM01
- 999 END
diff --git a/src/packlib/hepdb/examples/dbexam/cdexam01/cstor1.inc b/src/packlib/hepdb/examples/dbexam/cdexam01/cstor1.inc
deleted file mode 100644
index 5d80a01..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdexam01/cstor1.inc
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: cstor1.inc,v 1.1.1.1 1996/02/28 16:23:43 mclareni Exp $
-*
-* $Log: cstor1.inc,v $
-* Revision 1.1.1.1 1996/02/28 16:23:43 mclareni
-* Hepdb, cdlib, etc
-*
-*
-*
-* cstor1.inc
-*
- COMMON /GCBANK/ FENCCS(22), LQ(9)
- DIMENSION IQ(2), Q(2)
- EQUIVALENCE (IQ(1),Q(1),LQ(9))
-*
- COMMON /QUEST/ IQUEST(100)
-*
diff --git a/src/packlib/hepdb/examples/dbexam/cdexam01/cuser1.inc b/src/packlib/hepdb/examples/dbexam/cdexam01/cuser1.inc
deleted file mode 100644
index e1cf009..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdexam01/cuser1.inc
+++ /dev/null
@@ -1,14 +0,0 @@
-*
-* $Id: cuser1.inc,v 1.1.1.1 1996/02/28 16:23:43 mclareni Exp $
-*
-* $Log: cuser1.inc,v $
-* Revision 1.1.1.1 1996/02/28 16:23:43 mclareni
-* Hepdb, cdlib, etc
-*
-*
-*
-* cuser1.inc
-*
- COMMON /CUSER1/ IDIVCU, ISTOCU, LPRTCU, LDUVCU(16), LKUVCU(16)
- + , LUSECU
-*
diff --git a/src/packlib/hepdb/examples/dbexam/cdexam02/Imakefile b/src/packlib/hepdb/examples/dbexam/cdexam02/Imakefile
deleted file mode 100644
index b4f23c3..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdexam02/Imakefile
+++ /dev/null
@@ -1,3 +0,0 @@
-SRCS_F= cdexam02.F cdinmu.F cdonmu.F cexam02.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/hepdb/examples/dbexam/cdexam02/cdexam02.F b/src/packlib/hepdb/examples/dbexam/cdexam02/cdexam02.F
deleted file mode 100644
index 37ad4bf..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdexam02/cdexam02.F
+++ /dev/null
@@ -1,9 +0,0 @@
-*
-* $Id: cdexam02.F,v 1.1.1.1 1996/02/28 16:23:44 mclareni Exp $
-*
-* $Log: cdexam02.F,v $
-* Revision 1.1.1.1 1996/02/28 16:23:44 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
diff --git a/src/packlib/hepdb/examples/dbexam/cdexam02/cdinmu.F b/src/packlib/hepdb/examples/dbexam/cdexam02/cdinmu.F
deleted file mode 100644
index a7b9288..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdexam02/cdinmu.F
+++ /dev/null
@@ -1,124 +0,0 @@
-*
-* $Id: cdinmu.F,v 1.1.1.1 1996/02/28 16:23:45 mclareni Exp $
-*
-* $Log: cdinmu.F,v $
-* Revision 1.1.1.1 1996/02/28 16:23:45 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDINMU
-* =================
-*
-************************************************************************
-* *
-* SUBR. CDINMU *
-* *
-* Initializes DBUSE on the imitation of the Muon Data Base *
-* *
-* Called by CEXAM02 *
-* *
-************************************************************************
-*
-#include "cstor2.inc"
-#include "cuser2.inc"
-#include "cvser2.inc"
- PARAMETER (NOFF2=12, NOFFP=6)
- DIMENSION KEYS(100), MASK(100)
-*
-* ------------------------------------------------------------------
-*
- CALL TIMEX (TIMINT)
- CALL CDUVTX (IDAY, ITIM1)
- ITIME = 0
-*
-* *** -------------- UVDS ---------------------
-*
- CALL VZERO (MASK, 100)
- CALL VZERO (KEYS, 100)
- MASK(NOFF2+1) = 1
- KEYS(NOFF2+1) = 16
- DO 5 I = 1, KEYS(NOFF2+1)
- KEYS(NOFF2+1+I) = I
- 5 CONTINUE
- CALL CDUSEDB ('//DBL3/MUCH/MCALB/UVDS', LKUVCU(1), ITIME,
- + MASK, KEYS, 'M', IRC)
- CALL CDUSEDB ('//DVL3/MUCH/MCALB/UVDS', LKUVCV(1), ITIME,
- + MASK, KEYS, 'M', IRC)
-#if defined(CERNLIB__DEBUG)
- IF (LKUVCU(1).NE.0)
- + CALL DZSHOW ('UVDS ', IDIVCU, LKUVCU(1), 'L', 0, 0, 0, 0)
- IF (LKUVCV(1).NE.0)
- + CALL DZSHOW ('UVDS ', IDIVCU, LKUVCV(1), 'L', 0, 0, 0, 0)
-#endif
-*
-* *** -------------- HRAS ---------------------
-*
- CALL VZERO (MASK, 100)
- CALL VZERO (KEYS, 100)
- MASK(NOFF2+1) = 1
- MASK(NOFF2+2) = 1
- KEYS(NOFF2+1) = 16
- KEYS(NOFF2+2) = 5
- DO 10 I = 1, KEYS(NOFF2+1)
- KEYS(NOFF2+2+I) = I
- 10 CONTINUE
- IS = NOFF2 + 2 + KEYS(NOFF2+1)
- DO 20 I = 1, KEYS(NOFF2+2)
- KEYS(IS+I) = I
- 20 CONTINUE
- CALL CDUSEDB ('//DBL3/MUCH/MCALB/ALIG/HRAS', LKHRCU(1,1),
- + ITIME, MASK, KEYS, 'M', IRC)
- CALL CDUSEDB ('//DVL3/MUCH/MCALB/ALIG/HRAS', LKHRCV(1,1),
- + ITIME, MASK, KEYS, 'M', IRC)
-#if defined(CERNLIB__DEBUG)
- IF (LKHRCU(1,1).NE.0)
- + CALL DZSHOW ('HRAS ', IDIVCU, LKHRCU(1,1), 'L', 0, 0, 0, 0)
- IF (LKHRCV(1,1).NE.0)
- + CALL DZSHOW ('HRAS ', IDIVCU, LKHRCV(1,1), 'L', 0, 0, 0, 0)
-#endif
-*
-* *** -------------- BWIR ---------------------
-*
- CALL CDUSE ('//DBL3/MUCH/MPARS/BWIR', LKBWCU, ITIME, ' ', IRC)
- CALL CDUSE ('//DVL3/MUCH/MPARS/BWIR', LKBWCV, ITIME, ' ', IRC)
-#if defined(CERNLIB__DEBUG)
- IF (LKBWCU.NE.0)
- + CALL DZSHOW ('BWIR ', IDIVCU, LKBWCU, 'B', 0, 0, 0, 0)
- IF (LKBWCV.NE.0)
- + CALL DZSHOW ('BWIR ', IDIVCU, LKBWCV, 'B', 0, 0, 0, 0)
-#endif
-*
-* *** -------------- YBRI ---------------------
-*
- CALL VZERO (MASK, 100)
- CALL VZERO (KEYS, 100)
- MASK(NOFF2+1) = 1
- MASK(NOFFP) = 1
- KEYS(NOFFP) = 1
- KEYS(NOFF2+1) = 17
- DO 30 I = 1, KEYS(NOFF2+1)
- KEYS(NOFF2+1+I) = I
- 30 CONTINUE
- CALL CDUSEDB ('//DBL3/MUCH/MPARS/MGEOM/YPCH/YBRI', LKYBCU(1),
- + ITIME, MASK, KEYS, 'M', IRC)
- CALL CDUSEDB ('//DVL3/MUCH/MPARS/MGEOM/YPCH/YBRI', LKYBCV(1),
- + ITIME, MASK, KEYS, 'M', IRC)
-#if defined(CERNLIB__DEBUG)
- IF (LKYBCU(1).NE.0)
- + CALL DZSHOW ('YBRI ', IDIVCU, LKYBCU(1), 'L', 0, 0, 0, 0)
- IF (LKYBCV(1).NE.0)
- + CALL DZSHOW ('YBRI ', IDIVCU, LKYBCV(1), 'L', 0, 0, 0, 0)
-#endif
-*
- CALL TIMEX (TIMNOW)
- TIME = TIMNOW - TIMINT
- CALL CDUVTX (IDAY, ITIM2)
- ITIME = ITIM2 - ITIM1
- WRITE (LPRTCU, 1001) IDAY, ITIM1, ITIM2, ITIME
- WRITE (LPRTCU, 1002) TIMINT, TIMNOW, TIME
-*
- 1001 FORMAT (/,' CDINMU : IDAY/ITIM1/ITIM2/ITIME ', 4I12)
- 1002 FORMAT (/,' CDINMU : TIMINT/TIMNOW/TIME ',4G12.4)
-* END CDINMU
- END
diff --git a/src/packlib/hepdb/examples/dbexam/cdexam02/cdonmu.F b/src/packlib/hepdb/examples/dbexam/cdexam02/cdonmu.F
deleted file mode 100644
index 9ac591e..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdexam02/cdonmu.F
+++ /dev/null
@@ -1,217 +0,0 @@
-*
-* $Id: cdonmu.F,v 1.1.1.1 1996/02/28 16:23:45 mclareni Exp $
-*
-* $Log: cdonmu.F,v $
-* Revision 1.1.1.1 1996/02/28 16:23:45 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDONMU (ITIME)
-* =========================
-*
-************************************************************************
-* *
-* SUBR. CDONMU (ITIME) *
-* *
-* Tests CDUSEDB on the imitation of the Muon Data Base *
-* *
-* Arguments : *
-* *
-* ITIME Validity time *
-* *
-* Called by CEXAM02 *
-* *
-************************************************************************
-*
-#include "cstor2.inc"
-#include "cuser2.inc"
-#include "cvser2.inc"
- PARAMETER (NOFF2=12, NOFFP=6)
- DIMENSION KEYS(100), MASK(100)
- CHARACTER CHOPT*4
-*
-* ------------------------------------------------------------------
-*
- CALL TIMEX (TIMINT)
- CALL CDUVTX (IDAY, ITIM1)
-*
-* *** -------------- UVDS ---------------------
-*
- CALL VZERO (MASK, 100)
- CALL VZERO (KEYS, 100)
- MASK(NOFF2+1) = 1
- KEYS(NOFF2+1) = 16
- DO 5 I = 1, KEYS(NOFF2+1)
- KEYS(NOFF2+1+I) = I
- 5 CONTINUE
- CHOPT = 'AM'
- CALL CDUSEDB ('//DBL3/MUCH/MCALB/UVDS', LKUVCU(1), ITIME, MASK,
- + KEYS, CHOPT, IRC)
- CALL CDUSEDB ('//DVL3/MUCH/MCALB/UVDS', LKUVCV(1), ITIME, MASK,
- + KEYS, CHOPT, IRC)
- DO 10 I = 1, KEYS(NOFF2+1)
- IF (LKUVCU(I).GT.0) THEN
- LDUVCU(I) = LQ(LKUVCU(I)-1)
- ELSE
- LDUVCU(I) = 0
- ENDIF
-#if !defined(CERNLIB__DEBUG)
- IF (LDUVCU(I).NE.0.AND.I.EQ.KEYS(NOFF2+1))
-#endif
-#if defined(CERNLIB__DEBUG)
- IF (LDUVCU(I).NE.0)
-#endif
- + CALL DZSHOW ('UVDS ', IDIVCU, LDUVCU(I), 'V', 0, 0, 0, 0)
- IF (LKUVCV(I).GT.0) THEN
- LDUVCV(I) = LQ(LKUVCV(I)-1)
- ELSE
- LDUVCV(I) = 0
- ENDIF
-#if !defined(CERNLIB__DEBUG)
- IF (LDUVCV(I).NE.0.AND.I.EQ.KEYS(NOFF2+1))
-#endif
-#if defined(CERNLIB__DEBUG)
- IF (LDUVCV(I).NE.0)
-#endif
- + CALL DZSHOW ('UVDS ', IDIVCU, LDUVCV(I), 'V', 0, 0, 0, 0)
- 10 CONTINUE
- CALL CDFREE ('//DBL3/MUCH/MCALB/UVDS', LKUVCU, MASK, KEYS, CHOPT,
- + IRC)
- CALL CDFREE ('//DVL3/MUCH/MCALB/UVDS', LKUVCV, MASK, KEYS, CHOPT,
- + IRC)
-*
-* *** -------------- HRAS ---------------------
-*
- CALL VZERO (MASK, 100)
- CALL VZERO (KEYS, 100)
- MASK(NOFF2+1) = 1
- MASK(NOFF2+2) = 1
- KEYS(NOFF2+1) = 16
- KEYS(NOFF2+2) = 5
- DO 15 I = 1, KEYS(NOFF2+1)
- KEYS(NOFF2+2+I) = I
- 15 CONTINUE
- IS = NOFF2 + 2 + KEYS(NOFF2+1)
- DO 20 I = 1, KEYS(NOFF2+2)
- KEYS(IS+I) = I
- 20 CONTINUE
- CHOPT = 'AM'
- CALL CDUSEDB ('//DBL3/MUCH/MCALB/ALIG/HRAS', LKHRCU(1,1), ITIME,
- + MASK, KEYS, CHOPT, IRC)
- CALL CDUSEDB ('//DVL3/MUCH/MCALB/ALIG/HRAS', LKHRCV(1,1), ITIME,
- + MASK, KEYS, CHOPT, IRC)
- DO 30 J = 1, KEYS(NOFF2+2)
- DO 25 I = 1, KEYS(NOFF2+1)
- IF (LKHRCU(I,J).GT.0) THEN
- LDHRCU(I,J) = LQ(LKHRCU(I,J)-1)
- ELSE
- LDHRCU(I,J) = 0
- ENDIF
-#if !defined(CERNLIB__DEBUG)
- IF (LDHRCU(I,J).NE.0.AND.I.EQ.KEYS(NOFF2+1))
-#endif
-#if defined(CERNLIB__DEBUG)
- IF (LDHRCU(I,J).NE.0)
-#endif
- + CALL DZSHOW ('HRAS ', IDIVCU, LDHRCU(I,J), 'V', 0,0, 0,0)
- IF (LKHRCV(I,J).GT.0) THEN
- LDHRCV(I,J) = LQ(LKHRCV(I,J)-1)
- ELSE
- LDHRCV(I,J) = 0
- ENDIF
-#if !defined(CERNLIB__DEBUG)
- IF (LDHRCV(I,J).NE.0.AND.I.EQ.KEYS(NOFF2+1))
-#endif
-#if defined(CERNLIB__DEBUG)
- IF (LDHRCV(I,J).NE.0)
-#endif
- + CALL DZSHOW ('HRAS ', IDIVCU, LDHRCV(I,J), 'V', 0,0, 0,0)
- 25 CONTINUE
- 30 CONTINUE
- CALL CDFREE ('//DBL3/MUCH/MCALB/ALIG/HRAS', LKHRCU, MASK, KEYS,
- + CHOPT, IRC)
- CALL CDFREE ('//DVL3/MUCH/MCALB/ALIG/HRAS', LKHRCV, MASK, KEYS,
- + CHOPT, IRC)
-*
-* *** -------------- BWIR ---------------------
-*
- CHOPT = 'AV'
- CALL VZERO (MASK, 100)
- CALL CDUSE ('//DBL3/MUCH/MPARS/BWIR', LKBWCU, ITIME, CHOPT, IRC)
- CALL CDUSE ('//DVL3/MUCH/MPARS/BWIR', LKBWCV, ITIME, CHOPT, IRC)
- IF (LKBWCU.GT.0) THEN
- LDBWCU = LQ(LKBWCU-1)
- CALL DZSHOW ('BWIR ', IDIVCU, LDBWCU, 'V', 0, 0, 0, 0)
- ENDIF
- IF (LKBWCV.GT.0) THEN
- LDBWCV = LQ(LKBWCV-1)
- CALL DZSHOW ('BWIR ', IDIVCU, LDBWCV, 'V', 0, 0, 0, 0)
- ENDIF
- CALL CDFREE ('//DBL3/MUCH/MPARS/BWIR', LKBWCU, MASK, KEYS,
- + CHOPT, IRC)
- CALL CDFREE ('//DVL3/MUCH/MPARS/BWIR', LKBWCV, MASK, KEYS,
- + CHOPT, IRC)
-*
-* *** -------------- YBRI ---------------------
-*
- CALL VZERO (MASK, 100)
- CALL VZERO (KEYS, 100)
- MASK(NOFF2+1) = 1
- MASK(NOFFP) = 1
- KEYS(NOFFP) = 1
- KEYS(NOFF2+1) = 17
- DO 35 I = 1, KEYS(NOFF2+1)
- KEYS(NOFF2+1+I) = I
- 35 CONTINUE
- CHOPT = 'AM'
- CALL CDUSEDB ('//DBL3/MUCH/MPARS/MGEOM/YPCH/YBRI', LKYBCU(1),
- + ITIME, MASK, KEYS, CHOPT, IRC)
- CALL CDUSEDB ('//DVL3/MUCH/MPARS/MGEOM/YPCH/YBRI', LKYBCV(1),
- + ITIME, MASK, KEYS, CHOPT, IRC)
- DO 40 I = 1, KEYS(NOFF2+1)
- IF (LKYBCU(I).GT.0) THEN
- LDYBCU(I) = LQ(LKYBCU(I)-1)
- ELSE
- LDYBCU(I) = 0
- ENDIF
-#if !defined(CERNLIB__DEBUG)
- IF (LDYBCU(I).NE.0.AND.I.EQ.KEYS(NOFF2+1))
-#endif
-#if defined(CERNLIB__DEBUG)
- IF (LDYBCU(I).NE.0)
-#endif
- + CALL DZSHOW ('YBRI ', IDIVCU, LDYBCU(I), 'V', 0, 0, 0, 0)
- IF (LKYBCV(I).GT.0) THEN
- LDYBCV(I) = LQ(LKYBCV(I)-1)
- ELSE
- LDYBCV(I) = 0
- ENDIF
-#if !defined(CERNLIB__DEBUG)
- IF (LDYBCV(I).NE.0.AND.I.EQ.KEYS(NOFF2+1))
-#endif
-#if defined(CERNLIB__DEBUG)
- IF (LDYBCV(I).NE.0)
-#endif
- + CALL DZSHOW ('YBRI ', IDIVCU, LDYBCV(I), 'V', 0, 0, 0, 0)
- 40 CONTINUE
- CALL CDFREE ('//DBL3/MUCH/MPARS/MGEOM/YPCH/YBRI', LKYBCU, MASK,
- + KEYS, CHOPT, IRC)
- CALL CDFREE ('//DVL3/MUCH/MPARS/MGEOM/YPCH/YBRI', LKYBCV, MASK,
- + KEYS, CHOPT, IRC)
-#if defined(CERNLIB__DEBUG)
-*
- CALL DZSNAP ('MEMORY MAP OF MUON DATABASE', IDIVCU, 'LM')
-#endif
-*
- CALL TIMEX (TIMNOW)
- TIME = TIMNOW - TIMINT
- CALL CDUVTX (IDAY, ITIM2)
- ITIME = ITIM2 - ITIM1
- WRITE (LPRTCU, 1001) IDAY, ITIM1, ITIM2, ITIME
- WRITE (LPRTCU, 1002) TIMINT, TIMNOW, TIME
-*
- 1001 FORMAT (/,' CDONMU : IDAY/ITIM1/ITIM2/ITIME ', 4I12)
- 1002 FORMAT (/,' CDONMU : TIMINT/TIMNOW/TIME ',4G12.4)
-* END CDONMU
- END
diff --git a/src/packlib/hepdb/examples/dbexam/cdexam02/cexam02.F b/src/packlib/hepdb/examples/dbexam/cdexam02/cexam02.F
deleted file mode 100644
index 8c192d0..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdexam02/cexam02.F
+++ /dev/null
@@ -1,166 +0,0 @@
-*
-* $Id: cexam02.F,v 1.1.1.1 1996/02/28 16:23:44 mclareni Exp $
-*
-* $Log: cexam02.F,v $
-* Revision 1.1.1.1 1996/02/28 16:23:44 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- PROGRAM CEXAM02
-* ===============
-*
-************************************************************************
-* *
-* PROG. CEXAM02 *
-* *
-* Program to debug DBUSE on a fictitious Data Base. It can also *
-* debug the routines CDPRIN, CDPURG and CDSTAT. *
-* *
-* The Data Base structure is an extraction from the Muon Chamber *
-* database as proposed by B.Adeva and E.Gonzalez in L3 Report No.496 *
-* *
-************************************************************************
-*
- PARAMETER (NLAST=150000, NDIV1=5000)
- COMMON /GCBANK/ FENCCS(22), LQ(NLAST)
-#include "cuser2.inc"
-#include "cvser2.inc"
- PARAMETER (NOFF2=12)
- CHARACTER CHOPT*8, CFNM1*80, CFNM2*80, CFNM3*80
-*
-* ------------------------------------------------------------------
-*
- CALL MZEBRA (-1)
-*
-* *** Open the 1 and only 1 Store used in the reconstruction
-*
- CALL MZSTOR (ISTOCU, '/GCBANK/', ' ', FENCCS(1), LQ(1), LQ(1)
- + , LQ(1), LQ(NDIV1), LQ(NLAST))
-*
-* *** Open the RZ-file with an Open Statement (or JCL, etc)
-*
- LUNRZ = 1
- LUNFZ = 2
- LU2RZ = 3
- LPRTCU = 6
- NREC = 1000
- LREC = 1024
- NBYTE = 4*LREC
- NBYTF = 80
-#if defined(CERNLIB_IBM)
- CFNM1 = 'DBMUON.DATA.A4'
- CFNM2 = 'DBMUFZ.DATA.A'
- CFNM3 = 'DBMUOM.DATA.A4'
-#endif
-#if !defined(CERNLIB_IBM)
- CFNM1 = 'DBMUON.DAT'
- CFNM2 = 'DBMUFZ.DAT'
- CFNM3 = 'DBMUOM.DAT'
-#endif
- CALL CDROPN (LUNRZ, ' ', CFNM1, NBYTE, IOERR)
- IF (IOERR.NE.0) GO TO 999
- CALL CDROPN (LU2RZ, 'ZO', CFNM3, NBYTE, IOERR)
- IF (IOERR.NE.0) GO TO 999
- CALL CDSOPN (LUNFZ, 'AI', CFNM2, NBYTF, IOERR)
- IF (IOERR.NE.0) GO TO 999
-*
-* *** Log-Level
-*
-#if !defined(CERNLIB__DEBUG)
- CALL MZLOGL (ISTOCU, 0)
-#endif
-#if defined(CERNLIB__DEBUG)
- CALL MZLOGL (ISTOCU, 1)
-#endif
-*
-* *** Define user division and link area like:
-*
- CALL MZDIV (ISTOCU, IDIVCU, 'DB-USERS', 20000, 30000, 'L')
- CALL MZLINK (ISTOCU, '/CUSER2/', LKUVCU(1), LDYBCU(17), LKUVCU(1))
- CALL MZLINK (ISTOCU, '/CVSER2/', LKUVCV(1), LDYBCV(17), LKUVCV(1))
-*
-* *** Initialize DB-Package
-*
- CALL TIMEST (999999.)
- NPAIR = 1
- LUFZ = 0
- NTOP1 = 0
- NTOP2 = 0
- CALL CDINIT (IDIVCU, LU2RZ, LUFZ, 'DBL3', NPAIR, NREC, NTOP1,
- + 'UZ', IRC)
- CALL CDINIT (IDIVCU, LUNRZ, LUFZ, 'DVL3', NPAIR, NREC, NTOP2,
- + ' ', IRC)
-#if !defined(CERNLIB__DEBUG)
- CALL CDLOGL ('DBL3', 0, ' ', IRC)
- CALL CDLOGL ('DVL3', 0, ' ', IRC)
-#endif
-#if defined(CERNLIB__DEBUG)
- CALL CDLOGL ('DBL3', 2, ' ', IRC)
- CALL CDLOGL ('DVL3', 2, ' ', IRC)
- CALL DZSTOR ('DBSTORE', ISTOCU)
- CALL DZAREA ('DB-LINKS', ISTOCU, ' ', 0, ' ')
-#endif
-*
-* *** Retrieve the data base from the journal file
-*
- CALL TIMEX (TIMINT)
- CALL CDUVTX (IDAY, ITIM1)
- CALL CDFZUP (LUNFZ, ' ', IRC)
- CALL FZENDI (LUNFZ, 'T')
-*
- CALL TIMEX (TIMNOW)
- TIME = TIMNOW - TIMINT
- CALL CDUVTX (IDAY, ITIM2)
- ITIME = ITIM2 - ITIM1
- WRITE (LPRTCU, 1001) IDAY, ITIM1, ITIM2, ITIME
- WRITE (LPRTCU, 1002) TIMINT, TIMNOW, TIME
-*
-* *** Initialize the Muon Data Base structure
-*
- CALL CDINMU
-*
-* *** Read the Muon Data Base
-*
- IDATX = 800601
- DO 10 I = 1, 3
- CALL CDPKTS (IDATX, 120000, ITIME, IRC)
- CALL CDONMU (ITIME)
- IDATX = IDATX + 10000
- 10 CONTINUE
-*
-* *** Test subroutine CDPRIN
-*
-#if !defined(CERNLIB__DEBUG)
- CHOPT = 'K'
-#endif
-#if defined(CERNLIB__DEBUG)
- CHOPT = 'D'
-#endif
- CALL CDPRIN ('//DBL3/MUCH/MCALB/UVDS', CHOPT, IRC)
- CALL CDPRIN ('//DVL3/MUCH/MCALB/UVDS', CHOPT, IRC)
-*
-* *** Test subroutine DBPURG
-*
- KYDAT = NOFF2 + 1
- CALL CDPURG ('//DBL3/MUCH/MCALB/UVDS', KYDAT, 10, 'K', IRC)
- CALL CDPRIN ('//DBL3/MUCH/MCALB/UVDS', CHOPT, IRC)
-*
-* *** Print out the summary of usage
-*
- CALL CDSTAT (LPRTCU, IRC)
-*
-* *** Test subroutine DBDELT
-*
- CALL RZSTAT ('//DBL3', 20, ' ')
- CALL CDDDIR ('//DBL3/MUCH/MPARS/MGEOM', ' ', IRC)
- CALL RZSTAT ('//DBL3', 20, ' ')
-*
-* *** Close DataBase
-*
- CALL CDEND ('*', 'A', IRC)
-*
- 1001 FORMAT (/,' CEXAM02 : IDAY/ITIM1/ITIM2/ITIME ', 4I12)
- 1002 FORMAT (/,' CEXAM02 : TIMINT/TIMNOW/TIME ',4G12.4)
-* END CEXAM02
- 999 END
diff --git a/src/packlib/hepdb/examples/dbexam/cdexam02/cstor2.inc b/src/packlib/hepdb/examples/dbexam/cdexam02/cstor2.inc
deleted file mode 100644
index 341533d..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdexam02/cstor2.inc
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: cstor2.inc,v 1.1.1.1 1996/02/28 16:23:44 mclareni Exp $
-*
-* $Log: cstor2.inc,v $
-* Revision 1.1.1.1 1996/02/28 16:23:44 mclareni
-* Hepdb, cdlib, etc
-*
-*
-*
-* cstor2.inc
-*
- COMMON /GCBANK/ FENCCS(22), LQ(9)
- DIMENSION IQ(2), Q(2)
- EQUIVALENCE (IQ(1),Q(1),LQ(9))
-*
- COMMON /QUEST/ IQUEST(100)
-*
diff --git a/src/packlib/hepdb/examples/dbexam/cdexam02/cuser2.inc b/src/packlib/hepdb/examples/dbexam/cdexam02/cuser2.inc
deleted file mode 100644
index 98eb0f1..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdexam02/cuser2.inc
+++ /dev/null
@@ -1,15 +0,0 @@
-*
-* $Id: cuser2.inc,v 1.1.1.1 1996/02/28 16:23:44 mclareni Exp $
-*
-* $Log: cuser2.inc,v $
-* Revision 1.1.1.1 1996/02/28 16:23:44 mclareni
-* Hepdb, cdlib, etc
-*
-*
-*
-* cuser2.inc
-*
- COMMON /CUSER2/ IDIVCU, ISTOCU, LPRTCU, LKUVCU(16), LDUVCU(16)
- + , LKBWCU, LDBWCU, LKHRCU(16,5), LDHRCU(16,5)
- + , LKYBCU(17), LDYBCU(17)
-*
diff --git a/src/packlib/hepdb/examples/dbexam/cdexam02/cvser2.inc b/src/packlib/hepdb/examples/dbexam/cdexam02/cvser2.inc
deleted file mode 100644
index 7311c68..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdexam02/cvser2.inc
+++ /dev/null
@@ -1,14 +0,0 @@
-*
-* $Id: cvser2.inc,v 1.1.1.1 1996/02/28 16:23:44 mclareni Exp $
-*
-* $Log: cvser2.inc,v $
-* Revision 1.1.1.1 1996/02/28 16:23:44 mclareni
-* Hepdb, cdlib, etc
-*
-*
-*
-* cvser2.inc
-*
- COMMON /CVSER2/ LKUVCV(16), LDUVCV(16), LKBWCV, LDBWCV
- + , LKHRCV(16,5), LDHRCV(16,5), LKYBCV(17), LDYBCV(17)
-*
diff --git a/src/packlib/hepdb/examples/dbexam/cdexam03/Imakefile b/src/packlib/hepdb/examples/dbexam/cdexam03/Imakefile
deleted file mode 100644
index ae693b2..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdexam03/Imakefile
+++ /dev/null
@@ -1,3 +0,0 @@
-SRCS_F= cdcrfd.F cdcrfk.F cdexam03.F cexam03.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/hepdb/examples/dbexam/cdexam03/cdcrfd.F b/src/packlib/hepdb/examples/dbexam/cdexam03/cdcrfd.F
deleted file mode 100644
index e78e02a..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdexam03/cdcrfd.F
+++ /dev/null
@@ -1,45 +0,0 @@
-*
-* $Id: cdcrfd.F,v 1.1.1.1 1996/02/28 16:23:45 mclareni Exp $
-*
-* $Log: cdcrfd.F,v $
-* Revision 1.1.1.1 1996/02/28 16:23:45 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDCRFD
-* =================
-*
-************************************************************************
-* *
-* SUBR. CDCRFD *
-* *
-* Creates a the directory structure of a fictitious data base *
-* *
-* Called by CEXAM03 *
-* *
-************************************************************************
-*
- CHARACTER CRATF*50, CRATT(50)*8
- DATA NKEX /50/
- DATA CRATF/'IIIHHHHHHHHHHHHHHHHHHHHBBBBBBBBBBBBBBBBBBBBIIIIIII'/
- DATA CRATT/'UINTEG01','UINTEG02','UINTEG03',
- + 'UHOLL_01','UHOLL_02','UHOLL_03','UHOLL_04','UHOLL_05',
- + 'UHOLL_06','UHOLL_07','UHOLL_08','UHOLL_09','UHOLL_10',
- + 'UHOLL_11','UHOLL_12','UHOLL_13','UHOLL_44','UHOLL_15',
- + 'UHOLL_16','UHOLL_17','UHOLL_18','UHOLL_19','UHOLL_20',
- + 'UBINR_01','UBINR_02','UBINR_03','UBINR_04','UBINR_05',
- + 'UBINR_06','UBINR_07','UBINR_08','UBINR_09','UBINR_10',
- + 'UBINR_11','UBINR_12','UBINR_13','UBINR_44','UBINR_15',
- + 'UBINR_16','UBINR_17','UBINR_18','UBINR_19','UBINR_20',
- + 'UINTEG04','UINTEG05','UINTEG06','UINTEG07','UINTEG08',
- + 'UINTEG09','UINTEG10'/
-*
-* ------------------------------------------------------------------
-*
- IPREC = 0
- DELTA = 0.
- CALL CDMDIR ('//DBL3/FAKE/CRATES', NKEX, CRATF, CRATT, 0,
- + IPREC, DELTA, 'C', IRC)
-* END CDCRFD
- END
diff --git a/src/packlib/hepdb/examples/dbexam/cdexam03/cdcrfk.F b/src/packlib/hepdb/examples/dbexam/cdexam03/cdcrfk.F
deleted file mode 100644
index 837525e..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdexam03/cdcrfk.F
+++ /dev/null
@@ -1,149 +0,0 @@
-*
-* $Id: cdcrfk.F,v 1.1.1.1 1996/02/28 16:23:46 mclareni Exp $
-*
-* $Log: cdcrfk.F,v $
-* Revision 1.1.1.1 1996/02/28 16:23:46 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDCRFK (ITIM0)
-* =========================
-*
-************************************************************************
-* *
-* SUBR. CDCRFK (ITIM0) *
-* *
-* Creates a complete fictitious Data Base to accommodate 50 user keys*
-* *
-* Arguments : *
-* *
-* ITIM1 Start time of validity *
-* *
-* Called by CEXAM03 *
-* *
-************************************************************************
-*
-#include "cstor3.inc"
-#include "cuser3.inc"
- PARAMETER (NOFF1=10, NOFF2=12, NOFFP=6, NKEX=NOFF2+50)
- DIMENSION KEYX(NKEX), K(500,2), P(500,5)
- INTEGER BITS(20)
- CHARACTER CHOPT*8, CRATE(20)*4
- DATA IPROG /1/, XRANG / 1000.0/, XCENT / 500.0/
- DATA CRATE /'CR01','CR02','CR03','CR04','CR05',
- + 'CR06','CR07','CR08','CR09','CR10',
- + 'CR11','CR12','CR13','CR14','CR15',
- + 'CR16','CR17','CR18','CR19','CR20'/
-#if defined(CERNLIB_APOLLO)
- DATA BITS /16#0001, 16#0008, 16#0040, 16#0200, 16#1000,
- + 16#0001, 16#0009, 16#0041, 16#0201, 16#1001,
- + 16#0001, 16#0009, 16#0049, 16#0209, 16#1009,
- + 16#0001, 16#0009, 16#0049, 16#0249, 16#1049/
-#endif
-#if defined(CERNLIB_CRAY)
- DATA BITS /X'0001', X'0008', X'0040', X'0200', X'1000',
- + X'0001', X'0009', X'0041', X'0201', X'1001',
- + X'0001', X'0009', X'0049', X'0209', X'1009',
- + X'0001', X'0009', X'0049', X'0249', X'1049'/
-#endif
-#if defined(CERNLIB_IBM)
- DATA BITS /Z0001, Z0008, Z0040, Z0200, Z1000,
- + Z0001, Z0009, Z0041, Z0201, Z1001,
- + Z0001, Z0009, Z0049, Z0209, Z1009,
- + Z0001, Z0009, Z0049, Z0249, Z1049/
-#endif
-#if (!defined(CERNLIB_APOLLO))&&(!defined(CERNLIB_CRAY))&&(!defined(CERNLIB_IBM))
- DATA BITS /'0001'X, '0008'X, '0040'X, '0200'X, '1000'X,
- + '0001'X, '0009'X, '0041'X, '0201'X, '1001'X,
- + '0001'X, '0009'X, '0049'X, '0209'X, '1009'X,
- + '0001'X, '0009'X, '0049'X, '0249'X, '1049'X/
-#endif
-*
-* ------------------------------------------------------------------
-*
- CALL TIMEX (TIMINT)
- CALL CDUVTX (IDAY, ITIM1)
-*
-* *** Prepare the keys for the structure
-*
- CALL CDPKTS (991231, 235000, INFIN, IRC)
- CALL VZERO (KEYX, NKEX)
- KEYX(NOFF1+1) = ITIM0
- KEYX(NOFF1+2) = INFIN
- KEYX(NOFFP) = IPROG
- DO 10 I = NOFF2+1, NOFF2+3
- KEYX(I) = 50000*RNDM(I)
- 10 CONTINUE
- DO 15 I = NOFF2+4, NOFF2+23
- CALL UCTOH (CRATE(I-NOFF2-3), KEYX(I), 4, 4)
- 15 CONTINUE
- CALL UCOPY (BITS(1), KEYX(NOFF2+24), 20)
- DO 20 I = NOFF2+44, NKEX
- KEYX(I) = 50000*RNDM(I)
- 20 CONTINUE
-*
-* *** Create Data to store with DBOUT 'R' Option - most general I/O
-* *** (Example is taken from the Generators)
-*
- N = 25
- NDAT = 2 + 5 + 7*N
- CALL MZFORM ('CRAT', '1I 3F 1I -S', IOCRA)
- CALL MZBOOK (IDIVCU, LUSECU, LUSECU, 2, 'CRAT', 0,0,NDAT, IOCRA,0)
-*
- IE = 10001
- DO 35 I = 1, N
- DO 25 J = 1, 2
- K(I,J) = (J-1)*25 + I
- 25 CONTINUE
- DO 30 J = 1, 5
- P(I,J) = (J-1)*250. + I*0.1
- 30 CONTINUE
- 35 CONTINUE
- L = LUSECU
- IQ(L+1) = IE
- Q(L+2) = 0.
- Q(L+3) = 0.
- Q(L+4) = 0.
- IQ(L+5) = N
- L = L + 5
- IQ(L+1) = 16*N*2 + 2
- L = L + 1
- DO 40 I = 1, N
- IQ(L+1) = K(I,1)
- IQ(L+2) = K(I,2)
- L = L + 2
- 40 CONTINUE
- IQ(L+1) = 16*N*5 + 3
- L = L + 1
- DO 50 I = 1, N
- DO 45 J = 1, 5
- Q(L+J) = P(I,J)
- 45 CONTINUE
- L = L + 5
- 50 CONTINUE
-*
- CHOPT = 'CDY'
- CALL CDSTOR ('//DBL3/FAKE/CRATES', LUSECU, LKTRCU(1), IDIVCU,
- + KEYX, CHOPT, IRC)
- IF (LUSECU.NE.0) THEN
- CALL DZSHOW ('CRAT ', IDIVCU, LUSECU, 'B', 0, 0, 0, 0)
- CALL MZDROP (IDIVCU, LUSECU, ' ')
- ENDIF
- CALL UOPTC (CHOPT, 'C', IOPTC)
- IF (IOPTC.NE.0) THEN
- CALL DZSHOW ('LKTRCU ', IDIVCU, LKTRCU(1), 'LVB', 0, 0, 0, 0)
- CALL MZDROP (IDIVCU, LKTRCU(1), 'L')
- ENDIF
-*
- CALL TIMEX (TIMNOW)
- TIME = TIMNOW - TIMINT
- CALL CDUVTX (IDAY, ITIM2)
- ITIME = ITIM2 - ITIM1
- WRITE (LPRTCU, 1001) IDAY, ITIM1, ITIM2, ITIME
- WRITE (LPRTCU, 1002) TIMINT, TIMNOW, TIME
-*
- 1001 FORMAT (/,' CDCRFK : IDAY/ITIM1/ITIM2/ITIME ', 4I12)
- 1002 FORMAT (/,' CDCRFK : TIMINT/TIMNOW/TIME ',4G12.4)
-* END CDCRFK
- END
diff --git a/src/packlib/hepdb/examples/dbexam/cdexam03/cdexam03.F b/src/packlib/hepdb/examples/dbexam/cdexam03/cdexam03.F
deleted file mode 100644
index fc4b889..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdexam03/cdexam03.F
+++ /dev/null
@@ -1,9 +0,0 @@
-*
-* $Id: cdexam03.F,v 1.1.1.1 1996/02/28 16:23:45 mclareni Exp $
-*
-* $Log: cdexam03.F,v $
-* Revision 1.1.1.1 1996/02/28 16:23:45 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
diff --git a/src/packlib/hepdb/examples/dbexam/cdexam03/cexam03.F b/src/packlib/hepdb/examples/dbexam/cdexam03/cexam03.F
deleted file mode 100644
index 31b2373..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdexam03/cexam03.F
+++ /dev/null
@@ -1,96 +0,0 @@
-*
-* $Id: cexam03.F,v 1.1.1.1 1996/02/28 16:23:45 mclareni Exp $
-*
-* $Log: cexam03.F,v $
-* Revision 1.1.1.1 1996/02/28 16:23:45 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- PROGRAM CEXAM03
-* ===============
-*
-************************************************************************
-* *
-* PROG. CEXAM03 *
-* *
-* Program to create a fictitious Data Base to test the Package *
-* including CDSTOR, CDMDIR *
-* *
-* The Data Base structure is completely arbitary *
-* *
-************************************************************************
-*
- PARAMETER (NLAST=150000, NDIV1=5000)
- COMMON /GCBANK/ FENCCS(22), LQ(NLAST)
-*
-#include "cuser3.inc"
- CHARACTER CFNM1*80
-* ------------------------------------------------------------------
-*
-* *** Open the RZ-file with an Open Statement (or JCL, etc)
-*
- LUNRZ = 1
- LPRTCU = 6
- NREC = 1000
- LREC = 1024
- NBYTE = 4*LREC
-#if defined(CERNLIB_IBM)
- CFNM1 = 'DBFAKE.DATA.A4'
-#endif
-#if !defined(CERNLIB_IBM)
- CFNM1 = 'DBFAKE.DAT'
-#endif
- CALL CDROPN (LUNRZ, 'ZO', CFNM1, NBYTE, IOERR)
- IF (IOERR.NE.0) GO TO 999
- CALL MZEBRA (-1)
-*
-* *** Open the 1 and only 1 Store used in the reconstruction
-*
- CALL MZSTOR (ISTOCU, '/GCBANK/', ' ', FENCCS(1), LQ(1), LQ(1)
- + , LQ(1), LQ(NDIV1), LQ(NLAST))
-*
-* *** Log-Level
-*
-#if !defined(CERNLIB__DEBUG)
- CALL MZLOGL (ISTOCU, 0)
-#endif
-#if defined(CERNLIB__DEBUG)
- CALL MZLOGL (ISTOCU, 1)
-#endif
-*
-* *** Define user division and link area like:
-*
- CALL MZDIV (ISTOCU, IDIVCU, 'DB-USERS', 50000, 100000, 'L')
- CALL MZLINK (ISTOCU, '/CUSER3/', LKTRCU(1), LUSECU, LKTRCU(1))
-*
-* *** Initialize DB-Package
-*
- CALL TIMEST (999999.)
- NPAIR = 1
- LUFZ = 0
- NTOP = 0
- CALL CDINIT (IDIVCU, LUNRZ, LUFZ, 'DBL3', NPAIR, NREC, NTOP,
- + 'UZ', IRC)
-#if !defined(CERNLIB__DEBUG)
- CALL CDLOGL ('DBL3', 0, ' ', IRC)
-#endif
-#if defined(CERNLIB__DEBUG)
- CALL CDLOGL ('DBL3', 2, ' ', IRC)
-#endif
-*
-* *** Create the Fake Data Base
-*
- CALL CDCRFD
- IDATX = 800101
- DO 10 I = 1, 3
- CALL CDPKTS (IDATX, 0, ISTRV, IRC)
- CALL CDCRFK (ISTRV)
- IDATX = IDATX + 10000
- 10 CONTINUE
-*
-* *** Close Data Base
-*
- CALL CDEND ('*', 'A', IRC)
-* END CEXAM03
- 999 END
diff --git a/src/packlib/hepdb/examples/dbexam/cdexam03/cstor3.inc b/src/packlib/hepdb/examples/dbexam/cdexam03/cstor3.inc
deleted file mode 100644
index 19068a5..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdexam03/cstor3.inc
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: cstor3.inc,v 1.1.1.1 1996/02/28 16:23:45 mclareni Exp $
-*
-* $Log: cstor3.inc,v $
-* Revision 1.1.1.1 1996/02/28 16:23:45 mclareni
-* Hepdb, cdlib, etc
-*
-*
-*
-* cstor3.inc
-*
- COMMON /GCBANK/ FENCCS(22), LQ(9)
- DIMENSION IQ(2), Q(2)
- EQUIVALENCE (IQ(1),Q(1),LQ(9))
-*
- COMMON /QUEST/ IQUEST(100)
-*
diff --git a/src/packlib/hepdb/examples/dbexam/cdexam03/cuser3.inc b/src/packlib/hepdb/examples/dbexam/cdexam03/cuser3.inc
deleted file mode 100644
index 25b4a8b..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdexam03/cuser3.inc
+++ /dev/null
@@ -1,14 +0,0 @@
-*
-* $Id: cuser3.inc,v 1.1.1.1 1996/02/28 16:23:45 mclareni Exp $
-*
-* $Log: cuser3.inc,v $
-* Revision 1.1.1.1 1996/02/28 16:23:45 mclareni
-* Hepdb, cdlib, etc
-*
-*
-*
-* cuser3.inc
-*
- COMMON /CUSER3/ IDIVCU, ISTOCU, LPRTCU, LKTRCU(5), LDTRCU(5)
- + , LUSECU
-*
diff --git a/src/packlib/hepdb/examples/dbexam/cdexam04/Imakefile b/src/packlib/hepdb/examples/dbexam/cdexam04/Imakefile
deleted file mode 100644
index af50216..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdexam04/Imakefile
+++ /dev/null
@@ -1,3 +0,0 @@
-SRCS_F= cdexam04.F cdonfk.F cexam04.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/hepdb/examples/dbexam/cdexam04/cdexam04.F b/src/packlib/hepdb/examples/dbexam/cdexam04/cdexam04.F
deleted file mode 100644
index 1c9a93d..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdexam04/cdexam04.F
+++ /dev/null
@@ -1,9 +0,0 @@
-*
-* $Id: cdexam04.F,v 1.1.1.1 1996/02/28 16:23:46 mclareni Exp $
-*
-* $Log: cdexam04.F,v $
-* Revision 1.1.1.1 1996/02/28 16:23:46 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
diff --git a/src/packlib/hepdb/examples/dbexam/cdexam04/cdonfk.F b/src/packlib/hepdb/examples/dbexam/cdexam04/cdonfk.F
deleted file mode 100644
index 7d563d7..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdexam04/cdonfk.F
+++ /dev/null
@@ -1,68 +0,0 @@
-*
-* $Id: cdonfk.F,v 1.1.1.1 1996/02/28 16:23:46 mclareni Exp $
-*
-* $Log: cdonfk.F,v $
-* Revision 1.1.1.1 1996/02/28 16:23:46 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDONFK
-* =================
-*
-************************************************************************
-* *
-* SUBR. CDONFK *
-* *
-* Tests CDUSEM with option 'S' and for 50 user keys *
-* *
-* Called by CEXAM04 *
-* *
-************************************************************************
-*
-#include "cstor4.inc"
-#include "cuser4.inc"
- PARAMETER (NOFF2=12)
- DIMENSION KEYS(100), MASK(100)
- CHARACTER CHOPT*8
-*
-* ------------------------------------------------------------------
-*
- CALL TIMEX (TIMINT)
- CALL CDUVTX (IDAY, ITIM1)
- CALL VZERO (MASK, 100)
- CALL VZERO (KEYS, 100)
- CALL UCTOH ('CR05', KEYS(NOFF2+8), 4, 4)
- MASK(NOFF2+8) = 1
- CALL CDPKTS (830101, 90000, ITIME, IRC)
- CHOPT = 'SK'
-*
-* *** -------------- CRATES ---------------------
-*
- CALL CDUSEM ('//DBL3/FAKE/CRATES', LKTRCU(1), ITIME, MASK, KEYS,
- + CHOPT, IRC)
-*
-* *** Print linear structure
-*
- CALL DZSHOW ('LKTRCU ', IDIVCU, LKTRCU(1), 'LVB', 0, 0, 0, 0)
-*
-* *** Test subroutine CDPRIN
-*
- CALL CDPRIN ('//DBL3/FAKE/CRATES', 'K', IRC)
-#if defined(CERNLIB__DEBUG)
- CALL CDPRIN ('//DBL3/FAKE/CRATES', 'D', IRC)
-#endif
- CALL CDFREE ('//DBL3/FAKE/CRATES', LKTRCU(1), MASK, KEYS, CHOPT,
- + IRC)
-*
- CALL TIMEX (TIMNOW)
- TIME = TIMNOW - TIMINT
- CALL CDUVTX (IDAY, ITIM2)
- ITIME = ITIM2 - ITIM1
- WRITE (LPRTCU, 1001) IDAY, ITIM1, ITIM2, ITIME
- WRITE (LPRTCU, 1002) TIMINT, TIMNOW, TIME
-*
- 1001 FORMAT (/,' CDONFK : IDAY/ITIM1/ITIM2/ITIME ', 4I12)
- 1002 FORMAT (/,' CDONFK : TIMINT/TIMNOW/TIME ',4G12.4)
-* END CDONFK
- END
diff --git a/src/packlib/hepdb/examples/dbexam/cdexam04/cexam04.F b/src/packlib/hepdb/examples/dbexam/cdexam04/cexam04.F
deleted file mode 100644
index ed98386..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdexam04/cexam04.F
+++ /dev/null
@@ -1,87 +0,0 @@
-*
-* $Id: cexam04.F,v 1.1.1.1 1996/02/28 16:23:46 mclareni Exp $
-*
-* $Log: cexam04.F,v $
-* Revision 1.1.1.1 1996/02/28 16:23:46 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- PROGRAM CEXAM04
-* ===============
-*
-************************************************************************
-* *
-* PROG. CEXAM04 *
-* *
-* Program to debug CDUSEM on a fictitious Data Base *
-* *
-* Program is used to test option 'S' in CDUSEM for 50 user keys *
-* *
-************************************************************************
-*
- PARAMETER (NLAST=150000, NDIV1=5000)
- COMMON /GCBANK/ FENCCS(22), LQ(NLAST)
-*
-#include "cuser4.inc"
-* ------------------------------------------------------------------
-*
-* *** Open the RZ-file with an Open Statement (or JCL, etc)
-*
- LUNRZ = 1
- LPRTCU = 6
- LREC = 1024
- NREC = 0
- NBYTE = 4*LREC
-#if defined(CERNLIB_IBM)
- CALL CDROPN (LUNRZ, ' ', 'DBFAKE.DATA.A4', NBYTE, IOERR)
-#endif
-#if !defined(CERNLIB_IBM)
- CALL CDROPN (LUNRZ, ' ', 'DBFAKE.DAT', NBYTE, IOERR)
-#endif
- IF (IOERR.NE.0) GO TO 999
- CALL MZEBRA (-1)
-*
-* *** Open the 1 and only 1 Store used in the reconstruction
-*
- CALL MZSTOR (ISTOCU, '/GCBANK/', ' ', FENCCS(1), LQ(1), LQ(1)
- + , LQ(1), LQ(NDIV1), LQ(NLAST))
-*
-* *** Log-Level
-*
-#if !defined(CERNLIB__DEBUG)
- CALL MZLOGL (ISTOCU, 0)
-#endif
-#if defined(CERNLIB__DEBUG)
- CALL MZLOGL (ISTOCU, 1)
-#endif
-*
-* *** Define user division and link area like:
-*
- CALL MZDIV (ISTOCU, IDIVCU, 'DB-USERS', 20000, 30000, 'L')
- CALL MZLINK (ISTOCU, '/CUSER4/', LKTRCU(1), LDTRCU(5), LKTRCU(1))
-*
-* *** Initialize DB-Package
-*
- CALL TIMEST (999999.)
- NPAIR = 1
- LUFZ = 0
- NTOP = 0
- CALL CDINIT (IDIVCU, LUNRZ, LUFZ, 'DBL3', NPAIR, NREC, NTOP,
- + ' ', IRC)
-#if !defined(CERNLIB__DEBUG)
- CALL CDLOGL ('DBL3', 0, ' ', IRC)
-#endif
-#if defined(CERNLIB__DEBUG)
- CALL CDLOGL ('DBL3', 2, ' ', IRC)
-#endif
-*
-* *** Read the Data Base
-*
- CALL CDONFK
-*
-* *** Close DataBase
-*
- CALL CDEND ('*', 'A', IRC)
-* END CEXAM04
- 999 END
diff --git a/src/packlib/hepdb/examples/dbexam/cdexam04/cstor4.inc b/src/packlib/hepdb/examples/dbexam/cdexam04/cstor4.inc
deleted file mode 100644
index 38abc35..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdexam04/cstor4.inc
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: cstor4.inc,v 1.1.1.1 1996/02/28 16:23:46 mclareni Exp $
-*
-* $Log: cstor4.inc,v $
-* Revision 1.1.1.1 1996/02/28 16:23:46 mclareni
-* Hepdb, cdlib, etc
-*
-*
-*
-* cstor4.inc
-*
- COMMON /GCBANK/ FENCCS(22), LQ(9)
- DIMENSION IQ(2), Q(2)
- EQUIVALENCE (IQ(1),Q(1),LQ(9))
-*
- COMMON /QUEST/ IQUEST(100)
-*
diff --git a/src/packlib/hepdb/examples/dbexam/cdexam04/cuser4.inc b/src/packlib/hepdb/examples/dbexam/cdexam04/cuser4.inc
deleted file mode 100644
index 48a8e7c..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdexam04/cuser4.inc
+++ /dev/null
@@ -1,13 +0,0 @@
-*
-* $Id: cuser4.inc,v 1.1.1.1 1996/02/28 16:23:46 mclareni Exp $
-*
-* $Log: cuser4.inc,v $
-* Revision 1.1.1.1 1996/02/28 16:23:46 mclareni
-* Hepdb, cdlib, etc
-*
-*
-*
-* cuser4.inc
-*
- COMMON /CUSER4/ IDIVCU, ISTOCU, LPRTCU, LKTRCU(5), LDTRCU(5)
-*
diff --git a/src/packlib/hepdb/examples/dbexam/cdexam05/Imakefile b/src/packlib/hepdb/examples/dbexam/cdexam05/Imakefile
deleted file mode 100644
index 9e9eaea..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdexam05/Imakefile
+++ /dev/null
@@ -1,4 +0,0 @@
-SRCS_F= cdbrca.F cdcbcn.F cdcdl1.F cdexam05.F cdl1et.F \ @@\
- cdmatt.F cdmodp.F cexam05.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/hepdb/examples/dbexam/cdexam05/cdbrca.F b/src/packlib/hepdb/examples/dbexam/cdexam05/cdbrca.F
deleted file mode 100644
index e206ef6..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdexam05/cdbrca.F
+++ /dev/null
@@ -1,89 +0,0 @@
-*
-* $Id: cdbrca.F,v 1.1.1.1 1996/02/28 16:23:47 mclareni Exp $
-*
-* $Log: cdbrca.F,v $
-* Revision 1.1.1.1 1996/02/28 16:23:47 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDBRCA (ITIME)
-* =========================
-*
-************************************************************************
-* *
-* SUBR. CDBRCA (ITIME) *
-* *
-* Creates an example of the Branch-Camac vs. Rack-Crate table *
-* as suggested by T. Hebecker *
-* *
-* Arguments : *
-* *
-* ITIME Start of time validity *
-* *
-* Called by CDL1ET *
-* *
-************************************************************************
-*
-#include "cstor5.inc"
-#include "cuser5.inc"
- PARAMETER (NOFF1=10, NOFF2=12, NOFFP=6)
- PARAMETER (NKEX=NOFF2+4)
- DIMENSION KEYX(NKEX)
- CHARACTER CHOPT*8, COMNT*40
- DATA IPROG/1/, INFIN/773964216/, IFRST/0/
-*
-* ------------------------------------------------------------------
-*
-* *** -------- BRANCH-CAMAC ----------------------
-*
- IFRST = IFRST + 1
- NDAT = 10
- CHOPT = 'CDY'
- CALL MZBOOK (IDIVCU, LUSECU, LUSECU, 2, 'BRCA', 0, 0, NDAT, 5, 0)
-*
-* ** Comment
-*
- COMNT = 'BRANCH-CAMAC VS. RACK-CRATE '
- CALL UCTOH (COMNT, IQ(LUSECU+1), 4, 40)
-*
- CALL VZERO (KEYX, NKEX)
- KEYX(NOFF1+1) = ITIME
- KEYX(NOFF1+2) = INFIN
- KEYX(NOFFP) = IPROG
-*
-* ** Loop on branch and camac
-*
- DO 30 ICR = 1, 20
- DO 25 IBR = 1, 3
- KEYX(NOFF2+1) = IBR
- KEYX(NOFF2+2) = ICR
- KEYX(NOFF2+3) = (ICR-1)/4 + 1
- KEYX(NOFF2+4) = MOD (ICR, 4)
- IF (KEYX(NOFF2+4).EQ.0) KEYX(NOFF2+4) = 4
-*
- CALL CDSTOR ('//DBL3/TRIG/HARDCONF/BRACAM', LUSECU, LKTRCU(3),
- + IDIVCU, KEYX, CHOPT, IRC)
-*
-#if defined(CERNLIB__DEBUG)
- IF (LUSECU.NE.0) THEN
- CALL DZSHOW ('BRACAM ', IDIVCU, LUSECU, 'B', 0, 0, 0, 0)
- ENDIF
-#endif
- CALL UOPTC (CHOPT, 'C', IOPTC)
- IF (IOPTC.NE.0) THEN
-#if defined(CERNLIB__DEBUG)
- IF ((ICR.EQ.1.OR.ICR.EQ.20).AND.(IBR.EQ.1)) THEN
-#endif
-#if !defined(CERNLIB__DEBUG)
- IF ((ICR.EQ.1).AND.(IBR.EQ.1)) THEN
-#endif
- CALL DZSHOW ('LKBRACAM', IDIVCU, LKTRCU(3), 'BLV',0,0,0,0)
- ENDIF
- CALL MZDROP (IDIVCU, LKTRCU(3), 'L')
- ENDIF
- 25 CONTINUE
- 30 CONTINUE
- CALL MZDROP (IDIVCU, LUSECU, ' ')
-* END CDBRCA
- END
diff --git a/src/packlib/hepdb/examples/dbexam/cdexam05/cdcbcn.F b/src/packlib/hepdb/examples/dbexam/cdexam05/cdcbcn.F
deleted file mode 100644
index 06f8b8f..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdexam05/cdcbcn.F
+++ /dev/null
@@ -1,104 +0,0 @@
-*
-* $Id: cdcbcn.F,v 1.1.1.1 1996/02/28 16:23:47 mclareni Exp $
-*
-* $Log: cdcbcn.F,v $
-* Revision 1.1.1.1 1996/02/28 16:23:47 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDCBCN (ITYP, NICKN, ITIME)
-* =======================================
-*
-************************************************************************
-* *
-* SUBR. CDCBCN (ITYP, NICKN, ITIME) *
-* *
-* Creates a table of front pannel cable connections *
-* as suggested by T. Hebecker *
-* *
-* Arguments : *
-* *
-* ITYP Topological module number *
-* NICKN Nickname - unique name for each connection *
-* ITIME Start of time validity *
-* *
-* Called by CDL1ET *
-* *
-************************************************************************
-*
-#include "cstor5.inc"
-#include "cuser5.inc"
- PARAMETER (NOFF1=10, NOFF2=12, NOFFP=6)
- PARAMETER (NKEX=NOFF2+8)
- DIMENSION KEYX(NKEX), IOWDS(40)
- CHARACTER CHOPT*8, COMNT*40
- DATA IPROG/1/, INFIN/773964216/, IFRST/0/
-*
-* ------------------------------------------------------------------
-*
-* *** -------- CABLE CONNECTIONS ----------------------
-*
- IFRST = IFRST + 1
- NDAT = 11
- CHOPT = 'CDY'
- CALL MZIOCH (IOWDS, 40, '10H -F')
- CALL MZBOOK (IDIVCU, LUSECU, LUSECU, 2, 'MDPR', 0,0, NDAT,IOWDS,0)
-*
-* ** Comment
-*
- COMNT = 'CABLE CONNECTIONS FOR THAT MODULE '
- CALL UCTOH (COMNT, IQ(LUSECU+1), 4, 40)
-*
-* ** Cable length
-*
- Q(LUSECU+11) = 10.0*RNDM (Q)
-*
- CALL VZERO (KEYX, NKEX)
- KEYX(NOFF1+1) = ITIME
- KEYX(NOFF1+2) = INFIN
- KEYX(NOFFP) = IPROG
-*
-* ** Generate Cable connections
-* ** Only the same types are concerned
-* ** # of output cable = # of input cable = ITYP
-* ** Position of the first cable = ITYP
-*
- NTOPO = 100*ITYP + 3*ITYP - 2
- NTOPI = NTOPO + 1
- KEYX(NOFF2+1) = NTOPO
- KEYX(NOFF2+2) = ITYP
- KEYX(NOFF2+3) = ITYP*2 - 1
- KEYX(NOFF2+4) = NTOPI
- KEYX(NOFF2+5) = KEYX(NOFF2+2)
- KEYX(NOFF2+6) = KEYX(NOFF2+3)
-*
-* ** Nickname and polarity
-*
- KEYX(NOFF2+7) = NICKN
- CALL UCTOH ('P ', KEYX(NOFF2+8), 4, 4)
-*
- CALL CDSTOR ('//DBL3/TRIG/HARDCONF/CABCON', LUSECU, LKTRCU(4),
- + IDIVCU, KEYX, CHOPT, IRC)
-*
- IF (LUSECU.NE.0) THEN
-#if defined(CERNLIB__DEBUG)
- CALL DZSHOW ('CABCON ', IDIVCU, LUSECU, 'B', 0, 0, 0, 0)
-#endif
- CALL MZDROP (IDIVCU, LUSECU, ' ')
- ENDIF
-*
- CALL UOPTC (CHOPT, 'C', IOPTC)
- IF (IOPTC.NE.0) THEN
-#if defined(CERNLIB__DEBUG)
- IF (IFRST.LE.20) THEN
-#endif
-#if !defined(CERNLIB__DEBUG)
- IF (IFRST.LE.5) THEN
-#endif
- CALL DZSHOW ('LKCABCON', IDIVCU, LKTRCU(4), 'BLV',0,0,0,0)
- ENDIF
- CALL MZDROP (IDIVCU, LKTRCU(4), 'L')
- ENDIF
-* END CDCBCN
- END
diff --git a/src/packlib/hepdb/examples/dbexam/cdexam05/cdcdl1.F b/src/packlib/hepdb/examples/dbexam/cdexam05/cdcdl1.F
deleted file mode 100644
index 925a9c9..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdexam05/cdcdl1.F
+++ /dev/null
@@ -1,58 +0,0 @@
-*
-* $Id: cdcdl1.F,v 1.1.1.1 1996/02/28 16:23:47 mclareni Exp $
-*
-* $Log: cdcdl1.F,v $
-* Revision 1.1.1.1 1996/02/28 16:23:47 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDCDL1
-* =================
-*
-************************************************************************
-* *
-* SUBR. CDCDL1 *
-* *
-* Creates the directory structure of example Level 1 energy trigger *
-* Data base *
-* *
-* Called by CDL1ET *
-* *
-************************************************************************
-*
- PARAMETER (NKTPS=3, NKBRA=4, NKMAT=10, NKMOD=7, NKCAB=8)
- CHARACTER CFTPS*3, CFBRA*4, CFMAT*10, CFMOD*7, CFCAB*8
- CHARACTER*8 CTTPS(3), CTBRA(4), CTMAT(10), CTMOD(7), CTCAB(8)
- DATA CFTPS /'IHA'/, CFBRA /'IIII'/, CFMOD /'HAHIIII'/
- DATA CFMAT /'IIIIIIIIII'/, CFCAB /'IIIIIIIH'/
- DATA CTTPS /'TOPOLOGY', 'SERIAL_1', 'SERIAL_2'/
- DATA CTBRA /'BRANCH ', 'CAMAC ', 'RACK ',
- + 'CRATE '/
- DATA CTMAT /'TOPOL.NU', 'TYPE ', 'BRANCH ',
- + 'CAMAC ', 'STATION ', 'TIMING ',
- + 'SWITCHES', 'IN/OUT_C', 'RES.OUT1',
- + 'RES.OUT2'/
- DATA CTMOD /'SERIAL_1', 'SERIAL_2', 'STATUS ',
- + 'MODU_TYP', 'NOBITS ', 'RES.OUT1',
- + 'RES.OUT2'/
- DATA CTCAB /'#OUT_MOD', 'OUT_1ST ', 'OUT_LAST',
- + '#INP_MOD', 'INP_1ST ', 'INP_LAST',
- + 'NICKNAME', 'POLARITY'/
-*
-* ------------------------------------------------------------------
-*
- IPREC = 0
- DELTA = 0.0
- CALL CDMDIR ('//DBL3/TRIG/TOPSER', NKTPS, CFTPS, CTTPS,
- + 0, IPREC, DELTA, ' ', IRC)
- CALL CDMDIR ('//DBL3/TRIG/HARDCONF/BRACAM', NKBRA, CFBRA, CTBRA,
- + 0, IPREC, DELTA, ' ', IRC)
- CALL CDMDIR ('//DBL3/TRIG/HARDCONF/MODATT', NKMAT, CFMAT, CTMAT,
- + 0, IPREC, DELTA, ' ', IRC)
- CALL CDMDIR ('//DBL3/TRIG/MODPRP', NKMOD, CFMOD, CTMOD,
- + 0, IPREC, DELTA, ' ', IRC)
- CALL CDMDIR ('//DBL3/TRIG/HARDCONF/CABCON', NKCAB, CFCAB, CTCAB,
- + 0, IPREC, DELTA, ' ', IRC)
-* END CDCDL1
- END
diff --git a/src/packlib/hepdb/examples/dbexam/cdexam05/cdexam05.F b/src/packlib/hepdb/examples/dbexam/cdexam05/cdexam05.F
deleted file mode 100644
index fd49921..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdexam05/cdexam05.F
+++ /dev/null
@@ -1,9 +0,0 @@
-*
-* $Id: cdexam05.F,v 1.1.1.1 1996/02/28 16:23:47 mclareni Exp $
-*
-* $Log: cdexam05.F,v $
-* Revision 1.1.1.1 1996/02/28 16:23:47 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
diff --git a/src/packlib/hepdb/examples/dbexam/cdexam05/cdl1et.F b/src/packlib/hepdb/examples/dbexam/cdexam05/cdl1et.F
deleted file mode 100644
index ba0b8f4..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdexam05/cdl1et.F
+++ /dev/null
@@ -1,256 +0,0 @@
-*
-* $Id: cdl1et.F,v 1.1.1.1 1996/02/28 16:23:47 mclareni Exp $
-*
-* $Log: cdl1et.F,v $
-* Revision 1.1.1.1 1996/02/28 16:23:47 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDL1ET
-* =================
-*
-************************************************************************
-* *
-* SUBR. CDL1ET *
-* *
-* Creates an example of the Level 1 Energy Trigger as suggested by *
-* T. Hebecker *
-* *
-* Called by CEXAM05 *
-* *
-************************************************************************
-*
-#include "cstor5.inc"
-#include "cuser5.inc"
- PARAMETER (NOFF1=10, NOFF2=12, NOFFP=6)
- DIMENSION KEYX(50), KEYO(50)
- CHARACTER CHOPT*8, COMNT*40
- CHARACTER MODU1*4, MODU2*4, MODU5(5)*1, SERNO*8, SEROL*8
- DATA IPROG /1/, INFIN /773964216/
- DATA MODU1 /'XMOD'/, MODU5 /'A','B','C','D','E'/
-*
-* ------------------------------------------------------------------
-*
-* *** -------- TOPSER ----------------------
-*
- NKEX = NOFF2 + 3
- CALL CDCDL1
-*
-* ** 10 data words reserved for comments (40 characters)
-*
- NDAT = 10
-*
-* ** Set-up TOPSER at time IT1 and date ID1
-*
- ID1 = 870731
- IT1 = 103000
- CALL CDPKTS (ID1, IT1, IDT1, IRC)
-*
-* ** Set up Branch-Camac vs. Rack-crate table
-*
- CALL CDBRCA (IDT1)
-*
- DO 30 I = 1, 50
- CALL VZERO (KEYX, NKEX)
- KEYX(NOFF1+1) = IDT1
- KEYX(NOFF1+2) = INFIN
- KEYX(NOFFP) = IPROG
-*
-* * Topological Module
-*
- ITYP = I/3 + 1
- KEYX(NOFF2+1) = 100*ITYP + I
-*
-* * Set up Module Attributes (i.e. prescribed properties)
-*
- CALL CDMATT (KEYX(NOFF2+1), IDT1)
-*
-* * Serial Number of Module
-*
- J = (I-1)/10 + 1
- MODU1(1:1) = MODU5(J)
- CALL UCTOH (MODU1, KEYX(NOFF2+2), 4, 4)
- IMODU = 10*I
- WRITE (MODU2, 1001) IMODU
- CALL UCTOH (MODU2, KEYX(NOFF2+3), 4, 4)
-*
-* ** Store Module Properties
-*
- SERNO = MODU1//MODU2
- SEROL = SERNO
- CALL CDMODP (SEROL, SERNO, ITYP, IDT1)
- CHOPT = 'CDY'
- CALL MZBOOK (IDIVCU, LUSECU, LUSECU, 2, 'TPSR', 0, 0, NDAT, 5,0)
-*
-* * Comment
-*
- COMNT = 'TOPSER AT 870731 103000'
- CALL UCTOH (COMNT, IQ(LUSECU+1), 4, 40)
- CALL CDSTOR ('//DBL3/TRIG/TOPSER', LUSECU, LKTRCU(1),
- + IDIVCU, KEYX, CHOPT, IRC)
- IF (LUSECU.NE.0) THEN
-#if defined(CERNLIB__DEBUG)
- CALL DZSHOW ('TOPSER ', IDIVCU, LUSECU, 'B', 0, 0, 0, 0)
-#endif
- CALL MZDROP (IDIVCU, LUSECU, ' ')
- ENDIF
- CALL UOPTC (CHOPT, 'C', IOPTC)
- IF (IOPTC.NE.0) THEN
-#if defined(CERNLIB__DEBUG)
- IF (I.EQ.1.OR.I.EQ.50) THEN
-#endif
-#if !defined(CERNLIB__DEBUG)
- IF (I.EQ.1) THEN
-#endif
- CALL DZSHOW ('LKTOPSER', IDIVCU, LKTRCU(1), 'BLV', 0,0, 0,0)
- ENDIF
- CALL MZDROP (IDIVCU, LKTRCU(1), 'L')
- ENDIF
- 30 CONTINUE
-*
-* ** Change first 20 TOPSER at time IT2 and date ID2
-*
- ID2 = 880731
- IT2 = 163000
- CALL CDPKTS (ID2, IT2, IDT2, IRC)
-*
- DO 40 I = 1, 20
- CALL VZERO (KEYX, NKEX)
- KEYX(NOFF1+1) = IDT2
- KEYX(NOFF1+2) = INFIN
- KEYX(NOFFP) = IPROG
-*
-* * Topological Module
-*
- ITYP = I/3 + 1
- KEYX(NOFF2+1) = 100*ITYP + I
-*
-* * Serial Number of Module
-*
- J = (I-1)/10 + 1
- MODU1(1:1) = 'X'
- CALL UCTOH (MODU1, KEYX(NOFF2+2), 4, 4)
- IMODU = 10*I
- WRITE (MODU2, 1001) IMODU
- CALL UCTOH (MODU2, KEYX(NOFF2+3), 4, 4)
-*
-* ** Store Module Properties
-*
- SERNO = MODU1//MODU2
- MODU1(1:1) = MODU5(J)
- SEROL = MODU1//MODU2
- CALL CDMODP (SEROL, SERNO, ITYP, IDT2)
- CALL UCOPY (KEYX, KEYO, NKEX)
- CALL UCTOH (SEROL, KEYO(NOFF2+2), 4, 8)
- CHOPT = 'CDY'
- CALL MZBOOK (IDIVCU, LUSECU, LUSECU, 2, 'TPSR', 0, 0, NDAT, 5,0)
-*
-* * Comment
-*
- COMNT = 'TOPSER AT 880731 163000'
- CALL UCTOH (COMNT, IQ(LUSECU+1), 4, 40)
- CALL CDREPL ('//DBL3/TRIG/TOPSER', LUSECU, LKTRCU(1),
- + IDIVCU, KEYO, KEYX, CHOPT, IRC)
- IF (LUSECU.NE.0) THEN
-#if defined(CERNLIB__DEBUG)
- CALL DZSHOW ('TOPSER ', IDIVCU, LUSECU, 'B', 0, 0, 0, 0)
-#endif
- CALL MZDROP (IDIVCU, LUSECU, ' ')
- ENDIF
- CALL UOPTC (CHOPT, 'C', IOPTC)
- IF (IOPTC.NE.0) THEN
-#if defined(CERNLIB__DEBUG)
- IF (I.EQ.1.OR.I.EQ.20) THEN
-#endif
-#if !defined(CERNLIB__DEBUG)
- IF (I.EQ.1) THEN
-#endif
- CALL DZSHOW ('LKTOPSER', IDIVCU, LKTRCU(1), 'BLV', 0,0, 0,0)
- ENDIF
- CALL MZDROP (IDIVCU, LKTRCU(1), 'L')
- ENDIF
- 40 CONTINUE
-*
-* ** Change last 20 TOPSER at time IT3 and date ID3
-*
- ID3 = 900131
- IT3 = 221500
- CALL CDPKTS (ID3, IT3, IDT3, IRC)
-*
- DO 50 I = 31, 50
- CALL VZERO (KEYX, NKEX)
- KEYX(NOFF1+1) = IDT3
- KEYX(NOFF1+2) = INFIN
- KEYX(NOFFP) = IPROG
-*
-* * Topological Module
-*
- ITYP = I/3 + 1
- KEYX(NOFF2+1) = 100*ITYP + I
-*
-* * Serial Number of Module
-*
- J = (I-1)/10 + 1
- MODU1(1:1) = 'Y'
- CALL UCTOH (MODU1, KEYX(NOFF2+2), 4, 4)
- IMODU = 10*I
- WRITE (MODU2, 1001) IMODU
- CALL UCTOH (MODU2, KEYX(NOFF2+3), 4, 4)
-*
-* ** Store Module Properties
-*
- SERNO = MODU1//MODU2
- MODU1(1:1) = MODU5(J)
- SEROL = MODU1//MODU2
- CALL CDMODP (SEROL, SERNO, ITYP, IDT3)
- CALL UCOPY (KEYX, KEYO, NKEX)
- CALL UCTOH (SEROL, KEYO(NOFF2+2), 4, 8)
- CHOPT = 'DY'
- CALL MZBOOK (IDIVCU, LUSECU, LUSECU, 2, 'TPSR', 0, 0, NDAT, 5,0)
-*
-* * Comment
-*
- COMNT = 'TOPSER AT 900131 221500'
- CALL UCTOH (COMNT, IQ(LUSECU+1), 4, 40)
- CALL CDREPL ('//DBL3/TRIG/TOPSER', LUSECU, LKTRCU(1),
- + IDIVCU, KEYO, KEYX, CHOPT, IRC)
- IF (LUSECU.NE.0) THEN
-#if defined(CERNLIB__DEBUG)
- CALL DZSHOW ('TOPSER ', IDIVCU, LUSECU, 'B', 0, 0, 0, 0)
-#endif
- CALL MZDROP (IDIVCU, LUSECU, ' ')
- ENDIF
- CALL UOPTC (CHOPT, 'C', IOPTC)
- IF (IOPTC.NE.0) THEN
-#if defined(CERNLIB__DEBUG)
- IF (I.EQ.31.OR.I.EQ.50) THEN
-#endif
-#if !defined(CERNLIB__DEBUG)
- IF (I.EQ.31) THEN
-#endif
- CALL DZSHOW ('LKTOPSER', IDIVCU, LKTRCU(1), 'BLV', 0,0, 0,0)
- ENDIF
- CALL MZDROP (IDIVCU, LKTRCU(1), 'L')
- ENDIF
- 50 CONTINUE
-*
-* ** The propeerties of the last two modules are changed at ID4 and IT4
-*
- ID4 = 920101
- IT4 = 103000
- CALL CDPKTS (ID4, IT4, IDT4, IRC)
- CALL CDMODP ('YMOD 490', 'YMOD 490', ITYP, IDT4)
- CALL CDMODP ('YMOD 500', 'YMOD 500', ITYP, IDT4)
-*
-* ** Set up Cable Connections
-*
- NICKN = 0
- DO 60 ITYP = 1, 17
- NICKN = NICKN + 1
- CALL CDCBCN (ITYP, NICKN, IDT1)
- 60 CONTINUE
-*
- 1001 FORMAT (I4)
-* END CDL1ET
- END
diff --git a/src/packlib/hepdb/examples/dbexam/cdexam05/cdmatt.F b/src/packlib/hepdb/examples/dbexam/cdexam05/cdmatt.F
deleted file mode 100644
index fc8f898..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdexam05/cdmatt.F
+++ /dev/null
@@ -1,103 +0,0 @@
-*
-* $Id: cdmatt.F,v 1.1.1.1 1996/02/28 16:23:47 mclareni Exp $
-*
-* $Log: cdmatt.F,v $
-* Revision 1.1.1.1 1996/02/28 16:23:47 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDMATT (NTOP, ITIME)
-* ===============================
-*
-************************************************************************
-* *
-* SUBR. CDMATT (NTOP, ITIME) *
-* *
-* Creates table of Module - attributes (prescribed module properties)*
-* as suggested by T. Hebecker *
-* *
-* Arguments : *
-* *
-* NTOP Topological Module number *
-* ITIME Start of time validity *
-* *
-* Called by CDL1ET *
-* *
-************************************************************************
-*
-#include "cstor5.inc"
-#include "cuser5.inc"
- PARAMETER (NOFF1=10, NOFF2=12, NOFFP=6)
- PARAMETER (NKEX=NOFF2+10)
- DIMENSION KEYX(NKEX)
- CHARACTER CHOPT*8, COMNT*40
- DATA IPROG/1/, INFIN/773964216/, IFRST/0/
-*
-* ------------------------------------------------------------------
-*
-* *** -------- MODULE ATTRIBUTES ----------------------
-*
- IFRST = IFRST + 1
- NDAT = 10
- CHOPT = 'CDY'
- CALL MZBOOK (IDIVCU, LUSECU, LUSECU, 2, 'MATT', 0, 0, NDAT, 5, 0)
-*
-* ** Comment
-*
- COMNT = 'PRESCRIBED PROPERTIES OF THAT MODULE '
- CALL UCTOH (COMNT, IQ(LUSECU+1), 4, 40)
-*
- CALL VZERO (KEYX, NKEX)
- KEYX(NOFF1+1) = ITIME
- KEYX(NOFF1+2) = INFIN
- KEYX(NOFFP) = IPROG
-*
- KEYX(NOFF2+1) = NTOP
- ITYP = NTOP/100
- KEYX(NOFF2+2) = ITYP
-*
-* ** Generate Branch, Camac and Station number
-*
- KEYX(NOFF2+3) = MOD (NTOP, 3)
- IF (KEYX(NOFF2+3).EQ.0) KEYX(NOFF2+3) = 3
- KEYX(NOFF2+4) = NTOP/100 + 1
- KEYX(NOFF2+5) = 21.0*RNDM(Q) - 1.0
-*
-* ** Generate Relative Timing and Switches
-*
- KEYX(NOFF2+6) = 0
- KEYX(NOFF2+7) = 0
- IF (ITYP.EQ.5) KEYX(NOFF2+7) = 11
-*
-* ** Generate In/Out Cables and Resistors
-*
- NCIN = ITYP
- NCOUT = ITYP
- KEYX(NOFF2+8) = 1000*NCIN + NCOUT
- KEYX(NOFF2+9) = KEYX(NOFF2+8)
- KEYX(NOFF2+10) = ITYP*1000
-*
- CALL CDSTOR ('//DBL3/TRIG/HARDCONF/MODATT', LUSECU, LKTRCU(5),
- + IDIVCU, KEYX, CHOPT, IRC)
- IF (LUSECU.NE.0) THEN
-#if defined(CERNLIB__DEBUG)
- CALL DZSHOW ('MODATT ', IDIVCU, LUSECU, 'B', 0, 0, 0, 0)
-#endif
- CALL MZDROP (IDIVCU, LUSECU, ' ')
- ENDIF
-*
- CALL UOPTC (CHOPT, 'C', IOPTC)
- IF (IOPTC.NE.0) THEN
-#if defined(CERNLIB__DEBUG)
- IF (IFRST.LE.20) THEN
-#endif
-#if !defined(CERNLIB__DEBUG)
- IF (IFRST.LE.5) THEN
-#endif
- CALL DZSHOW ('LKMODATT', IDIVCU, LKTRCU(5), 'BLV', 0, 0, 0, 0)
- ENDIF
- CALL MZDROP (IDIVCU, LKTRCU(5), 'L')
- ENDIF
-* END CDMATT
- END
diff --git a/src/packlib/hepdb/examples/dbexam/cdexam05/cdmodp.F b/src/packlib/hepdb/examples/dbexam/cdexam05/cdmodp.F
deleted file mode 100644
index 7f27673..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdexam05/cdmodp.F
+++ /dev/null
@@ -1,147 +0,0 @@
-*
-* $Id: cdmodp.F,v 1.1.1.1 1996/02/28 16:23:47 mclareni Exp $
-*
-* $Log: cdmodp.F,v $
-* Revision 1.1.1.1 1996/02/28 16:23:47 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDMODP (SEROL, SERNO, ITYP, ITIME)
-* =============================================
-*
-************************************************************************
-* *
-* SUBR. CDMODP (SEROL, SERNO, ITYP, ITIME) *
-* *
-* Creates an example of the Properties of the Modules *
-* as suggested by T. Hebecker *
-* *
-* Arguments : *
-* *
-* SEROL Serial number of the old module *
-* SERNO Serial number of the Module *
-* ITYP Type of the module *
-* ITIME Start of time validity *
-* *
-* Called by CDL1ET *
-* *
-************************************************************************
-*
-#include "cstor5.inc"
-#include "cuser5.inc"
- PARAMETER (NOFF1=10, NOFF2=12, NOFFP=6)
- PARAMETER (NKEX=NOFF2+7)
- DIMENSION IOWDS(40), KEYX(NKEX), KEYO(NKEX)
- CHARACTER CHOPT*8, COMNT*40
- CHARACTER SERNO*8, STATU*4, SEROL*8
- LOGICAL FERA
- DATA IPROG/1/, INFIN/773964216/, IFRST/0/
-*
-* ------------------------------------------------------------------
-*
-* *** -------- MODPRP ----------------------
-*
- IFRST = IFRST + 1
- CALL VZERO (KEYX, NKEX)
- KEYX(NOFF1+1) = ITIME
- KEYX(NOFF1+2) = INFIN
- KEYX(NOFFP) = IPROG
-*
-* * Serial Number of Module
-*
- CALL UCTOH (SERNO, KEYX(NOFF2+1), 4, 8)
-*
-* * Status
-*
- STATU = 'Y '
- CALL UCTOH (STATU, KEYX(NOFF2+3), 4, 4)
-*
-* * Integer keys
-*
- FERA = ITYP.EQ.5
- NCIN = ITYP
- NCOUT = ITYP
- KEYX(NOFF2+4) = ITYP
- KEYX(NOFF2+5) = 0
- IF (FERA) KEYX(NOFF2+5) = 11
- KEYX(NOFF2+6) = 1000*NCIN + NCOUT
- KEYX(NOFF2+7) = ITYP*1000
- CALL UCOPY (KEYX, KEYO, NKEX)
- CALL UCTOH (SEROL, KEYO(NOFF2+1), 4, 8)
-*
-* * ADC - Information (If FERA = 'F ')
-*
- IF (FERA) THEN
- NDAT = 127
- CALL MZIOCH (IOWDS, 40, '10H 5F 16I 80F -H')
- ELSE
- NDAT = 15
- CALL MZIOCH (IOWDS, 40, '10H -F')
- ENDIF
-*
- CHOPT = 'CDY'
- CALL MZBOOK (IDIVCU, LUSECU, LUSECU, 2, 'MDPR', 0,0, NDAT,IOWDS,0)
- IF (FERA) THEN
-*
-* ** ADC - Data
-*
- LWU = LUSECU + 15
- DO 30 I = 1, 16
-* Channel #
- IQ(LWU+I) = I-1
-* Pedestals
- Q (LWU+16+I) = 35. + 10.*RNDM(Q)
-* R.M.S.
- Q (LWU+32+I) = RNDM(Q)
-* Slopes
- Q (LWU+48+I) = 1. + 0.05*(RNDM(Q)-0.5)
-* Intercepts
- Q (LWU+64+I) = 1.5*(RNDM(Q)-0.5)
-* Chi-squares
- Q (LWU+80+I) = 2.*RNDM(Q)
-* OK ?
- CALL UCTOH ('Y ', IQ(LWU+96+I), 4, 4)
- 30 CONTINUE
- ENDIF
-*
-* ** Comment
-*
- COMNT = 'MODULE PROPERTIES '
- CALL UCTOH (COMNT, IQ(LUSECU+1), 4, 40)
-*
-* ** Floating data
-*
- Q(LUSECU+11) = 99. * RNDM(Q)
- Q(LUSECU+12) = 99. * RNDM(Q)
- Q(LUSECU+13) = 0.
- Q(LUSECU+14) = 0.
- Q(LUSECU+15) = 0.
-*
- IF (SEROL.EQ.SERNO) THEN
- CALL CDSTOR ('//DBL3/TRIG/MODPRP', LUSECU, LKTRCU(2),
- + IDIVCU, KEYX, CHOPT, IRC)
- ELSE
- CALL CDREPL ('//DBL3/TRIG/MODPRP', LUSECU, LKTRCU(2),
- + IDIVCU, KEYO, KEYX, CHOPT, IRC)
- ENDIF
- IF (LUSECU.NE.0) THEN
-#if defined(CERNLIB__DEBUG)
- CALL DZSHOW ('MODPRP ', IDIVCU, LUSECU, 'B', 0, 0, 0, 0)
-#endif
-#if !defined(CERNLIB__DEBUG)
- IF (MOD(IFRST,50).EQ.1)
- + CALL DZSHOW ('MODPRP ', IDIVCU, LUSECU, 'B', 0, 0, 0, 0)
-#endif
- CALL MZDROP (IDIVCU, LUSECU, ' ')
- ENDIF
-*
- CALL UOPTC (CHOPT, 'C', IOPTC)
- IF (IOPTC.NE.0) THEN
-#if defined(CERNLIB__DEBUG)
- CALL DZSHOW ('LKMODPRP', IDIVCU, LKTRCU(2), 'BLV', 0, 0, 0, 0)
-#endif
- CALL MZDROP (IDIVCU, LKTRCU(2), 'L')
- ENDIF
-* END CDMODP
- END
diff --git a/src/packlib/hepdb/examples/dbexam/cdexam05/cexam05.F b/src/packlib/hepdb/examples/dbexam/cdexam05/cexam05.F
deleted file mode 100644
index 03234ad..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdexam05/cexam05.F
+++ /dev/null
@@ -1,100 +0,0 @@
-*
-* $Id: cexam05.F,v 1.1.1.1 1996/02/28 16:23:47 mclareni Exp $
-*
-* $Log: cexam05.F,v $
-* Revision 1.1.1.1 1996/02/28 16:23:47 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- PROGRAM CEXAM05
-* ===============
-*
-************************************************************************
-* *
-* PROG. CEXAM05 *
-* *
-* Program to create a fictitious Data Base to test the Package *
-* including CDSTOR, CDMDIR, CDUSEM (opt.'S') and nkeys > 14 *
-* *
-* Creates an immitation of the Trigger Data Base *
-* *
-************************************************************************
-*
- PARAMETER (NLAST=150000, NDIV1=5000)
- COMMON /GCBANK/ FENCCS(22), LQ(NLAST)
-*
-#include "cuser5.inc"
-* ------------------------------------------------------------------
-*
-* *** Open the RZ-file with an Open Statement (or JCL, etc)
-*
- LUNRZ = 1
- LPRTCU = 6
- NREC = 1000
- LREC = 1024
- NBYTE = 4*LREC
-#if defined(CERNLIB_IBM)
- CALL CDROPN (LUNRZ, 'ZO', 'DBTRIG.DATA.A4', NBYTE, IOERR)
-#endif
-#if !defined(CERNLIB_IBM)
- CALL CDROPN (LUNRZ, 'ZO', 'DBTRIG.DAT', NBYTE, IOERR)
-#endif
- IF (IOERR.NE.0) GO TO 999
- CALL MZEBRA (-1)
-*
-* *** Open the 1 and only 1 Store used in the reconstruction
-*
- CALL MZSTOR (ISTOCU, '/GCBANK/', ' ', FENCCS(1), LQ(1), LQ(1)
- + , LQ(1), LQ(NDIV1), LQ(NLAST))
-*
-* *** Log-Level
-*
-#if !defined(CERNLIB__DEBUG)
- CALL MZLOGL (ISTOCU, 0)
-#endif
-#if defined(CERNLIB__DEBUG)
- CALL MZLOGL (ISTOCU, 1)
-#endif
-*
-* *** Define user division and link area like:
-*
- CALL MZDIV (ISTOCU, IDIVCU, 'DB-USERS', 50000, 100000, 'L')
- CALL MZLINK (ISTOCU, '/CUSER5/', LDTRCU(1), LUSECU, LDTRCU(1))
-*
-* *** Initialize DB-Package
-*
- CALL TIMEST (999999.)
- NPAIR = 1
- LUFZ = 0
- NTOP = 0
- CALL CDINIT (IDIVCU, LUNRZ, LUFZ, 'DBL3', NPAIR, NREC, NTOP,
- + 'UZ', IRC)
-#if !defined(CERNLIB__DEBUG)
- CALL CDLOGL ('DBL3', 0, ' ', IRC)
-#endif
-#if defined(CERNLIB__DEBUG)
- CALL CDLOGL ('DBL3', 2, ' ', IRC)
-#endif
-*
-* *** Create the Trigger Data Base
-*
- CALL TIMEX (TIMINT)
- CALL CDUVTX (IDAY, ITIM1)
- CALL CDL1ET
-*
- CALL TIMEX (TIMNOW)
- TIME = TIMNOW - TIMINT
- CALL CDUVTX (IDAY, ITIM2)
- ITIME = ITIM2 - ITIM1
- WRITE (LPRTCU, 1001) IDAY, ITIM1, ITIM2, ITIME
- WRITE (LPRTCU, 1002) TIMINT, TIMNOW, TIME
-*
-* *** Close Data Base
-*
- CALL CDEND ('*', 'A', IRC)
-*
- 1001 FORMAT (/,' CEXAM05 : IDAY/ITIM1/ITIM2/ITIME ', 4I12)
- 1002 FORMAT (/,' CEXAM05 : TIMINT/TIMNOW/TIME ',4G12.4)
-* END CEXAM05
- 999 END
diff --git a/src/packlib/hepdb/examples/dbexam/cdexam05/cstor5.inc b/src/packlib/hepdb/examples/dbexam/cdexam05/cstor5.inc
deleted file mode 100644
index 8b50cd3..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdexam05/cstor5.inc
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: cstor5.inc,v 1.1.1.1 1996/02/28 16:23:47 mclareni Exp $
-*
-* $Log: cstor5.inc,v $
-* Revision 1.1.1.1 1996/02/28 16:23:47 mclareni
-* Hepdb, cdlib, etc
-*
-*
-*
-* cstor5.inc
-*
- COMMON /GCBANK/ FENCCS(22), LQ(9)
- DIMENSION IQ(2), Q(2)
- EQUIVALENCE (IQ(1),Q(1),LQ(9))
-*
- COMMON /QUEST/ IQUEST(100)
-*
diff --git a/src/packlib/hepdb/examples/dbexam/cdexam05/cuser5.inc b/src/packlib/hepdb/examples/dbexam/cdexam05/cuser5.inc
deleted file mode 100644
index 406c02e..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdexam05/cuser5.inc
+++ /dev/null
@@ -1,14 +0,0 @@
-*
-* $Id: cuser5.inc,v 1.1.1.1 1996/02/28 16:23:47 mclareni Exp $
-*
-* $Log: cuser5.inc,v $
-* Revision 1.1.1.1 1996/02/28 16:23:47 mclareni
-* Hepdb, cdlib, etc
-*
-*
-*
-* cuser5.inc
-*
- COMMON /CUSER5/ ISTOCU, IDIVCU, LPRTCU, LDTRCU(5), LKTRCU(5)
- + , LUSECU
-*
diff --git a/src/packlib/hepdb/examples/dbexam/cdexam06/Imakefile b/src/packlib/hepdb/examples/dbexam/cdexam06/Imakefile
deleted file mode 100644
index b25887c..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdexam06/Imakefile
+++ /dev/null
@@ -1,3 +0,0 @@
-SRCS_F= cdexam06.F cdrl1e.F cexam06.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/hepdb/examples/dbexam/cdexam06/cdexam06.F b/src/packlib/hepdb/examples/dbexam/cdexam06/cdexam06.F
deleted file mode 100644
index 07b7577..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdexam06/cdexam06.F
+++ /dev/null
@@ -1,9 +0,0 @@
-*
-* $Id: cdexam06.F,v 1.1.1.1 1996/02/28 16:23:49 mclareni Exp $
-*
-* $Log: cdexam06.F,v $
-* Revision 1.1.1.1 1996/02/28 16:23:49 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
diff --git a/src/packlib/hepdb/examples/dbexam/cdexam06/cdrl1e.F b/src/packlib/hepdb/examples/dbexam/cdexam06/cdrl1e.F
deleted file mode 100644
index c1f35d0..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdexam06/cdrl1e.F
+++ /dev/null
@@ -1,303 +0,0 @@
-*
-* $Id: cdrl1e.F,v 1.1.1.1 1996/02/28 16:23:50 mclareni Exp $
-*
-* $Log: cdrl1e.F,v $
-* Revision 1.1.1.1 1996/02/28 16:23:50 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDRL1E (ITIME)
-* =========================
-*
-************************************************************************
-* *
-* SUBR. CDRL1E (ITIME) *
-* *
-* Query of the Trigger Data Base for a given time *
-* as suggested by T. Hebecker *
-* *
-* Arguments : *
-* *
-* ITIME Time for which the query refers *
-* *
-* Called by CEXAM06 *
-* *
-************************************************************************
-*
-#include "cstor6.inc"
-#include "cuser6.inc"
- PARAMETER (NOFF1=10, NOFF2=12, NOFFP=6)
- DIMENSION KEY1(100), KEY2(100), KEY3(100), KEY4(100)
- DIMENSION KEY5(100), KEY6(100), KEY7(100), KEY8(100)
- DIMENSION MSK1(100), MSK2(100), MSK3(100), MSK4(100)
- DIMENSION MSK5(100), MSK6(100), MSK7(100), MSK8(100)
- CHARACTER COMNT*40, SERNB*8, STATU*4, OK*4, POLAR*4
- CHARACTER CHOP1*20, CHOP2*20, CHOP3*20, CHOP4*20
- CHARACTER CHOP5*20, CHOP6*20, CHOP7*20, CHOP8*20
- LOGICAL FERA
- INTEGER RESOU1, RESOU2
-*
-* ------------------------------------------------------------------
-*
-* *** Unpack date and time
-*
- CALL CDUPTS (ID1, IT1, ITIME, IRC)
-*
-* *** Find all modules (Topological number) in Rack # IRCK
-* *** and perform further querries to these modules
-*
- DO 100 IRCK = 1, 5
- WRITE (LPRTCU, 1001) IRCK
-*
-* ** Camac number
-*
- CALL VZERO (KEY5, 50)
- CALL VZERO (MSK5, 50)
- MSK5(NOFF2+3) = 1
- KEY5(NOFF2+3) = IRCK
- CHOP5 = 'SK'
- CALL CDUSEM ('//DBL3/TRIG/HARDCONF/BRACAM', LKTRCU(5), ITIME,
- + MSK5, KEY5, CHOP5, IRC)
-*
- IF (LKTRCU(5).EQ.0) THEN
- WRITE (LPRTCU, 1002)
- GO TO 100
- ENDIF
-*
- NK5 = NZBANK (IDIVCU, LKTRCU(5))
- LKTRCU(9) = LKTRCU(5)
- DO 90 IK5 = 1, NK5
- IF (LKTRCU(9).EQ.0) GO TO 95
- IBRA = IQ(LKTRCU(9)+NOFF2+1)
- ICAM = IQ(LKTRCU(9)+NOFF2+2)
- WRITE (LPRTCU, 1003) ICAM, IBRA
-*
-* ** Module number
-*
- CALL VZERO (MSK6, 50)
- CALL VZERO (KEY6, 50)
- MSK6(NOFF2+3) = 1
- MSK6(NOFF2+4) = 1
- KEY6(NOFF2+3) = IBRA
- KEY6(NOFF2+4) = ICAM
- CHOP6 = 'KS'
- CALL CDUSEM ('//DBL3/TRIG/HARDCONF/MODATT', LKTRCU(6), ITIME,
- + MSK6, KEY6, CHOP6, IRC)
-*
- IF (LKTRCU(6).EQ.0) THEN
- WRITE (LPRTCU, 1004)
- GO TO 90
- ENDIF
-*
- NK6 = NZBANK (IDIVCU, LKTRCU(6))
- LKTRCU(10) = LKTRCU(6)
- DO 80 IK6 = 1, NK6
- IF (LKTRCU(10).EQ.0) GO TO 85
- IMOD = IQ(LKTRCU(10)+NOFF2+1)
- WRITE (LPRTCU, 1005) IMOD
-*
-* ** Find the cable connections of that module
-* * Output cables
-*
- CALL VZERO (KEY7, 50)
- CALL VZERO (MSK7, 50)
- CHOP7 = 'SK'
- MSK7(NOFF2+1) = 1
- KEY7(NOFF2+1) = IMOD
- CALL CDUSEM ('//DBL3/TRIG/HARDCONF/CABCON', LKTRCU(7),
- + ITIME, MSK7, KEY7, CHOP7, IRC)
-*
-* * Print input cables (start-end, #, nicknumber and polarity)
-*
- NK7 = NZBANK (IDIVCU, LKTRCU(7))
- IF (NK7.LE.0) THEN
- WRITE (LPRTCU, 1006)
- GO TO 20
- ENDIF
- LKTRCU(11) = LKTRCU(7)
- DO 10 IK7 = 1, NK7
- IF (LKTRCU(11).EQ.0) GO TO 20
- L11 = LKTRCU(11)
- CALL UHTOC (IQ(L11+NOFF2+8), 4, POLAR, 4)
- WRITE (LPRTCU, 1007) IQ(L11+NOFF2+2), IQ(L11+NOFF2+3),
- + IQ(L11+NOFF2+4), IQ(L11+NOFF2+5),
- + IQ(L11+NOFF2+6), IQ(L11+NOFF2+7),
- + POLAR
- 10 LKTRCU(11) = LQ(LKTRCU(11))
-*
- 20 CALL CDFREE ('//DBL3/TRIG/HARDCONF/CABCON', LKTRCU(7), MSK7,
- + KEY7, CHOP7, IRC)
-*
-* * Input cables
-*
- CALL VZERO (KEY7, 50)
- CALL VZERO (MSK7, 50)
- CHOP7 = 'SK'
- MSK7(NOFF2+4) = 1
- KEY7(NOFF2+4) = IMOD
- CALL CDUSEM ('//DBL3/TRIG/HARDCONF/CABCON', LKTRCU(7),
- + ITIME, MSK7, KEY7, CHOP7, IRC)
-*
-* * Print output cables (start-end, #, nicknumber and polarity)
-*
- NK7 = NZBANK (IDIVCU, LKTRCU(7))
- IF (NK7.LE.0) THEN
- WRITE (LPRTCU, 1008)
- GO TO 40
- ENDIF
- LKTRCU(11) = LKTRCU(7)
- DO 30 IK7 = 1, NK7
- IF (LKTRCU(11).EQ.0) GO TO 40
- L11 = LKTRCU(11)
- CALL UHTOC (IQ(L11+NOFF2+8), 4, POLAR, 4)
- WRITE (LPRTCU, 1009) IQ(L11+NOFF2+5), IQ(L11+NOFF2+6),
- + IQ(L11+NOFF2+1), IQ(L11+NOFF2+2),
- + IQ(L11+NOFF2+3), IQ(L11+NOFF2+7),
- + POLAR
- 30 LKTRCU(11) = LQ(LKTRCU(11))
-*
- 40 CALL CDFREE ('//DBL3/TRIG/HARDCONF/CABCON', LKTRCU(7), MSK7,
- + KEY7, CHOP7, IRC)
-*
-* ** Find the serial number of that module
-*
- CALL VZERO (KEY1, 50)
- CALL VZERO (MSK1, 50)
- CHOP1 = ' '
- MSK1(NOFF2+1) = 1
- KEY1(NOFF2+1) = IMOD
- CALL CDUSEM ('//DBL3/TRIG/TOPSER', LKTRCU(1), ITIME,
- + MSK1, KEY1, CHOP1, IRC)
-*
-* ** Print serial # with the comment
-*
- LDTRCU(1) = LQ(LKTRCU(1)-1)
- CALL UHTOC (IQ(LKTRCU(1)+NOFF2+2), 4, SERNB, 8)
- CALL UHTOC (IQ(LDTRCU(1)+1), 4, COMNT, 40)
- WRITE (LPRTCU, 1010) SERNB, KEY1(NOFF2+1), ID1, IT1, COMNT
-*
- CALL CDFREE ('//DBL3/TRIG/TOPSER', LKTRCU(1), MSK1, KEY1,
- + CHOP1, IRC)
-*
-* ** Print the properties of that particular module
-*
- CALL VZERO (KEY2, 50)
- CALL VZERO (MSK2, 50)
- CALL UCTOH (SERNB, KEY2(NOFF2+1), 4, 8)
- CHOP2 = ' '
- MSK2(NOFF2+1) = 1
- MSK2(NOFF2+2) = 1
- CALL CDUSEM ('//DBL3/TRIG/MODPRP', LKTRCU(2), ITIME,
- + MSK2, KEY2, CHOP2, IRC)
-*
- LDTRCU(2) = LQ(LKTRCU(2)-1)
- CALL UHTOC (IQ(LKTRCU(2)+NOFF2+3), 4, STATU, 4)
- ITYP = IQ(LKTRCU(2)+NOFF2+4)
- FERA = ITYP.EQ.5
- NOBITS = IQ(LKTRCU(2)+NOFF2+5)
- RESOU1 = IQ(LKTRCU(2)+NOFF2+6)
- RESOU2 = IQ(LKTRCU(2)+NOFF2+7)
- CALL UHTOC (IQ(LDTRCU(2)+1), 4, COMNT, 40)
-*
- WRITE (LPRTCU, 1011) SERNB, STATU, ITYP, NOBITS, RESOU1,
- + RESOU2, COMNT
- IF (FERA) THEN
- WRITE (LPRTCU,1012)
- LDT = LDTRCU(2) + 15
- DO 50 I = 1, 16
- CALL UHTOC (IQ(LDT+96+I), 4, OK, 4)
- WRITE (LPRTCU, 1013) IQ(LDT+I), Q(LDT+16+I), Q(LDT+32+I)
- + , Q(LDT+48+I), Q(LDT+64+I)
- + , Q(LDT+80+I), OK
- 50 CONTINUE
- ENDIF
-*
- CALL CDFREE ('//DBL3/TRIG/MODPRP', LKTRCU(2), MSK2, KEY2,
- + CHOP2, IRC)
-*
-* ** Find all serial # which can satisfy the properties of module
-* ** First find the requested module properties
-*
- CALL VZERO (KEY3, 50)
- CALL VZERO (MSK3, 50)
- CHOP3 = 'K'
- MSK3(NOFF2+1) = 1
- KEY3(NOFF2+1) = IMOD
-*
- CALL CDUSEM ('//DBL3/TRIG/HARDCONF/MODATT', LKTRCU(3),
- + ITIME, MSK3, KEY3, CHOP3, IRC)
- ITYPE = IQ(LKTRCU(3)+NOFF2+2)
- RESOU1 = IQ(LKTRCU(3)+NOFF2+9)
- RESOU2 = IQ(LKTRCU(3)+NOFF2+10)
-*
- CALL CDFREE ('//DBL3/TRIG/HARDCONF/MODATT', LKTRCU(3), MSK3,
- + KEY3, CHOP3, IRC)
-*
-* ** Next find all the serial numbers
-*
- CHOP4 = 'VKS'
- STATU = 'Y '
- CALL VZERO (KEY4, 50)
- CALL VZERO (MSK4, 50)
- MSK4(NOFF2+3) = 1
- MSK4(NOFF2+4) = 1
- MSK4(NOFF2+6) = 1
- MSK4(NOFF2+7) = 1
- CALL UCTOH (STATU, KEY4(NOFF2+3), 4, 4)
- KEY4(NOFF2+4) = ITYPE
- KEY4(NOFF2+6) = RESOU1
- KEY4(NOFF2+7) = RESOU2
-*
- CALL CDUSEM ('//DBL3/TRIG/MODPRP', LKTRCU(4), ITIME,
- + MSK4, KEY4, CHOP4, IRC)
- WRITE (LPRTCU, 1014) IMOD
- LKT = LKTRCU(4)
- NS4 = NZBANK (IDIVCU, LKT)
- IF (NS4.GT.0) THEN
- 60 CALL UHTOC (IQ(LKT+NOFF2+1), 4, SERNB, 8)
- WRITE (LPRTCU, 1015) SERNB
- LKT = LQ(LKT)
- IF (LKT.NE.0) GO TO 60
- ENDIF
-*
- CALL CDFREE ('//DBL3/TRIG/MODPRP', LKTRCU(4), MSK4, KEY4,
- + CHOP4, IRC)
-#if defined(CERNLIB__DEBUG)
- CALL DZSHOW ('LKTRCU4 ', IDIVCU, LKTRCU(4), 'LVB', 0,0, 0,0)
-#endif
-*
- 80 LKTRCU(10) = LQ(LKTRCU(10))
- 85 CALL CDFREE ('//DBL3/TRIG/HARDCONF/MODATT', LKTRCU(6), MSK6,
- + KEY6, CHOP6, IRC)
-*
- 90 LKTRCU(9) = LQ(LKTRCU(9))
- 95 CALL CDFREE ('//DBL3/TRIG/HARDCONF/BRACAM', LKTRCU(5), MSK5,
- + KEY5, CHOP5, IRC)
-*
- 100 CONTINUE
-*
- 1001 FORMAT (/5X,' ========== Rack Number : ',I5,' =========='//)
- 1002 FORMAT (/10X,' +++ There is no Camac in this Rack !!! ')
- 1003 FORMAT (/10X,' +++ Camac Number : ',I5,' Branch Number : ',I5
- +,' +++')
- 1004 FORMAT (/15X,' --- There is NO Module in this Camac !!! ')
- 1005 FORMAT (/15X,' --- Module Number : ',I5,' ---')
- 1006 FORMAT (/10X,' ... There is NO output cable from this Module !!!')
- 1007 FORMAT (/10X,' ... Cables from plugs :',I4,' -',I4,
- + ' to module :',I8,' and plugs :',I4,' -',I4,I10,2X,A4)
- 1008 FORMAT (/10X,' ... There is NO input cable to this Module !!!')
- 1009 FORMAT (/10X,' ... Cables to plugs :',I4,' -',I4,
- + ' from module :',I8,' and plugs :',I4,' -',I4,I10,2X,A4)
- 1010 FORMAT (/2X,'Module number : ',A8,' for topological no. :',I6
- +,' and validity : ',2I7,2X,A40)
- 1011 FORMAT (/2X,'Properties of Module : ',A8,' Status Modul type'
- +,' Nobits Res.Out1 Res.Out2 Comment'/36X,A4,4X,I4,3X,3I10
- +,5X,A40)
- 1012 FORMAT (/20X,' ADC - Properties ',2X
- +,'Channel Pedest R.M.S. Slope Intercept Chi2 OK?'/)
- 1013 FORMAT (45X,I2,5F9.3,2X,A4)
- 1014 FORMAT (/20X,' --- All serial numbers for Module : ',I10,' ---'/)
- 1015 FORMAT (25X,A8)
-* END CDRL1E
- 999 END
diff --git a/src/packlib/hepdb/examples/dbexam/cdexam06/cexam06.F b/src/packlib/hepdb/examples/dbexam/cdexam06/cexam06.F
deleted file mode 100644
index 907c740..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdexam06/cexam06.F
+++ /dev/null
@@ -1,103 +0,0 @@
-*
-* $Id: cexam06.F,v 1.1.1.1 1996/02/28 16:23:49 mclareni Exp $
-*
-* $Log: cexam06.F,v $
-* Revision 1.1.1.1 1996/02/28 16:23:49 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- PROGRAM CEXAM06
-* ===============
-*
-************************************************************************
-* *
-* PROG. CEXAM06 *
-* *
-* Program to use a fictitious Trigger Data Base for energy level *
-* trigger as suggested by T. Hebecker *
-* *
-* This is an example how one can use DBL3 to imitate a relational *
-* Data base system *
-* *
-************************************************************************
-*
- PARAMETER (NLAST=150000, NDIV1=5000)
- COMMON /GCBANK/ FENCCS(22), LQ(NLAST)
-*
-#include "cuser6.inc"
-* ------------------------------------------------------------------
-*
-* *** Open the RZ-file with an Open Statement (or JCL, etc)
-*
- LUNRZ = 1
- LPRTCU = 6
- LREC = 1024
- NBYTE = 4*LREC
-#if defined(CERNLIB_IBM)
- CALL CDROPN (LUNRZ, ' ', 'DBTRIG.DATA.A4', NBYTE, IOERR)
-#endif
-#if !defined(CERNLIB_IBM)
- CALL CDROPN (LUNRZ, ' ', 'DBTRIG.DAT', NBYTE, IOERR)
-#endif
- IF (IOERR.NE.0) GO TO 999
- CALL MZEBRA (-1)
-*
-* *** Open the 1 and only 1 Store used in the reconstruction
-*
- CALL MZSTOR (ISTOCU, '/GCBANK/', ' ', FENCCS(1), LQ(1), LQ(1)
- + , LQ(1), LQ(NDIV1), LQ(NLAST))
-*
-* *** Log-Level
-*
-#if !defined(CERNLIB__DEBUG)
- CALL MZLOGL (ISTOCU, 0)
-#endif
-#if defined(CERNLIB__DEBUG)
- CALL MZLOGL (ISTOCU, 1)
-#endif
-*
-* *** Define user division and link area like:
-*
- CALL MZDIV (ISTOCU, IDIVCU, 'DB-USERS', 50000, 100000, 'L')
- CALL MZLINK (ISTOCU, '/CUSER6/', LDTRCU(1), LKTRCU(12), LDTRCU(1))
-*
-* *** Initialize DB-Package
-*
- CALL TIMEST (999999.)
- NPAIR = 1
- LUFZ = 0
- NTOP = 0
- CALL CDINIT (IDIVCU, LUNRZ, LUFZ, 'DBL3', NPAIR, NREC, NTOP,
- + ' ', IRC)
-#if !defined(CERNLIB__DEBUG)
- CALL CDLOGL ('DBL3', 0, ' ', IRC)
-#endif
-#if defined(CERNLIB__DEBUG)
- CALL CDLOGL ('DBL3', 2, ' ', IRC)
-#endif
-*
-* *** Read the Trigger Data Base - Query it for a given time IDT1
-*
- CALL TIMEX (TIMINT)
- CALL CDUVTX (IDAY, ITIM1)
- ID1 = 890101
- IT1 = 220000
- CALL CDPKTS (ID1, IT1, IDT1, IRC)
- CALL CDRL1E (IDT1)
-*
- CALL TIMEX (TIMNOW)
- TIME = TIMNOW - TIMINT
- CALL CDUVTX (IDAY, ITIM2)
- ITIME = ITIM2 - ITIM1
- WRITE (LPRTCU, 1001) IDAY, ITIM1, ITIM2, ITIME
- WRITE (LPRTCU, 1002) TIMINT, TIMNOW, TIME
-*
-* *** Close DataBase
-*
- CALL CDEND ('*', 'A', IRC)
-*
- 1001 FORMAT (/,' CEXAM06 : IDAY/ITIM1/ITIM2/ITIME ', 4I12)
- 1002 FORMAT (/,' CEXAM06 : TIMINT/TIMNOW/TIME ',4G12.4)
-* END CEXAM06
- 999 END
diff --git a/src/packlib/hepdb/examples/dbexam/cdexam06/cstor6.inc b/src/packlib/hepdb/examples/dbexam/cdexam06/cstor6.inc
deleted file mode 100644
index 92bd7fd..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdexam06/cstor6.inc
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: cstor6.inc,v 1.1.1.1 1996/02/28 16:23:49 mclareni Exp $
-*
-* $Log: cstor6.inc,v $
-* Revision 1.1.1.1 1996/02/28 16:23:49 mclareni
-* Hepdb, cdlib, etc
-*
-*
-*
-* cstor6.inc
-*
- COMMON /GCBANK/ FENCCS(22), LQ(9)
- DIMENSION IQ(2), Q(2)
- EQUIVALENCE (IQ(1),Q(1),LQ(9))
-*
- COMMON /QUEST/ IQUEST(100)
-*
diff --git a/src/packlib/hepdb/examples/dbexam/cdexam06/cuser6.inc b/src/packlib/hepdb/examples/dbexam/cdexam06/cuser6.inc
deleted file mode 100644
index 29454c0..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdexam06/cuser6.inc
+++ /dev/null
@@ -1,13 +0,0 @@
-*
-* $Id: cuser6.inc,v 1.1.1.1 1996/02/28 16:23:49 mclareni Exp $
-*
-* $Log: cuser6.inc,v $
-* Revision 1.1.1.1 1996/02/28 16:23:49 mclareni
-* Hepdb, cdlib, etc
-*
-*
-*
-* cuser6.inc
-*
- COMMON /CUSER6/ IDIVCU, ISTOCU, LPRTCU, LDTRCU(12), LKTRCU(12)
-*
diff --git a/src/packlib/hepdb/examples/dbexam/cdexam07/Imakefile b/src/packlib/hepdb/examples/dbexam/cdexam07/Imakefile
deleted file mode 100644
index e793438..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdexam07/Imakefile
+++ /dev/null
@@ -1,3 +0,0 @@
-SRCS_F= cdcruv.F cdexam07.F cexam07.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/hepdb/examples/dbexam/cdexam07/cdcruv.F b/src/packlib/hepdb/examples/dbexam/cdexam07/cdcruv.F
deleted file mode 100644
index 73fb699..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdexam07/cdcruv.F
+++ /dev/null
@@ -1,65 +0,0 @@
-*
-* $Id: cdcruv.F,v 1.1.1.1 1996/02/28 16:23:51 mclareni Exp $
-*
-* $Log: cdcruv.F,v $
-* Revision 1.1.1.1 1996/02/28 16:23:51 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDCRUV (ITIM1)
-* =========================
-*
-************************************************************************
-* *
-* SUBR. CDCRUV (ITIM1) *
-* *
-* Creates the UVDS part of the Muon Chamber Data Base *
-* *
-* Arguments : *
-* *
-* ITIM1 Start time of validity *
-* *
-* Called by CEXAM07 *
-* *
-************************************************************************
-*
-#include "cstor7.inc"
-#include "cuser7.inc"
- PARAMETER (NOFF1=10, NOFF2=12, NOFFP=6, NKEYS=NOFF2+1)
- DIMENSION KEYX(4), KEYS(NKEYS)
- DATA IPROG /1/, KEYX /4*0/, NENT /0/
- DATA XRANG / 1000.0/, XCENT / 500.0/
-*
-* ------------------------------------------------------------------
-*
- NENT = NENT + 1
- CALL CDPKTS (991231, 235959, INFIN, IRC)
-*
-* *** -------- UVDS ----------------------
-*
- NKEYU = 16
- NDAT = 48
- CALL VZERO (KEYS, NKEYS)
- KEYS(NOFF1+1) = ITIM1
- KEYS(NOFF1+2) = INFIN
- KEYS(NOFFP) = IPROG
- DO 10 K = 1, NKEYU
- CALL MZBOOK (IDIVCU, LUSECU, LUSECU, 2, 'UVDS', 0, 0, NDAT, 3,0)
- KEYS(NOFF2+1) = K
- DO 5 I = 1, NDAT
- Q(LUSECU+I) = XRANG*RNDM(Q) - XCENT
- 5 CONTINUE
- CALL CDSTOR ('//DBL3/MUCH/MCALB/UVDS', LUSECU, LKUVCU, IDIVCU,
- + KEYS, 'DP', IRC)
-#if !defined(CERNLIB__DEBUG)
- IF (NENT.LE.50 .AND. LUSECU.NE.0 .AND. K.EQ.NKEYU)
-#endif
-#if defined(CERNLIB__DEBUG)
- IF (NENT.LE.50 .AND. LUSECU.NE.0)
-#endif
- + CALL DZSHOW ('UVDS ', IDIVCU, LUSECU, 'B', 0, 0, 0, 0)
- CALL MZDROP (IDIVCU, LUSECU, ' ')
- 10 CONTINUE
-* END CDCRUV
- END
diff --git a/src/packlib/hepdb/examples/dbexam/cdexam07/cdexam07.F b/src/packlib/hepdb/examples/dbexam/cdexam07/cdexam07.F
deleted file mode 100644
index 3b9dbb7..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdexam07/cdexam07.F
+++ /dev/null
@@ -1,9 +0,0 @@
-*
-* $Id: cdexam07.F,v 1.1.1.1 1996/02/28 16:23:50 mclareni Exp $
-*
-* $Log: cdexam07.F,v $
-* Revision 1.1.1.1 1996/02/28 16:23:50 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
diff --git a/src/packlib/hepdb/examples/dbexam/cdexam07/cexam07.F b/src/packlib/hepdb/examples/dbexam/cdexam07/cexam07.F
deleted file mode 100644
index f56009d..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdexam07/cexam07.F
+++ /dev/null
@@ -1,135 +0,0 @@
-*
-* $Id: cexam07.F,v 1.1.1.1 1996/02/28 16:23:50 mclareni Exp $
-*
-* $Log: cexam07.F,v $
-* Revision 1.1.1.1 1996/02/28 16:23:50 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- PROGRAM CEXAM07
-* ===============
-*
-************************************************************************
-* *
-* PROG. CEXAM07 *
-* *
-* Program to create a fictitious database to test the partitioned *
-* directory (CDSTOR with option P at the time of creating the user *
-* directory) *
-* *
-* This program uses a different store from /GCBANK/ and hence both *
-* the user division and the ZEBRA system division refer to the new *
-* store /CSTOR7/ and tests the new feature of version 3.00 of DBL3 *
-* *
-************************************************************************
-*
- PARAMETER (NLAST=150000, NDIV1=5000)
- COMMON /CSTOR7/ FENCCS(22), LQ(NLAST)
- COMMON /QUEST/ IQUEST(100)
-*
-#include "cuser7.inc"
-* ------------------------------------------------------------------
-*
-* *** Open the RZ-file with an Open Statement (or JCL, etc)
-*
- LUNRZ = 1
- LPRTCU = 6
- NREC = 1000
- LREC = 1024
- NBYTE = 4*LREC
-#if defined(CERNLIB_IBM)
- CALL CDROPN (LUNRZ, 'ZO', 'DBUVDS.DATA.A4', NBYTE, IOERR)
-#endif
-#if !defined(CERNLIB_IBM)
- CALL CDROPN (LUNRZ, 'ZO', 'DBUVDS.DAT', NBYTE, IOERR)
-#endif
- IF (IOERR.NE.0) GO TO 999
- CALL MZEBRA(-1)
-*
-* *** Open the 1 and only 1 Store used in the reconstruction
-*
- CALL MZSTOR (ISTOCU, '/CSTOR7/', ' ', FENCCS(1), LQ(1), LQ(1)
- + , LQ(1), LQ(NDIV1), LQ(NLAST))
-*
-* *** Log-Level
-*
-#if !defined(CERNLIB__DEBUG)
- CALL MZLOGL (ISTOCU, 0)
-#endif
-#if defined(CERNLIB__DEBUG)
- CALL MZLOGL (ISTOCU, 1)
-#endif
-*
-* *** Define user division and link area like:
-*
- CALL MZDIV (ISTOCU, IDIVCU, 'DB-USERS', 50000, 100000, 'L')
- CALL MZLINK (ISTOCU, '/CUSER7/', LDUVCU, LUSECU, LDUVCU)
-*
-* *** Expand the system-division to its maximum
-*
- LARGE = NLAST/2
- IDIVS = IDIVCU - 1
- CALL MZNEED (IDIVS, LARGE, 'G')
- ND = LARGE + IQUEST(11) - 20
- IF (ND.GT.0) THEN
- CALL MZBOOK (IDIVS, L, 0, 2, 'DUMY', 0, 0, ND, 2, -1)
- CALL MZDROP (IDIVS, L, ' ')
- ENDIF
-*
-* *** Initialize DB-Package
-*
- CALL TIMEST (999999.)
- NPAIR = 1
- LUFZ = 0
- NTOP = 0
- CALL CDINIT (IDIVCU, LUNRZ, LUFZ, 'DBL3', NPAIR, NREC, NTOP,
- + 'UZ', IRC)
-#if !defined(CERNLIB__DEBUG)
- CALL CDLOGL ('DBL3', 0, ' ', IRC)
-#endif
-#if defined(CERNLIB__DEBUG)
- CALL CDLOGL ('DBL3', 2, ' ', IRC)
-#endif
-*
-* *** Create the Data Base with partitioned directory
-*
- IPREC = 3
- DELTA = 0.
- CALL CDMDIR ('//DBL3/MUCH/MCALB/UVDS', 1, 'I', 'US_KEY_1', 200,
- + IPREC, DELTA, 'CP', IRC)
- IYEAR = 80
- MONTH = 1
- IDAY = 1
- CALL TIMEX (TIMINT)
- CALL CDUVTX (IDATE, ITIM1)
- DO 10 I = 1, 500
- IDATX = IYEAR*10000 + MONTH*100 + IDAY
- CALL CDPKTS (IDATX, 0, ISTRV, IRC)
- CALL CDCRUV (ISTRV)
- IDAY = IDAY + 10
- IF (IDAY.GT.25) THEN
- MONTH = MONTH + 1
- IDAY = 1
- IF (MONTH.GT.12) THEN
- IYEAR = IYEAR + 1
- MONTH = 1
- ENDIF
- ENDIF
- 10 CONTINUE
-*
- CALL TIMEX (TIMNOW)
- TIME = TIMNOW - TIMINT
- CALL CDUVTX (IDATE, ITIM2)
- ITIME = ITIM2 - ITIM1
- WRITE (LPRTCU, 1001) IDATE, ITIM1, ITIM2, ITIME
- WRITE (LPRTCU, 1002) TIMINT, TIMNOW, TIME
-*
-* *** Close Data Base
-*
- CALL CDEND ('*', 'A', IRC)
-*
- 1001 FORMAT (/,' CEXAM07 : IDAY/ITIM1/ITIM2/ITIME ', 4I12)
- 1002 FORMAT (/,' CEXAM07 : TIMINT/TIMNOW/TIME ',4G12.4)
-* END CEXAM07
- 999 END
diff --git a/src/packlib/hepdb/examples/dbexam/cdexam07/cstor7.inc b/src/packlib/hepdb/examples/dbexam/cdexam07/cstor7.inc
deleted file mode 100644
index 55adaf9..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdexam07/cstor7.inc
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: cstor7.inc,v 1.1.1.1 1996/02/28 16:23:50 mclareni Exp $
-*
-* $Log: cstor7.inc,v $
-* Revision 1.1.1.1 1996/02/28 16:23:50 mclareni
-* Hepdb, cdlib, etc
-*
-*
-*
-* cstor7.inc
-*
- COMMON /CSTOR7/ FENCCS(22), LQ(9)
- DIMENSION IQ(2), Q(2)
- EQUIVALENCE (IQ(1),Q(1),LQ(9))
-*
- COMMON /QUEST/ IQUEST(100)
-*
diff --git a/src/packlib/hepdb/examples/dbexam/cdexam07/cuser7.inc b/src/packlib/hepdb/examples/dbexam/cdexam07/cuser7.inc
deleted file mode 100644
index e11b5da..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdexam07/cuser7.inc
+++ /dev/null
@@ -1,13 +0,0 @@
-*
-* $Id: cuser7.inc,v 1.1.1.1 1996/02/28 16:23:50 mclareni Exp $
-*
-* $Log: cuser7.inc,v $
-* Revision 1.1.1.1 1996/02/28 16:23:50 mclareni
-* Hepdb, cdlib, etc
-*
-*
-*
-* cuser7.inc
-*
- COMMON /CUSER7/ ISTOCU, IDIVCU, LPRTCU, LDUVCU, LKUVCU, LUSECU
-*
diff --git a/src/packlib/hepdb/examples/dbexam/cdexam08/Imakefile b/src/packlib/hepdb/examples/dbexam/cdexam08/Imakefile
deleted file mode 100644
index 1edada7..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdexam08/Imakefile
+++ /dev/null
@@ -1,3 +0,0 @@
-SRCS_F= cdexam08.F cdonuv.F cdptes.F cexam08.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/hepdb/examples/dbexam/cdexam08/cdexam08.F b/src/packlib/hepdb/examples/dbexam/cdexam08/cdexam08.F
deleted file mode 100644
index 1f989ef..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdexam08/cdexam08.F
+++ /dev/null
@@ -1,9 +0,0 @@
-*
-* $Id: cdexam08.F,v 1.1.1.1 1996/02/28 16:23:51 mclareni Exp $
-*
-* $Log: cdexam08.F,v $
-* Revision 1.1.1.1 1996/02/28 16:23:51 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
diff --git a/src/packlib/hepdb/examples/dbexam/cdexam08/cdonuv.F b/src/packlib/hepdb/examples/dbexam/cdexam08/cdonuv.F
deleted file mode 100644
index 3dc508f..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdexam08/cdonuv.F
+++ /dev/null
@@ -1,73 +0,0 @@
-*
-* $Id: cdonuv.F,v 1.1.1.1 1996/02/28 16:23:52 mclareni Exp $
-*
-* $Log: cdonuv.F,v $
-* Revision 1.1.1.1 1996/02/28 16:23:52 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDONUV (ITIME)
-* =========================
-*
-************************************************************************
-* *
-* SUBR. CDONUV (ITIME) *
-* *
-* Tests CDUSEM on the imitation of the Muon Data Base *
-* *
-* Arguments : *
-* *
-* ITIME Validity time *
-* *
-* Called by CEXAM08 *
-* *
-************************************************************************
-*
-#include "cstor8.inc"
-#include "cuser8.inc"
- PARAMETER (NOFF1=10, NOFF2=12, NOFFP=6, NKEYS=NOFF2+1)
- DIMENSION KEYS(100), MASK(100)
- CHARACTER CHOPT*4
- DATA NENT /0/
-*
-* ------------------------------------------------------------------
-*
- CALL VZERO (KEYS, NKEYS)
- CALL VZERO (MASK, NKEYS)
-*
-* *** -------------- UVDS ---------------------
-*
- MASK(NOFF2+1) = 1
- KEYS(NOFF2+1) = 16
- IF (ITIME.EQ.0) THEN
- CALL CDBOOK ('//DBL3/MUCH/MCALB/UVDS', LKUVCU(1), KEYS(NOFF2+1),
- + ' ', IRC)
- DO 5 I = 1, KEYS(NOFF2+1)
- IQ(LKUVCU(I)+NOFF2+1) = I
- IF (I.NE.KEYS(NOFF2+1)) LKUVCU(I+1) = LQ(LKUVCU(I))
- 5 CONTINUE
- GO TO 999
- ENDIF
- NENT = NENT + 1
- CHOPT = 'M'
- CALL CDUSEM ('//DBL3/MUCH/MCALB/UVDS', LKUVCU(1), ITIME,
- + MASK, KEYS, CHOPT, IRC)
- DO 10 I = 1, KEYS(NOFF2+1)
- IF (LKUVCU(I).GT.0) THEN
- LDUVCU(I) = LQ(LKUVCU(I)-1)
- ELSE
- LDUVCU(I) = 0
- ENDIF
-#if !defined(CERNLIB__DEBUG)
- IF (NENT.LE.50.AND.LDUVCU(I).NE.0.AND.I.EQ.KEYS(NOFF2+1))
-#endif
-#if defined(CERNLIB__DEBUG)
- IF (NENT.LE.50.AND.LDUVCU(I).NE.0)
-#endif
- + CALL DZSHOW ('UVDS ', IDIVCU, LDUVCU(I), 'V', 0, 0, 0, 0)
- 10 CONTINUE
- CALL CDFREE ('//DBL3/MUCH/MCALB/UVDS', LKUVCU, MASK, KEYS, CHOPT,
- + IRC)
-* END CDONUV
- 999 END
diff --git a/src/packlib/hepdb/examples/dbexam/cdexam08/cdptes.F b/src/packlib/hepdb/examples/dbexam/cdexam08/cdptes.F
deleted file mode 100644
index 4bcd162..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdexam08/cdptes.F
+++ /dev/null
@@ -1,63 +0,0 @@
-*
-* $Id: cdptes.F,v 1.1.1.1 1996/02/28 16:23:52 mclareni Exp $
-*
-* $Log: cdptes.F,v $
-* Revision 1.1.1.1 1996/02/28 16:23:52 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDPTES
-*
-* =================
-*
-************************************************************************
-* *
-* SUBR. CDPTES *
-* *
-* Tests the routine CDPLTI and CDPLOB on the fictitious data base *
-* *
-* Called by CEXAM08 *
-* *
-************************************************************************
-*
- PARAMETER (NPAWC=20000)
- COMMON /PAWC/ HMEMOR(NPAWC)
- PARAMETER (NOFF1=10, NOFF2=12, NOFFP=6, NKEYS=NOFF2+1)
- DIMENSION KEYS(NKEYS), MASK(NKEYS), KOBJ(10)
- CHARACTER CFNAM*20
-* ------------------------------------------------------------------
-*
-* *** Initialize HPLOT
-*
- LUMET = 2
-#if defined(CERNLIB_IBMVM)
- CFNAM = 'CEXAM08.META.A1'
-#endif
-#if !defined(CERNLIB_IBMVM)
- CFNAM = 'CEXAM08.META'
-#endif
-#if defined(CERNLIB_APOLLO)||defined(CERNLIB_UNIX)
- CALL CUTOL (CFNAM)
-#endif
- CALL CDOPFL (LUMET, CFNAM, 'UNKNOWN', IOERR)
- CALL HLIMIT (-NPAWC)
- CALL HPLINT (0)
- CALL HPLCAP (-LUMET)
-*
- CALL VZERO (MASK, NKEYS)
- CALL VZERO (KEYS, NKEYS)
- KEYS (NOFF2+1) = 1
- MASK (NOFF2+1) = 1
- CALL CDPLTI ('//DBL3/MUCH/MCALB/UVDS', MASK, KEYS, 'X', IRC)
- CALL IGSA (1)
- KOBJ (1) = 1
- KOBJ (2) = 3
- KEYBV = NOFF1 + 1
- CALL CDPLOB ('//DBL3/MUCH/MCALB/UVDS', MASK, KEYS, 2, KOBJ, KEYBV,
- + 1, 'X', IRC)
- CALL IGSA (1)
-*
- CALL HPLEND
-* END CDPTES
- END
diff --git a/src/packlib/hepdb/examples/dbexam/cdexam08/cexam08.F b/src/packlib/hepdb/examples/dbexam/cdexam08/cexam08.F
deleted file mode 100644
index 40c4ae2..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdexam08/cexam08.F
+++ /dev/null
@@ -1,153 +0,0 @@
-*
-* $Id: cexam08.F,v 1.1.1.1 1996/02/28 16:23:51 mclareni Exp $
-*
-* $Log: cexam08.F,v $
-* Revision 1.1.1.1 1996/02/28 16:23:51 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- PROGRAM CEXAM08
-* ===============
-*
-************************************************************************
-* *
-* PROG. CEXAM08 *
-* *
-* Program to debug CDUSEM on a fictitious Data Base for partitioned *
-* directories *
-* *
-* This program uses /CSTOR1/ as store 1 (ZEBRA store 0) where the *
-* ZEBRA system division is created and /CSTOR8/ as store 2 (ZEBRA *
-* store 1) where the DB-divisions (both system and user) are *
-* created. This tests the complete generality of DBL3 (independence *
-* from store allocation). The user can make use of this example to *
-* initialize the store(s) and DBL3 for his own application program. *
-* *
-************************************************************************
-*
- PARAMETER (NLAS1=100000, NLAS2=150000, NDIV1=5000)
- COMMON /CSTOR1/ IFENC1(4), LQ1(NLAS1)
- COMMON /CSTOR8/ IFENC2(22), LQ2(NLAS2)
- COMMON /QUEST/ IQUEST(100)
-#include "cuser8.inc"
- CHARACTER CHOPT*8
-*
-* ------------------------------------------------------------------
-*
-* *** Open the RZ-file with an Open Statement (or JCL, etc)
-*
- LUNRZ = 1
- LPRTCU = 6
- LREC = 1024
- NBYTE = 4*LREC
- NREC = 0
-#if defined(CERNLIB_IBM)
- CALL CDROPN (LUNRZ, ' ', 'DBUVDS.DATA.A4', NBYTE, IOERR)
-#endif
-#if !defined(CERNLIB_IBM)
- CALL CDROPN (LUNRZ, ' ', 'DBUVDS.DAT', NBYTE, IOERR)
-#endif
- IF (IOERR.NE.0) GO TO 999
- CALL MZEBRA (-1)
-*
-* *** Open two Stores one for system and one for user division
-*
- CALL MZSTOR (IST1DU, '/CSTOR1/', ' ', IFENC1(1), LQ1(1), LQ1(1)
- + , LQ1(1), LQ1(NDIV1), LQ1(NLAS1))
- CALL MZSTOR (IST2DU, '/CSTOR8/', ' ', IFENC2(1), LQ2(1), LQ2(1)
- + , LQ2(1), LQ2(NDIV1), LQ2(NLAS2))
-*
-* *** Log-Level
-*
-#if !defined(CERNLIB__DEBUG)
- CALL MZLOGL (IST1DU, 0)
- CALL MZLOGL (IST2DU, 0)
-#endif
-#if defined(CERNLIB__DEBUG)
- CALL MZLOGL (IST1DU, 1)
- CALL MZLOGL (IST2DU, 1)
-#endif
-*
-* *** Define user division and link area like:
-*
- CALL MZDIV (IST2DU, IDIVCU, 'DB-USERS', 20000, 30000, 'L')
- CALL MZLINK (IST2DU, '/CUSER8/', LDUVCU(1), LKUVCU(16), LDUVCU(1))
-*
-* *** Expand the system-division to its maximum
-*
- LARGE = NLAS1/2
- IDIVS = 20
- CALL MZNEED (IDIVS, LARGE, 'G')
- ND = LARGE + IQUEST(11) - 20
- IF (ND.GT.0) THEN
- CALL MZBOOK (IDIVS, L, 0, 2, 'DUMY', 0, 0, ND, 2, -1)
- CALL MZDROP (IDIVS, L, ' ')
- ENDIF
-*
-* *** Initialize DB-Package
-*
- CALL TIMEST (999999.)
- NPAIR = 1
- LUFZ = 0
- NTOP = 0
- CALL CDINIT (IDIVCU, LUNRZ, LUFZ, 'DBL3', NPAIR, NREC, NTOP,
- + ' ', IRC)
-#if !defined(CERNLIB__DEBUG)
- CALL CDLOGL ('DBL3', 0, ' ', IRC)
-#endif
-#if defined(CERNLIB__DEBUG)
- CALL CDLOGL ('DBL3', 2, ' ', IRC)
- CALL DZSTOR ('CSTOR8', IST2DU)
- CALL DZAREA ('DB-LINKS', IST2DU, ' ', 0, ' ')
-#endif
-*
-* *** Read the Partitioned Data Base
-*
- IYEAR = 80
- MONTH = 1
- IDAY = 3
- CALL TIMEX (TIMINT)
- CALL CDUVTX (IDATE, ITIM1)
- CALL CDONUV (0)
- DO 10 I = 1, 100
- IDATX = IYEAR*10000 + MONTH*100 + IDAY
- CALL CDPKTS (IDATX, 0, ITIME, IRC)
- CALL CDONUV (ITIME)
- IDAY = IDAY + 10
- IF (IDAY.GT.25) THEN
- MONTH = MONTH + 1
- IDAY = 3
- IF (MONTH.GT.12) THEN
- IYEAR = IYEAR + 1
- MONTH = 1
- ENDIF
- ENDIF
- 10 CONTINUE
-*
- CALL TIMEX (TIMNOW)
- TIME = TIMNOW - TIMINT
- CALL CDUVTX (IDATE, ITIM2)
- ITIME = ITIM2 - ITIM1
- WRITE (LPRTCU, 1001) IDATE, ITIM1, ITIM2, ITIME
- WRITE (LPRTCU, 1002) TIMINT, TIMNOW, TIME
-#if defined(CERNLIB__DEBUG)
-*
-* *** Test subroutine CDPRIN
-*
- CHOPT = 'K'
- CALL CDPRIN ('//DBL3/MUCH/MCALB/UVDS', CHOPT, IRC)
-#endif
-*
-* *** Plot some data objects and validity period
-*
- CALL CDPTES
-*
-* *** Close DataBase
-*
- CALL CDEND ('*', 'A', IRC)
-*
- 1001 FORMAT (/,' CEXAM08 : IDAY/ITIM1/ITIM2/ITIME ', 4I12)
- 1002 FORMAT (/,' CEXAM08 : TIMINT/TIMNOW/TIME ',4G12.4)
-* END CEXAM08
- 999 END
diff --git a/src/packlib/hepdb/examples/dbexam/cdexam08/cstor8.inc b/src/packlib/hepdb/examples/dbexam/cdexam08/cstor8.inc
deleted file mode 100644
index 4e1a8b6..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdexam08/cstor8.inc
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: cstor8.inc,v 1.1.1.1 1996/02/28 16:23:51 mclareni Exp $
-*
-* $Log: cstor8.inc,v $
-* Revision 1.1.1.1 1996/02/28 16:23:51 mclareni
-* Hepdb, cdlib, etc
-*
-*
-*
-* cstor8.inc
-*
- COMMON /CSTOR8/ FENCCS(22), LQ(9)
- DIMENSION IQ(2), Q(2)
- EQUIVALENCE (IQ(1),Q(1),LQ(9))
-*
- COMMON /QUEST/ IQUEST(100)
-*
diff --git a/src/packlib/hepdb/examples/dbexam/cdexam08/cuser8.inc b/src/packlib/hepdb/examples/dbexam/cdexam08/cuser8.inc
deleted file mode 100644
index 6ed98d8..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdexam08/cuser8.inc
+++ /dev/null
@@ -1,14 +0,0 @@
-*
-* $Id: cuser8.inc,v 1.1.1.1 1996/02/28 16:23:51 mclareni Exp $
-*
-* $Log: cuser8.inc,v $
-* Revision 1.1.1.1 1996/02/28 16:23:51 mclareni
-* Hepdb, cdlib, etc
-*
-*
-*
-* cuser8.inc
-*
- COMMON /CUSER8/ IDIVCU, IST1DU, IST2DU, LPRTCU, LDUVCU(16)
- + , LKUVCU(16)
-*
diff --git a/src/packlib/hepdb/examples/dbexam/cdexam09/Imakefile b/src/packlib/hepdb/examples/dbexam/cdexam09/Imakefile
deleted file mode 100644
index e115cd0..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdexam09/Imakefile
+++ /dev/null
@@ -1,4 +0,0 @@
-SRCS_F= cdbkin.F cdexam09.F cduvd1.F cduvd2.F cduvd3.F \ @@\
- cduvd4.F cduvdt.F cexam09.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/hepdb/examples/dbexam/cdexam09/cdbkin.F b/src/packlib/hepdb/examples/dbexam/cdexam09/cdbkin.F
deleted file mode 100644
index 866a604..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdexam09/cdbkin.F
+++ /dev/null
@@ -1,79 +0,0 @@
-*
-* $Id: cdbkin.F,v 1.1.1.1 1996/02/28 16:23:53 mclareni Exp $
-*
-* $Log: cdbkin.F,v $
-* Revision 1.1.1.1 1996/02/28 16:23:53 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDBKIN (PATHN, KEY1S, IUDIV, LBD, LSUP, JBIAS, IRC)
-* ==============================================================
-*
-************************************************************************
-* *
-* SUBR. CDBKIN (PATHN, KEY1S, IUDIV, LBD*, LSUP, JBIAS, IRC*) *
-* *
-* Fetches from disk to a ZEBRA bank data valid for a given Key *
-* serial number (as stored inside the directory) *
-* *
-* Arguments : *
-* *
-* PATHN Character string describing the pathname *
-* KEY1S Serial number of the data to be fetched *
-* IUDIV Division index where bank is expected *
-* LBD(*) Address of the bank in memory *
-* LSUP Supporting link of the bank (see MZBOOK) *
-* JBIAS Link bias for creating the data bank (see MZBOOK) *
-* IRC(*) Return Code *
-* 0 : No error *
-* 31 : Illegal path name *
-* 32 : No key or data in the path name *
-* *
-* Called by user *
-* *
-************************************************************************
-*
-#include "caopts.inc"
-#include "cdcblk.inc"
-#include "ckkeys.inc"
-#include "ctpath.inc"
- DIMENSION LSUP(9), LBD(9), ITIME(MXPACD)
- CHARACTER PATH*80, PATHN*(*)
-*
-* ------------------------------------------------------------------
-*
-* *** Set the character option
-*
- CALL CDOPTS (' ', IRC)
- IF (IRC.NE.0) GO TO 900
- IOKYCA(IDHKSN) = 1
-*
-* *** Set the current directory
-*
- CALL CDLDUP (PATHN, 0, IRC)
- IF (IRC.NE.0) GO TO 900
- DO 10 I = 1, NPARCD
- ITIME(I) = 1
- 10 CONTINUE
- CALL CDKEYT
-*
- IF (NKEYCK.LE.0) THEN
- IRC = 32
-#if defined(CERNLIB__DEBUG)
- NCHAR = LENOCC (PAT1CT)
- IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDBKIN : No key '//
- + 'or data for Path Name '//PAT1CT(1:NCHAR)//''')', IARGCD, 0)
-#endif
- GO TO 900
- ENDIF
-*
-* *** Read in the data
-*
- CALL VZERO (KEYVCK, NWKYCK)
- KEYVCK(IDHKSN) = KEY1S
- CALL CDKXIN (ITIME, IUDIV, LBD(1), LSUP(1), JBIAS, NWKEY, KEYVCK,
- + IPREC, IRC)
- 900 IOKYCA(IDHKSN) = 0
-* END CDBKIN
- 999 END
diff --git a/src/packlib/hepdb/examples/dbexam/cdexam09/cdexam09.F b/src/packlib/hepdb/examples/dbexam/cdexam09/cdexam09.F
deleted file mode 100644
index 99bf717..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdexam09/cdexam09.F
+++ /dev/null
@@ -1,9 +0,0 @@
-*
-* $Id: cdexam09.F,v 1.1.1.1 1996/02/28 16:23:52 mclareni Exp $
-*
-* $Log: cdexam09.F,v $
-* Revision 1.1.1.1 1996/02/28 16:23:52 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
diff --git a/src/packlib/hepdb/examples/dbexam/cdexam09/cduvd1.F b/src/packlib/hepdb/examples/dbexam/cdexam09/cduvd1.F
deleted file mode 100644
index c8a991d..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdexam09/cduvd1.F
+++ /dev/null
@@ -1,51 +0,0 @@
-*
-* $Id: cduvd1.F,v 1.1.1.1 1996/02/28 16:23:52 mclareni Exp $
-*
-* $Log: cduvd1.F,v $
-* Revision 1.1.1.1 1996/02/28 16:23:52 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDUVD1
-* =================
-*
-************************************************************************
-* *
-* SUBR. CDUVD1 *
-* *
-* Stores objects in the UVD1 subdirectory using CDSTOR *
-* *
-* Called by CEXAM09 *
-* *
-************************************************************************
-*
-#include "cstor9.inc"
-#include "cuser9.inc"
-* ------------------------------------------------------------------
-*
-* *** Get Real time at the beginning of the loop
-*
- CALL TIMEX (TIMINT)
- CALL CDUVTX (IDAY, ITIM1)
-*
-* *** Now save the objects
-*
- DO 10 K = 1, NOBJCU
- CALL CDSTOR ('//DBL3/DBMU/MCALB/UVD1', LUSECU(K), LKUVCU,
- + IDIVCU, KEYSCU(1,K), 'DY', IRC)
- 10 CONTINUE
-*
-* *** Get Real time at the end of the loop
-*
- CALL TIMEX (TIMNOW)
- TIME = TIMNOW - TIMINT
- CALL CDUVTX (IDAY, ITIM2)
- ITIME = ITIM2 - ITIM1
- WRITE (LPRTCU, 1001) IDAY, ITIM1, ITIM2, ITIME
- WRITE (LPRTCU, 1002) TIMINT, TIMNOW, TIME
-*
- 1001 FORMAT (/,' CDUVD1 : IDAY/ITIM1/ITIM2/ITIME ', 4I12)
- 1002 FORMAT (/,' CDUVD1 : TIMINT/TIMNOW/TIME ',4G12.4)
-* END CDUVD1
- END
diff --git a/src/packlib/hepdb/examples/dbexam/cdexam09/cduvd2.F b/src/packlib/hepdb/examples/dbexam/cdexam09/cduvd2.F
deleted file mode 100644
index d4f009f..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdexam09/cduvd2.F
+++ /dev/null
@@ -1,49 +0,0 @@
-*
-* $Id: cduvd2.F,v 1.1.1.1 1996/02/28 16:23:53 mclareni Exp $
-*
-* $Log: cduvd2.F,v $
-* Revision 1.1.1.1 1996/02/28 16:23:53 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDUVD2
-* =================
-*
-************************************************************************
-* *
-* SUBR. CDUVD2 *
-* *
-* Stores objects in the UVD2 subdirectory using CDSTOM *
-* *
-* Called by CEXAM09 *
-* *
-************************************************************************
-*
-#include "cstor9.inc"
-#include "cuser9.inc"
-* ------------------------------------------------------------------
-*
-* *** Get Real time at the beginning of the loop
-*
- CALL TIMEX (TIMINT)
- CALL CDUVTX (IDAY, ITIM1)
-*
-* *** Now save the objects
-*
- CALL CDSTOM ('//DBL3/DBMU/MCALB/UVD2', LUSECU, LKBKCU, IDIVCU,
- + NKEYCU, NOBJCU, KEYSCU, KEYSCU, 'DY', IRC)
-*
-* *** Get Real time at the end of the loop
-*
- CALL TIMEX (TIMNOW)
- TIME = TIMNOW - TIMINT
- CALL CDUVTX (IDAY, ITIM2)
- ITIME = ITIM2 - ITIM1
- WRITE (LPRTCU, 1001) IDAY, ITIM1, ITIM2, ITIME
- WRITE (LPRTCU, 1002) TIMINT, TIMNOW, TIME
-*
- 1001 FORMAT (/,' CDUVD2 : IDAY/ITIM1/ITIM2/ITIME ', 4I12)
- 1002 FORMAT (/,' CDUVD2 : TIMINT/TIMNOW/TIME ',4G12.4)
-* END CDUVD2
- END
diff --git a/src/packlib/hepdb/examples/dbexam/cdexam09/cduvd3.F b/src/packlib/hepdb/examples/dbexam/cdexam09/cduvd3.F
deleted file mode 100644
index 35f5e8e..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdexam09/cduvd3.F
+++ /dev/null
@@ -1,51 +0,0 @@
-*
-* $Id: cduvd3.F,v 1.1.1.1 1996/02/28 16:23:53 mclareni Exp $
-*
-* $Log: cduvd3.F,v $
-* Revision 1.1.1.1 1996/02/28 16:23:53 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDUVD3
-* =================
-*
-************************************************************************
-* *
-* SUBR. CDUVD3 *
-* *
-* Stores objects in the UVD3 subdirectory using CDSTOR (with update) *
-* *
-* Called by CEXAM09 *
-* *
-************************************************************************
-*
-#include "cstor9.inc"
-#include "cuser9.inc"
-* ------------------------------------------------------------------
-*
-* *** Get Real time at the beginning of the loop
-*
- CALL TIMEX (TIMINT)
- CALL CDUVTX (IDAY, ITIM1)
-*
-* *** Now save the objects
-*
- DO 10 K = 1, NOBJCU
- CALL CDSTOR ('//DBL3/DBMU/MCALB/UVD3', LUSECU(K), LKUVCU,
- + IDIVCU, KEYSCU(1,K), 'DP', IRC)
- 10 CONTINUE
-*
-* *** Get Real time at the end of the loop
-*
- CALL TIMEX (TIMNOW)
- TIME = TIMNOW - TIMINT
- CALL CDUVTX (IDAY, ITIM2)
- ITIME = ITIM2 - ITIM1
- WRITE (LPRTCU, 1001) IDAY, ITIM1, ITIM2, ITIME
- WRITE (LPRTCU, 1002) TIMINT, TIMNOW, TIME
-*
- 1001 FORMAT (/,' CDUVD3 : IDAY/ITIM1/ITIM2/ITIME ', 4I12)
- 1002 FORMAT (/,' CDUVD3 : TIMINT/TIMNOW/TIME ',4G12.4)
-* END CDUVD3
- END
diff --git a/src/packlib/hepdb/examples/dbexam/cdexam09/cduvd4.F b/src/packlib/hepdb/examples/dbexam/cdexam09/cduvd4.F
deleted file mode 100644
index 9d5c28b..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdexam09/cduvd4.F
+++ /dev/null
@@ -1,49 +0,0 @@
-*
-* $Id: cduvd4.F,v 1.1.1.1 1996/02/28 16:23:53 mclareni Exp $
-*
-* $Log: cduvd4.F,v $
-* Revision 1.1.1.1 1996/02/28 16:23:53 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDUVD4
-* =================
-*
-************************************************************************
-* *
-* SUBR. CDUVD4 *
-* *
-* Stores objects in the UVD4 subdirectory using CDSTOM (with update) *
-* *
-* Called by CEXAM09 *
-* *
-************************************************************************
-*
-#include "cstor9.inc"
-#include "cuser9.inc"
-* ------------------------------------------------------------------
-*
-* *** Get Real time at the beginning of the loop
-*
- CALL TIMEX (TIMINT)
- CALL CDUVTX (IDAY, ITIM1)
-*
-* *** Now save the objects
-*
- CALL CDSTOM ('//DBL3/DBMU/MCALB/UVD4', LUSECU, LKBKCU, IDIVCU,
- + NKEYCU, NOBJCU, KEYSCU, KEYSCU, 'DP', IRC)
-*
-* *** Get Real time at the end of the loop
-*
- CALL TIMEX (TIMNOW)
- TIME = TIMNOW - TIMINT
- CALL CDUVTX (IDAY, ITIM2)
- ITIME = ITIM2 - ITIM1
- WRITE (LPRTCU, 1001) IDAY, ITIM1, ITIM2, ITIME
- WRITE (LPRTCU, 1002) TIMINT, TIMNOW, TIME
-*
- 1001 FORMAT (/,' CDUVD4 : IDAY/ITIM1/ITIM2/ITIME ', 4I12)
- 1002 FORMAT (/,' CDUVD4 : TIMINT/TIMNOW/TIME ',4G12.4)
-* END CDUVD4
- END
diff --git a/src/packlib/hepdb/examples/dbexam/cdexam09/cduvdt.F b/src/packlib/hepdb/examples/dbexam/cdexam09/cduvdt.F
deleted file mode 100644
index 7e7e810..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdexam09/cduvdt.F
+++ /dev/null
@@ -1,200 +0,0 @@
-*
-* $Id: cduvdt.F,v 1.1.1.1 1996/02/28 16:23:53 mclareni Exp $
-*
-* $Log: cduvdt.F,v $
-* Revision 1.1.1.1 1996/02/28 16:23:53 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDUVDT
-* =================
-*
-************************************************************************
-* *
-* SUBR. CDUVDT *
-* *
-* Tests the objects stored in the directories *
-* *
-* Called by CEXAM09 *
-* *
-************************************************************************
-*
-#include "ckkeys.inc"
-#include "cstor9.inc"
-#include "cuser9.inc"
- CHARACTER PATHN*30
- PARAMETER (NOFFP=6)
-*
-* ------------------------------------------------------------------
-*
-* *** Get Real time at the beginning of the loop
-*
- CALL TIMEX (TIMINT)
- CALL CDUVTX (IDAY, ITIM1)
-*
-* *** Now test the first directory
-*
- PATHN = '//DBL3/DBMU/MCALB/UVD1'
- WRITE (LPRTCU, 1003) PATHN
- NERR = 0
- DO 20 IOBJ = 1, NOBJCU
- IERR = 0
- KEY1S = IOBJ
- NDAT = IQ(LUSECU(IOBJ)-1)
- CALL CDBKIN (PATHN, KEY1S, IDIVCU, LDUVCU, LKUVCU, 2, IRC)
- NDATD = IQ(LDUVCU-1)
- DO 10 K = 1, NKEYCU
- IF (K.GE.NOFFP.AND.KEYVCK(K).NE.KEYSCU(K,IOBJ)) IERR = IERR +1
- 10 CONTINUE
- IF (NDAT.NE.NDATD) THEN
- IERR = IERR + 1
- ELSE
- DO 15 I = 1, NDAT
- DIFF = (Q(LUSECU(IOBJ)+I) - Q(LDUVCU+I)) / AMAX1
- + (ABS(Q(LDUVCU+I)), ABS(Q(LUSECU(IOBJ)+I)), 1.0E-12)
- IF (ABS(DIFF).GT.0.01) IERR = IERR + 1
- 15 CONTINUE
- ENDIF
- IF (IERR.GT.0) THEN
- NERR = NERR + 1
-#if defined(CERNLIB__DEBUG)
- WRITE (LPRTCU, 1004) (KEYSCU(K,IOBJ), K = 1, NKEYCU)
- WRITE (LPRTCU, 1005) (KEYVDK(K), K = 1, NKEYCU)
- WRITE (LPRTCU, 1006) NDAT, (Q(LUSECU(IOBJ)+I), I = 1, NDAT)
- WRITE (LPRTCU, 1007) NDATD, (Q(LDUVCU+I), I = 1, NDATD)
-#endif
- ENDIF
- IF (LDUVCU.GT.0) CALL MZDROP (ISTOCU, LDUVCU, 'L')
- 20 CONTINUE
- WRITE (LPRTCU, 1008) NERR, NOBJCU
-*
-* *** Now test the second directory
-*
- PATHN = '//DBL3/DBMU/MCALB/UVD2'
- WRITE (LPRTCU, 1003) PATHN
- NERR = 0
- DO 40 IOBJ = 1, NOBJCU
- IERR = 0
- KEY1S = IOBJ
- NDAT = IQ(LUSECU(IOBJ)-1)
- CALL CDBKIN (PATHN, KEY1S, IDIVCU, LDUVCU, LKUVCU, 2, IRC)
- NDATD = IQ(LDUVCU-1)
- DO 30 K = 1, NKEYCU
- IF (K.GE.NOFFP.AND.KEYVCK(K).NE.KEYSCU(K,IOBJ)) IERR = IERR +1
- 30 CONTINUE
- IF (NDAT.NE.NDATD) THEN
- IERR = IERR + 1
- ELSE
- DO 35 I = 1, NDAT
- DIFF = (Q(LUSECU(IOBJ)+I) - Q(LDUVCU+I)) / AMAX1
- + (ABS(Q(LDUVCU+I)), ABS(Q(LUSECU(IOBJ)+I)), 1.0E-12)
- IF (ABS(DIFF).GT.0.01) IERR = IERR + 1
- 35 CONTINUE
- ENDIF
- IF (IERR.GT.0) THEN
- NERR = NERR + 1
-#if defined(CERNLIB__DEBUG)
- WRITE (LPRTCU, 1004) (KEYSCU(K,IOBJ), K = 1, NKEYCU)
- WRITE (LPRTCU, 1005) (KEYVDK(K), K = 1, NKEYCU)
- WRITE (LPRTCU, 1006) NDAT, (Q(LUSECU(IOBJ)+I), I = 1, NDAT)
- WRITE (LPRTCU, 1007) NDATD, (Q(LDUVCU+I), I = 1, NDATD)
-#endif
- ENDIF
- IF (LDUVCU.GT.0) CALL MZDROP (ISTOCU, LDUVCU, 'L')
- 40 CONTINUE
- WRITE (LPRTCU, 1008) NERR, NOBJCU
-*
-* *** Now test the third directory
-*
- PATHN = '//DBL3/DBMU/MCALB/UVD3'
- WRITE (LPRTCU, 1003) PATHN
- NERR = 0
- DO 60 IOBJ = 1, NOBJCU
- IERR = 0
- KEY1S = IOBJ
- NDAT = IQ(LUSECU(IOBJ)-1)
- CALL CDBKIN (PATHN, KEY1S, IDIVCU, LDUVCU, LKUVCU, 2, IRC)
- NDATD = IQ(LDUVCU-1)
- DO 50 K = 1, NKEYCU
- IF (K.GE.NOFFP.AND.KEYVCK(K).NE.KEYSCU(K,IOBJ)) IERR = IERR +1
- 50 CONTINUE
- IF (NDAT.NE.NDATD) THEN
- IERR = IERR + 1
- ELSE
- DO 55 I = 1, NDAT
- DIFF = (Q(LUSECU(IOBJ)+I) - Q(LDUVCU+I)) / AMAX1
- + (ABS(Q(LDUVCU+I)), ABS(Q(LUSECU(IOBJ)+I)), 1.0E-12)
- IF (ABS(DIFF).GT.0.01) IERR = IERR + 1
- 55 CONTINUE
- ENDIF
- IF (IERR.GT.0) THEN
- NERR = NERR + 1
-#if defined(CERNLIB__DEBUG)
- WRITE (LPRTCU, 1004) (KEYSCU(K,IOBJ), K = 1, NKEYCU)
- WRITE (LPRTCU, 1005) (KEYVDK(K), K = 1, NKEYCU)
- WRITE (LPRTCU, 1006) NDAT, (Q(LUSECU(IOBJ)+I), I = 1, NDAT)
- WRITE (LPRTCU, 1007) NDATD, (Q(LDUVCU+I), I = 1, NDATD)
-#endif
- ENDIF
- IF (LDUVCU.GT.0) CALL MZDROP (ISTOCU, LDUVCU, 'L')
- 60 CONTINUE
- WRITE (LPRTCU, 1008) NERR, NOBJCU
-*
-* *** Now test the fourth directory
-*
- PATHN = '//DBL3/DBMU/MCALB/UVD4'
- WRITE (LPRTCU, 1003) PATHN
- NERR = 0
- DO 80 IOBJ = 1, NOBJCU
- IERR = 0
- KEY1S = IOBJ
- NDAT = IQ(LUSECU(IOBJ)-1)
- CALL CDBKIN (PATHN, KEY1S, IDIVCU, LDUVCU, LKUVCU, 2, IRC)
- NDATD = IQ(LDUVCU-1)
- DO 70 K = 1, NKEYCU
- IF (K.GE.NOFFP.AND.KEYVCK(K).NE.KEYSCU(K,IOBJ)) IERR = IERR +1
- 70 CONTINUE
- IF (NDAT.NE.NDATD) THEN
- IERR = IERR + 1
- ELSE
- DO 75 I = 1, NDAT
- DIFF = (Q(LUSECU(IOBJ)+I) - Q(LDUVCU+I)) / AMAX1
- + (ABS(Q(LDUVCU+I)), ABS(Q(LUSECU(IOBJ)+I)), 1.0E-12)
- IF (ABS(DIFF).GT.0.01) IERR = IERR + 1
- 75 CONTINUE
- ENDIF
- IF (IERR.GT.0) THEN
- NERR = NERR + 1
-#if defined(CERNLIB__DEBUG)
- WRITE (LPRTCU, 1004) (KEYSCU(K,IOBJ), K = 1, NKEYCU)
- WRITE (LPRTCU, 1005) (KEYVDK(K), K = 1, NKEYCU)
- WRITE (LPRTCU, 1006) NDAT, (Q(LUSECU(IOBJ)+I), I = 1, NDAT)
- WRITE (LPRTCU, 1007) NDATD, (Q(LDUVCU+I), I = 1, NDATD)
-#endif
- ENDIF
- IF (LDUVCU.GT.0) CALL MZDROP (ISTOCU, LDUVCU, 'L')
- 80 CONTINUE
- WRITE (LPRTCU, 1008) NERR, NOBJCU
-*
-* *** Get Real time at the end of the loop
-*
- CALL TIMEX (TIMNOW)
- TIME = TIMNOW - TIMINT
- CALL CDUVTX (IDAY, ITIM2)
- ITIME = ITIM2 - ITIM1
- WRITE (LPRTCU, 1001) IDAY, ITIM1, ITIM2, ITIME
- WRITE (LPRTCU, 1002) TIMINT, TIMNOW, TIME
-*
- 1001 FORMAT (/,' CDUVDT : IDAY/ITIM1/ITIM2/ITIME ', 4I12)
- 1002 FORMAT (/,' CDUVDT : TIMINT/TIMNOW/TIME ',4G12.4)
- 1003 FORMAT (//,' CDUVDT : Test object stored in directory ',A)
-#if defined(CERNLIB__DEBUG)
- 1004 FORMAT (' Input Keys',10I12)
- 1005 FORMAT (' Output Keys',10I12)
- 1006 FORMAT (' Input Data',I12,9G12.4/(12X,10G12.4))
- 1007 FORMAT (' Output Data',I12,9G12.4/(12X,10G12.4))
-#endif
- 1008 FORMAT (/,' CDUVDT : Number of errors ',I6,' in ',I6,' objects')
-* END CDUVDT
- END
diff --git a/src/packlib/hepdb/examples/dbexam/cdexam09/cexam09.F b/src/packlib/hepdb/examples/dbexam/cdexam09/cexam09.F
deleted file mode 100644
index 433ccb0..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdexam09/cexam09.F
+++ /dev/null
@@ -1,179 +0,0 @@
-*
-* $Id: cexam09.F,v 1.1.1.1 1996/02/28 16:23:52 mclareni Exp $
-*
-* $Log: cexam09.F,v $
-* Revision 1.1.1.1 1996/02/28 16:23:52 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- PROGRAM CEXAM09
-* ===============
-*
-************************************************************************
-* *
-* PROG. CEXAM09 *
-* *
-* Program to create a fictitious database to test the batch option *
-* DBENTB and compare its performance against standard CDSTOR *
-* *
-* This program uses a different store from /GCBANK/ and hence both *
-* the user division and the ZEBRA system division refer to the new *
-* store /CSTOR9/ and muliple save ala CDSTOM *
-* *
-************************************************************************
-*
- PARAMETER (NLAST=150000, NDIV1=5000)
- COMMON /CSTOR9/ FENCCS(22), LQ(NLAST)
- DIMENSION IQ(2), Q(2)
- EQUIVALENCE (IQ(1),Q(1),LQ(9))
-*
- COMMON /QUEST/ IQUEST(100)
-*
-#include "cuser9.inc"
- PARAMETER (NKEX=NKEYCU-NOF2CU, NOFF1=10, NOFFP=6)
- CHARACTER CHTAG(NKEX)*8, CHFOR*(NKEX), CHD*2
- DATA CHTAG /'US_KEY_1'/, CHFOR /'I'/
-*
-* ------------------------------------------------------------------
-*
-* *** Open the RZ-file with an Open Statement (or JCL, etc)
-*
- LUNRZ = 1
- LPRTCU = 6
- NREC = 1000
- LREC = 1024
- NBYTE = 4*LREC
-#if defined(CERNLIB_IBM)
- CALL CDROPN (LUNRZ, 'ZO', 'DBTEST.DATA.A4', NBYTE, IOERR)
-#endif
-#if !defined(CERNLIB_IBM)
- CALL CDROPN (LUNRZ, 'ZO', 'DBTEST.DAT', NBYTE, IOERR)
-#endif
- IF (IOERR.NE.0) GO TO 999
- CALL MZEBRA(-1)
-*
-* *** Open the 1 and only 1 Store used in the reconstruction
-*
- CALL MZSTOR (ISTOCU, '/CSTOR9/', ' ', FENCCS(1), LQ(1), LQ(1)
- + , LQ(1), LQ(NDIV1), LQ(NLAST))
-*
-* *** Log-Level
-*
- CALL MZLOGL (ISTOCU, 0)
-*
-* *** Define user division and link area like:
-*
- CALL MZDIV (ISTOCU, IDIVCU, 'DB-USERS', 50000, 100000, 'L')
- CALL MZLINK (ISTOCU, '/CUSER9/', LDUVCU, LUSECU(NOBJCU), LDUVCU)
-*
-* *** Expand the system-division to its maximum
-*
- LARGE = NLAST/2
- IDIVS = IDIVCU - 1
- CALL MZNEED (IDIVS, LARGE, 'G')
- ND = LARGE + IQUEST(11) - 20
- IF (ND.GT.0) THEN
- CALL MZBOOK (IDIVS, L, 0, 2, 'DUMY', 0, 0, ND, 2, -1)
- CALL MZDROP (IDIVS, L, ' ')
- ENDIF
-*
-* *** Initialize DB-Package
-*
- CALL TIMEST (999999.)
- NPAIR = 1
- LUFZ = 0
- NTOP = 0
- CALL CDINIT (IDIVCU, LUNRZ, LUFZ, 'DBL3', NPAIR, NREC, NTOP,
- + 'UZ', IRC)
-#if !defined(CERNLIB__DEBUG)
- CALL CDLOGL ('DBL3', 0, ' ', IRC)
-#endif
-#if defined(CERNLIB__DEBUG)
- CALL CDLOGL ('DBL3', 2, ' ', IRC)
-#endif
-*
-* *** Generate the list of objects to be inserted
-*
- IDEND = 901231
- IDBGN = 880617
- ITIME = 0
- CALL CDPKTS (IDEND, ITIME, INFIN, IRC)
- CALL CDPKTS (IDBGN, ITIME, IDTIM, IRC)
- IPVSN = 1
- XRANG = 500.
- XCENT = 1000.
- NDAT = 48
- DO 10 I = 1, NOBJCU
- KEYU = MOD (I, NKYNCU)
- IF (KEYU.EQ.0) THEN
- KEYU = NKYNCU
- IDBGN = IDBGN + 1
- CALL CDPKTS (IDBGN, ITIME, IDTIM, IRC)
- ENDIF
- KEYSCU(NOFF1+1 ,I) = IDTIM
- KEYSCU(NOFF1+2 ,I) = INFIN
- KEYSCU(NOFFP ,I) = IPVSN
- KEYSCU(NOF2CU+1,I) = KEYU
- CALL MZBOOK (IDIVCU, LUSECU(I), LUSECU(I), 2, 'UVDS', 0, 0, NDAT
- + , 3, 0)
- DO 5 J = 1, NDAT
- Q(LUSECU(I)+J) = XRANG*RNDM(Q) - XCENT
- 5 CONTINUE
- 10 CONTINUE
-*
-* *** Create the two directories
-*
- CHD = 'C'
- IPREC = 3
- DELTA = 0.
- CALL CDMDIR ('//DBL3/DBMU/MCALB/UVD1', NKEX, CHFOR, CHTAG, 20,
- + IPREC, DELTA, CHD, IRC)
- CALL CDMDIR ('//DBL3/DBMU/MCALB/UVD2', NKEX, CHFOR, CHTAG, 20,
- + IPREC, DELTA, CHD, IRC)
- CALL CDMDIR ('//DBL3/DBMU/MCALB/UVD3', NKEX, CHFOR, CHTAG, 20,
- + IPREC, DELTA, CHD, IRC)
- CALL CDMDIR ('//DBL3/DBMU/MCALB/UVD4', NKEX, CHFOR, CHTAG, 20,
- + IPREC, DELTA, CHD, IRC)
-*
-* *** Now use 4 methods for saving the datasets
-*
- CALL CDUVD1
-#if defined(CERNLIB__DEBUG)
- CALL DZSNAP ('UVD1', IDIVCU, 'LMT')
- CALL DZSNAP ('UVD1', IDIVCU-1, 'LMT')
-#endif
- CALL CDUVD2
-#if defined(CERNLIB__DEBUG)
- CALL DZSNAP ('UVD2', IDIVCU, 'LMT')
- CALL DZSNAP ('UVD2', IDIVCU-1, 'LMT')
-#endif
- CALL CDUVD3
-#if defined(CERNLIB__DEBUG)
- CALL DZSNAP ('UVD3', IDIVCU, 'LMT')
- CALL DZSNAP ('UVD3', IDIVCU-1, 'LMT')
-#endif
- CALL CDUVD4
-#if defined(CERNLIB__DEBUG)
- CALL DZSNAP ('UVD4', IDIVCU, 'LMT')
- CALL DZSNAP ('UVD4', IDIVCU-1, 'LMT')
-#endif
-*
-* *** Test the data objects stored
-*
- CALL CDUVDT
-#if defined(CERNLIB__DEBUG)
-*
-* *** Debug print out
-*
- DO 20 K = 1, NOBJCU
- IF (MOD(K,NKYNCU).EQ.1)
- + CALL DZSHOW ('UVDS ', IDIVCU, LUSECU(K), 'B', 0, 0, 0, 0)
- 20 CONTINUE
-#endif
-*
-* *** Close Data Base
-*
- CALL CDEND ('*', 'A', IRC)
-* END CEXAM09
- 999 END
diff --git a/src/packlib/hepdb/examples/dbexam/cdexam09/cstor9.inc b/src/packlib/hepdb/examples/dbexam/cdexam09/cstor9.inc
deleted file mode 100644
index de4c178..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdexam09/cstor9.inc
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: cstor9.inc,v 1.1.1.1 1996/02/28 16:23:52 mclareni Exp $
-*
-* $Log: cstor9.inc,v $
-* Revision 1.1.1.1 1996/02/28 16:23:52 mclareni
-* Hepdb, cdlib, etc
-*
-*
-*
-* cstor9.inc
-*
- COMMON /CSTOR9/ FENCCS(22), LQ(9)
- DIMENSION IQ(2), Q(2)
- EQUIVALENCE (IQ(1),Q(1),LQ(9))
-*
- COMMON /QUEST/ IQUEST(100)
-*
diff --git a/src/packlib/hepdb/examples/dbexam/cdexam09/cuser9.inc b/src/packlib/hepdb/examples/dbexam/cdexam09/cuser9.inc
deleted file mode 100644
index c190f13..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdexam09/cuser9.inc
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: cuser9.inc,v 1.1.1.1 1996/02/28 16:23:52 mclareni Exp $
-*
-* $Log: cuser9.inc,v $
-* Revision 1.1.1.1 1996/02/28 16:23:52 mclareni
-* Hepdb, cdlib, etc
-*
-*
-*
-* cuser9.inc
-*
- PARAMETER (NOF2CU=12)
- PARAMETER (NKEYCU=NOF2CU+1, NKYNCU=16, NOBJCU=320)
- COMMON /CUSER9/ ISTOCU, IDIVCU, LPRTCU, KEYSCU(NKEYCU,NOBJCU)
- + , LDUVCU, LKUVCU, LUSECU(NOBJCU)
-*
diff --git a/src/packlib/hepdb/examples/dbexam/cdexam10/Imakefile b/src/packlib/hepdb/examples/dbexam/cdexam10/Imakefile
deleted file mode 100644
index d6f10bd..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdexam10/Imakefile
+++ /dev/null
@@ -1,3 +0,0 @@
-SRCS_F= cexam10.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/hepdb/examples/dbexam/cdexam10/cexam10.F b/src/packlib/hepdb/examples/dbexam/cdexam10/cexam10.F
deleted file mode 100644
index 91e9bc8..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdexam10/cexam10.F
+++ /dev/null
@@ -1,99 +0,0 @@
-*
-* $Id: cexam10.F,v 1.1.1.1 1996/02/28 16:23:53 mclareni Exp $
-*
-* $Log: cexam10.F,v $
-* Revision 1.1.1.1 1996/02/28 16:23:53 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- PROGRAM CEXAM10
-* ===============
-*
-************************************************************************
-* *
-* PROG. CEXAM10 *
-* *
-* Program to debug CDPURG and CDPRIN on a fictitious Data Base *
-* *
-************************************************************************
-*
- PARAMETER (NLAST=150000, NDIV1=5000)
- COMMON /GCBANK/ FENCCS(22), LQ(NLAST)
- CHARACTER CHOPT*8
- PARAMETER (NOFF2=12)
- DIMENSION KEYS(100), MASK(100)
-* ------------------------------------------------------------------
-*
-* *** Open the RZ-file with an Open Statement (or JCL, etc)
-*
- LUNRZ = 1
- NREC = 1000
- LREC = 1024
- NBYTE = 4*LREC
-#if defined(CERNLIB_IBM)
- CALL CDROPN (LUNRZ, 'O', 'DBMUON.DATA.A4', NBYTE, IOERR)
-#endif
-#if !defined(CERNLIB_IBM)
- CALL CDROPN (LUNRZ, 'O', 'DBMUON.DAT', NBYTE, IOERR)
-#endif
- IF (IOERR.NE.0) GO TO 999
- CALL MZEBRA (-1)
-*
-* *** Open the 1 and only 1 Store used in the reconstruction
-*
- CALL MZSTOR (ISTOCU, '/GCBANK/', ' ', FENCCS(1), LQ(1), LQ(1)
- + , LQ(1), LQ(NDIV1), LQ(NLAST))
-*
-* *** Log-Level
-*
-#if !defined(CERNLIB__DEBUG)
- CALL MZLOGL (ISTOCU, 0)
-#endif
-#if defined(CERNLIB__DEBUG)
- CALL MZLOGL (ISTOCU, 1)
-#endif
-*
-* *** Define user division and link area like:
-*
- CALL MZDIV (ISTOCU, IDIVCU, 'DB-USERS', 20000, 30000, 'L')
-*
-* *** Initialize DB-Package
-*
- NPAIR = 1
- LUFZ = 0
- NTOP = 0
- CALL CDINIT (IDIVCU, LUNRZ, LUFZ, 'DBL3', NPAIR, NREC, NTOP,
- + 'U', IRC)
-#if !defined(CERNLIB__DEBUG)
- CALL CDLOGL ('DBL3', 0, ' ', IRC)
-#endif
-#if defined(CERNLIB__DEBUG)
- CALL CDLOGL ('DBL3', 2, ' ', IRC)
-#endif
-*
-* *** Test subroutine CDPRIN
-*
- PRINT 1001
- READ (*, 1002) CHOPT
- CALL CDPRIN ('//DBL3/MUCH/MCALB/UVDS', 'K', IRC)
-*
-* *** Test subroutine CDPURG
-*
- MASK(NOFF2+1) = 1
- KEYS(NOFF2+1) = 10
- CALL CDPKTS (801222, 0, ITIME, IRC)
- KYDAT = NOFF2 + 1
- CALL CDPURK ('//DBL3/MUCH/MCALB/UVDS', ITIME, MASK,KEYS, ' ', IRC)
- CALL CDPRIN ('//DBL3/MUCH/MCALB/UVDS', 'K', IRC)
- CALL CDPURG ('//DBL3/MUCH/MCALB/UVDS', KYDAT, 10, CHOPT, IRC)
- CALL CDPRIN ('//DBL3/MUCH/MCALB/UVDS', 'K', IRC)
-*
-* *** Close DataBase
-*
- CALL CDEND ('*', 'A', IRC)
-*
- 1001 FORMAT (' Give the character option in purging : ')
- 1002 FORMAT (A)
-* END CEXAM10
- 999 END
diff --git a/src/packlib/hepdb/examples/dbexam/cdexam11/Imakefile b/src/packlib/hepdb/examples/dbexam/cdexam11/Imakefile
deleted file mode 100644
index f0fcecc..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdexam11/Imakefile
+++ /dev/null
@@ -1,3 +0,0 @@
-SRCS_F= cdcrbk.F cdlokf.F cexam11.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/hepdb/examples/dbexam/cdexam11/cdcrbk.F b/src/packlib/hepdb/examples/dbexam/cdexam11/cdcrbk.F
deleted file mode 100644
index 67ed6bf..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdexam11/cdcrbk.F
+++ /dev/null
@@ -1,84 +0,0 @@
-*
-* $Id: cdcrbk.F,v 1.1.1.1 1996/02/28 16:23:54 mclareni Exp $
-*
-* $Log: cdcrbk.F,v $
-* Revision 1.1.1.1 1996/02/28 16:23:54 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDCRBK (LUNI, LPRNT, KEYS)
-*
-************************************************************************
-*
-* SUBR. CDCRBK (LUNI, LPRNT, KEYS)
-*
-* Creates user bank to be entered into data base
-* (Version prepared to transfer the field map to data base)
-*
-* Arguments :
-*
-* LUNI Logical unit number of input file
-* LPRNT Logical unit number of log file
-* KEYS Corresponding Key vector
-*
-* Called by CEXAM11
-*
-************************************************************************
-*
- PARAMETER (KWBANK=69000, KWWORK=5200)
- COMMON /GCBANK/ NZEBRA, GVERSN, ZVERSN, IXSTOR, IXDIV, IXCONS
- + , FENDQ(16), LMAIN, LR1, WS(KWBANK)
- DIMENSION IQ(2), Q(2), LQ(8000), IWS(2)
- EQUIVALENCE (Q(1), IQ(1), LQ(9)), (LQ(1), LMAIN)
- EQUIVALENCE (IWS(1), WS(1))
- PARAMETER (NOFF1=10, NOFFP=6)
- COMMON /CUSERB/ LKBKCU, LLBKCU
-*
- DIMENSION KEYS(9)
-* start User part of CDCRBK
- REAL BZM(5000), BRM(5000)
-*
-* ------------------------------------------------------------------
-*
-* *** Read BZ map-limits
-*
- READ (LUNI, 2001) ZMINZ,ZMAXZ,RMINZ,RMAXZ,NZZ,NRZ,DZZ,DRZ
- NMAX = NZZ * NRZ
- WRITE (LPRNT, *) ' CDCRBK : NMAX, NZ, NR = ', NMAX, NZZ, NRZ
-*
-* ** Read the main-component map
-*
- READ (LUNI, 2002) (BZM(I),I=1,NMAX)
-*
-* ** Read BR map-limits
-*
- READ (LUNI, 2001) ZMINR,ZMAXR,RMINR,RMAXR,NZR,NRR,DZR,DRR
- NMAX = NZR * NRR
- WRITE (LPRNT, *) ' CDCRBK : NMAX, NZ, NR = ', NMAX, NZR, NRR
-*
-* ** Read the minor-component map
-*
- READ (LUNI, 2002) (BRM(I),I=1,NMAX)
-*
-* *** Create the FMAP bank
-*
- ND = 2*NMAX + 4
- CALL MZFORM ('FMAP', '2I -F', IOFM)
- CALL MZBOOK (IXDIV, LKBKCU, LKBKCU, 1, 'FMAP', 0, 0, ND, IOFM, -1)
- IQ(LKBKCU+1) = NZZ
- IQ(LKBKCU+2) = NRZ
- Q(LKBKCU+3) = DZZ
- Q(LKBKCU+4) = DRZ
- CALL UCOPY (BZM, Q(LKBKCU+5), NMAX)
- CALL UCOPY (BRM, Q(LKBKCU+NMAX+5), NMAX)
-*
-* *** Prepare the key vector
-*
- CALL CDPKTS (991231, 235959, KEYS(NOFF1+2), IRC)
- KEYS(NOFFP) = 1
-*
- 2001 FORMAT (4E15.5/2I15,2E15.5)
- 2002 FORMAT (4E15.5)
-* END CDCRBK
- 999 END
diff --git a/src/packlib/hepdb/examples/dbexam/cdexam11/cdlokf.F b/src/packlib/hepdb/examples/dbexam/cdexam11/cdlokf.F
deleted file mode 100644
index c600b1c..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdexam11/cdlokf.F
+++ /dev/null
@@ -1,36 +0,0 @@
-*
-* $Id: cdlokf.F,v 1.1.1.1 1996/02/28 16:23:54 mclareni Exp $
-*
-* $Log: cdlokf.F,v $
-* Revision 1.1.1.1 1996/02/28 16:23:54 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDLOKF (CHID, LBUF, NBUF, I)
-*
-************************************************************************
-*
-* SUBR. CDLOKF (CHID, LBUF, NBUF, I*)
-*
-* Finds a character string in an array of hollerith numbers
-*
-* Arguments :
-*
-* CHID Character string
-* LBUF Array of NBUF length
-* I Index number in LBUF corresponding to CHID
-*
-* Called by CEXAM11
-*
-************************************************************************
-*
- CHARACTER*4 CHID
- DIMENSION LBUF(2)
-* ------------------------------------------------------------------
-*
- CALL UCTOH (CHID, ICHID, 4, 4)
- I = IUCOMP (ICHID, LBUF, NBUF)
-* END CDLOKF
- END
-
diff --git a/src/packlib/hepdb/examples/dbexam/cdexam11/cexam11.F b/src/packlib/hepdb/examples/dbexam/cdexam11/cexam11.F
deleted file mode 100644
index 7e3dbf0..0000000
--- a/src/packlib/hepdb/examples/dbexam/cdexam11/cexam11.F
+++ /dev/null
@@ -1,229 +0,0 @@
-*
-* $Id: cexam11.F,v 1.1.1.1 1996/02/28 16:23:54 mclareni Exp $
-*
-* $Log: cexam11.F,v $
-* Revision 1.1.1.1 1996/02/28 16:23:54 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- PROGRAM CEXAM11
-*
-************************************************************************
-*
-* PROG. CEXAM11
-*
-* Provides facility to enter information into data base from an input
-* file. It operates with 2 FFKEY data cards 'IOPA' to specify the
-* input and output (data base) files and 'DIRE' to specify the name
-* of the directory and when needed the specification of user keys.
-*
-* External routines : CDCRBK, CDLOKF, HEPDB routines
-* External libraries : PACKLIB, KERNLIB
-*
-************************************************************************
-*
- PARAMETER (NLAST=150000, NDIV1=5000)
- COMMON /GCBANK/ NZEBRA, GVERSN, ZVERSN, IXSTOR, IXDIV, IXCONS
- + , FENDQ(16), LMAIN, LR1, WS(NLAST)
- DIMENSION IQ(2), Q(2), LQ(8000)
- EQUIVALENCE (Q(1),IQ(1),LQ(9)), (LQ(1),LMAIN,LBKS)
-*
- COMMON /QUEST/ IQUEST(100)
-*
- COMMON /CUSERB/ LKBKCU, LLBKCU
-*
- PARAMETER (NBUFF=50, NBDIR=20, NBKEY=20)
- DIMENSION LBUFF(NBUFF), LBDIR(NBDIR), LBKEY(NBKEY)
- CHARACTER CHINP*4, CHDBL*4, CHOPT*4, TOPN*16, CHDIR*80
- CHARACTER CHNAM*80, CHFOR*100, CTAG(100)*8, CHVL*4
- PARAMETER (NOFF1=10, NOFF2=12, IDHINS=4)
- INTEGER KEYS(100)
-*
-* ------------------------------------------------------------------
-*
-* *** Initialize ZEBRA
-*
- CALL MZEBRA (-1)
- CALL MZSTOR (IXSTOR, '/GCBANK/', ' ', FENDQ(1), LQ(1), LQ(1)
- + , LQ(1), LQ(NDIV1), LQ(NLAST))
- CALL MZDIV (IXSTOR, IXCONS, 'Constant', 10000, NLAST-5000, 'L')
- IXDIV = IXSTOR + 2
- CALL MZLINK (IXSTOR, '/CUSERB/', LKBKCU, LLBKCU, LLBKCU)
-*
-* *** Initialize FFREAD
-*
- LPRNT = 6
- CALL FFINIT (0)
- LUNIN = 0
- LUNDB = 0
- CALL VBLANK (LBUFF, NBUFF)
- CALL VBLANK (LBDIR, NBDIR)
- CALL VBLANK (LBKEY, NBKEY)
- CALL FFKEY ('IOPA', LBUFF, NBUFF, 'MIXED')
- CALL FFKEY ('DIRE', LBDIR, NBDIR, 'MIXED')
- CALL FFKEY ('KYCH', LBKEY, NBKEY, 'MIXED')
- CALL FFGO
-*
-* *** Find the name of the directory and hence Top dir name
-*
- CALL UHTOC (LBDIR(1), 4, CHNAM, 80)
- IF (CHNAM(1:2).NE.'//') THEN
- WRITE (LPRNT, *) ' CEXAM11 : No valid directory name given'
- GO TO 999
- ENDIF
- LNB = INDEX (CHNAM, ' ')
- IF (LNB.GT.1) THEN
- CHDIR = CHNAM(1:LNB-1)
- ELSE
- CHDIR = CHNAM
- ENDIF
- NCHAR = LENOCC (CHDIR)
- NCHRT = INDEX (CHDIR(3:NCHAR), '/') - 1
- IF (NCHRT.LE.0) NCHRT = NCHAR - 2
- TOPN = CHDIR(3:NCHRT+2)
-*
-* *** Open the i/p and o/p files
-*
- CALL CDLOKF ('INPU', LBUFF, NBUFF, I)
- IF (I.GT.0) THEN
- I = I + 1
- LUNIN = IABS (LBUFF(I))
- IF (LBUFF(I).LT.0) I = I + 2
- CALL UHTOC (LBUFF(I+1), 4, CHFOR, 80)
- LNB = INDEX (CHFOR, ' ')
- CHNAM = CHFOR(2:LNB)
-#if defined(CERNLIB_APOLLO)||defined(CERNLIB_UNIX)
- CALL CUTOL (CHNAM)
-#endif
- CALL CDOPFL (LUNIN, CHNAM, 'OLD', IRC)
- IF (IRC.NE.0) LUNIN = 0
- ENDIF
-*
- CALL CDLOKF ('DBL3', LBUFF, NBUFF, I)
- IF (I.GT.0) THEN
- I = I + 1
- LUNDB = IABS (LBUFF(I))
- IF (LBUFF(I).LT.0) THEN
- I = I + 1
- CALL UHTOC (LBUFF(I), 4, CHDBL, 4)
- I = I + 1
- LRCDB = LBUFF(I)
- I = I + 1
- LXTDB = LBUFF(I)
- I = I + 1
- CALL UHTOC (LBUFF(I), 4, CHOPT, 4)
- ELSE
- CHDBL = 'RO '
- LRCDB = 4096
- LXTDB = 4096
- CHOPT = 'U '
- ENDIF
- CALL UHTOC (LBUFF(I+1), 4, CHFOR, 80)
- LNB = INDEX (CHFOR, ' ')
- CHNAM = CHFOR(2:LNB)
- CALL CDROPN (LUNDB, CHDBL, CHNAM, LRCDB, IRC)
- IF (IRC.NE.0) LUNDB = 0
- ENDIF
-*
- IF (LUNIN.EQ.0.OR.LUNDB.EQ.0) THEN
- WRITE (LPRNT, *) ' CEXAM11 : Error in opening the files'
- GO TO 999
- ENDIF
-*
-* *** Initialize the Database
-*
- NPAIR = 1
- LUFZ = 0
- NTOP = 0
- CALL CDINIT (IDIVCU, LUNDB, LUFZ, TOPN, NPAIR, LXTDB, NTOP,
- + CHOPT, IRC)
- CALL CDLOGL (TOPN, 1, ' ', IRC)
- CALL UOPTC (CHOPT, 'Z', II)
-*
-* *** See if directory creation is necessary
-*
- IF (II.GT.0) THEN
- ICREA = 1
- ELSE
- CALL RZCDIR (CHDIR, ' ')
- IF (IQUEST(1).EQ.0) THEN
- ICREA = 0
- NWKEY = IQUEST(8)
- ELSE
- ICREA = 1
- ENDIF
- ENDIF
-*
-* *** Find the number of user keys and create directory
-*
- IF (ICREA.GT.0) THEN
- NUKYS = 0
- CHFOR = ' '
- CTAG(1) = ' '
- CALL CDLOKF ('KEYS', LBDIR, NBDIR, I)
- 10 IF (I.GT.0 .AND. I.LE.NBDIR-3) THEN
- I = I + 1
- CALL UHTOC (LBDIR(I), 4, CTAG(NUKYS+1), 8)
- IF (CTAG(NUKYS+1).NE.' ') THEN
- I = I + 2
- CALL UHTOC (LBDIR(I), 4, CHVL, 4)
- IF (CHVL(1:1).NE.'I'.AND.CHVL(1:1).NE.'B'.AND.
- + CHVL(1:1).NE.'H'.AND.CHVL(1:1).NE.'A') CHVL(1:1) = 'I'
- IF (NUKYS.GT.0) THEN
- CHFOR = CHFOR(1:NUKYS)//CHVL(1:1)
- ELSE
- CHFOR = CHVL(1:1)
- ENDIF
- NUKYS = NUKYS + 1
- GO TO 10
- ENDIF
- ENDIF
- IPREC = 0
- DELTA = 0.
- CALL CDMDIR (CHDIR, NUKYS, CHFOR, CTAG, 0, IPREC,DELTA, 'C',IRC)
- NWKEY = NUKYS + NOFF2
- IF (IQUEST(1).NE.0) THEN
- WRITE (LPRNT, *) ' CEXAM11 : Error ', IQUEST(1),
- + ' in creating directory'
- GO TO 50
- ENDIF
- ENDIF
-*
-* *** Now call user routine to prepare the data base object
-*
- CALL VZERO (KEYS, NWKEY)
- CALL CDCRBK (LUNIN, LPRNT, KEYS)
-*
-* *** Update some of the keys
-*
- IK = 1
- 20 IF (IK.LT.NBKEY) THEN
- IF (LBKEY(IK).GT.0.AND.LBKEY(IK).LE.NWKEY) THEN
- IKEY = LBKEY(IK)
- IF (IKEY.EQ.NOFF1+1.OR.IKEY.EQ.NOFF1+2) THEN
- CALL DBPKTS (LBKEY(IK+1), LBKEY(IK+2), KEYS(IKEY), IRC)
- IK = IK + 3
- ELSE IF (IKEY.EQ.IDHINS) THEN
- CALL DBPKTM (LBKEY(IK+1), LBKEY(IK+2), KEYS(IKEY))
- IK = IK + 3
- ELSE
- KEYS(IKEY) = LBKEY(IK+1)
- IK = IK + 2
- ENDIF
- GO TO 20
- ENDIF
- ENDIF
-*
-* *** Enter it in Data base
-*
- CALL CDSTOR (CHDIR, LKBKCU, LLBKCU, IXDIV, KEYS, 'DY', IRC)
- WRITE (LPRNT, *) ' CEXAM11 : Data entered in ', CHDIR(1:NCHAR)
- WRITE (LPRNT, *) ' Error code ', IRC
-*
-* *** Close data base and exit
-*
- 50 CALL CDEND ('*', 'A', IRC)
- CALL MZEND
-* END CEXAM11
- 999 END
diff --git a/src/packlib/hepdb/examples/dbexam/cx77/Imakefile b/src/packlib/hepdb/examples/dbexam/cx77/Imakefile
deleted file mode 100644
index 1c1628c..0000000
--- a/src/packlib/hepdb/examples/dbexam/cx77/Imakefile
+++ /dev/null
@@ -1,4 +0,0 @@
-SRCS_F= encodi.F encodr.F hexenc.F ifsheqc.F jlastx.F jsearx.F \ @@\
- texarr.F texerr.F texins.F texnme.F texstr.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/hepdb/examples/dbexam/cx77/encodi.F b/src/packlib/hepdb/examples/dbexam/cx77/encodi.F
deleted file mode 100644
index 6e72511..0000000
--- a/src/packlib/hepdb/examples/dbexam/cx77/encodi.F
+++ /dev/null
@@ -1,74 +0,0 @@
-*
-* $Id: encodi.F,v 1.1.1.1 1996/02/28 16:23:42 mclareni Exp $
-*
-* $Log: encodi.F,v $
-* Revision 1.1.1.1 1996/02/28 16:23:42 mclareni
-* Hepdb, cdlib, etc
-*
-*
- SUBROUTINE ENCODI(NUMB,MODE,STRN,LENR)
-* ---09.10.88-----------------====-====-
- CHARACTER*(*) STRN
-*
- CHARACTER ENCOD*11
- DATA LCODE/11/
-*
-* MODE = [-](IPL*100+MNL)
-* IPL=1 -force plus
-* LEF>0 -left shift of code( MODE<0 )
-* MNL -minimal code length to
-* be filled by left zeros
-* MXL -maximal code length (=len(STRN))
-*
- IPL=IABS(MODE)/100
- LEF=MAX0(-MODE,0)
- MNL=MAX0(MOD(IABS(MODE),100),1)
- MXL=LEN(STRN)
-*
- LSN=0
- IF(NUMB.LT.0.OR.IPL.NE.0) LSN=1
-*
- WRITE(ENCOD,'(I11)') NUMB
- JJ=0
- DO 110 J=1,LCODE
- IF(ENCOD(J:J).NE.' '.AND.JJ.EQ.0) JJ=J
- 110 CONTINUE
-*
- IF(LSN.NE.0.AND.NUMB.GE.0) THEN
- JJ=JJ-1
- ENCOD(JJ:JJ)='+'
- ENDIF
-*
- ENCOD=ENCOD(JJ:LCODE)
- LNM=LCODE-JJ+1
-*
- IF(LNM.GT.MXL) THEN
-C IF(MXL.EQ.1) THEN
-C ENCOD(1:1)='*'
-C ELSE
- JJ=MAX0(MXL-1,1)
- LEX=MOD(LNM-MXL+2,10)
- ENCOD(JJ:JJ+1)='!'//CHAR(ICHAR('0')+LEX)
-C ENDIF
- LNM=MXL
- ENDIF
-*
- LIZ=MAX0(MIN0(MNL-LNM,MXL-LNM),0)
- JJ=MXL-LNM-LIZ+1
- IF(LEF.GT.0) JJ=1
-*
- STRN=' '
- IF(LSN.GT.0) THEN
- STRN(JJ:JJ)=ENCOD(1:1)
- JJ=JJ+1
- ENDIF
-*
- DO 155 J=JJ,JJ+LIZ-1
- STRN(J:J)='0'
- 155 CONTINUE
-*
- JJ=JJ+LIZ
- STRN(JJ:JJ+LNM-LSN-1)=ENCOD(1+LSN:LNM)
- LENR=LNM+LIZ
-*
- END
diff --git a/src/packlib/hepdb/examples/dbexam/cx77/encodr.F b/src/packlib/hepdb/examples/dbexam/cx77/encodr.F
deleted file mode 100644
index 2b685d6..0000000
--- a/src/packlib/hepdb/examples/dbexam/cx77/encodr.F
+++ /dev/null
@@ -1,249 +0,0 @@
-*
-* $Id: encodr.F,v 1.1.1.1 1996/02/28 16:23:42 mclareni Exp $
-*
-* $Log: encodr.F,v $
-* Revision 1.1.1.1 1996/02/28 16:23:42 mclareni
-* Hepdb, cdlib, etc
-*
-*
- SUBROUTINE ENCODR(FNUM,MODE,STRN,LENR)
-* ----------------------------====-====-
-*
-* $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
-* $ To encode FNUM, according with MODE, $
-* $ into STRN, with the effective code $
-* $ length in LENR. $
-* $ $
-* $ Created by Boris Khomenko $
-* $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
-*
- IMPLICIT NONE
-* *************
-* --- arguments ----
- REAL*4 FNUM
- INTEGER MODE,LENR
- CHARACTER*(*) STRN
-* ------------------
-*
-* ---- local variables ----
- LOGICAL LEFT,FXPN
- INTEGER MMOD,NSGD,MXFR,MXCH
- INTEGER NNNN,LSGN,LINT,LFRZ,LFRX,LPNT,MXDG,NDIG
- INTEGER IEX0,IEXP,LEXP
- INTEGER IFRP,LNNN,JJ,LL
- REAL*4 PLOG,PNUM,RNNN
- CHARACTER ENCOD*16
- REAL*4 REAL4MX,REAL4MN
-* -------------------------
- DATA REAL4MX,REAL4MN/1E37,1E-37/
-*
- PNUM=ABS(FNUM)
- LSGN=0
- IF(FNUM.LT.0.) LSGN=1
- MXCH=LEN(STRN)
- IF(MXCH-LSGN.LE.0) THEN
- STRN='*'
- RETURN
- ENDIF
-*
- LEFT=MODE.LT.0
- MMOD=IABS(MODE)
- FXPN=MMOD.GT.99
- MMOD=MOD(MMOD,100)
- IF(MMOD.EQ.0) MMOD=69
- IF(MMOD.GE.10) THEN
- NSGD=MIN0(MMOD/10,9)
- MXFR=MOD(MMOD,10)
- ELSE
- NSGD=MMOD
- MXFR=9
- ENDIF
- IF(MXFR.LT.9) THEN
- IF(PNUM.LT.10.**(-MXFR-1)) PNUM=0
- ELSE IF(PNUM.NE.0) THEN
- PNUM=AMAX1(PNUM,REAL4MN)
- ENDIF
- PNUM=AMIN1(PNUM,REAL4MX)
-*
- ENCOD=' '
- IF(LSGN.GT.0) ENCOD(1:1)='-'
- LENR=LSGN
-*
- IEXP=0
- LEXP=0
- IF(PNUM.GT.0) THEN
- PLOG=ALOG10(PNUM)
- IEX0=IFIX(PLOG)-8
- IF(PLOG.LT.0) IEX0=IEX0-1
- RNNN=PNUM
- IF(IEX0.GE. 30) RNNN=RNNN*1E-30
- IF(IEX0.LE.-30) RNNN=RNNN*1E+30
- NNNN=RNNN/10.**MOD(IEX0,30)+.5
-*
- IF(NNNN.GE.1000000000) THEN
- NNNN=NNNN/10
- IEX0=IEX0+1
- ELSE IF(NNNN.LT.100000000) THEN
- NNNN=NNNN*10
- IEX0=IEX0-1
- ELSE IF(NNNN/1000.EQ.999999.AND.MOD(NNNN/100,10).GE.5) THEN
- NNNN=100000000
- IEX0=IEX0+1
- ENDIF
-*
- LINT=9+IEX0
- LPNT=1
- MXDG=MIN0(MXCH-LSGN-LPNT,NSGD+2,9)
- IF(LINT.EQ.MXDG+1.AND.LINT.LE.3) THEN
- LPNT=0
- MXDG=MXDG+1
- ELSE IF(LINT.GT.MXDG) THEN
- IEXP=LINT-1
- LINT=1
- IF(NSGD.EQ.9) NSGD=6
- ENDIF
-*
- IF(LINT.LT.0) THEN
- LFRZ=-LINT
- IF(MXFR.LT.9.OR.LINT.GE.-3.AND.-LINT.LT.MXDG) THEN
- NNNN=NNNN/10**IABS(LINT)
- LINT=0
- ELSE
- IEXP=LINT
- LINT=0
- IF(IEXP.NE.-9) THEN
- IEXP=IEXP-1
- LINT=1
- ENDIF
- ENDIF
- ENDIF
-*
- IFRP=0
- 11 CONTINUE
- IFRP=-IABS(IFRP)
- IF(IEXP.NE.0) THEN
- LEXP=2
- IF(IABS(IEXP).GE.10) LEXP=3
- IF(IEXP.LT.0) LEXP=LEXP+1
- NDIG=MIN0(MXCH-LSGN-LPNT-LEXP,NSGD)
- IF(NDIG.EQ.0.AND.LPNT.GT.0) THEN
- IF(LINT.EQ.1) THEN
- LPNT=0
- NDIG=1
- ELSE IF(LINT.EQ.0) THEN
- NNNN=NNNN/10
- LINT=1
- LPNT=0
- NDIG=1
- ENDIF
- ENDIF
- IF(NDIG.GE.0.AND.NNNN+5*10**(8-NDIG).GT.999999999) THEN
- NNNN=NNNN/10
- IF(LINT.EQ.0.OR.IEXP.EQ.9) THEN
- LINT=LINT+1
- ELSE
- IEXP=IEXP+1
- ENDIF
- IFRP=IABS(IFRP)+1
- ENDIF
- IF(IABS(IEXP).LE.10.AND.LPNT.GT.0) THEN
- LL=((IEXP+ISIGN(1,IEXP))/3)*3-IEXP
- IF(LL.EQ.1.AND.LINT.GT.0 .OR.
- + LL.EQ.-1.AND.NDIG-LINT.GT.0) THEN
- IEXP=IEXP+LL
- LINT=LINT-LL
- IFRP=IABS(IFRP)+1
- ENDIF
- ENDIF
- ELSE
-* -- to encode without exponent
- MXDG=MXCH-LSGN-LPNT
- IF(LINT.GT.0) THEN
- NDIG=MIN0(MXDG,LINT+MXFR,MAX0(NSGD,LINT))
- ELSE
- NDIG=MIN0(MXDG,LINT+MXFR,LFRZ+NSGD)
- ENDIF
- IF(NDIG.GE.0) THEN
- IF(NNNN+5*10**(8-NDIG).GT.999999999) THEN
- NNNN=NNNN/10
- LINT=LINT+1
- IF(LINT.GT.MXDG) THEN
- IEXP=3
- LINT=LINT-3
- ENDIF
- IFRP=IABS(IFRP)+1
- ELSE IF(NDIG.EQ.LINT-1) THEN
- LPNT=0
- IFRP=IABS(IFRP)+1
- ENDIF
- ENDIF
- ENDIF
-*
- IF(IFRP.GT.0) GOTO 11
-*
- IF(NDIG.GT.0) THEN
- IF(NDIG.LT.9) THEN
- NNNN=NNNN/10**(8-NDIG)
- NNNN=(NNNN+5)/10
- ENDIF
- CALL ENCODI(NNNN,-NDIG,ENCOD(LENR+1:),LNNN)
- IF(LPNT.GT.0) THEN
- JJ=LENR+LINT+1
- LL=MAX0(LNNN-LINT,0)
- IF(LL.GT.0) ENCOD(JJ+1:JJ+LL)=ENCOD(JJ:JJ+LL-1)
- ENCOD(JJ:JJ)='.'
- LFRX=LL
- ELSE
- LFRX=0
- ENDIF
- LENR=LENR+LNNN+LPNT
-*
- IF(IEXP.NE.0) THEN
- JJ=LENR+1
- ENCOD(JJ:JJ)='E'
- CALL ENCODI(IEXP,-1,ENCOD(JJ+1:JJ+3),LL)
- LENR=LENR+1+LL
- LFRX= 1+LL
- ENDIF
- ELSE
-* -- Field overflow, RETURN
- DO 199 JJ=1,MXCH
- 199 STRN(JJ:JJ)='*'
-*
- IF(LSGN.GT.0.AND.MXCH.GE.2) STRN(1:1)='-'
- IF(MXCH.GE.LSGN+2) THEN
- IF(PNUM.LT.1) THEN
- STRN(LSGN+1:LSGN+1)='.'
- ELSE
- STRN(MXCH:MXCH)='.'
- ENDIF
- ENDIF
-*
- LENR=MXCH
- RETURN
- ENDIF
-*
- ELSE IF(FNUM.NE.0.) THEN
-* -- a QUAZY null
- ENCOD(LENR+1:)='0.000000000'
- LL=3
- IF(MXFR.LT.9) LL=MXFR+2
- LENR=MIN0(LENR+LL,MXCH)
-*
- ELSE
-* -- a TRUE null
- ENCOD='0'
- LENR=1
- LFRX=-1
- ENDIF
-*
- STRN=' '
- IF(LEFT) THEN
- STRN(1:LENR)=ENCOD
- ELSE
- JJ=MXCH-LENR+1
- IF(FXPN.AND.MXFR.LT.9) JJ=MAX0(MIN0(JJ,JJ-MXFR+LFRX),1)
- STRN(JJ:MXCH)=ENCOD
- LENR=MXCH-JJ+1
- ENDIF
- END
diff --git a/src/packlib/hepdb/examples/dbexam/cx77/hexenc.F b/src/packlib/hepdb/examples/dbexam/cx77/hexenc.F
deleted file mode 100644
index afa1451..0000000
--- a/src/packlib/hepdb/examples/dbexam/cx77/hexenc.F
+++ /dev/null
@@ -1,85 +0,0 @@
-*
-* $Id: hexenc.F,v 1.1.1.1 1996/02/28 16:23:42 mclareni Exp $
-*
-* $Log: hexenc.F,v $
-* Revision 1.1.1.1 1996/02/28 16:23:42 mclareni
-* Hepdb, cdlib, etc
-*
-*
- SUBROUTINE HEXENC(NUMB,LENG,CODE,LRES)
-* ----------------------------====-====-
- CHARACTER CODE*(*)
- CHARACTER CC*8
-*
- IS0=ICHAR('0')
- ISA=ICHAR('A')-10
-*
- LL=IABS(LENG)
- IF(LL.EQ.0) LL=8
- LL=MIN0(LL,LEN(CODE),8)
- JH=0
- JL=0
- JB=1
- DO J=8,1,-1
- ID=JBYT(NUMB,JB,4)
- IF(ID.LE.9) THEN
- CC(J:J)=CHAR(IS0+ID)
- ELSE
- CC(J:J)=CHAR(ISA+ID)
- ENDIF
- IF(ID.GT.0) THEN
- IF(JH.LE.0) JL=J
- JH=J
- ENDIF
- JB=JB+4
- ENDDO
- IF(JH.LE.0) JH=8
- IF(JL.LE.0) JL=1
- CODE=' '
- IF(LENG.GE.0) THEN
- IF(LENG.EQ.0) LL=MIN0(LL,9-JH)
- JA=9-LL
- JC=MAX0(LEN(CODE)-LL+1,1)
- CODE(JC:)=CC(JA:)
- IF(JH.LT.JA.AND.JC.GT.1) THEN
- CODE(JC-1:JC-1)='~'
- LL=LL+1
- ENDIF
- ELSE
- CODE(:LL)=CC
- IF(LL.LT.JL.AND.LEN(CODE).GT.LL) THEN
- LL=LL+1
- CODE(LL:LL)='~'
- ENDIF
- ENDIF
- LRES=LL
- END
-*
- FUNCTION IHEXAN(CODE,LCOD)
-* --------------------------
- CHARACTER CODE*(*)
-*
- CHARACTER*1 C
-*
- IS0=ICHAR('0')
- ISA=ICHAR('A')-10
-*
- NN=0
- JN=0
-*
- DO 111 JC=1,LCOD
- C=CODE(JC:JC)
- N=-1
- IF(C.GE.'0'.AND.C.LE.'9') N=ICHAR(C)-IS0
- IF(C.GE.'A'.AND.C.LE.'F') N=ICHAR(C)-ISA
- IF(N.GE.0) THEN
- JN=JN+1
- NN=ISHFT(NN,4)+N
- ELSE IF(JN.GT.0) THEN
- GOTO 60
- ENDIF
- 111 CONTINUE
-*
- 60 CONTINUE
- IHEXAN=NN
- END
diff --git a/src/packlib/hepdb/examples/dbexam/cx77/ifsheqc.F b/src/packlib/hepdb/examples/dbexam/cx77/ifsheqc.F
deleted file mode 100644
index 8cacd9d..0000000
--- a/src/packlib/hepdb/examples/dbexam/cx77/ifsheqc.F
+++ /dev/null
@@ -1,71 +0,0 @@
-*
-* $Id: ifsheqc.F,v 1.1.1.1 1996/02/28 16:23:43 mclareni Exp $
-*
-* $Log: ifsheqc.F,v $
-* Revision 1.1.1.1 1996/02/28 16:23:43 mclareni
-* Hepdb, cdlib, etc
-*
-*
- FUNCTION IFSHEQC(STR1,STR2)
-* ---------------------------
-*-- Author : Boris Khomenko
-*********************************************************
-* The function IFSHEQC gives the result of *
-* the comparision of two character strings *
-* ignoring their trailing blanks. The length *
-* of comparision will be equal to the minimal *
-* length of significant parts of STR1,STR2. *
-* But if STR2 contains an asterisk, dividing *
-* the string on two parts, the first one is *
-* respected as the minimal portion for comparision. *
-* If STR1 is longer, the comrarision will be done *
-* for full its significant length. *
-* Examples: *
-* --------- *
-* STR1 STR2 IFSHEQC *
-* abcd abc 1 (OK) *
-* ab abc 1 (OK) *
-* ad abc 0 (NOK) *
-* a ab*cd 0 (NOK) *
-* ab ab*cd 1 (OK) *
-* abcd ab*cd 1 (OK) *
-* abcde ab*cd 0 (NOK) *
-* <blank> *ab 1 (OK) *
-* ab *ab 1 (OK) *
-* b *ab 0 (NOK) *
-*********************************************************
- IMPLICIT NONE
-*
-* -- fun & arguments --
- INTEGER IFSHEQC
- CHARACTER*(*) STR1,STR2
-*
-* -- externals --
- INTEGER LNBLNK
-*
-* -- local variables --
- INTEGER LEN1,LEN2,LEN3,LL
-*
- IFSHEQC=0
- LEN1=LNBLNK(STR1)
- LEN2=LNBLNK(STR2)
- LEN3=INDEX(STR2,'*')-1
- IF(LEN3.GE.0) THEN
- LL=MAX0(LEN1,LEN3)
- IF(LL.EQ.0) THEN
- IFSHEQC=1
- ELSE IF(LL.LE.LEN3) THEN
- IF(STR1(:LL).EQ.STR2(:LL)) IFSHEQC=1
- ELSE IF(LL.LE.LEN2-1) THEN
- IF((LEN3.EQ.0.OR.STR1(:LEN3).EQ.STR2(:LEN3)).AND.
- + STR1(LEN3+1:LL).EQ.STR2(LEN3+2:LL+1)) IFSHEQC=1
- ENDIF
- ELSE
- LL=MIN0(LEN1,LEN2)
- IF(LL.GT.0) THEN
- IF(STR1(:LL).EQ.STR2(:LL)) IFSHEQC=1
- ELSE
- IFSHEQC=1
- ENDIF
- ENDIF
- END
diff --git a/src/packlib/hepdb/examples/dbexam/cx77/jlastx.F b/src/packlib/hepdb/examples/dbexam/cx77/jlastx.F
deleted file mode 100644
index 1af98b3..0000000
--- a/src/packlib/hepdb/examples/dbexam/cx77/jlastx.F
+++ /dev/null
@@ -1,79 +0,0 @@
-*
-* $Id: jlastx.F,v 1.1.1.1 1996/02/28 16:23:42 mclareni Exp $
-*
-* $Log: jlastx.F,v $
-* Revision 1.1.1.1 1996/02/28 16:23:42 mclareni
-* Hepdb, cdlib, etc
-*
-*
- FUNCTION JLASTC(STRN,CHRS)
-* ---06.02.89---------------
- CHARACTER*(*) STRN,CHRS
-*
- JLASTC=0
- DO 111 J=LEN(STRN),1,-1
- IF(INDEX(CHRS,STRN(J:J)).NE.0) THEN
- JLASTC=J
- RETURN
- ENDIF
- 111 CONTINUE
- END
-*
-*
- FUNCTION JLASNC(STRN,CHRS)
-* ---06.02.89---------------
- CHARACTER*(*) STRN,CHRS
-*
- JLASNC=0
- DO 111 J=LEN(STRN),1,-1
- IF(INDEX(CHRS,STRN(J:J)).EQ.0) THEN
- JLASNC=J
- RETURN
- ENDIF
- 111 CONTINUE
- END
-*
-*
- FUNCTION JLASTI(STRN,CHRS)
-* ---06.02.89---------------
- CHARACTER*(*) STRN,CHRS
- CHARACTER*1 C
-*
- JLASTI=0
- LCH0=LEN(CHRS)-1
- IF(LCH0.LT.1) RETURN
-*
- DO 111 J=LEN(STRN),1,-1
- C=STRN(J:J)
- DO 112 K=1,LCH0,2
- IF(C.GE.CHRS(K:K).AND.C.LE.CHRS(K+1:K+1)) THEN
- JLASTI=J
- RETURN
- ENDIF
- 112 CONTINUE
- 111 CONTINUE
- END
-*
-*
- FUNCTION JLASNI(STRN,CHRS)
-* ---06.02.89---------------
- CHARACTER*(*) STRN,CHRS
- CHARACTER*1 C
-*
- JLASNI=0
- LCH0=LEN(CHRS)-1
- IF(LCH0.LT.1) RETURN
-*
- DO 111 J=LEN(STRN),1,-1
- C=STRN(J:J)
- IFYES=0
- DO 112 K=1,LCH0,2
- IF(C.GE.CHRS(K:K).AND.C.LE.CHRS(K+1:K+1)) IFYES=1
- 112 CONTINUE
- IF(IFYES.EQ.0) THEN
- JLASNI=J
- RETURN
- ENDIF
- 111 CONTINUE
- END
-
diff --git a/src/packlib/hepdb/examples/dbexam/cx77/jsearx.F b/src/packlib/hepdb/examples/dbexam/cx77/jsearx.F
deleted file mode 100644
index a8f874d..0000000
--- a/src/packlib/hepdb/examples/dbexam/cx77/jsearx.F
+++ /dev/null
@@ -1,77 +0,0 @@
-*
-* $Id: jsearx.F,v 1.1.1.1 1996/02/28 16:23:42 mclareni Exp $
-*
-* $Log: jsearx.F,v $
-* Revision 1.1.1.1 1996/02/28 16:23:42 mclareni
-* Hepdb, cdlib, etc
-*
-*
- FUNCTION JSEARC(STRN,CHRS)
-* ---21.01.89---------------
- CHARACTER*(*) STRN,CHRS
-*
- JSEARC=0
- DO 111 J=1,LEN(STRN)
- IF(INDEX(CHRS,STRN(J:J)).GT.0) THEN
- JSEARC=J
- RETURN
- ENDIF
- 111 CONTINUE
- END
-*
-*
- FUNCTION JSEANC(STRN,CHRS)
-* ---21.01.89---------------
- CHARACTER*(*) STRN,CHRS
-*
- JSEANC=0
- DO 111 J=1,LEN(STRN)
- IF(INDEX(CHRS,STRN(J:J)).EQ.0) THEN
- JSEANC=J
- RETURN
- ENDIF
- 111 CONTINUE
- END
-*
-*
- FUNCTION JSEARI(STRN,CHRS)
-* ---21.01.89---------------
- CHARACTER*(*) STRN,CHRS
- CHARACTER CH
-*
- NCHR=LEN(CHRS)
- JSEARI=0
- IF(NCHR.LT.2) RETURN
-*
- DO 112 J=1,LEN(STRN)
- CH=STRN(J:J)
- DO 111 K=1,NCHR-1,2
- IF(CH.GE.CHRS(K:K).AND.CH.LE.CHRS(K+1:K+1)) THEN
- JSEARI=J
- RETURN
- ENDIF
- 111 CONTINUE
- 112 CONTINUE
- END
-*
-*
- FUNCTION JSEANI(STRN,CHRS)
-* ---21.01.89---------------
- CHARACTER*(*) STRN,CHRS
- CHARACTER CH
-*
- NCHR=LEN(CHRS)
- JSEANI=0
- IF(NCHR.LT.2) RETURN
- DO 112 J=1,LEN(STRN)
- CH=STRN(J:J)
- IFEQ=0
- DO 111 K=1,NCHR-1,2
- IF(CH.GE.CHRS(K:K).AND.CH.LE.CHRS(K+1:K+1)) IFEQ=1
- 111 CONTINUE
- IF(IFEQ.EQ.0) THEN
- JSEANI=J
- RETURN
- ENDIF
- 112 CONTINUE
- END
diff --git a/src/packlib/hepdb/examples/dbexam/cx77/texarr.F b/src/packlib/hepdb/examples/dbexam/cx77/texarr.F
deleted file mode 100644
index 8e56a04..0000000
--- a/src/packlib/hepdb/examples/dbexam/cx77/texarr.F
+++ /dev/null
@@ -1,113 +0,0 @@
-*
-* $Id: texarr.F,v 1.1.1.1 1996/02/28 16:23:42 mclareni Exp $
-*
-* $Log: texarr.F,v $
-* Revision 1.1.1.1 1996/02/28 16:23:42 mclareni
-* Hepdb, cdlib, etc
-*
-*
- SUBROUTINE TEXARR(LINE,JPAK,IFTX,LEVL,MXAR,NACT,RARR)
-* -----------------------****-****-----------****-====-
-*
- CHARACTER*(*) LINE
- REAL*4 RARR(MXAR)
- INTEGER*4 IARR(MXAR)
-*
- LOGICAL IFREAL
- CHARACTER*4 PRFX
-*
- IFREAL=.true.
- GOTO 10
-*
- ENTRY TEXARI(LINE,JPAK,IFTX,LEVL,MXAR,NACT,IARR)
-* -----------------------****-****-----------****-====-
-*
- IFREAL=.false.
-*
- 10 CONTINUE
-*
- IF(NACT.LT.0.OR.NACT.GT.MXAR) NACT=0
-*
- NAC=0
- IOK=0
- RDV=0
- IDV=0
- 12 CONTINUE
- CALL TEXINS(LINE,JPAK,IFTX,PRFX,NUMB,FNUM)
- NXL=IFTX-(IFTX/4)*4
-*
- IF(IOK.LE.0) THEN
- IF(PRFX.EQ.'=') THEN
- NAC=MAX0(NAC,NACT)
- IOK=1
-*
- ELSE IF(PRFX.EQ.'$') THEN
- IDV=NUMB
- IF(IDV.EQ.0) IDV=1
- RDV=FNUM
- IF(RDV.EQ.0) RDV=1
- ELSE IF(PRFX.EQ.'*') THEN
- NAC=MAX0(NAC,1)
- IF(IFREAL) THEN
- RV=RARR(NAC)
- ELSE
- IV=IARR(NAC)
- ENDIF
-*
- DO I=NAC+1,MIN0(NAC+NUMB-1,MXAR)
- IF(IFREAL) THEN
- RV=RV+RDV
- RARR(I)=RV
- ELSE
- IV=IV+IDV
- IARR(I)=IV
- ENDIF
- ENDDO
- NAC=MIN0(NAC+NUMB-1,MXAR)
-*
- ELSE IF(PRFX.EQ.'>') THEN
- IF(IDV.EQ.0) IDV=1
- IF(RDV.EQ.0) RDV=1.
- NAC=MAX0(NAC,1)
-
- IF(IFREAL) THEN
- RV=RARR(NAC)
- NN=ABS(FNUM-RV)/ABS(RDV)+1.5
- IF(FNUM.LT.RV) RDV=-ABS(RDV)
- ELSE
- IV=IARR(NAC)
- NN=IABS(NUMB-IV)/IABS(IDV)+1
- IF(NUMB.LT.IV) IDV=-IABS(IDV)
- ENDIF
-*
- DO I=NAC+1,MIN0(NAC+NN-1,MXAR)
- IF(IFREAL) THEN
- RV=RV+RDV
- RARR(I)=RV
- ELSE
- IV=IV+IDV
- IARR(I)=IV
- ENDIF
- ENDDO
- NAC=MIN0(NAC+NN-1,MXAR)
-*
- ELSE
- IF(IFTX/8.GT.0) THEN
- NAC=NAC+1
- IF( IFREAL) RARR(NAC)=FNUM
- IF(.NOT.IFREAL) IARR(NAC)=NUMB
- ELSE IF(NXL.GE.LEVL) THEN
- NAC=NAC+1
- ENDIF
- ENDIF
-*
- IF(NAC.GE.MXAR) THEN
- NACT=MXAR
- IOK=1
- ENDIF
- ENDIF
-*
- IF(NXL.GE.LEVL) GOTO 12
-*
- IF(IOK.EQ.0) NACT=NAC
- END
diff --git a/src/packlib/hepdb/examples/dbexam/cx77/texerr.F b/src/packlib/hepdb/examples/dbexam/cx77/texerr.F
deleted file mode 100644
index af4950d..0000000
--- a/src/packlib/hepdb/examples/dbexam/cx77/texerr.F
+++ /dev/null
@@ -1,54 +0,0 @@
-*
-* $Id: texerr.F,v 1.1.1.1 1996/02/28 16:23:42 mclareni Exp $
-*
-* $Log: texerr.F,v $
-* Revision 1.1.1.1 1996/02/28 16:23:42 mclareni
-* Hepdb, cdlib, etc
-*
-*
- SUBROUTINE TEXERR(PRETX,LINTX,IFCL,JPK1,JPK2,POSTX,LERMS,ERRMS)
-* ---------------------------------------------------=====,=====-
-*
- CHARACTER*(*) PRETX,LINTX,POSTX,ERRMS
- CHARACTER*10 COLTX
-*
-C JPAK=((JTX*200+JNM)*200+JNX)*200+JMX
-*
- LLTX=LEN(LINTX)
- LERM=LEN(ERRMS)
-*
- ERRMS=PRETX
- LERMS=MIN0(LEN(PRETX),LERM)
- J1=MOD(JPK1/8000000,200)
- IF(J1.GT.0.AND.J1.LE.LLTX) THEN
- J1=MAX0(J1,1)
- IF(JSEARC(' ,/',LINTX(J1:J1)).GT.0) J1=MAX0(J1-1,1)
- J2=MIN0(MAX0(MOD(JPK2/200,200),1),LLTX)
- IF(LINTX(J2:J2).NE.' ') J2=MAX0(J2-1,1)
- J1=MIN0(J1,J2)
- IF(IFCL.NE.0.OR.JSEANC(LINTX(J1:J2),' ,/').LE.0) THEN
- LL=1
- COLTX(LL:LL)='['
- CALL ENCODI(J1,-1,COLTX(LL+1:),LR)
- LL=LL+LR+1
- COLTX(LL:LL)=':'
- IF(IFCL.LT.0) COLTX(LL:LL)='_'
- CALL ENCODI(J2,-1,COLTX(LL+1:),LR)
- LL=LL+LR+1
- COLTX(LL:LL)=']'
- IF(LERMS.LT.LERM) ERRMS(LERMS+1:)=COLTX
- LERMS=MIN0(LERMS+LL,LERM)
- ENDIF
- IF(IFCL.GE.0) THEN
- IF(LERMS.LT.LERM) ERRMS(LERMS+1:)=LINTX(J1:J2)
- LERMS=MAX0(LERMS+1,JLASNC(ERRMS,' '))
- ENDIF
- ELSE
- IF(LERMS.LT.LERM) ERRMS(LERMS+1:)='[eol]'
- LERMS=MIN0(LERMS+5,LERM)
- ENDIF
- IF(LERMS.LT.LERM) THEN
- ERRMS(LERMS+1:)=POSTX
- LERMS=MIN0(LERMS+LEN(POSTX),LERM)
- ENDIF
- END
diff --git a/src/packlib/hepdb/examples/dbexam/cx77/texins.F b/src/packlib/hepdb/examples/dbexam/cx77/texins.F
deleted file mode 100644
index 9859a92..0000000
--- a/src/packlib/hepdb/examples/dbexam/cx77/texins.F
+++ /dev/null
@@ -1,254 +0,0 @@
-*
-* $Id: texins.F,v 1.1.1.1 1996/02/28 16:23:42 mclareni Exp $
-*
-* $Log: texins.F,v $
-* Revision 1.1.1.1 1996/02/28 16:23:42 mclareni
-* Hepdb, cdlib, etc
-*
-*
- SUBROUTINE TEXINS(STRN,JPAK,IFTX,PRFX,INUM,FNUM)
-* ---15.09.88------------****-====-====-====-====-
-*
- CHARACTER*(*) STRN,PRFX
-*
- PARAMETER (MAXPOS=2147483647)
- EQUIVALENCE(IN,FN)
- CHARACTER*1 CH,C2,C3
-*
-* Get info from JPAK
- JNX=MAX0(MOD(JPAK/200,200),1)
- JMX=MOD(JPAK,200)
- IF(JMX.EQ.0) JMX=MIN0(LEN(STRN),199)
-*
-* Init pointers,prefix and numbers
- JTX=0
- JNM=0
- PRFX=' '
- JEP=0
- INUM=0
- FNUM=0
-*
-* Init IFTX components
- IFNM=0
- IFPR=0
- IFNX=0
-*
-* Return with IFTX=0 if string is already finished
- IF(JNX.GT.JMX) GOTO 90
-* Else go on
-* Init number attributes
- ISN=0
- IJS=0
- FRAC=-1.
-*
-* They will be very useful
- IC0=ICHAR('0')
- ICA=ICHAR('A')-10
- LCA=ICHAR('a')-10
- LIMTST=(MAXPOS-9)/10
- LIMHEX=MAXPOS/16+1
-*
-* Get starting
- J=JNX
- JNX=0
-* JNX >0 will force end of scan
- 10 CONTINUE
-*
- CH=STRN(J:J)
- C2=' '
- C3=' '
- IF(J.LT.JMX) C2=STRN(J+1:J+1)
- IF(J.LT.JMX-1) C3=STRN(J+2:J+2)
-*
- IF(CH.EQ.' ') THEN
-* no actoin with leading blanc
-* end of level=1 by blanc after text
- IF(JTX.GT.0) THEN
- JNX=J+1
- IFNX=1
- ENDIF
-*
- ELSE IF(CH.EQ.',') THEN
-* end of level=2 by comma
- IF(JTX.LE.0) JTX=J
- JNX=J+1
- IFNX=2
- IF(C2.EQ.' ') IFNX=1
-*
- ELSE IF(CH.EQ.'/') THEN
-* end of level=3 by slash
- IF(JTX.LE.0) JTX=J
- JNX=J+1
- IFNX=3
- IF(C2.EQ.' ') IFNX=1
-*
- ELSE
-* =================================
-* ===== It isn't a delimiter ======
-*
- IF(IFNM.LE.0) THEN
-* ------- Non number stage --------
- IF(JTX.LE.0) THEN
-* Something is encountered
- JTX=J
- IFTX=0
- ENDIF
-*
- C2=' '
- C3=' '
- IF(J.LT.JMX) C2=STRN(J+1:J+1)
- IF(J.LT.JMX-1) C3=STRN(J+2:J+2)
-*
- IF(CH.GE.'0'.AND.CH.LE.'9') THEN
-* Int.number start by a digit
- IFNM=1
- ELSE IF(CH.EQ.'+'.OR.CH.EQ.'-') THEN
- IF(C2.EQ.'.') THEN
- IF(C3.GE.'0'.AND.C3.LE.'9') THEN
-* Flt.number start by sign, point and digit
- IFNM=3
- IF(CH.EQ.'-') ISN=1
- FRAC=.1
- IJS=2
- ENDIF
-*
- ELSE IF(C2.GE.'0'.AND.C2.LE.'9') THEN
-* Int.number start by sign and digit
- IFNM=1
- IF(CH.EQ.'-') ISN=1
- IJS=1
- ENDIF
- ELSE IF(CH.EQ.'.') THEN
- IF(C2.GE.'0'.AND.C2.LE.'9') THEN
-* Flt.number start by point and digit
- IFNM=3
- IJS=1
- FRAC=.1
- ENDIF
- ELSE IF(CH.EQ.'#'.AND.C2.EQ.''''.AND.
- + (C3.GE.'0'.AND.C3.LE.'9'.OR.
- + C3.GE.'A'.AND.C3.LE.'F'.OR.
- + C3.GE.'a'.AND.C3.LE.'f') ) THEN
-* Hex.number start by #'h...
- IFNM=2
- IJS=2
- ENDIF
- IF(IFNM.GT.0) THEN
-* Mark start of number and correct
-* J position to its 1st digit
- JNM=J
- J=J+IJS
- ELSE
-* Not a number, joint this char to prefix
- JEP=J
- ENDIF
- ENDIF
-*
-* ---------number stage-------------
- IF(IFNM.GT.0) THEN
- CH=STRN(J:J)
- ICH=ICHAR(CH)
-*
-* If char is a digit, get in IV its value, else IV=-1
-* But if char is the flt.point, IV=99 and IFNM=3 are forced
- IV=-1
- IF(CH.GE.'0'.AND.CH.LE.'9') THEN
- IV=ICH-IC0
- ELSE IF(CH.EQ.'.'.AND.IFNM.NE.2.AND.FRAC.LT.0.) THEN
- IF(IFNM.EQ.1) FNUM=INUM
- IFNM=MAX0(IFNM,3)
- FRAC=.1
- IV=99
- ELSE IF(IFNM.EQ.2) THEN
- IF(CH.GE.'A'.AND.CH.LE.'F') IV=ICH-ICA
- IF(CH.GE.'a'.AND.CH.LE.'f') IV=ICH-LCA
- ENDIF
-* IV is defined.
-*
-*
- IF(IV.GE.0) THEN
-* Here we have a legal digit or, may be, flt.point
-* - - - - - - - - - - - - - - - - - - - - - - - - -
-*
- IF(IFNM.EQ.1.AND.INUM.GT.LIMTST) THEN
-* Test on possibility of integer overflow
- IF(INUM.GT.(MAXPOS-IV)/10) THEN
-* if it will occur, mark it in IFNM
-* and turn to the float mode
- IFNM=7
- FNUM=INUM
- ENDIF
- ENDIF
-*
- IF(IFNM.EQ.1) THEN
-* Integer
- INUM=INUM*10+IV
-*
- ELSE IF(IFNM.EQ.2) THEN
-* Hexadecimal
- IF(INUM.LT.LIMHEX) THEN
- INUM=INUM*16+IV
- ELSE
- INUM=(INUM-LIMHEX)*16-MAXPOS-1+IV
- ENDIF
-*
- ELSE IF(IFNM.GE.3) THEN
-* Flt.point
- IF(IV.NE.99) THEN
- IF(FRAC.LE.0.) THEN
-* Entiere part
- FNUM=FNUM*10.+FLOAT(IV)
- ELSE
-* Fraction part
- FNUM=FNUM+FLOAT(IV)*FRAC
- FRAC=FRAC/10.
- ENDIF
- ENDIF
- ENDIF
-* - - - - - - - - - - - - - - - - - - - - - - - - -
- ELSE
-* The char isn't acceptable for the number,the scan
-* be stopped with IFNX=3. But .'. may conclude
-* the hexa number and be included into number text.
- JNX=J
- IF(IFNM.EQ.2.AND.CH.EQ.'''') JNX=J+1
- IFNX=3
-* - - - - - - - - - - - - - - - - - - - - - - - - -
- ENDIF
-*
- ENDIF
- ENDIF
-*
-* Next char position and repeate or stop
- J=J+1
- IF(J.GT.JMX.AND.JNX.LE.0) JNX=J
- IF(JNX.LE.0) GOTO 10
-*
- 88 CONTINUE
- IF(JNX.GT.JMX) GOTO 89
- IF(STRN(JNX:JNX).NE.' ') GOTO 89
- JNX=JNX+1
- GOTO 88
- 89 CONTINUE
-*
- IF(JNX.GT.JMX) IFNX=0
-*
-* ============ Stop =================
- 90 CONTINUE
-*
- JPAK=((JTX*200+JNM)*200+JNX)*200+JMX
-*
- IF(JEP.GT.0) PRFX=STRN(JTX:JEP)
- IF(PRFX.NE.' ') IFPR=1
-*
- IFTX=IFNM*8+IFPR*4+IFNX
-*
- IF(ISN.NE.0) THEN
-* Is negative
- INUM=-INUM
- FNUM=-FNUM
- ENDIF
-*
- IF(IFNM.EQ.1.OR.IFNM.EQ.2) FNUM=INUM
-*
- END
diff --git a/src/packlib/hepdb/examples/dbexam/cx77/texnme.F b/src/packlib/hepdb/examples/dbexam/cx77/texnme.F
deleted file mode 100644
index 1f79a87..0000000
--- a/src/packlib/hepdb/examples/dbexam/cx77/texnme.F
+++ /dev/null
@@ -1,108 +0,0 @@
-*
-* $Id: texnme.F,v 1.1.1.1 1996/02/28 16:23:42 mclareni Exp $
-*
-* $Log: texnme.F,v $
-* Revision 1.1.1.1 1996/02/28 16:23:42 mclareni
-* Hepdb, cdlib, etc
-*
-*
- SUBROUTINE TEXNME(STRN,JPAK,IFTX,NAME)
-* ---15.09.88------------****-====-====-
-*
- CHARACTER*(*) STRN,NAME
-*
- EQUIVALENCE(IN,FN)
-*
- CHARACTER*1 CH,C2,C3
-*
-* Get info from JPAK
- JNX=MAX0(MOD(JPAK/200,200),1)
- JMX=MOD(JPAK,200)
- IF(JMX.EQ.0) JMX=MIN0(LEN(STRN),199)
-*
-* Init pointers & prefix
- JTX=0
- JNM=0
- NAME=' '
- JEP=0
-*
-* Init IFTX components
- IFNM=0
- IFPR=0
- IFNX=0
-*
-* Return with IFTX=0 if string is already finished
- IF(JNX.GT.JMX) GOTO 90
-* Else go on
-*
-* Get starting
- J=JNX
- JNX=0
-* JNX >0 will force end of scan
- 10 CONTINUE
-*
- CH=STRN(J:J)
- C2=' '
- C3=' '
- IF(J.LT.JMX) C2=STRN(J+1:J+1)
- IF(J.LT.JMX-1) C3=STRN(J+2:J+2)
-*
- IF(CH.EQ.' ') THEN
-* no actoin with leading blanc
-* end of level=1 by blanc after text
- IF(JTX.GT.0) THEN
- JNX=J+1
- IFNX=1
- ENDIF
-*
- ELSE IF(CH.EQ.',') THEN
-* end of level=2 by comma
- IF(JTX.LE.0) JTX=J
- JNX=J+1
- IFNX=2
-*
- ELSE IF(CH.EQ.'/') THEN
-* end of level=3 by slash
- IF(JTX.LE.0) JTX=J
- JNX=J+1
- IFNX=3
- IF(C2.EQ.' ') IFNX=1
-*
- ELSE
-* =================================
-* ===== It isn't a delimiter ======
-*
- IF(JTX.LE.0) THEN
-* Something is encountered
- JTX=J
- IFTX=0
- ENDIF
- JEP=J
-*
- ENDIF
-*
-* Next char position and repeate or stop
- J=J+1
- IF(J.GT.JMX.AND.JNX.LE.0) JNX=J
- IF(JNX.LE.0) GOTO 10
-*
- 88 CONTINUE
- IF(JNX.GT.JMX) GOTO 89
- IF(STRN(JNX:JNX).NE.' ') GOTO 89
- JNX=JNX+1
- GOTO 88
- 89 CONTINUE
-*
- IF(JNX.GT.JMX) IFNX=0
-*
-* ============ Stop =================
- 90 CONTINUE
-*
- JPAK=JTX*8000000+JNX*200+JMX
-*
- IF(JEP.GT.0) NAME=STRN(JTX:JEP)
- IF(NAME.NE.' ') IFPR=1
-*
- IFTX=IFPR*4+IFNX
-*
- END
diff --git a/src/packlib/hepdb/examples/dbexam/cx77/texstr.F b/src/packlib/hepdb/examples/dbexam/cx77/texstr.F
deleted file mode 100644
index 8cfa3e1..0000000
--- a/src/packlib/hepdb/examples/dbexam/cx77/texstr.F
+++ /dev/null
@@ -1,106 +0,0 @@
-*
-* $Id: texstr.F,v 1.1.1.1 1996/02/28 16:23:43 mclareni Exp $
-*
-* $Log: texstr.F,v $
-* Revision 1.1.1.1 1996/02/28 16:23:43 mclareni
-* Hepdb, cdlib, etc
-*
-*
- SUBROUTINE TEXSTR(LINE,JPAK,IFTX,STRN)
-* ---10.03.94------------****-====-====-
-* -- Author : Boris Khomenko
-* This routine selects any text limited
-* by blanks and/or commas within a LINE's
-* segment defined by pointers inside JPAK.
-* JPAK returns new values of pointers;
-* IFTX contains result flags;
-* STRN returns the found text or " ".
-*
- IMPLICIT NONE
- CHARACTER*(*) LINE , STRN
- INTEGER JPAK , IFTX
-*
- INTEGER IFPR , IFNX
- INTEGER JTX , JNX , JMX
- INTEGER J , JEP
-*
- CHARACTER*1 CH
-*
-* Get info from JPAK
- JNX=MAX0(MOD(JPAK/200,200),1)
- JMX=MOD(JPAK,200)
- IF(JMX.EQ.0) JMX=MIN0(LEN(LINE),199)
-*
-* Init pointers & prefix
- JTX=0
- STRN=' '
- JEP=0
-*
-* Init IFTX components (no number flag here)
- IFPR=0
- IFNX=0
-*
-* Return with IFTX=0 if string is already finished
- IF(JNX.GT.JMX) GOTO 90
-* Else go on
-*
-* Get starting
- J=JNX
- JNX=0
-* JNX >0 will force end of scan
- 10 CONTINUE
-*
- CH=LINE(J:J)
-*
- IF(CH.EQ.' ') THEN
-* no actoin with leading blanc
-* end of level=1 by blanc after text
- IF(JTX.GT.0) THEN
- JNX=J+1
- IFNX=1
- ENDIF
-*
- ELSE IF(CH.EQ.',') THEN
-* end of level=2 by comma
- IF(JTX.LE.0) JTX=J
- JNX=J+1
- IFNX=2
-*
- ELSE
-* =================================
-* ===== It isn't a delimiter ======
-*
- IF(JTX.LE.0) THEN
-* Something is encountered
- JTX=J
- IFTX=0
- ENDIF
- JEP=J
-*
- ENDIF
-*
-* Next char position and repeate or stop
- J=J+1
- IF(J.GT.JMX.AND.JNX.LE.0) JNX=J
- IF(JNX.LE.0) GOTO 10
-*
- 88 CONTINUE
- IF(JNX.GT.JMX) GOTO 89
- IF(LINE(JNX:JNX).NE.' ') GOTO 89
- JNX=JNX+1
- GOTO 88
- 89 CONTINUE
-*
- IF(JNX.GT.JMX) IFNX=0
-*
-* ============ Stop =================
- 90 CONTINUE
-*
- JPAK=JTX*8000000+JNX*200+JMX
-*
- IF(JEP.GT.0) STRN=LINE(JTX:JEP)
- IF(STRN.NE.' ') IFPR=1
-*
- IFTX=IFPR*4+IFNX
-*
- END
diff --git a/src/packlib/hepdb/examples/example/Imakefile b/src/packlib/hepdb/examples/example/Imakefile
deleted file mode 100644
index 79fe4de..0000000
--- a/src/packlib/hepdb/examples/example/Imakefile
+++ /dev/null
@@ -1,5 +0,0 @@
-SRCS_F= cdexam1.F cdexam10.F cdexam11.F cdexam12.F cdexam13.F \ @@\
- cdexam2.F cdexam3.F cdexam4.F cdexam5.F cdexam6.F cdexam7.F \ @@\
- cdexam8.F cdexam9.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/hepdb/examples/example/cdexam1.F b/src/packlib/hepdb/examples/example/cdexam1.F
deleted file mode 100644
index e8f4dea..0000000
--- a/src/packlib/hepdb/examples/example/cdexam1.F
+++ /dev/null
@@ -1,46 +0,0 @@
-*
-* $Id: cdexam1.F,v 1.1.1.1 1996/02/28 16:23:54 mclareni Exp $
-*
-* $Log: cdexam1.F,v $
-* Revision 1.1.1.1 1996/02/28 16:23:54 mclareni
-* Hepdb, cdlib, etc
-*
-*
- PROGRAM CDEXA1
-* ==============
-*
-* Create a new, empty database
-*
- PARAMETER (NWPAW=100000)
- COMMON/PAWC/PAW(NWPAW)
-*
-* Initialise Zebra, HBOOK and HEPDB
-*
- CALL CDPAW(NWPAW,NHBOOK,IDIV,'USR-DIV',5000,50000,'ZPHU',IRC)
-*
-* Unit for database access
-*
- LUNCD = 1
-*
-* Database parameters
-*
- NPAIR = 1
- NPRE = 200
- NTOP = 1
- NQUO = 65000
-*
-* Accept default record length (1024 words)
-*
- LRECL = 0
- CALL CDNEW(LUNCD,'HEPDB','HEPDB.DBS',IDIV,NPAIR,NQUO,NPRE,NTOP,
- + LRECL,'F',IRC)
-*
-* Set the log level
-*
- CALL CDLOGL(' ',3,'A',IRC)
-*
-* Terminate
-*
- CALL CDEND(' ','A',IRC)
-
- END
diff --git a/src/packlib/hepdb/examples/example/cdexam10.F b/src/packlib/hepdb/examples/example/cdexam10.F
deleted file mode 100644
index 2d5e66e..0000000
--- a/src/packlib/hepdb/examples/example/cdexam10.F
+++ /dev/null
@@ -1,96 +0,0 @@
-*
-* $Id: cdexam10.F,v 1.1.1.1 1996/02/28 16:23:55 mclareni Exp $
-*
-* $Log: cdexam10.F,v $
-* Revision 1.1.1.1 1996/02/28 16:23:55 mclareni
-* Hepdb, cdlib, etc
-*
-*
- PROGRAM CDEXA10
-* ===============
-*
-* Test Fortran CDUSE routine
-*
- common/quest/iquest(100)
- PARAMETER (NWPAW=100000)
- COMMON/PAWC/NWP,IXPAWC,IHDIV,IXHIGZ,IXKU,FENC(5),LMAIN,HCV(NWPAW)
- DIMENSION IQ(2),Q(2),LQ(8000)
- EQUIVALENCE (LQ(1),LMAIN),(IQ(1),LQ(9)),(Q(1),IQ(1))
- PARAMETER (NKEYS=14)
- PARAMETER (MAXOBJ=1000)
- PARAMETER (NW=100)
- DIMENSION KEYS(NKEYS),MASK(NKEYS)
- CHARACTER*10 CHFOR
- CHARACTER*4 CHTOP
- CHARACTER*80 CHFILE
- CHARACTER*8 CHTAG(NW)
-
- NWP = NWPAW
-*
-* Initialise Zebra, HBOOK and HEPDB
-*
- CALL CDPAW(NWPAW,NHBOOK,IDIV,'USR-DIV',5000,NWPAW,'ZPHU',IRC)
-*
-* Unit for database access
-*
- LUNCD = 1
-*
-* Unit for database update (via journal files)
-*
- LUNFZ = 2
-*
-* Find the database file and construct the top directory name
-*
- CALL CDPREF(10,'CH',CHTOP,CHFILE,IRC)
-*
-* Open the database file
-*
- LRECL = 0
- CALL CDOPEN(LUNCD,LUNFZ,CHTOP,CHFILE,LRECL,IDIV,' ',IRC)
-*
-* Open another db
-*
- CALL CDPREF(10,'C2',CHTOP,CHFILE,IRC)
- LRECL = 0
- LUNCD1 = 3
- LUNFZ1 = 4
- CALL CDOPEN(LUNCD1,LUNFZ1,CHTOP,CHFILE,LRECL,IDIV,' ',IRC)
-*
-* Set the log level
-*
- CALL CDLOGL(' ',3,'A',IRC)
-*
-* Get objects using full path
-*
- NUMRUN = 1
- CALL CDUSE('//CDCH/GEOMETRY/CALOR/MASK',LBANK,NUMRUN,'ADF',IRC)
- PRINT *,NUMRUN,LBANK,IRC
-
- CALL MZDROP(IDIV,LBANK,' ')
- LBANK = 0
-*
-* Get objects using alias
-*
- CALL CDUSE('%3018',LBANK,NUMRUN,'ADF',IRC)
- PRINT *,NUMRUN,LBANK,IRC
- CALL MZDROP(IDIV,LBANK,' ')
- LBANK = 0
-*
-* Get objects using alias
-*
- CALL CDUSE('%3071',LBANK,NUMRUN,'ADF',IRC)
- PRINT *,NUMRUN,LBANK,IRC
- CALL CDUSE('%3018',LBANK,NUMRUN,'ADF',IRC)
- PRINT *,NUMRUN,LBANK,IRC
-
- CALL CDUSE('%3071',LBANK,NUMRUN,'ADF',IRC)
- PRINT *,NUMRUN,LBANK,IRC
-
- CALL CDUSE('//CDC2/5152',LBANK,NUMRUN,'ADF',IRC)
- PRINT *,NUMRUN,LBANK,IRC
-*
-* Terminate
-*
- CALL CDEND(' ','A',IRC)
-
- END
diff --git a/src/packlib/hepdb/examples/example/cdexam11.F b/src/packlib/hepdb/examples/example/cdexam11.F
deleted file mode 100644
index 4c182ab..0000000
--- a/src/packlib/hepdb/examples/example/cdexam11.F
+++ /dev/null
@@ -1,79 +0,0 @@
-*
-* $Id: cdexam11.F,v 1.1.1.1 1996/02/28 16:23:55 mclareni Exp $
-*
-* $Log: cdexam11.F,v $
-* Revision 1.1.1.1 1996/02/28 16:23:55 mclareni
-* Hepdb, cdlib, etc
-*
-*
- PROGRAM CDEXA11
-* ===============
-*
-* Test Fortran CDUSE and CDVECT routines
-*
- COMMON/QUEST/IQUEST(100)
- PARAMETER (NWPAW=100000)
- COMMON/PAWC/NWP,IXPAWC,IHDIV,IXHIGZ,IXKU,FENC(5),LMAIN,HCV(NWPAW)
- DIMENSION IQ(2),Q(2),LQ(8000)
- EQUIVALENCE (LQ(1),LMAIN),(IQ(1),LQ(9)),(Q(1),IQ(1))
- common/mylink/lbank
- PARAMETER (NKEYS=14)
- PARAMETER (MAXOBJ=1000)
- PARAMETER (NW=100)
- DIMENSION KEYS(NKEYS),MASK(NKEYS)
- dimension numrun(2)
- dimension ivect(100)
- CHARACTER*10 CHFOR
- CHARACTER*4 CHTOP
- CHARACTER*80 CHFILE
- CHARACTER*8 CHTAG(NW)
-
- NWP = NWPAW
-*
-* Initialise Zebra, HBOOK and HEPDB
-*
- CALL CDPAW(NWPAW,NHBOOK,IDIV,'USR-DIV',5000,NWPAW,'ZPHU',IRC)
-* call hlimit(nwpaw)
- call mzlogl(ixpawc,3)
- call mzlink(ixpawc,'/MYLINK/',lbank,lbank,lbank)
-*
-* Unit for database access
-*
- LUNCD = 1
-*
-* Unit for database update (via journal files)
-*
- LUNFZ = 2
-*
-* Find the database file and construct the top directory name
-*
- CALL CDPREF(10,'W8',CHTOP,CHFILE,IRC)
-*
-* Open the database file
-*
- LRECL = 0
- CALL CDOPEN(LUNCD,LUNFZ,CHTOP,CHFILE,LRECL,IHDIV,' ',IRC)
-*
- CALL CDLOGL(' ',3,'A',IRC)
-*
-* Get objects using full path
-*
- NUMRUN(1) = 9
- numrun(2) = 3
- CALL CDUSE('//CDW8/TRG',LBANK,NUMRUN,' ',IRC)
- print 9001,iquest(1),iquest(2)
-9001 format(' IQUEST(1-2) = ',I10,1X,I10)
-*
-* Get vector
-*
- lvect = 100
- CALL CDVECT('//CDWG/TRG',IVECT,LVECT,LBANK,'G',IRC)
- print *,lvect,irc
- print *,(ivect(i),i=1,10)
-*
-* Terminate
-*
- CALL CDEND(' ','A',IRC)
- CALL MZEND
-
- END
diff --git a/src/packlib/hepdb/examples/example/cdexam12.F b/src/packlib/hepdb/examples/example/cdexam12.F
deleted file mode 100644
index d23c3a3..0000000
--- a/src/packlib/hepdb/examples/example/cdexam12.F
+++ /dev/null
@@ -1,99 +0,0 @@
-*
-* $Id: cdexam12.F,v 1.1.1.1 1996/02/28 16:23:55 mclareni Exp $
-*
-* $Log: cdexam12.F,v $
-* Revision 1.1.1.1 1996/02/28 16:23:55 mclareni
-* Hepdb, cdlib, etc
-*
-*
- PROGRAM put_get_data
-c
-c*** practice putting/retrieving data to/from tpr directory
-c
-c hr feb 94
-c
-c***********************************************************************
- parameter (nwpaw=1000000)
- COMMON /PAWC/NWP,IXPAWC,IHDIV,IXHIGZ,IXKU,FENC(5),LMAIN,HCV(NWPAW)
- DIMENSION IQ(2),Q(2),LQ(8000)
- EQUIVALENCE (LQ(1),LMAIN),(IQ(1),LQ(9)),(Q(1),IQ(1))
-
- parameter (nkeys=2)
- parameter (maxobj=1000)
- parameter (nodirs=13)
- parameter (nhbook = 1000)
-
- character*4 chtop
- character*80 chfile
-
- character*8 chtag(nkeys)
- character*10 chfor
- character*40 dname
-
- integer imask(14)
- integer keys(14)
-c-----------------------------------------------------------------------
- character*10 test_text
-
- integer ivect(10)
-
- data ivect/ 10, 9, 8, 7, 6, 5, 3, 4, 2, 1/
-
-c=======================================================================
- idiv = 0
-
- call cdpaw(nwpaw, nhbook, idiv, 'USR-DIV', 5000, 500000,
- * 'ZPHU', irc)
-
-c------------------------------------------------------------------------
-
- luncd = 1
- lunfz = 2
-
- lun_names = 10
-
- do i=1,10
- write(6,*)' ivect,i',ivect(i),i
- enddo
-
-
- call cdpref( lun_names, 'AA', chtop, chfile, irc )
- if( irc .gt. 4 ) then
- print *,' EGOPEN: stop due to fatal error from CDPREF'
- stop 16
- endif
-
- write(6,*)' after cdpref, chtop=',chtop,' chfile=',chfile,
- * ' irc=',irc
-
- lrecl = 0
- call cdopen( luncd, lunfz, chtop, chfile, lrecl, idiv, ' ', irc)
-
- write (6,*)' after cdopen, lrecl=',lrecl,' idiv=',idiv,' irc=',irc
-c-----------------------------------------------------------------------
-
- dname = '//CDAA/AUX/CALGEO'
-
- call vzero(keys,14)
-
- keys(10) = 1
-
- keys(11) = 2
- keys(12) = 3
- keys(13) = 4HRUD1
- keys(14) = 4HRUD2
-
- call cdvect( ' ',ivect, 10, laddr, 'PI', irc)
-
- write(6,*)'after cdvect laddr',laddr,'irc',irc
-
- print *,(iq(laddr+i),i=1,20)
-
- iudiv=0
- call cdstor(dname, laddr,lkybk,iudiv,keys, ' ', irc)
-
- write(6,*)'after cdstor lkybk',lkybk,'irc',irc
-
- call cdend(' ','A',irc)
-c-----------------------------------------------------------------------
- end
diff --git a/src/packlib/hepdb/examples/example/cdexam13.F b/src/packlib/hepdb/examples/example/cdexam13.F
deleted file mode 100644
index 96643b8..0000000
--- a/src/packlib/hepdb/examples/example/cdexam13.F
+++ /dev/null
@@ -1,82 +0,0 @@
-*
-* $Id: cdexam13.F,v 1.1.1.1 1996/02/28 16:23:56 mclareni Exp $
-*
-* $Log: cdexam13.F,v $
-* Revision 1.1.1.1 1996/02/28 16:23:56 mclareni
-* Hepdb, cdlib, etc
-*
-*
-c
-c*** practice retrieving data from tpr directory
-c
-c hr feb 94
-c
-c***********************************************************************
- PARAMETER (LURCOR=200000)
- COMMON/CRZT/IXSTOR,IXDIV,IFENCE(2),LEV,LEVIN,BLVECT(LURCOR)
- DIMENSION LQ(999),IQ(999),Q(999)
- EQUIVALENCE (IQ(1),Q(1),LQ(9)),(LQ(1),LEV)
- COMMON /ZUNIT/ IQREAD,IQPRNT,IQPR2,IQLOG,IQPNCH,IQTTIN,IQTYPE
- COMMON/MYLINK/LKEY
-
- CHARACTER*4 CHTOP
- CHARACTER*80 CHFILE,CHPATH,DNAME
- INTEGER IVECT(10)
-*
-* Initialise ZEBRA
-*
- CALL MZEBRA(0)
- CALL MZSTOR(IXSTOR,'/CRZT/',' ',IFENCE,LEV,BLVECT(1),BLVECT(1),
- + BLVECT(5000),BLVECT(LURCOR))
- CALL MZLOGL(IXSTOR,3)
-
- CALL MZLINK(IXSTOR,'MYLINK',LKEY,LKEY,LKEY)
- IQPRNT = 6
-
- NWP = NWPAW
-*
-* Initialise HBOOK
-*
- CALL HLIMIT(-NWP)
-*
-* Initialise HEPDB
-*
- CALL CDPAW(NWPAW,NHBOOK,IDIV,'USR-DIV',5000,50000,'U',IRC)
-
- WRITE(6,*)'irc cdpaw',irc
-
- LUNCD=1
- LUNFZ=2
- CALL CDPREF(10,'AA',chtop,chfile,irc)
-
- WRITE(6,*)'cdpref:chtop,chfile,irc',chtop,chfile,irc
-
- lrecl=0
-
- call cdopen( luncd, lunfz, chtop, chfile, lrecl, idiv, ' ', irc)
-
- write (6,*)' after cdopen, lrecl=',lrecl,' idiv=',idiv,' irc=',irc
-c-----------------------------------------------------------------------
-
- irun=2
- lkey=0
- CALL CDUSE('//CDAA/AUX/CALGEO',lkey,IRUN,'F',IRC)
-
- write(6,*)'cd use: IRC,LQ(lkey-1)',lkey,IRC,LQ(lkey-1)
-
- ldata = lq(lkey-1)
- print *,(lq(ldata+i),i=1,20)
-
- lvect=10
- CALL CDVECT('//CDAA/AUX/CALGEO',ivect,lvect,LQ(lkey-1),'GI',irc)
-
- print *,(ivect(i),i=1,lvect)
-
- write(6,*)'cdvect: irc,ivect(1)',irc,ivect(1)
-
- CALL CDEND(' ','A',IRC)
-
- write(6,*)'cdend:irc',irc
-
- stop
- end
diff --git a/src/packlib/hepdb/examples/example/cdexam2.F b/src/packlib/hepdb/examples/example/cdexam2.F
deleted file mode 100644
index eaa4309..0000000
--- a/src/packlib/hepdb/examples/example/cdexam2.F
+++ /dev/null
@@ -1,71 +0,0 @@
-*
-* $Id: cdexam2.F,v 1.1.1.1 1996/02/28 16:23:54 mclareni Exp $
-*
-* $Log: cdexam2.F,v $
-* Revision 1.1.1.1 1996/02/28 16:23:54 mclareni
-* Hepdb, cdlib, etc
-*
-*
- PROGRAM CDEXA2
-* ==============
-*
-* Modify an existing database
-*
- PARAMETER (NWPAW=100000)
- COMMON/PAWC/ PAW(NWPAW)
-*
-* Number of user keys: system, experiment and # pairs were
-* defined at database creation time
-*
- PARAMETER (NKEYS=10)
- PARAMETER (MAXOBJ=1000)
- CHARACTER*8 CHTAG(NKEYS)
- CHARACTER*10 CHFOR
- CHARACTER*4 CHTOP
- CHARACTER*80 CHFILE
-*
-* Initialise Zebra, HBOOK and HEPDB
-*
- CALL CDPAW(NWPAW,NHBOOK,IDIV,'USR-DIV',5000,50000,'ZPHU',IRC)
-*
-* Unit for database access
-*
- LUNCD = 1
-*
-* Unit for database update (via journal files)
-*
- LUNFZ = 2
-*
-* Find the database file and construct the top directory name
-*
- CALL CDPREF(10,'AA',CHTOP,CHFILE,IRC)
- IF(IRC.NE.0) THEN
- PRINT *,'CDEXAM2. stopping due to fatal error from CDPREF'
- STOP 16
- ENDIF
-*
-* Open the database file
-*
- LRECL = 0
- CALL CDOPEN(LUNCD,LUNFZ,CHTOP,CHFILE,LRECL,IDIV,' ',IRC)
-*
-* Set the log level
-*
- CALL CDLOGL(' ',3,'A',IRC)
-*
-* Create some directories
-*
- CHFOR = 'IIIIIIIIII'
- DO 10 I=1,NKEYS
- WRITE(CHTAG(I),'(A6,I2.2)') 'USRKEY',I
-10 CONTINUE
- DELTA = 0.0
- IPREC = 0
- CALL CDMDIR('//CDAA/DIRA/DIRB/DIRC/DIRD',NKEYS,CHFOR,CHTAG,MAXOBJ,
- + IPREC,DELTA,'CP',IRC)
-*
-* Terminate
-*
- CALL CDEND(' ','A',IRC)
-
- END
diff --git a/src/packlib/hepdb/examples/example/cdexam3.F b/src/packlib/hepdb/examples/example/cdexam3.F
deleted file mode 100644
index ae40e9f..0000000
--- a/src/packlib/hepdb/examples/example/cdexam3.F
+++ /dev/null
@@ -1,81 +0,0 @@
-*
-* $Id: cdexam3.F,v 1.1.1.1 1996/02/28 16:23:54 mclareni Exp $
-*
-* $Log: cdexam3.F,v $
-* Revision 1.1.1.1 1996/02/28 16:23:54 mclareni
-* Hepdb, cdlib, etc
-*
-*
- PROGRAM CDEXA3
-* ==============
-*
-* Test alias manipulation
-*
- PARAMETER (NWPAW=100000)
- COMMON/PAWC/ PAW(NWPAW)
- PARAMETER (NKEYS=10)
- PARAMETER (MAXOBJ=1000)
- CHARACTER*8 CHTAG(NKEYS)
- CHARACTER*10 CHFOR
- CHARACTER*4 CHTOP
- CHARACTER*80 CHFILE
- CHARACTER*255 CHALIA
-*
-* Initialise Zebra, HBOOK and HEPDB
-*
- CALL CDPAW(NWPAW,NHBOOK,IDIV,'USR-DIV',5000,50000,'ZPHU',IRC)
-*
-* Unit for database access
-*
- LUNCD = 1
-*
-* Unit for database update (via journal files)
-*
- LUNFZ = 2
-*
-* Find the database file and construct the top directory name
-*
- CALL CDPREF(10,'AA',CHTOP,CHFILE,IRC)
-*
-* Open the database file
-*
- LRECL = 0
- CALL CDOPEN(LUNCD,LUNFZ,CHTOP,CHFILE,LRECL,IDIV,' ',IRC)
-*
-* Set the log level
-*
- CALL CDLOGL(' ',3,'A',IRC)
-*
-* Print the current alias definitions
-*
- CALL CDALIA('//CDAA/DIRA/DIRB/DIRC/DIRD',' ','P',IRC)
- PRINT *,'CDEXAM3. return code ',IRC,' from CDALIA'
-*
-* Enter a new alias for this session
-*
- CALL CDALIA('//CDAA/DIRA/DIRB/DIRC/DIRD','FRODO','S',IRC)
- PRINT *,'CDEXAM3. return code ',IRC,' from CDALIA'
-*
-* Print the equivalence name for FRODO
-*
- CALL CDALIA(CHALIA,'FRODO','R',IRC)
- PRINT *,'CDEXA3. equivalence name for FRODO is ',
- + CHALIA(1:LENOCC(CHALIA))
-*
-* Get the current alias definitions
-*
- CHALIA = ' '
- CALL CDALIA('//CDAA/DIRA/DIRB/DIRC/DIRD',CHALIA,'G',IRC)
- PRINT *,'CDEXAM3. return code ',IRC,' from CDALIA'
- PRINT *,'CDEXA3. alias definition is ',CHALIA(1:LENOCC(CHALIA))
-*
-* Enter a different alias into the database
-*
- CALL CDALIA('//CDAA/DIRA/DIRB/DIRC/DIRD','BILBO','U',IRC)
- PRINT *,'CDEXAM3. return code ',IRC,' from CDALIA'
-*
-* Terminate
-*
- CALL CDEND(' ','A',IRC)
-
- END
diff --git a/src/packlib/hepdb/examples/example/cdexam4.F b/src/packlib/hepdb/examples/example/cdexam4.F
deleted file mode 100644
index ab2d440..0000000
--- a/src/packlib/hepdb/examples/example/cdexam4.F
+++ /dev/null
@@ -1,85 +0,0 @@
-*
-* $Id: cdexam4.F,v 1.1.1.1 1996/02/28 16:23:55 mclareni Exp $
-*
-* $Log: cdexam4.F,v $
-* Revision 1.1.1.1 1996/02/28 16:23:55 mclareni
-* Hepdb, cdlib, etc
-*
-*
- PROGRAM CDEXA3
-* ==============
-*
-* Test mnemonic name manipulation
-*
- PARAMETER (NWPAW=100000)
- COMMON/PAWC/ PAW(NWPAW)
- PARAMETER (NKEYS=10)
- PARAMETER (MAXOBJ=1000)
- PARAMETER (NW=100)
- CHARACTER*10 CHFOR
- CHARACTER*4 CHTOP
- CHARACTER*80 CHFILE
- CHARACTER*8 CHTAG(NW)
- call errset(0)
-*
-* Initialise Zebra, HBOOK and HEPDB
-*
- CALL CDPAW(NWPAW,NHBOOK,IDIV,'USR-DIV',5000,50000,'ZPHU',IRC)
-*
-* Unit for database access
-*
- LUNCD = 1
-*
-* Unit for database update (via journal files)
-*
- LUNFZ = 2
-*
-* Find the database file and construct the top directory name
-*
- CALL CDPREF(10,'AA',CHTOP,CHFILE,IRC)
-*
-* Open the database file
-*
- LRECL = 0
- CALL CDOPEN(LUNCD,LUNFZ,CHTOP,CHFILE,LRECL,IDIV,' ',IRC)
-*
-* Set the log level
-*
- CALL CDLOGL(' ',3,'A',IRC)
-*
-* Get current definitions (if any)
-*
- print *,'get current mnemonic name definitions'
- CALL CDNAME('//CDAA/DIRA/DIRB/DIRC/DIRD',NW,CHTAG,'R',IRC)
- print *,(chtag(i),i=1,nw)
-*
-* Store some definitions - these are somewhat arbitrary
-*
- CHTAG(1) = 'X'
- CHTAG(2) = 'Y'
- CHTAG(3) = 'Z'
- CHTAG(4) = 'PX'
- CHTAG(5) = 'PY'
- CHTAG(6) = 'PZ'
- CHTAG(7) = 'E'
- CHTAG(8) = 'DX'
- CHTAG(9) = 'DY'
- CHTAG(10)= 'DZ'
- print *,'store some mnemonic name definitions'
- CALL CDNAME('//CDAA/DIRA/DIRB/DIRC/DIRD',10,CHTAG,'U',IRC)
-*
-* Now print current definitions
-*
- print *,'print the mnemonic name definitions'
- CALL CDNAME('//CDAA/DIRA/DIRB/DIRC/DIRD',10,CHTAG,'P',IRC)
-*
-* and delete them
-*
-* print *,'delete the mnemonic name definitions'
-* CALL CDNAME('//CDAA/DIRA/DIRB/DIRC/DIRD',10,CHTAG,'D',IRC)
-*
-* Terminate
-*
- CALL CDEND(' ','A',IRC)
-
- END
diff --git a/src/packlib/hepdb/examples/example/cdexam5.F b/src/packlib/hepdb/examples/example/cdexam5.F
deleted file mode 100644
index 1602e4b..0000000
--- a/src/packlib/hepdb/examples/example/cdexam5.F
+++ /dev/null
@@ -1,60 +0,0 @@
-*
-* $Id: cdexam5.F,v 1.1.1.1 1996/02/28 16:23:55 mclareni Exp $
-*
-* $Log: cdexam5.F,v $
-* Revision 1.1.1.1 1996/02/28 16:23:55 mclareni
-* Hepdb, cdlib, etc
-*
-*
- PROGRAM CDEXA5
-* ==============
-*
-* Modify an existing database
-*
- PARAMETER (NWPAW=100000)
- COMMON/PAWC/ PAW(NWPAW)
- PARAMETER (NKEYS=10)
- PARAMETER (MAXOBJ=1000)
- CHARACTER*8 CHTAG(NKEYS)
- CHARACTER*10 CHFOR
- CHARACTER*4 CHTOP
- CHARACTER*80 CHFILE
-*
-* Initialise Zebra, HBOOK and HEPDB
-*
- CALL CDPAW(NWPAW,NHBOOK,IDIV,'USR-DIV',5000,50000,'ZPHU',IRC)
-*
-* Unit for database access
-*
- LUNCD = 1
-*
-* Unit for database update (via journal files)
-*
- LUNFZ = 2
-*
-* Find the database file and construct the top directory name
-*
- CALL CDPREF(10,'AA',CHTOP,CHFILE,IRC)
- IF(IRC.NE.0) THEN
- PRINT *,'CDEXAM5. stopping due to fatal error from CDPREF'
- STOP 16
- ENDIF
-*
-* Open the database file
-*
- LRECL = 0
- CALL CDOPEN(LUNCD,LUNFZ,CHTOP,CHFILE,LRECL,IDIV,' ',IRC)
-*
-* Set the log level
-*
- CALL CDLOGL(' ',3,'A',IRC)
-*
-* Delete some directories
-*
- CALL CDDDIR('//CDAA/DIRA/DIRB/DIRC/DIRD',' ',IRC)
-*
-* Terminate
-*
- CALL CDEND(' ','A',IRC)
-
- END
diff --git a/src/packlib/hepdb/examples/example/cdexam6.F b/src/packlib/hepdb/examples/example/cdexam6.F
deleted file mode 100644
index 8a70ded..0000000
--- a/src/packlib/hepdb/examples/example/cdexam6.F
+++ /dev/null
@@ -1,72 +0,0 @@
-*
-* $Id: cdexam6.F,v 1.1.1.1 1996/02/28 16:23:55 mclareni Exp $
-*
-* $Log: cdexam6.F,v $
-* Revision 1.1.1.1 1996/02/28 16:23:55 mclareni
-* Hepdb, cdlib, etc
-*
-*
- PROGRAM CDEXA6
-* ==============
-*
-* Test Zebra structure manipulation
-*
- PARAMETER (NWPAW=100000)
- COMMON/PAWC/NWP,IXPAWC,IHDIV,IXHIGZ,IXKU,FENC(5),LMAIN,HCV(NWPAW)
- DIMENSION IQ(2),Q(2),LQ(8000)
- EQUIVALENCE (LQ(1),LMAIN),(IQ(1),LQ(9)),(Q(1),IQ(1))
- PARAMETER (NKEYS=10)
- PARAMETER (MAXOBJ=1000)
- PARAMETER (NW=100)
- DIMENSION KEYS(NKEYS)
- CHARACTER*10 CHFOR
- CHARACTER*4 CHTOP
- CHARACTER*80 CHFILE
- CHARACTER*8 CHTAG(NW)
-
- NWP = NWPAW
-*
-* Initialise Zebra, HBOOK and HEPDB
-*
- CALL CDPAW(NWPAW,NHBOOK,IDIV,'USR-DIV',5000,50000,'ZPHU',IRC)
-*
-* Unit for database access
-*
- LUNCD = 1
-*
-* Unit for database update (via journal files)
-*
- LUNFZ = 2
-*
-* Find the database file and construct the top directory name
-*
- CALL CDPREF(10,'AA',CHTOP,CHFILE,IRC)
-*
-* Open the database file
-*
- LRECL = 0
- CALL CDOPEN(LUNCD,LUNFZ,CHTOP,CHFILE,LRECL,IDIV,' ',IRC)
-*
-* Set the log level
-*
- CALL CDLOGL(' ',3,'A',IRC)
-*
-* Store a bank
-*
- DO 10 I=1,NKEYS
- KEYS(I) = I*10
-10 CONTINUE
- JBIAS = 2
- CALL MZBOOK(IDIV,LADDR,LSUP,JBIAS,'TEST',0,0,50,2,0)
-
- DO 20 I=1,50
- IQ(LADDR+I) = 51 - I
-20 CONTINUE
- CALL CDSTOR('//CDAA/DIRA/DIRB/DIRC/DIRD',LADDR,LKYBK,IDIV,
- + KEYS,'A',IRC)
-*
-* Terminate
-*
- CALL CDEND(' ','A',IRC)
-
- END
diff --git a/src/packlib/hepdb/examples/example/cdexam7.F b/src/packlib/hepdb/examples/example/cdexam7.F
deleted file mode 100644
index 3cd1096..0000000
--- a/src/packlib/hepdb/examples/example/cdexam7.F
+++ /dev/null
@@ -1,65 +0,0 @@
-*
-* $Id: cdexam7.F,v 1.2 1996/04/16 06:46:46 jamie Exp $
-*
-* $Log: cdexam7.F,v $
-* Revision 1.2 1996/04/16 06:46:46 jamie
-* Correct size of /PAWC/
-*
-* Revision 1.1.1.1 1996/02/28 16:23:55 mclareni
-* Hepdb, cdlib, etc
-*
-*
- PROGRAM CDEXA7
-* ==============
-*
-* Test Fortran LD routine
-*
- PARAMETER (NWPAW=100000)
- COMMON/PAWC/NWP,IXPAWC,IHDIV,IXHIGZ,IXKU,FENC(5),LMAIN,HCV(NWPAW)
- DIMENSION IQ(2),Q(2),LQ(8000)
- EQUIVALENCE (LQ(1),LMAIN),(IQ(1),LQ(9)),(Q(1),IQ(1))
- PARAMETER (NKEYS=10)
- PARAMETER (MAXOBJ=1000)
- PARAMETER (NW=100)
- DIMENSION KEYS(NKEYS)
- CHARACTER*10 CHFOR
- CHARACTER*4 CHTOP
- CHARACTER*80 CHFILE
- CHARACTER*8 CHTAG(NW)
-
- NWP = NWPAW
-*
-* Initialise Zebra, HBOOK and HEPDB
-*
- CALL CDPAW(NWPAW,NHBOOK,IDIV,'USR-DIV',5000,50000,'ZPHU',IRC)
-*
-* Unit for database access
-*
- LUNCD = 1
-*
-* Unit for database update (via journal files)
-*
- LUNFZ = 2
-*
-* Find the database file and construct the top directory name
-*
- CALL CDPREF(10,'AA',CHTOP,CHFILE,IRC)
-*
-* Open the database file
-*
- LRECL = 0
- CALL CDOPEN(LUNCD,LUNFZ,CHTOP,CHFILE,LRECL,IDIV,' ',IRC)
-*
-* Set the log level
-*
- CALL CDLOGL(' ',3,'A',IRC)
-*
-* List directories
-*
- CALL CDLDIR('//CDAA',6,99,'CMOS',IRC)
-*
-* Terminate
-*
- CALL CDEND(' ','A',IRC)
-
- END
diff --git a/src/packlib/hepdb/examples/example/cdexam8.F b/src/packlib/hepdb/examples/example/cdexam8.F
deleted file mode 100644
index d298748..0000000
--- a/src/packlib/hepdb/examples/example/cdexam8.F
+++ /dev/null
@@ -1,65 +0,0 @@
-*
-* $Id: cdexam8.F,v 1.2 1996/04/16 06:46:47 jamie Exp $
-*
-* $Log: cdexam8.F,v $
-* Revision 1.2 1996/04/16 06:46:47 jamie
-* Correct size of /PAWC/
-*
-* Revision 1.1.1.1 1996/02/28 16:23:55 mclareni
-* Hepdb, cdlib, etc
-*
-*
- PROGRAM CDEXA8
-* ==============
-*
-* Test Fortran LS routine
-*
- PARAMETER (NWPAW=100000)
- COMMON/PAWC/NWP,IXPAWC,IHDIV,IXHIGZ,IXKU,FENC(5),LMAIN,HCV(NWPAW)
- DIMENSION IQ(2),Q(2),LQ(8000)
- EQUIVALENCE (LQ(1),LMAIN),(IQ(1),LQ(9)),(Q(1),IQ(1))
- PARAMETER (NKEYS=10)
- PARAMETER (MAXOBJ=1000)
- PARAMETER (NW=100)
- DIMENSION KEYS(NKEYS)
- CHARACTER*10 CHFOR
- CHARACTER*4 CHTOP
- CHARACTER*80 CHFILE
- CHARACTER*8 CHTAG(NW)
-
- NWP = NWPAW
-*
-* Initialise Zebra, HBOOK and HEPDB
-*
- CALL CDPAW(NWPAW,NHBOOK,IDIV,'USR-DIV',5000,50000,'ZPHU',IRC)
-*
-* Unit for database access
-*
- LUNCD = 1
-*
-* Unit for database update (via journal files)
-*
- LUNFZ = 2
-*
-* Find the database file and construct the top directory name
-*
- CALL CDPREF(10,'C2',CHTOP,CHFILE,IRC)
-*
-* Open the database file
-*
- LRECL = 0
- CALL CDOPEN(LUNCD,LUNFZ,CHTOP,CHFILE,LRECL,IDIV,' ',IRC)
-*
-* Set the log level
-*
- CALL CDLOGL(' ',3,'A',IRC)
-*
-* List directory contents
-*
- CALL CDLIST('//CDC2/5250',0,' ',0,0,0,0,'CDMPT',IRC)
-*
-* Terminate
-*
- CALL CDEND(' ','A',IRC)
-
- END
diff --git a/src/packlib/hepdb/examples/example/cdexam9.F b/src/packlib/hepdb/examples/example/cdexam9.F
deleted file mode 100644
index 2be7cef..0000000
--- a/src/packlib/hepdb/examples/example/cdexam9.F
+++ /dev/null
@@ -1,70 +0,0 @@
-*
-* $Id: cdexam9.F,v 1.2 1996/04/16 06:46:48 jamie Exp $
-*
-* $Log: cdexam9.F,v $
-* Revision 1.2 1996/04/16 06:46:48 jamie
-* Correct size of /PAWC/
-*
-* Revision 1.1.1.1 1996/02/28 16:23:55 mclareni
-* Hepdb, cdlib, etc
-*
-*
- PROGRAM CDEXA9
-* ==============
-*
-* Test Fortran CDUSEM routine
-*
- PARAMETER (NWPAW=100000)
- COMMON/PAWC/NWP,IXPAWC,IHDIV,IXHIGZ,IXKU,FENC(5),LMAIN,HCV(NWPAW)
- DIMENSION IQ(2),Q(2),LQ(8000)
- EQUIVALENCE (LQ(1),LMAIN),(IQ(1),LQ(9)),(Q(1),IQ(1))
- PARAMETER (NKEYS=14)
- PARAMETER (MAXOBJ=1000)
- PARAMETER (NW=100)
- DIMENSION KEYS(NKEYS),MASK(NKEYS)
- CHARACTER*10 CHFOR
- CHARACTER*4 CHTOP
- CHARACTER*80 CHFILE
- CHARACTER*8 CHTAG(NW)
-
- NWP = NWPAW
-*
-* Initialise Zebra, HBOOK and HEPDB
-*
- CALL CDPAW(NWPAW,NHBOOK,IDIV,'USR-DIV',5000,50000,'ZPHU',IRC)
-*
-* Unit for database access
-*
- LUNCD = 1
-*
-* Unit for database update (via journal files)
-*
- LUNFZ = 2
-*
-* Find the database file and construct the top directory name
-*
- CALL CDPREF(10,'AU',CHTOP,CHFILE,IRC)
-*
-* Open the database file
-*
- LRECL = 0
- CALL CDOPEN(LUNCD,LUNFZ,CHTOP,CHFILE,LRECL,IDIV,' ',IRC)
-*
-* Set the log level
-*
- CALL CDLOGL(' ',3,'A',IRC)
-*
-* Get objects using selection mask
-*
- NUMRUN = 1
- CALL VZERO(MASK,NKEYS)
- MASK(10) = 1
- KEYS(10) = 4271809
- CALL CDUSEM('//CDAU/AUX/HWP3',LBANK,NUMRUN,MASK,KEYS,' ',IRC)
- PRINT *,'Return code ',IRC,' from CDUSEM'
-*
-* Terminate
-*
- CALL CDEND(' ','A',IRC)
-
- END
diff --git a/src/packlib/hepdb/hepdb/Imakefile b/src/packlib/hepdb/hepdb/Imakefile
deleted file mode 100644
index d80f6cf..0000000
--- a/src/packlib/hepdb/hepdb/Imakefile
+++ /dev/null
@@ -1,15 +0,0 @@
-INCLUDES= caopti.inc caopts.inc cbconc.inc cbsrvr.inc cbsrvrn.inc \ @@\
- ccdisp.inc cdcblk.inc cdcdes.inc cdfold.inc cdilun.inc \ @@\
- cdkeys.inc cdlscm.inc cdlufm.inc cdlupc.inc cdnamc.inc \ @@\
- cdoccm.inc cdopen.inc cdrnge.inc cdtime.inc cdulnk.inc \ @@\
- cdunit.inc cduscm.inc cdwacm.inc cfzlun.inc cinitl.inc \ @@\
- ckkeys.inc clinks.inc cmulop.inc cplots.inc crccom.inc \ @@\
- csavbk.inc ctkxin.inc ctmpak.inc ctpath.inc cuserf.inc \ @@\
- cviews.inc cxlink.inc czpack.inc doc.inc dxused.inc fzstat.inc \ @@\
- hdbkeys.inc hdblun.inc hdbopt.inc hdbopta.inc hdboptc.inc \ @@\
- hdboptd.inc hdbopts.inc hdbpara.inc hdbpha.inc l3bits.inc \ @@\
- l3bitx.inc l3cores.inc nwpaw.inc p3dbl3.inc qftitlch.inc \ @@\
- quest.inc slate.inc pilot.h \@@\
- caopti.doc caopts.doc cbsrvr.doc cdcblk.doc
-
-InstallIncludes($(INCLUDES),$(CERN_INCLUDEDIR),hepdb)
diff --git a/src/packlib/hepdb/hepdb/caopti.doc b/src/packlib/hepdb/hepdb/caopti.doc
deleted file mode 100644
index 59d25ff..0000000
--- a/src/packlib/hepdb/hepdb/caopti.doc
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: caopti.doc,v 1.1 1997/01/22 16:56:55 gunter Exp $
-*
-* $Log: caopti.doc,v $
-* Revision 1.1 1997/01/22 16:56:55 gunter
-* rename files with % to be .doc files
-*
-* Revision 1.1.1.1 1996/02/28 16:24:06 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#ifndef CERNLIB_HEPDB_CAOPTI%_INC
-#define CERNLIB_HEPDB_CAOPTI%_INC
-*
-*
-* caopti%.inc
-*
-#if defined(CERNLIB__DOC)
-/CAOPTI/ (For carrying information to decode options)
- CALFCA Alphanumeric characters interpreted in character option
- CSTRCA Character string decoded as integers for Text files
- MPAKCA Byte packing parameters used for PAKBYT/UPKBYT
-#endif
-
-#endif
diff --git a/src/packlib/hepdb/hepdb/caopti.inc b/src/packlib/hepdb/hepdb/caopti.inc
deleted file mode 100644
index 7c2e60b..0000000
--- a/src/packlib/hepdb/hepdb/caopti.inc
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: caopti.inc,v 1.1.1.1 1996/02/28 16:24:04 mclareni Exp $
-*
-* $Log: caopti.inc,v $
-* Revision 1.1.1.1 1996/02/28 16:24:04 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#ifndef CERNLIB_HEPDB_CAOPTI_INC
-#define CERNLIB_HEPDB_CAOPTI_INC
-*
-*
-* caopti.inc
-*
- COMMON /CAOPTI/ CALFCA(62), CSTRCA
- CHARACTER CALFCA*1, CSTRCA*132
- COMMON /CAOPT1/ MPAKCA(2)
- INTEGER MPAKCA
-*
-
-#endif
diff --git a/src/packlib/hepdb/hepdb/caopts.doc b/src/packlib/hepdb/hepdb/caopts.doc
deleted file mode 100644
index 10123ae..0000000
--- a/src/packlib/hepdb/hepdb/caopts.doc
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: caopts.doc,v 1.1 1997/01/22 16:56:56 gunter Exp $
-*
-* $Log: caopts.doc,v $
-* Revision 1.1 1997/01/22 16:56:56 gunter
-* rename files with % to be .doc files
-*
-* Revision 1.1.1.1 1996/02/28 16:24:06 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#ifndef CERNLIB_HEPDB_CAOPTS%_INC
-#define CERNLIB_HEPDB_CAOPTS%_INC
-*
-*
-* caopts%.inc
-*
-#if defined(CERNLIB__DOC)
-/CAOPTS/ (For carrying decoded information of CHOPT)
- IOPaCA..IOPzCA Flag for each character in character option.
- Decoded by CDOPTS and set to 1 if option requested.
- IOKYCA Flag for each key element as set by CHOPT.
- Decoded and has similar meaning as IOPxCA.
-#endif
-
-#endif
diff --git a/src/packlib/hepdb/hepdb/caopts.inc b/src/packlib/hepdb/hepdb/caopts.inc
deleted file mode 100644
index d1cdbf2..0000000
--- a/src/packlib/hepdb/hepdb/caopts.inc
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: caopts.inc,v 1.1.1.1 1996/02/28 16:24:04 mclareni Exp $
-*
-* $Log: caopts.inc,v $
-* Revision 1.1.1.1 1996/02/28 16:24:04 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#ifndef CERNLIB_HEPDB_CAOPTS_INC
-#define CERNLIB_HEPDB_CAOPTS_INC
-*
-*
-* caopts.inc
-*
- PARAMETER (MXKYCA=100)
- COMMON /CAOPTS/ IOPACA, IOPBCA, IOPCCA, IOPDCA, IOPECA, IOPFCA
- + , IOPGCA, IOPHCA, IOPICA, IOPJCA, IOPKCA, IOPLCA
- + , IOPMCA, IOPNCA, IOPOCA, IOPPCA, IOPQCA, IOPRCA
- + , IOPSCA, IOPTCA, IOPUCA, IOPVCA, IOPWCA, IOPXCA
- + , IOPYCA, IOPZCA, IOKYCA(MXKYCA), IPRBCA, IPRECA
-*
-
-#endif
diff --git a/src/packlib/hepdb/hepdb/cbconc.inc b/src/packlib/hepdb/hepdb/cbconc.inc
deleted file mode 100644
index a7d48fe..0000000
--- a/src/packlib/hepdb/hepdb/cbconc.inc
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: cbconc.inc,v 1.1.1.1 1996/02/28 16:24:04 mclareni Exp $
-*
-* $Log: cbconc.inc,v $
-* Revision 1.1.1.1 1996/02/28 16:24:04 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#ifndef CERNLIB_HEPDB_CBCONC_INC
-#define CERNLIB_HEPDB_CBCONC_INC
-*
-*
-* cbconc.inc
-*
- COMMON /CBCONC/ ISYSCB(100), IUSECB(100)
-*
-
-#endif
diff --git a/src/packlib/hepdb/hepdb/cbsrvr.doc b/src/packlib/hepdb/hepdb/cbsrvr.doc
deleted file mode 100644
index 9dff136..0000000
--- a/src/packlib/hepdb/hepdb/cbsrvr.doc
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: cbsrvr.doc,v 1.1 1997/01/22 16:56:56 gunter Exp $
-*
-* $Log: cbsrvr.doc,v $
-* Revision 1.1 1997/01/22 16:56:56 gunter
-* rename files with % to be .doc files
-*
-* Revision 1.1.1.1 1996/02/28 16:24:06 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#ifndef CERNLIB_HEPDB_CBSRVR%_INC
-#define CERNLIB_HEPDB_CBSRVR%_INC
-*
-*
-* cbsrvr%.inc
-*
-#if defined(CERNLIB__DOC)
-/CBSRVR/ (For carrying information of Cache etc of VAX server)
- CACHCB Name of the cache used by the server and the client
- FILECB Complete filename of the MAPCOM file
- DIRECB Directory name of the MAPCOM files
-/CBSRVRN/ (For giving some information back to the VAX server)
- PNUPCB The directory name last updated
- LPNUCB Length of the directory name
- IAUPCB Action code used in that directory
-#endif
-
-#endif
diff --git a/src/packlib/hepdb/hepdb/cbsrvr.inc b/src/packlib/hepdb/hepdb/cbsrvr.inc
deleted file mode 100644
index 3252d8f..0000000
--- a/src/packlib/hepdb/hepdb/cbsrvr.inc
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: cbsrvr.inc,v 1.1.1.1 1996/02/28 16:24:04 mclareni Exp $
-*
-* $Log: cbsrvr.inc,v $
-* Revision 1.1.1.1 1996/02/28 16:24:04 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#ifndef CERNLIB_HEPDB_CBSRVR_INC
-#define CERNLIB_HEPDB_CBSRVR_INC
-*
-*
-* cbsrvr.inc
-*
- COMMON /CBSRVR/ CACHCB, FILECB, DIRECB
- CHARACTER CACHCB*11, FILECB*28, DIRECB*12
-*
-
-#endif
diff --git a/src/packlib/hepdb/hepdb/cbsrvrn.inc b/src/packlib/hepdb/hepdb/cbsrvrn.inc
deleted file mode 100644
index 2dfc99b..0000000
--- a/src/packlib/hepdb/hepdb/cbsrvrn.inc
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: cbsrvrn.inc,v 1.1.1.1 1996/02/28 16:24:04 mclareni Exp $
-*
-* $Log: cbsrvrn.inc,v $
-* Revision 1.1.1.1 1996/02/28 16:24:04 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#ifndef CERNLIB_HEPDB_CBSRVRN_INC
-#define CERNLIB_HEPDB_CBSRVRN_INC
-*
-*
-* cbsrvrn.inc
-*
- COMMON /CBSRVRN/PNUPCB, LPNUCB, IAUPCB
- CHARACTER*80 PNUPCB
- INTEGER*4 LPNUCB
- INTEGER*4 IAUPCB
-*
-
-#endif
diff --git a/src/packlib/hepdb/hepdb/ccdisp.inc b/src/packlib/hepdb/hepdb/ccdisp.inc
deleted file mode 100644
index c7d02b0..0000000
--- a/src/packlib/hepdb/hepdb/ccdisp.inc
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: ccdisp.inc,v 1.1.1.1 1996/02/28 16:24:04 mclareni Exp $
-*
-* $Log: ccdisp.inc,v $
-* Revision 1.1.1.1 1996/02/28 16:24:04 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#ifndef CERNLIB_HEPDB_CCDISP_INC
-#define CERNLIB_HEPDB_CCDISP_INC
-*
-*
-* ccdisp.inc
-*
- COMMON /CCDISP/ IOPHCC, IOTYCC(100), MXDPCC, NUMCCC(100)
- COMMON /CCFMTD/ CFMTCC
- CHARACTER CFMTCC*20
-*
-
-#endif
diff --git a/src/packlib/hepdb/hepdb/cdcblk.doc b/src/packlib/hepdb/hepdb/cdcblk.doc
deleted file mode 100644
index bba16b8..0000000
--- a/src/packlib/hepdb/hepdb/cdcblk.doc
+++ /dev/null
@@ -1,145 +0,0 @@
-*
-* $Id: cdcblk.doc,v 1.1 1997/01/22 16:56:57 gunter Exp $
-*
-* $Log: cdcblk.doc,v $
-* Revision 1.1 1997/01/22 16:56:57 gunter
-* rename files with % to be .doc files
-*
-* Revision 1.1.1.1 1996/02/28 16:24:06 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#ifndef CERNLIB_HEPDB_CDCBLK%_INC
-#define CERNLIB_HEPDB_CDCBLK%_INC
-*
-*
-* cdcblk%.inc
-*
-#if defined(CERNLIB__DOC)
-/GCBANK/ (For definition of the Q/IQ/LQ vectors)
- LQ,IQ,Q Dynamic memory used inside the program
- FENCCD Fence words used
-/QUEST/ (For communication with user; error code etc.)
- IQUEST Error code and other information
-/CDUSCM/ (Most commonly used ZEBRA pointers and other indices)
- IDEBCD Debug level (default set at 0 in DBINIT)
- IDISCD Division index of DBL3 system division
- IDIVCD Division index of DBL3 user division
- IHKYCD Hollerith bank name of Key banks
- IKDRCD Internal pointer to the first key in current directory
- IONOCD IO descriptor of the node bank
- KOFSCD Offset of the store containing ZEBRA system division
- KOFUCD Offset of the store containing DBL3 divisions relative
- to /GCBANK/
- LBADCD -|
- LBAFCD |
- LBDACD |
- LBFXCD |
- LBFYCD | Relocatable ZBERA addresses
- LBKYCD | Key bank
- LBNOCD | Current node bank
- LFIXCD |
- LREFCD |
- LSAVCD |
- LTOPCD -| First Top level bank (saved for all operations)
- LPRTCD Logical unit number of the standard output file
- NTOPCD Number of top level directories
- NDMXCB Maximum number of data words to store a text file
- (Offsets and mnemonics)
- IKTYCD Key descriptor in the directory bank
- KNSDCD Number of subdirectories
- KLSDCD Pointer to the first subdirectory
- NWNOCD Number of fixed words in the node bank (containing IO
- descriptor of the Key banks)
- NWITCD Number of words/directory in the Dictionary bank
- NPUSCD Number of directories to be added in one go in the
- Dictionary bank (per push)
- MAXLCD Maximum number of characters in the path name
- JRZUCD Bit in flag to tell if no packing/updating is done
- JIGNCD to tell the current object is to be ignored
- JPRTCD to tell the current directory is partitiond
- JASFCD to tell the current object is a text file
- KLKYCD Offset of the Key bank w.r.t. the node bank
- KLDACD Offset of the Data bank w.r.t. the key bank
- KLNOCD Reference link offset of the node bank from key bank
- KLUPCD link offset of the top bank from key bank
- KLDICD Offset of the dictionary bank w.r.t. the top bank
- KLFZCD of the FZDB bank (conatining list of directories
- to be updated from Journal file) w.r.t. top bank
- MFZTOP Offset of top directory name in FZDB bank
- MFZDIR of directory name in FZDB bank
- MXLWCD Maximum number of words in the directory name in FZDB
- MUPLUN Offset in UPCD of logical unit number of RZ file
- MUPFLG of flag if D.B. to be updated
- MUPJFL of logical unit number of journal file
- MUPBAK of logical unit number of backup file
- MUPDIC of identifier of the top directory
- MUPNCH of number of characters in top name
- MUPSRV of the shared/server flag
- MUPKY7 of maximum Key7 value for retrieval
- MUPNAM of name of the top directory
- MNDNWK Offset in NOCD of the number of key elements
- MNDNWD of total number of words in Key bank
- MNDNCH of number of characters in the name
- MNDDIC of unique identifier of the node
- MNDIOF of IO descriptor of the key bank
- MNDNAM of name of the path to the node
- NLKYCD Number of links in the KYCD bank
- NSKYCD Number of structural links in the KYCD bank
- MKYRID Offset in KYCD of number of physical reads from disk
- MKYCEV (from end) of number of calls to DBUSE in 1 event
- MKYCRU of number of calls to DBUSE in 1 run
- MKYPRE of precision used to store the object
- MKYFRI of FREE flag
- NLUPCD Number of links in the UPCD bank
- NSUPCD Number of structural links in the UPCD bank
- NDUPCD Number of data words in the UPCD bank
- MDCNTM Offset in DICT of the number of nodes in the dictionary
- MDCITM of unique identifier of the node
- MDCNCH of number of characters in the path name
- MDCLUP of last update to the node
- MDCALI of the alias name
- MDCNAM of the path name to the node
- NARGCD Maximum dimension of IARGCD used for printing
- LUFMCD Logical unit number for the server file (in P mode)
- IDHKSN Offset in key vector of serial number of the object
- IDHPTR of reference to the master object
- IDHUSI of source identifier (Prog Vsn)
- IDHFLG of flag
- IDHINS of insertion time
- MPSRCD of partition number
- MXKPCD of maximum number per partition
- MOBJCD of lowest serial number (-1) in
- current partition
- MHFMCD Offset in | of height of the frame
- MLEVCD the bank | level number
- MNAMCD created in | node name
- MNCHCD DBFPAT of | number of characters in node name
- MNDWCD directory | number of down nodes
- MNFNCD information | upward node number
- MNLVCD used for | number of levels
- MNNUCD display etc.| node number
- MNODCD number of nodes in the level
- MPNNCD pointer to the first node
- MPNLCD pointer to next level/node
- MPPLCD pointer to previous level
- MXOFCD X-offset of the level
- MXWDCD X-width of the level
- MYFLCD Y-offset of the level
- MYFNCD Y-offset of the node
-/CDCBLK/ (Additional flags and pointers)
- LCDRCD -| ZEBRA pointers in the | Current directory
- LJNKCD -| ZEBRA system divsion |
- IBIGCD Maximum end validity range value
- INSRCD Initialization flag in server mode
- IODICD IO descriptor of the Dictionary bank
- IOFDCD of the FDDB bank
- IOFZCD of the FZDB bank
- IOVRCD Overwrite flag in DBFZUP
- KYENCD Logical end validity of the current object
- MXINCD Maximum allowed insertion time for data retrieval
- IOKYCD IO descriptor of the Key bank
- IARGCD Buffer for printout
-#endif
-
-#endif
diff --git a/src/packlib/hepdb/hepdb/cdcblk.inc b/src/packlib/hepdb/hepdb/cdcblk.inc
deleted file mode 100644
index 1f4808c..0000000
--- a/src/packlib/hepdb/hepdb/cdcblk.inc
+++ /dev/null
@@ -1,59 +0,0 @@
-*
-* $Id: cdcblk.inc,v 1.1.1.1 1996/02/28 16:24:04 mclareni Exp $
-*
-* $Log: cdcblk.inc,v $
-* Revision 1.1.1.1 1996/02/28 16:24:04 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#ifndef CERNLIB_HEPDB_CDCBLK_INC
-#define CERNLIB_HEPDB_CDCBLK_INC
-*
-*
-* cdcblk.inc
-*
- COMMON /GCBANK/ FENCCD(22), LQ(9)
- DIMENSION IQ(2), Q(2)
- EQUIVALENCE (IQ(1),Q(1),LQ(9))
-*
- COMMON /QUEST/ IQUEST(100)
-*
- PARAMETER (IKTYCD=33, KNSDCD=23, KLSDCD=26, NWNOCD=16)
- PARAMETER (KLKDCD=27, KNKDCD=31)
- PARAMETER (NWITCD=28, NPUSCD=50, MAXLCD=80, MXPACD=10)
- PARAMETER (JRZUCD=1, JIGNCD=2, JPRTCD=3, JASFCD=4)
- PARAMETER (KLKYCD=0, KLDACD=1, KLNOCD=2, KLUPCD=3, KLDICD=2)
- PARAMETER (KLFZCD=3, MFZTOP=1, MFZDIR=5, MXLWCD=20)
- PARAMETER (MNDNWK=1, MNDNWD=2, MNDNCH=3, MNDDIC=4)
- PARAMETER (MNDIOF=5, MNDNAM=NWNOCD+5, NLKYCD=3, NSKYCD=1)
- PARAMETER (MKYRID=-4, MKYCEV=-3, MKYCRU=-2, MKYPRE=-1)
- PARAMETER (MKYFRI=0)
- PARAMETER (MDCNTM=1, MDCITM=1, MDCNCH=2, MDCLUP=3, MDCCMP=4)
- PARAMETER (MDCPRC=5, MDCDEL=6, MDCALI=7, MDCNAM=9)
- PARAMETER (NARGCD=20)
- PARAMETER (MUPLUN=1, MUPFLG=2, MUPSRV=3, MUPSHR=4, MUPAIR=5)
- PARAMETER (MUPDIC=6, MUPKIN=7, MUPJFL=8, MUPBAK=9,MUPNCH=10)
- PARAMETER (MUPKY7=7, MUPNAM=11,MUPHFL=MUPNAM+4)
- PARAMETER (NLUPCD=3, NSUPCD=2, NDUPCD=MUPHFL)
-#include "hepdb/cdlufm.inc"
- PARAMETER (IDHKSN=1, IDHPTR=2, IDHFLG=3, IDHINS=4, IDHUSI=6,
- + IDHSRN=7, IDHEX1=8, IDHEX2=9, IDHEX3=10)
-* For DBL3
-* PARAMETER (IDHKSN=1, IDHPTR=2, IDHFLG=6, IDHINS=7, IDHUSI=5)
- PARAMETER (MPSRCD=1, MXKPCD=2, MOBJCD=5)
- PARAMETER (MHFMCD=3, MLEVCD=3, MNAMCD=7, MNCHCD=5, MNDWCD=4)
- PARAMETER (MNFNCD=3, MNLVCD=2, MNNUCD=2, MNODCD=4, MPNNCD=2)
- PARAMETER (MPNLCD=1, MPPLCD=8, MXOFCD=5, MXWDCD=6, MYFLCD=7)
- PARAMETER (MYFNCD=6)
- COMMON /CDCBLK/ LCDRCD, LJNKCD, IBIGCD, INSRCD, IOVRCD
- + , KYENCD(MXPACD), IARGCD(NARGCD)
- COMMON /CDIOBK/ IODICD, IOFDCD, IOFZCD, IOKYCD(NWNOCD), IONOCD
- + , IOUPCD
- COMMON /CDUPCD/ IOPPCD, IOPSCD, ITOPCD, IOUTCD, LUBKCD, LUFZCD
- + , LURZCD, MXINCD, NCHRCD, NPARCD, IHFLCD
- COMMON /CDDICD/ DELTCD, ICMPCD, IPRECD, ITNUCD, LUPDCD
- COMMON /CDCHVR/ TOPNCD, CALICD
- CHARACTER TOPNCD*16, CALICD*8
-#include "hepdb/cduscm.inc"
-
-#endif
diff --git a/src/packlib/hepdb/hepdb/cdcdes.inc b/src/packlib/hepdb/hepdb/cdcdes.inc
deleted file mode 100644
index 7c286be..0000000
--- a/src/packlib/hepdb/hepdb/cdcdes.inc
+++ /dev/null
@@ -1,13 +0,0 @@
-*
-* $Id: cdcdes.inc,v 1.1.1.1 1996/02/28 16:24:01 mclareni Exp $
-*
-* $Log: cdcdes.inc,v $
-* Revision 1.1.1.1 1996/02/28 16:24:01 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#ifndef CERNLIB_HEPDB_CDCDES_INC
-#define CERNLIB_HEPDB_CDCDES_INC
-*
-
-#endif
diff --git a/src/packlib/hepdb/hepdb/cdfold.inc b/src/packlib/hepdb/hepdb/cdfold.inc
deleted file mode 100644
index 403deff..0000000
--- a/src/packlib/hepdb/hepdb/cdfold.inc
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: cdfold.inc,v 1.1.1.1 1996/02/28 16:24:03 mclareni Exp $
-*
-* $Log: cdfold.inc,v $
-* Revision 1.1.1.1 1996/02/28 16:24:03 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#ifndef CERNLIB_HEPDB_CDFOLD_INC
-#define CERNLIB_HEPDB_CDFOLD_INC
-*
-*
-* cdfold.inc
-*
- IF(IOPTP.EQ.0) THEN
- CALL CUTOL(CHFILE(1:LFILE))
- ENDIF
-
-#endif
diff --git a/src/packlib/hepdb/hepdb/cdilun.inc b/src/packlib/hepdb/hepdb/cdilun.inc
deleted file mode 100644
index 052a911..0000000
--- a/src/packlib/hepdb/hepdb/cdilun.inc
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: cdilun.inc,v 1.1.1.1 1996/02/28 16:24:02 mclareni Exp $
-*
-* $Log: cdilun.inc,v $
-* Revision 1.1.1.1 1996/02/28 16:24:02 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#ifndef CERNLIB_HEPDB_CDILUN_INC
-#define CERNLIB_HEPDB_CDILUN_INC
-*
-*
-* cdilun.inc
-*
- INTEGER NLUN
- PARAMETER (NLUN=6)
- DIMENSION LUNARR(NLUN)
- INTEGER LUNARR
- DATA LUNARR(1)/1/,LUNARR(2)/2/,LUNARR(3)/3/,
- + LUNARR(4)/4/,LUNARR(5)/7/,LUNARR(6)/8/
-
-#endif
diff --git a/src/packlib/hepdb/hepdb/cdkeys.inc b/src/packlib/hepdb/hepdb/cdkeys.inc
deleted file mode 100644
index 275c4dc..0000000
--- a/src/packlib/hepdb/hepdb/cdkeys.inc
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: cdkeys.inc,v 1.1.1.1 1996/02/28 16:24:02 mclareni Exp $
-*
-* $Log: cdkeys.inc,v $
-* Revision 1.1.1.1 1996/02/28 16:24:02 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#ifndef CERNLIB_HEPDB_CDKEYS_INC
-#define CERNLIB_HEPDB_CDKEYS_INC
-*
-*
-* cdkeys.inc
-*
- COMMON/CDKEYS/NKEYCD,NSYSCD,NEXPCD,NPAICD,NUSRCD
-
-#endif
diff --git a/src/packlib/hepdb/hepdb/cdlscm.inc b/src/packlib/hepdb/hepdb/cdlscm.inc
deleted file mode 100644
index e003441..0000000
--- a/src/packlib/hepdb/hepdb/cdlscm.inc
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: cdlscm.inc,v 1.1.1.1 1996/02/28 16:24:02 mclareni Exp $
-*
-* $Log: cdlscm.inc,v $
-* Revision 1.1.1.1 1996/02/28 16:24:02 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#ifndef CERNLIB_HEPDB_CDLSCM_INC
-#define CERNLIB_HEPDB_CDLSCM_INC
-*
-*
-* cdlscm.inc
-*
- COMMON/CDLSCM/NKEYSN,ILNK1,ILNK2,IDAT1,IDAT2,
- + NOBJM,NOBJT,NDIRT,CHBANK
- CHARACTER*4 CHBANK
-
-#endif
diff --git a/src/packlib/hepdb/hepdb/cdlufm.inc b/src/packlib/hepdb/hepdb/cdlufm.inc
deleted file mode 100644
index 02fc86d..0000000
--- a/src/packlib/hepdb/hepdb/cdlufm.inc
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: cdlufm.inc,v 1.1.1.1 1996/02/28 16:24:04 mclareni Exp $
-*
-* $Log: cdlufm.inc,v $
-* Revision 1.1.1.1 1996/02/28 16:24:04 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#ifndef CERNLIB_HEPDB_CDLUFM_INC
-#define CERNLIB_HEPDB_CDLUFM_INC
-*
-*
-* cdlufm.inc
-*
- COMMON /CDLUFM/ LUFMCD
-*KEEP, CDLUFM, IF=IBMRT, HPUX.
-* PARAMETER (LUFMCD=87)
-*KEEP, CDLUFM, IF=-IBMRT, IF=-HPUX.
-* PARAMETER (LUFMCD=999)
-
-#endif
diff --git a/src/packlib/hepdb/hepdb/cdlupc.inc b/src/packlib/hepdb/hepdb/cdlupc.inc
deleted file mode 100644
index 4aadf4e..0000000
--- a/src/packlib/hepdb/hepdb/cdlupc.inc
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: cdlupc.inc,v 1.1.1.1 1996/02/28 16:24:01 mclareni Exp $
-*
-* $Log: cdlupc.inc,v $
-* Revision 1.1.1.1 1996/02/28 16:24:01 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#ifndef CERNLIB_HEPDB_CDLUPC_INC
-#define CERNLIB_HEPDB_CDLUPC_INC
-*
-*
-* cdlupc.inc
-*
- COMMON/CDLUPC/IDMAXU,ITMAXU,CHDIRU
- CHARACTER*255 CHDIRU
-
-#endif
diff --git a/src/packlib/hepdb/hepdb/cdnamc.inc b/src/packlib/hepdb/hepdb/cdnamc.inc
deleted file mode 100644
index 624d53d..0000000
--- a/src/packlib/hepdb/hepdb/cdnamc.inc
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: cdnamc.inc,v 1.1.1.1 1996/02/28 16:24:02 mclareni Exp $
-*
-* $Log: cdnamc.inc,v $
-* Revision 1.1.1.1 1996/02/28 16:24:02 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#ifndef CERNLIB_HEPDB_CDNAMC_INC
-#define CERNLIB_HEPDB_CDNAMC_INC
-*
-*
-* cdnamc.inc
-*
-* Maximum number of databases that can be handled by one server
- PARAMETER (MAXDB=50)
-* Maximum number of remote servers
- PARAMETER (MAXSRV=50)
-* File names, directories for backup files, input queues, remote queues
- COMMON/CDNAMC/LQUED ,LTODO, LLOGD ,LSAVD, LREMQ, LBADD,
- + NFILES,NSERV,MASTER,
- + CDTODO,CDQUED,CDLOGD,CDSAVD,CDBADD,CDPRFX,
- + CDFILE,CDREMQ,CDMODE
- CHARACTER*255 CDFILE(MAXDB),CDSAVD,CDTODO,CDQUED,CDBADD,CDLOGD
- CHARACTER*255 CDREMQ(MAXDB,MAXSRV)
- CHARACTER*2 CDPRFX(MAXDB)
- CHARACTER*1 CDMODE
- INTEGER LDFILE(MAXDB),NSERV(MAXDB),LREMQ(MAXDB,MAXSRV)
- LOGICAL MASTER
-
-#endif
diff --git a/src/packlib/hepdb/hepdb/cdoccm.inc b/src/packlib/hepdb/hepdb/cdoccm.inc
deleted file mode 100644
index f781d7b..0000000
--- a/src/packlib/hepdb/hepdb/cdoccm.inc
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: cdoccm.inc,v 1.1.1.1 1996/02/28 16:24:03 mclareni Exp $
-*
-* $Log: cdoccm.inc,v $
-* Revision 1.1.1.1 1996/02/28 16:24:03 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#ifndef CERNLIB_HEPDB_CDOCCM_INC
-#define CERNLIB_HEPDB_CDOCCM_INC
-*
-* For CDOBJC
-*
-* cdoccm.inc
-*
- COMMON/FAFCCM/IOPTD,IOPTF,IOPTL,IOPTZ,NFOUND,NDIRT
-
-#endif
diff --git a/src/packlib/hepdb/hepdb/cdopen.inc b/src/packlib/hepdb/hepdb/cdopen.inc
deleted file mode 100644
index 93a91f6..0000000
--- a/src/packlib/hepdb/hepdb/cdopen.inc
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: cdopen.inc,v 1.1.1.1 1996/02/28 16:24:03 mclareni Exp $
-*
-* $Log: cdopen.inc,v $
-* Revision 1.1.1.1 1996/02/28 16:24:03 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#ifndef CERNLIB_HEPDB_CDOPEN_INC
-#define CERNLIB_HEPDB_CDOPEN_INC
-*
-*
-* cdopen.inc
-*
- CALL CDCOUN(NFILES)
- IF(NFILES.EQ.0) THEN
- IF(LLOGCD.GT.-3) WRITE(LPRTCD,*) 'No files currently ',
- + 'open - use the OPEN command to open a file'
- RETURN
- ENDIF
-
-#endif
diff --git a/src/packlib/hepdb/hepdb/cdrnge.inc b/src/packlib/hepdb/hepdb/cdrnge.inc
deleted file mode 100644
index 385ddf0..0000000
--- a/src/packlib/hepdb/hepdb/cdrnge.inc
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: cdrnge.inc,v 1.1.1.1 1996/02/28 16:24:03 mclareni Exp $
-*
-* $Log: cdrnge.inc,v $
-* Revision 1.1.1.1 1996/02/28 16:24:03 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#ifndef CERNLIB_HEPDB_CDRNGE_INC
-#define CERNLIB_HEPDB_CDRNGE_INC
-*
-*
-* cdrnge.inc
-*
-* NCRNGE - range count (e.g. [8:10] = 3)
-* ICRNGE - 8,9,10 (in previous example)
- COMMON/CDRNGE/NCRNGE(20),ICRNGE(100,20),
- + ICELEM(100,20),ICVAL(100,20)
-
-#endif
diff --git a/src/packlib/hepdb/hepdb/cdtime.inc b/src/packlib/hepdb/hepdb/cdtime.inc
deleted file mode 100644
index dafb82f..0000000
--- a/src/packlib/hepdb/hepdb/cdtime.inc
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: cdtime.inc,v 1.1.1.1 1996/02/28 16:24:01 mclareni Exp $
-*
-* $Log: cdtime.inc,v $
-* Revision 1.1.1.1 1996/02/28 16:24:01 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#ifndef CERNLIB_HEPDB_CDTIME_INC
-#define CERNLIB_HEPDB_CDTIME_INC
-*
-*
-* cdtime.inc
-*
- COMMON/CDTIME/IDATCD,ITIMCD,JDATCD,JTIMCD
-
-#endif
diff --git a/src/packlib/hepdb/hepdb/cdulnk.inc b/src/packlib/hepdb/hepdb/cdulnk.inc
deleted file mode 100644
index d8e2c3b..0000000
--- a/src/packlib/hepdb/hepdb/cdulnk.inc
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: cdulnk.inc,v 1.1.1.1 1996/02/28 16:24:02 mclareni Exp $
-*
-* $Log: cdulnk.inc,v $
-* Revision 1.1.1.1 1996/02/28 16:24:02 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#ifndef CERNLIB_HEPDB_CDULNK_INC
-#define CERNLIB_HEPDB_CDULNK_INC
-*
-*
-* cdulnk.inc
-*
- COMMON/CDULNK/LINK01
-
-#endif
diff --git a/src/packlib/hepdb/hepdb/cdunit.inc b/src/packlib/hepdb/hepdb/cdunit.inc
deleted file mode 100644
index c41e66c..0000000
--- a/src/packlib/hepdb/hepdb/cdunit.inc
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: cdunit.inc,v 1.1.1.1 1996/02/28 16:24:02 mclareni Exp $
-*
-* $Log: cdunit.inc,v $
-* Revision 1.1.1.1 1996/02/28 16:24:02 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#ifndef CERNLIB_HEPDB_CDUNIT_INC
-#define CERNLIB_HEPDB_CDUNIT_INC
-*
-*
-* cdunit.inc
-*
-*
-* Units for output, errors, redirected output, loglevel
-*
- COMMON/CDUNIT/LOUTCD,LPRTCD,LFILCD,LLOGCD
- INTEGER LOUTCD,LPRTCD,LFILCD,LLOGCD
-
-#endif
diff --git a/src/packlib/hepdb/hepdb/cduscm.inc b/src/packlib/hepdb/hepdb/cduscm.inc
deleted file mode 100644
index e8daa1e..0000000
--- a/src/packlib/hepdb/hepdb/cduscm.inc
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: cduscm.inc,v 1.1.1.1 1996/02/28 16:24:04 mclareni Exp $
-*
-* $Log: cduscm.inc,v $
-* Revision 1.1.1.1 1996/02/28 16:24:04 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#ifndef CERNLIB_HEPDB_CDUSCM_INC
-#define CERNLIB_HEPDB_CDUSCM_INC
-*
-*
-* cduscm.inc
-*
- COMMON /CDUSCM/ IDEBCD, IDISCD, IDIVCD, IHKYCD, IKDRCD
- + , KOFSCD, KOFUCD
- + , LTOPCD, LBADCD, LBAFCD, LBDACD, LBFXCD, LBFYCD
- + , LBKYCD, LBNOCD, LFIXCD, LREFCD(7), LSAVCD, LBUPCD
- + , LPRTCD, NTOPCD
- PARAMETER (NDMXCB=25000)
-*
-
-#endif
diff --git a/src/packlib/hepdb/hepdb/cdwacm.inc b/src/packlib/hepdb/hepdb/cdwacm.inc
deleted file mode 100644
index 406f59c..0000000
--- a/src/packlib/hepdb/hepdb/cdwacm.inc
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: cdwacm.inc,v 1.1.1.1 1996/02/28 16:24:01 mclareni Exp $
-*
-* $Log: cdwacm.inc,v $
-* Revision 1.1.1.1 1996/02/28 16:24:01 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#ifndef CERNLIB_HEPDB_CDWACM_INC
-#define CERNLIB_HEPDB_CDWACM_INC
-*
-*
-* cdwacm.inc
-*
- COMMON/CDWACM/IWAKCD
-
-#endif
diff --git a/src/packlib/hepdb/hepdb/cfzlun.inc b/src/packlib/hepdb/hepdb/cfzlun.inc
deleted file mode 100644
index fc20dff..0000000
--- a/src/packlib/hepdb/hepdb/cfzlun.inc
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: cfzlun.inc,v 1.1.1.1 1996/02/28 16:24:05 mclareni Exp $
-*
-* $Log: cfzlun.inc,v $
-* Revision 1.1.1.1 1996/02/28 16:24:05 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#ifndef CERNLIB_HEPDB_CFZLUN_INC
-#define CERNLIB_HEPDB_CFZLUN_INC
-*
-*
-* cfzlun.inc
-*
- PARAMETER (MACTCF=1, MNKYCF=2, MOPTCF=3, MPATCF=4, MPRECF=5)
- PARAMETER (MXKPCF=5, MPARCF=5, MFLGCF=5, MDELCF=5)
- PARAMETER (MINSCF=6, MWDPCF=6, MKEPCF=6, MTIMCF=7, MRECCF=7)
- PARAMETER (NHEDCF=300, NWFMCF=16)
- COMMON /CFZLUN/ IHEDCF(NHEDCF), IOFMCF(NWFMCF), LUFZCF, NUFZCF
- + , NWHDCF
-*
-
-#endif
diff --git a/src/packlib/hepdb/hepdb/cinitl.inc b/src/packlib/hepdb/hepdb/cinitl.inc
deleted file mode 100644
index 45bac11..0000000
--- a/src/packlib/hepdb/hepdb/cinitl.inc
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: cinitl.inc,v 1.1.1.1 1996/02/28 16:24:05 mclareni Exp $
-*
-* $Log: cinitl.inc,v $
-* Revision 1.1.1.1 1996/02/28 16:24:05 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#ifndef CERNLIB_HEPDB_CINITL_INC
-#define CERNLIB_HEPDB_CINITL_INC
-*
-*
-* cinitl.inc
-*
- COMMON /CINITL/ TOPLCI, TOPNCI
- CHARACTER TOPLCI*16, TOPNCI*16
-*
-
-#endif
diff --git a/src/packlib/hepdb/hepdb/ckkeys.inc b/src/packlib/hepdb/hepdb/ckkeys.inc
deleted file mode 100644
index ea7f82a..0000000
--- a/src/packlib/hepdb/hepdb/ckkeys.inc
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: ckkeys.inc,v 1.1.1.1 1996/02/28 16:24:05 mclareni Exp $
-*
-* $Log: ckkeys.inc,v $
-* Revision 1.1.1.1 1996/02/28 16:24:05 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#ifndef CERNLIB_HEPDB_CKKEYS_INC
-#define CERNLIB_HEPDB_CKKEYS_INC
-*
-*
-* ckkeys.inc
-*
- INTEGER TENCK
- PARAMETER (MXDMCK=90, MXKYCK=10000, TENCK=10, MXKPCK=1000)
- PARAMETER (NOF1CK=10, NOF2CK=10, NOF3CK=6)
- PARAMETER (NOFSCK=5, NOFECK=5)
-* For DBL3
-* PARAMETER (NOF1CK=2, NOF2CK=5, NOF3CK=3)
-*
- COMMON /CKKEYS/ ICONCK(MXDMCK), INDKCK(MXKYCK), IOTYCK(MXDMCK)
- + , IPURCK(MXKYCK), KEY1CK(MXKYCK), KEYNCK(MXDMCK)
- + , KEYVCK(MXDMCK), KYP1CK(MXDMCK), KYP2CK(MXDMCK)
- + , KYVMCK(MXDMCK), KEY7CK, NKEYCK, NSKPCK, NSYSCK
- + , NWKYCK
- DIMENSION RKY1CK(MXKYCK)
- EQUIVALENCE (KEY1CK(1), RKY1CK(1))
-*
- COMMON /CKTAGS/ CHTGCK(TENCK), CTAGCK(MXDMCK), CHFTCK
- CHARACTER CHFTCK*10, CHTGCK*8, CTAGCK*8
-*
-
-#endif
diff --git a/src/packlib/hepdb/hepdb/clinks.inc b/src/packlib/hepdb/hepdb/clinks.inc
deleted file mode 100644
index d696f6e..0000000
--- a/src/packlib/hepdb/hepdb/clinks.inc
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: clinks.inc,v 1.1.1.1 1996/02/28 16:24:05 mclareni Exp $
-*
-* $Log: clinks.inc,v $
-* Revision 1.1.1.1 1996/02/28 16:24:05 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#ifndef CERNLIB_HEPDB_CLINKS_INC
-#define CERNLIB_HEPDB_CLINKS_INC
-*
-*
-* clinks.inc
-*
- COMMON /CLINKS/ LSTRCL(5), LAUXCL(10), LREFCL(10)
-*
-
-#endif
diff --git a/src/packlib/hepdb/hepdb/cmulop.inc b/src/packlib/hepdb/hepdb/cmulop.inc
deleted file mode 100644
index 15375e7..0000000
--- a/src/packlib/hepdb/hepdb/cmulop.inc
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: cmulop.inc,v 1.1.1.1 1996/02/28 16:24:05 mclareni Exp $
-*
-* $Log: cmulop.inc,v $
-* Revision 1.1.1.1 1996/02/28 16:24:05 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#ifndef CERNLIB_HEPDB_CMULOP_INC
-#define CERNLIB_HEPDB_CMULOP_INC
-*
-*
-* cmulop.inc
-*
- PARAMETER (NMLMCM=10)
- COMMON /CMULOP/ INDXCM(NMLMCM), KEYVCM(NMLMCM), KTYPCM(NMLMCM)
- + , LFKYCM(NMLMCM), NOCCCM(NMLMCM), NMULCM
-*
-
-#endif
diff --git a/src/packlib/hepdb/hepdb/cplots.inc b/src/packlib/hepdb/hepdb/cplots.inc
deleted file mode 100644
index 7e0895d..0000000
--- a/src/packlib/hepdb/hepdb/cplots.inc
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: cplots.inc,v 1.1.1.1 1996/02/28 16:24:05 mclareni Exp $
-*
-* $Log: cplots.inc,v $
-* Revision 1.1.1.1 1996/02/28 16:24:05 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#ifndef CERNLIB_HEPDB_CPLOTS_INC
-#define CERNLIB_HEPDB_CPLOTS_INC
-*
-*
-* cplots.inc
-*
- PARAMETER (NOBMCP=50, NPLMCP=500, NPMXCP=10)
- PARAMETER (NMAXCP=2*NOBMCP)
- COMMON /CPLOTS/ IBINCP(8), INDXCP(2,NOBMCP), KOBJCP(NMAXCP)
- + , NKSMCP(NPMXCP), NKSTCP(NPMXCP), NDSMCP(NPMXCP)
- + , NDSTCP(NPMXCP), IBEGCP(NPMXCP), NDEMCP(NPMXCP)
- + , IOTYCP(NMAXCP), NSKYCP(NPMXCP), NKEYCP(80,NPMXCP)
- + , KKEYCP(80,NPMXCP), VMAXCP, VMINCP
- COMMON /CPLOCH/ CHRPCP, CTTLCP, DYENCP, DYSTCP
- CHARACTER CHRPCP*119, CTTLCP*75, DYENCP*10, DYSTCP*10
-*
-
-#endif
diff --git a/src/packlib/hepdb/hepdb/crccom.inc b/src/packlib/hepdb/hepdb/crccom.inc
deleted file mode 100644
index 3b940ab..0000000
--- a/src/packlib/hepdb/hepdb/crccom.inc
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: crccom.inc,v 1.1.1.1 1996/02/28 16:24:05 mclareni Exp $
-*
-* $Log: crccom.inc,v $
-* Revision 1.1.1.1 1996/02/28 16:24:05 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#ifndef CERNLIB_HEPDB_CRCCOM_INC
-#define CERNLIB_HEPDB_CRCCOM_INC
-*
-*
-* crccom.inc
-*
- PARAMETER (NMAXCR=20000)
- COMMON /CRCCOM/ IFRSCR, IWORCR(4), QVECCR(NMAXCR), ILSTCR(128)
- DIMENSION IQVECR(NMAXCR)
- EQUIVALENCE (QVECCR, IQVECR)
-CDEC$ PSECT /CRCCOM/ ALIGN=9
-*
-
-#endif
diff --git a/src/packlib/hepdb/hepdb/csavbk.inc b/src/packlib/hepdb/hepdb/csavbk.inc
deleted file mode 100644
index b6c2cc6..0000000
--- a/src/packlib/hepdb/hepdb/csavbk.inc
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: csavbk.inc,v 1.1.1.1 1996/02/28 16:24:05 mclareni Exp $
-*
-* $Log: csavbk.inc,v $
-* Revision 1.1.1.1 1996/02/28 16:24:05 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#ifndef CERNLIB_HEPDB_CSAVBK_INC
-#define CERNLIB_HEPDB_CSAVBK_INC
-*
-*
-* csavbk.inc
-*
- PARAMETER (NSVMCS=50, NSAVCS=20, MXDMCS=100)
- COMMON /CSAVBK/ NOBJCS, LOBJCS(NSVMCS), KEYSCS(MXDMCS,NSVMCS)
-*
-
-#endif
diff --git a/src/packlib/hepdb/hepdb/ctkxin.inc b/src/packlib/hepdb/hepdb/ctkxin.inc
deleted file mode 100644
index adc9285..0000000
--- a/src/packlib/hepdb/hepdb/ctkxin.inc
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: ctkxin.inc,v 1.1.1.1 1996/02/28 16:24:05 mclareni Exp $
-*
-* $Log: ctkxin.inc,v $
-* Revision 1.1.1.1 1996/02/28 16:24:05 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#ifndef CERNLIB_HEPDB_CTKXIN_INC
-#define CERNLIB_HEPDB_CTKXIN_INC
-*
-*
-* ctkxin.inc
-*
- PARAMETER (MXPACT=10)
- COMMON /CTKXIN/ ICURCT, IDNRCT, IKYLCT, IMINCT, INRSCT(MXPACT)
- + , IPRVCT, IUSECT, KEY6CT, KY6NCT, MNKYCT, NTIMCT
-*
-
-#endif
diff --git a/src/packlib/hepdb/hepdb/ctmpak.inc b/src/packlib/hepdb/hepdb/ctmpak.inc
deleted file mode 100644
index b2c5261..0000000
--- a/src/packlib/hepdb/hepdb/ctmpak.inc
+++ /dev/null
@@ -1,35 +0,0 @@
-*
-* $Id: ctmpak.inc,v 1.2 1999/08/17 12:42:50 mclareni Exp $
-*
-* $Log: ctmpak.inc,v $
-* Revision 1.2 1999/08/17 12:42:50 mclareni
-* Y2k mods submitted by Rob Komar
-*
-* Revision 1.1.1.1 1996/02/28 16:24:05 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#ifndef CERNLIB_HEPDB_CTMPAK_INC
-#define CERNLIB_HEPDB_CTMPAK_INC
-*
-*
-* ctmpak.inc
-*
- PARAMETER (MXSEC=61, MXMIN=61, MXHOU=25, MXDAY=32, MXMON=13)
- PARAMETER (MXYEA=134)
- INTEGER IDAYY(55), IDAYM(12,2)
- SAVE IDAYY, IDAYM
- DATA IDAYY / 366, 731, 1096, 1461, 1827, 2192, 2557,
- 1 2922, 3288, 3653, 4018, 4383, 4749, 5114,
- 2 5479, 5844, 6210, 6575, 6940, 7305, 7671,
- 3 8036, 8401, 8766, 9132, 9497, 9862, 10227,
- 4 10593,10958,11323,11688,12054,12419,12784,
- 5 13149,13515,13880,14245,14610,14976,15341,
- 6 15706,16071,16437,16802,17167,17532,17898,
- 7 18263,18628,18993,19359,19724,20089/
- DATA IDAYM / 0, 31, 59, 90, 120, 151, 181, 212, 243,
- 1 273, 304, 334, 0, 31, 60, 91, 121, 152,
- 2 182, 213, 244, 274, 305, 335/
-*
-
-#endif
diff --git a/src/packlib/hepdb/hepdb/ctpath.inc b/src/packlib/hepdb/hepdb/ctpath.inc
deleted file mode 100644
index cc75bf6..0000000
--- a/src/packlib/hepdb/hepdb/ctpath.inc
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: ctpath.inc,v 1.1.1.1 1996/02/28 16:24:05 mclareni Exp $
-*
-* $Log: ctpath.inc,v $
-* Revision 1.1.1.1 1996/02/28 16:24:05 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#ifndef CERNLIB_HEPDB_CTPATH_INC
-#define CERNLIB_HEPDB_CTPATH_INC
-*
-*
-* ctpath.inc
-*
- COMMON /CTPATH/ PAT1CT, PAT2CT, PAT3CT, PAT4CT, TOP1CT, TOP2CT
- CHARACTER*80 PAT1CT, PAT2CT, PAT3CT, PAT4CT
- CHARACTER*16 TOP1CT, TOP2CT
-*
-
-#endif
diff --git a/src/packlib/hepdb/hepdb/cuserf.inc b/src/packlib/hepdb/hepdb/cuserf.inc
deleted file mode 100644
index 846f277..0000000
--- a/src/packlib/hepdb/hepdb/cuserf.inc
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: cuserf.inc,v 1.1.1.1 1996/02/28 16:24:05 mclareni Exp $
-*
-* $Log: cuserf.inc,v $
-* Revision 1.1.1.1 1996/02/28 16:24:05 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#ifndef CERNLIB_HEPDB_CUSERF_INC
-#define CERNLIB_HEPDB_CUSERF_INC
-*
-*
-* cuserf.inc
-*
- COMMON /CUSERF/ IDCMCU, IFLGCU, IPRECU, DELTCU
-*
-
-#endif
diff --git a/src/packlib/hepdb/hepdb/cviews.inc b/src/packlib/hepdb/hepdb/cviews.inc
deleted file mode 100644
index 5d1b717..0000000
--- a/src/packlib/hepdb/hepdb/cviews.inc
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: cviews.inc,v 1.1.1.1 1996/02/28 16:24:06 mclareni Exp $
-*
-* $Log: cviews.inc,v $
-* Revision 1.1.1.1 1996/02/28 16:24:06 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#ifndef CERNLIB_HEPDB_CVIEWS_INC
-#define CERNLIB_HEPDB_CVIEWS_INC
-*
-*
-* cviews.inc
-*
- COMMON /CVIEWS/ IFKYCV(100), JFKYCV(100), IOTYCV(100), KEYSCV(100)
-*
-
-#endif
diff --git a/src/packlib/hepdb/hepdb/cxlink.inc b/src/packlib/hepdb/hepdb/cxlink.inc
deleted file mode 100644
index d2aeca2..0000000
--- a/src/packlib/hepdb/hepdb/cxlink.inc
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: cxlink.inc,v 1.1.1.1 1996/02/28 16:24:06 mclareni Exp $
-*
-* $Log: cxlink.inc,v $
-* Revision 1.1.1.1 1996/02/28 16:24:06 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#ifndef CERNLIB_HEPDB_CXLINK_INC
-#define CERNLIB_HEPDB_CXLINK_INC
-*
-*
-* cxlink.inc
-*
- PARAMETER (MAXJCX=20, MAXVCX= 20, LUKYCX=88, LUDACX=89)
- COMMON /CXLINK/ ISTOCX, KEYSCX(100), MASKCX(100), L3PRCX, LURZCX
- + , LFRSCX, LJOICX, LKJNCX(MAXJCX), LDJNCX(MAXJCX)
- + , LVIWCX, LKVWCX(MAXVCX), LDVWCX(MAXVCX), LASTCX
-*
-
-#endif
diff --git a/src/packlib/hepdb/hepdb/czpack.inc b/src/packlib/hepdb/hepdb/czpack.inc
deleted file mode 100644
index b335b82..0000000
--- a/src/packlib/hepdb/hepdb/czpack.inc
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: czpack.inc,v 1.1.1.1 1996/02/28 16:24:06 mclareni Exp $
-*
-* $Log: czpack.inc,v $
-* Revision 1.1.1.1 1996/02/28 16:24:06 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#ifndef CERNLIB_HEPDB_CZPACK_INC
-#define CERNLIB_HEPDB_CZPACK_INC
-*
-*
-* czpack.inc
-*
- COMMON /CZPACK/ PRECCZ, PACKCZ
- LOGICAL PACKCZ
-*
-
-#endif
diff --git a/src/packlib/hepdb/hepdb/doc.inc b/src/packlib/hepdb/hepdb/doc.inc
deleted file mode 100644
index bc711ae..0000000
--- a/src/packlib/hepdb/hepdb/doc.inc
+++ /dev/null
@@ -1,15 +0,0 @@
-*
-* $Id: doc.inc,v 1.1.1.1 1996/02/28 16:24:06 mclareni Exp $
-*
-* $Log: doc.inc,v $
-* Revision 1.1.1.1 1996/02/28 16:24:06 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#ifndef CERNLIB_HEPDB_DOC_INC
-#define CERNLIB_HEPDB_DOC_INC
-*
-#if defined(CERNLIB__DOC)
-#endif
-
-#endif
diff --git a/src/packlib/hepdb/hepdb/dxused.inc b/src/packlib/hepdb/hepdb/dxused.inc
deleted file mode 100644
index eaeec70..0000000
--- a/src/packlib/hepdb/hepdb/dxused.inc
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: dxused.inc,v 1.1.1.1 1996/02/28 16:24:01 mclareni Exp $
-*
-* $Log: dxused.inc,v $
-* Revision 1.1.1.1 1996/02/28 16:24:01 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#ifndef CERNLIB_HEPDB_DXUSED_INC
-#define CERNLIB_HEPDB_DXUSED_INC
-*
-*
-* dxused.inc
-*
- PARAMETER (NSYSDX=7, MXKYDX=100)
- COMMON /DXUSED/ LDATDX, LKEYDX, KEYSDX(MXKYDX), MASKDX(MXKYDX)
- + , IOPADX, IOPBDX, IOPCDX, IOPDDX, IOPEDX, IOPFDX
- + , IOPGDX, IOPHDX, IOPIDX, IOPJDX, IOPKDX, IOPLDX
- + , IOPMDX, IOPNDX, IOPODX, IOPPDX, IOPQDX, IOPRDX
- + , IOPSDX, IOPTDX, IOPUDX, IOPVDX, IOPWDX, IOPXDX
- + , IOPYDX, IOPZDX, IOKYDX(MXKYDX)
-
-#endif
diff --git a/src/packlib/hepdb/hepdb/fzstat.inc b/src/packlib/hepdb/hepdb/fzstat.inc
deleted file mode 100644
index 63234eb..0000000
--- a/src/packlib/hepdb/hepdb/fzstat.inc
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: fzstat.inc,v 1.1.1.1 1996/02/28 16:24:01 mclareni Exp $
-*
-* $Log: fzstat.inc,v $
-* Revision 1.1.1.1 1996/02/28 16:24:01 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#ifndef CERNLIB_HEPDB_FZSTAT_INC
-#define CERNLIB_HEPDB_FZSTAT_INC
-*
-*
-* fzstat.inc
-*
- COMMON/FZSTAT/INFLUN,INFSTA,INFOFZ(40)
-
-#endif
diff --git a/src/packlib/hepdb/hepdb/hdbkeys.inc b/src/packlib/hepdb/hepdb/hdbkeys.inc
deleted file mode 100644
index b4c7d83..0000000
--- a/src/packlib/hepdb/hepdb/hdbkeys.inc
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: hdbkeys.inc,v 1.1.1.1 1996/02/28 16:24:02 mclareni Exp $
-*
-* $Log: hdbkeys.inc,v $
-* Revision 1.1.1.1 1996/02/28 16:24:02 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#ifndef CERNLIB_HEPDB_HDBKEYS_INC
-#define CERNLIB_HEPDB_HDBKEYS_INC
-*
-*
-* hdbkeys.inc
-*
- PARAMETER (KOFSYS=1,KOFEXP=6,KOFVAL=11)
- PARAMETER (NOFSYS=5,NOFEXP=5)
- PARAMETER (KOFKSN=1,KOFPTR=2,KOFFLG=3,KOFINS=4,KOFSY1=5)
- PARAMETER (KOFUSI=6,KOFSRN=7,KOFEX1=8,KOFEX2=9,KOFEX3=10)
-
-#endif
diff --git a/src/packlib/hepdb/hepdb/hdblun.inc b/src/packlib/hepdb/hepdb/hdblun.inc
deleted file mode 100644
index 8f6ad70..0000000
--- a/src/packlib/hepdb/hepdb/hdblun.inc
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: hdblun.inc,v 1.1.1.1 1996/02/28 16:24:02 mclareni Exp $
-*
-* $Log: hdblun.inc,v $
-* Revision 1.1.1.1 1996/02/28 16:24:02 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#ifndef CERNLIB_HEPDB_HDBLUN_INC
-#define CERNLIB_HEPDB_HDBLUN_INC
-*
-*
-* hdblun.inc
-*
- COMMON/HDBLUN/NUMLUN,MCDLUN(KMXLUN),MCDLUA(KMXLUN)
- INTEGER NUMLUN,MCDLUN,MCDLUA
-
-#endif
diff --git a/src/packlib/hepdb/hepdb/hdbopt.inc b/src/packlib/hepdb/hepdb/hdbopt.inc
deleted file mode 100644
index 08fd713..0000000
--- a/src/packlib/hepdb/hepdb/hdbopt.inc
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: hdbopt.inc,v 1.1.1.1 1996/02/28 16:24:03 mclareni Exp $
-*
-* $Log: hdbopt.inc,v $
-* Revision 1.1.1.1 1996/02/28 16:24:03 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#ifndef CERNLIB_HEPDB_HDBOPT_INC
-#define CERNLIB_HEPDB_HDBOPT_INC
-*
-*
-* hdbopt.inc
-*
- COMMON/HDBOPT/CHOPTT
- CHARACTER*36 CHOPTT
-
-#endif
diff --git a/src/packlib/hepdb/hepdb/hdbopta.inc b/src/packlib/hepdb/hepdb/hdbopta.inc
deleted file mode 100644
index dfd7586..0000000
--- a/src/packlib/hepdb/hepdb/hdbopta.inc
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: hdbopta.inc,v 1.1.1.1 1996/02/28 16:24:03 mclareni Exp $
-*
-* $Log: hdbopta.inc,v $
-* Revision 1.1.1.1 1996/02/28 16:24:03 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#ifndef CERNLIB_HEPDB_HDBOPTA_INC
-#define CERNLIB_HEPDB_HDBOPTA_INC
-*
-*
-* hdbopta.inc
-*
- DO 1 I=1,36
- IOPT(I) = 1
- 1 CONTINUE
-
-#endif
diff --git a/src/packlib/hepdb/hepdb/hdboptc.inc b/src/packlib/hepdb/hepdb/hdboptc.inc
deleted file mode 100644
index ffc937e..0000000
--- a/src/packlib/hepdb/hepdb/hdboptc.inc
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: hdboptc.inc,v 1.1.1.1 1996/02/28 16:24:03 mclareni Exp $
-*
-* $Log: hdboptc.inc,v $
-* Revision 1.1.1.1 1996/02/28 16:24:03 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#ifndef CERNLIB_HEPDB_HDBOPTC_INC
-#define CERNLIB_HEPDB_HDBOPTC_INC
-*
-*
-* hdboptc.inc
-*
- CALL CDOPTC(CHOPT,ALFNUM,IOPT)
-
-#endif
diff --git a/src/packlib/hepdb/hepdb/hdboptd.inc b/src/packlib/hepdb/hepdb/hdboptd.inc
deleted file mode 100644
index 21c888b..0000000
--- a/src/packlib/hepdb/hepdb/hdboptd.inc
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: hdboptd.inc,v 1.1.1.1 1996/02/28 16:24:03 mclareni Exp $
-*
-* $Log: hdboptd.inc,v $
-* Revision 1.1.1.1 1996/02/28 16:24:03 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#ifndef CERNLIB_HEPDB_HDBOPTD_INC
-#define CERNLIB_HEPDB_HDBOPTD_INC
-*
-*
-* hdboptd.inc
-*
- DIMENSION IOPT(36)
- INTEGER IOPT
- EQUIVALENCE (IOPT(1),IOPTA),(IOPT(2),IOPTB),(IOPT(3),IOPTC),
- + (IOPT(4),IOPTD),(IOPT(5),IOPTE),(IOPT(6),IOPTF),
- + (IOPT(7),IOPTG),(IOPT(8),IOPTH),(IOPT(9),IOPTI),
- + (IOPT(10),IOPTJ),(IOPT(11),IOPTK),(IOPT(12),IOPTL),
- + (IOPT(13),IOPTM),(IOPT(14),IOPTN),(IOPT(15),IOPTO),
- + (IOPT(16),IOPTP),(IOPT(17),IOPTQ),(IOPT(18),IOPTR),
- + (IOPT(19),IOPTS),(IOPT(20),IOPTT),(IOPT(21),IOPTU),
- + (IOPT(22),IOPTV),(IOPT(23),IOPTW),(IOPT(24),IOPTX),
- + (IOPT(25),IOPTY),(IOPT(26),IOPTZ),(IOPT(27),IOPT1),
- + (IOPT(28),IOPT2),(IOPT(29),IOPT3),(IOPT(30),IOPT4),
- + (IOPT(31),IOPT5),(IOPT(32),IOPT6),(IOPT(33),IOPT7),
- + (IOPT(31),IOPT5),(IOPT(32),IOPT6),(IOPT(33),IOPT7),
- + (IOPT(34),IOPT8),(IOPT(35),IOPT9),(IOPT(36),IOPT0)
- CHARACTER*36 ALFNUM
- DATA ALFNUM/'ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890'/
-
-#endif
diff --git a/src/packlib/hepdb/hepdb/hdbopts.inc b/src/packlib/hepdb/hepdb/hdbopts.inc
deleted file mode 100644
index f6318c9..0000000
--- a/src/packlib/hepdb/hepdb/hdbopts.inc
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: hdbopts.inc,v 1.1.1.1 1996/02/28 16:24:03 mclareni Exp $
-*
-* $Log: hdbopts.inc,v $
-* Revision 1.1.1.1 1996/02/28 16:24:03 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#ifndef CERNLIB_HEPDB_HDBOPTS_INC
-#define CERNLIB_HEPDB_HDBOPTS_INC
-*
-*
-* hdbopts.inc
-*
- CHARACTER*(*) CHOPT
-#include "hepdb/hdboptd.inc"
-#include "hepdb/hdboptc.inc"
-
-#endif
diff --git a/src/packlib/hepdb/hepdb/hdbpara.inc b/src/packlib/hepdb/hepdb/hdbpara.inc
deleted file mode 100644
index 9c11386..0000000
--- a/src/packlib/hepdb/hepdb/hdbpara.inc
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: hdbpara.inc,v 1.1.1.1 1996/02/28 16:24:02 mclareni Exp $
-*
-* $Log: hdbpara.inc,v $
-* Revision 1.1.1.1 1996/02/28 16:24:02 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#ifndef CERNLIB_HEPDB_HDBPARA_INC
-#define CERNLIB_HEPDB_HDBPARA_INC
-*
-*
-* hdbpara.inc
-*
- INTEGER KMXLUN
- PARAMETER (KMXLUN=99)
-
-#endif
diff --git a/src/packlib/hepdb/hepdb/hdbpha.inc b/src/packlib/hepdb/hepdb/hdbpha.inc
deleted file mode 100644
index be56f57..0000000
--- a/src/packlib/hepdb/hepdb/hdbpha.inc
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: hdbpha.inc,v 1.1.1.1 1996/02/28 16:24:02 mclareni Exp $
-*
-* $Log: hdbpha.inc,v $
-* Revision 1.1.1.1 1996/02/28 16:24:02 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#ifndef CERNLIB_HEPDB_HDBPHA_INC
-#define CERNLIB_HEPDB_HDBPHA_INC
-*
-*
-* hdbpha.inc
-*
- COMMON/HDBPHA/MCDPHA
- INTEGER MCDPHA
-
-#endif
diff --git a/src/packlib/hepdb/hepdb/l3bits.inc b/src/packlib/hepdb/hepdb/l3bits.inc
deleted file mode 100644
index df7b2bb..0000000
--- a/src/packlib/hepdb/hepdb/l3bits.inc
+++ /dev/null
@@ -1,96 +0,0 @@
-*
-* $Id: l3bits.inc,v 1.2 2006/09/15 09:35:14 mclareni Exp $
-*
-* $Log: l3bits.inc,v $
-* Revision 1.2 2006/09/15 09:35:14 mclareni
-* Submitted mods for gcc4/gfortran and MacOSX, corrected to work also on slc4 with gcc3.4 and 4.1
-*
-* Revision 1.1.1.1 1996/02/28 16:24:06 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#ifndef CERNLIB_HEPDB_L3BITS_INC
-#define CERNLIB_HEPDB_L3BITS_INC
-*
-*
-* l3bits.inc
-*
-#if defined(CERNLIB_APOLLO)
- IBITS (I,N,L) = RSHFT (LSHFT(I,32-N-L), 32-L)
-*
- JBIT (IZW,IZP) = AND (RSHFT(IZW,IZP-1), 1)
- JBYT (IZW,IZP,NZB) = IBITS (IZW,IZP-1,NZB)
-*
- MSBIT0 (IZW,IZP) = AND (IZW, NOT(LSHFT(1,IZP-1)) )
- MSBIT1 (IZW,IZP) = OR (IZW, LSHFT(1,IZP-1) )
- MSBYT (MZ,IZW,IZP,NZB) = OR ( AND (IZW, NOT(
- + LSHFT (RSHFT(NOT(INT4(0)),32-NZB), IZP-1)))
- + , RSHFT (LSHFT(MZ,32-NZB), 33-IZP-NZB) )
-#endif
-*
-* l3bits.inc
-*
-#if defined(CERNLIB_CRAY)
- JBIT (IZW,IZP) = SHIFTR(IZW,IZP-1) .AND. MASK(127)
- JBYT (IZW,IZP,NZB) = SHIFTR(IZW,IZP-1) .AND. MASK(128-NZB)
-*
- MSBIT0 (IZW,IZP) = IZW .AND. SHIFT(MASK(65),IZP)
- MSBIT1 (IZW,IZP) = IZW .OR. SHIFT(MASK(1), IZP)
- MSBYT (MZ,IZW,IZP,NZB) = (IZW .AND. SHIFT(MASK(64-NZB),IZP-1))
- + .OR. SHIFT(MZ.AND.MASK(128-NZB),IZP-1)
-#endif
-*
-* l3bits.inc
-*
-#if defined(CERNLIB_HPUX)
- JBIT (IZW,IZP) = IBITS (IZW,IZP-1,1)
- JBYT (IZW,IZP,NZB) = IBITS (IZW,IZP-1,NZB)
-#endif
-#if defined(CERNLIB_IBM)||defined(CERNLIB_IBMRT)||defined(CERNLIB_VAX)\
- || defined(CERNLIB_GFORTRAN)
- IBITS (I,N,L) = ISHFT(ISHFT(I,32-L-N),L-32)
-*
- JBIT (IZW,IZP) = IBITS (IZW,IZP-1,1)
- JBYT (IZW,IZP,NZB) = IBITS (IZW,IZP-1,NZB)
-*
- MSBIT0 (IZW,IZP) = IAND (IZW, NOT(ISHFT(1,IZP-1)) )
- MSBIT1 (IZW,IZP) = IOR (IZW, ISHFT(1,IZP-1) )
- MSBYT (MZ,IZW,IZP,NZB) = IOR ( IAND (IZW, NOT(
- + ISHFT (ISHFT(NOT(0),-32+NZB), IZP-1)))
- + , ISHFT (ISHFT(MZ, 32-NZB), -33+IZP+NZB) )
-#endif
-*
-* l3bits.inc
-*
-#if defined(CERNLIB_F2C) && !defined(CERNLIB_GFORTRAN)
-C--
-C-- Note: F2C-ish RSHIFT is arithmetic right shift.
-C-- This means sign bits are shifted in at the high end
-C
- ISHFTL(IZW,NZB) = LSHIFT(IZW,NZB)
- JBIT (IZW,IZP) = AND(RSHIFT(IZW,IZP-1),1)
- JBYT (IZW,IZP,NZB) = ISHFTR(LSHIFT(IZW,33-IZP-NZB),32-NZB)
- MSBIT0 (IZW,IZP) = AND (IZW, NOT(LSHIFT(1,IZP-1)) )
- MSBIT1 (IZW,IZP) = OR (IZW, LSHIFT(1,IZP-1) )
- MSBIT (MZ,IZW,IZP) = OR (AND (IZW, NOT(LSHIFT(1,IZP-1)) )
- + , LSHIFT(AND(MZ,1),IZP-1))
-#endif
-*
-* l3bits.inc
-*
-#if (defined(CERNLIB_WINNT))&&(!defined(CERNLIB_F2C))
- JBIT (IZW,IZP) = IAND (ISHFT(IZW,1-IZP), 1)
- JBYT (IZW,IZP,NZB) = ISHFT (ISHFT(IZW,33-IZP-NZB), -32+NZB)
- MSBIT0 (IZW,IZP) = IAND (IZW, NOT(ISHFT(1,IZP-1)) )
- MSBIT1 (IZW,IZP) = IOR (IZW, ISHFT(1,IZP-1) )
- MSBIT (MZ,IZW,IZP) = IOR (IAND (IZW, NOT(ISHFT(1,IZP-1)) )
- + , ISHFT(IAND(MZ,1),IZP-1))
- MSBYT (MZ,IZW,IZP,NZB) = IOR (
- + IAND (IZW, NOT(ISHFT (ISHFT(NOT(0),-32+NZB), IZP-1)))
- + , ISHFT (ISHFT(MZ,32-NZB), -33+IZP+NZB) )
- MCBYT (MZ,IZQ,IZW,IZP,NZB) = IOR (
- + IAND (IZW, NOT(ISHFT (ISHFT(NOT(0),-32+NZB), IZP-1)))
- + , ISHFT (ISHFT(ISHFT(MZ,-IZQ+1),32-NZB), -33+IZP+NZB) )
-#endif
-
-#endif
diff --git a/src/packlib/hepdb/hepdb/l3bitx.inc b/src/packlib/hepdb/hepdb/l3bitx.inc
deleted file mode 100644
index 903b606..0000000
--- a/src/packlib/hepdb/hepdb/l3bitx.inc
+++ /dev/null
@@ -1,110 +0,0 @@
-*
-* $Id: l3bitx.inc,v 1.2 2006/09/15 09:35:14 mclareni Exp $
-*
-* $Log: l3bitx.inc,v $
-* Revision 1.2 2006/09/15 09:35:14 mclareni
-* Submitted mods for gcc4/gfortran and MacOSX, corrected to work also on slc4 with gcc3.4 and 4.1
-*
-* Revision 1.1.1.1 1996/02/28 16:24:06 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#ifndef CERNLIB_HEPDB_L3BITX_INC
-#define CERNLIB_HEPDB_L3BITX_INC
-*
-*
-* l3bitx.inc
-*
-#if defined(CERNLIB_APOLLO)
-#include "hepdb/l3bits.inc"
- MSBIT (MZ,IZW,IZP) = OR (AND (IZW, NOT(LSHFT(1,IZP-1)) )
- + , LSHFT(AND(MZ,1),IZP-1) )
-*
- MCBYT (MZ,IZQ,IZW,IZP,NZB) = OR ( AND (IZW, NOT(
- + LSHFT (RSHFT(NOT(INT4(0)),32-NZB), IZP-1)))
- + , RSHFT (LSHFT(RSHFT(MZ,IZQ-1),32-NZB), 33-IZP-NZB) )
-*
- JBYTET (MZ,IZW,IZP,NZB) = AND (MZ,
- + RSHFT (LSHFT(IZW,33-IZP-NZB), 32-NZB) )
- JBYTOR (MZ,IZW,IZP,NZB) = OR (MZ,
- + RSHFT (LSHFT(IZW,33-IZP-NZB), 32-NZB) )
- MBYTET (MZ,IZW,IZP,NZB) = AND (IZW, NOT(RSHFT (
- + LSHFT(NOT(MZ),32-NZB), 33-IZP-NZB)) )
- MBYTOR (MZ,IZW,IZP,NZB) = OR (IZW, RSHFT (
- + LSHFT(MZ,32-NZB), 33-IZP-NZB) )
-#endif
-*
-* l3bitx.inc
-*
-#if defined(CERNLIB_CRAY)
-#include "hepdb/l3bits.inc"
- MSBIT (MZ,IZW,IZP) = (IZW .AND. SHIFT(MASK(65),IZP))
- + .OR. SHIFT(MZ.AND.MASK(127),IZP-1)
-*
- MCBYT (MZ,IZQ,IZW,IZP,NZB)=(IZW.AND.SHIFT(MASK(64-NZB),IZP-1))
- + .OR. SHIFT(SHIFTR(MZ,IZQ-1).AND.MASK(128-NZB),IZP-1)
-*
- JBYTET (MZ,IZW,IZP,NZB) = MZ .AND. SHIFTR(IZW,IZP-1)
- + .AND. MASK(128-NZB)
- JBYTOR (MZ,IZW,IZP,NZB) = MZ .OR. (SHIFTR(IZW,IZP-1)
- + .AND. MASK(128-NZB) )
- MBYTET (MZ,IZW,IZP,NZB) = IZW .AND.
- + SHIFT (MZ.OR. MASK(64-NZB), IZP-1)
- MBYTOR (MZ,IZW,IZP,NZB) = IZW .OR.
- + SHIFT (MZ.AND.MASK(128-NZB),IZP-1)
-#endif
-*
-* l3bitx.inc
-*
-#if defined(CERNLIB_IBM)||defined(CERNLIB_IBMRT)||defined(CERNLIB_VAX)\
- || defined(CERNLIB_GFORTRAN)
-#include "hepdb/l3bits.inc"
- MSBIT (MZ,IZW,IZP) = IOR (IAND (IZW, NOT(ISHFT(1,IZP-1)) )
- + , ISHFT(IAND(MZ,1),IZP-1))
-*
- MCBYT (MZ,IZQ,IZW,IZP,NZB) = IOR ( IAND (IZW, NOT(
- + ISHFT (ISHFT(NOT(0),-32+NZB), IZP-1)))
- + , ISHFT (ISHFT(ISHFT(MZ,-IZQ+1),32-NZB), -33+IZP+NZB) )
-*
- JBYTET (MZ,IZW,IZP,NZB) = IAND (MZ, IBITS(IZW,IZP-1,NZB))
- JBYTOR (MZ,IZW,IZP,NZB) = IOR (MZ, IBITS(IZW,IZP-1,NZB))
- MBYTET (MZ,IZW,IZP,NZB) = IAND (IZW, NOT(ISHFT (
- + ISHFT(NOT(MZ),32-NZB),-33+IZP+NZB)) )
- MBYTOR (MZ,IZW,IZP,NZB) = IOR (IZW, ISHFT (
- + ISHFT(MZ,32-NZB),-33+IZP+NZB) )
-#endif
-*
-* l3bitx.inc
-*
-#if defined(CERNLIB_F2C) && !defined(CERNLIB_GFORTRAN)
-#include "hepdb/l3bits.inc"
- JBYTET (MZ,IZW,IZP,NZB) = AND (MZ,
- + ishftr (LSHIFT(IZW,33-IZP-NZB),32-NZB) )
- JBYTOR (MZ,IZW,IZP,NZB) = OR (MZ,
- + ishftr (LSHIFT(IZW,33-IZP-NZB),32-NZB) )
- MBYTET (MZ,IZW,IZP,NZB) = AND (IZW,
- + NOT(ishftr (LSHIFT(NOT(MZ),32-NZB),33-IZP-NZB)) )
- MBYTOR (MZ,IZW,IZP,NZB) = OR (IZW,
- + ishftr (LSHIFT(MZ,32-NZB),33-IZP-NZB) )
- BTEST(IZW,IZP) = AND (IZW,LSHIFT(1,IZP)) .NE. 0
- IBSET(IZW,IZP) = OR (IZW,LSHIFT(1,IZP))
- IBCLR(IZW,IZP) = AND (IZW,NOT(LSHIFT(1,IZP)))
- IBITS (IZW,IZP,NZB) = ISHFTR (LSHIFT(IZW,32-IZP-NZB), 32-NZB)
-
-#endif
-*
-* l3bitx.inc
-*
-#if (defined(CERNLIB_WINNT))&&(!defined(CERNLIB_F2C))
-#include "hepdb/l3bits.inc"
- JBYTET (MZ,IZW,IZP,NZB) = IAND (MZ,
- + ISHFT (ISHFT(IZW,33-IZP-NZB),-32+NZB) )
- JBYTOR (MZ,IZW,IZP,NZB) = IOR (MZ,
- + ISHFT (ISHFT(IZW,33-IZP-NZB),-32+NZB) )
- MBYTET (MZ,IZW,IZP,NZB) = IAND (IZW,
- + NOT(ISHFT (ISHFT(NOT(MZ),32-NZB),-33+IZP+NZB)) )
- MBYTOR (MZ,IZW,IZP,NZB) = IOR (IZW,
- + ISHFT (ISHFT(MZ,32-NZB),-33+IZP+NZB) )
-#endif
-
-#endif
diff --git a/src/packlib/hepdb/hepdb/l3cores.inc b/src/packlib/hepdb/hepdb/l3cores.inc
deleted file mode 100644
index af2d182..0000000
--- a/src/packlib/hepdb/hepdb/l3cores.inc
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: l3cores.inc,v 1.1.1.1 1996/02/28 16:24:04 mclareni Exp $
-*
-* $Log: l3cores.inc,v $
-* Revision 1.1.1.1 1996/02/28 16:24:04 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#ifndef CERNLIB_HEPDB_L3CORES_INC
-#define CERNLIB_HEPDB_L3CORES_INC
-*
-*
-* l3cores.inc
-*
- PARAMETER (L3CORQ=200000, L3CORH=200000, L3CORK=70000)
-*
-
-#endif
diff --git a/src/packlib/hepdb/hepdb/nwpaw.inc b/src/packlib/hepdb/hepdb/nwpaw.inc
deleted file mode 100644
index 3f8030e..0000000
--- a/src/packlib/hepdb/hepdb/nwpaw.inc
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: nwpaw.inc,v 1.1.1.1 1996/02/28 16:24:01 mclareni Exp $
-*
-* $Log: nwpaw.inc,v $
-* Revision 1.1.1.1 1996/02/28 16:24:01 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#ifndef CERNLIB_HEPDB_NWPAW_INC
-#define CERNLIB_HEPDB_NWPAW_INC
-*
-*
-* nwpaw.inc
-*
- INTEGER NWPAW
- PARAMETER (NWPAW=500000)
-
-#endif
diff --git a/src/packlib/hepdb/hepdb/p3dbl3.inc b/src/packlib/hepdb/hepdb/p3dbl3.inc
deleted file mode 100644
index 75d18d7..0000000
--- a/src/packlib/hepdb/hepdb/p3dbl3.inc
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: p3dbl3.inc,v 1.1.1.1 1996/02/28 16:24:06 mclareni Exp $
-*
-* $Log: p3dbl3.inc,v $
-* Revision 1.1.1.1 1996/02/28 16:24:06 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#ifndef CERNLIB_HEPDB_P3DBL3_INC
-#define CERNLIB_HEPDB_P3DBL3_INC
-*
-*
-* p3dbl3.inc
-*
- COMMON /P3DBL3/ IDDBP3, NWDBP3, IWDBP3(32), LIDBP3, LODBP3, IQDBP3
- + , IXDBP3, IPASP3, NDIRP3, NBKDP3, NBKYP3, INDXP3
- + , LNK1P3, LNK2P3, LNK3P3, LNK4P3, LNK5P3, LNK6P3
- + , LNK7P3, LNK8P3, LNK9P3
-*
- COMMON /P3DBC3/ RNDBP3 , MSDBP3
- CHARACTER RNDBP3*8, MSDBP3*80
-*
-
-#endif
diff --git a/src/packlib/hepdb/hepdb/pilot.h b/src/packlib/hepdb/hepdb/pilot.h
deleted file mode 100644
index 5dc344e..0000000
--- a/src/packlib/hepdb/hepdb/pilot.h
+++ /dev/null
@@ -1,47 +0,0 @@
-#if defined(CERNLIB_WINNT)
-# if !defined(CERNLIB_UNIX)
-# define CERNLIB_UNIX
-# endif
-# define CERNLIB_LENDIAN
-# ifndef CERNLIB_QFMSOFT
-# define CERNLIB_BSLASH
-# endif
-# ifdef CERNLIB_MSSTDCALL
-# define CERNLIB_QXCAPT
-# else
-# define CERNLIB_QXNO_SC
-# endif
-#endif
-
-#if defined(CERNLIB_UNIX)
-#define CERNLIB__DEBUG
-#define CERNLIB__SERVER
-#define CERNLIB_EQUHOLCH
-#define CERNLIB_QHOLL
-#define CERNLIB_QTRHOLL
-#ifndef CERNLIB_QXCAPT
-# define CERNLIB_QX_SC
-#endif
-#endif
-
-#if defined(CERNLIB_LINUX)
-#if !defined(CERNLIB_PPC)
-#define CERNLIB_LENDIAN
-#endif
-#define CERNLIB_BSLASH
-#endif
-
-#if (defined(CERNLIB_DECS))||(defined(CERNLIB_QMVAOS))
-#define CERNLIB_LENDIAN
-#endif
-
-#if defined(CERNLIB_VAXVMS)
-#ifndef CERNLIB_VAX
-#define CERNLIB_VAX
-#endif
-#define CERNLIB__DEBUG
-#define CERNLIB__SERVER
-#define CERNLIB_EQUHOLCH
-#define CERNLIB_QHOLL
-#define CERNLIB_QTRHOLL
-#endif
diff --git a/src/packlib/hepdb/hepdb/qftitlch.inc b/src/packlib/hepdb/hepdb/qftitlch.inc
deleted file mode 100644
index 5ac4a0d..0000000
--- a/src/packlib/hepdb/hepdb/qftitlch.inc
+++ /dev/null
@@ -1,10 +0,0 @@
-*
-#ifndef CERNLIB_HEPDB_QFTITLCH_INC
-#define CERNLIB_HEPDB_QFTITLCH_INC
-*
-*
-* qftitlch.inc
-*
-#define HepdbTitleFortranString \
-'HEPDB 1.21/00 960329 12:00 CERN PROGRAM LIBRARY HEPDB=Q180'
-#endif
diff --git a/src/packlib/hepdb/hepdb/quest.inc b/src/packlib/hepdb/hepdb/quest.inc
deleted file mode 100644
index 619f2de..0000000
--- a/src/packlib/hepdb/hepdb/quest.inc
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: quest.inc,v 1.1.1.1 1996/02/28 16:24:02 mclareni Exp $
-*
-* $Log: quest.inc,v $
-* Revision 1.1.1.1 1996/02/28 16:24:02 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#ifndef CERNLIB_HEPDB_QUEST_INC
-#define CERNLIB_HEPDB_QUEST_INC
-*
-*
-* quest.inc
-*
- COMMON/QUEST/IQUEST(100)
- INTEGER IQUEST
-
-#endif
diff --git a/src/packlib/hepdb/hepdb/slate.inc b/src/packlib/hepdb/hepdb/slate.inc
deleted file mode 100644
index d32d5a3..0000000
--- a/src/packlib/hepdb/hepdb/slate.inc
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: slate.inc,v 1.1.1.1 1996/02/28 16:24:02 mclareni Exp $
-*
-* $Log: slate.inc,v $
-* Revision 1.1.1.1 1996/02/28 16:24:02 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#ifndef CERNLIB_HEPDB_SLATE_INC
-#define CERNLIB_HEPDB_SLATE_INC
-*
-*
-* slate.inc
-*
- COMMON/SLATE/IS(40)
- INTEGER IS
-
-#endif
diff --git a/src/packlib/hepdb/obsolete/cdp3/Makefile.in b/src/packlib/hepdb/obsolete/cdp3/Makefile.in
deleted file mode 100644
index b86d21e..0000000
--- a/src/packlib/hepdb/obsolete/cdp3/Makefile.in
+++ /dev/null
@@ -1,94 +0,0 @@
-#
-# hepdb/cdp3/Makefile.in - compiles and archives the source code in this directory.
-# It is invoked by Makefile.xxxxx in the above directory, where xxxxx is the name of the library.
-# Generated by car2cvs $Revision: 1.1.1.1 $ (nk)
-#
-# $Id: Makefile.in,v 1.1.1.1 1996/02/28 16:24:07 mclareni Exp $
-#
-# $Log: Makefile.in,v $
-# Revision 1.1.1.1 1996/02/28 16:24:07 mclareni
-# Hepdb, cdlib, etc
-#
-#
-
-MAKE = gmake
-SHELL = /bin/sh
-srcdir = @srcdir@
-VPATH = @srcdir@
-MACHINE = @MACHINE@
-
-CPP = @CPP@
-ETAGS = etags -a
-MAKEDEPEND = @MAKEDEPEND@
-FC = @FC@
-FFLAGS = @FFLAGS@
-OPT_FFLAGS = @OPT_FFLAGS@
-DBG_FFLAGS = @DBG_FFLAGS@
-ifeq "$(srcdir)" "."
- absrcdir = $(shell pwd)
-else
- absrcdir = $(srcdir)
-endif
-
-FORTRAN_SOURCES=$(wildcard $(srcdir)/*.F)
-
-NOTDIR_F_SOURCES=$(notdir $(FORTRAN_SOURCES))
-
-OBJS=$(NOTDIR_F_SOURCES:%.F=$(LIBRARY)(%.o))
-
-VAX_FORTRAN_SOURCES=$(NOTDIR_F_SOURCES:%.F=$(LOCALVAXSRC)/%.for)
-
-VAX_COMS := $(NOTDIR_F_SOURCES:.F=.com)
-
-LIBRARY=dummy
-ifeq "$(LIBRARY)" "dummy"
- OBJS=
-endif
-.SUFFIXES: .cdf
-
-.PHONY:dummy production vaxsrc vaxcom debug clean distclean realclean TAGS depend fort_depend c_depend cc_depend
- @
-
-dummy::
- @echo Run Makefile in the parent directory
-
-debug production:$(OBJS)
- @test "$(LIBRARY)" = "dummy" || test "`echo *.o`" = "*.o" || ($(AR) rvs $(LIBRARY) *.o;$(RM) *.o)
-
-vaxsrc:$(VAX_FORTRAN_SOURCES)
- @
-
-vaxcom:$(VAX_COMS)
- @
-
-clean:
- @rm -f *.o *.bak
-
-distclean:clean
- @rm -f Makefile Makefile.obj
-
-realclean:
- @rm -f *~ #*
-
-TAGS:$(absrcdir)/*[Fch]
- @$(ETAGS) -f $(dir $(LIBRARY))/TAGS.$(LIBRARY_NAME) $(absrcdir)/*[Fch]
-
-depend:fort_depend
- @test "$(LIBRARY)" != "dummy" || echo Run Makefile in the parent directory
-
-.F.a:
- $(FC) $(CERNLIB_DEFS) $(CERNLIB_FFLAGS) $(FFLAGS) -c $<
-
-
-$(LOCALVAXSRC)/%.for:%.F ; $(CPP) -DCERNLIB_VAX $(CERNLIB_DEFS) $(CERNLIB_FFLAGS) $(FFLAGS) $< | grep -v "^\#" > $@
- @
-
-%.com:%.F ; @echo "$$ @cernlib_cfl $* $(shell basename $(srcdir)) $(shell basename $(shell dirname $(srcdir))) $(LIBRARY_NAME) $(CERNLIB_DEFS)" >> $(LOCALVAXSRC)/cfl.com
- @
-
-fort_depend:$(FORTRAN_SOURCES)
- @test "$(LIBRARY)" = "dummy" || test -z "$(FORTRAN_SOURCES)" || $(MAKEDEPEND) -o.o\) -p$$\(LIBRARY\)\( $(CERNLIB_DEFS) $(CERNLIB_FFLAGS) $(FORTRAN_SOURCES)
-
-
-
-
diff --git a/src/packlib/hepdb/obsolete/cdp3/README b/src/packlib/hepdb/obsolete/cdp3/README
deleted file mode 100644
index babd29e..0000000
--- a/src/packlib/hepdb/obsolete/cdp3/README
+++ /dev/null
@@ -1,9 +0,0 @@
-*
-* $Id: README,v 1.1.1.1 1996/02/28 16:24:07 mclareni Exp $
-*
-* $Log: README,v $
-* Revision 1.1.1.1 1996/02/28 16:24:07 mclareni
-* Hepdb, cdlib, etc
-*
-*
-* This directory was created from hepdb.car patch cdp3
diff --git a/src/packlib/hepdb/obsolete/cdp3/cdchld.F b/src/packlib/hepdb/obsolete/cdp3/cdchld.F
deleted file mode 100644
index 1c45c31..0000000
--- a/src/packlib/hepdb/obsolete/cdp3/cdchld.F
+++ /dev/null
@@ -1,88 +0,0 @@
-*
-* $Id: cdchld.F,v 1.1.1.1 1996/02/28 16:24:07 mclareni Exp $
-*
-* $Log: cdchld.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:07 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#if defined(CERNLIB_APOLLO)||defined(CERNLIB_IBM)
-#include "sys/CERNLIB_machine.h"
-#include "_hepdb/pilot.h"
-#if defined(CERNLIB__P3CHILD)
-#if defined(CERNLIB__P3CHILD)
-* Ignoring t=dummy
-#endif
- SUBROUTINE CDCHLD
-* =================
-*
-************************************************************************
-* *
-* SUBR. CDCHLD *
-* *
-* Prepares the interrupt message vector and halts execution *
-* *
-* Called by CDAFRI, CDATOI, CDDDIR, CDEALI, CDENTB, CDINIT, CDKOUT, *
-* CDPART, CDPURP, CDRENK, CDSDIR, CDSNAM, CDSPUR, CDUSP3 *
-* *
-************************************************************************
-*
-#include "cdcblk.inc"
-#include "p3dbl3.inc"
-* ------------------------------------------------------------------
-*
- IF (RNDBP3.EQ.'CDRZIN ') GO TO 100
-*
-* ** Encode name of calling routine
-*
- CALL UCTOH (RNDBP3, IWDBP3(NWDBP3+1), 4, 8)
- NWDBP3 = NWDBP3 + 2
-*
-* ** Interrupt host
-*
- CALL APPAUS ('CDCHLD', NWDBP3, IWDBP3)
-*
-* ** Extract Host return code
-*
- IQDBP3 = IWDBP3(NWDBP3)
- NWDBP3 = NWDBP3 - 1
-*
- GO TO 999
-*
-* *** Called in conjunction with DBRZIN
-*
- 100 IF (NBKDP3.GT.0) INDXP3 = INDXP3+NBKDP3+21
- IF (INDXP3.LE.1) THEN
- IQDBP3=99
- GO TO 999
- ENDIF
- IQ(KOFUCD+LNK1P3+1) = NDIRP3
-*
-* ** Interrupt host
-*
- IWDBP3(3) = INDXP3
- CALL UCTOH (RNDBP3, IWDBP3(4), 4, 8)
- NWDBP3 = 5
- CALL APSEND (IQDBP3, 'CDCHLD', NWDBP3, IWDBP3,
- + IQ(KOFUCD+LNK1P3+1), INDXP3)
-*
- NDIRP3=0
- NBKYP3=0
- NBKDP3=0
- INDXP3=1
- IF (IQDBP3.EQ.0) IQDBP3=IWDBP3(1)
- IF (IQDBP3.NE.0) GO TO 999
-*
-* ** Read the objects now
-*
- IF (LNK3P3.NE.0) THEN
- CALL MZDROP (IXDBP3, LNK3P3, 'BVL.')
- LNK3P3 = 0
- ENDIF
- NWDBP3 = 32
- CALL APFZIN (IDDBP3, IXDBP3, LNK3P3, 2, '....', NWDBP3, IWDBP3)
- IQDBP3 = IQUEST(1)
-* END CDCHLD
- 999 END
-#endif
-#endif
diff --git a/src/packlib/hepdb/obsolete/cdp3/dbhost.F b/src/packlib/hepdb/obsolete/cdp3/dbhost.F
deleted file mode 100644
index 3920bc0..0000000
--- a/src/packlib/hepdb/obsolete/cdp3/dbhost.F
+++ /dev/null
@@ -1,448 +0,0 @@
-*
-* $Id: dbhost.F,v 1.1.1.1 1996/02/28 16:24:07 mclareni Exp $
-*
-* $Log: dbhost.F,v $
-* Revision 1.1.1.1 1996/02/28 16:24:07 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#if defined(CERNLIB_APOLLO)||defined(CERNLIB_IBM)
-#include "sys/CERNLIB_machine.h"
-#include "_hepdb/pilot.h"
-#if !defined(CERNLIB__P3CHILD)
- SUBROUTINE DBHOST (IDTASK, NWUSER, IWUSER)
-* ==========================================
-*
-************************************************************************
-* *
-* SUBR. DBHOST (IDTASK,NWUSER,IWUSER) *
-* *
-* Service routine for HEPDB requests from child tasks *
-* *
-* Arguments : *
-* *
-* IDTASK Child identifier *
-* NWUSER Number of words in the message vector *
-* IWUSER Message vector *
-* *
-* Called by <user> *
-* *
-************************************************************************
-*
-#include "zunit.inc"
-#include "mqsys.inc"
-#include "caopti.inc"
-#include "cduscm.inc"
-#include "p3dbl3.inc"
- COMMON /P3ZEBR/ ZEBRP3(35), IDTZP3
-*
- DIMENSION IWUSER(9)
- DIMENSION INKEYS(3), IARG(6), MLDBP3(8)
- CHARACTER CHNAME*8 , OLDDIR*255
- SAVE MLDBP3, IXSYP3, NBDBP3, KQSP3
-*
- DATA INITDB, INITZ, INITRZ, KQSP3 /0,0,0,0/
- DATA INKEYS /4HEBRA, 4HINIT, 4HDONE/
- DATA CHNAME /'ABCDEFGH'/
-*
-* ------------------------------------------------------------------
-*
- CALL APTBEG (INDXT)
-*
-* ** Check that ZEBRA system has been initialized
-*
- ICODE = 0
- IF (INITZ.EQ.0) THEN
- DO 2 K=1,3
- IF (MQKEYS(K).NE.INKEYS(K)) GO TO 900
- 2 CONTINUE
- IF (NQSTOR.LT.0) GO TO 902
- LIDBP3 = 0
- LODBP3 = 0
- INITZ = 1
- CALL P3UNIT (LPRTAP)
- ENDIF
-*
-* ** Check that HEPDB system has been initialized
-*
- IF (INITDB.EQ.0) THEN
- DO 4 K=1,8
- IF (CALFCA(K).NE.CHNAME(K:K)) GO TO 10
- 4 CONTINUE
- INITDB = IDIVCD
- ENDIF
-*
-* ** Load the message vector
-*
- 10 CALL APHTOC (IWUSER(NWUSER-1), RNDBP3, 8)
- IDDBP3 = IDTASK
- NWDBP3 = NWUSER - 2
- CALL UCOPY (IWUSER, IWDBP3, NWDBP3)
- MSDBP3 = ' '
- CALL APHTOC (IWUSER, MSDBP3, 8)
- IQDBP3 = -1
-*
- CALL P3LOGQ (LOGLAP)
- IF (LOGLAP.GT.1) CALL CDPRNT (LPRTAP, '(/,'' DBHOST : Invoked '//
- + 'by Task'',I3,'', Routine '//RNDBP3//''')', IDTASK, 1)
-*
-* ** Select action to take
-*
- IF (RNDBP3.EQ.'CDRZIN') THEN
- ICODE = 7
- ELSE IF (RNDBP3.EQ.'CDAFRI') THEN
- ICODE = 3
- ELSE IF (RNDBP3.EQ.'CDATOI') THEN
- ICODE = 4
- ELSE IF (RNDBP3.EQ.'CDEND ') THEN
- ICODE = 6
- ELSE IF (RNDBP3.EQ.'CDINIT') THEN
- ICODE = 1
- ELSE IF (RNDBP3.EQ.'CDSNAM') THEN
- IF (MSDBP3.EQ.'JOURNAL') THEN
- ICODE = 2
- ELSE
- ICODE = 5
- ENDIF
- ELSE IF (MSDBP3.EQ.'JOURNAL') THEN
- ICODE = 2
- ELSE
- GO TO 910
- ENDIF
-*
- GO TO (100,200,300,400,500,600,100), ICODE
-*
-* ** CDINIT : open Database file in update mode
-*
- 100 IF (INITDB.NE.0) GO TO 150
-*
-* ** Database not initialized: look for largest store
-*
- IBIG = 0
- MYSTOR = -1
- DO 120 JQ=0,NQSTOR
- KQ = NQOFFT(JQ+1)
- ISIZE = LQSTA(KQ+21) - LQSTA(KQ+1)
- IF (ISIZE.GT.IBIG) THEN
- IBIG = ISIZE
- MYSTOR = JQ
- ENDIF
- 120 CONTINUE
-*
-* ** Create a division in the largest store
-*
- MYSTOR = ISHFT (MYSTOR, 26)
- CALL MZDIV (MYSTOR, INITDB, 'APDBL3', 5000, 16384, 'PR')
-*
-* ** O.K., we can go now
-*
- 150 IF (ICODE .EQ.7) GO TO 700
-*
- IF (NWDBP3.LT.8) GO TO 920
- LUN = IWDBP3(1)
- MSDBP3 = ' '
- CALL APHTOC (IWDBP3(2), MSDBP3, 16)
- NRECS = IWDBP3(6)
- CALL APHTOC (IWDBP3(7), MSDBP3(17:24), 8)
- IF (LOGLAP.GT.-1) THEN
- IF (LOGLAP.LT.2)
- + CALL CDPRNT (LPRTAP, '(/,'' DBHOST : Invoked '//
- + 'by Task'',I3,'', Routine '//RNDBP3//''')', IDTASK, 1)
- IARG(1) = LUN
- IARG(2) = NRECS
- CALL CDPRNT (LPRTAP, '('' Initialize directory '//
- + MSDBP3(1:16)//' on unit'',I3,'', options '//MSDBP3(17:24)//
- + ', record length'',I6)', IARG, 2)
- ENDIF
- CALL DBINIT (INITDB, LUN, MSDBP3(1:16), LTOP, NRECS,MSDBP3(17:24))
- IQDBP3 = IQUEST(1)
- IF (IQDBP3.EQ.-2) IQDBP3 = 0
- IF (LIDBP3.EQ. 0) CALL APOPCH (LIDBP3, 0, IQDBP3)
- NWDBP3 = 0
- CALL DBLOGL (LUN, LOGLAP)
- GO TO 800
-*
-* ** "Journal file": update database
-*
- 200 IF (INITDB.EQ.0) GO TO 930
- IF (LOGLAP.GT.1) CALL CDPRNT (LPRTAP, '('' Update '//
- + 'Database'')', IARG, 0)
- IF (LIDBP3.EQ.0) CALL APOPCH (LIDBP3, 0, IQDBP3)
- IQDBP3 = 0
- NWDBP3 = 0
- GO TO 800
-*
-* ** Update Database by reading journal file
-*
- 250 IDTZP3 = IDDBP3
- CALL DBFZUP (LIDBP3,'S')
- GO TO 999
-*
-* ** CDAFRI : copy text onto external file from a bank
-*
- 300 LUN = IWDBP3(1)
- NDATA = IWDBP3(2)
- IQDBP3 = 0
- IF (LIDBP3.EQ.0) CALL APOPCH (LIDBP3, 0, IQDBP3)
- NWDBP3 = 0
- GO TO 800
-*
- 350 CALL APFZIN (IDDBP3,JQPDVL,LBANK,2,'A',0,0)
- IF (IQUEST(1).NE.0) GO TO 999
- NDATA = IQ(KQS+LBANK-1)
- IF (NDATA.LE.0) GO TO 999
- NTOT = 0
- 360 IF (NTOT.LT.NDATA) THEN
- CALL CDLIND (IQ(KQS+LBANK+1), NTOT, MSDBP3, LENG)
- IF (LENG.GT.0) THEN
- WRITE (LUN,'(A)') MSDBP3(1:LENG)
- ELSE
- WRITE (LUN,*)
- ENDIF
- GO TO 360
- ENDIF
- CALL MZDROP (JQPDVL, LBANK, 'L')
- GO TO 999
-*
-* ** CDATOI : copy text from external file into a bank
-*
- 400 LUN = IWDBP3(1)
- NDATA = NDMXCB
- CALL UCTOH ('APDB', ITEMP3, 4, 4)
- CALL MZBOOK (JQPDVL, LBANK , 0, 2, ITEMP3, 0, 0, NDATA, 1, -1)
- NDAT = 0
- 410 READ (LUN, '(A80)', ERR=420, END=420) MSDBP3
- LENG = LENOCC (MSDBP3)
- CALL CDLINC (MSDBP3, LENG, IQ(KQS+LBANK+1), NDAT)
- IF (NDAT.GT.NDATA-20) THEN
- IQDBP3 = -1
- GO TO 800
- ENDIF
- GO TO 410
- 420 NDP = NDAT - NDATA
- IF (NDP.LT.0) CALL MZPUSH (JQPDVL, LBANK, 0, NDP, 'I')
- IQDBP3 = 0
- NWDBP3 = 1
- IWDBP3(1) = NDAT
- IF (LODBP3.EQ.0) CALL APOPCH (LODBP3, 1, IQDBP3)
- LBANK = LZFIDH (JQPDVL, ITEMP3, 0)
- GO TO 800
-*
- 450 CALL APFZUT (IDDBP3, JQPDVL, LBANK, 1, 'S', 1, 0, 0)
- CALL MZDROP (JQPDVL, LBANK, ' ')
- GO TO 999
-*
-* ** CDSNAM : copy bank from external file
-*
- 500 LUN = IWDBP3(1)
- IF (LODBP3.EQ.0) CALL APOPCH (LODBP3, 1, IQDBP3)
- CALL FZIN (LUN, JQPDVL, LBANK, 2, 'A', 0, 0)
- IQDBP3 = IQUEST(1)
- NWDBP3 = 0
- GO TO 800
-*
-* ** DBEND : ready for future applications
-*
- 600 IQDBP3 = 0
- NWDBP3 = 0
- GO TO 800
- 650 CONTINUE
- GO TO 999
-*
-* ** DBRZIN: retrieve set of data objects
-*
- 700 IF (INITRZ.EQ.0) THEN
- INITRZ = 1
- IXSTP3 = ISHFT(INITDB,-26)
- IXDBP3 = ISHFT(IXSTP3, 26) + 2
- IXSYP3 = ISHFT(IXSTP3, 26) + 24
- CALL MZLINK (IXDBP3, '/P3DBL3/', LNK1P3, LNK1P3, LNK9P3)
- CALL UCTOH ('DBRZ', MLDBP3(1), 4, 4)
- MLDBP3(2) = 0
- MLDBP3(3) = 0
- MLDBP3(4) = 5
- CALL MZIOBK (MLDBP3, 8, '2I 1B 2F')
- CALL MZBOOK (IXSYP3, LNK1P3, 0, 2, 'DBP3', 0, 0, 122, 2, 0)
- NBDBP3 = 122
- KQSP3 = KQS
- ENDIF
-* Receive list of requests
- INDXP3 = IWDBP3(3)
- NWDBP3 = 0
- CHNAME = MSDBP3
- IF (LOGLAP.GT.1) CALL CDPRNT (LPRTAP, '(/,'' Called '//
- + 'by '//CHNAME//' with'',I6,'' data words'')', INDXP3, 1)
- IF (INDXP3.GT.NBDBP3) THEN
- INC = INDXP3-NBDBP3
- CALL MZNEED (IXSYP3, INC, 'G...')
- IF (IQUEST(11).LT.0) THEN
- IQDBP3 = 11
- GO TO 790
- ENDIF
- CALL MZPUSH (IXSYP3, LNK1P3, 0, INC, 'I...')
- NBDBP3 = INDXP3
- ENDIF
-*
- CALL P3RECV (IDDBP3, IQ(KQSP3+LNK1P3+1), NW, NBDBP3, IQDBP3)
-*
- IF (IQDBP3.EQ.0.AND.NW.LT.INDXP3) THEN
- IQDBP3 = 12
- GO TO 790
- ENDIF
-* Nb. of directories
- NDIRP3 = IQ(KQSP3+LNK1P3+1)
-* Prepare banks
- IF (LNK2P3.NE.0) CALL MZDROP (IXDBP3, LNK2P3, 'L...')
- CALL MZBOOK (IXDBP3, LNK2P3, 0, 2, 'DBP3', 2, 2, 0, 2, 0)
-* Retrieve objects
- NBRETR = 0
- INDXP3 = 1
- CALL RZCDIR (OLDDIR, 'R...')
-*
- DO 740 NDIR = 1, NDIRP3
-* Set directory
- CALL ZITOH (IQ(KQSP3+LNK1P3+INDXP3+2), IWDBP3, 20)
- CALL UHTOC (IWDBP3, 4, MSDBP3, 80)
- CALL RZCDIR (MSDBP3,'....')
- IF (IQUEST(1).NE.0) THEN
- IQDBP3 = 13
- GO TO 790
- ENDIF
-* Nb. of keys
- NBKDP3 = IQ(KQSP3+LNK1P3+INDXP3+1)
-* Read data banks
- INDXP3 = INDXP3+21
- DO 730 NBK = 1, NBKDP3
- INDXP3 = INDXP3+1
- ICUR = IQ(KQSP3+LNK1P3+INDXP3)
- IF (NBRETR.EQ.0) THEN
- LNK9P3 = LNK2P3
- JBP3 = -1
- ELSE
- LNK9P3 = LNK3P3
- JBP3 = 0
- ENDIF
- LBANK = LNK9P3
- CALL RZIN (IXDBP3, LBANK, JBP3, ICUR, 999999, 'S...')
- IF (IQUEST(1).NE.0) THEN
- IQDBP3 = 14
- GO TO 790
- ENDIF
- LNK3P3 = LQ(KQSP3+LNK9P3+JBP3)
- LNK9P3 = 0
-* Save first words in a special bank (unpacking,backwards compatib.)
- CALL MZNEED (IXDBP3, 20, 'G...')
- IF (IQUEST(11).LT.0) THEN
- IQDBP3 = 15
- GO TO 790
- ENDIF
- IF (NBRETR.EQ.0) THEN
- CALL MZLIFT (IXDBP3, LNK4P3, LNK2P3,-2, MLDBP3, 0)
- ELSE
- CALL MZLIFT (IXDBP3, LBANK, LNK4P3, 0, MLDBP3, 0)
- LNK4P3 = LBANK
- ENDIF
- DO 725 I = 1, 2
- IQ(KQSP3+LNK4P3+I ) = IQ(KQSP3+LNK3P3+I)
- Q(KQSP3+LNK4P3+I+3) = Q(KQSP3+LNK3P3+I)
- 725 CONTINUE
- IQ(KQSP3+LNK4P3+3) = IQ(KQSP3+LNK3P3+3)
-*
- NBRETR = NBRETR+1
- 730 CONTINUE
-*
- IF (LOGLAP.GT.1) CALL CDPRNT (LPRTAP, '(I10,'' Data objects '//
- + 'retrieved from '//MSDBP3//' '')', NBKDP3, 1)
-*
- 740 CONTINUE
- IF (LOGLAP.GT.1) CALL CDPRNT (LPRTAP, '(I10,'' Data objects '//
- + 'retrieved'')', NBRETR, 1)
- IQDBP3=0
-* Reset directory
- CALL RZCDIR (OLDDIR, '....')
- GO TO 800
-*
-* ** Transfer objects to child
-*
- 750 CALL APFZUT (IDDBP3, IXDBP3, LNK2P3, 1, '....', 2, 0, IWDBP3)
- CALL MZDROP (IXDBP3, LNK2P3, '....')
- CALL MZGARB (IXDBP3, 0)
- CALL MZDRED (IXDBP3)
- GO TO 999
-*
-* ** Errors
-*
- 790 IF (LOGLAP.LT.1) GO TO 800
- IF (LOGLAP.LT.2) THEN
- CALL CDPRNT (LPRTAP, '(/,'' DBHOST : Invoked '//
- + 'by Task'',I3,'', Routine '//RNDBP3//''')', IDTASK, 1)
- CALL CDPRNT (LPRTAP, '(/,'' Called '//
- + 'by '//CHNAME//' with'',I6,'' data words'')', INDXP3, 1)
- ENDIF
-*
- GO TO (791,792,793,794,795), IQDBP3-10
-*
- 791 CALL CDPRNT (LPRTAP,
- + '('' ****** Error : No more space available in system '//
- + 'division to store list of requests'')', IARG, 0)
- GO TO 800
-*
- 792 IARG(1) = INDXP3
- IARG(2) = NW
- CALL CDPRNT (LPRTAP,
- + '('' ****** Error in P3RECV:'',I6,'' Words expected,'',
- + I6,'' Words received'')', IARG, 2)
- GO TO 800
-*
- 793 CALL CDPRNT (LPRTAP,
- + '('' ****** Error : Unknow directory '//MSDBP3//' '')',
- + IARG, 0)
- GO TO 800
-*
- 794 IARG(1) = IQUEST(1)
- IARG(2) = ICUR
- CALL CDPRNT (LPRTAP,
- + '('' ****** RZIN Error'',I6,'' for Key'',I5,'' in'//
- + MSDBP3//' '')', IARG, 2)
- GO TO 800
-*
- 795 CALL CDPRNT (LPRTAP,
- + '('' ****** Error : No more space available in user '//
- + 'division to store auxiliary data'')', IARG, 0)
- GO TO 800
-*
-* ** Restart child task
-*
- 800 NWDBP3 = NWDBP3+1
- IWDBP3(NWDBP3) = IQDBP3
- CALL APCONT (IDDBP3, IRET, NWDBP3, IWDBP3)
- IF (IQDBP3.NE.0.OR.IRET.NE.0) GO TO 999
-*
- GO TO (999,250,350,450,450,650,750), ICODE
-*
-* ** Errors
-*
- 900 CALL CDPRNT (6, '(/,'' DBHOST : ZEBRA system not initialized'')',
- + IARG, 0)
- GO TO 990
- 902 CALL CDPRNT (IQPRNT, '(/,'' DBHOST : no ZEBRA store was initial'//
- + 'ized'')', IARG, 0)
- GO TO 990
- 910 CALL CDPRNT (IQPRNT, '(/,'' DBHOST : Unknown request '//RNDBP3//
- + ''')', IARG, 0)
- GO TO 990
- 920 CALL CDPRNT (IQPRNT, '(/,'' DBHOST : not enough message words '//
- + 'received ('',I2,'') -- 8 expected'')', NWDBP3, 1)
- GO TO 990
- 930 CALL CDPRNT (IQPRNT, '(/,'' DBHOST : DBL3 not initialized yet'')',
- + IARG, 0)
-*
- 990 IQDBP3 = -1
- NWDBP3 = 0
- GO TO 800
-*
- 999 CALL APTEND (INDXT,'DBHOST',IDTASK)
-* END DBHOST
- END
-#endif
-#endif
diff --git a/src/packlib/hepdb/programs/Imakefile b/src/packlib/hepdb/programs/Imakefile
deleted file mode 100644
index 69ed47f..0000000
--- a/src/packlib/hepdb/programs/Imakefile
+++ /dev/null
@@ -1,9 +0,0 @@
-
-#define IHaveSubdirs
-#define PassCDebugFlags
-
-PROGRAMDIRS= hepdb cdbackup cdmake cdmove cdserv
-
-SUBDIRS= $(PROGRAMDIRS)
-
-InstallBinSubdirs($(SUBDIRS))
diff --git a/src/packlib/hepdb/programs/cdbackup/Imakefile b/src/packlib/hepdb/programs/cdbackup/Imakefile
deleted file mode 100644
index 07bf3af..0000000
--- a/src/packlib/hepdb/programs/cdbackup/Imakefile
+++ /dev/null
@@ -1,5 +0,0 @@
-SRCS_F= cdbackup.F zabend.F
-
-CernlibFortranProgramTarget(cdbackup,$(OBJS),NullParameter,NullParameter,packlib)
-
-InstallProgram(cdbackup,$(CERN_BINDIR))
diff --git a/src/packlib/hepdb/programs/cdbackup/cdbackup.F b/src/packlib/hepdb/programs/cdbackup/cdbackup.F
deleted file mode 100644
index 0e3f742..0000000
--- a/src/packlib/hepdb/programs/cdbackup/cdbackup.F
+++ /dev/null
@@ -1,151 +0,0 @@
-*
-* $Id: cdbackup.F,v 1.4 2000/01/04 17:13:27 mclareni Exp $
-*
-* $Log: cdbackup.F,v $
-* Revision 1.4 2000/01/04 17:13:27 mclareni
-* Correct includes and remove IARGC dummy argument
-*
-* Revision 1.3 2000/01/04 15:56:30 jamie
-* change I6 to I6.6 (blank in filename)
-*
-* Revision 1.2 1996/05/02 11:48:22 jamie
-* increase zebra store to 3M for wa98 db
-*
-* Revision 1.1.1.1 1996/02/28 16:23:33 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- PROGRAM CDBACKUP
-*
-* Convert HEPDB RZ files to exchange format
-*
- CHARACTER*255 CHNAMF,CHSERV,CHLINE,CHFILE,CHBACK,CHLINK
- PARAMETER (IPRINT=6)
- PARAMETER (IDEBUG=0)
- PARAMETER (LUNI=1)
- PARAMETER (LUNO=2)
- PARAMETER (LUNN=4)
- PARAMETER (NWPAW=3000000)
- COMMON/PAWC/PAW(NWPAW)
- INTEGER SYSTEMF
-
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB_TCPSOCK))
- IDUMMY = CINIT(DUMMY)
-#endif
- CALL HLIMIT(NWPAW)
-
- NARGS = IARGC()
-
- IF(NARGS.LT.2) THEN
- WRITE(IPRINT,9001)
- 9001 FORMAT(' CDBACKUP. Usage:',
- + ' cdbackup source-directory target-directory')
- GOTO 999
- ENDIF
-
- CALL CDVERS(' ',' ','P')
-
- CALL XZINIT(IPRINT,IDEBUG,LUNI,LUNO)
-
- CALL GETARG(1,CHSERV)
- LSERV = LENOCC(CHSERV)
-
- CALL GETARG(2,CHBACK)
- LBACK = LENOCC(CHBACK)
-
- IF(IDEBUG.GE.1) WRITE(IPRINT,9002) CHSERV(1:LSERV),CHBACK(1:LBACK)
- 9002 FORMAT(' CDBACKUP. Server directory: ',A,' Backup directory: ',A)
-*
-* Open NAMES file and loop over all database files
-* (identified by :file tags)
-*
-#if defined(CERNLIB_UNIX)
- IF(CHSERV(LSERV:LSERV).NE.'/') THEN
- LSERV = LSERV + 1
- CHSERV(LSERV:LSERV) = '/'
- ENDIF
- IF(CHBACK(LBACK:LBACK).NE.'/') THEN
- LBACK = LBACK + 1
- CHBACK(LBACK:LBACK) = '/'
- ENDIF
-#endif
-
- CHNAMF = CHSERV(1:LSERV)//'HEPDB.NAMES'
- LNAMF = LSERV + 11
-
-#if defined(CERNLIB_UNIX)
- CALL CUTOL(CHNAMF(1:LNAMF))
-#endif
-
- IF(IDEBUG.GE.1) WRITE(IPRINT,9003) CHNAMF(1:LNAMF)
- 9003 FORMAT(' CDBACKUP. Names file: ',A)
-
- OPEN(LUNN,FILE=CHNAMF(1:LNAMF),ACCESS='SEQUENTIAL',
- + FORM='FORMATTED',STATUS='OLD',IOSTAT=IRC)
- IF(IRC.NE.0) GOTO 20
-
- 10 CONTINUE
- READ(LUNN,'(A)',END=999) CHLINE
- LLINE = LENOCC(CHLINE)
- IF(IDEBUG.GE.2) WRITE(IPRINT,9004) CHLINE(1:LLINE)
- 9004 FORMAT(' CDBACKUP. Read line: ',A,' from names file')
- IF(INDEX(CHLINE(1:LLINE),':file.').EQ.0) GOTO 10
-
- ISTART = INDEX(CHLINE(1:LLINE),':file.') + 6
- CHFILE = CHLINE(ISTART:LLINE)
- LFILE = LLINE - ISTART + 1
- IEND = INDEX(CHFILE(1:LFILE),' :')
- IF(IEND.NE.0) LFILE = IEND - 1
-
-#if defined(CERNLIB_UNIX)
- ISTART = INDEXB(CHFILE(1:LFILE),'/') + 1
-#endif
-#if defined(CERNLIB_VAXVMS)
- ISTART = INDEX(CHFILE(1:LFILE),']') + 1
-#endif
- IEND = INDEXB(CHFILE(1:LFILE),'.')
-
- IF(IDEBUG.GE.1) WRITE(IPRINT,9005) CHFILE(1:LFILE)
- 9005 FORMAT(' CDBACKUP. database file: ',A)
-
- CALL DATIME(ID,IT)
-
- WRITE(CHBACK(LBACK+1:),9006) CHFILE(ISTART:IEND),ID
- 9006 FORMAT(A,I6.6)
- LBAKK = LBACK + IEND - ISTART + 7
-
- IRECL = 3600
- PRINT 9007,CHFILE(1:LFILE),CHBACK(1:LBAKK)
- 9007 FORMAT(' CDBACKUP. copying ',A,' to ',A)
- CALL XZRTOF(CHFILE(1:LFILE),CHBACK(1:LBAKK),IRECL,' ',IRC)
-
- 20 CONTINUE
- IF(IRC.NE.0) THEN
-#if defined(CERNLIB_IBMVM)
- STOP 4
-#endif
-#if defined(CERNLIB_VAXVMS)
- CALL SYS$EXIT(%VAL(4))
-#endif
-#if defined(CERNLIB_UNIX)
- CALL FAEXIT(4)
-#endif
- ELSE
-#if defined(CERNLIB_UNIX)
-*
-* Create link to latest 'good' backup
-*
- CHLINK = CHBACK(1:LBAKK-6)//'good'
- LLINK = LBAKK - 2
- CALL UNLINKF(CHLINK(1:LLINK))
- PRINT 9008,CHBACK(1:LBAKK),CHLINK(1:LLINK)
- 9008 FORMAT(' CDBACKUP. linking ',A,' to ',A)
- ISTAT = SYSTEMF('ln -s '//CHBACK(1:LBAKK)//
- + ' '//CHLINK(1:LLINK))
-#endif
- ENDIF
-
- GOTO 10
-
- 999 END
diff --git a/src/packlib/hepdb/programs/cdbackup/zabend.F b/src/packlib/hepdb/programs/cdbackup/zabend.F
deleted file mode 100644
index 2a46b45..0000000
--- a/src/packlib/hepdb/programs/cdbackup/zabend.F
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: zabend.F,v 1.2 2000/01/04 17:13:55 mclareni Exp $
-*
-* $Log: zabend.F,v $
-* Revision 1.2 2000/01/04 17:13:55 mclareni
-* Correct includes
-*
-* Revision 1.1.1.1 1996/02/28 16:23:33 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE ZABEND
- CHARACTER*255 CHDIR
-
- PRINT 9001
-9001 FORMAT(' CDBACKUP. ZABEND routine reached - ZPOSTM cancelled')
- CALL RZCDIR(CHDIR,'R')
- LDIR = LENOCC(CHDIR)
-
- PRINT 9002,CHDIR(1:LDIR)
-9002 FORMAT(' CDBACKUP. current directory is ',A)
-
-#if defined(CERNLIB_VAXVMS)
- CALL SYS$EXIT(%VAL(1736938))
-#endif
-#if defined(CERNLIB_UNIX)
- CALL FAEXIT(16)
-#endif
-#if defined(CERNLIB_IBM)
- STOP 16
-#endif
- END
diff --git a/src/packlib/hepdb/programs/cddump/cddump.F b/src/packlib/hepdb/programs/cddump/cddump.F
deleted file mode 100644
index be149fd..0000000
--- a/src/packlib/hepdb/programs/cddump/cddump.F
+++ /dev/null
@@ -1,170 +0,0 @@
-*
-* $Id: cddump.F,v 1.1.1.1 1996/02/28 16:23:33 mclareni Exp $
-*
-* $Log: cddump.F,v $
-* Revision 1.1.1.1 1996/02/28 16:23:33 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_hepdb/pilot.h"
- PROGRAM CDDUMP
-*
-* Program to dump headers of journal file(s)
-*
- COMMON/PAWC/PAW(50000)
- COMMON/QUEST/IQUEST(100)
- CHARACTER*255 CHPATH,CHDICT
- CHARACTER*8 CHALIA
- CHARACTER*80 CHOPT
- CHARACTER*40 CHACT(9)
- DIMENSION IUHEAD(400)
- DIMENSION IOCR(100)
- PARAMETER (JBIAS=2)
- PARAMETER (IEVENT=0)
-
- CALL HLIMIT(50000)
-*
-* Action codes
-*
- CHACT(1) = 'Enter data'
- CHACT(2) = 'MKDIR'
- CHACT(3) = 'Delete data'
- CHACT(4) = 'RMDIR'
- CHACT(5) = 'mv'
- CHACT(6) = 'Help/mnemonic names manipulation'
- CHACT(7) = 'Alias manipulation'
- CHACT(8) = 'Purge partitions'
- CHACT(9) = 'Delete object (don''t)'
-
- CALL FZFILE(1,0,'IA')
- OPEN(1,ACCESS='SEQUENTIAL',
- + FORM='FORMATTED',
-#if defined(CERNLIB_IBM)
- + ACTION='READ',
-#endif
-#if defined(CERNLIB_VAXVMS)
- + READONLY,
-#endif
- + STATUS='OLD')
- CALL FZLOGL(1,0)
-#if defined(CERNLIB_IBM)
-#endif
-#if defined(CERNLIB_VAXVMS)
-#endif
- NREC=0
- 10 CONTINUE
- NHEAD = 400
- CALL FZIN(1,0,LSUP,2,'S',NHEAD,IUHEAD)
- IF(IQUEST(1).EQ.0) THEN
- NREC = NREC + 1
-*
-* Print the fixed part of the header
-*
- IF(IUHEAD(1).GT.0.AND.IUHEAD(1).LT.10) THEN
- PRINT 9001,CHACT(IUHEAD(1)),(IUHEAD(I),I=2,4)
- 9001 FORMAT(' CDDUMP: ',A,' number of key elements: ',I3,
- + ' number of words for CHOPT: ',I2,
- + ' number of words for PATH: ',I2)
- ENDIF
-
- NWKEY = IUHEAD(2)
- LCHOPT = IUHEAD(3)
- LPATH = IUHEAD(4)
-*
-* Now the variable bit
-*
- IF(IUHEAD(1).EQ.1) THEN
- ICHOPT = IUHEAD(2) + 5
- IPATH = IUHEAD(2) + 6 + LCHOPT
- CALL UHTOC(IUHEAD(ICHOPT),4,CHOPT,LCHOPT*4)
- CALL UHTOC(IUHEAD(IPATH),4,CHPATH,LPATH*4)
- PRINT 9002,CHPATH(1:LPATH*4),CHOPT(1:LCHOPT*4)
- 9002 FORMAT(' CDDUMP. path ',A,' CHOPT ',A)
- ELSEIF(IUHEAD(1).EQ.2) THEN
- ICHOPT = 8
- NCFO = (NWKEY+3)/4
- IPATH = IUHEAD(4) + NCFO + 2*NWKEY + 8
- CALL UHTOC(IUHEAD(ICHOPT),4,CHOPT,LCHOPT*4)
- CALL UHTOC(IUHEAD(IPATH),4,CHPATH,LPATH*4)
- PRINT 9002,CHPATH(1:LPATH*4),CHOPT(1:LCHOPT*4)
- CALL CDUPTM(IDATE,ITIME,IUHEAD(6),IRC)
- PRINT 9003,IUHEAD(5),IDATE,ITIME
- 9003 FORMAT(' CDDUMP. max. # objects/partition = ',I6,
- + ' date/time = ',I6.6,'/',I4.4)
- ELSEIF(IUHEAD(1).EQ.3) THEN
-*
-* cdpurg/cdpurk
-*
- NPAIRS = IUHEAD(5)
- CALL UHTOC(IUHEAD(ICHOPT),4,CHOPT,LCHOPT*4)
- CALL UHTOC(IUHEAD(IPATH),4,CHPATH,LPATH*4)
- PRINT 9002,CHPATH(1:LPATH*4),CHOPT(1:LCHOPT*4)
- ELSEIF(IUHEAD(1).EQ.4) THEN
- ICHOPT = 7
- IPATH = ICHOPT + LCHOPT
- CALL UHTOC(IUHEAD(ICHOPT),4,CHOPT,LCHOPT*4)
- CALL UHTOC(IUHEAD(IPATH),4,CHPATH,LPATH*4)
- PRINT 9002,CHPATH(1:LPATH*4),CHOPT(1:LCHOPT*4)
- CALL CDUPTM(IDATE,ITIME,IUHEAD(6),IRC)
- PRINT 9004,IDATE,ITIME
- 9004 FORMAT(' CDDUMP. date/time = ',I6.6,'/',I4.4)
- ELSEIF(IUHEAD(1).EQ.5) THEN
- IPATH = 2*IUHEAD(2)+6
- CALL UHTOC(IUHEAD(IPATH),4,CHPATH,LPATH*4)
- PRINT 9005,CHPATH(1:LPATH*4)
- 9005 FORMAT(' CDDUMP. path ',A)
- ELSEIF(IUHEAD(1).EQ.6) THEN
- ICHOPT = IUHEAD(2) + 5
- IPATH = IUHEAD(2) + 6 + LCHOPT
- CALL UHTOC(IUHEAD(ICHOPT),4,CHOPT,LCHOPT*4)
- CALL UHTOC(IUHEAD(IPATH),4,CHPATH,LPATH*4)
- PRINT 9002,CHPATH(1:LPATH*4),CHOPT(1:LCHOPT*4)
- IF(IUHEAD(5).EQ.1) THEN
- PRINT 9006
- 9006 FORMAT(' CDDUMP. enter help information')
- ELSEIF(IUHEAD(5).EQ.2) THEN
- PRINT 9007
- 9007 FORMAT(' CDDUMP. enter dictionary information')
- ENDIF
- ELSEIF(IUHEAD(1).EQ.7) THEN
- IPATH = IUHEAD(4) + 9
- IDICT = 7
- LDICT = IUHEAD(4)
- LPATH = IUHEAD(6)
- IALIA = IUHEAD(4) + 7
- CALL UHTOC(IUHEAD(IPATH),4,CHPATH,LPATH*4)
- CALL UHTOC(IUHEAD(IDICT),4,CHDICT,LPATH*4)
- CALL UHTOC(IUHEAD(IALIA),4,CHALIA,8)
- PRINT 9008,CHALIA,CHPATH(1:LPATH*4),CHDICT(1:LDICT*4)
- 9008 FORMAT(' CDDUMP. enter alias ',A,' for path ',A,
- + ' in dictionary ',A)
- ELSEIF(IUHEAD(1).EQ.8) THEN
- ICHOPT = 7
- IPATH = IUHEAD(3) + 7
- LPATH = IUHEAD(4)
- CALL CDUPTM(IDATE,ITIME,IUHEAD(5),IRC)
- CALL UHTOC(IUHEAD(7),4,CHOPT,4)
- CALL UHTOC(IUHEAD(IPATH),4,CHPATH,LPATH*4)
- PRINT 9002,CHPATH(1:LPATH*4),CHOPT(1:LCHOPT*4)
- PRINT 9004,IDATE,ITIME
- ELSEIF(IUHEAD(1).EQ.9) THEN
-*
-* CDDONT
-*
- ICHOPT = IUHEAD(2) + 5
- IPATH = IUHEAD(2) + 6 + LCHOPT
- CALL UHTOC(IUHEAD(ICHOPT),4,CHOPT,LCHOPT*4)
- CALL UHTOC(IUHEAD(IPATH),4,CHPATH,LPATH*4)
- PRINT 9002,CHPATH(1:LPATH*4),CHOPT(1:LCHOPT*4)
- ELSE
- PRINT 9009,IUHEAD(1)
- 9009 FORMAT(' CDDUMP: unrecognised action code ',I2)
- ENDIF
-
- GOTO 10
- ENDIF
- CALL FZENDI(1,'T')
- CLOSE(1)
-*
- 999 END
diff --git a/src/packlib/hepdb/programs/cdhepdb/cdhepdb.F b/src/packlib/hepdb/programs/cdhepdb/cdhepdb.F
deleted file mode 100644
index 5beddd5..0000000
--- a/src/packlib/hepdb/programs/cdhepdb/cdhepdb.F
+++ /dev/null
@@ -1,455 +0,0 @@
-*
-* $Id: cdhepdb.F,v 1.1.1.1 1996/02/28 16:23:33 mclareni Exp $
-*
-* $Log: cdhepdb.F,v $
-* Revision 1.1.1.1 1996/02/28 16:23:33 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_hepdb/pilot.h"
- PROGRAM CDHEPDB
-*CMZ : 21/02/91 16.24.17 by Jamie Shiers
-*-- Author : Jamie Shiers 21/02/91
-* Program to move updates between CERNVM and HEPDB
-*
-* Stolen from FATMEN.
-*
- PARAMETER (NDIR=100)
- CHARACTER*255 CHDIRS(NDIR)
- PARAMETER (NMAX=500)
- CHARACTER*64 FILES(NMAX)
- CHARACTER*8 HEPUSR,HEPNOD,REMUSR,REMNOD,REMDBS
- CHARACTER*64 REMOTE,TARGET
- CHARACTER*12 CHTIME
- CHARACTER*8 CHUSER,CHPASS
- CHARACTER*8 CHNODE,CHTYPE,CHSYS,CHRAND
- CHARACTER*6 CHENT
- CHARACTER*80 CHMAIL,LINE,CHDIR
- CHARACTER*38 VALID
- CHARACTER*255 ERRMSG
- CHARACTER*2 CDPREF
- CHARACTER*255 CDFILE
- COMMON/PAWC/PAW(50000)
- PARAMETER (IPRINT=6)
- PARAMETER (IDEBUG=0)
- PARAMETER (LUNI=1)
- PARAMETER (LUNO=2)
-#include "quest.inc"
-#include "slate.inc"
- DATA NENTRY/0/
- DATA VALID/'ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890._'/
-*
-* Initialise ZEBRA
-*
- CALL HLIMIT(50000)
-*
-* Initialise XZ
-*
- CALL XZINIT(IPRINT,IDEBUG,LUNI,LUNO)
-*
- CALL CDHOST(CHNODE,IRC)
- LNODE = LENOCC(CHNODE)
-*
-* Open connection to HEPDB...
-*
-#if defined(CERNLIB_TCPSOCK)
- IDUMMY = CINIT(IDUMMY)
-#endif
-#if !defined(CERNLIB_TCPSOCK)
- CALL VMREXX('F','USER',CHUSER,IC)
- CALL VMREXX('F','PWD' ,CHPASS,IC)
- CALL CUTOL(CHUSER)
- CALL CUTOL(CHPASS)
- CALL VMSTAK(CHPASS,'L',IC)
- CALL VMSTAK(CHUSER,'L',IC)
-#endif
-
- CALL CZOPEN('zserv','HEPDB',IRC)
-*
-* First entry: look on hepdb before sleeping
-*
- NDIRS = 0
- GOTO 20
-
- 10 CALL VMCMS('EXEC HDBSERV',IRC)
- IF(IRC.EQ.99) GOTO 20
- IF(IRC.NE.0) THEN
- PRINT *,'CDHEPDB. error ',IRC,' from HDBSERV. Stopping...'
- GOTO 90
- ENDIF
-
- NENTRY = NENTRY + 1
-*
-* Get the user and node name for this file...
-*
- CALL VMCMS('GLOBALV SELECT *EXEC STACK HDBADDR',IC)
- CALL VMRTRM(LINE,IEND)
- ISTART = ICFNBL(LINE,1,IEND)
- CALL CDWORD(HEPUSR,0,' ',LINE(ISTART:IEND),IC)
- LHEP = LENOCC(HEPUSR)
- CALL CDWORD(HEPNOD,1,' ',LINE(ISTART:IEND),IC)
- LNOD = LENOCC(HEPNOD)
-*
-* Get file name (for database prefix and name of remote server)
-*
- CALL VMCMS('GLOBALV SELECT *EXEC STACK CDFILE',IC)
- CALL VMRTRM(CDFILE,LFILE)
- CDPREF = CDFILE(1:2)
- LBLANK = INDEX(CDFILE(1:LFILE),' ')
- JBLANK = INDEXB(CDFILE(1:LFILE),' ')
- REMDBS = CDFILE(LBLANK+1:JBLANK-1)
- LDBS = JBLANK - LBLANK - 1
-
- IF(IDEBUG.GE.1)
- +PRINT *,'CDHEPDB. Update received for ',REMDBS(1:LDBS),' prefix ',
- + CDPREF
-*
-* Number of pending files
-*
- CALL VMCMS('GLOBALV SELECT *EXEC STACK HDBFILES',IC)
- CALL VMRTRM(LINE,IEND)
- NRDR = ICDECI(LINE,1,IEND)
-
- CALL DATIME(ID,IT)
- WRITE(CHTIME,'(I6.6,I4.4,I2.2)') ID,IT,IS(6)
- WRITE(CHENT ,'(I6.6)') NENTRY
- CALL CDRAND(CHRAND,IRC)
-*
-* Now put this file...
-* This assumes the HEPDB naming convention: /hepdb/cdgroup,
-* e.g. /hepdb/cdchorus
- CHDIR = '/hepdb/'//REMDBS(1:LDBS)//
- + '/todo'
- LDIR = LENOCC(CHDIR)
-*
- REMOTE = ' '
- REMOTE = 'zz'//CHTIME//CHRAND//CHENT
- + //'.'//HEPUSR(1:LHEP)//'_'//HEPNOD(1:LNOD)
- LREM = LENOCC(REMOTE)
- TARGET = REMOTE(1:LREM)
-*
-* Change remote directory
-*
- CALL CUTOL(CHDIR(1:LDIR))
- IF(IDEBUG.GE.1) PRINT *,'CDHEPDB. Changing remote directory to ',
- + CHDIR(1:LDIR)
- CALL XZCD(CHDIR(1:LDIR),IRC)
- IF(IRC.NE.0) THEN
- WRITE(ERRMSG,9001) CHDIR(1:LDIR)
- 9001 FORMAT(' CDHEPDB. error ',I10,' changing remote directory to ',A)
- LMSG = LENOCC(ERRMSG)
- GOTO 100
- ENDIF
-
- IF(IDEBUG.GE.1) PRINT *,'CDHEPDB. Sending file as ',
- + REMOTE(1:LREM)
- CALL XZPUTA(CDFILE(1:LFILE),REMOTE(1:LREM),' ',IC)
- IF(IC.NE.0) THEN
- WRITE(ERRMSG,9002) IC,HEPUSR,HEPNOD
- 9002 FORMAT(' CDHEPDB. error ',I6,' sending update from ',
- + A,' at ',A,' to HEPDB')
- LMSG = LENOCC(ERRMSG)
- GOTO 100
- ENDIF
-*
-* Rename the remote update file
-*
- LSTA = INDEXB(TARGET(1:LREM),'/') + 1
- TARGET(LSTA:LSTA+1) = CDPREF
- IF(IDEBUG.GE.1) PRINT *,'CDHEPDB. Renaming file to ',
- + TARGET(1:LREM)
- CALL XZMV(REMOTE(1:LREM),TARGET(1:LREM),' ',IRC)
- IF(IRC.NE.0) THEN
- WRITE(ERRMSG,9003) IRC,REMOTE(1:LREM)
- 9003 FORMAT(' CDHEPDB. error ',I10,' renaming ',A)
- LMSG = LENOCC(ERRMSG)
- GOTO 100
- ENDIF
-*
-* Delete this update...
-*
- CALL VMCMS('ERASE '//CDFILE(1:LFILE),IC)
-*
-* Try to clear out RDR
-*
- IF(NRDR.GT.10) GOTO 10
-*
-* Are there any files for us to get?
-*
- 20 CONTINUE
-*
-* Get list of remote directories
-*
- JCONT = 0
- IF(NDIRS.EQ.0) THEN
- IF(IDEBUG.GE.1) PRINT 9004
- 9004 FORMAT(' CDHEPDB. Retrieving list of remote directories...')
- CALL XZLS('/hepdb/cd*/tovm',CHDIRS,NDIR,NDIRS,JCONT,'D',IC)
- NDIRS = MIN(NDIR,NDIRS)
- IF(JCONT.NE.0) THEN
- IC = 0
- PRINT 9005
- 9005 FORMAT(' CDHEPDB. too many directories - excess names',
- + ' will be flushed')
-*
- 30 CONTINUE
- CALL CZGETA(CHMAIL,ISTAT)
- LCH = LENOCC(CHMAIL)
- IF(CHMAIL(1:1).EQ.'0') THEN
-*
-* Nop
-*
- ELSEIF(CHMAIL(1:1).EQ.'1') THEN
- ELSEIF(CHMAIL(1:1).EQ.'2') THEN
- GOTO 30
- ELSEIF(CHMAIL(1:1).EQ.'3') THEN
- IQUEST(1) = 1
- IRC = 1
- ELSEIF(CHMAIL(1:1).EQ.'E') THEN
- IQUEST(1) = -1
- IRC = -1
- ELSEIF(CHMAIL(1:1).EQ.'V') THEN
- GOTO 30
- ELSE
- IQUEST(1) = 1
- IRC = 1
- ENDIF
-
- ENDIF
-
- IF(IC.NE.0) THEN
- WRITE(ERRMSG,9006) IC
- 9006 FORMAT(' CDHEPDB. error ',I10,' issuing remote LS command')
- LMSG = LENOCC(ERRMSG)
- GOTO 100
- ENDIF
-*
- ENDIF
-
- IF(NDIRS.EQ.1.AND.INDEX(CHDIRS(1),'not found').NE.0) THEN
- ERRMSG = 'CDHEPDB. there are no remote directories!'
- LMSG = LENOCC(ERRMSG)
- GOTO 100
- ENDIF
-
- DO 80 J=1,NDIRS
-
- LDIR = LENOCC(CHDIRS(J))
- IF(LDIR.EQ.0) GOTO 80
- CALL CLTOU(CHDIRS(J)(1:LDIR))
-*
-* Get the name of the server for whom these updates are intended...
-*
- JSTART = INDEX(CHDIRS(J)(1:LDIR),'/CD')
- IF(JSTART.EQ.0) THEN
- IF(IDEBUG.GE.-3)
- + PRINT *,'CDHEPDB. unrecognised directory - skipped ',
- + '(',CHDIRS(J)(1:LDIR),')'
- GOTO 80
- ELSE
- JSTART = JSTART + 1
- ENDIF
-
- JEND = INDEX(CHDIRS(J)(JSTART:LDIR),'/')
-
- IF(JEND.EQ.0) THEN
- PRINT *,'CDHEPDB. unrecognised file name - skipped ',
- + '(',CHDIRS(J)(1:LDIR),')'
- GOTO 80
- ENDIF
-
- REMUSR = CHDIRS(J)(JSTART:JSTART+JEND-2)
- LREM = LENOCC(REMUSR)
-
- IF(LREM.EQ.0) THEN
- IF(IDEBUG.GE.-3)
- + PRINT *,'CDHEPDB. unrecognised file name - skipped ',
- + '(',CHDIRS(J)(1:LDIR),')'
- GOTO 80
- ENDIF
-
- IF(IDEBUG.GE.1)
- + PRINT *,'CDHEPDB. processing updates for ',REMUSR(1:LREM)
- CALL XZCD(CHDIRS(J)(1:LDIR),IRC)
- IF(IRC.NE.0) THEN
- IF(IDEBUG.GE.-3)
- + PRINT 9007,CHDIRS(J)(1:LDIR)
- 9007 FORMAT(' CDHEPDB. cannot set directory to ',A)
- LMSG = LENOCC(ERRMSG)
- GOTO 100
- ENDIF
-
- ICONT = 0
- NFILES = 0
- IF(IDEBUG.GE.1) PRINT *, 'HEPDB. Retrieving list '
- + //'of remote files in ', CHDIRS(J)(1:LDIR)
- CALL XZLS(' ',FILES,NMAX,NFILES,ICONT,' ',IC)
- NFILES = MIN(NFILES,NMAX)
- IF(IDEBUG.GE.2)
- + PRINT *,'CDHEPDB. ',NFILES,' files found in ',CHDIRS(J)(1:LDIR)
- IF(ICONT.NE.0) THEN
- IC = 0
- IF(IDEBUG.GE.0)
- + PRINT 9008
- 9008 FORMAT(' CDHEPDB. too many files - excess names will be',
- + ' flushed')
-*
- 40 CONTINUE
- CALL CZGETA(CHMAIL,ISTAT)
- LCH = LENOCC(CHMAIL)
- IF(CHMAIL(1:1).EQ.'0') THEN
-*
-* Nop
-*
- ELSEIF(CHMAIL(1:1).EQ.'1') THEN
- ELSEIF(CHMAIL(1:1).EQ.'2') THEN
- GOTO 40
- ELSEIF(CHMAIL(1:1).EQ.'3') THEN
- IQUEST(1) = 1
- IRC = 1
- ELSEIF(CHMAIL(1:1).EQ.'E') THEN
- IQUEST(1) = -1
- IRC = -1
- ELSEIF(CHMAIL(1:1).EQ.'V') THEN
- GOTO 40
- ELSE
- IQUEST(1) = 1
- IRC = 1
- ENDIF
-*
- ENDIF
-
-
- DO 70 I=1,NFILES
- LF = LENOCC(FILES(I))
- IF(LF.EQ.0) GOTO 70
- CALL CLTOU(FILES(I))
-*
-* Fix for the case when there are no files...
-*
- IF(NFILES.EQ.1) THEN
-
- IF(INDEX(FILES(I)(1:LF),'DOES NOT EXIST').NE.0.OR.
- + INDEX(FILES (I)(1:LF),'NOT FOUND').NE.0) GOTO 10
-
- IF(INDEX(FILES(I)(1:LF),'ARG LIST TOO LONG').NE.0) THEN
- IF(IDEBUG.GE.-3) THEN
- PRINT *,'CDHEPDB. Stopping due to the following '
- + //'error...'
- PRINT *,FILES(I)(1:LF)
- PRINT *,'(Intervention required on HEPDB)'
- ENDIF
- CALL VMCMS('EXEC TELL JAMIE '//FILES(I)(1:LF),IC)
- CALL VMCMS('EXEC TELL JAMIE Logging off...',IC)
- CALL VMCMS('EXEC TELL FATONE Logging off due to'//
- + FILES(I)(1:LF),IC)
- CALL VMSTAK('LOGOFF','L',IC)
- STOP
- ENDIF
-
- ENDIF
-*
-* Check that file name is valid
-*
- DO 50 L=1,LF
- IF(INDEX(VALID,FILES(I)(L:L)).EQ.0) THEN
- IF(IDEBUG.GE.-3) THEN
- PRINT *,'CDHEPDB. invalid character ',
- + FILES(I)(L:L),
- + ' at ',L,' in ',FILES(I)(1:LF)
- PRINT *,'CDHEPDB. skipping update...'
- ENDIF
- GOTO 70
- ENDIF
- 50 CONTINUE
-
- IF(INDEX(FILES(I)(1:LF),CHNODE(1:LNODE)).NE.0) THEN
- IF(IDEBUG.GE.1)
- + PRINT *,'CDHEPDB. skipping update for ',CHNODE(1:LNODE),
- + '(',FILES(I)(1:LF),')'
- GOTO 70
- ENDIF
- LSLASH = INDEXB(FILES(I)(1:LF),'/')
- IF(FILES(I)(LSLASH+1:LSLASH+2).EQ.'ZZ') THEN
- IF(IDEBUG.GE.1)
- + PRINT *,'CDHEPDB. active file - skipped ', '(',FILES(I)
- + (1:LF),')'
- GOTO 70
- ENDIF
-
- IF(IDEBUG.GE.2)
- + PRINT *,'CDHEPDB. update found for ',REMUSR(1:LREM), '(',
- + FILES(I)(1:LF),')'
-
- IF(IDEBUG.GE.1) PRINT *,'CDHEPDB. retrieving update ',
- + FILES(I)(1:LF)
-
- CDPREF = FILES(I)(1:LF)
- CALL CDRAND(CHRAND,IRC)
- CDFILE = CDPREF // CHRAND(3:) // '.HEPDB.B'
- LFILE = 16
-
- CALL XZGETA(CDFILE(1:LFILE),FILES(I)(1:LF),'S',IC)
- IF(IC.NE.0) THEN
- WRITE(ERRMSG,9009) IC,REMUSR(1:LREM)
- 9009 FORMAT(' CDHEPDB. error ',I6,' retrieving update for ',A)
- LMSG = LENOCC(ERRMSG)
- GOTO 100
- ENDIF
-*
-* Protection against zero length files
-*
- IF(IQUEST(11).EQ.0) GOTO 60
-
- LDOT = INDEX(CDFILE(1:LFILE),'.')
- CDFILE(LDOT:LDOT) = ' '
- LDOT = INDEX(CDFILE(1:LFILE),'.')
- CDFILE(LDOT:LDOT) = ' '
-
- CALL VMCMS('EXEC SENDFILE '//CDFILE(1:LFILE)//' TO '
- + //REMUSR(1:LREM),IC)
- IF(IC.NE.0) THEN
- WRITE(ERRMSG,9010) IC,REMUSR(1:LREM)
- 9010 FORMAT(' CDHEPDB. error ',I6,' sending update to ',A)
- LMSG = LENOCC(ERRMSG)
- GOTO 100
- ENDIF
-*
-* Now delete local file
-*
- CALL VMCMS('ERASE '//CDFILE(1:LFILE),IC)
-*
-* and the remote one
-*
- 60 continue
- CALL XZRM(FILES(I)(1:LF),IC)
- IF(IC.NE.0) THEN
- WRITE(ERRMSG,9011) IC,FILES(I)(1:LF)
- 9011 FORMAT(' CDHEPDB. error ',I6,' deleting file ',A)
- LMSG = LENOCC(ERRMSG)
- GOTO 100
- ENDIF
-
- 70 CONTINUE
-
- 80 CONTINUE
-*
-* Wait for some action...
-*
- GOTO 10
-
- 90 CALL CZCLOS(ISTAT)
- STOP
- 100 CONTINUE
-*
-* Error exit
-*
- IF(IDEBUG.GE.-3) PRINT *,ERRMSG(1:LMSG)
- CALL VMCMS('EXEC TELL JAMIE '//ERRMSG(1:LMSG),IC)
- CALL VMCMS('EXEC TELL JAMIE Logging off...',IC)
- CALL VMCMS('EXEC TELL FATONE Logging off due to'//ERRMSG(1:LMSG),
- + IC)
- CALL VMSTAK('LOGOFF','L',IC)
- GOTO 90
- END
diff --git a/src/packlib/hepdb/programs/cdmain/cdmain.F b/src/packlib/hepdb/programs/cdmain/cdmain.F
deleted file mode 100644
index 59fb94f..0000000
--- a/src/packlib/hepdb/programs/cdmain/cdmain.F
+++ /dev/null
@@ -1,103 +0,0 @@
-*
-* $Id: cdmain.F,v 1.1.1.1 1996/02/28 16:23:34 mclareni Exp $
-*
-* $Log: cdmain.F,v $
-* Revision 1.1.1.1 1996/02/28 16:23:34 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_hepdb/pilot.h"
- PROGRAM CDMAIN
-* ==============
-*
-************************************************************************
-* *
-* PROG. CDMAIN *
-* *
-* Main Program of the Interactive HEPDB based on the KUIP Package *
-* *
-************************************************************************
-*
- PARAMETER (L3CORQ=200000, L3CORH=200000, L3CORK=70000)
- COMMON /GCBANK/ FENCCD(22), LQ(L3CORQ)
- COMMON /PAWC/ PAW(L3CORH)
- PARAMETER (L3WKST=1, NARGL3=100)
- COMMON /L3FLAG/ IFTML3, IGYFL3, IHFIL3, IHISL3, INTXL3, IPRTL3
- + , IPR2L3, IWKTL3, IXERL3, MOP3L3, ARGSL3(NARGL3)
- INTEGER IARGL3(NARGL3)
- INTEGER IFTML3, IGYFL3, IHFIL3, IHISL3, INTXL3, IPRTL3
- + , IPR2L3, IWKTL3, IXERL3, MOP3L3
- REAL ARGSL3
- EQUIVALENCE (IARGL3(1), ARGSL3(1))
- PARAMETER (MAXJCX=20, MAXVCX= 20, LUKYCX=88, LUDACX=89)
- COMMON /CXLINK/ ISTOCX, KEYSCX(100), MASKCX(100), L3PRCX, LURZCX
- + , LFRSCX, LJOICX, LKJNCX(MAXJCX), LDJNCX(MAXJCX)
- + , LVIWCX, LKVWCX(MAXVCX), LDVWCX(MAXVCX), LASTCX
-*
- DATA LUNER /19/, LUNMF /10/
-*
-* ------------------------------------------------------------------
-*
-* *** Interface to C-routines for KUIP
-*
- CALL INITC
-*
-* *** Initialize ZEBRA
-*
- CALL MZEBRA (-1)
-*
-* ** Initialize DB-Store, User-Division, User-Links
-*
- CALL CDXINI (L3CORQ)
-*
-* ** Initialize PAW and KUIP
-*
- CALL HLIMIT (-L3CORH)
- CALL KUINIT (L3CORK)
- INTXL3 = 1
- NWORD = 0
- CALL IGINIT (NWORD)
- CALL KUOPEN (LUNMF, 'dbase.metafile', 'UNKNOWN', ISTAT)
- CALL KUOPEN (LUNER, 'gkserror.log', 'UNKNOWN', ISTAT)
- CALL HERMES (LUNER)
- CALL IGWKTY (IWKTL3)
- CALL HPLINT (IWKTL3)
- CALL IGSA (L3WKST)
-*
-* ** Define the Exit Routine
-*
- CALL TIMEST (99999.)
-*
-* * Create the Interactive Command structure
-*
- CALL HERMES (L3PRCX)
- CALL VECDEF
- CALL CDINXI
- CALL HISDEF
- CALL FUNDEF
- CALL NTUDEF
- CALL ZEBDEF
- CALL GRADEF
- CALL PICDEF
- CALL FORDEF
- CALL NETDEF
- CALL PVEDEF
-*
-* * Set prompt
-*
- CALL KUEXEC ('SET/PROMPT ''DB >''')
-*
-* * Execute LOGON Macro
-*
- CALL KUEXEC ('EXEC DBLOGN')
-*
- CALL KUSPY ('NEVER')
-*
- CALL KUWHAT
-*
- CALL CDEND ('*', 'A', IRC)
- STOP
-* END CDMAIN
- END
-
diff --git a/src/packlib/hepdb/programs/cdmake/Imakefile b/src/packlib/hepdb/programs/cdmake/Imakefile
deleted file mode 100644
index 5d12ae2..0000000
--- a/src/packlib/hepdb/programs/cdmake/Imakefile
+++ /dev/null
@@ -1,5 +0,0 @@
-SRCS_F= cdmake.F
-
-CernlibFortranProgramTarget(cdmake,$(OBJS),NullParameter,NullParameter,packlib)
-
-InstallProgram(cdmake,$(CERN_BINDIR))
diff --git a/src/packlib/hepdb/programs/cdmake/cdmake.F b/src/packlib/hepdb/programs/cdmake/cdmake.F
deleted file mode 100644
index 3084034..0000000
--- a/src/packlib/hepdb/programs/cdmake/cdmake.F
+++ /dev/null
@@ -1,123 +0,0 @@
-*
-* $Id: cdmake.F,v 1.2 1996/03/12 13:07:35 cernlib Exp $
-*
-* $Log: cdmake.F,v $
-* Revision 1.2 1996/03/12 13:07:35 cernlib
-* Build hepdb programs: hepdb, cdserv, cdnew, and cdmove
-*
-* Revision 1.1.1.1 1996/02/28 16:23:34 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- PROGRAM CDMAKE
-* ==============
-*
-* Create a new, empty database
-*
- PARAMETER (NWPAW=100000)
- COMMON/PAWC/PAW(NWPAW)
-#include "hepdb/slate.inc"
- CHARACTER*255 CHLINE
- CHARACTER*255 CHFILE
-*
-* Initialise Zebra, HBOOK and HEPDB
-*
- CALL CDPAW(NWPAW,NHBOOK,IDIV,'USR-DIV',5000,50000,'ZPHU',IRC)
-*
-* Unit for database access
-*
- LUNCD = 1
-*
-* Get database parameters
-*
- CALL GETENVF('CDFILE',CHFILE)
- IF(IS(1).EQ.0) THEN
- CHFILE = 'HEPDB.DBS'
- LFILE = 9
- WRITE(6,9001) CHFILE(1:LFILE)
- 9001 FORMAT(' CDMAKE. database name defaulted to ',A,/,
- + ' (environmental variable CDFILE not set)')
- ELSE
- LFILE = IS(1)
- WRITE(6,9002) CHFILE(1:LFILE)
- 9002 FORMAT(' CDMAKE. database name set to ',A)
- ENDIF
-
- CALL GETENVF('CDPAIR',CHLINE)
- IF(IS(1).EQ.0) THEN
- NPAIR = 1
- WRITE(6,9003) NPAIR
- 9003 FORMAT(' CDMAKE. # of validity pairs defaulted to ',I3,/,
- + ' (environmental variable CDPAIR not set)')
- ELSE
- NPAIR = ICDECI(CHLINE,1,IS(1))
- IF(NPAIR.LE.0) THEN
- WRITE(6,9004) NPAIR
- 9004 FORMAT(' CDMAKE. # of validity pairs invalid: ',I3)
- STOP 4
- ENDIF
- WRITE(6,9005) NPAIR
- 9005 FORMAT(' CDMAKE. # of validity pairs set to ',I3)
- ENDIF
-
- CALL GETENVF('CDPRE',CHLINE)
- IF(IS(1).EQ.0) THEN
- NPRE = 10000
- WRITE(6,9006) NPRE
- 9006 FORMAT(' CDMAKE. # of preformatted records defaulted to ',I6,/,
- + ' (environmental variable CDPRE not set)')
- ELSE
- NPRE = ICDECI(CHLINE,1,IS(1))
- WRITE(6,9007) NPRE
- 9007 FORMAT(' CDMAKE. # of preformatted records set to ',I3)
- ENDIF
-
- CALL GETENVF('CDTOP',CHLINE)
- IF(IS(1).EQ.0) THEN
- NTOP = 1
- WRITE(6,9008) NTOP
- 9008 FORMAT(' CDMAKE. database numeric ID defaulted to ',I3,/,
- + ' (environmental variable CDTOP not set)')
- ELSE
- NTOP = ICDECI(CHLINE,1,IS(1))
- WRITE(6,9009) NTOP
- 9009 FORMAT(' CDMAKE. database numeric ID set to ',I3)
- ENDIF
-
- CALL GETENVF('CDQUO',CHLINE)
- IF(IS(1).EQ.0) THEN
- NQUO = 65000
- WRITE(6,9010) NQUO
- 9010 FORMAT(' CDMAKE. database quota defaulted to ',I6,/,
- + ' (environmental variable CDQUO not set)')
- ELSE
- NQUO = ICDECI(CHLINE,1,IS(1))
- WRITE(6,9011) NQUO
- 9011 FORMAT(' CDMAKE. database quota defaulted to ',I3)
- ENDIF
-
- CALL GETENVF('CDRECL',CHLINE)
- IF(IS(1).EQ.0) THEN
- LRECL = 1024
- WRITE(6,9012) LRECL
- 9012 FORMAT(' CDMAKE. record length defaulted to ',I6,' words ',/,
- + ' (environmental variable CDRECL not set)')
- ELSE
- LRECL = ICDECI(CHLINE,1,IS(1))
- WRITE(6,9013) LRECL
- 9013 FORMAT(' CDMAKE. record length set to ',I6,' words ')
- ENDIF
-*
- CALL CDNEW(LUNCD,'HEPDB',CHFILE(1:LFILE),IDIV,
- + NPAIR,NQUO,NPRE,NTOP,LRECL,'F',IRC)
-*
-* Set the log level
-*
- CALL CDLOGL(' ',3,'A',IRC)
-*
-* Terminate
-*
- CALL CDEND(' ','A',IRC)
-
- END
diff --git a/src/packlib/hepdb/programs/cdmove/Imakefile b/src/packlib/hepdb/programs/cdmove/Imakefile
deleted file mode 100644
index 53e89c2..0000000
--- a/src/packlib/hepdb/programs/cdmove/Imakefile
+++ /dev/null
@@ -1,9 +0,0 @@
-SRCS_F= cdmove.F
-
-#ifdef CERNLIB_VAXVMS
-NeedTcpipLib
-#endif
-
-CernlibFortranProgramTarget(cdmove,$(OBJS),NullParameter,NullParameter,packlib)
-
-InstallProgram(cdmove,$(CERN_BINDIR))
diff --git a/src/packlib/hepdb/programs/cdmove/cdmove.F b/src/packlib/hepdb/programs/cdmove/cdmove.F
deleted file mode 100644
index 714de0e..0000000
--- a/src/packlib/hepdb/programs/cdmove/cdmove.F
+++ /dev/null
@@ -1,930 +0,0 @@
-*
-* $Id: cdmove.F,v 1.4 1996/04/12 09:42:25 cernlib Exp $
-*
-* $Log: cdmove.F,v $
-* Revision 1.4 1996/04/12 09:42:25 cernlib
-* New handling of title
-*
-* Revision 1.3 1996/03/29 11:18:20 jamie
-* qftitlch
-*
-* Revision 1.2 1996/03/12 13:07:39 cernlib
-* Build hepdb programs: hepdb, cdserv, cdnew, and cdmove
-*
-* Revision 1.1.1.1 1996/02/28 16:23:34 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- PROGRAM CDMOVE
-*******************************************************************************
-* *
-* #### ##### # # #### # # ###### *
-* # # # # ## ## # # # # # *
-* # # # # ## # # # # # ##### *
-* # # # # # # # # # # *
-* # # # # # # # # # # # *
-* #### ##### # # #### ## ###### *
-* *
-*******************************************************************************
-* *
-* Send HEPDB journal files to slave servers *
-* This version is for VM, Unix and VAX/VMS systems only *
-* (MVS version requires XZLLS, GETENVF) *
-* Can be used to transfer updates to MAXSRV remote machines *
-* Updates can be for different groups. *
-* *
-*******************************************************************************
-
- PARAMETER (MAXFIL=1000)
- PARAMETER (MAXSRV=50)
- PARAMETER (MAXGRP=50)
- PARAMETER (IPRINT=6)
- PARAMETER (LUNI=1)
- PARAMETER (LUNO=2)
- PARAMETER (LUNN=3)
- COMMON/PAWC/PAW(50000)
-#include "hepdb/cduscm.inc"
-#include "hepdb/slate.inc"
-#include "zebra/quest.inc"
- COMMON/CZSOCK/LUNCZ,IADTCP,LBUF,ISKIN,ISKOUT,IPROT
- CHARACTER*255 FILES(MAXFIL),CHFILE,CHPATT,CHDIR
- CHARACTER*20 CHIN(2,10)
- CHARACTER*255 CHOUT(2,20)
- CHARACTER*255 CHSERV,CHLIST,CHSTOP
- CHARACTER*255 CHPATH(MAXSRV)
- CHARACTER*255 GENAM,REMDIR,REMFIL,LOCFIL,TODO
- CHARACTER*20 CHTEMP
- CHARACTER*80 CHMAIL
- CHARACTER*8 CHWAKE,CHLOGL,USER,CHHOST,CHTYPE,CHSYS
- CHARACTER*8 GROUP
- CHARACTER*8 CHGRP (MAXGRP)
- CHARACTER*20 CHNAME(MAXSRV)
- CHARACTER*20 CHUSER(MAXSRV)
-* Increase to 80 for node names like hpikf1_f.ikf.physik.uni-frankfurt.de
- CHARACTER*80 CHNODE(MAXSRV)
- CHARACTER*20 CHPROT(MAXSRV)
- CHARACTER*20 CHRECV(MAXSRV)
- CHARACTER*20 CHPOLL(MAXSRV)
- CHARACTER*80 CHQUED(MAXSRV)
- CHARACTER*80 CHLQUE(MAXSRV)
- CHARACTER*80 CHRQUE(MAXSRV)
- CHARACTER*2 PREFIX
- CHARACTER*1 CHMODE,CHOPT
- DIMENSION LGRP (MAXGRP)
- DIMENSION LPATH(MAXSRV),LNAME(MAXSRV),LUSER(MAXSRV),
- + LNODE(MAXSRV),LPROT(MAXSRV),LPOLL(MAXSRV),
- + LRECV(MAXSRV),LQUED(MAXSRV),LLQUE(MAXSRV),
- + LRQUE(MAXSRV)
- LOGICAL IEXIST,IOPEN
-#include "hepdb/qftitlch.inc"
- CHARACTER VIDQQ*(*)
- PARAMETER (VIDQQ = '@(#)' //
- + HepdbTitleFortranString
- + // '>')
- CALL CLEFT (VIDQQ,1,0)
-
- LPRTCD = IPRINT
-#if defined(CERNLIB_VAXVMS)
- OPEN(LPRTCD,FILE='SYS$OUTPUT',RECL=512,STATUS='UNKNOWN',
- + FORM='FORMATTED',ACCESS='SEQUENTIAL')
-#endif
-*
-* Initialise ZEBRA
-*
- CALL HLIMIT(50000)
-*
-* Print version number
-*
- CALL CDVERS(' ',' ','P')
-*
-* Get host name
-*
- CALL CDHOST(CHHOST,IRC)
- LHOST = LENOCC(CHHOST)
- CALL CLTOU(CHHOST(1:LHOST))
-*
-* Get list of users to process
-*
- CALL GETENVF('CDGROUPS',CHLIST)
- LLIST = IS(1)
- IF(LLIST.EQ.0) THEN
- NUSERS = 1
-*
-* Get our name
-*
- CALL GETENVF('CDGRP',CHGRP(1))
- LGRP(1) = IS(1)
- IF(IS(1).EQ.0) THEN
- CALL CDUSER(CHGRP(1),IRC)
- LGRP(1) = LENOCC(CHGRP(1))
- ENDIF
- CALL CLTOU(CHGRP(1)(1:LGRP(1)))
- ELSE
- CALL CLTOU(CHLIST(1:LLIST))
- CALL CDNWRD(',',CHLIST(1:LLIST),NUSERS)
- DO 10 I=1,NUSERS
- CALL CDWORD(CHGRP(I),I-1,',',CHLIST(1:LLIST),IRC)
- LGRP(I) = LENOCC(CHGRP(I))
- 10 CONTINUE
- ENDIF
-*
-* Get stop file
-*
- CALL GETENVF('CDSTOP',CHSTOP)
- LSTOP = IS(1)
-*
-* Initialise counters
-*
- NSENT = 0
- NGOT = 0
-*
-* Get the log level
-*
- CALL GETENVF('CDLOGL',CHLOGL)
- IF(IS(1).GT.0) THEN
- IDEBCD = ICDECI(CHLOGL,1,8)
- ELSE
- IDEBCD = 0
- ENDIF
-
- IF(IDEBCD.GT.0) THEN
- CHOPT = 'S'
- ELSE
- CHOPT = ' '
- ENDIF
-*
-* Get the wakeup interval
-*
- CALL GETENVF('CDWAKEUP',CHWAKE)
- IF(IS(1).GT.0) THEN
- ISLEEP = ICDECI(CHWAKE,1,8)
- ELSE
- ISLEEP = 60
- ENDIF
-*
-* Initialise XZ
-*
- CALL XZINIT(IPRINT,IDEBCD,LUNI,LUNO)
-
- 20 CONTINUE
-
- DO 130 N=1,NUSERS
-
- IF(IDEBCD.GE.0) WRITE(LPRTCD,9001) CHGRP(N)(1:LGRP(N))
- 9001 FORMAT(/,' CDMOVE. processing group ',A)
-
- IF(CHGRP(N)(1:2).EQ.'CD') THEN
- GROUP = CHGRP(N)(1:LGRP(N))
- LGROUP = LGRP(N)
- ELSE
- GROUP = 'CD'//CHGRP(N)(1:LGRP(N))
- LGROUP = LGRP(N) + 2
- ENDIF
-*
-* Get location of names file
-*
- CALL GETENVF(GROUP(1:LGROUP),CHDIR)
- LDIR = IS(1)
- IF(LDIR.EQ.0) THEN
- CHFILE = 'HEPDB.NAMES'
- ELSE
-#if defined(CERNLIB_IBMMVS)
- CHFILE = CHDIR(1:LDIR)//'.'//
- + 'HEPDB.NAMES'
-#endif
-#if defined(CERNLIB_VAXVMS)
- CHFILE = CHDIR(1:LDIR)//
- + 'HEPDB.NAMES'
-#endif
-#if (defined(CERNLIB_UNIX))&&(!defined(CERNLIB_WINNT))&&(!defined(CERNLIB_MSDOS))
- CHFILE = CHDIR(1:LDIR)//'/'//
- + 'HEPDB.NAMES'
-#endif
-#if defined(CERNLIB_WINNT)
- CHFILE = CHDIR(1:LDIR)//'\\'//
- + 'HEPDB.NAMES'
-#endif
-#if defined(CERNLIB_MSDOS)
- CHFILE = CHDIR(1:LDIR)//'\\'//
- + 'HEPDB.NAM'
-#endif
- ENDIF
- LF = LENOCC(CHFILE)
-#if defined(CERNLIB_UNIX)
- CALL CUTOL(CHFILE(1:LF))
-#endif
-#if defined(CERNLIB_IBMMVS)
-*
-* Override with names files entries
-*
- CHIN(1,1) = ':nick'
- CHIN(2,1) = 'CDMOVE'
-
- CHOUT(1,1) = ':wakeup'
- CHOUT(2,1) = ' '
- CHOUT(1,2) = ':logl'
- CHOUT(2,2) = ' '
-
- NIN = 1
- NOUT = 2
- CALL NAMEFD(LUNN,CHFILE(1:LF),CHIN,NIN,CHOUT,NOUT,IRC)
- IF(IRC.EQ.0) THEN
- LOUT = LENOCC(CHOUT(2,1))
- IF(LOUT.NE.0) ISLEEP = ICDECI(CHOUT(2,1),1,LOUT)
- LOUT = LENOCC(CHOUT(2,2))
- IF(LOUT.NE.0) IDEBCD = ICDECI(CHOUT(2,1),1,LOUT)
- ENDIF
-#endif
-*
-* Get the list of databases for this group
-*
- CHIN(1,1) = ':nick'
- CHIN(2,1) = 'CONFIG'
-
- CHOUT(1,1) = ':servers'
-
- NIN = 1
- NOUT = 1
- LUN = 1
-
- IF(IDEBCD.GE.1) WRITE(LPRTCD,9002) CHFILE(1:LF)
- 9002 FORMAT(' CDMOVE. processing names file ',A)
- CALL NAMEFD(LUNN,CHFILE(1:LF),CHIN,NIN,CHOUT,NOUT,IRC)
- IF(IRC.NE.0) THEN
- WRITE(LPRTCD,9003) IRC
- 9003 FORMAT(' CDMOVE. error from NAMEFD, IRC = ',I10)
- GOTO 140
- ENDIF
-*
-* For each server, get
-* :node
-* :userid
-*
-* :userid gives us the name of the HEPDB group for whom
-* we are working. e.g.
-* :userid.cdcplear
-* We expect an environmental variable/symbol of this
-* name (uppercase), e.g.
-* CDCPLEAR:==DISK$MF:[CDCPLEAR]
-* This has subdirectories [.TOnode], e.g.
-* :node.CPUX04 = [.TOCPUX04] unless overridden by tag :localq
-*
- CHSERV = CHOUT(2,1)
- CALL CSQMBL(CHSERV,1,LEN(CHSERV))
- LCHSERV = LENOCC(CHSERV)
-
- IF(LCHSERV.EQ.0) THEN
- WRITE(LPRTCD,9004) GROUP(1:LGROUP)
- 9004 FORMAT(' CDMOVE. no servers defined for ',A)
- WRITE(LPRTCD,9005)
- 9005 FORMAT(' CDMOVE. The :servers tag for the :nick.config entry',
- + ' must contain a list of all remote servers.')
- IF(NUSERS.EQ.1) THEN
- GOTO 140
- ELSE
- GOTO 130
- ENDIF
- ENDIF
-
- CALL CDNWRD(' ',CHSERV(1:LCHSERV),NSERV)
-
- IF(NSERV.GT.MAXSRV) THEN
- WRITE(LPRTCD,9006) MAXSRV
- 9006 FORMAT(' CDMOVE. cannot process more than ',I6,' servers')
- NSERV = MAXSRV
- ENDIF
-
- DO 30 I=1,NSERV
- CALL CDWORD(CHNAME(I),I-1,' ',CHSERV(1:LCHSERV),IRC)
- IF(IDEBCD.GE.1) WRITE(LPRTCD,9007) CHNAME(I)
- 9007 FORMAT(/,' CDMOVE. processing node ',A)
- CHIN(1,1) = ':nick'
- CHIN(2,1) = CHNAME(I)
-
- CHOUT(1,1) = ':userid'
- CHOUT(2,1) = ' '
- CHOUT(1,2) = ':node'
- CHOUT(2,2) = ' '
- CHOUT(1,3) = ':protocol'
- CHOUT(2,3) = ' '
- CHOUT(1,4) = ':receive'
- CHOUT(2,4) = ' '
- CHOUT(1,5) = ':queue'
- CHOUT(2,5) = ' '
- CHOUT(1,6) = ':localq'
- CHOUT(2,6) = ' '
- CHOUT(1,7) = ':remoteq'
- CHOUT(2,7) = ' '
- CHOUT(1,8) = ':poll'
- CHOUT(2,8) = ' '
-#if defined(CERNLIB_IBMMVS)
- CHOUT(1,9) = ':mvsid'
- CHOUT(2,9) = ' '
-#endif
-
- NIN = 1
-#if defined(CERNLIB_IBMMVS)
- NOUT = 9
-#endif
-#if !defined(CERNLIB_IBMMVS)
- NOUT = 8
-#endif
-
- CALL NAMEFD(LUNN,CHFILE(1:LF),CHIN,NIN,CHOUT,NOUT,IRC)
-
- LUSER(I) = LENOCC(CHOUT(2,1))
- CHUSER(I) = CHOUT(2,1)(1:LUSER(I))
-
- LNODE(I) = LENOCC(CHOUT(2,2))
- CHNODE(I) = CHOUT(2,2)(1:LNODE(I))
-
- LPROT(I) = LENOCC(CHOUT(2,3))
- IF(LPROT(I).EQ.0) THEN
- LPROT(I) = 18
- CHPROT(I) = 'TCP/IP (defaulted)'
- ELSE
- CHPROT(I) = CHOUT(2,3)(1:LPROT(I))
- CALL CLTOU(CHPROT(I)(1:LPROT(I)))
- ENDIF
-
- LRECV(I) = LENOCC(CHOUT(2,4))
- IF(LRECV(I).EQ.0) THEN
- LRECV(I) = 14
- CHRECV(I) = 'NO (defaulted)'
- ELSE
- CHRECV(I) = CHOUT(2,4)(1:LRECV(I))
- CALL CLTOU(CHRECV(I)(1:LRECV(I)))
- ENDIF
-
- LQUED(I) = LENOCC(CHOUT(2,5))
- CHQUED(I) = CHOUT(2,5)(1:LQUED(I))
-
- LLQUE(I) = LENOCC(CHOUT(2,6))
- CHLQUE(I) = CHOUT(2,6)(1:LLQUE(I))
-#if defined(CERNLIB_IBMVM)
- IF(LLQUE(I).EQ.0) THEN
- CHLQUE(I) = 'B'
- LLQUE(I) = 1
- WRITE(LPRTCD,9008)
- 9008 FORMAT(' CDMOVE. local queue defaulted to mode B')
- ENDIF
-#endif
-
- LRQUE(I) = LENOCC(CHOUT(2,7))
- CHRQUE(I) = CHOUT(2,7)(1:LRQUE(I))
-
- LPOLL(I) = LENOCC(CHOUT(2,8))
- IF(LPOLL(I).EQ.0) THEN
- LPOLL(I) = 14
- CHPOLL(I) = 'NO (defaulted)'
- ELSE
- CHPOLL(I) = CHOUT(2,8)(1:LPOLL(I))
- CALL CLTOU(CHPOLL(I)(1:LPOLL(I)))
- ENDIF
-
-#if defined(CERNLIB_IBMMVS)
- LPATH(I) = LENOCC(CHOUT(2,9))
- CHPATH(I) = CHOUT(2,9)(1:LPATH(I))
- CALL CLTOU(CHPATH(I)(1:LPATH(I)))
-#endif
-
- IF(IDEBCD.GE.0) THEN
- WRITE(LPRTCD,*)
- WRITE(LPRTCD,9009) CHUSER(I)(1:LUSER(I))
- 9009 FORMAT(' CDMOVE. remote user : ',A)
- WRITE(LPRTCD,9010) CHNODE(I)(1:LNODE(I))
- 9010 FORMAT(' CDMOVE. remote node : ',A)
- WRITE(LPRTCD,9011) CHPROT(I)(1:LPROT(I))
- 9011 FORMAT(' CDMOVE. protocol : ',A)
- WRITE(LPRTCD,9012) CHRECV(I)(1:LRECV(I))
- 9012 FORMAT(' CDMOVE. receive? : ',A)
-
- IF(LQUED(I).EQ.0) THEN
- WRITE(LPRTCD,9013) '(TODO subdirectory)'
- ELSE
- WRITE(LPRTCD,9013) CHQUED(I)(1:LQUED(I))
- 9013 FORMAT(' CDMOVE. server queue : ',A)
- ENDIF
-
- WRITE(LPRTCD,9014) CHLQUE(I)(1:LLQUE(I))
- 9014 FORMAT(' CDMOVE. local queue : ',A)
-
- IF(LRQUE(I).EQ.0) THEN
- WRITE(LPRTCD,9015) '(QUEUE subdirectory)'
- ELSE
- WRITE(LPRTCD,9015) CHRQUE(I)(1:LRQUE(I))
- 9015 FORMAT(' CDMOVE. remote queue : ',A)
- ENDIF
-
- WRITE(LPRTCD,9016) CHPOLL(I)(1:LPOLL(I))
- 9016 FORMAT(' CDMOVE. poll remote? : ',A)
- ENDIF
-
- IF(CHRECV(I)(1:LRECV(I)).EQ.'YES') THEN
- LRECV(I) = 0
- ELSE
- IF(INDEX(CHPROT(I)(1:LPROT(I)),'BITNET').NE.0) THEN
- IF(IDEBCD.GE.-3) WRITE(LPRTCD,9017)
- 9017 FORMAT(' CDMOVE. receive option invalid for Bitnet nodes')
- LRECV(I) = 0
- ENDIF
- ENDIF
-
- IF(CHPOLL(I)(1:LPOLL(I)).NE.'YES') LPOLL(I) = 0
-
- IF(LPOLL(I).NE.0.AND.LRECV(I).NE.0) THEN
- IF(IDEBCD.GT.-3) WRITE(LPRTCD,9018)
- 9018 FORMAT(' CDMOVE. warning - POLL option implies RECEIVE')
- LRECV(I) = 0
- ENDIF
-
-#if (!defined(CERNLIB_IBMVM))&&(!defined(CERNLIB_SFS))&&(!defined(CERNLIB_IBMMVS))
-*
-* Get the pathname on the local machine where files are located
-*
- CHPATH(I) = ' '
- CHTEMP = CHUSER(I)(1:LUSER(I))
- CALL CLTOU(CHTEMP)
- CALL GETENVF(CHTEMP,CHPATH(I))
- LPATH(I) = IS(1)
-#endif
-#if (!defined(CERNLIB_IBMVM))&&(!defined(CERNLIB_SFS))
- IF(LPATH(I).EQ.0) THEN
- WRITE(LPRTCD,9019) CHUSER(I)(1:LUSER(I))
- 9019 FORMAT(' CDMOVE. error - variable ',A,' is not defined.',
- + ' Updates will not be processed for this server.')
- CHPATH(I) = GROUP
- LPATH(I) = LGROUP
- ELSE
- IF(IDEBCD.GE.0) WRITE(LPRTCD,9020) CHPATH(I)(1:LPATH(I))
- 9020 FORMAT(' CDMOVE. server dir. : ',A)
- ENDIF
-#endif
-
- 30 CONTINUE
-*
-* Now we are ready to go.
-*
- 40 CONTINUE
- DO 120 I=1,NSERV
-*
-* Loop over all remote servers
-#if (!defined(CERNLIB_IBMVM))&&(!defined(CERNLIB_SFS))
-*
-* Skip if local path undefined
-*
- IF(LPATH(I).EQ.0) GOTO 120
-#endif
-*
-* Look for files in local queue
-*
- ICONT = 0
- IF(LLQUE(I).EQ.0) THEN
-#if defined(CERNLIB_VAXVMS)
- CHPATT = CHPATH(I)(1:LPATH(I)-1) // '.TO' // CHNODE(I)
- + (1:LNODE(I)) // CHPATH(I)(LPATH(I):LPATH(I))
- LPATT = LENOCC(CHPATT)
-#endif
-#if (defined(CERNLIB_UNIX))&&(!defined(CERNLIB_WINNT))
- CHPATT = CHPATH(I)(1:LPATH(I)) // '/TO' // CHNODE(I)(1:
- + LNODE(I))
- LPATT = LENOCC(CHPATT)
- CALL CUTOL(CHPATT(1:LPATT))
-#endif
-#if defined(CERNLIB_WINNT)
- CHPATT = CHPATH(I)(1:LPATH(I)) // '\\TO' // CHNODE(I)(1:
- + LNODE(I))
- LPATT = LENOCC(CHPATT)
- CALL CUTOL(CHPATT(1:LPATT))
-#endif
-#if defined(CERNLIB_IBMMVS)
- CHPATT = CHPATH(I)(1:LPATH(I)) // '.TO' // CHNODE(I)(1:
- + LNODE(I))
- LPATT = LENOCC(CHPATT)
-#endif
-#if (defined(CERNLIB_IBMVM))&&(!defined(CERNLIB_SFS))
-*
-* Look for files on the CDLQUE disk
-*
- CHPATT = CHUSER(I)(1:LUSER(I)) // ' ' // CHNODE(I)(1:
- + LNODE(I)) // ' ' //CDLQUE(I)(1:LLQUE(I))
- LPATT = LENOCC(CHPATT)
-#endif
- ELSE
- CHPATT = CHLQUE(I)(1:LLQUE(I))
- LPATT = LLQUE(I)
- ENDIF
-#if !defined(CERNLIB_IBMVM)
-*
-* Look for signal.stop file
-*
- IF(LSTOP.EQ.0) THEN
-
-#endif
-#if defined(CERNLIB_IBMMVS)
- CHSTOP ='/'//CHPATT(1:LPATT)//'.SIGNAL.STOP'
- LSTOP = LPATT + 13
-#endif
-#if (defined(CERNLIB_UNIX))&&(!defined(CERNLIB_WINNT))&&(!defined(CERNLIB_MSDOS))
- CHSTOP = CHPATT(1:LPATT)//'/signal.stop'
- LSTOP = LPATT + 12
-#endif
-#if defined(CERNLIB_WINNT)
- CHSTOP = CHPATT(1:LPATT)//'\\signal.stop'
- LSTOP = LPATT + 12
-#endif
-#if defined(CERNLIB_MSDOS)
- CHSTOP = CHPATT(1:LPATT)//'\\signal.sto'
- LSTOP = LPATT + 11
-#endif
-#if defined(CERNLIB_VAXVMS)
- CHSTOP = CHPATT(1:LPATT)//'SIGNAL.STOP'
- LSTOP = LPATT + 11
-#endif
-#if !defined(CERNLIB_IBMVM)
- ENDIF
- INQUIRE(FILE=CHSTOP(1:LSTOP),EXIST=IEXIST)
- IF(IEXIST) THEN
- PRINT *,'CDMOVE. signal.stop file found - stopping'
- GOTO 140
- ENDIF
-#endif
-
- ICONT = 0
- IOPEN = .FALSE.
- 50 CONTINUE
- CALL XZLLS(CHPATT(1:LPATT),FILES,MAXFIL,NFOUND,ICONT,' ',
- + IRC)
- IF(IDEBCD.GE.1)
- + PRINT *,'CDMOVE. ',NFOUND,' files in ',CHPATT(1:LPATT)
- IF(NFOUND.EQ.0.AND.LPOLL(I).EQ.0) GOTO 120
-*
-* XZLLS sets IRC to -1 if NFOUND>MAXFIL...
-*
- IRC = 0
- NFOUND = MIN(NFOUND,MAXFIL)
-*
-* If we are continuing with an existing node, skip the CZOPEN etc.
-*
- IF(ICONT.NE.0.AND.IOPEN) GOTO 60
-*
- IF(INDEX(CHPROT(I),'BITNET').NE.0) THEN
- IPROT = -1
- ELSEIF(INDEX(CHPROT(I),'MVSJOB').NE.0) THEN
- IPROT = -2
- ELSEIF(INDEX(CHPROT(I),'DECNET').NE.0) THEN
- IPROT = 1
- ELSE
- IPROT = 0
- ENDIF
-*
-* Skip CZOPEN for Bitnet & MVS nodes
-*
- IF(IPROT.LT.0) GOTO 60
-*
-* Open connection to remote node using specified protocol
-* This assumes that we have a correctly configured .netrc
-* file, or the correct PROXY settings for DECnet connections.
-*
- IF(IDEBCD.GE.2) WRITE(LPRTCD,9021) CHNODE(I)(1:LNODE(I))
- 9021 FORMAT(' CDMOVE. connecting to node ',A)
- CALL CZOPEN('zserv',CHNODE(I)(1:LNODE(I)),IRC)
- IF(IRC.NE.0) THEN
- PRINT *,'CDMOVE. cannot connect to ', CHNODE(I)(1:
- + LNODE(I))
- GOTO 120
- ENDIF
-*
-* Get current directory - this will tell us what sort
-* of machine we are talking to...
-*
- CALL XZPWD(REMDIR,IRC)
- LRDIR = LENOCC(REMDIR)
-*
-* Get type of machine
-*
- IVAX = 0
- IF((INDEX(REMDIR(1:LRDIR),']').NE.0).OR. (INDEX(REMDIR(1:
- + LRDIR),'>').NE.0)) IVAX = 1
-
- IF(IDEBCD.GE.2) WRITE(LPRTCD,9022) REMDIR(1:LRDIR)
- 9022 FORMAT(' CDMOVE. remote directory is ',A)
-*
-* If remote queue is not defined, assume that we are
-* in home directory of remote server
-*
- IF(LQUED(I).EQ.0) THEN
- IF(IVAX.EQ.1) THEN
- IF(IDEBCD.GE.1) WRITE(LPRTCD,9023) '[.TODO]'
- CALL XZCD('[.TODO]',IRC)
- ELSE
- IF(IDEBCD.GE.1) WRITE(LPRTCD,9023) 'TODO'
- CALL XZCD('TODO',IRC)
- ENDIF
- ELSE
- IF(IDEBCD.GE.1) WRITE(LPRTCD,9023) CHQUED(I)(1:LQUED(I))
- CALL XZCD(CHQUED(I)(1:LQUED(I)),IRC)
- ENDIF
- 9023 FORMAT(' CDMOVE. setting remote directory to ',A)
-
- IF(IRC.NE.0) THEN
- WRITE(LPRTCD,9024) IRC
- 9024 FORMAT(' CDMOVE. error ',I10,' setting remote directory')
- GOTO 140
- ENDIF
-
- 60 CONTINUE
- IOPEN = .TRUE.
-
- DO 70 J=1,NFOUND
- IBRA = INDEXB(FILES(J),']')
- PREFIX = FILES(J)(IBRA+1:IBRA+2)
-#if (defined(CERNLIB_UNIX))&&(!defined(CERNLIB_WINNT))
- CHFILE = CHPATT(1:LPATT)//'/'//FILES(J)
-#endif
-#if defined(CERNLIB_WINNT)
- CHFILE = CHPATT(1:LPATT)//'\\'//FILES(J)
-#endif
-#if defined(CERNLIB_VAXVMS)||defined(CERNLIB_IBMMVS)
- CHFILE = FILES(J)
-#endif
-*
-* Skip active files
-*
- CALL CLTOU(PREFIX)
- IF(PREFIX.EQ.'ZZ') GOTO 70
-
- LF = LENOCC(CHFILE)
-*
-* Transfer the file
-*
- IF(IPROT.LT.0) THEN
- CALL FABNET(CHFILE(1:LF),CHUSER(I)(1:LUSER(I)),
- + CHNODE(I )(1:LNODE(I)),IPROT,IRC)
- ELSE
- CALL CDUNIQ(REMFIL,IRC)
- LREM = LENOCC(REMFIL)
- IF(IDEBCD.GE.1) WRITE(LPRTCD,9025) CHFILE(1:LF),
- + REMFIL(1:LREM)
- 9025 FORMAT(' CDMOVE. sending ',A,' as ',A)
- CALL XZPUTA(CHFILE(1:LF),REMFIL(1:LREM),CHOPT,IRC)
- IF(IRC.EQ.0) THEN
- NSENT = NSENT + 1
-*
-* Now rename the remote file
-*
- IF(IDEBCD.GE.1) WRITE(LPRTCD,9026) REMFIL(1:LREM),
- + PREFIX//REMFIL(3:LREM)
- 9026 FORMAT(' CDMOVE. renaming ',A,' to ',A)
- CALL XZMV(REMFIL(1:LREM),PREFIX//REMFIL(3:LREM),' '
- + ,IRC)
- ENDIF
- ENDIF
- IF(IRC.NE.0) THEN
- WRITE(LPRTCD,9027) CHFILE(1:LF),CHNODE(I)(1:LNODE(I))
- 9027 FORMAT(' CDMOVE. error transferring ',A,' to ',A)
- ICONT = 0
- GOTO 110
- ENDIF
-*
-* and delete the original if successful
-*
- IF(IDEBCD.GE.1) WRITE(LPRTCD,9028) CHFILE(1:LF)
- 9028 FORMAT(' CDMOVE. deleting ',A)
- CALL XZLRM(CHFILE(1:LF),IRC)
- IF(IRC.NE.0) WRITE(LPRTCD,9029) IRC,CHFILE(1:LF)
- 9029 FORMAT(' CDMOVE. error ',I10,' deleting ',A)
-*
-* any remaining files to process?
-*
- 70 CONTINUE
- IF(ICONT.NE.0) GOTO 50
-*
-* Should we receive any files for us?
-*
- IF(LRECV(I).EQ.0) THEN
- IF(IDEBCD.GE.1) WRITE(LPRTCD,9023) CHRQUE(I)(1:LRQUE(I))
- IF(LRQUE(I).GT.0) THEN
- IF(IDEBCD.GE.1)
- + WRITE(LPRTCD,9023) CHRQUE(I)(1:LRQUE(I))
- CALL XZCD(CHRQUE(I)(1:LRQUE(I)),IRC)
- ELSE
- IF(IVAX.EQ.0) THEN
- IF(IDEBCD.GE.1) WRITE(LPRTCD,9023) '../queue'
- CALL XZCD('../queue',IRC)
- ELSE
- IF(IDEBCD.GE.1) WRITE(LPRTCD,9023) '[-.QUEUE]'
- CALL XZCD('[-.QUEUE]',IRC)
- ENDIF
- ENDIF
- IF(IDEBCD.GE.2) THEN
- CALL XZPWD(REMDIR,IRC)
- LRDIR = LENOCC(REMDIR)
- WRITE(LPRTCD,9030) REMDIR(1:LRDIR)
- 9030 FORMAT(' CDMOVE. remote directory is ',A)
- ENDIF
-*
-* Anything there?
-*
- ICONT = 0
- 80 CONTINUE
- CHPATT = ' '
- CALL XZLS(CHPATT,FILES,MAXFIL,NFOUND,ICONT,' ',IRC)
- IF(IRC.NE.0.AND.ICONT.EQ.0) THEN
- IF(IDEBCD.GT.-3) WRITE(LPRTCD,9031) IRC
- 9031 FORMAT(' CDMOVE. return code ',I6,' from XZLS')
- NFOUND = 0
- ENDIF
-
- IF(ICONT.NE.0) THEN
- PRINT *,'CDMOVE. too many files - excess names '//
- + 'will be flushed'
-*
- 90 CONTINUE
- CALL CZGETA(CHMAIL,ISTAT)
- LCH = LENOCC(CHMAIL)
- IF(CHMAIL(1:1).EQ.'0') THEN
- ELSEIF(CHMAIL(1:1).EQ.'1') THEN
- ELSEIF(CHMAIL(1:1).EQ.'2') THEN
- GOTO 90
- ELSEIF(CHMAIL(1:1).EQ.'3') THEN
- IQUEST(1) = 1
- IRC = 1
- ELSEIF(CHMAIL(1:1).EQ.'E') THEN
- IQUEST(1) = -1
- IRC = -1
- ELSEIF(CHMAIL(1:1).EQ.'V') THEN
- GOTO 90
- ELSE
- IQUEST(1) = 1
- IRC = 1
- ENDIF
-*
- ENDIF
-
- NFOUND = MIN(NFOUND,MAXFIL)
-
- DO 100 J=1,NFOUND
-*
-* Get current file
-*
- CHFILE = FILES(J)
- LF = LENOCC(CHFILE)
- CALL CLTOU(CHFILE(1:LF))
-*
-* Get prefix
-*
- IBRA = INDEXB(FILES(J),']')
- PREFIX = FILES(J)(IBRA+1:IBRA+2)
-*
-* Skip active files
-*
- IF(PREFIX.EQ.'ZZ') GOTO 100
-*
-* Did it come from this node?
-*
- IF(INDEX(CHFILE(1:LF),'_'//CHHOST(1:LHOST)).EQ.0) THEN
-#if (!defined(CERNLIB_IBMVM))&&(!defined(CERNLIB_SFS))
- CALL CDUNIQ(LOCFIL,IRC)
- LLOC = LENOCC(LOCFIL)
-#endif
-#if defined(CERNLIB_VAXVMS)
- CHPATT = CHPATH(I)(1:LPATH(I)-1) // '.TODO' //
- + CHPATH(I)(LPATH(I):LPATH(I))
- LPATT = LENOCC(CHPATT)
-#endif
-#if (defined(CERNLIB_UNIX))&&(!defined(CERNLIB_WINNT))
- CHPATT = CHPATH(I)(1:LPATH(I)) // '/TODO/'
- LPATT = LENOCC(CHPATT)
- CALL CUTOL(CHPATT(1:LPATT))
-#endif
-#if defined(CERNLIB_WINNT)
- CHPATT = CHPATH(I)(1:LPATH(I)) // '\\TODO\\'
- LPATT = LENOCC(CHPATT)
- CALL CUTOL(CHPATT(1:LPATT))
-#endif
-#if defined(CERNLIB_IBMMVS)
- CHPATT = CHPATH(I)(1:LPATH(I)) // '.TODO.'
- LPATT = LENOCC(CHPATT)
-#endif
-#if (defined(CERNLIB_IBMVM))&&(!defined(CERNLIB_SFS))
-*
-* Receive into a temporary file
-*
- CHPATT = CHUSER(I)(1:LUSER(I)) // ' '
- LPATT = LUSER(I) + 1
- LOCFIL = CHNODE(I)(1:LNODE(I)) // ' A3'
- LLOC = LNODE(I) + 3
-#endif
- WRITE(LPRTCD,9032) CHPATT(1:LPATT)//LOCFIL(1:LLOC),
- + CHFILE(1:LF)
- 9032 FORMAT(' CDMOVE. receiving ',A,' from ',A)
- CALL XZGETA(CHPATT(1:LPATT)//LOCFIL(1:LLOC),
- + CHFILE(1 :LF),CHOPT,IRC)
- IF(IRC.NE.0) THEN
- ICONT = 0
- GOTO 110
- ENDIF
- NGOT = NGOT + 1
-#if (!defined(CERNLIB_IBMVM))&&(!defined(CERNLIB_SFS))
-*
-* Now rename the local file
-*
- WRITE(LPRTCD,9026) CHPATT(1:LPATT)//LOCFIL(1:LLOC),
- + CHPATT(1: LPATT)//PREFIX//LOCFIL(3:LLOC)
- CALL XZLMV(CHPATT(1:LPATT)//LOCFIL(1:LLOC),
- + CHPATT(1: LPATT)//PREFIX//LOCFIL(3:LLOC), ' ',IRC)
-#endif
-#if (defined(CERNLIB_IBMVM))&&(!defined(CERNLIB_SFS))
-*
-* Now send it to the local server
-* The server should not send it back if:
-* 1) fromid = gateway
-* 2) fromnode = current node
-*
- IF(IDEBCD.GE.1)
- + WRITE(LPRTCD,9033) CHPATT(1:LPATT)//LOCFIL(1:LLOC),
- + CHUSER(I)(1:LUSER(I)),CHHOST(1:LHOST)
- 9033 FORMAT(' CDMOVE. sending ',A,' to ',A,' at ',A)
- CALL VMCMS('EXEC SENDFILE '// CHPATT(1:LPATT)//
- + LOCFIL(1:LLOC)// ' TO '//CHUSER(I)(1:LUSER(I))//
- + ' AT '//CHHOST(1:LHOST),IRC)
-
-#endif
- ELSE
- IF(IDEBCD.GE.1) WRITE(LPRTCD,9034) CHFILE(1:LF),
- + CHHOST(1:LHOST)
- 9034 FORMAT(' CDMOVE. file ',A,' originated from this node (',A,')')
- ENDIF
-*
-* Delete
-*
- IF(IDEBCD.GE.1) WRITE(LPRTCD,9035) CHFILE(1:LF)
- 9035 FORMAT(' CDMOVE. removing file ',A)
- ISTART = 1
-#if defined(CERNLIB_VAXVMS)
- ISTART = INDEX(CHFILE(1:LF),']')+1
-#endif
- CALL XZRM(CHFILE(ISTART:LF),IRC)
-
- 100 CONTINUE
- IF(ICONT.NE.0) GOTO 80
-
- ENDIF
- 110 CONTINUE
- IF(IPROT.GE.0) THEN
-*
-* Close current connection
-*
- CALL CZCLOS(IRC)
- ENDIF
- 120 CONTINUE
-
- IF(NUSERS.EQ.1) THEN
- IF(IDEBCD.GE.1) THEN
- CALL DATIME(ID,IT)
- WRITE(LPRTCD,9036) ID,IT,ISLEEP
- 9036 FORMAT(' CDMOVE. time is ',I6,1X,I4,' sleeping for ',I6,
- + ' seconds')
- ENDIF
-
- CALL SLEEPF(ISLEEP)
- GOTO 40
- ENDIF
- 130 CONTINUE
-
- IF(IDEBCD.GE.1) THEN
- CALL DATIME(ID,IT)
- WRITE(LPRTCD,9036) ID,IT,ISLEEP
- ENDIF
-
- CALL SLEEPF(ISLEEP)
-*
-* Reprocess names file in case of multiple groups
-*
- GOTO 20
-
- 140 CONTINUE
-
- CALL DATIME(ID,IT)
- WRITE(LPRTCD,9037) NSENT,NGOT,NUSERS
- 9037 FORMAT(' CDMOVE. sent ',I6,' and received ',I6,
- + ' files for ',I6,' servers')
- WRITE(LPRTCD,9038) ID,IT
- 9038 FORMAT(' CDMOVE. stopping at ',I6,1X,I4)
-
-#if defined(CERNLIB_VAXVMS)
-*
-* Dummmies
-*
- CALL CZDUMM
-#endif
- END
-#if defined(CERNLIB_VAXVMS)
- SUBROUTINE CZDUMM
- ENTRY CTL$GL_PCB
- ENTRY CTL$T_ACCOUNT
- ENTRY CTL$T_USERNAME
- END
-#endif
diff --git a/src/packlib/hepdb/programs/cdserv/Imakefile b/src/packlib/hepdb/programs/cdserv/Imakefile
deleted file mode 100644
index 6e1f8a4..0000000
--- a/src/packlib/hepdb/programs/cdserv/Imakefile
+++ /dev/null
@@ -1,6 +0,0 @@
-SRCS_F= abend.F cdback.F cdbad.F cdconf.F cddelf.F cdload.F \ @@\
- cdlogf.F cdsend.F cdserv.F cdstop.F cdtrap.F cdwake.F
-
-CernlibFortranProgramTarget(cdserv,$(OBJS),NullParameter,NullParameter,packlib)
-
-InstallProgram(cdserv,$(CERN_BINDIR))
diff --git a/src/packlib/hepdb/programs/cdserv/abend.F b/src/packlib/hepdb/programs/cdserv/abend.F
deleted file mode 100644
index 24c2723..0000000
--- a/src/packlib/hepdb/programs/cdserv/abend.F
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: abend.F,v 1.2 1996/03/12 13:07:49 cernlib Exp $
-*
-* $Log: abend.F,v $
-* Revision 1.2 1996/03/12 13:07:49 cernlib
-* Build hepdb programs: hepdb, cdserv, cdnew, and cdmove
-*
-* Revision 1.1.1.1 1996/02/28 16:23:35 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE ABEND
- INTEGER SYSTEMF
-
- PRINT *,'ABEND. call for CDSERV'
-
-#if defined(CERNLIB_UNIX)
- PRINT *,'ABEND. calling CDABEND script'
- IC = SYSTEMF('cdabend')
-#endif
-#if defined(CERNLIB_VAXVMS)
- PRINT *,'ABEND. calling CDABEND command file'
- IC = SYSTEMF('@CDABEND')
-#endif
-#if defined(CERNLIB_IBMVM)
- PRINT *,'ABEND. calling CDABEND exec'
- IC = SYSTEMF('EXEC CDABEND')
-#endif
-
- END
diff --git a/src/packlib/hepdb/programs/cdserv/cdback.F b/src/packlib/hepdb/programs/cdserv/cdback.F
deleted file mode 100644
index e7804be..0000000
--- a/src/packlib/hepdb/programs/cdserv/cdback.F
+++ /dev/null
@@ -1,73 +0,0 @@
-*
-* $Id: cdback.F,v 1.2 1996/03/12 13:07:52 cernlib Exp $
-*
-* $Log: cdback.F,v $
-* Revision 1.2 1996/03/12 13:07:52 cernlib
-* Build hepdb programs: hepdb, cdserv, cdnew, and cdmove
-*
-* Revision 1.1.1.1 1996/02/28 16:23:35 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDBACK(CHFILE,IDB,IRC)
- CHARACTER*(*) CHFILE
- CHARACTER*255 SOURCE,TARGET
- CHARACTER*64 CHNAME
-#include "hepdb/cduscm.inc"
-#include "hepdb/cdnamc.inc"
- INTEGER SYSTEMF
-
- IRC = 0
-*
-* Copy update file to backup directory
-*
- LFILE = LENOCC(CHFILE)
- SOURCE = CHFILE(1:LFILE)
- LSRCE = LFILE
-#if defined(CERNLIB_UNIX)
- LSLASH = INDEXB(CHFILE(1:LFILE),'/')
- CHNAME = CHFILE(LSLASH+1:LFILE)
- CHNAME(1:2) = CDPRFX(IDB)
- TARGET = CDSAVD(1:LSAVD) // '/' // CHNAME
- LTARGT = LSAVD + LFILE - LSLASH + 1
- CALL CUTOL(TARGET(1:LTARGT))
- IF(IDEBCD.GE.1) WRITE(LPRTCD,9001) SOURCE(1:LSRCE),
- + TARGET(1:LTARGT)
- IRC = SYSTEMF('mv '//SOURCE(1:LSRCE)//' '//TARGET(1:LTARGT))
-#endif
-#if defined(CERNLIB_VAXVMS)
- LSQBRA = INDEXB(CHFILE(1:LFILE),']')
- CHNAME = CHFILE(LSQBRA+1:LFILE)
- CHNAME(1:2) = CDPRFX(IDB)
- TARGET = CDSAVD(1:LSAVD) // CHNAME
- LTARGT = LSAVD + LFILE - LSQBRA
- IF(IDEBCD.GE.1) WRITE(LPRTCD,9001) SOURCE(1:LSRCE),
- + TARGET(1:LTARGT)
- IC = LIB$RENAME_FILE(SOURCE(1:LSRCE),TARGET(1:LTARGT),,,,,,,,,,)
- IF(.NOT.IC) THEN
- IRC = -1
- ELSE
- IRC = 0
- ENDIF
-
-#endif
-#if defined(CERNLIB_IBMVM)
- LBLANK = INDEXB(SOURCE(1:LSRCE),' ')
- TARGET = SOURCE(1:LBLANK) // CDSAVD(1:LSAVD)
- TARGET(1:2) = CDPRFX(IDB)
- LTARGT = LENOCC(TARGET)
- IF(LSAVD.EQ.1) THEN
- LTARGT = LTARGT + 1
- TARGET(LTARGT:LTARGT) = '1'
- ENDIF
- IF(IDEBCD.GE.1) WRITE(LPRTCD,9001) SOURCE(1:LSRCE),
- + TARGET(1:LTARGT)
-* CALL VMCMS('COPYFILE '//SOURCE(1:LSRCE)//' '//TARGET(1:LTARGT),
-* + IRC)
-* CALL VMCMS('ERASE '//SOURCE(1:LSRCE),IRC)
- CALL VMCMS('EXEC CDJOURN '//SOURCE(1:LSRCE)
- + //' '//TARGET(1:LTARGT),IRC)
-#endif
-9001 FORMAT(' CDBACK. renaming ',A,' to ',/,18X,A)
- END
diff --git a/src/packlib/hepdb/programs/cdserv/cdbad.F b/src/packlib/hepdb/programs/cdserv/cdbad.F
deleted file mode 100644
index aa2368c..0000000
--- a/src/packlib/hepdb/programs/cdserv/cdbad.F
+++ /dev/null
@@ -1,68 +0,0 @@
-*
-* $Id: cdbad.F,v 1.2 1996/03/12 13:07:54 cernlib Exp $
-*
-* $Log: cdbad.F,v $
-* Revision 1.2 1996/03/12 13:07:54 cernlib
-* Build hepdb programs: hepdb, cdserv, cdnew, and cdmove
-*
-* Revision 1.1.1.1 1996/02/28 16:23:35 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDBAD(CHFILE,IRC)
- CHARACTER*(*) CHFILE
- CHARACTER*255 SOURCE,TARGET
- CHARACTER*64 CHNAME
-#include "hepdb/cdnamc.inc"
-#include "hepdb/cduscm.inc"
- INTEGER SYSTEMF
-
- IRC = 0
-*
-* Move file to 'bad' directory
-*
- LFILE = LENOCC(CHFILE)
- SOURCE = CHFILE(1:LFILE)
- LSRCE = LFILE
-#if defined(CERNLIB_UNIX)
- LSLASH = INDEXB(CHFILE(1:LFILE),'/')
- CHNAME = CHFILE(LSLASH+1:LFILE)
- TARGET = CDBADD(1:LBADD) // '/' // CHNAME
- LTARGT = LBADD + LFILE - LSLASH + 1
- CALL CUTOL(TARGET(1:LTARGT))
- IF(IDEBCD.GE.1) WRITE(LPRTCD,9001) SOURCE(1:LSRCE),
- + TARGET(1:LTARGT)
- IC = SYSTEMF('mv '//SOURCE(1:LSRCE)//' '//TARGET(1:LTARGT))
-#endif
-#if defined(CERNLIB_VAXVMS)
- LSQBRA = INDEXB(CHFILE(1:LFILE),']')
- CHNAME = CHFILE(LSQBRA+1:LFILE)
- TARGET = CDBADD(1:LBADD) // CHNAME
- LTARGT = LBADD + LFILE - LSQBRA
- IF(IDEBCD.GE.1) WRITE(LPRTCD,9001) SOURCE(1:LSRCE),
- + TARGET(1:LTARGT)
- IC = LIB$RENAME_FILE(SOURCE(1:LSRCE),TARGET(1:LTARGT),,,,,,,,,,)
- IF(.NOT.IC) THEN
- IRC = -1
- ELSE
- IRC = 0
- ENDIF
-
-#endif
-#if defined(CERNLIB_IBMVM)
- LBLANK = INDEXB(SOURCE(1:LSRCE),' ')
- TARGET = SOURCE(1:LBLANK) // CDBADD(1:LBADD)
- LTARGT = LENOCC(TARGET)
- IF(LBADD.EQ.1) THEN
- LTARGT = LTARGT + 1
- TARGET(LTARGT:LTARGT) = '1'
- ENDIF
- IF(IDEBCD.GE.1) WRITE(LPRTCD,9001) SOURCE(1:LSRCE),
- + TARGET(1:LTARGT)
- CALL VMCMS('COPYFILE '//SOURCE(1:LSRCE)//' '//TARGET(1:LTARGT),
- + IRC)
- CALL VMCMS('ERASE '//SOURCE(1:LSRCE),IRC)
-#endif
-9001 FORMAT(' CDBAD. renaming ',A,' to ',/,17X,A)
- END
diff --git a/src/packlib/hepdb/programs/cdserv/cdconf.F b/src/packlib/hepdb/programs/cdserv/cdconf.F
deleted file mode 100644
index dc49888..0000000
--- a/src/packlib/hepdb/programs/cdserv/cdconf.F
+++ /dev/null
@@ -1,249 +0,0 @@
-*
-* $Id: cdconf.F,v 1.2 1996/03/12 13:07:56 cernlib Exp $
-*
-* $Log: cdconf.F,v $
-* Revision 1.2 1996/03/12 13:07:56 cernlib
-* Build hepdb programs: hepdb, cdserv, cdnew, and cdmove
-*
-* Revision 1.1.1.1 1996/02/28 16:23:35 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDCONF(LUNNF,CHFILE,ILOGLV,IWAKE,IRC)
- CHARACTER*(*) CHFILE
- CHARACTER*20 CHIN(2,10)
- CHARACTER*255 CHOUT(2,20)
- CHARACTER*255 CHPREF,CHSERV,CHTEMP
-#if defined(CERNLIB_VAXVMS)
- INCLUDE '($RMSDEF)'
-#endif
-#if defined(CERNLIB_UNIX)
- LOGICAL IEXIST
-#endif
-#include "hepdb/cdnamc.inc"
-#include "hepdb/cduscm.inc"
-*
-* Read configuration file
-*
- IRC = 0
- LF = LENOCC(CHFILE)
- NIN = 1
- NOUT = 8
-*
-* Get list of databases, queue directory, log directory
-*
- CHIN(1,1) = ':nick'
- CHIN(2,1) = 'config'
-
- CHOUT(1,1) = ':list'
- CHOUT(2,1) = ' '
-
- CHOUT(1,2) = ':log'
- CHOUT(2,2) = ' '
-
- CHOUT(1,3) = ':todo'
- CHOUT(2,3) = ' '
-
- CHOUT(1,4) = ':queue'
- CHOUT(2,4) = ' '
-
- CHOUT(1,5) = ':save'
- CHOUT(2,5) = ' '
-
- CHOUT(1,6) = ':bad'
- CHOUT(2,6) = ' '
-
- CHOUT(1,7) = ':loglevel'
- CHOUT(2,7) = ' '
-
- CHOUT(1,8) = ':wakeup'
- CHOUT(2,8) = ' '
-
- CALL NAMEFD(LUNNF,CHFILE(1:LF),CHIN,NIN,CHOUT,NOUT,IRC)
- IF(IRC.NE.0) THEN
- WRITE(LPRTCD,9001) IRC,CHFILE(1:LF)
- 9001 FORMAT(' CDCONF. error ',I6,' processing names file ',A)
- WRITE(LPRTCD,9002)
- 9002 FORMAT(' CDCONF. check that names file is correctly configured')
- WRITE(LPRTCD,9003)
- 9003 FORMAT(' CDCONF. the following tags must be specified:')
- DO 10 I=1,8
- WRITE(LPRTCD,9004) CHOUT(1,I)(1:LENOCC(CHOUT(1,I)))
- 9004 FORMAT(1X,A)
- 10 CONTINUE
- RETURN
- ENDIF
-*
-* Directories
-*
- CDLOGD = CHOUT(2,2)
- LLOGD = LENOCC(CDLOGD)
- CDTODO = CHOUT(2,3)
- LTODO = LENOCC(CDTODO)
- CDQUED = CHOUT(2,4)
- LQUED = LENOCC(CDQUED)
- CDSAVD = CHOUT(2,5)
- LSAVD = LENOCC(CDSAVD)
- CDBADD = CHOUT(2,6)
- LBADD = LENOCC(CDBADD)
-#if defined(CERNLIB_IBMVM)
- CALL CLTOU(CDSAVD(1:LSAVD))
- CALL CLTOU(CDBADD(1:LBADD))
-#endif
-*
-* Loglevel
-*
- ILOGLV = ICDECI(CHOUT(2,7),1,LEN(CHOUT(2,7)))
-*
-* Wakeup interval in seconds
-*
- IWAKE = ICDECI(CHOUT(2,8),1,LEN(CHOUT(2,8)))
- IF(IWAKE.LE.0) THEN
- WRITE(LPRTCD,9005) IWAKE
- 9005 FORMAT(' CDCONF. illegal wakeup interval of ',I6,
- + ' seconds specified. Using default of 60')
- IWAKE = 60
- ENDIF
-*
-* List of database prefixes
-*
- CHPREF = CHOUT(2,1)
- LPREF = LENOCC(CHPREF)
-#if defined(CERNLIB__DEBUG)
- WRITE(LPRTCD,9006) ILOGLV
- 9006 FORMAT(' CDCONF. loglevel : ',I6)
- WRITE(LPRTCD,9007) IWAKE
- 9007 FORMAT(' CDCONF. wakeup interval: ',I6)
- WRITE(LPRTCD,9008) CDLOGD(1:LLOGD)
- 9008 FORMAT(' CDCONF. log directory : ',A)
- WRITE(LPRTCD,9009) CDQUED(1:LQUED)
- 9009 FORMAT(' CDCONF. queue directory: ',A,' (client)')
- WRITE(LPRTCD,9010) CDTODO(1:LTODO)
- 9010 FORMAT(' CDCONF. input directory: ',A,' (server)')
- IF(CDQUED(1:LQUED).EQ.CDTODO(1:LTODO)) THEN
- WRITE(LPRTCD,9011)
- MASTER = .TRUE.
- ELSE
- WRITE(LPRTCD,9012)
- MASTER = .FALSE.
- ENDIF
- 9011 FORMAT(' CDCONF. client and server directories match -',
- + ' operating as database master')
- 9012 FORMAT(' CDCONF. client and server directories do not match -',
- + ' operating as slave server')
- WRITE(LPRTCD,9013) CDSAVD(1:LSAVD)
- 9013 FORMAT(' CDCONF. save directory : ',A)
- WRITE(LPRTCD,9014) CDBADD(1:LBADD)
- 9014 FORMAT(' CDCONF. bad directory : ',A)
- WRITE(LPRTCD,9015) CHPREF(1:LPREF)
- 9015 FORMAT(' CDCONF. database codes : ',A)
-#endif
-*
-* Process list of database prefixes
-*
- CALL CDNWRD(' ',CHPREF,NWORDS)
-*
-* Number of servers
-*
- NFILES = NWORDS
-
- IF(ILOGLV.GE.1) WRITE(LPRTCD,9016) NWORDS
- 9016 FORMAT(' CDCONF. number of databases = ',I6)
-
- DO 40 I=1,NWORDS
-
- CALL CDWORD(CDPRFX(I),I-1,' ',CHPREF,IRC)
- CALL CLTOU(CDPRFX(I))
-*
-* Get the file name and list of servers for this database
-*
- NIN = 1
- NOUT = 2
- CHIN(1,1) = ':nick'
- CHIN(2,1) = CDPRFX(I)
-
- CHOUT(1,1) = ':file'
- CHOUT(2,1) = ' '
-
- CHOUT(1,2) = ':servers'
- CHOUT(2,2) = ' '
-
- CALL NAMEFD(LUNNF,CHFILE(1:LF),CHIN,NIN,CHOUT,NOUT,IRC)
- IF(IRC.NE.0) THEN
- WRITE(LPRTCD,9017) IRC,CHFILE(1:LF),CDPRFX(I)
- 9017 FORMAT(' CDCONF. error ',I6,' processing names file ',A,
- + ' for entry ',A)
- WRITE(LPRTCD,9002)
- WRITE(LPRTCD,9003)
- DO 20 J=1,2
- WRITE(LPRTCD,9004) CHOUT(1,J)(1:LENOCC(CHOUT(1,J)))
- 20 CONTINUE
- RETURN
- ENDIF
-
- CDFILE(I) = CHOUT(2,1)
- LDFILE(I) = LENOCC(CHOUT(2,1))
-
- IF(ILOGLV.GE.1) WRITE(LPRTCD,9018) CDPRFX(I),
- + CDFILE(I)(1:LDFILE(I))
- 9018 FORMAT(' CDCONF. database file for ',A,' is ',A)
-*
-* Process the list of servers and get the local queue directories
-*
- CHSERV = CHOUT(2,2)
- CALL CDNWRD(' ',CHSERV,JWORDS)
- NSERV(I) = JWORDS
-
- IF(ILOGLV.GE.1) WRITE(LPRTCD,9019) JWORDS
- 9019 FORMAT(' CDCONF. number of remote servers = ',I6)
-
- CHIN(1,1) = ':nick'
- CHOUT(1,1) = ':localq'
- CHOUT(2,1) = ' '
- NIN = 1
- NOUT = 1
-
- DO 30 J=1,JWORDS
- CALL CDWORD(CHIN(2,1),J-1,' ',CHSERV,IRC)
- IF(ILOGLV.GE.2) PRINT *,'CDCONF. processing ',CHIN(2,1)
- CALL NAMEFD(LUNNF,CHFILE(1:LF),CHIN,NIN,CHOUT,NOUT,IRC)
- IF(IRC.NE.0) THEN
- WRITE(LPRTCD,9020) IRC,CHFILE(1:LF),CHIN(2,1)
- 9020 FORMAT(' CDCONF. error ',I6,' processing names file ',A,
- + ' for entry ',A)
- WRITE(LPRTCD,9021)
- 9021 FORMAT(' CDCONF. is there a :LOCALQ tag for this entry?')
- RETURN
- ENDIF
- CDREMQ(I,J) = CHOUT(2,1)
- LREMQ (I,J) = LENOCC(CHOUT(2,1))
- IF(ILOGLV.GE.2) WRITE(LPRTCD,9022) CHIN(2,1),
- + CDREMQ(I,J)(1:LREMQ(I,J))
- 9022 FORMAT(' CDCONF. local q for ',A,' is ',A)
-*
-* Make queue directories if they don't exist
-*
-#if defined(CERNLIB_VAXVMS)
- ISTAT = LIB$FIND_FILE(CDREMQ(I,J)(1:LREMQ(I,J)),CHTEMP,
- + JCONT)
- IF(ISTAT.EQ.RMS$_DNF) THEN
- IF(ILOGLV.GE.0) WRITE(LPRTCD,9023) CHIN(2,1), CDREMQ(I,
- + J)(1:LREMQ(I,J))
- ISTAT = LIB$CREATE_DIR(CDREMQ(I,J)(1:LREMQ(I,J)),,,,,)
- IF(.NOT.ISTAT) CALL LIB$SIGNAL(%VAL(ISTAT))
- ENDIF
- ISTAT = LIB$FIND_FILE_END(JCONT)
-#endif
-#if defined(CERNLIB_UNIX)
- INQUIRE(FILE=CDREMQ(I,J)(1:LREMQ(I,J)),EXIST=IEXIST)
- IF(.NOT.IEXIST) THEN
- IF(ILOGLV.GE.0) WRITE(LPRTCD,9023) CHIN(2,1), CDREMQ(I,
- + J)(1:LREMQ(I,J))
- ISTAT = SYSTEMF('mkdir '//CDREMQ(I,J)(1:LREMQ(I,J)))
- ENDIF
-#endif
- 9023 FORMAT(' CDCONF. creating local q for ',A,' (',A,')')
- 30 CONTINUE
- 40 CONTINUE
- END
diff --git a/src/packlib/hepdb/programs/cdserv/cddelf.F b/src/packlib/hepdb/programs/cdserv/cddelf.F
deleted file mode 100644
index 3df8fcc..0000000
--- a/src/packlib/hepdb/programs/cdserv/cddelf.F
+++ /dev/null
@@ -1,36 +0,0 @@
-*
-* $Id: cddelf.F,v 1.2 1996/03/12 13:07:58 cernlib Exp $
-*
-* $Log: cddelf.F,v $
-* Revision 1.2 1996/03/12 13:07:58 cernlib
-* Build hepdb programs: hepdb, cdserv, cdnew, and cdmove
-*
-* Revision 1.1.1.1 1996/02/28 16:23:36 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDDELF(CHFILE,IRC)
- CHARACTER*(*) CHFILE
- CHARACTER*255 CHNAME
- INTEGER SYSTEMF
-#include "hepdb/cduscm.inc"
-
- IRC = 0
- LNAME = LENOCC(CHFILE)
- CHNAME = CHFILE(1:LNAME)
- IF(IDEBCD.GE.1) WRITE(LPRTCD,9001) CHNAME(1:LNAME)
-9001 FORMAT(' CDDELF. deleting ',A)
-
-#if defined(CERNLIB_UNIX)
- IRC = SYSTEMF('rm -f '//CHNAME(1:LNAME))
-#endif
-#if defined(CERNLIB_VAXVMS)
- ICODE = LIB$DELETE_FILE(CHNAME(1:LNAME))
- IF(.NOT.ICODE) IRC = 42
-#endif
-#if defined(CERNLIB_IBMVM)
- CALL VMCMS('ERASE '//CHNAME(1:LNAME),IRC)
-#endif
-
- END
diff --git a/src/packlib/hepdb/programs/cdserv/cdload.F b/src/packlib/hepdb/programs/cdserv/cdload.F
deleted file mode 100644
index 3242f5b..0000000
--- a/src/packlib/hepdb/programs/cdserv/cdload.F
+++ /dev/null
@@ -1,73 +0,0 @@
-*
-* $Id: cdload.F,v 1.2 1996/03/12 13:08:00 cernlib Exp $
-*
-* $Log: cdload.F,v $
-* Revision 1.2 1996/03/12 13:08:00 cernlib
-* Build hepdb programs: hepdb, cdserv, cdnew, and cdmove
-*
-* Revision 1.1.1.1 1996/02/28 16:23:35 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDLOAD(LUNFZ,CHFILE,IRC)
-
- CHARACTER*(*) CHFILE
-#include "hepdb/cdnamc.inc"
-#include "hepdb/quest.inc"
- CHARACTER*132 TEXT
-*-----------------------------------------------------------------------
-*
- LFILE = LENOCC(CHFILE)
-#if defined(CERNLIB_VAXVMS)
- ISTART = INDEXB(CHFILE(1:LFILE),']')+1
-#endif
-#if !defined(CERNLIB_VAXVMS)
- ISTART = 1
-#endif
-#if !defined(CERNLIB_IBMVM)
- OPEN(LUNFZ,IOSTAT=ISTAT,FILE=CHFILE(1:LFILE),FORM='FORMATTED',
- + STATUS='OLD')
-#endif
-#if defined(CERNLIB_IBMVM)
- OPEN(LUNFZ,IOSTAT=ISTAT,FILE='/'//CHFILE(1:LFILE),
- + STATUS='OLD',FORM='FORMATTED')
-#endif
- IF(ISTAT.NE.0) THEN
- IRC = ISTAT
- WRITE (TEXT,9001) CHFILE(ISTART:LFILE), ISTAT
- CALL CDLOGF (-1,TEXT)
- RETURN
- ELSE
- CALL FZFILE (LUNFZ, 0, 'AIP')
- IF ( IQUEST(1) .NE. 0 ) THEN
- IRC = IQUEST(1)
- WRITE (TEXT,9002) CHFILE(ISTART:LFILE), IRC
- CALL CDLOGF (-2,TEXT)
- ELSE
- WRITE (TEXT,9003) CHFILE(ISTART:LFILE)
-#if defined(CERNLIB__DEBUG)
- CALL CDLOGF (0,TEXT)
-#endif
- PRINT *,' Loading the file ',CHFILE(1:LFILE)
- CALL CDFZUP(LUNFZ,'F',IRC)
- IF(IRC.EQ.0) THEN
- IRC = 0
- WRITE (TEXT,9004) CHFILE(ISTART:LFILE)
- CALL CDLOGF (0,TEXT)
- ELSE
- WRITE (TEXT,9005) CHFILE(ISTART:LFILE), IRC
- CALL CDLOGF (-11,TEXT)
- ENDIF
- CALL FZENDI(LUNFZ,'T')
- ENDIF
- ENDIF
-
- CLOSE(LUNFZ)
-
- 9001 FORMAT (' Error opening journal file: ',A,'. IOSTAT=',I7)
- 9002 FORMAT (' Error at FZFILE of ',A,'. IQUEST (1)=',I7)
- 9003 FORMAT (' Opened the file: ',A)
- 9004 FORMAT (' Loaded the file: ',A)
- 9005 FORMAT (' Error loading the file: ',A,'. IRC=',I7)
- END
diff --git a/src/packlib/hepdb/programs/cdserv/cdlogf.F b/src/packlib/hepdb/programs/cdserv/cdlogf.F
deleted file mode 100644
index 4f7ebce..0000000
--- a/src/packlib/hepdb/programs/cdserv/cdlogf.F
+++ /dev/null
@@ -1,83 +0,0 @@
-*
-* $Id: cdlogf.F,v 1.2 1996/03/12 13:08:02 cernlib Exp $
-*
-* $Log: cdlogf.F,v $
-* Revision 1.2 1996/03/12 13:08:02 cernlib
-* Build hepdb programs: hepdb, cdserv, cdnew, and cdmove
-*
-* Revision 1.1.1.1 1996/02/28 16:23:35 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDLOGF(ICODE,TEXT)
- CHARACTER*(*) TEXT
-#include "hepdb/cdnamc.inc"
-#include "hepdb/slate.inc"
- CHARACTER*10 CHACC
- PARAMETER (LUNLG=3)
- DATA NENTRY/0/
- SAVE NENTRY,IOPLOG
-
- LTEXT = LENOCC(TEXT)
- IF (IOPLOG.EQ.0) THEN
- IERR = 0
- CHACC = 'APPEND'
-#if defined(CERNLIB_IBMVM)
- 10 OPEN(UNIT=LUNLG,STATUS='UNKNOWN',IOSTAT=ISTAT,
- + FORM='FORMATTED',FILE='/HEPDB LOG '//CDLOGD(1:LLOGD))
-#endif
-#if defined(CERNLIB_APOLLO)
- 10 OPEN(UNIT=LUNLG,STATUS='APPEND',IOSTAT=ISTAT,
-#endif
-#if defined(CERNLIB_VAXVMS)
- 10 OPEN(UNIT=LUNLG,ACCESS=CHACC,IOSTAT=ISTAT,STATUS='UNKNOWN',
- + SHARED,
- + FORM='FORMATTED',FILE=CDLOGD(1:LLOGD)//'hepdb.log')
-#endif
-#if (defined(CERNLIB_UNIX))&&(!defined(CERNLIB_APOLLO))
- 10 OPEN(UNIT=LUNLG,STATUS='UNKNOWN',IOSTAT=ISTAT,
-#endif
-#if defined(CERNLIB_UNIX)
- + FORM='FORMATTED',FILE=CDLOGD(1:LLOGD)//'/hepdb.log')
-#endif
- IF(ISTAT.NE.0) THEN
- IC = SLEEPF(1)
- IERR = IERR + 1
- IF(IERR.GT.10) THEN
- CALL DATIME(ID,IT)
- PRINT 9003,ICODE,(IS(I),I=1,6),TEXT(1:LTEXT)
- STOP 'Stop because the log file is locked'
- ELSE
- GO TO 10
- ENDIF
- ENDIF
- IOPLOG = 1
-#if defined(CERNLIB_VAXVMS)
-*
-* Try a dummy write to trap problem with DEC Fortran 6.1
-*
- IF(CHACC.EQ.'APPEND') THEN
- WRITE (LUNLG,'(A)',IOSTAT=ISTAT)
- IF(ISTAT.NE.0) THEN
- PRINT 9001,ISTAT,LUNLG,CHACC
- 9001 FORMAT(' CDLOGF. error ',I6,' writing to file on unit ',I6,
- + ' using ACCESS=',A)
- PRINT 9002
- 9002 FORMAT(' CDLOGF. switching to ACCESS=SEQUENTIAL')
- CLOSE (LUNLG)
- CHACC = 'SEQUENTIAL'
- GOTO 10
- ENDIF
- ENDIF
-#endif
- ENDIF
- CALL DATIME(ID,IT)
- WRITE (LUNLG,9003) ICODE,(IS(I),I=1,6),TEXT(1:LTEXT)
- IF(TEXT(1:4).EQ.'Stop') THEN
- CLOSE(LUNLG)
- IOPLOG = 0
- ENDIF
- 9003 FORMAT(I4,1X,I4.4,'/',I2.2,'/',I2.2,'/',1X,
- + I2.2,':',I2.2,':',I2.2,1X,A)
- END
diff --git a/src/packlib/hepdb/programs/cdserv/cdsend.F b/src/packlib/hepdb/programs/cdserv/cdsend.F
deleted file mode 100644
index e857a82..0000000
--- a/src/packlib/hepdb/programs/cdserv/cdsend.F
+++ /dev/null
@@ -1,104 +0,0 @@
-*
-* $Id: cdsend.F,v 1.2 1996/03/12 13:08:04 cernlib Exp $
-*
-* $Log: cdsend.F,v $
-* Revision 1.2 1996/03/12 13:08:04 cernlib
-* Build hepdb programs: hepdb, cdserv, cdnew, and cdmove
-*
-* Revision 1.1.1.1 1996/02/28 16:23:35 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDSEND(CHFILE,NDB,IRC)
- CHARACTER*(*) CHFILE
- CHARACTER*255 SOURCE,TARGET,CHTARG
- CHARACTER*64 CHNAME
-#include "hepdb/cduscm.inc"
-#include "hepdb/cdnamc.inc"
-*
-* Copy update file to input queues of all known servers
-*
- IRC = 0
-*
-* Copy update file to remote server directories
-*
- LFILE = LENOCC(CHFILE)
- SOURCE = CHFILE(1:LFILE)
- LSRCE = LFILE
-#if defined(CERNLIB_UNIX)
- LSLASH = INDEXB(CHFILE(1:LFILE),'/')
- CHNAME = CHFILE(LSLASH+1:LFILE)
-#endif
-#if defined(CERNLIB_VAXVMS)
- LSQBRA = INDEXB(CHFILE(1:LFILE),']')
- CHNAME = CHFILE(LSQBRA+1:LFILE)
-#endif
-
- DO 10 I=1,NSERV(NDB)
-#if defined(CERNLIB_UNIX)
- TARGET = CDREMQ(NDB,I)(1:LREMQ(NDB,I)) // '/' // CHNAME
- LTARGT = LREMQ(NDB,I) + LFILE - LSLASH + 1
- CALL CUTOL(TARGET(1:LTARGT))
-*
-* Copy file to target directory
-*
- IF(IDEBCD.GE.1) WRITE(LPRTCD,9001) SOURCE(1:LSRCE),
- + TARGET(1:LTARGT)
- IC = SYSTEMF('cp '//SOURCE(1:LSRCE)//' '//TARGET(1:LTARGT))
-*
-* Set ownership - this is for Multinet UID/GID mapping
-*
- IF(INDEX(TARGET(1:LTARGT),'/tovxcrna/').NE.0)
- + IC = SYSTEMF('chown jamie '//TARGET(1:LTARGT))
-*
-* Now rename
-*
- CHTARG = TARGET(1:LTARGT)
- CHTARG(LREMQ(NDB,I)+2:LREMQ(NDB,I)+3) = CDPRFX(NDB)
- CALL CUTOL(CHTARG(1:LTARGT))
- IF(IDEBCD.GE.1) WRITE(LPRTCD,9002) TARGET(1:LTARGT),
- + CHTARG(1:LTARGT)
- IC = SYSTEMF('mv '//TARGET(1:LTARGT)//' '//CHTARG(1:LTARGT))
-#endif
-#if defined(CERNLIB_VAXVMS)
- TARGET = CDREMQ(NDB,I)(1:LREMQ(NDB,I)) // CHNAME
- LTARGT = LREMQ (NDB,I) + LFILE - LSQBRA
-*
-* Copy file to target directory
-*
- IF(IDEBCD.GE.1) WRITE(LPRTCD,9001) SOURCE(1:LSRCE),
- + TARGET(1:LTARGT)
- CALL CDMOVF(SOURCE(1:LSRCE),TARGET(1:LTARGT),'K',IRC)
- IF(IRC.NE.0) GOTO 10
-*
-* Now rename
-*
- CHTARG = TARGET(1:LTARGT)
- CHTARG(LREMQ(NDB,I)+1:LREMQ(NDB,I)+2) = CDPRFX(NDB)
- IF(IDEBCD.GE.1) WRITE(LPRTCD,9002) TARGET(1:LTARGT),
- + CHTARG(1:LTARGT)
- IC = LIB$RENAME_FILE(TARGET(1:LTARGT),CHTARG(1:LTARGT)
- + ,,,,,,,,,,)
- IF(.NOT.IC) THEN
- IRC = -1
- ELSE
- IRC = 0
- ENDIF
-#endif
-#if defined(CERNLIB_IBMVM)
- LBLANK = INDEXB(SOURCE(1:LSRCE),' ')
- TARGET = SOURCE(1:LBLANK) // CDREMQ(NDB,I)(1:LREMQ(NDB,I))
- LTARGT = LENOCC(TARGET)
- IF(IDEBCD.GE.1) WRITE(LPRTCD,9001) SOURCE(1:LSRCE),
- + TARGET(1:LTARGT)
- CALL VMCMS('COPYFILE '//SOURCE(1:LSRCE)//' '//TARGET(1:LTARGT)
- + ,IRC)
- CALL VMCMS('RENAME'//TARGET(1:LTARGT)//' '//
- + CDPRFX(NDB)//TARGET(3:LTARGT),IRC)
-#endif
- 10 CONTINUE
-
-9001 FORMAT(' CDSEND. copying ',A,' to ',/,18X,A)
-9002 FORMAT(' CDSEND. renaming ',A,' to ',/,18X,A)
- END
diff --git a/src/packlib/hepdb/programs/cdserv/cdserv.F b/src/packlib/hepdb/programs/cdserv/cdserv.F
deleted file mode 100644
index 65f7e1c..0000000
--- a/src/packlib/hepdb/programs/cdserv/cdserv.F
+++ /dev/null
@@ -1,390 +0,0 @@
-*
-* $Id: cdserv.F,v 1.6 1996/04/23 14:05:26 jamie Exp $
-*
-* $Log: cdserv.F,v $
-* Revision 1.6 1996/04/23 14:05:26 jamie
-* increase zebra store to 3M words
-*
-* Revision 1.5 1996/04/12 09:42:27 cernlib
-* New handling of title
-*
-* Revision 1.4 1996/04/02 14:43:09 cernlib
-* Split up "/ *" to '/' // '*'; this does fpp on VMS a favour
-*
-* Revision 1.3 1996/03/29 11:18:21 jamie
-* qftitlch
-*
-* Revision 1.2 1996/03/12 13:08:06 cernlib
-* Build hepdb programs: hepdb, cdserv, cdnew, and cdmove
-*
-* Revision 1.1.1.1 1996/02/28 16:23:35 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- PROGRAM CDSERV
-* ==============
-*
-* HEPDB database server
-*
-* Method:
-* =======
-*
-* Upon initialisation, the server reads configuration information
-* from a names file. This determines which database files are to
-* be managed, the directories where updates will be found, the
-* directories where journal files will be saved, the names of
-* remote servers etc.
-*
-* The server then looks for files in the update directory. It stops
-* if a file named signal.stop is found. Otherwise, it determines from
-* the update file name the name of the database to be processed,
-* opens the database and processes the update file.
-*
-* The update file is then moved to a journal directory and copied
-* to the input directories of all known remote servers. In some
-* cases, the files are first copied to a local queue and moved to
-* the final directories using another server.
-*
-* The server can operate in one of two modes:
-*
-* 1) Master
-* Updates are allocated a unique (within a directory) KEY(1)
-* and stamped with the insertion date and time
-* 2) Slave
-*
-* The master server is the one where the directories pointed
-* to by the :todo and :queue tags are the same.
-*
-* This permits the same code to run as both master and slave
-*
-#include "hepdb/cdnamc.inc"
-#include "hepdb/cduscm.inc"
-#include "hepdb/cdwacm.inc"
-#include "zebra/fzstat.inc"
-#include "hepdb/slate.inc"
- PARAMETER (MAXGCB = 3000000)
- COMMON /GCBANK/ FENCE(22),LQ(MAXGCB)
- DIMENSION IQ(999),Q(999)
- EQUIVALENCE (Q(1),IQ(1),LQ(9))
- PARAMETER (NMAX=100)
- CHARACTER*255 CHFILE,CHSTOP,CHSEAR,FILES(NMAX)
- CHARACTER*80 CHTEXT,CHJOUR
- CHARACTER*4 CHTOP,CHOPT
- CHARACTER*2 PREFIX
- CHARACTER*8 CHNODE
- LOGICAL ISTOP,IFBATCH
-#include "hepdb/quest.inc"
-#include "hepdb/qftitlch.inc"
- CHARACTER VIDQQ*(*)
- PARAMETER (VIDQQ = '@(#)' //
- + HepdbTitleFortranString
- + // '>')
- CALL CLEFT (VIDQQ,1,0)
-*
-*-----------------------------------------------------------------------
-
- IOPLOG = 0
- LUNRZ = 1
- LUNFZ = 2
- LUNLG = 3
- LUNNF = 4
- LPRTCD = 6
- LUNCDI = 7
- LUNJOU = 8
- IWAKCD = 0
-
- NFILES = 0
- CALL VZERO(NSERV,MAXDB)
-#if defined(CERNLIB_VAXVMS)
- OPEN(LPRTCD,FILE='SYS$OUTPUT',RECL=512,STATUS='UNKNOWN',
- + FORM='FORMATTED',ACCESS='SEQUENTIAL')
-#endif
-*
-* Read configuration from NAMES file
-*
- CHFILE = 'HEPDB.NAMES'
- CALL CDCONF(LUNNF,CHFILE,ILOGLV,IWAKE,IRC)
-
- IDEBCD = ILOGLV
-
-#if defined(CERNLIB_VAXVMS)
- CHSTOP = CDTODO(1:LTODO) // 'SIGNAL.STOP'
- LSTOP = LTODO + 11
-
- TMIN = 5.
- CALL GETENVF('CDTMIN',CHTEXT)
- IF(IS(1).NE.0) TMIN = ICDECI(CHTEXT,1,IS(1))
-
-#endif
-#if defined(CERNLIB_UNIX)
- CHSTOP = CDTODO(1:LTODO) // '/SIGNAL.STOP'
- LSTOP = LTODO + 12
- CALL CUTOL(CHSTOP(1:LSTOP))
-#endif
-#if defined(CERNLIB_IBMMVS)
- CHSTOP = CDTODO(1:LTODO) // '.SIGNAL.STOP'
- LSTOP = LTODO + 12
-#endif
-*
-*** Initialize ZEBRA
-*
-#if defined(CERNLIB__DEBUG)
- CALL MZEBRA(0)
-#endif
-#if !defined(CERNLIB__DEBUG)
- CALL MZEBRA(-3)
-#endif
-*
- CALL DATIME(ID,IT)
- CALL CDHOST(CHNODE,IRC)
- LNODE = LENOCC(CHNODE)
- CALL CLTOU (CHNODE)
- WRITE(CHTEXT,9010) 'Init. at ',ID,IT,' on node ',CHNODE
- CALL CDLOGF(0,CHTEXT)
-#if defined(CERNLIB_UNIX)
- CALL GETPIDF(IPID)
- WRITE(CHTEXT,9001) IPID,CHNODE
- 9001 FORMAT('CDSERV. PID = ',I10,' NODE = ',A)
- CALL CDLOGF(0,CHTEXT)
-#endif
-
-#if defined(CERNLIB__DEBUG)
- CALL MZSTOR(IXSTOR,'/GCBANK/',' ',FENCE(1),LQ(1),LQ(5),LQ(9),
- + LQ(5000),LQ(MAXGCB))
- CALL MZLOGL(IXSTOR,0)
-#endif
-#if !defined(CERNLIB__DEBUG)
- CALL MZSTOR(IXSTOR,'/GCBANK/','Q',FENCE(1),LQ(1),LQ(5),LQ(9),
- + LQ(5000),LQ(MAXGCB))
- CALL MZLOGL(IXSTOR,-3)
-#endif
- IDIVD = IXSTOR + 2
-*
-*** Loop waiting for work
-*
- 10 CONTINUE
-*
-* Look for files in the input queue
-*
- JWAKCD = IWAKCD
-#if !defined(CERNLIB_IBMVM)
- INQUIRE(FILE=CHSTOP(1:LSTOP),EXIST=ISTOP)
- IF(ISTOP) GOTO 40
-#endif
-#if defined(CERNLIB_VAXVMS)
- IF(IFBATCH(DUMMY)) THEN
- CALL TIMEL(TLEFT)
- IF(TLEFT.LT.TMIN) THEN
- WRITE(CHTEXT,9001) TLEFT,TMIN
- 9001 FORMAT('Only ',F10.1,' seconds left. Minimum ',F10.1)
- CALL CDLOGF(0,CHTEXT)
- GOTO 40
- ENDIF
- ENDIF
- CHSEAR = CDTODO(1:LTODO) // '*.*'
-#endif
-#if defined(CERNLIB_UNIX)
- CHSEAR = CDTODO(1:LTODO) // '/' // '*'
-#endif
-#if !defined(CERNLIB_IBMVM)
- ICONT = 0
- CALL CDLLS(LUNCDI,CHSEAR,FILES,NMAX,NFOUND,ICONT,IRC)
- IF(NFOUND.EQ.0) THEN
- IF(IWAKCD.EQ.JWAKCD) THEN
- CALL SLEEPF(IWAKE)
- JWAKCD = IWAKCD
- ENDIF
- GOTO 10
- ENDIF
-
- NZZ = 0
-
- DO 30 I=1,NFOUND
- CHFILE = FILES(I)
- LFILE = LENOCC(CHFILE)
-#endif
-#if defined(CERNLIB_VAXVMS)
- LSQBRA = INDEXB(CHFILE(1:LFILE),']')
- ISTART = LSQBRA + 1
- PREFIX = CHFILE(LSQBRA+1:LSQBRA+2)
-#endif
-#if defined(CERNLIB_UNIX)
- ISTART = 1
- LSLASH = INDEXB(CHFILE(1:LFILE),'/')
- PREFIX = CHFILE(LSLASH+1:LSLASH+2)
-#endif
-#if defined(CERNLIB_IBMVM)
- CALL VMCMS('EXEC HDBSERV',IRC)
- IF(IRC.EQ.3.OR.IRC.EQ.99) GOTO 10
- IF(IRC.NE.0) THEN
- WRITE(CHTEXT,9002) IRC
- 9002 FORMAT('Return code from EXEC HDBSERV = ',I10)
- CALL CDLOGF(0,CHTEXT)
- GOTO 40
- ENDIF
-*
-* Get filename
-*
- CALL VMCMS('GLOBALV SELECT *EXEC STACK CDFILE',IC)
- CALL VMRTRM(CHFILE,LFILE)
- PREFIX = CHFILE(1:2)
- ISTART = 1
-#endif
-*
-* Get name of database file
-*
- CALL CLTOU(PREFIX)
-*
-* Skip active (ZZ & QQ) files
-*
- IF(PREFIX.EQ.'ZZ'.OR.PREFIX.EQ.'QQ') THEN
- NZZ = NZZ + 1
- GOTO 30
- ENDIF
-*
-* and last.kumac files...
-*
- IF(CHFILE(1:LFILE).EQ.'LAST.KUMAC'.OR.
- + CHFILE(1:LFILE).EQ.'last.kumac') GOTO 30
-
- IDB = ICNTH(PREFIX,CDPRFX,NFILES)
- IF(IDB.EQ.0) THEN
- WRITE(CHTEXT,9003)
- 9003 FORMAT('Cannot find database for following file')
- CALL CDLOGF(0,CHTEXT)
- WRITE(CHTEXT,9004) CHFILE(ISTART:LFILE)
- 9004 FORMAT('Filename: ',A)
- CALL CDLOGF(0,CHTEXT)
-*
-* Move update file to 'bad' directory
-*
- CALL CDBAD(CHFILE,IRC)
- WRITE(CHTEXT,9005) CHFILE(ISTART:LFILE)
- 9005 FORMAT('Bad prefix in file ',A)
- CALL CDLOGF(-1,CHTEXT)
- GOTO 40
- ENDIF
-#if defined(CERNLIB_IBMVM)
-*
-* Strip off <user.address>
-*
- ISTART = INDEX(CDFILE(IDB),'>')
- IF(ISTART.EQ.0) ISTART = INDEX(CDFILE(IDB),']')
- ISTART = ISTART + 1
-#endif
-#if !defined(CERNLIB_IBMVM)
- ISTART = 1
-#endif
-*
-* Open database file
-*
- LRECL = 0
- CHTOP = 'CD' // PREFIX
- CHOPT = 'EP'
- CALL CLTOU(CHTOP)
- CALL CDUPDT(LUNRZ,LUNFZ,CHTOP,CDFILE(IDB)(ISTART:),LRECL,
- + IDIVD,CHOPT,IRC)
- IF(IRC.NE.0) THEN
- WRITE(CHTEXT,9006) IRC,CHTOP
- 9006 FORMAT('Return code ',I3,' from CDUPDT for ',A)
- CALL CDLOGF(-1,CHTEXT)
- GOTO 40
- ENDIF
-
- CALL CDLOGL(CHTOP,ILOGLV,' ',IRC)
-*
-* Get unique name for journal file
-*
- CALL CDUNIQ(CHJOUR,IRC)
-*
-* Open journal file
-*
- IF(IDEBCD.GE.1) THEN
- WRITE(CHTEXT,7007) CHTOP,LUNJOU
- 7007 FORMAT('Opening journal file ',A,' on unit ',I2)
- CALL CDLOGF(-1,CHTEXT)
- ENDIF
-
- CALL CDJOUR(LUNJOU,CHTOP,CHJOUR,80,'AOZ',IRC)
- IF(IRC.NE.0) THEN
- WRITE(CHTEXT,9007) IRC,CHTOP
- 9007 FORMAT('Return code ',I3,' from CDJOUR for ',A)
- CALL CDLOGF(-1,CHTEXT)
- GOTO 40
- ENDIF
-*
-* Process update
-*
- CALL CDLOAD(LUNFZ,CHFILE,IRC)
- IF(IRC.NE.0) THEN
-*
-* Purge new journal file
-*
- CLOSE(LUNJOU,STATUS='DELETE')
- GOTO 40
- ENDIF
-*
-* Get FZ status information for new journal file
-*
- CALL FZINFO(LUNJOU)
-
- IUSED = INFOFZ(2)
-*
-* Close new journal file
-*
- CALL FZENDO(LUNJOU,'TE')
-*
-* Do not send or journal if file unused
-*
- IF(IUSED.EQ.0) THEN
- CLOSE(LUNJOU,STATUS='DELETE')
- WRITE(CHTEXT,9008) CHTOP
- 9008 FORMAT('Warning - empty output journal file deleted for ',A)
- CALL CDLOGF(-1,CHTEXT)
- GOTO 20
- ENDIF
-
- CLOSE(LUNJOU)
-*
-* Send new journal file to list of remote servers
-* This is only for the master server as slaves must,
-* by definition, have received this update from the master
-*
- IF(MASTER) CALL CDSEND(CHJOUR,IDB,IRC)
-*
-* and save
-*
- CALL CDBACK(CHJOUR,IDB,IRC)
- IF(IRC.NE.0) THEN
- WRITE(CHTEXT,9009) IRC,CHTOP
- 9009 FORMAT('Return code ',I3,' from CDBACK for ',A)
- CALL CDLOGF(-1,CHTEXT)
- GOTO 40
- ENDIF
-
- 20 CONTINUE
-*
-* Delete original update file
-*
- CALL CDDELF(CHFILE,IRC)
-*
-* Close this database
-*
- CALL CDEND(CHTOP,'S',IRC)
- 30 CONTINUE
-*
-* Sleep if we only found ZZ files...
-*
- IF(NZZ.EQ.NFOUND) CALL SLEEPF(IWAKE)
-
- GOTO 10
-
- 40 CONTINUE
- CALL DATIME(ID,IT)
- WRITE(CHTEXT,9011) 'Stopping at ',ID,IT
- 9010 FORMAT(A,I6,1X,I4,1X,A,1X,A)
- 9011 FORMAT(A,I6,1X,I4)
- CALL CDLOGF(0,CHTEXT)
-
- END
diff --git a/src/packlib/hepdb/programs/cdserv/cdstop.F b/src/packlib/hepdb/programs/cdserv/cdstop.F
deleted file mode 100644
index 0f6f96b..0000000
--- a/src/packlib/hepdb/programs/cdserv/cdstop.F
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: cdstop.F,v 1.3 1997/03/14 17:07:41 mclareni Exp $
-*
-* $Log: cdstop.F,v $
-* Revision 1.3 1997/03/14 17:07:41 mclareni
-* WNT mods
-*
-* Revision 1.2.2.1 1997/01/21 11:28:54 mclareni
-* All mods for Winnt 96a on winnt branch
-*
-* Revision 1.2 1996/03/12 13:08:07 cernlib
-* Build hepdb programs: hepdb, cdserv, cdnew, and cdmove
-*
-* Revision 1.1.1.1 1996/02/28 16:23:35 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDSTOP
-#include "hepdb/cdnamc.inc"
- CALL CDEND(' ','A',IRC)
- CALL MZEND
- END
diff --git a/src/packlib/hepdb/programs/cdserv/cdtrap.F b/src/packlib/hepdb/programs/cdserv/cdtrap.F
deleted file mode 100644
index d3cb499..0000000
--- a/src/packlib/hepdb/programs/cdserv/cdtrap.F
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: cdtrap.F,v 1.2 1996/03/12 13:08:08 cernlib Exp $
-*
-* $Log: cdtrap.F,v $
-* Revision 1.2 1996/03/12 13:08:08 cernlib
-* Build hepdb programs: hepdb, cdserv, cdnew, and cdmove
-*
-* Revision 1.1.1.1 1996/02/28 16:23:36 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
-#if defined(CERNLIB_UNIX)
- SUBROUTINE CDTRAP(ISTAT)
-
- INTEGER SIGNALF
-
- EXTERNAL CDWAKE
-
- ISTAT = SIGNALF(1,CDWAKE,-1)
-
- END
-#endif
diff --git a/src/packlib/hepdb/programs/cdserv/cdwake.F b/src/packlib/hepdb/programs/cdserv/cdwake.F
deleted file mode 100644
index ed404ea..0000000
--- a/src/packlib/hepdb/programs/cdserv/cdwake.F
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: cdwake.F,v 1.2 1996/03/12 13:08:10 cernlib Exp $
-*
-* $Log: cdwake.F,v $
-* Revision 1.2 1996/03/12 13:08:10 cernlib
-* Build hepdb programs: hepdb, cdserv, cdnew, and cdmove
-*
-* Revision 1.1.1.1 1996/02/28 16:23:36 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDWAKE
-#include "hepdb/cdwacm.inc"
-
- DATA IWAKE/0/
- SAVE IWAKE
-
- IWAKE = IWAKE + 1
-
- IWAKCD = IWAKE
-
- END
diff --git a/src/packlib/hepdb/programs/cplear/cpkalc.F b/src/packlib/hepdb/programs/cplear/cpkalc.F
deleted file mode 100644
index acb04e3..0000000
--- a/src/packlib/hepdb/programs/cplear/cpkalc.F
+++ /dev/null
@@ -1,125 +0,0 @@
-*
-* $Id: cpkalc.F,v 1.1.1.1 1996/02/28 16:23:36 mclareni Exp $
-*
-* $Log: cpkalc.F,v $
-* Revision 1.1.1.1 1996/02/28 16:23:36 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_hepdb/pilot.h"
- SUBROUTINE CPKALC(CHDIR)
- CHARACTER*(*) CHDIR
- COMMON/USRLNK/IDIV,LADDR
- PARAMETER (NKEYS=2)
- PARAMETER (MAXOBJ=1000)
- DIMENSION KEYS(13)
- DIMENSION KEYZ(4)
- CHARACTER*8 CHTAG(NKEYS)
- CHARACTER*2 CHFOR
- CHARACTER*255 CHPATH,CHSAVE
-#include "rzcl.inc"
-#include "rzk.inc"
- DATA NENTRY/0/
- SAVE NENTRY
-#include "q_jbit.inc"
-* Ignoring t=pass
-
- IF(NENTRY.EQ.0) THEN
- NENTRY = 1
- RETURN
- ENDIF
-*
-* Must save directory in local variable: calls to RZ
-* overwrite it!
-*
- LDIR = LENOCC(CHDIR)
- CHSAVE = CHDIR(1:LDIR)
-*
-* Make directories in HEPDB database
-*
- DELTA = 0.0
- IPREC = 0
- CHFOR = 'HH'
- CHTAG(1) = 'DETECTOR'
- CHTAG(2) = 'POINTER '
-*
-* Construct directory name for HEPDB file
-*
- LSLASH = INDEXB(CHSAVE(1:LDIR),'/') + 1
- IF(INDEX(CHSAVE(1:LDIR),'MONTE').EQ.0) THEN
- CHPATH = '//CDCD/CALIBRATION/'//CHSAVE(LSLASH:LDIR)
- LPATH = LDIR - LSLASH + 20
- ELSE
- CHPATH = '//CDCD/'//CHSAVE(LSLASH:LDIR)
- LPATH = LDIR - LSLASH + 8
- ENDIF
- CALL CDMDIR(CHPATH(1:LPATH),NKEYS,CHFOR,CHTAG,MAXOBJ,
- + IPREC,DELTA,'CP',IRC)
-*
-* Loop over objects in current directory (file RZKAL.DATA)
-*
- CALL RZCDIR(CHSAVE(1:LDIR),' ')
-*
-* Retrieve the keys in this directory
-*
- IF(LQRS.EQ.0) GOTO 99
- IF(LCDIR.EQ.0) GOTO 99
- LS = IQ(KQSP+LCDIR+KLS)
- LK = IQ(KQSP+LCDIR+KLK)
- NK = IQ(KQSP+LCDIR+KNKEYS)
- NWK= IQ(KQSP+LCDIR+KNWKEY)
- DO 10 I=1,NK
-
- K=LK+(NWK+1)*(I-1)
- DO 20 J=1,NWK
- IKDES=(J-1)/10
- IKBIT1=3*J-30*IKDES-2
- IF(JBYT(IQ(KQSP+LCDIR+KKDES+IKDES),IKBIT1,3).LT.3)THEN
- KEYZ(J)=IQ(KQSP+LCDIR+K+J)
- ELSE
- CALL ZITOH(IQ(KQSP+LCDIR+K+J),KEYZ(J),1)
- ENDIF
- 20 CONTINUE
-
- CALL VZERO(KEYS,10)
- CALL UCOPY(KEYZ(1),KEYS(11),4)
-*
-* Retrieve the highest cycle of this object
-* (will need modification if all cycles are to be converted)
-*
- ICYCLE = 9999
- JBIAS = 2
- CALL RZIN(IDIV,LADDR,JBIAS,KEYZ,ICYCLE,' ')
- IF(IQUEST(1).NE.0) THEN
- PRINT *,'CPKALC. error ',IQUEST(1),' from RZIN for ',KEYZ
- GOTO 10
- ENDIF
-*
-* Date/time of insertion
-*
- CALL RZDATE(IQUEST(14),IDATE,ITIME,1)
- CALL CDPKTM(IDATE,ITIME,IPACK,IRC)
- KEYS(4) = IPACK
-*
-* Store objects in HEPDB with appropriate keys
-* Option H: honour insertion time in KEYS(IDHINS)
-*
- CALL CDSTOR(CHPATH(1:LPATH),LADDR,LKYBK,IDIV,KEYS,'H',IRC)
-*
-* Reset directory
-*
- CALL RZCDIR(CHSAVE(1:LDIR),' ')
-*
-* Drop this bank
-*
- CALL MZDROP(IDIV,LADDR,' ')
- LADDR = 0
-
- 10 CONTINUE
-
- 99 CONTINUE
-
- CALL RZCDIR(CHSAVE(1:LDIR),' ')
-
- END
diff --git a/src/packlib/hepdb/programs/cplear/kalconv.F b/src/packlib/hepdb/programs/cplear/kalconv.F
deleted file mode 100644
index 839bd5f..0000000
--- a/src/packlib/hepdb/programs/cplear/kalconv.F
+++ /dev/null
@@ -1,99 +0,0 @@
-*
-* $Id: kalconv.F,v 1.1.1.1 1996/02/28 16:23:36 mclareni Exp $
-*
-* $Log: kalconv.F,v $
-* Revision 1.1.1.1 1996/02/28 16:23:36 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_hepdb/pilot.h"
- PROGRAM KALCONV
-*
-* Program to convert CPLEAR calibration database
-* to HEPDB format
-*
-* RZKAL keys: VAL_STAR (I)
-* VAL_STOP (I)
-* DETECTOR (H)
-* BANK ID (H)
-* insertion time = RZ date/time
-*
-* HEPDB keys: NPAIR = 1
-* VAL_STAR = KEYS(11) (I)
-* VAL_STOP = KEYS(12) (I)
-* NUSER = 2
-* DETECTOR = KEYS(13) (H)
-* BANK ID = LEYS(14) (H)
-* insertion time = KEYS(IDHINS)
-*
-* Output pathnames:
-*
-* //CDCD/CALIBRATION/DC_LT
-* //CDCD/CALIBRATION/DC_MT
-* //CDCD/CALIBRATION/DC_ST
-*
-* //CDCD/CALIBRATION/PC_ST
-* //CDCD/CALIBRATION/PC_LT
-* //CDCD/CALIBRATION/PC_MT
-*
-* //CDCD/CALIBRATION/PID_ST
-* //CDCD/CALIBRATION/PID_LT
-* //CDCD/CALIBRATION/PID_MT
-*
-* //CDCD/CALIBRATION/ST_MT
-*
-* //CDCD/CALIBRATION/CALO_LT
-*
- PARAMETER (NWPAW=100000)
- COMMON/PAWC/ PAW(NWPAW)
- COMMON/USRLNK/IDIV,LADDR
- CHARACTER*4 CHTOP
- CHARACTER*80 CHFILE
- EXTERNAL CPKALC
-*
-* Initialise Zebra, HBOOK and HEPDB
-*
- CALL CDPAW(NWPAW,NHBOOK,IDIV,'USR-DIV',5000,50000,'ZPHU',IRC)
-*
-* Link area of banks retrieved from database
-*
- CALL MZLINK(IDIV,'/USRLNK/',LADDR,LADDR,LADDR)
-*
-* Unit for database access
-*
- LUNCD = 1
-*
-* Unit for database update (via journal files)
-*
- LUNFZ = 2
-*
-* Unit for RZKAL file
-*
- LUNRZ = 3
-*
-* Open CPLEAR calibration database (RZKAL.DATA)
-*
- LRECL = 0
- CALL RZOPEN(LUNRZ,'RZKAL','rzkal.data',' ',LRECL,IRC)
- CALL RZFILE(LUNRZ,'RZKAL',' ')
-*
-* Find the database file and construct the top directory name
-*
- CALL CDPREF(10,'CD',CHTOP,CHFILE,IRC)
-*
-* Open the database file
-*
- LRECL = 0
- CALL CDOPEN(LUNCD,LUNFZ,CHTOP,CHFILE,LRECL,IDIV,' ',IRC)
-*
-* Loop over directories in RZKAL.DATA
-*
- CALL RZSCAN('//RZKAL',CPKALC)
-*
-* Terminate
-*
- CALL CDEND(' ','A',IRC)
- CALL RZCLOS(' ','A')
-
- END
diff --git a/src/packlib/hepdb/programs/hepdb/Imakefile b/src/packlib/hepdb/programs/hepdb/Imakefile
deleted file mode 100644
index b4eb0e9..0000000
--- a/src/packlib/hepdb/programs/hepdb/Imakefile
+++ /dev/null
@@ -1,22 +0,0 @@
-#define IHaveCDF
-
-SRCS_F= cdcdrc.F cdclsh.F cdclsr.F cdexit.F cdextq.F cdfilc.F \ @@\
- cdkali.F cdkhlp.F cdkpak.F cdkpwd.F cdktxt.F cdkupk.F cdldc.F \ @@\
- cdlogc.F cdlsc.F cdmerg.F cdmkdr.F cdobjc.F cdopnc.F cdoutp.F \ @@\
- cdpwd.F cdquit.F cdrmc.F cdrmdc.F cdrmtc.F cdrzld.F cdrzop.F \ @@\
- cdrzst.F cdseac.F cdsele.F cdtree.F cdverc.F cdwind.F cdzoom.F \ @@\
- zabend.F
-
-SRCS_CDF=cdcdf.cdf
-
-SubdirLibraryTarget(dbmodule,NullParameter)
-
-DefinePackageLibrary(dbmodule)
-
-#ifdef CERNLIB_HPUX
-SpecialFortranObjectRule(hepdb,hepdb,'-WF,-P',NullParameter)
-#endif
-
-CernlibFortranProgramTarget(hepdb,hepdb.o,$(PACKAGE_LIB),$(PACKAGE_LIB),packlib)
-
-InstallProgram(hepdb,$(CERN_BINDIR))
diff --git a/src/packlib/hepdb/programs/hepdb/README b/src/packlib/hepdb/programs/hepdb/README
deleted file mode 100644
index 543be7c..0000000
--- a/src/packlib/hepdb/programs/hepdb/README
+++ /dev/null
@@ -1,9 +0,0 @@
-*
-* $Id: README,v 1.1.1.1 1996/02/28 16:23:27 mclareni Exp $
-*
-* $Log: README,v $
-* Revision 1.1.1.1 1996/02/28 16:23:27 mclareni
-* Hepdb, cdlib, etc
-*
-*
-* This directory was created from hepdb.car patch hepdb
diff --git a/src/packlib/hepdb/programs/hepdb/cdcdf.cdf b/src/packlib/hepdb/programs/hepdb/cdcdf.cdf
deleted file mode 100644
index 94495ad..0000000
--- a/src/packlib/hepdb/programs/hepdb/cdcdf.cdf
+++ /dev/null
@@ -1,483 +0,0 @@
-*
-* $Id: cdcdf.cdf,v 1.1 1996/03/12 13:08:27 cernlib Exp $
-*
-* $Log: cdcdf.cdf,v $
-* Revision 1.1 1996/03/12 13:08:27 cernlib
-* Build hepdb programs: hepdb, cdserv, cdnew, and cdmove
-*
-* Revision 1.1.1.1 1996/02/28 16:24:08 mclareni
-* Hepdb, cdlib, etc
-*
-*
-*----------------------------------------------------------------
-*
-* HEPDB command definition file (CDF)
-*
-*----------------------------------------------------------------
->NAME CDCDF
->MENU HEPDB
->Guidance
-HEPDB shell commands
-
-*----------------------------------------------------------------
->command ALIAS
->Action CDKALI
->PARAMETERS
-+
-PATH 'Pathname ' C D=' '
-ALIAS 'Alias ' C D=' '
-CHOPT 'Options ' C D=' '
--D 'delete the alias definition for the specified path'
--P 'print the alias definition for the specified path'
--R 'retrieve and print the equivalence name for the specified alias'
--S 'set the alias for the specified path for the current session'
--U 'as S, but also update database'
->Guidance
-
-Use the ALIAS command to delete, print, retrieve, set or update
-alias definitions. The action of the command depends on the option
-specified by the CHOPT argument.
-
-*----------------------------------------------------------------
->command CDHELP
->Action CDKHLP
->PARAMETERS
-+
-PATH 'Pathname ' C D=' '
-FILE 'File ' C D=' '
-CHOPT 'Options ' C D=' '
--D 'delete the help information for the specified path'
--P 'print the help information for the specified path'
--R 'read the help information for specified path and enter into database'
--W 'write the help information for specified path into the file'
-
-*----------------------------------------------------------------
->command CDTEXT
->Action CDKTXT
->PARAMETERS
-+
-PATH 'Pathname ' C D=' '
-FILE 'File ' C D=' '
-CHOPT 'Options ' C D=' '
--D 'delete the text information for the specified path'
--P 'print the text information for the specified path'
--R 'read the text information for specified path and enter into database'
--W 'write the text information for specified path into the file'
-
-*----------------------------------------------------------------
->command COUNT
->Action CDOBJC
->PARAMETERS
-+
-PATH 'Pathname ' C D=' '
-CHOPT 'Options ' C D=' '
--D 'display number of subdirectories at each level'
--O 'display number of objects at each level'
--L 'display lowest level only, i.e. directories with no subdirectories'
--Z 'display only directories with no (zero) objects'
->Guidance
-Use the COUNT command to count the number of objects in the specified
-directory or directories.
-
-*----------------------------------------------------------------
->command FILES
->Action CDFILC
->Guidance
-Use the FILES command to display information on the database files
-that are currently open.
-
-*----------------------------------------------------------------
->command LOGLEVEL
->Action CDLOGC
->PARAMETERS
-+
-PATH 'Pathname' C D=' '
-LEVEL 'Loglevel' I D=0
-CHOPT 'Options ' C D=' '
->GUIDANCE
-Use the LOGLEVEL command to set the HEPDB logging level.
-.
-Syntax: LOGLEVEL path loglevel options
-
-*----------------------------------------------------------------
->command OPEN
->Action CDOPNC
->PARAMETERS
-PREFIX 'Prefix ' C D=' '
-+
-FILE 'Filename' C D=' '
-CHOPT 'Options ' C D='X'
--X 'The specified file is in Zebra RZ exchange data format
--N 'The specified file is in Zebra RZ native data format
->GUIDANCE
-Use the OPEN command to open a HEPDB file by specifying the database
-prefix.
-.
-Syntax: OPEN PREFIX FILENAME CHOPT
-
-*----------------------------------------------------------------
->command CLOSE
->Action CDCLSH
->PARAMETERS
-PREFIX 'Prefix of database file' C D=' '
-+
-CHOPT 'Options ' C D=' '
--A 'Close all files (prefix is ignored)'
->guidance
-Use the CLOSE command to close a HEPDB file opened by the OPEN
-command.
-*----------------------------------------------------------------
->command RZOPEN
->Action CDRZOP
->PARAMETERS
-NAME 'Topdir ' C D=' '
-FILE 'Filename' C D=' '
-+
-CHOPT 'Options ' C D='X'
--X 'The specified file is in Zebra RZ exchange data format
--N 'The specified file is in Zebra RZ native data format
->GUIDANCE
-Use the OPEN command to open any RZ file, including an HEPDB file
-.
-Syntax: RZOPEN TOPDIR FILENAME CHOPT
-
-*----------------------------------------------------------------
->command RZCLOSE
->Action CDCLSR
->PARAMETERS
-+
-NAME 'Topdir ' C D=' '
-CHOPT 'Options ' C D=' '
->GUIDANCE
-Use the CLOSE command to close a file opened with RZOPEN
-Syntax: CLOSE NAME FILE CHOPT
-
-*----------------------------------------------------------------
->command OUTPUT
->Action CDOUTP
->PARAMETERS
-+
-FILE 'Filename' C D=' '
-CHOPT 'Options ' C D=' '
--C 'close file and redirect output to terminal'
--P 'preserve case of file'
--R 'replace existing file'
--S 'switch back to previously opened file'
--T 'redirect output back to terminal'
->GUIDANCE
-Use the OUTPUT command to redirect output to a specified file.
-.
-Syntax: OUTPUT FILE
-
-*----------------------------------------------------------------
->command WINDOW
->Guidance
-Use the WINDOW command to set the insertion time window.
-Objects that were inserted outside the specified window
-will be invisible via the LS command.
-
-Syntax: WINDOW start-end
-
-The start and end times should be specified in the format
-
-yymmdd.hhmm
-
-Use the command WINDOW -R to reset to the default behaviour
-of no check on insertion time.
-
->Action CDWIND
->Parameters
-+
-RANGE 'date and time range' C D='-'
-CHOPT 'options ' C D=' '
--R 'Reset the time window to the default (no check)'
-*----------------------------------------------------------------
->command VERSION
->Guidance
-Use the VERSION command to display the version of the HEPDB
-software that you are running.
-Syntax: VERSION
->Action CDVERC
-
->MENU \HDBCAT
->Guidance
-Commands to manipulate HEPDB databases
-
-*----------------------------------------------------------------
->command CD
->Guidance
-Use the CD command to change the current default directory.
-.
-Syntax: CD path
->Action CDCDRC
->PARAMETERS
-PATH 'path' C D=' '
-+
-CHOPT 'options ' C D=' '
--A 'all of below'
--Q 'show quota for new directory'
--S 'show number of subdirectories'
--T 'show creation & modification times'
--U 'show usage information'
-
-*----------------------------------------------------------------
->command LD
->Action CDLDC
->PARAMETERS
-+
-PATH 'Pathname ' C D='*'
-NLEVEL 'Number of levels to display' I D=1
-CHOPT 'Options' C D=' '
--H 'Write a header showing the command and options'
--C 'List the creation date & time of the directory/ies'
--M 'List the modification date & time of the directory/ies'
--O 'Display the number of objects'
--R 'List subdirectories recursively'
--S 'Display number of subdirectories'
--T 'Display the tags for the directory/ies'
--V 'Generate a "very wide" listing (132 columns)'
--W 'Generate a "wide" listing (80 columns)'
->GUIDANCE
-Use the LD command to display subdirectories below the specified
-level.
-
-*----------------------------------------------------------------
->command LS
->Action CDLSC
->PARAMETERS
-+
-PATH 'Pathname ' C D=' '
-KSN 'Key serial number' I D=0
-BANK 'Bankname ' C D=' '
-ILNK1 'Index of the first link to be printed' I D=0
-ILNK2 'Index of the last link to be printed' I D=0
-IDAT1 'Index of the first word to be printed' I D=0
-IDAT2 'Index of the last word to be printed' I D=0
-CHOPT 'Options ' C D=' '
--C 'display object count'
--D 'display key definitions'
--E 'display the experiment keys'
--G 'display keys in a generic fashion (RZPRNK)'
--K 'display all keys'
--L 'list only lowest level (end node) directories (D)'
--M 'show maxima and minima of validity range pairs'
--N 'display number of data words'
--P 'display pathname (D)'
--S 'display the system keys'
--T 'display insertion date and time (RZ value)'
--U 'display user keys'
--V 'display validity range pairs'
--Z 'dump ZEBRA bank with DZSHOW'
->GUIDANCE
-Use the LS command to display the contents of a directory
-If option Z is specified, the name of the bank(s) to display
-may be given. If multiple banks are to be displayed, their names
-should be separated by commas. Wild cards are permitted in
-bank names.
-.
-Syntax: LS <options>
-
-*----------------------------------------------------------------
->command PWD
->Guidance
-Use the PWD command to print the current (working) directory.
-Syntax: PWD
->Action CDKPWD
->PARAMETERS
-+
-CHOPT 'Options ' C D=' '
--A 'Display alias name of current directory'
-
-*----------------------------------------------------------------
->command SEARCH
->Action CDSEAC
->Guidance
-Use the SEARCH command to search for something
->PARAMETERS
-PATH 'path name' C D='*'
-+
-CHOPT 'Options ' C D=' '
-
-*----------------------------------------------------------------
->command STATUS
->Guidance
-Use the STATUS command to print usage statistics on the
-specified directory down NLEVEL levels.
-Syntax: STATUS path nlevel
->Action CDRZST
->Parameters
-+
-PATH 'Path name ' C D=' '
-NLEVEL 'number of levels' I D=99
-CHOPT 'Options ' C D=' '
-
-*----------------------------------------------------------------
->command TREE
->Guidance
-Use the TREE command to draw a directory tree starting at the
-specified directory down NLEVEL levels.
-Syntax: TREE path nlevel
->Action CDTREE
->Parameters
-+
-PATH 'Path name ' C D=' '
-NLEVEL 'number of levels' I D=99
-CHOPT 'options ' C D=' '
--A 'show alias name (if any) for each directory'
--N 'show the number of objects for each directory if non-zero'
--O 'show the number of objects for each directory'
--S 'show the number of subdirectories for each directory'
--C 'show the date and time the directory was created'
--M 'show the date and time of the last modification (RZ)'
-
-*----------------------------------------------------------------
->command SELECT
->Guidance
-Use the SELECT command to specify the instant of validity for which
-objects are required.
-Syntax: SELECT
->Action CDSELE
->Parameters
-ISEL1 'Primary selection' I D=0
-+
-ISEL2 'Secondary selection' I D=0
-ISEL3 'Tertiary selection' I D=0
-
-*----------------------------------------------------------------
->command ZOOM
->Action CDZOOM
->PARAMETERS
-+
-PATH 'Pathname' C D=' '
->Guidance
-Use the ZOOM command to descend the specified (wild-carded)
-directory tree to the first lowest level directory that
-contains one or more entries
-.
-e.g. ZOOM DATA
-.
- ZOOM *DST/*/P88*
-.
->MENU \HDBMAN
->Guidance
-Utility commands
-
-*----------------------------------------------------------------
->command DIR
->Guidance
-Use the DIR command to issue a call to RZLDIR for the specified
-path. This command is normally used for debug purposes only.
-.
->Action CDRZLD
->Parameters
-+
-PATH 'path-name' C D=' '
-CHOPT 'options ' C D=' '
--T 'list also subdirectory tree'
--X 'eXtended listing - show also OFFSET,REC1,REC2'
-
-*----------------------------------------------------------------
->command EXTRACT
->Action CDEXTQ
->PARAMETERS
-+
-PATH 'Pathname' C D='*/*'
-OUTPUT 'Output filename' C D=' '
-CHOPT 'Options ' C D='C'
->GUIDANCE
-Use the EXTRACT command to copy a subset of the HEPDB catalogue
-
-*----------------------------------------------------------------
->command MERGE
->Action CDMERG
->PARAMETERS
-+
-INPUT 'Input filename' C D=' '
-PATH 'Pathname' C D='*/*'
-CHOPT 'Options ' C D='C'
->GUIDANCE
-Use the MERGE command to merge an update file created by
-the EXTRACT command into the specified path.
-
-*----------------------------------------------------------------
->command MKDIR
->Guidance
-Use the MKDIR command to create a directory
-Syntax: MKDIR directory_name.
->Action CDMKDR
->PARAMETERS
-DIRNAM 'directory' C D=' '
-
-*----------------------------------------------------------------
->command RM
->Guidance
-Use the RM command to logically remove an entry from the catalogue
-Syntax: RM
->Action CDRMC
->PARAMETERS
-+
-
-*----------------------------------------------------------------
->command RMDIR
->Guidance
-Use the RMDIR command to remove a directory from the catalogue.
-.
-N.B. directories can only be removed if
-.
- 1) They contain no subdirectories
-.
- 2) They contain no entries
-.
-If you wish to remove a complete directory tree that contains
-no entries, use the RMTREE command.
-.
-Syntax: RMDIR PATH
->Action CDRMDC
->PARAMETERS
-PATH 'directory' C D=' '
-
-*----------------------------------------------------------------
->command RMTREE
->Guidance
-Use the RMTREE command to remove a complete directory tree.
-.
-N.B. if any of the directories below the named directory
-contain entries, then the command will be refused.
-.
-Syntax: RMTREE PATH
->Action CDRMTC
->PARAMETERS
-PATH 'directory' C D=' '
-
-*----------------------------------------------------------------
->command PACK
->Guidance
-Use the PACK command to convert a date/time combination into
-its packed representation.
-.
-If IDATE=ITIME=0, then the current date and time will be used.
-.
-Syntax: PACK YYMMDD HHMM[SS]
->Action CDKPAK
->PARAMETERS
-+
-DATE 'date in YYMMDD format' I D='0'
-TIME 'time in HHMM/HHMMSS format' I D='0'
-CHOPT 'options ' C D='M'
--M 'pack date/time using CDPKTM (default)'
--S 'pack date/time using CDPKTS'
-
-*----------------------------------------------------------------
->command UNPACK
->Guidance
-Use the UNPACK command to convert a date/time combination into
-its packed representation
-.
-Syntax: UNPACK packed-time
->Action CDKUPK
->PARAMETERS
-PACK 'packed date/date' I D='0'
-CHOPT 'options ' C D='M'
--M 'unpack date/time using CDPKTM (default)'
--S 'unpack date/time using CDPKTS'
-
diff --git a/src/packlib/hepdb/programs/hepdb/cdcdrc.F b/src/packlib/hepdb/programs/hepdb/cdcdrc.F
deleted file mode 100644
index c69656b..0000000
--- a/src/packlib/hepdb/programs/hepdb/cdcdrc.F
+++ /dev/null
@@ -1,86 +0,0 @@
-*
-* $Id: cdcdrc.F,v 1.2 1996/03/12 13:08:28 cernlib Exp $
-*
-* $Log: cdcdrc.F,v $
-* Revision 1.2 1996/03/12 13:08:28 cernlib
-* Build hepdb programs: hepdb, cdserv, cdnew, and cdmove
-*
-* Revision 1.1.1.1 1996/02/28 16:23:32 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDCDRC
-
- CHARACTER*255 CHPATH
- CHARACTER*255 CHALIA
- CHARACTER*8 CHOPT
-#include "hepdb/cdunit.inc"
-#include "hepdb/quest.inc"
-#include "hepdb/hdboptd.inc"
-
- CALL KUGETC(CHPATH,LPATH)
- CALL KUGETC(CHOPT,LOPT)
-
-#include "hepdb/hdboptc.inc"
- IF(IOPTA.NE.0) THEN
-#include "hepdb/hdbopta.inc"
- ENDIF
-
-#include "hepdb/cdopen.inc"
-
- IF(LPATH.EQ.0) THEN
- CALL CDPWD(CHOPT)
- ELSE
-*
-* Alias support
-*
- IF(CHPATH(1:1).EQ.'%') THEN
- CHALIA = CHPATH(2:LPATH)
- CALL CDRALI(CHALIA,CHPATH,IRC)
- LPATH = LENOCC(CHPATH)
- ENDIF
-
- CALL RZCDIR(CHPATH(1:LPATH),' ')
- IF(IQUEST(1).EQ.0) THEN
- CALL RZCDIR(CHPATH,'R')
- LPATH = LENOCC(CHPATH)
- WRITE(LOUTCD,*) 'CDCDRC. current working directory = ',
- + CHPATH(1:LPATH)
- ELSE
- WRITE(LOUTCD,*) 'CDCDRC. error setting directory to ',
- + CHPATH(1:LPATH)
- RETURN
- ENDIF
-*
-* Quota
-*
- IF(IOPTQ.NE.0) THEN
- WRITE(LOUTCD,*) 'Quota = ',IQUEST(10)
- ENDIF
-*
-*
-* Subdirectories
-*
- IF(IOPTS.NE.0) THEN
- WRITE(LOUTCD,*) 'Number of subdirectories = ',IQUEST(9)
- ENDIF
-*
-* Dates & Times
-*
- IF(IOPTT.NE.0) THEN
- WRITE(LOUTCD,*) 'Created on ',IQUEST(14),' at ',IQUEST(15),
- + 'Modified on ',IQUEST(16),' at ',IQUEST(17)
- ENDIF
-*
-* Usage
-*
- IF(IOPTU.NE.0) THEN
- WRITE(LOUTCD,*) 'Number of records used = ',IQUEST(18)
- WRITE(LOUTCD,*) IQUEST(19),' megawords + ',IQUEST(20),
- + ' words'
- ENDIF
-
- ENDIF
-
- END
diff --git a/src/packlib/hepdb/programs/hepdb/cdclsh.F b/src/packlib/hepdb/programs/hepdb/cdclsh.F
deleted file mode 100644
index d92fbbd..0000000
--- a/src/packlib/hepdb/programs/hepdb/cdclsh.F
+++ /dev/null
@@ -1,82 +0,0 @@
-*
-* $Id: cdclsh.F,v 1.2 1996/03/12 13:08:30 cernlib Exp $
-*
-* $Log: cdclsh.F,v $
-* Revision 1.2 1996/03/12 13:08:30 cernlib
-* Build hepdb programs: hepdb, cdserv, cdnew, and cdmove
-*
-* Revision 1.1.1.1 1996/02/28 16:23:32 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDCLSH
-*
-* Close a HEPDB database file
-*
-#include "hepdb/cdunit.inc"
-#include "zebra/rzcl.inc"
-#include "zebra/zunit.inc"
-
- CHARACTER*16 CHDIR,CHTOP,CHNAME
- CHARACTER*8 CHOPT
-#include "hepdb/hdboptd.inc"
- DIMENSION IHDIR(4)
-
- CALL KUGETC(CHDIR,LDIR)
-
- IF(CHDIR(1:2).EQ.'//') THEN
- CHTOP = CHDIR(3:LDIR)
- LTOP = LDIR - 2
- ELSEIF(LDIR.EQ.2) THEN
- CHTOP = 'CD'//CHDIR(1:LDIR)
- LTOP = LDIR + 2
- ELSE
- CHTOP = CHDIR(1:LDIR)
- LTOP = LDIR
- ENDIF
-
- CALL KUGETC(CHOPT,LOPT)
-
-#include "hepdb/hdboptc.inc"
-
-*
-* Find out the unit number for this file
-*
- NCLOSD = 0
- IF(LQRS.EQ.0) GOTO 30
- LRZ = LQRS
- 10 IF(LRZ.EQ.0) GOTO 30
- CALL ZITOH(IQ(KQSP+LRZ+1),IHDIR,4)
- CALL UHTOC(IHDIR,4,CHNAME,16)
- LN = LENOCC(CHNAME)
- IF(CHNAME(1:LN).EQ.CHTOP(1:LTOP).OR.IOPTA.NE.0) THEN
- LUNDB = IQ(KQSP+LRZ-5)
- IF(LUNDB.EQ.0) GOTO 20
- IF(LLOGCD.GE.0) WRITE(LPRTCD,*) 'CDCLSH. closing ',
- + CHNAME(1:LN),' on unit ',LUNDB
-*
-* Now issue CDEND for this file
-*
- CALL CDEND(CHNAME(1:LN),' ',IRC)
- NCLOSD = NCLOSD + 1
-*
-* Free the logical unit
-*
- CALL CDFLUN(LUNDB,IRC)
- ENDIF
-
- 20 CONTINUE
- LRZ=LQ(KQSP+LRZ)
- GO TO 10
- 30 CONTINUE
-
- IF(IOPTA.EQ.0.AND.NCLOSD.EQ.0) THEN
- IF(LLOGCD.GE.-3) WRITE(LPRTCD,*) 'CDCLSH. file with ',
- + 'top directory ',CHTOP(1:LTOP),' is not open'
- ENDIF
-
- IF(LLOGCD.GE.0) WRITE(LPRTCD,*) 'CDCLSH. closed ',
- + NCLOSD,' file(s)'
-
- END
diff --git a/src/packlib/hepdb/programs/hepdb/cdclsr.F b/src/packlib/hepdb/programs/hepdb/cdclsr.F
deleted file mode 100644
index 4181046..0000000
--- a/src/packlib/hepdb/programs/hepdb/cdclsr.F
+++ /dev/null
@@ -1,67 +0,0 @@
-*
-* $Id: cdclsr.F,v 1.2 1996/03/12 13:08:31 cernlib Exp $
-*
-* $Log: cdclsr.F,v $
-* Revision 1.2 1996/03/12 13:08:31 cernlib
-* Build hepdb programs: hepdb, cdserv, cdnew, and cdmove
-*
-* Revision 1.1.1.1 1996/02/28 16:23:32 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDCLSR
-*
-* Close a HEPDB database file
-*
-#include "hepdb/cdunit.inc"
-#include "zebra/rzcl.inc"
-#include "zebra/zunit.inc"
-
- CHARACTER*16 CHTOP,CHNAME
- CHARACTER*8 CHOPT
-#include "hepdb/hdboptd.inc"
- DIMENSION IHDIR(4)
-
- CALL KUGETC(CHTOP,LTOP)
- CALL KUGETC(CHOPT,LOPT)
-
-#include "hepdb/hdboptc.inc"
-
-*
-* Find out the unit number for this file
-*
- NCLOSD = 0
- IF(LQRS.EQ.0) GOTO 30
- LRZ = LQRS
- 10 IF(LRZ.EQ.0) GOTO 30
- CALL ZITOH(IQ(KQSP+LRZ+1),IHDIR,4)
- CALL UHTOC(IHDIR,4,CHNAME,16)
- LN = LENOCC(CHNAME)
- IF(CHNAME(1:LN).EQ.CHTOP(1:LTOP).OR.IOPTA.NE.0) THEN
- LUNDB = IQ(KQSP+LRZ-5)
- IF(LUNDB.EQ.0) GOTO 20
- IF(LLOGCD.GE.0) WRITE(LPRTCD,*) 'CDCLSC. closing ',
- + CHNAME(1:LN),' on unit ',LUNDB
- CALL RZCLOS(CHNAME(1:LN),' ')
- NCLOSD = NCLOSD + 1
-*
-* Free the logical unit
-*
- CALL CDFLUN(LUNDB,IRC)
- ENDIF
-
- 20 CONTINUE
- LRZ=LQ(KQSP+LRZ)
- GO TO 10
- 30 CONTINUE
-
- IF(IOPTA.EQ.0.AND.NCLOSD.EQ.0) THEN
- IF(LLOGCD.GE.-3) WRITE(LPRTCD,*) 'CDCLSC. file with ',
- + 'top directory ',CHTOP(1:LTOP),' is not open'
- ENDIF
-
- IF(LLOGCD.GE.0) WRITE(LPRTCD,*) 'CDCLSC. closed ',
- + NCLOSD,' file(s)'
-
- END
diff --git a/src/packlib/hepdb/programs/hepdb/cdexit.F b/src/packlib/hepdb/programs/hepdb/cdexit.F
deleted file mode 100644
index 4f26899..0000000
--- a/src/packlib/hepdb/programs/hepdb/cdexit.F
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: cdexit.F,v 1.2 1996/03/12 13:08:33 cernlib Exp $
-*
-* $Log: cdexit.F,v $
-* Revision 1.2 1996/03/12 13:08:33 cernlib
-* Build hepdb programs: hepdb, cdserv, cdnew, and cdmove
-*
-* Revision 1.1.1.1 1996/02/28 16:23:27 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDEXIT
-*
-* Clean termination - close all HEPDB files
-*
- CALL CDEND(' ','AC',IRC)
-*
-* and now any remaining RZ files...
-*
- CALL RZCLOS(' ','A')
-
- END
diff --git a/src/packlib/hepdb/programs/hepdb/cdextq.F b/src/packlib/hepdb/programs/hepdb/cdextq.F
deleted file mode 100644
index 515fa00..0000000
--- a/src/packlib/hepdb/programs/hepdb/cdextq.F
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: cdextq.F,v 1.2 1996/03/12 13:08:34 cernlib Exp $
-*
-* $Log: cdextq.F,v $
-* Revision 1.2 1996/03/12 13:08:34 cernlib
-* Build hepdb programs: hepdb, cdserv, cdnew, and cdmove
-*
-* Revision 1.1.1.1 1996/02/28 16:23:32 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDEXTQ
-
- PRINT *,'Not yet implemented'
-
- END
diff --git a/src/packlib/hepdb/programs/hepdb/cdfilc.F b/src/packlib/hepdb/programs/hepdb/cdfilc.F
deleted file mode 100644
index 2c064ad..0000000
--- a/src/packlib/hepdb/programs/hepdb/cdfilc.F
+++ /dev/null
@@ -1,43 +0,0 @@
-*
-* $Id: cdfilc.F,v 1.2 1996/03/12 13:08:36 cernlib Exp $
-*
-* $Log: cdfilc.F,v $
-* Revision 1.2 1996/03/12 13:08:36 cernlib
-* Build hepdb programs: hepdb, cdserv, cdnew, and cdmove
-*
-* Revision 1.1.1.1 1996/02/28 16:23:28 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDFILC
-*
-* Show what files are currently attached
-*
-#include "hepdb/cdunit.inc"
-#include "zebra/rzcl.inc"
-#include "zebra/zunit.inc"
-
- CHARACTER*16 CHNAME
- DIMENSION IHDIR(4)
-
- NFILES = 0
- IF(LQRS.EQ.0) GOTO 30
- LRZ = LQRS
- 10 IF(LRZ.EQ.0) GOTO 30
- CALL ZITOH(IQ(KQSP+LRZ+1),IHDIR,4)
- CALL UHTOC(IHDIR,4,CHNAME,16)
- LN = LENOCC(CHNAME)
- LUNDB = IQ(KQSP+LRZ-5)
- IF(LUNDB.EQ.0) GOTO 20
- NFILES = NFILES + 1
- WRITE(LOUTCD,9001) NFILES,LUNDB,CHNAME(1:LN)
-9001 FORMAT(' File # ',I3.3,', unit: ',I4.4,', top directory: ',A16)
- 20 CONTINUE
- LRZ=LQ(KQSP+LRZ)
- GO TO 10
- 30 CONTINUE
-
- WRITE(LOUTCD,*) 'CDFILC. ',NFILES,' file(s) are attached'
-
- END
diff --git a/src/packlib/hepdb/programs/hepdb/cdkali.F b/src/packlib/hepdb/programs/hepdb/cdkali.F
deleted file mode 100644
index 38dab30..0000000
--- a/src/packlib/hepdb/programs/hepdb/cdkali.F
+++ /dev/null
@@ -1,40 +0,0 @@
-*
-* $Id: cdkali.F,v 1.2 1996/03/12 13:08:37 cernlib Exp $
-*
-* $Log: cdkali.F,v $
-* Revision 1.2 1996/03/12 13:08:37 cernlib
-* Build hepdb programs: hepdb, cdserv, cdnew, and cdmove
-*
-* Revision 1.1.1.1 1996/02/28 16:23:32 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDKALI
-
- CHARACTER*255 CHPATH
- CHARACTER*8 CHOPT,CHALIA
-
- CALL KUGETC(CHPATH,LPATH)
- CALL KUGETC(CHALIA,LALIA)
- CALL KUGETC(CHOPT,LOPT)
-
- IF(LOPT.GT.1) THEN
- PRINT *,'CDKALI. error - please specify only 1 option'
- RETURN
- ENDIF
-
- IF(CHOPT.EQ.'R'.AND.LPATH.GT.0.AND.LALIA.EQ.0) THEN
- CHALIA = CHPATH(1:LPATH)
- LALIA = LPATH
- CHPATH = ' '
- ENDIF
-
- CALL CDALIA(CHPATH,CHALIA,CHOPT,IRC)
-
- IF(CHOPT(1:LOPT).EQ.'R') THEN
- PRINT *,'CDKALI. equivalence name for ',CHALIA(1:LALIA),
- + ' is ',CHPATH(1:LENOCC(CHPATH))
- ENDIF
-
- END
diff --git a/src/packlib/hepdb/programs/hepdb/cdkhlp.F b/src/packlib/hepdb/programs/hepdb/cdkhlp.F
deleted file mode 100644
index f33a9a8..0000000
--- a/src/packlib/hepdb/programs/hepdb/cdkhlp.F
+++ /dev/null
@@ -1,39 +0,0 @@
-*
-* $Id: cdkhlp.F,v 1.2 1996/03/12 13:08:38 cernlib Exp $
-*
-* $Log: cdkhlp.F,v $
-* Revision 1.2 1996/03/12 13:08:38 cernlib
-* Build hepdb programs: hepdb, cdserv, cdnew, and cdmove
-*
-* Revision 1.1.1.1 1996/02/28 16:23:32 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDKHLP
- CHARACTER*255 CHPATH,CHFILE
- CHARACTER*8 CHOPT
-
- CALL KUGETC(CHPATH,LPATH)
- CALL KUGETC(CHFILE,LFILE)
- CALL KUGETC(CHOPT, LOPT)
-
- IF(LOPT.EQ.0) THEN
- LOPT = 1
- CHOPT = ' '
- ENDIF
-
- IOPTR = INDEX(CHOPT(1:LOPT),'R')
- IOPTW = INDEX(CHOPT(1:LOPT),'R')
- IF(IOPTR+IOPTW.NE.0) THEN
- CALL CDGLUN(LUN,IRC)
- ELSE
- LUN = 6
- ENDIF
-
- CALL CDHELP(LUN,CHFILE(1:LFILE),CHPATH(1:LPATH),
- + CHOPT(1:LOPT),IRC)
-
- IF(LUN.NE.6) CALL CDFLUN(LUN,RC)
-
- END
diff --git a/src/packlib/hepdb/programs/hepdb/cdkpak.F b/src/packlib/hepdb/programs/hepdb/cdkpak.F
deleted file mode 100644
index 93733ba..0000000
--- a/src/packlib/hepdb/programs/hepdb/cdkpak.F
+++ /dev/null
@@ -1,57 +0,0 @@
-*
-* $Id: cdkpak.F,v 1.2 1996/03/12 13:08:39 cernlib Exp $
-*
-* $Log: cdkpak.F,v $
-* Revision 1.2 1996/03/12 13:08:39 cernlib
-* Build hepdb programs: hepdb, cdserv, cdnew, and cdmove
-*
-* Revision 1.1.1.1 1996/02/28 16:23:32 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDKPAK
-#include "hepdb/cdunit.inc"
-#include "hepdb/slate.inc"
- CHARACTER*20 CHOPT
-
- CALL KUGETI(IDATE)
- CALL KUGETI(ITIME)
- CALL KUGETC(CHOPT,LCHOPT)
-
- IF(LCHOPT.EQ.0) THEN
- IOPTS = 0
- ELSE
- IOPTS = INDEX(CHOPT(1:LCHOPT),'S')
- ENDIF
-
- IF(IDATE.EQ.0.AND.ITIME.EQ.0) THEN
- CALL DATIME(IDATE,ITIME)
- IF(IOPTS.NE.0) ITIME = ITIME*100 + IS(6)
- ENDIF
-
- IF(IOPTS.EQ.0) THEN
-
- CALL CDPKTM(IDATE,ITIME,IPACK,IRC)
-
- ELSE
-
- CALL CDPKTS(IDATE,ITIME,IPACK,IRC)
-
- ENDIF
-
- IF(IRC.EQ.0) THEN
-
- WRITE(LOUTCD,9001) IDATE,ITIME,IPACK
-
- ELSE
-
- WRITE(LOUTCD,9002) IRC,IDATE,ITIME
-
- ENDIF
-
-9001 FORMAT(' CDKPAK. packed value of ',I6,1X,I6,' is ',I10)
-
-9002 FORMAT(' CDKPAK. error ',I3,' packing ',I6,1X,I6)
-
- END
diff --git a/src/packlib/hepdb/programs/hepdb/cdkpwd.F b/src/packlib/hepdb/programs/hepdb/cdkpwd.F
deleted file mode 100644
index db1db23..0000000
--- a/src/packlib/hepdb/programs/hepdb/cdkpwd.F
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: cdkpwd.F,v 1.2 1996/03/12 13:08:40 cernlib Exp $
-*
-* $Log: cdkpwd.F,v $
-* Revision 1.2 1996/03/12 13:08:40 cernlib
-* Build hepdb programs: hepdb, cdserv, cdnew, and cdmove
-*
-* Revision 1.1.1.1 1996/02/28 16:23:32 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDKPWD
-
- CHARACTER*8 CHOPT
-
- CALL KUGETC(CHOPT,LOPT)
- CALL CDPWD(CHOPT)
-
- END
diff --git a/src/packlib/hepdb/programs/hepdb/cdktxt.F b/src/packlib/hepdb/programs/hepdb/cdktxt.F
deleted file mode 100644
index b6f5f04..0000000
--- a/src/packlib/hepdb/programs/hepdb/cdktxt.F
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: cdktxt.F,v 1.2 1996/03/12 13:08:41 cernlib Exp $
-*
-* $Log: cdktxt.F,v $
-* Revision 1.2 1996/03/12 13:08:41 cernlib
-* Build hepdb programs: hepdb, cdserv, cdnew, and cdmove
-*
-* Revision 1.1.1.1 1996/02/28 16:23:32 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDKTXT
-*
-* Enter text file into the database
-*
- END
diff --git a/src/packlib/hepdb/programs/hepdb/cdkupk.F b/src/packlib/hepdb/programs/hepdb/cdkupk.F
deleted file mode 100644
index 9a841e1..0000000
--- a/src/packlib/hepdb/programs/hepdb/cdkupk.F
+++ /dev/null
@@ -1,51 +0,0 @@
-*
-* $Id: cdkupk.F,v 1.2 1996/03/12 13:08:42 cernlib Exp $
-*
-* $Log: cdkupk.F,v $
-* Revision 1.2 1996/03/12 13:08:42 cernlib
-* Build hepdb programs: hepdb, cdserv, cdnew, and cdmove
-*
-* Revision 1.1.1.1 1996/02/28 16:23:33 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDKUPK
-#include "hepdb/cdunit.inc"
-#include "hepdb/slate.inc"
- CHARACTER*20 CHOPT
-
- CALL KUGETI(IPACK)
- CALL KUGETC(CHOPT,LCHOPT)
-
- IF(LCHOPT.EQ.0) THEN
- IOPTS = 0
- ELSE
- IOPTS = INDEX(CHOPT(1:LCHOPT),'S')
- ENDIF
-
- IF(IOPTS.EQ.0) THEN
-
- CALL CDUPTM(IDATE,ITIME,IPACK,IRC)
-
- ELSE
-
- CALL CDUPTS(IDATE,ITIME,IPACK,IRC)
-
- ENDIF
-
- IF(IRC.EQ.0) THEN
-
- WRITE(LOUTCD,9001) IPACK,IDATE,ITIME
-
- ELSE
-
- WRITE(LOUTCD,9002) IRC,IPACK
-
- ENDIF
-
-9001 FORMAT(' CDUKPK. unpacked value of ',I10,' is ',I6,1X,I6)
-
-9002 FORMAT(' CDUKPK. error ',I3,' unpacking ',I10)
-
- END
diff --git a/src/packlib/hepdb/programs/hepdb/cdldc.F b/src/packlib/hepdb/programs/hepdb/cdldc.F
deleted file mode 100644
index 5d70ec6..0000000
--- a/src/packlib/hepdb/programs/hepdb/cdldc.F
+++ /dev/null
@@ -1,95 +0,0 @@
-*
-* $Id: cdldc.F,v 1.2 1996/03/12 13:08:43 cernlib Exp $
-*
-* $Log: cdldc.F,v $
-* Revision 1.2 1996/03/12 13:08:43 cernlib
-* Build hepdb programs: hepdb, cdserv, cdnew, and cdmove
-*
-* Revision 1.1.1.1 1996/02/28 16:23:29 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDLDC
-#include "hepdb/cdunit.inc"
- CHARACTER*255 CHPATH,PATH,CHDIR
- CHARACTER*12 CHOPT
-#include "hepdb/quest.inc"
-#include "hepdb/cdopen.inc"
-*
-* List contents of current directory
-* Options: C - creation date & time
-* M - modification date & time
-* O - number of objects
-* R - list subdirectories recursively
-* S - number of subdirectories
-* T - tags
-*
- CHOPT = ' '
- CALL KUGETC(PATH,LPATH)
- CALL CDFIXF(PATH,CHPATH)
- LPATH = LENOCC(CHPATH)
- CALL KUGETI(NLEVEL)
- CALL KUGETC(CHOPT,LCHOPT)
-
-* Save current directory
-*
- CALL RZCDIR(CHDIR,'R')
- LCHDIR = LENOCC(CHDIR)
-
- IF(LCHOPT.EQ.0) THEN
- LCHOPT = 1
- CHOPT = ' '
- ENDIF
-*
- IF(INDEX(CHOPT(1:LCHOPT),'H').NE.0) THEN
- WRITE(LOUTCD,*) '>>> Command: LD ',
- + 'Options: ',CHOPT(1:LCHOPT)
- WRITE(LOUTCD,*) '>>> Path: ',CHPATH(1:LPATH)
- WRITE(LOUTCD,*) '>>> Current directory: ',CHDIR(1:LCHDIR)
- ENDIF
-*
-* Turn on option R if NLEVEL > 1
-*
- IF(NLEVEL.GT.1) CHOPT = 'R'
- IF(INDEX(CHOPT,'R').EQ.0) THEN
- IWILD = ICFMUL('*%()<>',CHPATH,1,LPATH)
- IF(IWILD.LE.LPATH) THEN
- ISLASH = INDEXB(CHPATH(1:IWILD),'/') + 1
-*
-* Turn on option R if more than one level of wild-cards
-*
- IF(INDEX(CHPATH(ISLASH:LPATH),'/').NE.0) THEN
- LCH = LENOCC(CHOPT)
- LCH = LCH + 1
- CHOPT(LCH:LCH) = 'R'
- ENDIF
-
- ENDIF
- ELSE
-*
-* Set maximum number of levels if -R and NLEVEL=1 (default)
-*
- IF(NLEVEL.EQ.1) NLEVEL = 99
- ENDIF
-
- CALL CDLDIR(CHPATH(1:LPATH),LOUTCD,NLEVEL,CHOPT,IRET)
-
- NDIR = IQUEST(11)
- NMAT = IQUEST(12)
-
- IF(NDIR.NE.0) THEN
- WRITE(LOUTCD,9001) NDIR,NMAT
- ELSE
- WRITE(LOUTCD,9002)
- ENDIF
-*
-* Reset current directory
-*
- CALL RZCDIR(CHDIR(1:LCHDIR),'U')
-
- 9001 FORMAT(' Total of ',I10,' subdirectories of which ',
- + I10,' match')
- 9002 FORMAT(' No subdirectories found')
-
- END
diff --git a/src/packlib/hepdb/programs/hepdb/cdlogc.F b/src/packlib/hepdb/programs/hepdb/cdlogc.F
deleted file mode 100644
index 29a6a71..0000000
--- a/src/packlib/hepdb/programs/hepdb/cdlogc.F
+++ /dev/null
@@ -1,35 +0,0 @@
-*
-* $Id: cdlogc.F,v 1.2 1996/03/12 13:08:45 cernlib Exp $
-*
-* $Log: cdlogc.F,v $
-* Revision 1.2 1996/03/12 13:08:45 cernlib
-* Build hepdb programs: hepdb, cdserv, cdnew, and cdmove
-*
-* Revision 1.1.1.1 1996/02/28 16:23:28 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDLOGC
-
- CHARACTER*255 CHPATH
- CHARACTER*8 CHOPT
-
- CALL KUGETC(CHPATH,LPATH)
- CALL KUGETI(LOGL)
- CALL KUGETC(CHOPT,LOPT)
-
- IF(LPATH.EQ.0) THEN
- CHPATH = ' '
- LPATH = 1
- ENDIF
-
- IF(LOPT.EQ.0) THEN
- CHOPT = ' '
- LOPT = 1
- ENDIF
-
- CALL CDLOGL(CHPATH(1:LPATH),LOGL,CHOPT(1:LOPT),IRC)
-
-
- END
diff --git a/src/packlib/hepdb/programs/hepdb/cdlsc.F b/src/packlib/hepdb/programs/hepdb/cdlsc.F
deleted file mode 100644
index f373c4a..0000000
--- a/src/packlib/hepdb/programs/hepdb/cdlsc.F
+++ /dev/null
@@ -1,79 +0,0 @@
-*
-* $Id: cdlsc.F,v 1.2 1996/03/12 13:08:46 cernlib Exp $
-*
-* $Log: cdlsc.F,v $
-* Revision 1.2 1996/03/12 13:08:46 cernlib
-* Build hepdb programs: hepdb, cdserv, cdnew, and cdmove
-*
-* Revision 1.1.1.1 1996/02/28 16:23:31 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDLSC
- CHARACTER*255 PATH,CHPATH,CHDIR
- CHARACTER*36 CHOPT
-#include "hepdb/cdunit.inc"
-#include "hepdb/hdboptd.inc"
-#include "hepdb/hdbopt.inc"
-#include "hepdb/cdlscm.inc"
- EXTERNAL CDLS
-#include "hepdb/cdopen.inc"
-*
-
- NOBJT = 0
- NDIRT = 0
- NOBJM = 0
-
- CALL RZCDIR(CHDIR,'R')
- LCHDIR = LENOCC(CHDIR)
-
- CALL KUGETC(PATH,LPATH)
- CALL KUGETI(KSN)
- NKEYSN = KSN
- CALL KUGETC(CHBANK,LBANK)
- CALL KUGETI(ILNK1)
- CALL KUGETI(ILNK2)
- CALL KUGETI(IDAT1)
- CALL KUGETI(IDAT2)
- CALL KUGETC(CHOPT,LCHOPT)
- CALL CDFIXF(PATH,CHPATH)
- LPATH = LENOCC(CHPATH)
-
- IF(LCHOPT.GT.0) THEN
- CHOPTT = CHOPT(1:LCHOPT)
- ELSE
- CHOPTT = ' '
- ENDIF
-
-#include "hepdb/hdboptc.inc"
-*
-* Look for objects in specified path
-*
- IF(LLOGCD.GE.2) PRINT *,'CDLSC. enter for ',CHPATH(1:LPATH),
- + ',',CHOPT
-*
- IF(IOPTH.NE.0) THEN
- WRITE(LOUTCD,*) '>>> Command: LS ',
- + 'Options: ',CHOPT(1:LCHOPT),' key serial number: ',KSN
- WRITE(LOUTCD,*) '>>> Path: ',CHPATH(1:LPATH)
- WRITE(LOUTCD,*) '>>> Current directory: ',
- + CHDIR(1:LCHDIR)
- WRITE(LOUTCD,*) '>>> Bank name: ',CHBANK,
- + ' first/last links,data words = ',ILNK1,ILNK2,IDAT1,IDAT2
- ENDIF
-*
- IF(ICFMUL('*%(<>[]',CHPATH,1,LPATH).GT.LPATH) THEN
- CALL RZCDIR(CHPATH(1:LPATH),' ')
- CALL CDLS(CHPATH(1:LPATH),IRC)
- ELSE
- CALL CDSCAN(CHPATH(1:LPATH),99,CDLS,IRC)
- ENDIF
-
- WRITE(LOUTCD,9001) NOBJT,NDIRT,NOBJM
- 9001 FORMAT(' Total of ',I6,' objects in ',I6,' directories',
- + ' of which ',I6,' match selection criteria')
-
- CALL RZCDIR(CHDIR(1:LCHDIR),' ')
-
- END
diff --git a/src/packlib/hepdb/programs/hepdb/cdmerg.F b/src/packlib/hepdb/programs/hepdb/cdmerg.F
deleted file mode 100644
index 5d579dd..0000000
--- a/src/packlib/hepdb/programs/hepdb/cdmerg.F
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: cdmerg.F,v 1.2 1996/03/12 13:08:48 cernlib Exp $
-*
-* $Log: cdmerg.F,v $
-* Revision 1.2 1996/03/12 13:08:48 cernlib
-* Build hepdb programs: hepdb, cdserv, cdnew, and cdmove
-*
-* Revision 1.1.1.1 1996/02/28 16:23:30 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDMERG
-
- PRINT *,'Not yet implemented'
-
- END
diff --git a/src/packlib/hepdb/programs/hepdb/cdmkdr.F b/src/packlib/hepdb/programs/hepdb/cdmkdr.F
deleted file mode 100644
index e353761..0000000
--- a/src/packlib/hepdb/programs/hepdb/cdmkdr.F
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: cdmkdr.F,v 1.2 1996/03/12 13:08:49 cernlib Exp $
-*
-* $Log: cdmkdr.F,v $
-* Revision 1.2 1996/03/12 13:08:49 cernlib
-* Build hepdb programs: hepdb, cdserv, cdnew, and cdmove
-*
-* Revision 1.1.1.1 1996/02/28 16:23:30 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDMKDR
-
- PRINT *,'Not yet implemented'
-
- END
diff --git a/src/packlib/hepdb/programs/hepdb/cdobjc.F b/src/packlib/hepdb/programs/hepdb/cdobjc.F
deleted file mode 100644
index 47d13e7..0000000
--- a/src/packlib/hepdb/programs/hepdb/cdobjc.F
+++ /dev/null
@@ -1,74 +0,0 @@
-*
-* $Id: cdobjc.F,v 1.2 1996/03/12 13:08:51 cernlib Exp $
-*
-* $Log: cdobjc.F,v $
-* Revision 1.2 1996/03/12 13:08:51 cernlib
-* Build hepdb programs: hepdb, cdserv, cdnew, and cdmove
-*
-* Revision 1.1.1.1 1996/02/28 16:23:31 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDOBJC
-
-#include "hepdb/cdunit.inc"
-
- CHARACTER*255 PATH,CHPATH,CHDIR
- CHARACTER*255 PATH2
- CHARACTER*36 CHOPT
-#include "hepdb/cdoccm.inc"
- EXTERNAL CDOBJX
-#include "hepdb/cdopen.inc"
-*
- CALL RZCDIR(CHDIR,'R')
- LCHDIR = LENOCC(CHDIR)
-
- PATH = ' '
- CALL KUGETC(PATH,LPATH)
- CALL KUGETC(CHOPT,LCHOPT)
-
- CALL CDFIXF(PATH,CHPATH)
- LPATH = LENOCC(CHPATH)
-
- IF(LCHOPT.EQ.0) THEN
- CHOPT = ' '
- LCHOPT = 1
- ENDIF
-
- IF(INDEX(CHOPT(1:LCHOPT),'H').NE.0) THEN
- WRITE(LOUTCD,*) '>>> Command: COUNT ',
- + 'Options: ',CHOPT(1:LCHOPT)
- WRITE(LOUTCD,*) '>>> Path: ',PATH(1:LPATH)
- WRITE(LOUTCD,*) '>>> Current directory: ',CHDIR(1:LCHDIR)
- ENDIF
-*
-
-
- IOPTD = 0
- IOPTF = 0
- IOPTL = 0
- IOPTZ = 0
- IF(INDEX(CHOPT(1:LCHOPT),'D').NE.0) IOPTD = 1
- IF(INDEX(CHOPT(1:LCHOPT),'F').NE.0) IOPTF = 1
- IF(INDEX(CHOPT(1:LCHOPT),'L').NE.0) IOPTL = 1
- IF(INDEX(CHOPT(1:LCHOPT),'Z').NE.0) IOPTZ = 1
-
- IF(IOPTL.NE.0) IOPTD = 1
- IF(IOPTZ.NE.0) IOPTF = 1
-*
- NFOUND = 0
- NMATCH = 0
- NDIRT = 0
-
- CALL CDSCAN(CHPATH(1:LPATH),99,CDOBJX,IRC)
-
- IF(LLOGCD.GE.-2) THEN
- WRITE(LOUTCD,9001) NFOUND,NDIRT
- 9001 FORMAT(' Total of ',I6,' objects in ',I6,
- + ' directories')
- ENDIF
-
- CALL RZCDIR(CHDIR(1:LCHDIR),' ')
- RETURN
- END
diff --git a/src/packlib/hepdb/programs/hepdb/cdopnc.F b/src/packlib/hepdb/programs/hepdb/cdopnc.F
deleted file mode 100644
index cd2df48..0000000
--- a/src/packlib/hepdb/programs/hepdb/cdopnc.F
+++ /dev/null
@@ -1,81 +0,0 @@
-*
-* $Id: cdopnc.F,v 1.3 1996/04/01 08:16:17 jamie Exp $
-*
-* $Log: cdopnc.F,v $
-* Revision 1.3 1996/04/01 08:16:17 jamie
-* change idiv from 0 to 20
-*
-* Revision 1.2 1996/03/12 13:08:52 cernlib
-* Build hepdb programs: hepdb, cdserv, cdnew, and cdmove
-*
-* Revision 1.1.1.1 1996/02/28 16:23:28 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDOPNC
-#include "hepdb/cdunit.inc"
-#include "hepdb/quest.inc"
-*
-* Open a HEPDB file
-*
- CHARACTER*16 CHTOP
- CHARACTER*2 CHPREF
- CHARACTER*255 CHFILE
- CHARACTER*26 CHOPT
-
- DATA NENTRY/0/
- SAVE NENTRY,LUNFZ
-
- IF(NENTRY.EQ.0) THEN
- CALL CDGLUN(LUNFZ,IRC)
- NENTRY = 1
- IDIV = 20
- ENDIF
-
- CALL KUGETC(CHPREF,LPREF)
- CALL KUGETS(CHFILE,LFILE)
- CALL KUGETC(CHOPT,LOPT)
-*
-* Get a FORTRAN unit
-*
- CALL CDGLUN(LUNCD,IRC)
-
- IF(IRC.NE.0) THEN
- IF(LLOGCD.GT.-3) WRITE(LPRTCD,*) 'CDOPNC. could not ',
- + 'allocate FORTRAN unit to open file'
- RETURN
- ENDIF
-
- IF(LLOGCD.GE.3) WRITE(LPRTCD,*) 'CDOPNC. allocated FORTRAN unit ',
- + LUNCD
-*
-* Get database file name from prefix
-*
- IF(LFILE.EQ.0) THEN
- CALL CDPREF(LUNCD,CHPREF,CHTOP,CHFILE,IRC)
- LFILE = LENOCC(CHFILE)
- ELSE
- CHTOP = 'CD'//CHPREF
- ENDIF
-
- LTOP = LENOCC(CHTOP)
-*
-* Open the database file
-*
- LRECL = 0
- CALL CDOPEN(LUNCD,LUNFZ,CHTOP,CHFILE,LRECL,IDIV,' ',IRC)
- IF(IRC.EQ.0) THEN
- IF(LLOGCD.GE.0) WRITE(LPRTCD,9001) CHFILE(1:LFILE),LUNCD,
- + CHTOP(1:LTOP),LRECL
- ELSE
- IF(LLOGCD.GT.-3) WRITE(LPRTCD,9002) IRC,CHFILE(1:LFILE),LUNCD,
- + CHTOP(1:LTOP),LRECL
- ENDIF
-
-9001 FORMAT(' CDOPNC. opened file ',A,' on unit ',I2,
- + ' with top directory ',A,' and record length ',I6)
-9002 FORMAT(' CDOPNC. error ',I6,' opening file ',A,' on unit ',I2,
- + ' with top directory ',A,' and record length ',I6)
-
- END
diff --git a/src/packlib/hepdb/programs/hepdb/cdoutp.F b/src/packlib/hepdb/programs/hepdb/cdoutp.F
deleted file mode 100644
index 8a62707..0000000
--- a/src/packlib/hepdb/programs/hepdb/cdoutp.F
+++ /dev/null
@@ -1,131 +0,0 @@
-*
-* $Id: cdoutp.F,v 1.2 1996/03/12 13:08:53 cernlib Exp $
-*
-* $Log: cdoutp.F,v $
-* Revision 1.2 1996/03/12 13:08:53 cernlib
-* Build hepdb programs: hepdb, cdserv, cdnew, and cdmove
-*
-* Revision 1.1.1.1 1996/02/28 16:23:28 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDOUTP
-#include "hepdb/cdunit.inc"
-#include "zebra/zunit.inc"
-#if defined(CERNLIB_IBMMVS)
- DIMENSION DISP(3)
- DIMENSION SPACE(4)
- CHARACTER*8 CHUNIT
-#endif
- CHARACTER*3 CHSTAT
- LOGICAL IEXIST,ISOPEN
- CHARACTER*255 CHFILE
- CHARACTER*8 CHOPT
-#include "hepdb/hdboptd.inc"
-
-#if (defined(CERNLIB_IBMMVS))&&(defined(CERNLIB_NEWLIB))
- CHUNIT = 'FAST'
- LUNIT = 4
-#endif
-#if (defined(CERNLIB_IBMMVS))&&(defined(CERNLIB_GSI))
- CHUNIT = 'SYSDA'
- LUNIT = 5
-#endif
-
- CALL KUGETS(CHFILE,LFILE)
- CALL KUGETC(CHOPT,LOPT)
-
-#include "hepdb/hdboptc.inc"
-*
-* Close previously opened file
-*
- IF(IOPTC.NE.0) THEN
- INQUIRE(LFILCD,OPENED=ISOPEN)
- IF(.NOT.ISOPEN) THEN
- IF(LLOGCD.GT.3) WRITE(LPRTCD,*) 'CDOUTP. CHFILE has ',
- + 'not yet been redirected'
- RETURN
- ENDIF
- CLOSE(LFILCD)
- ENDIF
-*
-* Switch back to previously opened file
-*
- IF(IOPTS.NE.0) THEN
- INQUIRE(LFILCD,OPENED=ISOPEN)
- IF(.NOT.ISOPEN) THEN
- IF(LLOGCD.GT.3) WRITE(LPRTCD,*) 'CDOUTP. CHFILE has ',
- + 'not yet been redirected'
- RETURN
- ENDIF
- ELSE
- LOUTCD = LFILCD
- IQPRNT = LFILCD
- ENDIF
-*
-* Switch CHFILE back to terminal
-*
- IF(IOPTC.NE.0.OR.IOPTT.NE.0) THEN
- LOUTCD = LPRTCD
- IQPRNT = LPRTCD
- ELSE
-
-#if defined(CERNLIB_UNIX)
-#include "hepdb/cdfold.inc"
-#endif
-#if !defined(CERNLIB_UNIX)
- CALL CLTOU(CHFILE(1:LFILE))
-#endif
-*
-* Open the file
-*
-#if defined(CERNLIB_IBMVM)
- CALL CTRANS('.',' ',CHFILE,1,LFILE)
-#endif
-#if defined(CERNLIB_IBM)
- INQUIRE(FILE='/'//CHFILE(1:LFILE),EXIST=IEXIST)
-#endif
-#if !defined(CERNLIB_IBM)
- INQUIRE(FILE=CHFILE(1:LFILE),EXIST=IEXIST)
-#endif
- IF(IEXIST) THEN
- IF(IOPTR.EQ.0) THEN
- WRITE(LPRTCD,*) 'CDOUTP. file already exists - ',
- + 'use the R option to replace'
- RETURN
- ENDIF
- CHSTAT = 'OLD'
- ELSE
- CHSTAT = 'NEW'
- ENDIF
-#if defined(CERNLIB_IBMVM)
- CALL CTRANS('.',' ',CHFILE,1,LFILE)
- CALL FILEINF(ISTAT,'LRECL',133,'RECFM','F')
- OPEN(LFILCD,FILE='/'//CHFILE(1:LFILE),ACCESS='SEQUENTIAL',
-#endif
-#if defined(CERNLIB_IBMMVS)
- CALL FILEINF(ISTAT,'DEVICE',CHUNIT(1:LUNIT),'TRK',1,
- + 'SECOND',1,'DIR',0,
- + 'RECFM','VBA','LRECL',137,'BLKSIZE',6233)
- OPEN(LFILCD,FILE='/'//CHFILE(1:LFILE),ACCESS='SEQUENTIAL',
- + ACTION='READWRITE',
-#endif
-#if (!defined(CERNLIB_IBMVM))&&(!defined(CERNLIB_IBMMVS))
- OPEN(LFILCD,FILE=CHFILE(1:LFILE),ACCESS='SEQUENTIAL',
-#endif
- + STATUS=CHSTAT,FORM='FORMATTED',IOSTAT=IRC)
-*
-* Was open successful?
-*
- IF(IRC.EQ.0) THEN
- LOUTCD = LFILCD
- IQPRNT = LFILCD
- ELSE
- IF(LLOGCD.GT.-3) WRITE(LPRTCD,*) 'CDOUTP. error ',IRC,
- + ' opening ',CHFILE(1:LFILE)
- ENDIF
-
- ENDIF
-
- END
diff --git a/src/packlib/hepdb/programs/hepdb/cdpwd.F b/src/packlib/hepdb/programs/hepdb/cdpwd.F
deleted file mode 100644
index 9b231aa..0000000
--- a/src/packlib/hepdb/programs/hepdb/cdpwd.F
+++ /dev/null
@@ -1,39 +0,0 @@
-*
-* $Id: cdpwd.F,v 1.2 1996/03/12 13:08:55 cernlib Exp $
-*
-* $Log: cdpwd.F,v $
-* Revision 1.2 1996/03/12 13:08:55 cernlib
-* Build hepdb programs: hepdb, cdserv, cdnew, and cdmove
-*
-* Revision 1.1.1.1 1996/02/28 16:23:28 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDPWD(CHOPT)
-
-#include "hepdb/cdunit.inc"
-
- CHARACTER*255 CHPATH,CHALIA
-#include "hepdb/hdbopts.inc"
-#include "hepdb/cdopen.inc"
-
- CALL RZCDIR(CHPATH,'R')
- LPATH = LENOCC(CHPATH)
-
- IF(IOPTA.NE.0) THEN
- CALL CDALIA(CHPATH(1:LPATH),CHALIA,'G',IRC)
- LALIA = LENOCC(CHALIA)
- IF(LALIA.EQ.0) THEN
- CHALIA = '(none)'
- LALIA = 6
- ENDIF
- WRITE(LOUTCD,9001) CHPATH(1:LPATH),CHALIA(1:LALIA)
-9001 FORMAT(' CDPWD. Current working directory = ',A,/,
- + ' alias = ',A)
- ELSE
- WRITE(LOUTCD,9002) CHPATH(1:LPATH)
-9002 FORMAT(' CDPWD. Current working directory = ',A)
- ENDIF
-
- END
diff --git a/src/packlib/hepdb/programs/hepdb/cdquit.F b/src/packlib/hepdb/programs/hepdb/cdquit.F
deleted file mode 100644
index d849247..0000000
--- a/src/packlib/hepdb/programs/hepdb/cdquit.F
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: cdquit.F,v 1.2 1996/03/12 13:08:56 cernlib Exp $
-*
-* $Log: cdquit.F,v $
-* Revision 1.2 1996/03/12 13:08:56 cernlib
-* Build hepdb programs: hepdb, cdserv, cdnew, and cdmove
-*
-* Revision 1.1.1.1 1996/02/28 16:23:28 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDQUIT
-*
-* Abnormal termination
-*
- END
diff --git a/src/packlib/hepdb/programs/hepdb/cdrmc.F b/src/packlib/hepdb/programs/hepdb/cdrmc.F
deleted file mode 100644
index f1ca883..0000000
--- a/src/packlib/hepdb/programs/hepdb/cdrmc.F
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: cdrmc.F,v 1.2 1996/03/12 13:08:57 cernlib Exp $
-*
-* $Log: cdrmc.F,v $
-* Revision 1.2 1996/03/12 13:08:57 cernlib
-* Build hepdb programs: hepdb, cdserv, cdnew, and cdmove
-*
-* Revision 1.1.1.1 1996/02/28 16:23:29 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDRMC
-
- PRINT *,'Not yet implemented'
-
- END
diff --git a/src/packlib/hepdb/programs/hepdb/cdrmdc.F b/src/packlib/hepdb/programs/hepdb/cdrmdc.F
deleted file mode 100644
index 5424443..0000000
--- a/src/packlib/hepdb/programs/hepdb/cdrmdc.F
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: cdrmdc.F,v 1.2 1996/03/12 13:08:58 cernlib Exp $
-*
-* $Log: cdrmdc.F,v $
-* Revision 1.2 1996/03/12 13:08:58 cernlib
-* Build hepdb programs: hepdb, cdserv, cdnew, and cdmove
-*
-* Revision 1.1.1.1 1996/02/28 16:23:30 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDRMDC
-
- PRINT *,'Not yet implemented'
-
- END
diff --git a/src/packlib/hepdb/programs/hepdb/cdrmtc.F b/src/packlib/hepdb/programs/hepdb/cdrmtc.F
deleted file mode 100644
index 52faf35..0000000
--- a/src/packlib/hepdb/programs/hepdb/cdrmtc.F
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: cdrmtc.F,v 1.2 1996/03/12 13:09:00 cernlib Exp $
-*
-* $Log: cdrmtc.F,v $
-* Revision 1.2 1996/03/12 13:09:00 cernlib
-* Build hepdb programs: hepdb, cdserv, cdnew, and cdmove
-*
-* Revision 1.1.1.1 1996/02/28 16:23:30 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDRMTC
-
- PRINT *,'Not yet implemented'
-
- END
diff --git a/src/packlib/hepdb/programs/hepdb/cdrzld.F b/src/packlib/hepdb/programs/hepdb/cdrzld.F
deleted file mode 100644
index 0e1264d..0000000
--- a/src/packlib/hepdb/programs/hepdb/cdrzld.F
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: cdrzld.F,v 1.2 1996/03/12 13:09:02 cernlib Exp $
-*
-* $Log: cdrzld.F,v $
-* Revision 1.2 1996/03/12 13:09:02 cernlib
-* Build hepdb programs: hepdb, cdserv, cdnew, and cdmove
-*
-* Revision 1.1.1.1 1996/02/28 16:23:29 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDRZLD
-#include "zebra/zunit.inc"
-#include "hepdb/cdunit.inc"
- CHARACTER*255 CHPATH,PATH
- CHARACTER*8 CHOPT
-
-#include "hepdb/cdopen.inc"
-
- CALL KUGETC(PATH,LPATH)
- IF(LPATH.EQ.0) THEN
- CALL RZCDIR(CHPATH,'R')
- ELSE
- CALL CDFIXF(PATH,CHPATH)
- ENDIF
- LPATH = LENOCC(CHPATH)
-
- CALL KUGETC(CHOPT,LCH)
-
- IQSAVE = IQPRNT
-*
-* Call RZLDIR
-*
- IQPRNT = LOUTCD
-
- CALL RZLDIR(PATH(1:LPATH),CHOPT)
-
- IQPRNT = IQSAVE
-
- END
diff --git a/src/packlib/hepdb/programs/hepdb/cdrzop.F b/src/packlib/hepdb/programs/hepdb/cdrzop.F
deleted file mode 100644
index 85e3ca9..0000000
--- a/src/packlib/hepdb/programs/hepdb/cdrzop.F
+++ /dev/null
@@ -1,81 +0,0 @@
-*
-* $Id: cdrzop.F,v 1.2 1996/03/12 13:09:03 cernlib Exp $
-*
-* $Log: cdrzop.F,v $
-* Revision 1.2 1996/03/12 13:09:03 cernlib
-* Build hepdb programs: hepdb, cdserv, cdnew, and cdmove
-*
-* Revision 1.1.1.1 1996/02/28 16:23:31 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDRZOP
-#include "hepdb/cdunit.inc"
-#include "hepdb/quest.inc"
-*
-* Open a HEPDB file
-*
- CHARACTER*16 CHTOP
- CHARACTER*255 CHFILE
- CHARACTER*26 CHOPT
-
- CALL KUGETC(CHTOP,LTOP)
- CALL KUGETS(CHFILE,LFILE)
- CALL KUGETC(CHOPT,LOPT)
-*
-* Get a FORTRAN unit
-*
- CALL CDGLUN(LUNDB,IRC)
-
- IF(IRC.NE.0) THEN
- IF(LLOGCD.GT.-3) WRITE(LPRTCD,*) 'CDRZOP. could not ',
- + 'allocate FORTRAN unit to open file'
- RETURN
- ENDIF
-
- IF(LLOGCD.GE.3) WRITE(LPRTCD,*) 'CDRZOP. allocated FORTRAN unit ',
- + LUNDB
-*
-* Build top directory name, if required
-*
- IF(LTOP.EQ.0) THEN
- IF(LUNDB.LT.10) THEN
- WRITE(CHTOP,9001) LUNDB
- LTOP = 4
- ELSE
- WRITE(CHTOP,9002) LUNDB
- LTOP = 5
- ENDIF
- 9001 FORMAT('LUN',I1)
- 9002 FORMAT('LUN',I2)
- ENDIF
-*
-* Open the file
-*
- IF(LLOGCD.GE.3) WRITE(LPRTCD,*) 'CDRZOP. call RZOPEN for ',
- + 'LUN = ',LUNDB,' CHTOP = ',CHTOP,' CHFILE = ',
- + CHFILE(1:LFILE),' options = ',CHOPT(1:LOPT)
-
- LRECL = 0
- CALL RZOPEN(LUNDB,CHTOP(1:LTOP),CHFILE(1:LFILE),
- + CHOPT(1:LOPT),LRECL,IRC)
-
- IF(IRC.NE.0.AND.LLOGCD.GT.-3) THEN
- WRITE(LPRTCD,*) 'CDRZOP. cannot open ',CHFILE(1:LFILE),
- + ' return code from RZOPEN = ',IRC
- CALL CDFLUN(LUNDB,IRC)
- ELSEIF(IRC.EQ.0.AND.LLOGCD.GE.0) THEN
- WRITE(LPRTCD,*) 'CDRZOP. opened file ',CHFILE(1:LFILE),
- + ', top directory = ',CHTOP(1:LTOP)
-*
-* Issue RZFILE
-*
- CALL RZFILE(LUNDB,CHTOP(1:LTOP),CHOPT(1:LOPT))
- IF(IQUEST(1).NE.0.AND.LLOGCD.GT.-3) THEN
- WRITE(LPRTCD,*) 'CDRZOP. return code from RZFILE = ',
- + IQUEST(1)
- ENDIF
- ENDIF
-
- END
diff --git a/src/packlib/hepdb/programs/hepdb/cdrzst.F b/src/packlib/hepdb/programs/hepdb/cdrzst.F
deleted file mode 100644
index 3329dce..0000000
--- a/src/packlib/hepdb/programs/hepdb/cdrzst.F
+++ /dev/null
@@ -1,40 +0,0 @@
-*
-* $Id: cdrzst.F,v 1.2 1996/03/12 13:09:04 cernlib Exp $
-*
-* $Log: cdrzst.F,v $
-* Revision 1.2 1996/03/12 13:09:04 cernlib
-* Build hepdb programs: hepdb, cdserv, cdnew, and cdmove
-*
-* Revision 1.1.1.1 1996/02/28 16:23:31 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDRZST
-
-#include "hepdb/cdunit.inc"
-#include "zebra/zunit.inc"
-
- CHARACTER*255 CHPATH,PATH
- CHARACTER*8 CHOPT
- INTEGER NLEVEL,IQSAVE
-
-#include "hepdb/cdopen.inc"
-
- CALL KUGETC(PATH,LPATH)
-
- CALL CDFIXF(PATH,CHPATH)
- LPATH = LENOCC(CHPATH)
-
- CALL KUGETI(NLEVEL)
- CALL KUGETC(CHOPT,LOPT)
-
- IQSAVE = IQPRNT
-
- IQPRNT = LOUTCD
-
- CALL RZSTAT(CHPATH(1:LPATH),NLEVEL,CHOPT)
-
- IQPRINT = IQSAVE
-
- END
diff --git a/src/packlib/hepdb/programs/hepdb/cdseac.F b/src/packlib/hepdb/programs/hepdb/cdseac.F
deleted file mode 100644
index 35fad77..0000000
--- a/src/packlib/hepdb/programs/hepdb/cdseac.F
+++ /dev/null
@@ -1,14 +0,0 @@
-*
-* $Id: cdseac.F,v 1.2 1996/03/12 13:09:05 cernlib Exp $
-*
-* $Log: cdseac.F,v $
-* Revision 1.2 1996/03/12 13:09:05 cernlib
-* Build hepdb programs: hepdb, cdserv, cdnew, and cdmove
-*
-* Revision 1.1.1.1 1996/02/28 16:23:31 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDSEAC
- END
diff --git a/src/packlib/hepdb/programs/hepdb/cdsele.F b/src/packlib/hepdb/programs/hepdb/cdsele.F
deleted file mode 100644
index f73231a..0000000
--- a/src/packlib/hepdb/programs/hepdb/cdsele.F
+++ /dev/null
@@ -1,14 +0,0 @@
-*
-* $Id: cdsele.F,v 1.2 1996/03/12 13:09:07 cernlib Exp $
-*
-* $Log: cdsele.F,v $
-* Revision 1.2 1996/03/12 13:09:07 cernlib
-* Build hepdb programs: hepdb, cdserv, cdnew, and cdmove
-*
-* Revision 1.1.1.1 1996/02/28 16:23:31 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDSELE
- END
diff --git a/src/packlib/hepdb/programs/hepdb/cdtree.F b/src/packlib/hepdb/programs/hepdb/cdtree.F
deleted file mode 100644
index d62a3cb..0000000
--- a/src/packlib/hepdb/programs/hepdb/cdtree.F
+++ /dev/null
@@ -1,43 +0,0 @@
-*
-* $Id: cdtree.F,v 1.2 1996/03/12 13:09:09 cernlib Exp $
-*
-* $Log: cdtree.F,v $
-* Revision 1.2 1996/03/12 13:09:09 cernlib
-* Build hepdb programs: hepdb, cdserv, cdnew, and cdmove
-*
-* Revision 1.1.1.1 1996/02/28 16:23:29 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDTREE
-#include "hepdb/cdunit.inc"
-#include "hepdb/quest.inc"
- CHARACTER*255 PATH,PATH1
- CHARACTER*8 CHOPT
-
-#include "hepdb/cdopen.inc"
-
- CALL KUGETC(PATH1,LPATH)
- IF(LPATH.EQ.0) THEN
- CALL RZCDIR(PATH,'R')
- ELSE
- CALL CDFIXF(PATH1,PATH)
- ENDIF
- LPATH = LENOCC(PATH)
-
- CALL KUGETI(NLEVEL)
-
- CALL KUGETC(CHOPT,LCHOPT)
-*
-* Get tree
-*
- WRITE(LOUTCD,*) 'CDTREK. directory tree structure below ',
- + PATH(1:LPATH),' down ',NLEVEL,' levels'
-
- CALL CDTREK(PATH(1:LPATH),NLEVEL,CHOPT,IRC)
-
- WRITE(LOUTCD,*)
- WRITE(LOUTCD,*) IQUEST(11),' subdirectories found'
-
- END
diff --git a/src/packlib/hepdb/programs/hepdb/cdverc.F b/src/packlib/hepdb/programs/hepdb/cdverc.F
deleted file mode 100644
index 2ef9871..0000000
--- a/src/packlib/hepdb/programs/hepdb/cdverc.F
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: cdverc.F,v 1.2 1996/03/12 13:09:11 cernlib Exp $
-*
-* $Log: cdverc.F,v $
-* Revision 1.2 1996/03/12 13:09:11 cernlib
-* Build hepdb programs: hepdb, cdserv, cdnew, and cdmove
-*
-* Revision 1.1.1.1 1996/02/28 16:23:32 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDVERC
-
- CALL CDVERS(' ',' ','P')
-
- END
diff --git a/src/packlib/hepdb/programs/hepdb/cdwind.F b/src/packlib/hepdb/programs/hepdb/cdwind.F
deleted file mode 100644
index 6fbfb69..0000000
--- a/src/packlib/hepdb/programs/hepdb/cdwind.F
+++ /dev/null
@@ -1,30 +0,0 @@
-*
-* $Id: cdwind.F,v 1.2 1996/03/12 13:09:13 cernlib Exp $
-*
-* $Log: cdwind.F,v $
-* Revision 1.2 1996/03/12 13:09:13 cernlib
-* Build hepdb programs: hepdb, cdserv, cdnew, and cdmove
-*
-* Revision 1.1.1.1 1996/02/28 16:23:32 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDWIND
-#include "hepdb/cdtime.inc"
- CHARACTER*80 CHWIND
- CHARACTER*8 CHOPT
-
- CALL KUGETC(CHWIND,LWIND)
- CALL KUGETC(CHOPT,LOPT)
-
- IF(INDEX(CHOPT,'R').NE.0) THEN
- IDATCD = 0
- ITIMCD = 0
- JDATCD = 0
- JTIMCD = 0
- ELSE
- CALL CDDTRN(CHWIND(1:LWIND),IDATCD,ITIMCD,JDATCD,JTIMCD,IC)
- ENDIF
-
- END
diff --git a/src/packlib/hepdb/programs/hepdb/cdzoom.F b/src/packlib/hepdb/programs/hepdb/cdzoom.F
deleted file mode 100644
index c59057c..0000000
--- a/src/packlib/hepdb/programs/hepdb/cdzoom.F
+++ /dev/null
@@ -1,40 +0,0 @@
-*
-* $Id: cdzoom.F,v 1.2 1996/03/12 13:09:14 cernlib Exp $
-*
-* $Log: cdzoom.F,v $
-* Revision 1.2 1996/03/12 13:09:14 cernlib
-* Build hepdb programs: hepdb, cdserv, cdnew, and cdmove
-*
-* Revision 1.1.1.1 1996/02/28 16:23:29 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE CDZOOM
-
-#include "hepdb/quest.inc"
-#include "hepdb/cdunit.inc"
- CHARACTER*255 CHPATH,PATH
-
-#include "hepdb/cdopen.inc"
-
- CALL KUGETC(PATH,LPATH)
- IF(LPATH.EQ.0) THEN
- CALL RZCDIR(CHPATH,'R')
- ELSE
- CALL CDFIXF(PATH,CHPATH)
- ENDIF
- LPATH = LENOCC(CHPATH)
-
- CALL CDZOO1(CHPATH(1:LPATH),IRC)
- CALL CDPWD(' ')
-
- IF(IRC.NE.0) THEN
- IF(LLOGCD.GT.-3) WRITE(LOUTCD,*) 'CDZOOM. unable to find ',
- + 'lowest level directory with ',
- + 'one or more entries'
- ELSE
- WRITE(LOUTCD,*) 'CDZOOM. objects: ',IQUEST(14)
- ENDIF
-
- END
diff --git a/src/packlib/hepdb/programs/hepdb/hepdb.F b/src/packlib/hepdb/programs/hepdb/hepdb.F
deleted file mode 100644
index a74263c..0000000
--- a/src/packlib/hepdb/programs/hepdb/hepdb.F
+++ /dev/null
@@ -1,100 +0,0 @@
-*
-* $Id: hepdb.F,v 1.4 1996/04/12 09:42:30 cernlib Exp $
-*
-* $Log: hepdb.F,v $
-* Revision 1.4 1996/04/12 09:42:30 cernlib
-* New handling of title
-*
-* Revision 1.3 1996/03/29 11:18:23 jamie
-* qftitlch
-*
-* Revision 1.2 1996/03/12 13:09:16 cernlib
-* Build hepdb programs: hepdb, cdserv, cdnew, and cdmove
-*
-* Revision 1.1.1.1 1996/02/28 16:23:27 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- PROGRAM HEPDB
-#include "hepdb/cdilun.inc"
-#include "hepdb/cduscm.inc"
-#include "hepdb/quest.inc"
-*
-* HEPDB interactive interface
-*
-#include "hepdb/nwpaw.inc"
- COMMON /PAWC/ NWPAWC,IXPAWC,IHBOOK,IXHIGZ,IXKU,IFENCE(5)
- +, LMAIN, IPAW(NWPAW)
- EXTERNAL CDEXIT,CDQUIT
-#include "hepdb/qftitlch.inc"
- CHARACTER VIDQQ*(*)
- PARAMETER (VIDQQ = '@(#)' //
- + HepdbTitleFortranString
- + // '>')
- CALL CLEFT (VIDQQ,1,0)
-*
-* Initialise C environment
-*
- CALL INITC
-*
-* Initialise Zebra...
-*
- CALL MZEBRA(-3)
- CALL MZPAW(NWPAW,' ')
-*
-* Link area...
-*
- CALL MZLINK(IXPAWC,'/CDULNK/',LINK01,LINK01,LINK01)
-*
-* Kuip...
-*
- NWORDS = 50000
- CALL KUINIT(NWORDS)
-*
-* HEPDB...
-*
- CALL CDINIC
-*
-* CDF...
-*
- CALL CDCDF
-*
-* Set prompt...
-*
- CALL KIPRMT('HEPDB>')
-*
-* Set up the EXIT and QUIT routines
-*
- CALL KUEXIT(CDEXIT)
- CALL KUQUIT(CDQUIT)
-*
-* Define some FORTRAN units
-*
- CALL CDSETU(LUNARR,NLUN,IRC)
-*
-* Default loglevel, output unit
-*
- LPRTCD = 6
- IDEBCD = 0
-*
- LTOPCD = 0
-*
-* Automatic execution of LOGON kumacs
-*
- CALL KULOGN('HDB','SGULV')
-*
-* Pass control to KUIP...
-*
-#if !defined(CERNLIB_MOTIF)
- CALL KUWHAT
-#endif
-#if defined(CERNLIB_MOTIF)
- CALL KUWHAM('HEPDB')
-#endif
-
-#if defined(CERNLIB_VAXVMS)
- CALL SYS$EXIT(%VAL(1))
-#endif
-*
- END
diff --git a/src/packlib/hepdb/programs/hepdb/zabend.F b/src/packlib/hepdb/programs/hepdb/zabend.F
deleted file mode 100644
index bed71ae..0000000
--- a/src/packlib/hepdb/programs/hepdb/zabend.F
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: zabend.F,v 1.2 1996/03/12 13:09:17 cernlib Exp $
-*
-* $Log: zabend.F,v $
-* Revision 1.2 1996/03/12 13:09:17 cernlib
-* Build hepdb programs: hepdb, cdserv, cdnew, and cdmove
-*
-* Revision 1.1.1.1 1996/02/28 16:23:29 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#include "hepdb/pilot.h"
- SUBROUTINE ZABEND
-#include "zebra/zstate.inc"
- PRINT *,'ZABEND routine for HEPDB reached - ZPOSTM cancelled'
- IF(NQPHAS.LE.0) CALL ABEND
- NQPHAS = - 2
- CALL ZEND
- END
diff --git a/src/packlib/hepdb/scripts/com/cdabend.dat b/src/packlib/hepdb/scripts/com/cdabend.dat
deleted file mode 100644
index e18ec4b..0000000
--- a/src/packlib/hepdb/scripts/com/cdabend.dat
+++ /dev/null
@@ -1,13 +0,0 @@
-*
-* $Id: cdabend.dat,v 1.1.1.1 1996/02/28 16:23:57 mclareni Exp $
-*
-* $Log: cdabend.dat,v $
-* Revision 1.1.1.1 1996/02/28 16:23:57 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#if defined(CERNLIB_VAXVMS)
-$!DECK ID>, CDABEND.COM
-$SET NOON
-$MAIL/SUBJECT="HEPDB server abending: ''CDSERV' " _NL: VXCERN::JAMIE
-#endif
diff --git a/src/packlib/hepdb/scripts/com/cdacl.dat b/src/packlib/hepdb/scripts/com/cdacl.dat
deleted file mode 100644
index e38333f..0000000
--- a/src/packlib/hepdb/scripts/com/cdacl.dat
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: cdacl.dat,v 1.1.1.1 1996/02/28 16:23:58 mclareni Exp $
-*
-* $Log: cdacl.dat,v $
-* Revision 1.1.1.1 1996/02/28 16:23:58 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#if defined(CERNLIB_VAXVMS)
-$!DECK ID>, CDACL.COM
-$ if p1 .eqs. "" then exit
-$ group = P1 - "CD"
-$ set acl /object_type=file DISK$MF:['p1']QUEUE.DIR -
-/acl=(IDENTIFIER='P1',ACCESS=READ+WRITE+EXECUTE+DELETE+CONTROL)
-$ set acl /object_type=file DISK$MF:['p1']QUEUE.DIR -
-/acl=(IDENTIFIER=ID$_'GROUP',ACCESS=READ+WRITE+EXECUTE)
-$ set acl /object_type=file DISK$MF:['p1']QUEUE.DIR -
-/acl=(IDENTIFIER='P1',OPTIONS=DEFAULT,ACCESS=READ+WRITE+EXECUTE+DELETE+CONTROL)
-$ set acl /object_type=file DISK$MF:['p1']QUEUE.DIR -
-/acl=(IDENTIFIER=ID$_'GROUP',OPTIONS=DEFAULT,ACCESS=READ+WRITE+EXECUTE)
-$ directory/security DISK$MF:['p1']QUEUE.DIR
-#endif
diff --git a/src/packlib/hepdb/scripts/com/cdcheck.dat b/src/packlib/hepdb/scripts/com/cdcheck.dat
deleted file mode 100644
index a8afe37..0000000
--- a/src/packlib/hepdb/scripts/com/cdcheck.dat
+++ /dev/null
@@ -1,78 +0,0 @@
-*
-* $Id: cdcheck.dat,v 1.1.1.1 1996/02/28 16:23:58 mclareni Exp $
-*
-* $Log: cdcheck.dat,v $
-* Revision 1.1.1.1 1996/02/28 16:23:58 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#if defined(CERNLIB_VAXVMS)
-$!DECK ID>, CDCHECK.COM
-$SET NOON
-$ !
-$ ! Check that HEPDB servers are started
-$ !
-$ if p1 .eqs. "" then exit
-$ servers = p1
-$ count = 0
-$ save_mess = f$environment("MESSAGE")
-$ set message/nofacility/noseverity/noid/notext
-$ bqname = f$trnlnm("SYS$FATMEN")
-$ if bqname .eqs. "" then bqname = "SYS$FATMEN"
-$ !
-$ ! Check that the queue is started
-$ !
-$ if f$getqui("DISPLAY_QUEUE","QUEUE_STOPPED",bqname) .eqs. "FALSE" then -
- start/queue 'bqname'
-$loop:
-$ server = f$element(count,",",servers)
-$ if server .eqs. "," then goto end
-$ count = count + 1
-$ write sys$output "Processing ''server'..."
-$ show user/nooutput 'server'
-$ if $severity .ne. 1
-$ then
-$ !
-$ ! Check that server has not been stopped
-$ !
-$ ON WARNING THEN GOTO UNDEFINED
-$ cddir = &server
-$ ON WARNING THEN CONTINUE
-$ cddir = f$extract(0,f$length(cddir)-1,cddir) + ".TODO]SIGNAL.STOP"
-$ if f$search(cddir) .nes. ""
-$ then write sys$output "Signal.Stop file found - will not restart"
-$ goto loop
-$ endif
-$ !
-$ ! Check that server is not pending (or otherwise)
-$ !
-$ TEMP = F$GETQUI("")
-$ QLOOP:
-$ QNAME = F$GETQUI("DISPLAY_QUEUE","QUEUE_NAME","*")
-$ IF QNAME .EQS. "" THEN goto submit
-$ IF QNAME .NES. bqname then goto qloop
-$ WRITE SYS$OUTPUT ""
-$ WRITE SYS$OUTPUT "QUEUE: ", QNAME
-$ JLOOP:
-$ NOACCESS = F$GETQUI("DISPLAY_JOB","JOB_INACCESSIBLE",,"ALL_JOBS")
-$ IF NOACCESS .EQS. "TRUE" THEN GOTO JLOOP
-$ IF NOACCESS .EQS. "" THEN GOTO QLOOP
-$ JNAME = F$GETQUI("DISPLAY_JOB","JOB_NAME",,"FREEZE_CONTEXT,ALL_JOBS")
-$ UNAME = F$GETQUI("DISPLAY_JOB","USERNAME",,"FREEZE_CONTEXT,ALL_JOBS")
-$ JID = F$GETQUI("DISPLAY_JOB","ENTRY_NUMBER",,"FREEZE_CONTEXT,ALL_JOBS")
-$ WRITE SYS$OUTPUT "JOB: ", JNAME," ENTRY: ",JID," USER: ",UNAME
-$ if uname .eqs. server then goto loop
-$ goto jloop
-$ submit:
-$ set message'save_mess'
-$ write sys$output "Restarting server ..."
-$ cdserv = &server + "CDSERV.COM"
-$ submit/queue='bqname'/user='server' /id 'cdserv'
-$ endif
-$ goto loop
-$ undefined:$ write sys$output "Warning: symbol ''server' is not defined"
-$ goto loop
-$ end:
-$ set message'save_mess'
-$ exit
-#endif
diff --git a/src/packlib/hepdb/scripts/com/cdhepdb_acl.dat b/src/packlib/hepdb/scripts/com/cdhepdb_acl.dat
deleted file mode 100644
index a7aefcb..0000000
--- a/src/packlib/hepdb/scripts/com/cdhepdb_acl.dat
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: cdhepdb_acl.dat,v 1.1.1.1 1996/02/28 16:23:58 mclareni Exp $
-*
-* $Log: cdhepdb_acl.dat,v $
-* Revision 1.1.1.1 1996/02/28 16:23:58 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#if defined(CERNLIB_VAXVMS)
-$!DECK ID>, CDHEPDB_ACL.COM
-$ !
-$ ! Set ACL on [.TODO] and [.TOHEPDB] directories of server 'p1' so that
-$ ! gateway process can transfer updates.
-$ !
-$ if p1 .eqs. "" then exit
-$ p2 = "CDHEPDB"
-$ !
-$ set acl /object_type=file DISK$MF:['p1']TODO.DIR -
-/acl=(IDENTIFIER='p2',ACCESS=READ+WRITE+EXECUTE+DELETE+CONTROL)
-$ set acl /object_type=file DISK$MF:['p1']TODO.DIR -
-/acl=(IDENTIFIER='p2',OPTIONS=DEFAULT,ACCESS=READ+WRITE+EXECUTE+DELETE+CONTROL)
-$ !
-$ set acl /object_type=file DISK$MF:['p1']TOHEPDB.DIR -
-/acl=(IDENTIFIER='p2',ACCESS=READ+WRITE+EXECUTE+DELETE+CONTROL)
-$ set acl /object_type=file DISK$MF:['p1']TOHEPDB.DIR -
-/acl=(IDENTIFIER='p2',OPTIONS=DEFAULT,ACCESS=READ+WRITE+EXECUTE+DELETE+CONTROL)
-#endif
diff --git a/src/packlib/hepdb/scripts/com/cdmast.dat b/src/packlib/hepdb/scripts/com/cdmast.dat
deleted file mode 100644
index 67329ec..0000000
--- a/src/packlib/hepdb/scripts/com/cdmast.dat
+++ /dev/null
@@ -1,60 +0,0 @@
-*
-* $Id: cdmast.dat,v 1.1.1.1 1996/02/28 16:23:58 mclareni Exp $
-*
-* $Log: cdmast.dat,v $
-* Revision 1.1.1.1 1996/02/28 16:23:58 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#if defined(CERNLIB_VAXVMS)
-$!DECK ID>, CDMAST.COM
-$SET NOON
-$ !
-$ ! Master HEPDB command file
-$ !
-$ save_mess = f$environment("MESSAGE")
-$ set message/nofacility/noseverity/noid/notext
-$ write sys$output "CDMAST starting at ''f$time()'"
-$ !
-$ ! Ensure that FATMEN queue is started
-$ !
-$ if f$getqui("DISPLAY_QUEUE","QUEUE_STOPPED","SYS$FATMEN") .eqs. "TRUE" then -
-start/queue sys$fatmen
-$ !
-$ ! define list of servers
-$ !
-$ node = f$trnlnm("SYS$CLUSTER_NODE") - "::"
-$ if node .eqs. "" then node = f$trnlnm("SYS$NODE") - "::"
-$ if node .eqs. "VXCERN" .or. node .eqs. "VSCRNA" then -
-servers = "CDHEPDB,CDCHORUS,CDCPLEAR,CDNOMAD" ! Separate by commas
-$ if node .eqs. "UXCP05" then servers = "CDCPLEAR"
-$ !
-$ wakeup :== 00:30:00 ! Every 30 minutes
-$ !
-$ ! define symbols - this is VXCERN specific
-$ ! unless you put all servers on DISK$MF
-$ !
-$ n = 0
-$ loop:
-$ server = f$element(n,",",servers)
-$ if server .eqs. "," then goto again
-$ 'server' == "DISK$MF:[''server']"
-$ n = n + 1
-$ goto loop
-$ again:
-$ !
-$ ! Run the command files that expect a complete list as argument
-$ !
-$ write sys$output ">>> CDPURGE..."
-$ @CERN_ROOT:[EXE]CDPURGE 'servers' ! Purge old journal files
-$ !
-$ write sys$output ">>> CDCHECK..."
-$ @CERN_ROOT:[EXE]CDCHECK 'servers' ! Check that servers are started
-$ !
-$ write sys$output ">>> Time is ''f$time()'. Waiting ''wakeup'..."
-$ wait 'wakeup'
-$ write sys$output ">>> Wakeup at ''f$time()'."
-$ goto again
-$ set message 'save_mess'
-$ exit
-#endif
diff --git a/src/packlib/hepdb/scripts/com/cdmove.dat b/src/packlib/hepdb/scripts/com/cdmove.dat
deleted file mode 100644
index 1bc9881..0000000
--- a/src/packlib/hepdb/scripts/com/cdmove.dat
+++ /dev/null
@@ -1,35 +0,0 @@
-*
-* $Id: cdmove.dat,v 1.1.1.1 1996/02/28 16:23:58 mclareni Exp $
-*
-* $Log: cdmove.dat,v $
-* Revision 1.1.1.1 1996/02/28 16:23:58 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#if defined(CERNLIB_VAXVMS)
-$!DECK ID>, CDMOVE.COM
-$ !
-$ ! Command file to launch CDMOVE
-$ !
-$ node = f$trnlnm("SYS$NODE")
-$ time = f$time()
-$ pid = f$getjpi("","PID")
-$ write sys$output "CDMOVE starting on ''node' at ''time'"
-$ write sys$output "Process id: ''pid'"
-$ !
-$ ! Define list of groups for whom updates are to be processed
-$ !
-$ cdgroups:==cdcplear,cdchorus
-$ !
-$ ! For each group, define directory where names file resides
-$ !
-$ cdcplear:==disk$mf:[cdcplear]
-$ cdchorus:==disk$mf:[cdchorus]
-$ !
-$ ! Set the wakeup interval and loglevel
-$ !
-$ cdwakeup:==60
-$ cdlogl :==1
-$ !
-$ RUN CERN:[PRO.EXE]CDMOVE
-#endif
diff --git a/src/packlib/hepdb/scripts/com/cdnew.dat b/src/packlib/hepdb/scripts/com/cdnew.dat
deleted file mode 100644
index 133e00f..0000000
--- a/src/packlib/hepdb/scripts/com/cdnew.dat
+++ /dev/null
@@ -1,86 +0,0 @@
-*
-* $Id: cdnew.dat,v 1.1.1.1 1996/02/28 16:23:57 mclareni Exp $
-*
-* $Log: cdnew.dat,v $
-* Revision 1.1.1.1 1996/02/28 16:23:57 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#if defined(CERNLIB_VAXVMS)
-$!DECK ID>, CDNEW.COM
-$ !
-$ ! Setup the directory and file structure for a new
-$ ! server
-$ !
-$ set noon
-$ procedure = f$parse(f$environment("PROCEDURE"),,,"NAME")
-$ say = "write sys$output"
-$ if p1 .eqs. ""
-$ then
-$ write sys$output "''procedure': usage ''procedure' group"
-$ exit
-$ endif
-$ !
-$ ! Does the directory already exist?
-$ !
-$ home = f$search("DISK$MF:[000000]''p1'.dir")
-$ if home .eqs. ""
-$ then
-$ say "''procedure': home directory for ''p1' does not exist."
-$ say "''procedure': please create an account using USERREG"
-$ exit
-$ endif
-$ !
-$ ! Create subdirectories
-$ !
-$ create/directory DISK$MF:['p1'.BAD]
-$ create/directory DISK$MF:['p1'.LOG]
-$ create/directory DISK$MF:['p1'.QUEUE]
-$ create/directory DISK$MF:['p1'.TODO]
-$ create/directory DISK$MF:['p1'.SAVE]
-$ directory DISK$MF:['p1'] /security
-$ !
-$ ! Set protections
-$ !
-$ set file/protection=w:re DISK$MF:[000000]'p1'.DIR
-$ set file/protection=w:re DISK$MF:['p1']BAD.DIR
-$ set file/protection=w:re DISK$MF:['p1']LOG.DIR
-$ set file/protection=w:re DISK$MF:['p1']SAVE.DIR
-$ set file/protection=w:re DISK$MF:['p1']TODO.DIR
-$ !
-$ ! and the ACL
-$ !
-$ group = P1 - "CD"
-$ set acl /object_type=file DISK$MF:['p1']QUEUE.DIR -
-/acl=(IDENTIFIER='P1',ACCESS=READ+WRITE+EXECUTE+DELETE+CONTROL)
-$ set acl /object_type=file DISK$MF:['p1']QUEUE.DIR -
-/acl=(IDENTIFIER=ID$_'GROUP',ACCESS=READ+WRITE+EXECUTE)
-$ set acl /object_type=file DISK$MF:['p1']QUEUE.DIR -
-/acl=(IDENTIFIER='P1',OPTIONS=DEFAULT,ACCESS=READ+WRITE+EXECUTE+DELETE+CONTROL)
-$ set acl /object_type=file DISK$MF:['p1']QUEUE.DIR -
-/acl=(IDENTIFIER=ID$_'GROUP',OPTIONS=DEFAULT,ACCESS=READ+WRITE+EXECUTE)
-$ !
-$ ! If identifier does not exist, set world write protection
-$ !
-$ if $severity .ne. 1
-$ then
-$ say "''procedure': identifier ''id$_group' does not exist"
-$ say "''procedure': granting W:RWE access"
-$ set file/prot=w:rwe DISK$MF:['p1']QUEUE.DIR
-$ endif
-$ !
-$ ! Create names file
-$ !
-$ open/write out DISK$MF:['p1']HEPDB.NAMES
-$ write out ":nick.config"
-$ write out ":list.aa"
-$ write out ":bad.DISK$MF:[''p1'.BAD]"
-$ write out ":log.DISK$MF:[''p1'.LOG]"
-$ write out ":queue.DISK$MF:[''p1'.QUEUE]"
-$ write out ":todo.DISK$MF:[''p1'.TODO]"
-$ write out ":save.DISK$MF:[''p1'.SAVE]"
-$ write out ":wakeup.120"
-$ write out ":loglevel.3"
-$ close out
-$ type DISK$MF:['p1']HEPDB.NAMES
-#endif
diff --git a/src/packlib/hepdb/scripts/com/cdpurge.dat b/src/packlib/hepdb/scripts/com/cdpurge.dat
deleted file mode 100644
index de5a4b6..0000000
--- a/src/packlib/hepdb/scripts/com/cdpurge.dat
+++ /dev/null
@@ -1,38 +0,0 @@
-*
-* $Id: cdpurge.dat,v 1.1.1.1 1996/02/28 16:23:57 mclareni Exp $
-*
-* $Log: cdpurge.dat,v $
-* Revision 1.1.1.1 1996/02/28 16:23:57 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#if defined(CERNLIB_VAXVMS)
-$!DECK ID>, CDPURGE.COM
-$SET NOON
-$ !
-$ ! Purge journalled HEPDB updates that are over a day old
-$ !
-$ if p1 .eqs. "" then exit
-$ hepdb = p1
-$ count = 0
-$ save_mess = f$environment("MESSAGE")
-$ set message/nofacility/noseverity/noid/notext
-$loop:
-$ server = f$element(count,",",hepdb)
-$ if server .eqs. "," then goto end
-$ count = count + 1
-$ write sys$output "Processing ''server'..."
-$ ON WARNING THEN GOTO UNDEFINED
-$ cddir = &server
-$ purge 'cddir' ! Purge old log files
-$ cdfil = f$extract(0,f$length(cddir)-1,cddir) + ".SAVE]*.*;*"
-$ ON WARNING THEN CONTINUE
-$ delete/before=-0-23:59 'cdfil'
-$ goto loop
-$ undefined:
-$ write sys$output "Warning: symbol ''server' is not defined"
-$ goto loop
-$ end:
-$ set message 'save_mess'
-$ exit
-#endif
diff --git a/src/packlib/hepdb/scripts/com/cdsend.dat b/src/packlib/hepdb/scripts/com/cdsend.dat
deleted file mode 100644
index 58ecd51..0000000
--- a/src/packlib/hepdb/scripts/com/cdsend.dat
+++ /dev/null
@@ -1,124 +0,0 @@
-*
-* $Id: cdsend.dat,v 1.1.1.1 1996/02/28 16:23:57 mclareni Exp $
-*
-* $Log: cdsend.dat,v $
-* Revision 1.1.1.1 1996/02/28 16:23:57 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#if defined(CERNLIB_VAXVMS)
-$!DECK ID>, CDSEND.COM
-$ !
-$ ! Command file to move updates between 'slave' and 'master'
-$ !
-$ ! Invoked by CDSERV.COM from the account CDHEPDB on current node
-$ !
-$ ! Assumes correct UID & GID mapping for directories on 'master'
-$ ! MULTINET CONFIGURE /NFS
-$ ! NFS-CONFIG>add uid cdhepdb 102 3
-$ ! NFS-CONFIG>ctrl-z
-$ !
-$ set noon
-$ !
-$ ! List of servers
-$ !
-$ cdservers = "CDCPLEAR,CDCHORUS,CDNOMAD"
-$ !
-$ ! Master & slave definitions
-$ !
-$ slave = f$trnlnm("SYS$NODE") - "::"
-$ master = "HEPDB"
-$ !
-$ ! UIC
-$ !
-$ our_uic = f$getjpi("","UIC")
-$ !
-$ main_loop:
-$ nserver = 0
-$ !
-$ ! Loop over all servers
-$ !
-$ loop_servers:
-$ server = f$element(nserver,",",cdservers)
-$ nserver = nserver + 1
-$ if server .eqs. "," then goto sleep
-$ !
-$ write sys$output "Processing ''server'..."
-$ !
-$ ! Look for files waiting to be sent to 'master'
-$ !
-$ to_hepdb:
-$ journal_file = f$search("DISK$MF:[''server'.TO''master']*.*")
-$ !
-$ if journal_file .eqs. "" then goto from_hepdb
-$ !
-$ ! Skip 'active' files
-$ !
-$ if f$locate("]ZZ",journal_file) .lt. f$length(journal_file) then -
-goto to_hepdb
-$ !
-$ ! Build remote file name
-$ !
-$ istart = f$locate("]",journal_file) + 1
-$ remote_file = "''master':[''server'.TODO]ZZ" + -
- f$extract(istart+2,f$length(journal_file),journal_file)
-$ !
-$ ! Copy the file over
-$ !
-$ copy 'journal_file' 'remote_file' /log /noconfirm
-$ !
-$ ! Rename remote file and delete local file if it was ok
-$ !
-$ if $severity .eq. 1
-$ then
-$ remote_update = "''master':[''server'.TODO]" + -
- f$extract(istart,f$length(journal_file),journal_file)
-$ rename 'remote_file' 'remote_update' /nolog /noconfirm
-$ if $severity .eq. 1 then delete /nolog /noconfirm 'journal_file'
-$ endif
-$ !
-$ goto to_hepdb
-$ !
-$ ! Look for files to be pulled over from 'master'
-$ !
-$ from_hepdb:
-$ journal_file = f$search("HEPDB:[''server'.TO''slave']*.*")
-$ !
-$ if journal_file .eqs. "" then goto loop_servers
-$ !
-$ ! Skip 'active' files
-$ !
-$ if f$extract(0,2,journal_file) .eqs. "ZZ" then goto from_hepdb
-$ !
-$ ! Check UIC (to see if we will be able to delete remote file)
-$ !
-$ remote_uic = f$file_attributes(journal_file,"UIC")
-$ if remote_uic .nes. our_uic then goto from_hepdb
-$ !
-$ ! Build local file name
-$ !
-$ istart = f$locate("]",journal_file) + 1
-$ local_file = "DISK$MF:[''server'.TODO]ZZ" + -
- f$extract(istart+2,f$length(journal_file),journal_file)
-$ !
-$ ! Copy the file over
-$ !
-$ copy 'journal_file' 'local_file' /log /noconfirm
-$ !
-$ ! Rename local file and delete remote file if it was ok
-$ !
-$ if $severity .eq. 1
-$ then
-$ local_update = "DISK$MF:[''server'.TODO]" + -
- f$extract(istart,f$length(journal_file),journal_file)
-$ rename 'local_file' 'local_update' /log /noconfirm
-$ if $severity .eq. 1 then delete /log /noconfirm 'journal_file'
-$ endif
-$ !
-$ goto from_hepdb
-$ !
-$ sleep:
-$ wait 00:10:00
-$ write sys$output "Wakeup at ''f$time()'"
-$ goto main_loop
-#endif
diff --git a/src/packlib/hepdb/scripts/com/cdserv.dat b/src/packlib/hepdb/scripts/com/cdserv.dat
deleted file mode 100644
index 66f33d5..0000000
--- a/src/packlib/hepdb/scripts/com/cdserv.dat
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: cdserv.dat,v 1.1.1.1 1996/02/28 16:23:58 mclareni Exp $
-*
-* $Log: cdserv.dat,v $
-* Revision 1.1.1.1 1996/02/28 16:23:58 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#if defined(CERNLIB_VAXVMS)
-$!DECK ID>, CDSERV.COM
-$ !
-$ ! Command file to launch HEPDB server
-$ !
-$ set noon
-$ node = f$trnlnm("SYS$NODE")
-$ time = f$time()
-$ pid = f$getjpi("","PID")
-$ user = f$getjpi("","USERNAME")
-$ user = user - "CD"
-$ write sys$output "CDSERV starting on ''node' at ''time'"
-$ write sys$output "Process id: ''pid'"
-$ procname = "HEPdb_''user'"
-$ set process/name='procname'
-$ !
-$ RUN CERN:[PRO.EXE]CDSERV
-#endif
diff --git a/src/packlib/hepdb/scripts/com/runepdb.dat b/src/packlib/hepdb/scripts/com/runepdb.dat
deleted file mode 100644
index dd79cbf..0000000
--- a/src/packlib/hepdb/scripts/com/runepdb.dat
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: runepdb.dat,v 1.1.1.1 1996/02/28 16:23:57 mclareni Exp $
-*
-* $Log: runepdb.dat,v $
-* Revision 1.1.1.1 1996/02/28 16:23:57 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#if defined(CERNLIB_VAXVMS)
-$!DECK ID>, run_hepdb.COM
-$ set noon
-$ !
-$ ! Multinet NFS
-$ !
-$ if f$trnlnm("MULTINET") .nes. ""
-$ then
-$ if f$trnlnm("HEPDB").eqs."" then -
-$ NFSMOUNT/soft HEPDB::"/hepdb" HEPDB
-$ endif
-$ !
-$ ! UCX NFS
-$ !
-$ if f$trnlnm("UCX$HOST") .nes. ""
-$ then
-$ if f$trnlnm("HEPDB").eqs."" then -
-$ ! << do the bizzo >>
-$ endif
-$ @cern:[pro.exe]cdmast
-#endif
diff --git a/src/packlib/hepdb/scripts/rexx/cdabend.dat b/src/packlib/hepdb/scripts/rexx/cdabend.dat
deleted file mode 100644
index 6946f31..0000000
--- a/src/packlib/hepdb/scripts/rexx/cdabend.dat
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: cdabend.dat,v 1.1.1.1 1996/02/28 16:23:59 mclareni Exp $
-*
-* $Log: cdabend.dat,v $
-* Revision 1.1.1.1 1996/02/28 16:23:59 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#if defined(CERNLIB_IBMVM)
-/*DECK ID>, CDABEND.EXEC */
-/*-------------------------------------------------------------*/
-/* */
-/* C D A B E N D */
-/* */
-/*-------------------------------------------------------------*/
-'ID (STACK'
-Pull user . node .
-if fexist(HEPDB MAILFILE A3) then 'ERASE HEPDB MAILFILE A3'
-'EXECIO 1 DISKW HEPDB MAILFILE A3 (STRING 'user node
-'EXEC MAIL HEPDBMAN (NOEDIT NOLOG FILE HEPDB MAILFILE SUBJECT CDSERV abend'
-#endif
diff --git a/src/packlib/hepdb/scripts/rexx/cdhepdb.dat b/src/packlib/hepdb/scripts/rexx/cdhepdb.dat
deleted file mode 100644
index f25e8ae..0000000
--- a/src/packlib/hepdb/scripts/rexx/cdhepdb.dat
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: cdhepdb.dat,v 1.1.1.1 1996/02/28 16:23:59 mclareni Exp $
-*
-* $Log: cdhepdb.dat,v $
-* Revision 1.1.1.1 1996/02/28 16:23:59 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#if defined(CERNLIB_IBMVM)
-/*DECK ID>, CDHEPDB.EXEC */
-Trace
-'EXEC GIME FAT3 (MODESEQ -Q NONOTICE)
-'EXEC GIME CERNPAMS
-'EXEC YPATCHY PAM1="ZEBRA CAR *" PAM2="HEPDB CARDS" CRADLE="CDHEPDB CRADLE",
-ASM="CDHEPDB FORTRAN A1"'
-'EXEC VFORT CDHEPDB'
-'EXEC CDLD'
-#endif
diff --git a/src/packlib/hepdb/scripts/rexx/cdjourn.dat b/src/packlib/hepdb/scripts/rexx/cdjourn.dat
deleted file mode 100644
index 94a115d..0000000
--- a/src/packlib/hepdb/scripts/rexx/cdjourn.dat
+++ /dev/null
@@ -1,63 +0,0 @@
-*
-* $Id: cdjourn.dat,v 1.1.1.1 1996/02/28 16:23:59 mclareni Exp $
-*
-* $Log: cdjourn.dat,v $
-* Revision 1.1.1.1 1996/02/28 16:23:59 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#if defined(CERNLIB_IBMVM)
-/*DECK ID>, CDJOURN.EXEC */
-/*---------------------------------------------------------------------*/
-/* */
-/* */
-/* # # ###### ##### ##### ##### */
-/* # # # # # # # # # */
-/* ###### ##### # # # # ##### */
-/* # # # ##### # # # # */
-/* # # # # # # # # */
-/* # # ###### # ##### ##### */
-/* */
-/* */
-/*---------------------------------------------------------------------*/
-
-Parse arg fn1 ft1 fm1 fn2 ft2 fm2
-
-/* Move file1 to file2, checking that there is enough disk space
- on target disk. A cleanup is triggered if required
- */
-
-need = QFILE(fn1 ft1 fm1,"BLKNO")
-
-free = QDISK(fm2,"BLKLEFT")
-
-if need > free/2 then do
-
- 'MAKEBUF'
-
- 'LFILE * * 'fm2 '(SORT TIME STACK'
-
- If RC = 28 then exit /* No files on the disk! */
-
- n = queued()
-
- do n-1
-
- Pull fn3 ft3 fm3 .
-
- Say 'Erasing 'fn3 ft3 fm3
- 'ERASE 'fn3 ft3 fm3
-
- free = QDISK(fm2,"BLKLEFT")
-
- if need < free/2 then leave
-
- end
-
-end
-
-'COPYFILE 'fn1 ft1 fm1 fn2 ft2 fm2
-
-'ERASE 'fn1 ft1 fm1
-
-#endif
diff --git a/src/packlib/hepdb/scripts/rexx/hdbserv.dat b/src/packlib/hepdb/scripts/rexx/hdbserv.dat
deleted file mode 100644
index 97189ee..0000000
--- a/src/packlib/hepdb/scripts/rexx/hdbserv.dat
+++ /dev/null
@@ -1,801 +0,0 @@
-*
-* $Id: hdbserv.dat,v 1.1.1.1 1996/02/28 16:23:58 mclareni Exp $
-*
-* $Log: hdbserv.dat,v $
-* Revision 1.1.1.1 1996/02/28 16:23:58 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#if defined(CERNLIB_IBMVM)
-/*DECK ID>, HDBSERV.EXEC */
-/*---------------------------------------------------------------------*/
-/* */
-/* */
-/* # # ###### ##### ##### ##### */
-/* # # # # # # # # # */
-/* ###### ##### # # # # ##### */
-/* # # # ##### # # # # */
-/* # # # # # # # # */
-/* # # ###### # ##### ##### */
-/* */
-/* */
-/*---------------------------------------------------------------------*/
-Parse Source . . execname .
-
-If Index('HDBSERV/DELSERV/DELCOPY/DELPSF',execname) = 0 then do
- Say 'Action not currently supported'
- Exit 999
- end
-
-'IDENTIFY (LIFO'
-Parse pull username . mynode .
-if XFLAG('CPXA') then do
- NOREAD = 'NOREAD'
- IUCVMSG = 'IUCVMSG'
- end
- else do
- NOREAD = ''
- IUCVMSG = ''
- end
-
-/* Get wakeup interval */
-
-interval = "+01:00:00"
-
-"GLOBALV SELECT *EXEC STACK CDWAKEUP"
-
-pull sleep
-
-if strip(sleep) = '' then sleep = interval
-
-Select
- When execname = 'HDBSERV' then do
-
- 'GLOBALV SELECT *EXEC GET CDFILE'
-
- Parse var cdfile
-
- If fexist(cdfile) then do
-
- Say "Unprocessed journal file" cdfile "exists -> will process now"
- exit /* Fast exit if we still have a file to process */
-
- end
-/*
- owner.0 = 4
- owner.1 = username mynode
- owner.2 = "JAMIE CERNVM"
- owner.3 = "FATONE"
- owner.4 = "HRRCR"
-
- operator.0 = 3
- operator.1 = "OPSUTIL"
- operator.2 = "CONSOLE"
- operator.3 = "LEPSERV"*/
-
-/* Build list of HEPDB owners and operators */
-hdbstaff = 'HDBOWNERS HDBOPERATORS'
-
-Do j = 1 to 2
-current = word(hdbstaff,j)
-'NAMEFIND :NICK 'current'(STACK'
-If RC = 32 then do
- ic = setvar(stem'.0',0)
- end
-
- else do
- stem = substr(current,4,length(current)-4)
- Pull line
- Pull . line
-/* stem.0 = words(line) */
- ic = setvar(stem'.0',words(line))
- do i = 1 to words(line)
- current = word(line,i)
- 'NAMEFIND :NICK 'current'(STACK'
- If RC = 32 then do
- address = current mynode
- ic = setvar(stem'.'i,address)
- end
- else do
- Pull .
- Pull . user
- Pull . node
- address = user node
- ic = setvar(stem'.'i,address)
- end
- end
- end
-
-end
- end
- otherwise nop
-end /* Select on EXECNAME */
-
-validmsg.0 = 15
-validmsg.1 = "HELP = display this list"
-validmsg.2 = "HELLO = check if server is active"
-validmsg.3 = "STOP = stop server"
-validmsg.4 = "QDISK (QUERY_DISK_parameters) (,File) "
-validmsg.5 = "QSPOOL = return number of spool files"
-validmsg.6 = "DROP fmode (fmode) (...)"
-validmsg.7 = "GIME gime_parameters_and_options"
-validmsg.8 = "*FATLOG* = log FATMEN request "
-validmsg.9 = "CLOSE = close console log and send to JAMIE"
-validmsg.10 = "NEWLOG = start new "execname "log"
-validmsg.11 = "FINIS = close "execname "log"
-validmsg.12 = "SETPW"
-validmsg.13 = "LOGOFF"
-validmsg.14 = "PURGE = purge old FAT* FZ* journal files"
-validmsg.15 = "WAKEUP = simulate arrival of new RDR file"
-
-Stop = 999999
-
-/* Issue WAKEUP and wait for new RDR files ... */
-
-wait:
-
-'DROPBUF'
-'CP SET MSG IUCV'
- Do Forever
-
- Call wakeup_wait
- RC = Result
- Select
- When RC = 6 then do /* Console attention */
- Signal Stop
- Call Logmes execname mynode "Stop"
- End
-
-/* When RC = 3 then do /* time */
- time = 'TIME'("S")
- do i = 1 to times.0
- timediff = time-times.i
- If timediff >= 0 & timediff < 5 then leave
- End
- If i <= times.0 then do
- Call logmes execname mynode "TIME" time
- nomsg = 1
- end
- nomsg = 0
- End */
-
- Otherwise do
- End
- End
-End /*Do Forever*/
-
-/*=================== W A K E U P - W A I T ========================*/
-
-wakeup_wait:
-if fexist("$ORACLE$ $OSDPRT$") then do
- "ERASE $ORACLE$ $OSDPRT$"
- end
-'WAKEUP' sleep '(RDR' NOREAD IUCVMSG /* Wakeup once an hour */
-code = rc
-/* P r o c e s s m e s s a g e */
-
-Select
- When code = 2 then do /* Timer expired */
- Say 'Wakeup at 'date() time()
- exit 99
- end
-
- When code = 4 then do /* New RDR file */
- Say 'New RDR file received at 'date() time()
- call check_sp /* Check disk space */
- temp = QSPOOL("FIRST")
- Parse var temp origin spoolid class fna fty .
- hdbtype = QSPOOL("FIRST","TYPE")
- if hdbtype = 'CON' then do
- Say 'Purging console file ...'
- 'CP PURGE RDR 'spoolid
- end
- hdbuser = QSPOOL("FIRST","ORIGINID")
- hdbnode = QSPOOL("FIRST","FROMNODE")
-
-/* Fix user and node name for files arriving from Cray station */
-
- if hdbuser = "CRNCRAYX" & hdbnode = "CERNVM" then do
- hdbuser = username
- hdbnode = "SN201"
- end
-
- "GLOBALV SELECT *EXEC SETPL HDBADDR " hdbuser hdbnode
-
- nfiles = QSPOOL("RDR","NUMFILES")
- "GLOBALV SELECT *EXEC SETPL HDBFILES " nfiles
-
- If class = "U" & index(origin,'ORA') ^= 0 then do
- Say origin spoolid class
- Say 'Log file from ORACLE - purge'
- 'CP PURGE R' spoolid
- Return 1
- end
-
- If fty = "MAIL" | fty = "NOTE" then do
- "CP PURGE RDR" spoolid
- Say purging mail file...
- Return 1
- End/* End of MAIL handling */
-/* Receive RDR file and then exit */
- /* call queue_rdr*/
- Select
- When execname = 'HDBSERV' then do
-/* Get the name of the spool file */
- fileid = qspool(spoolid,'FILEID')
- if fileid = 'none none' then do
- 'TRANSFER RDR ' fileid 'TO JAMIE RDR'
- end
- else do
- 'EXEC Receive 'spoolid fileid' A1 (REPLACE'
- 'GLOBALV SELECT *EXEC SETPL CDFILE 'fileid 'A'
- Exit
- end
- end
- Otherwise nop
- End
- End
-
- When code = 5 then do /* New MSG */
- Pull text
- Parse var text . user text
-
- If user = XNAME("RSCSID") | user = "DECMCS" then do
- Parse Var text . "FROM" user_node text
- Parse Var user_node node "(" user ")" .
- If user = "" | DATATYPE(user,"N") then Return 1
- End
- Else do
- node = mynode
- End
- If index(text,"*GONE") ^= 0 then Return /* Ignore GONE messages */
- If index(user,"DECSTG") ^= 0 then Return /* Ignore DECSTG% messages */
- If user = 'MAILER' then Return /* Don't process messages from MAILER */
- If user = "MAILER" then Return 1
- Call process_msg
- Return result
- end
- When code = 6 then do /* Console interrupt */
- Say ""
- Say "Stopping due to CONSOLE interrupt at "date() time()
- Say "Stopping due to CONSOLE interrupt at "date() time()
- Say ""
- Signal stop
- end
- Otherwise nop
- End
-
-Return
-
-/*====================== L o g m e s ========================*/
-
-Logmes: Procedure Expose execname Nextwork stop owner.
-Trace Off
-
-Parse arg user node action text
-
- day = DATE("O")
- tim = TIME()
- line = day tim ,
- LEFT(user,8) LEFT(node,8) LEFT(action,8) text
- Call Check_A "Logging" line
- 'EXECIO 1 DISKW 'execname' LOG A ( VAR LINE '
-
-Return 0
-
-/*====================== H a l t ==============================*/
-
-Halt:
-
-Call Logmes execname XNAME("NODEID") "ERROR" "Halt at line" sigl
-Signal Stop
-
-/*====================== S y n t a x ========================*/
-
-Syntax:
-
-Call Logmes execname XNAME("NODEID") "ERROR" "Syntax error at line" sigl
-Signal Stop
-
-/*====================== N o v a l u e =====================*/
-
-Novalue:
-
-Call Logmes execname XNAME("NODEID") "ERROR" "Undefined variable at line" sigl
-Signal Stop
-
-/*====================== C h e c k _ f m ==================*/
-
-Check_fm: Procedure Expose execname Nextwork stop owner.
-Trace Off
-Parse Arg fm,blkneed
-
-mynode = XNAME("NODEID")
-If ^QDISK(fm,'RW') then do
- text = "Not write access to my" fm "disk"
- Call warning text
- Return -2
-End
-lim = 10
-blkmin = 30
-blkleft = QDISK(fm,'BLKLEFT')
-If blkleft < blkmin then do
- text = "Disk space = "blkleft" blocks in my" fm "disk"
- Call warning text
- Return -1
-End
-If blkleft < blkmin+blkneed then irc = Nextwork
-Else irc = 0
-
-blktot = QDISK(fm,'BLKTOT')
-left = 100 * blkleft/blktot
-If left < lim then do
- If ^FEXIST(execname "LESS"lim fm) then do
- line = "Disk space: Only " FORMAT(left,3,1)"% free "
- 'EXECIO 1 DISKW' execname 'LESS'lim fm '1 ( VAR LINE FINIS'
- text = line "on my" fm "disk"
- Call warning text
- End
-End
-Else do
- If FEXIST(execname "LESS"lim fm) then 'ERASE' execname 'LESS'lim fm
-End
-Return irc
-
-/*====================== C h e c k _ s p ==================*/
-
-Check_sp: Procedure Expose username execname Nextwork stop owner.
-Trace Off
-
-permax = 90
-perused = QDISK('A','PERCENT')
-If perused > permax then do
- text = perused "% of A-disk in use - performing cleanup "
- Call warning text
- Say text
- "EXEC SENDFILE "execname "LOG TO JAMIE AT CERNVM"
- Call warning "Erasing "execname "LOG"
- "ERASE "execname "LOG"
- Call warning "Erasing "username "NETLOG"
- "ERASE "username "NETLOG"
- perused = QDISK('A','PERCENT')
- text = perused "% of A-disk in use after cleanup "
- Call warning text
- If perused > permax then do
- Call warning "Clean-up failed - exiting"
- Exit 999
- End
- Return 0
-End
-
-/*====================== C h e c k _ A =====================*/
-
-Check_A:
-Trace Off
-Parse arg mssg
-
-irc = Check_fm("A",0)
-If irc <= -2 then do
- Say mssg
- Signal Stop
-End
-If irc = - 1 then do
- If QFILE(execname "LOG A","BLKNO") > 10 then do
- 'EXEC SENDFILE 'execname' LOG A TO 'XNAME("USERID")' ( NOLOG'
- 'ERASE 'execname' LOG A'
- If Check_fm("A",0) < 0 then do
- Say mssg
- Signal Stop
- End
- Else Return 0
- End
- Else do
- Say mssg
- Signal Stop
- End
-End
-Return 0
-
-/*====================== O p e r a t o r ==================*/
-
-Operator: Procedure Expose execname stop owner. operator. mynode
-
-Parse arg user , node
-If node ^= mynode then Return -1
-do i=1 to operator.0
- If operator.i = user then Return 0
-End
-
-Return -1
-
-
-/*====================== A u t h o r i z e ===============*/
-
-Authorize: Procedure Expose execname stop owner.
-
-Parse arg user , node
-
-do i=1 to owner.0
- Parse Var owner.i usero nodeo
- If user = usero then do
- If nodeo = "" | node = nodeo then Return 0
- End
-End
-
-Return -1
-
-/*====================== P r o c e s s _ m s g ===================*/
-
-Process_msg:
-/*Say text*/
-action = SUBSTR(WORD(text,1),1,4," ")
-Select
-
- When action = "QSPO" then do
- If Authorize(user,node) = 0 | operator(user,node) = 0 then do
- Call Logmes user node "Qspool "
- n_files = QSPOOL("RDR","NUMFILES")
- Call Send_msg user node "I have "n_files" files in my RDR"
- End
- Else Do
- Call Logmes user node "NOAUTHO" text
- Call send_msg user node "Not authorized"
- End
- End
-
- When action = "STOP" then do
- If Authorize(user,node) = 0 | operator(user,node) = 0 then do
- Call Logmes user node "Stop "
- Call Send_msg user node "Stop"
- Signal Stop
- End
- Else Do
- Call Logmes user node "NOAUTHO" text
- Call send_msg user node "Not authorized"
- End
- End
-
- When action = "LOGO" then do
- If Authorize(user,node) = 0 | operator(user,node) = 0 then do
- Call Logmes user node "Logoff "
- Call Send_msg user node "Logoff"
- Queue "CP LOGOFF"
- Signal Stop
- End
- Else Do
- Call Logmes user node "NOAUTHO" text
- Call send_msg user node "Not authorized"
- End
- End
-
- When action = "WAKE" then do
- If Authorize(user,node) = 0 | operator(user,node) = 0 then do
- Call Logmes user node "WAKEUP"
- Call Send_msg user node "Thanks for the alarm call"
- Exit 99
- End
- Else Do
- Call Logmes user node "NOAUTHO" text
- Call send_msg user node "Not authorized"
- End
- End
-
- When action = "PURG" then do
- If Authorize(user,node) = 0 | operator(user,node) = 0 then do
- Call Logmes user node "PURGE"
- Call Send_msg user node "Purging journal files..."
- 'LISTFILE FAT* FZ* B (E'
- 'CMS EXEC PURGE'
- End
- Else Do
- Call Logmes user node "NOAUTHO" text
- Call send_msg user node "Not authorized"
- End
- End
-
- When action = "HELL" then do
- If Authorize(user,node) = 0 | operator(user,node) = 0 then do
- Call Logmes user node "Hello "
- Call Send_msg user node "Hello and how are you today?"
- End
- Else Do
- Call Logmes user node "NOAUTHO" text
- Call send_msg user node "Not authorized"
- End
- End
-
- When action = "HELP" then do
- If Authorize(user,node) = 0 then do
- Call Logmes user node text
- Call Help
- End
- Else Do
- Call Logmes user node "NOAUTHO" text
- Call send_msg user node "Not authorized"
- End
- End
-
- When action = "NEWL" then do
- If Authorize(user,node) = 0 then do
- "FINIS "execname "LOG"
- "ERASE "execname "LOG"
- Call Logmes user node text
- Call send_msg user node "Old "execname "log erased"
- End
- Else Do
- Call Logmes user node "NOAUTHO" text
- Call send_msg user node "Not authorized"
- End
- End
-
- When action = "FINI" then do
- If Authorize(user,node) = 0 then do
- "FINIS "execname "LOG"
- Call Logmes user node text
- Call send_msg user node execname "log closed"
- End
- Else Do
- Call Logmes user node "NOAUTHO" text
- Call send_msg user node "Not authorized"
- End
- End
-
- When action = "SETP" then do
- If Authorize(user,node) = 0 then do
- Parse var text wud pw .
-/*
- "GLOBALV SELECT *EXEC SETPL PWD "pw
- "GLOBALV INIT"*/
- "EXEC RACKF" pw
- Call Logmes user node wud
- Call send_msg user node "SETPW processed"
- Call Logmes user node "Logoff after pw change"
- Call Send_msg user node "Logoff after pw change"
- "CP LOGOFF"
- Call Logmes user node wud
- Call send_msg user node "SETPW processed"
- End
- Else Do
- Call Logmes user node "NOAUTHO" text
- Call send_msg user node "Not authorized"
- End
- End
-
- When action = "CLOS" then do
- If Authorize(user,node) = 0 then do
- Call Logmes user node text
- "CP SPOOL CONSOLE CLOSE"
- saverc = Result
- Call Send_msg user node text "processed."
- Return saverc
- End
- Else Call Logmes user node "NOAUTHO" text
- End
-
- When action = "QQUE" then do
- If Authorize(user,node) = 0 then do
- Call Logmes user node text
- Call qqueue text
- End
- Else Call Logmes user node "NOAUTHO" text
- End
-
- When action = "QDIS" then do
- If Authorize(user,node) = 0 then do
- Call Logmes user node text
- Call q_disk text
- End
- Else Call Logmes user node "NOAUTHO" text
- End
-
- When action = "DROP" then do
- If Authorize(user,node) = 0 then do
- Call Logmes user node text
- Call drop text
- End
- Else Call Logmes user node "NOAUTHO" text
- End
-
- When action = "GIME" then do
- If Authorize(user,node) = 0 then do
- Call Logmes user node text
- Call gime text
- End
- Else Call Logmes user node "NOAUTHO" text
- End
-
- When action = "CHQU" then do
- If Authorize(user,node) = 0 then do
- Call Logmes user node text
- Call chqueue text
- Return result
- End
- Else Call Logmes user node "NOAUTHO" text
- End
-
- When action = "*FAT" then do
- Call Logmes user node text
- End
-
- When action = "CHJO" then do
- If Authorize(user,node) = 0 then do
- Call Logmes user node text
- Call chjour text
- Return result
- End
- Else Call Logmes user node "NOAUTHO" text
- End
-
- Otherwise do
- If Authorize(user,node) = 0 then do
- Call send_msg user node "Invalid command" text
- Call Help
- End
- Call Logmes user node "BAD_MSG" text
- End
-End
-
-Return 1
-
-/*====================== H e l p ==============================*/
-
-Help:
-parse arg ihelp
-
-If DATATYPE(ihelp,"N") & ihelp > 0 & ihelp <= validmsg.0 then do
- Call Send_msg user node validmsg.ihelp
-End
-Else do
- Call Send_msg user node "The valid commands are:"
- do i=1 to validmsg.0
- Call Send_msg user node validmsg.i
- End
-End
-Return 0
-
-/*====================== S e n d _ m s g ==================*/
-
-Send_msg: Procedure Expose execname stop owner.
-Parse arg user node stext
-mynode = XNAME("NODEID")
-If user = XNAME("USERID") & node = mynode then Say stext
-Else do
- If node = mynode then 'CP MSG' user stext
- Else 'EXEC TELL' user 'AT' node stext
-End
-Return 0
-
-/*====================== C h e c k _ f i l e =====================*/
-
-Check_file:
-
-Parse arg fname,ftype,fuser,faddr
-
-If faddr ^= QDISK(Buffm,"ADDRESS") | fuser ^= XNAME("USERID") then do
- 'EXEC GIME 'fuser faddr '(STACK QUIET'
- If RC > 4 then Return -2
- Parse Pull fmode .
- idrop = 1
-End
-Else do
- fmode = Buffm
- idrop = 0
-End
-
-iexist = FEXIST(fname ftype fmode) - 1
-If iexist = 0 then do
- blkno = QFILE("=","BLKNO")
- blksize = QDISK(fmode,"BLKSIZE")
- size = FORMAT(blkno*blksize/1000,6,1)
-End
-If idrop then 'EXEC DROP 'fmode
-
-Return iexist
-
-/*====================== S t o p ==============================*/
-
-Stop:
- text = 'STOP'
- call warning text
-If FEXIST(execname "AUXLOG A") Then 'ERASE 'execname' AUXLOG A'
-
-Exit stop
-
-/*====================== W a r n i n g =====================*/
-
-Warning:
-
-Parse arg msg
-do i = 2 to owner.0
- Parse var owner.i user node
- If node = "" then node = XNAME("NODEID")
- Call mail user node msg
-End
-Return 0
-
-/*====================== M a i l ==============================*/
-
-Mail: Procedure Expose execname stop owner.
-
-Parse Arg user node text
-test = 1
-If ^test then
- 'EXEC MAIL' user 'AT' node '(NOPROMPT NOLOG NOEDIT FILE DUMMY MAIL A',
- 'SUBJECT' execname 'AT' XNAME("NODEID")':' text
-Else Call Send_msg user node text
-Return 0
-
-/*====================== R e c e i v e =====================*/
-
-Receive:
-
-Parse Arg spoolid fname ftype fmode
-
-'EXECIO 0 CP ( STRING ORDER READER' spoolid
-Do forever
- 'EXECIO 1000 CARD (STEM BUFF. '
- Rcsave = RC
- 'EXECIO' Buff.0 'DISKW' fname ftype fmode '0 F 80 ( STEM BUFF. '
- If Rcsave = 2 then leave
-End
- 'FINIS' fname ftype fmode
-
-Return 0
-
-/*====================== D r o p ==============================*/
-
-Drop:
-
-Parse arg . fm
-'EXEC DROP 'fm' ( QUIET'
-Call Send_msg user node "DROP "fm" ===> Rc="RC
-Return 0
-
-/*====================== G i m e ==============================*/
-
-Gime:
-
-Parse arg . fm
-'MAKEBUF'
-ibuf = Rc
-'EXEC GIME 'fm' ( QUIET STACK'
-rcsave = rc
-If rcsave <= 4 then Parse pull fmode .
-'DROPBUF' ibuf
-Call Send_msg user node "GIME "fm" ===> Rc="rcsave "fm="fmode
-Return 0
-
-/*====================== Q d i s k ===========================*/
-
-Q_disk:
-
-Parse arg . rest
-Parse Var rest opt "," ifile
-mynode = XNAME("NODEID")
-ifile = 'ABBREV'('WORD'(ifile,1),"F")
-'MAKEBUF'
-buffn = Rc
-'QUERY DISK 'opt'( STACK'
-Queue ""
-If ifile then do
- If node = mynode then do
- 'CP SPOOL PUNCH TO 'user
- End
- Else do
- 'CP SPOOL PUNCH TO 'XNAME("RSCSID")
- 'CP TAG DEV PUNCH 'node user
- End
- 'EXECIO * PUNCH '
- 'CP CLOSE PUNCH NAME' execname 'QDISK'
- 'CP SPOOL PUNCH OFF'
- If node ^= mynode then 'CP TAG DEV PUNCH'
-End
-Else do forever
- Parse pull line
- If line = "" then leave
- Call Send_msg user node line
-End
-'DROPBUF' buffn
-Return 0
-
-#endif
diff --git a/src/packlib/hepdb/scripts/rexx/hdbstart.dat b/src/packlib/hepdb/scripts/rexx/hdbstart.dat
deleted file mode 100644
index 2ac0d0b..0000000
--- a/src/packlib/hepdb/scripts/rexx/hdbstart.dat
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: hdbstart.dat,v 1.1.1.1 1996/02/28 16:23:59 mclareni Exp $
-*
-* $Log: hdbstart.dat,v $
-* Revision 1.1.1.1 1996/02/28 16:23:59 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#if defined(CERNLIB_IBMVM)
-/*DECK ID>, HDBSTART.EXEC */
-/* H D B _ S T A R T */
- If QCONSOLE("DISCO") then nop
- else do
- Say "+++ Type #CP DISC to disconnect +++"
- Say "+++ Type #CP DISC to disconnect +++"
- Say "+++ Type #CP DISC to disconnect +++"
- end
-'IDENTIFY (STACK'
-Parse pull . . locnode .
-
- 'EXEC CERNLIB CDLIB PACKLIB!NEW'
- 'LOAD CDSERV NAMEFD (NOMAP NOAUTO CLEAR START)'
-#endif
diff --git a/src/packlib/hepdb/scripts/unix/bootmail.dat b/src/packlib/hepdb/scripts/unix/bootmail.dat
deleted file mode 100755
index 88df51a..0000000
--- a/src/packlib/hepdb/scripts/unix/bootmail.dat
+++ /dev/null
@@ -1,3 +0,0 @@
-#!/bin/ksh
-subject="`hostname` rebooting at `date`"
-mail -s "${subject}" hepdb-mgr at zfatal.cern.ch < /dev/null > /dev/null
diff --git a/src/packlib/hepdb/scripts/unix/cdabend.dat b/src/packlib/hepdb/scripts/unix/cdabend.dat
deleted file mode 100644
index 6649c95..0000000
--- a/src/packlib/hepdb/scripts/unix/cdabend.dat
+++ /dev/null
@@ -1,14 +0,0 @@
-*
-* $Id: cdabend.dat,v 1.1.1.1 1996/02/28 16:24:00 mclareni Exp $
-*
-* $Log: cdabend.dat,v $
-* Revision 1.1.1.1 1996/02/28 16:24:00 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#if defined(CERNLIB_UNIX)
-#
-# This is for HEPDB. Modify at will
-#
-echo HEPDB server $CDSERV abending | mail hepdb-mgr at zfatal.cern.ch
-#endif
diff --git a/src/packlib/hepdb/scripts/unix/cdbackup.dat b/src/packlib/hepdb/scripts/unix/cdbackup.dat
deleted file mode 100644
index 9e86d41..0000000
--- a/src/packlib/hepdb/scripts/unix/cdbackup.dat
+++ /dev/null
@@ -1,143 +0,0 @@
-*
-* $Id: cdbackup.dat,v 1.2 1996/04/16 10:09:02 jamie Exp $
-*
-* $Log: cdbackup.dat,v $
-* Revision 1.2 1996/04/16 10:09:02 jamie
-* bring in sync with /afs/cern.ch/project/hepdb/scripts, aix 4 upgrade
-*
-* Revision 1.1.1.1 1996/02/28 16:24:01 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#if defined(CERNLIB_UNIX)
-#!/bin/ksh
-d=`date`
-echo
-echo CDBACKUP running at $d
-echo
-#
-# Fix for CERNSP based fatcat server
-#
-this_host=`hostname`
-
-if [ $this_host = "sp019" ]
- then export CDHOST=hepdb
- echo ${0}: setting HEPDB hostname to $CDHOST
-fi
-#
-# Delete old backup files
-#
-find /cdback0 -name *.[0-9]* -mtime +4 -exec rm {} \;
-find /cdback1 -name *.[0-9]* -mtime +4 -exec rm {} \;
-#
-# Loop over all HEPDB servers and
-# stop them
-# copy all database files to the backup area, verifying in the process
-# restart current server
-#
-log=" "
-run=" "
-nos=" "
-b="."
-#
-# Ensure that variables are defined...
-#
-for i in /hepdb/cd*
-do
- typeset -u cdgrp
- typeset -l cdserv
- cdpath=$i
- cdgrp=`basename $i`
- cdserv=$cdgrp
- eval $cdgrp=$cdpath;export $cdgrp
-#
-# Skip CDMOVE
-#
- if test $cdserv != "cdmove"
- then
-#
-# and stop those servers that are running...
-#
- if [ -x ${i}/cdserv ]
- then
-#
-# does a log file exist?
-#
- if [ -f /hepdb/${cdgrp}.log ]
- then
- echo Log file exists for ${cdgrp} - looking for existing process
- log=${log}${b}${cdgrp}
- pid=`cat /hepdb/${cdgrp}.log | awk '{printf "%s\n",$14}'`
- if (test $pid)
- then
- echo Looking for server process for $cdgrp
- if(ps -ae | grep -ws $pid )
- then
- echo CDSERV running PID = $pid
- run=${run}${b}${cdgrp}
- d=`date`
- echo Stopped at $d for backup > /hepdb/${cdserv}/todo/signal.stop
-#
-# Wait until the server is stopped
-#
- while (ps -ae | grep -s $pid )
- do
- d=`date`
- echo Server ${cdserv} still running - sleeping at $d
- sleep 60
- done
-#
-# Check that output directory exists
-#
- if [ ! -d /cdback/${cdserv} ]
- then
- echo Creating directory /cdback/${cdserv}
- mkdir /cdback/${cdserv}
- fi
-#
-# Server is now stopped - backup RZ files
-#
- echo Backing up HEPDB files in /hepdb/${cdserv} ...
- /afs/cern.ch/project/hepdb/@sys/bin/cdbackup /hepdb/${cdserv} \
- /cdback/${cdserv} >> /cdback/cdback.log
- rc=$?
- if [ $rc -ne 0 ]
- then
- echo RC = $rc for backup of RZ file for ${cdserv} | mail \
- -s "HEPDB backup for ${cdserv}" hepdb-mgr at zfatal.cern.ch
- fi
-#
-# Touch good backup file(s)
-#
- touch /cdback/${cdserv}/*.good
-#
-# and copy over names file for save keeping
-#
- cp -p /hepdb/${cdserv}/hepdb.names /cdback/${cdserv}
-#
-# Now restart server
-#
- d=`date`
- echo Restarting server for ${cdserv} at ${d}
- rm /hepdb/${cdserv}/todo/signal.stop
- cwd=`pwd`
- cd /hepdb/${cdserv}
- nohup /hepdb/${cdserv}/cdserv ${cdgrp} > /hepdb/${cdserv}/cdserv.log &
- cd ${cwd}
- else
- echo No existing server found for $cdgrp
- echo Removing old log file...
- rm /hepdb/${cdgrp}.log
- nos=${nos}${b}${cdgrp}
- fi
- fi
- fi
- fi
- fi
-done
-
-echo
-echo Log files found for $log | tr '.' ' '
-echo Servers running for $run | tr '.' ' '
-echo No server found for $nos | tr '.' ' '
-#endif
diff --git a/src/packlib/hepdb/scripts/unix/cdcheck.dat b/src/packlib/hepdb/scripts/unix/cdcheck.dat
deleted file mode 100755
index 92fe1a6..0000000
--- a/src/packlib/hepdb/scripts/unix/cdcheck.dat
+++ /dev/null
@@ -1,130 +0,0 @@
-#!/bin/ksh
-
-me=`whoami`
-
-if [ "$me" != "root" ]
- then
- echo "This script should be run from root"
- exit
-fi
-
-#
-# Ensure that variables are defined...
-#
-
-for i in /hepdb/cd*
- do
-
-typeset -u cdgrp
-cdpath=$i
-cdgrp=`basename $i`
-eval $cdgrp=$cdpath;export $cdgrp
-#
-# and start the servers
-#
-if [ -x ${i}/cdserv ]
- then
-#
-# does a log file exist?
-#
- if [ -f /hepdb/${cdgrp}.log ]
- then
-#
-# log file exists - looking for existing proces'
-#
- log=${log}${b}${cdgrp}
-#
-# change to $14 for more modern AIX
-#
- pid=`cat /hepdb/${cdgrp}.log | awk '{printf "%s\n",$14}'`
- if (test $pid)
- then
-#
-# Looking for server process $pid for $cdgrp
-#
- if (ps -ae | grep -qs $pid )
- then
-#
-# OK! server found
-#
- :
- else
-#
-# No existing server found for $cdgrp - starting server
-#
- if [ -f ${i}/todo/signal.stop ]
- then
-#
-# Send warning mail for stopped servers
-#
- subject=`echo Warning: server stopped for group ${cdgrp}`
- ls -l ${i}/todo/signal.stop | \
- mail -s " ${subject} " hepdb-mgr at zfatal.cern.ch
- else
-#
-# Send warning mail for "dead" servers (process not found)
-# (Start server for $cdgrp)
-#
- cd ${i}
- subject=`echo Error: no process found for group ${cdgrp}`
- ls -lm ${i}/cdserv.log | \
- mail -s " ${subject} " hepdb-mgr at zfatal.cern.ch
-# nohup ${i}/cdserv ${cdgrp} > $i/cdserv.log &
-
- fi # End loop over "stopped" servers
-
- fi
-#
-# Could not find PID in log file
-#
- else
- if [ -f ${i}/todo/signal.stop ]
- then
-#
-# Send warning mail for stopped servers
-#
- subject=`echo Warning: server stopped for group ${cdgrp}`
- ls -l ${i}/todo/signal.stop | \
- mail -s " ${subject} " hepdb-mgr at zfatal.cern.ch
- else
-#
-# Send warning mail for "dead" servers (process not found)
-# (Start server for $cdgrp)
-#
- cd ${i}
- subject=`echo Error: no process found for group ${cdgrp}`
- ls -lm ${i}/cdserv.log | \
- mail -s " ${subject} " hepdb-mgr at zfatal.cern.ch
-# nohup ${i}/cdserv ${cdgrp} > $i/cdserv.log &
-
- fi # End loop over "stopped" servers
-
- fi
-
- else
-#
-# Server stopped cleanly or has never been started...
-#
- if [ -f ${i}/todo/signal.stop ]
-
- then
-#
-# Send warning mail for stopped servers
-#
- subject=`echo Warning: server stopped for group ${cdgrp}`
- ls -l ${i}/todo/signal.stop | \
- mail -s " ${subject} " hepdb-mgr at zfatal.cern.ch
- else
- cd ${i}
- subject=`echo Error: no process found for group ${cdgrp}`
- ls -lm ${i}/cdserv.log | \
- mail -s " ${subject} " hepdb-mgr at zfatal.cern.ch
-# nohup ${i}/cdserv ${cdgrp} > $i/cdserv.log &
-
- fi # End loop over "stopped" servers
-
- fi # End loop over servers for which a log file (/hepdb/CDxxx.log) was found
-
-fi # End loop over servers with CDSERV script
-
-done
diff --git a/src/packlib/hepdb/scripts/unix/cdchk.dat b/src/packlib/hepdb/scripts/unix/cdchk.dat
deleted file mode 100644
index 181eb22..0000000
--- a/src/packlib/hepdb/scripts/unix/cdchk.dat
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: cdchk.dat,v 1.1.1.1 1996/02/28 16:24:01 mclareni Exp $
-*
-* $Log: cdchk.dat,v $
-* Revision 1.1.1.1 1996/02/28 16:24:01 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#if defined(CERNLIB_UNIX)
-#!/bin/ksh
-#
-# Ensure that variables are defined...
-#
-for i in /hepdb/cd*
-
- do
-
- typeset -u cdgrp
- cdpath=$i
- cdgrp=`basename $i`
- eval $cdgrp=$cdpath;export $cdgrp
-#
-# Look for startable servers (cdserv exists)
-#
- if [ -x ${i}/cdserv ]
- then
- if [ -f ${i}/todo/signal.stop ]
- then
- ls -l ${i}/todo/signal.stop | mail -s $cdgrp hepdb-mgr at zfatal.cern.ch
- fi
- fi
- done
-
-#endif
diff --git a/src/packlib/hepdb/scripts/unix/cdmake.dat b/src/packlib/hepdb/scripts/unix/cdmake.dat
deleted file mode 100644
index f8ca13f..0000000
--- a/src/packlib/hepdb/scripts/unix/cdmake.dat
+++ /dev/null
@@ -1,36 +0,0 @@
-*
-* $Id: cdmake.dat,v 1.1.1.1 1996/02/28 16:24:00 mclareni Exp $
-*
-* $Log: cdmake.dat,v $
-* Revision 1.1.1.1 1996/02/28 16:24:00 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#if defined(CERNLIB_UNIX)
-#
-# Make a new database
-#
-# export CDFILE='name of the database file'
- export CDFILE='test.dbs'
-
-# export CDPAIR='number of validity range pairs'
- export CDPAIR=1
-
-# export CDPRE='number of records to be preformatted'
- export CDPRE=100
-
-# export CDTOP='numeric ID for database'
- export CDTOP=1
-
-# export CDQUO='number of records for database quota'
- export CDQUO=65000
-
-# export CDRECL='record length of database file (words)'
- export CDRECL=1024
-
-#
-# now run the job
-#
-
- /cern/pro/bin/cdmake
-#endif
diff --git a/src/packlib/hepdb/scripts/unix/cdmove.dat b/src/packlib/hepdb/scripts/unix/cdmove.dat
deleted file mode 100644
index 23a4524..0000000
--- a/src/packlib/hepdb/scripts/unix/cdmove.dat
+++ /dev/null
@@ -1,36 +0,0 @@
-*
-* $Id: cdmove.dat,v 1.1.1.1 1996/02/28 16:24:00 mclareni Exp $
-*
-* $Log: cdmove.dat,v $
-* Revision 1.1.1.1 1996/02/28 16:24:00 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#if defined(CERNLIB_UNIX)
-#!/bin/ksh
-#
-# Example CDMOVE script. On HEPDB, this is stored as
-# /hepdb/cdmove/cdserv.
-# /hepdb/cdmove/cdsrv is a link to ~jamie/hepdb/cdmove
-#
-# This allows CDMOVE to be started by CDSTART as if it
-# were a normal database server.
-#
-#trap 'rm -f $new $old; exit 1' 1 2 15 #clean up
-t=`date`
-h=`hostname`
-echo
-echo CDMOVE starting at $t on $h
-echo
-echo $1 starting at $t on $h PID = $$ > /hepdb/${1}.log
-typeset -l cdpath
-cdpath=/hepdb/${1}
-export CDGROUPS="CDCPLEAR,CDCHORUS,CDCNDIV,CDWA97"
-export CDCPLEAR=/hepdb/cdcplear
-export CDCHORUS=/hepdb/cdchorus
-${cdpath}/cdsrv
-if [ -f /hepdb/${1}.log ]
-then
- rm -f /hepdb/${1}.log
-fi
-#endif
diff --git a/src/packlib/hepdb/scripts/unix/cdmovechk.dat b/src/packlib/hepdb/scripts/unix/cdmovechk.dat
deleted file mode 100755
index f292c4c..0000000
--- a/src/packlib/hepdb/scripts/unix/cdmovechk.dat
+++ /dev/null
@@ -1,29 +0,0 @@
-#!/bin/ksh
-#
-# Check that the HEPDB 'cdmove' server is not stuck
-#
-set -xv
-
-date
-
-tail /hepdb/cdmove/cdserv.log > /hepdb/cdmove/check1
-
-diff /hepdb/cdmove/check0 /hepdb/cdmove/check1 > /dev/null 2>&1
-
-if [ $? -eq 0 ]
-
-then
-
- logfile=/hepdb/cdmove/cdserv.log
- lm=`ls -lLm ${logfile}`
- subject=`echo ${0}: ${lm}`
- tail ${logfile} | mail -s " ${subject} " hepdb-mgr at zfatal.cern.ch
- (su - jamie;restart_cdmove;exit)
- ps -ef | grep cdmove | mail -s " cdmove restarted " hepdb-mgr at zfatal.cern.ch
-
-else
-
- mv /hepdb/cdmove/check1 /hepdb/cdmove/check0
-
-fi
-
diff --git a/src/packlib/hepdb/scripts/unix/cdnew.dat b/src/packlib/hepdb/scripts/unix/cdnew.dat
deleted file mode 100644
index 0cbac23..0000000
--- a/src/packlib/hepdb/scripts/unix/cdnew.dat
+++ /dev/null
@@ -1,79 +0,0 @@
-*
-* $Id: cdnew.dat,v 1.1.1.1 1996/02/28 16:24:00 mclareni Exp $
-*
-* $Log: cdnew.dat,v $
-* Revision 1.1.1.1 1996/02/28 16:24:00 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#if defined(CERNLIB_UNIX)
-#
-# Setup the directory and file structure for a new
-# server
-#
-iam=`whoami`
-#
-# Are we root?
-#
-if [ "$iam" != "root" ]
-then
- echo $0: This script must be run from root
- exit
-fi
-#
-# Did we get any arguments?
-#
-if [ $# != 1 ]
-then
- echo $0: usage $0 group
- exit
-fi
-#
-# Does this directory exist?
-#
-if [ -d /hepdb/$1 ]
-then
- echo $0: Directory /hepdb/$1 already exists
- exit
-fi
-#
-# No, so make it
-#
-mkdir /hepdb/$1
-#
-# and the subdirectories...
-#
-mkdir /hepdb/$1/bad
-mkdir /hepdb/$1/log
-mkdir /hepdb/$1/queue
-chmod o+w /hepdb/$1/queue
-mkdir /hepdb/$1/todo
-mkdir /hepdb/$1/save
-ls -F /hepdb/$1
-#
-# now create the names file
-#
-echo :nick.config > /hepdb/$1/hepdb.names
-echo :list.aa >> /hepdb/$1/hepdb.names
-echo :log./hepdb/$1/log >> /hepdb/$1/hepdb.names
-echo :queue./hepdb/$1/queue >> /hepdb/$1/hepdb.names
-echo :todo./hepdb/$1/todo >> /hepdb/$1/hepdb.names
-echo :save./hepdb/$1/save >> /hepdb/$1/hepdb.names
-echo :bad./hepdb/$1/bad >> /hepdb/$1/hepdb.names
-echo :loglevel.3 >> /hepdb/$1/hepdb.names
-echo :wakeup.60 >> /hepdb/$1/hepdb.names
-echo :nick.aa >> /hepdb/$1/hepdb.names
-echo :file./hepdb/$1/aa.dbs >> /hepdb/$1/hepdb.names
-echo :desc.Description of the database >> /hepdb/$1/hepdb.names
-echo :servers. >> /hepdb/$1/hepdb.names
-cat /hepdb/$1/hepdb.names
-#
-# Link the server script
-#
-ln -s /cern/new/bin/cdserv.sh /hepdb/$1/cdserv
-#
-# and the server module
-#
-ln -s /cern/new/bin/cdserv /hepdb/$1/cdsrv
-
-#endif
diff --git a/src/packlib/hepdb/scripts/unix/cdps.dat b/src/packlib/hepdb/scripts/unix/cdps.dat
deleted file mode 100644
index f822526..0000000
--- a/src/packlib/hepdb/scripts/unix/cdps.dat
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: cdps.dat,v 1.2 1996/04/16 10:09:04 jamie Exp $
-*
-* $Log: cdps.dat,v $
-* Revision 1.2 1996/04/16 10:09:04 jamie
-* bring in sync with /afs/cern.ch/project/hepdb/scripts, aix 4 upgrade
-*
-* Revision 1.1.1.1 1996/02/28 16:24:00 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#if defined(CERNLIB_UNIX)
-#echo 'HEPDB server Elapsed CPU time %CPU'
-#echo '==============================================================================='
-#ps -aef -F "args,etime,time,pcpu" | grep "/cdsrv" | sort +2 -r
-echo ' Elapsed CPU time %CPU ** HEPDB server ** '
-echo '========================================================'
-ps -aef -F "etime,time,pcpu,args" | cut -c 1-80 | grep "/cdsrv" | sort +1 -r
-
-#endif
diff --git a/src/packlib/hepdb/scripts/unix/cdqueue.dat b/src/packlib/hepdb/scripts/unix/cdqueue.dat
deleted file mode 100644
index dbd5cb4..0000000
--- a/src/packlib/hepdb/scripts/unix/cdqueue.dat
+++ /dev/null
@@ -1,48 +0,0 @@
-*
-* $Id: cdqueue.dat,v 1.1.1.1 1996/02/28 16:24:01 mclareni Exp $
-*
-* $Log: cdqueue.dat,v $
-* Revision 1.1.1.1 1996/02/28 16:24:01 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#if defined(CERNLIB_UNIX)
-#!/bin/ksh
-#
-# Ensure that variables are defined...
-#
-for i in /hepdb/cd*
-
- do
-
- typeset -u cdgrp
- cdpath=$i
- cdgrp=`basename $i`
- eval $cdgrp=$cdpath;export $cdgrp
-#
-# Look for startable servers (cdserv exists)
-#
- if [ -x ${i}/cdserv ]
- then
-#
-# Pending files?
-#
- todo=`ls ${i}/todo | wc -l`
- if [ ${todo} != "0" ]
- then
- echo ${todo} pending files for ${cdgrp} | \
- mail -s $cdgrp hepdb-mgr at zfatal.cern.ch
- fi
-
- if [ -d ${i}/tovm ]
- then
- tovm=`ls ${i}/tovm | wc -l`
- if [ ${tovm} != "0" ]
- then
- echo ${tovm} pending files for transmission to CERNVM for ${cdgrp} | \
- mail -s $cdgrp hepdb-mgr at zfatal.cern.ch
- fi
- fi
- fi
- done
-#endif
diff --git a/src/packlib/hepdb/scripts/unix/cdsend.dat b/src/packlib/hepdb/scripts/unix/cdsend.dat
deleted file mode 100644
index 732ed89..0000000
--- a/src/packlib/hepdb/scripts/unix/cdsend.dat
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: cdsend.dat,v 1.1.1.1 1996/02/28 16:24:00 mclareni Exp $
-*
-* $Log: cdsend.dat,v $
-* Revision 1.1.1.1 1996/02/28 16:24:00 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#if defined(CERNLIB_UNIX)
-#
-# Move files between two hosts
-#
-
-for file in /hepdb/cd*/tovm
-
-do
-#
-# Get prefix
-#
-
-prefix=`echo $file | awk '{ print substr($file,1,2) "'`
-
-if [ prefix == "qq" ]
- then
- continue
-fi
-done
-#endif
diff --git a/src/packlib/hepdb/scripts/unix/cdserv.dat b/src/packlib/hepdb/scripts/unix/cdserv.dat
deleted file mode 100644
index ee989c4..0000000
--- a/src/packlib/hepdb/scripts/unix/cdserv.dat
+++ /dev/null
@@ -1,48 +0,0 @@
-*
-* $Id: cdserv.dat,v 1.1.1.1 1996/02/28 16:24:00 mclareni Exp $
-*
-* $Log: cdserv.dat,v $
-* Revision 1.1.1.1 1996/02/28 16:24:00 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#if defined(CERNLIB_UNIX)
-#!/bin/ksh
-#
-# Example CDSERV script.
-#
-#trap 'rm -f $new $old; exit 1' 1 2 15 #clean up
-t=`date`
-h=`hostname`
-echo
-echo CDSERV starting at $t on $h PID = $$
-echo
-echo $1 starting at $t on $h PID = $$ > /hepdb/${1}.log
-typeset -l cdpath
-cdpath=/hepdb/${1}
-#
-# Save old logfiles
-#
-if [ -f ${cdpath}/cdserv.log ]
-then
- cat ${cdpath}/cdserv.log >> cdserv.oldlog
- echo $1 starting at $t on $h PID = $$ >> cdserv.oldlog
-fi
-
-if [ -f ${cdpath}/log/hepdb.log ]
-then
- cat ${cdpath}/log/hepdb.log >> ${cdpath}/log/hepdb.oldlog
-fi
-#
-# Now start server
-#
-${cdpath}/cdsrv
-#
-# Remove lock file
-#
-if [ -f /hepdb/${1}.log ]
-then
- rm -f /hepdb/${1}.log
-fi
-
-#endif
diff --git a/src/packlib/hepdb/scripts/unix/cdstart.dat b/src/packlib/hepdb/scripts/unix/cdstart.dat
deleted file mode 100644
index 7740782..0000000
--- a/src/packlib/hepdb/scripts/unix/cdstart.dat
+++ /dev/null
@@ -1,117 +0,0 @@
-*
-* $Id: cdstart.dat,v 1.2 1996/04/16 10:09:07 jamie Exp $
-*
-* $Log: cdstart.dat,v $
-* Revision 1.2 1996/04/16 10:09:07 jamie
-* bring in sync with /afs/cern.ch/project/hepdb/scripts, aix 4 upgrade
-*
-* Revision 1.1.1.1 1996/02/28 16:24:00 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#if defined(CERNLIB_UNIX)
-#!/bin/ksh
-start=" "
-stop=" "
-run=" "
-nolog=" "
-noscr=" "
-b="."
-me=`whoami`
-
-if [ "$me" != "root" ]
- then
- echo "This script should be run from root"
- exit
-fi
-
-#
-# Fix for CERNSP based fatcat server
-#
-this_host=`hostname`
-
-if [ $this_host = "sp019" ]
- then export CDHOST=hepdb
- echo ${0}: setting HEPDB hostname to $CDHOST
-fi
-
-#
-# Ensure that variables are defined...
-#
-
-for i in /hepdb/cd*
- do
-
-echo
-typeset -u cdgrp
-cdpath=$i
-cdgrp=`basename $i`
-echo Setting $cdgrp to $cdpath ...
-eval $cdgrp=$cdpath;export $cdgrp
-#
-# and start the servers
-#
-if [ -x ${i}/cdserv ]
- then
-#
-# does a log file exist?
-#
- if [ -f /hepdb/${cdgrp}.log ]
- then
- echo '>>> log file exists - looking for existing process'
- log=${log}${b}${cdgrp}
- pid=`cat /hepdb/${cdgrp}.log | awk '{printf "%s\n",$14}'`
- if (test $pid)
- then
- echo Looking for server process $pid for $cdgrp
- if(ps -ae | grep -s $pid )
- then
- echo CDSRV running PID = $pid
- run=${run}${b}${cdgrp}
- else
- echo No existing server found for $cdgrp - starting server
- if [ -f ${i}/todo/signal.stop ]
- then echo but signal.stop file found!
- else echo Starting server for $cdgrp
- cd ${i}
- nohup ${i}/cdserv ${cdgrp} > $i/cdserv.log &
- start=${start}${b}${cdgrp}
- fi
- fi
-
- else
- echo No existing server found for $cdgrp - starting server
- if [ -f ${i}/todo/signal.stop ]
- then echo but signal.stop file found!
- stop=${stop}${b}${cdgrp}
- else echo Starting server for $cdgrp
- cd ${i}
- nohup ${i}/cdserv ${cdgrp} > $i/cdserv.log &
- start=${start}${b}${cdgrp}
- fi
- fi
- else
- echo No server log found in $i
- if [ -f ${i}/todo/signal.stop ]
- then echo but signal.stop file found!
- stop=${stop}${b}${cdgrp}
- else echo Starting server for $cdgrp
- cd ${i}
- nohup ${i}/cdserv ${cdgrp} > $i/cdserv.log &
- start=${start}${b}${cdgrp}
- fi
- fi
- else
- echo No cdserv script found in $i - cannot start server
- scr=${scr}${b}${cdgrp}
-fi
-
-done
-
-echo
-echo Log files found for $log | tr '.' ' '
-echo Started servers for $start | tr '.' ' '
-echo Servers already running for $run | tr '.' ' '
-echo Servers stopped $stop | tr '.' ' '
-echo No scripts found for $scr | tr '.' ' '
-#endif
diff --git a/src/packlib/hepdb/scripts/unix/cdstop.dat b/src/packlib/hepdb/scripts/unix/cdstop.dat
deleted file mode 100644
index 27cac0c..0000000
--- a/src/packlib/hepdb/scripts/unix/cdstop.dat
+++ /dev/null
@@ -1,83 +0,0 @@
-*
-* $Id: cdstop.dat,v 1.2 1996/04/16 10:09:08 jamie Exp $
-*
-* $Log: cdstop.dat,v $
-* Revision 1.2 1996/04/16 10:09:08 jamie
-* bring in sync with /afs/cern.ch/project/hepdb/scripts, aix 4 upgrade
-*
-* Revision 1.1.1.1 1996/02/28 16:24:00 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#if defined(CERNLIB_UNIX)
-#!/bin/ksh
-stop=" "
-run=" "
-nolog=" "
-noscr=" "
-b="."
-d=`date`
-#
-# Ensure that variables are defined...
-#
-if [ -f restart_hepdb ]
- echo Remove old restart_hepdb file...
- then rm -i restart_hepdb
-fi
-
-for i in /hepdb/cd*
- do
-
-typeset -u cdgrp
-typeset -l cdusr
-cdpath=$i
-cdgrp=`basename $i`
-cdusr=$cdgrp
-eval $cdgrp=$cdpath;export $cdgrp
-#
-# and stop those servers that are running...
-#
-if [ -x ${i}/cdserv ]
- then
-#
-# does a log file exist?
-#
- if [ -f /hepdb/${cdgrp}.log ]
- then
- echo Log file exists for ${cdgrp} - looking for existing process
- log=${log}${b}${cdgrp}
- pid=`cat /hepdb/${cdgrp}.log | awk '{printf "%s\n",$14}'`
- if (test $pid)
- then
- echo Looking for server process for $cdgrp
- if(ps -ae | grep -s $pid )
- then
- echo CDSERV running PID = $pid
- run=${run}${b}${cdgrp}
- echo rm /hepdb/${cdusr}/todo/signal.stop >> restart_hepdb
- echo Server stopped at $d > /hepdb/${cdusr}/todo/signal.stop
- else
- echo No existing server found for $cdgrp
- echo Removing old log file...
- rm /hepdb/${cdgrp}.log
- if [ -f ${i}/todo/signal.stop ]
- then echo signal.stop file found!
- rm ${i}/todo/signal.stop
- echo '(removed)'
- fi
- fi
- fi
- fi
-fi
-
-done
-
-echo
-echo Log files found for $log | tr '.' ' '
-echo Servers already running for $run | tr '.' ' '
-echo cdstart >> restart_hepdb
-if [ -f restart_hepdb ]
- then chmod +x restart_hepdb
- echo restart servers by typing restart_hepdb
-fi
-#endif
diff --git a/src/packlib/hepdb/scripts/unix/cdvars.dat b/src/packlib/hepdb/scripts/unix/cdvars.dat
deleted file mode 100644
index 8d37d00..0000000
--- a/src/packlib/hepdb/scripts/unix/cdvars.dat
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: cdvars.dat,v 1.1.1.1 1996/02/28 16:24:00 mclareni Exp $
-*
-* $Log: cdvars.dat,v $
-* Revision 1.1.1.1 1996/02/28 16:24:00 mclareni
-* Hepdb, cdlib, etc
-*
-*
-#if defined(CERNLIB_UNIX)
-for i in /hepdb/cd*
- do
- typeset -u cdgrp
- cdpath=$i
- cdgrp=`basename $i`
- echo Setting $cdgrp to $cdpath ...
- eval $cdgrp=$cdpath;export $cdgrp
- done
-#endif
diff --git a/src/packlib/hepdb/scripts/unix/ctab.dat b/src/packlib/hepdb/scripts/unix/ctab.dat
deleted file mode 100644
index 9038a0d..0000000
--- a/src/packlib/hepdb/scripts/unix/ctab.dat
+++ /dev/null
@@ -1,7 +0,0 @@
-# Check all servers running at 08:00
-#
-0 11 * * * ( /bin/sh /u/cp/jamie/bin/cdchk ) > /dev/null 2>&1
-#
-# Check for backlogs
-#
-0 0 * * * ( /bin/sh /u/cp/jamie/bin/cdqueue ) > /dev/null 2>&1
diff --git a/src/packlib/hepdb/scripts/unix/ctab_root.dat b/src/packlib/hepdb/scripts/unix/ctab_root.dat
deleted file mode 100644
index 8ae0717..0000000
--- a/src/packlib/hepdb/scripts/unix/ctab_root.dat
+++ /dev/null
@@ -1,24 +0,0 @@
-#
-# Backup database files
-#
-0 23 * * * /afs/cern.ch/project/hepdb/scripts/cdbackup.sh > /dev/null 2>&1
-#
-# Look for servers that are stopped
-#
-0 8 * * * /afs/cern.ch/project/hepdb/scripts/cdchk > /dev/null 2>&1
-#
-# More powerful check
-#
-20 * * * * /afs/cern.ch/project/hepdb/scripts/cdcheck > /dev/null 2>&1
-#
-# Check for backlogs
-#
-# TGB - fixed syntax error
-#
-0 0 * * * /u/cp/jamie/bin/cdqueue > /dev/null 2>&1
-#
-#
-# Special check for cdmove
-#
-30 * * * * /afs/cern.ch/project/hepdb/scripts/cdmovechk >> /var/log/cdmovechk.log 2>&1
-42 8,0 * * * ( /usr/lpp/adsm/scripts/cron_adsm.pl ) >/dev/null 2>&1
diff --git a/src/packlib/kapack/Imakefile b/src/packlib/kapack/Imakefile
deleted file mode 100644
index ecbb506..0000000
--- a/src/packlib/kapack/Imakefile
+++ /dev/null
@@ -1,15 +0,0 @@
-
-#define IHaveSubdirs
-#define PassCDebugFlags
-
-AllTarget(libraries)
-
-SUBDIRS= code test kapack
-
-TopOfPackage(kapack)
-
-SubdirLibraryTarget(kapack,code)
-
-TestSubdirs(test)
-
-InstallIncludeSubdirs(kapack)
diff --git a/src/packlib/kapack/code/Imakefile b/src/packlib/kapack/code/Imakefile
deleted file mode 100644
index 0d389d2..0000000
--- a/src/packlib/kapack/code/Imakefile
+++ /dev/null
@@ -1,25 +0,0 @@
-SRCS_F= ka1to2.F kaadd.F kaaddm.F kacopy.F kadel.F kadelm.F kafree.F \ @@\
- kaget.F kagetm.F kahold.F kalen.F kalist.F kaloc.F kamake.F \ @@\
- kamsg.F kaoptn.F kapre.F kaprem.F kaprik.F kaput.F kaputm.F \ @@\
- karlse.F kaseq.F kaseqm.F kastop.F kat.F kaxad1.F kaxad2.F \ @@\
- kaxad3.F kaxadd.F kaxage.F kaxcmp.F kaxcon.F kaxdel.F kaxdl1.F \ @@\
- kaxdl2.F kaxdlv.F kaxe2i.F kaxed.F kaxend.F kaxfbk.F kaxgbk.F \ @@\
- kaxget.F kaxglv.F kaxgxa.F kaxgxd.F kaxi2e.F kaxini.F kaxinr.F \ @@\
- kaxins.F kaxjid.F kaxls1.F kaxmaj.F kaxmsg.F kaxnam.F kaxolk.F \ @@\
- kaxopn.F kaxput.F kaxrd.F kaxrlk.F kaxshl.F kaxshr.F \ @@\
- kaxtlk.F kaxwrd.F kaxwrt.F kaz1a2.F kaz1b2.F
-
-#if !defined(CERNLIB_IBM)
-SRCS_F := $(SRCS_F) kaxrcl.F
-#else
-SRCS_F := $(SRCS_F) kaxrclib.F
-#endif
-
-#if defined(CERNLIB_HPUX)
-SpecialFortranLibObjectRule(ka1to2,ka1to2,'-WF,-P',NullParameter)
-SpecialFortranLibObjectRule(kacopy,kacopy,'-WF,-P',NullParameter)
-SpecialFortranLibObjectRule(kamake,kamake,'-WF,-P',NullParameter)
-SpecialFortranLibObjectRule(kaxopn,kaxopn,'-WF,-P',NullParameter)
-#endif
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kapack/code/ka1to2.F b/src/packlib/kapack/code/ka1to2.F
deleted file mode 100644
index 31f954b..0000000
--- a/src/packlib/kapack/code/ka1to2.F
+++ /dev/null
@@ -1,125 +0,0 @@
-*
-* $Id: ka1to2.F,v 1.1.1.1 1996/03/08 11:40:51 mclareni Exp $
-*
-* $Log: ka1to2.F,v $
-* Revision 1.1.1.1 1996/03/08 11:40:51 mclareni
-* Kapack
-*
-*
-#include "kapack/pilot.h"
- SUBROUTINE KA1TO2(LUN)
-*
-*.....CONVERT A KA-FILE FROM VERSION 1 TO VERSION 2
-*
-#include "kapack/kax000.inc"
-#include "kapack/kax020.inc"
-#include "kapack/kax030.inc"
-#include "kapack/kax050.inc"
-#include "kapack/kax0a0.inc"
-*
-#if defined(CERNLIB_CRAY)
- CHARACTER*2 CHALUN
-#endif
-*
-*-----------------------------------------------------------------------
-*
- CALL KAXINN(LUN)
-*
-*.....OPEN THE KA-FILE
- IF ( KAXRCL(LUNKAF) .LE. 0 ) GO TO 91
- IF ( LBKS(LUNKAF) .EQ. 0 ) THEN
-#if defined(CERNLIB_UNIX)
- WRITE(MSG,1000) LUNKAF
- 1000 FORMAT('CRNKA506 KA1TO2: ENTER THE NAME OF THE KA-FILE FOR',
- + ' UNIT ',I3)
- CALL KAXMSG(ISYSWR,MSG)
- READ(ISYSRD,1001) MSG
- 1001 FORMAT(A)
-#endif
-#if defined(CERNLIB_CRAY)
- WRITE(CHALUN,'(I2)') LUNKAF
- MSG = 'fort.'//CHALUN(INDEX(CHALUN,' ')+1:2)
-#endif
-#if !defined(CERNLIB_NORD)
- OPEN ( ACCESS = 'DIRECT',
-#endif
-#if defined(CERNLIB_NORD)
- OPEN ( BUFFER_SIZE = KAXRCL ( LUNKAF ),
- + MODE = 'SEGMENT',
-#endif
-#if defined(CERNLIB_UNIX)||defined(CERNLIB_CRAY)
- + FILE = MSG(1:INDEX(MSG,' ')-1),
-#endif
- + ERR = 92,
- + FORM = 'UNFORMATTED',
- + IOSTAT = IOS,
- + RECL = KAXRCL(LUNKAF),
-#if defined(CERNLIB_VAX)
- + STATUS = 'UNKNOWN',
-#endif
-#if defined(CERNLIB_CRAY)
- + STATUS = 'OLD',
-#endif
- + UNIT = LUNKAF )
- IF ( IOS .NE. 0 ) GO TO 92
- ENDIF
-*
-*.....VALIDATE THE FILE ATTRIBUTES
- READ(LUNKAF,ERR=93,IOSTAT=IOS,REC=1) (IA(I),I=1,NBCW1)
- IF ( IOS .NE. 0 ) GO TO 93
- IF ( IA(13) .NE. 1 ) GO TO 94
- IF ( IA(15) .GT. LBUF ) GO TO 95
-*
-*.....STORE FILE-DEPENDENT PARAMETERS
- NBLKS = IA(14)
- LBLK = IA(15)
- MAXPAK = IA(16)
-*
-*.....DO THE CONVERSION FOR ALL NON-FREE BLOCKS
- DO 1 NBLOCK = NBLKS, 1, -1
- CALL KAXRD(NBLOCK,IA,LBLK)
- IF ( IA(4).NE.0 .AND. IA(8).LE.1 ) THEN
- CALL KAZ1A2
- IF ( NBLOCK .EQ. 1 ) IA(13) = 2
- CALL KAXWRT(NBLOCK,IA,LBLK)
- ENDIF
- 1 CONTINUE
-*
-*.....SUCCESSFUL COMPLETION
- WRITE(MSG,100) LUNKAF
- CALL KAXMSG(LUNLOG,MSG)
- STOP
-*
-*.....ERROR PROCESSING
- 91 WRITE(MSG,191) LUNKAF
- GO TO 99
-*
- 92 WRITE(MSG,192) LUNKAF, IOS
- GO TO 99
-*
- 93 WRITE(MSG,193) LUNKAF, IOS
- GO TO 99
-*
- 94 WRITE(MSG,194) LUNKAF
- GO TO 99
-*
- 95 WRITE(MSG,195) IA(15), LUNKAF, LBUF
- GO TO 99
-*
- 99 CALL KAXMSG(LUNERR,MSG)
- CALL KAXEND
-*
- 100 FORMAT('CRNKA500 KA1TO2: CONVERSION COMPLETE FOR THE KA-FILE ON
- + UNIT ',I3)
- 191 FORMAT('CRNKA501 KA1TO2: UNABLE TO OBTAIN THE BLOCK LENGTH FOR
- + THE KA-FILE ON UNIT ',I3)
- 192 FORMAT('CRNKA502 KA1TO2: ERROR WHILE OPENING THE KA-FILE ON
- + UNIT ',I3,', IOSTAT = ',I11)
- 193 FORMAT('CRNKA503 KA1TO2: I/O ERROR WHILE READING BLOCK 1 FROM
- + UNIT ',I3,', IOSTAT = ',I11)
- 194 FORMAT('CRNKA504 KA1TO2: THE KA-FILE ON UNIT ',I3,
- + ' CANNOT BE CONVERTED AS IT IS NOT A VERSION 1 KA-FILE')
- 195 FORMAT('CRNKA505 KA1TO2: THE BLOCK LENGTH OF ',I11,' WORDS ON
- + UNIT ',I3,' EXCEEDS THE BUFFER LENGTH OF ',I11,' WORDS')
-*
- END
diff --git a/src/packlib/kapack/code/kaadd.F b/src/packlib/kapack/code/kaadd.F
deleted file mode 100644
index c87ac9e..0000000
--- a/src/packlib/kapack/code/kaadd.F
+++ /dev/null
@@ -1,102 +0,0 @@
-*
-* $Id: kaadd.F,v 1.1.1.1 1996/03/08 11:40:51 mclareni Exp $
-*
-* $Log: kaadd.F,v $
-* Revision 1.1.1.1 1996/03/08 11:40:51 mclareni
-* Kapack
-*
-*
-#include "kapack/pilot.h"
- SUBROUTINE KAADD(LUN,MAJNAM,MINNAM,IDATA,LDATA,IRC)
-*
-*.....ADD A RECORD TO A KA-FILE
-*
-#include "kapack/kax000.inc"
-#include "kapack/kax020.inc"
-#include "kapack/kax050.inc"
-#include "kapack/kax0a0.inc"
-*
- CHARACTER MAJNAM*(*), MINNAM*(*)
-*
- INTEGER IDATA(*)
-*
-*-----------------------------------------------------------------------
-*
- CALL KAXINI(LUN)
- IF ( .NOT. MODIFY ) GO TO 21
-*
-*.....PROCESS THE MAJOR NAME
- CALL KAXMAJ(MAJNAM,*11,*31)
-*
-*.....CHECK THE RECORD LENGTH, LDATA
- IF ( LDATA.LT.-1 .OR. LDATA.GT.KLMAX(0) ) GO TO 13
- LXDATA = LDATA
- IF ( LXDATA .EQ. -1 ) LXDATA = KLDEF(0)
-*
-*.....CONVERT THE MINOR NAME TO A KEY
- CALL KAXNAM(MINNAM,MINKEY,*12)
-*
-*.....ADD THE RECORD TO THE MINOR TREE
- CALL KAXADD(KROOT(0),MINKEY,IDATA,LXDATA,*41,*91)
-*
-*.....SUCCESSFUL COMPLETION
- IRC = 0
- WRITE(MSG,100) MAJNAM, MINNAM, LXDATA, LUN
- CALL KAXMSG(LUNLOG,MSG)
- RETURN
-*
-*.....ERROR PROCESSING
- 11 IRC = 1
- WRITE(MSG,111) MAJNAM
- GO TO 99
-*
- 12 IRC = 1
- WRITE(MSG,112) MINNAM
- GO TO 99
-*
- 13 IRC = 1
- WRITE(MSG,113) LDATA, KLMAX(0), MAJNAM
- GO TO 99
-*
- 21 IRC = 2
- WRITE(MSG,121) LUN
- GO TO 99
-*
- 31 IRC = 3
- WRITE(MSG,131) MAJNAM, MINNAM, LUN
- GO TO 99
-*
- 41 IRC = 4
- WRITE(MSG,141) MAJNAM, MINNAM, LUN
- GO TO 99
-*
- 91 WRITE(MSG,191) MAJNAM, MINNAM, LUN
- CALL KAXMSG(LUNERR,MSG)
- CALL KAXEND
-*
- 99 CALL KAXMSG(LUNERR,MSG)
- IF ( RETURN ) RETURN
- CALL KAXEND
-*
- 100 FORMAT('CRNKA010 KAADD: ''',A,' ',A,''' OF LENGTH ',I11,
- + ' WORDS HAS BEEN ADDED TO THE KA-FILE ON UNIT ',I3)
- 111 FORMAT('CRNKA011 KAADD: ''',A,''' IS NOT AN ACCEPTABLE MAJOR
- + NAME')
- 112 FORMAT('CRNKA012 KAADD: ''',A,''' IS NOT AN ACCEPTABLE MINOR
- + NAME')
- 113 FORMAT('CRNKA013 KAADD: ',I11,' IS NOT AN ACCEPTABLE RECORD ',
- + ' LENGTH, IT MUST BE IN THE RANGE 0 - ',I11,
- + ' FOR MAJOR NAME ''',A,'''')
- 121 FORMAT('CRNKA014 KAADD: MODIFICATION ATTEMPTED ON UNIT ',I3,
- + ' WITH MODIFY=NO SET')
- 131 FORMAT('CRNKA015 KAADD: ADDITION OF ''',A,' ',A,''' FAILED
- + ON UNIT ',I3,', THE MAJOR NAME DOES NOT EXIST IN THE
- + KA-FILE')
- 141 FORMAT('CRNKA016 KAADD: ADDITION OF ''',A,' ',A,''' FAILED
- + ON UNIT ',I3,', THIS RECORD ALREADY EXISTS IN THE
- + KA-FILE')
- 191 FORMAT('CRNKA017 KAADD: ADDITION OF ''',A,' ',A,''' FAILED
- + ON UNIT ',I3,', THE KA-FILE CONTAINS INSUFFICIENT FREE
- + SPACE')
-*
- END
diff --git a/src/packlib/kapack/code/kaaddm.F b/src/packlib/kapack/code/kaaddm.F
deleted file mode 100644
index d77702a..0000000
--- a/src/packlib/kapack/code/kaaddm.F
+++ /dev/null
@@ -1,122 +0,0 @@
-*
-* $Id: kaaddm.F,v 1.1.1.1 1996/03/08 11:40:51 mclareni Exp $
-*
-* $Log: kaaddm.F,v $
-* Revision 1.1.1.1 1996/03/08 11:40:51 mclareni
-* Kapack
-*
-*
-#include "kapack/pilot.h"
- SUBROUTINE KAADDM(LUN,MAJNAM,LDEF,LMAX,IRC)
-*
-*.....ADD A MAJOR ENTRY TO A KA-FILE
-*
-#include "kapack/kax000.inc"
-#include "kapack/kax020.inc"
-#include "kapack/kax02c.inc"
-#include "kapack/kax050.inc"
-#include "kapack/kax0b0.inc"
-*
- CHARACTER MAJNAM*(*)
-*
- PARAMETER (MAJLEN=3)
- INTEGER MAJREC(1:MAJLEN)
-*
-*-----------------------------------------------------------------------
-*
- CALL KAXINI(LUN)
- IF ( .NOT. MODIFY ) GO TO 21
-*
-*.....CHECK THE DEFAULT AND MAXIMUM LENGTHS
- IF ( LDEF .LT. 0 ) GO TO 12
- IF ( LMAX .LT. 0 ) GO TO 13
- IF ( LDEF .GT. LMAX ) GO TO 14
-*
-*.....CONVERT THE MAJOR NAME TO A KEY
- CALL KAXNAM(MAJNAM,MAJKEY,*11)
-*
-*.....GET A ROOT BLOCK, BUILD MAJOR ENTRY AND ADD IT TO THE MAJOR TREE
-* . . (NOTE THAT BLOCK 1 MUST BE LOCKED THROUGHOUT THIS PROCESS)
- CALL KAXOLK(1)
- CALL KAXGBK(IROOT)
- MAJREC(1) = IROOT
- MAJREC(2) = LDEF
- MAJREC(3) = LMAX
- CALL KAXADD(1,MAJKEY,MAJREC,MAJLEN,*31,*91)
- CALL KAXRLK(1)
-*
-*.....INITIALIZE THE ROOT BLOCK OF THE MINOR TREE
- CALL UZERO(IB,1,NBCW)
- IB(1) = IROOT
- IB(4) = IROOT
- IB(5) = 1
- IB(6) = NBCW + 1
- IB(7) = IB(6) + 3
- IB(NBCW+1) = 3
- IB(NBCW+2) = 2
- IB(NBCW+3) = MAXKEY
- CALL KAXWRT(IROOT,IB,NBCW+4)
-*
-*.....SUCCESSFUL COMPLETION
- IRC = 0
- WRITE(MSG,100) MAJNAM, LUN, LDEF, LMAX
- CALL KAXMSG(LUNLOG,MSG)
- RETURN
-*
-*.....ERROR PROCESSING
- 11 IRC = 1
- WRITE(MSG,111) MAJNAM
- GO TO 99
-*
- 12 IRC = 1
- WRITE(MSG,112) LDEF
- GO TO 99
-*
- 13 IRC = 1
- WRITE(MSG,113) LMAX
- GO TO 99
-*
- 14 IRC = 1
- WRITE(MSG,114) LDEF, LMAX
- GO TO 99
-*
- 21 IRC = 2
- WRITE(MSG,121) LUN
- GO TO 99
-*
- 31 IRC = 3
- CALL KAXFBK(IROOT)
- CALL KAXRLK(1)
- WRITE(MSG,131) MAJNAM, LUN
- GO TO 99
-*
- 91 CALL KAXFBK(IROOT)
- WRITE(MSG,191) MAJNAM, LUN
- CALL KAXMSG(LUNERR,MSG)
- CALL KAXEND
-*
- 99 CALL KAXMSG(LUNERR,MSG)
- IF ( RETURN ) RETURN
- CALL KAXEND
-*
- 100 FORMAT('CRNKA020 KAADDM: MAJOR NAME ''',A,
- + ''' HAS BEEN ADDED TO THE KA-FILE ON UNIT ',I3,
- + ' WITH DEFAULT LENGTH ',I11,' AND MAXIMUM LENGTH ',I11)
- 111 FORMAT('CRNKA021 KAADDM: ''',A,''' IS NOT AN ACCEPTABLE MAJOR
- + NAME')
- 112 FORMAT('CRNKA022 KAADDM: ',I11,' IS NOT AN ACCEPTABLE VALUE FOR
- + THE DEFAULT RECORD LENGTH')
- 113 FORMAT('CRNKA023 KAADDM: ',I11,' IS NOT AN ACCEPTABLE VALUE FOR
- + THE MAXIMUM RECORD LENGTH')
- 114 FORMAT('CRNKA024 KAADDM: THE DEFAULT RECORD LENGTH OF ',I11,
- + ' EXCEEDS THE MAXIMUM RECORD LENGTH OF ',I11)
- 121 FORMAT('CRNKA025 KAADDM: MODIFICATION ATTEMPTED ON UNIT ',I3,
- + ' WITH MODIFY=NO SET')
- 131 FORMAT('CRNKA026 KAADDM: ADDITION OF MAJOR NAME ''',A,
- + ''' FAILED ON UNIT ',I3,
- + ', THIS MAJOR NAME ALREADY EXISTS IN THE KA-FILE')
- 191 FORMAT('CRNKA027 KAADDM: ADDITION OF MAJOR NAME ''',A,
- + ''' FAILED ON UNIT ',I3,', THE KA-FILE CONTAINS
- + INSUFFICIENT FREE SPACE')
-*
- END
diff --git a/src/packlib/kapack/code/kacopy.F b/src/packlib/kapack/code/kacopy.F
deleted file mode 100644
index bbd0c7a..0000000
--- a/src/packlib/kapack/code/kacopy.F
+++ /dev/null
@@ -1,236 +0,0 @@
-*
-* $Id: kacopy.F,v 1.1.1.1 1996/03/08 11:40:51 mclareni Exp $
-*
-* $Log: kacopy.F,v $
-* Revision 1.1.1.1 1996/03/08 11:40:51 mclareni
-* Kapack
-*
-*
-#include "kapack/pilot.h"
- SUBROUTINE KACOPY(LUNIN,LUNOUT,MODE,IRC)
-*
-*.....COPY, LOAD, UNLOAD OR EXTEND A KA-FILE
-*
-#include "kapack/kax000.inc"
-#include "kapack/kax020.inc"
-#include "kapack/kax030.inc"
-#include "kapack/kax050.inc"
-#include "kapack/kax0a0.inc"
-*
-#if defined(CERNLIB_CRAY)
- CHARACTER*2 CHALUN
-#endif
- INTEGER IFREE(1:4)
-*
-*-----------------------------------------------------------------------
-*
- CALL KAXINN(LUNIN)
-*
-*.....CHECK THE ARGUMENTS
- IF ( LUNOUT.LT.1 .OR. LUNOUT.GT.MAXLUN ) GO TO 11
- IF ( MODE.LT.1 .OR.
- + (MODE.GT.3.AND.MODE.LT.10) .OR.
- + MODE.GT.1000 ) GO TO 12
-*
-*.....OPEN THE INPUT FILE AND READ THE FIRST BLOCK
- NBLOCK = 1
- IF ( MODE .EQ. 2 ) THEN
- REWIND LUNIN
- READ(LUNIN,ERR=91,IOSTAT=IOS) (IA(I),I=1,15),
- + (IA(J),J=16,IA(15))
- IF ( IOS .NE. 0 ) GO TO 91
- ELSE
- CALL KAXINI(LUNIN)
- CALL KAXRD(NBLOCK,IA,LBLK)
- ENDIF
- NXFREE = IA( 3)
- NB = IA(14)
- LBKIN = IA(15)
-*
-*.....OPEN THE OUTPUT FILE
- IF ( MODE .EQ. 1 ) THEN
- REWIND LUNOUT
- ELSE IF ( LBKS(LUNOUT) .EQ. 0 ) THEN
-#if defined(CERNLIB_UNIX)
- WRITE(MSG,1000) LUNOUT
- 1000 FORMAT('CRNKA28A KAMAKE: ENTER THE NAME OF THE KA-FILE FOR',
- + ' UNIT ',I3)
- CALL KAXMSG(ISYSWR,MSG)
- READ(ISYSRD,1001) MSG
- 1001 FORMAT(A)
-#endif
-#if defined(CERNLIB_CRAY)
- WRITE(CHALUN,'(I2)') LUNOUT
- MSG = 'fort.'//CHALUN(INDEX(CHALUN,' ')+1:2)
-#endif
-#if !defined(CERNLIB_NORD)
- OPEN ( ACCESS = 'DIRECT',
-#endif
-#if defined(CERNLIB_NORD)
- OPEN ( BUFFER_SIZE = LWORD * LBKIN,
- + MODE = 'SEGMENT',
-#endif
-#if defined(CERNLIB_UNIX)||defined(CERNLIB_CRAY)
- + FILE = MSG(1:INDEX(MSG,' ')-1),
-#endif
- + ERR = 92,
- + FORM = 'UNFORMATTED',
- + IOSTAT = IOS,
- + RECL = LWORD*LBKIN,
-#if defined(CERNLIB_VAX)
- + STATUS = 'UNKNOWN',
-#endif
-#if defined(CERNLIB_CRAY)
- + STATUS = 'NEW',
-#endif
- + UNIT = LUNOUT )
- IF ( IOS .NE. 0 ) GO TO 92
- LBKS(LUNOUT) = -1
- ELSE
- GO TO 93
- ENDIF
-*
-*.....WRITE THE FIRST BLOCK
- IF ( MODE .EQ. 1 ) THEN
- WRITE(LUNOUT,ERR=94,IOSTAT=IOS) (IA(I),I=1,LBKIN)
- IF ( IOS .NE. 0 ) GO TO 94
- ELSE
- WRITE(LUNOUT,ERR=94,IOSTAT=IOS,REC=NBLOCK) (IA(I),I=1,LBKIN)
- IF ( IOS .NE. 0 ) GO TO 94
- ENDIF
-*
-*.....COPY THE REMAINING BLOCKS
- DO 1 NBLOCK = 2, NB
- IF ( MODE .EQ. 2 ) THEN
- READ(LUNIN,END=96,ERR=91,IOSTAT=IOS) (IA(I),I=1,LBKIN)
- IF ( IOS .NE. 0 ) GO TO 91
- ELSE
- CALL KAXRD(NBLOCK,IA,LBKIN)
- ENDIF
- IF ( IA(1) .NE. NBLOCK ) GO TO 95
- IF ( MODE .EQ. 1 ) THEN
- WRITE(LUNOUT,ERR=94,IOSTAT=IOS) (IA(I),I=1,LBKIN)
- IF ( IOS .NE. 0 ) GO TO 94
- ELSE
- WRITE(LUNOUT,ERR=94,IOSTAT=IOS,REC=NBLOCK) (IA(I),I=1,LBKIN)
- IF ( IOS .NE. 0 ) GO TO 94
- ENDIF
- 1 CONTINUE
-*
-*.....CHAIN THE NEW FREE BLOCKS IF EXPANSION HAS BEEN REQUESTED
- IF ( MODE .LT. 10 ) THEN
- NEW = 0
- NXFREE= IA(3)
- ELSE
- NEW = NINT(REAL(NB)*REAL(MODE)/100.0)
- IFREE(2) = 0
- IFREE(3) = NXFREE
- IFREE(4) = 0
- DO 2 NBLOCK = NB+NEW, NB+1, -1
- IFREE(1) = NBLOCK
- WRITE(LUNOUT,ERR=94,IOSTAT=IOS,REC=NBLOCK) IFREE
- IF ( IOS .NE. 0 ) GO TO 94
- IFREE(3) = NBLOCK
- 2 CONTINUE
- CALL KAXRD(1,IA,LBKIN)
- IA( 2) = IA( 2) + NEW
- IA( 3) = IFREE(1)
- IA(14) = NB + NEW
- WRITE(LUNOUT,ERR=94,IOSTAT=IOS,REC=1) (IA(I),I=1,LBKIN)
- IF ( IOS .NE. 0 ) GO TO 94
- ENDIF
-*
-*.....VERIFY THAT THE LAST BLOCK WAS WRITTEN CORRECTLY IF MODE>1
- IF ( MODE .GT. 1 ) THEN
- IA(1) = -1
- IA(3) = -1
- READ(LUNOUT,ERR=97,IOSTAT=IOS,REC=NB+NEW) ( IA(I), I=1,3 )
- IF ( IOS .NE. 0 ) GO TO 97
- IF ( IA(1).NE.NB+NEW .OR. IA(3).NE.NXFREE ) GO TO 97
- ENDIF
-*
-*.....SUCCESSFUL COMPLETION
- IRC = 0
- IF ( MODE .EQ. 1 ) WRITE(MSG,101) NB, LUNIN, LUNOUT
- IF ( MODE .EQ. 2 ) WRITE(MSG,102) NB, LUNIN, LUNOUT
- IF ( MODE .EQ. 3 ) WRITE(MSG,103) NB, LUNIN, LUNOUT
- IF ( MODE .GE. 10) WRITE(MSG,110) NB, LUNIN, LUNOUT, NEW, MODE
- CALL KAXMSG(LUNLOG,MSG)
- RETURN
-*
-*.....ERROR PROCESSING
- 11 IRC = 1
- WRITE(MSG,111) LUNOUT, MAXLUN
- GO TO 99
-*
- 12 IRC = 1
- WRITE(MSG,112) MODE
- GO TO 99
-*
- 91 WRITE(MSG,191) NBLOCK, LUNIN, IOS
- CALL KAXMSG(LUNERR,MSG)
- CALL KAXEND
-*
- 92 WRITE(MSG,192) LUNOUT, IOS
- CALL KAXMSG(LUNERR,MSG)
- CALL KAXEND
-*
- 93 WRITE(MSG,193) LUNOUT
- CALL KAXMSG(LUNERR,MSG)
- CALL KAXEND
-*
- 94 WRITE(MSG,194) NBLOCK, LUNOUT, IOS
- CALL KAXMSG(LUNERR,MSG)
- CALL KAXEND
-*
- 95 WRITE(MSG,195) LUNIN, NBLOCK, IA(1)
- CALL KAXMSG(LUNERR,MSG)
- CALL KAXEND
-*
- 96 WRITE(MSG,196) LUNIN, NBLOCK, NB, IOS
- CALL KAXMSG(LUNERR,MSG)
- CALL KAXEND
-*
- 97 WRITE(MSG,197) LUNOUT, IOS
- CALL KAXMSG(LUNERR,MSG)
- CALL KAXEND
-*
- 99 CALL KAXMSG(LUNERR,MSG)
- IF ( RETURN ) RETURN
- CALL KAXEND
-*
- 101 FORMAT('CRNKA280 KACOPY: ',I11,
- + ' BLOCKS SUCCESSFULLY UNLOADED FROM THE KA-FILE ON UNIT ',
- + I3,' TO THE SEQUENTIAL FILE ON UNIT ',I3)
- 102 FORMAT('CRNKA280 KACOPY: ',I11,' BLOCKS SUCCESSFULLY LOADED ',
- + ' FROM THE SEQUENTIAL FILE ON UNIT ',I3,
- + ' TO THE KA-FILE ON UNIT ',I3)
- 103 FORMAT('CRNKA280 KACOPY: ',I11,
- + ' BLOCKS SUCCESSFULLY COPIED FROM THE KA-FILE ON UNIT ',I3,
- + ' TO THE KA-FILE ON UNIT ',I3)
- 110 FORMAT('CRNKA280 KACOPY: ',I11,
- + ' BLOCKS SUCCESSFULLY COPIED FROM THE KA-FILE ON UNIT ',I3,
- + ' TO THE KA-FILE ON UNIT ',I3,' WITH THE ADDITION OF ',I11,
- + ' (',I11,'%) NEW BLOCKS')
- 111 FORMAT('CRNKA281 KACOPY: ',I11,' IS NOT AN ACCEPTABLE UNIT NUMBER
- + FOR THE OUTPUT FILE, IT MUST BE IN THE RANGE 1 - ',I3)
- 112 FORMAT('CRNKA282 KACOPY: ',I11,' IS NOT AN ACCEPTABLE MODE, IT
- + MUST BE IN THE RANGE 1-3 OR 10-1000')
- 191 FORMAT('CRNKA283 KACOPY: I/O ERROR WHILE READING BLOCK ',I11,
- + ' FROM UNIT ',I3,', IOSTAT = ',I11)
- 192 FORMAT('CRNKA284 KACOPY: ERROR WHILE OPENING THE FILE ON UNIT ',
- + I3,', IOSTAT = ',I11)
- 193 FORMAT('CRNKA285 KACOPY: ATTEMPT TO OVERWRITE AN EXISTING KA-FILE
- + ON UNIT ',I3)
- 194 FORMAT('CRNKA286 KACOPY: I/O ERROR WHILE WRITING BLOCK ',I11,
- + ' TO UNIT ',I3,', IOSTAT = ',I11)
- 195 FORMAT('CRNKA287 KACOPY: INVALID BLOCK NUMBER OR IDENTIFIER ON
- + UNIT ',I3,', NUMBER = ',I11,', IDENTIFIER = ',I11)
- 196 FORMAT('CRNKA288 KACOPY: EOF ENCOUNTERED ON UNIT ',I3,
- + ' WHILE READING BLOCK ',I11,
- + ' FROM THE KA-FILE WHICH SHOULD CONTAIN ',I11,' BLOCKS, ',
- + ' IOSTAT = ',I11)
- 197 FORMAT('CRNKA289 KACOPY: ERROR(S) OCCURRED DURING CREATION OF THE
- + NEW KA-FILE ON UNIT ',I3,', IOSTAT = ',I11)
-*
- END
diff --git a/src/packlib/kapack/code/kadel.F b/src/packlib/kapack/code/kadel.F
deleted file mode 100644
index f6023e5..0000000
--- a/src/packlib/kapack/code/kadel.F
+++ /dev/null
@@ -1,81 +0,0 @@
-*
-* $Id: kadel.F,v 1.1.1.1 1996/03/08 11:40:51 mclareni Exp $
-*
-* $Log: kadel.F,v $
-* Revision 1.1.1.1 1996/03/08 11:40:51 mclareni
-* Kapack
-*
-*
-#include "kapack/pilot.h"
- SUBROUTINE KADEL(LUN,MAJNAM,MINNAM,IRC)
-*
-*.....DELETE A RECORD FROM A KA-FILE
-*
-#include "kapack/kax000.inc"
-#include "kapack/kax020.inc"
-#include "kapack/kax050.inc"
-#include "kapack/kax0a0.inc"
-*
- CHARACTER MAJNAM*(*), MINNAM*(*)
-*
-*-----------------------------------------------------------------------
-*
- CALL KAXINI(LUN)
- IF ( .NOT. MODIFY ) GO TO 21
-*
-*.....PROCESS THE MAJOR NAME
- CALL KAXMAJ(MAJNAM,*11,*31)
-*
-*.....CONVERT THE MINOR NAME TO A KEY
- CALL KAXNAM(MINNAM,MINKEY,*12)
-*
-*.....DELETE THE RECORD
- CALL KAXDEL(KROOT(0),MINKEY,*41)
-*
-*.....SUCCESSFUL COMPLETION
- IRC = 0
- WRITE(MSG,100) MAJNAM, MINNAM, LUN
- CALL KAXMSG(LUNLOG,MSG)
- RETURN
-*
-*.....ERROR PROCESSING
- 11 IRC = 1
- WRITE(MSG,111) MAJNAM
- GO TO 99
-*
- 12 IRC = 1
- WRITE(MSG,112) MINNAM
- GO TO 99
-*
- 21 IRC = 2
- WRITE(MSG,121) LUN
- GO TO 99
-*
- 31 IRC = 3
- WRITE(MSG,131) MAJNAM, MINNAM, LUN
- GO TO 99
-*
- 41 IRC = 4
- WRITE(MSG,141) MAJNAM, MINNAM, LUN
- GO TO 99
-*
- 99 CALL KAXMSG(LUNERR,MSG)
- IF ( RETURN ) RETURN
- CALL KAXEND
-*
- 100 FORMAT('CRNKA030 KADEL: ''',A,' ',A,
- + ''' HAS BEEN DELETED FROM THE KA-FILE ON UNIT ',I3)
- 111 FORMAT('CRNKA031 KADEL: ''',A,''' IS NOT AN ACCEPTABLE MAJOR
- + NAME')
- 112 FORMAT('CRNKA032 KADEL: ''',A,''' IS NOT AN ACCEPTABLE MINOR
- + NAME')
- 121 FORMAT('CRNKA033 KADEL: MODIFICATION ATTEMPTED ON UNIT ',I3,
- + ' WITH MODIFY=NO SET')
- 131 FORMAT('CRNKA034 KADEL: DELETION OF ''',A,' ',A,''' FAILED
- + ON UNIT ',I3,', THE MAJOR NAME DOES NOT EXIST IN THE
- + KA-FILE')
- 141 FORMAT('CRNKA035 KADEL: DELETION OF ''',A,' ',A,''' FAILED
- + ON UNIT ',I3,', THIS RECORD DOES NOT EXIST IN THE
- + KA-FILE')
-*
- END
diff --git a/src/packlib/kapack/code/kadelm.F b/src/packlib/kapack/code/kadelm.F
deleted file mode 100644
index 1f0273e..0000000
--- a/src/packlib/kapack/code/kadelm.F
+++ /dev/null
@@ -1,87 +0,0 @@
-*
-* $Id: kadelm.F,v 1.1.1.1 1996/03/08 11:40:51 mclareni Exp $
-*
-* $Log: kadelm.F,v $
-* Revision 1.1.1.1 1996/03/08 11:40:51 mclareni
-* Kapack
-*
-*
-#include "kapack/pilot.h"
- SUBROUTINE KADELM(LUN,MAJNAM,IRC)
-*
-*.....DELETE A MAJOR ENTRY FROM A KA-FILE
-*
-#include "kapack/kax000.inc"
-#include "kapack/kax020.inc"
-#include "kapack/kax02c.inc"
-#include "kapack/kax050.inc"
-#include "kapack/kax0a0.inc"
-#include "kapack/kax0b0.inc"
-*
- CHARACTER MAJNAM*(*)
-*
-*-----------------------------------------------------------------------
-*
- CALL KAXINI(LUN)
- IF ( .NOT. MODIFY ) GO TO 21
-*
-*.....PROCESS THE MAJOR NAME
- CALL KAXMAJ(MAJNAM,*11,*31)
-*
-*.....ENSURE THERE ARE NO ASSOCIATED RECORDS
- CALL KAXRD(KROOT(0),IB,NBCW+NRCW+2)
- IF ( IB(5).NE.1 .OR. IB(IB(6)+NRCW+1).NE.MAXKEY ) GO TO 41
-*
-*.....INVALIDATE THE MAJOR STACK ENTRIES
- KUNIT(0) = -1
- KUNIT(1) = -1
-*
-*.....DELETE THE MAJOR ENTRY AND FREE THE ROOT BLOCK OF THE MINOR TREE
-* . . (NOTE THAT BLOCK 1 MUST BE LOCKED THROUGHOUT THIS PROCESS)
- CALL KAXOLK(1)
- CALL KAXDEL(1,MAJKEY,*31)
- CALL KAXFBK(KROOT(0))
- CALL KAXRLK(1)
-*
-*.....SUCCESSFUL COMPLETION
- IRC = 0
- WRITE(MSG,100) MAJNAM, LUN
- CALL KAXMSG(LUNLOG,MSG)
- RETURN
-*
-*.....ERROR PROCESSING
- 11 IRC = 1
- WRITE(MSG,111) MAJNAM
- GO TO 99
-*
- 21 IRC = 2
- WRITE(MSG,121) LUN
- GO TO 99
-*
- 31 IRC = 3
- CALL KAXRLK(1)
- WRITE(MSG,131) MAJNAM, LUN
- GO TO 99
-*
- 41 IRC = 4
- WRITE(MSG,141) MAJNAM, LUN
- GO TO 99
-*
- 99 CALL KAXMSG(LUNERR,MSG)
- IF ( RETURN ) RETURN
- CALL KAXEND
-*
- 100 FORMAT('CRNKA040 KADELM: MAJOR NAME ''',A,''' HAS BEEN DELETED
- + FROM THE KA-FILE ON UNIT ',I3)
- 111 FORMAT('CRNKA041 KADELM: ''',A,''' IS NOT AN ACCEPTABLE MAJOR
- + NAME')
- 121 FORMAT('CRNKA042 KADELM: MODIFICATION ATTEMPTED ON UNIT ',I3,
- + ' WITH MODIFY=NO SET')
- 131 FORMAT('CRNKA043 KADELM: DELETION OF MAJOR NAME ''',A,
- + ''' FAILED ON UNIT ',I3,', THIS MAJOR NAME DOES NOT EXIST
- + IN THE KA-FILE')
- 141 FORMAT('CRNKA044 KADELM: DELETION OF MAJOR NAME ''',A,
- + ''' FAILED ON UNIT ',I3,', THIS MAJOR NAME STILL HAS
- + ASSOCIATED RECORDS')
-*
- END
diff --git a/src/packlib/kapack/code/kafree.F b/src/packlib/kapack/code/kafree.F
deleted file mode 100644
index 0efae2b..0000000
--- a/src/packlib/kapack/code/kafree.F
+++ /dev/null
@@ -1,82 +0,0 @@
-*
-* $Id: kafree.F,v 1.1.1.1 1996/03/08 11:40:51 mclareni Exp $
-*
-* $Log: kafree.F,v $
-* Revision 1.1.1.1 1996/03/08 11:40:51 mclareni
-* Kapack
-*
-*
-#include "kapack/pilot.h"
- SUBROUTINE KAFREE(LUN,MAJNAM,IRC)
-*
-*.....RELEASE A LOCK
-*
-#include "kapack/kax000.inc"
-#include "kapack/kax020.inc"
-#include "kapack/kax02c.inc"
-#include "kapack/kax050.inc"
-*
- CHARACTER MAJNAM*(*)
-*
-*-----------------------------------------------------------------------
-*
- CALL KAXINI(LUN)
-*
-*.....PROCESS THE MAJOR NAME
- IF ( MAJNAM .EQ. ' ' ) THEN
- IROOT = 1
- ELSE
- CALL KAXMAJ(MAJNAM,*11,*21)
- IROOT = KROOT(0)
- ENDIF
-*
-*.....RELEASE THE LOCK IF IT IS HELD
- CALL KAXTLK(IROOT,*31)
- CALL KAXRLK(IROOT)
-*
-*.....SUCCESSFUL COMPLETION
- IRC = 0
- IF ( MAJNAM .EQ. ' ' ) THEN
- WRITE(MSG,100) LUN
- ELSE
- WRITE(MSG,101) MAJNAM, LUN
- ENDIF
- CALL KAXMSG(LUNLOG,MSG)
- RETURN
-*
-*.....ERROR PROCESSING
- 11 IRC = 1
- WRITE(MSG,111) MAJNAM
- GO TO 99
-*
- 21 IRC = 2
- WRITE(MSG,121) MAJNAM, LUN
- GO TO 99
-*
- 31 IRC = 3
- IF ( MAJNAM .EQ. ' ' ) THEN
- WRITE(MSG,1311) LUN
- ELSE
- WRITE(MSG,1312) MAJNAM, LUN
- ENDIF
- GO TO 99
-*
- 99 CALL KAXMSG(LUNERR,MSG)
- IF ( RETURN ) RETURN
- CALL KAXEND
-*
- 100 FORMAT('CRNKA350 KAFREE: LOCK FREED FOR MAJOR NAMES ON UNIT ',I3)
- 101 FORMAT('CRNKA350 KAFREE: LOCK FREED FOR MAJOR NAME ''',A,
- + ''' ON UNIT ',I3)
- 111 FORMAT('CRNKA351 KAFREE: ''',A,''' IS NOT AN ACCEPTABLE MAJOR
- + NAME')
- 121 FORMAT('CRNKA352 KAFREE: ATTEMPT TO FREE MAJOR NAME ''',A,
- + ''' FAILED ON UNIT ',I3,
- + ', THIS MAJOR NAME DOES NOT EXIST IN THE KA-FILE')
-1311 FORMAT('CRNKA353 KAFREE: ATTEMPT TO FREE MAJOR NAMES FAILED ON
- + UNIT ',I3,', THE MAJOR NAMES ARE NOT HELD')
-1312 FORMAT('CRNKA353 KAFREE: ATTEMPT TO FREE MAJOR NAME ''',A,
- + ''' FAILED ON UNIT ',I3,
- + ', THIS MAJOR NAME IS NOT HELD')
-*
- END
diff --git a/src/packlib/kapack/code/kaget.F b/src/packlib/kapack/code/kaget.F
deleted file mode 100644
index 38a5c27..0000000
--- a/src/packlib/kapack/code/kaget.F
+++ /dev/null
@@ -1,116 +0,0 @@
-*
-* $Id: kaget.F,v 1.1.1.1 1996/03/08 11:40:51 mclareni Exp $
-*
-* $Log: kaget.F,v $
-* Revision 1.1.1.1 1996/03/08 11:40:51 mclareni
-* Kapack
-*
-*
-#include "kapack/pilot.h"
- SUBROUTINE KAGET(LUN,MAJNAM,MINNAM,MODE,IDATA,LDATA,IRC)
-*
-*.....RETRIEVE A RECORD FROM A KA-FILE
-*
-#include "kapack/kax000.inc"
-#include "kapack/kax020.inc"
-#include "kapack/kax050.inc"
-#include "kapack/kax0a0.inc"
-*
- CHARACTER MAJNAM*(*), MINNAM*(*), MODE*(*)
-*
- INTEGER IDATA(*)
-*
-*-----------------------------------------------------------------------
-*
- CALL KAXINI(LUN)
-*
-*.....PROCESS THE MAJOR NAME
- CALL KAXMAJ(MAJNAM,*12,*21)
-*
-*.....CONVERT THE MINOR NAME TO A KEY
- CALL KAXNAM(MINNAM,MINKEY,*13)
-*
-*.....LOCK THE MINOR TREE IF THE MODE IS UPDATE
- IF ( MODE .EQ. 'UPDATE') THEN
- CALL KAXOLK(KROOT(0))
- ELSE IF ( MODE .NE. 'READ' ) THEN
- GO TO 11
- ENDIF
-*
-*.....LOCATE THE RECORD
- CALL KAXGET(KROOT(0),MINKEY,1,LOC,*31)
-*
-*.....COPY THE RECORD TO THE USER'S STORAGE
- IF ( IA(8) .EQ. 0 ) THEN
-*
-*........NON-SEGMENTED RECORD
- LDATA = IA(LOC) - NRCW - IA(LOC+NRCW)
- IPTR = LOC + NRCW + IA(LOC+NRCW)
- CALL UCOPY( IA(IPTR), IDATA, LDATA )
-*
- ELSE
-*
-*........SEGMENTED RECORD
- IF ( IA(8) .NE. 1 ) GO TO 91
- LDATA = IA(7) - IA(6) - NRCW - IA(LOC+NRCW)
- IPTR = LOC + NRCW + IA(LOC+NRCW)
- CALL UCOPY( IA(IPTR), IDATA, LDATA )
- 1 CALL KAXRD(IA(3),IA,LBLK)
- IF ( IA(8).NE.2 .AND. IA(8).NE.3 ) GO TO 91
- LSEG = IA(7) - IA(6)
- CALL UCOPY( IA(IA(6)), IDATA(LDATA+1), LSEG )
- LDATA = LDATA + LSEG
- IF ( IA(8) .NE. 2 ) GO TO 1
- ENDIF
-*
-*.....SUCCESSFUL COMPLETION
- IRC = 0
- RETURN
-*
-*.....ERROR PROCESSING
- 11 IRC = 1
- WRITE(MSG,111) MODE
- GO TO 99
-*
- 12 IRC = 1
- WRITE(MSG,112) MAJNAM
- GO TO 99
-*
- 13 IRC = 1
- WRITE(MSG,113) MINNAM
- GO TO 99
-*
- 21 IRC = 2
- WRITE(MSG,121) MAJNAM, MINNAM, LUN
- GO TO 99
-*
- 31 IRC = 3
- WRITE(MSG,131) MAJNAM, MINNAM, LUN
- IF ( MODE .EQ. 'UPDATE' ) CALL KAXRLK(KROOT(0))
- GO TO 99
-*
- 91 WRITE(MSG,191) IA(8), IA(1), LUNKAF
- CALL KAXMSG(LUNERR,MSG)
- CALL KAXEND
-*
- 99 CALL KAXMSG(LUNERR,MSG)
- IF ( RETURN ) RETURN
- CALL KAXEND
-*
- 111 FORMAT('CRNKA051 KAGET: ''',A,''' IS NOT AN ACCEPTABLE VALUE FOR
- + THE FOURTH ARGUMENT, (MODE), IT MUST BE EITHER ''READ'' OR
- + ''UPDATE''')
- 112 FORMAT('CRNKA052 KAGET: ''',A,''' IS NOT AN ACCEPTABLE MAJOR
- + NAME')
- 113 FORMAT('CRNKA053 KAGET: ''',A,''' IS NOT AN ACCEPTABLE MINOR
- + NAME')
- 121 FORMAT('CRNKA054 KAGET: RETRIEVAL OF ''',A,' ',A,''' FAILED
- + ON UNIT ',I3,', THE MAJOR NAME DOES NOT EXIST IN THE
- + KA-FILE')
- 131 FORMAT('CRNKA055 KAGET: RETRIEVAL OF ''',A,' ',A,''' FAILED
- + ON UNIT ',I3,', THIS RECORD DOES NOT EXIST IN THE
- + KA-FILE')
- 191 FORMAT('CRNKA056 KAGET: INVALID BLOCK TYPE ''',I11,
- + ''' FOUND IN BLOCK ',I11,' ON UNIT ',I3)
-*
- END
diff --git a/src/packlib/kapack/code/kagetm.F b/src/packlib/kapack/code/kagetm.F
deleted file mode 100644
index 54c7189..0000000
--- a/src/packlib/kapack/code/kagetm.F
+++ /dev/null
@@ -1,72 +0,0 @@
-*
-* $Id: kagetm.F,v 1.1.1.1 1996/03/08 11:40:51 mclareni Exp $
-*
-* $Log: kagetm.F,v $
-* Revision 1.1.1.1 1996/03/08 11:40:51 mclareni
-* Kapack
-*
-*
-#include "kapack/pilot.h"
- SUBROUTINE KAGETM(LUN,MAJNAM,MODE,LDEF,LMAX,IRC)
-*
-*.....RETRIEVE A MAJOR ENTRY FROM A KA-FILE
-*
-#include "kapack/kax000.inc"
-#include "kapack/kax020.inc"
-#include "kapack/kax02c.inc"
-#include "kapack/kax050.inc"
-#include "kapack/kax0a0.inc"
-*
- CHARACTER MAJNAM*(*), MODE*(*)
-*
-*-----------------------------------------------------------------------
-*
- CALL KAXINI(LUN)
-*
-*.....LOCK THE MAJOR TREE IF THE MODE IS UPDATE
- IF ( MODE .EQ. 'UPDATE') THEN
- CALL KAXOLK(1)
- ELSE IF ( MODE .NE. 'READ' ) THEN
- GO TO 11
- ENDIF
-*
-*.....PROCESS THE MAJOR NAME
- CALL KAXMAJ(MAJNAM,*12,*21)
-*
-*.....STORE THE DEFAULT AND MAXIMUM LENGTHS FOR THE CALLER
- LDEF = KLDEF(0)
- LMAX = KLMAX(0)
-*
-*.....SUCCESSFUL COMPLETION
- IRC = 0
- RETURN
-*
-*.....ERROR PROCESSING
- 11 IRC = 1
- WRITE(MSG,111) MODE
- GO TO 99
-*
- 12 IRC = 1
- WRITE(MSG,112) MAJNAM
- IF ( MODE .EQ. 'UPDATE' ) CALL KAXRLK(1)
- GO TO 99
-*
- 21 IRC = 2
- WRITE(MSG,121) MAJNAM, LUN
- IF ( MODE .EQ. 'UPDATE' ) CALL KAXRLK(1)
- GO TO 99
-*
- 99 CALL KAXMSG(LUNERR,MSG)
- IF ( RETURN ) RETURN
- CALL KAXEND
-*
- 111 FORMAT('CRNKA061 KAGETM: ''',A,''' IS NOT AN ACCEPTABLE VALUE FOR
- + THE THIRD ARGUMENT, (MODE), IT MUST BE EITHER ''READ'' OR
- + ''UPDATE''')
- 112 FORMAT('CRNKA062 KAGETM: ''',A,''' IS NOT AN ACCEPTABLE MAJOR
- + NAME')
- 121 FORMAT('CRNKA063 KAGETM: RETRIEVAL OF MAJOR NAME ''',A,
- + ''' FAILED ON UNIT ',I3,
- + ', THIS MAJOR NAME DOES NOT EXIST IN THE KA-FILE')
-*
- END
diff --git a/src/packlib/kapack/code/kahold.F b/src/packlib/kapack/code/kahold.F
deleted file mode 100644
index 9eba7b5..0000000
--- a/src/packlib/kapack/code/kahold.F
+++ /dev/null
@@ -1,68 +0,0 @@
-*
-* $Id: kahold.F,v 1.1.1.1 1996/03/08 11:40:51 mclareni Exp $
-*
-* $Log: kahold.F,v $
-* Revision 1.1.1.1 1996/03/08 11:40:51 mclareni
-* Kapack
-*
-*
-#include "kapack/pilot.h"
- SUBROUTINE KAHOLD(LUN,MAJNAM,IRC)
-*
-*.....OBTAIN A LOCK
-*
-#include "kapack/kax000.inc"
-#include "kapack/kax020.inc"
-#include "kapack/kax02c.inc"
-#include "kapack/kax050.inc"
-*
- CHARACTER MAJNAM*(*)
-*
-*-----------------------------------------------------------------------
-*
- CALL KAXINI(LUN)
-*
-*.....PROCESS THE MAJOR NAME
- IF ( MAJNAM .EQ. ' ' ) THEN
- IROOT = 1
- ELSE
- CALL KAXMAJ(MAJNAM,*11,*21)
- IROOT = KROOT(0)
- ENDIF
-*
-*.....OBTAIN THE LOCK
- CALL KAXOLK(IROOT)
-*
-*.....SUCCESSFUL COMPLETION
- IRC = 0
- IF ( MAJNAM .EQ. ' ' ) THEN
- WRITE(MSG,100) LUN
- ELSE
- WRITE(MSG,101) MAJNAM, LUN
- ENDIF
- CALL KAXMSG(LUNLOG,MSG)
- RETURN
-*
-*.....ERROR PROCESSING
- 11 IRC = 1
- WRITE(MSG,111) MAJNAM
- GO TO 99
-*
- 21 IRC = 2
- WRITE(MSG,121) MAJNAM, LUN
- GO TO 99
-*
- 99 CALL KAXMSG(LUNERR,MSG)
- IF ( RETURN ) RETURN
- CALL KAXEND
-*
- 100 FORMAT('CRNKA340 KAHOLD: LOCK HELD FOR MAJOR NAMES ON UNIT ',I3)
- 101 FORMAT('CRNKA340 KAHOLD: LOCK HELD FOR MAJOR NAME ''',A,
- + ''' ON UNIT ',I3)
- 111 FORMAT('CRNKA341 KAHOLD: ''',A,''' IS NOT AN ACCEPTABLE MAJOR
- + NAME')
- 121 FORMAT('CRNKA342 KAHOLD: ATTEMPT TO LOCK MAJOR NAME ''',A,
- + ''' FAILED ON UNIT ',I3,
- + ', THIS MAJOR NAME DOES NOT EXIST IN THE KA-FILE')
-*
- END
diff --git a/src/packlib/kapack/code/kalen.F b/src/packlib/kapack/code/kalen.F
deleted file mode 100644
index 73acd6e..0000000
--- a/src/packlib/kapack/code/kalen.F
+++ /dev/null
@@ -1,77 +0,0 @@
-*
-* $Id: kalen.F,v 1.1.1.1 1996/03/08 11:40:51 mclareni Exp $
-*
-* $Log: kalen.F,v $
-* Revision 1.1.1.1 1996/03/08 11:40:51 mclareni
-* Kapack
-*
-*
-#include "kapack/pilot.h"
- SUBROUTINE KALEN(LUN,MAJNAM,MINNAM,LDEF,LMAX,NWORDS,IRC)
-*
-*.....RETRIEVE THE LENGTH ATTRIBUTES OF A RECORD
-*
-#include "kapack/kax000.inc"
-#include "kapack/kax020.inc"
-#include "kapack/kax050.inc"
-#include "kapack/kax0a0.inc"
-*
- CHARACTER MAJNAM*(*), MINNAM*(*)
-*
-*-----------------------------------------------------------------------
-*
- CALL KAXINI(LUN)
-*
-*.....PROCESS THE MAJOR NAME
- CALL KAXMAJ(MAJNAM,*11,*21)
-*
-*.....CONVERT THE MINOR NAME TO A KEY
- CALL KAXNAM(MINNAM,MINKEY,*12)
-*
-*.....STORE THE DEFAULT AND MAXIMUM LENGTHS FOR THE CALLER
- LDEF = KLDEF(0)
- LMAX = KLMAX(0)
-*
-*.....LOCATE THE RECORD
- CALL KAXGET(KROOT(0),MINKEY,1,LOC,*31)
-*
-*.....STORE THE RECORD LENGTH FOR THE CALLER
- NWORDS = IA(LOC) - NRCW - IA(LOC+NRCW)
-*
-*.....SUCCESSFUL COMPLETION
- IRC = 0
- RETURN
-*
-*.....ERROR PROCESSING
- 11 IRC = 1
- WRITE(MSG,111) MAJNAM
- GO TO 99
-*
- 12 IRC = 1
- WRITE(MSG,112) MINNAM
- GO TO 99
-*
- 21 IRC = 2
- IF ( RETURN ) RETURN
- WRITE(MSG,121) MAJNAM, LUN
- GO TO 99
-*
- 31 IRC = 3
- IF ( RETURN ) RETURN
- WRITE(MSG,131) MAJNAM, MINNAM, LUN
- GO TO 99
-*
- 99 CALL KAXMSG(LUNERR,MSG)
- IF ( RETURN ) RETURN
- CALL KAXEND
-*
- 111 FORMAT('CRNKA311 KALEN: ''',A,''' IS NOT AN ACCEPTABLE MAJOR
- + NAME')
- 112 FORMAT('CRNKA312 KALEN: ''',A,''' IS NOT AN ACCEPTABLE MINOR
- + NAME')
- 121 FORMAT('CRNKA313 KALEN: THE MAJOR NAME ''',A,''' DOES NOT EXIST
- + IN THE KA-FILE ON UNIT ',I3)
- 131 FORMAT('CRNKA314 KALEN: THE RECORD ''',A,' ',A,''' DOES NOT EXIST
- + IN THE KA-FILE ON UNIT ',I3)
-*
- END
diff --git a/src/packlib/kapack/code/kalist.F b/src/packlib/kapack/code/kalist.F
deleted file mode 100644
index 97fa058..0000000
--- a/src/packlib/kapack/code/kalist.F
+++ /dev/null
@@ -1,114 +0,0 @@
-*
-* $Id: kalist.F,v 1.1.1.1 1996/03/08 11:40:51 mclareni Exp $
-*
-* $Log: kalist.F,v $
-* Revision 1.1.1.1 1996/03/08 11:40:51 mclareni
-* Kapack
-*
-*
-#include "kapack/pilot.h"
- SUBROUTINE KALIST(LUN,MAJNAM,MODE,IRC)
-*
-*.....LIST THE CONTENTS OF A KA-FILE
-*
-#include "kapack/kax000.inc"
-#include "kapack/kax020.inc"
-#include "kapack/kax050.inc"
-*
- CHARACTER MAJNAM*(*), MAJOR*(MAXNAM)
-*
- LOGICAL XRETRN
-*
-*-----------------------------------------------------------------------
-*
- CALL KAXINI(LUN)
-*
-*.....CHECK THE VALUE OF MODE
- IF ( MODE .NE. 1 ) GO TO 11
-*
-*.....SAVE THE CURRENT RETURN SETTING AND ENFORCE 'RETURN=YES'
- XRETRN = RETURN
- RETURN = .TRUE.
-*
-*.....CHECK WHETHER A SPECIFIC MAJOR NAME HAS BEEN REQUESTED
- IF ( MAJNAM .NE. ' ' ) THEN
-*
-*........PROCESS A SPECIFIC MAJOR NAME
- CALL KAGETM(LUN,MAJNAM,'READ',LDEF,LMAX,IRC)
- IF ( IRC .EQ. 0 ) THEN
- WRITE(MSG,100) LUN, MAJNAM, LDEF, LMAX
- CALL KAXMSG(LUNLOG,MSG)
- CALL KAXLS1(MAJNAM)
- ELSE IF ( IRC .EQ. 1 ) THEN
- GO TO 12
- ELSE IF ( IRC .EQ. 2 ) THEN
- GO TO 21
- ENDIF
-*
- ELSE
-*
-*........PROCESS ALL MAJOR NAMES
- WRITE(MSG,101) LUN
- CALL KAXMSG(LUNLOG,MSG)
- NMAJOR = 0
- MAJOR = ' '
-*
- 1 CALL KASEQM(LUN,MAJOR,LDEF,LMAX,IRC)
- IF ( IRC .EQ. 0 ) THEN
- NMAJOR = NMAJOR + 1
- NC = INDEX(MAJOR,' ') - 1
- WRITE(LUNLOG,103) NMAJOR, LDEF, LMAX, MAJOR(1:NC)
- CALL KAXLS1(MAJOR)
- GO TO 1
- ELSE IF ( IRC .EQ. 1 ) THEN
- GO TO 13
- ELSE IF ( IRC .EQ. 2 ) THEN
- IF ( NMAJOR .EQ. 0 ) THEN
- WRITE(MSG,102) LUN
- CALL KAXMSG(LUNLOG,MSG)
- ENDIF
- ENDIF
- ENDIF
-*
-*.....SUCCESSFUL COMPLETION
- IRC = 0
- RETURN = XRETRN
- RETURN
-*
-*.....ERROR PROCESSING
- 11 IRC = 1
- WRITE(MSG,111) MODE
- GO TO 99
-*
- 12 IRC = 1
- RETURN = XRETRN
- IF ( RETURN ) RETURN
- CALL KAXEND
-*
- 13 IRC = 1
- RETURN = XRETRN
- IF ( RETURN ) RETURN
- CALL KAXEND
-*
- 21 IRC = 2
- RETURN = XRETRN
- IF ( RETURN ) RETURN
- CALL KAXEND
-*
- 99 CALL KAXMSG(LUNERR,MSG)
- RETURN = XRETRN
- IF ( RETURN ) RETURN
- CALL KAXEND
-*
- 100 FORMAT('CRNKA290 KALIST: SEQUENTIAL LISTING OF THE KA-FILE ON
- + UNIT ',I3,' FOR MAJOR NAME ''',A,'''',
- + ', LDEF = ',I11,', LMAX = ',I11,':')
- 101 FORMAT('CRNKA290 KALIST: SEQUENTIAL LISTING OF THE KA-FILE ON
- + UNIT ',I3,':')
- 102 FORMAT('CRNKA291 KALIST: THE KA-FILE ON UNIT ',I3,' IS EMPTY')
- 103 FORMAT(' ',I5,'. LDEF ',I5,', LMAX ',I5,
- + ', MAJOR NAME: ',A)
- 111 FORMAT('CRNKA292 KALIST: ',I11,' IS NOT AN ACCEPTABLE MODE, IT
- + MUST HAVE THE VALUE 1')
-*
- END
diff --git a/src/packlib/kapack/code/kaloc.F b/src/packlib/kapack/code/kaloc.F
deleted file mode 100644
index d630a7d..0000000
--- a/src/packlib/kapack/code/kaloc.F
+++ /dev/null
@@ -1,70 +0,0 @@
-*
-* $Id: kaloc.F,v 1.1.1.1 1996/03/08 11:40:51 mclareni Exp $
-*
-* $Log: kaloc.F,v $
-* Revision 1.1.1.1 1996/03/08 11:40:51 mclareni
-* Kapack
-*
-*
-#include "kapack/pilot.h"
- SUBROUTINE KALOC(LUN,MAJNAM,MINNAM,IRC)
-*
-*.....LOCATE A SPECIFIED RECORD
-*
-#include "kapack/kax000.inc"
-#include "kapack/kax020.inc"
-#include "kapack/kax050.inc"
-#include "kapack/kax0a0.inc"
-*
- CHARACTER MAJNAM*(*), MINNAM*(*)
-*
-*-----------------------------------------------------------------------
-*
- CALL KAXINI(LUN)
-*
-*.....PROCESS THE MAJOR NAME
- CALL KAXMAJ(MAJNAM,*11,*21)
-*
-*.....CONVERT THE MINOR NAME TO A KEY
- CALL KAXNAM(MINNAM,MINKEY,*12)
-*
-*.....LOCATE THE RECORD
- CALL KAXGET(KROOT(0),MINKEY,1,LOC,*31)
-*
-*.....SUCCESSFUL COMPLETION
- IRC = 0
- RETURN
-*
-*.....ERROR PROCESSING
- 11 IRC = 1
- WRITE(MSG,111) MAJNAM
- GO TO 99
-*
- 12 IRC = 1
- WRITE(MSG,112) MINNAM
- GO TO 99
-*
- 21 IRC = 2
- IF ( RETURN ) RETURN
- WRITE(MSG,121) MAJNAM, LUN
- GO TO 99
-*
- 31 IRC = 3
- IF ( RETURN ) RETURN
- WRITE(MSG,131) MAJNAM, MINNAM, LUN
- GO TO 99
-*
- 99 CALL KAXMSG(LUNERR,MSG)
- IF ( RETURN ) RETURN
- CALL KAXEND
-*
- 111 FORMAT('CRNKA071 KALOC: ''',A,''' IS NOT AN ACCEPTABLE MAJOR
- + NAME')
- 112 FORMAT('CRNKA072 KALOC: ''',A,''' IS NOT AN ACCEPTABLE MINOR
- + NAME')
- 121 FORMAT('CRNKA073 KALOC: THE MAJOR NAME ''',A,''' DOES NOT EXIST
- + IN THE KA-FILE ON UNIT ',I3)
- 131 FORMAT('CRNKA074 KALOC: THE RECORD ''',A,' ',A,''' DOES NOT EXIST
- + IN THE KA-FILE ON UNIT ',I3)
-*
- END
diff --git a/src/packlib/kapack/code/kamake.F b/src/packlib/kapack/code/kamake.F
deleted file mode 100644
index 3024c34..0000000
--- a/src/packlib/kapack/code/kamake.F
+++ /dev/null
@@ -1,239 +0,0 @@
-*
-* $Id: kamake.F,v 1.1.1.1 1996/03/08 11:40:51 mclareni Exp $
-*
-* $Log: kamake.F,v $
-* Revision 1.1.1.1 1996/03/08 11:40:51 mclareni
-* Kapack
-*
-*
-#include "kapack/pilot.h"
- SUBROUTINE KAMAKE(LUN,NRECS,NWORDS,IRC)
-*
-*.....CREATE A NEW KA-FILE
-*
-#include "kapack/kax000.inc"
-#include "kapack/kax020.inc"
-#include "kapack/kax030.inc"
-#include "kapack/kax050.inc"
-#include "kapack/kax0a0.inc"
-*
-#if defined(CERNLIB_CRAY)
- CHARACTER*2 CHALUN
-#endif
- EQUIVALENCE (ISIZE,SIZE)
-*
-*-----------------------------------------------------------------------
-*
- CALL KAXINN(LUN)
-*
-*.....ENSURE THERE IS NOT ALREADY A KA-FILE ATTACHED TO THE UNIT
- IF ( LBKS(LUNKAF) .NE. 0 ) GO TO 21
-*
-*.....VALIDATE THE ARGUMENTS
- IF ( NWORDS .EQ. 0 ) THEN
- ISIZE = NRECS
- IF ( SIZE .LT. 0.0 ) GO TO 13
- ELSE
- IF ( NRECS .LT. 1 ) GO TO 11
- IF ( NWORDS .LT. 0 ) GO TO 12
- ENDIF
-*
-*.....CALCULATE THE KEY PACKING FACTOR AND THE MAXIMUM KEY VALUE
- N = MAXINT
- MAXKEY = 0
- MAXPAK = 0
- 1 IF ( N/99 .NE. 0 ) THEN
- MAXKEY = MAXKEY*100 + 99
- MAXPAK = MAXPAK + 1
- N = N/100
- GO TO 1
- ENDIF
- IF ( MAXPAK .LT. 1 ) GO TO 91
-*
-*.....ENSURE THAT THE BUFFER LENGTH IS SUFFICIENT
- MINBUF = NBCW1 + 3*(MAXNAM/MAXPAK+6)
- IF ( LBUF .LT. MINBUF ) GO TO 92
-*
-*.....CALCULATE THE NUMBER OF BLOCKS, NB, REQUIRED
- IF ( NWORDS .EQ. 0 ) THEN
- NB = 1 024.0 * 1 024.0 * SIZE / REAL ( LBUF*LWORD ) + 1.
- ELSE
- AVKEY = REAL( (MAXNAM/MAXPAK + 2)/2 )
- AVRECL = REAL( NWORDS ) + AVKEY
- RPB = REAL( LBUF - NBCW ) / AVRECL
- BLOCKS = REAL( NRECS ) / RPB
- NB = MAX( INT( 1.1 * BLOCKS ) , 5 )
- ENDIF
-*
-*.....OPEN THE FILE FOR DIRECT ACCESS
-#if defined(CERNLIB_UNIX)
- WRITE(MSG,1000) LUNKAF
- 1000 FORMAT('CRNKA08A KAMAKE: ENTER THE NAME OF THE KA-FILE FOR',
- + ' UNIT ',I3)
- CALL KAXMSG(ISYSWR,MSG)
- READ(ISYSRD,1001) MSG
- 1001 FORMAT(A)
-#endif
-#if defined(CERNLIB_CRAY)
- WRITE(CHALUN,'(I2)') LUNKAF
- MSG = 'fort.'//CHALUN(INDEX(CHALUN,' ')+1:2)
-#endif
-#if !defined(CERNLIB_NORD)
- OPEN ( ACCESS = 'DIRECT',
-#endif
-#if defined(CERNLIB_NORD)
- OPEN ( BUFFER_SIZE = LBUF * LWORD,
- + MODE = 'SEGMENT',
-#endif
-#if defined(CERNLIB_UNIX)||defined(CERNLIB_CRAY)
- + FILE = MSG(1:INDEX(MSG,' ')-1),
-#endif
- + ERR = 93,
- + FORM = 'UNFORMATTED',
- + IOSTAT = IOS,
- + RECL = LBUF * LWORD,
-#if defined(CERNLIB_VAX)
- + STATUS = 'UNKNOWN',
-#endif
-#if defined(CERNLIB_CRAY)
- + STATUS = 'NEW',
-#endif
- + UNIT = LUNKAF )
- IF ( IOS .NE. 0 ) GO TO 93
- LBKS(LUNKAF) = -1
-*
-*.....FORMAT AND WRITE BLOCK 1
- CALL UZERO(IA,1,LBUF)
- IA( 1) = 1
- IA( 2) = NB - 1
- IA( 3) = 2
- IA( 4) = 1
- IA( 5) = 1
- IA( 6) = NBCW1 + 1
- IA( 7) = IA(6) + 3
- IA( 8) = 0
- IA( 9) = 0
- IA(10) = 0
- IA(11) = 0
- IA(12) = 0
- IA(13) = KAVRSN
- IA(14) = NB
- IA(15) = LBUF
- IA(16) = MAXPAK
- IA(17) = 0
- IA(18) = 0
- IA(19) = 0
- IA(20) = 0
- IA(21) = 0
- IA(22) = 0
- IA(23) = 0
- IA(24) = 0
-*
- IA(NBCW1+1) = 3
- IA(NBCW1+2) = 2
- IA(NBCW1+3) = MAXKEY
-*
- WRITE(LUNKAF,ERR=94,IOSTAT=IOS,REC=1) ( IA(I), I=1,LBUF )
- IF ( IOS .NE. 0 ) GO TO 94
-*
-*.....FORMAT AND WRITE BLOCKS 2 - (LAST-1)
- CALL UZERO(IA,1,IA(7)-1)
-*
- DO 2 NBLOCK = 2, NB-1
- IA(1) = NBLOCK
- IA(3) = NBLOCK + 1
- WRITE(LUNKAF,ERR=94,IOSTAT=IOS,REC=NBLOCK) ( IA(I), I=1,LBUF )
- IF ( IOS .NE. 0 ) GO TO 94
- 2 CONTINUE
-*
-*.....FORMAT AND WRITE THE LAST BLOCK
- IA(1) = NB
- IA(3) = 0
- WRITE(LUNKAF,ERR=94,IOSTAT=IOS,REC=NB) ( IA(I), I=1,LBUF )
- IF ( IOS .NE. 0 ) GO TO 94
-*
-*.....VERIFY THAT THE LAST BLOCK WAS WRITTEN CORRECTLY
- IA(1) = -1
- IA(3) = -1
- READ(LUNKAF,ERR=95,IOSTAT=IOS,REC=NB) ( IA(I), I=1,3 )
- IF ( IOS .NE. 0 ) GO TO 95
- IF ( IA(1).NE.NB .OR. IA(3).NE.0 ) GO TO 95
-*
-*.....SUCCESSFUL COMPLETION
- IRC = 0
- IF ( NWORDS .EQ. 0 ) THEN
- WRITE(MSG,100) SIZE, LUNKAF, NB, LBUF*LWORD
- ELSE
- WRITE(MSG,101) LUNKAF, NRECS, NWORDS, NB, LBUF
- ENDIF
- CALL KAXMSG(LUNLOG,MSG)
- RETURN
-*
-*.....ERROR PROCESSING
- 11 IRC = 1
- WRITE(MSG,111) NRECS
- GO TO 99
-*
- 12 IRC = 1
- WRITE(MSG,112) NWORDS
- GO TO 99
-*
- 13 IRC = 1
- WRITE(MSG,113) NWORDS
- GO TO 99
-*
- 21 IRC = 2
- WRITE(MSG,121) LUNKAF
- GO TO 99
-*
- 91 WRITE(MSG,191)
- CALL KAXMSG(LUNERR,MSG)
- CALL KAXEND
-*
- 92 WRITE(MSG,192) LBUF, MINBUF
- CALL KAXMSG(LUNERR,MSG)
- CALL KAXEND
-*
- 93 WRITE(MSG,193) LUNKAF, IOS
- CALL KAXMSG(LUNERR,MSG)
- CALL KAXEND
-*
- 94 WRITE(MSG,194) NBLOCK, LUNKAF, IOS
- CALL KAXMSG(LUNERR,MSG)
- CALL KAXEND
-*
- 95 WRITE(MSG,195) LUNKAF, IOS
- CALL KAXMSG(LUNERR,MSG)
- CALL KAXEND
-*
- 99 CALL KAXMSG(LUNERR,MSG)
- IF ( RETURN ) RETURN
- CALL KAXEND
-*
- 100 FORMAT('CRNKA080 KAMAKE: KA-FILE OF ',G11.6,
- + ' MEGABYTES CREATED ON UNIT ',I3,
- + ', (',I11,' BLOCKS OF ',I11,' BYTES FORMATTED)')
- 101 FORMAT('CRNKA080 KAMAKE: KA-FILE CREATED ON UNIT ',I3,' FOR ',
- + I11,' RECORDS OF AVERAGE LENGTH ',I11,' WORDS, (',
- + I11,' BLOCKS OF ',I11,' WORDS FORMATTED)')
- 111 FORMAT('CRNKA081 KAMAKE: ',I11,' IS NOT A VALID VALUE FOR THE
- + NUMBER OF RECORDS')
- 112 FORMAT('CRNKA082 KAMAKE: ',I11,' IS NOT A VALID VALUE FOR THE
- + AVERAGE RECORD LENGTH')
- 113 FORMAT('CRNKA089 KAMAKE: ',G11.6,' IS NOT A VALID VALUE FOR THE
- + FILE SIZE')
- 121 FORMAT('CRNKA083 KAMAKE: ATTEMPT TO CREATE A NEW KA-FILE ON
- + UNIT ',I3,' WHICH ALREADY HAS A KA-FILE ATTACHED')
- 191 FORMAT('CRNKA084 KAMAKE: INVALID KEY PACKING FACTOR, KAPACK SYSTEM
- + OR INSTALLATION ERROR')
- 192 FORMAT('CRNKA085 KAMAKE: THE BUFFER LENGTH OF ',I11,
- + ' IS SMALLER THAN THE MINIMUM OF ',I11,
- + ', KAPACK SYSTEM OR INSTALLATION ERROR')
- 193 FORMAT('CRNKA086 KAMAKE: UNABLE TO OPEN A NEW KA-FILE ON UNIT ',
- + I3,', IOSTAT = ',I11)
- 194 FORMAT('CRNKA087 KAMAKE: UNABLE TO WRITE BLOCK ',I11,' TO THE
- + KA-FILE BEING CREATED ON UNIT ',I3,', IOSTAT = ',I11)
- 195 FORMAT('CRNKA088 KAMAKE: ERROR(S) OCCURRED DURING CREATION OF THE
- + KA-FILE ON UNIT ',I3,', IOSTAT = ',I11)
-*
- END
diff --git a/src/packlib/kapack/code/kamsg.F b/src/packlib/kapack/code/kamsg.F
deleted file mode 100644
index 540991d..0000000
--- a/src/packlib/kapack/code/kamsg.F
+++ /dev/null
@@ -1,30 +0,0 @@
-*
-* $Id: kamsg.F,v 1.1.1.1 1996/03/08 11:40:51 mclareni Exp $
-*
-* $Log: kamsg.F,v $
-* Revision 1.1.1.1 1996/03/08 11:40:51 mclareni
-* Kapack
-*
-*
-#include "kapack/pilot.h"
- SUBROUTINE KAMSG(LUN,STRING,IRC)
-*
-*.....WRITE A USER MESSAGE IN THE TRANSACTION LOG
-*
-#include "kapack/kax000.inc"
-#include "kapack/kax020.inc"
-*
- CHARACTER STRING*(*)
-*
-*-----------------------------------------------------------------------
-*
- CALL KAXINN(LUN)
-*
- IF ( LUNLOG .NE. 0 ) THEN
- CALL KAXMSG(LUNLOG,STRING)
- IRC = 0
- ELSE
- IRC = 1
- ENDIF
-*
- END
diff --git a/src/packlib/kapack/code/kaoptn.F b/src/packlib/kapack/code/kaoptn.F
deleted file mode 100644
index 28a0f5f..0000000
--- a/src/packlib/kapack/code/kaoptn.F
+++ /dev/null
@@ -1,170 +0,0 @@
-*
-* $Id: kaoptn.F,v 1.1.1.1 1996/03/08 11:40:51 mclareni Exp $
-*
-* $Log: kaoptn.F,v $
-* Revision 1.1.1.1 1996/03/08 11:40:51 mclareni
-* Kapack
-*
-*
-#include "kapack/pilot.h"
- SUBROUTINE KAOPTN(LUN,STRING,IRC)
-*
-*.....SPECIFY OPTIONS
-*
-#include "kapack/kax000.inc"
-#include "kapack/kax020.inc"
-#include "kapack/kax030.inc"
-#include "kapack/kax050.inc"
-#include "kapack/kax060.inc"
-*
- CHARACTER STRING*(*)
-*
-*-----------------------------------------------------------------------
-*
- CALL KAXINN(LUN)
-*
-*.....CHECK THE STRING AND FIND THE LOCATION OF THE OPTION AND VALUE
- LOCEQU = INDEX(STRING,'=')
- IF ( LOCEQU .LE. 0 ) GO TO 11
- CALL KAXWRD(STRING(:LOCEQU-1),LOC1,LENOPT,*11)
- CALL KAXWRD(STRING(LOCEQU+1:),LOC3,LENVAL,*11)
- LOC2 = LOC1 + LENOPT - 1
- LOC3 = LOC3 + LOCEQU
- LOC4 = LOC3 + LENVAL - 1
- IF ( LOC2+1 .LT. LOCEQU ) THEN
- CALL KAXWRD(STRING(LOC2+1:LOCEQU-1),LOC,L,*1)
- GO TO 11
- ENDIF
- 1 IF ( LOC4+1 .LT. LEN(STRING) ) THEN
- CALL KAXWRD(STRING(LOC4+1:),LOC,L,*2)
- GO TO 11
- ENDIF
-*
-*.....LUNERR OR LUNLOG OPTION
- 2 IF ( STRING(LOC1:LOC2).EQ.'LUNERR' .OR.
- + STRING(LOC1:LOC2).EQ.'LUNLOG' ) THEN
-*
- IF ( LENVAL .GT. 2 ) GO TO 31
-*
- NUMBER = 0
- DO 3 I = LOC3, LOC4
- IDIGIT = INDEX('0123456789',STRING(I:I)) - 1
- IF ( IDIGIT .LT. 0 ) GO TO 31
- NUMBER = NUMBER*10 + IDIGIT
- 3 CONTINUE
-*
- IF ( NUMBER .GT. MAXLUN ) GO TO 31
-*
- IF ( STRING(LOC1:LOC2) .EQ. 'LUNERR' ) LUNERR = NUMBER
- IF ( STRING(LOC1:LOC2) .EQ. 'LUNLOG' ) THEN
- IF ( NUMBER .EQ. 0 ) THEN
- WRITE(MSG,100) STRING(LOC1:LOC2),STRING(LOC3:LOC4),LUNKAF
- CALL KAXMSG(LUNLOG,MSG)
- ENDIF
- LUNLOG = NUMBER
- ENDIF
-*
-*.....MODIFY OR RETURN OPTION
- ELSE IF ( STRING(LOC1:LOC2).EQ.'MODIFY' .OR.
- + STRING(LOC1:LOC2).EQ.'RETURN' ) THEN
-*
- IF ( STRING(LOC3:LOC4).NE.'YES' .AND.
- + STRING(LOC3:LOC4).NE.'NO' ) GO TO 31
-*
- IF ( STRING(LOC1:LOC2) .EQ. 'MODIFY' )
- + MODIFY = STRING(LOC3:LOC4).EQ.'YES'
-*
- IF ( STRING(LOC1:LOC2) .EQ. 'RETURN' )
- + RETURN = STRING(LOC3:LOC4).EQ.'YES'
-*
-*.....INVALID OPTION
- ELSE
- GO TO 21
- ENDIF
-*
-*.....STORE THE OPTIONS
- IMOD = 0
- IF ( MODIFY ) IMOD = 1
- IRET = 0
- IF ( RETURN ) IRET = 1
- IOPTNS(LUNKAF) = LUNERR*10000 + LUNLOG*100 + IMOD*10 + IRET
-#if defined(CERNLIB_VAX)
-*
-*.....CLOSE AND RE-OPEN THE FILE IF 'MODIFY' REQUESTED
- IF ( STRING(LOC1:LOC2).EQ.'MODIFY' .AND. LBKS(LUNKAF).NE.0 ) THEN
- CLOSE ( ERR = 91,
- + IOSTAT = IOS,
- + STATUS = 'KEEP',
- + UNIT = LUNKAF )
- IF ( IOS .NE. 0 ) GO TO 91
-*
- IF ( MODIFY ) THEN
- OPEN ( ACCESS = 'DIRECT',
- + ERR = 92,
- + FORM = 'UNFORMATTED',
- + IOSTAT = IOS,
- + RECL = KAXRCL(LUNKAF),
- + SHARED,
- + STATUS = 'UNKNOWN',
- + UNIT = LUNKAF )
- ELSE
- OPEN ( ACCESS = 'DIRECT',
- + ERR = 92,
- + FORM = 'UNFORMATTED',
- + IOSTAT = IOS,
- + READONLY,
- + SHARED,
- + STATUS = 'OLD',
- + UNIT = LUNKAF )
- ENDIF
- IF ( IOS .NE. 0 ) GO TO 92
- ENDIF
-#endif
-*
-*.....SUCCESSFUL COMPLETION
- IRC = 0
- WRITE(MSG,100) STRING(LOC1:LOC2), STRING(LOC3:LOC4), LUNKAF
- CALL KAXMSG(LUNLOG,MSG)
- RETURN
-*
-*.....ERROR PROCESSING
- 11 IRC = 1
- WRITE(MSG,111) STRING
- GO TO 99
-*
- 21 IRC = 2
- WRITE(MSG,121) STRING(LOC1:LOC2)
- GO TO 99
-*
- 31 IRC = 3
- WRITE(MSG,131) STRING(LOC3:LOC4), STRING(LOC1:LOC2)
- GO TO 99
-#if defined(CERNLIB_VAX)
-*
- 91 WRITE(MSG,191) LUNKAF, IOS
- CALL KAXMSG(LUNERR,MSG)
- CALL KAXEND
-*
- 92 WRITE(MSG,192) LUNKAF, IOS
- CALL KAXMSG(LUNERR,MSG)
- CALL KAXEND
-#endif
-*
- 99 CALL KAXMSG(LUNERR,MSG)
- IF ( RETURN ) RETURN
- CALL KAXEND
-*
- 100 FORMAT('CRNKA090 KAOPTN: OPTION ',A,'=',A,' SET FOR UNIT ',I3)
- 111 FORMAT('CRNKA091 KAOPTN: THE SECOND ARGUMENT, ''',A,''', IS NOT
- + OF THE FORM ''OPTION=VALUE''')
- 121 FORMAT('CRNKA092 KAOPTN: ''',A,''' IS NOT A VALID OPTION')
- 131 FORMAT('CRNKA093 KAOPTN: ''',A,''' IS NOT AN ACCEPTABLE VALUE FOR
- + THE ',A,' OPTION')
-#if defined(CERNLIB_VAX)
- 191 FORMAT('CRNKA094 KAOPTN: CLOSE ERROR WHILE CHANGING THE READ/WRITE
- + STATUS OF THE KA-FILE ON UNIT ',I3,', IOSTAT = ',I11)
- 192 FORMAT('CRNKA094 KAOPTN: OPEN ERROR WHILE CHANGING THE READ/WRITE
- + STATUS OF THE KA-FILE ON UNIT ',I3,', IOSTAT = ',I11)
-#endif
-*
- END
diff --git a/src/packlib/kapack/code/kapre.F b/src/packlib/kapack/code/kapre.F
deleted file mode 100644
index 2e2f291..0000000
--- a/src/packlib/kapack/code/kapre.F
+++ /dev/null
@@ -1,153 +0,0 @@
-*
-* $Id: kapre.F,v 1.1.1.1 1996/03/08 11:40:51 mclareni Exp $
-*
-* $Log: kapre.F,v $
-* Revision 1.1.1.1 1996/03/08 11:40:51 mclareni
-* Kapack
-*
-*
-#include "kapack/pilot.h"
- SUBROUTINE KAPRE(LUN,MAJNAM,MINNAM,IDATA,LDATA,IRC)
-*
-*.....RETRIEVE THE RECORD PRECEDING THE ONE SPECIFIED BY THE CALLER
-*
-#include "kapack/kax000.inc"
-#include "kapack/kax020.inc"
-#include "kapack/kax050.inc"
-#include "kapack/kax0a0.inc"
-#include "kapack/kax0b0.inc"
-*
- CHARACTER MAJNAM*(*), MINNAM*(*)
- CHARACTER MINOLD*(MAXNAM)
-*
- INTEGER IDATA(*)
-*
- LOGICAL DODATA
-*
-*-----------------------------------------------------------------------
-*
- DODATA = .TRUE.
-*
- 1 CALL KAXINI(LUN)
-*
-*.....PROCESS THE MAJOR NAME
- CALL KAXMAJ(MAJNAM,*11,*21)
-*
-*.....CHECK WHETHER THIS IS AN IMMEDIATE RECALL
- IF ( MINNAM.EQ.MINOLD .AND. IA(10).EQ.1 ) GO TO 3
-*
-*.....NOT AN IMMEDIATE RECALL SO CONVERT THE SUPPLIED MINOR NAME
- 2 IF ( MINNAM .EQ. ' ' ) THEN
- MINKEY(1) = 2
- MINKEY(2) = MAXKEY
- ELSE
- CALL KAXNAM(MINNAM,MINKEY,*12)
- ENDIF
-*
-*.....DO A KEY SEARCH FROM THE ROOT
- CALL KAXGET(KROOT(0),MINKEY,1,LOC,*3)
-*
-*.....THE SUPPLIED NAME HAS BEEN LOCATED SO GET THE PREVIOUS ONE
- 3 IF ( LOC .EQ. IA(6) ) THEN
- IF ( IA(2).EQ.0 .OR. IA(1).EQ.1 ) GO TO 31
- 4 NBLK = IA(1)
- CALL KAXRD(IA(2),IA,LBLK)
- IF ( IA(3) .NE. NBLK ) GO TO 2
- IF ( IA(8) .GT. 1 ) GO TO 4
- LOC = IA(7)
- ENDIF
-*
- LOCP = IA(6)
- 5 IF ( LOCP+IA(LOCP) .LT. LOC ) THEN
- LOCP = LOCP + IA(LOCP)
- GO TO 5
- ENDIF
- LOC = LOCP
-*
-*.....CONVERT THE LOCATED KEY TO AN EXTERNAL NAME
- CALL KAXI2E(IA(LOC+NRCW),MINNAM,*13)
-*
-*.....COPY THE RECORD TO THE USER'S STORAGE
- LDATA = IA(LOC) - NRCW - IA(LOC+NRCW)
- IF ( DODATA ) THEN
- IF ( IA(8) .EQ. 0 ) THEN
-*
-*...........NON-SEGMENTED RECORD
- IPTR = LOC + NRCW + IA(LOC+NRCW)
- CALL UCOPY( IA(IPTR), IDATA, LDATA )
-*
- ELSE
-*
-*...........SEGMENTED RECORD
- IF ( IA(8) .NE. 1 ) GO TO 91
- LDATA = IA(7) - IA(6) - NRCW - IA(LOC+NRCW)
- IPTR = LOC + NRCW + IA(LOC+NRCW)
- CALL UCOPY( IA(IPTR), IDATA, LDATA )
- IB(3) = IA(3)
- 6 CALL KAXRD(IB(3),IB,LBLK)
- IF ( IB(8).NE.2 .AND. IB(8).NE.3 ) GO TO 91
- LSEG = IB(7) - IB(6)
- CALL UCOPY( IB(IB(6)), IDATA(LDATA+1), LSEG )
- LDATA = LDATA + LSEG
- IF ( IB(8) .NE. 2 ) GO TO 6
- ENDIF
- ENDIF
-*
-*.....SUCCESSFUL COMPLETION
- MINOLD = MINNAM
- IA(10) = 1
- IRC = 0
- RETURN
-*
-*.....ENTRY POINT FOR NO DATA RETURN
- ENTRY KAPRE1(LUN,MAJNAM,MINNAM,LDATA,IRC)
- DODATA = .FALSE.
- GO TO 1
-*
-*.....ERROR PROCESSING
- 11 IRC = 1
- WRITE(MSG,111) MAJNAM
- GO TO 99
-*
- 12 IRC = 1
- WRITE(MSG,112) MINNAM
- GO TO 99
-*
- 13 IRC = 1
- WRITE(MSG,113) MAJNAM, LUN, LEN(MINNAM)
- GO TO 99
-*
- 21 IRC = 2
- WRITE(MSG,121) MAJNAM, LUN
- GO TO 99
-*
- 31 IRC = 3
- IF ( RETURN ) RETURN
- WRITE(MSG,131) MAJNAM, LUN
- GO TO 99
-*
- 91 WRITE(MSG,191) IA(8), IA(1), LUNKAF
- CALL KAXMSG(LUNERR,MSG)
- CALL KAXEND
-*
- 99 CALL KAXMSG(LUNERR,MSG)
- IF ( RETURN ) RETURN
- CALL KAXEND
-*
- 111 FORMAT('CRNKA381 KAPRE: ''',A,''' IS NOT AN ACCEPTABLE MAJOR
- + NAME')
- 112 FORMAT('CRNKA382 KAPRE: ''',A,''' IS NOT AN ACCEPTABLE MINOR
- + NAME')
- 113 FORMAT('CRNKA383 KAPRE: RETRIEVAL FAILED FOR MAJOR ',
- + ' NAME ''',A,''' ON UNIT ',I3,', THE LENGTH OF ',I11,
- + ' IS INSUFFICIENT FOR THE THIRD ARGUMENT')
- 121 FORMAT('CRNKA384 KAPRE: RETRIEVAL FAILED FOR MAJOR ',
- + ' NAME ''',A,''' ON UNIT ',I3,
- + ', THIS MAJOR NAME DOES NOT EXIST IN THE KA-FILE')
- 131 FORMAT('CRNKA385 KAPRE: BEGINNING OF FILE DETECTED DURING
- + REVERSE SEQUENTIAL RETRIEVAL FOR MAJOR NAME ''',A,
- + ''' ON UNIT ',I3)
- 191 FORMAT('CRNKA386 KAPRE: INVALID BLOCK TYPE ''',I11,
- + ''' FOUND IN BLOCK ',I11,' ON UNIT ',I3)
-*
- END
diff --git a/src/packlib/kapack/code/kaprem.F b/src/packlib/kapack/code/kaprem.F
deleted file mode 100644
index 686f7c8..0000000
--- a/src/packlib/kapack/code/kaprem.F
+++ /dev/null
@@ -1,98 +0,0 @@
-*
-* $Id: kaprem.F,v 1.1.1.1 1996/03/08 11:40:51 mclareni Exp $
-*
-* $Log: kaprem.F,v $
-* Revision 1.1.1.1 1996/03/08 11:40:51 mclareni
-* Kapack
-*
-*
-#include "kapack/pilot.h"
- SUBROUTINE KAPREM(LUN,MAJNAM,LDEF,LMAX,IRC)
-*
-*.....RETRIEVE THE MAJOR NAME PRECEDING THE ONE SUPPLIED BY THE CALLER
-*
-#include "kapack/kax000.inc"
-#include "kapack/kax020.inc"
-#include "kapack/kax02c.inc"
-#include "kapack/kax050.inc"
-#include "kapack/kax0a0.inc"
-*
- CHARACTER MAJNAM*(*)
- CHARACTER MAJOLD*(MAXNAM)
- SAVE MAJOLD
-*
-*-----------------------------------------------------------------------
-*
- CALL KAXINI(LUN)
-*
-*.....CHECK WHETHER THIS IS AN IMMEDIATE RECALL
- IF (.NOT.NEWLUN .AND. MAJNAM.EQ.MAJOLD .AND. IA(10).EQ.2) GO TO 2
-*
-*.....NOT AN IMMEDIATE RECALL SO CONVERT THE SUPPLIED MAJOR NAME
- 1 IF ( MAJNAM .EQ. ' ' ) THEN
- MAJKEY(1) = 2
- MAJKEY(2) = MAXKEY
- ELSE
- CALL KAXNAM(MAJNAM,MAJKEY,*11)
- ENDIF
-*
-*.....DO A KEY SEARCH FROM THE ROOT
- CALL KAXGET(1,MAJKEY,1,LOC,*2)
-*
-*.....THE SUPPLIED NAME HAS BEEN LOCATED SO GET THE PREVIOUS ONE
- 2 IF ( LOC .EQ. IA(6) ) THEN
- IF ( IA(2).EQ.0 .OR. IA(1).EQ.1 ) GO TO 21
- NBLK = IA(1)
- CALL KAXRD(IA(2),IA,LBLK)
- IF ( IA(3) .NE. NBLK ) GO TO 1
- LOC = IA(7)
- ENDIF
-*
- LOCP = IA(6)
- 3 IF ( LOCP+IA(LOCP) .LT. LOC ) THEN
- LOCP = LOCP + IA(LOCP)
- GO TO 3
- ENDIF
- LOC = LOCP
-*
-*.....CONVERT THE LOCATED KEY TO AN EXTERNAL NAME
- CALL KAXI2E(IA(LOC+NRCW),MAJNAM,*12)
-*
-*.....STORE THE DEFAULT AND MAXIMUM LENGTHS FOR THE CALLER
- IPTR = LOC + NRCW + IA(LOC+NRCW)
- LDEF = IA(IPTR+1)
- LMAX = IA(IPTR+2)
-*
-*.....SUCCESSFUL COMPLETION
- MAJOLD = MAJNAM
- IA(10) = 2
- IRC = 0
- RETURN
-*
-*.....ERROR PROCESSING
- 11 IRC = 1
- WRITE(MSG,111) MAJNAM
- GO TO 99
-*
- 12 IRC = 1
- WRITE(MSG,112) LUN, LEN(MAJNAM)
- GO TO 99
-*
- 21 IRC = 2
- IF ( RETURN ) RETURN
- WRITE(MSG,121) LUN
- GO TO 99
-*
- 99 CALL KAXMSG(LUNERR,MSG)
- IF ( RETURN ) RETURN
- CALL KAXEND
-*
- 111 FORMAT('CRNKA391 KAPREM: ''',A,''' IS NOT AN ACCEPTABLE MAJOR
- + NAME')
- 112 FORMAT('CRNKA392 KAPREM: RETRIEVAL OF MAJOR NAMES FAILED',
- + ' ON UNIT ',I3,', THE LENGTH OF ',I11,
- + ' IS INSUFFICIENT FOR THE SECOND ARGUMENT')
- 121 FORMAT('CRNKA393 KAPREM: BEGINNING OF FILE DETECTED DURING
- + REVERSE SEQUENTIAL RETRIEVAL OF MAJOR NAMES ON UNIT ',I3)
-*
- END
diff --git a/src/packlib/kapack/code/kaprik.F b/src/packlib/kapack/code/kaprik.F
deleted file mode 100644
index 8d1b1fc..0000000
--- a/src/packlib/kapack/code/kaprik.F
+++ /dev/null
@@ -1,81 +0,0 @@
-*
-* $Id: kaprik.F,v 1.1.1.1 1996/03/08 11:40:51 mclareni Exp $
-*
-* $Log: kaprik.F,v $
-* Revision 1.1.1.1 1996/03/08 11:40:51 mclareni
-* Kapack
-*
-*
-#include "kapack/pilot.h"
- SUBROUTINE KAPRIK(LUN,IRC)
-*
-*.....PRINT KEY VALUES
-*
-#include "kapack/kax000.inc"
-#include "kapack/kax020.inc"
-#include "kapack/kax050.inc"
-#include "kapack/kax0b0.inc"
-*
- CHARACTER MAJNAM*(MAXNAM)
-*
- LOGICAL LOCKED, XRETRN
-*
-*-----------------------------------------------------------------------
-*
- CALL KAXINI(LUN)
-*
-*.....SAVE THE CURRENT RETURN SETTING AND ENFORCE 'RETURN=YES'
- XRETRN = RETURN
- RETURN = .TRUE.
-*
- LOCKED = .FALSE.
-*
-*.....MAJOR TREE
- CALL KAXRD(1,IB,9)
- IF ( IB(9) .NE. 0 ) THEN
- LOCKED = .TRUE.
- WRITE(MSG,100) IB(9)
- CALL KAXMSG(LUNLOG,MSG)
- ENDIF
-*
-*.....LOOP FOR ALL MAJOR NAMES
- MAJNAM = ' '
-*
- 1 CALL KASEQM(LUN,MAJNAM,LDEF,LMAX,IRC)
- IF ( IRC .EQ. 0 ) THEN
- CALL KAXRD(KPROOT,IB,9)
- IF ( IB(9) .NE. 0 ) THEN
- LOCKED = .TRUE.
- NC = INDEX(MAJNAM,' ') - 1
- WRITE(MSG,101) MAJNAM(1:NC), IB(9)
- CALL KAXMSG(LUNLOG,MSG)
- ENDIF
- GO TO 1
- ELSE IF ( IRC .EQ. 1 ) THEN
- GO TO 11
- ELSE IF ( IRC .EQ. 2 ) THEN
- IF ( .NOT.LOCKED ) THEN
- WRITE(MSG,102) LUN
- CALL KAXMSG(LUNLOG,MSG)
- ENDIF
- ENDIF
-*
-*.....SUCCESSFUL COMPLETION
- IRC = 0
- RETURN = XRETRN
- RETURN
-*
-*.....ERROR PROCESSING
- 11 IRC = 1
- RETURN = XRETRN
- IF ( RETURN ) RETURN
- CALL KAXEND
-*
- 100 FORMAT('CRNKA400 KAPRIK: THE MAJOR NAMES ARE LOCKED WITH A KEY
- + VALUE OF ',I11)
- 101 FORMAT('CRNKA401 KAPRIK: MAJOR NAME ',A,' IS LOCKED WITH A KEY
- + VALUE OF ',I11)
- 102 FORMAT('CRNKA402 KAPRIK: THERE ARE NO LOCKS SET IN THE KA-FILE ON
- + UNIT ',I3)
-*
- END
diff --git a/src/packlib/kapack/code/kaput.F b/src/packlib/kapack/code/kaput.F
deleted file mode 100644
index 9c304bb..0000000
--- a/src/packlib/kapack/code/kaput.F
+++ /dev/null
@@ -1,90 +0,0 @@
-*
-* $Id: kaput.F,v 1.1.1.1 1996/03/08 11:40:51 mclareni Exp $
-*
-* $Log: kaput.F,v $
-* Revision 1.1.1.1 1996/03/08 11:40:51 mclareni
-* Kapack
-*
-*
-#include "kapack/pilot.h"
- SUBROUTINE KAPUT(LUN,MAJNAM,MINNAM,IDATA,IRC)
-*
-*.....REPLACE A RECORD IN A KA-FILE
-*
-#include "kapack/kax000.inc"
-#include "kapack/kax020.inc"
-#include "kapack/kax050.inc"
-#include "kapack/kax0a0.inc"
-*
- CHARACTER MAJNAM*(*), MINNAM*(*)
-*
- INTEGER IDATA(*)
-*
-*-----------------------------------------------------------------------
-*
- CALL KAXINI(LUN)
- IF ( .NOT. MODIFY ) GO TO 21
-*
-*.....PROCESS THE MAJOR NAME
- CALL KAXMAJ(MAJNAM,*11,*31)
-*
-*.....CONVERT THE MINOR NAME TO A KEY
- CALL KAXNAM(MINNAM,MINKEY,*12)
-*
-*.....REPLACE THE RECORD
- CALL KAXPUT(KROOT(0),MINKEY,IDATA,*41,*51)
-*
-*.....SUCCESSFUL COMPLETION
- IRC = 0
- WRITE(MSG,100) MAJNAM, MINNAM, LUN
- CALL KAXMSG(LUNLOG,MSG)
- RETURN
-*
-*.....ERROR PROCESSING
- 11 IRC = 1
- WRITE(MSG,111) MAJNAM
- GO TO 99
-*
- 12 IRC = 1
- WRITE(MSG,112) MINNAM
- GO TO 99
-*
- 21 IRC = 2
- WRITE(MSG,121) LUN
- GO TO 99
-*
- 31 IRC = 3
- WRITE(MSG,131) MAJNAM, MINNAM, LUN
- GO TO 99
-*
- 41 IRC = 4
- WRITE(MSG,141) MAJNAM, MINNAM, LUN
- GO TO 99
-*
- 51 IRC = 5
- WRITE(MSG,151) MAJNAM, MINNAM, LUN
- GO TO 99
-*
- 99 CALL KAXMSG(LUNERR,MSG)
- IF ( RETURN ) RETURN
- CALL KAXEND
-*
- 100 FORMAT('CRNKA100 KAPUT: ''',A,' ',A,
- + ''' HAS BEEN REPLACED IN THE KA-FILE ON UNIT ',I3)
- 111 FORMAT('CRNKA101 KAPUT: ''',A,''' IS NOT AN ACCEPTABLE MAJOR
- + NAME')
- 112 FORMAT('CRNKA102 KAPUT: ''',A,''' IS NOT AN ACCEPTABLE MINOR
- + NAME')
- 121 FORMAT('CRNKA103 KAPUT: MODIFICATION ATTEMPTED ON UNIT ',I3,
- + ' WITH MODIFY=NO SET')
- 131 FORMAT('CRNKA104 KAPUT: REPLACEMENT OF ''',A,' ',A,''' FAILED
- + ON UNIT ',I3,', THE MAJOR NAME DOES NOT EXIST IN THE
- + KA-FILE')
- 141 FORMAT('CRNKA105 KAPUT: REPLACEMENT OF ''',A,' ',A,''' FAILED
- + ON UNIT ',I3,', THIS RECORD DOES NOT EXIST IN THE
- + KA-FILE')
- 151 FORMAT('CRNKA106 KAPUT: REPLACEMENT OF ''',A,' ',A,''' FAILED ON
- + UNIT ',I3,
- + ', THE RECORD HAS NOT BEEN ACCESSED IN UPDATE MODE')
-*
- END
diff --git a/src/packlib/kapack/code/kaputm.F b/src/packlib/kapack/code/kaputm.F
deleted file mode 100644
index c0634f2..0000000
--- a/src/packlib/kapack/code/kaputm.F
+++ /dev/null
@@ -1,110 +0,0 @@
-*
-* $Id: kaputm.F,v 1.1.1.1 1996/03/08 11:40:51 mclareni Exp $
-*
-* $Log: kaputm.F,v $
-* Revision 1.1.1.1 1996/03/08 11:40:51 mclareni
-* Kapack
-*
-*
-#include "kapack/pilot.h"
- SUBROUTINE KAPUTM(LUN,MAJNAM,LDEF,LMAX,IRC)
-*
-*.....REPLACE A MAJOR ENTRY IN A KA-FILE
-*
-*.....UPDATING OF MAJOR NAME STACK ENTRIES ADDED 880628
-*
-#include "kapack/kax000.inc"
-#include "kapack/kax020.inc"
-#include "kapack/kax02c.inc"
-#include "kapack/kax050.inc"
-#include "kapack/kax0a0.inc"
-*
- CHARACTER MAJNAM*(*)
-*
- PARAMETER (MAJLEN=3)
- INTEGER MAJREC(1:MAJLEN)
-*
-*-----------------------------------------------------------------------
-*
- CALL KAXINI(LUN)
- IF ( .NOT. MODIFY ) GO TO 21
-*
-*.....CHECK THE DEFAULT AND MAXIMUM LENGTHS
- IF ( LDEF .LT. 0 ) GO TO 12
- IF ( LMAX .LT. 0 ) GO TO 13
- IF ( LDEF .GT. LMAX ) GO TO 14
-*
-*.....PROCESS THE MAJOR NAME
- CALL KAXMAJ(MAJNAM,*11,*31)
-*
-*.....BUILD THE NEW MAJOR ENTRY AND REPLACE IT IN THE MAJOR TREE
- MAJREC(1) = KROOT(0)
- MAJREC(2) = LDEF
- MAJREC(3) = LMAX
- CALL KAXPUT(1,MAJKEY,MAJREC,*31,*41)
-*.....UPDATE THE LENGTH ATTRIBUTES OF THE MAJOR NAME IN THE STACK
- KLDEF(0)= LDEF
- KLDEF(1)= LDEF
- KLMAX(0)= LMAX
- KLMAX(1)= LMAX
-*
-*.....SUCCESSFUL COMPLETION
- IRC = 0
- WRITE(MSG,100) MAJNAM, LUN, LDEF, LMAX
- CALL KAXMSG(LUNLOG,MSG)
- RETURN
-*
-*.....ERROR PROCESSING
- 11 IRC = 1
- WRITE(MSG,111) MAJNAM
- GO TO 99
-*
- 12 IRC = 1
- WRITE(MSG,112) LDEF
- GO TO 99
-*
- 13 IRC = 1
- WRITE(MSG,113) LMAX
- GO TO 99
-*
- 14 IRC = 1
- WRITE(MSG,114) LDEF, LMAX
- GO TO 99
-*
- 21 IRC = 2
- WRITE(MSG,121) LUN
- GO TO 99
-*
- 31 IRC = 3
- WRITE(MSG,131) MAJNAM, LUN
- GO TO 99
-*
- 41 IRC = 4
- WRITE(MSG,141) MAJNAM, LUN
- GO TO 99
-*
- 99 CALL KAXMSG(LUNERR,MSG)
- IF ( RETURN ) RETURN
- CALL KAXEND
-*
- 100 FORMAT('CRNKA110 KAPUTM: MAJOR NAME ''',A,
- + ''' HAS BEEN REPLACED IN THE KA-FILE ON UNIT ',I3,
- + ' WITH DEFAULT LENGTH ',I11,' AND MAXIMUM LENGTH ',I11)
- 111 FORMAT('CRNKA111 KAPUTM: ''',A,''' IS NOT AN ACCEPTABLE MAJOR
- + NAME')
- 112 FORMAT('CRNKA112 KAPUTM: ',I11,' IS NOT AN ACCEPTABLE VALUE FOR
- + THE DEFAULT RECORD LENGTH')
- 113 FORMAT('CRNKA113 KAPUTM: ',I11,' IS NOT AN ACCEPTABLE VALUE FOR
- + THE MAXIMUM RECORD LENGTH')
- 114 FORMAT('CRNKA114 KAPUTM: THE DEFAULT RECORD LENGTH OF ',I11,
- + ' EXCEEDS THE MAXIMUM RECORD LENGTH OF ',I11)
- 121 FORMAT('CRNKA115 KAPUTM: MODIFICATION ATTEMPTED ON UNIT ',I3,
- + ' WITH MODIFY=NO SET')
- 131 FORMAT('CRNKA116 KAPUTM: REPLACEMENT OF MAJOR NAME ''',A,
- + ''' FAILED ON UNIT ',I3,', THIS MAJOR NAME DOES NOT EXIST
- + IN THE KA-FILE')
- 141 FORMAT('CRNKA117 KAPUTM: REPLACEMENT OF MAJOR NAME ''',A,
- + ''' FAILED ON UNIT ',I3,
- + ', THE MAJOR NAME HAS NOT BEEN ACCESSED IN UPDATE MODE')
-*
- END
diff --git a/src/packlib/kapack/code/karlse.F b/src/packlib/kapack/code/karlse.F
deleted file mode 100644
index 63e620d..0000000
--- a/src/packlib/kapack/code/karlse.F
+++ /dev/null
@@ -1,72 +0,0 @@
-*
-* $Id: karlse.F,v 1.1.1.1 1996/03/08 11:40:51 mclareni Exp $
-*
-* $Log: karlse.F,v $
-* Revision 1.1.1.1 1996/03/08 11:40:51 mclareni
-* Kapack
-*
-*
-#include "kapack/pilot.h"
- SUBROUTINE KARLSE(LUN,KEY,IRC)
-*
-*.....RELEASE ALL TREES LOCKED WITH THE SPECIFIED KEY
-*
-#include "kapack/kax000.inc"
-#include "kapack/kax020.inc"
-#include "kapack/kax050.inc"
-#include "kapack/kax0b0.inc"
-*
- CHARACTER MAJOR*(MAXNAM)
-*
- LOGICAL XRETRN
-*
-*-----------------------------------------------------------------------
-*
- CALL KAXINI(LUN)
-*
-*.....SAVE THE CURRENT RETURN SETTING AND ENFORCE 'RETURN=YES'
- XRETRN = RETURN
- RETURN = .TRUE.
-*
-*.....LOOP FOR ALL MAJOR NAMES
- NRESET = 0
- MAJOR = ' '
-*
- 1 CALL KASEQM(LUN,MAJOR,LDEF,LMAX,IRC)
- IF ( IRC .EQ. 0 ) THEN
- CALL KAXRD(KPROOT,IB,LBLK)
- IF ( IB(9) .EQ. KEY ) THEN
- IB(9) = 0
- CALL KAXWRT(IB(1),IB,IB(7)-1)
- NRESET = NRESET + 1
- ENDIF
- GO TO 1
- ELSE IF ( IRC .EQ. 1 ) THEN
- GO TO 11
- ENDIF
-*
-*.....BLOCK 1
- CALL KAXRD(1,IB,LBLK)
- IF ( IB(9) .EQ. KEY ) THEN
- IB(9) = 0
- CALL KAXWRT(IB(1),IB,IB(7)-1)
- NRESET = NRESET + 1
- ENDIF
-*
-*.....SUCCESSFUL COMPLETION
- IRC = 0
- WRITE(MSG,100) NRESET, LUN
- CALL KAXMSG(LUNLOG,MSG)
- RETURN = XRETRN
- RETURN
-*
-*.....ERROR PROCESSING
- 11 IRC = 1
- RETURN = XRETRN
- IF ( RETURN ) RETURN
- CALL KAXEND
-*
- 100 FORMAT('CRNKA370 KARLSE: ',I11,' LOCKS RELEASED IN THE KA-FILE
- + ON UNIT ',I3)
-*
- END
diff --git a/src/packlib/kapack/code/kaseq.F b/src/packlib/kapack/code/kaseq.F
deleted file mode 100644
index c50586e..0000000
--- a/src/packlib/kapack/code/kaseq.F
+++ /dev/null
@@ -1,147 +0,0 @@
-*
-* $Id: kaseq.F,v 1.1.1.1 1996/03/08 11:40:51 mclareni Exp $
-*
-* $Log: kaseq.F,v $
-* Revision 1.1.1.1 1996/03/08 11:40:51 mclareni
-* Kapack
-*
-*
-#include "kapack/pilot.h"
- SUBROUTINE KASEQ(LUN,MAJNAM,MINNAM,IDATA,LDATA,IRC)
-*
-*.....RETRIEVE THE RECORD FOLLOWING THE ONE SPECIFIED BY THE CALLER
-*
-#include "kapack/kax000.inc"
-#include "kapack/kax020.inc"
-#include "kapack/kax050.inc"
-#include "kapack/kax0a0.inc"
-*
- CHARACTER MAJNAM*(*), MINNAM*(*)
- CHARACTER MINOLD*(MAXNAM)
-*
- INTEGER IDATA(*)
-*
- LOGICAL DODATA
-*
-*-----------------------------------------------------------------------
-*
- DODATA = .TRUE.
-*
- 1 CALL KAXINI(LUN)
-*
-*.....PROCESS THE MAJOR NAME
- CALL KAXMAJ(MAJNAM,*11,*21)
-*
-*.....CHECK WHETHER THIS IS AN IMMEDIATE RECALL
- IF ( MINNAM.EQ.MINOLD .AND. IA(10).EQ.3 ) GO TO 3
-*
-*.....NOT AN IMMEDIATE RECALL SO CONVERT THE SUPPLIED MINOR NAME
- 2 IF ( MINNAM .EQ. ' ' ) THEN
- MINKEY(1) = 2
- MINKEY(2) = -1
- ELSE
- CALL KAXNAM(MINNAM,MINKEY,*12)
- ENDIF
-*
-*.....DO A KEY SEARCH FROM THE ROOT
- CALL KAXGET(KROOT(0),MINKEY,1,LOC,*5)
-*
-*.....THE SUPPLIED NAME HAS BEEN LOCATED SO GET THE NEXT ONE
- 3 LOC = LOC + IA(LOC)
- IF ( LOC.GE.IA(7) .OR. IA(8).NE.0 ) THEN
- 4 NBLK = IA(1)
- CALL KAXRD(IA(3),IA,LBLK)
- IF ( IA(2) .NE. NBLK ) GO TO 2
- IF ( IA(8) .GT. 1 ) GO TO 4
- LOC = IA(6)
- ENDIF
-*
-*.....CHECK FOR 'END OF FILE'
- 5 IF ( IA(LOC+NRCW+1) .EQ. MAXKEY ) GO TO 31
-*
-*.....CONVERT THE LOCATED KEY TO AN EXTERNAL NAME
- CALL KAXI2E(IA(LOC+NRCW),MINNAM,*13)
-*
-*.....COPY THE RECORD TO THE USER'S STORAGE
- LDATA = IA(LOC) - NRCW - IA(LOC+NRCW)
- IF ( DODATA ) THEN
- IF ( IA(8) .EQ. 0 ) THEN
-*
-*...........NON-SEGMENTED RECORD
- IPTR = LOC + NRCW + IA(LOC+NRCW)
- CALL UCOPY( IA(IPTR), IDATA, LDATA )
-*
- ELSE
-*
-*...........SEGMENTED RECORD
- IF ( IA(8) .NE. 1 ) GO TO 91
- LDATA = IA(7) - IA(6) - NRCW - IA(LOC+NRCW)
- IPTR = LOC + NRCW + IA(LOC+NRCW)
- CALL UCOPY( IA(IPTR), IDATA, LDATA )
- 6 CALL KAXRD(IA(3),IA,LBLK)
- IF ( IA(8).NE.2 .AND. IA(8).NE.3 ) GO TO 91
- LSEG = IA(7) - IA(6)
- CALL UCOPY( IA(IA(6)), IDATA(LDATA+1), LSEG )
- LDATA = LDATA + LSEG
- IF ( IA(8) .NE. 2 ) GO TO 6
- ENDIF
- ENDIF
-*
-*.....SUCCESSFUL COMPLETION
- MINOLD = MINNAM
- IA(10) = 3
- IRC = 0
- RETURN
-*
-*.....ENTRY POINT FOR NO DATA RETURN
- ENTRY KASEQ1(LUN,MAJNAM,MINNAM,LDATA,IRC)
- DODATA = .FALSE.
- GO TO 1
-*
-*.....ERROR PROCESSING
- 11 IRC = 1
- WRITE(MSG,111) MAJNAM
- GO TO 99
-*
- 12 IRC = 1
- WRITE(MSG,112) MINNAM
- GO TO 99
-*
- 13 IRC = 1
- WRITE(MSG,113) MAJNAM, LUN, LEN(MINNAM)
- GO TO 99
-*
- 21 IRC = 2
- WRITE(MSG,121) MAJNAM, LUN
- GO TO 99
-*
- 31 IRC = 3
- IF ( RETURN ) RETURN
- WRITE(MSG,131) MAJNAM, LUN
- GO TO 99
-*
- 91 WRITE(MSG,191) IA(8), IA(1), LUNKAF
- CALL KAXMSG(LUNERR,MSG)
- CALL KAXEND
-*
- 99 CALL KAXMSG(LUNERR,MSG)
- IF ( RETURN ) RETURN
- CALL KAXEND
-*
- 111 FORMAT('CRNKA121 KASEQ: ''',A,''' IS NOT AN ACCEPTABLE MAJOR
- + NAME')
- 112 FORMAT('CRNKA122 KASEQ: ''',A,''' IS NOT AN ACCEPTABLE MINOR
- + NAME')
- 113 FORMAT('CRNKA123 KASEQ: RETRIEVAL FAILED FOR MAJOR ',
- + ' NAME ''',A,''' ON UNIT ',I3,', THE LENGTH OF ',I11,
- + ' IS INSUFFICIENT FOR THE THIRD ARGUMENT')
- 121 FORMAT('CRNKA124 KASEQ: RETRIEVAL FAILED FOR MAJOR ',
- + ' NAME ''',A,''' ON UNIT ',I3,
- + ', THIS MAJOR NAME DOES NOT EXIST IN THE KA-FILE')
- 131 FORMAT('CRNKA125 KASEQ: END OF FILE DETECTED DURING
- + FORWARD SEQUENTIAL RETRIEVAL FOR MAJOR NAME ''',A,
- + ''' ON UNIT ',I3)
- 191 FORMAT('CRNKA126 KASEQ: INVALID BLOCK TYPE ''',I11,
- + ''' FOUND IN BLOCK ',I11,' ON UNIT ',I3)
-*
- END
diff --git a/src/packlib/kapack/code/kaseqm.F b/src/packlib/kapack/code/kaseqm.F
deleted file mode 100644
index 781a59d..0000000
--- a/src/packlib/kapack/code/kaseqm.F
+++ /dev/null
@@ -1,97 +0,0 @@
-*
-* $Id: kaseqm.F,v 1.1.1.1 1996/03/08 11:40:51 mclareni Exp $
-*
-* $Log: kaseqm.F,v $
-* Revision 1.1.1.1 1996/03/08 11:40:51 mclareni
-* Kapack
-*
-*
-#include "kapack/pilot.h"
- SUBROUTINE KASEQM(LUN,MAJNAM,LDEF,LMAX,IRC)
-*
-*.....RETRIEVE THE MAJOR NAME FOLLOWING THE ONE SUPPLIED BY THE CALLER
-*
-#include "kapack/kax000.inc"
-#include "kapack/kax020.inc"
-#include "kapack/kax02c.inc"
-#include "kapack/kax050.inc"
-#include "kapack/kax0a0.inc"
-*
- CHARACTER MAJNAM*(*)
- CHARACTER MAJOLD*(MAXNAM)
- SAVE MAJOLD
-*
-*-----------------------------------------------------------------------
-*
- CALL KAXINI(LUN)
-*
-*.....CHECK WHETHER THIS IS AN IMMEDIATE RECALL
- IF (.NOT.NEWLUN .AND. MAJNAM.EQ.MAJOLD .AND. IA(10).EQ.4) GO TO 3
-*
-*.....NOT AN IMMEDIATE RECALL SO CONVERT THE SUPPLIED MAJOR NAME
- 2 IF ( MAJNAM .EQ. ' ' ) THEN
- MAJKEY(1) = 2
- MAJKEY(2) = -1
- ELSE
- CALL KAXNAM(MAJNAM,MAJKEY,*11)
- ENDIF
-*
-*.....DO A KEY SEARCH FROM THE ROOT
- CALL KAXGET(1,MAJKEY,1,LOC,*5)
-*
-*.....THE SUPPLIED NAME HAS BEEN LOCATED SO GET THE NEXT ONE
- 3 LOC = LOC + IA(LOC)
- IF ( LOC .GE. IA(7) ) THEN
- NBLK = IA(1)
- CALL KAXRD(IA(3),IA,LBLK)
- IF ( IA(2) .NE. NBLK ) GO TO 2
- LOC = IA(6)
- ENDIF
-*
-*.....CHECK FOR 'END OF FILE'
- 5 IF ( IA(LOC+NRCW+1) .EQ. MAXKEY ) GO TO 21
-*
-*.....CONVERT THE LOCATED KEY TO AN EXTERNAL NAME
- CALL KAXI2E(IA(LOC+NRCW),MAJNAM,*12)
-*
-*.....STORE THE DEFAULT AND MAXIMUM LENGTHS FOR THE CALLER
- IPTR = LOC + NRCW + IA(LOC+NRCW)
- LDEF = IA(IPTR+1)
- LMAX = IA(IPTR+2)
-*
-*.....STORE THE ROOT BLOCK NUMBER FOR USE BY KAPRIK AND KARLSE
- KPROOT= IA(IPTR)
-*
-*.....SUCCESSFUL COMPLETION
- MAJOLD = MAJNAM
- IA(10) = 4
- IRC = 0
- RETURN
-*
-*.....ERROR PROCESSING
- 11 IRC = 1
- WRITE(MSG,111) MAJNAM
- GO TO 99
-*
- 12 IRC = 1
- WRITE(MSG,112) LUN, LEN(MAJNAM)
- GO TO 99
-*
- 21 IRC = 2
- IF ( RETURN ) RETURN
- WRITE(MSG,121) LUN
- GO TO 99
-*
- 99 CALL KAXMSG(LUNERR,MSG)
- IF ( RETURN ) RETURN
- CALL KAXEND
-*
- 111 FORMAT('CRNKA131 KASEQM: ''',A,''' IS NOT AN ACCEPTABLE MAJOR
- + NAME')
- 112 FORMAT('CRNKA132 KASEQM: RETRIEVAL OF MAJOR NAMES FAILED',
- + ' ON UNIT ', I3,', THE LENGTH OF ',I11,
- + ' IS INSUFFICIENT FOR THE SECOND ARGUMENT')
- 121 FORMAT('CRNKA133 KASEQM: END OF FILE DETECTED DURING
- + FORWARD SEQUENTIAL RETRIEVAL OF MAJOR NAMES ON UNIT ',I3)
-*
- END
diff --git a/src/packlib/kapack/code/kastop.F b/src/packlib/kapack/code/kastop.F
deleted file mode 100644
index a746198..0000000
--- a/src/packlib/kapack/code/kastop.F
+++ /dev/null
@@ -1,36 +0,0 @@
-*
-* $Id: kastop.F,v 1.1.1.1 1996/03/08 11:40:52 mclareni Exp $
-*
-* $Log: kastop.F,v $
-* Revision 1.1.1.1 1996/03/08 11:40:52 mclareni
-* Kapack
-*
-*
-#include "kapack/pilot.h"
- SUBROUTINE KASTOP
-*
-*.....TERMINATE KAPACK PROCESSING
-*
-#include "kapack/kax000.inc"
-#include "kapack/kax020.inc"
-#include "kapack/kax030.inc"
-#include "kapack/kax070.inc"
-#include "kapack/kax0b0.inc"
-*
-*-----------------------------------------------------------------------
-*
-*.....DELETE ALL LOCKS
-* . . (TO AVOID RECURSION VIA KAXEND DO NOT CALL LOWER LEVEL ROUTINES)
- DO 1 L = 1, LLOCKQ
- IF ( LOCKN(L) .NE. 0 ) THEN
- LUN = LOCKU(L)
- READ(LUN,REC=LOCKI(L)) (IB(I),I=1,LBKS(LUN))
- IF ( IB(9) .EQ. JOBID ) THEN
- IB(9) = 0
- WRITE(LUN,REC=LOCKI(L)) (IB(I),I=1,LBKS(LUN))
- ENDIF
- LOCKN(L) = 0
- ENDIF
- 1 CONTINUE
-*
- END
diff --git a/src/packlib/kapack/code/kat.F b/src/packlib/kapack/code/kat.F
deleted file mode 100644
index a3fe591..0000000
--- a/src/packlib/kapack/code/kat.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: kat.F,v 1.1.1.1 1996/03/08 11:40:52 mclareni Exp $
-*
-* $Log: kat.F,v $
-* Revision 1.1.1.1 1996/03/08 11:40:52 mclareni
-* Kapack
-*
-*
-* DECK OF SUBROUTINE TO PRINT PAM TITLE.
-#include "kapack/pilot.h"
- SUBROUTINE KAT(LUN)
-*
-*.....PRINT THE PAM TITLE ON UNIT LUN
-*
- CHARACTER TITLE*80
-*
-*-----------------------------------------------------------------------
-*
- WRITE(TITLE,100)
- CALL KAXED(LUN,TITLE)
-*
- 100 FORMAT('CRNKA001 KAT: ',
- + 40H KAPACK 2.17 950217 CERN
- +)
-*
- END
diff --git a/src/packlib/kapack/code/kaxad1.F b/src/packlib/kapack/code/kaxad1.F
deleted file mode 100644
index ff18e02..0000000
--- a/src/packlib/kapack/code/kaxad1.F
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: kaxad1.F,v 1.1.1.1 1996/03/08 11:40:52 mclareni Exp $
-*
-* $Log: kaxad1.F,v $
-* Revision 1.1.1.1 1996/03/08 11:40:52 mclareni
-* Kapack
-*
-*
-#include "kapack/pilot.h"
- SUBROUTINE KAXAD1(LOC,KEY,IDATA,LDATA)
-*
-*.....ADD A RECORD TO A TREE: METHOD 1, INSERTION IN CURRENT BLOCK
-*
-#include "kapack/kax000.inc"
-#include "kapack/kax020.inc"
-#include "kapack/kax0a0.inc"
-*
- INTEGER IDATA(*), KEY(*)
-*
-*-----------------------------------------------------------------------
-*
-*.....CALCULATE THE TOTAL LENGTH OF THE NEW RECORD
- LREC = NRCW + KEY(1) + LDATA
-*
-*.....INSERT THE RECORD IF THERE IS SUFFICIENT SPACE, ELSE CALL KAXAD2
- IF ( LREC .LE. LBLK+1-IA(7) ) THEN
- CALL KAXINS(IA,LOC,KEY,IDATA,LDATA)
- CALL KAXWRT(IA(1),IA,IA(7)-1)
- ELSE
- CALL KAXAD2(LOC,KEY,IDATA,LDATA)
- ENDIF
-*
- END
diff --git a/src/packlib/kapack/code/kaxad2.F b/src/packlib/kapack/code/kaxad2.F
deleted file mode 100644
index d026248..0000000
--- a/src/packlib/kapack/code/kaxad2.F
+++ /dev/null
@@ -1,84 +0,0 @@
-*
-* $Id: kaxad2.F,v 1.1.1.1 1996/03/08 11:40:52 mclareni Exp $
-*
-* $Log: kaxad2.F,v $
-* Revision 1.1.1.1 1996/03/08 11:40:52 mclareni
-* Kapack
-*
-*
-#include "kapack/pilot.h"
- SUBROUTINE KAXAD2(LOC,KEY,IDATA,LDATA)
-*
-*.....ADD A RECORD TO A TREE: METHOD 2, SPLIT THE CURRENT BLOCK
-*
-#include "kapack/kax000.inc"
-#include "kapack/kax020.inc"
-#include "kapack/kax0a0.inc"
-#include "kapack/kax0b0.inc"
-*
- INTEGER IDATA(*), KEY(*)
-*
- LOGICAL LONG
-*
-*-----------------------------------------------------------------------
-*
-*.....GENERATE A NEW TREE LEVEL TO AVOID SPLITTING A ROOT BLOCK
- IF ( IA(1) .EQ. IA(4) ) CALL KAXGLV(LOC)
-*
- NLEFT = IA(2)
- NRIGHT = IA(1)
-*
-*.....THE BLOCK CANNOT BE SPLIT IF INSERTION IS AT THE BEGINNING
- IF ( LOC .EQ. IA(6) ) THEN
- CALL KAXAD3(KEY,IDATA,LDATA,NBLOCK)
-*
- ELSE
-*
-*.....GET A BLOCK TO BECOME THE NEW LEFT BROTHER
- CALL KAXGBK(NBLOCK)
- IA(2) = NBLOCK
-*
-*........DETERMINE SPACE AVAILABLE AFTER THE SPLIT
- LA = LBLK+1 - IA(7) + LOC - IA(6)
- LB = LBLK+1 - LOC
- LONG = (LREC.GT.LA) .AND. (LREC.GT.LB)
- IF ( LONG ) CALL KAXAD3(KEY,IDATA,LDATA,NRIGHT)
-*
-*........SPLIT THE CURRENT BLOCK
- IB( 1) = NBLOCK
- IB( 2) = NLEFT
- IB( 3) = NRIGHT
- IB( 4) = IA(4)
- IB( 5) = IA(5)
- IB( 6) = NBCW + 1
- IB( 7) = NBCW + 1
- IB( 8) = 0
- IB( 9) = 0
- IB(10) = 0
- CALL KAXSHL(IA,IB,LOC-IA(6))
-*
-*........INSERT THE NEW RECORD
- IF ( .NOT. LONG ) THEN
- IF ( LA .GT. LB ) THEN
- CALL KAXINS(IA,IA(6),KEY,IDATA,LDATA)
- ELSE
- CALL KAXINS(IB,LOC,KEY,IDATA,LDATA)
- ENDIF
- ENDIF
-*
-*........WRITE THE NEW BLOCK
- CALL KAXWRT(IB(1),IB,IB(7)-1)
- CALL KAXGXA(IB)
- ENDIF
-*
-*.....UPDATE THE RIGHT POINTER IN THE OLD LEFT BROTHER
- IF ( NLEFT .NE. 0 ) THEN
- CALL KAXRD(NLEFT,IB,LBLK)
- IB(3) = NBLOCK
- CALL KAXWRT(IB(1),IB,IB(7)-1)
- ENDIF
-*
-*.....REPLACE THE CURRENT BLOCK
- CALL KAXWRT(IA(1),IA,IA(7)-1)
-*
- END
diff --git a/src/packlib/kapack/code/kaxad3.F b/src/packlib/kapack/code/kaxad3.F
deleted file mode 100644
index 002b634..0000000
--- a/src/packlib/kapack/code/kaxad3.F
+++ /dev/null
@@ -1,69 +0,0 @@
-*
-* $Id: kaxad3.F,v 1.1.1.1 1996/03/08 11:40:52 mclareni Exp $
-*
-* $Log: kaxad3.F,v $
-* Revision 1.1.1.1 1996/03/08 11:40:52 mclareni
-* Kapack
-*
-*
-#include "kapack/pilot.h"
- SUBROUTINE KAXAD3(KEY,IDATA,LDATA,LINK)
-*
-*.....ADD A RECORD TO A TREE: METHOD 3, ACQUIRE ADDITIONAL BLOCK(S)
-*
-#include "kapack/kax000.inc"
-#include "kapack/kax020.inc"
-#include "kapack/kax0a0.inc"
-#include "kapack/kax0b0.inc"
-*
- INTEGER IDATA(*), KEY(*)
-*
-*-----------------------------------------------------------------------
-*
-*.....INITIALIZE
- CALL KAXGBK(NBLOCK)
- LINK = NBLOCK
- NPREV = IA(2)
- ITYPE = 0
- LDONE = 0
- LDO = MIN ( LBLK-NBCW-NRCW-KEY(1), LDATA )
-*
-*.....LOOP FOR EACH SEGMENT
- 1 IF ( LDATA .GT. LDONE+LDO ) THEN
- CALL KAXGBK(NXTBLK)
- IF ( ITYPE .EQ. 0 ) ITYPE = 1
- ELSE
- NXTBLK = IA(1)
- IF ( ITYPE .NE. 0 ) ITYPE = 2
- ENDIF
- IB( 1) = NBLOCK
- IB( 2) = NPREV
- IB( 3) = NXTBLK
- IB( 4) = IA( 4)
- IB( 5) = IA( 5)
- IB( 6) = NBCW + 1
- IB( 7) = IB( 6)
- IB( 8) = ITYPE
- IB( 9) = 0
- IB(10) = 0
- IF ( ITYPE .LE. 1 ) THEN
- IB(IB(7)) = LREC
- CALL UCOPY(KEY,IB(IB(7)+1),KEY(1))
- IB(7) = IB(7) + NRCW + KEY(1)
- ENDIF
- CALL UCOPY(IDATA(LDONE+1),IB(IB(7)),LDO)
- IB(7) = IB(7) + LDO
- CALL KAXWRT(IB(1),IB,IB(7)-1)
- IF ( ITYPE .LE. 1 ) CALL KAXGXA(IB)
- LDONE = LDONE + LDO
- IF ( LDONE .LT. LDATA ) THEN
- NPREV = NBLOCK
- NBLOCK = NXTBLK
- ITYPE = 3
- LDO = MIN ( LBLK-NBCW, LDATA-LDONE )
- GO TO 1
- ENDIF
-*
- IA(2) = IB(1)
-*
- END
diff --git a/src/packlib/kapack/code/kaxadd.F b/src/packlib/kapack/code/kaxadd.F
deleted file mode 100644
index 343064b..0000000
--- a/src/packlib/kapack/code/kaxadd.F
+++ /dev/null
@@ -1,72 +0,0 @@
-*
-* $Id: kaxadd.F,v 1.1.1.1 1996/03/08 11:40:52 mclareni Exp $
-*
-* $Log: kaxadd.F,v $
-* Revision 1.1.1.1 1996/03/08 11:40:52 mclareni
-* Kapack
-*
-*
-#include "kapack/pilot.h"
- SUBROUTINE KAXADD(IROOT,KEY,IDATA,LDATA,*,*)
-*
-*.....ADD A RECORD TO A TREE: STEERING ROUTINE
-*
-#include "kapack/kax000.inc"
-#include "kapack/kax020.inc"
-#include "kapack/kax050.inc"
-#include "kapack/kax080.inc"
-#include "kapack/kax0a0.inc"
-*
- INTEGER IDATA(*), KEY(*)
-*
-*-----------------------------------------------------------------------
-*
-*.....ENSURE THERE IS ENOUGH SPACE ASSUMING THE WORST CASE
- NEED = 1 + LEVELS + (NRCW+KEY(1)+LDATA-1)/(LBLK-NBCW) + 1
- IF ( NEED .GT. NFREE ) RETURN 2
-*
-*.....LOCK THE TREE
- CALL KAXOLK(IROOT)
-*
-*.....DETERMINE THE POTENTIAL LOCATION OF THE RECORD
- CALL KAXGET(IROOT,KEY,1,LOC,*1)
- GO TO 11
-*
-*.....INITIALIZE THE INDEX ADDITION QUEUE POINTERS
- 1 IXAF = 0
- IXAL = 0
-*
-*.....ADD THE NEW RECORD
- CALL KAXAD1(LOC,KEY,IDATA,LDATA)
-*
-*.....PERFORM ANY INDEX ADDITIONS WHICH HAVE BEEN GENERATED
- 2 IF ( IXAF .NE. IXAL ) THEN
- NEXT = MOD(IXAF+1,LXAQ+1)
- CALL KAXGET(IROOT,IXAKEY(1,NEXT),IXALEV(NEXT),IXLOC,*3)
- GO TO 91
- 3 CALL KAXAD1(IXLOC,IXAKEY(1,NEXT),IXAPTR(NEXT),1)
- IXAF = NEXT
- GO TO 2
- ENDIF
-*
-*.....SUCCESSFUL COMPLETION
- CALL KAXRLK(IROOT)
- RETURN
-*
-*.....ENTRY POINT TO ADD INDEX ENTRIES ONLY
- ENTRY KAXADX(IROOT)
- CALL KAXOLK(IROOT)
- GO TO 2
-*
-*.....ERROR PROCESSING
- 11 CALL KAXRLK(IROOT)
- RETURN 1
-*
- 91 WRITE(MSG,191) LUNKAF
- CALL KAXMSG(LUNERR,MSG)
- CALL KAXEND
-*
- 191 FORMAT('CRNKA141 KAXADD: KAPACK SYSTEM ERROR OR CORRUPT FILE ON
- + UNIT ',I3)
-*
- END
diff --git a/src/packlib/kapack/code/kaxage.F b/src/packlib/kapack/code/kaxage.F
deleted file mode 100644
index 3f3834c..0000000
--- a/src/packlib/kapack/code/kaxage.F
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: kaxage.F,v 1.1.1.1 1996/03/08 11:40:52 mclareni Exp $
-*
-* $Log: kaxage.F,v $
-* Revision 1.1.1.1 1996/03/08 11:40:52 mclareni
-* Kapack
-*
-*
-#include "kapack/pilot.h"
-#if !defined(CERNLIB_IBM)||defined(CERNLIB_QMIBMXA)
- SUBROUTINE KAXAGE(IWAIT)
-C
-C Routine to wait for given time period IHUNS - in 1/100sec units
-C
- CALL SLEEPF(IWAIT/100)
-*
- END
-#endif
diff --git a/src/packlib/kapack/code/kaxcmp.F b/src/packlib/kapack/code/kaxcmp.F
deleted file mode 100644
index a5bc612..0000000
--- a/src/packlib/kapack/code/kaxcmp.F
+++ /dev/null
@@ -1,48 +0,0 @@
-*
-* $Id: kaxcmp.F,v 1.1.1.1 1996/03/08 11:40:52 mclareni Exp $
-*
-* $Log: kaxcmp.F,v $
-* Revision 1.1.1.1 1996/03/08 11:40:52 mclareni
-* Kapack
-*
-*
-#include "kapack/pilot.h"
- INTEGER FUNCTION KAXCMP(KEYA,KEYB)
-*
-*.....COMPARE TWO KEYS IN INTERNAL REPRESENTATION
-* KEYA < KEYB ---> KAXCMP < 0
-* KEYA = KEYB ---> KAXCMP = 0
-* KEYA > KEYB ---> KAXCMP > 0
-*
- INTEGER KEYA(*), KEYB(*)
-*
-*-----------------------------------------------------------------------
-*
- IF ( KEYA(2).LT.0 .AND. KEYB(2).LT.0 ) THEN
-*
-*........BOTH KEYS ARE NUMERIC
- KAXCMP = KEYA(1) - KEYB(1)
- IF ( KAXCMP .NE. 0 ) RETURN
-*
- DO 1 I = 2, KEYA(1)
- KAXCMP = ABS(KEYA(I)) - ABS(KEYB(I))
- IF ( KAXCMP .NE. 0 ) RETURN
- 1 CONTINUE
-*
- ELSE IF ( KEYA(2).GT.0 .AND. KEYB(2).GT.0 ) THEN
-*
-*........BOTH KEYS ARE ALPHANUMERIC
- DO 2 I = 2, MIN(KEYA(1),KEYB(1))
- KAXCMP = KEYA(I) - KEYB(I)
- IF ( KAXCMP .NE. 0 ) RETURN
- 2 CONTINUE
-*
- KAXCMP = KEYA(1) - KEYB(1)
-*
- ELSE
-*
-*........ONE KEY IS NUMERIC AND THE OTHER ALPHANUMERIC
- KAXCMP = KEYA(2)
- ENDIF
-*
- END
diff --git a/src/packlib/kapack/code/kaxcon.F b/src/packlib/kapack/code/kaxcon.F
deleted file mode 100644
index 824a40f..0000000
--- a/src/packlib/kapack/code/kaxcon.F
+++ /dev/null
@@ -1,71 +0,0 @@
-*
-* $Id: kaxcon.F,v 1.1.1.1 1996/03/08 11:40:52 mclareni Exp $
-*
-* $Log: kaxcon.F,v $
-* Revision 1.1.1.1 1996/03/08 11:40:52 mclareni
-* Kapack
-*
-*
-#include "kapack/pilot.h"
- SUBROUTINE KAXCON
-*
-*.....PERFORM CONCATENATION WITH THE LEFT OR RIGHT BROTHER
-*
-#include "kapack/kax000.inc"
-#include "kapack/kax020.inc"
-#include "kapack/kax0a0.inc"
-#include "kapack/kax0b0.inc"
-*
-*-----------------------------------------------------------------------
-*
-*.....SPECIAL CASE - CHECK FOR A ROOT BLOCK, THEN
-* IF IT IS NOT A LEAF AND HAS ONLY ONE ENTRY, DELETE THE LEVEL
- IF ( IA(4) .EQ. IA(1) ) THEN
- IF ( IA(5).NE.1 .AND. IA(6)+IA(IA(6)).GE.IA(7) ) CALL KAXDLV
- RETURN
- ENDIF
-*
-*.....DON'T ATTEMPT CONCATENATION IF OCCUPANCY IS ABOVE THRESHOLD
- NSPACE = LBLK + 1 - IA(6)
- NUSEDA = IA(7) - IA(6)
- USED = REAL(NUSEDA) / REAL(NSPACE)
- IF ( USED .GT. THRESH ) RETURN
-*
-*.....TRY TO CONCATENATE WITH THE LEFT BROTHER
- IF ( IA(2) .EQ. 0 ) GO TO 1
- CALL KAXRD(IA(2),IB,LBLK)
- IF ( IB(8) .NE. 0 ) GO TO 1
- NUSEDB = IB(7) - IB(6)
- IF ( NUSEDA+NUSEDB .GT. NSPACE ) GO TO 1
- CALL KAXGXD(IB)
- CALL KAXSHR(IB,IA,NUSEDB)
- IA(2) = IB(2)
- CALL KAXWRT(IA(1),IA,IA(7)-1)
- CALL KAXFBK(IB(1))
- IF ( IA(2) .NE. 0 ) THEN
- CALL KAXRD(IA(2),IB,LBLK)
- IB(3) = IA(1)
- CALL KAXWRT(IB(1),IB,IB(7)-1)
- ENDIF
- RETURN
-*
-*.....TRY TO CONCATENATE WITH THE RIGHT BROTHER
- 1 IF ( IA(3) .EQ. 0 ) GO TO 2
- CALL KAXRD(IA(3),IB,LBLK)
- IF ( IB(8) .NE. 0 ) GO TO 2
- NUSEDB = IB(7) - IB(6)
- IF ( NUSEDA+NUSEDB .GT. NSPACE ) GO TO 2
- CALL KAXGXD(IA)
- CALL KAXSHR(IA,IB,NUSEDA)
- IB(2) = IA(2)
- CALL KAXWRT(IB(1),IB,IB(7)-1)
- CALL KAXFBK(IA(1))
- IF ( IA(2) .NE. 0 ) THEN
- CALL KAXRD(IA(2),IB,LBLK)
- IB(3) = IA(3)
- CALL KAXWRT(IB(1),IB,IB(7)-1)
- ENDIF
-*
- 2 RETURN
-*
- END
diff --git a/src/packlib/kapack/code/kaxdel.F b/src/packlib/kapack/code/kaxdel.F
deleted file mode 100644
index c6ea060..0000000
--- a/src/packlib/kapack/code/kaxdel.F
+++ /dev/null
@@ -1,74 +0,0 @@
-*
-* $Id: kaxdel.F,v 1.1.1.1 1996/03/08 11:40:52 mclareni Exp $
-*
-* $Log: kaxdel.F,v $
-* Revision 1.1.1.1 1996/03/08 11:40:52 mclareni
-* Kapack
-*
-*
-#include "kapack/pilot.h"
- SUBROUTINE KAXDEL(IROOT,KEY,*)
-*
-*.....DELETE A RECORD FROM A TREE: STEERING ROUTINE
-*
-* MODIFIED 1987/05/06 TO INCLUDE THE KAXADX CALL IN THE LABEL 1 LOOP
-* SINCE THE CALL TO KAXDL1 IN THE LOOP MAY GENERATE INDEX ADDITION
-* ENTRIES. THIS CORRECTS THE RARE BUG WHEREBY INDEX BLOCKS GOT LOST.
-* PAM VERSION 2.08 H.RENSHALL, DD, CERN.
-*
-#include "kapack/kax000.inc"
-#include "kapack/kax020.inc"
-#include "kapack/kax050.inc"
-#include "kapack/kax080.inc"
-#include "kapack/kax090.inc"
-#include "kapack/kax0a0.inc"
-*
- INTEGER KEY(*)
-*
-*-----------------------------------------------------------------------
-*
-*.....LOCK THE TREE
- CALL KAXOLK(IROOT)
-*
-*.....LOCATE THE RECORD
- CALL KAXGET(IROOT,KEY,1,LOC,*11)
-*
-*.....INITIALIZE THE INDEX ADDITION AND DELETION QUEUE POINTERS
- IXAF = 0
- IXAL = 0
- IXDF = 0
- IXDL = 0
-*
-*.....DELETE THE RECORD
- CALL KAXDL1(LOC)
-*
-*.....PERFORM ANY INDEX MODIFICATIONS WHICH HAVE BEEN GENERATED
-* (DELETIONS MUST BE MADE AFTER ADDITIONS TO AVOID DELETING
-* THE LEVELS TO WHICH THE ADDITIONS ARE TO BE MADE)
-*
- 1 CALL KAXADX(IROOT)
-*
- IF ( IXDF .NE. IXDL ) THEN
- NEXT = MOD(IXDF+1,LXDQ+1)
- CALL KAXGET(IROOT,IXDKEY(1,NEXT),IXDLEV(NEXT),IXLOC,*91)
- CALL KAXDL1(IXLOC)
- IXDF = NEXT
- GO TO 1
- ENDIF
-*
-*.....SUCCESSFUL COMPLETION
- CALL KAXRLK(IROOT)
- RETURN
-*
-*.....ERROR PROCESSING
- 11 CALL KAXRLK(IROOT)
- RETURN 1
-*
- 91 WRITE(MSG,191) LUNKAF
- CALL KAXMSG(LUNERR,MSG)
- CALL KAXEND
-*
- 191 FORMAT('CRNKA161 KAXDEL: KAPACK SYSTEM ERROR OR CORRUPT FILE ON
- + UNIT ',I3)
-*
- END
diff --git a/src/packlib/kapack/code/kaxdl1.F b/src/packlib/kapack/code/kaxdl1.F
deleted file mode 100644
index be96e6b..0000000
--- a/src/packlib/kapack/code/kaxdl1.F
+++ /dev/null
@@ -1,45 +0,0 @@
-*
-* $Id: kaxdl1.F,v 1.1.1.1 1996/03/08 11:40:52 mclareni Exp $
-*
-* $Log: kaxdl1.F,v $
-* Revision 1.1.1.1 1996/03/08 11:40:52 mclareni
-* Kapack
-*
-*
-#include "kapack/pilot.h"
- SUBROUTINE KAXDL1(LOC)
-*
-*.....DELETE A BLOCKED RECORD
-*
-#include "kapack/kax000.inc"
-#include "kapack/kax0a0.inc"
-*
-*-----------------------------------------------------------------------
-*
-*.....CHECK FOR UNBLOCKED OR SEGMENTED RECORDS
- IF ( LOC.EQ.IA(6) .AND. LOC+IA(LOC).GE.IA(7) ) THEN
- CALL KAXDL2
-*
- ELSE
-*
-*........BLOCKED RECORDS
- IF ( LOC+IA(LOC) .LT. IA(7) ) THEN
-*
-*...........NOT THE HIGHEST RECORD IN THE BLOCK
- IA(7) = IA(7) - IA(LOC)
- CALL UCOPY( IA(LOC+IA(LOC)), IA(LOC), IA(7)-LOC )
- CALL KAXWRT(IA(1),IA,IA(7)-1)
- CALL KAXCON
-*
- ELSE
-*
-*...........THE HIGHEST RECORD IN THE BLOCK
- CALL KAXGXD(IA)
- IA(7) = IA(7) - IA(LOC)
- CALL KAXWRT(IA(1),IA,IA(7)-1)
- CALL KAXGXA(IA)
-*
- ENDIF
- ENDIF
-*
- END
diff --git a/src/packlib/kapack/code/kaxdl2.F b/src/packlib/kapack/code/kaxdl2.F
deleted file mode 100644
index 09851f1..0000000
--- a/src/packlib/kapack/code/kaxdl2.F
+++ /dev/null
@@ -1,58 +0,0 @@
-*
-* $Id: kaxdl2.F,v 1.1.1.1 1996/03/08 11:40:52 mclareni Exp $
-*
-* $Log: kaxdl2.F,v $
-* Revision 1.1.1.1 1996/03/08 11:40:52 mclareni
-* Kapack
-*
-*
-#include "kapack/pilot.h"
- SUBROUTINE KAXDL2
-*
-*.....DELETE AN UNBLOCKED OR SEGMENTED RECORD
-*
-#include "kapack/kax000.inc"
-#include "kapack/kax020.inc"
-#include "kapack/kax050.inc"
-#include "kapack/kax0a0.inc"
-*
-*-----------------------------------------------------------------------
-*
-*.....CHECK THE TYPE OF THE FIRST BLOCK
- IF ( IA(8).NE.0 .AND. IA(8).NE.1 ) GO TO 91
- NLEFT = IA(2)
-*
-*.....STORE INDEX DELETION DATA
- CALL KAXGXD(IA)
-*
-*.....LOOP TO FREE ALL BLOCKS IN THE CHAIN
- 1 CALL KAXFBK(IA(1))
- IF ( IA(8).EQ.1 .OR. IA(8).EQ.3 ) THEN
- CALL KAXRD(IA(3),IA,NBCW)
- IF ( IA(8).NE.2 .AND. IA(8).NE.3 ) GO TO 91
- GO TO 1
- ENDIF
- NRIGHT = IA(3)
-*
-*.....LINK THE REMAINING BLOCKS TOGETHER
- IF ( NLEFT .NE. 0 ) THEN
- CALL KAXRD(NLEFT,IA,LBLK)
- IA(3) = NRIGHT
- CALL KAXWRT(IA(1),IA,IA(7)-1)
- ENDIF
- CALL KAXRD(NRIGHT,IA,LBLK)
- IA(2) = NLEFT
- CALL KAXWRT(IA(1),IA,IA(7)-1)
-*
-*.....SUCCESSFUL COMPLETION
- RETURN
-*
-*.....ERROR PROCESSING
- 91 WRITE(MSG,191) IA(8), IA(1), LUNKAF
- CALL KAXMSG(LUNERR,MSG)
- CALL KAXEND
-*
- 191 FORMAT('CRNKA171 KAXDL2: INVALID BLOCK TYPE ''',I11,
- + ''' FOUND IN BLOCK ',I11,' ON UNIT ',I3)
-*
- END
diff --git a/src/packlib/kapack/code/kaxdlv.F b/src/packlib/kapack/code/kaxdlv.F
deleted file mode 100644
index 0bfaad7..0000000
--- a/src/packlib/kapack/code/kaxdlv.F
+++ /dev/null
@@ -1,36 +0,0 @@
-*
-* $Id: kaxdlv.F,v 1.1.1.1 1996/03/08 11:40:52 mclareni Exp $
-*
-* $Log: kaxdlv.F,v $
-* Revision 1.1.1.1 1996/03/08 11:40:52 mclareni
-* Kapack
-*
-*
-#include "kapack/pilot.h"
- SUBROUTINE KAXDLV
-*
-*.....DELETE A TREE LEVEL, (THE ROOT BLOCK CONTAINS ONLY ONE ENTRY)
-*
-#include "kapack/kax000.inc"
-#include "kapack/kax020.inc"
-#include "kapack/kax0a0.inc"
-#include "kapack/kax0b0.inc"
-*
-*-----------------------------------------------------------------------
-*
-*.....READ THE BLOCK POINTED TO BY THE ROOT BLOCK ENTRY
- LOC = IA(6)
- IPTR = LOC + NRCW + IA(LOC+NRCW)
- NBLOCK = IA(IPTR)
- CALL KAXRD(NBLOCK,IB,LBLK)
-*
-*.....COPY ITS CONTENTS INTO THE ROOT BLOCK
- CALL UCOPY( IB(IB(6)), IA(IA(6)), IB(7)-IB(6) )
- IA(7) = IA(6) + ( IB(7) - IB(6) )
-*
-*.....DELETE THE REDUNDANT LEVEL
- IA(5) = IA(5) - 1
- CALL KAXWRT(IA(1),IA,IA(7)-1)
- CALL KAXFBK(IB(1))
-*
- END
diff --git a/src/packlib/kapack/code/kaxe2i.F b/src/packlib/kapack/code/kaxe2i.F
deleted file mode 100644
index 7e973d5..0000000
--- a/src/packlib/kapack/code/kaxe2i.F
+++ /dev/null
@@ -1,67 +0,0 @@
-*
-* $Id: kaxe2i.F,v 1.1.1.1 1996/03/08 11:40:52 mclareni Exp $
-*
-* $Log: kaxe2i.F,v $
-* Revision 1.1.1.1 1996/03/08 11:40:52 mclareni
-* Kapack
-*
-*
-#include "kapack/pilot.h"
- SUBROUTINE KAXE2I(STRING,INT,*)
-*
-*.....CONVERT A CHARACTER STRING FROM EXTERNAL TO INTERNAL FORMAT
-*
-#include "kapack/kax000.inc"
-#include "kapack/kax020.inc"
-#include "kapack/kax040.inc"
-*
- CHARACTER STRING*(*)
-*
- INTEGER INT(*)
-*
- LOGICAL NUMBER
-*
-*-----------------------------------------------------------------------
-*
-*.....CALCULATE THE NUMBER OF WORDS IN THE INTERNAL REPRESENTATION
- NCHARS = LEN(STRING)
- INT(1) = (NCHARS-1)/MAXPAK + 2
-*
-*.....ASSUME THE STRING IS ALPHANUMERIC
- NUMBER = .FALSE.
- IE = 0
- IW = 1
-*
-*.....DETERMINE WHETHER THE STRING IS NUMERIC OR ALPHANUMERIC
- DO 1 I = 1, NCHARS
- IF ( INDEX('0123456789',STRING(I:I)) .LE. 0 ) GO TO 2
- 1 CONTINUE
-*
-*.....THE STRING IS NUMERIC
- NUMBER = .TRUE.
- IE = MOD(NCHARS,MAXPAK)
- IF ( IE .NE. 0 ) IW = IW + 1
- INT(2) = 0
-*
-*.....CONVERT THE STRING
- 2 DO 3 I = 1, NCHARS
- IF ( IE .EQ. 0 ) THEN
- IE = MAXPAK
- IW = IW + 1
- INT(IW) = 0
- ENDIF
- IE = IE - 1
- DO 4 IC = 1, MAXC
- IF ( STRING(I:I) .EQ. CSET(IC) ) THEN
- INT(IW) = INT(IW) + IC * 100**IE
- GO TO 3
- ENDIF
- 4 CONTINUE
- RETURN 1
- 3 CONTINUE
-*
- IF ( NUMBER ) INT(2) = -INT(2)
-*
- RETURN
-*
- END
diff --git a/src/packlib/kapack/code/kaxed.F b/src/packlib/kapack/code/kaxed.F
deleted file mode 100644
index bd63b34..0000000
--- a/src/packlib/kapack/code/kaxed.F
+++ /dev/null
@@ -1,92 +0,0 @@
-*
-* $Id: kaxed.F,v 1.1.1.1 1996/03/08 11:40:52 mclareni Exp $
-*
-* $Log: kaxed.F,v $
-* Revision 1.1.1.1 1996/03/08 11:40:52 mclareni
-* Kapack
-*
-*
-#include "kapack/pilot.h"
- SUBROUTINE KAXED(LUN,TEXT)
-*
-*.....EDIT AND PRINT MESSAGES
-*
-#include "kapack/kax000.inc"
-*
- CHARACTER BUFFER*(LLINE), DATE*8, TEXT*(*), TIME*8
-#if defined(CERNLIB_NORD)||defined(CERNLIB_VAX)
-*
-*.....SPACE FOR COMMON SLATE IS NEEDED BY THE ASSEMBLER ROUTINE UHTOC
- COMMON /SLATE/ DUMMY(40)
- DIMENSION DATEN(2), TIMEN(2)
-#endif
-*
- LOGICAL SPLIT
-*
-*-----------------------------------------------------------------------
-*
- IF ( LUN .EQ. 0 ) RETURN
-*
-*.....PUT ID, DATE AND TIME INTO BUFFER AND CALCULATE THE INDENTATION
- BUFFER = ' '
- IF ( TEXT(1:3) .EQ. 'CRN' ) THEN
- BUFFER(1:8) = TEXT(1:8)
- ITEXT = 10
- INDENT = INDEX(TEXT,':') + 20
- ELSE
- BUFFER(1:8) = 'CRNKA000'
- ITEXT = 1
- INDENT = 28
- ENDIF
-#if (!defined(CERNLIB_NORD))&&(!defined(CERNLIB_VAX))
- CALL DATIMH(DATE,TIME)
-#endif
-#if defined(CERNLIB_NORD)||defined(CERNLIB_VAX)
- CALL DATIMH(DATEN,TIMEN)
- CALL UHTOC(DATEN,4,DATE,8)
- CALL UHTOC(TIMEN,4,TIME,8)
-#endif
- BUFFER(10:17) = DATE
- BUFFER(19:26) = TIME
-*
-*.....SCAN THE MESSAGE FOR WORDS AND TRANSFER THEM TO THE BUFFER
- IBUF = 28
- MAXWRD = LLINE - INDENT + 1
- SPLIT = .FALSE.
-*
-*.....FIND THE LOCATION AND LENGTH OF A WORD
- 1 CALL KAXWRD(TEXT(ITEXT:),LOCWRD,LENWRD,*2)
- ITEXT = ITEXT + LOCWRD - 1
-*
-*.....IF THE WORD IS TOO LONG IT MUST BE SPLIT AND A HYPHEN INSERTED
- IF ( LENWRD .GT. MAXWRD ) THEN
- LENWRD = LLINE - IBUF
- IF ( LENWRD .LT. 2 ) LENWRD = MAXWRD - 1
- SPLIT = .TRUE.
- ENDIF
-*
-*.....FLUSH THE BUFFER IF THERE IS NOT ENOUGH SPACE FOR THE WORD
- IF ( LENWRD .GT. LLINE-IBUF+1 ) THEN
- WRITE(LUN,100) BUFFER
- BUFFER = ' '
- IBUF = INDENT
- ENDIF
-*
-*.....INSERT THE WORD IN THE BUFFER AND ADD A HYPHEN IF NECESSARY
- BUFFER(IBUF:IBUF+LENWRD-1) = TEXT(ITEXT:ITEXT+LENWRD-1)
- IF ( SPLIT ) THEN
- BUFFER(LLINE:) = '-'
- SPLIT = .FALSE.
- ENDIF
-*
-*.....INCREMENT THE MESSAGE AND BUFFER POINTERS
- IBUF = IBUF + LENWRD + 1
- ITEXT = ITEXT + LENWRD
- GO TO 1
-*
-*.....FLUSH OUT ANYTHING REMAINING IN THE BUFFER
- 2 IF ( BUFFER .NE. ' ' ) WRITE(LUN,100) BUFFER
-*
- 100 FORMAT(' ',A)
-*
- END
diff --git a/src/packlib/kapack/code/kaxend.F b/src/packlib/kapack/code/kaxend.F
deleted file mode 100644
index 3be2905..0000000
--- a/src/packlib/kapack/code/kaxend.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: kaxend.F,v 1.1.1.1 1996/03/08 11:40:52 mclareni Exp $
-*
-* $Log: kaxend.F,v $
-* Revision 1.1.1.1 1996/03/08 11:40:52 mclareni
-* Kapack
-*
-*
-#include "kapack/pilot.h"
- SUBROUTINE KAXEND
-*
-*.....ABANDON PROCESSING
-*
-#include "kapack/kax000.inc"
-#include "kapack/kax020.inc"
-*
-*-----------------------------------------------------------------------
-*
- CALL KAXMSG(LUNERR,'CRNKA999 KAXEND: PROCESSING TERMINATED OWING
- + TO THE ABOVE CONDITION')
-*
- CALL KASTOP
-*
- STOP 999
-*
- END
diff --git a/src/packlib/kapack/code/kaxfbk.F b/src/packlib/kapack/code/kaxfbk.F
deleted file mode 100644
index 9195641..0000000
--- a/src/packlib/kapack/code/kaxfbk.F
+++ /dev/null
@@ -1,78 +0,0 @@
-*
-* $Id: kaxfbk.F,v 1.1.1.1 1996/03/08 11:40:52 mclareni Exp $
-*
-* $Log: kaxfbk.F,v $
-* Revision 1.1.1.1 1996/03/08 11:40:52 mclareni
-* Kapack
-*
-*
-#include "kapack/pilot.h"
- SUBROUTINE KAXFBK(IBLOCK)
-*
-*.....INSERT A BLOCK IN THE FREE BLOCK CHAIN
-*
-#include "kapack/kax000.inc"
-#include "kapack/kax020.inc"
-#include "kapack/kax030.inc"
-#include "kapack/kax050.inc"
-#include "kapack/kax0a0.inc"
-#include "kapack/kax0b0.inc"
-*
- INTEGER IFREE(1:4)
-*
-*-----------------------------------------------------------------------
-*
-*.....CHECK THE NUMBER OF THE BLOCK TO BE FREED
- IF ( IBLOCK.LT.2 .OR. IBLOCK.GT.NBLKS ) GO TO 91
-*
- IFREE(1) = IBLOCK
- IFREE(2) = 0
- IFREE(4) = 0
-*.....GET A LOCK ON BLOCK 1
- CALL KAXOLK(1)
-*
-*.....ADD IT TO THE FREE BLOCK CHAIN
- CALL KAXRD(1,IB,LBLK)
- IFREE(3) = IB(3)
- CALL KAXWRT(IFREE(1),IFREE,4)
- IB(2) = IB(2) + 1
- IB(3) = IFREE(1)
- CALL KAXWRT(1,IB,IB(7)-1)
- NFBK(LUNKAF) = IB(2)
- NFREE = IB(2)
-*
-*.....UPDATE BLOCK 1 IN STORAGE IF IT EXISTS THERE
- IF ( IA(1) .EQ. 1 ) THEN
- IA(2) = IB(2)
- IA(3) = IB(3)
- ENDIF
-*
-*.....CALCULATE THE NUMBER AND PERCENTAGE OF FREE BLOCKS
- PCFREE = REAL(IB(2)) / REAL(IB(14)) * 100.0
- IF ( PCFREE .LT. 10.0 ) THEN
- WRITE(MSG,101) LUNKAF, IB(2), PCFREE
- CALL KAXMSG(LUNLOG,MSG)
- ELSE IF ( PCFREE .LT. 20.0 ) THEN
- WRITE(MSG,102) LUNKAF, IB(2), PCFREE
- CALL KAXMSG(LUNLOG,MSG)
- ENDIF
-*
-*.....SUCCESSFUL COMPLETION - RELEASE THE LOCK AND RETURN
- CALL KAXRLK(1)
- RETURN
-*
-*.....ERROR PROCESSING
- 91 WRITE(MSG,191) IBLOCK, LUNKAF
- CALL KAXMSG(LUNERR,MSG)
- CALL KAXEND
-*
- 101 FORMAT('CRNKA181 KAXFBK: **** SERIOUS WARNING ****, THE KA-FILE
- + ON UNIT ',I3,' CONTAINS ONLY ',I11,' (',F5.1,'%) ',
- + ' FREE BLOCKS')
- 102 FORMAT('CRNKA182 KAXFBK: *** WARNING ***, THE KA-FILE
- + ON UNIT ',I3,' CONTAINS ONLY ',I11,' (',F5.1,'%) ',
- + ' FREE BLOCKS')
- 191 FORMAT('CRNKA183 KAXFBK: KAPACK SYSTEM ERROR, ATTEMPT TO FREE
- + BLOCK ',I11,' ON UNIT ',I3)
-*
- END
diff --git a/src/packlib/kapack/code/kaxgbk.F b/src/packlib/kapack/code/kaxgbk.F
deleted file mode 100644
index 0424af2..0000000
--- a/src/packlib/kapack/code/kaxgbk.F
+++ /dev/null
@@ -1,82 +0,0 @@
-*
-* $Id: kaxgbk.F,v 1.1.1.1 1996/03/08 11:40:52 mclareni Exp $
-*
-* $Log: kaxgbk.F,v $
-* Revision 1.1.1.1 1996/03/08 11:40:52 mclareni
-* Kapack
-*
-*
-#include "kapack/pilot.h"
- SUBROUTINE KAXGBK(IBLOCK)
-*
-*.....GET A BLOCK FROM THE FREE BLOCK CHAIN
-*
-#include "kapack/kax000.inc"
-#include "kapack/kax020.inc"
-#include "kapack/kax030.inc"
-#include "kapack/kax050.inc"
-#include "kapack/kax0a0.inc"
-#include "kapack/kax0b0.inc"
-*
- INTEGER IFREE(1:4)
-*
-*-----------------------------------------------------------------------
-*
-*.....GET A LOCK ON BLOCK 1
- CALL KAXOLK(1)
-*
-*.....UNCHAIN THE FIRST FREE BLOCK IF ONE EXISTS
- CALL KAXRD(1,IB,LBLK)
- IF ( IB(2) .LE. 0 ) GO TO 91
- CALL KAXRD(IB(3),IFREE,4)
- IF ( IFREE(1).NE.IB(3) .OR. IFREE(2).NE.0 .OR.
- + IFREE(3).LT.0 .OR. IFREE(4).NE.0 ) GO TO 92
- IBLOCK = IFREE(1)
- IB(3) = IFREE(3)
- IB(2) = IB(2) - 1
- CALL KAXWRT(1,IB,IB(7)-1)
- NFBK(LUNKAF) = IB(2)
- NFREE = IB(2)
-*
-*.....UPDATE BLOCK 1 IN STORAGE IF IT EXISTS THERE
- IF ( IA(1) .EQ. 1 ) THEN
- IA(2) = IB(2)
- IA(3) = IB(3)
- ENDIF
-*
-*.....CALCULATE THE NUMBER AND PERCENTAGE OF FREE BLOCKS
- PCFREE = REAL(IB(2)) / REAL(IB(14)) * 100.0
- IF ( PCFREE .LT. 10.0 ) THEN
- WRITE(MSG,101) LUNKAF, IB(2), PCFREE
- CALL KAXMSG(LUNLOG,MSG)
- ELSE IF ( PCFREE .LT. 20.0 ) THEN
- WRITE(MSG,102) LUNKAF, IB(2), PCFREE
- CALL KAXMSG(LUNLOG,MSG)
- ENDIF
-*
-*.....SUCCESSFUL COMPLETION - RELEASE THE LOCK AND RETURN
- CALL KAXRLK(1)
- RETURN
-*
-*.....ERROR PROCESSING
- 91 WRITE(MSG,191) LUNKAF
- GO TO 99
-*
- 92 WRITE(MSG,192) LUNKAF, IB(3), IFREE
- GO TO 99
-*
- 99 CALL KAXMSG(LUNERR,MSG)
- CALL KAXEND
-*
- 101 FORMAT('CRNKA191 KAXGBK: **** SERIOUS WARNING ****, THE KA-FILE
- + ON UNIT ',I3,' CONTAINS ONLY ',I11,' (',F5.1,'%) ',
- + ' FREE BLOCKS')
- 102 FORMAT('CRNKA192 KAXGBK: *** WARNING ***, THE KA-FILE
- + ON UNIT ',I3,' CONTAINS ONLY ',I11,' (',F5.1,'%) ',
- + ' FREE BLOCKS')
- 191 FORMAT('CRNKA193 KAXGBK: NO FREE BLOCKS AVAILABLE ON UNIT ',I3)
- 192 FORMAT('CRNKA194 KAXGBK: KAPACK SYSTEM ERROR OR CORRUPT FILE, ',
- + ' INVALID FREE BLOCK ON UNIT ',I3,', BLOCK NUMBER = ',I11,
- + ', CONTENTS = ',4I11)
-*
- END
diff --git a/src/packlib/kapack/code/kaxget.F b/src/packlib/kapack/code/kaxget.F
deleted file mode 100644
index e5231b1..0000000
--- a/src/packlib/kapack/code/kaxget.F
+++ /dev/null
@@ -1,55 +0,0 @@
-*
-* $Id: kaxget.F,v 1.1.1.1 1996/03/08 11:40:52 mclareni Exp $
-*
-* $Log: kaxget.F,v $
-* Revision 1.1.1.1 1996/03/08 11:40:52 mclareni
-* Kapack
-*
-*
-#include "kapack/pilot.h"
- SUBROUTINE KAXGET(IROOT,KEY,LEVEL,LOC,*)
-*
-*.....GET THE ACTUAL OR POTENTIAL LOCATION OF A KEY IN A TREE
-*
-#include "kapack/kax000.inc"
-#include "kapack/kax020.inc"
-#include "kapack/kax050.inc"
-#include "kapack/kax0a0.inc"
-*
- INTEGER KEY(*)
-*
-*-----------------------------------------------------------------------
-*
-*.....READ THE INITIAL BLOCK
- CALL KAXRD(IROOT,IA,LBLK)
-*
-*.....SEARCH THE BLOCK
- 1 LOC = IA(6)
-*
- 2 IF ( LOC .GE. IA(7) ) GO TO 91
- ICMP = KAXCMP(KEY,IA(LOC+NRCW))
- IF ( ICMP .GT. 0 ) THEN
- LOC = LOC + IA(LOC)
- GO TO 2
- ENDIF
-*
-*.....MATCH FOUND, CHECK WHETHER IT IS AT THE REQUIRED LEVEL
- IF ( IA(5) .NE. LEVEL ) THEN
- IPTR = LOC + NRCW + IA(LOC+NRCW)
- CALL KAXRD(IA(IPTR),IA,LBLK)
- GO TO 1
- ENDIF
-*
-*.....MATCH FOUND AT THE REQUIRED LEVEL
- IF ( ICMP .EQ. 0 ) RETURN
- RETURN 1
-*
-*.....ERROR PROCESSING
- 91 WRITE(MSG,191) IA(1), LUNKAF
- CALL KAXMSG(LUNERR,MSG)
- CALL KAXEND
-*
- 191 FORMAT('CRNKA231 KAXGET: KAPACK SYSTEM ERROR OR CORRUPT FILE, KEY
- + SEARCH ERROR IN BLOCK ',I11,' ON UNIT ',I3)
-*
- END
diff --git a/src/packlib/kapack/code/kaxglv.F b/src/packlib/kapack/code/kaxglv.F
deleted file mode 100644
index 7bb128e..0000000
--- a/src/packlib/kapack/code/kaxglv.F
+++ /dev/null
@@ -1,53 +0,0 @@
-*
-* $Id: kaxglv.F,v 1.1.1.1 1996/03/08 11:40:52 mclareni Exp $
-*
-* $Log: kaxglv.F,v $
-* Revision 1.1.1.1 1996/03/08 11:40:52 mclareni
-* Kapack
-*
-*
-#include "kapack/pilot.h"
- SUBROUTINE KAXGLV(LOC)
-*
-*.....GENERATE A NEW TREE LEVEL, (TO AVOID SPLITTING A ROOT BLOCK)
-*
-#include "kapack/kax000.inc"
-#include "kapack/kax020.inc"
-#include "kapack/kax0a0.inc"
-#include "kapack/kax0b0.inc"
-*
-*-----------------------------------------------------------------------
-*
-*.....GET A NEW BLOCK
- CALL KAXGBK(NBLOCK)
-*
-*.....RE-FORMAT THE BLOCK CONTROL WORDS OF THE ROOT BLOCK
- CALL UCOPY(IA,IB,IA(6)-1)
- IB(5) = IB(5) + 1
- IB(7) = IB(6) + 4
-*
-*.....CONSTRUCT AN INDEX ENTRY POINTING TO THE NEW BLOCK
- I = IB(6)
- IB(I+0) = 4
- IB(I+1) = 2
- IB(I+2) = MAXKEY
- IB(I+3) = NBLOCK
-*
-*.....UPDATE THE CURRENT BLOCK
- IA(1) = NBLOCK
-*
-*.....CONTRACT THE BLOCK CONTROL WORDS IF BLOCK 1 IS BEING REPLACED
- IF ( IB(1) .EQ. 1 ) THEN
- CALL UCOPY( IA(NBCW1+1), IA(NBCW+1), IA(7)-IA(6) )
- IA(6) = IA(6) - (NBCW1-NBCW)
- IA(7) = IA(7) - (NBCW1-NBCW)
- LOC = LOC - (NBCW1-NBCW)
- IA(2) = 0
- IA(3) = 0
- ENDIF
-*
-*.....WRITE THE BLOCKS
- CALL KAXWRT(IA(1),IA,IA(7)-1)
- CALL KAXWRT(IB(1),IB,IB(7)-1)
-*
- END
diff --git a/src/packlib/kapack/code/kaxgxa.F b/src/packlib/kapack/code/kaxgxa.F
deleted file mode 100644
index dfda5f1..0000000
--- a/src/packlib/kapack/code/kaxgxa.F
+++ /dev/null
@@ -1,49 +0,0 @@
-*
-* $Id: kaxgxa.F,v 1.1.1.1 1996/03/08 11:40:52 mclareni Exp $
-*
-* $Log: kaxgxa.F,v $
-* Revision 1.1.1.1 1996/03/08 11:40:52 mclareni
-* Kapack
-*
-*
-#include "kapack/pilot.h"
- SUBROUTINE KAXGXA(IZ)
-*
-*.....GENERATE AN ENTRY IN THE INDEX ADDITION QUEUE
-*
-#include "kapack/kax000.inc"
-#include "kapack/kax020.inc"
-#include "kapack/kax050.inc"
-#include "kapack/kax080.inc"
-*
- INTEGER IZ(*)
-*
-*-----------------------------------------------------------------------
-*
-*.....SEARCH FOR THE LAST RECORD, (I.E. THE HIGHEST KEY), IN THE BLOCK
- I = IZ(6)
- 1 IF ( I .LT. IZ(7) ) THEN
- LOC = I
- I = LOC + IZ(LOC)
- GO TO 1
- ENDIF
-*
-*.....QUEUE THE ENTRY
- IXAL = MOD(IXAL+1,LXAQ+1)
- IF ( IXAL .EQ. IXAF ) GO TO 91
- CALL UCOPY( IZ(LOC+NRCW), IXAKEY(1,IXAL), IZ(LOC+NRCW) )
- IXALEV(IXAL) = IZ(5) + 1
- IXAPTR(IXAL) = IZ(1)
-*
-*.....SUCCESSFUL COMPLETION
- RETURN
-*
-*.....ERROR PROCESSING
- 91 WRITE(MSG,191)
- CALL KAXMSG(LUNERR,MSG)
- CALL KAXEND
-*
- 191 FORMAT('CRNKA201 KAXGXA: KAPACK SYSTEM ERROR, INDEX ADDITION
- + QUEUE FULL')
-*
- END
diff --git a/src/packlib/kapack/code/kaxgxd.F b/src/packlib/kapack/code/kaxgxd.F
deleted file mode 100644
index 1df07a9..0000000
--- a/src/packlib/kapack/code/kaxgxd.F
+++ /dev/null
@@ -1,48 +0,0 @@
-*
-* $Id: kaxgxd.F,v 1.1.1.1 1996/03/08 11:40:52 mclareni Exp $
-*
-* $Log: kaxgxd.F,v $
-* Revision 1.1.1.1 1996/03/08 11:40:52 mclareni
-* Kapack
-*
-*
-#include "kapack/pilot.h"
- SUBROUTINE KAXGXD(IZ)
-*
-*.....GENERATE AN ENTRY IN THE INDEX DELETION QUEUE
-*
-#include "kapack/kax000.inc"
-#include "kapack/kax020.inc"
-#include "kapack/kax050.inc"
-#include "kapack/kax090.inc"
-*
- INTEGER IZ(*)
-*
-*-----------------------------------------------------------------------
-*
-*.....SEARCH FOR THE LAST RECORD, (I.E. THE HIGHEST KEY), IN THE BLOCK
- I = IZ(6)
- 1 IF ( I .LT. IZ(7) ) THEN
- LOC = I
- I = LOC + IZ(LOC)
- GO TO 1
- ENDIF
-*
-*.....QUEUE THE ENTRY
- IXDL = MOD(IXDL+1,LXDQ+1)
- IF ( IXDL .EQ. IXDF ) GO TO 91
- CALL UCOPY( IZ(LOC+NRCW), IXDKEY(1,IXDL), IZ(LOC+NRCW) )
- IXDLEV(IXDL) = IZ(5) + 1
-*
-*.....SUCCESSFUL COMPLETION
- RETURN
-*
-*.....ERROR PROCESSING
- 91 WRITE(MSG,191)
- CALL KAXMSG(LUNERR,MSG)
- CALL KAXEND
-*
- 191 FORMAT('CRNKA211 KAXGXD: KAPACK SYSTEM ERROR, INDEX DELETION
- + QUEUE FULL')
-*
- END
diff --git a/src/packlib/kapack/code/kaxi2e.F b/src/packlib/kapack/code/kaxi2e.F
deleted file mode 100644
index 400c75b..0000000
--- a/src/packlib/kapack/code/kaxi2e.F
+++ /dev/null
@@ -1,63 +0,0 @@
-*
-* $Id: kaxi2e.F,v 1.1.1.1 1996/03/08 11:40:53 mclareni Exp $
-*
-* $Log: kaxi2e.F,v $
-* Revision 1.1.1.1 1996/03/08 11:40:53 mclareni
-* Kapack
-*
-*
-#include "kapack/pilot.h"
- SUBROUTINE KAXI2E(INT,STRING,*)
-*
-*.....CONVERT A CHARACTER STRING FROM INTERNAL TO EXTERNAL FORMAT
-*
-#include "kapack/kax000.inc"
-#include "kapack/kax020.inc"
-#include "kapack/kax040.inc"
-#include "kapack/kax050.inc"
-*
- CHARACTER STRING*(*)
-*
- INTEGER INT(*)
-*
-*-----------------------------------------------------------------------
-*
-*.....CALCULATE THE NUMBER OF NON-NULL CHARACTERS IN THE STRING
- NCHARS = (INT(1)-1)*MAXPAK
- NUMBER = INT(INT(1))
- IF ( INT(2) .LT. 0 ) NUMBER = ABS(INT(2))
-*
- DO 1 I = 1, MAXPAK
- IF ( MOD(NUMBER,100) .EQ. 0 ) NCHARS = NCHARS - 1
- NUMBER = NUMBER/100
- 1 CONTINUE
-*
-*.....CHECK THAT THE NUMBER OF CHARACTERS IS NOT TOO LARGE
- IF ( NCHARS .GT. LEN(STRING) ) RETURN 1
-*
-*.....DO THE CONVERSION
- STRING = ' '
- DO 3 IW = INT(1), 2, -1
- NUMBER = ABS(INT(IW))
- DO 2 I = 1, MAXPAK
- IC = MOD(NUMBER,100)
- IF ( IC .NE. 0 ) THEN
- IF ( IC.LT.1 .OR. IC.GT.MAXC ) GO TO 91
- STRING(NCHARS:NCHARS) = CSET(IC)
- NCHARS = NCHARS - 1
- ENDIF
- NUMBER = NUMBER/100
- 2 CONTINUE
- 3 CONTINUE
-*
- RETURN
-*
-*.....ERROR PROCESSING
- 91 WRITE(MSG,191) IC
- CALL KAXMSG(LUNERR,MSG)
- CALL KAXEND
-*
- 191 FORMAT('CRNKA151 KAXI2E: KAPACK SYSTEM ERROR OR CORRUPT FILE ON
- & UNIT ',I3,', INVALID CODE ',I11,' IN NAME')
-*
- END
diff --git a/src/packlib/kapack/code/kaxini.F b/src/packlib/kapack/code/kaxini.F
deleted file mode 100644
index e94d998..0000000
--- a/src/packlib/kapack/code/kaxini.F
+++ /dev/null
@@ -1,83 +0,0 @@
-*
-* $Id: kaxini.F,v 1.1.1.1 1996/03/08 11:40:52 mclareni Exp $
-*
-* $Log: kaxini.F,v $
-* Revision 1.1.1.1 1996/03/08 11:40:52 mclareni
-* Kapack
-*
-*
-#include "kapack/pilot.h"
- SUBROUTINE KAXINI(LUN)
-*
-*.....PERFORM CALL-DEPENDENT INITIALIZATION
-*
-#include "kapack/kax000.inc"
-#include "kapack/kax020.inc"
-#include "kapack/kax030.inc"
-#include "kapack/kax050.inc"
-#include "kapack/kax060.inc"
-#include "kapack/kax0a0.inc"
-*
- LOGICAL DOFILE, NEWRUN
-*
- DATA NEWRUN/.TRUE./
-*
-*-----------------------------------------------------------------------
-*
- DOFILE = .TRUE.
-*
-*.....PERFORM RUN-DEPENDENT INITIALIZATION ON THE FIRST CALL
- 1 IF ( NEWRUN ) THEN
- CALL KAXINR
- LUNKAF = 0
- NEWRUN = .FALSE.
- ENDIF
-*
-*.....CHECK LUN AND SEE WHETHER IT IS THE SAME AS IN THE PREVIOUS CALL
- IF ( LUN.LT.1 .OR. LUN.GT.MAXLUN ) GO TO 91
- NEWLUN = LUN .NE. LUNKAF
-*
-*.....SET THE VALUE OF THE KAFILE UNIT NUMBER FOR THIS CALL TO KAPACK
- LUNKAF = LUN
-*
-*.....INITIALIZE CALL-DEPENDENT PARAMETERS IF LUN HAS CHANGED
- IF ( NEWLUN ) THEN
- LUNERR = MOD(IOPTNS(LUNKAF)/10000,100)
- LUNLOG = MOD(IOPTNS(LUNKAF)/100,100)
- MODIFY = MOD(IOPTNS(LUNKAF)/10,10) .EQ. 1
- RETURN = MOD(IOPTNS(LUNKAF),10) .EQ. 1
- LBLK = LBKS(LUNKAF)
- NBLKS = NBKS(LUNKAF)
- NFREE = NFBK(LUNKAF)
- MAXKEY = MAXK(LUNKAF)
- MAXPAK = MAXP(LUNKAF)
- ENDIF
-*
-*.....PERFORM FILE INITIALIZATION IF NECESSARY
- IF ( DOFILE .AND. LBKS(LUNKAF).LE.0 ) THEN
- CALL KAXOPN
- LBLK = LBKS(LUNKAF)
- NBLKS = NBKS(LUNKAF)
- NFREE = NFBK(LUNKAF)
- MAXKEY = MAXK(LUNKAF)
- MAXPAK = MAXP(LUNKAF)
- ENDIF
-*
-*.....SUCCESSFUL COMPLETION
- RETURN
-*
-*.....ENTRY POINT FOR INITIALIZATION WITHOUT FILE
- ENTRY KAXINN(LUN)
- DOFILE = .FALSE.
- GO TO 1
-*
-*.....ERROR PROCESSING
- 91 WRITE(MSG,191) LUN, MAXLUN
- LUNERR = ISYSWR
- CALL KAXMSG(LUNERR,MSG)
- CALL KAXEND
-*
- 191 FORMAT('CRNKA221 KAXINI: ',I11,' IS NOT AN ACCEPTABLE UNIT NUMBER,
- + IT MUST BE IN THE RANGE 1 - ',I3)
-*
- END
diff --git a/src/packlib/kapack/code/kaxinr.F b/src/packlib/kapack/code/kaxinr.F
deleted file mode 100644
index 1c8dcc8..0000000
--- a/src/packlib/kapack/code/kaxinr.F
+++ /dev/null
@@ -1,119 +0,0 @@
-*
-* $Id: kaxinr.F,v 1.1.1.1 1996/03/08 11:40:52 mclareni Exp $
-*
-* $Log: kaxinr.F,v $
-* Revision 1.1.1.1 1996/03/08 11:40:52 mclareni
-* Kapack
-*
-*
-#include "kapack/pilot.h"
- SUBROUTINE KAXINR
-*
-*.....PERFORM RUN-DEPENDENT INITIALIZATION
-*
-#include "kapack/kax000.inc"
-#include "kapack/kax010.inc"
-#include "kapack/kax020.inc"
-#include "kapack/kax030.inc"
-#include "kapack/kax040.inc"
-#include "kapack/kax060.inc"
-#include "kapack/kax070.inc"
-*
- CHARACTER C(1:MAXC)*1
-*
-*.....DEFINE THE INTERNAL CHARACTER SET
- DATA
- + C(01) /' '/,
- + C(02) /'0'/, C(03) /'1'/, C(04) /'2'/, C(05) /'3'/,
- + C(06) /'4'/, C(07) /'5'/, C(08) /'6'/, C(09) /'7'/,
- + C(10) /'8'/, C(11) /'9'/, C(12) /'A'/, C(13) /'B'/,
- + C(14) /'C'/, C(15) /'D'/, C(16) /'E'/, C(17) /'F'/,
- + C(18) /'G'/, C(19) /'H'/, C(20) /'I'/, C(21) /'J'/,
- + C(22) /'K'/, C(23) /'L'/, C(24) /'M'/, C(25) /'N'/,
- + C(26) /'O'/, C(27) /'P'/, C(28) /'Q'/, C(29) /'R'/,
- + C(30) /'S'/, C(31) /'T'/, C(32) /'U'/, C(33) /'V'/,
- + C(34) /'W'/, C(35) /'X'/, C(36) /'Y'/, C(37) /'Z'/,
- + C(38) /'$'/, C(39) /''''/, C(40) /'('/, C(41) /')'/,
- + C(42) /'*'/, C(43) /'+'/, C(44) /','/, C(45) /'-'/,
- + C(46) /'.'/, C(47) /'/'/, C(48) /':'/, C(49) /'='/
-*
-*-----------------------------------------------------------------------
-*
-*.....CHECK THE VALIDITY OF THE INSTALLATION-DEPENDENT PARAMETERS
- IF ( ISYSWR .LT. 0 .OR. ISYSWR .GT. 99 ) GO TO 90
- IF ( IWAIT .LT. 0 .OR. IWAIT .GT. 6000 ) GO TO 91
- IF ( LBUF .LT. 80 ) GO TO 92
- IF ( LLINE .LT. 70 .OR. LLINE .GT. 150 ) GO TO 93
- IF ( LWORD .LT. 1 .OR. LWORD .GT. 10 ) GO TO 94
- IF ( MAXINT .LT. 99 ) GO TO 95
- IF ( MAXLUN .LT. 1 .OR. MAXLUN .GT. 99 ) GO TO 96
- IF ( MAXNAM .LT. 1 ) GO TO 97
- IF ( MAXTRY .LT. 1 .OR. MAXTRY .GT. 10 ) GO TO 98
-*
-*.....GET THE JOBID FOR THIS RUN
- JOBID = KAXJID()
-*
-*.....INITIALIZE THE INTERNAL CHARACTER SET
- DO 1 I = 1, MAXC
- CSET(I) = C(I)
- 1 CONTINUE
-*
-*.....INITIALIZE FILE AND RUN-DEPENDENT PARAMETERS AND DEFAULT OPTIONS
- DO 2 I = 1, MAXLUN
- LBKS(I) = 0
- NBKS(I) = 0
- MAXK(I) = 0
- MAXP(I) = 0
- TITLED(I) = .FALSE.
- IOPTNS(I) = ISYSWR*10000 + ISYSWR*100
- 2 CONTINUE
-*
-*.....INITIALIZE THE LOCK QUEUE
- DO 3 I = 1, LLOCKQ
- LOCKI(I) = 0
- LOCKU(I) = 0
- LOCKN(I) = 0
- 3 CONTINUE
-*
-*.....INITIALIZE THE MAJOR STACK, (I.E. INVALIDATE ALL ENTRIES)
- DO 4 I = 1, LMQ
- KUNIT(I) = -1
- 4 CONTINUE
-*
-*.....SUCCESSFUL COMPLETION
- RETURN
-*
-*.....ERROR PROCESSING
- 90 WRITE(*,190) ISYSWR, 'ISYSWR'
- GO TO 999
-*
- 91 WRITE(ISYSWR,190) IWAIT, 'IWAIT'
- GO TO 999
-*
- 92 WRITE(ISYSWR,190) LBUF, 'LBUF'
- GO TO 999
-*
- 93 WRITE(ISYSWR,190) LLINE, 'LLINE'
- GO TO 999
-*
- 94 WRITE(ISYSWR,190) LWORD, 'LWORD'
- GO TO 999
-*
- 95 WRITE(ISYSWR,190) MAXINT, 'MAXINT'
- GO TO 999
-*
- 96 WRITE(ISYSWR,190) MAXLUN, 'MAXLUN'
- GO TO 999
-*
- 97 WRITE(ISYSWR,190) MAXNAM, 'MAXNAM'
- GO TO 999
-*
- 98 WRITE(ISYSWR,190) MAXTRY, 'MAXTRY'
- GO TO 999
-*
- 999 STOP 999
-*
- 190 FORMAT(' CRNKA300 KAXINR: KAPACK HAS BEEN INSTALLED WITH THE UNACC
- +EPTABLE VALUE OF ',I11,' FOR THE PARAMETER ''',A,'''')
-*
- END
diff --git a/src/packlib/kapack/code/kaxins.F b/src/packlib/kapack/code/kaxins.F
deleted file mode 100644
index 93a81d1..0000000
--- a/src/packlib/kapack/code/kaxins.F
+++ /dev/null
@@ -1,30 +0,0 @@
-*
-* $Id: kaxins.F,v 1.1.1.1 1996/03/08 11:40:52 mclareni Exp $
-*
-* $Log: kaxins.F,v $
-* Revision 1.1.1.1 1996/03/08 11:40:52 mclareni
-* Kapack
-*
-*
-#include "kapack/pilot.h"
- SUBROUTINE KAXINS(IZ,LOC,KEY,IDATA,LDATA)
-*
-*.....INSERT A RECORD IN A BLOCK
-*
-#include "kapack/kax000.inc"
-#include "kapack/kax020.inc"
-*
- INTEGER IDATA(*), IZ(*), KEY(*)
-*
-*-----------------------------------------------------------------------
-*
-*.....CREATE A GAP FOR THE NEW RECORD, (UNLESS IT GOES AT THE END)
- IF ( LOC .NE. IZ(7) ) CALL UCOPY2(IZ(LOC),IZ(LOC+LREC),IZ(7)-LOC)
- IZ(7) = IZ(7) + LREC
-*
-*.....INSERT THE NEW RECORD
- IZ(LOC) = LREC
- CALL UCOPY(KEY,IZ(LOC+NRCW),KEY(1))
- IF ( LDATA .NE. 0 ) CALL UCOPY(IDATA,IZ(LOC+NRCW+KEY(1)),LDATA)
-*
- END
diff --git a/src/packlib/kapack/code/kaxjid.F b/src/packlib/kapack/code/kaxjid.F
deleted file mode 100644
index 680bce6..0000000
--- a/src/packlib/kapack/code/kaxjid.F
+++ /dev/null
@@ -1,36 +0,0 @@
-*
-* $Id: kaxjid.F,v 1.1.1.1 1996/03/08 11:40:53 mclareni Exp $
-*
-* $Log: kaxjid.F,v $
-* Revision 1.1.1.1 1996/03/08 11:40:53 mclareni
-* Kapack
-*
-*
-#include "kapack/pilot.h"
- FUNCTION KAXJID()
-*
-*.....A FUNCTION TO RETURN A UNIQUE JOB IDENTIFIER
-*
- CHARACTER DATE*8, TIME*8
-#if defined(CERNLIB_NORD)||defined(CERNLIB_VAX)
-*
-*.....SPACE FOR COMMON SLATE IS NEEDED BY THE ASSEMBLER ROUTINE UHTOC
- COMMON /SLATE/ DUMMY(40)
- DIMENSION DATEN(2), TIMEN(2)
-#endif
-*
-*-----------------------------------------------------------------------
-*
-#if (!defined(CERNLIB_NORD))&&(!defined(CERNLIB_VAX))
- CALL DATIMH(DATE,TIME)
-#endif
-#if defined(CERNLIB_NORD)||defined(CERNLIB_VAX)
- CALL DATIMH(DATEN,TIMEN)
- CALL UHTOC(TIMEN,4,TIME,8)
-#endif
- READ(TIME,100) IHH, IMM, ISS
- KAXJID = IHH*10000 + IMM*100 + ISS
-*
- 100 FORMAT(I2,1X,I2,1X,I2)
-*
- END
diff --git a/src/packlib/kapack/code/kaxls1.F b/src/packlib/kapack/code/kaxls1.F
deleted file mode 100644
index 2b9727d..0000000
--- a/src/packlib/kapack/code/kaxls1.F
+++ /dev/null
@@ -1,40 +0,0 @@
-*
-* $Id: kaxls1.F,v 1.1.1.1 1996/03/08 11:40:53 mclareni Exp $
-*
-* $Log: kaxls1.F,v $
-* Revision 1.1.1.1 1996/03/08 11:40:53 mclareni
-* Kapack
-*
-*
-#include "kapack/pilot.h"
- SUBROUTINE KAXLS1(MAJOR)
-*
-*.....LIST THE MINOR NAMES FOR THE SPECIFIED MAJOR NAME
-*
-#include "kapack/kax000.inc"
-#include "kapack/kax020.inc"
-*
- CHARACTER MAJOR*(*), MINOR*(MAXNAM)
-*
-*-----------------------------------------------------------------------
-*
- NMINOR = 0
- MINOR = ' '
-*
- 1 CALL KASEQ1(LUNKAF,MAJOR,MINOR,NWORDS,IRC)
- IF ( IRC .EQ. 0 ) THEN
- NMINOR = NMINOR + 1
- NC = INDEX(MINOR,' ') - 1
- WRITE(LUNLOG,100) NMINOR, NWORDS, MINOR(1:NC)
- GO TO 1
- ELSE IF ( IRC .EQ. 3 ) THEN
- IF ( NMINOR .EQ. 0 ) WRITE(LUNLOG,101)
- ENDIF
-*
-*.....SUCCESSFUL COMPLETION
- RETURN
-*
- 100 FORMAT(' ',I5,'. LENGTH ',I5,', MINOR NAME: ',A)
- 101 FORMAT(' ',13X,'THERE ARE NO RECORDS FOR THIS MAJOR NAME')
-*
- END
diff --git a/src/packlib/kapack/code/kaxmaj.F b/src/packlib/kapack/code/kaxmaj.F
deleted file mode 100644
index 58c22db..0000000
--- a/src/packlib/kapack/code/kaxmaj.F
+++ /dev/null
@@ -1,83 +0,0 @@
-*
-* $Id: kaxmaj.F,v 1.1.1.1 1996/03/08 11:40:53 mclareni Exp $
-*
-* $Log: kaxmaj.F,v $
-* Revision 1.1.1.1 1996/03/08 11:40:53 mclareni
-* Kapack
-*
-*
-#include "kapack/pilot.h"
- SUBROUTINE KAXMAJ(MAJNAM,*,*)
-*
-*.....GET THE MAJOR ENTRY CORRESPONDING TO THE SPECIFIED MAJOR NAME:
-*
-* THE MOST RECENTLY USED MAJOR ENTRIES ARE KEPT IN A STACK.
-* ENTRIES 0 AND 1 ARE IDENTICAL AND ARE THE MOST RECENTLY USED.
-*
-* MODIFIED 1987/05/06 TO INCLUDE A CALL TO KAXNAM IN THE DO 1 LOOP
-* SINCE MAJKEY IS NOT STACKED AND IT MUST BE REFRESHED. FAILURE TO DO
-* SO CAN RESULT IN KADELM DELETING THE WRONG MAJOR NAME.
-* PAM VERSION 2.08 H.RENSHALL, DD, CERN.
-*
-#include "kapack/kax000.inc"
-#include "kapack/kax020.inc"
-#include "kapack/kax02c.inc"
-#include "kapack/kax0a0.inc"
-*
- CHARACTER MAJNAM*(*)
-*
-*-----------------------------------------------------------------------
-*
-*.....RETURN IMMEDIATELY IF THE REQUEST IS AT THE TOP OF THE STACK
- IF ( LUNKAF.EQ.KUNIT(0) .AND. MAJNAM.EQ.KMAJOR(0) ) RETURN
-*
-*.....INVALIDATE THE LAST USE INDICATOR
- IA(10)= 0
-*
-*.....IF THE REQUEST IS ELSEWHERE IN THE STACK MOVE IT TO THE TOP
- DO 1 I = 2, LMQ
- LPUSH = I
- IF ( KUNIT(I) .LT. 0 ) GO TO 2
- IF ( LUNKAF.EQ.KUNIT(I) .AND. MAJNAM.EQ.KMAJOR(I) ) THEN
- KMAJOR(0) = KMAJOR(I)
- KLDEF(0) = KLDEF(I)
- KLMAX(0) = KLMAX(I)
- KROOT(0) = KROOT(I)
- KUNIT(0) = KUNIT(I)
- CALL KAXNAM(MAJNAM,MAJKEY,*11)
- GO TO 3
- ENDIF
- 1 CONTINUE
-*
-*.....REQUEST NOT IN THE STACK SO CONVERT THE NAME TO AN INTERNAL KEY
- 2 CALL KAXNAM(MAJNAM,MAJKEY,*11)
-*
-*.....GET THE REQUESTED ENTRY FROM THE KA-FILE
- CALL KAXGET(1,MAJKEY,1,LOC,*12)
-*
-*.....STORE IT AT THE TOP OF THE STACK
- IPTR = LOC + NRCW + IA(LOC+NRCW)
- KMAJOR(0) = MAJNAM
- KLDEF(0) = IA(IPTR+1)
- KLMAX(0) = IA(IPTR+2)
- KROOT(0) = IA(IPTR)
- KUNIT(0) = LUNKAF
-*
-*.....PUSH DOWN THE STACK, (ALL ENTRIES BELOW LPUSH REMAIN UNCHANGED)
- 3 DO 4 I = LPUSH, 1, -1
- KMAJOR(I) = KMAJOR(I-1)
- KLDEF(I) = KLDEF(I-1)
- KLMAX(I) = KLMAX(I-1)
- KROOT(I) = KROOT(I-1)
- KUNIT(I) = KUNIT(I-1)
- 4 CONTINUE
-*
-*.....SUCCESSFUL COMPLETION
- RETURN
-*
-*.....ERROR PROCESSING
- 11 RETURN 1
-*
- 12 RETURN 2
-*
- END
diff --git a/src/packlib/kapack/code/kaxmsg.F b/src/packlib/kapack/code/kaxmsg.F
deleted file mode 100644
index ccfdf9a..0000000
--- a/src/packlib/kapack/code/kaxmsg.F
+++ /dev/null
@@ -1,36 +0,0 @@
-*
-* $Id: kaxmsg.F,v 1.1.1.1 1996/03/08 11:40:53 mclareni Exp $
-*
-* $Log: kaxmsg.F,v $
-* Revision 1.1.1.1 1996/03/08 11:40:53 mclareni
-* Kapack
-*
-*
-#include "kapack/pilot.h"
- SUBROUTINE KAXMSG(LUN,TEXT)
-*
-*.....PROCESS MESSAGES
-*
-#include "kapack/kax000.inc"
-#include "kapack/kax010.inc"
-#include "kapack/kax020.inc"
-*
- CHARACTER JIDMSG*60, TEXT*(*)
-*
-*-----------------------------------------------------------------------
-*
- IF ( LUN .EQ. 0 ) RETURN
-*
-*.....WRITE A TITLE IF NECESSARY
- IF ( .NOT. TITLED(LUN) ) THEN
- CALL KAT(LUN)
- WRITE(JIDMSG,100) JOBID
- CALL KAXED(LUN,JIDMSG)
- TITLED(LUN) = .TRUE.
- ENDIF
-*
- CALL KAXED(LUN,TEXT)
-*
- 100 FORMAT('CRNKA360 KAXMSG: THE KEY FOR THIS RUN IS ',I11)
-*
- END
diff --git a/src/packlib/kapack/code/kaxnam.F b/src/packlib/kapack/code/kaxnam.F
deleted file mode 100644
index f44992a..0000000
--- a/src/packlib/kapack/code/kaxnam.F
+++ /dev/null
@@ -1,38 +0,0 @@
-*
-* $Id: kaxnam.F,v 1.1.1.1 1996/03/08 11:40:53 mclareni Exp $
-*
-* $Log: kaxnam.F,v $
-* Revision 1.1.1.1 1996/03/08 11:40:53 mclareni
-* Kapack
-*
-*
-#include "kapack/pilot.h"
- SUBROUTINE KAXNAM(NAME,KEY,*)
-*
-*.....VALIDATE A NAME AND CONVERT IT TO INTERNAL REPRESENTATION
-*
-#include "kapack/kax000.inc"
-*
- CHARACTER NAME*(*)
-*
- INTEGER KEY(*)
-*
-*-----------------------------------------------------------------------
-*
-*.....CHECK THE NAME
- CALL KAXWRD(NAME,LOC1,NCHARS,*11)
- IF ( NCHARS .GT. MAXNAM ) GO TO 11
- LOC2 = LOC1 + NCHARS - 1
- CALL KAXWRD(NAME(LOC2+1:),JUNK1,JUNK2,*1)
- GO TO 11
-*
-*.....CONVERT IT
- 1 CALL KAXE2I(NAME(LOC1:LOC2),KEY,*11)
-*
-*.....SUCCESSFUL COMPLETION
- RETURN
-*
-*.....ERROR PROCESSING
- 11 RETURN 1
-*
- END
diff --git a/src/packlib/kapack/code/kaxolk.F b/src/packlib/kapack/code/kaxolk.F
deleted file mode 100644
index e9cc17c..0000000
--- a/src/packlib/kapack/code/kaxolk.F
+++ /dev/null
@@ -1,80 +0,0 @@
-*
-* $Id: kaxolk.F,v 1.1.1.1 1996/03/08 11:40:53 mclareni Exp $
-*
-* $Log: kaxolk.F,v $
-* Revision 1.1.1.1 1996/03/08 11:40:53 mclareni
-* Kapack
-*
-*
-#include "kapack/pilot.h"
- SUBROUTINE KAXOLK(IROOT)
-*
-*.....OBTAIN A LOCK FOR THE TREE WITH ROOT NUMBER IROOT
-*
-#include "kapack/kax000.inc"
-#include "kapack/kax020.inc"
-#include "kapack/kax02c.inc"
-#include "kapack/kax050.inc"
-#include "kapack/kax070.inc"
-#include "kapack/kax0b0.inc"
-*
-*-----------------------------------------------------------------------
-*
-*.....SEARCH THE LOCK QUEUE FOR ENTRY IROOT AND THE FIRST FREE ENTRY
- L = 0
- DO 1 I = 1, LLOCKQ
- IF ( LOCKI(I).EQ.IROOT .AND. LOCKU(I).EQ.LUNKAF ) THEN
- L = I
- GO TO 2
- ENDIF
- IF ( L.EQ.0 .AND. LOCKN(I).EQ.0 ) L = I
- 1 CONTINUE
- IF ( L .EQ. 0 ) GO TO 92
-*
-*.....LOCK THE TREE IF IT IS NOT ALREADY LOCKED
- 2 IF ( LOCKN(L) .EQ. 0 ) THEN
- DO 3 I = 0, MAXTRY
- CALL KAXRD(IROOT,IB,LBLK)
- IF ( IB(9) .EQ. 0 ) THEN
- IB(9) = JOBID
- CALL KAXWRT(IROOT,IB,IB(7)-1)
- GO TO 4
- ENDIF
- CALL KAXAGE(IWAIT)
- 3 CONTINUE
- GO TO 91
- ENDIF
-*
-*.....PUT THE ROOT ID IN THE LOCK QUEUE AND INCREMENT THE LOCK COUNT
- 4 LOCKI(L) = IROOT
- LOCKU(L) = LUNKAF
- LOCKN(L) = LOCKN(L) + 1
-*
-*.....SUCCESSFUL COMPLETION
- RETURN
-*
-*.....ERROR PROCESSING
- 91 IF ( IROOT .EQ. 1 ) THEN
- WRITE(MSG,1911) LUNKAF
- ELSE IF ( IROOT .EQ. KROOT(0) ) THEN
- WRITE(MSG,1912) KMAJOR(0), LUNKAF
- ELSE
- WRITE(MSG,1913) IROOT, LUNKAF
- ENDIF
- GO TO 99
-*
- 92 WRITE(MSG,192)
- GO TO 99
-*
- 99 CALL KAXMSG(LUNERR,MSG)
- CALL KAXEND
-*
- 1911 FORMAT('CRNKA321 KAXOLK: UNABLE TO OBTAIN EXCLUSIVE ACCESS TO',
- + ' THE KA-FILE ON UNIT ',I3)
- 1912 FORMAT('CRNKA322 KAXOLK: UNABLE TO OBTAIN EXCLUSIVE ACCESS TO',
- + ' MAJOR NAME ''',A,''' ON UNIT ',I3)
- 1913 FORMAT('CRNKA323 KAXOLK: UNABLE TO OBTAIN EXCLUSIVE ACCESS TO',
- + ' TREE ',I11,' ON UNIT ',I3)
- 192 FORMAT('CRNKA324 KAXOLK: LOCK QUEUE OVERFLOW')
-*
- END
diff --git a/src/packlib/kapack/code/kaxopn.F b/src/packlib/kapack/code/kaxopn.F
deleted file mode 100644
index 0a00393..0000000
--- a/src/packlib/kapack/code/kaxopn.F
+++ /dev/null
@@ -1,171 +0,0 @@
-*
-* $Id: kaxopn.F,v 1.1.1.1 1996/03/08 11:40:53 mclareni Exp $
-*
-* $Log: kaxopn.F,v $
-* Revision 1.1.1.1 1996/03/08 11:40:53 mclareni
-* Kapack
-*
-*
-#include "kapack/pilot.h"
- SUBROUTINE KAXOPN
-*
-*.....OPEN AN EXISTING KA-FILE
-*
-#include "kapack/kax000.inc"
-#include "kapack/kax020.inc"
-#include "kapack/kax030.inc"
-#include "kapack/kax050.inc"
-#include "kapack/kax0b0.inc"
-*
- CHARACTER VERB1*3, VERB2*3
-#if defined(CERNLIB_CRAY)
- CHARACTER*2 CHALUN
-#endif
-*
-*-----------------------------------------------------------------------
-*
-*.....CHECK THE RECORD LENGTH
- IF ( KAXRCL(LUNKAF) .LE. 0 ) GO TO 91
-*
-*.....OPEN THE FILE FOR DIRECT ACCESS
- IF ( LBKS(LUNKAF) .EQ. 0 ) THEN
-#if defined(CERNLIB_UNIX)
- WRITE(MSG,1000) LUNKAF
- 1000 FORMAT('CRNKA24A KAXOPN: ENTER THE NAME OF THE KA-FILE FOR',
- + ' UNIT ',I3)
- CALL KAXMSG(ISYSWR,MSG)
- READ(ISYSRD,1001) MSG
- 1001 FORMAT(A)
-#endif
-#if defined(CERNLIB_CRAY)
- WRITE(CHALUN,'(I2)') LUNKAF
- MSG='fort.'//CHALUN(INDEX(CHALUN,' ')+1:2)
-#endif
-#if (!defined(CERNLIB_VAX))&&(!defined(CERNLIB_NORD))
- OPEN ( ACCESS = 'DIRECT',
-#endif
-#if defined(CERNLIB_NORD)
- OPEN ( BUFFER_SIZE = KAXRCL ( LUNKAF ),
- + MODE = 'SEGMENT',
-#endif
-#if defined(CERNLIB_UNIX)||defined(CERNLIB_CRAY)
- + FILE = MSG(1:INDEX(MSG,' ')-1),
-#endif
-#if !defined(CERNLIB_VAX)
- + ERR = 92,
- + FORM = 'UNFORMATTED',
- + IOSTAT = IOS,
- + RECL = KAXRCL(LUNKAF),
-#endif
-#if defined(CERNLIB_CRAY)
- + STATUS = 'OLD',
-#endif
-#if !defined(CERNLIB_VAX)
- + UNIT = LUNKAF )
-#endif
-#if defined(CERNLIB_VAX)
- IF ( MODIFY ) THEN
- OPEN ( ACCESS = 'DIRECT',
- + ERR = 92,
- + FORM = 'UNFORMATTED',
- + IOSTAT = IOS,
- + RECL = KAXRCL(LUNKAF),
- + SHARED,
- + STATUS = 'UNKNOWN',
- + UNIT = LUNKAF )
- ELSE
- OPEN ( ACCESS = 'DIRECT',
- + ERR = 92,
- + FORM = 'UNFORMATTED',
- + IOSTAT = IOS,
- + READONLY,
- + SHARED,
- + STATUS = 'OLD',
- + UNIT = LUNKAF )
- ENDIF
-#endif
- IF ( IOS .NE. 0 ) GO TO 92
- LBKS(LUNKAF) = -1
- ENDIF
-*
-*.....VALIDATE THE FILE ATTRIBUTES
- READ(LUNKAF,ERR=93,IOSTAT=IOS,REC=1) (IB(I),I=1,NBCW1)
- IF ( IOS .NE. 0 ) GO TO 93
- IF ( IB(13) .NE. KAVRSN ) GO TO 94
- IF ( IB(15) .GT. LBUF ) GO TO 95
-*
-*.....STORE FILE-DEPENDENT PARAMETERS
- LBKS(LUNKAF) = IB(15)
- NBKS(LUNKAF) = IB(14)
- NFBK(LUNKAF) = IB( 2)
- MAXP(LUNKAF) = IB(16)
- MAXK(LUNKAF) = 0
- DO 1 I = 1, MAXP(LUNKAF)
- MAXK(LUNKAF) = MAXK(LUNKAF)*100 + 99
- 1 CONTINUE
-*
-*.....CALCULATE THE NUMBER AND PERCENTAGE OF FREE BLOCKS
- NBUSED = IB(14) - IB(2)
- PCFREE = REAL(IB(2)) / REAL(IB(14)) * 100.0
- PCUSED = 100.0 - PCFREE
- VERB1 = 'ARE'
- IF ( NBUSED .EQ. 1 ) VERB1 = 'IS'
- VERB2 = 'ARE'
- IF ( IB(2) .EQ. 1 ) VERB2 = 'IS'
- WRITE(MSG,100) LUNKAF, IB(14), NBUSED, PCUSED,
- + VERB1, IB(2), PCFREE, VERB2
- CALL KAXMSG(LUNLOG,MSG)
- IF ( PCFREE .LT. 10.0 ) THEN
- WRITE(MSG,101) LUNKAF, IB(2), PCFREE
- CALL KAXMSG(LUNLOG,MSG)
- ELSE IF ( PCFREE .LT. 20.0 ) THEN
- WRITE(MSG,102) LUNKAF, IB(2), PCFREE
- CALL KAXMSG(LUNLOG,MSG)
- ENDIF
-*
-*.....SUCCESSFUL COMPLETION
- RETURN
-*
-*.....ERROR PROCESSING
- 91 WRITE(MSG,191) LUNKAF
- GO TO 99
-*
- 92 WRITE(MSG,192) LUNKAF, IOS
- GO TO 99
-*
- 93 WRITE(MSG,193) LUNKAF, IOS
- GO TO 99
-*
- 94 WRITE(MSG,194) LUNKAF
- GO TO 99
-*
- 95 WRITE(MSG,195) IB(15), LUNKAF, LBUF
- GO TO 99
-*
- 99 CALL KAXMSG(LUNERR,MSG)
- CALL KAXEND
-*
- 100 FORMAT('CRNKA240 KAXOPN: KA-FILE OPENED ON UNIT ',I3,
- + '; THE FILE CONTAINS ',I11,' BLOCKS OF WHICH ',
- + I11,' (',F5.1,'%) ',A,' USED AND ',
- + I11,' (',F5.1,'%) ',A,' UNUSED')
- 101 FORMAT('CRNKA241 KAXOPN: **** SERIOUS WARNING ****, THE KA-FILE
- + ON UNIT ',I3,' CONTAINS ONLY ',I11,' (',F5.1,'%) ',
- + ' FREE BLOCKS')
- 102 FORMAT('CRNKA242 KAXOPN: *** WARNING ***, THE KA-FILE
- + ON UNIT ',I3,' CONTAINS ONLY ',I11,' (',F5.1,'%) ',
- + ' FREE BLOCKS')
- 191 FORMAT('CRNKA243 KAXOPN: UNABLE TO OBTAIN THE BLOCK LENGTH FOR
- + THE KA-FILE ON UNIT ',I3)
- 192 FORMAT('CRNKA244 KAXOPN: ERROR WHILE OPENING THE KA-FILE ON
- + UNIT ',I3,', IOSTAT = ',I11)
- 193 FORMAT('CRNKA245 KAXOPN: I/O ERROR WHILE READING BLOCK 1 FROM
- + UNIT ',I3,', IOSTAT = ',I11)
- 194 FORMAT('CRNKA246 KAXOPN: THE KA-FILE ON UNIT ',I3,
- + ' IS INCOMPATIBLE WITH THIS VERSION OF KAPACK AND SHOULD',
- + ' BE CONVERTED BY SUBROUTINE KA1TO2, (SEE THE PAM TITLE',
- + ' OR CNL 175 FOR DETAILS)')
- 195 FORMAT('CRNKA247 KAXOPN: THE BLOCK LENGTH OF ',I11,' WORDS ON
- + UNIT ',I3,' EXCEEDS THE BUFFER LENGTH OF ',I11,' WORDS')
-*
- END
diff --git a/src/packlib/kapack/code/kaxput.F b/src/packlib/kapack/code/kaxput.F
deleted file mode 100644
index 82b0603..0000000
--- a/src/packlib/kapack/code/kaxput.F
+++ /dev/null
@@ -1,74 +0,0 @@
-*
-* $Id: kaxput.F,v 1.1.1.1 1996/03/08 11:40:53 mclareni Exp $
-*
-* $Log: kaxput.F,v $
-* Revision 1.1.1.1 1996/03/08 11:40:53 mclareni
-* Kapack
-*
-*
-#include "kapack/pilot.h"
- SUBROUTINE KAXPUT(IROOT,KEY,IDATA,*,*)
-*
-*.....REPLACE A RECORD IN A BLOCK
-*
-#include "kapack/kax000.inc"
-#include "kapack/kax020.inc"
-#include "kapack/kax050.inc"
-#include "kapack/kax0a0.inc"
-*
- INTEGER IDATA(*), KEY(*)
-*
-*-----------------------------------------------------------------------
-*
-*.....LOCATE THE RECORD
- CALL KAXGET(IROOT,KEY,1,LOC,*11)
-*
-*.....ENSURE THE TREE IS LOCKED
- CALL KAXTLK(IROOT,*12)
-*
-*.....REPLACE IT
- IF ( IA(8) .EQ. 0 ) THEN
-*
-*........NON-SEGMENTED RECORD
- LDATA = IA(LOC) - NRCW - IA(LOC+NRCW)
- IPTR = LOC + NRCW + IA(LOC+NRCW)
- CALL UCOPY(IDATA,IA(IPTR),LDATA)
- CALL KAXWRT(IA(1),IA,IA(7)-1)
-*
- ELSE
-*
-*........SEGMENTED RECORD
- IF ( IA(8) .NE. 1 ) GO TO 91
- LSEG = IA(7) - IA(6) - NRCW - IA(LOC+NRCW)
- IPTR = LOC + NRCW + IA(LOC+NRCW)
- CALL UCOPY(IDATA,IA(IPTR),LSEG)
- CALL KAXWRT(IA(1),IA,IA(7)-1)
- LDONE = LSEG
-*
- 1 CALL KAXRD(IA(3),IA,LBLK)
- IF ( IA(8).NE.2 .AND. IA(8).NE.3 ) GO TO 91
- LSEG = IA(7) - IA(6)
- CALL UCOPY (IDATA(LDONE+1),IA(IA(6)),LSEG)
- CALL KAXWRT(IA(1),IA,IA(7)-1)
- LDONE = LDONE + LSEG
- IF ( IA(8) .NE. 2 ) GO TO 1
-*
- ENDIF
-*
-*.....SUCCESSFUL COMPLETION
- CALL KAXRLK(IROOT)
- RETURN
-*
-*.....ERROR PROCESSING
- 11 RETURN 1
-*
- 12 RETURN 2
-*
- 91 WRITE(MSG,191) IA(8), IA(1), LUNKAF
- CALL KAXMSG(LUNERR,MSG)
- CALL KAXEND
-*
- 191 FORMAT('CRNKA251 KAXPUT: INVALID BLOCK TYPE ''',I11,
- + ''' FOUND IN BLOCK ',I11,' ON UNIT ',I3)
-*
- END
diff --git a/src/packlib/kapack/code/kaxrcl.F b/src/packlib/kapack/code/kaxrcl.F
deleted file mode 100644
index 173f5b9..0000000
--- a/src/packlib/kapack/code/kaxrcl.F
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: kaxrcl.F,v 1.1.1.1 1996/03/08 11:40:53 mclareni Exp $
-*
-* $Log: kaxrcl.F,v $
-* Revision 1.1.1.1 1996/03/08 11:40:53 mclareni
-* Kapack
-*
-*
-#include "kapack/pilot.h"
-#if !defined(CERNLIB_IBM)
- INTEGER FUNCTION KAXRCL(LUNKAF)
-*
-*.....OBTAIN THE BLOCKSIZE OF A DIRECT ACCESS FILE FOR USE BY KAPACK.
-* THE BLOCKSIZE IS RETURNED IN THE UNITS REQUIRED BY THE FORTRAN
-* OPEN STATEMENT FOR UNFORMATTED DIRECT ACCESS FILES.
-*
-#include "kapack/kax000.inc"
-*
-*-----------------------------------------------------------------------
-*
- KAXRCL = LWORD * LBUF
-*
- END
-#endif
diff --git a/src/packlib/kapack/code/kaxrclib.F b/src/packlib/kapack/code/kaxrclib.F
deleted file mode 100644
index 10b0931..0000000
--- a/src/packlib/kapack/code/kaxrclib.F
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: kaxrclib.F,v 1.1.1.1 1996/03/08 11:40:53 mclareni Exp $
-*
-* $Log: kaxrclib.F,v $
-* Revision 1.1.1.1 1996/03/08 11:40:53 mclareni
-* Kapack
-*
-*
-#include "kapack/pilot.h"
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB_QMIBMXA))
- INTEGER FUNCTION KAXRCL(LUN)
-#include "kapack/kax000.inc"
-#include "kapack/kax030.inc"
- IF (LBKS(LUN).EQ.0) OPEN (LUN)
- INQUIRE(LUN,RECL=ILEN)
- IF (LBKS(LUN).EQ.0) CLOSE (LUN)
- KAXRCL = ILEN
- END
-#endif
diff --git a/src/packlib/kapack/code/kaxrd.F b/src/packlib/kapack/code/kaxrd.F
deleted file mode 100644
index adf8cc4..0000000
--- a/src/packlib/kapack/code/kaxrd.F
+++ /dev/null
@@ -1,62 +0,0 @@
-*
-* $Id: kaxrd.F,v 1.1.1.1 1996/03/08 11:40:53 mclareni Exp $
-*
-* $Log: kaxrd.F,v $
-* Revision 1.1.1.1 1996/03/08 11:40:53 mclareni
-* Kapack
-*
-*
-#include "kapack/pilot.h"
- SUBROUTINE KAXRD(NBLOCK,IBUFF,NWORDS)
-*
-*.....READ A SPECIFIED BLOCK
-*
-#include "kapack/kax000.inc"
-#include "kapack/kax020.inc"
-#include "kapack/kax050.inc"
-*
- INTEGER IBUFF(NWORDS)
-*
-*-----------------------------------------------------------------------
-*
- IBLOCK = NBLOCK
- IF ( IBLOCK.LT.1 .OR. IBLOCK.GT.NBLKS ) GO TO 91
- IF ( NWORDS.LT.1 .OR. NWORDS.GT.LBLK ) GO TO 92
-*
- READ(LUNKAF,ERR=93,IOSTAT=IOS,REC=IBLOCK) IBUFF
- IF ( IOS .NE. 0 ) GO TO 93
- IF ( IBUFF(1) .NE. IBLOCK ) GO TO 94
-*
-*.....STORE THE NUMBER OF LEVELS IF A ROOT BLOCK HAS BEEN READ
- IF ( IBUFF(1) .EQ. IBUFF(4) ) LEVELS = IBUFF(5)
-*
-*.....SUCCESSFUL COMPLETION
- RETURN
-*
-*.....ERROR PROCESSING
- 91 WRITE(MSG,191) IBLOCK, LUNKAF, NBLKS
- GO TO 99
-*
- 92 WRITE(MSG,192) NWORDS, LUNKAF, LBLK
- GO TO 99
-*
- 93 WRITE(MSG,193) IBLOCK, LUNKAF, IOS
- GO TO 99
-*
- 94 WRITE(MSG,194) LUNKAF, IBLOCK, IBUFF(1)
- GO TO 99
-*
- 99 CALL KAXMSG(LUNERR,MSG)
- CALL KAXEND
-*
- 191 FORMAT('CRNKA261 KAXRD: KAPACK SYSTEM ERROR OR CORRUPT FILE,
- + REQUEST TO READ BLOCK ',I11,' FROM UNIT ',I3,
- + ' WHICH HAS ',I11,' BLOCKS')
- 192 FORMAT('CRNKA262 KAXRD: REQUEST TO READ ',I11,' WORDS FROM
- + UNIT ',I3,' WHICH HAS A BLOCK LENGTH OF ',I11,' WORDS')
- 193 FORMAT('CRNKA263 KAXRD: I/O ERROR WHILE READING BLOCK ',I11,
- + ' FROM UNIT ',I3,', IOSTAT = ',I11)
- 194 FORMAT('CRNKA264 KAXRD: INVALID BLOCK NUMBER OR IDENTIFIER ON
- + UNIT ',I3,', NUMBER = ',I11,', IDENTIFIER = ',I11)
-*
- END
diff --git a/src/packlib/kapack/code/kaxrlk.F b/src/packlib/kapack/code/kaxrlk.F
deleted file mode 100644
index 82a297f..0000000
--- a/src/packlib/kapack/code/kaxrlk.F
+++ /dev/null
@@ -1,73 +0,0 @@
-*
-* $Id: kaxrlk.F,v 1.1.1.1 1996/03/08 11:40:53 mclareni Exp $
-*
-* $Log: kaxrlk.F,v $
-* Revision 1.1.1.1 1996/03/08 11:40:53 mclareni
-* Kapack
-*
-*
-#include "kapack/pilot.h"
- SUBROUTINE KAXRLK(IROOT)
-*
-*.....RELEASE A LOCK FOR THE TREE WITH ROOT NUMBER IROOT
-*
-#include "kapack/kax000.inc"
-#include "kapack/kax020.inc"
-#include "kapack/kax02c.inc"
-#include "kapack/kax050.inc"
-#include "kapack/kax070.inc"
-#include "kapack/kax0b0.inc"
-*
-*-----------------------------------------------------------------------
-*
-*.....SEARCH THE LOCK QUEUE FOR ENTRY IROOT
- DO 1 I = 1, LLOCKQ
- IF ( LOCKI(I).EQ.IROOT .AND. LOCKU(I).EQ.LUNKAF ) THEN
- L = I
- GO TO 2
- ENDIF
- 1 CONTINUE
- GO TO 91
-*
-*.....DECREMENT THE LOCK COUNT
- 2 IF ( LOCKN(L) .EQ. 0 ) GO TO 91
- LOCKN(L) = LOCKN(L) - 1
-*
-*.....DELETE THE LOCK IF THE COUNT HAS REACHED ZERO
- IF ( LOCKN(L) .EQ. 0 ) THEN
- CALL KAXRD(IROOT,IB,LBLK)
- IF ( IB(9) .NE. JOBID ) GO TO 92
- IB(9) = 0
- CALL KAXWRT(IROOT,IB,IB(7)-1)
- ENDIF
-*
-*.....SUCCESSFUL COMPLETION
- RETURN
-*
-*.....ERROR PROCESSING
- 91 IF ( IROOT .EQ. 1 ) THEN
- WRITE(MSG,1911) LUNKAF
- ELSE IF ( IROOT .EQ. KROOT(0) ) THEN
- WRITE(MSG,1912) KMAJOR(0), LUNKAF
- ELSE
- WRITE(MSG,1913) IROOT, LUNKAF
- ENDIF
- GO TO 99
-*
- 92 WRITE(MSG,192) IB(9), LUNKAF
- GO TO 99
-*
- 99 CALL KAXMSG(LUNERR,MSG)
- CALL KAXEND
-*
- 1911 FORMAT('CRNKA331 KAXRLK: KAPACK SYSTEM ERROR, INVALID REQUEST TO',
- + ' RELEASE THE KA-FILE ON UNIT ',I3)
- 1912 FORMAT('CRNKA332 KAXRLK: KAPACK SYSTEM ERROR, INVALID REQUEST TO',
- + ' RELEASE MAJOR NAME ''',A,''' ON UNIT ',I3)
- 1913 FORMAT('CRNKA333 KAXRLK: KAPACK SYSTEM ERROR, INVALID REQUEST TO',
- + ' RELEASE TREE ',I11,' ON UNIT ',I3)
- 192 FORMAT('CRNKA334 KAXRLK: ACCESS CONFLICT WITH JOB ',I11,
- + ', DATA MAY HAVE BEEN LOST WHILE UPDATING THE KA-FILE ON ',
- + ' UNIT ',I3)
-*
- END
diff --git a/src/packlib/kapack/code/kaxshl.F b/src/packlib/kapack/code/kaxshl.F
deleted file mode 100644
index e37cb2e..0000000
--- a/src/packlib/kapack/code/kaxshl.F
+++ /dev/null
@@ -1,30 +0,0 @@
-*
-* $Id: kaxshl.F,v 1.1.1.1 1996/03/08 11:40:53 mclareni Exp $
-*
-* $Log: kaxshl.F,v $
-* Revision 1.1.1.1 1996/03/08 11:40:53 mclareni
-* Kapack
-*
-*
-#include "kapack/pilot.h"
- SUBROUTINE KAXSHL(IZ,IL,N)
-*
-*.....SHIFT DATA INTO THE LEFT BROTHER OF A BLOCK
-*
- INTEGER IL(*), IZ(*)
-*
-*-----------------------------------------------------------------------
-*
- IF ( N .GT. 0 ) THEN
-*
-*........SHIFT DATA TO THE LEFT
- CALL UCOPY( IZ(IZ(6)), IL(IL(7)), N )
- IL(7) = IL(7) + N
-*
-*........CLOSE THE GAP
- IF ( IZ(7)-IZ(6)-N .GT. 0 )
- + CALL UCOPY( IZ(IZ(6)+N), IZ(IZ(6)), IZ(7)-IZ(6)-N )
- IZ(7) = IZ(7) - N
- ENDIF
-*
- END
diff --git a/src/packlib/kapack/code/kaxshr.F b/src/packlib/kapack/code/kaxshr.F
deleted file mode 100644
index d8f6dee..0000000
--- a/src/packlib/kapack/code/kaxshr.F
+++ /dev/null
@@ -1,30 +0,0 @@
-*
-* $Id: kaxshr.F,v 1.1.1.1 1996/03/08 11:40:53 mclareni Exp $
-*
-* $Log: kaxshr.F,v $
-* Revision 1.1.1.1 1996/03/08 11:40:53 mclareni
-* Kapack
-*
-*
-#include "kapack/pilot.h"
- SUBROUTINE KAXSHR(IZ,IR,N)
-*
-*.....SHIFT DATA INTO THE RIGHT BROTHER OF A BLOCK
-*
- INTEGER IR(*), IZ(*)
-*
-*-----------------------------------------------------------------------
-*
- IF ( N .GT. 0 ) THEN
-*
-*........CREATE A GAP TO RECEIVE THE DATA
- IF ( IR(7)-IR(6) .GT. 0 )
- + CALL UCOPY2( IR(IR(6)), IR(IR(6)+N), IR(7)-IR(6) )
- IR(7) = IR(7) + N
-*
-*........SHIFT DATA INTO THE GAP
- CALL UCOPY( IZ(IZ(7)-N), IR(IR(6)), N )
- IZ(7) = IZ(7) - N
- ENDIF
-*
- END
diff --git a/src/packlib/kapack/code/kaxtlk.F b/src/packlib/kapack/code/kaxtlk.F
deleted file mode 100644
index 7fbf6eb..0000000
--- a/src/packlib/kapack/code/kaxtlk.F
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: kaxtlk.F,v 1.1.1.1 1996/03/08 11:40:53 mclareni Exp $
-*
-* $Log: kaxtlk.F,v $
-* Revision 1.1.1.1 1996/03/08 11:40:53 mclareni
-* Kapack
-*
-*
-#include "kapack/pilot.h"
- SUBROUTINE KAXTLK(IROOT,*)
-*
-*.....TEST A LOCK FOR THE TREE WITH ROOT NUMBER IROOT
-*
-#include "kapack/kax000.inc"
-#include "kapack/kax020.inc"
-#include "kapack/kax070.inc"
-*
-*-----------------------------------------------------------------------
-*
-*.....SEARCH THE LOCK QUEUE FOR ENTRY IROOT
- DO 1 I = 1, LLOCKQ
- IF ( LOCKI(I).EQ.IROOT .AND.
- + LOCKU(I).EQ.LUNKAF .AND.
- + LOCKN(I).NE.0 ) RETURN
- 1 CONTINUE
-*
- RETURN 1
-*
- END
diff --git a/src/packlib/kapack/code/kaxwrd.F b/src/packlib/kapack/code/kaxwrd.F
deleted file mode 100644
index 1fd3a3b..0000000
--- a/src/packlib/kapack/code/kaxwrd.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: kaxwrd.F,v 1.1.1.1 1996/03/08 11:40:53 mclareni Exp $
-*
-* $Log: kaxwrd.F,v $
-* Revision 1.1.1.1 1996/03/08 11:40:53 mclareni
-* Kapack
-*
-*
-#include "kapack/pilot.h"
- SUBROUTINE KAXWRD(STRING,LOC,LENGTH,*)
-*
-*.....FIND THE LOCATION AND LENGTH OF A WORD DELIMITED BY BLANKS
-*
- CHARACTER STRING*(*)
-*
-*-----------------------------------------------------------------------
-*
- DO 1 LOC = 1, LEN(STRING)
- IF ( STRING(LOC:LOC) .NE. ' ' ) THEN
- LENGTH = INDEX(STRING(LOC:),' ') - 1
- IF ( LENGTH .LT. 0 ) LENGTH = LEN(STRING) - LOC + 1
- RETURN
- ENDIF
- 1 CONTINUE
-*
- RETURN 1
-*
- END
diff --git a/src/packlib/kapack/code/kaxwrt.F b/src/packlib/kapack/code/kaxwrt.F
deleted file mode 100644
index 680ef28..0000000
--- a/src/packlib/kapack/code/kaxwrt.F
+++ /dev/null
@@ -1,67 +0,0 @@
-*
-* $Id: kaxwrt.F,v 1.1.1.1 1996/03/08 11:40:53 mclareni Exp $
-*
-* $Log: kaxwrt.F,v $
-* Revision 1.1.1.1 1996/03/08 11:40:53 mclareni
-* Kapack
-*
-*
-#include "kapack/pilot.h"
- SUBROUTINE KAXWRT(NBLOCK,IBUFF,NWORDS)
-*
-*.....WRITE A SPECIFIED BLOCK
-*
-*.....DETECTION OF ILLEGAL FREE BLOCK POINTER ADDED 880628
-*
-#include "kapack/kax000.inc"
-#include "kapack/kax020.inc"
-#include "kapack/kax050.inc"
-*
- INTEGER IBUFF(NWORDS)
-*
-*-----------------------------------------------------------------------
-*
- IF ( NBLOCK.LT.1 .OR. NBLOCK.GT.NBLKS ) GO TO 91
- IF ( NWORDS.LT.1 .OR. NWORDS.GT.LBLK ) GO TO 92
- IF(IBUFF(2).EQ.0.AND.IBUFF(3).EQ.1) GO TO 95
- IF ( IBUFF(1) .NE. NBLOCK ) GO TO 93
-*
- WRITE(LUNKAF,ERR=94,IOSTAT=IOS,REC=NBLOCK) IBUFF
- IF ( IOS .NE. 0 ) GO TO 94
-*
-*.....SUCCESSFUL COMPLETION
- RETURN
-*
-*.....ERROR PROCESSING
- 91 WRITE(MSG,191) NBLOCK, LUNKAF, NBLKS
- GO TO 99
-*
- 92 WRITE(MSG,192) NWORDS, LUNKAF, LBLK
- GO TO 99
-*
- 93 WRITE(MSG,193) LUNKAF, NBLOCK, IBUFF(1)
- GO TO 99
-*
- 94 WRITE(MSG,194) NBLOCK, LUNKAF, IOS
- GO TO 99
-*
- 95 WRITE(MSG,195) LUNKAF, NBLOCK, IBUFF(1),IBUFF(2),IBUFF(3),IBUFF(4)
- GO TO 99
-*
- 99 CALL KAXMSG(LUNERR,MSG)
- CALL KAXEND
-*
- 191 FORMAT('CRNKA271 KAXWRT: KAPACK SYSTEM ERROR OR CORRUPT FILE,
- + REQUEST TO WRITE BLOCK ',I11,' TO UNIT ',I3,
- + ' WHICH HAS ',I11,' BLOCKS')
- 192 FORMAT('CRNKA272 KAXWRT: REQUEST TO WRITE ',I11,' WORDS TO
- + UNIT ',I3,' WHICH HAS A BLOCK LENGTH OF ',I11,' WORDS')
- 193 FORMAT('CRNKA273 KAXWRT: INVALID BLOCK NUMBER OR IDENTIFIER ON
- + UNIT ',I3,', NUMBER = ',I11,', IDENTIFIER = ',I11)
- 194 FORMAT('CRNKA274 KAXWRT: I/O ERROR WHILE WRITING BLOCK ',I11,
- + ' TO UNIT ',I3,', IOSTAT = ',I11)
- 195 FORMAT('CRNKA275 KAXWRT: KAPACK SYSTEM ERROR, ',
- + 'REQUEST TO WRITE BLOCK ',I11,' TO UNIT ',I3,
- + ' WITH ILLEGAL FREE BLOCK POINTERS=',4I6)
-*
- END
diff --git a/src/packlib/kapack/code/kaz1a2.F b/src/packlib/kapack/code/kaz1a2.F
deleted file mode 100644
index 73fd346..0000000
--- a/src/packlib/kapack/code/kaz1a2.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: kaz1a2.F,v 1.1.1.1 1996/03/08 11:40:53 mclareni Exp $
-*
-* $Log: kaz1a2.F,v $
-* Revision 1.1.1.1 1996/03/08 11:40:53 mclareni
-* Kapack
-*
-*
-#include "kapack/pilot.h"
- SUBROUTINE KAZ1A2
-*
-*.....AUXILIARY ROUTINE TO KA1TO2: PROCESS THE RECORDS IN A GIVEN BLOCK
-*
-#include "kapack/kax000.inc"
-#include "kapack/kax0a0.inc"
-*
-*-----------------------------------------------------------------------
-*
- LOC = IA(6)
- 1 IF ( LOC .LT. IA(7) ) THEN
- CALL KAZ1B2(IA(LOC+NRCW))
- LOC = LOC + IA(LOC)
- GO TO 1
- ENDIF
-*
- END
diff --git a/src/packlib/kapack/code/kaz1b2.F b/src/packlib/kapack/code/kaz1b2.F
deleted file mode 100644
index ec434f3..0000000
--- a/src/packlib/kapack/code/kaz1b2.F
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: kaz1b2.F,v 1.1.1.1 1996/03/08 11:40:53 mclareni Exp $
-*
-* $Log: kaz1b2.F,v $
-* Revision 1.1.1.1 1996/03/08 11:40:53 mclareni
-* Kapack
-*
-*
-#include "kapack/pilot.h"
- SUBROUTINE KAZ1B2(INT)
-*
-*.....AUXILIARY ROUTINE TO KA1TO2: CONVERT A GIVEN NAME
-*
-#include "kapack/kax000.inc"
-#include "kapack/kax020.inc"
-*
- INTEGER INT(*)
-*
- LOGICAL NEG
-*
-*-----------------------------------------------------------------------
-*
- NEG = INT(2) .LT. 0
- INT(2) = ABS( INT(2) )
-*
-*.....LOOP FOR EACH WORD IN THE NAME
- DO 2 IWORD = 2, INT(1)
- NUMOLD = INT(IWORD)
- NUMNEW = 0
- DO 1 I = 1, MAXPAK
- IC = MOD(NUMOLD,100)
- NUMOLD = NUMOLD/100
- IF ( IC.GT.0 .AND. IC.LT.MAXC ) IC = IC + 1
- NUMNEW = NUMNEW + IC * 100**(I-1)
- 1 CONTINUE
- INT(IWORD) = NUMNEW
- 2 CONTINUE
-*
- IF ( NEG ) INT(2) = -INT(2)
-*
- END
diff --git a/src/packlib/kapack/ibm_assembler/kaxageml.s b/src/packlib/kapack/ibm_assembler/kaxageml.s
deleted file mode 100644
index 356fe68..0000000
--- a/src/packlib/kapack/ibm_assembler/kaxageml.s
+++ /dev/null
@@ -1,106 +0,0 @@
-*
-* $Id: kaxageml.s,v 1.1.1.1 1996/03/08 11:40:55 mclareni Exp $
-*
-* $Log: kaxageml.s,v $
-* Revision 1.1.1.1 1996/03/08 11:40:55 mclareni
-* Kapack
-*
-*
-#if (defined(CERNLIB_IBM))&&(!defined(CERNLIB_QMIBMXA))
- TITLE 'KAXAGE'
-***********************************************************************
-* *
-* K A X A G E *
-* =========== *
-* *
-***********************************************************************
-* *
-* FUNCTION: PUT THE TASK INTO A WAIT STATE FOR A SPECIFIED *
-* PERIOD OF TIME *
-* *
-* CALLING SEQUENCE: CALL KAXAGE(INTVAL) *
-* *
-* ARGUMENTS: INTVAL - A 4-BYTE INTEGER CONTAINING THE TIME PERIOD,*
-* IN HUNDREDTHS OF SECONDS, FOR WHICH THE *
-* TASK IS TO WAIT. A ZERO OR NEGATIVE VALUE *
-* WILL CAUSE AN IMMEDIATE RETURN TO THE *
-* CALLING ROUTINE WITH NO WAIT. *
-* *
-* EXAMPLE: TO PUT THE TASK INTO A WAIT STATE FOR 5 SECONDS: *
-* *
-* CALL KAXAGE(500) *
-* *
-***********************************************************************
- EJECT
-***********************************************************************
-* *
-* M O D I F I C A T I O N L O G *
-* =============================== *
-* *
-***********************************************************************
-* *
-* 1 . 0 0 *
-* ======= *
-* *
-* ORIGINAL VERSION. *
-* *
-* R. MATTHEWS, CERN/DD, MAY 1985. *
-* *
-***********************************************************************
- EJECT
-R0 EQU 0
-R1 EQU 1
-R2 EQU 2
-R3 EQU 3
-R4 EQU 4
-R5 EQU 5
-R6 EQU 6
-R7 EQU 7
-R8 EQU 8
-R9 EQU 9
-R10 EQU 10
-R11 EQU 11
-R12 EQU 12
-R13 EQU 13
-R14 EQU 14
-R15 EQU 15
- EJECT
- PRINT NOGEN
-KAXAGE CSECT
- SPACE 2
-* P R O L O G U E
- SPACE
- USING KAXAGE,R15
- B SAVEREGS
- DC AL1(7),CL7'KAXAGE' IDENTIFIER
- DC C'1.00' VERSION.MODIFICATION LEVEL
-SAVEREGS STM R14,R12,12(R13)
- LR R4,R13
- CNOP 0,4
- BAL R13,AROUNDSA
-SAVEAREA DC A(EPILOGUE),17F'0'
- DROP R15
- USING SAVEAREA,R13
-AROUNDSA ST R13,8(0,R4)
- ST R4,4(0,R13)
- XC 8(4,R13),8(R13)
- SPACE
- LR R11,R1 R11 -> ARGUMENT LIST
- SPACE
- L R4,0(0,R11) R4 -> USER'S WAIT INTERVAL
- L R3,0(0,R4) R3 := USER'S WAIT INTERVAL
- LTR R3,R3 IS IT .LE. ZERO ?
- BNP EPILOGUE YES, BRANCH
- SPACE
- STIMER WAIT,BINTVL=(R4) ISSUE THE WAIT
- SPACE 2
-* E P I L O G U E
- SPACE
-EPILOGUE EQU *
- L R13,4(0,R13)
- LM R14,R12,12(R13)
- MVI 12(R13),X'FF'
- BR R14
- SPACE 2
- END
-#endif
diff --git a/src/packlib/kapack/ibm_assembler/kaxrclml.s b/src/packlib/kapack/ibm_assembler/kaxrclml.s
deleted file mode 100644
index 2c09349..0000000
--- a/src/packlib/kapack/ibm_assembler/kaxrclml.s
+++ /dev/null
@@ -1,148 +0,0 @@
-*
-* $Id: kaxrclml.s,v 1.1.1.1 1996/03/08 11:40:55 mclareni Exp $
-*
-* $Log: kaxrclml.s,v $
-* Revision 1.1.1.1 1996/03/08 11:40:55 mclareni
-* Kapack
-*
-*
-#if (defined(CERNLIB_IBM))&&(!defined(CERNLIB_QMIBMXA))
- TITLE 'KAXRCL'
-***********************************************************************
-* *
-* K A X R C L *
-* =========== *
-* *
-***********************************************************************
-* *
-* FUNCTION: OBTAIN THE BLOCKSIZE OF A DIRECT ACCESS FILE FOR USE *
-* BY KAPACK. THE BLOCKSIZE IS RETURNED IN THE UNITS *
-* REQUIRED BY THE FORTRAN OPEN STATEMENT FOR *
-* UNFORMATTED DIRECT ACCESS FILES, (I.E. BYTES ON IBM). *
-* IN THE EVENT OF AN ERROR A LENGTH OF ZERO WILL BE *
-* RETURNED. *
-* *
-* CALLING SEQUENCE: LENGTH = KAXRCL(LUN) *
-* *
-* ARGUMENTS: LUN - AN INTEGER EXPRESSION WHOSE VALUE REPRESENTS *
-* THE NUMBER OF THE UNIT TO WHICH THE FILE IS *
-* CONNECTED. *
-* *
-***********************************************************************
- EJECT
-***********************************************************************
-* *
-* M O D I F I C A T I O N L O G *
-* =============================== *
-* *
-***********************************************************************
-* *
-* 1 . 0 1 *
-* ======= *
-* *
-* DCBOFOPN REPLACED BY X'10' FOR COMPATIBILITY WITH CMS DCBD MACRO. *
-* *
-* R. MATTHEWS, CERN/DD, APRIL 1985. *
-* *
-***********************************************************************
-* *
-* 1 . 0 0 *
-* ======= *
-* *
-* ORIGINAL VERSION. *
-* *
-* R. MATTHEWS, CERN/DD, JULY 1982. *
-* *
-***********************************************************************
- EJECT
-R0 EQU 0
-R1 EQU 1
-R2 EQU 2
-R3 EQU 3
-R4 EQU 4
-R5 EQU 5
-R6 EQU 6
-R7 EQU 7
-R8 EQU 8
-R9 EQU 9
-R10 EQU 10
-R11 EQU 11
-R12 EQU 12
-R13 EQU 13
-R14 EQU 14
-R15 EQU 15
- EJECT
- PRINT NOGEN
-KAXRCL CSECT
- SPACE 2
-* P R O L O G U E
- SPACE
- USING KAXRCL,R15
- B SAVEREGS
- DC AL1(7),CL7'KAXRCL' IDENTIFIER
- DC C'1.01' VERSION.MODIFICATION LEVEL
-SAVEREGS STM R14,R12,12(R13)
- LR R4,R13
- CNOP 0,4
- BAL R13,AROUNDSA
-SAVEAREA DC A(EPILOGUE),17F'0'
- DROP R15
- USING SAVEAREA,R13
-AROUNDSA ST R13,8(0,R4)
- ST R4,4(0,R13)
- XC 8(4,R13),8(R13)
- SPACE
- LR R11,R1 R11 -> ARGUMENT LIST
- LA R10,DCB R10 -> DCB
- USING IHADCB,R10 ESTABLISH ADDRESSABILITY OF THE DCB
- SPACE 2
-* G E N E R A T E T H E D D N A M E
- SPACE
- L R2,0(0,R11) R2 -> UNIT IDENTIFIER
- L R2,0(0,R2) R2 := UNIT IDENTIFIER
- CVD R2,DOUBLE CONVERT IT TO EBCDIC...
- MVC EDITAREA(L'PATTERN1),PATTERN1
- ED EDITAREA(L'PATTERN1),DOUBLE+6
- MVC DCBDDNAM+2(2),EDITAREA+1 MOVE IT INTO THE DCB
- SPACE 2
-* O P E N T H E D C B
- SPACE
- XC DOUBLE,DOUBLE SET DEFAULT LENGTH
- OPEN DCB
- TM DCBOFLGS,X'10' WAS THE OPEN SUCCESSFUL ?
- BNO EPILOGUE NO, BRANCH
- SPACE 2
-* G E T T H E B L O C K S I Z E
- SPACE
- LH R2,DCBBLKSI R2 := BLOCKSIZE
- ST R2,DOUBLE STORE IT
- SPACE 2
-* C L O S E T H E D C B
- SPACE
- CLOSE DCB
- EJECT
-* E P I L O G U E
- SPACE
-EPILOGUE EQU *
- L R0,DOUBLE LOAD THE RESULT
- L R13,4(0,R13)
- L R14,12(0,R13)
- LM R1,R12,24(R13)
- MVI 12(R13),X'FF'
- BR R14
- EJECT
-* D A T A A R E A S
- SPACE
-DOUBLE DS D
- SPACE
-EDITAREA DS 3C
-PATTERN1 DC X'212020'
- SPACE
-DCB DCB DDNAME=FT??F001,DSORG=PS,MACRF=(R)
- SPACE 2
- LTORG
- SPACE 2
- DCBD DSORG=PS
- SPACE 2
- END
-#endif
diff --git a/src/packlib/kapack/kapack/Imakefile b/src/packlib/kapack/kapack/Imakefile
deleted file mode 100644
index ea06d63..0000000
--- a/src/packlib/kapack/kapack/Imakefile
+++ /dev/null
@@ -1,5 +0,0 @@
-INCLUDES= kax000.inc kax010.inc kax020.inc kax02c.inc \ @@\
- kax030.inc kax040.inc kax050.inc kax060.inc kax070.inc \ @@\
- kax080.inc kax090.inc kax0a0.inc kax0b0.inc pilot.h
-
-InstallIncludes($(INCLUDES),$(CERN_INCLUDEDIR),kapack)
diff --git a/src/packlib/kapack/kapack/kax000.inc b/src/packlib/kapack/kapack/kax000.inc
deleted file mode 100644
index dadf3ab..0000000
--- a/src/packlib/kapack/kapack/kax000.inc
+++ /dev/null
@@ -1,70 +0,0 @@
-*
-* $Id: kax000.inc,v 1.1.1.1 1996/03/08 11:40:53 mclareni Exp $
-*
-* $Log: kax000.inc,v $
-* Revision 1.1.1.1 1996/03/08 11:40:53 mclareni
-* Kapack
-*
-*
-#ifndef CERNLIB_KAPACK_KAX000_INC
-#define CERNLIB_KAPACK_KAX000_INC
-*
-*
-* kax000.inc
-*
-#if (defined(CERNLIB_UNIX))&&(defined(CERNLIB_DOUBLE))
- PARAMETER ( ISYSRD=5, ISYSWR=6, IWAIT=500,
- + LBUF=1500, LLINE=79, LMQ=9, LWORD=4,
- + MAXINT=2147483647, MAXLUN=99, MAXNAM=100, MAXTRY=5 )
-*
- PARAMETER ( KAVRSN=2, LLOCKQ=10, LXAQ=3, LXDQ=3, MAXC=49,
- + MAXMSG=500, NBCW=12, NBCW1=24, NRCW=1, THRESH=0.5 )
-*
-#endif
-#if defined(CERNLIB_CDC)
- PARAMETER ( ISYSRD=5, ISYSWR=6, IWAIT=500,
- + LBUF=1500, LLINE=79, LMQ=9, LWORD=1,
- + MAXINT=281474976710655, MAXLUN=99, MAXNAM=100, MAXTRY=5 )
-*
- PARAMETER ( KAVRSN=2, LLOCKQ=10, LXAQ=3, LXDQ=3, MAXC=49,
- + MAXMSG=500, NBCW=12, NBCW1=24, NRCW=1, THRESH=0.5 )
-*
-#endif
-#if (defined(CERNLIB_CRAY)||defined(CERNLIB_QMCOS)||defined(CERNLIB_UNIX))&&(!defined(CERNLIB_DOUBLE))
- PARAMETER ( ISYSRD=5, ISYSWR=6, IWAIT=500,
- + LBUF=1500, LLINE=79, LMQ=9, LWORD=8,
- + MAXINT=281474976710655, MAXLUN=99, MAXNAM=100, MAXTRY=5 )
-*
- PARAMETER ( KAVRSN=2, LLOCKQ=10, LXAQ=3, LXDQ=3, MAXC=49,
- + MAXMSG=274, NBCW=12, NBCW1=24, NRCW=1, THRESH=0.5 )
-*
-#endif
-#if defined(CERNLIB_IBM)
- PARAMETER ( ISYSRD=5, ISYSWR=6, IWAIT=500,
- + LBUF=1500, LLINE=79, LMQ=9, LWORD=4,
- + MAXINT=2147483647, MAXLUN=99, MAXNAM=100, MAXTRY=5 )
-*
- PARAMETER ( KAVRSN=2, LLOCKQ=10, LXAQ=3, LXDQ=3, MAXC=49,
- + MAXMSG=500, NBCW=12, NBCW1=24, NRCW=1, THRESH=0.5 )
-*
-#endif
-#if defined(CERNLIB_NORD)
- PARAMETER ( ISYSRD=1, ISYSWR=1, IWAIT=500,
- + LBUF=2048, LLINE=79, LMQ=9, LWORD=4,
- + MAXINT=2147483647, MAXLUN=99, MAXNAM=100, MAXTRY=5 )
-*
- PARAMETER ( KAVRSN=2, LLOCKQ=10, LXAQ=3, LXDQ=3, MAXC=49,
- + MAXMSG=256, NBCW=12, NBCW1=24, NRCW=1, THRESH=0.5 )
-*
-#endif
-#if defined(CERNLIB_VAX)
- PARAMETER ( ISYSRD=5, ISYSWR=6, IWAIT=500,
- + LBUF=1500, LLINE=79, LMQ=9, LWORD=1,
- + MAXINT=2147483647, MAXLUN=99, MAXNAM=100, MAXTRY=5 )
-*
- PARAMETER ( KAVRSN=2, LLOCKQ=10, LXAQ=3, LXDQ=3, MAXC=49,
- + MAXMSG=500, NBCW=12, NBCW1=24, NRCW=1, THRESH=0.5 )
-*
-#endif
-
-#endif
diff --git a/src/packlib/kapack/kapack/kax010.inc b/src/packlib/kapack/kapack/kax010.inc
deleted file mode 100644
index 59cce5a..0000000
--- a/src/packlib/kapack/kapack/kax010.inc
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: kax010.inc,v 1.1.1.1 1996/03/08 11:40:53 mclareni Exp $
-*
-* $Log: kax010.inc,v $
-* Revision 1.1.1.1 1996/03/08 11:40:53 mclareni
-* Kapack
-*
-*
-#ifndef CERNLIB_KAPACK_KAX010_INC
-#define CERNLIB_KAPACK_KAX010_INC
-*
-*
-* kax010.inc
-*
- COMMON /KAX010/ TITLED(1:MAXLUN)
- LOGICAL TITLED
-
-#endif
diff --git a/src/packlib/kapack/kapack/kax020.inc b/src/packlib/kapack/kapack/kax020.inc
deleted file mode 100644
index 3704ff7..0000000
--- a/src/packlib/kapack/kapack/kax020.inc
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: kax020.inc,v 1.1.1.1 1996/03/08 11:40:53 mclareni Exp $
-*
-* $Log: kax020.inc,v $
-* Revision 1.1.1.1 1996/03/08 11:40:53 mclareni
-* Kapack
-*
-*
-#ifndef CERNLIB_KAPACK_KAX020_INC
-#define CERNLIB_KAPACK_KAX020_INC
-*
-*
-* kax020.inc
-*
- COMMON /KAX020/ JOBID, LBLK, LEVELS, LREC, LUNERR, LUNKAF, LUNLOG,
- + MAXKEY, MAXPAK, MODIFY, NBLKS, NFREE,
- + NEWLUN, RETURN,
- + MAJKEY(1:1+MAXNAM), MINKEY(1:1+MAXNAM),
- + KLDEF(0:LMQ), KLMAX(0:LMQ),
- + KROOT(0:LMQ), KUNIT(0:LMQ), KPROOT
- LOGICAL MODIFY, NEWLUN, RETURN
-
-#endif
diff --git a/src/packlib/kapack/kapack/kax02c.inc b/src/packlib/kapack/kapack/kax02c.inc
deleted file mode 100644
index 8e90b47..0000000
--- a/src/packlib/kapack/kapack/kax02c.inc
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: kax02c.inc,v 1.1.1.1 1996/03/08 11:40:54 mclareni Exp $
-*
-* $Log: kax02c.inc,v $
-* Revision 1.1.1.1 1996/03/08 11:40:54 mclareni
-* Kapack
-*
-*
-#ifndef CERNLIB_KAPACK_KAX02C_INC
-#define CERNLIB_KAPACK_KAX02C_INC
-*
-*
-* kax02c.inc
-*
- COMMON /KAX02C/ KMAJOR(0:LMQ)
- CHARACTER KMAJOR*(MAXNAM)
-
-#endif
diff --git a/src/packlib/kapack/kapack/kax030.inc b/src/packlib/kapack/kapack/kax030.inc
deleted file mode 100644
index 501f99e..0000000
--- a/src/packlib/kapack/kapack/kax030.inc
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: kax030.inc,v 1.1.1.1 1996/03/08 11:40:54 mclareni Exp $
-*
-* $Log: kax030.inc,v $
-* Revision 1.1.1.1 1996/03/08 11:40:54 mclareni
-* Kapack
-*
-*
-#ifndef CERNLIB_KAPACK_KAX030_INC
-#define CERNLIB_KAPACK_KAX030_INC
-*
-*
-* kax030.inc
-*
- COMMON /KAX030/ LBKS(1:MAXLUN), NBKS(1:MAXLUN), NFBK(1:MAXLUN),
- + MAXK(1:MAXLUN), MAXP(1:MAXLUN)
-
-#endif
diff --git a/src/packlib/kapack/kapack/kax040.inc b/src/packlib/kapack/kapack/kax040.inc
deleted file mode 100644
index 21665df..0000000
--- a/src/packlib/kapack/kapack/kax040.inc
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: kax040.inc,v 1.1.1.1 1996/03/08 11:40:54 mclareni Exp $
-*
-* $Log: kax040.inc,v $
-* Revision 1.1.1.1 1996/03/08 11:40:54 mclareni
-* Kapack
-*
-*
-#ifndef CERNLIB_KAPACK_KAX040_INC
-#define CERNLIB_KAPACK_KAX040_INC
-*
-*
-* kax040.inc
-*
- COMMON /KAX040/ CSET(1:MAXC)
- CHARACTER CSET*1
-
-#endif
diff --git a/src/packlib/kapack/kapack/kax050.inc b/src/packlib/kapack/kapack/kax050.inc
deleted file mode 100644
index fd0362b..0000000
--- a/src/packlib/kapack/kapack/kax050.inc
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: kax050.inc,v 1.1.1.1 1996/03/08 11:40:54 mclareni Exp $
-*
-* $Log: kax050.inc,v $
-* Revision 1.1.1.1 1996/03/08 11:40:54 mclareni
-* Kapack
-*
-*
-#ifndef CERNLIB_KAPACK_KAX050_INC
-#define CERNLIB_KAPACK_KAX050_INC
-*
-*
-* kax050.inc
-*
- COMMON /KAX050/ MSG
- CHARACTER MSG*(MAXMSG)
-
-#endif
diff --git a/src/packlib/kapack/kapack/kax060.inc b/src/packlib/kapack/kapack/kax060.inc
deleted file mode 100644
index 3062868..0000000
--- a/src/packlib/kapack/kapack/kax060.inc
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: kax060.inc,v 1.1.1.1 1996/03/08 11:40:54 mclareni Exp $
-*
-* $Log: kax060.inc,v $
-* Revision 1.1.1.1 1996/03/08 11:40:54 mclareni
-* Kapack
-*
-*
-#ifndef CERNLIB_KAPACK_KAX060_INC
-#define CERNLIB_KAPACK_KAX060_INC
-*
-*
-* kax060.inc
-*
- COMMON /KAX060/ IOPTNS(1:MAXLUN)
-
-#endif
diff --git a/src/packlib/kapack/kapack/kax070.inc b/src/packlib/kapack/kapack/kax070.inc
deleted file mode 100644
index e6048f9..0000000
--- a/src/packlib/kapack/kapack/kax070.inc
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: kax070.inc,v 1.1.1.1 1996/03/08 11:40:54 mclareni Exp $
-*
-* $Log: kax070.inc,v $
-* Revision 1.1.1.1 1996/03/08 11:40:54 mclareni
-* Kapack
-*
-*
-#ifndef CERNLIB_KAPACK_KAX070_INC
-#define CERNLIB_KAPACK_KAX070_INC
-*
-*
-* kax070.inc
-*
- COMMON /KAX070/ LOCKI(1:LLOCKQ), LOCKU(1:LLOCKQ), LOCKN(1:LLOCKQ)
-
-#endif
diff --git a/src/packlib/kapack/kapack/kax080.inc b/src/packlib/kapack/kapack/kax080.inc
deleted file mode 100644
index 9b3b4f6..0000000
--- a/src/packlib/kapack/kapack/kax080.inc
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: kax080.inc,v 1.1.1.1 1996/03/08 11:40:54 mclareni Exp $
-*
-* $Log: kax080.inc,v $
-* Revision 1.1.1.1 1996/03/08 11:40:54 mclareni
-* Kapack
-*
-*
-#ifndef CERNLIB_KAPACK_KAX080_INC
-#define CERNLIB_KAPACK_KAX080_INC
-*
-*
-* kax080.inc
-*
- COMMON /KAX080/ IXAF,IXAL,IXALEV(0:LXAQ),IXAPTR(0:LXAQ),
- + IXAKEY(1:1+MAXNAM,0:LXAQ)
-
-#endif
diff --git a/src/packlib/kapack/kapack/kax090.inc b/src/packlib/kapack/kapack/kax090.inc
deleted file mode 100644
index 915ff21..0000000
--- a/src/packlib/kapack/kapack/kax090.inc
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: kax090.inc,v 1.1.1.1 1996/03/08 11:40:54 mclareni Exp $
-*
-* $Log: kax090.inc,v $
-* Revision 1.1.1.1 1996/03/08 11:40:54 mclareni
-* Kapack
-*
-*
-#ifndef CERNLIB_KAPACK_KAX090_INC
-#define CERNLIB_KAPACK_KAX090_INC
-*
-*
-* kax090.inc
-*
- COMMON /KAX090/ IXDF,IXDL,IXDLEV(0:LXDQ),
- + IXDKEY(1:1+MAXNAM,0:LXDQ)
-
-#endif
diff --git a/src/packlib/kapack/kapack/kax0a0.inc b/src/packlib/kapack/kapack/kax0a0.inc
deleted file mode 100644
index f32ebfd..0000000
--- a/src/packlib/kapack/kapack/kax0a0.inc
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: kax0a0.inc,v 1.1.1.1 1996/03/08 11:40:54 mclareni Exp $
-*
-* $Log: kax0a0.inc,v $
-* Revision 1.1.1.1 1996/03/08 11:40:54 mclareni
-* Kapack
-*
-*
-#ifndef CERNLIB_KAPACK_KAX0A0_INC
-#define CERNLIB_KAPACK_KAX0A0_INC
-*
-*
-* kax0a0.inc
-*
- COMMON /KAX0A0/ IA(1:LBUF)
-
-#endif
diff --git a/src/packlib/kapack/kapack/kax0b0.inc b/src/packlib/kapack/kapack/kax0b0.inc
deleted file mode 100644
index 08a77fc..0000000
--- a/src/packlib/kapack/kapack/kax0b0.inc
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: kax0b0.inc,v 1.1.1.1 1996/03/08 11:40:54 mclareni Exp $
-*
-* $Log: kax0b0.inc,v $
-* Revision 1.1.1.1 1996/03/08 11:40:54 mclareni
-* Kapack
-*
-*
-#ifndef CERNLIB_KAPACK_KAX0B0_INC
-#define CERNLIB_KAPACK_KAX0B0_INC
-*
-*
-* kax0b0.inc
-*
- COMMON /KAX0B0/ IB(1:LBUF)
-
-#endif
diff --git a/src/packlib/kapack/kapack/pilot.h b/src/packlib/kapack/kapack/pilot.h
deleted file mode 100644
index 529d53f..0000000
--- a/src/packlib/kapack/kapack/pilot.h
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: pilot.h,v 1.1.1.1 1996/03/08 11:40:54 mclareni Exp $
-*
-* $Log: pilot.h,v $
-* Revision 1.1.1.1 1996/03/08 11:40:54 mclareni
-* Kapack
-*
-*
-#if defined(CERNLIB_IBMVM) || defined(CERNLIB_IBMMVS)
-#ifndef CERNLIB_IBM
-#define CERNLIB_IBM
-#endif
-#endif
-
-#if defined(CERNLIB_CRAY) || defined(CERNLIB_CDC)
-#ifndef CERNLIB_SINGLE
-#define CERNLIB_SINGLE
-#endif
-#endif
-
-#if defined(CERNLIB_UNIX) && !defined(CERNLIB_SINGLE)
-#ifndef CERNLIB_DOUBLE
-#define CERNLIB_DOUBLE
-#endif
-#endif
-
-#if defined(CERNLIB_IBM) || defined(CERNLIB_VAX) || defined(CERNLIB_NORD)
-#ifndef CERNLIB_DOUBLE
-#define CERNLIB_DOUBLE
-#endif
-#endif
-
diff --git a/src/packlib/kapack/test/Imakefile b/src/packlib/kapack/test/Imakefile
deleted file mode 100644
index cec873d..0000000
--- a/src/packlib/kapack/test/Imakefile
+++ /dev/null
@@ -1,32 +0,0 @@
-
-DefinePackageLibrary(NullParameter)
-
-CernlibFortranProgramTarget(kapack,test1.o,$(PACKAGE_LIB),$(PACKAGE_LIB),kernlib)
-
-/* the kapack test, or better kamake asks for a file name only in unix.
- * on VMS, the file is opened on unit 11, resulting in for011.dat
- * other systems ?
- */
-
-#if defined(CERNLIB_UNIX)
-
-TestTarget(kapack,NullParameter,test.input)
-
-CopyFile(kapack.input,test.input)
-
-clean::
- RemoveFile(kapackt.dat)
-
-#elif defined(CERNLIB_VAX)
-
-TestTarget(kapack,NullParameter,NullParameter)
-
-clean::
- RemoveFile(FOR011.DAT)
-
-#elif 1
-
-test::
- echo "You must still add the test for Kapack to the Imakefile."
-
-#endif
diff --git a/src/packlib/kapack/test/kapack.input b/src/packlib/kapack/test/kapack.input
deleted file mode 100644
index 2344902..0000000
--- a/src/packlib/kapack/test/kapack.input
+++ /dev/null
@@ -1 +0,0 @@
-kapackt.dat
diff --git a/src/packlib/kapack/test/test1.F b/src/packlib/kapack/test/test1.F
deleted file mode 100644
index a62e0ee..0000000
--- a/src/packlib/kapack/test/test1.F
+++ /dev/null
@@ -1,119 +0,0 @@
-*
-* $Id: test1.F,v 1.1.1.1 1996/03/08 11:40:53 mclareni Exp $
-*
-* $Log: test1.F,v $
-* Revision 1.1.1.1 1996/03/08 11:40:53 mclareni
-* Kapack
-*
-*
-#include "kapack/pilot.h"
-#if defined(CERNLIB_CDC)
- PROGRAM KATEST (INPUT,OUTPUT,TAPE5=INPUT,TAPE6=OUTPUT)
-#endif
-#if defined(CERNLIB_NORD)
- OPEN ( UNIT=11, FILE='KAPTEST:KAPC', ACCESS='DIRECT')
-*
-*.....ACCESS COULD BE 'DC' IF ENOUGH CONTIGUOUS SPACE ON DISK
-*
- OPEN ( UNIT= 6 , FILE='TERMINAL' )
-#endif
- CALL KATST1(11)
- CALL KATST2(11)
- CALL KASTOP
- END
- SUBROUTINE KATST1(LUN)
-*
-*.....KAPACK TEST 1: CREATE A KA-FILE, ADD, RETRIEVE AND VERIFY RECORDS
-*
-#include "kapack/kax000.inc"
-*
- CHARACTER*5 MAJOR, MINOR
- INTEGER IA(10000)
- DATA IA/10000*0/
-*
-*-----------------------------------------------------------------------
-*
-*.....SET OPTIONS
- CALL KAOPTN(LUN,'MODIFY=YES',IRC)
-*
-*.....CREATE A KA-FILE
- HMEG = 343400. * LWORD * 1.3 / (1 024. * 1 024. )
- CALL KAMAKE(LUN,HMEG,0,IRC)
-*
-*.....ADD, RETRIEVE AND VERIFY SOME RECORDS
- MAJOR = '1'
- CALL KAADDM(LUN,MAJOR,0,99999,IRC)
- CALL KAHOLD(LUN,MAJOR,IRC)
- DO 1 J = 1, 100
- WRITE(MINOR,100) J
- NWORDS = J
- IA(NWORDS) = NWORDS
- CALL KAADD(LUN,MAJOR,MINOR,IA,NWORDS,IRC)
- IA(NWORDS) = 0
- CALL KAGET(LUN,MAJOR,MINOR,'READ',IA,NWORDS,IRC)
- IF ( IA(NWORDS) .NE. NWORDS ) GO TO 10
- IA(NWORDS) = 0
- 1 CONTINUE
- CALL KAFREE(LUN,MAJOR,IRC)
-*
- MAJOR = '2'
- CALL KAADDM(LUN,MAJOR,0,99999,IRC)
- CALL KAHOLD(LUN,MAJOR,IRC)
- DO 2 J = 1, 100
- WRITE(MINOR,100) J
- NWORDS = J*J
- IA(NWORDS) = NWORDS
- CALL KAADD(LUN,MAJOR,MINOR,IA,NWORDS,IRC)
- IA(NWORDS) = 0
- CALL KAGET(LUN,MAJOR,MINOR,'READ',IA,NWORDS,IRC)
- IF ( IA(NWORDS) .NE. NWORDS ) GO TO 10
- IA(NWORDS) = 0
- 2 CONTINUE
- CALL KAFREE(LUN,MAJOR,IRC)
-*
-*.....SUCCESSFUL COMPLETION
- WRITE(6,101)
- RETURN
-*
-*.....ERROR PROCESSING
- 10 WRITE(6,110) MAJOR, MINOR, NWORDS, IA(NWORDS)
- CALL KASTOP
- STOP
-*
- 100 FORMAT(I5)
- 101 FORMAT(' ***** TEST 1 COMPLETED SUCCESSFULLY *****')
- 110 FORMAT(' VERIFICATION ERROR FOR RECORD ',2A,', NWORDS = ',I10,
- + ', IA(NWORDS) = ',I10)
-*
- END
- SUBROUTINE KATST2(LUN)
-*
-*.....KAPACK TEST 2: DELETE THE ENTRIES CREATED BY KATST1
-*
- CHARACTER*5 MAJOR, MINOR
-*
-*-----------------------------------------------------------------------
-*
-*.....SET OPTIONS
- CALL KAOPTN(LUN,'MODIFY=YES',IRC)
-*
-*.....DELETE ALL THE ENTRIES
- DO 2 I = 2, 1, -1
- WRITE(MAJOR,100) I
- CALL KAHOLD(LUN,MAJOR,IRC)
- DO 1 J = 100, 1, -1
- WRITE(MINOR,100) J
- CALL KADEL(LUN,MAJOR,MINOR,IRC)
- 1 CONTINUE
- CALL KAFREE(LUN,MAJOR,IRC)
- CALL KADELM(LUN,MAJOR,IRC)
- 2 CONTINUE
-*
-*.....SUCCESSFUL COMPLETION
- WRITE(6,101)
- RETURN
-*
- 100 FORMAT(I5)
- 101 FORMAT(' ***** TEST 2 COMPLETED SUCCESSFULLY *****')
-*
- END
diff --git a/src/packlib/kapack/versions/patchy_flags b/src/packlib/kapack/versions/patchy_flags
deleted file mode 100644
index 4723e4f..0000000
--- a/src/packlib/kapack/versions/patchy_flags
+++ /dev/null
@@ -1,70 +0,0 @@
-*
-* $Id: patchy_flags,v 1.1.1.1 1996/03/08 11:40:54 mclareni Exp $
-*
-* $Log: patchy_flags,v $
-* Revision 1.1.1.1 1996/03/08 11:40:54 mclareni
-* Kapack
-*
-*
-* Flags patch
-* This directory was created from kapack.car patch fkapack
-#if defined(CERNLIB_IBMAIX)
-#ifndef CERNLIB_AIX370
-#define CERNLIB_AIX370
-#endif
-#endif
-#if defined(CERNLIB_IBMMVS)||defined(CERNLIB_IBMVM)
-#ifndef CERNLIB_IBM
-#define CERNLIB_IBM
-#endif
-#endif
-#if defined(CERNLIB_ALLIANT)||defined(CERNLIB_APOLLO)||defined(CERNLIB_CONVEX)||defined(CERNLIB_IBMAIX)||defined(CERNLIB_NECSX)||defined(CERNLIB_UNISYS)
-#ifndef CERNLIB_UNIX
-#define CERNLIB_UNIX
-#endif
-#endif
-#if defined(CERNLIB_DECS)||defined(CERNLIB_HPUX)||defined(CERNLIB_IBMRT)||defined(CERNLIB_SGI)||defined(CERNLIB_SUN)
-#ifndef CERNLIB_UNIX
-#define CERNLIB_UNIX
-#endif
-#endif
-#if defined(CERNLIB_AMIGAUX)||defined(CERNLIB_CDCUX)||defined(CERNLIB_GOULD)||defined(CERNLIB_MACMPW)||defined(CERNLIB_MACAUX)||defined(CERNLIB_MIPS)
-#ifndef CERNLIB_UNIX
-#define CERNLIB_UNIX
-#endif
-#endif
-#if defined(CERNLIB_IBMPC)||defined(CERNLIB_IBMUX)||defined(CERNLIB_NEXT)||defined(CERNLIB_LINUX)
-#ifndef CERNLIB_UNIX
-#define CERNLIB_UNIX
-#endif
-#endif
-#if defined(CERNLIB_AIX370)||defined(CERNLIB_IPSC)
-#ifndef CERNLIB_UNIX
-#define CERNLIB_UNIX
-#endif
-#endif
-#if defined(CERNLIB_VAXVMS)||defined(CERNLIB_VAXULX)
-#ifndef CERNLIB_VAX
-#define CERNLIB_VAX
-#endif
-#endif
-#if defined(CERNLIB_CDC)||defined(CERNLIB_CRAY)
-#ifndef CERNLIB_SINGLE
-#define CERNLIB_SINGLE
-#endif
-#endif
-#if defined(CERNLIB_IBM)||defined(CERNLIB_VAX)||defined(CERNLIB_NORD)
-#ifndef CERNLIB_DOUBLE
-#define CERNLIB_DOUBLE
-#endif
-#endif
-#if (defined(CERNLIB_UNIX))&&(!defined(CERNLIB_SINGLE))
-#ifndef CERNLIB_DOUBLE
-#define CERNLIB_DOUBLE
-#endif
-#endif
-#if defined(CERNLIB_IBM)
-#ifndef CERNLIB_QMIBMXA
-#define CERNLIB_QMIBMXA
-#endif
-#endif
diff --git a/src/packlib/kapack/versions/v100209.dat b/src/packlib/kapack/versions/v100209.dat
deleted file mode 100644
index bd1932a..0000000
--- a/src/packlib/kapack/versions/v100209.dat
+++ /dev/null
@@ -1,194 +0,0 @@
-*
-* $Id: v100209.dat,v 1.1.1.1 1996/03/08 11:40:54 mclareni Exp $
-*
-* $Log: v100209.dat,v $
-* Revision 1.1.1.1 1996/03/08 11:40:54 mclareni
-* Kapack
-*
-*
-* Previous versions
-*-- FIRST VERSION OF PAM 15-JULY-1983 VERSION 1.00
-*--
-*-- MODIFICATION 19-NOV -1983 VERSION 1.01
-*-- USER-CALLABLE SUBROUTINE KAMSG ADDED.
-*-- SUBROUTINE KAXMSG MODIFIED TO SUPPORT SUBROUTINE
-*-- KAMSG BY DETECTING USER MESSAGES AND PREFIXING THEM
-*-- WITH THE ID CRNKA000 AND A TIME AND DATE STAMP.
-*-- SUBROUTINE KAOPTN MODIFIED TO WRITE A MESSAGE IN THE
-*-- TRANSACTION LOG WHEN CALLED WITH OPTION LUNLOG=0
-*-- (THIS OPTION HAS THE EFFECT OF SWITCHING OFF THE LOG
-*-- AND PRIOR TO THIS MODIFICATION THERE WAS NO INDICATION
-*-- THAT THIS HAD OCCURRED).
-*-- STATEMENT NUMBERS CHANGED IN SUBROUTINES KATST1 AND KATST2.
-*-- REDUNDANT STATEMENT 'NWORDS = -1' REMOVED FROM
-*-- SUBROUTINE KAXLS1.
-*-- SUBROUTINES KASEQ AND KASEQM REPLACED BY HIGH-SPEED
-*-- VERSIONS. OTHER SUBPROGRAMS AFFECTED: KAXINI, KAXINR, KAXLOC
-*--
-*-- CHANGES FROM 1.01 - 13-FEB -1984 VERSION 1.02
-*--
-*-- (1) SUBROUTINE KAMAKE MODIFIED TO WRITE A MINIMUM OF 2 BLOCKS
-*-- (TO AVOID RECORD NUMBER OUT OF RANGE ERRORS).
-*-- (2) C REPLACED BY *IN COLUMN 1 OF COMMENTS.
-*-- (3) & REPLACED BY + IN COLUMN 6 OF CONTINUATION LINES.
-*-- (4) SOME MESSAGES SHORTENED (FOR CRAY).
-*-- (5) REWIND OF SEQUENTIAL FILE ADDED TO SUBROUTINE KACOPY.
-*-- (6) SUBROUTINE KAT MODIFIED TO PRINT THE PAM TITLE IN THE SAME
-*-- FORMAT AS OTHER MESSAGES. SUBROUTINE KAXMSG HAS BEEN
-*-- MODIFIED TO SUPPORT THIS AND IS NOW AN INTERFACE TO A NEW
-*-- SUBROUTINE KAXED WHICH PERFORMS THE MESSAGE EDITING FORMERLY
-*-- PERFORMED BY KAXMSG.
-*-- (7) INTERNAL CHARACTER REPRESENTATION CHANGED: NULL=0, BLANK=99
-*-- SUBPROGRAMS AFFECTED: KAXCHA, KAXICH, KAXINR & COMMON KAX004.
-*-- (8) FUNCTION KAXXNK SPLIT INTO TWO FUNCTIONS, KAXNAM AND KAXE2I.
-*-- (9) FUNCTION KAXXKN MODIFIED SLIGHTLY AND RENAMED KAXI2E.
-*--
-*-- CHANGES FROM 1.02 - 05-APR -1984 VERSION 1.03
-*-- (1) ARRAYS MAXK AND MAXP ADDED TO COMMON/KAX003/. SUBPROGRAMS
-*-- KAXINI, KAXINR AND KAXOPN MODIFIED ACCORDINGLY.
-*-- (2) ERROR IN KAXINI PREVENTING DETECTION OF LUN CHANGE,
-*-- CORRECTED, (AFFECTED APPLICATIONS USING MULTIPLE UNITS
-*-- WITH DIFFERENT ATTRIBUTES).
-*-- (3) KASEQ AND KASEQM MODIFIED TO DETECT CHANGE OF UNIT.
-*--
-*-- CHANGES FROM 1.03
-*-- (1) PERFORMANCE IMPROVEMENT TO REDUCE THE CPU TIME AND NUMBER
-*-- OF I/O OPERATIONS IN APPLICATIONS WHICH MAKE MULTIPLE CALLS
-*-- TO KAPACK WITH THE SAME UNIT NUMBER AND MAJOR NAME.
-*-- (2) 'RETURN=YES' ENFORCED DURING KALIST PROCESSING.
-*-- (3) FORMAT OF KALIST OUTPUT CHANGED.
-*-- (4) CMS FLAG INTRODUCED TO CREATE KA-FILES WITH A BLOCK SIZE
-*-- OF 4K BYTES UNDER THE IBM VM/CMS OPERATING SYSTEM.
-*-- (5) TEST PROGRAM CHANGED TO RETRIEVE AND VERIFY THE RECORDS
-*-- WHICH ARE WRITTEN.
-*-- (6) COMMON BLOCKS RENAMED.
-*-- (7) CORRECTION TO KASEQ AND KASEQM.
-*-- (8) BUG FIXED IN VAX VERSION IN PRINTING DATE AND TIME.
-*-- (9) TO ENABLE FILE SHARING ON VAX, THE 'SHARED' KEYWORD HAS BEEN
-*-- ADDED TO THE OPEN STATEMENT IN SUBROUTINE KAXOPN.
-*-- (10) STATUS='UNKNOWN' EXPLICITLY SPECIFIED IN OPEN STATEMENTS TO
-*-- ELIMINATE ERROR MESSAGE ON VAX.
-*-- (11) INTERNAL CHARACTER REPRESENTATION CHANGED. SUBPROGRAMS
-*-- AFFECTED: KAXC2I (FORMERLY KAXICH), KAXI2C (FORMERLY KAXCHA).
-*-- KA-FILES WHICH WERE CREATED WITH EARLIER VERSIONS OF KAPACK
-*-- CANNOT BE PROCESSED WITH VERSION 2 OR LATER VERSIONS AND
-*-- ATTEMPTS TO DO SO WILL PROVOKE ERROR CRNKA246. IN ORDER TO
-*-- CONTINUE USING THESE KA-FILES THEY MUST BE CONVERTED BY A
-*-- CALL TO SUBROUTINE KA1TO2 WHICH HAS BEEN ADDED TO THIS PAM
-*-- FILE. IN ORDER TO CONVERT A KA-FILE THE FOLLOWING STEPS
-*-- SHOULD BE TAKEN:
-*-- (1) USE SUBROUTINE KACOPY TO MAKE A BACKUP OR COPY OF
-*-- THE KA-FILE.
-*-- (2) EXECUTE A PROGRAM WHICH CALLS KA1TO2 IN THE FOLLOWING
-*-- WAY:
-*-- CALL KA1TO2(LUN)
-*-- WHERE LUN IS AN INTEGER WHICH IDENTIFIES THE UNIT TO
-*-- WHICH THE ORIGINAL KA-FILE IS CONNECTED.
-*-- (3) ENSURE THAT THE PROGRAM TERMINATES NORMALLY AND
-*-- PRODUCES THE MESSAGE CRNKA500.
-*-- (4) IF SUBSEQUENT PROCESSING OF THE CONVERTED KA-FILE IS
-*-- SUCCESSFUL THE COPY MAY BE DELETED.
-*--
-*-- CHANGES FROM 2.00
-*-- (1) ASSEMBLY VERSION OF KAXRCL MODIFIED FOR ASSEMBLY UNDER CMS.
-*-- (2) THE PERCENTAGE BLOCK UTILIZATION IS INDICATED IN MESSAGE
-*-- CRNKA240 ISSUED BY KAXOPN.
-*-- (3) EXECUTION TERMINATES IF KAXOPN DETERMINES THAT MODIFY=YES
-*-- HAS BEEN REQUESTED AND THE FREE SPACE IS BELOW A THRESHOLD.
-*-- (4) KAMAKE MODIFIED TO WRITE A MINIMUM OF 3 BLOCKS FOR
-*-- COMPATIBILITY WITH THE KAXOPN THRESHOLD CHECK.
-*-- (5) KACOPY MODIFIED TO PREVENT COPYING TO AN OUTPUT FILE
-*-- WHICH HAS ALREADY BEEN OPENED AS A KA-FILE IN THE SAME JOB.
-*-- (6) KACOPY MODIFIED TO ENABLE A KA-FILE TO BE EXPANDED.
-*-- (7) SUBROUTINE KALEN INTRODUCED TO RETRIEVE THE LENGTH
-*-- ATTRIBUTES OF A RECORD.
-*-- (8) FUNCTION KAXLOC RENAMED KAXGET.
-*-- (9) LOGICAL FUNCTIONS REPLACED BY SUBROUTINES WITH ALTERNATE
-*-- RETURNS.
-*--
-*-- Changes from 2.01
-*-- (1) Internal restructuring for support of asynchronous concurrent
-*-- access, (ACA).
-*-- (2) KAXOPN modified to use COMMON/KAX0B0/ in place of /KAX0A0/.
-*-- (3) Former contents of COMMON/KAX070/ merged with COMMON/KAX020/.
-*-- COMMON/KAX070/ now used as a lock queue for ACA operations.
-*-- (4) KAXFBK and KAXGBK modified to avoid block contention with
-*-- ACA subroutines.
-*-- (5) Some adjustable array declarators replaced by assumed-size
-*-- array declarators to avoid an error on VAX for zero-length
-*-- records.
-*-- (6) Patchy flag 'CERN' removed.
-*-- (7) New user-callable subroutines: KAFREE, KAHOLD, KARLSE,
-*-- KASTOP
-*-- (8) New internal subroutines: KAXAGE, KAXJID, KAXOLK, KAXRLK,
-*-- KAXTLK
-*-- (9) Test job modified to call KAFREE, KAHOLD and KASTOP.
-*-- (10) Additional installation parameters checked by KAXINR.
-*--
-C Changes from 2.02
-C (1) Subroutine KAXFBK modified to eliminate optimization action
-C on local variables.
-C (2) Buffer length increased to 1500 words in CMS version.
-C (3) Bug corrected in KAXINI affecting the setting of the error
-C unit number (LUNERR).
-C (4) Patchy flag 'APOLLO' added.
-C (5) Code added to KAMAKE and KAXOPN to obtain the file name on
-C Apollo systems.
-C (6) RETURN statements added to KAXE2I and KAXI2E to circumvent
-C a NORD compiler bug.
-C (7) Error in setting the value of NBLKS corrected in KAXINI.
-C (8) Messages CRNKA261 and CRNKA271 expanded.
-C
-C CHANGES FROM 2.03
-C (1) Maximum name length changed from 50 to 100 characters.
-C (2) New user-callable subprograms:
-C KAPRE - retrieve the record preceding the one specified
-C KAPREM - retrieve the major name preceding the one specified
-C KAPRIK - print the values of the keys in a locked KA-file
-C (3) In the VAX version, the READONLY parameter is used when
-C opening a KA-FILE with MODIFY=NO in effect. If KAOPTN
-C is called with the MODIFY option for an open file, the
-C file is closed and re-opened accordingly.
-C (4) Minor changes to messages CRNKA080, CRNKA123, CRNKA124,
-C CRNKA125, CRNKA132 and CRNKA133.
-C
-C CHANGES FROM 2.04
-C (1) Alternative calling sequence provided for KAMAKE:
-C CALL KAMAKE(LUN,SIZE,0,IRC)
-C where SIZE is a real number which specifies the total
-C size of the KA-file in megabytes, (no overhead is added).
-C (2) References to KAXC2I and KAXI2C replaced by inline code.
-C
-C CHANGES FROM 2.05
-C (1) Major name stack implemented to eliminate a search of
-C the major tree for the most recently used major names.
-C (2) KAXADD modified to ensure that there are sufficient
-C free blocks before a new entry is added.
-C (3) Code added to KACOPY to ensure that the final block of
-C the output file has been written correctly when mode>1.
-C (4) Messages CRNKA181, CRNKA182, CRNKA191, CRNKA192,
-C CRNKA241, CRNKA242 modified.
-C (5) Sample IBM installation job modified to correctly
-C process assembler source.
-C
-C CHANGES FROM 2.06
-C Bug fixed in KAXFBK which caused 'CORRUPT KAFILE' abends in
-C rare cases (involving repeated updates of the same records).
-C Bug fixed in KACOPY giving spurious error message at end of copy.
-C Bug fixed in KAXMAJ when making subsequent calls with different
-C MAJOR name but the same MINOR name (through KASEQ).
-C Bug fixed in KASEQM when called from KAPRIK.
-C All these errors were introduced in version 2.06.
-C
-C CHANGES FROM 2.07
-C Bug fixed in KAXDEL when called from KADEL which led to
-C deletion of wrong index record pointers in rare cases. The
-C minor records were still in the data but could not be found
-C other than by sequential reading. This was a very old bug.
-C Bug fixed in KAXMAJ when called from KADELM which caused
-C deletion of a previously referenced major name in rare cases.
-C This bug was introduced at version 2.06.
-C
-C CHANGES FROM 2.07
-C CRAY FLAG ADDED
-C
diff --git a/src/packlib/kapack/versions/v210.dat b/src/packlib/kapack/versions/v210.dat
deleted file mode 100644
index e2157ba..0000000
--- a/src/packlib/kapack/versions/v210.dat
+++ /dev/null
@@ -1,13 +0,0 @@
-*
-* $Id: v210.dat,v 1.1.1.1 1996/03/08 11:40:54 mclareni Exp $
-*
-* $Log: v210.dat,v $
-* Revision 1.1.1.1 1996/03/08 11:40:54 mclareni
-* Kapack
-*
-*
-* Version 2.10
-C- APOLLO CODE CHANGED IN KACOPY AND KA1TO2
-C- BUG CORRECTED IN KAMAKE
-C- INSTALL PATCH REMOVED - SEE INSTALL PAM
-C
diff --git a/src/packlib/kapack/versions/v211.dat b/src/packlib/kapack/versions/v211.dat
deleted file mode 100644
index b42ed3a..0000000
--- a/src/packlib/kapack/versions/v211.dat
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: v211.dat,v 1.1.1.1 1996/03/08 11:40:54 mclareni Exp $
-*
-* $Log: v211.dat,v $
-* Revision 1.1.1.1 1996/03/08 11:40:54 mclareni
-* Kapack
-*
-*
-* Version 2.11 881101
-C- OPEN CORRECTED FOR THE CRAY AND THE NORD.
-C- CORRECT BUG IN KAPUTM WHEREBY CHANGING MAJOR NAME
-C LENGTHS AND CONTINUING EXECUTION WAS NOT PROPERLY
-C HANDLED.
-C- ADD A CHECK INTO KAXWRT TO DETECT THE CREATION OF
-C ILLEGAL FREE BLOCK POINTERS.
-C- CRAYCOS FLAG ADDED FOR CRAY COS OPERATING SYSTEM:
-C +USE,CRAY -> UNICOS VERSION
-C +USE,CRAYCOS -> COS VERSION
-C
diff --git a/src/packlib/kapack/versions/v212.dat b/src/packlib/kapack/versions/v212.dat
deleted file mode 100644
index 3caccf2..0000000
--- a/src/packlib/kapack/versions/v212.dat
+++ /dev/null
@@ -1,11 +0,0 @@
-*
-* $Id: v212.dat,v 1.1.1.1 1996/03/08 11:40:54 mclareni Exp $
-*
-* $Log: v212.dat,v $
-* Revision 1.1.1.1 1996/03/08 11:40:54 mclareni
-* Kapack
-*
-*
-* Version 2.12
-C- MAXMSG SET TO 274 FOR THE CRAY
-C
diff --git a/src/packlib/kapack/versions/v213.dat b/src/packlib/kapack/versions/v213.dat
deleted file mode 100644
index ca08a3c..0000000
--- a/src/packlib/kapack/versions/v213.dat
+++ /dev/null
@@ -1,13 +0,0 @@
-*
-* $Id: v213.dat,v 1.1.1.1 1996/03/08 11:40:54 mclareni Exp $
-*
-* $Log: v213.dat,v $
-* Revision 1.1.1.1 1996/03/08 11:40:54 mclareni
-* Kapack
-*
-*
-* Version 2.13 900212 18.30
-C- Introduce *KAPACK patch
-C- Rename patch CDES > KACDES, TEST > KATEST
-C- Add FORTRAN versions of KAXAGE, KAXRCL (for IBM/XA)
-C
diff --git a/src/packlib/kapack/versions/v214.dat b/src/packlib/kapack/versions/v214.dat
deleted file mode 100644
index 12bc651..0000000
--- a/src/packlib/kapack/versions/v214.dat
+++ /dev/null
@@ -1,14 +0,0 @@
-*
-* $Id: v214.dat,v 1.1.1.1 1996/03/08 11:40:54 mclareni Exp $
-*
-* $Log: v214.dat,v $
-* Revision 1.1.1.1 1996/03/08 11:40:54 mclareni
-* Kapack
-*
-*
-* Version 2.14 901031 15.30
-C- Introduce the following patches/flags:
-C > SKAPACK : source patch
-C > FKAPACK : flags patch (renamed from KAFLAGS)
-C > DKAPACK : documentation patch
-C
diff --git a/src/packlib/kapack/versions/v215.dat b/src/packlib/kapack/versions/v215.dat
deleted file mode 100644
index bd90fa1..0000000
--- a/src/packlib/kapack/versions/v215.dat
+++ /dev/null
@@ -1,14 +0,0 @@
-*
-* $Id: v215.dat,v 1.1.1.1 1996/03/08 11:40:54 mclareni Exp $
-*
-* $Log: v215.dat,v $
-* Revision 1.1.1.1 1996/03/08 11:40:54 mclareni
-* Kapack
-*
-*
-* Version 2.15 910209 18.20
-C- Introduce the following patches/flags:
-C > HPUX,MIPS,IBMVM,IBMMVS,VAXVMS,VAXULX
-C
-C- Corrections:
-C > P=KAPACK ,D=KAXAGE : Use new routine SLEEPF on all systems
diff --git a/src/packlib/kapack/versions/v216.dat b/src/packlib/kapack/versions/v216.dat
deleted file mode 100644
index 41c9e03..0000000
--- a/src/packlib/kapack/versions/v216.dat
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: v216.dat,v 1.1.1.1 1996/03/08 11:40:54 mclareni Exp $
-*
-* $Log: v216.dat,v $
-* Revision 1.1.1.1 1996/03/08 11:40:54 mclareni
-* Kapack
-*
-*
-* Version 2.16 930902 11.20
-C- Introduce the following patches/flags:
-C > NEXT,LINUX
-C
diff --git a/src/packlib/kapack/versions/v217.dat b/src/packlib/kapack/versions/v217.dat
deleted file mode 100644
index 0084747..0000000
--- a/src/packlib/kapack/versions/v217.dat
+++ /dev/null
@@ -1,11 +0,0 @@
-*
-* $Id: v217.dat,v 1.1.1.1 1996/03/08 11:40:54 mclareni Exp $
-*
-* $Log: v217.dat,v $
-* Revision 1.1.1.1 1996/03/08 11:40:54 mclareni
-* Kapack
-*
-*
-* This directory was created from kapack.car patch history
-C KAPACK 2.17 950217 11.50 CERN Program Library Z303 KAPACK
-* 17-FEB-95 add SAVE statement to KASEQM, KAPREM (Lynn Garren)
diff --git a/src/packlib/kernlib/Imakefile b/src/packlib/kernlib/Imakefile
deleted file mode 100644
index a939fd4..0000000
--- a/src/packlib/kernlib/Imakefile
+++ /dev/null
@@ -1,22 +0,0 @@
-
-#define IHaveSubdirs
-#define PassCDebugFlags
-
-AllTarget(kernlib)
-
-LIBDIRS= kernbit kerngen kernnum umon
-
-SUBDIRS= $(LIBDIRS)
-
-TopOfPackage(kernlib)
-
-SubdirLibraryTarget(kernlib,$(LIBDIRS))
-
-InstallLibrary(kernlib,$(CERN_LIBDIR))
-InstallLibraryAlias(kernlib,kernlib-shift,$(CERN_LIBDIR))
-
-test:: LibraryTargetName(kernlib)
-
-TestSubdirs($(SUBDIRS))
-
-InstallIncludeSubdirs($(LIBDIRS))
diff --git a/src/packlib/kernlib/kernbit/Imakefile b/src/packlib/kernlib/kernbit/Imakefile
deleted file mode 100644
index 9adf66e..0000000
--- a/src/packlib/kernlib/kernbit/Imakefile
+++ /dev/null
@@ -1,36 +0,0 @@
-
-#define IHaveSubdirs
-#define PassCDebugFlags
-
-
-LIBDIRS= i303 j530 m429 m433 m437 m439 m442 m443 t000 z009 z265
-
-#if defined(CERNLIB_VAXVMS)
-LIBDIRS := $(LIBDIRS) m231asm z313
-#endif
-
-#if defined(CERNLIB_VAX) && ! defined(CERNLIB_QMALPH)
-LIBDIRS := $(LIBDIRS) m233vax
-#endif
-
-#if defined(CERNLIB_UNIX) && ! defined(CERNLIB_OS9)
-LIBDIRS += z268
-#endif
-
-#if defined(CERNLIB_HPUX)
-LIBDIRS += t002
-#endif
-
-#if defined(CERNLIB_WINNT)
-LIBDIRS += z264
-#endif
-
-SUBDIRS= $(LIBDIRS) kernbit test
-
-TopOfPackage(kernbit)
-
-SubdirLibraryTarget(kernbit,$(LIBDIRS))
-
-TestSubdirs(test)
-
-InstallIncludeSubdirs(kernbit)
diff --git a/src/packlib/kernlib/kernbit/history/v105.dat b/src/packlib/kernlib/kernbit/history/v105.dat
deleted file mode 100644
index 9e5b8ec..0000000
--- a/src/packlib/kernlib/kernbit/history/v105.dat
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: v105.dat,v 1.1.1.1 1996/02/15 17:47:45 mclareni Exp $
-*
-* $Log: v105.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:47:45 mclareni
-* Kernlib
-*
-*
-* Version 1.05 870529 16.00
-C- Deletions:
-C > M441 BITPAK, M508 BITPOS removed into normal KERN-pams
-C
diff --git a/src/packlib/kernlib/kernbit/history/v106.dat b/src/packlib/kernlib/kernbit/history/v106.dat
deleted file mode 100644
index f345006..0000000
--- a/src/packlib/kernlib/kernbit/history/v106.dat
+++ /dev/null
@@ -1,15 +0,0 @@
-*
-* $Id: v106.dat,v 1.1.1.1 1996/02/15 17:47:45 mclareni Exp $
-*
-* $Log: v106.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:47:45 mclareni
-* Kernlib
-*
-*
-* Version 1.06 910408 4.40
-C- Additions:
-C > M233 Moved from GENLIB as it is needed by CSPACK
-C > Z265 SLEEPF MVS version, to join KERNIBM next CNL
-C > Z037 VAXAST VAX version, to join KERNVAX next CNL
-C > T000 INITC Initialize C from Fortran (only on IBM)
-C
diff --git a/src/packlib/kernlib/kernbit/history/v107.dat b/src/packlib/kernlib/kernbit/history/v107.dat
deleted file mode 100644
index 68bdc3c..0000000
--- a/src/packlib/kernlib/kernbit/history/v107.dat
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: v107.dat,v 1.1.1.1 1996/02/15 17:47:45 mclareni Exp $
-*
-* $Log: v107.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:47:45 mclareni
-* Kernlib
-*
-*
-* Version 1.07 910910 22.00
-C- Additions:
-C > P=FKERNBIT QSAA Flag to use the SAA-C compiler on IBM
-C > M433 CLTOU Add STRIP, SUBWORD, WORD, WORDS functions "a la REXX"
- Add WORDSEP to set word-delimiter for M433 package
-C > M442 NAMEFD Fortran version of VM/CMS command NAMEFIND
-C > M443 CHARN Translate CHARACTER <> numeric rep. of numbers
-C > M444 UXTOVM Translate Unix-filenames to VM (for OPEN,INQUIRE,etc)
-C > Z100 JOBNAM Add test program
-C > Z265 GETENVF Add dummy version for MVS
-C > Z305 VMSTAK Add test program
-C > Z307 JOB$VM Add test program
-C > Z313 JOBINFO Add test program
-C
diff --git a/src/packlib/kernlib/kernbit/history/v108.dat b/src/packlib/kernlib/kernbit/history/v108.dat
deleted file mode 100644
index 7ddd972..0000000
--- a/src/packlib/kernlib/kernbit/history/v108.dat
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: v108.dat,v 1.1.1.1 1996/02/15 17:47:44 mclareni Exp $
-*
-* $Log: v108.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:47:44 mclareni
-* Kernlib
-*
-*
-* Version 1.08 920316 1.00
-C- Additions:
-C > Z264 IARGC Emulation of UNIX function on Vax/VMS (to join KERNVAX)
-C > Z313 JOBINFO Add Vax/VMS version
-C > T001 TIMAX Only for CERN, because of the accounting factor
-C > T002 UNALIGN Allow unaligned_data_access - HPUX (to join KERNHPX)
-C
-C- Corrections:
-C > M442 NAMEFD Open files on Vax SHARED,on IBM with ACTION='READ'
-C > T000 INITC Enable also for MVS (M.Dahlinger, GSI)
-C
diff --git a/src/packlib/kernlib/kernbit/history/v109.dat b/src/packlib/kernlib/kernbit/history/v109.dat
deleted file mode 100644
index 43f4f46..0000000
--- a/src/packlib/kernlib/kernbit/history/v109.dat
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: v109.dat,v 1.1.1.1 1996/02/15 17:47:44 mclareni Exp $
-*
-* $Log: v109.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:47:44 mclareni
-* Kernlib
-*
-*
-* Version 1.09 920722 3.30
-C- Add flags IPSC, MSDOS
-C
-C- Additions:
-C > I303 RDWORD Moved from GENLIB. Correct COMMON/RDNMB2/ def in RDMODE
-C > J530 BINSIZ Moved from GENLIB
-C > M214 CVTVAX Moved from GENLIB
-C > M216 GETWI Moved from GENLIB
-C > M218 CVTCDC Moved from GENLIB
-C > M231 CVTIB Moved from GENLIB
-C > M232 CVTND Moved from GENLIB
-C > M416 UBLOW1 Moved from GENLIB
-C > M429 NUMBIT Moved from GENLIB
-C > M437 GETBIT Moved from GENLIB
-C > M438 BTMOVE Moved from GENLIB
-C > M439 GETBYT Moved from GENLIB
-C > Z009 CALDAT Moved from GENLIB
-C > Z034 WHICH Moved from GENLIB
-C > Z265 WHICHF Emulation of UNIX function in FORTRAN (to join KERNFOR)
-C > Z313 JOBINFO Correct VMS version, implement HOSTID
-C
-C- Corrections:
-C > M442 NAMEFD Look for tags terminated by "."
-C
diff --git a/src/packlib/kernlib/kernbit/history/v110.dat b/src/packlib/kernlib/kernbit/history/v110.dat
deleted file mode 100644
index 62b4eba..0000000
--- a/src/packlib/kernlib/kernbit/history/v110.dat
+++ /dev/null
@@ -1,14 +0,0 @@
-*
-* $Id: v110.dat,v 1.1.1.1 1996/02/15 17:47:44 mclareni Exp $
-*
-* $Log: v110.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:47:44 mclareni
-* Kernlib
-*
-*
-* Version 1.10 930226 1.10
-C- Corrections:
-C > M433 INDEXX force declaration of WORD as EXTERNAL (Absoft -NeXT)
-C > M442 NAMEFD New version
-C > Z264 IARGC treat quote-delimited strings as single args
-C
diff --git a/src/packlib/kernlib/kernbit/history/v111.dat b/src/packlib/kernlib/kernbit/history/v111.dat
deleted file mode 100644
index cd83008..0000000
--- a/src/packlib/kernlib/kernbit/history/v111.dat
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: v111.dat,v 1.1.1.1 1996/02/15 17:47:44 mclareni Exp $
-*
-* $Log: v111.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:47:44 mclareni
-* Kernlib
-*
-*
-* Version 1.11 930609 1.11
-C- Corrections:
-C > Z264 IARGC Bug in IARGC/VMS which limited arg length to 100
-C
diff --git a/src/packlib/kernlib/kernbit/history/v112.dat b/src/packlib/kernlib/kernbit/history/v112.dat
deleted file mode 100644
index a545e7a..0000000
--- a/src/packlib/kernlib/kernbit/history/v112.dat
+++ /dev/null
@@ -1,10 +0,0 @@
-*
-* $Id: v112.dat,v 1.1.1.1 1996/02/15 17:47:44 mclareni Exp $
-*
-* $Log: v112.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:47:44 mclareni
-* Kernlib
-*
-*
-C- Modifications:
-C > Z264 GETARG Handle imagename (GETARG(0,PARM))
diff --git a/src/packlib/kernlib/kernbit/history/v113.dat b/src/packlib/kernlib/kernbit/history/v113.dat
deleted file mode 100644
index 7b9d844..0000000
--- a/src/packlib/kernlib/kernbit/history/v113.dat
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: v113.dat,v 1.1.1.1 1996/02/15 17:47:44 mclareni Exp $
-*
-* $Log: v113.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:47:44 mclareni
-* Kernlib
-*
-*
-C- Modifications:
-C > M231 CVTIB - mod for AXP compatibility
-C > Disable Z264 for VAX - now in KERNVAX.
-C > Add WINNT flag
diff --git a/src/packlib/kernlib/kernbit/history/v114.dat b/src/packlib/kernlib/kernbit/history/v114.dat
deleted file mode 100644
index 0f51052..0000000
--- a/src/packlib/kernlib/kernbit/history/v114.dat
+++ /dev/null
@@ -1,11 +0,0 @@
-*
-* $Id: v114.dat,v 1.1.1.1 1996/02/15 17:47:44 mclareni Exp $
-*
-* $Log: v114.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:47:44 mclareni
-* Kernlib
-*
-*
-C- Modifications: (GF)
-C > Z268 SYSTEMS new routine
-C > Add OS9 flags, and in M433 for OS9 a C strut for the COMMON.
diff --git a/src/packlib/kernlib/kernbit/history/v115.dat b/src/packlib/kernlib/kernbit/history/v115.dat
deleted file mode 100644
index cc23b3e..0000000
--- a/src/packlib/kernlib/kernbit/history/v115.dat
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: v115.dat,v 1.1.1.1 1996/02/15 17:47:44 mclareni Exp $
-*
-* $Log: v115.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:47:44 mclareni
-* Kernlib
-*
-*
-C- Modifications: (GF)
-C- > Z268 SYSTEMS disabled for OS9.
-C- > Z268 linux and freebsd added in fortran wrapper.
-C-
diff --git a/src/packlib/kernlib/kernbit/i303/Imakefile b/src/packlib/kernlib/kernbit/i303/Imakefile
deleted file mode 100644
index bd3a924..0000000
--- a/src/packlib/kernlib/kernbit/i303/Imakefile
+++ /dev/null
@@ -1,6 +0,0 @@
-SRCS_F= \ @@\
- ralph.F rdendb.F rdigi.F rdint.F rdload.F rdmant.F rdmode.F \ @@\
- rdname.F rdnext.F rdskip.F rdskpb.F rdupch.F rdupst.F rdwdat.F \ @@\
- rdword.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kernbit/i303/i303cd.inc b/src/packlib/kernlib/kernbit/i303/i303cd.inc
deleted file mode 100644
index 8e8162f..0000000
--- a/src/packlib/kernlib/kernbit/i303/i303cd.inc
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: i303cd.inc,v 1.1.1.1 1996/02/15 17:47:47 mclareni Exp $
-*
-* $Log: i303cd.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:47:47 mclareni
-* Kernlib
-*
-*
-#ifndef CERNLIB_KERNBIT_I303CD_INC
-#define CERNLIB_KERNBIT_I303CD_INC
-*
-*
-* i303cd.inc
-*
- COMMON /RDNMB1/ IBPTR,MODE
- COMMON /RDNMB2/ BUFFER,CURNT
- CHARACTER BUFFER*80, CURNT*1
-
-#endif
diff --git a/src/packlib/kernlib/kernbit/i303/ralph.F b/src/packlib/kernlib/kernbit/i303/ralph.F
deleted file mode 100644
index a8d9837..0000000
--- a/src/packlib/kernlib/kernbit/i303/ralph.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: ralph.F,v 1.1.1.1 1996/02/15 17:47:46 mclareni Exp $
-*
-* $Log: ralph.F,v $
-* Revision 1.1.1.1 1996/02/15 17:47:46 mclareni
-* Kernlib
-*
-*
-#include "kernbit/pilot.h"
- LOGICAL FUNCTION RALPH()
-#include "i303cd.inc"
- CHARACTER LWCASE*26, UPCASE*26
-C*NS CHARACTER*1 CHAR
- DATA LWCASE/'abcdefghijklmnopqrstuvwxyz'/
- DATA UPCASE/'ABCDEFGHIJKLMNOPQRSTUVWXYZ'/
- RALPH=.FALSE.
- IF((INDEX(LWCASE,CURNT).GT.0).OR.(INDEX(UPCASE,CURNT).GT.0))THEN
- RALPH=.TRUE.
- ENDIF
- RETURN
- END
diff --git a/src/packlib/kernlib/kernbit/i303/rdendb.F b/src/packlib/kernlib/kernbit/i303/rdendb.F
deleted file mode 100644
index 951b2eb..0000000
--- a/src/packlib/kernlib/kernbit/i303/rdendb.F
+++ /dev/null
@@ -1,15 +0,0 @@
-*
-* $Id: rdendb.F,v 1.1.1.1 1996/02/15 17:47:46 mclareni Exp $
-*
-* $Log: rdendb.F,v $
-* Revision 1.1.1.1 1996/02/15 17:47:46 mclareni
-* Kernlib
-*
-*
-#include "kernbit/pilot.h"
- LOGICAL FUNCTION RDENDB()
-#include "i303cd.inc"
- RDENDB=.FALSE.
- IF (IBPTR .GT. 80) RDENDB=.TRUE.
- RETURN
- END
diff --git a/src/packlib/kernlib/kernbit/i303/rdigi.F b/src/packlib/kernlib/kernbit/i303/rdigi.F
deleted file mode 100644
index 21da678..0000000
--- a/src/packlib/kernlib/kernbit/i303/rdigi.F
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: rdigi.F,v 1.1.1.1 1996/02/15 17:47:46 mclareni Exp $
-*
-* $Log: rdigi.F,v $
-* Revision 1.1.1.1 1996/02/15 17:47:46 mclareni
-* Kernlib
-*
-*
-#include "kernbit/pilot.h"
- LOGICAL FUNCTION RDIGI()
-C** TO FIND TYPE OF A CHARACTER 'CHAR'
-C*******************************************************************
-#include "i303cd.inc"
- CHARACTER XXXXXX*10
-C*NS CHARACTER*1 CHAR
- DATA XXXXXX/'0123456789'/
- RDIGI=.FALSE.
- IF (INDEX(XXXXXX,CURNT) .GT. 0) RDIGI=.TRUE.
- RETURN
- END
diff --git a/src/packlib/kernlib/kernbit/i303/rdint.F b/src/packlib/kernlib/kernbit/i303/rdint.F
deleted file mode 100644
index 6839ffb..0000000
--- a/src/packlib/kernlib/kernbit/i303/rdint.F
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: rdint.F,v 1.1.1.1 1996/02/15 17:47:46 mclareni Exp $
-*
-* $Log: rdint.F,v $
-* Revision 1.1.1.1 1996/02/15 17:47:46 mclareni
-* Kernlib
-*
-*
-#include "kernbit/pilot.h"
- SUBROUTINE RDINT(LENGTH)
-C** RDINT READS SEQUENCE OF XXXXXX STARTING WITH THE CURRENT CHARACTER
-C** AND RETURNS LENGTH OF IT. IF THE CURRENT CHARACTER IS NOT A DIGIT
-C** LENGTH=0. AFTER RDINT THE CURRENT CHARACTER IS NON-DIGIT TRAILING
-C** THE SEQUENCE.
-C** RDINT IS USED TO READ INTEGER PART ,MANTISSA AND EXPONENT OF A
-C** NUMBER.
-C** RETURNED LENGTH IS USED TO PREPARE FORMAT FOR READ OPERATOR
-C*********************************************************************
-#include "i303cd.inc"
-C*NS CHARACTER XXXXXX*10
-C*NS LOGICAL RDIGI,RALPH
- LOGICAL RDIGI
-
- IBEG=IBPTR
- 1 CONTINUE
- IF (RDIGI()) THEN
- CALL RDNEXT
- GO TO 1
- ENDIF
- LENGTH=IBPTR-IBEG
- END
diff --git a/src/packlib/kernlib/kernbit/i303/rdload.F b/src/packlib/kernlib/kernbit/i303/rdload.F
deleted file mode 100644
index 9f2c6d1..0000000
--- a/src/packlib/kernlib/kernbit/i303/rdload.F
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: rdload.F,v 1.1.1.1 1996/02/15 17:47:46 mclareni Exp $
-*
-* $Log: rdload.F,v $
-* Revision 1.1.1.1 1996/02/15 17:47:46 mclareni
-* Kernlib
-*
-*
-#include "kernbit/pilot.h"
- SUBROUTINE RDLOAD(STRING)
-C READ STRING INTO INTERNAL BUFFER OF RDWORD
-C********************************************************************
- CHARACTER*(*) STRING
-#include "i303cd.inc"
- BUFFER=STRING
- IBPTR=0
- CALL RDNEXT
- RETURN
- END
diff --git a/src/packlib/kernlib/kernbit/i303/rdmant.F b/src/packlib/kernlib/kernbit/i303/rdmant.F
deleted file mode 100644
index 7fa81e3..0000000
--- a/src/packlib/kernlib/kernbit/i303/rdmant.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: rdmant.F,v 1.1.1.1 1996/02/15 17:47:46 mclareni Exp $
-*
-* $Log: rdmant.F,v $
-* Revision 1.1.1.1 1996/02/15 17:47:46 mclareni
-* Kernlib
-*
-*
-#include "kernbit/pilot.h"
- SUBROUTINE RDMANT(LENMAN,LENEXP)
-C** CALLED AFTER DECIMAL POINT WAS READ TO READ MANTISSA
-C**********************************************************************
-#include "i303cd.inc"
-C*NS LOGICAL RDIGI,RALPH
- CHARACTER*1 RDUPCH
-
- CALL RDINT(LENMAN)
- IFPOS=IBPTR
- IF (RDUPCH(CURNT) .EQ. 'E') THEN
- CALL RDNEXT
-C *** SIGN IS THE FIRST CHARACTER
- IF ((CURNT .EQ. '+') .OR. (CURNT .EQ. '-')) THEN
- CALL RDNEXT
- ENDIF
- CALL RDINT(LENGTH)
- ENDIF
- LENEXP=IBPTR-IFPOS
- END
diff --git a/src/packlib/kernlib/kernbit/i303/rdmode.F b/src/packlib/kernlib/kernbit/i303/rdmode.F
deleted file mode 100644
index 4554c1b..0000000
--- a/src/packlib/kernlib/kernbit/i303/rdmode.F
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: rdmode.F,v 1.1.1.1 1996/02/15 17:47:46 mclareni Exp $
-*
-* $Log: rdmode.F,v $
-* Revision 1.1.1.1 1996/02/15 17:47:46 mclareni
-* Kernlib
-*
-*
-#include "kernbit/pilot.h"
- SUBROUTINE RDMODE(I)
-C TO CHANGE MODE OF WORK OF RDNAME.
-C CALL TO RDMODE(2) WILL FORCE RDNAME READ AS WHOLE NAMES SETS OF
-C ALPHANUMERIC CHARACTERS, SUCH AS ALPHA99.
-C THE USUAL MODE (PURELY ALPHABETIC NAMES) WILL BE RESTORED BY A
-C CALL RDMODE(1)
-C********************************************************************
-#include "i303cd.inc"
- MODE=I
- END
diff --git a/src/packlib/kernlib/kernbit/i303/rdname.F b/src/packlib/kernlib/kernbit/i303/rdname.F
deleted file mode 100644
index 2433bd6..0000000
--- a/src/packlib/kernlib/kernbit/i303/rdname.F
+++ /dev/null
@@ -1,36 +0,0 @@
-*
-* $Id: rdname.F,v 1.2 2000/03/31 15:17:05 mclareni Exp $
-*
-* $Log: rdname.F,v $
-* Revision 1.2 2000/03/31 15:17:05 mclareni
-* Remove spurious character in column 74 to help Absoft f90 extended format
-*
-* Revision 1.1.1.1 1996/02/15 17:47:46 mclareni
-* Kernlib
-*
-*
-#include "kernbit/pilot.h"
- SUBROUTINE RDNAME(NAME)
-C** RDNAME IS CALLED WHEN FIRST CHAR OF A WORD IS A LETTER
-C******************************************************************
- CHARACTER*(*) NAME
-#include "i303cd.inc"
- LOGICAL RDIGI,RALPH
-
- IBEG=IBPTR
- 1 IBPTR=IBPTR+1
- IF (IBPTR .GT. 80) GO TO 2
- CURNT=BUFFER(IBPTR:IBPTR)
- IF (RALPH()) GO TO 1
-C *** IN CASE ALPHANUMERICAL NAMES ARE CONSIDERED
- IF ( (MODE .EQ. 2) .AND. RDIGI() ) GO TO 1
- 2 CONTINUE
- NAME=BUFFER(IBEG:(IBPTR-1))
-C *** CONVERT NAME TO UPPER CASE
- CALL RDUPST(NAME)
- IF (LEN(NAME) .LT. IBPTR-IBEG) THEN
- PRINT*,
- - '**ERROR IN RDWORD: NAME READ IS TOO LONG. IT IS TRUNCATED TO: '
- - ,NAME
- ENDIF
- END
diff --git a/src/packlib/kernlib/kernbit/i303/rdnext.F b/src/packlib/kernlib/kernbit/i303/rdnext.F
deleted file mode 100644
index fea3e0f..0000000
--- a/src/packlib/kernlib/kernbit/i303/rdnext.F
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: rdnext.F,v 1.1.1.1 1996/02/15 17:47:46 mclareni Exp $
-*
-* $Log: rdnext.F,v $
-* Revision 1.1.1.1 1996/02/15 17:47:46 mclareni
-* Kernlib
-*
-*
-#include "kernbit/pilot.h"
- SUBROUTINE RDNEXT
-C READ NEXT CHARACTER INTO CURNT AND ADJUST THE POINTER IBPTR
-C********************************************************************
-#include "i303cd.inc"
-
- IBPTR=IBPTR+1
- IF (IBPTR .LE.80) THEN
- CURNT=BUFFER(IBPTR:IBPTR)
- ELSE
- CURNT=' '
- ENDIF
- RETURN
- END
diff --git a/src/packlib/kernlib/kernbit/i303/rdskip.F b/src/packlib/kernlib/kernbit/i303/rdskip.F
deleted file mode 100644
index 0dce9af..0000000
--- a/src/packlib/kernlib/kernbit/i303/rdskip.F
+++ /dev/null
@@ -1,15 +0,0 @@
-*
-* $Id: rdskip.F,v 1.1.1.1 1996/02/15 17:47:46 mclareni Exp $
-*
-* $Log: rdskip.F,v $
-* Revision 1.1.1.1 1996/02/15 17:47:46 mclareni
-* Kernlib
-*
-*
-#include "kernbit/pilot.h"
- SUBROUTINE RDSKIP
-C SKIP THE END OF THE BUFFER
-#include "i303cd.inc"
- IBPTR=81
- CURNT=' '
- END
diff --git a/src/packlib/kernlib/kernbit/i303/rdskpb.F b/src/packlib/kernlib/kernbit/i303/rdskpb.F
deleted file mode 100644
index d16d578..0000000
--- a/src/packlib/kernlib/kernbit/i303/rdskpb.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: rdskpb.F,v 1.1.1.1 1996/02/15 17:47:46 mclareni Exp $
-*
-* $Log: rdskpb.F,v $
-* Revision 1.1.1.1 1996/02/15 17:47:46 mclareni
-* Kernlib
-*
-*
-#include "kernbit/pilot.h"
- SUBROUTINE RDSKPB
-C** SKIPS BLANKS BEGINNING FROM CURRENT CHARACTER AND POSITIONS
-C** POINTER ON FIRST NON-BLANK CHARACTER OR ON POSITION 81 IF
-C** THERE IS NO NON-BLANCS LEFT
-C********************************************************************
-#include "i303cd.inc"
- 1 CONTINUE
- IF (CURNT .EQ. ' ') THEN
- IF (IBPTR .GE. 80) THEN
- IBPTR=81
- RETURN
- ENDIF
- CALL RDNEXT
- GO TO 1
- ENDIF
- RETURN
- END
diff --git a/src/packlib/kernlib/kernbit/i303/rdupch.F b/src/packlib/kernlib/kernbit/i303/rdupch.F
deleted file mode 100644
index 090e2e8..0000000
--- a/src/packlib/kernlib/kernbit/i303/rdupch.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: rdupch.F,v 1.1.1.1 1996/02/15 17:47:46 mclareni Exp $
-*
-* $Log: rdupch.F,v $
-* Revision 1.1.1.1 1996/02/15 17:47:46 mclareni
-* Kernlib
-*
-*
-#include "kernbit/pilot.h"
- CHARACTER*1 FUNCTION RDUPCH(CHAR)
-C** TO CONVERT A CHARACTER TO UPPER CASE
-C*******************************************************************
- CHARACTER*1 CHAR
- CHARACTER LWCASE*26, UPCASE*26
- DATA LWCASE/'abcdefghijklmnopqrstuvwxyz'/
- DATA UPCASE/'ABCDEFGHIJKLMNOPQRSTUVWXYZ'/
- I=INDEX(LWCASE,CHAR)
- RDUPCH=CHAR
- IF (I .GT. 0) RDUPCH=UPCASE(I:I)
- RETURN
- END
diff --git a/src/packlib/kernlib/kernbit/i303/rdupst.F b/src/packlib/kernlib/kernbit/i303/rdupst.F
deleted file mode 100644
index 22fc33e..0000000
--- a/src/packlib/kernlib/kernbit/i303/rdupst.F
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: rdupst.F,v 1.1.1.1 1996/02/15 17:47:46 mclareni Exp $
-*
-* $Log: rdupst.F,v $
-* Revision 1.1.1.1 1996/02/15 17:47:46 mclareni
-* Kernlib
-*
-*
-#include "kernbit/pilot.h"
- SUBROUTINE RDUPST(STRING)
-C** TO CONVERT A STRING TO UPPER CASE
-C*******************************************************************
- CHARACTER*(*) STRING
- CHARACTER*1 RDUPCH
- L=LEN(STRING)
- DO 1 I=1,L
- STRING(I:I)=RDUPCH(STRING(I:I))
- 1 CONTINUE
- RETURN
- END
diff --git a/src/packlib/kernlib/kernbit/i303/rdwdat.F b/src/packlib/kernlib/kernbit/i303/rdwdat.F
deleted file mode 100644
index 9e4d805..0000000
--- a/src/packlib/kernlib/kernbit/i303/rdwdat.F
+++ /dev/null
@@ -1,13 +0,0 @@
-*
-* $Id: rdwdat.F,v 1.1.1.1 1996/02/15 17:47:46 mclareni Exp $
-*
-* $Log: rdwdat.F,v $
-* Revision 1.1.1.1 1996/02/15 17:47:46 mclareni
-* Kernlib
-*
-*
-#include "kernbit/pilot.h"
- BLOCK DATA RDWDAT
-#include "i303cd.inc"
- DATA IBPTR/81/,MODE/1/
- END
diff --git a/src/packlib/kernlib/kernbit/i303/rdword.F b/src/packlib/kernlib/kernbit/i303/rdword.F
deleted file mode 100644
index 586d7fe..0000000
--- a/src/packlib/kernlib/kernbit/i303/rdword.F
+++ /dev/null
@@ -1,142 +0,0 @@
-*
-* $Id: rdword.F,v 1.1.1.1 1996/02/15 17:47:45 mclareni Exp $
-*
-* $Log: rdword.F,v $
-* Revision 1.1.1.1 1996/02/15 17:47:45 mclareni
-* Kernlib
-*
-*
-#include "kernbit/pilot.h"
- SUBROUTINE RDWORD(INUM,FPNUM,NAME,KTYPE)
-C RDWORD IS A SMALL LEXICAL ANALYSER WHICH WAS WRITTEN TO REPLACE
-C FUNCTIONALLY PACKAGE I301 USED ON CDC. IT READS THE NEXT OBJECT FROM
-C ITS INTERNAL BUFFER. THIS OBJECT CAN BE A NUMBER, AN ALPHABETIC
-C WORD OR A SPECIAL CHARACTER.
-C VALUES RETURNED:
-C KTYPE - TYPE OF OBJECT READ
-C KTYPE=2 - INTEGER
-C 1 - FLOATING POINT NUMBER
-C 0 - SPECIAL CHARACTER
-C -1 - ALPHABETIC WORD
-C -100 - AN ERROR OR END OF BUFFER WAS DETECTED DURING READING
-C OF THE CURRENT OBJECT
-C WHEN INTEGER OR FLOATING POINT NUMBER WAS READ:
-C FPNUM = VALUE OF NUMBER READ IN FLOATING POINT FORM
-C INUM = VALUE OF INTEGER READ OR INTEGER PART OF FLOATING POINT
-C NUMBER
-C WHEN NAME OR SPECIAL CHARACTER WAS READ:
-C NAME = FIRST LENGTH(NAME) CHARACTERS OF NAME READ OR SPECIAL
-C CHARACTER. IF NAME WAS TRUNCATED AN ERROR MESSAGE IS GIVEN
-C -----------------------------------------------------------------
-C AUXILLIARY SUBROUTINES FOR USE WITH RDWORD:
-C RDLOAD(STRING) - PUT 'STRING' INTO INTERNAL BUFFER OF RDWORD AND
-C SET INTERNAL POINTER TO ITS FIRST POSITION
-C RDSKIP - SKIPS CONTENT OF THE BUFFER UP TO THE END
-C RDENDB() - LOGICAL FUNCTION RETURNING .TRUE. VALUE IF END OF THE
-C BUFFER WAS REACHED AND .FALSE. OTHERWIZE
-C*******************************************************************
-C** IBPTR - INDEX OF THE CURRENT CHARACTER IN THE BUFFER
-C** CURNT - CURRENT CHARACTER IN THE BUFFER TO WHICH IBPTR POINTS
-C** CURNT IS ALWAYS UPDATED WHEN IBPTR CHANGED
-C** NOTE: AFTER EVERY SUBROUTINE IBPTR POINTS TO THE FIRST CHARACTER
-C** NOT READ BY THIS SUBROUTINE
-C********************************************************************
- EXTERNAL RDWDAT
- CHARACTER*(*) NAME
-#include "i303cd.inc"
- CHARACTER*8 FORM
-C*NS LOGICAL RDIGI,RALPH,RDENDB
- LOGICAL RDIGI,RALPH
- CHARACTER*1 RDUPCH
- NAME=' '
- INUM=0
- FPNUM=0.0
- KTYPE=-100
- CALL RDSKPB
-C** END OF BUFFER CASE
- IF (IBPTR .GT. 80) RETURN
-C** TO STORE THE INDEX OF THE FIRST CHARACTER OF THE WORD
- IFPOS=IBPTR
-C** NUMBER PROCESSING
-C** SIGN IS THE FIRST CHARACTER
- IF ((CURNT .EQ. '+') .OR. (CURNT .EQ. '-' )) THEN
- NAME=CURNT
- CALL RDNEXT
- IF (.NOT. (RDIGI() .OR. (CURNT .EQ. '.'))) THEN
-C *** NO DIGIT OR POINT AFTER SIGN. IT IS A SPECIAL CHARACTER
- KTYPE=0
- RETURN
- ENDIF
- NAME=' '
- ENDIF
-C** DECIMAL POINT IS THE FIRST CHARACTER MAY BE AFTER '+' OR '-'
- IF (CURNT .EQ. '.') THEN
- CALL RDNEXT
- IF (RDIGI()) THEN
- CALL RDMANT(LENMAN,LENEXP)
-C *** MAKE FORMAT WITH NDEC DIGIT AFTER DEC. POINT
- WRITE(FORM,FMT='(2H(F,I2,1H.,I2,1H))') IBPTR-IFPOS,LENMAN
-C *** READ NUMBER FROM THE BUFFER ACCORDING TO PREPARED FORMAT
- READ(BUFFER(IFPOS:(IBPTR-1)),FMT=FORM) FPNUM
- INUM=FPNUM
- KTYPE=1
- RETURN
- ELSE
-C *** POINT WHICH IS NOT IN A NUMBER IS A SPECIAL CHARACTER
- NAME='.'
- KTYPE=0
- ENDIF
- RETURN
- ENDIF
-C** DIGIT IS THE FIRST CHARACTER OF THE NEW WORD OR SECOND CHARACTER
-C** AFTER '+' OR '-' - NUMBER PROCESSING
- IF (RDIGI()) THEN
- CALL RDINT(LENINT)
-C *** DECIMAL POINT AFTER INTEGER PART. READ MANTISSA
- IF (CURNT .EQ. '.') THEN
- CALL RDNEXT
- CALL RDMANT(LENMAN,LENEXP)
-C *** MAKE FORMAT WITH NDEC DIGIT AFTER DEC. POINT
- WRITE(FORM,FMT='(2H(F,I2,1H.,I2,1H))') IBPTR-IFPOS,LENMAN
-C *** READ NUMBER FROM THE BUFFER ACCORDING TO PREPARED FORMAT
- READ(BUFFER(IFPOS:(IBPTR-1)),FMT=FORM) FPNUM
- INUM = FPNUM
- KTYPE = 1
- RETURN
- ENDIF
-C *** 'E' IMMEDIATELY AFTER INTEGER PART. THIS IS CONSIDERED
-C *** LEGAL FLOATING POINT NUMBER
- IF (RDUPCH(CURNT) .EQ. 'E') THEN
- CALL RDMANT(LENMAN,LENEXP)
-C *** MAKE FORMAT WITH NDEC DIGIT AFTER DEC. POINT
- WRITE(FORM,FMT='(2H(F,I2,1H.,I2,1H))') IBPTR-IFPOS,LENMAN
-C *** READ NUMBER FROM THE BUFFER ACCORDING TO PREPARED FORMAT
- READ(BUFFER(IFPOS:(IBPTR-1)),FMT=FORM) FPNUM
- INUM = FPNUM
- KTYPE = 1
- RETURN
- ENDIF
-C *** INTEGER PART NOT FOLLOWED BY '.' OR 'E'
-C** MAKE FORMAT 'INN' WHERE 'NN' IS THE NUMBER LENGTH
- WRITE(FORM,FMT='(2H(I,I2,1H))') IBPTR-IFPOS
-C** READ NUMBER FROM THE BUFFER ACCORDING TO PREPARED FORMAT
- READ(BUFFER(IFPOS:(IBPTR-1)),FMT=FORM) INUM
- FPNUM=INUM
- KTYPE = 2
- RETURN
- ENDIF
-C
-C** LETTER IS THE FIRST CHARACTER OF THE NEW WORD - NAME PROCESSING
- IF (RALPH()) THEN
- CALL RDNAME(NAME)
- KTYPE = -1
- RETURN
- ENDIF
-C
-C** SPECIAL CHARACTER ENCOUNTERED
- NAME=CURNT
- KTYPE = 0
- CALL RDNEXT
- RETURN
-
- END
diff --git a/src/packlib/kernlib/kernbit/j530/Imakefile b/src/packlib/kernlib/kernbit/j530/Imakefile
deleted file mode 100644
index 4ff7cd9..0000000
--- a/src/packlib/kernlib/kernbit/j530/Imakefile
+++ /dev/null
@@ -1,4 +0,0 @@
-SRCS_F= \ @@\
- binsiz.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kernbit/j530/binsiz.F b/src/packlib/kernlib/kernbit/j530/binsiz.F
deleted file mode 100644
index 248c8f4..0000000
--- a/src/packlib/kernlib/kernbit/j530/binsiz.F
+++ /dev/null
@@ -1,65 +0,0 @@
-*
-* $Id: binsiz.F,v 1.1.1.1 1996/02/15 17:47:47 mclareni Exp $
-*
-* $Log: binsiz.F,v $
-* Revision 1.1.1.1 1996/02/15 17:47:47 mclareni
-* Kernlib
-*
-*
-#include "kernbit/pilot.h"
- SUBROUTINE BINSIZ(A1,A2,NAA,BL,BH,NB,BWID)
-C SUBROUTINE TO DETERMINE REASONABLE HISTOGRAM INTERVALS
-C GIVEN ABSOLUTE UPPER AND LOWER BOUNDS A1 AND A2
-C AND DESIRED MAXIMUM NUMBER OF BINS NAA
-C PROGRAM MAKES REASONABLE BINNING FROM BL TO BH OF WIDTH BWID
-C F. JAMES, AUGUST, 1974
- AL = MIN(A1,A2)
- AH = MAX(A1,A2)
- IF (AL.EQ.AH) AH = AL + 1.
-C IF NAA .EQ. -1 , PROGRAM USES BWID INPUT FROM CALLING ROUTINE
- IF (NAA .EQ. -1) GO TO 150
- 10 NA = NAA - 1
- IF (NA .LT. 1) NA = 1
-C GET NOMINAL BIN WIDTH IN EXPON FORM
- 20 AWID = (AH-AL)/NA
- LOG = LOG10(AWID)
- IF (AWID .LE. 1.0) LOG=LOG-1
- SIGFIG = AWID * (10.00 **(-LOG))
-C ROUND MANTISSA UP TO 2, 2.5, 5, OR 10
- IF(SIGFIG .GT. 2.0) GO TO 40
- SIGRND = 2.0
- GO TO 100
- 40 IF (SIGFIG .GT. 2.5) GO TO 50
- SIGRND = 2.5
- GO TO 100
- 50 IF(SIGFIG .GT. 5.0) GO TO 60
- SIGRND =5.0
- GO TO 100
- 60 SIGRND = 1.0
- LOG = LOG + 1
- 100 CONTINUE
- BWID = SIGRND*10.0**LOG
- GO TO 200
-C GET NEW BOUNDS FROM NEW WIDTH BWID
- 150 IF (BWID .LE. 0.) GO TO 10
- 200 CONTINUE
- ALB = AL/BWID
- LWID=ALB
- IF (ALB .LT. 0.0) LWID=LWID-1
- BL = BWID*LWID
- ALB = AH/BWID + 1.0
- KWID = ALB
- IF (ALB .LT. 0.0) KWID=KWID-1
- BH = BWID*KWID
- NB = KWID-LWID
- IF (NAA .GT. 5) GO TO 240
- IF (NAA .EQ. -1) RETURN
-C REQUEST FOR ONE BIN IS DIFFICULT CASE
- IF (NAA .GT. 1 .OR. NB .EQ. 1) RETURN
- BWID = BWID*2.0
- NB = 1
- RETURN
- 240 IF (2*NB .NE. NAA) RETURN
- NA = NA + 1
- GO TO 20
- END
diff --git a/src/packlib/kernlib/kernbit/kernbit/Imakefile b/src/packlib/kernlib/kernbit/kernbit/Imakefile
deleted file mode 100644
index 4582d04..0000000
--- a/src/packlib/kernlib/kernbit/kernbit/Imakefile
+++ /dev/null
@@ -1,3 +0,0 @@
-INCLUDES= pilot.h
-
-InstallIncludes($(INCLUDES),$(CERN_INCLUDEDIR),kernbit)
diff --git a/src/packlib/kernlib/kernbit/kernbit/pilot.h b/src/packlib/kernlib/kernbit/kernbit/pilot.h
deleted file mode 100644
index 2349e12..0000000
--- a/src/packlib/kernlib/kernbit/kernbit/pilot.h
+++ /dev/null
@@ -1,53 +0,0 @@
-#if defined(CERNLIB_IBMMVS)||defined(CERNLIB_IBMVM)
-#ifndef CERNLIB_IBM
-#define CERNLIB_IBM
-#endif
-#endif
-#if defined(CERNLIB_VAXVMS)||defined(CERNLIB_VAXULTRIX)
-#ifndef CERNLIB_VAX
-#define CERNLIB_VAX
-#endif
-#endif
-#if defined(CERNLIB_CDC)||defined(CERNLIB_CRAY)
-#ifndef CERNLIB_SINGLE
-#define CERNLIB_SINGLE
-#endif
-#endif
-#if defined(CERNLIB_IBM)||defined(CERNLIB_VAX)||defined(CERNLIB_NORD)
-#ifndef CERNLIB_DOUBLE
-#define CERNLIB_DOUBLE
-#endif
-#endif
-#if (defined(CERNLIB_UNIX))&&(!defined(CERNLIB_SINGLE))
-#ifndef CERNLIB_DOUBLE
-#define CERNLIB_DOUBLE
-#endif
-#endif
-#if defined(CERNLIB_UNIX)
-#ifndef CERNLIB_BSLASH
-#define CERNLIB_BSLASH
-#endif
-#endif
-#if defined(CERNLIB_WINNT)||defined(CERNLIB_OS9)
-#ifndef CERNLIB_QFMSOFT
-# ifndef CERNLIB_BSLASH
-# define CERNLIB_BSLASH
-# endif
-# endif
-#endif
-
-#if defined(CERNLIB_IBM)
-#ifndef CERNLIB_QMIBMXA
-#define CERNLIB_QMIBMXA
-#endif
-#endif
-#if defined(CERNLIB_IBMVM)||defined(CERNLIB_IBMMVS)
-#ifndef CERNLIB_QSAA
-#define CERNLIB_QSAA
-#endif
-#endif
-#if defined(CERNLIB_QMALPH)
-#ifndef CERNLIB_FORTRAN
-#define CERNLIB_FORTRAN
-#endif
-#endif
diff --git a/src/packlib/kernlib/kernbit/m231asm/Imakefile b/src/packlib/kernlib/kernbit/m231asm/Imakefile
deleted file mode 100644
index eccbb51..0000000
--- a/src/packlib/kernlib/kernbit/m231asm/Imakefile
+++ /dev/null
@@ -1,3 +0,0 @@
-SRCS_S= dibdx.s dxdib.s sibsx.s sxsib.s
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kernbit/m231asm/dibdx.s b/src/packlib/kernlib/kernbit/m231asm/dibdx.s
deleted file mode 100644
index f7c4405..0000000
--- a/src/packlib/kernlib/kernbit/m231asm/dibdx.s
+++ /dev/null
@@ -1,74 +0,0 @@
-;
-; $Id: dibdx.s,v 1.1.1.1 1996/02/15 17:47:47 mclareni Exp $
-;
-; $Log: dibdx.s,v $
-; Revision 1.1.1.1 1996/02/15 17:47:47 mclareni
-; Kernlib
-;
-;
- .TITLE DIBDX
-;
-; CERN PROGLIB# M231 CVTIB
-; ORIG. HYDRA FQT PACKAGE ROUTINE FQTICD
-; EXTRACTED AND NAME CHANGED BY H.RENSHALL/DD, 1984-05-11
-; AND THEN PARTLY REWRITTEN TO ACCOUNT FOR IBM LARGER FLOAT RANGE
-; AND EXACT ZERO IN DOUBLE PRECISION CONVERTION BY
-; F.CARMINATI/DD, 1985-02-18
-;
-; 29-MAR-1994 AXP compatibility
-;
-; SUBROUTINE DIBDX (A,NWORDS)
-;
-; CONVERTS THE FIRST NWORDS 64 BITS WORDS OF VECTOR A FROM
-; IBM FLOATING POINT NUMBER FORMAT TO VAX D_FLOATING POINT FORMAT
-;
- .PSECT $CODE,PIC,CON,REL,LCL,SHR,EXE,RD,NOWRT,LONG
-;DIBDX::
- .ENTRY DIBDX,^M<R7,R8,R9,R10,R11>
- MOVAL @4(AP),R11 ;GET ADRESS OF VECTOR
- MOVL @8(AP), R9 ;LOAD COUNT
- TSTL R9 ;COMPARE 0 WITH THE COUNT
- BGTR L$IAMD ;LOOP COUNT GT 0
- RET ;LOOP COUNT LE 0
- L$IAMD:
-;---
- MOVL (R11)+,R0 ;FIELD SHIFTED ALREADY.
- MOVL (R11)+,R1
- TSTL R1 ;TEST IF EXACT ZERO
- BNEQ CONT ;CONTINUE CONVERTION
- BRW LOOP ;SKIP CONVERTION
- CONT: EXTZV #24,#7,R1,R8 ;EXTRACT EXPONENT (POWERS OF 64)
- SUBL2 #64,R8 ;TAKE AWAY EXCESS
- ASHL #2,R8,R8 ;NOW POWERS OF TWO
- CLRL R7 ;CLEAR THE SIGN MASK
- BBC #31,R1,POS ;BRANCH IF POSITIVE
- MOVL #^XF0000000,R7 ;SET THE SIGN MASK
- POS: INSV #^X00,#24,#8,R1 ;CLEAR THE EXP FIELD
- CLRL R10 ;LOAD THE SHIFT COUNTER
- BBS #23,R1,OUT ;FIRST BIT OF IBM MANTISSA
- INCL R10 ;SHIFT ONE
- BBS #22,R1,OUT ;SECOND BIT OF IBM MANTISSA
- INCL R10 ;SHIFT TWO
- BBS #21,R1,OUT ;THIRD BIT OF IBM MANTISSA
- INCL R10 ;SHIFT THREE
- OUT: ASHQ R10,R0,R0 ;SHIFT THE QUADWORD
- SUBL2 R10,R8 ;NEW EXPONENT
- CMPL R8,#-128 ;SEE IF TOO LITTLE
- BGTR GRTR ;NOT TOO LITTLE
- MOVQ #^X0080000000000000,R0 ;JUST THE SMALLEST FLOAT
- BRB INSIG ;NOW THE SIGN
- GRTR: CMPL R8,#127 ;SEE IF TOO BIG
- BLEQ LSTN ;NOT TOO BIG
- MOVQ #^X7FFFFFFFFFFFFFFF,R0 ;JUST THE BIGGEST FLOAT
- BRB INSIG ;NOW THE SIGN
- LSTN: ADDL2 #^X80,R8 ;ADD EXCESS 128
- INSV R8,#23,#8,R1 ;PACK EXPONENT AND MANTISSA
-INSIG: BISL2 R7,R1 ;LOAD THE SIGN MASK
- ROTL #16,R1,R1 ;SWAP WORDS
- ROTL #16,R0,R0 ;SWAP WORDS
- MOVL R1,-8(R11) ;STORE FIRST LONGWORD
- MOVL R0,-4(R11) ;STORE SECOND LONGWORD
- LOOP: SOBGTR R9, LOOP1 ;LOOP
- RET
-LOOP1: BRW L$IAMD ;BRANCH BACK
- .END
diff --git a/src/packlib/kernlib/kernbit/m231asm/dxdib.s b/src/packlib/kernlib/kernbit/m231asm/dxdib.s
deleted file mode 100644
index 0f3e39f..0000000
--- a/src/packlib/kernlib/kernbit/m231asm/dxdib.s
+++ /dev/null
@@ -1,65 +0,0 @@
-;
-; $Id: dxdib.s,v 1.1.1.1 1996/02/15 17:47:47 mclareni Exp $
-;
-; $Log: dxdib.s,v $
-; Revision 1.1.1.1 1996/02/15 17:47:47 mclareni
-; Kernlib
-;
-;
- .TITLE DXDIB
-;
-; CERN PROGLIB# M231 CVTIB
-; ORIG. HYDRA FQT PACKAGE ROUTINE FQTICD
-; EXTRACTED AND NAME CHANGED BY H.RENSHALL/DD, 1984-05-11
-; & THEN MODIFIED BY F.CARMINATI/DD TO CONVERT FROM VAX
-; TO IBM DOUBLE PRECISION, 1985-14-02
-;
-; 29-MAR-1994 AXP compatibility
-;
-; SUBROUTINE DXDIB (A,NWORDS)
-;
-; CONVERTS THE FIRST NWORDS DOUBLEWORDS OF VECTOR A FROM
-; VAX D_FLOATING POINT NUMBER FORMAT TO IBM DOUBLE PRECISION
-; FORMAT
-;
- .PSECT $CODE,PIC,CON,REL,LCL,SHR,EXE,RD,NOWRT,LONG
-;DXDIB::
- .ENTRY DXDIB,^M<R6,R7,R8,R9,R10,R11>
- MOVAL @4(AP),R11 ;GET ADRESS OF VECTOR
- MOVL @8(AP), R9 ;LOAD COUNT
- TSTL R9 ;COMPARE 0 WITH THE COUNT
- BGTR LOOP ;LOOP COUNT GT 0
- RET ;LOOP COUNT LE 0
-;---
- LOOP: MOVL (R11)+,R1 ;FIELD SHIFTED ALREADY.
- MOVL (R11)+,R0 ;INITIAL SWAP OF LONGWORDS
- TSTL R1 ;CHECK IF EXACT ZERO
- BEQL FIN ;BRANCH ON ZERO
- ROTL #16,R0,R0 ;SWAP WORDS IN R0
- EXTZV #7,#8,R1,R8 ;EXTRACT EXPONENT (POWERS OF 2)
- SUBL2 #^X80,R8 ;TAKE AWAY EXCESS
- EXTZV #0,#2,R8,R7 ;FIND THE REST
- ASHL #-2,R8,R8 ;DIVIDE EXPONENT BY FOUR
- ;SO YOU GET THE POWERS OF 16
- TSTB R7 ;COMPARE THE REST WITH ZERO
- BNEQ LAB1 ;BRANCH ON NOT EQUAL
- ADDL2 #4,R7 ;NORMALIZE EXPONENT
- SUBL2 #1,R8 ;NORMALIZE EXPONENT BASE 16
- LAB1: SUBL3 #4,R7,R6 ;THIS IS THE SHIFT
- MOVL R1,R10 ;SAVE R1 FOR LATER USE
- ROTL #16,R1,R1 ;SWAP WORDS FOR SHIFT
- ASHQ R6,R0,R0 ;PERFORM THE SHIFT
- ADDL2 #^X94,R7 ;THIS IS THE NEW EXP
- INSV R7,#7,#8,R10 ;THIS IS THE FLOATING TO CONVERT
- CLRL R7 ;CLEAR THE SIGN MASK
- BBCC #15,R10,POS ;BRANCH IF POSITIVE
- MOVL #^X80000000,R7 ;LOAD R7 WITH THE SIGN
- POS: CVTFL R10,R1 ;THIS IS THE IBM MANTISSA
- ADDL2 #65,R8 ;THIS IS THE IBM EXPONENT
- INSV R8,#24,#7,R1 ;THAT NOW WE HAVE PACKED
- BISL2 R7,R1 ;INSERT THE SIGN
- MOVL R0, -8(R11)
- MOVL R1, -4(R11)
- FIN: SOBGTR R9, LOOP ;LOOP
- RET
- .END
diff --git a/src/packlib/kernlib/kernbit/m231asm/sibsx.s b/src/packlib/kernlib/kernbit/m231asm/sibsx.s
deleted file mode 100644
index 1bc477b..0000000
--- a/src/packlib/kernlib/kernbit/m231asm/sibsx.s
+++ /dev/null
@@ -1,57 +0,0 @@
-;
-; $Id: sibsx.s,v 1.1.1.1 1996/02/15 17:47:47 mclareni Exp $
-;
-; $Log: sibsx.s,v $
-; Revision 1.1.1.1 1996/02/15 17:47:47 mclareni
-; Kernlib
-;
-;
- .TITLE SIBSX
-;
-; CERN PROGLIB# M231 CVTIB
-; ORIG. HYDRA FQT PACKAGE ROUTINE FQTICD
-; EXTRACTED AND NAME CHANGED BY H.RENSHALL/DD, 1984-05-11
-; AND THEN PARTLY REWRITTEN TO ACCOUNT FOR IBM LARGER FLOAT RANGE
-; AND EXACT ZERO CONVERTION BY F.CARMINATI/DD, 1985-02-18
-;
-; SUBROUTINE SIBSX (A,NWORDS)
-;
-; CONVERTS THE FIRST NWORDS OF VECTOR A FROM IBM FLOATING POINT
-; NUMBER FORMAT TO VAX FLOATING POINT FORMAT
-;
- .PSECT $CODE,PIC,CON,REL,LCL,SHR,EXE,RD,NOWRT,LONG
-;SIBSX::
- .ENTRY SIBSX,^M<R8,R9,R10,R11>
- MOVAL @4(AP),R11 ;GET ADRESS OF VECTOR
- MOVL @8(AP), R9 ;LOAD COUNT
- TSTL R9 ;COMPARE 0 WITH THE COUNT
- BGTR L$IAMD ;LOOP COUNT GT 0
- RET ;LOOP COUNT LE 0
- L$IAMD:
-;---
- MOVL (R11)+,R0 ;FIELD SHIFTED ALREADY.
- TSTL R0 ;TEST IF EXACT ZERO
- BEQL LOOPG ;SKIP CONVERTION
- EXTZV #0,#24,R0,R1 ;EXTRACT MANTISSA
- EXTZV #24,#7,R0,R8 ;EXTRACT EXPONENT (POWERS OF 64)
- SUBL2 #64,R8 ;TAKE AWAY EXCESS
- ASHL #2,R8,R8 ;NOW POWERS OF TWO
- CVTLF R1,R10 ;MANTISSA TO VAX STANDARDS
- EXTZV #7,#5,R10,R1 ;GET NORMALISATION SHIFT
- ADDL2 R1,R8 ;NEW EXPONENT
- CMPL R8,#-104 ;SEE IF TOO LITTLE
- BGTR GRTR ;NOT TOO LITTLE
- MOVL #^X00000080,R10 ;JUST THE SMALLEST FLOAT
- BRB INSIG ;NOW THE SIGN
- GRTR: CMPL R8,#151 ;SEE IF TOO BIG
- BLEQ LSTN ;NOT TOO BIG
- MOVL #^XFFFF7FFF,R10 ;JUST THE BIGGEST FLOAT
- BRB INSIG ;NOW THE SIGN
- LSTN: ADDL2 #^X68,R8 ;ADJUST AND ADD EXCESS 128
- INSV R8,#7,#8,R10 ;PACK EXPONENT AND MANTISSA
-INSIG: BBC #31,R0,FIN ;WAS INPUT NEGATIVE?
- BISL2 #^X00008000,R10 ;YES
- FIN: MOVL R10, -4(R11)
-LOOPG: SOBGTR R9, L$IAMD ;LOOP
- RET
- .END
diff --git a/src/packlib/kernlib/kernbit/m231asm/sxsib.s b/src/packlib/kernlib/kernbit/m231asm/sxsib.s
deleted file mode 100644
index 9d756da..0000000
--- a/src/packlib/kernlib/kernbit/m231asm/sxsib.s
+++ /dev/null
@@ -1,55 +0,0 @@
-;
-; $Id: sxsib.s,v 1.1.1.1 1996/02/15 17:47:47 mclareni Exp $
-;
-; $Log: sxsib.s,v $
-; Revision 1.1.1.1 1996/02/15 17:47:47 mclareni
-; Kernlib
-;
-;
- .TITLE SXSIB
-;
-; CERN PROGLIB# M231 CVTIB
-; ORIG. HYDRA FQT PACKAGE ROUTINE FQTICD
-; EXTRACTED AND NAME CHANGED BY H.RENSHALL/DD, 1984-05-11
-; & THEN MODIFIED BY F.CARMINATI/DD TO CONVERT FROM VAX
-; TO IBM FLOATING, 1985-11-02
-;
-; SUBROUTINE SXSIB (A,NWORDS)
-;
-; CONVERTS THE FIRST NWORDS OF VECTOR A FROM VAX FLOATING
-; POINT NUMBER FORMAT TO IBM FLOATING POINT FORMAT
-;
- .PSECT $CODE,PIC,CON,REL,LCL,SHR,EXE,RD,NOWRT,LONG
-;SXSIB::
- .ENTRY SXSIB,^M<R8,R9,R10,R11>
- MOVAL @4(AP),R11 ;GET ADRESS OF VECTOR
- MOVL @8(AP), R9 ;LOAD COUNT
- TSTL R9 ;COMPARE 0 WITH THE COUNT
- BGTR LOOP ;LOOP COUNT GT 0
- RET ;LOOP COUNT LE 0
-;---
- LOOP: MOVL (R11)+,R0 ;FIELD SHIFTED ALREADY.
- TSTL R0 ;CHECK IF EXACT ZERO
- BEQL FIN ;BRANCH ON ZERO
- EXTZV #7,#8,R0,R8 ;EXTRACT EXPONENT (POWERS OF 2)
- SUBL2 #^X80,R8 ;TAKE AWAY EXCESS
- EXTZV #0,#2,R8,R1 ;FIND THE REST
- ASHL #-2,R8,R8 ;DIVIDE EXPONENT BY FOUR
- ;SO YOU GET THE POWERS OF 16
- TSTB R1 ;COMPARE THE REST WITH ZERO
- BNEQ LAB1 ;BRANCH ON NOT EQUAL
- ADDL2 #4,R1 ;NORMALIZE EXPONENT
- SUBL2 #1,R8 ;NORMALIZE EXPONENT BASE 16
- LAB1: ADDL2 #^X94,R1 ;THIS IS THE NEW EXP
- INSV R1,#7,#8,R0 ;THIS IS THE FLOATING TO CONVERT
- CLRL R1 ;CLEAR THE SIGN MASK
- BBCC #15,R0,POS ;BRANCH IF POSITIVE
- MOVL #^X80000000,R1 ;LOAD R1 WITH THE SIGN
- POS: CVTFL R0,R10 ;THIS IS THE IBM MANTISSA
- ADDL2 #65,R8 ;THIS IS THE IBM EXPONENT
- INSV R8,#24,#7,R10 ;THAT NOW WE HAVE PACKED
- BISL2 R1,R10 ;INSERT THE SIGN
- MOVL R10, -4(R11)
- FIN: SOBGTR R9, LOOP ;LOOP
- RET
- .END
diff --git a/src/packlib/kernlib/kernbit/m233vax/Imakefile b/src/packlib/kernlib/kernbit/m233vax/Imakefile
deleted file mode 100644
index 856bdad..0000000
--- a/src/packlib/kernlib/kernbit/m233vax/Imakefile
+++ /dev/null
@@ -1,3 +0,0 @@
-SRCS_S= tra0e0.s tre0a0.s
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kernbit/m233vax/tra0e0.s b/src/packlib/kernlib/kernbit/m233vax/tra0e0.s
deleted file mode 100644
index 200b82c..0000000
--- a/src/packlib/kernlib/kernbit/m233vax/tra0e0.s
+++ /dev/null
@@ -1,108 +0,0 @@
-;
-; $Id: tra0e0.s,v 1.1.1.1 1996/02/15 17:47:48 mclareni Exp $
-;
-; $Log: tra0e0.s,v $
-; Revision 1.1.1.1 1996/02/15 17:47:48 mclareni
-; Kernlib
-;
-;
- .TITLE TRA0E0
-;++
-; CERN PROGLIB# M233 TRA0E0 .VERSION KERNVAX 2.01
-; ORIG. J. VORBRUEGGEN 28/5/83
-;
-; SUBROUTINE TRA0E0(A, N)
-; Translate the N characters at A from CERN ASCII to CERN EBCDIC
-;
-; Register usage:
-; N <= 65535 N > 65535
-; R0 byte count (used by MOVTC)
-; R1 | source address in A
-; R2 | (used by MOVTC)
-; R3 | (used by MOVTC) address of translation table
-; R4 | (used by MOVTC)
-; R5 | destination address in A (same as R1)
-; R6 not used = 65535
-; R7 not used updated byte count
-;
-; NOTE: R6/R7 are only saved if necessary (i. e. N > 65535).
-;--
- .IDENT /01/
- .PSECT $CODE,PIC,CON,REL,LCL,SHR,EXE,RD,NOWRT,LONG
- .ENTRY TRA0E0,^M<R2,R3,R4,R5>
-
- MOVL @8(AP),R0 ; get N
- BLEQ 10$ ; return if <= 0
- CMPL #65536,R0 ; can we do it in one go ?
- BLSSU 20$ ; if more than 64KB, use loop
- MOVTC R0, at 4(AP),#0,A0E0TABLE,R0, at 4(AP) ; Normal case.
-10$: RET
-
-20$: MOVQ R6,-(SP) ; first save two registers
- MOVL R0,R7 ; save count from destruction
- MOVAL @4(AP),R1 ; get base address of A
- MOVL R1,R5 ; copy it for use as destination
- MOVAL A0E0TABLE,R3 ; get address of translation table
- MOVL #65535,R6 ; this is the maximum for one MOVTC
-
-30$: MOVTC R6,(R1),#0,(R3),R6,(R5) ; translate one 64KB chunk
- ACBL R6,#-65535,R7,30$ ; any more ?
- BEQL 40$ ; already finished ?
- MOVTC R7,(R1),#0,(R3),R7,(R5) ; no, translate the rest
-40$: MOVQ (SP)+,R6 ; restore registers
- RET
-
- .PSECT $PDATA,PIC,CON,REL,LCL,SHR,NOEXE,RD,NOWRT,LONG
-;++
-; This translation table converts CERN ASCII to CERN EBCDIC.
-; It is based on the Rutherford table with the following
-; modifications:
-; - ASCII 5E is converted to EBCDIC 6A (circumflex)
-; - illegal characters are converted to 7B (hash)
-; rather than 6C (percent)
-;
-; Modification Log
-;
-; Change in the CERN IBM character set - January 1990
-;
-; braces 7B/7D map to EBCDIC C0/D0 (mapped to 8B/9B before)
-; tilde 7E maps to EBCDIC A1 (mapped to 5F before)
-; caret 5E maps to EBCDIC 5F (mapped to 6A before)
-;--
-A0E0TABLE:
- .BYTE ^X00,^X01,^X02,^X03,^X37,^X2D,^X2E,^X2F ; 07
- .BYTE ^X16,^X05,^X25,^X0B,^X0C,^X0D,^X0E,^X0F ; 0F
- .BYTE ^X10,^X11,^X12,^X13,^X3C,^X3D,^X32,^X26 ; 17
- .BYTE ^X18,^X19,^X3F,^X27,^X1C,^X1D,^X1E,^X1F ; 1F
- .BYTE ^X40,^X5A,^X7F,^X7B,^X5B,^X6C,^X50,^X7D ; 27
- .BYTE ^X4D,^X5D,^X5C,^X4E,^X6B,^X60,^X4B,^X61 ; 2F
- .BYTE ^XF0,^XF1,^XF2,^XF3,^XF4,^XF5,^XF6,^XF7 ; 37
- .BYTE ^XF8,^XF9,^X7A,^X5E,^X4C,^X7E,^X6E,^X6F ; 3F
- .BYTE ^X7C,^XC1,^XC2,^XC3,^XC4,^XC5,^XC6,^XC7 ; 47
- .BYTE ^XC8,^XC9,^XD1,^XD2,^XD3,^XD4,^XD5,^XD6 ; 4F
- .BYTE ^XD7,^XD8,^XD9,^XE2,^XE3,^XE4,^XE5,^XE6 ; 57
- .BYTE ^XE7,^XE8,^XE9,^XAD,^XE0,^XBD,^X5F,^X6D ; 5F
-; .BYTE ^XE7,^XE8,^XE9,^XAD,^XE0,^XBD,^X6A,^X6D ; Change 5E 6A->5F
- .BYTE ^X79,^X81,^X82,^X83,^X84,^X85,^X86,^X87 ; 67
- .BYTE ^X88,^X89,^X91,^X92,^X93,^X94,^X95,^X96 ; 6F
- .BYTE ^X97,^X98,^X99,^XA2,^XA3,^XA4,^XA5,^XA6 ; 77
- .BYTE ^XA7,^XA8,^XA9,^XC0,^X4F,^XD0,^XA1,^X07 ; 7F
-; .BYTE ^XA7,^XA8,^XA9,^X8B,^X4F,^X9B,^X5F,^X07
-; Change 7B/7D/7E 8B/9B/5F->C0/D0/A1
- .BYTE ^X7B,^X7B,^X7B,^X7B,^X7B,^X7B,^X7B,^X7B ; 87
- .BYTE ^X7B,^X7B,^X7B,^X7B,^X7B,^X7B,^X7B,^X7B ; 8F
- .BYTE ^X7B,^X7B,^X7B,^X7B,^X7B,^X7B,^X7B,^X7B ; 97
- .BYTE ^X7B,^X7B,^X7B,^X7B,^X7B,^X7B,^X7B,^X7B ; 9F
- .BYTE ^X7B,^X7B,^X7B,^X7B,^X7B,^X7B,^X7B,^X7B ; A7
- .BYTE ^X7B,^X7B,^X7B,^X7B,^X7B,^X7B,^X7B,^X7B ; AF
- .BYTE ^X7B,^X7B,^X7B,^X7B,^X7B,^X7B,^X7B,^X7B ; B7
- .BYTE ^X7B,^X7B,^X7B,^X7B,^X7B,^X7B,^X7B,^X7B ; BF
- .BYTE ^X7B,^X7B,^X7B,^X7B,^X7B,^X7B,^X7B,^X7B ; C7
- .BYTE ^X7B,^X7B,^X7B,^X7B,^X7B,^X7B,^X7B,^X7B ; CF
- .BYTE ^X7B,^X7B,^X7B,^X7B,^X7B,^X7B,^X7B,^X7B ; D7
- .BYTE ^X7B,^X7B,^X7B,^X7B,^X7B,^X7B,^X7B,^X7B ; DF
- .BYTE ^X7B,^X7B,^X7B,^X7B,^X7B,^X7B,^X7B,^X7B ; E7
- .BYTE ^X7B,^X7B,^X7B,^X7B,^X7B,^X7B,^X7B,^X7B ; EF
- .BYTE ^X7B,^X7B,^X7B,^X7B,^X7B,^X7B,^X7B,^X7B ; F7
- .BYTE ^X7B,^X7B,^X7B,^X7B,^X7B,^X7B,^X7B,^X7B ; FF
- .END
diff --git a/src/packlib/kernlib/kernbit/m233vax/tre0a0.s b/src/packlib/kernlib/kernbit/m233vax/tre0a0.s
deleted file mode 100644
index a650126..0000000
--- a/src/packlib/kernlib/kernbit/m233vax/tre0a0.s
+++ /dev/null
@@ -1,117 +0,0 @@
-;
-; $Id: tre0a0.s,v 1.1.1.1 1996/02/15 17:47:47 mclareni Exp $
-;
-; $Log: tre0a0.s,v $
-; Revision 1.1.1.1 1996/02/15 17:47:47 mclareni
-; Kernlib
-;
-;
- .TITLE TRE0A0
-;++
-; CERN PROGLIB# M233 TRE0A0 .VERSION KERNVAX 2.01
-; ORIG. J. VORBRUEGGEN 28/5/83
-;
-; SUBROUTINE TRE0A0(A, N)
-; Translate the N characters at A from CERN EBCDIC to CERN ASCII
-;
-; Register usage:
-; N <= 65535 N > 65535
-; R0 byte count (used by MOVTC)
-; R1 | source address in A
-; R2 | (used by MOVTC)
-; R3 | (used by MOVTC) address of translation table
-; R4 | (used by MOVTC)
-; R5 | destination address in A (same as R1)
-; R6 not used = 65535
-; R7 not used updated byte count
-;
-; NOTE: R6/R7 are only saved if necessary (i. e. N > 65535).
-;--
- .IDENT /01/
- .PSECT $CODE,PIC,CON,REL,LCL,SHR,EXE,RD,NOWRT,LONG
- .ENTRY TRE0A0,^M<R2,R3,R4,R5>
-
- MOVL @8(AP),R0 ; get N
- BLEQ 10$ ; return if <= 0
- CMPL #65536,R0 ; can we do it in one go ?
- BLSSU 20$ ; if more than 64KB, use loop
- MOVTC R0, at 4(AP),#0,E0A0TABLE,R0, at 4(AP) ; Normal case.
-10$: RET
-
-20$: MOVQ R6,-(SP) ; first save two registers
- MOVL R0,R7 ; save count from destruction
- MOVAL @4(AP),R1 ; get base address of A
- MOVL R1,R5 ; copy it for use as destination
- MOVAL E0A0TABLE,R3 ; get address of translation table
- MOVL #65535,R6 ; this is the maximum for one MOVTC
-
-30$: MOVTC R6,(R1),#0,(R3),R6,(R5) ; translate one 64KB chunk
- ACBL R6,#-65535,R7,30$ ; any more ?
- BEQL 40$ ; already finished ?
- MOVTC R7,(R1),#0,(R3),R7,(R5) ; no, translate the rest
-40$: MOVQ (SP)+,R6 ; restore registers
- RET
-
- .PSECT $PDATA,PIC,CON,REL,LCL,SHR,NOEXE,RD,NOWRT,LONG
-;++
-; This translation table converts CERN EBCDIC to CERN ASCII.
-; It is based on the Rutherford table with the following
-; modifications:
-; - EBCDIC 6A is converted to ASCII 5E (circumflex)
-; - EBCDIC 71 is considered illegal
-; - illegal characters are converted to 23 (hash) rather than
-; 25 (percent)
-;
-; Modification Log
-;
-; Change in the CERN IBM character set - January 1990
-;
-; braces C0/D0 map to ASCII 7B/7D (mapped to 23 hash before)
-; 8B/9B map to 23 hash (illegal) (mapped to braces before)
-; tilde A1 maps to ASCII 7E tilde (mapped to 23 hash before)
-; not sign 5F maps to ASCII 5E caret (mapped to 7E tilde before)
-; split bar 6A maps to ASCII 23 hash (mapped to 5E caret before)
-; caret 53 maps to ASCII 23 hash (unchanged !)
-;
-;--
-E0A0TABLE:
- .BYTE ^X00,^X01,^X02,^X03,^X23,^X09,^X23,^X7F ; 07
- .BYTE ^X23,^X23,^X23,^X0B,^X0C,^X0D,^X0E,^X0F ; 0F
- .BYTE ^X10,^X11,^X12,^X13,^X23,^X23,^X08,^X23 ; 17
- .BYTE ^X18,^X19,^X23,^X23,^X1C,^X1D,^X1E,^X1F ; 1F
- .BYTE ^X23,^X23,^X23,^X23,^X23,^X0A,^X17,^X1B ; 27
- .BYTE ^X23,^X23,^X23,^X23,^X23,^X05,^X06,^X07 ; 2F
- .BYTE ^X23,^X23,^X16,^X23,^X23,^X23,^X23,^X04 ; 37
- .BYTE ^X23,^X23,^X23,^X23,^X14,^X15,^X23,^X1A ; 3F
- .BYTE ^X20,^X23,^X23,^X23,^X23,^X23,^X23,^X23 ; 47
- .BYTE ^X23,^X23,^X23,^X2E,^X3C,^X28,^X2B,^X7C ; 4F
- .BYTE ^X26,^X23,^X23,^X23,^X23,^X23,^X23,^X23 ; 57
- .BYTE ^X23,^X23,^X21,^X24,^X2A,^X29,^X3B,^X5E ; 5F
-; .BYTE ^X23,^X23,^X21,^X24,^X2A,^X29,^X3B,^X7E ; Change 5F 7E->5E
- .BYTE ^X2D,^X2F,^X23,^X23,^X23,^X23,^X23,^X23 ; 67
- .BYTE ^X23,^X23,^X23,^X2C,^X25,^X5F,^X3E,^X3F ; 6F
-; .BYTE ^X23,^X23,^X5E,^X2C,^X25,^X5F,^X3E,^X3F ; Change 6A 5E->23
- .BYTE ^X23,^X23,^X23,^X23,^X23,^X23,^X23,^X23 ; 77
- .BYTE ^X23,^X60,^X3A,^X23,^X40,^X27,^X3D,^X22 ; 7F
- .BYTE ^X23,^X61,^X62,^X63,^X64,^X65,^X66,^X67 ; 87
- .BYTE ^X68,^X69,^X23,^X23,^X23,^X23,^X23,^X23 ; 8F
-; .BYTE ^X68,^X69,^X23,^X7B,^X23,^X23,^X23,^X23 ; Change 8B 7B->23
- .BYTE ^X23,^X6A,^X6B,^X6C,^X6D,^X6E,^X6F,^X70 ; 97
- .BYTE ^X71,^X72,^X23,^X23,^X23,^X23,^X23,^X23 ; 9F
-; .BYTE ^X71,^X72,^X23,^X7D,^X23,^X23,^X23,^X23 ; Change 9B 7D->23
- .BYTE ^X23,^X7E,^X73,^X74,^X75,^X76,^X77,^X78 ; A7
-; .BYTE ^X23,^X23,^X73,^X74,^X75,^X76,^X77,^X78 ; Change A1 23->7E
- .BYTE ^X79,^X7A,^X23,^X23,^X23,^X5B,^X23,^X23 ; AF
- .BYTE ^X23,^X23,^X23,^X23,^X23,^X23,^X23,^X23 ; B7
- .BYTE ^X23,^X23,^X23,^X23,^X23,^X5D,^X23,^X23 ; BF
- .BYTE ^X7B,^X41,^X42,^X43,^X44,^X45,^X46,^X47 ; C7
-; .BYTE ^X23,^X41,^X42,^X43,^X44,^X45,^X46,^X47 ; Change C0 23->7B
- .BYTE ^X48,^X49,^X23,^X23,^X23,^X23,^X23,^X23 ; CF
- .BYTE ^X7D,^X4A,^X4B,^X4C,^X4D,^X4E,^X4F,^X50 ; D7
-; .BYTE ^X23,^X4A,^X4B,^X4C,^X4D,^X4E,^X4F,^X50 ; Change D0 23->7D
- .BYTE ^X51,^X52,^X23,^X23,^X23,^X23,^X23,^X23 ; DF
- .BYTE ^X5C,^X23,^X53,^X54,^X55,^X56,^X57,^X58 ; E7
- .BYTE ^X59,^X5A,^X23,^X23,^X23,^X23,^X23,^X23 ; EF
- .BYTE ^X30,^X31,^X32,^X33,^X34,^X35,^X36,^X37 ; F7
- .BYTE ^X38,^X39,^X23,^X23,^X23,^X23,^X23,^X23 ; FF
- .END
diff --git a/src/packlib/kernlib/kernbit/m429/Imakefile b/src/packlib/kernlib/kernbit/m429/Imakefile
deleted file mode 100644
index f587011..0000000
--- a/src/packlib/kernlib/kernbit/m429/Imakefile
+++ /dev/null
@@ -1,8 +0,0 @@
-#if defined(CERNLIB_VAX) && !defined(CERNLIB_QMALPH)
-SRCS_S= numbitvx.s
-#else
-SRCS_F= numbit.F
-#endif
-
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kernbit/m429/m429btpw.inc b/src/packlib/kernlib/kernbit/m429/m429btpw.inc
deleted file mode 100644
index cc39741..0000000
--- a/src/packlib/kernlib/kernbit/m429/m429btpw.inc
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: m429btpw.inc,v 1.1.1.1 1996/02/15 17:47:48 mclareni Exp $
-*
-* $Log: m429btpw.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:47:48 mclareni
-* Kernlib
-*
-*
-#ifndef CERNLIB_KERNBIT_M429BTPW_INC
-#define CERNLIB_KERNBIT_M429BTPW_INC
-*
-*
-* m429btpw.inc
-*
-#if defined(CERNLIB_DOUBLE)
-C-- DEFAULT FORTRAN VALUE OF NBITPW= 32 BITS PER WORD
-C-- NBITPW FOR IBM,VAX OR NORD ( 32 BITS PER WORD)
- PARAMETER( NBITPW=32 )
-#endif
-
-#endif
diff --git a/src/packlib/kernlib/kernbit/m429/numbit.F b/src/packlib/kernlib/kernbit/m429/numbit.F
deleted file mode 100644
index 63d91d3..0000000
--- a/src/packlib/kernlib/kernbit/m429/numbit.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: numbit.F,v 1.1.1.1 1996/02/15 17:47:48 mclareni Exp $
-*
-* $Log: numbit.F,v $
-* Revision 1.1.1.1 1996/02/15 17:47:48 mclareni
-* Kernlib
-*
-*
-#include "kernbit/pilot.h"
-#if (defined(CERNLIB_UNIX)||defined(CERNLIB_FORTRAN))&&(!defined(CERNLIB_F4))
- INTEGER FUNCTION NUMBIT(I)
- LOGICAL BTEST
-#include "m429btpw.inc"
- IBCOUN=0
- DO 10 JB=0,NBITPW-1
- IF(BTEST(I,JB)) IBCOUN=IBCOUN+1
- 10 CONTINUE
- NUMBIT=IBCOUN
-*
- END
-#endif
diff --git a/src/packlib/kernlib/kernbit/m429/numbitvx.s b/src/packlib/kernlib/kernbit/m429/numbitvx.s
deleted file mode 100644
index ce4324c..0000000
--- a/src/packlib/kernlib/kernbit/m429/numbitvx.s
+++ /dev/null
@@ -1,48 +0,0 @@
-;
-; $Id: numbitvx.s,v 1.1.1.1 1996/02/15 17:47:48 mclareni Exp $
-;
-; $Log: numbitvx.s,v $
-; Revision 1.1.1.1 1996/02/15 17:47:48 mclareni
-; Kernlib
-;
-;
- .TITLE NUMBIT -- RETURNS THE NUMBER OF 1 BITS IN THE ARGUMENT.
-;
-; ROUTINE NUMBIT - CERNLIB ROUTINE M429
-;
-; NUMBIT FINDS THE NUMBER OF 1 BITS IN THE ARGUMENT WORD.
-;
-; THIS ROUTINE WORKS IN THE FOLLOWING MANNER. IT FIRST VERIFYS
-; THAT THE ARGUMENT IS NON-ZERO. IF NOT, IT RETURNS ZERO. IT THEN
-; PERFORMS THE THE FOLLOWING STEPS FOR EACH SET BIT.
-; 1) IT CLEARS THE LOWEST ORDER BIT BY ANDING THE WORKING COPY
-; OF THE ARGUMENT WITH THE COMPLEMENT OF ITS NEGATIVE.
-; 2) IT INCREMENTS A BIT COUNTER.
-; THIS LOOP CONTINUES UNTIL THE WORKING COPY OF THE ARGUMENT IS
-; ZERO (ALL BITS HAVE BEEN CLEARED). THE BIT COUNTER THEN CONTAINS
-; THE DESIRED VALUE.
-;
-; REVISION HISTORY
-;
-; DATE AUTHOR CHANGES
-; ---- ------ -------
-; 2-MAY-83 J. ZWEIZIG ORIGINAL VERSION
-;
-;
-
- .PSECT $CODE,PIC,CON,REL,LCL,SHR,EXE,RD,NOWRT,LONG
-
- .ENTRY NUMBIT,^M<R2>
-
- CLRL R0 ; ZERO THE STARTING VALUE
- MOVL @4(AP),R1 ; GET THE ARGUMENT VALUE
- BEQL 2$ ; MAKE SURE ONE BIT IS SET
-1$: INCL R0 ; INCREMENT THE BIT COUNT.
- MNEGL R1,R2 ; DELETE THE LOWEST ORDER BIT
- BICL R2,R1 ; BY ANDING THE NUMBER WITH
- ; THE COMPLEMENT OF ITS NEGATIVE.
- BNEQ 1$ ; REPEAT FOR THE REST OF THE BITS
-
-2$: RET
-
- .END
diff --git a/src/packlib/kernlib/kernbit/m433/Imakefile b/src/packlib/kernlib/kernbit/m433/Imakefile
deleted file mode 100644
index 4cb350a..0000000
--- a/src/packlib/kernlib/kernbit/m433/Imakefile
+++ /dev/null
@@ -1,9 +0,0 @@
-SRCS_F= indexa.F indexb.F indexc.F indexn.F indexs.F indxac.F indxbc.F \ @@\
- indxnc.F iscan.F repeat.F spaces.F strip.F subword.F verify.F \ @@\
- word.F words.F wordsep.F
-
-#ifdef CERNLIB_OS9
-SRCS_C= m433f2h.c
-#endif
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kernbit/m433/indexa.F b/src/packlib/kernlib/kernbit/m433/indexa.F
deleted file mode 100644
index 015e42d..0000000
--- a/src/packlib/kernlib/kernbit/m433/indexa.F
+++ /dev/null
@@ -1,30 +0,0 @@
-*
-* $Id: indexa.F,v 1.1.1.1 1996/02/15 17:47:48 mclareni Exp $
-*
-* $Log: indexa.F,v $
-* Revision 1.1.1.1 1996/02/15 17:47:48 mclareni
-* Kernlib
-*
-*
-#include "kernbit/pilot.h"
- FUNCTION INDEXA(STRING)
-C
-C CERN PROGLIB# M433 INDEXA .VERSION KERNFOR 4.14 860211
-C ORIG. 26/03/86 M.GOOSSENS/DD
-C
-C- Find the first alpha-numeric character in a string
-C
- CHARACTER*(*) STRING
-C
- CHARACTER*(*) CALFA
- PARAMETER
- X (CALFA='abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ')
-C
- DO 10 I=1,LEN(STRING)
- IF (INDEX(CALFA,STRING(I:I)).NE.0) THEN
- INDEXA = I
- GO TO 999
- ENDIF
-10 CONTINUE
- INDEXA = 0
- 999 END
diff --git a/src/packlib/kernlib/kernbit/m433/indexb.F b/src/packlib/kernlib/kernbit/m433/indexb.F
deleted file mode 100644
index 284e514..0000000
--- a/src/packlib/kernlib/kernbit/m433/indexb.F
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: indexb.F,v 1.1.1.1 1996/02/15 17:47:49 mclareni Exp $
-*
-* $Log: indexb.F,v $
-* Revision 1.1.1.1 1996/02/15 17:47:49 mclareni
-* Kernlib
-*
-*
-#include "kernbit/pilot.h"
- FUNCTION INDEXB(STR,SSTR)
-C
-C CERN PROGLIB# M433 INDEXB .VERSION KERNFOR 4.14 860211
-C ORIG. 26/03/86 M.GOOSSENS/DD
-C
-C- Find the first occurrence of the substring SSTR in the string STR
-C- starting at the back of STR and scanning backward
-C
- CHARACTER*(*) STR,SSTR
-C
- LENS = LEN(STR)
- LENSS = LEN(SSTR)
-C
- DO 10 I=LENS-LENSS+1,1,-1
- IF (STR(I:I+LENSS-1).EQ.SSTR) THEN
- INDEXB = I
- GO TO 999
- ENDIF
- 10 CONTINUE
- INDEXB = 0
-C
- 999 END
diff --git a/src/packlib/kernlib/kernbit/m433/indexc.F b/src/packlib/kernlib/kernbit/m433/indexc.F
deleted file mode 100644
index 4964c88..0000000
--- a/src/packlib/kernlib/kernbit/m433/indexc.F
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: indexc.F,v 1.1.1.1 1996/02/15 17:47:49 mclareni Exp $
-*
-* $Log: indexc.F,v $
-* Revision 1.1.1.1 1996/02/15 17:47:49 mclareni
-* Kernlib
-*
-*
-#include "kernbit/pilot.h"
- FUNCTION INDEXC(STR,SSTR)
-C
-C CERN PROGLIB# M433 INDEXC .VERSION KERNFOR 4.14 860211
-C ORIG. 26/03/86 M.GOOSSENS/DD
-C
-C- Find the leftmost position where substring SSTR does not match
-C- string STR scanning forward
-C
- CHARACTER*(*) STR,SSTR
-C
- LENS = LEN(STR)
- LENSS = LEN(SSTR)
-C
- DO 10 I=1,LENS-LENSS+1
- IF (STR(I:I+LENSS-1).NE.SSTR) THEN
- INDEXC = I
- GO TO 999
- ENDIF
- 10 CONTINUE
- INDEXC = 0
-C
- 999 END
diff --git a/src/packlib/kernlib/kernbit/m433/indexn.F b/src/packlib/kernlib/kernbit/m433/indexn.F
deleted file mode 100644
index ef5fbee..0000000
--- a/src/packlib/kernlib/kernbit/m433/indexn.F
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: indexn.F,v 1.1.1.1 1996/02/15 17:47:49 mclareni Exp $
-*
-* $Log: indexn.F,v $
-* Revision 1.1.1.1 1996/02/15 17:47:49 mclareni
-* Kernlib
-*
-*
-#include "kernbit/pilot.h"
- FUNCTION INDEXN(STRING)
-C
-C CERN PROGLIB# M433 INDEXN .VERSION KERNFOR 4.14 860211
-C ORIG. 26/03/86 M.GOOSSENS/DD
-C
-C- Find the first numeric character in a string
-C
- CHARACTER*(*) STRING
-C
- CHARACTER*(*) CNUM
- PARAMETER (CNUM='0123456789')
-C
- DO 10 I=1,LEN(STRING)
- IF (INDEX(CNUM,STRING(I:I)).NE.0) THEN
- INDEXN = I
- GO TO 999
- ENDIF
-10 CONTINUE
- INDEXN = 0
- 999 END
diff --git a/src/packlib/kernlib/kernbit/m433/indexs.F b/src/packlib/kernlib/kernbit/m433/indexs.F
deleted file mode 100644
index c4b86b1..0000000
--- a/src/packlib/kernlib/kernbit/m433/indexs.F
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: indexs.F,v 1.1.1.1 1996/02/15 17:47:49 mclareni Exp $
-*
-* $Log: indexs.F,v $
-* Revision 1.1.1.1 1996/02/15 17:47:49 mclareni
-* Kernlib
-*
-*
-#include "kernbit/pilot.h"
- FUNCTION INDEXS(STRING)
-C
-C CERN PROGLIB# M433 INDEXS .VERSION KERNFOR 4.14 860211
-C ORIG. 26/03/86 M.GOOSSENS/DD
-C
-C- Find the first special (i.e. non numeric nor alpha-numeric)
-C- character in a string
-C
- CHARACTER*(*) STRING
-C
- CHARACTER*(*) CSPEC
- PARAMETER (CSPEC=
- X '0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ')
-C
- DO 10 I=1,LEN(STRING)
- IF (INDEX(CSPEC,STRING(I:I)).EQ.0) THEN
- INDEXS = I
- GO TO 999
- ENDIF
-10 CONTINUE
- INDEXS = 0
- 999 END
diff --git a/src/packlib/kernlib/kernbit/m433/indxac.F b/src/packlib/kernlib/kernbit/m433/indxac.F
deleted file mode 100644
index db47ad5..0000000
--- a/src/packlib/kernlib/kernbit/m433/indxac.F
+++ /dev/null
@@ -1,30 +0,0 @@
-*
-* $Id: indxac.F,v 1.1.1.1 1996/02/15 17:47:49 mclareni Exp $
-*
-* $Log: indxac.F,v $
-* Revision 1.1.1.1 1996/02/15 17:47:49 mclareni
-* Kernlib
-*
-*
-#include "kernbit/pilot.h"
- FUNCTION INDXAC(STRING)
-C
-C CERN PROGLIB# M433 INDXAC .VERSION KERNFOR 4.14 860211
-C ORIG. 26/03/86 M.GOOSSENS/DD
-C
-C- Find the first non alpha-numeric character in a string
-C
- CHARACTER*(*) STRING
-C
- CHARACTER*(*) CALFA
- PARAMETER
- X (CALFA='abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ')
-C
- DO 10 I=1,LEN(STRING)
- IF (INDEX(CALFA,STRING(I:I)).EQ.0) THEN
- INDXAC = I
- GO TO 999
- ENDIF
-10 CONTINUE
- INDXAC = 0
- 999 END
diff --git a/src/packlib/kernlib/kernbit/m433/indxbc.F b/src/packlib/kernlib/kernbit/m433/indxbc.F
deleted file mode 100644
index 9725c35..0000000
--- a/src/packlib/kernlib/kernbit/m433/indxbc.F
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: indxbc.F,v 1.1.1.1 1996/02/15 17:47:49 mclareni Exp $
-*
-* $Log: indxbc.F,v $
-* Revision 1.1.1.1 1996/02/15 17:47:49 mclareni
-* Kernlib
-*
-*
-#include "kernbit/pilot.h"
- FUNCTION INDXBC(STR,SSTR)
-C
-C CERN PROGLIB# M433 INDXBC .VERSION KERNFOR 4.14 860211
-C ORIG. 26/03/86 M.GOOSSENS/DD
-C
-C- Find the leftmost position where substring SSTR does not match
-C- string STR scanning from back to front starting at the end of STR
-C
- CHARACTER*(*) STR,SSTR
-C
- LENS = LEN(STR)
- LENSS = LEN(SSTR)
-C
- DO 10 I=LENS-LENSS+1,1,-1
- IF (STR(I:I+LENSS-1).NE.SSTR) THEN
- INDXBC = I
- GO TO 999
- ENDIF
- 10 CONTINUE
- INDXBC = 0
-C
- 999 END
diff --git a/src/packlib/kernlib/kernbit/m433/indxnc.F b/src/packlib/kernlib/kernbit/m433/indxnc.F
deleted file mode 100644
index 24830f8..0000000
--- a/src/packlib/kernlib/kernbit/m433/indxnc.F
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: indxnc.F,v 1.1.1.1 1996/02/15 17:47:49 mclareni Exp $
-*
-* $Log: indxnc.F,v $
-* Revision 1.1.1.1 1996/02/15 17:47:49 mclareni
-* Kernlib
-*
-*
-#include "kernbit/pilot.h"
- FUNCTION INDXNC(STRING)
-C
-C CERN PROGLIB# M433 INDXNC .VERSION KERNFOR 4.14 860211
-C ORIG. 26/03/86 M.GOOSSENS/DD
-C
-C- Find the first non numeric character in a string
-C
- CHARACTER*(*) STRING
-C
- CHARACTER*(*) CNUM
- PARAMETER (CNUM='0123456789')
-C
- DO 10 I=1,LEN(STRING)
- IF (INDEX(CNUM,STRING(I:I)).EQ.0) THEN
- INDXNC = I
- GO TO 999
- ENDIF
-10 CONTINUE
- INDXNC = 0
- 999 END
diff --git a/src/packlib/kernlib/kernbit/m433/iscan.F b/src/packlib/kernlib/kernbit/m433/iscan.F
deleted file mode 100644
index a3f55b4..0000000
--- a/src/packlib/kernlib/kernbit/m433/iscan.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: iscan.F,v 1.1.1.1 1996/02/15 17:47:49 mclareni Exp $
-*
-* $Log: iscan.F,v $
-* Revision 1.1.1.1 1996/02/15 17:47:49 mclareni
-* Kernlib
-*
-*
-#include "kernbit/pilot.h"
- FUNCTION ISCAN(STR,SET)
-C
-C CERN PROGLIB# M433 ISCAN .VERSION KERNFOR 4.14 860211
-C ORIG. 26/03/86 M.GOOSSENS/DD
-C
-C- Scan string STR and return the leftmost position where any of
-C- the characters in SET matches a character in STR
-C
- CHARACTER*(*) STR,SET
-C
- DO 10 I=1,LEN(STR)
- IF (INDEX(SET,STR(I:I)).NE.0) THEN
- ISCAN = I
- GO TO 999
- ENDIF
- 10 CONTINUE
- ISCAN = 0
-C
- 999 END
diff --git a/src/packlib/kernlib/kernbit/m433/m433cs.inc b/src/packlib/kernlib/kernbit/m433/m433cs.inc
deleted file mode 100644
index 7e66738..0000000
--- a/src/packlib/kernlib/kernbit/m433/m433cs.inc
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: m433cs.inc,v 1.1.1.1 1996/02/15 17:47:49 mclareni Exp $
-*
-* $Log: m433cs.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:47:49 mclareni
-* Kernlib
-*
-*
-#ifndef CERNLIB_KERNBIT_M433CS_INC
-#define CERNLIB_KERNBIT_M433CS_INC
-*
-*
-* m433cs.inc
-*
-C
- COMMON/M433CS/ICHSEP,CHSEP
- CHARACTER*1 CHSEP
-C
- IF(ICHSEP.NE.1) THEN
- ICHSEP=1
- CHSEP=' '
- ENDIF
-C
-
-#endif
diff --git a/src/packlib/kernlib/kernbit/m433/m433f2h.c b/src/packlib/kernlib/kernbit/m433/m433f2h.c
deleted file mode 100644
index b58fdd0..0000000
--- a/src/packlib/kernlib/kernbit/m433/m433f2h.c
+++ /dev/null
@@ -1,26 +0,0 @@
-/*
- * $Id: m433f2h.c,v 1.1.1.1 1996/02/15 17:47:49 mclareni Exp $
- *
- * $Log: m433f2h.c,v $
- * Revision 1.1.1.1 1996/02/15 17:47:49 mclareni
- * Kernlib
- *
- */
-#include "kernbit/pilot.h"
-#if defined(CERNLIB_OS9)
-/*
- * Definition of the m433cs_ structure
- * generated by f2c as replacement for
- * the M433CS common in kernbit.car
- *
- * 20/09/94 Martin Merkel, CERN/CN
- */
-
-#include "f2c.h"
-
-struct {
- integer ichsep;
- char chsep[1];
-} m433cs_;
-
-#endif
diff --git a/src/packlib/kernlib/kernbit/m433/repeat.F b/src/packlib/kernlib/kernbit/m433/repeat.F
deleted file mode 100644
index 5bc3df9..0000000
--- a/src/packlib/kernlib/kernbit/m433/repeat.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: repeat.F,v 1.1.1.1 1996/02/15 17:47:49 mclareni Exp $
-*
-* $Log: repeat.F,v $
-* Revision 1.1.1.1 1996/02/15 17:47:49 mclareni
-* Kernlib
-*
-*
-#include "kernbit/pilot.h"
- CHARACTER*(*) FUNCTION REPEAT(STR,NTIMES)
-C
-C CERN PROGLIB# M433 REPEAT .VERSION KERNFOR 4.14 860211
-C ORIG. 27/03/86 M.GOOSSENS/DD
-C
-C- The function value REPEAT returns NTIMES concatenated copies
-C- of the input string STR
-C
- CHARACTER*(*) STR
-C
- IBEGIN = 1
- LENSTR = LEN(STR)
- LENREP = LEN(REPEAT)
- DO 10 I=1,MIN(NTIMES,LENREP/LENSTR+1)
- REPEAT(IBEGIN:) = STR
- IBEGIN = IBEGIN + LENSTR
- 10 CONTINUE
-C
- 999 END
diff --git a/src/packlib/kernlib/kernbit/m433/spaces.F b/src/packlib/kernlib/kernbit/m433/spaces.F
deleted file mode 100644
index e13caa6..0000000
--- a/src/packlib/kernlib/kernbit/m433/spaces.F
+++ /dev/null
@@ -1,44 +0,0 @@
-*
-* $Id: spaces.F,v 1.2 2002/03/04 16:20:46 mclareni Exp $
-*
-* $Log: spaces.F,v $
-* Revision 1.2 2002/03/04 16:20:46 mclareni
-* Tidy a dubious construct which fails with Sun WS6U1 f77 at opt 3
-*
-* Revision 1.1.1.1 1996/02/15 17:47:49 mclareni
-* Kernlib
-*
-*
- CHARACTER*(*) FUNCTION SPACES(STR,MSPACE)
-C
-C CERN PROGLIB# M433 SPACES .VERSION KERNFOR 4.14 860211
-C ORIG. 6/05/86 M.GOOSSENS/DD
-C
-C- The function value SPACES returns the character string STR with
-C- leading blanks removed and each occurence of one or more blanks
-C- replaced by NSPACE blanks inside the string STR
-C
- CHARACTER*(*) STR
-C
- NSPACE = MSPACE
- LENSPA = LEN(SPACES)
- SPACES = ' '
- IF (NSPACE.LT.0) NSPACE = 0
- IBLANK = 1
- ISPACE = 1
- 100 INONBL = INDEXC(STR(IBLANK:),' ')
- IF (INONBL.EQ.0) THEN
- SPACES(ISPACE:) = STR(IBLANK:)
- GO TO 999
- ENDIF
- INONBL = INONBL + IBLANK - 1
- IBLANK = INDEX(STR(INONBL:),' ')
- IF (IBLANK.EQ.0) THEN
- SPACES(ISPACE:) = STR(INONBL:)
- GO TO 999
- ENDIF
- IBLANK = IBLANK + INONBL - 1
- SPACES(ISPACE:) = STR(INONBL:IBLANK-1)
- ISPACE = ISPACE + IBLANK - INONBL + NSPACE
- IF (ISPACE.LE.LENSPA) GO TO 100
- 999 END
diff --git a/src/packlib/kernlib/kernbit/m433/strip.F b/src/packlib/kernlib/kernbit/m433/strip.F
deleted file mode 100644
index a9a4f28..0000000
--- a/src/packlib/kernlib/kernbit/m433/strip.F
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: strip.F,v 1.1.1.1 1996/02/15 17:47:49 mclareni Exp $
-*
-* $Log: strip.F,v $
-* Revision 1.1.1.1 1996/02/15 17:47:49 mclareni
-* Kernlib
-*
-*
-#include "kernbit/pilot.h"
- CHARACTER*(*) FUNCTION STRIP(STR,CHOPT,CHD)
-C
-C CERN PROGLIB# M433 STRIP .VERSION KERNBIT 1.07 910903
-C Author: M.Marquina 91/03/03
-C
-C- Remove Leading/Trailing CHD characters from string STR
-C
- CHARACTER*(*) STR,CHOPT
- CHARACTER*1 CHD,CHO
-#include "m433cs.inc"
- LSTR=LENOCC(STR)
- CHO=CHOPT(1:1)
- CALL CLTOU(CHO)
- MODE=0
- IF(CHO.EQ.'L') MODE=1
- IF(CHO.EQ.'T') MODE=2
- IS=1
- IE=LSTR
- IF(MODE.LE.1) THEN
- DO WHILE(STR(IS:IS).EQ.CHD.AND.IS.LT.LSTR)
- IS=IS+1
- ENDDO
- IF(MODE.EQ.0) MODE=3
- ENDIF
- IF(MODE.GE.2) THEN
- DO WHILE(STR(IE:IE).EQ.CHD.AND.IE.GT.IS)
- IE=IE-1
- ENDDO
- ENDIF
- STRIP=STR(IS:IE)
- RETURN
- END
diff --git a/src/packlib/kernlib/kernbit/m433/subword.F b/src/packlib/kernlib/kernbit/m433/subword.F
deleted file mode 100644
index abdb4ba..0000000
--- a/src/packlib/kernlib/kernbit/m433/subword.F
+++ /dev/null
@@ -1,44 +0,0 @@
-*
-* $Id: subword.F,v 1.1.1.1 1996/02/15 17:47:49 mclareni Exp $
-*
-* $Log: subword.F,v $
-* Revision 1.1.1.1 1996/02/15 17:47:49 mclareni
-* Kernlib
-*
-*
-#include "kernbit/pilot.h"
- CHARACTER*(*) FUNCTION SUBWORD(STR,IW,NW)
-C
-C CERN PROGLIB# M433 SUBWORD .VERSION KERNBIT 1.07 910902
-C Author: M.Marquina 91/03/03
-C
-C- Select NW words of string STR starting at word IW (word-del CHSEP)
-C
- CHARACTER*(*) STR
-#include "m433cs.inc"
- LSTR=LENOCC(STR)
- SUBWORD=' '
- IF(IW.LT.1) RETURN
-C*> Strip leading characters
- I0=1
- DO WHILE(STR(I0:I0).EQ.CHSEP.AND.I0.LT.LSTR)
- I0=I0+1
- ENDDO
- IF(I0.EQ.LSTR) RETURN
- JW=1
- IS=I0
- IE=LSTR
- DO 10 N=I0,LSTR
- IF(STR(N:N).NE.CHSEP) GOTO 10
- IF(STR(N-1:N-1).NE.CHSEP) JW=JW+1
- IF(JW.LT.IW) GOTO 10
- IF(JW.EQ.IW) IS=N+1
- IF(JW.NE.IW+NW) GOTO 10
- IE=N-1
- GOTO 20
- 10 CONTINUE
- 20 CONTINUE
- IF(IW.GT.JW) RETURN
- IF(IE.GE.IS) SUBWORD=STR(IS:IE)
- RETURN
- END
diff --git a/src/packlib/kernlib/kernbit/m433/verify.F b/src/packlib/kernlib/kernbit/m433/verify.F
deleted file mode 100644
index 95e4911..0000000
--- a/src/packlib/kernlib/kernbit/m433/verify.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: verify.F,v 1.1.1.1 1996/02/15 17:47:49 mclareni Exp $
-*
-* $Log: verify.F,v $
-* Revision 1.1.1.1 1996/02/15 17:47:49 mclareni
-* Kernlib
-*
-*
-#include "kernbit/pilot.h"
- INTEGER FUNCTION VERIFY(STR,SET)
-C
-C CERN PROGLIB# M433 VERIFY .VERSION KERNFOR 4.14 860211
-C ORIG. 26/03/86 M.GOOSSENS/DD
-C
-C- Scan string STR and return the leftmost position of a character
-C- in STR which is not in the set SET
-C
- CHARACTER*(*) STR,SET
-C
- DO 10 I=1,LEN(STR)
- IF (INDEX(SET,STR(I:I)).EQ.0) THEN
- VERIFY = I
- GO TO 999
- ENDIF
- 10 CONTINUE
- VERIFY = 0
-C
- 999 END
diff --git a/src/packlib/kernlib/kernbit/m433/word.F b/src/packlib/kernlib/kernbit/m433/word.F
deleted file mode 100644
index 4e1af51..0000000
--- a/src/packlib/kernlib/kernbit/m433/word.F
+++ /dev/null
@@ -1,45 +0,0 @@
-*
-* $Id: word.F,v 1.1.1.1 1996/02/15 17:47:49 mclareni Exp $
-*
-* $Log: word.F,v $
-* Revision 1.1.1.1 1996/02/15 17:47:49 mclareni
-* Kernlib
-*
-*
-#include "kernbit/pilot.h"
- CHARACTER*(*) FUNCTION WORD(STR,IW)
-C
-C CERN PROGLIB# M433 WORD .VERSION KERNBIT 1.07 910903
-C Author: M.Marquina 91/03/03
-C
-C- Select word IW of string STR (word-delimiter CHSEP)
-C
- CHARACTER*(*) STR
-#include "m433cs.inc"
- LSTR=LENOCC(STR)
- WORD=' '
- IF(IW.LT.1) RETURN
-C*> Strip leading characters
- I0=1
- DO WHILE(STR(I0:I0).EQ.CHSEP.AND.I0.LT.LSTR)
- I0=I0+1
- ENDDO
- IF(I0.EQ.LSTR) RETURN
- NW=1
- JW=1
- IS=I0
- IE=LSTR
- DO 10 N=I0,LSTR
- IF(STR(N:N).NE.CHSEP) GOTO 10
- IF(STR(N-1:N-1).NE.CHSEP) JW=JW+1
- IF(JW.LT.IW) GOTO 10
- IF(JW.EQ.IW) IS=N+1
- IF(JW.NE.IW+NW) GOTO 10
- IE=N-1
- GOTO 20
- 10 CONTINUE
- 20 CONTINUE
- IF(IW.GT.JW) RETURN
- IF(IE.GE.IS) WORD=STR(IS:IE)
- RETURN
- END
diff --git a/src/packlib/kernlib/kernbit/m433/words.F b/src/packlib/kernlib/kernbit/m433/words.F
deleted file mode 100644
index 8428adc..0000000
--- a/src/packlib/kernlib/kernbit/m433/words.F
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: words.F,v 1.1.1.1 1996/02/15 17:47:49 mclareni Exp $
-*
-* $Log: words.F,v $
-* Revision 1.1.1.1 1996/02/15 17:47:49 mclareni
-* Kernlib
-*
-*
-#include "kernbit/pilot.h"
- INTEGER FUNCTION WORDS(STR)
-C
-C CERN PROGLIB# M433 WORDS .VERSION KERNBIT 1.07 910903
-C Author: M.Marquina 91/03/03
-C
-C- Return number of words in string STR
-C
- CHARACTER*(*) STR
-#include "m433cs.inc"
- LSTR=LENOCC(STR)
- WORDS=0
-C*> Strip leading characters
- I0=1
- DO WHILE(STR(I0:I0).EQ.CHSEP.AND.I0.LT.LSTR)
- I0=I0+1
- ENDDO
- IF(I0.EQ.LSTR) RETURN
- JW=1
- DO 10 N=I0,LSTR
- IF(STR(N:N).NE.CHSEP) GOTO 10
- IF(STR(N-1:N-1).NE.CHSEP) JW=JW+1
- 10 CONTINUE
- WORDS=JW
- RETURN
- END
diff --git a/src/packlib/kernlib/kernbit/m433/wordsep.F b/src/packlib/kernlib/kernbit/m433/wordsep.F
deleted file mode 100644
index 89d4b68..0000000
--- a/src/packlib/kernlib/kernbit/m433/wordsep.F
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: wordsep.F,v 1.1.1.1 1996/02/15 17:47:49 mclareni Exp $
-*
-* $Log: wordsep.F,v $
-* Revision 1.1.1.1 1996/02/15 17:47:49 mclareni
-* Kernlib
-*
-*
-#include "kernbit/pilot.h"
- SUBROUTINE WORDSEP(STR)
-C
-C CERN PROGLIB# M433 WORDSEP .VERSION KERNBIT 1.07 910903
-C Author: M.Marquina 91/09/03
-C
-C- Sets the CHARACTER separator used in M433 package
-C
- CHARACTER*1 STR
-#include "m433cs.inc"
- CHSEP =STR
- ICHSEP=1
- RETURN
- END
diff --git a/src/packlib/kernlib/kernbit/m437/Imakefile b/src/packlib/kernlib/kernbit/m437/Imakefile
deleted file mode 100644
index a546a06..0000000
--- a/src/packlib/kernlib/kernbit/m437/Imakefile
+++ /dev/null
@@ -1,8 +0,0 @@
-#if defined(CERNLIB_VAX) && !defined(CERNLIB_QMALPH)
-SRCS_S= getbitvx.s
-#else
-SRCS_F= getbit.F setbit.F
-#endif
-
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kernbit/m437/getbit.F b/src/packlib/kernlib/kernbit/m437/getbit.F
deleted file mode 100644
index b7cd7ec..0000000
--- a/src/packlib/kernlib/kernbit/m437/getbit.F
+++ /dev/null
@@ -1,39 +0,0 @@
-*
-* $Id: getbit.F,v 1.1.1.1 1996/02/15 17:47:50 mclareni Exp $
-*
-* $Log: getbit.F,v $
-* Revision 1.1.1.1 1996/02/15 17:47:50 mclareni
-* Kernlib
-*
-*
-#include "kernbit/pilot.h"
-#if defined(CERNLIB_FORTRAN)||defined(CERNLIB_NORD)||defined(CERNLIB_PDP)||defined(CERNLIB_UNIVAC)||defined(CERNLIB_CRAY)||defined(CERNLIB_UNIX)
- SUBROUTINE GETBIT ( I, M, L)
-C-- SUBROUTINE TO RETURN A SINGLE BIT IN A CONTINUOUS STRING
-C-- DIMENSION M - DANGEROUS FOR SOME COMPILERS !
- DIMENSION M(2)
-C-- DEFAULT FORTRAN VALUE OF INWORD= 32 BITS PER WORD
- DATA INWORD / 32/
-#if defined(CERNLIB_DOUBLE)
-C-- INWORD FOR IBM,VAX OR NORD ( 32 BITS PER WORD)
- INWORD=32
-#endif
-#if defined(CERNLIB_PDP)||defined(CERNLIB_UNIVAC)
-C-- INWORD FOR PDP (DEC-10 OR 20) OR UNIVAC ( 36 BITS PER WORD)
- INWORD=36
-#endif
-#if defined(CERNLIB_CDC)
-C-- INWORD FOR CDC ( 60 BITS PER WORD)
- INWORD=60
-#endif
-#if (defined(CERNLIB_SINGLE))&&(!defined(CERNLIB_CDC))
-C-- INWORD FOR CRAY ( 64 BITS PER WORD) +CONVEX (SINGLE MODE)
- INWORD=64
-#endif
-C-- DO SOME INTEGER (TRUNCATED) ARITHMETIC
- IWORD= (I-1)/INWORD + 1
- IBIT= IWORD*INWORD - I + 1
- L= JBIT ( M(IWORD), IBIT)
- RETURN
- END
-#endif
diff --git a/src/packlib/kernlib/kernbit/m437/getbitvx.s b/src/packlib/kernlib/kernbit/m437/getbitvx.s
deleted file mode 100644
index 85d4bff..0000000
--- a/src/packlib/kernlib/kernbit/m437/getbitvx.s
+++ /dev/null
@@ -1,42 +0,0 @@
-;
-; $Id: getbitvx.s,v 1.1.1.1 1996/02/15 17:47:50 mclareni Exp $
-;
-; $Log: getbitvx.s,v $
-; Revision 1.1.1.1 1996/02/15 17:47:50 mclareni
-; Kernlib
-;
-;
- .TITLE GETBIT
-; SUBROUTINE SETBIT: SET THE VALUE OF A BIT IN A BIT STRING
-;
-;
-SETBIT::
- .WORD ^M<R2,R3>
- MOVL @4(AP),R0 ;I
- MOVAL @8(AP),R2 ;M
- MOVAL @12(AP),R3
- DECL R0
- EXTZV #0,#5,R0,R1
- MCOML R1,R1
- INSV R1,#0,#5,R0
- INSV (R3),R0,#1,(R2)
- RET
-;
-; SUBROUTINE GETBIT: GET THE VALUE OF A BIT IN
-; A BIT STRING
-;
-GETBIT::
- .WORD ^M<R2,R3>
- MOVL @4(AP),R0 ;I
- MOVAL @8(AP),R2 ;M
- MOVAL @12(AP),R3
- DECL R0
- EXTZV #0,#5,R0,R1
- MCOML R1,R1
- INSV R1,#0,#5,R0
- BBS R0,(R2),BSET
- BICL2 #1,(R3)
- RET
-BSET: BISL2 #1,(R3)
- RET
- .END
diff --git a/src/packlib/kernlib/kernbit/m437/setbit.F b/src/packlib/kernlib/kernbit/m437/setbit.F
deleted file mode 100644
index b8bbd40..0000000
--- a/src/packlib/kernlib/kernbit/m437/setbit.F
+++ /dev/null
@@ -1,39 +0,0 @@
-*
-* $Id: setbit.F,v 1.1.1.1 1996/02/15 17:47:50 mclareni Exp $
-*
-* $Log: setbit.F,v $
-* Revision 1.1.1.1 1996/02/15 17:47:50 mclareni
-* Kernlib
-*
-*
-#include "kernbit/pilot.h"
-#if defined(CERNLIB_FORTRAN)||defined(CERNLIB_NORD)||defined(CERNLIB_PDP)||defined(CERNLIB_UNIVAC)||defined(CERNLIB_CRAY)||defined(CERNLIB_UNIX)
- SUBROUTINE SETBIT ( I, M, L)
-C-- SUBROUTINE TO SET A SINGLE BIT IN A CONTINUOUS STRING
-C-- DIMENSION M - DANGEROUS FOR SOME COMPILERS !
- DIMENSION M(2)
-C-- DEFAULT FORTRAN VALUE OF INWORD= 32 BITS PER WORD
- DATA INWORD / 32/
-#if defined(CERNLIB_DOUBLE)
-C-- INWORD FOR IBM,VAX OR NORD ( 32 BITS PER WORD)
- INWORD=32
-#endif
-#if defined(CERNLIB_PDP)||defined(CERNLIB_UNIVAC)
-C-- INWORD FOR PDP (DEC-10 OR 20) OR UNIVAC ( 36 BITS PER WORD)
- INWORD=36
-#endif
-#if defined(CERNLIB_CDC)
-C-- INWORD FOR CDC ( 60 BITS PER WORD)
- INWORD=60
-#endif
-#if (defined(CERNLIB_SINGLE))&&(!defined(CERNLIB_CDC))
-C-- INWORD FOR CRAY ( 64 BITS PER WORD) +CONVEX(SINGLE MODE)
- INWORD=64
-#endif
-C-- DO SOME INTEGER (TRUNCATED) ARITHMETIC
- IWORD= (I-1)/INWORD + 1
- IBIT= IWORD*INWORD - I + 1
- CALL SBIT ( L, M(IWORD), IBIT)
- RETURN
- END
-#endif
diff --git a/src/packlib/kernlib/kernbit/m439/Imakefile b/src/packlib/kernlib/kernbit/m439/Imakefile
deleted file mode 100644
index ff055b6..0000000
--- a/src/packlib/kernlib/kernbit/m439/Imakefile
+++ /dev/null
@@ -1,4 +0,0 @@
-SRCS_F= \ @@\
- getbyt.F setbyt.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kernbit/m439/getbyt.F b/src/packlib/kernlib/kernbit/m439/getbyt.F
deleted file mode 100644
index 48f6a2f..0000000
--- a/src/packlib/kernlib/kernbit/m439/getbyt.F
+++ /dev/null
@@ -1,84 +0,0 @@
-*
-* $Id: getbyt.F,v 1.1.1.1 1996/02/15 17:47:50 mclareni Exp $
-*
-* $Log: getbyt.F,v $
-* Revision 1.1.1.1 1996/02/15 17:47:50 mclareni
-* Kernlib
-*
-*
-#include "kernbit/pilot.h"
-#if defined(CERNLIB_FORTRAN)||defined(CERNLIB_VAX)||defined(CERNLIB_UNIVAC)||defined(CERNLIB_CRAY)||defined(CERNLIB_PDP)||defined(CERNLIB_APOLLO)||defined(CERNLIB_UNIX)||defined(CERNLIB_NORD)
- SUBROUTINE GETBYT(CHAR,IBEG,NBITS,INT)
-C
-C CERN PROGLIB# M439 GETBYT .VERSION GEN 2.09 831122
-C ORIG. MODIFIED UPKCH FROM KERNFOR 4.07
-C
- DIMENSION CHAR(9)
- INTEGER CHAR
-C
-C
-#if defined(CERNLIB_DOUBLE)
- DATA NBITSW / 32 /
-#endif
-#if defined(CERNLIB_PDP)||defined(CERNLIB_UNIVAC)
- DATA NBITSW / 36 /
-#endif
-#if defined(CERNLIB_CDC)
- DATA NBITSW / 60 /
-#endif
-#if (defined(CERNLIB_SINGLE))&&(!defined(CERNLIB_CDC))
- DATA NBITSW / 64 /
-#endif
-C
-C
- IF (NBITS.LE.0) GO TO 58
- IGNOR = IBEG - 1
- NZONE= IGNOR + NBITS
- JCH = 1
- IF (NZONE.NE.NBITSW) GO TO 41
-C
-C---- ZONE = WORD
-C
-C*UL 21 JGO = NBITSW+1 - IGNOR
- JGO = NBITSW+1 - IGNOR
- NBEND= NBITS + 1
- NBEND= MAX (NBEND,JGO)
-C
-C*UL 22 JBT = JGO
- JBT = JGO
-C
-C*UL 24 JBT = JBT - NBITS
- JBT = JBT - NBITS
- INT= JBYT (CHAR(JCH),JBT,NBITS)
- GO TO 58
-C
-C---- ZONE NOT EQUALS A WORD
-C
- 41 JBT = NBITSW - IGNOR
- NBEND = NZONE+1 - NBITS
- NBEND = MIN (NBEND,IGNOR+NBITS)
-C
-C*UL 42 NBDONE= IGNOR
- NBDONE= IGNOR
- 43 IF (JBT.GE.0) GO TO 44
- JBT= JBT + NBITSW
- JCH= JCH + 1
- GO TO 43
-C
- 44 JBT = JBT - NBITS
- IF (JBT.LT.0) GO TO 51
- INT= JBYT (CHAR(JCH),JBT+1,NBITS)
- GO TO 58
-C
-C-- CHARACTER ACROSS WORD BOUNDARY
- 51 NLEFT= NBITS + JBT
- NRIGH= -JBT
- JBT = JBT + NBITSW
- INT= JBYT (CHAR(JCH+1),JBT+1,NRIGH)
- IF (NLEFT.EQ.0) GO TO 54
- CALL CBYT (CHAR(JCH),1,INT,NRIGH+1,NLEFT)
- 54 JCH= JCH + 1
-C
- 58 RETURN
- END
-#endif
diff --git a/src/packlib/kernlib/kernbit/m439/setbyt.F b/src/packlib/kernlib/kernbit/m439/setbyt.F
deleted file mode 100644
index 6ab7f03..0000000
--- a/src/packlib/kernlib/kernbit/m439/setbyt.F
+++ /dev/null
@@ -1,83 +0,0 @@
-*
-* $Id: setbyt.F,v 1.1.1.1 1996/02/15 17:47:50 mclareni Exp $
-*
-* $Log: setbyt.F,v $
-* Revision 1.1.1.1 1996/02/15 17:47:50 mclareni
-* Kernlib
-*
-*
-#include "kernbit/pilot.h"
-#if defined(CERNLIB_FORTRAN)||defined(CERNLIB_VAX)||defined(CERNLIB_UNIVAC)||defined(CERNLIB_CRAY)||defined(CERNLIB_PDP)||defined(CERNLIB_APOLLO)||defined(CERNLIB_UNIX)||defined(CERNLIB_NORD)
- SUBROUTINE SETBYT (CHAR,IBEG,NBITS,INT)
-C
-C CERN PROGLIB# M439 SETBYT .VERSION GEN 2.09 832211
-C ORIG. MODIFIED PKCHAR FROM KERNFOR 4.06
-C
- DIMENSION CHAR(9)
- INTEGER CHAR
-C
-#if defined(CERNLIB_DOUBLE)
- DATA NBITSW / 32 /
-#endif
-#if defined(CERNLIB_PDP)||defined(CERNLIB_UNIVAC)
- DATA NBITSW / 36 /
-#endif
-#if defined(CERNLIB_CDC)
- DATA NBITSW / 60 /
-#endif
-#if (defined(CERNLIB_SINGLE))&&(!defined(CERNLIB_CDC))
- DATA NBITSW / 64 /
-#endif
-C
-C
- IF (NBITS.LE.0) GO TO 58
- IGNOR = IBEG - 1
- NZONE = IGNOR + NBITS
- JCH = 1
- IF (NZONE.NE.NBITSW) GO TO 41
-C
-C---- ZONE = WORD
-C
-C*UL 21 JGO = NBITSW+1 - IGNOR
- JGO = NBITSW+1 - IGNOR
- NBEND= NBITS + 1
- NBEND= MAX (NBEND,JGO)
-C
-C*UL 22 JBT = JGO
- JBT = JGO
-C
-C*UL 24 JBT = JBT - NBITS
- JBT = JBT - NBITS
- CALL SBYT (INT,CHAR(JCH),JBT,NBITS)
- GO TO 58
-C
-C---- ZONE NOT EQUALS A WORD
-C
- 41 JBT = NBITSW - IGNOR
- NBEND = NZONE+1 - NBITS
- NBEND = MIN (NBEND,IGNOR+NBITS)
-C
-C*UL 42 NBDONE= IGNOR
- NBDONE= IGNOR
- 43 IF (JBT.GE.0) GO TO 44
- JBT= JBT + NBITSW
- JCH= JCH + 1
- GO TO 43
-C
- 44 JBT = JBT - NBITS
- IF (JBT.LT.0) GO TO 51
- CALL SBYT (INT,CHAR(JCH),JBT+1,NBITS)
- GO TO 58
-C
-C-- CHARACTER ACROSS WORD BOUNDARY
- 51 NLEFT= NBITS + JBT
- NRIGH= -JBT
- JBT = JBT + NBITSW
- IF (NLEFT.EQ.0) GO TO 54
- CALL CBYT (INT,NRIGH+1,CHAR(JCH),1,NLEFT)
- 54 JCH= JCH + 1
- CALL SBYT (INT,CHAR(JCH),JBT+1,NRIGH)
-C
- 58 RETURN
- END
-#endif
diff --git a/src/packlib/kernlib/kernbit/m442/Imakefile b/src/packlib/kernlib/kernbit/m442/Imakefile
deleted file mode 100644
index 95498eb..0000000
--- a/src/packlib/kernlib/kernbit/m442/Imakefile
+++ /dev/null
@@ -1,4 +0,0 @@
-SRCS_F= \ @@\
- namefd.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kernbit/m442/namefd.F b/src/packlib/kernlib/kernbit/m442/namefd.F
deleted file mode 100644
index 6d3f273..0000000
--- a/src/packlib/kernlib/kernbit/m442/namefd.F
+++ /dev/null
@@ -1,272 +0,0 @@
-*
-* $Id: namefd.F,v 1.1.1.1 1996/02/15 17:47:50 mclareni Exp $
-*
-* $Log: namefd.F,v $
-* Revision 1.1.1.1 1996/02/15 17:47:50 mclareni
-* Kernlib
-*
-*
-#include "kernbit/pilot.h"
- SUBROUTINE NAMEFD(LUN,CHFILE,CHIN,NIN,CHOUT,NOUT,IRC)
- CHARACTER*(*) CHIN(2,NIN),CHOUT(2,NOUT),CHFILE
- CHARACTER*255 CHLINE,CHBUF(10),CHUBUF(10)
- CHARACTER*255 CHTAG ,CHVAL ,CHULIN, CHNAME
- LOGICAL IEOF
-*
-#if defined(CERNLIB_IBMMVS)
- CHARACTER*8 PREFIX
-#endif
-*
-* CERN PROGLIB# M442 NAMEFD .VERSION KERNBIT 1.08 911120
-* Author: Jamie Shiers
-*
-* Emulation of VM/CMS NAMEFIND command. Process NAMES file
-* looking for the first entry containing the specified
-* input tags and return those requested.
-* CHIN(1,I) = tag name
-* CHIN(2,I) = tag value
-*
-* Checks on tag name and value are case insensitive, but
-* values are returned asis.
-*
-* Return codes:
-* in case of OPEN error: IOSTAT from FORTRAN OPEN
-* 32 - no match found for input tags & values
-* 4 - not all requested output tags found
-*
-* Mods Date Comments
-* 95/02/28 Version=1.08 Ignore lines beginning with *
-* 93/01/27 Version=1.07 Add debug code, IF=$DEBUG
-* 92/10/15 Version=1.06 Fix bug for single character values
-* 92/10/09 Version=1.05 Handle multiple tags/line correctly
-* 92/06/11 Version=1.04 Look for tags terminated by .
-* Version=1.03 Open files on VAX READONLY
-* Version=1.02 Open files on IBM ACTION='READ'
-* Version=1.01 Open files on VAX shared
-* Version=1.00 First release
-* ------------------------------------------------------------------
- IRC = 0
- IFOUND = 0
-
- LF = LENOCC(CHFILE)
- CHNAME = CHFILE(1:LF)
-#if defined(CERNLIB_UNIX)
- CALL CUTOL(CHNAME(1:LF))
-#endif
-#if defined(CERNLIB_IBMVM)
- CALL CTRANS('.',' ',CHNAME,1,LF)
-#endif
-#if defined(CERNLIB_IBMMVS)
- IF(CHFILE(1:1).EQ.'.') THEN
- CHNAME = CHFILE(2:LF)
- LF = LF - 1
- ELSE
- CALL KPREFI(PREFIX,NCHPRE)
- CHNAME = PREFIX(1:NCHPRE)//CHFILE(1:LF)
- LF = LF + NCHPRE
- ENDIF
- CALL CLTOU(CHNAME(1:LF))
-#endif
-#if defined(CERNLIB_IBM)
- OPEN(UNIT=LUN,FILE='/'//CHNAME(1:LF),FORM='UNFORMATTED',
- + ACTION='READ',
-#endif
-#if !defined(CERNLIB_IBM)
- OPEN(UNIT=LUN,FILE=CHNAME(1:LF),FORM='FORMATTED',
-#endif
-#if defined(CERNLIB_VAXVMS)
- + READONLY,
-#endif
- + STATUS='OLD',ACCESS='SEQUENTIAL',IOSTAT=IRC)
-
- IF(IRC.NE.0) THEN
- PRINT *,'Cannot open ',CHNAME(1:LF),' IOSTAT = ',IRC
- RETURN
- ENDIF
-*
-* Loop over all records in the file, looking for the first
-* entry that matches input criteria
-*
- IEOF = .FALSE.
- NBUF = 1
- 10 CONTINUE
-#if defined(CERNLIB_IBM)
- READ(LUN,NUM=LLINE,END=100) CHLINE
-#endif
-#if !defined(CERNLIB_IBM)
- READ(LUN,'(A)',END=100) CHLINE
- LLINE = LENOCC(CHLINE)
-#endif
- IF(LLINE.EQ.0) GOTO 10
-
-#if defined(CERNLIB__DEBUG)
- WRITE(6,9001) CHLINE(1:LLINE)
- 9001 FORMAT(' NAMEFD. read line ',A)
-#endif
-*
-* Ignore lines beginning with a *
-*
- IF(CHLINE(1:1).EQ.'*') GOTO 10
-
- CHULIN = CHLINE
- CALL CLTOU(CHULIN)
-*
-* Each element of the file starts with a line containing
-* :nick and ends with the next line containing :nick,
-* or the end-of-file
-*
- IF(INDEX(CHULIN(1:LLINE),':NICK').NE.0) THEN
- CHBUF(NBUF) = CHLINE(1:LLINE)
-*
-* Now get the remaining records for this element
-*
- 20 CONTINUE
-#if defined(CERNLIB_IBM)
- READ(LUN,NUM=LLINE,END=30) CHLINE
-#endif
-#if !defined(CERNLIB_IBM)
- READ(LUN,'(A)',END=30) CHLINE
- LLINE = LENOCC(CHLINE)
-#endif
- IF(LLINE.EQ.0) GOTO 20
- IF(CHLINE(1:1).EQ.'*') GOTO 20
-#if defined(CERNLIB__DEBUG)
- WRITE(6,9001) CHLINE(1:LLINE)
-#endif
- CHULIN = CHLINE
- CALL CLTOU(CHULIN)
- IF(INDEX(CHULIN(1:LLINE),':NICK').NE.0) GOTO 40
- NBUF = NBUF + 1
- CHBUF(NBUF) = CHLINE(1:LLINE)
- GOTO 20
- 30 CONTINUE
- IEOF = .TRUE.
- 40 CONTINUE
-*
-* Now have NBUF lines for current element.
-* Look for input tags...
-*
- NTAGS = 0
- DO 60 I=1,NBUF
- LBUF = LENOCC(CHBUF(I))
- IF(LBUF.EQ.0) GOTO 60
- DO 50 J=1,NIN
-*
-* Does this tag exist in current record?
-*
- LTAG = LENOCC(CHIN(1,J))
- CHTAG = CHIN(1,J)(1:LTAG)
- CHUBUF(I) = CHBUF(I)
- CALL CLTOU(CHTAG)
- CALL CLTOU(CHUBUF(I))
-#if defined(CERNLIB__DEBUG)
- WRITE(6,9002) CHTAG(1:LTAG),I,CHUBUF(I)(1:LBUF)
- 9002 FORMAT(' NAMEFD. hunt for input tag ',A,' in buffer element ',I2,
- + ' = ',A)
-#endif
- ISTART = INDEX(CHUBUF(I)(1:LBUF),CHTAG(1:LTAG)//'.')
- ISTART = INDEX(CHUBUF(I)(1:LBUF),CHTAG(1:LTAG)//'.')
- IF(ISTART.NE.0) THEN
-*
-* Does the value match?
-*
- ISTART = ISTART + LTAG + 1
- IEND = INDEX(CHBUF(I)(ISTART+1:LBUF),' ')
- IF(IEND.EQ.0) THEN
- IEND = LBUF
- ELSE
- IEND = IEND + ISTART
- ENDIF
- CHVAL = CHIN(2,J)
- LCHVAL = LENOCC(CHIN(2,J))
- CALL CLTOU(CHVAL)
- IF(CHVAL(1:LCHVAL).NE.CHUBUF(I)(ISTART:IEND)) THEN
- GOTO 90
- ELSE
-*
-* Tag matched - increment counter
-*
- NTAGS = NTAGS + 1
- ENDIF
- ENDIF
- 50 CONTINUE
- 60 CONTINUE
-*
-* Check that we found all the tags we were looking for...
-*
- IF(NTAGS.LT.NIN) GOTO 90
- IFOUND = 1
-*
-* Now return want the user wanted...
-*
- NTAGS = 0
- DO 80 I=1,NBUF
- LBUF = LENOCC(CHBUF(I))
- IF(LBUF.EQ.0) GOTO 80
- DO 70 J=1,NOUT
-*
-* Does this tag exist in current record?
-*
- LTAG = LENOCC(CHOUT(1,J))
- CHTAG = CHOUT(1,J)(1:LTAG)
- CALL CLTOU(CHTAG)
-#if defined(CERNLIB__DEBUG)
- WRITE(6,9003) CHTAG(1:LTAG),I,CHUBUF(I)(1:LBUF)
- 9003 FORMAT(' NAMEFD. hunt for output tag ',A,' in buffer element ',I2,
- + ' = ',A)
-#endif
- ISTART = INDEX(CHUBUF(I)(1:LBUF),CHTAG(1:LTAG)//'.')
- IF(ISTART.NE.0) THEN
-*
-* Get the value of this tag...
-*
- ISTART = ISTART + LTAG + 1
- IF(ISTART.GE.LBUF) THEN
- IEND = LBUF
- ELSE
- IEND = INDEX(CHBUF(I)(ISTART+1:LBUF),' :')
- IF(IEND.EQ.0) THEN
- IEND = LBUF
- ELSE
- IEND = IEND + ISTART
- ENDIF
- ENDIF
- CHOUT(2,J) = CHBUF(I)(ISTART:IEND)
-#if defined(CERNLIB__DEBUG)
- WRITE(6,9004) CHTAG(1:LTAG),CHBUF(I)(ISTART:IEND)
- 9004 FORMAT(' NAMEFD. value of tag ',A,' is ',A)
-#endif
- NTAGS = NTAGS + 1
- ENDIF
- 70 CONTINUE
- 80 CONTINUE
-*
-* We have found an entry - now return
-*
- IF(NTAGS.EQ.NOUT) THEN
- IFOUND = 2
- GOTO 100
- ENDIF
-*
-* Entry did not have all the fields we want
-* Look for a better one...
-*
- 90 CONTINUE
-*
-* Anything left to process?
-*
- IF(.NOT.IEOF) THEN
- NBUF = 1
- CHBUF(NBUF) = CHLINE(1:LLINE)
- GOTO 20
- ENDIF
-*
- ENDIF
-
- 100 CLOSE(LUN)
-*
-* No entries found matching search criteria
-*
- IF(IFOUND.EQ.0) IRC = 32
- IF(IFOUND.EQ.1) IRC = 4
- END
diff --git a/src/packlib/kernlib/kernbit/m443/Imakefile b/src/packlib/kernlib/kernbit/m443/Imakefile
deleted file mode 100644
index ab579ef..0000000
--- a/src/packlib/kernlib/kernbit/m443/Imakefile
+++ /dev/null
@@ -1,4 +0,0 @@
-SRCS_F= \ @@\
- charn.F icharn.F rchar.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kernbit/m443/charn.F b/src/packlib/kernlib/kernbit/m443/charn.F
deleted file mode 100644
index f809471..0000000
--- a/src/packlib/kernlib/kernbit/m443/charn.F
+++ /dev/null
@@ -1,47 +0,0 @@
-*
-* $Id: charn.F,v 1.1.1.1 1996/02/15 17:47:50 mclareni Exp $
-*
-* $Log: charn.F,v $
-* Revision 1.1.1.1 1996/02/15 17:47:50 mclareni
-* Kernlib
-*
-*
-#include "kernbit/pilot.h"
- CHARACTER*(*) FUNCTION CHARN(N)
-*
-* CERN PROGLIB# M443 CHARN .VERSION KERNBIT 1.07 910711
-* Author: Miguel Marquina 91/07/11
-*
-* Build CHARACTER CHARN from INTEGER N
-*
-* Mods Date Comments
-*
- CHARACTER*1 NULL,MINUS
- DATA NULL/'0'/,MINUS/'-'/
-**
- LN=LEN(CHARN)
- CHARN=' '
- NZERO=ICHAR(NULL)
- NP=1
- IS=ISIGN(1,N)
- NB=ABS(N)
- IP=LN+1
-10 CONTINUE
- NDIGIT=MOD(NB,10)
- IP=IP-1
- IF(IP.LT.1) GOTO 20
- CHARN(IP:IP)=CHAR(NDIGIT+NZERO)
- NB=NB/10
- IF(NB.GT.0) GOTO 10
- IF(IS.LT.0) THEN
- IP=IP-1
- IF(IP.LT.1) GOTO 20
- CHARN(IP:IP)=MINUS
- ENDIF
- RETURN
-20 CONTINUE
- CHARN='*'
- PRINT 1000,N,LN
-1000 FORMAT(' **** M443 CHARN: The number ',I10,' cannot be stored'/
- + ' in CHARN (declared length:',I4,')')
- END
diff --git a/src/packlib/kernlib/kernbit/m443/icharn.F b/src/packlib/kernlib/kernbit/m443/icharn.F
deleted file mode 100644
index 5d01afe..0000000
--- a/src/packlib/kernlib/kernbit/m443/icharn.F
+++ /dev/null
@@ -1,58 +0,0 @@
-*
-* $Id: icharn.F,v 1.1.1.1 1996/02/15 17:47:50 mclareni Exp $
-*
-* $Log: icharn.F,v $
-* Revision 1.1.1.1 1996/02/15 17:47:50 mclareni
-* Kernlib
-*
-*
-#include "kernbit/pilot.h"
- FUNCTION ICHARN(CHN)
-*
-* CERN PROGLIB# M443 CHARN .VERSION KERNBIT 1.07 910711
-* Author: Miguel Marquina 85/02/26
-*
-* Build INTEGER ICHARN from CHARACTER string CHN
-*
-* Mods Date Comments
-* MARQUINA 87/05/xx Recode in F77
-*
- CHARACTER*(*) CHN
- CHARACTER*1 NULL,MINUS,IBLANK,IDOT
- EQUIVALENCE(B,NB)
- DATA NULL/'0'/,MINUS/'-'/,IDOT/'.'/,IBLANK/' '/
-
- LN=LEN(CHN)
- NB=0
- NP=1
- IR=0
- IF(LN.LT.1) GOTO 100
- K1=LN+1
- K2=K1
- IS= 1
- IP=LN
- DO 50 K=1,LN
- K1=K1-1
- IF(CHN(K1:K1).EQ.IBLANK) GOTO 50
- K2=K2-1
- IF(CHN(K1:K1).NE.MINUS) GOTO 10
- IS=-1
- GOTO 50
-10 CONTINUE
- IF(CHN(K1:K1).NE.IDOT) GOTO 20
- IP= K2
- IR= 1
- GOTO 50
-20 CONTINUE
- NDIGIT=ICHAR(CHN(K1:K1))-ICHAR(NULL)
- NB=NB+NP*NDIGIT
- NP=NP*10
-50 CONTINUE
- NB=NB*IS
- IF(IR.EQ.0) GOTO 100
- EXP=10**(LN-IP)
- B=NB/EXP
-100 CONTINUE
- ICHARN=NB
- RETURN
- END
diff --git a/src/packlib/kernlib/kernbit/m443/rchar.F b/src/packlib/kernlib/kernbit/m443/rchar.F
deleted file mode 100644
index d073020..0000000
--- a/src/packlib/kernlib/kernbit/m443/rchar.F
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: rchar.F,v 1.1.1.1 1996/02/15 17:47:50 mclareni Exp $
-*
-* $Log: rchar.F,v $
-* Revision 1.1.1.1 1996/02/15 17:47:50 mclareni
-* Kernlib
-*
-*
-#include "kernbit/pilot.h"
- FUNCTION RCHAR(CHN)
-*
-* CERN PROGLIB# M443 CHARN .VERSION KERNBIT 1.07 910711
-* Author: Miguel Marquina 85/11/xx
-*
-* Build REAL RCHAR from CHARACTER string CHN
-*
-* Mods Date Comments
-*
- CHARACTER*(*) CHN
- EQUIVALENCE(R,NR)
- NR=ICHARN(CHN)
- RCHAR=R
- RETURN
- END
diff --git a/src/packlib/kernlib/kernbit/obsolete/m214/Imakefile b/src/packlib/kernlib/kernbit/obsolete/m214/Imakefile
deleted file mode 100644
index 56bc6a6..0000000
--- a/src/packlib/kernlib/kernbit/obsolete/m214/Imakefile
+++ /dev/null
@@ -1,4 +0,0 @@
-SRCS_F= \ @@\
- dvxdx.F dvxsx.F dxdvx.F dxsvx.F svxdx.F svxsx.F sxdvx.F sxsvx.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kernbit/obsolete/m214/dvxdx.F b/src/packlib/kernlib/kernbit/obsolete/m214/dvxdx.F
deleted file mode 100644
index 2ecba16..0000000
--- a/src/packlib/kernlib/kernbit/obsolete/m214/dvxdx.F
+++ /dev/null
@@ -1,67 +0,0 @@
-*
-* $Id: dvxdx.F,v 1.1.1.1 1996/02/15 17:47:36 mclareni Exp $
-*
-* $Log: dvxdx.F,v $
-* Revision 1.1.1.1 1996/02/15 17:47:36 mclareni
-* Kernlib
-*
-*
-#include "kernbit/pilot.h"
- SUBROUTINE DVXDX(IARRAY,NWORDS)
-C
-C This is a subroutine to convert from VAX floating
-C point format (64 Bits) to IBM double precision floating
-C format (64 bits).
-C
-C IARRAY an area of storage 64*NWORDS bits long in which
-C are stored NWORDS 64 bits VAX floating point
-C numbers.
-C On output it will contain NWORDS 64 bits IBM
-C floating point numbers
-C
-C NWORDS number of floating point numbers to convert
-C
- LOGICAL BTEST
- DIMENSION IARRAY(*),IDUMMY(2)
- IF(NWORDS.LE.0) GO TO 999
- DO 2 J=2,2*NWORDS,2
-C
-C Check for exact 0
-C
- IF(IARRAY(J).NE.0) GO TO 1
- IARRAY(2*J-1) = 0
- IARRAY(2*J ) = 0
- GO TO 2
-C
-C Get exponent
-C
- 1 IEXPO = ISHFT(ISHFT(IARRAY(J),17),-24)
-C VAX EXP + VAX BIAS + IBM BIAS
-C IEXPO = IEXPO - 128 + 260
- IEXPO = IEXPO + 132
- IEX16 = IEXPO/4
- ILEFT = 4 - MOD(IEXPO,4)
- IF(ILEFT.EQ.4) THEN
- ILEFT = 0
- IEX16 = IEX16 - 1
- END IF
- IDUMMY(1) = ISHFT(ISHFT(IARRAY(J),25),-9)
- IDUMMY(1) = IBSET(IDUMMY(1),23)
- IDUMMY(1) = IOR(IDUMMY(1),ISHFT(IARRAY(J),-16))
- ITEST1 = ISHFT(IARRAY(J-1),-16)
- ITEST2 = IAND(IARRAY(J-1),65535)
- ITEST1 = ITEST1 + 2 ** (ILEFT-1)
- ITEST2 = ITEST2 + ISHFT(ITEST1,-16)
- IDUMMY(1) = IDUMMY(1) + ISHFT(ITEST2,-16)
- IDUMMY(2) = IOR(ISHFT(ISHFT(ITEST1,16),-16),ISHFT(ITEST2,16))
- IMOVE = ILEFT + 4*ISHFT(IDUMMY(1),-24)
- IDUMMY(2) =
- + IOR(ISHFT(IDUMMY(2),-IMOVE),ISHFT(IDUMMY(1),32-IMOVE))
- IDUMMY(1) = ISHFT(IDUMMY(1),-IMOVE)
- IEX16 = IEX16 + ISHFT(IDUMMY(1),-24)
- IDUMMY(1) = IOR(IDUMMY(1),ISHFT(IEX16,24))
- IF(BTEST(IARRAY(J),15)) IDUMMY(1) = IBSET(IDUMMY(1),31)
- IARRAY(J-1) = IDUMMY(1)
- IARRAY(J ) = IDUMMY(2)
- 2 CONTINUE
- 999 END
diff --git a/src/packlib/kernlib/kernbit/obsolete/m214/dvxsx.F b/src/packlib/kernlib/kernbit/obsolete/m214/dvxsx.F
deleted file mode 100644
index 188746b..0000000
--- a/src/packlib/kernlib/kernbit/obsolete/m214/dvxsx.F
+++ /dev/null
@@ -1,59 +0,0 @@
-*
-* $Id: dvxsx.F,v 1.1.1.1 1996/02/15 17:47:36 mclareni Exp $
-*
-* $Log: dvxsx.F,v $
-* Revision 1.1.1.1 1996/02/15 17:47:36 mclareni
-* Kernlib
-*
-*
-#include "kernbit/pilot.h"
- SUBROUTINE DVXSX(IARRAY,NWORDS)
-C
-C This is a subroutine to convert from VAX double precision
-C floating point format (64 Bits) to IBM floating format
-C (32 bits).
-C
-C IARRAY an area of storage 64*NWORDS bits long in which
-C are stored NWORDS 64 bits VAX floating point
-C numbers.
-C On output it will contain NWORDS 32 bits IBM
-C floating point numbers
-C
-C NWORDS number of floating point numbers to convert
-C
- DIMENSION IARRAY(*)
- LOGICAL BTEST
- IF(NWORDS.LE.0) GO TO 999
- DO 1 J=2,2*NWORDS,2
-C
-C Check for exact 0
-C
- IF(IARRAY(J).EQ.0) GO TO 1
-C
-C Get exponent
-C
- IEXPO = ISHFT(ISHFT(IARRAY(J),17),-24)
-C VAX EXP + VAX BIAS + IBM BIAS
-C IEXPO = IEXPO - 128 + 260
- IEXPO = IEXPO + 132
- IEX16 = IEXPO/4
- ILEFT = 4 - MOD(IEXPO,4)
- IF(ILEFT.EQ.4) THEN
- ILEFT = 0
- IEX16 = IEX16 - 1
- END IF
- IDUMMY = ISHFT(ISHFT(IARRAY(J),25),-9)
- IDUMMY = IBSET(IDUMMY,23)
- IDUMMY = IOR(IDUMMY,ISHFT(IARRAY(J),-16))
- IDUMMY = IDUMMY + 2 ** (ILEFT-1)
- IDUMMY = ISHFT(IDUMMY,-ILEFT)
- IF(BTEST(IDUMMY,24)) THEN
- IDUMMY = IDUMMY + 1
- IDUMMY = ISHFT(IDUMMY,-4)
- IEX16 = IEX16 + 1
- END IF
- IDUMMY = IOR(IDUMMY,ISHFT(IEX16,24))
- IF(BTEST(IARRAY(J),15)) IDUMMY = IBSET(IDUMMY,31)
- IARRAY(J/2) = IDUMMY
- 1 CONTINUE
- 999 END
diff --git a/src/packlib/kernlib/kernbit/obsolete/m214/dxdvx.F b/src/packlib/kernlib/kernbit/obsolete/m214/dxdvx.F
deleted file mode 100644
index 73ab82c..0000000
--- a/src/packlib/kernlib/kernbit/obsolete/m214/dxdvx.F
+++ /dev/null
@@ -1,69 +0,0 @@
-*
-* $Id: dxdvx.F,v 1.1.1.1 1996/02/15 17:47:37 mclareni Exp $
-*
-* $Log: dxdvx.F,v $
-* Revision 1.1.1.1 1996/02/15 17:47:37 mclareni
-* Kernlib
-*
-*
-#include "kernbit/pilot.h"
- SUBROUTINE DXDVX(IARRAY,NWORDS)
-C
-C This is a subroutine to convert from IBM double precision
-C floating point format (64 Bits) to VAX long floating point
-C format (64 Bits)
-C
-C IARRAY an area of storage 64*NWORDS bits long in which
-C are stored one next to the other NWORDS 64 bits
-C IBM floating point numbers. On output it will
-C contain NWORDS 64 bits VAX floating point numbers
-C
-C NWORDS number of floating point numbers to convert
-C
- DIMENSION IARRAY(*),IDUMMY(2)
- LOGICAL BTEST
- DATA IBIG /Z FFFF 7FFF/
- DATA ISMA /Z 0000 0080/
- IF(NWORDS.LE.0) GO TO 999
- DO 2 J=1,2*NWORDS,2
-C
-C Check for exact 0
-C
- IDUMMY(1) = 0
- IDUMMY(2) = 0
- IF(IARRAY(J).EQ.0) GO TO 1
-C
-C Get exponent
-C
- IEXPO = ISHFT(IARRAY(J),1)
- IEXPO = ISHFT(IEXPO,-25)
- IF(BTEST(IARRAY(J),23)) THEN
- ILEFT = 0
- ELSEIF(BTEST(IARRAY(J),22)) THEN
- ILEFT = 1
- ELSEIF(BTEST(IARRAY(J),21)) THEN
- ILEFT = 2
- ELSEIF(BTEST(IARRAY(J),20)) THEN
- ILEFT = 3
- END IF
- IEXPO = IEXPO * 4 - ILEFT - 128
- IF(IEXPO.LE.0) THEN
- IDUMMY(1) = 0
- IDUMMY(2) = ISMA
- GO TO 1
- ELSEIF(IEXPO.GT.255) THEN
- IDUMMY(1) = NOT(0)
- IDUMMY(2) = IBIG
- GO TO 1
- END IF
- IDUMMY(1) = ISHFT(IARRAY(J+1),ILEFT)
- IDUMMY(2) = IOR(ISHFT(ISHFT(IARRAY(J),9+ILEFT),-9),
- + ISHFT(IARRAY(J+1),-32+ILEFT))
- IDUMMY(1) = IOR(ISHFT(IDUMMY(1),16),ISHFT(IDUMMY(1),-16))
- IDUMMY(2) = IOR(ISHFT(IDUMMY(2),16),ISHFT(IDUMMY(2),-16))
- IDUMMY(2) = IOR(IDUMMY(2),ISHFT(IEXPO,7))
- 1 IF(BTEST(IARRAY(J),31)) IDUMMY(2) = IBSET(IDUMMY(2),15)
- IARRAY(J ) = IDUMMY(1)
- IARRAY(J+1) = IDUMMY(2)
- 2 CONTINUE
- 999 END
diff --git a/src/packlib/kernlib/kernbit/obsolete/m214/dxsvx.F b/src/packlib/kernlib/kernbit/obsolete/m214/dxsvx.F
deleted file mode 100644
index a82c37c..0000000
--- a/src/packlib/kernlib/kernbit/obsolete/m214/dxsvx.F
+++ /dev/null
@@ -1,68 +0,0 @@
-*
-* $Id: dxsvx.F,v 1.1.1.1 1996/02/15 17:47:37 mclareni Exp $
-*
-* $Log: dxsvx.F,v $
-* Revision 1.1.1.1 1996/02/15 17:47:37 mclareni
-* Kernlib
-*
-*
-#include "kernbit/pilot.h"
- SUBROUTINE DXSVX(IARRAY,NWORDS)
-C
-C This is a subroutine to convert from IBM double precision
-C floating point format (64 Bits) to VAX short floating
-C point format (32 Bits)
-C
-C IARRAY an area of storage 64*NWORDS bits long in which
-C are stored one next to the other NWORDS 32 bits
-C IBM floating point numbers. On output it will
-C contain NWORDS 32 bits VAX floating point numbers
-C each stored in a 64 bits area, right adjusted with
-C zero fill
-C
-C NWORDS number of floating point numbers to convert
-C
- DIMENSION IARRAY(*)
- LOGICAL BTEST
- DATA IBIG /Z FFFF 7FFF/
- DATA ISMA /Z 0000 0080/
- IF(NWORDS.LE.0) GO TO 999
- DO 2 J=1,2*NWORDS,2
-C
-C Check for exact 0
-C
- IF(IARRAY(J).EQ.0) GO TO 2
-C
-C Get exponent and sign
-C
- IEXPO = ISHFT(IARRAY(J),1)
- IEXPO = ISHFT(IEXPO,-25)
- IF(BTEST(IARRAY(J),23)) THEN
- ILEFT = 0
- ELSEIF(BTEST(IARRAY(J),22)) THEN
- ILEFT = 1
- ELSEIF(BTEST(IARRAY(J),21)) THEN
- ILEFT = 2
- ELSEIF(BTEST(IARRAY(J),20)) THEN
- ILEFT = 3
- END IF
- IEXPO = IEXPO * 4 - ILEFT - 128
- IDUMMY = ISHFT(IAND(IARRAY(J),2**24-1),ILEFT+1)
- IDUMMY = IOR(IDUMMY,ISHFT(IARRAY(J+1),-31+ILEFT))+1
- ISPILL = ISHFT(IDUMMY,-25)
- IDUMMY = ISHFT(IDUMMY,-ISPILL-1)
- IEXPO = IEXPO+ISPILL
- IF(IEXPO.LE.0) THEN
- IDUMMY = ISMA
- GO TO 1
- ELSEIF(IEXPO.GT.255) THEN
- IDUMMY = IBIG
- GO TO 1
- END IF
- IDUMMY = IOR(ISHFT(IDUMMY,16),ISHFT(ISHFT(IDUMMY,9),-25))
- IDUMMY = IOR(IDUMMY,ISHFT(IEXPO,7))
- 1 IF(BTEST(IARRAY(J),31)) IDUMMY = IBSET(IDUMMY,15)
- IARRAY(J+1) = IDUMMY
- IARRAY(J ) = 0
- 2 CONTINUE
- 999 END
diff --git a/src/packlib/kernlib/kernbit/obsolete/m214/svxdx.F b/src/packlib/kernlib/kernbit/obsolete/m214/svxdx.F
deleted file mode 100644
index b969f79..0000000
--- a/src/packlib/kernlib/kernbit/obsolete/m214/svxdx.F
+++ /dev/null
@@ -1,59 +0,0 @@
-*
-* $Id: svxdx.F,v 1.1.1.1 1996/02/15 17:47:36 mclareni Exp $
-*
-* $Log: svxdx.F,v $
-* Revision 1.1.1.1 1996/02/15 17:47:36 mclareni
-* Kernlib
-*
-*
-#include "kernbit/pilot.h"
- SUBROUTINE SVXDX(IARRAY,NWORDS)
-C
-C This is a subroutine to convert from VAX floating
-C point format (32 Bits) to IBM double precision floating
-C format (64 bits).
-C
-C IARRAY an area of storage 64*NWORDS bits long in which
-C are stored NWORDS 32 bits VAX floating point
-C numbers, right adjusted with zero fill in 64
-C bits elements.
-C On output it will contain NWORDS 64 bits IBM
-C floating point numbers
-C
-C NWORDS number of floating point numbers to convert
-C
- LOGICAL BTEST
- DIMENSION IARRAY(*),IDUMMY(2)
- IF(NWORDS.LE.0) GO TO 999
- DO 2 J=2,2*NWORDS,2
-C
-C Check for exact 0
-C
- IF(IARRAY(J).NE.0) GO TO 1
- IARRAY(J-1) = 0
- IARRAY(J ) = 0
- GO TO 2
-C
-C Get exponent
-C
- 1 IEXPO = ISHFT(ISHFT(IARRAY(J),17),-24)
-C VAX EXP + VAX BIAS + IBM BIAS
-C IEXPO = IEXPO - 128 + 260
- IEXPO = IEXPO + 132
- IEX16 = IEXPO/4
- ILEFT = 4 - MOD(IEXPO,4)
- IF(ILEFT.EQ.4) THEN
- ILEFT = 0
- IEX16 = IEX16 - 1
- END IF
- IDUMMY(1) = ISHFT(ISHFT(IARRAY(J),25),-9)
- IDUMMY(1) = IBSET(IDUMMY(1),23)
- IDUMMY(1) = IOR(IDUMMY(1),ISHFT(IARRAY(J),-16))
- IDUMMY(2) = ISHFT(IDUMMY(1),32-ILEFT)
- IDUMMY(1) = ISHFT(IDUMMY(1),-ILEFT)
- IDUMMY(1) = IOR(IDUMMY(1),ISHFT(IEX16,24))
- IF(BTEST(IARRAY(J),15)) IDUMMY(1) = IBSET(IDUMMY(1),31)
- IARRAY(J-1) = IDUMMY(1)
- IARRAY(J ) = IDUMMY(2)
- 2 CONTINUE
- 999 END
diff --git a/src/packlib/kernlib/kernbit/obsolete/m214/svxsx.F b/src/packlib/kernlib/kernbit/obsolete/m214/svxsx.F
deleted file mode 100644
index 44fe330..0000000
--- a/src/packlib/kernlib/kernbit/obsolete/m214/svxsx.F
+++ /dev/null
@@ -1,88 +0,0 @@
-*
-* $Id: svxsx.F,v 1.1.1.1 1996/02/15 17:47:36 mclareni Exp $
-*
-* $Log: svxsx.F,v $
-* Revision 1.1.1.1 1996/02/15 17:47:36 mclareni
-* Kernlib
-*
-*
-#include "kernbit/pilot.h"
-#if defined(CERNLIB_QMIBMVF)
- at PROCESS DIRECTIVE ('*VDIR:') VECTOR OPT(3)
-#endif
- SUBROUTINE SVXSX(IARRAY,NWORDS)
-C
-C This is a subroutine to convert from VAX floating
-C point format (32 Bits) to IBM floating point format
-C (32 bits).
-C
-C IARRAY an area of storage 32*NWORDS bits long in which
-C are stored NWORDS 32 bits VAX floating point
-C numbers.
-C On output it will contain NWORDS 32 bits IBM
-C floating point numbers
-C
-C NWORDS number of floating point numbers to convert
-C
-C VAX format : mmmm mmmm mmmm mmmm seee eeee emmm mmmm
-C IBM format : seee eeee mmmm mmmm mmmm mmmm mmmm mmmm
-C
-C
-C Author: M.Roethlisberger/IBM Optimize/Vectorize
-C Date: 29-01-90
-C
-C Original Code written by Federico Carminati
-C
-C ----------------------------------------------------------------------
- DIMENSION J1(0:3), J2(0:3), J3(0:3)
- DIMENSION IARRAY(*)
- PARAMETER (LVMIN = 25 )
-C PARAMETER (MA0180 = Z 00000180 )
- PARAMETER (MA0180 = 384 )
-C PARAMETER (MA7E00 = Z 00007E00 )
- PARAMETER (MA7E00 = 32256 )
-C PARAMETER (MA8000 = Z 00008000 )
- PARAMETER (MA8000 = 00032768 )
-C PARAMETER (MSKB23 = Z 00800000 )
- PARAMETER (MSKB23 = 08388608 )
-C
-C
-C For Info: 32 = Z 20, 33 = Z 21
-C Z 20000000 Z 21000000 Z 21000000 Z 21000000
- DATA J1 /536870912, 553648128, 553648128, 553648128/
- DATA J2 / 1, 8, 4, 2/
- DATA J3 / 0, 4, 2, 1/
-
- IF (NWORDS.GE.LVMIN) THEN
-C*VDIR: PREFER VECTOR
- DO 1 J=1,NWORDS
- JLFT = ISHFT (IAND(IARRAY(J),MA0180),-7)
-C
-C Take the 6 first bits of VAX exp, shift them 15 positions to
-C the left and add 33 or 32, 24 positions shifted to the left.
-C ------------------------------------------------------------
- JEXP = ISHFT (IAND (IARRAY(J),MA7E00),15)+ J1(JLFT)
- JSGN = ISHFT (IAND (IARRAY(J),MA8000),16)
- JMANT = (IOR (IOR(ISHFT(ISHFT(IARRAY(J),25),-9),ISHFT
- . (IARRAY(J),-16)),MSKB23) + J3(JLFT))/J2(JLFT)
-C
-C Make sure not exact 0
-C
- JARRAY = IARRAY (J)
- IF (JARRAY.NE.0) IARRAY(J) = IOR(IOR(JSGN,JEXP),JMANT)
- 1 CONTINUE
-
- ELSE IF (NWORDS.GT.0) THEN
-C*VDIR: PREFER SCALAR
- DO 2 J=1,NWORDS
- JLFT = ISHFT (IAND(IARRAY(J),MA0180),-7)
- JEXP = ISHFT (IAND (IARRAY(J),MA7E00),15)+ J1(JLFT)
- JSGN = ISHFT (IAND (IARRAY(J),MA8000),16)
- JMANT = (IOR (IOR(ISHFT(ISHFT(IARRAY(J),25),-9),ISHFT
- . (IARRAY(J),-16)),MSKB23) + J3(JLFT))/J2(JLFT)
- JARRAY = IARRAY (J)
- IF (JARRAY.NE.0) IARRAY(J) = IOR(IOR(JSGN,JEXP),JMANT)
- 2 CONTINUE
- ENDIF
-
- END
diff --git a/src/packlib/kernlib/kernbit/obsolete/m214/sxdvx.F b/src/packlib/kernlib/kernbit/obsolete/m214/sxdvx.F
deleted file mode 100644
index 585642c..0000000
--- a/src/packlib/kernlib/kernbit/obsolete/m214/sxdvx.F
+++ /dev/null
@@ -1,67 +0,0 @@
-*
-* $Id: sxdvx.F,v 1.1.1.1 1996/02/15 17:47:36 mclareni Exp $
-*
-* $Log: sxdvx.F,v $
-* Revision 1.1.1.1 1996/02/15 17:47:36 mclareni
-* Kernlib
-*
-*
-#include "kernbit/pilot.h"
- SUBROUTINE SXDVX(IARRAY,NWORDS)
-C
-C This is a subroutine to convert from IBM short floating
-C point format (32 Bits) to VAX long floating point format
-C (64 Bits)
-C
-C IARRAY an area of storage 64*NWORDS bits long in which
-C are stored one next to the other NWORDS 32 bits
-C IBM floating point numbers. On output it will
-C contain NWORDS 64 bits VAX floating point numbers
-C
-C NWORDS number of floating point numbers to convert
-C
- DIMENSION IARRAY(*),IDUMMY(2)
- LOGICAL BTEST
- DATA IBIG /Z FFFF 7FFF/
- DATA ISMA /Z 0000 0080/
- IF(NWORDS.LE.0) GO TO 999
- DO 2 J=NWORDS,1,-1
-C
-C Check for exact 0
-C
- IDUMMY(1) = 0
- IDUMMY(2) = 0
- IF(IARRAY(J).EQ.0) GO TO 1
-C
-C Get exponent and sign
-C
- IEXPO = ISHFT(IARRAY(J),1)
- IEXPO = ISHFT(IEXPO,-25)
- IF(BTEST(IARRAY(J),23)) THEN
- ILEFT = 0
- ELSEIF(BTEST(IARRAY(J),22)) THEN
- ILEFT = 1
- ELSEIF(BTEST(IARRAY(J),21)) THEN
- ILEFT = 2
- ELSEIF(BTEST(IARRAY(J),20)) THEN
- ILEFT = 3
- END IF
- IEXPO = IEXPO * 4 - ILEFT - 128
- IF(IEXPO.LE.0) THEN
- IDUMMY(1) = 0
- IDUMMY(2) = ISMA
- GO TO 1
- ELSEIF(IEXPO.GT.255) THEN
- IDUMMY(1) = NOT(0)
- IDUMMY(2) = IBIG
- GO TO 1
- END IF
- IDUMMY(2) =
- + IOR(ISHFT(IARRAY(J),16+ILEFT),
- + ISHFT(ISHFT(IARRAY(J),9+ILEFT),-25))
- IDUMMY(2) = IOR(IDUMMY(2),ISHFT(IEXPO,7))
- 1 IF(BTEST(IARRAY(J),31)) IDUMMY(2) = IBSET(IDUMMY(2),15)
- IARRAY(2*J-1) = IDUMMY(1)
- IARRAY(2*J ) = IDUMMY(2)
- 2 CONTINUE
- 999 END
diff --git a/src/packlib/kernlib/kernbit/obsolete/m214/sxsvx.F b/src/packlib/kernlib/kernbit/obsolete/m214/sxsvx.F
deleted file mode 100644
index 5cd1f6e..0000000
--- a/src/packlib/kernlib/kernbit/obsolete/m214/sxsvx.F
+++ /dev/null
@@ -1,82 +0,0 @@
-*
-* $Id: sxsvx.F,v 1.1.1.1 1996/02/15 17:47:36 mclareni Exp $
-*
-* $Log: sxsvx.F,v $
-* Revision 1.1.1.1 1996/02/15 17:47:36 mclareni
-* Kernlib
-*
-*
-#include "kernbit/pilot.h"
-#if defined(CERNLIB_QMIBMVF)
- at PROCESS DIRECTIVE ('*VDIR:')
-#endif
- SUBROUTINE SXSVX(IARRAY,NWORDS)
-C
-C This is a subroutine to convert from IBM short floating
-C point format (32 bits) to VAX short floating point format
-C (32 Bits)
-C
-C IARRAY an area of storage 32*NWORDS bits long in which
-C are stored NWORDS 32 bits IBM floating point
-C numbers. On output it will contain NWORDS
-C 32 bits VAX floating point numbers
-C
-C NWORDS number of floating point numbers to convert
-C
-C
-C IBM format : seee eeee mmmm mmmm mmmm mmmm mmmm mmmm
-C VAX format : mmmm mmmm mmmm mmmm seee eeee emmm mmmm
-C
-C
- DIMENSION IARRAY(*)
- DIMENSION J1(0:15), J2(0:15)
-
- DATA MSKA24 /Z 00FF FFFF/
- DATA MSKB24 /Z 00F0 0000/
- DATA MSKB31 /Z 7F00 0000/
- DATA MSKA32 /Z 8000 0000/
- DATA IBIG /Z FFFF 7FFF/
- DATA ISMA /Z 0000 0080/
- DATA J1 / 0, 384, 256, 256, 128, 128, 128, 128,
- . 0, 0, 0, 0, 0, 0, 0, 0/
- DATA J2 / 1, 8, 4, 4, 2, 2, 2, 2,
- . 1, 1, 1, 1, 1, 1, 1, 1/
-
-
- PARAMETER (LVMIN = 20)
-
- IF (NWORDS.GE.LVMIN) THEN
-C*VDIR: PREFER VECTOR
- DO 1 J=1,NWORDS
- INDX = ISHFT (IAND (MSKB24,IARRAY(J)),-20)
- JEXP = ISHFT (IAND (MSKB31,IARRAY(J)),-15)-J1(INDX)-16384
- JSGN = ISHFT (IAND (MSKA32,IARRAY(J)),-16)
- JMANT = IAND (MSKA24,IARRAY(J))*J2(INDX)
- JDUM = IOR (ISHFT(JMANT,16),ISHFT(ISHFT(JMANT,9),-25))
- JDUM = IOR (IOR (JDUM,JEXP),JSGN)
-C
-C 127 is 0 7 positions left-shifted.
-C 32649 is 255 7 positions left-shifted.
-C
- IF (JEXP.LT. 127) JDUM = ISMA
- IF (JEXP.GT. 32640) JDUM = IBIG
-
- IF (IARRAY(J).NE.0) IARRAY(J) = JDUM
- 1 CONTINUE
-
- ELSE IF (NWORDS.GT.0) THEN
-C*VDIR: PREFER SCALAR
- DO 2 J=1,NWORDS
- INDX = ISHFT (IAND (MSKB24,IARRAY(J)),-20)
- JEXP = ISHFT (IAND (MSKB31,IARRAY(J)),-15)-J1(INDX)-16384
- JSGN = ISHFT (IAND (MSKA32,IARRAY(J)),-16)
- JMANT = IAND (MSKA24,IARRAY(J))*J2(INDX)
- JDUM = IOR (ISHFT(JMANT,16),ISHFT(ISHFT(JMANT,9),-25))
- JDUM = IOR (IOR (JDUM,JEXP),JSGN)
- IF (JEXP.LT. 127) JDUM = ISMA
- IF (JEXP.GT. 32640) JDUM = IBIG
- IF (IARRAY(J).NE.0) IARRAY(J) = JDUM
- 2 CONTINUE
- ENDIF
-
- END
diff --git a/src/packlib/kernlib/kernbit/obsolete/m216/Imakefile b/src/packlib/kernlib/kernbit/obsolete/m216/Imakefile
deleted file mode 100644
index 630c93c..0000000
--- a/src/packlib/kernlib/kernbit/obsolete/m216/Imakefile
+++ /dev/null
@@ -1,4 +0,0 @@
-SRCS_F= \ @@\
- concdc.F errlog.F getwi.F readwi.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kernbit/obsolete/m216/cdc_a4.s b/src/packlib/kernlib/kernbit/obsolete/m216/cdc_a4.s
deleted file mode 100644
index 87edaed..0000000
--- a/src/packlib/kernlib/kernbit/obsolete/m216/cdc_a4.s
+++ /dev/null
@@ -1,103 +0,0 @@
-*
-* $Id: cdc_a4.s,v 1.1.1.1 1996/02/15 17:47:37 mclareni Exp $
-*
-* $Log: cdc_a4.s,v $
-* Revision 1.1.1.1 1996/02/15 17:47:37 mclareni
-* Kernlib
-*
-*
-CDC$A4 CSECT
-#if defined(CERNLIB_QMIBMXA)
-CDC$A4 AMODE ANY
-CDC$A4 RMODE ANY
-#endif
-*
-* CALL CDC$A4(CDCBUF,IBMBUF,LEN,BYTWD,FILL)
-*
-* CDCBUF: Array of 64-bit words containig a 60-bit CDC word
-* right justified (output of READWI)
-* IBMBUF: Any memory space of at least LEN*BYTWD bytes
-* LEN : Number of CDC words to decode
-* BYTWD : Number of characters taken from each CDC word (Optional,
-* defaults to 4
-* FILL : Optional value to be stored in CDCBUF (padded to 64 bits on
-* the left) to avoid Error 14 from CONCDC
-*
-* Note: a CDC word contains 10 6-bit CDC characters; they are transla-
-* ted from CDC Display 6-bit code to EBCDIC 8-bit code, and assembled
-* contiguously into IBMBUF (whose word boundaries are ignored). Only
-* if BYTWD=4 the CDC and IBM word counts are equal, with the loss of
-* of the 6 rightmost CDC characters (normally not used if the program
-* was written for 32-bit machines).
-* If BYTWD > 10 blanks are added to the right of the 10 characters of
-* each CDC word.
- SPACE
-R0 EQU 0
-R1 EQU 1
-R2 EQU 2
-R3 EQU 3
-R4 EQU 4
-R5 EQU 5
-R6 EQU 6
-R7 EQU 7
-R8 EQU 8
-R9 EQU 9
-R10 EQU 10
-R11 EQU 11
-R12 EQU 12
-R13 EQU 13
-R14 EQU 14
-R15 EQU 15
- PRINT NOGEN
- USING *,R15
- B START
- DC X'07',CL7'CDC$A4'
-SAVEAREA DS 3F
- SPACE
-START STM R14,R12,12(R13)
- LR R12,R13
- LA R13,SAVEAREA
- ST R13,8(R12)
- ST R12,4(R13)
- USING SAVEAREA,R13
- DROP R15
- LM R2,R6,0(R1) Get addr of args
- XR R8,R8 For filler
- LTR R4,R4 Length last parm?
- BM DEFBYTSW Yes, set default BYTWD & fill
- LTR R5,R5 BYTWD last parm?
- BNM BYTESWD No, all parms given - do work
- B DEFFILL Yes, set default filler
-DEFBYTSW LA R5,=F'4' Our default for BYTWD
-DEFFILL XR R6,R6 ...and clear Filler address
-BYTESWD L R4,0(R4) Get length of array
-LOOP LM R10,R11,0(R2) <--+ Get a word (odd)
- SLDL R10,2 | Shift left R10-R11 2 bits
- L R7,0(R5) | Get Bytes per Word in R7 (loop count)
-LOOPC STCM R10,MSB,0(R3) <+ | Store in output array (8 bits)
- NI 0(R3),X'3F' | | Clear leftmost 2 bits
- TR 0(1,R3),CDCTB | | Translate CDC Display Code to EBCDIC
- LA R3,1(R3) | | Point to next byte (output)
- SLDL R10,6 | | Shift-in next CDC character or blank
- BCT R7,LOOPC ------+ | Loop for next CDC character
- LTR R6,R6 | Filler required?
- BZ NOFILL | No
- L R9,0(R6) | Yes, get it
- STM R8,R9,0(R2) | Store it in place (input)
-NOFILL LA R2,8(R2) | Point to next CDC word (input)
- BCT R4,LOOP ---------+ Loop for next CDC word
-END L R13,4(R13)
-** MVI 12(R13),X'FF'
- LM R2,R12,28(R13)
- BR R14
- SPACE 3
-* 0123456701234567 octal
-*
-CDCTB DC C' ABCDEFGHIJKLMNO' 00-17
- DC C'PQRSTUVWXYZ01234' 20-37
- DC C'56789+-*/()$= ,.' 40-57
- DC C'#[]%"_!&&''?<>@\^;' 60-77
-*
-MSB EQU B'1000' Most significant byte (leftmost)
- LTORG
- END
diff --git a/src/packlib/kernlib/kernbit/obsolete/m216/concdc.F b/src/packlib/kernlib/kernbit/obsolete/m216/concdc.F
deleted file mode 100644
index 585015d..0000000
--- a/src/packlib/kernlib/kernbit/obsolete/m216/concdc.F
+++ /dev/null
@@ -1,125 +0,0 @@
-*
-* $Id: concdc.F,v 1.1.1.1 1996/02/15 17:47:37 mclareni Exp $
-*
-* $Log: concdc.F,v $
-* Revision 1.1.1.1 1996/02/15 17:47:37 mclareni
-* Kernlib
-*
-*
-#include "kernbit/pilot.h"
- SUBROUTINE CONCDC(DWORD,N,SWORD,IERR,LERR)
-C
-C Authors: Eric McINTOSH - Elia PEROTTO Sept.1986
-C
-C This routine tries to convert CDC format single precision integers
-C and floating point numbers to IBM single precision.
-C The input data is assumed to be stored 60 bits per 64-bit IBM word
-C (right justified) and the 32-bit results are stored in SWORD which
-C may replace the input.
-C
-C DWORD : the REAL*8 input array of 60 in 64 bit data
-C N : the number of data items to be converted
-C SWORD : the single precision 32-bit array of results
-C IERR : will be set non-zero if at least one error was detected
-C LERR : if .LT. zero no errors are listed,
-C if .EQ. zero errors are listed on standard output,
-C if .GT. zero on logical unit LERR.
-C
- DIMENSION SWORD (*)
- CHARACTER*10 A10
- REAL*8 DWORD (*) , WORD, RWORD
- INTEGER IWORD(2) , JWORD(2), KWORD(2)
- EQUIVALENCE (IWORD(1),WORD), (KWORD(1),RWORD), (LWORD,TWORD)
- LOGICAL INT,ERROR
- DATA M1/Z00000001/, M12/Z00000FFF/
- 1 M28/Z0FFFFFFF/, M31/Z7FFFFFFF/, M32/ZFFFFFFFF/
-C
-C IERR reports at least one special case occurence if non-zero
-C special cases are listed on standard output (LERR = 0) or on
-C unit LERR (LERR > 0) or ignored (LERR < 0).
-C
- IERR = 0
- DO 1 I=1,N
- ERROR = .FALSE.
- INT = .FALSE.
-C for debugging
-C IERR = 99
-C ERROR = .TRUE.
-C
- WORD = DWORD (I)
- ISIGN = IAND( ISHFT( IWORD(1),-27 ) , M1)
- IF ( ISIGN .NE. 0 ) THEN
- JWORD (1) = IEOR ( IWORD(1),M28)
- JWORD (2) = IEOR ( IWORD(2),M32 )
- ELSE
- JWORD(1) = IWORD (1)
- JWORD(2) = IWORD (2)
- ENDIF
- IEXP = IAND ( ISHFT (JWORD(1),-16) , M12)
- RWORD = DWORD(I)
- IF (JWORD(1) .EQ. 0 ) THEN
-C we can assume an integer (almost)
- INT = .TRUE.
- ISIGN2 = IAND (ISHFT (JWORD(2),-31) , M1)
- IF (ISIGN2 .NE. 0 .AND. ISIGN .EQ. 0) THEN
- IERR = 11
- ERROR = .TRUE.
-C this is a too big positive integer or underflow
- INT = .FALSE.
- ENDIF
- ELSE
-C we have to assume floating point even if integer is too big ???
- IF (IEXP .EQ. 2047) THEN
-C infinite value
- IERR = 12
- ERROR = .TRUE.
- ELSEIF (IEXP .EQ. 1023) THEN
-C indefinite value
- IERR = 13
- ERROR = .TRUE.
- ELSEIF (IEXP .EQ. 0) THEN
-C underflow perhaps or a very big integer
- IERR = 11
- ERROR = .TRUE.
- ELSEIF (IEXP .GE. 1229 .OR. IEXP .LE. 715) THEN
-C not in IBM range
- IERR = 14
- ERROR = .TRUE.
- ENDIF
- ENDIF
- IF (ERROR) THEN
- CALL CDC$A4(DWORD(I),A10,1,10)
- IF (IERR .EQ. 11 .OR. IERR .EQ. 13) THEN
- KWORD(1) = 0
- KWORD(2) = 0
- ENDIF
- ENDIF
- CALL CVT76A (RWORD, 1)
- IF (INT) THEN
- LWORD = KWORD (2)
- SWORD(I) = TWORD
- ELSE
- SWORD(I) = SNGL(RWORD)
- ENDIF
- IF (ERROR) THEN
- IF (LERR .EQ. 0) THEN
- WRITE (*,100) I,IERR, WORD, ISIGN, IEXP, IEXP, A10,
- 1 RWORD, RWORD, KWORD(1), KWORD (2),
- 2 SWORD(I), SWORD(I), KWORD(2)
- ELSEIF (LERR .GT. 0) THEN
- WRITE (LERR,100) I,IERR, WORD, ISIGN, IEXP, IEXP, A10,
- 1 RWORD, RWORD, KWORD(1), KWORD (2),
- 2 SWORD(I), SWORD(I), KWORD(2)
- ENDIF
- ENDIF
- 1 CONTINUE
- RETURN
-C
- 100 FORMAT(/,' ITEM NO ',I10,
- 1 /,' CONCDC ERROR DETECTED: IERR = ',I2,
- 2 ' (11=BIG INTEGER/UNDERFLOW, 12=INF, 13=IND, 14=RANGE)',
- 3 /,' INPUT = ',Z16,' SIGN = ',I1,' EXP = ',I4,' #',Z3,
- + ' CHAR = ''',A10,'''',
- 4 /,' VALUE = ',Z16,E25.15,I15,I15,
- 5 /,' SNGLE = ',Z8,8X,E17.7,8X,I15)
- END
diff --git a/src/packlib/kernlib/kernbit/obsolete/m216/cvt76a.s b/src/packlib/kernlib/kernbit/obsolete/m216/cvt76a.s
deleted file mode 100644
index 4f940f0..0000000
--- a/src/packlib/kernlib/kernbit/obsolete/m216/cvt76a.s
+++ /dev/null
@@ -1,123 +0,0 @@
-*
-* $Id: cvt76a.s,v 1.1.1.1 1996/02/15 17:47:37 mclareni Exp $
-*
-* $Log: cvt76a.s,v $
-* Revision 1.1.1.1 1996/02/15 17:47:37 mclareni
-* Kernlib
-*
-*
-NAME TITLE 'TITLE'
-CVT76A CSECT CONVERTS FROM CDC REAL FORMAT TO
-#if defined(CERNLIB_QMIBMXA)
-CVT76A AMODE ANY
-CVT76A RMODE ANY
-#endif
- PRINT DATA IBM REAL FORMAT
-*
-* CALLED FROM FORTRAN AS
-* CALL CVT76A(DATA,N) WHERE DATA IS STRING OF N REAL*8
-* CDC REPRESENTATION FLOATING POINT
-* OR INTEGER WORDS. RESULT IS PUT BACK
-* IN ARRAY DATA. FLOATING POINT NUMBERS
-* ARE PUT BACK AS REAL*8 WHEREAS INTEGERS
-* ARE PUT AS INTEGER*4 IN LOWER HALF OF
-* THE 'REAL*8' WORD. INTEGER OVER/UNDERFLOW
-* ARE SET TO MAX INTEGER WITH CORRECT SIGN.
-*
- USING CVT76A,15
- B START NUMBERS OUT OF RANGE OF IBM
- DC X'07',CL7'CVT76A' SET TO ZERO OR OVERFLOW
-SAVE DS 18F AS APPROPRIATE
- SPACE
-START STM 14,12,12(13) SAVE REGISTERS
- LR 12,13
- LA 13,SAVE
- ST 12,4(13)
- ST 13,8(12)
- DROP 15
- USING SAVE,13
- L 11,4(1) ADRESS OF N
- L 11,0(11) VALUE OF N-- ARRAY SIZE
- LTR 11,11 CHECK FOR N GT 0
- BC 12,EPILOG
- SPACE 2
- L 1,0(1) ADDRESS OF ARRAY
-SIGN EQU 3 SET UP REGISTERS WITH CONSTANTS
-R2 EQU 4
-R3 EQU 5
-X2CD EQU 6
-ZERO EQU 7
-F EQU 8
-E EQU 10
- SR 7,7
- LM 4,6,CONSTS
-LOOP LH E,0(1) LOAD EXPONENT INTO E
- N E,=X'00000FFF'
- L F,0(1) LOAD MANTISSA INTO F AND F+1
- N F,=X'0000FFFF'
- L F+1,4(1)
- LR SIGN,ZERO
- LR 2,E CHECK FOR NEGATIVE ARG.
- S 2,=XL4'800'
- BM POSNUM IF NEG COMPLEMENT WORD
- X E,=X'00000FFF' AND SET SIGN FLAG
- X F,=X'0000FFFF'
- X F+1,=X'FFFFFFFF'
- LA SIGN,128(SIGN)
-POSNUM LTR 2,E
- BZ INTEGR CHECK IF INTEGER
- SR 2,R2 IF EXPONENT NEG. ADD 1
- BNM POSEXP
- LA E,1(E)
-POSEXP SR E,X2CD CORRECT BIAS OF EXPONENT
- LR 2,E TEST FOR EXPONENT IN RANGE
- SRA 2,9
- CR 2,ZERO
- BZ INRNGE
- BH OVFLOW
-UNFLOW ST ZERO,0(1) SET RETURN ARG. TO ZERO
- ST ZERO,4(1)
- B NEXT
-OVFLOW L 2,=X'FFFFFFFF' SET RETURN ARG. TO OVERFLOW
- ST 2,4(1)
- CR SIGN,ZERO
- BNE NEGOV
- SRL 2,1
-NEGOV ST 2,0(1)
- B NEXT
-INRNGE LR 2,E CHANGE EXPONENT TO BASE 16
- NR 2,R3
- N E,=XL4'FFFC'
- SLDA F,5(2) SHIFT MANTISSA
-CONT SRA E,2
- AR E,SIGN PACK SIGN BIT INTO EXP.
-GONOW ST F,0(1) PACK EXPONENT AND MANTISSA
- ST F+1,4(1) INTO R*8 REPLY
- STC E,0(1)
- B NEXT
-INTEGR ST ZERO,0(1)
- LTR F,F
- BNZ TOOLRG
- LTR F+1,F+1
- BM TOOLRG
- LTR SIGN,SIGN
- BZ GOINT
- LCR F+1,F+1
- B GOINT
-TOOLRG L F+1,=X'7FFFFFFF'
- LTR SIGN,SIGN
- BZ GOINT
- L F+1,=X'80000000'
-GOINT ST F+1,4(1)
-NEXT LA 1,8(1) INCREMENT ADRESS POINTER
- BCT 11,LOOP GO BACK IF ANY MORE
- B EPILOG
- SPACE 2
- DS 0F
-CONSTS DC XL4'400',F'3',XL4'2CD'
-EPILOG L 13,SAVE+4 PICK UP OLD SAVE AREA
- L 14,12(13) RETURN ADDRESS
- LM 2,12,28(13) RESTORE REG 1 AND 2
-** MVI 12(13),X'FF' SIGNAL RETURN
- BR 14
- END
diff --git a/src/packlib/kernlib/kernbit/obsolete/m216/errlog.F b/src/packlib/kernlib/kernbit/obsolete/m216/errlog.F
deleted file mode 100644
index 4a4d12e..0000000
--- a/src/packlib/kernlib/kernbit/obsolete/m216/errlog.F
+++ /dev/null
@@ -1,49 +0,0 @@
-*
-* $Id: errlog.F,v 1.1.1.1 1996/02/15 17:47:37 mclareni Exp $
-*
-* $Log: errlog.F,v $
-* Revision 1.1.1.1 1996/02/15 17:47:37 mclareni
-* Kernlib
-*
-*
-#include "kernbit/pilot.h"
- SUBROUTINE ERRLOG (LUN,REC,MAXN,IERR,N,LERR,NBYTE,
- 1 IOERR,NBLOCK,IBLOCK,ITOFW,IRECNO,NWORD,
- 2 ITYPE,IBIT,IBEGIN,ICOUNT,SKIP,NEXTW,
- 3 SEVSIX,IWORDS)
- REAL * 8 REC (*)
- LOGICAL * 1 SKIP,SEVSIX
- IF (LERR .LT. 0) RETURN
- IF (LERR .EQ. 0) THEN
- WRITE (*,100) LUN,MAXN,LERR,IERR,NBYTE,N
- WRITE (*,101) IOERR,NBLOCK,IBLOCK
- WRITE (*,102) IRECNO,ITOFW,NWORD
- WRITE (*,103) SKIP,NEXTW,ITYPE,IBIT,IBEGIN,ICOUNT
- WRITE (*,106) SEVSIX,IWORDS
- IF (NWORD .NE. 0) WRITE (*,105)
- DO 1 J=1,NWORD,5
- 1 WRITE (*,104) J,(REC(I),I=J,J+4)
- ELSE
- WRITE (LERR,100) LUN,MAXN,LERR,IERR,NBYTE,N
- WRITE (LERR,101) IOERR,NBLOCK,IBLOCK
- WRITE (LERR,102) IRECNO,ITOFW,NWORD
- WRITE (LERR,103) SKIP,NEXTW,ITYPE,IBIT,IBEGIN,ICOUNT
- WRITE (*,106) SEVSIX,IWORDS
- IF (NWORD .NE. 0) WRITE (LERR,105)
- DO 2 J=1,NWORD,5
- 2 WRITE (LERR,104) J,(REC(I),I=J,J+4)
- ENDIF
- RETURN
- 100 FORMAT(/,' READWI CALLED WITH LUN = ',I5,' MAXN = ',I10,
- 1' LERR = ',I5,' REPORTS',/,' ERROR NO ',I5,
- 2' BYTES READ = ',I10,' WORDS RETURNED = ',I10)
- 101 FORMAT(/,' IOERR = ',I5,' NBLOCK = ',I10,' IBLOCK = ',I10)
- 102 FORMAT(' IRECNO = ',I10,' ITOFIRSTW = ',I10,' NWORDS = ',I10)
- 103 FORMAT(' SKIPPING WAS ',L3,' NEXTW = ',I10,' RECORD TYPE ',I5,
- 1' NORMAL, DELETED, EOP, EOS 0-3',/,' RECORD PORTION ',I5,
- 2' COMPLETE, FIRST, MIDDLE, LAST 0-3 ','IBEGIN = ',I10,
- 3' ICOUNT = ',I10)
- 104 FORMAT(I10,5Z20)
- 105 FORMAT(//)
- 106 FORMAT(' SEVSIX WAS ',L3,' IWORDS ',I10)
- END
diff --git a/src/packlib/kernlib/kernbit/obsolete/m216/getwi.F b/src/packlib/kernlib/kernbit/obsolete/m216/getwi.F
deleted file mode 100644
index 8ac73d9..0000000
--- a/src/packlib/kernlib/kernbit/obsolete/m216/getwi.F
+++ /dev/null
@@ -1,15 +0,0 @@
-*
-* $Id: getwi.F,v 1.1.1.1 1996/02/15 17:47:37 mclareni Exp $
-*
-* $Log: getwi.F,v $
-* Revision 1.1.1.1 1996/02/15 17:47:37 mclareni
-* Kernlib
-*
-*
-#include "kernbit/pilot.h"
- SUBROUTINE GETWI(LUN,ARRAY,MAXN,RESULT,IERR,N,LERR)
- CALL READWI(LUN,ARRAY,MAXN,IERR,N,LERR)
- IF (IERR.NE.0) RETURN
- CALL CONCDC(ARRAY,N,RESULT,IERR,LERR)
- RETURN
- END
diff --git a/src/packlib/kernlib/kernbit/obsolete/m216/readwi.F b/src/packlib/kernlib/kernbit/obsolete/m216/readwi.F
deleted file mode 100644
index 1776454..0000000
--- a/src/packlib/kernlib/kernbit/obsolete/m216/readwi.F
+++ /dev/null
@@ -1,312 +0,0 @@
-*
-* $Id: readwi.F,v 1.1.1.1 1996/02/15 17:47:37 mclareni Exp $
-*
-* $Log: readwi.F,v $
-* Revision 1.1.1.1 1996/02/15 17:47:37 mclareni
-* Kernlib
-*
-*
-#include "kernbit/pilot.h"
- SUBROUTINE READWI(LUN,ARRAY,MAXN,IERR,N,LERR)
-C
-C THIS SUBROUTINE WILL READ ONE W RECORD FROM A CDC FILE (7600 OR
-C NOS/BE FORMAT) WHICH HAS BEEN CREATED WITH W/I FORMAT. THE TAPE
-C OR DISK FILE SHOULD BE IBM U FORMAT, ONE RECORD/BLOCK. IT IS
-C ASSUMED THAT EACH BLOCK IS 512 60-BIT WORDS OR LESS, AND EXCESS
-C BITS WILL BE IGNORED.
-C EACH CDC 60-BIT WORD IS STORED RIGHT-JUSTIFIED IN A 64-BIT ELEMENT
-C OF THE REAL*8 ARRAY. THIS BUFFER CAN THEN BE PASSED TO
-C CONCDC TO CONVERT FROM CDC 60-BIT INTEGER OR FLOATING POINT
-C FORMAT TO IBM 32/64 BIT INTEGER OR FLOATING POINT FORMAT.
-C
-C THE SUBROUTINE CAN ONLY PROCESS A SINGLE LOGICAL UNIT UNLESS
-C ALL LOGICAL UNIT CHANGES OCCUR AT BLOCK BOUNDARIES.
-C EVEN THEN THERE WOULD BE SPURIOUS BLOCK NUMBER ERRORS.
-C
-C
-C LUN FORTRAN LOGICAL UNIT NUMBER OF FILE TO READ.
-C ARRAY REAL*8 ARRAY FOR THE RECORD OF
-C MAXN MAXIMUM 60/64 BIT WORDS.
-C IERR THE ERROR CODE.
-C 0 NORMAL RECORD
-C 1 END OF FILE, IOREAD ERROR 2
-C 2 END OF PARTITION
-C 3 END OF SECTION
-C 4 END OF INFORMATION, IOREAD ERROR 4
-C 5 PARITY ERROR OR SUCH, IOREAD ERROR 3
-C 6 W CONTROL WORD ERROR
-C 7 IOREAD ERROR 1 - NO FILE OR BAD JCL/DCB I SUPPOSE
-C 8 BLOCK NUMBER ERROR (internal NOT returned)
-C 9 I CONTROL WORD ERROR
-C N NUMBER OF 64-BIT WORDS RETURNED (RECORD LENGTH).
-C LERR LOGICAL UNIT FOR ERROR REPORT AND SUMMARY.
-C -1 NO ERROR MESSAGES, NO SUMMARY.
-C 0 MESSAGES TO STANDARD OUTPUT (*).
-C L MESSAGES TO LOGICAL UNIT L.
-C
-C NO DATA IS RETURNED UNLESS IERR = 0. THE NEXT
-C CALL WILL CONTINUE PROCESSING DROPPING BAD DATA.
-C
-C E. MCINTOSH 16/6/86.
-C
- REAL * 8 ARRAY (*), REC (512)
- INTEGER IREC (1024)
- EQUIVALENCE (IREC(1),REC(1))
- LOGICAL * 1 IBYTE (3840)
-C
- LOGICAL * 1 SKIP,SEVSIX
-C
- INTEGER * 4 NEXTW,NWORD,NBLOCK,IWORDS
-C
-C SAVE SKIP,NEXTW,NWORD,NBLOCK,REC,SEVSIX,IWORDS
- DATA SKIP /.FALSE./, SEVSIX /.FALSE./
- DATA NEXTW /1/, NWORD /0/, NBLOCK /0/, IWORDS /0/
- DATA M2/Z3/, M10/Z3FF/, M12/ZFFF/, M14/Z3FFF/, M18/Z3FFFF/
-C
-C LIST OF VARIABLES
-C PARAMETERS : LUN, ARRAY, MAXN, IERR (VAR), N (VAR), LERR
-C NBLOCK : CURRENT BLOCK ORDINAL (MOD 4096)
-C IBLOCK : BLOCK ORDINAL FROM I CONTROL WORD
-C ITOFW : POINTER TO FIRST W CONTROL WORD IN BLOCK
-C IRECNO : RECORD ORDINAL (MOD 2**24)
-C NBYTE : NO OF BYTES RETURNED FROM IOPACK
-C NWORD : NO OF 60-BIT WORDS IN BLOCK
-C IBIT : FLAG FOR FIRST, MIDDLE, LAST, ONLY PIECE OF RECORD
-C ITYPE : FLAG FOR NORMAL, EOS, EOP, DELETED RECORD
-C IBEGIN : INDEX TO FIRST DATA ITEM
-C ICOUNT : NUMBER OF DATA ITEMS IN CURRENT W SEGMENT
-C SEVSIX : TRUE IF WE HAVE 7600 FORMAT WI (FALSE = NOS/BE)
-C IWORDS : TOTAL LENGTH OF A 7600 W RECORD
-C
- IBLOCK = -1
- ITOFW = -1
- IRECNO = -1
- IBIT = -1
- ITYPE = -1
- IBEGIN = -1
- ICOUNT = -1
- IOERR = -1
- NBYTE = -1
-C
- N = 0
- IERR = 0
-C
- 10 IF (NEXTW.GT.NWORD) THEN
-C WE NEED A NEW BLOCK
- IF (NEXTW.NE.NWORD+1) THEN
-C SOMETHING WRONG EVEN IF SKIPPING
- IERR = 6
- SKIP = .TRUE.
- CALL ERRLOG (LUN,REC(1),MAXN,IERR,N,LERR,NBYTE,
- 1 IOERR,NBLOCK,IBLOCK,ITOFW,IRECNO,NWORD,
- 2 ITYPE,IBIT,IBEGIN,ICOUNT,SKIP,NEXTW,
- 3 SEVSIX,IWORDS)
- NWORD = 0
- NEXTW = 1
- RETURN
- ENDIF
-C TRY AND READ A NEW BLOCK
- NBYTE = 3840
- CALL IOGET (LUN,IBYTE(1),NBYTE,IOERR)
-C CALL IOREAD(LUN,IBYTE(1),NBYTE,IOERR)
-C
-C USED TO TEST PARITY ERROR HANDLING
-C IF ((NBLOCK/10)*10 .EQ. NBLOCK ) IOERR = 3
-C
- IF (IOERR.NE.0) THEN
- IF (IOERR.EQ.1) THEN
- IERR = 7
- ELSEIF (IOERR.EQ.2) THEN
- IERR = 1
- ELSEIF (IOERR.EQ.3) THEN
- IERR = 5
- ELSEIF (IOERR.EQ.4) THEN
- IERR = 4
- ELSE
- IERR=7
- ENDIF
- SKIP = .FALSE.
- IF (IERR.EQ.5) THEN
- SKIP = .TRUE.
- NBLOCK = NBLOCK+1
- IF (NBLOCK.GE.4096) NBLOCK = NBLOCK - 4096
- ENDIF
- ITEMP = (NBYTE+7)/8
- CALL ERRLOG (LUN,IBYTE(1),MAXN,IERR,N,LERR,NBYTE,
- 1 IOERR,NBLOCK,IBLOCK,ITOFW,IRECNO,ITEMP,
- 2 ITYPE,IBIT,IBEGIN,ICOUNT,SKIP,NEXTW,
- 3 SEVSIX,IWORDS)
- NWORD = 0
- NEXTW = 1
- N = 0
- RETURN
- ENDIF
-C GOT A NEW BLOCK NOW AT LAST
-C COUNT ONE MORE
- NBLOCK = NBLOCK + 1
- IF (NBLOCK.GE.4096) NBLOCK = NBLOCK - 4096
-C
-C REMEMBER SKIP MAY BE TRUE OR FALSE; SEE LATER
-C
-C NOW UNPACK 60 TO 64 BITS, IBYTE TO REC
-C
- CALL S$XTO4 (IBYTE,REC)
-C
-C COMPUTE THE NUMBER OF 60-BIT WORDS IN THE BLOCK
-C
- NWORD = (NBYTE*8) / 60
-C
-C UNPACK THE I CONTROL WORD
-C IBLOCK BITS 53-42 THE BLOCK ORDINAL MOD 4096
-C IRECNO BITS 41-18 THE RECORD ORDINAL MOD 2**24
-C ITOFW BITS 17-0 WORD NO OF 1ST W CONTROL WORD
-C ITOFW IS ALWAYS 1 FOR NOS/BE FILES BUT MAY BE
-C ZERO (IF ENTIRE BLOCK IS PART OF A RECORD) OR
-C GT 1 (IF LAST PART OF A RECORD)
-C IF THE FILE IS A 7600 TAPE.
-C
-C
- IF (NWORD .EQ. 0) GO TO 10
- ITOFW = IAND (IREC(2),M18)
- IRECNO = IAND ( ISHFT (IREC(2),-18),M14)
- 1 + ISHFT (IAND (IREC(1),M10),14)
- IBLOCK = IAND ( ISHFT (IREC(1),-10),M12)
-C CHECK THE BLOCK NUMBER
- IF (IBLOCK .NE. NBLOCK) THEN
- IERR = 8
- CALL ERRLOG (LUN,REC(1),MAXN,IERR,N,LERR,NBYTE,
- 1 IOERR,NBLOCK,IBLOCK,ITOFW,IRECNO,NWORD,
- 2 ITYPE,IBIT,IBEGIN,ICOUNT,SKIP,NEXTW,
- 3 SEVSIX,IWORDS)
- IERR = 0
- NBLOCK = IBLOCK
- ENDIF
-C CHECK ITOFW IS REASONABLE
- IF (ITOFW+1 .GT. NWORD) THEN
- IERR = 9
- CALL ERRLOG (LUN,REC(1),MAXN,IERR,N,LERR,NBYTE,
- 1 IOERR,NBLOCK,IBLOCK,ITOFW,IRECNO,NWORD,
- 2 ITYPE,IBIT,IBEGIN,ICOUNT,SKIP,NEXTW,
- 3 SEVSIX,IWORDS)
- NWORD = 0
- NEXTW = 1
- N = 0
- RETURN
- ENDIF
-C NOW SET UP NEXTW AND WSEG NOT FORGETTING THE 7600
-C
-C WE MUST SET UP FROM W CONTROL WORD NOS/BE OR 7600 AS FOLLOWS:
-C IF THE POINTER TO THE 1ST W CONTROL WORD IS 0 WE ASSUME A
-C 7600 CONTINUATION RECORD, IF IS NOT 1 WE ASSUME A 7600
-C CONTINUATION RECORD, LAST PIECE, OTHERWISE WE SET UP
-C ICOUNT = BITS 17-0 NUMBER OF WORDS IN THE SEGMENT
-C IBIT = BITS 43,42 AS 0 COMPLETE RECORD
-C 1 1ST PIECE
-C 2 MIDDLE PIECE
-C 3 LAST PIECE
-C ITYPE = BITS 58,57 AS 0 NORMAL RECORD
-C 1 DELETED RECORD
-C 2 END OF PARTITION
-C 3 END OF SECTION
-C BITS 23-18 UNUSED BIT COUNT ARE IGNORED
-C BITS 41-24 SIZE OF PREVIOUS + 1 FOR BACKSPACE ARE IGNORED
-C IBEGIN = ARRAY INDEX TO FIRST DATA ITEM
-C ICOUNT = THE NUMBER OF DATA ITEMS
-C
- IF (ITOFW .EQ. 0) THEN
- IF (.NOT.SEVSIX) GO TO 99
- IWORDS = IWORDS - (NWORD-1)
- NEXTW = NWORD + 1
- IF (IWORDS .EQ. 0) THEN
- IBIT = 3
- ELSE
- IBIT = 2
- ENDIF
- ITYPE = 0
- ICOUNT = NWORD - 1
- IBEGIN = 2
- GO TO 20
- ELSEIF (ITOFW .NE. 1) THEN
- IF (.NOT.SEVSIX) GO TO 99
- IWORDS = IWORDS - (ITOFW-1)
- IF (IWORDS .NE. 0) GO TO 99
- NEXTW = 1 + ITOFW
- IBIT = 3
- ITYPE = 0
- ICOUNT = ITOFW - 1
- IBEGIN = 2
- GO TO 20
- ELSE
-C DECODE A NORMAL W CONTROL WORD
- NEXTW = 2
- ENDIF
-C
- ENDIF
-C END OF NEED A NEW BLOCK; NOW WE HANDLE W AND DATA
-C
-C NOW WE DECODE A W CONTROL WORD
- IBEGIN = NEXTW + 1
- INDEX = NEXTW * 2
- ITYPE = IAND ( ISHFT (IREC(INDEX-1),-25),M2)
- IBIT = IAND ( ISHFT (IREC(INDEX-1),-10),M2)
- ICOUNT = IAND (IREC(INDEX),M18)
- NEXTW = NEXTW + ICOUNT + 1
- 20 CONTINUE
-C NOW WE HAVE DATA LET US VALIDATE ICOUNT
-C
-C USED TO TEST W CONTROL WORD ERRORS
-C IF ((NBLOCK/5)*5 .EQ. NBLOCK) ICOUNT = ICOUNT+10000
-C
- IF (ICOUNT .NE. 0) THEN
- IF (IBEGIN+ICOUNT-1 .GT. NWORD) THEN
-C FOR THE MOMENT WE HAVE TO ASSUME A 7600 FORMAT FILE
-C THE WORD COUNT IS FOR THE COMPLETE RECORD EVEN IF THIS
-C PIECE IS ONLY THE FIRST SEGMENT. WE SET UP IBIT TO 1
-C (1ST PIECE), IBEGIN IS OK, AND ITYPE IS 0 (NORMAL RECORD).
-C IWORDS IS USED TO CHECK CONSISTENCY WHEN WE GET THE REST.
- SEVSIX = .TRUE.
- IBIT = 1
- IWORDS = ICOUNT
- ICOUNT = NWORD - IBEGIN + 1
- IWORDS = IWORDS - ICOUNT
- NEXTW = NWORD + 1
- ENDIF
- ENDIF
-C NEXT WE CHECK FOR SKIPPING TO START OF NEW RECORD
- IF (SKIP) THEN
- IF (ITYPE .EQ. 0 .AND. IBIT .GE. 2) GO TO 10
-C I.E. IF NORMAL RECORD, MIDDLE OR LAST PIECE SKIP IT
- SKIP = .FALSE.
- ENDIF
-C NOW CHECK FOR TYPE OF RECORD
- IF (ITYPE .EQ. 1) GO TO 10
-C SKIP A DELETED RECORD
- IF (ITYPE .NE. 0) THEN
-C WE HAVE EOS OR EOP
- IERR = ITYPE
- IF (N .NE. 0) GO TO 99
-C INCOMPLETE RECORD INDICATES SOMETHING ROTTEN
- RETURN
- ENDIF
-C NEXT WE TRY AND TRANSFER TO USER
- IF (N + ICOUNT .GT. MAXN) THEN
- ICOUNT = MAXN - N
- IF (IBIT .EQ. 1 .OR. IBIT .EQ. 2) SKIP = .TRUE.
- ENDIF
- DO 40 I = 1,ICOUNT
- ARRAY (N+1) = REC (IBEGIN + I - 1)
- 40 N = N + 1
- IF (SKIP .OR. IBIT .EQ. 0 .OR. IBIT .EQ. 3) RETURN
-C ARRAY IS FULL (SKIP) OR END OF RECORD COMPLETE OR LAST PIECE
- GO TO 10
- 99 IERR = 6
- CALL ERRLOG (LUN,REC(1),MAXN,IERR,N,LERR,NBYTE,
- 1 IOERR,NBLOCK,IBLOCK,ITOFW,IRECNO,NWORD,
- 2 ITYPE,IBIT,IBEGIN,ICOUNT,SKIP,NEXTW,
- 3 SEVSIX,IWORDS)
- N=0
- SKIP = .TRUE.
- NWORD = 0
- NEXTW = 1
- RETURN
- END
diff --git a/src/packlib/kernlib/kernbit/obsolete/m216/s_xto4.s b/src/packlib/kernlib/kernbit/obsolete/m216/s_xto4.s
deleted file mode 100644
index 3af7abb..0000000
--- a/src/packlib/kernlib/kernbit/obsolete/m216/s_xto4.s
+++ /dev/null
@@ -1,46 +0,0 @@
-*
-* $Id: s_xto4.s,v 1.1.1.1 1996/02/15 17:47:37 mclareni Exp $
-*
-* $Log: s_xto4.s,v $
-* Revision 1.1.1.1 1996/02/15 17:47:37 mclareni
-* Kernlib
-*
-*
-S$XTO4 CSECT
-#if defined(CERNLIB_QMIBMXA)
-S$XTO4 AMODE ANY
-S$XTO4 RMODE ANY
-#endif
- PRINT NOGEN
- USING *,15
- B ROUNDSA
- DC X'07'
- DC CL7'S$XTO4'
-SAVEAREA DS 18F
-ROUNDSA STM 14,12,12(13)
- LR 12,13
- LA 13,SAVEAREA
- ST 13,8(12)
- ST 12,4(,13)
- USING SAVEAREA,13
- DROP 15
- LM 2,3,0(1) GET ADDRESS OF INPUT & OUTPUT ARRAYS
- LA 5,256(0) GET LENGTH OF ARRAY/2
- LA 4,4(0) GET NR TO SHIFT
-LOOP EQU *
- LM 10,12,0(2) GET FIRST WORD
- SRDL 10,0(4) SHIFT
- STM 10,11,0(3) STORE RESULT
- NI 0(3),X'0F' AND OUT TOP 4 BITS
- LA 3,8(3) UPDATE ADDRESS OF OUTPUT
- MVC 0(8,3),7(2) MOVE SECOND WORD
- NI 0(3),X'0F' AND OUT TOP FUR BITS
- LA 2,15(2) UPDATE POINTER
- LA 3,8(3) UPDATE ADDR OF OUTPUT
- BCT 5,LOOP LOOP OVER?
-END L 13,4(,13)
- LM 2,12,28(13)
- L 14,12(,13)
-** MVI 12(13),X'FF'
- BR 14
- END
diff --git a/src/packlib/kernlib/kernbit/obsolete/m218/Imakefile b/src/packlib/kernlib/kernbit/obsolete/m218/Imakefile
deleted file mode 100644
index 7ebcb8b..0000000
--- a/src/packlib/kernlib/kernbit/obsolete/m218/Imakefile
+++ /dev/null
@@ -1,4 +0,0 @@
-SRCS_F= \ @@\
- dcddx.F dcdsx.F dxdcd.F dxscd.F scddx.F scdsx.F sxdcd.F sxscd.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kernbit/obsolete/m218/dcddx.F b/src/packlib/kernlib/kernbit/obsolete/m218/dcddx.F
deleted file mode 100644
index 7cacbed..0000000
--- a/src/packlib/kernlib/kernbit/obsolete/m218/dcddx.F
+++ /dev/null
@@ -1,90 +0,0 @@
-*
-* $Id: dcddx.F,v 1.1.1.1 1996/02/15 17:47:38 mclareni Exp $
-*
-* $Log: dcddx.F,v $
-* Revision 1.1.1.1 1996/02/15 17:47:38 mclareni
-* Kernlib
-*
-*
-#include "kernbit/pilot.h"
- SUBROUTINE DCDDX(IARRAY,NWORDS)
-C
-C This is a subroutine to convert from CDC long floating
-C point format (120 Bits) to IBM double precision floating
-C point format (64 Bits)
-C
-C IARRAY an area of storage 128*NWORDS bits long in which
-C are stored NWORDS 120 bits CDC floating point
-C numbers right adjusted in pairs of 64 bits areas,
-C 60 bits in each pair, right adjusted with zero
-C fill. On output it will contain NWORDS 64 bits
-C IBM double precision floating point numbers one
-C next to the other.
-C
-C NWORDS number of floating point numbers to convert
-C
- DIMENSION IARRAY(*),IDUMMY(2)
- LOGICAL BTEST,SET,CLEAR
- DATA MASK/Z00FFFFFF/,IBIG/Z7FFFFFFF/,ISMALL/Z00100000/
- DATA ICEX/Z000007FF/,NCEX/ZFFFFFC00/
- IF(NWORDS.LE.0) GO TO 999
- DO 2 J=1,NWORDS
-C
-C Get sign and exponent
-C
- JJ = 4*J-3
- IEXPO = 0
- ISIGN = 0
- CALL BTMOVE(IARRAY(JJ),5,ISIGN,32,1)
- CALL BTMOVE(IARRAY(JJ),6,IEXPO,22,11)
-C
-C Check for exact 0
-C
- SET = BTEST(IARRAY(JJ),15).AND.BTEST(ISIGN,0)
- + .AND.BTEST(IEXPO,0)
- CLEAR = .NOT.(BTEST(IARRAY(JJ),15).OR. BTEST(ISIGN,0)
- + .OR. BTEST(IEXPO,0))
- IF(CLEAR.OR.SET) THEN
- IARRAY(2*J-1)=0
- IARRAY(2*J )=0
- GO TO 2
- END IF
- IF(ISIGN.NE.0) IEXPO = IAND(NOT(IEXPO),ICEX)
- IF(BTEST(IEXPO,10)) THEN
- IEXPO = IBCLR(IEXPO,10)
- ELSE
- IEXPO = IOR(NCEX,IEXPO+1)
- END IF
-C CDC EXP + CDC BIAS + CDC NORM + IBM BIAS
-C IEXPO = IEXPO + 48 + 260
- IEXPO = IEXPO + 308
- IF(IEXPO.GT.512) THEN
- IDUMMY(1)=IBIG
- IDUMMY(2)=NOT(0)
- GO TO 1
- ELSEIF(IEXPO.LT.1) THEN
- IDUMMY(1)=ISMALL
- IDUMMY(2)=0
- GO TO 1
- END IF
- IEX16 = (IEXPO)/4
- ILEFT = 4 - MOD(IEXPO,4)
- IF(ILEFT.EQ.4) THEN
- ILEFT = 0
- IEX16 = IEX16 - 1
- END IF
- IDUMMY(1) = ISHFT(IEX16,24)
- IDUMMY(2) = 0
- CALL BTMOVE(IARRAY(JJ),17,IDUMMY,9+ILEFT,48)
- CALL BTMOVE(IARRAY(JJ),81,IDUMMY,57+ILEFT,8-ILEFT)
- IF(ISIGN.NE.0) THEN
- IMASK = 2**(24-ILEFT)-1
- IDUMMY(1) = IOR(IAND(NOT(IMASK),IDUMMY(1)),
- + IAND(IMASK,NOT(IDUMMY(1))))
- IDUMMY(2) = NOT(IDUMMY(2))
- END IF
- 1 CALL SBIT(ISIGN,IDUMMY,32)
- IARRAY(2*J-1)=IDUMMY(1)
- IARRAY(2*J )=IDUMMY(2)
- 2 CONTINUE
- 999 END
diff --git a/src/packlib/kernlib/kernbit/obsolete/m218/dcdsx.F b/src/packlib/kernlib/kernbit/obsolete/m218/dcdsx.F
deleted file mode 100644
index bde4496..0000000
--- a/src/packlib/kernlib/kernbit/obsolete/m218/dcdsx.F
+++ /dev/null
@@ -1,82 +0,0 @@
-*
-* $Id: dcdsx.F,v 1.1.1.1 1996/02/15 17:47:38 mclareni Exp $
-*
-* $Log: dcdsx.F,v $
-* Revision 1.1.1.1 1996/02/15 17:47:38 mclareni
-* Kernlib
-*
-*
-#include "kernbit/pilot.h"
- SUBROUTINE DCDSX(IARRAY,NWORDS)
-C
-C This is a subroutine to convert from CDC long floating
-C point format (120 Bits) to IBM short floating point
-C format (32 Bits)
-C
-C IARRAY an area of storage 128*NWORDS bits long in which
-C are stored NWORDS 120 bits CDC floating point
-C numbers right adjusted in pairs of 64 bits areas,
-C 60 bits in each pair, right adjusted with zero
-C fill. On output it will contain NWORDS 32 bits
-C IBM floating point numbers one next to the other.
-C
-C NWORDS number of floating point numbers to convert
-C
- DIMENSION IARRAY(*)
- LOGICAL BTEST,SET,CLEAR
- DATA MASK/Z00FFFFFF/,IBIG/Z7FFFFFFF/,ISMALL/Z00100000/
- DATA ICEX/Z000007FF/,NCEX/ZFFFFFC00/
- IF(NWORDS.LE.0) GO TO 999
- DO 2 J=1,NWORDS
-C
-C Get exponent and sign
-C
- JJ = 4*J-3
- IEXPO = 0
- ISIGN = 0
- CALL BTMOVE(IARRAY(JJ),5,ISIGN,32,1)
- CALL BTMOVE(IARRAY(JJ),6,IEXPO,22,11)
-C
-C Check for exact 0
-C
- SET = BTEST(IARRAY(JJ),15).AND.BTEST(ISIGN,0)
- + .AND.BTEST(IEXPO,0)
- CLEAR = .NOT.(BTEST(IARRAY(JJ),15).OR. BTEST(ISIGN,0)
- + .OR. BTEST(IEXPO,0))
- IF(CLEAR.OR.SET) THEN
- IARRAY(J) = 0
- GO TO 2
- END IF
- IF(ISIGN.NE.0) IEXPO = IAND(NOT(IEXPO),ICEX)
- IF(BTEST(IEXPO,10)) THEN
- IEXPO = IBCLR(IEXPO,10)
- ELSE
- IEXPO = IOR(NCEX,IEXPO+1)
- END IF
-C CDC EXP + CDC BIAS + CDC NORM + IBM BIAS
-C IEXPO = IEXPO + 48 + 260
- IEXPO = IEXPO + 308
- IF(IEXPO.GT.512) THEN
- IDUMMY=IBIG
- GO TO 1
- ELSEIF(IEXPO.LT.1) THEN
- IDUMMY=ISMALL
- GO TO 1
- END IF
- IEX16 = (IEXPO)/4
- ILEFT = 4 - MOD(IEXPO,4)
- IF(ILEFT.EQ.4) THEN
- ILEFT = 0
- IEX16 = IEX16 - 1
- END IF
- IDUMMY = ISHFT(IEX16,24)
- CALL BTMOVE(IARRAY(JJ),17,IDUMMY,9+ILEFT,24-ILEFT)
- IF(ISIGN.NE.0) THEN
- IMASK = 2**(24-ILEFT)-1
- IDUMMY = IOR(IAND(NOT(IMASK),IDUMMY),
- + IAND(IMASK,NOT(IDUMMY)))
- END IF
- 1 CALL SBIT(ISIGN,IDUMMY,32)
- IARRAY(J) = IDUMMY
- 2 CONTINUE
- 999 END
diff --git a/src/packlib/kernlib/kernbit/obsolete/m218/dxdcd.F b/src/packlib/kernlib/kernbit/obsolete/m218/dxdcd.F
deleted file mode 100644
index f4c6d72..0000000
--- a/src/packlib/kernlib/kernbit/obsolete/m218/dxdcd.F
+++ /dev/null
@@ -1,83 +0,0 @@
-*
-* $Id: dxdcd.F,v 1.1.1.1 1996/02/15 17:47:38 mclareni Exp $
-*
-* $Log: dxdcd.F,v $
-* Revision 1.1.1.1 1996/02/15 17:47:38 mclareni
-* Kernlib
-*
-*
-#include "kernbit/pilot.h"
- SUBROUTINE DXDCD(IARRAY,NWORDS)
-C
-C This is a subroutine to convert from IBM double precision
-C floating point format (64 Bits) to CDC long floating point
-C format (120 Bits)
-C
-C IARRAY an area of storage 120*NWORDS bits long in which
-C are stored one next to the other NWORDS 64 bits
-C IBM floating point numbers. On output it will
-C contain NWORDS 120 bits CDC floating point numbers
-C stored in pair of 64 bits areas, 60 bits per area,
-C right adjusted with zero fill
-C
-C NWORDS number of floating point numbers to convert
-C
- DIMENSION IARRAY(*),IDUMMY(2)
- LOGICAL BTEST
- DOUBLE PRECISION ZERO(2),ONE(2)
- DATA ZERO / Z0000 0000 0000 0000,
- + Z0000 0000 0000 0000/,
- + ONE / ZFFFF FFFF FFFF FFFF,
- + ZFFFF FFFF FFFF FFFF/
- IF(NWORDS.LE.0) GO TO 999
- DO 2 J=NWORDS,1,-1
-C
-C Get exponent and sign
-C
- JJ = 4*J - 3
- IDUMMY(1) = IARRAY(2*J-1)
- IDUMMY(2) = IARRAY(2*J )
- ISIGN = ISHFT(IDUMMY(1),-31)
- IEXPO = ISHFT(IDUMMY(1),1)
- IEXPO = ISHFT(IEXPO,-25)
- IF(BTEST(IDUMMY(1),23)) THEN
- ILEFT = 0
- ELSEIF(BTEST(IDUMMY(1),22)) THEN
- ILEFT = 1
- ELSEIF(BTEST(IDUMMY(1),21)) THEN
- ILEFT = 2
- ELSEIF(BTEST(IDUMMY(1),20)) THEN
- ILEFT = 3
- END IF
- IEXPO = IEXPO * 4 - ILEFT - 48 - 256
- IEXP1 = IEXPO - 48
- IF(IEXPO.GE.0) THEN
- IEXPO = IBSET(IEXPO,10)
- ELSE
- IEXPO = IBCLR(IEXPO-1,10)
- END IF
- IF(IEXP1.GE.0) THEN
- IEXP1 = IBSET(IEXP1,10)
- ELSE
- IEXP1 = IBCLR(IEXP1-1,10)
- END IF
- CALL VZERO(IARRAY(JJ),4)
- IF(ISIGN.EQ.0) THEN
- CALL BTMOVE(IEXPO,22,IARRAY(JJ),6,11)
- CALL BTMOVE(IDUMMY(1),9+ILEFT,IARRAY(JJ),17,48)
- CALL BTMOVE(IEXP1,22,IARRAY(JJ),70,11)
- CALL BTMOVE(IDUMMY(1),57+ILEFT,IARRAY(JJ),81,8-ILEFT)
- ELSE
- CALL BTMOVE(ONE ,1,IARRAY(JJ),5,60)
- CALL BTMOVE(ONE ,1,IARRAY(JJ),69,60)
- CALL BTMOVE(NOT(IEXPO),22,IARRAY(JJ),6,11)
- CALL BTMOVE
- + (NOT(IDUMMY(1)),9+ILEFT,IARRAY(JJ),17,24-ILEFT)
- CALL BTMOVE
- + (NOT(IDUMMY(2)),1,IARRAY(JJ),41-ILEFT,24+ILEFT)
- CALL BTMOVE(NOT(IEXP1),22,IARRAY(JJ),70,11)
- CALL BTMOVE
- + (NOT(IDUMMY(2)),25+ILEFT,IARRAY(JJ),81,8-ILEFT)
- END IF
- 2 CONTINUE
- 999 END
diff --git a/src/packlib/kernlib/kernbit/obsolete/m218/dxscd.F b/src/packlib/kernlib/kernbit/obsolete/m218/dxscd.F
deleted file mode 100644
index 23554e4..0000000
--- a/src/packlib/kernlib/kernbit/obsolete/m218/dxscd.F
+++ /dev/null
@@ -1,68 +0,0 @@
-*
-* $Id: dxscd.F,v 1.1.1.1 1996/02/15 17:47:38 mclareni Exp $
-*
-* $Log: dxscd.F,v $
-* Revision 1.1.1.1 1996/02/15 17:47:38 mclareni
-* Kernlib
-*
-*
-#include "kernbit/pilot.h"
- SUBROUTINE DXSCD(IARRAY,NWORDS)
-C
-C This is a subroutine to convert from IBM double precision
-C floating point format (64 Bits) to CDC short floating
-C point format (60 Bits)
-C
-C IARRAY an area of storage 64*NWORDS bits long in which
-C are stored one next to the other NWORDS 32 bits
-C IBM floating point numbers. On output it will
-C contain NWORDS 60 bits CDC floating point numbers
-C right adjusted in 64 bits areas.
-C
-C NWORDS number of floating point numbers to convert
-C
- DIMENSION IARRAY(*),IDUMMY(2)
- LOGICAL BTEST
- DOUBLE PRECISION ZERO,ONE
- DATA ZERO / Z0000 0000 0000 0000 /
- DATA ONE / ZFFFF FFFF FFFF FFFF /
- IF(NWORDS.LE.0) GO TO 999
- DO 2 J=1,NWORDS
-C
-C Get exponent and sign
-C
- JJ = 2*J-1
- IDUMMY(1) = IARRAY(2*J-1)
- IDUMMY(2) = IARRAY(2*J )
- ISIGN = ISHFT(IDUMMY(1),-31)
- IEXPO = ISHFT(IDUMMY(1),1)
- IEXPO = ISHFT(IEXPO,-25)
- IF(BTEST(IDUMMY(1),23)) THEN
- ILEFT = 0
- ELSEIF(BTEST(IDUMMY(1),22)) THEN
- ILEFT = 1
- ELSEIF(BTEST(IDUMMY(1),21)) THEN
- ILEFT = 2
- ELSEIF(BTEST(IDUMMY(1),20)) THEN
- ILEFT = 3
- END IF
- IEXPO = IEXPO * 4 - ILEFT - 48 - 256
- IF(IEXPO.GE.0) THEN
- IEXPO = IBSET(IEXPO,10)
- ELSE
- IEXPO = IBCLR(IEXPO-1,10)
- END IF
- CALL VZERO(IARRAY(JJ),2)
- IF(ISIGN.EQ.0) THEN
- CALL BTMOVE(IEXPO,22,IARRAY(JJ),6,11)
- CALL BTMOVE(IDUMMY(1),9+ILEFT,IARRAY(JJ),17,48)
- ELSE
- CALL BTMOVE(ONE ,1,IARRAY(JJ),5,60)
- CALL BTMOVE(NOT(IEXPO),22,IARRAY(JJ),6,11)
- CALL BTMOVE
- + (NOT(IDUMMY(1)),9+ILEFT,IARRAY(JJ),17,24-ILEFT)
- CALL BTMOVE
- + (NOT(IDUMMY(2)),1,IARRAY(JJ),41-ILEFT,24+ILEFT)
- END IF
- 2 CONTINUE
- 999 END
diff --git a/src/packlib/kernlib/kernbit/obsolete/m218/scddx.F b/src/packlib/kernlib/kernbit/obsolete/m218/scddx.F
deleted file mode 100644
index 1b540a6..0000000
--- a/src/packlib/kernlib/kernbit/obsolete/m218/scddx.F
+++ /dev/null
@@ -1,88 +0,0 @@
-*
-* $Id: scddx.F,v 1.1.1.1 1996/02/15 17:47:38 mclareni Exp $
-*
-* $Log: scddx.F,v $
-* Revision 1.1.1.1 1996/02/15 17:47:38 mclareni
-* Kernlib
-*
-*
-#include "kernbit/pilot.h"
- SUBROUTINE SCDDX(IARRAY,NWORDS)
-C
-C This is a subroutine to convert from CDC short floating
-C point format (60 Bits) to IBM double precision floating
-C point format (64 bits)
-C
-C IARRAY an area of storage 64*NWORDS bits long in which
-C are stored NWORDS 60 bits CDC floating point
-C numbers right adjusted in 64 bits doublewords.
-C On output it will contain NWORDS 64 bits IBM
-C double precision floating point numbers.
-C
-C NWORDS number of floating point numbers to convert
-C
- DIMENSION IARRAY(*),IDUMMY(2)
- LOGICAL BTEST,SET,CLEAR
- DATA MASK/Z00FFFFFF/,IBIG/Z7FFFFFFF/,ISMALL/Z00100000/
- DATA ICEX/Z000007FF/,NCEX/ZFFFFFC00/
- IF(NWORDS.LE.0) GO TO 999
- DO 2 J=NWORDS,1,-1
-C
-C Get sign and exponent
-C
- JJ = 2*J-1
- IEXPO = 0
- ISIGN = 0
- CALL BTMOVE(IARRAY(JJ),5,ISIGN,32,1)
- CALL BTMOVE(IARRAY(JJ),6,IEXPO,22,11)
-C
-C Check for exact 0
-C
- SET = BTEST(IARRAY(JJ),15).AND.BTEST(ISIGN,0)
- + .AND.BTEST(IEXPO,0)
- CLEAR = .NOT.(BTEST(IARRAY(JJ),15).OR. BTEST(ISIGN,0)
- + .OR. BTEST(IEXPO,0))
- IF(CLEAR.OR.SET) THEN
- IARRAY(2*J-1)=0
- IARRAY(2*J )=0
- GO TO 2
- END IF
- IF(ISIGN.NE.0) IEXPO = IAND(NOT(IEXPO),ICEX)
- IF(BTEST(IEXPO,10)) THEN
- IEXPO = IBCLR(IEXPO,10)
- ELSE
- IEXPO = IOR(NCEX,IEXPO+1)
- END IF
-C CDC EXP + CDC BIAS + CDC NORM + IBM BIAS
-C IEXPO = IEXPO + 48 + 260
- IEXPO = IEXPO + 308
- IF(IEXPO.GT.512) THEN
- IDUMMY(1)=IBIG
- IDUMMY(2)=NOT(0)
- GO TO 1
- ELSEIF(IEXPO.LT.1) THEN
- IDUMMY(1)=ISMALL
- IDUMMY(2)=0
- GO TO 1
- END IF
- IEX16 = (IEXPO)/4
- ILEFT = 4 - MOD(IEXPO,4)
- IF(ILEFT.EQ.4) THEN
- ILEFT = 0
- IEX16 = IEX16 - 1
- END IF
- IDUMMY(1) = ISHFT(IEX16,24)
- IDUMMY(2) = 0
- CALL BTMOVE(IARRAY(JJ),17,IDUMMY,9+ILEFT,48)
- IF(ISIGN.NE.0) THEN
- IMASK = 2**(24-ILEFT)-1
- IDUMMY(1) = IOR(IAND(NOT(IMASK),IDUMMY(1)),
- + IAND(IMASK,NOT(IDUMMY(1))))
- IMASK = NOT(2**(8-ILEFT)-1)
- IDUMMY(2) = IAND(IMASK,NOT(IDUMMY(2)))
- END IF
- 1 CALL SBIT(ISIGN,IDUMMY,32)
- IARRAY(2*J-1)=IDUMMY(1)
- IARRAY(2*J )=IDUMMY(2)
- 2 CONTINUE
- 999 END
diff --git a/src/packlib/kernlib/kernbit/obsolete/m218/scdsx.F b/src/packlib/kernlib/kernbit/obsolete/m218/scdsx.F
deleted file mode 100644
index efd4190..0000000
--- a/src/packlib/kernlib/kernbit/obsolete/m218/scdsx.F
+++ /dev/null
@@ -1,81 +0,0 @@
-*
-* $Id: scdsx.F,v 1.1.1.1 1996/02/15 17:47:37 mclareni Exp $
-*
-* $Log: scdsx.F,v $
-* Revision 1.1.1.1 1996/02/15 17:47:37 mclareni
-* Kernlib
-*
-*
-#include "kernbit/pilot.h"
- SUBROUTINE SCDSX(IARRAY,NWORDS)
-C
-C This is a subroutine to convert from CDC short floating
-C point format (60 bits) to IBM short floating point
-C format (32 bits).
-C
-C IARRAY an area of storage 64*NWORDS bits long in which
-C are stored NWORDS 60 bits CDC floating point
-C numbers right adjusted in 64 bits doublewords.
-C On output it will contain NWORDS 32 bits IBM
-C floating point numbers
-C
-C NWORDS number of floating point numbers to convert
-C
- DIMENSION IARRAY(*)
- LOGICAL BTEST,SET,CLEAR
- DATA MASK/Z00FFFFFF/,IBIG/Z7FFFFFFF/,ISMALL/Z00100000/
- DATA ICEX/Z000007FF/,NCEX/ZFFFFFC00/
- IF(NWORDS.LE.0) GO TO 999
- DO 2 J=1,NWORDS
-C
-C Get exponent and sign
-C
- JJ = 2*J-1
- IEXPO = 0
- ISIGN = 0
- CALL BTMOVE(IARRAY(JJ),5,ISIGN,32,1)
- CALL BTMOVE(IARRAY(JJ),6,IEXPO,22,11)
-C
-C Check for exact 0
-C
- SET = BTEST(IARRAY(JJ),15).AND.BTEST(ISIGN,0)
- + .AND.BTEST(IEXPO,0)
- CLEAR = .NOT.(BTEST(IARRAY(JJ),15).OR. BTEST(ISIGN,0)
- + .OR. BTEST(IEXPO,0))
- IF(CLEAR.OR.SET) THEN
- IARRAY(J) = 0
- GO TO 2
- END IF
- IF(ISIGN.NE.0) IEXPO = IAND(NOT(IEXPO),ICEX)
- IF(BTEST(IEXPO,10)) THEN
- IEXPO = IBCLR(IEXPO,10)
- ELSE
- IEXPO = IOR(NCEX,IEXPO+1)
- END IF
-C CDC EXP + CDC BIAS + CDC NORM + IBM BIAS
-C IEXPO = IEXPO + 48 + 260
- IEXPO = IEXPO + 308
- IF(IEXPO.GT.512) THEN
- IDUMMY=IBIG
- GO TO 1
- ELSEIF(IEXPO.LT.1) THEN
- IDUMMY=ISMALL
- GO TO 1
- END IF
- IEX16 = IEXPO/4
- ILEFT = 4 - MOD(IEXPO,4)
- IF(ILEFT.EQ.4) THEN
- ILEFT = 0
- IEX16 = IEX16 - 1
- END IF
- IDUMMY = ISHFT(IEX16,24)
- CALL BTMOVE(IARRAY(JJ),17,IDUMMY,9+ILEFT,24-ILEFT)
- IF(ISIGN.NE.0) THEN
- IMASK = 2**(24-ILEFT)-1
- IDUMMY = IOR(IAND(NOT(IMASK),IDUMMY),
- + IAND(IMASK,NOT(IDUMMY)))
- END IF
- 1 CALL SBIT(ISIGN,IDUMMY,32)
- IARRAY(J) = IDUMMY
- 2 CONTINUE
- 999 END
diff --git a/src/packlib/kernlib/kernbit/obsolete/m218/sxdcd.F b/src/packlib/kernlib/kernbit/obsolete/m218/sxdcd.F
deleted file mode 100644
index 0f4b6d3..0000000
--- a/src/packlib/kernlib/kernbit/obsolete/m218/sxdcd.F
+++ /dev/null
@@ -1,77 +0,0 @@
-*
-* $Id: sxdcd.F,v 1.1.1.1 1996/02/15 17:47:38 mclareni Exp $
-*
-* $Log: sxdcd.F,v $
-* Revision 1.1.1.1 1996/02/15 17:47:38 mclareni
-* Kernlib
-*
-*
-#include "kernbit/pilot.h"
- SUBROUTINE SXDCD(IARRAY,NWORDS)
-C
-C This is a subroutine to convert from IBM short floating
-C point format (32 Bits) to CDC long floating point format
-C (120 Bits)
-C
-C IARRAY an area of storage 128*NWORDS bits long in which
-C are stored one next to the other NWORDS 32 bits
-C IBM floating point numbers. On output it will
-C contain NWORDS 120 bits CDC floating point numbers
-C stored in pair of 64 bits areas, 60 bits per area,
-C right adjusted in with zero fill.
-C
-C NWORDS number of floating point numbers to convert
-C
- DIMENSION IARRAY(*)
- LOGICAL BTEST
- DOUBLE PRECISION ZERO(2),ONE(2)
- PARAMETER (IBYTE = 120)
- DATA ZERO / Z0000 0000 0000 0000,
- + Z0000 0000 0000 0000/,
- + ONE / ZFFFF FFFF FFFF FFFF,
- + ZFFFF FFFF FFFF FFFF/
- IF(NWORDS.LE.0) GO TO 999
- DO 2 J=NWORDS,1,-1
-C
-C Get exponent and sign
-C
- JJ = 4*J-3
- IDUMMY = IARRAY(J)
- ISIGN = ISHFT(IDUMMY,-31)
- IEXPO = ISHFT(IDUMMY,1)
- IEXPO = ISHFT(IEXPO,-25)
- IF(BTEST(IDUMMY,23)) THEN
- ILEFT = 0
- ELSEIF(BTEST(IDUMMY,22)) THEN
- ILEFT = 1
- ELSEIF(BTEST(IDUMMY,21)) THEN
- ILEFT = 2
- ELSEIF(BTEST(IDUMMY,20)) THEN
- ILEFT = 3
- END IF
- IEXPO = IEXPO * 4 - ILEFT - 48 - 256
- IEXP1 = IEXPO - 48
- IF(IEXPO.GE.0) THEN
- IEXPO = IBSET(IEXPO,10)
- ELSE
- IEXPO = IBCLR(IEXPO-1,10)
- END IF
- IF(IEXP1.GE.0) THEN
- IEXP1 = IBSET(IEXP1,10)
- ELSE
- IEXP1 = IBCLR(IEXP1-1,10)
- END IF
- CALL VZERO(IARRAY(JJ),4)
- IF(ISIGN.EQ.0) THEN
- CALL BTMOVE(IEXPO,22,IARRAY(JJ),6,11)
- CALL BTMOVE(IDUMMY,9+ILEFT,IARRAY(JJ),17,24-ILEFT)
- CALL BTMOVE(IEXP1,22,IARRAY(JJ),70,11)
- ELSE
- CALL BTMOVE(ONE ,1,IARRAY(JJ),5,60)
- CALL BTMOVE(ONE ,1,IARRAY(JJ),69,60)
- CALL BTMOVE(NOT(IEXPO),22,IARRAY(JJ),6,11)
- CALL BTMOVE(NOT(IDUMMY),9+ILEFT,IARRAY(JJ),17,24-ILEFT)
- CALL BTMOVE(NOT(IEXP1),22,IARRAY(JJ),70,11)
- END IF
- 2 CONTINUE
- 999 END
diff --git a/src/packlib/kernlib/kernbit/obsolete/m218/sxscd.F b/src/packlib/kernlib/kernbit/obsolete/m218/sxscd.F
deleted file mode 100644
index e4ed4f4..0000000
--- a/src/packlib/kernlib/kernbit/obsolete/m218/sxscd.F
+++ /dev/null
@@ -1,64 +0,0 @@
-*
-* $Id: sxscd.F,v 1.1.1.1 1996/02/15 17:47:38 mclareni Exp $
-*
-* $Log: sxscd.F,v $
-* Revision 1.1.1.1 1996/02/15 17:47:38 mclareni
-* Kernlib
-*
-*
-#include "kernbit/pilot.h"
- SUBROUTINE SXSCD(IARRAY,NWORDS)
-C
-C This is a subroutine to convert from IBM short floating
-C point format (32 Bits) to CDC short floating point format
-C (60 Bits)
-C
-C IARRAY an area of storage 64*NWORDS bits long in which
-C are stored one next to the other NWORDS 32 bits
-C IBM floating point numbers. On output it will
-C contain NWORDS 60 bits CDC floating point numbers
-C right adjusted in 64 bits areas.
-C
-C NWORDS number of floating point numbers to convert
-C
- DIMENSION IARRAY(*)
- LOGICAL BTEST
- DOUBLE PRECISION ZERO,ONE
- DATA ZERO / Z0000 0000 0000 0000 /
- DATA ONE / ZFFFF FFFF FFFF FFFF /
- IF(NWORDS.LE.0) GO TO 999
- DO 2 J=NWORDS,1,-1
-C
-C Get exponent and sign
-C
- JJ = 2*J-1
- IDUMMY = IARRAY(J)
- ISIGN = ISHFT(IDUMMY,-31)
- IEXPO = ISHFT(IDUMMY,1)
- IEXPO = ISHFT(IEXPO,-25)
- IF(BTEST(IDUMMY,23)) THEN
- ILEFT = 0
- ELSEIF(BTEST(IDUMMY,22)) THEN
- ILEFT = 1
- ELSEIF(BTEST(IDUMMY,21)) THEN
- ILEFT = 2
- ELSEIF(BTEST(IDUMMY,20)) THEN
- ILEFT = 3
- END IF
- IEXPO = IEXPO * 4 - ILEFT - 48 - 256
- IF(IEXPO.GE.0) THEN
- IEXPO = IBSET(IEXPO,10)
- ELSE
- IEXPO = IBCLR(IEXPO-1,10)
- END IF
- CALL VZERO(IARRAY(JJ),2)
- IF(ISIGN.EQ.0) THEN
- CALL BTMOVE(IEXPO,22,IARRAY(JJ),6,11)
- CALL BTMOVE(IDUMMY,9+ILEFT,IARRAY(JJ),17,24-ILEFT)
- ELSE
- CALL BTMOVE(ONE ,1,IARRAY(JJ),5,60)
- CALL BTMOVE(NOT(IEXPO),22,IARRAY(JJ),6,11)
- CALL BTMOVE(NOT(IDUMMY),9+ILEFT,IARRAY(JJ),17,24-ILEFT)
- END IF
- 2 CONTINUE
- 999 END
diff --git a/src/packlib/kernlib/kernbit/obsolete/m231ftn/Imakefile b/src/packlib/kernlib/kernbit/obsolete/m231ftn/Imakefile
deleted file mode 100644
index a23ecb3..0000000
--- a/src/packlib/kernlib/kernbit/obsolete/m231ftn/Imakefile
+++ /dev/null
@@ -1,4 +0,0 @@
-SRCS_F= \ @@\
- dibdx.F dxdib.F sibsx.F sxsib.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kernbit/obsolete/m231ftn/dibdx.F b/src/packlib/kernlib/kernbit/obsolete/m231ftn/dibdx.F
deleted file mode 100644
index de1b301..0000000
--- a/src/packlib/kernlib/kernbit/obsolete/m231ftn/dibdx.F
+++ /dev/null
@@ -1,13 +0,0 @@
-*
-* $Id: dibdx.F,v 1.1.1.1 1996/02/15 17:47:38 mclareni Exp $
-*
-* $Log: dibdx.F,v $
-* Revision 1.1.1.1 1996/02/15 17:47:38 mclareni
-* Kernlib
-*
-*
-#include "kernbit/pilot.h"
- SUBROUTINE DIBDX
- PRINT *,'M231 DIBDX: routine not available in Alpha-VMS'
- STOP
- END
diff --git a/src/packlib/kernlib/kernbit/obsolete/m231ftn/dxdib.F b/src/packlib/kernlib/kernbit/obsolete/m231ftn/dxdib.F
deleted file mode 100644
index 2f3d444..0000000
--- a/src/packlib/kernlib/kernbit/obsolete/m231ftn/dxdib.F
+++ /dev/null
@@ -1,13 +0,0 @@
-*
-* $Id: dxdib.F,v 1.1.1.1 1996/02/15 17:47:38 mclareni Exp $
-*
-* $Log: dxdib.F,v $
-* Revision 1.1.1.1 1996/02/15 17:47:38 mclareni
-* Kernlib
-*
-*
-#include "kernbit/pilot.h"
- SUBROUTINE DXDIB
- PRINT *,'M231 DXDIB: routine not available in Alpha-VMS'
- STOP
- END
diff --git a/src/packlib/kernlib/kernbit/obsolete/m231ftn/sibsx.F b/src/packlib/kernlib/kernbit/obsolete/m231ftn/sibsx.F
deleted file mode 100644
index ec43c2e..0000000
--- a/src/packlib/kernlib/kernbit/obsolete/m231ftn/sibsx.F
+++ /dev/null
@@ -1,13 +0,0 @@
-*
-* $Id: sibsx.F,v 1.1.1.1 1996/02/15 17:47:38 mclareni Exp $
-*
-* $Log: sibsx.F,v $
-* Revision 1.1.1.1 1996/02/15 17:47:38 mclareni
-* Kernlib
-*
-*
-#include "kernbit/pilot.h"
- SUBROUTINE SIBSX
- PRINT *,'M231 SIBSX: routine not available in Alpha-VMS'
- STOP
- END
diff --git a/src/packlib/kernlib/kernbit/obsolete/m231ftn/sxsib.F b/src/packlib/kernlib/kernbit/obsolete/m231ftn/sxsib.F
deleted file mode 100644
index f1c1de1..0000000
--- a/src/packlib/kernlib/kernbit/obsolete/m231ftn/sxsib.F
+++ /dev/null
@@ -1,13 +0,0 @@
-*
-* $Id: sxsib.F,v 1.1.1.1 1996/02/15 17:47:38 mclareni Exp $
-*
-* $Log: sxsib.F,v $
-* Revision 1.1.1.1 1996/02/15 17:47:38 mclareni
-* Kernlib
-*
-*
-#include "kernbit/pilot.h"
- SUBROUTINE SXSIB
- PRINT *,'M231 SXSIB: routine not available in Alpha-VMS'
- STOP
- END
diff --git a/src/packlib/kernlib/kernbit/obsolete/m232cdc/lndsx.s b/src/packlib/kernlib/kernbit/obsolete/m232cdc/lndsx.s
deleted file mode 100644
index 5d6f607..0000000
--- a/src/packlib/kernlib/kernbit/obsolete/m232cdc/lndsx.s
+++ /dev/null
@@ -1,66 +0,0 @@
-*
-* $Id: lndsx.s,v 1.1.1.1 1996/02/15 17:47:39 mclareni Exp $
-*
-* $Log: lndsx.s,v $
-* Revision 1.1.1.1 1996/02/15 17:47:39 mclareni
-* Kernlib
-*
-*
- IDENT LNDSX
- ENTRY LNDSX
-************************************************************************
-* *
-* SUBROUTINE LNDSX (WORDS,NWORDS) *
-* *
-* CONVERT THE FIRST NWORDS ELEMENTS OF WORDS FROM NORD LONG (48-BIT) *
-* FLOATING POINT TO CDC NORMALISED SHORT FLOATING POINT (60-BIT) AND *
-* STORE THE RESULTS BACK IN WORDS. THE NORD 48-BIT NUMBERS ARE ASSUMED *
-* RIGHT JUSTIFIED WITH ZERO FILL IN THE ELEMENTS OF WORDS. IF NWORDS *
-* IS LESS THAN ONE A DO NOTHING RETURN IS MADE. *
-* NORD WORD IS 32 BIT MANTISSA,15 BIT EXPONENT (BIAS OF 2**14),SIGN BIT*
-* CDC WORD IS 48 BIT MANTISSA,11 BIT EXPONENT (BIAS OF 2**10),SIGN BIT*
-* NORD NUMBER RANGE IS 10**-4920 TO 10**4920 *
-* CDC NUMBER RANGE IS 10**-293 TO 10**322 *
-* NORD NUMBERS GT 10**322 ARE SET TO 10**322 IN CDC FORM *
-* NORD NUMBERS LT 10**-293 ARE SET TO 10**-293 IN CDC FORM *
-* *
-* H.RENSHALL/DD/CERN 80/09/17 *
-* *
-************************************************************************
- TRACE VFD 30/5HLNDSX,30/3
- LNDSX DATA 0 .STORAGE FOR RETURN JUMP ADDRESS
- SB1 X1 .B1=ADDRESS OF WORDS(1)
- SA1 A1+1 .X1=ADDRESS OF N
- SA1 X1 .X1=NUMBER OF WORDS TO TRANSLATE
- SB2 X1+B1 .B2=ADDRESS OF WORDS(NWORDS+1)
- LE B2,B1,LNDSX .DO NOTHING RETURN IF N LE ZERO
- MX0 28 .FORM LEFT 28 BITS MASK
- MX1 45 .FORM LEFT 45 BITS MASK
- MX5 9 .FORM LEFT 9 BITS MASK-CDC EXP
- LX5 10 .SHIFT 9 BIT MASK TO BITS 2-10
- MX7 1 .FORM LEFT 1 BIT MASK
- LX7 48 .SHIFT TO BIT 48-CDC MANTISSA
- FLPT SA2 B1 .SET X2 = NEXT NORD NUMBER
- ZR X2,ENDLOOP .LEAVE UNCHANGED IF ZERO
- BX4 X2 .COPY NORD NUMBER TO X4
- BX2 -X0*X2 .MASK OFF MANTISSA
- LX4 12 .LEFT ADJUST NORD NUMBER
- AX4 44 .RIGHT ADJUST WITH SIGN EXTEND
- BX3 -X1*X4 .MASK INTO X3 THE 15 BIT EXPONENT
- AX4 15 .MAKE X4 A COPY OF THE SIGN BIT
- SX3 X3-16416 .SUBTR (2**14 BIAS + 32 TO CONV F
- SB5 X3 .COPY 18-BIT SIGNED EXPONENT TO B
- AX3 10 .RIGHT SHIFT-DROP 10 BITS,EXTEND
- ZR X3,NOOVFL .TEST ON MIXED BITS IE CDC EXP OF
- AX3 7 .MAKE X3 A COPY OF THE EXPONENT S
- BX3 X3-X5 .SET LARGEST OR SMALLEST CDC EXPO
- SB5 X3 .COPY THIS EXPONENT INTO B5
- BX2 X7 .SET BIT 48 AS THE CDC MANTISSA
- NOOVFL PX6 X2,B5 .PACK AS A FLOATING POINT NUMBER
- NX6 X6,B5 .NORMALISE THE NUMBER
- BX6 X4-X6 .COMPLEMENT IF NEGATIVE
- SA6 B1 .SAVE CONVERTED NUMBER
- ENDLOOP SB1 B1+1 .ADD 1 TO FIRST ADDRESS
- LT B1,B2,FLPT .INSTACK LOOP TILL ALL CONVERTED
- EQ LNDSX .RETURN
- END
diff --git a/src/packlib/kernlib/kernbit/obsolete/m232cdc/sndsx.s b/src/packlib/kernlib/kernbit/obsolete/m232cdc/sndsx.s
deleted file mode 100644
index 68817d4..0000000
--- a/src/packlib/kernlib/kernbit/obsolete/m232cdc/sndsx.s
+++ /dev/null
@@ -1,58 +0,0 @@
-*
-* $Id: sndsx.s,v 1.1.1.1 1996/02/15 17:47:39 mclareni Exp $
-*
-* $Log: sndsx.s,v $
-* Revision 1.1.1.1 1996/02/15 17:47:39 mclareni
-* Kernlib
-*
-*
- IDENT SNDSX
- ENTRY SNDSX
-************************************************************************
-* *
-* SUBROUTINE SNDSX (WORDS,NWORDS) *
-* *
-* CONVERT THE FIRST NWORDS ELEMENTS OF WORDS FROM NORD SHORT (32-BIT) *
-* FLOATING POINT TO CDC NORMALISED SHORT FLOATING POINT (60-BIT) AND *
-* STORE THE RESULTS BACK IN WORDS. THE NORD 32-BIT NUMBERS ARE ASSUMED *
-* RIGHT JUSTIFIED WITH ZERO FILL IN THE ELEMENTS OF WORDS. IF NWORDS *
-* IS LESS THAN ONE A DO NOTHING RETURN IS MADE. *
-* NORD WORD IS 22 BIT MANTISSA,9 BIT EXPONENT (BIAS OF 2**8),SIGN BIT *
-* NORD WORD HAS IMPLICIT BIT 23 IN MANTISSA FOR NON-ZERO NUMBERS *
-* CDC WORD IS 48 BIT MANTISSA,11 BIT EXPONENT (BIAS OF 2**10),SIGN BIT*
-* NORD NUMBER RANGE IS 10**-76 TO 10**76 *
-* CDC NUMBER RANGE IS 10**-293 TO 10**322 *
-* ALL NORD NUMBERS CONVERT EXACTLY *
-* *
-* H.RENSHALL/DD/CERN 80/09/17 *
-* *
-************************************************************************
- TRACE VFD 30/5HSNDSX,30/3
- SNDSX DATA 0 .STORAGE FOR RETURN JUMP ADDRESS
- SB1 X1 .B1=ADDRESS OF WORDS(1)
- SA1 A1+1 .X1=ADDRESS OF N
- SA1 X1 .X1=NUMBER OF WORDS TO TRANSLATE
- SB2 X1+B1 .B2=ADDRESS OF WORDS(NWORDS+1)
- LE B2,B1,SNDSX .ERROR RETURN IF N LE ZERO
- MX0 38 .FORM LEFT 38 BITS MASK
- MX1 51 .SET MASK
- MX7 1 .SET BIT 60
- LX7 23 .SHIFT TO BIT 23
- FLPT SA2 B1 .SET X2 = NEXT NORD NUMBER
- ZR X2,ENDLOOP .LEAVE UNCHANGED IF ZERO
- BX4 X2 .COPY NORD NUMBER INTO X4
- BX2 -X0*X2 .MASK MANTISSA
- BX2 X2+X7 .OR MISSING NORD BIT IN MANTISSA
- LX4 28 .LEFT ADJUST NORD NUMBER
- AX4 50 .RIGHT ADJ-DROP MANT-EXTEND SIGN
- BX3 -X1*X4 .MASK 9-BIT EXPONENT INTO X3
- AX4 9 .MAKE X4 A COPY OF THE SIGN BIT
- SB5 X3-279 .SUB (2**8 BIAS + 23 TO CONV FRAC
- PX6 X2,B5 .PACK AS A FLPT NUMBER
- NX6 X6,B5 .NORMALISE THE NUMBER
- BX6 X4-X6 .COMPLEMENT IF NEGATIVE
- SA6 B1 .SAVE CONVERTED NUMBER
- ENDLOOP SB1 B1+1 .ADD 1 TO FIRST ADDRESS
- LT B1,B2,FLPT .INSTACK LOOP TILL ALL CONVERTED
- EQ SNDSX .RETURN
- END
diff --git a/src/packlib/kernlib/kernbit/obsolete/m232cdc/sxlnd.s b/src/packlib/kernlib/kernbit/obsolete/m232cdc/sxlnd.s
deleted file mode 100644
index 46c9037..0000000
--- a/src/packlib/kernlib/kernbit/obsolete/m232cdc/sxlnd.s
+++ /dev/null
@@ -1,66 +0,0 @@
-*
-* $Id: sxlnd.s,v 1.1.1.1 1996/02/15 17:47:39 mclareni Exp $
-*
-* $Log: sxlnd.s,v $
-* Revision 1.1.1.1 1996/02/15 17:47:39 mclareni
-* Kernlib
-*
-*
- IDENT SXLND
- ENTRY SXLND
-************************************************************************
-* *
-* SUBROUTINE SXLND (WORDS,NWORDS) *
-* *
-* CONVERT THE FIRST NWORDS ELEMENTS OF WORDS FROM CDC SHORT (60-BIT) *
-* FLOATING POINT TO NORD NORMALISED LONG FLOATING POINT (48-BIT) AND *
-* STORE THE RESULTS BACK IN WORDS. THE NORD 48-BIT NUMBERS ARE PLACED *
-* RIGHT JUSTIFIED WITH ZERO FILL IN THE ELEMENTS OF WORDS. IF NWORDS *
-* IS LESS THAN ONE A DO NOTHING RETURN IS MADE. *
-* NORD WORD IS 32 BIT MANTISSA,15 BIT EXPONENT (BIAS OF 2**14),SIGN BIT*
-* CDC WORD IS 48 BIT MANTISSA,11 BIT EXPONENT (BIAS OF 2**10),SIGN BIT*
-* NORD NUMBER RANGE IS 10**-4920 TO 10**4920 *
-* CDC NUMBER RANGE IS 10**-293 TO 10**322 *
-* CDC + OR -VE OVERFLOWS ARE SET TO +/-10**4920 IN NORD FORMAT *
-* CDC + OR -VE UNDERFLOWS TRANSLATE TO +/-10**-293 IN NORD FORMAT
-* CDC INDEFINITE NUMBERS ARE TRANSLATED TO MAX/MIN NORD NUMBERS *
-* THE NORD OUTPUT NUMBERS ARE NORMALISED IF THE CDC INPUT NUMBERS WERE *
-* *
-* H.RENSHALL/DD/CERN 80/09/17 *
-* *
-************************************************************************
- TRACE VFD 30/5HSXLND,30/3
- SXLND DATA 0 .STORAGE FOR RETURN JUMP ADDRESS
- SB1 X1 .B1=ADDRESS OF WORDS(1)
- SA1 A1+1 .X1=ADDRESS OF N
- SA1 X1 .X1=NUMBER OF WORDS TO TRANSLATE
- SB2 X1+B1 .B2=ADDRESS OF WORDS(NWORDS+1)
- LE B2,B1,SXLND .DO NOTHING RETURN IF N LE ZERO
- MX0 1 .SET BIT 60
- LX0 48 .SHIFT TO BIT 48
- MX5 1 .SET LEFT 1-BIT
- LX5 1 .RIGHT ADJUST
- SB3 16432 .NORD BIAS (2**14) + 48 FOR DEC P
- FLPT SA2 B1 .SET X2 = NEXT CDC NUMBER
- BX4 X2 .COPY NUMBER TO X4
- AX4 59 .FILL X4 WITH SIGN BIT
- BX7 X4-X2 .COMPLEMENT TO X7 IF NEGATIVE
- ZR X7,RESTORE .ALLOWS FOR CDC +-0.
- OR X2,OUTRANGE .TEST IF CDC NUMBER IN RANGE (760
- UX7 B5,X7 .UNPACK +VE MANT TO X7,EXP TO B5
- AX7 16 .REDUCE MANTISSA TO 32 BITS
- SX6 B5+B3 .ADD NORD BIAS (2**14) +48 FOR DE
- LX6 32 .POSITION AS NORD EXPONENT
- BX6 X6+X7 .OR MANT AND EXP INTO X6
- BX4 X0*X4 .GET SIGN BIT IN BIT 48 OF X4
- BX7 X6+X4 .OR IN THE SIGN BIT INTO X7
- ZR RESTORE .JUMP OVER OUT OF RANGE
- OUTRANGE SA2 LIMIT .SET LARGEST NORD NUMBER
- BX4 X0*X4 .GET SIGN BIT IN BIT 48 OF X4
- BX7 X2+X4 OR SIGN INTO LARGEST NORD NUMBER
- RESTORE SA7 B1 .STORE CONVERTED NUMBER (-0. TO +
- SB1 B1+X5 .ADD 1 TO FIRST ADDRESS
- LT B1,B2,FLPT .INSTACK LOOP TILL ALL CONVERTED
- EQ SXLND .RETURN
- LIMIT DATA B00003777777777777776 .LARGEST NORD FP NUMBER
- END
diff --git a/src/packlib/kernlib/kernbit/obsolete/m232cdc/sxsnd.s b/src/packlib/kernlib/kernbit/obsolete/m232cdc/sxsnd.s
deleted file mode 100644
index 2998aa1..0000000
--- a/src/packlib/kernlib/kernbit/obsolete/m232cdc/sxsnd.s
+++ /dev/null
@@ -1,75 +0,0 @@
-*
-* $Id: sxsnd.s,v 1.1.1.1 1996/02/15 17:47:39 mclareni Exp $
-*
-* $Log: sxsnd.s,v $
-* Revision 1.1.1.1 1996/02/15 17:47:39 mclareni
-* Kernlib
-*
-*
- IDENT SXSND
- ENTRY SXSND
-************************************************************************
-* *
-* SUBROUTINE SXSND (WORDS,NWORDS) *
-* *
-* CONVERT THE FIRST NWORDS ELEMENTS OF WORDS FROM CDC SHORT (60-BIT) *
-* FLOATING POINT TO NORD NORMALISED SHORT FLOATING POINT (32-BIT) AND *
-* STORE THE RESULTS BACK IN WORDS. THE NORD 32-BIT NUMBERS ARE PLACED *
-* RIGHT JUSTIFIED WITH ZERO FILL IN THE ELEMENTS OF WORDS. IF NWORDS *
-* IS LESS THAN ONE A DO NOTHING RETURN IS MADE. *
-* NORD WORD IS 22 BIT MANTISSA,9 BIT EXPONENT (BIAS OF 2**8),SIGN BIT *
-* NORD WORD HAS IMPLICIT BIT 23 SET IN MANTISSA FOR NON-ZERO NUMBERS *
-* CDC WORD IS 48 BIT MANTISSA,11 BIT EXPONENT (BIAS OF 2**10),SIGN BIT*
-* NORD NUMBER RANGE IS 10**-76 TO 10**76 *
-* CDC NUMBER RANGE IS 10**-293 TO 10**322 *
-* CDC + OR -VE NUMBERS GT 10**76 ARE SET TO +/-10**76 IN NORD FORMAT *
-* CDC + OR -VE NUMBERS LT 10**-76 ARE SET TO +/-10**-76 IN NORD FORMAT *
-* CDC INDEFINITE NUMBERS ARE TRANSLATED TO MAX/MIN NORD NUMBERS *
-* THE NORD OUTPUT NUMBERS ARE NORMALISED IF THE CDC INPUT NUMBERS WERE *
-* *
-* H.RENSHALL/DD/CERN 80/09/17 *
-* *
-************************************************************************
- TRACE VFD 30/5HSXSND,30/3
- SXSND DATA 0 .STORAGE FOR RETURN JUMP ADDRESS
- SB1 X1 .B1=ADDRESS OF WORDS(1)
- SA1 A1+1 .X1=ADDRESS OF N
- SA1 X1 .X1=NUMBER OF WORDS TO TRANSLATE
- SB2 X1+B1 .B2=ADDRESS OF WORDS(NWORDS+1)
- LE B2,B1,SXSND .DO NOTHING RETURN IF N LE ZERO
- MX5 22 .FORM LEFT 22 BITS MASK
- LX5 22 .RIGHT ADJUST 22 BIT MASK
- MX0 1 .FORM LEFT 1-BIT MASK
- LX0 32 .SET NORD SIGN BIT
- MX1 9 .FORM LEFT 9-BIT MASK
- LX1 9 .RIGHT ADJUST 9 BIT MASK
- SB3 304 .NORD BIAS (2**8) + 48 FOR DEC PN
- SB7 1 .SET B7= 1
- FLPT SA2 B1 .SET X2 = NEXT CDC NUMBER
- BX4 X2 .COPY NUMBER TO X4
- AX4 59 .FILL X4 WITH SIGN BIT
- BX7 X4-X2 .COMPLEMENT TO X7 IF NEGATIVE
- ZR X7,RESTORE .ALLOWS FOR CDC +-0.
- IR X2,INRANGE .TEST IF CDC NUMBER IN RANGE (760
- SA2 LIMIT .LOAD LARGEST NORD FP NUMBER
- ZR ADDSIGN .ADD SIGN AND RETURN THIS VALUE
- INRANGE UX7 B5,X7 .UNPACK +VE MANT TO X7,EXP TO B5
- AX7 25 .REDUCE MANT.TO 23 BITS
- BX7 X7*X5 .REMOVE BIT 23
- SX6 B5+B3 .ADD NORD BIAS (2**8) +48 FOR DEC
- BX3 -X1*X6 .MASK OUT RIGHT 9 BITS.
- NZ X3,OUTRANGE .TEST FOR NON-ZERO IE NORD EXP OV
- LX6 22 .POSITION AS NORD EXPONENT
- BX2 X6+X7 .OR MANT AND EXP INTO X7
- ZR ADDSIGN .JUMP ROUND OUTRANGE
- OUTRANGE SA2 LIMIT .SET LARGEST NORD NUMBER
- PL X3,ADDSIGN .BRANCH TO ADD SIGN IF EXP +VEGN
- AX2 30 .SHIFT TO BE INTEGER 1
- ADDSIGN BX7 X4*X0 .SET NORD SIGN BIT
- BX7 X7+X2 .OR IN SIGN BIT
- RESTORE SA7 B1 .STORE CONVERTED NUMBER (-0. TO +
- SB1 B1+B7 .ADD 1 TO FIRST ADDRESS
- LT B1,B2,FLPT .INSTACK LOOP TILL ALL CONVERTED
- EQ SXSND .RETURN
- LIMIT DATA B00000000017777777776 .LARGEST NORD FP NUMBER
- END
diff --git a/src/packlib/kernlib/kernbit/obsolete/m232ibm/lndlx.s b/src/packlib/kernlib/kernbit/obsolete/m232ibm/lndlx.s
deleted file mode 100644
index e24d492..0000000
--- a/src/packlib/kernlib/kernbit/obsolete/m232ibm/lndlx.s
+++ /dev/null
@@ -1,241 +0,0 @@
-*
-* $Id: lndlx.s,v 1.1.1.1 1996/02/15 17:47:40 mclareni Exp $
-*
-* $Log: lndlx.s,v $
-* Revision 1.1.1.1 1996/02/15 17:47:40 mclareni
-* Kernlib
-*
-*
- TITLE 'LNDLX/LXLND'
-***********************************************************************
-* *
-* L N D L X *
-* ========= *
-* *
-***********************************************************************
-* *
-* FUNCTION: CONVERT NORD-100 48-BIT NORMALISED FLOATING POINT *
-* NUMBERS TO IBM 64-BIT FLOATING POINT REPRESENTATION. *
-* NUMBERS WHOSE MAGNITUDE EXCEEDS THE IBM MAXIMUM WILL *
-* HAVE A MAGNITUDE OF X'7FFFFFFFFFFFFFFF' AFTER *
-* CONVERSION. NUMBERS WHOSE MAGNITUDE IS LESS THAN THE *
-* IBM MINIMUM WILL HAVE A MAGNITUDE OF *
-* X'0010000000000000' AFTER CONVERSION. *
-* *
-* CALLING SEQUENCE: CALL LNDLX(DWORDS,NWORDS) *
-* *
-* ARGUMENTS: DWORDS - AN ARRAY OF DOUBLEWORDS CONTAINING THE *
-* NORD-100 48-BIT FLOATING POINT NUMBERS *
-* WHICH ARE TO BE CONVERTED. THE CONVERTED *
-* NUMBERS WILL REPLACE THE ORIGINAL ONES IN *
-* THIS ARRAY. EACH 48-BIT NORD NUMBER MUST *
-* BE RIGHT JUSTIFIED IN A DOUBLEWORD. *
-* *
-* NWORDS - AN INTEGER CONSTANT OR 4-BYTE INTEGER *
-* VARIABLE CONTAINING THE NUMBER OF DOUBLE *
-* WORDS TO BE CONVERTED. A VALUE LESS THAN *
-* ONE WILL CAUSE CONTROL TO BE RETURNED TO *
-* THE CALLER WITH NO PROCESSING. *
-* *
-***********************************************************************
- EJECT
-***********************************************************************
-* *
-* L X L N D *
-* ========= *
-* *
-***********************************************************************
-* *
-* FUNCTION: CONVERT IBM 64-BIT NORMALISED FLOATING POINT NUMBERS *
-* TO NORD-100 48-BIT FLOATING POINT REPRESENTATION. *
-* *
-* CALLING SEQUENCE: CALL LXLND(DWORDS,NWORDS) *
-* *
-* ARGUMENTS: DWORDS - AN ARRAY OF DOUBLEWORDS CONTAINING THE *
-* IBM 64-BIT BIT FLOATING POINT NUMBERS *
-* WHICH ARE TO BE CONVERTED. THE CONVERTED *
-* NUMBERS WILL REPLACE THE ORIGINAL ONES IN *
-* THIS ARRAY, EACH WILL BE RIGHT JUSTIFIED IN *
-* A DOUBLEWORD WITH ZERO FILL. *
-* *
-* NWORDS - AN INTEGER CONSTANT OR 4-BYTE INTEGER *
-* VARIABLE CONTAINING THE NUMBER OF DOUBLE *
-* WORDS TO BE CONVERTED. A VALUE LESS THAN *
-* ONE WILL CAUSE CONTROL TO BE RETURNED TO *
-* THE CALLER WITH NO PROCESSING. *
-* *
-***********************************************************************
- EJECT
-***********************************************************************
-* *
-* M O D I F I C A T I O N L O G *
-* =============================== *
-* *
-***********************************************************************
-* *
-* 1 . 0 0 *
-* ======= *
-* *
-* ORIGINAL VERSION. *
-* *
-* R. MATTHEWS, CERN/DD, SEPTEMBER 1980. *
-* *
-***********************************************************************
- EJECT
- EJECT
- PRINT NOGEN
-LNDLX CSECT
-#if defined(CERNLIB_QMIBMXA)
-LNDLX AMODE ANY
-LNDLX RMODE ANY
-#endif
- SPACE 2
-* P R O L O G U E
- SPACE
- USING LNDLX,R15
- B SAVEREGS
- DC AL1(7),CL7'LNDLX' IDENTIFIER
- DC C'1.00' VERSION.MODIFICATION LEVEL
-SAVEREGS STM R14,R12,12(R13)
- LR R4,R13
- CNOP 0,4
- BAL R13,AROUNDSA
-SAVEAREA DC A(EPILOGUE),17F'0'
- DROP R15
- USING SAVEAREA,R13
-AROUNDSA ST R13,8(0,R4)
- ST R4,4(0,R13)
- XC 8(4,R13),8(R13)
- SPACE 2
- BAL R12,SETUP
- SPACE
- LM R7,R8,MASKS1 R7 := X'0007FFFF', R8 := X'00080000'
- SPACE
-LOOP1 EQU *
- LM R2,R3,0(R9) R2,3 := NUMBER TO BE CONVERTED
- SLDL R2,16 LEFT JUSTIFY IT
- LTR R5,R2 R5 := BITS 0-31 OF THE NUMBER
- BZ LOOP1END BRANCH IF ZERO, (NO CONVERSION NECESSARY)
- ST R2,0(0,R9) STORE THE SIGN LEFT JUSTIFIED
- SLDL R4,1 SAVE THE SIGN BIT IN R4
- CL R5,=X'81F9FFFF' IS THE NUMBER TOO LARGE ?
- BNH NOTHIGH NO, BRANCH
- OC 0(8,R9),=X'7FFFFFFFFFFFFFFF' STORE MAX, PRESERVE SIGN
- B LOOP1END
-NOTHIGH CL R5,=X'7DFB0000' IS THE NUMBER TOO SMALL ?
- BNL CONVERT1 NO, BRANCH
- NC 0(8,R9),=X'8000000000000000' YES, PRESERVE THE SIGN
- MVI 1(R9),X'10' STORE THE MINIMUM
- B LOOP1END
-CONVERT1 SLDL R2,8 R2,3 := 56-BIT MANTISSA IN BITS 8-63
- LA R2,0(0,R2) ZERO BITS 0-7
- LR R6,R5 R6 := 15-BIT CHARACTERISTIC IN BITS 0-14
- NR R6,R7 ZERO BITS 0-12
- SLR R5,R6 R5 := 13-BIT POWER 16 CHARACTERISTIC
- SRA R6,17 R6 := RESIDUAL POWER 2 EXPONENT
- BZ COMBINE1 BRANCH IF IT IS ZERO
- SLDL R2,0(R6) PRENORMALISE
- SRDL R2,4 POSTNORMALISE
- ALR R5,R8 INCREMENT THE CHARACTERISTIC
-COMBINE1 SLDL R4,1 SAVE THE BIAS IN R4
- SLL R5,6 R5 := 6-BIT POWER 16 EXPONENT IN BITS 0-5
- SRDL R4,2 REPLACE SIGN; R5 := IBM CHARACTERISTIC
- OR R2,R5 COMBINE THE CHARACTERISTIC AND MANTISSA
- STM R2,R3,0(R9) STORE THE RESULT
-LOOP1END BXLE R9,R10,LOOP1 GO AND PROCESS THE NEXT NUMBER
- SPACE
- B EPILOGUE
- EJECT
-* E N T R Y P O I N T L X L N D
- SPACE
- ENTRY LXLND
- USING LXLND,R15
- CNOP 0,4
-LXLND B EP0102
- DC AL1(7),CL7'LXLND' IDENTIFIER
-EP0101 DC A(SAVEAREA)
-EP0102 STM R14,R12,12(R13)
- LR R4,R13
- L R13,EP0101
- ST R13,8(0,R4)
- ST R4,4(0,R13)
- XC 8(4,R13),8(R13)
- DROP R15
- SPACE 2
- BAL R12,SETUP
- SPACE
- LM R6,R8,MASKS2 R6:=7E000000, R7:=80000000, R8:=00010000
- SPACE
-LOOP2 LM R4,R5,0(R9) R4,5 := NUMBER TO BE CONVERTED
- LTR R3,R4 R3 := BITS 0-31 OF THE NUMBER
- BZ LOOP2END BRANCH IF ZERO, (NO CONVERSION NECESSARY)
- LA R4,0(0,R4) R4,5 := 56-BIT MANTISSA IN BITS 8-63
- SLR R3,R4 R3 := IBM CHARACTERISTIC
- SLDL R2,1 SAVE THE SIGN IN R2
- SRA R3,6 EXPAND CHARACTERISTIC WITH 6 BIAS BITS
- XR R3,R6 COMPLEMENT THE 6 NEW BITS
- SRDL R2,1 REPLACE SIGN; R3 := NORD CHARACTERISTIC
- SLDL R4,8 R4 := 56-BIT MANTISSA IN BITS 0-55
-NORMAL2 CLR R4,R7 IS IT NORMALISED ?
- BNL COMBINE2 YES, BRANCH
- SLDL R4,1 NO, SHIFT IT LEFT BY ONE BIT
- SLR R3,R8 DECREMENT THE CHARACTERISTIC
- B NORMAL2 GO AND TEST FOR NORMALISATION
-COMBINE2 SRL R3,16 R3 := 16-BIT CHARACTERISTIC IN BITS 16-31
- STM R3,R4,0(R9) STORE THE RESULT
-LOOP2END BXLE R9,R10,LOOP2 GO AND PROCESS THE NEXT NUMBER
- SPACE
- B EPILOGUE
- EJECT
-* P R E - C O N V E R S I O N I N I T I A L I S A T I O N
- SPACE
-SETUP LM R9,R10,0(R1) R9 -> WORDS; R10 -> NWORDS
- L R10,0(0,R10) R10 := NWORDS
- LTR R10,R10 ARE THERE ANY NUMBERS TO BE CONVERTED ?
- BNP EPILOGUE NO, BRANCH
- SPACE
- BCTR R10,0 R10 := NWORDS-1
- SLA R10,3 R10 := 8*(NWORDS-1), EXCESS -> OVERFLOW
- LA R11,0(R9,R10) R11 -> LAST NUMBER TO BE CONVERTED
- LA R10,8 R10 := 8 FOR LOOP INCREMENT
- SPACE
- BR R12
- EJECT
-* E P I L O G U E
- SPACE
-EPILOGUE EQU *
- L R13,4(0,R13)
- LM R14,R12,12(R13)
-** OI 12(R13),X'FF'
- BR R14
- EJECT
-* D A T A A R E A S
- SPACE
- DS 0D
-MASKS1 DC X'0007FFFF',X'00080000'
-MASKS2 DC X'7E000000',X'80000000',X'00010000'
- SPACE 2
- LTORG
-R0 EQU 0
-R1 EQU 1
-R2 EQU 2
-R3 EQU 3
-R4 EQU 4
-R5 EQU 5
-R6 EQU 6
-R7 EQU 7
-R8 EQU 8
-R9 EQU 9
-R10 EQU 10
-R11 EQU 11
-R12 EQU 12
-R13 EQU 13
-R14 EQU 14
-R15 EQU 15
- SPACE 2
-F0 EQU 0
-F2 EQU 2
-F4 EQU 4
-F6 EQU 6
- SPACE 2
- END
diff --git a/src/packlib/kernlib/kernbit/obsolete/m232ibm/sndsx.s b/src/packlib/kernlib/kernbit/obsolete/m232ibm/sndsx.s
deleted file mode 100644
index 184e8be..0000000
--- a/src/packlib/kernlib/kernbit/obsolete/m232ibm/sndsx.s
+++ /dev/null
@@ -1,237 +0,0 @@
-*
-* $Id: sndsx.s,v 1.1.1.1 1996/02/15 17:47:39 mclareni Exp $
-*
-* $Log: sndsx.s,v $
-* Revision 1.1.1.1 1996/02/15 17:47:39 mclareni
-* Kernlib
-*
-*
- TITLE 'SNDSX / SXSND'
-***********************************************************************
-* *
-* S N D S X *
-* ========= *
-* *
-***********************************************************************
-* *
-* FUNCTION: CONVERT NORD-100 32-BIT NORMALISED FLOATING POINT *
-* NUMBERS TO IBM 32-BIT FLOATING POINT REPRESENTATION. *
-* NUMBERS WHOSE MAGNITUDE EXCEEDS THE IBM MAXIMUM *
-* WILL HAVE A MAGNITUDE OF X'7FFFFFFF' AFTER CONVERSION.*
-* *
-* CALLING SEQUENCE: CALL SNDSX(WORDS,NWORDS) *
-* *
-* ARGUMENTS: WORDS - AN ARRAY OF FULLWORDS CONTAINING THE *
-* NORD-100 32-BIT FLOATING POINT NUMBERS *
-* WHICH ARE TO BE CONVERTED. THE CONVERTED *
-* NUMBERS WILL REPLACE THE ORIGINAL ONES IN *
-* THIS ARRAY. *
-* *
-* NWORDS - AN INTEGER CONSTANT OR 4-BYTE INTEGER *
-* VARIABLE CONTAINING THE NUMBER OF WORDS TO *
-* BE CONVERTED. A VALUE LESS THAN ONE WILL *
-* CAUSE CONTROL TO BE RETURNED TO THE CALLER *
-* WITH NO PROCESSING. *
-* *
-***********************************************************************
- EJECT
-***********************************************************************
-* *
-* S X S N D *
-* ========= *
-* *
-***********************************************************************
-* *
-* FUNCTION: CONVERT IBM 32-BIT NORMALISED FLOATING POINT NUMBERS *
-* TO NORD-100 32-BIT FLOATING POINT REPRESENTATION. *
-* NUMBERS WHOSE MAGNITUDE IS LESS THAN THE NORD MINIMUM *
-* WILL HAVE A MAGNITUDE OF X'00000001' AFTER CONVERSION.*
-* *
-* CALLING SEQUENCE: CALL SXSND(WORDS,NWORDS) *
-* *
-* ARGUMENTS: WORDS - AN ARRAY OF FULLWORDS CONTAINING THE *
-* IBM 32-BIT FLOATING POINT NUMBERS WHICH ARE *
-* TO BE CONVERTED. THE CONVERTED NUMBERS *
-* WILL REPLACE THE ORIGINAL ONES IN THIS *
-* ARRAY. *
-* *
-* NWORDS - AN INTEGER CONSTANT OR 4-BYTE INTEGER *
-* VARIABLE CONTAINING THE NUMBER OF WORDS TO *
-* BE CONVERTED. A VALUE LESS THAN ONE WILL *
-* CAUSE CONTROL TO BE RETURNED TO THE CALLER *
-* WITH NO PROCESSING. *
-* *
-***********************************************************************
- EJECT
-***********************************************************************
-* *
-* M O D I F I C A T I O N L O G *
-* =============================== *
-* *
-***********************************************************************
-* *
-* 1 . 0 0 *
-* ======= *
-* *
-* ORIGINAL VERSION. *
-* *
-* R. MATTHEWS, CERN/DD, SEPTEMBER 1980. *
-* *
-***********************************************************************
- EJECT
- EJECT
- PRINT NOGEN
-SNDSX CSECT
-#if defined(CERNLIB_QMIBMXA)
-SNDSX AMODE ANY
-SNDSX RMODE ANY
-#endif
- SPACE 2
-* P R O L O G U E
- SPACE
- USING SNDSX,R15
- B SAVEREGS
- DC AL1(7),CL7'SNDSX' IDENTIFIER
- DC C'1.00' VERSION.MODIFICATION LEVEL
-SAVEREGS STM R14,R12,12(R13)
- LR R4,R13
- CNOP 0,4
- BAL R13,AROUNDSA
-SAVEAREA DC A(EPILOGUE),17F'0'
- DROP R15
- USING SAVEAREA,R13
-AROUNDSA ST R13,8(0,R4)
- ST R4,4(0,R13)
- XC 8(4,R13),8(R13)
- SPACE 2
- BAL R12,SETUP
- SPACE
- LM R5,R6,MASKS R5 := X'00400000', R6 := '01000000'
- LE F6,MAXIMUM F6 := MAXIMUM CONVERTIBLE NUMBER
- SPACE
-LOOP1 EQU *
- LE F0,0(0,R9) F0 := NUMBER TO BE CONVERTED
- LPER F0,F0 F0 := ABSOLUTE VALUE OF THE NUMBER
- CER F0,F6 IS IT MORE THAN THE MAXIMUM CONVERTIBLE ?
- BNH CONVERT1 NO, GO AND CONVERT IT
- OC 0(4,R9),=X'7FFFFFFFF' YES, STORE MAXIMUM, PRESERVE SIGN
- B LOOP1END
-CONVERT1 L R2,0(0,R9) R2 := NUMBER TO BE CONVERTED
- LTR R3,R2 R3 := NUMBER TO BE CONVERTED
- BZ LOOP1END BRANCH IF ZERO, (NO CONVERSION NECESSARY)
- LA R4,0(0,R2) R4 := BITS 8-31 OF NUMBER TO BE CONVERTED
- SLR R2,R4 R2 := IBM CHARACTERISTIC IN BITS 0-7
- OR R3,R5 R3 := 23-BIT MANTISSA IN BITS 9-31
- SLL R3,1 R3 := 24-BIT MANTISSA IN BITS 8-31
- LA R3,0(0,R3) ZERO BITS 0-7
- SRA R4,22 R4 := RESIDUAL POWER 2 EXPONENT
- BZ COMBINE1 BRANCH IF IT IS ZERO
- SLL R3,0(R4) PRENORMALISE
- SRL R3,4 POSTNORMALISE
- ALR R2,R6 INCREMENT THE CHARACTERISTIC
-COMBINE1 OR R2,R3 COMBINE THE CHARACTERISTIC AND MANTISSA
- ST R2,0(0,R9) STORE THE RESULT
-LOOP1END BXLE R9,R10,LOOP1 GO AND PROCESS THE NEXT NUMBER
- SPACE
- B EPILOGUE
- EJECT
-* E N T R Y P O I N T S X S N D
- SPACE
- ENTRY SXSND
- USING SXSND,R15
- CNOP 0,4
-SXSND B EP0102
- DC AL1(7),CL7'SXSND' IDENTIFIER
-EP0101 DC A(SAVEAREA)
-EP0102 STM R14,R12,12(R13)
- LR R4,R13
- L R13,EP0101
- ST R13,8(0,R4)
- ST R4,4(0,R13)
- XC 8(4,R13),8(R13)
- DROP R15
- SPACE 2
- BAL R12,SETUP
- SPACE
- L R5,MASKS R5 := X'00400000'
- LE F6,MINIMUM F6 := MINIMUM CONVERTIBLE NUMBER
- SPACE
-LOOP2 EQU *
- LE F0,0(0,R9) F0 := NUMBER TO BE CONVERTED
- LPER F0,F0 F0 := ABSOLUTE VALUE OF THE NUMBER
- BZ LOOP2END BRANCH IF THE FRACTION IS ZERO
- CER F0,F6 IS IT LESS THAN THE MINIMUM CONVERTIBLE ?
- BNL CONVERT2 NO, GO AND CONVERT IT
- NC 0(4,R9),=X'80000000' YES, PRESERVE THE SIGN
- MVI 3(R9),X'01' STORE THE MINIMUM
- B LOOP2END
-CONVERT2 L R4,0(0,R9) R4 := NUMBER TO BE CONVERTED
- LA R3,0(0,R4) R3 := 24-BIT MANTISSA IN BITS 8-31
- SLR R4,R3 R4 := CHARACTERISTIC IN BITS 0-7
- SR R2,R2 R2 := 0
- SLDL R2,9 R2 := MOST SIGNIFICANT BIT OF MANTISSA
-NORMAL2 LTR R2,R2 IS IT 1 ?
- BNZ COMBINE2 YES, BRANCH
- SLDL R2,1 R2 := MOST SIGNIFICANT BIT OF MANTISSA
- SLR R4,R5 DECREMENT THE CHARACTERISTIC
- B NORMAL2 GO AND TEST THE MOST SIGNIFICANT BIT
-COMBINE2 SRL R3,10 R3 := 22-BIT MANTISSA IN BITS 10-31
- OR R4,R3 COMBINE THE CHARACTERISTIC AND MANTISSA
- ST R4,0(0,R9) STORE THE RESULT
-LOOP2END BXLE R9,R10,LOOP2 GO AND PROCESS THE NEXT NUMBER
- SPACE
- B EPILOGUE
- EJECT
-* P R E - C O N V E R S I O N I N I T I A L I S A T I O N
- SPACE
-SETUP LM R9,R10,0(R1) R9 -> WORDS; R10 -> NWORDS
- L R10,0(0,R10) R10 := NWORDS
- LTR R10,R10 ARE THERE ANY NUMBERS TO BE CONVERTED ?
- BNP EPILOGUE NO, BRANCH
- SPACE
- BCTR R10,0 R10 := NWORDS-1
- SLA R10,2 R10 := 4*(NWORDS-1), EXCESS -> OVERFLOW
- LA R11,0(R9,R10) R11 -> LAST NUMBER TO BE CONVERTED
- LA R10,4 R10 := 4 FOR LOOP INCREMENT
- SPACE
- BR R12
- EJECT
-* E P I L O G U E
- SPACE
-EPILOGUE EQU *
- L R13,4(0,R13)
- LM R14,R12,12(R13)
-** OI 12(R13),X'FF'
- BR R14
- EJECT
-* D A T A A R E A S
- SPACE
- DS 0F
-MAXIMUM DC X'7F3FFFFF' LARGEST CONVERTIBLE NORD 32-BIT NUMBER
-MINIMUM DC X'00800002' SMALLEST CONVERTIBLE IBM 32-BIT NUMBER
-MASKS DC X'00400000',X'01000000'
- SPACE 2
- LTORG
-R0 EQU 0
-R1 EQU 1
-R2 EQU 2
-R3 EQU 3
-R4 EQU 4
-R5 EQU 5
-R6 EQU 6
-R7 EQU 7
-R8 EQU 8
-R9 EQU 9
-R10 EQU 10
-R11 EQU 11
-R12 EQU 12
-R13 EQU 13
-R14 EQU 14
-R15 EQU 15
- SPACE 2
-F0 EQU 0
-F2 EQU 2
-F4 EQU 4
-F6 EQU 6
- SPACE 2
- END
diff --git a/src/packlib/kernlib/kernbit/obsolete/m233ibm/a0e0.inc b/src/packlib/kernlib/kernbit/obsolete/m233ibm/a0e0.inc
deleted file mode 100644
index 5699fd2..0000000
--- a/src/packlib/kernlib/kernbit/obsolete/m233ibm/a0e0.inc
+++ /dev/null
@@ -1,188 +0,0 @@
-*
-* $Id: a0e0.inc,v 1.1.1.1 1996/02/15 17:47:40 mclareni Exp $
-*
-* $Log: a0e0.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:47:40 mclareni
-* Kernlib
-*
-*
-*
-* a0e0.inc
-*
- MACRO
-&L A0E0
- SPACE
-&L DS 0C BYTE ALIGNMENT ONLY
- SPACE
-* THIS TRANSLATE TABLE CONVERTS CERN ASCII TO CERN EBCDIC
-*
-* IT IS BASED ON THE RUTHERFORD TABLE WITH THE FOLLOWING
-* MODIFICATIONS:-
-* ASCII 5E IS CONVERTED TO EBCDIC 6A (CIRCUMFLEX)
-* ILLEGAL CHARACTERS ARE CONVERTED TO 7B (HASH) RATHER THAN
-* 6C (PERCENT)
-*
-* Changed for new CERN character set/conversions
-* See below for details of change.
-* Tony Cass User Support CERN/DD 5th December 1989
-*
-*STANDARD CERN ASCII TO EBCDIC CONVERSION TABLE OBTAINED FROM
-*ROB WATTS ON APRIL 28TH 1981
-*
-* CODE 00,&OPT,00,N8 . NULL
-* CODE 01,&OPT,01,N8 . SOH
-* CODE 02,&OPT,02,N8 . STX
-* CODE 03,&OPT,03,N8 . ETX
-* CODE 04,&OPT,37,N8 . EOT
-* CODE 05,&OPT,2D,N8 . ENQ
-* CODE 06,&OPT,2E,N8 . ACK
-* CODE 07,&OPT,2F,N8 . BEL
-* CODE 08,&OPT,16,N8 . BACKSPACE
-* CODE 09,&OPT,05,N8 . HT
-* CODE 0A,&OPT,25,N8 . LF
-* CODE 0B,&OPT,0B,N8 . VT
-* CODE 0C,&OPT,0C,N8 . FF
-* CODE 0D,&OPT,0D,N8 . CR
-* CODE 0E,&OPT,0E,N8 . SO
-* CODE 0F,&OPT,0F,N8 . SI
-* CODE 10,&OPT,10,N8 . DLE
-* CODE 11,&OPT,11,N8 . DC1
-* CODE 12,&OPT,12,N8 . DC2
-* CODE 13,&OPT,13,N8 . DC3
-* CODE 14,&OPT,3C,N8 . DC4
-* CODE 15,&OPT,3D,N8 . NAK
-* CODE 16,&OPT,32,N8 . SYN
-* CODE 17,&OPT,26,N8 . ETB
-* CODE 18,&OPT,18,N8 . CAN
-* CODE 19,&OPT,19,N8 . EM
-* CODE 1A,&OPT,3F,N8 . SUB
-* CODE 1B,&OPT,27,N8 . ESC
-* CODE 1C,&OPT,1C,N8 . FS
-* CODE 1D,&OPT,1D,N8 . GS
-* CODE 1E,&OPT,1E,N8 . RS
-* CODE 1F,&OPT,1F,N8 . US
-* CODE 20,&OPT,40,N8 . SPACE
-* CODE 21,&OPT,5A,N8 . EXCLAMATION MARK
-* CODE 22,&OPT,7F,N8 . DOUBLE QUOTE
-* CODE 23,&OPT,7B,N8 . HASH SIGN
-* CODE 24,&OPT,5B,N8 . DOLLAR SIGN
-* CODE 25,&OPT,6C,N8 . PERCENT
-* CODE 26,&OPT,50,N8 . AMPERSAND
-* CODE 27,&OPT,7D,N8 . SINGLE QUOTE
-* CODE 28,&OPT,4D,N8 . LEFT BRACKET
-* CODE 29,&OPT,5D,N8 . RIGHT BRACKET
-* CODE 2A,&OPT,5C,N8 . ASTERISK
-* CODE 2B,&OPT,4E,N8 . PLUS
-* CODE 2C,&OPT,6B,N8 . COMMA
-* CODE 2D,&OPT,60,N8 . MINUS
-* CODE 2E,&OPT,4B,N8 . PERIOD (FULL STOP)
-* CODE 2F,&OPT,61,N8 . SLASH
-* CODE 30,&OPT,F0,N8 . ZERO
-* CODE 31,&OPT,F1,N8 . ONE
-* CODE 32,&OPT,F2,N8 . TWO
-* CODE 33,&OPT,F3,N8 . THREE
-* CODE 34,&OPT,F4,N8 . FOUR
-* CODE 35,&OPT,F5,N8 . FIVE
-* CODE 36,&OPT,F6,N8 . SIX
-* CODE 37,&OPT,F7,N8 . SEVEN
-* CODE 38,&OPT,F8,N8 . EIGHT
-* CODE 39,&OPT,F9,N8 . NINE
-* CODE 3A,&OPT,7A,N8 . COLON
-* CODE 3B,&OPT,5E,N8 . SEMI-COLON
-* CODE 3C,&OPT,4C,N8 . LESS THAN
-* CODE 3D,&OPT,7E,N8 . EQUALS
-* CODE 3E,&OPT,6E,N8 . GREATER THAN
-* CODE 3F,&OPT,6F,N8 . QUESTION MARK
-* CODE 40,&OPT,7C,N8 . AT SIGN
-* CODE 41,&OPT,C1,N8 . UPPER A
-* CODE 42,&OPT,C2,N8 . UPPER B
-* CODE 43,&OPT,C3,N8 . UPPER C
-* CODE 44,&OPT,C4,N8 . UPPER D
-* CODE 45,&OPT,C5,N8 . UPPER E
-* CODE 46,&OPT,C6,N8 . UPPER F
-* CODE 47,&OPT,C7,N8 . UPPER G
-* CODE 48,&OPT,C8,N8 . UPPER H
-* CODE 49,&OPT,C9,N8 . UPPER I
-* CODE 4A,&OPT,D1,N8 . UPPER J
-* CODE 4B,&OPT,D2,N8 . UPPER K
-* CODE 4C,&OPT,D3,N8 . UPPER L
-* CODE 4D,&OPT,D4,N8 . UPPER M
-* CODE 4E,&OPT,D5,N8 . UPPER N
-* CODE 4F,&OPT,D6,N8 . UPPER O
-* CODE 50,&OPT,D7,N8 . UPPER P
-* CODE 51,&OPT,D8,N8 . UPPER Q
-* CODE 52,&OPT,D9,N8 . UPPER R
-* CODE 53,&OPT,E2,N8 . UPPER S
-* CODE 54,&OPT,E3,N8 . UPPER T
-* CODE 55,&OPT,E4,N8 . UPPER U
-* CODE 56,&OPT,E5,N8 . UPPER V
-* CODE 57,&OPT,E6,N8 . UPPER W
-* CODE 58,&OPT,E7,N8 . UPPER X
-* CODE 59,&OPT,E8,N8 . UPPER Y
-* CODE 5A,&OPT,E9,N8 . UPPER Z
-* CODE 5B,&OPT,AD,N8 . LEFT SQUARE BRACKET
-* CODE 5C,&OPT,E0,N8 . BACK SLASH
-* CODE 5D,&OPT,BD,N8 . RIGHT SQUARE BRACKET
-* CODE 5E,&OPT,6A,N8 . CIRCUMFLEX
-* CODE 5F,&OPT,6D,N8 . UNDERSCORE
-* CODE 60,&OPT,79,N8 . GRAVE ACCENT
-* CODE 61,&OPT,81,N8 . LOWER A
-* CODE 62,&OPT,82,N8 . LOWER B
-* CODE 63,&OPT,83,N8 . LOWER C
-* CODE 64,&OPT,84,N8 . LOWER D
-* CODE 65,&OPT,85,N8 . LOWER E
-* CODE 66,&OPT,86,N8 . LOWER F
-* CODE 67,&OPT,87,N8 . LOWER G
-* CODE 68,&OPT,88,N8 . LOWER H
-* CODE 69,&OPT,89,N8 . LOWER I
-* CODE 6A,&OPT,91,N8 . LOWER J
-* CODE 6B,&OPT,92,N8 . LOWER K
-* CODE 6C,&OPT,93,N8 . LOWER L
-* CODE 6D,&OPT,94,N8 . LOWER M
-* CODE 6E,&OPT,95,N8 . LOWER N
-* CODE 6F,&OPT,96,N8 . LOWER O
-* CODE 70,&OPT,97,N8 . LOWER P
-* CODE 71,&OPT,98,N8 . LOWER Q
-* CODE 72,&OPT,99,N8 . LOWER R
-* CODE 73,&OPT,A2,N8 . LOWER S
-* CODE 74,&OPT,A3,N8 . LOWER T
-* CODE 75,&OPT,A4,N8 . LOWER U
-* CODE 76,&OPT,A5,N8 . LOWER V
-* CODE 77,&OPT,A6,N8 . LOWER W
-* CODE 78,&OPT,A7,N8 . LOWER X
-* CODE 79,&OPT,A8,N8 . LOWER Y
-* CODE 7A,&OPT,A9,N8 . LOWER Z
-* CODE 7B,&OPT,8B,N8 . LEFT BRACE
-* CODE 7C,&OPT,4F,N8 . VERTICAL BAR
-* CODE 7D,&OPT,9B,N8 . RIGHT BRACE
-* CODE 7E,&OPT,5F,N8 . LOGICAL NOT TO TILDE
-* CODE 7F,&OPT,07,N8 . DEL (RUBOUT)
-*
- SPACE
-TNT$A0E0 DC X'00010203372D2E2F1605250B0C0D0E0F'
- DC X'101112133C3D322618193F271C1D1E1F'
- DC X'405A7F7B5B6C507D4D5D5C4E6B604B61'
- DC X'F0F1F2F3F4F5F6F7F8F97A5E4C7E6E6F'
- DC X'7CC1C2C3C4C5C6C7C8C9D1D2D3D4D5D6'
- DC X'D7D8D9E2E3E4E5E6E7E8E9ADE0BD6A6D'
- DC X'79818283848586878889919293949596'
- DC X'979899A2A3A4A5A6A7A8A98B4F9B5F07'
- DC X'7B7B7B7B7B7B7B7B7B7B7B7B7B7B7B7B'
- DC X'7B7B7B7B7B7B7B7B7B7B7B7B7B7B7B7B'
- DC X'7B7B7B7B7B7B7B7B7B7B7B7B7B7B7B7B'
- DC X'7B7B7B7B7B7B7B7B7B7B7B7B7B7B7B7B'
- DC X'7B7B7B7B7B7B7B7B7B7B7B7B7B7B7B7B'
- DC X'7B7B7B7B7B7B7B7B7B7B7B7B7B7B7B7B'
- DC X'7B7B7B7B7B7B7B7B7B7B7B7B7B7B7B7B'
- DC X'7B7B7B7B7B7B7B7B7B7B7B7B7B7B7B7B'
- ORG TNT$A0E0+X'5E' TNT: Map ASCII caret/circumflex
- DC X'5F' to EBCDIC logical NOT
- ORG TNT$A0E0+X'7B' TNT: Map ASCII left curly bracket
- DC X'C0' to new CERN code
- ORG TNT$A0E0+X'7D' TNT: Map ASCII rihjt curly bracket
- DC X'D0' to new CERN code
- ORG TNT$A0E0+X'7E' TNT: Map ASCII tilde
- DC X'A1' to EBCDIC tilde
- ORG , TNT: Reset Location counter
- SPACE
- MEND
diff --git a/src/packlib/kernlib/kernbit/obsolete/m233ibm/c0e0.inc b/src/packlib/kernlib/kernbit/obsolete/m233ibm/c0e0.inc
deleted file mode 100644
index 185c992..0000000
--- a/src/packlib/kernlib/kernbit/obsolete/m233ibm/c0e0.inc
+++ /dev/null
@@ -1,37 +0,0 @@
-*
-* $Id: c0e0.inc,v 1.1.1.1 1996/02/15 17:47:40 mclareni Exp $
-*
-* $Log: c0e0.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:47:40 mclareni
-* Kernlib
-*
-*
-*
-* c0e0.inc
-*
- MACRO
-&L C0E0
- SPACE
-&L DS 0C BYTE ALIGNMENT ONLY
- SPACE
-* THIS TRANSLATE TABLE CONVERTS CERN CDC DISPLAY CODE
-* TO CERN EBCDIC.
- SPACE
- DC X'7BC1C2C3C4C5C6C7C8C9D1D2D3D4D5D6'
- DC X'D7D8D9E2E3E4E5E6E7E8E9F0F1F2F3F4'
- DC X'F5F6F7F8F94E605C614D5D5B7E406B4B'
- DC X'7BADBD7A7F6D5A507D6F4C6E7CE06A5E'
- DC X'7B7B7B7B7B7B7B7B7B7B7B7B7B7B7B7B'
- DC X'7B7B7B7B7B7B7B7B7B7B7B7B7B7B7B7B'
- DC X'7B7B7B7B7B7B7B7B7B7B7B7B7B7B7B7B'
- DC X'7B7B7B7B7B7B7B7B7B7B7B7B7B7B7B7B'
- DC X'7B7B7B7B7B7B7B7B7B7B7B7B7B7B7B7B'
- DC X'7B7B7B7B7B7B7B7B7B7B7B7B7B7B7B7B'
- DC X'7B7B7B7B7B7B7B7B7B7B7B7B7B7B7B7B'
- DC X'7B7B7B7B7B7B7B7B7B7B7B7B7B7B7B7B'
- DC X'7B7B7B7B7B7B7B7B7B7B7B7B7B7B7B7B'
- DC X'7B7B7B7B7B7B7B7B7B7B7B7B7B7B7B7B'
- DC X'7B7B7B7B7B7B7B7B7B7B7B7B7B7B7B7B'
- DC X'7B7B7B7B7B7B7B7B7B7B7B7B7B7B7B7B'
- SPACE
- MEND
diff --git a/src/packlib/kernlib/kernbit/obsolete/m233ibm/e0a0.inc b/src/packlib/kernlib/kernbit/obsolete/m233ibm/e0a0.inc
deleted file mode 100644
index 6667cff..0000000
--- a/src/packlib/kernlib/kernbit/obsolete/m233ibm/e0a0.inc
+++ /dev/null
@@ -1,63 +0,0 @@
-*
-* $Id: e0a0.inc,v 1.1.1.1 1996/02/15 17:47:40 mclareni Exp $
-*
-* $Log: e0a0.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:47:40 mclareni
-* Kernlib
-*
-*
-*
-* e0a0.inc
-*
- MACRO
-&L E0A0
- SPACE
-&L DS 0C BYTE ALIGNMENT ONLY
- SPACE
-* THIS TRANSLATE TABLE CONVERTS CERN EBCDIC TO CERN ASCII
-*
-* IT IS BASED ON THE RUTHERFORD TABLE WITH THE FOLLOWING
-* MODIFICATIONS:-
-* EBCDIC 6A IS CONVERTED TO ASCII 5E (CIRCUMFLEX)
-* EBCDIC 71 IS CONSIDERED ILLEGAL
-* ILLEGAL CHARACTERS ARE CONVERTED TO 23 (HASH) RATHER THAN
-* 25 (PERCENT)
-*
-* Changed for new CERN character set/conversions
-* See below for details of change.
-* Tony Cass User Support CERN/DD 5th December 1989
-*
- SPACE
-TNT$E0A0 DC X'000102032309237F2323230B0C0D0E0F'
- DC X'1011121323230823181923231C1D1E1F'
- DC X'23232323230A171B2323232323050607'
- DC X'2323162323232304232323231415231A'
- DC X'20232323232323232323232E3C282B7C'
- DC X'2623232323232323232321242A293B7E'
- DC X'2D2F23232323232323235E2C255F3E3F'
- DC X'232323232323232323603A2340273D22'
- DC X'23616263646566676869237B23232323'
- DC X'236A6B6C6D6E6F707172237D23232323'
- DC X'2323737475767778797A2323235B2323'
- DC X'232323232323232323232323235D2323'
- DC X'23414243444546474849232323232323'
- DC X'234A4B4C4D4E4F505152232323232323'
- DC X'5C23535455565758595A232323232323'
- DC X'30313233343536373839232323232323'
- ORG TNT$E0A0+X'5F' TNT: Map EBCDIC Logical NOT
- DC X'5E' to ASCII caret/circumflex
- ORG TNT$E0A0+X'6A' TNT: Map EBCDIC Split bar
- DC X'23' to ASCII default
- ORG TNT$E0A0+X'8B' TNT: Old CERN curly bracket (left)
- DC X'23' to ASCII default
- ORG TNT$E0A0+X'9B' TNT: Old CERN curly bracket (right)
- DC X'23' to ASCII default
- ORG TNT$E0A0+X'A1' TNT: Map EBCDIC tilde
- DC X'7E' to ASCII tilde
- ORG TNT$E0A0+X'C0' TNT: New CERN curly bracket (left)
- DC X'7B' to ASCII
- ORG TNT$E0A0+X'D0' TNT: New CERN curly bracket (right)
- DC X'7D' to ASCII
- ORG , TNT: Reset Location counter
- SPACE
- MEND
diff --git a/src/packlib/kernlib/kernbit/obsolete/m233ibm/e0c0.inc b/src/packlib/kernlib/kernbit/obsolete/m233ibm/e0c0.inc
deleted file mode 100644
index a7f7ced..0000000
--- a/src/packlib/kernlib/kernbit/obsolete/m233ibm/e0c0.inc
+++ /dev/null
@@ -1,47 +0,0 @@
-*
-* $Id: e0c0.inc,v 1.1.1.1 1996/02/15 17:47:40 mclareni Exp $
-*
-* $Log: e0c0.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:47:40 mclareni
-* Kernlib
-*
-*
-*
-* e0c0.inc
-*
- MACRO
-&L E0C0
- SPACE
-&L DS 0C BYTE ALIGNMENT ONLY
- SPACE
-* THIS TRANSLATE TABLE CONVERTS CERN EBCDIC TO CERN
-* CDC DISPLAY CODE.
-* LOWER CASE CHARACTERS ARE CONVERTED INTO UPPER CASE
-* PERCENT (HEX 6C) AND COLON (HEX 7A) ARE BOTH CONVERTED
-* TO PERCENT (HEX 33, 63B)
-* VERTICAL BAR (HEX 4F) AND BACKSLASH (HEX E0) ARE BOTH
-* CONVERTED TO BACKSLASH (HEX 3D, 75B)
-* LOGICAL NOT/TILDE (HEX 5F) AND CIRCUMFLEX (HEX 6A) ARE
-* BOTH CONVERTED TO CIRCUMFLEX (HEX 3E, 76B)
-* LEFT AND RIGHT BRACE (HEX 4D, 5D) AND LEFT AND RIGHT
-* SQUARE BRACKETS(HEX AD,BD) ARE BOTH CONVERTED TO SQUARE
-* BRACKETS (HEX 31,32, 61B,62B)
- SPACE
- DC X'30303030303030303030303030303030'
- DC X'30303030303030303030303030303030'
- DC X'30303030303030303030303030303030'
- DC X'30303030303030303030303030303030'
- DC X'30303030303030303030302F3A29253D'
- DC X'37303030303030303030362B272A3F3E'
- DC X'262830303030303030303E2E33353B39'
- DC X'3030303030303030303033303C382C34'
- DC X'30010203040506070809303130303030'
- DC X'300A0B0C0D0E0F101112303230303030'
- DC X'3030131415161718191A303030313030'
- DC X'30303030303030303030303030323030'
- DC X'30010203040506070809303030303030'
- DC X'300A0B0C0D0E0F101112303030303030'
- DC X'3D30131415161718191A303030303030'
- DC X'1B1C1D1E1F2021222324303030303030'
- SPACE
- MEND
diff --git a/src/packlib/kernlib/kernbit/obsolete/m233ibm/e0el.inc b/src/packlib/kernlib/kernbit/obsolete/m233ibm/e0el.inc
deleted file mode 100644
index a2817ab..0000000
--- a/src/packlib/kernlib/kernbit/obsolete/m233ibm/e0el.inc
+++ /dev/null
@@ -1,37 +0,0 @@
-*
-* $Id: e0el.inc,v 1.1.1.1 1996/02/15 17:47:40 mclareni Exp $
-*
-* $Log: e0el.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:47:40 mclareni
-* Kernlib
-*
-*
-*
-* e0el.inc
-*
- MACRO
-&L E0EL
- SPACE
-&L DS 0C BYTE ALIGNMENT ONLY
- SPACE
-* THIS TRANSLATE TABLE CONVERTS CERN EBCDIC TO CERN EBCDIC
-* WITH ONLY LOWER CASE LETTERS.
- SPACE
- DC X'000102030405060708090A0B0C0D0E0F'
- DC X'101112131415161718191A1B1C1D1E1F'
- DC X'202122232425262728292A2B2C2D2E2F'
- DC X'303132333435363738393A3B3C3D3E3F'
- DC X'404142434445464748494A4B4C4D4E4F'
- DC X'505152535455565758595A5B5C5D5E5F'
- DC X'606162636465666768696A6B6C6D6E6F'
- DC X'707172737475767778797A7B7C7D7E7F'
- DC X'808182838485868788898A8B8C8D8E8F'
- DC X'909192939495969798999A9B9C9D9E9F'
- DC X'A0A1A2A3A4A5A6A7A8A9AAABACADAEAF'
- DC X'B0B1B2B3B4B5B6B7B8B9BABBBCBDBEBF'
- DC X'C0818283848586878889CACBCCCDCECF'
- DC X'D0919293949596979899DADBDCDDDEDF'
- DC X'E0E1A2A3A4A5A6A7A8A9EAEBECEDEEEF'
- DC X'F0F1F2F3F4F5F6F7F8F9FAFBFCFDFEFF'
- SPACE
- MEND
diff --git a/src/packlib/kernlib/kernbit/obsolete/m233ibm/e0eu.inc b/src/packlib/kernlib/kernbit/obsolete/m233ibm/e0eu.inc
deleted file mode 100644
index d8f70ea..0000000
--- a/src/packlib/kernlib/kernbit/obsolete/m233ibm/e0eu.inc
+++ /dev/null
@@ -1,37 +0,0 @@
-*
-* $Id: e0eu.inc,v 1.1.1.1 1996/02/15 17:47:40 mclareni Exp $
-*
-* $Log: e0eu.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:47:40 mclareni
-* Kernlib
-*
-*
-*
-* e0eu.inc
-*
- MACRO
-&L E0EU
- SPACE
-&L DS 0C BYTE ALIGNMENT ONLY
- SPACE
-* THIS TRANSLATE TABLE CONVERTS CERN EBCDIC TO CERN EBCDIC
-* WITH ONLY UPPER CASE LETTERS.
- SPACE
- DC X'000102030405060708090A0B0C0D0E0F'
- DC X'101112131415161718191A1B1C1D1E1F'
- DC X'202122232425262728292A2B2C2D2E2F'
- DC X'303132333435363738393A3B3C3D3E3F'
- DC X'404142434445464748494A4B4C4D4E4F'
- DC X'505152535455565758595A5B5C5D5E5F'
- DC X'606162636465666768696A6B6C6D6E6F'
- DC X'707172737475767778797A7B7C7D7E7F'
- DC X'80C1C2C3C4C5C6C7C8C98A8B8C8D8E8F'
- DC X'90D1D2D3D4D5D6D7D8D99A9B9C9D9E9F'
- DC X'A0A1E2E3E4E5E6E7E8E9AAABACADAEAF'
- DC X'B0B1B2B3B4B5B6B7B8B9BABBBCBDBEBF'
- DC X'C0C1C2C3C4C5C6C7C8C9CACBCCCDCECF'
- DC X'D0D1D2D3D4D5D6D7D8D9DADBDCDDDEDF'
- DC X'E0E1E2E3E4E5E6E7E8E9EAEBECEDEEEF'
- DC X'F0F1F2F3F4F5F6F7F8F9FAFBFCFDFEFF'
- SPACE
- MEND
diff --git a/src/packlib/kernlib/kernbit/obsolete/m233ibm/e0tn.inc b/src/packlib/kernlib/kernbit/obsolete/m233ibm/e0tn.inc
deleted file mode 100644
index bc4b80b..0000000
--- a/src/packlib/kernlib/kernbit/obsolete/m233ibm/e0tn.inc
+++ /dev/null
@@ -1,40 +0,0 @@
-*
-* $Id: e0tn.inc,v 1.1.1.1 1996/02/15 17:47:40 mclareni Exp $
-*
-* $Log: e0tn.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:47:40 mclareni
-* Kernlib
-*
-*
-*
-* e0tn.inc
-*
- MACRO
-&L E0TN
- SPACE
-&L DS 0C BYTE ALIGNMENT ONLY
- SPACE
-* THIS TRANSLATE TABLE CONVERTS CERN EBCDIC TO CHARACTERS
-* THAT ARE AVAILABLE ON THE TN PRINT TRAIN, ALLOWING MUCH
-* FASTER PRINTING. ALL OTHER CHARACTERS ARE CONVERTED TO
-* SPACE
-*
- SPACE
- DC X'40404040404040404040404040404040'
- DC X'40404040404040404040404040404040'
- DC X'40404040404040404040404040404040'
- DC X'40404040404040404040404040404040'
- DC X'404040404040404040404A4B4C4D4E4F'
- DC X'504040404040404040405A5B5C5D5E5F'
- DC X'60614040404040404040406B6C6D6E6F'
- DC X'404040404040404040407A7B7C7D7E7F'
- DC X'40818283848586878889408B8C8D8E8F'
- DC X'40919293949596979899409B9C9D9E9F'
- DC X'A0A1A2A3A4A5A6A7A8A940ABACADAEAF'
- DC X'B0B1B2B3B4B5B6B7B8B940BBBCBDBEBF'
- DC X'40C1C2C3C4C5C6C7C8C9404040404040'
- DC X'40D1D2D3D4D5D6D7D8D9404040404040'
- DC X'E040E2E3E4E5E6E7E8E9404040404040'
- DC X'F0F1F2F3F4F5F6F7F8F9404040404040'
- SPACE
- MEND
diff --git a/src/packlib/kernlib/kernbit/obsolete/m233ibm/e0zt.inc b/src/packlib/kernlib/kernbit/obsolete/m233ibm/e0zt.inc
deleted file mode 100644
index f07172c..0000000
--- a/src/packlib/kernlib/kernbit/obsolete/m233ibm/e0zt.inc
+++ /dev/null
@@ -1,38 +0,0 @@
-*
-* $Id: e0zt.inc,v 1.1.1.1 1996/02/15 17:47:40 mclareni Exp $
-*
-* $Log: e0zt.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:47:40 mclareni
-* Kernlib
-*
-*
-*
-* e0zt.inc
-*
- MACRO
-&L E0ZT
- SPACE
-&L DS 0C BYTE ALIGNMENT ONLY
- SPACE
-* THIS TRANSLATE TABLE CONVERTS CERN EBCDIC TO EBCDIC WITH
-* ONLY THOSE CHARACTERS WHICH ARE AVAILABLE ON A TN
-* PRINT TRAIN. OTHER CHARACTERS ARE CONVERTED TO C'.'.
- SPACE
- DC X'4B4B4B4B4B4B4B4B4B4B4B4B4B4B4B4B'
- DC X'4B4B4B4B4B4B4B4B4B4B4B4B4B4B4B4B'
- DC X'4B4B4B4B4B4B4B4B4B4B4B4B4B4B4B4B'
- DC X'4B4B4B4B4B4B4B4B4B4B4B4B4B4B4B4B'
- DC X'404B4B4B4B4B4B4B4B4B4A4B4C4D4E4F'
- DC X'504B4B4B4B4B4B4B4B4B5A5B5C5D5E5F'
- DC X'60614B4B4B4B4B4B4B4B4B6B6C6D6E6F'
- DC X'4B4B4B4B4B4B4B4B4B4B7A7B7C7D7E7F'
- DC X'4B8182838485868788894B8B8C8D8E8F'
- DC X'4B9192939495969798994B9B9C9D9E9F'
- DC X'A0A1A2A3A4A5A6A7A8A94BABACADAEAF'
- DC X'B0B1B2B3B4B5B6B7B8B94BBBBCBDBEBF'
- DC X'4BC1C2C3C4C5C6C7C8C94B4B4B4B4B4B'
- DC X'4BD1D2D3D4D5D6D7D8D94B4B4B4B4B4B'
- DC X'E04BE2E3E4E5E6E7E8E94B4B4B4B4B4B'
- DC X'F0F1F2F3F4F5F6F7F8F94B4B4B4B4B4B'
- SPACE
- MEND
diff --git a/src/packlib/kernlib/kernbit/obsolete/m233ibm/tra0e0.s b/src/packlib/kernlib/kernbit/obsolete/m233ibm/tra0e0.s
deleted file mode 100644
index 0a3b199..0000000
--- a/src/packlib/kernlib/kernbit/obsolete/m233ibm/tra0e0.s
+++ /dev/null
@@ -1,45 +0,0 @@
-*
-* $Id: tra0e0.s,v 1.1.1.1 1996/02/15 17:47:41 mclareni Exp $
-*
-* $Log: tra0e0.s,v $
-* Revision 1.1.1.1 1996/02/15 17:47:41 mclareni
-* Kernlib
-*
-*
-#include "a0e0.inc"
-TRA0E0 CSECT
-#if defined(CERNLIB_QMIBMXA)
-TRA0E0 AMODE ANY
-TRA0E0 RMODE ANY
-#endif
-*
-* CALL TRA0E0(AREA,N)
-* TRANSLATES N BYTES IN AREA
-*
- B 12(15) BRANCH PAST NAME
- DC X'07',CL7'TRA0E0 '
-*
- STM 14,12,12(13)
- BALR 12,0
- USING *,12
- B START
-TAB A0E0
-START L 2,0(1) ADDRESS OF AREA
- L 3,4(1) ADDRESS OF N
- L 3,0(3) VALUE OF N
- LA 4,256(0) SET UP 256
-LOOP SR 3,4 SEE IF MORE THAN 256 LEFT
- BC 13,FINAL
- TR 0(256,2),TAB TRANSLATE 256 BYTE AT A TIME
- LA 2,256(2)
- B LOOP
-FINAL AR 3,4
- BC 8,RETURN IF ZERO LEFT RETURN
- BCTR 3,0
- EX 3,TRA TRANSLATE THE REST
-RETURN LM 2,12,28(13) RESTORE REGISTERS
-** MVI 12(13),X'FF'
- BR 14
-TRA TR 0(,2),TAB
-*
- END
diff --git a/src/packlib/kernlib/kernbit/obsolete/m233ibm/trc0e0.s b/src/packlib/kernlib/kernbit/obsolete/m233ibm/trc0e0.s
deleted file mode 100644
index 33d87e3..0000000
--- a/src/packlib/kernlib/kernbit/obsolete/m233ibm/trc0e0.s
+++ /dev/null
@@ -1,45 +0,0 @@
-*
-* $Id: trc0e0.s,v 1.1.1.1 1996/02/15 17:47:41 mclareni Exp $
-*
-* $Log: trc0e0.s,v $
-* Revision 1.1.1.1 1996/02/15 17:47:41 mclareni
-* Kernlib
-*
-*
-#include "c0e0.inc"
-TRC0E0 CSECT
-#if defined(CERNLIB_QMIBMXA)
-TRC0E0 AMODE ANY
-TRC0E0 RMODE ANY
-#endif
-*
-* CALL TRC0E0(AREA,N)
-* TRANSLATES N BYTES IN AREA
-*
- B 12(15) BRANCH PAST NAME
- DC X'07',CL7'TRC0E0 '
-*
- STM 14,12,12(13)
- BALR 12,0
- USING *,12
- B START
-TAB C0E0
-START L 2,0(1) ADDRESS OF AREA
- L 3,4(1) ADDRESS OF N
- L 3,0(3) VALUE OF N
- LA 4,256(0) SET UP 256
-LOOP SR 3,4 SEE IF MORE THAN 256 LEFT
- BC 13,FINAL
- TR 0(256,2),TAB TRANSLATE 256 BYTE AT A TIME
- LA 2,256(2)
- B LOOP
-FINAL AR 3,4
- BC 8,RETURN IF ZERO LEFT RETURN
- BCTR 3,0
- EX 3,TRA TRANSLATE THE REST
-RETURN LM 2,12,28(13) RESTORE REGISTERS
-** MVI 12(13),X'FF'
- BR 14
-TRA TR 0(,2),TAB
-*
- END
diff --git a/src/packlib/kernlib/kernbit/obsolete/m233ibm/tre0a0.s b/src/packlib/kernlib/kernbit/obsolete/m233ibm/tre0a0.s
deleted file mode 100644
index 2ad409c..0000000
--- a/src/packlib/kernlib/kernbit/obsolete/m233ibm/tre0a0.s
+++ /dev/null
@@ -1,45 +0,0 @@
-*
-* $Id: tre0a0.s,v 1.1.1.1 1996/02/15 17:47:41 mclareni Exp $
-*
-* $Log: tre0a0.s,v $
-* Revision 1.1.1.1 1996/02/15 17:47:41 mclareni
-* Kernlib
-*
-*
-#include "e0a0.inc"
-TRE0A0 CSECT
-#if defined(CERNLIB_QMIBMXA)
-TRE0A0 AMODE ANY
-TRE0A0 RMODE ANY
-#endif
-*
-* CALL TRE0A0(AREA,N)
-* TRANSLATES N BYTES IN AREA
-*
- B 12(15) BRANCH PAST NAME
- DC X'07',CL7'TRE0A0 '
-*
- STM 14,12,12(13)
- BALR 12,0
- USING *,12
- B START
-TAB E0A0
-START L 2,0(1) ADDRESS OF AREA
- L 3,4(1) ADDRESS OF N
- L 3,0(3) VALUE OF N
- LA 4,256(0) SET UP 256
-LOOP SR 3,4 SEE IF MORE THAN 256 LEFT
- BC 13,FINAL
- TR 0(256,2),TAB TRANSLATE 256 BYTE AT A TIME
- LA 2,256(2)
- B LOOP
-FINAL AR 3,4
- BC 8,RETURN IF ZERO LEFT RETURN
- BCTR 3,0
- EX 3,TRA TRANSLATE THE REST
-RETURN LM 2,12,28(13) RESTORE REGISTERS
-** MVI 12(13),X'FF'
- BR 14
-TRA TR 0(,2),TAB
-*
- END
diff --git a/src/packlib/kernlib/kernbit/obsolete/m233ibm/tre0c0.s b/src/packlib/kernlib/kernbit/obsolete/m233ibm/tre0c0.s
deleted file mode 100644
index af82a46..0000000
--- a/src/packlib/kernlib/kernbit/obsolete/m233ibm/tre0c0.s
+++ /dev/null
@@ -1,45 +0,0 @@
-*
-* $Id: tre0c0.s,v 1.1.1.1 1996/02/15 17:47:41 mclareni Exp $
-*
-* $Log: tre0c0.s,v $
-* Revision 1.1.1.1 1996/02/15 17:47:41 mclareni
-* Kernlib
-*
-*
-#include "e0c0.inc"
-TRE0C0 CSECT
-#if defined(CERNLIB_QMIBMXA)
-TRE0C0 AMODE ANY
-TRE0C0 RMODE ANY
-#endif
-*
-* CALL TRE0C0(AREA,N)
-* TRANSLATES N BYTES IN AREA
-*
- B 12(15) BRANCH PAST NAME
- DC X'07',CL7'TRE0C0 '
-*
- STM 14,12,12(13)
- BALR 12,0
- USING *,12
- B START
-TAB E0C0
-START L 2,0(1) ADDRESS OF AREA
- L 3,4(1) ADDRESS OF N
- L 3,0(3) VALUE OF N
- LA 4,256(0) SET UP 256
-LOOP SR 3,4 SEE IF MORE THAN 256 LEFT
- BC 13,FINAL
- TR 0(256,2),TAB TRANSLATE 256 BYTE AT A TIME
- LA 2,256(2)
- B LOOP
-FINAL AR 3,4
- BC 8,RETURN IF ZERO LEFT RETURN
- BCTR 3,0
- EX 3,TRA TRANSLATE THE REST
-RETURN LM 2,12,28(13) RESTORE REGISTERS
-** MVI 12(13),X'FF'
- BR 14
-TRA TR 0(,2),TAB
-*
- END
diff --git a/src/packlib/kernlib/kernbit/obsolete/m233ibm/tre0el.s b/src/packlib/kernlib/kernbit/obsolete/m233ibm/tre0el.s
deleted file mode 100644
index 9291114..0000000
--- a/src/packlib/kernlib/kernbit/obsolete/m233ibm/tre0el.s
+++ /dev/null
@@ -1,45 +0,0 @@
-*
-* $Id: tre0el.s,v 1.1.1.1 1996/02/15 17:47:40 mclareni Exp $
-*
-* $Log: tre0el.s,v $
-* Revision 1.1.1.1 1996/02/15 17:47:40 mclareni
-* Kernlib
-*
-*
-#include "e0el.inc"
-TRE0EL CSECT
-#if defined(CERNLIB_QMIBMXA)
-TRE0EL AMODE ANY
-TRE0EL RMODE ANY
-#endif
-*
-* CALL TRE0EL(AREA,N)
-* TRANSLATES N BYTES IN AREA
-*
- B 12(15) BRANCH PAST NAME
- DC X'07',CL7'TRE0EL '
-*
- STM 14,12,12(13)
- BALR 12,0
- USING *,12
- B START
-TAB E0EL
-START L 2,0(1) ADDRESS OF AREA
- L 3,4(1) ADDRESS OF N
- L 3,0(3) VALUE OF N
- LA 4,256(0) SET UP 256
-LOOP SR 3,4 SEE IF MORE THAN 256 LEFT
- BC 13,FINAL
- TR 0(256,2),TAB TRANSLATE 256 BYTE AT A TIME
- LA 2,256(2)
- B LOOP
-FINAL AR 3,4
- BC 8,RETURN IF ZERO LEFT RETURN
- BCTR 3,0
- EX 3,TRA TRANSLATE THE REST
-RETURN LM 2,12,28(13) RESTORE REGISTERS
-** MVI 12(13),X'FF'
- BR 14
-TRA TR 0(,2),TAB
-*
- END
diff --git a/src/packlib/kernlib/kernbit/obsolete/m233ibm/tre0eu.s b/src/packlib/kernlib/kernbit/obsolete/m233ibm/tre0eu.s
deleted file mode 100644
index c991150..0000000
--- a/src/packlib/kernlib/kernbit/obsolete/m233ibm/tre0eu.s
+++ /dev/null
@@ -1,45 +0,0 @@
-*
-* $Id: tre0eu.s,v 1.1.1.1 1996/02/15 17:47:40 mclareni Exp $
-*
-* $Log: tre0eu.s,v $
-* Revision 1.1.1.1 1996/02/15 17:47:40 mclareni
-* Kernlib
-*
-*
-#include "e0eu.inc"
-TRE0EU CSECT
-#if defined(CERNLIB_QMIBMXA)
-TRE0EU AMODE ANY
-TRE0EU RMODE ANY
-#endif
-*
-* CALL TRE0EU(AREA,N)
-* TRANSLATES N BYTES IN AREA
-*
- B 12(15) BRANCH PAST NAME
- DC X'07',CL7'TRE0EU '
-*
- STM 14,12,12(13)
- BALR 12,0
- USING *,12
- B START
-TAB E0EU
-START L 2,0(1) ADDRESS OF AREA
- L 3,4(1) ADDRESS OF N
- L 3,0(3) VALUE OF N
- LA 4,256(0) SET UP 256
-LOOP SR 3,4 SEE IF MORE THAN 256 LEFT
- BC 13,FINAL
- TR 0(256,2),TAB TRANSLATE 256 BYTE AT A TIME
- LA 2,256(2)
- B LOOP
-FINAL AR 3,4
- BC 8,RETURN IF ZERO LEFT RETURN
- BCTR 3,0
- EX 3,TRA TRANSLATE THE REST
-RETURN LM 2,12,28(13) RESTORE REGISTERS
-** MVI 12(13),X'FF'
- BR 14
-TRA TR 0(,2),TAB
-*
- END
diff --git a/src/packlib/kernlib/kernbit/obsolete/m233ibm/tre0tn.s b/src/packlib/kernlib/kernbit/obsolete/m233ibm/tre0tn.s
deleted file mode 100644
index fe62da2..0000000
--- a/src/packlib/kernlib/kernbit/obsolete/m233ibm/tre0tn.s
+++ /dev/null
@@ -1,45 +0,0 @@
-*
-* $Id: tre0tn.s,v 1.1.1.1 1996/02/15 17:47:40 mclareni Exp $
-*
-* $Log: tre0tn.s,v $
-* Revision 1.1.1.1 1996/02/15 17:47:40 mclareni
-* Kernlib
-*
-*
-#include "e0tn.inc"
-TRE0TN CSECT
-#if defined(CERNLIB_QMIBMXA)
-TRE0TN AMODE ANY
-TRE0TN RMODE ANY
-#endif
-*
-* CALL TRE0TN(AREA,N)
-* TRANSLATES N BYTES IN AREA
-*
- B 12(15) BRANCH PAST NAME
- DC X'07',CL7'TRE0TN '
-*
- STM 14,12,12(13)
- BALR 12,0
- USING *,12
- B START
-TAB E0TN
-START L 2,0(1) ADDRESS OF AREA
- L 3,4(1) ADDRESS OF N
- L 3,0(3) VALUE OF N
- LA 4,256(0) SET UP 256
-LOOP SR 3,4 SEE IF MORE THAN 256 LEFT
- BC 13,FINAL
- TR 0(256,2),TAB TRANSLATE 256 BYTE AT A TIME
- LA 2,256(2)
- B LOOP
-FINAL AR 3,4
- BC 8,RETURN IF ZERO LEFT RETURN
- BCTR 3,0
- EX 3,TRA TRANSLATE THE REST
-RETURN LM 2,12,28(13) RESTORE REGISTERS
-** MVI 12(13),X'FF'
- BR 14
-TRA TR 0(,2),TAB
-*
- END
diff --git a/src/packlib/kernlib/kernbit/obsolete/m233ibm/tre0zt.s b/src/packlib/kernlib/kernbit/obsolete/m233ibm/tre0zt.s
deleted file mode 100644
index 4ce5677..0000000
--- a/src/packlib/kernlib/kernbit/obsolete/m233ibm/tre0zt.s
+++ /dev/null
@@ -1,45 +0,0 @@
-*
-* $Id: tre0zt.s,v 1.1.1.1 1996/02/15 17:47:40 mclareni Exp $
-*
-* $Log: tre0zt.s,v $
-* Revision 1.1.1.1 1996/02/15 17:47:40 mclareni
-* Kernlib
-*
-*
-#include "e0zt.inc"
-TRE0ZT CSECT
-#if defined(CERNLIB_QMIBMXA)
-TRE0ZT AMODE ANY
-TRE0ZT RMODE ANY
-#endif
-*
-* CALL TRE0ZT(AREA,N)
-* TRANSLATES N BYTES IN AREA
-*
- B 12(15) BRANCH PAST NAME
- DC X'07',CL7'TRE0ZT '
-*
- STM 14,12,12(13)
- BALR 12,0
- USING *,12
- B START
-TAB E0ZT
-START L 2,0(1) ADDRESS OF AREA
- L 3,4(1) ADDRESS OF N
- L 3,0(3) VALUE OF N
- LA 4,256(0) SET UP 256
-LOOP SR 3,4 SEE IF MORE THAN 256 LEFT
- BC 13,FINAL
- TR 0(256,2),TAB TRANSLATE 256 BYTE AT A TIME
- LA 2,256(2)
- B LOOP
-FINAL AR 3,4
- BC 8,RETURN IF ZERO LEFT RETURN
- BCTR 3,0
- EX 3,TRA TRANSLATE THE REST
-RETURN LM 2,12,28(13) RESTORE REGISTERS
-** MVI 12(13),X'FF'
- BR 14
-TRA TR 0(,2),TAB
-*
- END
diff --git a/src/packlib/kernlib/kernbit/obsolete/m416/ublow1.s b/src/packlib/kernlib/kernbit/obsolete/m416/ublow1.s
deleted file mode 100644
index 9cd8f3e..0000000
--- a/src/packlib/kernlib/kernbit/obsolete/m416/ublow1.s
+++ /dev/null
@@ -1,169 +0,0 @@
-*
-* $Id: ublow1.s,v 1.1.1.1 1996/02/15 17:47:40 mclareni Exp $
-*
-* $Log: ublow1.s,v $
-* Revision 1.1.1.1 1996/02/15 17:47:40 mclareni
-* Kernlib
-*
-*
-#if defined(CERNLIB_CDC)
- IDENT UBLOW1
- ENTRY UBLOW1
-* SUBROUTINE UBLOW1 (A,X,NBITS)
-* (WRITTEN FOR SCOPE 3.3 - FTN)
-*
-* X1 LOOP COUNT B1 LAST STORE ADR
-* X2 B2 STORE ADR
-* X3 B3 NBITS REMAINING
-* X5 WORD BEING ANALYS. B5
-* X6 RESULT B6 = 60
-* X7 =-1 B7 =-1
-*
- VFD 36/0HUBLOW1,24/0
- UBLOW1 BSS 1
- SA2 A1+2 .X2=ADDRESS OF NBITS
- MX7 59 .X7=-1
- SB7 X7 .B7=-1
- SA3 X2 .X3=NBITS
- SB6 60
- SA4 A1-B7 .X4=ADDRESS OF X
- SA5 X1 .ADR(A)
- SB3 X3 .NBITS
- SB2 X4
- SB1 X4+B3
- LOOP1 SX1 B3 .J=NBITS
- GE B6,B3,LOOP2 .J=60 IF NBITS.GT.60
- SX1 B6
- LOOP2 BX6 -X7*X5 .PICK BIT
- IX1 X1+X7 .J=J-1
- LX5 59 .RIGHT-SHIFT OF ANALYSED WORD BY 1
- SA6 B2 .STORE RESULT
- SB2 B2-B7 .STEP STORE ADR
- NZ X1,LOOP2
- GE B2,B1,UBLOW1
- SA5 A5-B7 .NEXT WORD TO BE BLOWN UP
- SB3 B3-B6 .NBITS= NBITS - 60
- EQ LOOP1
- END
-#endif
-#if defined(CERNLIB_IBM)
- TITLE 'UBLOW1'
-***********************************************************************
-* *
-* U B L O W 1 *
-* =========== *
-* *
-***********************************************************************
-* *
-* REFER TO CERN PROGRAM LIBRARY MEMBER M416 FOR DETAILS. *
-* *
-***********************************************************************
- EJECT
-***********************************************************************
-* *
-* M O D I F I C A T I O N L O G *
-* =============================== *
-* *
-***********************************************************************
-* *
-* 1 . 0 0 *
-* ======= *
-* *
-* ORIGINAL VERSION. *
-* *
-* R. MATTHEWS, CERN/DD, JULY 1982. *
-* *
-***********************************************************************
- EJECT
- EJECT
- PRINT NOGEN
-UBLOW1 CSECT
-#endif
-#if defined(CERNLIB_QMIBMXA)
-UBLOW1 AMODE ANY
-UBLOW1 RMODE ANY
-#endif
-#if defined(CERNLIB_IBM)
- SPACE 2
-* P R O L O G U E
- SPACE
- USING UBLOW1,R15
- B SAVEREGS
- DC AL1(7),CL7'UBLOW1' IDENTIFIER
- DC C'1.00' VERSION.MODIFICATION LEVEL
-SAVEREGS STM R14,R12,12(R13)
- LR R4,R13
- CNOP 0,4
- BAL R13,AROUNDSA
-SAVEAREA DC A(EPILOGUE),17F'0'
- DROP R15
- USING SAVEAREA,R13
-AROUNDSA ST R13,8(0,R4)
- ST R4,4(0,R13)
- XC 8(4,R13),8(R13)
- SPACE 2
-* P R O C E S S
- SPACE
- LM R2,R4,0(R1) R2 -> A; R3 -> K; R4 -> N
- L R4,0(0,R4) R4 := N
- L R8,=F'-4' R8 := -4 FOR LOOP INCREMENT
- AR R3,R8 R3 -> K(0)
- SRDL R4,5 R4 := NUMBER OF FULLWORDS TO PROCESS
- SRL R5,27 R5 := NUMBER OF ADDITIONAL BITS
- LTR R4,R4 ARE THERE ANY FULLWORDS ?
- BNP EXTRABIT NO, BRANCH
- SPACE
-NEXTWORD L R7,0(0,R2) R7 := WORD TO BE DISPERSED
- LR R9,R3 R9 := TEST VALUE FOR LOOPING
- LA R3,32*4(0,R3) R3 -> FIRST TARGET WORD
- SPACE
-NEXTBIT SR R6,R6 R6 := 0
- SLDL R6,1 SHIFT IN THE NEXT BIT
- ST R6,0(0,R3) STORE IT IN K
- BXH R3,R8,NEXTBIT LOOP TO PROCESS THE NEXT BIT OF THE WORD
- SPACE
- LA R2,4(0,R2) R2 -> NEXT WORD TO BE DISPERSED
- LA R3,32*4(0,R3) R3 -> NEXT TARGET AREA
- BCT R4,NEXTWORD LOOP TO PROCESS THE NEXT FULLWORD
- SPACE
-EXTRABIT LTR R5,R5 ARE THERE ANY ADDITIONAL BITS ?
- BNP EPILOGUE NO, BRANCH
- L R6,0(0,R2) GET THEM INTO R6
- SRDL R6,0(R5) SHIFT THEM INTO R7
- LR R9,R3 R9 := TEST VALUE FOR LOOPING
- SLL R5,2 R5 := NUMBER OF TARGET BYTES
- LA R3,0(R5,R3) R3 -> FIRST TARGET WORD
- SPACE
-NEXTBIT1 SR R6,R6 R6 := 0
- SLDL R6,1 SHIFT IN THE NEXT BIT
- ST R6,0(0,R3) STORE IT IN K
- BXH R3,R8,NEXTBIT1 LOOP TO PROCESS THE NEXT BIT
- SPACE 2
-* E P I L O G U E
- SPACE
-EPILOGUE EQU *
- L R13,4(0,R13)
- LM R14,R12,12(R13)
-** MVI 12(R13),X'FF'
- BR R14
- SPACE
- LTORG
-R0 EQU 0
-R1 EQU 1
-R2 EQU 2
-R3 EQU 3
-R4 EQU 4
-R5 EQU 5
-R6 EQU 6
-R7 EQU 7
-R8 EQU 8
-R9 EQU 9
-R10 EQU 10
-R11 EQU 11
-R12 EQU 12
-R13 EQU 13
-R14 EQU 14
-R15 EQU 15
- SPACE
- END
-#endif
diff --git a/src/packlib/kernlib/kernbit/obsolete/m416/ubnch1.s b/src/packlib/kernlib/kernbit/obsolete/m416/ubnch1.s
deleted file mode 100644
index eb0e14f..0000000
--- a/src/packlib/kernlib/kernbit/obsolete/m416/ubnch1.s
+++ /dev/null
@@ -1,173 +0,0 @@
-*
-* $Id: ubnch1.s,v 1.1.1.1 1996/02/15 17:47:40 mclareni Exp $
-*
-* $Log: ubnch1.s,v $
-* Revision 1.1.1.1 1996/02/15 17:47:40 mclareni
-* Kernlib
-*
-*
-#if defined(CERNLIB_CDC)
- IDENT UBNCH1
- ENTRY UBNCH1
-* SUBROUTINE UBNCH1 (A,X,NBITS)
-* (WRITTEN FOR SCOPE 3.3 - FTN)
-*
-* X1 B1 LAST TAKE ADR +
-* X2 B2 STORE ADR
-* X3 NBITS REMAINING B3
-* X4 = 60 B4 STOP INNER LOOP
-* X5 A(J) B5 SHIFT COUNTER
-* X6 COMPILE RESULT B6 = 60
-* X7 =-1 B7 =-1
-*
- VFD 36/0HUBNCH1,24/0
- UBNCH1 BSS 1
- SA2 A1+2 .X2=ADDRESS OF NBITS
- MX7 59 .X7=-1
- SB7 X7 .B7=-1
- SA3 X2 .NBITS
- SB6 60
- SB1 X1
- SA2 A1-B7 .X2=ADDRESS OF X
- SB1 B1+X3 .ADR( A(NBITS+1) )
- SA5 X1 .ADR(A)
- SX4 B6
- LOOP1 SB4 X3 .N=NBITS
- MX6 0
- SB5 B0 .SHIFT ZERO FOR FIRST WORD
- GE B6,B4,LOOP2 .N=60 IF NBITS.GT.60
- SB4 B6
- LOOP2 BX1 -X7*X5 .MASK A(J)
- SA5 A5-B7 .A(J+1)
- LX1 B5,X1 .SHIFT MASKED A(J)
- SB5 B5-B7 .BUMP SHIFT COUNTER
- BX6 X6+X1 .COMPILE RESULT
- LT B5,B4,LOOP2
- SA6 X2 .STORE 1 WORD OF RESULTS
- IX3 X3-X4 .NBITS= NBITS - 60
- SB5 A5
- GE B5,B1,UBNCH1
- IX2 X2-X7 .BUMP STORE ADR
- EQ LOOP1
- END
-#endif
-#if defined(CERNLIB_IBM)
- TITLE 'UBNCH1'
-***********************************************************************
-* *
-* U B N C H 1 *
-* =========== *
-* *
-***********************************************************************
-* *
-* REFER TO CERN PROGRAM LIBRARY MEMBER M416 FOR DETAILS. *
-* *
-***********************************************************************
- EJECT
-***********************************************************************
-* *
-* M O D I F I C A T I O N L O G *
-* =============================== *
-* *
-***********************************************************************
-* *
-* 1 . 0 0 *
-* ======= *
-* *
-* ORIGINAL VERSION. *
-* *
-* R. MATTHEWS, CERN/DD, JULY 1982. *
-* *
-***********************************************************************
- EJECT
- EJECT
- PRINT NOGEN
-UBNCH1 CSECT
-#endif
-#if defined(CERNLIB_QMIBMXA)
-UBNCH1 AMODE ANY
-UBNCH1 RMODE ANY
-#endif
-#if defined(CERNLIB_IBM)
- SPACE 2
-* P R O L O G U E
- SPACE
- USING UBNCH1,R15
- B SAVEREGS
- DC AL1(7),CL7'UBNCH1' IDENTIFIER
- DC C'1.00' VERSION.MODIFICATION LEVEL
-SAVEREGS STM R14,R12,12(R13)
- LR R4,R13
- CNOP 0,4
- BAL R13,AROUNDSA
-SAVEAREA DC A(EPILOGUE),17F'0'
- DROP R15
- USING SAVEAREA,R13
-AROUNDSA ST R13,8(0,R4)
- ST R4,4(0,R13)
- XC 8(4,R13),8(R13)
- SPACE 2
-* P R O C E S S
- SPACE
- LM R2,R4,0(R1) R2 -> K; R3 -> A; R4 -> N
- L R4,0(0,R4) R4 := N
- L R8,=F'-4' R8 := -4 FOR LOOP INCREMENT
- AR R2,R8 R2 -> K(0)
- SRDL R4,5 R4 := NUMBER OF FULLWORDS TO PROCESS
- SRL R5,27 R5 := NUMBER OF ADDITIONAL BITS
- LTR R4,R4 ARE THERE ANY FULLWORDS ?
- BNP EXTRABIT NO, BRANCH
- SPACE
-NEXTWORD LR R9,R2 R9 := TEST VALUE FOR LOOPING
- LA R2,32*4(0,R2) R2 -> FIRST SOURCE WORD
- SPACE
-NEXTBIT SLL R6,1 MAKE SPACE FOR THE NEXT BIT
- O R6,0(0,R2) OR IN THE NEXT BIT
- BXH R2,R8,NEXTBIT LOOP TO PROCESS THE NEXT BIT OF THE WORD
- SPACE
- ST R6,0(0,R3) STORE THE ACCUMULATED BITS IN A
- LA R3,4(0,R3) R3 -> NEXT TARGET WORD
- LA R2,32*4(0,R2) R2 -> NEXT SOURCE AREA
- BCT R4,NEXTWORD LOOP TO PROCESS THE NEXT FULLWORD
- SPACE
-EXTRABIT LTR R5,R5 ARE THERE ANY ADDITIONAL BITS ?
- BNP EPILOGUE NO, BRANCH
- LR R9,R2 R9 := TEST VALUE FOR LOOPING
- SLL R5,2 R5 := NUMBER OF SOURCE BYTES
- LA R2,0(R5,R2) R2 -> FIRST SOURCE WORD
- SR R6,R6 R6 := 0
- SPACE
-NEXTBIT1 SLL R6,1 MAKE SPACE FOR THE NEXT BIT
- O R6,0(0,R2) OR IN THE NEXT BIT
- BXH R2,R8,NEXTBIT1 LOOP TO PROCESS THE NEXT BIT
- SPACE
- ST R6,0(0,R3) STORE THE ACCUMULATED BITS IN A
- SPACE 2
-* E P I L O G U E
- SPACE
-EPILOGUE EQU *
- L R13,4(0,R13)
- LM R14,R12,12(R13)
-** MVI 12(R13),X'FF'
- BR R14
- SPACE
- LTORG
-R0 EQU 0
-R1 EQU 1
-R2 EQU 2
-R3 EQU 3
-R4 EQU 4
-R5 EQU 5
-R6 EQU 6
-R7 EQU 7
-R8 EQU 8
-R9 EQU 9
-R10 EQU 10
-R11 EQU 11
-R12 EQU 12
-R13 EQU 13
-R14 EQU 14
-R15 EQU 15
- SPACE
- END
-#endif
diff --git a/src/packlib/kernlib/kernbit/obsolete/m429/numbitcd.s b/src/packlib/kernlib/kernbit/obsolete/m429/numbitcd.s
deleted file mode 100644
index 582205c..0000000
--- a/src/packlib/kernlib/kernbit/obsolete/m429/numbitcd.s
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: numbitcd.s,v 1.1.1.1 1996/02/15 17:47:42 mclareni Exp $
-*
-* $Log: numbitcd.s,v $
-* Revision 1.1.1.1 1996/02/15 17:47:42 mclareni
-* Kernlib
-*
-*
-#if (defined(CERNLIB_CDC))&&(!defined(CERNLIB_FORTRAN))
- IDENT NUMBIT
- ENTRY NUMBIT
-* FUNCTION NUMBIT(I)= SUM OF ONES BITS IN I
- VFD 36/6HNUMBIT,24/NUMBIT
- NUMBIT DATA 0
- SA1 X1
- CX6 X1
- JP NUMBIT
- END
-#endif
diff --git a/src/packlib/kernlib/kernbit/obsolete/m429/numbitcr.F b/src/packlib/kernlib/kernbit/obsolete/m429/numbitcr.F
deleted file mode 100644
index 7606cfb..0000000
--- a/src/packlib/kernlib/kernbit/obsolete/m429/numbitcr.F
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: numbitcr.F,v 1.1.1.1 1996/02/15 17:47:42 mclareni Exp $
-*
-* $Log: numbitcr.F,v $
-* Revision 1.1.1.1 1996/02/15 17:47:42 mclareni
-* Kernlib
-*
-*
-#include "kernbit/pilot.h"
-#if defined(CERNLIB_CRAY)
- FUNCTION NUMBIT(I)
-C-- FUNCTION TO COUNT THE NUMBER OF 1-BITS IN A WORD
-C-- USE THE FTN LIBRARY POPCNT FUNCTION
- NUMBIT= POPCNT(I)
- RETURN
- END
-#endif
diff --git a/src/packlib/kernlib/kernbit/obsolete/m429/numbitib.s b/src/packlib/kernlib/kernbit/obsolete/m429/numbitib.s
deleted file mode 100644
index 03be1c6..0000000
--- a/src/packlib/kernlib/kernbit/obsolete/m429/numbitib.s
+++ /dev/null
@@ -1,35 +0,0 @@
-*
-* $Id: numbitib.s,v 1.1.1.1 1996/02/15 17:47:42 mclareni Exp $
-*
-* $Log: numbitib.s,v $
-* Revision 1.1.1.1 1996/02/15 17:47:42 mclareni
-* Kernlib
-*
-*
-#if (defined(CERNLIB_IBM))&&(!defined(CERNLIB_FORTRAN))
-* FUNCTION NUMBIT(N) COUNTS NUMBER OF ONE-BITS IN ARGUMENT N
-* RESULT IS RETURNED IN REGISTER 0.
-*
-NUMBIT CSECT
-#if defined(CERNLIB_QMIBMXA)
-NUMBIT AMODE ANY
-NUMBIT RMODE ANY
-#endif
- USING NUMBIT,15
- STM 14,12,12(13) SAVE REGISTERS
- L 1,0(0,1) GET ADDRESS OF ARGUMENT
- L 1,0(0,1) GET ARGUMENT ITSELFF
- LA 2,32 INIT SHIFT COUNTER
- SR 3,3 INIT RESULT
-NUMBLP LTR 1,1 SET CONDITION CODE
- BC 8,DONE TEST IF WORD EMPTY
- BNM NUMBSHFT IF SIGN BIT ZERO GO SHIFT
- LA 3,1(0,3) IF ONE COUNT UP IN RESULT
-NUMBSHFT SLL 1,1 SHIFT ONE POSITION LEFT
- BCT 2,NUMBLP GO ROUND TILL THRU
-DONE ST 3,20(0,13) DONE, OVERWRITE OLD REG0
- LM 14,12,12(13) GET REGISTERS BACK
- BR 14 AND RETURN TO CALLER
-*
- END
-#endif
diff --git a/src/packlib/kernlib/kernbit/obsolete/m437/getbitcd.s b/src/packlib/kernlib/kernbit/obsolete/m437/getbitcd.s
deleted file mode 100644
index a62dd19..0000000
--- a/src/packlib/kernlib/kernbit/obsolete/m437/getbitcd.s
+++ /dev/null
@@ -1,46 +0,0 @@
-*
-* $Id: getbitcd.s,v 1.1.1.1 1996/02/15 17:47:43 mclareni Exp $
-*
-* $Log: getbitcd.s,v $
-* Revision 1.1.1.1 1996/02/15 17:47:43 mclareni
-* Kernlib
-*
-*
-#if (defined(CERNLIB_CDC))&&(!defined(CERNLIB_FORTRAN))
- IDENT GETBIT
- ENTRY GETBIT
-* SUBROUTINE GETBIT(N,A,L)
-* GETS L (0 OR 1) FROM BIT N OF WORDSTRING A
-* N.B. BITS ARE NUMBERED 1,2,3... ETC FROM LEFT TO RIGHT
-* AUTHOR H.GROTE CERN/DD VERSION 2 DATE 81/01/31
- VFD 36/6HGETBIT,24/GETBIT
- DUMP DATA 0
- GETBIT DATA 0
- SX6 A0
- SA6 DUMP
- SA5 A1 *N TO X5 (*N MEANS ADDRESS OF N, ETC.
- SX4 74B NO. OF BITS
- SX0 1B
- SA3 A1+1B *A TO X3
- SA2 X5 N TO X2
- PX7 B0,X4
- NX5 B0,X7 FLOAT(60) TO X5
- IX7 X2-X0 N-1 TO X7
- PX2 B0,X7 FLOAT(N-1) TO X2
- FX1 X2/X5 (N-1)/60 (FLOAT) TO X1
- UX5 B2,X1
- LX2 B2,X5 INT. PART TO X2
- IX6 X3+X2 *A(M) TO X6
- DX5 X2*X4 60*INT. PART
- IX7 X7-X5 MOD(N-1,60) TO X7
- SA2 X6 A(M) TO X2, *A(M) TO A2
- SB2 X7+1B LEFT SHIFT TO MAKE BIT RIGHT ADJ.
- LX3 B2,X2 SHIFT A(M) LEFT
- BX6 X0*X3 MASK BIT
- SA2 A1+2B *L TO X2
- SA6 X2 STORE IN L
- SA1 DUMP
- SA0 X1
- JP GETBIT
- END
-#endif
diff --git a/src/packlib/kernlib/kernbit/obsolete/m437/getbitib.s b/src/packlib/kernlib/kernbit/obsolete/m437/getbitib.s
deleted file mode 100644
index 1c6cd05..0000000
--- a/src/packlib/kernlib/kernbit/obsolete/m437/getbitib.s
+++ /dev/null
@@ -1,84 +0,0 @@
-*
-* $Id: getbitib.s,v 1.1.1.1 1996/02/15 17:47:43 mclareni Exp $
-*
-* $Log: getbitib.s,v $
-* Revision 1.1.1.1 1996/02/15 17:47:43 mclareni
-* Kernlib
-*
-*
-#if (defined(CERNLIB_IBM))&&(!defined(CERNLIB_FORTRAN))
- TITLE 'GETBIT/SETBIT - GET OR SET THE VALUE OF A BIT IN AN ARRAY'
-GETBIT CSECT
-#if defined(CERNLIB_QMIBMXA)
-GETBIT AMODE ANY
-GETBIT RMODE ANY
-#endif
-***********************************************************************
-* *
-* CALL GETBIT(I,M,L) GETS THE VALUE OF A SELECTED BIT IN AN ARRAY *
-* CALL SETBIT(I,M,L) SETS THE VALUE OF A SELECTED BIT IN AN ARRAY *
-* *
-* ARGUMENTS: *
-* I - A 4-BYTE INTEGER CONTAINING THE NUMBER OF THE BIT *
-* (STARTING ON THE LEFT WITH 1) *
-* M - AN ARRAY CONTAINING THE BIT *
-* L - A 4-BYTE INTEGER WHOSE RIGHTMOST BIT WILL CONTAIN THE VALUE *
-* FOUND BY GETBIT OR THE VALUE TO BE SET BY SETBIT *
-* *
-***********************************************************************
- SPACE 5
- USING GETBIT,15 ESTABLISH ADDRESSABILITY
- STM 14,12,12(13) SAVE THE REGISTER CONTENTS
- SR 11,11 R11 := 0 TO INDICATE ENTRY AT GETBIT
- LA 15,SETBIT CHANGE TO COMMON BASE ADDRESS
- USING SETBIT,15
- B CONTINUE BRANCH AROUND SETBIT ENTRY POINT
- SPACE 2
- ENTRY SETBIT
-SETBIT EQU *
- STM 14,12,12(13) SAVE THE REGISTER CONTENTS
- LA 11,1 R11 := 1 TO INDICATE ENTRY AT SETBIT
- SPACE 2
-* CALCULATE THE NUMBER OF THE BIT AND BYTE TO BE PROCESSED
- SPACE 1
-CONTINUE EQU *
- LM 2,4,0(1) R2 -> I; R3 -> M; R4 -> L
- L 6,0(0,2) R6 := I
- BCTR 6,0 R6 := I-1 (SO BIT NUMBERING STARTS AT 0)
- SRDL 6,3 R6 := BYTE NUMBER; R7 CONTAINS BIT NUMBER
- AR 3,6 R3 -> BYTE TO BE PROCESSED
- SRL 7,29 R7 := NUMBER OF THE BIT TO BE PROCESSED
- L 5,=X'FF7F0080' R5 := MASKS
- SRL 5,0(7) SHIFT THE MASK TO MATCH THE BIT POSITION
- BCT 11,TESTBIT BRANCH IF ENTRY WAS AT GETBIT
- SPACE 2
-* SET THE BIT ON OR OFF
- SPACE 1
- TM 3(4),X'01' IS IT TO BE SET ON OR OFF ?
- BO SWITCHON BRANCH IF IT IS TO BE SET ON
- SRL 5,16 GET COMPLEMENT OF MASK TO SWITCH BIT OFF
- EX 5,NI EXECUTE NI TO SWITCH THE BIT OFF
- B RETURN BRANCH TO THE RETURN SEQUENCE
- SPACE 1
-SWITCHON EQU *
- EX 5,OI EXECUTE OI TO SWITCH THE BIT ON
- B RETURN BRANCH TO THE RETURN SEQUENCE
- SPACE 2
-* TEST THE BIT
- SPACE 1
-TESTBIT EQU *
- XC 0(4,4),0(4) L := 0
- EX 5,TM TEST THE REQUESTED BIT
- BNO RETURN RETURN IF THE BIT IS OFF
- MVI 3(4),X'01' L := 1
- SPACE 2
-RETURN EQU *
- LM 14,12,12(13) RESTORE THE REGISTER CONTENTS
- BR 14 RETURN TO CALLER
- SPACE 2
-NI NI 0(3),X'00' NI INSTRUCTION TO SET THE BIT OFF
-OI OI 0(3),X'00' OI INSTRUCTION TO SET THE BIT ON
-TM TM 0(3),X'00' TM INSTRUCTION TO TEST THE BIT
- SPACE 2
- END
-#endif
diff --git a/src/packlib/kernlib/kernbit/obsolete/m437/setbitcd.s b/src/packlib/kernlib/kernbit/obsolete/m437/setbitcd.s
deleted file mode 100644
index cada3a8..0000000
--- a/src/packlib/kernlib/kernbit/obsolete/m437/setbitcd.s
+++ /dev/null
@@ -1,53 +0,0 @@
-*
-* $Id: setbitcd.s,v 1.1.1.1 1996/02/15 17:47:43 mclareni Exp $
-*
-* $Log: setbitcd.s,v $
-* Revision 1.1.1.1 1996/02/15 17:47:43 mclareni
-* Kernlib
-*
-*
-#if (defined(CERNLIB_CDC))&&(!defined(CERNLIB_FORTRAN))
- IDENT SETBIT
- ENTRY SETBIT
-* SUBROUTINE SETBIT(N,A,L)
-* PUTS L (0 OR 1) IN BIT N OF WORD STRING A
-* N.B. BITS ARE NUMBERED 1,2,3... ETC FROM LEFT TO RIGHT
-* AUTHOR H.GROTE CERN/DD VERSION 2 DATE 81/01/31
- VFD 36/6HSETBIT,24/SETBIT
- DUMP DATA 0
- SETBIT DATA 0
- SX6 A0
- SA6 DUMP
- SA5 A1 *N TO X5 (*N MEANS ADDRESS OF N, ETC.
- SX4 74B NO. OF BITS
- SX0 1B
- SA3 A1+1B *A TO X3
- SA2 X5 N TO X2
- PX7 B0,X4
- NX5 B0,X7 FLOAT(60) TO X5
- IX7 X2-X0 N-1 TO X7
- PX2 B0,X7 FLOAT(N-1) TO X2
- FX1 X2/X5 (N-1)/60 (FLOAT) TO X1
- UX5 B2,X1
- LX2 B2,X5 INT. PART TO X2
- IX6 X3+X2 *A(M) TO X6
- DX5 X2*X4 60*INT. PART
- IX7 X7-X5 MOD(N-1,60) TO X7
- SA2 X6 A(M) TO X2, *A(M) TO A2
- SB2 X7+1B LEFT SHIFT TO MAKE BIT RIGHT ADJ.
- LX3 B2,X2 SHIFT A(M) LEFT
- SB1 X4 60 TO B1
- SA4 A1+2B *L TO X4
- SA4 X4 L TO X4
- MX7 73B 59 BIT MASK
- BX5 X0*X4 RIGHTMOST BIT OF L
- SB3 B1-B2 RETURN SHIFT
- BX1 X7*X3 59 LEFT BITS OF SHIFTED A(M)
- BX2 X1+X5 OR WITH BIT
- LX6 B3,X2 SHIFT BACK
- SA6 A2 STORE IN A(M)
- SA1 DUMP
- SA0 X1
- JP SETBIT
- END
-#endif
diff --git a/src/packlib/kernlib/kernbit/obsolete/m438/Imakefile b/src/packlib/kernlib/kernbit/obsolete/m438/Imakefile
deleted file mode 100644
index 4dcef08..0000000
--- a/src/packlib/kernlib/kernbit/obsolete/m438/Imakefile
+++ /dev/null
@@ -1,4 +0,0 @@
-SRCS_F= \ @@\
- btmove.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kernbit/obsolete/m438/btmove.F b/src/packlib/kernlib/kernbit/obsolete/m438/btmove.F
deleted file mode 100644
index 419106f..0000000
--- a/src/packlib/kernlib/kernbit/obsolete/m438/btmove.F
+++ /dev/null
@@ -1,52 +0,0 @@
-*
-* $Id: btmove.F,v 1.1.1.1 1996/02/15 17:47:43 mclareni Exp $
-*
-* $Log: btmove.F,v $
-* Revision 1.1.1.1 1996/02/15 17:47:43 mclareni
-* Kernlib
-*
-*
-#include "kernbit/pilot.h"
-#if defined(CERNLIB_CDC)
- SUBROUTINE BTMOVE(IS,ISBIT,IT,ITBIT,NBIT)
-C--- BIT MOVE ROUTINE, CDC VERSION
-C--- AUTHOR H. GROTE / CERN-DD 13.10.80
-C--- ROUTINE MOVES -NBIT- BITS FROM ARRAY IS TO ARRAY IT,
-C--- STARTING AT BITS ISBIT IN IS, AND ITBIT IN IT.
-C--- BITS ARE COUNTED FROM LEFT TO RIGHT, 1 TO INFINITY.
-C--- FOR NBIT LE 0, NO TRANSFER.
- DIMENSION IS(2),IT(2)
-C--- MBIT IS THE NUMBER OF BITS / WORD
- DATA MBIT/ 60 /
- IF(NBIT.LE.0) GOTO 500
-C--- FIRST AND LAST WORD IN ARRAY IS
- KSW1=(ISBIT-1)/MBIT+1
- KSW2=(ISBIT+NBIT-2)/MBIT+1
-C--- FIRST BIT IN IS(KSW1) AND LAST IN IS(KSW2)
- IBS1=ISBIT-MBIT*(KSW1-1)
- IBS2=ISBIT+NBIT-1-MBIT*(KSW2-1)
-C--- FIRST AND LAST WORD IN ARRAY IT
- KTW1=(ITBIT-1)/MBIT+1
- KTW2=(ITBIT+NBIT-2)/MBIT+1
-C--- FIRST BIT IN IT(KTW1), LAST IN IT(KTW2)
- IBT1=ITBIT-MBIT*(KTW1-1)
- IBT2=ITBIT+NBIT-1-MBIT*(KTW2-1)
-C--- NO. OF WORDS TO SHIFT
- NW=MAX(KTW2-KTW1,KSW2-KSW1)+1
-C--- KEEP FIRST AND LAST TWO WORD OF IT
- KEEP1=IT(KTW1)
- KEEP2=IT(KTW2)
-C--- SHIFT IN SOURCE ARRAY
- CALL SHLONG(IS(KSW1),NW,IBS1-IBT1)
-C--- MOVE WORDS INTO IT
- CALL UCOPY(IS(KSW1),IT(KTW1),KTW2+1-KTW1)
-C--- SHIFT BACK
- CALL SHLONG(IS(KSW1),NW,IBT1-IBS1)
-C--- CORRECT FIRST AND LAST (ONE OR TWO) WORDS
- MASK1=MASK(IBT1-1)
- MASK2=MASK(IBT2)
- IT(KTW1)=OR(AND(MASK1,KEEP1),AND(COMPL(MASK1),IT(KTW1)))
- IT(KTW2)=OR(AND(MASK2,IT(KTW2)),AND(COMPL(MASK2),KEEP2))
- 500 RETURN
- END
-#endif
diff --git a/src/packlib/kernlib/kernbit/obsolete/m438/btmoveml.s b/src/packlib/kernlib/kernbit/obsolete/m438/btmoveml.s
deleted file mode 100644
index 0cada32..0000000
--- a/src/packlib/kernlib/kernbit/obsolete/m438/btmoveml.s
+++ /dev/null
@@ -1,133 +0,0 @@
-*
-* $Id: btmoveml.s,v 1.1.1.1 1996/02/15 17:47:43 mclareni Exp $
-*
-* $Log: btmoveml.s,v $
-* Revision 1.1.1.1 1996/02/15 17:47:43 mclareni
-* Kernlib
-*
-*
-#if defined(CERNLIB_IBM)
-BTMOVE CSECT
-#if defined(CERNLIB_QMIBMXA)
-BTMOVE AMODE ANY
-BTMOVE RMODE ANY
-#endif
-* CALL BTMOVE(A,NA,X,NX,NBITS)
-* THIS ROUTINE MOVES A BIT-STRING OF LENGTH NBITS STARTING AT
-* BIT NA OF ARRAY A TO POSITION STARTING AT BIT NX OF ARRAY X.
-* BITS ARE COUNTED LEFT TO RIGHT ACROSS WORD BOUNDARY,START. WITH 1
- USING *,15
- B BEGIN
- DC X'6'
- DC CL6'BTMOVE'
-BEGIN STM 0,10,24(13)
- LM 1,5,0(1) R1-R5=ADDRESSES OF THE ARG. OF ROUTINE
-* FIND THE ADDRESS OF THE FIRST BYTE OF ARRAY A TO BE MOVED.
- SR 0,0
- SR 7,7
- L 6,0(2) R6=LA
- SRDL 6,3(0) R6/8
- SRL 7,29(0) REST OF DIV.
- CR 7,0
- BH LANOT0
- L 7,NBYTE
- S 1,ONE
-LANOT0 AR 1,6 R1=ADDRESS OF FIRST BYTE OF A TO BE MOVED.
- LR 2,7 R2= 1ST BIT OF BYTE TO BE MOVED.
-* FIND THE ADDRESS OF THE FIRST BYTE OF ARRAY X TO BE CHANGED
- SR 7,7
- L 6,0(4)
- SRDL 6,3(0)
- SRL 7,29(0)
- CR 7,0
- BH LXNOT0
- L 7,NBYTE
- S 3,ONE
-LXNOT0 AR 3,6
- LR 4,7
-*
- L 8,WORD
- SR 8,2
- L 9,WORD
- SR 9,4
- L 6,0(5) R6= NBER OF BITS TO TRANSFER FROM A TO X
- CR 6,0
- BNH FIN
-* BRANCHING IF THE NBITS TO TRANSFER IS BIGGER THAN 32
- L 10,WORD
- SR 10,6
- BM NBERW
-* THE NBITS TO BE MOVED ARE LESS THAN 32.
- LR 0,6
- L 5,0(3)
- B LASTB
-*
-* FIND THE NBER OF WORDS TO BE MOVED FROM A TO X.
-NBERW SR 7,7
- SRDL 6,5(0) R6/32
- SRL 7,27(0) REST OF THE DIV.
- LR 0,7 R0=NBER OF BITS TO BE MOVED (NBITS<32)
- LR 10,6 R10=NBER OF WORDS OF 32 BITS TO BE MOVED
- L 5,0(3) R5=1ST WORD X TO BE CHANGED.
-*
-* COPIES ONE WORD AT A TIME
-LOOP L 6,0(1)
- L 7,4(1)
- SRDL 6,1(8)
- LR 6,5
- SRL 6,1(9)
- SLDL 6,1(9)
- ST 6,0(3)
- LR 5,7
- LA 3,4(3)
- LA 1,4(1)
- BCT 10,LOOP
-*
-LASTB LR 10,4
- AR 10,0
- S 10,ONE
- BNP FIN
-* THE 'NBITS' OF THE STRING TO BE MOVED ARE LESS THAN 32
- L 6,0(1)
- L 7,4(1)
- SRDL 6,1(8)
- L 10,WORD
- SR 10,0
- SRL 7,0(10)
- SLL 7,0(10)
- LR 6,5
- SRL 6,1(9)
- SLDL 6,1(9)
- AR 0,4
- S 0,ONE
- S 0,WORD
- BM MINUS
-* THE NBITS ARE TO BE MOVED IN TWO CONSEC. WORDS OF ARRAY X
- ST 6,0(3)
- SR 6,6
- CR 0,6
- BE FIN
- LA 3,4(3)
- LR 10,0
- SLDL 6,0(10)
- L 5,WORD
- SR 5,10
- B EQUAL
-* THE NBITS ARE TO BE MOVED IN ONE WORD OF ARRAY X
-MINUS A 0,WORD
- L 5,WORD
- SR 5,0
- SRL 6,0(5)
- LR 10,0
-EQUAL L 7,0(3)
- SLL 7,0(10)
- SLDL 6,0(5)
- ST 6,0(3)
-FIN LM 0,10,24(13)
-** MVI 12(13),X'FF'
- BCR 15,14
-NBYTE DC F'8'
-WORD DC F'32'
-ONE DC F'1'
- END
-#endif
diff --git a/src/packlib/kernlib/kernbit/obsolete/m438/shlong.s b/src/packlib/kernlib/kernbit/obsolete/m438/shlong.s
deleted file mode 100644
index 4fe254b..0000000
--- a/src/packlib/kernlib/kernbit/obsolete/m438/shlong.s
+++ /dev/null
@@ -1,82 +0,0 @@
-*
-* $Id: shlong.s,v 1.1.1.1 1996/02/15 17:47:43 mclareni Exp $
-*
-* $Log: shlong.s,v $
-* Revision 1.1.1.1 1996/02/15 17:47:43 mclareni
-* Kernlib
-*
-*
-#if defined(CERNLIB_CDC)
- IDENT SHLONG
- ENTRY SHLONG
-* SUBROUTINE SHLONG(IA,NW,NBIT)
-* PERFORMS A LONG LEFT SHIFT (NBIT GT 0) OR RIGHT SHIFT
-* ( NB LT 0 ) CIRCULAR ON IA(1)...IA(NW)
-*
- TRACE VFD 42/0LSHLONG,18/SHLONG
- SHA0 DATA 0
- SHLONG JP 400000B+*
- SX6 A0
- SA0 A1
- SA6 SHA0 SAVE A0
- SB1 1
- SA2 A0+1 ADDRESS OF NW TO X2
- SB2 59
- SA3 A0+2 ADDRESS OF NBIT TO X3
- SA2 X2 NW TO X2
- SA3 X3 NBIT TO X3
- SB3 X2-1 NW-1 TO B3
- LT B3,B0,RETURN RETURN IF NW LE 0
- SB4 X3 NBIT TO B4
- SB5 B4
- GE B4,B0,CONT1 JUMP IF B4 GE 0
- SB5 B0-B4 ABS(NBIT) TO B5
- CONT1 EQ B5,B0,RETURN RETURN IF NBIT EQ 0
- GT B5,B2,RETURN RETURN IF NBIT GE 60
- GE B4,B0,POSIT JUMP IF NBIT GT 0
-* RIGHT CIRCULAR SHIFT
- SB4 B4+B2 NO. OF MASK BITS -1
- MX7 1
- AX0 B4,X7 MASK1 TO X0
- SB4 B4+B1 SHIFT COUNT IN BITS
- SA1 A0 ADDRESS OF IA(1) TO X1
- SA4 X1+B3 KEEP LAST WORD IN X4
- SB6 X1 ADDRESS IA(1)
- SB7 A4 ADDRESS IA(NW)
- NLOOP LT B7,B6,RETURN END LOOP
- SA2 B7 ADDR.(IA(I2)) TO A2, IA(I2) TO X2
- SB7 B7-B1 ADDR.(IA(I1))
- BX3 X4 LAST WORD IF AT END OF LOOP
- LT B7,B6,NLOOP1
- SA3 B7 REPLACE LAST WORD BY IA(I1) IN X3
- NLOOP1 BX5 X0*X2 AND(MASK1,IA(I2))
- BX6 -X0*X3 AND(MASK2,IA(I1))
- BX7 X5+X6 OR
- LX6 B4,X7 LEFT SHIFT
- SA6 A2 STORE IN IA(I2)
- EQ NLOOP LOOP
-* LEFT SHIFT
- POSIT SB5 B4-B1
- MX7 1
- AX0 B5,X7 MASK1 TO X0
- SA1 A0 ADDR.(IA(1)) TO X1
- SA4 X1 KEEP FIRST WORD IN X4
- SB6 X1 ADDR. IA(1)
- SB7 X1+B3 ADDR. IA(NW)
- PLOOP GT B6,B7,RETURN
- SA2 B6 ADDR.(IA(I2)) TO A2, IA(I2) TO X2
- SB6 B6+B1 ADDR(IA(I1))
- BX3 X4 TAKE LAST WORD AT END OF LOOP
- GT B6,B7,PLOOP1
- SA3 B6 IA(I1) TO X3
- PLOOP1 BX5 -X0*X2 AND(MASK2,IA(I2))
- BX6 X0*X3 AND(MASK1,IA(I1))
- BX7 X5+X6 OR
- LX6 B4,X7 LEFT SHIFT
- SA6 A2 STORE IN IA(I2)
- EQ PLOOP
- RETURN SA1 SHA0
- SA0 X1 RESTORE A0
- EQ SHLONG RETURN
- END
-#endif
diff --git a/src/packlib/kernlib/kernbit/obsolete/m439/getbytml.s b/src/packlib/kernlib/kernbit/obsolete/m439/getbytml.s
deleted file mode 100644
index 4051d32..0000000
--- a/src/packlib/kernlib/kernbit/obsolete/m439/getbytml.s
+++ /dev/null
@@ -1,343 +0,0 @@
-*
-* $Id: getbytml.s,v 1.1.1.1 1996/02/15 17:47:43 mclareni Exp $
-*
-* $Log: getbytml.s,v $
-* Revision 1.1.1.1 1996/02/15 17:47:43 mclareni
-* Kernlib
-*
-*
-#if (defined(CERNLIB_IBM)||defined(CERNLIB_CDC))&&(!defined(CERNLIB_FORTRAN))
-#if defined(CERNLIB_CDC)
- IDENT GETBYT
- ENTRY GETBYT
- EXT SHRERR
-*CALLING
-* CALL GETBYT(ADDR,NBEG,LBIT,IRES)
-GETBYT BSS 1
- SA2 A1+1
- SA2 X2 .X2=NBEG
- SA4 MAX .X4=MAX=140,737,488,355,327=2**47-1
- IX4 X4-X2
- NG X4,ZERO .IF NBEG > MAX GO TO ZERO
- SA4 =1 .X4=1
- IX2 X2-X4 .NBEG=NBEG-1
- NG X2,ZERO .IF NBEG<1 GO TO ZERO
-*
- SA3 A1+2
- SA3 X3 .X3=LBIT
- SB3 X3 ,B3=LBIT
- PL X3,INST .IF LBIT > 0 GO TO INST
-***************************************************
-*
-* ERROR HANDLING
-*
-*
-ZERO SA2 A1+1
- SA3 A1+2
- LX6 X3
- LX7 X2
- SA7 ANBEG
- SA6 ALBIT
- SA1 ANBEG
- RJ SHRERR
- ZR RET
-ANBEG BSS 1
-ALBIT BSS 1
-*
-****************************************************
-*
-INST SA4 =60 .X4=60
- SB6 X4 .B6=60
- IX4 X4-X3 .
- NG X4,ZERO .IF LBIT > 60 GO TO ZERO
-*
-* WE MUST COMPUTE VALUE (NBEG/60) IN ORDER TO
-* OBTAIN ADDRESS MODIFICATOR.
-*
- LX3 X2 .X3=NBEG
- SX4 B6 .X4=60
- PX3 B0,X3 PACK NBEG
- PX4 B0,X4 PACK 60
- NX4 X4 NORMALIZE 60
- NX3 X3 NORMALIZE NBEG
- FX3 X3/X4 X3=NBEG/60
- UX0 B1,X3 UNPACK RESULT
- LX3 B1,X0 .TAKE INTEGER PART
-*
-* X3 CONTAINS MODIFICATOR OF BEGIN ADDRESS
-*
- IX7 X1+X3
-*
- SX4 B6 .X4=60
- IX3 X3*X4
- IX5 X2-X3 .X5=R(NBEG/60)
-*
-* NOW X5 CONTAINS BIT NUMBER IN WORD
-*
- SB5 X5 .B5=X5
- SA4 MASK+B5 .X4=MASK TO BE NEEDED
- SA2 X7 .X2=ADDR
- BX2 X2*X4 .X2=X2 .AND. X4
-*
-* COMPUTATION OF SHIFT PARAMETER
-*
- SB4 B6-B3 .B4=60-LBIT
- SB4 B4-B5 .B4=60-LBIT-R(NBEG/60)
- ZR B4,RET .GO OUT IF SHIFT=0
- GT B4,RIGHT .IF B4>0 GO TO RIGHT
-*
-* LEFT SHIFT
-*
- SB4 -B4 .CHANGE SIGN
- LX2 B4 .SHIFT <--- BY B4
- SA3 A2+1 .READ NEXT WORD
- SB5 B4-B6 .B5=60-SHIFT PARAMETER
- LX3 B5 .SHIFT ---> BY B5
- SB5 -B5
- SA4 B5+MASK
- BX3 X3*X4
- BX2 X3+X2 . LOGICAL OR
- ZR RET .GO OUT
-*
-*
-*
-RIGHT SB4 -B4
- LX2 B4 .SHIFT X2 ---> BY B4
- SB4 -B4
- SA4 B4+MASK
- BX2 X2*X4
- ZR RET .GO OUT
-*
-*
-RET LX6 X2 .X6=X2
- SA5 A1+3 .A5=ADDRESS OF RESULT ADDRESS
- SA6 X5 .STORE THE RESULT
- ZR GETBYT .RETURN TO CALLER
-MASK DATA 77777777777777777777B
- DATA 37777777777777777777B
- DATA 17777777777777777777B
- DATA 07777777777777777777B
- DATA 03777777777777777777B
- DATA 01777777777777777777B
- DATA 00777777777777777777B
- DATA 00377777777777777777B
- DATA 00177777777777777777B
- DATA 00077777777777777777B
- DATA 00037777777777777777B
- DATA 00017777777777777777B
- DATA 00007777777777777777B
- DATA 00003777777777777777B
- DATA 00001777777777777777B
- DATA 00000777777777777777B
- DATA 00000377777777777777B
- DATA 00000177777777777777B
- DATA 00000077777777777777B
- DATA 00000037777777777777B
- DATA 00000017777777777777B
- DATA 00000007777777777777B
- DATA 00000003777777777777B
- DATA 00000001777777777777B
- DATA 00000000777777777777B
- DATA 00000000377777777777B
- DATA 00000000177777777777B
- DATA 00000000077777777777B
- DATA 00000000037777777777B
- DATA 00000000017777777777B
- DATA 00000000007777777777B
- DATA 00000000003777777777B
- DATA 00000000001777777777B
- DATA 00000000000777777777B
- DATA 00000000000377777777B
- DATA 00000000000177777777B
- DATA 00000000000077777777B
- DATA 00000000000037777777B
- DATA 00000000000017777777B
- DATA 00000000000007777777B
- DATA 00000000000003777777B
- DATA 00000000000001777777B
- DATA 00000000000000777777B
- DATA 00000000000000377777B
- DATA 00000000000000177777B
- DATA 00000000000000077777B
- DATA 00000000000000037777B
- DATA 00000000000000017777B
- DATA 00000000000000007777B
- DATA 00000000000000003777B
- DATA 00000000000000001777B
- DATA 00000000000000000777B
- DATA 00000000000000000377B
- DATA 00000000000000000177B
- DATA 00000000000000000077B
- DATA 00000000000000000037B
- DATA 00000000000000000017B
- DATA 00000000000000000007B
- DATA 00000000000000000003B
- DATA 00000000000000000001B
- DATA 00000000000000000000B
-*
-MAX DATA 00003777777777777777B
-*
- END
-#endif
-#if defined(CERNLIB_IBM)
-GETBYT CSECT
-#endif
-#if defined(CERNLIB_QMIBMXA)
-GETBYT AMODE ANY
-GETBYT RMODE ANY
-#endif
-#if defined(CERNLIB_IBM)
-* CALL GETBYT(ADR,NBEG,LBIT,IRES)
-* ADR - ADDRESS OF BIT STRING
-* NBEG - NUMBER OF BEGIN BIT IN ADR
-* LBIT - LENGTH IN BITS
-* IRES _ RESULT
-***********************************
-* LBIT <= 32 AND LBIT > 0
-* BY A.E. SHEVEL 3/4-79
-*
- SAVE (14,12),,*
- BALR 9,0
- USING *,9
- LR 2,13
- LA 13,DSA##1 R13=DSA ADDRESS
- ST 13,8(2)
- ST 2,4(13)
- B Y##1
-DSA##1 DC 25F'0' SAVE AREA
- CNOP 0,4
-Y##1 EQU *
-***********************************
-*
- LM 2,5,0(1) LOAD PARAMETER ADDRESSES
- XR 0,0 R0=0
- L 6,0(3) R6=NBEG
- LTR 6,6 NBEG=<0?
- BNH ERRZ YES
- SL 6,=F'1' R6=R6-1
-*
-CONT EQU *
- L 7,0(4) R7=LBIT
- LTR 7,7 LBIT=<0?
- BNH ERRZ YES
- C 7,=F'32' R7 > 32?
- BNH ARON NO
- B ERRZ GO TO ERROR MESSAGE
-ARON EQU *
- CLR 7,0 R7=0?
- BNZ SHON NO
- LA 7,1 R7=1
-SHON EQU *
- LR 1,5 R1=R5
-*
-****************************************
-*
-* AT THIS POINT ALLOCATION OF DATA IS THE FOLLOWING:
-* R1 HAS ADDRESS OF RESULT
-* R2 HAS ADDRESS OF SOURCE BIT STRING
-* R4 HAS THE RESULT
-* R6 HAS (NBIT-1)
-* R7 HAS LBIT
-*
-****************************************
-*
- LR 3,6 R3=R6
- SRL 3,3 R3=R3/8
-* AT R3 WE OBTAINED A NUMBER OF BYTES
- N 6,MASK R6=A NUMBER OF BIT IN BYTE
- ALR 2,3
- MVC WRK,0(2) WRK=SOURCE FIELD
- L 4,WRK R4=WRK
- LR 5,6
- SLL 5,2 R5=R5*4
- N 4,M1(5)
-*
-*
- L 0,=F'32' R0=32
- SLR 0,7 R0=R0-R7
- SLR 0,6 R0=R0-R6
- LTR 0,0
- BH RSHIFT
- BZ RET GO OUT
-*
-*
-* LEFT SHIFT
-*
-LSHIFT LPR 0,0 R0=ABS(R0)
- ST 0,INCR STORE SHIFT PARAM.
- LR 8,0 R8=R0
- SLL 4,0(8) SHIFT <--- BY R8
-*
-* INCLUDE THE REST BITS
-*
- LR 8,7 R8=R7
- SRL 8,3 R8=R8/8 NUMBER OF BYTES
- ALR 2,8 R2=R2+R8
- XR 0,0 R0=0
- IC 0,0(2) R0=LAST BYTE
- N 7,MASK NUMBER OF BITS
-*
-* COMPUTE SHIFT PARAMETER
-*
- SL 7,=F'8' R7=R7-8
- LPR 7,7 R7=ABS(R7)
- SL 7,INCR R7=R7-PREV. SHIFT PARAM.
- SRL 0,0(7) SHIFT ---> BY R7
- OR 4,0
- B RET GO OUT
-*
-*
-*
-RSHIFT LR 8,0 R8=R0
- SRL 4,0(8) SHIFT --> BY R8
- B RET GO OUT
-*
-***********************************
-*
-* DIAGNOSTICS
-*
-ERRZ LM 2,5,0(1)
- ST 3,IB
- ST 4,JB
- LA 1,PERR R1=ADDRESS OF PARAMETER LIST
- CALL SHRERR
- B RET
-PERR DS 0F
-IB DS A
-JB DS A
-***********************************
-*
-RET ST 4,0(1) STORE RESULT
- L 13,DSA##1+4
- RETURN (14,12)
-*
-* END OF PROGRAM TEXT
-*
-*****************************************************
-*
-* CONSTANTS AND VARIABLES AREA
-*
-MASK DC F'7' CONSTANT FOR LOG 'AND'
-WRK DC F'0' WORK VARIABLE
-INCR DS F
-M1 DS 0F
- DC XL1'FF' 11111111
- DC 3X'FF'
- DC FL1'127' 1111111
- DC 3X'FF'
- DC FL1'63' 111111
- DC 3X'FF'
- DC FL1'31' 11111
- DC 3X'FF'
- DC FL1'15' 1111
- DC 3X'FF'
- DC FL1'7' 111
- DC 3X'FF'
- DC FL1'3' 11
- DC 3X'FF'
- DC FL1'1' 1
- DC 3X'FF'
- DC 4X'00' 0
- END
-#endif
-#endif
diff --git a/src/packlib/kernlib/kernbit/obsolete/m439/setbytml.s b/src/packlib/kernlib/kernbit/obsolete/m439/setbytml.s
deleted file mode 100644
index 45eb333..0000000
--- a/src/packlib/kernlib/kernbit/obsolete/m439/setbytml.s
+++ /dev/null
@@ -1,335 +0,0 @@
-*
-* $Id: setbytml.s,v 1.1.1.1 1996/02/15 17:47:44 mclareni Exp $
-*
-* $Log: setbytml.s,v $
-* Revision 1.1.1.1 1996/02/15 17:47:44 mclareni
-* Kernlib
-*
-*
-#if (defined(CERNLIB_IBM)||defined(CERNLIB_CDC))&&(!defined(CERNLIB_FORTRAN))
-#if defined(CERNLIB_CDC)
- IDENT SETBYT
- ENTRY SETBYT
- EXT SHSERR
-*
-* CALL SETBYT(ADDR,IBEG,ILEN,IRES)
-*
-* REVISED OCT 28 1980 BY T LINDELOF
-SETBYT BSS 1
- SA2 A1+1
- SA2 X2 .A2=IBEG ADDRESS
- SA4 MAX .X4=MAX=2**47-1
- IX4 X4-X2
- NG X4,ZERO .IF IBEG > MAX ERROR EXIT
- SA4 =1 .X4=1
- IX2 X2-X4 .X2=IBEG-1
- NG X2,ZERO .IF IBEG < 1 ERROR EXIT
-*
-* B-REGISTER ALLOCATION
-* B3-ILEN
-* B4-SHIFT PARAMETER
-* B5-MOD(IBEG-1,60)
-* B6-60
-* B7-TEMP
-*
- SA3 A1+2 .A3=ADDRESS OF ILEN ADDRESS
- SA3 X3 .X3=ILEN
- SB3 X3 .B3=ILEN
- PL X3,INST .IF ILEN < 1 ERROR EXIT
-*
-***************************************************
-*
-* ERROR HANDLING
-*
-ZERO SA2 A1+1
- SA3 A1+2
- LX6 X3
- LX7 X2
- SA7 AIBEG
- SA6 AILEN
- SA1 AIBEG
- RJ SHSERR
- ZR SETBYT
-AIBEG BSS 1
-AILEN BSS 1
-*
-****************************************************
-*
-INST SA4 =60 .X4=60
- SB6 X4 .B6=60
- IX4 X4-X3 .X4=60-ILEN
- NG X4,ZERO .IF ILEN > 60 ERROR EXIT
-*
-* OBTAIN ADDRESS MODIFICATOR
-*
- LX3 X2 .X3=X2=IBEG-1
- SX4 B6 .X4=60
- PX3 B0,X3 .PACK IBEG
- PX4 B0,X4 .PACK 60
- NX4 X4 .NORMALIZE 60
- NX3 X3 .NORMALIZE IBEG
- FX3 X3/X4 .X3=(IBEG-1)/60
- UX0 B1,X3 .UNPACK RESULT
- LX3 B1,X0 .TAKE INTEGER PART
-*
-* X3 CONTAINS MODIFICATOR OF BEGIN ADDRESS
-*
- IX7 X1+X3 .X7=ADDRESS OF FIRST TARGET WORD
- SX4 B6 .X4=60
- IX3 X3*X4
- SX5 X2 .X5=IBEG-1
- IX5 X5-X3
- SB5 X5 .X5=B5=MOD(IBEG-1,60)
-*
-* NOW X5+1 POINTS TO FIRST BIT TO BE SET
-*
- SB7 B5+B3
- SB7 B6-B7
- SX3 B7 .-X3=#BITS AFFECTED IN TARGET WD 2
-*
-* LEFT BITS OF IRES MUST BE CLEARED
-*
- SA2 A1+3 .X2=ADDRESS OF IRES
- SA2 X2 .X2=IRES
- SB7 B3-1 .B7=ILEN-1
- MX4 1
- AX4 B7
- LX4 B3 .X4=ILEN 1-BITS RIGHT-ADJUSTED
- BX2 X2*X4 .X2=ILEN BITS OF DATA, RIGHT-ADJUSTED
-*
-* COMPUTATION OF SHIFT PARAMETER
-*
-* AT THIS POINT REGISTERS CONTAIN THE FOLLOWING DATA
-* X2 THE ILEN RIGHT-MOST BITS OF IRES
-* X3 NEGATIVE IF TWO TARGET WORDS WILL BE AFFECTED
-* X4 ILEN 1-BITS, RIGHT-ADJUSTED
-* B3 ILEN
-* B5 MOD(IBEG-1,60)
-* B6 60
-*
- SB4 B6-B3
- SB4 B4-B5
- GE B4,POS
- SB4 B4+B6
-* .B4=MOD(120-ILEN-MOD(IBEG-1,60),60)
- POS LX2 B4
- LX4 B4
-*
-* X2 (DATA) AND X4 (MASK) NOW SHIFTED TO CORRECT POSITION
-* BUT (IF X3>0) END-AROUND SO THAT RIGHT-MOST BITS GO TO (X7) AND
-* LEFT-MOST BITS TO (X7+1)
-*
-* STORE THE FIRST PART OF DATA
-*
- BX5 X2
- BX6 -X4
- PL X3,ONE
- BX1 -X3
- SB7 X1-1
- MX1 1
- AX1 B7
- BX5 -X1*X5 .CLEAR LEFT-MOST BITS OF DATA
- BX6 X1+X6 .AND OF THE INVERTED MASK
- ONE SA1 X7 .X1=TARGET WORD 1
- BX6 X1*X6 .CLEAR BITS TO BE SET
- BX6 X5+X6 .X6=OR BETWEEN TARGET AND DATA
- SA6 A1 .STORE RESULT
-*
-* STORE THE SECOND PART OF DATA
-*
- PL X3,GOUT
- MX6 1
- AX6 B7
- BX5 X2*X6
- SA1 X7+1 .X1=TARGET WORD 2
- BX6 -X6*X1 .CLEAR BITS TO BE SET
- BX6 X5+X6 .X6=OR BETWEEN TARGET AND DATA
- SA6 A1 .STORE SECOND WORD
-*
-GOUT ZR SETBYT .RETURN TO CALLER
-*
-MAX DATA 00003777777777777777B
-*
- END
-#endif
-#if defined(CERNLIB_IBM)
- TITLE 'SETBYT'
-***********************************************************************
-* *
-* S E T B Y T *
-* =========== *
-* *
-* FUNCTION: A USER-SUPPLIED BIT-STRING IS COPIED TO A SPECIFIED *
-* LOCATION IN AN ARRAY *
-* *
-* CALLING SEQUENCE: CALL SETBYT(ARRAY,LOCATN,NBITS,STRING) *
-* *
-* ARGUMENTS: ARRAY - THE TARGET ARRAY INTO WHICH THE BIT-STRING *
-* IS TO BE COPIED. THIS MAY BE OF ANY TYPE *
-* AND LENGTH CONSISTENT WITH THE LENGTH OF THE*
-* BIT-STRING AND THE LOCATION TO WHICH IT IS *
-* TO BE COPIED. *
-* LOCATN - A 4-BYTE INTEGER CONSTANT OR INTEGER *
-* VARIABLE WHICH SPECIFIES THE LOCATION TO *
-* WHICH THE BIT-STRING IS TO BE COPIED IN *
-* THE TARGET ARRAY. BITS IN THE TARGET ARRAY *
-* ARE NUMBERED FROM THE LEFT STARTING WITH *
-* BIT 1 AND THE NUMBERING CONTINUES ACROSS *
-* ARRAY ELEMENT BOUNDARIES. THE BIT-STRING *
-* IS COPIED SO THAT ITS LEFT-MOST BIT *
-* OCCUPIES THE BIT LOCATION SPECIFIED BY *
-* LOCATN AND MAY SPAN ELEMENTS OF THE TARGET *
-* ARRAY. *
-* NBITS - A 4-BYTE INTEGER CONSTANT OR INTEGER *
-* VARIABLE WHICH SPECIFIES THE NUMBER OF *
-* BITS IN THE BIT STRING. IT MAY HAVE ANY *
-* VALUE IN THE RANGE 1-32. *
-* BITS - A 4-BYTE AREA CONTAINING THE BIT STRING *
-* WHICH IS TO BE COPIED. THE RIGHT-MOST *
-* NBITS BITS ARE COPIED FROM THIS AREA INTO *
-* THE TARGET ARRAY. *
-* *
-***********************************************************************
- EJECT
-***********************************************************************
-* *
-* M O D I F I C A T I O N L O G *
-* =============================== *
-* *
-***********************************************************************
-* *
-* 2 . 0 0 *
-* ======= *
-* *
-* NEW VERSION. *
-* *
-* R.MATTHEWS, NOVEMBER 1979. *
-* *
-***********************************************************************
- EJECT
- EJECT
- PRINT NOGEN
-SETBYT CSECT
-#endif
-#if defined(CERNLIB_QMIBMXA)
-SETBYT AMODE ANY
-SETBYT RMODE ANY
-#endif
-#if defined(CERNLIB_IBM)
- SPACE 2
-* P R O L O G U E
- SPACE
- USING SETBYT,R15
- B SAVEREGS
- DC AL1(7),CL7'SETBYT' IDENTIFIER
- DC C'2.00' VERSION.MODIFICATION LEVEL
-SAVEREGS STM R14,R12,12(R13)
- LR R4,R13
- CNOP 0,4
- BAL R13,AROUNDSA
-SAVEAREA DC A(EPILOGUE),17F'0'
- DROP R15
- USING SAVEAREA,R13
-AROUNDSA ST R13,8(0,R4)
- ST R4,4(0,R13)
- XC 8(4,R13),8(R13)
- SPACE
- LR R11,R1 R11 -> ARGUMENT LIST
- SPACE
- LM R2,R5,0(R1) R2 -> ARRAY; R3 -> LOCATN;
-* R4 -> NBITS; R5 -> STRING
- SPACE 2
-* T E S T T H E V A L U E S O F L O C A T N A N D N B I T S
- SPACE
- L R4,0(0,R4) R4 := NBITS
- LTR R4,R4 IS NBITS .GT.0 ?
- BNP ERROR1 NO, BRANCH
- C R4,=F'32' IS NBITS .GT. 32 ?
- BH ERROR1 YES, BRANCH
- SPACE
- L R6,0(0,R3) R6 := LOCATN
- LTR R6,R6 IS LOCATN .GT. 0 ?
- BNP ERROR1 NO, BRANCH
- SPACE 2
-* F I N D T A R G E T B Y T E & B I T A N D T H E S P A N
- SPACE
- BCTR R6,0 R6 := LOCATN-1 (I.E. BIT ZERO IS ORIGIN)
- SRDL R6,3 R6 := BYTE LOCATION
- SRL R7,29 R7 := BIT LOCATION
- AR R2,R6 R2 -> TARGET BYTE IN ARRAY
- LR R3,R7 R3 := BIT LOCATION IN TARGET BYTE
- SPACE
- LA R8,0(R3,R4)
- BCTR R8,0
- SRL R8,3 R8 := NUMBER OF BYTES FOR AND & OR OPS.
- SPACE 2
-* P U T Z E R O S I N T A R G E T A R E A O F A R R A Y
- SPACE
- L R6,ONEBITS R6 := 11111111111111111111111111111111
- SR R7,R7 R7 := 00000000000000000000000000000000
- SRDL R6,0(R4) SHIFT NBITS INTO R7
- SLDL R6,32 SHIFT THEM TO THE TOP OF R6; R7 := 0
- SRDL R6,0(R3) SHIFT THEM TO THE TARGET BIT LOCATION
- STM R6,R7,DOUBLE STORE THEM
- MVC MASK,ONEBITS MASK := X'FFFFFFFFFFFFFFFF'
- XC MASK,DOUBLE MASK HAS 0'S IN TARGET AREA, 1'S ELSEWHERE
- EX R8,NC1 AND THE MASK WITH THE TARGET ARRAY
- SPACE 2
-* P U T B I T S T R I N G I N T H E T A R G E T A R E A
- SPACE
- MVC DOUBLE(4),0(R5) MOVE USER'S BIT-STRING INTO FULLWORD
- L R6,DOUBLE R6 := USER'S BIT STRING
- SR R7,R7 R7 := 00000000000000000000000000000000
- SRDL R6,0(R4) SHIFT REQUIRED BITS INTO R7
- SLDL R6,32 SHIFT THEM TO THE TOP OF R6; R7 := 0
- SRDL R6,0(R3) SHIFT THEM TO THE TARGET BIT LOCATION
- STM R6,R7,MASK STORE THEM
- EX R8,OC1 OR THEM WITH THE TARGET ARRAY
- B EPILOGUE
- SPACE 2
-NC1 NC 0(0,R2),MASK AND MASK WITH THE TARGET AREA OF ARRAY
- SPACE 2
-OC1 OC 0(0,R2),MASK OR MASK WITH THE TARGET AREA OF ARRAY
- EJECT
-* E R R O R C O N D I T I O N S
- SPACE
-ERROR1 EQU *
- LM R2,R3,4(R1) R2 -> LOCATN; R3 -> NBITS
- CALL SHSERR,((R2),(R3)),VL
- B EPILOGUE
- EJECT
-* E P I L O G U E
- SPACE
-EPILOGUE EQU *
- L R13,4(0,R13)
- LM R14,R12,12(R13)
-** OI 12(R13),X'FF'
- BR R14
- EJECT
-* D A T A A R E A S
- SPACE
-DOUBLE DS D
-MASK DS D
-ONEBITS DC X'FFFFFFFFFFFFFFFF'
- SPACE 2
- LTORG
-R0 EQU 0
-R1 EQU 1
-R2 EQU 2
-R3 EQU 3
-R4 EQU 4
-R5 EQU 5
-R6 EQU 6
-R7 EQU 7
-R8 EQU 8
-R9 EQU 9
-R10 EQU 10
-R11 EQU 11
-R12 EQU 12
-R13 EQU 13
-R14 EQU 14
-R15 EQU 15
- SPACE 2
- END
-#endif
-#endif
diff --git a/src/packlib/kernlib/kernbit/obsolete/m439/shrerr.F b/src/packlib/kernlib/kernbit/obsolete/m439/shrerr.F
deleted file mode 100644
index 27c7152..0000000
--- a/src/packlib/kernlib/kernbit/obsolete/m439/shrerr.F
+++ /dev/null
@@ -1,42 +0,0 @@
-*
-* $Id: shrerr.F,v 1.1.1.1 1996/02/15 17:47:44 mclareni Exp $
-*
-* $Log: shrerr.F,v $
-* Revision 1.1.1.1 1996/02/15 17:47:44 mclareni
-* Kernlib
-*
-*
-#include "kernbit/pilot.h"
-#if (defined(CERNLIB_IBM)||defined(CERNLIB_CDC))&&(!defined(CERNLIB_FORTRAN))
- SUBROUTINE SHRERR(NBEG,LBIT)
- DIMENSION IC(2)
- DATA IC/1HG,1HS/
- DATA NOM/20/,INOM/0/
-#if defined(CERNLIB_IBM)
- DATA NBPW/32/
-#endif
-#if defined(CERNLIB_CDC)
- DATA NBPW/60/
-#endif
- I=1
- GO TO 201
-#if (defined(CERNLIB_CDC))&&(defined(CERNLIB_F4))
- ENTRY SHSERR
-#endif
-#if defined(CERNLIB_IBM)||!defined(CERNLIB_F4)
- ENTRY SHSERR(NBEG,LBIT)
-#endif
- I=2
- 201 WRITE(6,200)IC(I)
- 200 FORMAT(1X,6('ERROR IN ',A1,'ETBYT'))
- IF (NBEG.LE.0) WRITE(6,280)
- 280 FORMAT(' INCORRECT VALUE OF BEGIN BIT NUMBER')
- IF (LBIT.LE.0 .OR. LBIT.GT.NBPW) WRITE(6,300)
- 300 FORMAT(' INCORRECT BYTE LENGTH')
- WRITE(6,240)NBEG,LBIT
- 240 FORMAT(' NBEG=',I20,' LBIT=',I20)
- INOM=INOM+1
- IF (INOM.GT.NOM) STOP
- RETURN
- END
-#endif
diff --git a/src/packlib/kernlib/kernbit/obsolete/m443/charr.F b/src/packlib/kernlib/kernbit/obsolete/m443/charr.F
deleted file mode 100644
index 56e754a..0000000
--- a/src/packlib/kernlib/kernbit/obsolete/m443/charr.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: charr.F,v 1.1.1.1 1996/02/15 17:47:44 mclareni Exp $
-*
-* $Log: charr.F,v $
-* Revision 1.1.1.1 1996/02/15 17:47:44 mclareni
-* Kernlib
-*
-*
-#include "kernbit/pilot.h"
-#if defined(CERNLIB_NEVER)
- CHARACTER*(*) FUNCTION CHARR(R)
-*
-* CERN PROGLIB# M443 CHARN .VERSION KERNBIT 1.07 910711
-* Author: Miguel Marquina 91/07/11
-*
-* Build CHARACTER CHARR from floating-point number R
-*
-* Mods Date Comments
-*
- CHARACTER*(*) CHARR
- CHARACTER*6 CHFMT
- DATA CHFMT/'(Fn.m)'/
- LN=LEN(CHARR)
- RETURN
- END
-#endif
diff --git a/src/packlib/kernlib/kernbit/obsolete/m444/uxtovm.F b/src/packlib/kernlib/kernbit/obsolete/m444/uxtovm.F
deleted file mode 100644
index e5fbb76..0000000
--- a/src/packlib/kernlib/kernbit/obsolete/m444/uxtovm.F
+++ /dev/null
@@ -1,60 +0,0 @@
-*
-* $Id: uxtovm.F,v 1.1.1.1 1996/02/15 17:47:41 mclareni Exp $
-*
-* $Log: uxtovm.F,v $
-* Revision 1.1.1.1 1996/02/15 17:47:41 mclareni
-* Kernlib
-*
-*
-* UXTOVM: Translate Unix-filenames to VM
-* This directory was created from kernbit.car patch m444
- CHARACTER*(*) FUNCTION UXTOVM(UXFILE)
-*
-* CERN PROGLIB# M444 UXTOVM .VERSION KERNBIT 1.07 910903
-* Author: Miguel Marquina 91/09/03
-*
-* Translates Unix-filenames to VM syntax (adequate for OPEN,INQUIRE)
-*
-* Mods Date Comments
-*
- CHARACTER*(*) UXFILE
- CHARACTER*21 VMFILE
-*
- VMFILE='/FNNONE FTNONE * '
- LS =LENOCC(UXFILE)
- IFN=INDEXB(UXFILE,'/')+1
- IFT=INDEX(UXFILE(IFN:),'.')+IFN
- IFM=INDEX(UXFILE(IFT:),'.')+IFT
-*
- IF(IFM.EQ.IFT) IFM=LS+2
-*
- IF (IFT.EQ.1) THEN
-*-- /dir/fn
- VMFILE( 2: 9)=UXFILE(IFN:)
- ELSEIF(IFT.EQ.2) THEN
-*-- /dir/.ft
- VMFILE( 2: 9)='DOT'
- VMFILE(11:18)=UXFILE(IFT:IFM-2)
- ELSE
-*-- /dir/fn.ft
- VMFILE( 2: 9)=UXFILE(IFN:IFT-2)
- IF(IFT.LE.LS)
- + VMFILE(11:18)=UXFILE(IFT:IFM-2)
- ENDIF
- IF(IFM.LE.LS.AND.IFN.EQ.1) THEN
-*-- fn.ft.fm
- VMFILE(20:21)=UXFILE(IFM:MIN(2,IFM+2))
- ENDIF
-*-- Translate special types when there is a directory
- IF(IFN.GT.1) THEN
- IF(VMFILE(11:18).EQ.'f') VMFILE(11:18)='FORTRAN'
- IF(VMFILE(11:18).EQ.'o') VMFILE(11:18)='TEXT'
- IF(VMFILE(11:18).EQ.'a') THEN
- VMFILE(11:18)='TXTLIB'
- IF(VMFILE(2:4).EQ.'lib')VMFILE( 2: 9)=UXFILE(IFN+3:IFT-2)
- ENDIF
- ENDIF
- CALL CLTOU(VMFILE)
- UXTOVM=VMFILE
- RETURN
- END
diff --git a/src/packlib/kernlib/kernbit/obsolete/t000/initcibm.c b/src/packlib/kernlib/kernbit/obsolete/t000/initcibm.c
deleted file mode 100644
index c31cb60..0000000
--- a/src/packlib/kernlib/kernbit/obsolete/t000/initcibm.c
+++ /dev/null
@@ -1,18 +0,0 @@
-/*
- * $Id: initcibm.c,v 1.1.1.1 1996/02/15 17:47:41 mclareni Exp $
- *
- * $Log: initcibm.c,v $
- * Revision 1.1.1.1 1996/02/15 17:47:41 mclareni
- * Kernlib
- *
- */
-#include "sys/CERNLIB_machine.h"
-#include "_kernbit/pilot.h"
-#if (defined(CERNLIB_IBM))&&(defined(CERNLIB_QSAA))
-#pragma csect (CODE,"INITCC")
-#pragma linkage (initc,FORTRAN)
-void initc(ii)
-int ii;
-{
-}
-#endif
diff --git a/src/packlib/kernlib/kernbit/obsolete/t001/timax.F b/src/packlib/kernlib/kernbit/obsolete/t001/timax.F
deleted file mode 100644
index 09de2ae..0000000
--- a/src/packlib/kernlib/kernbit/obsolete/t001/timax.F
+++ /dev/null
@@ -1,37 +0,0 @@
-*
-* $Id: timax.F,v 1.1.1.1 1996/02/15 17:47:41 mclareni Exp $
-*
-* $Log: timax.F,v $
-* Revision 1.1.1.1 1996/02/15 17:47:41 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_kernbit/pilot.h"
- SUBROUTINE TIMAX (T)
-C***********************************************************************
-C RETURN NORMALISED TIME (only useful at CERN, where the accounted time
-C is different to the native CPU)
-C A VERY TEMPORARY 3090 ONLY VERSION HRR
-C COULD USE JOB$VM FOR BATCH BUT NOT YET FOR INTERACTIVE SO LEAVE SIMPLE
-C***********************************************************************
-#if !defined(CERNLIB_CERNVMB)
- DATA RNORM /20.0/
-#endif
-#if defined(CERNLIB_CERNVMB)
- DATA RNORM / 5.0/
-#endif
- CALL TIMEX(TT)
- GO TO 100
- ENTRY TIMAL (T)
- CALL TIMEL (TT)
- GO TO 100
- ENTRY TIMAD (T)
- CALL TIMED (TT)
- 100 T= TT*RNORM
- RETURN
- ENTRY TIMAST (T)
- TT= T/RNORM
- CALL TIMEST (TT)
- RETURN
- END
diff --git a/src/packlib/kernlib/kernbit/obsolete/whichm/wibm.dat b/src/packlib/kernlib/kernbit/obsolete/whichm/wibm.dat
deleted file mode 100644
index 12aff41..0000000
--- a/src/packlib/kernlib/kernbit/obsolete/whichm/wibm.dat
+++ /dev/null
@@ -1,51 +0,0 @@
-*
-* $Id: wibm.dat,v 1.1.1.1 1996/02/15 17:47:41 mclareni Exp $
-*
-* $Log: wibm.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:47:41 mclareni
-* Kernlib
-*
-*
-#if defined(CERNLIB_IBMVM)
-/*DECK ID>, which.exec */
-/**********************************************************************
- * *
- * WHICH EXEC V1.00 *
- * *
- * Emulation of the Unix utility *
- * *
- * Author: M.Marquina 90/11/30 *
- * *
- * Mods Date Comments *
- * *
- **********************************************************************/
- Address Command
- Arg file
-
- If file="" Then Call ERROR 1 0
-
- If 'WORDS'(file)=1 Then file=file "EXEC"
- If 'WORDS'(file)=2 Then file=file "*"
-
- info="File" file "not found on any of the accessed disks"
- 'ESTATE' file
- If rc=0 Then Do
- qed0='QUEUED'()
- 'LISTFILE' file '(DATE LIFO'
- qed ='QUEUED'()-qed0-1
- Do n=1 to qed ; Pull dummy ; End
- Pull info
- End
-
- Say info
- Exit
-/* ------------------------------------------------------------------ */
- ERROR:
- Arg ne cc vv
-
- src="CRNWHI"
- err.1 ="001E Arguments missing"
-
- 'EXECIO 1 EMSG (STRING' src||err.ne
- Exit cc
-#endif
diff --git a/src/packlib/kernlib/kernbit/obsolete/z034/machid.inc b/src/packlib/kernlib/kernbit/obsolete/z034/machid.inc
deleted file mode 100644
index e2e9f02..0000000
--- a/src/packlib/kernlib/kernbit/obsolete/z034/machid.inc
+++ /dev/null
@@ -1,47 +0,0 @@
-*
-* $Id: machid.inc,v 1.1.1.1 1996/02/15 17:47:43 mclareni Exp $
-*
-* $Log: machid.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:47:43 mclareni
-* Kernlib
-*
-*
-*
-* machid.inc
-*
-#if !defined(CERNLIB_IBM)
-#if defined(CERNLIB_VAX)
- DATA IMAC / 4HVAX /
- ISIT = 1
-#endif
-#endif
-#if !defined(CERNLIB_IBM)
-#if (!defined(CERNLIB_NOSBE))&&(defined(CERNLIB_CDC))
- DATA IMAC / 4H7600 /
- ISIT = 2
-#endif
-#endif
-#if !defined(CERNLIB_IBM)
-#if (defined(CERNLIB_NOSBE))&&(defined(CERNLIB_CDC))
- DATA IMAC / 4H6400 /
- ISIT = 3
-#endif
-#endif
-#if !defined(CERNLIB_IBM)
-#if defined(CERNLIB_APOLLO)
- DATA IMAC / 4HAPO /
- ISIT = 9
-#endif
-#endif
-#if !defined(CERNLIB_IBM)
-#if defined(CERNLIB_CONVEX)
- DATA IMAC / 4HCVX /
- ISIT=13
-#endif
-#endif
-#if !defined(CERNLIB_IBM)
-#if defined(CERNLIB_CRAY)
- DATA IMAC / 4HCRAY /
- ISIT=12
-#endif
-#endif
diff --git a/src/packlib/kernlib/kernbit/obsolete/z034/mframe.F b/src/packlib/kernlib/kernbit/obsolete/z034/mframe.F
deleted file mode 100644
index c29885a..0000000
--- a/src/packlib/kernlib/kernbit/obsolete/z034/mframe.F
+++ /dev/null
@@ -1,42 +0,0 @@
-*
-* $Id: mframe.F,v 1.1.1.1 1996/02/15 17:47:43 mclareni Exp $
-*
-* $Log: mframe.F,v $
-* Revision 1.1.1.1 1996/02/15 17:47:43 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_kernbit/pilot.h"
-#if defined(CERNLIB_IBM)
- SUBROUTINE MFRAME (A)
- DATA B/4H9000/
- A = B
- RETURN
- END
-#endif
-#if (defined(CERNLIB_CDC))&&(!defined(CERNLIB_NOSBE))
- SUBROUTINE MFRAME (A)
- DATA B/4HMFZ /
- A = B
- RETURN
- END
-#endif
-#if (defined(CERNLIB_CDC))&&(defined(CERNLIB_NOSBE))
- SUBROUTINE MFRAME(A)
-C IDENTIFY CDC FRONTEND MAINFRAME MFA OR MFB
- DIMENSION TID(70)
- SSHPAR = SHIFT(LOCF(TID(1)),12)
-#endif
-#if (defined(CERNLIB_CDC))&&(defined(CERNLIB_NOSBE))&&(defined(CERNLIB_F4))
- CALL REQPP(4LSSHP.OR.2000000B.OR.LOCF(SSHPAR))
-#endif
-#if (defined(CERNLIB_CDC))&&(defined(CERNLIB_NOSBE))&&(!defined(CERNLIB_F4))
- CALL REQPP(L"SSHP".OR.O"2000000".OR.LOCF(SSHPAR))
-#endif
-#if (defined(CERNLIB_CDC))&&(defined(CERNLIB_NOSBE))
- A = 10H
- CALL CHMOVE(TID,8,A,1,3)
- RETURN
- END
-#endif
diff --git a/src/packlib/kernlib/kernbit/obsolete/z034/reqpp.s b/src/packlib/kernlib/kernbit/obsolete/z034/reqpp.s
deleted file mode 100644
index 233c696..0000000
--- a/src/packlib/kernlib/kernbit/obsolete/z034/reqpp.s
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: reqpp.s,v 1.1.1.1 1996/02/15 17:47:43 mclareni Exp $
-*
-* $Log: reqpp.s,v $
-* Revision 1.1.1.1 1996/02/15 17:47:43 mclareni
-* Kernlib
-*
-*
-#if (defined(CERNLIB_CDC))&&(defined(CERNLIB_NOSBE))
- IDENT REQPP
- ENTRY REQPP
-REQPP
- SA1 A1
- SB1 X1
-+SA11
- NZ X1,*
- SA1 B1
- BX6 X1
- SA6 1
- XJ
-LOOP SA2 X1
- LX2 59
- PL X2,LOOP
- EQ REQPP
- END
-#endif
diff --git a/src/packlib/kernlib/kernbit/obsolete/z034/which.F b/src/packlib/kernlib/kernbit/obsolete/z034/which.F
deleted file mode 100644
index 5b33b18..0000000
--- a/src/packlib/kernlib/kernbit/obsolete/z034/which.F
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: which.F,v 1.1.1.1 1996/02/15 17:47:43 mclareni Exp $
-*
-* $Log: which.F,v $
-* Revision 1.1.1.1 1996/02/15 17:47:43 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_kernbit/pilot.h"
-#if !defined(CERNLIB_IBM)
- SUBROUTINE WHICH(ISIT,IVAL)
-C CERN PACKAGE Z034 MACHINE/SYSTEM IDENTIFICATION
-#endif
- DATA IMAC / 4H /
- ISIT = 0
- IVAL = IMAC
- END
diff --git a/src/packlib/kernlib/kernbit/obsolete/z034/whichid.F b/src/packlib/kernlib/kernbit/obsolete/z034/whichid.F
deleted file mode 100644
index 6c2a2bf..0000000
--- a/src/packlib/kernlib/kernbit/obsolete/z034/whichid.F
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: whichid.F,v 1.1.1.1 1996/02/15 17:47:43 mclareni Exp $
-*
-* $Log: whichid.F,v $
-* Revision 1.1.1.1 1996/02/15 17:47:43 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_kernbit/pilot.h"
-#if !defined(CERNLIB_IBM)
-#endif
diff --git a/src/packlib/kernlib/kernbit/obsolete/z034/whichml.s b/src/packlib/kernlib/kernbit/obsolete/z034/whichml.s
deleted file mode 100644
index fb2a754..0000000
--- a/src/packlib/kernlib/kernbit/obsolete/z034/whichml.s
+++ /dev/null
@@ -1,173 +0,0 @@
-*
-* $Id: whichml.s,v 1.1.1.1 1996/02/15 17:47:43 mclareni Exp $
-*
-* $Log: whichml.s,v $
-* Revision 1.1.1.1 1996/02/15 17:47:43 mclareni
-* Kernlib
-*
-*
-#if defined(CERNLIB_IBM)
-WHICH CSECT
-#if defined(CERNLIB_QMIBMXA)
-WHICH AMODE ANY
-WHICH RMODE ANY
-#endif
-*
-* MODULE WHICH
-*
-* ENTRY POINT WHICH
-*
-* TYPE NON-REENTRANT, FORTRAN COMPATIBLE
-*
-* AUTHOR H.R.RENSHALL, DD, CERN. 09/05/78.
-*
-* MODIFIED 12/09/81 BY ADDITION OF MODELS 3081 AND 7880.
-* MODIFIED 11/09/82 CORRECT 7880 FOR INTERNAL LABEL 3033!
-* MODIFIED 04/01/86 BY ADDITION OF 3090 AND 7880 TO 7890
-* MODIFIED 12/02/92 BY ADDITION OF 9000 (ALL MODELS HAVE
-* THE SAME CVTID OF 9021. AT CERN RETURN 9900).
-*
-* FORTRAN CALLABLE FUNCTION TO IDENTIFY CPU MODEL.
-*
-* INTEGER*4 ISIT
-* REAL*4 VAL
-* CALL WHICH ( ISIT, VAL)
-*
-* WILL RETURN ISIT ( INTEGER) VAL ( CHARACTER) FOR MODEL
-*
-* 0 ' ' UNKNOWN
-*
-* 4 '/168' 168
-*
-* 5 '3032' 3032
-*
-* 6 '3081' 3081
-*
-* 7 '7890' 7890-MVS
-*
-* 8 '3090' 3090-MVS
-*
-* 10 '7890' 7890-VM CMS
-*
-* 11 '3090' 3090-VM CMS
-*
-* 14 '9000' 9000-MVS
-*
-* 15 '9000' 9000-VM CMS
-*
-* 16 '9900' 9000-CERN VM
-*
-* BY EXAMINING THE CVTMDL FIELD, PREFIX -6 IN THE CVT.
-*
-* NEW MODELS AND RETURN VALUES MAY BE ADDED AS LINES IN THE
-* MODELS TABLE WITH NO OTHER MODS TO THE CODE.
-*
-* NOTE USES THE EXPANDED MACROS #ROUTINE, #EQUATE AND
-* #RETURN FROM THE RUTHERFORD MACRO LIBRARY.
-*
-*WHICH #ROUTINE BASE=(R13),NAME=WHICH MACRO EXPANDED HERE
- ENTRY WHICH
-* DECLARE THE EXTERNAL NAME
- DS 0H ROUTINE ENTRY POINT
- USING WHICH,15
-* INITIAL ADDRESSABILITY
- B #RTA0001
-* BRANCH PAST NAME
- DC AL1(#RTA0001-*-1)
-* LENGTH OF NAME
- DC C'WHICH' NAME
-#RTA0001 DS 0H ALIGN FOR INSTRUCTION
- STM 14,12,12(13) STORE CALLER'S REGISTERS
- LR 12,13 HOLD CALLER'S SA ADDRESS
- CNOP 0,4 ALIGN ON WORD
- BAL 13,#RTE0001
-* BRANCH AND SET 13
-#RTD0001 DS 0F INVENTED NAME FOR SAVEAREA
- DROP 15 DROP OLD BASE
- USING #RTD0001,13
-* ADDRESS VIA SAVEAREA
- DS (72)X SAVEAREA
-#RTE0001 DS 0H END OF SAVEAREA
- ST 12,4(0,13) LINK OLD SA DOWN
- ST 13,8(0,12) LINK NEW SA UP
-* #EQUATE EXPANDED MACRO
-* SYMBOLIC NAMES FOR GENERAL REGISTERS
-R0 EQU 0
-R1 EQU 1
-R2 EQU 2
-R3 EQU 3
-R4 EQU 4
-R5 EQU 5
-R6 EQU 6
-R7 EQU 7
-R8 EQU 8
-R9 EQU 9
-R10 EQU 10
-R11 EQU 11
-R12 EQU 12
-R13 EQU 13
-R14 EQU 14
-R15 EQU 15
- LTR R2,R1 TEST IF NO PARAMETER LIST
- BZ RETURN DO NOTHING AND RETURN
- LA R0,0 SET UP DEFAULT VALUE ISIT=0
- L R2,0(R1) GET FIRST PARAMETER ADDRESS
- ST R0,0(R2) LOAD DEFAULT VALUE OF ISIT
- L R6,16 GET CVT ORIGIN INTO R6
- S R6,CVTMDL SUBTRACT OFFSET TO POINT TO CVTMDL
- LA R3,MODELS-LMODEL POINT TO BEFORE MODEL TABLE
- LA R4,LMODEL SET UP INCREMENT
- LA R5,MODELEND POINT PAST LAST MODEL
- USING MODEL,R3 ADDRESS MODEL TABLE
-LOOP DS 0H LOOP OVER ALL MODELS IN TABLE
- BXH R3,R4,UNKNOWN EXIT IF MODEL NOT IN TABLE
- CLC 0(2,R6),MODELID COMPARE CVTMDL WITH TABLE ENTRY
- BNE LOOP
- MVC 0(4,R2),ISIT LOAD ISIT ARGUMENT
- L R0,VAL STORE VAL IN R0
- B FINAL GO FOR LAST ARGUMENT
-UNKNOWN L R0,BLANK HERE WHEN MODEL NOT IN TABLE
-FINAL LTR R2,R2 WAS SECOND ARGUMENT GIVEN
- BM RETURN RETURN IF NOT
- L R2,4(R1) GET 2ND ARGUMENT ADDRESS
- ST R0,0(R2) LOAD SECOND ARGUMENT
-*RETURN #RETURN RC=0 AND RETURN EXPANDED MACRO
-RETURN XR 15,15 CLEAR RETURN CODE
- L 13,4(13) PICK UP OLD SA ADDRESS
- L 14,12(13) RESTORE REGISTER 14
- LM 2,12,28(13) RELOAD CALLER'S REGISTERS
-** MVI 12(13),X'FF'
-* SET TRACEBACK FLAG
- BR 14 RETURN TO CALLER
-CVTMDL DC F'6' OFFSET OF CVTMDL FROM CVT ORIGIN
-BLANK DC X'40404040' BLANK FOR MODEL NOT IN TABLE
-MODELS EQU * NOW FOLLOWS TABLE VALUES
- DC X'016800000000000461F1F6F8' ISIT=4,VAL='/168'
- DC X'3032000000000005F3F0F3F2' ISIT=5,VAL='3032'
- DC X'3081000000000006F3F0F8F1' ISIT=6,VAL='3081'
-#if defined(CERNLIB_IBMMVS)
- DC X'3033000000000007F7F8F9F0' ISIT=7,VAL='7890'!!!
- DC X'3090000000000008F3F0F9F0' ISIT=8,VAL='3090'
- DC X'902100000000000EF9F0F0F0' ISIT=14,VAL='9000'
-#endif
-#if !defined(CERNLIB_IBMMVS)
- DC X'303300000000000AF7F8F9F0' ISIT=10,VAL='7890'!!!
- DC X'309000000000000BF3F0F9F0' ISIT=11,VAL='3090'
-#endif
-#if (!defined(CERNLIB_IBMMVS))&&(!defined(CERNLIB_CERN))
- DC X'902100000000000FF9F0F0F0' ISIT=15,VAL='9000'
-#endif
-#if (!defined(CERNLIB_IBMMVS))&&(defined(CERNLIB_CERN))
- DC X'9021000000000010F9F0F0F0' ISIT=16,VAL='9900'
-#endif
-*
-* INSERT ANY NEW MODELS HERE
-*
-MODELEND EQU * END OF TABLE ENTRIES
-MODEL DSECT DSECT FOR MAPPING INTO TABLE
-MODELID DS XL4 TO COMPARE WITH CVTMDL
-ISIT DS XL4 4 BYTE ISIT VALUE TO RETURN
-VAL DS XL4 4 CHARACTER VAL TO RETURN
-LMODEL EQU *-MODEL LENGTH OF TABLE ENTRY
- END
-#endif
diff --git a/src/packlib/kernlib/kernbit/obsolete/z265/delay.s b/src/packlib/kernlib/kernbit/obsolete/z265/delay.s
deleted file mode 100644
index 65a613d..0000000
--- a/src/packlib/kernlib/kernbit/obsolete/z265/delay.s
+++ /dev/null
@@ -1,58 +0,0 @@
-*
-* $Id: delay.s,v 1.1.1.1 1996/02/15 17:47:44 mclareni Exp $
-*
-* $Log: delay.s,v $
-* Revision 1.1.1.1 1996/02/15 17:47:44 mclareni
-* Kernlib
-*
-*
-#if defined(CERNLIB_IBMMVS)
-*
-* DELAY executing program
-*
-* Wait for some real time and then return to caller
-*
-* Structure: Subroutine
-*
-* USAGE: CALL DELAY (NHSEC)
-*
-* NHSEC Input, INTEGER, number of time units to wait
-* time unit is 26 usec
-*
-* Restrictions: Usage mutually exclusive with that of TMLOG
-*
-* Author: D. Moenkemeyer March 1981
-*
-* ORIGINAL UNEXPANDED FOLLOWS
-*ELAY BEG *,MODE=RENT,RMODE=ANY
-* L 2,0(1) GET ADDRESS OF TIMER UNITS
-* STIMER WAIT,TUINTVL=(2) WAIT
-* SCHL RET=0,MODE=RENT
-* END
-*ELAY BEG *,MODE=RENT,RMODE=ANY
-DELAY CSECT
-DELAY RMODE ANY
-DELAY AMODE ANY
- ENTRY DELAY
- USING *,12
- B 10(0,15) BRANCH AROUND ID
- DC AL1(5) LENGTH OF ID
- DC CL5'DELAY'
- STM 14,12,12(13) SAVE CALLER'S REGISTER
- LR 12,15 LOAD BASE
- GETMAIN R,LV=72
- ST 13,4(1) BACKWARD CHAIN
- ST 1,8(13) FORWARD CHAIN
- LR 15,13
- LR 13,1
- LM 15,1,16(15) RESTORE ALL REGISTER
- L 2,0(1) GET ADDRESS OF TIMER UNITS
- STIMER WAIT,TUINTVL=(2) WAIT
- LR 1,13
- L 13,4(13) RELOAD SA-REG
- FREEMAIN R,LV=72,A=(1)
- LM 14,12,12(13) RESTORE CALLER'S REGISTER
- XR 15,15
- BR 14 RETURN TO CALLER
- END
-#endif
diff --git a/src/packlib/kernlib/kernbit/obsolete/z265/getenvf.F b/src/packlib/kernlib/kernbit/obsolete/z265/getenvf.F
deleted file mode 100644
index a0bc1b3..0000000
--- a/src/packlib/kernlib/kernbit/obsolete/z265/getenvf.F
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: getenvf.F,v 1.1.1.1 1996/02/15 17:47:44 mclareni Exp $
-*
-* $Log: getenvf.F,v $
-* Revision 1.1.1.1 1996/02/15 17:47:44 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_kernbit/pilot.h"
-#if defined(CERNLIB_IBMMVS)
- SUBROUTINE GETENVF(CHENV,CHVAL)
-* Dummy version for systems without environmental variables
- COMMON/SLATE/IS(40)
- CHARACTER*(*) CHENV,CHVAL
- CHVAL = ' '
- IS(1) = 0
- END
-#endif
diff --git a/src/packlib/kernlib/kernbit/obsolete/z265/sleepf.F b/src/packlib/kernlib/kernbit/obsolete/z265/sleepf.F
deleted file mode 100644
index 27d270c..0000000
--- a/src/packlib/kernlib/kernbit/obsolete/z265/sleepf.F
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: sleepf.F,v 1.1.1.1 1996/02/15 17:47:44 mclareni Exp $
-*
-* $Log: sleepf.F,v $
-* Revision 1.1.1.1 1996/02/15 17:47:44 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_kernbit/pilot.h"
-#if defined(CERNLIB_IBMMVS)
- INTEGER FUNCTION SLEEPF(ISEC)
-C
-C CERN PROGLIB# Z265 SLEEPF .VERSION KERNIBM X.XX 910308
-C ORIG. 08/03/91, Harald Keller / DESY
-C Fortran interface to SLEEP
-C
- DATA CYCLE/26E-6/
- NCYCS=IFIX(1./CYCLE) * ISEC
- CALL DELAY(NCYCS)
- SLEEPF = 0
- RETURN
- END
-#endif
diff --git a/src/packlib/kernlib/kernbit/t000/Imakefile b/src/packlib/kernlib/kernbit/t000/Imakefile
deleted file mode 100644
index 14b6e27..0000000
--- a/src/packlib/kernlib/kernbit/t000/Imakefile
+++ /dev/null
@@ -1,4 +0,0 @@
-SRCS_F= \ @@\
- initc.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kernbit/t000/initc.F b/src/packlib/kernlib/kernbit/t000/initc.F
deleted file mode 100644
index fab060f..0000000
--- a/src/packlib/kernlib/kernbit/t000/initc.F
+++ /dev/null
@@ -1,14 +0,0 @@
-*
-* $Id: initc.F,v 1.1.1.1 1996/02/15 17:47:54 mclareni Exp $
-*
-* $Log: initc.F,v $
-* Revision 1.1.1.1 1996/02/15 17:47:54 mclareni
-* Kernlib
-*
-*
-#include "kernbit/pilot.h"
-#if !defined(CERNLIB_IBM)||!defined(CERNLIB_QSAA)
- SUBROUTINE INITC
- RETURN
- END
-#endif
diff --git a/src/packlib/kernlib/kernbit/t002/Imakefile b/src/packlib/kernlib/kernbit/t002/Imakefile
deleted file mode 100644
index b23e049..0000000
--- a/src/packlib/kernlib/kernbit/t002/Imakefile
+++ /dev/null
@@ -1,4 +0,0 @@
-SRCS_C= \ @@\
- unalign.c
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kernbit/t002/unalign.c b/src/packlib/kernlib/kernbit/t002/unalign.c
deleted file mode 100644
index a425fcb..0000000
--- a/src/packlib/kernlib/kernbit/t002/unalign.c
+++ /dev/null
@@ -1,25 +0,0 @@
-/*
- * $Id: unalign.c,v 1.1.1.1 1996/02/15 17:47:54 mclareni Exp $
- *
- * $Log: unalign.c,v $
- * Revision 1.1.1.1 1996/02/15 17:47:54 mclareni
- * Kernlib
- *
- */
-#include "kernbit/pilot.h"
-#if !defined(CERNLIB_QXNO_SC)
-/*> ROUTINE UNALIGN
- CERN PROGLIB# T002 UNALIGN .VERSION KERNBIT 1.08 920316
- ORIG. 91/xx/xx Lee Roberts-SSC
-
- Interface to allow_unaligned_data_access when using option +ppu
-
- HP has chosen NOT to allow unaligned accesses by default. This
- routine is needed by tests who do like KERNNUMT.
-
-*/
-void allow_unaligned_data_access_()
-{
- allow_unaligned_data_access();
-}
-#endif
diff --git a/src/packlib/kernlib/kernbit/test/Imakefile b/src/packlib/kernlib/kernbit/test/Imakefile
deleted file mode 100644
index b001c0b..0000000
--- a/src/packlib/kernlib/kernbit/test/Imakefile
+++ /dev/null
@@ -1,20 +0,0 @@
-SRCS_F= kbhdr.F m433t.F m442t.F m443t.F z100t.F z265t.F z268t.F z009t.F
-
-
-#if defined(CERNLIB_VAXVMS) || defined(CERNLIB_IBMVM)
-SRCS_F:= $(SRCS_F) z313t.F
-#endif
-
-#if defined(CERNLIB_IBMVM)
-SRCS_F:= $(SRCS_F) m444t.F z305t.F z307t.F
-#endif
-
-SubdirLibraryTarget(kernbitt,NullParameter)
-
-DefinePackageLibrary(kernbitt)
-
-NormalFortranProgramTarget(kbtest,kbtest.o,$(PACKAGE_LIB),$(PACKAGE_LIB),NullParameter)
-
-TestTarget(kbtest,fatmen.names,NullParameter)
-
-CopyFile(namefd.input,fatmen.names)
diff --git a/src/packlib/kernlib/kernbit/test/kbhdr.F b/src/packlib/kernlib/kernbit/test/kbhdr.F
deleted file mode 100644
index da4f2e0..0000000
--- a/src/packlib/kernlib/kernbit/test/kbhdr.F
+++ /dev/null
@@ -1,15 +0,0 @@
-*
-* $Id: kbhdr.F,v 1.1.1.1 1996/02/15 17:47:55 mclareni Exp $
-*
-* $Log: kbhdr.F,v $
-* Revision 1.1.1.1 1996/02/15 17:47:55 mclareni
-* Kernlib
-*
-*
-#include "kernbit/pilot.h"
- SUBROUTINE KBHDR(STRING)
- CHARACTER*(*) STRING
- PRINT 1000,STRING
-1000 FORMAT(' **** Testing ',A)
- RETURN
- END
diff --git a/src/packlib/kernlib/kernbit/test/kbtest.F b/src/packlib/kernlib/kernbit/test/kbtest.F
deleted file mode 100644
index 963a552..0000000
--- a/src/packlib/kernlib/kernbit/test/kbtest.F
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: kbtest.F,v 1.2 1996/12/12 13:50:34 cernlib Exp $
-*
-* $Log: kbtest.F,v $
-* Revision 1.2 1996/12/12 13:50:34 cernlib
-* Add test for caldat z009
-*
-* Revision 1.1.1.1 1996/02/15 17:47:55 mclareni
-* Kernlib
-*
-*
-#include "kernbit/pilot.h"
- CALL M433T
- CALL M442T
- CALL M443T
-#if defined(CERNLIB_IBMVM)
- CALL M444T
-#endif
- CALL Z009T
- CALL Z100T
- CALL Z265T
-#if (defined(CERNLIB_UNIX))&&(!defined(CERNLIB_OS9))
- CALL Z268T
-#endif
-#if defined(CERNLIB_IBMVM)
- CALL Z305T
- CALL Z307T
-#endif
-#if defined(CERNLIB_IBMVM)||defined(CERNLIB_VAXVMS)
- CALL Z313T
-#endif
- END
diff --git a/src/packlib/kernlib/kernbit/test/m433t.F b/src/packlib/kernlib/kernbit/test/m433t.F
deleted file mode 100644
index 69346fe..0000000
--- a/src/packlib/kernlib/kernbit/test/m433t.F
+++ /dev/null
@@ -1,66 +0,0 @@
-*
-* $Id: m433t.F,v 1.1.1.1 1996/02/15 17:47:55 mclareni Exp $
-*
-* $Log: m433t.F,v $
-* Revision 1.1.1.1 1996/02/15 17:47:55 mclareni
-* Kernlib
-*
-*
-#include "kernbit/pilot.h"
- SUBROUTINE M433T
-*
-* Test of M433 Package
-*
- CHARACTER*80 STRIP,WORD,SUBWORD
- CHARACTER*80 STRING,STROUT
- INTEGER WORDS
- DIMENSION IW(4),NW(4)
-#if defined(CERNLIB_NEXT)
-C** The Absoft compiler has an intrinsic function called WORD
-C It needs the following declaration to take the KERNLIB one
- EXTERNAL WORD
-#endif
- DATA IW/1,4,7,9/, NW/3,5,4,2/
-*
- CALL KBHDR('M433 CLTOU')
- NT=0
- STRING='This is a test1 of M433 CLTOU'
-1 CONTINUE
- NT=NT+1
- NWS=WORDS(STRING)
- PRINT 1000,NT,NWS,STRING
-C
- DO 10 N=0,9
- STROUT=WORD(STRING,N)
- LSTR =LENOCC(STROUT)
- PRINT 1001,N,LSTR,STROUT
-10 CONTINUE
-C
- DO 20 N=1,4
- STROUT=SUBWORD(STRING,IW(N),NW(N))
- LSTR =LENOCC(STROUT)
- PRINT 1002,IW(N),NW(N),LSTR,STROUT
-20 CONTINUE
- IF(NT.EQ.1) THEN
- STRING=' /// This/is/ test2// of/M433/CLTOU/// '
- CALL WORDSEP('/')
- ENDIF
- IF(NT.LT.2) GOTO 1
-99 CONTINUE
- STROUT=STRING
- LSTR=LENOCC(STROUT)
- PRINT *, 'Stripping Leading " " of: >>>',STROUT(1:LSTR),'<<<'
- STROUT=STRIP(STROUT,'Leading',' ')
- LSTR=LENOCC(STROUT)
- PRINT *, 'Stripping Trailing " " of: >>>',STROUT(1:LSTR),'<<<'
- STROUT=STRIP(STROUT,'trail',' ')
- LSTR=LENOCC(STROUT)
- PRINT *, 'Stripping Both "/" of: >>>',STROUT(1:LSTR),'<<<'
- STROUT=STRIP(STROUT,'both','/')
- LSTR=LENOCC(STROUT)
- PRINT *, 'Stripped string : >>>',STROUT(1:LSTR),'<<<'
- RETURN
-1000 FORMAT(' Test#',I2,' string(nw=',I2,'):',A)
-1001 FORMAT(' Word (',I5, ',L=',I2,')=',A)
-1002 FORMAT(' Subword(',I2,',',I2,',L=',I2,')=',A)
- END
diff --git a/src/packlib/kernlib/kernbit/test/m442t.F b/src/packlib/kernlib/kernbit/test/m442t.F
deleted file mode 100644
index 58f07bb..0000000
--- a/src/packlib/kernlib/kernbit/test/m442t.F
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: m442t.F,v 1.1.1.1 1996/02/15 17:47:55 mclareni Exp $
-*
-* $Log: m442t.F,v $
-* Revision 1.1.1.1 1996/02/15 17:47:55 mclareni
-* Kernlib
-*
-*
-#include "kernbit/pilot.h"
- SUBROUTINE M442T
-*
-* Test of FORTRAN emulation of VM NAMEFIND command
-*
- CHARACTER*20 CHIN(2,10)
- CHARACTER*255 CHOUT(2,10)
-*
- CALL KBHDR('M442 NAMEFD')
-*
-* Get the list of FATSERVERS...
-*
- CHIN(1,1) = ':nick'
- CHIN(2,1) = 'FATSERVERS'
-
- CHOUT(1,1) = ':list'
-
- NIN = 1
- NOUT = 1
- LUN = 1
- CALL NAMEFD(LUN,'fatmen.names',CHIN,NIN,CHOUT,NOUT,IRC)
-*
- PRINT 1000,(CHOUT(K,1),K=1,2)
-1000 FORMAT(6X,'Extraction from fatmen.names: ',2A20)
- RETURN
- END
diff --git a/src/packlib/kernlib/kernbit/test/m443t.F b/src/packlib/kernlib/kernbit/test/m443t.F
deleted file mode 100644
index 82f2875..0000000
--- a/src/packlib/kernlib/kernbit/test/m443t.F
+++ /dev/null
@@ -1,44 +0,0 @@
-*
-* $Id: m443t.F,v 1.1.1.1 1996/02/15 17:47:55 mclareni Exp $
-*
-* $Log: m443t.F,v $
-* Revision 1.1.1.1 1996/02/15 17:47:55 mclareni
-* Kernlib
-*
-*
-#include "kernbit/pilot.h"
- SUBROUTINE M443T
- CHARACTER*8 STRING, CHARN
- CALL KBHDR('M443 CHARN')
- STRING='12345'
- IN =ICHARN(STRING)
- PRINT 1000, STRING, IN
-*
- STRING='-67890'
- IN =ICHARN(STRING)
- PRINT 1000, STRING, IN
-*
- STRING='12.345'
- RN =RCHAR(STRING)
- PRINT 1001, STRING, RN
-*
- STRING='-678.90'
- RN =RCHAR(STRING)
- PRINT 1001, STRING, RN
-*
- STRING=CHARN(IN)
- PRINT 1002, STRING, IN
-*
- IN=123456789
- STRING=CHARN(IN)
- PRINT 1002, STRING, IN
-*
-* STRING=CHARN(RN)
-* PRINT 1003, STRING, RN
-*
-1000 FORMAT(6X,'CHAR TO I translation: string ',A,' number',I10)
-1001 FORMAT(6X,'CHAR TO R translation: string ',A,' number',F10.5)
-1002 FORMAT(6X,'I TO CHAR translation: string ',A,' number',I10)
-1003 FORMAT(6X,'R TO CHAR translation: string ',A,' number',F10.5)
- RETURN
- END
diff --git a/src/packlib/kernlib/kernbit/test/m444t.F b/src/packlib/kernlib/kernbit/test/m444t.F
deleted file mode 100644
index 687cb0e..0000000
--- a/src/packlib/kernlib/kernbit/test/m444t.F
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: m444t.F,v 1.1.1.1 1996/02/15 17:47:55 mclareni Exp $
-*
-* $Log: m444t.F,v $
-* Revision 1.1.1.1 1996/02/15 17:47:55 mclareni
-* Kernlib
-*
-*
-#include "kernbit/pilot.h"
-#if defined(CERNLIB_IBMVM)
- SUBROUTINE M444T
- CHARACTER*80 UXFILE
- CHARACTER*21 VMFILE,UXTOVM
- CALL KBHDR('M444 UXTOVM')
- UXFILE='/cern/new/src/source.f'
- VMFILE=UXTOVM(UXFILE)
- PRINT 1000, UXFILE,VMFILE
- UXFILE='/cern/new/src/source.o'
- VMFILE=UXTOVM(UXFILE)
- PRINT 1000, UXFILE,VMFILE
- UXFILE='/cern/new/lib/libkernlib.a'
- VMFILE=UXTOVM(UXFILE)
- PRINT 1000, UXFILE,VMFILE
- UXFILE='kernlib.txtlib'
- VMFILE=UXTOVM(UXFILE)
- PRINT 1000, UXFILE,VMFILE
- UXFILE='profile.exec.p'
- VMFILE=UXTOVM(UXFILE)
- PRINT 1000, UXFILE,VMFILE
-*
-1000 FORMAT(' Unix filename : ',A/' VM translation: ',A)
- RETURN
- END
-#endif
diff --git a/src/packlib/kernlib/kernbit/test/namefd.input b/src/packlib/kernlib/kernbit/test/namefd.input
deleted file mode 100644
index a15e62d..0000000
--- a/src/packlib/kernlib/kernbit/test/namefd.input
+++ /dev/null
@@ -1,59 +0,0 @@
-*
-* $Id: namefd.input,v 1.1.1.1 1996/02/15 17:47:55 mclareni Exp $
-*
-* $Log: namefd.input,v $
-* Revision 1.1.1.1 1996/02/15 17:47:55 mclareni
-* Kernlib
-*
-*
-*DECK ID>, fatmen.names
-:nick.FMSACLAY
- :userid.fmsmc
- :node.frsac12
- :DIR1.//cern/smc
-
-:nick.FATCAT
- :userid.fmfatcat
- :node.cernvm
- :DIR1.//cern/smc
-
-:nick.FMIN2P3
- :userid.fmsmc
- :node.frcpn11
- :DIR1.//cern/smc
-
-:nick.FMRAL
- :userid.fmsmc
- :node.ukacrl
- :DIR1.//cern/smc
-
-:nick.FATSERVERS :plink.splodge
- :list.fatop1 fatop2
-
-:nick.FATOPERATORS
- :list.fatop1 fatop2
-
-:nick.FATOP1
- :userid.console
- :node.cernvm
-
-:nick.FATOP2
- :userid.opsutil
- :node.cernvm
-
-:nick.FATOWN1
- :userid.fatone
- :node.cernvm
-
-:nick.FATOWN2
- :userid.hrrcr
- :node.cernvm
-
-:nick.FATOWNERS
- :list.fatown1 fatown2 jamie igb
-
-:nick.FATCAT
- :userid.fmfatcat
- :node.cernvm
- :DIR1.//cern/smc
-
diff --git a/src/packlib/kernlib/kernbit/test/z009t.F b/src/packlib/kernlib/kernbit/test/z009t.F
deleted file mode 100644
index 2bf54ae..0000000
--- a/src/packlib/kernlib/kernbit/test/z009t.F
+++ /dev/null
@@ -1,806 +0,0 @@
-*
-* $Id: z009t.F,v 1.1 1996/12/12 13:50:36 cernlib Exp $
-*
-* $Log: z009t.F,v $
-* Revision 1.1 1996/12/12 13:50:36 cernlib
-* Add test for caldat z009
-*
-*
- SUBROUTINE Z009T
-C PROGRAM CALDATT
-C
-C BATCH PROGRAM FOR TESTING CALDAT
-C
-C NAMES OF THE MONTHS STRINGS:
-C 3 CHARS: 'JAN', 'FEB', 'MAR', 'APR', 'MAY', 'JUN',
-C 'JUL', 'AUG', 'SEP', 'OCT', 'NOV', 'DEC'
-C 5 CHARS: 'JAN. ', 'FEB. ', 'MARCH', 'APRIL', 'MAY ', 'JUNE ',
-C 'JULY ', 'AUG. ', 'SEPT.', 'OCT. ', 'NOV. ', 'DEC. '
-C
-C NAMES OF THE WEEK DAYS:
-C 2 CHARS: 'MO', 'TU', 'WE', 'TH', 'FR', 'SA', 'SU'
-C 4 CHARS: 'MON.', 'TUE.', 'WED.', 'THUR', 'FRI.', 'SAT.','SUN.'
-C
-C
- INTEGER IINDEX, RETC
-C
-C CALDAT VARIABLES FOR "TODAY", USED AS REFERENCE
-C
- INTEGER BINREP(8)
- CHARACTER CHREP*119
- CHARACTER DMY14*14, DMY11*11, DMY9*9, DMY10*10
- CHARACTER*8 DMY8A, DMY8B, YMD8, MDY8, YDM8
- CHARACTER*6 DMY6, YMD6, MDY6, YDM6
- CHARACTER YD5*5, W4*4, W2*2
-C
- EQUIVALENCE (CHREP( 1: 14), DMY14), (CHREP( 15: 25), DMY11),
- * (CHREP( 26: 34), DMY9 ), (CHREP( 35: 44), DMY10),
- * (CHREP( 45: 52), DMY8A), (CHREP( 53: 60), DMY8B),
- * (CHREP( 61: 66), DMY6 ), (CHREP( 67: 74), YMD8 ),
- * (CHREP( 75: 80), YMD6 ), (CHREP( 81: 88), MDY8 ),
- * (CHREP( 89: 94), MDY6 ), (CHREP( 95:102), YDM8 ),
- * (CHREP(103:108), YDM6 ), (CHREP(109:113), YD5 ),
- * (CHREP(114:117), W4 ), (CHREP(118:119), W2 )
-C
-C CALDAT VARIABLES FOR THE VARIOUS FIELDS
-C
- INTEGER XINREP(8)
- CHARACTER XCHREP*119
- CHARACTER XDMY14*14, XDMY11*11, XDMY9*9, XDMY10*10
- CHARACTER*8 XDMY8A, XDMY8B, XYMD8, XMDY8, XYDM8
- CHARACTER*6 XDMY6, XYMD6, XMDY6, XYDM6
- CHARACTER XYD5*5, XW4*4, XW2*2
-C
- EQUIVALENCE (XCHREP( 1: 14), XDMY14), (XCHREP( 15: 25), XDMY11),
- * (XCHREP( 26: 34), XDMY9 ), (XCHREP( 35: 44), XDMY10),
- * (XCHREP( 45: 52), XDMY8A), (XCHREP( 53: 60), XDMY8B),
- * (XCHREP( 61: 66), XDMY6 ), (XCHREP( 67: 74), XYMD8 ),
- * (XCHREP( 75: 80), XYMD6 ), (XCHREP( 81: 88), XMDY8 ),
- * (XCHREP( 89: 94), XMDY6 ), (XCHREP( 95:102), XYDM8 ),
- * (XCHREP(103:108), XYDM6 ), (XCHREP(109:113), XYD5 ),
- * (XCHREP(114:117), XW4 ), (XCHREP(118:119), XW2 )
-C
-C 3 RUNS:
-C
- INTEGER RUN
-C
- DO 10000 RUN = 1, 3
- GO TO (10010, 10020, 10030), RUN
-C
-10010 IINDEX = 0
- WRITE (6, 10011)
-10011 FORMAT (' 1. RUN: TODAY')
-C ================
- GO TO 11000
-C
-C
-10020 IINDEX = 101
- WRITE (6, 10021)
-10021 FORMAT (' 2. RUN: 10 YEARS AGO')
-C =======================
- BINREP (3) = BINREP (3) - 10
- GO TO 11000
-C
-C
-10030 IINDEX = 101
- WRITE (6, 10031)
-10031 FORMAT (' 3. RUN: 10 YEARS FROM NOW')
-C ============================
- BINREP (3) = BINREP (3) + 20
- GO TO 11000
-C
-11000 CONTINUE
-C
-C INITIALISE
-C
- CALL CALDAT (IINDEX, CHREP, BINREP, RETC)
- IF (RETC .EQ. 0) THEN
- WRITE (6, 65) DMY14, DMY11, DMY9, DMY10, DMY8A, DMY8B, DMY6,
- * YMD8, YMD6, MDY8, MDY6, YDM8, YDM6, YD5, W4, W2
- 65 FORMAT (' REFERENCE <---+----1--->', /
- * ' DMY14 ', A/
- * ' DMY11 ', A/
- * ' DMY9 ', A/
- * ' DMY10 ', A/
- * ' DMY8A ', A/
- * ' DMY8B ', A/
- * ' DMY6 ', A/
- * ' YMD8 ', A/
- * ' YMD6 ', A/
- * ' MDY8 ', A/
- * ' MDY6 ', A/
- * ' YDM8 ', A/
- * ' YDM6 ', A/
- * ' YD5 ', A/
- * ' W4 ', A/
- * ' W2 ', A)
- WRITE (6, 66) BINREP
- 66 FORMAT (' DAY, MONTH, YEAR ', 3I10/
- * ' DAY IN THE YEAR ', I10/
- * ' PACKED DECIMAL X''', Z8, ''''/
- * ' JULIAN ', I10/
- * ' DAY IN THE WEEK ', I10/
- * ' WEEK IN THE YEAR ', I10)
-C
- ELSE
- WRITE (6, 67) CHREP, BINREP, RETC
- 67 FORMAT (' TODAY FAILED', /,
- * ' CHREP ', A119, /,
- * ' BINREP ', 4I10, 2X, Z8, 3I10 /,
- * ' ERROR CODE =', I10)
- GO TO 9000
- END IF
-C
-C LOOP OVER CHOICES OF IINDEX
-C
- DO 1000 KINDEX = 1, 19
- XCHREP = ' '
- DO 100 I = 1, 8
- 100 XINREP (I) = 0
-C
-C SET IINDEX AND SELECT CHOICE
-C
- IF (KINDEX .LE. 14) THEN
- IINDEX = KINDEX
- ELSE
- IINDEX = KINDEX + 86
-C 101 = 15 + 86 , ...
- ENDIF
-C
- GO TO (1010, 1020, 1030, 1040, 1050, 1060, 1070,
- 1 1080, 1090, 1100, 1110, 1120, 1130, 1140,
- 2 1150, 1160, 1170, 1180, 1190) KINDEX
-C
-C
- 1010 CONTINUE
- WRITE (6, 1011)
- 1011 FORMAT (' DMY14 ')
-C ===========
- XDMY14 = DMY14
- CALL CALDAT (IINDEX, XCHREP, XINREP, RETC)
- IF (RETC .EQ. 0) THEN
- IF (XCHREP .EQ. CHREP) THEN
- IF (XINREP(1) .EQ. BINREP(1) .AND.
- 2 XINREP(2) .EQ. BINREP(2) .AND.
- 3 XINREP(3) .EQ. BINREP(3) .AND.
- 4 XINREP(4) .EQ. BINREP(4) .AND.
- 5 XINREP(5) .EQ. BINREP(5) .AND.
- 6 XINREP(6) .EQ. BINREP(6) .AND.
- 7 XINREP(7) .EQ. BINREP(7) .AND.
- 8 XINREP(8) .EQ. BINREP(8) ) THEN
- WRITE (6, 9061)
- ELSE
- WRITE (6, 9062)
- WRITE (6, 9065) XCHREP, XINREP, RETC
- END IF
- ELSE
- WRITE (6, 9063)
- WRITE (6, 9065) XCHREP, XINREP, RETC
- END IF
- ELSE
- WRITE (6, 9064)
- WRITE (6, 9065) XCHREP, XINREP, RETC
- END IF
-C
- GO TO 1000
-C
-C
- 1020 CONTINUE
- WRITE (6, 1021)
- 1021 FORMAT (' DMY11 ')
-C ===========
- XDMY11 = DMY11
- CALL CALDAT (IINDEX, XCHREP, XINREP, RETC)
- IF (RETC .EQ. 0) THEN
- IF (XCHREP .EQ. CHREP) THEN
- IF (XINREP(1) .EQ. BINREP(1) .AND.
- 2 XINREP(2) .EQ. BINREP(2) .AND.
- 3 XINREP(3) .EQ. BINREP(3) .AND.
- 4 XINREP(4) .EQ. BINREP(4) .AND.
- 5 XINREP(5) .EQ. BINREP(5) .AND.
- 6 XINREP(6) .EQ. BINREP(6) .AND.
- 7 XINREP(7) .EQ. BINREP(7) .AND.
- 8 XINREP(8) .EQ. BINREP(8) ) THEN
- WRITE (6, 9061)
- ELSE
- WRITE (6, 9062)
- WRITE (6, 9065) XCHREP, XINREP, RETC
- END IF
- ELSE
- WRITE (6, 9063)
- WRITE (6, 9065) XCHREP, XINREP, RETC
- END IF
- ELSE
- WRITE (6, 9064)
- WRITE (6, 9065) XCHREP, XINREP, RETC
- END IF
-C
- GO TO 1000
-C
- 1030 CONTINUE
- WRITE (6, 1031)
- 1031 FORMAT (' DMY9 ')
-C ===========
- XDMY9 = DMY9
- CALL CALDAT (IINDEX, XCHREP, XINREP, RETC)
- IF (RETC .EQ. 0) THEN
- IF (XCHREP .EQ. CHREP) THEN
- IF (XINREP(1) .EQ. BINREP(1) .AND.
- 2 XINREP(2) .EQ. BINREP(2) .AND.
- 3 XINREP(3) .EQ. BINREP(3) .AND.
- 4 XINREP(4) .EQ. BINREP(4) .AND.
- 5 XINREP(5) .EQ. BINREP(5) .AND.
- 6 XINREP(6) .EQ. BINREP(6) .AND.
- 7 XINREP(7) .EQ. BINREP(7) .AND.
- 8 XINREP(8) .EQ. BINREP(8) ) THEN
- WRITE (6, 9061)
- ELSE
- WRITE (6, 9062)
- WRITE (6, 9065) XCHREP, XINREP, RETC
- END IF
- ELSE
- WRITE (6, 9063)
- WRITE (6, 9065) XCHREP, XINREP, RETC
- END IF
- ELSE
- WRITE (6, 9064)
- WRITE (6, 9065) XCHREP, XINREP, RETC
- END IF
-C
- GO TO 1000
-C
-C
- 1040 CONTINUE
- WRITE (6, 1041)
- 1041 FORMAT (' DMY10 ')
-C ===========
- XDMY10 = DMY10
- CALL CALDAT (IINDEX, XCHREP, XINREP, RETC)
- IF (RETC .EQ. 0) THEN
- IF (XCHREP .EQ. CHREP) THEN
- IF (XINREP(1) .EQ. BINREP(1) .AND.
- 2 XINREP(2) .EQ. BINREP(2) .AND.
- 3 XINREP(3) .EQ. BINREP(3) .AND.
- 4 XINREP(4) .EQ. BINREP(4) .AND.
- 5 XINREP(5) .EQ. BINREP(5) .AND.
- 6 XINREP(6) .EQ. BINREP(6) .AND.
- 7 XINREP(7) .EQ. BINREP(7) .AND.
- 8 XINREP(8) .EQ. BINREP(8) ) THEN
- WRITE (6, 9061)
- ELSE
- WRITE (6, 9062)
- WRITE (6, 9065) XCHREP, XINREP, RETC
- END IF
- ELSE
- WRITE (6, 9063)
- WRITE (6, 9065) XCHREP, XINREP, RETC
- END IF
- ELSE
- WRITE (6, 9064)
- WRITE (6, 9065) XCHREP, XINREP, RETC
- END IF
-C
- GO TO 1000
-C
-C
- 1050 CONTINUE
- WRITE (6, 1051)
- 1051 FORMAT (' DMY8A ')
-C ===========
- XDMY8A = DMY8A
- CALL CALDAT (IINDEX, XCHREP, XINREP, RETC)
- IF (RETC .EQ. 0) THEN
- IF (XCHREP .EQ. CHREP) THEN
- IF (XINREP(1) .EQ. BINREP(1) .AND.
- 2 XINREP(2) .EQ. BINREP(2) .AND.
- 3 XINREP(3) .EQ. BINREP(3) .AND.
- 4 XINREP(4) .EQ. BINREP(4) .AND.
- 5 XINREP(5) .EQ. BINREP(5) .AND.
- 6 XINREP(6) .EQ. BINREP(6) .AND.
- 7 XINREP(7) .EQ. BINREP(7) .AND.
- 8 XINREP(8) .EQ. BINREP(8) ) THEN
- WRITE (6, 9061)
- ELSE
- WRITE (6, 9062)
- WRITE (6, 9065) XCHREP, XINREP, RETC
- END IF
- ELSE
- WRITE (6, 9063)
- WRITE (6, 9065) XCHREP, XINREP, RETC
- END IF
- ELSE
- WRITE (6, 9064)
- WRITE (6, 9065) XCHREP, XINREP, RETC
- END IF
-C
- GO TO 1000
-C
-C
- 1060 CONTINUE
- WRITE (6, 1061)
- 1061 FORMAT (' DMY8B ')
-C ===========
- XDMY8B = DMY8B
- CALL CALDAT (IINDEX, XCHREP, XINREP, RETC)
- IF (RETC .EQ. 0) THEN
- IF (XCHREP .EQ. CHREP) THEN
- IF (XINREP(1) .EQ. BINREP(1) .AND.
- 2 XINREP(2) .EQ. BINREP(2) .AND.
- 3 XINREP(3) .EQ. BINREP(3) .AND.
- 4 XINREP(4) .EQ. BINREP(4) .AND.
- 5 XINREP(5) .EQ. BINREP(5) .AND.
- 6 XINREP(6) .EQ. BINREP(6) .AND.
- 7 XINREP(7) .EQ. BINREP(7) .AND.
- 8 XINREP(8) .EQ. BINREP(8) ) THEN
- WRITE (6, 9061)
- ELSE
- WRITE (6, 9062)
- WRITE (6, 9065) XCHREP, XINREP, RETC
- END IF
- ELSE
- WRITE (6, 9063)
- WRITE (6, 9065) XCHREP, XINREP, RETC
- END IF
- ELSE
- WRITE (6, 9064)
- WRITE (6, 9065) XCHREP, XINREP, RETC
- END IF
-C
- GO TO 1000
-C
-C
- 1070 CONTINUE
- WRITE (6, 1071)
- 1071 FORMAT (' DMY6 ')
-C ===========
- XDMY6 = DMY6
- CALL CALDAT (IINDEX, XCHREP, XINREP, RETC)
- IF (RETC .EQ. 0) THEN
- IF (XCHREP .EQ. CHREP) THEN
- IF (XINREP(1) .EQ. BINREP(1) .AND.
- 2 XINREP(2) .EQ. BINREP(2) .AND.
- 3 XINREP(3) .EQ. BINREP(3) .AND.
- 4 XINREP(4) .EQ. BINREP(4) .AND.
- 5 XINREP(5) .EQ. BINREP(5) .AND.
- 6 XINREP(6) .EQ. BINREP(6) .AND.
- 7 XINREP(7) .EQ. BINREP(7) .AND.
- 8 XINREP(8) .EQ. BINREP(8) ) THEN
- WRITE (6, 9061)
- ELSE
- WRITE (6, 9062)
- WRITE (6, 9065) XCHREP, XINREP, RETC
- END IF
- ELSE
- WRITE (6, 9063)
- WRITE (6, 9065) XCHREP, XINREP, RETC
- END IF
- ELSE
- WRITE (6, 9064)
- WRITE (6, 9065) XCHREP, XINREP, RETC
- END IF
-C
- GO TO 1000
-C
-C
- 1080 CONTINUE
- WRITE (6, 1081)
- 1081 FORMAT (' YMD8 ')
-C ===========
- XYMD8 = YMD8
- CALL CALDAT (IINDEX, XCHREP, XINREP, RETC)
- IF (RETC .EQ. 0) THEN
- IF (XCHREP .EQ. CHREP) THEN
- IF (XINREP(1) .EQ. BINREP(1) .AND.
- 2 XINREP(2) .EQ. BINREP(2) .AND.
- 3 XINREP(3) .EQ. BINREP(3) .AND.
- 4 XINREP(4) .EQ. BINREP(4) .AND.
- 5 XINREP(5) .EQ. BINREP(5) .AND.
- 6 XINREP(6) .EQ. BINREP(6) .AND.
- 7 XINREP(7) .EQ. BINREP(7) .AND.
- 8 XINREP(8) .EQ. BINREP(8) ) THEN
- WRITE (6, 9061)
- ELSE
- WRITE (6, 9062)
- WRITE (6, 9065) XCHREP, XINREP, RETC
- END IF
- ELSE
- WRITE (6, 9063)
- WRITE (6, 9065) XCHREP, XINREP, RETC
- END IF
- ELSE
- WRITE (6, 9064)
- WRITE (6, 9065) XCHREP, XINREP, RETC
- END IF
-C
- GO TO 1000
-C
-C
- 1090 CONTINUE
- WRITE (6, 1091)
- 1091 FORMAT (' YMD6 ')
-C ===========
- XYMD6 = YMD6
- CALL CALDAT (IINDEX, XCHREP, XINREP, RETC)
- IF (RETC .EQ. 0) THEN
- IF (XCHREP .EQ. CHREP) THEN
- IF (XINREP(1) .EQ. BINREP(1) .AND.
- 2 XINREP(2) .EQ. BINREP(2) .AND.
- 3 XINREP(3) .EQ. BINREP(3) .AND.
- 4 XINREP(4) .EQ. BINREP(4) .AND.
- 5 XINREP(5) .EQ. BINREP(5) .AND.
- 6 XINREP(6) .EQ. BINREP(6) .AND.
- 7 XINREP(7) .EQ. BINREP(7) .AND.
- 8 XINREP(8) .EQ. BINREP(8) ) THEN
- WRITE (6, 9061)
- ELSE
- WRITE (6, 9062)
- WRITE (6, 9065) XCHREP, XINREP, RETC
- END IF
- ELSE
- WRITE (6, 9063)
- WRITE (6, 9065) XCHREP, XINREP, RETC
- END IF
- ELSE
- WRITE (6, 9064)
- WRITE (6, 9065) XCHREP, XINREP, RETC
- END IF
-C
- GO TO 1000
-C
-C
- 1100 CONTINUE
- WRITE (6, 1101)
- 1101 FORMAT (' MDY8 ')
-C ===========
- XMDY8 = MDY8
- CALL CALDAT (IINDEX, XCHREP, XINREP, RETC)
- IF (RETC .EQ. 0) THEN
- IF (XCHREP .EQ. CHREP) THEN
- IF (XINREP(1) .EQ. BINREP(1) .AND.
- 2 XINREP(2) .EQ. BINREP(2) .AND.
- 3 XINREP(3) .EQ. BINREP(3) .AND.
- 4 XINREP(4) .EQ. BINREP(4) .AND.
- 5 XINREP(5) .EQ. BINREP(5) .AND.
- 6 XINREP(6) .EQ. BINREP(6) .AND.
- 7 XINREP(7) .EQ. BINREP(7) .AND.
- 8 XINREP(8) .EQ. BINREP(8) ) THEN
- WRITE (6, 9061)
- ELSE
- WRITE (6, 9062)
- WRITE (6, 9065) XCHREP, XINREP, RETC
- END IF
- ELSE
- WRITE (6, 9063)
- WRITE (6, 9065) XCHREP, XINREP, RETC
- END IF
- ELSE
- WRITE (6, 9064)
- WRITE (6, 9065) XCHREP, XINREP, RETC
- END IF
-C
- GO TO 1000
-C
-C
- 1110 CONTINUE
- WRITE (6, 1111)
- 1111 FORMAT (' MDY6 ')
-C ===========
- XMDY6 = MDY6
- CALL CALDAT (IINDEX, XCHREP, XINREP, RETC)
- IF (RETC .EQ. 0) THEN
- IF (XCHREP .EQ. CHREP) THEN
- IF (XINREP(1) .EQ. BINREP(1) .AND.
- 2 XINREP(2) .EQ. BINREP(2) .AND.
- 3 XINREP(3) .EQ. BINREP(3) .AND.
- 4 XINREP(4) .EQ. BINREP(4) .AND.
- 5 XINREP(5) .EQ. BINREP(5) .AND.
- 6 XINREP(6) .EQ. BINREP(6) .AND.
- 7 XINREP(7) .EQ. BINREP(7) .AND.
- 8 XINREP(8) .EQ. BINREP(8) ) THEN
- WRITE (6, 9061)
- ELSE
- WRITE (6, 9062)
- WRITE (6, 9065) XCHREP, XINREP, RETC
- END IF
- ELSE
- WRITE (6, 9063)
- WRITE (6, 9065) XCHREP, XINREP, RETC
- END IF
- ELSE
- WRITE (6, 9064)
- WRITE (6, 9065) XCHREP, XINREP, RETC
- END IF
-C
- GO TO 1000
-C
-C
- 1120 CONTINUE
- WRITE (6, 1121)
- 1121 FORMAT (' YDM8 ')
-C ===========
- XYDM8 = YDM8
- CALL CALDAT (IINDEX, XCHREP, XINREP, RETC)
- IF (RETC .EQ. 0) THEN
- IF (XCHREP .EQ. CHREP) THEN
- IF (XINREP(1) .EQ. BINREP(1) .AND.
- 2 XINREP(2) .EQ. BINREP(2) .AND.
- 3 XINREP(3) .EQ. BINREP(3) .AND.
- 4 XINREP(4) .EQ. BINREP(4) .AND.
- 5 XINREP(5) .EQ. BINREP(5) .AND.
- 6 XINREP(6) .EQ. BINREP(6) .AND.
- 7 XINREP(7) .EQ. BINREP(7) .AND.
- 8 XINREP(8) .EQ. BINREP(8) ) THEN
- WRITE (6, 9061)
- ELSE
- WRITE (6, 9062)
- WRITE (6, 9065) XCHREP, XINREP, RETC
- END IF
- ELSE
- WRITE (6, 9063)
- WRITE (6, 9065) XCHREP, XINREP, RETC
- END IF
- ELSE
- WRITE (6, 9064)
- WRITE (6, 9065) XCHREP, XINREP, RETC
- END IF
-C
- GO TO 1000
-C
-C
- 1130 CONTINUE
- WRITE (6, 1131)
- 1131 FORMAT (' YDM6 ')
-C ===========
- XYDM6 = YDM6
- CALL CALDAT (IINDEX, XCHREP, XINREP, RETC)
- IF (RETC .EQ. 0) THEN
- IF (XCHREP .EQ. CHREP) THEN
- IF (XINREP(1) .EQ. BINREP(1) .AND.
- 2 XINREP(2) .EQ. BINREP(2) .AND.
- 3 XINREP(3) .EQ. BINREP(3) .AND.
- 4 XINREP(4) .EQ. BINREP(4) .AND.
- 5 XINREP(5) .EQ. BINREP(5) .AND.
- 6 XINREP(6) .EQ. BINREP(6) .AND.
- 7 XINREP(7) .EQ. BINREP(7) .AND.
- 8 XINREP(8) .EQ. BINREP(8) ) THEN
- WRITE (6, 9061)
- ELSE
- WRITE (6, 9062)
- WRITE (6, 9065) XCHREP, XINREP, RETC
- END IF
- ELSE
- WRITE (6, 9063)
- WRITE (6, 9065) XCHREP, XINREP, RETC
- END IF
- ELSE
- WRITE (6, 9064)
- WRITE (6, 9065) XCHREP, XINREP, RETC
- END IF
-C
- GO TO 1000
-C
-C
- 1140 CONTINUE
- WRITE (6, 1141)
- 1141 FORMAT (' YD5 ')
-C ===========
- XYD5 = YD5
- CALL CALDAT (IINDEX, XCHREP, XINREP, RETC)
- IF (RETC .EQ. 0) THEN
- IF (XCHREP .EQ. CHREP) THEN
- IF (XINREP(1) .EQ. BINREP(1) .AND.
- 2 XINREP(2) .EQ. BINREP(2) .AND.
- 3 XINREP(3) .EQ. BINREP(3) .AND.
- 4 XINREP(4) .EQ. BINREP(4) .AND.
- 5 XINREP(5) .EQ. BINREP(5) .AND.
- 6 XINREP(6) .EQ. BINREP(6) .AND.
- 7 XINREP(7) .EQ. BINREP(7) .AND.
- 8 XINREP(8) .EQ. BINREP(8) ) THEN
- WRITE (6, 9061)
- ELSE
- WRITE (6, 9062)
- WRITE (6, 9065) XCHREP, XINREP, RETC
- END IF
- ELSE
- WRITE (6, 9063)
- WRITE (6, 9065) XCHREP, XINREP, RETC
- END IF
- ELSE
- WRITE (6, 9064)
- WRITE (6, 9065) XCHREP, XINREP, RETC
- END IF
-C
- GO TO 1000
-C
-C
- 1150 CONTINUE
- WRITE (6, 1151)
- 1151 FORMAT (' BINREP ( 1, 2, 3) ')
-C =======================
- XINREP (1) = BINREP (1)
- XINREP (2) = BINREP (2)
- XINREP (3) = BINREP (3)
- CALL CALDAT (IINDEX, XCHREP, XINREP, RETC)
- IF (RETC .EQ. 0) THEN
- IF (XCHREP .EQ. CHREP) THEN
- IF (XINREP(1) .EQ. BINREP(1) .AND.
- 2 XINREP(2) .EQ. BINREP(2) .AND.
- 3 XINREP(3) .EQ. BINREP(3) .AND.
- 4 XINREP(4) .EQ. BINREP(4) .AND.
- 5 XINREP(5) .EQ. BINREP(5) .AND.
- 6 XINREP(6) .EQ. BINREP(6) .AND.
- 7 XINREP(7) .EQ. BINREP(7) .AND.
- 8 XINREP(8) .EQ. BINREP(8) ) THEN
- WRITE (6, 9061)
- ELSE
- WRITE (6, 9062)
- WRITE (6, 9065) XCHREP, XINREP, RETC
- END IF
- ELSE
- WRITE (6, 9063)
- WRITE (6, 9065) XCHREP, XINREP, RETC
- END IF
- ELSE
- WRITE (6, 9064)
- WRITE (6, 9065) XCHREP, XINREP, RETC
- END IF
-C
- GO TO 1000
-C
-C
- 1160 CONTINUE
- WRITE (6, 1161)
- 1161 FORMAT (' BINREP ( 4 ) ')
-C ==================
- IF ( RUN .NE. 1) THEN
- WRITE (6, 1162)
- 1162 FORMAT (' THIS ENTRY WORKS WITH DDD ONLY, AND ASSUMES',
- 1 ' "THIS YEAR". THEREFORE USELESS FOR THIS RUN')
- GO TO 1000
- END IF
-C
- XINREP (4) = BINREP (4)
- CALL CALDAT (IINDEX, XCHREP, XINREP, RETC)
- IF (RETC .EQ. 0) THEN
- IF (XCHREP .EQ. CHREP) THEN
- IF (XINREP(1) .EQ. BINREP(1) .AND.
- 2 XINREP(2) .EQ. BINREP(2) .AND.
- 3 XINREP(3) .EQ. BINREP(3) .AND.
- 4 XINREP(4) .EQ. BINREP(4) .AND.
- 5 XINREP(5) .EQ. BINREP(5) .AND.
- 6 XINREP(6) .EQ. BINREP(6) .AND.
- 7 XINREP(7) .EQ. BINREP(7) .AND.
- 8 XINREP(8) .EQ. BINREP(8) ) THEN
- WRITE (6, 9061)
- ELSE
- WRITE (6, 9062)
- WRITE (6, 9065) XCHREP, XINREP, RETC
- END IF
- ELSE
- WRITE (6, 9063)
- WRITE (6, 9065) XCHREP, XINREP, RETC
- END IF
- ELSE
- WRITE (6, 9064)
- WRITE (6, 9065) XCHREP, XINREP, RETC
- END IF
-C
- GO TO 1000
-C
-C
- 1170 CONTINUE
- WRITE (6, 1171)
- 1171 FORMAT (' BINREP ( 5 ) ')
-C ==================
- XINREP (5) = BINREP (5)
- CALL CALDAT (IINDEX, XCHREP, XINREP, RETC)
- IF (RETC .EQ. 0) THEN
- IF (XCHREP .EQ. CHREP) THEN
- IF (XINREP(1) .EQ. BINREP(1) .AND.
- 2 XINREP(2) .EQ. BINREP(2) .AND.
- 3 XINREP(3) .EQ. BINREP(3) .AND.
- 4 XINREP(4) .EQ. BINREP(4) .AND.
- 5 XINREP(5) .EQ. BINREP(5) .AND.
- 6 XINREP(6) .EQ. BINREP(6) .AND.
- 7 XINREP(7) .EQ. BINREP(7) .AND.
- 8 XINREP(8) .EQ. BINREP(8) ) THEN
- WRITE (6, 9061)
- ELSE
- WRITE (6, 9062)
- WRITE (6, 9065) XCHREP, XINREP, RETC
- END IF
- ELSE
- WRITE (6, 9063)
- WRITE (6, 9065) XCHREP, XINREP, RETC
- END IF
- ELSE
- WRITE (6, 9064)
- WRITE (6, 9065) XCHREP, XINREP, RETC
- END IF
-C
- GO TO 1000
-C
-C
- 1180 CONTINUE
- WRITE (6, 1181)
- 1181 FORMAT (' BINREP ( 6 ) ')
-C ==================
- XINREP (6) = BINREP (6)
- CALL CALDAT (IINDEX, XCHREP, XINREP, RETC)
- IF (RETC .EQ. 0) THEN
- IF (XCHREP .EQ. CHREP) THEN
- IF (XINREP(1) .EQ. BINREP(1) .AND.
- 2 XINREP(2) .EQ. BINREP(2) .AND.
- 3 XINREP(3) .EQ. BINREP(3) .AND.
- 4 XINREP(4) .EQ. BINREP(4) .AND.
- 5 XINREP(5) .EQ. BINREP(5) .AND.
- 6 XINREP(6) .EQ. BINREP(6) .AND.
- 7 XINREP(7) .EQ. BINREP(7) .AND.
- 8 XINREP(8) .EQ. BINREP(8) ) THEN
- WRITE (6, 9061)
- ELSE
- WRITE (6, 9062)
- WRITE (6, 9065) XCHREP, XINREP, RETC
- END IF
- ELSE
- WRITE (6, 9063)
- WRITE (6, 9065) XCHREP, XINREP, RETC
- END IF
- ELSE
- WRITE (6, 9064)
- WRITE (6, 9065) XCHREP, XINREP, RETC
- END IF
-C
- GO TO 1000
-C
-C
- 1190 CONTINUE
- WRITE (6, 1191)
- 1191 FORMAT (' BINREP ( 3 AND 4 ) ')
-C ==========================
- XINREP (3) = BINREP (3)
- XINREP (4) = BINREP (4)
- CALL CALDAT (IINDEX, XCHREP, XINREP, RETC)
- IF (RETC .EQ. 0) THEN
- IF (XCHREP .EQ. CHREP) THEN
- IF (XINREP(1) .EQ. BINREP(1) .AND.
- 2 XINREP(2) .EQ. BINREP(2) .AND.
- 3 XINREP(3) .EQ. BINREP(3) .AND.
- 4 XINREP(4) .EQ. BINREP(4) .AND.
- 5 XINREP(5) .EQ. BINREP(5) .AND.
- 6 XINREP(6) .EQ. BINREP(6) .AND.
- 7 XINREP(7) .EQ. BINREP(7) .AND.
- 8 XINREP(8) .EQ. BINREP(8) ) THEN
- WRITE (6, 9061)
- WRITE (6, 9065) XCHREP, XINREP, RETC
- ELSE
- WRITE (6, 9062)
- WRITE (6, 9065) XCHREP, XINREP, RETC
- END IF
- ELSE
- WRITE (6, 9063)
- WRITE (6, 9065) XCHREP, XINREP, RETC
- END IF
- ELSE
- WRITE (6, 9064)
- WRITE (6, 9065) XCHREP, XINREP, RETC
- END IF
-C
-C END OF ONE CALDAT INPUT FORMAT
-C
- 1000 CONTINUE
-C
-C END OF RUN
-C
-10000 CONTINUE
-C
- 9000 STOP
-C
- 9061 FORMAT (' OKAY')
- 9062 FORMAT (' BINREP FAULTY')
- 9063 FORMAT (' CHREP FAULTY')
- 9064 FORMAT (' RETURN CODE > 0 ')
- 9065 FORMAT (' CHREP ', A119, /,
- * ' BINREP ', 4I10, 2X, Z8, 3I10 /,
- * ' ERROR CODE =', I10)
- END
diff --git a/src/packlib/kernlib/kernbit/test/z100t.F b/src/packlib/kernlib/kernbit/test/z100t.F
deleted file mode 100644
index bc64abc..0000000
--- a/src/packlib/kernlib/kernbit/test/z100t.F
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: z100t.F,v 1.2 1997/02/04 17:34:01 mclareni Exp $
-*
-* $Log: z100t.F,v $
-* Revision 1.2 1997/02/04 17:34:01 mclareni
-* Merge Winnt and 97a versions
-*
-* Revision 1.1.1.1 1996/02/15 17:47:55 mclareni
-* Kernlib
-*
-*
-#include "kernbit/pilot.h"
- SUBROUTINE Z100T
- INTEGER NAME(2)
- CALL KBHDR('Z100 JOBNAM')
- CALL JOBNAM(NAME)
- PRINT 1000,NAME
-1000 FORMAT(6X,'Batch process name: ',2A4)
- RETURN
- END
diff --git a/src/packlib/kernlib/kernbit/test/z265t.F b/src/packlib/kernlib/kernbit/test/z265t.F
deleted file mode 100644
index e6251f1..0000000
--- a/src/packlib/kernlib/kernbit/test/z265t.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: z265t.F,v 1.1.1.1 1996/02/15 17:47:55 mclareni Exp $
-*
-* $Log: z265t.F,v $
-* Revision 1.1.1.1 1996/02/15 17:47:55 mclareni
-* Kernlib
-*
-*
-#include "kernbit/pilot.h"
- SUBROUTINE Z265T
- REAL*8 D,T1,T2
- DATA ILAPSE/10/
- CALL KBHDR('Z265 SLEEPF')
- CALL DATIMH(D,T1)
- PRINT 1000,D,T1,ILAPSE
- CALL SLEEPF(ILAPSE)
- CALL DATIMH(D,T2)
- PRINT 1000,D,T2,ILAPSE
-1000 FORMAT(6X,'Current date/time: ',2A10,' sleeping',I5,' sec')
- RETURN
- END
diff --git a/src/packlib/kernlib/kernbit/test/z268t.F b/src/packlib/kernlib/kernbit/test/z268t.F
deleted file mode 100644
index 599c05c..0000000
--- a/src/packlib/kernlib/kernbit/test/z268t.F
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: z268t.F,v 1.2 1996/09/20 14:37:04 cernlib Exp $
-*
-* $Log: z268t.F,v $
-* Revision 1.2 1996/09/20 14:37:04 cernlib
-* mods for Linux
-*
-* Revision 1.1.1.1 1996/02/15 17:47:55 mclareni
-* Kernlib
-*
-*
-#include "kernbit/pilot.h"
-#if (defined(CERNLIB_UNIX))&&(!defined(CERNLIB_OS9))
- SUBROUTINE Z268T
- CHARACTER*128 COMMAND
- CHARACTER*128 BUFFER
- INTEGER LEN
- INTEGER NL
- INTEGER NC
- INTEGER RC
- INTEGER OV
-
- CALL KBHDR('Z268 SYSTEMS')
-#ifndef CERNLIB_LINUX
- COMMAND='ls 2>&1 \0'
-#else
- COMMAND='ls 2>&1 '
-#endif
- LEN = 128
- CALL SYSTEMS(COMMAND,BUFFER,LEN,NL,NC,RC,OV)
- WRITE (*, *) "Number of chars: ",NC
- WRITE (*, *) "Number of lines: ",NL
- WRITE (*, *) "returned code:",RC
- IF (OV.GT.0) THEN
- WRITE (*, *) "buffer is overflowed"
- ENDIF
- WRITE (6, *) "Buffer content :"
- WRITE (6, *) '>'//BUFFER(1:NC)//'<'
- RETURN
- END
-#endif
diff --git a/src/packlib/kernlib/kernbit/test/z305t.F b/src/packlib/kernlib/kernbit/test/z305t.F
deleted file mode 100644
index 2c4d832..0000000
--- a/src/packlib/kernlib/kernbit/test/z305t.F
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: z305t.F,v 1.1.1.1 1996/02/15 17:47:55 mclareni Exp $
-*
-* $Log: z305t.F,v $
-* Revision 1.1.1.1 1996/02/15 17:47:55 mclareni
-* Kernlib
-*
-*
-#include "kernbit/pilot.h"
-#if defined(CERNLIB_IBMVM)
- SUBROUTINE Z305T
- CHARACTER*40 STRING
- DATA STRING/'NULL LINE'/
- CALL KBHDR('Z305 VMSTAK')
- CALL VMSTAK(STRING,'L',IRC)
- PRINT 1000,IRC,STRING
-1000 FORMAT(6X,'RC=',I3,' after putting on the stack: ',A)
- RETURN
- END
-#endif
diff --git a/src/packlib/kernlib/kernbit/test/z307t.F b/src/packlib/kernlib/kernbit/test/z307t.F
deleted file mode 100644
index e5b5054..0000000
--- a/src/packlib/kernlib/kernbit/test/z307t.F
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: z307t.F,v 1.1.1.1 1996/02/15 17:47:55 mclareni Exp $
-*
-* $Log: z307t.F,v $
-* Revision 1.1.1.1 1996/02/15 17:47:55 mclareni
-* Kernlib
-*
-*
-#include "kernbit/pilot.h"
-#if defined(CERNLIB_IBMVM)
- SUBROUTINE Z307T
- DIMENSION SPACE(32)
- LOGICAL BATCH ,JOB$VM
- CHARACTER*8 INFO(10),MACHTP(3)
- EQUIVALENCE (INFO(1),SPACE( 1))
- EQUIVALENCE (TIME ,SPACE(21))
- EQUIVALENCE (TNORM ,SPACE(23))
- EQUIVALENCE (MACH ,SPACE(25))
- DATA MACHTP/'Unknown','370','XA'/
-C
- CALL KBHDR('Z307 JOB$VM')
- BATCH = JOB$VM(SPACE)
- PRINT 1000,MACHTP(MACH+1),BATCH
- PRINT 1001,TIME,TNORM
- PRINT 1002,(INFO(N),N=1,10)
-1000 FORMAT(6X,'Running on ',A,' machine in Batch? ',I2)
-1001 FORMAT(6X,'CPU time: ',F11.2,' sc. Normalization factor: ',F7.2)
-1002 FORMAT((4X,5(2X,A8)))
- RETURN
- END
-#endif
diff --git a/src/packlib/kernlib/kernbit/test/z313t.F b/src/packlib/kernlib/kernbit/test/z313t.F
deleted file mode 100644
index 83d246e..0000000
--- a/src/packlib/kernlib/kernbit/test/z313t.F
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: z313t.F,v 1.1.1.1 1996/02/15 17:47:55 mclareni Exp $
-*
-* $Log: z313t.F,v $
-* Revision 1.1.1.1 1996/02/15 17:47:55 mclareni
-* Kernlib
-*
-*
-#include "kernbit/pilot.h"
-#if defined(CERNLIB_IBMVM)||defined(CERNLIB_VAXVMS)
- SUBROUTINE Z313T
- COMMON/Z313IN/JINFO(20,2)
-#if defined(CERNLIB_IBMVM)
- CHARACTER*8 JOBINFO,INFO,JINFO
-#endif
-#if defined(CERNLIB_VAXVMS)
- CHARACTER*15 JOBINFO,INFO,JINFO
-#endif
-C
- CALL KBHDR('Z313 JOBINFO')
-C
- INFO =JOBINFO('CPUTIME')
- TIME =ICHARN(INFO)
- INFO =JOBINFO('CPUFACT')
- TNORM=ICHARN(INFO)/100
- PRINT 1001,TIME,TNORM
- PRINT 1002,JINFO
-1001 FORMAT(6X,'CPU time: ',F11.2,' sc. Normalization factor: ',F7.2)
-1002 FORMAT((4X,5(2X,A)))
- RETURN
- END
-#endif
diff --git a/src/packlib/kernlib/kernbit/whichm/Imakefile b/src/packlib/kernlib/kernbit/whichm/Imakefile
deleted file mode 100644
index 2ce812c..0000000
--- a/src/packlib/kernlib/kernbit/whichm/Imakefile
+++ /dev/null
@@ -1,4 +0,0 @@
-SRCS_F= \ @@\
- wuix.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kernbit/whichm/wuix.F b/src/packlib/kernlib/kernbit/whichm/wuix.F
deleted file mode 100644
index 175280e..0000000
--- a/src/packlib/kernlib/kernbit/whichm/wuix.F
+++ /dev/null
@@ -1,39 +0,0 @@
-*
-* $Id: wuix.F,v 1.1.1.1 1996/02/15 17:47:54 mclareni Exp $
-*
-* $Log: wuix.F,v $
-* Revision 1.1.1.1 1996/02/15 17:47:54 mclareni
-* Kernlib
-*
-*
-#include "kernbit/pilot.h"
-#if defined(CERNLIB_UNIX)
- PROGRAM WHICH
-*
-* CERN PROGLIB# Z265 WHICHM .VERSION KERNBIT 1.09 920701
-* Author: Jamie Shiers
-* FORTRAN version of Unix which command
-*
- CHARACTER*255 CHPATH,CHPROG,CHFILE
-
- COMMON/SLATE/IS(40)
-
- CALL GETENVF('PATH',CHPATH)
- LPATH = IS(1)
-
- NARGS = IARGC(DUMMY)
- IF(NARGS.EQ.1) THEN
- CALL GETARG(1,CHPROG)
- CALL WHICHF(CHPATH,CHPROG,CHFILE)
- IF(IS(1).GT.0) THEN
- PRINT *,CHFILE(1:IS(1))
- ELSE
- PRINT *,'No ',CHPROG(1:LENOCC(CHPROG)),' found in ',
- + CHPATH(1:LPATH)
- ENDIF
- ELSE
- PRINT *,'usage: which <command>'
- ENDIF
-
- END
-#endif
diff --git a/src/packlib/kernlib/kernbit/z009/Imakefile b/src/packlib/kernlib/kernbit/z009/Imakefile
deleted file mode 100644
index 941b474..0000000
--- a/src/packlib/kernlib/kernbit/z009/Imakefile
+++ /dev/null
@@ -1,4 +0,0 @@
-SRCS_F= \ @@\
- caldat.F cdmon.F cleap.F cydiy.F cyear4.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kernbit/z009/caldat.F b/src/packlib/kernlib/kernbit/z009/caldat.F
deleted file mode 100644
index 336a5da..0000000
--- a/src/packlib/kernlib/kernbit/z009/caldat.F
+++ /dev/null
@@ -1,953 +0,0 @@
-*
-* $Id: caldat.F,v 1.3 2000/01/06 11:01:15 mclareni Exp $
-*
-* $Log: caldat.F,v $
-* Revision 1.3 2000/01/06 11:01:15 mclareni
-* Y2K corrections from Otto Hell
-*
-* Revision 1.2 1996/12/12 13:49:25 cernlib
-* Caldat mods from O. Hell to cater for the year 2000
-*
-* Revision 1.1.1.1 1996/02/15 17:47:51 mclareni
-* Kernlib
-*
-*
-#include "kernbit/pilot.h"
- SUBROUTINE CALDAT (IINDEX, CHREP, BINREP, RETC)
-C
-CC
-CCC This is the calendar date routine to end all calendar date routines.
-CC
-C It takes any calendar date represention and produces from it
-C simultaneously many other calendar date representaions, plus a few
-C extra informations.
-C CALDAT proper is written in IBM /360 Assembler and is reentrant.
-C This FORTRAN version has been created for portability in the science
-C community, and is not reentrant.
-C CALDAT proper delivers the IBM /360 machine date for today, with
-C - hopefully - correct century.
-C This FORTRAN version relies on DATIME and its COMMON/SLATE/ISL(1),
-C which is documented in the CERNLIB manual as being 19yy, but which
-C I "may assume to return the correct date", as I am assured by CERN.
-C
-C
-C AUTHOR: O. HELL, DESY, MARCH 1983
-C FORTRAN 77 VERSION: MAY 1984
-C Changes: Hell, November 1996:
-C * Correct ouput of BINREP(5) = packed decimal format
-C * Employing COMMON/SLATE/ISL(1), assuming it to return the
-C correct date rather than 19yy
-C * improved guessing of 4-digit year from 2-digit year, see
-C internal routine CYEAR4
-C * 2-digit year in formats DMY9 and DMY8A with leading 0, e.g
-C 22 NOV 06 and 22.11.06 rather than
-C 22 NOV 6 and 22.11. 6
-C
-C
-C EXTERNAL ROUTINE CALLED:
-C DATIME FROM KERNLIB, RETURNS TODAY'S DATE
-C
-C INTERNAL ROUTINES AND FUNCTIONS:
-C NAME R/F INPUT OUTPUTS
-C CDMON R DAY IN YEAR MONTH AND DAY IN MONTH
-C CLEAP F YEAR LEAP = WHETHER LEAPYEAR OR NOT
-C CYDIY R JULIAN DATE YEAR, LEAP, DAY IN YEAR
-C CYEAR4 F YEAR LIKE 84 YEAR LIKE 1984
-C
-C
-CC
-CC
-CCC THE REPRESENTATIONS
-CC
-C TWO ARGUMENTS ARE USED FOR THE PASSING OF THE CALENDAR DATES: A
-C CHARACTER STRING AND AN ARRAY OF FULL WORDS.
-C THE VARIOUS REPRESENTATIONS ARE NUMBERED, AND AN INPUT PARAMETER
-C ('INPUT INDEX') SPECIFIES THE REPRESENTATION CONTAINING THE INPUT
-C CALENDAR DATE.
-C AN EXTRA OUTPUT PARAMETER RECEIVES A RETURNCODE.
-C SPECIAL CASES: INPUT INDEX = 0 DESIGNATES 'TODAY'.
-C INPUT YEAR YEAR2, RATHER THAN YEAR, IN CERTAIN INPUT
-C FIELDS DESIGNATES 'THIS CENTURY'.
-C INPUT INDEX OR INPUT DATA INVALID:
-C OUTPUT CHARACTER STRING WITH ALL '*',
-C OUTPUT NUMBERS ALL X'81818181'
-C = -2 122 219 135
-C
-C ONE OF THE ARRAY ELEMENTS CONTAINS THE JULIAN DATE (= DAYS SINCE
-C 1.JAN. 1 , WITHOUT GREGOR'S PAUSE) WHICH, BEING A PURE INTEGER
-C NUMBER, IS ESPECIALLY WELL SUITED FOR ARITHMETICAL CALCULATIONS.
-C
-C
-C (ANY $ APPEARING IN THE FOLLOWING TEXT DESIGNATES AN AREA TO BE
-C MODIFIED WHEN NEW REPRSENTATIONS ARE TO BE ADDED. INSTRUCTIONS
-C FOLLOW AT THE END OF THIS CODE.)
-C
-C
-C
-C
-CC CALL FROM FORTRAN 77:
-C
-C $
- INTEGER IINDEX, BINREP(8), RETC
- CHARACTER CHREP*119
-C CHARACTER DMY14*14, DMY11*11, DMY9*9, DMY10*10
-C CHARACTER*8 DMY8A, DMY8B, YMD8, MDY8, YDM8
-C CHARACTER*6 DMY6, YMD6, MDY6, YDM6
-C CHARACTER YD5*5, W4*4, W2*2
-C
-C EQUIVALENCE (CHREP( 1: 14), DMY14), (CHREP( 15: 25), DMY11),
-C * (CHREP( 26: 34), DMY9 ), (CHREP( 35: 44), DMY10),
-C * (CHREP( 45: 52), DMY8A), (CHREP( 53: 60), DMY8B),
-C * (CHREP( 61: 66), DMY6 ), (CHREP( 67: 74), YMD8 ),
-C * (CHREP( 75: 80), YMD6 ), (CHREP( 81: 88), MDY8 ),
-C * (CHREP( 89: 94), MDY6 ), (CHREP( 95:102), YDM8 ),
-C * (CHREP(103:108), YDM6 ), (CHREP(109:113), YD5 ),
-C * (CHREP(114:117), W4 ), (CHREP(118:119), W2 )
-C $
-C DMY11 = '16 APR 1982'
-C IINDEX = 2
-C CALL CALDAT (IINDEX, CHREP, BINREP, RETC)
-C
-C
-C EXAMPLE FOR THE NAMES AND THEIR POSSIBLE VALUES
-C NAME VALUE IINDEX (INPUT INDEX: VALUE TO MAKE
-C THIS FIELD THE INPUT FIELD)
-C 12345678901234
-C DMY14 16. APRIL 1982 1
-C DMY11 16 APR 1982 2
-C DMY9 16 APR 82 3
-C DMY10 16. 4.1982 4
-C DMY8A 16. 4.82 5
-C DMY8B 16/04/82 6
-C DMY6 160482 7
-C YMD8 82/04/16 8
-C YMD6 820416 9
-C MDY8 04/16/82 10
-C MDY6 041682 11
-C YDM8 82/16/04 12
-C YDM6 821604 13
-C YD5 82106 14
-C W4 FRI.
-C W2 FR
-C 12345678901234
-C
-C
-C NAMES OF THE MONTHS AND THE WEEK DAYS STRINGS,
-C BOTH SHORT AND LONG:
-C
- CHARACTER*3 MONNS (12)
- CHARACTER*5 MONNL (12)
- CHARACTER*2 DAYNS (0:6)
- CHARACTER*4 DAYNL (0:6)
- INTEGER LYEAR (2)
- INTEGER MONTAB (12,2)
-C
-C
-C NUMBER REPRESENTATIONS
-C
-C BINREP-
-C ELEMENT CONTENTS TYPE EXAMPLE IINDEX
-C
-C 1,2,3 D, M, Y BINARY 16, 4, 1982 101
-C 4 DAY IN THE YEAR BINARY 106 102
-C 5 00YYDDDC PACKED DEC 0082106C 103
-C 6 JULIAN DATE BINARY 723651 104
-C = DAYS SINCE 1.JAN. 1 , WITHOUT GREGOR'S PAUSE
-C 7 WEEKDAY, MO = 0, ETC BINARY 4
-C 8 WEEK IN THE YEAR BINARY 15
-C WEEK 1 CONTAINS THE 1ST THURSDAY IN THE YEAR.
-C (ACCORDING TO DIN = DEUTSCHE INDUSTRIE-NORM)
-C
-C ADDITIONAL INPUT SPECIFICATION:
-C 3,4 Y, DAY IN YEAR BINARY 1982, 106 105
-C
-C
-C
-C
-CC CALL FROM FORTRAN IV:
-C
-C $ INTEGER IINDEX, BINREP(8), RETC
-C $ LOGICAL*1 CHREP(119),
-C * DMY14(14), DMY11(11), DMY9 ( 9), DMY10(10), DMY8A( 8),
-C * DMY8B( 8), DMY6 ( 6), YMD8 ( 8), YMD6 ( 6), MDY8 ( 8),
-C * MDY6 ( 6), YDM8 ( 8), YDM6 ( 6), YD5 ( 5), W4 ( 4),
-C $ * W2 ( 2)
-C EQUIVALENCE (CHREP( 1), DMY14(1)), (CHREP( 15), DMY11(1)),
-C * (CHREP( 26), DMY9 (1)), (CHREP( 35), DMY10(1)),
-C * (CHREP( 45), DMY8A(1)), (CHREP( 53), DMY8B(1)),
-C * (CHREP( 61), DMY6 (1)), (CHREP( 67), YMD8 (1)),
-C * (CHREP( 75), YMD6 (1)), (CHREP( 81), MDY8 (1)),
-C * (CHREP( 89), MDY6 (1)), (CHREP( 95), YDM8 (1)),
-C * (CHREP(103), YDM6 (1)), (CHREP(109), YD5 (1)),
-C $ * (CHREP(114), W4 (1)), (CHREP(118), W2 (1))
-C
-C DATA DMY11 /'16 APR 1982'/, IINDEX /2/
-C CALL CALDAT (IINDEX, CHREP, BINREP, RETC)
-C
-C
-C MEANING OF THE STRINGS AND ARRAY ELEMENTS AS WELL AS NAMES OF THE
-C MONTHS STRINGS AND EXAMPLES SEE FORTRAN 77
-C
-C
-C
-CC
-CCC MEANING OF RETURN CODE (RETC, ARGUMENT 4)
-C
-C
-C RETC MEANING
-C 0 EVERYTHING FINE
-C 4 IINDEX < 0
-C 8 UPPER BOUND FOR CHREP < IINDEX < LOWER BOUND FOR BINREP
-C 12 UPPER BOUND FOR BINREP < IINDEX
-C 16 DDD OUT OF BOUNDS
-C 20 MM | DD OUT OF BOUNDS
-C 24 YEAR OUT OF BOUNDS
-C 1001 SYNTAX ERROR IN DMY14 IINDEX = 1
-C 1002 SYNTAX ERROR IN DMY11 2
-C 1003 SYNTAX ERROR IN DMY9 3
-C 1004 SYNTAX ERROR IN DMY10 4
-C 1005 SYNTAX ERROR IN DMY8A 5
-C 1006 SYNTAX ERROR IN DMY8B 6
-C 1007 SYNTAX ERROR IN DMY6 7
-C 1008 SYNTAX ERROR IN YMD8 8
-C 1009 SYNTAX ERROR IN YMD6 9
-C 1010 SYNTAX ERROR IN MDY8 10
-C 1011 SYNTAX ERROR IN MDY6 11
-C 1012 SYNTAX ERROR IN YDM8 12
-C 1013 SYNTAX ERROR IN YDM6 13
-C 1014 SYNTAX ERROR IN YD5 14
-C $
-C 1103 SYNTAX ERROR IN JULIUS 103
-C 1104 SYNTAX ERROR IN JULIAN 104
-C $
-C
-CC
-CC
-CCC BEGINNING
-CC
-CC
-C
-C
-CC CONSTANTS
-C
-C
-C For use with DATIME:
- COMMON /SLATE/ ISL(40)
-C
- INTEGER Z10E6, Z10E5, Z10000, Z1000, Z100, Z10, ZE, ZC, Z81X4
- PARAMETER ( Z10E6 = 16**6, Z10E5 = 16**5, Z10000 = 16**4,
- * Z1000 = 16**3, Z100 = 16**2,
- * Z10 = 16, ZE = 14, ZC = 12,
- * Z81X4 = -2 122 219 135 )
-C -2 122 219 135 = HEX 81818181
-C
- INTEGER KINXBL
- PARAMETER ( KINXBL = 101 )
-C $ KINXCH 14 HIGHEST IINDEX FOR CHAR REPRES.
-C KINXBL 101 LOWEST IINDEX FOR BIN REPRES.
-C $ KINXBH 105 HIGHEST IINDEX FOR BIN REPRES.
-C
-C
-CC VARIABLES
-CC
-C
-C
-C IMPORTANT LOCAL REGISTERS
- INTEGER LEAP, YEAR, YEAR2, MONTH, DAY, DIY, JULIAN
-C
-C LEAP 1 OR 2 NORMAL YEAR OR LEAP YEAR
-C YEAR E.G. 1984 (and then YEAR2 = 84)
-C MONTH 1 .. 12
-C DAY 1 .. 31 DAY IN MONTH
-C DIY 1 .. 366 DAY IN YEAR
-C JULIAN > 0 JULIAN DATE = DAYS SINCE 1. JAN. 1
-C
-C
-C INTERNAL FUNCTIONS
- INTEGER CLEAP, CYEAR4
-C
-C
-C SHORT RANGE VARIABLES
- INTEGER I, J, K
-C
-C
-CC NORMAL YEAR / LEAP YEAR DATA
-C
-C DAYS IN THE MONTHS
- INTEGER DAYTAB (12,2)
-C DAYS IN THE YEAR
-C (COPY IN ROUTINE CYDIY)
- DATA LYEAR / 365, 366 /
-C
-C DAYS IN THE MONTHS ACCUMULATED
-C (COPY OF THIS TABLE IN CDMON)
- DATA MONTAB /
- * 000, 031, 059, 090, 120, 151, 181, 212, 243, 273, 304, 334,
- * 000, 031, 060, 091, 121, 152, 182, 213, 244, 274, 305, 335 /
-C
-C DAYS IN THE MONTHS
- DATA DAYTAB /
- * 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31,
- * 31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 /
-C
- DATA MONNS /
- * 'JAN', 'FEB', 'MAR', 'APR', 'MAY', 'JUN',
- * 'JUL', 'AUG', 'SEP', 'OCT', 'NOV', 'DEC' /
-C
- DATA MONNL /
- * 'JAN. ', 'FEB. ', 'MARCH', 'APRIL', 'MAY ', 'JUNE ',
- * 'JULY ', 'AUG. ', 'SEPT.', 'OCT. ', 'NOV. ', 'DEC. ' /
-C
- DATA DAYNS /
- * 'MO', 'TU', 'WE', 'TH', 'FR', 'SA', 'SU' /
-C
- DATA DAYNL /
- * 'MON.', 'TUE.', 'WED.', 'THUR', 'FRI.', 'SAT.', 'SUN.' /
-C
-C
-C
-CC
-CC
-CCC IINDEX, CHECKS AND BRANCH TO CORRESPONDING INPUT ROUTINE
-CC
-C
-C THIS OUGHT TO BE A CASE STATEMENT:
-C
- IF ( IINDEX .LT. 0 ) GO TO 80004
-C
- IF ( IINDEX .EQ. 0 ) GO TO 10000
-C $
- GO TO ( 10010, 10020, 10030, 10040, 10050, 10060, 10070,
- * 10080, 10090, 10100, 10110, 10120, 10130, 10140 ), IINDEX
-C
-C IINDEX IS GREATER THAN KINXCH.
-C
- IF ( IINDEX .LT. KINXBL ) GO TO 80008
-C $
- GO TO ( 11010, 11020, 11030, 11040, 11050 ), IINDEX - 100
-C
-C IINDEX IS GREATER THAN KINXBH.
-C
- GO TO 80012
-C
-C
-CC
-CC
-CC AFTER BRANCHING WITH IINDEX THE INPUT DATA IS INTERPRETED.
-CC THEN YEAR, YEAR2, MONTH, DAY, LEAP, DIY, AND JULIAN ARE
-CC DETERMINED.
-CC AFTER THAT, ALL THE OTHER REPRESENTATIONS ARE PRODUCED.
-CC
-C
-CC
-CC
-CCC INPUT DATE = TODAY, IINDEX = 0 'ROUTINE INX0'
-CC
-C NO SYNTAX CHECKS NECESSARY
-10000 CONTINUE
- CALL DATIME (K, I)
-C K = YYMMDD, I = HHMM; TIME NOT USED.
-C
- YEAR = ISL (1)
- I = K / 100
- DAY = K - I * 100
- YEAR2 = I / 100
- MONTH = I - YEAR2 * 100
-C YEAR -> LEAP, DIY, JULIAN
- GO TO 18230
-C
-C
-CC
-CC 'ROUTINE INX1'
-CCC INPUT DATE = '16. APRIL 1982', FIELD CHREP( 1: 14), IINDEX = 1
-CC SUBSTR 12345678901234 DMY14
-C SYNTAX CHECKS
-10010 CONTINUE
- IF ( CHREP ( 3: 3) .NE. '.' .OR.
- * CHREP ( 4: 4) .NE. ' ' .OR.
- * CHREP (10:10) .NE. ' ' ) GO TO 81001
-C
-C THIS AND ALL FOLLOWING READ STATEMENTS USE IOSTAT= RATHER THAN
-C ERR= BECAUSE THE SIEMENS FORTRAN 77 COMPILER DOESN'T ACCEPT ERR=
-C IN READ A STATEMENT ON AN INTERNAL FILE.
-C NO PROBLEM WITH THE IBM VS FORTRAN COMPILER.
-C DECODE DAY
- READ ( CHREP, '(I2)', IOSTAT=K ) DAY
- IF ( K .NE. 0 ) GO TO 81001
-C DECODE MONTH
- DO 10011, MONTH = 1, 12
- IF ( CHREP (5:9) .EQ. MONNL (MONTH) ) GO TO 10012
-10011 CONTINUE
-C MONTH NOT IDENTIFIED:
- GO TO 80020
-10012 CONTINUE
-C DECODE YEAR
- READ ( CHREP (11:14), '(I4)', IOSTAT=K ) YEAR
- IF ( K .NE. 0 ) GO TO 81001
-C LEAP, DIY, JULIAN
- YEAR2 = YEAR - (YEAR/100)*100
-C YEAR -> LEAP, DIY, JULIAN
- GO TO 18230
-C
-C
-CC
-CC 'ROUTINE INX2'
-CCC INPUT DATE = '16 APR 1982', FIELD CHREP( 15: 25), IINDEX = 2
-CC SUBSTR 56789012345 DMY11
-C SYNTAX CHECKS
-10020 CONTINUE
- IF ( CHREP (17:17) .NE. ' ' .OR.
- * CHREP (21:21) .NE. ' ' ) GO TO 81002
-C
-C DECODE DAY
- READ ( CHREP (15:16), '(I2)', IOSTAT=K ) DAY
- IF ( K .NE. 0 ) GO TO 81002
-C DECODE MONTH
- DO 10021, MONTH = 1, 12
- IF ( CHREP (18:20) .EQ. MONNS (MONTH) ) GO TO 10022
-10021 CONTINUE
-C MONTH NOT IDENTIFIED:
- GO TO 80020
-10022 CONTINUE
-C DECODE YEAR
- READ ( CHREP (22:25), '(I4)', IOSTAT=K ) YEAR
- IF ( K .NE. 0 ) GO TO 81002
-C LEAP, DIY, JULIAN
- YEAR2 = YEAR - (YEAR/100)*100
-C YEAR -> LEAP, DIY, JULIAN
- GO TO 18230
-C
-C
-CC
-CC 'ROUTINE INX3'
-CCC INPUT DATE = '14 APR 82', FIELD CHREP( 26: 34), IINDEX = 3
-CC SUBSTR 678901234 DMY9
-C SYNTAX CHECKS
-10030 CONTINUE
- IF ( CHREP (28:28) .NE. ' ' .OR.
- * CHREP (32:32) .NE. ' ' ) GO TO 81003
-C
-C DECODE DAY
- READ ( CHREP (26:27), '(I2)', IOSTAT=K ) DAY
- IF ( K .NE. 0 ) GO TO 81003
-C DECODE MONTH
- DO 10031, MONTH = 1, 12
- IF ( CHREP (29:31) .EQ. MONNS (MONTH) ) GO TO 10032
-10031 CONTINUE
-C MONTH NOT IDENTIFIED:
- GO TO 80020
-10032 CONTINUE
-C DECODE YEAR
- READ ( CHREP (33:34), '(I2)', IOSTAT=K ) YEAR2
- IF ( K .NE. 0 ) GO TO 81003
-C YEAR2 -> YEAR, LEAP, DIY, JULIAN
- GO TO 18210
-C
-C
-CC
-CC 'ROUTINE INX4'
-CCC INPUT DATE = '16. 4.1982', FIELD CHREP( 35: 44), IINDEX = 4
-CC SUBSTR 5678901234 DMY10
-C SYNTAX CHECKS
-10040 CONTINUE
- IF ( CHREP (37:37) .NE. '.' .OR.
- * CHREP (40:40) .NE. '.' ) GO TO 81004
-C
-C DECODE DAY, MONTH, AND YEAR
- READ ( CHREP (35:44), '(I2,1X,I2,1X,I4)', IOSTAT=K )
- * DAY, MONTH, YEAR
- IF ( K .NE. 0 ) GO TO 81004
- YEAR2 = YEAR - (YEAR/100)*100
-C YEAR -> LEAP, DIY, JULIAN
- GO TO 18230
-C
-C
-CC
-CC 'ROUTINE INX5'
-CCC INPUT DATE = '16. 4.82', FIELD CHREP( 45: 52), IINDEX = 5
-CC SUBSTR 56789012 DMY8A
-C SYNTAX CHECKS
-10050 CONTINUE
- IF ( CHREP (47:47) .NE. '.' .OR.
- * CHREP (50:50) .NE. '.' ) GO TO 81005
-C
-C DECODE DAY, MONTH, AND YEAR
- READ ( CHREP (45:52), '(I2,1X,I2,1X,I2)', IOSTAT=K )
- * DAY, MONTH, YEAR2
- IF ( K .NE. 0 ) GO TO 81005
-C YEAR2 -> YEAR, LEAP, DIY, JULIAN
- GO TO 18210
-C
-C
-CC
-CC 'ROUTINE INX6'
-CCC INPUT DATE = '16/04/82', FIELD CHREP( 53: 60), IINDEX = 6
-CC SUBSTR 34567890 DMY8B
-C SYNTAX CHECKS
-10060 CONTINUE
- IF ( CHREP (55:55) .NE. '/' .OR.
- * CHREP (58:58) .NE. '/' ) GO TO 81006
-C
-C DECODE DAY, MONTH, AND YEAR
- READ ( CHREP (53:60), '(I2,1X,I2,1X,I2)', IOSTAT=K )
- * DAY, MONTH, YEAR2
- IF ( K .NE. 0 ) GO TO 81006
-C YEAR2 -> YEAR, LEAP, DIY, JULIAN
- GO TO 18210
-C
-CC
-CC 'ROUTINE INX7'
-CCC INPUT DATE = '160482', FIELD CHREP( 61: 66), IINDEX = 7
-CC SUBSTR 123456 DMY6
-C DECODE DAY, MONTH, AND YEAR
-10070 CONTINUE
- READ ( CHREP (61:66), '(I2,I2,I2)', IOSTAT=K )
- * DAY, MONTH, YEAR2
- IF ( K .NE. 0 ) GO TO 81007
-C YEAR2 -> YEAR, LEAP, DIY, JULIAN
- GO TO 18210
-C
-C
-CC
-CC 'ROUTINE INX8'
-CCC INPUT DATE = '82/04/16', FIELD CHREP( 67: 74), IINDEX = 8
-CC SUBSTR 78901234 YMD8
-C SYNTAX CHECKS
-10080 CONTINUE
- IF ( CHREP (69:69) .NE. '/' .OR.
- * CHREP (72:72) .NE. '/' ) GO TO 81008
-C
-C DECODE DAY, MONTH, AND YEAR
- READ ( CHREP (67:74), '(I2,1X,I2,1X,I2)', IOSTAT=K )
- * YEAR2, MONTH, DAY
- IF ( K .NE. 0 ) GO TO 81008
-C YEAR2 -> YEAR, LEAP, DIY, JULIAN
- GO TO 18210
-C
-C
-CC
-CC 'ROUTINE INX9'
-CCC INPUT DATE = '820416', FIELD CHREP( 75: 80), IINDEX = 9
-CC SUBSTR 567890 YMD6
-C
-C DECODE DAY, MONTH, AND YEAR
-10090 CONTINUE
- READ ( CHREP (75:80), '(I2,I2,I2)', IOSTAT=K )
- * YEAR2, MONTH, DAY
- IF ( K .NE. 0 ) GO TO 81009
-C YEAR2 -> YEAR, LEAP, DIY, JULIAN
- GO TO 18210
-C
-C
-CC
-CC 'ROUTINE INX10'
-CCC INPUT DATE = '04/16/82', FIELD CHREP( 81: 88), IINDEX = 10
-CC SUBSTR 12345678 MDY8
-C SYNTAX CHECKS
-10100 CONTINUE
- IF ( CHREP (83:83) .NE. '/' .OR.
- * CHREP (86:86) .NE. '/' ) GO TO 81010
-C
-C DECODE DAY, MONTH, AND YEAR
- READ ( CHREP (81:88), '(I2,1X,I2,1X,I2)', IOSTAT=K )
- * MONTH, DAY, YEAR2
- IF ( K .NE. 0 ) GO TO 81010
-C YEAR2 -> YEAR, LEAP, DIY, JULIAN
- GO TO 18210
-C
-C
-CC
-CC 'ROUTINE INX11'
-CCC INPUT DATE = '041682', FIELD CHREP( 89: 94), IINDEX = 11
-CC SUBSTR 901234 MDY6
-C
-C DECODE DAY, MONTH, AND YEAR
-10110 CONTINUE
- READ ( CHREP (89:94), '(I2,I2,I2)', IOSTAT=K )
- * MONTH, DAY, YEAR2
- IF ( K .NE. 0 ) GO TO 81011
-C YEAR2 -> YEAR, LEAP, DIY, JULIAN
- GO TO 18210
-C
-C
-CC
-CC 'ROUTINE INX12'
-CCC INPUT DATE = '82/16/04', FIELD CHREP( 95:102), IINDEX = 12
-CC SUBSTR 56789012 YDM8
-C SYNTAX CHECKS
-10120 CONTINUE
- IF ( CHREP ( 97: 97) .NE. '/' .OR.
- * CHREP (100:100) .NE. '/' ) GO TO 81012
-C
-C DECODE DAY, MONTH, AND YEAR
- READ ( CHREP (95:102), '(I2,1X,I2,1X,I2)', IOSTAT=K )
- * YEAR2, DAY, MONTH
- IF ( K .NE. 0 ) GO TO 81012
-C YEAR2 -> YEAR, LEAP, DIY, JULIAN
- GO TO 18210
-C
-C
-CC
-CC 'ROUTINE INX13'
-CCC INPUT DATE = '821604', FIELD CHREP(103:108), IINDEX = 13
-CC SUBSTR 345678 YDM6
-C
-C DECODE DAY, MONTH, AND YEAR
-10130 CONTINUE
- READ ( CHREP (103:108), '(I2,I2,I2)', IOSTAT=K )
- * YEAR2, DAY, MONTH
- IF ( K .NE. 0 ) GO TO 81013
-C YEAR2 -> YEAR, LEAP, DIY, JULIAN
- GO TO 18210
-C
-C
-CC
-CC 'ROUTINE INX14'
-CCC INPUT DATE = '82106', FIELD CHREP(109:113), IINDEX = 14
-CC SUBSTR 90123 YD5
-C DECODE DAY IN YEAR AND YEAR
-10140 CONTINUE
- READ ( CHREP (109:113), '(I2,I3)', IOSTAT=K ) YEAR2, DIY
- IF ( K .NE. 0 ) GO TO 81014
-C YY -> YEAR, LEAP, MONTH, DAY, JULIAN
- IF ( YEAR2 .LT. 0 ) GO TO 80024
- YEAR = CYEAR4 ( YEAR2 )
- LEAP = CLEAP ( YEAR )
- IF ( DIY .LT. 0 .OR. DIY .GT. LYEAR (LEAP) ) GO TO 80016
- CALL CDMON ( LEAP, DIY, MONTH, DAY )
-C JULIAN
- GO TO 18300
-C
-C $
-CC
-CC 'ROUTINE INX101'
-CCC INPUT DATE = 16, 4, 1982, ELEMENTS 1-3 OF BINREP, IINDEX = 101
-CC
-C
-11010 CONTINUE
- DAY = BINREP (1)
- MONTH = BINREP (2)
- YEAR = BINREP (3)
-C
- IF ( YEAR .LE. 0 ) GO TO 80024
- YEAR2 = YEAR - (YEAR/100)*100
- LEAP = CLEAP ( YEAR )
- IF ( MONTH .LT. 1 .OR. MONTH .GT. 12 ) GO TO 80020
- IF ( DAY .LT. 1 .OR. DAY .GT. DAYTAB(MONTH, LEAP)) GO TO 80020
- DIY = MONTAB ( MONTH, LEAP ) + DAY
-C JULIAN
- GO TO 18300
-C
-C
-C
-CC
-CC 'ROUTINE INX102'
-CCC INPUT DATE = 106 , ELEMENT 4 OF BINREP, IINDEX = 102
-CC YEAR IS TAKEN TO BE THIS YEAR
-C
-11020 CONTINUE
- DIY = BINREP (4)
- CALL DATIME (K, I)
-C K = YYMMDD, I = HHMM; TIME NOT USED.
-C
- YEAR = ISL (1)
- IF ( YEAR .LE. 0 ) GO TO 80024
- YEAR2 = K / 10000
- LEAP = CLEAP ( YEAR )
- IF ( DIY .LT. 0 .OR. DIY .GT. LYEAR (LEAP) ) GO TO 80016
- CALL CDMON ( LEAP, DIY, MONTH, DAY )
-C JULIAN
- GO TO 18300
-C
-C
-CC
-CC 'ROUTINE INX103'
-CCC INPUT DATE = JULIUS, ELEMENT 5 OF BINREP, IINDEX = 103
-C 00 YY DD DC, PACKED DECIMAL
-C
-C THIS IS A DATA TYPE N O T SUPPORTED BY FORTRAN, BUT IT OCCURS
-C E.G. IN SMF FROM IBM /370 .
-C
-11030 CONTINUE
-C Syntax checks: first two hex digits must be 00 and
-C last hex digit must be C or E .
- IF ( .NOT. (
- * ( 0 .LT. BINREP (5) .AND. BINREP (5) .LT. Z10E6 )
- * .AND. ( MOD (BINREP (5), Z10 ) .EQ. ZC .OR.
- * MOD (BINREP (5), Z10 ) .EQ. ZE )
- * )
- * ) GO TO 81103
-C
-C YEAR
-C K <- 00 00 00 YY, I <- 00 00 DD DC
- K = BINREP (5) / Z10000
- I = BINREP (5) - K * Z10000
- YEAR2 = K / Z10
- YEAR2 = YEAR2 * 10 + (K - YEAR2 * Z10)
- YEAR = CYEAR4 ( YEAR2 )
-C
-C DIY
-C K <- 00 00 00 DD, I <- 00 00 0D DD
- I = I / Z10
- K = I / Z10
- DIY = K / Z10
- DIY = DIY * 100 + (K - DIY * Z10) * 10 + (I - K * Z10)
-C
- IF ( YEAR .LE. 0 ) GO TO 80024
- LEAP = CLEAP ( YEAR )
- IF ( DIY .LT. 0 .OR. DIY .GT. LYEAR (LEAP) ) GO TO 80016
- CALL CDMON ( LEAP, DIY, MONTH, DAY )
-C JULIAN
- GO TO 18300
-C
-C
-CC
-CC 'ROUTINE INX104'
-CCC INPUT DATE = JULIAN, ELEMENT 6 OF BINREP, IINDEX = 104
-CC
-11040 CONTINUE
- JULIAN = BINREP (6)
- IF ( JULIAN .LT. 1 ) GO TO 81104
- CALL CYDIY ( JULIAN, YEAR, LEAP, DIY )
- CALL CDMON ( LEAP, DIY, MONTH, DAY )
- YEAR2 = YEAR - (YEAR/100)*100
-C PRODUCE OUTPUT DATA & RETURN
- GO TO 20000
-C
-C
-CC
-CC 'ROUTINE INX105'
-CCC INPUT DATE = 1982, 106, ELEMENTS 3-4 OF BINREP, IINDEX = 105
-CC
-11050 CONTINUE
- YEAR = BINREP (3)
- DIY = BINREP (4)
- IF ( YEAR .LE. 0 ) GO TO 80024
- YEAR2 = YEAR - (YEAR/100)*100
- LEAP = CLEAP ( YEAR )
- IF ( DIY .LT. 0 .OR. DIY .GT. LYEAR (LEAP) ) GO TO 80016
- CALL CDMON ( LEAP, DIY, MONTH, DAY )
-C JULIAN
- GO TO 18300
-C
-C $
-CC
-CC
-CCC COMMON SECTION FOR VARIOUS INPUTS
-CC
-C
-C
-C Common section for inputs of type DAY, MONTH, YEAR2
-C
-18210 CONTINUE
- IF ( YEAR2 .LT. 0 ) GO TO 80024
- YEAR = CYEAR4 ( YEAR2 )
-C
-C Common section for inputs of type DAY, MONTH, YEAR, and YEAR2
-C
-18230 CONTINUE
- LEAP = CLEAP ( YEAR )
- IF ( MONTH .LT. 1 .OR. MONTH .GT. 12 ) GO TO 80020
- IF ( DAY .LT. 1 .OR. DAY .GT. DAYTAB(MONTH, LEAP)) GO TO 80020
- DIY = MONTAB ( MONTH, LEAP ) + DAY
-C
-C Common section for inputs of type .NE. JULIAN
-C
-18300 CONTINUE
- JULIAN = DIY + (YEAR - 1) * 365 + (YEAR - 1) / 4
- * - (YEAR - 1) / 100 + (YEAR - 1) / 400
-C
-C
-CC
-CC
-CCC PRODUCE OUTPUTS AND RETURN
-CC
-C
-C
-CC STORE REGISTERED OUTPUT DATA
-C
-20000 CONTINUE
- BINREP (1) = DAY
- BINREP (2) = MONTH
- BINREP (3) = YEAR
- BINREP (4) = DIY
-C $
-C $
-CC STORE JULIUS 00YYDDDC
-C
- K = DIY / 10
- I = K / 10
- BINREP (5) = ZC + (DIY - K*10) * Z10 + (K - I*10) * Z100 +
- * I * Z1000
- I = YEAR2 / 10
- BINREP (5) = BINREP(5) + (YEAR2 - I*10) * Z10000 + I *Z10E5
-C
-C
-CC STORE DAY IN WEEK AND WEEK IN YEAR
-C WIY = ( DIY - DIW + 9 ) / 7
-C DEFINITION, ACCORDING TO DIN
-C = DEUTSCHES INSTITUT FUER NORMUNG:
-C WEEK 1 CONTAINS THE 1ST THURSDAY.
-C
- BINREP (6) = JULIAN
- J = MOD (JULIAN-1, 7)
- BINREP (7) = J
- BINREP (8) = (DIY - J + 9) / 7
-C
-C
-CC STORE ALPHA STRINGS
-C
-C THE FOLLOWING WRITE STATEMENT IS SPLIT UP INTO THREE, BECAUSE THE
-C SIEMENS FORTRAN 77 COMPILER CONSIDERS THE FORMAT A CHARACTER
-C STRING, WHICH AS SUCH MAY NOT EXCEED 255 CHARACTERS.
-C NO PROBLEM WITH THE IBM VS FORTRAN COMPILER. J=DAY IN WEEK
-C
- WRITE ( CHREP ( 1: 52),
- 1'( I2, ''. '', A5, '' '', I4, I2, '' '', A3, '' '', I4,
- 3 I2, '' '', A3, '' '', I2.2,
- 4 I2, ''.'', I2, ''.'', I4, I2, ''.'', I2, ''.'',I2.2)')
- 1 DAY, MONNL(MONTH), YEAR, DAY, MONNS(MONTH), YEAR,
- 3 DAY, MONNS(MONTH), YEAR2,
- 4 DAY, MONTH, YEAR, DAY, MONTH, YEAR2
-C
- WRITE ( CHREP ( 53: 94),
- 6'( I2.2, ''/'', I2.2, ''/'', I2.2, I2.2, I2.2, I2.2,
- 8 I2.2, ''/'', I2.2, ''/'', I2.2, I2.2, I2.2, I2.2,
- X I2.2, ''/'', I2.2, ''/'', I2.2, I2.2, I2.2, I2.2)')
- 6 DAY, MONTH, YEAR2, DAY, MONTH, YEAR2,
- 8 YEAR2, MONTH, DAY, YEAR2, MONTH, DAY,
- X MONTH, DAY, YEAR2, MONTH, DAY, YEAR2
-C
- WRITE ( CHREP ( 95:119),
- 2'( I2.2, ''/'', I2.2, ''/'', I2.2, I2.2, I2.2, I2.2,
- 4 I2.2, I3.3, A4, A2 )')
- 2 YEAR2, DAY, MONTH, YEAR2, DAY, MONTH,
- 4 YEAR2, DIY, DAYNL(J), DAYNS(J)
-C
-C
-CC
-CC
-CCC END
-CC
-C
- RETC = 0
- GO TO 90000
-C
-C
-CC
-CC
-CCC BAD IINDEX
-CC
-C RETCODE
-80004 CONTINUE
-C IINDEX < 0 :
- RETC = 4
- GO TO 88000
-80008 CONTINUE
-C IINDEX < KINXBL:
- RETC = 8
- GO TO 88000
-80012 CONTINUE
-C IINDEX > KINXBH:
- RETC = 12
- GO TO 88000
-C DDD OFF BOUNDS:
-80016 RETC = 16
- GO TO 88000
-C MM | DD OFF BOUNDS:
-80020 RETC = 20
- GO TO 88000
-C YEAR OFF BOUNDS:
-80024 RETC = 24
- GO TO 88000
-C SYNTAX ERROR IN DMY14:
-81001 RETC = 1001
- GO TO 88000
-C SYNTAX ERROR IN DMY11:
-81002 RETC = 1002
- GO TO 88000
-C SYNTAX ERROR IN DMY9:
-81003 RETC = 1003
- GO TO 88000
-C SYNTAX ERROR IN DMY10:
-81004 RETC = 1004
- GO TO 88000
-C SYNTAX ERROR IN DMY8A:
-81005 RETC = 1005
- GO TO 88000
-C SYNTAX ERROR IN DMY8B:
-81006 RETC = 1006
- GO TO 88000
-C SYNTAX ERROR IN DMY6:
-81007 RETC = 1007
- GO TO 88000
-C SYNTAX ERROR IN YMD8:
-81008 RETC = 1008
- GO TO 88000
-C SYNTAX ERROR IN YMD6:
-81009 RETC = 1009
- GO TO 88000
-C SYNTAX ERROR IN MDY8:
-81010 RETC = 1010
- GO TO 88000
-C SYNTAX ERROR IN MDY6:
-81011 RETC = 1011
- GO TO 88000
-C SYNTAX ERROR IN YDM8:
-81012 RETC = 1012
- GO TO 88000
-C SYNTAX ERROR IN YDM6:
-81013 RETC = 1013
- GO TO 88000
-C SYNTAX ERROR IN YD5:
-81014 RETC = 1014
- GO TO 88000
-C SYNTAX ERROR IN JULIUS:
-81103 RETC = 1103
- GO TO 88000
-C SYNTAX ERROR IN JULIAN:
-81104 RETC = 1104
- GO TO 88000
-C
-C $
-C
-C CHREP ALL '*', BINREP ALL HEX 81
-88000 CONTINUE
- DO 88010, I = 1, 119
- CHREP (I:I) = '*'
-88010 CONTINUE
-C
- DO 88020, I = 1, 8
- BINREP (I) = Z81X4
-88020 CONTINUE
-C
- GO TO 90000
-C
-C
-CC
-CC
-CCC INSTRUCTIONS HOW TO ADD MORE REPRESENTATIONS
-CC
-C
-C ALL AREAS WHERE CHANGES MAY BE NECESSARY ARE MARKED WITH $ .
-C ADDITIONS MAY ME MADE TO THE CHARACTER STRING OR TO THE
-C INTEGER ARRAY.
-C THE FOLLOWING AREAS ARE RELEVANT:
-C - THE CALLS FROM THE VARIOUS LANGUAGES
-C - DECLARATIONS
-C - SUBFIELD NAMES AND/OR DESCRIPTIONS
-C - DESCRIPTION OF THE RETURN CODES
-C - JUMP TABLE TO THE INPUT ROUTINES (LABELS 10XX0 OR 11XX0)
-C - NEW INPUT ROUTINE, LABEL 10XX0 OR 11XX0 .
-C - STORAGE OF RESULTS, DAYS, MONTH, YEAR.
-C - ERROR ROUTINE, LABEL 80XXX OR 81XXX
-C - CONSTANTS KINXCH AND KINXBH - ONLY COMMENT
-C
-C END OF MAIN ROUTINE CALDAT
-C 'LOCAL' ROUTINES OF CALDAT FOLLOW
-C
-C
-C
-C
-90000 CONTINUE
- END
diff --git a/src/packlib/kernlib/kernbit/z009/cdmon.F b/src/packlib/kernlib/kernbit/z009/cdmon.F
deleted file mode 100644
index 096a321..0000000
--- a/src/packlib/kernlib/kernbit/z009/cdmon.F
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: cdmon.F,v 1.1.1.1 1996/02/15 17:47:51 mclareni Exp $
-*
-* $Log: cdmon.F,v $
-* Revision 1.1.1.1 1996/02/15 17:47:51 mclareni
-* Kernlib
-*
-*
-#include "kernbit/pilot.h"
- SUBROUTINE CDMON (LEAP, DIY, MONTH, DAY)
-C
-CC COMPUTE DAY & MONTH FROM DIY & LEAP
-C
- INTEGER LEAP, DIY, MONTH, DAY
-C
-C DAYS IN THE MONTHS ACCUMULATED
-C (TABLE COPIED FROM MAIN ROUTINE)
- INTEGER MONTAB (12,2)
- DATA MONTAB /
- * 000, 031, 059, 090, 120, 151, 181, 212, 243, 273, 304, 334,
- * 000, 031, 060, 091, 121, 152, 182, 213, 244, 274, 305, 335 /
-C
-C
- DO 10, MONTH = 12, 2, -1
- IF ( DIY .GT. MONTAB (MONTH, LEAP) ) GO TO 20
- 10 CONTINUE
-C
- MONTH = 1
-C
- 20 DAY = DIY - MONTAB (MONTH, LEAP)
-C
- END
diff --git a/src/packlib/kernlib/kernbit/z009/cleap.F b/src/packlib/kernlib/kernbit/z009/cleap.F
deleted file mode 100644
index 438af4c..0000000
--- a/src/packlib/kernlib/kernbit/z009/cleap.F
+++ /dev/null
@@ -1,38 +0,0 @@
-*
-* $Id: cleap.F,v 1.1.1.1 1996/02/15 17:47:51 mclareni Exp $
-*
-* $Log: cleap.F,v $
-* Revision 1.1.1.1 1996/02/15 17:47:51 mclareni
-* Kernlib
-*
-*
-#include "kernbit/pilot.h"
- INTEGER FUNCTION CLEAP (YEAR)
-C
-CC COMPUTE LEAP
-C I.E. SET FUNCTION VALUE TO THE CORRECT TABLE INDEX
-C = 1 FOR NORMAL, = 2 FOR LEAP YEAR
-C
-C DECISION TABLE FOR LEAP YEARS
-C -----------------------+------+------+------+------
-C YEAR DIVISIBLE BY 4 | YES | YES | YES | NO
-C YEAR DIVISIBLE BY 100 | YES | YES | NO |--
-C YEAR DIVISIBLE BY 400 | YES | NO | -- |--
-C -----------------------+------+------+------+------
-C YEAR IS LEAP YEAR | YES | NO | YES | NO
-C EXAMPLES | 20000 | 1900 | 1980 | 1981
-C -----------------------+------+------+------+------
-C
- INTEGER YEAR
-C
- IF ( MOD (YEAR, 4 ) .NE. 0 ) THEN
- CLEAP = 1
- ELSEIF ( MOD (YEAR, 100) .NE. 0 ) THEN
- CLEAP = 2
- ELSEIF ( MOD (YEAR, 400) .NE. 0 ) THEN
- CLEAP = 1
- ELSE
- CLEAP = 2
- ENDIF
-C
- END
diff --git a/src/packlib/kernlib/kernbit/z009/cydiy.F b/src/packlib/kernlib/kernbit/z009/cydiy.F
deleted file mode 100644
index db718f8..0000000
--- a/src/packlib/kernlib/kernbit/z009/cydiy.F
+++ /dev/null
@@ -1,49 +0,0 @@
-*
-* $Id: cydiy.F,v 1.1.1.1 1996/02/15 17:47:51 mclareni Exp $
-*
-* $Log: cydiy.F,v $
-* Revision 1.1.1.1 1996/02/15 17:47:51 mclareni
-* Kernlib
-*
-*
-#include "kernbit/pilot.h"
- SUBROUTINE CYDIY (JULIAN, YEAR, LEAP, DIY)
-C
-CC COMPUTE DIY, YEAR & LEAP FROM JULIAN
-C
-C SINCE
-C JULIAN = DIY + (YEAR - 1) * 365 + (YEAR - 1) / 4
-C - - (YEAR - 1) / 100 + (YEAR - 1) / 400
-C WITH INTEGER DIVISION, THE INVERSION WILL NOT BE EXACT, BUT GIVE
-C A GOOD VALUE TO START FROM:
-C JULIAN <= (YEAR - 1) * (365 + 1/4 - 1/100 + 1/400)
-C = (YEAR - 1) * 146097 / 400
-C YEAR APPROX.= JULIAN * 400 / 146097 + 1
-C
-C LYEAR IS COPY FROM MAIN ROUTINE
- INTEGER LYEAR (2)
- INTEGER JULIAN, YEAR, LEAP, DIY
- INTEGER CLEAP
- DATA LYEAR / 365, 366 /
-C
-C
- YEAR = (JULIAN * 400) / 146097 + 1
- DIY = JULIAN - (YEAR - 1) * 365 - (YEAR - 1) / 4
- + + (YEAR - 1) / 100 - (YEAR - 1) / 400
- IF ( DIY .LT. 1 ) GO TO 200
-C
-C ADVANCE YEAR
- 100 LEAP = CLEAP ( YEAR )
- IF ( DIY .LE. LYEAR (LEAP) ) GO TO 900
- DIY = DIY - LYEAR (LEAP)
- YEAR = YEAR + 1
- GO TO 100
-C
-C RETARD YEAR
- 200 YEAR = YEAR - 1
- LEAP = CLEAP ( YEAR )
- DIY = DIY + LYEAR (LEAP)
- IF ( DIY .LT. 1 ) GO TO 200
-C
- 900 CONTINUE
- END
diff --git a/src/packlib/kernlib/kernbit/z009/cyear4.F b/src/packlib/kernlib/kernbit/z009/cyear4.F
deleted file mode 100644
index 3df94f9..0000000
--- a/src/packlib/kernlib/kernbit/z009/cyear4.F
+++ /dev/null
@@ -1,72 +0,0 @@
-*
-* $Id: cyear4.F,v 1.2 1996/12/12 13:49:28 cernlib Exp $
-*
-* $Log: cyear4.F,v $
-* Revision 1.2 1996/12/12 13:49:28 cernlib
-* Caldat mods from O. Hell to cater for the year 2000
-*
-* Revision 1.1.1.1 1996/02/15 17:47:51 mclareni
-* Kernlib
-*
-*
-#include "kernbit/pilot.h"
- INTEGER FUNCTION CYEAR4 (YEAR2)
-C
-CC "Compute" YYYY from YY
-C
-C This algorithm cannot deliver a "correct" result. It aims to
-C keep the absolute difference between "this year" and CYEAR4 at
-C less or equal to 50 :
-C
-C If "this 2-digit-year" is less than 50
-C then it assumes
-C "this century" for YEAR2 <= 50 and
-C "previous century" for YEAR2 > 50
-C
-C If "this 2-digit-year" is larger than 50
-C then it assumes
-C "next century" for YEAR2 <= 50 and
-C "this century" for YEAR2 > 50
-C
-C Examples:
-C this year YEAR2 CYEAR one century . . . . . next century
-C yyyy yy 50................99 00...............50
-C 1936 36 39 1939 this_y. YEAR2 CYEAR
-C 1936 36 89 1889 YEAR2 CYEAR this_year
-C 1996 96 39 2039 this_year YEAR2 CYEAR
-C 1996 96 89 1989 this_y. YEAR2 CYEAR
-C
-C
-C This computation is tied to DATIME and its COMMON /SLATE/ ISL(1)
-C hoping that this will give the correct century, even in the
-C year 2000, see remarks at the very top of the CALDAT source.
-C
- INTEGER YEAR2, I, K
- COMMON /SLATE/ ISL(40)
-C ISL(1) = ccyy
-C
-C This 2-digit-year --> I (yy), this century --> K (cc00)
-C
- CALL DATIME (K, I)
-C K = yymmdd, I = hhmm
-C
- I = K / 10000
- K = ISL(1) - I
-C
-C Decide on CYEAR4
-C
- IF ( I .LE. 50 ) THEN
- IF ( YEAR2 .LE. 50 ) THEN
- CYEAR4 = K + YEAR2
- ELSE
- CYEAR4 = K - 100 + YEAR2
- ENDIF
- ELSE
- IF ( YEAR2 .LE. 50 ) THEN
- CYEAR4 = K + 100 + YEAR2
- ELSE
- CYEAR4 = K + YEAR2
- ENDIF
- ENDIF
-C
- END
diff --git a/src/packlib/kernlib/kernbit/z037/Imakefile b/src/packlib/kernlib/kernbit/z037/Imakefile
deleted file mode 100644
index dc7f34d..0000000
--- a/src/packlib/kernlib/kernbit/z037/Imakefile
+++ /dev/null
@@ -1,6 +0,0 @@
-SRCS_F= astcca.F astcch.F astdcc.F astdoc.F astecc.F astecs.F astint.F \ @@\
- astscs.F astxit.F
-
-SRCS_S= fiopat.s
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kernbit/z037/astcca.F b/src/packlib/kernlib/kernbit/z037/astcca.F
deleted file mode 100644
index b3129ec..0000000
--- a/src/packlib/kernlib/kernbit/z037/astcca.F
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: astcca.F,v 1.1.1.1 1996/02/15 17:47:52 mclareni Exp $
-*
-* $Log: astcca.F,v $
-* Revision 1.1.1.1 1996/02/15 17:47:52 mclareni
-* Kernlib
-*
-*
-#include "kernbit/pilot.h"
- SUBROUTINE ASTCCA
-*-----------------------------------------------------------------------
-* ASTCCA - This routines receives control when a control_c is typed
-* to the terminal.
-* AUTHOR : Carlo Mekenkamp /Leiden (MEKENKAM at HLERUL5)
-* SIDE EFFECTS: Signal SS$_CONTROLC.
-* CREATION DATE: 10-MAR-1988
-*-----------------------------------------------------------------------
-#include "astcom.inc"
- INCLUDE '($SYSSRVNAM)/NOLIST'
- INCLUDE '($SSDEF)/NOLIST'
- INCLUDE '($LIBDEF)/NOLIST'
- INCLUDE '($STSDEF)/NOLIST'
- CALL LIB$SIGNAL(%VAL(IOR(IAND(-(STS$M_SEVERITY+1),
- - SS$_CONTROLC),STS$K_ERROR)))
- END
diff --git a/src/packlib/kernlib/kernbit/z037/astcch.F b/src/packlib/kernlib/kernbit/z037/astcch.F
deleted file mode 100644
index de3d3f8..0000000
--- a/src/packlib/kernlib/kernbit/z037/astcch.F
+++ /dev/null
@@ -1,58 +0,0 @@
-*
-* $Id: astcch.F,v 1.1.1.1 1996/02/15 17:47:52 mclareni Exp $
-*
-* $Log: astcch.F,v $
-* Revision 1.1.1.1 1996/02/15 17:47:52 mclareni
-* Kernlib
-*
-*
-#include "kernbit/pilot.h"
- INTEGER*4 FUNCTION ASTCCH(SA, MA)
-*-----------------------------------------------------------------------
-* ASTCCH - This routine gets control if an exception occurs
-* when established
-* AUTHOR : Carlo Mekenkamp /Leiden (MEKENKAM at HLERUL5)
-* VARIABLES : SA : Signal Array
-* SA(1) Number of arguments
-* SA(2) Condition name
-* SA(3) First signal-specific argument
-* ...
-* SA(SA(1)) PC at time exception
-* SA(SA(1)+1) PSL at time exception
-* MA : Mechanism Array
-* MA(1) Number of mechanism arguments
-* MA(2) Establisher frame address
-* MA(3) Frame depth of establisher
-* MA(4) Saved register R0
-* MA(5) Saved register R1
-* SIDE EFFECTS: IF condition matches SS$_CONTROLC THEN
-* IF NOT ASTCS THEN
-* stack unwind to establisher of caller
-* enable control-C AST
-* ELSE
-* ASTIP=.TRUE.
-* return SS$_CONTINUE
-* ENDIF
-* ELSE
-* resignal
-* ENDIF
-* CREATION DATE: 10-MAR-1988
-*-----------------------------------------------------------------------
-#include "astcom.inc"
- INTEGER*4 SA(*), MA(5)
- INCLUDE '($SYSSRVNAM)/NOLIST'
- INCLUDE '($LIBDEF)/NOLIST'
- INCLUDE '($SSDEF)/NOLIST'
- INTEGER*4 LIB$MATCH_COND
- IF(LIB$MATCH_COND(SA(2),SS$_CONTROLC).EQ.1)THEN
- IF(ASTCS)THEN
- ASTIP = .TRUE.
- ASTCCH = SS$_CONTINUE
- ELSE
- CALL SYS$UNWIND(MA(3),)
- CALL ASTECC
- ENDIF
- ELSE
- ASTCCH = SS$_RESIGNAL
- ENDIF
- END
diff --git a/src/packlib/kernlib/kernbit/z037/astcom.inc b/src/packlib/kernlib/kernbit/z037/astcom.inc
deleted file mode 100644
index 076fccb..0000000
--- a/src/packlib/kernlib/kernbit/z037/astcom.inc
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: astcom.inc,v 1.1.1.1 1996/02/15 17:47:52 mclareni Exp $
-*
-* $Log: astcom.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:47:52 mclareni
-* Kernlib
-*
-*
-#ifndef CERNLIB_KERNBIT_ASTCOM_INC
-#define CERNLIB_KERNBIT_ASTCOM_INC
-*
-*
-* astcom.inc
-*
-*-----------------------------------------------------------------------
-* ASTCOM - Stores various quantities being used for control_C
-* interception on a Vax. (For information, contact
-* Carlo Mekenkamp, MEKENKAM at HLERUL5.)
-*-----------------------------------------------------------------------
- IMPLICIT NONE
- COMMON /ASTCOM/ CHAN, ASTIP, ASTCS
- VOLATILE CHAN, ASTIP, ASTCS
- INTEGER*4 CHAN
- LOGICAL*4 ASTIP,ASTCS
-
-#endif
diff --git a/src/packlib/kernlib/kernbit/z037/astdcc.F b/src/packlib/kernlib/kernbit/z037/astdcc.F
deleted file mode 100644
index f4c5415..0000000
--- a/src/packlib/kernlib/kernbit/z037/astdcc.F
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: astdcc.F,v 1.1.1.1 1996/02/15 17:47:52 mclareni Exp $
-*
-* $Log: astdcc.F,v $
-* Revision 1.1.1.1 1996/02/15 17:47:52 mclareni
-* Kernlib
-*
-*
-#include "kernbit/pilot.h"
- SUBROUTINE ASTDCC
-*-----------------------------------------------------------------------
-* ASTDCC - Disables Control C AST
-* AUTHOR : Carlo Mekenkamp /Leiden (MEKENKAM at HLERUL5)
-* SIDE EFFECTS: Cancels control-C-AST on CHAN.
-* CREATION DATE: 10-MAR-1988
-*-----------------------------------------------------------------------
-#include "astcom.inc"
- INCLUDE '($SYSSRVNAM)/NOLIST'
- CALL SYS$CANCEL(%VAL(CHAN))
- END
diff --git a/src/packlib/kernlib/kernbit/z037/astecc.F b/src/packlib/kernlib/kernbit/z037/astecc.F
deleted file mode 100644
index 3dd3950..0000000
--- a/src/packlib/kernlib/kernbit/z037/astecc.F
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: astecc.F,v 1.1.1.1 1996/02/15 17:47:52 mclareni Exp $
-*
-* $Log: astecc.F,v $
-* Revision 1.1.1.1 1996/02/15 17:47:52 mclareni
-* Kernlib
-*
-*
-#include "kernbit/pilot.h"
- SUBROUTINE ASTECC
-*-----------------------------------------------------------------------
-* ASTECC - Enables Control C AST
-* AUTHOR : Carlo Mekenkamp /Leiden (MEKENKAM at HLERUL5)
-* SIDE EFFECTS: Queues a control-C-AST to CHAN.
-* CREATION DATE: 10-MAR-1988
-*-----------------------------------------------------------------------
-#include "astcom.inc"
- EXTERNAL ASTCCA
- INCLUDE '($SYSSRVNAM)/NOLIST'
- INCLUDE '($IODEF)/NOLIST'
- CALL SYS$QIOW(,%VAL(CHAN),%VAL(IOR(IO$_SETMODE,IO$M_CTRLCAST)),
- - ,,,ASTCCA,,,,,)
- END
diff --git a/src/packlib/kernlib/kernbit/z037/astecs.F b/src/packlib/kernlib/kernbit/z037/astecs.F
deleted file mode 100644
index 77b24a4..0000000
--- a/src/packlib/kernlib/kernbit/z037/astecs.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: astecs.F,v 1.1.1.1 1996/02/15 17:47:52 mclareni Exp $
-*
-* $Log: astecs.F,v $
-* Revision 1.1.1.1 1996/02/15 17:47:52 mclareni
-* Kernlib
-*
-*
-#include "kernbit/pilot.h"
- SUBROUTINE ASTECS
-*-----------------------------------------------------------------------
-* ASTECS - Ends critical section in which no stack unwind may occur
-* AUTHOR : Carlo Mekenkamp /Leiden (MEKENKAM at HLERUL5)
-* SIDE EFFECTS: ASTCS = .FALSE.,
-* IF ASTIP THEN SIGNAL SS$_CONTROLC
-* CREATION DATE: 10-MAR-1988
-*-----------------------------------------------------------------------
-#include "astcom.inc"
- INCLUDE '($LIBDEF)/NOLIST'
- INCLUDE '($SSDEF)/NOLIST'
- INCLUDE '($STSDEF)/NOLIST'
- ASTCS = .FALSE.
- IF(ASTIP)THEN
- ASTIP=.FALSE.
- CALL LIB$SIGNAL(%VAL(IOR(IAND(-(STS$M_SEVERITY+1),
- - SS$_CONTROLC),STS$K_ERROR)))
- ENDIF
- END
diff --git a/src/packlib/kernlib/kernbit/z037/astint.F b/src/packlib/kernlib/kernbit/z037/astint.F
deleted file mode 100644
index f10852a..0000000
--- a/src/packlib/kernlib/kernbit/z037/astint.F
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: astint.F,v 1.1.1.1 1996/02/15 17:47:52 mclareni Exp $
-*
-* $Log: astint.F,v $
-* Revision 1.1.1.1 1996/02/15 17:47:52 mclareni
-* Kernlib
-*
-*
-#include "kernbit/pilot.h"
- SUBROUTINE ASTINT
-*-----------------------------------------------------------------------
-* ASTINT - Initialisation Control C AST Routines
-* AUTHOR : Carlo Mekenkamp /Leiden (MEKENKAM at HLERUL5)
-* SIDE EFFECTS: Initialize ASTCS and ASTIP to .FALSE.,
-* Assign a channel to the terminal,
-* Enable control-C AST.
-* CREATION DATE: 10-MAR-1988
-*-----------------------------------------------------------------------
-#include "astcom.inc"
- INCLUDE '($SYSSRVNAM)/NOLIST'
- ASTCS = .FALSE.
- ASTIP = .FALSE.
- CALL SYS$ASSIGN('TT',CHAN,,)
- CALL ASTECC
- END
diff --git a/src/packlib/kernlib/kernbit/z037/astscs.F b/src/packlib/kernlib/kernbit/z037/astscs.F
deleted file mode 100644
index 2b2abf3..0000000
--- a/src/packlib/kernlib/kernbit/z037/astscs.F
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: astscs.F,v 1.1.1.1 1996/02/15 17:47:52 mclareni Exp $
-*
-* $Log: astscs.F,v $
-* Revision 1.1.1.1 1996/02/15 17:47:52 mclareni
-* Kernlib
-*
-*
-#include "kernbit/pilot.h"
- SUBROUTINE ASTSCS
-*-----------------------------------------------------------------------
-* ASTSCS - Starts critical section in which no stack unwind may occur
-* AUTHOR : Carlo Mekenkamp /Leiden (MEKENKAM at HLERUL5)
-* SIDE EFFECTS: ASTCS = .TRUE.
-* CREATION DATE: 10-MAR-1988
-*-----------------------------------------------------------------------
-#include "astcom.inc"
- ASTCS = .TRUE.
- END
diff --git a/src/packlib/kernlib/kernbit/z037/astxit.F b/src/packlib/kernlib/kernbit/z037/astxit.F
deleted file mode 100644
index 9944fdb..0000000
--- a/src/packlib/kernlib/kernbit/z037/astxit.F
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: astxit.F,v 1.1.1.1 1996/02/15 17:47:52 mclareni Exp $
-*
-* $Log: astxit.F,v $
-* Revision 1.1.1.1 1996/02/15 17:47:52 mclareni
-* Kernlib
-*
-*
-#include "kernbit/pilot.h"
- SUBROUTINE ASTXIT
-*-----------------------------------------------------------------------
-* ASTXIT - Exitialisation Control C AST routines
-* AUTHOR : Carlo Mekenkamp /Leiden (MEKENKAM at HLERUL5)
-* SIDE EFFECTS: Disable control-C AST,
-* Deassign channel to terminal.
-* CREATION DATE: 10-MAR-1988
-*-----------------------------------------------------------------------
-#include "astcom.inc"
- INCLUDE '($SYSSRVNAM)/NOLIST'
- CALL ASTDCC
- CALL SYS$DASSGN(%VAL(CHAN))
- END
diff --git a/src/packlib/kernlib/kernbit/z264/Imakefile b/src/packlib/kernlib/kernbit/z264/Imakefile
deleted file mode 100644
index 78128dc..0000000
--- a/src/packlib/kernlib/kernbit/z264/Imakefile
+++ /dev/null
@@ -1,7 +0,0 @@
-SRCS_F= \ @@\
- getarg.F iargc.F
-
-SRCS_C= \ @@\
- getcom.c
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kernbit/z264/getarg.F b/src/packlib/kernlib/kernbit/z264/getarg.F
deleted file mode 100644
index 0601d39..0000000
--- a/src/packlib/kernlib/kernbit/z264/getarg.F
+++ /dev/null
@@ -1,117 +0,0 @@
-*
-* $Id: getarg.F,v 1.1.1.1 1996/02/15 17:47:52 mclareni Exp $
-*
-* $Log: getarg.F,v $
-* Revision 1.1.1.1 1996/02/15 17:47:52 mclareni
-* Kernlib
-*
-*
-#include "kernbit/pilot.h"
- SUBROUTINE GETARG(JW,PARM)
-C
-C CERN PROGLIB# Z264 IARGC .VERSION KERNVAX x.xx 911130
-C
-C Returns JWth argument in command line
-C Author: Miguel Marquina 91/11/30
-C
-C Mods Date Comments
-c V.Fine 94/01/18 Windows/NT support
-c J.Shiers 93/11/15 Handle getarg(0,parm) case
-* ISTAT returned in /SLATE/
-c M.Marquina 92/12/05 Treat quote-delimited strings as single args
-C
- COMMON/Z264/IREAD,ISLEN,STRING
- COMMON/SLATE/IS(40)
- CHARACTER*255 STRING
- LOGICAL LB,LQ
- CHARACTER*(*) PARM
-#if defined(CERNLIB_VAXVMS)
- INCLUDE '($JPIDEF)'
-*
-* Imagename
-*
- IF(JW.EQ.0) THEN
- IS(1) = 0
- ISTAT = LIB$GETJPI(JPI$_IMAGNAME,,,,STRING,%REF(LENSTR))
- IF(.NOT.ISTAT) THEN
- IS(1) = ISTAT
- PARM = ' '
- GOTO 99
- ENDIF
- ISTAT = LIB$TRIM_FILESPEC(STRING(1:LENSTR),PARM,LEN(PARM),)
- ELSE
-
- IF(IREAD.EQ.0) THEN
- STRING=' '
- IFL=0
- IRC=LIB$GET_FOREIGN(STRING,,ISLEN,IFL)
- IREAD=1
- ENDIF
- NW =0
- LB =.TRUE.
- LQ =.FALSE.
- IP1=0
- IP2=ISLEN
- DO 10 N=1,ISLEN
- IF(STRING(N:N).NE.' ') THEN
- IF(STRING(N:N).EQ.'"') LQ=.NOT.LQ
- IF(NW.EQ.JW-1.AND.IP1.EQ.0) IP1=N
- IF(LB) LB=.FALSE.
- ENDIF
- IF(LQ) GOTO 10
- IF(STRING(N:N).EQ.' '.AND..NOT.LB) THEN
- LB=.TRUE.
- NW=NW+1
- ENDIF
- IF(NW.EQ.JW) THEN
- IP2=N-1
- GOTO 20
- ENDIF
- 10 CONTINUE
- 20 CONTINUE
- PARM=' '
- IF(IP1.GT.0) THEN
- IF(STRING(IP1:IP1).EQ.'"') IP1=IP1+1
- IF(STRING(IP2:IP2).EQ.'"') IP2=IP2-1
- IF(IP1.LE.IP2) PARM=STRING(IP1:IP2)
- ENDIF
- ENDIF
-#endif
-#if defined(CERNLIB_WINNT)
- IF(IREAD.EQ.0) THEN
- STRING=' '
- IFL=0
- CALL GETCOM(STRING,ISLEN)
- IREAD=1
- ENDIF
- NW =0
- LB =.TRUE.
- LQ =.FALSE.
- IP1=0
- IP2=ISLEN
- DO 10 N=1,ISLEN
- IF(STRING(N:N).NE.' ') THEN
- IF(STRING(N:N).EQ.'"') LQ=.NOT.LQ
- IF(NW.EQ.JW.AND.IP1.EQ.0) IP1=N
- IF(LB) LB=.FALSE.
- ENDIF
- IF(LQ) GOTO 10
- IF(STRING(N:N).EQ.' '.AND..NOT.LB) THEN
- LB=.TRUE.
- NW=NW+1
- ENDIF
- IF(NW.EQ.JW+1) THEN
- IP2=N-1
- GOTO 20
- ENDIF
- 10 CONTINUE
- 20 CONTINUE
- PARM=' '
- IF(IP1.GT.0) THEN
- IF(STRING(IP1:IP1).EQ.'"') IP1=IP1+1
- IF(STRING(IP2:IP2).EQ.'"') IP2=IP2-1
- IF(IP1.LE.IP2) PARM=STRING(IP1:IP2)
- ENDIF
-#endif
-99 RETURN
- END
diff --git a/src/packlib/kernlib/kernbit/z264/getcom.c b/src/packlib/kernlib/kernbit/z264/getcom.c
deleted file mode 100644
index 877fd71..0000000
--- a/src/packlib/kernlib/kernbit/z264/getcom.c
+++ /dev/null
@@ -1,47 +0,0 @@
-/*
- * $Id: getcom.c,v 1.3 1997/09/02 14:24:15 mclareni Exp $
- *
- * $Log: getcom.c,v $
- * Revision 1.3 1997/09/02 14:24:15 mclareni
- * WINNT correction
- *
- * Revision 1.2 1997/02/04 17:34:07 mclareni
- * Merge Winnt and 97a versions
- *
- * Revision 1.1.1.1.2.1 1997/01/21 11:29:16 mclareni
- * All mods for Winnt 96a on winnt branch
- *
- * Revision 1.1.1.1 1996/02/15 17:47:53 mclareni
- * Kernlib
- *
- */
-#include "kernbit/pilot.h"
-#if defined(CERNLIB_WINNT)
- #include <windows.h>
- #include <string.h>
- #include <stdlib.h>
-/*
- * SUBROUTINE GETCOM(STRING,ISLEN)
- *
- * CERN PROGLIB# Z264 IARGC .VERSION Microsoft C 940118
- *
- * Returns command line
- * Author: Valery Fine 94/01/18
- */
-#ifndef CERNLIB_MSSTDCALL
- void getcom_(string,islen,maxlen)
-#else
- void _stdcall GETCOM(string,maxlen,islen)
-#endif
- char *string;
- int *islen;
- int maxlen;
- {
- if (maxlen>0) {
- char *lpCommandLine;
- lpCommandLine = GetCommandLine();
- *islen = min(strlen(lpCommandLine),maxlen);
- memcpy(string,lpCommandLine,*islen);
- }
- }
-#endif
diff --git a/src/packlib/kernlib/kernbit/z264/iargc.F b/src/packlib/kernlib/kernbit/z264/iargc.F
deleted file mode 100644
index a5518f4..0000000
--- a/src/packlib/kernlib/kernbit/z264/iargc.F
+++ /dev/null
@@ -1,61 +0,0 @@
-*
-* $Id: iargc.F,v 1.2 1997/02/04 17:34:08 mclareni Exp $
-*
-* $Log: iargc.F,v $
-* Revision 1.2 1997/02/04 17:34:08 mclareni
-* Merge Winnt and 97a versions
-*
-* Revision 1.1.1.1.2.1 1997/01/21 11:29:17 mclareni
-* All mods for Winnt 96a on winnt branch
-*
-* Revision 1.1.1.1 1996/02/15 17:47:52 mclareni
-* Kernlib
-*
-*
-#include "kernbit/pilot.h"
- FUNCTION IARGC()
-C
-C CERN PROGLIB# Z264 IARGC .VERSION KERNVAX x.xx 911130
-C
-C Returns number of arguments in command line
-C Author: Miguel Marquina 91/11/30
-C
-C Mods Date Comments
-C V.Fine 94/01/18 Windows/NT support
-C M.Marquina 92/12/05 Treat quote-delimited strings as single args
-C
- COMMON/Z264/IREAD,ISLEN,STRING
- CHARACTER*255 STRING
- LOGICAL LB,LQ
- IF(IREAD.EQ.0) THEN
- STRING=' '
- IFL=0
-#if defined(CERNLIB_VAXVMS)
- IRC=LIB$GET_FOREIGN(STRING,,ISLEN,IFL)
-#endif
-#if defined(CERNLIB_WINNT)
- CALL GETCOM(STRING,ISLEN)
-#endif
- IREAD=1
- ENDIF
- NW=0
- IF(ISLEN.EQ.0) GOTO 20
- LB=.TRUE.
- LQ=.FALSE.
- DO 10 N=1,ISLEN
- IF(STRING(N:N).EQ.'"') LQ=.NOT.LQ
- IF(LQ) GOTO 10
- IF(STRING(N:N).NE.' '.AND.LB) LB=.FALSE.
- IF(STRING(N:N).EQ.' '.AND..NOT.LB) THEN
- LB=.TRUE.
- NW=NW+1
- ENDIF
-10 CONTINUE
- IF(STRING(N-1:N-1).NE.' ') NW=NW+1
-20 CONTINUE
- IARGC=NW
-#if defined(CERNLIB_WINNT)
- IARGC=IARGC-1
-#endif
- RETURN
- END
diff --git a/src/packlib/kernlib/kernbit/z265/Imakefile b/src/packlib/kernlib/kernbit/z265/Imakefile
deleted file mode 100644
index 31690e9..0000000
--- a/src/packlib/kernlib/kernbit/z265/Imakefile
+++ /dev/null
@@ -1,4 +0,0 @@
-SRCS_F= \ @@\
- whichf.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kernbit/z265/whichf.F b/src/packlib/kernlib/kernbit/z265/whichf.F
deleted file mode 100644
index 73d3966..0000000
--- a/src/packlib/kernlib/kernbit/z265/whichf.F
+++ /dev/null
@@ -1,70 +0,0 @@
-*
-* $Id: whichf.F,v 1.1.1.1 1996/02/15 17:47:53 mclareni Exp $
-*
-* $Log: whichf.F,v $
-* Revision 1.1.1.1 1996/02/15 17:47:53 mclareni
-* Kernlib
-*
-*
-#include "kernbit/pilot.h"
-#if defined(CERNLIB_UNIX)
- SUBROUTINE WHICHF(CHPATH,CHLOOK,CHFILE)
-*
-* CERN PROGLIB# Z265 WHICHF .VERSION KERNBIT 1.09 920701
-* Author: Jamie Shiers
-* FORTRAN callable version of Unix which command
-*
-* Input: CHPATH - character variable containing the pathname
-* which is searched
-* CHLOOK - the program (file) to look for
-* Output: CHFILE - the full name of the file
-* COMMON/SLATE/IS(40)
-* IS(1) - length of CHFILE. 0 = no match
-*
- CHARACTER*(*) CHPATH,CHLOOK,CHFILE
- COMMON/SLATE/ IS(40)
- CHARACTER*255 CHNAME,CHPROG
- LOGICAL IEXIST
-
- LPATH = LENOCC(CHPATH)
- LPROG = LENOCC(CHLOOK)
- CHPROG = CHLOOK(1:LPROG)
-*
-* Loop over all elements in path name
-*
- ISTART = 1
-10 CONTINUE
- ICOLON = INDEX(CHPATH(ISTART:LPATH),':')
- IF(ICOLON.NE.0) THEN
- IEND = ISTART + ICOLON - 2
- ELSE
- IEND = LPATH
- ENDIF
-*
-* In case of a dot, get CWD
-*
- IF(CHPATH(ISTART:IEND).EQ.'.') THEN
- CALL GETWDF(CHNAME)
- CHFILE = CHNAME(1:IS(1)) // '/'
- + // CHPROG(1:LPROG)
- ELSE
- CHFILE = CHPATH(ISTART:IEND) // '/'
- + // CHPROG(1:LPROG)
- ENDIF
- LFILE = LENOCC(CHFILE)
-*
-* Does this file exist?
-*
- INQUIRE(FILE=CHFILE(1:LFILE),EXIST=IEXIST)
- IF(IEXIST) THEN
- IS(1) = LFILE
- RETURN
- ENDIF
-
- ISTART = ISTART + ICOLON
- IF(ICOLON.NE.0) GOTO 10
-
- IS(1) = 0
-
- END
-#endif
diff --git a/src/packlib/kernlib/kernbit/z268/Imakefile b/src/packlib/kernlib/kernbit/z268/Imakefile
deleted file mode 100644
index 4b4fc19..0000000
--- a/src/packlib/kernlib/kernbit/z268/Imakefile
+++ /dev/null
@@ -1,4 +0,0 @@
-SRCS_C= \ @@\
- systems.c
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kernbit/z268/systems.c b/src/packlib/kernlib/kernbit/z268/systems.c
deleted file mode 100644
index 9845945..0000000
--- a/src/packlib/kernlib/kernbit/z268/systems.c
+++ /dev/null
@@ -1,235 +0,0 @@
-/*
- * $Id: systems.c,v 1.5 2006/09/15 09:35:15 mclareni Exp $
- *
- * $Log: systems.c,v $
- * Revision 1.5 2006/09/15 09:35:15 mclareni
- * Submitted mods for gcc4/gfortran and MacOSX, corrected to work also on slc4 with gcc3.4 and 4.1
- *
- * Revision 1.4 1998/08/25 12:45:56 mclareni
- * QMGLIBC changes for Linux RH51
- *
- * Revision 1.3 1997/09/02 14:24:26 mclareni
- * WINNT correction
- *
- * Revision 1.2 1997/02/04 17:34:10 mclareni
- * Merge Winnt and 97a versions
- *
- * Revision 1.1.1.1.2.1 1997/01/21 11:29:18 mclareni
- * All mods for Winnt 96a on winnt branch
- *
- * Revision 1.1.1.1 1996/02/15 17:47:53 mclareni
- * Kernlib
- *
- */
-#include "kernbit/pilot.h"
-/* Small mods V.Fine 97/08/16
- for Windows NT
- */
-
-/* Small mods G.Folger 94/09/23
- * shorten lines to less than 80 chars
- * add names defined in ANSI mode
- * HPUX, IBMRT have _ for fotran too.
- * shift_systems changed to void, all uses and return's are for void
- * /
-
-/*
- * Copyright (C) 1993 by CERN/CN/SW/DC
- * All rights reserved
- */
-
-#ifdef __hpux /* to compile with -Aa option, ie, ansi */
-#define _HPUX_SOURCE
-#endif
-
-#ifdef __apollo
-#define _INCLUDE_BSD_SOURCE
-#endif /* __apollo */
-
-
-#include <stdio.h>
-#include <errno.h>
-#if !defined(_OSK) && !defined(CERNLIB_WINNT) /* OS 9 */
-# include <sys/wait.h>
-#endif
-#include <string.h> /* needed GF */
-
-#ifdef _OSK /* OS9 has no EINVAL */
-#define EINVAL EOS_ILLARG
-#endif
-
-
-#ifndef lint
-static char sccsid[] =
- "@(#)systems.c 1.2 6/8/94 CERN CN-SW/DC Felix Hassine";
-#endif /* not lint */
-
-#ifndef WIN32
- extern int errno;
-#else
-# ifndef popen
-# define popen _popen
-# endif
-# ifndef pclose
-# define pclose _pclose
-# endif
-# ifndef sys_errlist
-# define sys_errlist _sys_errlist
-# endif
-#endif
-
-#if !defined(CERNLIB_QMGLIBC)
-extern char *sys_errlist[] ; /* System error list */
-#endif
-
-/*
- * The following function executes with popen()
- * the command specified by the string command
- * and stores the buflen first bytes of the stdout output
- * stream into buf. Stderr is not redirected nor closed.
- *
- * l : number of lines of the output. A line is assumed to
- * be defined by the lexical expression: ^.*\n
- * chars : Number of characters stored into buf
- * rc : returned code of the command
- * ovflw : Indicates if buf provided was large enough (0) or not (1).
- */
-
-void shift_systems( command, buf, buflen, l, chars , rc, ovflw )
-
-char *command;
-char *buf;
-int buflen ;
-int *l;
-int *chars;
-int *rc;
-int *ovflw;
-{
- FILE *ps ;
- int rcode ;
- char ebuf[1024];
- int i,count;
- char *b,*cp;
-
- if ( !strlen(command) ) {
- fprintf(stderr,"systems(): Command badly specified.\n");
- *rc= -EINVAL;
- *chars=0 ;
- *l=0 ;
- return;
- }
-
- if ( buflen <= 0) {
- *rc= -EINVAL;
- *chars=0 ;
- *l=0 ;
- return;
- }
-
-#if defined(hpux) || defined(__hpux)
- cp = strrstr(command, "\\0") ;
- if ( cp != NULL && strcspn(cp + 2, " ") == 0) {
- *cp='\0' ;
- }
-#endif /* hpux */
-
- if ( (ps=(FILE *)popen(command,"r"))==NULL ) {
- fprintf(stderr,"systems(): popen(): %s\n",sys_errlist[errno] );
- *rc= -errno;
- *chars=0 ;
- *l=0 ;
- return;
- }
-
- rcode = fread(buf, 1, buflen , ps );
- if ( rcode < 0 ) {
- fprintf(stderr,"systems(): pipe fread(): %s\n",
- sys_errlist[errno] );
- buf[0]='\n';
- *rc= -errno;
- *chars=0 ;
- *l=0 ;
- return;
- }
- else {
- i = rcode ;
- buf[i]='\0' ;
- rcode = strlen(buf) ;
-#if defined(sgi) || defined(__sgi)
- if ( buflen > rcode)
- memset ( buf + rcode, ' ', buflen - rcode);
-#endif
- }
-
- *chars = rcode ;
-
- /*
- * Empty pipe before pclose !
- */
- while ( fread(ebuf, 1, 1024, ps) > 0 ) ;
- *ovflw = (rcode >= buflen ? 1:0 ) ;
-
- rcode = pclose ( ps );
-#ifndef WIN32
- *rc = WEXITSTATUS ( rcode ) ;
-#else
- *rc = rcode ;
-#endif
-
- /*
- * How many lines ?
- */
- i = 0;
- b = buf ;
- count= 0;
- while (i < strlen(buf) && (b= (char * )strchr( buf + i,'\n')) != NULL){
- i=(int) ( b-buf)+ 1;
- count ++ ;
- }
- *l = count;
-
-}
-
-/*
- * FORTRAN wrapper
- */
-
-#if defined(sun) || defined(__sun) \
-|| defined(sgi) || defined(__sgi) \
-|| ( defined(ultrix) && defined (mips) ) \
-|| ( defined(__ultrix) && defined (__mips) ) \
-|| defined(hpux) || defined(__hpux) \
-|| ( defined(__osf__) && defined(__alpha) ) \
-|| defined(_IBMR2) \
-|| defined(__convexc__) \
-|| defined(_OSK) \
-|| defined(__linux) || defined(__FreeBSD__) || defined(__DARWIN__)
-
- void systems_( command, buf, buflen, l, chars, rc, ovflw )
-
-#elif defined(apollo) || defined(__apollo) || defined(CERNLIB_QXNO_SC)
-
- void systems( command, buf, buflen, l, chars, rc, ovflw )
-
-#elif defined(CERNLIB_MSSTDCALL)
-
- void _stdcall SYSTEMS(command,comlen, buf, buflent, buflen, l, chars, rc, ovflw )
- int comlen,buflent;
-
-#else
-/* if you end up here, then you must add your system.*/
- unported systems( command, buf, buflen, l, chars, rc, ovflw ,comlen, buflent)
-#endif
-
-char *command;
-char *buf;
-int *buflen ;
-int *l;
-int *chars;
-int *rc;
-int *ovflw;
-{
- (void) shift_systems ( command, buf, *buflen, l, chars, rc, ovflw );
- return ;
-
-}
diff --git a/src/packlib/kernlib/kernbit/z313/Imakefile b/src/packlib/kernlib/kernbit/z313/Imakefile
deleted file mode 100644
index 0f9cf78..0000000
--- a/src/packlib/kernlib/kernbit/z313/Imakefile
+++ /dev/null
@@ -1,4 +0,0 @@
-SRCS_F= \ @@\
- jobinfo.F nodeid.F userid.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kernbit/z313/jobinfo.F b/src/packlib/kernlib/kernbit/z313/jobinfo.F
deleted file mode 100644
index 96ae28b..0000000
--- a/src/packlib/kernlib/kernbit/z313/jobinfo.F
+++ /dev/null
@@ -1,56 +0,0 @@
-*
-* $Id: jobinfo.F,v 1.1.1.1 1996/02/15 17:47:53 mclareni Exp $
-*
-* $Log: jobinfo.F,v $
-* Revision 1.1.1.1 1996/02/15 17:47:53 mclareni
-* Kernlib
-*
-*
-#include "kernbit/pilot.h"
- CHARACTER*(*) FUNCTION JOBINFO(PAR)
-C
-C CERN PROGLIB# Z313 JOBINFO .VERSION KERNBIT 1.08 911216
-C ORIG. 16/12/91, Miguel Marquina
-C Extraction of Job Information for Vax/VMS systems
-C
- CHARACTER*(*) PAR
- PARAMETER (JBDATA=20,JBL=15)
- COMMON/Z313IN/JINFO(JBDATA,2)
- CHARACTER*(JBL) JREQ(JBDATA), INFO(JBDATA), JINFO
- CHARACTER*(JBL) USERID,HOSTID
-
- DATA JREQ/'SENDERID','ACCOUNT ','DISTCODE','USERID ','JOBID ',
- + 'STORAGE ','JOBSTAT ','HOSTID ','BMONID ','MBMONID ',
- + 'CPUTIME ','CPUFACT ','MACHINE ','BATCHSYS','GID ',
- + ' ',' ',' ',' ',' '/
- DATA INFO/'userid ','account ','distcode','userid ','INTERACT',
- + 'storage ',' ','nodeid ',' ',' ',
- + '2592000 ','100 ','Unknown ','VMSBATCH',' ',
- + ' ',' ',' ',' ',' '/
-
- IF(JFILL.EQ.1) GOTO 100
- JFILL =1
-C
- INFO(4)=USERID()
-C INFO(6)=STORSZ()
- INFO(8)=HOSTID()
- INFO(1)=INFO(4)
-C
- DO 10 N=1,JBDATA
- JINFO(N,1)=JREQ(N)
- JINFO(N,2)=INFO(N)
-10 CONTINUE
-100 CONTINUE
-C-- Fill Job request
- JOBINFO=' '
- LPAR=LEN(PAR)
- IF(LPAR.LT.1) GOTO 120
- LINF=LEN(JOBINFO)
- DO 110 N=1,JBDATA
- IF(PAR.NE.JREQ(N)(1:LPAR)) GOTO 110
- JOBINFO=INFO(N)(1:MIN(JBL,LINF))
- GOTO 120
-110 CONTINUE
-120 CONTINUE
- RETURN
- END
diff --git a/src/packlib/kernlib/kernbit/z313/nodeid.F b/src/packlib/kernlib/kernbit/z313/nodeid.F
deleted file mode 100644
index 405b268..0000000
--- a/src/packlib/kernlib/kernbit/z313/nodeid.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: nodeid.F,v 1.1.1.1 1996/02/15 17:47:53 mclareni Exp $
-*
-* $Log: nodeid.F,v $
-* Revision 1.1.1.1 1996/02/15 17:47:53 mclareni
-* Kernlib
-*
-*
-#include "kernbit/pilot.h"
- CHARACTER*15 FUNCTION HOSTID()
-C
-C CERN PROGLIB# Z313 HOSTID .VERSION KERNBIT 1.09 920725
-C ORIG. 92/07/25, Miguel Marquina
-C Extraction of Host Identifier
-C
- IMPLICIT NONE
-
- INCLUDE '($SYIDEF)'
- INTEGER LIB$GETSYI, ISTAT,ULEN
-
- CHARACTER*15 STRING
- ISTAT = LIB$GETSYI(SYI$_NODENAME,, STRING, ULEN)
-C
- HOSTID=STRING( 1: ULEN)
- RETURN
- END
diff --git a/src/packlib/kernlib/kernbit/z313/userid.F b/src/packlib/kernlib/kernbit/z313/userid.F
deleted file mode 100644
index 760ec9d..0000000
--- a/src/packlib/kernlib/kernbit/z313/userid.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: userid.F,v 1.1.1.1 1996/02/15 17:47:53 mclareni Exp $
-*
-* $Log: userid.F,v $
-* Revision 1.1.1.1 1996/02/15 17:47:53 mclareni
-* Kernlib
-*
-*
-#include "kernbit/pilot.h"
- CHARACTER*15 FUNCTION USERID()
-C
-C CERN PROGLIB# Z313 USERID .VERSION KERNBIT x.xx 911216
-C ORIG. 16/12/91, Miguel Marquina
-C Extraction of User Identifier
-C
- IMPLICIT NONE
-
- INCLUDE '($JPIDEF)'
- INTEGER LIB$GETJPI, ISTAT,ULEN
-
- CHARACTER*15 STRING
- ISTAT = LIB$GETJPI(JPI$_USERNAME,,,, STRING, ULEN)
-C
- USERID=STRING( 1: ULEN)
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/Imakefile b/src/packlib/kernlib/kerngen/Imakefile
deleted file mode 100644
index 51766ca..0000000
--- a/src/packlib/kernlib/kerngen/Imakefile
+++ /dev/null
@@ -1,32 +0,0 @@
-#define IHaveSubdirs
-#define PassCDebugFlags
-
-
-LIBDIRS= ccgen ccgenci ccgencf ccgenu tcgen xvect
-
-#ifdef unix
-#undef unix
-#endif
-
-#if defined(CERNLIB_UNIX)
-LIBDIRS+=unix tcgens
-#else
-#if defined(CERNLIB_VAXVMS)
-LIBDIRS :=$(LIBDIRS) tcgenc vmscode
-#ifdef CERNLIB_QMALPH
-LIBDIRS :=$(LIBDIRS) tcgens
-#endif
-#else
-LIBDIRS+=other tcgens
-#endif
-#endif
-
-SUBDIRS= $(LIBDIRS) kerngen test
-
-TopOfPackage(kerngen)
-
-SubdirLibraryTarget(kerngen,$(LIBDIRS))
-
-TestSubdirs(test)
-
-InstallIncludeSubdirs(kerngen)
diff --git a/src/packlib/kernlib/kerngen/README b/src/packlib/kernlib/kerngen/README
deleted file mode 100644
index 12c1fc0..0000000
--- a/src/packlib/kernlib/kerngen/README
+++ /dev/null
@@ -1,30 +0,0 @@
-
- KERNLIB
-
----------------------------------------------------------------------
-
-The directories have he following contents:
-
-ccgen General C routines
-ccgencf the CF package of C routines
-ccgenu utility C routines used by CCGEN or CCGENCF
-ccgenci CIO package(Z311), Unix only.
-
-xvect XIN / XOUT routines
-
-tcgen all standard Fortran routines for KERNLIB,
- except: the ones found on KERNNUM Pam
- the ones found also in ccgen, these are in tcgenc
- the ones also in vms/vmsmlan, these are in tcgens
-
-tcgenc continuation of tcgen, has routines which are also in ccgen.
-
-tcgens continuation of tcgen, has routines which are also in vms/vmsmlan
-
-obsolete/kernfor/tcnum routines inherited from KERNNUM to make sure that
- GENSEC remains complete; this is not to be used for making
- a complete KERNLIB on machines where KERNNUM is ready;
-
-obsolete/tcgenr obsolete GENSEC routines
-
-
diff --git a/src/packlib/kernlib/kerngen/ccgen/Imakefile b/src/packlib/kernlib/kerngen/ccgen/Imakefile
deleted file mode 100644
index 3e3410b..0000000
--- a/src/packlib/kernlib/kerngen/ccgen/Imakefile
+++ /dev/null
@@ -1,58 +0,0 @@
-#ifndef CERNLIB_VAXVMS
-
-SRCS_F= accessf.F chdirf.F getenvf.F getwdf.F lstatf.F perrorf.F \ @@\
- readlnf.F renamef.F setenvf.F statf.F systemf.F tmpro.F \ @@\
- tmproi.F toslat.F unlinkf.F
-
-SRCS_C= abend.c accesi.c chdiri.c ctimef.c datime.c datimh.c exitf.c \ @@\
- geteni.c getgidf.c getpidf.c getuidf.c getwdi.c gmtimef.c intrac.c \ @@\
- jmplong.c jmpset.c jumptn.c jumpxn.c kervers.c killf.c locb.c locf.c \ @@\
- perroi.c qnexte.c readlni.c renami.c seteni.c setjmpf.c \ @@\
- sleepf.c signalf.c sigprnt.c sigunbl.c stati.c systei.c \ @@\
- tminit.c unlini.c tmread.c
-
-#ifndef CERNLIB_OS9
-SRCS_C += timel.c lstati.c
-#endif
-
-#ifdef CERNLIB_QFAPOGEE
-SRCS_C += apofsz.c
-#endif
-
-#if defined(CERNLIB_WINNT)
-SRCS_C += lnblnk.c
-#endif
-
-#if defined(CERNLIB_WINNT) && defined(CERNLIB_MSSTDCALL)
-SRCS_C += locbdummy.c locfdummy.c
-#endif
-
-#if defined(CERNLIB_DECS) || defined(CERNLIB_QMVAOS) \
- || defined(CERNLIB_HPUX) || defined(CERNLIB_IBMRT) || defined(CERNLIB_IBMRTD) \
- || defined(CERNLIB_OS9) || defined(CERNLIB_LINUX)
-SRCS_C += lenocc.c lnblnk.c
-#endif
-
-#if defined(CERNLIB_SGI) || defined(CERNLIB_SUN)
-SRCS_C += lenocc.c
-#endif
-
-#else /* VMS */
-
-SRCS_F= accessf.F chdirf.F getenvf.F getwdf.F perrorf.F statf.F toslat.F \ @@\
- renamef.F systemf.F tmpro.F
-
-SRCS_C= accesi.c datime.c datimh.c perroi.c stati.c
-
-#ifdef CERNLIB_QMALPH
-SRCS_C := $(SRCS_C) qnexte.c vxinvb.c vxinvc.c
-#endif
-
-#endif
-
-
-#ifndef CERNLIB_DOS
-SRCS_C := $(SRCS_C) vxinvb.c vxinvc.c
-#endif
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kerngen/ccgen/abend.c b/src/packlib/kernlib/kerngen/ccgen/abend.c
deleted file mode 100644
index ef20498..0000000
--- a/src/packlib/kernlib/kerngen/ccgen/abend.c
+++ /dev/null
@@ -1,36 +0,0 @@
-/*
- * $Id: abend.c,v 1.2 1997/02/04 17:34:12 mclareni Exp $
- *
- * $Log: abend.c,v $
- * Revision 1.2 1997/02/04 17:34:12 mclareni
- * Merge Winnt and 97a versions
- *
- * Revision 1.1.1.1.2.1 1997/01/21 11:29:22 mclareni
- * All mods for Winnt 96a on winnt branch
- *
- * Revision 1.1.1.1 1996/02/15 17:49:20 mclareni
- * Kernlib
- *
- */
-#include "kerngen/pilot.h"
-#include "kerngen/fortranc.h"
-
-/*> ROUTINE ABEND
- CERN PROGLIB# Z035 ABEND .VERSION KERNFOR 4.31 911111
-*/
-#if defined(CERNLIB_QX_SC)
-void type_of_call abend_()
-#endif
-#if defined(CERNLIB_QXNO_SC)
-void type_of_call abend()
-#endif
-#if defined(CERNLIB_QXCAPT)
-void type_of_call ABEND()
-#endif
-{
- exit(7);
-}
-/*> END <----------------------------------------------------------*/
-#ifdef CERNLIB_TCGEN_ABEND
-#undef CERNLIB_TCGEN_ABEND
-#endif
diff --git a/src/packlib/kernlib/kerngen/ccgen/accesi.c b/src/packlib/kernlib/kerngen/ccgen/accesi.c
deleted file mode 100644
index 38c0b9e..0000000
--- a/src/packlib/kernlib/kerngen/ccgen/accesi.c
+++ /dev/null
@@ -1,81 +0,0 @@
-/*
- * $Id: accesi.c,v 1.3 1997/10/23 16:25:08 mclareni Exp $
- *
- * $Log: accesi.c,v $
- * Revision 1.3 1997/10/23 16:25:08 mclareni
- * NT mods, mostly C Fortran interface
- *
- * Revision 1.2 1997/02/04 17:34:13 mclareni
- * Merge Winnt and 97a versions
- *
- * Revision 1.1.1.1.2.1 1997/01/21 11:29:22 mclareni
- * All mods for Winnt 96a on winnt branch
- *
- * Revision 1.1.1.1 1996/02/15 17:49:21 mclareni
- * Kernlib
- *
- */
-#include "kerngen/pilot.h"
-#ifdef CERNLIB_WINNT
-# include <io.h>
-#endif
-/*> ROUTINE ACCESI
- CERN PROGLIB# Z265 ACCESI .VERSION KERNFOR 4.34 930114
- ORIG. 06/10/92, RDM + JZ
- Fortran interface to access
-
- R_OK 4 test for read permission
- W_OK 2 test for write permission
- X_OK 1 test for execute (search) permission
- F_OK 0 test for presence of file
-
- accessible = access(path, mode)
- int accessible;
- char *path;
- int mode;
-
- access checks the given file path for accessibility according to mode,
- which is an inclusive or of the bits R_OK, W_OK, and X_OK. Specifying
- mode as F_OK (that is, 0) tests whether the directories leading to the
- file can be searched and the file exists.
-*/
-#include <stdio.h>
-#include "kerngen/fortchar.h"
-#if defined(CERNLIB_QX_SC)
-int type_of_call accesi_(fname, mode, lgname)
-#endif
-#if defined(CERNLIB_QXNO_SC)
-int type_of_call accesi(fname, mode, lgname)
-#endif
-#if defined(CERNLIB_QXCAPT)
-int type_of_call ACCESI(fname,
-#ifdef CERNLIB_MSSTDCALL
- lfname,
-#endif
- mode, lgname)
-#endif
-#ifdef CERNLIB_MSSTDCALL
- int lfname;
-#endif
-#if defined(CERNLIB_QMCRY)
- _fcd fname;
-#endif
-#if !defined(CERNLIB_QMCRY)
- char *fname;
-#endif
- int *lgname, *mode;
-{
- char *ptf, *fchtak();
- int istat, umode;
-
- istat = -1;
- ptf = fchtak(fname, *lgname);
- if (ptf == NULL) goto exit;
-
- umode = *mode & 7;
- istat = access(ptf, umode);
- free(ptf);
-
-exit:
- return istat;
-}
diff --git a/src/packlib/kernlib/kerngen/ccgen/accessf.F b/src/packlib/kernlib/kerngen/ccgen/accessf.F
deleted file mode 100644
index 5ce8294..0000000
--- a/src/packlib/kernlib/kerngen/ccgen/accessf.F
+++ /dev/null
@@ -1,38 +0,0 @@
-*
-* $Id: accessf.F,v 1.1.1.1 1996/02/15 17:49:21 mclareni Exp $
-*
-* $Log: accessf.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:21 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- LOGICAL FUNCTION ACCESSF (FNAME, MODE)
-C
-C CERN PROGLIB# Z265 ACCESSF .VERSION KERNFOR 4.37 930715
-C ORIG. 06/10/92, RDM + JZ
-C Fortran interface to access
-C
- CHARACTER*(*) FNAME
- INTEGER ACCESI
-
- LGNAME = LNBLNK(FNAME)
-
-#if defined(CERNLIB_QMVAX)
- I = ACCESI (%REF(FNAME), MODE, LGNAME)
-#endif
-#if !defined(CERNLIB_QMVAX)
- I = ACCESI (FNAME, MODE, LGNAME)
-#endif
-
- IF (I .EQ. 0) THEN
- ACCESSF = .TRUE.
- RETURN
- ENDIF
-
- ACCESSF = .FALSE.
- RETURN
- END
-#ifdef CERNLIB_TCGEN_ACCESSF
-#undef CERNLIB_TCGEN_ACCESSF
-#endif
diff --git a/src/packlib/kernlib/kerngen/ccgen/allgs/lnblnk.c b/src/packlib/kernlib/kerngen/ccgen/allgs/lnblnk.c
deleted file mode 100644
index 6d89e63..0000000
--- a/src/packlib/kernlib/kerngen/ccgen/allgs/lnblnk.c
+++ /dev/null
@@ -1,41 +0,0 @@
-/*
- * $Id: lnblnk.c,v 1.3 1997/10/23 16:25:15 mclareni Exp $
- *
- * $Log: lnblnk.c,v $
- * Revision 1.3 1997/10/23 16:25:15 mclareni
- * NT mods, mostly C Fortran interface
- *
- * Revision 1.2 1997/02/04 17:35:00 mclareni
- * Merge Winnt and 97a versions
- *
- * Revision 1.1.1.1.2.1 1997/01/21 11:30:06 mclareni
- * All mods for Winnt 96a on winnt branch
- *
- * Revision 1.1.1.1 1996/02/15 17:49:34 mclareni
- * Kernlib
- *
- */
-/*> ROUTINE LNBLNK
- CERN PROGLIB# M432 LNBLNK .VERSION KERNVMI 1.06 920511
- ORIG. 30/04/92, RDM + JZ
-
- N = LNBLNK (CHLINE) find last non-blank character in CHLINE
-*/
-#ifndef CERNLIB_MSSTDCALL
- int lnblnk_(chline, len)
-#else
- int __stdcall LNBLNK(chline, len)
-#endif
- char *chline;
- int len;
-{
- char *chcur;
-
- chcur = chline + len;
- while (chcur > chline)
- { if (*--chcur != ' ') goto exit; }
- return 0;
-
-exit: return chcur+1 - chline;
-}
-/*> END <----------------------------------------------------------*/
diff --git a/src/packlib/kernlib/kerngen/ccgen/apofsz.c b/src/packlib/kernlib/kerngen/ccgen/apofsz.c
deleted file mode 100644
index dd46e7d..0000000
--- a/src/packlib/kernlib/kerngen/ccgen/apofsz.c
+++ /dev/null
@@ -1,26 +0,0 @@
-/*
- * Get the file size when using Apogee compiler
- * on a Sun Solaris box.
- */
-#include <sys/stat.h>
-#include <stdlib.h>
-
-int
-apofsz_(s,nbytes,slen)
-char *s;
-int *nbytes;
-int slen;
-{
- int i;
- char *ss = (char *)malloc(slen + 1);
- struct stat sbuf;
- for (i = 0; i < slen; i++) {
- if (s[i] == ' ') break;
- else ss[i] = s[i];
- }
- ss[i] = '\0';
- i = stat(ss,&sbuf);
- free(ss);
- *nbytes = (int)sbuf.st_size;
- return i;
-}
diff --git a/src/packlib/kernlib/kerngen/ccgen/chdirf.F b/src/packlib/kernlib/kerngen/ccgen/chdirf.F
deleted file mode 100644
index 663c7d8..0000000
--- a/src/packlib/kernlib/kerngen/ccgen/chdirf.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: chdirf.F,v 1.1.1.1 1996/02/15 17:49:21 mclareni Exp $
-*
-* $Log: chdirf.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:21 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QMVAX)
-#include "vaxsys/chdirf.F"
-#else
- INTEGER FUNCTION CHDIRF (NAME)
-C
-C CERN PROGLIB# Z265 CHDIRF .VERSION KERNFOR 4.26 910313
-C ORIG. 22/02/91, JZ
-C Fortran interface routine to chdir
-C
- CHARACTER NAME*(*)
- INTEGER CHDIRI
-
- LGNAME = LNBLNK (NAME)
- CHDIRF = CHDIRI (NAME,LGNAME)
- RETURN
- END
-#endif
diff --git a/src/packlib/kernlib/kerngen/ccgen/chdiri.c b/src/packlib/kernlib/kerngen/ccgen/chdiri.c
deleted file mode 100644
index 0934113..0000000
--- a/src/packlib/kernlib/kerngen/ccgen/chdiri.c
+++ /dev/null
@@ -1,75 +0,0 @@
-/*
- * $Id: chdiri.c,v 1.3 1997/09/02 14:26:34 mclareni Exp $
- *
- * $Log: chdiri.c,v $
- * Revision 1.3 1997/09/02 14:26:34 mclareni
- * WINNT correction
- *
- * Revision 1.2 1997/02/04 17:34:14 mclareni
- * Merge Winnt and 97a versions
- *
- * Revision 1.1.1.1.2.1 1997/01/21 11:29:23 mclareni
- * All mods for Winnt 96a on winnt branch
- *
- * Revision 1.1.1.1 1996/02/15 17:49:21 mclareni
- * Kernlib
- *
- */
-#include "kerngen/pilot.h"
-#include "kerngen/fortranc.h"
-
-/*> ROUTINE CHDIRI
- CERN PROGLIB# Z265 CHDIRI .VERSION KERNFOR 4.38 931108
- ORIG. 22/02/91, JZ
- Fortran interface routine to chdir
-
- ISTAT = CHDIRF (NAME)
-
- NAME the name of the new current working directory
- ISTAT returns zero if successful
-*/
-#include <stdio.h>
-#ifdef WIN32
-#include <direct.h>
-# ifndef chdir
-# define chdir _chdir
-# endif
-#endif
-#include "kerngen/fortchar.h"
-#if defined(CERNLIB_QX_SC)
-int type_of_call chdiri_(fname,lgname)
-#endif
-#if defined(CERNLIB_QXNO_SC)
-int type_of_call chdiri(fname,lgname)
-#endif
-#if defined(CERNLIB_QXCAPT)
-# ifdef CERNLIB_MSSTDCALL
- int type_of_call CHDIRI(fname, len_fname, lgname)
- int len_fname;
-# else
- int type_of_call CHDIRI(fname,lgname)
-# endif
-#endif
-#if defined(CERNLIB_QMCRY)
- _fcd fname;
-#endif
-#if !defined(CERNLIB_QMCRY)
- char *fname;
-#endif
- int *lgname;
-{
- char *ptname, *fchtak();
- int istat, chdir();
-
-/* get memory and copy NAME terminated */
-
- ptname = fchtak(fname,*lgname);
- if (ptname == NULL) goto bad;
-
- istat = chdir (ptname);
- free (ptname);
- return istat;
-
-bad: return -1;
-}
-/*> END <----------------------------------------------------------*/
diff --git a/src/packlib/kernlib/kerngen/ccgen/ctimef.c b/src/packlib/kernlib/kerngen/ccgen/ctimef.c
deleted file mode 100644
index da36e10..0000000
--- a/src/packlib/kernlib/kerngen/ccgen/ctimef.c
+++ /dev/null
@@ -1,42 +0,0 @@
-/*
- * $Id: ctimef.c,v 1.2 1997/02/04 17:34:14 mclareni Exp $
- *
- * $Log: ctimef.c,v $
- * Revision 1.2 1997/02/04 17:34:14 mclareni
- * Merge Winnt and 97a versions
- *
- * Revision 1.1.1.1.2.1 1997/01/21 11:29:24 mclareni
- * All mods for Winnt 96a on winnt branch
- *
- * Revision 1.1.1.1 1996/02/15 17:49:21 mclareni
- * Kernlib
- *
- */
-#include "kerngen/pilot.h"
-#include "kerngen/fortranc.h"
-
-/*> ROUTINE CTIMEF (CLOCK, STIME)
- CERN PROGLIB# Z265 CTIMEF .VERSION KERNFOR 4.36 930602
- ORIG. 14/03/91, RDM
- Fortran interface routine to ctime
-
- CLOCK encoded time (returned by, e.g. STATF)
- STIME decoded time string of length 24 (CHARACTER*24 STIME)
-*/
-#if defined(CERNLIB_QX_SC)
-void type_of_call ctimef_(clock, stime)
-#endif
-#if defined(CERNLIB_QXNO_SC)
-void type_of_call ctimef(clock, stime)
-#endif
-#if defined(CERNLIB_QXCAPT)
-void type_of_call CTIMEF(clock, stime)
-#endif
-int *clock;
-char *stime;
-{
- char *ctime();
-
- strncpy(stime,ctime(clock),24);
-}
-/*> END <----------------------------------------------------------*/
diff --git a/src/packlib/kernlib/kerngen/ccgen/datime.c b/src/packlib/kernlib/kerngen/ccgen/datime.c
deleted file mode 100644
index eabf509..0000000
--- a/src/packlib/kernlib/kerngen/ccgen/datime.c
+++ /dev/null
@@ -1,95 +0,0 @@
-/*
- * $Id: datime.c,v 1.5 1997/12/19 16:36:06 mclareni Exp $
- *
- * $Log: datime.c,v $
- * Revision 1.5 1997/12/19 16:36:06 mclareni
- * After 2000, the date in ID, ND will have the old format with the year as 2 digits
- *
- * Revision 1.4 1997/12/15 16:52:27 mclareni
- * Make length of structure slate 40, same as common slate in all the other routines
- *
- * Revision 1.3 1997/09/02 14:26:35 mclareni
- * WINNT correction
- *
- * Revision 1.2 1997/02/04 17:34:15 mclareni
- * Merge Winnt and 97a versions
- *
- * Revision 1.1.1.1.2.1 1997/01/21 11:29:24 mclareni
- * All mods for Winnt 96a on winnt branch
- *
- * Revision 1.1.1.1 1996/02/15 17:49:21 mclareni
- * Kernlib
- *
- */
-#include "kerngen/pilot.h"
-#include "kerngen/fortranc.h"
-
-#if defined(CERNLIB_QMIRTD)
-#include "irtdgs/datime.c"
-#else
-/*> ROUTINE DATIME
- CERN PROGLIB# Z007 DATIME .VERSION KERNFOR 4.40 940929
-*/
-#if !defined(CERNLIB_QMOS9)
-#include <sys/types.h>
-#endif
-#include <time.h>
-
-#if defined(CERNLIB_QX_SC)
-#define slate slate_
-struct { int inum[40]; } slate_;
-void type_of_call datime_(id, it)
-#endif
-#if defined(CERNLIB_QXNO_SC)
-struct { int inum[40]; } slate;
-void type_of_call datime(id, it)
-#endif
-#if defined(CERNLIB_QXCAPT)
-#define slate SLATE
-struct { int inum[40]; } SLATE;
-void type_of_call DATIME(id, it)
-#endif
- int *id, *it;
-{
- struct tm *tp;
-#if defined(CERNLIB_QMAPO)
- int nsl;
-#endif
-
-#if (defined(CERNLIB_QMAPO))&&(defined(CERNLIB_QX_SC))
- void type_of_call toslat_();
-#endif
-#if (defined(CERNLIB_QMAPO))&&(defined(CERNLIB_QXNO_SC))
- void type_of_call toslat();
-#endif
-
-#if defined(CERNLIB_QXCAPT)
- void type_of_call TOSLAT();
-#endif
-
- time_t tloc = time(0);
- tp = localtime(&tloc);
- slate.inum[0] = tp->tm_year + 1900;
- slate.inum[1] = tp->tm_mon + 1;
- slate.inum[2] = tp->tm_mday;
- slate.inum[3] = tp->tm_hour;
- slate.inum[4] = tp->tm_min;
- slate.inum[5] = tp->tm_sec;
-#if defined(CERNLIB_QMAPO)
- nsl = 6;
-#endif
-#if (defined(CERNLIB_QMAPO))&&(defined(CERNLIB_QX_SC))
- toslat_ (slate.inum, &nsl);
-#endif
-#if (defined(CERNLIB_QMAPO))&&(defined(CERNLIB_QXNO_SC))
- toslat (slate.inum, &nsl);
-#endif
- *id = (tp->tm_year % 100 ) * 10000;
- *id += (tp->tm_mon + 1) * 100;
- *id += tp->tm_mday;
- *it = tp->tm_hour * 100;
- *it += tp->tm_min;
- return;
-}
-/*> END <----------------------------------------------------------*/
-#endif
diff --git a/src/packlib/kernlib/kerngen/ccgen/datimh.c b/src/packlib/kernlib/kerngen/ccgen/datimh.c
deleted file mode 100644
index 14b621d..0000000
--- a/src/packlib/kernlib/kerngen/ccgen/datimh.c
+++ /dev/null
@@ -1,71 +0,0 @@
-/*
- * $Id: datimh.c,v 1.6 1997/12/19 16:36:09 mclareni Exp $
- *
- * $Log: datimh.c,v $
- * Revision 1.6 1997/12/19 16:36:09 mclareni
- * After 2000, the date in ID, ND will have the old format with the year as 2 digits
- *
- * Revision 1.5 1997/11/05 10:35:32 mclareni
- * Remove the last WNT mod
- *
- * Revision 1.3 1997/09/02 14:26:35 mclareni
- * WINNT correction
- *
- * Revision 1.2 1997/02/04 17:34:15 mclareni
- * Merge Winnt and 97a versions
- *
- * Revision 1.1.1.1.2.1 1997/01/21 11:29:26 mclareni
- * All mods for Winnt 96a on winnt branch
- *
- * Revision 1.1.1.1 1996/02/15 17:49:21 mclareni
- * Kernlib
- *
- */
-#include "kerngen/pilot.h"
-#include "kerngen/fortranc.h"
-
-/*> ROUTINE DATIMH
- CERN PROGLIB# Z007 DATIMH .VERSION KERNFOR 4.40 940929
-*/
-#if !defined(CERNLIB_QMOS9)
-#include <sys/types.h>
-#endif
-#include <time.h>
-
-#if defined(CERNLIB_QX_SC)
-void type_of_call datimh_(dh, th)
-#endif
-#if defined(CERNLIB_QXNO_SC)
-void type_of_call datimh(dh, th)
-#endif
-#if defined(CERNLIB_QXCAPT)
-void type_of_call DATIMH(dh, th)
-#endif
- char dh[7], th[7];
-{
- struct tm *tp;
-
- time_t tloc = time(0);
- tp = localtime(&tloc);
- dh[0] = tp->tm_mday / 10 + '0';
- dh[1] = tp->tm_mday % 10 + '0';
- dh[2] = '/';
- dh[3] = (tp->tm_mon + 1) / 10 + '0';
- dh[4] = (tp->tm_mon + 1) % 10 + '0';
- dh[5] = '/';
- dh[6] = (tp->tm_year % 100) / 10 + '0';
- dh[7] = (tp->tm_year % 100) % 10 + '0';
- th[0] = tp->tm_hour / 10 + '0';
- th[1] = tp->tm_hour % 10 + '0';
- th[2] = '.';
- th[3] = tp->tm_min / 10 + '0';
- th[4] = tp->tm_min % 10 + '0';
- th[5] = '.';
- th[6] = tp->tm_sec / 10 + '0';
- th[7] = tp->tm_sec % 10 + '0';
- return;
-}
-/*> END <----------------------------------------------------------*/
-#ifdef CERNLIB_TCGEN_DATIMH
-#undef CERNLIB_TCGEN_DATIMH
-#endif
diff --git a/src/packlib/kernlib/kerngen/ccgen/dosgs/intrac.c b/src/packlib/kernlib/kerngen/ccgen/dosgs/intrac.c
deleted file mode 100644
index a65ca1d..0000000
--- a/src/packlib/kernlib/kerngen/ccgen/dosgs/intrac.c
+++ /dev/null
@@ -1,31 +0,0 @@
-/*
- * $Id: intrac.c,v 1.1.1.1 1996/02/15 17:49:31 mclareni Exp $
- *
- * $Log: intrac.c,v $
- * Revision 1.1.1.1 1996/02/15 17:49:31 mclareni
- * Kernlib
- *
- */
-/*> ROUTINE INTRAC
- CERN PROGLIB# Z044 INTRAC .VERSION KERNFOR 4.38 931108
-*/
-#ifdef WIN32
-#include <io.h>
-#endif
-#if defined(CERNLIB_QX_SC)
-int intrac_()
-#endif
-#if defined(CERNLIB_QXNO_SC)
-int intrac()
-#endif
-#if defined(CERNLIB_QXCAPT)
-int INTRAC()
-#endif
-{
-#ifdef WIN32
- return (((int) isatty(0)!=0) ? 1 : 0) ;
-#else
- return ((int) isatty(0));
-#endif
-}
-/*> END <----------------------------------------------------------*/
diff --git a/src/packlib/kernlib/kerngen/ccgen/dosgs/lstati.c b/src/packlib/kernlib/kerngen/ccgen/dosgs/lstati.c
deleted file mode 100644
index c91f29d..0000000
--- a/src/packlib/kernlib/kerngen/ccgen/dosgs/lstati.c
+++ /dev/null
@@ -1,98 +0,0 @@
-*
-* $Id: lstati.c,v 1.1.1.1 1996/02/15 17:49:31 mclareni Exp $
-*
-* $Log: lstati.c,v $
-* Revision 1.1.1.1 1996/02/15 17:49:31 mclareni
-* Kernlib
-*
-*
-/*> ROUTINE LSTATI
- CERN PROGLIB# Z265 LSTATI .VERSION KERNFOR 4.38 931108
-C ORIG. 24/03/91, RDM + JZ
- Fortran interface routine to lstat
-*/
-#include <stdio.h>
-#include <sys/types.h>
-#include <sys/stat.h>
-#include "kerngen/fortchar.inc"
-#if defined(CERNLIB_QX_SC)
-int lstati_(fname, info, lgname, slate)
-#endif
-#if defined(CERNLIB_QXNO_SC)
-int lstati(fname, info, lgname, slate)
-#endif
-#if defined(CERNLIB_QXCAPT)
-int LSTATI(fname, info, lgname, slate)
-#endif
-#if defined(CERNLIB_QMCRY)
- _fcd fname;
-#endif
-#if !defined(CERNLIB_QMCRY)
- char *fname;
-#endif
- int *lgname;
- int *info;
- int *slate;
-{
-#ifdef WIN32
-#define lstat stat
-#endif
- struct stat *buf;
- char *ptname, *fchtak();
- int istat, lstat();
-
- istat = -1;
- ptname = fchtak(fname,*lgname);
- if (ptname == NULL) goto out1;
-
- buf = (struct stat *) malloc(sizeof (struct stat));
- if (buf == NULL) goto out2;
-
- istat = lstat(ptname, buf);
-
- if (!istat) {
- info[0] = (int) buf->st_dev;
- info[1] = (int) buf->st_ino;
- info[2] = (int) buf->st_mode;
- info[3] = (int) buf->st_nlink;
- info[4] = (int) buf->st_uid;
- info[5] = (int) buf->st_gid;
- info[6] = (int) buf->st_size;
- info[7] = (int) buf->st_atime;
- info[8] = (int) buf->st_mtime;
- info[9] = (int) buf->st_ctime;
-#if (!defined(CERNLIB_QMSGI))&&(!defined(CERNLIB_QMDOS))
- info[10] = (int) buf->st_blksize;
- info[11] = (int) buf->st_blocks;
-#endif
-#if defined(CERNLIB_QMDOS)
-#ifdef WIN32
- info[10] = 0;
-#else
- info[10] = (int) buf->st_blksize;
-#endif
- info[11] = 0;
-#endif
-#if defined(CERNLIB_QMSGI)
- info[10] = 0;
- info[11] = 0;
-#endif
- *slate++ = (buf->st_mode & S_IFMT) ^ S_IFREG;
-#if !defined(CERNLIB_QMDOS)
- *slate++ = (buf->st_mode & S_IFMT) ^ S_IFLNK;
-#endif
-#if defined(CERNLIB_QMDOS)
- *slate++ = 0;
-#endif
- *slate++ = (buf->st_mode & S_IFMT) ^ S_IFDIR;
- };
-
- free(buf);
-out2: free(ptname);
-out1: return istat;
-
-}
-#ifdef WIN32
-#undef lstat
-#endif
-/*> END <----------------------------------------------------------*/
diff --git a/src/packlib/kernlib/kerngen/ccgen/dosgs/sleepf.c b/src/packlib/kernlib/kerngen/ccgen/dosgs/sleepf.c
deleted file mode 100644
index cf88751..0000000
--- a/src/packlib/kernlib/kerngen/ccgen/dosgs/sleepf.c
+++ /dev/null
@@ -1,39 +0,0 @@
-/*
- * $Id: sleepf.c,v 1.1.1.1 1996/02/15 17:49:31 mclareni Exp $
- *
- * $Log: sleepf.c,v $
- * Revision 1.1.1.1 1996/02/15 17:49:31 mclareni
- * Kernlib
- *
- */
-/*> ROUTINE SLEEPF (NSECS)
- CERN PROGLIB# Z265 SLEEPF .VERSION KERNFOR 4.26 910313
- ORIG. 22/02/91, JZ
- Fortran interface routine to sleep
-*/
-#ifdef WIN32
-#include <windows.h>
-#endif
-#if defined(CERNLIB_QX_SC)
-void sleepf_(seconds)
-#endif
-#if defined(CERNLIB_QXNO_SC)
-void sleepf(seconds)
-#endif
-#if defined(CERNLIB_QXCAPT)
-void SLEEPF(seconds)
-#endif
- int *seconds;
-{
- void sleep();
- int secu;
-
- secu = *seconds;
-#ifdef WIN32
- Sleep(secu*1000));
-#else
- sleep(secu);
-#endif
- return;
-}
-/*> END <----------------------------------------------------------*/
diff --git a/src/packlib/kernlib/kerngen/ccgen/dosgs/timel.c b/src/packlib/kernlib/kerngen/ccgen/dosgs/timel.c
deleted file mode 100644
index 1b190f2..0000000
--- a/src/packlib/kernlib/kerngen/ccgen/dosgs/timel.c
+++ /dev/null
@@ -1,317 +0,0 @@
-/*
- * $Id: timel.c,v 1.1.1.1 1996/02/15 17:49:31 mclareni Exp $
- *
- * $Log: timel.c,v $
- * Revision 1.1.1.1 1996/02/15 17:49:31 mclareni
- * Kernlib
- *
- */
-/*> ROUTINE TIMEL
- CERN PROGLIB# Z007 TIMEST .VERSION KERNFOR 4.38 931108
- ORIG. 01/03/85 FCA, mod 03/11/93 GF
-*/
-#ifdef WIN32
-#include <sys\types.h>
-#else
-#include <sys/types.h>
-#endif
-#include <time.h>
-#ifndef WIN32
-#include <sys/times.h>
-#include <sys/param.h>
-#include <sys/time.h>
-#include <sys/resource.h>
-#endif
-
-#ifndef CLOCKS_PER_SEC
-#define CLOCKS_PER_SEC CLK_TCK
-#endif
-
-
-#ifndef RLIMIT_CPU
-#define RLIMIT_CPU 0 /* For HP-UX... */
-#endif
-#ifndef RLIM_INFINITY
-#define RLIM_INFINITY 0x7fffffff /* For HP-UX... */
-#endif
-
-#if defined(CERNLIB_QSYSBSD)||defined(CERNLIB_QMVMI)||defined(CERNLIB_QMVAOS)
-#define HZ 60.;
-#endif
-
-#ifndef HZ
-#ifdef __GNUC__
-#define HZ 1
-#else
-#define HZ 1./CLOCKS_PER_SEC
-#endif
-#endif
-
-#if defined(CERNLIB_QMDOS)
-#ifdef __GNUC__
-#define sectim 1./timsec
-#define time_t double
-double timfac = 1./CLOCKS_PER_SEC;
-double timsec = (double) 0x7fffffff/CLOCKS_PER_SEC;
-#include <std.h>
-#endif
-#ifdef WIN32
-
-/**************************************************************************\
-*
-* For some reason 'clock()' returns elapsed time on at least the AXP
-* systems. Substitute the routine 'ntclock()' for 'clock()'.
-*
-\**************************************************************************/
-
-#define clock ntclock
-
-#endif
-
-#endif
-#if !defined(CERNLIB_QMDOS)
-struct tms tps;
-#endif
-static float timlim;
-static time_t timstart, timlast;
-static int tml_init = 1;
-float deftim = 999.;
-
-#if defined(CERNLIB_QX_SC)
-#define timest timest_
-#define timex timex_
-#define timed timed_
-#define timel timel_
-#endif
-#if defined(CERNLIB_QXCAPT)
-#define timest TIMEST
-#define timex TIMEX
-#define timed TIMED
-#define timel TIMEL
-#endif
-
- /* local routine called by timst, and time_init */
-static void time_st(timl)
-float timl;
-{
-#if !defined(CERNLIB_QMDOS)
- times(&tps);
-#endif
- timlim = timl;
-#if !defined(CERNLIB_QMDOS)
- timstart = tps.tms_utime+tps.tms_cutime+tps.tms_stime+tps.tms_cstime;
-#endif
-#if defined(CERNLIB_QMDOS)
-#ifdef __GNUC__
- timstart= (long)((time(NULL)&0xfffff)*sectim) * timsec
- + (double)(clock()*timfac);
-#else
- timstart= clock();
-#endif
-
-#endif
- timlast = timstart;
- tml_init = 0;
- return;
-}
- /* local routine to start by default */
-static void time_init()
-{
-#if !defined(CERNLIB_QMDOS)
- struct rlimit rlimit;
-#endif
- float maxtime;
-
- maxtime=deftim;
-
-#if !defined(CERNLIB_QMDOS)
- if (getrlimit(RLIMIT_CPU, &rlimit)==0) {
- if ( rlimit.rlim_cur != RLIM_INFINITY )
- maxtime = (float) rlimit.rlim_cur;
- }
-
-#endif
- time_st(maxtime);
- return;
-}
-
-void timest(timl)
-float *timl;
-{
-#if !defined(CERNLIB_QMDOS)
- struct rlimit rlimit;
-#endif
- float maxtime;
-
- if (tml_init != 0) {
-
-/* get maximum time allowed by system, and do not allow more */
- maxtime = *timl;
-#if !defined(CERNLIB_QMDOS)
- if (getrlimit(RLIMIT_CPU, &rlimit)==0) {
- maxtime = (float) rlimit.rlim_cur;
- maxtime = ( maxtime > *timl ) ? *timl : maxtime;
- }
-#endif
- time_st(maxtime);
- }
- return;
-}
-void timex(tx)
-/*
-C
- CERN PROGLIB# Z007 TIMEX .VERSION KERNFOR 4.38 931108
-C
-*/
-float *tx;
-{
- time_t timnow;
- if (tml_init) {
- time_init();
- *tx = 0.;
- }
- else {
-#if !defined(CERNLIB_QMDOS)
- times(&tps);
- timnow = tps.tms_utime+tps.tms_cutime+tps.tms_stime+tps.tms_cstime;
-#endif
-#if defined(CERNLIB_QMDOS)
-#ifdef _MSDOS_
- timnow= (long)((time(NULL)&0xfffff)*sectim) * timsec
- + (double)(clock()*timfac);
-#else
- timnow= clock();
-#endif
-#endif
- *tx = (float) (timnow - timstart) / HZ;
- }
- return;
-}
-
-void timed(td)
-/*
-C
- CERN PROGLIB# Z007 TIMED .VERSION KERNFOR 4.38 931108
-C
-*/
-float *td;
-{
- time_t timnow;
- if (tml_init) {
- time_init();
- *td = timlim;
- }
- else {
-#if !defined(CERNLIB_QMDOS)
- times(&tps);
- timnow = tps.tms_utime+tps.tms_cutime+tps.tms_stime+tps.tms_cstime;
-#endif
-#if defined(CERNLIB_QMDOS)
-#ifdef _MSDOS_
- timnow= (long)((time(NULL)&0xfffff)*sectim) * timsec
- + (double)(clock()*timfac);
-#else
- timnow=clock();
-#endif
-#endif
- *td = (float) (timnow - timlast) / HZ;
- timlast = timnow;
- }
- return;
-}
-
-void timel(tl)
-/*
-C
- CERN PROGLIB# Z007 TIMEL .VERSION KERNFOR 4.38 931108
-C
-*/
-float *tl;
-{
- time_t timnow;
- if (tml_init) {
- time_init();
- *tl = timlim;
- }
- else {
-#if !defined(CERNLIB_QMDOS)
- times(&tps);
- timnow = tps.tms_utime+tps.tms_cutime+tps.tms_stime+tps.tms_cstime;
-#endif
-#if defined(CERNLIB_QMDOS)
-#ifdef _MSDOS_
- timnow= (long)((time(NULL)&0xfffff)*sectim) * timsec
- + (double)(clock()*timfac);
-#else
- timnow= clock();
-#endif
-#endif
- *tl = timlim - (float) (timnow - timstart) / HZ;
- }
- return;
-}
-#ifdef __GNUC__
-#undef time_t
-#endif
-
-#ifdef WIN32
-#undef clock
-
-/**************************************************************************\
-* ntclock.c -- function to return sum of user and kernel time
-*
-* For some reason 'clock()' returns elapsed time on at least the AXP
-* systems. Call native WIN32 routines to get process CPU time, and
-* return in the same (weird) units defined by 'clock()'.
-*
-\**************************************************************************/
-
-#include <windows.h>
-#include <stdio.h>
-
-clock_t ntclock ()
-{
- double tTotal;
- clock_t cTotal;
- DWORD ret;
- FILETIME ftKernel, ftUser, ftCreate, ftExit;
-
- static HANDLE hProcess = 0;
-
- cTotal = 0;
-
- if (hProcess == 0)
- hProcess = GetCurrentProcess();
-
- ret = GetProcessTimes (hProcess, &ftCreate, &ftExit, &ftKernel, &ftUser);
- if (ret != TRUE){
- ret = GetLastError ();
- printf ("\n* Error on GetProcessTimes in ntclock() 0x%lx", (int)ret);
- return cTotal;
- }
-
- /*
- * Process times are returned in a 64-bit structure, as the number of
- * 100 nanosecond ticks since 1 January 1601. User mode and kernel mode
- * times for this process are in separate 64-bit structures.
- * To convert to floating point seconds, we will:
- *
- * Convert sum of high 32-bit quantities to 64-bit float
- * Multiply by 2**32
- * Add low 32-bit tick counts
- * Divide by 10,000,000 to convert to seconds
- * Convert to 'clock_t' value in "clock ticks"
- */
-
- tTotal = ftKernel.dwHighDateTime + ftUser.dwHighDateTime;
- tTotal = tTotal * 4294967296.0;
- tTotal = tTotal + (ftKernel.dwLowDateTime + ftUser.dwLowDateTime);
- tTotal = tTotal * 1.0E-7;
- cTotal = tTotal * CLOCKS_PER_SEC;
-
- return cTotal;
-}
-
-#endif
-
-/*> END <----------------------------------------------------------*/
diff --git a/src/packlib/kernlib/kerngen/ccgen/dosgs/tmproi.c b/src/packlib/kernlib/kerngen/ccgen/dosgs/tmproi.c
deleted file mode 100644
index 70aa46e..0000000
--- a/src/packlib/kernlib/kerngen/ccgen/dosgs/tmproi.c
+++ /dev/null
@@ -1,41 +0,0 @@
-/*
-* $Id: tmproi.c,v 1.1.1.1 1996/02/15 17:49:32 mclareni Exp $
-*
-* $Log: tmproi.c,v $
-* Revision 1.1.1.1 1996/02/15 17:49:32 mclareni
-* Kernlib
-*
-*/
-/*> ROUTINE TMPROI
- CERN PROGLIB# TMPROI .VERSION KERNFOR 4.36 930602
- ORIG. 30/05/91, JZ
- Fortran interface routine to print a prompt string
- CALL TMPRO (TEXT)
-*/
-#ifdef WIN32
-#include <io.h>
-#endif
-#include <stdio.h>
-#include "kerngen/fortchar.inc"
-#if defined(CERNLIB_QX_SC)
-void tmproi_(ftext, lgtext)
-#endif
-#if defined(CERNLIB_QXNO_SC)
-void tmproi(ftext, lgtext)
-#endif
-#if defined(CERNLIB_QXCAPT)
-void TMPROI(ftext, lgtext)
-#endif
-#if defined(CERNLIB_QMCRY)
- _fcd ftext;
-#endif
-#if !defined(CERNLIB_QMCRY)
- char *ftext;
-#endif
- int *lgtext;
-{
- write (1, ftext, *lgtext);
- return;
-}
-/*> END <----------------------------------------------------------*/
-
diff --git a/src/packlib/kernlib/kerngen/ccgen/exitf.c b/src/packlib/kernlib/kerngen/ccgen/exitf.c
deleted file mode 100644
index 32a2545..0000000
--- a/src/packlib/kernlib/kerngen/ccgen/exitf.c
+++ /dev/null
@@ -1,37 +0,0 @@
-/*
- * $Id: exitf.c,v 1.2 1997/02/04 17:34:16 mclareni Exp $
- *
- * $Log: exitf.c,v $
- * Revision 1.2 1997/02/04 17:34:16 mclareni
- * Merge Winnt and 97a versions
- *
- * Revision 1.1.1.1.2.1 1997/01/21 11:29:27 mclareni
- * All mods for Winnt 96a on winnt branch
- *
- * Revision 1.1.1.1 1996/02/15 17:49:21 mclareni
- * Kernlib
- *
- */
-#include "kerngen/pilot.h"
-#include "kerngen/fortranc.h"
-
-/*> ROUTINE EXITF
- CERN PROGLIB# Z035 EXITF .VERSION KERNFOR 4.39 940228
-*/
-#if defined(CERNLIB_QX_SC)
-void type_of_call exitf_(st)
-#endif
-#if defined(CERNLIB_QXNO_SC)
-void type_of_call exitf(st)
-#endif
-#if defined(CERNLIB_QXCAPT)
-void type_of_call EXITF(st)
-#endif
- int *st;
-{
- exit(*st);
-}
-/*> END <----------------------------------------------------------*/
-#ifdef CERNLIB_TCGEN_EXITF
-#undef CERNLIB_TCGEN_EXITF
-#endif
diff --git a/src/packlib/kernlib/kerngen/ccgen/geteni.c b/src/packlib/kernlib/kerngen/ccgen/geteni.c
deleted file mode 100644
index 3bc009e..0000000
--- a/src/packlib/kernlib/kerngen/ccgen/geteni.c
+++ /dev/null
@@ -1,69 +0,0 @@
-/*
- * $Id: geteni.c,v 1.3 1997/09/02 14:26:36 mclareni Exp $
- *
- * $Log: geteni.c,v $
- * Revision 1.3 1997/09/02 14:26:36 mclareni
- * WINNT correction
- *
- * Revision 1.2 1997/02/04 17:34:17 mclareni
- * Merge Winnt and 97a versions
- *
- * Revision 1.1.1.1.2.1 1997/01/21 11:29:27 mclareni
- * All mods for Winnt 96a on winnt branch
- *
- * Revision 1.1.1.1 1996/02/15 17:49:22 mclareni
- * Kernlib
- *
- */
-#include "kerngen/pilot.h"
-#include "kerngen/fortranc.h"
-
-/*> ROUTINE GETENI
- CERN PROGLIB# Z265 GETENI .VERSION KERNFOR 4.31 911111
- ORIG. 22/02/91, JZ
- Fortran interface routine to getenv
-
- CALL GETENVF (NAME, TEXT*)
-
- NAME the name of the environment variable,
- TEXT returns its value
- ISLATE(1) returns its length
-*/
-#include <stdio.h>
-#include "kerngen/fortchar.h"
-#if defined(CERNLIB_QX_SC)
-void type_of_call geteni_(fname, ftext, lgtext, lgname)
-#endif
-#if defined(CERNLIB_QXNO_SC)
-void type_of_call geteni(fname, ftext, lgtext, lgname)
-#endif
-#if defined(CERNLIB_QXCAPT)
-# ifdef CERNLIB_MSSTDCALL
- void type_of_call GETENI(fname, len_fname, ftext, len_ftext, lgtext, lgname)
- int len_fname, len_ftext;
-# else
- void type_of_call GETENI(fname, ftext, lgtext, lgname)
-# endif
-#endif
-#if defined(CERNLIB_QMCRY)
- _fcd fname, ftext;
-#endif
-#if !defined(CERNLIB_QMCRY)
- char *fname, *ftext;
-#endif
- int *lgtext, *lgname;
-{
- char *ptname, *fchtak();
- char *pttext, *getenv();
- int fchput();
-
- pttext = NULL;
- ptname = fchtak(fname,*lgname);
- if (ptname == NULL) goto out;
- pttext = getenv (ptname);
- free(ptname);
-
-out: *lgtext = fchput (pttext,ftext,*lgtext);
- return;
-}
-/*> END <----------------------------------------------------------*/
diff --git a/src/packlib/kernlib/kerngen/ccgen/getenvf.F b/src/packlib/kernlib/kerngen/ccgen/getenvf.F
deleted file mode 100644
index d06d0b2..0000000
--- a/src/packlib/kernlib/kerngen/ccgen/getenvf.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: getenvf.F,v 1.1.1.1 1996/02/15 17:49:22 mclareni Exp $
-*
-* $Log: getenvf.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:22 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QMVAX)
-#include "vaxsys/getenvf.F"
-#else
- SUBROUTINE GETENVF (NAME, TEXT)
-C
-C CERN PROGLIB# Z265 GETENVF .VERSION KERNFOR 4.26 910313
-C ORIG. 22/02/91, JZ
-C Fortran interface routine to getenv
-C
- COMMON /SLATE/ISL(40)
- CHARACTER*(*) NAME, TEXT
-
- LGN = LNBLNK (NAME)
- NTX = LEN(TEXT)
- CALL GETENI (NAME,TEXT,NTX,LGN)
- ISL(1) = NTX
- RETURN
- END
-#endif
diff --git a/src/packlib/kernlib/kerngen/ccgen/getgidf.c b/src/packlib/kernlib/kerngen/ccgen/getgidf.c
deleted file mode 100644
index 9f2d455..0000000
--- a/src/packlib/kernlib/kerngen/ccgen/getgidf.c
+++ /dev/null
@@ -1,46 +0,0 @@
-/*
- * $Id: getgidf.c,v 1.2 1997/02/04 17:34:18 mclareni Exp $
- *
- * $Log: getgidf.c,v $
- * Revision 1.2 1997/02/04 17:34:18 mclareni
- * Merge Winnt and 97a versions
- *
- * Revision 1.1.1.1.2.1 1997/01/21 11:29:27 mclareni
- * All mods for Winnt 96a on winnt branch
- *
- * Revision 1.1.1.1 1996/02/15 17:49:22 mclareni
- * Kernlib
- *
- */
-#include "kerngen/pilot.h"
-#include "kerngen/fortranc.h"
-
-#if defined(CERNLIB_QMOS9)
-#include "os9gs/getgidf.c"
-#else
-/*> ROUTINE GETGIDF
- CERN PROGLIB# Z265 GETGIDF .VERSION KERNFOR 4.38 931108
- ORIG. 01/04/93, JS
- Fortran interface routine to getgid
-*/
-#include <sys/types.h>
-#if defined(CERNLIB_QX_SC)
-void type_of_call getgidf_(gid)
-#endif
-#if defined(CERNLIB_QXNO_SC)
-void type_of_call getgidf(gid)
-#endif
-#if defined(CERNLIB_QXCAPT)
-void type_of_call GETGIDF(gid)
-#endif
- int *gid;
-{
-#ifndef WIN32
- gid_t getgid();
-
- *gid = getgid();
-#endif
- return;
-}
-/*> END <----------------------------------------------------------*/
-#endif
diff --git a/src/packlib/kernlib/kerngen/ccgen/getpidf.c b/src/packlib/kernlib/kerngen/ccgen/getpidf.c
deleted file mode 100644
index cc69e2d..0000000
--- a/src/packlib/kernlib/kerngen/ccgen/getpidf.c
+++ /dev/null
@@ -1,45 +0,0 @@
-/*
- * $Id: getpidf.c,v 1.2 1997/02/04 17:34:19 mclareni Exp $
- *
- * $Log: getpidf.c,v $
- * Revision 1.2 1997/02/04 17:34:19 mclareni
- * Merge Winnt and 97a versions
- *
- * Revision 1.1.1.1.2.1 1997/01/21 11:29:28 mclareni
- * All mods for Winnt 96a on winnt branch
- *
- * Revision 1.1.1.1 1996/02/15 17:49:22 mclareni
- * Kernlib
- *
- */
-#include "kerngen/pilot.h"
-#include "kerngen/fortranc.h"
-
-#if defined(CERNLIB_QMOS9)
-#include "os9gs/getpidf.c"
-#else
-/*> ROUTINE GETPIDF (IPID)
- CERN PROGLIB# Z265 GETPIDF .VERSION KERNFOR 4.38 931108
- ORIG. 22/02/91, JZ
- Fortran interface routine to getpid
-*/
-#ifdef WIN32
-#include <process.h>
-#endif
-#if defined(CERNLIB_QX_SC)
-void type_of_call getpidf_(pid)
-#endif
-#if defined(CERNLIB_QXNO_SC)
-void type_of_call getpidf(pid)
-#endif
-#if defined(CERNLIB_QXCAPT)
-void type_of_call GETPIDF(pid)
-#endif
- int *pid;
-{
- int getpid();
- *pid = getpid();
- return;
-}
-/*> END <----------------------------------------------------------*/
-#endif
diff --git a/src/packlib/kernlib/kerngen/ccgen/getuidf.c b/src/packlib/kernlib/kerngen/ccgen/getuidf.c
deleted file mode 100644
index 26613a2..0000000
--- a/src/packlib/kernlib/kerngen/ccgen/getuidf.c
+++ /dev/null
@@ -1,46 +0,0 @@
-/*
- * $Id: getuidf.c,v 1.2 1997/02/04 17:34:20 mclareni Exp $
- *
- * $Log: getuidf.c,v $
- * Revision 1.2 1997/02/04 17:34:20 mclareni
- * Merge Winnt and 97a versions
- *
- * Revision 1.1.1.1.2.1 1997/01/21 11:29:28 mclareni
- * All mods for Winnt 96a on winnt branch
- *
- * Revision 1.1.1.1 1996/02/15 17:49:22 mclareni
- * Kernlib
- *
- */
-#include "kerngen/pilot.h"
-#include "kerngen/fortranc.h"
-
-#if defined(CERNLIB_QMOS9)
-#include "os9gs/getuidf.c"
-#else
-/*> ROUTINE GETUIDF
- CERN PROGLIB# Z265 GETUIDF .VERSION KERNFOR 4.38 931108
- ORIG. 01/04/93, JS
- Fortran interface routine to getuid
-*/
-#include <sys/types.h>
-#if defined(CERNLIB_QX_SC)
-void type_of_call getuidf_(uid)
-#endif
-#if defined(CERNLIB_QXNO_SC)
-void type_of_call getuidf(uid)
-#endif
-#if defined(CERNLIB_QXCAPT)
-void type_of_call GETUIDF(uid)
-#endif
- int *uid;
-{
-#ifndef WIN32
- uid_t getuid();
-
- *uid = getuid();
-#endif
- return;
-}
-/*> END <----------------------------------------------------------*/
-#endif
diff --git a/src/packlib/kernlib/kerngen/ccgen/getwdf.F b/src/packlib/kernlib/kerngen/ccgen/getwdf.F
deleted file mode 100644
index 09e39b3..0000000
--- a/src/packlib/kernlib/kerngen/ccgen/getwdf.F
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: getwdf.F,v 1.1.1.1 1996/02/15 17:49:23 mclareni Exp $
-*
-* $Log: getwdf.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:23 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QMVAX)
-#include "vaxsys/getwdf.F"
-#else
- SUBROUTINE GETWDF (TEXT)
-C
-C CERN PROGLIB# Z265 GETWDF .VERSION KERNFOR 4.26 910313
-C ORIG. 22/02/91, JZ
-C Fortran interface routine to getwd
-C
- COMMON /SLATE/ISL(40)
- CHARACTER TEXT*(*)
-
- NTX = LEN(TEXT)
- CALL GETWDI (TEXT, NTX)
- ISL(1) = NTX
- RETURN
- END
-#endif
diff --git a/src/packlib/kernlib/kerngen/ccgen/getwdi.c b/src/packlib/kernlib/kerngen/ccgen/getwdi.c
deleted file mode 100644
index f2d3934..0000000
--- a/src/packlib/kernlib/kerngen/ccgen/getwdi.c
+++ /dev/null
@@ -1,90 +0,0 @@
-/*
- * $Id: getwdi.c,v 1.3 1997/09/02 14:26:36 mclareni Exp $
- *
- * $Log: getwdi.c,v $
- * Revision 1.3 1997/09/02 14:26:36 mclareni
- * WINNT correction
- *
- * Revision 1.2 1997/02/04 17:34:20 mclareni
- * Merge Winnt and 97a versions
- *
- * Revision 1.1.1.1.2.1 1997/01/21 11:29:29 mclareni
- * All mods for Winnt 96a on winnt branch
- *
- * Revision 1.1.1.1 1996/02/15 17:49:23 mclareni
- * Kernlib
- *
- */
-#include "kerngen/pilot.h"
-#include "kerngen/fortranc.h"
-
-/*> ROUTINE GETWDI
- CERN PROGLIB# Z265 GETWDI .VERSION KERNFOR 4.38 931108
- ORIG. 22/02/91, JZ
- Fortran interface routine to getwd
-
- CALL GETWDF (TEXT*)
-
- returns the name of the c.w.d. in TEXT
- ISLATE(1) returns its lenth NTEXT
-*/
-#include <stdio.h>
-#ifdef WIN32
-#include <direct.h>
-# ifndef getcwd
-# define getcwd _getcwd
-# endif
-#endif
-#include "kerngen/fortchar.h"
-#if defined(CERNLIB_QX_SC)
-void type_of_call getwdi_(fname, lgname)
-#endif
-#if defined(CERNLIB_QXNO_SC)
-void type_of_call getwdi(fname, lgname)
-#endif
-#if defined(CERNLIB_QXCAPT)
-# ifdef CERNLIB_MSSTDCALL
- void type_of_call GETWDI(fname, len_fname, lgname)
- int len_fname;
-# else
- void type_of_call GETWDI(fname, lgname)
-# endif
-#endif
-#if defined(CERNLIB_QMCRY)
- _fcd fname;
-#endif
-#if !defined(CERNLIB_QMCRY)
- char *fname;
-#endif
- int *lgname;
-{
- char *malloc();
- char *ptalc, *pttext;
- int fchput();
- int nalc;
-#if !defined(CERNLIB_QGETCWD)
- char *getwd();
-#endif
-#if defined(CERNLIB_QGETCWD)
- char *getcwd();
- int nsize;
-#endif
-
- pttext = NULL;
- nalc = 2048;
- ptalc = malloc(nalc);
- if (ptalc == NULL) goto out;
-
-#if !defined(CERNLIB_QGETCWD)
- pttext = getwd (ptalc);
-#endif
-#if defined(CERNLIB_QGETCWD)
- nsize = nalc;
- pttext = getcwd (ptalc, nsize);
-#endif
-
-out: *lgname = fchput (pttext,fname,*lgname);
- if (ptalc != NULL) free(ptalc);
- return;
-}
-/*> END <----------------------------------------------------------*/
diff --git a/src/packlib/kernlib/kerngen/ccgen/gmtimef.c b/src/packlib/kernlib/kerngen/ccgen/gmtimef.c
deleted file mode 100644
index d981f1a..0000000
--- a/src/packlib/kernlib/kerngen/ccgen/gmtimef.c
+++ /dev/null
@@ -1,61 +0,0 @@
-/*
- * $Id: gmtimef.c,v 1.2 1997/02/04 17:34:21 mclareni Exp $
- *
- * $Log: gmtimef.c,v $
- * Revision 1.2 1997/02/04 17:34:21 mclareni
- * Merge Winnt and 97a versions
- *
- * Revision 1.1.1.1.2.1 1997/01/21 11:29:29 mclareni
- * All mods for Winnt 96a on winnt branch
- *
- * Revision 1.1.1.1 1996/02/15 17:49:23 mclareni
- * Kernlib
- *
- */
-#include "kerngen/pilot.h"
-#include "kerngen/fortranc.h"
-
-#if defined(CERNLIB_QMIRTD)
-#include "irtdgs/gmtimef.c"
-#else
-/*> ROUTINE GMTIMEF (CLOCK, TARR)
- CERN PROGLIB# Z265 GMTIMEF .VERSION KERNFOR 4.32 920229
- ORIG. 14/03/91, RDM
- Fortran interface routine to gmtime
-
- CLOCK encoded time (returned by, e.g. STATF)
- TARR decoded time (INTEGER TARR(9))
-*/
-#include <stdio.h>
-#include <time.h>
-#if defined(CERNLIB_QMAPO)||defined(CERNLIB_QMALT)
-#include <sys/types.h>
-#endif
-
-#if defined(CERNLIB_QX_SC)
-void type_of_call gmtimef_(clock, tarr)
-#endif
-#if defined(CERNLIB_QXNO_SC)
-void type_of_call gmtimef(clock, tarr)
-#endif
-#if defined(CERNLIB_QXCAPT)
-void type_of_call GMTIMEF(clock, tarr)
-#endif
- time_t *clock;
- int *tarr;
-{
- struct tm *gmtime(), *tm;
-
- tm = gmtime(clock);
- tarr[0] = tm->tm_sec;
- tarr[1] = tm->tm_min;
- tarr[2] = tm->tm_hour;
- tarr[3] = tm->tm_mday;
- tarr[4] = tm->tm_mon;
- tarr[5] = tm->tm_year;
- tarr[6] = tm->tm_wday;
- tarr[7] = tm->tm_yday;
- tarr[8] = tm->tm_isdst;
-}
-/*> END <----------------------------------------------------------*/
-#endif
diff --git a/src/packlib/kernlib/kerngen/ccgen/hpxgs/lenocc.c b/src/packlib/kernlib/kerngen/ccgen/hpxgs/lenocc.c
deleted file mode 100644
index 1633427..0000000
--- a/src/packlib/kernlib/kerngen/ccgen/hpxgs/lenocc.c
+++ /dev/null
@@ -1,62 +0,0 @@
-/*
- * $Id: lenocc.c,v 1.1.1.1 1996/02/15 17:49:32 mclareni Exp $
- *
- * $Log: lenocc.c,v $
- * Revision 1.1.1.1 1996/02/15 17:49:32 mclareni
- * Kernlib
- *
- */
-/*> ROUTINE LENOCC
- CERN PROGLIB# M507 LENOCC .VERSION KERNHPX 1.02 920511
- ORIG. 30/04/92, RDM + JZ
-
- N = LENOCC (CHLINE) find last non-blank character in CHLINE
-*/
-#if defined(CERNLIB_QX_SC)
- int lenocc_(chline, len)
-#endif
-#if defined(CERNLIB_QXNO_SC)
- int lenocc(chline, len)
-#endif
- char *chline;
- int len;
-{
- static unsigned int blnk = 0x20202020;
- unsigned int *wdcur;
- char *chcur;
- int ntail, i;
-
- chcur = chline + len;
- if (len <= 24) goto small;
-
-/* ---- handle long string */
-
-/* look at the last ntail characters */
-
- ntail = ((int)chcur & 3);
- for (i = ntail; i > 0; i--)
- { if (*--chcur != ' ') goto exit; }
-
-/* look for trailing blank words */
-
- wdcur = (unsigned int*) (chcur-4);
- while (wdcur >= (unsigned int*)chline )
- { if (*wdcur != blnk) break; wdcur--; }
-
-/* find last non-blank character */
-
- chcur = (char*) (wdcur+1);
- while (chcur > chline)
- { if (*--chcur != ' ') goto exit; }
- return 0;
-
-exit: return chcur+1 - chline;
-
-/* ---- handle short string */
-
-small:
- while (chcur > chline)
- { if (*--chcur != ' ') goto exit; }
- return 0;
-}
-/*> END <----------------------------------------------------------*/
diff --git a/src/packlib/kernlib/kerngen/ccgen/hpxgs/lnblnk.c b/src/packlib/kernlib/kerngen/ccgen/hpxgs/lnblnk.c
deleted file mode 100644
index ce05411..0000000
--- a/src/packlib/kernlib/kerngen/ccgen/hpxgs/lnblnk.c
+++ /dev/null
@@ -1,33 +0,0 @@
-/*
- * $Id: lnblnk.c,v 1.1.1.1 1996/02/15 17:49:32 mclareni Exp $
- *
- * $Log: lnblnk.c,v $
- * Revision 1.1.1.1 1996/02/15 17:49:32 mclareni
- * Kernlib
- *
- */
-/*> ROUTINE LNBLNK
- CERN PROGLIB# M507 LNBLNK .VERSION KERNHPX 1.02 920511
- ORIG. 30/04/92, RDM + JZ
-
- N = LNBLNK (CHLINE) find last non-blank character in CHLINE
-*/
-#if defined(CERNLIB_QX_SC)
- int lnblnk_(chline, len)
-#endif
-#if defined(CERNLIB_QXNO_SC)
- int lnblnk(chline, len)
-#endif
- char *chline;
- int len;
-{
- char *chcur;
-
- chcur = chline + len;
- while (chcur > chline)
- { if (*--chcur != ' ') goto exit; }
- return 0;
-
-exit: return chcur+1 - chline;
-}
-/*> END <----------------------------------------------------------*/
diff --git a/src/packlib/kernlib/kerngen/ccgen/intrac.c b/src/packlib/kernlib/kerngen/ccgen/intrac.c
deleted file mode 100644
index 0db0d4c..0000000
--- a/src/packlib/kernlib/kerngen/ccgen/intrac.c
+++ /dev/null
@@ -1,37 +0,0 @@
-/*
- * $Id: intrac.c,v 1.2 1997/02/04 17:34:21 mclareni Exp $
- *
- * $Log: intrac.c,v $
- * Revision 1.2 1997/02/04 17:34:21 mclareni
- * Merge Winnt and 97a versions
- *
- * Revision 1.1.1.1.2.1 1997/01/21 11:29:29 mclareni
- * All mods for Winnt 96a on winnt branch
- *
- * Revision 1.1.1.1 1996/02/15 17:49:23 mclareni
- * Kernlib
- *
- */
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_WINNT)
-#include "wntgs/intrac.c"
-#elif defined(CERNLIB_QMDOS)
-#include "dosgs/intrac.c"
-#else
-/*> ROUTINE INTRAC
- CERN PROGLIB# Z044 INTRAC .VERSION KERNFOR 4.39 940228
-*/
-#if defined(CERNLIB_QX_SC)
-int intrac_()
-#endif
-#if defined(CERNLIB_QXNO_SC)
-int intrac()
-#endif
-#if defined(CERNLIB_QXCAPT)
-int INTRAC()
-#endif
-{
- return ((int) isatty(0));
-}
-/*> END <----------------------------------------------------------*/
-#endif
diff --git a/src/packlib/kernlib/kerngen/ccgen/irtdgs/datime.c b/src/packlib/kernlib/kerngen/ccgen/irtdgs/datime.c
deleted file mode 100644
index 4771ede..0000000
--- a/src/packlib/kernlib/kerngen/ccgen/irtdgs/datime.c
+++ /dev/null
@@ -1,42 +0,0 @@
-/*
- * $Id: datime.c,v 1.1.1.1 1996/02/15 17:49:30 mclareni Exp $
- *
- * $Log: datime.c,v $
- * Revision 1.1.1.1 1996/02/15 17:49:30 mclareni
- * Kernlib
- *
- */
-/*> ROUTINE DATIME
- CERN PROGLIB# Z007 DATIME .VERSION KERNIRT 1.06 930811
-*/
-#include <sys/types.h>
-#include <time.h>
-
-#define slate slate_
-struct { int inum[79]; } slate_;
-void datime_(id, it)
-#if defined(CERNLIB_QXCAPT)
-#define slate SLATE
-struct { int inum[79]; } slate;
-void DATIME(id, it)
-#endif
- int *id, *it;
-{
- struct tm *tp;
-
- time_t tloc = time(0);
- tp = localtime(&tloc);
- slate.inum[0] = tp->tm_year + 1900;
- slate.inum[2] = tp->tm_mon + 1;
- slate.inum[4] = tp->tm_mday;
- slate.inum[6] = tp->tm_hour;
- slate.inum[8] = tp->tm_min;
- slate.inum[10] = tp->tm_sec;
- *id = tp->tm_year * 10000;
- *id += (tp->tm_mon + 1) * 100;
- *id += tp->tm_mday;
- *it = tp->tm_hour * 100;
- *it += tp->tm_min;
- return;
-}
-/*> END <----------------------------------------------------------*/
diff --git a/src/packlib/kernlib/kerngen/ccgen/irtdgs/gmtimef.c b/src/packlib/kernlib/kerngen/ccgen/irtdgs/gmtimef.c
deleted file mode 100644
index b0f1e4e..0000000
--- a/src/packlib/kernlib/kerngen/ccgen/irtdgs/gmtimef.c
+++ /dev/null
@@ -1,45 +0,0 @@
-/*
- * $Id: gmtimef.c,v 1.1.1.1 1996/02/15 17:49:30 mclareni Exp $
- *
- * $Log: gmtimef.c,v $
- * Revision 1.1.1.1 1996/02/15 17:49:30 mclareni
- * Kernlib
- *
- */
-/*> ROUTINE GMTIMEF (CLOCK, TARR)
- CERN PROGLIB# Z265 GMTIMEF .VERSION KERNIRT 1.06 930811
- ORIG. 14/03/91, RDM
- Fortran interface routine to gmtime
-
- CLOCK encoded time (returned by, e.g. STATF)
- TARR decoded time (INTEGER TARR(9))
-*/
-#include <stdio.h>
-#include <time.h>
-
-#if defined(CERNLIB_QX_SC)
-void gmtimef_(clock, tarr)
-#endif
-#if defined(CERNLIB_QXNO_SC)
-void gmtimef(clock, tarr)
-#endif
-#if defined(CERNLIB_QXCAPT)
-void GMTIMEF(clock, tarr)
-#endif
- time_t *clock;
- int *tarr;
-{
- struct tm *gmtime(), *tm;
-
- tm = gmtime(clock);
- tarr[0] = tm->tm_sec;
- tarr[2] = tm->tm_min;
- tarr[4] = tm->tm_hour;
- tarr[6] = tm->tm_mday;
- tarr[8] = tm->tm_mon;
- tarr[10] = tm->tm_year;
- tarr[12] = tm->tm_wday;
- tarr[14] = tm->tm_yday;
- tarr[16] = tm->tm_isdst;
-}
-/*> END <----------------------------------------------------------*/
diff --git a/src/packlib/kernlib/kerngen/ccgen/irtdgs/locf.c b/src/packlib/kernlib/kerngen/ccgen/irtdgs/locf.c
deleted file mode 100644
index 17a61ae..0000000
--- a/src/packlib/kernlib/kerngen/ccgen/irtdgs/locf.c
+++ /dev/null
@@ -1,28 +0,0 @@
-/*
- * $Id: locf.c,v 1.1.1.1 1996/02/15 17:49:31 mclareni Exp $
- *
- * $Log: locf.c,v $
- * Revision 1.1.1.1 1996/02/15 17:49:31 mclareni
- * Kernlib
- *
- */
-/*> ROUTINE LOCF
- CERN PROGLIB# N100 LOCF .VERSION KERNIRT 1.06 930811
-*/
-* Number of ADdress Units Per Word
-#define NADUPW 8 /* Number of ADdress Units Per Word */
-#define LADUPW 3 /* Logarithm base 2 of ADdress Units Per Word */
-#if defined(CERNLIB_QX_SC)
-unsigned int locf_(iadr)
-#endif
-#if defined(CERNLIB_QXNO_SC)
-unsigned int locf(iadr)
-#endif
-#if defined(CERNLIB_QXCAPT)
-unsigned int LOCF(iadr)
-#endif
- char *iadr;
-{
- return( ((unsigned) iadr) >> LADUPW );
-}
-/*> END <----------------------------------------------------------*/
diff --git a/src/packlib/kernlib/kerngen/ccgen/irtdgs/lstati.c b/src/packlib/kernlib/kerngen/ccgen/irtdgs/lstati.c
deleted file mode 100644
index 64a05c6..0000000
--- a/src/packlib/kernlib/kerngen/ccgen/irtdgs/lstati.c
+++ /dev/null
@@ -1,67 +0,0 @@
-*
-* $Id: lstati.c,v 1.1.1.1 1996/02/15 17:49:31 mclareni Exp $
-*
-* $Log: lstati.c,v $
-* Revision 1.1.1.1 1996/02/15 17:49:31 mclareni
-* Kernlib
-*
-*
-/*> ROUTINE LSTATI
- CERN PROGLIB# Z265 LSTATI .VERSION KERNIRT 1.06 930811
-C ORIG. 24/03/91, RDM + JZ
- Fortran interface routine to lstat
-*/
-#include <stdio.h>
-#include <sys/types.h>
-#include <sys/stat.h>
-#include "kerngen/fortchar.inc"
-#if defined(CERNLIB_QX_SC)
-int lstati_(fname, info, lgname, slate)
-#endif
-#if defined(CERNLIB_QXNO_SC)
-int lstati(fname, info, lgname, slate)
-#endif
-#if defined(CERNLIB_QXCAPT)
-int LSTATI(fname, info, lgname, slate)
-#endif
- int *lgname;
- int *info;
- int *slate;
-{
- struct stat *buf;
- char *ptname, *fchtak();
- int istat, lstat();
-
- istat = -1;
- ptname = fchtak(fname,*lgname);
- if (ptname == NULL) goto out1;
-
- buf = (struct stat *) malloc(sizeof (struct stat));
- if (buf == NULL) goto out2;
-
- istat = lstat(ptname, buf);
-
-/ if (!istat) {
- info[0] = (int) buf->st_dev;
- info[2] = (int) buf->st_ino;
- info[4] = (int) buf->st_mode;
- info[6] = (int) buf->st_nlink;
- info[8] = (int) buf->st_uid;
- info[10] = (int) buf->st_gid;
- info[12] = (int) buf->st_size;
- info[14] = (int) buf->st_atime;
- info[16] = (int) buf->st_mtime;
- info[18] = (int) buf->st_ctime;
- info[20] = (int) buf->st_blksize;
- info[22] = (int) buf->st_blocks;
- *slate++ = (buf->st_mode & S_IFMT) ^ S_IFREG;
- *slate++ = (buf->st_mode & S_IFMT) ^ S_IFLNK;
- *slate++ = (buf->st_mode & S_IFMT) ^ S_IFDIR;
- };
-
- free(buf);
-out2: free(ptname);
-out1: return istat;
-
-}
-/*> END <----------------------------------------------------------*/
diff --git a/src/packlib/kernlib/kerngen/ccgen/irtdgs/timel.c b/src/packlib/kernlib/kerngen/ccgen/irtdgs/timel.c
deleted file mode 100644
index eb29621..0000000
--- a/src/packlib/kernlib/kerngen/ccgen/irtdgs/timel.c
+++ /dev/null
@@ -1,159 +0,0 @@
-/*
- * $Id: timel.c,v 1.1.1.1 1996/02/15 17:49:31 mclareni Exp $
- *
- * $Log: timel.c,v $
- * Revision 1.1.1.1 1996/02/15 17:49:31 mclareni
- * Kernlib
- *
- */
-/*> ROUTINE TIMEL
- CERN PROGLIB# Z007 TIMEST .VERSION KERNIRT 1.06 930811
- ORIG. 01/03/85 FCA, mod 02/06/93 GF
-*/
-#include <sys/types.h>
-#include <time.h>
-#include <sys/times.h>
-#include <sys/param.h>
-#include <sys/time.h>
-#include <sys/resource.h>
-
-#ifndef RLIMIT_CPU
-#define RLIMIT_CPU 0 /* For HP-UX... */
-#endif
-#ifndef RLIM_INFINITY
-#define RLIM_INFINITY 0x7fffffff /* For HP-UX... */
-#endif
-
-#if defined(CERNLIB_QSYSBSD)
-#define HZ 60.;
-#endif
-
-struct tms tps;
-static float timlim;
-static time_t timstart, timlast;
-static int tml_init = 1;
-float deftim = 999.;
-
-#if defined(CERNLIB_QX_SC)
-#define timest timest_
-#define timex timex_
-#define timed timed_
-#define timel timel_
-#endif
-#if defined(CERNLIB_QXCAPT)
-#define timest TIMEST
-#define timex TIMEX
-#define timed TIMED
-#define timel TIMEL
-#endif
-
- /* local routine called by timst, and time_init */
-static void time_st(timl)
-float timl;
-{
- times(&tps);
- timlim = timl;
- timstart = tps.tms_utime+tps.tms_cutime;
- timlast = timstart;
- tml_init = 0;
- return;
-}
- /* local routine to start by default */
-static void time_init()
-{
- struct rlimit rlimit;
- float maxtime;
-
- maxtime=deftim;
-
- if (getrlimit(RLIMIT_CPU, &rlimit)==0) {
- if ( rlimit.rlim_cur != RLIM_INFINITY )
- maxtime = (float) rlimit.rlim_cur;
- }
-
- time_st(maxtime);
- return;
-}
-
-void timest(timl)
-double *timl;
-{
- struct rlimit rlimit;
- float maxtime;
-
- if (tml_init != 0) {
-
-/* get maximum time allowed by system, and do not allow more */
- maxtime = *timl;
- if (getrlimit(RLIMIT_CPU, &rlimit)==0) {
- maxtime = (float) rlimit.rlim_cur;
- maxtime = ( maxtime > *timl ) ? *timl : maxtime;
- }
- time_st(maxtime);
- }
- return;
-}
-void timex(tx)
-/*
-C
- CERN PROGLIB# Z007 TIMEX .VERSION KERNIRT 1.06 930811
-C
-*/
-double *tx;
-{
- time_t timnow;
- if (tml_init) {
- time_init();
- *tx = 0.;
- }
- else {
- times(&tps);
- timnow = tps.tms_utime+tps.tms_cutime;
- *tx = (float) (timnow - timstart) / HZ;
- }
- return;
-}
-
-void timed(td)
-/*
-C
- CERN PROGLIB# Z007 TIMED .VERSION KERNIRT 1.06 930811
-C
-*/
-double *td;
-{
- time_t timnow;
- if (tml_init) {
- time_init();
- *td = timlim;
- }
- else {
- times(&tps);
- timnow = tps.tms_utime+tps.tms_cutime;
- *td = (float) (timnow - timlast) / HZ;
- timlast = timnow;
- }
- return;
-}
-
-void timel(tl)
-/*
-C
- CERN PROGLIB# Z007 TIMEL .VERSION KERNIRT 1.06 930811
-C
-*/
-double *tl;
-{
- time_t timnow;
- if (tml_init) {
- time_init();
- *tl = timlim;
- }
- else {
- times(&tps);
- timnow = tps.tms_utime+tps.tms_cutime;
- *tl = timlim - (float) (timnow - timstart) / HZ;
- }
- return;
-}
-/*> END <----------------------------------------------------------*/
diff --git a/src/packlib/kernlib/kerngen/ccgen/irtgs/lenocc.c b/src/packlib/kernlib/kerngen/ccgen/irtgs/lenocc.c
deleted file mode 100644
index da2b61d..0000000
--- a/src/packlib/kernlib/kerngen/ccgen/irtgs/lenocc.c
+++ /dev/null
@@ -1,51 +0,0 @@
-/*
- * $Id: lenocc.c,v 1.1.1.1 1996/02/15 17:49:33 mclareni Exp $
- *
- * $Log: lenocc.c,v $
- * Revision 1.1.1.1 1996/02/15 17:49:33 mclareni
- * Kernlib
- *
- */
-/*> ROUTINE LENOCC
- CERN PROGLIB# M507 LENOCC .VERSION KERNIRT 1.05 920511
- ORIG. 30/04/92, RDM + JZ
-
- N = LENOCC (CHLINE) find last non-blank character in CHLINE
-*/
- int lenocc_(chline, len)
- char *chline;
- int len;
-{
- static unsigned int blnk = 0x20202020;
- unsigned int *wdcur;
- char *chcur;
- int ntail, i;
-
- chcur = chline + len;
- if (len <= 24) goto small;
-
-/* ---- handle long string */
-
-/* look for trailing blank words */
-
- wdcur = (unsigned int*) (chcur-4);
- while (wdcur >= (unsigned int*)chline )
- { if (*wdcur != blnk) break; wdcur--; }
-
-/* find last non-blank character */
-
- chcur = (char*) (wdcur+1);
- while (chcur > chline)
- { if (*--chcur != ' ') goto exit; }
- return 0;
-
-exit: return chcur+1 - chline;
-
-/* ---- handle short string */
-
-small:
- while (chcur > chline)
- { if (*--chcur != ' ') goto exit; }
- return 0;
-}
-/*> END <----------------------------------------------------------*/
diff --git a/src/packlib/kernlib/kerngen/ccgen/irtgs/lnblnk.c b/src/packlib/kernlib/kerngen/ccgen/irtgs/lnblnk.c
deleted file mode 100644
index 4bc5509..0000000
--- a/src/packlib/kernlib/kerngen/ccgen/irtgs/lnblnk.c
+++ /dev/null
@@ -1,51 +0,0 @@
-/*
- * $Id: lnblnk.c,v 1.1.1.1 1996/02/15 17:49:33 mclareni Exp $
- *
- * $Log: lnblnk.c,v $
- * Revision 1.1.1.1 1996/02/15 17:49:33 mclareni
- * Kernlib
- *
- */
-/*> ROUTINE LNBLNK
- CERN PROGLIB# M507 LNBLNK .VERSION KERNIRT 1.05 920511
- ORIG. 30/04/92, RDM + JZ
-
- N = LNBLNK (CHLINE) find last non-blank character in CHLINE
-*/
- int lnblnk_(chline, len)
- char *chline;
- int len;
-{
- static unsigned int blnk = 0x20202020;
- unsigned int *wdcur;
- char *chcur;
- int ntail, i;
-
- chcur = chline + len;
- if (len <= 24) goto small;
-
-/* ---- handle long string */
-
-/* look for trailing blank words */
-
- wdcur = (unsigned int*) (chcur-4);
- while (wdcur >= (unsigned int*)chline )
- { if (*wdcur != blnk) break; wdcur--; }
-
-/* find last non-blank character */
-
- chcur = (char*) (wdcur+1);
- while (chcur > chline)
- { if (*--chcur != ' ') goto exit; }
- return 0;
-
-exit: return chcur+1 - chline;
-
-/* ---- handle short string */
-
-small:
- while (chcur > chline)
- { if (*--chcur != ' ') goto exit; }
- return 0;
-}
-/*> END <----------------------------------------------------------*/
diff --git a/src/packlib/kernlib/kerngen/ccgen/irtgs/signalf.c b/src/packlib/kernlib/kerngen/ccgen/irtgs/signalf.c
deleted file mode 100644
index 04dd945..0000000
--- a/src/packlib/kernlib/kerngen/ccgen/irtgs/signalf.c
+++ /dev/null
@@ -1,50 +0,0 @@
-/*
- * $Id: signalf.c,v 1.1.1.1 1996/02/15 17:49:33 mclareni Exp $
- *
- * $Log: signalf.c,v $
- * Revision 1.1.1.1 1996/02/15 17:49:33 mclareni
- * Kernlib
- *
- */
-/*> ROUTINE SIGNALF
- CERN PROGLIB# SIGNALF .VERSION KERNIRT 1.03 910314
- ORIG. 12/03/91, JZ
- FORTRAN interface routine to sigaction */
-#include <stdio.h>
-#include <signal.h>
-#include <errno.h>
-#if defined(CERNLIB_IBMRT)&&defined(CERNLIB_QXNO_SC)
-int signalf(signum,funct,flag)
-#else
-int signalf_(signum,funct,flag)
-#endif
- long *signum, *flag;
- long *funct;
-{
- int sigaction();
- int istat, signo;
-
- struct mysig {
- int sa_handler;
- sigset_t sa_mask;
- int sa_flags;
- };
-
- struct mysig newbuf;
- struct mysig oldbuf;
-
- signo = *signum;
-
- if (*flag < 0) newbuf.sa_handler = funct;
- else if (*flag == 0) newbuf.sa_handler = SIG_DFL;
- else if (*flag == 1) newbuf.sa_handler = SIG_IGN;
- else newbuf.sa_handler = *flag;
-
- newbuf.sa_flags = 0;
- sigemptyset(&newbuf.sa_mask);
-
- istat = sigaction(signo,&newbuf,&oldbuf);
- if (istat == 0) return oldbuf.sa_handler;
- return -errno;
-}
-/*> END <----------------------------------------------------------*/
diff --git a/src/packlib/kernlib/kerngen/ccgen/jmplong.c b/src/packlib/kernlib/kerngen/ccgen/jmplong.c
deleted file mode 100644
index 84b3401..0000000
--- a/src/packlib/kernlib/kerngen/ccgen/jmplong.c
+++ /dev/null
@@ -1,46 +0,0 @@
-/*
- * $Id: jmplong.c,v 1.3 1997/10/23 16:25:09 mclareni Exp $
- *
- * $Log: jmplong.c,v $
- * Revision 1.3 1997/10/23 16:25:09 mclareni
- * NT mods, mostly C Fortran interface
- *
- * Revision 1.2 1997/02/04 17:34:22 mclareni
- * Merge Winnt and 97a versions
- *
- * Revision 1.1.1.1.2.1 1997/01/21 11:29:30 mclareni
- * All mods for Winnt 96a on winnt branch
- *
- * Revision 1.1.1.1 1996/02/15 17:49:23 mclareni
- * Kernlib
- *
- */
-#include "kerngen/pilot.h"
-
-/*> ROUTINE JMPLONG
- CERN PROGLIB# JMPLONG .VERSION KERNFOR 4.36 930602
- Fortran interface routine to longjmp for JMPSET
-*/
-#if defined(CERNLIB_QX_SC)
-void type_of_call jmplong_(area,fnum)
-#endif
-#if defined(CERNLIB_QXNO_SC)
-void type_of_call jmplong(area,fnum)
-#endif
-#if defined(CERNLIB_QXCAPT)
-void type_of_call JMPLONG(area,fnum)
-#endif
- char *area;
- int *fnum;
-{
- int num;
-
- num = *fnum;
-#if defined(CERNLIB_QSIGJMP)
- siglongjmp(area,num);
-#endif
-#if !defined(CERNLIB_QSIGJMP)
- longjmp(area,num);
-#endif
-}
-/*> END <----------------------------------------------------------*/
diff --git a/src/packlib/kernlib/kerngen/ccgen/jmpset.c b/src/packlib/kernlib/kerngen/ccgen/jmpset.c
deleted file mode 100644
index 899a593..0000000
--- a/src/packlib/kernlib/kerngen/ccgen/jmpset.c
+++ /dev/null
@@ -1,95 +0,0 @@
-/*
- * $Id: jmpset.c,v 1.3 1997/10/23 16:25:10 mclareni Exp $
- *
- * $Log: jmpset.c,v $
- * Revision 1.3 1997/10/23 16:25:10 mclareni
- * NT mods, mostly C Fortran interface
- *
- * Revision 1.2 1997/02/04 17:34:22 mclareni
- * Merge Winnt and 97a versions
- *
- * Revision 1.1.1.1.2.1 1997/01/21 11:29:30 mclareni
- * All mods for Winnt 96a on winnt branch
- *
- * Revision 1.1.1.1 1996/02/15 17:49:23 mclareni
- * Kernlib
- *
- */
-#include "kerngen/pilot.h"
-
-/*> ROUTINE JMPSET (AREA, ROUT)
-
- CERN PROGLIB# JMPSET .VERSION KERNFOR 4.29 910718
-
- The function setjmp cannot be implemented
- by a Fortran interface routine
-
- Instead, we provide IRETN = JMPSET (AREA,ROUT) which
- will dump the environment into AREA and call ROUT.
- IRTN = 0 on return signals normal return from ROUT,
- IRTN = n signals return from JMPLONG (AREA,n)
-
-Usage :
- PROGRAM TOP
- COMMON /JMP/ AREA(32)
- EXTERNAL XQT
-
- 12 IRTN = JMPSET (AREA,XQT)
- GO TO 12
- END
-
- SUBROUTINE XQT
- CALL DOWN
- END
-
- SUBROUTINE DOWN
- COMMON /JMP/ AREA(32)
-
- IF (HOME) CALL JMPLONG (AREA,1)
- END
-*/
-#include <setjmp.h>
-#if defined(CERNLIB_QX_SC)
-int type_of_call jmpset_(area,ufun)
-#endif
-#if defined(CERNLIB_QXNO_SC)
-int type_of_call jmpset(area,ufun)
-#endif
-#if defined(CERNLIB_QXCAPT)
-int type_of_call JMPSET(area,ufun)
-#endif
-#if defined(CERNLIB_QSIGJMP)
- sigjmp_buf area;
-#endif
-#if !defined(CERNLIB_QSIGJMP)
- jmp_buf area;
-#endif
-#if defined(CERNLIB_QCCINDAD)
- void (type_of_call ** ufun)();
-#endif
-#if !defined(CERNLIB_QCCINDAD)
- void (type_of_call * ufun)();
-#endif
-{
- void (type_of_call * unext)();
- int irtn;
-
-#if defined(CERNLIB_QCCINDAD)
- unext = *ufun;
-#endif
-#if !defined(CERNLIB_QCCINDAD)
- unext = ufun;
-#endif
-
-#if defined(CERNLIB_QSIGJMP)
- irtn = sigsetjmp(area,7);
-#endif
-#if !defined(CERNLIB_QSIGJMP)
- irtn = setjmp(area);
-#endif
-
- if (irtn != 0) return irtn;
- (* unext)();
- return 0;
-}
-/*> END <----------------------------------------------------------*/
diff --git a/src/packlib/kernlib/kerngen/ccgen/jumptn.c b/src/packlib/kernlib/kerngen/ccgen/jumptn.c
deleted file mode 100644
index ac9a2c6..0000000
--- a/src/packlib/kernlib/kerngen/ccgen/jumptn.c
+++ /dev/null
@@ -1,140 +0,0 @@
-/*
- * $Id: jumptn.c,v 1.4 2004/07/29 14:07:43 mclareni Exp $
- *
- * $Log: jumptn.c,v $
- * Revision 1.4 2004/07/29 14:07:43 mclareni
- * Use the ALPHA/OSF version for 64-bit pointer systems using the CERNLIB_QMLXIA64 cpp flag
- *
- * Revision 1.3 1997/10/23 16:25:10 mclareni
- * NT mods, mostly C Fortran interface
- *
- * Revision 1.2 1997/02/04 17:34:23 mclareni
- * Merge Winnt and 97a versions
- *
- * Revision 1.1.1.1.2.1 1997/01/21 11:29:31 mclareni
- * All mods for Winnt 96a on winnt branch
- *
- * Revision 1.1.1.1 1996/02/15 17:49:24 mclareni
- * Kernlib
- *
- */
-#include "kerngen/pilot.h"
-
-#if defined(CERNLIB_QMLXIA64)||defined(CERNLIB_QMVAOS)
-#include "vaogs/jumptn.c"
-#else
-/*> ROUTINE JUMPTN
- CERN PROGLIB# Z043 JUMPTN .VERSION KERNFOR 4.40 940929
- ORIG. 21/04/88 JZ+FCA
-C
-C- To transfer to the user routine TARGET (say) with 2 parameters
-C- two steps are needed :
-
-C- 1) EXTERNAL TARGET to get the address of TARGET
-C- IADR = JUMPAD (TARGET)
-
-C- 3) CALL JUMPT2 (IADR,par1,par2) to transfer
-*/
-#if defined(CERNLIB_QCCINDAD)
-#define IADR *iadr
-#endif
-#if !defined(CERNLIB_QCCINDAD)
-#define IADR iadr
-#endif
-#if defined(CERNLIB_QX_SC)
-#define jumpt0 type_of_call jumpt0_
-#define jumpt1 type_of_call jumpt1_
-#define jumpt2 type_of_call jumpt2_
-#define jumpt3 type_of_call jumpt3_
-#define jumpt4 type_of_call jumpt4_
-#define jumpt5 type_of_call jumpt5_
-#define jumpt6 type_of_call jumpt6_
-#define jumpt7 type_of_call jumpt7_
-#define jumpt8 type_of_call jumpt8_
-#define jumpt9 type_of_call jumpt9_
-#endif
-#if defined(CERNLIB_QXCAPT)
-#define jumpt0 type_of_call JUMPT0
-#define jumpt1 type_of_call JUMPT1
-#define jumpt2 type_of_call JUMPT2
-#define jumpt3 type_of_call JUMPT3
-#define jumpt4 type_of_call JUMPT4
-#define jumpt5 type_of_call JUMPT5
-#define jumpt6 type_of_call JUMPT6
-#define jumpt7 type_of_call JUMPT7
-#define jumpt8 type_of_call JUMPT8
-#define jumpt9 type_of_call JUMPT9
-#endif
-void jumpt0(iadr)
- void (type_of_call **IADR)();
-{
- (**IADR)();
- return;
-}
-
-void jumpt1(iadr,ixa)
- void (type_of_call **IADR)();
- char *ixa;
-{
- (**IADR)(ixa);
- return;
-}
-
-void jumpt2(iadr, ixa, ixb)
- void (type_of_call **IADR)();
- char *ixa, *ixb;
-{
- (**IADR)(ixa, ixb);
- return;
-}
-void jumpt3(iadr, ixa, ixb, ixc)
- void (type_of_call **IADR)();
- char *ixa, *ixb, *ixc;
-{
- (**IADR)(ixa, ixb, ixc);
- return;
-}
-void jumpt4(iadr, ixa, ixb, ixc, ixd)
- void (type_of_call **IADR)();
- char *ixa, *ixb, *ixc, *ixd;
-{
- (**IADR)(ixa, ixb, ixc, ixd);
- return;
-}
-void jumpt5(iadr, ixa, ixb, ixc, ixd, ixe)
- void (type_of_call **IADR)();
- char *ixa, *ixb, *ixc, *ixd, *ixe;
-{
- (**IADR)(ixa, ixb, ixc, ixd, ixe);
- return;
-}
-void jumpt6(iadr, ixa, ixb, ixc, ixd, ixe, ixf)
- void (type_of_call **IADR)();
- char *ixa, *ixb, *ixc, *ixd, *ixe, *ixf;
-{
- (**IADR)(ixa, ixb, ixc, ixd, ixe, ixf);
- return;
-}
-void jumpt7(iadr, ixa, ixb, ixc, ixd, ixe, ixf, ixg)
- void (type_of_call **IADR)();
- char *ixa, *ixb, *ixc, *ixd, *ixe, *ixf, *ixg;
-{
- (**IADR)(ixa, ixb, ixc, ixd, ixe, ixf, ixg);
- return;
-}
-void jumpt8(iadr, ixa, ixb, ixc, ixd, ixe, ixf, ixg, ixh)
- void (type_of_call **IADR)();
- char *ixa, *ixb, *ixc, *ixd, *ixe, *ixf, *ixg, *ixh;
-{
- (**IADR)(ixa, ixb, ixc, ixd, ixe, ixf, ixg, ixh);
- return;
-}
-void jumpt9(iadr, ixa, ixb, ixc, ixd, ixe, ixf, ixg, ixh, ixi)
- void (type_of_call **IADR)();
- char *ixa, *ixb, *ixc, *ixd, *ixe, *ixf, *ixg, *ixh, *ixi;
-{
- (**IADR)(ixa, ixb, ixc, ixd, ixe, ixf, ixg, ixh, ixi);
- return;
-}
-/*> END <----------------------------------------------------------*/
-#endif
diff --git a/src/packlib/kernlib/kerngen/ccgen/jumpxn.c b/src/packlib/kernlib/kerngen/ccgen/jumpxn.c
deleted file mode 100644
index 8d32042..0000000
--- a/src/packlib/kernlib/kerngen/ccgen/jumpxn.c
+++ /dev/null
@@ -1,152 +0,0 @@
-/*
- * $Id: jumpxn.c,v 1.4 2004/07/29 14:07:43 mclareni Exp $
- *
- * $Log: jumpxn.c,v $
- * Revision 1.4 2004/07/29 14:07:43 mclareni
- * Use the ALPHA/OSF version for 64-bit pointer systems using the CERNLIB_QMLXIA64 cpp flag
- *
- * Revision 1.3 1997/10/23 16:25:11 mclareni
- * NT mods, mostly C Fortran interface
- *
- * Revision 1.2 1997/02/04 17:34:23 mclareni
- * Merge Winnt and 97a versions
- *
- * Revision 1.1.1.1.2.1 1997/01/21 11:29:31 mclareni
- * All mods for Winnt 96a on winnt branch
- *
- * Revision 1.1.1.1 1996/02/15 17:49:24 mclareni
- * Kernlib
- *
- */
-#include "kerngen/pilot.h"
-
-#if defined(CERNLIB_QMLXIA64)||defined(CERNLIB_QMVAOS)
-#include "vaogs/jumpxn.c"
-#else
-/*> ROUTINE JUMPXN
- CERN PROGLIB# Z042 JUMPXN .VERSION KERNFOR 4.40 940929
- ORIG. 21/04/88 JZ+FCA
-C
-C- To transfer to the user routine TARGET (say) with 2 parameters
-C- three steps are needed :
-
-C- 1) EXTERNAL TARGET to get the address of TARGET
-C- IADR = JUMPAD (TARGET)
-
-C- 2) CALL JUMPST (IADR) to set the tranfer address
-
-C- 3) CALL JUMPX2 (par1,par2) to transfer
-*/
-#if defined(CERNLIB_QCCINDAD)
-#define IADR *iadr
-#endif
-#if !defined(CERNLIB_QCCINDAD)
-#define IADR iadr
-#endif
-#if defined(CERNLIB_QX_SC)
-#define jumpad type_of_call jumpad_
-#define jumpst type_of_call jumpst_
-#define jumpx0 type_of_call jumpx0_
-#define jumpx1 type_of_call jumpx1_
-#define jumpx2 type_of_call jumpx2_
-#define jumpx3 type_of_call jumpx3_
-#define jumpx4 type_of_call jumpx4_
-#define jumpx5 type_of_call jumpx5_
-#define jumpx6 type_of_call jumpx6_
-#define jumpx7 type_of_call jumpx7_
-#define jumpx8 type_of_call jumpx8_
-#define jumpx9 type_of_call jumpx9_
-#endif
-#if defined(CERNLIB_QXCAPT)
-#define jumpad type_of_call JUMPAD
-#define jumpst type_of_call JUMPST
-#define jumpx0 type_of_call JUMPX0
-#define jumpx1 type_of_call JUMPX1
-#define jumpx2 type_of_call JUMPX2
-#define jumpx3 type_of_call JUMPX3
-#define jumpx4 type_of_call JUMPX4
-#define jumpx5 type_of_call JUMPX5
-#define jumpx6 type_of_call JUMPX6
-#define jumpx7 type_of_call JUMPX7
-#define jumpx8 type_of_call JUMPX8
-#define jumpx9 type_of_call JUMPX9
-#endif
-
-static void (type_of_call *tarsub)();
-
-/* ---- jumpad --------------------------------------------- */
-int jumpad(ifun)
- char *ifun;
-{
- return (int) ifun;
-}
-/* ---- jumpst --------------------------------------------- */
-void jumpst(iadr)
- void (type_of_call **IADR)();
-{
- tarsub = *IADR;
-}
-/* ---- jumpxn --------------------------------------------- */
-void jumpx0()
-{
- (*tarsub)();
- return;
-}
-
-void jumpx1(ixa)
- char *ixa;
-{
- (*tarsub)(ixa);
- return;
-}
-
-void jumpx2(ixa, ixb)
- char *ixa, *ixb;
-{
- (*tarsub)(ixa, ixb);
- return;
-}
-void jumpx3(ixa, ixb, ixc)
- char *ixa, *ixb, *ixc;
-{
- (*tarsub)(ixa, ixb, ixc);
- return;
-}
-void jumpx4(ixa, ixb, ixc, ixd)
- char *ixa, *ixb, *ixc, *ixd;
-{
- (*tarsub)(ixa, ixb, ixc, ixd);
- return;
-}
-void jumpx5(ixa, ixb, ixc, ixd, ixe)
- char *ixa, *ixb, *ixc, *ixd, *ixe;
-{
- (*tarsub)(ixa, ixb, ixc, ixd, ixe);
- return;
-}
-void jumpx6(ixa, ixb, ixc, ixd, ixe, ixf)
- char *ixa, *ixb, *ixc, *ixd, *ixe, *ixf;
-{
- (*tarsub)(ixa, ixb, ixc, ixd, ixe, ixf);
- return;
-}
-void jumpx7(ixa, ixb, ixc, ixd, ixe, ixf, ixg)
- char *ixa, *ixb, *ixc, *ixd, *ixe, *ixf, *ixg;
-{
- (*tarsub)(ixa, ixb, ixc, ixd, ixe, ixf, ixg);
- return;
-}
-void jumpx8(ixa, ixb, ixc, ixd, ixe, ixf, ixg, ixh)
- char *ixa, *ixb, *ixc, *ixd, *ixe, *ixf, *ixg, *ixh;
-{
- (*tarsub)(ixa, ixb, ixc, ixd, ixe, ixf, ixg, ixh);
- return;
-}
-void jumpx9(ixa, ixb, ixc, ixd, ixe, ixf, ixg, ixh, ixi)
- char *ixa, *ixb, *ixc, *ixd, *ixe, *ixf, *ixg, *ixh, *ixi;
-{
- (*tarsub)(ixa, ixb, ixc, ixd, ixe, ixf, ixg, ixh, ixi);
- return;
-}
-/*> END <----------------------------------------------------------*/
-#endif
diff --git a/src/packlib/kernlib/kerngen/ccgen/kervers.c b/src/packlib/kernlib/kerngen/ccgen/kervers.c
deleted file mode 100644
index b4c85cd..0000000
--- a/src/packlib/kernlib/kerngen/ccgen/kervers.c
+++ /dev/null
@@ -1,14 +0,0 @@
-/*
- * $Id:
- *
- * $Log:
- */
-
-/*
- * Dummy C routine to distinguish cernlib 2002 from earlier releases
- * in configure scripts with nm
- */
-
-void v2002()
-{
-}
diff --git a/src/packlib/kernlib/kerngen/ccgen/killf.c b/src/packlib/kernlib/kerngen/ccgen/killf.c
deleted file mode 100644
index b18e35c..0000000
--- a/src/packlib/kernlib/kerngen/ccgen/killf.c
+++ /dev/null
@@ -1,60 +0,0 @@
-/*
- * $Id: killf.c,v 1.3 1997/09/02 14:26:37 mclareni Exp $
- *
- * $Log: killf.c,v $
- * Revision 1.3 1997/09/02 14:26:37 mclareni
- * WINNT correction
- *
- * Revision 1.2 1997/02/04 17:34:24 mclareni
- * Merge Winnt and 97a versions
- *
- * Revision 1.1.1.1.2.1 1997/01/21 11:29:32 mclareni
- * All mods for Winnt 96a on winnt branch
- *
- * Revision 1.1.1.1 1996/02/15 17:49:24 mclareni
- * Kernlib
- *
- */
-#ifdef WIN32
-# include <windows.h>
-#endif
-
-#include "kerngen/pilot.h"
-#include "kerngen/fortranc.h"
-
-
-/*> ROUTINE KILLF (IPID,ISIG)
- CERN PROGLIB# Z265 KILLF .VERSION KERNFOR 4.26 910313
- ORIG. 22/02/91, JZ
- Fortran interface routine to kill
-*/
-#if defined(CERNLIB_QX_SC)
-int type_of_call killf_(pid, sig)
-#endif
-#if defined(CERNLIB_QXNO_SC)
-int type_of_call killf(pid, sig)
-#endif
-#if defined(CERNLIB_QXCAPT)
-int type_of_call KILLF(pid, sig)
-#endif
- int *pid, *sig;
-{
-#ifndef WIN32
- int kill();
- int pidu, sigu, istat;
-
- pidu = *pid;
- sigu = *sig;
- istat = kill(pidu, sigu);
- return istat;
-#else
- HANDLE hProcess;
- BOOL TermSucc;
-
- hProcess= OpenProcess(PROCESS_ALL_ACCESS, TRUE, *pid);
- if (hProcess == NULL)
- TermSucc= TerminateProcess(hProcess, -1);
- return -1;
-#endif
-}
-/*> END <----------------------------------------------------------*/
diff --git a/src/packlib/kernlib/kerngen/ccgen/lenocc.c b/src/packlib/kernlib/kerngen/ccgen/lenocc.c
deleted file mode 100644
index 6cdc3d6..0000000
--- a/src/packlib/kernlib/kerngen/ccgen/lenocc.c
+++ /dev/null
@@ -1,76 +0,0 @@
-/*
- * $Id: lenocc.c,v 1.3 1997/10/23 16:25:11 mclareni Exp $
- *
- * $Log: lenocc.c,v $
- * Revision 1.3 1997/10/23 16:25:11 mclareni
- * NT mods, mostly C Fortran interface
- *
- * Revision 1.2 1996/09/20 14:51:15 cernlib
- * Linux added
- *
- * Revision 1.1.1.1 1996/02/15 17:49:20 mclareni
- * Kernlib
- *
- */
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QMHPX)||defined(CERNLIB_QMOS9)
-#include "hpxgs/lenocc.c"
-#elif defined(CERNLIB_QMIRT)||defined(CERNLIB_QMIRTD)
-#include "irtgs/lenocc.c"
-#elif 1
-/*> ROUTINE LENOCC
- CERN PROGLIB# M507 LENOCC .VERSION KERNVMI 1.06 920511
- ORIG. 30/04/92, RDM + JZ
-
- N = LENOCC (CHLINE) find last non-blank character in CHLINE
-*/
-#if defined(CERNLIB_QXNO_SC)
- int type_of_call lenocc(chline, len)
-#elif defined(CERNLIB_QXCAPT)
- int type_of_call LENOCC(chline, len)
-#else
- int type_of_call lenocc_(chline, len)
-#endif
- char *chline;
- int len;
-{
- static unsigned int blnk = 0x20202020;
- unsigned int *wdcur;
- char *chcur;
- int ntail, i;
-
- chcur = chline + len;
- if (len <= 24) goto small;
-
-/* ---- handle long string */
-
-/* look at the last ntail characters */
-
- ntail = ((int)chcur & 3);
- for (i = ntail; i > 0; i--)
- { if (*--chcur != ' ') goto exit; }
-
-/* look for trailing blank words */
-
- wdcur = (unsigned int*) (chcur-4);
- while (wdcur >= (unsigned int*)chline )
- { if (*wdcur != blnk) break; wdcur--; }
-
-/* find last non-blank character */
-
- chcur = (char*) (wdcur+1);
- while (chcur > chline)
- { if (*--chcur != ' ') goto exit; }
- return 0;
-
-exit: return chcur+1 - chline;
-
-/* ---- handle short string */
-
-small:
- while (chcur > chline)
- { if (*--chcur != ' ') goto exit; }
- return 0;
-}
-/*> END <----------------------------------------------------------*/
-#endif
diff --git a/src/packlib/kernlib/kerngen/ccgen/lnblnk.c b/src/packlib/kernlib/kerngen/ccgen/lnblnk.c
deleted file mode 100644
index 66a8c04..0000000
--- a/src/packlib/kernlib/kerngen/ccgen/lnblnk.c
+++ /dev/null
@@ -1,28 +0,0 @@
-/*
- * $Id: lnblnk.c,v 1.4 1997/09/02 14:26:37 mclareni Exp $
- *
- * $Log: lnblnk.c,v $
- * Revision 1.4 1997/09/02 14:26:37 mclareni
- * WINNT correction
- *
- * Revision 1.3 1997/02/04 17:34:31 mclareni
- * Merge Winnt and 97a versions
- *
- * Revision 1.2 1996/09/20 14:51:17 cernlib
- * Linux added
- *
- * Revision 1.1.1.1.2.1 1997/01/21 11:29:35 mclareni
- * All mods for Winnt 96a on winnt branch
- *
- * Revision 1.1.1.1 1996/02/15 17:49:28 mclareni
- * Kernlib
- *
- */
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QMHPX)||defined(CERNLIB_QMOS9)
-#include "hpxgs/lnblnk.c"
-#elif defined(CERNLIB_QMIRT)||defined(CERNLIB_QMIRTD)
-#include "irtgs/lnblnk.c"
-#elif defined(CERNLIB_QMVAOS)||defined(CERNLIB_QMVMI)||defined(CERNLIB_LINUX)||defined(CERNLIB_MSSTDCALL)
-#include "allgs/lnblnk.c"
-#endif
diff --git a/src/packlib/kernlib/kerngen/ccgen/locb.c b/src/packlib/kernlib/kerngen/ccgen/locb.c
deleted file mode 100644
index 9251295..0000000
--- a/src/packlib/kernlib/kerngen/ccgen/locb.c
+++ /dev/null
@@ -1,52 +0,0 @@
-/*
- * $Id: locb.c,v 1.3 1997/09/02 14:26:37 mclareni Exp $
- *
- * $Log: locb.c,v $
- * Revision 1.3 1997/09/02 14:26:37 mclareni
- * WINNT correction
- *
- * Revision 1.2 1997/02/04 17:34:31 mclareni
- * Merge Winnt and 97a versions
- *
- * Revision 1.1.1.1.2.1 1997/01/21 11:29:35 mclareni
- * All mods for Winnt 96a on winnt branch
- *
- * Revision 1.1.1.1 1996/02/15 17:49:24 mclareni
- * Kernlib
- *
- */
-#include "kerngen/pilot.h"
-#include "kerngen/fortranc.h"
-
-#if defined(CERNLIB_MSSTDCALL) && defined(CERNLIB_LOCF_CHARACTER)
-# define Dummy2LocPar ,_dummy
-# define DummyDef int _dummy;
-#else
-# define Dummy2LocPar
-# define DummyDef
-#endif
-
-
-/*> ROUTINE LOCB
- CERN PROGLIB# N101 LOCB .VERSION KERNFOR 4.36 930602
-*/
-#if defined(CERNLIB_QX_SC)
-int type_of_call locb_(iadr Dummy2LocPar)
-#endif
-#if defined(CERNLIB_QXNO_SC)
-int type_of_call locb(iadr Dummy2LocPar)
-#endif
-#if defined(CERNLIB_QXCAPT)
-int type_of_call LOCB(iadr Dummy2LocPar)
-#endif
- char *iadr;
-#ifdef DummyDef
- DummyDef
-#endif
-{
- return( (int) iadr );
-}
-/*> END <----------------------------------------------------------*/
-#ifdef CERNLIB_TCGEN_LOCB
-#undef CERNLIB_TCGEN_LOCB
-#endif
diff --git a/src/packlib/kernlib/kerngen/ccgen/locbdummy.c b/src/packlib/kernlib/kerngen/ccgen/locbdummy.c
deleted file mode 100644
index 12ef29e..0000000
--- a/src/packlib/kernlib/kerngen/ccgen/locbdummy.c
+++ /dev/null
@@ -1,12 +0,0 @@
-#include "kerngen/pilot.h"
-#include "kerngen/fortranc.h"
-
-#ifndef CERNLIB_LOCF_CHARACTER
-#define CERNLIB_LOCF_CHARACTER
-#endif
-
-#include "locb.c"
-
-#ifdef CERNLIB_LOCF_CHARACTER
-#undef CERNLIB_LOCF_CHARACTER
-#endif
diff --git a/src/packlib/kernlib/kerngen/ccgen/locf.c b/src/packlib/kernlib/kerngen/ccgen/locf.c
deleted file mode 100644
index 00d8cda..0000000
--- a/src/packlib/kernlib/kerngen/ccgen/locf.c
+++ /dev/null
@@ -1,96 +0,0 @@
-/*
- * $Id: locf.c,v 1.4 2004/07/29 14:06:07 mclareni Exp $
- *
- * $Log: locf.c,v $
- * Revision 1.4 2004/07/29 14:06:07 mclareni
- * Alice version for 64-bit pointer systems using the CERNLIB_QMLXIA64 cpp flag
- *
- * Revision 1.2 2002/12/02 16:37:45 brun
- * Changes from Federico Carminati and Peter Hristov who ported the system
- * on the Ithanium processors.It is tested on HP, Sun, and Alpha, everything
- * seems to work. The optimisation is switched off in case of gcc2.xx.yyy
- *
- * Revision 1.1.1.1 2002/07/24 15:56:28 rdm
- * initial import into CVS
- *
- * Revision 1.1.1.1 2002/06/16 15:18:46 hristov
- * Separate distribution of Geant3
- *
- * Revision 1.1.1.1 1999/05/18 15:55:28 fca
- * AliRoot sources
- *
- * Revision 1.3 1997/09/02 14:26:38 mclareni
- * WINNT correction
- *
- * Revision 1.2 1997/02/04 17:34:35 mclareni
- * Merge Winnt and 97a versions
- *
- * Revision 1.1.1.1.2.1 1997/01/21 11:29:36 mclareni
- * All mods for Winnt 96a on winnt branch
- *
- * Revision 1.1.1.1 1996/02/15 17:49:24 mclareni
- * Kernlib
- *
- */
-#include "kerngen/pilot.h"
-#include "kerngen/fortranc.h"
-#if defined(CERNLIB_QMLXIA64)
-#include "stdio.h"
-#endif
-
-#if defined(CERNLIB_MSSTDCALL) && defined(CERNLIB_LOCF_CHARACTER)
-# define Dummy2LocPar ,_dummy
-# define DummyDef int _dummy;
-#else
-# define Dummy2LocPar
-# define DummyDef
-#endif
-
-#if defined(CERNLIB_QMIRTD)
-#include "irtdgs/locf.c"
-#elif defined(CERNLIB_QMVAOS)
-#include "vaogs/locf.c"
-#else
-/*> ROUTINE LOCF
- CERN PROGLIB# N100 LOCF .VERSION KERNFOR 4.36 930602
-*/
-#define NADUPW 4 /* Number of ADdress Units Per Word */
-#define LADUPW 2 /* Logarithm base 2 of ADdress Units Per Word */
-#if defined(CERNLIB_QX_SC)
-unsigned int type_of_call locf_(iadr Dummy2LocPar)
-#elif defined(CERNLIB_QXNO_SC)
-unsigned int type_of_call locf(iadr Dummy2LocPar)
-#elif defined(CERNLIB_QXCAPT)
-unsigned int type_of_call LOCF(iadr Dummy2LocPar)
-#endif
- char *iadr;
-#ifdef DummDef
- DummyDef
-#endif
-{
-#if defined(CERNLIB_QMLXIA64)
- const unsigned long long int mask=0x00000000ffffffff;
- static unsigned long long int base=1;
- unsigned long long int jadr=(unsigned long long int) iadr;
- unsigned long long int jadrl = ((mask & jadr) >> LADUPW);
-
- if (base == 1) {
- base = (~mask & jadr);
- } else if(base != (~mask & jadr)) {
- printf("!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!\n");
- printf("locf_() Warning: changing base from %lx to %lx!!!\n",
- base, (~mask & jadr));
- printf("This may result in program crash or incorrect results\n");
- printf("!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!\n");
- }
- return ((unsigned) jadrl);
-#else
- return( ((unsigned) iadr) >> LADUPW );
-#endif
-}
-#undef Dummy2LocPar
-#undef DummyDef
-#undef CERNLIB_LOCF_CHARACTER
-/*> END <----------------------------------------------------------*/
-#endif
-
diff --git a/src/packlib/kernlib/kerngen/ccgen/locfdummy.c b/src/packlib/kernlib/kerngen/ccgen/locfdummy.c
deleted file mode 100644
index bc88789..0000000
--- a/src/packlib/kernlib/kerngen/ccgen/locfdummy.c
+++ /dev/null
@@ -1,12 +0,0 @@
-#include "kerngen/pilot.h"
-#include "kerngen/fortranc.h"
-
-#ifndef CERNLIB_LOCF_CHARACTER
-#define CERNLIB_LOCF_CHARACTER
-#endif
-
-#include "locf.c"
-
-#ifdef CERNLIB_LOCF_CHARACTER
-#undef CERNLIB_LOCF_CHARACTER
-#endif
diff --git a/src/packlib/kernlib/kerngen/ccgen/lstatf.F b/src/packlib/kernlib/kerngen/ccgen/lstatf.F
deleted file mode 100644
index 73f615e..0000000
--- a/src/packlib/kernlib/kerngen/ccgen/lstatf.F
+++ /dev/null
@@ -1,35 +0,0 @@
-*
-* $Id: lstatf.F,v 1.1.1.1 1996/02/15 17:49:24 mclareni Exp $
-*
-* $Log: lstatf.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:24 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QMOS9)
-#include "os9gs/lstatf.F"
-#else
- INTEGER FUNCTION LSTATF (NAME, INFO)
-C
-C CERN PROGLIB# Z265 LSTATF .VERSION KERNFOR 4.36 930602
-C ORIG. 24/03/93, RDM + JZ
-C Fortran interface routine to lstat
-C
-C NAME the name of the file of which information is required
-C INFO(12) buffer returning the information about "file"
-C
-C A succesful call returns 0; a failed call returns -1.
-C also: NDSLAT = 0 if NAME is a regular file
-C NESLAT = 0 if NAME is a symbolic link
-C NFSLAT = 0 if NAME is a directory
-C
- CHARACTER*(*) NAME
- INTEGER INFO(12), LSTATI
- COMMON /SLATE/ISLATE(40)
-
- LGN = LNBLNK (NAME)
- LSTATF = LSTATI (NAME, INFO, LGN, ISLATE)
- RETURN
- END
-#endif
diff --git a/src/packlib/kernlib/kerngen/ccgen/lstati.c b/src/packlib/kernlib/kerngen/ccgen/lstati.c
deleted file mode 100644
index af48dce..0000000
--- a/src/packlib/kernlib/kerngen/ccgen/lstati.c
+++ /dev/null
@@ -1,94 +0,0 @@
-/*
-* $Id: lstati.c,v 1.2 1997/02/04 17:34:35 mclareni Exp $
-*
-* $Log: lstati.c,v $
-* Revision 1.2 1997/02/04 17:34:35 mclareni
-* Merge Winnt and 97a versions
-*
-* Revision 1.1.1.1.2.1 1997/01/21 11:29:36 mclareni
-* All mods for Winnt 96a on winnt branch
-*
-* Revision 1.1.1.1 1996/02/15 17:49:29 mclareni
-* Kernlib
-*
-*/
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_WINNT)
-#include "wntgs/lstati.c"
-#elif defined(CERNLIB_QMDOS)
-#include "dosgs/lstati.c"
-#elif defined(CERNLIB_QMIRTD)
-#include "irtdgs/lstati.c"
-#else
-/*> ROUTINE LSTATI
- CERN PROGLIB# Z265 LSTATI .VERSION KERNFOR 4.39 940228
-C ORIG. 24/03/91, RDM + JZ
- Fortran interface routine to lstat
-*/
-#include <stdio.h>
-#include <sys/types.h>
-#include <sys/stat.h>
-#include "kerngen/fortchar.h"
-#if defined(CERNLIB_QX_SC)
-int lstati_(fname, info, lgname, slate)
-#endif
-#if defined(CERNLIB_QXNO_SC)
-int lstati(fname, info, lgname, slate)
-#endif
-#if defined(CERNLIB_QXCAPT)
-int LSTATI(fname, info, lgname, slate)
-#endif
-#if defined(CERNLIB_QMCRY)
- _fcd fname;
-#endif
-#if !defined(CERNLIB_QMCRY)
- char *fname;
-#endif
- int *lgname;
- int *info;
- int *slate;
-{
- struct stat *buf;
- char *ptname, *fchtak();
- int istat, lstat();
-
- istat = -1;
- ptname = fchtak(fname,*lgname);
- if (ptname == NULL) goto out1;
-
- buf = (struct stat *) malloc(sizeof (struct stat));
- if (buf == NULL) goto out2;
-
- istat = lstat(ptname, buf);
-
- if (!istat) {
- info[0] = (int) buf->st_dev;
- info[1] = (int) buf->st_ino;
- info[2] = (int) buf->st_mode;
- info[3] = (int) buf->st_nlink;
- info[4] = (int) buf->st_uid;
- info[5] = (int) buf->st_gid;
- info[6] = (int) buf->st_size;
- info[7] = (int) buf->st_atime;
- info[8] = (int) buf->st_mtime;
- info[9] = (int) buf->st_ctime;
-#if (!defined(CERNLIB_QMSGI))&&(!defined(CERNLIB_QMDOS))
- info[10] = (int) buf->st_blksize;
- info[11] = (int) buf->st_blocks;
-#endif
-#if defined(CERNLIB_QMSGI)||defined(CERNLIB_QMDOS)
- info[10] = 0;
- info[11] = 0;
-#endif
- *slate++ = (buf->st_mode & S_IFMT) ^ S_IFREG;
- *slate++ = (buf->st_mode & S_IFMT) ^ S_IFLNK;
- *slate++ = (buf->st_mode & S_IFMT) ^ S_IFDIR;
- };
-
- free(buf);
-out2: free(ptname);
-out1: return istat;
-
-}
-/*> END <----------------------------------------------------------*/
-#endif
diff --git a/src/packlib/kernlib/kerngen/ccgen/os9gs/getgidf.c b/src/packlib/kernlib/kerngen/ccgen/os9gs/getgidf.c
deleted file mode 100644
index 96270f9..0000000
--- a/src/packlib/kernlib/kerngen/ccgen/os9gs/getgidf.c
+++ /dev/null
@@ -1,34 +0,0 @@
-/*
- * $Id: getgidf.c,v 1.1.1.1 1996/02/15 17:49:31 mclareni Exp $
- *
- * $Log: getgidf.c,v $
- * Revision 1.1.1.1 1996/02/15 17:49:31 mclareni
- * Kernlib
- *
- */
-/*> ROUTINE GETGIDF
- CERN PROGLIB# Z265 GETGIDF .VERSION KERNOS9 1.01 940727
- ORIG. 01/04/93, JS
- Fortran interface routine to _os_id ().
- Replaces call to getgid for OS-9 systems.
- MOD. 27/07/94, MM
-*/
-#include <process.h>
-#include <types.h>
-
-void getgidf_(int *gid)
-{
- process_id proc_id;
- u_int16 priority;
- u_int16 age;
- int32 schedule;
- u_int16 group;
- u_int16 user;
-
- error_code err;
-
- err = _os_id (&proc_id, &priority, &age, &schedule, &group, &user);
- *gid = group;
- return;
-}
-/*> END <----------------------------------------------------------*/
diff --git a/src/packlib/kernlib/kerngen/ccgen/os9gs/getpidf.c b/src/packlib/kernlib/kerngen/ccgen/os9gs/getpidf.c
deleted file mode 100644
index c4276b0..0000000
--- a/src/packlib/kernlib/kerngen/ccgen/os9gs/getpidf.c
+++ /dev/null
@@ -1,35 +0,0 @@
-/*
- * $Id: getpidf.c,v 1.1.1.1 1996/02/15 17:49:31 mclareni Exp $
- *
- * $Log: getpidf.c,v $
- * Revision 1.1.1.1 1996/02/15 17:49:31 mclareni
- * Kernlib
- *
- */
-/*> ROUTINE GETPIDF (IPID)
- CERN PROGLIB# Z265 GETPIDF .VERSION KERNOS9 1.01 940727
- ORIG. 22/02/91, JZ
- Fortran interface routine to _os_id ().
- Replaces call to getpid for OS-9 systems.
- MOD. 27/07/94, MM
-*/
-
-#include <process.h>
-#include <types.h>
-
-void getpidf_(int *pid)
-{
- process_id proc_id;
- u_int16 priority;
- u_int16 age;
- int32 schedule;
- u_int16 group;
- u_int16 user;
-
- error_code err;
-
- err = _os_id (&proc_id, &priority, &age, &schedule, &group, &user);
- *pid = proc_id;
- return;
-}
-/*> END <----------------------------------------------------------*/
diff --git a/src/packlib/kernlib/kerngen/ccgen/os9gs/getuidf.c b/src/packlib/kernlib/kerngen/ccgen/os9gs/getuidf.c
deleted file mode 100644
index 2b331c4..0000000
--- a/src/packlib/kernlib/kerngen/ccgen/os9gs/getuidf.c
+++ /dev/null
@@ -1,35 +0,0 @@
-/*
- * $Id: getuidf.c,v 1.1.1.1 1996/02/15 17:49:31 mclareni Exp $
- *
- * $Log: getuidf.c,v $
- * Revision 1.1.1.1 1996/02/15 17:49:31 mclareni
- * Kernlib
- *
- */
-/*> ROUTINE GETUIDF
- CERN PROGLIB# Z265 GETUIDF .VERSION KERNOS9 1.01 940727
- ORIG. 01/04/93, JS
- Fortran interface routine to _os_id ().
- Replaces call to getuid for OS-9 systems.
- MOD. 27/07/94, MM
-*/
-
-#include <process.h>
-#include <types.h>
-
-void getuidf_(int *uid)
-{
- process_id proc_id;
- u_int16 priority;
- u_int16 age;
- int32 schedule;
- u_int16 group;
- u_int16 user;
-
- error_code err;
-
- err = _os_id (&proc_id, &priority, &age, &schedule, &group, &user);
- *uid = user;
- return;
-}
-/*> END <----------------------------------------------------------*/
diff --git a/src/packlib/kernlib/kerngen/ccgen/os9gs/lnblnk.c b/src/packlib/kernlib/kerngen/ccgen/os9gs/lnblnk.c
deleted file mode 100644
index 73f60df..0000000
--- a/src/packlib/kernlib/kerngen/ccgen/os9gs/lnblnk.c
+++ /dev/null
@@ -1,33 +0,0 @@
-/*
- * $Id: lnblnk.c,v 1.1.1.1 1996/02/15 17:49:31 mclareni Exp $
- *
- * $Log: lnblnk.c,v $
- * Revision 1.1.1.1 1996/02/15 17:49:31 mclareni
- * Kernlib
- *
- */
-/*> ROUTINE LNBLNK
- CERN PROGLIB# M507 LNBLNK .VERSION KERNOS9 1.01 940718
- ORIG. 30/04/92, RDM + JZ
-
- N = LNBLNK (CHLINE) find last non-blank character in CHLINE
-*/
-#if defined(CERNLIB_QX_SC)
- int lnblnk_(chline, len)
-#endif
-#if defined(CERNLIB_QXNO_SC)
- int lnblnk(chline, len)
-#endif
- char *chline;
- int len;
-{
- char *chcur;
-
- chcur = chline + len;
- while (chcur > chline)
- { if (*--chcur != ' ') goto exit; }
- return 0;
-
-exit: return chcur+1 - chline;
-}
-/*> END <----------------------------------------------------------*/
diff --git a/src/packlib/kernlib/kerngen/ccgen/os9gs/lstatf.F b/src/packlib/kernlib/kerngen/ccgen/os9gs/lstatf.F
deleted file mode 100644
index cbce4cc..0000000
--- a/src/packlib/kernlib/kerngen/ccgen/os9gs/lstatf.F
+++ /dev/null
@@ -1,36 +0,0 @@
-*
-* $Id: lstatf.F,v 1.1.1.1 1996/02/15 17:49:31 mclareni Exp $
-*
-* $Log: lstatf.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:31 mclareni
-* Kernlib
-*
-*
-* T=XCC.
- INTEGER FUNCTION LSTATF (NAME, INFO)
-C
-C CERN PROGLIB# Z265 LSTATF .VERSION KERNOS9 1.01 940906
-C ORIG. 14/03/91, RDM
-C MOD. 06/09/94, MM
-C Fortran interface routine to lstat:
-C The lstat system call is not available on OS-9 system. OS-9 does not
-C support links. Therefore the call to LSTATI is replaced by a simple
-C call to STATI instead.
-C
-C NAME the name of the file of which information is required
-C INFO(12) buffer returning the information about "file"
-C
-C A succesfull call returns 0. A failed call returns -1.
-C
- CHARACTER*(*) NAME
- INTEGER INFO(12), STATI
-
- LGN = LNBLNK (NAME)
-#if defined(CERNLIB_QMVAX)
- STATF = STATI (%REF(NAME), INFO, LGN)
-#endif
-#if !defined(CERNLIB_QMVAX)
- STATF = STATI (NAME, INFO, LGN)
-#endif
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/ccgen/os9gs/signalf.c b/src/packlib/kernlib/kerngen/ccgen/os9gs/signalf.c
deleted file mode 100644
index c8ae4b7..0000000
--- a/src/packlib/kernlib/kerngen/ccgen/os9gs/signalf.c
+++ /dev/null
@@ -1,60 +0,0 @@
-/*
- * $Id: signalf.c,v 1.1.1.1 1996/02/15 17:49:31 mclareni Exp $
- *
- * $Log: signalf.c,v $
- * Revision 1.1.1.1 1996/02/15 17:49:31 mclareni
- * Kernlib
- *
- */
-/*> ROUTINE SIGNALF
- CERN PROGLIB# SIGNALF .VERSION KERNOS9 1.01 940722
- ORIG. 12/03/91, JZ
- FORTRAN interface routine to signal
-
- INTEGER FUNCTION SIGNALF (NUMSIG,PROC,IFLAG)
-
-C- NUMSIG : signal number
-C- PROC : external of the handler, if IFLAG = -1
-C- IFLAG : < 0 instal PROC
-C- = 0 default action
-C- = 1 ignore signal
-C- > 1 adr of handler as returned earlier
-C- function value = adr of previous handler
-*/
-#include <signal.h>
-#if defined(CERNLIB_QX_SC)
-int signalf_(signum,funct,flag)
-#endif
-#if defined(CERNLIB_QXNO_SC)
-int signalf(signum,funct,flag)
-#endif
-#if defined(CERNLIB_QXCAPT)
-int SIGNALF(signum,funct,flag)
-#endif
- int *signum, *flag;
- int *funct;
-{
- int signo, istat;
- int handler;
- void *oldhand;
-
- signo = *signum;
-
-#if defined(CERNLIB_QCCINDAD)
- if (*flag < 0) handler = *funct;
-#endif
-#if !defined(CERNLIB_QCCINDAD)
- if (*flag < 0) handler = (int)funct;
-#endif
- else if (*flag == 0) handler = (int)SIG_DFL;
- else if (*flag == 1) handler = (int)SIG_IGN;
- else handler = *flag;
-
- oldhand = signal(signo,(void *)handler);
- istat = (int)oldhand;
-#ifndef __GNUC__
- if (oldhand == SIG_ERR) istat = -1;
-#endif
- return istat;
-}
-/*> END <----------------------------------------------------------*/
diff --git a/src/packlib/kernlib/kerngen/ccgen/perroi.c b/src/packlib/kernlib/kerngen/ccgen/perroi.c
deleted file mode 100644
index 38563e3..0000000
--- a/src/packlib/kernlib/kerngen/ccgen/perroi.c
+++ /dev/null
@@ -1,67 +0,0 @@
-/*
- * $Id: perroi.c,v 1.3 1997/09/02 14:26:38 mclareni Exp $
- *
- * $Log: perroi.c,v $
- * Revision 1.3 1997/09/02 14:26:38 mclareni
- * WINNT correction
- *
- * Revision 1.2 1997/02/04 17:34:36 mclareni
- * Merge Winnt and 97a versions
- *
- * Revision 1.1.1.1.2.1 1997/01/21 11:29:37 mclareni
- * All mods for Winnt 96a on winnt branch
- *
- * Revision 1.1.1.1 1996/02/15 17:49:25 mclareni
- * Kernlib
- *
- */
-#include "kerngen/pilot.h"
-#include "kerngen/fortranc.h"
-
-/*> ROUTINE PERROI
- CERN PROGLIB# Z265 PERROI .VERSION KERNFOR 4.31 911111
- ORIG. 22/02/91, JZ
- Fortran interface routine to perror
-
- CALL PERRORF (TEXT)
-
- TEXT the text to be printed before the error message
-*/
-#include <stdio.h>
-#include "kerngen/fortchar.h"
-#if defined(CERNLIB_QX_SC)
-void type_of_call perroi_(ftext, lgtext)
-#endif
-#if defined(CERNLIB_QXNO_SC)
-void type_of_call perroi(ftext, lgtext)
-#endif
-#if defined(CERNLIB_QXCAPT)
-void type_of_call PERROI(ftext,
-# ifdef CERNLIB_MSSTDCALL
- len_ftext,
-# endif
- lgtext)
-#endif
-#if defined(CERNLIB_QMCRY)
- _fcd ftext;
-#endif
-#if !defined(CERNLIB_QMCRY)
- char *ftext;
-#endif
-
-#ifdef CERNLIB_MSSTDCALL
- int len_ftext;
-#endif
- int *lgtext;
-{
- char *pttext, *fchtak();
-
- pttext = fchtak(ftext,*lgtext);
- perror (pttext);
- if (pttext != NULL) free (pttext);
- return;
-}
-/*> END <----------------------------------------------------------*/
-#ifdef CERNLIB_TCGEN_PERRORF
-#undef CERNLIB_TCGEN_PERRORF
-#endif
diff --git a/src/packlib/kernlib/kerngen/ccgen/perrorf.F b/src/packlib/kernlib/kerngen/ccgen/perrorf.F
deleted file mode 100644
index 62d2b5d..0000000
--- a/src/packlib/kernlib/kerngen/ccgen/perrorf.F
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: perrorf.F,v 1.1.1.1 1996/02/15 17:49:25 mclareni Exp $
-*
-* $Log: perrorf.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:25 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE PERRORF (TEXT)
-C
-C CERN PROGLIB# Z265 PERRORF .VERSION KERNFOR 4.26 910313
-C ORIG. 22/02/91, JZ
-C Fortran interface routine to perror
-C
- CHARACTER TEXT*(*)
-
-#if !defined(CERNLIB_QMVAX)
- CALL PERROI (TEXT,LEN(TEXT))
-#endif
-#if defined(CERNLIB_QMVAX)
- CALL PERROI (%REF(TEXT),LEN(TEXT))
-#endif
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/ccgen/qnexte.c b/src/packlib/kernlib/kerngen/ccgen/qnexte.c
deleted file mode 100644
index 5894d8f..0000000
--- a/src/packlib/kernlib/kerngen/ccgen/qnexte.c
+++ /dev/null
@@ -1,77 +0,0 @@
-/*
- * $Id: qnexte.c,v 1.2 1997/02/04 17:34:37 mclareni Exp $
- *
- * $Log: qnexte.c,v $
- * Revision 1.2 1997/02/04 17:34:37 mclareni
- * Merge Winnt and 97a versions
- *
- * Revision 1.1.1.1.2.1 1997/01/21 11:29:38 mclareni
- * All mods for Winnt 96a on winnt branch
- *
- * Revision 1.1.1.1 1996/02/15 17:49:25 mclareni
- * Kernlib
- *
- */
-#include "kerngen/pilot.h"
-#include "kerngen/fortranc.h"
-
-#if defined(CERNLIB_QMSUN)
-#include "sungs/qnexte.c"
-#else
-/*> ROUTINE QNEXTE
- CERN PROGLIB# Z041 QNEXTE .VERSION KERNFOR 4.29 910718
-* ORIG. 23/05/91, JZ
-*/
-#include <setjmp.h>
-
-#if defined(CERNLIB_QX_SC)
-void type_of_call qnext_();
-#endif
-
-#if defined(CERNLIB_QXNO_SC)
-void type_of_call qnext();
-#endif
-
-#if defined(CERNLIB_QXCAPT)
-void type_of_call QNEXT();
-#endif
-
-#if defined(CERNLIB_QX_SC)
-void type_of_call qnexte_()
-#endif
-#if defined(CERNLIB_QXNO_SC)
-void type_of_call qnexte()
-#endif
-#if defined(CERNLIB_QXCAPT)
-void type_of_call QNEXTE()
-#endif
-#if defined(CERNLIB_QSIGJMP)
-{ static sigjmp_buf myenv;
- static int ireent = 0;
-
- if (ireent) siglongjmp (myenv, 7);
-
- ireent = 77;
- sigsetjmp (myenv,7);
-#endif
-#if !defined(CERNLIB_QSIGJMP)
-{ static jmp_buf myenv;
- static int ireent = 0;
-
- if (ireent) longjmp (myenv, 7);
-
- ireent = 77;
- setjmp (myenv);
-#endif
-#if defined(CERNLIB_QX_SC)
- qnext_();
-#endif
-#if defined(CERNLIB_QXNO_SC)
- qnext();
-#endif
-#if defined(CERNLIB_QXCAPT)
- QNEXT();
-#endif
-}
-/*> END <----------------------------------------------------------*/
-#endif
diff --git a/src/packlib/kernlib/kerngen/ccgen/readlnf.F b/src/packlib/kernlib/kerngen/ccgen/readlnf.F
deleted file mode 100644
index ef09c06..0000000
--- a/src/packlib/kernlib/kerngen/ccgen/readlnf.F
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: readlnf.F,v 1.1.1.1 1996/02/15 17:49:25 mclareni Exp $
-*
-* $Log: readlnf.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:25 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- INTEGER FUNCTION READLNF (PATH, TEXT)
-C
-C CERN PROGLIB# Z265 READLNF .VERSION KERNFOR 4.36 930602
-C ORIG. 24/03/93, JZ
-C Fortran interface routine to readlink
-C
- CHARACTER*(*) PATH, TEXT
- INTEGER READLNI
-
- LGN = LNBLNK (PATH)
- NTX = LEN(TEXT)
- READLNF = READLNI (PATH,TEXT,NTX,LGN)
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/ccgen/readlni.c b/src/packlib/kernlib/kerngen/ccgen/readlni.c
deleted file mode 100644
index 2fec638..0000000
--- a/src/packlib/kernlib/kerngen/ccgen/readlni.c
+++ /dev/null
@@ -1,61 +0,0 @@
-/*
-* $Id: readlni.c,v 1.2 1997/02/04 17:34:37 mclareni Exp $
-*
-* $Log: readlni.c,v $
-* Revision 1.2 1997/02/04 17:34:37 mclareni
-* Merge Winnt and 97a versions
-*
-* Revision 1.1.1.1.2.1 1997/01/21 11:29:38 mclareni
-* All mods for Winnt 96a on winnt branch
-*
-* Revision 1.1.1.1 1996/02/15 17:49:29 mclareni
-* Kernlib
-*
-*/
-#include "kerngen/pilot.h"
-#include "kerngen/fortranc.h"
-
-/*> ROUTINE READLNI
- CERN PROGLIB# Z265 READLNI .VERSION KERNFOR 4.36 930602
- ORIG. 24/03/93, JZ
- Fortran interface routine to readlink
-
- NCH = READLNF (PATH, TEXT*)
-
- PATH the path name of the link
- TEXT returns its value
- NCH returns the length of the value
-*/
-#include <stdio.h>
-#include "kerngen/fortchar.h"
-#if defined(CERNLIB_QX_SC)
-int type_of_call readlni_(fname, ftext, lgtext, lgname)
-#endif
-#if defined(CERNLIB_QXNO_SC)
-int type_of_call readlni(fname, ftext, lgtext, lgname)
-#endif
-#if defined(CERNLIB_QXCAPT)
-int type_of_call READLNI(fname, ftext, lgtext, lgname)
-#endif
-#if defined(CERNLIB_QMCRY)
- _fcd fname, ftext;
-#endif
-#if !defined(CERNLIB_QMCRY)
- char *fname, *ftext;
-#endif
- int *lgtext, *lgname;
-{
- char *ptname, *fchtak();
- int readlink();
- int fchput();
- int nch;
-
- nch = -1;
- ptname = fchtak(fname,*lgname);
- if (ptname == NULL) goto out;
- nch = readlink (ptname,ftext,*lgtext);
- free(ptname);
-
-out: return nch;
-}
-/*> END <----------------------------------------------------------*/
diff --git a/src/packlib/kernlib/kerngen/ccgen/renamef.F b/src/packlib/kernlib/kerngen/ccgen/renamef.F
deleted file mode 100644
index 3c862ae..0000000
--- a/src/packlib/kernlib/kerngen/ccgen/renamef.F
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: renamef.F,v 1.1.1.1 1996/02/15 17:49:25 mclareni Exp $
-*
-* $Log: renamef.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:25 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QMVAX)
-#include "vaxsys/renamef.F"
-#else
- INTEGER FUNCTION RENAMEF (FROM,TO)
-C
-C CERN PROGLIB# Z265 RENAMEF .VERSION KERNFOR 4.26 910313
-C ORIG. 22/02/91, JZ
-C Fortran interface routine to rename
-C
- CHARACTER*(*) FROM, TO
- INTEGER RENAMI
-
- LGFR = LNBLNK (FROM)
- LGTO = LNBLNK (TO)
- RENAMEF = RENAMI (FROM, TO, LGFR, LGTO)
- RETURN
- END
-#endif
diff --git a/src/packlib/kernlib/kerngen/ccgen/renami.c b/src/packlib/kernlib/kerngen/ccgen/renami.c
deleted file mode 100644
index 9447854..0000000
--- a/src/packlib/kernlib/kerngen/ccgen/renami.c
+++ /dev/null
@@ -1,64 +0,0 @@
-/*
- * $Id: renami.c,v 1.2 1997/02/04 17:34:38 mclareni Exp $
- *
- * $Log: renami.c,v $
- * Revision 1.2 1997/02/04 17:34:38 mclareni
- * Merge Winnt and 97a versions
- *
- * Revision 1.1.1.1.2.1 1997/01/21 11:29:39 mclareni
- * All mods for Winnt 96a on winnt branch
- *
- * Revision 1.1.1.1 1996/02/15 17:49:25 mclareni
- * Kernlib
- *
- */
-#include "kerngen/pilot.h"
-#include "kerngen/fortranc.h"
-
-/*> ROUTINE RENAMI
- CERN PROGLIB# Z265 RENAMI .VERSION KERNFOR 4.31 911111
- ORIG. 22/02/91, JZ
- Fortran interface routine to rename
-
- ISTAT = RENAMEF (FROM, TO)
-
- FROM old file name
- TO new file name
- ISTAT zero if successful
-*/
-#include <stdio.h>
-#include "kerngen/fortchar.h"
-#if defined(CERNLIB_QX_SC)
-int type_of_call renami_(frpath, topath, lgfr, lgto)
-#endif
-#if defined(CERNLIB_QXNO_SC)
-int type_of_call renami(frpath, topath, lgfr, lgto)
-#endif
-#if defined(CERNLIB_QXCAPT)
-int type_of_call RENAMI(frpath, topath, lgfr, lgto)
-#endif
-#if defined(CERNLIB_QMCRY)
- _fcd frpath, topath;
-#endif
-#if !defined(CERNLIB_QMCRY)
- char *frpath, *topath;
-#endif
- int *lgfr, *lgto;
-{
- char *ptfr, *ptto, *fchtak();
- int istat, rename();
-
- istat = -1;
- ptfr = fchtak(frpath,*lgfr);
- if (ptfr == NULL) goto bad;
-
- ptto = fchtak(topath,*lgto);
- if (ptto == NULL) goto pre;
-
- istat = rename (ptfr, ptto);
-
- free (ptto);
-pre: free (ptfr);
-bad: return istat;
-}
-/*> END <----------------------------------------------------------*/
diff --git a/src/packlib/kernlib/kerngen/ccgen/seteni.c b/src/packlib/kernlib/kerngen/ccgen/seteni.c
deleted file mode 100644
index d1ae69c..0000000
--- a/src/packlib/kernlib/kerngen/ccgen/seteni.c
+++ /dev/null
@@ -1,20 +0,0 @@
-/*
- * $Id: seteni.c,v 1.2 1997/02/04 17:34:38 mclareni Exp $
- *
- * $Log: seteni.c,v $
- * Revision 1.2 1997/02/04 17:34:38 mclareni
- * Merge Winnt and 97a versions
- *
- * Revision 1.1.1.1.2.1 1997/01/21 11:29:39 mclareni
- * All mods for Winnt 96a on winnt branch
- *
- * Revision 1.1.1.1 1996/02/15 17:49:29 mclareni
- * Kernlib
- *
- */
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QENVBSD)
-#include "setenvbsd.c"
-#else
-#include "setenvsy5.c"
-#endif
diff --git a/src/packlib/kernlib/kerngen/ccgen/setenvbsd.c b/src/packlib/kernlib/kerngen/ccgen/setenvbsd.c
deleted file mode 100644
index c90d4e3..0000000
--- a/src/packlib/kernlib/kerngen/ccgen/setenvbsd.c
+++ /dev/null
@@ -1,62 +0,0 @@
-/*
- * $Id: setenvbsd.c,v 1.2 1997/02/04 17:34:39 mclareni Exp $
- *
- * $Log: setenvbsd.c,v $
- * Revision 1.2 1997/02/04 17:34:39 mclareni
- * Merge Winnt and 97a versions
- *
- * Revision 1.1.1.1.2.1 1997/01/21 11:29:40 mclareni
- * All mods for Winnt 96a on winnt branch
- *
- * Revision 1.1.1.1 1996/02/15 17:49:26 mclareni
- * Kernlib
- *
- */
-/*> ROUTINE SETENI
- CERN PROGLIB# Z265 SETENI .VERSION KERNFOR 4.36 930602
- ORIG. 22/02/91, JZ
- Fortran interface routine to setenv
-
- CALL SETENVF (NAME, TEXT*)
-
- NAME the name of the environment variable,
- TEXT the value to be assigned
-*/
-#include <stdio.h>
-#include "kerngen/fortchar.h"
-#include "kerngen/fortranc.h"
-
-#if defined(CERNLIB_QX_SC)
-int type_of_call seteni_(fname, ftext, lgname, lgtext)
-#endif
-#if defined(CERNLIB_QXNO_SC)
-int type_of_call seteni(fname, ftext, lgname, lgtext)
-#endif
-#if defined(CERNLIB_QXCAPT)
-int type_of_call SETENI(fname, ftext, lgname, lgtext)
-#endif
-#if defined(CERNLIB_QMCRY)
- _fcd fname, ftext;
-#endif
-#if !defined(CERNLIB_QMCRY)
- char *fname, *ftext;
-#endif
- int *lgtext, *lgname;
-{
- char *ptname, *pttext, *fchtak();
- int nname, ntext, istat, setenv();
-
- istat = -1;
- nname = *lgname;
- ntext = *lgtext;
-
- ptname = fchtak(fname,nname);
- if (ptname == NULL) goto out1;
- pttext = fchtak(ftext,ntext);
- if (pttext == NULL) goto out2;
- istat = setenv (ptname, pttext);
- free(pttext);
-out2: free(ptname);
-out1: return istat;
-}
-/*> END <----------------------------------------------------------*/
diff --git a/src/packlib/kernlib/kerngen/ccgen/setenvf.F b/src/packlib/kernlib/kerngen/ccgen/setenvf.F
deleted file mode 100644
index e52f6ce..0000000
--- a/src/packlib/kernlib/kerngen/ccgen/setenvf.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: setenvf.F,v 1.1.1.1 1996/02/15 17:49:26 mclareni Exp $
-*
-* $Log: setenvf.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:26 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- INTEGER FUNCTION SETENVF (NAME, TEXT)
-C
-C CERN PROGLIB# Z265 SETENVF .VERSION KERNFOR 4.36 930602
-C ORIG. 22/02/91, JZ
-C Fortran interface routine to setenv (BSD) or putenv (SYS V)
-C
- CHARACTER*(*) NAME, TEXT
- INTEGER SETENI
-
- LGNM = LNBLNK (NAME)
- LGTX = LNBLNK (TEXT)
- LGTX = MAX (1, LGTX)
- IF (LGNM.EQ.0) GO TO 91
-
- SETENVF = SETENI (NAME,TEXT,LGNM,LGTX)
- RETURN
-
- 91 SETENVF = -1
- END
diff --git a/src/packlib/kernlib/kerngen/ccgen/setenvsy5.c b/src/packlib/kernlib/kerngen/ccgen/setenvsy5.c
deleted file mode 100644
index 5a740b6..0000000
--- a/src/packlib/kernlib/kerngen/ccgen/setenvsy5.c
+++ /dev/null
@@ -1,72 +0,0 @@
-/*
- * $Id: setenvsy5.c,v 1.2 1997/02/04 17:34:39 mclareni Exp $
- *
- * $Log: setenvsy5.c,v $
- * Revision 1.2 1997/02/04 17:34:39 mclareni
- * Merge Winnt and 97a versions
- *
- * Revision 1.1.1.1.2.1 1997/01/21 11:29:40 mclareni
- * All mods for Winnt 96a on winnt branch
- *
- * Revision 1.1.1.1 1996/02/15 17:49:26 mclareni
- * Kernlib
- *
- */
-/*> ROUTINE SETENI
- CERN PROGLIB# Z265 SETENI .VERSION KERNFOR 4.36 930602
- ORIG. 22/02/91, JZ
- Fortran interface routine to putenv
-
- CALL SETENVF (NAME, TEXT*)
-
- NAME the name of the environment variable,
- TEXT the value to be assigned
-*/
-#include <stdio.h>
-#include "kerngen/fortchar.h"
-#include "kerngen/fortranc.h"
-
-#if defined(CERNLIB_QX_SC)
-int type_of_call seteni_(fname, ftext, lgname, lgtext)
-#endif
-#if defined(CERNLIB_QXNO_SC)
-int type_of_call seteni(fname, ftext, lgname, lgtext)
-#endif
-#if defined(CERNLIB_QXCAPT)
-int type_of_call SETENI(fname, ftext, lgname, lgtext)
-#endif
-#if defined(CERNLIB_QMCRY)
- _fcd fname, ftext;
-#endif
-#if !defined(CERNLIB_QMCRY)
- char *fname, *ftext;
-#endif
- int *lgtext, *lgname;
-{
- char *ptname, *pttext, *pts, *ptt, *fchtak();
- int nname, ntext, istat, putenv();
- int ntot, j;
-
- istat = -1;
- nname = *lgname;
- ntext = *lgtext;
- ntot = nname + 1 + ntext;
-
- ptname = fchtak(fname,ntot);
- if (ptname == NULL) goto out1;
- pttext = fchtak(ftext,ntext);
- if (pttext == NULL) goto out2;
-
- pts = pttext;
- ptt = ptname + nname;
- *ptt++ = '=';
- for (j = 0; j <= ntext; j++) *ptt++ = *pts++;
-
- istat = putenv (ptname);
- free(pttext);
- if (istat == 0) return 0;
-
-out2: free(ptname);
-out1: return istat;
-}
-/*> END <----------------------------------------------------------*/
diff --git a/src/packlib/kernlib/kerngen/ccgen/setjmpf.c b/src/packlib/kernlib/kerngen/ccgen/setjmpf.c
deleted file mode 100644
index 2e7efdd..0000000
--- a/src/packlib/kernlib/kerngen/ccgen/setjmpf.c
+++ /dev/null
@@ -1,60 +0,0 @@
-/*
- * $Id: setjmpf.c,v 1.2 1997/02/04 17:34:40 mclareni Exp $
- *
- * $Log: setjmpf.c,v $
- * Revision 1.2 1997/02/04 17:34:40 mclareni
- * Merge Winnt and 97a versions
- *
- * Revision 1.1.1.1.2.1 1997/01/21 11:29:40 mclareni
- * All mods for Winnt 96a on winnt branch
- *
- * Revision 1.1.1.1 1996/02/15 17:49:26 mclareni
- * Kernlib
- *
- */
-#include "kerngen/pilot.h"
-/*> ROUTINE SETJMPF (AREA, ROUT)
-
- CERN PROGLIB# SETJMPF .VERSION KERNFOR 4.26 910313
-
- The function setjmp cannot be implemented
- by a Fortran interface routine
-
- Instead we provide now the function JMPSET;
- the present SETJMPF is obsolete and will be
- removed in the next update.
-*/
-#include <setjmp.h>
-#include "kerngen/fortranc.h"
-
-#if defined(CERNLIB_QX_SC)
-void type_of_call setjmpf_(area,ufun)
-#endif
-#if defined(CERNLIB_QXNO_SC)
-void type_of_call setjmpf(area,ufun)
-#endif
-#if defined(CERNLIB_QXCAPT)
-void type_of_call SETJMPF(area,ufun)
-#endif
- jmp_buf area;
-#if defined(CERNLIB_QCCINDAD)
- void (** ufun)();
-#endif
-#if !defined(CERNLIB_QCCINDAD)
- void (* ufun)();
-#endif
-{
- void (* unext)();
-
-#if defined(CERNLIB_QCCINDAD)
- unext = *ufun;
-#endif
-#if !defined(CERNLIB_QCCINDAD)
- unext = ufun;
-#endif
-
- if ( setjmp(area) ) return;
-
- (* unext)();
-}
-/*> END <----------------------------------------------------------*/
diff --git a/src/packlib/kernlib/kerngen/ccgen/sgigs/signalf.c b/src/packlib/kernlib/kerngen/ccgen/sgigs/signalf.c
deleted file mode 100644
index a16c988..0000000
--- a/src/packlib/kernlib/kerngen/ccgen/sgigs/signalf.c
+++ /dev/null
@@ -1,40 +0,0 @@
-/*
- * $Id: signalf.c,v 1.1.1.1 1996/02/15 17:49:34 mclareni Exp $
- *
- * $Log: signalf.c,v $
- * Revision 1.1.1.1 1996/02/15 17:49:34 mclareni
- * Kernlib
- *
- */
-/*> ROUTINE SIGNALF
- CERN PROGLIB# SIGNALF .VERSION KERNSGI 1.04 930120
- ORIG. 12/03/91, JZ
- FORTRAN interface routine to sigaction */
-#include <signal.h>
-#include <stdio.h>
-#include <errno.h>
-int signalf_(signum,funct,flag)
- int *signum, *flag;
- void (*funct)();
-{
- int sigaction();
- int istat, signo;
-
- struct sigaction newbuf;
- struct sigaction oldbuf;
-
- signo = *signum;
-
- if (*flag < 0) newbuf.sa_handler = funct;
- else if (*flag == 0) newbuf.sa_handler = SIG_DFL;
- else if (*flag == 1) newbuf.sa_handler = SIG_IGN;
- else newbuf.sa_handler = (void (*)())*flag;
-
- newbuf.sa_flags = 0;
- sigemptyset(&newbuf.sa_mask);
-
- istat = sigaction(signo,&newbuf,&oldbuf);
- if (istat == 0) return (int)oldbuf.sa_handler;
- return -1;
-}
-/*> END <----------------------------------------------------------*/
diff --git a/src/packlib/kernlib/kerngen/ccgen/sigbsd.c b/src/packlib/kernlib/kerngen/ccgen/sigbsd.c
deleted file mode 100644
index eb16364..0000000
--- a/src/packlib/kernlib/kerngen/ccgen/sigbsd.c
+++ /dev/null
@@ -1,53 +0,0 @@
-/*
- * $Id: sigbsd.c,v 1.2 1997/02/04 17:34:40 mclareni Exp $
- *
- * $Log: sigbsd.c,v $
- * Revision 1.2 1997/02/04 17:34:40 mclareni
- * Merge Winnt and 97a versions
- *
- * Revision 1.1.1.1.2.1 1997/01/21 11:29:41 mclareni
- * All mods for Winnt 96a on winnt branch
- *
- * Revision 1.1.1.1 1996/02/15 17:49:26 mclareni
- * Kernlib
- *
- */
-/*> ROUTINE SIGNALF
- CERN PROGLIB# SIGNALF .VERSION KERNFOR 4.36 930602
- ORIG. 24/05/93, JZ
- FORTRAN interface routine to sigvec */
-#include <signal.h>
-#include "kerngen/fortranc.h"
-
-#if defined(CERNLIB_QX_SC)
-int type_of_call signalf_(signum,funct,flag)
-#endif
-#if defined(CERNLIB_QXNO_SC)
-int type_of_call signalf(signum,funct,flag)
-#endif
-#if defined(CERNLIB_QXCAPT)
-int type_of_call SIGNALF(signum,funct,flag)
-#endif
- int *signum, *flag;
- void (*funct)();
-{
- int istat, signo;
-
- struct sigvec newbuf;
- struct sigvec oldbuf;
-
- signo = *signum;
-
- if (*flag < 0) newbuf.sv_handler = funct;
- else if (*flag == 0) newbuf.sv_handler = SIG_DFL;
- else if (*flag == 1) newbuf.sv_handler = SIG_IGN;
- else newbuf.sv_handler = (void (*)())*flag;
-
- newbuf.sv_flags = 0;
- newbuf.sv_mask = 0;
-
- istat = sigvec(signo,&newbuf,&oldbuf);
- if (istat == 0) return (int)oldbuf.sv_handler;
- return -1;
-}
-/*> END <----------------------------------------------------------*/
diff --git a/src/packlib/kernlib/kerngen/ccgen/signalf.c b/src/packlib/kernlib/kerngen/ccgen/signalf.c
deleted file mode 100644
index 4e2c527..0000000
--- a/src/packlib/kernlib/kerngen/ccgen/signalf.c
+++ /dev/null
@@ -1,84 +0,0 @@
-/*
- * $Id: signalf.c,v 1.3 1999/10/06 14:17:01 mclareni Exp $
- *
- * $Log: signalf.c,v $
- * Revision 1.3 1999/10/06 14:17:01 mclareni
- * On AIX 4.3 we have to use the Posix version of signalf to get it to compile
- *
- * Revision 1.2 1997/02/04 17:34:41 mclareni
- * Merge Winnt and 97a versions
- *
- * Revision 1.1.1.1.2.1 1997/01/21 11:29:41 mclareni
- * All mods for Winnt 96a on winnt branch
- *
- * Revision 1.1.1.1 1996/02/15 17:49:26 mclareni
- * Kernlib
- *
- */
-#include "kerngen/pilot.h"
-#include "kerngen/fortranc.h"
-
-#if defined(CERNLIB_QMSGI)
-#include "sgigs/signalf.c"
-#elif defined(CERNLIB_QMOS9)
-#include "os9gs/signalf.c"
-#elif defined(CERNLIB_QSIGBSD)
-#include "sigbsd.c"
-#elif defined(CERNLIB_QSIGPOSIX)
-#include "sigposix.c"
-#elif defined(CERNLIB_QMIRT)||defined(CERNLIB_QMIRTD)
-#include "irtgs/signalf.c"
-#else
-/*> ROUTINE SIGNALF
- CERN PROGLIB# SIGNALF .VERSION KERNFOR 4.38 931108
- ORIG. 12/03/91, JZ
- FORTRAN interface routine to signal
-
- INTEGER FUNCTION SIGNALF (NUMSIG,PROC,IFLAG)
-
-C- NUMSIG : signal number
-C- PROC : external of the handler, if IFLAG = -1
-C- IFLAG : < 0 instal PROC
-C- = 0 default action
-C- = 1 ignore signal
-C- > 1 adr of handler as returned earlier
-C- function value = adr of previous handler
-*/
-#include <signal.h>
-#if defined(CERNLIB_QX_SC)
-int type_of_call signalf_(signum,funct,flag)
-#endif
-#if defined(CERNLIB_QXNO_SC)
-int type_of_call signalf(signum,funct,flag)
-#endif
-#if defined(CERNLIB_QXCAPT)
-int type_of_call SIGNALF(signum,funct,flag)
-#endif
- int *signum, *flag;
- int *funct;
-{
- int signo, istat;
- int handler;
- void *oldhand;
-
- signo = *signum;
-
-#if defined(CERNLIB_QCCINDAD)
- if (*flag < 0) handler = *funct;
-#endif
-#if !defined(CERNLIB_QCCINDAD)
- if (*flag < 0) handler = (int)funct;
-#endif
- else if (*flag == 0) handler = (int)SIG_DFL;
- else if (*flag == 1) handler = (int)SIG_IGN;
- else handler = *flag;
-
- oldhand = signal(signo,handler);
- istat = (int)oldhand;
-#ifndef __GNUC__
- if (oldhand == SIG_ERR) istat = -1;
-#endif
- return istat;
-}
-/*> END <----------------------------------------------------------*/
-#endif
diff --git a/src/packlib/kernlib/kerngen/ccgen/sigposix.c b/src/packlib/kernlib/kerngen/ccgen/sigposix.c
deleted file mode 100644
index fab0414..0000000
--- a/src/packlib/kernlib/kerngen/ccgen/sigposix.c
+++ /dev/null
@@ -1,70 +0,0 @@
-/*
- * $Id: sigposix.c,v 1.2 1997/02/04 17:34:42 mclareni Exp $
- *
- * $Log: sigposix.c,v $
- * Revision 1.2 1997/02/04 17:34:42 mclareni
- * Merge Winnt and 97a versions
- *
- * Revision 1.1.1.1.2.1 1997/01/21 11:29:42 mclareni
- * All mods for Winnt 96a on winnt branch
- *
- * Revision 1.1.1.1 1996/02/15 17:49:26 mclareni
- * Kernlib
- *
- */
-/*> ROUTINE SIGNALF
- CERN PROGLIB# SIGNALF .VERSION KERNFOR 4.36 930602
- ORIG. 24/05/93, JZ
- FORTRAN interface routine to sigaction */
-#include <signal.h>
-#include "kerngen/fortranc.h"
-
-#if defined(CERNLIB_QX_SC)
-int type_of_call signalf_(signum,funct,flag)
-#endif
-#if defined(CERNLIB_QXNO_SC)
-int type_of_call signalf(signum,funct,flag)
-#endif
-#if defined(CERNLIB_QXCAPT)
-int type_of_call SIGNALF(signum,funct,flag)
-#endif
- int *signum, *flag;
- void (*funct)();
-{
- int sigaction();
- int istat, signo;
-
- struct sigaction newbuf;
- struct sigaction oldbuf;
- void (*action)();
-
-#if defined(CERNLIB_QMHPX)
- static subsq = 0;
-#endif
-
- signo = *signum;
-
- if (*flag == -1) action = funct;
- else if (*flag == 0) action = SIG_DFL;
- else if (*flag == 1) action = SIG_IGN;
- else action = (void (*)())*flag;
-
- newbuf.sa_handler = action;
- newbuf.sa_flags = 0;
- sigemptyset(&newbuf.sa_mask);
-
-#if defined(CERNLIB_QMHPX)
-/* on HP sigaction is not properly initialized
- * if running with a Fortran main program,
- * a call to signal will fix this */
- if (subsq == 0 )
- { subsq = 7;
- istat = signal (signo, action);
- }
-#endif
-
- istat = sigaction(signo,&newbuf,&oldbuf);
- if (istat == 0) return (int)oldbuf.sa_handler;
- return -1;
-}
-/*> END <----------------------------------------------------------*/
diff --git a/src/packlib/kernlib/kerngen/ccgen/sigprnt.c b/src/packlib/kernlib/kerngen/ccgen/sigprnt.c
deleted file mode 100644
index 67e4c1a..0000000
--- a/src/packlib/kernlib/kerngen/ccgen/sigprnt.c
+++ /dev/null
@@ -1,45 +0,0 @@
-/*
- * $Id: sigprnt.c,v 1.2 1997/02/04 17:34:42 mclareni Exp $
- *
- * $Log: sigprnt.c,v $
- * Revision 1.2 1997/02/04 17:34:42 mclareni
- * Merge Winnt and 97a versions
- *
- * Revision 1.1.1.1.2.1 1997/01/21 11:29:42 mclareni
- * All mods for Winnt 96a on winnt branch
- *
- * Revision 1.1.1.1 1996/02/15 17:49:27 mclareni
- * Kernlib
- *
- */
-#include "kerngen/pilot.h"
-/*> ROUTINE SIGPRNT
- CERN PROGLIB# SIGPRNT .VERSION KERNFOR 4.42 951011
- ORIG. 10/10/95, JZ
- print the mask of blocked signals */
-#include <stdio.h>
-#include <signal.h>
-#include "kerngen/fortranc.h"
-
-#if defined(CERNLIB_QX_SC)
-void type_of_call sigprnt_()
-#endif
-#if defined(CERNLIB_QXNO_SC)
-void type_of_call sigprnt()
-#endif
-#if defined(CERNLIB_QXCAPT)
-void type_of_call SIGPRNT()
-#endif
-{
-#ifndef CERNLIB_WINNT
- sigset_t oldmask;
-
- sigprocmask (NULL, NULL, &oldmask);
-
- printf (" blocked signals are: %x\n", oldmask);
-#else
- printf ("Printing the mask of blocked signal isn't implemented for Windows\n");
-#endif
- return;
-}
-/*> END <----------------------------------------------------------*/
diff --git a/src/packlib/kernlib/kerngen/ccgen/sigunbl.c b/src/packlib/kernlib/kerngen/ccgen/sigunbl.c
deleted file mode 100644
index ae6fcf0..0000000
--- a/src/packlib/kernlib/kerngen/ccgen/sigunbl.c
+++ /dev/null
@@ -1,44 +0,0 @@
-/*
- * $Id: sigunbl.c,v 1.2 1997/02/04 17:34:43 mclareni Exp $
- *
- * $Log: sigunbl.c,v $
- * Revision 1.2 1997/02/04 17:34:43 mclareni
- * Merge Winnt and 97a versions
- *
- * Revision 1.1.1.1.2.1 1997/01/21 11:29:43 mclareni
- * All mods for Winnt 96a on winnt branch
- *
- * Revision 1.1.1.1 1996/02/15 17:49:27 mclareni
- * Kernlib
- *
- */
-#include "kerngen/pilot.h"
-/*> ROUTINE SIGUNBL
- CERN PROGLIB# SIGUNBL .VERSION KERNFOR 4.42 951011
- ORIG. 10/10/95, JZ
- unblock all signals */
-#include <stdio.h>
-#include <signal.h>
-#include "kerngen/fortranc.h"
-
-#if defined(CERNLIB_QX_SC)
-void type_of_call sigunbl_()
-#endif
-#if defined(CERNLIB_QXNO_SC)
-void type_of_call sigunbl()
-#endif
-#if defined(CERNLIB_QXCAPT)
-void type_of_call SIGUNBL()
-#endif
-{
-#ifndef CERNLIB_WINNT
- sigset_t newmask;
-
- sigemptyset(&newmask);
- sigprocmask (SIG_SETMASK, &newmask, NULL);
-#else
- DoAttention(" Attention !!! SIGUNBL is not implemented for Windows NT\n");
-#endif
- return;
-}
-/*> END <----------------------------------------------------------*/
diff --git a/src/packlib/kernlib/kerngen/ccgen/sleepf.c b/src/packlib/kernlib/kerngen/ccgen/sleepf.c
deleted file mode 100644
index 4f7e7d6..0000000
--- a/src/packlib/kernlib/kerngen/ccgen/sleepf.c
+++ /dev/null
@@ -1,45 +0,0 @@
-/*
- * $Id: sleepf.c,v 1.2 1997/02/04 17:34:43 mclareni Exp $
- *
- * $Log: sleepf.c,v $
- * Revision 1.2 1997/02/04 17:34:43 mclareni
- * Merge Winnt and 97a versions
- *
- * Revision 1.1.1.1.2.1 1997/01/21 11:29:43 mclareni
- * All mods for Winnt 96a on winnt branch
- *
- * Revision 1.1.1.1 1996/02/15 17:49:27 mclareni
- * Kernlib
- *
- */
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_WINNT)
-#include "wntgs/sleepf.c"
-#elif defined(CERNLIB_QMDOS)
-#include "dosgs/sleepf.c"
-#else
-/*> ROUTINE SLEEPF (NSECS)
- CERN PROGLIB# Z265 SLEEPF .VERSION KERNFOR 4.26 910313
- ORIG. 22/02/91, JZ
- Fortran interface routine to sleep
-*/
-#if defined(CERNLIB_QX_SC)
-void sleepf_(seconds)
-#endif
-#if defined(CERNLIB_QXNO_SC)
-void sleepf(seconds)
-#endif
-#if defined(CERNLIB_QXCAPT)
-void SLEEPF(seconds)
-#endif
- int *seconds;
-{
- void sleep();
- int secu;
-
- secu = *seconds;
- sleep(secu);
- return;
-}
-/*> END <----------------------------------------------------------*/
-#endif
diff --git a/src/packlib/kernlib/kerngen/ccgen/statf.F b/src/packlib/kernlib/kerngen/ccgen/statf.F
deleted file mode 100644
index 5ee8e9e..0000000
--- a/src/packlib/kernlib/kerngen/ccgen/statf.F
+++ /dev/null
@@ -1,43 +0,0 @@
-*
-* $Id: statf.F,v 1.3 1997/09/02 14:26:39 mclareni Exp $
-*
-* $Log: statf.F,v $
-* Revision 1.3 1997/09/02 14:26:39 mclareni
-* WINNT correction
-*
-* Revision 1.2 1997/02/04 17:34:44 mclareni
-* Merge Winnt and 97a versions
-*
-* Revision 1.1.1.1.2.1 1997/01/21 11:29:44 mclareni
-* All mods for Winnt 96a on winnt branch
-*
-* Revision 1.1.1.1 1996/02/15 17:49:27 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- INTEGER FUNCTION STATF (NAME, INFO)
-C
-C CERN PROGLIB# Z265 STATF .VERSION KERNFOR 4.37 930715
-C ORIG. 14/03/91, RDM
-C Fortran interface routine to stat
-C
-C NAME the name of the file of which information is required
-C INFO(12) buffer returning the information about "file"
-C
-C A succesfull call returns 0. A failed call returns -1.
-C
- CHARACTER*(*) NAME
- INTEGER INFO(12), STATI
-
- LGN = LNBLNK (NAME)
-
-#if defined(CERNLIB_QMVAX)
- STATF = STATI (%REF(NAME), INFO, LGN)
-#endif
-#if !defined(CERNLIB_QMVAX)
- STATF = STATI (NAME, INFO, LGN)
-#endif
-
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/ccgen/stati.c b/src/packlib/kernlib/kerngen/ccgen/stati.c
deleted file mode 100644
index 4595bd6..0000000
--- a/src/packlib/kernlib/kerngen/ccgen/stati.c
+++ /dev/null
@@ -1,109 +0,0 @@
-/*
- * $Id: stati.c,v 1.4 1997/09/02 14:26:39 mclareni Exp $
- *
- * $Log: stati.c,v $
- * Revision 1.4 1997/09/02 14:26:39 mclareni
- * WINNT correction
- *
- * Revision 1.3 1997/02/04 17:34:45 mclareni
- * Merge Winnt and 97a versions
- *
- * Revision 1.2 1996/10/11 07:49:51 cernlib
- * Sgi now has st_blksize and st_blocks, so store and return these.
- * Use #else instead of complicated #if
- *
- * Revision 1.1.1.1.2.1 1997/01/21 11:29:44 mclareni
- * All mods for Winnt 96a on winnt branch
- *
- * Revision 1.1.1.1 1996/02/15 17:49:27 mclareni
- * Kernlib
- *
- */
-#include "kerngen/pilot.h"
-/*> ROUTINE STATI
- CERN PROGLIB# Z265 STATI .VERSION KERNFOR 4.40 940929
-C ORIG. 14/03/91, RDM
- Fortran interface routine to stat
-*/
-#include <stdio.h>
-#if defined(CERNLIB_QMVAX)||defined(CERNLIB_QMOS9)
-#include <types.h>
-#include <stat.h>
-#endif
-#if (!defined(CERNLIB_QMVAX))&&(!defined(CERNLIB_QMOS9))
-#include <sys/types.h>
-#include <sys/stat.h>
-#include "kerngen/fortchar.h"
-#endif
-#include "kerngen/fortranc.h"
-#if defined(CERNLIB_QX_SC)
-int type_of_call stati_(fname, info, lgname)
-#endif
-#if defined(CERNLIB_QXNO_SC)
-int type_of_call stati(fname, info, lgname)
-#endif
-#if defined(CERNLIB_QXCAPT)
-# ifndef CERNLIB_MSSTDCALL
- int type_of_call STATI(fname, info, lgname)
-# else
- int type_of_call STATI(fname, lfname, info, lgname)
- int lfname;
-# endif
-#endif
-#if defined(CERNLIB_QMCRY)
- _fcd fname;
-#endif
-#if !defined(CERNLIB_QMCRY)
- char *fname;
-#endif
- int *lgname;
- int *info;
-{
-#ifndef WIN32
- struct stat *buf;
-#else
- struct _stat *buf;
-#endif
- char *ptname, *fchtak();
- int istat, stat();
-
- istat = -1;
- ptname = fchtak(fname,*lgname);
- if (ptname == NULL) goto out1;
-
-#ifndef WIN32
- buf = (struct stat *) malloc(sizeof (struct stat));
-#else
- buf = (struct _stat *) malloc(sizeof (struct _stat));
-#endif
-
- if (buf == NULL) goto out2;
-
- istat = stat(ptname, buf);
-
- if (!istat) {
- info[0] = (int) buf->st_dev;
- info[1] = (int) buf->st_ino;
- info[2] = (int) buf->st_mode;
- info[3] = (int) buf->st_nlink;
- info[4] = (int) buf->st_uid;
- info[5] = (int) buf->st_gid;
- info[6] = (int) buf->st_size;
- info[7] = (int) buf->st_atime;
- info[8] = (int) buf->st_mtime;
- info[9] = (int) buf->st_ctime;
-#if defined(CERNLIB_QMDOS)||defined(CERNLIB_QMVAX)||defined(CERNLIB_QMOS9)||defined(CERNLIB_WINNT)
- info[10] = 0;
- info[11] = 0;
-#else
- info[10] = (int) buf->st_blksize;
- info[11] = (int) buf->st_blocks;
-#endif
- };
-
- free(buf);
-out2: free(ptname);
-out1: return istat;
-
-}
-/*> END <----------------------------------------------------------*/
diff --git a/src/packlib/kernlib/kerngen/ccgen/sungs/qnexte.c b/src/packlib/kernlib/kerngen/ccgen/sungs/qnexte.c
deleted file mode 100644
index 0f07112..0000000
--- a/src/packlib/kernlib/kerngen/ccgen/sungs/qnexte.c
+++ /dev/null
@@ -1,24 +0,0 @@
-/*
- * $Id: qnexte.c,v 1.1.1.1 1996/02/15 17:49:35 mclareni Exp $
- *
- * $Log: qnexte.c,v $
- * Revision 1.1.1.1 1996/02/15 17:49:35 mclareni
- * Kernlib
- *
- */
-/*
-* CERN PROGLIB# Z041 QNEXTE .VERSION KERNSUN 1.00 881114
-* ORIG. 14/11/88, JZ
-*/
-#include <setjmp.h>
-qnexte_()
-{ static jmp_buf myenv;
- static int ireent = 0;
- static int j = 7;
-
- if (ireent) longjmp(myenv, j);
-
- ireent = 77;
- setjmp(myenv);
- qnext_();
-}
diff --git a/src/packlib/kernlib/kerngen/ccgen/systei.c b/src/packlib/kernlib/kerngen/ccgen/systei.c
deleted file mode 100644
index 7498487..0000000
--- a/src/packlib/kernlib/kerngen/ccgen/systei.c
+++ /dev/null
@@ -1,76 +0,0 @@
-/*
- * $Id: systei.c,v 1.3 1997/09/02 14:26:40 mclareni Exp $
- *
- * $Log: systei.c,v $
- * Revision 1.3 1997/09/02 14:26:40 mclareni
- * WINNT correction
- *
- * Revision 1.2 1997/02/04 17:34:45 mclareni
- * Merge Winnt and 97a versions
- *
- * Revision 1.1.1.1.2.1 1997/01/21 11:29:44 mclareni
- * All mods for Winnt 96a on winnt branch
- *
- * Revision 1.1.1.1 1996/02/15 17:49:27 mclareni
- * Kernlib
- *
- */
-#include "kerngen/pilot.h"
-#include "kerngen/fortranc.h"
-
-/*> ROUTINE SYSTEI
- CERN PROGLIB# Z265 SYSTEI .VERSION KERNFOR 4.31 911111
- ORIG. 22/02/91, JZ
- Fortran interface routine to system
-
- ISTAT = SYSTEMF (TEXT)
-
- TEXT the command to be executed .
- ISTAT returns zero if successful
-*/
-#include <stdio.h>
-#include "kerngen/fortchar.h"
-
-#if defined(CERNLIB_QX_SC)
-int type_of_call systei_(ftext,nsize)
-#endif
-
-#if defined(CERNLIB_QXNO_SC)
-int type_of_call systei(ftext,nsize)
-#endif
-
-#if defined(CERNLIB_QXCAPT)
-# ifndef CERNLIB_MSSTDCALL
- int type_of_call SYSTEI(ftext,nsize)
-# else
- int type_of_call SYSTEI(ftext,len_ftext,nsize)
-# endif
-#endif
-
-#if defined(CERNLIB_QMCRY)
- _fcd ftext;
-#endif
-#if !defined(CERNLIB_QMCRY)
- char *ftext;
-#endif
- int *nsize;
-#ifdef CERNLIB_MSSTDCALL
- int len_ftext;
-#endif
-{
- char *ptname, *fchtak();
- int system();
- int istat;
-
-/* get memory and copy TEXT terminated */
-
- ptname = fchtak(ftext,*nsize);
- if (ptname == NULL) goto bad;
-
- istat = system (ptname);
- free (ptname);
- return istat;
-
-bad: return -1;
-}
-/*> END <----------------------------------------------------------*/
diff --git a/src/packlib/kernlib/kerngen/ccgen/systemf.F b/src/packlib/kernlib/kerngen/ccgen/systemf.F
deleted file mode 100644
index 607b6cc..0000000
--- a/src/packlib/kernlib/kerngen/ccgen/systemf.F
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: systemf.F,v 1.2 1997/02/04 17:34:46 mclareni Exp $
-*
-* $Log: systemf.F,v $
-* Revision 1.2 1997/02/04 17:34:46 mclareni
-* Merge Winnt and 97a versions
-*
-* Revision 1.1.1.1.2.1 1997/01/21 11:29:45 mclareni
-* All mods for Winnt 96a on winnt branch
-*
-* Revision 1.1.1.1 1996/02/15 17:49:27 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QMVAX)
-#include "vaxsys/systemf.F"
-#else
- INTEGER FUNCTION SYSTEMF (NAME)
-C
-C CERN PROGLIB# Z265 SYSTEMF .VERSION KERNFOR 4.26 910313
-C ORIG. 22/02/91, JZ
-C Fortran interface routine to system
-C
- CHARACTER NAME*(*)
- INTEGER SYSTEI
-
-
- LGNAME = LNBLNK (NAME)
- SYSTEMF = SYSTEI (NAME,LGNAME)
- RETURN
- END
-#endif
diff --git a/src/packlib/kernlib/kerngen/ccgen/timel.c b/src/packlib/kernlib/kerngen/ccgen/timel.c
deleted file mode 100644
index 6e7085a..0000000
--- a/src/packlib/kernlib/kerngen/ccgen/timel.c
+++ /dev/null
@@ -1,190 +0,0 @@
-/*
- * $Id: timel.c,v 1.2 1997/02/04 17:34:47 mclareni Exp $
- *
- * $Log: timel.c,v $
- * Revision 1.2 1997/02/04 17:34:47 mclareni
- * Merge Winnt and 97a versions
- *
- * Revision 1.1.1.1.2.1 1997/01/21 11:29:45 mclareni
- * All mods for Winnt 96a on winnt branch
- *
- * Revision 1.1.1.1 1996/02/15 17:49:27 mclareni
- * Kernlib
- *
- */
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_WINNT)
-#include "wntgs/timel.c"
-#elif defined(CERNLIB_QMDOS)
-#include "dosgs/timel.c"
-#elif defined(CERNLIB_QMIRTD)
-#include "irtdgs/timel.c"
-#else
-/*> ROUTINE TIMEL
- CERN PROGLIB# Z007 TIMEST .VERSION KERNFOR 4.39 940228
- ORIG. 01/03/85 FCA, mod 03/11/93 GF
-*/
-#include <sys/types.h>
-#include <time.h>
-#include <sys/times.h>
-#include <sys/param.h>
-#include <sys/time.h>
-#include <sys/resource.h>
-
-#ifndef CLOCKS_PER_SEC
-#define CLOCKS_PER_SEC CLK_TCK
-#endif
-
-
-#ifndef RLIMIT_CPU
-#define RLIMIT_CPU 0 /* For HP-UX... */
-#endif
-#ifndef RLIM_INFINITY
-#define RLIM_INFINITY 0x7fffffff /* For HP-UX... */
-#endif
-
-#if defined(CERNLIB_QSYSBSD)||defined(CERNLIB_QMVMI)||defined(CERNLIB_QMVAOS)
-#define HZ 60.;
-#endif
-
-#ifndef HZ
-#ifdef __GNUC__
-#define HZ 1
-#else
-#define HZ 1./CLOCKS_PER_SEC
-#endif
-#endif
-
-struct tms tps;
-static float timlim;
-static time_t timstart, timlast;
-static int tml_init = 1;
-float deftim = 999.;
-
-#if defined(CERNLIB_QX_SC)
-#define timest timest_
-#define timex timex_
-#define timed timed_
-#define timel timel_
-#endif
-#if defined(CERNLIB_QXCAPT)
-#define timest TIMEST
-#define timex TIMEX
-#define timed TIMED
-#define timel TIMEL
-#endif
-
- /* local routine called by timst, and time_init */
-static void time_st(timl)
-float timl;
-{
- times(&tps);
- timlim = timl;
- timstart = tps.tms_utime+tps.tms_cutime+tps.tms_stime+tps.tms_cstime;
- timlast = timstart;
- tml_init = 0;
- return;
-}
- /* local routine to start by default */
-static void time_init()
-{
- struct rlimit rlimit;
- float maxtime;
-
- maxtime=deftim;
-
- if (getrlimit(RLIMIT_CPU, &rlimit)==0) {
- if ( rlimit.rlim_cur != RLIM_INFINITY )
- maxtime = (float) rlimit.rlim_cur;
- }
-
- time_st(maxtime);
- return;
-}
-
-void timest(timl)
-float *timl;
-{
- struct rlimit rlimit;
- float maxtime;
-
- if (tml_init != 0) {
-
-/* get maximum time allowed by system, and do not allow more */
- maxtime = *timl;
- if (getrlimit(RLIMIT_CPU, &rlimit)==0) {
- maxtime = (float) rlimit.rlim_cur;
- maxtime = ( maxtime > *timl ) ? *timl : maxtime;
- }
- time_st(maxtime);
- }
- return;
-}
-void timex(tx)
-/*
-C
- CERN PROGLIB# Z007 TIMEX .VERSION KERNFOR 4.39 940228
-C
-*/
-float *tx;
-{
- time_t timnow;
- if (tml_init) {
- time_init();
- *tx = 0.;
- }
- else {
- times(&tps);
- timnow = tps.tms_utime+tps.tms_cutime+tps.tms_stime+tps.tms_cstime;
- *tx = (float) (timnow - timstart) / HZ;
- }
- return;
-}
-
-void timed(td)
-/*
-C
- CERN PROGLIB# Z007 TIMED .VERSION KERNFOR 4.39 940228
-C
-*/
-float *td;
-{
- time_t timnow;
- if (tml_init) {
- time_init();
- *td = timlim;
- }
- else {
- times(&tps);
- timnow = tps.tms_utime+tps.tms_cutime+tps.tms_stime+tps.tms_cstime;
- *td = (float) (timnow - timlast) / HZ;
- timlast = timnow;
- }
- return;
-}
-
-void timel(tl)
-/*
-C
- CERN PROGLIB# Z007 TIMEL .VERSION KERNFOR 4.39 940228
-C
-*/
-float *tl;
-{
- time_t timnow;
- if (tml_init) {
- time_init();
- *tl = timlim;
- }
- else {
- times(&tps);
- timnow = tps.tms_utime+tps.tms_cutime+tps.tms_stime+tps.tms_cstime;
- *tl = timlim - (float) (timnow - timstart) / HZ;
- }
- return;
-}
-#ifdef __GNUC__
-#undef time_t
-#endif
-/*> END <----------------------------------------------------------*/
-#endif
diff --git a/src/packlib/kernlib/kerngen/ccgen/tminit.c b/src/packlib/kernlib/kerngen/ccgen/tminit.c
deleted file mode 100644
index d71acb9..0000000
--- a/src/packlib/kernlib/kerngen/ccgen/tminit.c
+++ /dev/null
@@ -1,40 +0,0 @@
-/*
- * $Id: tminit.c,v 1.2 1997/02/04 17:34:48 mclareni Exp $
- *
- * $Log: tminit.c,v $
- * Revision 1.2 1997/02/04 17:34:48 mclareni
- * Merge Winnt and 97a versions
- *
- * Revision 1.1.1.1.2.1 1997/01/21 11:29:46 mclareni
- * All mods for Winnt 96a on winnt branch
- *
- * Revision 1.1.1.1 1996/02/15 17:49:28 mclareni
- * Kernlib
- *
- */
-#include "kerngen/pilot.h"
-#include "kerngen/fortranc.h"
-
-/*> ROUTINE TMINIT
- CERN PROGLIB# TMINIT .VERSION KERNFOR 4.36 930602
- ORIG. 20/07/90, RH + JZ
- Fortran interface routine to initialize TMPRO / TMREAD
- CALL TMINIT (INIT)
-*/
-#include <stdio.h>
-#if defined(CERNLIB_QX_SC)
-void type_of_call tminit_(ptinit)
-#endif
-#if defined(CERNLIB_QXNO_SC)
-void type_of_call tminit(ptinit)
-#endif
-#if defined(CERNLIB_QXCAPT)
-void type_of_call TMINIT(ptinit)
-#endif
- int *ptinit;
-{
- *ptinit = 7;
-/* setbuf (stdout,NULL); */
- return;
-}
-/*> END <----------------------------------------------------------*/
diff --git a/src/packlib/kernlib/kerngen/ccgen/tmpro.F b/src/packlib/kernlib/kerngen/ccgen/tmpro.F
deleted file mode 100644
index 54e4cfc..0000000
--- a/src/packlib/kernlib/kerngen/ccgen/tmpro.F
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: tmpro.F,v 1.1.1.1 1996/02/15 17:49:28 mclareni Exp $
-*
-* $Log: tmpro.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:28 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QMVAX)
-#include "vaxsys/tmpro.F"
-#else
- SUBROUTINE TMPRO (TEXT)
-C
-C CERN PROGLIB# TMPRO .VERSION KERNFOR 4.37 930715
-C ORIG. 30/05/91, JZ
-C
-C Fortran interface : print a prompt string
-C
- CHARACTER TEXT*(*)
-
- LGTEXT = LEN (TEXT)
-#if defined(CERNLIB_QMVAX)
- CALL TMPROI (%REF(TEXT),LGTEXT)
-#endif
-#if !defined(CERNLIB_QMVAX)
- CALL TMPROI (TEXT,LGTEXT)
-#endif
- RETURN
- END
-#endif
diff --git a/src/packlib/kernlib/kerngen/ccgen/tmproi.c b/src/packlib/kernlib/kerngen/ccgen/tmproi.c
deleted file mode 100644
index e4d5d63..0000000
--- a/src/packlib/kernlib/kerngen/ccgen/tmproi.c
+++ /dev/null
@@ -1,54 +0,0 @@
-/*
-* $Id: tmproi.c,v 1.3 1997/10/23 16:25:12 mclareni Exp $
-*
-* $Log: tmproi.c,v $
-* Revision 1.3 1997/10/23 16:25:12 mclareni
-* NT mods, mostly C Fortran interface
-*
-* Revision 1.2 1997/02/04 17:34:48 mclareni
-* Merge Winnt and 97a versions
-*
-* Revision 1.1.1.1.2.1 1997/01/21 11:29:46 mclareni
-* All mods for Winnt 96a on winnt branch
-*
-* Revision 1.1.1.1 1996/02/15 17:49:28 mclareni
-* Kernlib
-*
-*/
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QMDOS)
-#include "wntgs/tmproi.c"
-#else
-/*> ROUTINE TMPROI
- CERN PROGLIB# TMPROI .VERSION KERNFOR 4.39 940228
- ORIG. 30/05/91, JZ
- Fortran interface routine to print a prompt string
- CALL TMPRO (TEXT)
-*/
-#ifdef WIN32
-#include <io.h>
-#endif
-#include <stdio.h>
-#include "kerngen/fortchar.h"
-#if defined(CERNLIB_QX_SC)
-void tmproi_(ftext, lgtext)
-#endif
-#if defined(CERNLIB_QXNO_SC)
-void tmproi(ftext, lgtext)
-#endif
-#if defined(CERNLIB_QXCAPT)
-void TMPROI(ftext, lgtext)
-#endif
-#if defined(CERNLIB_QMCRY)
- _fcd ftext;
-#endif
-#if !defined(CERNLIB_QMCRY)
- char *ftext;
-#endif
- int *lgtext;
-{
- write (1, ftext, *lgtext);
- return;
-}
-/*> END <----------------------------------------------------------*/
-#endif
diff --git a/src/packlib/kernlib/kerngen/ccgen/tmread.c b/src/packlib/kernlib/kerngen/ccgen/tmread.c
deleted file mode 100644
index 2137916..0000000
--- a/src/packlib/kernlib/kerngen/ccgen/tmread.c
+++ /dev/null
@@ -1,82 +0,0 @@
-/*
-* $Id: tmread.c,v 1.2 1997/02/04 17:34:49 mclareni Exp $
-*
-* $Log: tmread.c,v $
-* Revision 1.2 1997/02/04 17:34:49 mclareni
-* Merge Winnt and 97a versions
-*
-* Revision 1.1.1.1.2.1 1997/01/21 11:29:47 mclareni
-* All mods for Winnt 96a on winnt branch
-*
-* Revision 1.1.1.1 1996/02/15 17:49:28 mclareni
-* Kernlib
-*
-*/
-#include "kerngen/pilot.h"
-#include "kerngen/fortranc.h"
-
-/*> ROUTINE TMREAD
- CERN PROGLIB# TMREAD .VERSION KERNFOR 4.37 930715
- ORIG. 20/07/90, JZ
- read the next line from stdin :
- CALL TMREAD (MAXCH, LINE, NCH, ISTAT)
- MAXCH maxim. # of characters into LINE
- NCH actual # of characters read into LINE
- ISTAT status return, zero : OK -ve : EoF
-*/
-#include <stdio.h>
-#if defined(CERNLIB_QMVAX)
-#include descrip
-#endif
-#if defined(CERNLIB_QX_SC)
-void type_of_call tmread_(alim, cols, anch, astat)
-#endif
-#if defined(CERNLIB_QXNO_SC)
-void type_of_call tmread(alim, cols, anch, astat)
-#endif
-#if defined(CERNLIB_QXCAPT)
-void type_of_call TMREAD(alim, cols, anch, astat)
-#endif
-#if defined(CERNLIB_QMVAX)
- struct dsc$descriptor_s *cols;
-#endif
-#if !defined(CERNLIB_QMVAX)
- char *cols;
-#endif
- int *alim, *anch, *astat;
-{
- char *ubuf;
- int ch, jcol, lim;
-
-#if defined(CERNLIB_QMVAX)
- ubuf = cols->dsc$a_pointer;
-#endif
-#if !defined(CERNLIB_QMVAX)
- ubuf = cols;
-#endif
-
-/*-- read the text */
- lim = *alim;
- jcol = 0;
- while (lim-- > 0)
- { ch = getchar();
- if (ch == EOF) goto endf;
- if (ch == '\n') goto endl;
- *ubuf++ = ch;
- jcol = jcol + 1;
- }
-/* discard excess characters */
-loop: ch = getchar();
- if (ch == '\n') goto endl;
- if (ch != EOF) goto loop;
-
-endf: *anch = jcol;
- *astat = -1;
- clearerr(stdin);
- return;
-
-endl: *anch = jcol;
- *astat = 0;
- return;
-}
-/*> END <----------------------------------------------------------*/
diff --git a/src/packlib/kernlib/kerngen/ccgen/toslat.F b/src/packlib/kernlib/kerngen/ccgen/toslat.F
deleted file mode 100644
index a11433d..0000000
--- a/src/packlib/kernlib/kerngen/ccgen/toslat.F
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: toslat.F,v 1.1.1.1 1996/02/15 17:49:28 mclareni Exp $
-*
-* $Log: toslat.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:28 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE TOSLAT (IVEC,N)
-C
-C CERN PROGLIB# TOSLAT .VERSION KERNFOR 4.33 920511
-C ORIG. 22/02/91, JZ
-C Fortran interface to copy a vector from a C routine into /SLATE/
-C On Apollo it is at the moment not possible to access a
-C Fortran COMMON from C
-C
- COMMON /SLATE/ISLAT(40)
-
- CALL UCOPY (IVEC, ISLAT, N)
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/ccgen/unlini.c b/src/packlib/kernlib/kerngen/ccgen/unlini.c
deleted file mode 100644
index f7b187d..0000000
--- a/src/packlib/kernlib/kerngen/ccgen/unlini.c
+++ /dev/null
@@ -1,72 +0,0 @@
-/*
- * $Id: unlini.c,v 1.3 1997/09/02 14:26:40 mclareni Exp $
- *
- * $Log: unlini.c,v $
- * Revision 1.3 1997/09/02 14:26:40 mclareni
- * WINNT correction
- *
- * Revision 1.2 1997/02/04 17:34:50 mclareni
- * Merge Winnt and 97a versions
- *
- * Revision 1.1.1.1.2.1 1997/01/21 11:29:47 mclareni
- * All mods for Winnt 96a on winnt branch
- *
- * Revision 1.1.1.1 1996/02/15 17:49:28 mclareni
- * Kernlib
- *
- */
-#include "kerngen/pilot.h"
-#include "kerngen/fortranc.h"
-
-/*> ROUTINE UNLINI
- CERN PROGLIB# Z265 UNLINI .VERSION KERNFOR 4.31 911111
- ORIG. 15/10/91, JZ
- Fortran interface routine to unlink
-
- ISTAT = UNLINKF (NAME)
-
- NAME the name of the file to be deleted
- ISTAT returns zero if successful
-*/
-#include <stdio.h>
-#include "kerngen/fortchar.h"
-#if defined(CERNLIB_QX_SC)
-int type_of_call unlini_(fname,lgname)
-#endif
-#if defined(CERNLIB_QXNO_SC)
-int type_of_call unlini(fname,lgname)
-#endif
-#if defined(CERNLIB_QXCAPT)
-# ifndef CERNLIB_MSSTDCALL
- int type_of_call UNLINI(fname,lgname)
-# else
- int type_of_call UNLINI(fname,lfname,lgname)
- int lfname;
-# endif
-#endif
-#if defined(CERNLIB_QMCRY)
- _fcd fname;
-#endif
-#if !defined(CERNLIB_QMCRY)
- char *fname;
-#endif
- int *lgname;
-{
- char *ptname, *fchtak();
- int istat, unlink();
-
-/* get memory and copy NAME terminated */
-
- ptname = fchtak(fname,*lgname);
- if (ptname == NULL) goto bad;
-
- istat = unlink (ptname);
- free (ptname);
- return istat;
-
-bad: return -1;
-}
-/*> END <----------------------------------------------------------*/
-#ifdef CERNLIB_TCGEN_UNLINKF
-#undef CERNLIB_TCGEN_UNLINKF
-#endif
diff --git a/src/packlib/kernlib/kerngen/ccgen/unlinkf.F b/src/packlib/kernlib/kerngen/ccgen/unlinkf.F
deleted file mode 100644
index 16b4f30..0000000
--- a/src/packlib/kernlib/kerngen/ccgen/unlinkf.F
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: unlinkf.F,v 1.1.1.1 1996/02/15 17:49:28 mclareni Exp $
-*
-* $Log: unlinkf.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:28 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- INTEGER FUNCTION UNLINKF (NAME)
-C
-C CERN PROGLIB# Z265 UNLINKF .VERSION KERNFOR 4.31 911111
-C ORIG. 15/10/91, JZ
-C Fortran interface routine to unlink
-C
- CHARACTER NAME*(*)
- INTEGER UNLINI
-
- LGNAME = LNBLNK (NAME)
- UNLINKF = UNLINI (NAME,LGNAME)
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/ccgen/vaogs/jumptn.c b/src/packlib/kernlib/kerngen/ccgen/vaogs/jumptn.c
deleted file mode 100644
index d4b15e4..0000000
--- a/src/packlib/kernlib/kerngen/ccgen/vaogs/jumptn.c
+++ /dev/null
@@ -1,82 +0,0 @@
-/*
- * $Id: jumptn.c,v 1.1.1.1 1996/02/15 17:49:32 mclareni Exp $
- *
- * $Log: jumptn.c,v $
- * Revision 1.1.1.1 1996/02/15 17:49:32 mclareni
- * Kernlib
- *
- */
-/*> ROUTINE JUMPTN
- CERN PROGLIB# Z043 JUMPTN .VERSION KERNVMI 1.09 940531
- ORIG. 21/04/88 JZ+FCA
-C
-C- To transfer to the user routine TARGET (say) with 2 parameters
-C- two steps are needed :
-
-C- 1) EXTERNAL TARGET to get the address of TARGET
-C- IADR = JUMPAD (TARGET)
-
-C- 3) CALL JUMPT2 (IADR,par1,par2) to transfer
-*/
-#define jumpt0 jumpt0_
-#define jumpt1 jumpt1_
-#define jumpt2 jumpt2_
-#define jumpt3 jumpt3_
-#define jumpt4 jumpt4_
-
-extern int jumpad_();
-
-static void (*jumpto)();
-
-void jumpt0(iadr)
- int *iadr;
-{
- long func;
- func = *iadr + (long)jumpad_;
- jumpto = (void(*)()) func;
- jumpto();
- return;
-}
-
-void jumpt1(iadr,ipara)
- int *iadr;
- char *ipara;
-{
- long func;
- func = *iadr + (long)jumpad_;
- jumpto = (void(*)()) func;
- jumpto (ipara);
- return;
-}
-
-void jumpt2(iadr, ipara, iparb)
- int *iadr;
- char *ipara, *iparb;
-{
- long func;
- func = *iadr + (long)jumpad_;
- jumpto = (void(*)()) func;
- jumpto (ipara, iparb);
- return;
-}
-void jumpt3(iadr, ipara, iparb, iparc)
- int *iadr;
- char *ipara, *iparb, *iparc;
-{
- long func;
- func = *iadr + (long)jumpad_;
- jumpto = (void(*)()) func;
- jumpto (ipara, iparb, iparc);
- return;
-}
-void jumpt4(iadr, ipara, iparb, iparc, ipard)
- int *iadr;
- char *ipara, *iparb, *iparc, *ipard;
-{
- long func;
- func = *iadr + (long)jumpad_;
- jumpto = (void(*)()) func;
- jumpto (ipara, iparb, iparc, ipard);
- return;
-}
-/*> END <----------------------------------------------------------*/
diff --git a/src/packlib/kernlib/kerngen/ccgen/vaogs/jumpxn.c b/src/packlib/kernlib/kerngen/ccgen/vaogs/jumpxn.c
deleted file mode 100644
index e1ec301..0000000
--- a/src/packlib/kernlib/kerngen/ccgen/vaogs/jumpxn.c
+++ /dev/null
@@ -1,79 +0,0 @@
-/*
- * $Id: jumpxn.c,v 1.1.1.1 1996/02/15 17:49:32 mclareni Exp $
- *
- * $Log: jumpxn.c,v $
- * Revision 1.1.1.1 1996/02/15 17:49:32 mclareni
- * Kernlib
- *
- */
-/*> ROUTINE JUMPXN
- CERN PROGLIB# Z042 JUMPXN .VERSION KERNVMI 1.08 930527
- ORIG. 21/04/88 JZ+FCA, adapted 11/05/93 AP+JZ
-C
-C- To transfer to the user routine TARGET (say) with 2 parameters
-C- three steps are needed :
-
-C- 1) EXTERNAL TARGET to get the address of TARGET
-C- IADR = JUMPAD (TARGET)
-
-C- 2) CALL JUMPST (IADR) to set the tranfer address
-
-C- 3) CALL JUMPX2 (par1,par2) to transfer
-*/
-
-static void (*tarsub)();
-
-/* ---- jumpad --------------------------------------------- */
-int jumpad_(ifun)
- char *ifun;
-{
- long temp;
-
- temp = (long)ifun - (long)jumpad_;
- return (int) temp;
-}
-
-/* ---- jumpst --------------------------------------------- */
-void jumpst_(iadr)
- int *iadr;
-{
- long true;
-
- true = (long)jumpad_;
- true = true + *iadr;
- tarsub = (void (*)())true;
-}
-
-/* ---- jumpxn --------------------------------------------- */
-jumpx0_()
-{
- (*tarsub)();
- return;
-}
-
-jumpx1_(ipara)
- char *ipara;
-{
- (*tarsub)(ipara);
- return;
-}
-
-jumpx2_(ipara, iparb)
- char *ipara, *iparb;
-{
- (*tarsub)(ipara, iparb);
- return;
-}
-jumpx3_(ipara, iparb, iparc)
- char *ipara, *iparb, *iparc;
-{
- (*tarsub)(ipara, iparb, iparc);
- return;
-}
-jumpx4_(ipara, iparb, iparc, ipard)
- char *ipara, *iparb, *iparc, *ipard;
-{
- (*tarsub)(ipara, iparb, iparc, ipard);
- return;
-}
-/*> END <----------------------------------------------------------*/
diff --git a/src/packlib/kernlib/kerngen/ccgen/vaogs/locf.c b/src/packlib/kernlib/kerngen/ccgen/vaogs/locf.c
deleted file mode 100644
index f54bec4..0000000
--- a/src/packlib/kernlib/kerngen/ccgen/vaogs/locf.c
+++ /dev/null
@@ -1,18 +0,0 @@
-/*
- * $Id: locf.c,v 1.1.1.1 1996/02/15 17:49:32 mclareni Exp $
- *
- * $Log: locf.c,v $
- * Revision 1.1.1.1 1996/02/15 17:49:32 mclareni
- * Kernlib
- *
- */
-/*> ROUTINE LOCF
- CERN PROGLIB# N100 LOCF .VERSION KERNVMI 1.08 930527
- ORIG. 11/05/93, JZ
-*/
-unsigned int locf_(iadr)
- char *iadr;
-{
- return( ((unsigned) iadr) >> 2 );
-}
-/*> END <----------------------------------------------------------*/
diff --git a/src/packlib/kernlib/kerngen/ccgen/vaxsys/chdirf.F b/src/packlib/kernlib/kerngen/ccgen/vaxsys/chdirf.F
deleted file mode 100644
index 1f91dca..0000000
--- a/src/packlib/kernlib/kerngen/ccgen/vaxsys/chdirf.F
+++ /dev/null
@@ -1,112 +0,0 @@
-*
-* $Id: chdirf.F,v 1.1.1.1 1996/02/15 17:49:29 mclareni Exp $
-*
-* $Log: chdirf.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:29 mclareni
-* Kernlib
-*
-*
- INTEGER FUNCTION CHDIRF (CHNAME)
-C
-C CERN PROGLIB# Z265 CHDIRF .VERSION KERNVAX 2.36 910306
-C ORIG. 31/07/90, Federico Carminati
-C MODIF. 25/02/91, Jamie Shiers, to work in detached mode
-C
-C- Simulate UNIX system call
-
- INCLUDE '($LNMDEF)'
- STRUCTURE /ITMLST/
- UNION
- MAP
- INTEGER*2 BUFFER_LENGTH
- INTEGER*2 ITEM_CODE
- INTEGER*4 BUFFER_ADDRESS
- INTEGER*4 RETURN_LENGTH_ADDRESS
- ENDMAP
- MAP
- INTEGER*4 END_LIST /0/
- ENDMAP
- END UNION
- END STRUCTURE
-
- RECORD /ITMLST/ LNM_LIST(2)
-
- COMMON /SLATE/ ISTAT, ISLATE(39)
-
- CHARACTER CHNAME*(*), CHSTRI*255, CHLOGN*127
- LOGICAL FIRST
- INTEGER*2 LIST2(2)
- INTEGER LIST4(4), SYS$SETDDIR, SYS$TRNLNM, SYS$CRELNM
- EQUIVALENCE (LIST2, LIST4)
- DATA LENRET/0/
-
- CHSTRI=CHNAME
- FIRST=.TRUE.
- LENCHN=INDEX(CHNAME,' ')-1
- IF (LENCHN.LE.0) LENCHN=LEN(CHNAME)
-*
-* Cater for users who like the <> characters as directory delimiters
-*
- CALL CTRANS('<','[',CHSTRI,1,LENCHN)
- CALL CTRANS('>',']',CHSTRI,1,LENCHN)
- 10 IF (CHSTRI(1:1).NE.'[') THEN
- IF (INDEX(CHSTRI,':[') .NE. 0) THEN
-*
-*--- A directory and a device are specified
-*
-* ISTAT=LIB$SET_LOGICAL('SYS$DISK',CHSTRI(1:INDEX(CHSTRI,':')),
-* + 'LNM$PROCESS')
-
- LNM_LIST(1).BUFFER_LENGTH = INDEX(CHSTRI,':')
- LNM_LIST(1).ITEM_CODE = LNM$_STRING
- LNM_LIST(1).BUFFER_ADDRESS = %LOC(CHSTRI)
- LNM_LIST(1).RETURN_LENGTH_ADDRESS = %LOC(LENRET)
-
- LNM_LIST(2).END_LIST = 0
-
- ISTAT=SYS$CRELNM(,'LNM$PROCESS','SYS$DISK',,LNM_LIST)
- IF(.NOT.ISTAT) GO TO 20
- CHSTRI=CHSTRI(INDEX(CHSTRI,'['):)
- ELSEIF (CHSTRI(LENCHN:LENCHN).EQ.':') THEN
-*
-*--- A device only is specified
-*
-* ISTAT=LIB$SET_LOGICAL('SYS$DISK',CHSTRI(:LENCHN),
-* + 'LNM$PROCESS')
-
- LNM_LIST(1).BUFFER_LENGTH = LENCHN
- LNM_LIST(1).ITEM_CODE = LNM$_STRING
- LNM_LIST(1).BUFFER_ADDRESS = %LOC(CHSTRI)
- LNM_LIST(1).RETURN_LENGTH_ADDRESS = %LOC(LENRET)
-
- LNM_LIST(2).END_LIST = 0
-
- ISTAT=SYS$CRELNM(,'LNM$PROCESS','SYS$DISK',,LNM_LIST)
- GO TO 20
- ELSEIF (FIRST) THEN
- FIRST=.FALSE.
- LIST2(1)=LEN(CHLOGN)
- LIST2(2)=LNM$_STRING
- LIST4(2)=%LOC(CHLOGN)
- LIST4(3)=%LOC(LENCH)
- LIST4(4)=0
- ISTAT = SYS$TRNLNM(LNM$M_CASE_BLIND,'LNM$FILE_DEV',
- + CHSTRI(1:INDEX(CHSTRI,' ')-1),,LIST2)
- IF(.NOT.ISTAT) GO TO 20
- CHSTRI=CHLOGN(:LENCH)
- GO TO 10
- ELSE
- ISTAT=0
- GO TO 20
- END IF
- END IF
- ISTAT = SYS$SETDDIR(CHSTRI, %VAL(0), %VAL(0))
- 20 IF (ISTAT) THEN
- ISTAT = 0
- IRET = 0
- ELSE
- IRET = -1
- ENDIF
- CHDIRF = IRET
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/ccgen/vaxsys/getenvf.F b/src/packlib/kernlib/kerngen/ccgen/vaxsys/getenvf.F
deleted file mode 100644
index 8e12640..0000000
--- a/src/packlib/kernlib/kerngen/ccgen/vaxsys/getenvf.F
+++ /dev/null
@@ -1,43 +0,0 @@
-*
-* $Id: getenvf.F,v 1.1.1.1 1996/02/15 17:49:29 mclareni Exp $
-*
-* $Log: getenvf.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:29 mclareni
-* Kernlib
-*
-*
- SUBROUTINE GETENVF (CHSYM,CHTEXT)
-
-C CERN PROGLIB# Z265 GETENVF .VERSION KERNVAX 2.36 910306
-C ORIG. 31/07/90, JZ
-C MOD. 11/01/91, JZ, change name to GETENVF
-
-C- Simulate UNIX system call
-
- COMMON /SLATE/ NTEXT, ISTAT, ISLATE(38)
- CHARACTER CHSYM*(*), CHTEXT*(*)
-
- NALL = 0
- NSYM = LNBLNK (CHSYM)
- IF (NSYM.LE.0) THEN
- ISTAT = -7
- NALL = 0
- GO TO 27
- ENDIF
-
- IF (NSYM.NE.4) GO TO 21
- IF (CHSYM(1:4).NE.'HOME') GO TO 21
- ISTAT = LIB$SYS_TRNLOG ('SYS$LOGIN',NALL,CHTEXT,,,%VAL(0))
- GO TO 24
-
- 21 ISTAT = LIB$GET_SYMBOL (CHSYM(1:NSYM),CHTEXT,NALL)
- 24 IF (ISTAT) THEN
- ISTAT = 0
- ELSE
- NALL = 0
- ENDIF
-
- 27 CHTEXT(NALL+1:) = ' '
- NTEXT = NALL
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/ccgen/vaxsys/getwdf.F b/src/packlib/kernlib/kerngen/ccgen/vaxsys/getwdf.F
deleted file mode 100644
index f3b488d..0000000
--- a/src/packlib/kernlib/kerngen/ccgen/vaxsys/getwdf.F
+++ /dev/null
@@ -1,38 +0,0 @@
-*
-* $Id: getwdf.F,v 1.1.1.1 1996/02/15 17:49:29 mclareni Exp $
-*
-* $Log: getwdf.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:29 mclareni
-* Kernlib
-*
-*
- SUBROUTINE GETWDF (TEXT)
-
-C CERN PROGLIB# Z265 GETWDF .VERSION KERNVAX 2.36 910306
-C ORIG. 31/07/90, Federico Carminati
-C MOD. 11/01/91, JZ, change name to GETWDF
-
-C- Simulate UNIX system call
-
- COMMON /SLATE/ NTEXT, ISTAT, ISLATE(38)
- CHARACTER TEXT*(*)
- INTEGER SYS$SETDDIR
-
- ISTAT = LIB$SYS_TRNLOG ('SYS$DISK',NDISK,TEXT,,,%VAL(0))
-
- IF (.NOT.ISTAT) GO TO 99
-
- ISTAT = SYS$SETDDIR(%VAL(0), NDIR, TEXT(NDISK+1:))
-
- IF (.NOT.ISTAT) GO TO 99
-
- NALL = NDISK + NDIR
- TEXT(NALL+1:) = ' '
- NTEXT = NALL
- ISTAT = 0
- RETURN
-
- 99 TEXT = ' '
- NTEXT = 0
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/ccgen/vaxsys/renamef.F b/src/packlib/kernlib/kerngen/ccgen/vaxsys/renamef.F
deleted file mode 100644
index 886a063..0000000
--- a/src/packlib/kernlib/kerngen/ccgen/vaxsys/renamef.F
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: renamef.F,v 1.1.1.1 1996/02/15 17:49:29 mclareni Exp $
-*
-* $Log: renamef.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:29 mclareni
-* Kernlib
-*
-*
- INTEGER FUNCTION RENAMEF (FROM,TO)
-C
-C CERN PROGLIB# Z265 RENAMEF .VERSION KERNVAX 2.36 910306
-C ORIG. 06/03/91, JZ
-C Fortran interface routine to rename
-C
- CHARACTER*(*) FROM, TO
-
- LGFR = LNBLNK (FROM)
- LGTO = LNBLNK (TO)
- ISTAT = LIB$RENAME_FILE (FROM(1:LGFR), TO(1:LGTO))
-
- IF (ISTAT) ISTAT = 0
- RENAMEF = ISTAT
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/ccgen/vaxsys/systemf.F b/src/packlib/kernlib/kerngen/ccgen/vaxsys/systemf.F
deleted file mode 100644
index 73ac1d3..0000000
--- a/src/packlib/kernlib/kerngen/ccgen/vaxsys/systemf.F
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: systemf.F,v 1.1.1.1 1996/02/15 17:49:29 mclareni Exp $
-*
-* $Log: systemf.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:29 mclareni
-* Kernlib
-*
-*
- INTEGER FUNCTION SYSTEMF (NAME)
-C
-C CERN PROGLIB# Z265 SYSTEMF .VERSION KERNVAX 2.46 940913
-C ORIG. 06/03/91, JZ, mod. march 94, JS
-C Fortran interface routine to system
-C
- CHARACTER NAME*(*)
- INCLUDE '($SSDEF)'
-
- LGN = LNBLNK (NAME)
- ISTAT = LIB$SPAWN (NAME(1:LGN))
- IF(ISTAT.EQ.SS$_NORMAL) ISTAT = 0
- SYSTEMF = ISTAT
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/ccgen/vaxsys/tmpro.F b/src/packlib/kernlib/kerngen/ccgen/vaxsys/tmpro.F
deleted file mode 100644
index 86ceb5f..0000000
--- a/src/packlib/kernlib/kerngen/ccgen/vaxsys/tmpro.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: tmpro.F,v 1.1.1.1 1996/02/15 17:49:30 mclareni Exp $
-*
-* $Log: tmpro.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:30 mclareni
-* Kernlib
-*
-*
- SUBROUTINE TMPRO (TEXT)
-C
-C CERN PROGLIB# Z313 TMPRO .VERSION KERNVAX 2.45 940228
-C ORIG. 16/02/94, JZ
-C
-C Print a prompt string to stdout
-C
- CHARACTER TEXT*(*)
-
- WRITE (6,9001) TEXT
- 9001 FORMAT (1X,A,$)
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/ccgen/vxinvb.c b/src/packlib/kernlib/kerngen/ccgen/vxinvb.c
deleted file mode 100644
index 0e14145..0000000
--- a/src/packlib/kernlib/kerngen/ccgen/vxinvb.c
+++ /dev/null
@@ -1,59 +0,0 @@
-/*
- * $Id: vxinvb.c,v 1.2 1997/02/04 17:34:50 mclareni Exp $
- *
- * $Log: vxinvb.c,v $
- * Revision 1.2 1997/02/04 17:34:50 mclareni
- * Merge Winnt and 97a versions
- *
- * Revision 1.1.1.1.2.1 1997/01/21 11:29:47 mclareni
- * All mods for Winnt 96a on winnt branch
- *
- * Revision 1.1.1.1 1996/02/15 17:49:28 mclareni
- * Kernlib
- *
- */
-#include "kerngen/pilot.h"
-#include "kerngen/fortranc.h"
-
-/*> ROUTINE VXINVB
- CERN PROGLIB#M434 VXINVB .VERSION KERNFOR 4.42 951011
- ORIG. 10/07/95, JZ
-
- CALL VXINVB (IXV,N)
-
- byte inversion N words of IXV, in situ
-*/
-
-#if defined(CERNLIB_QX_SC)
-void type_of_call vxinvb_(ixv, n)
-#endif
-#if defined(CERNLIB_QXNO_SC)
-void type_of_call vxinvb(ixv, n)
-#endif
-#if defined(CERNLIB_QXCAPT)
-void type_of_call VXINVB(ixv, n)
-#endif
- int *ixv, *n;
-{
- int limit, jloop;
- int in;
-
- limit = *n;
-
-/*-- swop: 1 | 2 | 3 | 4
- to: 4 | 3 | 2 | 1 */
-
- for (jloop = 0; jloop < limit; jloop++)
- { in = ixv[jloop];
- ixv[jloop] =
- ((in >> 24) & 0x000000ff) |
- ((in >> 8) & 0x0000ff00) |
- ((in << 8) & 0x00ff0000) |
- ((in << 24) & 0xff000000);
- }
- return;
-}
-/*> END <----------------------------------------------------------*/
-#ifdef CERNLIB_TCGEN_VXINVB
-#undef CERNLIB_TCGEN_VXINVB
-#endif
diff --git a/src/packlib/kernlib/kerngen/ccgen/vxinvc.c b/src/packlib/kernlib/kerngen/ccgen/vxinvc.c
deleted file mode 100644
index 3d22422..0000000
--- a/src/packlib/kernlib/kerngen/ccgen/vxinvc.c
+++ /dev/null
@@ -1,58 +0,0 @@
-/*
- * $Id: vxinvc.c,v 1.2 1997/02/04 17:34:51 mclareni Exp $
- *
- * $Log: vxinvc.c,v $
- * Revision 1.2 1997/02/04 17:34:51 mclareni
- * Merge Winnt and 97a versions
- *
- * Revision 1.1.1.1.2.1 1997/01/21 11:29:55 mclareni
- * All mods for Winnt 96a on winnt branch
- *
- * Revision 1.1.1.1 1996/02/15 17:49:28 mclareni
- * Kernlib
- *
- */
-#include "kerngen/pilot.h"
-#include "kerngen/fortranc.h"
-/*> ROUTINE VXINVC
- CERN PROGLIB#M434 VXINVC .VERSION KERNFOR 4.42 951011
- ORIG. 10/07/95, JZ
-
- CALL VXINVC (IV,IXV,N)
-
- copy N words from IV to IXV with byte inversion
-*/
-
-#if defined(CERNLIB_QX_SC)
-void type_of_call vxinvc_(iv, ixv, n)
-#endif
-#if defined(CERNLIB_QXNO_SC)
-void type_of_call vxinvc(iv, ixv, n)
-#endif
-#if defined(CERNLIB_QXCAPT)
-void type_of_call VXINVC(iv, ixv, n)
-#endif
- int *iv, *ixv, *n;
-{
- int limit, jloop;
- int in;
-
- limit = *n;
-
-/*-- swop: 1 | 2 | 3 | 4
- to: 4 | 3 | 2 | 1 */
-
- for (jloop = 0; jloop < limit; jloop++)
- { in = iv[jloop];
- ixv[jloop] =
- ((in >> 24) & 0x000000ff) |
- ((in >> 8) & 0x0000ff00) |
- ((in << 8) & 0x00ff0000) |
- ((in << 24) & 0xff000000);
- }
- return;
-}
-/*> END <----------------------------------------------------------*/
-#ifdef CERNLIB_TCGEN_VXINVC
-#undef CERNLIB_TCGEN_VXINVC
-#endif
diff --git a/src/packlib/kernlib/kerngen/ccgen/wntgs/doattention.c b/src/packlib/kernlib/kerngen/ccgen/wntgs/doattention.c
deleted file mode 100644
index 5d833b9..0000000
--- a/src/packlib/kernlib/kerngen/ccgen/wntgs/doattention.c
+++ /dev/null
@@ -1,9 +0,0 @@
-void DoAttention(char *name){
-#include <stdio.h>
-/* This routine just prints a remined about non-implemented features
- * Valery Fine 30.05.96 JINR/Dubna, Russia (E-mail: fine at vxcern.cern.ch
- */
- printf("===========================================================\n");
- printf("Attention !!! %s is not implemented for Windows NT\n", name);
- printf("===========================================================\n");
-}
diff --git a/src/packlib/kernlib/kerngen/ccgen/wntgs/intrac.c b/src/packlib/kernlib/kerngen/ccgen/wntgs/intrac.c
deleted file mode 100644
index 5c43c55..0000000
--- a/src/packlib/kernlib/kerngen/ccgen/wntgs/intrac.c
+++ /dev/null
@@ -1,33 +0,0 @@
-/*
- * $Id: intrac.c,v 1.1 1997/02/04 17:35:05 mclareni Exp $
- *
- * $Log: intrac.c,v $
- * Revision 1.1 1997/02/04 17:35:05 mclareni
- * Merge Winnt and 97a versions
- *
- * Revision 1.1.1.1 1996/02/15 17:49:31 mclareni
- * Kernlib
- *
- */
-/*> ROUTINE INTRAC
- CERN PROGLIB# Z044 INTRAC .VERSION KERNFOR 4.38 931108
-*/
-#ifdef WIN32
-#include <io.h>
-#endif
-
-#include "kerngen/fortranc.h"
-
-#if defined(CERNLIB_QX_SC)
-int type_of_call intrac_()
-#endif
-#if defined(CERNLIB_QXNO_SC)
-int type_of_call intrac()
-#endif
-#if defined(CERNLIB_QXCAPT)
-int type_of_call INTRAC()
-#endif
-{
- return (((int) isatty(0)!=0) ? 1 : 0) ;
-}
-/*> END <----------------------------------------------------------*/
diff --git a/src/packlib/kernlib/kerngen/ccgen/wntgs/lstati.c b/src/packlib/kernlib/kerngen/ccgen/wntgs/lstati.c
deleted file mode 100644
index 2e541f2..0000000
--- a/src/packlib/kernlib/kerngen/ccgen/wntgs/lstati.c
+++ /dev/null
@@ -1,67 +0,0 @@
-/*> ROUTINE LSTATI
- CERN PROGLIB# Z265 LSTATI .VERSION KERNFOR 4.38 931108
-C ORIG. 24/03/91, RDM + JZ
- Fortran interface routine to lstat
- Version for Windows NT/Windows 95 by Valery Fine 30/05/96 (fine at vxcern.cern.ch)
-*/
-#ifdef __STDC__
-# undef __STDC__
-#endif
-
-#include <stdio.h>
-#include <sys/types.h>
-#include <sys/stat.h>
-
-#include "kerngen/fortranc.h"
-
-#if defined(CERNLIB_QX_SC)
-int type_of_call lstati_(fname, info, lgname, slate)
-#endif
-#if defined(CERNLIB_QXNO_SC)
-int type_of_call lstati(fname, info, lgname, slate)
-#endif
-#if defined(CERNLIB_QXCAPT)
-int type_of_call LSTATI(fname, info, lgname, slate)
-#endif
- char *fname;
- int *lgname;
- int *info;
- int *slate;
-{
- struct _stat *buf;
- char *ptname, *fchtak();
- int istat, lstat();
-
- istat = -1;
- ptname = fchtak(fname,*lgname);
- if (ptname == NULL) goto out1;
-
- buf = (struct _stat *) malloc(sizeof (struct _stat));
- if (buf == NULL) goto out2;
-
- istat = stat(ptname, buf);
-
- if (!istat) {
- info[0] = (int) buf->st_dev;
- info[1] = (int) buf->st_ino;
- info[2] = (int) buf->st_mode;
- info[3] = (int) buf->st_nlink;
- info[4] = (int) buf->st_uid;
- info[5] = (int) buf->st_gid;
- info[6] = (int) buf->st_size;
- info[7] = (int) buf->st_atime;
- info[8] = (int) buf->st_mtime;
- info[9] = (int) buf->st_ctime;
- info[10] = 0;
- info[11] = 0;
- *slate++ = (buf->st_mode & S_IFMT) ^ S_IFREG;
- *slate++ = 0;
- *slate++ = (buf->st_mode & S_IFMT) ^ S_IFDIR;
- };
-
- free(buf);
-out2: free(ptname);
-out1: return istat;
-
-}
-/*> END <----------------------------------------------------------*/
diff --git a/src/packlib/kernlib/kerngen/ccgen/wntgs/sleepf.c b/src/packlib/kernlib/kerngen/ccgen/wntgs/sleepf.c
deleted file mode 100644
index 33b00ba..0000000
--- a/src/packlib/kernlib/kerngen/ccgen/wntgs/sleepf.c
+++ /dev/null
@@ -1,42 +0,0 @@
-/*
- * $Id: sleepf.c,v 1.1 1997/02/04 17:35:06 mclareni Exp $
- *
- * $Log: sleepf.c,v $
- * Revision 1.1 1997/02/04 17:35:06 mclareni
- * Merge Winnt and 97a versions
- *
- * Revision 1.1.1.1 1996/02/15 17:49:31 mclareni
- * Kernlib
- *
- */
-/*> ROUTINE SLEEPF (NSECS)
- CERN PROGLIB# Z265 SLEEPF .VERSION KERNFOR 4.26 910313
- ORIG. 22/02/91, JZ
- Fortran interface routine to sleep
-*/
-#include <windows.h>
-#include "kerngen/fortranc.h"
-
-#if defined(CERNLIB_QX_SC)
-void type_of_call sleepf_(seconds)
-#endif
-#if defined(CERNLIB_QXNO_SC)
-void type_of_call sleepf(seconds)
-#endif
-#if defined(CERNLIB_QXCAPT)
-void type_of_call SLEEPF(seconds)
-#endif
- int *seconds;
-{
- void sleep();
- int secu;
-
- secu = *seconds;
-#ifdef WIN32
- Sleep(secu*1000);
-#else
- sleep(secu);
-#endif
- return;
-}
-/*> END <----------------------------------------------------------*/
diff --git a/src/packlib/kernlib/kerngen/ccgen/wntgs/timel.c b/src/packlib/kernlib/kerngen/ccgen/wntgs/timel.c
deleted file mode 100644
index 918f081..0000000
--- a/src/packlib/kernlib/kerngen/ccgen/wntgs/timel.c
+++ /dev/null
@@ -1,193 +0,0 @@
-/*> ROUTINE TIMEL
- CERN PROGLIB# Z007 TIMEST .VERSION KERNFOR 4.38 931108
- ORIG. 01/03/85 FCA, mod 03/11/93 GF
- Version for Windows NT/Windows 95 by Valery Fine 30/05/96 (fine at vxcern.cern.ch)
-*/
-#include <windows.h>
-#include <sys\types.h>
-
-#ifndef gTicks
-# define gTicks 1.0e-7;
-#endif
-
-#define time_t double
-
-static float timlim;
-static time_t timstart, timlast;
-static HANDLE hProcess;
-
-
-static int tml_init = 1;
-double deftim = 999.;
-
-#if defined(CERNLIB_QXCAPT)
-#define timest type_of_call TIMEST
-#define timex type_of_call TIMEX
-#define timed type_of_call TIMED
-#define timel type_of_call TIMEL
-#elif defined(CERNLIB_QX_SC)
-#define timest type_of_call timest_
-#define timex type_of_call timex_
-#define timed type_of_call timed_
-#define timel type_of_call timel_
-#endif
-
-
-//______________________________________________________________________________
-double GetRealTime(){
- union {FILETIME ftFileTime;
- __int64 ftInt64;
- } ftRealTime; // time the process has spent in kernel mode
- SYSTEMTIME st;
- GetSystemTime(&st);
- SystemTimeToFileTime(&st,&ftRealTime.ftFileTime);
- return (double)ftRealTime.ftInt64 * gTicks;
-}
-
-//______________________________________________________________________________
-double GetCPUTime(){
- OSVERSIONINFO OsVersionInfo;
-
-//*-* Value Platform
-//*-* ----------------------------------------------------
-//*-* VER_PLATFORM_WIN32s Win32s on Windows 3.1
-//*-* VER_PLATFORM_WIN32_WINDOWS Win32 on Windows 95
-//*-* VER_PLATFORM_WIN32_NT Windows NT
-//*-*
- OsVersionInfo.dwOSVersionInfoSize=sizeof(OSVERSIONINFO);
- GetVersionEx(&OsVersionInfo);
- if (OsVersionInfo.dwPlatformId == VER_PLATFORM_WIN32_NT) {
- DWORD ret;
- FILETIME ftCreate, // when the process was created
- ftExit; // when the process exited
-
- union {FILETIME ftFileTime;
- __int64 ftInt64;
- } ftKernel; // time the process has spent in kernel mode
-
- union {FILETIME ftFileTime;
- __int64 ftInt64;
- } ftUser; // time the process has spent in user mode
-
- ret = GetProcessTimes (hProcess, &ftCreate, &ftExit,
- &ftKernel.ftFileTime,
- &ftUser.ftFileTime);
- if (ret != TRUE){
- ret = GetLastError ();
- printf("GetCPUTime", " Error on GetProcessTimes 0x%lx", (int)ret);
- }
-
- /*
- * Process times are returned in a 64-bit structure, as the number of
- * 100 nanosecond ticks since 1 January 1601. User mode and kernel mode
- * times for this process are in separate 64-bit structures.
- * To convert to floating point seconds, we will:
- *
- * Convert sum of high 32-bit quantities to 64-bit int
- */
-
- return (double) (ftKernel.ftInt64 + ftUser.ftInt64) * gTicks;
- }
- else
- return GetRealTime();
-
-}
-
- /* local routine called by timst, and time_init */
-//_______________________________________________________________
-static void time_st(timl)
-float timl;
-{
- hProcess = GetCurrentProcess();
- timstart = GetCPUTime();
- timlast = timstart;
- timlim = timl;
- tml_init = 0;
- return;
-}
- /* local routine to start by default */
-//_______________________________________________________________
-static void time_init()
-{
- float maxtime;
- maxtime=deftim;
- time_st(maxtime);
- return;
-}
-
-//_______________________________________________________________
-void timest(timl)
-float *timl;
-{
- float maxtime;
-
- if (tml_init != 0) {
- maxtime = *timl;
- time_st(maxtime);
- }
- return;
-}
-//_______________________________________________________________
-void timex(tx)
-/*
-C
- CERN PROGLIB# Z007 TIMEX .VERSION KERNFOR 4.38 931108
-C
-*/
-float *tx;
-{
- time_t timnow;
- if (tml_init) {
- time_init();
- *tx = 0.;
- }
- else {
- timnow= GetCPUTime();
- *tx = (float) (timnow - timstart);
- }
- return;
-}
-
-//_______________________________________________________________
-void timed(td)
-/*
-C
- CERN PROGLIB# Z007 TIMED .VERSION KERNFOR 4.38 931108
-C
-*/
-float *td;
-{
- time_t timnow;
- if (tml_init) {
- time_init();
- *td = timlim;
- }
- else {
- timnow=GetCPUTime();
- *td = (float) (timnow - timlast);
- timlast = timnow;
- }
- return;
-}
-
-//_______________________________________________________________
-void timel(tl)
-/*
-C
- CERN PROGLIB# Z007 TIMEL .VERSION KERNFOR 4.38 931108
-C
-*/
-float *tl;
-{
- time_t timnow;
- if (tml_init) {
- time_init();
- *tl = timlim;
- }
- else {
- timnow= GetCPUTime();
- *tl = timlim - (float) (timnow - timstart);
- }
- return;
-}
-/*> END <----------------------------------------------------------*/
diff --git a/src/packlib/kernlib/kerngen/ccgen/wntgs/tmproi.c b/src/packlib/kernlib/kerngen/ccgen/wntgs/tmproi.c
deleted file mode 100644
index 6459434..0000000
--- a/src/packlib/kernlib/kerngen/ccgen/wntgs/tmproi.c
+++ /dev/null
@@ -1,40 +0,0 @@
-/*
-* $Id: tmproi.c,v 1.1 1997/02/04 17:35:07 mclareni Exp $
-*
-* $Log: tmproi.c,v $
-* Revision 1.1 1997/02/04 17:35:07 mclareni
-* Merge Winnt and 97a versions
-*
-* Revision 1.1.1.1 1996/02/15 17:49:32 mclareni
-* Kernlib
-*
-*/
-/*> ROUTINE TMPROI
- CERN PROGLIB# TMPROI .VERSION KERNFOR 4.36 930602
- ORIG. 30/05/91, JZ
- Fortran interface routine to print a prompt string
- CALL TMPRO (TEXT)
-*/
-#ifdef WIN32
-#include <io.h>
-#endif
-#include <stdio.h>
-#include "kerngen/fortranc.h"
-
-#if defined(CERNLIB_QX_SC)
-void type_of_call tmproi_(ftext, lgtext)
-#endif
-#if defined(CERNLIB_QXNO_SC)
-void type_of_call tmproi(ftext, lgtext)
-#endif
-#if defined(CERNLIB_QXCAPT)
-void type_of_call TMPROI(ftext, lgtext)
-#endif
- char *ftext;
- int *lgtext;
-{
- write (1, ftext, *lgtext);
- return;
-}
-/*> END <----------------------------------------------------------*/
-
diff --git a/src/packlib/kernlib/kerngen/ccgencf/Imakefile b/src/packlib/kernlib/kerngen/ccgencf/Imakefile
deleted file mode 100644
index 86c83d0..0000000
--- a/src/packlib/kernlib/kerngen/ccgencf/Imakefile
+++ /dev/null
@@ -1,15 +0,0 @@
-SRCS_F= cfopen.F cfstat.F
-
-SRCS_C= cfclos.c cfget.c cfopei.c cfperm.c cfput.c cfrew.c cfseek.c \ @@\
- cfsize.c cfstati.c cftell.c
-
-#if defined(CERNLIB_WINNT) && defined(CERNLIB_MSSTDCALL)
-SRCS_C += cfputdummy.c cfgetdummy.c
-#endif
-
-SubdirLibraryTarget(NullParameter,NullParameter)
-
-#ifdef CERNLIB_SHIFT
-CERNDEFINES:= $(CERNDEFINES) -DCERNLIB_SHIFT
-EXTRA_INCLUDES:= $(EXTRA_INCLUDES) -I/usr/local/include
-#endif
diff --git a/src/packlib/kernlib/kerngen/ccgencf/cfclos.c b/src/packlib/kernlib/kerngen/ccgencf/cfclos.c
deleted file mode 100644
index aaee08b..0000000
--- a/src/packlib/kernlib/kerngen/ccgencf/cfclos.c
+++ /dev/null
@@ -1,63 +0,0 @@
-/*
- * $Id: cfclos.c,v 1.3 1999/05/11 16:02:10 mclareni Exp $
- *
- * $Log: cfclos.c,v $
- * Revision 1.3 1999/05/11 16:02:10 mclareni
- * Modifications for RFIO on Windows NT, behind cpp flags for NT and SHIFT.
- * Other platforms should not be affected. They should probably have gone into
- * the shift software.
- *
- * Revision 1.2 1997/02/04 17:35:10 mclareni
- * Merge Winnt and 97a versions
- *
- * Revision 1.1.1.1.2.1 1997/01/21 11:30:09 mclareni
- * All mods for Winnt 96a on winnt branch
- *
- * Revision 1.1.1.1 1996/02/15 17:49:35 mclareni
- * Kernlib
- *
- */
-#include "kerngen/pilot.h"
-#include "kerngen/fortranc.h"
-
-/*> ROUTINE CFCLOS
- CERN PROGLIB# Z310 CFCLOS .VERSION KERNFOR 4.29 910718
- ORIG. 12/01/91, JZ
- CALL CFCLOS (LUNDES,MEDIUM)
- close the file :
- LUNDES file descriptor
- MEDIUM = 0,1,2,3 : primary disk/tape, secondary disk/tape
-*/
-#include "kerngen/cf_clos.h"
-#include "kerngen/cf_xaft.h"
-
-#if defined(CERNLIB_PROJSHIFT) && defined(_WIN32)
-#include <winsock2.h>
- extern int no_of_opens;
-#endif
-
-#if defined(CERNLIB_QX_SC)
-void type_of_call cfclos_(lundes, medium)
-#endif
-#if defined(CERNLIB_QXNO_SC)
-void type_of_call cfclos(lundes, medium)
-#endif
-#if defined(CERNLIB_QXCAPT)
-void type_of_call CFCLOS(lundes, medium)
-#endif
- int *lundes, *medium;
-{
- int fildes;
-
- fildes = *lundes;
- close (fildes);
-#if defined(CERNLIB_PROJSHIFT) && defined(_WIN32)
-/* extern int no_of_opens; */
- if (no_of_opens-- == 0 )WSACleanup();
-#endif
- return;
-}
-/*> END <----------------------------------------------------------*/
-#ifdef CERNLIB_TCGEN_CFCLOS
-#undef CERNLIB_TCGEN_CFCLOS
-#endif
diff --git a/src/packlib/kernlib/kerngen/ccgencf/cfget.c b/src/packlib/kernlib/kerngen/ccgencf/cfget.c
deleted file mode 100644
index 2735303..0000000
--- a/src/packlib/kernlib/kerngen/ccgencf/cfget.c
+++ /dev/null
@@ -1,99 +0,0 @@
-/*
- * $Id: cfget.c,v 1.5 1997/10/23 16:33:18 mclareni Exp $
- *
- * $Log: cfget.c,v $
- * Revision 1.5 1997/10/23 16:33:18 mclareni
- * NT mods
- *
- * Revision 1.4 1997/09/02 14:26:44 mclareni
- * WINNT correction
- *
- * Revision 1.3 1997/02/04 17:35:10 mclareni
- * Merge Winnt and 97a versions
- *
- * Revision 1.2 1997/01/15 16:25:31 cernlib
- * fix from F.Hemmer to return rfio return code
- *
- * Revision 1.1.1.1.2.1 1997/01/21 11:30:09 mclareni
- * All mods for Winnt 96a on winnt branch
- *
- * Revision 1.1.1.1 1996/02/15 17:49:36 mclareni
- * Kernlib
- *
- */
-#include "kerngen/pilot.h"
-#include "kerngen/fortranc.h"
-
-#if defined(CERNLIB_QMOS9)
-#include "os9gs/cfget.c"
-#else
-/*> ROUTINE CFGET
- CERN PROGLIB# Z310 CFGET .VERSION KERNFOR 4.29 910718
- ORIG. 12/01/91, JZ
- CALL CFGET (LUNDES, MEDIUM, NWREC, NWTAK, MBUF, ISTAT)
- read from the file :
- LUNDES file descriptor
- MEDIUM = 0,1,2,3 : primary disk/tape, secondary disk/tape
- NWREC number of words record size
- *NWTAK* number of words to be read / actually read
- *MBUF vector to be read into
- *ISTAT status, =zero if success
-*/
-#include "kerngen/cf_reaw.h"
-#ifndef WIN32
-# include <errno.h>
-#else
-# include <stdlib.h>
-#endif
-#include "kerngen/cf_xaft.h"
-#include "kerngen/wordsizc.h"
-#if defined(CERNLIB_QX_SC)
-void type_of_call cfget_(lundes, medium, nwrec, nwtak, mbuf, stat)
-#endif
-#if defined(CERNLIB_QXNO_SC)
-void type_of_call cfget(lundes, medium, nwrec, nwtak, mbuf, stat)
-#endif
-#if defined(CERNLIB_QXCAPT)
-void type_of_call CFGET(lundes, medium, nwrec, nwtak, mbuf,
-# ifdef CERNLIB_CFGET_CHARACTER
- lmbuf,
-# endif
- stat)
-# ifdef CERNLIB_CFGET_CHARACTER
- int lmbuf;
-# endif
-#endif
- char *mbuf;
- int *lundes, *medium, *nwrec, *nwtak, *stat;
-{
- int fildes;
- int nbdn, nbdo;
-
- *stat = 0;
- if (*nwtak <= 0) return;
-
-/* read the file */
-
- fildes = *lundes;
- nbdo = *nwrec * NBYTPW;
- nbdn = read (fildes, mbuf, nbdo);
- if (nbdn == 0) goto heof;
- if (nbdn < 0) goto herror;
-retn: *nwtak = (nbdn - 1) / NBYTPW + 1;
- return;
-
-/* Handle exceptions */
-
-heof: *stat = -1;
- return;
-
-#if defined(CERNLIB_PROJSHIFT)
-herror: *stat = (serrno ? serrno : (rfio_errno ? rfio_errno : errno));
-#else
-herror: *stat = errno;
-#endif
- perror (" error in CFGET");
- return;
-}
-/*> END <----------------------------------------------------------*/
-#endif
diff --git a/src/packlib/kernlib/kerngen/ccgencf/cfgetdummy.c b/src/packlib/kernlib/kerngen/ccgencf/cfgetdummy.c
deleted file mode 100644
index e8671c6..0000000
--- a/src/packlib/kernlib/kerngen/ccgencf/cfgetdummy.c
+++ /dev/null
@@ -1,9 +0,0 @@
-#ifndef CERNLIB_CFGET_CHARACTER
-#define CERNLIB_CFGET_CHARACTER
-#endif
-
-#include "cfget.c"
-
-#ifdef CERNLIB_CFGET_CHARACTER
-#undef CERNLIB_CFGET_CHARACTER
-#endif
diff --git a/src/packlib/kernlib/kerngen/ccgencf/cfopei.c b/src/packlib/kernlib/kerngen/ccgencf/cfopei.c
deleted file mode 100644
index e554034..0000000
--- a/src/packlib/kernlib/kerngen/ccgencf/cfopei.c
+++ /dev/null
@@ -1,177 +0,0 @@
-/*
- * $Id: cfopei.c,v 1.5 1999/05/11 16:02:11 mclareni Exp $
- *
- * $Log: cfopei.c,v $
- * Revision 1.5 1999/05/11 16:02:11 mclareni
- * Modifications for RFIO on Windows NT, behind cpp flags for NT and SHIFT.
- * Other platforms should not be affected. They should probably have gone into
- * the shift software.
- *
- * Revision 1.4 1997/09/02 14:26:46 mclareni
- * WINNT correction
- *
- * Revision 1.3 1997/02/04 17:35:11 mclareni
- * Merge Winnt and 97a versions
- *
- * Revision 1.2 1997/01/15 16:25:32 cernlib
- * fix from F.Hemmer to return rfio return code
- *
- * Revision 1.1.1.1.2.1 1997/01/21 11:30:10 mclareni
- * All mods for Winnt 96a on winnt branch
- *
- * Revision 1.1.1.1 1996/02/15 17:49:36 mclareni
- * Kernlib
- *
- */
-#include "kerngen/pilot.h"
-#include "kerngen/fortranc.h"
-
-#if defined(CERNLIB_QMOS9)
-#include "os9gs/cfopei.c"
-#else
-/*> ROUTINE CFOPEI
- CERN PROGLIB# Z310 CFOPEI .VERSION KERNFOR 4.38 931108
- ORIG. 12/01/91, JZ
- CALL CFOPEN (LUNDES, MEDIUM, NWREC, MODE, NBUF, TEXT, ISTAT)
- open a file :
- *LUNDES file descriptor
- MEDIUM = 0,1,2,3 : primary disk/tape, secondary disk/tape
- NWREC record length in number of words
- MODE string selecting IO mode
- = 'r ', 'w ', 'a ', 'r+ ', ...
- NBUF number of buffers to be allocated, (not used)
- TEXT name of the file
- *ISTAT status, =zero if success
-*/
-#include "kerngen/cf_open.h"
-#include <errno.h>
-#include "kerngen/cf_xaft.h"
-#include "kerngen/fortchar.h"
-#include "kerngen/wordsizc.h"
-#if defined(CERNLIB_PROJSHIFT) && defined(_WIN32)
-#include <winsock2.h>
- int no_of_opens = 0;
-#endif
- int cfopen_perm = 0;
-#if defined(CERNLIB_QX_SC)
-void type_of_call cfopei_(lundes,medium,nwrec,mode,nbuf,ftext,stat,lgtx)
-#endif
-#if defined(CERNLIB_QXNO_SC)
-void type_of_call cfopei(lundes,medium,nwrec,mode,nbuf,ftext,stat,lgtx)
-#endif
-#if defined(CERNLIB_QXCAPT)
-# ifndef CERNLIB_MSSTDCALL
- void type_of_call CFOPEI(lundes,medium,nwrec,mode,nbuf,ftext,stat,lgtx)
-# else
- void type_of_call CFOPEI(lundes,medium,nwrec,mode,nbuf,ftext,len_ftext,stat,lgtx)
- int len_ftext;
-# endif
-#endif
-#if defined(CERNLIB_QMCRY)
- _fcd ftext;
-#endif
-#if !defined(CERNLIB_QMCRY)
- char *ftext;
-#endif
-
- int *lundes, *medium, *nwrec, *nbuf, *stat, *lgtx;
- int *mode;
-{
-#if defined(CERNLIB_PROJSHIFT) && defined(_WIN32)
- WSADATA wsadata;
-#endif
- char *pttext, *fchtak();
- int flags;
- int fildes;
- int perm;
-
- *lundes = 0;
- *stat = -1;
-
- perm = cfopen_perm;
- cfopen_perm = 0;
-
-/* construct flags :
- mode[0] = 0 r 1 w 2 a
- mode[1] = 1 +
-*/
-/* flags for disk */
-
- if (*medium == 1) goto fltp;
- if (*medium == 3) goto fltp;
-
- if (mode[0] == 0)
- {if (mode[1] == 0)
- flags = O_RDONLY;
- else
- flags = O_RDWR;}
-
- else if (mode[0] == 1)
- {if (mode[1] == 0)
- flags = O_WRONLY | O_CREAT | O_TRUNC;
- else
- flags = O_RDWR | O_CREAT | O_TRUNC;}
-
- else if (mode[0] == 2)
- {if (mode[1] == 0)
- flags = O_WRONLY | O_CREAT | O_APPEND;
- else
- flags = O_RDWR | O_CREAT | O_APPEND;}
- goto act;
-
-/* flags for tape */
-
-fltp: if (mode[0] == 0)
- {if (mode[1] == 0)
- flags = O_RDONLY;
- else
- flags = O_RDWR;}
-
- else if (mode[0] == 1)
- {if (mode[1] == 0)
- flags = O_WRONLY;
- else
- flags = O_RDWR;}
-
- else if (mode[0] == 2) return;
-
-/* open the file */
-
-act: pttext = fchtak(ftext,*lgtx);
- if (pttext == 0) return;
-
- if (perm == 0) perm = 0644;
-
-#if defined(CERNLIB_PROJSHIFT) && defined(_WIN32)
- if (no_of_opens > 0 )
- no_of_opens++;
- else {
- if (WSAStartup (MAKEWORD (2, 0), &wsadata)) {
- fprintf (stderr, "WSAStartup unsuccessful\n");
- return;
- }
- no_of_opens++;
- }
-#endif
-#if defined(CERNLIB_QMDOS) || defined(CERNLIB_WINNT)
- fildes = open (pttext, flags | O_BINARY, perm);
-#else
- fildes = open (pttext, flags, perm);
-#endif
- if (fildes < 0) goto errm;
- *lundes = fildes;
- *stat = 0;
- goto done;
-
-#if defined(CERNLIB_PROJSHIFT)
-errm: *stat = (serrno ? serrno : (rfio_errno ? rfio_errno : errno));
-#else
-errm: *stat = errno;
-#endif
- perror (" error in CFOPEN");
-
-done: free(pttext);
- return;
-}
-/*> END <----------------------------------------------------------*/
-#endif
diff --git a/src/packlib/kernlib/kerngen/ccgencf/cfopen.F b/src/packlib/kernlib/kerngen/ccgencf/cfopen.F
deleted file mode 100644
index ca983c1..0000000
--- a/src/packlib/kernlib/kerngen/ccgencf/cfopen.F
+++ /dev/null
@@ -1,53 +0,0 @@
-*
-* $Id: cfopen.F,v 1.1.1.1 1996/02/15 17:49:36 mclareni Exp $
-*
-* $Log: cfopen.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:36 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE CFOPEN (LUNDES, MEDIUM, NWREC, MODE, NBUF, NAME, ISTAT)
-C
-C CERN PROGLIB# Z310 CFOPEN .VERSION KERNFOR 4.27 910426
-C ORIG. 12/01/91, JZ
-C
- DIMENSION LUNDES(9), ISTAT(9)
- CHARACTER MODE*(*), NAME*(*)
- DIMENSION NVMODE(4)
- CHARACTER CHUSE*4
-
-
- LGN = LNBLNK (NAME)
-
- CHUSE = MODE
- CALL CUTOL (CHUSE)
- CALL VZERO (NVMODE,4)
-
- IF (INDEX(CHUSE,'a').NE.0) NVMODE(1) = 2
- IF (INDEX(CHUSE,'w').NE.0) THEN
- IF (NVMODE(1).NE.0) GO TO 91
- NVMODE(1) = 1
- ENDIF
- IF (INDEX(CHUSE,'r').NE.0) THEN
- IF (NVMODE(1).NE.0) GO TO 91
- ENDIF
-
- IF (INDEX(CHUSE,'+').NE.0) NVMODE(2) = 1
- IF (INDEX(CHUSE,'l').NE.0) NVMODE(3) = 1
-
-#if !defined(CERNLIB_QMVAX)
- CALL CFOPEI (LUNDES,MEDIUM,NWREC,NVMODE,NBUF,NAME,ISTAT,LGN)
-#endif
-#if defined(CERNLIB_QMVAX)
- CALL CFOPEI (LUNDES,MEDIUM,NWREC,NVMODE,NBUF,%REF(NAME),ISTAT,LGN)
-#endif
- RETURN
-
- 91 LUNDES(1) = 0
- ISTAT(1) = -1
- RETURN
- END
-#ifdef CERNLIB_TCGEN_CFOPEN
-#undef CERNLIB_TCGEN_CFOPEN
-#endif
diff --git a/src/packlib/kernlib/kerngen/ccgencf/cfperm.c b/src/packlib/kernlib/kerngen/ccgencf/cfperm.c
deleted file mode 100644
index 0798606..0000000
--- a/src/packlib/kernlib/kerngen/ccgencf/cfperm.c
+++ /dev/null
@@ -1,43 +0,0 @@
-/*
- * $Id: cfperm.c,v 1.2 1997/02/04 17:35:11 mclareni Exp $
- *
- * $Log: cfperm.c,v $
- * Revision 1.2 1997/02/04 17:35:11 mclareni
- * Merge Winnt and 97a versions
- *
- * Revision 1.1.1.1.2.1 1997/01/21 11:30:10 mclareni
- * All mods for Winnt 96a on winnt branch
- *
- * Revision 1.1.1.1 1996/02/15 17:49:36 mclareni
- * Kernlib
- *
- */
-#include "kerngen/pilot.h"
-#include "kerngen/fortranc.h"
-
-/*> ROUTINE CFPERM
- CERN PROGLIB# Z311 CFPERM .VERSION KERNFOR 4.34 930114
- ORIG. 03/06/92, JZ
- CALL CFPERM (NPERM)
- set permission mask NPERM to be used in next call to CFOPEN
-*/
-#if defined(CERNLIB_QX_SC)
-void type_of_call cfperm_(nperm)
-#endif
-#if defined(CERNLIB_QXNO_SC)
-void type_of_call cfperm(nperm)
-#endif
-#if defined(CERNLIB_QXCAPT)
-void type_of_call CFPERM(nperm)
-#endif
- int *nperm;
-{
- extern int cfopen_perm;
-
- cfopen_perm = *nperm & 0777;
- return;
-}
-/*> END <----------------------------------------------------------*/
-#ifdef CERNLIB_TCGEN_CFPERM
-#undef CERNLIB_TCGEN_CFPERM
-#endif
diff --git a/src/packlib/kernlib/kerngen/ccgencf/cfput.c b/src/packlib/kernlib/kerngen/ccgencf/cfput.c
deleted file mode 100644
index 8a09308..0000000
--- a/src/packlib/kernlib/kerngen/ccgencf/cfput.c
+++ /dev/null
@@ -1,83 +0,0 @@
-/*
- * $Id: cfput.c,v 1.4 1997/10/23 16:33:19 mclareni Exp $
- *
- * $Log: cfput.c,v $
- * Revision 1.4 1997/10/23 16:33:19 mclareni
- * NT mods
- *
- * Revision 1.3 1997/02/04 17:35:12 mclareni
- * Merge Winnt and 97a versions
- *
- * Revision 1.2 1997/01/15 16:25:33 cernlib
- * fix from F.Hemmer to return rfio return code
- *
- * Revision 1.1.1.1.2.1 1997/01/21 11:30:11 mclareni
- * All mods for Winnt 96a on winnt branch
- *
- * Revision 1.1.1.1 1996/02/15 17:49:36 mclareni
- * Kernlib
- *
- */
-#include "kerngen/pilot.h"
-#include "kerngen/fortranc.h"
-
-/*> ROUTINE CFPUT
- CERN PROGLIB# Z310 CFPUT .VERSION KERNFOR 4.29 910718
- ORIG. 12/01/91, JZ
- CALL CFPUT (LUNDES, MEDIUM, NWREC, MBUF, ISTAT)
- write to the file :
- LUNDES file descriptor
- MEDIUM = 0,1,2,3 : primary disk/tape, secondary disk/tape
- NWREC record size, number of words to be written
- MBUF vector to be written
- *ISTAT status, =zero if success
-*/
-#include "kerngen/cf_reaw.h"
-#include <errno.h>
-#include "kerngen/cf_xaft.h"
-#include "kerngen/wordsizc.h"
-#if defined(CERNLIB_QX_SC)
-void type_of_call cfput_(lundes, medium, nwrec, mbuf, stat)
-#endif
-#if defined(CERNLIB_QXNO_SC)
-void type_of_call cfput(lundes, medium, nwrec, mbuf, stat)
-#endif
-#if defined(CERNLIB_QXCAPT)
-void type_of_call CFPUT(lundes, medium, nwrec, mbuf,
-# ifdef CERNLIB_CFPUT_CHARACTER
- lmbuf,
-# endif
- stat)
-# ifdef CERNLIB_CFPUT_CHARACTER
- int lmbuf;
-# endif
-#endif
- char *mbuf;
- int *lundes, *medium, *nwrec, *stat;
-{
- int fildes;
- int nbdn, nbdo;
-
- *stat = 0;
- if (*nwrec <= 0) return;
-
-/* write the file */
-
- fildes = *lundes;
- nbdo = *nwrec * NBYTPW;
- nbdn = write (fildes, mbuf, nbdo);
- if (nbdn < 0) goto trouble;
- return;
-
-#if defined(CERNLIB_PROJSHIFT)
-trouble: *stat = (serrno ? serrno : (rfio_errno ? rfio_errno : errno));
-#else
-trouble: *stat = errno;
-#endif
- perror (" error in CFPUT");
- return;
-}
-/*> END <----------------------------------------------------------*/
-#ifdef CERNLIB_TCGEN_CFPUT
-#undef CERNLIB_TCGEN_CFPUT
-#endif
diff --git a/src/packlib/kernlib/kerngen/ccgencf/cfputdummy.c b/src/packlib/kernlib/kerngen/ccgencf/cfputdummy.c
deleted file mode 100644
index 06abe46..0000000
--- a/src/packlib/kernlib/kerngen/ccgencf/cfputdummy.c
+++ /dev/null
@@ -1,9 +0,0 @@
-#ifndef CERNLIB_CFPUT_CHARACTER
-#define CERNLIB_CFPUT_CHARACTER
-#endif
-
-#include "cfput.c"
-
-#ifdef CERNLIB_CFPUT_CHARACTER
-#undef CERNLIB_CFPUT_CHARACTER
-#endif
diff --git a/src/packlib/kernlib/kerngen/ccgencf/cfrew.c b/src/packlib/kernlib/kerngen/ccgencf/cfrew.c
deleted file mode 100644
index 82f84a3..0000000
--- a/src/packlib/kernlib/kerngen/ccgencf/cfrew.c
+++ /dev/null
@@ -1,54 +0,0 @@
-/*
- * $Id: cfrew.c,v 1.2 1997/02/04 17:35:12 mclareni Exp $
- *
- * $Log: cfrew.c,v $
- * Revision 1.2 1997/02/04 17:35:12 mclareni
- * Merge Winnt and 97a versions
- *
- * Revision 1.1.1.1.2.1 1997/01/21 11:30:11 mclareni
- * All mods for Winnt 96a on winnt branch
- *
- * Revision 1.1.1.1 1996/02/15 17:49:36 mclareni
- * Kernlib
- *
- */
-#include "kerngen/pilot.h"
-#include "kerngen/fortranc.h"
-
-/*> ROUTINE CFREW
- CERN PROGLIB# Z310 CFREW .VERSION KERNFOR 4.29 910718
- ORIG. 12/01/91, JZ
- CALL CFREW (LUNDES,MEDIUM)
- rewind the file :
- LUNDES file descriptor
- MEDIUM = 0,1,2,3 : primary disk/tape, secondary disk/tape
-*/
-#include "kerngen/cf_seek.h"
-#include "kerngen/cf_xaft.h"
-
-#if defined(CERNLIB_QX_SC)
-void type_of_call cfrew_(lundes, medium)
-#endif
-#if defined(CERNLIB_QXNO_SC)
-void type_of_call cfrew(lundes, medium)
-#endif
-#if defined(CERNLIB_QXCAPT)
-void type_of_call CFREW(lundes, medium)
-#endif
- int *lundes, *medium;
-{
- int fildes;
- int newpos;
-
- fildes = *lundes;
- newpos = lseek (fildes, 0, 0);
- if (newpos < 0) goto trouble;
- return;
-
-trouble: perror (" error in CFREW");
- return;
-}
-/*> END <----------------------------------------------------------*/
-#ifdef CERNLIB_TCGEN_CFREW
-#undef CERNLIB_TCGEN_CFREW
-#endif
diff --git a/src/packlib/kernlib/kerngen/ccgencf/cfseek.c b/src/packlib/kernlib/kerngen/ccgencf/cfseek.c
deleted file mode 100644
index 3b40463..0000000
--- a/src/packlib/kernlib/kerngen/ccgencf/cfseek.c
+++ /dev/null
@@ -1,63 +0,0 @@
-/*
- * $Id: cfseek.c,v 1.2 1997/02/04 17:35:13 mclareni Exp $
- *
- * $Log: cfseek.c,v $
- * Revision 1.2 1997/02/04 17:35:13 mclareni
- * Merge Winnt and 97a versions
- *
- * Revision 1.1.1.1.2.1 1997/01/21 11:30:12 mclareni
- * All mods for Winnt 96a on winnt branch
- *
- * Revision 1.1.1.1 1996/02/15 17:49:36 mclareni
- * Kernlib
- *
- */
-#include "kerngen/pilot.h"
-/*> ROUTINE CFSEEK
- CERN PROGLIB# Z310 CFSEEK .VERSION KERNFOR 4.29 910718
- ORIG. 12/01/91, JZ
- CALL CFSEEK (LUNDES, MEDIUM, NWREC, JCREC, ISTAT)
- reposition the file :
- LUNDES file descriptor
- MEDIUM = 0,1,2,3 : primary disk/tape, secondary disk/tape
- NWREC number of words per record
- JCREC number of records before current
- *ISTAT status, =zero if success
-*/
-#include "kerngen/cf_seek.h"
-#include "kerngen/cf_xaft.h"
-#include "kerngen/wordsizc.h"
-#include "kerngen/fortranc.h"
-
-#if defined(CERNLIB_QX_SC)
-void type_of_call cfseek_(lundes, medium, nwrec, jcrec, stat)
-#endif
-#if defined(CERNLIB_QXNO_SC)
-void type_of_call cfseek(lundes, medium, nwrec, jcrec, stat)
-#endif
-#if defined(CERNLIB_QXCAPT)
-void type_of_call CFSEEK(lundes, medium, nwrec, jcrec, stat)
-#endif
- int *lundes, *medium, *nwrec, *jcrec, *stat;
-{
- int fildes;
- int nbdo;
- int isw;
-
-/* position the file */
-
- fildes = *lundes;
- nbdo = *jcrec * *nwrec * NBYTPW;
- isw = lseek (fildes, nbdo, 0);
- if (isw < 0) goto trouble;
- *stat = 0;
- return;
-
-trouble: *stat = -1;
- perror (" error in CFSEEK");
- return;
-}
-/*> END <----------------------------------------------------------*/
-#ifdef CERNLIB_TCGEN_CFSEEK
-#undef CERNLIB_TCGEN_CFSEEK
-#endif
diff --git a/src/packlib/kernlib/kerngen/ccgencf/cfsize.c b/src/packlib/kernlib/kerngen/ccgencf/cfsize.c
deleted file mode 100644
index ef3a47d..0000000
--- a/src/packlib/kernlib/kerngen/ccgencf/cfsize.c
+++ /dev/null
@@ -1,67 +0,0 @@
-/*
- * $Id: cfsize.c,v 1.2 1997/02/04 17:35:13 mclareni Exp $
- *
- * $Log: cfsize.c,v $
- * Revision 1.2 1997/02/04 17:35:13 mclareni
- * Merge Winnt and 97a versions
- *
- * Revision 1.1.1.1.2.1 1997/01/21 11:30:12 mclareni
- * All mods for Winnt 96a on winnt branch
- *
- * Revision 1.1.1.1 1996/02/15 17:49:36 mclareni
- * Kernlib
- *
- */
-#include "kerngen/pilot.h"
-/*> ROUTINE CFSIZE
- CERN PROGLIB# Z310 CFSIZE .VERSION KERNFOR 4.29 910718
- ORIG. 12/01/91, JZ
- CALL CFSIZE (LUNDES, MEDIUM, NWREC, JRECL, ISTAT)
- get the position of the end-of-file and position to it :
- LUNDES file descriptor
- MEDIUM = 0,1,2,3 : primary disk/tape, secondary disk/tape
- NWREC number of words per record
- *JRECL number of records before end-of-file
- *ISTAT status, =zero if success
-*/
-#include "kerngen/cf_seek.h"
-#include "kerngen/cf_xaft.h"
-#include "kerngen/wordsizc.h"
-#include "kerngen/fortranc.h"
-
-#if defined(CERNLIB_QX_SC)
-void type_of_call cfsize_(lundes, medium, nwrec, jrecl, stat)
-#endif
-#if defined(CERNLIB_QXNO_SC)
-void type_of_call cfsize(lundes, medium, nwrec, jrecl, stat)
-#endif
-#if defined(CERNLIB_QXCAPT)
-void type_of_call CFSIZE(lundes, medium, nwrec, jrecl, stat)
-#endif
- int *lundes, *medium, *nwrec, *jrecl, *stat;
-{
- int fildes;
- int nboff;
-
-/* position the file to the end */
-
- fildes = *lundes;
- nboff = lseek (fildes, 0, 2);
- if (nboff < 0) goto trouble;
-
-/* get position of the file */
-
- nboff = nboff / NBYTPW;
- nboff = nboff / *nwrec;
- *jrecl = nboff;
- *stat = 0;
- return;
-
-trouble: *stat = -1;
- perror (" error in CFSIZE");
- return;
-}
-/*> END <----------------------------------------------------------*/
-#ifdef CERNLIB_TCGEN_CFSIZE
-#undef CERNLIB_TCGEN_CFSIZE
-#endif
diff --git a/src/packlib/kernlib/kerngen/ccgencf/cfstat.F b/src/packlib/kernlib/kerngen/ccgencf/cfstat.F
deleted file mode 100644
index 4202660..0000000
--- a/src/packlib/kernlib/kerngen/ccgencf/cfstat.F
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: cfstat.F,v 1.3 1996/10/17 16:16:30 cernlib Exp $
-*
-* $Log: cfstat.F,v $
-* Revision 1.3 1996/10/17 16:16:30 cernlib
-* Correct type of cfstati to be integer
-*
-* Revision 1.2 1996/10/17 09:23:15 cernlib
-* add back in accidentally deleted declaration lines
-*
-* Revision 1.1 1996/10/16 12:57:34 cernlib
-* Add cfstat. cfstati is used by cfstat. This uses rfio_stat if CERNLIB_SHIFT
-* is set.
-*
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- INTEGER FUNCTION CFSTAT (NAME, INFO)
-C
-C CERN PROGLIB# Z310 CFSTAF
-C ORIG. 11-Oct-96; stolen from ccgen/statf.F; GF.
-C ORIG. 14/03/91, RDM
-C Fortran interface routine to stat
-C
-C NAME the name of the file of which information is required
-C INFO(12) buffer returning the information about "file"
-C
-C A succesfull call returns 0. A failed call returns -1.
-C
- CHARACTER*(*) NAME
- INTEGER INFO(12), CFSTATI
-
- LGN = LNBLNK (NAME)
-#if !defined(CERNLIB_QMVAX)
- CFSTAT = CFSTATI (NAME, INFO, LGN)
-#else
- CFSTAT = CFSTATI (%REF(NAME), INFO, LGN)
-#endif
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/ccgencf/cfstati.c b/src/packlib/kernlib/kerngen/ccgencf/cfstati.c
deleted file mode 100755
index 8263134..0000000
--- a/src/packlib/kernlib/kerngen/ccgencf/cfstati.c
+++ /dev/null
@@ -1,154 +0,0 @@
-/*
- * $Id: cfstati.c,v 1.7 2001/08/15 13:16:05 mclareni Exp $
- *
- * $Log: cfstati.c,v $
- * Revision 1.7 2001/08/15 13:16:05 mclareni
- * Clean up the calls to stat, mainly to get it to compile with Castor 1.3.3.0
- *
- * Revision 1.6 1999/05/11 16:02:12 mclareni
- * Modifications for RFIO on Windows NT, behind cpp flags for NT and SHIFT.
- * Other platforms should not be affected. They should probably have gone into
- * the shift software.
- *
- * Revision 1.5 1997/11/05 11:05:35 mclareni
- * Remove malloc and free, which caused optimisation problems on NT; should be faster on Unix too.
- *
- * Revision 1.4 1997/10/23 16:33:20 mclareni
- * NT mods
- *
- * Revision 1.3 1997/09/02 14:26:47 mclareni
- * WINNT correction
- *
- * Revision 1.2 1997/02/20 16:41:48 gunter
- * Mods for WNT; ie. transcribe the mods done to stati.c for WNT.
- *
- * Revision 1.1 1996/10/16 12:57:35 cernlib
- * Add cfstat. cfstati is used by cfstat. This uses rfio_stat if CERNLIB_SHIFT
- * is set.
- *
- * Kernlib
- *
- */
-
-#ifdef CERNLIB_WINNT
-/*#pragma optimize( "", off ) */
-#endif
-
-#include "kerngen/pilot.h"
-/*> ROUTINE STATI
- * CERN PROGLIB# Z310 CFSTATI
- * ORIG. stolen with mods from stati.c, 11-Oct-96; GF.
- * Routine used by cfstat; interface to stat or rfio_stat ( if shift software
- * is in use)
-*/
-#include <stdio.h>
-#include <stdlib.h>
-#if defined(CERNLIB_QMVAX)||defined(CERNLIB_QMOS9)
-#include <types.h>
-#include <stat.h>
-#endif
-#if (!defined(CERNLIB_QMVAX))&&(!defined(CERNLIB_QMOS9))
-#ifndef WIN32
-#include <sys/types.h>
-#include <sys/stat.h>
-
-#else
-# include <sys\types.h>
-# include <sys\stat.h>
-#endif
-#include "kerngen/fortchar.h"
-#include "kerngen/cf_xaft.h"
-#endif
-#include "kerngen/fortranc.h"
-
-#if defined(CERNLIB_PROJSHIFT) && defined(_WIN32)
-#include <winsock2.h>
- extern int no_of_opens;
-#endif
-
-#if defined(CERNLIB_QX_SC)
-int type_of_call cfstati_(fname, info, lgname)
-#endif
-#if defined(CERNLIB_QXNO_SC)
-int type_of_call cfstati(fname, info, lgname)
-#endif
-#if defined(CERNLIB_QXCAPT)
-#ifndef CERNLIB_MSSTDCALL
- int type_of_call CFSTATI(fname, info, lgname)
-#else
- int type_of_call CFSTATI(fname, lfname, info, lgname )
- int lfname;
-#endif
-#endif
-#if defined(CERNLIB_QMCRY)
- _fcd fname;
-#endif
-#if !defined(CERNLIB_QMCRY)
- char *fname;
-#endif
- int *lgname;
- int *info;
-{
-
-#if defined(CERNLIB_PROJSHIFT) && defined(_WIN32)
- WSADATA wsadata;
-#endif
-
- struct stat buf;
- char *ptname, *fchtak();
-
-#if defined(CERNLIB_PROJSHIFT)
- int istat=-1;
-#else
- int istat=-1, stat();
-#endif
-
- ptname = fchtak(fname,*lgname);
- if (ptname == NULL) return -1;
-
-
-#if defined(CERNLIB_PROJSHIFT) && defined(_WIN32)
-
-/* extern int no_of_opens;*/
- if (no_of_opens == 0 ) {
- if (WSAStartup (MAKEWORD (2, 0), &wsadata)) {
- fprintf (stderr, "WSAStartup unsuccessful\n");
- return -1;
- }
- }
-
-#endif
-
- istat = stat(ptname, &buf);
-
-
-
- if (!istat) {
- info[0] = (int) buf.st_dev;
- info[1] = (int) buf.st_ino;
- info[2] = (int) buf.st_mode;
- info[3] = (int) buf.st_nlink;
- info[4] = (int) buf.st_uid;
- info[5] = (int) buf.st_gid;
- info[6] = (int) buf.st_size;
- info[7] = (int) buf.st_atime;
- info[8] = (int) buf.st_mtime;
- info[9] = (int) buf.st_ctime;
-#if defined(CERNLIB_QMDOS)||defined(CERNLIB_QMVAX)||defined(CERNLIB_QMOS9) \
- ||defined(CERNLIB_WINNT)
- info[10] = 0;
- info[11] = 0;
-#else
- info[10] = (int) buf.st_blksize;
- info[11] = (int) buf.st_blocks;
-#endif
- };
-
- free(ptname);
-#if defined(CERNLIB_PROJSHIFT) && defined(_WIN32)
- if (no_of_opens == 0 )WSACleanup();
-#endif
- return istat;
-
-}
-/*> END <----------------------------------------------------------*/
diff --git a/src/packlib/kernlib/kerngen/ccgencf/cftell.c b/src/packlib/kernlib/kerngen/ccgencf/cftell.c
deleted file mode 100644
index a0e7cbf..0000000
--- a/src/packlib/kernlib/kerngen/ccgencf/cftell.c
+++ /dev/null
@@ -1,62 +0,0 @@
-/*
- * $Id: cftell.c,v 1.2 1997/02/04 17:35:14 mclareni Exp $
- *
- * $Log: cftell.c,v $
- * Revision 1.2 1997/02/04 17:35:14 mclareni
- * Merge Winnt and 97a versions
- *
- * Revision 1.1.1.1.2.1 1997/01/21 11:30:13 mclareni
- * All mods for Winnt 96a on winnt branch
- *
- * Revision 1.1.1.1 1996/02/15 17:49:36 mclareni
- * Kernlib
- *
- */
-#include "kerngen/pilot.h"
-/*> ROUTINE CFTELL
- CERN PROGLIB# Z310 CFTELL .VERSION KERNFOR 4.29 910718
- ORIG. 12/01/91, JZ
- CALL CFTELL (LUNDES, MEDIUM, NWREC, JCREC, ISTAT)
- get the current position of the file :
- LUNDES file descriptor
- MEDIUM = 0,1,2,3 : primary disk/tape, secondary disk/tape
- NWREC number of words per record
- *JCREC number of records before current
- *ISTAT status, =zero if success
-*/
-#include "kerngen/cf_seek.h"
-#include "kerngen/cf_xaft.h"
-#include "kerngen/wordsizc.h"
-#include "kerngen/fortranc.h"
-
-#if defined(CERNLIB_QX_SC)
-void type_of_call cftell_(lundes, medium, nwrec, jcrec, stat)
-#endif
-#if defined(CERNLIB_QXNO_SC)
-void type_of_call cftell(lundes, medium, nwrec, jcrec, stat)
-#endif
-#if defined(CERNLIB_QXCAPT)
-void type_of_call CFTELL(lundes, medium, nwrec, jcrec, stat)
-#endif
- int *lundes, *medium, *nwrec, *jcrec, *stat;
-{
- int fildes;
- int nboff;
-
-/* get position of the file */
-
- fildes = *lundes;
- nboff = lseek (fildes, 0, 1);
- if (nboff < 0) goto trouble;
- *jcrec = (nboff / NBYTPW) / *nwrec;
- *stat = 0;
- return;
-
-trouble: *stat = -1;
- perror (" error in CFTELL");
- return;
-}
-/*> END <----------------------------------------------------------*/
-#ifdef CERNLIB_TCGEN_CFTELL
-#undef CERNLIB_TCGEN_CFTELL
-#endif
diff --git a/src/packlib/kernlib/kerngen/ccgencf/os9gs/cfget.c b/src/packlib/kernlib/kerngen/ccgencf/os9gs/cfget.c
deleted file mode 100644
index 008dee1..0000000
--- a/src/packlib/kernlib/kerngen/ccgencf/os9gs/cfget.c
+++ /dev/null
@@ -1,55 +0,0 @@
-/*
- * $Id: cfget.c,v 1.1.1.1 1996/02/15 17:49:37 mclareni Exp $
- *
- * $Log: cfget.c,v $
- * Revision 1.1.1.1 1996/02/15 17:49:37 mclareni
- * Kernlib
- *
- */
-/*> ROUTINE CFGET
- CERN PROGLIB# Z310 CFGET .VERSION KERNOS9 1.01 940729
- ORIG. 12/01/91, JZ
- MOD. 29/07/94, MM (remove label retn: )
- CALL CFGET (LUNDES, MEDIUM, NWREC, NWTAK, MBUF, ISTAT)
- read from the file :
- LUNDES file descriptor
- MEDIUM = 0,1,2,3 : primary disk/tape, secondary disk/tape
- NWREC number of words record size
- *NWTAK* number of words to be read / actually read
- *MBUF vector to be read into
- *ISTAT status, =zero if success
-*/
-#include <stdio.h>
-#include <errno.h>
-#define NBYTPW 4 /* Number of bytes per word */
-
-void cfget_(lundes, medium, nwrec, nwtak, mbuf, stat)
- char *mbuf;
- int *lundes, *medium, *nwrec, *nwtak, *stat;
-{
- int fildes;
- int nbdn, nbdo;
-
- *stat = 0;
- if (*nwtak <= 0) return;
-
-/* read the file */
-
- fildes = *lundes;
- nbdo = *nwrec * NBYTPW;
- nbdn = read (fildes, mbuf, nbdo);
- if (nbdn == 0) goto heof;
- if (nbdn < 0) goto herror;
- *nwtak = (nbdn - 1) / NBYTPW + 1;
- return;
-
-/* Handle exceptions */
-
-heof: *stat = -1;
- return;
-
-herror: *stat = errno;
- perror (" error in CFGET");
- return;
-}
-/*> END <----------------------------------------------------------*/
diff --git a/src/packlib/kernlib/kerngen/ccgencf/os9gs/cfopei.c b/src/packlib/kernlib/kerngen/ccgencf/os9gs/cfopei.c
deleted file mode 100644
index 2670eab..0000000
--- a/src/packlib/kernlib/kerngen/ccgencf/os9gs/cfopei.c
+++ /dev/null
@@ -1,138 +0,0 @@
-/*
- * $Id: cfopei.c,v 1.1.1.1 1996/02/15 17:49:37 mclareni Exp $
- *
- * $Log: cfopei.c,v $
- * Revision 1.1.1.1 1996/02/15 17:49:37 mclareni
- * Kernlib
- *
- */
-/*> ROUTINE CFOPEI
- CERN PROGLIB# Z310 CFOPEI .VERSION KERNOS9 1.01 940801
- ORIG. 12/01/91, JZ
- CALL CFOPEN (LUNDES, MEDIUM, NWREC, MODE, NBUF, TEXT, ISTAT)
- open a file :
- *LUNDES file descriptor
- MEDIUM = 0,1,2,3 : primary disk/tape, secondary disk/tape
- NWREC record length in number of words
- MODE string selecting IO mode
- = 'r ', 'w ', 'a ', 'r+ ', ...
- NBUF number of buffers to be allocated, (not used)
- TEXT name of the file
- *ISTAT status, =zero if success
-*/
-#include "kerngen/cf#open.h"
-#include <errno.h>
-#include <modes.h>
-#include "kerngen/cf#xaft.h"
-#include "kerngen/fortchar.h"
-#include "kerngen/wordsizc.h"
- int cfopen_perm = 0;
-
-void cfopei_(lundes,medium,nwrec,mode,nbuf,ftext,stat,lgtx)
- char *ftext;
- int *lundes, *medium, *nwrec, *nbuf, *stat, *lgtx;
- int *mode;
-{
- char *pttext, *fchtak();
- int flags;
- int fildes;
- int perm;
-
- *lundes = 0;
- *stat = -1;
-
- perm = cfopen_perm;
- cfopen_perm = 0;
-
-/*
- * construct flags :
- * mode[0] = 0 r 1 w 2 a
- * mode[1] = 1 +
- */
-
- if ((*medium == 1) || (*medium == 3))
- {
-
-/*
- * flags for tape
- */
-
- if (mode[0] == 0)
- {
- if (mode[1] == 0)
- flags = FAM_READ;
- else
- flags = FAM_READ | FAM_WRITE;
-
- } else if (mode[0] == 1) {
-
- if (mode[1] == 0)
- flags = FAM_WRITE;
- else
- flags = FAM_READ | FAM_WRITE;
-
- } else if (mode[0] == 2) return;
-
- } else {
-
-/*
- * flags for disk
- */
-
- if (mode[0] == 0)
- {
- if (mode[1] == 0)
- flags = FAM_READ;
- else
- flags = FAM_READ | FAM_WRITE;
-
- } else if (mode[0] == 1) {
-
- if (mode[1] == 0)
- flags = FAM_WRITE;
- else
- flags = FAM_WRITE | FAM_READ;
-
- } else if (mode[0] == 2) {
-
- if (mode[1] == 0)
- flags = FAM_WRITE | FAM_APPEND;
- else
- flags = FAM_WRITE | FAM_READ | FAM_APPEND;
- }
- }
-
-/*
- * open the file
- */
-
- pttext = fchtak(ftext,*lgtx);
- if (pttext == 0) return;
-
- if (perm == 0) perm = FAP_READ | FAP_WRITE | FAP_PREAD;
-
- if ( (mode[0] == 1) &
- ((*medium == 0) || (*medium == 2))
- ) {
- if ( (fildes = create (pttext, flags, perm)) < 0 )
- fildes = creat (pttext, flags);
-
- } else {
- fildes = open (pttext, flags);
- if ((mode[0] == 2) &
- (fildes < 0) ) fildes = create (pttext, flags, perm);
- }
-
- if (fildes < 0) goto errm;
-
- *lundes = fildes;
- *stat = 0;
- goto done;
-
-errm: *stat = errno;
- perror (" error in CFOPEN");
-
-done: free(pttext);
- return;
-}
-/*> END <----------------------------------------------------------*/
diff --git a/src/packlib/kernlib/kerngen/ccgenci/Imakefile b/src/packlib/kernlib/kerngen/ccgenci/Imakefile
deleted file mode 100644
index 0d176bd..0000000
--- a/src/packlib/kernlib/kerngen/ccgenci/Imakefile
+++ /dev/null
@@ -1,11 +0,0 @@
-SRCS_F= ciopen.F
-
-SRCS_C= ciclos.c ciget.c cigetw.c ciopei.c ciperm.c ciput.c ciputw.c \ @@\
- cirew.c ciseek.c cisize.c citell.c
-
-#ifdef CERNLIB_SHIFT
-CERNDEFINES:= $(CERNDEFINES) -DCERNLIB_SHIFT
-EXTRA_INCLUDES:= $(EXTRA_INCLUDES) -I/usr/local/include
-#endif
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kerngen/ccgenci/ciclos.c b/src/packlib/kernlib/kerngen/ccgenci/ciclos.c
deleted file mode 100644
index 613a2e5..0000000
--- a/src/packlib/kernlib/kerngen/ccgenci/ciclos.c
+++ /dev/null
@@ -1,45 +0,0 @@
-/*
- * $Id: ciclos.c,v 1.2 1997/02/04 17:35:16 mclareni Exp $
- *
- * $Log: ciclos.c,v $
- * Revision 1.2 1997/02/04 17:35:16 mclareni
- * Merge Winnt and 97a versions
- *
- * Revision 1.1.1.1.2.1 1997/01/21 11:30:15 mclareni
- * All mods for Winnt 96a on winnt branch
- *
- * Revision 1.1.1.1 1996/02/15 17:49:37 mclareni
- * Kernlib
- *
- */
-#include "kerngen/pilot.h"
-#include "kerngen/fortranc.h"
-
-/*> ROUTINE CICLOS
- CERN PROGLIB# Z311 CICLOS .VERSION KERNFOR 4.31 911111
- ORIG. 12/10/91, JZ
- CALL CICLOS (LUNDES)
- close the file :
- LUNDES file descriptor
-*/
-#include "kerngen/cf_clos.h"
-#include "kerngen/cf_xaft.h"
-
-#if defined(CERNLIB_QX_SC)
-void type_of_call ciclos_(lundes)
-#endif
-#if defined(CERNLIB_QXNO_SC)
-void type_of_call ciclos(lundes)
-#endif
-#if defined(CERNLIB_QXCAPT)
-void type_of_call CICLOS(lundes)
-#endif
- int *lundes;
-{
- int fildes;
-
- fildes = *lundes;
- close (fildes);
- return;
-}
-/*> END <----------------------------------------------------------*/
diff --git a/src/packlib/kernlib/kerngen/ccgenci/ciget.c b/src/packlib/kernlib/kerngen/ccgenci/ciget.c
deleted file mode 100644
index dcd9650..0000000
--- a/src/packlib/kernlib/kerngen/ccgenci/ciget.c
+++ /dev/null
@@ -1,110 +0,0 @@
-/*
- * $Id: ciget.c,v 1.4 1997/09/02 14:26:49 mclareni Exp $
- *
- * $Log: ciget.c,v $
- * Revision 1.4 1997/09/02 14:26:49 mclareni
- * WINNT correction
- *
- * Revision 1.3 1997/02/04 17:35:17 mclareni
- * Merge Winnt and 97a versions
- *
- * Revision 1.2 1997/01/15 16:25:44 cernlib
- * fix from F.Hemmer to return rfio return code
- *
- * Revision 1.1.1.1.2.1 1997/01/21 11:30:16 mclareni
- * All mods for Winnt 96a on winnt branch
- *
- * Revision 1.1.1.1 1996/02/15 17:49:37 mclareni
- * Kernlib
- *
- */
-#include "kerngen/pilot.h"
-#include "kerngen/fortranc.h"
-
-/*> ROUTINE CIGET
- CERN PROGLIB# Z311 CIGET .VERSION KERNFOR 4.37 930715
- ORIG. 12/10/91, JZ
- CALL CIGET (LUNDES, MBUF, NBDO, NBDONE, ISTAT)
- read from the file :
- LUNDES file descriptor
- *MBUF vector to be read into
- NBDO number of bytes to be read
- *NBDONE number of bytes actually read
- *ISTAT status, =zero if success
-*/
-#include "kerngen/cf_reaw.h"
-#ifndef WIN32
-# include <errno.h>
-#else
-# include <stdlib.h>
-#endif
-#include "kerngen/cf_xaft.h"
-#include "kerngen/fortchar.h"
-#if defined(CERNLIB_QMVAX)
-#include <descrip.h>
-#endif
-#if defined(CERNLIB_QX_SC)
-void type_of_call ciget_(lundes, mbuf, nbdo, nbdone, stat)
-#endif
-#if defined(CERNLIB_QXNO_SC)
-void type_of_call ciget(lundes, mbuf, nbdo, nbdone, stat)
-#endif
-#if defined(CERNLIB_QXCAPT)
-# ifdef CERNLIB_MSSTDCALL
- void type_of_call CIGET(lundes, mbuf, lmbuf, nbdo, nbdone, stat)
- int lmbuf;
-# else
- void type_of_call CIGET(lundes, mbuf, nbdo, nbdone, stat)
-# endif
-#endif
-#if defined(CERNLIB_QMCRY)
- _fcd mbuf;
-#endif
-#if defined(CERNLIB_QMVAX)
- struct dsc$descriptor_s *mbuf;
-#endif
-#if (!defined(CERNLIB_QMCRY))&&(!defined(CERNLIB_QMVAX))
- char *mbuf;
-#endif
- int *lundes, *nbdo, *nbdone, *stat;
-{
- char *ubuf;
- int fildes;
- int nbdn, nbxq;
-
- *stat = 0;
- if (*nbdo <= 0) return;
-#if defined(CERNLIB_QMCRY)
- ubuf = _fcdtocp(mbuf);
-#endif
-#if defined(CERNLIB_QMVAX)
- ubuf = mbuf->dsc$a_pointer;
-#endif
-#if (!defined(CERNLIB_QMCRY))&&(!defined(CERNLIB_QMVAX))
- ubuf = mbuf;
-#endif
-
-/* read the file */
-
- fildes = *lundes;
- nbxq = *nbdo;
- nbdn = read (fildes, ubuf, nbxq);
- if (nbdn == 0) goto heof;
- if (nbdn < 0) goto herror;
- *nbdone = nbdn;
- return;
-
-/* Handle exceptions */
-
-heof: *stat = -1;
- return;
-
-#if defined(CERNLIB_PROJSHIFT)
-herror: *stat = (serrno ? serrno : (rfio_errno ? rfio_errno : errno));
-#else
-herror: *stat = errno;
-#endif
- perror (" error in CIGET");
- return;
-}
-/*> END <----------------------------------------------------------*/
diff --git a/src/packlib/kernlib/kerngen/ccgenci/cigetw.c b/src/packlib/kernlib/kerngen/ccgenci/cigetw.c
deleted file mode 100644
index cff2552..0000000
--- a/src/packlib/kernlib/kerngen/ccgenci/cigetw.c
+++ /dev/null
@@ -1,84 +0,0 @@
-/*
- * $Id: cigetw.c,v 1.4 1997/09/02 14:26:50 mclareni Exp $
- *
- * $Log: cigetw.c,v $
- * Revision 1.4 1997/09/02 14:26:50 mclareni
- * WINNT correction
- *
- * Revision 1.3 1997/02/04 17:35:17 mclareni
- * Merge Winnt and 97a versions
- *
- * Revision 1.2 1997/01/15 16:25:44 cernlib
- * fix from F.Hemmer to return rfio return code
- *
- * Revision 1.1.1.1.2.1 1997/01/21 11:30:17 mclareni
- * All mods for Winnt 96a on winnt branch
- *
- * Revision 1.1.1.1 1996/02/15 17:49:37 mclareni
- * Kernlib
- *
- */
-#include "kerngen/pilot.h"
-#include "kerngen/fortranc.h"
-
-/*> ROUTINE CIGETW
- CERN PROGLIB# Z311 CIGETW .VERSION KERNFOR 4.31 911111
- ORIG. 12/10/91, JZ
- CALL CIGETW (LUNDES, MBUF, NWDO, NWDONE, ISTAT)
- read from the file :
- LUNDES file descriptor
- *MBUF vector to be read into
- NWDO number of full words to be read
- *NWDONE number of full words actually read
- *ISTAT status, =zero if success
-*/
-#include "kerngen/cf_reaw.h"
-#ifndef WIN32
-# include <errno.h>
-#else
-# include <stdlib.h>
-#endif
-#include "kerngen/cf_xaft.h"
-#include "kerngen/wordsizc.h"
-#if defined(CERNLIB_QX_SC)
-void type_of_call cigetw_(lundes, mbuf, nwdo, nwdone, stat)
-#endif
-#if defined(CERNLIB_QXNO_SC)
-void type_of_call cigetw(lundes, mbuf, nwdo, nwdone, stat)
-#endif
-#if defined(CERNLIB_QXCAPT)
-void type_of_call CIGETW(lundes, mbuf, nwdo, nwdone, stat)
-#endif
- int *mbuf;
- int *lundes, *nwdo, *nwdone, *stat;
-{
- int fildes;
- int nbdn, nbxq;
-
- *stat = 0;
- if (*nwdo <= 0) return;
-
-/* read the file */
-
- fildes = *lundes;
- nbxq = *nwdo * NBYTPW;
- nbdn = read (fildes, mbuf, nbxq);
- if (nbdn == 0) goto heof;
- if (nbdn < 0) goto herror;
- *nwdone = nbdn / NBYTPW;
- return;
-
-/* Handle exceptions */
-
-heof: *stat = -1;
- return;
-
-#if defined(CERNLIB_PROJSHIFT)
-herror: *stat = (serrno ? serrno : (rfio_errno ? rfio_errno : errno));
-#else
-herror: *stat = errno;
-#endif
- perror (" error in CIGETW");
- return;
-}
-/*> END <----------------------------------------------------------*/
diff --git a/src/packlib/kernlib/kerngen/ccgenci/ciopei.c b/src/packlib/kernlib/kerngen/ccgenci/ciopei.c
deleted file mode 100644
index 9729f30..0000000
--- a/src/packlib/kernlib/kerngen/ccgenci/ciopei.c
+++ /dev/null
@@ -1,134 +0,0 @@
-/*
- * $Id: ciopei.c,v 1.4 1997/09/02 14:26:53 mclareni Exp $
- *
- * $Log: ciopei.c,v $
- * Revision 1.4 1997/09/02 14:26:53 mclareni
- * WINNT correction
- *
- * Revision 1.3 1997/02/04 17:35:18 mclareni
- * Merge Winnt and 97a versions
- *
- * Revision 1.2 1997/01/15 16:25:45 cernlib
- * fix from F.Hemmer to return rfio return code
- *
- * Revision 1.1.1.1.2.1 1997/01/21 11:30:17 mclareni
- * All mods for Winnt 96a on winnt branch
- *
- * Revision 1.1.1.1 1996/02/15 17:49:39 mclareni
- * Kernlib
- *
- */
-#include "kerngen/pilot.h"
-#include "kerngen/fortranc.h"
-
-#if defined(CERNLIB_QMOS9)
-#include "os9gs/ciopei.c"
-#else
-/*> ROUTINE CIOPEI
- CERN PROGLIB# Z311 CIOPEI .VERSION KERNFOR 4.39 940228
- ORIG. 12/10/91, JZ
- CALL CIOPEN (LUNDES, MODE, TEXT, ISTAT)
- open a file :
- *LUNDES file descriptor
- MODE string selecting IO mode
- = 'r ', 'w ', 'a ', 'r+ ', ...
- TEXT name of the file
- *ISTAT status, =zero if success
-*/
-#include "kerngen/cf_open.h"
-#ifndef WIN32
-# include <errno.h>
-#else
-# include <stdlib.h>
-#endif
-#include "kerngen/cf_xaft.h"
-#include "kerngen/fortchar.h"
- int ciopen_perm = 0;
-#if defined(CERNLIB_QX_SC)
-void type_of_call ciopei_(lundes,mode,ftext,stat,lgtx)
-#endif
-#if defined(CERNLIB_QXNO_SC)
-void type_of_call ciopei(lundes,mode,ftext,stat,lgtx)
-#endif
-#if defined(CERNLIB_QXCAPT)
-# ifdef CERNLIB_MSSTDCALL
- void type_of_call CIOPEI(lundes,mode,ftext,lftext,stat,lgtx)
- int lftext;
-# else
- void type_of_call CIOPEI(lundes,mode,ftext,stat,lgtx)
-# endif
-#endif
-#if defined(CERNLIB_QMCRY)
- _fcd ftext;
-#endif
-#if !defined(CERNLIB_QMCRY)
- char *ftext;
-#endif
- int *lundes, *stat, *lgtx;
- int *mode;
-{
- char *pttext, *fchtak();
- int flags;
- int fildes;
- int perm;
-
- *lundes = 0;
- *stat = -1;
-
- perm = ciopen_perm;
- ciopen_perm = 0;
-
-/* construct flags :
- mode[0] = 0 r 1 w 2 a
- mode[1] = 1 +
-*/
-/* flags for disk */
-
-
- if (mode[0] == 0)
- {if (mode[1] == 0)
- flags = O_RDONLY;
- else
- flags = O_RDWR;}
-
- else if (mode[0] == 1)
- {if (mode[1] == 0)
- flags = O_WRONLY | O_CREAT | O_TRUNC;
- else
- flags = O_RDWR | O_CREAT | O_TRUNC;}
-
- else if (mode[0] == 2)
- {if (mode[1] == 0)
- flags = O_WRONLY | O_CREAT | O_APPEND;
- else
- flags = O_RDWR | O_CREAT | O_APPEND;}
-
-/* open the file */
-
- pttext = fchtak(ftext,*lgtx);
- if (pttext == 0) return;
-
- if (perm == 0) perm = 0644;
-
-#if defined(CERNLIB_QMDOS) || defined(CERNLIB_WINNT)
- fildes = open (pttext, flags | O_BINARY, perm);
-#else
- fildes = open (pttext, flags, perm);
-#endif
- if (fildes < 0) goto errm;
- *lundes = fildes;
- *stat = 0;
- goto done;
-
-#if defined(CERNLIB_PROJSHIFT)
-errm: *stat = (serrno ? serrno : (rfio_errno ? rfio_errno : errno));
-#else
-errm: *stat = errno;
-#endif
-/* perror (" error in CIOPEN"); */
-
-done: free(pttext);
- return;
-}
-/*> END <----------------------------------------------------------*/
-#endif
diff --git a/src/packlib/kernlib/kerngen/ccgenci/ciopen.F b/src/packlib/kernlib/kerngen/ccgenci/ciopen.F
deleted file mode 100644
index 350b799..0000000
--- a/src/packlib/kernlib/kerngen/ccgenci/ciopen.F
+++ /dev/null
@@ -1,49 +0,0 @@
-*
-* $Id: ciopen.F,v 1.1.1.1 1996/02/15 17:49:38 mclareni Exp $
-*
-* $Log: ciopen.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:38 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE CIOPEN (LUNDES, MODE, NAME, ISTAT)
-C
-C CERN PROGLIB# Z311 CIOPEN .VERSION KERNFOR 4.31 911111
-C ORIG. 12/10/91, JZ
-C
- DIMENSION LUNDES(9), ISTAT(9)
- CHARACTER MODE*(*), NAME*(*)
- DIMENSION NVMODE(4)
- CHARACTER CHUSE*4
-
-
- LGN = LNBLNK (NAME)
-
- CHUSE = MODE
- CALL CUTOL (CHUSE)
- CALL VZERO (NVMODE,4)
-
- IF (INDEX(CHUSE,'a').NE.0) NVMODE(1) = 2
- IF (INDEX(CHUSE,'w').NE.0) THEN
- IF (NVMODE(1).NE.0) GO TO 91
- NVMODE(1) = 1
- ENDIF
- IF (INDEX(CHUSE,'r').NE.0) THEN
- IF (NVMODE(1).NE.0) GO TO 91
- ENDIF
-
- IF (INDEX(CHUSE,'+').NE.0) NVMODE(2) = 1
-
-#if !defined(CERNLIB_QMVAX)
- CALL CIOPEI (LUNDES,NVMODE,NAME,ISTAT,LGN)
-#endif
-#if defined(CERNLIB_QMVAX)
- CALL CIOPEI (LUNDES,NVMODE,%REF(NAME),ISTAT,LGN)
-#endif
- RETURN
-
- 91 LUNDES(1) = 0
- ISTAT(1) = -1
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/ccgenci/ciperm.c b/src/packlib/kernlib/kerngen/ccgenci/ciperm.c
deleted file mode 100644
index 94616fa..0000000
--- a/src/packlib/kernlib/kerngen/ccgenci/ciperm.c
+++ /dev/null
@@ -1,40 +0,0 @@
-/*
- * $Id: ciperm.c,v 1.2 1997/02/04 17:35:18 mclareni Exp $
- *
- * $Log: ciperm.c,v $
- * Revision 1.2 1997/02/04 17:35:18 mclareni
- * Merge Winnt and 97a versions
- *
- * Revision 1.1.1.1.2.1 1997/01/21 11:30:18 mclareni
- * All mods for Winnt 96a on winnt branch
- *
- * Revision 1.1.1.1 1996/02/15 17:49:39 mclareni
- * Kernlib
- *
- */
-#include "kerngen/pilot.h"
-#include "kerngen/fortranc.h"
-
-/*> ROUTINE CIPERM
- CERN PROGLIB# Z311 CIPERM .VERSION KERNFOR 4.34 930114
- ORIG. 03/06/92, JZ
- CALL CIPERM (NPERM)
- set permission mask NPERM to be used in next call to CIOPEN
-*/
-#if defined(CERNLIB_QX_SC)
-void type_of_call ciperm_(nperm)
-#endif
-#if defined(CERNLIB_QXNO_SC)
-void type_of_call ciperm(nperm)
-#endif
-#if defined(CERNLIB_QXCAPT)
-void type_of_call CIPERM(nperm)
-#endif
- int *nperm;
-{
- extern int ciopen_perm;
-
- ciopen_perm = *nperm & 0777;
- return;
-}
-/*> END <----------------------------------------------------------*/
diff --git a/src/packlib/kernlib/kerngen/ccgenci/ciput.c b/src/packlib/kernlib/kerngen/ccgenci/ciput.c
deleted file mode 100644
index 168dfa5..0000000
--- a/src/packlib/kernlib/kerngen/ccgenci/ciput.c
+++ /dev/null
@@ -1,102 +0,0 @@
-/*
- * $Id: ciput.c,v 1.4 1997/09/02 14:26:54 mclareni Exp $
- *
- * $Log: ciput.c,v $
- * Revision 1.4 1997/09/02 14:26:54 mclareni
- * WINNT correction
- *
- * Revision 1.3 1997/02/04 17:35:19 mclareni
- * Merge Winnt and 97a versions
- *
- * Revision 1.2 1997/01/15 16:25:46 cernlib
- * fix from F.Hemmer to return rfio return code
- *
- * Revision 1.1.1.1.2.1 1997/01/21 11:30:18 mclareni
- * All mods for Winnt 96a on winnt branch
- *
- * Revision 1.1.1.1 1996/02/15 17:49:39 mclareni
- * Kernlib
- *
- */
-#include "kerngen/pilot.h"
-#include "kerngen/fortranc.h"
-
-/*> ROUTINE CIPUT
- CERN PROGLIB# Z311 CIPUT .VERSION KERNFOR 4.37 930715
- ORIG. 12/10/91, JZ
- CALL CIPUT (LUNDES, MBUF, NBPUT, ISTAT)
- write to the file :
- LUNDES file descriptor
- MBUF vector to be written
- NBPUT number of bytes to be written
- *ISTAT status, =zero if success
-*/
-#include "kerngen/cf_reaw.h"
-#ifndef WIN32
-# include <errno.h>
-#else
-# include <stdlib.h>
-#endif
-#include "kerngen/cf_xaft.h"
-#include "kerngen/fortchar.h"
-#if defined(CERNLIB_QMVAX)
-#include <descrip.h>
-#endif
-#if defined(CERNLIB_QX_SC)
-void type_of_call ciput_(lundes, mbuf, nbput, stat)
-#endif
-#if defined(CERNLIB_QXNO_SC)
-void type_of_call ciput(lundes, mbuf, nbput, stat)
-#endif
-#if defined(CERNLIB_QXCAPT)
-# ifdef CERNLIB_MSSTDCALL
- void type_of_call CIPUT(lundes, mbuf, lmbuf, nbput, stat)
- int lmbuf;
-# else
- void type_of_call CIPUT(lundes, mbuf, nbput, stat)
-# endif
-#endif
-#if defined(CERNLIB_QMCRY)
- _fcd mbuf;
-#endif
-#if defined(CERNLIB_QMVAX)
- struct dsc$descriptor_s *mbuf;
-#endif
-#if (!defined(CERNLIB_QMCRY))&&(!defined(CERNLIB_QMVAX))
- char *mbuf;
-#endif
- int *lundes, *nbput, *stat;
-{
- char *ubuf;
- int fildes;
- int nbdn, nbdo;
-
- *stat = 0;
- if (*nbput <= 0) return;
-#if defined(CERNLIB_QMCRY)
- ubuf = _fcdtocp(mbuf);
-#endif
-#if defined(CERNLIB_QMVAX)
- ubuf = mbuf->dsc$a_pointer;
-#endif
-#if (!defined(CERNLIB_QMCRY))&&(!defined(CERNLIB_QMVAX))
- ubuf = mbuf;
-#endif
-
-/* write the file */
-
- fildes = *lundes;
- nbdo = *nbput;
- nbdn = write (fildes, ubuf, nbdo);
- if (nbdn < 0) goto trouble;
- return;
-
-#if defined(CERNLIB_PROJSHIFT)
-trouble: *stat = (serrno ? serrno : (rfio_errno ? rfio_errno : errno));
-#else
-trouble: *stat = errno;
-#endif
- perror (" error in CIPUT");
- return;
-}
-/*> END <----------------------------------------------------------*/
diff --git a/src/packlib/kernlib/kerngen/ccgenci/ciputw.c b/src/packlib/kernlib/kerngen/ccgenci/ciputw.c
deleted file mode 100644
index 56d677d..0000000
--- a/src/packlib/kernlib/kerngen/ccgenci/ciputw.c
+++ /dev/null
@@ -1,76 +0,0 @@
-/*
- * $Id: ciputw.c,v 1.4 1997/09/02 14:26:54 mclareni Exp $
- *
- * $Log: ciputw.c,v $
- * Revision 1.4 1997/09/02 14:26:54 mclareni
- * WINNT correction
- *
- * Revision 1.3 1997/02/04 17:35:20 mclareni
- * Merge Winnt and 97a versions
- *
- * Revision 1.2 1997/01/15 16:25:47 cernlib
- * fix from F.Hemmer to return rfio return code
- *
- * Revision 1.1.1.1.2.1 1997/01/21 11:30:19 mclareni
- * All mods for Winnt 96a on winnt branch
- *
- * Revision 1.1.1.1 1996/02/15 17:49:39 mclareni
- * Kernlib
- *
- */
-#include "kerngen/pilot.h"
-#include "kerngen/fortranc.h"
-
-/*> ROUTINE CIPUTW
- CERN PROGLIB# Z311 CIPUTW .VERSION KERNFOR 4.31 911111
- ORIG. 12/10/91, JZ
- CALL CIPUTW (LUNDES, MBUF, NWPUT, ISTAT)
- write to the file :
- LUNDES file descriptor
- MBUF vector to be written
- NWPUT number of full words to be written
- *ISTAT status, =zero if success
-*/
-#include "kerngen/cf_reaw.h"
-#ifndef WIN32
-# include <errno.h>
-#else
-# include <stdlib.h>
-#endif
-#include "kerngen/cf_xaft.h"
-#include "kerngen/wordsizc.h"
-#if defined(CERNLIB_QX_SC)
-void type_of_call ciputw_(lundes, mbuf, nwput, stat)
-#endif
-#if defined(CERNLIB_QXNO_SC)
-void type_of_call ciputw(lundes, mbuf, nwput, stat)
-#endif
-#if defined(CERNLIB_QXCAPT)
-void type_of_call CIPUTW(lundes, mbuf, nwput, stat)
-#endif
- int *mbuf;
- int *lundes, *nwput, *stat;
-{
- int fildes;
- int nbdn, nbdo;
-
- *stat = 0;
- if (*nwput <= 0) return;
-
-/* write the file */
-
- fildes = *lundes;
- nbdo = *nwput * NBYTPW;
- nbdn = write (fildes, mbuf, nbdo);
- if (nbdn < 0) goto trouble;
- return;
-
-#if defined(CERNLIB_PROJSHIFT)
-trouble: *stat = (serrno ? serrno : (rfio_errno ? rfio_errno : errno));
-#else
-trouble: *stat = errno;
-#endif
- perror (" error in CIPUTW");
- return;
-}
-/*> END <----------------------------------------------------------*/
diff --git a/src/packlib/kernlib/kerngen/ccgenci/cirew.c b/src/packlib/kernlib/kerngen/ccgenci/cirew.c
deleted file mode 100644
index b7b9b9a..0000000
--- a/src/packlib/kernlib/kerngen/ccgenci/cirew.c
+++ /dev/null
@@ -1,53 +0,0 @@
-/*
- * $Id: cirew.c,v 1.3 1997/09/16 09:45:00 mclareni Exp $
- *
- * $Log: cirew.c,v $
- * Revision 1.3 1997/09/16 09:45:00 mclareni
- * Typing error affecting VMS
- *
- * Revision 1.2 1997/02/04 17:35:20 mclareni
- * Merge Winnt and 97a versions
- *
- * Revision 1.1.1.1.2.1 1997/01/21 11:30:19 mclareni
- * All mods for Winnt 96a on winnt branch
- *
- * Revision 1.1.1.1 1996/02/15 17:49:39 mclareni
- * Kernlib
- *
- */
-#include "kerngen/pilot.h"
-#include "kerngen/fortranc.h"
-
-/*> ROUTINE CIREW
- CERN PROGLIB# Z311 CIREW .VERSION KERNFOR 4.31 911111
- ORIG. 12/10/91, JZ
- CALL CIREW (LUNDES)
- rewind the file :
- LUNDES file descriptor
-*/
-#include "kerngen/cf_seek.h"
-#include "kerngen/cf_xaft.h"
-
-#if defined(CERNLIB_QX_SC)
-void type_of_call cirew_(lundes)
-#endif
-#if defined(CERNLIB_QXNO_SC)
-void type_of_call cirew(lundes)
-#endif
-#if defined(CERNLIB_QXCAPT)
-void type_of_call CIREW(lundes)
-#endif
- int *lundes;
-{
- int fildes;
- int newpos;
-
- fildes = *lundes;
- newpos = lseek (fildes, 0, 0);
- if (newpos < 0) goto trouble;
- return;
-
-trouble: perror (" error in CIREW");
- return;
-}
-/*> END <----------------------------------------------------------*/
diff --git a/src/packlib/kernlib/kerngen/ccgenci/ciseek.c b/src/packlib/kernlib/kerngen/ccgenci/ciseek.c
deleted file mode 100644
index da395ee..0000000
--- a/src/packlib/kernlib/kerngen/ccgenci/ciseek.c
+++ /dev/null
@@ -1,57 +0,0 @@
-/*
- * $Id: ciseek.c,v 1.2 1997/02/04 17:35:21 mclareni Exp $
- *
- * $Log: ciseek.c,v $
- * Revision 1.2 1997/02/04 17:35:21 mclareni
- * Merge Winnt and 97a versions
- *
- * Revision 1.1.1.1.2.1 1997/01/21 11:30:20 mclareni
- * All mods for Winnt 96a on winnt branch
- *
- * Revision 1.1.1.1 1996/02/15 17:49:39 mclareni
- * Kernlib
- *
- */
-#include "kerngen/pilot.h"
-#include "kerngen/fortranc.h"
-
-/*> ROUTINE CISEEK
- CERN PROGLIB# Z311 CISEEK .VERSION KERNFOR 4.31 911111
- ORIG. 12/10/91, JZ
- CALL CISEEK (LUNDES, JCBYT, ISTAT)
- reposition the file :
- LUNDES file descriptor
- JCBYT number of bytes before current
- *ISTAT status, =zero if success
-*/
-#include "kerngen/cf_seek.h"
-#include "kerngen/cf_xaft.h"
-#if defined(CERNLIB_QX_SC)
-void type_of_call ciseek_(lundes, jcbyt, stat)
-#endif
-#if defined(CERNLIB_QXNO_SC)
-void type_of_call ciseek(lundes, jcbyt, stat)
-#endif
-#if defined(CERNLIB_QXCAPT)
-void type_of_call CISEEK(lundes, jcbyt, stat)
-#endif
- int *lundes, *jcbyt, *stat;
-{
- int fildes;
- int nbdo;
- int isw;
-
-/* position the file */
-
- fildes = *lundes;
- nbdo = *jcbyt;
- isw = lseek (fildes, nbdo, 0);
- if (isw < 0) goto trouble;
- *stat = 0;
- return;
-
-trouble: *stat = -1;
- perror (" error in CISEEK");
- return;
-}
-/*> END <----------------------------------------------------------*/
diff --git a/src/packlib/kernlib/kerngen/ccgenci/cisize.c b/src/packlib/kernlib/kerngen/ccgenci/cisize.c
deleted file mode 100644
index e013ab9..0000000
--- a/src/packlib/kernlib/kerngen/ccgenci/cisize.c
+++ /dev/null
@@ -1,59 +0,0 @@
-/*
- * $Id: cisize.c,v 1.2 1997/02/04 17:35:21 mclareni Exp $
- *
- * $Log: cisize.c,v $
- * Revision 1.2 1997/02/04 17:35:21 mclareni
- * Merge Winnt and 97a versions
- *
- * Revision 1.1.1.1.2.1 1997/01/21 11:30:20 mclareni
- * All mods for Winnt 96a on winnt branch
- *
- * Revision 1.1.1.1 1996/02/15 17:49:39 mclareni
- * Kernlib
- *
- */
-#include "kerngen/pilot.h"
-#include "kerngen/fortranc.h"
-
-/*> ROUTINE CISIZE
- CERN PROGLIB# Z311 CISIZE .VERSION KERNFOR 4.31 911111
- ORIG. 12/10/91, JZ
- CALL CISIZE (LUNDES, JBYTL, ISTAT)
- get the position of the end-of-file and position to it :
- LUNDES file descriptor
- *JBYTL number of bytes before end-of-file
- *ISTAT status, =zero if success
-*/
-#include "kerngen/cf_seek.h"
-#include "kerngen/cf_xaft.h"
-#if defined(CERNLIB_QX_SC)
-void type_of_call cisize_(lundes, jbytl, stat)
-#endif
-#if defined(CERNLIB_QXNO_SC)
-void type_of_call cisize(lundes, jbytl, stat)
-#endif
-#if defined(CERNLIB_QXCAPT)
-void type_of_call CISIZE(lundes, jbytl, stat)
-#endif
- int *lundes, *jbytl, *stat;
-{
- int fildes;
- int nboff;
-
-/* position the file to the end */
-
- fildes = *lundes;
- nboff = lseek (fildes, 0, 2);
- if (nboff < 0) goto trouble;
-
-/* get position of the file */
-
- *jbytl = nboff;
- *stat = 0;
- return;
-
-trouble: *stat = -1;
- perror (" error in CISIZE");
- return;
-}
-/*> END <----------------------------------------------------------*/
diff --git a/src/packlib/kernlib/kerngen/ccgenci/citell.c b/src/packlib/kernlib/kerngen/ccgenci/citell.c
deleted file mode 100644
index c74aec6..0000000
--- a/src/packlib/kernlib/kerngen/ccgenci/citell.c
+++ /dev/null
@@ -1,56 +0,0 @@
-/*
- * $Id: citell.c,v 1.2 1997/02/04 17:35:22 mclareni Exp $
- *
- * $Log: citell.c,v $
- * Revision 1.2 1997/02/04 17:35:22 mclareni
- * Merge Winnt and 97a versions
- *
- * Revision 1.1.1.1.2.1 1997/01/21 11:30:21 mclareni
- * All mods for Winnt 96a on winnt branch
- *
- * Revision 1.1.1.1 1996/02/15 17:49:39 mclareni
- * Kernlib
- *
- */
-#include "kerngen/pilot.h"
-#include "kerngen/fortranc.h"
-
-/*> ROUTINE CITELL
- CERN PROGLIB# Z311 CITELL .VERSION KERNFOR 4.31 911111
- ORIG. 12/10/91, JZ
- CALL CITELL (LUNDES, JCBYT, ISTAT)
- get the current position of the file :
- LUNDES file descriptor
- *JCBYT number of bytes before current
- *ISTAT status, =zero if success
-*/
-#include "kerngen/cf_seek.h"
-#include "kerngen/cf_xaft.h"
-#if defined(CERNLIB_QX_SC)
-void type_of_call citell_(lundes, jcbyt, stat)
-#endif
-#if defined(CERNLIB_QXNO_SC)
-void type_of_call citell(lundes, jcbyt, stat)
-#endif
-#if defined(CERNLIB_QXCAPT)
-void type_of_call CITELL(lundes, jcbyt, stat)
-#endif
- int *lundes, *jcbyt, *stat;
-{
- int fildes;
- int nboff;
-
-/* get position of the file */
-
- fildes = *lundes;
- nboff = lseek (fildes, 0, 1);
- if (nboff < 0) goto trouble;
- *jcbyt = nboff;
- *stat = 0;
- return;
-
-trouble: *stat = -1;
- perror (" error in CITELL");
- return;
-}
-/*> END <----------------------------------------------------------*/
diff --git a/src/packlib/kernlib/kerngen/ccgenci/os9gs/ciopei.c b/src/packlib/kernlib/kerngen/ccgenci/os9gs/ciopei.c
deleted file mode 100644
index c2f3ec5..0000000
--- a/src/packlib/kernlib/kerngen/ccgenci/os9gs/ciopei.c
+++ /dev/null
@@ -1,101 +0,0 @@
-/*
- * $Id: ciopei.c,v 1.1.1.1 1996/02/15 17:49:40 mclareni Exp $
- *
- * $Log: ciopei.c,v $
- * Revision 1.1.1.1 1996/02/15 17:49:40 mclareni
- * Kernlib
- *
- */
-/*> ROUTINE CIOPEI
- CERN PROGLIB# Z311 CIOPEI .VERSION KERNOS9 1.01 940801
- ORIG. 12/10/91, JZ
- CALL CIOPEN (LUNDES, MODE, TEXT, ISTAT)
- open a file :
- *LUNDES file descriptor
- MODE string selecting IO mode
- = 'r ', 'w ', 'a ', 'r+ ', ...
- TEXT name of the file
- *ISTAT status, =zero if success
-*/
-#include "kerngen/cf#open.h"
-#include <modes.h>
-#include <errno.h>
-#include "kerngen/cf#xaft.h"
-#include "kerngen/fortchar.h"
- int ciopen_perm = 0;
-
-void ciopei_(lundes,mode,ftext,stat,lgtx)
- char *ftext;
- int *lundes, *stat, *lgtx;
- int *mode;
-{
- char *pttext, *fchtak();
- int flags;
- int fildes;
- int perm;
-
- *lundes = 0;
- *stat = -1;
-
- perm = ciopen_perm;
- ciopen_perm = 0;
-
-/* construct flags :
- mode[0] = 0 r 1 w 2 a
- mode[1] = 1 +
-*/
-/* flags for disk */
-
-
- if (mode[0] == 0)
- {
- if (mode[1] == 0)
- flags = FAM_READ;
- else
- flags = FAM_READ | FAM_WRITE;
-
- } else if (mode[0] == 1) {
-
- if (mode[1] == 0)
- flags = FAM_WRITE;
- else
- flags = FAM_WRITE | FAM_READ;
-
- } else if (mode[0] == 2) {
-
- if (mode[1] == 0)
- flags = FAM_WRITE | FAM_APPEND;
- else
- flags = FAM_WRITE | FAM_READ | FAM_APPEND;
- }
-
-
-/* open the file */
-
- pttext = fchtak(ftext,*lgtx);
- if (pttext == 0) return;
-
- if (perm == 0) perm = FAP_READ | FAP_WRITE | FAP_PREAD;
-
- if (mode[0] == 1) {
- if ( (fildes = create (pttext, flags, perm)) < 0 )
- fildes = creat (pttext, flags);
- } else {
- fildes = open (pttext, flags);
- if ((mode[0] == 2) &
- (fildes < 0) ) fildes = create (pttext, flags, perm);
- }
-
-
- if (fildes < 0) goto errm;
- *lundes = fildes;
- *stat = 0;
- goto done;
-
-errm: *stat = errno;
-/* perror (" error in CIOPEN"); */
-
-done: free(pttext);
- return;
-}
-/*> END <----------------------------------------------------------*/
diff --git a/src/packlib/kernlib/kerngen/ccgenu/Imakefile b/src/packlib/kernlib/kerngen/ccgenu/Imakefile
deleted file mode 100644
index 9d305d1..0000000
--- a/src/packlib/kernlib/kerngen/ccgenu/Imakefile
+++ /dev/null
@@ -1,3 +0,0 @@
-SRCS_C= fchput.c fchtak.c
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kerngen/ccgenu/fchput.c b/src/packlib/kernlib/kerngen/ccgenu/fchput.c
deleted file mode 100644
index 0f107a9..0000000
--- a/src/packlib/kernlib/kerngen/ccgenu/fchput.c
+++ /dev/null
@@ -1,54 +0,0 @@
-/*
- * $Id: fchput.c,v 1.1.1.1 1996/02/15 17:49:40 mclareni Exp $
- *
- * $Log: fchput.c,v $
- * Revision 1.1.1.1 1996/02/15 17:49:40 mclareni
- * Kernlib
- *
- */
-#include "kerngen/pilot.h"
-/*> ROUTINE FCHPUT
- CERN PROGLIB# FCHPUT .VERSION KERNFOR 4.31 911111
- ORIG. 22/02/91, JZ
-
- Copy a zero-terminated C character string
- to a Fortran character string of length NTEXT,
- return length and blank-fill
-*/
-#include <stdio.h>
-#include "kerngen/fortchar.h"
-int fchput(pttext,ftext,lgtext)
- char *pttext;
-#if defined(CERNLIB_QMCRY)
- _fcd ftext;
-#endif
-#if !defined(CERNLIB_QMCRY)
- char *ftext;
-#endif
- int lgtext;
-{
- char *utext;
- int limit, jcol;
- int nhave;
-
- limit = lgtext;
- jcol = 0;
-#if defined(CERNLIB_QMCRY)
- utext = _fcdtocp(ftext);
-#endif
-#if !defined(CERNLIB_QMCRY)
- utext = ftext;
-#endif
- if (pttext == NULL) goto out;
-
-/*-- copy the text to the caller */
- for (jcol = 0; jcol < limit; jcol++)
- { if (*pttext == '\0') break;
- *utext++ = *pttext++;
- }
-
-out: nhave = jcol;
- for (; jcol < limit; jcol++) *utext++ = ' ';
- return nhave;
-}
-/*> END <----------------------------------------------------------*/
diff --git a/src/packlib/kernlib/kerngen/ccgenu/fchtak.c b/src/packlib/kernlib/kerngen/ccgenu/fchtak.c
deleted file mode 100644
index bdb1af8..0000000
--- a/src/packlib/kernlib/kerngen/ccgenu/fchtak.c
+++ /dev/null
@@ -1,52 +0,0 @@
-/*
- * $Id: fchtak.c,v 1.1.1.1 1996/02/15 17:49:40 mclareni Exp $
- *
- * $Log: fchtak.c,v $
- * Revision 1.1.1.1 1996/02/15 17:49:40 mclareni
- * Kernlib
- *
- */
-#include "kerngen/pilot.h"
-/*> ROUTINE FCHTAK
- CERN PROGLIB# FCHTAK .VERSION KERNFOR 4.31 911111
- ORIG. 22/02/91, JZ
-
- copy a Fortran character string
- to allocated memory zero-terminated,
- return the memory pointer
-*/
-#include <stdio.h>
-#include "kerngen/fortchar.h"
-char *fchtak(ftext,lgtext)
-#if defined(CERNLIB_QMCRY)
- _fcd ftext;
-#endif
-#if !defined(CERNLIB_QMCRY)
- char *ftext;
-#endif
- int lgtext;
-{
- char *malloc();
- char *ptalc, *ptuse;
- char *utext;
- int nalc;
- int ntx, jcol;
-
- nalc = lgtext + 8;
- ptalc = malloc (nalc);
- if (ptalc == NULL) goto exit;
-#if defined(CERNLIB_QMCRY)
- utext = _fcdtocp(ftext);
-#endif
-#if !defined(CERNLIB_QMCRY)
- utext = ftext;
-#endif
-
- ptuse = ptalc;
- ntx = lgtext;
- for (jcol = 0; jcol < ntx; jcol++) *ptuse++ = *utext++;
-
- *ptuse = '\0';
-exit: return ptalc;
-}
-/*> END <----------------------------------------------------------*/
diff --git a/src/packlib/kernlib/kerngen/history/iguide.dat b/src/packlib/kernlib/kerngen/history/iguide.dat
deleted file mode 100644
index b6b9e64..0000000
--- a/src/packlib/kernlib/kerngen/history/iguide.dat
+++ /dev/null
@@ -1,9 +0,0 @@
-*
-* $Id: iguide.dat,v 1.1.1.1 1996/02/15 17:50:42 mclareni Exp $
-*
-* $Log: iguide.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:50:42 mclareni
-* Kernlib
-*
-*
-* Installation Guide
diff --git a/src/packlib/kernlib/kerngen/history/inform.dat b/src/packlib/kernlib/kerngen/history/inform.dat
deleted file mode 100644
index c674850..0000000
--- a/src/packlib/kernlib/kerngen/history/inform.dat
+++ /dev/null
@@ -1,15 +0,0 @@
-*
-* $Id: inform.dat,v 1.1.1.1 1996/02/15 17:50:41 mclareni Exp $
-*
-* $Log: inform.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:50:41 mclareni
-* Kernlib
-*
-*
-* General information
-
- At CERN we inhibited flag QMIBMXA to install this package on our
- SIEMENS machine when it was running
- CPLEVEL : VM/SP Release 4, HPO level 42, Service Level 425
- CMSLEVEL : VM/SP Release 4, Service Level 420
-
diff --git a/src/packlib/kernlib/kerngen/history/kerndos/history.dat b/src/packlib/kernlib/kerngen/history/kerndos/history.dat
deleted file mode 100644
index 7c59aad..0000000
--- a/src/packlib/kernlib/kerngen/history/kerndos/history.dat
+++ /dev/null
@@ -1,67 +0,0 @@
-*
-* $Id: history.dat,v 1.1.1.1 1996/02/15 17:50:44 mclareni Exp $
-*
-* $Log: history.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:50:44 mclareni
-* Kernlib
-*
-*
-* This directory was created from kerndos.car patch kerndos
-#if !defined(CERNLIB_KERNDOS)
-
- KERNLIB routines particular to MS-DOS
-
----------------------------------------------------------------------
-
- This file contains the following patches :
-
-*KDOS Pilot-patch selecting KERNLIB for MS-DOS
-
-*KDECWNT Pilot-patch selecting KERNLIB for Windows NT with DEC Fortran
-
-QMDOS Machine patch MS-DOS
-
-DOSPROGS MS-DOS utility programs
-
-DOSGS MS-DOS variants of KERNLIB routines
-
-=====================================================================
-
-
- UP-DATE RECORD FOR THE PAM-FILE KERNDOS
- ----------------------------------------
-
- New pilot patch: *KDECWNT for DEC with Windows /NT
- New decks: INTRAC, LSTATI, TIMEL, TMPROI,
- SLEEPF.
-
- Change of options: F2C -> QF_F2C, NDP -> QF_NDP
-
- New decks: BTEST, IBCLR, IBITS, IBSET have been introduce for F2C.
- Flag QGETCWD have been introduced 16.07.93 11:32 V.E.Fine
- New seq, F2C have been introduced to compiler under F2C
-
- To provide CERNLIB's under Windows/NT and GNU-sh as well
- #ifdef WIN32
- and
- #ifder __GNUC__
- options have been introduced for C sources.
- 11-07-93 V.E.Fine CERN/JINR
-
- F2C-ish version have been introduced now 03-12-92 23:49am
- F2C-flag has been set by default.
-
- Note: F2C RSHIFT is arithmetic right shift.
- ----- This means sign bits are shifted in at the high end
-
-
- Update in PUTGET to work with SuperVGA mode 11-27-92 11:09am
- Small bug in PUTGET 09-14-92 07:34pm
----------------------------------------------------------------------
-
- First release of the KERNDOS Pam : 24 June 1992
-
----------------------------------------------------------------------
-
-C====================================================================
-#endif
diff --git a/src/packlib/kernlib/kerngen/history/kernfor/history.dat b/src/packlib/kernlib/kerngen/history/kernfor/history.dat
deleted file mode 100644
index be21f7a..0000000
--- a/src/packlib/kernlib/kerngen/history/kernfor/history.dat
+++ /dev/null
@@ -1,238 +0,0 @@
-*
-* $Id: history.dat,v 1.1.1.1 1996/02/15 17:50:43 mclareni Exp $
-*
-* $Log: history.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:50:43 mclareni
-* Kernlib
-*
-*
-* This directory was created from kernfor.car patch kernfor
-#if !defined(CERNLIB_KERNFOR)
-
-
- KERNLIB FORTRAN ROUTINES FOR ALL MACHINES
-
----------------------------------------------------------------------
-
- This file contains the following Patches
-
-
-QM... Machine type patches to select assembly options
-
-UTYGEN General Utility programs
-
-CCGEN General C routines
-CCGENCF the CF package of C routines
-CCGENU utility C routines used by CCGEN or CCGENCF
-
-XVECT XIN / XOUT routines
-
-TCGEN all standard Fortran routines for KERNLIB,
- except the ones found on KERNNUM Pam
-
-TCNUM routines inherited from KERNNUM to make sure that
- GENSEC remains complete; this is not to be used for making
- a complete KERNLIB on machines where KERNNUM is ready;
-
-TCGENR obsolete GENSEC routines
-
----------------------------------------------------------------------
-
- The following Patch-names may be used with IF-parameters
- on Patchy control-cards for conditional assembly
-
-
-Computer types
---------------
-
- QMNNB32 for an unknown 32-bit machine
-
- QMALT Alliant
- QMAMX Amiga Unix
-
- QMAPO Apollo
- QMAPO10 Apollo DPS 10000
-
- QMCDCV CDC 6000/7000/Cyber with Fortran 5
- QMCDC CDC 6000/7000/Cyber with Fortran 4
-
- QMDOS MS-DOS and Windows/NT
-
- QMCRY CRAY systems COS or UNICOS
- QMCRU CRAY system UNICOS only
-
- QMCV64 Convex 64-bit mode
- QMCV32 Convex 32-bit mode
- QMCVX Convex either mode
-
- QMDGE Data General, ECLIPSE
- QMHPX Hewlett Packard HP Unix
-
- QMIBM IBM 360 / 370
- QMIBMVF IBM Vector facility
- QMIBMXA IBM Xtended Adressing
-
- QMIBX IBM 3090 with system AIX
- QMIRT IBM / RT and 6000 with xlf compiler
-
- QMND3 NORD 500
- QMNXT Next
- QMOS9 Microware OS-9
- QMPDP DEC PDP 10
-
- QMSGI Silicon Graphics
- QMSUN SUN
-
- QMTMO Transputer with Meiko compiler
- QMUNI UNIVAC 1100 with earlier compilers
- QMUNO UNIVAC 1100 with FTN compiler
-
- QMVAX Digital VAX
- QMVMI Digital VAX with MIPS processor - DECstation
- QMVAO Digital Alpha with OSF, + S for 32-bit
- (+ L for 64-bit later)
-Fortran dialects
-----------------
-
- QF_APO Apollo Fortran for /com/ftn
- QF_APO77 for /bin/f77
- QF_DEC DEC Fortran
- QF_F2C compilation through "f2c"
- QF_IBM IBM VS Fortran
- QF_SIEM Siemens Fortran on IBM
- QF_MSOFT Microsoft Fortran
-
-Operating systems
------------------
-
- QS_UNIX Unix
- QS_VMS for DEC system VMS
-
-Word capacity
--------------
-
- B32 number of bits in one computer word
- B36
- B48
- B60
- B64
-
- B36M 36 bits or more per word
- B48M
- B60M
-
- A4 number of characters in 1 computer word
- A5
- A6
- A8
- A10
-
- A5M 5 characters or more per word
- A6M
- A8M
-
-Other computer or Fortran features
-----------------------------------
-
- QASCII Character set is ASCII
- QEBCDIC Character set is EBCDIC
-
- QIEEE Floating point representation is IEEE
-
- QISASTD ISA standard intrinsic functions available :
- IAND, IOR, NOT, ISHFT
- QMILSTD MIL standard intrinsic functions available :
- IBITS, MVBITS, ISHFTC
-
- QHOLL Hollerith constants exist
- EQUHOLCH EQUIVALENCE Hollerith/Character ok
- QORTHOLL orthodox Hollerith storage left to right in word
-
- QSYSBSD Unix system BSD (system 5 otherwise)
- QSIGJMP Posix sigsetjmp/siglongjmp for setjmp/longjmp
- QENVBSD BSD setenv is available
- QGETCWD BSD getwd is not available, but getcwd is available
- QSIGBSD signal handling with BSD sigvec
- QSIGPOSIX signal handling with Posix sigaction
-
- QX_SC external names are lower case with underscore
- QXNO_SC external names are lower case without underscore
- QXCAPT external names are capital
-
- QCCINDAD routine entry adr are passed double indirect
- in Fortran calls (needed in C routines)
-
- INTDOUBL use double precision for some internal calculations
- (used at present only in the TR routines)
-
- QINTCOPY copy vectors as integers (in UCOPY et al.)
-
- NOSHIFT left/right shift is not available,
- sequence Q$SHIFT cannot be defined
-
- HEX dumps must be done in hexadecimal representation
- else: dumps are in octal
-
- ENTRET multiple entry functions must return by entry name
- else: return by function name works ok
-
- ENTRCDC CDC Fortran 4 syntax for ENTRY statement
- else: ENTRY statement contains argument list
-
-Flags inherited from KENRNUM - only used in P=TCNUM
-----------------------------
-
- NUMLOPRE floating point precision for 32-bit machines
-
- NUMHIPRE =-NUMLOPRE
-
- NUME293 maximum exponent = 10**293
-
- NUME75 maximum exponent = 10**75
-
- NUME38 maximum exponent = 10**38
-
-
-The USE-selection of the machine-type is done on the
-KERNLIB Pam-file of the particular machine;
-the selection of the others is done by the machine-type patch
-on the present Pam.
-
----------------------------------------------------------------------
-
-KERNLIB routines in machine language or otherwise special
-for individual machines are found on the following PAM-files:
-
- KERNALT for Alliant
- KERNAPO for APOLLO
- KERNCDC for CDC 7600 / 6000
- KERNCRY for CRAY RESEARCH INC.
- KERNCVX for Convex
- KERNDGE for DATA GENERAL
- KERNHPX for HP Unix
- KERNIBM for IBM 3090 with systems MVS or VM
- KERNIBX for IBM 3090 with system AIX
- KERNIRT for IBM / RT
- KERNNOR for NORD 500
- KERNOS9 for Microware OS-9
- KERNPDP for DEC PDP 10
- KERNSGI for Silicon Graphics
- KERNSUN for SUN
- KERNTMO for Transputer with Meiko compiler
- KERNUNI for UNIVAC 1100 SERIES
- KERNVAX for Digital VAX 11
- KERNVMI for Digital VAX with MIPS processor
- KERNDOS for MSDOS and Windows/NT
-
-These contain also the deletes of the unwanted Fortran routines,
-and hence must pass trough YPATCHY just before the present Pam.
-
----------------------------------------------------------------------
-
-A program to test a large number of the KERNLIB routines is
-found on a separate Pam-file :
-
- MICKY test program, verify expected results
-
-=====================================================================
-#endif
diff --git a/src/packlib/kernlib/kerngen/history/kernfor/previous.dat b/src/packlib/kernlib/kerngen/history/kernfor/previous.dat
deleted file mode 100644
index c3f6e90..0000000
--- a/src/packlib/kernlib/kerngen/history/kernfor/previous.dat
+++ /dev/null
@@ -1,664 +0,0 @@
-*
-* $Id: previous.dat,v 1.1.1.1 1996/02/15 17:50:43 mclareni Exp $
-*
-* $Log: previous.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:50:43 mclareni
-* Kernlib
-*
-*
-#if !defined(CERNLIB_KERNFOR)
-
-UP-DATE 4.41 : 24-Jan-1995
-----------------------------
-
-Replacing file KERNFOR 4.40 940929 16.15
-
-Correct: p=TCGEN, D=CCOSUB,CENVIR bug if overflow
- p=CCGEN, D=TMREAD return NCH also if failure
- use posix version of SIGNALF on SUN
-
----------------------------------------------------------------------
-
-UP-DATE 4.40 : 29-Sept-1994
-----------------------------
-
-Replacing file KERNFOR 4.39 940322 12.57
-
-New patches: P=*KUUX pilot for an Unknown Unix machine
- P=QMOS9 for Microware OS-9
- P=P5_CC, P5_CI, P5BOOT for Patchy bootstrap export
-
-New option: P=QINTCOPY copy vectors as integers
- P=QINTZERO zero vectors as integers
-
-Correct: p=TCGEN, D=UCOPY et al. copy integers if QINTCOPY
- D=UZERO,VZERO zero integers if QINTZERO
- D=ICNUMU underscore alphabetic, not numeric
- D=FCASPLIT correct for LINUX
- p=CCGEN,d=JUMPXN, JUMPTN extend to 9 parameters
-
----------------------------------------------------------------------
-
-UP-DATE 4.39 : 28-Feb-1994
-----------------------------
-
-Replacing file KERNFOR 4.38 931110 15.04
-
-New Decks: P=TCGEN, D=ICEQU test equality
- D=CCOSUB copy with token substitution
- D=CENVIR environment variables subst
- P=CCGEN, D=EXITF to exit with status code
- P=TCGEN, D=EXITF
- P=TCGEN, D=ACCESSF
-
-Correct: P=UTYGEN, D=FCASPLIT to allow long commands (VAX)
- P=UTYGEN, D=XBANNER use GETARG on all machines
- P=CCGENCI, D=CIOPEI to have default permissions 644
- P=CCGENCF include-file for the VAX
- P=TCGEN, D=GSHOWF to have the "what"-identifier
- P=TCGEN, D=CCOPYL, CCOPYR, CCOPIV bug for NCH=0
- P=CCGEN, D=INTRAC,LSTATI,TIMEL remove material for MS-DOS
- (put it on KERNDOS)
-
- P=UTYGEN, D=FCASPLIT to implement Windows/NT
- P=CCGEN, D=TMPROI
-
-Change: P=QMCVX -> QMCV64
- P=QMCVY -> QMCV32
-
-Delete: P=CCGEN, D=LONGJMP obsolete
-
-Delete use: P=TCGEN, D=SETFMT,SORTX obsolete
- D=UFLINT,UHOLLR,MATIN1
- D=MXEQU,POWEZE,SMXINV
-
-New patch: P=CCGENCX re-organize usage of CCGENCI and CF
-
-New options: P=QF_DEC, QF_F2C, QF_MSOFT Fortran dialects
- P=QF_IBM instead of old QMIBMFVS
- P=QF_SIEM old QMIBMFSI (Siemens)
-
- P=QS_UNIX operating system is UNIX
-
----------------------------------------------------------------------
-
-UP-DATE 4.38 : 8-Nov-1993
-----------------------------
-
-Replacing file KERNFOR 4.37 931103 12.20
-
-New Decks: P=TCGEN, D=ICNUMU
-
-Correct: P=CCGEN, D=TIMEL include system time counting
- P=CCGEN, D=SIGNALF for signal handling under
- MSDOS with Gcc compiler
- P=CCGEN, D=CHDIRI, GETWDI, INTRAC, TIMEL, STATI,
- D=GETGIDF, GETPIDF, GETUIDF, LSTATI.
- to compile with MSC under Windows/NT
- P=CCGENCF, D=CFOPEI,
- P=CCGENCI, D=CIOPEI.
-
- P=UTYGEN, D=FCASPLIT to write 0 char. for blank lines
-
----------------------------------------------------------------------
-
-UP-DATE 4.37 : 1-July-1993
-----------------------------
-
-Replacing file KERNFOR 4.36 930609 17.40
-
-Correct: P=CCGENCI, D=CIGET,CIPUT VAX: parameter by descriptor
- P=CCGENCF, D=. adapt include file for Posix
- P=CCGEN, D=STATF, STATI mod. for VAX
- D=ACCESSF, ACCESI
- D=TMINIT, TMPRO, TMPROI, TMREAD
-
----------------------------------------------------------------------
-
-UP-DATE 4.36 : 2-June-1993
-----------------------------
-
-Replacing file KERNFOR 4.35 930318 15.53
-
-New patch: P=QMVAOS for VAX Alpha with OSF, 32-bit
-
-New Decks: P=CCGEN, D=GETGIDF, GETUIDF
- P=CCGEN, D=LSTATF, LSTATI
- P=CCGEN, D=READLNF, READLNI
- P=CCGEN, D=SETENVF, SETENVBSD, SETENVSY5
- P=CCGEN, D=SIGBSD, SIGPOSIX for signal handling
- P=TCGEN, D=ICINQ, ICINQL, ICINQU
-
-Correct: P=TCGEN, D=CSETVI,CSETVM improve error indication
- P=TCGEN, D=ICNTH,/L,/U variable array size problem
- P=UTYGEN, D=FCASPLIT
- P=CCGEN change 'long' to 'int' everywhere
- P=CCGEN, D=JUMPXN
- P=CCGEN, D=TIMEL use resource limits
-
----------------------------------------------------------------------
-
-UP-DATE 4.35 : 8-Mar-1993
-----------------------------
-
-Replacing file KERNFOR 4.34 930112 19.54
-
-New Decks : P=TCGEN, D=CCOPIV, CSETVI, CSETVM
-
-Correct : P=TCGEN,D=ICHEXI,ICOCTI,NCHEXI,NCOCTI use shift
-
-Delete : P=CCGEN, D=TMNBUF, TMPROM obsolete
-
----------------------------------------------------------------------
-
-UP-DATE 4.34 : 12-Jan-1993
-----------------------------
-
-Replacing file KERNFOR 4.33 920703 12.04
-
-New Decks : P=CCGEN, D=ACCESSF,ACCESI
- P=TCGEN, D=UNLINKF Fortran default
-
-Correct : P=TCGEN,D=LOCF bug in Fortran default
-
- P=CCGEN, D=DATIME,DATIMH,JUMPXN,JUMPTN
- P=CCGENCF, D=CFPERM
- P=CCGENCI, D=CIPERM correct handling of externals
-
----------------------------------------------------------------------
-
-UP-DATE 4.33 : 11-May-1992
-----------------------------
-
-Replacing file KERNFOR 4.32 920229 19.42
-
-New Decks : P=TCGEN, D=CSETOI, ICOCTI, NCDECI, NCHEXI, NCOCTI
- P=CCGENCF, D=CFPERM to set permissions
- P=CCGENCI, D=CIPERM to set permissions
-
-Correct : FCASPLIT add -O option for cc
- add char-length options for IBM
- Apollo with f77
- P=CCGENCF, D=CFOPEI to use permissions
- P=CCGENCI, D=CIOPEI to use permissions
- P=TCGEN, D=ICNTH, ICNTHL, ICNTHU fix a bug
-
----------------------------------------------------------------------
-
-UP-DATE 4.32 : 29-Feb-1992
-----------------------------
-
-Replacing file KERNFOR 4.31 911113 18.15
-
-New Decks : P=TCGEN, D=CCOPYL, CCOPYR copy character strings
-
-Correct : GMTIMEF for Apollo
- FCASPLIT correct format statement
- Fortran options for Apollo
- CIOPEN of P=CCGENCI remove message
-
----------------------------------------------------------------------
-
-UP-DATE 4.31 : 11-Nov-1991
-----------------------------
-
-Replacing file KERNFOR 4.30 910816 12.23
-
-New Patch : P=CCGENCI new CIOPACK
-
-New Decks : P=TCGEN, D=IUWEED to find infinite
- P=CCGEN, D=UNLINKF C interface
-
-Correct : XBANNER single banner page
- XINB,XINBF,XINBS return IOSTAT code
- ABEND in CCGEN + TCGEN set return-code 7
- BLOW,BUNCH missing DIMENSION
- CSETHI use mask + shift
-
----------------------------------------------------------------------
-
-UP-DATE 4.30 : 19-Aug-1991
-----------------------------
-
-Replacing file KERNFOR 4.29 910731 19.17
-
-New machine: CVY for Convex 32-bit mode
-
-Correct : default UBLOW and UBUNCH (for Convex)
- FCASPLIT add new options
- XBANNER (for Convex)
- CCGENCF (include-files for Cray)
-
----------------------------------------------------------------------
-
-UP-DATE 4.29 : 18-July-1991
-----------------------------
-
-Replacing file KERNFOR 4.28 910513 21.11
-
-New flag QSIGJMP to use posix version of setjmp/longjmp
-New default sequence LUNSTP for standard output printing
-
-Change patch names : QMIBMSI --> QMIBMFSI Fortran Siemens
- QMIBMVS --> QMIBMFVS Fortran VS
-
-New Patch : P=PROJSHIFT for the SHIFT project
- P=QMAMX for Amiga Unix
-
-New Decks : P=CCGEN, D=JMPSET, JMPLONG for setjmp/longjmp
- P=CCGEN, D=TMINIT to initialize TM
- P=CCGEN, D=TMPRO, TMPROI to print a prompt
- P=TCGEN, D=CKRACK
-
-Correct : P=CCGEN, D=QNEXTE use posix
- P=CCGEN, D=QNEXTE remove undocumented feature
- P=CCGEN, D=LOCF use shift, not division
- P=CCGENCF re-organize include-files
- P=TCGEN, D=KERNGT,GSHOWF handle LUN=0
- CSETDI, CSETHI small correction for NGSLAT
-
-Obsolete : P=CCGEN, D=SETJMPF, LONGJMP, TMPROM
-
----------------------------------------------------------------------
-
-UP-DATE 4.28 : 13-May-1991
-----------------------------
-
-Replacing file KERNFOR 4.27 910426 11.31
-
-Correct : P=CCGENCF, D=CFOPEI fix bug
-
----------------------------------------------------------------------
-
-UP-DATE 4.27 : 26-Apr-1991
-----------------------------
-
-Replacing file KERNFOR 4.26 910319 0.10
-
-Correct : P=CCGENCF re-write
- P=CCGEN, D=QNEXTE,TIMEL change name of variable init
-
----------------------------------------------------------------------
-
-UP-DATE 4.26 : 13-Mar-1991
-----------------------------
-
-Replacing file KERNFOR 4.25 901023 10.53
-
-New Patches : P=CCGENCF CF routines in C
- P=CCGENU C utilities
- P=QMHPX for HP UNIX
-
-New Decks : P=CCGEN : Fortran interfaces
- D=CHDIRF, GETENVF, GETPIDF, GETWDF, KILLF
- D=PERRORF, RENAMEF, SIGNALF, SLEEPF, STATF, SYSTEMF
- D=CTIMEF, GMTIMEF
-
- P=CCGEN, D=JUMPTN new routine
- P=TCGEN, D=CFWEOF, FFSIZE dummy routines
-
-Correct : P=CCGEN new flags QX_SC, QXNO_SC, QXCAPT
- D=FCASPLIT, XBANNER add HPX
- D=UCOPY2 bug for SGI for N=1
-
----------------------------------------------------------------------
-
-UP-DATE 4.25 : 22-Oct-1990
-----------------------------
-
-Replacing file KERNFOR 4.24 900423 19.05
-
-New Decks : P=UTYGEN, D=XBANNER
- P=CCGEN, D=TMNBUF, TMPROM, TMREAD
-
-Correct : RANECUSQ, RANECU, RANECQ for QMIBX
- FCASPLIT for QMIRT, QMVMI
-
----------------------------------------------------------------------
-
-UP-DATE 4.24 : 24-Apr-1990
-----------------------------
-
-Replacing file KERNFOR 4.23 891215 15.17
-
-New Patches : UTYGEN general utility programs
- QMIBX for IBM 3090 with AIX
- QMSGI name change from QMSIG
-
-New Decks : LONGJMP of P=CCGEN
- CSQMCH, CTRANS, ICHEXI of CHPACK
-
-Correct : INTRAC, JUMPXN, TIMEL of P=CCGEN
-
----------------------------------------------------------------------
-
-UP-DATE 4.23 : 15-Dec-1989
-----------------------------
-
-Replacing file KERNFOR 4.22 890913 21.13
-
-New Patches : CCGEN general C routines
- QDEFAULT default setting of options
- Q$BITSEQ standard sequences Q$JBIT etc
- QMSGI for Silicon Graphics
- QMMPW for MAC II
-
-New Decks : CSETHI, ICTYPE of CHPACK
- RNDM a default for 32-bit, IEEE machines
- LOCB a default working on several machines
- ABEND a dummy default
- JUMPXN a dummy default
- TRACEQX the old TRACEQ for CDC,PDP,UNIVAC
- TRACEQ a dummy default
- JOBNAM a dummy default
-
-Correct : Introduce the new QISASTD / QMILSTD options in :
- CBYT, JBIT, JBYT, JBYTET, JBYTOR
- MBYTET, MBYTOR, MCBYT, MSBIT, MSBIT0, MSBIT1, MSBYT
- SBIT, SBIT0, SBIT1, SBYT, SBYTOR
- PKBYT, UPKBYT
-
- IUFORW for ASCII machines
- CHTOI, ITOCH new version for ASCII machines
-
- Turn into usable defaults :
- LOCF, UBLOW, UBUNCH
- FLOARG, INTARG, IUMODE, UFLINT
-
----------------------------------------------------------------------
-
-UP-DATE 4.22 : 13-Sep-1989
-----------------------------
-
-Replacing file KERNFOR 4.21 890323 13.28
-
-New Decks : CSQMBL, ICLOCL of CHPACK
- VIZPRI visual printing routine
-
-Correct : ICDECI NGSLAT=0 also if terminated by blank
- DATIME (dummy) to load /SLATE/
-
----------------------------------------------------------------------
-
-UP-DATE 4.21 : 23-mar-1989
-----------------------------
-
-Replacing file KERNFOR 4.20 881028 16.01
-
-New Patches : P=QMCVX machine patch for Convex
- P=QMTMO machine patch for Transputer
- P=QMVMI machine patch for VAX with MIPS proc.
-
-New Decks : KERNGT, SORTR, SORTD, SORTI
- LVSMI, LVSMX, LVSDMI, LVSDMX, LVSIMI, LVSIMX
- RANMAR and subsidiary
- RANECU and subsidiary
- CFILL, CLEFT, CRIGHT, CSETDI
- ICDECI, ICFIND, ICFMUL, ICFILA, ICFNBL
- ICLOC, ICLOCU, ICLUNS, ICNEXT
- ICNTH, ICNTHL, ICNTHU, ICNUM, ICNUMA, LNBLNK
-
-Correct : CLTOU, CUTOL speed up
- LENOCC speed up
- ATG, PROXIM re-written
- many change dummy DIMENSION A(2) -> A(*)
- for speed with some compilers
- change ALOG, ALOG10, MIN0, MAX0 etc
- to LOG, LOG10, MIN, MAX etc
- JBIT,JBYT,JBYTET,JBYTOR true defaults
- SBIT,SBIT0,SBIT1,SBYTOR true defaults
- UCTOH,UCTOH1,UHTOC,UH1TOC true defaults
- MBYTET,MBYTOR,MCBYT,MSBIT/0/1,MSBYT new defaults
- PKBYT,UPKBYT new defaults
- remove the dependency on the F77 option
-
----------------------------------------------------------------------
-
-UP-DATE 4.20 : 28-oct-1988
-----------------------------
-
-Replacing file KERNFOR 4.19 880728 17.19
-
-New Patch : P=QMSUN machine patch for SUN
-
-Correct : MBYTOR correct (fatal) typing error
- PKCHAR,UPKCH,UCTOH1,UCTOH,UH1TOC,UHTOC
- avoid variable names CHAR,ICHAR,INT
-
----------------------------------------------------------------------
-
-UP-DATE 4.19 : 28-JUL-1988
-----------------------------
-
-Replacing file KERNFOR 4.18 880425 20.38
-
-New Decks : D=NOARG dummy version
-
-New Patch : P=QMALT machine patch for Alliant
-
-Correct : IULAST use reverse loop
- XINB, XINBS clean up
-
----------------------------------------------------------------------
-
-UP-DATE 4.18 : 25-APR-1988
-----------------------------
-
-Replacing file KERNFOR 4.17 870922 23.17
-
-New Decks : D=IUCOLA, IUFILA
-
-Corrections : D=RANNOR test on zero
- D=CFROMI fix problem
-
- D=PKCHAR,UHOLLR,UOPT,UPKCH,UTRANS
- use PARAMETER instead of DATA statem.
-
----------------------------------------------------------------------
-
-UP-DATE 4.17 : 22-SEP-1987
-----------------------------
-
-Replacing file KERNFOR 4.16 870601 15.46
-
-Corrections : P=TCGEN, D=SBYTOR to use IOR
- D=PKCHAR,UHOLLR,UOPT,UPKCH,UTRANS
- change local variables to standard names
-
----------------------------------------------------------------------
-
-UP-DATE 4.16 : 1-JUNE-1987
-----------------------------
-
-Replacing file KERNFOR 4.15 861204 21.05
-
-New Decks : P=TCGEN, D=JBYTOR, MBYTET, MBYTOR, MCBYT
- D=MSBIT, MSBIT0, MSBIT1, MSBYT
- D=BITPOS, IBITS, ISHFTC, MVBITS
-
-Corrections : P=TCGEN, D=JBYTET to use IAND
- D=VZERO to set integer zero
- D=TRCHLU,TRCHUL to use DSQRT if necc.
-
- Remove material specific to NORD 50 and CII SIGMA
- from the KERNLIB Pam-files
-
----------------------------------------------------------------------
-
-UP-DATE 4.15 : 4-DEC-1986
-----------------------------
-
-Replacing file KERNFOR 4.14 860514 15.32
-
-New Decks : P=TCGEN, D=IE3FOD, IE3FOS, IE3TOD, IE3TOS
-
-Corrections : P=TCGEN : TR-Package : use some internal double prec.
-
----------------------------------------------------------------------
-
-UP-DATE 4.14 : 14-MAY-1986
-----------------------------
-
-Replacing file KERNFOR 4.13 860226 9.52
-
-New Decks : P=TCGEN, D=CLTOU, CUTOL
-
----------------------------------------------------------------------
-
-UP-DATE 4.13 : 26-FEB-1986
-----------------------------
-
-Replacing file KERNFOR 4.12 850702 17.48
-
-New Decks : P=TCGEN, D=CFROMI, IFROMC
-
----------------------------------------------------------------------
-
-UP-DATE 4.12 : 2-JULY-1985
-----------------------------
-
-Replacing file KERNFOR 4.11 850529 14.35
-
-New Deck : P=TCGEN, D=VLINCO routine VLINE with new name
- to avoid clash
- with the VERSATEC Library
-
----------------------------------------------------------------------
-
-UP-DATE 4.11 : 29-MAY-1985
-----------------------------
-
-Replacing file KERNFOR 4.10 850326 18.37
-
-Corrections : P=XVECT, D=XINB, XINBS ADD F77 MODE, TO LIMIT
- P=TCGEN, D=CHTOI ADD F77 FLAG ON DECK
- P=TCGEN, D=TIMEL STANDARD DUMMY TIME =9999
-
----------------------------------------------------------------------
-
-UP-DATE 4.10 : 20-MAR-1985
-----------------------------
-
-Replacing file KERNFOR 4.09 840827 17.04
-
-New Decks : P=TCGEN, D=UOPTC CHAR. VERSION OF UOPT
- P=TCGEN, D=LENOCC CHAR LENGTH OCCUPIED
- P=TCGEN, D=INTRAC,TIMEST GENERAL DUMMIES
-Corrections : P=TCGEN, D=CHTOI CHANGE CHARACTER SET
-
----------------------------------------------------------------------
-
-UP-DATE 4.09 : 27-AUG-1984
-----------------------------
-
-Replacing file KERNFOR 4.08 840613 20.50
-
-New Deck : P=TCGEN, D=QNEXTE FOR 'NEXT EVENT'
-
----------------------------------------------------------------------
-
-UP-DATE 4.08 : 13-JUN-1984
-----------------------------
-
-Replacing file KERNFOR 4.07 830704 20.54
-
-New Patch : P=QMAPO FOR THE APOLLO
-
-New Decks : P=TCGEN, D=CHTOI, SORCHA F 77 ONLY
-
-Tidy up : P=TCGEN, D=PKBYT, UPKBYT for ease of conversion
-
-Correction : P=TCGEN, D=IUBACK,IUFORW,IUNEXT,SETFMT CLEAN DATA
- D=UBLANK,ULEFT,URIGHT,USET,VBLANK
-
----------------------------------------------------------------------
-
-UP-DATE 4.07 : 24-JUN-1983 RE-DONE : 4-JULY-83
-----------------------------
-
-Replacing file KERNFOR 4.06 830526 19.53
-
-Add sequence calls Q$JBIT for statement functions JBIT + JBYT
-
-Correction : P=TCGEN, D=LOREN4 FAULTY USE OF DSQRT IF=B48M
-
----------------------------------------------------------------------
-
-UP-DATE 4.06 : 26-MAY-1983
-----------------------------
-
-Replacing file KERNFOR 4.05 821202 23.47
-
-READY CONDITIONALS FOR 64 BITS (B64)
-
-New Patch : P=QMCRY FOR THE CRAY
-
-Corrections: P=TCGEN, D=FLOARG,INTARG,IUMODE,UFLINT ADD IF=QMCRY
- JBYTPK,SBYTPK ADD IF=B64
- PKBYT,UPKBYT,PKCHAR,UPKCH
-
- D=VDIST FIX FOR BUG IN CDC F77 COMPILER
-
----------------------------------------------------------------------
-
-UP-DATE 4.05 : 2-DEC-1982
-----------------------------
-
-Replacing file KERNFOR 4.04 821124 21.28
-
-Corrections: P=TCGEN, D=TIMED,TIMEL,TIMX (DUMMY ROUTINES) BUG FIXED
-
----------------------------------------------------------------------
-
-UP-DATE 4.04 : 24-NOV-1982
-----------------------------
-
-Replacing file KERNFOR 4.03 821008 12.19
-
-New Patch : P=TCNUM
-
-Corrections: P=TCGEN, D=LORENB,LORENF,LOREN4
- INTERNALLY DOUBLE PREC. ON 32-BIT MACHINES
-
-Deletions : P=TCGEN, D=ERF,FREQ,FINT,PROB
- THE OFFICIAL SOURCE IS NOW ON KERNNUM
- TO BE SURE THEY ARE PRESENT AND WORKING
- COPIES ARE KEPT IN P=TCNUM
-
----------------------------------------------------------------------
-
-UP-DATE 4.03 : 8-OCT-1982
-----------------------------
-
-Replacing file KERNFOR 4.02 820801 12.00
-
-New Decks : P=TCGEN - DUMMIES FOR ROUTINES TO BE SPECIALLY WRITTEN
- JBIT, JBYT, LOCF, SBIT, SBYT, UBLOW, UBUNCH
- DATIME, DATIMH, TIMED, TIMEL, TIMEX
-
----------------------------------------------------------------------
-
-UP-DATE 4.02 : 23-JUL-1982
-----------------------------
-
-Replacing file KERNFOR 4.01 820528 12.54
-
-New Patch : P=QMHRR MACHINE PATCH FOR THE HARRIS COMPUTER
-
-New Decks : P=TCGEN, D=FLOARG, INTARG
-
-Corrections: P=TCGEN, D=FINT NEW VERSION
-
----------------------------------------------------------------------
-
-UP-DATE 4.01 : 28-MAY-1982
-----------------------------
-
-Replacing file KERNFOR 4.00 820401 12.00
-
-Corrections : P=TCGEN, D= JBYTET, SBYTOR
- NON-ANSI DEFAULTS BROUGHT BACK
-
----------------------------------------------------------------------
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/history/kernfor/update.dat b/src/packlib/kernlib/kerngen/history/kernfor/update.dat
deleted file mode 100644
index c8c20cf..0000000
--- a/src/packlib/kernlib/kerngen/history/kernfor/update.dat
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: update.dat,v 1.1.1.1 1996/02/15 17:50:42 mclareni Exp $
-*
-* $Log: update.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:50:42 mclareni
-* Kernlib
-*
-*
-#if !defined(CERNLIB_KERNFOR)
-
-
- UP-DATE RECORD FOR THE PAM-FILE KERNFOR, VERSION 4
- ---------------------------------------------------
-
-
-UP-DATE 4.42 : 11-Oct-1995
-----------------------------
-
-Replacing file KERNFOR 4.41 950124 14.37
-
-New Decks: P=CCGEN, D=VXINVB, VXINVC C version of byte-swop
- D=SIGUNBL,SIGPRNT for signal handling
-
-Delete: p=TCGEN, D=ATG is now in mathlib
-
----------------------------------------------------------------------
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/history/kernfor/updvs200.dat b/src/packlib/kernlib/kerngen/history/kernfor/updvs200.dat
deleted file mode 100644
index 11e8e20..0000000
--- a/src/packlib/kernlib/kerngen/history/kernfor/updvs200.dat
+++ /dev/null
@@ -1,348 +0,0 @@
-*
-* $Id: updvs200.dat,v 1.1.1.1 1996/02/15 17:50:43 mclareni Exp $
-*
-* $Log: updvs200.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:50:43 mclareni
-* Kernlib
-*
-*
-#if !defined(CERNLIB_KERNFOR)
-C-
----------------------------------------------------------------------
-HISTORY OF GENERAL SECTION VERSIONS 2.00 - 2.14
----------------------------------------------------------------------
-C-
-C- CHANGES 07/07/72 FOR VERSION 2.00
-C-
-C-
-C- 1. NEW PATCH PDP10
-C- 2. PATCH TCGEN REPLACES PATCH TCGEN1
-C- 3. PATCH TCGENR REPLACES PATCH TCGEN2
-C- 4. FOLLOWING DECKS PREVIOUSLY IN TCGEN1 NOW IN TCGENR
-C- BCDWD - DIGITIN - DIRCOS - DIST - DOT - DOTNOR - ERPRIP -
-C- IFORMT - IPACK - JTH - JTH10 - JTHN - MOVE - PRIPAR - STORE -
-C- STOREN
-C- 5. FOLLOWING DECKS PREVIOUSLY IN TCGE2 NOW IN TCGEN
-C- STRAG - VOMAS - VOTAUF
-C- 6. MINOR CHANGES TO FOLLOWING DECKS
-C- PATCH TCGEN
-C- JBYTET - MXMLRT - SBYTOR - SETFMT - TCDUMP - UBLANK - VDOTN
-C- PATCH TCGENR
-C- ICRD
-C- 7. NEW DECK (TCGEN) - VDOTN2 - PKCHAR - UPKCH
-C- 8. FOLLOWING DECKS DELETED FROM PATCH CDCFTN
-C- JTH - JTH1 - JTHB - MOVE - STOREB - STORE1 - STORE6 - UBLOW1 -
-C- UBNCH1
-C- 9. FOLLOWING DECKS DELETED FROM PATCH CDC60
-C- JTH - JTH10 - MOVE - STORE6 - STORETC - UBLOW1 - UBNCH1
-C- 10. FOLLOWING DECKS DELETED FROM PATCH CDC38
-C- JTH - JTH1 - JTH10 - MOVE - STORE6
-C- 11. FOLLOWING DECKS DELETED FROM PATCH IBM360
-C- ICRD - JTH - MOVE - STORE - UBLOW1 - UBNCH1 - JTH1 - JTHB -
-C- STORE1 - STOREB
-C- 12. FOLLOWING DECKS DELETED FROM PATCH IBM7000
-C- DIGITIN - DIST - DOT - DOTNOR - ICRD - IUNME - REMARK - STORE
-C- - JTH6 - FXEM
-C-
-C--------------------------------------------------------------------
-C-
-C-
-C- CHANGES 10/10/72 FOR VERSION 2.01
-C-
-C-
-C- 0. DECKS TOUCHED IN TCGEN
-C- ACOS - AFROMI - ERF - IUBIN - IUCHAN - IUHIST - PAROFI -
-C- VOMAS
-C- DECKS TOUCHED IN TCGENR
-C- DIGITN - DOTNOR - IBAD - ICRD - JTH - PTOR - ZFIELD
-C- DECKS TOUCHED IN IBM360
-C- IUCOMP - UBLANK (DELETED) - UBLOW - UBLUBU
-C-
-C- 1. FUNCTIONS WITH MULTIPLE ENTRY POINTS CORRECTED FOR IBM360
-C-
-C- 2. OVERFLOW TROUBLE IN IUBIN - IUCHAN - IUHIST CORRECTED
-C-
-C- 3. PATCH IBM360. BUGS IN IUCOMP - UBLOW - UBLUBU CORRECTED.
-C- UBLANK DELETED.
-C-
-C- 4. PROBLEMS
-C- UCOPYN IN FORTRAN MUST BE CALLED WITH REAL ARGUMENTS ONLY.
-C- IOFMAS MUST BE IN ASSEMBLER FOR IBM 360 SERIES MACHINES
-C- IBM 360 ASSEMBLER ROUTINES IUBIN - IUCHAN - MXMPY2 WORK BADLY.
-C- NEW IBM 360 ASSEMBLER ROUTINES FOR VOMAS - IUBIN - IUCHAN -
-C- MXMPY2 - (PAROFI) - UCOPYN IN PREPARATION.
-C-
-C--------------------------------------------------------------------
-C-
-C-
-C- CHANGES 25/01/73 FOR VERSION 2.02
-C-
-C-
-C- 1. DECKS TOUCHED IN TCGEN
-C- ACOS - AFROMI - CBYT - CROSS - JBYTET - SBYTOR - TCDUMP
-C- SMALL BUGS CORRECTED
-C-
-C- 2. NEW PATCH PDP10F (PDP10 FORTRAN)
-C-
-C- 3. P=PDP10. DECK TRCBQ REPLACED. DECK TRACBQ MOOVED TO PDP10F.
-C-
-C- 4. P=CDC60. NEW DECKS LOCBYT - PKCHAR - UPKCH.
-C-
-C- 5. P=CDCFTN. NEW DECKS LOCBYT - PKCHAR - UPKCH.
-C-
-C--------------------------------------------------------------------
-C-
-C-
-C- CHANGES 01/04/73 FOR VERSION 2.03
-C-
-C-
-C- 1. P=TCGEN.
-C- -- ACOS - AFROMI PAROFI - VOMAS CHANGED FOR COMPATIBILITY
-C- -- NEW ROUTINE VCOPYN TO SUPPLY UCOPYN.
-C- UCOPYN FOR INTEGERS ONLY, VCOPYN FOR FLOATING POINT VALUES.
-C- -- FORTRAN VERSIONS OF JBYTET AND SBYTOR SHOULD NOT BE USED
-C- WHENEVER THE CORRESPONDING ROUTINE EXISTS IN ASSEMBLER CODE
-C-
-C- 2. P=TCGENR.
-C- -- DIGITN - ICRD CHANGED FOR COMPATIBILITY.
-C-
-C- 3. P=X6000.
-C- -- XTPCH NOW CONTAINS REWIND(IT)
-C-
-C- 4. P=PDP10F.
-C- -- SEQUENCE PDP10F FOR COMMENTS.
-C- -- FREQ REPLACED.
-C-
-C- 5. P=PDP10.
-C- -- SEQUENCE PDP10 FOR COMMENTS.
-C- -- 'END' REPLACED BY 'PRGEND'
-C- -- BLANK CARDS SUPPRESSED.
-C- -- NEW DECKS = PKCHAR - UPKCH - ZLATE
-C- -- DECKS IN ALPHABETIC ORDER
-C-
-C- 6. P=UNI1100.
-C- -- BUG IN IUCOMP CORRECTED.
-C-
-C- 7. P=IBM360.
-C- -- BUGS IN IUBIN - IUCOMP - MXEQU - MXMPY2 CORRECTED
-C-
----------------------------------------------------------------------
-C-
-C-
-C- CHANGES 25/07/73 FOR VERSION 2.04
-C-
-C-
-C- 1. P=TCGEN.
-C- -- UCOPYN MISS PUNCH CORRECTED.
-C-
-C- 2. PILOT PATCHES FOR CDC - IBM - PDP - UNIVAC.
-C-
----------------------------------------------------------------------
-C-
-C-
-C- CHANGES 25/08/73 FOR VERSION 2.05
-C-
-C-
-C- 1) NEW ROUTINES
-C----------------
-C-
-C- P=TCGEN, D=TRACEQ.
-C- P=CDCFTN, D=ABEND, CBYT, INCBYT, IUFIND, JBYTET, JBYTPK, JRSBYT,
-C- SBYTOR, SBYTPK, TRAC1Q.
-C- P=UNIV1100,D=TRAC1Q.
-C- P=IBM360, D=DATE, REENT.
-C- P=IBM360F, D=SORTZV, UBUNCH, UBLOW.
-C-
-C- 2) DELETED ROUTINES
-C----------------------
-C-
-C- P=CDC60, D=GSDEBUG
-C- P=IBM360, D=SORTZV, UBLOW, UBUNCH
-C--------------------------------------------------------------------
-C-
-C-
-C- CHANGES OF 11/05/74 FOR VERSION 2.06
-C-
-C-
-C- 1. P=TCGEN, D=TL... TL-PACK NEW ROUTINES.
-C- D=TX... TX-PACK NEW ROUTINES.
-C-
-C- 2. P=CDCFTN, D=ABEND SMALL CORRECTIONS
-C- D=CBYT SERIOUS BUG CORRECTION
-C- D=TRACEQ SPECIAL 7600 VERSION,NEW.
-C-
-C- 3. P=CERN7600. NEW PATCH WITH SPECIAL 7600 ML ROUTINES
-C-
-C- 4. P=CDC60, D=ABEND, CBYT, IUFIND, JBYTET, JBYTPK, JRSBYT,
-C- SBYTOR, SBYTPK. NEW ML VERSIONS
-C-
-C- 5. P=CDC38, D=CLOKZB36. NEW ROUTINE
-C-
-C- 6. P=UNI1100,D=TRAC1Q. CORRECTED
-C- D=TRACBQ, D=TRCBQQ. DELETED
-C-
-C- 7. P=SIGMA7. NEW PATCH OF ML ROUTINES FOR CII SIGMA7
-C-
-C--------------------------------------------------------------------
-C-
-C-
-C- CHANGES OF 9/10/74 FOR VERSION 2.07
-C-
-C-
-C- P=TCGEN, D=TR... TR-PACK NEW ROUTINES.
-C-
-C- P=CERN7600, D=TRAC0Q, C=63. SMALL BUG CORRECTED.
-C-
-C- P=UNI1100. NEW ML ROUTINES (FROM KOBENHAVN)
-C- ASORTZ, ERF, INTSOR, ISORTZ, IUBIN, IUCHAN,
-C- IUFIND, IUHUNT, OMSORT, PROB, SORTZV,
-C- UCOCOP, UZERO.
-C- RE-WRITTEN,HOPEFULLY FASTER, ML VERSIONS
-C- (FROM KOBENHAVN) INCBYT, IUCOMP, JBYTPK, PKBYT,
-C- SBYTPK, UCOPY, UPKBYT.
-C-
-C- P=IBM360. NEW ML ROUTINES (FROM LIVERPOOL)
-C- INCBYT, UCOPY, VFILL.
-C- RE-WRITTEN,HOPEFULLY FASTER, ML VERSIONS
-C- (FROM LIVERPOOL) IUBIN, IUCHAN, IUCOMP, IUFIND,
-C- JBIT, JBYT, SBIT, SBYT, UCOPY2,
-C- UFILL.
----------------------------------------------------------------------
-C-
-C-
-C- CHANGES OF 18/12/74 FOR VERSION 2.08
-C-
-C-
-C- P=TCGEN, D=TX... TX-PACK SUPPRESSED.
-C- D=TR... RE-WRITTEN AND NEW ROUTINES.
-C-
----------------------------------------------------------------------
-
-
- CHANGES OF 01/11/75 FOR VERSION 2.09
-
- P=TCGEN. NEW DECKS: FLTSOR,INTSOR,LORENB,LORENF,POWEZE,SORTZV
- MODIFIED DECKS: ERF,IUHUNT,TLRES,TRACEQ,VDOTN
- MOVED TO P=TCGENR: PAROFI,VOMAS,VOTAUF
-
- P=X6000,X3800,X3000S. REMOVED TO ARCHIVE (PRESUMABLY NO LONGER USED)
-
- P=XSCOPE,XSCOPE2,XSCOPE3. NEW X-PACKAGE FOR CDC6000/7000
-
- P=XUNIV. MODIFICATIONS FOR PATCHY4
-
- P=X7090. ARCHIVED
-
- P=CDCFTN. LOTS OF NEW ROUTINES
-
- P=CERN7600. NEW DECK: INCMEM
- MODIFIED DECK NAME: KFILEFTN TO KFILE
-
- P=CDC60,CDC38. ARCHIVED
-
- P=PDP10F,PDP10. NEW VERSION ON SPECIAL MINI-PAM
-
- P=UNI1100. MODIFIED DECKS: IUBIN,IUCHAN,PROB,UCOPY
-
- P=IBM360F. SUPPRESSED DECKS: UBLOW,UBUNCH
- MODIFIED DECK: SORTZV
-
- P=IBM7000. ARCHIVED
-
----------------------------------------------------------------------
-
-
- CHANGES OF 25/11/75 FOR VERSION 2.10
-
- ALL PILOT-PATCHES HAVE BEEN RE-NAMED AND RE-ORGANISED
-
- P=TCGEN, D=TRACEQ : NEW VERSION
-
- P=TCGENR, D=PAROFI,VOMAS : MODIFIED
-
- P=CDCFTN, D=ABEND,IUWEED,TRAC1Q : MOVED TO P=CDCSYS
- D=TRACEQ : DELETED
-
- P=CDC76SYS, CDC60SYS, CDCSYS : NEW PATCHES FOR CDC 7600/6000
-
- P=CERN7600, ALL REGULAR ROUTINES MOVED TO P=CDCSYS,CDC76SYS,CDC60SYS
-
----------------------------------------------------------------------
-
-
-CHANGES OF 14/03/76 FOR VERSION 2.11
-
-
-P=*GUNI, D=DELETES. CORRECTIONS
-
-P=*GIBM, D=DELETES. CORRECTIONS
-
-P=TCGEN, D=JBYTET,SBYTOR AVOID MIXED-MODE MASK STATEMENTS
-
-P=CDCFTN, D=MXADD, C=58. SERIOUS BUF FOR 7600 TIMING
-
-P=CDCSYS D=IDATZA. NEW ML-VERSION
-
-P=UNI1100, D=LOCF,TRAC1Q,UBLOW,UBUNCH, C=1. RUBBISH REMOVED
- D=JBYTET,SBYTOR AVOID MIXED-MODE MASK STATEMENTS
-
-P=IBM360, D=DATE. TROUBLESOME COMMENT CHANGED
- D=UBUNCH. DECK-NAME CHANGED FROM UBLUBU
-
----------------------------------------------------------------------
-
-
-CHANGES OF 30/04/76 FOR VERSION 2.12
-
-
-P=TCGEN, D=SORTX, STRAG, VMODUL MOVED TO P=TCGENR
-
-P=CDCFTN, D=IUHUNT, MXMLRT BUGS CORRECTED
- D=IUSAME RE-WRITE FOR INDEF. STRINGS
-
-P=CDC60SYS, D=. INCMEM SEQUENCES CHANGED FOR SCOPE 3.4.3
-
-P=CDCFTN,CDC76SYS-CDCSYS ALL CDC COMPASS ROUTINES HAVE BEEN CLEANED
- BY PROGRAM TO STANDARD ALIGNMENT TO IMPROVE
- READABILITY. THE OBJECT DECKS BEFORE & AFT
- HAVE BEEN CHECKED FOR IDENTITY BIT-FOR-BIT
-
----------------------------------------------------------------------
-
-
-CHANGES OF 1/07/76 FOR VERSION 2.13
-
-
-P=*GCDC, D=DELETES, C=2. TAKE ACOS ETC. FROM SYSTEM LIBRARY
-
-P=CDC76SYS, D=NAMJOB NEW ROUTINE
-
-P=CDCSYS, D=DATEZB,NAMJOB,NAMEZB,NAMEZBP NEW ROUTINES
-
-P=CDCSYS, D=ABEND, C=6 CORRECTIONS FOR NEW SYSTEM
- D=EQUBUF, C=3, 73
- D=RETRNF, C=3, 43
-
-P=IBM360, D=UCOPYN, C=22-23 BUG CORRECTED
-
----------------------------------------------------------------------
-
-
-CHANGES OF 4/12/76 FOR VERSION 2.14
-
-
-P=TCGEN D=ERF, PROB CORRECTIONS OF ENTRY STATEMENTS
-P=TCGEN D=VDIST, VDIST2 NEW ROUTINES
-P=TCGEN D=TRACEQ DEFINE DEFAULT LUN FOR OTHER MACHINES
-P=TCGEN D=SORTX BROUGHT BACK FROM P=TCGENR
-
-
-ALL PATCHES FOR SPECIFIC MACHINES HAVE BEEN MOVED FROM THE GENSEC PAM
-TO INDIVIDUAL PAM-FILES, 1 FOR EACH MACHINE, AS DESCRIBED ON THE FIRST PAGE
-
----------------------------------------------------------------------
-
- ==== VERSION 3.01 = 2.14 ====
-
-=====================================================================
-#endif
diff --git a/src/packlib/kernlib/kerngen/history/kernfor/updvs300.dat b/src/packlib/kernlib/kerngen/history/kernfor/updvs300.dat
deleted file mode 100644
index cfd9a95..0000000
--- a/src/packlib/kernlib/kerngen/history/kernfor/updvs300.dat
+++ /dev/null
@@ -1,251 +0,0 @@
-*
-* $Id: updvs300.dat,v 1.1.1.1 1996/02/15 17:50:43 mclareni Exp $
-*
-* $Log: updvs300.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:50:43 mclareni
-* Kernlib
-*
-*
-#if !defined(CERNLIB_KERNFOR)
-
- UP-DATE RECORD FOR THE GENSEC VERSIONS 3.01 TO 3.99
- ---------------------------------------------------
-
- FIRST RELEASE OF THE GENSEC MINI-PAM : 4-DEC-1976
-
----------------------------------------------------------------------
-
-UP-DATE 3.02 : 18-OCT-1977
-----------------------------
-
-REPLACING FILE GENSEC 2.14 761204 19.17
-
-NEW DECKS : P=TCGEN, D= RANNOR, UBITS, UFLINT
-
-CORRECTIONS : P=TCGEN, D= IUBIN, IUCHAN, IUHIST
- ASSURE ROUNDING UPWARDS
-
----------------------------------------------------------------------
-
-UP-DATE 3.03 : 29-APR-1978
-----------------------------
-
-REPLACING FILE GENSEC 3.02 771018 16.47
-
-
-NEW DECKS : D=FLPSOR, INTSOR CERN PROGRAM LIBRARY M103
-
-CORRECTIONS: D=SORTZV NEW VERSION FROM PROGLIB M101
- D=SORTX NEW VERSION FROM PROGLIB M106
-
-DELETES: D=FLTSOR, INTSOR DISTURBING ROUTINES OF OLD SORTZV
-
-TRIVIAL: D=DOTI, ERF TIDIED UP
-
----------------------------------------------------------------------
-
-UP-DATE 3.04 : 15-JUNE-1978
------------------------------
-
-REPLACING FILE GENSEC 3.03 780501 19.21
-
-
-CORRECTIONS: D=SORTX BROUGHT BACK FROM VERSION 3.02
- THE ROUTINE TAKEN FROM CERN PROG. LIB FOR 3.03
- DOES NOT PRESERVE THE ORIGINAL ORDER FOR EQUAL KEYS
-
----------------------------------------------------------------------
-
-UP-DATE 3.05 : 15-JULY-1978
------------------------------
-
-REPLACING FILE GENSEC 3.04 780614 18.17
-
-
-NEW PATCH: P=XVECT
-
----------------------------------------------------------------------
-
-UP-DATE 3.06 : 15-SEPT-1978
------------------------------
-
-REPLACING FILE GENSEC 3.05 780714 16.04
-
-
-NEW DECKS: P=TCGEN, D= IUFNBL, UTRANS
-
----------------------------------------------------------------------
-
-UP-DATE 3.07 : 15-NOV-1978
-----------------------------
-
-REPLACING FILE GENSEC 3.06 780916 12.51
-
-
-MOVED AND CORRECTED FOR IBM D=AFROMI FROM P=TCGEN TO P=TCGENR
-
----------------------------------------------------------------------
-
-UP-DATE 3.08 : 18-DEC-1978
-----------------------------
-
-REPLACING FILE GENSEC 3.07 781115 19.08
-
-
-NEW DECKS : P=TCGEN, D=GSHOW, GSHOWF TO PRINT GENSEC VERSION USED
-
----------------------------------------------------------------------
-
-UP-DATE 3.09 : 27-APR-1979
-----------------------------
-
-REPLACING FILE GENSEC 3.08 781218 23.26
-
-
-NEW DECKS : P=TCGEN, D=IUMODE
-
-CORRECTIONS: P=TCGEN, D=GSHOWF ADD HOOK FOR USER MESSAGE
-
----------------------------------------------------------------------
-
-UP-DATE 3.10 : 12-DEC-1979
-----------------------------
-
-REPLACING FILE GENSEC 3.09 790427 10.50
-
-
-CORRECTIONS: P=TCGEN, D=SORTZV CHECK FOR N.LE.1
-
----------------------------------------------------------------------
-
-UP-DATE 3.11 : 16-JULY-1980
------------------------------
-
-REPLACING FILE GENSEC 3.10 791212 15.57
-
-
-NEW PATCHES: P=QM... MACHINE TYPE PATCHES
-
-CORRECTIONS: P=XVECT, D=XINCF,XOUTCF FORMATS MODIFIED FOR A4
-
- P=TCGEN, D=ACOS,ERF RE-ORGANIZE RETURN FROM FUNCTIONS
- WITH MULTIPLE ENTRY-POINTS,
- GENERAL FIX OF SPECIAL NORD 50 BUG
-
- D=UFLINT ALLOW SEQUENCE INSTEAD OF TAGS
-
-THIS UP-DATE STARTS PREPARING THE CHANGE FROM TAGS TO PATCHY CONDITIONALS
-
----------------------------------------------------------------------
-
-UP-DATE 3.12 : 30-JULY-1980
------------------------------
-
-REPLACING FILE GENSEC 3.11 800716 19.41
-
-
-CORRECTIONS: P=TCGEN, D=IUMODE CALLING SEQUENCE CHANGED
-
----------------------------------------------------------------------
-
-UP-DATE 3.13 : 28-JAN-1981
-----------------------------
-
-REPLACING FILE GENSEC 3.12 800730 17.24
-
-
-CORRECTIONS: P=TCGEN, D=IULOOK FIX FOR NORD 50
- D=TRACEQ TIDY UP FOR VAX ET AL
-
----------------------------------------------------------------------
-
-UP-DATE 3.14 : 30-NOV-1981
-----------------------------
-
-REPLACING FILE GENSEC 3.13 810128 14.51
-
-
-CORRECTIONS : P=TCGEN, D=GSHOW, GSHOWF, TCDUMP, TRACEQ
- CORRECT FORMATS FOR FORTRAN 77 COMPATIBILITY
-
-NEW ROUTINES : P=TCGEN, D=UCTOH1, UCTOH, UH1TOC, UHTOC
-
-OBSOLETED : P=TCGEN, D=ACOS, LORENC, LOTRAN, MXADD, MXDMA, MXDMAL
- XIN123, XOUT123, XWRBCD
-
-RE-ORDER P=TCGEN TO BE READY FOR KERNLIB.
-ALL MATH ROUTINES (SECTIONS A-H) GO TO THE END OF THIS PATCH,
-IN THE ORDER EXPECTED TO BE DELIVERED FROM CERN MATH SECTION.
-
----------------------------------------------------------------------
-
-UP-DATE 3.15 : 13-JAN-1982
-----------------------------
-
-REPLACING FILE GENSEC 3.14 811130 21.52
-
-CORRECTIONS: ERF SPLIT INTO ERF AND FREQ SEPARATE
- MATIN1 DIAGNOSTIC PRINT REMOVED
- FLPSOR,INTSOR MAKE STANDARD FORTRAN
- VCOPY,VFIX,VFLOAT TEST N.LE.0 ON ENTRY
-
-ALL YSHIFT TAGS HAVE BEEN REPLACED BY PATCHY IF'S
-
----------------------------------------------------------------------
-
-UP-DATE 3.16 : 25-JAN-1982
-----------------------------
-
-REPLACING FILE GENSEC 3.15 820113 19.30
-
-CORRECTIONS: FREQ CORRECT FOR PRECISION ON CDC
-
-TRANSLATION BY PROGRAM FOR STANDARD KERNLIB HEADER CARDS
-
----------------------------------------------------------------------
-
-UP-DATE 3.17 : 4-FEB-1982
-----------------------------
-
-REPLACING FILE GENSEC 3.16 820126 20.00
-
-
-NEW DECKS : P=TCGEN, D=BLOW,BUNCH FOR KERNLIB
-
-CORRECTIONS: P=TCGEN, D=UBITS NEW VERSION
- D=FINT,PROB IMPROVED COMPUTATIONS
-
----------------------------------------------------------------------
-
-UP-DATE 3.18 : 12-FEB-1982
-----------------------------
-
-REPLACING FILE GENSEC 3.17 820204 15.19
-
-NEW PATCH : P=QMUNO FOR UNIVAC FTN WITH O-OPTION
-
----------------------------------------------------------------------
-
-UP-DATE 3.19 : 29-MAR-1982
-----------------------------
-
-REPLACING FILE GENSEC 3.18 820212 10.56
-
-TIDY COMMENTS FOR KERNLIB, FORMATS IN GSHOW CHANGED
-
----------------------------------------------------------------------
-
-UP-DATE 3.20 : 30-MAR-1982
-----------------------------
-
-REPLACING FILE GENSEC 3.19 820329 18.27
-
-ADD IF=QMUNO SELECTION TO IUMODE, TRACEQ, UFLINT
-
----------------------------------------------------------------------
-
- KERNFOR 4.00 = GENSEC 3.20
-
----------------------------------------------------------------------
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/history/kernhpx/history.dat b/src/packlib/kernlib/kerngen/history/kernhpx/history.dat
deleted file mode 100644
index 676ed74..0000000
--- a/src/packlib/kernlib/kerngen/history/kernhpx/history.dat
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: history.dat,v 1.1.1.1 1996/02/15 17:50:44 mclareni Exp $
-*
-* $Log: history.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:50:44 mclareni
-* Kernlib
-*
-*
-* This directory was created from kernhpx.car patch kernhpx
-#if !defined(CERNLIB_KERNHPX)
-
- KERNLIB routines particular to HP Unix
-
----------------------------------------------------------------------
-
- This file contains the following patches :
-
-*KHPX Pilot-patch selecting the full standard general KERNLIB
- for the HP Unix
-
-QMHPX HPX machine patch
-
-HPXGS HPX versions of general KERNLIB rotuines
-
-=====================================================================
-#endif
diff --git a/src/packlib/kernlib/kerngen/history/kernhpx/previous.dat b/src/packlib/kernlib/kerngen/history/kernhpx/previous.dat
deleted file mode 100644
index 515feaf..0000000
--- a/src/packlib/kernlib/kerngen/history/kernhpx/previous.dat
+++ /dev/null
@@ -1,42 +0,0 @@
-*
-* $Id: previous.dat,v 1.1.1.1 1996/02/15 17:50:44 mclareni Exp $
-*
-* $Log: previous.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:50:44 mclareni
-* Kernlib
-*
-*
-#if !defined(CERNLIB_KERNHPX)
-
-UP-DATE 1.03 : 11-May-1994
-----------------------------
-
-Replacing file KERNHPX 1.02 920521 16.28
-
-Selection on P=P5BOOT for the Patchy boot-strap export
-
----------------------------------------------------------------------
-
-UP-DATE 1.02 : 11-May-1992
-----------------------------
-
-Replacing file KERNHPX 1.01 920304 18.56
-
-New Decks: LENOCC, LNBLNK for speed
-
----------------------------------------------------------------------
-
-UP-DATE 1.01 : 4-mar-1992
-----------------------------
-
-Replacing file KERNHPX 1.00 910313 18.10
-
-Correct: D=FFSIZE
-
----------------------------------------------------------------------
-
- First release of the KERNHPX Pam : 25-FEB-1991
-
----------------------------------------------------------------------
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/history/kernhpx/update.dat b/src/packlib/kernlib/kerngen/history/kernhpx/update.dat
deleted file mode 100644
index b0a55a8..0000000
--- a/src/packlib/kernlib/kerngen/history/kernhpx/update.dat
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: update.dat,v 1.1.1.1 1996/02/15 17:50:44 mclareni Exp $
-*
-* $Log: update.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:50:44 mclareni
-* Kernlib
-*
-*
-#if !defined(CERNLIB_KERNHPX)
-
-
- Up-date record for the Pam-file KERNHPX
- ----------------------------------------
-
-
-UP-DATE 1.04 : 28-Sept-1994
-----------------------------
-
-Replacing file KERNHPX 1.03 940511 20.58
-
-New Decks: TRACEQ, TRACEQC to print trace-back of routines
-
----------------------------------------------------------------------
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/history/kernirt/history.dat b/src/packlib/kernlib/kerngen/history/kernirt/history.dat
deleted file mode 100644
index e8d9685..0000000
--- a/src/packlib/kernlib/kerngen/history/kernirt/history.dat
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: history.dat,v 1.1.1.1 1996/02/15 17:50:45 mclareni Exp $
-*
-* $Log: history.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:50:45 mclareni
-* Kernlib
-*
-*
-* This directory was created from kernirt.car patch kernirt
-#if !defined(CERNLIB_KERNIRT)
-
- KERNLIB ROUTINES PARTICULAR TO THE IBM RT
-
----------------------------------------------------------------------
-
- This file contains the following patches :
-
-*KIRT Pilot-patch selecting the standard KERNLIB for IBM RT
-
-QMIRT IBM RT machine patch
-
-IRTPROGS Utility programs to run on IBM RT
-
-IRTGS IBM RT versions of general KERNLIB routines
-
-=====================================================================
-#endif
diff --git a/src/packlib/kernlib/kerngen/history/kernirt/previous.dat b/src/packlib/kernlib/kerngen/history/kernirt/previous.dat
deleted file mode 100644
index 611840f..0000000
--- a/src/packlib/kernlib/kerngen/history/kernirt/previous.dat
+++ /dev/null
@@ -1,93 +0,0 @@
-*
-* $Id: previous.dat,v 1.1.1.1 1996/02/15 17:50:45 mclareni Exp $
-*
-* $Log: previous.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:50:45 mclareni
-* Kernlib
-*
-*
-#if !defined(CERNLIB_KERNIRT)
-
-Up-date 1.07 : 3-Mar-1994
-----------------------------
-
-Replacing File KERNIRT 1.06 930812 10.34
-
-Delete : INTRAC use INTRAC in p=CCGEN
-
----------------------------------------------------------------------
-
-Up-date 1.06 : 11-Aug-1993
-----------------------------
-
-Replacing File KERNIRT 1.05 920521 16.27
-
-New patches: *KIRTD, QMIRTD, IRTDGS for Autodouble
-
----------------------------------------------------------------------
-
-Up-date 1.05 : 11-May-1992
-----------------------------
-
-Replacing File KERNIRT 1.04 910719 12.59
-
-New decks : LENOCC, LNBLNK for speed
-
----------------------------------------------------------------------
-
-Up-date 1.04 : 18-July-1991
-----------------------------
-
-Replacing File KERNIRT 1.03 910315 17.05
-
-Correct : P=QMIRT complete options
- KERNGT to use Z=QFTITLCH
-
-Delete : SIGNAL obsolete, use SIGNALF
-
----------------------------------------------------------------------
-
-Up-date 1.03 : 14-Mar-1991
-----------------------------
-
-Replacing File KERNIRT 1.02 900925 18.30
-
-New decks : SIGNALF
-
-Correct : Connect P=CCGEN, CCGENCF of KERNFOR
-
-Delete : CHDIR, GETCWD, PERROR, RENAME
-
----------------------------------------------------------------------
-
-Up-date 1.02 : 25-Sep-1990
-----------------------------
-
-Replacing File KERNIRT 1.01 900319 22.28
-
-New decks : CHDIR, GETCWD, PERROR, RENAME, SIGNAL
-
-Correct : connect CCGEN by individual routines
-
----------------------------------------------------------------------
-
-Up-date 1.01 : 19-Mar-1990
-----------------------------
-
-Replacing File KERNIRT 1.00 891208 11.00
-
-New : XINB, XINBF, XINBS as on IBM
- INTRAC
-
-Correct : the pilot patch is *KIRT (and not *KMIRT)
- FCASPLIT to be used from KERNFOR
-
-Delete : FSPLIT, IARGC
-
----------------------------------------------------------------------
-
- FIRST RELEASE OF THE KERNIRT PAM : 8-Dec-1989
-
----------------------------------------------------------------------
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/history/kernirt/update.dat b/src/packlib/kernlib/kerngen/history/kernirt/update.dat
deleted file mode 100644
index 545bc54..0000000
--- a/src/packlib/kernlib/kerngen/history/kernirt/update.dat
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: update.dat,v 1.1.1.1 1996/02/15 17:50:45 mclareni Exp $
-*
-* $Log: update.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:50:45 mclareni
-* Kernlib
-*
-*
-#if !defined(CERNLIB_KERNIRT)
-
- Up-date RECORD FOR THE PAM-FILE KERNIRT
- ----------------------------------------
-
-
-Up-date 1.08 : 31-May-1994
-----------------------------
-
-Replacing File KERNIRT 1.07 940303 11.34
-
-Selection on P=P5BOOT for the Patchy boot-strap export
-
-Correct: p=IRTDGS @PROCESS directive corrected
- p=IRTDGS, d=UPACK direction sensitive
-
----------------------------------------------------------------------
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/history/kernlnx/history.dat b/src/packlib/kernlib/kerngen/history/kernlnx/history.dat
deleted file mode 100644
index 347b14d..0000000
--- a/src/packlib/kernlib/kerngen/history/kernlnx/history.dat
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: history.dat,v 1.1.1.1 1996/02/15 17:50:45 mclareni Exp $
-*
-* $Log: history.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:50:45 mclareni
-* Kernlib
-*
-*
-* This directory was created from kernlnx.car patch kernlnx
-#if !defined(CERNLIB_KERNLNX)
-
- KERNLIB routines particular to LINUX
-
----------------------------------------------------------------------
-
- This file contains the following patches :
-
- *KLNX Pilot-patch selecting KERNLIB for LINUX
-
- QMLNX Machine patch LINUX
-
- LNXGS LINUX variants of KERNLIB routines
-
-=====================================================================
-#endif
diff --git a/src/packlib/kernlib/kerngen/history/kernlnx/previous.dat b/src/packlib/kernlib/kerngen/history/kernlnx/previous.dat
deleted file mode 100644
index 9fe8533..0000000
--- a/src/packlib/kernlib/kerngen/history/kernlnx/previous.dat
+++ /dev/null
@@ -1,43 +0,0 @@
-*
-* $Id: previous.dat,v 1.1.1.1 1996/02/15 17:50:45 mclareni Exp $
-*
-* $Log: previous.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:50:45 mclareni
-* Kernlib
-*
-*
-#if !defined(CERNLIB_KERNLNX)
-
-UP-DATE 1.02: 11-May-1994
-----------------------------
-
-Replacing File KERNLNX 1.01 940309 15.15
-
-Selection on P=P5BOOT for the patchy boot-strap
-
-Correct: D=ISHFTR to be a simple right-shift
- D=UBLOW, UBUNCH to use LSHIFT and ISHFTR
-
-Delete: D=LRSHFT no longer needed
- P=LNXPROGS
-
- d=UCOPY,UCOPY2,USWOP the routines on kernfor are
- now good for LINUX
-
----------------------------------------------------------------------
-
-UP-DATE 1.01: 9-Mar-1994
-----------------------------
-
-Replacing File KERNLNX 1.00 930505 18.20
-
-New decks: RNDM, IRNDM, RDMIN
-
----------------------------------------------------------------------
-
- First release of the KERNLNX Pam : 07 MAY 1993
-
----------------------------------------------------------------------
-
-C====================================================================
-#endif
diff --git a/src/packlib/kernlib/kerngen/history/kernlnx/update.dat b/src/packlib/kernlib/kerngen/history/kernlnx/update.dat
deleted file mode 100644
index 38f38e1..0000000
--- a/src/packlib/kernlib/kerngen/history/kernlnx/update.dat
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: update.dat,v 1.1.1.1 1996/02/15 17:50:45 mclareni Exp $
-*
-* $Log: update.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:50:45 mclareni
-* Kernlib
-*
-*
-#if !defined(CERNLIB_KERNLNX)
-
-
- UP-DATE RECORD FOR THE PAM-FILE KERNLNX
- ----------------------------------------
-
-
-UP-DATE 1.03: 18-July-1994
-----------------------------
-
-Replacing File KERNLNX 1.02 940511 11.03
-
-Correct: use the new C routines VXINVB, VXINVC from KERNFOR
-
----------------------------------------------------------------------
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/history/kernmpw/history.dat b/src/packlib/kernlib/kerngen/history/kernmpw/history.dat
deleted file mode 100644
index 189a991..0000000
--- a/src/packlib/kernlib/kerngen/history/kernmpw/history.dat
+++ /dev/null
@@ -1,53 +0,0 @@
-*
-* $Id: history.dat,v 1.1.1.1 1996/02/15 17:50:46 mclareni Exp $
-*
-* $Log: history.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:50:46 mclareni
-* Kernlib
-*
-*
-* This directory was created from kernmpw.car patch kernmpw
-#if !defined(CERNLIB_KERNMPW)
-
- KERNLIB ROUTINES PARTICULAR TO THE MAC II
-
----------------------------------------------------------------------
-
- This file contains the following patches :
-
-*KMMPW Pilot-patch selecting the standard KERNLIB for MAC II
-
-QMMPW MAC II machine patch
-
-MPWGS MAC II versions of KERNLIB routines
-
-=====================================================================
-
-
- UP-DATE RECORD FOR THE PAM-FILE KERNMPW
- ----------------------------------------
-
-
-UP-DATE 1.02 : 21-Nov-1992
-----------------------------
-
-Replacing File KERNMPW 1.01 900215 17.34
-
-Correct : P=MPWGS, D=TIME correct bug in TIMED
-
----------------------------------------------------------------------
-
-UP-DATE 1.01 : 15-Feb-1990
-----------------------------
-
-Replacing File KERNMPW 1.00 891208 12.00
-
-Correct : the pilot patch is *KMPW (and not *KMMPW)
-
----------------------------------------------------------------------
-
- FIRST RELEASE OF THE KERNMPW PAM : 8-DEC-1989
-
----------------------------------------------------------------------
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/history/kernos9/history.dat b/src/packlib/kernlib/kerngen/history/kernos9/history.dat
deleted file mode 100644
index dc506f8..0000000
--- a/src/packlib/kernlib/kerngen/history/kernos9/history.dat
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: history.dat,v 1.1.1.1 1996/02/15 17:50:46 mclareni Exp $
-*
-* $Log: history.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:50:46 mclareni
-* Kernlib
-*
-*
-* This directory was created from kernos9.car patch kernos9
-#if !defined(CERNLIB_KERNOS9)
-
- KERNLIB routines particular to Microware OS-9
-
----------------------------------------------------------------------
-
- This file contains the following patches :
-
-*KOS9 Pilot-patch selecting the full standard general KERNLIB
- for the Microware OS-9
-
-QMOS9 OS9 machine patch
-
-OS9GS OS9 versions of general KERNLIB rotuines
-
-=====================================================================
-#endif
diff --git a/src/packlib/kernlib/kerngen/history/kernos9/previous.dat b/src/packlib/kernlib/kerngen/history/kernos9/previous.dat
deleted file mode 100644
index 1a226dc..0000000
--- a/src/packlib/kernlib/kerngen/history/kernos9/previous.dat
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: previous.dat,v 1.1.1.1 1996/02/15 17:50:46 mclareni Exp $
-*
-* $Log: previous.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:50:46 mclareni
-* Kernlib
-*
-*
-#if !defined(CERNLIB_KERNOS9)
-
----------------------------------------------------------------------
-
- First release of the KERNOS9 Pam : 21-MAY-1992
-
----------------------------------------------------------------------
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/history/kernos9/update.dat b/src/packlib/kernlib/kerngen/history/kernos9/update.dat
deleted file mode 100644
index c54c9f6..0000000
--- a/src/packlib/kernlib/kerngen/history/kernos9/update.dat
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: update.dat,v 1.1.1.1 1996/02/15 17:50:46 mclareni Exp $
-*
-* $Log: update.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:50:46 mclareni
-* Kernlib
-*
-*
-#if !defined(CERNLIB_KERNOS9)
-
-
- Up-date record for the Pam-file KERNOS9
- ----------------------------------------
-
-UP-DATE 1.01 : 29-sept-1994
-------------------------------
-
-Replacing file KERNOS9 1.00 920521 16.28
-
-Correct:
-
----------------------------------------------------------------------
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/history/kernsgi/history.dat b/src/packlib/kernlib/kerngen/history/kernsgi/history.dat
deleted file mode 100644
index 0db6617..0000000
--- a/src/packlib/kernlib/kerngen/history/kernsgi/history.dat
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: history.dat,v 1.1.1.1 1996/02/15 17:50:47 mclareni Exp $
-*
-* $Log: history.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:50:47 mclareni
-* Kernlib
-*
-*
-* This directory was created from kernsgi.car patch kernsgi
-#if !defined(CERNLIB_KERNSGI)
-
- KERNLIB ROUTINES PARTICULAR TO THE Silicon Graphics
-
----------------------------------------------------------------------
-
- This file contains the following patches :
-
-*KSGI Pilot-patch selecting the standard KERNLIB for Silicon Graphics
-
-QMSGI Silicon Graphics machine patch
-
-SGIPROGS Silicon Graphics utility programs
-
-SGIGS Silicon Graphics versions of general KERNLIB routines
-
-=====================================================================
-#endif
diff --git a/src/packlib/kernlib/kerngen/history/kernsgi/previous.dat b/src/packlib/kernlib/kerngen/history/kernsgi/previous.dat
deleted file mode 100644
index 3a4da87..0000000
--- a/src/packlib/kernlib/kerngen/history/kernsgi/previous.dat
+++ /dev/null
@@ -1,53 +0,0 @@
-*
-* $Id: previous.dat,v 1.1.1.1 1996/02/15 17:50:47 mclareni Exp $
-*
-* $Log: previous.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:50:47 mclareni
-* Kernlib
-*
-*
-#if !defined(CERNLIB_KERNSGI)
-
-UP-DATE 1.04 : 20-Jan-1993
-----------------------------
-
-Replacing File KERNSGI 1.03 920521 16.33
-
-Correct : SIGNALF correct for C syntax
-
----------------------------------------------------------------------
-
-UP-DATE 1.03 : 11-May-1992
-----------------------------
-
-Replacing File KERNSGI 1.02 910318 14.16
-
-New deck : LENOCC for speed
-
----------------------------------------------------------------------
-
-UP-DATE 1.02 : 18-Mar-1991
-----------------------------
-
-Replacing File KERNSGI 1.01 900724 18.48
-
-New deck : SIGNALF, FFSIZE
-
-Correct : connect P=CCGEN, CCGENCF of KERNFOR
-
----------------------------------------------------------------------
-
-UP-DATE 1.01 : 24-July-1990
-----------------------------
-
-Replacing File KERNSGI 1.00 891208 10.40
-
-Correct : connect CCGEN by individual routines
-
----------------------------------------------------------------------
-
- First release of the KERNSGI Pam : 8-dec-1989
-
----------------------------------------------------------------------
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/history/kernsgi/update.dat b/src/packlib/kernlib/kerngen/history/kernsgi/update.dat
deleted file mode 100644
index 0d069cc..0000000
--- a/src/packlib/kernlib/kerngen/history/kernsgi/update.dat
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: update.dat,v 1.1.1.1 1996/02/15 17:50:46 mclareni Exp $
-*
-* $Log: update.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:50:46 mclareni
-* Kernlib
-*
-*
-#if !defined(CERNLIB_KERNSGI)
-
-
- UP-DATE RECORD FOR THE PAM-FILE KERNSGI
- ----------------------------------------
-
-
-UP-DATE 1.05 : 11-May-1994
-----------------------------
-
-Replacing File KERNSGI 1.04 930120 11.39
-
-Selection on P=P5BOOT for the Patchy boot-strap export
-
----------------------------------------------------------------------
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/history/kernsun/history.dat b/src/packlib/kernlib/kerngen/history/kernsun/history.dat
deleted file mode 100644
index 7d18aa1..0000000
--- a/src/packlib/kernlib/kerngen/history/kernsun/history.dat
+++ /dev/null
@@ -1,30 +0,0 @@
-*
-* $Id: history.dat,v 1.1.1.1 1996/02/15 17:50:47 mclareni Exp $
-*
-* $Log: history.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:50:47 mclareni
-* Kernlib
-*
-*
-* This directory was created from kernsun.car patch kernsun
-#if !defined(CERNLIB_KERNSUN)
-
- KERNLIB ROUTINES PARTICULAR TO THE SUN
-
----------------------------------------------------------------------
-
- This file contains the following patches :
-
-*KSUN Pilot-patch selecting the standard KERNLIB for SUN
-
-QMSUN SUN machine patch
-
-SUNGS SUN versions of general KERNLIB routines
-
-SOLARIS option patch to select for this operating system
-
-BUGLRSHFT temporary option patch to work around the SUN intrinsic
- function LRSHFT which is wrong with f77 version 3.0
-
-=====================================================================
-#endif
diff --git a/src/packlib/kernlib/kerngen/history/kernsun/previous.dat b/src/packlib/kernlib/kerngen/history/kernsun/previous.dat
deleted file mode 100644
index 5dcb43e..0000000
--- a/src/packlib/kernlib/kerngen/history/kernsun/previous.dat
+++ /dev/null
@@ -1,136 +0,0 @@
-*
-* $Id: previous.dat,v 1.1.1.1 1996/02/15 17:50:47 mclareni Exp $
-*
-* $Log: previous.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:50:47 mclareni
-* Kernlib
-*
-*
-#if !defined(CERNLIB_KERNSUN)
-
-UP-DATE 1.10: 24-Jan-1995
-----------------------------
-
-Replacing File KERNSUN 1.09 940905 18.59
-
-Correct: use SIGNALF from KERNFOR, Posix version
- use QNEXTE from KERNFOR for Solaris
-
----------------------------------------------------------------------
-
-UP-DATE 1.09: 5-Sep-1994
-----------------------------
-
-Replacing File KERNSUN 1.08 940601 21.40
-
-New patches: option BUGLRSHFT to avoid use of intrinsic LRSHFT
-
----------------------------------------------------------------------
-
-UP-DATE 1.08: 11-May-1994
-----------------------------
-
-Replacing File KERNSUN 1.07 940218 10.46
-
-Selection on P=P5BOOT for the Patchy boot-strap export
-
----------------------------------------------------------------------
-
-UP-DATE 1.07: 24-Feb-1994
-----------------------------
-
-Replacing File KERNSUN 1.06 920521 16.30
-
-New patches: option SOLARIS for new operating system
- NOOPT to divert routines to be compiled
- without optimisation
-
-Correct: KERNGT to have the "what"-identifier
-
-Obsoleted: JUMPAD, JUMPX2 use from KERNFOR
-
----------------------------------------------------------------------
-
-UP-DATE 1.06: 11-May-1992
-----------------------------
-
-Replacing File KERNSUN 1.05 910318 17.46
-
-New decks: LENOCC for speed
-
-Deleted: TIMED, TIMEX use from KERNFOR
- GSHOW use KERNGT
- P=SUNPROGS
-
-Correct: KERNGT to use Z=QFTITLCH
- many routines use the intrinsic LRSHFT instead of ISHFT
-
----------------------------------------------------------------------
-
-UP-DATE 1.05: 18-Mar-1991
-----------------------------
-
-Replacing File KERNSUN 1.04 900925 13.33
-
-New decks: SIGNALF, FFSIZE
-
-Correct: connect P=CCGEN, CCGENCF of KERNFOR
- merge P=SUNSYS into P=SUNGS
-
- LOCB bug fixed
-
----------------------------------------------------------------------
-
-UP-DATE 1.04: 24-Sept-1990
-----------------------------
-
-Replacing File KERNSUN 1.03 891121 0.53
-
-Correct: connect some CCGEN routines
- FCASPLIT: use version on KERNFOR
- correct faulty TIMED
-
----------------------------------------------------------------------
-
-UP-DATE 1.03: 20-Nov-1989
-----------------------------
-
-Replacing File KERNSUN 1.02 891025 19.06
-
-New decks: LOCB return the byte adr of a variable
-
----------------------------------------------------------------------
-
-UP-DATE 1.02: 25-Oct-1989
-----------------------------
-
-Replacing File KERNSUN 1.01 890626 20.10
-
-Correct: DATIME to return seconds in /SLATE/
- JUMPX2 add entries JUMPX1 and JUMPX0
- LOCF change to work also on SPARC
-
----------------------------------------------------------------------
-
-UP-DATE 1.01: 23-june-1989
-----------------------------
-
-Replacing File KERNSUN 1.00 881114 22.18
-
-New Deck: KERNGT
-
-Correct: remove UCTOH1, UCTOH, UH1TOC, UHTOC
- these routines were working only on SUN 3
- the new defaults on KERNFOR are good for SUN 3 & 4
-
- LOCF allow for 31 bit adrs
-
- FCASPLIT new version
-
----------------------------------------------------------------------
-
- First release of the KERNSUN Pam : 12-oct-1988
-
----------------------------------------------------------------------
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/history/kernsun/update.dat b/src/packlib/kernlib/kerngen/history/kernsun/update.dat
deleted file mode 100644
index fda4147..0000000
--- a/src/packlib/kernlib/kerngen/history/kernsun/update.dat
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: update.dat,v 1.1.1.1 1996/02/15 17:50:47 mclareni Exp $
-*
-* $Log: update.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:50:47 mclareni
-* Kernlib
-*
-*
-#if !defined(CERNLIB_KERNSUN)
-
-
- UP-DATE RECORD FOR THE PAM-FILE KERNSUN
- ----------------------------------------
-
-
-UP-DATE 1.11: 28-Sep-1995
-----------------------------
-
-Replacing File KERNSUN 1.10 950124 19.06
-
-Deleted: dummy TRACEQ use from KERNFOR
-
----------------------------------------------------------------------
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/history/kernvax/gvaxup1.dat b/src/packlib/kernlib/kerngen/history/kernvax/gvaxup1.dat
deleted file mode 100644
index 7e39acd..0000000
--- a/src/packlib/kernlib/kerngen/history/kernvax/gvaxup1.dat
+++ /dev/null
@@ -1,170 +0,0 @@
-*
-* $Id: gvaxup1.dat,v 1.1.1.1 1996/02/15 17:50:48 mclareni Exp $
-*
-* $Log: gvaxup1.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:50:48 mclareni
-* Kernlib
-*
-*
-
- UP-DATE RECORD FOR GENVAX VERSIONS 1.01 TO 1.99
- -----------------------------------------------
-
-
- FIRST RELEASE OF THE GENVAX MINI-PAM : 10-NOV-79
-
----------------------------------------------------------------------
-
-UPDATE 1.02 : 7-DEC-79
--------------------------
-
-REPLACING FILE GENVAX 1.01 791110 12.37
-
-NEW DECKS: P=VAXGS, D=IUMODE, TIMED
-
----------------------------------------------------------------------
-
-UPDATE 1.03 : 17-APR-80
--------------------------
-
-REPLACING FILE GENVAX 1.02 791207 15.45
-
-CORRECTIONS: P=VAXGS, D=IUMODE
-
----------------------------------------------------------------------
-
-UPDATE 1.04 : 21-JULY-80
--------------------------
-
-REPLACING FILE GENVAX 1.03 800417 15.54
-
-CORRECTIONS: P=VAXGS, D=UBLOW, UBUNCH
-
----------------------------------------------------------------------
-
-UPDATE 1.05 : 30-JULY-80
--------------------------
-
-REPLACING FILE GENVAX 1.04 800721 16.03
-
-CORRECTIONS: P=VAXGS, D=IUMODE CALLING SEQUENCE CHANGED
-
----------------------------------------------------------------------
-
-UPDATE 1.06 : 3-NOV-80
--------------------------
-
-REPLACING FILE GENVAX 1.05 800730 17.25
-
-CORRECTIONS: P=VAXGS, D=UCOPY RE-WRITE FOR BUG
-
----------------------------------------------------------------------
-
-UPDATE 1.07 : 17-NOV-80
--------------------------
-
-REPLACING FILE GENVAX 1.06 801103 18.57
-
-NEW DECK : P=VAXGS, D=IUCOMH COMPARE HOLLERITH
-
----------------------------------------------------------------------
-
-UPDATE 1.08 : 29-JAN-81
--------------------------
-
-REPLACING FILE GENVAX 1.07 801117 18.51
-
-NEW DECKS : P=VAXGS, D=SWBL16, SWBU16 BLOW/BUNCH WITH BYT SWOPPING
-
----------------------------------------------------------------------
-
-UPDATE 1.09 : 26-FEB-81
--------------------------
-
-REPLACING FILE GENVAX 1.08 810129 15.59
-
-CHANGE ALL '+DEL ...' INTO '+USE,..., T=INH'
-
----------------------------------------------------------------------
-
-UPDATE 1.10 : 26-NOV-81
--------------------------
-
-REPLACING FILE GENVAX 1.09 810226 18.24
-
-NEW DECKS : P=VAXGS, D=ABEND
-
----------------------------------------------------------------------
-
-UPDATE 1.11 : 12-FEB-82
--------------------------
-
-REPLACING FILE GENVAX 1.10 811127 12.08
-
-NEW DECKS : P=VAXGS, D=GSHOW
-
----------------------------------------------------------------------
-
-UPDATE 1.12 : 4-JUNE-82
--------------------------
-
-REPLACING FILE GENVAX 1.11 820212 11.15
-
-FORMAL TRANSLATION FOR KERNLIB (COMMENT CARDS ONLY)
-
----------------------------------------------------------------------
-
-UPDATE 1.13 : 6-JUNE-82
--------------------------
-
-REPLACING FILE GENVAX 1.12 820604 19.30
-
-CORRECTIONS: P=XVECTVAX,D=XINB,XINBS ADD LENGTH PROTECTION
- P=VAXGS, D=SBIT,SBYT PROTECT 0/-VE BIT COUNT
-NEW DECKS: P=VAXGS, D=UCTOH1,UH1TOC IN MACHINE LANGUAGE
-
----------------------------------------------------------------------
-
-UPDATE 1.14 : 1-JUL-82
--------------------------
-
-REPLACING FILE GENVAX 1.13 820606 22.07
-
-NEW DECKS : P=VAXGS, D=AKMULT FOR MULTI-ROUTINE ASSEMBLY
-
----------------------------------------------------------------------
-
-UPDATE 1.15 : 21-JUL-82
--------------------------
-
-REPLACING FILE GENVAX 1.14 820701 12.14
-
-NEW DECKS : P=VAXGS, D=DATIMH, NOARG, RNDM
-
----------------------------------------------------------------------
-
-UPDATE 1.16 : 22-JUL-82
--------------------------
-
-REPLACING FILE GENVAX 1.15 820721 9.39
-
-NEW DECKS : P=VAXGS, D=FLOARG, INTARG, UCOPY2, UFLINT
-
- THE NEW UCOPY2 CONTAINS UCOPY
-
----------------------------------------------------------------------
-
-UPDATE 1.17 : 27-JUL-82
--------------------------
-
-REPLACING FILE GENVAX 1.16 820722 13.10
-
-NEW DECKS : P=VAXGS, D=TIMEL, TIMEX
-
-CORRECTIONS: P=VAXGS, D=TIMED
-
----------------------------------------------------------------------
-
- KERNVAX 2.00 = GENVAX 1.17
-
----------------------------------------------------------------------
diff --git a/src/packlib/kernlib/kerngen/history/kernvax/history.dat b/src/packlib/kernlib/kerngen/history/kernvax/history.dat
deleted file mode 100644
index ffda54e..0000000
--- a/src/packlib/kernlib/kerngen/history/kernvax/history.dat
+++ /dev/null
@@ -1,36 +0,0 @@
-*
-* $Id: history.dat,v 1.1.1.1 1996/02/15 17:50:48 mclareni Exp $
-*
-* $Log: history.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:50:48 mclareni
-* Kernlib
-*
-*
-* This directory was created from kernvax.car patch kernvax
-
- KERNLIB ROUTINES PARTICULAR TO THE VAX
-
----------------------------------------------------------------------
-
- This file contains the following Patches :
-
-*KVAX Pilot-patch selecting Kernlib for VAX system VMS
-*KALPH Pilot-patch selecting Kernlib for ALPHA system VMS
-
-QMVAX VAX and ALPHA machine patch
-
-VAXUTIL Utility programs for VAX or ALPHA
-
-VAXMLAN VAX only machine language versions of Kernlib routines
-
-VAXGS VAX Fortran versions of some standard Kernlib routines
-
-VAXSYS Routines specific to VAX operating system VMS
-
- And the following option patches are used :
-
-QMALPH ALPHA only machine patch
-
-QMVAXCC if the C compiler is available
-
-=====================================================================
diff --git a/src/packlib/kernlib/kerngen/history/kernvax/previous.dat b/src/packlib/kernlib/kerngen/history/kernvax/previous.dat
deleted file mode 100644
index 8c000eb..0000000
--- a/src/packlib/kernlib/kerngen/history/kernvax/previous.dat
+++ /dev/null
@@ -1,520 +0,0 @@
-*
-* $Id: previous.dat,v 1.1.1.1 1996/02/15 17:50:48 mclareni Exp $
-*
-* $Log: previous.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:50:48 mclareni
-* Kernlib
-*
-*
-#if !defined(CERNLIB_KERNVAX)
-
-UPDATE 2.46 : 13-Sept-94
---------------------------
-
-Replacing file KERNVAX 2.45 940311 10.07
-
-Selection on P=P5BOOT for the Patchy boot-strap export
-
-Correct: SYSTEMF to return status on failure
- FFRVAX, FTOVAX to handle /name as name:
- select the right QNEXTE for Alpha
-
-New deck: P=VAXGS, D=GETPIDF VMS version of Unix routine
-
----------------------------------------------------------------------
-
-UPDATE 2.45 : 28-Feb-94
--------------------------
-
-Replacing file KERNVAX 2.44 931108 18.25
-
-New Decks: P=VAXSYS, D=GETARG, TMINIT, TMPRO, TMREAD
-
-Correct: TIMEX, TIMED are now in Fortran
- UNLINKF made much simpler
- FFRVAX, FTOVAX to handle ~/
-
- P=VAXMLAN add line .TITLE into each deck
-
- Program CD to try ./name ../name ~/name for cd name
-
----------------------------------------------------------------------
-
-UPDATE 2.44 : 8-Nov-93
--------------------------
-
-Replacing file KERNVAX 2.43 930623 23.52
-
-New deck: P=VAXGS, D=IE3FODA new version for Alpha
-
----------------------------------------------------------------------
-
-UPDATE 2.43 : 24-June-93
--------------------------
-
-Replacing file KERNVAX 2.42 930609 15.42
-
-Correct: do +USE, CCGEN. and consequent deletes added
-
----------------------------------------------------------------------
-
-UPDATE 2.42 : 9-June-93
--------------------------
-
-Replacing file KERNVAX 2.41 930210 11.27
-
-Correct: P=VAXSYS, D=INTRAC to behave as UNIX isatty
-
-New Decks: P=VAXSYS, D=IFBATCH = .NOT.(old INTRAC)
- P=VAXSYS, D=WHOAMI file name of the execution module
-
----------------------------------------------------------------------
-
-UPDATE 2.41 : 1-Mar-93
--------------------------
-
-Replacing file KERNVAX 2.40 930205 11.36
-
-Correct: P=VAXSYS, D=TIMEL add entry TIMEST
-
----------------------------------------------------------------------
-
-UPDATE 2.40 : 4-Feb-93
--------------------------
-
-Replacing file KERNVAX 2.39 930128 15.57
-
-Merge P=ALPHGS into P=VAXGS
- P=VAXSYSML into P=VAXMLAN
-
-New Decks: P=VAXGS, D=LOCB
- P=VAXSYS, D=UNLINKF
-
----------------------------------------------------------------------
-
-UPDATE 2.39 : 12-Jan-93
--------------------------
-
-Replacing file KERNVAX 2.38 921007 20.12
-
-New Patches: P=*KALPH, ALPHGS for the ALPHA machine with VMS
- P=QMVAXCC new option if C compiler available
-
-New Deck: P=VAXGS, D=RNDM Fortran version
-
-Correct: CHDIRF, GETENVF, GETWDF remove the TRANSIT option
-
----------------------------------------------------------------------
-
-UPDATE 2.38 : 7-Oct-92
--------------------------
-
-Replacing file KERNVAX 2.37 910719 13.16
-
-New Patch: P=VAXSYSML m/language routines extracted from P=VAXSYS
-
----------------------------------------------------------------------
-
-UPDATE 2.37 : 18-July-91
--------------------------
-
-Replacing file KERNVAX 2.36 910306 18.55
-
-Correct : P=VAXGS, D=ABEND re-write to be true abend
-
----------------------------------------------------------------------
-
-UPDATE 2.36 : 6-Mar-91
--------------------------
-
-Replacing file KERNVAX 2.35 900831 13.48
-
-New decks : P=VAXUTIL, D=CD simulate Unix command cd
-
- CHDIRF, GETWDF, GETENVF new standard KERNLIB routines
- RENAMEF, SLEEPF, SYSTEMF
-
-Deleted : P=VAXUTIL, D=FPREP no longer needed
- D=XBANNER now on KERNFOR
- CHDIR, GETCWD, GETENV clashed with the C library
- option TRANSIT gives the old names as ENTRY points
- P=VAXSYS, D=UMCOM,UMLOG moved to a different PAM
-
----------------------------------------------------------------------
-
-UPDATE 2.35 : 31-Aug-90
--------------------------
-
-Replacing file KERNVAX 2.34 900301 12.55
-
-New decks : CHDIR, GETCWD, GETENV simulate Unix system calls
- FFRVAX, FTOVAX handle UNIX file-name syntax
-
-Correct : QNEXTD message more explicit
-
-Deleted : P=*KVIX, P=VIXUTIL never of any use
-
----------------------------------------------------------------------
-
-UPDATE 2.34 : 1-Mar-90
--------------------------
-
-Replacing file KERNVAX 2.33 891121 1.09
-
-Correct : IE3FOS,IE3TOS of P=VAXMLAN bug
-
----------------------------------------------------------------------
-
-UPDATE 2.33 : 20-Nov-89
--------------------------
-
-Replacing file KERNVAX 2.32 890926 22.16
-
-New decks : LOCB return the byte adr of a variable
-
----------------------------------------------------------------------
-
-UPDATE 2.32 : 26-Sep-89
--------------------------
-
-Replacing file KERNVAX 2.31 890323 16.05
-
-New Decks : XBANNER in P=VAXUTIL
-
-Correct : DATIME to return seconds in /SLATE/
- JUMPX2 add entries JUMPX1 and JUMPX0
- PKCHAR,UPKCH correct bug
-
----------------------------------------------------------------------
-
-UPDATE 2.31 : 23-Mar-89
--------------------------
-
-Replacing file KERNVAX 2.30 881021 14.58
-
-New Decks: P=VAXMLAN, D=IE3FOS, IE3TOS Mlan for speed
- P=VAXSYS, D=UMCOM, UMLOG service routines of UMON
- KERNGT to eventually replace GSHOW
-
-Correct : D=VXINVB, VXINBC test on # of words zero / -ve
-
----------------------------------------------------------------------
-
-UPDATE 2.30 : 21-oct-88
--------------------------
-
-Replacing file KERNVAX 2.29 880809 21.00
-
-Correct : D=VXINVB, VXINBC speed-up even further
- D=RNDM multiplier: 690069 to 69069
- D=FPREP fix bug 'C END'
- P=*KVAX remove USE of VAXUTIL
- D=AKMULT add /NOLOG/NOCONF
-
----------------------------------------------------------------------
-
-UPDATE 2.29 : 9-AUG-88
--------------------------
-
-Replacing file KERNVAX 2.28 880712 20.05
-
- Further clean-up preparing for Ultrix
-
----------------------------------------------------------------------
-
-UPDATE 2.28 : 12-JUL-88
--------------------------
-
-Replacing file KERNVAX 2.27 880712 16.52
-
-New Patch: P=VAXMLAN to take all machine-language routines
- preparing for Ultrix
-
----------------------------------------------------------------------
-
-UPDATE 2.27 : 12-JUL-88
--------------------------
-
-Replacing file KERNVAX 2.26 880425 20.38
-
-New Patch: P=*KVIX, VIXUTIL preparing for Ultrix
-
-New Deck: P=VAXUTIL, D=FPREP.
-
-Correct : D=QNEXTE correct for INLIB
-
----------------------------------------------------------------------
-
-UPDATE 2.26 : 25-APR-88
--------------------------
-
-Replacing file KERNVAX 2.25 880302 22.56
-
-NEW : D=JUMPAD, JUMPX2
-
-MOVE : D=XINB, XINBS from P=XVECTVAX to P=VAXGS
-
-DELETE : P=XVECTVAX
-
----------------------------------------------------------------------
-
-UPDATE 2.25 : 3-MAR-88
--------------------------
-
-Replacing file KERNVAX 2.24 870710 10.59
-
-MODIFY : D=QNEXTE change reference to QNEXT to be weak
- D=XINB,XINBS changed to return IOSTAT
- D=IE3TOS fix problem of exponent range
-
-NEW : D=QNEXTD dummy for QNEXTE called if QNEXT missing
-
----------------------------------------------------------------------
-
-UPDATE 2.24 : 10-JUL-87
--------------------------
-
-Replacing file KERNVAX 2.23 870612 20.35
-
-MODIFY : P=QMVAX remove def's Z=Q$JBIT,Q$SBIT,Q$JBYTET
-
----------------------------------------------------------------------
-
-UPDATE 2.23 : 12-JUN-87
--------------------------
-
-Replacing file KERNVAX 2.22 870525 22.01
-
-NEW DECKS : P=VAXSYS, D=VXINVB, VXINVC, VXINVBF, VXINVCF
-
----------------------------------------------------------------------
-
-UPDATE 2.22 : 24-MAY-87
--------------------------
-
-Replacing file KERNVAX 2.21 870121 17.51
-
-NEW DECKS : P=VAXGS, D=JBYTOR
-
-MODIFY : P=*KVAX split in to new *KVAX and new QMVAX
- P=*GVAX deleted
-
----------------------------------------------------------------------
-
-UPDATE 2.21 : 21-JAN-87
--------------------------
-
-Replacing file KERNVAX 2.20 861204 21.07
-
-CORRECTIONS : P=VAXGS, D=UCOPY2,UCTOH,UHTOC correct mistake
-
----------------------------------------------------------------------
-
-UPDATE 2.20 : 4-DEC-86
--------------------------
-
-Replacing file KERNVAX 2.19 861014 11.12
-
-NEW DECKS : P=VAXGS, D=IE3FOD,IQ3FOS,IE3TOD,IE3TOS
-
-CORRECTIONS : P=VAXGS, D=UCOPY2,UCTOH,UHTOC to be shareable
- P=*KVAX new versions of the Q$ sequs
-
----------------------------------------------------------------------
-
-UPDATE 2.19 : 14-OCT-86
--------------------------
-
-Replacing file KERNVAX 2.18 860514 12.39
-
-CORRECTIONS : P=VAXSYS, D=TIMEL FIX BUG, CALL LIST TERMINATED
-
----------------------------------------------------------------------
-
-UPDATE 2.18 : 14-MAY-86
--------------------------
-
-Replacing file KERNVAX 2.17 860131 12.12
-
-CORRECTIONS : P=VAXGS, D=UBLANK,UCOPY2,UZERO,VBLANK,VZERO
- BUG FIXED FOR EXACTLY 65536 BYTES
-
----------------------------------------------------------------------
-
-UPDATE 2.17 : 31-JAN-86
--------------------------
-
-Replacing file KERNVAX 2.16 851205 20.12
-
-CORRECTIONS : P=VAXGS, D=UHTOC BUG FIXED, REGISTER 3 SAVED NOW
-
----------------------------------------------------------------------
-
-UPDATE 2.16 : 5-DEC-85
--------------------------
-
-Replacing file KERNVAX 2.15 850809 15.35
-
-CORRECTIONS : P=VAXGS, D=UCOPY2 BUG FIXED FOR EXACTLY 65536 BYTES
-
----------------------------------------------------------------------
-
-UPDATE 2.15 : 9-AUG-85
--------------------------
-
-Replacing file KERNVAX 2.14 850612 14.50
-
-NEW ROUTINES : P=VAXGS, D=MBYTET,MBYTOR,MCBYT,MSBIT,MSBYT
-
----------------------------------------------------------------------
-
-UPDATE 2.14 : 12-JUN-85
--------------------------
-
-Replacing file KERNVAX 2.13 850603 18.33
-
-CORRECTIONS : P=VAXGS, D=IUHUNT BUG FIXED (R3,R4 NOT SAVED)
-
----------------------------------------------------------------------
-
-UPDATE 2.13 : 3-JUNE-85
--------------------------
-
-Replacing file KERNVAX 2.12 850522 15.42
-
-CORRECTIONS : P=VAXSYS, D=INTRAC CORRECT TYPING MISTAKE
-
----------------------------------------------------------------------
-
-UPDATE 2.12 : 22-MAY-85
--------------------------
-
-Replacing file KERNVAX 2.11 850320 21.08
-
-CORRECTIONS : P=VAXGS, D=NOARG HANDLE ZERO PARAMETERS
- P=VAXSYS, D=TIMEL INFINTE IS 9999.
-
----------------------------------------------------------------------
-
-UPDATE 2.11 : 20-MAR-85
--------------------------
-
-Replacing file KERNVAX 2.10 840815 22.57
-
-NEW DECK : P=VAXSYS, D=INTRAC
-
----------------------------------------------------------------------
-
-UPDATE 2.10 : 16-AUG-84
--------------------------
-
-Replacing file KERNVAX 2.09 840215 18.30
-
-NEW DECK : P=VAXSYS, D=QNEXTE
-
----------------------------------------------------------------------
-
-UPDATE 2.09 : 15-FEB-84
--------------------------
-
-Replacing file KERNVAX 2.08 840210 11.27
-
-PLACE DEFINITIONS OF Z=Q$JBIT, Q$JBYTET INTO P=*KVAX.
-
-CORRECTIONS : P=VAXGS, D=IUMODE, UFLINT Q$JBIT CONNECTED
-
----------------------------------------------------------------------
-
-UPDATE 2.08 : 9-FEB-84
--------------------------
-
-Replacing file KERNVAX 2.07 831122 12.14
-
-CORRECTIONS : P=VAXGS, D=PKCHAR, UPKCH BUGS CORRECTED
-
----------------------------------------------------------------------
-
-UPDATE 2.07 : 22-NOV-83
--------------------------
-
-Replacing file KERNVAX 2.06 830930 12.12
-
-RESTORE D=TIMEL AS IT WAS ON VERSION 2.04
-
----------------------------------------------------------------------
-
-UPDATE 2.06 : 30-SEP-83
--------------------------
-
-Replacing file KERNVAX 2.05 830901 09.00
-
-RENAME P=SYVMS TO P=VAXSYS
-
-MOVE D=SWBL16, SWBU16, TRACEQ, VAXTIO, WAIT2S TO P=VAXSYS
-
-NEW PATCH : P=VAXOBS SAVE SOME OBSOLETE ROUTINES
- FROM VERSION 2.04 INTO HERE JUST IN CASE
-
----------------------------------------------------------------------
-
-UPDATE 2.05 : 1-SEP-83
--------------------------
-
-Replacing file KERNVAX 2.04 830531 16.49
-
-NEW PATCHES : P=SYVMS VAX SPECIAL SYSTEM ROUTINES
-
- P=VAXUTIL, D=AKMULT MOVED FROM PATCH VAXGS
-
-NEW DECKS : P=VAXGS, D=CBYT, IUCOMP, IUFIND, IUHUNT, IUSAME, JBYTET
- JBYTPK, JRSBYT, LVMAX, LVMAXA, LVMIN, LVMINA
- PKBYT, PKCHAR, SBYTOR, SBYTPK, UCOPIV, UCOPYN
- UFILL, UPKBYT, UPKCH, USWOP, VADD, VASUM, VBIAS
- VBLANK, VCOPYN, VDOT, VDOTN, VDOTN2, VEXCUM
- VFILL, VFIX, VFLOAT, VLINE, VMATL, VMATR, VMAX
- VMAXA, VMIN, VMINA, VMOD, VMUL, VSCALE, VSUB
- VSUM, VUNIT
-
- P=SYVMS, D=JOBNAM, TIMED, TIMEL, TIMEX
-
----------------------------------------------------------------------
-
-UPDATE 2.04 : 31-MAY-83
--------------------------
-
-Replacing file KERNVAX 2.03 830524 18.34
-
-NEW DECK : P=VAXGS, D=UHOLLR TO FILL TRAILING BLANKS
-
-CORRECTIONS: P=VAXGS, D=VAXTIO, WAIT2S CHARACTER 'PER-CENT' LOST
-
----------------------------------------------------------------------
-
-UPDATE 2.03 : 24-MAY-83
--------------------------
-
-Replacing file KERNVAX 2.02 821007 13.16
-
-NEW DECKS: P=VAXGS, D=VAXTIO, WAIT2S
-
----------------------------------------------------------------------
-
-UPDATE 2.02 : 7-OCT-82
--------------------------
-
-Replacing file KERNVAX 2.01 820923 12.08
-
-CORRECTIONS : P=VAXGS, D=LOCF ADD +USE,...,T=INH.
-
----------------------------------------------------------------------
-
-UPDATE 2.01 : 23-SEP-82
--------------------------
-
-Replacing file KERNVAX 2.00 820801 12.00
-
-NEW DECKS: P=VAXGS, D=UCTOH, UHTOC
-
----------------------------------------------------------------------
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/history/kernvax/update.dat b/src/packlib/kernlib/kerngen/history/kernvax/update.dat
deleted file mode 100644
index 95e7ff0..0000000
--- a/src/packlib/kernlib/kerngen/history/kernvax/update.dat
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: update.dat,v 1.1.1.1 1996/02/15 17:50:47 mclareni Exp $
-*
-* $Log: update.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:50:47 mclareni
-* Kernlib
-*
-*
-#if !defined(CERNLIB_KERNVAX)
-
-
- UP-DATE RECORD FOR THE PAM-FILE KERNVAX, VERSION 2
- ---------------------------------------------------
-
-
-UPDATE 2.47 : 18-July-95
---------------------------
-
-Replacing file KERNVAX 2.46 940913 14.37
-
-Correct: on the Alpha: use the new VXINVB, VXINVC from KERNFOR
-
----------------------------------------------------------------------
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/history/kernvmi/history.dat b/src/packlib/kernlib/kerngen/history/kernvmi/history.dat
deleted file mode 100644
index aab2043..0000000
--- a/src/packlib/kernlib/kerngen/history/kernvmi/history.dat
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: history.dat,v 1.1.1.1 1996/02/15 17:50:48 mclareni Exp $
-*
-* $Log: history.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:50:48 mclareni
-* Kernlib
-*
-*
-* This directory was created from kernvmi.car patch kernvmi
-#if !defined(CERNLIB_KERNVMI)
-
- KERNLIB routines particular to VAX / MIPS
-
----------------------------------------------------------------------
-
- This file contains the following patches :
-
-*KVAOS Pilot patch to make KERNLIB for Alpha OSF 32-bit
-*KVMI Pilot patch to make KERNLIB for VAX / MIPS
-
-QMVAOS VAO machine patch, short, 32 bit
-QMVMI VMI machine patch
-
-VAOGS VAOS specific routines
-VMIGS VMI specific routines
-ALLGS specific routines both for VMI and VAO 32-bit
-
-QMVAO option for VAX Alpha both short and long, 32 or 64 bits
-
-=====================================================================
-#endif
diff --git a/src/packlib/kernlib/kerngen/history/kernvmi/previous.dat b/src/packlib/kernlib/kerngen/history/kernvmi/previous.dat
deleted file mode 100644
index 007f3c8..0000000
--- a/src/packlib/kernlib/kerngen/history/kernvmi/previous.dat
+++ /dev/null
@@ -1,99 +0,0 @@
-*
-* $Id: previous.dat,v 1.1.1.1 1996/02/15 17:50:48 mclareni Exp $
-*
-* $Log: previous.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:50:48 mclareni
-* Kernlib
-*
-*
-#if !defined(CERNLIB_KERNVMI)
-
-UP-DATE 1.09 : 31-May-1994
-----------------------------
-
-Replacing File KERNVMI 1.08 930603 10.40
-
-New Patches: P=P5BOOT for the Patchy 5 bootstrap
-
-New decks: P=VAOGS, D=JUMPTN for the Alpha
-
----------------------------------------------------------------------
-
-UP-DATE 1.08 : 27-May-1993
-----------------------------
-
-Replacing File KERNVMI 1.07 930511 18.03
-
-New Patches: *KVAOS, QMVAOS, VAOGS for DEC Alpha OSF 32-bit
-
-Renamed: P=VMIGS to P=ALLGS
- P=VMIMLAN to P=VMIGS
-
----------------------------------------------------------------------
-
-UP-DATE 1.07 : 11-May-1993
-----------------------------
-
-Replacing File KERNVMI 1.06 920521 16.31
-
-New Patch: VMIMLAN moved machine-language routines for MIPS
- D=JUMPXN, SETJMP, LONGJMP from P=VMIGS
-
----------------------------------------------------------------------
-
-UP-DATE 1.06 : 11-May-1992
-----------------------------
-
-Replacing File KERNVMI 1.05 910719 13.17
-
-New Decks: LENOCC, LNBLNK for speed
-
----------------------------------------------------------------------
-
-UP-DATE 1.05 : 18-July-1991
-----------------------------
-
-Replacing File KERNVMI 1.04 910225 21.14
-
-Delete : D=QNEXTE use default from KERNFOR
-
----------------------------------------------------------------------
-
-UP-DATE 1.04 : 25-Feb-1991
-----------------------------
-
-Replacing File KERNVMI 1.03 900726 22.43
-
-Correct : connect P=CCGEN, CCGENCF of KERNFOR
-
----------------------------------------------------------------------
-
-UP-DATE 1.03 : 26-July-1990
-----------------------------
-
-Replacing File KERNVMI 1.02 900228 16.29
-
-Correct : connect some CCGEN routines
- use the BSD42 option
-
-Delete Decks : GSHOW, DATIME, DATIMH, INTRAC, IUFORW
- LOCB, LOCF, TIMEX
-
----------------------------------------------------------------------
-
-UP-DATE 1.02 : 21-Feb-1990
-----------------------------
-
-Replacing File KERNVMI 1.01 891208 12.00
-
-New Decks : IUCOMH
-
-Correct : FCASPLIT to be used from KERNFOR
-
----------------------------------------------------------------------
-
- First release of the KERNVMI Pam : 8-Dec-1989
-
----------------------------------------------------------------------
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/history/kernvmi/update.dat b/src/packlib/kernlib/kerngen/history/kernvmi/update.dat
deleted file mode 100644
index cb4cf1b..0000000
--- a/src/packlib/kernlib/kerngen/history/kernvmi/update.dat
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: update.dat,v 1.1.1.1 1996/02/15 17:50:48 mclareni Exp $
-*
-* $Log: update.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:50:48 mclareni
-* Kernlib
-*
-*
-#if !defined(CERNLIB_KERNVMI)
-
-
- Up-date record for the Pam-file KERNVMI
- ----------------------------------------
-
-
-UP-DATE 1.10 : 18-July-1995
-----------------------------
-
-Replacing File KERNVMI 1.09 940530 22.05
-
-Correct : use the new C routines VXINVB, VXINVC from KERFOR
-
----------------------------------------------------------------------
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/history/uguide.dat b/src/packlib/kernlib/kerngen/history/uguide.dat
deleted file mode 100644
index a0fded2..0000000
--- a/src/packlib/kernlib/kerngen/history/uguide.dat
+++ /dev/null
@@ -1,9 +0,0 @@
-*
-* $Id: uguide.dat,v 1.1.1.1 1996/02/15 17:50:42 mclareni Exp $
-*
-* $Log: uguide.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:50:42 mclareni
-* Kernlib
-*
-*
-* User Guide
diff --git a/src/packlib/kernlib/kerngen/history/v100.dat b/src/packlib/kernlib/kerngen/history/v100.dat
deleted file mode 100644
index 87ebd31..0000000
--- a/src/packlib/kernlib/kerngen/history/v100.dat
+++ /dev/null
@@ -1,11 +0,0 @@
-*
-* $Id: v100.dat,v 1.1.1.1 1996/02/15 17:50:42 mclareni Exp $
-*
-* $Log: v100.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:50:42 mclareni
-* Kernlib
-*
-*
-* Version 1.00 920307 16.00
-C- First release
-C
diff --git a/src/packlib/kernlib/kerngen/history/v101.dat b/src/packlib/kernlib/kerngen/history/v101.dat
deleted file mode 100644
index f8d89af..0000000
--- a/src/packlib/kernlib/kerngen/history/v101.dat
+++ /dev/null
@@ -1,13 +0,0 @@
-*
-* $Id: v101.dat,v 1.1.1.1 1996/02/15 17:50:42 mclareni Exp $
-*
-* $Log: v101.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:50:42 mclareni
-* Kernlib
-*
-*
-* Version 1.01 930304 19.00
-C- Add NEXT flag (F. Dittus/University Bern)
-C- Add CONVEX32/64, MSDOS, OPENVMS flags
-C- Add SHIFT
-C
diff --git a/src/packlib/kernlib/kerngen/kerngen/Imakefile b/src/packlib/kernlib/kerngen/kerngen/Imakefile
deleted file mode 100644
index d10a0ec..0000000
--- a/src/packlib/kernlib/kerngen/kerngen/Imakefile
+++ /dev/null
@@ -1,9 +0,0 @@
-INCLUDES= iall1s.inc iallbl.inc q_andor.inc q_cbyt.inc \ @@\
- q_isabit.inc q_jbit.inc q_jbytet.inc q_sbit.inc q_sbyt.inc \ @@\
- q_shift.inc qnatch.inc qnatchdata.inc ublowx1.inc ubnchx1.inc \ @@\
- wordsize.inc cf_clos.h cf_open.h cf_reaw.h cf_seek.h cf_xaft.h \ @@\
- fortchar.h fortranc.h kalph.h kdecwnt.h kdos.h khpx.h kirt.h kirtd.h \ @@\
- klnx.h kmpw.h kos9.h ksgi.h ksun.h kvaos.h kvax.h kvmi.h kwnt.h \ @@\
- pilot.h qf_f2c.h wordsizc.h
-
-InstallIncludes($(INCLUDES),$(CERN_INCLUDEDIR),kerngen)
diff --git a/src/packlib/kernlib/kerngen/kerngen/cf_clos.h b/src/packlib/kernlib/kerngen/kerngen/cf_clos.h
deleted file mode 100644
index 03b8b29..0000000
--- a/src/packlib/kernlib/kerngen/kerngen/cf_clos.h
+++ /dev/null
@@ -1,30 +0,0 @@
-/*
-* $Id: cf_clos.h,v 1.2 1997/02/04 17:35:35 mclareni Exp $
-*
-* $Log: cf_clos.h,v $
-* Revision 1.2 1997/02/04 17:35:35 mclareni
-* Merge Winnt and 97a versions
-*
-* Revision 1.1.1.1.2.1 1997/01/21 11:30:25 mclareni
-* All mods for Winnt 96a on winnt branch
-*
-* Revision 1.1.1.1 1996/02/15 17:49:20 mclareni
-* Kernlib
-*
-*
-*
-* cf#clos.inc
-*/
-#if defined(CERNLIB_QMAPO)||defined(CERNLIB_QMOS9)
-#elif defined(CERNLIB_QMVAX)
-#include <file.h> /* VAX/VMS */
-#elif defined(CERNLIB_QMDOS) || defined(CERNLIB_WINNT)
- #ifdef WIN32
-# ifdef __STDC__
-# undef __STDC__
-# endif
- #include <io.h>
- #endif
-#else
-#include <unistd.h> /* default Posix */
-#endif
diff --git a/src/packlib/kernlib/kerngen/kerngen/cf_open.h b/src/packlib/kernlib/kerngen/kerngen/cf_open.h
deleted file mode 100644
index 576fd64..0000000
--- a/src/packlib/kernlib/kerngen/kerngen/cf_open.h
+++ /dev/null
@@ -1,52 +0,0 @@
-/*
-* $Id: cf_open.h,v 1.2 1997/02/04 17:35:35 mclareni Exp $
-*
-* $Log: cf_open.h,v $
-* Revision 1.2 1997/02/04 17:35:35 mclareni
-* Merge Winnt and 97a versions
-*
-* Revision 1.1.1.1.2.1 1997/01/21 11:30:25 mclareni
-* All mods for Winnt 96a on winnt branch
-*
-* Revision 1.1.1.1 1996/02/15 17:49:17 mclareni
-* Kernlib
-*
-*
-*
-* cf#open.inc
-*/
-#if defined(CERNLIB_QMAPO)
-#include <sys/file.h> /* Apollo */
-#elif defined(CERNLIB_QMAMX)
-#include <sys/types.h> /* AMX */
-#include <sys/fcntl.h>
-#include <sys/file.h>
-#elif defined(CERNLIB_QMCRY)||defined(CERNLIB_QMHPX)||defined(CERNLIB_QMIBX)||defined(CERNLIB_QMSUN)
-#include <fcntl.h> /* CRAY HPX IBX SUN */
-#elif defined(CERNLIB_QMIRT)||defined(CERNLIB_QMIRTD)
-#include <fcntl.h> /* IRT */
-#include <sys/mode.h>
-#elif defined(CERNLIB_QMVAX)
-#include <file.h> /* VAX/VMS */
-#elif defined(CERNLIB_QMVMI)
-#include <sys/types.h>
-#include <sys/stat.h>
-#include <fcntl.h> /* VMI Decstation */
-#elif defined(CERNLIB_QMDOS) || defined(CERNLIB_WINNT)
-#ifdef __GNUC__
-#include <sys/file.h>
-#else
-# ifdef WIN32
-# ifdef __STDC__
-# undef __STDC__
-# endif
-# include <io.h>
-# include <stdio.h>
-# include <fcntl.h>
-# endif
-#endif
-#else
-#include <sys/types.h>
-#include <sys/stat.h>
-#include <sys/fcntl.h> /* default Posix */
-#endif
diff --git a/src/packlib/kernlib/kerngen/kerngen/cf_reaw.h b/src/packlib/kernlib/kerngen/kerngen/cf_reaw.h
deleted file mode 100644
index 34c8c98..0000000
--- a/src/packlib/kernlib/kerngen/kerngen/cf_reaw.h
+++ /dev/null
@@ -1,32 +0,0 @@
-/*
-* $Id: cf_reaw.h,v 1.2 1997/02/04 17:35:36 mclareni Exp $
-*
-* $Log: cf_reaw.h,v $
-* Revision 1.2 1997/02/04 17:35:36 mclareni
-* Merge Winnt and 97a versions
-*
-* Revision 1.1.1.1.2.1 1997/01/21 11:30:26 mclareni
-* All mods for Winnt 96a on winnt branch
-*
-* Revision 1.1.1.1 1996/02/15 17:49:17 mclareni
-* Kernlib
-*
-*
-*
-* cf#reaw.inc
-*/
-#if defined(CERNLIB_QMAPO)
-#elif defined(CERNLIB_QMOS9)
-#include <stdio.h> /* Microware OS-9 */
-#elif defined(CERNLIB_QMVAX)
-#include <file.h> /* VAX/VMS */
-#elif defined(CERNLIB_QMDOS) ||defined(CERNLIB_WINNT)
- #ifdef WIN32
-# ifdef __STDC__
-# undef __STDC__
-# endif
- #include <io.h>
- #endif
-#else
-#include <unistd.h> /* default Posix */
-#endif
diff --git a/src/packlib/kernlib/kerngen/kerngen/cf_seek.h b/src/packlib/kernlib/kerngen/kerngen/cf_seek.h
deleted file mode 100644
index 42973b5..0000000
--- a/src/packlib/kernlib/kerngen/kerngen/cf_seek.h
+++ /dev/null
@@ -1,45 +0,0 @@
-/*
-* $Id: cf_seek.h,v 1.2 1997/02/04 17:35:36 mclareni Exp $
-*
-* $Log: cf_seek.h,v $
-* Revision 1.2 1997/02/04 17:35:36 mclareni
-* Merge Winnt and 97a versions
-*
-* Revision 1.1.1.1.2.1 1997/01/21 11:30:26 mclareni
-* All mods for Winnt 96a on winnt branch
-*
-* Revision 1.1.1.1 1996/02/15 17:49:17 mclareni
-* Kernlib
-*
-*
-*
-* cf#seek.inc
-*/
-#if defined(CERNLIB_QMAPO)
-#include <sys/file.h> /* Apollo */
-#elif defined(CERNLIB_QMAMX)
-#include <sys/types.h> /* AMX */
-#include <sys/file.h>
-#elif defined(CERNLIB_QMOS9)
-#include <stdio.h> /* Microware OS-9 */
-#elif defined(CERNLIB_QMVAX)
-#include <file.h> /* VAX/VMS */
-#elif defined(CERNLIB_QMIRTD)
-#include <unistd.h> /* IRTD */
-#elif defined(CERNLIB_QMDOS) || defined(CERNLIB_WINNT)
- #ifdef __GNUC__
- #include <sys/file.h>
- #include <unistd.h>
- #else
- #ifdef __STDC__
- #undef __STDC__
- #endif
- #include <stdio.h>
- #ifdef WIN32
- #include <io.h>
- #endif
- #endif
-#else
-#include <sys/types.h> /* default Posix */
-#include <unistd.h>
-#endif
diff --git a/src/packlib/kernlib/kerngen/kerngen/cf_xaft.h b/src/packlib/kernlib/kerngen/kerngen/cf_xaft.h
deleted file mode 100644
index a3d29bd..0000000
--- a/src/packlib/kernlib/kerngen/kerngen/cf_xaft.h
+++ /dev/null
@@ -1,20 +0,0 @@
-/*
-* $Id: cf_xaft.h,v 1.2 1999/11/10 17:30:05 mclareni Exp $
-*
-* $Log: cf_xaft.h,v $
-* Revision 1.2 1999/11/10 17:30:05 mclareni
-* Shift version 1.1.4.4 needs POSIX defined on Win32
-*
-* Revision 1.1.1.1 1996/02/15 17:49:17 mclareni
-* Kernlib
-*
-*
-*
-* cf#xaft.inc
-*/
-#if defined(CERNLIB_PROJSHIFT)
-#if defined(_WIN32)
-#define _POSIX_
-#endif
-#include <shift.h>
-#endif
diff --git a/src/packlib/kernlib/kerngen/kerngen/fortchar.h b/src/packlib/kernlib/kerngen/kerngen/fortchar.h
deleted file mode 100644
index b33c27e..0000000
--- a/src/packlib/kernlib/kerngen/kerngen/fortchar.h
+++ /dev/null
@@ -1,15 +0,0 @@
-/*
-* $Id: fortchar.h,v 1.1.1.1 1996/02/15 17:49:18 mclareni Exp $
-*
-* $Log: fortchar.h,v $
-* Revision 1.1.1.1 1996/02/15 17:49:18 mclareni
-* Kernlib
-*
-*
-* for C routines receiving a Fortran Character string
-*
-* fortchar.inc
-*/
-#if defined(CERNLIB_QMCRY)
-#include <fortran.h>
-#endif
diff --git a/src/packlib/kernlib/kerngen/kerngen/fortranc.h b/src/packlib/kernlib/kerngen/kerngen/fortranc.h
deleted file mode 100644
index 76e9cd9..0000000
--- a/src/packlib/kernlib/kerngen/kerngen/fortranc.h
+++ /dev/null
@@ -1,19 +0,0 @@
-#ifdef WIN32
-# ifdef CERNLIB_MSSTDCALL
-# define F77_UCASE
-# define type_of_call _stdcall
-# ifndef CERNLIB_QXCAPT
-# define CERNLIB_QXCAPT
-# endif
-# else
-# define F77_LCASE
-# ifndef CERNLIB_QXNO_SC
-# define CERNLIB_QXNO_SC
-# endif
-# endif
-#endif
-
-#ifndef type_of_call
-#define type_of_call
-#endif
-
diff --git a/src/packlib/kernlib/kerngen/kerngen/iall1s.inc b/src/packlib/kernlib/kerngen/kerngen/iall1s.inc
deleted file mode 100644
index 9e89509..0000000
--- a/src/packlib/kernlib/kerngen/kerngen/iall1s.inc
+++ /dev/null
@@ -1,6 +0,0 @@
-C set a word of all ones
-#if defined(CERNLIB_QMDOS) && !defined(CERNLIB_QFMSOFT)
- PARAMETER (IALL11 = NOT(0))
-#else
- PARAMETER (IALL11 = -1)
-#endif
diff --git a/src/packlib/kernlib/kerngen/kerngen/iallbl.inc b/src/packlib/kernlib/kerngen/kerngen/iallbl.inc
deleted file mode 100644
index e778e64..0000000
--- a/src/packlib/kernlib/kerngen/kerngen/iallbl.inc
+++ /dev/null
@@ -1,3 +0,0 @@
-* a word of all blanks
-C- - PARAMETER (IALLBL = X'20202020')
- PARAMETER (IALLBL = 538976288 )
diff --git a/src/packlib/kernlib/kerngen/kerngen/kalph.h b/src/packlib/kernlib/kerngen/kerngen/kalph.h
deleted file mode 100644
index b96d4b8..0000000
--- a/src/packlib/kernlib/kerngen/kerngen/kalph.h
+++ /dev/null
@@ -1,38 +0,0 @@
-#if 0
-* for VAX
-* This pilot patch was created from kernvax.car patch _kalph
-* This directory was created from kernvax.car patch vaxalpha
-* This directory was created from kernvax.car patch qmvax
-* This directory was created from kernfor.car patch qmvax
-* CC assumed available
-* external names without underscores
-* ISA standard routines, ISHFT, IOR, etc
-* MIL standard routines, IBITS, MVBITS, ISHFTC
-* Hollerith constants exist
-* EQUIVALENCE Hollerith/Character ok
-* Hollerith storage not orthodox
-#endif
-#ifndef CERNLIB_QMALPH
-#define CERNLIB_QMALPH
-#endif
-#ifndef CERNLIB_QMVAXCC
-#define CERNLIB_QMVAXCC
-#endif
-#ifndef CERNLIB_QMVAX
-#define CERNLIB_QMVAX
-#endif
-#ifndef CERNLIB_QXNO_SC
-#define CERNLIB_QXNO_SC
-#endif
-#ifndef CERNLIB_QISASTD
-#define CERNLIB_QISASTD
-#endif
-#ifndef CERNLIB_QMILSTD
-#define CERNLIB_QMILSTD
-#endif
-#ifdef CERNLIB_QORTHOLL
-#undef CERNLIB_QORTHOLL
-#endif
-#ifndef CERNLIB_QINTZERO
-#define CERNLIB_QINTZERO
-#endif
diff --git a/src/packlib/kernlib/kerngen/kerngen/kdecwnt.h b/src/packlib/kernlib/kerngen/kerngen/kdecwnt.h
deleted file mode 100644
index cad2a82..0000000
--- a/src/packlib/kernlib/kerngen/kerngen/kdecwnt.h
+++ /dev/null
@@ -1,56 +0,0 @@
-#if 0
-* This pilot patch was created from kerndos.car patch _kdecwnt
-* This pilot patch was created from kerndos.car patch _kdos
-* This directory was created from kerndos.car patch qmdos
-#endif
-#ifndef CERNLIB_QF_DEC
-#define CERNLIB_QF_DEC
-#endif
-#ifndef CERNLIB_QS_WNT
-#define CERNLIB_QS_WNT
-#endif
-#if (!defined(CERNLIB_QF_DEC))&&(!defined(CERNLIB_QF_NDP))
-#ifndef CERNLIB_QF_F2C
-#define CERNLIB_QF_F2C
-#endif
-#endif
-#if !defined(CERNLIB_QS_WNT)
-#ifndef CERNLIB_QS_DOS
-#define CERNLIB_QS_DOS
-#endif
-#endif
-#ifndef CERNLIB_QMDOS
-#define CERNLIB_QMDOS
-#endif
-#ifndef CERNLIB_QX_SC
-#define CERNLIB_QX_SC
-#endif
-#ifndef CERNLIB_QIEEE
-#define CERNLIB_QIEEE
-#endif
-#if defined(CERNLIB_QF_NDP)||defined(CERNLIB_QF_DEC)
-#ifndef CERNLIB_QISASTD
-#define CERNLIB_QISASTD
-#endif
-#ifndef CERNLIB_QMILSTD
-#define CERNLIB_QMILSTD
-#endif
-#endif
-#ifdef CERNLIB_QORTHOLL
-#undef CERNLIB_QORTHOLL
-#endif
-#ifndef CERNLIB_F77TRARG
-#define CERNLIB_F77TRARG
-#endif
-#ifndef CERNLIB_QCFIO
-#define CERNLIB_QCFIO
-#endif
-#ifndef CERNLIB_QGETCWD
-#define CERNLIB_QGETCWD
-#endif
-#ifndef CERNLIB_QINTCOPY
-#define CERNLIB_QINTCOPY
-#endif
-#ifndef CERNLIB_QINTZERO
-#define CERNLIB_QINTZERO
-#endif
diff --git a/src/packlib/kernlib/kerngen/kerngen/kdos.h b/src/packlib/kernlib/kerngen/kerngen/kdos.h
deleted file mode 100644
index 168c5bf..0000000
--- a/src/packlib/kernlib/kerngen/kerngen/kdos.h
+++ /dev/null
@@ -1,49 +0,0 @@
-#if 0
-* This pilot patch was created from kerndos.car patch _kdos
-* This directory was created from kerndos.car patch qmdos
-#endif
-#if (!defined(CERNLIB_QF_DEC))&&(!defined(CERNLIB_QF_NDP))
-#ifndef CERNLIB_QF_F2C
-#define CERNLIB_QF_F2C
-#endif
-#endif
-#if !defined(CERNLIB_QS_WNT)
-#ifndef CERNLIB_QS_DOS
-#define CERNLIB_QS_DOS
-#endif
-#endif
-#ifndef CERNLIB_QMDOS
-#define CERNLIB_QMDOS
-#endif
-#ifndef CERNLIB_QX_SC
-#define CERNLIB_QX_SC
-#endif
-#ifndef CERNLIB_QIEEE
-#define CERNLIB_QIEEE
-#endif
-#if defined(CERNLIB_QF_NDP)||defined(CERNLIB_QF_DEC)
-#ifndef CERNLIB_QISASTD
-#define CERNLIB_QISASTD
-#endif
-#ifndef CERNLIB_QMILSTD
-#define CERNLIB_QMILSTD
-#endif
-#endif
-#ifdef CERNLIB_QORTHOLL
-#undef CERNLIB_QORTHOLL
-#endif
-#ifndef CERNLIB_F77TRARG
-#define CERNLIB_F77TRARG
-#endif
-#ifndef CERNLIB_QCFIO
-#define CERNLIB_QCFIO
-#endif
-#ifndef CERNLIB_QGETCWD
-#define CERNLIB_QGETCWD
-#endif
-#ifndef CERNLIB_QINTCOPY
-#define CERNLIB_QINTCOPY
-#endif
-#ifndef CERNLIB_QINTZERO
-#define CERNLIB_QINTZERO
-#endif
diff --git a/src/packlib/kernlib/kerngen/kerngen/khpx.h b/src/packlib/kernlib/kerngen/kerngen/khpx.h
deleted file mode 100644
index 984646c..0000000
--- a/src/packlib/kernlib/kerngen/kerngen/khpx.h
+++ /dev/null
@@ -1,46 +0,0 @@
-#if 0
-* This pilot patch was created from kernhpx.car patch _khpx
-* external names with underscore
-* IEEE floating point
-* Hollerith constants exist
-* EQUIVALENCE Hollerith/Character ok
-* Orthodox Hollerith storage left to right
-* Internal double-precision
-* ISA standard routines, ISHFT, IOR, etc
-* MIL standard routines, IBITS, MVBITS, etc
-#endif
-#ifndef CERNLIB_QMHPX
-#define CERNLIB_QMHPX
-#endif
-#if !defined(CERNLIB_QXNO_SC)
-#ifndef CERNLIB_QX_SC
-#define CERNLIB_QX_SC
-#endif
-#endif
-#ifndef CERNLIB_QIEEE
-#define CERNLIB_QIEEE
-#endif
-#ifndef CERNLIB_QORTHOLL
-#define CERNLIB_QORTHOLL
-#endif
-#ifndef CERNLIB_INTDOUBL
-#define CERNLIB_INTDOUBL
-#endif
-#ifndef CERNLIB_QISASTD
-#define CERNLIB_QISASTD
-#endif
-#ifndef CERNLIB_QMILSTD
-#define CERNLIB_QMILSTD
-#endif
-#ifndef CERNLIB_QS_UNIX
-#define CERNLIB_QS_UNIX
-#endif
-#ifndef CERNLIB_QGETCWD
-#define CERNLIB_QGETCWD
-#endif
-#ifndef CERNLIB_QSIGPOSIX
-#define CERNLIB_QSIGPOSIC
-#endif
-#ifndef CERNLIB_QINTZERO
-#define CERNLIB_QINTZERO
-#endif
diff --git a/src/packlib/kernlib/kerngen/kerngen/kirt.h b/src/packlib/kernlib/kerngen/kerngen/kirt.h
deleted file mode 100644
index f3550a8..0000000
--- a/src/packlib/kernlib/kerngen/kerngen/kirt.h
+++ /dev/null
@@ -1,47 +0,0 @@
-#if 0
-* for IBM / RT
-* This pilot patch was created from kernirt.car patch _kirt
-* This directory was created from kernirt.car patch qmirt
-* This directory was created from kernfor.car patch qmirt
-* Normal Unix system machine
-* Posix call for setjmp/longjmp
-* MIL standard routines, IBITS, MVBITS, etc
-* ISA standard routines, ISHFT, IOR, etc
-* External names with underscore
-* IEEE floating point
-* Hollerith constants exist
-* EQUIVALENCE Hollerith/Character ok
-* Orthodox Hollerith storage left to right
-* running Unix
-* Posix call for signal
-#endif
-#ifndef CERNLIB_QMIRT
-#define CERNLIB_QMIRT
-#endif
-#ifndef CERNLIB_QSIGJMP
-#define CERNLIB_QSIGJMP
-#endif
-#ifndef CERNLIB_QMILSTD
-#define CERNLIB_QMILSTD
-#endif
-#ifndef CERNLIB_QISASTD
-#define CERNLIB_QISASTD
-#endif
-#ifndef CERNLIB_QX_SC
-#define CERNLIB_QX_SC
-#endif
-#ifndef CERNLIB_QIEEE
-#define CERNLIB_QIEEE
-#endif
-#ifndef CERNLIB_QORTHOLL
-#define CERNLIB_QORTHOLL
-#endif
-#ifndef CERNLIB_QS_UNIX
-#define CERNLIB_QS_UNIX
-#endif
-#ifndef CERNLIB_QINTZERO
-#define CERNLIB_QINTZERO
-#endif
-#ifndef CERNLIB_QSIGPOSIX
-#define CERNLIB_QSIGPOSIX
-#endif
diff --git a/src/packlib/kernlib/kerngen/kerngen/kirtd.h b/src/packlib/kernlib/kerngen/kerngen/kirtd.h
deleted file mode 100644
index 3e49c09..0000000
--- a/src/packlib/kernlib/kerngen/kerngen/kirtd.h
+++ /dev/null
@@ -1,40 +0,0 @@
-#if 0
-* This directory was created from kernirt.car patch qmirtd
-* This pilot patch was created from kernirt.car patch _kirtd
-* Normal Unix system machine
-* Posix call for setjmp/longjmp
-* MIL standard routines, IBITS, MVBITS, etc
-* ISA standard routines, ISHFT, IOR, etc
-* External names with underscore
-* IEEE floating point
-* Hollerith constants exist
-* EQUIVALENCE Hollerith/Character ok
-* Orthodox Hollerith storage left to right
-#endif
-#ifndef CERNLIB_QMIRTD
-#define CERNLIB_QMIRTD
-#endif
-#ifndef CERNLIB_QSIGJMP
-#define CERNLIB_QSIGJMP
-#endif
-#ifndef CERNLIB_QMILSTD
-#define CERNLIB_QMILSTD
-#endif
-#ifndef CERNLIB_QISASTD
-#define CERNLIB_QISASTD
-#endif
-#ifndef CERNLIB_QX_SC
-#define CERNLIB_QX_SC
-#endif
-#ifndef CERNLIB_QIEEE
-#define CERNLIB_QIEEE
-#endif
-#ifndef CERNLIB_QORTHOLL
-#define CERNLIB_QORTHOLL
-#endif
-#ifdef CERNLIB_QINTCOPY
-#undef CERNLIB_QINTCOPY
-#endif
-#ifdef CERNLIB_QINTZERO
-#undef CERNLIB_QINTZERO
-#endif
diff --git a/src/packlib/kernlib/kerngen/kerngen/klnx.h b/src/packlib/kernlib/kerngen/kerngen/klnx.h
deleted file mode 100644
index 9483dc4..0000000
--- a/src/packlib/kernlib/kerngen/kerngen/klnx.h
+++ /dev/null
@@ -1,40 +0,0 @@
-#if 0
-* This pilot patch was created from kernlnx.car patch _klnx
-* This directory was created from kernlnx.car patch qmlnx
-* Normal Unix system machine
-* Posix call for setjmp/longjmp
-* IEEE floating point
-* ISA standard routines, ISHFT, IOR, etc
-* Hollerith storage not orthodox
-* UCOPY et al. to copy integers
-#endif
-#ifndef CERNLIB_QMLNX
-#define CERNLIB_QMLNX
-#endif
-#ifndef CERNLIB_QPOSIX
-#define CERNLIB_QPOSIX
-#endif
-#ifndef CERNLIB_QIEEE
-#define CERNLIB_QIEEE
-#endif
-#if (!defined(CERNLIB_PPC))
-# ifdef CERNLIB_QISASTD
-# undef CERNLIB_QISASTD
-# endif
-# ifdef CERNLIB_QORTHOLL
-# undef CERNLIB_QORTHOLL
-# endif
-#else
-# ifndef CERNLIB_QISASTD
-# define CERNLIB_QISASTD
-# endif
-# ifndef CERNLIB_QORTHOLL
-# define CERNLIB_QORTHOLL
-# endif
-#endif
-#ifndef CERNLIB_QINTCOPY
-#define CERNLIB_QINTCOPY
-#endif
-#ifndef CERNLIB_QINTZERO
-#define CERNLIB_QINTZERO
-#endif
diff --git a/src/packlib/kernlib/kerngen/kerngen/kmpw.h b/src/packlib/kernlib/kerngen/kerngen/kmpw.h
deleted file mode 100644
index 2028bdb..0000000
--- a/src/packlib/kernlib/kerngen/kerngen/kmpw.h
+++ /dev/null
@@ -1,26 +0,0 @@
-#if 0
-* for MAC II, MPW shell, LSE compiler
-* This pilot patch was created from kernmpw.car patch _kmpw
-* This directory was created from kernmpw.car patch qmmpw
-* This directory was created from kernfor.car patch qmmpw
-* ISA standard routines, ISHFT, IOR, etc
-* IEEE floating point
-#endif
-#ifndef CERNLIB_QMMPW
-#define CERNLIB_QMMPW
-#endif
-#ifndef CERNLIB_F77
-#define CERNLIB_F77
-#endif
-#ifndef CERNLIB_QIEEE
-#define CERNLIB_QIEEE
-#endif
-#ifndef CERNLIB_QISASTD
-#define CERNLIB_QISASTD
-#endif
-#ifndef CERNLIB_QORTHOLL
-#define CERNLIB_QORTHOLL
-#endif
-#ifndef CERNLIB_QINTZERO
-#define CERNLIB_QINTZERO
-#endif
diff --git a/src/packlib/kernlib/kerngen/kerngen/kos9.h b/src/packlib/kernlib/kerngen/kerngen/kos9.h
deleted file mode 100644
index a74eed2..0000000
--- a/src/packlib/kernlib/kerngen/kerngen/kos9.h
+++ /dev/null
@@ -1,47 +0,0 @@
-#if 0
-* for Microware OS-9
-* This pilot patch was created from kernos9.car patch _kos9
-* This directory was created from kernos9.car patch qmos9
-* This directory was created from kernfor.car patch qmos9
-* external names with underscore
-* IEEE floating point
-* Hollerith constants exist
-* EQUIVALENCE Hollerith/Character ok
-* Internal double-precision
-* Orthodox Hollerith storage left to right
-* ISA standard routines, ISHFT, IOR, etc
-* MIL standard routines, IBITS, MVBITS, etc
-* running Unix
-#endif
-#ifndef CERNLIB_QMOS9
-#define CERNLIB_QMOS9
-#endif
-#if !defined(CERNLIB_QXNO_SC)
-#ifndef CERNLIB_QX_SC
-#define CERNLIB_QX_SC
-#endif
-#endif
-#ifndef CERNLIB_QIEEE
-#define CERNLIB_QIEEE
-#endif
-#ifndef CERNLIB_QORTHOLL
-#define CERNLIB_QORTHOLL
-#endif
-#ifndef CERNLIB_INTDOUBL
-#define CERNLIB_INTDOUBL
-#endif
-#ifndef CERNLIB_QISASTD
-#define CERNLIB_QISASTD
-#endif
-#ifndef CERNLIB_QMILSTD
-#define CERNLIB_QMILSTD
-#endif
-#ifdef CERNLIB_NOGETWD
-#undef CERNLIB_NOGETWD
-#endif
-#ifndef CERNLIB_QS_UNIX
-#define CERNLIB_QS_UNIX
-#endif
-#ifndef CERNLIB_QINTZERO
-#define CERNLIB_QINTZERO
-#endif
diff --git a/src/packlib/kernlib/kerngen/kerngen/ksgi.h b/src/packlib/kernlib/kerngen/kerngen/ksgi.h
deleted file mode 100644
index dda30c0..0000000
--- a/src/packlib/kernlib/kerngen/kerngen/ksgi.h
+++ /dev/null
@@ -1,48 +0,0 @@
-#if 0
-* for Silicon Graphics Iris
-* This pilot patch was created from kernsgi.car patch _ksgi
-* This directory was created from kernsgi.car patch qmsgi
-* This directory was created from kernfor.car patch qmsgi
-* there are still problems with IBITS
-* Normal Unix system machine
-* external names with underscore
-* floating point is IEEE
-* ISA standard routines, ISHFT, IOR, etc
-* MIL standard routines, IBITS, MVBITS, etc
-* Hollerith constants exist
-* EQUIVALENCE Hollerith/Character ok
-* Orthodox Hollerith storage left to right
-* Internal double-precision
-* running Unix
-* Posix call for setjmp/longjmp
-#endif
-#ifdef CERNLIB_QMILSTD
-#undef CERNLIB_QMILSTD
-#endif
-#ifndef CERNLIB_QMSGI
-#define CERNLIB_QMSGI
-#endif
-#ifndef CERNLIB_QX_SC
-#define CERNLIB_QX_SC
-#endif
-#ifndef CERNLIB_QIEEE
-#define CERNLIB_QIEEE
-#endif
-#ifndef CERNLIB_QISASTD
-#define CERNLIB_QISASTD
-#endif
-#ifndef CERNLIB_QORTHOLL
-#define CERNLIB_QORTHOLL
-#endif
-#ifndef CERNLIB_INTDOUBL
-#define CERNLIB_INTDOUBL
-#endif
-#ifndef CERNLIB_QS_UNIX
-#define CERNLIB_QS_UNIX
-#endif
-#ifndef CERNLIB_QSIGJMP
-#define CERNLIB_QSIGJMP
-#endif
-#ifndef CERNLIB_QINTZERO
-#define CERNLIB_QINTZERO
-#endif
diff --git a/src/packlib/kernlib/kerngen/kerngen/ksun.h b/src/packlib/kernlib/kerngen/kerngen/ksun.h
deleted file mode 100644
index 86df104..0000000
--- a/src/packlib/kernlib/kerngen/kerngen/ksun.h
+++ /dev/null
@@ -1,78 +0,0 @@
-#if 0
-* for SUN
-* This pilot patch was created from kernsun.car patch _ksun
-* This directory was created from kernsun.car patch qmsun
-* This directory was created from kernfor.car patch qmsun
-* Normal Unix system machine
-* IEEE floating point
-* external names with underscore
-* Hollerith constants exist
-* EQUIVALENCE Hollerith/Character ok
-* Orthodox Hollerith storage left to right
-* Internal double-precision
-* signal handling with Posix sigaction
-* running Unix
-#endif
-
-#if !defined(CERNLIB_SOLARIS)
-#if 0
-CERNLIB_BUGLRSHFT to get round the lrshft bug in Sun f77 3.0.x
-#endif
-#define CERNLIB_BUGLRSHFT
-#endif
-
-#ifndef CERNLIB_QMSUN
-#define CERNLIB_QMSUN
-#endif
-
-#ifndef CERNLIB_QIEEE
-#define CERNLIB_QIEEE
-#endif
-
-#ifndef CERNLIB_QX_SC
-#define CERNLIB_QX_SC
-#endif
-
-#ifndef CERNLIB_QORTHOLL
-#define CERNLIB_QORTHOLL
-#endif
-
-#ifndef CERNLIB_INTDOUBL
-#define CERNLIB_INTDOUBL
-#endif
-
-#ifndef CERNLIB_QSIGPOSIX
-#define CERNLIB_QSIGPOSIX
-#endif
-
-#if defined(CERNLIB_SOLARIS)
-
-#ifndef CERNLIB_QSIGJMP
-#define CERNLIB_QSIGJMP
-#endif
-
-#ifndef CERNLIB_QGETCWD
-#define CERNLIB_QGETCWD
-#endif
-
-#ifndef CERNLIB_QSIGPOSIX
-#define CERNLIB_QSIGPOSIX
-#endif
-
-#ifdef CERNLIB_QSYSBSD
-#undef CERNLIB_QSYSBSD
-#endif
-
-#ifdef CERNLIB_QENVBSD
-#undef CERNLIB_QENVBSD
-#endif
-
-#endif
-
-#ifndef CERNLIB_QS_UNIX
-#define CERNLIB_QS_UNIX
-#endif
-
-#ifndef CERNLIB_QINTZERO
-#define CERNLIB_QINTZERO
-#endif
diff --git a/src/packlib/kernlib/kerngen/kerngen/kvaos.h b/src/packlib/kernlib/kerngen/kerngen/kvaos.h
deleted file mode 100644
index eaea349..0000000
--- a/src/packlib/kernlib/kerngen/kerngen/kvaos.h
+++ /dev/null
@@ -1,58 +0,0 @@
-#if 0
-* for Vax Alpha OSF, 32-bit mode
-* This pilot patch was created from kernvmi.car patch _kvaos
-* This directory was created from kernvmi.car patch qmvaos
-* This directory was created from kernfor.car patch qmvaos
-* Normal Unix system machine
-* external names with underscores
-* IEEE floating point
-* ISA standard functions available
-* MIL standard routines, IBITS, MVBITS, etc
-* Hollerith storage not orthodox
-* Hollerith constants exist
-* EQUIVALENCE Hollerith/Character ok
-* running Unix
-* running Unix system BSD
-* use sigaction
-* BSD version for SETENVF
-* Posix call for setjmp/longjmp
-#endif
-#ifndef CERNLIB_QMVAO
-#define CERNLIB_QMVAO
-#endif
-#ifndef CERNLIB_QMVAOS
-#define CERNLIB_QMVAOS
-#endif
-#ifndef CERNLIB_QX_SC
-#define CERNLIB_QX_SC
-#endif
-#ifndef CERNLIB_QIEEE
-#define CERNLIB_QIEEE
-#endif
-#ifndef CERNLIB_QISASTD
-#define CERNLIB_QISASTD
-#endif
-#ifndef CERNLIB_QMILSTD
-#define CERNLIB_QMILSTD
-#endif
-#ifdef CERNLIB_QORTHOLL
-#undef CERNLIB_QORTHOLL
-#endif
-#ifndef CERNLIB_QS_UNIX
-#define CERNLIB_QS_UNIX
-#endif
-#ifndef CERNLIB_QSYSBSD
-#define CERNLIB_QSYSBSD
-#endif
-#ifndef CERNLIB_QSIGPOSIX
-#define CERNLIB_QSIGPOSIX
-#endif
-#ifndef CERNLIB_QENVBSD
-#define CERNLIB_QENVBSD
-#endif
-#ifndef CERNLIB_QSIGJMP
-#define CERNLIB_QSIGJMP
-#endif
-#ifndef CERNLIB_QINTZERO
-#define CERNLIB_QINTZERO
-#endif
diff --git a/src/packlib/kernlib/kerngen/kerngen/kvax.h b/src/packlib/kernlib/kerngen/kerngen/kvax.h
deleted file mode 100644
index b384a93..0000000
--- a/src/packlib/kernlib/kerngen/kerngen/kvax.h
+++ /dev/null
@@ -1,35 +0,0 @@
-#if 0
-* for VAX
-* This pilot patch was created from kernvax.car patch _kvax
-* This directory was created from kernvax.car patch vaxalpha
-* This directory was created from kernvax.car patch qmvax
-* This directory was created from kernfor.car patch qmvax
-* CC assumed available
-* external names without underscores
-* ISA standard routines, ISHFT, IOR, etc
-* MIL standard routines, IBITS, MVBITS, ISHFTC
-* Hollerith constants exist
-* EQUIVALENCE Hollerith/Character ok
-* Hollerith storage not orthodox
-#endif
-#ifndef CERNLIB_QMVAXCC
-#define CERNLIB_QMVAXCC
-#endif
-#ifndef CERNLIB_QMVAX
-#define CERNLIB_QMVAX
-#endif
-#ifndef CERNLIB_QXNO_SC
-#define CERNLIB_QXNO_SC
-#endif
-#ifndef CERNLIB_QISASTD
-#define CERNLIB_QISASTD
-#endif
-#ifndef CERNLIB_QMILSTD
-#define CERNLIB_QMILSTD
-#endif
-#ifdef CERNLIB_QORTHOLL
-#undef CERNLIB_QORTHOLL
-#endif
-#ifndef CERNLIB_QINTZERO
-#define CERNLIB_QINTZERO
-#endif
diff --git a/src/packlib/kernlib/kerngen/kerngen/kvmi.h b/src/packlib/kernlib/kerngen/kerngen/kvmi.h
deleted file mode 100644
index e8a5e7e..0000000
--- a/src/packlib/kernlib/kerngen/kerngen/kvmi.h
+++ /dev/null
@@ -1,51 +0,0 @@
-#if 0
-* for Vax / Mips
-* This pilot patch was created from kernvmi.car patch _kvmi
-* This directory was created from kernvmi.car patch qmvmi
-* This directory was created from kernfor.car patch qmvmi
-* Normal Unix system machine
-* external names with underscores
-* IEEE floating point
-* ISA standard functions available
-* Hollerith storage not orthodox
-* Hollerith constants exist
-* EQUIVALENCE Hollerith/Character ok
-* running Unix
-* running Unix system BSD
-* signal handling with BSD sigvec
-* BSD version for SETENVF
-* Posix call for setjmp/longjmp
-#endif
-#ifndef CERNLIB_QMVMI
-#define CERNLIB_QMVMI
-#endif
-#ifndef CERNLIB_QX_SC
-#define CERNLIB_QX_SC
-#endif
-#ifndef CERNLIB_QIEEE
-#define CERNLIB_QIEEE
-#endif
-#ifndef CERNLIB_QISASTD
-#define CERNLIB_QISASTD
-#endif
-#ifdef CERNLIB_QORTHOLL
-#undef CERNLIB_QORTHOLL
-#endif
-#ifndef CERNLIB_QS_UNIX
-#define CERNLIB_QS_UNIX
-#endif
-#ifndef CERNLIB_QSYSBSD
-#define CERNLIB_QSYSBSD
-#endif
-#ifndef CERNLIB_QSIGBSD
-#define CERNLIB_QSIGBSD
-#endif
-#ifndef CERNLIB_QENVBSD
-#define CERNLIB_QENVBSD
-#endif
-#ifndef CERNLIB_QSIGJMP
-#define CERNLIB_QSIGJMP
-#endif
-#ifndef CERNLIB_QINTZERO
-#define CERNLIB_QINTZERO
-#endif
diff --git a/src/packlib/kernlib/kerngen/kerngen/kwnt.h b/src/packlib/kernlib/kerngen/kerngen/kwnt.h
deleted file mode 100644
index eae9cd4..0000000
--- a/src/packlib/kernlib/kerngen/kerngen/kwnt.h
+++ /dev/null
@@ -1,55 +0,0 @@
-#if 0
-* This pilot for Windows NT for Microsoft Powersation Fortran v.4.0
-#endif
-
-#ifdef CERNLIB_WINNT
-#ifndef CERNLIB_QS_WNT
-#define CERNLIB_QS_WNT
-#endif
-#endif
-
-#ifndef CERNLIB_QS_DOS
-#define CERNLIB_QS_DOS
-#endif
-
-#ifndef CERNLIB_QMDOS
-#define CERNLIB_QMDOS
-#endif
-
-#ifndef CERNLIB_QIEEE
-#define CERNLIB_QIEEE
-#endif
-
-#ifndef CERNLIB_QISASTD
-#define CERNLIB_QISASTD
-#endif
-
-#ifndef CERNLIB_QMILSTD
-#define CERNLIB_QMILSTD
-#endif
-
-#ifdef CERNLIB_QORTHOLL
-#undef CERNLIB_QORTHOLL
-#endif
-
-#ifndef CERNLIB_F77TRARG
-#define CERNLIB_F77TRARG
-#endif
-
-#ifndef CERNLIB_QCFIO
-#define CERNLIB_QCFIO
-#endif
-
-#ifndef CERNLIB_QGETCWD
-#define CERNLIB_QGETCWD
-#endif
-
-#ifndef CERNLIB_QINTCOPY
-#define CERNLIB_QINTCOPY
-#endif
-
-#ifndef CERNLIB_QINTZERO
-#define CERNLIB_QINTZERO
-#endif
-
-#include "fortranc.h"
diff --git a/src/packlib/kernlib/kerngen/kerngen/pilot.h b/src/packlib/kernlib/kerngen/kerngen/pilot.h
deleted file mode 100644
index 3bf3adf..0000000
--- a/src/packlib/kernlib/kerngen/kerngen/pilot.h
+++ /dev/null
@@ -1,98 +0,0 @@
-#if 0
-* This pilot patch was created from kerngen.car patch _kerngen
-* This directory was created from kernfor.car patch qdefault
-* Character set is ASCII
-* Internal double-precision
-* copy vectors as floating normally
-#endif
-#if defined(CERNLIB_MSDOS)
-#include "kdos.h"
-#endif
-#if defined(CERNLIB_WINNT)
-#include "kwnt.h"
-#endif
-#if (defined(CERNLIB_DECS))&&(!defined(CERNLIB_QMVAOS))
-#include "kvmi.h"
-#endif
-#if (defined(CERNLIB_DECS))&&(defined(CERNLIB_QMVAOS))
-#include "kvaos.h"
-#endif
-#if defined(CERNLIB_HPUX)
-#include "khpx.h"
-#endif
-#if defined(CERNLIB_IBMRT)
-#include "kirt.h"
-#endif
-#if defined(CERNLIB_LINUX)
-#include "klnx.h"
-#endif
-#if defined(CERNLIB_MACMPW)
-#include "kmpw.h"
-#endif
-#if defined(CERNLIB_OS9)
-#if 0
-* Added at release 94B
-#endif
-#include "kos9.h"
-#endif
-#if defined(CERNLIB_SGI)
-#include "kerngen/ksgi.h"
-#endif
-#if defined(CERNLIB_SUN)
-#include "ksun.h"
-#endif
-#if (defined(CERNLIB_VAXVMS))&&(!defined(CERNLIB_QMALPH))
-#include "kvax.h"
-#endif
-#if (defined(CERNLIB_VAXVMS))&&(defined(CERNLIB_QMALPH))
-#include "kalph.h"
-#endif
-#ifndef CERNLIB_A4
-#define CERNLIB_A4
-#endif
-#ifndef CERNLIB_B32
-#define CERNLIB_B32
-#endif
-#ifndef CERNLIB_HEX
-#define CERNLIB_HEX
-#endif
-#if !defined(CERNLIB_QEBCDIC)
-#ifndef CERNLIB_QASCII
-#define CERNLIB_QASCII
-#endif
-#endif
-#if defined(CERNLIB_B32)||defined(CERNLIB_B36)
-#ifndef CERNLIB_INTDOUBL
-#define CERNLIB_INTDOUBL
-#endif
-#endif
-#if defined(CERNLIB_QX_SC)
-#ifdef CERNLIB_QXNO_SC
-#undef CERNLIB_QXNO_SC
-#endif
-#endif
-#if defined(CERNLIB_QXNO_SC)
-#ifdef CERNLIB_QX_SC
-#undef CERNLIB_QX_SC
-#endif
-#endif
-#if defined(CERNLIB_QXNO_SC)||defined(CERNLIB_QX_SC)
-#ifdef CERNLIB_QXCAPT
-#undef CERNLIB_QXCAPT
-#endif
-#endif
-#if (!defined(CERNLIB_QXNO_SC))&&(!defined(CERNLIB_QXCAPT))
-#ifndef CERNLIB_QX_SC
-#define CERNLIB_QX_SC
-#endif
-#endif
-#if defined(CERNLIB_SHIFT)
-#ifndef CERNLIB_PROJSHIFT
-#define CERNLIB_PROJSHIFT
-#endif
-#endif
-
-#ifndef type_of_call
-#define type_of_call
-#endif
-
diff --git a/src/packlib/kernlib/kerngen/kerngen/q_andor.inc b/src/packlib/kernlib/kerngen/kerngen/q_andor.inc
deleted file mode 100644
index 46d05a8..0000000
--- a/src/packlib/kernlib/kerngen/kerngen/q_andor.inc
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: q_andor.inc,v 1.2 1997/02/04 17:35:38 mclareni Exp $
-*
-* $Log: q_andor.inc,v $
-* Revision 1.2 1997/02/04 17:35:38 mclareni
-* Merge Winnt and 97a versions
-*
-* Revision 1.1.1.1.2.1 1997/01/21 11:30:28 mclareni
-* All mods for Winnt 96a on winnt branch
-*
-* Revision 1.1.1.1 1996/02/15 17:49:19 mclareni
-* Kernlib
-*
-*
-* IAND / IOR / IEOR / NOT standard?
-*
-* q_andor.inc
-*
-#if defined(CERNLIB_QMSUN)||defined(CERNLIB_QMLNX)
- IAND (IZV,IZW) = AND (IZV, IZW)
- IOR (IZV,IZW) = OR (IZV, IZW)
- IEOR (IZV,IZW) = XOR (IZV, IZW)
-#elif defined(CERNLIB_QMDOS)&&defined(CERNLIB_QF2C)
- IAND(IZV,IZW) = AND(IZV,IZW)
- IOR(IZV,IZW) = OR(IZV,IZW)
- IEOR(IZV,IZW) = XOR(IZV,IZW)
-#else
-#endif
diff --git a/src/packlib/kernlib/kerngen/kerngen/q_cbyt.inc b/src/packlib/kernlib/kerngen/kerngen/q_cbyt.inc
deleted file mode 100644
index 819672c..0000000
--- a/src/packlib/kernlib/kerngen/kerngen/q_cbyt.inc
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: q_cbyt.inc,v 1.2 2006/09/15 09:35:16 mclareni Exp $
-*
-* $Log: q_cbyt.inc,v $
-* Revision 1.2 2006/09/15 09:35:16 mclareni
-* Submitted mods for gcc4/gfortran and MacOSX, corrected to work also on slc4 with gcc3.4 and 4.1
-*
-* Revision 1.1.1.1 1996/02/15 17:49:19 mclareni
-* Kernlib
-*
-*
-*
-* q_cbyt.inc
-*
-#if defined(CERNLIB_QMLNX) && !defined(CERNLIB_GFORTRAN)
- MCBYT (MZ,IZQ,IZW,IZP,NZB) = OR (
- + AND (IZW, NOT(LSHIFT (ISHFTR(NOT(0),32-NZB),IZP-1)))
- + ,ISHFTR (LSHIFT(LSHIFT(MZ,IZQ-1),32-NZB), 33-IZP-NZB))
-#elif defined(CERNLIB_QMDOS)&&defined(CERNLIB_QF_F2C)
-C MCBYT (MZ,IZQ,IZW,IZP,NZB) = OR (
-C + AND (IZW, NOT(LSHIFT (ishftr(NOT(0),32-NZB), IZP-1)))
-C + , ishftr (LSHIFT(LSHIFT(MZ,-IZQ+1),32-NZB), 33-IZP-NZB) )
-#elif defined(CERNLIB_QMOS9)||defined(CERNLIB_QMHPX)||(defined(CERNLIB_QMDOS)&&(!defined(CERNLIB_QF_F2C)))
- MCBYT (MZ,IZQ,IZW,IZP,NZB) = IOR (
- + IAND (IZW, NOT(ISHFT (ISHFT(NOT(0),-32+NZB), IZP-1)))
- + , ISHFT (ISHFT(ISHFT(MZ,-IZQ+1),32-NZB), -33+IZP+NZB) )
-#elif defined(CERNLIB_GFORTRAN)
- MCBYT (MZ,IZQ,IZW,IZP,NZB) = IOR (
- + IAND (IZW, NOT(ISHFT (ISHFT(NOT(0),-32+NZB), IZP-1)))
- + , ISHFT (ISHFT(ISHFT(MZ,IZQ-1),32-NZB), -33+IZP+NZB) )
-#endif
diff --git a/src/packlib/kernlib/kerngen/kerngen/q_isabit.inc b/src/packlib/kernlib/kerngen/kerngen/q_isabit.inc
deleted file mode 100644
index 2d9b2d3..0000000
--- a/src/packlib/kernlib/kerngen/kerngen/q_isabit.inc
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: q_isabit.inc,v 1.2 2006/09/15 09:35:16 mclareni Exp $
-*
-* $Log: q_isabit.inc,v $
-* Revision 1.2 2006/09/15 09:35:16 mclareni
-* Submitted mods for gcc4/gfortran and MacOSX, corrected to work also on slc4 with gcc3.4 and 4.1
-*
-* Revision 1.1.1.1 1996/02/15 17:49:20 mclareni
-* Kernlib
-*
-*
-*
-* q_isabit.inc
-*
-#if (defined(CERNLIB_QMLNX)&&!defined(CERNLIB_GFORTRAN))||(defined(CERNLIB_QMDOS)&&defined(CERNLIB_QF_F2C))
- BTEST(IZW,IZP) = AND (IZW,LSHIFT(1,IZP)) .NE. 0
- IBSET(IZW,IZP) = OR (IZW,LSHIFT(1,IZP))
- IBCLR(IZW,IZP) = AND (IZW,NOT(LSHIFT(1,IZP)))
- IBITS (IZW,IZP,NZB) = ISHFTR (LSHIFT(IZW,32-IZP-NZB), 32-NZB)
-#elsif defined(CERNLIB_GFORTRAN)
- BTEST(IZW,IZP) = IAND (IZW,ISHFT(1,IZP)) .NE. 0
- IBSET(IZW,IZP) = IOR (IZW,ISHFT(1,IZP))
- IBCLR(IZW,IZP) = IAND (IZW,NOT(ISHFT(1,IZP)))
- IBITS (IZW,IZP,NZB) = ISHFT(ISHFT(IZW,32-NZB-IZP),NZB-32)
-#endif
diff --git a/src/packlib/kernlib/kerngen/kerngen/q_jbit.inc b/src/packlib/kernlib/kerngen/kerngen/q_jbit.inc
deleted file mode 100644
index 61ade65..0000000
--- a/src/packlib/kernlib/kerngen/kerngen/q_jbit.inc
+++ /dev/null
@@ -1,38 +0,0 @@
-*
-* $Id: q_jbit.inc,v 1.3 2006/09/15 09:35:16 mclareni Exp $
-*
-* $Log: q_jbit.inc,v $
-* Revision 1.3 2006/09/15 09:35:16 mclareni
-* Submitted mods for gcc4/gfortran and MacOSX, corrected to work also on slc4 with gcc3.4 and 4.1
-*
-* Revision 1.2 1997/02/04 17:35:39 mclareni
-* Merge Winnt and 97a versions
-*
-* Revision 1.1.1.1.2.1 1997/01/21 11:30:29 mclareni
-* All mods for Winnt 96a on winnt branch
-*
-* Revision 1.1.1.1 1996/02/15 17:49:19 mclareni
-* Kernlib
-*
-*
-*
-* q_jbit.inc
-*
-#if defined(CERNLIB_QMLNX) && !defined(CERNLIB_GFORTRAN)
- JBIT(IZW,IZP) = AND(ISHFTR(IZW,IZP-1),1)
- JBYT(IZW,IZP,NZB) = ISHFTR(LSHIFT(IZW,33-IZP-NZB),32-NZB)
-#elif defined(CERNLIB_QMDOS)&&defined(CERNLIB_QF_F2C)
- JBIT (IZW,IZP) = AND(RSHIFT(IZW,IZP-1),1)
- JBYT (IZW,IZP,NZB) = ISHFTR(LSHIFT(IZW,33-IZP-NZB),32-NZB)
-#elif defined(CERNLIB_QMSUN)&&defined(CERNLIB_BUGLRSHFT)
-#elif defined(CERNLIB_QMSUN)&&(!defined(CERNLIB_BUGLRSHFT))
- JBIT (IZW,IZP) = AND (lrshft(IZW,IZP-1), 1)
- JBYT (IZW,IZP,NZB)= lrshft (LSHIFT(IZW,33-IZP-NZB),32-NZB)
-#elif defined(CERNLIB_QMOS9)||defined(CERNLIB_QMHPX)
- JBIT (IZW,IZP) = IBITS (IZW,IZP-1,1)
- JBYT (IZW,IZP,NZB) = IBITS (IZW,IZP-1,NZB)
-#elif (defined(CERNLIB_QMDOS)&&(!defined(CERNLIB_QF_F2C))) || defined(CERNLIB_QFMSOFT)\
- || defined(CERNLIB_GFORTRAN)
- JBIT (IZW,IZP) = IAND (ISHFT(IZW,1-IZP), 1)
- JBYT (IZW,IZP,NZB) = ISHFT (ISHFT(IZW,33-IZP-NZB), -32+NZB)
-#endif
diff --git a/src/packlib/kernlib/kerngen/kerngen/q_jbytet.inc b/src/packlib/kernlib/kerngen/kerngen/q_jbytet.inc
deleted file mode 100644
index e30e4ee..0000000
--- a/src/packlib/kernlib/kerngen/kerngen/q_jbytet.inc
+++ /dev/null
@@ -1,66 +0,0 @@
-*
-* $Id: q_jbytet.inc,v 1.3 2006/09/15 09:35:16 mclareni Exp $
-*
-* $Log: q_jbytet.inc,v $
-* Revision 1.3 2006/09/15 09:35:16 mclareni
-* Submitted mods for gcc4/gfortran and MacOSX, corrected to work also on slc4 with gcc3.4 and 4.1
-*
-* Revision 1.2 1997/02/04 17:35:40 mclareni
-* Merge Winnt and 97a versions
-*
-* Revision 1.1.1.1.2.1 1997/01/21 11:30:29 mclareni
-* All mods for Winnt 96a on winnt branch
-*
-* Revision 1.1.1.1 1996/02/15 17:49:20 mclareni
-* Kernlib
-*
-*
-*
-* q_jbytet.inc
-*
-#if defined(CERNLIB_QMSUN)&&defined(CERNLIB_BUGLRSHFT)
-#elif defined(CERNLIB_QMSUN)&&(!defined(CERNLIB_BUGLRSHFT))
- JBYTET (MZ,IZW,IZP,NZB) = AND (MZ,
- + lrshft (LSHIFT(IZW,33-IZP-NZB), 32-NZB))
- JBYTOR (MZ,IZW,IZP,NZB) = OR (MZ,
- + lrshft (LSHIFT(IZW,33-IZP-NZB), 32-NZB))
- MBYTET (MZ,IZW,IZP,NZB) = AND (IZW, NOT(lrshft (
- + LSHIFT(NOT(MZ),32-NZB), 33-IZP-NZB)))
- MBYTOR (MZ,IZW,IZP,NZB) = OR (IZW, lrshft (
- + LSHIFT(MZ,32-NZB), 33-IZP-NZB))
-#if defined(CERNLIB_QMLNX) && !defined(CERNLIB_GFORTRAN)
- JBYTET (MZ,IZW,IZP,NZB) = AND (MZ,
- + ISHFTR (LSHIFT(IZW,33-IZP-NZB),32-NZB) )
- JBYTOR (MZ,IZW,IZP,NZB) = OR (MZ,
- + ISHFTR (LSHIFT(IZW,33-IZP-NZB),32-NZB) )
- MBYTET (MZ,IZW,IZP,NZB) = AND (IZW,
- + NOT(ISHFTR (LSHIFT(NOT(MZ),32-NZB),33-IZP-NZB)) )
- MBYTOR (MZ,IZW,IZP,NZB) = OR (IZW,
- + ISHFTR (LSHIFT(MZ,32-NZB),33-IZP-NZB))
-#if defined(CERNLIB_QMDOS)&&defined(CERNLIB_QF_F2C)
- JBYTET (MZ,IZW,IZP,NZB) = AND (MZ,
- + ishftr (LSHIFT(IZW,33-IZP-NZB),32-NZB) )
- JBYTOR (MZ,IZW,IZP,NZB) = OR (MZ,
- + ishftr (LSHIFT(IZW,33-IZP-NZB),32-NZB) )
- MBYTET (MZ,IZW,IZP,NZB) = AND (IZW,
- + NOT(ishftr (LSHIFT(NOT(MZ),32-NZB),33-IZP-NZB)) )
- MBYTOR (MZ,IZW,IZP,NZB) = OR (IZW,
- + ishftr (LSHIFT(MZ,32-NZB),33-IZP-NZB) )
-#elif defined(CERNLIB_QMOS9)||defined(CERNLIB_QMHPX)
- JBYTET (MZ,IZW,IZP,NZB) = IAND (MZ, IBITS(IZW,IZP-1,NZB))
- JBYTOR (MZ,IZW,IZP,NZB) = IOR (MZ, IBITS(IZW,IZP-1,NZB))
- MBYTET (MZ,IZW,IZP,NZB) = IAND (IZW, NOT(ishft (
- + ISHFT(NOT(MZ),32-NZB),-33+IZP+NZB)) )
- MBYTOR (MZ,IZW,IZP,NZB) = IOR (IZW, ishft (
- + ISHFT(MZ,32-NZB),-33+IZP+NZB) )
-#elif (defined(CERNLIB_QMDOS)&&(!defined(CERNLIB_QF_F2C))) || defined(CERNLIB_QFMSOFT)\
- || defined(CERNLIB_GFORTRAN)
- JBYTET (MZ,IZW,IZP,NZB) = IAND (MZ,
- + ISHFT (ISHFT(IZW,33-IZP-NZB),-32+NZB) )
- JBYTOR (MZ,IZW,IZP,NZB) = IOR (MZ,
- + ISHFT (ISHFT(IZW,33-IZP-NZB),-32+NZB) )
- MBYTET (MZ,IZW,IZP,NZB) = IAND (IZW,
- + NOT(ISHFT (ISHFT(NOT(MZ),32-NZB),-33+IZP+NZB)) )
- MBYTOR (MZ,IZW,IZP,NZB) = IOR (IZW,
- + ISHFT (ISHFT(MZ,32-NZB),-33+IZP+NZB) )
-#endif
diff --git a/src/packlib/kernlib/kerngen/kerngen/q_sbit.inc b/src/packlib/kernlib/kerngen/kerngen/q_sbit.inc
deleted file mode 100644
index e7bbc95..0000000
--- a/src/packlib/kernlib/kerngen/kerngen/q_sbit.inc
+++ /dev/null
@@ -1,36 +0,0 @@
-*
-* $Id: q_sbit.inc,v 1.3 2006/09/15 09:35:16 mclareni Exp $
-*
-* $Log: q_sbit.inc,v $
-* Revision 1.3 2006/09/15 09:35:16 mclareni
-* Submitted mods for gcc4/gfortran and MacOSX, corrected to work also on slc4 with gcc3.4 and 4.1
-*
-* Revision 1.2 1997/02/04 17:35:40 mclareni
-* Merge Winnt and 97a versions
-*
-* Revision 1.1.1.1.2.1 1997/01/21 11:30:30 mclareni
-* All mods for Winnt 96a on winnt branch
-*
-* Revision 1.1.1.1 1996/02/15 17:49:20 mclareni
-* Kernlib
-*
-*
-*
-* q_sbit.inc
-*
-#if defined(CERNLIB_QMSUN)||(defined(CERNLIB_QMLNX) && !defined(CERNLIB_GFORTRAN)
- MSBIT0 (IZW,IZP) = AND (IZW, NOT(LSHIFT(1,IZP-1)) )
- MSBIT1 (IZW,IZP) = OR (IZW, LSHIFT(1,IZP-1) )
- MSBIT (MZ,IZW,IZP) = OR (AND (IZW, NOT(LSHIFT(1,IZP-1)) )
- + , LSHIFT(AND(MZ,1),IZP-1) )
-#elif defined(CERNLIB_QMDOS)&&defined(CERNLIB_QF_F2C)
- MSBIT0 (IZW,IZP) = AND (IZW, NOT(LSHIFT(1,IZP-1)) )
- MSBIT1 (IZW,IZP) = OR (IZW, LSHIFT(1,IZP-1) )
- MSBIT (MZ,IZW,IZP) = OR (AND (IZW, NOT(LSHIFT(1,IZP-1)) )
- + , LSHIFT(AND(MZ,1),IZP-1))
-#elif defined(CERNLIB_QMOS9)||defined(CERNLIB_QMHPX)||(defined(CERNLIB_QMDOS)&&(!defined(CERNLIB_QF_F2C))) || defined(CERNLIB_QFMSOFT) || defined(CERNLIB_GFORTRAN)
- MSBIT0 (IZW,IZP) = IAND (IZW, NOT(ISHFT(1,IZP-1)) )
- MSBIT1 (IZW,IZP) = IOR (IZW, ISHFT(1,IZP-1) )
- MSBIT (MZ,IZW,IZP) = IOR (IAND (IZW, NOT(ISHFT(1,IZP-1)) )
- + , ISHFT(IAND(MZ,1),IZP-1))
-#endif
diff --git a/src/packlib/kernlib/kerngen/kerngen/q_sbyt.inc b/src/packlib/kernlib/kerngen/kerngen/q_sbyt.inc
deleted file mode 100644
index 7de8c20..0000000
--- a/src/packlib/kernlib/kerngen/kerngen/q_sbyt.inc
+++ /dev/null
@@ -1,36 +0,0 @@
-*
-* $Id: q_sbyt.inc,v 1.4 2006/09/15 09:35:16 mclareni Exp $
-*
-* $Log: q_sbyt.inc,v $
-* Revision 1.4 2006/09/15 09:35:16 mclareni
-* Submitted mods for gcc4/gfortran and MacOSX, corrected to work also on slc4 with gcc3.4 and 4.1
-*
-* Revision 1.3 1997/09/02 14:26:58 mclareni
-* WINNT correction
-*
-* Revision 1.2 1997/02/04 17:35:40 mclareni
-* Merge Winnt and 97a versions
-*
-* Revision 1.1.1.1.2.1 1997/01/21 11:30:31 mclareni
-* All mods for Winnt 96a on winnt branch
-*
-* Revision 1.1.1.1 1996/02/15 17:49:20 mclareni
-* Kernlib
-*
-*
-*
-* q_sbyt.inc
-*
-#if defined(CERNLIB_QMLNX) && !defined(CERNLIB_GFORTRAN)
- MSBYT (MZ,IZW,IZP,NZB) = OR (
- + AND (IZW, NOT(LSHIFT (ISHFTR(NOT(0),32-NZB),IZP-1)))
- + ,ISHFTR (LSHIFT(MZ,32-NZB), 33-IZP-NZB) )
-#elif defined(CERNLIB_QMDOS)&&defined(CERNLIB_QF_F2C)
-C MSBYT (MZ,IZW,IZP,NZB) = OR (
-C + AND (IZW, NOT(LSHIFT (ISHFTR(NOT(0),32-NZB), IZP-1)))
-C + , ISHFTR (LSHIFT(MZ,32-NZB), 33-IZP-NZB) )
-#elif defined(CERNLIB_QMOS9)||defined(CERNLIB_QMHPX)||(defined(CERNLIB_QMDOS)&&(!defined(CERNLIB_QF_F2C))) || defined(CERNLIB_QFMSOFT) || defined(CERNLIB_QFDEC) || defined(CERNLIB_GFORTRAN)
- MSBYT (MZ,IZW,IZP,NZB) = IOR (
- + IAND (IZW, NOT(ISHFT (ISHFT(NOT(0),-32+NZB), IZP-1)))
- + , ISHFT (ISHFT(MZ,32-NZB), -33+IZP+NZB) )
-#endif
diff --git a/src/packlib/kernlib/kerngen/kerngen/q_shift.inc b/src/packlib/kernlib/kerngen/kerngen/q_shift.inc
deleted file mode 100644
index 77e6052..0000000
--- a/src/packlib/kernlib/kerngen/kerngen/q_shift.inc
+++ /dev/null
@@ -1,37 +0,0 @@
-*
-* $Id: q_shift.inc,v 1.3 2006/09/15 09:35:16 mclareni Exp $
-*
-* $Log: q_shift.inc,v $
-* Revision 1.3 2006/09/15 09:35:16 mclareni
-* Submitted mods for gcc4/gfortran and MacOSX, corrected to work also on slc4 with gcc3.4 and 4.1
-*
-* Revision 1.2 1996/03/05 17:04:19 cernlib
-* Replace #else by elif 1 ( for SGI cpp )
-*
-* Revision 1.1.1.1 1996/02/15 17:49:19 mclareni
-* Kernlib
-*
-*
-*
-* q_shift.inc
-*
-#if defined(CERNLIB_QMSUN)&&defined(CERNLIB_BUGLRSHFT)
- ISHFTL (IZW,NZB) = LSHIFT (IZW, NZB)
- ISHFTR (IZW,NZB) = ishft (IZW, -NZB)
-#elif defined(CERNLIB_QMSUN)&&(!defined(CERNLIB_BUGLRSHFT))
- ISHFTL (IZW,NZB) = LSHIFT (IZW, NZB)
- ISHFTR (IZW,NZB) = lrshft (IZW, NZB)
-#elif defined(CERNLIB_QMDOS)&&defined(CERNLIB_QF_F2C)
-C--
-C-- Note: F2C-ish RSHIFT is arithmetic right shift.
-C-- This means sign bits are shifted in at the high end
-C
- ISHFTL(IZW,NZB) = LSHIFT(IZW,NZB)
-C ISHFTR(IZW,NZB) = RSHIFT(IZW,NZB)
-C ISHFT(IZW,NZB) = LSHIFT(IZW,NZB)
-#elif defined(CERNLIB_QMLNX) && !defined(CERNLIB_GFORTRAN)
- ISHFTL (IZW,NZB) = LSHIFT (IZW,NZB)
-#elif 1
- ISHFTL (IZW,NZB) = ISHFT (IZW, NZB)
- ISHFTR (IZW,NZB) = ISHFT (IZW, -NZB)
-#endif
diff --git a/src/packlib/kernlib/kerngen/kerngen/qf_f2c.h b/src/packlib/kernlib/kerngen/kerngen/qf_f2c.h
deleted file mode 100644
index fa22480..0000000
--- a/src/packlib/kernlib/kerngen/kerngen/qf_f2c.h
+++ /dev/null
@@ -1,35 +0,0 @@
-/*
-* $Id: qf_f2c.h,v 1.1.1.1 1996/02/15 17:49:20 mclareni Exp $
-*
-* $Log: qf_f2c.h,v $
-* Revision 1.1.1.1 1996/02/15 17:49:20 mclareni
-* Kernlib
-*
-*
-* This is a piece of f2c.h file by AT&T
-*
-* qf_f2c.h
-*/
-typedef long ftnlen;
-typedef long int integer;
-typedef char *address;
-typedef short int shortint;
-typedef float real;
-typedef double doublereal;
-
-typedef struct { real r, i; } complex;
-#ifdef WIN32 /* V.E.Fine 03.07.93 */
-#define _COMPLEX_DEFINED
-#endif
-
-typedef struct { doublereal r, i; } doublecomplex;
-typedef long int logical;
-typedef short int shortlogical;
-typedef char logical1;
-typedef char integer1;
-/* typedef long long longint; */ /* system-dependent */
-
-#define TRUE_ (1)
-#define FALSE_ (0)
-#define min(a,b) ((a) <= (b) ? (a) : (b))
-#define max(a,b) ((a) >= (b) ? (a) : (b))
diff --git a/src/packlib/kernlib/kerngen/kerngen/qnatch.inc b/src/packlib/kernlib/kerngen/kerngen/qnatch.inc
deleted file mode 100644
index 6146494..0000000
--- a/src/packlib/kernlib/kerngen/kerngen/qnatch.inc
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: qnatch.inc,v 1.1.1.1 1996/02/15 17:49:14 mclareni Exp $
-*
-* $Log: qnatch.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:49:14 mclareni
-* Kernlib
-*
-*
-* Siemens compiler
-*
-* qnatch.inc
-*
-#if defined(CERNLIB_QMIBM)
-#if defined(CERNLIB_QF_SIEM)
- COMMON /QNATCH/ NATCH(256)
- INTEGER*2 NATCH
-#else
- INTEGER*2 NATCH(256)
-#endif
-#include "qnatchdata.inc"
-#endif
diff --git a/src/packlib/kernlib/kerngen/kerngen/qnatchdata.inc b/src/packlib/kernlib/kerngen/kerngen/qnatchdata.inc
deleted file mode 100644
index 8bb4dc5..0000000
--- a/src/packlib/kernlib/kerngen/kerngen/qnatchdata.inc
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: qnatchdata.inc,v 1.1.1.1 1996/02/15 17:49:17 mclareni Exp $
-*
-* $Log: qnatchdata.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:49:17 mclareni
-* Kernlib
-*
-*
-*
-* qnatchdata.inc
-*
-#if defined(CERNLIB_QMIBM)
- DATA NATCH / 64*0, 1, 9*0, 0, 6*1, 9*0, 8*1, 8*0, 6*1, 9*0
- +, 7*1, 0, 9*3, 0, 1, 5*0, 9*3, 0, 1, 5*0
- +, 0, 8*3, 3*0, 1, 15*0, 1, 2*0, 0, 9*4, 6*0
- +, 0, 9*4, 6*0, 1, 0, 8*4, 6*0, 10*2, 6*0 /
-C- Nature : 0 unseen, 1 others, 2 numeric, 3 lower, 4 upper case
-#endif
diff --git a/src/packlib/kernlib/kerngen/kerngen/ublowx1.inc b/src/packlib/kernlib/kerngen/kerngen/ublowx1.inc
deleted file mode 100644
index 13a5cd3..0000000
--- a/src/packlib/kernlib/kerngen/kerngen/ublowx1.inc
+++ /dev/null
@@ -1,11 +0,0 @@
-#if defined(CERNLIB_B64)
-C- -PARAMETER (IBLAN1 = X'0020202020202020')
-C- - PARAMETER (MASK1 = X'FF00000000000000')
- PARAMETER (IBLAN1 = 9042521604759584 )
- PARAMETER (MASK1 = -72057594037927936 )
-#elif defined(CERNLIB_B32)
-C- -PARAMETER (IBLAN1 = X'00202020')
-C- - PARAMETER (MASK1 = X'FF000000')
- PARAMETER (IBLAN1 = 2105376 )
- PARAMETER (MASK1 = -16777216 )
-#endif
diff --git a/src/packlib/kernlib/kerngen/kerngen/ubnchx1.inc b/src/packlib/kernlib/kerngen/kerngen/ubnchx1.inc
deleted file mode 100644
index a1db4f9..0000000
--- a/src/packlib/kernlib/kerngen/kerngen/ubnchx1.inc
+++ /dev/null
@@ -1,7 +0,0 @@
-#if defined(CERNLIB_B64)
-C- - PARAMETER (MASK1 = X'FF00000000000000')
- PARAMETER (MASK1 = -72057594037927936 )
-#elif defined(CERNLIB_B32)
-C- - PARAMETER (MASK1 = X'FF000000')
- PARAMETER (MASK1 = -16777216 )
-#endif
diff --git a/src/packlib/kernlib/kerngen/kerngen/wordsizc.h b/src/packlib/kernlib/kerngen/kerngen/wordsizc.h
deleted file mode 100644
index 340a9de..0000000
--- a/src/packlib/kernlib/kerngen/kerngen/wordsizc.h
+++ /dev/null
@@ -1,17 +0,0 @@
-/*
-* $Id: wordsizc.h,v 1.1.1.1 1996/02/15 17:49:19 mclareni Exp $
-*
-* $Log: wordsizc.h,v $
-* Revision 1.1.1.1 1996/02/15 17:49:19 mclareni
-* Kernlib
-*
-*
-*
-* wordsizc.h
-*/
-#if defined(CERNLIB_QMIRTD)
-#define NBITPW 64 /* Number of bits per word */
-#define NBYTPW 8 /* Number of bytes per word */
-#else
-#define NBYTPW 4 /* Number of bytes per word */
-#endif
diff --git a/src/packlib/kernlib/kerngen/kerngen/wordsize.inc b/src/packlib/kernlib/kerngen/kerngen/wordsize.inc
deleted file mode 100644
index 81dd633..0000000
--- a/src/packlib/kernlib/kerngen/kerngen/wordsize.inc
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: wordsize.inc,v 1.1.1.1 1996/02/15 17:49:18 mclareni Exp $
-*
-* $Log: wordsize.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:49:18 mclareni
-* Kernlib
-*
-*
-*
-* wordsize.inc
-*
-* # of bits/word
-* # of characters/word
-#if defined(CERNLIB_QMIRTD)
- PARAMETER (NBITPW=64, NCHAPW=8, NBITPC=8)
-#else
- PARAMETER (NBITPW=32)
- PARAMETER (NCHAPW=4)
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/_kuux/pilot.h b/src/packlib/kernlib/kerngen/obsolete/_kuux/pilot.h
deleted file mode 100644
index 7b77c0e..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/_kuux/pilot.h
+++ /dev/null
@@ -1,114 +0,0 @@
-#if 0
-* This pilot patch was created from kernfor.car patch _kuux
-#endif
-#if 0
-* pilot for an unknown UNIX machine
-#endif
-#ifndef CERNLIB_QMUUX
-#define CERNLIB_QMUUX
-#endif
-#if !defined(CERNLIB_B64)
-#ifndef CERNLIB_B32
-#define CERNLIB_B32
-#endif
-#endif
-#if !defined(CERNLIB_A8)
-#ifndef CERNLIB_A4
-#define CERNLIB_A4
-#endif
-#endif
-#ifndef CERNLIB_HEX
-#define CERNLIB_HEX
-#endif
-#if 0
-* running Unix
-#endif
-#ifndef CERNLIB_QS_UNIX
-#define CERNLIB_QS_UNIX
-#endif
-#if 0
-* IEEE floating point representation
-#endif
-#ifndef CERNLIB_QIEEE
-#define CERNLIB_QIEEE
-#endif
-#if 0
-* ISA standard routines, ISHFT, IOR, etc
-#endif
-#ifndef CERNLIB_QISASTD
-#define CERNLIB_QISASTD
-#endif
-#if 0
-* Posix call for setjmp/longjmp
-#endif
-#ifndef CERNLIB_QSIGJMP
-#define CERNLIB_QSIGJMP
-#endif
-#ifndef CERNLIB_QDEFAULT
-#define CERNLIB_QDEFAULT
-#endif
-#if !defined(CERNLIB_P5BOOT)
-#ifndef CERNLIB_CCGEN
-#define CERNLIB_CCGEN
-#endif
-#ifndef CERNLIB_CCGENCX
-#define CERNLIB_CCGENCX
-#endif
-#ifndef CERNLIB_CCGENCF
-#define CERNLIB_CCGENCF
-#endif
-#ifndef CERNLIB_CCGENCI
-#define CERNLIB_CCGENCI
-#endif
-#endif
-#if !defined(CERNLIB_P5BOOT)
-#ifndef CERNLIB_XVECT
-#define CERNLIB_XVECT
-#endif
-#ifndef CERNLIB_TCGEN
-#define CERNLIB_TCGEN
-#endif
-#endif
-#if defined(CERNLIB_P5BOOT)
-#ifndef CERNLIB_P5_CC
-#define CERNLIB_P5_CC
-#endif
-#ifndef CERNLIB_P5_CI
-#define CERNLIB_P5_CI
-#endif
-#endif
-#if 0
-* possible other options
-#endif
-#if !defined(CERNLIB__KUUX)
-#if 0
-.USE, QXNO_SC. external names without underscores
-#endif
-#if 0
-.USE, QXCAPT. external names capital
-#endif
-#if 0
-.USE, QSYSBSD. running Unix system BSD
-#endif
-#if 0
-.USE, QENVBSD. BSD version for SETENVF
-#endif
-#if 0
-.USE, QSIGBSD. signal handling with BSD sigvec
-#endif
-#if 0
-.USE, QSIGPOSIX. signal handling with Posix sigaction
-#endif
-#if 0
-.USE, QGETCWD. system has no getwd but getcwd
-#endif
-#if 0
-.USE, QMILSTD. MIL standard routines, IBITS, MVBITS, etc
-#endif
-#if 0
-.USE, QCCINDAD. Double indirect adr for externals
-#endif
-#if 0
-.USE, QORTHOLL, T=INH. Hollerith storage not orthodox
-#endif
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernali/aligs/Imakefile b/src/packlib/kernlib/kerngen/obsolete/kernali/aligs/Imakefile
deleted file mode 100644
index 28bf8ad..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernali/aligs/Imakefile
+++ /dev/null
@@ -1,8 +0,0 @@
-SRCS_F= \ @@\
- iucomh.F kerngt.F qnexte.F rndm.F ublow.F ubunch.F vxinvb.F \ @@\
- vxinvc.F xinb.F xinbs.F
-
-SRCS_S= \ @@\
- jumpxn.s longjmp.s setjmp.s
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernali/aligs/iucomh.F b/src/packlib/kernlib/kerngen/obsolete/kernali/aligs/iucomh.F
deleted file mode 100644
index 9a78814..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernali/aligs/iucomh.F
+++ /dev/null
@@ -1,48 +0,0 @@
-*
-* $Id: iucomh.F,v 1.1.1.1 1996/02/15 17:50:51 mclareni Exp $
-*
-* $Log: iucomh.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:51 mclareni
-* Kernlib
-*
-*
-#include "kernali/pilot.h"
- FUNCTION IUCOMH (ISTR1, ISTR2, NCH)
-C
-C CERN PROGLIB# IUCOMH .VERSION KERNALI 1.00 900919
-C ORIG. FCA+JZ, 20/02/90
-C
-C Compare the two Hollerith strings of NCH bytes length and return
-C -1 if STRING1 < STRING2
-C 0 =
-C +1 >
-C which is determined by the first non-identical character.
-C
- DIMENSION ISTR1(9), ISTR2(9)
- PARAMETER (NCHAPW=4,NBITPC=8)
-C
- NDO = NCH
- IF (NDO.LE.0) GO TO 30
- NWD = (NDO-1)/NCHAPW + 1
-
- DO 29 JW=1,NWD
- IWD1 = ISTR1(JW)
- IWD2 = ISTR2(JW)
- NL = MIN(NDO,4)
-
- DO 28 J=1,NL
- ICHAR1 = IAND (IWD1,255)
- ICHAR2 = IAND (IWD2,255)
- IF (ICHAR1-ICHAR2) 32, 26, 31
- 26 IWD1 = ISHFT (IWD1,-8)
- 28 IWD2 = ISHFT (IWD2,-8)
- 29 NDO = NDO - 4
-
- 30 IUCOMH = 0
- RETURN
-
- 31 IUCOMH = 1
- RETURN
- 32 IUCOMH = -1
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernali/aligs/jumpxn.s b/src/packlib/kernlib/kerngen/obsolete/kernali/aligs/jumpxn.s
deleted file mode 100644
index 5839120..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernali/aligs/jumpxn.s
+++ /dev/null
@@ -1,91 +0,0 @@
-*
-* $Id: jumpxn.s,v 1.1.1.1 1996/02/15 17:50:53 mclareni Exp $
-*
-* $Log: jumpxn.s,v $
-* Revision 1.1.1.1 1996/02/15 17:50:53 mclareni
-* Kernlib
-*
-*
- #
- #CERN PROGLIB# Z042 JUMPXN .VERSION KERNALI 1.00 900919
- #ORIG. 8/11/89 R.WARREN
- #
- .verstamp 1 31
- .lcomm $$6 4
- .lcomm $$7 4
- .text
- .align 2
- .file 2 "jumpxq.f"
- .globl jumpad_
- .loc 2 3
- .ent jumpad_ 2
-jumpad_:
- .option O1
- subu $sp, 48
- sw $31, 20($sp)
- .mask 0x80000000, -28
- .frame $sp, 48, $31
- b $37
-$32:
- .loc 2 5
- .set volatile
- lw $4, 28($sp)
- .set novolatile
- jal locb_
- sw $2, 40($sp)
- b $36
- .globl jumpst_
- .aent jumpst_ 2
-jumpst_:
- subu $sp, 48
- sw $31, 20($sp)
- sw $4, 48($sp)
- b $38
-$33:
- .loc 2 8
- .loc 2 9
- .set volatile
- lw $14, 28($sp)
- .set novolatile
- lw $15, 0($14)
- sw $15, $$7
- b $36
- .globl jumpxq_
- .aent jumpxq_ 2
-jumpxq_:
- .globl jumpx0_
- .aent jumpx0_ 2
-jumpx0_:
- .globl jumpx1_
- .aent jumpx1_ 2
-jumpx1_:
- .globl jumpx2_
- .aent jumpx2_ 2
-jumpx2_:
- .loc 2 15
- lw $24, $$7
- j $24
-$35:
- .lab $$6
-$36:
- .loc 2 17
- lw $2, 40($sp)
- b $39
-$37:
- sw $4, 28($sp)
- b $32
-$38:
- lw $4, 48($sp)
- sw $4, 28($sp)
- b $33
- .endb 12
- .endb 13
- .endb 14
-$39:
- lw $31, 20($sp)
- addu $sp, 48
- j $31
- .end jumpad_
-#ifdef CERNLIB_TCGEN_JUMPXN
-#undef CERNLIB_TCGEN_JUMPXN
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernali/aligs/kerngt.F b/src/packlib/kernlib/kerngen/obsolete/kernali/aligs/kerngt.F
deleted file mode 100644
index 6b1720e..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernali/aligs/kerngt.F
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: kerngt.F,v 1.1.1.1 1996/02/15 17:50:51 mclareni Exp $
-*
-* $Log: kerngt.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:51 mclareni
-* Kernlib
-*
-*
-#include "kernali/pilot.h"
- SUBROUTINE KERNGT (LUN)
-C
-C CERN PROGLIB# KERNGT .VERSION KERNALI 1.00 900919
-C ORIG. 3/02/89 K.M.STORR
-C
-C-- STORE PAM TITLE INTO /SLATE/ FOR PRINTING BY GSHOWF
-
- COMMON /SLATE/ ISLATE(40)
-
- CALL UCTOH1 (
- + CPP_TITLE_CH
- + // ' '
- +, ISLATE, 40 )
- CALL GSHOWF (LUN)
- RETURN
- END
-#ifdef CERNLIB_TCGEN_KERNGT
-#undef CERNLIB_TCGEN_KERNGT
-#endif
-#include "kernali/TITLE.kernali"
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernali/aligs/longjmp.s b/src/packlib/kernlib/kerngen/obsolete/kernali/aligs/longjmp.s
deleted file mode 100644
index c90e509..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernali/aligs/longjmp.s
+++ /dev/null
@@ -1,40 +0,0 @@
-*
-* $Id: longjmp.s,v 1.1.1.1 1996/02/15 17:50:53 mclareni Exp $
-*
-* $Log: longjmp.s,v $
-* Revision 1.1.1.1 1996/02/15 17:50:53 mclareni
-* Kernlib
-*
-*
- .text
- #
- #CERN PROGLIB# LONGJMP .VERSION KERNALI 1.00 900919
- #ORIG. 8/11/89 R.WARREN
- #
- .align 2
- .globl longjmp_
- .loc 2 11
- .ent longjmp_ 2
-longjmp_:
- .option O1
- subu $sp, 32
- sw $31, 20($sp)
- sd $4, 32($sp)
- .mask 0x80000000, -12
- .frame $sp, 32, $31
- .loc 2 12
- lw $14, 36($sp)
- lw $15, 0($14)
- sw $15, 28($sp)
- .loc 2 13
- lw $4, 32($sp)
- move $5, $15
- jal longjmp
- .loc 2 14
- lw $31, 20($sp)
- addu $sp, 32
- j $31
- .end longjmp_
-#ifdef CERNLIB_TCGEN_LONGJMP
-#undef CERNLIB_TCGEN_LONGJMP
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernali/aligs/qnexte.F b/src/packlib/kernlib/kerngen/obsolete/kernali/aligs/qnexte.F
deleted file mode 100644
index 63cea0f..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernali/aligs/qnexte.F
+++ /dev/null
@@ -1,37 +0,0 @@
-*
-* $Id: qnexte.F,v 1.1.1.1 1996/02/15 17:50:53 mclareni Exp $
-*
-* $Log: qnexte.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:53 mclareni
-* Kernlib
-*
-*
-#include "kernali/pilot.h"
- SUBROUTINE QNEXTE
-C
-C CERN PROGLIB# Z041 QNEXTE .VERSION KERNALI 1.00 900919
-C ORIG. 12/10/89 K.M.STORR from Apollo version
-C
- SAVE MAREA
- DIMENSION MAREA(16)
- DATA MAREA / 16*0 /
-
- IF (MAREA(1).EQ.0) GO TO 21
-C
-C-- RE-ENTRY
-C
- CALL LONGJMP (MAREA(2),J)
-C
-C-- FIRST ENTRY
-C
- 21 MAREA(1) = 77
- CALL SETJMP (MAREA(2))
-C
-C-- GO DOWN
-C
- CALL QNEXT
- RETURN
- END
-#ifdef CERNLIB_TCGEN_QNEXTE
-#undef CERNLIB_TCGEN_QNEXTE
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernali/aligs/rndm.F b/src/packlib/kernlib/kerngen/obsolete/kernali/aligs/rndm.F
deleted file mode 100644
index 12b5067..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernali/aligs/rndm.F
+++ /dev/null
@@ -1,60 +0,0 @@
-*
-* $Id: rndm.F,v 1.1.1.1 1996/02/15 17:50:53 mclareni Exp $
-*
-* $Log: rndm.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:53 mclareni
-* Kernlib
-*
-*
-#include "kernali/pilot.h"
- FUNCTION RNDM (ISEED)
-C
-C CERN PROGLIB# V104 RNDM .VERSION KERNALI 1.00 900919
-C ORIG. 2/02/89 M.K.Storr from IBM version
-C
-C- Uniform Random Number Generator,
-C- giving the same sequence as the IBM and VAX version
-
- REAL IRNDM
- EQUIVALENCE (AMAN,MANT)
- SAVE MCGN
- DATA MCGN /12345/
- DATA MASK1 /'0C000000'x/, MASK2/'33000000'x/
-
- MCGN = MCGN * 69069
- MANT = ishft (MCGN,-8)
- IF (MANT.EQ.0) GO TO 14
- AMAN = MANT
-C- AMAN in the range 1 to 2**24-1
- MANT = MANT - MASK1
-C- multiply by 2.**(-24)
- RNDM = AMAN
- RETURN
-
-C-- for zero set RNDM = 2.**(-25)
- 14 MANT = MASK2
- RNDM = AMAN
- RETURN
-
-C-- Integer random number
- ENTRY IRNDM (ISEED)
- MCGN = MCGN * 69069
- MANT = ISHFT (MCGN,-1)
- IRNDM = AMAN
- RETURN
-
-C-- Set the seed
- ENTRY RDMIN (ISEED)
- MCGN = ISEED
- RETURN
-
-C-- Get the seed
- ENTRY RDMOUT (ISEED)
- ISEED = MCGN
- END
-#ifdef CERNLIB_TCGEN_RNDM
-#undef CERNLIB_TCGEN_RNDM
-#endif
-#ifdef CERNLIB_TCGEN_IRNDM
-#undef CERNLIB_TCGEN_IRNDM
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernali/aligs/setjmp.s b/src/packlib/kernlib/kerngen/obsolete/kernali/aligs/setjmp.s
deleted file mode 100644
index 29a0cf3..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernali/aligs/setjmp.s
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: setjmp.s,v 1.1.1.1 1996/02/15 17:50:53 mclareni Exp $
-*
-* $Log: setjmp.s,v $
-* Revision 1.1.1.1 1996/02/15 17:50:53 mclareni
-* Kernlib
-*
-*
- .text
- #
- #CERN PROGLIB# SETJMP .VERSION KERNALI 1.00 900919
- #ORIG. 8/11/89 R.WARREN
- #
- .align 2
- .globl setjmp_
- .loc 2 5
- .ent setjmp_ 2
-setjmp_:
- .option O1
- j setjmp
- sw $4, 0($sp)
- .frame $sp, 0, $31
- .loc 2 6
- j $31
- .end setjmp_
-#ifdef CERNLIB_TCGEN_SETJMP
-#undef CERNLIB_TCGEN_SETJMP
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernali/aligs/ublow.F b/src/packlib/kernlib/kerngen/obsolete/kernali/aligs/ublow.F
deleted file mode 100644
index 08298ad..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernali/aligs/ublow.F
+++ /dev/null
@@ -1,53 +0,0 @@
-*
-* $Id: ublow.F,v 1.1.1.1 1996/02/15 17:50:53 mclareni Exp $
-*
-* $Log: ublow.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:53 mclareni
-* Kernlib
-*
-*
-#include "kernali/pilot.h"
- SUBROUTINE UBLOW (MS,MT,NCHP)
-C
-C CERN PROGLIB# M409 UBLOW .VERSION KERNALI 1.00 900919
-C ORIG. 03/02/89 K.M.STORR
-C
-
- DIMENSION MS(99), MT(99), NCHP(9)
- DATA IBLAN1 /'20202000'X/
- DATA MASK1 /'000000FF'X/
-
- NCH = NCHP(1)
- IF (NCH) 91, 29, 11
- 11 NWS = ishft (NCH,-2)
- NTRAIL = IAND (NCH,3)
- JT = 0
- IF (NWS.EQ.0) GO TO 26
-
-C-- Unpack the initial complete words
-
- DO 24 JS=1,NWS
- MWD = MS(JS)
- MT(JT+1) = IOR (IBLAN1,IAND(MASK1,MWD))
- MT(JT+2) = IOR (IBLAN1,IAND(MASK1,ISHFT(MWD, -8)))
- MT(JT+3) = IOR (IBLAN1,IAND(MASK1,ISHFT(MWD,-16)))
- MT(JT+4) = IOR (IBLAN1, ISHFT(MWD,-24) )
- 24 JT = JT + 4
-
- IF (NTRAIL.EQ.0) RETURN
-
-C-- Unpack the trailing word
-
- 26 MWD = MS(NWS+1)
-
- DO 28 JS=1,NTRAIL
- MT(JT+1) = IOR (IBLAN1,IAND(MASK1,MWD))
- MWD = ISHFT (MWD,-8)
- 28 JT = JT + 1
- 29 RETURN
-
- 91 CALL ABEND
- END
-#ifdef CERNLIB_TCGEN_UBLOW
-#undef CERNLIB_TCGEN_UBLOW
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernali/aligs/ubunch.F b/src/packlib/kernlib/kerngen/obsolete/kernali/aligs/ubunch.F
deleted file mode 100644
index e5ef675..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernali/aligs/ubunch.F
+++ /dev/null
@@ -1,54 +0,0 @@
-*
-* $Id: ubunch.F,v 1.1.1.1 1996/02/15 17:50:53 mclareni Exp $
-*
-* $Log: ubunch.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:53 mclareni
-* Kernlib
-*
-*
-#include "kernali/pilot.h"
- SUBROUTINE UBUNCH (MS,MT,NCHP)
-C
-C CERN PROGLIB# M409 UBUNCH .VERSION KERNALI 1.00 900919
-C ORIG. 03/02/89 K.M.STORR
-C
-
- DIMENSION MS(99), MT(99), NCHP(9)
- DATA IBLAN1 /'20202020'X/
- DATA MASK1 /'000000FF'X/
-
- NCH = NCHP(1)
- IF (NCH) 91,39,11
- 11 NWT = ishft (NCH,-2)
- NTRAIL = IAND (NCH,3)
- JS = 0
- IF (NWT.EQ.0) GO TO 31
-
-C-- Pack the initial complete words
-
- DO 24 JT=1,NWT
- MT(JT) = IOR (IOR (IOR (
- + IAND(MS(JS+1),MASK1),
- + ishft (IAND(MS(JS+2),MASK1), 8)),
- + ishft (IAND(MS(JS+3),MASK1),16)),
- + ishft (MS(JS+4), 24) )
- 24 JS = JS + 4
-
- IF (NTRAIL.EQ.0) RETURN
-
-C-- Pack the trailing word
-
- 31 MWD = IBLAN1
- JS = NCH
-
- DO 34 JT=1,NTRAIL
- MWD = IOR (ishft(MWD,8), IAND(MS(JS),MASK1))
- 34 JS = JS - 1
- MT(NWT+1) = MWD
- 39 RETURN
-
- 91 CALL ABEND
- END
-#ifdef CERNLIB_TCGEN_UBUNCH
-#undef CERNLIB_TCGEN_UBUNCH
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernali/aligs/vxinvb.F b/src/packlib/kernlib/kerngen/obsolete/kernali/aligs/vxinvb.F
deleted file mode 100644
index 1d16498..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernali/aligs/vxinvb.F
+++ /dev/null
@@ -1,30 +0,0 @@
-*
-* $Id: vxinvb.F,v 1.1.1.1 1996/02/15 17:50:53 mclareni Exp $
-*
-* $Log: vxinvb.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:53 mclareni
-* Kernlib
-*
-*
-#include "kernali/pilot.h"
- SUBROUTINE VXINVB (MV,NW)
-
-C CERN PROGLIB# M434 VXINVB .VERSION KERNALI 1.00 900919
-C ORIG. 12-June-87, F. Carminati + J. Zoll
-
-C- VX invert bytes, in-place
-C- Fortran version, slower than the machine-language routine
-
- DIMENSION MV(99)
- LOGICAL*1 LLD(4), LST(4)
- EQUIVALENCE (LLD,MLD), (LST,MST)
-
- DO 29 J=1,NW
- MLD = MV(J)
- LST(1) = LLD(4)
- LST(2) = LLD(3)
- LST(3) = LLD(2)
- LST(4) = LLD(1)
- MV(J) = MST
- 29 CONTINUE
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernali/aligs/vxinvc.F b/src/packlib/kernlib/kerngen/obsolete/kernali/aligs/vxinvc.F
deleted file mode 100644
index bb97370..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernali/aligs/vxinvc.F
+++ /dev/null
@@ -1,30 +0,0 @@
-*
-* $Id: vxinvc.F,v 1.1.1.1 1996/02/15 17:50:54 mclareni Exp $
-*
-* $Log: vxinvc.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:54 mclareni
-* Kernlib
-*
-*
-#include "kernali/pilot.h"
- SUBROUTINE VXINVC (MVI,MVX,NW)
-
-C CERN PROGLIB# M434 VXINVC .VERSION KERNALI 1.00 900919
-C ORIG. 12-June-87, F. Carminati + J. Zoll
-
-C- VX invert bytes and copy
-C- Fortran version, slower than the machine-language routine
-
- DIMENSION MVI(99), MVX(99)
- LOGICAL*1 LLD(4), LST(4)
- EQUIVALENCE (LLD,MLD), (LST,MST)
-
- DO 29 J=1,NW
- MLD = MVI(J)
- LST(1) = LLD(4)
- LST(2) = LLD(3)
- LST(3) = LLD(2)
- LST(4) = LLD(1)
- MVX(J) = MST
- 29 CONTINUE
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernali/aligs/xinb.F b/src/packlib/kernlib/kerngen/obsolete/kernali/aligs/xinb.F
deleted file mode 100644
index 310ae8f..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernali/aligs/xinb.F
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: xinb.F,v 1.1.1.1 1996/02/15 17:50:54 mclareni Exp $
-*
-* $Log: xinb.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:54 mclareni
-* Kernlib
-*
-*
-#include "kernali/pilot.h"
- SUBROUTINE XINB (LUN,XBV,NXB)
-C
-C CERN PROGLIB# Z203 XINB .VERSION KERNALI 1.00 900919
-C ORIG. 4/01/89 JZ
-C
- DIMENSION XBV(99)
-
- READ (LUN,IOSTAT=JSTAT) N, (XBV(J),J=1,MIN(N,NXB))
- IF (JSTAT) 61, 24, 64
- 24 N = MIN (N,NXB)
- NXB = MAX (N,1)
- RETURN
-
- 61 NXB = 0
- RETURN
-
- 64 NXB = -JSTAT
- RETURN
- END
-#ifdef CERNLIB_TCGEN_XINB
-#undef CERNLIB_TCGEN_XINB
-#endif
-#ifdef CERNLIB_XVECT_XINB
-#undef CERNLIB_XVECT_XINB
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernali/aligs/xinbs.F b/src/packlib/kernlib/kerngen/obsolete/kernali/aligs/xinbs.F
deleted file mode 100644
index 7a38f5c..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernali/aligs/xinbs.F
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: xinbs.F,v 1.1.1.1 1996/02/15 17:50:54 mclareni Exp $
-*
-* $Log: xinbs.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:54 mclareni
-* Kernlib
-*
-*
-#include "kernali/pilot.h"
- SUBROUTINE XINBS (LUN,XAV,NA,XBV,NXB)
-C
-C CERN PROGLIB# Z203 XINBS .VERSION KERNALI 1.00 900919
-C ORIG. 4/01/89 JZ
-C
- DIMENSION XBV(99), XAV(NA)
-
- READ (LUN,IOSTAT=JSTAT) N,XAV,(XBV(J),J=1,MIN(N,NXB))
- IF (JSTAT) 61, 24, 64
- 24 N = MIN (N,NXB)
- NXB = MAX (N,1)
- RETURN
-
- 61 NXB = 0
- RETURN
-
- 64 NXB = -JSTAT
- RETURN
- END
-#ifdef CERNLIB_TCGEN_XINBS
-#undef CERNLIB_TCGEN_XINBS
-#endif
-#ifdef CERNLIB_XVECT_XINBS
-#undef CERNLIB_XVECT_XINBS
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernali/inhibit.list b/src/packlib/kernlib/kerngen/obsolete/kernali/inhibit.list
deleted file mode 100644
index b8e3109..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernali/inhibit.list
+++ /dev/null
@@ -1,13 +0,0 @@
-tcgen/kerngt
-tcgen/jumpxn
-tcgen/qnexte
-tcgen/rndm
-tcgen/irndm
-tcgen/setjmp
-tcgen/longjmp
-tcgen/ublow
-tcgen/ubunch
-tcgen/xinb
-xvect/xinb
-tcgen/xinbs
-xvect/xinbs
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernali/kernali/pilot.h b/src/packlib/kernlib/kerngen/obsolete/kernali/kernali/pilot.h
deleted file mode 100644
index e7cb643..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernali/kernali/pilot.h
+++ /dev/null
@@ -1,58 +0,0 @@
-#if 0
-* This pilot patch was created from kernali.car patch _kali
-* This directory was created from kernali.car patch qmali
-#endif
-#ifndef CERNLIB_A4
-#define CERNLIB_A4
-#endif
-#ifndef CERNLIB_B32
-#define CERNLIB_B32
-#endif
-#ifndef CERNLIB_HEX
-#define CERNLIB_HEX
-#endif
-#ifndef CERNLIB_QISASTD
-#define CERNLIB_QISASTD
-#endif
-#ifndef CERNLIB_BSD42
-#define CERNLIB_BSD42
-#endif
-#ifndef CERNLIB_ALIGS
-#define CERNLIB_ALIGS
-#endif
-#ifndef CERNLIB_XVECT
-#define CERNLIB_XVECT
-#endif
-#ifndef CERNLIB_TCGEN
-#define CERNLIB_TCGEN
-#endif
-#ifndef CERNLIB_CCGEN_ABEND
-#define CERNLIB_CCGEN_ABEND
-#endif
-#ifndef CERNLIB_CCGEN_DATIME
-#define CERNLIB_CCGEN_DATIME
-#endif
-#ifndef CERNLIB_CCGEN_DATIMH
-#define CERNLIB_CCGEN_DATIMH
-#endif
-#ifndef CERNLIB_CCGEN_INTRAC
-#define CERNLIB_CCGEN_INTRAC
-#endif
-#ifndef CERNLIB_CCGEN_LOCB
-#define CERNLIB_CCGEN_LOCB
-#endif
-#ifndef CERNLIB_CCGEN_LOCF
-#define CERNLIB_CCGEN_LOCF
-#endif
-#ifndef CERNLIB_CCGEN_TIMEL
-#define CERNLIB_CCGEN_TIMEL
-#endif
-#ifndef CERNLIB_CCGEN_TMNBUF
-#define CERNLIB_CCGEN_TMNBUF
-#endif
-#ifndef CERNLIB_CCGEN_TMPROM
-#define CERNLIB_CCGEN_TMPROM
-#endif
-#ifndef CERNLIB_CCGEN_TMREAD
-#define CERNLIB_CCGEN_TMREAD
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernali/kernali/qcardl.inc b/src/packlib/kernlib/kerngen/obsolete/kernali/kernali/qcardl.inc
deleted file mode 100644
index b5b4ea3..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernali/kernali/qcardl.inc
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: qcardl.inc,v 1.1.1.1 1996/02/15 17:50:51 mclareni Exp $
-*
-* $Log: qcardl.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:50:51 mclareni
-* Kernlib
-*
-*
-#ifndef CERNLIB_KERNALI_QCARDL_INC
-#define CERNLIB_KERNALI_QCARDL_INC
-*
-*
-* qcardl.inc
-*
-#if 0
-C====================================================================
-#endif
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernalt/altgs/Imakefile b/src/packlib/kernlib/kerngen/obsolete/kernalt/altgs/Imakefile
deleted file mode 100644
index 25d9091..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernalt/altgs/Imakefile
+++ /dev/null
@@ -1,11 +0,0 @@
-SRCS_F= \ @@\
- kerngt.F lenocc.F locff.F ucopy.F ucopy2.F ucopyn.F uctoh.F \ @@\
- uctoh1.F uh1toc.F uhtoc.F vblank.F vfill.F vzero.F xinb.F xinbs.F
-
-SRCS_C= \ @@\
- lenoci.c
-
-SRCS_S= \ @@\
- locb.s locf.s
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernalt/altgs/kerngt.F b/src/packlib/kernlib/kerngen/obsolete/kernalt/altgs/kerngt.F
deleted file mode 100644
index 010ed1d..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernalt/altgs/kerngt.F
+++ /dev/null
@@ -1,35 +0,0 @@
-*
-* $Id: kerngt.F,v 1.1.1.1 1996/02/15 17:50:55 mclareni Exp $
-*
-* $Log: kerngt.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:55 mclareni
-* Kernlib
-*
-*
-#include "kernalt/pilot.h"
- SUBROUTINE KERNGT (LUN)
-C
-C CERN PROGLIB# Z001 KERNGT .VERSION KERNALT 1.08 891207
-C ORIG. 16/03/89
-C
-C-- Store Pam title into /SLATE/ for printing by GSHOWF
-
- COMMON /SLATE/ MCH(40)
-
-C- GSHOW is the old name for KERNGT
- ENTRY GSHOW (LUN)
-
- CALL UCTOH1 (
- + CPP_TITLE_CH
- + // ' '
- +, MCH, 40)
- CALL GSHOWF (LUN)
- RETURN
- END
-#ifdef CERNLIB_TCGEN_KERNGT
-#undef CERNLIB_TCGEN_KERNGT
-#endif
-#ifdef CERNLIB_TCGEN_GSHOW
-#undef CERNLIB_TCGEN_GSHOW
-#endif
-#include "kernalt/TITLE.kernalt"
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernalt/altgs/lenocc.F b/src/packlib/kernlib/kerngen/obsolete/kernalt/altgs/lenocc.F
deleted file mode 100644
index 4e4453a..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernalt/altgs/lenocc.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: lenocc.F,v 1.1.1.1 1996/02/15 17:50:55 mclareni Exp $
-*
-* $Log: lenocc.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:55 mclareni
-* Kernlib
-*
-*
-#include "kernalt/pilot.h"
- FUNCTION LENOCC (CHP)
-C
-C CERN PROGLIB# M507 LENOCC .VERSION KERNALT 1.11 920603
-C ORIG. 02/06/92 JZ
-C
-C-- Find last non-blank character
-C- (With Alliant Fortran the hidden length of a string
-C- is not available to a called C routine)
-
- CHARACTER CHP*(*)
-
- LENOCC = LENOCI (CHP,LEN(CHP))
- RETURN
- END
-#ifdef CERNLIB_TCGEN_LENOCC
-#undef CERNLIB_TCGEN_LENOCC
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernalt/altgs/lenoci.c b/src/packlib/kernlib/kerngen/obsolete/kernalt/altgs/lenoci.c
deleted file mode 100644
index 46e3f63..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernalt/altgs/lenoci.c
+++ /dev/null
@@ -1,61 +0,0 @@
-/*
- * $Id: lenoci.c,v 1.1.1.1 1996/02/15 17:50:55 mclareni Exp $
- *
- * $Log: lenoci.c,v $
- * Revision 1.1.1.1 1996/02/15 17:50:55 mclareni
- * Kernlib
- *
- */
-#include "kernalt/pilot.h"
-/*> ROUTINE LENOCI
- CERN PROGLIB# M507 LENOCC .VERSION KERNALT 1.11 920603
- ORIG. 30/04/92, RDM + JZ
-
- N = LENOCC (CHLINE) find last non-blank character in CHLINE
-*/
- int lenoci_(chline, lenpar)
- char *chline;
- int *lenpar;
-{
- static unsigned int blnk = 0x20202020;
- unsigned int *wdcur;
- char *chcur;
- int ntail, i;
- int len;
-
- len = *lenpar;
-
- chcur = chline + len;
- if (len <= 24) goto small;
-
-/* ---- handle long string */
-
-/* look at the last ntail characters */
-
- ntail = ((int)chcur & 3);
- for (i = ntail; i > 0; i--)
- { if (*--chcur != ' ') goto exit; }
-
-/* look for trailing blank words */
-
- wdcur = (unsigned int*) (chcur-4);
- while (wdcur >= (unsigned int*)chline )
- { if (*wdcur != blnk) break; wdcur--; }
-
-/* find last non-blank character */
-
- chcur = (char*) (wdcur+1);
- while (chcur > chline)
- { if (*--chcur != ' ') goto exit; }
- return 0;
-
-exit: return chcur+1 - chline;
-
-/* ---- handle short string */
-
-small:
- while (chcur > chline)
- { if (*--chcur != ' ') goto exit; }
- return 0;
-}
-/*> END <----------------------------------------------------------*/
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernalt/altgs/locb.s b/src/packlib/kernlib/kerngen/obsolete/kernalt/altgs/locb.s
deleted file mode 100644
index bc0c649..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernalt/altgs/locb.s
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: locb.s,v 1.1.1.1 1996/02/15 17:50:55 mclareni Exp $
-*
-* $Log: locb.s,v $
-* Revision 1.1.1.1 1996/02/15 17:50:55 mclareni
-* Kernlib
-*
-*
-|--> IDENT: locb
-| CERN PROGLIB# N100 LOCB .VERSION KERNALT 1.08 891207
-| ORIG. 28/06/88 JZ
-
- .text
- .globl _locb_
- | JAD = LOCB (VAR) lword adr of VAR
-_locb_:
- movl a0@, d0 | d0 = lad byte adr
- rts
-#ifdef CERNLIB_CCGEN_LOCB
-#undef CERNLIB_CCGEN_LOCB
-#endif
-#ifdef CERNLIB_TCGEN_LOCB
-#undef CERNLIB_TCGEN_LOCB
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernalt/altgs/locf.s b/src/packlib/kernlib/kerngen/obsolete/kernalt/altgs/locf.s
deleted file mode 100644
index ffee403..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernalt/altgs/locf.s
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: locf.s,v 1.1.1.1 1996/02/15 17:50:55 mclareni Exp $
-*
-* $Log: locf.s,v $
-* Revision 1.1.1.1 1996/02/15 17:50:55 mclareni
-* Kernlib
-*
-*
-|--> IDENT: locf
-| CERN PROGLIB# N100 LOCF .VERSION KERNALT 1.03 880701
-| ORIG. 28/06/88 JZ
-
- .text
- .globl _locf_
- | JAD = LOCF (VAR) lword adr of VAR
-_locf_:
- movl a0@, d0 | d0 = lad byte adr
- asrl #2, d0 | ladr = lad / 4
- rts
-#ifdef CERNLIB_CCGEN_LOCF
-#undef CERNLIB_CCGEN_LOCF
-#endif
-#ifdef CERNLIB_TCGEN_LOCF
-#undef CERNLIB_TCGEN_LOCF
-#endif
-#ifdef CERNLIB_ALTGS_LOCFF
-#undef CERNLIB_ALTGS_LOCFF
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernalt/altgs/locff.F b/src/packlib/kernlib/kerngen/obsolete/kernalt/altgs/locff.F
deleted file mode 100644
index 542ae62..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernalt/altgs/locff.F
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: locff.F,v 1.1.1.1 1996/02/15 17:50:55 mclareni Exp $
-*
-* $Log: locff.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:55 mclareni
-* Kernlib
-*
-*
-#include "kernalt/pilot.h"
- FUNCTION LOCF (AM)
-C
-C CERN PROGLIB# N100 LOCF .VERSION KERNALT 1.01 880222
-C ORIG. 22/02/88 JZ
-C
- DIMENSION AM(9)
-
- LOCF= LOC (AM(1)) /4
- RETURN
- END
-#ifdef CERNLIB_CCGEN_LOCF
-#undef CERNLIB_CCGEN_LOCF
-#endif
-#ifdef CERNLIB_TCGEN_LOCF
-#undef CERNLIB_TCGEN_LOCF
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernalt/altgs/ucopy.F b/src/packlib/kernlib/kerngen/obsolete/kernalt/altgs/ucopy.F
deleted file mode 100644
index abd42b4..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernalt/altgs/ucopy.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: ucopy.F,v 1.1.1.1 1996/02/15 17:50:55 mclareni Exp $
-*
-* $Log: ucopy.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:55 mclareni
-* Kernlib
-*
-*
-#include "kernalt/pilot.h"
- SUBROUTINE UCOPY (A,B,N)
-C
-C CERN PROGLIB# V301 UCOPY .VERSION KERNALT 1.00 880212
-C ORIG. 15/02/88 JZ
-C
-C-- No overlap, A and B must be separate vectors on the Alliant
-C- For overlaps use UCOPY2
-
- DIMENSION A(2),B(2)
-
- IF (N.EQ.0) RETURN
- B(1:N) = A(1:N)
- RETURN
- END
-#ifdef CERNLIB_TCGEN_UCOPY
-#undef CERNLIB_TCGEN_UCOPY
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernalt/altgs/ucopy2.F b/src/packlib/kernlib/kerngen/obsolete/kernalt/altgs/ucopy2.F
deleted file mode 100644
index c39a604..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernalt/altgs/ucopy2.F
+++ /dev/null
@@ -1,52 +0,0 @@
-*
-* $Id: ucopy2.F,v 1.1.1.1 1996/02/15 17:50:55 mclareni Exp $
-*
-* $Log: ucopy2.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:55 mclareni
-* Kernlib
-*
-*
-#include "kernalt/pilot.h"
- SUBROUTINE UCOPY2 (A,B,N)
-C
-C CERN PROGLIB# V301 UCOPY2 .VERSION KERNALT 1.01 880222
-C ORIG. 22/02/88 JZ
-C
-C-- Vectors A and B may be overlapping
-
- INTEGER A(99), B(99)
-
- IA = LOC (A(1))
- IB = LOC (B(1))
- IF (N.EQ.0) RETURN
- IF (IA-IB) 41, 99, 21
-
-C---- IB < IA : the beginning of A may overlap the end of B
-
- 21 IF (IB+4*N .LE. IA) THEN
- B(1:N) = A(1:N)
- RETURN
- ENDIF
-
-CVD$ NOCONCUR
- DO 24 I=1,N
- 24 B(I) = A(I)
-CVD$ CONCUR
- RETURN
-
-C---- IA < IB : the beginning of B may overlap the end of A
-
- 41 IF (IA+4*N .LE. IB) THEN
- B(1:N) = A(1:N)
- RETURN
- ENDIF
-
-CVD$ NOCONCUR
- DO 44 I=N,1,-1
- 44 B(I) = A(I)
-CVD$ CONCUR
- 99 RETURN
- END
-#ifdef CERNLIB_TCGEN_UCOPY2
-#undef CERNLIB_TCGEN_UCOPY2
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernalt/altgs/ucopyn.F b/src/packlib/kernlib/kerngen/obsolete/kernalt/altgs/ucopyn.F
deleted file mode 100644
index f39e2a7..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernalt/altgs/ucopyn.F
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: ucopyn.F,v 1.1.1.1 1996/02/15 17:50:55 mclareni Exp $
-*
-* $Log: ucopyn.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:55 mclareni
-* Kernlib
-*
-*
-#include "kernalt/pilot.h"
- SUBROUTINE UCOPYN (IA,IX,N)
-C
-C CERN PROGLIB# V301 UCOPYN .VERSION KERNALT 1.00 880212
-C ORIG. 15/02/88 JZ
-C
- DIMENSION IA(99), IX(99)
-
- IF (N.EQ.0) RETURN
-
- IX(1:N) = -IA(1:N)
- RETURN
- END
-#ifdef CERNLIB_TCGEN_UCOPYN
-#undef CERNLIB_TCGEN_UCOPYN
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernalt/altgs/uctoh.F b/src/packlib/kernlib/kerngen/obsolete/kernalt/altgs/uctoh.F
deleted file mode 100644
index e26e33a..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernalt/altgs/uctoh.F
+++ /dev/null
@@ -1,166 +0,0 @@
-*
-* $Id: uctoh.F,v 1.1.1.1 1996/02/15 17:50:55 mclareni Exp $
-*
-* $Log: uctoh.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:55 mclareni
-* Kernlib
-*
-*
-#include "kernalt/pilot.h"
- SUBROUTINE UCTOH (MS,MT,NPW,NCHP)
-C
-C CERN PROGLIB# M409 UCTOH .VERSION KERNALT 1.00 880212
-C ORIG. 10/02/88 JZ
-C
- DIMENSION MS(99), MT(99), NCHP(9)
-
- DIMENSION MWDV(3)
- CHARACTER CHWD*12
- EQUIVALENCE (CHWD,MWDV)
-
- PARAMETER (IBLAN1 = '00202020'X)
- PARAMETER (IBLAN2 = '00002020'X)
- PARAMETER (IBLAN3 = '00000020'X)
- PARAMETER (MASK1 = 'FF000000'X)
- PARAMETER (MASK2 = 'FFFF0000'X)
- PARAMETER (MASK3 = 'FFFFFF00'X)
-
- DIMENSION IBLANK(3), MASK(3)
- DATA IBLANK / '00202020'X, '00002020'X, '00000020'X /
- DATA MASK / 'FF000000'X, 'FFFF0000'X, 'FFFFFF00'X /
-
-
- NCH = NCHP(1)
- IF (NCH) 91, 29, 11
- 11 GO TO (21, 31, 41), NPW
-
-C-------- NPW = 4
-
- NWS = ishft (NCH,-2)
- NTRAIL = IAND (NCH,3)
- IF (NWS.EQ.0) GO TO 15
-
- DO 14 J=1,NWS
- 14 MT(J) = MS(J)
- IF (NTRAIL.EQ.0) RETURN
-
- 15 MT(NWS+1) = IOR (IBLANK(NTRAIL), IAND(MS(NWS+1),MASK(NTRAIL)))
- RETURN
-
-C-------- NPW = 1
-C-- equivalent to 'CALL UCTOH1(MS,MT,NCH)'
-
- 21 NWS = ishft (NCH,-2)
- NTRAIL = IAND (NCH,3)
- JT = 0
- IF (NWS.EQ.0) GO TO 26
-
-C-- Unpack the initial complete words
-
- DO 24 JS=1,NWS
- MWD = MS(JS)
- MT(JT+1) = IOR (IBLAN1,IAND(MASK1,MWD))
- MT(JT+2) = IOR (IBLAN1,IAND(MASK1,ISHFT(MWD, 8)))
- MT(JT+3) = IOR (IBLAN1,IAND(MASK1,ISHFT(MWD,16)))
- MT(JT+4) = IOR (IBLAN1, ISHFT(MWD,24) )
- 24 JT = JT + 4
-
- IF (NTRAIL.EQ.0) RETURN
-
-C-- Unpack the trailing word
-
- 26 MWD = MS(NWS+1)
-
- DO 28 JS=1,NTRAIL
- MT(JT+1) = IOR (IBLAN1,IAND(MASK1,MWD))
- MWD = ISHFT (MWD,8)
- 28 JT = JT + 1
- 29 RETURN
-
-C-------- NPW = 2
-
- 31 NWS = ishft (NCH,-2)
- NTRAIL = IAND (NCH,3)
- JT = 0
- IF (NWS.EQ.0) GO TO 36
-
-C-- Unpack the initial complete words
-
- DO 34 JS=1,NWS
- MWD = MS(JS)
- MT(JT+1) = IOR (IBLAN2,IAND(MASK2,MWD))
- MT(JT+2) = IOR (IBLAN2,ISHFT(MWD,16))
- 34 JT = JT + 2
-
- IF (NTRAIL.EQ.0) RETURN
-
-C-- Unpack the trailing word
-
- 36 MWD = MS(NWS+1)
-
- IF (NTRAIL.EQ.1) THEN
- MT(JT+1) = IOR (IBLAN1,IAND(MASK1,MWD))
- RETURN
-
- ELSEIF (NTRAIL.EQ.2) THEN
- MT(JT+1) = IOR (IBLAN2,IAND(MASK2,MWD))
- RETURN
-
- ELSE
- MT(JT+1) = IOR (IBLAN2,IAND(MASK2,MWD))
- MT(JT+2) = IOR (IBLAN1,IAND(MASK1,ISHFT(MWD,16)))
- ENDIF
- RETURN
-
-C-------- NPW = 3
-
- 41 NWS = NCH/12
- NTRAIL = NCH - 12*NWS
- JS = 0
- JT = 0
- IF (NWS.EQ.0) GO TO 46
-
-C-- Unpack the initial complete words
-
- DO 44 JL=1,NWS
- MWDV(1) = MS(JS+1)
- MWDV(2) = MS(JS+2)
- MWDV(3) = MS(JS+3)
- MT(JT+1) = IOR (IBLAN3,IAND(MASK3,MWDV(1)))
- MT(JT+2) = IOR (IOR (IBLAN3,ISHFT(MWDV(1),24))
- +, ishft(IAND(MASK2,MWDV(2)),-8))
- MT(JT+3) = IOR (IOR (IBLAN3,ISHFT(MWDV(2),16))
- +, ishft(IAND(MASK1,MWDV(3)),-16))
- MT(JT+4) = IOR (IBLAN3,ISHFT(MWDV(3),8))
- JS = JS + 3
- 44 JT = JT + 4
-
- IF (NTRAIL.EQ.0) RETURN
-
-C-- Unpack the trailing words
-
- 46 MWDV(1) = MS(JS+1)
- MWDV(2) = MS(JS+2)
- MWDV(3) = MS(JS+3)
-
- CHWD(NTRAIL+1:12) = ' '
-
- MT(JT+1) = IOR (IBLAN3,IAND(MASK3,MWDV(1)))
- IF (NTRAIL.LE.3) RETURN
-
- MT(JT+2) = IOR (IOR (IBLAN3,ISHFT(MWDV(1),24))
- +, ishft(IAND(MASK2,MWDV(2)),-8))
- IF (NTRAIL.LE.6) RETURN
-
- MT(JT+3) = IOR (IOR (IBLAN3,ISHFT(MWDV(2),16))
- +, ishft(IAND(MASK1,MWDV(3)),-16))
- IF (NTRAIL.LE.9) RETURN
-
- MT(JT+4) = IOR (IBLAN3,ISHFT(MWDV(3),8))
- RETURN
-
- 91 CALL ABEND
- END
-#ifdef CERNLIB_TCGEN_UCTOH
-#undef CERNLIB_TCGEN_UCTOH
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernalt/altgs/uctoh1.F b/src/packlib/kernlib/kerngen/obsolete/kernalt/altgs/uctoh1.F
deleted file mode 100644
index beed87e..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernalt/altgs/uctoh1.F
+++ /dev/null
@@ -1,53 +0,0 @@
-*
-* $Id: uctoh1.F,v 1.1.1.1 1996/02/15 17:50:55 mclareni Exp $
-*
-* $Log: uctoh1.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:55 mclareni
-* Kernlib
-*
-*
-#include "kernalt/pilot.h"
- SUBROUTINE UCTOH1 (MS,MT,NCHP)
-C
-C CERN PROGLIB# M409 UCTOH1 .VERSION KERNALT 1.00 880212
-C ORIG. 10/02/88 JZ
-C
- DIMENSION MS(99), MT(99), NCHP(9)
- PARAMETER (IBLAN1 = '00202020'X)
- PARAMETER (MASK1 = 'FF000000'X)
-
-
- NCH = NCHP(1)
- IF (NCH) 91, 29, 11
- 11 NWS = ishft (NCH,-2)
- NTRAIL = IAND (NCH,3)
- JT = 0
- IF (NWS.EQ.0) GO TO 26
-
-C-- Unpack the initial complete words
-
- DO 24 JS=1,NWS
- MWD = MS(JS)
- MT(JT+1) = IOR (IBLAN1,IAND(MASK1,MWD))
- MT(JT+2) = IOR (IBLAN1,IAND(MASK1,ISHFT(MWD, 8)))
- MT(JT+3) = IOR (IBLAN1,IAND(MASK1,ISHFT(MWD,16)))
- MT(JT+4) = IOR (IBLAN1, ISHFT(MWD,24) )
- 24 JT = JT + 4
-
- IF (NTRAIL.EQ.0) RETURN
-
-C-- Unpack the trailing word
-
- 26 MWD = MS(NWS+1)
-
- DO 28 JS=1,NTRAIL
- MT(JT+1) = IOR (IBLAN1,IAND(MASK1,MWD))
- MWD = ISHFT (MWD,8)
- 28 JT = JT + 1
- 29 RETURN
-
- 91 CALL ABEND
- END
-#ifdef CERNLIB_TCGEN_UCTOH1
-#undef CERNLIB_TCGEN_UCTOH1
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernalt/altgs/uh1toc.F b/src/packlib/kernlib/kerngen/obsolete/kernalt/altgs/uh1toc.F
deleted file mode 100644
index 03412bf..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernalt/altgs/uh1toc.F
+++ /dev/null
@@ -1,67 +0,0 @@
-*
-* $Id: uh1toc.F,v 1.1.1.1 1996/02/15 17:50:55 mclareni Exp $
-*
-* $Log: uh1toc.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:55 mclareni
-* Kernlib
-*
-*
-#include "kernalt/pilot.h"
- SUBROUTINE UH1TOC (MS,MT,NCHP)
-C
-C CERN PROGLIB# M409 UH1TOC .VERSION KERNALT 1.00 880212
-C ORIG. 10/02/88 JZ
-C
- DIMENSION MS(99), MT(99), NCHP(9)
-
- PARAMETER (MASK1 = 'FF000000'X)
- PARAMETER (MASK2 = 'FFFF0000'X)
- PARAMETER (MASK3 = 'FFFFFF00'X)
-
-
- NCH = NCHP(1)
- IF (NCH) 91, 29, 11
- 11 NWT = ishft (NCH,-2)
- NTRAIL = IAND (NCH,3)
- JS = 0
- IF (NWT.EQ.0) GO TO 26
-
-C-- Pack the initial complete words
-
- DO 24 JT=1,NWT
- MT(JT) = IOR (IOR (IOR (
- + IAND(MASK1,MS(JS+1))
- +, ishft (IAND(MASK1,MS(JS+2)), -8))
- +, ishft (IAND(MASK1,MS(JS+3)),-16))
- +, ishft (MS(JS+4) ,-24))
- 24 JS = JS + 4
-
- IF (NTRAIL.EQ.0) RETURN
-
-C-- Pack the trailing word
-
- 26 GO TO ( 28, 27), NTRAIL
-
- MT(NWT+1) = IOR (IOR (IOR (
- + IAND(MASK1,MS(JS+1))
- +, ishft (IAND(MASK1,MS(JS+2)), -8))
- +, ishft (IAND(MASK1,MS(JS+3)),-16))
- +, IAND (NOT(MASK3),MT(NWT+1)))
- RETURN
-
- 27 MT(NWT+1) = IOR (IOR (
- + IAND(MASK1,MS(JS+1))
- +, ishft (IAND(MASK1,MS(JS+2)), -8))
- +, IAND (NOT(MASK2),MT(NWT+1)))
- RETURN
-
- 28 MT(NWT+1) = IOR (
- + IAND(MASK1,MS(JS+1))
- +, IAND (NOT(MASK1),MT(NWT+1)))
- 29 RETURN
-
- 91 CALL ABEND
- END
-#ifdef CERNLIB_TCGEN_UH1TOC
-#undef CERNLIB_TCGEN_UH1TOC
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernalt/altgs/uhtoc.F b/src/packlib/kernlib/kerngen/obsolete/kernalt/altgs/uhtoc.F
deleted file mode 100644
index 3ec47a2..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernalt/altgs/uhtoc.F
+++ /dev/null
@@ -1,197 +0,0 @@
-*
-* $Id: uhtoc.F,v 1.1.1.1 1996/02/15 17:50:55 mclareni Exp $
-*
-* $Log: uhtoc.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:55 mclareni
-* Kernlib
-*
-*
-#include "kernalt/pilot.h"
- SUBROUTINE UHTOC (MS,NPW,MT,NCHP)
-C
-C CERN PROGLIB# M409 UHTOC .VERSION KERNALT 1.01 880222
-C ORIG. 22/02/88 JZ
-C
- DIMENSION MS(99), MT(99), NCHP(9)
-
- PARAMETER (MASK1 = 'FF000000'X)
- PARAMETER (MASK2 = 'FFFF0000'X)
- PARAMETER (MASK3 = 'FFFFFF00'X)
-
- DIMENSION MASK(3)
- DATA MASK / 'FF000000'X, 'FFFF0000'X, 'FFFFFF00'X /
-
-
- NCH = NCHP(1)
- IF (NCH) 91, 29, 11
- 11 GO TO (21, 31, 41), NPW
-
-C-------- NPW = 4
-
- NWT = ishft (NCH,-2)
- NTRAIL = IAND (NCH,3)
- IF (NWT.EQ.0) GO TO 15
-
- DO 14 J=1,NWT
- 14 MT(J) = MS(J)
- IF (NTRAIL.EQ.0) RETURN
-
- 15 MT(NWT+1) = IOR (IAND (MS(NWT+1), MASK(NTRAIL))
- +, IAND (MT(NWT+1),NOT(MASK(NTRAIL))))
- RETURN
-
-C-------- NPW = 1
-C-- equivalent to 'CALL UH1TOC(MS,MT,NCH)'
-
- 21 NWT = ishft (NCH,-2)
- NTRAIL = IAND (NCH,3)
- JS = 0
- IF (NWT.EQ.0) GO TO 26
-
-C-- Pack the initial complete words
-
- DO 24 JT=1,NWT
- MT(JT) = IOR (IOR (IOR (
- + IAND(MASK1,MS(JS+1))
- +, ishft (IAND(MASK1,MS(JS+2)), -8))
- +, ishft (IAND(MASK1,MS(JS+3)),-16))
- +, ishft (MS(JS+4), -24))
- 24 JS = JS + 4
-
- IF (NTRAIL.EQ.0) RETURN
-
-C-- Pack the trailing word
-
- 26 GO TO ( 28, 27), NTRAIL
-
- MT(NWT+1) = IOR (IOR (IOR (
- + IAND(MASK1,MS(JS+1))
- +, ishft (IAND(MASK1,MS(JS+2)), -8))
- +, ishft (IAND(MASK1,MS(JS+3)),-16))
- +, IAND (NOT(MASK3),MT(NWT+1)))
- RETURN
-
- 27 MT(NWT+1) = IOR (IOR (
- + IAND(MASK1,MS(JS+1))
- +, ishft (IAND(MASK1,MS(JS+2)), -8))
- +, IAND (NOT(MASK2),MT(NWT+1)))
- RETURN
-
- 28 MT(NWT+1) = IOR (
- + IAND(MASK1,MS(JS+1))
- +, IAND (NOT(MASK1),MT(NWT+1)))
- 29 RETURN
-
-C-------- NPW = 2
-
- 31 NWT = ishft (NCH,-2)
- NTRAIL = IAND (NCH,3)
- JS = 0
- IF (NWT.EQ.0) GO TO 36
-
-C-- Pack the initial complete words
-
- DO 34 JT=1,NWT
- MT(JT) = IOR (IAND(MASK2,MS(JS+1))
- +, ishft (MS(JS+2),-16))
- 34 JS = JS + 2
-
- IF (NTRAIL.EQ.0) RETURN
-
-C-- Pack the trailing word
-
- 36 GO TO ( 38, 37), NTRAIL
-
- MT(NWT+1) = IOR (IOR (
- + IAND(MASK2,MS(JS+1))
- +, ishft (IAND(MASK1,MS(JS+2)),-16))
- +, IAND (NOT(MASK3),MT(NWT+1)))
- RETURN
-
- 37 MT(NWT+1) = IOR (
- + IAND(MASK2,MS(JS+1))
- +, IAND (NOT(MASK2),MT(NWT+1)))
- RETURN
-
- 38 MT(NWT+1) = IOR (
- + IAND(MASK1,MS(JS+1))
- +, IAND (NOT(MASK1),MT(NWT+1)))
- RETURN
-
-C-------- NPW = 3
-
- 41 NWT = NCH/12
- NTRAIL = NCH - 12*NWT
- JS = 0
- JT = 0
- IF (NWT.EQ.0) GO TO 46
-
-C-- Pack the initial complete words
-
- DO 44 JL=1,NWT
- MT(JT+1) = IOR ( IAND ( MS(JS+1), MASK3)
- +, ishft (MS(JS+2),-24))
-
- MT(JT+2) = IOR ( IAND (ISHFT(MS(JS+2), 8), MASK2)
- +, ishft (MS(JS+3),-16))
-
- MT(JT+3) = IOR ( IAND (ISHFT(MS(JS+3), 16), MASK1)
- +, ishft (MS(JS+4), -8))
- JS = JS + 4
- 44 JT = JT + 3
-
- IF (NTRAIL.EQ.0) RETURN
-
-C-- Pack the trailing word
-
- 46 IF (NTRAIL.LE.3) THEN
- MT(JT+1) = IOR ( IAND ( MS(JS+1), MASK(NTRAIL))
- +, IAND (MT(JT+1),NOT(MASK(NTRAIL))))
- RETURN
-
- ELSEIF (NTRAIL.LE.6) THEN
- MT(JT+1) = IOR ( IAND ( MS(JS+1), MASK3)
- +, ishft (MS(JS+2), -24))
-
- N = NTRAIL - 4
- IF (N.EQ.0) RETURN
-
- MT(JT+2) = IOR ( IAND (ISHFT(MS(JS+2), 8), MASK(N))
- +, IAND (MT(JT+2),NOT(MASK(N))))
- RETURN
-
- ELSEIF (NTRAIL.LT.9) THEN
- MT(JT+1) = IOR ( IAND ( MS(JS+1), MASK3)
- +, ishft (MS(JS+2), -24))
-
- MWD = IOR ( IAND (ISHFT(MS(JS+2), 8), MASK2)
- +, ishft (MS(JS+3), -16))
- N = NTRAIL - 4
- IF (N.EQ.3) THEN
- MWD = IOR ( IAND(MWD, MASK(N))
- +, IAND(MT(JT+2),NOT(MASK(N))))
- ENDIF
- MT(JT+2) = MWD
- RETURN
-
- ELSE
- MT(JT+1) = IOR ( IAND ( MS(JS+1), MASK3)
- +, ishft (MS(JS+2), -24))
-
- MT(JT+2) = IOR ( IAND (ISHFT(MS(JS+2), 8), MASK2)
- +, ishft (MS(JS+3), -16))
-
- MWD = IOR ( IAND (ISHFT(MS(JS+3), 16), MASK1)
- +, ishft (MS(JS+4), -8))
- N = NTRAIL - 8
- MWD = IOR ( IAND(MWD, MASK(N))
- +, IAND(MT(JT+3),NOT(MASK(N))))
- MT(JT+3) = MWD
- ENDIF
- RETURN
-
- 91 CALL ABEND
- END
-#ifdef CERNLIB_TCGEN_UHTOC
-#undef CERNLIB_TCGEN_UHTOC
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernalt/altgs/vblank.F b/src/packlib/kernlib/kerngen/obsolete/kernalt/altgs/vblank.F
deleted file mode 100644
index 3846f95..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernalt/altgs/vblank.F
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: vblank.F,v 1.1.1.1 1996/02/15 17:50:55 mclareni Exp $
-*
-* $Log: vblank.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:55 mclareni
-* Kernlib
-*
-*
-#include "kernalt/pilot.h"
- SUBROUTINE VBLANK (A,N)
-C
-C CERN PROGLIB# F121 VBLANK .VERSION KERNALT 1.00 880212
-C ORIG. 01/07/71
-C
- INTEGER A(99), BLANK
- PARAMETER (BLANK = '20202020'X)
-
- IF (N.LE.0) RETURN
-
- A(1:N) = BLANK
- RETURN
- END
-#ifdef CERNLIB_TCGEN_VBLANK
-#undef CERNLIB_TCGEN_VBLANK
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernalt/altgs/vfill.F b/src/packlib/kernlib/kerngen/obsolete/kernalt/altgs/vfill.F
deleted file mode 100644
index a1eef9f..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernalt/altgs/vfill.F
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: vfill.F,v 1.1.1.1 1996/02/15 17:50:55 mclareni Exp $
-*
-* $Log: vfill.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:55 mclareni
-* Kernlib
-*
-*
-#include "kernalt/pilot.h"
- SUBROUTINE VFILL (A,N,IVAL)
-C
-C CERN PROGLIB# F121 VFILL .VERSION KERNALT 1.00 880212
-C ORIG. 01/07/71
-C
- INTEGER A(99)
-
- IF (N.LE.0) RETURN
-
- A(1:N) = IVAL
- RETURN
- END
-#ifdef CERNLIB_TCGEN_VFILL
-#undef CERNLIB_TCGEN_VFILL
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernalt/altgs/vzero.F b/src/packlib/kernlib/kerngen/obsolete/kernalt/altgs/vzero.F
deleted file mode 100644
index a33c64d..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernalt/altgs/vzero.F
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: vzero.F,v 1.1.1.1 1996/02/15 17:50:55 mclareni Exp $
-*
-* $Log: vzero.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:55 mclareni
-* Kernlib
-*
-*
-#include "kernalt/pilot.h"
- SUBROUTINE VZERO (IA,N)
-C
-C CERN PROGLIB# F121 VZERO .VERSION KERNALT 1.00 880212
-C ORIG. 01/07/71, modif. 24/05/87 to set integer zero
-C
- DIMENSION IA(9)
-
- IF (N.LE.0) RETURN
-
- IA(1:N) = 0
- RETURN
- END
-#ifdef CERNLIB_TCGEN_VZERO
-#undef CERNLIB_TCGEN_VZERO
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernalt/altgs/xinb.F b/src/packlib/kernlib/kerngen/obsolete/kernalt/altgs/xinb.F
deleted file mode 100644
index 975f583..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernalt/altgs/xinb.F
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: xinb.F,v 1.1.1.1 1996/02/15 17:50:55 mclareni Exp $
-*
-* $Log: xinb.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:55 mclareni
-* Kernlib
-*
-*
-#include "kernalt/pilot.h"
- SUBROUTINE XINB (LUN,XBV,NXB)
-C
-C CERN PROGLIB# Z203 XINB .VERSION KERNALT 1.00 880212
-C ORIG. 8/02/88 JZ
-C
- DIMENSION XBV(99)
-
- READ (LUN,IOSTAT=JSTAT) N, (XBV(J),J=1,MIN(N,NXB))
- IF (JSTAT) 61, 24, 64
- 24 N = MIN (N,NXB)
- NXB = MAX (N,1)
- RETURN
-
- 61 NXB = 0
- RETURN
-
- 64 NXB = -JSTAT
- RETURN
- END
-#ifdef CERNLIB_TCGEN_XINB
-#undef CERNLIB_TCGEN_XINB
-#endif
-#ifdef CERNLIB_XVECT_XINB
-#undef CERNLIB_XVECT_XINB
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernalt/altgs/xinbs.F b/src/packlib/kernlib/kerngen/obsolete/kernalt/altgs/xinbs.F
deleted file mode 100644
index 5761b44..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernalt/altgs/xinbs.F
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: xinbs.F,v 1.1.1.1 1996/02/15 17:50:56 mclareni Exp $
-*
-* $Log: xinbs.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:56 mclareni
-* Kernlib
-*
-*
-#include "kernalt/pilot.h"
- SUBROUTINE XINBS (LUN,XAV,NA,XBV,NXB)
-C
-C CERN PROGLIB# Z203 XINBS .VERSION KERNALT 1.00 880212
-C ORIG. 8/02/88 JZ
-C
- DIMENSION XBV(99), XAV(NA)
-
- READ (LUN,IOSTAT=JSTAT) N,XAV,(XBV(J),J=1,MIN(N,NXB))
- IF (JSTAT) 61, 24, 64
- 24 N = MIN (N,NXB)
- NXB = MAX (N,1)
- RETURN
-
- 61 NXB = 0
- RETURN
-
- 64 NXB = -JSTAT
- RETURN
- END
-#ifdef CERNLIB_TCGEN_XINBS
-#undef CERNLIB_TCGEN_XINBS
-#endif
-#ifdef CERNLIB_XVECT_XINBS
-#undef CERNLIB_XVECT_XINBS
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernalt/altprogs/Imakefile b/src/packlib/kernlib/kerngen/obsolete/kernalt/altprogs/Imakefile
deleted file mode 100644
index 9603826..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernalt/altprogs/Imakefile
+++ /dev/null
@@ -1,4 +0,0 @@
-SRCS_F= \ @@\
- fcasplit.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernalt/altprogs/fcasplit.F b/src/packlib/kernlib/kerngen/obsolete/kernalt/altprogs/fcasplit.F
deleted file mode 100644
index 1cc97d8..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernalt/altprogs/fcasplit.F
+++ /dev/null
@@ -1,15 +0,0 @@
-*
-* $Id: fcasplit.F,v 1.1.1.1 1996/02/15 17:50:55 mclareni Exp $
-*
-* $Log: fcasplit.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:55 mclareni
-* Kernlib
-*
-*
-#include "kernalt/pilot.h"
-#ifndef CERNLIB_QMALT
-#define CERNLIB_QMALT
-#endif
-#ifndef CERNLIB_UTYGEN_FCASPLIT
-#define CERNLIB_UTYGEN_FCASPLIT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernalt/altsys/Imakefile b/src/packlib/kernlib/kerngen/obsolete/kernalt/altsys/Imakefile
deleted file mode 100644
index 042e0aa..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernalt/altsys/Imakefile
+++ /dev/null
@@ -1,10 +0,0 @@
-SRCS_F= \ @@\
- datime.F datimh.F intrac.F timed.F timex.F
-
-SRCS_C= \ @@\
- signalf.c
-
-SRCS_S= \ @@\
- jumpxn.s qnexte.s
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernalt/altsys/datime.F b/src/packlib/kernlib/kerngen/obsolete/kernalt/altsys/datime.F
deleted file mode 100644
index 7fdb914..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernalt/altsys/datime.F
+++ /dev/null
@@ -1,42 +0,0 @@
-*
-* $Id: datime.F,v 1.1.1.1 1996/02/15 17:50:56 mclareni Exp $
-*
-* $Log: datime.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:56 mclareni
-* Kernlib
-*
-*
-#include "kernalt/pilot.h"
- SUBROUTINE DATIME (ND,NT)
-C
-C CERN PROGLIB# Z007 DATIME .VERSION KERNALT 1.07 890913
-C ORIG. 15/02/88 JZ
-C MOD. 11/09/89 add /SLATE/, JZ
-C
-C- CALL DATIME (ND,NT) RETURNS INTEGER DATE ND = YYMMDD
-C- INTEGER TIME NT = HHMM
-C- returns also ISL (1) y (2) m (3) d (4) h (5) m (6) s
-C
- COMMON /SLATE/ ISL(30), MM(10)
-
-
- CALL IDATE (MM)
- CALL ITIME (MM(4))
-
- DO 24 J=1,6
- 24 ISL(J) = MM(J)
- ISL(1) = MM(3)
- ISL(3) = MM(1)
-
- MM(3) = MOD (MM(3),100)
-
- ND = (MM(3)*100+MM(2))*100 + MM(1)
- NT = MM(4) *100 + MM(5)
- RETURN
- END
-#ifdef CERNLIB_CCGEN_DATIME
-#undef CERNLIB_CCGEN_DATIME
-#endif
-#ifdef CERNLIB_TCGEN_DATIME
-#undef CERNLIB_TCGEN_DATIME
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernalt/altsys/datimh.F b/src/packlib/kernlib/kerngen/obsolete/kernalt/altsys/datimh.F
deleted file mode 100644
index a193e3c..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernalt/altsys/datimh.F
+++ /dev/null
@@ -1,50 +0,0 @@
-*
-* $Id: datimh.F,v 1.1.1.1 1996/02/15 17:50:56 mclareni Exp $
-*
-* $Log: datimh.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:56 mclareni
-* Kernlib
-*
-*
-#include "kernalt/pilot.h"
- SUBROUTINE DATIMH (ND,NT)
-C
-C CERN PROGLIB# Z007 DATIMH .VERSION KERNALT 1.00 880212
-C ORIG. 15/02/88 JZ
-C
-
-C- CALL DATIMH (ND,NT) RETURNS HOLLERITH DATE ND = DD/MM/YY
-C- HOLLERITH TIME NT = HH.MM.SS
-
- COMMON /SLATE/ ISAFE(10), M(24), MM(6)
-
- DIMENSION ND(2), NT(2)
-
-
- CALL UBLOW (16H0 /0 /000 .0 .00, M, 16)
-
-C- D D / M M / Y Y H H . M M . S S
-C- 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6
-
- CALL IDATE (MM)
- CALL ITIME (MM(4))
-
- MM(3) = MOD (MM(3),100)
-
- CALL USET (MM(3), M, 7, 8)
- CALL USET (MM(2), M, 4, 5)
- CALL USET (MM(1), M, 1, 2)
- CALL USET (MM(4), M, 9,10)
- CALL USET (MM(5), M,12,13)
- CALL USET (MM(6), M,15,16)
-
- CALL UBUNCH (M(1),ND,8)
- CALL UBUNCH (M(9),NT,8)
- RETURN
- END
-#ifdef CERNLIB_CCGEN_DATIMH
-#undef CERNLIB_CCGEN_DATIMH
-#endif
-#ifdef CERNLIB_TCGEN_DATIMH
-#undef CERNLIB_TCGEN_DATIMH
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernalt/altsys/intrac.F b/src/packlib/kernlib/kerngen/obsolete/kernalt/altsys/intrac.F
deleted file mode 100644
index cceb2d2..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernalt/altsys/intrac.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: intrac.F,v 1.1.1.1 1996/02/15 17:50:56 mclareni Exp $
-*
-* $Log: intrac.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:56 mclareni
-* Kernlib
-*
-*
-#include "kernalt/pilot.h"
- LOGICAL FUNCTION INTRAC(DUMMY)
-C
-C CERN PROGLIB# Z044 INTRAC .VERSION KERNALT 1.01 880222
-C ORIG. 22/02/88 JZ
-C
-C- The program is considered interactive if standard input
-C- is connected to the terminal
-
- LOGICAL ISATTY
-
- INTRAC = ISATTY (5)
- RETURN
- END
-#ifdef CERNLIB_CCGEN_INTRAC
-#undef CERNLIB_CCGEN_INTRAC
-#endif
-#ifdef CERNLIB_TCGEN_INTRAC
-#undef CERNLIB_TCGEN_INTRAC
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernalt/altsys/jumpxn.s b/src/packlib/kernlib/kerngen/obsolete/kernalt/altsys/jumpxn.s
deleted file mode 100644
index 1e8ee56..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernalt/altsys/jumpxn.s
+++ /dev/null
@@ -1,44 +0,0 @@
-*
-* $Id: jumpxn.s,v 1.1.1.1 1996/02/15 17:50:56 mclareni Exp $
-*
-* $Log: jumpxn.s,v $
-* Revision 1.1.1.1 1996/02/15 17:50:56 mclareni
-* Kernlib
-*
-*
-|--> IDENT: jumpxn
-| CERN PROGLIB# Z042 JUMPXN .VERSION KERNALT 1.08 891207
-| ORIG. 28/06/88 JZ
-| MOD. 12/09/89 JZ, add entries JUMPX1, JUMPX0
-
- .text
- .globl _jumpxn_, _jumpx1_, _jumpx2_
- | CALL JUMPXN (PAR1,PAR2,...) transfer
-_jumpxn_:
-_jumpx0_:
-_jumpx1_:
-_jumpx2_:
- movl jxq.jpoint, a1 | a1 = jump address
- jmp a1@ | jump
-
- .globl _jumpst_
- | CALL JUMPST (JTRANS) set transfer address
-_jumpst_:
- movl a0@, a1 | a1 = adr(JTRANS)
- movl a1@, jxq.jpoint | jpoint = JTRANS
- rts
-
- .globl _jumpad_
- | JTRANS = JUMPAD (TARGET) get transfer address
-_jumpad_:
- movl a0@, d0 | value = adr(TARGET)
- rts
-
- .data
-jxq.jpoint: .long 0
-#ifdef CERNLIB_CCGEN_JUMPXN
-#undef CERNLIB_CCGEN_JUMPXN
-#endif
-#ifdef CERNLIB_TCGEN_JUMPXN
-#undef CERNLIB_TCGEN_JUMPXN
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernalt/altsys/qnexte.s b/src/packlib/kernlib/kerngen/obsolete/kernalt/altsys/qnexte.s
deleted file mode 100644
index d1145f2..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernalt/altsys/qnexte.s
+++ /dev/null
@@ -1,47 +0,0 @@
-*
-* $Id: qnexte.s,v 1.1.1.1 1996/02/15 17:50:56 mclareni Exp $
-*
-* $Log: qnexte.s,v $
-* Revision 1.1.1.1 1996/02/15 17:50:56 mclareni
-* Kernlib
-*
-*
-|--> IDENT: qnexte
-| CERN PROGLIB# Z041 QNEXTE .VERSION KERNALT 1.03 880701
-| ORIG. 28/06/88 JZ
-
- .text
- .globl _qnexte_
- .globl _qnext_
-_qnexte_:
- tstl qn.jpoint | test original stack-pointer set
- bne qn.reent
-
- | First entry
- link a6,#-8
- movl a6,qn.jpoint | save stack pointer on first entry
- bra qn.godown
-
- | Re-entry
-qn.reent:
- movl qn.jpoint,a6 | get original stack pointer
-
-qn.godown:
- unlk a6
- lea _qnext_,a1
- movl #0, a0
-
- link a6, #-8
- movl a0, a6@(-4)
- jsr _qnext_
- unlk a6
- rts
-
- .data
-qn.jpoint: .long 0
-#ifdef CERNLIB_CCGEN_QNEXTE
-#undef CERNLIB_CCGEN_QNEXTE
-#endif
-#ifdef CERNLIB_TCGEN_QNEXTE
-#undef CERNLIB_TCGEN_QNEXTE
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernalt/altsys/signalf.c b/src/packlib/kernlib/kerngen/obsolete/kernalt/altsys/signalf.c
deleted file mode 100644
index 7812ee4..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernalt/altsys/signalf.c
+++ /dev/null
@@ -1,48 +0,0 @@
-/*
- * $Id: signalf.c,v 1.1.1.1 1996/02/15 17:50:56 mclareni Exp $
- *
- * $Log: signalf.c,v $
- * Revision 1.1.1.1 1996/02/15 17:50:56 mclareni
- * Kernlib
- *
- */
-#include "kernalt/pilot.h"
-/*> ROUTINE SIGNALF
- CERN PROGLIB# SIGNALF .VERSION KERNSGI 1.04 930120
- ORIG. 24/05/93, JZ
- FORTRAN interface routine to sigvec */
-#include <signal.h>
-
-int signalf_(signum,funct,flag)
- int *signum, *flag;
- int (*funct)();
-{
- int istat, signo;
-
- struct sigvec newbuf;
- struct sigvec oldbuf;
-
- signo = *signum;
-
- if (*flag < 0) newbuf.sv_handler = funct;
- else if (*flag == 0) newbuf.sv_handler = SIG_DFL;
- else if (*flag == 1) newbuf.sv_handler = SIG_IGN;
- else newbuf.sv_handler = (int (*)())*flag;
-
- newbuf.sv_flags = 0;
- newbuf.sv_mask = 0;
-
- istat = sigvec(signo,&newbuf,&oldbuf);
- if (istat == 0) return (int)oldbuf.sv_handler;
- return -1;
-}
-/*> END <----------------------------------------------------------*/
-#ifdef CERNLIB_CCGEN_SIGNALF
-#undef CERNLIB_CCGEN_SIGNALF
-#endif
-#ifdef CERNLIB_CCGEN_SIGBSD
-#undef CERNLIB_CCGEN_SIGBSD
-#endif
-#ifdef CERNLIB_CCGEN_SIGPOSIX
-#undef CERNLIB_CCGEN_SIGPOSIX
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernalt/altsys/timed.F b/src/packlib/kernlib/kerngen/obsolete/kernalt/altsys/timed.F
deleted file mode 100644
index 1607335..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernalt/altsys/timed.F
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: timed.F,v 1.1.1.1 1996/02/15 17:50:56 mclareni Exp $
-*
-* $Log: timed.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:56 mclareni
-* Kernlib
-*
-*
-#include "kernalt/pilot.h"
- SUBROUTINE TIMED (T)
-C
-C CERN PROGLIB# Z007 TIMED .VERSION KERNALT 1.01 880222
-C ORIG. 22/02/88, JZ
-C
- DIMENSION TT(2), TCALL(2), ITCALL(2)
- EQUIVALENCE (ITCALL,TCALL)
- SAVE TCALL
- DATA ITCALL / 0, 0 /
-
- TOT = DTIME (TT)
- IF (ITCALL(1).NE.0) THEN
- T = TT(1) - TCALL(1)
- RETURN
- ENDIF
-
- TOT = DTIME (TCALL)
- RETURN
- END
-#ifdef CERNLIB_CCGEN_TIMEL
-#undef CERNLIB_CCGEN_TIMEL
-#endif
-#ifdef CERNLIB_TCGEN_TIMED
-#undef CERNLIB_TCGEN_TIMED
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernalt/altsys/timex.F b/src/packlib/kernlib/kerngen/obsolete/kernalt/altsys/timex.F
deleted file mode 100644
index 85c7b71..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernalt/altsys/timex.F
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: timex.F,v 1.1.1.1 1996/02/15 17:50:56 mclareni Exp $
-*
-* $Log: timex.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:56 mclareni
-* Kernlib
-*
-*
-#include "kernalt/pilot.h"
- SUBROUTINE TIMEX (T)
-C
-C CERN PROGLIB# Z007 TIMEX .VERSION KERNALT 1.00 880212
-C ORIG. 15/02/88, JZ
-C
-
- DIMENSION TT(2)
-
- TOT = ETIME (TT)
- T = TT(1)
- RETURN
- END
-#ifdef CERNLIB_CCGEN_TIMEL
-#undef CERNLIB_CCGEN_TIMEL
-#endif
-#ifdef CERNLIB_TCGEN_TIMEX
-#undef CERNLIB_TCGEN_TIMEX
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernalt/history/history.dat b/src/packlib/kernlib/kerngen/obsolete/kernalt/history/history.dat
deleted file mode 100644
index da6ba1f..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernalt/history/history.dat
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: history.dat,v 1.1.1.1 1996/02/15 17:50:57 mclareni Exp $
-*
-* $Log: history.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:50:57 mclareni
-* Kernlib
-*
-*
-* This directory was created from kernalt.car patch kernalt
-#if !defined(CERNLIB_KERNALT)
-
- KERNLIB routines particular to Alliant
-
----------------------------------------------------------------------
-
- This file contains the following patches :
-
-*KALT Pilot-patch selecting the full standard general KERNLIB
- for the Alliant
-
-QMALT ALT machine patch
-
-ALTGS ALT versions of general KERNLIB rotuines
-
-ALTSYS ALT versions of KERNLIB system routine interfaces
-
-=====================================================================
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernalt/history/previous.dat b/src/packlib/kernlib/kerngen/obsolete/kernalt/history/previous.dat
deleted file mode 100644
index 59e7a18..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernalt/history/previous.dat
+++ /dev/null
@@ -1,138 +0,0 @@
-*
-* $Id: previous.dat,v 1.1.1.1 1996/02/15 17:50:57 mclareni Exp $
-*
-* $Log: previous.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:50:57 mclareni
-* Kernlib
-*
-*
-
-Up-date 1.11 : 3-June-1992
-----------------------------
-
-Replacing file KERNALT 1.10 910225 15.28
-
-New decks : LENOCC fast LNBLNK for many trailing blanks
-
----------------------------------------------------------------------
-
-Up-date 1.10 : 25-Feb-1991
-----------------------------
-
-Replacing file KERNALT 1.09 900724 15.35
-
-Correct : connect CCGEN of KERNFOR
-
----------------------------------------------------------------------
-
-Up-date 1.09 : 24-July-1990
-----------------------------
-
-Replacing file KERNALT 1.08 891207 22.21
-
-Deleted : P=ALTPROGS, D=ASPLIT, FPREP
-
----------------------------------------------------------------------
-
-Up-date 1.08 : 7-Dec-1989
-----------------------------
-
-Replacing file KERNALT 1.07 890913 21.04
-
-New decks : LOCB return the byte adr of a variable
-
-Corrections: JUMPXN name changed fromy JUMPXQ
-
-Deleted : routines which are now available from KERNFOR :
- CBYT, JBIT, JBYTxx, MBYTxx, MCBYT, MSBxxx,
- SBITx, SBYTxx
- PKBYT, UPKBYT, RNDM, ABEND
- INCBYT, IUFORW, LOCBYT
- FLOARG, INTARG, IUMODE, UFLINT
- UBLOW, UBUNCH, JOBNAM, TRACEQ
-
----------------------------------------------------------------------
-
-Up-date 1.07 : 13-Sept-1989
-----------------------------
-
-Replacing file KERNALT 1.06 890626 19.26
-
-Corrections: DATIME to return /SLATE/
- JUMPXQ add entry JUMPX0
-
----------------------------------------------------------------------
-
-Up-date 1.06 : 26-June-1989
-----------------------------
-
-Replacing file KERNALT 1.05 881021 10.23
-
-New decks : KERNGT to replace GSHOW eventually
-
-Corrections: FCASPLIT new version
-
----------------------------------------------------------------------
-
-Up-date 1.05 : 21-oct-1988
-----------------------------
-
-Replacing file KERNALT 1.04 880715 15.08
-
-New decks : P=ALTPROGS, D=FCASPLIT
-
-Correct : P=ALTPROGS, D=FPREP fix bug 'C END'
- P=ALTGS, D=RNDM correct multiplier 69069
- make sure that all right-shifting ISHFT are in lower case
-
----------------------------------------------------------------------
-
-Up-date 1.04 : 13-jul-1988
-----------------------------
-
-Replacing file KERNALT 1.03 880701 11.32
-
-Correct : RNDM avoid exact zero result
-Delete : NOARG dummy is now on KERNFOR
-
----------------------------------------------------------------------
-
-Up-date 1.03 : 30-jun-1988
-----------------------------
-
-Replacing file KERNALT 1.02 880323 15.11
-
-New decks : P=ALTGS, D=LOCF assembler version
- P=ALTSYS, D=JUMPXQ, QNEXTE
-
-New Patch : P=ALTPROGS utility programs
-
----------------------------------------------------------------------
-
-Up-date 1.02 : 23-mar-1988
-----------------------------
-
-Replacing file KERNALT 1.01 880223 9.37
-
-New decks : P=ALTGS, D=RNDM with entries IRNDM etc
-
-Deleted : P=ALTSYS, D=IRNDM, RNDM
-
----------------------------------------------------------------------
-
-Up-date 1.01 : 22-feb-1988
-----------------------------
-
-Replacing file KERNALT 1.00 880217 12.00
-
-New decks : P=ALTGS, D=FLOARG, INCBYT, INTARG, LOCBYT, UFLINT
-
-Modifs : P=ALTGS, D=LOCF, UCOPY2, UHTOC
- P=ALTSYS, D=INTRAC, IRNDM, RNDM, TIMED
-
----------------------------------------------------------------------
-
- First release of the KERNALT Pam : 17-FEB-1988
-
----------------------------------------------------------------------
-
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernalt/history/update.dat b/src/packlib/kernlib/kerngen/obsolete/kernalt/history/update.dat
deleted file mode 100644
index a35fddd..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernalt/history/update.dat
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: update.dat,v 1.1.1.1 1996/02/15 17:50:57 mclareni Exp $
-*
-* $Log: update.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:50:57 mclareni
-* Kernlib
-*
-*
-
-
- Up-date record for the Pam-file KERNALT
- ----------------------------------------
-
-
-Up-date 1.12 : 3-June-1993
-----------------------------
-
-Replacing file KERNALT 1.11 920603 11.59
-
-New decks : SIGNALF sigvec is slightly different on Alliant
-
----------------------------------------------------------------------
-
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernalt/inhibit.list b/src/packlib/kernlib/kerngen/obsolete/kernalt/inhibit.list
deleted file mode 100644
index 9252607..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernalt/inhibit.list
+++ /dev/null
@@ -1,42 +0,0 @@
-tcgen/lnblnk
-tcgen/kerngt
-tcgen/gshow
-tcgen/lenocc
-ccgen/locb
-tcgen/locb
-ccgen/locf
-tcgen/locf
-altgs/locff
-ccgen/locf
-tcgen/locf
-tcgen/ucopy
-tcgen/ucopy2
-tcgen/ucopyn
-tcgen/uctoh1
-tcgen/uctoh
-tcgen/uh1toc
-tcgen/uhtoc
-tcgen/vblank
-tcgen/vfill
-tcgen/vzero
-tcgen/xinb
-xvect/xinb
-tcgen/xinbs
-xvect/xinbs
-ccgen/datime
-tcgen/datime
-ccgen/datimh
-tcgen/datimh
-ccgen/intrac
-tcgen/intrac
-ccgen/jumpxn
-tcgen/jumpxn
-ccgen/qnexte
-tcgen/qnexte
-ccgen/signalf
-ccgen/sigbsd
-ccgen/sigposix
-ccgen/timel
-tcgen/timed
-ccgen/timel
-tcgen/timex
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernalt/kernalt/pilot.h b/src/packlib/kernlib/kerngen/obsolete/kernalt/kernalt/pilot.h
deleted file mode 100644
index 9fd944e..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernalt/kernalt/pilot.h
+++ /dev/null
@@ -1,46 +0,0 @@
-#if 0
-* This pilot patch was created from kernalt.car patch _kalt
-* This directory was created from kernalt.car patch qmalt
-#endif
-#ifndef CERNLIB_F77
-#define CERNLIB_F77
-#endif
-#ifndef CERNLIB_A4
-#define CERNLIB_A4
-#endif
-#ifndef CERNLIB_B32
-#define CERNLIB_B32
-#endif
-#ifndef CERNLIB_HEX
-#define CERNLIB_HEX
-#endif
-#ifndef CERNLIB_QISASTD
-#define CERNLIB_QISASTD
-#endif
-#ifndef CERNLIB_QMILSTD
-#define CERNLIB_QMILSTD
-#endif
-#ifndef CERNLIB_ALTPROGS
-#define CERNLIB_ALTPROGS
-#endif
-#ifndef CERNLIB_ALTGS
-#define CERNLIB_ALTGS
-#endif
-#ifndef CERNLIB_ALTSYS
-#define CERNLIB_ALTSYS
-#endif
-#ifndef CERNLIB_XVECT
-#define CERNLIB_XVECT
-#endif
-#ifndef CERNLIB_TCGEN
-#define CERNLIB_TCGEN
-#endif
-#ifdef CERNLIB_TCGEN_LNBLNK
-#undef CERNLIB_TCGEN_LNBLNK
-#endif
-#ifndef CERNLIB_CCGEN
-#define CERNLIB_CCGEN
-#endif
-#ifndef CERNLIB_CCGENCF
-#define CERNLIB_CCGENCF
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernalt/kernalt/q_andor.inc b/src/packlib/kernlib/kerngen/obsolete/kernalt/kernalt/q_andor.inc
deleted file mode 100644
index 79dc477..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernalt/kernalt/q_andor.inc
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: q_andor.inc,v 1.1.1.1 1996/02/15 17:50:54 mclareni Exp $
-*
-* $Log: q_andor.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:50:54 mclareni
-* Kernlib
-*
-*
-#ifndef CERNLIB_KERNALT_Q_ANDOR_INC
-#define CERNLIB_KERNALT_Q_ANDOR_INC
-*
-*
-* q_andor.inc
-*
-* IAND / IOR / IEOR / NOT are standard on ALT
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernalt/kernalt/q_cbyt.inc b/src/packlib/kernlib/kerngen/obsolete/kernalt/kernalt/q_cbyt.inc
deleted file mode 100644
index 71703a8..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernalt/kernalt/q_cbyt.inc
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: q_cbyt.inc,v 1.1.1.1 1996/02/15 17:50:54 mclareni Exp $
-*
-* $Log: q_cbyt.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:50:54 mclareni
-* Kernlib
-*
-*
-#ifndef CERNLIB_KERNALT_Q_CBYT_INC
-#define CERNLIB_KERNALT_Q_CBYT_INC
-*
-*
-* q_cbyt.inc
-*
- MCBYT (MZ,IZQ,IZW,IZP,NZB) = IOR ( IAND (IZW, NOT(
- + ISHFT (ishft(NOT(0),-32+NZB), IZP-1)))
- + , ishft (ISHFT(ishft(MZ,-IZQ+1),32-NZB), -33+IZP+NZB) )
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernalt/kernalt/q_jbit.inc b/src/packlib/kernlib/kerngen/obsolete/kernalt/kernalt/q_jbit.inc
deleted file mode 100644
index b323d82..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernalt/kernalt/q_jbit.inc
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: q_jbit.inc,v 1.1.1.1 1996/02/15 17:50:54 mclareni Exp $
-*
-* $Log: q_jbit.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:50:54 mclareni
-* Kernlib
-*
-*
-#ifndef CERNLIB_KERNALT_Q_JBIT_INC
-#define CERNLIB_KERNALT_Q_JBIT_INC
-*
-*
-* q_jbit.inc
-*
- JBIT (IZW,IZP) = IBITS (IZW,IZP-1,1)
- JBYT (IZW,IZP,NZB) = IBITS (IZW,IZP-1,NZB)
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernalt/kernalt/q_jbytet.inc b/src/packlib/kernlib/kerngen/obsolete/kernalt/kernalt/q_jbytet.inc
deleted file mode 100644
index baf6bf4..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernalt/kernalt/q_jbytet.inc
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: q_jbytet.inc,v 1.1.1.1 1996/02/15 17:50:54 mclareni Exp $
-*
-* $Log: q_jbytet.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:50:54 mclareni
-* Kernlib
-*
-*
-#ifndef CERNLIB_KERNALT_Q_JBYTET_INC
-#define CERNLIB_KERNALT_Q_JBYTET_INC
-*
-*
-* q_jbytet.inc
-*
- JBYTET (MZ,IZW,IZP,NZB) = IAND (MZ, IBITS(IZW,IZP-1,NZB))
- JBYTOR (MZ,IZW,IZP,NZB) = IOR (MZ, IBITS(IZW,IZP-1,NZB))
- MBYTET (MZ,IZW,IZP,NZB) = IAND (IZW, NOT(ishft (
- + ISHFT(NOT(MZ),32-NZB),-33+IZP+NZB)) )
- MBYTOR (MZ,IZW,IZP,NZB) = IOR (IZW, ishft (
- + ISHFT(MZ,32-NZB),-33+IZP+NZB) )
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernalt/kernalt/q_sbit.inc b/src/packlib/kernlib/kerngen/obsolete/kernalt/kernalt/q_sbit.inc
deleted file mode 100644
index 3c36be2..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernalt/kernalt/q_sbit.inc
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: q_sbit.inc,v 1.1.1.1 1996/02/15 17:50:54 mclareni Exp $
-*
-* $Log: q_sbit.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:50:54 mclareni
-* Kernlib
-*
-*
-#ifndef CERNLIB_KERNALT_Q_SBIT_INC
-#define CERNLIB_KERNALT_Q_SBIT_INC
-*
-*
-* q_sbit.inc
-*
- MSBIT0 (IZW,IZP) = IAND (IZW, NOT(ISHFT(1,IZP-1)) )
- MSBIT1 (IZW,IZP) = IOR (IZW, ISHFT(1,IZP-1) )
- MSBIT (MZ,IZW,IZP) = IOR (IAND (IZW, NOT(ISHFT(1,IZP-1)) )
- + , ISHFT(IAND(MZ,1),IZP-1))
- MSBYT (MZ,IZW,IZP,NZB) = IOR ( IAND (IZW, NOT(
- + ISHFT (ishft(NOT(0),-32+NZB), IZP-1)))
- + , ishft (ISHFT(MZ, 32-NZB), -33+IZP+NZB) )
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernalt/kernalt/q_shift.inc b/src/packlib/kernlib/kerngen/obsolete/kernalt/kernalt/q_shift.inc
deleted file mode 100644
index ab42b8e..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernalt/kernalt/q_shift.inc
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: q_shift.inc,v 1.1.1.1 1996/02/15 17:50:54 mclareni Exp $
-*
-* $Log: q_shift.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:50:54 mclareni
-* Kernlib
-*
-*
-#ifndef CERNLIB_KERNALT_Q_SHIFT_INC
-#define CERNLIB_KERNALT_Q_SHIFT_INC
-*
-*
-* q_shift.inc
-*
- ISHFTL (IZW,NZB) = ISHFT (IZW, NZB)
- ISHFTR (IZW,NZB) = ishft (IZW, -NZB)
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernalt/kernalt/qcardl.inc b/src/packlib/kernlib/kerngen/obsolete/kernalt/kernalt/qcardl.inc
deleted file mode 100644
index 8f7e52d..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernalt/kernalt/qcardl.inc
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: qcardl.inc,v 1.1.1.1 1996/02/15 17:50:54 mclareni Exp $
-*
-* $Log: qcardl.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:50:54 mclareni
-* Kernlib
-*
-*
-#ifndef CERNLIB_KERNALT_QCARDL_INC
-#define CERNLIB_KERNALT_QCARDL_INC
-*
-*
-* qcardl.inc
-*
-#if 0
-C====================================================================
-#endif
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernamx/amxgs/Imakefile b/src/packlib/kernlib/kerngen/obsolete/kernamx/amxgs/Imakefile
deleted file mode 100644
index ad5de07..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernamx/amxgs/Imakefile
+++ /dev/null
@@ -1,7 +0,0 @@
-SRCS_F= \ @@\
- intrac.F kerngt.F ublow.F
-
-SRCS_C= \ @@\
- signalf.c
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernamx/amxgs/intrac.F b/src/packlib/kernlib/kerngen/obsolete/kernamx/amxgs/intrac.F
deleted file mode 100644
index af8470b..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernamx/amxgs/intrac.F
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: intrac.F,v 1.1.1.1 1996/02/15 17:50:58 mclareni Exp $
-*
-* $Log: intrac.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:58 mclareni
-* Kernlib
-*
-*
-#include "kernamx/pilot.h"
- LOGICAL FUNCTION INTRAC()
-C
-C CERN PROGLIB# Z044 INTRAC .VERSION KERNAMX 1.00 910718
-C ORIG. March 90, Roger Howard, Vancouver
-C
-C Return .TRUE. if job is interactive, .FALSE. otherwise.
-C On AIX (unix) check whether standard input is a terminal.
-C
- INTEGER SYSTEM
- INTRAC = SYSTEM('tty -s').EQ.0
- RETURN
- END
-#ifdef CERNLIB_TCGEN_INTRAC
-#undef CERNLIB_TCGEN_INTRAC
-#endif
-#ifdef CERNLIB_CCGEN_INTRAC
-#undef CERNLIB_CCGEN_INTRAC
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernamx/amxgs/kerngt.F b/src/packlib/kernlib/kerngen/obsolete/kernamx/amxgs/kerngt.F
deleted file mode 100644
index d5df0bd..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernamx/amxgs/kerngt.F
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: kerngt.F,v 1.1.1.1 1996/02/15 17:50:58 mclareni Exp $
-*
-* $Log: kerngt.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:58 mclareni
-* Kernlib
-*
-*
-#include "kernamx/pilot.h"
- SUBROUTINE KERNGT (LUN)
-C
-C CERN PROGLIB# Z001 GSHOW .VERSION KERNAMX 1.00 910718
-C ORIG. 12/12/83 JZ
-C
-C-- Store Pam title into /SLATE/ for printing by GSHOWF
-C
- COMMON /SLATE/ MCH(40)
-
- CALL UCTOH1 (
- + CPP_TITLE_CH
- + // ' '
- +, MCH,40)
- CALL GSHOWF (LUN)
- RETURN
- END
-#ifdef CERNLIB_TCGEN_KERNGT
-#undef CERNLIB_TCGEN_KERNGT
-#endif
-#include "kernamx/TITLE.kernamx"
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernamx/amxgs/signalf.c b/src/packlib/kernlib/kerngen/obsolete/kernamx/amxgs/signalf.c
deleted file mode 100644
index 035ed3a..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernamx/amxgs/signalf.c
+++ /dev/null
@@ -1,50 +0,0 @@
-/*
- * $Id: signalf.c,v 1.1.1.1 1996/02/15 17:50:58 mclareni Exp $
- *
- * $Log: signalf.c,v $
- * Revision 1.1.1.1 1996/02/15 17:50:58 mclareni
- * Kernlib
- *
- */
-#include "kernamx/pilot.h"
-/*> ROUTINE SIGNALF
- CERN PROGLIB# SIGNALF .VERSION KERNAMX 1.00 910718
- ORIG. 12/03/91, JZ
- FORTRAN interface routine to sigaction */
-#include <stdio.h>
-#include <signal.h>
-#include <errno.h>
-int signalf_(signum,funct,flag)
- long *signum, *flag;
- long *funct;
-{
- int sigaction();
- int istat, signo;
-
- struct mysig {
- int sa_handler;
- sigset_t sa_mask;
- int sa_flags;
- };
-
- struct mysig newbuf;
- struct mysig oldbuf;
-
- signo = *signum;
-
- if (*flag < 0) newbuf.sa_handler = funct;
- else if (*flag == 0) newbuf.sa_handler = SIG_DFL;
- else if (*flag == 1) newbuf.sa_handler = SIG_IGN;
- else newbuf.sa_handler = *flag;
-
- newbuf.sa_flags = 0;
- sigemptyset(&newbuf.sa_mask);
-
- istat = sigaction(signo,&newbuf,&oldbuf);
- if (istat == 0) return oldbuf.sa_handler;
- return -errno;
-}
-/*> END <----------------------------------------------------------*/
-#ifdef CERNLIB_CCGEN_SIGNALF
-#undef CERNLIB_CCGEN_SIGNALF
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernamx/amxgs/ublow.F b/src/packlib/kernlib/kerngen/obsolete/kernamx/amxgs/ublow.F
deleted file mode 100644
index a8a7bfb..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernamx/amxgs/ublow.F
+++ /dev/null
@@ -1,59 +0,0 @@
-*
-* $Id: ublow.F,v 1.1.1.1 1996/02/15 17:50:58 mclareni Exp $
-*
-* $Log: ublow.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:58 mclareni
-* Kernlib
-*
-*
-#include "kernamx/pilot.h"
-CDECK ID>, UBLOW.
- SUBROUTINE UBLOW (MS,MT,NCHP)
-C
-C CERN PROGLIB# M409 UBLOW .VERSION KERNAMX 1.00 910718
-C ORIG. 05/12/89, FCA+JZ
-C
-
- DIMENSION MS(99), MT(99), NCHP(9)
-C- - PARAMETER (IALLBL = X'20202020')
- PARAMETER (IALLBL = 538976288 )
-C- - PARAMETER (MASK1 = X'FF000000')
- PARAMETER (MASK1 = -16777216 )
-CAMX PARAMETER (IBLAN1 = ISHFT (IALLBL,-8))
- PARAMETER (IBLAN1 = 2105376 )
-
-
- NCH = NCHP(1)
- IF (NCH) 91, 29, 11
- 11 NWS = ISHFT (NCH,-2)
- NTRAIL = IAND (NCH,3)
- JT = 0
- IF (NWS.EQ.0) GO TO 26
-
-C-- Unpack the initial complete words
-
- DO 24 JS=1,NWS
- MWD = MS(JS)
- MT(JT+1) = IOR (IBLAN1,IAND(MASK1,MWD))
- MT(JT+2) = IOR (IBLAN1,IAND(MASK1,ISHFT(MWD, 8)))
- MT(JT+3) = IOR (IBLAN1,IAND(MASK1,ISHFT(MWD,16)))
- MT(JT+4) = IOR (IBLAN1, ISHFT(MWD,24) )
- 24 JT = JT + 4
-
- IF (NTRAIL.EQ.0) RETURN
-
-C-- Unpack the trailing word
-
- 26 MWD = MS(NWS+1)
-
- DO 28 JS=1,NTRAIL
- MT(JT+1) = IOR (IBLAN1,IAND(MASK1,MWD))
- MWD = ISHFT (MWD,8)
- 28 JT = JT + 1
- 29 RETURN
-
- 91 CALL ABEND
- END
-#ifdef CERNLIB_TCGEN_UBLOW
-#undef CERNLIB_TCGEN_UBLOW
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernamx/history/history.dat b/src/packlib/kernlib/kerngen/obsolete/kernamx/history/history.dat
deleted file mode 100644
index b70e1ce..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernamx/history/history.dat
+++ /dev/null
@@ -1,37 +0,0 @@
-*
-* $Id: history.dat,v 1.1.1.1 1996/02/15 17:50:57 mclareni Exp $
-*
-* $Log: history.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:50:57 mclareni
-* Kernlib
-*
-*
-* This directory was created from kernamx.car patch kernamx
-#if !defined(CERNLIB_KERNAMX)
-
- KERNLIB ROUTINES PARTICULAR TO THE Amiga 3000UX
-
----------------------------------------------------------------------
-
- This file contains the following patches :
-
-*KAMX Pilot-patch selecting the standard KERNLIB for Amiga 3000UX
-
-QMAMX Amiga 3000UX machine patch
-
-AMXGS Amiga 3000UX versions of general KERNLIB routines
-
-=====================================================================
-
-
- Up-date RECORD FOR THE PAM-FILE KERNAMX
- ----------------------------------------
-
-
----------------------------------------------------------------------
-
- FIRST RELEASE OF THE KERNAMX PAM : 18-July-1991
-
----------------------------------------------------------------------
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernamx/inhibit.list b/src/packlib/kernlib/kerngen/obsolete/kernamx/inhibit.list
deleted file mode 100644
index 853d273..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernamx/inhibit.list
+++ /dev/null
@@ -1,5 +0,0 @@
-tcgen/kerngt
-tcgen/intrac
-ccgen/intrac
-ccgen/signalf
-tcgen/ublow
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernamx/kernamx/pilot.h b/src/packlib/kernlib/kerngen/obsolete/kernamx/kernamx/pilot.h
deleted file mode 100644
index 29b6411..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernamx/kernamx/pilot.h
+++ /dev/null
@@ -1,91 +0,0 @@
-#if 0
-* This pilot patch was created from kernamx.car patch _kamx
-* This directory was created from kernamx.car patch qmamx
-#endif
-#ifndef CERNLIB_F77
-#define CERNLIB_F77
-#endif
-#ifndef CERNLIB_A4
-#define CERNLIB_A4
-#endif
-#ifndef CERNLIB_B32
-#define CERNLIB_B32
-#endif
-#ifndef CERNLIB_HEX
-#define CERNLIB_HEX
-#endif
-#if 0
-* Normal Unix system machine
-#endif
-#ifndef CERNLIB_QMUIX
-#define CERNLIB_QMUIX
-#endif
-#if 0
-* Posix call for setjmp/longjmp
-#endif
-#ifndef CERNLIB_QPOSIX
-#define CERNLIB_QPOSIX
-#endif
-#if 0
-* MIL standard routines, IBITS, MVBITS, ISHFTC
-#endif
-#ifndef CERNLIB_QMILSTD
-#define CERNLIB_QMILSTD
-#endif
-#if 0
-* ISA standard routines, ISHFT, IOR, etc
-#endif
-#ifndef CERNLIB_QISASTD
-#define CERNLIB_QISASTD
-#endif
-#if 0
-* External names with underscore
-#endif
-#ifndef CERNLIB_QX_SC
-#define CERNLIB_QX_SC
-#endif
-#if 0
-* IEEE floating point
-#endif
-#ifndef CERNLIB_QIEEE
-#define CERNLIB_QIEEE
-#endif
-#if 0
-* Character set is ASCII
-#endif
-#ifndef CERNLIB_QASCII
-#define CERNLIB_QASCII
-#endif
-#if 0
-* Hollerith constants exist
-#endif
-#ifndef CERNLIB_QHOLL
-#define CERNLIB_QHOLL
-#endif
-#if 0
-* EQUIVALENCE Hollerith/Character ok
-#endif
-#ifndef CERNLIB_EQUHOLCH
-#define CERNLIB_EQUHOLCH
-#endif
-#if 0
-* Orthodox Hollerith storage left to right
-#endif
-#ifndef CERNLIB_QORTHOLL
-#define CERNLIB_QORTHOLL
-#endif
-#ifndef CERNLIB_AMXGS
-#define CERNLIB_AMXGS
-#endif
-#ifndef CERNLIB_XVECT
-#define CERNLIB_XVECT
-#endif
-#ifndef CERNLIB_TCGEN
-#define CERNLIB_TCGEN
-#endif
-#ifndef CERNLIB_CCGEN
-#define CERNLIB_CCGEN
-#endif
-#ifndef CERNLIB_CCGENCF
-#define CERNLIB_CCGENCF
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernamx/kernamx/q_shift.inc b/src/packlib/kernlib/kerngen/obsolete/kernamx/kernamx/q_shift.inc
deleted file mode 100644
index b47f6a2..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernamx/kernamx/q_shift.inc
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: q_shift.inc,v 1.1.1.1 1996/02/15 17:50:57 mclareni Exp $
-*
-* $Log: q_shift.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:50:57 mclareni
-* Kernlib
-*
-*
-#ifndef CERNLIB_KERNAMX_Q_SHIFT_INC
-#define CERNLIB_KERNAMX_Q_SHIFT_INC
-*
-*
-* q_shift.inc
-*
- ISHFTL (IZW,NZB) = ISHFT (IZW, NZB)
- ISHFTR (IZW,NZB) = ISHFT (IZW, -NZB)
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernamx/kernamx/qcardl.inc b/src/packlib/kernlib/kerngen/obsolete/kernamx/kernamx/qcardl.inc
deleted file mode 100644
index c0973cc..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernamx/kernamx/qcardl.inc
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: qcardl.inc,v 1.1.1.1 1996/02/15 17:50:57 mclareni Exp $
-*
-* $Log: qcardl.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:50:57 mclareni
-* Kernlib
-*
-*
-#ifndef CERNLIB_KERNAMX_QCARDL_INC
-#define CERNLIB_KERNAMX_QCARDL_INC
-*
-*
-* qcardl.inc
-*
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/_kapo/pilot.h b/src/packlib/kernlib/kerngen/obsolete/kernapo/_kapo/pilot.h
deleted file mode 100644
index d4cdfed..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/_kapo/pilot.h
+++ /dev/null
@@ -1,21 +0,0 @@
-#if 0
-* This pilot patch was created from kernapo.car patch _kapo
-#endif
-#if 0
-* for Apollo with /com/ftn
-#endif
-#ifndef CERNLIB_ANYAPO
-#define CERNLIB_ANYAPO
-#endif
-#ifndef CERNLIB_QF_APO
-#define CERNLIB_QF_APO
-#endif
-#ifndef CERNLIB_QMAPOFTN
-#define CERNLIB_QMAPOFTN
-#endif
-#if 0
-* external names without underscores
-#endif
-#ifndef CERNLIB_QXNO_SC
-#define CERNLIB_QXNO_SC
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/_kapof77/pilot.h b/src/packlib/kernlib/kerngen/obsolete/kernapo/_kapof77/pilot.h
deleted file mode 100644
index 7489bd7..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/_kapof77/pilot.h
+++ /dev/null
@@ -1,21 +0,0 @@
-#if 0
-* This pilot patch was created from kernapo.car patch _kapof77
-#endif
-#if 0
-* for Apollo with f77
-#endif
-#ifndef CERNLIB_ANYAPO
-#define CERNLIB_ANYAPO
-#endif
-#ifndef CERNLIB_QF_APO77
-#define CERNLIB_QF_APO77
-#endif
-#ifndef CERNLIB_QMAPOF77
-#define CERNLIB_QMAPOF77
-#endif
-#if 0
-* external names with underscores
-#endif
-#ifndef CERNLIB_QX_SC
-#define CERNLIB_QX_SC
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/anyapo/Imakefile b/src/packlib/kernlib/kerngen/obsolete/kernapo/anyapo/Imakefile
deleted file mode 100644
index ba45f74..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/anyapo/Imakefile
+++ /dev/null
@@ -1,4 +0,0 @@
-SRCS_F= \ @@\
- normal.F patchy.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/anyapo/normal.F b/src/packlib/kernlib/kerngen/obsolete/kernapo/anyapo/normal.F
deleted file mode 100644
index 66aed58..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/anyapo/normal.F
+++ /dev/null
@@ -1,35 +0,0 @@
-*
-* $Id: normal.F,v 1.1.1.1 1996/02/15 17:51:00 mclareni Exp $
-*
-* $Log: normal.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:00 mclareni
-* Kernlib
-*
-*
-#include "kernapo/pilot.h"
-#if !defined(CERNLIB_P5BOOT)
-#ifndef CERNLIB_APOGS
-#define CERNLIB_APOGS
-#endif
-#ifndef CERNLIB_APOSYS
-#define CERNLIB_APOSYS
-#endif
-#ifndef CERNLIB_CCGEN
-#define CERNLIB_CCGEN
-#endif
-#ifndef CERNLIB_CCGENCX
-#define CERNLIB_CCGENCX
-#endif
-#ifndef CERNLIB_CCGENCF
-#define CERNLIB_CCGENCF
-#endif
-#ifndef CERNLIB_CCGENCI
-#define CERNLIB_CCGENCI
-#endif
-#ifndef CERNLIB_XVECT
-#define CERNLIB_XVECT
-#endif
-#ifndef CERNLIB_TCGEN
-#define CERNLIB_TCGEN
-#endif
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/anyapo/patchy.F b/src/packlib/kernlib/kerngen/obsolete/kernapo/anyapo/patchy.F
deleted file mode 100644
index f6fd260..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/anyapo/patchy.F
+++ /dev/null
@@ -1,72 +0,0 @@
-*
-* $Id: patchy.F,v 1.1.1.1 1996/02/15 17:51:00 mclareni Exp $
-*
-* $Log: patchy.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:00 mclareni
-* Kernlib
-*
-*
-* Patch boot-strap
-#include "kernapo/pilot.h"
-#if defined(CERNLIB_P5BOOT)
-#ifndef CERNLIB_P5_CC
-#define CERNLIB_P5_CC
-#endif
-#ifndef CERNLIB_P5_CI
-#define CERNLIB_P5_CI
-#endif
-#ifndef CERNLIB_APOGS_IANDETC
-#define CERNLIB_APOGS_IANDETC
-#endif
-#ifndef CERNLIB_APOGS_ISHFT
-#define CERNLIB_APOGS_ISHFT
-#endif
-#ifndef CERNLIB_APOGS_JBIT
-#define CERNLIB_APOGS_JBIT
-#endif
-#ifndef CERNLIB_APOGS_JBYT
-#define CERNLIB_APOGS_JBYT
-#endif
-#ifndef CERNLIB_APOGS_LENOCC
-#define CERNLIB_APOGS_LENOCC
-#endif
-#ifndef CERNLIB_APOGS_LOCF
-#define CERNLIB_APOGS_LOCF
-#endif
-#ifndef CERNLIB_APOGS_PKBYT
-#define CERNLIB_APOGS_PKBYT
-#endif
-#ifndef CERNLIB_APOGS_SBIT0
-#define CERNLIB_APOGS_SBIT0
-#endif
-#ifndef CERNLIB_APOGS_SBIT1
-#define CERNLIB_APOGS_SBIT1
-#endif
-#ifndef CERNLIB_APOGS_SBYT
-#define CERNLIB_APOGS_SBYT
-#endif
-#ifndef CERNLIB_APOGS_UCTOH
-#define CERNLIB_APOGS_UCTOH
-#endif
-#ifndef CERNLIB_APOGS_UPKBYT
-#define CERNLIB_APOGS_UPKBYT
-#endif
-#ifndef CERNLIB_APOSYS_DATIME
-#define CERNLIB_APOSYS_DATIME
-#endif
-#ifndef CERNLIB_APOSYS_GETARG
-#define CERNLIB_APOSYS_GETARG
-#endif
-#ifndef CERNLIB_APOSYS_IARGC
-#define CERNLIB_APOSYS_IARGC
-#endif
-#ifndef CERNLIB_APOSYS_INTRAC
-#define CERNLIB_APOSYS_INTRAC
-#endif
-#ifndef CERNLIB_APOSYS_SIGNALF
-#define CERNLIB_APOSYS_SIGNALF
-#endif
-#ifndef CERNLIB_APOSYS_TRACEQ
-#define CERNLIB_APOSYS_TRACEQ
-#endif
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/apobsol/Imakefile b/src/packlib/kernlib/kerngen/obsolete/kernapo/apobsol/Imakefile
deleted file mode 100644
index a3630a4..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/apobsol/Imakefile
+++ /dev/null
@@ -1,5 +0,0 @@
-SRCS_F= \ @@\
- chdirf.F getcwdf.F getenvf.F jumpad.F jumpx2.F qnexte.F renamef.F \ @@\
- uctoh.F uctoh1.F uh1toc.F uhtoc.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/apobsol/chdirf.F b/src/packlib/kernlib/kerngen/obsolete/kernapo/apobsol/chdirf.F
deleted file mode 100644
index 92abebd..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/apobsol/chdirf.F
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: chdirf.F,v 1.1.1.1 1996/02/15 17:51:10 mclareni Exp $
-*
-* $Log: chdirf.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:10 mclareni
-* Kernlib
-*
-*
-#include "kernapo/pilot.h"
- INTEGER FUNCTION CHDIRF (CHNAME)
-C
-C CERN PROGLIB# CHDIRF .VERSION KERNAPO 1.21 900731
-C ORIG. 25/07/90 JZ
-C
-C- APOLLO inplementation of UNIX function
-
- CHARACTER CHNAME*(*)
- INTEGER*2 LENA
-
- ISTAT = -1
- LENA = ICFIND (' ', CHNAME,1,LEN(CHNAME)) - 1
- IF (LENA.GT.0) CALL NAME_$SET_WDIR (CHNAME,LENA,ISTAT)
- CHDIRF = ISTAT
- RETURN
- END
-#ifdef CERNLIB_CCGEN_CHDIRF
-#undef CERNLIB_CCGEN_CHDIRF
-#endif
-#ifdef CERNLIB_TCGEN_CHDIRF
-#undef CERNLIB_TCGEN_CHDIRF
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/apobsol/getcwdf.F b/src/packlib/kernlib/kerngen/obsolete/kernapo/apobsol/getcwdf.F
deleted file mode 100644
index eb8222a..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/apobsol/getcwdf.F
+++ /dev/null
@@ -1,35 +0,0 @@
-*
-* $Id: getcwdf.F,v 1.1.1.1 1996/02/15 17:51:10 mclareni Exp $
-*
-* $Log: getcwdf.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:10 mclareni
-* Kernlib
-*
-*
-#include "kernapo/pilot.h"
- SUBROUTINE GETCWDF (CHNAME,NNAME)
-C
-C CERN PROGLIB# GETCWDF .VERSION KERNAPO 1.21 900731
-C ORIG. 25/07/90 JZ
-C
-C- APOLLO inplementation of UNIX function
-
- CHARACTER CHNAME*(*)
- INTEGER*2 LENA
-
- CALL NAME_$GET_WDIR (CHNAME,LENA,ISTAT)
- IF (ISTAT.NE.0) THEN
- LENA = 0
- ELSE
- CALL CUTOL (CHNAME(1:LENA))
- ENDIF
- CHNAME(LENA+1:) = ' '
- NNAME = LENA
- RETURN
- END
-#ifdef CERNLIB_CCGEN_GETCWDF
-#undef CERNLIB_CCGEN_GETCWDF
-#endif
-#ifdef CERNLIB_TCGEN_GETCWDF
-#undef CERNLIB_TCGEN_GETCWDF
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/apobsol/getenvf.F b/src/packlib/kernlib/kerngen/obsolete/kernapo/apobsol/getenvf.F
deleted file mode 100644
index c4040ad..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/apobsol/getenvf.F
+++ /dev/null
@@ -1,43 +0,0 @@
-*
-* $Id: getenvf.F,v 1.1.1.1 1996/02/15 17:51:10 mclareni Exp $
-*
-* $Log: getenvf.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:10 mclareni
-* Kernlib
-*
-*
-#include "kernapo/pilot.h"
- SUBROUTINE GETENVF (CHVAR,CHVAL,NVALR)
-C
-C CERN PROGLIB# GETENVF .VERSION KERNAPO 1.21 900731
-C ORIG. 25/07/90 JZ
-C
-C- APOLLO inplementation of UNIX function
-
- CHARACTER CHVAR*(*), CHVAL*(*)
- CHARACTER RESULT*64
- INTEGER*4 LOCRES
- POINTER /LOCRES/ RESULT
- INTEGER*2 NVAR, NVAL
-
-
- NVAR = ICFIND (' ', CHVAR,1,LEN(CHVAR)) - 1
- IF (NVAR.LE.0) GO TO 49
-
- CALL EV_$GET_VAR (CHVAR,NVAR,LOCRES,NVAL)
- IF (LOCRES.EQ.0) GO TO 49
- CHVAL = RESULT(1:NVAL)
- CALL CUTOL (CHVAL(1:NVAL))
- NVALR = NVAL
- RETURN
-
- 49 NVALR = 0
- CHVAL = ' '
- RETURN
- END
-#ifdef CERNLIB_CCGEN_GETENVF
-#undef CERNLIB_CCGEN_GETENVF
-#endif
-#ifdef CERNLIB_TCGEN_GETENVF
-#undef CERNLIB_TCGEN_GETENVF
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/apobsol/jumpad.F b/src/packlib/kernlib/kerngen/obsolete/kernapo/apobsol/jumpad.F
deleted file mode 100644
index e94067d..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/apobsol/jumpad.F
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: jumpad.F,v 1.1.1.1 1996/02/15 17:51:11 mclareni Exp $
-*
-* $Log: jumpad.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:11 mclareni
-* Kernlib
-*
-*
-#include "kernapo/pilot.h"
- FUNCTION JUMPAD (ITARGT)
-C
-C CERN PROGLIB# Z042 JUMPAD .VERSION KERNAPO 1.13 880425
-C ORIG. 21/04/88 JZ
-C
-C- Get target address for use with JUMPXn
-
- JUMPAD = IADDR (ITARGT)
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/apobsol/jumpx2.F b/src/packlib/kernlib/kerngen/obsolete/kernapo/apobsol/jumpx2.F
deleted file mode 100644
index ea08a3f..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/apobsol/jumpx2.F
+++ /dev/null
@@ -1,68 +0,0 @@
-*
-* $Id: jumpx2.F,v 1.1.1.1 1996/02/15 17:51:11 mclareni Exp $
-*
-* $Log: jumpx2.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:11 mclareni
-* Kernlib
-*
-*
-#include "kernapo/pilot.h"
- SUBROUTINE JUMPX2 (IPARA,IPARB)
-C
-C CERN PROGLIB# Z042 JUMPX2 .VERSION KERNAPO 1.18 890929
-C ORIG. 21/04/88 JZ
-C MOD. 12/09/89 JZ, add entries JUMPX1, JUMPX0
-C
-C- To transfer to the user routine TARGET (say) with 2 parameters
-C- three steps are needed :
-
-C- 1) EXTERNAL TARGET to get the address of TARGET
-C- IADR = JUMPAD (TARGET)
-
-C- 2) CALL JUMPST (IADR) to set the tranfer address
-
-C- 3) CALL JUMPX2 (par1,par2) to transfer
-
- DIMENSION IPARA(9), IPARB(9)
-
- INTEGER JPOINT
- POINTER / JPOINT / TARGET
- SAVE JPOINT
-
- CALL JUMPY2 (TARGET,IPARA,IPARB)
- RETURN
-
- ENTRY JUMPX1 (IPARA)
- CALL JUMPY1 (TARGET,IPARA)
- RETURN
-
- ENTRY JUMPX0
- CALL JUMPY0 (TARGET)
- RETURN
-
- ENTRY JUMPST (JADR)
- JPOINT = JADR
- RETURN
- END
-C-----------------------------------------------------
- SUBROUTINE JUMPY2 (TARSUB,IPARA,IPARB)
- DIMENSION IPARA(9), IPARB(9)
- EXTERNAL TARSUB
-
- CALL TARSUB (IPARA,IPARB)
- RETURN
-
- ENTRY JUMPY1 (TARSUB,IPARA)
- CALL TARSUB (IPARA)
- RETURN
-
- ENTRY JUMPY0 (TARSUB)
- CALL TARSUB
- RETURN
- END
-#ifdef CERNLIB_CCGEN_JUMPXN
-#undef CERNLIB_CCGEN_JUMPXN
-#endif
-#ifdef CERNLIB_TCGEN_JUMPXN
-#undef CERNLIB_TCGEN_JUMPXN
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/apobsol/qnexte.F b/src/packlib/kernlib/kerngen/obsolete/kernapo/apobsol/qnexte.F
deleted file mode 100644
index 6d8cd66..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/apobsol/qnexte.F
+++ /dev/null
@@ -1,40 +0,0 @@
-*
-* $Id: qnexte.F,v 1.1.1.1 1996/02/15 17:51:10 mclareni Exp $
-*
-* $Log: qnexte.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:10 mclareni
-* Kernlib
-*
-*
-#include "kernapo/pilot.h"
- SUBROUTINE QNEXTE
-C
-C CERN PROGLIB# Z041 QNEXTE .VERSION KERNAPO 1.15 881020
-C ORIG. 25/03/85, W. VAN LEUWEN, I. ZACHAROV, NIKHEF
-C
- SAVE MAREA
- DIMENSION MAREA(16)
- DATA MAREA / 16*0 /
-
- IF (MAREA(1).EQ.0) GO TO 21
-C
-C-- RE-ENTRY
-C
- CALL LONGJMP (MAREA(2),J)
-C
-C-- FIRST ENTRY
-C
- 21 MAREA(1) = 77
- CALL SETJMP (MAREA(2))
-C
-C-- GO DOWN
-C
- CALL QNEXT
- RETURN
- END
-#ifdef CERNLIB_CCGEN_QNEXTE
-#undef CERNLIB_CCGEN_QNEXTE
-#endif
-#ifdef CERNLIB_TCGEN_QNEXTE
-#undef CERNLIB_TCGEN_QNEXTE
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/apobsol/renamef.F b/src/packlib/kernlib/kerngen/obsolete/kernapo/apobsol/renamef.F
deleted file mode 100644
index 9f9ecde..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/apobsol/renamef.F
+++ /dev/null
@@ -1,147 +0,0 @@
-*
-* $Id: renamef.F,v 1.1.1.1 1996/02/15 17:51:11 mclareni Exp $
-*
-* $Log: renamef.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:11 mclareni
-* Kernlib
-*
-*
-#include "kernapo/pilot.h"
- INTEGER FUNCTION RENAMEF (CHFR,CHTO)
-C
-C CERN PROGLIB# RENAMEF .VERSION KERNAPO 1.21 900731
-C ORIG. 25/07/90 JZ
-C
-C- APOLLO inplementation of UNIX function
-C- but only for files, not for directories
-
-%include '/sys/ins/base.ins.ftn'
-%include '/sys/ins/pgm.ins.ftn'
-
- COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT,DUMMY(36)
- CHARACTER CHFR*(*), CHTO*(*)
- CHARACTER CHOLD*(256), CHNEW*(256)
- CHARACTER CHLEAF*32
- INTEGER*2 NLEAFLG
- INTEGER*2 NFRLG, NTOLG
- INTEGER*2 NOLDLG, NNEWLG
- INTEGER*2 NNAMLG, NOP1LG, NOP2LG
-
- CHARACTER CHNAM*4, CHOP1*4, CHOP2*4
- CHARACTER CANAM*6, CAOP1*6, CAOP2*6
- CHARACTER CAOLD*(258), CANEW*(258)
-
- EQUIVALENCE (CHNAM(1:1), CANAM(3:3))
- EQUIVALENCE (CHOP1(1:1), CAOP1(3:3))
- EQUIVALENCE (CHOP2(1:1), CAOP2(3:3))
- EQUIVALENCE (CHOLD(1:1), CAOLD(3:3))
- EQUIVALENCE (CHNEW(1:1), CANEW(3:3))
-
- EQUIVALENCE (NNAMLG, CANAM)
- EQUIVALENCE (NOP1LG, CAOP1)
- EQUIVALENCE (NOP2LG, CAOP2)
- EQUIVALENCE (NOLDLG, CAOLD)
- EQUIVALENCE (NNEWLG, CANEW)
-
- DIMENSION LARGV(5)
-
- ISTAT = -1
- NFR = ICFIND (' ', CHFR,1,LEN(CHFR)) - 1
- IF (NFR.LE.0) GO TO 39
-
- NTO = ICFIND (' ', CHTO,1,LEN(CHTO)) - 1
- IF (NTO.LE.0) GO TO 39
-
-C---- Expand FROM path-name, check file exists
-
- RENAMEF = -1
- NFRLG = NFR
- CALL NAME_$GET_PATH (CHFR,NFRLG,CHOLD,NOLDLG,ISTAT)
- IF (ISTAT.NE.0) GO TO 39
-
-C---- Expand TO path-name, check file exists
-
- NTOLG = NTO
- CALL NAME_$GET_PATH (CHTO,NTOLG,CHNEW,NNEWLG,ISTAT)
- IF (ISTAT.NE.0) GO TO 24
-
-C-- Delete file
-
- CALL NAME_$DELETE_FILE (CHNEW,NNEWLG,ISTAT)
- GO TO 31
-
-C-- Construct expansion
-
- 24 JSLNEW = ICFIND ('/',CHTO,1,NTO)
- IF (NGSLAT.EQ.0) GO TO 25
- CHNEW = CHTO
- NNEWLG = NTOLG
- GO TO 31
-
- 25 CALL NAME_$GET_WDIR (CHNEW,NNEWLG,ISTAT)
- IF (ISTAT.NE.0) GO TO 39
- NNEWLG = NNEWLG + 1
- CHNEW(NNEWLG:NNEWLG) = '/'
- CHNEW(NNEWLG+1:NNEWLG+NTOLG) = CHTO(1:NTOLG)
- NNEWLG = NNEWLG + NTOLG
-
-C---- Decide copy | rename
-
- 31 NOLD = NOLDLG
- NNEW = NNEWLG
- CALL CUTOL (CHOLD(1:NOLDLG))
- CALL CUTOL (CHNEW(1:NNEWLG))
-
- IF (NOLD.EQ.NNEW) THEN
- IF (CHOLD(1:NOLD).EQ.CHNEW(1:NNEW)) RETURN
- ENDIF
-
- JSLO = ICFILA ('/',CHOLD,1,NOLD)
- JSLN = ICFILA ('/',CHNEW,1,NNEW)
-
- IF (JSLO.NE.JSLN) GO TO 41
- IF (CHOLD(1:JSLN).NE.CHNEW(1:JSLN)) GO TO 41
-
-C---- RENAMEF file
-
- NLEAFLG = NNEW - JSLN
- IF (NLEAFLG.LE.0) RETURN
-
- CHLEAF = CHNEW(JSLN+1:JSLN+NLEAFLG)
-
- CALL NAME_$CNAME (CHOLD,NOLDLG,CHLEAF,NLEAFLG,ISTAT)
- 39 RENAMEF = ISTAT
- RETURN
-
-C---- Copy file
-
- 41 CHNAM = 'cpf'
- CHOP1 = '-r'
- CHOP2 = '-pdt'
-
- NNAMLG = 3
- NOP1LG = 2
- NOP2LG = 4
-
- LARGV(1) = IADDR (CANAM)
- LARGV(2) = IADDR (CAOLD)
- LARGV(3) = IADDR (CANEW)
- LARGV(4) = IADDR (CAOP1)
- LARGV(5) = IADDR (CAOP2)
-
- CALL PGM_$INVOKE ('/com/cpf',INT2(8), INT2(5),LARGV,
- + 0,0, PGM_$WAIT, IHDL, ISTAT)
- RENAMEF = ISTAT
- IF (ISTAT.NE.0) RETURN
-
-C-- delete the original
-
- CALL NAME_$DELETE_FILE (CHOLD,NOLDLG,ISTAT)
- RETURN
- END
-#ifdef CERNLIB_CCGEN_RENAMEF
-#undef CERNLIB_CCGEN_RENAMEF
-#endif
-#ifdef CERNLIB_TCGEN_RENAMEF
-#undef CERNLIB_TCGEN_RENAMEF
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/apobsol/uctoh.F b/src/packlib/kernlib/kerngen/obsolete/kernapo/apobsol/uctoh.F
deleted file mode 100644
index 74df7ff..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/apobsol/uctoh.F
+++ /dev/null
@@ -1,67 +0,0 @@
-*
-* $Id: uctoh.F,v 1.1.1.1 1996/02/15 17:51:10 mclareni Exp $
-*
-* $Log: uctoh.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:10 mclareni
-* Kernlib
-*
-*
-#include "kernapo/pilot.h"
- SUBROUTINE UCTOH (KCHAR,KHOLL,NPW,NCH)
-C
-C CERN PROGLIB# M409 UCTOH .VERSION KERNAPO 1.07 860212
-C ORIG. 11/02/86 A. PETRILLI, CERN
-C
- PARAMETER (MAXCPW=4)
-
- CHARACTER*(9) KCHAR,KHOLL
-
- IF (NCH.LE.0) RETURN
- GO TO (11, 21, 31), NPW
-
-C---- NPW = 4
-
- KHOLL(1:NCH) = KCHAR(1:NCH)
- I = MOD(NCH,MAXCPW)
- IF (I.NE.0) KHOLL(NCH+1:NCH+(MAXCPW-I)) = ' '
- RETURN
-
-C---- NPW = 1
-
-C-- EQUIVALENT TO 'CALL UCTOH1(KCHAR,KHOLL,NCH)'
-
- 11 J = 1
- KHOLL(1:4*NCH) = ' '
- DO 14 L=1,NCH
- KHOLL(J:J) = KCHAR(L:L)
- J = J+MAXCPW
- 14 CONTINUE
- RETURN
-
-C---- NPW = 2
-
- 21 J = 1
- I = MOD(NCH,2)
- K = NCH-I
- DO 24 L=1,K,2
- KHOLL(J:J+MAXCPW-1) = KCHAR(L:L+1)
- J = J+MAXCPW
- 24 CONTINUE
- IF (I.NE.0) KHOLL(J:J+MAXCPW-1) = KCHAR(NCH:NCH)
- RETURN
-
-C---- NPW = 3
-
- 31 J = 1
- I = MOD(NCH,3)
- K = NCH-I
- DO 34 L=1,K,3
- KHOLL(J:J+MAXCPW-1) = KCHAR(L:L+2)
- J = J+MAXCPW
- 34 CONTINUE
- IF (I.NE.0) KHOLL(J:J+MAXCPW-1) = KCHAR(NCH-I+1:NCH)
- RETURN
- END
-#ifdef CERNLIB_TCGEN_UCTOH
-#undef CERNLIB_TCGEN_UCTOH
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/apobsol/uctoh1.F b/src/packlib/kernlib/kerngen/obsolete/kernapo/apobsol/uctoh1.F
deleted file mode 100644
index 807a9fe..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/apobsol/uctoh1.F
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: uctoh1.F,v 1.1.1.1 1996/02/15 17:51:10 mclareni Exp $
-*
-* $Log: uctoh1.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:10 mclareni
-* Kernlib
-*
-*
-#include "kernapo/pilot.h"
- SUBROUTINE UCTOH1 (KCHAR,KHOLL,NCH)
-C
-C CERN PROGLIB# M409 UCTOH1 .VERSION KERNAPO 1.07 860212
-C ORIG. 11/02/86 A. PETRILLI, CERN
-C
- PARAMETER (MAXCPW=4)
-
- CHARACTER*(9) KCHAR,KHOLL
-
- IF (NCH.LE.0) RETURN
-
- J = 1
- KHOLL(1:4*NCH) = ' '
- DO 14 L=1,NCH
- KHOLL(J:J) = KCHAR(L:L)
- J = J+MAXCPW
- 14 CONTINUE
- RETURN
- END
-#ifdef CERNLIB_TCGEN_UCTOH1
-#undef CERNLIB_TCGEN_UCTOH1
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/apobsol/uh1toc.F b/src/packlib/kernlib/kerngen/obsolete/kernapo/apobsol/uh1toc.F
deleted file mode 100644
index dc2422f..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/apobsol/uh1toc.F
+++ /dev/null
@@ -1,47 +0,0 @@
-*
-* $Id: uh1toc.F,v 1.1.1.1 1996/02/15 17:51:10 mclareni Exp $
-*
-* $Log: uh1toc.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:10 mclareni
-* Kernlib
-*
-*
-#include "kernapo/pilot.h"
- SUBROUTINE UH1TOC (MH,MC,NCHP)
-C
-C CERN PROGLIB# M409 UH1TOC .VERSION KERNAPO 1.06 851211
-C ORIG. 29/03/85 JZ
-C
-
- DIMENSION MH(99), NCHP(9)
- INTEGER*2 MC(99)
-
-
- NCH = NCHP(1)
- IF (NCH) 91,39,11
- 11 NW = RSHFT (NCH,1)
- NTRAIL = RSHFT (LSHFT(NCH,31),31)
- JH = 0
- IF (NW.EQ.0) GO TO 31
-
-C-- PACK THE LEADING 16-BIT WORDS
-
- DO 24 JC=1,NW
- MC(JC) = OR ( LSHFT (RSHFT(MH(JH+1),24), 8),
- + RSHFT(MH(JH+2),24) )
- 24 JH = JH + 2
-
- IF (NTRAIL.EQ.0) RETURN
-
-C-- PACK THE TRAILING WORD
-
- 31 JC = NW + 1
- MC(JC) = OR ( LSHFT (RSHFT(MH(JH+1),24), 8),
- + RSHFT (LSHFT(MC(JC) ,8), 8))
- 39 RETURN
-
- 91 CALL ABEND
- END
-#ifdef CERNLIB_TCGEN_UH1TOC
-#undef CERNLIB_TCGEN_UH1TOC
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/apobsol/uhtoc.F b/src/packlib/kernlib/kerngen/obsolete/kernapo/apobsol/uhtoc.F
deleted file mode 100644
index 5627e79..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/apobsol/uhtoc.F
+++ /dev/null
@@ -1,64 +0,0 @@
-*
-* $Id: uhtoc.F,v 1.1.1.1 1996/02/15 17:51:10 mclareni Exp $
-*
-* $Log: uhtoc.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:10 mclareni
-* Kernlib
-*
-*
-#include "kernapo/pilot.h"
- SUBROUTINE UHTOC (MH,NPHP,MC,NCHP)
-C
-C CERN PROGLIB# M409 UHTOC .VERSION KERNAPO 1.06 851211
-C ORIG. 29/03/85 JZ
-C
-
- DIMENSION MH(99), NPHP(9), NCHP(9)
- INTEGER*2 MC(99)
-
- INTEGER*2 MCH2(2), ICOMP, ITOGGL
- EQUIVALENCE (MCH2,MCH4)
-
-
- NPH = NPHP(1)
- NCH = NCHP(1)
- IF (NCH) 91,39,11
- 11 NW = RSHFT (NCH,1)
- JC = 1
- ITOGGL = 0
- NPH = MIN0 (NPH,4)
- NWH = (NCH-1)/NPH + 1
-
-C-- TAKE CHARACTERS FROM MH WORD BY WORD
-
- DO 29 JWH=1,NWH
- MWDH = MH(JWH)
-
- DO 28 JPH=1,NPH
- MCH4 = RSHFT(MWDH,24)
- MWDH = LSHFT(MWDH,8)
- IF (ITOGGL.NE.0) GO TO 24
- ICOMP = LSHFT(MCH2(2),8)
- ITOGGL = 1
- GO TO 27
-
- 24 MC(JC) = OR (ICOMP,MCH2(2))
- JC = JC + 1
- ITOGGL = 0
- 27 NCH = NCH - 1
- IF (NCH.EQ.0) GO TO 31
- 28 CONTINUE
- 29 CONTINUE
-
-
-C-- PACK THE TRAILING WORD
-
- 31 IF (ITOGGL.EQ.0) RETURN
- MC(JC) = OR ( ICOMP, RSHFT (LSHFT(MC(JC),8), 8))
- 39 RETURN
-
- 91 CALL ABEND
- END
-#ifdef CERNLIB_TCGEN_UHTOC
-#undef CERNLIB_TCGEN_UHTOC
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/apoccr/Imakefile b/src/packlib/kernlib/kerngen/obsolete/kernapo/apoccr/Imakefile
deleted file mode 100644
index 39341ad..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/apoccr/Imakefile
+++ /dev/null
@@ -1,4 +0,0 @@
-SRCS_F= \ @@\
- chdir.F getcwd.F getenv.F rename.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/apoccr/chdir.F b/src/packlib/kernlib/kerngen/obsolete/kernapo/apoccr/chdir.F
deleted file mode 100644
index d312ae6..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/apoccr/chdir.F
+++ /dev/null
@@ -1,30 +0,0 @@
-*
-* $Id: chdir.F,v 1.1.1.1 1996/02/15 17:51:09 mclareni Exp $
-*
-* $Log: chdir.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:09 mclareni
-* Kernlib
-*
-*
-#include "kernapo/pilot.h"
- INTEGER FUNCTION CHDIR (CHNAME)
-C
-C CERN PROGLIB# CHDIR .VERSION KERNAPO 1.21 900731
-C ORIG. 25/07/90 JZ
-C
-C- APOLLO inplementation of UNIX function
-
- CHARACTER CHNAME*(*)
- INTEGER*2 LENA
-
- LENA = LNBLNK (CHNAME)
- CALL NAME_$SET_WDIR (CHNAME,LENA,ISTAT)
- CHDIR = ISTAT
- RETURN
- END
-#ifdef CERNLIB_CCGEN_CHDIR
-#undef CERNLIB_CCGEN_CHDIR
-#endif
-#ifdef CERNLIB_TCGEN_CHDIR
-#undef CERNLIB_TCGEN_CHDIR
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/apoccr/getcwd.F b/src/packlib/kernlib/kerngen/obsolete/kernapo/apoccr/getcwd.F
deleted file mode 100644
index 0be10a6..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/apoccr/getcwd.F
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: getcwd.F,v 1.1.1.1 1996/02/15 17:51:09 mclareni Exp $
-*
-* $Log: getcwd.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:09 mclareni
-* Kernlib
-*
-*
-#include "kernapo/pilot.h"
- SUBROUTINE GETCWD (CHNAME)
-C
-C CERN PROGLIB# GETCWD .VERSION KERNAPO 1.21 900731
-C ORIG. 25/07/90 JZ
-C
-C- APOLLO inplementation of UNIX function
-
- CHARACTER CHNAME*(*)
- INTEGER*2 LENA
-
- CALL NAME_$GET_WDIR (CHNAME,LENA,ISTAT)
- IF (ISTAT.NE.0) THEN
- LENA = 0
- ELSE
- CALL CUTOL (CHNAME(1:LENA))
- ENDIF
- CHNAME(LENA+1:) = ' '
- RETURN
- END
-#ifdef CERNLIB_CCGEN_GETCWD
-#undef CERNLIB_CCGEN_GETCWD
-#endif
-#ifdef CERNLIB_TCGEN_GETCWD
-#undef CERNLIB_TCGEN_GETCWD
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/apoccr/getenv.F b/src/packlib/kernlib/kerngen/obsolete/kernapo/apoccr/getenv.F
deleted file mode 100644
index 9f10f8e..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/apoccr/getenv.F
+++ /dev/null
@@ -1,39 +0,0 @@
-*
-* $Id: getenv.F,v 1.1.1.1 1996/02/15 17:51:10 mclareni Exp $
-*
-* $Log: getenv.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:10 mclareni
-* Kernlib
-*
-*
-#include "kernapo/pilot.h"
- SUBROUTINE GETENV (CHVAR,CHVAL)
-C
-C CERN PROGLIB# GETENV .VERSION KERNAPO 1.21 900731
-C ORIG. 25/07/90 JZ
-C
-C- APOLLO inplementation of UNIX function
-
- CHARACTER CHVAR*(*), CHVAL*(*)
- CHARACTER RESULT*64
- INTEGER*4 LOCRES
- POINTER /LOCRES/ RESULT
- INTEGER*2 NVAR, NVAL
-
-
- NVAR = LNBLNK (CHVAR)
- CALL EV_$GET_VAR (CHVAR,NVAR,LOCRES,NVAL)
- IF (LOCRES.NE.0) THEN
- CHVAL = RESULT(1:NVAL)
- CALL CUTOL (CHVAL(1:NVAL))
- ELSE
- CHVAL = ' '
- ENDIF
- RETURN
- END
-#ifdef CERNLIB_CCGEN_GETENV
-#undef CERNLIB_CCGEN_GETENV
-#endif
-#ifdef CERNLIB_TCGEN_GETENV
-#undef CERNLIB_TCGEN_GETENV
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/apoccr/rename.F b/src/packlib/kernlib/kerngen/obsolete/kernapo/apoccr/rename.F
deleted file mode 100644
index 660d6ee..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/apoccr/rename.F
+++ /dev/null
@@ -1,143 +0,0 @@
-*
-* $Id: rename.F,v 1.1.1.1 1996/02/15 17:51:10 mclareni Exp $
-*
-* $Log: rename.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:10 mclareni
-* Kernlib
-*
-*
-#include "kernapo/pilot.h"
- INTEGER FUNCTION RENAME (CHFR,CHTO)
-C
-C CERN PROGLIB# RENAME .VERSION KERNAPO 1.21 900731
-C ORIG. 25/07/90 JZ
-C
-C- APOLLO inplementation of UNIX function
-C- but only for files, not for directories
-
-%include '/sys/ins/base.ins.ftn'
-%include '/sys/ins/pgm.ins.ftn'
-
- COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT,DUMMY(36)
- CHARACTER CHFR*(*), CHTO*(*)
- CHARACTER CHOLD*(256), CHNEW*(256)
- CHARACTER CHLEAF*32
- INTEGER*2 NLEAFLG
- INTEGER*2 NFRLG, NTOLG
- INTEGER*2 NOLDLG, NNEWLG
- INTEGER*2 NNAMLG, NOP1LG, NOP2LG
-
- CHARACTER CHNAM*4, CHOP1*4, CHOP2*4
- CHARACTER CANAM*6, CAOP1*6, CAOP2*6
- CHARACTER CAOLD*(258), CANEW*(258)
-
- EQUIVALENCE (CHNAM(1:1), CANAM(3:3))
- EQUIVALENCE (CHOP1(1:1), CAOP1(3:3))
- EQUIVALENCE (CHOP2(1:1), CAOP2(3:3))
- EQUIVALENCE (CHOLD(1:1), CAOLD(3:3))
- EQUIVALENCE (CHNEW(1:1), CANEW(3:3))
-
- EQUIVALENCE (NNAMLG, CANAM)
- EQUIVALENCE (NOP1LG, CAOP1)
- EQUIVALENCE (NOP2LG, CAOP2)
- EQUIVALENCE (NOLDLG, CAOLD)
- EQUIVALENCE (NNEWLG, CANEW)
-
- DIMENSION LARGV(5)
-
-
-C---- Expand FROM path-name, check file exists
-
- RENAME = -1
- NFR = LNBLNK (CHFR)
- NFRLG = NFR
- CALL NAME_$GET_PATH (CHFR,NFRLG,CHOLD,NOLDLG,ISTAT)
- IF (ISTAT.NE.0) GO TO 39
-
-C---- Expand TO path-name, check file exists
-
- NTO = LNBLNK (CHTO)
- NTOLG = NTO
- CALL NAME_$GET_PATH (CHTO,NTOLG,CHNEW,NNEWLG,ISTAT)
- IF (ISTAT.NE.0) GO TO 24
-
-C-- Delete file
-
- CALL NAME_$DELETE_FILE (CHNEW,NNEWLG,ISTAT)
- GO TO 31
-
-C-- Construct expansion
-
- 24 JSLNEW = ICFIND ('/',CHTO,1,NTO)
- IF (NGSLAT.EQ.0) GO TO 25
- CHNEW = CHTO
- NNEWLG = NTOLG
- GO TO 31
-
- 25 CALL NAME_$GET_WDIR (CHNEW,NNEWLG,ISTAT)
- IF (ISTAT.NE.0) GO TO 39
- NNEWLG = NNEWLG + 1
- CHNEW(NNEWLG:NNEWLG) = '/'
- CHNEW(NNEWLG+1:NNEWLG+NTOLG) = CHTO(1:NTOLG)
- NNEWLG = NNEWLG + NTOLG
-
-C---- Decide copy | rename
-
- 31 NOLD = NOLDLG
- NNEW = NNEWLG
- CALL CUTOL (CHOLD(1:NOLDLG))
- CALL CUTOL (CHNEW(1:NNEWLG))
-
- IF (NOLD.EQ.NNEW) THEN
- IF (CHOLD(1:NOLD).EQ.CHNEW(1:NNEW)) RETURN
- ENDIF
-
- JSLO = ICFILA ('/',CHOLD,1,NOLD)
- JSLN = ICFILA ('/',CHNEW,1,NNEW)
-
- IF (JSLO.NE.JSLN) GO TO 41
- IF (CHOLD(1:JSLN).NE.CHNEW(1:JSLN)) GO TO 41
-
-C---- Rename file
-
- NLEAFLG = NNEW - JSLN
- IF (NLEAFLG.LE.0) RETURN
-
- CHLEAF = CHNEW(JSLN+1:JSLN+NLEAFLG)
-
- CALL NAME_$CNAME (CHOLD,NOLDLG,CHLEAF,NLEAFLG,ISTAT)
- 39 RENAME = ISTAT
- RETURN
-
-C---- Copy file
-
- 41 CHNAM = 'cpf'
- CHOP1 = '-r'
- CHOP2 = '-pdt'
-
- NNAMLG = 3
- NOP1LG = 2
- NOP2LG = 4
-
- LARGV(1) = IADDR (CANAM)
- LARGV(2) = IADDR (CAOLD)
- LARGV(3) = IADDR (CANEW)
- LARGV(4) = IADDR (CAOP1)
- LARGV(5) = IADDR (CAOP2)
-
- CALL PGM_$INVOKE ('/com/cpf',INT2(8), INT2(5),LARGV,
- + 0,0, PGM_$WAIT, IHDL, ISTAT)
- RENAME = ISTAT
- IF (ISTAT.NE.0) RETURN
-
-C-- delete the original
-
- CALL NAME_$DELETE_FILE (CHOLD,NOLDLG,ISTAT)
- RETURN
- END
-#ifdef CERNLIB_CCGEN_RENAME
-#undef CERNLIB_CCGEN_RENAME
-#endif
-#ifdef CERNLIB_TCGEN_RENAME
-#undef CERNLIB_TCGEN_RENAME
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/Imakefile b/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/Imakefile
deleted file mode 100644
index dc0ce36..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/Imakefile
+++ /dev/null
@@ -1,14 +0,0 @@
-SRCS_F= \ @@\
- btest.F cbyt.F iandetc.F ibclr.F ibset.F incbyt.F ishft.F iuforw.F \ @@\
- jbit.F jbyt.F jbytet.F jbytor.F jrsbyt.F kerngt.F locb.F locbyt.F \ @@\
- locf.F lvmaxa.F mbytet.F mbytor.F mcbyt.F msbit.F msbit0.F msbit1.F \ @@\
- msbyt.F pkbyt.F rndm.F sbit.F sbit0.F sbit1.F sbyt.F sbytor.F \ @@\
- ublow.F ubunch.F ucopiv.F ucopy.F ucopy2.F uctoh.F uctoh1.F \ @@\
- ufill.F uh1toc.F uhtoc.F upkbyt.F uswop.F uzero.F vadd.F vbias.F \ @@\
- vblank.F vcopyn.F vdot.F vdotn.F vdotn2.F vfill.F vlinco.F vmatl.F \ @@\
- vmatr.F vmaxa.F vmod.F vscale.F vsub.F vsum.F vzero.F
-
-SRCS_C= \ @@\
- lenocc.c
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/btest.F b/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/btest.F
deleted file mode 100644
index fa1238f..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/btest.F
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: btest.F,v 1.1.1.1 1996/02/15 17:51:01 mclareni Exp $
-*
-* $Log: btest.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:01 mclareni
-* Kernlib
-*
-*
-#include "kernapo/pilot.h"
- LOGICAL FUNCTION BTEST (I,N)
-C
-C CERN PROGLIB# M441 BTEST .VERSION KERNAPO 1.10 870524
-C ORIG. 01/10/85 T.LINDELOF, corrected 19/05/87
-C
-C APOLLO VERSION OF ANSI/ISA FUNCTION BTEST
-C N IS THE BIT TO BE TESTED
-C
- BTEST = AND(I, LSHFT(1, N)) .NE. 0
- END
-#ifdef CERNLIB_TCGEN_BTEST
-#undef CERNLIB_TCGEN_BTEST
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/cbyt.F b/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/cbyt.F
deleted file mode 100644
index 7fef247..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/cbyt.F
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: cbyt.F,v 1.1.1.1 1996/02/15 17:51:01 mclareni Exp $
-*
-* $Log: cbyt.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:01 mclareni
-* Kernlib
-*
-*
-#include "kernapo/pilot.h"
- SUBROUTINE CBYT (MZ,IZQ,IZW,IZP,NZB)
-C
-C CERN PROGLIB# M421 CBYT .VERSION KERNAPO 1.15 881020
-C ORIG. 14/12/83 JZ
-C
-C
- MASK = LSHFT (RSHFT(INT4(-1),32-NZB), IZP-1)
- IZW = OR ( AND(NOT(MASK),IZW),
- + AND(MASK,LSHFT(RSHFT(MZ,IZQ-1),IZP-1)))
- RETURN
- END
-#ifdef CERNLIB_TCGEN_CBYT
-#undef CERNLIB_TCGEN_CBYT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/iandetc.F b/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/iandetc.F
deleted file mode 100644
index 45203b8..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/iandetc.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: iandetc.F,v 1.1.1.1 1996/02/15 17:51:01 mclareni Exp $
-*
-* $Log: iandetc.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:01 mclareni
-* Kernlib
-*
-*
-#include "kernapo/pilot.h"
- FUNCTION IAND (I,J)
-C
-C CERN PROGLIB# M441 IANDETC .VERSION KERNAPO 1.10 870524
-C ORIG. 01/10/85 T.LINDELOF
-C
-C APOLLO versions of functions IAND, IOR, IEOR
-
- IAND = AND(I,J)
- END
- FUNCTION IOR (I,J)
-
- IOR = OR(I,J)
- END
- FUNCTION IEOR (I,J)
-
- IEOR = XOR(I,J)
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/ibclr.F b/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/ibclr.F
deleted file mode 100644
index bdb3231..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/ibclr.F
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: ibclr.F,v 1.1.1.1 1996/02/15 17:51:02 mclareni Exp $
-*
-* $Log: ibclr.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:02 mclareni
-* Kernlib
-*
-*
-#include "kernapo/pilot.h"
- FUNCTION IBCLR (I,N)
-C
-C CERN PROGLIB# M441 IBCLR .VERSION KERNAPO 1.10 870524
-C ORIG. 01/10/85 T.LINDELOF
-C
-C APOLLO VERSION OF ANSI/ISA FUNCTION IBCLR
-C N IS THE POSTION OF THE BIT TO BE CLEARED
-C
- IBCLR = AND(I, NOT(LSHFT(1, N)))
- END
-#ifdef CERNLIB_TCGEN_IBCLR
-#undef CERNLIB_TCGEN_IBCLR
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/ibset.F b/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/ibset.F
deleted file mode 100644
index fe7f1fe..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/ibset.F
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: ibset.F,v 1.1.1.1 1996/02/15 17:51:02 mclareni Exp $
-*
-* $Log: ibset.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:02 mclareni
-* Kernlib
-*
-*
-#include "kernapo/pilot.h"
- FUNCTION IBSET (I,N)
-C
-C CERN PROGLIB# M441 IBSET .VERSION KERNAPO 1.10 870524
-C ORIG. 01/10/85 T.LINDELOF
-C
-C APOLLO VERSION OF ANSI/ISA FUNCTION IBSET
-C N IS THE POSITION OF THE BIT TO BE SET
-C
- IBSET = OR(I, LSHFT(1, N))
- END
-#ifdef CERNLIB_TCGEN_IBSET
-#undef CERNLIB_TCGEN_IBSET
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/incbyt.F b/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/incbyt.F
deleted file mode 100644
index 347c6d8..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/incbyt.F
+++ /dev/null
@@ -1,44 +0,0 @@
-*
-* $Id: incbyt.F,v 1.1.1.1 1996/02/15 17:51:02 mclareni Exp $
-*
-* $Log: incbyt.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:02 mclareni
-* Kernlib
-*
-*
-#include "kernapo/pilot.h"
- FUNCTION INCBYT (INCP,IA,JTHP,NBITS)
-C
-C CERN PROGLIB# M423 INCBYT .VERSION KERNAPO 1.01 831216
-C ORIG. 14/12/83 JZ
-C
- DIMENSION INCP(9),IA(99),JTHP(9),NBITS(3)
-C
-C
- INC = INCP(1)
- JTH = JTHP(1)
- NZB = NBITS(1)
- NPW = NBITS(2)
- NPB = NBITS(3)
-
- INCBYT = 0
-
- JWORD= (JTH-1)/NPW + 1
- JPOS = JTH - (JWORD-1)*NPW
- NL = (JPOS-1)*NZB
- MASK = LSHFT (RSHFT(INT4(-1),32-NZB),NL)
-
- IZW = IA(JWORD)
- NEW = INC + RSHFT (AND(MASK,IZW),NL)
- IF (NEW.GT.NPB) GO TO 21
- 17 IA(JWORD) = OR (AND(NOT(MASK),IZW), LSHFT(NEW,NL))
- RETURN
-C
- 21 INCBYT = NEW - NPB
- IF (INCBYT.EQ.INC) RETURN
- NEW = NPB
- GO TO 17
- END
-#ifdef CERNLIB_TCGEN_INCBYT
-#undef CERNLIB_TCGEN_INCBYT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/ishft.F b/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/ishft.F
deleted file mode 100644
index ee12dca..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/ishft.F
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: ishft.F,v 1.1.1.1 1996/02/15 17:51:02 mclareni Exp $
-*
-* $Log: ishft.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:02 mclareni
-* Kernlib
-*
-*
-#include "kernapo/pilot.h"
- FUNCTION ISHFT (I,K)
-C
-C CERN PROGLIB# M441 ISHFT .VERSION KERNAPO 1.10 870524
-C ORIG. 01/10/85 T.LINDELOF
-C
-C APOLLO VERSION OF ANSI/ISA FUNCTION ISHFT
-C K IS THE SHIFT COUNT - NEGATIVE TO THE RIGHT
-C POSITIVE TO THE LEFT
-C
- IF (K.GT.0) THEN
- ISHFT = LSHFT(I, K)
- ELSEIF (K.LT.0) THEN
- ISHFT = RSHFT(I, -K)
- ELSE
- ISHFT = I
- ENDIF
- END
-#ifdef CERNLIB_TCGEN_ISHFT
-#undef CERNLIB_TCGEN_ISHFT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/iuforw.F b/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/iuforw.F
deleted file mode 100644
index 2afb563..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/iuforw.F
+++ /dev/null
@@ -1,38 +0,0 @@
-*
-* $Id: iuforw.F,v 1.1.1.1 1996/02/15 17:51:02 mclareni Exp $
-*
-* $Log: iuforw.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:02 mclareni
-* Kernlib
-*
-*
-#include "kernapo/pilot.h"
- FUNCTION IUFORW (IC,JL,JR)
-C
-C CERN PROGLIB# M410 IUFORW .VERSION KERNAPO 1.00 831212
-C ORIG. 12/12/83 JZ
-C
- DIMENSION IC(99)
- COMMON /SLATE/ ND,JEND, DUMMY(38)
-
- ND = 0
- JEND = JL
- IVAL = 0
-
- 12 IF (JEND.GT.JR) GO TO 20
- K = RSHFT (IC(JEND),24)
- IF (K.EQ.32) GO TO 19
- IF (K.GE.58) GO TO 20
- K = K - 48
- IF (K.LT.0) GO TO 20
- IVAL = 10*IVAL + K
- ND = ND + 1
- 19 JEND = JEND + 1
- GO TO 12
-
- 20 IUFORW = IVAL
- RETURN
- END
-#ifdef CERNLIB_TCGEN_IUFORW
-#undef CERNLIB_TCGEN_IUFORW
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/jbit.F b/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/jbit.F
deleted file mode 100644
index 729a545..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/jbit.F
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: jbit.F,v 1.1.1.1 1996/02/15 17:51:02 mclareni Exp $
-*
-* $Log: jbit.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:02 mclareni
-* Kernlib
-*
-*
-#include "kernapo/pilot.h"
- FUNCTION JBIT (IZW,IZP)
-C
-C CERN PROGLIB# M421 JBIT .VERSION KERNAPO 1.00 831212
-C ORIG. 12/12/83 JZ
-C
- JBIT = AND (RSHFT(IZW,IZP-1), 1)
- RETURN
- END
-#ifdef CERNLIB_TCGEN_JBIT
-#undef CERNLIB_TCGEN_JBIT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/jbyt.F b/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/jbyt.F
deleted file mode 100644
index dcafd04..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/jbyt.F
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: jbyt.F,v 1.1.1.1 1996/02/15 17:51:02 mclareni Exp $
-*
-* $Log: jbyt.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:02 mclareni
-* Kernlib
-*
-*
-#include "kernapo/pilot.h"
- FUNCTION JBYT (IZW,IZP,NZB)
-C
-C CERN PROGLIB# M421 JBYT .VERSION KERNAPO 1.08 860429
-C ORIG. 12/12/83 JZ
-C
- JBYT = RSHFT (LSHFT(IZW,33-IZP-NZB),32-NZB)
- RETURN
- END
-#ifdef CERNLIB_TCGEN_JBYT
-#undef CERNLIB_TCGEN_JBYT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/jbytet.F b/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/jbytet.F
deleted file mode 100644
index 0c81a64..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/jbytet.F
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: jbytet.F,v 1.1.1.1 1996/02/15 17:51:03 mclareni Exp $
-*
-* $Log: jbytet.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:03 mclareni
-* Kernlib
-*
-*
-#include "kernapo/pilot.h"
- FUNCTION JBYTET (MZ,IZW,IZP,NZB)
-C
-C CERN PROGLIB# M421 JBYTET .VERSION KERNAPO 1.08 860429
-C ORIG. 12/12/83 JZ
-C
- JBYTET = AND (MZ, RSHFT (LSHFT(IZW,33-IZP-NZB),32-NZB) )
- RETURN
- END
-#ifdef CERNLIB_TCGEN_JBYTET
-#undef CERNLIB_TCGEN_JBYTET
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/jbytor.F b/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/jbytor.F
deleted file mode 100644
index cff212f..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/jbytor.F
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: jbytor.F,v 1.1.1.1 1996/02/15 17:51:03 mclareni Exp $
-*
-* $Log: jbytor.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:03 mclareni
-* Kernlib
-*
-*
-#include "kernapo/pilot.h"
- FUNCTION JBYTOR (MZ,IZW,IZP,NZB)
-C
-C CERN PROGLIB# M421 JBYTOR .VERSION KERNAPO 1.10 870524
-C ORIG. 19/05/87 JZ
-C
- JBYTOR = OR (MZ, RSHFT (LSHFT(IZW,33-IZP-NZB),32-NZB) )
- RETURN
- END
-#ifdef CERNLIB_TCGEN_JBYTOR
-#undef CERNLIB_TCGEN_JBYTOR
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/jrsbyt.F b/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/jrsbyt.F
deleted file mode 100644
index 7ae5983..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/jrsbyt.F
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: jrsbyt.F,v 1.1.1.1 1996/02/15 17:51:03 mclareni Exp $
-*
-* $Log: jrsbyt.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:03 mclareni
-* Kernlib
-*
-*
-#include "kernapo/pilot.h"
- FUNCTION JRSBYT (IT,IZW,IZP,NZB)
-C
-C CERN PROGLIB# M421 JRSBYT .VERSION KERNAPO 1.01 831216
-C ORIG. 14/12/83 JZ
-C
-
- MASK = LSHFT (RSHFT(INT4(-1),32-NZB), IZP-1)
- JRSBYT = RSHFT (AND(MASK,IZW),IZP-1)
- IZW = OR (AND(NOT(MASK),IZW), AND(MASK,LSHFT(IT,IZP-1)))
- RETURN
- END
-#ifdef CERNLIB_TCGEN_JRSBYT
-#undef CERNLIB_TCGEN_JRSBYT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/kerngt.F b/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/kerngt.F
deleted file mode 100644
index 6c9e47f..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/kerngt.F
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: kerngt.F,v 1.1.1.1 1996/02/15 17:51:01 mclareni Exp $
-*
-* $Log: kerngt.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:01 mclareni
-* Kernlib
-*
-*
-#include "kernapo/pilot.h"
- SUBROUTINE KERNGT (LUN)
-C
-C CERN PROGLIB# Z001 KERNGT .VERSION KERNAPO 1.16 890321
-C ORIG. 16/03/89 JZ
-C
-C-- Store Pam title into /SLATE/ for printing by GSHOWF
-C
- COMMON /SLATE/ MCH(40)
-
- CALL UCTOH1 (
- + CPP_TITLE_CH
- + // ' '
- +, MCH,40)
- CALL GSHOWF (LUN)
- RETURN
- END
-#ifdef CERNLIB_TCGEN_KERNGT
-#undef CERNLIB_TCGEN_KERNGT
-#endif
-#include "kernapo/TITLE.kernapo"
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/lenocc.c b/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/lenocc.c
deleted file mode 100644
index ae8be39..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/lenocc.c
+++ /dev/null
@@ -1,72 +0,0 @@
-/*
- * $Id: lenocc.c,v 1.1.1.1 1996/02/15 17:51:03 mclareni Exp $
- *
- * $Log: lenocc.c,v $
- * Revision 1.1.1.1 1996/02/15 17:51:03 mclareni
- * Kernlib
- *
- */
-#include "kernapo/pilot.h"
-/*> ROUTINE LENOCC
- CERN PROGLIB# M507 LENOCC .VERSION KERNAPO 1.25 921121
- ORIG. 30/04/92, RDM + JZ
-
- N = LENOCC (CHLINE) find last non-blank character in CHLINE
-*/
-#if defined(CERNLIB_QF_APO77)
- int lenocc_(chline, len)
- char *chline;
- int len;
-#endif
-#if defined(CERNLIB_QF_APO)
- int lenocc(chline, lenpar)
- char *chline;
- short *lenpar;
-#endif
-{
- static unsigned int blnk = 0x20202020;
- unsigned int *wdcur;
- char *chcur;
- int ntail, i;
-#if defined(CERNLIB_QF_APO)
- int len;
-
- len = *lenpar;
-#endif
- chcur = chline + len;
- if (len <= 24) goto small;
-
-/* ---- handle long string */
-
-/* look at the last ntail characters */
-
- ntail = ((int)chcur & 3);
- for (i = ntail; i > 0; i--)
- { if (*--chcur != ' ') goto exit; }
-
-/* look for trailing blank words */
-
- wdcur = (unsigned int*) (chcur-4);
- while (wdcur >= (unsigned int*)chline )
- { if (*wdcur != blnk) break; wdcur--; }
-
-/* find last non-blank character */
-
- chcur = (char*) (wdcur+1);
- while (chcur > chline)
- { if (*--chcur != ' ') goto exit; }
- return 0;
-
-exit: return chcur+1 - chline;
-
-/* ---- handle short string */
-
-small:
- while (chcur > chline)
- { if (*--chcur != ' ') goto exit; }
- return 0;
-}
-/*> END <----------------------------------------------------------*/
-#ifdef CERNLIB_TCGEN_LENOCC
-#undef CERNLIB_TCGEN_LENOCC
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/locb.F b/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/locb.F
deleted file mode 100644
index ca0ad46..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/locb.F
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: locb.F,v 1.1.1.1 1996/02/15 17:51:03 mclareni Exp $
-*
-* $Log: locb.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:03 mclareni
-* Kernlib
-*
-*
-#include "kernapo/pilot.h"
- FUNCTION LOCB (AM)
-C
-C CERN PROGLIB# N100 LOCB .VERSION KERNAPO 1.19 891207
-C ORIG. 11/11/89 JZ
-C
- DIMENSION AM(9)
-
- LOCB= IADDR(AM(1))
- RETURN
- END
-#ifdef CERNLIB_CCGEN_LOCB
-#undef CERNLIB_CCGEN_LOCB
-#endif
-#ifdef CERNLIB_TCGEN_LOCB
-#undef CERNLIB_TCGEN_LOCB
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/locbyt.F b/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/locbyt.F
deleted file mode 100644
index 3924c4d..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/locbyt.F
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: locbyt.F,v 1.1.1.1 1996/02/15 17:51:03 mclareni Exp $
-*
-* $Log: locbyt.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:03 mclareni
-* Kernlib
-*
-*
-#include "kernapo/pilot.h"
- FUNCTION LOCBYT (IT,IA,N,NW,LA,NBITS)
-C
-C CERN PROGLIB# M428 LOCBYT .VERSION KERNAPO 1.01 831216
-C ORIG. 14/12/83 JZ
-C
- DIMENSION IA(9)
-C
-C
- IF (N.EQ.0) GO TO 19
- MASK = LSHFT (RSHFT(INT4(-1),32-NBITS),LA-1)
- ITSH = LSHFT (IT,LA-1)
-
- DO 18 J=1,N,NW
- IF (AND(IA(J),MASK).EQ.ITSH) GO TO 21
- 18 CONTINUE
- 19 LOCBYT= 0
- RETURN
-C
- 21 LOCBYT= J
- RETURN
- END
-#ifdef CERNLIB_TCGEN_LOCBYT
-#undef CERNLIB_TCGEN_LOCBYT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/locf.F b/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/locf.F
deleted file mode 100644
index 6c5e9c5..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/locf.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: locf.F,v 1.1.1.1 1996/02/15 17:51:03 mclareni Exp $
-*
-* $Log: locf.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:03 mclareni
-* Kernlib
-*
-*
-#include "kernapo/pilot.h"
- FUNCTION LOCF (AM)
-C
-C CERN PROGLIB# N100 LOCF .VERSION KERNAPO 1.16 890321
-C ORIG. 13/12/83 T. LINDELOF
-C Mod. 14/02/89 JZ, to be usable also on DN 10000
-C
- DIMENSION AM(9)
-
- LOCF= RSHFT (IADDR(AM(1)), 2)
- RETURN
- END
-#ifdef CERNLIB_CCGEN_LOCF
-#undef CERNLIB_CCGEN_LOCF
-#endif
-#ifdef CERNLIB_TCGEN_LOCF
-#undef CERNLIB_TCGEN_LOCF
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/lvmaxa.F b/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/lvmaxa.F
deleted file mode 100644
index 88deef0..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/lvmaxa.F
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: lvmaxa.F,v 1.1.1.1 1996/02/15 17:51:03 mclareni Exp $
-*
-* $Log: lvmaxa.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:03 mclareni
-* Kernlib
-*
-*
-#include "kernapo/pilot.h"
- FUNCTION LVMAXA (A,N)
-C
-C CERN PROGLIB# F121 LVMAXA .VERSION KERNAPO 1.17 890626
-C ORIG. 29/05/89 F.Carminati
-C
- DIMENSION A(*)
-
- IF (N.GT.0) THEN
- CALL VEC_$MAX (A,N,HMAX,IMAX)
- LVMAXA = IMAX
- RETURN
- ENDIF
- LVMAXA = 0
- RETURN
- END
-#ifdef CERNLIB_TCGEN_LVMAXA
-#undef CERNLIB_TCGEN_LVMAXA
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/mbytet.F b/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/mbytet.F
deleted file mode 100644
index d352c22..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/mbytet.F
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: mbytet.F,v 1.1.1.1 1996/02/15 17:51:03 mclareni Exp $
-*
-* $Log: mbytet.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:03 mclareni
-* Kernlib
-*
-*
-#include "kernapo/pilot.h"
- FUNCTION MBYTET (MZ,IZW,IZP,NZB)
-C
-C CERN PROGLIB# M421 MBYTET .VERSION KERNAPO 1.10 870524
-C ORIG. 19/05/87 JZ
-C
-
- MBYTET = AND (IZW,
- + NOT(RSHFT (LSHFT(NOT(MZ),32-NZB), 33-IZP-NZB)) )
- RETURN
- END
-#ifdef CERNLIB_TCGEN_MBYTET
-#undef CERNLIB_TCGEN_MBYTET
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/mbytor.F b/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/mbytor.F
deleted file mode 100644
index 2421bf0..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/mbytor.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: mbytor.F,v 1.1.1.1 1996/02/15 17:51:03 mclareni Exp $
-*
-* $Log: mbytor.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:03 mclareni
-* Kernlib
-*
-*
-#include "kernapo/pilot.h"
- FUNCTION MBYTOR (MZ,IZW,IZP,NZB)
-C
-C CERN PROGLIB# M421 MBYTOR .VERSION KERNAPO 1.10 870524
-C ORIG. 19/05/87 JZ
-C
-
- MBYTOR = OR (IZW, RSHFT (LSHFT(MZ,32-NZB), 33-IZP-NZB) )
- RETURN
- END
-#ifdef CERNLIB_TCGEN_MBYTOR
-#undef CERNLIB_TCGEN_MBYTOR
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/mcbyt.F b/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/mcbyt.F
deleted file mode 100644
index 6a8ae41..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/mcbyt.F
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: mcbyt.F,v 1.1.1.1 1996/02/15 17:51:04 mclareni Exp $
-*
-* $Log: mcbyt.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:04 mclareni
-* Kernlib
-*
-*
-#include "kernapo/pilot.h"
- FUNCTION MCBYT (MZ,IZQ,IZW,IZP,NZB)
-C
-C CERN PROGLIB# M421 MCBYT .VERSION KERNAPO 1.10 870524
-C ORIG. 19/05/87 JZ
-C
-
- MCBYT = OR ( AND (IZW
- + , NOT(LSHFT (RSHFT(NOT(INT4(0)),32-NZB), IZP-1)))
- + , RSHFT (LSHFT(RSHFT(MZ,IZQ-1),32-NZB), 33-IZP-NZB))
- RETURN
- END
-#ifdef CERNLIB_TCGEN_MCBYT
-#undef CERNLIB_TCGEN_MCBYT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/msbit.F b/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/msbit.F
deleted file mode 100644
index fdbdb5f..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/msbit.F
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: msbit.F,v 1.1.1.1 1996/02/15 17:51:04 mclareni Exp $
-*
-* $Log: msbit.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:04 mclareni
-* Kernlib
-*
-*
-#include "kernapo/pilot.h"
- FUNCTION MSBIT (MZ,IZW,IZP)
-C
-C CERN PROGLIB# M421 MSBIT .VERSION KERNAPO 1.10 870524
-C ORIG. 19/05/87 JZ
-C
-
- MSBIT = OR (AND (IZW, NOT(LSHFT(1,IZP-1)) )
- + , LSHFT(AND(MZ,1),IZP-1) )
- RETURN
- END
-#ifdef CERNLIB_TCGEN_MSBIT
-#undef CERNLIB_TCGEN_MSBIT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/msbit0.F b/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/msbit0.F
deleted file mode 100644
index 10209e9..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/msbit0.F
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: msbit0.F,v 1.1.1.1 1996/02/15 17:51:04 mclareni Exp $
-*
-* $Log: msbit0.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:04 mclareni
-* Kernlib
-*
-*
-#include "kernapo/pilot.h"
- FUNCTION MSBIT0 (IZW,IZP)
-C
-C CERN PROGLIB# M421 MSBIT0 .VERSION KERNAPO 1.10 870524
-C ORIG. 19/05/87 JZ
-C
- MSBIT0 = AND (IZW, NOT(LSHFT(1,IZP-1)))
- RETURN
- END
-#ifdef CERNLIB_TCGEN_MSBIT0
-#undef CERNLIB_TCGEN_MSBIT0
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/msbit1.F b/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/msbit1.F
deleted file mode 100644
index 84646c4..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/msbit1.F
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: msbit1.F,v 1.1.1.1 1996/02/15 17:51:04 mclareni Exp $
-*
-* $Log: msbit1.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:04 mclareni
-* Kernlib
-*
-*
-#include "kernapo/pilot.h"
- FUNCTION MSBIT1 (IZW,IZP)
-C
-C CERN PROGLIB# M421 MSBIT1 .VERSION KERNAPO 1.10 870524
-C ORIG. 19/05/87 JZ
-C
- MSBIT1 = OR (IZW, LSHFT(1,IZP-1))
- RETURN
- END
-#ifdef CERNLIB_TCGEN_MSBIT1
-#undef CERNLIB_TCGEN_MSBIT1
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/msbyt.F b/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/msbyt.F
deleted file mode 100644
index 32a3eff..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/msbyt.F
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: msbyt.F,v 1.1.1.1 1996/02/15 17:51:04 mclareni Exp $
-*
-* $Log: msbyt.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:04 mclareni
-* Kernlib
-*
-*
-#include "kernapo/pilot.h"
- FUNCTION MSBYT (MZ,IZW,IZP,NZB)
-C
-C CERN PROGLIB# M421 MSBYT .VERSION KERNAPO 1.10 870524
-C ORIG. 19/05/87 JZ
-C
-
- MSBYT = OR ( AND (IZW
- + , NOT(LSHFT (RSHFT(NOT(INT4(0)),32-NZB), IZP-1)))
- + , RSHFT (LSHFT(MZ,32-NZB), 33-IZP-NZB) )
- RETURN
- END
-#ifdef CERNLIB_TCGEN_MSBYT
-#undef CERNLIB_TCGEN_MSBYT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/pkbyt.F b/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/pkbyt.F
deleted file mode 100644
index d2aff5c..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/pkbyt.F
+++ /dev/null
@@ -1,66 +0,0 @@
-*
-* $Id: pkbyt.F,v 1.1.1.1 1996/02/15 17:51:05 mclareni Exp $
-*
-* $Log: pkbyt.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:05 mclareni
-* Kernlib
-*
-*
-#include "kernapo/pilot.h"
- SUBROUTINE PKBYT (MIV,MBV,JTHP,NINTP,NBITS)
-C
-C CERN PROGLIB# M422 PKBYT .VERSION KERNAPO 1.01 831216
-C ORIG. 16/12/83 JZ
-C
- DIMENSION MIV(99), MBV(99), JTHP(9), NINTP(9), NBITS(2)
-
-
- JTH = JTHP(1)
- NINT = NINTP(1)
- IF (NINT.LE.0) RETURN
-
- NZB = NBITS(1)
- IF (NZB.GT.0) GO TO 11
- NZB = 1
- NPWD = 32
- MASK = 1
- GO TO 12
-
- 11 NPWD = NBITS(2)
- MASK = RSHFT (INT4(-1),32-NZB)
-
- 12 JBV = 1
- JIV = 0
- IF (JTH.LT.2) GO TO 21
- JBV = (JTH-1)/NPWD + 1
- JPOS = JTH - (JBV-1)*NPWD - 1
- IF (JPOS.EQ.0) GO TO 21
- NL = JPOS*NZB
- MSKU = LSHFT (MASK,NL)
- JIVE = NPWD - JPOS
- GO TO 22
-
-C-- PACK EACH WORD
-
- 21 NL = 0
- MSKU = MASK
- JIVE = JIV + NPWD
- 22 JIVE = MIN0 (NINT,JIVE)
- IZW = MBV(JBV)
-
- 24 JIV = JIV + 1
- IZW = OR (AND(NOT(MSKU),IZW),
- + AND(MSKU,LSHFT(MIV(JIV),NL)))
- IF (JIV.EQ.JIVE) GO TO 27
- NL = NL + NZB
- MSKU = LSHFT (MSKU,NZB)
- GO TO 24
-
- 27 MBV(JBV) = IZW
- IF (JIV.EQ.NINT) RETURN
- JBV = JBV + 1
- GO TO 21
- END
-#ifdef CERNLIB_TCGEN_PKBYT
-#undef CERNLIB_TCGEN_PKBYT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/rndm.F b/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/rndm.F
deleted file mode 100644
index 2d65e24..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/rndm.F
+++ /dev/null
@@ -1,60 +0,0 @@
-*
-* $Id: rndm.F,v 1.1.1.1 1996/02/15 17:51:05 mclareni Exp $
-*
-* $Log: rndm.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:05 mclareni
-* Kernlib
-*
-*
-#include "kernapo/pilot.h"
- FUNCTION RNDM (ISEED)
-C
-C CERN PROGLIB# V104 RNDM .VERSION KERNAPO 1.19 891207
-C ORIG. 22-mar-88 JZ from IBM version of G.Marsaglia et al., Montreal
-C CORR. 13-july-88, JZ, avoid exact zero
-C CORR. 13-oct-88, JZ, correct multiplier
-C CORR. 11-nov-89, JZ, correct result from IRNDM
-C
-C- Uniform Random Number Generator,
-C- giving the same sequence as the IBM and VAX version
-
- EQUIVALENCE (AMAN,MANT)
- SAVE MCGN
- DATA MCGN /12345/
-
- MCGN = MCGN * 69069
- MANT = RSHFT (MCGN,8)
- IF (MANT.EQ.0) GO TO 14
- AMAN = MANT
-C- AMAN in the range 1 to 2**24-1
- MANT = MANT - 16#0C000000
-C- multiply by 2.**(-24)
- RNDM = AMAN
- RETURN
-
-C-- for zero set RNDM = 2.**(-25)
- 14 MANT = 16#33000000
- RNDM = AMAN
- RETURN
-
-C-- Integer random number
- ENTRY IRNDM (ISEED)
- MCGN = MCGN * 69069
- IRNDM = RSHFT (MCGN,1)
- RETURN
-
-C-- Set the seed
- ENTRY RDMIN (ISEED)
- MCGN = ISEED
- RETURN
-
-C-- Get the seed
- ENTRY RDMOUT (ISEED)
- ISEED = MCGN
- END
-#ifdef CERNLIB_TCGEN_RNDM
-#undef CERNLIB_TCGEN_RNDM
-#endif
-#ifdef CERNLIB_TCGEN_IRNDM
-#undef CERNLIB_TCGEN_IRNDM
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/sbit.F b/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/sbit.F
deleted file mode 100644
index 58e9f7f..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/sbit.F
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: sbit.F,v 1.1.1.1 1996/02/15 17:51:05 mclareni Exp $
-*
-* $Log: sbit.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:05 mclareni
-* Kernlib
-*
-*
-#include "kernapo/pilot.h"
- SUBROUTINE SBIT (IT,IZW,IZP)
-C
-C CERN PROGLIB# M421 SBIT .VERSION KERNAPO 1.00 831212
-C ORIG. 12/12/83 JZ
-C
-
- IZW = OR (AND(NOT(LSHFT(1,IZP-1)),IZW),
- + LSHFT(AND(IT,1),IZP-1))
- RETURN
- END
-#ifdef CERNLIB_TCGEN_SBIT
-#undef CERNLIB_TCGEN_SBIT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/sbit0.F b/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/sbit0.F
deleted file mode 100644
index d25e25d..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/sbit0.F
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: sbit0.F,v 1.1.1.1 1996/02/15 17:51:05 mclareni Exp $
-*
-* $Log: sbit0.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:05 mclareni
-* Kernlib
-*
-*
-#include "kernapo/pilot.h"
- SUBROUTINE SBIT0 (IZW,IZP)
-C
-C CERN PROGLIB# M421 SBIT0 .VERSION KERNAPO 1.00 831212
-C ORIG. 12/12/83 JZ
-C
- IZW = AND (IZW, NOT(LSHFT(1,IZP-1)))
- RETURN
- END
-#ifdef CERNLIB_TCGEN_SBIT0
-#undef CERNLIB_TCGEN_SBIT0
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/sbit1.F b/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/sbit1.F
deleted file mode 100644
index 4e3c357..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/sbit1.F
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: sbit1.F,v 1.1.1.1 1996/02/15 17:51:05 mclareni Exp $
-*
-* $Log: sbit1.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:05 mclareni
-* Kernlib
-*
-*
-#include "kernapo/pilot.h"
- SUBROUTINE SBIT1 (IZW,IZP)
-C
-C CERN PROGLIB# M421 SBIT1 .VERSION KERNAPO 1.00 831212
-C ORIG. 12/12/83 JZ
-C
- IZW = OR (IZW, LSHFT(1,IZP-1))
- RETURN
- END
-#ifdef CERNLIB_TCGEN_SBIT1
-#undef CERNLIB_TCGEN_SBIT1
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/sbyt.F b/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/sbyt.F
deleted file mode 100644
index 24dbc3c..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/sbyt.F
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: sbyt.F,v 1.1.1.1 1996/02/15 17:51:05 mclareni Exp $
-*
-* $Log: sbyt.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:05 mclareni
-* Kernlib
-*
-*
-#include "kernapo/pilot.h"
- SUBROUTINE SBYT (IT,IZW,IZP,NZB)
-C
-C CERN PROGLIB# M421 SBYT .VERSION KERNAPO 1.00 831212
-C ORIG. 12/12/83 JZ
-C
- MASK = LSHFT (RSHFT(INT4(-1),32-NZB), IZP-1)
-
- IZW = OR (AND(NOT(MASK),IZW), AND(MASK,LSHFT(IT,IZP-1)))
- RETURN
- END
-#ifdef CERNLIB_TCGEN_SBYT
-#undef CERNLIB_TCGEN_SBYT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/sbytor.F b/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/sbytor.F
deleted file mode 100644
index 74a0954..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/sbytor.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: sbytor.F,v 1.1.1.1 1996/02/15 17:51:05 mclareni Exp $
-*
-* $Log: sbytor.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:05 mclareni
-* Kernlib
-*
-*
-#include "kernapo/pilot.h"
- SUBROUTINE SBYTOR (IT,IZW,IZP,NZB)
-C
-C CERN PROGLIB# M421 SBYTOR .VERSION KERNAPO 1.00 831212
-C ORIG. 12/12/83 JZ
-C
-
- IZW = OR (IZW, LSHFT(AND(RSHFT(INT4(-1),32-NZB),IT), IZP-1))
- RETURN
- END
-#ifdef CERNLIB_TCGEN_SBYTOR
-#undef CERNLIB_TCGEN_SBYTOR
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/ublow.F b/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/ublow.F
deleted file mode 100644
index 2af5030..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/ublow.F
+++ /dev/null
@@ -1,54 +0,0 @@
-*
-* $Id: ublow.F,v 1.1.1.1 1996/02/15 17:51:05 mclareni Exp $
-*
-* $Log: ublow.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:05 mclareni
-* Kernlib
-*
-*
-#include "kernapo/pilot.h"
- SUBROUTINE UBLOW (MS,MT,NCHP)
-C
-C CERN PROGLIB# M409 UBLOW .VERSION KERNAPO 1.11 880222
-C ORIG. 12/12/83 JZ, modif. 15/2/88 for speed
-C
-
- DIMENSION MS(99), MT(99), NCHP(9)
- PARAMETER (IBLAN1 = 16#00202020)
- PARAMETER (MASK1 = 16#FF000000)
-
-
- NCH = NCHP(1)
- IF (NCH) 91, 29, 11
- 11 NWS = RSHFT (NCH,2)
- NTRAIL = AND (NCH,3)
- JT = 0
- IF (NWS.EQ.0) GO TO 26
-
-C-- Unpack the initial complete words
-
- DO 24 JS=1,NWS
- MWD = MS(JS)
- MT(JT+1) = OR (IBLAN1,AND(MASK1,MWD))
- MT(JT+2) = OR (IBLAN1,AND(MASK1,LSHFT(MWD, 8)))
- MT(JT+3) = OR (IBLAN1,AND(MASK1,LSHFT(MWD,16)))
- MT(JT+4) = OR (IBLAN1, LSHFT(MWD,24) )
- 24 JT = JT + 4
-
- IF (NTRAIL.EQ.0) RETURN
-
-C-- Unpack the trailing word
-
- 26 MWD = MS(NWS+1)
-
- DO 28 JS=1,NTRAIL
- MT(JT+1) = OR (IBLAN1,AND(MASK1,MWD))
- MWD = LSHFT (MWD,8)
- 28 JT = JT + 1
- 29 RETURN
-
- 91 CALL ABEND
- END
-#ifdef CERNLIB_TCGEN_UBLOW
-#undef CERNLIB_TCGEN_UBLOW
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/ubunch.F b/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/ubunch.F
deleted file mode 100644
index ce5123e..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/ubunch.F
+++ /dev/null
@@ -1,57 +0,0 @@
-*
-* $Id: ubunch.F,v 1.1.1.1 1996/02/15 17:51:05 mclareni Exp $
-*
-* $Log: ubunch.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:05 mclareni
-* Kernlib
-*
-*
-#include "kernapo/pilot.h"
- SUBROUTINE UBUNCH (MS,MT,NCHP)
-C
-C CERN PROGLIB# M409 UBUNCH .VERSION KERNAPO 1.11 880222
-C ORIG. 12/12/83 JZ
-C Mod. 29/03/85 remove entry UH1TOC
-C Mod. 15/02/88 for speed, JZ
-C
-
- DIMENSION MS(99), MT(99), NCHP(9)
- PARAMETER (IBLAN1 = 16#20202020)
- PARAMETER (MASK1 = 16#FF000000)
-
-
- NCH = NCHP(1)
- IF (NCH) 91,39,11
- 11 NWT = RSHFT (NCH,2)
- NTRAIL = AND (NCH,3)
- JS = 0
- IF (NWT.EQ.0) GO TO 31
-
-C-- Pack the initial complete words
-
- DO 24 JT=1,NWT
- MT(JT) = OR (OR (OR (
- + AND(MS(JS+1),MASK1),
- + RSHFT (AND(MS(JS+2),MASK1), 8)),
- + RSHFT (AND(MS(JS+3),MASK1),16)),
- + RSHFT (MS(JS+4), 24) )
- 24 JS = JS + 4
-
- IF (NTRAIL.EQ.0) RETURN
-
-C-- Pack the trailing word
-
- 31 MWD = IBLAN1
- JS = NCH
-
- DO 34 JT=1,NTRAIL
- MWD = OR (RSHFT(MWD,8), AND(MS(JS),MASK1))
- 34 JS = JS - 1
- MT(NWT+1) = MWD
- 39 RETURN
-
- 91 CALL ABEND
- END
-#ifdef CERNLIB_TCGEN_UBUNCH
-#undef CERNLIB_TCGEN_UBUNCH
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/ucopiv.F b/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/ucopiv.F
deleted file mode 100644
index 1c8bd9d..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/ucopiv.F
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: ucopiv.F,v 1.1.1.1 1996/02/15 17:51:06 mclareni Exp $
-*
-* $Log: ucopiv.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:06 mclareni
-* Kernlib
-*
-*
-#include "kernapo/pilot.h"
- SUBROUTINE UCOPIV (A,B,N)
-C
-C CERN PROGLIB# V301 UCOPIV .VERSION KERNAPO 1.17 890531
-C ORIG. 01/07/71
-C MOD 31/05/89 FCA
-C
- DIMENSION A(*), B(*)
-C
- IF (N.GT.0) CALL VEC_$COPY_I (A,1,B(N),-1,N)
- END
-#ifdef CERNLIB_TCGEN_UCOPIV
-#undef CERNLIB_TCGEN_UCOPIV
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/ucopy.F b/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/ucopy.F
deleted file mode 100644
index 84732c5..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/ucopy.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: ucopy.F,v 1.1.1.1 1996/02/15 17:51:06 mclareni Exp $
-*
-* $Log: ucopy.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:06 mclareni
-* Kernlib
-*
-*
-#include "kernapo/pilot.h"
- SUBROUTINE UCOPY (A,B,N)
-C
-C CERN PROGLIB# V301 UCOPY .VERSION KERNAPO 1.24 920511
-C ORIG. 01/03/85 R.BRUN
-C
- INTEGER A(*), B(*)
-
- IF (N.GT.0) CALL VEC_$COPY (A,B,N)
- END
-#ifdef CERNLIB_TCGEN_UCOPY
-#undef CERNLIB_TCGEN_UCOPY
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/ucopy2.F b/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/ucopy2.F
deleted file mode 100644
index 85422da..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/ucopy2.F
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: ucopy2.F,v 1.1.1.1 1996/02/15 17:51:06 mclareni Exp $
-*
-* $Log: ucopy2.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:06 mclareni
-* Kernlib
-*
-*
-#include "kernapo/pilot.h"
- SUBROUTINE UCOPY2 (A,B,N)
-C
-C CERN PROGLIB# V301 UCOPY2 .VERSION KERNAPO 1.04 850321
-C ORIG. 01/03/85 R.BRUN
-C
- DIMENSION A(*),B(*)
-
- IF (N.LE.0) RETURN
- IA=IADDR (A)
- IB=IADDR (B)
- IF (IA-IB) 11, 99, 21
-
-C-- REVERSE LOOP
- 11 CALL VEC_$COPY_I (A (N),-1,B (N),-1,N)
- RETURN
-
-C-- USUAL LOOP
- 21 CALL VEC_$COPY (A,B,N)
- 99 RETURN
- END
-#ifdef CERNLIB_TCGEN_UCOPY2
-#undef CERNLIB_TCGEN_UCOPY2
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/uctoh.F b/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/uctoh.F
deleted file mode 100644
index e1818bf..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/uctoh.F
+++ /dev/null
@@ -1,168 +0,0 @@
-*
-* $Id: uctoh.F,v 1.1.1.1 1996/02/15 17:51:06 mclareni Exp $
-*
-* $Log: uctoh.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:06 mclareni
-* Kernlib
-*
-*
-#include "kernapo/pilot.h"
-#if !defined(CERNLIB_QMAPO10)
- SUBROUTINE UCTOH (MS,MT,NPW,NCHP)
-C
-C CERN PROGLIB# M409 UCTOH .VERSION KERNAPO 1.11 880222
-C ORIG. 10/02/88 JZ
-C
- DIMENSION MS(99), MT(99), NCHP(9)
-
- DIMENSION MWDV(3)
- CHARACTER CHWD*12
- EQUIVALENCE (CHWD,MWDV)
-
- PARAMETER (IBLAN1 = 16#00202020)
- PARAMETER (IBLAN2 = 16#00002020)
- PARAMETER (IBLAN3 = 16#00000020)
- PARAMETER (MASK1 = 16#FF000000)
- PARAMETER (MASK2 = 16#FFFF0000)
- PARAMETER (MASK3 = 16#FFFFFF00)
-
- DIMENSION IBLANK(3), MASK(3)
- DATA IBLANK / 16#00202020, 16#00002020, 16#00000020 /
- DATA MASK / 16#FF000000, 16#FFFF0000, 16#FFFFFF00 /
-
-
- NCH = NCHP(1)
- IF (NCH) 91, 29, 11
- 11 GO TO (21, 31, 41), NPW
-
-C-------- NPW = 4
-
- NWS = RSHFT (NCH,2)
- NTRAIL = AND (NCH,3)
- IF (NWS.EQ.0) GO TO 15
-
- DO 14 J=1,NWS
- 14 MT(J) = MS(J)
- IF (NTRAIL.EQ.0) RETURN
-
- 15 MT(NWS+1) = OR (IBLANK(NTRAIL), AND(MS(NWS+1),MASK(NTRAIL)))
- RETURN
-
-C-------- NPW = 1
-C-- equivalent to 'CALL UCTOH1(MS,MT,NCH)'
-
- 21 NWS = RSHFT (NCH,2)
- NTRAIL = AND (NCH,3)
- JT = 0
- IF (NWS.EQ.0) GO TO 26
-
-C-- Unpack the initial complete words
-
- DO 24 JS=1,NWS
- MWD = MS(JS)
- MT(JT+1) = OR (IBLAN1,AND(MASK1,MWD))
- MT(JT+2) = OR (IBLAN1,AND(MASK1,LSHFT(MWD, 8)))
- MT(JT+3) = OR (IBLAN1,AND(MASK1,LSHFT(MWD,16)))
- MT(JT+4) = OR (IBLAN1, LSHFT(MWD,24) )
- 24 JT = JT + 4
-
- IF (NTRAIL.EQ.0) RETURN
-
-C-- Unpack the trailing word
-
- 26 MWD = MS(NWS+1)
-
- DO 28 JS=1,NTRAIL
- MT(JT+1) = OR (IBLAN1,AND(MASK1,MWD))
- MWD = LSHFT (MWD,8)
- 28 JT = JT + 1
- 29 RETURN
-
-C-------- NPW = 2
-
- 31 NWS = RSHFT (NCH,2)
- NTRAIL = AND (NCH,3)
- JT = 0
- IF (NWS.EQ.0) GO TO 36
-
-C-- Unpack the initial complete words
-
- DO 34 JS=1,NWS
- MWD = MS(JS)
- MT(JT+1) = OR (IBLAN2,AND(MASK2,MWD))
- MT(JT+2) = OR (IBLAN2,LSHFT(MWD,16))
- 34 JT = JT + 2
-
- IF (NTRAIL.EQ.0) RETURN
-
-C-- Unpack the trailing word
-
- 36 MWD = MS(NWS+1)
-
- IF (NTRAIL.EQ.1) THEN
- MT(JT+1) = OR (IBLAN1,AND(MASK1,MWD))
- RETURN
-
- ELSEIF (NTRAIL.EQ.2) THEN
- MT(JT+1) = OR (IBLAN2,AND(MASK2,MWD))
- RETURN
-
- ELSE
- MT(JT+1) = OR (IBLAN2,AND(MASK2,MWD))
- MT(JT+2) = OR (IBLAN1,AND(MASK1,LSHFT(MWD,16)))
- ENDIF
- RETURN
-
-C-------- NPW = 3
-
- 41 NWS = NCH/12
- NTRAIL = NCH - 12*NWS
- JS = 0
- JT = 0
- IF (NWS.EQ.0) GO TO 46
-
-C-- Unpack the initial complete words
-
- DO 44 JL=1,NWS
- MWDV(1) = MS(JS+1)
- MWDV(2) = MS(JS+2)
- MWDV(3) = MS(JS+3)
- MT(JT+1) = OR (IBLAN3,AND(MASK3,MWDV(1)))
- MT(JT+2) = OR (OR (IBLAN3,LSHFT(MWDV(1),24))
- +, RSHFT(AND(MASK2,MWDV(2)),8))
- MT(JT+3) = OR (OR (IBLAN3,LSHFT(MWDV(2),16))
- +, RSHFT(AND(MASK1,MWDV(3)),16))
- MT(JT+4) = OR (IBLAN3,LSHFT(MWDV(3),8))
- JS = JS + 3
- 44 JT = JT + 4
-
- IF (NTRAIL.EQ.0) RETURN
-
-C-- Unpack the trailing words
-
- 46 MWDV(1) = MS(JS+1)
- MWDV(2) = MS(JS+2)
- MWDV(3) = MS(JS+3)
-
- CHWD(NTRAIL+1:12) = ' '
-
- MT(JT+1) = OR (IBLAN3,AND(MASK3,MWDV(1)))
- IF (NTRAIL.LE.3) RETURN
-
- MT(JT+2) = OR (OR (IBLAN3,LSHFT(MWDV(1),24))
- +, RSHFT(AND(MASK2,MWDV(2)),8))
- IF (NTRAIL.LE.6) RETURN
-
- MT(JT+3) = OR (OR (IBLAN3,LSHFT(MWDV(2),16))
- +, RSHFT(AND(MASK1,MWDV(3)),16))
- IF (NTRAIL.LE.9) RETURN
-
- MT(JT+4) = OR (IBLAN3,LSHFT(MWDV(3),8))
- RETURN
-
- 91 CALL ABEND
- END
-#ifdef CERNLIB_TCGEN_UCTOH
-#undef CERNLIB_TCGEN_UCTOH
-#endif
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/uctoh1.F b/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/uctoh1.F
deleted file mode 100644
index 0295aef..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/uctoh1.F
+++ /dev/null
@@ -1,55 +0,0 @@
-*
-* $Id: uctoh1.F,v 1.1.1.1 1996/02/15 17:51:06 mclareni Exp $
-*
-* $Log: uctoh1.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:06 mclareni
-* Kernlib
-*
-*
-#include "kernapo/pilot.h"
-#if !defined(CERNLIB_QMAPO10)
- SUBROUTINE UCTOH1 (MS,MT,NCHP)
-C
-C CERN PROGLIB# M409 UCTOH1 .VERSION KERNAPO 1.11 880222
-C ORIG. 10/02/88 JZ
-C
- DIMENSION MS(99), MT(99), NCHP(9)
- PARAMETER (IBLAN1 = 16#00202020)
- PARAMETER (MASK1 = 16#FF000000)
-
-
- NCH = NCHP(1)
- IF (NCH) 91, 29, 11
- 11 NWS = RSHFT (NCH,2)
- NTRAIL = AND (NCH,3)
- JT = 0
- IF (NWS.EQ.0) GO TO 26
-
-C-- Unpack the initial complete words
-
- DO 24 JS=1,NWS
- MWD = MS(JS)
- MT(JT+1) = OR (IBLAN1,AND(MASK1,MWD))
- MT(JT+2) = OR (IBLAN1,AND(MASK1,LSHFT(MWD, 8)))
- MT(JT+3) = OR (IBLAN1,AND(MASK1,LSHFT(MWD,16)))
- MT(JT+4) = OR (IBLAN1, LSHFT(MWD,24) )
- 24 JT = JT + 4
-
- IF (NTRAIL.EQ.0) RETURN
-
-C-- Unpack the trailing word
-
- 26 MWD = MS(NWS+1)
-
- DO 28 JS=1,NTRAIL
- MT(JT+1) = OR (IBLAN1,AND(MASK1,MWD))
- MWD = LSHFT (MWD,8)
- 28 JT = JT + 1
- 29 RETURN
-
- 91 CALL ABEND
- END
-#ifdef CERNLIB_TCGEN_UCTOH1
-#undef CERNLIB_TCGEN_UCTOH1
-#endif
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/ufill.F b/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/ufill.F
deleted file mode 100644
index 7109603..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/ufill.F
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: ufill.F,v 1.1.1.1 1996/02/15 17:51:06 mclareni Exp $
-*
-* $Log: ufill.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:06 mclareni
-* Kernlib
-*
-*
-#include "kernapo/pilot.h"
- SUBROUTINE UFILL (IV,JL,JR,ISTUFF)
-C
-C CERN PROGLIB# V300 UFILL .VERSION KERNAPO 1.17 890531
-C ORIG. 01/07/71 JZ
-C MOD 31/05/89 FCA
-C
- DIMENSION IV(*)
-C
- NCOUNT=JR-JL+1
- IF(NCOUNT.GT.0) CALL VEC_$INIT (IV(JL),NCOUNT,ISTUFF)
- END
-#ifdef CERNLIB_TCGEN_UFILL
-#undef CERNLIB_TCGEN_UFILL
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/uh1toc.F b/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/uh1toc.F
deleted file mode 100644
index 08f41f3..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/uh1toc.F
+++ /dev/null
@@ -1,69 +0,0 @@
-*
-* $Id: uh1toc.F,v 1.1.1.1 1996/02/15 17:51:06 mclareni Exp $
-*
-* $Log: uh1toc.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:06 mclareni
-* Kernlib
-*
-*
-#include "kernapo/pilot.h"
-#if !defined(CERNLIB_QMAPO10)
- SUBROUTINE UH1TOC (MS,MT,NCHP)
-C
-C CERN PROGLIB# M409 UH1TOC .VERSION KERNAPO 1.11 880222
-C ORIG. 10/02/88 JZ
-C
- DIMENSION MS(99), MT(99), NCHP(9)
-
- PARAMETER (MASK1 = 16#FF000000)
- PARAMETER (MASK2 = 16#FFFF0000)
- PARAMETER (MASK3 = 16#FFFFFF00)
-
-
- NCH = NCHP(1)
- IF (NCH) 91, 29, 11
- 11 NWT = RSHFT (NCH,2)
- NTRAIL = AND (NCH,3)
- JS = 0
- IF (NWT.EQ.0) GO TO 26
-
-C-- Pack the initial complete words
-
- DO 24 JT=1,NWT
- MT(JT) = OR (OR (OR (
- + AND(MASK1,MS(JS+1))
- +, RSHFT (AND(MASK1,MS(JS+2)), 8))
- +, RSHFT (AND(MASK1,MS(JS+3)),16))
- +, RSHFT (MS(JS+4) ,24))
- 24 JS = JS + 4
-
- IF (NTRAIL.EQ.0) RETURN
-
-C-- Pack the trailing word
-
- 26 GO TO ( 28, 27), NTRAIL
-
- MT(NWT+1) = OR (OR (OR (
- + AND(MASK1,MS(JS+1))
- +, RSHFT (AND(MASK1,MS(JS+2)), 8))
- +, RSHFT (AND(MASK1,MS(JS+3)),16))
- +, AND (NOT(MASK3),MT(NWT+1)))
- RETURN
-
- 27 MT(NWT+1) = OR (OR (
- + AND(MASK1,MS(JS+1))
- +, RSHFT (AND(MASK1,MS(JS+2)), 8))
- +, AND (NOT(MASK2),MT(NWT+1)))
- RETURN
-
- 28 MT(NWT+1) = OR (
- + AND(MASK1,MS(JS+1))
- +, AND (NOT(MASK1),MT(NWT+1)))
- 29 RETURN
-
- 91 CALL ABEND
- END
-#ifdef CERNLIB_TCGEN_UH1TOC
-#undef CERNLIB_TCGEN_UH1TOC
-#endif
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/uhtoc.F b/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/uhtoc.F
deleted file mode 100644
index aaa6baa..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/uhtoc.F
+++ /dev/null
@@ -1,199 +0,0 @@
-*
-* $Id: uhtoc.F,v 1.1.1.1 1996/02/15 17:51:06 mclareni Exp $
-*
-* $Log: uhtoc.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:06 mclareni
-* Kernlib
-*
-*
-#include "kernapo/pilot.h"
-#if !defined(CERNLIB_QMAPO10)
- SUBROUTINE UHTOC (MS,NPW,MT,NCHP)
-C
-C CERN PROGLIB# M409 UHTOC .VERSION KERNAPO 1.11 880222
-C ORIG. 10/02/88 JZ
-C
- DIMENSION MS(99), MT(99), NCHP(9)
-
- PARAMETER (MASK1 = 16#FF000000)
- PARAMETER (MASK2 = 16#FFFF0000)
- PARAMETER (MASK3 = 16#FFFFFF00)
-
- DIMENSION MASK(3)
- DATA MASK / 16#FF000000, 16#FFFF0000, 16#FFFFFF00 /
-
-
- NCH = NCHP(1)
- IF (NCH) 91, 29, 11
- 11 GO TO (21, 31, 41), NPW
-
-C-------- NPW = 4
-
- NWT = RSHFT (NCH,2)
- NTRAIL = AND (NCH,3)
- IF (NWT.EQ.0) GO TO 15
-
- DO 14 J=1,NWT
- 14 MT(J) = MS(J)
- IF (NTRAIL.EQ.0) RETURN
-
- 15 MT(NWT+1) = OR (AND (MS(NWT+1), MASK(NTRAIL))
- +, AND (MT(NWT+1),NOT(MASK(NTRAIL))))
- RETURN
-
-C-------- NPW = 1
-C-- equivalent to 'CALL UH1TOC(MS,MT,NCH)'
-
- 21 NWT = RSHFT (NCH,2)
- NTRAIL = AND (NCH,3)
- JS = 0
- IF (NWT.EQ.0) GO TO 26
-
-C-- Pack the initial complete words
-
- DO 24 JT=1,NWT
- MT(JT) = OR (OR (OR (
- + AND(MASK1,MS(JS+1))
- +, RSHFT (AND(MASK1,MS(JS+2)), 8))
- +, RSHFT (AND(MASK1,MS(JS+3)),16))
- +, RSHFT (MS(JS+4), 24))
- 24 JS = JS + 4
-
- IF (NTRAIL.EQ.0) RETURN
-
-C-- Pack the trailing word
-
- 26 GO TO ( 28, 27), NTRAIL
-
- MT(NWT+1) = OR (OR (OR (
- + AND(MASK1,MS(JS+1))
- +, RSHFT (AND(MASK1,MS(JS+2)), 8))
- +, RSHFT (AND(MASK1,MS(JS+3)),16))
- +, AND (NOT(MASK3),MT(NWT+1)))
- RETURN
-
- 27 MT(NWT+1) = OR (OR (
- + AND(MASK1,MS(JS+1))
- +, RSHFT (AND(MASK1,MS(JS+2)), 8))
- +, AND (NOT(MASK2),MT(NWT+1)))
- RETURN
-
- 28 MT(NWT+1) = OR (
- + AND(MASK1,MS(JS+1))
- +, AND (NOT(MASK1),MT(NWT+1)))
- 29 RETURN
-
-C-------- NPW = 2
-
- 31 NWT = RSHFT (NCH,2)
- NTRAIL = AND (NCH,3)
- JS = 0
- IF (NWT.EQ.0) GO TO 36
-
-C-- Pack the initial complete words
-
- DO 34 JT=1,NWT
- MT(JT) = OR (AND(MASK2,MS(JS+1))
- +, RSHFT (MS(JS+2),16))
- 34 JS = JS + 2
-
- IF (NTRAIL.EQ.0) RETURN
-
-C-- Pack the trailing word
-
- 36 GO TO ( 38, 37), NTRAIL
-
- MT(NWT+1) = OR (OR (
- + AND(MASK2,MS(JS+1))
- +, RSHFT (AND(MASK1,MS(JS+2)),16))
- +, AND (NOT(MASK3),MT(NWT+1)))
- RETURN
-
- 37 MT(NWT+1) = OR (
- + AND(MASK2,MS(JS+1))
- +, AND (NOT(MASK2),MT(NWT+1)))
- RETURN
-
- 38 MT(NWT+1) = OR (
- + AND(MASK1,MS(JS+1))
- +, AND (NOT(MASK1),MT(NWT+1)))
- RETURN
-
-C-------- NPW = 3
-
- 41 NWT = NCH/12
- NTRAIL = NCH - 12*NWT
- JS = 0
- JT = 0
- IF (NWT.EQ.0) GO TO 46
-
-C-- Pack the initial complete words
-
- DO 44 JL=1,NWT
- MT(JT+1) = OR ( AND ( MS(JS+1), MASK3)
- +, RSHFT (MS(JS+2),24))
-
- MT(JT+2) = OR ( AND (LSHFT(MS(JS+2), 8), MASK2)
- +, RSHFT (MS(JS+3),16))
-
- MT(JT+3) = OR ( AND (LSHFT(MS(JS+3),16), MASK1)
- +, RSHFT (MS(JS+4), 8))
- JS = JS + 4
- 44 JT = JT + 3
-
- IF (NTRAIL.EQ.0) RETURN
-
-C-- Pack the trailing word
-
- 46 IF (NTRAIL.LE.3) THEN
- MT(JT+1) = OR ( AND (MS(JS+1), MASK(NTRAIL))
- +, AND (MT(JT+1),NOT(MASK(NTRAIL))))
- RETURN
-
- ELSEIF (NTRAIL.LE.6) THEN
- MT(JT+1) = OR ( AND (MS(JS+1), MASK3)
- +, RSHFT (MS(JS+2), 24))
-
- N = NTRAIL - 4
- IF (N.EQ.0) RETURN
-
- MT(JT+2) = OR ( AND (LSHFT(MS(JS+2), 8), MASK(N))
- +, AND (MT(JT+2), NOT(MASK(N))))
- RETURN
-
- ELSEIF (NTRAIL.LT.9) THEN
- MT(JT+1) = OR ( AND (MS(JS+1), MASK3)
- +, RSHFT (MS(JS+2), 24))
-
- MWD = OR ( AND (LSHFT(MS(JS+2), 8), MASK2)
- +, RSHFT (MS(JS+3),16))
- N = NTRAIL - 4
- IF (N.EQ.3) THEN
- MWD = OR ( AND(MWD, MASK(N))
- +, AND(MT(JT+2),NOT(MASK(N))))
- ENDIF
- MT(JT+2) = MWD
- RETURN
-
- ELSE
- MT(JT+1) = OR ( AND ( MS(JS+1), MASK3)
- +, RSHFT (MS(JS+2), 24))
-
- MT(JT+2) = OR ( AND (LSHFT(MS(JS+2), 8), MASK2)
- +, RSHFT (MS(JS+3), 16))
-
- MWD = OR ( AND (LSHFT(MS(JS+3), 16), MASK1)
- +, RSHFT (MS(JS+4), 8))
- N = NTRAIL - 8
- MWD = OR ( AND(MWD, MASK(N))
- +, AND(MT(JT+3),NOT(MASK(N))))
- MT(JT+3) = MWD
- ENDIF
- RETURN
-
- 91 CALL ABEND
- END
-#ifdef CERNLIB_TCGEN_UHTOC
-#undef CERNLIB_TCGEN_UHTOC
-#endif
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/upkbyt.F b/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/upkbyt.F
deleted file mode 100644
index 082f5c4..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/upkbyt.F
+++ /dev/null
@@ -1,60 +0,0 @@
-*
-* $Id: upkbyt.F,v 1.1.1.1 1996/02/15 17:51:06 mclareni Exp $
-*
-* $Log: upkbyt.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:06 mclareni
-* Kernlib
-*
-*
-#include "kernapo/pilot.h"
- SUBROUTINE UPKBYT (MBV,JTHP,MIV,NINTP,NBITS)
-C
-C CERN PROGLIB# M422 UPKBYT .VERSION KERNAPO 1.01 831216
-C ORIG. 16/12/83 JZ
-C
- DIMENSION MIV(99), MBV(99), JTHP(9), NINTP(9), NBITS(2)
-
- JTH = JTHP(1)
- NINT = NINTP(1)
- IF (NINT.LE.0) RETURN
-
- NZB = NBITS(1)
- IF (NZB.GT.0) GO TO 11
- NZB = 1
- NPWD = 32
- MASK = 1
- GO TO 12
-
- 11 NPWD = NBITS(2)
- MASK = RSHFT (INT4(-1),32-NZB)
-
- 12 JBV = 1
- JIV = 0
- IF (JTH.LT.2) GO TO 21
- JBV = (JTH-1)/NPWD + 1
- JPOS = JTH - (JBV-1)*NPWD - 1
- IF (JPOS.EQ.0) GO TO 21
- NR = JPOS*NZB
- JIVE = NPWD - JPOS
- IZW = RSHFT (MBV(JBV),NR)
- GO TO 22
-
-C-- UNPACK EACH WORD
-
- 21 JIVE = JIV + NPWD
- IZW = MBV(JBV)
- 22 JIVE = MIN0 (NINT,JIVE)
-
- 24 JIV = JIV + 1
- MIV(JIV) = AND (MASK,IZW)
- IF (JIV.EQ.JIVE) GO TO 27
- IZW = RSHFT (IZW,NZB)
- GO TO 24
-
- 27 IF (JIV.EQ.NINT) RETURN
- JBV = JBV + 1
- GO TO 21
- END
-#ifdef CERNLIB_TCGEN_UPKBYT
-#undef CERNLIB_TCGEN_UPKBYT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/uswop.F b/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/uswop.F
deleted file mode 100644
index 7bd17cb..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/uswop.F
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: uswop.F,v 1.1.1.1 1996/02/15 17:51:06 mclareni Exp $
-*
-* $Log: uswop.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:06 mclareni
-* Kernlib
-*
-*
-#include "kernapo/pilot.h"
- SUBROUTINE USWOP (IA,IB,N)
-C
-C CERN PROGLIB# F121 USWOP .VERSION KERNAPO 1.16 890321
-C ORIG. 19/12/88 F.Carminati
-C
- DIMENSION IA(*), IB(*)
- IF (N.GT.0) CALL VEC_$ISWAP(IA,IB,N)
- END
-#ifdef CERNLIB_TCGEN_USWOP
-#undef CERNLIB_TCGEN_USWOP
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/uzero.F b/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/uzero.F
deleted file mode 100644
index 1a7aaff..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/uzero.F
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: uzero.F,v 1.1.1.1 1996/02/15 17:51:06 mclareni Exp $
-*
-* $Log: uzero.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:06 mclareni
-* Kernlib
-*
-*
-#include "kernapo/pilot.h"
- SUBROUTINE UZERO (IV,JL,JR)
-C
-C CERN PROGLIB# V300 UZERO .VERSION KERNAPO 1.17 890701
-C ORIG. 01/01/65 JZ
-C MOD 31/05/89 FCA
-C
- DIMENSION IV(*)
-C
- NCOUNT=JR-JL+1
- IF(NCOUNT.GT.0) CALL VEC_$INIT (IV(JL),NCOUNT,0)
- END
-#ifdef CERNLIB_TCGEN_UZERO
-#undef CERNLIB_TCGEN_UZERO
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/vadd.F b/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/vadd.F
deleted file mode 100644
index 1b18504..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/vadd.F
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: vadd.F,v 1.1.1.1 1996/02/15 17:51:07 mclareni Exp $
-*
-* $Log: vadd.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:07 mclareni
-* Kernlib
-*
-*
-#include "kernapo/pilot.h"
- SUBROUTINE VADD (B,C,A,N)
-C
-C CERN PROGLIB# F121 VADD .VERSION KERNAPO 1.04 850321
-C ORIG. 01/03/85 R.BRUN
-C
- DIMENSION A(*),B(*),C(*)
- IF (N.GT.0) CALL VEC_$ADD_VECTOR (B,C,N,A)
- END
-#ifdef CERNLIB_TCGEN_VADD
-#undef CERNLIB_TCGEN_VADD
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/vbias.F b/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/vbias.F
deleted file mode 100644
index 74ca676..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/vbias.F
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: vbias.F,v 1.1.1.1 1996/02/15 17:51:07 mclareni Exp $
-*
-* $Log: vbias.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:07 mclareni
-* Kernlib
-*
-*
-#include "kernapo/pilot.h"
- SUBROUTINE VBIAS (B,ALPHA,A,N)
-C
-C CERN PROGLIB# F121 VBIAS .VERSION KERNAPO 1.04 850321
-C ORIG. 01/03/85 R.BRUN
-C
- DIMENSION A(*),B(*)
- IF (N.GT.0) CALL VEC_$ADD_CONSTANT (B,N,ALPHA,A)
- END
-#ifdef CERNLIB_TCGEN_VBIAS
-#undef CERNLIB_TCGEN_VBIAS
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/vblank.F b/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/vblank.F
deleted file mode 100644
index 3687899..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/vblank.F
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: vblank.F,v 1.1.1.1 1996/02/15 17:51:07 mclareni Exp $
-*
-* $Log: vblank.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:07 mclareni
-* Kernlib
-*
-*
-#include "kernapo/pilot.h"
- SUBROUTINE VBLANK (IA,N)
-C
-C CERN PROGLIB# F121 VBLANK .VERSION KERNAPO 1.24 920511
-C ORIG. 01/03/85 R.BRUN
-C
- DIMENSION IA(*)
- PARAMETER (IBLANK = 16#20202020)
-
- IF (N.GT.0) CALL VEC_$IINIT (IA,N,IBLANK)
- END
-#ifdef CERNLIB_TCGEN_VBLANK
-#undef CERNLIB_TCGEN_VBLANK
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/vcopyn.F b/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/vcopyn.F
deleted file mode 100644
index 92b2aa3..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/vcopyn.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: vcopyn.F,v 1.1.1.1 1996/02/15 17:51:07 mclareni Exp $
-*
-* $Log: vcopyn.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:07 mclareni
-* Kernlib
-*
-*
-#include "kernapo/pilot.h"
- SUBROUTINE VCOPYN (A,X,N)
-C
-C CERN PROGLIB# F121 VCOPYN .VERSION KERNAPO 1.17 890626
-C ORIG. 30/05/89 FCA
-C
- DIMENSION A(*), B(*)
-
- IF (N.GT.0) CALL VEC_$MULT_CONSTANT (A,N,-1.,X)
- END
-#ifdef CERNLIB_TCGEN_VCOPYN
-#undef CERNLIB_TCGEN_VCOPYN
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/vdot.F b/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/vdot.F
deleted file mode 100644
index e10db28..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/vdot.F
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: vdot.F,v 1.1.1.1 1996/02/15 17:51:07 mclareni Exp $
-*
-* $Log: vdot.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:07 mclareni
-* Kernlib
-*
-*
-#include "kernapo/pilot.h"
- FUNCTION VDOT (A,B,N)
-C
-C CERN PROGLIB# F121 VDOT .VERSION KERNAPO 1.17 890626
-C ORIG. 30/05/89 FCA
-C
- DIMENSION A(*), B(*)
-
- VDOT=0.0
- IF(N.GT.0) VDOT=VEC_$DOT(A,B,N)
- END
-#ifdef CERNLIB_TCGEN_VDOT
-#undef CERNLIB_TCGEN_VDOT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/vdotn.F b/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/vdotn.F
deleted file mode 100644
index 5b036db..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/vdotn.F
+++ /dev/null
@@ -1,38 +0,0 @@
-*
-* $Id: vdotn.F,v 1.1.1.1 1996/02/15 17:51:07 mclareni Exp $
-*
-* $Log: vdotn.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:07 mclareni
-* Kernlib
-*
-*
-#include "kernapo/pilot.h"
- FUNCTION VDOTN (A,B,N)
-C
-C CERN PROGLIB# F121 VDOTN .VERSION KERNAPO 1.17 890626
-C ORIG. 30/05/89 FCA
-C
- DIMENSION A(*), B(*)
-
- VDOTN=0.0
- IF(N.GT.0) THEN
- IF(N.GT.20) THEN
- VDEN = VEC_$DOT(A,A,N)*VEC_$DOT(B,B,N)
- IF(VDEN.NE.0.0) VDOTN=VEC_$DOT(A,B,N)/SQRT(VDEN)
- ELSE
- AAMOD = 0.0
- BBMOD = 0.0
- ABMOD = 0.0
- DO 10 J=1, N
- AAMOD = AAMOD + A(J)*A(J)
- BBMOD = BBMOD + B(J)*B(J)
- ABMOD = ABMOD + A(J)*B(J)
- 10 CONTINUE
- VDEN = AAMOD * BBMOD
- IF (VDEN.NE.0.0) VDOTN=ABMOD/SQRT(VDEN)
- ENDIF
- ENDIF
- END
-#ifdef CERNLIB_TCGEN_VDOTN
-#undef CERNLIB_TCGEN_VDOTN
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/vdotn2.F b/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/vdotn2.F
deleted file mode 100644
index 5848730..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/vdotn2.F
+++ /dev/null
@@ -1,38 +0,0 @@
-*
-* $Id: vdotn2.F,v 1.1.1.1 1996/02/15 17:51:07 mclareni Exp $
-*
-* $Log: vdotn2.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:07 mclareni
-* Kernlib
-*
-*
-#include "kernapo/pilot.h"
- FUNCTION VDOTN2 (A,B,N)
-C
-C CERN PROGLIB# F121 VDOTN2 .VERSION KERNAPO 1.17 890626
-C ORIG. 30/05/89 FCA
-C
- DIMENSION A(*), B(*)
-
- VDOTN2=0.0
- IF(N.GT.0) THEN
- IF(N.GT.20) THEN
- VDEN = VEC_$DOT(A,A,N)*VEC_$DOT(B,B,N)
- IF(VDEN.NE.0.0) VDOTN2=VEC_$DOT(A,B,N)**2/VDEN
- ELSE
- AAMOD = 0.0
- BBMOD = 0.0
- ABMOD = 0.0
- DO 10 J=1, N
- AAMOD = AAMOD + A(J)*A(J)
- BBMOD = BBMOD + B(J)*B(J)
- ABMOD = ABMOD + A(J)*B(J)
- 10 CONTINUE
- VDEN = AAMOD * BBMOD
- IF (VDEN.NE.0.0) VDOTN2=ABMOD**2/VDEN
- ENDIF
- ENDIF
- END
-#ifdef CERNLIB_TCGEN_VDOTN2
-#undef CERNLIB_TCGEN_VDOTN2
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/vfill.F b/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/vfill.F
deleted file mode 100644
index b0dc66b..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/vfill.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: vfill.F,v 1.1.1.1 1996/02/15 17:51:07 mclareni Exp $
-*
-* $Log: vfill.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:07 mclareni
-* Kernlib
-*
-*
-#include "kernapo/pilot.h"
- SUBROUTINE VFILL (A,N,C)
-C
-C CERN PROGLIB# F121 VFILL .VERSION KERNAPO 1.24 920511
-C ORIG. 01/03/85 R.BRUN
-C
- INTEGER A(*)
-
- IF (N.GT.0) CALL VEC_$INIT (A,N,C)
- END
-#ifdef CERNLIB_TCGEN_VFILL
-#undef CERNLIB_TCGEN_VFILL
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/vlinco.F b/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/vlinco.F
deleted file mode 100644
index 2c6f35c..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/vlinco.F
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: vlinco.F,v 1.1.1.1 1996/02/15 17:51:07 mclareni Exp $
-*
-* $Log: vlinco.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:07 mclareni
-* Kernlib
-*
-*
-#include "kernapo/pilot.h"
- SUBROUTINE VLINCO (A,ALPHA,B,BETA,X,N)
-C
-C CERN PROGLIB# F121 VLINCO .VERSION KERNAPO 1.17 890626
-C ORIG. 30/05/89 FCA
-C
- DIMENSION A(*), B(*), X(*)
-
- IF(N.GT.0) THEN
- CALL VEC_$MULT_CONSTANT (A,N,ALPHA,X)
- CALL VEC_$MULT_ADD (X,B,N,BETA,X)
- ENDIF
- END
-#ifdef CERNLIB_TCGEN_VLINCO
-#undef CERNLIB_TCGEN_VLINCO
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/vmatl.F b/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/vmatl.F
deleted file mode 100644
index 1f7aef6..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/vmatl.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: vmatl.F,v 1.1.1.1 1996/02/15 17:51:07 mclareni Exp $
-*
-* $Log: vmatl.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:07 mclareni
-* Kernlib
-*
-*
-#include "kernapo/pilot.h"
- SUBROUTINE VMATL (G,C,X,N,M)
-C
-C CERN PROGLIB# F121 VMATL .VERSION KERNAPO 1.17 890626
-C ORIG. 30/05/89 FCA
-C
- DIMENSION G(M,N), C(*), X(*)
-
- IF (N.GT.0.AND.M.GT.0) CALL VEC_$PREMULTN (C,G,M,N,X)
- END
-#ifdef CERNLIB_TCGEN_VMATL
-#undef CERNLIB_TCGEN_VMATL
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/vmatr.F b/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/vmatr.F
deleted file mode 100644
index 7f678b5..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/vmatr.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: vmatr.F,v 1.1.1.1 1996/02/15 17:51:08 mclareni Exp $
-*
-* $Log: vmatr.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:08 mclareni
-* Kernlib
-*
-*
-#include "kernapo/pilot.h"
- SUBROUTINE VMATR (A,G,V,N,M)
-C
-C CERN PROGLIB# F121 VMATR .VERSION KERNAPO 1.17 890626
-C ORIG. 30/05/89 FCA
-C
- DIMENSION A(*), G(M,N), V(*)
-
- IF (N.GT.0.AND.M.GT.0) CALL VEC_$POSTMULTN (G,A,M,N,V)
- END
-#ifdef CERNLIB_TCGEN_VMATR
-#undef CERNLIB_TCGEN_VMATR
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/vmaxa.F b/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/vmaxa.F
deleted file mode 100644
index 2dd512f..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/vmaxa.F
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: vmaxa.F,v 1.1.1.1 1996/02/15 17:51:08 mclareni Exp $
-*
-* $Log: vmaxa.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:08 mclareni
-* Kernlib
-*
-*
-#include "kernapo/pilot.h"
- FUNCTION VMAXA (A,N)
-C
-C CERN PROGLIB# F121 VMAXA .VERSION KERNAPO 1.17 890626
-C ORIG. 30/05/89 FCA
-C
- DIMENSION A(*)
-
- VMAXA = 0.0
- IF (N.GT.0) CALL VEC_$MAX (A,N,VMAXA,IMAXA)
- END
-#ifdef CERNLIB_TCGEN_VMAXA
-#undef CERNLIB_TCGEN_VMAXA
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/vmod.F b/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/vmod.F
deleted file mode 100644
index 916582a..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/vmod.F
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: vmod.F,v 1.1.1.1 1996/02/15 17:51:08 mclareni Exp $
-*
-* $Log: vmod.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:08 mclareni
-* Kernlib
-*
-*
-#include "kernapo/pilot.h"
- FUNCTION VMOD (A,N)
-C
-C CERN PROGLIB# F121 VMOD .VERSION KERNAPO 1.17 890626
-C ORIG. 30/05/89 FCA
-C
- DIMENSION A(*)
-
- VMOD=0.0
- IF(N.GT.0) VMOD=SQRT(VEC_$DOT(A,A,N))
- END
-#ifdef CERNLIB_TCGEN_VMOD
-#undef CERNLIB_TCGEN_VMOD
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/vscale.F b/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/vscale.F
deleted file mode 100644
index 2202eea..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/vscale.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: vscale.F,v 1.1.1.1 1996/02/15 17:51:08 mclareni Exp $
-*
-* $Log: vscale.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:08 mclareni
-* Kernlib
-*
-*
-#include "kernapo/pilot.h"
- SUBROUTINE VSCALE (A,ALPHA,X,N)
-C
-C CERN PROGLIB# F121 VSCALE .VERSION KERNAPO 1.17 890626
-C ORIG. 30/05/89 FCA
-C
- DIMENSION A(*), X(*)
-
- IF (N.GT.0) CALL VEC_$MULT_CONSTANT (A,N,ALPHA,X)
- END
-#ifdef CERNLIB_TCGEN_VSCALE
-#undef CERNLIB_TCGEN_VSCALE
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/vsub.F b/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/vsub.F
deleted file mode 100644
index e317ded..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/vsub.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: vsub.F,v 1.1.1.1 1996/02/15 17:51:08 mclareni Exp $
-*
-* $Log: vsub.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:08 mclareni
-* Kernlib
-*
-*
-#include "kernapo/pilot.h"
- SUBROUTINE VSUB (A,B,X,N)
-C
-C CERN PROGLIB# F121 VSUB .VERSION KERNAPO 1.17 890626
-C ORIG. 30/05/89 FCA
-C
- DIMENSION A(*), B(*), X(*)
-
- IF (N.GT.0) CALL VEC_$SUB (A,B,N,X)
- END
-#ifdef CERNLIB_TCGEN_VSUB
-#undef CERNLIB_TCGEN_VSUB
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/vsum.F b/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/vsum.F
deleted file mode 100644
index d9d3a24..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/vsum.F
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: vsum.F,v 1.1.1.1 1996/02/15 17:51:08 mclareni Exp $
-*
-* $Log: vsum.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:08 mclareni
-* Kernlib
-*
-*
-#include "kernapo/pilot.h"
- FUNCTION VSUM (A,N)
-C
-C CERN PROGLIB# F121 VSUM .VERSION KERNAPO 1.04 850321
-C ORIG. 01/03/85 R.BRUN
-C
- DIMENSION A(*)
- IF (N.GT.0) THEN
- VSUM= VEC_$SUM(A,N)
- ELSE
- VSUM= 0.0
- ENDIF
- END
-#ifdef CERNLIB_TCGEN_VSUM
-#undef CERNLIB_TCGEN_VSUM
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/vzero.F b/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/vzero.F
deleted file mode 100644
index f33fa3b..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/apogs/vzero.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: vzero.F,v 1.1.1.1 1996/02/15 17:51:08 mclareni Exp $
-*
-* $Log: vzero.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:08 mclareni
-* Kernlib
-*
-*
-#include "kernapo/pilot.h"
- SUBROUTINE VZERO(A,N)
-C
-C CERN PROGLIB# F121 VZERO .VERSION KERNAPO 1.24 920511
-C ORIG. 01/03/85 R.BRUN
-C
- INTEGER A(*)
-
- IF (N.GT.0) CALL VEC_$ZERO (A,N)
- END
-#ifdef CERNLIB_TCGEN_VZERO
-#undef CERNLIB_TCGEN_VZERO
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/apoprogs/Imakefile b/src/packlib/kernlib/kerngen/obsolete/kernapo/apoprogs/Imakefile
deleted file mode 100644
index faf9c76..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/apoprogs/Imakefile
+++ /dev/null
@@ -1,4 +0,0 @@
-SRCS_F= \ @@\
- cvfixto.F fcasplit.F xbanner.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/apoprogs/cvfixto.F b/src/packlib/kernlib/kerngen/obsolete/kernapo/apoprogs/cvfixto.F
deleted file mode 100644
index 3f9c29b..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/apoprogs/cvfixto.F
+++ /dev/null
@@ -1,168 +0,0 @@
-*
-* $Id: cvfixto.F,v 1.1.1.1 1996/02/15 17:51:00 mclareni Exp $
-*
-* $Log: cvfixto.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:00 mclareni
-* Kernlib
-*
-*
-#include "kernapo/pilot.h"
- PROGRAM CVFIXTO
-
-%INCLUDE '/sys/ins/base.ins.ftn'
-%INCLUDE '/sys/ins/ios.ins.ftn'
-
- PARAMETER (NCHNAM=80)
- INTEGER*2 PGM_$GET_ARG
- INTEGER*2 NARGS, ncharg, JARG
- CHARACTER CHTARG*(NCHNAM)
- CHARACTER TEXT*(NCHNAM)
- CHARACTER CHTYP*4
-
- INTEGER*2 IDSTROLD,IDSTRNEW, IRTOLD, IRTYPE
- DIMENSION IUID(2)
- PARAMETER (IUIDREC=768, IUIDUA=785)
-
-
- CALL PGM_$GET_ARGS (NARGS,LPOIARG)
- NARGS = NARGS - 1
- NBYTES = 0
- IF (NARGS-3) 12, 24, 21
- 12 PRINT 9009,
- 9009 FORMAT (' CVFIXTO: program to copy a file'
- F,' with fixed-length records'
- F/10X,'changing the Apollo attributes to one of 2 types:'
- F/10X,'type = F2 fixed-length with system control-word'
-C F/15X, '= F1 fixed-length without control-word'
- F/15X, '= UASC simple stream of bytes'
- F/15X, ' (R taken as F, A taken as U)'
- F/9X,' Please give CVFIXTO type source target [nbytes]')
- STOP
-
-C-- Get parameter 4, record size
-
- 21 ncharg = PGM_$GET_ARG (INT2(4),TEXT,ISTAT)
- NTXT = ncharg
- NBYTES = ICDECI (TEXT,1,NTXT)
-
-C-- Set the type of the output file from parameter 1
-
- 24 ncharg = PGM_$GET_ARG (INT2(1),TEXT,ISTAT)
- NTXT = ncharg
- TEXT(NTXT+1:) = ' '
- CALL CLTOU (TEXT)
-
- IUID(2) = 0
- IF (TEXT(1:1).EQ.'R') TEXT(1:1)='F'
- IF (TEXT(1:1).EQ.'A') TEXT(1:1)='U'
- IF (TEXT(1:1).EQ.'F') THEN
- KIND = 2
- IUID(1) = IUIDREC
- IRTYPE = IOS_$F2
- CHTYP = 'f2'
-C- format F1 is not currently implemented in IOS
-C IF (TEXT(2:2).EQ.'1') THEN
-C KIND = 1
-C IRTYPE = IOS_$F1
-C CHTYP = 'F1'
-C ENDIF
- ELSE
- IF (TEXT(1:1).NE.'U') GO TO 12
- KIND = 3
- IUID(1) = IUIDUA
- CHTYP = 'uasc'
- ENDIF
-
-C-- Get target filename, and CREATE
-
- ncharg = PGM_$GET_ARG (INT2(3),CHTARG,ISTAT)
- NCHTAR = ncharg
- CHTARG(NCHTAR+1:NCHNAM) = ' '
-
- CALL FLOPER (2, CHTARG(1:NCHTAR), 9)
-
- CALL IOS_$CREATE (CHTARG,ncharg
- +, IUID
- +, IOS_$NO_PRE_EXIST_MODE
- +, IOS_$WRITE_OPT
- +, IDSTRNEW, ISTAT)
- ISTATC = ISTAT
-
-C-- Get source file-name, and OPEN
-
- ncharg = PGM_$GET_ARG (INT2(2),TEXT,ISTAT)
- NTXT = ncharg
- TEXT(NTXT+1:NCHNAM) = ' '
-
- IDSTROLD = IOS_$OPEN (TEXT,ncharg,0,ISTAT)
- IF (ISTAT.NE.0) THEN
- PRINT 9034, ISTAT
- 9034 FORMAT (' ******* OPEN failed, ISTAT=',Z9,' hex')
- STOP
- ENDIF
-
- IRTOLD = IOS_$INQ_REC_TYPE (IDSTROLD,ISTAT)
- IF (IRTOLD.EQ.IOS_$UNDEF) GO TO 37
-
- LENFIR = IOS_$INQ_CUR_REC_LEN (IDSTROLD,ISTAT)
-
- PRINT 9035, LENFIR
- 9035 FORMAT (' Apollo thinks the record-length on the source file is'
- F,I6,' bytes/r')
-
- IF (NBYTES.EQ.0) NBYTES = MAX (0,LENFIR)
-
-C-- Set the record type of the target file
-
- 37 IF (NBYTES.EQ.0) NBYTES = 3600
- IF (KIND.LT.3) THEN
- CALL IOS_$SET_REC_TYPE (IDSTRNEW,IRTYPE,NBYTES,ISTAT)
- IF (ISTAT.NE.0) ISTATC=ISTAT
- ENDIF
-
- IF (ISTATC.NE.0) THEN
- PRINT 9036, ISTATC
- 9036 FORMAT (' ******* CREATE failed, ISTAT=',Z9,' hex')
- STOP
- ENDIF
-
-C---- Copy file
-
- PRINT 9041, CHTYP,TEXT(1:NTXT),CHTARG(1:NCHTAR),NBYTES
- 9041 FORMAT (' Convert to ',A/4X,'from file ',A/6X,'to file ',A
- F/14X,'Lrec =',I5,' bytes')
-
- NROLD = 0
- NWCEIN = NBYTES/4
-
- 43 NWR = IOS_$GET (IDSTROLD
- +, IOS_$NO_REC_BNDRY_OPT
- +, MBUF, NBYTES, ISTAT)
- IF (ISTAT.NE.0) GO TO 46
-
- CALL IOS_$PUT (IDSTRNEW,0,MBUF,NBYTES,ISTAT)
- IF (ISTAT.NE.0) GO TO 45
- NROLD = NROLD + 1
- GO TO 43
-
- 45 PRINT 9045, NROLD,ISTAT
- 9045 FORMAT (' ******* PUT failed after',I6,
- F' records, ISTAT=',Z9,' hex')
- STOP
-
- 46 IF (ISTAT.EQ.16#05040008) GO TO 71
- IF (ISTAT.EQ.16#01270009) GO TO 71
- PRINT 9048, NROLD,ISTAT
- 9048 FORMAT (' ******* GET failed after',I6,
- F' records, ISTAT= ',Z9,' hex')
- STOP
-
-C---- End
-
- 71 PRINT 9071, NROLD
- 9071 FORMAT (6X,I7,' records copied.')
-
- CALL IOS_$CLOSE (IDSTROLD,ISTAT)
- CALL IOS_$CLOSE (IDSTRNEW,ISTAT)
- CALL PGM_$EXIT
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/apoprogs/fcasplit.F b/src/packlib/kernlib/kerngen/obsolete/kernapo/apoprogs/fcasplit.F
deleted file mode 100644
index ad6369f..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/apoprogs/fcasplit.F
+++ /dev/null
@@ -1,15 +0,0 @@
-*
-* $Id: fcasplit.F,v 1.1.1.1 1996/02/15 17:51:00 mclareni Exp $
-*
-* $Log: fcasplit.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:00 mclareni
-* Kernlib
-*
-*
-#include "kernapo/pilot.h"
-#ifndef CERNLIB_QMAPO
-#define CERNLIB_QMAPO
-#endif
-#ifndef CERNLIB_UTYGEN_FCASPLIT
-#define CERNLIB_UTYGEN_FCASPLIT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/apoprogs/xbanner.F b/src/packlib/kernlib/kerngen/obsolete/kernapo/apoprogs/xbanner.F
deleted file mode 100644
index 1bf889c..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/apoprogs/xbanner.F
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: xbanner.F,v 1.1.1.1 1996/02/15 17:51:00 mclareni Exp $
-*
-* $Log: xbanner.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:00 mclareni
-* Kernlib
-*
-*
-#include "kernapo/pilot.h"
-#ifndef CERNLIB_QMAPO
-#define CERNLIB_QMAPO
-#endif
-#ifndef CERNLIB_QASCII
-#define CERNLIB_QASCII
-#endif
-#ifndef CERNLIB_UTYGEN_XBANNER
-#define CERNLIB_UTYGEN_XBANNER
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/aposys/Imakefile b/src/packlib/kernlib/kerngen/obsolete/kernapo/aposys/Imakefile
deleted file mode 100644
index 2612aa0..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/aposys/Imakefile
+++ /dev/null
@@ -1,7 +0,0 @@
-SRCS_F= \ @@\
- datime.F datimh.F floper.F getarg.F iargc.F intrac.F traceq.F
-
-SRCS_C= \ @@\
- signalf.c
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/aposys/datime.F b/src/packlib/kernlib/kerngen/obsolete/kernapo/aposys/datime.F
deleted file mode 100644
index 3932fd5..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/aposys/datime.F
+++ /dev/null
@@ -1,43 +0,0 @@
-*
-* $Id: datime.F,v 1.1.1.1 1996/02/15 17:51:08 mclareni Exp $
-*
-* $Log: datime.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:08 mclareni
-* Kernlib
-*
-*
-#include "kernapo/pilot.h"
-#if defined(CERNLIB_QF_APO)
- SUBROUTINE DATIME (ND,NT)
-C
-C CERN PROGLIB# Z007 DATIME .VERSION KERNAPO 1.18 890929
-C ORIG. 13/12/83 TL + JZ, CERN
-C MOD. 27/07/89 add /SLATE/, JZ
-C
-C- CALL DATIME (ND,NT) RETURNS INTEGER DATE ND = YYMMDD
-C- INTEGER TIME NT = HHMM
-C- returns also ISL (1) y (2) m (3) d (4) h (5) m (6) s
-C
- COMMON /SLATE/ ISL(40)
- INTEGER*2 MM(6)
- EQUIVALENCE (MM(1),ISL(31))
-
-
- CALL CAL_$DECODE_LOCAL_TIME (MM)
-
- DO 24 J=1,6
- 24 ISL(J) = MM(J)
-
- MM(1) = MOD (MM(1),100)
-
- ND = (INT4(MM(1))*100+INT4(MM(2)))*100 + INT4(MM(3))
- NT = INT4(MM(4)) *100 + INT4(MM(5))
- RETURN
- END
-#ifdef CERNLIB_CCGEN_DATIME
-#undef CERNLIB_CCGEN_DATIME
-#endif
-#ifdef CERNLIB_TCGEN_DATIME
-#undef CERNLIB_TCGEN_DATIME
-#endif
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/aposys/datimh.F b/src/packlib/kernlib/kerngen/obsolete/kernapo/aposys/datimh.F
deleted file mode 100644
index ac4f375..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/aposys/datimh.F
+++ /dev/null
@@ -1,52 +0,0 @@
-*
-* $Id: datimh.F,v 1.1.1.1 1996/02/15 17:51:09 mclareni Exp $
-*
-* $Log: datimh.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:09 mclareni
-* Kernlib
-*
-*
-#include "kernapo/pilot.h"
-#if defined(CERNLIB_QF_APO)
- SUBROUTINE DATIMH (ND,NT)
-C
-C CERN PROGLIB# Z007 DATIMH .VERSION KERNAPO 1.00 831212
-C ORIG. 13/12/83 TL + JZ, CERN
-C
-C
-C- CALL DATIMH (ND,NT) RETURNS HOLLERITH DATE ND = DD/MM/YY
-C- HOLLERITH TIME NT = HH.MM.SS
-C
- COMMON /SLATE/ ISAFE(10), M(27), MM
-C
- DIMENSION ND(2), NT(2)
- INTEGER*2 MM(6)
-
-
- CALL UBLOW (16H0 /0 /000 .0 .00, M, 16)
-C
-C- D D / M M / Y Y H H . M M . S S
-C- 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6
-C
- CALL CAL_$DECODE_LOCAL_TIME (MM)
-
- MM(1) = MOD (MM(1),100)
-
- CALL USET (INT4(MM(1)), M, 7, 8)
- CALL USET (INT4(MM(2)), M, 4, 5)
- CALL USET (INT4(MM(3)), M, 1, 2)
- CALL USET (INT4(MM(4)), M, 9,10)
- CALL USET (INT4(MM(5)), M,12,13)
- CALL USET (INT4(MM(6)), M,15,16)
-
- CALL UBUNCH (M(1),ND,8)
- CALL UBUNCH (M(9),NT,8)
- RETURN
- END
-#ifdef CERNLIB_CCGEN_DATIMH
-#undef CERNLIB_CCGEN_DATIMH
-#endif
-#ifdef CERNLIB_TCGEN_DATIMH
-#undef CERNLIB_TCGEN_DATIMH
-#endif
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/aposys/floper.F b/src/packlib/kernlib/kerngen/obsolete/kernapo/aposys/floper.F
deleted file mode 100644
index 8e7f9a5..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/aposys/floper.F
+++ /dev/null
@@ -1,68 +0,0 @@
-*
-* $Id: floper.F,v 1.1.1.1 1996/02/15 17:51:09 mclareni Exp $
-*
-* $Log: floper.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:09 mclareni
-* Kernlib
-*
-*
-#include "kernapo/pilot.h"
-#if defined(CERNLIB_QF_APO)
- SUBROUTINE FLOPER (MODE, CHFILE, LUNOP)
-
-C- File operations :
-C- MODE = 1 : delete file CHFILE
-C- 2 : change name of file CHFILE to CHFILE.bak
-
-C- Routine used by Patchy and CVFIXTO
-
- COMMON /SLATE/ LUNFLG,MSLATE(39)
- CHARACTER CHFILE*(*), CHLEAF*32, WORK*256
- INTEGER*2 NOLDLG, NLEAFLG, NWORK
-
-
-C-- Measure length of path-name, check file exists
-
- LUNFLG = 0
- NOLD = LNBLNK (CHFILE)
- NOLDLG = NOLD
- CALL NAME_$GET_PATH (CHFILE,NOLDLG,WORK,NWORK,ISTAT)
- IF (ISTAT.NE.0) RETURN
-
- IF (MODE.EQ.2) GO TO 41
- IF (MODE.NE.1) RETURN
-
-C---- Delete file
-
- CALL NAME_$DELETE_FILE (WORK,NWORK,ISTAT)
- RETURN
-
-C---- Rename file
-
-C-- Find start and length of last leaf
-
- 41 ND = ICFILA ('/',CHFILE,1,NOLD)
- IF (ND.GT.NOLD) ND = 0
- NL = MIN (NOLD-ND, 28)
- IF (NL.EQ.0) RETURN
-
-C-- Construct new leaf name, adding .BAK
-
- CHLEAF = CHFILE(ND+1:ND+NL) // '.bak'
- NL = NL + 4
-
-C-- Construct new path-name and delete its file, if any
-
- WORK(NWORK+1:NWORK+4) = '.bak'
- NWORK = NWORK + 4
- CALL NAME_$DELETE_FILE (WORK,NWORK,ISTAT)
-
-C-- Change name
-
- NOLDLG = NOLD
- NLEAFLG = NL
- CALL NAME_$CNAME (CHFILE,NOLDLG,CHLEAF,NLEAFLG,ISTAT)
- LUNFLG = 1
- RETURN
- END
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/aposys/getarg.F b/src/packlib/kernlib/kerngen/obsolete/kernapo/aposys/getarg.F
deleted file mode 100644
index ee7810d..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/aposys/getarg.F
+++ /dev/null
@@ -1,36 +0,0 @@
-*
-* $Id: getarg.F,v 1.1.1.1 1996/02/15 17:51:09 mclareni Exp $
-*
-* $Log: getarg.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:09 mclareni
-* Kernlib
-*
-*
-#include "kernapo/pilot.h"
-#if defined(CERNLIB_QF_APO)
- SUBROUTINE GETARG (JPARA,CHPARA)
-C
-C CERN PROGLIB# GETARG .VERSION KERNAPO 1.20 900328
-C ORIG. 22/03/90 JZ
-C
-C- APOLLO inplementation of UNIX function
-
- CHARACTER CHPARA*(*)
- INTEGER*2 PGM_$GET_ARG, JARG, NCHARG, NCHMAX
-
-
- JARG = JPARA
- NCHMAX = LEN (CHPARA)
- NCHARG = PGM_$GET_ARG (JARG, CHPARA, ISTAT)
-
- IF (NCHARG.GE.NCHMAX) RETURN
- CHPARA(NCHARG+1:NCHMAX) = ' '
- RETURN
- END
-#ifdef CERNLIB_CCGEN_GETARG
-#undef CERNLIB_CCGEN_GETARG
-#endif
-#ifdef CERNLIB_TCGEN_GETARG
-#undef CERNLIB_TCGEN_GETARG
-#endif
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/aposys/iargc.F b/src/packlib/kernlib/kerngen/obsolete/kernapo/aposys/iargc.F
deleted file mode 100644
index abc35d4..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/aposys/iargc.F
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: iargc.F,v 1.1.1.1 1996/02/15 17:51:09 mclareni Exp $
-*
-* $Log: iargc.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:09 mclareni
-* Kernlib
-*
-*
-#include "kernapo/pilot.h"
-#if defined(CERNLIB_QF_APO)
- FUNCTION IARGC ()
-C
-C CERN PROGLIB# IARGC .VERSION KERNAPO 1.20 900328
-C ORIG. 22/03/90 JZ
-C
-C- APOLLO inplementation of UNIX function
-
- INTEGER*2 NARGS
-
-
- CALL PGM_$GET_ARGS (NARGS,LPOIARG)
- IARGC = NARGS - 1
- RETURN
- END
-#ifdef CERNLIB_CCGEN_IARGC
-#undef CERNLIB_CCGEN_IARGC
-#endif
-#ifdef CERNLIB_TCGEN_IARGC
-#undef CERNLIB_TCGEN_IARGC
-#endif
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/aposys/intrac.F b/src/packlib/kernlib/kerngen/obsolete/kernapo/aposys/intrac.F
deleted file mode 100644
index c8a7f78..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/aposys/intrac.F
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: intrac.F,v 1.1.1.1 1996/02/15 17:51:09 mclareni Exp $
-*
-* $Log: intrac.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:09 mclareni
-* Kernlib
-*
-*
-#include "kernapo/pilot.h"
-#if defined(CERNLIB_QF_APO)
- LOGICAL FUNCTION INTRAC (DUMMY)
-C
-C CERN PROGLIB# Z044 INTRAC .VERSION KERNAPO 1.12 880323
-C ORIG. 23/03/88 JZ
-C
-C-- User is on-line if stream 0 behaves like a terminal
-
- IOFLCN = IOS_$INQ_CONN_FLAGS (0,ISTAT)
- IF (AND(IOFLCN,5).EQ.0) THEN
- INTRAC = .FALSE.
- ELSE
- INTRAC = .TRUE.
- ENDIF
- RETURN
- END
-#ifdef CERNLIB_CCGEN_INTRAC
-#undef CERNLIB_CCGEN_INTRAC
-#endif
-#ifdef CERNLIB_TCGEN_INTRAC
-#undef CERNLIB_TCGEN_INTRAC
-#endif
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/aposys/signalf.c b/src/packlib/kernlib/kerngen/obsolete/kernapo/aposys/signalf.c
deleted file mode 100644
index 706f0ab..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/aposys/signalf.c
+++ /dev/null
@@ -1,82 +0,0 @@
-/*
- * $Id: signalf.c,v 1.1.1.1 1996/02/15 17:51:09 mclareni Exp $
- *
- * $Log: signalf.c,v $
- * Revision 1.1.1.1 1996/02/15 17:51:09 mclareni
- * Kernlib
- *
- */
-#include "kernapo/pilot.h"
-#if defined(CERNLIB_QSYSBSD)
-/*> ROUTINE SIGNALF
- CERN PROGLIB# SIGNALF .VERSION KERNAPO 1.22 910313
- ORIG. 11/03/91, JZ
- Fortran interface routine to sigvec
- (using sigvec rather than signal to be sure not to pick it
- from the Fortran interface library)
-
- IOLD = SIGNALF (ISIGNO, FUNC, IFLAG)
-
- ISIGNO : signal number
- FUNC : signal handler if IFLAG = -1
- IFLAG : < 0 : FUNC is the handler
- = 0 : use default action
- = 1 : ignore signal
- > 1 : adr returned by earlier call
-
- IOLD returns the previous handler and can be used
- to restore it later.
-*/
-#include <stdio.h>
-#include <errno.h>
-#if defined(CERNLIB_QX_SC)
-long signalf_(signum, proc, flag)
-#endif
-#if defined(CERNLIB_QXNO_SC)
-long signalf(signum, proc, flag)
-#endif
- long *signum, *flag;
- long *proc;
-{
- struct mysig {
- int sv_handler;
- int sv_mask;
- int sv_flags; };
-
- struct mysig newbuf;
- struct mysig oldbuf;
- int sigvec();
- int siguse, istat;
-
- siguse = *signum;
-/* printf (" entry Signalf %d flag: %d \n", siguse, *flag); */
-
- if (*flag < 0)
- { newbuf.sv_handler = *proc;
-/* printf (" proc, *proc: %x %x \n", proc, *proc); */
- }
- else
- { newbuf.sv_handler = *flag;
-/* printf (" mode: %x \n", *flag); */
- }
-
- newbuf.sv_mask = 0;
- newbuf.sv_flags = 0;
-
-/* printf (" struct newbuf = %x %x %x\n",
- newbuf.sv_handler, newbuf.sv_mask, newbuf.sv_flags); */
-
- istat = sigvec(siguse, &newbuf, &oldbuf);
-/* printf (" sigvec returns status %d \n", istat); */
-
- if (istat == 0) return oldbuf.sv_handler;
- return -errno;
-}
-/*> END <----------------------------------------------------------*/
-#ifdef CERNLIB_CCGEN_SIGNALF
-#undef CERNLIB_CCGEN_SIGNALF
-#endif
-#ifdef CERNLIB_TCGEN_SIGNALF
-#undef CERNLIB_TCGEN_SIGNALF
-#endif
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/aposys/traceq.F b/src/packlib/kernlib/kerngen/obsolete/kernapo/aposys/traceq.F
deleted file mode 100644
index 8aa381b..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/aposys/traceq.F
+++ /dev/null
@@ -1,100 +0,0 @@
-*
-* $Id: traceq.F,v 1.1.1.1 1996/02/15 17:51:09 mclareni Exp $
-*
-* $Log: traceq.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:09 mclareni
-* Kernlib
-*
-*
-#include "kernapo/pilot.h"
- SUBROUTINE TRACEQ (LUN, NLEV)
-C
-C CERN PROGLIB# N105 TRACEQ .VERSION KERNAPO 1.17 890626
-C ORIG. 19/05/89 R. Wilhelm NIKHEF-H
-C
-C Fork a new process to do a traceback on the current process.
-C
-C LUN - Logical unit number of the print file
-C 0 = standard print file (unit 6)
-C NLEV - Maximum number of trace-back levels to print
-C
-%include '/sys/ins/pgm.ins.ftn'
-%include '/sys/ins/base.ins.ftn'
-
- INTEGER*4 ADDRESS(2), OUTSTR, HANDLE
- INTEGER*2 ARGCOUNT,NSTREAM,CONVEC(4),NAME(2),ARG(25)
- INTEGER*2 MODE
-
- CHARACTER CHPID*20, CHEDT*26
- EQUIVALENCE (CHPID,ARG(3))
- EQUIVALENCE (CHEDT,ARG(13))
-
- INTEGER GETPID
-
-C-- Handle Logical output unit
-
- IF (LUN.EQ.0) THEN
- LOUT = 6
- ELSE
- LOUT = LUN
- ENDIF
-
- WRITE (LOUT, '(/,A,/)') '***** TRACEQ: In-Line Trace-Back *****'
-
- NAME(1) = 2
- NAME(2) = 'sh'
- ARG(1) = 48
- ARG(2) = 'tb'
-
-C-- Get current UNIX process number
-
- IPID = GETPID()
- WRITE(CHPID,'(A1,I19)') ' ', IPID
-
-C-- The first 5 routine names are system routines which
-C-- the user should not care about. At maximum NLEV lines
-C-- of traceback information are printed.
-
- ILAST = NLEV + 5
- IF (ILAST.LT.999) THEN
- WRITE(CHEDT, '(A,I3,A)') ' | edstr -e 1,5d -e ', ILAST, ',$d'
- ELSE
- CHEDT = ' | edstr -e 1,5d'
- ENDIF
-
-C-- Get the STREAM identifier of FORTRAN unit LOUT
-
- INQUIRE(LOUT, STRID=OUTSTR, IOSTAT=IST)
- IF (IST.NE.STATUS_$OK) THEN
- OUTSTR = STREAM_$STDOUT
- ENDIF
-
-C-- Set up the streams to be passed to the new process:
-C-- Standard input, output; Error input, output.
-C-- Note that we cannot use parameters for the last two
-C-- differences between the SR9.7 and SR10 insert files.
-
- NSTREAM = 4
- CONVEC(1) = STREAM_$STDIN
- CONVEC(2) = OUTSTR
- CONVEC(3) = 2
- CONVEC(4) = 3
-
- ARGCOUNT = 2
- ADDRESS(1) = IADDR(NAME)
- ADDRESS(2) = IADDR(ARG)
-
-C-- Invoke command: /com/sh tb unix_pid | edstr -e 1,5d
-
- MODE = 0
- CALL PGM_$INVOKE('/com/sh', INT2(7), ARGCOUNT, ADDRESS,
- + NSTREAM, CONVEC, MODE, HANDLE, IST)
- CALL PGM_$PROC_WAIT(HANDLE, IST)
- RETURN
- END
-#ifdef CERNLIB_CCGEN_TRACEQ
-#undef CERNLIB_CCGEN_TRACEQ
-#endif
-#ifdef CERNLIB_TCGEN_TRACEQ
-#undef CERNLIB_TCGEN_TRACEQ
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/history/history.dat b/src/packlib/kernlib/kerngen/obsolete/kernapo/history/history.dat
deleted file mode 100644
index c292d57..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/history/history.dat
+++ /dev/null
@@ -1,49 +0,0 @@
-*
-* $Id: history.dat,v 1.1.1.1 1996/02/15 17:50:58 mclareni Exp $
-*
-* $Log: history.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:50:58 mclareni
-* Kernlib
-*
-*
-* This directory was created from kernapo.car patch kernapo
-#if !defined(CERNLIB_KERNAPO)
-
- KERNLIB ROUTINES PARTICULAR TO THE APOLLO
-
----------------------------------------------------------------------
-
- This file contains the following patches :
-
-*KAPO Pilot-patch selecting the standard KERNLIB for Apollo
-
-*KAPOL Pilot-patch selecting a KERNLIB not used
- together with the C library (for Patchy)
-
-QMAPO Apollo machine patch
-
-APOPROGS Utility programs to run on Apollo
-
-APOGS Apollo versions of general KERNLIB routines
-
-APOSYS Apollo versions of KERNLIB system routines
-
- The following option can be selected :
-
-QMAPO10 if the DN 10000 is the target machine
-
-QF_APO = QMAPOFTN
- the compiler to be used is "/com/ftn", note:
- Apollo default filenames .ftn and .bin;
- hidden character length variable passed
- as 2-byte integer by address.
-
-QF_APO77 = QMAPOF77
- the compiler to be used is "/bin/f77", note:
- appended underscore to subprogram and common block names;
- UNIX default filenames .f and .o;
- hidden character length variable passed
- as 4-byte integer by value.
-
-=====================================================================
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/history/previous.dat b/src/packlib/kernlib/kerngen/obsolete/kernapo/history/previous.dat
deleted file mode 100644
index 0f9ffe2..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/history/previous.dat
+++ /dev/null
@@ -1,325 +0,0 @@
-*
-* $Id: previous.dat,v 1.1.1.1 1996/02/15 17:50:58 mclareni Exp $
-*
-* $Log: previous.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:50:58 mclareni
-* Kernlib
-*
-*
-#if !defined(CERNLIB_KERNFOR)
-
-UP-DATE 1.25 : 21-Nov-1992
-----------------------------
-
-Replacing File KERNAPO 1.24 920703 12.06
-
-Correct : LENOCC for Apollo 10000
-
----------------------------------------------------------------------
-
-UP-DATE 1.24 : 11-May-1992
-----------------------------
-
-Replacing File KERNAPO 1.23 910719 13.00
-
-New Patch : *KAPOF77 pilot for /bin/f77
-
-New Option : QMAPOF77 to compile with /bin/f77
- QMAPOFTN to compile with /com/ftn
-
-New Deck : LENOCC written in C
-
-Correct : UCOPY, VBLANK, VFILL, VZERO missing DIMENSION
-
-Delete : TIMED, TIMEX use the routines from KERNFOR
-
----------------------------------------------------------------------
-
-UP-DATE 1.23 : 18-July-1991
-----------------------------
-
-Replacing File KERNAPO 1.22 910313 10.14
-
-Delete : GSHOW, QNEXTE use the routines from KERNFOR
-
-Correct : activate the statement function definitions
- in P=QMAPO; apparently for Fortran 10.8 this is
- now efficient.
-
----------------------------------------------------------------------
-
-UP-DATE 1.22 : 13-Mar-1991
-----------------------------
-
-Replacing File KERNAPO 1.21 900731 14.54
-
-New Patches : P=*KAPO to be used
- *KAPOL only for Patchy
- P=APOCCR to hold routines clashing with
- the C library
-
-New Deck : P=APOSYS, D=SIGNALF
-
-Correct : connect P=CCGEN of KERNFOR
-
- P=APOSYS, D=CHDIR,GETCWD,GETENV,RENAME UNIX functions
- moved into the new P=APOCCR
-
-Delete : P=APOPROGS, D=FPREP.
-
----------------------------------------------------------------------
-
-UP-DATE 1.21 : 31-July-1990
-----------------------------
-
-Replacing File KERNAPO 1.20 900328 17.31
-
-New Decks : CHDIR, GETCWD, GETENV, RENAME UNIX functions
-
-Correct : XBANNER use new version now on KERNFOR
- FLOPER change of calling sequence
- FCASPLIT for change in FLOPER
-
----------------------------------------------------------------------
-
-UP-DATE 1.20 : 28-Mar-1990
-----------------------------
-
-Replacing File KERNAPO 1.19 891207 22.34
-
-New Decks : GETARG, IARGC UNIX functions
- CVFIXTO in P=APOPROGS moved to here from Patchy
- FLOPER in P=APOSYS moved to here from Patchy
-
-Correct : FCASPLIT use new version now on KERNFOR
-
----------------------------------------------------------------------
-
-UP-DATE 1.19 : 7-DEC-1989
-----------------------------
-
-Replacing File KERNAPO 1.18 891018 14.57
-
-New Decks : LOCB return the byte adr of a variable
-
-Correct : RNDM correct result from IRNDM
-
-Delete : Use new routines from KERNFOR :
- ABEND, FLOARG, INTARG, IUMODE, JOBNAM, UFLINT
-
----------------------------------------------------------------------
-
-UP-DATE 1.18 : 29-Sept-1989
-----------------------------
-
-Replacing File KERNAPO 1.17 890628 12.05
-
-New Decks : XBANNER in P=APOPROGS
-
-Correct : DATIME to return seconds in /SLATE/
- JUMPX2 add entries JUMPX1 and JUMPX0
-
----------------------------------------------------------------------
-
-UP-DATE 1.17 : 26-june-1989
-----------------------------
-
-Replacing File KERNAPO 1.16 890321 21.33
-
-New Decks : LVMAXA for speed
- VCOPYN, VDOT, VDOTN, VDOTN2, VLINCO
- VMATL, VMATR, VMAXA, VMOD, VSCALE, VSUB
- UCOPIV, UFILL, UZERO
-
- FCASPLIT in P=APOPROGS
-
-Correct : TRACEQ replace dummy by true routine
-
-Deleted : XINB, XINBS the new defaults on KERNFOR are good
-
----------------------------------------------------------------------
-
-UP-DATE 1.16 : 21-mar-1989
-----------------------------
-
-Replacing File KERNAPO 1.15 881020 21.18
-
-New option : QMAPO10 for the DN 1000
-
-New Decks : USWOP for speed
- KERNGT to eventually replace GSHOW
-
-Correct : LOCF for DN 10000
- UCOPY2 bring back the fast version, Apollo
- have corrected the bug in VEC_COPY
-
----------------------------------------------------------------------
-
-UP-DATE 1.15 : 20-oct-1988
-----------------------------
-
-Replacing File KERNAPO 1.14 880715 15.37
-
-Correct : CBYT formal change to match statement function
- RNDM correct multiplier 69069
- FPREP fix bug in utility program
- QNEXTE, TIMED SAVE variables to be saved
-
----------------------------------------------------------------------
-
-UP-DATE 1.14 : 13-jul-1988
-----------------------------
-
-Replacing File KERNAPO 1.13 880425 20.47
-
-Correct : RNDM avoid exact zero result
-Delete : NOARG dummy is now on KERNFOR
-New patch : APOPROGS utility programs for Apollo
-
----------------------------------------------------------------------
-
-UP-DATE 1.13 : 25-apr-1988
-----------------------------
-
-Replacing File KERNAPO 1.12 880323 11.29
-
-New Decks : P=APOSYS, D=JUMPAD, JUMPX2
-
----------------------------------------------------------------------
-
-UP-DATE 1.12 : 23-MAR-1988
-----------------------------
-
-Replacing File KERNAPO 1.11 880222 17.42
-
-Modifs : P=APOSYS, D=INTRAC
-New Decks : P=APOGS, D=RNDM containing entries IRNDM etc
-Deleted : P=APOSYS, D=IRNDM, RNDM
-
----------------------------------------------------------------------
-
-UP-DATE 1.11 : 22-FEB-1988
-----------------------------
-
-Replacing File KERNAPO 1.10 870525 19.24
-
-Modifs : P=APOGS, D=UBLOW, UBUNCH
- D=UCTOH1, UCTOH
- D=UH1TOC, UHTOC re-written for speed
-
----------------------------------------------------------------------
-
-UP-DATE 1.10 : 24-MAY-1987
-----------------------------
-
-Replacing File KERNAPO 1.09 861204 21.03
-
-New Decks : P=APOGS, D=IANDETC, JBYTOR
- D=MBYTET, MBYTOR, MCBYT
- D=MSBIT, MSBIT0, MSBIT1, MSBYT
- D=BTEST, IBCLR, IBSET, ISHFT
-
-Modifs : P=QMAPO new Q$ sequences added
-
----------------------------------------------------------------------
-
-UP-DATE 1.09 : 4-DEC-1986
-----------------------------
-
-Replacing File KERNAPO 1.08 860514 20.17
-
-New Decks : P=APOSYS, D=INTRAC, NOARG (Dummies)
-
----------------------------------------------------------------------
-
-UP-DATE 1.08 : 14-MAY-1986
-----------------------------
-
-Replacing File KERNAPO 1.07 860212 20.07
-
-New Decks : P=APOSYS, D=IRNDM
-
-Modifs : P=APOGS, D=JBYT, JBYTET Re-written
- P=QMAPO Add Z=Q$ANDOR, Q$SHIFT
-
----------------------------------------------------------------------
-
-UP-DATE 1.07 : 12-FEB-1986
-----------------------------
-
-Replacing File KERNAPO 1.06 851211 12.47
-
-New Decks : P=APOGS, D=UCTOH1, UCTOH
-
-Modifs : P=APOGS, D=UBLOW entry UCTOH1 removed
-
----------------------------------------------------------------------
-
-UP-DATE 1.06 : 11-DEC-1985
-----------------------------
-
-Replacing File KERNAPO 1.05 850327 17.48
-
-New Decks : P=APOGS, D=UH1TOC, UHTOC
-
----------------------------------------------------------------------
-
-UP-DATE 1.05 : 27-MAR-1985
-----------------------------
-
-Replacing File KERNAPO 1.04 850321 16.35
-
-New Decks : P=APOSYS, D=QNEXTE, TRACEQ
-
----------------------------------------------------------------------
-
-UP-DATE 1.04 : 21-MAR-1985
-----------------------------
-
-Replacing File KERNAPO 1.03 840216 11.21
-
-New Patch : P=APOSYS SPLIT OFF WITH
- D= ABEND,DATIME,DATIMH,JOBNAM,RNDM
-
-New Decks : P=APOGS, D=UCOPY,UCOPY2,
- D=VADD,VBIAS,VBLANK,VFILL,VSUM,VZERO
-
- P=APOSYS, D=TIMED, TIMEX
-
-Modifs : P=APOSYS, D=RNDM
-
----------------------------------------------------------------------
-
-UP-DATE 1.03 : 15-FEB-1984
-----------------------------
-
-Replacing File KERNAPO 1.02 831219 21.50
-
-Modifs : P=*KAPOL new version of Z=Q$JBIT, Q$JBYTET
-
----------------------------------------------------------------------
-
-UP-DATE 1.02 : 19-DEC-1983
-----------------------------
-
-Replacing File KERNAPO 1.01 831216 19.17
-
-New Decks : D=RNDM
-Modifs : D=XINB, XINBS
-
----------------------------------------------------------------------
-
-UP-DATE 1.01 : 16-DEC-1983
-----------------------------
-
-Replacing File KERNAPO 1.00 831213 22.00
-
-More routines added
-
----------------------------------------------------------------------
-
- FIRST RELEASE OF THE KERNAPO PAM : 13-DEC-1983
-
----------------------------------------------------------------------
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/history/update.dat b/src/packlib/kernlib/kerngen/obsolete/kernapo/history/update.dat
deleted file mode 100644
index a6ec7bb..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/history/update.dat
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: update.dat,v 1.1.1.1 1996/02/15 17:50:58 mclareni Exp $
-*
-* $Log: update.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:50:58 mclareni
-* Kernlib
-*
-*
-#if !defined(CERNLIB_KERNAPO)
-
-
- UP-DATE RECORD FOR THE PAM-FILE KERNAPO
- ----------------------------------------
-
-
-UP-DATE 1.26 : 31-May-1994
-----------------------------
-
-Replacing File KERNAPO 1.25 921006 12.01
-
-Selection on P=P5BOOT for the Patchy boot-strap export
-
-Re-organize the pilots *KAPOF77 and *KAPO a bit, delete P=*KAPOL
-
-New names : QF_APO77 for QMAPOF77 to compile with /bin/f77
- QF_APO for QMAPOFTN to compile with /com/ftn
-
-Delete: p=APOSYS, D=JUMPAD,JUMPX2 use routines on KERNFOR
-
----------------------------------------------------------------------
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/inhibit.list b/src/packlib/kernlib/kerngen/obsolete/kernapo/inhibit.list
deleted file mode 100644
index 52b6a93..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/inhibit.list
+++ /dev/null
@@ -1,103 +0,0 @@
-tcgen/kerngt
-tcgen/btest
-tcgen/cbyt
-tcgen/ibclr
-tcgen/ibset
-tcgen/incbyt
-tcgen/ishft
-tcgen/iuforw
-tcgen/jbit
-tcgen/jbyt
-tcgen/jbytet
-tcgen/jbytor
-tcgen/jrsbyt
-tcgen/lenocc
-tcgen/locbyt
-ccgen/locb
-tcgen/locb
-ccgen/locf
-tcgen/locf
-tcgen/lvmaxa
-tcgen/mbytet
-tcgen/mbytor
-tcgen/mcbyt
-tcgen/msbit
-tcgen/msbit0
-tcgen/msbit1
-tcgen/msbyt
-tcgen/pkbyt
-tcgen/rndm
-tcgen/irndm
-tcgen/sbit
-tcgen/sbit0
-tcgen/sbit1
-tcgen/sbyt
-tcgen/sbytor
-tcgen/ublow
-tcgen/ubunch
-tcgen/ucopy
-tcgen/ucopy2
-tcgen/ucopiv
-tcgen/uctoh1
-tcgen/uctoh
-tcgen/ufill
-tcgen/uh1toc
-tcgen/uhtoc
-tcgen/upkbyt
-tcgen/uswop
-tcgen/uzero
-tcgen/vadd
-tcgen/vbias
-tcgen/vblank
-tcgen/vcopyn
-tcgen/vdot
-tcgen/vdotn
-tcgen/vdotn2
-tcgen/vfill
-tcgen/vlinco
-tcgen/vmatl
-tcgen/vmatr
-tcgen/vmaxa
-tcgen/vmod
-tcgen/vscale
-tcgen/vsub
-tcgen/vsum
-tcgen/vzero
-ccgen/datime
-tcgen/datime
-ccgen/datimh
-tcgen/datimh
-ccgen/getarg
-tcgen/getarg
-ccgen/iargc
-tcgen/iargc
-ccgen/intrac
-tcgen/intrac
-ccgen/signalf
-tcgen/signalf
-ccgen/traceq
-tcgen/traceq
-ccgen/chdir
-tcgen/chdir
-ccgen/getcwd
-tcgen/getcwd
-ccgen/getenv
-tcgen/getenv
-ccgen/rename
-tcgen/rename
-ccgen/qnexte
-tcgen/qnexte
-tcgen/uctoh1
-tcgen/uctoh
-tcgen/uh1toc
-tcgen/uhtoc
-ccgen/chdirf
-tcgen/chdirf
-ccgen/getcwdf
-tcgen/getcwdf
-ccgen/getenvf
-tcgen/getenvf
-ccgen/renamef
-tcgen/renamef
-ccgen/jumpxn
-tcgen/jumpxn
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/kernapo/q_andor.inc b/src/packlib/kernlib/kerngen/obsolete/kernapo/kernapo/q_andor.inc
deleted file mode 100644
index ef0bd69..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/kernapo/q_andor.inc
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: q_andor.inc,v 1.1.1.1 1996/02/15 17:50:59 mclareni Exp $
-*
-* $Log: q_andor.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:50:59 mclareni
-* Kernlib
-*
-*
-#ifndef CERNLIB_KERNAPO_Q_ANDOR_INC
-#define CERNLIB_KERNAPO_Q_ANDOR_INC
-*
-*
-* q_andor.inc
-*
-#if defined(CERNLIB_P5BOOT)
- IAND (IZV,IZW) = AND (IZV, IZW)
- IOR (IZV,IZW) = OR (IZV, IZW)
- IEOR (IZV,IZW) = XOR (IZV, IZW)
-* NOT is standard on APOLLO
-#endif
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/kernapo/q_cbyt.inc b/src/packlib/kernlib/kerngen/obsolete/kernapo/kernapo/q_cbyt.inc
deleted file mode 100644
index 569e799..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/kernapo/q_cbyt.inc
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: q_cbyt.inc,v 1.1.1.1 1996/02/15 17:50:59 mclareni Exp $
-*
-* $Log: q_cbyt.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:50:59 mclareni
-* Kernlib
-*
-*
-#ifndef CERNLIB_KERNAPO_Q_CBYT_INC
-#define CERNLIB_KERNAPO_Q_CBYT_INC
-*
-*
-* q_cbyt.inc
-*
-#if defined(CERNLIB_P5BOOT)
- MCBYT (MZ,IZQ,IZW,IZP,NZB) = OR (
- + AND (IZW, NOT(LSHFT (RSHFT(NOT(INT4(0)),32-NZB), IZP-1)))
- + , RSHFT (LSHFT(RSHFT(MZ,IZQ-1),32-NZB), 33-IZP-NZB) )
-#endif
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/kernapo/q_isabit.inc b/src/packlib/kernlib/kerngen/obsolete/kernapo/kernapo/q_isabit.inc
deleted file mode 100644
index 5a9afed..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/kernapo/q_isabit.inc
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: q_isabit.inc,v 1.1.1.1 1996/02/15 17:50:59 mclareni Exp $
-*
-* $Log: q_isabit.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:50:59 mclareni
-* Kernlib
-*
-*
-#ifndef CERNLIB_KERNAPO_Q_ISABIT_INC
-#define CERNLIB_KERNAPO_Q_ISABIT_INC
-*
-*
-* q_isabit.inc
-*
-#if defined(CERNLIB_P5BOOT)
- BTEST(IZW,IZP) = AND (IZW,LSHFT(1,IZP)) .NE. 0
- IBSET(IZW,IZP) = OR (IZW,LSHFT(1,IZP))
- IBCLR(IZW,IZP) = AND (IZW,NOT(LSHFT(1,IZP)))
- IBITS (IZW,IZP,NZB) = RSHFT (LSHFT(IZW,32-IZP-NZB), 32-NZB)
-#endif
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/kernapo/q_jbit.inc b/src/packlib/kernlib/kerngen/obsolete/kernapo/kernapo/q_jbit.inc
deleted file mode 100644
index fbe7540..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/kernapo/q_jbit.inc
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: q_jbit.inc,v 1.1.1.1 1996/02/15 17:50:59 mclareni Exp $
-*
-* $Log: q_jbit.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:50:59 mclareni
-* Kernlib
-*
-*
-#ifndef CERNLIB_KERNAPO_Q_JBIT_INC
-#define CERNLIB_KERNAPO_Q_JBIT_INC
-*
-*
-* q_jbit.inc
-*
-#if defined(CERNLIB_P5BOOT)
- JBIT (IZW,IZP) = AND (RSHFT(IZW,IZP-1), 1)
- JBYT (IZW,IZP,NZB)= RSHFT (LSHFT(IZW,33-IZP-NZB), 32-NZB)
-#endif
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/kernapo/q_jbytet.inc b/src/packlib/kernlib/kerngen/obsolete/kernapo/kernapo/q_jbytet.inc
deleted file mode 100644
index 39b9135..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/kernapo/q_jbytet.inc
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: q_jbytet.inc,v 1.1.1.1 1996/02/15 17:50:59 mclareni Exp $
-*
-* $Log: q_jbytet.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:50:59 mclareni
-* Kernlib
-*
-*
-#ifndef CERNLIB_KERNAPO_Q_JBYTET_INC
-#define CERNLIB_KERNAPO_Q_JBYTET_INC
-*
-*
-* q_jbytet.inc
-*
-#if defined(CERNLIB_P5BOOT)
- JBYTET (MZ,IZW,IZP,NZB) = AND (MZ,
- + RSHFT (LSHFT(IZW,33-IZP-NZB), 32-NZB) )
- JBYTOR (MZ,IZW,IZP,NZB) = OR (MZ,
- + RSHFT (LSHFT(IZW,33-IZP-NZB), 32-NZB) )
- MBYTET (MZ,IZW,IZP,NZB) = AND (IZW, NOT(RSHFT (
- + LSHFT(NOT(MZ),32-NZB), 33-IZP-NZB)) )
- MBYTOR (MZ,IZW,IZP,NZB) = OR (IZW, RSHFT (
- + LSHFT(MZ,32-NZB), 33-IZP-NZB) )
-#endif
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/kernapo/q_sbit.inc b/src/packlib/kernlib/kerngen/obsolete/kernapo/kernapo/q_sbit.inc
deleted file mode 100644
index a0348a3..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/kernapo/q_sbit.inc
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: q_sbit.inc,v 1.1.1.1 1996/02/15 17:50:59 mclareni Exp $
-*
-* $Log: q_sbit.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:50:59 mclareni
-* Kernlib
-*
-*
-#ifndef CERNLIB_KERNAPO_Q_SBIT_INC
-#define CERNLIB_KERNAPO_Q_SBIT_INC
-*
-*
-* q_sbit.inc
-*
-#if defined(CERNLIB_P5BOOT)
- MSBIT0 (IZW,IZP) = AND (IZW, NOT(LSHFT(1,IZP-1)) )
- MSBIT1 (IZW,IZP) = OR (IZW, LSHFT(1,IZP-1) )
- MSBIT (MZ,IZW,IZP) = OR (AND (IZW, NOT(LSHFT(1,IZP-1)) )
- + , LSHFT(AND(MZ,1),IZP-1) )
-#endif
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/kernapo/q_sbyt.inc b/src/packlib/kernlib/kerngen/obsolete/kernapo/kernapo/q_sbyt.inc
deleted file mode 100644
index 0695531..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/kernapo/q_sbyt.inc
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: q_sbyt.inc,v 1.1.1.1 1996/02/15 17:50:59 mclareni Exp $
-*
-* $Log: q_sbyt.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:50:59 mclareni
-* Kernlib
-*
-*
-#ifndef CERNLIB_KERNAPO_Q_SBYT_INC
-#define CERNLIB_KERNAPO_Q_SBYT_INC
-*
-*
-* q_sbyt.inc
-*
-#if defined(CERNLIB_P5BOOT)
- MSBYT (MZ,IZW,IZP,NZB) = OR (
- + AND (IZW, NOT(LSHFT (RSHFT(NOT(INT4(0)),32-NZB), IZP-1)))
- + , RSHFT (LSHFT(MZ,32-NZB), 33-IZP-NZB) )
-#endif
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/kernapo/q_shift.inc b/src/packlib/kernlib/kerngen/obsolete/kernapo/kernapo/q_shift.inc
deleted file mode 100644
index 5311802..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/kernapo/q_shift.inc
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: q_shift.inc,v 1.1.1.1 1996/02/15 17:50:59 mclareni Exp $
-*
-* $Log: q_shift.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:50:59 mclareni
-* Kernlib
-*
-*
-#ifndef CERNLIB_KERNAPO_Q_SHIFT_INC
-#define CERNLIB_KERNAPO_Q_SHIFT_INC
-*
-*
-* q_shift.inc
-*
-#if defined(CERNLIB_P5BOOT)
- ISHFTL (IZW,NZB) = LSHFT (IZW, NZB)
- ISHFTR (IZW,NZB) = RSHFT (IZW, NZB)
-#endif
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/kernapo/qcardl.inc b/src/packlib/kernlib/kerngen/obsolete/kernapo/kernapo/qcardl.inc
deleted file mode 100644
index e175213..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/kernapo/qcardl.inc
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: qcardl.inc,v 1.1.1.1 1996/02/15 17:50:59 mclareni Exp $
-*
-* $Log: qcardl.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:50:59 mclareni
-* Kernlib
-*
-*
-#ifndef CERNLIB_KERNAPO_QCARDL_INC
-#define CERNLIB_KERNAPO_QCARDL_INC
-*
-*
-* qcardl.inc
-*
-#if defined(CERNLIB_P5BOOT)
-C====================================================================
-#endif
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernapo/kernapo/qmapo.h b/src/packlib/kernlib/kerngen/obsolete/kernapo/kernapo/qmapo.h
deleted file mode 100644
index 1fda32a..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernapo/kernapo/qmapo.h
+++ /dev/null
@@ -1,42 +0,0 @@
-*
-* $Id: qmapo.h,v 1.1.1.1 1996/02/15 17:50:59 mclareni Exp $
-*
-* $Log: qmapo.h,v $
-* Revision 1.1.1.1 1996/02/15 17:50:59 mclareni
-* Kernlib
-*
-*
-* This directory was created from kernapo.car patch qmapo
-#ifndef CERNLIB_A4
-#define CERNLIB_A4
-#endif
-#ifndef CERNLIB_B32
-#define CERNLIB_B32
-#endif
-#ifndef CERNLIB_HEX
-#define CERNLIB_HEX
-#endif
-* Character set is ASCII
-#ifndef CERNLIB_QASCII
-#define CERNLIB_QASCII
-#endif
-* Hollerith constants exist
-#ifndef CERNLIB_QHOLL
-#define CERNLIB_QHOLL
-#endif
-* EQUIVALENCE Hollerith/Character ok
-#ifndef CERNLIB_EQUHOLCH
-#define CERNLIB_EQUHOLCH
-#endif
-* Orthodox Hollerith storage left to right
-#ifndef CERNLIB_QORTHOLL
-#define CERNLIB_QORTHOLL
-#endif
-* Internal double-precision
-#ifndef CERNLIB_INTDOUBL
-#define CERNLIB_INTDOUBL
-#endif
-* IEEE floating point
-#ifndef CERNLIB_QIEEE
-#define CERNLIB_QIEEE
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/_kcdc60/pilot.h b/src/packlib/kernlib/kerngen/obsolete/kerncdc/_kcdc60/pilot.h
deleted file mode 100644
index e52a40d..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/_kcdc60/pilot.h
+++ /dev/null
@@ -1,18 +0,0 @@
-#if 0
-* This pilot patch was created from kerncdc.car patch _kcdc60
-#endif
-#if 0
-* KERNLIB CDC FORTRAN 4 FOR SCOPE 3.4
-#endif
-#ifndef CERNLIB_XVECTCDC
-#define CERNLIB_XVECTCDC
-#endif
-#ifndef CERNLIB_XSCOPE3
-#define CERNLIB_XSCOPE3
-#endif
-#ifndef CERNLIB_CDC60SYS
-#define CERNLIB_CDC60SYS
-#endif
-#ifndef CERNLIB__KCDC
-#define CERNLIB__KCDC
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/_kcdc76/pilot.h b/src/packlib/kernlib/kerngen/obsolete/kerncdc/_kcdc76/pilot.h
deleted file mode 100644
index d0bb4c8..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/_kcdc76/pilot.h
+++ /dev/null
@@ -1,18 +0,0 @@
-#if 0
-* This pilot patch was created from kerncdc.car patch _kcdc76
-#endif
-#if 0
-* KERNLIB CDC FORTRAN 4 ON 7600
-#endif
-#ifndef CERNLIB_XVECTCDC
-#define CERNLIB_XVECTCDC
-#endif
-#ifndef CERNLIB_XSCOPE2
-#define CERNLIB_XSCOPE2
-#endif
-#ifndef CERNLIB_CDC76SYS
-#define CERNLIB_CDC76SYS
-#endif
-#ifndef CERNLIB__KCDC
-#define CERNLIB__KCDC
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/_knos/pilot.h b/src/packlib/kernlib/kerngen/obsolete/kerncdc/_knos/pilot.h
deleted file mode 100644
index 59f1b8f..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/_knos/pilot.h
+++ /dev/null
@@ -1,33 +0,0 @@
-#if 0
-* This pilot patch was created from kerncdc.car patch _knos
-#endif
-#if 0
-* KERNLIB CDC FORTRAN 4 FOR NOS
-#endif
-#if 0
-* FORTRAN VERSION 4.7 (SEE D=KFILE)
-#endif
-#ifndef CERNLIB_FTN47
-#define CERNLIB_FTN47
-#endif
-#ifndef CERNLIB_XVECTCDC
-#define CERNLIB_XVECTCDC
-#endif
-#ifndef CERNLIB_XSCOPE3
-#define CERNLIB_XSCOPE3
-#endif
-#ifndef CERNLIB_CDCNOS
-#define CERNLIB_CDCNOS
-#endif
-#ifndef CERNLIB__KCDC
-#define CERNLIB__KCDC
-#endif
-#ifndef CERNLIB_CDC60SYS_JOBNAM
-#define CERNLIB_CDC60SYS_JOBNAM
-#endif
-#ifndef CERNLIB_CDC60SYS_REPINIT
-#define CERNLIB_CDC60SYS_REPINIT
-#endif
-#ifdef CERNLIB_CDCSYS_INCMEM
-#undef CERNLIB_CDCSYS_INCMEM
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/_knosbe/pilot.h b/src/packlib/kernlib/kerngen/obsolete/kerncdc/_knosbe/pilot.h
deleted file mode 100644
index 5bac716..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/_knosbe/pilot.h
+++ /dev/null
@@ -1,45 +0,0 @@
-#if 0
-* This pilot patch was created from kerncdc.car patch _knosbe
-#endif
-#if 0
-* KERNLIB CDC FORTRAN 4 FOR NOS/BE
-#endif
-#if 0
-* FORTRAN VERSION 4.7 (SEE D=KFILE)
-#endif
-#ifndef CERNLIB_FTN47
-#define CERNLIB_FTN47
-#endif
-#ifndef CERNLIB_XVECTCDC
-#define CERNLIB_XVECTCDC
-#endif
-#ifndef CERNLIB_XSCOPE3
-#define CERNLIB_XSCOPE3
-#endif
-#ifndef CERNLIB_CDCNOSBE
-#define CERNLIB_CDCNOSBE
-#endif
-#ifndef CERNLIB__KCDC
-#define CERNLIB__KCDC
-#endif
-#ifndef CERNLIB_CDCNOS_DETACH
-#define CERNLIB_CDCNOS_DETACH
-#endif
-#ifndef CERNLIB_CDCNOS_RETRNF
-#define CERNLIB_CDCNOS_RETRNF
-#endif
-#ifndef CERNLIB_CDCNOS_DMPFIT
-#define CERNLIB_CDCNOS_DMPFIT
-#endif
-#ifndef CERNLIB_CDCNOS_LOAFIT
-#define CERNLIB_CDCNOS_LOAFIT
-#endif
-#ifndef CERNLIB_CDC60SYS_JOBNAM
-#define CERNLIB_CDC60SYS_JOBNAM
-#endif
-#ifndef CERNLIB_CDC60SYS_REPINIT
-#define CERNLIB_CDC60SYS_REPINIT
-#endif
-#ifdef CERNLIB_CDCSYS_INCMEM
-#undef CERNLIB_CDCSYS_INCMEM
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/_kvcdc76/pilot.h b/src/packlib/kernlib/kerngen/obsolete/kerncdc/_kvcdc76/pilot.h
deleted file mode 100644
index 9e6630a..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/_kvcdc76/pilot.h
+++ /dev/null
@@ -1,33 +0,0 @@
-#if 0
-* This pilot patch was created from kerncdc.car patch _kvcdc76
-#endif
-#if 0
-* KERNLIB CDC FORTRAN 5 ON 7600
-#endif
-#ifndef CERNLIB_F77
-#define CERNLIB_F77
-#endif
-#ifndef CERNLIB_FTN47
-#define CERNLIB_FTN47
-#endif
-#ifndef CERNLIB_XIOCDCV
-#define CERNLIB_XIOCDCV
-#endif
-#ifndef CERNLIB_CDC76SYS
-#define CERNLIB_CDC76SYS
-#endif
-#ifndef CERNLIB__KCDC
-#define CERNLIB__KCDC
-#endif
-#ifndef CERNLIB_QMCDCV
-#define CERNLIB_QMCDCV
-#endif
-#ifndef CERNLIB_XSCOPE2_LXBITS
-#define CERNLIB_XSCOPE2_LXBITS
-#endif
-#ifdef CERNLIB_CDC76SYS_LBCMZB
-#undef CERNLIB_CDC76SYS_LBCMZB
-#endif
-#ifdef CERNLIB_CDCSYS_INCMEM
-#undef CERNLIB_CDCSYS_INCMEM
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/_kvnos/pilot.h b/src/packlib/kernlib/kerngen/obsolete/kerncdc/_kvnos/pilot.h
deleted file mode 100644
index b13409a..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/_kvnos/pilot.h
+++ /dev/null
@@ -1,39 +0,0 @@
-#if 0
-* This pilot patch was created from kerncdc.car patch _kvnos
-#endif
-#if 0
-* KERNLIB CDC FORTRAN 5 FOR NOS
-#endif
-#ifndef CERNLIB_F77
-#define CERNLIB_F77
-#endif
-#if 0
-* FORTRAN VERSION 4.7 (SEE D=KFILE)
-#endif
-#ifndef CERNLIB_FTN47
-#define CERNLIB_FTN47
-#endif
-#ifndef CERNLIB_XIOCDCV
-#define CERNLIB_XIOCDCV
-#endif
-#ifndef CERNLIB_CDCNOS
-#define CERNLIB_CDCNOS
-#endif
-#ifndef CERNLIB__KCDC
-#define CERNLIB__KCDC
-#endif
-#ifndef CERNLIB_QMCDCV
-#define CERNLIB_QMCDCV
-#endif
-#ifndef CERNLIB_XSCOPE_LXBITS
-#define CERNLIB_XSCOPE_LXBITS
-#endif
-#ifndef CERNLIB_CDC60SYS_JOBNAM
-#define CERNLIB_CDC60SYS_JOBNAM
-#endif
-#ifndef CERNLIB_CDC60SYS_REPINIT
-#define CERNLIB_CDC60SYS_REPINIT
-#endif
-#ifdef CERNLIB_CDCSYS_INCMEM
-#undef CERNLIB_CDCSYS_INCMEM
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/_kvnosbe/pilot.h b/src/packlib/kernlib/kerngen/obsolete/kerncdc/_kvnosbe/pilot.h
deleted file mode 100644
index 3f19725..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/_kvnosbe/pilot.h
+++ /dev/null
@@ -1,51 +0,0 @@
-#if 0
-* This pilot patch was created from kerncdc.car patch _kvnosbe
-#endif
-#if 0
-* KERNLIB CDC FORTRAN 5 FOR NOS/BE
-#endif
-#ifndef CERNLIB_F77
-#define CERNLIB_F77
-#endif
-#if 0
-* FORTRAN VERSION 4.7 (SEE D=KFILE)
-#endif
-#ifndef CERNLIB_FTN47
-#define CERNLIB_FTN47
-#endif
-#ifndef CERNLIB_XIOCDCV
-#define CERNLIB_XIOCDCV
-#endif
-#ifndef CERNLIB_CDCNOSBE
-#define CERNLIB_CDCNOSBE
-#endif
-#ifndef CERNLIB__KCDC
-#define CERNLIB__KCDC
-#endif
-#ifndef CERNLIB_QMCDCV
-#define CERNLIB_QMCDCV
-#endif
-#ifndef CERNLIB_XSCOPE_LXBITS
-#define CERNLIB_XSCOPE_LXBITS
-#endif
-#ifndef CERNLIB_CDCNOS_DETACH
-#define CERNLIB_CDCNOS_DETACH
-#endif
-#ifndef CERNLIB_CDCNOS_RETRNF
-#define CERNLIB_CDCNOS_RETRNF
-#endif
-#ifndef CERNLIB_CDCNOS_DMPFIT
-#define CERNLIB_CDCNOS_DMPFIT
-#endif
-#ifndef CERNLIB_CDCNOS_LOAFIT
-#define CERNLIB_CDCNOS_LOAFIT
-#endif
-#ifndef CERNLIB_CDC60SYS_JOBNAM
-#define CERNLIB_CDC60SYS_JOBNAM
-#endif
-#ifndef CERNLIB_CDC60SYS_REPINIT
-#define CERNLIB_CDC60SYS_REPINIT
-#endif
-#ifdef CERNLIB_CDCSYS_INCMEM
-#undef CERNLIB_CDCSYS_INCMEM
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdc60sys/comment.inc b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdc60sys/comment.inc
deleted file mode 100644
index 828e7b4..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdc60sys/comment.inc
+++ /dev/null
@@ -1,15 +0,0 @@
-*
-* $Id: comment.inc,v 1.1.1.1 1996/02/15 17:51:32 mclareni Exp $
-*
-* $Log: comment.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:51:32 mclareni
-* Kernlib
-*
-*
-*
-* comment.inc
-*
-
-* THE PREVIOUS SEQUENCES ARE FOR USE WITH SCOPE 3.4.3
-* THE NEXT SEQUENCES ARE FOR USE WITH SCOPE 3.4.0
-
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdc60sys/defmodel.inc b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdc60sys/defmodel.inc
deleted file mode 100644
index 66df4f6..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdc60sys/defmodel.inc
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: defmodel.inc,v 1.1.1.1 1996/02/15 17:51:30 mclareni Exp $
-*
-* $Log: defmodel.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:51:30 mclareni
-* Kernlib
-*
-*
-*
-* defmodel.inc
-*
- MODEL MICRO 1,,*74*
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdc60sys/equbuf.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdc60sys/equbuf.s
deleted file mode 100644
index 7b9f761..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdc60sys/equbuf.s
+++ /dev/null
@@ -1,245 +0,0 @@
-*
-* $Id: equbuf.s,v 1.1.1.1 1996/02/15 17:51:32 mclareni Exp $
-*
-* $Log: equbuf.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:32 mclareni
-* Kernlib
-*
-*
- IDENT EQUBUF
-*
-* CERN PROGLIB# Z260 EQUBUF .VERSION KERNCDC 1.16 820129
-*
- ENTRY EQUBUF
- EXT ABEND
- SST
-* MODEL MICRO 1,,*74* OR 1,,*76*
-#include "defmodel.inc"
-*
-* CALL EQUBUF (LUNEX,LUNIN,OPTION,NERROR)
-* OPTION MAY BE N NO REWIND
-* R REWIND
-* U UNLOAD / DEFAULT IF 3RD ARG NOT GIVEN.
-* NERROR IS THE RETURN CODE (OPTIONAL)
-* IT RETURNS THE RM ERROR IF ANY (0 OTHERWISE)
-* IF A RM OCCURS WITHOUT NERROR SPECIFIED, THE JOB IS ABORTED.
-* A DAYFILE MESSAGE IS PRINTED FOR ANY RM-ERROR
-*
- NAME VFD 42/0HEQUBUF,18/EQUBUF
- ARG3 BSS 1 ADDRESS OF 3RD ARG. IF ANY.
- ADRC BSSZ 1 ADDRESS OF 4TH ARG. IF ANY.
- RC BSSZ 1 TO SAVE FIES
- EXNAME BSS 1
- MSG1 DATA H*EQUBUF - FILE NOT DECLARED =* *BL
- FILE1 BSSZ 1
- MSG2 DATA H*EQUBUF - RM ERROR =* *BL
- RMNR DATA H* ON * *BL
- LFN BSSZ 1
- TEMPA0 BSSZ 1
- FICF BSS 1
- #MD IFC LT, "MODEL" 75 *BL
- LNFIT SET 18
- FIT0 SET 6
- #MD ELSE
- LNFIT SET 14
- FIT0 SET 0
- #MD ENDIF
- EQUBUF EQ *+1BS17
- SX6 A0
- MX0 42
- SA6 TEMPA0 SAVE A0
-*
-* ASSIGN TO THE EXTERNAL FILE THE SAME FIT AS THE INTERNAL FILE.
- SB7 1
- SA4 A1+B7
- SA2 X1 X2= NAME OF EXTERNAL FILE.
- SA3 A4+B7 X3= ADDRESS OF 3RD ARGUMENT.
- SA1 X4 X1= NAME OF INTERNAL FILE.
- MX6 0
- ZR X3,SAVP4 JUMP IF ONLY 2 ARG
- SA4 A3+B7
- ZR X4,SAVP4 JUMP IF ONLY 3 ARGS
- MX7 0
- BX6 X4
- SA7 RC PRESET RC TO ZERO
- SAVP4 BSS 0
- SA6 ADRC SAVE ADDRESS OF 4TH ARG
- BX6 X2
- RJ GETNAME
- BX2 X6
- BX6 X1
- RJ GETNAME
- BX1 X6
- SA4 B7+B7 GET FIRST LOGICAL FILE NAME
- SEARCH ZR X4,NOTDEC
- BX7 X0*X4
- BX5 X7-X1
- ZR X5,FOUND
- SA4 A4+B7
- EQ SEARCH
-*
- NOTDEC SA7 FILE1
- MESSAGE MSG1
-*
- ABT BSS 0
- RJ ABEND
-*
- FOUND SX1 X4 X1= FIT ADDRESS.
- LX7 X2
- #MD IFC LT, "MODEL" 75 *BL
- SA0 X1 SAVE X1 WHICH WILL BE DESTROYED BY 6R
- #MD ENDIF
- BX6 X3
- SA7 EXNAME
- SA6 ARG3
- STORE X1,EX=RMERROR
- FETCH X1,CF,X6
- SA6 FICF SAVE THE ORIGINAL CF
- FETCH X1,OC,X4
- SX3 X4-1
- ZR X4,CHFIT FILE NEVER OPENED
- NZ X3,CLEANFT FILE ALREADY CLOSED
- SA3 ARG3
- ZR X3,UNLOAD
- SA4 X3
- MX0 6
- BX6 X4*X0
- LX6 6
- SX5 X6-1RR
- SX4 X6-1RN
- ZR X5,REWIND
- ZR X4,NOREW
-*
- UNLOAD CLOSEM X1,U
- EQ CLEANFT
- NOREW CLOSEM X1,N
- EQ CLEANFT
- REWIND CLOSEM X1,R
-*
- CLEANFT BSS 0
- #MD IFC LT, "MODEL" 75 *BL
- SX1 A0 RESTORE X1 DESTROYED BY 6RM
-*
-* CLEAN THE FET
- FETCH X1,FET,X2
- FETCH X1,FWB,X3
- MX6 0
- SB5 -1
- SB6 X3+B5
- SB7 X2 B7= FET START ADDRESS
- LOOPFET BSS 0
- SA6 B6
- SB6 B6+B5
- GE B6,B7,LOOPFET
- #MD ENDIF
-*
-* CLEAN THE FIT
- MX6 0
- SB5 1
- FETCH X1,EO,X2 SAVE FIEO IN X2
- SB1 LNFIT
- SB2 FIT0
- LOOPFT SA6 X1+B1
- SB1 B1-B5
- NE B1,B2,LOOPFT
- #MD IFC LT, "MODEL" 75 *BL
- FETCH X1,FET,X5 FIT+1
- BX7 X5
- SA7 X1+1
- STORE X1,DX=0 FIT+3
- MX6 0
- SA6 X1+4 FIT+4
- SA6 X1+2 FIT+2
- STORE X1,LT=ANY
- FETCH X1,FWB,X5 FIT+5
- BX6 X5
- SA6 X1+5
- STORE X1,SDS=YES
- #MD ENDIF
- STORE X1,EO=X2
- STORE X1,OF=N
-*
- CHFIT SA2 EXNAME
- BX6 X2
- SA6 X1
- SA4 FICF
- STORE X1,CF=X4 RESTORE THE ORIGINAL CF IN THE FIT
- SA2 ADRC
- SA5 TEMPA0
- SA0 X5 RESTORE A0
- ZR X2,EQUBUF NO RC, RETURN
- SA3 RC
- BX6 X3
- SA6 X2 RETURN RC
- EQ EQUBUF
-*
-* CONVERT THE TAPE NUMBER TO DISPLAY CODE AND APPEND TO *TAPE*
-* X6 HOLDS THE RESULT, A4, X4, X5, X7 ARE DESTROYED.
- GETNAME DATA 0
- BX4 X0*X6
- MX5 0
- NZ X4,GETNAME IT IS ALREADY A FILE NAME
- SA4 =4LTAPE
- SX7 X6-10
- PL X7,GET2 IF THE TAPE NUMBER IS 10-99
- SX7 X6+1R0 N IN DISPLAY CODE
- LX7 60-5*6
- BX6 X4+X7 APPEND TO *TAPE*
- EQ GETNAME
-*
-* CONVERT A TWO DIGIT TAPE NUMBER TO DISPLAY CODE
- GET2 SX7 X6-20
- SX6 X6-10
- SX5 X5+100B
- PL X7,GET2 THE NUMBER IS NOT YET REDUCED
- IX5 X6+X5
- SX7 X5+2R00 NN IN DISPLAY CODE
- LX7 60-6*6
- BX6 X4+X7 APPEND TO *TAPE*
- EQ GETNAME
-*
- RMERROR DATA 0
- #MD IFC LT, "MODEL" 75 *BL
- SX1 A0 RESTORE X1 DESTROYED BY 6RM
- #MD ENDIF
- FETCH X1,IRS,X6
- SA6 RC SAVE FIES
- BX3 X6
-*
-* TRANSFORM INTEGER IN DISPLAY CODE
- MX6 0
- MX0 60-3
- SB5 3 ONLY 3 DIGITS IN RM ERROR
- LX3 51
- SB1 1
- SB4 1R0
- COD1 BSS 0
- LX3 3
- BX4 -X0*X3
- SX5 X4+B4
- LX6 6
- IX6 X6+X5
- SB5 B5-B1
- NZ B5,COD1
- LX6 42
- MX0 18
- SA5 RMNR
- BX4 -X0*X5
- BX6 X0*X6
- IX6 X4+X6
- SA6 A5 STORE RMNR
- SA2 X1
- BX6 X2
- SA6 LFN SAVE LFN NAME
- MESSAGE MSG2
- SA2 ADRC
- ZR X2,ABT NO RC, ABORT
- #MD IFC LT, "MODEL" 75 *BL
- SX1 A0 RESTORE X1 DESTROYED BY 6RM
- #MD ENDIF
- STORE X1,ES=0 CLEAR FIES
- EQ RMERROR
- END
-#ifdef CERNLIB_CDCSYS_EQUBUF
-#undef CERNLIB_CDCSYS_EQUBUF
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdc60sys/incmem1.inc b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdc60sys/incmem1.inc
deleted file mode 100644
index 25d9183..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdc60sys/incmem1.inc
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: incmem1.inc,v 1.1.1.1 1996/02/15 17:51:30 mclareni Exp $
-*
-* $Log: incmem1.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:51:30 mclareni
-* Kernlib
-*
-*
-*
-* incmem1.inc
-*
- MAXFLD VFD 30/-1,30/0
-*
-* incmem1.inc
-*
- MAXFLD DATA 120000B
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdc60sys/incmem2.inc b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdc60sys/incmem2.inc
deleted file mode 100644
index b6d0340..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdc60sys/incmem2.inc
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: incmem2.inc,v 1.1.1.1 1996/02/15 17:51:31 mclareni Exp $
-*
-* $Log: incmem2.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:51:31 mclareni
-* Kernlib
-*
-*
-*
-* incmem2.inc
-*
- SA1 A7+B7
- PL X1,OK
- MEMORY SCM,MAXFLD,RECALL
- SA1 MAXFLD
- BX6 X1
- AX6 30
- SA6 A1 STORE MAXFLD (RH)
- OK BSS 0
-*
-* incmem2.inc
-*
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdc60sys/incmem7.inc b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdc60sys/incmem7.inc
deleted file mode 100644
index d36ea70..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdc60sys/incmem7.inc
+++ /dev/null
@@ -1,15 +0,0 @@
-*
-* $Id: incmem7.inc,v 1.1.1.1 1996/02/15 17:51:32 mclareni Exp $
-*
-* $Log: incmem7.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:51:32 mclareni
-* Kernlib
-*
-*
-*
-* incmem7.inc
-*
- MX5 6
- LX5 6 X5= 63
- IX6 X5+X6
- BX6 -X5*X6 X6= AFTER ROUNDED TO NEXT 100B
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdc60sys/jobnam.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdc60sys/jobnam.s
deleted file mode 100644
index 352a49e..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdc60sys/jobnam.s
+++ /dev/null
@@ -1,47 +0,0 @@
-*
-* $Id: jobnam.s,v 1.1.1.1 1996/02/15 17:51:32 mclareni Exp $
-*
-* $Log: jobnam.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:32 mclareni
-* Kernlib
-*
-*
- IDENT JOBNAM
-*
-* CERN PROGLIB# Z100 JOBNAM .VERSION KERNCDC 2.14 850320
-*
-* JOB = JOBNAM (JOB)
-* GET NAME OF JOB ON CDC 6000, SYSTEM SCOPE 3.4.3
-* P. FRENKIEL, COLLEGE DE FRANCE, PARIS, 23/11/77
-*
- ENTRY JOBNAM
- TRACE VFD 36/6HJOBNAM,24/JOBNAM
- STATUSA VFD 6/0,18/1S17+25B,12/1,12/0,12/10B
- STATUS BSSZ 2
- RETADR BSSZ 1
- JOBNAM BSSZ 1
- BX6 X1
- SA6 RETADR
- SA2 STATUSA
- BX7 X2
- SA7 STATUS
- MX6 0
- SA6 STATUS+1
- SYSTEM ACT,RCL,STATUS
- SA3 STATUS+1
- MX0 42
- SA1 RETADR X1= ADR(PARAMETER)
- BX6 X0*X3 KEEP FIRST 7 CHAR.
- MX2 54 X2= 00 IN POS. 10
- SX3 55B X3= 55 IN POS. 10
- LOOP BX6 X6+X3 MERGE BLANK INTO POS. N
- LX2 6 X2= 00 IN POS. N = N-1
- LX3 6 X3= 55 IN POS. N
- BX4 -X2*X6 X4= CHAR. N ISOLATED
- ZR X4,LOOP
- SA6 X1
- EQ JOBNAM
- END
-#ifdef CERNLIB_CDCSYS_JOBNAM
-#undef CERNLIB_CDCSYS_JOBNAM
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdc60sys/ldfifet.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdc60sys/ldfifet.s
deleted file mode 100644
index 0eef081..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdc60sys/ldfifet.s
+++ /dev/null
@@ -1,57 +0,0 @@
-*
-* $Id: ldfifet.s,v 1.1.1.1 1996/02/15 17:51:32 mclareni Exp $
-*
-* $Log: ldfifet.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:32 mclareni
-* Kernlib
-*
-*
- IDENT LDFIFET
-*
-* CERN PROGLIB# LDFIFET .VERSION KERNCDC 1.16 820129
-*
- ENTRY LDFIFET
- EXT UCOPY,GETFIT.
-*
- USE /FITFET/
- LUN BSS 1
- LFIT BSS 1
- MFIT BSS 16
- LFET BSS 1
- MFET BSS 10
- MWK BSS 53
- USE
-*
- TRACE VFD 42/7HLDFIFET,18/LDFIFET
- LDFIFET DATA 0
- MX6 1
- BX1 X1+X6
-+RJGETFIT
- BX6 X1
- SA6 LFIT
- SA6 PARI
- MX0 42
- SA2 X1+1
- BX6 -X0*X2
- SA6 LFET
- SA6 PARE
-*
- SA1 PARI
-+RJUCOPY
-- VFD 30/TRACE
- SA1 PARE
-+RJUCOPY
-- VFD 30/TRACE
- EQ LDFIFET
-*
- N16 DATA 16
- N10 DATA 10
- PARI DATA 0
- VFD 42/0,18/MFIT
- VFD 42/0,18/N16
- DATA 0
- PARE DATA 0
- VFD 42/0,18/MFET
- VFD 42/0,18/N10
- DATA 0
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdc60sys/namjob.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdc60sys/namjob.s
deleted file mode 100644
index 74ea242..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdc60sys/namjob.s
+++ /dev/null
@@ -1,40 +0,0 @@
-*
-* $Id: namjob.s,v 1.1.1.1 1996/02/15 17:51:32 mclareni Exp $
-*
-* $Log: namjob.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:32 mclareni
-* Kernlib
-*
-*
- IDENT NAMJOB
-*
-* CERN PROGLIB# NAMJOB .VERSION KERNCDC 1.03 771219
-*
-* JOB = NAMJOB (JOB)
-* GET NAME OF JOB ON CDC 6000, SYSTEM SCOPE 3.4.3
-* P. FRENKIEL, COLLEGE DE FRANCE, PARIS, 23/11/77
-*
- ENTRY NAMJOB
- TRACE VFD 36/6HNAMJOB,24/NAMJOB
- STATUSA VFD 6/0,18/1S17+25B,12/1,12/0,12/10B
- STATUS BSSZ 2
- RETADR BSSZ 1
- NAMJOB BSSZ 1
- BX6 X1
- SA6 RETADR
- SA2 STATUSA
- BX7 X2
- SA7 STATUS
- MX6 0
- SA6 STATUS+1
- SYSTEM ACT,RCL,STATUS
- SA3 STATUS+1
- MX0 42
- SA2 RETADR
- BX6 X0*X3
- SA6 X2
- EQ NAMJOB
- END
-#ifdef CERNLIB_CDCSYS_NAMJOB
-#undef CERNLIB_CDCSYS_NAMJOB
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdc60sys/prfifet.F b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdc60sys/prfifet.F
deleted file mode 100644
index 52eebb5..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdc60sys/prfifet.F
+++ /dev/null
@@ -1,134 +0,0 @@
-*
-* $Id: prfifet.F,v 1.1.1.1 1996/02/15 17:51:32 mclareni Exp $
-*
-* $Log: prfifet.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:32 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE PRFIFET (LUNP,NWFIT,NWFET,COMMENT)
-
-C CERN PROGLIB# PRFIFET .VERSION KERNCDC 1.03 771219
-
-C- DEBUG ROUTINE TO PRINT FIT/FET CONTENTS WITH MNEMONICS
-C- LUNP LOGICAL UNIT
-C- NWFIT NUMBER OF FIT-WORDS TO BE PRINTED, MAY BE ZERO
-C- NWFET NUMBER OF FET-WORDS TO BE PRINTED, MAY BE ZERO
-C- COMMENT TEXT-STRING TERMINATED BY . FOR PRINTING
-
-C- EXAMPLE: CALL PRFIFET (3LPAM,20,0,"PAM OPENED.")
-C- ALL FIT-WORDS, NOT FET
-
- COMMON /FITFET/ LUN,LFIT,MFIT(16),LFET,MFET(10),MWK(53)
- COMMON /IDFIFET/ IDI(164),IDE(90)
- DIMENSION COMMENT (9)
- DIMENSION MCM(80)
- EQUIVALENCE (MCM,LUN)
- DIMENSION MFMT(15), KFMT(15)
-
- DATA MFMT / 10H(5X3HL + ,10HI2,3X, , 13*(1H ) /
- DATA MFMTE/ 3H1X) /
- DATA KFMT / 10HO1,A5, ,10HO2,A5, ,10HO3,A5,
- +, 10HO4,A5, ,10HO5,A5, ,10HO6,A5,
- +, 10HO7,A5, ,10HO8,A5, ,10HO9,A5,
- +, 10HO10,A5, ,10HO11,A5, ,10HO12,A5,
- +, 10HO13,A5, ,10HO14,A5, ,10HO15,A5, /
- DATA IDOT / 1H. /
-
- DATA LGIDI/ 164 /
- DATA IDI / 42,3HLFN,18,3HR , 0
- +, 24,3HRL , 1,3HPM , 3,3HFO , 1,3HNDX, 3,3HBT , 1,3HBCK, 1,3HDT
- +, 4,3HRT , 1,3HDKI, 3,3HPD ,18,3HFET, 0
- +, 24,3HPTL, 2,3HOF , 2,3HVF , 2,3HCF , 2,3HLT , 3,3HULP, 7,3HFP
- +, 18,3HLX , 0
- +, 24,3HHL ,18,3HBFS,18,3HDX , 0
- +, 24,3HTL , 1,3HFNF, 1,3HPEF, 3,3HR , 5,3HSES, 8,3HIRS,18,3HEX ,0
- +, 6,3HVNO, 9,3HECT, 9,3HERL, 3,3HF/S, 2,3HE/S, 2,3HOC , 3,3HF/L
- +, 2,3HK/H, 6,3HLVL,18,3HFWB, 0
- +, 24,3HMRL,10,3HR , 1,3HCM , 3,3HEO ,22,3HWSA, 0
- +, 4,3HKP , 9,3HKL , 9,3HMKL, 4,3HRKP,12,3HRKW,22,3HPNA, 0
- +, 24,3HMNB, 8,3HRMK, 6,3HPC ,22,3HLA , 0
- +, 24,3HLP ,14,3HRB ,22,3HPAR, 0
- +, 1,3HPDF, 1,3HSBF,13,3HR , 1,3HCNF, 1,3HSB , 1,3HC1 , 6,3HLL
- +, 6,3HLOP,30,3HRC , 0
- +, 24,3HLBL, 6,3HMUL,30,3HBN , 0
- +, 24,3HMBL, 6,3HNL , 2,3HOVF,28,3HDL , 0, 0 /
-
- DATA IDE / 42,3HLFN, 4,3HLV , 5,3HERC, 9,3HCOD, 0
- +, 12,3HDT , 3,3HR/U, 3,3HE/M, 3,3HX/E, 3,3HN/S,12,3HDSP, 6,3HFLG
- +, 18,3HFIR, 0
- +, 12,3HZ ,15,3HZ ,15,3HZ ,18,3HIN , 0
- +, 12,3HZ ,15,3HZ ,15,3HZ ,18,3HOUT, 0
- +, 12,3HFNT,15,3HRBS,15,3HPRU,18,3HLIM, 0
- +, 12,3HR ,18,3HFWA,12,3HR ,18,3HLWA, 0
- +, 12,3HDEC,18,3HEXT, 6,3HUBC,24,4HMLRS, 0
- +, 18,3HRNO, 6,3HR ,18,3HIXL,18,3HIX , 0
- +, 12,3HR ,18,3HEOI,12,3HR ,18,3HEEA, 0, 0 /
-
-
- CALL UBLOW (COMMENT,MCM,80)
- NCM = IUFIND (IDOT,MCM,1,79)
- PRINT 9001, (MCM(J),J=1,NCM)
-
- LUN = LUNP
- CALL LDFIFET (LUN)
-
- IF (NWFIT.LE.0) GO TO 31
- PRINT 9004, LUN,LFIT
- JX = 1
- JW = 0
- NWPR= NWFIT
-
-C---- START FIT OR FET
-
- 20 MWK(1) = 0
-
-C-- NEXT WORD
-
- 21 JW = JW + 1
- MWD = MFIT(JW)
- JB = 61
- JFMT = 3
- JPUT = 1
-
-C-- NEXT ITEM
-
- 24 NB = IDI(JX)
- IF (NB.EQ.0) GO TO 27
- JB = JB - NB
- JPUT = JPUT + 2
- MWK(JPUT-1) = JBYT (MWD,JB,NB)
- MWK(JPUT) = IDI(JX+1)
- CALL SHFTZF (MWK(JPUT),18)
- J = (NB-1)/3
- MFMT(JFMT) = KFMT(J+1)
- JFMT = JFMT + 1
- JX = JX + 2
- GO TO 24
-
-C-- PRINT 1 WORD
-
- 27 MFMT(JFMT) = MFMTE
- PRINT MFMT, (MWK(J),J=1,JPUT)
- MWK(1) = MWK(1) + 1
- IF (MWK(1).GE.NWPR) GO TO 28
- JX = JX + 1
- IF (IDI(JX).NE.0) GO TO 21
-
- 28 IF (JW.GE.18) RETURN
-
-C------ START PRINTING OF FET
-
- 31 IF (NWFET.LE.0) RETURN
- JW = 17
- JX = LGIDI + 1
- NWPR = NWFET
- PRINT 9031, LUN,LFET
- GO TO 20
-
- 9001 FORMAT (1H0,80A1)
- 9004 FORMAT ("0FIT FOR FILE "A7," AT "O6/1X)
- 9031 FORMAT ("0 FET FOR "A7," AT "O6/1X )
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdc60sys/repinit.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdc60sys/repinit.s
deleted file mode 100644
index daf98c9..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdc60sys/repinit.s
+++ /dev/null
@@ -1,171 +0,0 @@
-*
-* $Id: repinit.s,v 1.1.1.1 1996/02/15 17:51:32 mclareni Exp $
-*
-* $Log: repinit.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:32 mclareni
-* Kernlib
-*
-*
- IDENT REPINIT
-*
-* CERN PROGLIB# Z038 REPINIT .VERSION KERNCDC 0.1 751115
-*
- ENTRY REPINIT,REPOK
- EXT ABEND
-* 30-NOV-73
-*
- USE /EXCHPAK/
- JCONDT BSS 1
- JCODE BSS 1
- LREP BSS 1
- XCHC BSS 16
- PARITY BSS 2
- USE
-*
-*---- INITIALIZE -- CALL REPINIT (REC-ADR,MASKPSD,MASKBPA)
-*
- VFD 42/7HREPINIT,18/REPINIT
- REPINIT DATA 0
- BX6 X1 SET RECOVERY ADR
- SA6 LREP
- SA2 A1+1 CONSTRUCT RECOVERY WORD
- SX4 25B DEFAULT RECOVERY WORD
- ZR X2,DEF TAKE DEFAULT IF 2ND PAR. MISSING
- SA3 A2+1
- SA2 X2 X2= JPSD
- SA3 X3 X3= JBPA
- SX6 1706B
- SX7 4000B
- SX4 14B
- BX6 X6*X2
- BX7 X7*X2
- BX4 X4*X3 X4= BIT 3 TIME, 4 DROP
- ZR X6,NOAR
- SX4 X4+1 X4= BIT 1 ARITH. CONDITIONS
- NOAR ZR X7,DEF
- SX4 X4+20B X4= BIT 5 ECS PARITY
- DEF BX7 X4
- SA7 RWORD
- SA1 REPINIT
- BX6 X1
- SA6 REPOK
- EQ REPOK+1
-*
-*------ RECOVERY PROCEDURE STARTS HERE, FIRST COPY XJPK TO COMMON
- GO DATA 0 X1= ADR(EXCHPK)
- SA1 X1
- SB7 1 B7= 1
- SB1 16 COPY 16 MORE WORDS
- BX7 X1
- SA7 XCHC
- BX5 X1 X5= BPA
- LOOP1 SA1 A1+B7
- SB1 B1-B7
- BX7 X1
- SA7 A7+B7
- NE B1,B0,LOOP1
-*
-*------ SET RJ TO RECOVERY ROUTINE
- SA3 LREP
- SA4 RJINST
- LX3 30
- BX6 X3+X4
- SA6 RJ
-*
-*------ CONVERT PSD OR BPA TO ERROR CONDITION AND CODE
- SB1 X5 B1= BPA
- SB2 2
- NE B1,B2,EXTER
-*
-*--- HANDLE PSD CONDITION
- SA1 B0 X1= WORD 0 (RA) = 000/C/P-COUNTER
- MX0 18
- LX0 54 X0= 00777777000000000000
- LX1 6 X1= WORD 0 ROTATED BY 6 PLACES
- BX6 X0*X1 P-COUNTER PICKED
- BX7 -X0*X5 P-COUNTER CLEARED IN EXCH-P
- BX6 X6+X7
- SA6 XCHC P-COUNTER STORED INTO EXCH-P
-*
- SA2 PSDCV X2= 07236
- MX0 3 X0= 70000...
- BX1 X0+X1 X1= 7/C/P-COUNTER
- LX1 6
- LOOPSD LX1 59
- LX2 3
- PL X1,LOOPSD
- BX7 X0*X2
- LX7 3 X7= 2 OVFL, 3 INDEF, 6 PROG RG, 7 SCM RG
- EQ JOIN
-*
-*--- EXTERNAL CONDITION BPA
- EXTER SA3 LIST X3= 01 06 07 10 12 17 21 77 77 77
- SA4 BPACV X4= 04 02 02 03 01 05 04 07 07 07
- SB5 9 B5= LOOP COUNT
- MX0 54 X0= MASK ...7777700
-*
- LOOPEX LX3 6
- LX4 6
- BX2 -X0*X3
- BX7 -X3*X4 X7= ERR NO - 911
- SB2 X2
- EQ B2,B1,ENDLEX BPA = CODE
- SB5 B5-B7
- NE B5,B0,LOOPEX
-*
-* CHECK SECOND OCCCURRENCE OF BPA CONDITION
- ENDLEX SA3 OCCURD X3= PREVIOUS OCC.
- SB5 X7 B5= 1, 2, 3, ...
- MX2 1
- LX2 B5,X2 X2= MASK WITH BIT 1, 2, 3, ...
- BX6 X2*X3
- NZ X6,EXABEND EXIT FOR SECOND OCC.
- BX6 X2+X3 X6= OCCURD UPDATED
- SA6 A3
- SX7 B5+11 X7= 12, 13, 14, 15, 16, 17, 18 = EC-900
-*
- JOIN SA5 X7+WORDS-1 CODE-WORD
- SX7 X7+900 JCONDT= 900 + 1, 2, 3, ...
- BX6 X5
- SA7 JCONDT
- SA6 A7+B7
- SA1 PARAM
- RJ DATA 0 RETURN-JUMP TO RECOVERY ROUTINE
- EXABEND RJ ABEND
-*
-*---- RESET RECOVERY CALL REPOK
-*
- REPOK DATA 0
- MX7 0
- SA7 B0 CLEAR RA TO ZERO
- SA7 JCODE CLEAR JCODE TO ZERO
- SA2 RWORD
- RECOVR GO,X2,LWA
- LWA EQ REPOK
-*
- RWORD DATA 0
- RJINST VFD 6/1,54/REPINIT-1
- PSDCV VFD 15/07236B,45/0
- BPACV DATA 04020203010504070707B
- LIST DATA 01060710121721777777B
- OCCURD DATA 0
- PARAM DATA 0
- WORDS VFD 60/10HUNDERFLOW 901 *BL
- VFD 60/10HOVERFLOW 902 *BL
- VFD 60/10HINDEFINITE 903 *BL
- VFD 60/10HSTEP 904 *BL
- VFD 60/10HBREAKPOINT 905 *BL
- VFD 60/10HPROG RANGE 906 *BL
- VFD 60/10HSCM RANGE 907 *BL
- VFD 60/10HLCM RANGE 908 *BL
- VFD 60/10HSCM BRANGE 909 *BL
- VFD 60/10HLCM BRANGE 910 *BL
- VFD 60/10HSCM PARITY 911 *BL
- VFD 60/10HLCM PARITY 912 *BL
- VFD 60/10HOP DROP 913 *BL
- VFD 60/10HRERUN 914 *BL
- VFD 60/10HTIME LIMIT 915 *BL
- VFD 60/10HMASS LIMIT 916 *BL
- VFD 60/10HLCM LIMIT 917 *BL
- VFD 60/10H???? 918 *BL
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdc76sys/defmodel.inc b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdc76sys/defmodel.inc
deleted file mode 100644
index a99852e..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdc76sys/defmodel.inc
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: defmodel.inc,v 1.1.1.1 1996/02/15 17:51:30 mclareni Exp $
-*
-* $Log: defmodel.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:51:30 mclareni
-* Kernlib
-*
-*
-*
-* defmodel.inc
-*
- MODEL MICRO 1,,*76*
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdc76sys/incmem1.inc b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdc76sys/incmem1.inc
deleted file mode 100644
index edf6bb6..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdc76sys/incmem1.inc
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: incmem1.inc,v 1.1.1.1 1996/02/15 17:51:30 mclareni Exp $
-*
-* $Log: incmem1.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:51:30 mclareni
-* Kernlib
-*
-*
-*
-* incmem1.inc
-*
- MAXFLD DATA 150000B
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdc76sys/incmem2.inc b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdc76sys/incmem2.inc
deleted file mode 100644
index 56932d8..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdc76sys/incmem2.inc
+++ /dev/null
@@ -1,11 +0,0 @@
-*
-* $Id: incmem2.inc,v 1.1.1.1 1996/02/15 17:51:30 mclareni Exp $
-*
-* $Log: incmem2.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:51:30 mclareni
-* Kernlib
-*
-*
-*
-* incmem2.inc
-*
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdc76sys/incmem7.inc b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdc76sys/incmem7.inc
deleted file mode 100644
index fbd0804..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdc76sys/incmem7.inc
+++ /dev/null
@@ -1,11 +0,0 @@
-*
-* $Id: incmem7.inc,v 1.1.1.1 1996/02/15 17:51:30 mclareni Exp $
-*
-* $Log: incmem7.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:51:30 mclareni
-* Kernlib
-*
-*
-*
-* incmem7.inc
-*
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdc76sys/jobnam.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdc76sys/jobnam.s
deleted file mode 100644
index 62f8e2f..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdc76sys/jobnam.s
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: jobnam.s,v 1.1.1.1 1996/02/15 17:51:30 mclareni Exp $
-*
-* $Log: jobnam.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:30 mclareni
-* Kernlib
-*
-*
- IDENT JOBNAM
-*
-* CERN PROGLIB# Z100 JOBNAM .VERSION KERNCDC 1.12 801111
-*
- ENTRY JOBNAM
-* JOB = JOBNAM (JOB)
- NAME VFD 42/0HJOBNAM,18/JOBNAM
- OU.NAME EQU 775B
- ANSWER BSS 1
- JOBNAM EQ *+1BS17
- MJ OU.NAME
- - VFD 30/ANSWER
- SA2 ANSWER
- BX6 X2
- SA6 X1
- EQ JOBNAM
- END
-#ifdef CERNLIB_CDCSYS_JOBNAM
-#undef CERNLIB_CDCSYS_JOBNAM
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdc76sys/lbcmzb.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdc76sys/lbcmzb.s
deleted file mode 100644
index f911035..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdc76sys/lbcmzb.s
+++ /dev/null
@@ -1,46 +0,0 @@
-*
-* $Id: lbcmzb.s,v 1.1.1.1 1996/02/15 17:51:30 mclareni Exp $
-*
-* $Log: lbcmzb.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:30 mclareni
-* Kernlib
-*
-*
- IDENT LBCMZB
-*
-* CERN PROGLIB# Z028 LBCMZB .VERSION KERNCDC 1.13 820111
-*
-* LBCMZB MEASURES THE LENGTH OF BLANK COMMON AVAILABLE
-* (NOT NECESSARILY THE DECLARED LENGTH) THAT IS, FROM THE
-* START OF BLANK COMMON TO THE END OF THE USER-S CENTRAL
-* MEMORY SPACE.
-*
-* CERN LIBRARY PROGRAM Z 028
-* THIS VERSION USES THE MEMORY MACRO TO DETERMINE FIELD LENGTH,
-* SO AS TO BE INDEPENDENT OF THE FORTRAN COMMON LIBRARY.
-* J.D.BLAKE/CERN 8 APRIL 1976
-*
- ENTRY LBCMZB
-* FUNCTION LBCMZB(DUMMY)
- VFD 42/0LLBCMZB,18/LBCMZB
- LBCMZB EQ *+1S17
-*
-* INVOKE MEMORY MACRO TO DETERMINE SCM FIELD LENGTH
-*
- MX6 0
- SA6 MEMSTAT PREPARE REQUEST/REPLY WORD
- MEMORY SCM,MEMSTAT,RECALL
- SA3 MEMSTAT READ REPLY
-*
-* SUBTRACT START ADDRESS OF BLANK COMMON AND RETURN RESULT
-*
- SX2 BLANK START OF BLANK COMMON
- AX3 30 SCM FIELD LENGTH
- IX6 X3-X2 LENGTH OF BLANK COMMON
- EQ LBCMZB RETURN
-*
- MEMSTAT DATA 0 MEMORY MACRO REQUEST/REPLY WORD
-*
- USE //
- BLANK BSS 1 FIRST LOCATION IN BLANK COMMON
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdc76sys/namjob.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdc76sys/namjob.s
deleted file mode 100644
index 720951c..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdc76sys/namjob.s
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: namjob.s,v 1.1.1.1 1996/02/15 17:51:30 mclareni Exp $
-*
-* $Log: namjob.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:30 mclareni
-* Kernlib
-*
-*
- IDENT NAMJOB
-*
-* CERN PROGLIB# NAMJOB .VERSION KERNCDC 0.1 760623
-*
- ENTRY NAMJOB
-* JOB = NAMJOB (JOB)
- NAME VFD 42/0HNAMJOB,18/NAMJOB
- OU.NAME EQU 775B
- ANSWER BSS 1
- NAMJOB EQ *+1BS17
- MJ OU.NAME
- - VFD 30/ANSWER
- SA2 ANSWER
- BX6 X2
- SA6 X1
- EQ NAMJOB
- END
-#ifdef CERNLIB_CDCSYS_NAMJOB
-#undef CERNLIB_CDCSYS_NAMJOB
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdc76sys/repinit.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdc76sys/repinit.s
deleted file mode 100644
index 2e29687..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdc76sys/repinit.s
+++ /dev/null
@@ -1,158 +0,0 @@
-*
-* $Id: repinit.s,v 1.1.1.1 1996/02/15 17:51:30 mclareni Exp $
-*
-* $Log: repinit.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:30 mclareni
-* Kernlib
-*
-*
- IDENT REPINIT
-*
-* CERN PROGLIB# Z038 REPINIT .VERSION KERNCDC 0.1 751115
-*
- ENTRY REPINIT,REPOK
- EXT ABEND
-* 30-NOV-73
-*
- USE /EXCHPAK/
- JCONDT BSS 1
- JCODE BSS 1
- LREP BSS 1
- XCHC BSS 16
- PARITY BSS 2
- USE
-*
-*---- INITIALIZE -- CALL REPINIT (REC-ADR,MASKPSD,MASKBPA)
-*
- VFD 42/7HREPINIT,18/REPINIT
- REPINIT DATA 0
- BX6 X1 SET RECOVERY ADR
- SA6 LREP
- SA2 A1+1 CONSTRUCT RECOVERY WORD
- SA4 RWDEF
- ZR X2,DEF TAKE DEFAULT VALUE IF 2ND PAR. MISSIN
- SA3 A2+1
- SA2 X2
- SA3 X3
- MX0 30
- LX2 12
- BX2 X2+X3
- BX4 X0*X4
- BX2 -X0*X2
- BX4 X2+X4
- DEF BX7 X4
- SA7 RWORD
- SA1 REPINIT
- BX6 X1
- SA6 REPOK
- EQ REPOK+1
-*
-* EXCHANGE JUMP PACKAGE RECIEVED
- FWA BSSZ 17
-*
-*------ RECOVERY PROCEDURE STARTS HERE, FIRST COPY XJPK TO COMMON
- SA1 FWA COPY FIRST WORD
- SB7 1 B7= 1
- SB1 16 COPY 16 MORE WORDS
- BX7 X1
- SA7 XCHC
- BX5 X1 X5= BPA
- LOOP1 SA1 A1+B7
- SB1 B1-B7
- BX7 X1
- SA7 A7+B7
- NE B1,B0,LOOP1
-*
-*------ SET RJ TO RECOVERY ROUTINE
- SA3 LREP
- SA4 RJINST
- LX3 30
- BX6 X3+X4
- SA6 RJ
-*
-*------ CONVERT PSD OR BPA TO ERROR CONDITION AND CODE
- SB1 X5 B1= BPA
- NE B1,B0,EXTER
-*
-*--- HANDLE PSD CONDITION
- SA1 FWA+3
- MX5 12
- LX1 12
- BX1 X5*X1
- LX1 12 X1= 12 CONDITION FLAGS, RIGHT JUST.
- NX7 B1,X1
- SB2 48
- SX7 B2-B1 X7= ERR CONDITION NUMBER
- EQ JOIN
-*
-*--- EXTERNAL CONDITION BPA
- EXTER MX7 0 X7= 1, 2, 3, ...
- SX5 B7 X5= 1
- SB5 6 B5= LOOP COUNT
- SA3 LIST X3= CODE POSSIBILITIES
- MX0 54 X0= MASK ...77700
-*
- LOOPEX LX3 6
- BX2 -X0*X3 X2= CODE POSS.
- IX7 X7+X5 X7= ERR CONDITION NO
- SB2 X2
- EQ B2,B1,ENDLEX BPA = CODE
- SB5 B5-B7
- NE B5,B0,LOOPEX
-*
-* CHECK SECOND OCCCURRENCE OF BPA CONDITION
- ENDLEX SA3 OCCURD X3= PREVIOUS OCC.
- SB5 X7 B5= 1, 2, 3, ...
- MX2 1
- LX2 B5,X2 X2= MASK WITH BIT 1, 2, 3, ...
- BX6 X2*X3
- NZ X6,EXABEND EXIT FOR SECOND OCC.
- BX6 X2+X3 X6= OCCURD UPDATED
- SA6 A3
- SX7 B5+12 X7= 13, 14, 15
-*
- JOIN SA5 X7+WORDS-1 CODE-WORD
- SX7 X7+900 JCONDT= 900 + 1, 2, 3, ...
- BX6 X5
- SA7 JCONDT
- SA6 A7+B7
- SA1 PARAM
- RJ DATA 0 RETURN-JUMP TO RECOVERY ROUTINE
- EXABEND RJ ABEND
-*
-*---- RESET RECOVERY CALL REPOK
-*
- REPOK DATA 0
- SA1 RWORD
- BX6 X1
- SA6 FWA
- REPRIEVE FWA
- MX7 0
- SA7 JCODE
- LWA EQ REPOK
-*
- RWDEF VFD 30/LWA,30/77470004B
- RWORD DATA 0
- RJINST VFD 6/1,54/REPINIT-1
- LIST VFD 30/0610011721B,30/0
- OCCURD DATA 0
- PARAM DATA 0
- WORDS VFD 60/10HUNDERFLOW 901 *BL
- VFD 60/10HOVERFLOW 902 *BL
- VFD 60/10HINDEFINITE 903 *BL
- VFD 60/10HSTEP 904 *BL
- VFD 60/10HBREAKPOINT 905 *BL
- VFD 60/10HPROG RANGE 906 *BL
- VFD 60/10HSCM RANGE 907 *BL
- VFD 60/10HLCM RANGE 908 *BL
- VFD 60/10HSCM BRANGE 909 *BL
- VFD 60/10HLCM BRANGE 910 *BL
- VFD 60/10HSCM PARITY 911 *BL
- VFD 60/10HLCM PARITY 912 *BL
- VFD 60/10HOP DROP 913 *BL
- VFD 60/10HRERUN 914 *BL
- VFD 60/10HTIME LIMIT 915 *BL
- VFD 60/10HMASS LIMIT 916 *BL
- VFD 60/10HLCM LIMIT 917 *BL
- VFD 60/10H???? 918 *BL
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdc76sys/timed.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdc76sys/timed.s
deleted file mode 100644
index ba5b6f0..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdc76sys/timed.s
+++ /dev/null
@@ -1,46 +0,0 @@
-*
-* $Id: timed.s,v 1.1.1.1 1996/02/15 17:51:30 mclareni Exp $
-*
-* $Log: timed.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:30 mclareni
-* Kernlib
-*
-*
- IDENT TIMED
-*
-* CERN PROGLIB# Z007 TIMED .VERSION KERNCDC 1.14 820114
-*
- ENTRY TIMED
-*
-* CALL TIMED (T) RETURNS RUNNING TIME SINCE LAST CALL
-* ACCURATE TO 1 CLOCK CYCLE JAN-82, JZ
-*
- TRACE VFD 30/5HTIMED,30/TIMED
- TIMED DATA 0
- BX6 X1
- SA6 SVX1 ADR(N) SAVED
- TIME NEW,7CLK TIME REQUEST MACRO
- SB7 1 B7= 1
- SA1 LAST X1= LAST
- SA2 A1+B7 X2= NEW
- SA3 A2+B7 X3= FACTOR
- IX5 X2-X1 X5= NEW-LAST INTEGER
- BX7 X2 X7= NEW FOR LAST
- PX0 B0,X5
- NX5 B0,X0 X5= NEW/LAST FLOATING
- SA2 A3+B7 X2= ADR(T)
- FX6 X3*X5 X6= NEW-LAST SECONDS
- SA7 A1 STORE LAST
- SA6 X2 STORE RESULT
- EQ TIMED
- LAST DATA 0
- NEW DATA 0
- FACT DATA 27.5E-9 SECONDS PER CLOCK-CYCLE
- SVX1 DATA 0
- END
-#ifdef CERNLIB_CDCSYS_TIMED
-#undef CERNLIB_CDCSYS_TIMED
-#endif
-#ifdef CERNLIB_TCGEN_TIMED
-#undef CERNLIB_TCGEN_TIMED
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/bitpos.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/bitpos.s
deleted file mode 100644
index 4b089c4..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/bitpos.s
+++ /dev/null
@@ -1,68 +0,0 @@
-*
-* $Id: bitpos.s,v 1.1.1.1 1996/02/15 17:51:19 mclareni Exp $
-*
-* $Log: bitpos.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:19 mclareni
-* Kernlib
-*
-*
- IDENT BITPOS
-*
-* CERN PROGLIB# M508 BITPOS .VERSION KERNCDC 2.18 870602
-* ORIG. ?
-*
-* CALL BITPOS(I,N,K,M)
-* I=INPUT VECTOR
-* N=NO. OF BITS TO BE EXAMINED
-* K= OUTPUT ARRAY OF POSITIONS IN VECTOR OF SET BITS
-* M= NO. OF SET BITS
-*
- ENTRY BITPOS
- VFD 36/6HBITPOS,24/BITPOS
- BITPOS DATA 0
- SB1 1
- SX5 B1
- SA2 A1+B1
- SX7 B0 . SET M
- SA1 X1 . GET I
- SA3 A2+B1 . GET BASE ADDRESS OF K
- SA4 A3+B1
- SA2 X2
- SB4 B1 . LOOP INDEX
- SB2 X2 . GET N
- SB6 60
- SB3 B6
- NZ X1,LOOP
- SB4 B6 . EMPTY WORD
- SB3 B1
- EQ L1
- LOOP BX2 X1*X5 . GET BIT
- ZR X2,L1
- SX6 B4-B1
- IX7 X7+X5 . INCREMENT M
- SA6 X3 . STORE K(M)
- IX3 X3+X5
- L1 GE B4,B2,OUT
- SB3 B3-B1
- SB4 B4+B1
- NE B3,L2 . CHECK WHETHER END OF WORD
- SA1 A1+B1
- SB3 B6
- NZ X1,LOOP
- SB4 B4-B1
- SB3 B1
- SB4 B4+B6
- EQ L1
- L2 AX1 B1 . SHIFT I
- NZ X1,LOOP
- NG X1,LOOP
- SB4 B4+B3 . NO MORE SET BITS IN THIS WORD
- SB4 B4-B1
- SB3 B1
- EQ L1
- OUT SA7 X4 . STORE M
- EQ B0,B0,BITPOS
- END
-#ifdef CERNLIB_TCGEN_BITPOS
-#undef CERNLIB_TCGEN_BITPOS
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/blow.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/blow.s
deleted file mode 100644
index 8c72526..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/blow.s
+++ /dev/null
@@ -1,80 +0,0 @@
-*
-* $Id: blow.s,v 1.1.1.1 1996/02/15 17:51:19 mclareni Exp $
-*
-* $Log: blow.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:19 mclareni
-* Kernlib
-*
-*
- IDENT BLOW
-*
-* CERN PROGLIB# M426 BLOW .VERSION KERNCDC 1.16 820129
-*
-* SUBROUTINE BLOW (SOURCE,TARGET,NBYTES,NBITS)
-*
-* SOURCE- GIVES THE ADDRESS OF A SOURCE ARRAY
-* TARGET- GIVES THE ADDRESS OF A TARGET ARRAY
-* NBYTES- NUMBER OF BYTES IN THE SOURCE RECORD
-* NBITS- NUMBER OF BITS PER BYTE
-*
-* MODIFIED JAN 1982 TO IGNORE CALLS WITH ERRONEOUS PARAMETER VALUES
-*
- ENTRY BLOW
- TRACE VFD 42/0LBLOW,18/BLOW
- BLOWA0 BSSZ 1
- BLOW JP 400000B+*
- SX6 A0
- SA6 BLOWA0 SAVE OLD A0
- SB1 1 CONSTANT B1=1
- SB6 60 CONSTANT B6=60
- SA0 A1 A0=PARAMETER LIST ADDRESS
- SA1 A1 READ SOURCE ADDRESS
- SA2 A1+B1 READ TARGET ADDRESS
- SA3 A2+B1 READ ADDRESS OF NUMBER OF BYTES
- SA4 A3+B1 READ ADDRESS OF NUMBER OF BITS
- SA5 X1 READ FIRST SOURCE WORD
- SB4 X2 B4=TARGET WORD ADDRESS
- SA3 X3 READ NUMBER OF BYTES
- SA4 X4 READ NUMBER OF BITS PER BYTE
- SB5 X3+B4 B5=TARGET WORD LIMIT(LWA+1)
- SB2 X4 B2=NUMBER OF BITS PER BYTE
- GE B4,B5,BLOW RETURN IF NUMBER OF BYTES .LE.0
- GE B0,B2,BLOW RETURN IF NUMBER OF BITS.LE.0
- GE B2,B6,BLOW RETURN IF NUMBER OF BITS.GE.60
- SB3 B6-B2 B3=REMAINING BIT COUNT IN WORD
- MX4 1
- SB7 B3-B1
- LX5 B2,X5 SHIFT FIRST SOURCE WORD
- AX7 B7,X4 X7=BYTE MASK
- BX6 -X7*X5 MASK OUT FIRST BYTE
- SB3 B3+B2 RESET REMAINING BIT COUNT
- SB5 B5-B1 B5=LAST TARGET WORD ADDRESS
-*
-* MAIN LOOP - ONCE PER BYTE
-*
- BLOW1 SA6 B4 STORE BYTE
- EQ B4,B5,BLOW2 JUMP IF LAST BYTE
- SB3 B3-B2 DECREMENT REMAINING BIT COUNT
- LX5 B2,X5 SHIFT SOURCE WORD
- SB4 B4+B1 INCREMENT TARGET ADDRESS
- BX6 -X7*X5 MASK OUT BYTE
- LT B2,B3,BLOW1 LOOP UNLESS AT SOURCE WORD BOUND
- SA5 A5+B1 READ NEXT SOURCE WORD
- AX4 B3,X7 CONSTRUCT PARTIAL BYTE MASK
- BX2 X4*X6 MASK OUT LEFT PARTIAL BYTE
- SB7 B2-B3 NUMBER OF BITS FROM NEW WORD
- LX5 B7,X5 SHIFT NEW SOURCE WORD
- BX3 -X4*X5 MASK OUT RIGTH PARTIAL BYTE
- BX6 X2+X3 MERGE PARTIAL BYTES
- SB3 B6+B3 RESET REMAINING BIT COUNT
- EQ BLOW1
-*
-* NORMAL EXIT
-*
- BLOW2 SA4 BLOWA0
- SA0 X4 RESTORE OLD AO
- EQ BLOW EXIT
- END
-#ifdef CERNLIB_TCGEN_BLOW
-#undef CERNLIB_TCGEN_BLOW
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/btest.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/btest.s
deleted file mode 100644
index c459835..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/btest.s
+++ /dev/null
@@ -1,36 +0,0 @@
-*
-* $Id: btest.s,v 1.1.1.1 1996/02/15 17:51:19 mclareni Exp $
-*
-* $Log: btest.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:19 mclareni
-* Kernlib
-*
-*
- IDENT BTEST
-*
-* CERN PROGLIB# M441 BTEST .VERSION KERNCDC 2.18 870602
-* ORIG. ?
-*
-* LOGICAL FUNCTION BTEST(I,N)
-*
-* COMPASS VERSION OF ANSI/ISA FUNCTION BTEST
-* I IS AN INTEGER VARIABLE IN THE CALLING SEQUENCE
-* N IS THE BIT TO BE TESTED
-*
- ENTRY BTEST
- VFD 30/5HBTEST,30/BTEST
- BTEST DATA 0
- SA2 A1+1
- SA2 X2
- SA1 X1
- SX3 1
- SB2 X2
- LX3 B2,X3
- BX6 X3*X1
- ZR X6,BTEST
- SX6 -1
- EQ B0,B0,BTEST
- END
-#ifdef CERNLIB_TCGEN_BTEST
-#undef CERNLIB_TCGEN_BTEST
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/bunch.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/bunch.s
deleted file mode 100644
index 66c2879..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/bunch.s
+++ /dev/null
@@ -1,92 +0,0 @@
-*
-* $Id: bunch.s,v 1.1.1.1 1996/02/15 17:51:19 mclareni Exp $
-*
-* $Log: bunch.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:19 mclareni
-* Kernlib
-*
-*
- IDENT BUNCH
-*
-* CERN PROGLIB# M436 BUNCH .VERSION KERNCDC 1.16 820129
-*
-* SUBROUTINE BUNCH (SOURCE,TARGET,NBYTES,NBITS)
-*
-* SOURCE- GIVES THE ADDRESS OF A SOURCE ARRAY
-* TARGET- GIVES THE ADDRESS OF A TARGET ARRAY
-* NBYTES- NUMBER OF BYTES IN THE SOURCE RECORD
-* NBITS- NUMBER OF BITS PER BYTE
-*
-* J.D.BLAKE/CERN 1 OCTOBER 1974
-* MODIFIED JAN 1982 TO IGNORE CALLS WITH ERRONEOUS PARAMETER VALUES
-*
- ENTRY BUNCH
- BUNCHTR VFD 42/0LBUNCH,18/BUNCH
- BUNCHA0 DATA 0
- BUNCH JP 400000B+*
- SX6 A0
- SA0 A1 A0=PARAMETER LIST ADDRESS
- SA6 BUNCHA0 SAVE OLD A0
- SB1 1 CONSTANT B1=1
- SB2 60 CONSTANT B2=60
- SA1 A1 READ SOURCE ADDRESS
- SA2 A1+B1 READ TARGET ADDRESS
- SA3 A2+B1 READ ADDRESS OF NUMBER OF BYTES
- SA4 A3+B1 READ ADDRESS OF NUMBER OF BITS
- SA5 X1-1 READ WORD BEFORE FIRST SOURCE WORD
- SB6 X2 B6=TARGET WORD ADDRESS
- SA3 X3 READ NUMBER OF BYTES
- SA4 X4 READ NUMBER OF BITS PER BYTE
- SB3 X3 B3=BYTE COUNTER
- SB4 X4 B4=NUMBER OF BITS PER BYTE
- LE B3,B0,BUNCH RETURN IF NUMBER OF BYTES.LE.0
- LE B4,B0,BUNCH RETURN IF NUMBER OF BITS.LE.0
- GE B4,B2,BUNCH RETURN IF NUMBER OF BITS.GE.60
- SB5 B2 B5=BIT POSITION IN TARGET WORD
- MX7 1
- SB7 B4-59
- LX0 B7,X7 X0=BYTE MASK
- SX6 B0 CLEAR FIRST TARGET WORD
-*
-** MAIN LOOP - ONCE PER BYTE
-*
-* REGISTER CONVENTIONS
-* A5,X5 SOURCE WORD
-* A6,B6,X6 TARGET WORD
-* X0 BYTE MASK (COMPLEMENT)
-* B1 1
-* B2 60
-* B3 BYTE COUNTER (=NBYTES INITIALLY, =0 FINALLY)
-* B4 BYTE LENGTH
-* B5 BIT POSITION IN TARGET WORD (=60 INITIALLY)
-*
- BUNCH1 SA5 A5+B1 READ NEXT SOURCE WORD
- SB5 B5-B4 DECREMENT BIT POSITION
- LE B3,B0,BUNCH3 JUMP IF LAST BYTE HAS BEEN MOVED
- BUNCH2 BX2 -X0*X5 EXTRACT SOURCE BYTE
- LX3 B5,X2 POSITION SOURCE BYTE (END-OFF)
- SB3 B3-B1 DECREMENT BYTE COUNTER
- BX6 X6+X3 ADD SOURCE BYTE TO TARGET WORD
- GT B5,B0,BUNCH1 LOOP UNLESS TARGET WORD IS FULL
- SA6 B6 STORE TARGET WORD
- SB5 B5+B2 RESET BIT POSITION (ADD 60)
- SB6 B6+B1 INCREMENT TARGET ADDRESS
- LX4 B5,X2 POSITION SOURCE BYTE (CIRCULARLY)
- SA5 A5+B1 READ NEXT SOURCE WORD
- SB5 B5-B4 DECREMENT BIT POSITION
- BX6 X4-X3 STORE BOTTOM OF SOURCE BYTE IN TARGET
- GT B3,B0,BUNCH2 LOOP UNLESS LAST BYTE HAS BEEN MOVED
-*
-** END OF LOOP - STORE INCOMPLETE TARGET WORD, IF ANY,
-* AND RETURN
-*
- BUNCH3 SA4 BUNCHA0
- SB7 B5+B4 BIT POSITION OF LAST BYTE
- SA0 X4 RESTORE OLD A0
- EQ B7,B2,BUNCH RETURN IF TARGET WORD IS EMPTY
- SA6 B6 STORE INCOMPLETE TARGET WORD
- EQ BUNCH RETURN
- END
-#ifdef CERNLIB_TCGEN_BUNCH
-#undef CERNLIB_TCGEN_BUNCH
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/cbyt.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/cbyt.s
deleted file mode 100644
index a591b84..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/cbyt.s
+++ /dev/null
@@ -1,51 +0,0 @@
-*
-* $Id: cbyt.s,v 1.1.1.1 1996/02/15 17:51:19 mclareni Exp $
-*
-* $Log: cbyt.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:19 mclareni
-* Kernlib
-*
-*
- IDENT CBYT
-*
-* CERN PROGLIB# M421 CBYT .VERSION KERNCDC 0.1 731018
-*
-* SUBROUTINE CBYT(A,LA,X,LX,NBITS)
-*
-* ROUTINE FOR FTN, CORRECTED 17-OCT-73 PC +JZ
-*
- ENTRY CBYT
- VFD 24/4HCBYT,36/CBYT
- CBYT DATA 0
- SB7 -1 B7= -1
- SA2 A1-B7 X2= ADR(LA)
- SA3 A2-B7 X3= ADR(X)
- SA4 A3-B7 X+= ADR(LX)
- SA5 A4-B7 X5= ADR(NBITS)
- SA2 X2 X2= LA
- SA4 X4 X4= LX
- MX0 1 MASK STARTED
- SA5 X5 X5= NBITS
- IX2 X4-X2 X2= LX-LA = IDISP DISPLACEMENT A TO X
- SB6 X5+B7 B6= NBITS-1
- BX6 X2 X6= IDISPL
- SX7 60 X7= 60
- SB5 X4+B6 B5= NBITS+LX-1
- AX6 59 X6= 0 OR -0
- SA1 X1 X1= A
- SA3 X3 X3= X
- AX0 B6,X0 MASK ON LEFT
- BX7 X6*X7 X7= 0 OR 60 FOR IDISPL +VE OR -VE
- SB2 X2 B2= IDISPL
- LX0 B5,X0 SHIFT MASK TO LX
- SB2 B2 B2= IDISPL OR IDISPL+60
- BX3 -X0*X3 MASK OUT BYTE IN X
- LX1 B2,X1 SHIFT BYTE IN A TO LX
- BX1 X0*X1 MASK OUT NON BYTE IN A
- BX6 X1+X3 ADD BYTE TO X
- SA6 A3 RESTORE RESULT
- EQ CBYT
- END
-#ifdef CERNLIB_TCGEN_CBYT
-#undef CERNLIB_TCGEN_CBYT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/cfromi.F b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/cfromi.F
deleted file mode 100644
index ae7c8b0..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/cfromi.F
+++ /dev/null
@@ -1,36 +0,0 @@
-*
-* $Id: cfromi.F,v 1.1.1.1 1996/02/15 17:51:19 mclareni Exp $
-*
-* $Log: cfromi.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:19 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
-#if defined(CERNLIB_F77)
- CHARACTER*(*) FUNCTION CFROMI(I)
-C
-C CERN PROGLIB# M431 CFROMI .VERSION KERNCDC 2.16 860514
-C ORIG. 10/02/86 M.METCALF
-C
-C TO CONVERT 4 PACKED ASCII CODES TO CHARACTERS
-C CDC ONLY
-C
- PARAMETER (M8 = COMPL(MASK(52)))
- CFROMI = ' '
- J = I
- LENCH = MIN(LEN(CFROMI), 4)
- JJ = LENCH
- DO 1 II = 4, 1, -1
- IF (II.LE.LENCH) THEN
- CALL ITOCH(AND(J, M8), CFROMI(JJ:JJ), *999)
- JJ = JJ-1
- ENDIF
- J = SHIFT(J, -8)
- 1 CONTINUE
- 999 END
-#ifdef CERNLIB_TCGEN_CFROMI
-#undef CERNLIB_TCGEN_CFROMI
-#endif
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/cvt360.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/cvt360.s
deleted file mode 100644
index 71018a7..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/cvt360.s
+++ /dev/null
@@ -1,106 +0,0 @@
-*
-* $Id: cvt360.s,v 1.1.1.1 1996/02/15 17:51:19 mclareni Exp $
-*
-* $Log: cvt360.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:19 mclareni
-* Kernlib
-*
-*
- IDENT CVT360
-*
-* CERN PROGLIB# M219 CVT360 .VERSION KERNCDC 2.01 820727
-*
- ENTFTN MACRO (NM,NOPAR,REG)
- LOCAL Z
- NM BSSZ 1
- Z1Z1Z IFNE *F,1
- EQ *+3
- BSSZ 2
- SA2 NM
- SA3 =O5302046000
- BX6 X2+X3
- LX6 30
- SA6 NM+2
- SA3 =O51200000000400000000
- SX4 NM+2
- IX3 X3+X4
- SX4 X4+1
- LX4 30
- BX6 X3+X4
- SA6 A2
- SX6 A0
- SB7 A1
- SA6 NM+3
- Z1Z1 SET 1 DIGITSELECTOR
- DUP NOPAR
- ZR X1,Z
- Z1Z1Z1 IFLT Z1Z1,7 IF FIRST SIX
- SB.Z1Z1 X1
- Z1Z1Z1 ELSE 2
- LX6 X1
- SA6 NM-NOPAR-2+Z1Z1
- Z1Z1Z1 ENDIF
- Z1Z1 SET Z1Z1+1
- Z1Z IFGE NOPAR,Z1Z1
- SA1 A1+1 LOAD NEXT
- Z1Z ENDIF
- ENDD
- Z BSS 0
-Z1Z1Z11 IFC NE,/REG//
-Z1Z1 SET 1
-Z1Z1Z1Z IFC EQ,/REG/X1/
-Z1Z1 SET 2
- BX2 X1
-Z1Z1Z1Z ENDIF
- S_REG A1-B7
- IFNE NOPAR,0
- ZR X.Z1Z1,*+2-$/46
- S_REG REG+1
- BSS 0
- ENDIF
- ENDM
- ENTRY CVT360
-* SUBROUTINE CVT360(AI,AJ,MODE)
- TRACE VFD 36/6HCVT360,24/3
- ENTFTN CVT360,3,X2
- SX2 X2-2
- NG X2,ERROR .BRANCH TO ERROR IF LT. 2 PARAMS
- ZR X2,FLPT .BRANCH TO FLPT IF 2 PARAMS
- SA3 B3 .PUT 3D PARAM IN X3
- ZR X3,FLPT .BRANCH TO FLPT MODE = 0
- INT SA2 B1 .PICK UP NUMBER IN X2
- SB4 B0 .SET INTEGER INDICATOR
- LX2 28 .SHIFT SIGN BIT TO LEFT
- BX3 X2 .EQUIVALENCE X2 X3
- AX3 59 .FORM A WORD OF SIGN BITS
- AX2 28 .SHIFT INTEGER BACK TO RIGHT WITH
- MX0 59 .SET MASK
- BX3 -X0*X3 .SET B1 = 0 OR 1 ACC. TO SIGN
- IX6 X2-X3 .SUBTRACT 1 IF NEG. 2,S COMPTO 1,
- EQ B0,B0,ENSTOR .BRANCH AND STORE THE RESULT
- FLPT SA2 B1 .SET X2 = NEXT IBM NUMBER
- SB4 B0+1 .SET FLPT INDICATOR
- BX3 X2
- MX0 36
- BX2 -X0*X2 .MASK MANTISSA
- BX3 X0*X3 .MASK EXPONENT
- LX3 28 .LEFT ADJUST EXPONENT
- BX4 X3 .EQUIVALENCE X4 AND X3
- AX4 59 .MAKE UP A WORD OF SIGN BITS
- AX3 52 .RIGHT ADJUST
- MX0 53 .SET MASK
- BX3 -X0*X3 .ENSURE X3 CONTAINS ONLY 7 BITS
- SX3 X3-64 .SUBTRACT64 BIAS
- LX3 2 .MULTIPLY BY 4 TOGO TO BASE 2
- SB5 X3-24 .SUBTRACT 24 TO CONVERT FRACT
- PX6 X2,B5 .PACK AS A FLPT NUMBER
- NX6 X6,B5 .NORMALISE THE NUMBER
- BX6 X4-X6 .COMPLEMENT IF NEGATIVE
- ENSTOR SA6 B1
- SB1 B1+1 .ADD 1 TO FIRST ADDRESS
- LT B2,B1,CVT360
- EQ B4,B0,INT
- EQ B0,B0,FLPT
- ERROR NO
- RET EQ CVT360 .RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/floarg.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/floarg.s
deleted file mode 100644
index 7ab993c..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/floarg.s
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: floarg.s,v 1.1.1.1 1996/02/15 17:51:19 mclareni Exp $
-*
-* $Log: floarg.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:19 mclareni
-* Kernlib
-*
-*
- IDENT FLOARG
-*
-* CERN PROGLIB# M250 FLOARG .VERSION KERNCDC 1.13 820111
-*
- ENTRY FLOARG
-* FUNCTION FLOARG(I)
- FLOARG CON 0
- SA2 X1 .X2=I
- SB2 12
- MX0 1
- BX3 X2*X0 .X3=BIT 59 DE I
- SB4 48 .
- LX4 X0,B4
- BX5 X2*X4 .X5=BIT 47 DE I
- LX5 X5,B2
- IX6 X3-X5
- NZ X6,EXIT
- PX3 X2
- NX2 X3
- EXIT BX6 X2
- EQ FLOARG
- END
-#ifdef CERNLIB_TCGEN_FLOARG
-#undef CERNLIB_TCGEN_FLOARG
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/flpsor.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/flpsor.s
deleted file mode 100644
index 54449de..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/flpsor.s
+++ /dev/null
@@ -1,134 +0,0 @@
-*
-* $Id: flpsor.s,v 1.1.1.1 1996/02/15 17:51:20 mclareni Exp $
-*
-* $Log: flpsor.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:20 mclareni
-* Kernlib
-*
-*
- IDENT FLPSOR
-*
-* CERN PROGLIB# M103 FLPSOR .VERSION KERNCDC 1.05 780503
-*
- ENTRY FLPSOR
-*
-* THIS SUBROUTINE PACKAGES WAS ENTIRELY RECODED IN MARCH 74
-* TO OVERCOME A DESIGN BUG IN THE PREVIOUS PACKAGE, THAT,
-* DEPENDING ON THE SEQUENCE OF THE NUMBERS TO BE SORTED,
-* OVERWROTE A NUMBER BY ANOTHER ONE.
-* H. V. EICKEN, CERN, DD-DIVISION
-*
-* PROGRAM M103 TAKEN FROM CERN PROGRAM LIBRARY, 29-APR-78
-*
-* SUBROUTINE FLPSOR(A,N)
-*
-* THIS SUBROUTINE SORTS FLOATING POINT NUMBERS
-* IT SORTS AN ARRAY INTO ITSELF
-* THE CALLING SEQUENCE IS * CALL FLPSOR ( ARRAY,NUMBER )
-*
- USE /SLATE/
- BSS 10
- STACK BSS 30
- USE
-*
- VFD 36/0HFLPSOR,24/FLPSOR
-FLPSOR EQ *+1S17 EXIT ENTRY LINE
- SB1 1 ALWAYS 1
- SA2 A1+B1
- SB7 B0-B1 STACK POINTER. EMPTY STACK
- SA3 X2 LOAD NUMBER OF ELEMENTS
- SX4 X1+B7 START OF ARRAY - 1
- IX5 X4+X3 ADDRESS OF LAST ELEMENT
- LX1 20
- BX1 X1+X5 FIRST AND LAST ELEMENT
- SB3 X3+B7 NUMBER OF ELEMENTS -1
- GE B0,B3,FLPSOR LESS THAN TWO ELEMENTS
-SPLIT SB4 X1 UPPER BOUNDARY
- AX1 20
- SB2 X1 LOWER BOUNDARY
- SX0 B2+B4
- SA2 B2 LOAD LOWER ELEMENT
- SA4 B4 LOAD UPPER ELEMENT
- AX0 1 ADDRESS OF CENTER ELEMENT
- FX5 X4-X2
- SB3 B3-B1 REDUCE NUMBER OF ELEMENTS
- BX6 X2 X6 CONTAINS SMALLEST ELEMENT
- SA3 X0 LOAD EVENTUAL CENTER ELEMENT
- LX7 X4 X7 CONTAINS LARGEST ELEMENT
- PL X5,L1 IF UPPER .GT. LOWER
- BX6 X4 SWAP THEM
- LX7 X2,B0
-L1 FX5 X7-X3
- ZR B3,L4 MORE THAN TWO ELEMENTS?
- BX4 X7 ALLOW FOR A SWAP
- PL X5,L2 IF UPPER .GT. CENTER
- BX7 X3 SWAP THEM
- LX3 X4,B0
-L2 FX5 X3-X6 MIGHT BE UNNECESSARY
- BX4 X6 X4 CONTAINS ASSUMED LOWEST
- LX6 X3,B0 X6 CONTAINS ASSUMED CENTER
- SB3 B3-B1 REDUCE NUMBER AGIN
- PL X5,L3 IF CENTER .GT. LOWER
- BX6 X4 SWAP THEM
- LX4 X3
-L3 SA6 A3 STORE CENTER
- SB5 B4 SET RUNNING POINTER IN UPPER
- LX3 X6 KEEP CENTER VALUE IN X3
- BX6 X4
-L4 SA6 A2 STORE LOWER
- SA7 A4 STORE UPPER
- ZR B3,NEXT INTERVAL IS SORTED
- SB3 B2 RUNNING POINTER IN LOWER
-UPPER SB5 B5-B1 REDUCE POINTER
- SA4 B5 LOAD ELEMENT
- FX0 X4-X3 COMPARE AGINST SPLITTING ELEMENT
- BX6 X4 PREPARE A SWAP
- EQ B3,B5,SPLITED INTERVAL IS SPLITTED
- PL X0,UPPER
-LOWER SB3 B3+B1 INCREMENT POINTER
- SA2 B3 LOAD ELEMENT
- FX0 X3-X2 COMPARE AGAINST SPLITTING ELEMENT
- BX7 X2 PREPARE A SWAP
- EQ B3,B5,SPLITED
- PL X0,LOWER
- SA6 A2 SWAP ELEMENTS
- SA7 A4
- EQ UPPER
-SPLITED SX1 B2 LOWER BOUNDARY IN LOWER INTERVAL
- SX2 B3 UPPER BOUNDARY IN LOWER INTERVAL
- SB5 B5+B1
- LX1 20
- SX3 B5 LOWER BOUNDARY IN UPPER INTERVAL
- SX4 B4 UPPER BOUNDARY IN UPPER INTERVAL
- BX1 X1+X2 ASSUME LOWER IS SMALLER
- LX3 20
- BX6 X3+X4 ASSUME UPPER IS LARGER
- SB3 B3-B2 # OF LEMENTS - 1 IN LOWER
- SB4 B4-B5 # OF ELEMNTS - 1 IN UPPER
- LX5 X6,B0 PREPARE A SWAP
- SX0 B4
- GE B4,B3,L5
- BX6 X1 SWAP THEM
- LX1 X5,B0
- SB2 B3
- SB3 X0
- SX0 B2
-L5 NZ B3,STOR MORE THAN ONE ELEMENT IN SMALLER?
- BX1 X6 NO, SMALLER IS SORTED
- SB3 X0
- EQ SPLIT
-STOR LX6 20
- BX7 X6+X0
- SB7 B7+B1 INCREMENT STACK POINTER
- SA7 STACK+B7 STORE INTERVAL
- EQ SPLIT
-NEXT SA1 STACK+B7 LOAD NEXT INTERVAL
- NG B7,FLPSOR STACK IS EMPTY, ALL DONE
- SB7 B7-B1 DECREMENT STACK POINTER
- SB3 X1 NUMBER OF ELEMENTS - 1
- AX1 20
- EQ SPLIT
- END
-#ifdef CERNLIB_TCGEN_FLPSOR
-#undef CERNLIB_TCGEN_FLPSOR
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/fto360.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/fto360.s
deleted file mode 100644
index 4dddc58..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/fto360.s
+++ /dev/null
@@ -1,223 +0,0 @@
-*
-* $Id: fto360.s,v 1.1.1.1 1996/02/15 17:51:20 mclareni Exp $
-*
-* $Log: fto360.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:20 mclareni
-* Kernlib
-*
-*
- IDENT FTO360
-*
-* CERN PROGLIB# M430 FTO360 .VERSION KERNCDC 2.01 820727
-*
- ENTRY FTO360
-* FTO360 - COMPASS VERSION - SEPTEMBER 1976 - GENEVIEVE ROUX
-* SUBROUTINE FTO360(IA,NN,MD)
-TRACE VFD 36/6HFTO360,24/3
-FTO360 EQ FTO360+400000B
- SB1 X1 B1=ADDRESS OF A
- SA1 A1+1 X1=ADDRESS OF N
- SB6 B1 .INITIALIZE FOR REAL
- SA2 X1
- SB2 X2+B1 B2=ADDRESS OF A(N+1)
- SA1 A1+1 ADDRESS OF THIRD PARAMETER
- ZR X1,REAL
- SA1 X1 X1=MODE
- ZR X1,REAL MODE=0 - REAL
- SX2 X1-1
- ZR X2,INT MODE=1 - INTEGER
- SA2 HF
- IX2 X2-X1
- ZR X2,REAL MODE=1HF - REAL
- SA2 HFLOAT
- IX2 X2-X1
- ZR X2,REAL MODE=5HFLOAT - REAL
- SA2 HI
- IX2 X2-X1
- ZR X2,INT MODE=1HI - INTEGER
- SA2 HINT
- IX2 X2-X1
- ZR X2,INT MODE=3HINT - INTEGER
- EQ FTO360
-INT BSS 0
- SA2 B1 PICKS UP NUMBER IN X2
- SB6 B0 SET INTEGER INDCATOR
- SB7 0 POSITIVE NUMBER
- PL X2,PLUS
- BX2 -X2
- SB7 1
-PLUS MX3 31
- ZR X2,LOAD
- LX3 31
- SX7 B7
- IX3 X3+X7
- IX4 X3-X2
- PL X4,OK
- BX2 X3
-OK ZR B7,LOAD
- MX3 32
- LX3 32
- MX0 73B
- IX2 X2+X0 X2=X2-1
- BX2 -X2
- BX2 X2*X3
- EQ LOAD
-HF DATA 1HF
-HFLOAT DATA 5HFLOAT
-HI DATA 1HI
-HINT DATA 3HINT
-I4Z DATA 7777777777777777B
-I2T23 DATA 40000000B
-I4Z8S DATA 7777777700000000B
-MXNO DATA 23147777777700000000B
-MNNO DATA 13144000000000000000B
-IXNOPL DATA 17777777777B
-IXNONG DATA 37777777777B
-REAL BSS 0
- SA2 B1 X2=A(I)
- SB7 B0 POSITIVE NUMBER
- PL X2,POS
- SB7 1 NEGATIVE NUMBER
- BX2 -X2 X2=-A(I)
-POS BSS 0
- ZR X2,LOAD
- SA3 MXNO X3=MXNO
- MX0 0
- IX3 X2-X3 A(I)-MXNO
- IX6 X0+X3
- MI X3,LTMXNO A(I) .LT. MNO
- EQ B7,B0,MAXPL
- SA2 IXNONG A(I)=37777777777B
- EQ LOAD
-MAXPL BSS 0
- SA2 IXNOPL
- EQ LOAD
-LTMXNO BSS 0
- SA3 MNNO X3=MNNO
- IX3 X3-X2 MNNO-A(I)
- IX6 X0+X3
- MI X6,INRANGE
- MX2 0 A(I)=0
- EQ LOAD
-INRANGE BSS 0
- MX4 48
- LX4 48
- BX0 X2 X0=A(I)
- BX7 X2*X4 MANTISSA=X7=A(I) .A. MASK(48)
- SX3 1720B
- AX0 60B SHIFT(A(I),48)
- IX6 X0-X3 EXPONENT=X6=SHIFT(A(I),48)-976
- SX0 57B
- IX5 X0-X6 X5=47-EXP
- MX0 73B X0=-1
- PL X5,LT47
- IX6 X6+X0 EXP=EXP-1
-LT47 BSS 0
- MX5 72B X5=MASK(58) OR -3B
- BX4 X6
- BX3 X6
- MX2 0
- AX4 73B
- BX1 X4-X3
- BX3 -X5*X1
- BX1 X3-X4
- IX4 X2+X1 J=X4=MOD(EXP,4)
- AX6 2B SHIFT(EXP,-2)
- NG X4,A44
- IX6 X6-X0 EXP=EXP+1
- IX4 X5+X4 J=J-3
- EQ JLT0
-A44 IX4 X4-X0 J=J-1
-JLT0 BSS 0
- SB4 X4
- LX7 B4,X7 MAN=SHIFT(MAN,NEW J)
- SA4 I2T23
- IX4 X4+X7 J=MAN+I2T23
- SX0 100B
- IX6 X6+X0 NEX=NEX+64D
- MX5 12
- BX3 X4*X5 J .A. MASK(12)
- SB4 -30B B4=-24
- ZR X3,A59
- SX0 177B
- IX3 X6-X0 EXP-127
- NZ X3,A58
- SA5 I4Z8S
- BX7 X7*X5
- AX7 30B
- EQ A60
-A58 BSS 0
- SB4 -34B
- MX0 73B X0=-1
- IX6 X6-X0 NEX=NEX+1
-A59 BSS 0
- LX7 B4,X4 MAN=SHIFT(J,KL)
- MX3 24
- LX3 24
- BX7 X7*X3 MAN=MAN .A. 7777777B
-A60 BSS 0
- LX6 30B EXP=SHIFT(EXP,24)
- BX2 X6+X7 A(I)=EXP .OR. MAN
- SX3 B7
- LX3 37B SHIFT OF SIGN BIT
- BX2 X2+X3 A(I)=A(I) .OR. SIGN BIT
-LOAD BX6 X2
- SA6 B1 STORE NEW NUMBER
-NEWNO BSS 0
- SB1 B1+1
- EQ B2,B1,FTO360
- EQ B6,B0,INT
- EQ B0,B0,REAL
- END
- IDENT BUNCH32
- ENTRY BUNCH32
-* SUBROUTINE BUNCH32(ARRAY,N)
- VFD 42/7HBUNCH32,18/BUNCH32
-SA BSSZ 1
-BUN SA1 SA
- SA0 X1
-BUNCH32 DATA 0
- SX6 A0
- SB1 X1
- SA6 SA
- SA1 A1+1
- SB2 X1
- SA0 B0
- MX7 28
- SB7 1
- SB6 B0
- MX6 0
- SA2 B2
- SB5 -32
- MX3 1
- SB4 28
- BX3 -X3
- SB2 X2
- EQ IP
- OP SB4 B4+92
- SA6 A0+B1
- SB3 B4-B7
- MX6 0
- SA0 A0+B7
- AX4 B3,X3
- BX1 X1*X4
- EQ SH
- IP SA1 B1+B6
- EQ B6,B2,ED
- SB6 B6+B7
- BX1 -X7*X1
- SH LX5 B4,X1
- SB4 B4+B5
- BX6 X5+X6
- GT B4,B5,IP
- LT B4,B5,OP
- SB4 28
- SA6 A0+B1
- SA0 A0+B7
- MX6 0
- EQ IP
- ED SB4 B4-28
- EQ B0,B4,BUN
- SA6 A0+B1
- EQ BUN
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/gshow.F b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/gshow.F
deleted file mode 100644
index 9067c02..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/gshow.F
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: gshow.F,v 1.1.1.1 1996/02/15 17:51:18 mclareni Exp $
-*
-* $Log: gshow.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:18 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE GSHOW (LUN)
-
-C CERN PROGLIB# GSHOW .VERSION KERNCDC 1.07 781218
-
-C-- STORE PAM TITLE INTO /SLATE/ FOR PRINTING BY GSHOWF
-
- COMMON /SLATE/ CH(40)
-
- CALL UBLOW (
- + 40H CPP_TITLE
- +, CH, 40)
-
- CALL GSHOWF (LUN)
- RETURN
- END
-#ifdef CERNLIB_TCGEN_GSHOW
-#undef CERNLIB_TCGEN_GSHOW
-#endif
-#include "TITLE.kerncdc"
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/iandetc.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/iandetc.s
deleted file mode 100644
index 34f65eb..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/iandetc.s
+++ /dev/null
@@ -1,58 +0,0 @@
-*
-* $Id: iandetc.s,v 1.1.1.1 1996/02/15 17:51:20 mclareni Exp $
-*
-* $Log: iandetc.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:20 mclareni
-* Kernlib
-*
-*
- IDENT IAND
-*
-* CERN PROGLIB# M441 IANDETC .VERSION KERNCDC 2.18 870602
-* ORIG. ?
-*
-* COMPASS VERSIONS OF IAND, IOR, IEOR, NOT
-*
- ENTRY IAND
- ENTRY IOR
- ENTRY IEOR
- ENTRY NOT
-*
-* FUNCTION IAND(I,J)
-*
- VFD 24/4HIAND,36/IAND
- IAND DATA 0
- SA2 A1+1
- SA2 X2
- SA1 X1
- BX6 X1*X2
- EQ B0,B0,IAND
-*
-* FUNCTION IOR(I,J)
-*
- VFD 18/3HIOR,42/IOR
- IOR DATA 0
- SA2 A1+1
- SA2 X2
- SA1 X1
- BX6 X1+X2
- EQ B0,B0,IOR
-*
-* FUNCTION IEOR(I,J)
-*
- VFD 24/4HIEOR,36/IEOR
- IEOR DATA 0
- SA2 A1+1
- SA2 X2
- SA1 X1
- BX6 X1-X2
- EQ B0,B0,IEOR
-*
-* FUNCTION NOT(I)
-*
- VFD 18/3HNOT,42/NOT
- NOT DATA 0
- SA1 X1
- BX6 -X1
- EQ B0,B0,NOT
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/ibclr.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/ibclr.s
deleted file mode 100644
index 7b74b82..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/ibclr.s
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: ibclr.s,v 1.1.1.1 1996/02/15 17:51:20 mclareni Exp $
-*
-* $Log: ibclr.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:20 mclareni
-* Kernlib
-*
-*
- IDENT IBCLR
-*
-* CERN PROGLIB# M441 IBCLR .VERSION KERNCDC 2.18 870602
-* ORIG. ?
-*
-* FUNCTION IBCLR(I,N)
-*
-* COMPASS VERSION OF ANSI/ISA FUNCTION IBCLR
-* I IS AN INTEGER VARIABLE IN THE CALLING SEQUENCE
-* N IS THE POSTION OF THE BIT TO BE CLEARED
-*
- ENTRY IBCLR
- VFD 30/5HIBCLR,30/IBCLR
- IBCLR DATA 0
- SA2 A1+1
- SA2 X2
- SA1 X1
- SX3 1
- SB2 X2
- LX3 B2,X3
- BX6 -X3*X1
- EQ B0,B0,IBCLR
- END
-#ifdef CERNLIB_TCGEN_IBCLR
-#undef CERNLIB_TCGEN_IBCLR
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/ibits.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/ibits.s
deleted file mode 100644
index 92f9b3c..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/ibits.s
+++ /dev/null
@@ -1,46 +0,0 @@
-*
-* $Id: ibits.s,v 1.1.1.1 1996/02/15 17:51:20 mclareni Exp $
-*
-* $Log: ibits.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:20 mclareni
-* Kernlib
-*
-*
- IDENT IBITS
-*
-* CERN PROGLIB# M441 IBITS .VERSION KERNCDC 2.18 870602
-* ORIG. ?
-*
-* FUNCTION IBITS(I,N,L)
-*
-* COMPASS VERSION OF MIL-STD-1753 FUNCTION IBITS
-* I IS AN INTEGER VARIABLE IN THE CALLING SEQUENCE
-* N IS THE RIGHTMOST BIT OF THE REQUIRED FIELD
-* L IS THE LENGTH OF THE REQUIRED FIELD
-*
- ENTRY IBITS
- VFD 30/5HIBITS,30/IBITS
- IBITS DATA 0
- SA2 A1+1
- SA3 A2+1
- SA3 X3
- ZR X3,ZERO .TEST ON ZERO FIELD
- SA2 X2
- SA1 X1
- SB3 X3
- SB2 X2
- MX4 1
- SB4 B3-1
- AX4 B4,X4
- SB6 B2+B3
- LX4 B6,X4
- BX6 X4*X1
- AX6 B2,X6
- EQ B0,B0,IBITS
-*
- ZERO SX6 B0
- EQ B0,B0,IBITS
- END
-#ifdef CERNLIB_TCGEN_IBITS
-#undef CERNLIB_TCGEN_IBITS
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/ibset.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/ibset.s
deleted file mode 100644
index b4072cd..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/ibset.s
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: ibset.s,v 1.1.1.1 1996/02/15 17:51:20 mclareni Exp $
-*
-* $Log: ibset.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:20 mclareni
-* Kernlib
-*
-*
- IDENT IBSET
-*
-* CERN PROGLIB# M441 IBSET .VERSION KERNCDC 2.18 870602
-* ORIG. ?
-*
-* FUNCTION IBSET(I,N)
-*
-* COMPASS VERSION OF ANSI/ISA FUNCTION IBSET
-* I IS AN INTEGER VARIABLE IN THE CALLING SEQUENCE
-* N IS THE POSITION OF THE BIT TO BE SET
-*
- ENTRY IBSET
- VFD 30/5HIBSET,30/IBSET
- IBSET DATA 0
- SA2 A1+1
- SA2 X2
- SA1 X1
- SX3 1
- SB2 X2
- LX3 B2,X3
- BX6 X3+X1
- EQ B0,B0,IBSET
- END
-#ifdef CERNLIB_TCGEN_IBSET
-#undef CERNLIB_TCGEN_IBSET
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/ie3fod.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/ie3fod.s
deleted file mode 100644
index 0c9147b..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/ie3fod.s
+++ /dev/null
@@ -1,113 +0,0 @@
-*
-* $Id: ie3fod.s,v 1.1.1.1 1996/02/15 17:51:20 mclareni Exp $
-*
-* $Log: ie3fod.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:20 mclareni
-* Kernlib
-*
-*
- IDENT IE3FOD
-*
-* CERN PROGLIB# M220 IE3FOD .VERSION KERNCDC 2.17 861204
-*
- ENTRY IE3FOD
-*
-* CALL IE3FOD (TAKE, PUT, NDP, JBAD)
-
-* CONVERT 'TAKE' OF NW=2*NDP WORDS CONTAINING
-* 'NDP' CDC DOUBLE-PRECISION FLOATING POINT NUMBERS
-* TO 'PUT' IN IEEE REPRESENTATION, EACH 32 BITS RIGHT JUST.
-* RETURN IN 'JBAD' THE POSITION OF LAST CONVERSION PROBLEM
-*
-* REGISTER ASSIGNMENTS
-*
-* X1 current word LH B1 adr(PUT(0))
-* X2 next word pre-loaded B2 JLOOP = 1,2,3,...
-* X3 sign-bit B3 NW
-* X4 current word RH
-*
-* X6 result LH -> PUT B6 adr(JBAD)
-* X7 result RH -> PUT B7 =1
-*
- VFD 36/6HIE3FOD,24/IE3FOD
- IE3FOD DATA 0
- SB7 1 *B7= 1
-* X1= adr(TAKE(1))
- SA2 A1+B7 X2= adr(PUT(1))
- SA3 A2+B7 X3= adr(NDP)
- SA4 A3+B7 X4= adr(JBAD)
-*
- SB6 -B7
- MX6 0
- SB1 X2+B6 *B1= adr(PUT(0))
- SB2 B0 *B2= JLOOP = 0
- SA2 X1 X2= TAKE(1) pre-loaded
- SA3 X3 X3= NDP
- SA6 X4 preset JBAD = 0
- LX3 1 X3= 2*NDP
- SB6 X4 *B6= adr(JBAD)
- SB3 X3 *B3= NW = 2*NDP
-*
- LOOP BX1 X2 X1= AL = TAKE(JLOOP)
- SA4 A2+B7 *X4= AR = TAKE(JLOOP+1)
- SB2 B2+B7 *B2= bump JLOOP by 1
- SA2 A4+B7 *X2= TAKE(JLOOP+2) preloaded
- MX6 0 *X6= 0 in case A=0
- MX7 0 *X7= 0 in case A=0
- ZR X1,STORE test A=0
- ID X1,BAD test A indefinite
- OR X1,OVF test A overflow
-*
- MX3 1
- BX0 X1
- BX3 X3*X1 *X3= sign-bit of A
- AX0 60 X0= all zero or one
- BX1 X1-X0 X1= AL = ABS(AL)
- BX4 X4-X0 X4= AR = ABS(AR)
- UX1 B4,X1 B4=N, X1=M(48 bits) for AL = M * 2**N
- SB4 B4+1024 B4= N+1024
- EQ B4,B7,STORE test underflow
- SB4 B4+46 *B4= N+47 + 1023 = IEEE char.
- SB5 2047
- GE B4,B5,OVF test IEEE char. .GE. 2047
-*
- UX4 B0,X4 X4= 48 bits of DP mantissa with sign
- MX0 12
- BX4 -X0*X4 X4= (48) bits 49-96 of DP mant. only
- AX4 43 X4= (5) bits 49-53 of DP mant.
- BX7 X1 X7= (48) bits 1-48 of DP mant.
- MX0 33
- BX7 -X0*X7 X7= (27) bits 22-48 of DP mant.
- LX7 5
- BX7 X7+X4 *X7= (32) bits 22-53 of IEEE mant.
-*
- AX1 27 X1= (21) bits 1-21 of mant.
- MX0 40
- BX1 -X0*X1 X1= (20) bits 2-21 of IEEE mant
- SX4 B4 X4= IEEE char
- LX3 32 sign-bit positioned
- LX4 20 char. positioned for merge
- BX6 X1+X3
- BX6 X6+X4
- STORE SA6 B1+B2 store PUT(JLOOP)
- SA7 A6+B7 store PUT(JLOOP+1)
- SB2 B2+B7 *B2= bump JLOOP by 1 again
- LT B2,B3,LOOP
- JP IE3FOD
-*
- BAD SA4 BADVAL X4= IEEE indefinite
- JP BADOVF
- OVF SA4 OVFVAL X4= IEEE overflow
- LX3 32 sign-bit positioned
- BX4 X4+X3
- BADOVF SX6 B2+B7 X6= JBAD = JLOOP/2
- AX6 1
- SA6 B6
- BX6 X4
- JP STORE
- BADVAL DATA 17774017700B
- OVFVAL DATA 17774000000B
- END
-#ifdef CERNLIB_TCGEN_IE3FOD
-#undef CERNLIB_TCGEN_IE3FOD
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/ie3fos.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/ie3fos.s
deleted file mode 100644
index 94b39ba..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/ie3fos.s
+++ /dev/null
@@ -1,109 +0,0 @@
-*
-* $Id: ie3fos.s,v 1.1.1.1 1996/02/15 17:51:20 mclareni Exp $
-*
-* $Log: ie3fos.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:20 mclareni
-* Kernlib
-*
-*
- IDENT IE3FOS
-*
-* CERN PROGLIB# M220 IE3FOS .VERSION KERNCDC 2.17 861204
-*
- ENTRY IE3FOS
-*
-* CALL IE3FOS (TAKE, PUT, NW, JBAD)
-
-* CONVERT 'TAKE' OF 'NW' CDC FLOATING POINT NUMBERS
-* TO 'PUT' IN IEEE REPRESENTATION, EACH 32 BITS RIGHT JUST.
-* RETURN IN 'JBAD' THE POSITION OF LAST CONVERSION PROBLEM
-*
-* REGISTER ASSIGNMENTS
-*
-* X1 current word B1 adr(PUT(0))
-* X2 next word pre-loaded B2 JLOOP = 1,2,3,...
-* X3 sign-bit B3 NW
-*
-* X6 last JBAD saved B6 adr(JBAD)
-* X7 result -> PUT B7 =1
-*
- VFD 36/6HIE3FOS,24/IE3FOS
- IE3FOS DATA 0
- SB7 1 *B7= 1
-* X1= adr(TAKE(1))
- SA2 A1+B7 X2= adr(PUT(1))
- SA3 A2+B7 X3= adr(NW)
- SA4 A3+B7 X4= adr(JBAD)
-*
- SB6 -B7
- SB1 X2+B6 *B1= adr(PUT(0))
- SB2 B0 *B2= JLOOP = 0
- SA2 X1 X2= TAKE(1) pre-loaded
- SA3 X3 X3= NW
- SB6 X4 *B6= adr(JBAD)
- MX6 0 *X6= JBAD = 0
- SB3 X3 *B3= NW
-*
- LOOP BX1 X2 X1= A = TAKE(JLOOP)
- SB2 B2+B7 *B2= JLOOP
- SA2 A2+B7 *X2= TAKE(JLOOP+1) preloaded
- MX7 0 *X7= 0 in case A=0
- ZR X1,STORE test A=0
- ID X1,BAD test A indefinite
- MX3 1
- BX5 X1
- BX3 X3*X1 *X3= sign-bit of A
- AX5 60 X5= all zero or one
- BX4 X1-X5 X4= A = ABS(A)
- NX1 X4 X1= A normalized
- UX1 B4,X1 B4=N, X1=M(48 bits) for A = M * 2**N
- SX4 B7 X4= 1
- AX1 23 X1= M (25 bits)
- IX1 X1+X4 X1= M (25 bits) rounded
- BX5 X1 to detect overflow to bit 26
- AX1 1 X1= M (24 bits)
- AX5 25 *X5= 1 if overflow to bit 26
- SB5 254 B5= 254
- SB4 X5+B4 B4= N bumped for rounding
- SB4 B4+173 B4= N+47 + 126 = IEEE ch'stic - 1
- LT B4,B0,CHZERO test IEEE ch'stic .LE. 0
- GE B4,B5,OVF test .GE. 255
- SX4 B4+B7 X4= N+47 + 127 = IEEE characteristic
- MX0 37
- BX1 -X0*X1 *X1= IEEE mantissa
- LX3 32 sign-bit positioned
- LX4 23 ch'stic positioned for merge
- BX7 X1+X3
- BX7 X7+X4
- STORE SA7 B1+B2 store PUT(JLOOP)
- LT B2,B3,LOOP
- SA6 B6 store JBAD to ouput parameter
- JP IE3FOS
-*
-*-- denormalized output number
-*
-CHZERO SB4 -B4 B4= 1 + IEEE ch'stic underflow
- SB5 24
- GE B4,B5,STORE zero if shift of 24 or more
- SB4 X5+B4 bumped by one if round to bit 26
- AX1 B4,X1 X1= mantissa shifted
- LX3 32 sign-bit positioned
- BX7 X1+X3
- JP STORE
-*
-*-- indefinite / overflow
-*
- BAD SA4 BADVAL X4= IEEE indefinite
- JP BADOVF
- OVF SA4 OVFVAL X4= IEEE overflow
- LX3 32 sign-bit positioned
- BX4 X4+X3
- BADOVF SX6 B2 *X6= JBAD = JLOOP
- BX7 X4
- JP STORE
- BADVAL DATA 17740177000B
- OVFVAL DATA 17740000000B
- END
-#ifdef CERNLIB_TCGEN_IE3FOS
-#undef CERNLIB_TCGEN_IE3FOS
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/ie3tod.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/ie3tod.s
deleted file mode 100644
index 51cebee..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/ie3tod.s
+++ /dev/null
@@ -1,113 +0,0 @@
-*
-* $Id: ie3tod.s,v 1.1.1.1 1996/02/15 17:51:20 mclareni Exp $
-*
-* $Log: ie3tod.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:20 mclareni
-* Kernlib
-*
-*
- IDENT IE3TOD
-*
-* CERN PROGLIB# M220 IE3TOD .VERSION KERNCDC 2.17 861204
-*
- ENTRY IE3TOD
-*
-* CALL IE3TOD (TAKE, PUT, NDP, JBAD)
-
-* CONVERT 'TAKE' OF NW=2*NDP WORDS CONTAINING
-* 'NDP' DOUBLE-PRECISION NUMBERS IN IEEE REPRESENTATION, EACH
-* 32 BITS RIGHT JUSTIFIED, TO 'PUT' AS CDC D.P. NUMBERS
-* RETURN IN 'JBAD' THE POSITION OF LAST CONVERSION PROBLEM
-*
-* REGISTER ASSIGNMENTS
-*
-* X1 current word LH B1 adr(PUT(0))
-* X2 next word pre-loaded B2 JLOOP = 1,2,3,...
-* X3 sign-bit B3 NW
-* X4 current word RH
-*
-* X6 result LH -> PUT B6 adr(JBAD)
-* X7 result RH -> PUT B7 =1
-*
- VFD 36/6HIE3TOD,24/IE3TOD
- IE3TOD DATA 0
- SB7 1 *B7= 1
-* X1= adr(TAKE(1))
- SA2 A1+B7 X2= adr(PUT(1))
- SA3 A2+B7 X3= adr(NDP)
- SA4 A3+B7 X4= adr(JBAD)
-*
- SB6 -B7
- MX6 0
- SB1 X2+B6 *B1= adr(PUT(0))
- SB2 B0 *B2= JLOOP = 0
- SA2 X1 X2= TAKE(1) pre-loaded
- SA3 X3 X3= NDP
- SA6 X4 preset JBAD = 0
- LX3 1 X3= 2*NDP
- SB6 X4 *B6= adr(JBAD)
- SB3 X3 *B3= NW = 2*NDP
-*
- LOOP BX1 X2 X1= AL = TAKE(JLOOP)
- SA4 A2+B7 *X4= AR = TAKE(JLOOP+1)
- SB2 B2+B7 *B2= bump JLOOP by 1
- SA2 A4+B7 *X2= TAKE(JLOOP+2) preloaded
- MX6 0 *X6= 0 in case A=0
- MX7 0 *X7= 0 in case A=0
- ZR X0,STORE test AL = 0
-*
- MX5 40
- BX5 -X5*X1 *X5= IEEE LH mantissa, 20 bits
- LX1 28
- MX3 1
- BX3 X3*X1 X3= sign-bit, left justfied
- AX3 60 *X3= all zero / all one if -ve
- LX1 12
- MX0 49
- BX1 -X0*X1 *X1= IEEE characteristic, right justif.
- SB4 X1-2047 B4= char'stic - 2047
- EQ B4,B0,BAD
- SB5 -1022
- SB4 X1-1070 B4= CDC exp = IEEE ch - 1023 - 47
- LT B4,B5,STORE underflow
-*
- LX5 27 X5= CDC Lmant from IEEE Lh, 20 bits
- LX4 55
- MX0 33
- BX0 -X0*X4 X0= CDC Lmant from IEEE Rh, 27 bis
- BX5 X5+X0 *X5= CDC Lmant, 47 bits
- MX0 5
- BX4 X0*X4
- LX4 48 *X4= CDC Rmant from IEEE Rh, 5 bits
- MX0 1 bring the hidden bit
- LX0 48
- BX5 X0+X5 *X5= CDC Lmant, 48 bits
- PX6 B4,X5
- SB4 B4-48
- PX7 B4,X4
- BX6 X3-X6
- BX7 X3-X7
- STORE SA6 B1+B2 store PUT(JLOOP)
- SA7 A6+B7 store PUT(JLOOP+1)
- SB2 B2+B7 *B2= bump JLOOP by 1 again
- LT B2,B3,LOOP
- JP IE3TOD
-*
-*-- indefinite / overflow
-*
- BAD ZR X5,OVF if mantissa zero
- SA4 BADVAL X4= IEEE indefinite
- JP BADOVF
- OVF SA4 OVFVAL X4= IEEE overflow
- BX4 X3-X4 add sign
- BADOVF SX6 B2+B7 X6= JBAD = JLOOP/2
- AX6 1
- SA6 B6
- BX6 X4
- JP STORE
- BADVAL DATA 17770000000000000000B
- OVFVAL DATA 37770000000000000000B
- END
-#ifdef CERNLIB_TCGEN_IE3TOD
-#undef CERNLIB_TCGEN_IE3TOD
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/ie3tos.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/ie3tos.s
deleted file mode 100644
index 99fa4e7..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/ie3tos.s
+++ /dev/null
@@ -1,102 +0,0 @@
-*
-* $Id: ie3tos.s,v 1.1.1.1 1996/02/15 17:51:20 mclareni Exp $
-*
-* $Log: ie3tos.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:20 mclareni
-* Kernlib
-*
-*
- IDENT IE3TOS
-*
-* CERN PROGLIB# M220 IE3TOS .VERSION KERNCDC 2.17 861204
-*
- ENTRY IE3TOS
-*
-* CALL IE3TOS (TAKE, PUT, NW, JBAD)
-
-* CONVERT 'TAKE' OF 'NW' IN IEEE REPRESENTATION, EACH 32 BITS
-* RIGHT JUSTIFIED, TO 'PUT' AS CDC FLOATING POINT NUMBERS
-* RETURN IN 'JBAD' THE POSITION OF LAST CONVERSION PROBLEM
-*
-* REGISTER ASSIGNMENTS
-*
-* X1 current word B1 adr(PUT(0))
-* X2 next word pre-loaded B2 JLOOP = 1,2,3,...
-* X3 sign-bit B3 NW
-*
-* X6 last JBAD saved B6 adr(JBAD)
-* X7 result -> PUT B7 =1
-*
- VFD 36/6HIE3TOS,24/IE3TOS
- IE3TOS DATA 0
- SB7 1 *B7= 1
-* X1= adr(TAKE(1))
- SA2 A1+B7 X2= adr(PUT(1))
- SA3 A2+B7 X3= adr(NW)
- SA4 A3+B7 X4= adr(JBAD)
-*
- SB6 -B7
- SB1 X2+B6 *B1= adr(PUT(0))
- SB2 B0 *B2= JLOOP = 0
- SA2 X1 X2= TAKE(1) pre-loaded
- SA3 X3 X3= NW
- SB6 X4 *B6= adr(JBAD)
- MX6 0 *X6= JBAD = 0
- SB3 X3 *B3= NW
-*
- LOOP BX1 X2 X1= A = TAKE(JLOOP)
- SB2 B2+B7 *B2= JLOOP
- SA2 A2+B7 *X2= TAKE(JLOOP+1) preloaded
- MX7 0 *X7= 0 in case A=0
- ZR X1,STORE test A=0
- MX5 37
- BX5 -X5*X1 *X5= IEEE mantissa
- LX1 28
- MX3 1
- BX3 X3*X1 X3= sign-bit, left justfied
- AX3 60 *X3= all zero / all one if -ve
- LX1 9
- MX4 52
- BX4 -X4*X1 *X4= IEEE characteristic, right justif.
- ZR X4,CHZERO
- SB4 X4-255 B4= char'stic - 255
- EQ B4,B0,BAD
-*
- MX0 1
- LX0 24 X0 bring the hidden bit
- BX5 X0+X5 X5= CDC mantissa, right justf.
- SB4 B4+105 B4= CDC exp = ch-127-23
- PX7 B4,X5 X7= result, not yet normalized
- NX7 X7 X7= result, absolute value
- BX7 X3-X7 X7= result, true value
- STORE SA7 B1+B2 store PUT(JLOOP)
- LT B2,B3,LOOP
- SA6 B6 store JBAD to ouput parameter
- JP IE3TOS
-*
-*-- denormalized output number
-*
-CHZERO SB4 -149 B4= CDC exp = -126 - 23
- PX7 B4,X5 X7= result, not yet normalized
- NX7 X7 X7= result, absolute value
- BX7 X3-X7 X7= result, true value
- JP STORE
-*
-*-- indefinite / overflow
-*
- BAD ZR X5,OVF if mantissa zero
- SA4 BADVAL X4= indefinite
- SX6 B2 *X6= JBAD = JLOOP
- BX7 X4
- JP STORE
-*
- OVF SA4 OVFVAL X4= overflow
- SX6 B2 *X6= JBAD = JLOOP
- BX7 X3-X4
- JP STORE
- BADVAL DATA 17770000000000000000B
- OVFVAL DATA 37770000000000000000B
- END
-#ifdef CERNLIB_TCGEN_IE3TOS
-#undef CERNLIB_TCGEN_IE3TOS
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/ifromc.F b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/ifromc.F
deleted file mode 100644
index 397a55c..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/ifromc.F
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: ifromc.F,v 1.1.1.1 1996/02/15 17:51:20 mclareni Exp $
-*
-* $Log: ifromc.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:20 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
-#if defined(CERNLIB_F77)
- FUNCTION IFROMC(CH)
-C
-C CERN PROGLIB# M431 IFROMC .VERSION KERNCDC 2.16 860514
-C ORIG. 10/02/86 M.METCALF
-C
-C TO CONVERT 1 TO 4 CHARACTERS TO A PACKED ASCII INTEGER FORM
-C CDC ONLY
-C
- CHARACTER*(*) CH
- PARAMETER (IBLANK = O"10020040")
- IFROMC = IBLANK
- LENCH = LEN(CH)
- DO 1 IC = 1, MIN(LENCH,4)
- CALL CHTOI(CH(IC:IC), IVAL, *999)
- IFROMC = SHIFT(IFROMC, 8) + IVAL
- 1 CONTINUE
- IF (LENCH.LT.4) IFROMC = ISHFTC(IFROMC, 8*(4-LENCH), 32)
- 999 END
-#ifdef CERNLIB_TCGEN_IFROMC
-#undef CERNLIB_TCGEN_IFROMC
-#endif
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/incbyt.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/incbyt.s
deleted file mode 100644
index 581ea87..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/incbyt.s
+++ /dev/null
@@ -1,69 +0,0 @@
-*
-* $Id: incbyt.s,v 1.1.1.1 1996/02/15 17:51:20 mclareni Exp $
-*
-* $Log: incbyt.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:20 mclareni
-* Kernlib
-*
-*
- IDENT INCBYT
-*
-* CERN PROGLIB# M423 INCBYT .VERSION KERNCDC 0.1 730801
-*
- ENTRY INCBYT
-*
-* FUNCTION INCBYT(INC,A,J,NBITS)
-*
-* ROUTINE WRITTEN BY P. CROZIER FOR FTN
-*
- VFD 36/6HINCBYT,24/INCBYT
- INCBYT DATA 0
- SB7 -1
- SA2 A1-B7 X2= ADR(A)
- SA3 A2-B7 X3= ADR(J)
- SA4 A3-B7 X4= ADR(NBITS)
- SB6 B0-B7 B6= 1
- SA3 X3 X3= J
- SA5 X4+B6 X5= INWORD
- SX3 X3+B7 X3= J-1
- PX5 X5 PACK INWORD INTO X5
- PX7 X3 PACK J-1 INTO X7
- NX6 X5 NORMALISE INWORD
- FX6 X7/X6 X6= JW-1
- SA4 X4 XJ= NBITS
- MX0 1 MASK STARTED
- SB4 X4+B7 B4= NBITS-1
- PX4 X4 PACK NBITS INTO X4
- AX0 B4,X0 MASK TO LEFT
- SB2 X2 B2= ADR(A)
- SB4 B4-B7 B4= NBITS
- UX6 B5,X6 UNPACK JW-1
- LX6 B5,X6 UNNORMALISE
- PX3 X6 PACK JW-1
- DX3 X3*X5 X3= J-JW
- SA1 X1 X1= INC
- SB2 X6+B2 B2= ADR(JWORD)
- FX3 X7-X3 X3= JB-1
- DX6 X3*X4 X6= L-1
- SA5 A5-B7 X5= MAX
- SA2 B2 X2= JWORD
- LX0 B4,X0 MASK TO RIGHT
- SB3 X6-60 B3= -(61-L)
- SB4 X6 B4= L-1
- AX2 B3,X2 SHIFT JWORD TO RIGHT
- BX6 X2*X0 MASK OUT NON BYTE IN JWORD
- IX1 X1+X6 X1= BYTE+INC
- IX6 X1-X5 X6= NEW BYTE - MAX
- BX3 X6 X3= X6
- AX3 59 X3= +0 IF X3.GT.MAX
- BX6 -X3*X6 X6= OVERFLOW
- BX7 -X0*X2 MASK BYTE IN JWORD
- IX1 X1-X6 X1= SUM-OVERFLOW
- BX3 X7+X1 X3= RESULT (SHIFTED)
- LX7 B4,X3 SHIFT TO L
- SA7 B2 RESTORE RESULT
- EQ INCBYT
- END
-#ifdef CERNLIB_TCGEN_INCBYT
-#undef CERNLIB_TCGEN_INCBYT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/intarg.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/intarg.s
deleted file mode 100644
index 1c2ef89..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/intarg.s
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: intarg.s,v 1.1.1.1 1996/02/15 17:51:20 mclareni Exp $
-*
-* $Log: intarg.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:20 mclareni
-* Kernlib
-*
-*
- IDENT INTARG
-*
-* CERN PROGLIB# M250 INTARG .VERSION KERNCDC 1.13 820111
-*
- ENTRY INTARG
-* FUNCTION INTARG(A)
- INTARG CON 0
- SA2 X1 .X2=A
- SB2 12
- MX0 1
- BX3 X2*X0 .X3=BIT 59 DE A
- SB1 48
- LX4 X0,B1
- BX5 X4*X2 .X5=BIT 47 DE A
- LX5 X5,B2
- IX6 X3-X5
- ZR X6,EXIT
- UX3 X2,B2
- LX2 X3,B2
- EXIT BX6 X2
- EQ INTARG
- END
-#ifdef CERNLIB_TCGEN_INTARG
-#undef CERNLIB_TCGEN_INTARG
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/intsor.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/intsor.s
deleted file mode 100644
index 68ed008..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/intsor.s
+++ /dev/null
@@ -1,138 +0,0 @@
-*
-* $Id: intsor.s,v 1.1.1.1 1996/02/15 17:51:21 mclareni Exp $
-*
-* $Log: intsor.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:21 mclareni
-* Kernlib
-*
-*
- IDENT INTSOR
-*
-* CERN PROGLIB# M103 INTSOR .VERSION KERNCDC 1.05 780503
-*
- ENTRY INTSOR
-*
-* SUBROUTINE INTSOR(IA,N)
-*
-* THIS SUBROUTINE SORTS INTEGER NUMBERS
-* IT SORTS AN ARRAY INTO ITSELF
-* THE CALLING SEQUENCE IS * CALL INTSOR ( IARRAY,NUMBER )
-*
-* PROGRAM M103 TAKEN FROM CERN PROGRAM LIBRARY, 29-APR-78
-*
-* NOTE
-* ----
-*
-* THE INTEGER NUMBERS MUST BE IN THE RANGE
-*
-* 0 .LE. ABS ( NUMBER ) .LE. ( 2 ** 59 ) - 1
-*
-* TO AVOID OVERFLOW CONDITIONS WHEN COMPARING NUMBERS
-* WITH DIFFERENT SIGN
-*
- USE /SLATE/
- BSS 10
- STACK BSS 30
- USE
-*
- VFD 36/0HINTSOR,24/INTSOR
-INTSOR EQ *+1S17 EXIT/ENTRY LINE
- SB1 1 ALWAYS 1
- SA2 A1+B1
- SB7 B0-B1 STACK POINTER. EMPTY STACK
- SA3 X2 LOAD NUMBER OF ELEMENTS
- SX4 X1+B7 START OF ARRAY - 1
- IX5 X4+X3 ADDRESS OF LAST ELEMENT
- LX1 20
- BX1 X1+X5 FIRST AND LAST ELEMENT
- SB3 X3+B7 NUMBER OF ELEMENTS -1
- GE B0,B3,INTSOR LESS THAN TWO ELEMENTS
-SPLIT SB4 X1 UPPER BOUNDARY
- AX1 20
- SB2 X1 LOWER BOUNDARY
- SX0 B2+B4
- SA2 B2 LOAD LOWER ELEMENT
- SA4 B4 LOAD UPPER ELEMENT
- AX0 1 ADDRESS OF CENTER ELEMENT
- IX5 X4-X2
- SB3 B3-B1 REDUCE NUMBER OF ELEMENTS
- BX6 X2 X6 CONTAINS SMALLEST ELEMENT
- SA3 X0 LOAD EVENTUAL CENTER ELEMENT
- LX7 X4 X7 CONTAINS LARGEST ELEMENT
- PL X5,L1 IF UPPER .GT. LOWER
- BX6 X4 SWAP THEM
- LX7 X2,B0
-L1 IX5 X7-X3
- ZR B3,L4 MORE THAN TWO ELEMENTS?
- BX4 X7 ALLOW FOR A SWAP
- PL X5,L2 IF UPPER .GT. CENTER
- BX7 X3 SWAP THEM
- LX3 X4,B0
-L2 IX5 X3-X6 MIGHT BE UNNECESSARY
- BX4 X6 X4 CONTAINS ASSUMED LOWEST
- LX6 X3,B0 X6 CONTAINS ASSUMED CENTER
- SB3 B3-B1 REDUCE NUMBER AGIN
- PL X5,L3 IF CENTER .GT. LOWER
- BX6 X4 SWAP THEM
- LX4 X3
-L3 SA6 A3 STORE CENTER
- SB5 B4 SET RUNNING POINTER IN UPPER
- LX3 X6 KEEP CENTER VALUE IN X3
- BX6 X4
-L4 SA6 A2 STORE LOWER
- SA7 A4 STORE UPPER
- ZR B3,NEXT INTERVAL IS SORTED
- SB3 B2 RUNNING POINTER IN LOWER
-UPPER SB5 B5-B1 REDUCE POINTER
- SA4 B5 LOAD ELEMENT
- IX0 X4-X3 COMPARE AGINST SPLITTING ELEMENT
- BX6 X4 PREPARE A SWAP
- EQ B3,B5,SPLITED INTERVAL IS SPLITTED
- PL X0,UPPER
-LOWER SB3 B3+B1 INCREMENT POINTER
- SA2 B3 LOAD ELEMENT
- IX0 X3-X2 COMPARE AGAINST SPLITTING ELEMENT
- BX7 X2 PREPARE A SWAP
- EQ B3,B5,SPLITED
- PL X0,LOWER
- SA6 A2 SWAP ELEMENTS
- SA7 A4
- EQ UPPER
-SPLITED SX1 B2 LOWER BOUNDARY IN LOWER INTERVAL
- SX2 B3 UPPER BOUNDARY IN LOWER INTERVAL
- SB5 B5+B1
- LX1 20
- SX3 B5 LOWER BOUNDARY IN UPPER INTERVAL
- SX4 B4 UPPER BOUNDARY IN UPPER INTERVAL
- BX1 X1+X2 ASSUME LOWER IS SMALLER
- LX3 20
- BX6 X3+X4 ASSUME UPPER IS LARGER
- SB3 B3-B2 # OF LEMENTS - 1 IN LOWER
- SB4 B4-B5 # OF ELEMNTS - 1 IN UPPER
- LX5 X6,B0 PREPARE A SWAP
- SX0 B4
- GE B4,B3,L5
- BX6 X1 SWAP THEM
- LX1 X5,B0
- SB2 B3
- SB3 X0
- SX0 B2
-L5 NZ B3,STOR MORE THAN ONE ELEMENT IN SMALLER?
- BX1 X6 NO, SMALLER IS SORTED
- SB3 X0
- EQ SPLIT
-STOR LX6 20
- BX7 X6+X0
- SB7 B7+B1 INCREMENT STACK POINTER
- SA7 STACK+B7 STORE INTERVAL
- EQ SPLIT
-NEXT SA1 STACK+B7 LOAD NEXT INTERVAL
- NG B7,INTSOR STACK IS EMPTY, ALL DONE
- SB7 B7-B1 DECREMENT STACK POINTER
- SB3 X1 NUMBER OF ELEMENTS - 1
- AX1 20
- EQ SPLIT
- END
-#ifdef CERNLIB_TCGEN_INTSOR
-#undef CERNLIB_TCGEN_INTSOR
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/ishft.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/ishft.s
deleted file mode 100644
index 9cb3a7b..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/ishft.s
+++ /dev/null
@@ -1,55 +0,0 @@
-*
-* $Id: ishft.s,v 1.1.1.1 1996/02/15 17:51:21 mclareni Exp $
-*
-* $Log: ishft.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:21 mclareni
-* Kernlib
-*
-*
- IDENT ISHFT
-*
-* CERN PROGLIB# M441 ISHFT .VERSION KERNCDC 2.18 870602
-* ORIG. ?
-*
-* FUNCTION ISHFT(I,K)
-*
-* COMPASS VERSION OF ANSI/ISA FUNCTION ISHFT
-* I IS AN INTEGER VARIABLE IN THE CALLING SEQUENCE
-* K IS THE SHIFT COUNT - NEGATIVE TO THE RIGHT
-* POSITIVE TO THE LEFT
-*
- ENTRY ISHFT
- VFD 30/5HISHFT,30/ISHFT
- ISHFT DATA 0
- SA2 A1+1
- SA2 X2
- SA1 X1
- ZR X2,ZERO .TEST ON ZERO SHIFT
- SX5 60
- IX5 X2-X5
- NZ X5,NE60 .TEST FOR 60 SHIFT
- SX6 B0
- EQ B0,B0,ISHFT
-NE60 MX3 1
- NG X2,NEG .TEST FOR NEGATIVE SHIFT
- SB2 X2
- LX1 B2,X1
- SB4 59
- SB4 B4-B2
- AX3 B4,X3 .FORM MASK
- BX6 X1*X3
- EQ B0,B0,ISHFT
-NEG SB4 X2
- SB2 -B4
- AX1 B2,X1
- SB4 B2-1
- AX3 B4,X3 .FORM MASK
- BX6 -X3*X1
- EQ B0,B0,ISHFT
- ZERO BX6 X1
- EQ B0,B0,ISHFT
-*
- END
-#ifdef CERNLIB_TCGEN_ISHFT
-#undef CERNLIB_TCGEN_ISHFT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/ishftc.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/ishftc.s
deleted file mode 100644
index 85e981b..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/ishftc.s
+++ /dev/null
@@ -1,77 +0,0 @@
-*
-* $Id: ishftc.s,v 1.1.1.1 1996/02/15 17:51:21 mclareni Exp $
-*
-* $Log: ishftc.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:21 mclareni
-* Kernlib
-*
-*
- IDENT ISHFTC
-*
-* CERN PROGLIB# M441 ISHFTC .VERSION KERNCDC 2.18 870602
-* ORIG. ?
-*
-* FUNCTION ISHFTC(I,K,L)
-*
-* COMPASS VERSION OF MIL-STD-1753 ISHFTC FUNCTION
-* I IS AN INTEGER VARIABLE IN THE CALLING SEQUENCE
-* K IS THE SHIFT COUNT - NEGATIVE TO THE RIGHT
-* POSITIVE TO THE LEFT
-* L IS THE NUMBER OF THE RIGHTMOST BITS TO BE SHIFTED, ALL
-* OTHER BITS ARE LEFT UNCHANGED
-*
- ENTRY ISHFTC
- VFD 36/6HISHFTC,24/ISHFTC
- ISHFTC DATA 0
- SA2 A1+1
- SA3 A2+1
- SA2 X2
- SA1 X1
- ZR X2,ZERO .TEST ON ZERO SHIFT
- SB1 1
- MX4 1
- SA3 X3
- SB3 X3
- SB2 X2
- SX5 B3-B2
- ZR X5,ZERO .TEST ON SHIFT SAME AS FIELD
- SX5 60
- IX5 X5-X3
- NG X2,NEG .TEST FOR NEGATIVE SHIFT
- NZ X5,NE60 .TEST FOR 60 FIELD
- LX6 B2,X1
- EQ B0,B0,ISHFTC
-* SWAP K BITS WITH L-K BITS IN L RIGHTMOST FIELD,
-* RETAINING UPPER 60-L BITS
- NE60 SB4 X5
- SB4 B4-B1
- AX4 B4,X4
- BX6 X4*X1 .UNCHANGED PART
- JUMP MX4 1
- SB4 B2-B1
- AX4 B4,X4
- LX4 B3,X4
- BX5 X4*X1
- SB5 B3-B2 .L-K
- AX5 B5,X5
- BX6 X6+X5 .THE K BITS
- MX4 1
- SB7 B5-B1
- AX4 B7,X4
- LX4 B5,X4
- BX5 X4*X1
- LX5 B2,X5
- BX6 X6+X5 .THE L-K BITS
- EQ B0,B0,ISHFTC
-* END OF SWAP
- NEG SB2 B3+B2 . L-ABS(K)
- SX6 B0
- ZR X5,JUMP .TEST FOR 60 FIELD
- EQ B0,B0,NE60
- ZERO BX6 X1
- EQ B0,B0,ISHFTC
-*
- END
-#ifdef CERNLIB_TCGEN_ISHFTC
-#undef CERNLIB_TCGEN_ISHFTC
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/iuback.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/iuback.s
deleted file mode 100644
index 9fcb969..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/iuback.s
+++ /dev/null
@@ -1,78 +0,0 @@
-*
-* $Id: iuback.s,v 1.1.1.1 1996/02/15 17:51:21 mclareni Exp $
-*
-* $Log: iuback.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:21 mclareni
-* Kernlib
-*
-*
- IDENT IUBACK
-*
-* CERN PROGLIB# M410 IUBACK .VERSION KERNCDC 1.06 780614
-*
- ENTRY IUBACK
-*
-* NVAL = IUBACK (CH,JL,JR)
-* COMPASS VERSION MAY 1978, JZ
-*
-* REGISTER ASSIGNMENTS
-*
-* X0 MASK 7700-00
-* X1 CH(J) B1 JN = J-1
-* X2 CH(J-1) AHEAD B2 JL
-* X3 FACTOR OF 10 B3 = -27 = DC FOR ZERO (DISPLAY CODE)
-* X4 = 10 B4 DC FOR CH(J) - 27
-* X5 NVAL CUMULATION B5 = 18 = DC FOR BLANK - 27
-* X6 DIGITS READ B6 = 10 = DC FOR PLUS - 27
-* B7 = 1
-*
- USE /SLATE/
- NDIGIT BSS 1
- JEND BSS 39
- USE
-*
- VFD 36/6HIUBACK,24/IUBACK
- IUBACK BSSZ 1 X1= ADR(CH)
- SB7 1
- SA2 A1+B7 X2= ADR(JL)
- SA3 A2+B7 X3= ADR(JR)
- MX0 6
- SB3 -27
- MX5 0
- SA2 X2 X2= JL
- SA3 X3 X3= JR
- SB5 18
- SB6 10
- MX6 0
- SX4 B6 X4= 10
- SB1 X3 B1= JN = JR
- SB2 X2 B2= JL
- SB4 B1-B7
- SA2 X1+B4 X2= CH(JN) = CH(JR)
- SX3 B7 X3= FACTOR = 1 INIT
- LT B1,B2,BLANK
-*
- LOOP BX1 X0*X2 X1= CH(J)
- SA2 A2-B7 X2= CH(JN) READ AHEAD
- SB1 B1-B7 B1= JN = J-1
- LX1 6
- SB4 X1+B3 B4= DC - 27
- LT B4,B0,END --> DC .LT. 27
- EQ B4,B5,BLANK --> DC .EQ. 45
- GE B4,B6,END --> DC .GE. 37
- SX1 B4
- DX1 X1*X3 X1= VAL*FACTOR
- SX6 X6+B7
- IX5 X1+X5 X5= SUM = SUM + VAL*FACT
- DX3 X3*X4 X3= FACT = FACT * 10
- BLANK GE B1,B2,LOOP
- SB1 B1-B7 JN = JN - 1
- END SA6 NDIGIT STORE NUMBER OF DIGITS READ
- SX7 B1+B7 JEND = J = JN+1
- SA7 A6+B7 STORE JEND
- BX6 X5
- EQ IUBACK
- END
-#ifdef CERNLIB_TCGEN_IUBACK
-#undef CERNLIB_TCGEN_IUBACK
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/iubin.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/iubin.s
deleted file mode 100644
index d4d97ab..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/iubin.s
+++ /dev/null
@@ -1,60 +0,0 @@
-*
-* $Id: iubin.s,v 1.1.1.1 1996/02/15 17:51:21 mclareni Exp $
-*
-* $Log: iubin.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:21 mclareni
-* Kernlib
-*
-*
- IDENT IUBIN
-*
-* CERN PROGLIB# Y202 IUBIN .VERSION KERNCDC 1.04 780211
-*
-* FUNCTION IUBIN(X,PAR,SPILL)
-* PAR(1)=NX, PAR(2)=DX, PAR(3)=XL
-*
-* PROGRAM P.RASTL, JULY 1971
-*
- ENTRY IUBIN
- VFD 30/5HIUBIN,30/IUBIN
- IUBIN BSS 1
- SA4 X1 X4= X
- SB7 1 B7= 1
- SA2 A1+B7 X2= ADR(PAR)
- SA5 A2+B7 X5= ADR(SPILL)
- SX0 17204B
- SA2 X2+B7 X2= DX = PAR(2)
- SA3 A2+B7 X3= XL = PAR(3)
- SA1 A2-B7 X1= NX = PAR(1)
- LX0 45 X0= 1.0
- RX2 X0/X2 X2= 1./DX
- RX4 X4-X3 X4= X - XL
- SB3 X5 B3= ADR(SPILL)
- SX7 16744B
- NX5 X4 X5= (X-XL) NORMALIZED
- RX6 X2*X5 X6= (X-XL)/DX
- LX7 45 X7= .000001 APPROX.
- RX2 X6+X7 X2= BINZ = (X-XL)/DX + .000001
- SX1 X1+B7 X1= NX+1
- UX3 B1,X2 X3= JBIN * 2**-B1 WITH B1 -VE NORMALLY
- SX5 B7 X5= 1
- AX2 59 X2= 0--0 IF BINZ +VE / 7--7 IF -VE
-+GEB1,B0,*+1SKIPIFBINZENORMOUS
- LX6 B1,X3 X6= INTG(BINZ)
- IX3 X6+X5 X3= JBIN = BINZ + 1
- BX6 -X2*X3 X6= JBIN = MAX0 (0,JBIN)
- MX0 59 X0= MASK FOR .TRUE. = 7--76
- IX7 X6-X1
- BX3 X7 X3= JBIN - (NX+1)
- AX7 59 X7= 7--7 IF JBIN.LT.NX+1 / 0--0 .GE.NX+1
- BX6 X7*X3 X6= MIN0 (JBIN-NX-1,0)
- BX7 -X7+X2 X7= 0--0 JBIN.LT.NX+1 / 7--7 .GE. NX+1
-* + 7--7 -VE BINZ / 0--0 +VE BINZ
- IX6 X6+X1 X6= JBIN = MIN0 (JBIN,NX+1)
- BX7 X0*X7 X7= SPILL
- SA7 B3
- EQ IUBIN
- END
-#ifdef CERNLIB_TCGEN_IUBIN
-#undef CERNLIB_TCGEN_IUBIN
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/iuchan.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/iuchan.s
deleted file mode 100644
index 9068031..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/iuchan.s
+++ /dev/null
@@ -1,54 +0,0 @@
-*
-* $Id: iuchan.s,v 1.1.1.1 1996/02/15 17:51:21 mclareni Exp $
-*
-* $Log: iuchan.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:21 mclareni
-* Kernlib
-*
-*
- IDENT IUCHAN
-*
-* CERN PROGLIB# Y201 IUCHAN .VERSION KERNCDC 1.04 780211
-*
-* FUNCTION IUCHAN(X,XL,DX,NX)
-*
-* PROGRAM P.RASTL, JULY 1971
-*
- ENTRY IUCHAN
- VFD 36/6HIUCHAN,24/IUCHAN
- IUCHAN BSS 1
- SA4 X1 X4= X
- SB7 1 B7= 1
- SA3 A1+B7 X3= ADR(XL)
- SA2 A3+B7 X2= ADR(DX)
- SA1 A2+B7 X1= ADR(NX)
- SX0 17204B
- SA2 X2 X2= DX
- SA3 X3 X3= XL
- SA1 X1 X1= NX
- LX0 45 X0= 1.0
- RX2 X0/X2 X2= 1./DX
- RX4 X4-X3 X4= X - XL
- SX7 16744B
- NX5 X4 X5= (X-XL) NORMALIZED
- RX6 X2*X5 X6= (X-XL)/DX
- LX7 45 X7= .000001 APPROX.
- RX2 X6+X7 X2= BINZ = (X-XL)/DX + .000001
- SX1 X1+B7 X1= NX+1
- UX3 B1,X2 X3= JBIN * 2**-B1 WITH B1 -VE NORMALLY
- SX5 B7 X5= 1
- AX2 59 X2= 0--0 IF BINZ +VE / 7--7 IF -VE
-+GEB1,B0,*+1SKIPIFBINZENORMOUS
- LX6 B1,X3 X6= INTG(BINZ)
- IX3 X6+X5 X3= JBIN = BINZ + 1
- BX6 -X2*X3 X6= JBIN = MAX0 (0,JBIN)
- IX7 X6-X1
- BX3 X7 X3= JBIN - (NX+1)
- AX7 59 X7= 7--7 IF JBIN.LT.NX+1 / 0--0 .GE.NX+1
- BX6 X7*X3 X6= MIN0 (JBIN-NX-1,0)
- IX6 X6+X1 X6= JBIN = MIN0 (JBIN,NX+1)
- EQ IUCHAN
- END
-#ifdef CERNLIB_TCGEN_IUCHAN
-#undef CERNLIB_TCGEN_IUCHAN
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/iucomp.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/iucomp.s
deleted file mode 100644
index eb34ac5..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/iucomp.s
+++ /dev/null
@@ -1,40 +0,0 @@
-*
-* $Id: iucomp.s,v 1.1.1.1 1996/02/15 17:51:21 mclareni Exp $
-*
-* $Log: iucomp.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:21 mclareni
-* Kernlib
-*
-*
- IDENT IUCOMP
-*
-* CERN PROGLIB# V304 IUCOMP .VERSION KERNCDC 0.1 750820
-*
- ENTRY IUCOMP
-* FUNCTION IUCOMP (ITEXT,IVECT,N)
-* (WRITTEN FOR SCOPE 3.3 - FTN)
- VFD 36/6HIUCOMP,24/IUCOMP
- IUCOMP BSS 1
- SA3 A1+2
- SA2 A1+1
- SA4 X3 X4= N
- MX6 0
- SB6 1 B6= 1
- SA5 X1 X5= ITEXT
- SA3 X2 FIRST ITEM OF IVECT IN X3
- ZR X4,IUCOMP
- IX1 X3-X5 PRE-COMPARE
- SX6 B6 X6= 1
- SB4 X4 B4= N
- LOOP SA3 A3+B6 NEXT ITEM IN X3
- SB4 B4-B6
- ZR X1,IUCOMP ITEM FOUND
- IX1 X3-X5
- SX6 X6+B6 X6= INDEX OF JUST CHECKED
- LT B0,B4,LOOP
- MX6 0 NOT FOUND
- EQ IUCOMP
- END
-#ifdef CERNLIB_TCGEN_IUCOMP
-#undef CERNLIB_TCGEN_IUCOMP
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/iufind.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/iufind.s
deleted file mode 100644
index 610c056..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/iufind.s
+++ /dev/null
@@ -1,44 +0,0 @@
-*
-* $Id: iufind.s,v 1.1.1.1 1996/02/15 17:51:21 mclareni Exp $
-*
-* $Log: iufind.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:21 mclareni
-* Kernlib
-*
-*
- IDENT IUFIND
-*
-* CERN PROGLIB# V304 IUFIND .VERSION KERNCDC 0.1 730801
-*
-* FUNCTION IUFIND(IT,IVEC,JL,JR)
-*
-* ROUTINE WRITTEN BY P. CROZIER FOR FTN
-*
- ENTRY IUFIND
- VFD 36/6HIUFIND,24/IUFIND
- IUFIND DATA 0
- SB7 -1 B7= -1
- SA2 A1-B7
- SA3 A2-B7
- SA4 A3-B7
- SB2 X2
- SA3 X3 X3= JL
- SA4 X4 X4= JR
- SB3 B2+B7
- SA1 X1 X1= IT
- SB6 X3+B3 B6= LOC OF ELEMENT JL
- SB5 X4+B3 B5= MAX ALLOWED ADDRESS
- LOOP SA2 B6 X2= IVEC(I)
- NO
- SB6 B6-B7 INCREMENT INDEX I
- BX0 X1-X2 X0= 0 IF IT = IVEC(I)
- ZR X0,OUTLET JUMP IF EQUAL
- GE B5,B6,LOOP JUMP IF JR.GE.I
- SX6 B6-B3 RETURN JR+1
- EQ IUFIND
- OUTLET SX6 B6-B2 RETURN SUBSCRIPT I
- EQ IUFIND
- END
-#ifdef CERNLIB_TCGEN_IUFIND
-#undef CERNLIB_TCGEN_IUFIND
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/iuforw.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/iuforw.s
deleted file mode 100644
index 6c3d118..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/iuforw.s
+++ /dev/null
@@ -1,76 +0,0 @@
-*
-* $Id: iuforw.s,v 1.1.1.1 1996/02/15 17:51:21 mclareni Exp $
-*
-* $Log: iuforw.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:21 mclareni
-* Kernlib
-*
-*
- IDENT IUFORW
-*
-* CERN PROGLIB# M410 IUFORW .VERSION KERNCDC 1.06 780614
-*
- ENTRY IUFORW
-*
-* NVAL = IUFORW (CH,JL,JR)
-* COMPASS VERSION MAY 1978, JZ
-*
-* REGISTER ASSIGNMENTS
-*
-* X0 MASK 7700-00
-* X1 CH(J) B1 J
-* X2 CH(J+1) AHEAD B2 JR
-* B3 = -27 = DC FOR ZERO (DISPLAY CODE)
-* X4 = 10 B4 DC FOR CH(J) - 27
-* X5 NVAL CUMULATION B5 = 18 = DC FOR BLANK - 27
-* X6 DIGITS READ B6 = 10 = DC FOR PLUS - 27
-* B7 = 1
-*
- USE /SLATE/
- NDIGIT BSS 1
- JEND BSS 39
- USE
-*
- VFD 36/6HIUFORW,24/IUFORW
- IUFORW BSSZ 1 X1= ADR(CH)
- SB7 1
- SA2 A1+B7 X2= ADR(JL)
- SA3 A2+B7 X3= ADR(JR)
- MX0 6
- SB3 -27
- MX5 0
- SA2 X2 X2= JL
- SA3 X3 X3= JR
- SB5 18
- SB6 10
- MX6 0
- SX4 B6 X4= 10
- SB1 X2 B1= JL
- SB2 X3 B2= JR
- SB1 B1-B7 B1= J = JL-1
- SA2 X1+B1 X2= CH(J+1) = CH(JL)
- GE B1,B2,BLANK
-*
- LOOP BX1 X0*X2 X1= CH(J)
- SA2 A2+B7 X2= CH(J+1) READ AHEAD
- SB1 B1+B7 B1= J
- LX1 6
- SB4 X1+B3 B4= DC - 27
- LT B4,B0,END --> DC .LT. 27
- EQ B4,B5,BLANK --> DC .EQ. 45
- GE B4,B6,END --> DC .GE. 37
- DX5 X4*X5
- SX1 B4
- SX6 X6+B7
- IX5 X1+X5
- BLANK LT B1,B2,LOOP
- SB1 B1+B7 J = J+1
- END SA6 NDIGIT STORE NUMBER OF DIGITS READ
- SX7 B1
- SA7 A6+B7 STORE JEND
- BX6 X5
- EQ IUFORW
- END
-#ifdef CERNLIB_TCGEN_IUFORW
-#undef CERNLIB_TCGEN_IUFORW
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/iuhist.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/iuhist.s
deleted file mode 100644
index d09e720..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/iuhist.s
+++ /dev/null
@@ -1,57 +0,0 @@
-*
-* $Id: iuhist.s,v 1.1.1.1 1996/02/15 17:51:21 mclareni Exp $
-*
-* $Log: iuhist.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:21 mclareni
-* Kernlib
-*
-*
- IDENT IUHIST
-*
-* CERN PROGLIB# Y203 IUHIST .VERSION KERNCDC 1.04 780211
-*
-* FUNCTION IUHIST(X,PAR,SPILL)
-* PAR(1)=NX, PAR(2)=1./DX, PAR(3)=XL
-*
-* PROGRAM P.RASTL, JULY 1971
-*
- ENTRY IUHIST
- VFD 36/6HIUHIST,24/IUHIST
- IUHIST BSS 1
- SA4 X1 X4= X
- SB7 1 B7= 1
- SA2 A1+B7 X2= ADR(PAR)
- SA5 A2+B7 X5= ADR(SPILL)
- SA2 X2+B7 X2= 1/DX = PAR(2)
- SA3 A2+B7 X3= XL = PAR(3)
- SA1 A2-B7 X1= NX = PAR(1)
- SX7 16744B
- RX4 X4-X3 X4= X - XL
- SB3 X5 B3= ADR(SPILL)
- NX5 X4 X5= (X-XL) NORMALIZED
- RX6 X2*X5 X6= (X-XL)/DX
- LX7 45 X7= .000001 APPROX.
- RX2 X6+X7 X2= BINZ = (X-XL)/DX + .000001
- SX1 X1+B7 X1= NX+1
- UX3 B1,X2 X3= JBIN * 2**-B1 WITH B1 -VE NORMALLY
- SX5 B7 X5= 1
- AX2 59 X2= 0--0 IF BINZ +VE / 7--7 IF -VE
-+GEB1,B0,*+1SKIPIFBINZENORMOUS
- LX6 B1,X3 X6= INTG(BINZ)
- IX3 X6+X5 X3= JBIN = BINZ + 1
- BX6 -X2*X3 X6= JBIN = MAX0 (0,JBIN)
- MX0 59 X0= MASK FOR .TRUE. = 7--76
- IX7 X6-X1
- BX3 X7 X3= JBIN - (NX+1)
- AX7 59 X7= 7--7 IF JBIN.LT.NX+1 / 0--0 .GE.NX+1
- BX6 X7*X3 X6= MIN0 (JBIN-NX-1,0)
- BX7 -X7+X2 X7= 0--0 JBIN.LT.NX+1 / 7--7 .GE. NX+1
-* + 7--7 -VE BINZ / 0--0 +VE BINZ
- IX6 X6+X1 X6= JBIN = MIN0 (JBIN,NX+1)
- BX7 X0*X7 X7= SPILL
- SA7 B3
- EQ IUHIST
- END
-#ifdef CERNLIB_TCGEN_IUHIST
-#undef CERNLIB_TCGEN_IUHIST
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/iuhunt.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/iuhunt.s
deleted file mode 100644
index acdd95e..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/iuhunt.s
+++ /dev/null
@@ -1,48 +0,0 @@
-*
-* $Id: iuhunt.s,v 1.1.1.1 1996/02/15 17:51:21 mclareni Exp $
-*
-* $Log: iuhunt.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:21 mclareni
-* Kernlib
-*
-*
- IDENT IUHUNT
-*
-* CERN PROGLIB# V304 IUHUNT .VERSION KERNCDC 0.1 760424
-*
- ENTRY IUHUNT
-* RE-WRITE FOR BUG-FIXING, JZ
-*
-* J = IUHUNT (IT,IVEC,NV,INC)
-*
- VFD 36/6HIUHUNT,24/IUHUNT
- FOUND SX6 B6+B7 X6= J = JL+1
- IUHUNT DATA 0
- SB7 1 B7= 1
- SA2 A1+B7
- SA3 A2+B7
- SA4 A3+B7
- SA1 X1 X1= IT
- SA2 X2 A2= ADR(IVECT(J))
- SA3 X3 X3= NV
- SA4 X4 X4= INC
- MX6 0 X6= J = ZERO
- SB6 X6 B6= (JL=J-1) = 0
- ZR X3,IUHUNT EXIT IF NV=0
- ZR X4,INCZER SPECIAL IF INC=0
- SB3 X3 B3= NV
- SB4 X4 B4= INC
- LOOP BX0 X2-X1 COMPAR IVEC(J) WITH IT
- ZR X0,FOUND
- SB6 B6+B4 B6= JL = JL+INC
- GE B6,B3,IUHUNT
- SA2 A2+B4 X2= IVEC(J)
- EQ LOOP
-*
- INCZER BX0 X2-X1
- ZR X0,FOUND IF IVEC(1)=IT
- EQ IUHUNT
- END
-#ifdef CERNLIB_TCGEN_IUHUNT
-#undef CERNLIB_TCGEN_IUHUNT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/iumode.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/iumode.s
deleted file mode 100644
index 3816887..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/iumode.s
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: iumode.s,v 1.1.1.1 1996/02/15 17:51:21 mclareni Exp $
-*
-* $Log: iumode.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:21 mclareni
-* Kernlib
-*
-*
- IDENT IUMODE
-*
-* CERN PROGLIB# M506 IUMODE .VERSION KERNCDC 1.10 790406
-*
- ENTRY IUMODE
-*
-* J= IUMODE(WORD) RETURNS ZERO IF INTEGER
-* 31-MARCH-79,FJ
-*
- VFD 36/6HIUMODE,24/IUMODE
-IUMODE DATA 0
- SA2 X1 X2= WORD
- AX2 48 X2= 49/SIGN , 11/EXP
- BX3 X2
- AX3 11 X3= 60/SIGN
- BX6 -X3*X2 X6= EXP IF +VE OR ZERO
- BX3 -X2*X3 X3= -EXP IF -VE OR ZERO
- BX6 X6+X3 X6= ABS(EXP)
- JP IUMODE
- END
-#ifdef CERNLIB_TCGEN_IUMODE
-#undef CERNLIB_TCGEN_IUMODE
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/iusame.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/iusame.s
deleted file mode 100644
index 77cacf4..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/iusame.s
+++ /dev/null
@@ -1,82 +0,0 @@
-*
-* $Id: iusame.s,v 1.1.1.1 1996/02/15 17:51:21 mclareni Exp $
-*
-* $Log: iusame.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:21 mclareni
-* Kernlib
-*
-*
- IDENT IUSAME
-*
-* CERN PROGLIB# M501 IUSAME .VERSION KERNCDC 0.1 760426
-*
- ENTRY IUSAME
-*
-* X0 MASK FULL / EXPONENT
-* X1 REFERENCE WORD B1 ADR (VECT(1))
-* X2 CURRENT WORD B2 J-1 / J OF CURRENT
-* X3 WORKING B3 JR
-* X4 MIN
-* X5 ADR(JASME) B5 JSAME
-* X6 = ZERO B6 JMIN = JSAME+MIN
-* B7 = 1
-* CURRENT: VECT(JFAIL) BEING COMPARED AGAINST VECT(JFAIL-1)
-*
-* NSAME = IUSAME (VECT,JL,JR,MIN,JSAME)
-*
- VFD 36/6HIUSAME,24/IUSAME
- IUSAME DATA 0
- SB7 1 *B7= 1
- SA2 A1+B7
- SA3 A2+B7
- SA4 A3+B7
- SA5 A4+B7 *X5= ADR(JSAME)
- SA2 X2 X2= JL LEFT
- SA3 X3 X3= JR RIGHT
- SA4 X4 *X4= MIN = MIN STRING LENGTH
- SB1 X1 *B1= ADR (VECT(1))
- SB2 X2 B2= JL = J-1 OF CURRENT, VECT(JL+1) INIT.
- SB3 X3 B3= JR
- SB6 B2+X4 B6= JL+MIN
- MX6 0 *X6= ZERO
- SB6 B6-B7
- SB6 B6-B7 B6= JL+MIN-2
- GE B6,B3,SHORT EXIT IF JL+MIN-2 .GE. JR
- SA2 B1+B2 X2= VECT(JL+1)
- SA1 A2-B7 X1= VECT(JL)
-*
- NEW SB5 B2 B5= JSAME = J OF FIRST WORD OF STRING
- SB6 B2+X4 B6= JMIN = JSAME+MIN
- OR X1,SPEC X1 OUT OF RANGE
- ID X1,SPEC X1 INDEFINITE
- MX0 60 X0= MASK FULL WORD
- LOOP BX3 X2-X1 X3= COMPARE
- SB2 B2+B7 B2= JFAIL, J OF CURRENT WORD
- BX1 X2 CURRENT WORD TO REFERENCE
- SA2 B1+B2 X2= VECT(J+1) NEXT WORD READY
- BX3 X0*X3 X3= COMPARE, SIGNIFICANT
- GE B2,B3,EXHAUST EXIT IF JFAIL .GE. JR
- ZR X3,LOOP
- LT B2,B6,NEW NO STRING IF JFAIL .LT. JSAME+MIN
- EQ FOUND
- SPEC MX0 12 X0= MASK EXPONENT ONLY
- EQ LOOP
-*
-* VECT (JL/JR) EXHAUSTED
-*
- EXHAUST BSS 0 JFAIL = JR
- NZ X3,NOTLAST
- SB2 B2+B7 JFAIL = JR+1
-NOTLAST GE B2,B6,FOUND STRING IF JFAIL .GE. JSAME+MIN
- SHORT SX7 B3+B7 JSAME = JR+1
- SA7 X5
- EQ IUSAME
-*
- FOUND SX7 B5 X7= JSAME
- SX6 B2-B5 X6= NSAME = JFAIL - JSAME
- SA7 X5 STORE JSAME
- EQ IUSAME
- END
-#ifdef CERNLIB_TCGEN_IUSAME
-#undef CERNLIB_TCGEN_IUSAME
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/jbit.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/jbit.s
deleted file mode 100644
index c678303..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/jbit.s
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: jbit.s,v 1.1.1.1 1996/02/15 17:51:21 mclareni Exp $
-*
-* $Log: jbit.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:21 mclareni
-* Kernlib
-*
-*
- IDENT JBIT
-*
-* CERN PROGLIB# M421 JBIT .VERSION KERNCDC 0.1 750820
-*
- ENTRY JBIT
-* FUNCTION JBIT (WORD,J)
-* (WRITTEN FOR SCOPE 3.3 - FTN)
- VFD 24/4HJBIT,36/JBIT
- JBIT BSS 1
- SA4 A1+1
- SX3 61
- SA2 X4 X2= J
- IX3 X3-X2
- SA1 X1 X1= WORD
- MX6 1
- LX6 1 SET MASK FOR LAST BIT
- SB3 X3 B3= X3= 61-J
- LX4 B3,X1
- BX6 X4*X6
- EQ JBIT
- END
-#ifdef CERNLIB_TCGEN_JBIT
-#undef CERNLIB_TCGEN_JBIT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/jbyt.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/jbyt.s
deleted file mode 100644
index d41193a..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/jbyt.s
+++ /dev/null
@@ -1,37 +0,0 @@
-*
-* $Id: jbyt.s,v 1.1.1.1 1996/02/15 17:51:22 mclareni Exp $
-*
-* $Log: jbyt.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:22 mclareni
-* Kernlib
-*
-*
- IDENT JBYT
-*
-* CERN PROGLIB# M421 JBYT .VERSION KERNCDC 0.1 750820
-*
- ENTRY JBYT
-* FUNCTION JBYT (WORD,J,NBITS)
-* (WRITTEN FOR SCOPE 3.3 - FTN)
- VFD 24/4HJBYT,36/JBYT
- JBYT BSS 1
- SA5 A1+2 X5= ADD OF NBITS
- SA2 A1+1 X2= ADD OF J
- SA3 X5 X3= NBITS
- MX6 1
- SX4 61
- SB6 X3-1
- SA2 X2 X2= J
- AX6 B6,X6
- SB3 X3 B3= NBITS
- SA1 X1 X1= WORD
- IX4 X4-X2
- LX6 B3,X6 X6= NBITS BITS ON THE RIGHT
- SB4 X4 B4= X4=61-J
- LX5 B4,X1
- BX6 X5*X6
- EQ JBYT
- END
-#ifdef CERNLIB_TCGEN_JBYT
-#undef CERNLIB_TCGEN_JBYT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/jbytet.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/jbytet.s
deleted file mode 100644
index 33e5004..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/jbytet.s
+++ /dev/null
@@ -1,43 +0,0 @@
-*
-* $Id: jbytet.s,v 1.1.1.1 1996/02/15 17:51:22 mclareni Exp $
-*
-* $Log: jbytet.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:22 mclareni
-* Kernlib
-*
-*
- IDENT JBYTET
-*
-* CERN PROGLIB# M421 JBYTET .VERSION KERNCDC 0.1 730801
-*
-* FUNCTION JBYTET(A,B,LB,NBITS)
-*
-* ROUTINE WRITTEN BY P. CROZIER FOR FTN
-*
- ENTRY JBYTET
- VFD 36/6HJBYTET,24/JBYTET
- JBYTET DATA 0
- SB7 -1 B7= -1
- SA2 A1-B7 X2= ADR(B)
- SA3 A2-B7 X3= ADR(LB)
- SA4 A3-B7 X4= ADR(NBITS)
- SA1 X1 X1= A
- SA2 X2 X2= B
- SA4 X4 X4= NBITS
- SA3 X3 X3= LB
- MX0 1 FORM MASK
- SB4 X4 B4= NBITS
- SB5 X4+B7 B5= NBITS-1
- AX0 B5,X0 MASK ON LEFT
- SB3 X3-61 B3= LB-61
- LX0 B4,X0 MASK ON RIGHT
- BX1 X0*X1 CLEAR NON BYTE IN A
- AX2 B3,X2 SHIFT BYTE IN B TO RIGHT
- NO
- NO
- BX6 X2*X1 STORE LOGICAL SUM OF BYTES
- EQ JBYTET
- END
-#ifdef CERNLIB_TCGEN_JBYTET
-#undef CERNLIB_TCGEN_JBYTET
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/jbytor.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/jbytor.s
deleted file mode 100644
index c10d650..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/jbytor.s
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: jbytor.s,v 1.1.1.1 1996/02/15 17:51:22 mclareni Exp $
-*
-* $Log: jbytor.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:22 mclareni
-* Kernlib
-*
-*
- IDENT JBYTOR
-*
-* CERN PROGLIB# M421 JBYTOR .VERSION KERNCDC 2.18 870602
-*
-* FUNCTION JBYTOR(A,B,LB,NBITS)
-*
-* ROUTINE DERIVED FROM JBYTET
-*
- ENTRY JBYTOR
- VFD 36/6HJBYTOR,24/JBYTOR
- JBYTOR DATA 0
- SB7 -1 B7= -1
- SA2 A1-B7 X2= ADR(B)
- SA3 A2-B7 X3= ADR(LB)
- SA4 A3-B7 X4= ADR(NBITS)
- SA1 X1 X1= A
- SA2 X2 X2= B
- SA4 X4 X4= NBITS
- SA3 X3 X3= LB
- MX0 1 FORM MASK
- SB4 X4 B4= NBITS
- SB5 X4+B7 B5= NBITS-1
- AX0 B5,X0 MASK ON LEFT
- SB3 X3-61 B3= LB-61
- LX0 B4,X0 MASK ON RIGHT
- AX2 B3,X2 SHIFT BYTE IN B TO RIGHT
- BX2 X0*X2 CLEAR NON BYTE
- BX6 X2+X1 STORE LOGICAL OR
- EQ JBYTOR
- END
-#ifdef CERNLIB_TCGEN_JBYTOR
-#undef CERNLIB_TCGEN_JBYTOR
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/jbytpk.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/jbytpk.s
deleted file mode 100644
index bceec0a..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/jbytpk.s
+++ /dev/null
@@ -1,58 +0,0 @@
-*
-* $Id: jbytpk.s,v 1.1.1.1 1996/02/15 17:51:22 mclareni Exp $
-*
-* $Log: jbytpk.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:22 mclareni
-* Kernlib
-*
-*
- IDENT JBYTPK
-*
-* CERN PROGLIB# M422 JBYTPK .VERSION KERNCDC 0.1 730801
-*
-* FUNCTION JBYTPK (A,J,NBITS)
-*
-* ROUTINE WRITTEN BY P. CROZIER FOR FTN
-*
- ENTRY JBYTPK
- VFD 36/6HJBYTPK,24/JBYTPK
- JBYTPK DATA 0
- SB7 -1 B7= -1
- SA2 A1-B7
- SA3 A2-B7
- SB6 -60 B6= -60
- SA4 X3+1 X4= INWORD
- SA3 X3 X3= NBITS
- SA2 X2 X2= J
- SB4 X3 B4= NBITS
- SX2 X2+B7 X2= J-1
- NE B0,B4,NODFLT JUMP IF NBITS NONZERO
- SX4 -B6 INWORD= 60
- SX3 -B7 X3= NBITS= 1
- NODFLT PX2 X2 PACK J-1 INTO X2
- PX4 X4 PACK INWORD INTO X4
- NX5 X4 NORMALISE INWORD INTO X5
- FX5 X2/X5 X5= (J-1)/INWORD= JW-1
- MX0 1 START MASK
- SB4 X3+B7 B4= NBITS-1
- PX3 X3 PACK NBITS INTO X3
- SB1 X1 B1= ADR(A)
- AX0 B4,X0 MASK ON LEFT
- UX5 B5,X5 UNPACK X5 INTO B5 AND X5
- LX5 B5,X5 UNNORMALISE X5 FOR JW-1
- PX6 X5 PACK JW-1 INTO X6
- DX6 X6*X4 X6= (JW-1)*INWORD
- SB4 B4-B7 B4= NBITS
- SB1 X5+B1 B1= ADR(JWORD)
- FX6 X2-X6 X6= JB-1
- DX6 X6*X3 X6= L-1
- SA1 B1 X1= JWORD
- LX0 B4,X0 MASK ON RIGHT
- SB6 X6+B6 B6= (L-1)-60
- AX1 B6,X1 SHIFT BYTE TO RIGHT
- BX6 X0*X1 MASK OUT NON BYTE
- EQ JBYTPK
- END
-#ifdef CERNLIB_TCGEN_JBYTPK
-#undef CERNLIB_TCGEN_JBYTPK
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/jrsbyt.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/jrsbyt.s
deleted file mode 100644
index a3b5a74..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/jrsbyt.s
+++ /dev/null
@@ -1,47 +0,0 @@
-*
-* $Id: jrsbyt.s,v 1.1.1.1 1996/02/15 17:51:22 mclareni Exp $
-*
-* $Log: jrsbyt.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:22 mclareni
-* Kernlib
-*
-*
- IDENT JRSBYT
-*
-* CERN PROGLIB# M421 JRSBYT .VERSION KERNCDC 0.1 730801
-*
-* FUNCTION JRSBYT(A,X,LX,NBITS)
-*
-* ROUTINE WRITTEN BY P. CROZIER FOR FTN
-*
- ENTRY JRSBYT
- VFD 36/6HJRSBYT,24/JRSBYT
- JRSBYT DATA 0
- SB7 -1 B7= -1
- SA2 A1-B7 X2= ADR(X)
- SA3 A2-B7 X3= ADR(LX)
- SA4 A3-B7 X4= ADR(NBITS)
- SA1 X1 X1= A
- SA2 X2 X2= X
- SA3 X3 X3= LX
- SA4 X4 X4= NBITS
- SB3 -61 B3= -61
- MX0 1
- SB5 X4+B7 B5= NBITS-1
- AX0 B5,X0 X0= MASK ON THE LRFT
- SB5 X3+B5 B5= LX+NBITS-1
- LX0 B5,X0 X0= MASK IN POSITION
- SB4 X3+B7 B4= LX-1
- BX6 X0*X2 X6= RESULT SHIFTED
- SB3 X3+B3 B3= LX-61
- LX1 B4,X1 X1= A POSITIONED
- BX1 X0*X1 CLEAR NON BYTE IN A
- BX2 -X0*X2 CLEAR BYTE IN X
- AX6 B3,X6 X6= RESULT JRSBYT
- BX7 X1+X2 X7= X, UPDATED
- SA7 A2 STORE RESULT X
- EQ JRSBYT
- END
-#ifdef CERNLIB_TCGEN_JRSBYT
-#undef CERNLIB_TCGEN_JRSBYT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/locbyt.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/locbyt.s
deleted file mode 100644
index a4ed571..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/locbyt.s
+++ /dev/null
@@ -1,62 +0,0 @@
-*
-* $Id: locbyt.s,v 1.1.1.1 1996/02/15 17:51:22 mclareni Exp $
-*
-* $Log: locbyt.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:22 mclareni
-* Kernlib
-*
-*
- IDENT LOCBYT
-*
-* CERN PROGLIB# M428 LOCBYT .VERSION KERNCDC 0.1 750820
-*
- ENTRY LOCBYT
-*
-* J = LOCBYT (IT,VECT,N,INC,L,NBITS)
- VFD 36/6HLOCBYT,24/LOCBYT
- LOCBYT DATA 0
- SB7 -1 B7= -1
- SA2 A1-B7 X2= ADR(VECT)
- SA3 A2-B7 X3= ADR(N)
- SB2 X2 B2= ADR(VECT)
- SA4 A3-B7 X4= ADR(INC)
- SA2 A4-B7 X2= ADR(L)
- SA5 A2-B7 X5= ADR(NBITS)
- SA4 X4 X4= INC
- SA5 X5 X5= NBITS
- SB4 X4 B4= INC
- SA4 X2 X4= L
- MX0 1
- SB6 X5+B7 B6= NBITS-1
- SB5 X5 B5= NBITS
- AX0 B6,X0 NBITS BITS CREATED
- SA1 X1 X1= IT
- SA3 X3 X3= N
- LX0 B5,X0 NBITS BITS JUSTIFIED
- SB5 X4+B7 B5= L-1
- LX0 B5,X0 X0= POSITIONED MASK OF NBITS BITS
- SA2 B2 A2= ADR OF FIRST WORD
- LX1 B5,X1 X1= POSITIONED IT
- ZR X3,NOPE N=0
- SB3 X3 B3= N
- SB5 B0 B5= 0
-* X0 MASK, POSITIONED
-* X1 IT, POSITIONED
-* A2 ADR CURRENT WORD
-* B3 N
-* B4 INC
-* B5 LOOP - 0, INC, 2*INC, ...
- LOOP BX4 X0*X2 MASK BYT
- SA2 A2+B4 READY NEXT WORD
- BX4 X1-X4
- ZR X4,FOUND
- SB5 B5+B4
- LT B5,B3,LOOP
- NOPE MX6 0 NOT FOUND
- EQ LOCBYT
- FOUND SX6 B5-B7
- EQ LOCBYT
- END
-#ifdef CERNLIB_TCGEN_LOCBYT
-#undef CERNLIB_TCGEN_LOCBYT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/loren4.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/loren4.s
deleted file mode 100644
index d7e3c43..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/loren4.s
+++ /dev/null
@@ -1,114 +0,0 @@
-*
-* $Id: loren4.s,v 1.1.1.1 1996/02/15 17:51:22 mclareni Exp $
-*
-* $Log: loren4.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:22 mclareni
-* Kernlib
-*
-*
- IDENT LOREN4 10-JUNE-68
-*
-* CERN PROGLIB# U101 LOREN4 .VERSION KERNCDC 0.1 750820
-*
- ENTRY LOREN4
-* SUBROUTINE LOREN4 (DIR,P4IN,P4OUT)
- NAME VFD 36/6HLOREN4,24/LOREN4
- LOREN4 BSS 1
- EXT SQRT
-*
- SB7 1 B7= 1
- SA2 A1+B7
- SB1 X1
- SA3 A2+B7
- SA1 B1
- BX7 X2
- RX0 X1*X1 X0= DIR(1)*DIR(1)
- SB2 X7
- BX6 X3
- SA2 A1+B7
- SB3 X6
- LX6 20
- RX1 X2*X2 X1= DIR(2)*DIR(2)
- SA3 A2+B7
- BX6 X6+X7
- SX7 B1
- RX2 X3*X3 X2= DIR(3)*DIR(3)
- LX6 20
- SA4 A3+B7
- RX5 X1+X0
- BX6 X6+X7
- NX5 B0,X5
- RX0 X4*X4 X0= DIR(4)*DIR(4)
- RX4 X5+X2
- SA6 B1B2B3 X6= B3-B2-B1
- NX7 B0,X4
- RX1 X0-X7
- SA7 PCM2 X7= PCM2
- NX6 B0,X1
- NO
- SA6 ARG
- SX7 A6
- SA7 ARGA
- MX6 0
- SA6 A7+B7
- SA1 ARGA
- + RJ SQRT
- - LT B0,B1,NAME
- SA2 B1B2B3
- SA1 =1.
- SA3 X2
- AX2 20
- RX0 X1/X6 X0= ONMCM
- SA4 X2
- SB7 1 B7= 1
- SA5 A3+B7
- RX7 X3*X4 X7= DIR(1)*P4IN(1)
- SA4 A4+B7
- AX2 20
- RX6 X5*X4 X6= DIR(2)*P4IN(2)
- SA3 A5+B7
- SB3 X2
- SA4 A4+B7
- RX7 X7+X6
- RX2 X3*X4 X2= DIR(3)*P4IN(3)
- SA5 PCM2
- SB4 3
- NX7 B0,X7
- SA3 A3+B7
- RX6 X2+X7
- SA4 A4+B7
- NX7 B0,X6 X7= EPBETA
- RX6 X3*X4 X6= DIR(4)*P4IN(4)
- RX3 X3*X0 X3= DIR(4)*ONMCM
- RX5 X7/X5 X5= EPBETA/PCM2
- RX7 X6-X7
- NX2 B0,X7
- RX4 X4*X0 X4= P4IN(4)*ONMCM
- RX6 X2*X0 X6= P4OUT(4)
- RX1 X3-X1
- NX0 B0,X1
- SA3 A3-B7
- RX2 X0*X5
- SA6 B3+B4 STORES P4OUT(4)
- RX1 X2-X4
- NX0 B0,X1 X0= PROD
-* LOOP IS TAKEN IN THE REVERSE ORDER
- LOOP RX5 X0*X3
- SA4 A4-B7
- RX7 X4+X5
- SA3 A3-B7
- NX6 B0,X7
- SB4 B4-B7
- NO
- SA6 A6-B7
- NE B4,B0,LOOP
- EQ LOREN4
-*
- ARG BSS 1
- PCM2 BSS 1
- B1B2B3 BSS 1
- ARGA BSS 2
- END
-#ifdef CERNLIB_TCGEN_LOREN4
-#undef CERNLIB_TCGEN_LOREN4
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/lorenb.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/lorenb.s
deleted file mode 100644
index 61ff9ee..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/lorenb.s
+++ /dev/null
@@ -1,92 +0,0 @@
-*
-* $Id: lorenb.s,v 1.1.1.1 1996/02/15 17:51:22 mclareni Exp $
-*
-* $Log: lorenb.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:22 mclareni
-* Kernlib
-*
-*
- IDENT LORENB
-*
-* CERN PROGLIB# U102 LORENB .VERSION KERNCDC 0.1 750820
-*
- ENTRY LORENB
-* CALL LORENB (U,PS,PI,PF)
-*
- VFD 36/6HLORENB,24/LORENB
- LORENB BSS 1
- SB7 1
- SA5 X1 X5= U
- SA2 A1+B7
- SB2 X2
- SA3 A2+B7
- SB6 3
- SB3 X3
- SA2 A3+B7
- SA4 B2+B6 X4= S4
- SB4 X2
- SA1 ONE FLOATING 1
- IX7 X4-X5 S4-U
- SA2 B3+B6 X2= I4
- ZR X7,CMS
-*
- FX0 X1/X5 X0= 1/U
- SA3 A4-B7 X3= S3
- FX6 X2*X4 X6= S4*I4
- FX5 X4+X5 X5= S4+U
- SA4 A2-B7 X4= I3
- NX5 X5
- SA2 A3-B7 X2= S2
- FX7 X3*X4 X7= S3*I3
- SA4 A4-B7 X4= I2
- FX6 X6+X7 SUM
- FX7 X2*X4 X7= S2*I2
- NX6 X6
- FX5 X1/X5 X5= 1/S4+U
- SA1 B2 X1= S1
- FX6 X6+X7 SUM
- SA4 B3 X4= I1
- FX7 X1*X4 X7= S1*I1
- NX6 X6
- SA4 B3+B6 X4= I4
- FX6 X6+X7 SUM
- NX6 X6
- FX7 X6*X0 X7= F4
- SA7 B4+B6
- FX0 X7+X4 X0= F4+I4
- NX0 X0
- SA4 B3 X4= I1
- FX0 X0*X5 X0= FN
- SA5 B3+B7 X5= I2
- FX6 X1*X0 X6= S1*FN
- FX7 X2*X0 X7= S2*FN
- FX6 X4+X6 X6= I1+S1*FN
- SA4 A5+B7 X4= I3
- NX6 X6
- FX7 X5+X7 X7= I2+S2*FN
- SA6 B4
- NX7 X7
- SA7 A6+B7
- FX7 X3*X0 X7= S3*FN
- FX6 X4+X7 X6= I3+S3*FN
- NX6 X6
- SA6 A7+B7
- EQ LORENB
- CMS SA1 A2-B7 X1= I3
- BX7 X2 X7= I4
- SA4 A1-B7 X4= I2
- BX6 X1 X6= I3
- SA3 B3 X3= I1
- SA7 B4+B6
- SA6 A7-B7
- BX7 X4 X7= I2
- BX6 X3 X3= I1
- SA7 A6-B7
- SA6 B4
- EQ LORENB
-*
- ONE DATA 1.
- END
-#ifdef CERNLIB_TCGEN_LORENB
-#undef CERNLIB_TCGEN_LORENB
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/lorenf.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/lorenf.s
deleted file mode 100644
index 2e39097..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/lorenf.s
+++ /dev/null
@@ -1,92 +0,0 @@
-*
-* $Id: lorenf.s,v 1.1.1.1 1996/02/15 17:51:22 mclareni Exp $
-*
-* $Log: lorenf.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:22 mclareni
-* Kernlib
-*
-*
- IDENT LORENF
-*
-* CERN PROGLIB# U102 LORENF .VERSION KERNCDC 0.1 750820
-*
- ENTRY LORENF
-* CALL LORENF (U,PS,PI,PF)
-*
- VFD 36/6HLORENF,24/LORENF
- LORENF BSS 1
- SB7 1
- SA5 X1 X5= U
- SA2 A1+B7
- SB2 X2
- SA3 A2+B7
- SB6 3
- SB3 X3
- SA2 A3+B7
- SA4 B2+B6 X4= S4
- SB4 X2
- SA1 ONE FLOATING 1
- IX7 X4-X5 S4-U
- SA2 B3+B6 X2= I4
- ZR X7,CMS
-*
- FX0 X1/X5 X0= 1/U
- SA3 A4-B7 X3= S3
- FX6 X2*X4 X6= S4*I4
- FX5 X4+X5 X5= S4+U
- SA4 A2-B7 X4= I3
- NX5 X5
- SA2 A3-B7 X2= S2
- FX7 X3*X4 X7= S3*I3
- SA4 A4-B7 X4= I2
- FX6 X6-X7 SUM
- FX7 X2*X4 X7= S2*I2
- NX6 X6
- FX5 X1/X5 X5= 1/S4+U
- SA1 B2 X1= S1
- FX6 X6-X7 SUM
- SA4 B3 X4= I1
- FX7 X1*X4 X7= S1*I1
- NX6 X6
- SA4 B3+B6 X4= I4
- FX6 X6-X7 SUM
- NX6 X6
- FX7 X6*X0 X7= F4
- SA7 B4+B6
- FX0 X7+X4 X0= F4+I4
- NX0 X0
- SA4 B3 X4= I1
- FX0 X0*X5 X0= FN
- SA5 B3+B7 X5= I2
- FX6 X1*X0 X6= S1*FN
- FX7 X2*X0 X7= S2*FN
- FX6 X4-X6 X6= I1-S1*FN
- SA4 A5+B7 X4= I3
- NX6 X6
- FX7 X5-X7 X7= I2-S2*FN
- SA6 B4
- NX7 X7
- SA7 A6+B7
- FX7 X3*X0 X7= S3*FN
- FX6 X4-X7 X6= I3-S3*FN
- NX6 X6
- SA6 A7+B7
- EQ LORENF
- CMS SA1 A2-B7 X1= I3
- BX7 X2 X7= I4
- SA4 A1-B7 X4= I2
- BX6 X1 X6= I3
- SA3 B3 X3= I1
- SA7 B4+B6
- SA6 A7-B7
- BX7 X4 X7= I2
- BX6 X3 X3= I1
- SA7 A6-B7
- SA6 B4
- EQ LORENF
-*
- ONE DATA 1.
- END
-#ifdef CERNLIB_TCGEN_LORENF
-#undef CERNLIB_TCGEN_LORENF
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/lvmax.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/lvmax.s
deleted file mode 100644
index 1eb5136..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/lvmax.s
+++ /dev/null
@@ -1,42 +0,0 @@
-*
-* $Id: lvmax.s,v 1.1.1.1 1996/02/15 17:51:22 mclareni Exp $
-*
-* $Log: lvmax.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:22 mclareni
-* Kernlib
-*
-*
- IDENT LVMAX
-*
-* CERN PROGLIB# F121 LVMAX .VERSION KERNCDC 0.1 750820
-*
-* I = LVMAX(A,N)
-* SETS I SUCH THAT
-* A(I) = MAX(A(J), J=1,N)
-*
-*
- ENTRY LVMAX
- VFD 30/5HLVMAX,30/LVMAX
- LVMAX DATA 0
- SB5 -1
- SA3 A1-B5
- SB1 X1
- SA2 X3
- SB3 X2+B5
- SA1 B1+B3
- BX6 X2
- GE B0,B3,LVMAX
- SB3 B3+B5
- SA4 B1+B3
- LOOP FX5 X4-X1
- SB3 B3+B5
- NG X5,ENDLP
- BX1 X4
- SX6 B3+2
- ENDLP SA4 B1+B3
- GE B3,B0,LOOP
- EQ B0,B0,LVMAX
- END
-#ifdef CERNLIB_TCGEN_LVMAX
-#undef CERNLIB_TCGEN_LVMAX
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/lvmaxa.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/lvmaxa.s
deleted file mode 100644
index 2df923e..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/lvmaxa.s
+++ /dev/null
@@ -1,44 +0,0 @@
-*
-* $Id: lvmaxa.s,v 1.1.1.1 1996/02/15 17:51:22 mclareni Exp $
-*
-* $Log: lvmaxa.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:22 mclareni
-* Kernlib
-*
-*
- IDENT LVMAXA
-*
-* CERN PROGLIB# F121 LVMAXA .VERSION KERNCDC 0.1 750820
-*
-* I = LVMAXA(A,N)
-* SETS I SUCH THAT
-* ABS(A(I)) = MAX(ABS(AJ)), J=1,N)
-*
-*
- ENTRY LVMAXA
- VFD 36/6HLVMAXA,24/LVMAXA
- LVMAXA DATA 0
- SB7 -1
- SA3 A1-B7
- SB1 X1+B7
- SA2 X3
- MX6 0
- SB3 X2
- MX7 0
- GE B0,B3,LVMAXA
- SA1 B1+B3
- LOOP BX3 X1
- AX1 60
- SB3 B3-1
- BX4 X1-X3
- SA1 B1+B3
- FX5 X4-X7
- NG X5,ENDLP
- BX7 X4
- SX6 B3+1
- ENDLP LT B0,B3,LOOP
- EQ B0,B0,LVMAXA
- END
-#ifdef CERNLIB_TCGEN_LVMAXA
-#undef CERNLIB_TCGEN_LVMAXA
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/lvmin.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/lvmin.s
deleted file mode 100644
index ee0e433..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/lvmin.s
+++ /dev/null
@@ -1,42 +0,0 @@
-*
-* $Id: lvmin.s,v 1.1.1.1 1996/02/15 17:51:22 mclareni Exp $
-*
-* $Log: lvmin.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:22 mclareni
-* Kernlib
-*
-*
- IDENT LVMIN
-*
-* CERN PROGLIB# F121 LVMIN .VERSION KERNCDC 0.1 750820
-*
-* I = LVMIN(A,N)
-* SETS I SUCH THAT
-* A(I) = MIN(A(J), J=1,N)
-*
-*
- ENTRY LVMIN
- VFD 30/5HLVMIN,30/LVMIN
- LVMIN DATA 0
- SB5 -1
- SA3 A1-B5
- SB1 X1
- SA2 X3
- SB3 X2+B5
- SA1 B1+B3
- BX6 X2
- GE B0,B3,LVMIN
- SB3 B3+B5
- SA4 B1+B3
- LOOP FX5 X1-X4
- SB3 B3+B5
- NG X5,ENDLP
- BX1 X4
- SX6 B3+2
- ENDLP SA4 B1+B3
- GE B3,B0,LOOP
- EQ B0,B0,LVMIN
- END
-#ifdef CERNLIB_TCGEN_LVMIN
-#undef CERNLIB_TCGEN_LVMIN
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/lvmina.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/lvmina.s
deleted file mode 100644
index 42dc541..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/lvmina.s
+++ /dev/null
@@ -1,48 +0,0 @@
-*
-* $Id: lvmina.s,v 1.1.1.1 1996/02/15 17:51:22 mclareni Exp $
-*
-* $Log: lvmina.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:22 mclareni
-* Kernlib
-*
-*
- IDENT LVMINA
-*
-* CERN PROGLIB# F121 LVMINA .VERSION KERNCDC 0.1 750820
-*
-* I = LVMINA(A,N)
-* SETS I SUCH THAT
-* ABS(A(I)) = MIN(ABS(AJ)), J=1,N)
-*
-*
- ENTRY LVMINA
- VFD 36/6HLVMINA,24/LVMINA
- LVMINA DATA 0
- SB7 -1
- SA3 A1-B7
- SB1 X1+B7
- SA2 X3
- MX6 0
- SB3 X2
- MX7 0
- GE B0,B3,LVMINA
- SA1 B1+B3
- BX5 X1
- SX6 X2
- AX5 60
- BX7 X5-X1
- LOOP BX3 X1
- AX1 60
- SB3 B3-1
- BX4 X1-X3
- SA1 B1+B3
- FX5 X7-X4
- NG X5,ENDLP
- BX7 X4
- SX6 B3+1
- ENDLP LT B0,B3,LOOP
- EQ B0,B0,LVMINA
- END
-#ifdef CERNLIB_TCGEN_LVMINA
-#undef CERNLIB_TCGEN_LVMINA
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/mbytet.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/mbytet.s
deleted file mode 100644
index 8181bb0..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/mbytet.s
+++ /dev/null
@@ -1,40 +0,0 @@
-*
-* $Id: mbytet.s,v 1.1.1.1 1996/02/15 17:51:22 mclareni Exp $
-*
-* $Log: mbytet.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:22 mclareni
-* Kernlib
-*
-*
- IDENT MBYTET
-*
-* CERN PROGLIB# M421 MBYTET .VERSION KERNCDC 2.15 850813
-* ORIG. JZ, 12/8/85
-*
-* FUNCTION MBYTET (A,B,LB,NBITS)
-*
- ENTRY MBYTET
- VFD 36/6HMBYTET,24/MBYTET
- MBYTET DATA 0
- SB7 -1 B7= -1
- SA2 A1-B7 X2= ADR(X)
- SA3 A2-B7 X2= ADR(LX)
- SA4 A3-B7 X4= ADR(NBITS)
- SA1 X1 X1= A
- SA2 X2 X2= X
- SA4 X4 X4= NBITS
- SA3 X3 X3= LX
- MX0 1 MASK STARTED
- SB5 X4+B7 B5= NBITS-1
- SB4 X4 B4= NBITS
- AX0 B5,X0 MASK ON THE LEFT
- LX0 B4,X0 MASK ON THE RIGHT
- SB3 X3+B7 B3= LX-1
- BX1 -X0+X1 SET NON BYTE IN A TO ALL ONES
- LX1 B3,X1 SHIFT A TO LX
- BX6 X2*X1 AND BYTE FROM A TO X
- EQ MBYTET
- END
-#ifdef CERNLIB_TCGEN_MBYTET
-#undef CERNLIB_TCGEN_MBYTET
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/mbytor.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/mbytor.s
deleted file mode 100644
index 62799e3..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/mbytor.s
+++ /dev/null
@@ -1,40 +0,0 @@
-*
-* $Id: mbytor.s,v 1.1.1.1 1996/02/15 17:51:22 mclareni Exp $
-*
-* $Log: mbytor.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:22 mclareni
-* Kernlib
-*
-*
- IDENT MBYTOR
-*
-* CERN PROGLIB# M421 MBYTOR .VERSION KERNCDC 2.15 850813
-* ORIG. JZ, 12/8/85
-*
-* FUNCTION MBYTOR (A,X,LX,NBITS)
-*
- ENTRY MBYTOR
- VFD 36/6HMBYTOR,24/MBYTOR
- MBYTOR DATA 0
- SB7 -1 B7= -1
- SA2 A1-B7 X2= ADR(X)
- SA3 A2-B7 X2= ADR(LX)
- SA4 A3-B7 X4= ADR(NBITS)
- SA1 X1 X1= A
- SA2 X2 X2= X
- SA4 X4 X4= NBITS
- SA3 X3 X3= LX
- MX0 1 MASK STARTED
- SB5 X4+B7 B5= NBITS-1
- SB4 X4 B4= NBITS
- AX0 B5,X0 MASK ON THE LEFT
- LX0 B4,X0 MASK ON THE RIGHT
- SB3 X3+B7 B3= LX-1
- BX1 X0*X1 CLEAR NON BYTE IN A
- LX1 B3,X1 SHIFT A TO LX
- BX6 X2+X1 ADD BYTE FROM A TO X
- EQ MBYTOR
- END
-#ifdef CERNLIB_TCGEN_MBYTOR
-#undef CERNLIB_TCGEN_MBYTOR
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/mcbyt.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/mcbyt.s
deleted file mode 100644
index 5b0f981..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/mcbyt.s
+++ /dev/null
@@ -1,49 +0,0 @@
-*
-* $Id: mcbyt.s,v 1.1.1.1 1996/02/15 17:51:22 mclareni Exp $
-*
-* $Log: mcbyt.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:22 mclareni
-* Kernlib
-*
-*
- IDENT MCBYT
-*
-* CERN PROGLIB# M421 MCBYT .VERSION KERNCDC 2.15 850813
-* ORIG. JZ, 12/8/85
-*
-* FUNCTION MCBYT (A,LA,X,LX,NBITS)
-*
- ENTRY MCBYT
- VFD 30/5HMCBYT,30/MCBYT
- MCBYT DATA 0
- SB7 -1 B7= -1
- SA2 A1-B7 X2= ADR(LA)
- SA3 A2-B7 X3= ADR(X)
- SA4 A3-B7 X+= ADR(LX)
- SA5 A4-B7 X5= ADR(NBITS)
- SA2 X2 X2= LA
- SA4 X4 X4= LX
- MX0 1 MASK STARTED
- SA5 X5 X5= NBITS
- IX2 X4-X2 X2= LX-LA = IDISP DISPLACEMENT A TO X
- SB6 X5+B7 B6= NBITS-1
- BX6 X2 X6= IDISPL
- SX7 60 X7= 60
- SB5 X4+B6 B5= NBITS+LX-1
- AX6 59 X6= 0 OR -0
- SA1 X1 X1= A
- SA3 X3 X3= X
- AX0 B6,X0 MASK ON LEFT
- BX7 X6*X7 X7= 0 OR 60 FOR IDISPL +VE OR -VE
- SB2 X2 B2= IDISPL
- LX0 B5,X0 SHIFT MASK TO LX
- SB2 B2 B2= IDISPL OR IDISPL+60
- BX3 -X0*X3 MASK OUT BYTE IN X
- LX1 B2,X1 SHIFT BYTE IN A TO LX
- BX1 X0*X1 MASK OUT NON BYTE IN A
- BX6 X1+X3 ADD BYTE TO X
- EQ MCBYT
- END
-#ifdef CERNLIB_TCGEN_MCBYT
-#undef CERNLIB_TCGEN_MCBYT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/msbit.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/msbit.s
deleted file mode 100644
index 6f5d813..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/msbit.s
+++ /dev/null
@@ -1,36 +0,0 @@
-*
-* $Id: msbit.s,v 1.1.1.1 1996/02/15 17:51:22 mclareni Exp $
-*
-* $Log: msbit.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:22 mclareni
-* Kernlib
-*
-*
- IDENT MSBIT
-*
-* CERN PROGLIB# M421 MSBIT .VERSION KERNCDC 2.15 850813
-* ORIG. JZ, 12/8/85
-*
-* FUNCTION MSBIT (VALUE,WORD,LOC)
-*
- ENTRY MSBIT
- VFD 30/5HMSBIT,30/MSBIT
- MSBIT BSS 1
- SA5 A1+2
- SA1 X1 X1= VALUE
- MX6 1
- SA3 X5 X3= LOC
- SA4 A5-1
- LX1 59
- SB3 X3
- BX7 X1*X6 MASK LAST BIT OF VALUE
- SA2 X4 X2= WORD
- LX6 X6,B3
- BX4 -X6*X2 CLEAR BIT IN WORD
- LX1 X7,B3
- BX6 X1+X4
- EQ MSBIT
- END
-#ifdef CERNLIB_TCGEN_MSBIT
-#undef CERNLIB_TCGEN_MSBIT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/msbit0.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/msbit0.s
deleted file mode 100644
index fcd31ce..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/msbit0.s
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: msbit0.s,v 1.1.1.1 1996/02/15 17:51:22 mclareni Exp $
-*
-* $Log: msbit0.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:22 mclareni
-* Kernlib
-*
-*
- IDENT MSBIT0
-*
-* CERN PROGLIB# M421 MSBIT0 .VERSION KERNCDC 2.15 850813
-* ORIG. JZ, 12/8/85
-*
-* FUNCTION MSBIT0 (WORD,LOC)
-*
- ENTRY MSBIT0
- VFD 36/6HMSBIT0,24/MSBIT0
- MSBIT0 BSS 1
- SA4 A1+1
- MX6 1
- SA1 X1 X1= IWORD
- SA2 X4 X2= LOC
- SB2 X2
- LX3 X6,B2
- BX6 -X3*X1 CLEAR BIT IN WORD
- EQ MSBIT0
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/msbit1.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/msbit1.s
deleted file mode 100644
index eaa77ac..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/msbit1.s
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: msbit1.s,v 1.1.1.1 1996/02/15 17:51:22 mclareni Exp $
-*
-* $Log: msbit1.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:22 mclareni
-* Kernlib
-*
-*
- IDENT MSBIT1
-*
-* CERN PROGLIB# M421 MSBIT1 .VERSION KERNCDC 2.15 850813
-* ORIG. JZ, 12/8/85
-*
-* FUNCTION MSBIT1 (WORD,LOC)
-*
- ENTRY MSBIT1
- VFD 36/6HMSBIT1,24/MSBIT1
- MSBIT1 BSS 1
- SA4 A1+1
- MX6 1
- SA1 X1 X1= IWORD
- SA2 X4 X2= LOC
- SB2 X2
- LX3 X6,B2
- BX6 X1+X3
- EQ MSBIT1
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/msbyt.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/msbyt.s
deleted file mode 100644
index 686b292..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/msbyt.s
+++ /dev/null
@@ -1,42 +0,0 @@
-*
-* $Id: msbyt.s,v 1.1.1.1 1996/02/15 17:51:22 mclareni Exp $
-*
-* $Log: msbyt.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:22 mclareni
-* Kernlib
-*
-*
- IDENT MSBYT
-*
-* CERN PROGLIB# M421 MSBYT .VERSION KERNCDC 2.15 850813
-* ORIG. JZ, 12/8/85
-*
-* FUNCTION MSBYT (VALUE,WORD,LOC,NBITS)
-*
- ENTRY MSBYT
- VFD 30/5HMSBYT,30/MSBYT
- MSBYT BSS 1
- SA5 A1+3 X5= ADDRESS OF NBITS
- SB5 -1
- SA4 X5 X4= NBITS
- MX6 1
- SA5 A5+B5 X5= ADDRESS OF LOC
- SA1 X1 X1= VALUE
- SB6 X4+B5 B6= NBITS-1
- SB4 X4 B4 = NBITS
- AX6 B6,X6
- SA3 X5 X3= LOC
- SA5 A5+B5 X5= ADDRESS OF WORD
- LX6 X6,B4 NBITS BITS ON THE RIGHT
- SB7 X3+B5 B7= LOC-1
- BX7 X1*X6 MASK NBITS BITS OF VALUE
- SA2 X5 X2= WORD
- LX6 X6,B7 SHIFT MASK
- LX1 X7,B7 SHIFT VALUE
- BX7 -X6*X2 ZERO OUT BYTE IN WORD
- BX6 X7+X1 ADD VALUE
- EQ MSBYT
- END
-#ifdef CERNLIB_TCGEN_MSBYT
-#undef CERNLIB_TCGEN_MSBYT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/mvbits.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/mvbits.s
deleted file mode 100644
index 6fea7a6..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/mvbits.s
+++ /dev/null
@@ -1,64 +0,0 @@
-*
-* $Id: mvbits.s,v 1.1.1.1 1996/02/15 17:51:22 mclareni Exp $
-*
-* $Log: mvbits.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:22 mclareni
-* Kernlib
-*
-*
- IDENT MVBITS
-*
-* CERN PROGLIB# M441 MVBITS .VERSION KERNCDC 2.18 870602
-* ORIG. ?
-*
-* SUBROUTINE MVBITS(I,N,L,J,M)
-*
-* COMPASS VERSION OF MIL-STD-1753 SUBROUTINE MVBITS
-* I AND J ARE INTEGERS IN THE CALLING SEQUENCE
-* N IS THE POSITION IN I FROM WHICH BITS ARE EXTRACTED
-* L IS THE NUMBER OF BITS TO BE EXTRACTED
-* M IS THE POSITION IN J INTO WHICH BITS ARE TO BE PLACED
-*
- ENTRY MVBITS
- VFD 36/6HMVBITS,24/MVBITS
- MVBITS DATA 0
- SA2 A1+1
- SA3 A2+1
- SA0 A3
- SA3 X3
- ZR X3,ZERO .TEST ON ZERO FIELD
- SA2 X2
- SA1 X1
- SB3 X3
- SB2 X2
- MX4 1
- SB4 B3-1
- AX4 B4,X4
- SB6 B2+B3
- LX4 B6,X4
- BX6 X4*X1
- AX6 B2,X6 .BITS EXTRACTED, NOW INSERT INTO J
- SA4 A0+1
- SA5 A4+1
- SA4 X4
- SA5 X5
- SB5 X5
- LX6 B5,X6 .BITS POSITIONED
- MX0 1
- SB7 59
- SB7 B7-B3
- AX0 B7,X0
- LX0 B5,X0 .MASK OF 60-L-M (UPPER) AND M (LOWER)
- BX4 X0*X4
- BX6 X6+X4
- SA6 A4
- EQ B0,B0,MVBITS
-*
- ZERO SX6 B0
- SA4 A0+1
- SA6 X4
- EQ B0,B0,MVBITS
- END
-#ifdef CERNLIB_TCGEN_MVBITS
-#undef CERNLIB_TCGEN_MVBITS
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/mxequ.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/mxequ.s
deleted file mode 100644
index 2600292..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/mxequ.s
+++ /dev/null
@@ -1,150 +0,0 @@
-*
-* $Id: mxequ.s,v 1.1.1.1 1996/02/15 17:51:23 mclareni Exp $
-*
-* $Log: mxequ.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:23 mclareni
-* Kernlib
-*
-*
- IDENT MXEQU 10-JUNE-68
-*
-* CERN PROGLIB# F109 MXEQU .VERSION KERNCDC 0.1 750820
-*
- ENTRY MXEQU
- ENTRY MXEQU1
-*
-* SUBROUTINE MXEQU (A,B,I,J)
- VFD 30/5HMXEQU,30/MXEQU
- SAVEA0 BSS 1
- MXEQU BSS 1
- SB2 1 B2= 1
- SA2 =-1. X2= -1.
- SB1 X1
- SA4 A1+B2
- SB7 B0 B7= L
- SA5 A4+B2
- SA1 B1 X1= A(1)
- SA3 X5 X3= I
- ZR X3,MXEQU
- SX6 A0
- SB3 X3
- SA6 SAVEA0
- SA0 X4 A0= ADDRESS OF B
- SA4 A5+B2
- SA5 X4 X5= J
- BX7 X5
- MX4 0 X4= LL
- SA7 JLOCAL
- LOOP17 RX0 X2/X1 X0= DIAG
- SA5 A1+B2 X5= A(L1L)
- IX6 X4+X3
- SX1 B2 X1= 1
- SB6 B0 B6= M
- SB4 B7 B4= LM=L
- IX4 X6+X1 LL=LL+I+1
- LOOP12 SA1 B4+B1 X1= A(LM)
- EQ B6,B7,DOWN12
- RX7 X1*X0
- NO
- NO
- NO
- SA7 A1
- DOWN12 SB6 B2+B6
- SB4 B4+B3 LM=LM+I
- LT B6,B3,LOOP12
- SB5 B7+B2 B5= L1
- NO
- GE B5,B3,BTRANS
- LOOP16 SX2 B7 X2= LM=L
- SB6 B0 B6= M
- NO
- SB4 B5-B7 B4= L1M-LM
- LOOP15 SA1 X2+B1 X1= A(LM)
- EQ B6,B7,DOWN15
- RX6 X5*X1
- SA1 A1+B4 X1= A(L1M)
- RX1 X6+X1
- NX7 B0,X1
- SA7 A1
- DOWN15 SB6 B2+B6
- IX2 X2+X3 LM=LM+I
- LT B6,B3,LOOP15
- SB5 B5+B2
- SA5 A5+B2
- LT B5,B3,LOOP16
- SB7 B7+B2
- SA1 B1+X4 X1= A(LL)
- SA2 =-1.
- LT B7,B3,LOOP17
- BTRANS SA2 JLOCAL X2= J
- EQ STARTB
- JLOCAL BSS 1
-*
-* SUBROUTINE MXEQU1 (A,B,I,J)
- VFD 36/6HMXEQU1,24/MXEQU1
- MXEQU1 BSS 1
- SB2 1
- SA4 A1+B2
- SB1 X1
- SA1 MXEQU1
- BX6 X1
- SA2 A4+B2
- SA6 MXEQU
- SA3 X2 X3= I
- SA5 A2+B2
- ZR X3,MXEQU
- SX7 A0
- SA2 X5 X2= J
- SA0 X4 A0= ADDRESS OF B
- SA7 SAVEA0
- SB3 X3 B3= I
- STARTB ZR X2,MXEQUE
- SA5 A0 X5= B(ML)
- SB4 B0
- LOOP27 BX0 -X2 X0= -J
- SB7 B4 B7= L
- SB4 B4+B2
- LOOP26 SX4 B7 LN=L
- IX1 X0+X2
- SB5 B0 B5= N
- SB6 X1 MN=M
- LOOP25 SA1 X4+B1 X1= A(LN)
- EQ B5,B7,DOWN25
- RX6 X5*X1
- SA1 A0+B6 X1= B(MN)
- RX1 X6+X1
- NX7 B0,X1
- SA7 A1
- DOWN25 SB5 B5+B2
- IX4 X4+X3 LN=LN+I
- NO
- SB6 B6+X2 MN=MN+J
- LT B5,B3,LOOP25
- SX0 X0+B2
- SA5 A5+B2
- NG X0,LOOP26
- LT B4,B3,LOOP27
- SB7 X3+B2 B7= I+1
- SA5 =1. X5= 1.
- SA1 B1 X1= A(1)
- SB1 B0 B1= N
- SA4 A0 X4= B(1)
- NO
- SX3 B2 X3= 1
- LOOP36 RX6 X5/X1
- BX0 -X2 X0= -J
- SB1 B1+B2
- SA1 A1+B7 X1= A(NN)
- LOOP35 RX7 X6*X4
- IX0 X0+X3
- SA4 A4+B2 X4= B(MN)
- SA7 A4-B2
- NG X0,LOOP35
- LT B1,B3,LOOP36
- MXEQUE SA1 SAVEA0
- SA0 X1
- EQ MXEQU
- END
-#ifdef CERNLIB_TCGEN_MXEQU
-#undef CERNLIB_TCGEN_MXEQU
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/mxmad.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/mxmad.s
deleted file mode 100644
index 3290c36..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/mxmad.s
+++ /dev/null
@@ -1,208 +0,0 @@
-*
-* $Id: mxmad.s,v 1.1.1.1 1996/02/15 17:51:23 mclareni Exp $
-*
-* $Log: mxmad.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:23 mclareni
-* Kernlib
-*
-*
- IDENT MXMAD 10-JUNE-68
-*
-* CERN PROGLIB# F110 MXMAD .VERSION KERNCDC 0.1 750820
-*
- ENTRY MXMAD
- ENTRY MXMAD1
- ENTRY MXMAD2
- ENTRY MXMAD3
- ENTRY MXMPY
- ENTRY MXMPY1
- ENTRY MXMPY2
- ENTRY MXMPY3
- ENTRY MXMUB
- ENTRY MXMUB1
- ENTRY MXMUB2
- ENTRY MXMUB3
-* SUBROUTINE MXMAD (A,B,C,I,J,K)
- VFD 30/5HMXMAD,30/MXMAD
- MXMAD BSS 1
- SA3 MXMAD
- SX2 0
- SA4 XMAD
- EQ LOC1
-* SUBROUTINE MXMAD1 (A,B,C,I,J,K)
- VFD 36/6HMXMAD1,24/MXMAD1
- MXMAD1 BSS 1
- SA3 MXMAD1
- SX2 1
- SA4 XMAD
- EQ LOC1
-* SUBROUTINE MXMAD2 (A,B,C,I,J,K)
- VFD 36/6HMXMAD2,24/MXMAD2
- MXMAD2 BSS 1
- SA3 MXMAD2
- SX2 2
- SA4 XMAD
- EQ LOC1
-* SUBROUTINE MXMAD3 (A,B,C,I,J,K)
- VFD 36/6HMXMAD3,24/MXMAD3
- MXMAD3 BSS 1
- SA3 MXMAD3
- SX2 3
- SA4 XMAD
- EQ LOC1
-* SUBROUTINE MXMPY (A,B,C,I,J,K)
- VFD 30/5HMXMPY,30/MXMPY
- MXMPY BSS 1
- SA3 MXMPY
- SX2 0
- SA4 XMPY
- EQ LOC1
-* SUBROUTINE MXMPY1 (A,B,C,I,J,K)
- VFD 36/6HMXMPY1,24/MXMPY1
- MXMPY1 BSS 1
- SA3 MXMPY1
- SX2 1
- SA4 XMPY
- EQ LOC1
-* SUBROUTINE MXMPY2 (A,B,C,I,J,K)
- VFD 36/6HMXMPY2,24/MXMPY2
- MXMPY2 BSS 1
- SA3 MXMPY2
- SX2 2
- SA4 XMPY
- EQ LOC1
-* SUBROUTINE MXMPY3 (A,B,C,I,J,K)
- VFD 36/6HMXMPY3,24/MXMPY3
- MXMPY3 BSS 1
- SA3 MXMPY3
- SX2 3
- SA4 XMPY
- EQ LOC1
-* SUBROUTINE MXMUB (A,B,C,I,J,K)
- VFD 30/5HMXMUB,30/MXMUB
- MXMUB BSS 1
- SA3 MXMUB
- SX2 0
- SA4 XMUB
- EQ LOC1
-* SUBROUTINE MXMUB1 (A,B,C,I,J,K)
- VFD 36/6HMXMUB1,24/MXMUB1
- MXMUB1 BSS 1
- SA3 MXMUB1
- SX2 1
- SA4 XMUB
- EQ LOC1
-* SUBROUTINE MXMUB2 (A,B,C,I,J,K)
- VFD 36/6HMXMUB2,24/MXMUB2
- MXMUB2 BSS 1
- SA3 MXMUB2
- SX2 2
- SA4 XMUB
- EQ LOC1
-* SUBROUTINE MXMUB3 (A,B,C,I,J,K)
- VFD 36/6HMXMUB3,24/MXMUB3
- MXMUB3 BSS 1
- SA3 MXMUB3
- SX2 3
- SA4 XMUB
-*
- LOC1 SB7 1
- SA5 A1+B7
- BX6 X3
- LX7 B0,X4
- SA6 MXMAD STORE E/E LINE
- SA4 A5+B7
- SA7 LOOP23 STORE APPROPRIATE INSTRUCTIONS
- SB2 X5
- SA5 A4+B7
- SB3 X4
- MX7 59
- SA4 X5 X4= I
- SB1 X1
- ZR X4,MXMAD
- SA1 A5+B7
- BX6 -X4 X6= -I
- SA3 X1 X3= J
- X2= N2=0, 1, 2, 3
- BX7 X2*X7
- SA4 A1+B7
- SB6 X3 B6= J
- SA1 B1 A1= B1
- SA5 X4 X5= K
- SX0 1 X0= 1
- SA6 MOINSI
- ZR X5,MXMAD
- BX4 -X6
- SX6 A0
- SA6 SAVEA0
- NZ X7,LOC5
- SX6 X3 IOA=J
- BX4 X0 IIA=1
- EQ LOC7
- LOC5 SX6 X0 IOA=1, IIA=I
- LOC7 BX7 X0*X2
- LX6 20
- NZ X7,LOC11
- SB1 X5
- IX6 X6+X0 IOB=1, IIB=K
- EQ LOC13
- LOC11 SB1 X5
- BX5 X0 IIB=1
- IX6 X6+X3 IOB=J
- LOC13 SA0 B2 A0= ADDRESS OF B(1)
- SB5 B0
- NO
- SB2 X0 B2= 1
- LOOP25 SB4 A0
- SB3 B3+B5
- NO
- SB5 B0 B5= M
- LOOP23 BSS 1
- SA2 A1
- SB7 B0 B7= N
- NO
- SA3 B4
- SX1 B4 X1= JB
- NO
- NO
- SX0 A2 X0= JA
- LOOP20 RX2 X2*X3
- FX1 X1+X5 X5= IIB
- SB7 B2+B7
- NX7 B0,X7
- IX0 X0+X4 X4= IIA
- SA3 X1 X3= B(JB)
- RX7 X7+X2
- SA2 X0 X2= A(JA)
- NE B6,B7,LOOP20
- NX7 B0,X7
- SB4 X6+B4 X6= IOA - IOB PACKED
- LOC23 SA7 B3+B5
- SB5 B2+B5
- NE B5,B1,LOOP23 B1= K
- LX6 40
- SA2 MOINSI
- SB7 X6
- SX7 X2+B2
- SA1 A1+B7
- LX6 20
- BX2 X7
- SA7 MOINSI
- NZ X2,LOOP25
- SA1 SAVEA0
- SA0 X1
- EQ MXMAD
- XMAD SA3 B3+B5
- BX7 X3
- EQ B6,B0,LOC23
- XMUB SA3 B3+B5
- BX7 -X3
- EQ B6,B0,LOC23
- XMPY MX7 0
- EQ B6,B0,LOC23
- MOINSI BSS 1
- SAVEA0 BSS 1
- END
-#ifdef CERNLIB_TCGEN_MXMAD
-#undef CERNLIB_TCGEN_MXMAD
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/mxmlrt.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/mxmlrt.s
deleted file mode 100644
index 5b586c4..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/mxmlrt.s
+++ /dev/null
@@ -1,138 +0,0 @@
-*
-* $Id: mxmlrt.s,v 1.1.1.1 1996/02/15 17:51:23 mclareni Exp $
-*
-* $Log: mxmlrt.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:23 mclareni
-* Kernlib
-*
-*
- IDENT MXMLRT
-*
-* CERN PROGLIB# F110 MXMLRT .VERSION KERNCDC 0.1 760424
-*
- ENTRY MXMLRT
- ENTRY MXMLTR
-*
-* SUBROUTINE MXMLRT (A,B,C,NI,NJ)
- VFD 36/6HMXMLRT,24/MXMLRT
- MXMLRT BSS 1
-*
- SB7 1
- MX0 1
- SB1 X1
- SA2 A1+B7
- LX0 21 X0= X-IPA-X
- SB2 X2
- SA1 A2+B7
- SB3 X1
- SA2 A1+B7
- SA4 X2 X4= NI
- SA1 A2+B7
- SB4 X4 B4= NI
- SA5 X1 X5= NJ
- BX2 X5 X2= JPA=NJ
- EQ LOC5
-*
-* SUBROUTINE MXMLTR (A,B,C,NI,NJ)
- VFD 36/6HMXMLTR,24/MXMLTR
- MXMLTR BSS 1
-*
- SB7 1
- SA4 MXMLTR
- SB1 X1
- SA2 A1+B7
- BX6 X4
- SB2 X2
- SA1 A2+B7
- SX2 B7 X2= JPA=1
- SA6 MXMLRT
- SB3 X1
- SA5 A1+B7
- SA4 X5 X4= NI
- LX0 X4 X0= IPA=NI
- SA1 A5+B7
- LX0 20 X0= X-IPA-X
- SB4 X4 B4= NI
- SA5 X1 X5= NJ
-*
- LOC5 IX0 X0+X2 X0= X-IPA-JPA
- MX3 59 X3= -1
- SB5 X5 B5= NJ
- LX0 20 X0= IPA-JPA-X
- SX5 B2 X5= B2
- EQ B4,B0,MXMLRT
- SX1 B1 X1= B1
- EQ B5,B0,MXMLRT
- LX5 20 X5= B2-X
- IX0 X0+X4 X0= IPA-JPA-II
- FX7 X1+X5 X7= B2-B1
- SA7 KPB2B1
- SX6 A0
- SA6 SAVEA0
- SA0 B1 A0= IA1
- MX6 0 X=0.
-*
- LOOP50 SB7 B3 IC=IC1
- BX3 -X3 X3= 1
- LX0 20 X0= JPA-II-IPA
- SB6 B3+B4
- LOOP10 SA6 B7
- SB7 B7+X3
- LT B7,B6,LOOP10
- SX4 B5 X4= NJ (FOR LOOP40)
- SB7 -1 B7= -1
- LOOP40 SA1 A0 IA=IA1
- MX6 0 X=0.
- SA2 B2 IB=IB1
- NO
- SB6 X0 B6= IPA
- SX3 B5 X3= NJ (FOR LOOP20)
- LX0 20 X0= II-IPA-JPA
- LOOP20 SX3 X3+B7
- FX7 X1*X2
- SA1 A1+B6 IA=IA+IPA
- SA2 A2+B5 IB=IB+NJ
- FX5 X6+X7
- NX6 B0,X5
- NZ X3,LOOP20
- SA1 B1 JA=JA1
- SB6 X0 B6= JPA
- SA2 B3 IC=IC1
- SX3 B4 X3= NI (FOR LOOP30)
- LOOP30 FX5 X6*X1
- SA1 A1+B6 JA=JA+JPA
- SX3 X3+B7
- FX7 X5+X2
- SA2 A2-B7 IC=IC+1
- NX7 B0,X7
- NO
- SA7 A2+B7
- NZ X3,LOOP30
- SB2 B2-B7 IB1=IB1+1
- SX4 X4+B7
- LX0 40 X0= JPA-II-IPA
- SB1 B1+X0 JA1=JA1+IPA
- NZ X4,LOOP40
- SA1 KPB2B1 X1= X-B2-B1
- LX0 20 X0= II-IPA-JPA
- SB3 B3+B4 IC1=IC1+NI
- SB6 X0 B6= JPA
- LX0 20 X0= IPA-JPA-II
- SB1 X1 JA1=1
- SA0 A0+B6 IA1=IA1+JPA
- SX3 B7 X3= -1
- IX0 X0+X3
- SB6 X0
- LX1 40 X1= B1-X-B2
- SB2 X1 IB1=1
- MX6 0
- NE B6,B0,LOOP50
- SA1 SAVEA0
- SA0 X1
- EQ MXMLRT
- KPB2B1 BSS 1
- SAVEA0 BSS 1
- END
-#ifdef CERNLIB_TCGEN_MXMLRT
-#undef CERNLIB_TCGEN_MXMLRT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/mxtrp.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/mxtrp.s
deleted file mode 100644
index a305094..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/mxtrp.s
+++ /dev/null
@@ -1,47 +0,0 @@
-*
-* $Id: mxtrp.s,v 1.1.1.1 1996/02/15 17:51:23 mclareni Exp $
-*
-* $Log: mxtrp.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:23 mclareni
-* Kernlib
-*
-*
- IDENT MXTRP 10-JUNE-68
-*
-* CERN PROGLIB# F110 MXTRP .VERSION KERNCDC 0.1 750820
-*
- ENTRY MXTRP
-* SUBROUTINE MXTRP (A,B,I,J)
- VFD 30/5HMXTRP,30/MXTRP
- MXTRP BSS 1
- SB7 1
- SA2 A1+B7
- SB1 X1
- SX0 B7 X0= 1
- SB2 X2
- MX7 59 X7= -1
- SA4 A2+B7
- SB6 B0 IA=K
- SA3 X4
- ZR X3,MXTRP X3= I
- SA5 A4+B7
- SB3 B6 B3= K
- SA4 X5
- SB4 X4 B4= J
- ZR X4,MXTRP X4= J
- LOOP1 SA1 B1+B6
- IX5 X3-X0 LOOP ON I
- SB3 B3+X0 B3= K
- LOOP2 FX7 X7+X0
- IX5 X5-X0
- BX6 X1
- SA1 A1+B4
- SA6 B2+X7 B(IB)=A(IA)
- PL X5,LOOP2
- SB6 B3 IA=K
- LT B3,B4,LOOP1
- EQ MXTRP
- END
-#ifdef CERNLIB_TCGEN_MXTRP
-#undef CERNLIB_TCGEN_MXTRP
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/mxuty.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/mxuty.s
deleted file mode 100644
index c9f9076..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/mxuty.s
+++ /dev/null
@@ -1,43 +0,0 @@
-*
-* $Id: mxuty.s,v 1.1.1.1 1996/02/15 17:51:23 mclareni Exp $
-*
-* $Log: mxuty.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:23 mclareni
-* Kernlib
-*
-*
- IDENT MXUTY 10-JUNE-68
-*
-* CERN PROGLIB# F110 MXUTY .VERSION KERNCDC 0.1 750820
-*
- ENTRY MXUTY
-* SUBROUTINE MXUTY (A,I)
- VFD 30/5HMXUTY,30/MXUTY
- MXUTY BSS 1
- SB3 1 B3= 1
- MX7 0 X7= 0.
- SA2 A1+B3
- SA3 X2 X3= I
- SX0 B3 X0= 1
- ZR X3,MXUTY
- IX5 X3-X0
- SB2 B0 J= 1
- SA2 =1.
- SB4 X3 B4= I
- BX6 X2 X6= (1.0)
- ZR X5,LOC2 J.E0.1
- LOOP1 SA6 X1+B2 A(J)=1.0
- IX5 X3-X0 X5= I
- SB2 B2+X0 J=J+1
- SB3 B3+X0 INDEX
- LOOP2 IX5 X5-X0 INDEX
- SA7 X1+B2
- SB2 B2+X0 J=J+1
- PL X5,LOOP2
- LT B3,B4,LOOP1
- LOC2 SA6 X1+B2
- EQ MXUTY
- END
-#ifdef CERNLIB_TCGEN_MXUTY
-#undef CERNLIB_TCGEN_MXUTY
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/pkbyt.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/pkbyt.s
deleted file mode 100644
index d0fdbfd..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/pkbyt.s
+++ /dev/null
@@ -1,90 +0,0 @@
-*
-* $Id: pkbyt.s,v 1.1.1.1 1996/02/15 17:51:23 mclareni Exp $
-*
-* $Log: pkbyt.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:23 mclareni
-* Kernlib
-*
-*
- IDENT PKBYT
-*
-* CERN PROGLIB# M422 PKBYT .VERSION KERNCDC 0.1 750820
-*
- ENTRY PKBYT
-* SUBROUTINE PKBYT (M,A,JTH,N,NBITS)
- VFD 30/5HPKBYT,30/PKBYT
- PKBYT BSS 1
- SB7 1
- SA2 A1+B7
- SB1 X1
- SA4 A2+B7
- SB2 X2
- SA5 A4+B7
- SA3 X4 X3= JTH
- SA2 A5+B7
- SA4 X5 X4= N
- ZR X4,PKBYT
- SA1 X2+B7 X1= INWORD
- SX6 A0
- SA5 X2 X5= NBITS
- PX2 B0,X1 X2= PACKED INWORD
- SA6 SAVEA0
- NX7 B0,X2 X7= NORMALISED INWORD
- NZ X5,L12
- SA2 SIXTY INWORD=60
- SX5 B7 NBITS=1
- NX7 B0,X2
- L12 SX1 X3-1 X1= JTH-1
- PX3 B0,X1 X1= PACKED (JTH-1)
- FX7 X3/X7
- SB5 X5 B5= NBITS
- SB3 X3 B3= JTH-1
- MX0 1
- SB6 B5-B7 B6= NBITS-1
- SB4 B0 CURRENT BYTE
- AX0 B6,X0 NBITS BITS ON LEFT
- SB6 B0 B6= LOC
- SA0 X2 A0= INWORD
- LT B3,B7,START
- UX6 B3,X7
- LX6 B3,X6 X6= NW A-WORDS UNTOUCHED
- PX6 B0,X6
- SB2 B2+X6 B2= NEW JA
- DX1 X6*X2
- FX3 X3-X1
- PX5 B0,X5 X5= PACKED NBITS
- DX7 X3*X5
- SB4 X3
- SB6 X7 B6= LOC
- START SA2 B2 A(JA)
- LX0 B5,X0 NBITS BITS ON THE RIGHT
- SB2 B1+X4 END OF M
- SA1 B1 M(JM)
- L21 BX6 X2
- SB4 A0-B4 REMAINING NUMBER OF BYTES
- LX7 B6,X0 SHIFT MASK
- L24 BX6 -X7*X6 ZERO OUT BYTE IN A(JA)
- LX1 B6,X1 SHIFT M(JM)
- SB4 B4-B7
- SB6 B6+B5 LOC
- BX5 X1*X7
- SB1 B1+B7
- LX7 B5,X7
- BX6 X6+X5 STORE M(JM) IN A(JA)
- GE B1,B2,END
- SA1 B1 NEXT M(JM)
- NE B4,B0,L24
- SA6 A2 STORE A(JA)
- SA2 A2+B7 NEXT A(JA)
- SB6 B0 B6= LOC
- EQ L21
- END SA6 A2
- SA1 SAVEA0
- SA0 X1
- EQ PKBYT
- SIXTY DATA 20000000000000000074B
- SAVEA0 BSS 1
- END
-#ifdef CERNLIB_TCGEN_PKBYT
-#undef CERNLIB_TCGEN_PKBYT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/pkchar.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/pkchar.s
deleted file mode 100644
index 4ce2ed8..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/pkchar.s
+++ /dev/null
@@ -1,222 +0,0 @@
-*
-* $Id: pkchar.s,v 1.1.1.1 1996/02/15 17:51:23 mclareni Exp $
-*
-* $Log: pkchar.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:23 mclareni
-* Kernlib
-*
-*
- IDENT PKCHAR
-*
-* CERN PROGLIB# M427 PKCHAR .VERSION KERNCDC 0.1 730123
-*
- ENTRY PKCHAR
-*
-* CALL PKCHAR (INT,CHAR,N,IPAR) IPAR=NBITS,NCHAR,NZONE,IGNOR,NFILL
-*
-* REGISTER ASSIGNMENTS
-*
-* A0 ADR(NCHAR(J))
-* X7 WORD BEING COMPILED B7 =1
-* X6 B6 NBITS
-* X5 B5 NBITSW PER WORD
-* X4 -NSKIP (SEC 2) B4 NCHAR
-* X3 NFILL B3 JGO (SEC 1)
-* X2 -N, COUNT UP B2 CHARACTER COUNTER
-* X1 INT(JIN) B1 JBT, BIT POSITION
-* X0 MASK OF NBITS BITS
-*
- EJECT
- VFD 36/6HPKCHAR,24/PKCHAR
- SAVEA0 DATA 0
- PKCHAR DATA 0
- SB7 1 B7= 1
- SA2 A1+B7
- SA3 A2+B7
- SA4 A3+B7
- SX6 A0
- SB1 X1
- SB2 X2
- SB3 X3
- SA6 SAVEA0
- SA3 X4
- SA1 A3+B7 X1= NCHAR
- SA5 A1+B7 *X5= NZONE
- SB5 60 B5= NBITSW
- SA4 A5+B7 X4= IGNOR
- PX0 X3 X0= NBITS FLOATING
- NZ X5,PREL11
- SX5 B5 NZONE = NBITSW
- PREL11 BSS 0
- NX0 B6,X0
- IX7 X5-X4 X7= NZONE - IGNOR
- PX6 X7 MXCHAR= (NZONE-IGNOR)/NBITS
- SA0 B2 A0= ADR (CHAR(1))
- FX6 X6/X0
- SA2 B3 X2= N
- SB6 X3 B6= NBITS
- ZR X2,EXITZ
- BX2 -X2 X2= -N
- SB2 X4 *B2= IGNOR
- UX6 B3,X6
- LX6 B3,X6 X6= MXCHAR
- SB3 B6-B7 B3= NBITS-1
- NZ X1,PREL31
- PREL21 BX1 X6
- PREL31 DX4 X1*X3 *X4= NCHAR*NBITS
- IX0 X7-X4 X0= NTRAIL = NZONE - IGNOR - NCHAR*NBITS
- SB4 X1 B4= NCHAR
- NG X0,PREL21 ORIGINAL NCHAR TOO BIG
- SA3 A4+B7 X3= NFILL
- MX0 1
- SX6 A0
- AX0 B3,X0 GENERATE NBITS BITS
- SB3 X5 B3= NZONE
- SA1 B1 A1= ADR(INT(1))
- BX7 X3 PRESET FIRST WORD TO NFILL
- SA6 NCH NCH = ADR(CHAR(1))
- LX0 B6,X0 X0= MASK
- SB1 B5-B2 B1= JBT = NBITSW-IGNOR = JGO
- BX1 X0*X1 X1= CLEANED INT(1)
- SB2 B0
- SB1 B1-B6 JBT= JBT - NBITS
- NE B3,B5,ZONED
-*
-*-------- SECTION 1 = ZONE EQUALS WORD
-*
- SB3 B1 B3= JGO = JBT INITIAL
- SX2 X2+B4 -N= -N + NCHAR
- ZR X3,GO1
- EQ GO2
-*
-* LOOP 1 SPECIAL FOR NFILL=0
-*
- ST24L1 BX5 X0*X1 CLEAN INT
- SA1 A1+B7 LOAD NEXT INT
- SB2 B2+B7 COUNT UP
- LX3 B1,X5 POSITION INT
- BX7 X3+X7 SET BYTE
- SB1 B1-B6 JBT= JBT - NBITS
- LT B2,B4,ST24L1 CHECK CHAR COUNT
- SA7 A0 STORE COMPLETED WORD
- SA0 A0+B7
- PL X2,EXITNS
- SB1 B3 JBT= JGO
- MX7 0
- SX2 X2+B4 -N= -N + NCHAR
- SB2 B0 INITIAL CHAR COUNT
- GO1 NG X2,ST24L1
- SB2 X2
- EQ ST24L1
-*
-* LOOP 2 GENERAL
-*
- ST24L2 BX5 X0*X1 CLEAN INT
- LX6 B1,X0 POSITION MASK
- SA1 A1+B7 LOAD NEXT INT
- SB2 B2+B7 COUNT UP
- BX7 -X6*X7 CLEAR TARGET BYTE
- LX5 B1,X5 POSITION INT
- SB1 B1-B6 JBT= JBT - NBITS
- BX7 X5+X7 SET BYTE
- LT B2,B4,ST24L2
- SA7 A0 STORE COMPLETED WORD
- SA0 A0+B7
- PL X2,EXITNS
- SB1 B3 JBT= JGO
- SX2 X2+B4 -N= -N + NCHAR
- GO2 BX7 X3
- SB2 B0 INITIAL CHAR COUNT
- NG X2,ST24L2
- SB2 X2
- EQ ST24L2
- EJECT
-*
-*-------- SECTION 2 = ZONE NOT EQUALS WORD
-*
- ZONED IX4 X4-X5 X4= -NSKIP = -(NZONE - NCHAR*NBITS)
- NZ X4,GO4
- NZ X3,GO4 NFILL NOT ZERO
- EQ GO3
-*
-* LOOP 3 SPECIAL FOR CHARCTERS COMPACT, NFILL = 0
-* NRIGHT=-JBT, NLEFT=NBITS-JBT
- PART3 BX1 -X6*X1 CLEAR NLEFT BITS OF INT
- SA0 A0+B7
- SB1 B1+B5 JBT= JBT + NBITSW
- BX7 X3 CLEAR NEW WORD
- JOIN3 SX2 X2+B7 COUNT UP
- LX5 B1,X1 POSITION INT
- SA1 A1+B7 LOAD NEXT INT
- BX7 X5+X7 SET BYTE
- SB1 B1-B6 JBT= JBT - NBITS
- PL X2,EXIT
- BX1 X0*X1 CLEAN INT
- GE B1,B0,JOIN3
- LX6 B1,X1 KEEP NLEFT BITS OF INT
- BX7 X6+X7 SET PARTIAL BYTE
- AX6 B1,X6 RE-POSITION NLEFT BITS ON INT
- SA7 A0 STORE COMPLETED WORD
- EQ PART3 PARTIAL BYTE
- GO3 EQU JOIN3
-*
-* LOOP 4 GENERAL
-* NRIGHT=-JBT, NLEFT=NBITS-JBT
- PART4 BX1 X6*X1 KEEP NRIGHT BITS
- LX6 B1,X6 POSITION MASK
- SA0 A0+B7
- BX7 X3 PRESET NEW WORD
- JOIN4 LX5 B1,X1 POSITION INT
- SA1 A1+B7 LOAD NEXT INT
- BX7 -X6*X7 CLEAR TARGET BYTE
- SB2 B2+B7 COUNT UP
- SB1 B1-B6 JBT= JBT-NBITS
- BX7 X5+X7 SET BYTE
- GE B2,B4,ENDZ
- ST44L4 LX6 B1,X0 POSITION MASK / MASK OF NLEFT BITS
- BX1 X0*X1 CLEAN INT
- GE B1,B0,JOIN4 COMPLETE BYTE
- BX7 -X6*X7 CLEAR PARTIAL TARGET BYTE
- LX5 B1,X1 KEEP NLEFT BITS OF INT
- SB3 B1+B6 B3= NLEFT
- BX7 X5+X7 SET PARTIAL BYTE
- SB1 B1+B5 JBT= JBT+NBITSW
- AX6 B3,X0 SET MASK OF NRIGHT BITS
- NO
- SA7 A0 STORE COMPLETED WORD
- EQ PART4 PARTIAL BYTE
- ENDZ PL X2,EXIT
- SB1 X4+B1 JBT= JBT - NSKIP
- GO4 SX2 X2+B4 -N= -N + NCHAR
- SB2 B0 B2= 0 COUNT CHARACTERS
- NG X2,ST43L4
- SB2 X2
- ST43L4 SB3 B1+B6
- GE B3,B0,ST44L4
- SA7 A0 STORE COMPLETED WORD
- SA0 A0+B7
- SB1 B1+B5 JBT= JBT + NBITSW
- BX7 X3 PRESET NEW WORD
- EQ ST43L4
-*
- EXITZ MX6 0
- SA5 SAVEA0
- SA6 NCH
- SA0 X5
- EQ PKCHAR
- EXIT SA7 A0 STORE LAST WORD
- SA0 A0+B7
- EXITNS SA3 NCH
- SA5 SAVEA0
- SX2 A0
- IX6 X2-X3
- SA6 NCH SET NCH WORDS USED INTO /SLATE/
- SA0 X5
- EQ PKCHAR
-*
- USE /SLATE/
- NCH BSS 40
- END
-#ifdef CERNLIB_TCGEN_PKCHAR
-#undef CERNLIB_TCGEN_PKCHAR
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/poweze.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/poweze.s
deleted file mode 100644
index 048fccb..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/poweze.s
+++ /dev/null
@@ -1,59 +0,0 @@
-*
-* $Id: poweze.s,v 1.1.1.1 1996/02/15 17:51:23 mclareni Exp $
-*
-* $Log: poweze.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:23 mclareni
-* Kernlib
-*
-*
- IDENT POWEZE
-*
-* CERN PROGLIB# B400 POWEZE .VERSION KERNCDC 1.05 780503
-*
- ENTRY POWEZE
-*
-* SUBROUTINE POWEZE(X,A,N)
-*
- NAME VFD 36/6HPOWEZE,24/POWEZE
- POWEZE BSSZ 1 X1= ADR(X)
- SB7 1 B7= 1
- SA2 A1+B7 X2= ADR(A)
- SA5 A2+B7 X5= ADR(N)
-*
- SB2 X2 B2= ADR(A)
- SA3 X1 X3= X
- SA1 X5 X1= N
-*
- SA2 ONE LOAD 1.0 IN X2
- SB3 59
- SB4 B7+B7
- LX0 X1,B3 NEG X0 = ODD POS = EVEN
- SB6 X1+B2 ADDR OF A(N+1) IN B6
- BX6 X2
- SA6 B2 STORE 1.0 IN A(1)
- SB6 B6+B7 ADDR OF A(N+1)+1 IN B6
- FX2 X3*X3 X**2 IN X2
- PL X0,DOWN IF EVEN DO NOT STORE A(2)
- SB2 B2+B7 ADDR OF A(2) IN B2
- BX6 X3 X IN X6
- SA6 B2 STORE X IN A(2)
- DOWN FX7 X6*X2 FIRST PAIR**********
- FX6 X6*X3 N EVEN A(2)=X A(3)=X**2
- SB3 B2+B7 N ODD A(3)=X**2 A(4)=X**3
- SB5 B2+B4
- EQ B3,B6,POWEZE TEST FOR I=1
- LOOP SA6 B3 STORE IN A(J)
- SA7 B5 STORE IN A(J+1)
- FX4 X6*X2 NEXT X**(J)
- FX5 X7*X2 NEXT X**(J+1)
- SB3 B3+B4 INCR STORE ADDR BY 2
- SB5 B5+B4 INCR STORE ADDR BY 2
- BX6 X4
- LX7 X5,B0
- NE B3,B6,LOOP TEST IF LAST A HAS BEEN STORED
- EQ POWEZE
- ONE DATA 1.0
- END
-#ifdef CERNLIB_TCGEN_POWEZE
-#undef CERNLIB_TCGEN_POWEZE
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/proxim.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/proxim.s
deleted file mode 100644
index 79ebfe0..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/proxim.s
+++ /dev/null
@@ -1,44 +0,0 @@
-*
-* $Id: proxim.s,v 1.1.1.1 1996/02/15 17:51:23 mclareni Exp $
-*
-* $Log: proxim.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:23 mclareni
-* Kernlib
-*
-*
- IDENT PROXIM
-*
-* CERN PROGLIB# B102 PROXIM .VERSION KERNCDC 0.1 750820
-*
- ENTRY PROXIM
-* FUNCTION PROXIM (ANGL,STAND)
-* RETURNS THAT (ANGL + N*PI2) WHICH IS THE CLOSEST TO STAND
- VFD 36/6HPROXIM,24/PROXIM
- PROXIM BSS 1
- SA3 X1 X3= ANGL(=A)
- SA2 A1+1
- SA4 X2 X4= STAND
- SA1 PI X1= PI
- SA2 PI2 X2= 2*PI
-*
- LOOP FX5 X3-X4
- NX0 X5 X3= A - STAND
- ZR X0,SORT
- BX6 X2
- NG X0,GOON
- BX0 -X0
- BX6 -X2
- GOON FX5 X1+X0
- NG X5,NEG
- EQ SORT
- NEG FX7 X3+X6
- NX3 X7
- EQ LOOP
- SORT BX6 X3
- EQ PROXIM
- PI DATA 3.14159265
- PI2 DATA 6.28318530
- END
-#ifdef CERNLIB_TCGEN_PROXIM
-#undef CERNLIB_TCGEN_PROXIM
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/rndm.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/rndm.s
deleted file mode 100644
index 60bbacf..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/rndm.s
+++ /dev/null
@@ -1,80 +0,0 @@
-*
-* $Id: rndm.s,v 1.1.1.1 1996/02/15 17:51:23 mclareni Exp $
-*
-* $Log: rndm.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:23 mclareni
-* Kernlib
-*
-*
- IDENT RNDM
-*
-* CERN PROGLIB# V104 RNDM .VERSION KERNCDC 1.02 771015
-*
- ENTRY RNDM,IRNDM,RDMIN,RDMOUT
-*
-* A = RNDM (DUMMY)
-* I = IRNDM (DUMMY)
-* CALL RDMIN (OCT)
-* CALL RDMOUT (OCT)
-*
-* PROGRAM TAKEN FROM CERN PROGLIB 15-OCT-77
-*
- NAME1 VFD 24/4HRNDM,36/RNDM
- RNDM DATA 0
- SA2 R
- SA3 FIVE
- SA4 RNDM
- DX0 X3*X2
- MX1 13
- BX5 -X1*X0
- LX4 30
- SB5 -47
- PX7 X5,B0
- SB7 X4
- NO
- PX1 X5,B5
- SA7 A2
- NX6 X1,B2
- JP B7
- NAME2 VFD 30/5HIRNDM,30/IRNDM
- IRNDM DATA 0
- SA2 R
- SA3 FIVE
- MX1 13
- SA4 IRNDM
- DX0 X3*X2
- FX7 X3*X2
- BX2 -X1*X0
- LX4 30
- SB7 X4
- MX5 49
- BX3 -X5*X7
- PX7 X2,B0
- BX5 X5*X2
- IX6 X5+X3
- SA7 A2
- JP B7
- NAME3 VFD 30/5HRDMIN,30/RDMIN
- RDMIN DATA 0
- SA4 RDMIN
- SA3 X1 ******
- MX1 13
- BX6 -X1*X3
- LX4 30
- SB7 X4
- PX7 X6,B0
- SA7 R
- JP B7
- NAME4 VFD 36/6HRDMOUT,24/RDMOUT
- RDMOUT DATA 0
- SA4 RDMOUT
- SA5 R
- LX4 30
- SB7 X4
- NO
- UX6 B2,X5
- SA6 X1 ****
- JP B7
- R DATA 20000000011060471625B
- FIVE DATA 20000000343277244615B
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/sbit.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/sbit.s
deleted file mode 100644
index 9d7bb4a..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/sbit.s
+++ /dev/null
@@ -1,37 +0,0 @@
-*
-* $Id: sbit.s,v 1.1.1.1 1996/02/15 17:51:23 mclareni Exp $
-*
-* $Log: sbit.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:23 mclareni
-* Kernlib
-*
-*
- IDENT SBIT
-*
-* CERN PROGLIB# M421 SBIT .VERSION KERNCDC 0.1 750820
-*
- ENTRY SBIT
-* SUBROUTINE SBIT (VALUE,WORD,LOC)
-* (WRITTEN FOR SCOPE 3.3 - FTN)
- VFD 24/4HSBIT,36/SBIT
- SBIT BSS 1
- SA5 A1+2
- SA1 X1 X1= VALUE
- MX6 1
- SA3 X5 X3= LOC
- SA4 A5-1
- LX1 59
- SB3 X3
- BX7 X1*X6 MASK LAST BIT OF VALUE
- SA2 X4 X2= WORD
- LX6 X6,B3
- BX4 -X6*X2 CLEAR BIT IN WORD
- LX1 X7,B3
- BX6 X1+X4
- NO
- SA6 A2
- EQ SBIT
- END
-#ifdef CERNLIB_TCGEN_SBIT
-#undef CERNLIB_TCGEN_SBIT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/sbit0.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/sbit0.s
deleted file mode 100644
index 551326c..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/sbit0.s
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: sbit0.s,v 1.1.1.1 1996/02/15 17:51:23 mclareni Exp $
-*
-* $Log: sbit0.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:23 mclareni
-* Kernlib
-*
-*
- IDENT SBIT0
-*
-* CERN PROGLIB# M421 SBIT0 .VERSION KERNCDC 0.1 750820
-*
- ENTRY SBIT0
-* SUBROUTINE SBIT0(WORD,LOC)
-* (WRITTEN FOR SCOPE 3.3 - FTN)
- VFD 30/5HSBIT0,30/SBIT0
- SBIT0 BSS 1
- SA4 A1+1
- MX6 1
- SA1 X1 X1= IWORD
- SA2 X4 X2= LOC
- SB2 X2
- LX3 X6,B2
- BX6 -X3*X1 CLEAR BIT IN WORD
- SA6 A1
- EQ SBIT0
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/sbit1.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/sbit1.s
deleted file mode 100644
index bdfdc2b..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/sbit1.s
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: sbit1.s,v 1.1.1.1 1996/02/15 17:51:23 mclareni Exp $
-*
-* $Log: sbit1.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:23 mclareni
-* Kernlib
-*
-*
- IDENT SBIT1
-*
-* CERN PROGLIB# M421 SBIT1 .VERSION KERNCDC 0.1 750820
-*
- ENTRY SBIT1
-* SUBROUTINE SBIT1(WORD,LOC)
-* (WRITTEN FOR SCOPE 3.3 - FTN)
- VFD 30/5HSBIT1,30/SBIT1
- SBIT1 BSS 1
- SA4 A1+1
- MX6 1
- SA1 X1 X1= IWORD
- SA2 X4 X2= LOC
- SB2 X2
- LX3 X6,B2
- BX6 X1+X3
- SA6 A1
- EQ SBIT1
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/sbyt.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/sbyt.s
deleted file mode 100644
index 215705e..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/sbyt.s
+++ /dev/null
@@ -1,42 +0,0 @@
-*
-* $Id: sbyt.s,v 1.1.1.1 1996/02/15 17:51:23 mclareni Exp $
-*
-* $Log: sbyt.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:23 mclareni
-* Kernlib
-*
-*
- IDENT SBYT
-*
-* CERN PROGLIB# M421 SBYT .VERSION KERNCDC 0.1 750820
-*
- ENTRY SBYT
-* SUBROUTINE SBYT (VALUE,WORD,LOC,NBITS)
-* (WRITTEN FOR SCOPE 3.3 - FTN)
- VFD 24/4HSBYT,36/SBYT
- SBYT BSS 1
- SA5 A1+3 X5= ADDRESS OF NBITS
- SB5 -1
- SA4 X5 X4= NBITS
- MX6 1
- SA5 A5+B5 X5= ADDRESS OF LOC
- SA1 X1 X1= VALUE
- SB6 X4+B5 B6= NBITS-1
- SB4 X4
- AX6 B6,X6
- SA3 X5 X3= LOC
- SA5 A5+B5 X5= ADDRESS OF WORD
- LX6 X6,B4 NBITS BITS ON THE RIGHT
- SB7 X3+B5 B7= LOC-1
- BX7 X1*X6 MASK NBITS BITS OF VALUE
- SA2 X5 X2= WORD
- LX6 X6,B7 SHIFT MASK
- LX1 X7,B7 SHIFT VALUE
- BX7 -X6*X2 ZERO OUT BYTE IN WORD
- BX6 X7+X1 ADD VALUE
- SA6 A2 STORE RESULT
- EQ SBYT
- END
-#ifdef CERNLIB_TCGEN_SBYT
-#undef CERNLIB_TCGEN_SBYT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/sbytor.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/sbytor.s
deleted file mode 100644
index ad3e523..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/sbytor.s
+++ /dev/null
@@ -1,44 +0,0 @@
-*
-* $Id: sbytor.s,v 1.1.1.1 1996/02/15 17:51:23 mclareni Exp $
-*
-* $Log: sbytor.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:23 mclareni
-* Kernlib
-*
-*
- IDENT SBYTOR
-*
-* CERN PROGLIB# M421 SBYTOR .VERSION KERNCDC 0.1 730801
-*
-* SUBROUTINE SBYTOR(A,X,LX,NBITS)
-*
-* ROUTINE WRITTEN BY P. CROZIER FOR FTN
-*
- ENTRY SBYTOR
- VFD 36/6HSBYTOR,24/SBYTOR
- SBYTOR DATA 0
- SB7 -1 B7= -1
- SA2 A1-B7 X2= ADR(X)
- SA3 A2-B7 X2= ADR(LX)
- SA4 A3-B7 X4= ADR(NBITS)
- SA1 X1 X1= A
- SA2 X2 X2= X
- SA4 X4 X4= NBITS
- SA3 X3 X3= LX
- MX0 1 MASK STARTED
- SB5 X4+B7 B5= NBITS-1
- SB4 X4 B4= NBITS
- AX0 B5,X0 MASK ON THE LEFT
- LX0 B4,X0 MASK ON THE RIGHT
- SB3 X3+B7 B3= LX-1
- BX1 X0*X1 CLEAR NON BYTE IN A
- LX1 B3,X1 SHIFT A TO LX
- NO
- NO
- BX6 X2+X1 ADD BYTE FROM A TO X
- SA6 A2 STORE RESULT IN X
- EQ SBYTOR
- END
-#ifdef CERNLIB_TCGEN_SBYTOR
-#undef CERNLIB_TCGEN_SBYTOR
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/sbytpk.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/sbytpk.s
deleted file mode 100644
index 49aad80..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/sbytpk.s
+++ /dev/null
@@ -1,65 +0,0 @@
-*
-* $Id: sbytpk.s,v 1.1.1.1 1996/02/15 17:51:23 mclareni Exp $
-*
-* $Log: sbytpk.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:23 mclareni
-* Kernlib
-*
-*
- IDENT SBYTPK
-*
-* CERN PROGLIB# M422 SBYTPK .VERSION KERNCDC 0.1 730801
-*
-* SUBROUTINE SBYTPK(X,A,J,NBITS)
-*
-* ROUTINE WRITTEN BY P. CROZIER FOR FTN
-*
- ENTRY SBYTPK
- VFD 36/6HSBYTPK, 24/SBYTPK
- SBYTPK DATA 0
- SB7 -1 B7= -1
- SA2 A1+1
- SA3 A2-B7
- SB6 60
- SA4 A3-B7
- SA3 X3 X3= J
- SA5 X4+1 X5= INWORD
- SA4 X4 X4= NBITS
- SX3 X3+B7 X3= J-1
- NO
- SB4 X4 B4= NBITS
- PX7 X3 PACK J-1 INTO X7
- NE B0,B4,NODFLT JUMP IF NBITS NONZERO
- SX5 B6 INWORD= 60
- SX4 -B7 X4= NBITS= 1
- NODFLT PX5 X5 PACK INWORD INTO X5
- NX6 X5 NORMALISE INWORD INTO X6
- FX6 X7/X6 X6= (J-1)/INWORD= JW-1
- MX0 1 START MASK
- SB4 X4+B7 B4= NBITS-1
- PX4 X4 PACK NBITS INTO X4
- SA1 X1 X1= X
- SB2 X2 B2= ADR(A)
- AX0 B4,X0 MASK ON LEFT
- UX6 B5,X6 UNPACK X6 INTO B5 AND X6
- LX6 B5,X6 UNNORMALISE X6 FOR JW-1
- PX3 X6 PACK JW-1 INTO X3
- DX3 X3*X5 X3= (JW-1)*INWORD
- SB4 B4-B7 B4= NBITS
- SB2 X6+B2 B2= ADR(JWORD)
- FX3 X7-X3 X3= JB-1
- DX3 X3*X4 X3= L-1
- SA2 B2 X2= JWORD
- LX0 B4,X0 MASK ON RIGHT
- BX7 X0*X1 MASK OUT NON BYTE IN X
- SB6 X3 B6= L-1
- LX0 B6,X0 SHIFT MASK TO BIT L
- BX6 -X0*X2 MASK OUT BYTE IN JWORD
- LX7 B6,X7 SHIFT BYTE IN X TO L
- BX6 X7+X6 X6= SUM OF BYTES
- SA6 B2 RESTORE RESULT
- EQ SBYTPK
- END
-#ifdef CERNLIB_TCGEN_SBYTPK
-#undef CERNLIB_TCGEN_SBYTPK
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/sortzv.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/sortzv.s
deleted file mode 100644
index 9f4a764..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/sortzv.s
+++ /dev/null
@@ -1,486 +0,0 @@
-*
-* $Id: sortzv.s,v 1.1.1.1 1996/02/15 17:51:23 mclareni Exp $
-*
-* $Log: sortzv.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:23 mclareni
-* Kernlib
-*
-*
- IDENT SORTZV
-*
-* CERN PROGLIB# M101 SORTZV .VERSION KERNCDC 1.16 820129
-*
-* SUBROUTINE SORTZV MODIFIED 23/07/79 BY H.R.RENSHALL/DD/US
-* TO MAKE CODE COMPATIBLE WITH DOCUMENTATION THAT IMPLIES THE 7 TH
-* AND 8 TH PARAMETERS MAY BE LEFT OUT OF THE CALL WHEN CHARACTER
-* SORTING. THIS RESULTS IN WORDS 0 AND 1 BEING OVERWRITTEN.
-* LENGTH OF CORRECTION IS TO CATER FOR REPEATED CALLS OF SORTZV
-* WITH DIFFERENT NUMBERS OF PARAMETERS.
-*
- ENTFTN MACRO (NM,NOPAR,REG)
- LOCAL Z
- NM BSSZ 1
- Z1Z1Z IFNE *F,1
- EQ *+3
- BSSZ 2
- SA2 NM
- SA3 =O5302046000
- BX6 X2+X3
- LX6 30
- SA6 NM+2
- SA3 =O51200000000400000000
- SX4 NM+2
- IX3 X3+X4
- SX4 X4+1
- LX4 30
- BX6 X3+X4
- SA6 A2
- SX6 A0
- SB7 A1
- SA6 NM+3
- Z1Z1 SET 1 DIGITSELECTOR
- DUP NOPAR
- ZR X1,Z
- Z1Z1Z1 IFLT Z1Z1,7 IF FIRST SIX
- SB.Z1Z1 X1
- Z1Z1Z1 ELSE 2
- LX6 X1
- SA6 NM-NOPAR-2+Z1Z1
- Z1Z1Z1 ENDIF
- Z1Z1 SET Z1Z1+1
- Z1Z IFGE NOPAR,Z1Z1
- SA1 A1+1 LOAD NEXT
- Z1Z ENDIF
- ENDD
- Z BSS 0
-Z1Z1Z11 IFC NE,/REG//
-Z1Z1 SET 1
-Z1Z1Z1Z IFC EQ,/REG/X1/
-Z1Z1 SET 2
- BX2 X1
-Z1Z1Z1Z ENDIF
- S_REG A1-B7
- IFNE NOPAR,0
- ZR X.Z1Z1,*+2-$/46
- S_REG REG+1
- BSS 0
- ENDIF
- ENDM
- ENTRY SORTZV
-* SUBROUTINE SORTZV(A,INDEX,N,MODE,NWAY,NSORT,M,CARSET)
-*
-* CORRECTIONS OF 23/07/79. DEFINE ZERO AND ITS ADDRESS.
-ZERO DATA 0 .UNCHANGED ZERO 23/07/79
-* END OF CORRECTIONS.
- M DATA 0 .ADDRESS OF M
- CARSET DATA 0 .ADDRESS OF CARSET
- + VFD 36/0HSORTZV,24/8
-*
-* CORRECTIONS OF 23/07/79. GET THE ACTUAL NUMBER OF PARAMETERS IN X5
-* AND IF LESS THAN 8 LOAD THE ADDRESS OF A WORD CONTAINING ZERO
-* INTO THE LOCATIONS OF M AND CARSET. THIS MUST BE DONE EACH TIME
-* AS THESE ADDRESSES ARE REPLACED BY VALUES AND NOT REFRESHED IN A
-* CALL TO SORTZV WITH LESS PARAMETERS THAN 8.
- ENTFTN SORTZV,8,X5 .GET ACTUAL NO PARMS IN X5
- SX4 7B .WILL TEST AGAINST GT 7 PARMS
- IX5 X5-X4 .SUBTRACT 7 FROM ACTUAL NUMBER
- PL X5,BEGIN .IF POSITIVE BYPASS FIXUP
- SX6 ZERO .PUT ADDRESS OF ZERO INTO X6
- SA6 M .LOAD ADDRESS OF ZERO INTO M
- SA6 CARSET .LOAD ADDRESS OF ZERO INTO CARSET
-* M NOW CONTAINS A VALID ADDRESS ALWAYS.
-* END OF CORRECTIONS.
-BEGIN MX0 59 .X0=-1 LABEL BEGIN ADDED
- SA1 B6 .LOAD NSORT
- SA2 B3 .LOAD N
- MX6 0 .X6=0
- SB6 B2+X0 .ADDRESS INDEX(0)
- SB7 X2 .B7=N
- NZ X1,FILLED .ARRAY INDEX IS PRESET
- LOOP0 IX6 X6-X0 .X6=X6+1
- SB7 B7-1
- SA6 B6+X6 .PRESET FIRST N OF INDEX
- LT B0,B7,LOOP0
- SB7 X2
- FILLED SA3 B5 .LOAD WAY
- SA1 B4 .LOAD MODE
- BX6 X2 .SAVE N
- LX7 X3,B0 .SAVE WAY
- SA6 N
- SA7 WAY
- ZR X1,CHARAC .CHARACTER SORT WANTED
- PL X1,FLOAT .FLOATING SORT WANTED
- SA1 INTSOR1 .MODIFIERS
- SA3 INTSOR2 .
- EQ B0,B0,START
- FLOAT SA1 FLPSOR1
- SA3 FLPSOR2
- START BX6 X1
- LX7 X3,B0
- SB1 B1+X0 .(A(0))
- SB2 B2+X0 .(INDEX(0))
- SA6 LOOP1
- SA7 ALTER+1
- RJ *+1
- BSS 1
- BX6 -X0 .X6=1
- LX7 X2,B0 .X7=N
- SB5 X6 .B5=1
- SB6 B5+B5 .B6=2
- SA6 LL .STORE BOUNDARIES
- SA7 LU
- SA0 A6-B5 .LL(0)
- SB7 A7-B5 .LU(0)
- LOC0 SB6 B6-B5 .P=P-1
- SA1 A0+B6 .LOWER
- SA2 B6+B7 .UPPER
- IX0 X1-X2
- ZR B6,TERMIN
- PL X0,LOC0 .NOT MEANINGFUL
- BX6 X1
- LX7 X2,B0
- SB3 X1+B5
- SB4 X2
- SA6 ILOW
- SA7 A6+B5
- IX0 X6+X7
- AX1 X0,B5
- SA2 X6+B2
- SA4 X1+B2 .LOAD MIDDLE
- BX7 X1
- SA5 X4+B1 .LOAD VALUE
- BX6 X2
- SA7 A6-B5 MIDDLE
- SA6 A4 .INSERT LOWEST TO MIDDLE
- LOOP1 SA1 B2+B3 .GET INDEX OF NEXT ITEM
- SA2 X1+B1 .GET VALUE
- RX0 X5-X2
- + SB3 B3+B5 .INCREASE POINTER
- NO
- NG X0,ALTER .SEQUENCE BROKEN
- TEST GE B4,B3,LOOP1
- LOC1 SA3 MIDDLE
- SA2 A3+B5 ILOW
- BX6 X4 INDEX OF T
- LX7 X1,B0 INDEX OF UPPERMOST IN LOWER
- SB3 X3
- SA6 A1 STORE INTO FINAL LOCATION
- SA7 X2+B2 STORE INTO LOWEST OF LOWER
- SA3 A2+B5 IUPP
- LT B3,B4,LOC2
- SX6 B4+B5 UPPER INTERVAL IS LARGER
- BX7 X3
- LX1 X2,B0 NEXT ILOW
- SX2 B4-B5 NEXT IUPP
- SA6 A0+B6 LL(P)
- SA7 B7+B6 LU(P)
- SB6 B6+B5 P=P+1
- IX0 X1-X2
- JP LOC0+1
- LOC2 SX7 B4-B5 LOWER INTERVAL IS LARGER
- BX6 X2
- LX2 X3,B0 NEXT IUPP
- SX1 B4+B5 NEXT ILOW
- SA6 A0+B6 LL(P)
- SA7 B7+B6 LU(P)
- SB6 B6+B5 P=P+1
- IX0 X1-X2
- JP LOC0+1
- ALTER LT B4,B3,LOC3 .SEARCH IN UPPER INETRVAL FOR
- SA2 B4+B2 .SMALLER ITEM TO SWAP
- SA3 X2+B1
- RX0 X3-X5
- SB4 B4-B5
- PL X0,ALTER
- BX6 X1 .PRPARE SWAP
- LX7 X2,B0
- SA6 A2 .SWAP
- SA7 A1
- NO
- SA1 B4+B2 .RELOAD FOR CASE B4.LT.B3
- EQ B0,B0,TEST
- LOC3 SX0 B4-B5 .UPPERMOST IN LOWER.B4 TO FIRST U
- SA2 ILOW
- IX0 X2-X0
- SB3 B4 .LOWEST IN UPPER
- SB4 B4-B5
- SA1 B4+B2 .UPPERMOST IN LOWER
- NZ X0,LOC1
- BX1 X4 .REPLACE BY ITSELF
- EQ B0,B0,LOC1
- TERMIN SA1 WAY
- SA3 N
- ZR X1,SORTZV .ASCENDING WANTED .DONE
- SB1 B5 .
- SB6 X3 .SWAP ARRAY INDEX TO BE
- AX3 1 .DESCENDING
- SX4 B5 .X4=1
- GE B5,B6,SORTZV .N IS NONSENSE OR ONE
- LOOP10 SA1 B2+B1
- SA2 B2+B6
- BX6 X1
- LX7 X2,B0
- IX3 X3-X4
- SB6 B6-B5
- SB1 B1+B5
- NO
- SA6 A2
- SA7 A1
- NZ X3,LOOP10
- EQ B0,B0,SORTZV
- N DATA 0
- WAY DATA 0
- INTSOR1 SA1 B2+B3 .PLUG IN INSTRUCTIONS
- SA2 X1+B1
- IX0 X5-X2
- FLPSOR1 SA1 B2+B3
- SA2 X1+B1
- FX0 X5-X2
- INTSOR2 IX0 X3-X5
- SB4 B4-B5
- PL X0,ALTER
- FLPSOR2 FX0 X3-X5
- SB4 B4-B5
- PL X0,ALTER .END OF PLUG IN
- CHARAC SA1 M .TO SEE WHICH CHARACTERSET IS TO
- SA2 CARSET .BE USED
- SA3 X1 .LOAD VALUE M
- SB4 X2 .ADDRESS OF CARSET
- MX5 54
- SB1 B1+X0 .ADDRESS OF A(0)
- BX7 X3
- SB2 B2+X0 .ADDRESS OF INSEX(0)
- SB3 X0 .B3=-1
- SA7 A1 .REPLACE ADDRESS M BY VALUE
- GE B0,B7,SORTZV
- NZ X3,TABLE .USER HAS OWN CHARACTERSET
- NORM SB7 10 .SWAP 00 AND 55
- SX3 55B
- SB4 STARTC .NEXT AFTER CONVERSION
- SB6 6
- LOOP2 SA1 B2+X6 .X6=N
- SA2 B1+X1 .LOAD DATA WORD
- IX6 X6+X0 .BUMP DOWN
- SB5 B7
- LOOP3 LX2 X2,B6
- BX1 -X5*X2 .GET CHARACTER
- IX4 X1-X3 .IS IT A BLANK
- SB5 B5+B3
- + NZ X1,*+1 .NOT A 00
- BX2 X2+X3 .INSERT 55
- + NZ X4,*+1 .NOT A 55
- BX2 X5*X2 .CLEAR TO ZERO
- + NZ B5,LOOP3
- BX7 X2
- NO
- NO
- SA7 A2 .STORE BACK
- NZ X6,LOOP2
- SB5 1
- JP B4 .ALLOWS TO USE FOR RECONVERTION
- STARTC SA1 N
- BX6 -X0
- LX7 X1,B0
- SA6 LL
- SA7 LU
- SB5 X6 .B5=1
- SA0 A6-B5 .LL(0)
- SB7 A7-B5 .LU(0)
- SB6 B5+B5
- LOC01 SB6 B6-B5 .P=P-1
- SA1 A0+B6 .LOWER
- SA2 B6+B7 .UPPER
- IX0 X1-X2
- ZR B6,TERMINC
- PL X0,LOC01 .NOT MEANINGFUL
- BX6 X1
- LX7 X2,B0
- SB3 X1+B5
- SB4 X2
- SA6 ILOW
- SA7 A6+B5
- IX0 X6+X7
- AX1 X0,B5
- SA2 X6+B2
- SA4 X1+B2 .LOAD MIDDLE
- BX7 X1
- SA5 X4+B1 .LOAD VALUE
- BX6 X2
- SA7 A6-B5 MIDDLE
- SA6 A4 .INSERT LOWEST TO MIDDLE
- BRANCH NG X5,NEG
- SA1 PLUS
- BX6 X1
- LX7 X1,B0
- EQ B0,B0,CONT
- NEG SA1 NEGATIV
- SA2 NEGAT2
- BX6 X1
- LX7 X2,B0
- CONT SA6 FIRST
- SA7 SECOND
- RJ *+1
- BSS 1
- LOOP11 SA1 B2+B3 .GET INDEX OF NEXT ITEM
- SA2 X1+B1 .GET VALUE
- IX0 X5-X2
- SB3 B3+B5 .INCREASE POINTER
- FIRST BSS 1 .PLUGWORD
- TESTC GE B4,B3,LOOP11
- LOC11 SA3 MIDDLE
- SA2 A3+B5 ILOW
- BX6 X4 INDEX OF T
- LX7 X1,B0 INDEX OF UPPERMOST IN LOWER
- SB3 X3
- SA6 A1 STORE INTO FINAL LOCATION
- SA7 X2+B2 STORE INTO LOWEST OF LOWER
- SA3 A2+B5 IUPP
- LT B3,B4,LOC21
- SX6 B4+B5 UPPER INTERVAL IS LARGER
- BX7 X3
- LX1 X2,B0 NEXT ILOW
- SX2 B4-B5 NEXT IUPP
- SA6 A0+B6 LL(P)
- SA7 B7+B6 LU(P)
- SB6 B6+B5 P=P+1
- IX0 X1-X2
- JP LOC01+1
- LOC21 SX7 B4-B5 LOWER INTERVAL IS LARGER
- BX6 X2
- LX2 X3,B0 NEXT IUPP
- SX1 B4+B5 NEXT ILOW
- SA6 A0+B6 LL(P)
- SA7 B7+B6 LU(P)
- SB6 B6+B5 P=P+1
- IX0 X1-X2
- JP LOC01+1
- ALTERC LT B4,B3,LOC31 .SEARCH IN UPPER INETRVAL FOR
- SA3 B4+B2 .SMALLER ITEM TO SWAP
- SA2 X3+B1
- IX0 X5-X2
- SB4 B4-B5
- SECOND BSS 1 .PLUGWORD
- BX6 X1 .PRPARE SWAP
- LX7 X3,B0
- SA6 A3 .SWAP
- SA7 A1
- NO
- SA1 B4+B2 .RELOAD FOR CASE B4.LT.B3
- EQ B0,B0,TESTC
- LOC31 SX0 B4-B5 .UPPERMOST IN LOWER.B4 TO FIRST U
- SA2 ILOW
- IX0 X2-X0
- SB3 B4 .LOWEST IN UPPER
- SB4 B4-B5
- SA1 B4+B2 .UPPERMOST IN LOWER
- NZ X0,LOC11
- BX1 X4 .REPLACE BY ITSELF
- EQ B0,B0,LOC11
- TERMINC SA1 M
- SA2 N
- SB7 10
- SX3 55B
- SB6 6
- BX6 X2
- SB4 TERMIN
- MX0 59
- SB3 X0
- MX5 54
- ZR X1,LOOP2
- MX5 6
- SB5 6
- EQ B0,B0,CONVERT
- TABLE MX7 59 .USER HAS OWN TABLE NOW BUILT UP
- SB5 77B .A TWO WAY TABLE AND CHECK FOR
- SB7 X6 .COMPLETENESS. B7=N
- LOOP20 SA1 B4+B5 .
- BX6 X5*X1
- SB5 B5+B3
- SA7 TICK+1+B5 .SET UP A TICK OFF TABLE
- SA6 A1
- PL B5,LOOP20
- MX5 6 .B5=-1 NOW
- SB6 X3+B3 .NUMBER OF CHARACTERS SPECIFIED-1
- LOOP21 SB5 B5-B3
- SA1 B4+B5
- BX2 X5*X1 .EXTRACT CHARACTER
- IX7 X7-X0
- LX2 6
- SA4 X2+B4
- BX6 X7+X4
- SA7 TICK+X2
- SA6 A4
- LT B5,B6,LOOP21
- SB3 100B
- SB5 B0
- BX0 -X0
- SA1 TICK+B5
- LOOP22 PL X1,DOWN .CHARACTER IS SPECIFIED
- SA2 B4+B5 .PLACE OF POINTER
- IX7 X7+X0
- BX6 X2+X7
- SB6 B6+X0
- SX4 B5
- SA6 A2
- GE B6,B3,MAD
- SA3 B4+B6
- BX2 -X5*X3
- LX4 54
- BX6 X4+X2
- NO
- SA6 A3
- DOWN SB5 B5+X0
- SA1 A1+1
- LT B5,B3,LOOP22
- SB4 STARTC
- MX4 54
- BX5 -X4
- SB5 B0
- CONVERT SA1 N .CONVERT NWORDS
- SA2 CARSET
- SB6 1
- SB7 X2
- MX4 54
- BX0 X1
- LOOP23 SA1 B2+X0
- SA2 B1+X1
- SB3 10
- LOOP24 LX2 6
- BX3 -X4*X2 .GET CHARACTER
- SA1 B7+X3
- BX6 X5*X1
- LX7 X6,B5 .ADJUST NEW CHARACTER
- SB3 B3-B6
- BX3 X4*X2
- IX2 X3+X7
- NZ B3,LOOP24
- BX6 X2
- SX0 X0-1
- SA6 A2
- NZ X0,LOOP23
- MX0 59
- SB5 B6
- JP B4
- MAD SX6 B7 .X6=N
- SX7 B0
- MX5 54
- BX0 -X0
- SA7 M
- SB3 X0
- EQ B0,B0,NORM
- PLUS NG X2,ALTERC
- NG X0,ALTERC
- NEGATIV PL X2,TESTC
- NG X0,ALTERC
- NEGAT2 PL X2,SECOND+1
- NG X0,ALTERC
- MIDDLE BSS 1
- ILOW BSS 1
- IUPP BSS 1
- LL BSS 40
- LU BSS 40
- TICK EQU LL
- END
-#ifdef CERNLIB_TCGEN_SORTZV
-#undef CERNLIB_TCGEN_SORTZV
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/traat.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/traat.s
deleted file mode 100644
index 3ebae40..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/traat.s
+++ /dev/null
@@ -1,73 +0,0 @@
-*
-* $Id: traat.s,v 1.1.1.1 1996/02/15 17:51:23 mclareni Exp $
-*
-* $Log: traat.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:23 mclareni
-* Kernlib
-*
-*
- IDENT TRAAT
-*
-* CERN PROGLIB# F112 TRAAT .VERSION KERNCDC 0.1 761001
-*
- ENTRY TRAAT
-* SUBROUTINE TRAAT(A,S,M,N)
-* S=A*AT S: SYMETRIC MXM, A: MXN
-* WRITTEN BY ST. MEEN 6-JULY-76-
- VFD 30/5HTRAAT,30/TRAAT
- TRAAT BSS 1
- SB7 1
- SA2 A1+B7
- SA3 A2+B7
- SA4 A3+B7
- SA3 X3
- SA4 X4
- SX7 B7 X7= 1
- SB6 X3 B6= M
- SB7 X4 B7= N
- SB3 B0
- SB4 B0
- SX0 B0
-* B1: INDEX OF A
-* B2: INDEX OF AT
-* B3: INDEX OF S
-* B4: COUNTS ROWS
-* B5: SUMMING INDEX
-* B6: M
-* B7: N
-* X0: A(X0) IS THE FIRST )LEMENT IN ROW B4
-* X3: COUNTS COLUMNS
-* X7: 1
-*
-* NEWROW-LOOP: B4=0,1,...,M-1
- NEWROW SB2 B0
- SX3 B4
-* NEWCOL-LOOP: X3=B4,B4-1,...,0
- NEWCOL SB1 X0
- IX3 X3-X7
- SB5 B0
- MX6 0
-*
-* SUMUP-LOOP: B5=0,...,M-1
-* MULTIPLIES ROW B4 BY ROW X3
- SUMUP SA4 X1+B1
- SA5 X1+B2
- RX5 X4*X5
- RX6 X6+X5
- NX6 B0,X6 X6= X6+S(B1+1)*A(B2+1)
-*
- SB1 B1+X7
- SB2 B2+X7
- SB5 B5+X7
- LT B5,B7,SUMUP
- SA6 X2+B3 S(B3)=X6
- SB3 B3+X7
- PL X3,NEWCOL
- SB4 B4+X7
- SX0 X0+B7 X0= X0+N
- LT B4,B6,NEWROW
- JP TRAAT
- END
-#ifdef CERNLIB_TCGEN_TRAAT
-#undef CERNLIB_TCGEN_TRAAT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/tral.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/tral.s
deleted file mode 100644
index 1d4bf6c..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/tral.s
+++ /dev/null
@@ -1,67 +0,0 @@
-*
-* $Id: tral.s,v 1.1.1.1 1996/02/15 17:51:23 mclareni Exp $
-*
-* $Log: tral.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:23 mclareni
-* Kernlib
-*
-*
- IDENT TRAL
-*
-* CERN PROGLIB# F112 TRAL .VERSION KERNCDC 0.1 761001
-*
- ENTRY TRAL
-* SUBROUTINE TRAL (A,U,B,M,N)
-* WRITTEN BY ST. MEEN 24-JUNE-76
- VFD 24/4HTRAL,36/TRAL
- TRAL BSS 1
- SB7 -1
- SA2 A1-B7
- SA3 A2-B7
- SA4 A3-B7
- SA5 A4-B7
-*
- SX7 -B7 X7= 1
- SA4 X4
- SA5 X5
- SB6 X4 B6= M
- SB7 X5 B7= N
- SB3 B0
-*
-* NEWROW-LOOP: B6=M,M-1,...,1
-NEWROW MX0 0
- SB5 X7 B5= 1
-*
-* NEWCOL-LOOP: B5= 1,...,N X0=0,2,5,...
-* B3 INCREASESE BY 1 EVERY RUN
-NEWCOL SB1 B3
- SB2 X0
- MX6 0
- SB4 B5
-*
-* SUMUP-LOOP: B4=B5,B5+1,...,N
-* MULTIPLIES ROW B5 OF A BY COL M-B6 OF U
- SUMUP SA4 X1+B1
- SA5 X2+B2
- RX5 X4*X5
- RX6 X6+X5
- NX6 B0,X6 X6= X6+A(B1)*U(B2)
-*
- SB1 B1+X7
- SB2 B2+B4
- SB4 B4+X7 B4= B4+1
- GE B7,B4,SUMUP IF B4LE N GOTO SUMUP
-*
- SA6 X3+B3 B(B3)=X6
- SB3 B3+X7
- SB5 B5+X7
- SX0 X0+B5
- GE B7,B5,NEWCOL IF B5 LE N GOTO NEWCOL
-*
- SB6 B6-1
- NE B6,B0,NEWROW IF B6NE 0 GOTO NEWROW
- JP TRAL
- END
-#ifdef CERNLIB_TCGEN_TRAL
-#undef CERNLIB_TCGEN_TRAL
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/tralt.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/tralt.s
deleted file mode 100644
index 70b2b61..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/tralt.s
+++ /dev/null
@@ -1,68 +0,0 @@
-*
-* $Id: tralt.s,v 1.1.1.1 1996/02/15 17:51:24 mclareni Exp $
-*
-* $Log: tralt.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:24 mclareni
-* Kernlib
-*
-*
- IDENT TRALT
-*
-* CERN PROGLIB# F112 TRALT .VERSION KERNCDC 0.1 761001
-*
- ENTRY TRALT
-* SUBROUTINE TRALT (A,U,B,M,N)
-* WRITTEN BY ST. MEEN 25-JUNE-76
- VFD 30/5HTRALT,30/TRALT
- TRALT BSS 1
- SB7 -1
- SA2 A1-B7
- SA3 A2-B7
- SA4 A3-B7
- SA5 A4-B7
-*
- SA4 X4
- SA5 X5
- SB6 X5 B6= N
-*
- DX7 X5*X5
- IX7 X7+X5
- AX7 1 X7= N*(N+1)/2
-*
- DX5 X5*X4
- SB3 X5+B7 B3= M*N-1
-* NEWROW-LOOP: WHILE B3GE 0 (M TIMES)
-*
- NEWROW SB2 X7+B7 B2= N*(N+1)/2-1
-*
- SB4 -B7 B4= 1
-* NEWCOL-LOOP: B4=1,2,...,N
- NEWCOL SB1 B3
- MX6 0
-*
- SB5 B4
-* SUMUP-LOOP: B5=B4,...,N
-* MULTIPLIES ROW B4 OF B! ROW B3 MOD N OF U
- SUMUP SA4 X1+B1
- SA5 X2+B2
- RX5 X4*X5
- RX6 X6+X5
- NX6 B0,X6 X6= X6+A(B1)*U(B2)
-*
- SB1 B1+B7 B1= B1-1
- SB2 B2+B7 B2= B2-1
-*
- SB5 B5-B7 B2= B5+1
- GE B6,B5,SUMUP
-*
- SA6 X3+B3 B(B3)=X6
- SB3 B3+B7
-*
- SB4 B4-B7 B4= B4+1
- GE B6,B4,NEWCOL
- GE B3,B0,NEWROW
- JP TRALT
- END
-#ifdef CERNLIB_TCGEN_TRALT
-#undef CERNLIB_TCGEN_TRALT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/tras.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/tras.s
deleted file mode 100644
index 2bf5041..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/tras.s
+++ /dev/null
@@ -1,82 +0,0 @@
-*
-* $Id: tras.s,v 1.1.1.1 1996/02/15 17:51:24 mclareni Exp $
-*
-* $Log: tras.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:24 mclareni
-* Kernlib
-*
-*
- IDENT TRAS
-*
-* CERN PROGLIB# F112 TRAS .VERSION KERNCDC 0.1 761001
-*
- ENTRY TRAS
-* SUBROUTINE TRAS (A,S,B,M,N)
-* WRITTEN BY ST. MEEN 30-JUNE-76
- VFD 24/4HTRAS,36/TRAS
- TRAS BSS 1
- SB7 -1
- SA2 A1-B7
- SA3 A2-B7
- SA4 A3-B7
- SA5 A4-B7
- SA4 X4
- SA5 X5
-*
-* B1 : INDEX OF A
-* B2 : INDEX OF S
-* B3 : INDEX OF B
-* B4 : COUNTS COLUMNS
-* B5 : SUMMING INDEX
-* B6 : =N
-* B7 : =-1
-* X0 : =M*N-1
-* X7 : S(X7) IS THE LAST ELEMENT OF COLUMN B4
-*
- DX7 X5*X5
- IX7 X7+X5
- AX7 1 X7= N*(N+1)/2
- SB6 X5 B6= N
- DX0 X4*X5
- SX0 X0+B7 X0= M*N-1
- SB3 B0
- SB4 B6+B7 B4= N-1
-*
-* NEW COL-LOOP: B4=N-1,...,0
-* B3= M*N-1,M*N-2,...,M*N-N
- NEWCOL SX7 X7+B7 X7= X7-1
- SB1 X0 B1= M*N-1
- SB3 B3+X0 B3= B3+M*N-1
-*
-* NEWROWLOOP: WHILE B3 GE 0 (M TIMES)
-* B3 DECREASES BY N EVERY RUN
- NEWROW SB2 X7
- MX6 0
- SB5 B6+B7 B5= N-1
-*
-* SUMUP-LOOP: B5=N-U,...,0
-* MULTIPLIES ROW $ OF A BY COL B4 OF S
- SUMUP SA4 X1+B1
- SA5 X2+B2
- RX5 X4*X5
- RX6 X6+X5
- NX6 B0,X6 X6= X6+A(B1+1)*S(B2+1)
-*
- SB1 B1+B7 B1= B1-1
- SB2 B2-B5
- SB5 B5+B7 B5= B5-1
- GE B5,B4,SUMUP
- SB2 B2+B5
- GE B5,B0,SUMUP
-*
- SA6 X3+B3 B(B3+1)=X6
- SB3 B3-B6 B3= B3-N
- GE B3,B0,NEWROW
-*
- SB4 B4+B7 B4= B4-1
- GE B4,B0,NEWCOL
- JP TRAS
- END
-#ifdef CERNLIB_TCGEN_TRAS
-#undef CERNLIB_TCGEN_TRAS
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/trasat.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/trasat.s
deleted file mode 100644
index 4dd5809..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/trasat.s
+++ /dev/null
@@ -1,111 +0,0 @@
-*
-* $Id: trasat.s,v 1.1.1.1 1996/02/15 17:51:24 mclareni Exp $
-*
-* $Log: trasat.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:24 mclareni
-* Kernlib
-*
-*
- IDENT TRASAT
-*
-* CERN PROGLIB# F112 TRASAT .VERSION KERNCDC 1.02 771015
-*
- ENTRY TRASAT
-* SUBROUTINE TRASAT(A,S,R,M,N)
-* R:= A.S.AT , A:MXN, S: SYMETRIC NXN, R: SYMMETRIC MXM.
-* WRITTEN BY ST. MEEN 12-JULY-76
- VFD 36/6HTRASAT,24/TRASAT
- TRASAT BSS 1
- SB7 1
- SA2 A1+B7
- SA3 A2+B7
- SA4 A3+B7
- SA5 A4+B7
-*
- SA4 X4
- SA5 X5
- SB4 X4 B4= M
- SB5 X5 B5= N
-*
-* SETS ALL R-ELEMENTS=0
- DX6 X4*X4
- IX6 X6+X4
- AX6 1
- SB1 X6
- MX6 0
- R SB1 B1-B7
- SA6 X3+B1
- NE B1,B0,R
-*
-* B1: COUNTS ROWS IN R AND A
-* B2: COUNTS COLUMNS IN S
-* B3: SUMMING INDEX, COUNT COLUMNS IN R
-* B4: M
-* B5: N
-* B7: 1
-* X1: INDEX OF A
-* X2: INDEX OF S
-* X3: INDEX OF R
-* A1: ADR(A)
-* A2: ADR(S)
-*
- SA2 X2
- SA1 X1
- SX1 A1
- SB1 B0
-*
-* NEWROW-LOOP: B1,...,M
- NEWROW SB1 B1+B7
- SX2 A2
- SB2 B0
-*
-* NEWSUM-LOOP: B2=0,...,N-1
- NEWSUM SX4 X1
- SX5 X2
- MX0 0
- SB3 B0
-*
-* SUMUP-LOOP:B3=1,2,...,N
-* MULTIPLIES ROW B1 OF A B! COL B2 OF S
- SUMUP SB3 B3+B7
- SA4 X4
- SA5 X5
- RX5 X4*X5
- RX0 X0+X5
- NX0 B0,X0
- SX4 A4+B7
- SX5 A5+B7
- GE B2,B3,SUMUP
- SX5 A5+B3
- LT B3,B5,SUMUP
-*
- SX4 X3
- SB3 B0
- SX5 A1+B2
-* ADDSUM-LOOP B3= 0,...,B1-1
-* MULTIPLIES COL B2 OF A B! X0 AND
-* ADD RESULT TO ROW B1 OF R
- ADDSUM SA5 X5
- RX6 X0*X5
- SA4 X4
- RX6 X6+X4
- NX6 B0,X6
- SA6 A4
-*
- SX4 A4+B7
- SX5 A5+B5
- SB3 B3+B7
- LT B3,B1,ADDSUM
-*
- SB2 B2+B7
- SX2 X2+B2
- LT B2,B5,NEWSUM
-*
- SX1 X1+B5
- SX3 X3+B1
- LT B1,B4,NEWROW
- JP TRASAT
- END
-#ifdef CERNLIB_TCGEN_TRASAT
-#undef CERNLIB_TCGEN_TRASAT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/trata.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/trata.s
deleted file mode 100644
index e9e46a8..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/trata.s
+++ /dev/null
@@ -1,67 +0,0 @@
-*
-* $Id: trata.s,v 1.1.1.1 1996/02/15 17:51:24 mclareni Exp $
-*
-* $Log: trata.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:24 mclareni
-* Kernlib
-*
-*
- IDENT TRATA
-*
-* CERN PROGLIB# F112 TRATA .VERSION KERNCDC 0.1 761001
-*
- ENTRY TRATA
-* SUBROUTINE TRATA(A,S,M,N)
-* S:=AT.A S: SYMETRIC NXN A: NXM
-* WRITTEN BY ST. MEEN 7-JULY-76
- VFD 30/5HTRATA,30/TRATA
- TRATA BSS 1
- SB7 1
- SA2 A1+B7
- SA3 A2+B7
- SA4 A3+B7
- SA3 X3
- SA4 X4
- DX5 X3*X4
- SB6 X5-1 B6= M*N-1
- SB5 X3 B5= M
- SB4 B0
- SB3 B0
-*
-* B1: INDEX OF AT
-* B2: INDEX OF A
-* B3: INDEX OF S
-* B4: COUNTS ROWS
-* B5: M
-* B6: M*N-1
-* B7: 1
-*
-* NEWROW-LOOP: B1=0,...,M
- NEWROW SB2 B0
-* NEWCOL-LOOP: B2= 0,1,...,B4
- NEWCOL SB1 B4
- MX6 0
-*
-* SUMUP-LOOP: WHILE B2.LE. M*N-1 (N TIMES)
-* MULTIPLIES COLUMN B4 B! COOUMN B2
- SUMUP SA4 X1+B1
- SA5 X1+B2
- RX5 X4*X5
- RX6 X6+X5
- NX6 B0,X6 X6= X6+A(B1)*A(B2)
-*
- SB1 B1+B5 B1= B1+M
- SB2 B2+B5 B2= B2+M
- GE B6,B2,SUMUP B2.LE.M*N-1
-*
- SA6 X2+B3 S(B3)=X6
- SB3 B3+B7 B3= B3+1
- SB2 B2-B6 B2= B2-M*N+1
- GE B4,B2,NEWCOL B2.LE.B4
- SB4 B4+B7 B4= B4+1
- LT B4,B5,NEWROW B4.LT.M
- JP TRATA
- END
-#ifdef CERNLIB_TCGEN_TRATA
-#undef CERNLIB_TCGEN_TRATA
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/trats.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/trats.s
deleted file mode 100644
index ea48268..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/trats.s
+++ /dev/null
@@ -1,74 +0,0 @@
-*
-* $Id: trats.s,v 1.1.1.1 1996/02/15 17:51:24 mclareni Exp $
-*
-* $Log: trats.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:24 mclareni
-* Kernlib
-*
-*
- IDENT TRATS
-*
-* CERN PROGLIB# F112 TRATS .VERSION KERNCDC 0.1 761001
-*
- ENTRY TRATS
-* SUBROUTINE TRATS(A,S,B,M,N)
-* WRITTEN BY ST. MEEN 6-JULY-76
- VFD 30/5HTRATS,30/TRATS
- TRATS BSS 1
- SB7 -1
- SA2 A1-B7
- SA3 A2-B7
- SA4 A3-B7
- SA5 A4-B7
- SA1 X1
- SA4 X4
- SA5 X5
-*
- BX1 -X4 X1= -N
- SB6 X5 B6= N
- DX7 X5*X5
- IX7 X7+X5
- AX7 1 X7= N*(N+1)/2
- DX0 X5*X4
- SX0 X0+B7 X0= M*N-1
- SB4 X5 B4= N
- SB3 B0
-*
-* NEWCOL-LOOP: B4=N-1,...,0
-* B3=M*N-1,M*N-2,...,M*N-N
- NEWCOL SB4 B4+B7
- SB3 B3+X0 B3= B3+M*N-1
- SB1 B0
- SX7 X7+B7
-*
-* NEWROW-LOOP: WHILE B3 GE0
-* B3 DECREASES BY N EVERY RUN M TIMES
- NEWROW SB1 B1+X0
- SB5 B6+B7 B5= N-1
- SB2 X7
- MX6 0
-*
-* SUMUP-LOOP: B5=N-1,...,0
-* MULTIPLIES ROW M*N-B3 OF A BY ROW B4 OF S
- SUMUP SA4 A1+B1
- SA5 X2+B2
- RX5 X4*X5
- RX6 X6+X5
- NX6 B0,X6 X6= X6+S(B1+1)*A(B2+1)
-*
- SB1 B1+X1 B1= B1-M
- SB2 B2-B5
- SB5 B5+B7
- GE B5,B4,SUMUP
- SB2 B2+B5
- GE B5,B0,SUMUP
-*
- SA6 B3+X3 B(B3+1)=X6
- SB3 B3-B6 B3= B3-N
- GE B3,B0,NEWROW
- NE B4,B0,NEWCOL
- JP TRATS
- END
-#ifdef CERNLIB_TCGEN_TRATS
-#undef CERNLIB_TCGEN_TRATS
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/tratsa.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/tratsa.s
deleted file mode 100644
index 6b894f8..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/tratsa.s
+++ /dev/null
@@ -1,112 +0,0 @@
-*
-* $Id: tratsa.s,v 1.1.1.1 1996/02/15 17:51:24 mclareni Exp $
-*
-* $Log: tratsa.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:24 mclareni
-* Kernlib
-*
-*
- IDENT TRATSA
-*
-* CERN PROGLIB# F112 TRATSA .VERSION KERNCDC 1.02 771015
-*
- ENTRY TRATSA
-* SUBROUTINE TRATSA(A,S,R,M,N)
-* R:= AT.S.A , A: NXM, S: SYMETRIC NXN, R: SYMMETRIC MXM
-* WRITTEN BY ST.MEEN 13-JULY-76
- VFD 36/6HTRATSA,24/TRATSA
- TRATSA BSS 1
- SB7 1
- SA2 A1+B7
- SA3 A2+B7
- SA4 A3+B7
- SA5 A4+B7
-*
- SA4 X4
- SA5 X5
- SB4 X4 B4= M
- SB5 X5 B5= N
-*
-* SETS ALL R-ELEMENTS=0
- DX6 X4*X4
- IX6 X6+X4
- AX6 1
- SB1 X6
- MX6 0
- R SB1 B1-B7
- SA6 X3+B1
- NE B1,B0,R
-*
-* B1: COUNTS ROWS IN R AND A
-* B2: COUNTS COLUMNS IN S
-* B3: SUMMING INDEX, COUNT COLUMNS IN R
-* B4: M
-* B5: N
-* B7: 1
-* X1: INDEX OF A
-* X2: INDEX OF S
-* X3: INDEX OF R
-* A1: ADR(A)
-* A2: ADR(S)
-*
- SA2 X2
- SA1 X1
- SB1 B0
-*
-* NEWROW-LOOP: B1= 0,...,M-1
- NEWROW SX2 A2
- SX1 A1
- SB2 B0
-*
-* NEWSUM-LOOP: B2=0,...,N-1
- NEWSUM SX4 A1+B1
- SX5 X2
- MX0 0
- SB3 B0
-*
-* SUMUP-LOOP: B3=1,...,N
-* MULTIPLIES COL B1 OF A BY COL B2 OF S
-* RESULT IN X0
- SUMUP SB3 B3+B7
- SA4 X4
- SA5 X5
- RX5 X4*X5
- RX0 X0+X5
- NX0 B0,X0
- SX4 A4+B4
- SX5 A5+B7
- GE B2,B3,SUMUP
- SX5 A5+B3
- LT B3,B5,SUMUP
-*
- SX4 X3
- SB3 B0
- SX5 X1
-* ADDSUM-LOOP: B3= 0,...,B1
-* MULTIPLIES ROW B2 OF A B! X0 AND ADD
-* TO ROW B1 OF R
- ADDSUM SA5 X5
- RX6 X0*X5
- SA4 X4
- RX6 X6+X4
- NX6 B0,X6
- SA6 A4
-*
- SX4 A4+B7
- SX5 A5+B7
- SB3 B3+B7
- GE B1,B3,ADDSUM
-*
- SB2 B2+B7
- SX1 X1+B4
- SX2 X2+B2
- LT B2,B5,NEWSUM
-*
- SB1 B1+B7
- SX3 X3+B1
- LT B1,B4,NEWROW
- JP TRATSA
- END
-#ifdef CERNLIB_TCGEN_TRATSA
-#undef CERNLIB_TCGEN_TRATSA
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/trchlu.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/trchlu.s
deleted file mode 100644
index 8ac440c..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/trchlu.s
+++ /dev/null
@@ -1,135 +0,0 @@
-*
-* $Id: trchlu.s,v 1.1.1.1 1996/02/15 17:51:24 mclareni Exp $
-*
-* $Log: trchlu.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:24 mclareni
-* Kernlib
-*
-*
- IDENT TRCHLU
-*
-* CERN PROGLIB# F112 TRCHLU .VERSION KERNCDC 0.1 761001
-*
- ENTRY TRCHLU
- EXT SQRT.
-* SUBROUTINE TRCHLU(S,A,M)
-* A.AT=S, A: TRIANGULAR MXM, S: SYMMETRIC MXM
-* WRITTEN BY ST. MEEN 23-JULY-76
-*
-* 1. S IS POSITIV-DEFINIT :OK
-* 2. S IS NOT POSITIV-SEMI-DEFINIT : ABORT
-* 3. IF ONE DIAGONALELEMENT OF S IS ZERO , RESULT OF CORRESPONDING
-* ROW AND COLUMN IS ZERO
-* 4. IF ONE DIAGONAL-ELEMENT OF S IS NEGATIV : NOT OK
-* 5. S IS POSITIV-SEMI-DEFINIT AND HAS NO CORRESPONDING ZERO-
-* ELEMENT IN THE DIAGONAL : MAY ABORT
-*
-* B1: INDEX OF LOOP1
-* B2: INDEX OF LOOP2
-* B3: A,S(B3) IS DIAGONAL-ELEMENTS
-* B4: POINTS TO THE ELEMENTS OF COLUMN B1
-* B5: INDEX OF SUMUP-LOOP
-* B6: M
-* B7: 1
-* X0: ACCUMULATOR IN SUMUP-LOOP
-* X1: ADR(S)
-* X2: ADR(A)
-* X3: S(B3) DIAG-ELEM OF S, 1/A(B3) (A(B3) DIAG-ELEM)
-*
- VFD 36/6HTRCHLU,24/TRCHLU
- TRCHLU BSS 1
- SB7 1
- SA2 A1+B7
- SA3 A2+B7
- SA3 X3
- SB6 X3 B6= M
-*
-* LOOP1: B1=1,2,...,M B3=0,2,5,9,....
- SB3 -B7
- SB1 B0
- LOOP1 SB1 B1+B7 B1= B1+1
- SB3 B3+B1
- SB4 B3
- SA3 X1+B3 X3= DIAG-ELEM NO B1 OF S
-*
-* LOOP2: B2=B1,B1+1,...,M
- SB2 B1
- LOOP2 MX0 0
- EQ B1,B7,ONE FIRST TIME IN LOOP2: NO SUMMING
- ZR X3,ZERO HAS FOUND A ZERO-DIAG-ELEM: SEE POINT
- SB5 B3-B1
- SB5 B5+B7 B5= B3-B1+1
- SX5 B4-B1
- SX5 X5+B7
- IX5 X5+X2 X5= B4-B1+1+X2
-*
-* SUMUP-LOOP: B5: B3-B1+1,...,B3-1
-* MULTIPLIES ROW B1 WITH ROW B2 OF A
-* RESULT IN X0
- SUMUP SA4 B5+X2
- SA5 X5
- RX5 X4*X5
- RX0 X0+X5
- NX0 B0,X0
- SB5 B5+B7
- SX5 A5+B7
- LT B5,B3,SUMUP
-*
- ONE SA4 B4+X1
- RX0 X4-X0
- NX0 B0,X0 X0= S(B4)-X0
- ZERO EQ B1,B2,ROOT EVERY FIRST TIME IN LOOP2 DIAG-ELEM A
- RX6 X0*X3 = SQRT(X0) AND X3=1/A(B4)
- SA6 X2+B4 ELSE A(B4)= X0/A(B3) =X0*X3
- RETROOT SB4 B4+B2
- SB2 B2+B7
- GE B6,B2,LOOP2
-*
- LT B1,B6,LOOP1
-*
- JP TRCHLU
-*
- ROOT BX6 X1 B3= B4
- SA6 STORE FIRST STORE ALL RELEVAT REGISTERS
- BX6 X2
- SA6 A6+B7
- BX6 X3
- SA6 A6+B7
- SX6 B1
- SA6 A6+B7
- SX6 B2
- SA6 A6+B7
- SX6 B3
- SA6 A6+B7
- SX6 B6
- SA6 A6+B7
-*
- BX1 X0
-+RJSQRT
-- VFD 30/TRCHLU
-*
- SB7 1 LOAD REGISTERS
- SA1 STORE
- SA2 A1+B7
- SA3 A2+B7
- SA4 A3+B7
- SB1 X4
- SA4 A4+B7
- SB2 X4
- SA4 A4+B7
- SB3 X4
- SB4 B3
- SA4 A4+B7
- SB6 X4
-*
- SA6 X2+B4 A(B4)= X6= SQRT(X0)
- NG X3,Z
- ZR X3,Z IF X3 .GT. 0 X3= 1/SQRT(X0)
- SA5 =1.0
- RX3 X5/X6
- Z JP RETROOT
- STORE BSS 7
- END
-#ifdef CERNLIB_TCGEN_TRCHLU
-#undef CERNLIB_TCGEN_TRCHLU
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/trchul.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/trchul.s
deleted file mode 100644
index 1835b8f..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/trchul.s
+++ /dev/null
@@ -1,152 +0,0 @@
-*
-* $Id: trchul.s,v 1.1.1.1 1996/02/15 17:51:24 mclareni Exp $
-*
-* $Log: trchul.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:24 mclareni
-* Kernlib
-*
-*
- IDENT TRCHUL
-*
-* CERN PROGLIB# F112 TRCHUL .VERSION KERNCDC 0.1 761001
-*
- ENTRY TRCHUL
- EXT SQRT.
-* SUBROUTINE TRCHUL(S,A,M)
-* AT.A=S, A:TRIANGULARMXM, S: SYMMETRIC MXM
-* WRITTEN BY ST. MEEN 23-JULY-76
-*
-* 1. S IS POSITIV-DEFINIT :OK
-* 2. S IS NOT POSITIV-SEMI-DEFINIT : ABORT
-* 3. IF ONE DIAGONALELEMENT OF S IS ZERO , RESULT OF CORRESPONDING
-* ROW AND COLUMN IS ZERO
-* 4. IF ONE DIAGONAL-ELEMENT OF S IS NEGATIV : NOT OK
-* 5. S IS POSITIV-SEMI-DEFINIT AND HAS NO CORRESPONDING ZERO-
-* ELEMENT IN THE DIAGONAL : MAY ABORT
-*
-* X0: ACCUMULATOR IN SUMING-LOOP
-* X1: ADR(S)
-* X2: ADR(A)
-* X3: DIAGONAL-ELEMENT NO B1 OF S,
-* OR: 1/A(B3) (A(B3): DIAGONAL-ELEMENT )
-*
-* B1: INDEX OF LOOP1
-* B2: INDEX OF SUMUP-LOOP
-* B3: A(B3), S(B3) IS DIAGONAL-ELEMENTS
-* B4: FIRST SIGNIFIKANT ELEMENT OF ACOLUMN WE WANT TO
-* MULTIPLY WITH COLUMN B1
-* B5: TEST REGISTER FOR LOOP2
-* B6: M
-* B7: 1
-*
- VFD 36/6HTRCHUL,24/TRCHUL
- TRCHUL BSS 1
- SB7 1
- SA2 A1+B7
- SA3 A2+B7
- SA3 X3
- SB6 X3 B6= M
-*
- DX5 X3*X3
- IX5 X5+X3
- AX5 1
- SB4 X5-1 B4= M*(M+1)/2-1
-*
-* LOOP1: B1=M,M-1,...,1
- SB1 B6
- LOOP1 SB3 B4 S,A(B3) IS THE NEXT DIAG.ELEM.
- SA3 X1+B3 PICK UP DIAGONAL-ELEMENT NO B1 OF S
- SB5 B3-B1
-*
-* LOOP2: B4=B3,B3-1,...,B3-B1+1
- LOOP2 MX0 0
- EQ B1,B6,MM FIRST TIME IN LOOP2 : NO SUMMING, X0=
- ZR X3,ZERO HAS FOUND A ZERO-DIAG-ELE: SEE POINT
-*
- SX4 B3+B1
- SX5 B4+B1
- IX4 X4+X2 X4= X2+B3+B1
- IX5 X5+X2 X5= X2+B4+B1
-* SUMUP-LOOP:B2=B1,B1+1,...,M
-* MULTIPLIES COL NO B1 WITH COL GIVEN BY B4
-* RESULT IN X0
- SB2 B1
- SUMUP SB2 B2+B7
- SA4 X4
- SA5 X5
- RX5 X4*X5
- RX0 X0+X5
- NX0 B0,X0
-*
- SX4 A4+B2
- SX5 A5+B2
- LT B2,B6,SUMUP
-*
- MM SA4 B4+X1
- RX0 X4-X0
- NX0 B0,X0 X0= S(B4)-X0
-*
- ZERO EQ B4,B3,ROOT IF S(B4) IS DIAG-ELEMENT A(B4)=SQRT(X
-* AND X3=1/SQRT(X0)
-* (THIS HAPPENS EVERY FIRST RUN IN LOOP2)
-* ELSE A(B4)=X0/SQRT(-X0-)=X0*X3
- RX6 X0*X3
- SA6 X2+B4
-*
- RETROOT SB4 B4-B7 B4= B4-1
- LT B5,B4,LOOP2
-*
- SB1 B1-B7 B1= B1-1
- LT B0,B1,LOOP1
-*
- JP TRCHUL FINISH
-*
- ROOT BX6 X1
-* B3=B4
-* FIRST STORE THE REGISTERS
- SA6 STORE
- BX6 X2
- SA6 A6+B7
- BX6 X3
- SA6 A6+B7
- SX6 B1
- SA6 A6+B7
- SX6 B2
- SA6 A6+B7
- SX6 B3
- SA6 A6+B7
- SX6 B6
- SA6 A6+B7
-*
- BX1 X0
-+RJSQRT
-- VFD 30/TRCHUL
-*
-* LOAD REGISTERS
- SB7 1
- SA1 STORE
- SA2 A1+B7
- SA3 A2+B7
- SA4 A3+B7
- SB1 X4
- SA4 A4+B7
- SB2 X4
- SA4 A4+B7
- SB3 X4
- SB4 B3
- SB5 B3-B1
- SA4 A4+B7
- SB6 X4
-*
- SA6 X2+B4 A(B4)=X6=SQRT(X0)
- NG X3,Z
- ZR X3,Z
-* IF DIAG.ELEM. S(B4) GT 0 THEN X3=1/SQRT(X0)
- SA5 =1.0
- RX3 X5/X6
- Z JP RETROOT
- STORE BSS 7
- END
-#ifdef CERNLIB_TCGEN_TRCHUL
-#undef CERNLIB_TCGEN_TRCHUL
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/trinv.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/trinv.s
deleted file mode 100644
index db073f1..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/trinv.s
+++ /dev/null
@@ -1,77 +0,0 @@
-*
-* $Id: trinv.s,v 1.1.1.1 1996/02/15 17:51:24 mclareni Exp $
-*
-* $Log: trinv.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:24 mclareni
-* Kernlib
-*
-*
- IDENT TRINV
-*
-* CERN PROGLIB# F112 TRINV .VERSION KERNCDC 0.1 761001
-*
- ENTRY TRINV
-* SUBROUTINE TRINV(S,S1,M)
-* S1= INV(S) S,S1: LOWER TRIANGULAR MXM
-* WRITTEN BY ST. MEEN 22-JULY-76
- VFD 30/5HTRINV,30/TRINV
- TRINV BSS 1
- SB7 -1
- SA2 A1-B7
- SA3 A2-B7
- SA3 X3
-*
- SB3 X3 B3= M
- SB1 -B7 B1= 1
- SB5 B0
- SB6 B0
- SA3 =1.0 X3= 1,0
-*
-* LOOP1: B1=1,2,...,M B6=0,2,5,9,...
- LOOP1 SA5 X1+B6 X5= DIAG-ELEM NO B1 OF S
- MX6 0
- NG X5,Z
- ZR X5,Z IF X5 .GT. 0 THEN X6=1/X5 ELSE X6=0
- RX6 X3/X5
- Z SA6 X2+B6 S1(B6) =X6 (DIAG-ELEM)
- BX6 -X6 X6= -X6
- SB4 B0
-*
-* LOOP2: B4=-1,-2,...UNTIL B5=B6
-* B5 INCREASES BY 1 EVERY RUN
- EQ B5,B6,OUT
- LOOP2 MX7 0
- ZR X6,ZERO
- SB2 -B1
- SB4 B4+B7
- SX4 X2+B5
- SX5 X1+B6
-*
-* "MULTIPLIES" ROW B1 OF S BY COL B4 OF S1
-* EXEPT DIAG-ELEM, RESULT IN X7
-* SUMUP-LOOP: B2=-B1+1,-B1+2,...,-B4
- SUMUP SB2 B2-B7
- SA4 X4+B2
- SA5 X5+B7
- RX5 X5*X4
- RX7 X7+X5
- NX7 B0,X7
- SX4 A4
- SX5 A5
- LT B2,B4,SUMUP
-*
- RX7 X6*X7 X7= X6*X7=-X7/S(B6)
- ZERO SA7 X2+B5 S1(B1)= X7
- SB5 B5-B7
- NE B5,B6,LOOP2
-*
- OUT SB5 B5-B7 B5= B5+1
- SB1 B1-B7 B1= B1+1
- SB6 B6+B1
- GE B3,B1,LOOP1
-*
- JP TRINV
- END
-#ifdef CERNLIB_TCGEN_TRINV
-#undef CERNLIB_TCGEN_TRINV
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/trla.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/trla.s
deleted file mode 100644
index 28c8c4e..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/trla.s
+++ /dev/null
@@ -1,66 +0,0 @@
-*
-* $Id: trla.s,v 1.1.1.1 1996/02/15 17:51:24 mclareni Exp $
-*
-* $Log: trla.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:24 mclareni
-* Kernlib
-*
-*
- IDENT TRLA
-*
-* CERN PROGLIB# F112 TRLA .VERSION KERNCDC 0.1 761001
-*
- ENTRY TRLA
-* SUBROUTINE TRLA (U,A,B,M,N)
-* WRITTEN BY ST. MEEN 21-JUNE-76
- VFD 24/4HTRLA,36/TRLA
- TRLA BSS 1
- SB7 1
- SA2 A1+B7
- SA3 A2+B7
- SA4 A3+B7
- SA5 A4+B7
-*
- SA4 X4 X4= M
- SA5 X5
- SB5 X5 B5= N
- DX5 X4*X5
- SB3 X5-1 B3= M*N -1
-*
- DX5 X4*X4
- IX5 X5+X4
- AX5 1
- SB4 X5-1 B4= M*(M+1)/2-1
- SB6 -B5 B6= -N
-*
-* NEWROW-LOOP: WHILE B4 GE 0 (M TIMES)
- NEWROW BSS 0
-* NEWCOL-LOOP WHILE B2 GT -N (N TIMES
- NEWCOL SB2 B3
- SB1 B4
- MX7 0
-*
-* SUMUP-LOOP: B2=B3,B3-N,... WHILE B2 GT 0
-* MULTIPLIES ROW B3/M OF U BY COL B3 MOD N
-* RESULT IN B(B3)
- SUMUP SA4 X1+B1
- SA5 X2+B2
- RX5 X4*X5
- RX7 X7+X5
- NX7 B0,X7 X7= X7+U(B1)*A(B2)
-*
- SB1 B1-B7 B1= B1-1
- SB2 B2-B5 B2= B2-N
- GE B2,B0,SUMUP
-*
- SA7 X3+B3 B(B3)=X7
- SB3 B3-B7 B3= B3-1
- LT B6,B2,NEWCOL
-*
- SB4 B1
- GE B4,B0,NEWROW
- JP TRLA
- END
-#ifdef CERNLIB_TCGEN_TRLA
-#undef CERNLIB_TCGEN_TRLA
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/trlta.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/trlta.s
deleted file mode 100644
index d88d541..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/trlta.s
+++ /dev/null
@@ -1,84 +0,0 @@
-*
-* $Id: trlta.s,v 1.1.1.1 1996/02/15 17:51:24 mclareni Exp $
-*
-* $Log: trlta.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:24 mclareni
-* Kernlib
-*
-*
- IDENT TRLTA
-*
-* CERN PROGLIB# F112 TRLTA .VERSION KERNCDC 0.1 761001
-*
- ENTRY TRLTA
-* SUBROUTINE TRLTA (U,A,B,M,N)
-* B=U.A, U: LOWER TRIANGULAR MXM, A: MXN, B: MXN.
-* WRITTEN BY ST. MEEN 22 JUNE-76
- VFD 30/5HTRLTA,30/TRLTA
- TRLTA BSS 1
- SB7 1
- SA2 A1+B7
- SA3 A2+B7
- SA4 A3+B7
- SA5 A4+B7
- SA1 X1
-*
- SA4 X4
- SA5 X5 X5= N
- SX7 B7 X7= 1
- DX0 X5*X4
- IX0 X0+X5
- IX0 X7-X0 X0= 1-(M*N+N)
- BX1 X5 X1= N
- SB7 X4 B7= M
- SB3 B0
- SB4 B0
- SB6 X7 B6= 1
-*
-* B1: INDEX OF U
-* B2: INDEX OF A
-* B3: INDEX OF B
-* B4: U(B4) IS THE FIRST ELEMENT IN ROW B6
-* B5: U(B1+B5) IS TO THE RIGHT OF U(B1)
-* B6: COUNTS WHICH ROW IN U AND B
-* B7: M
-* X0: 1-(M*N+N)
-* X1: N
-* X7: 1
-*
-* NEWROW-LOOP: B6=1,2,...,M B4=0,2,5,9,......
- NEWROW BSS 0
-* NEWCOL-LOOP N TIMES B1= B4,B1+B5,...
-* B3 INCREASES EVERY RUN
- NEWCOL SB1 B4
- SB5 B6
- SB2 B3
- MX6 0
-*
-* SUMUP-LOOP: B5=B6,B6+1,...,M
-* MULTIPLIES COLUMN B6 OF U BY COL $=1,..,N
- SUMUP SA4 A1+B1
- SA5 X2+B2
- RX5 X4*X5
- RX6 X6+X5
- NX6 B0,X6 X6= X6+U(B1)*A(B2)
-*
- SB1 B1+B5 B1= B1+B5
- SB2 B2+X1 B2= B2+N
- SB5 B5+X7 B5= B5+1
- GE B7,B5,SUMUP
-*
- SA6 X3+B3 B(B3)=X6
- SB3 B3+X7 B3= B3+1
- SB2 B2+X0 IF B2 GT M*N+N-1 GO TO NEWCOL
- LT B2,B0,NEWCOL
-*
- SB6 B6+X7 B6= B6+1
- SB4 B4+B6
- GE B7,B6,NEWROW
-*
- JP TRLTA
- END
-#ifdef CERNLIB_TCGEN_TRLTA
-#undef CERNLIB_TCGEN_TRLTA
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/trpck.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/trpck.s
deleted file mode 100644
index c70f3fa..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/trpck.s
+++ /dev/null
@@ -1,46 +0,0 @@
-*
-* $Id: trpck.s,v 1.1.1.1 1996/02/15 17:51:24 mclareni Exp $
-*
-* $Log: trpck.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:24 mclareni
-* Kernlib
-*
-*
- IDENT TRPCK
-*
-* CERN PROGLIB# F112 TRPCK .VERSION KERNCDC 0.1 761001
-*
- ENTRY TRPCK
-* SUBROUTINE TRPCK(A,S,M)
-* S:=A , A: MXM, S: SYMETRIC MXM
-* WRITTEN BY ST.MEEN 14-JULY-76
- VFD 30/5HTRPCK,30/TRPCK
- TRPCK BSS 1
- SB7 1
- SA2 A1+B7
- SA3 A2+B7
- SA3 X3
- SB1 B0
- SB3 X3 B3= M
-*
-* NEWROW-LOOP: B1=1,...,M
- NEWROW SB1 B1+B7
- SB5 X1
- SB2 B5+B1
-*
-* NEWCOL-LOOP: B5=X1,X1+1,...,X1+B1-1
-* COPY S(X2)=A(B5)
- NEWCOL SA5 B5
- BX6 X5
- SA6 X2
- SB5 B5+B7
- SX2 X2+B7
- LT B5,B2,NEWCOL
-*
- SX1 X1+B3 X1= X1+M
- LT B1,B3,NEWROW
- JP TRPCK
- END
-#ifdef CERNLIB_TCGEN_TRPCK
-#undef CERNLIB_TCGEN_TRPCK
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/trqsq.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/trqsq.s
deleted file mode 100644
index 7baf672..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/trqsq.s
+++ /dev/null
@@ -1,108 +0,0 @@
-*
-* $Id: trqsq.s,v 1.1.1.1 1996/02/15 17:51:24 mclareni Exp $
-*
-* $Log: trqsq.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:24 mclareni
-* Kernlib
-*
-*
- IDENT TRQSQ
-*
-* CERN PROGLIB# F112 TRQSQ .VERSION KERNCDC 0.1 761001
-*
- ENTRY TRQSQ
-* SUBROUTINE TRQSQ(Q,S,R,M)
-* R:= Q.S.Q , Q,S,R: SYMETRIC MXM.
-* WRITTEN BY ST. MEEN 19-JULY-76
- VFD 30/5HTRQSQ,30/TRQSQ
- TRQSQ BSS 1
- SB7 1
- SA2 A1+B7
- SA3 A2+B7
- SA4 A3+B7
-*
- SA4 X4
- SB4 X4 B4= M
-*
-* SETS ALL R-ELEMENTS=0
- DX6 X4*X4
- IX6 X6+X4
- AX6 1
- SB1 X6 B1= M*(M+1)/2
- MX6 0
- R SB1 B1-B7
- SA6 X3+B1
- NE B1,B0,R
-*
-* B1: COUNT ROWS IN R AND Q
-* B2: COUNTS COLUMNS IN S AND Q
-* B3: SUMMING INDEX, COUNT COLUMNS IN R
-* B4: M
-* B5: S(B5+X1), R(B5+X3) IS FIRST ELEMENT IN ROW B1
-* B6: S(B6+X2), Q(B6+X1) FIRST ELEMENT IN COLUMN B2
-* B7: 1
-* X1: ADR(Q)
-* X2: ADR(S)
-* X3: ADR(R)
-*
- SB5 B0
- SB1 B0
-*
-* NEWROW-LOOP: B1 =1,...,M
- NEWROW SB1 B1+B7
- SB6 B0
- SB2 B0
-* NEWSUM-LOOP: B2=0,...,M-1
-*
- NEWSUM SX4 B5+X1
- SX5 B6+X2
-*
- MX0 0
- SB3 B0
-* SUMUP-LOOP: B3=1,...,M
-* MULTIPLIES ROW B1 OF Q BY ROW B2 OF S
-* RESULT IN X0
- SUMUP SB3 B3+B7
- SA4 X4
- SA5 X5
- RX5 X4*X5
- RX0 X0+X5
- NX0 B0,X0
- SX4 A4+B7
- LT B3,B1,L1
- SX4 A4+B3
- L1 SX5 A5+B7
- GE B2,B3,SUMUP
- SX5 A5+B3
- LT B3,B4,SUMUP
-*
- SX4 B5+X3
- SX5 B6+X1
- SB3 B0
-* ADDSUM-LOOP : B3=1,...,B1-1
-* MULTIPLIES ROW B2 OF Q BY X0 AND
-* ADD IT TO ROW B1 OF R
- ADDSUM SA5 X5
- SA4 X4
- RX6 X0*X5
- RX6 X6+X4
- NX6 B0,X6
- SA6 A4 R(A4)=R(A4)+X0*Q(A5)
-*
- SX4 A4+B7
- SB3 B3+B7
- SX5 A5+B7
- GE B2,B3,L2
- SX5 A5+B3
- L2 LT B3,B1,ADDSUM
-*
- SB2 B2+B7
- SB6 B6+B2
- LT B2,B4,NEWSUM
- SB5 B5+B1
- LT B1,B4,NEWROW
- JP TRQSQ
- END
-#ifdef CERNLIB_TCGEN_TRQSQ
-#undef CERNLIB_TCGEN_TRQSQ
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/trsa.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/trsa.s
deleted file mode 100644
index d4b2a91..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/trsa.s
+++ /dev/null
@@ -1,81 +0,0 @@
-*
-* $Id: trsa.s,v 1.1.1.1 1996/02/15 17:51:24 mclareni Exp $
-*
-* $Log: trsa.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:24 mclareni
-* Kernlib
-*
-*
- IDENT TRSA
-*
-* CERN PROGLIB# F112 TRSA .VERSION KERNCDC 0.1 761001
-*
- ENTRY TRSA
-* SUBROUTINE TRSA (S,A,B,M,N)
-* WRITTEN BY ST. MEEN 25-JUNE-76
- VFD 24/4HTRSA,36/TRSA
- TRSA BSS 1
- SB7 -1
- SA2 A1-B7
- SA3 A2-B7
- SA4 A3-B7
- SA5 A4-B7
- SA4 X4
- SA5 X5
-*
-* B1 : INDEX OF S
-* B2 : INDEX OF A
-* B3 : INDEX OF B
-* B4 : COUNTS ROWS
-* B5 : SUMMING INDEX
-* B6 : =M-1
-* B7 : =-N
-* X0 : =M*N-1
-* X7 : S(X7) IS THE LAST ELEMENT OF ROW B4
-*
- DX7 X4*X4
- IX7 X7+X4
- AX7 1 X7= M*(M+1)/2
- DX0 X4*X5
- SX0 X0+B7 X0= M*N-1
- SB6 X4+B7 B6= M-1
- SB7 X5
- SB7 -B7 B7= -N
- SB3 X0 B3= M*N-1
- SB4 B6 B4= M-1
-* NEWROW-LOOP: B4=M-U,...,0
- NEWROW SX7 X7-1
- SB2 B0
-*
-* NEWCOL-LOOP: B2=M*N-1,M*N-2,...,M*N-N
- NEWCOL SB1 X7
- SB5 B6 B5= M-1
- SB2 B2+X0
- MX6 0
-*
-* SUMUP-LOOP: WHILE B2 GE 0 (M TIMES )
-* MULTIPLIES ROW B4 OF S B! COL M*N-B2 OF A
- SUMUP SA4 X1+B1
- SA5 X2+B2
- RX5 X4*X5
- RX6 X6+X5
- NX6 B0,X6 X6= X6+S(B1+1)*A(B2+1)
- SB2 B2+B7 B2= B2-N
- SB1 B1-B5
- SB5 B5-1
- GE B5,B4,SUMUP
- SB1 B1+B5
- GE B2,B0,SUMUP
-*
- SA6 X3+B3 B(B3+1)=X6
- SB3 B3-1
- LT B7,B2,NEWCOL
-*
- SB4 B4-1
- GE B4,B0,NEWROW
-*
- JP TRSA
- END
-#ifdef CERNLIB_TCGEN_TRSA
-#undef CERNLIB_TCGEN_TRSA
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/trsat.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/trsat.s
deleted file mode 100644
index a2b0d48..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/trsat.s
+++ /dev/null
@@ -1,69 +0,0 @@
-*
-* $Id: trsat.s,v 1.1.1.1 1996/02/15 17:51:24 mclareni Exp $
-*
-* $Log: trsat.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:24 mclareni
-* Kernlib
-*
-*
- IDENT TRSAT
-*
-* CERN PROGLIB# F112 TRSAT .VERSION KERNCDC 0.1 761001
-*
- ENTRY TRSAT
-* SUBROUTINE TRSAT(S,A,B,M,N)
-* WRITTEN BY ST.MEEN 5-JULY-76
- VFD 30/5HTRSAT,30/TRSAT
- TRSAT BSS 1
- SB7 -1
- SA2 A1-B7
- SA3 A2-B7
- SA4 A3-B7
- SA5 A4-B7
- SA4 X4
- SA5 X5
-*
- DX7 X4*X5 X7= M*N
- DX6 X4*X4
- IX6 X6+X4
- AX6 1
- SB6 X6 B6= (M*M+M)/2
- Y
- SX0 X4 X0= M
- SB4 X0 B4= M
- SB3 X7+B7 B3= M*N-1
-*
-* NEWROW-LOOP: B4=M-1,...,0
- NEWROW SB4 B4+B7
- SB2 X7+B7
- SB6 B6+B7
-*
-* NEWCOL-LOOP: B2=M*N-1,M*N-2,...,M*N-N
- NEWCOL SB1 B6
- SB5 X0+B7
- MX6 0
-*
-* SUMUP-LOOP: B5=M-1,...,0
-* MULTIPLIES ROW B4 OF S BY ROW M*N-B2 OF A
- SUMUP SA4 X1+B1
- SA5 X2+B2
- RX5 X4*X5
- RX6 X6+X5
- NX6 B0,X6 X6= X6+S(B1+1)*A(B2+1)
-*
- SB2 B2+B7
- SB1 B1-B5
- SB5 B5+B7
- GE B5,B4,SUMUP
- SB1 B1+B5
- GE B5,B0,SUMUP
-*
- SA6 X3+B3
- SB3 B3+B7
- GE B2,B0,NEWCOL
- NE B4,B0,NEWROW
- JP TRSAT
- END
-#ifdef CERNLIB_TCGEN_TRSAT
-#undef CERNLIB_TCGEN_TRSAT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/trsmlu.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/trsmlu.s
deleted file mode 100644
index 1e64567..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/trsmlu.s
+++ /dev/null
@@ -1,65 +0,0 @@
-*
-* $Id: trsmlu.s,v 1.1.1.1 1996/02/15 17:51:24 mclareni Exp $
-*
-* $Log: trsmlu.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:24 mclareni
-* Kernlib
-*
-*
- IDENT TRSMLU
-*
-* CERN PROGLIB# F112 TRSMLU .VERSION KERNCDC 0.1 761001
-*
- ENTRY TRSMLU
-* SUBROUTINE TRSMLU (A,S,M)
-* S:=A.AT, A: LOWER TRIANGULAR MXM, S:SYMMETRIC MXM
-* WRITTEN BY ST. MEEN 20-JULY-76
- VFD 36/6HTRSMLU,24/TRSMLU
- TRSMLU BSS 1
- SB7 1
- SA2 A1+B7
- SA3 A2+B7
- SA3 X3
-*
- DX5 X3*X3
- IX5 X5+X3
- AX5 1
- SB5 X5-1 B5= M*(M+1)/2-1
-*
- SB1 X3 B1= M
-* NEWROW-LOOP: B1=M,M-1,...,1 B6=...,5,2,0
- NEWROW SB6 B5
-*
- SB2 B1
-* NEWCOL-LOOP: B2=B1,B1-1,...,1
- NEWCOL SX4 X1+B5
- SX5 X1+B6
- MX6 0
-*
-* SUMUP-LOOP: B3=B2,B2-1,...,1
-* MULTIPLIES ROW B1 BY ROW B2, RESULT IN X6
- SB3 B2
- SUMUP SA4 X4
- SA5 X5
- RX5 X5*X4
- RX6 X6+X5
- NX6 B0,X6
-*
- SX4 A4-B7
- SX5 A5-B7
- SB3 B3-B7
- LT B0,B3,SUMUP
-*
- SA6 X2+B5 S(B5)=X6
- SB5 B5-B7
- SB6 B6-B2
- SB2 B2-B7
- LT B0,B2,NEWCOL
-*
- SB1 B1-B7
- LT B0,B1,NEWROW
- JP TRSMLU
- END
-#ifdef CERNLIB_TCGEN_TRSMLU
-#undef CERNLIB_TCGEN_TRSMLU
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/trsmul.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/trsmul.s
deleted file mode 100644
index dbe3a25..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/trsmul.s
+++ /dev/null
@@ -1,63 +0,0 @@
-*
-* $Id: trsmul.s,v 1.1.1.1 1996/02/15 17:51:25 mclareni Exp $
-*
-* $Log: trsmul.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:25 mclareni
-* Kernlib
-*
-*
- IDENT TRSMUL
-*
-* CERN PROGLIB# F112 TRSMUL .VERSION KERNCDC 0.1 761001
-*
- ENTRY TRSMUL
-* SUBROUTINE TRSMUL(A,S,M)
-* S:=AT.A, A: LOWER TRIANGULAR MXM, S: SYMMETRIC MXM
-* WRITTEN BY ST. MEEN 20-JULY-76
- VFD 36/6HTRSMUL,24/TRSMUL
- TRSMUL BSS 1
- SB7 1
- SA2 A1+B7
- SA3 A2+B7
- SA3 X3
-*
- SB4 X3 B4= M
- SB5 -B7
- SB6 B0
-*
-* NEWROW-LOOP: B1=1,2,...,M B5=0,2,5,9,..(DIAG-ELEM)
- SB1 B0
- NEWROW SB1 B1+B7
- SB5 B5+B1
-*
-* NEWCOL-LOOP: B2=1,2,...,B1
-* B6 INCREASES B! 1 EVERY RUN
- SB2 B0
- NEWCOL SB2 B2+B7
- SX4 X1+B5
- SX5 X1+B6
- MX6 0
-*
-* SUMUP-LOOP: B3= B1,...,M
-* MULTIPLIES CL B1 B! COL B2 OF A, RESULT IN X6
- SB3 B1
- SUMUP SA4 X4
- SA5 X5
- RX5 X5*X4
- RX6 X6+X5
- NX6 B0,X6
- SX4 A4+B3
- SX5 A5+B3
- SB3 B3+B7
- GE B4,B3,SUMUP
-*
- SA6 X2+B6 S(B6)=X6
- SB6 B6+B7
- LT B2,B1,NEWCOL
-*
- LT B1,B4,NEWROW
- JP TRSMUL
- END
-#ifdef CERNLIB_TCGEN_TRSMUL
-#undef CERNLIB_TCGEN_TRSMUL
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/trupck.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/trupck.s
deleted file mode 100644
index cb54d5b..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/trupck.s
+++ /dev/null
@@ -1,76 +0,0 @@
-*
-* $Id: trupck.s,v 1.1.1.1 1996/02/15 17:51:25 mclareni Exp $
-*
-* $Log: trupck.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:25 mclareni
-* Kernlib
-*
-*
- IDENT TRUPCK
-*
-* CERN PROGLIB# F112 TRUPCK .VERSION KERNCDC 0.1 761001
-*
- ENTRY TRUPCK
-* SUBROUTINE TRUPCK(S,A,M)
-* A:=S, S: SYMMETRIC MXM, A: MXM
-* WRITTEN BY ST.MEEN 16-JULY-76
- VFD 36/6HTRUPCK,24/TRUPCK
- TRUPCK BSS 1
- SB7 1
- SA2 A1+B7
- SA3 A2+B7
- SA3 X3
- SB3 X3 B3= M
-*
-* COPY LOWER PART
- DX5 X3*X3
- SB6 X5
- SB6 B6+X2 B6= ADR(LAST ELEMENT IN A) +1=X2+M*M
-*
- IX5 X5+X3
- AX5 1
- SB5 X5
- SB5 B5+X1 B5= ADR(LAST ELEMENT IN S) +1=X1+(M*M+M)/
-*
- SB1 B3 B1= M
-* NEWROW-LOOP: B1=M-1,...,0
-* B6-X2=M*M,M*(M-1),...,M
- NEWROW SB1 B1-B7
- SB2 B6-B1
-*
-* NEWCOL-LOOP: B6 ISSETDOWN BY 1 UNTIL B2-1
-* B5 DECREASES BY 1 EVERY RUN
-* COPY A(B6)=S(B5)
- NEWCOL SB5 B5-B7
- SB6 B6-B7
- SA5 B5
- BX6 X5
- SA6 B6
- GE B6,B2,NEWCOL
- SB6 B6-B3
- SB6 B6+B1 B6= B6-M+B1
- LT B0,B1,NEWROW
-*
-* COPY HIGHER PART
- SB1 B7
- SB4 X2
-* NROW-LOOP: B1=2,3,...,M
- NROW SB4 B4+B3
- SB5 B4
- SB6 X2+B1
- SB1 B1+B7
-* NCOL-LOOP: B6=X2+B1,X2+B1+M,......
-* B5=B4,B4+1,...,B4+B1-1
-* COPY A(B6)=A(B5)
- NCOL SA5 B5
- BX6 X5
- SA6 B6
- SB5 B5+B7
- SB6 B6+B3
- LT B6,B5,NCOL
- LT B1,B3,NROW
- JP TRUPCK
- END
-#ifdef CERNLIB_TCGEN_TRUPCK
-#undef CERNLIB_TCGEN_TRUPCK
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/ubits.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/ubits.s
deleted file mode 100644
index 1f99578..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/ubits.s
+++ /dev/null
@@ -1,69 +0,0 @@
-*
-* $Id: ubits.s,v 1.1.1.1 1996/02/15 17:51:25 mclareni Exp $
-*
-* $Log: ubits.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:25 mclareni
-* Kernlib
-*
-*
- IDENT UBITS
-*
-* CERN PROGLIB# M503 UBITS .VERSION KERNCDC 1.16 820129
-*
-* CALL UBITS (I,N,K,M)
-*
-* ARGUMENTS:
-* I - A FULLWORD ARRAY CONTAINING THE BIT STRING TO BE EXAMINED
-* N - THE NUMBER OF BITS IN THE BIT STRING
-* K - ARRAY TO CONTAIN THE LOCATIONS OF THE BITS WITH VALUE 1
-* M - NUMBER OF BITS FOUND TO HAVE THE VALUE 1
-*
- ENTRY UBITS
- VFD 30/5HUBITS,30/UBITS
- UBITS DATA 0
- SB1 1
- SX5 B1
- SA2 A1+B1
- SX7 B0 SET M
- SA1 X1 GET I
- SA3 A2+B1 GET BASE ADDRESS OF K
- SA4 A3+B1
- SA2 X2
- SB4 B1 LOOP INDEX
- SB2 X2 GET N
- SB6 60
- SB3 B6
- NZ X1,LOOP
- SB4 B6 EMPTY WORD
- SB3 B1
- EQ L1
- LOOP BX2 X1*X5 GET BIT
- ZR X2,L1
- SX6 B4
- IX7 X7+X5 INCREMENT M
- SA6 X3 STORE K(M)
- IX3 X3+X5
- L1 GE B4,B2,OUT
- SB3 B3-B1
- SB4 B4+B1
- NE B3,L2 CHECK WHETHER END OF WORD
- SA1 A1+B1
- SB3 B6
- NZ X1,LOOP
- SB4 B4-B1
- SB3 B1
- SB4 B4+B6
- EQ L1
- L2 AX1 B1 SHIFT I
- NZ X1,LOOP
- NG X1,LOOP
- SB4 B4+B3 NO MORE SET BITS IN THIS WORD
- SB4 B4-B1
- SB3 B1
- EQ L1
- OUT SA7 X4 STORE M
- EQ B0,B0,UBITS
- END
-#ifdef CERNLIB_TCGEN_UBITS
-#undef CERNLIB_TCGEN_UBITS
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/ublank.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/ublank.s
deleted file mode 100644
index d359489..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/ublank.s
+++ /dev/null
@@ -1,36 +0,0 @@
-*
-* $Id: ublank.s,v 1.1.1.1 1996/02/15 17:51:25 mclareni Exp $
-*
-* $Log: ublank.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:25 mclareni
-* Kernlib
-*
-*
- IDENT UBLANK
-*
-* CERN PROGLIB# V300 UBLANK .VERSION KERNCDC 0.1 750820
-*
- ENTRY UBLANK
-* SUBROUTINE UBLANK (IV,JL,JR)
-* (WRITTEN FOR SCOPE 3.3 - FTN)
- VFD 36/6HUBLANK,24/UBLANK
- UBLANK BSS 1
- SB7 -1
- SA2 A1-B7
- SB2 X1+B7 B2= START OF IV -1
- SA3 A2-B7
- SA1 BLANK
- SA2 X2 X2= JL
- SA3 X3 X3= JR
- BX6 X1
- SB7 -B7
- LOOP IX7 X2-X3 DO INDEX TEST
- SA6 B2+X2 STORE
- SX2 X2+B7 INCREASE INDEX
- NG X7,LOOP
- EQ UBLANK
- BLANK DATA 55555555555555555555B
- END
-#ifdef CERNLIB_TCGEN_UBLANK
-#undef CERNLIB_TCGEN_UBLANK
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/ublow.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/ublow.s
deleted file mode 100644
index 46d642e..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/ublow.s
+++ /dev/null
@@ -1,55 +0,0 @@
-*
-* $Id: ublow.s,v 1.1.1.1 1996/02/15 17:51:25 mclareni Exp $
-*
-* $Log: ublow.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:25 mclareni
-* Kernlib
-*
-*
- IDENT UBLOW
-*
-* CERN PROGLIB# M409 UBLOW .VERSION KERNCDC 2.07 831121
-*
- ENTRY UBLOW
-#if !defined(CERNLIB_F77)
- ENTRY UCTOH1
-#endif
-*
-* SUBROUTINE UBLOW (KBUNCH,KBLOWN,N)
-* (WRITTEN FOR SCOPE 3.3 -- FTN)
- VFD 30/5HUBLOW,30/UBLOW
- UCTOH1 BSS 0
- UBLOW BSS 1
- SB1 1 B1= 1
- SA4 BLANK 9 BLANKS PRECEEDED BY 00
- SA2 A1+B1 X2= ADDRESS OF KBLOWN
- MX0 6 MASK FOR CHARACTERS
- SA3 A2+B1
- SA5 X1 A5= ADDRESS OF KBUNCH
- SB7 10
- SA1 X3
- MX3 59 X3= -1
- SB3 X1
- ZR X1,UBLOW
- LOOP1 LX1 B0,X5
- SA5 A5+B1
- SB2 B7 SET LOOP COUNT
- BX7 X1*X0 FETCH FIRST CHARACTER
- LOOP2 LX1 6 PREPARE NEXT CHARACTER
- BX6 X7+X4 ADD BLANKS
- ZR B2,LOOP1 ALL TEN DONE
- SB3 B3-B1
- SA6 X2 STORE AWAY
- BX7 X1*X0 FETCH NEXT CHARACTER
- IX2 X2-X3 NEW STORE ADDRESS
- SB2 B2-B1 CHARACTER COUNT
- GE B3,B1,LOOP2
- EQ UBLOW RETURN
- BLANK DATA 00555555555555555555B
- END
-#ifdef CERNLIB_TCGEN_UBLOW
-#undef CERNLIB_TCGEN_UBLOW
-#endif
-#ifdef CERNLIB_TCGEN_UCTOH1
-#undef CERNLIB_TCGEN_UCTOH1
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/ubunch.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/ubunch.s
deleted file mode 100644
index 2e05fd9..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/ubunch.s
+++ /dev/null
@@ -1,59 +0,0 @@
-*
-* $Id: ubunch.s,v 1.1.1.1 1996/02/15 17:51:25 mclareni Exp $
-*
-* $Log: ubunch.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:25 mclareni
-* Kernlib
-*
-*
- IDENT UBUNCH
-*
-* CERN PROGLIB# M409 UBUNCH .VERSION KERNCDC 2.07 831121
-*
- ENTRY UBUNCH
-#if !defined(CERNLIB_F77)
- ENTRY UH1TOC
-#endif
-*
-* SUBROUTINE UBUNCH (KBLOWN,KBUNCH,N)
-* (WRITTEN FOR SCOPE 3.3 - FTN)
- VFD 36/6HUBUNCH,24/UBUNCH
- UH1TOC BSS 0
- UBUNCH BSS 1
- SA5 A1+2
- SA2 A1+1 X2= ADDRESS OF KBLOWN
- SA3 X5 X3= N
- MX7 6 MASK
- SB7 -6
- SA4 X1 X4= KBLOWN
- MX0 59 X0= -1
- ZR X3,UBUNCH
- LOOP1 MX6 0
- SB6 X0 B6= -1
- SB4 60 CHARACTER-COUNT
- LOOP2 LX4 B4,X4
- SB4 B4+B7
- BX5 X7*X4
- IX3 X3+X0
- LX7 54
- SA4 A4-B6
- NO
- BX6 X5+X6 THE RESULT
- ZR X3,FINN
- NZ B4,LOOP2
- FA SA6 X2
- IX2 X2-X0
- NZ B6,LOOP1
- EQ UBUNCH
- FINN SB6 B0
- ZR B4,FA
- SA4 BLANKS
- EQ LOOP2
- BLANKS DIS ,* * *BL
- END
-#ifdef CERNLIB_TCGEN_UBUNCH
-#undef CERNLIB_TCGEN_UBUNCH
-#endif
-#ifdef CERNLIB_TCGEN_UH1TOC
-#undef CERNLIB_TCGEN_UH1TOC
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/ucocop.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/ucocop.s
deleted file mode 100644
index ef65e27..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/ucocop.s
+++ /dev/null
@@ -1,52 +0,0 @@
-*
-* $Id: ucocop.s,v 1.1.1.1 1996/02/15 17:51:25 mclareni Exp $
-*
-* $Log: ucocop.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:25 mclareni
-* Kernlib
-*
-*
- IDENT UCOCOP
-*
-* CERN PROGLIB# V302 UCOCOP .VERSION KERNCDC 0.1 750820
-*
- ENTRY UCOCOP
-* SUBROUTINE UCOCOP (A,B,IDO,IW,NA,NB)
- VFD 36/6HUCOCOP,24/UCOCOP
- UCOCOP BSS 1
- SB7 -1
- SA2 A1-B7
- SB1 X1
- SA3 A2-B7
- SB2 X2+B7
- SX6 -B7
- SA2 X3 X2= IDO
- SA5 A3-B7
- BX3 -X2 X3= -IDO
- ZR X2,UCOCOP
- SA4 X5 X4= IW
- SA1 A5-B7
- ZR X4,UCOCOP
- SA5 X1 X5= NA
- SA2 A1-B7
- SB5 X5 B5= NA
- SA1 X2 X1= NB
- SB6 X1 B6= NB
- LOOPDO SA1 B1
- SB3 B0
- BX0 -X4 X0= -IW
- LOOPIW LX7 B0,X1
- SB3 X6+B3
- IX0 X0+X6
- SA7 B2+B3
- SA1 B1+B3
- NG X0,LOOPIW
- SB1 B1+B5
- IX3 X3+X6
- SB2 B2+B6
- NG X3,LOOPDO
- EQ UCOCOP
- END
-#ifdef CERNLIB_TCGEN_UCOCOP
-#undef CERNLIB_TCGEN_UCOCOP
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/ucopy.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/ucopy.s
deleted file mode 100644
index 9c8cd0d..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/ucopy.s
+++ /dev/null
@@ -1,68 +0,0 @@
-*
-* $Id: ucopy.s,v 1.1.1.1 1996/02/15 17:51:25 mclareni Exp $
-*
-* $Log: ucopy.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:25 mclareni
-* Kernlib
-*
-*
- IDENT UCOPY
-*
-* CERN PROGLIB# V301 UCOPY .VERSION KERNCDC 2.01 820727
-*
-* MOVE BLOCKS OF STORAGE
-*
-* SUBROUTINE UCOPY (S,T,N)
-*
-* OVERLAP NOT ALLOWED
-*
- ENTRY UCOPY
- VFD 30/5HUCOPY,30/UCOPY
- UCOPY BSS 1
-* X1= ADR(S)
- SB7 1 B7= 1
- SA2 A1+B7 X2= ADR(T)
- SA3 A2+B7 X3= ADR(N)
- SB1 X1 B1= ADR(S)
- SB6 B7+B7 B6= 2
- SB1 B0-B1 B1= -ADR(S)
- SA5 X3 X5= N
- SB3 X2+B1 B3= DISTANCE = ADR(T) - ADR(S)
- SA1 X1 A1= ADR(S)
- SA2 A1+B7 A2= ADR(S+1)
- SX0 B6+B6 X0= 4
- EQ B3,B0,UCOPY NO REAL COPY
- IX5 X5-X0 X5= N-4 FOR N WORDS STILL TO BE DONE
- NG X5,ENDL LT 4 WORDS
-*
- LOOP SA3 A1+B6 TRANSFER 4 WORDS AT A TIME
- BX6 X1
- SA4 A2+B6
- AX7 X2
- SA6 A1+B3
- SA7 A2+B3
- IX5 X5-X0
- SA1 A3+B6
- BX6 X3
- SA2 A4+B6
- AX7 X4
- SA6 A3+B3
- SA7 A4+B3
- PL X5,LOOP
- ENDL BX6 X1
- SB5 X5+B6 B5= N-2 FOR N WORDS STILL TO BE DONE
- SB4 B5+B6 B4= N
- LT B4,B7,UCOPY EXIT N < 1
- SA6 A1+B3
- BX7 X2
- EQ B4,B7,UCOPY EXIT N=1
- SA7 A2+B3
- SA1 A1+B6
- EQ B5,B0,UCOPY EXIT N=2
- BX6 X1
- SA6 A1+B3
- EQ UCOPY
- END
-#ifdef CERNLIB_TCGEN_UCOPY
-#undef CERNLIB_TCGEN_UCOPY
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/ucopy2.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/ucopy2.s
deleted file mode 100644
index 7b3fd37..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/ucopy2.s
+++ /dev/null
@@ -1,75 +0,0 @@
-*
-* $Id: ucopy2.s,v 1.1.1.1 1996/02/15 17:51:25 mclareni Exp $
-*
-* $Log: ucopy2.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:25 mclareni
-* Kernlib
-*
-*
- IDENT UCOPY2
-*
-* CERN PROGLIB# V301 UCOPY2 .VERSION KERNCDC 2.01 820727
-*
-* MOVE BLOCKS OF STORAGE
-*
-* SUBROUTINE UCOPY2 (S,T,N)
-*
-* OVERLAP ALLOWED
-*
- ENTRY UCOPY2
- VFD 36/6HUCOPY2,24/UCOPY2
- UCOPY2 BSS 1
-* X1= ADR(S)
- SB7 1 B7= 1
- SA2 A1+B7 X2= ADR(T)
- SA3 A2+B7 X3= ADR(N)
- SB1 X1 B1= ADR(S)
- SB6 B7 B6= +1 IF NOT-INV
- SB5 B0 START BIAS =0 IF NOT-INV
- SB1 B0-B1 B1= -ADR(S)
- SA5 X3 X5= N
- SB3 X2+B1 B3= DISTANCE = ADR(T) - ADR(S)
- EQ B3,B0,UCOPY2 NO REAL COPY
- LT B3,B0,NOTINV
- SB6 B0-B7 B6= -1 IF INV
- SB5 X5+B6 START BIAS =N-1 IF INV
-*
- NOTINV SA1 X1+B5 A1= ADR(S(FIRST))
- SB2 B7+B7 B2= 2
- SA2 A1+B6 A2= ADR(S(SECOND))
- SX0 B2+B2 X0= 4
- SB6 B6+B6 B6= +/- 2 FOR NOT/INV
- IX5 X5-X0 X5= N-4 FOR N WORDS STILL TO BE DONE
- NG X5,ENDL LT 4 WORDS
-*
- LOOP SA3 A1+B6 TRANSFER 4 WORDS AT A TIME
- BX6 X1
- SA4 A2+B6
- AX7 X2
- SA6 A1+B3
- SA7 A2+B3
- IX5 X5-X0
- SA1 A3+B6
- BX6 X3
- SA2 A4+B6
- AX7 X4
- SA6 A3+B3
- SA7 A4+B3
- PL X5,LOOP
- ENDL BX6 X1
- SB5 X5+B2 B5= N-2 FOR N WORDS STILL TO BE DONE
- SB4 B5+B2 B4= N
- LT B4,B7,UCOPY2 EXIT N < 1
- SA6 A1+B3
- BX7 X2
- EQ B4,B7,UCOPY2 EXIT N=1
- SA7 A2+B3
- SA1 A1+B6
- EQ B5,B0,UCOPY2 EXIT N=2
- BX6 X1
- SA6 A1+B3
- EQ UCOPY2
- END
-#ifdef CERNLIB_TCGEN_UCOPY2
-#undef CERNLIB_TCGEN_UCOPY2
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/uctoh.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/uctoh.s
deleted file mode 100644
index 264c01d..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/uctoh.s
+++ /dev/null
@@ -1,158 +0,0 @@
-*
-* $Id: uctoh.s,v 1.1.1.1 1996/02/15 17:51:25 mclareni Exp $
-*
-* $Log: uctoh.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:25 mclareni
-* Kernlib
-*
-*
- IDENT UCTOH
-*
-* CERN PROGLIB# M409 UCTOH .VERSION KERNCDC 2.07 831121
-* ORIG. 14/11/83 JZ, CERN
-*
-* SUBROUTINE UCTOH (CH,HOLL,K,NCH)
-*
-*----- USAGE OF REGISTERS
-*
-* B1 NO. OF CHARS STILL TO BE TAKEN FROM CUR. INPUT CH(J)
-* B2 = 10 CHAR PER INPUT WORD
-* B3 = 6*(10-K) SHIFT RESULT WORD
-* B4 = NCH COUNTED DOWN TO ZERO
-* B5 = K = CHAR CAPACITY OF HOLL
-* B6 NO. OF CHARS STILL TO BE PLACED INTO CUR. OUTPUT HOLL
-* B7 = -1
-*
-* A1,X1 INPUT WORD CH(J)
-* X0 MASK 77B FOR RIGHT-MOST CHARACTER
-* X4 MASK 00..0055..55 OF (10-K) BLANKS
-* X5 = 6 FOR INTEGER MULTIPLY
-* A6,X6 OUTPUT WORD HOLL(L)
-*
- ENTRY UCTOH
- VFD 30/5HUCTOH,30/UCTOH
- UCTOH BSS 1
- SB7 -1 *B7= -1
-* X1= ADR(CH)
- SA2 A1-B7 X2= ADR(HOLL)
- SA3 A2-B7 X3= ADR(K)
- SA4 A3-B7 X4= ADR(NCH)
- MX0 6
- LX0 6 *X0= 77B MASK OF 1 CHAR.
-*
- SB6 X2 B6= ADR(HOLL)
- SA3 X3 X3= K
- SA4 X4 X4= NCH
-*
- SA2 B6+B7 A2= ADR(HOLL) - 1
- SB2 10 *B2= 10
- ZR X4,UCTOH EXIT IF NCH=0
-*
- BX6 X2
- SA6 A2 *A6= ADR(HOLL) - 1
- SB4 X4 *B4= NCH
- SX5 6 *X5= 6
-*
-*-- CALC. B5 = K = MIN0 (K,10)
-*
- SX6 B2 X6= 10
- IX7 X6-X3 X7= 10 - K
- AX7 59 X7= MASK ALL ZERO OR ALL ONE
- BX6 X7*X6 X6= ZERO OR 10
- BX3 -X7*X3 X3= K OR ZERO
- BX3 X3+X6 X3= MIN0 (K,10)
- SB5 X3 *B5= K
-*
-*-- MAKE MASK OF 10-K BLANKS BY SHIFTING 6*(K-1) BITS
-* B3 IS SHIFT-COUNT OF OUTPUT WORDS 6*(10-K) BITS
-*
- SA4 BLANK X4= ZERO/9 BLANKS
- SX2 B5+B7 X2= K - 1
- SX3 B2-B5 X3= 10 - K
- DX2 X2*X5 X2= 6*(K-1)
- DX3 X3*X5 X3= 6*(10-K)
- SB6 X2 B6= 6*(K-1)
- SB3 X3 *B3= 6*(10-K)
- AX4 B6,X4 *X4= MASK WITH 10-K BLANKS
-*
-*-- READY FIRST INPUT WORD
-*
-#if !defined(CERNLIB_F77)
- SA1 X1 *A1= ADR(CH)
- SB1 B2 *B1= 10 TAKE 10 CHARS
-#endif
-#if defined(CERNLIB_F77)
- SB6 X1 B6= ADR(CH)
- AX1 24
- BX2 X1*X0 X2= NSK = SKIP NSK FIRST CHARS
- SA1 B6 *A1= ADR(CH)
- SB1 X2 B1= NSK
- DX2 X2*X5 X2= 6*NSK
- SB6 X2 B6= 6*NSK
- LX1 B6,X1 *X1= CH(1) ROTATED READY
- SB1 B2-B1 *B1= 10-NSK CHARS STILL TO BE TAKEN
-#endif
-*
-*-- START LOOPING
-*
- SA2 A1-B7 *X2= LOOK-AHEAD INPUT WORD
- MX6 0 *X6= ZERO, OUTPUT WORD CLEAR
- SB6 B5 *B6= K CHARS PER OUTPUT WORD
-*
-*----- COPY NEXT CHARACTER
-*
- LOOPCH LX1 6
- SB1 B1+B7 B1 CHARS TO BE TAKEN FROM CURRENT
- LX6 6
- SB4 B4+B7 B4 CHARS TO BE DONE IN ALL
- BX7 X0*X1 X7= 1 INPUT CHAR ISOLATED
- SB6 B6+B7 B6 CHARS TO BE PUT INTO CURRENT
- BX6 X6+X7 OUTPUT CHARS ACCUMULATED
- EQ B4,B0,DONE
- EQ B6,B0,NEXTOUT
- NE B1,B0,LOOPCH
-*
-*-- LOAD NEXT INPUT WORD
-*
- NEXTIN BX1 X2
- SA2 A2-B7 X2 NEXT LOOK-AHEAD INPUT WORD
- SB1 B2 B1= 10
- JP LOOPCH
-*
-*-- STORE CURRENT OUTPUT WORD, READY FOR NEXT
-*
- NEXTOUT LX6 B3,X6
- BX6 X4+X6 X6 OUTPUT WORD WITH BLANK-FILL
- SA6 A6-B7 STORED
- SB6 B5 B6= K
- MX6 0
- NE B1,B0,LOOPCH CURRENT INPUT NOT EXHAUSTED
- JP NEXTIN
-*
-*----- ALL DONE, STORE LAST OUTPUT WORD
-*
-* NKEEP = 10-NDONE TRAILING CHARS
-* - LEFT SHIFT RESULT BY 6*NKEEP
-* - MERGE NKEEP TRAILING BLANKS
-*
- DONE SB6 B5-B6 B6= NDONE
- SB6 B2-B6 B6= NKEEP = 10-NDONE
- EQ B6,B0,STORE
- SX2 B6 X2= NKEEP
- MX3 1
- DX2 X2*X5 X2= 6*NKEEP
- SA1 BLANK X1= ZERO WITH 9 TRAILING BLANKS
- SB1 X2 B1= 6*NKEEP
- SB2 X2+B7 B2= 6*NKEEP - 1
- LX6 B1,X6 X6= NDONE CHARS / ZERO
- AX3 B2,X3 X3= MASK OF 6*NKEEP BITS LEFT
- LX3 B1,X3 X3= MASK OF 6*NKEEP BITS RIGHT
- BX1 X3*X1 X1= NKEEP BLANKS ISOLATED
- BX6 X1+X6
-STORE SA6 A6-B7 STORE
- JP UCTOH
- BLANK DATA 00555555555555555555B
- END
-#ifdef CERNLIB_TCGEN_UCTOH
-#undef CERNLIB_TCGEN_UCTOH
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/uctoh1.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/uctoh1.s
deleted file mode 100644
index dd99367..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/uctoh1.s
+++ /dev/null
@@ -1,95 +0,0 @@
-*
-* $Id: uctoh1.s,v 1.1.1.1 1996/02/15 17:51:25 mclareni Exp $
-*
-* $Log: uctoh1.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:25 mclareni
-* Kernlib
-*
-*
-#if defined(CERNLIB_F77)
- IDENT UCTOH1
-*
-* CERN PROGLIB# M409 UCTOH1 .VERSION KERNCDC 2.07 831121
-* ORIG. 14/11/83 JZ, CERN
-*
-* SUBROUTINE UCTOH1 (CH,HOLL,NCH)
-*
-*----- USAGE OF REGISTERS
-*
-* B1 NO. OF CHARS STILL TO BE TAKEN FROM CUR. INPUT CH(J)
-* B2 = 10 CHAR PER INPUT WORD
-* B4 = NCH COUNTED DOWN TO ZERO
-* B7 = -1
-*
-* A1,X1 INPUT WORD CH(J)
-* X0 MASK 77B FOR RIGHT-MOST CHARACTER
-* X4 MASK 0055..55 OF 9 BLANKS
-* X5 = 6 FOR INTEGER MULTIPLY
-* A6,X6 OUTPUT WORD HOLL(L)
-*
- ENTRY UCTOH1
- VFD 36/6HUCTOH1,24/UCTOH1
- UCTOH1 BSS 1
- SB7 -1 *B7= -1
-* X1= ADR(CH)
- SA2 A1-B7 X2= ADR(HOLL)
- SA4 A2-B7 X4= ADR(NCH)
- MX0 6 *X0= 77B MASK OF 1 CHAR.
-*
- SA2 X2+B7 A2= ADR(HOLL) - 1
- SA4 X4 X4= NCH
-*
- SB2 10 *B2= 10
- ZR X4,UCTOH1 EXIT IF NCH=0
-*
- BX6 X2
- SA6 A2 *A6= ADR(HOLL) - 1
- SB4 X4 *B4= NCH
- SX5 6 *X5= 6
- SA4 BLANK *X4= ZERO/9 BLANKS
-*
-*-- READY FIRST INPUT WORD
-*
-#if !defined(CERNLIB_F77)
- SA1 X1 *A1= ADR(CH)
- SB1 B2 *B1= 10 TAKE 10 CHARS
-#endif
-#if defined(CERNLIB_F77)
- SB6 X1 B6= ADR(CH)
- AX1 24
- BX2 X1*X0 X2= NSK = SKIP NSK FIRST CHARS
- SA1 B6 *A1= ADR(CH)
- SB1 X2 B1= NSK
- DX2 X2*X5 X2= 6*NSK
- SB6 X2 B6= 6*NSK
- LX1 B6,X1 *X1= CH(1) ROTATED READY
- SB1 B2-B1 *B1= 10-NSK CHARS STILL TO BE TAKEN
-#endif
-*
-*-- START LOOPING
-*
- SA2 A1-B7 *X2= LOOK-AHEAD INPUT WORD
-*
-*----- COPY NEXT CHARACTER
-*
- LOOPCH BX6 X0*X1 X6= 1 INPUT CHAR ISOLATED
- SB4 B4+B7 B4 CHARS TO BE DONE IN ALL
- LX1 6
- BX6 X4+X6 X6 OUTPUT WORD WITH BLANK-FILL
- SB1 B1+B7 B1 CHARS TO BE TAKEN FROM CURRENT
- SA6 A6-B7 STORED
- EQ B4,B0,UCTOH1
- NE B1,B0,LOOPCH
-*
-*-- LOAD NEXT INPUT WORD
-*
- NEXTIN BX1 X2
- SA2 A2-B7 X2 NEXT LOOK-AHEAD INPUT WORD
- SB1 B2 B1= 10
- JP LOOPCH
- BLANK DATA 00555555555555555555B
- END
-#ifdef CERNLIB_TCGEN_UCTOH1
-#undef CERNLIB_TCGEN_UCTOH1
-#endif
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/udicop.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/udicop.s
deleted file mode 100644
index 4c84970..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/udicop.s
+++ /dev/null
@@ -1,65 +0,0 @@
-*
-* $Id: udicop.s,v 1.1.1.1 1996/02/15 17:51:25 mclareni Exp $
-*
-* $Log: udicop.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:25 mclareni
-* Kernlib
-*
-*
- IDENT UDICOP
-*
-* CERN PROGLIB# V302 UDICOP .VERSION KERNCDC 0.1 750820
-*
- ENTRY UDICOP
-* SUBROUTINE UDICOP (A,B,IDO,IW,NA,NB)
- VFD 36/6HUDICOP,24/UDICOP
- UDICOP BSS 1
- SB7 1
- SA5 A1+B7
- SX6 B7 X6= 1
- SA4 A5+B7
- SA2 X4 X2= IDO
- SA3 A4+B7
- IX7 X2-X6 X7= IDO-1
- ZR X2,UDICOP
- SA4 X3 X4= IW
- BX3 -X2 X3= -IDO
- ZR X4,UDICOP
- SB1 X1
- SA1 A3+B7
- SB2 X5
- SA5 X1 X5= NA
- SA2 A1+B7
- PX0 B0,X5 PACKED NA
- SB5 X5 B5= NA
- SA1 X2 X1= NB
- PX5 B0,X7 X5= PACKED (IDO-1)
- SB2 B2+X4
- PX2 B0,X1 PACKED NB
- SB6 X1 B6= NB
- DX7 X0*X5
- IX1 X4-X6
- DX0 X2*X5
- UX7 B0,X7 X7= NA*(IDO-1)
- IX2 X1+X7
- SB1 B1+X2 POINTER FOR A-ADDRESS
- UX0 B0,X0 X0= NB*(IDO-1)
- SB2 B2+X0 POINTER FOR B-ADDRESS
- LOOPDO SA1 B1
- SB3 B0
- BX0 -X4 X0= -IW
- LOOPIW LX7 B0,X1
- SB3 X6+B3
- IX0 X0+X6
- SA7 B2-B3
- SA1 B1-B3
- NG X0,LOOPIW
- SB1 B1-B5
- IX3 X3+X6
- SB2 B2-B6
- NG X3,LOOPDO
- EQ UDICOP
- END
-#ifdef CERNLIB_TCGEN_UDICOP
-#undef CERNLIB_TCGEN_UDICOP
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/ufill.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/ufill.s
deleted file mode 100644
index e62c75b..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/ufill.s
+++ /dev/null
@@ -1,35 +0,0 @@
-*
-* $Id: ufill.s,v 1.1.1.1 1996/02/15 17:51:25 mclareni Exp $
-*
-* $Log: ufill.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:25 mclareni
-* Kernlib
-*
-*
- IDENT UFILL
-*
-* CERN PROGLIB# V300 UFILL .VERSION KERNCDC 0.1 750820
-*
- ENTRY UFILL
-* SUBROUTINE UFILL (IV,JL,JR,ISTUFF)
- VFD 30/5HUFILL,30/UFILL
- UFILL BSS 1
- SA4 A1+3
- SB7 -1
- SA2 A1-B7
- SA4 X4 X4= ISTUFF
- SA5 A2-B7
- BX6 X4
- SA2 X2 X2= JL
- SA3 X5 X3= JR
- SB2 X1+B7 B2= START OF IV -1
- SB7 -B7
- LOOP IX7 X2-X3
- SA6 B2+X2
- SX2 X2+B7
- NG X7,LOOP
- EQ UFILL
- END
-#ifdef CERNLIB_TCGEN_UFILL
-#undef CERNLIB_TCGEN_UFILL
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/uflint.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/uflint.s
deleted file mode 100644
index 7e38c11..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/uflint.s
+++ /dev/null
@@ -1,61 +0,0 @@
-*
-* $Id: uflint.s,v 1.1.1.1 1996/02/15 17:51:25 mclareni Exp $
-*
-* $Log: uflint.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:25 mclareni
-* Kernlib
-*
-*
- IDENT UFLINT
-*
-* CERN PROGLIB# M251 UFLINT .VERSION KERNCDC 1.02 771015
-*
- ENTRY UFLINT
-*
-* CALL UFLINT (VECT,NW,MODE)
-*
-* PROGRAM WRITTEN 12-AUG-77, JZ
-*
- VFD 36/6HUFLINT,24/UFLINT
- UFLINT BSSZ 1
- SB7 1 B7= 1
- SA2 A1+B7 X2= ADR(NW)
- SA3 A2+B7 X3= ADR(MODE)
- SA1 X1 A1= ADR(VECT(J))
- SA2 X2 X2= NW
- SA3 X3 X3= MODE
- BX4 -X2
- SB6 X4 B6= /NW/
- NG X2,NEXT
- LX3 59 SET REPRESENTATION SELECTOR FOR NW +VE
- AX3 59
- SB6 X2 B6= NW
-*
- NEXT EQ B6,B0,UFLINT LOOP EXIT
- BX2 X1 X2= VECT(J)
- SA1 A1+B7 X1= VECT(J+1)
- SB6 B6-B7 BUMP LOOP COUNT
- LX3 59 X3= REPRES. SELECTOR IN SIGN-BIT
- BX4 X2
- AX4 48
- ZR X4,INTG --> VECT(J) HAS ZERO EXPONENT
- PL X3,NEXT
-*
-* CONVERT TO INTEGER
- ID X2,NEXT
- OR X2,NEXT
- UX0 B2,X2
- LX7 B2,X0
- SA7 A1-B7
- JP NEXT
-*
-* CONVERT TO FLOATING
- INTG NG X3,NEXT
- PX0 B0,X2
- NX7 B0,X0
- SA7 A1-B7
- JP NEXT
- END
-#ifdef CERNLIB_TCGEN_UFLINT
-#undef CERNLIB_TCGEN_UFLINT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/uh1toc.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/uh1toc.s
deleted file mode 100644
index 1d033bd..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/uh1toc.s
+++ /dev/null
@@ -1,115 +0,0 @@
-*
-* $Id: uh1toc.s,v 1.1.1.1 1996/02/15 17:51:26 mclareni Exp $
-*
-* $Log: uh1toc.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:26 mclareni
-* Kernlib
-*
-*
-#if defined(CERNLIB_F77)
- IDENT UH1TOC
-*
-* CERN PROGLIB# M409 UH1TOC .VERSION KERNCDC 2.14 850320
-* ORIG. 14/11/83 JZ, CERN
-*
-* SUBROUTINE UH1TOC (HOLL,CH,NCH)
-*
-*----- USAGE OF REGISTERS
-*
-* B4 = NCH COUNTED DOWN TO ZERO
-* B5 = 10 CHAR PER OUTPUT WORD
-* B6 NO. OF CHARS STILL TO BE PLACED INTO CUR. OUTPUT CH
-* B7 = -1
-*
-* A1,X1 INPUT WORD HOLL(J)
-* X0 MASK FOR LEFT-MOST CHARACTER
-* X5 = 6 FOR INTEGER MULTIPLY
-* A6,X6 OUTPUT WORD CH(L)
-*
- ENTRY UH1TOC
- VFD 36/6HUH1TOC,24/UH1TOC
- UH1TOC BSS 1
- SB7 -1 *B7= -1
-* X1= ADR(HOLL)
- SA3 A1-B7 X3= ADR(CH)
- SA4 A3-B7 X4= ADR(NCH)
- MX0 6 *X0= 7700...00 MASK OF 1 CHAR.
-*
- SB6 X3 B6= ADR(CH)
- SA4 X4 X4= NCH
-*
- SA5 B6+B7 A5= ADR(CH) - 1
- SB5 10 *B5= 10
- ZR X4,UH1TOC EXIT IF NCH=0
-*
- BX6 X5
- SA6 A5 *A6= ADR(CH) - 1
- SB4 X4 *B4= NCH
- SX5 6 *X5= 6
- SA1 X1 *A1= ADR(HOLL)
-*
-*-- READY FIRST OUTPUT WORD
-*
- MX6 0 *X6= CLEAR
- SB6 B5 *B6= 10 PUT 10 CHARS
-#if defined(CERNLIB_F77)
- LX3 30
- BX3 X3*X0 X3= NSK = KEEP NSK FIRST CHARS
- LX3 6
- ZR X3,READY
- SA2 A6-B7 X2= CH(1)
- SB6 X3 B6= NSK
- DX3 X3*X5 X3= 6*NSK
- MX4 1
- SB3 X3+B7 B3= 6*NSK - 1
- SB1 X3 B1= 6*NSK
- AX4 B3,X4 X4= MASK OF 6*NSK BITS LEFT
- SB6 B5-B6 *B6= 10-NSK CHARS STILL TO BE PUT
- BX6 X4*X2 X6= NSK CHARS / ZERO
- LX6 B1,X6 *X6= CH(1) ROTATED
- READY BSS 0
-#endif
-*
-*----- COPY NEXT CHARACTER
-*
- LOOPCH BX7 X0*X1 X7= ONE INPUT CHAR ISOLATED
- SA1 A1-B7 READY NEXT LOOK-AHEAD
- SB4 B4+B7 B4 CHARS TO BE DONE IN ALL
- BX6 X6+X7 OUTPUT CHARS ACCUMULATED
- SB6 B6+B7 B6 CHARS TO BE PUT INTO CURRENT
- LX6 6
- EQ B4,B0,DONE
- NE B6,B0,LOOPCH
-*
-*-- STORE CURRENT OUTPUT WORD, READY FOR NEXT
-*
- SA6 A6-B7 STORED
- SB6 B5 B6= 10
- MX6 0
- JP LOOPCH
-*
-*----- ALL DONE, STORE LAST OUTPUT WORD
-*
-* NKEEP = 10-NDONE TRAILING CHARS
-* - LEFT SHIFT RESULT BY 6*NKEEP
-* - MERGE NKEEP ORIGINAL CHARS
-*
- DONE EQ B6,B0,STORE B6= NKEEP
- SX2 B6 X2= NKEEP
- MX3 1
- DX2 X2*X5 X2= 6*NKEEP
- SA1 A6-B7 X1= ORIGINAL CONTENT OF CH(N)
- SB1 X2 B1= 6*NKEEP
- SB2 X2+B7 B2= 6*NKEEP - 1
- LX6 B1,X6 X6= NDONE CHARS / ZERO
- AX3 B2,X3 X3= MASK OF 6*NKEEP BITS LEFT
- LX3 B1,X3 X3= MASK OF 6*NKEEP BITS RIGHT
- BX1 X3*X1 X1= NKEEP ORIGINAL CHARS ISOLATED
- BX6 X1+X6
-STORE SA6 A6-B7 STORE
- JP UH1TOC
- END
-#ifdef CERNLIB_TCGEN_UH1TOC
-#undef CERNLIB_TCGEN_UH1TOC
-#endif
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/uhtoc.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/uhtoc.s
deleted file mode 100644
index a077d53..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/uhtoc.s
+++ /dev/null
@@ -1,142 +0,0 @@
-*
-* $Id: uhtoc.s,v 1.1.1.1 1996/02/15 17:51:25 mclareni Exp $
-*
-* $Log: uhtoc.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:25 mclareni
-* Kernlib
-*
-*
- IDENT UHTOC
-*
-* CERN PROGLIB# M409 UHTOC .VERSION KERNCDC 2.07 831121
-* ORIG. 14/11/83 JZ, CERN
-*
-* SUBROUTINE UHTOC (HOLL,K,CH,NCH)
-*
-*----- USAGE OF REGISTERS
-*
-* B1 NO. OF CHARS STILL TO BE TAKEN FROM CUR. INPUT HOLL(J)
-* B2 = K = CHAR CAPACITY OF 1 HOLL WORD
-* B4 = NCH COUNTED DOWN TO ZERO
-* B5 = 10 CHAR PER OUTPUT WORD
-* B6 NO. OF CHARS STILL TO BE PLACED INTO CUR. OUTPUT CH
-* B7 = -1
-*
-* A1,X1 INPUT WORD HOLL(J)
-* X0 MASK 77B FOR RIGHT-MOST CHARACTER
-* X5 = 6 FOR INTEGER MULTIPLY
-* A6,X6 OUTPUT WORD CH(L)
-*
- ENTRY UHTOC
- VFD 30/5HUHTOC,30/UHTOC
- UHTOC BSS 1
- SB7 -1 *B7= -1
-* X1= ADR(HOLL)
- SA2 A1-B7 X2= ADR(K)
- SA3 A2-B7 X3= ADR(CH)
- SA4 A3-B7 X4= ADR(NCH)
- MX0 6
- LX0 6 *X0= 77B MASK OF 1 CHAR.
-*
- SA2 X2 X2= K
- SB6 X3 B6= ADR(CH)
- SA4 X4 X4= NCH
-*
- SA5 B6+B7 A5= ADR(CH) - 1
- SB5 10 *B5= 10
- ZR X4,UHTOC EXIT IF NCH=0
-*
- BX6 X5
- SA6 A5 *A6= ADR(CH) - 1
- SB4 X4 *B4= NCH
- SX5 6 *X5= 6
- SA1 X1 *A1= ADR(HOLL)
-*
-*-- CALC. B2 = K = MIN0 (K,10)
-*
- SX6 B5 X6= 10
- IX7 X6-X2 X7= 10 - K
- AX7 59 X7= MASK ALL ZERO OR ALL ONE
- BX6 X7*X6 X6= ZERO OR 10
- BX2 -X7*X2 X2= K OR ZERO
- BX2 X2+X6 X2= MIN0 (K,10)
- SB2 X2 *B2= K
-*
-*-- READY FIRST OUTPUT WORD
-*
- MX6 0 *X6= CLEAR
- SB6 B5 *B6= 10 PUT 10 CHARS
-#if defined(CERNLIB_F77)
- AX3 24
- BX3 X3*X0 X3= NSK = KEEP NSK FIRST CHARS
- ZR X3,READY
- SA2 A6-B7 X2= CH(1)
- SB6 X3 B6= NSK
- DX3 X3*X5 X3= 6*NSK
- MX4 1
- SB3 X3+B7 B3= 6*NSK - 1
- SB1 X3 B1= 6*NSK
- AX4 B3,X4 X4= MASK OF 6*NSK BITS LEFT
- SB6 B5-B6 *B6= 10-NSK CHARS STILL TO BE PUT
- BX6 X4*X2 X6= NSK CHARS / ZERO
- LX6 B1,X6 *X6= CH(1) ROTATED
- READY BSS 0
-#endif
-*
-*-- START LOOPING
-*
- SA2 A1-B7 *X2= LOOK-AHEAD INPUT WORD
- SB1 B2 *B1= K CHARS PER INPUT WORD
-*
-*----- COPY NEXT CHARACTER
-*
- LOOPCH LX1 6
- SB1 B1+B7 B1 CHARS TO BE TAKEN FROM CURRENT
- LX6 6
- SB4 B4+B7 B4 CHARS TO BE DONE IN ALL
- BX7 X0*X1 X7= ONE INPUT CHAR ISOLATED
- SB6 B6+B7 B6 CHARS TO BE PUT INTO CURRENT
- BX6 X6+X7 OUTPUT CHARS ACCUMULATED
- EQ B4,B0,DONE
- EQ B6,B0,NEXTOUT
- NE B1,B0,LOOPCH
-*
-*-- LOAD NEXT INPUT WORD
-*
- NEXTIN BX1 X2
- SA2 A2-B7 X2 NEXT LOOK-AHEAD INPUT WORD
- SB1 B2 B1= K
- JP LOOPCH
-*
-*-- STORE CURRENT OUTPUT WORD, READY FOR NEXT
-*
- NEXTOUT SA6 A6-B7 STORED
- SB6 B5 B6= 10
- MX6 0
- NE B1,B0,LOOPCH CURRENT INPUT NOT EXHAUSTED
- JP NEXTIN
-*
-*----- ALL DONE, STORE LAST OUTPUT WORD
-*
-* NKEEP = 10-NDONE TRAILING CHARS
-* - LEFT SHIFT RESULT BY 6*NKEEP
-* - MERGE NKEEP ORIGINAL CHARS
-*
- DONE EQ B6,B0,STORE B6= NKEEP
- SX2 B6 X2= NKEEP
- MX3 1
- DX2 X2*X5 X2= 6*NKEEP
- SA1 A6-B7 X1= ORIGINAL CONTENT OF CH(N)
- SB1 X2 B1= 6*NKEEP
- SB2 X2+B7 B2= 6*NKEEP - 1
- LX6 B1,X6 X6= NDONE CHARS / ZERO
- AX3 B2,X3 X3= MASK OF 6*NKEEP BITS LEFT
- LX3 B1,X3 X3= MASK OF 6*NKEEP BITS RIGHT
- BX1 X3*X1 X1= NKEEP ORIGINAL CHARS ISOLATED
- BX6 X1+X6
-STORE SA6 A6-B7 STORE
- JP UHTOC
- END
-#ifdef CERNLIB_TCGEN_UHTOC
-#undef CERNLIB_TCGEN_UHTOC
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/uleft.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/uleft.s
deleted file mode 100644
index 6479231..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/uleft.s
+++ /dev/null
@@ -1,102 +0,0 @@
-*
-* $Id: uleft.s,v 1.1.1.1 1996/02/15 17:51:26 mclareni Exp $
-*
-* $Log: uleft.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:26 mclareni
-* Kernlib
-*
-*
- IDENT ULEFT
-*
-* CERN PROGLIB# M410 ULEFT .VERSION KERNCDC 1.06 780614
-*
- ENTRY ULEFT
-*
-* CALL ULEFT (CH,JL,JR)
-* COMPASS VERSION MAY 1978, JZ
-*
-* REGISTER ASSIGNMENTS
-*
-* X1 CH(JTK) B1 ADR(CH(0))
-* X2 CH(JTK+1) B2 JL
-* B3 JR
-* X4 BLANK WORD B4 JTK
-*
- USE /SLATE/
- NDIGIT BSS 1
- JEND BSS 39
- USE
-*
- VFD 30/5HULEFT,30/ULEFT
- ULEFT DATA 0 X1= ADR(CH)
- SB7 1
- SA2 A1+B7 X2= ADR(JL)
- SA3 A2+B7 X3= ADR(JR)
- SA4 BLANK X4= ALL BLANKS
- SA2 X2 X2= JL
- SA3 X3 X3= JR
- SB1 X1 B1= ADR(CH(1))
- SB1 B1-B7 B1= ADR(CH(0))
- SB2 X2 B2= JL
- SB3 X3 B3= JR
- SB5 B2 JEND = JL IN CASE
- LT B3,B2,HOME
- SB4 B2-B7 B4= JTK = JL-1
- SA2 B1+B2 X2= CH(JTK+1) = CH(JL)
-*
-* LOOP TO FIND FIRST BLANK
-*
- SB5 B3+B7 JEND = JR+1 IN CASE NO BLANK
- LOOP1 EQ B4,B3,HOME
- BX1 X2 X1= CH(JTK)
- SA2 A2+B7 X2= CH(JTK+1) READ AHEAD
- IX3 X1-X4
- SB4 B4+B7 B4= JTK
- NZ X3,LOOP1
-*
-* LOOP TO RUN OVER FIRST STRING OF BLANKS
-*
- SB5 B4 B5= JEND = JTK OF FIRST BLANK
- LOOP2 EQ B4,B3,HOME
- BX1 X2 X1= CH(JTK)
- SA2 A2+B7 X2= CH(JTK+1) READ AHEAD
- IX3 X1-X4
- SB4 B4+B7 B4= JTK
- ZR X3,LOOP2
-*
-* LOOP TO COPY
-*
- BX6 X1 STORE FIRST NON-BLANK CHAR
- SA6 B1+B5
- SB6 B4 B6= JTK OF LAST NON-BLANK CHAR
- LOOP3 EQ B4,B3,END3
- BX6 X2 X6= CH(JTK)
- SA2 A2+B7 X2= CH(JTK+1) READ AHEAD
- IX3 X6-X4
- SB4 B4+B7 B4= JTK
- ZR X3,LOOP3
- SA6 A6+B7
- SB6 B4 B6= JTK OF LAST NON-BLANK CHAR
- EQ LOOP3
-*
-* LOOP TO BLANK TRAILING WORDS
-*
- END3 SB5 A6-B1 B5= JPUT OF LAST STORED
- SB4 B6-B5 B4= N CHAR. TO BE CLEARED
- BX6 X4
- SB5 B5+B7 JEND = JPUT+1
- LOOP4 SA6 A6+B7
- SB4 B4-B7
- NE B4,B0,LOOP4
-*
- HOME SX7 B5 JEND
- SX6 B5-B2 NDIG = JEND - JL
- SA6 NDIGIT
- SA7 A6+B7
- EQ ULEFT
-*
- BLANK DATA 55555555555555555555B
- END
-#ifdef CERNLIB_TCGEN_ULEFT
-#undef CERNLIB_TCGEN_ULEFT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/uopt.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/uopt.s
deleted file mode 100644
index 80ed31d..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/uopt.s
+++ /dev/null
@@ -1,78 +0,0 @@
-*
-* $Id: uopt.s,v 1.1.1.1 1996/02/15 17:51:26 mclareni Exp $
-*
-* $Log: uopt.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:26 mclareni
-* Kernlib
-*
-*
- IDENT UOPT
-*
-* CERN PROGLIB# M502 UOPT .VERSION KERNCDC 0.1 750820
-*
-* SUBROUTINE UOPT(DATA,POSS,IOPT,NP)
-*
-* PROGRAM P.RASTL, JULY 1971
-*
- ENTRY UOPT
- VFD 24/4HUOPT,36/UOPT
- UOPT BSS 1
- SB7 -1
- SA2 A1-B7
- BX0 X0-X0 ALL FLAGS OFF
- SB2 X2
- SA1 X1 X1= FIRST WORD OF DATA
- MX3 6 X3= MASK
- SA4 A2-B7
- SX5 B0-B7
- SB3 X4
- SA2 A4-B7
- SA4 X2 X4= NP
- SB5 X4-10
- GE B0,B5,SPEC SPECIAL VERSION, IF NP.LE.10
- SA2 B2+B7 A2= B2-1
- SB4 X4
- SB6 6
- BX2 X2-X2
- FIND SB4 B4+B7
- NZ X2,CONT READ NEW POSSIBILITIES
- SA2 A2-B7
- CONT BX6 X1-X2 COMPARE CHARACTER
- LT B4,B0,END CHARACTER NOT FOUND
- BX6 X3*X6
- BX7 -X3*X2
- LX2 B6,X7
- NZ X6,FIND
- BX7 -X3*X1 CHARACTER EQUAL
- LX6 B4,X5
- SA2 B2
- SB4 X4
- BX0 X0+X6 SET FLAG
- LX1 B6,X7
- NZ X7,FIND READ NEW DATA
- SA1 A1-B7
- EQ FIND
- SPEC SA2 B2 SPECIAL VERSION
- LX1 54
- NEXT SB4 X4
- BX7 X2
- LX1 6
- FIND1 SB4 B4+B7
- BX6 X1-X7 COMPARE CHARACTER
- LT B4,B0,END CHARACTER NOT FOUND
- BX6 X3*X6
- LX7 6
- NZ X6,FIND1
- LX6 B4,X5 CHARACTER EQUAL
- BX0 X0+X6 SET FLAG
- EQ NEXT
- END BX6 X5*X0 STORE FLAGS
- SX4 X4+B7
- AX0 1
- SA6 X4+B3
- NZ X4,END
- EQ UOPT
- END
-#ifdef CERNLIB_TCGEN_UOPT
-#undef CERNLIB_TCGEN_UOPT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/upkbyt.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/upkbyt.s
deleted file mode 100644
index 765cb17..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/upkbyt.s
+++ /dev/null
@@ -1,83 +0,0 @@
-*
-* $Id: upkbyt.s,v 1.1.1.1 1996/02/15 17:51:26 mclareni Exp $
-*
-* $Log: upkbyt.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:26 mclareni
-* Kernlib
-*
-*
- IDENT UPKBYT
-*
-* CERN PROGLIB# M422 UPKBYT .VERSION KERNCDC 0.1 750820
-*
- ENTRY UPKBYT
-* SUBROUTINE UPKBYT (A,JTH,M,N,NBITS)
- VFD 36/6HUPKBYT,24/UPKBYT
- UPKBYT BSS 1
- SB7 1 B7= 1
- SA2 A1+B7
- SB1 X1
- SA3 X2 X3= JTH
- SA4 A2+B7
- SB3 X4
- SA2 A4+B7
- SA4 X2 X4= N
- SA5 A2+B7
- ZR X4,UPKBYT
- SX6 A0
- SA1 X5+B7 X1= INWORD
- PX2 B0,X1 X2= PACKED INWORD
- SA6 SAVEA0
- SA5 A1-B7 X5= NBITS
- NX7 B0,X2 X7= NORMALISED INWORD
- NZ X5,L12
- SA2 SIXTY INWORD=60
- SX5 B7 NBITS=1
- NX7 B0,X2
- L12 SX1 X3-1 X1= JTH-1
- PX3 B0,X1 X1= PACKED (JTH-1)
- FX7 X3/X7
- SB5 X5 B5= NBITS
- SB2 X3 23=JTH-1
- MX0 1
- SB6 B5-B7 B6= NBITS-1
- SB4 B0 CURRENT BYTE
- AX0 B6,X0 NBITS BITS ON LEFT
- SB6 B0 B6= LOC
- SA0 X2 A0= INWORD
- LT B2,B7,START
- UX6 B2,X7
- LX6 B2,X6 X6= NW A-WORDS UNTOUCHED
- PX6 B0,X6
- SB1 B1+X6 B1= JA
- DX1 X6*X2
- FX3 X3-X1
- PX5 B0,X5 X5= PACKED NBITS
- DX7 X3*X5
- SB4 X3 B4= JPOS
- SB6 X7 B6= LOC
- START LX0 B5,X0 NBITS BITS ON THE RIGHT
- SA1 B1 X1= A(JA)
- SB2 B3+X4 END OF M
- AX2 B6,X1
- L21 SB4 A0-B4 REMAINING NUMBER OF BYTES
- L24 BX6 X2*X0 PICK THE BYTE
- SB3 B3+B7
- SB4 B4-B7
- AX2 B5,X2
- NO
- SA6 B3-B7
- GE B3,B2,UPKBYE
- NE B4,B0,L24
- SA2 B1+B7
- SB1 B1+B7
- EQ L21
- UPKBYE SA1 SAVEA0
- SA0 X1
- EQ UPKBYT
- SIXTY DATA 20000000000000000074B
- SAVEA0 BSS 1
- END
-#ifdef CERNLIB_TCGEN_UPKBYT
-#undef CERNLIB_TCGEN_UPKBYT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/upkch.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/upkch.s
deleted file mode 100644
index 684a630..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/upkch.s
+++ /dev/null
@@ -1,188 +0,0 @@
-*
-* $Id: upkch.s,v 1.1.1.1 1996/02/15 17:51:26 mclareni Exp $
-*
-* $Log: upkch.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:26 mclareni
-* Kernlib
-*
-*
- IDENT UPKCH
-*
-* CERN PROGLIB# M427 UPKCH .VERSION KERNCDC 0.1 730123
-*
- ENTRY UPKCH
-*
-* CALL UPKCH (CHAR,INT,N,IPAR) IPAR=NBITS,NCHAR,NZONE,IGNOR
-*
-* REGISTER ASSIGNMENTS
-*
-* A0 ADR(INT(J))
-* X7 INT(J) B7 =1
-* X6 B6 NBITS
-* X5 B5 NBITSW PER WORD
-* X4 NSKIP (SEC 2) B4 NCHAR
-* X3 B3 JGO (SEC 1)
-* X2 -N, COUNT UP B2 CHARACTER COUNTER
-* X1 WORD BEING UNPACKED B1 JR = 60-JBT ROTATOR
-* X0 MASK OF NBITS BITS
-*
- VFD 36/6HUPKCH ,24/UPKCH *BL
- SAVEA0 DATA 0
- UPKCH DATA 0
- SB7 1 B7= 1
- SA2 A1+B7
- SA3 A2+B7
- SA4 A3+B7
- SX6 A0
- SB1 X1
- SB2 X2
- SB3 X3
- SA6 SAVEA0
- SA3 X4
- SA1 A3+B7 X1= NCHAR
- SA5 A1+B7 *X5= NZONE
- SB5 60 B5= NBITSW
- SA4 A5+B7 X4= IGNOR
- PX0 X3
- NZ X5,PREL11
- SX5 B5 NZONE = NBITSW
- PREL11 BSS 0
- NX0 B6,X0
- IX7 X5-X4 X7= NZONE - IGNOR
- PX6 X7 MXCHAR= (NZONE-IGNOR)/NBITS
- SA0 B2-B7 A0= ADR (INT(0))
- FX6 X6/X0
- SA2 B3 X2= N
- SB6 X3 B6= NBITS
- ZR X2,EXITZ
- BX2 -X2 X2= -N
- SB2 X4 *B2= IGNOR
- UX6 B3,X6
- LX6 B3,X6 X1= NCHAR = MXCHAR
- SB3 B6-B7 B3= NBITS-1
- NZ X1,PREL31
- PREL21 BX1 X6
- PREL31 DX4 X1*X3 *X4= NCHAR*NBITS
- IX0 X7-X4 X0= NTRAIL = NZONE - IGNOR - NCHAR*NBITS
- SB4 X1 B4= NCHAR
- NG X0,PREL21 ORIGINAL NCHAR TOO BIG
- MX0 1
- SX6 B1
- AX0 B3,X0 GENERATE NBITS BITS
- SB3 X5
- SA1 B1 A1= ADR(CHAR(1))
- LX0 B6,X0 X0= MASK
- SA6 NCH NCH = ADR(CHAR(1))
- SB1 B2+B6 B1= JR = IGNOR + NBITS
- NE B3,B5,ZONED
-*
-*-------- SECTION 1 = ZONE EQUALS WORD
-*
- SB3 B1 B3= JGO = JR INITIAL
- EQ GO1
-*
-* LOOP 1
-*
- ST24L1 LX6 B1,X1 POSITION BYTE
- SA0 A0+B7
- SB2 B2+B7 COUNT UP
- BX7 X0*X6 PICK INT
- SB1 B1+B6 JR = JR + NBITS
- SA7 A0 STORE INT
- LT B2,B4,ST24L1 CHECK CHAR COUNT
- PL X2,EXIT
- SA1 A1+B7 LOAD NEXT PACKED WORD
- SB1 B3 JBT= JGO
- GO1 SX2 X2+B4 -N= -N + NCHAR
- SB2 B0 INITIAL CHAR COUNT
- NG X2,ST24L1
- SB2 X2
- EQ ST24L1
- EJECT
-*
-*-------- SECTION 2 = ZONE NOT EQUALS WORD
-*
- ZONED IX4 X5-X4 X4= NSKIP = NZONE - NCHAR*NBIT
- BX3 X1 X3= WORKING COPY OF X1, WORD FOR UNPK
- NZ X4,ACT4
- SB3 B5+B7 B3= NBITSW+1
- EQ JOIN3
- ACT4 SB3 B5+B6 B3= NBITSW + NBITS
- SX2 X2+B4 -N= -N + B4
- SB2 B0
- NG X2,ST43L4
- SB2 X2
- EQ ST43L4
-*
-* LOOP 3 SPECIAL FOR CHARCTERS COMPACT
-*
- PART3 AX6 B1,X0 MASK OF NLEFT = NBITS-NRIGHT BITS
- BX7 X6*X3 PICK LEFT BITS IN OLD X1
- BX5 -X6*X1 CLEAR LEFT BITS IN NEW X1
- BX3 X5+X7 JOIN OLD+NEW
- JOIN3 LX5 B1,X3 POSITION BYTE
- SA0 A0+B7
- SX2 X2+B7 BUMP UP
- BX7 X0*X5 PICK INT
- NO
- SB1 B1+B6 JR = JR+NBITS
- SA7 A0 STORE INT
- BX3 X1
- PL X2,EXIT
- LT B1,B3,JOIN3
- SA1 A1+B7 FETCH NEW PACKED WORD
- SB1 B1-B5 JR = JR-60 = NRIGHT
- EQ PART3
-*
-* LOOP 4 GENERAL
-*
- PART4 AX6 B1,X0 MASK OF NLEFT = NBITS-NRIGHT BITS
- BX7 X6*X3 PICK LEFT BITS IN OLD X1
- BX5 -X6*X1 CLEAR LEFT BITS IN NEW X1
- BX3 X5+X7 JOIN OLD+NEW
- JOIN4 LX5 B1,X3 POSITION BYTE
- SA0 A0+B7
- SB2 B2+B7 BUMP UP
- BX7 X0*X5 PICK INT
- NO
- SB1 B1+B6 JR = JR+NBITS
- SA7 A0 STORE INT
- BX3 X1
- ST44L4 GE B2,B4,ENDZ
- LT B1,B5,JOIN4
- SA1 A1+B7 FETCH NEW PACKED WORD
- SB1 B1-B5 JR = JR-60 = NRIGHT
- EQ PART4
- ENDZ PL X2,EXITCH
- SX2 X2+B4 -N = -N + NCHAR
- SB1 X4+B1 JR = JR+NSKIP
- SB2 B0 CHAR COUNT INIT
- NG X2,ST43L4
- SB2 X2
- ST43L4 LT B1,B3,ST44L4
- SA1 A1+B7 FETCH NEW PACKED WORD
- SB1 B1-B5 JR = JR-NBITSW= JR-60
- BX3 X1
- EQ ST43L4
-*
- EXITZ MX6 0
- SA5 SAVEA0
- SA6 NCH
- SA0 X5
- EQ UPKCH
- EXITCH NE B1,B6,EXIT
- SA1 A1-B7
- EXIT SA3 NCH
- SX2 A1+B7
- SKIP IX6 X2-X3
- SA5 SAVEA0
- SA6 NCH SET NCH WORDS USED INTO /SLATE/
- SA0 X5
- EQ UPKCH
-*
- USE /SLATE/
- NCH BSS 40
- END
-#ifdef CERNLIB_TCGEN_UPKCH
-#undef CERNLIB_TCGEN_UPKCH
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/uright.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/uright.s
deleted file mode 100644
index 995c132..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/uright.s
+++ /dev/null
@@ -1,102 +0,0 @@
-*
-* $Id: uright.s,v 1.1.1.1 1996/02/15 17:51:26 mclareni Exp $
-*
-* $Log: uright.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:26 mclareni
-* Kernlib
-*
-*
- IDENT URIGHT
-*
-* CERN PROGLIB# M410 URIGHT .VERSION KERNCDC 1.06 780614
-*
- ENTRY URIGHT
-*
-* CALL URIGHT (CH,JL,JR)
-* COMPASS VERSION MAY 1978, JZ
-*
-* REGISTER ASSIGNMENTS
-*
-* X1 CH(JTK) B1 ADR(CH(0))
-* X2 CH(JTK-1) B2 JL
-* B3 JR
-* X4 BLANK WORD B4 JTK
-*
- USE /SLATE/
- NDIGIT BSS 1
- JEND BSS 39
- USE
-*
- VFD 36/6HURIGHT,24/URIGHT
- URIGHT DATA 0 X1= ADR(CH)
- SB7 1
- SA2 A1+B7 X2= ADR(JL)
- SA3 A2+B7 X3= ADR(JR)
- SA4 BLANK X4= ALL BLANKS
- SA2 X2 X2= JL
- SA3 X3 X3= JR
- SB1 X1 B1= ADR(CH(1))
- SB1 B1-B7 B1= ADR(CH(0))
- SB2 X2 B2= JL
- SB3 X3 B3= JR
- SB5 B3 JEND = JR IN CASE
- LT B3,B2,HOME
- SB4 B3+B7 B4= JTK = JR + 1
- SA2 B1+B3 X2= CH(JTK-1) = CH(JR)
-*
-* LOOP TO FIND FIRST BLANK
-*
- SB5 B2-B7 JEND = JL-1 IN CASE NO BLANK
- LOOP1 EQ B4,B2,HOME
- BX1 X2 X1= CH(JTK)
- SA2 A2-B7 X2= CH(JTK-1) READ AHEAD
- IX3 X1-X4
- SB4 B4-B7 B4= JTK
- NZ X3,LOOP1
-*
-* LOOP TO RUN OVER FIRST STRING OF BLANKS
-*
- SB5 B4 B5= JEND = JTK OF FIRST BLANK
- LOOP2 EQ B4,B2,HOME
- BX1 X2 X1= CH(JTK)
- SA2 A2-B7 X2= CH(JTK-1) READ AHEAD
- IX3 X1-X4
- SB4 B4-B7 B4= JTK
- ZR X3,LOOP2
-*
-* LOOP TO COPY
-*
- BX6 X1 STORE FIRST NON-BLANK CHAR
- SA6 B1+B5
- SB6 B4 B6= JTK OF LAST NON-BLANK CHAR
- LOOP3 EQ B4,B2,END3
- BX6 X2 X6= CH(JTK)
- SA2 A2-B7 X2= CH(JTK-1) READ AHEAD
- IX3 X6-X4
- SB4 B4-B7 B4= JTK
- ZR X3,LOOP3
- SA6 A6-B7
- SB6 B4 B6= JTK OF LAST NON-BLANK CHAR
- EQ LOOP3
-*
-* LOOP TO BLANK TRAILING WORDS
-*
- END3 SB5 A6-B1 B5= JPUT OF LAST STORED
- SB4 B5-B6 B4= N CHAR. TO BE CLEARED
- BX6 X4
- SB5 B5-B7 JEND = JPUT-1
- LOOP4 SA6 A6-B7
- SB4 B4-B7
- NE B4,B0,LOOP4
-*
- HOME SX7 B5 JEND
- SX6 B3-B5 NDIG = JR - JEND
- SA6 NDIGIT
- SA7 A6+B7
- EQ URIGHT
-*
- BLANK DATA 55555555555555555555B
- END
-#ifdef CERNLIB_TCGEN_URIGHT
-#undef CERNLIB_TCGEN_URIGHT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/uset.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/uset.s
deleted file mode 100644
index c72d699..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/uset.s
+++ /dev/null
@@ -1,75 +0,0 @@
-*
-* $Id: uset.s,v 1.1.1.1 1996/02/15 17:51:26 mclareni Exp $
-*
-* $Log: uset.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:26 mclareni
-* Kernlib
-*
-*
- IDENT USET
-*
-* CERN PROGLIB# M410 USET .VERSION KERNCDC 1.06 780614
-*
- ENTRY USET
-*
-* CALL USET (IVAL,CH,JL,JR)
-* COMPASS VERSION MAY 1978, JZ
-*
-* REGISTER ASSIGNMENTS
-*
-* X0 = 10 INTEGER
-* X1 IVAL B1 ADR(CH(1))
-* X2 IVAL/10 B2 JL
-* B3 JR
-* X4 = 10. NORMAL B4 J, INDEX FOR STORE
-* X5 = 1H0 ROTATED B7 = -1
-*
- USE /SLATE/
- NDIGIT BSS 1
- JNEXT BSS 39
- USE
-*
- VFD 24/4HUSET,36/USET
- USET DATA 0
- SB7 -1
- SB5 X1 B5= ADR(IVAL)
- SA1 A1-B7 X1= ADR(CH(1))
- SA2 A1-B7 X2= ADR(JL)
- SA3 A2-B7 X3= ADR(JR)
- SX0 10 X0= 10
- PX7 X0
- NX4 X7 X4= 10.
- SA2 X2 X2= JL
- SA3 X3 X3= JR
- SA5 ZERO X5= 1H0
- SB1 X1 B1= ADR(CH)
- SB2 X2 B2= JL
- SA2 B5 X2= IVAL
- SB3 X3 B3= JR
- SB4 X3 B4= J = JR
-*
- LOOP LT B4,B2,END B4= J
- BX1 X2 X1= IVAL
- PX7 X2 X7= IVAL FLOATING
- FX3 X7/X4 X3= IVAL/10 FLOATING
- UX7 B5,X3
- LX2 B5,X7 X2= IVAL/10 INTEGER
- DX7 X0*X2 X7= 10 * (IVAL/10)
- IX3 X1-X7 X3= N = MOD(IVAL,10)
- IX7 X5+X3
- LX7 54 X7= DISPAY CODE REPR. OF N
- SB4 B4+B7 B4= JNEXT = J-1
- SA7 B1+B4 STORE NEW CHARACTER
- NZ X2,LOOP
-*
- END SX6 B3-B4 NDIG = JR - JN
- SX7 B4 JN
- SA6 NDIGIT
- SA7 A6-B7
- EQ USET
-*
- ZERO DATA 55555555555555555533B
- END
-#ifdef CERNLIB_TCGEN_USET
-#undef CERNLIB_TCGEN_USET
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/uswop.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/uswop.s
deleted file mode 100644
index f3f54a3..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/uswop.s
+++ /dev/null
@@ -1,38 +0,0 @@
-*
-* $Id: uswop.s,v 1.1.1.1 1996/02/15 17:51:27 mclareni Exp $
-*
-* $Log: uswop.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:27 mclareni
-* Kernlib
-*
-*
- IDENT USWOP
-*
-* CERN PROGLIB# V303 USWOP .VERSION KERNCDC 0.1 750820
-*
- ENTRY USWOP
-* SUBROUTINE USWOP (A,B,N)
-* (WRITTEN FOR SCOPE 3.3 - FTN)
- VFD 30/5HUSWOP,30/USWOP
- USWOP BSS 1
- SA5 A1+2
- SA4 A1+1
- SA3 X5 X3= N
- SB4 1 B4= 1
- SA1 X1 X1= FIRST A-ELEMENT
- SA2 X4 X2= FIRST B-ELEMENT
- SB5 X3 B5= N
- ZR X3,USWOP
- LOOP BX7 X1 X7= A-ELEMENT
- SA1 A1+B4 X1= A-ELEMENT
- LX6 B0,X2 X6= B-ELEMENT
- SA2 A2+B4 X2= B-ELEMENT
- SB5 B5-B4
- SA6 A1-B4
- SA7 A2-B4
- NE B5,B0,LOOP
- EQ USWOP RETURN
- END
-#ifdef CERNLIB_TCGEN_USWOP
-#undef CERNLIB_TCGEN_USWOP
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/uzero.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/uzero.s
deleted file mode 100644
index 65ba48b..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/uzero.s
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: uzero.s,v 1.1.1.1 1996/02/15 17:51:27 mclareni Exp $
-*
-* $Log: uzero.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:27 mclareni
-* Kernlib
-*
-*
- IDENT UZERO
-*
-* CERN PROGLIB# V300 UZERO .VERSION KERNCDC 0.1 750820
-*
- ENTRY UZERO
-* SUBROUTINE UZERO (IV,JL,JR)
-* (WRITTEN FOR SCOPE 3.3 - FTN)
- VFD 30/5HUZERO,30/UZERO
- UZERO BSS 1
- SB7 -1
- SA2 A1-B7
- SB2 X1+B7 B2= START OF IV -1
- SA3 A2-B7
- MX6 0
- SA2 X2 X2= JL
- SA3 X3 X3= JR
- SB7 -B7
- LOOP IX7 X2-X3 DO INDEX TEST
- SA6 B2+X2 STORE
- SX2 X2+B7 INCREASE INDEX
- NG X7,LOOP
- EQ UZERO
- END
-#ifdef CERNLIB_TCGEN_UZERO
-#undef CERNLIB_TCGEN_UZERO
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/vadd.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/vadd.s
deleted file mode 100644
index 26fe4aa..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/vadd.s
+++ /dev/null
@@ -1,40 +0,0 @@
-*
-* $Id: vadd.s,v 1.1.1.1 1996/02/15 17:51:27 mclareni Exp $
-*
-* $Log: vadd.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:27 mclareni
-* Kernlib
-*
-*
- IDENT VADD
-*
-* CERN PROGLIB# F121 VADD .VERSION KERNCDC 0.1 750820
-*
-* CALL VADD(A,B,X,N)
-* SETS
-* X(I) = A(I) + B(I) FOR I = 1,N
-*
-*
- ENTRY VADD
- VFD 24/4HVADD,36/VADD
- VADD DATA 0
- SB5 -1
- SA4 A1-B5
- SA5 A4-B5
- SA2 A5-B5
- SA3 X2
- SB6 X3+B5
- ZR X3,VADD
- NG X3,VADD
- LOOP SA3 X1+B6
- SA2 X4+B6
- FX6 X3+X2
- NX7 X6
- SA7 X5+B6
- SB6 B6+B5
- GE B6,B0,LOOP
- EQ B0,B0,VADD
- END
-#ifdef CERNLIB_TCGEN_VADD
-#undef CERNLIB_TCGEN_VADD
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/vasum.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/vasum.s
deleted file mode 100644
index 1e66bb1..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/vasum.s
+++ /dev/null
@@ -1,39 +0,0 @@
-*
-* $Id: vasum.s,v 1.1.1.1 1996/02/15 17:51:27 mclareni Exp $
-*
-* $Log: vasum.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:27 mclareni
-* Kernlib
-*
-*
- IDENT VASUM
-*
-* CERN PROGLIB# F121 VASUM .VERSION KERNCDC 0.1 750820
-*
-* Y = VASUM(A,N)
-* SETS
-* Y = ABS(A(1)) + ABS(A(2)) + ...... + ABS(A(N))
-*
-*
- ENTRY VASUM
- VFD 30/5HVASUM,30/VASUM
- VASUM DATA 0
- SA3 A1+1
- MX6 0
- SA2 X3
- ZR X2,VASUM
- SB6 X2-1
- NG X2,VASUM
- LOOP SA3 X1+B6
- BX4 X3
- AX3 60
- BX5 X3-X4
- FX2 X6+X5
- SB6 B6-1
- NX6 X2
- GE B6,B0,LOOP
- EQ B0,B0,VASUM
- END
-#ifdef CERNLIB_TCGEN_VASUM
-#undef CERNLIB_TCGEN_VASUM
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/vbias.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/vbias.s
deleted file mode 100644
index 456f95e..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/vbias.s
+++ /dev/null
@@ -1,40 +0,0 @@
-*
-* $Id: vbias.s,v 1.1.1.1 1996/02/15 17:51:27 mclareni Exp $
-*
-* $Log: vbias.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:27 mclareni
-* Kernlib
-*
-*
- IDENT VBIAS
-*
-* CERN PROGLIB# F121 VBIAS .VERSION KERNCDC 0.1 750820
-*
-* CALL VBIAS(A,ALPHA,X,N)
-* SETS
-* X(I) = A(I) + ALPHA FOR I = 1,N
-*
-*
- ENTRY VBIAS
- VFD 30/5HVBIAS,30/VBIAS
- VBIAS DATA 0
- SB5 -1
- SA5 A1-B5
- SA2 X5
- SA3 A5-B5
- SA5 A3-B5
- SA4 X5
- SB6 X4+B5
- ZR X4,VBIAS
- NG X4,VBIAS
- LOOP SA5 X1+B6
- FX7 X5+X2
- NX6 X7
- SA6 X3+B6
- SB6 B6+B5
- GE B6,B0,LOOP
- EQ B0,B0,VBIAS
- END
-#ifdef CERNLIB_TCGEN_VBIAS
-#undef CERNLIB_TCGEN_VBIAS
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/vblank.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/vblank.s
deleted file mode 100644
index 50687b7..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/vblank.s
+++ /dev/null
@@ -1,35 +0,0 @@
-*
-* $Id: vblank.s,v 1.1.1.1 1996/02/15 17:51:27 mclareni Exp $
-*
-* $Log: vblank.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:27 mclareni
-* Kernlib
-*
-*
- IDENT VBLANK
-*
-* CERN PROGLIB# F121 VBLANK .VERSION KERNCDC 0.1 750820
-*
-* (WRITTEN FOR SCOPE 3.3 - FTN)
-* CALL VBLANK (A,N)
-* TO BLANK A VECTOR A OF DIMENSION N
- ENTRY VBLANK
- VFD 36/6HVBLANK,24/VBLANK
- VBLANK DATA 0
- SA4 A1+1
- SA3 BLANK
- SA2 X4 X2= N
- SB4 -1
- BX6 X3
- ZR X2,VBLANK
- NG X2,VBLANK
- SB3 X2+B4
- LOOP SA6 X1+B3
- SB3 B3+B4
- GE B3,B0,LOOP
- EQ B0,B0,VBLANK
- BLANK DATA H* * *BL
- END
-#ifdef CERNLIB_TCGEN_VBLANK
-#undef CERNLIB_TCGEN_VBLANK
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/vdot.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/vdot.s
deleted file mode 100644
index 3f91bfa..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/vdot.s
+++ /dev/null
@@ -1,39 +0,0 @@
-*
-* $Id: vdot.s,v 1.1.1.1 1996/02/15 17:51:27 mclareni Exp $
-*
-* $Log: vdot.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:27 mclareni
-* Kernlib
-*
-*
- IDENT VDOT
-*
-* CERN PROGLIB# F121 VDOT .VERSION KERNCDC 0.1 750820
-*
-* Y = VDOT(A,B,N)
-* SETS
-* Y = A.B = SCALAR PRODUCT OF A AND B (EACH OF DIMENSION N)
-*
-*
- ENTRY VDOT
- VFD 24/4HVDOT,36/VDOT
- VDOT DATA 0
- SB5 -1
- SA2 A1-B5
- MX6 0
- SA4 A2-B5
- SA3 X4
- SB6 X3+B5
- LT B6,B0,VDOT
- LOOP SA4 X1+B6
- SA5 X2+B6
- FX3 X4*X5
- SB6 B6+B5
- FX7 X6+X3
- NX6 B7,X7
- GE B6,B0,LOOP
- EQ B0,B0,VDOT
- END
-#ifdef CERNLIB_TCGEN_VDOT
-#undef CERNLIB_TCGEN_VDOT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/vdotn.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/vdotn.s
deleted file mode 100644
index 76a3b9e..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/vdotn.s
+++ /dev/null
@@ -1,67 +0,0 @@
-*
-* $Id: vdotn.s,v 1.1.1.1 1996/02/15 17:51:27 mclareni Exp $
-*
-* $Log: vdotn.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:27 mclareni
-* Kernlib
-*
-*
- IDENT VDOTN
-*
-* CERN PROGLIB# F121 VDOTN .VERSION KERNCDC 0.1 751101
-*
- ENTRY VDOTN
- EXT SQRT
- NAME VFD 30/5HVDOTN,30/VDOTN
- VDOTN BSS 1
- SB5 -1
- SA2 A1-B5
- MX6 0 XX
- SA4 A2-B5
- BX0 X6 YY
- SA3 X4
- SB6 X3+B5
- LT B6,B0,VDOTN
- MX7 0 XY
- LOOP SA4 X1+B6
- SA5 X2+B6
- FX3 X4*X4 X * X
- FX6 X6+X3
- SB6 B6+B5
- FX3 X4*X5 X * Y
- FX7 X7+X3
- NX6 X6
- FX4 X5*X5 Y * Y
- NX7 X7
- FX0 X0+X4
- NX0 X0
- GE B6,B0,LOOP
- FX6 X6*X0
- SA6 ARG
- SB1 A6
- SX6 B1
- SA6 ARGA
- MX6 0
- SA6 A6-B5
- SA1 ARGA
- SA7 STORE
- + RJ SQRT
- - LT B0,B1,NAME
- SA1 STORE
- SB5 59
- FX6 X1/X6
- AX3 B5,X6
- SA2 ONE X2= 1.
- BX5 X3-X6 X5= ABS (VDOTN)
- FX4 X2-X5 X4= 1. - ABS (VDOTN)
- PL X4,VDOTN
- BX6 X2-X3
- EQ VDOTN
- ONE DATA 17204000000000000000B
- STORE BSS 1
- ARG BSS 1
- ARGA BSS 2
- END
-#ifdef CERNLIB_TCGEN_VDOTN
-#undef CERNLIB_TCGEN_VDOTN
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/vdotn2.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/vdotn2.s
deleted file mode 100644
index 5663814..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/vdotn2.s
+++ /dev/null
@@ -1,45 +0,0 @@
-*
-* $Id: vdotn2.s,v 1.1.1.1 1996/02/15 17:51:27 mclareni Exp $
-*
-* $Log: vdotn2.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:27 mclareni
-* Kernlib
-*
-*
- IDENT VDOTN2
-*
-* CERN PROGLIB# F121 VDOTN2 .VERSION KERNCDC 0.1 750820
-*
- ENTRY VDOTN2
- VFD 36/6HVDOTN2,24/VDOTN2
- VDOTN2 BSS 1
- SB5 -1
- SA2 A1-B5
- MX6 0 XX
- SA4 A2-B5
- BX0 X6 YY
- SA3 X4
- SB6 X3+B5
- LT B6,B0,VDOTN2
- MX7 0 XY
- LOOP SA4 X1+B6
- SA5 X2+B6
- FX3 X4*X4 X * X
- FX6 X6+X3
- SB6 B6+B5
- FX3 X4*X5 X * Y
- FX7 X7+X3
- NX6 X6
- FX4 X5*X5 Y * Y
- NX7 X7
- FX0 X0+X4
- NX0 X0
- GE B6,B0,LOOP
- FX3 X7/X6 XY / XX
- FX2 X7/X0 XY / YY
- FX6 X3*X2 XY**2 / XX*YY
- EQ VDOTN2
- END
-#ifdef CERNLIB_TCGEN_VDOTN2
-#undef CERNLIB_TCGEN_VDOTN2
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/vfill.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/vfill.s
deleted file mode 100644
index 652aa58..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/vfill.s
+++ /dev/null
@@ -1,38 +0,0 @@
-*
-* $Id: vfill.s,v 1.1.1.1 1996/02/15 17:51:27 mclareni Exp $
-*
-* $Log: vfill.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:27 mclareni
-* Kernlib
-*
-*
- IDENT VFILL
-*
-* CERN PROGLIB# F121 VFILL .VERSION KERNCDC 0.1 750820
-*
-* (WRITTEN FOR SCOPE 3.3 - FTN)
-* CALL VFILL(X,N,ALPHA)
-* SETS
-* X(I) = ALPHA FOR I = 1,N
-*
-*
- ENTRY VFILL
- VFD 30/5HVFILL,30/VFILL
- VFILL DATA 0
- SA4 A1+1
- SA5 A1+2
- SA2 X4 X2= N
- SB6 -1
- ZR X2,VFILL
- SA3 X5 X3= ALPHA
- BX7 X3
- NG X2,VFILL
- SB4 X2+B6
- LOOP SA7 X1+B4
- SB4 B4+B6
- GE B4,B0,LOOP
- EQ B0,B0,VFILL
- END
-#ifdef CERNLIB_TCGEN_VFILL
-#undef CERNLIB_TCGEN_VFILL
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/vline.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/vline.s
deleted file mode 100644
index 64aed53..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/vline.s
+++ /dev/null
@@ -1,47 +0,0 @@
-*
-* $Id: vline.s,v 1.1.1.1 1996/02/15 17:51:27 mclareni Exp $
-*
-* $Log: vline.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:27 mclareni
-* Kernlib
-*
-*
- IDENT VLINE
-*
-* CERN PROGLIB# F121 VLINE .VERSION KERNCDC 0.1 750820
-*
-* CALL VLINE(A,ALPHA,B,BETA,X,N)
-* SETS
-* X(I) = A(I)*ALPHA + B(I)*BETA FOR I = 1,N
-*
-*
- ENTRY VLINE
- VFD 30/5HVLINE,30/VLINE
- VLINE DATA 0
- SB7 -1
- SA2 A1-B7
- SB1 X1+B7
- SA3 X2
- SA4 A2-B7
- SB3 X4+B7
- SA2 A4-B7
- SA1 X2
- SA5 A2-B7
- SA2 A5-B7
- SA4 X2
- SB6 X4
- GE B0,B6,VLINE
- LOOP SA2 B1+B6
- FX6 X2*X3
- SA4 B3+B6
- FX7 X4*X1
- FX0 X6+X7
- SB6 B6-1
- NX7 X0
- SA7 X5+B6
- NE B0,B6,LOOP
- EQ B0,B0,VLINE
- END
-#ifdef CERNLIB_TCGEN_VLINE
-#undef CERNLIB_TCGEN_VLINE
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/vmatl.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/vmatl.s
deleted file mode 100644
index 5890729..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/vmatl.s
+++ /dev/null
@@ -1,61 +0,0 @@
-*
-* $Id: vmatl.s,v 1.1.1.1 1996/02/15 17:51:27 mclareni Exp $
-*
-* $Log: vmatl.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:27 mclareni
-* Kernlib
-*
-*
- IDENT VMATL
-*
-* CERN PROGLIB# F121 VMATL .VERSION KERNCDC 0.1 750820
-*
-* CALL VMATL(H,A,X,K,N)
-* SETS
-* X = A * H WHERE H IS A MATRIX OF DIMENSION N*K
-* A IS A VECTOR OF DIMENSION N
-* X IS A VECTOR OF DIMENSION K
-*
-*
- ENTRY VMATL
- VFD 30/5HVMATL,30/VMATL
- VMATL DATA 0
- SB7 1
- SB1 X1
- SA2 A1+B7
- MX6 0
- SA3 A2+B7
- SB6 B0
- SA1 A3+B7
- SA4 X1
- SB3 X3
- SA5 A1+B7
- SB4 X4
- SA1 X5
- SB5 X1
- LE B4,B0,VMATL
- GT B5,B0,NEXT
- LOOP1 SA6 B3+B6
- SB6 B6+B7
- LT B6,B4,LOOP1
- EQ B0,B0,VMATL
- NEXT SA1 B1-B7
- SB3 B3-1
- SB1 B0
- LOOP3 SB6 B0
- MX6 0
- SB1 B1+B7
- LOOP2 SA1 A1+B7
- SA4 X2+B6
- RX3 X1*X4
- RX7 X6+X3
- SB6 B6+B7
- NX6 B0,X7
- LT B6,B5,LOOP2
- SA6 B3+B1
- LT B1,B4,LOOP3
- EQ B0,B0,VMATL
- END
-#ifdef CERNLIB_TCGEN_VMATL
-#undef CERNLIB_TCGEN_VMATL
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/vmatr.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/vmatr.s
deleted file mode 100644
index 8586cd0..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/vmatr.s
+++ /dev/null
@@ -1,63 +0,0 @@
-*
-* $Id: vmatr.s,v 1.1.1.1 1996/02/15 17:51:27 mclareni Exp $
-*
-* $Log: vmatr.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:27 mclareni
-* Kernlib
-*
-*
- IDENT VMATR
-*
-* CERN PROGLIB# F121 VMATR .VERSION KERNCDC 0.1 750820
-*
-* CALL VMATR(A,G,X,N,K)
-* SETS
-* X = G * A WHERE G IS A MATRIX OF DIMENSION K*N
-* A IS A VECTOR OF DIMENSION N
-* X IS A VECTOR OF DIMENSION K
-*
-*
- ENTRY VMATR
- VFD 30/5HVMATR,30/VMATR
- VMATR DATA 0
- SB7 1
- SB1 X1
- SA2 A1+B7
- SB2 X2
- SA1 A2+B7
- SB3 X1
- SA2 A1+B7
- MX6 0
- SA4 X2
- SB6 B0
- SA3 A2+B7
- SB4 X4
- SA5 X3
- SB5 X5
- LE B5,B0,VMATR
- GT B4,B0,NEXT
- LOOP1 SA6 B3+B6
- SB6 B6+B7
- LT B6,B5,LOOP1
- EQ B0,B0,VMATR
- NEXT SX4 B2
- SB6 B0
- LOOP3 SB5 B5-B7
- SB2 X4+B5
- MX6 0
- LOOP2 SA2 B2
- SA1 B1+B6
- RX3 X1*X2
- RX7 X6+X3
- SB6 B6+B7
- NX6 B0,X7
- SB2 B2+X5
- LT B6,B4,LOOP2
- SA6 B3+B5
- SB6 B0
- GT B5,B0,LOOP3
- EQ B0,B0,VMATR
- END
-#ifdef CERNLIB_TCGEN_VMATR
-#undef CERNLIB_TCGEN_VMATR
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/vmax.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/vmax.s
deleted file mode 100644
index e8d25be..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/vmax.s
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: vmax.s,v 1.1.1.1 1996/02/15 17:51:27 mclareni Exp $
-*
-* $Log: vmax.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:27 mclareni
-* Kernlib
-*
-*
- IDENT VMAX
-*
-* CERN PROGLIB# F121 VMAX .VERSION KERNCDC 0.1 750820
-*
-* Y = VMAX(A,N)
-* SETS
-* Y = MAX(A(I), I=1,N)
-*
- ENTRY VMAX
- VFD 24/4HVMAX,36/VMAX
- VMAX DATA 0
- SB5 -1
- SA3 A1-B5
- MX6 0
- SA2 X3
- SB3 X2+B5
- SA5 X1+B3
- GT B0,B3,VMAX
- BX6 X5
- EQ B0,B3,VMAX
- SB3 B3+B5
- SA4 X1+B3
- LOOP FX5 X4-X6
- SB3 B3+B5
- NG X5,ENDLP
- BX6 X4
- ENDLP SA4 X1+B3
- GE B3,B0,LOOP
- EQ B0,B0,VMAX
- END
-#ifdef CERNLIB_TCGEN_VMAX
-#undef CERNLIB_TCGEN_VMAX
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/vmaxa.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/vmaxa.s
deleted file mode 100644
index 94d0749..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/vmaxa.s
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: vmaxa.s,v 1.1.1.1 1996/02/15 17:51:27 mclareni Exp $
-*
-* $Log: vmaxa.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:27 mclareni
-* Kernlib
-*
-*
- IDENT VMAXA
-*
-* CERN PROGLIB# F121 VMAXA .VERSION KERNCDC 0.1 750820
-*
-* Y = VMAXA(A,N)
-* SETS
-* Y = MAX(ABS(A(I)), I=1,N)
-*
- ENTRY VMAXA
- VFD 30/5HVMAXA,30/VMAXA
- VMAXA DATA 0
- SB7 -1
- SA3 A1-B7
- SB1 X1+B7
- SA2 X3
- MX6 0
- SB3 X2
- SA1 B1+B3
- GE B0,B3,VMAXA
- LOOP BX3 X1
- AX1 60
- SB3 B3-1
- BX4 X1-X3
- SA1 B1+B3
- FX5 X4-X6
- NG X5,ENDLP
- BX6 X4
- ENDLP LT B0,B3,LOOP
- EQ B0,B0,VMAXA
- END
-#ifdef CERNLIB_TCGEN_VMAXA
-#undef CERNLIB_TCGEN_VMAXA
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/vmin.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/vmin.s
deleted file mode 100644
index 31883e0..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/vmin.s
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: vmin.s,v 1.1.1.1 1996/02/15 17:51:27 mclareni Exp $
-*
-* $Log: vmin.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:27 mclareni
-* Kernlib
-*
-*
- IDENT VMIN
-*
-* CERN PROGLIB# F121 VMIN .VERSION KERNCDC 0.1 750820
-*
-* Y = VMIN(A,N)
-* SETS
-* Y = MIN(A(I), I=1,N)
-*
- ENTRY VMIN
- VFD 24/4HVMIN,36/VMIN
- VMIN DATA 0
- SB5 -1
- SA3 A1-B5
- MX6 0
- SA2 X3
- SB3 X2+B5
- SA5 X1+B3
- GT B0,B3,VMIN
- BX6 X5
- EQ B0,B3,VMIN
- SB3 B3+B5
- SA4 X1+B3
- LOOP FX5 X6-X4
- SB3 B3+B5
- NG X5,ENDLP
- BX6 X4
- ENDLP SA4 X1+B3
- GE B3,B0,LOOP
- EQ B0,B0,VMIN
- END
-#ifdef CERNLIB_TCGEN_VMIN
-#undef CERNLIB_TCGEN_VMIN
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/vmina.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/vmina.s
deleted file mode 100644
index 47764d0..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/vmina.s
+++ /dev/null
@@ -1,44 +0,0 @@
-*
-* $Id: vmina.s,v 1.1.1.1 1996/02/15 17:51:28 mclareni Exp $
-*
-* $Log: vmina.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:28 mclareni
-* Kernlib
-*
-*
- IDENT VMINA
-*
-* CERN PROGLIB# F121 VMINA .VERSION KERNCDC 0.1 750820
-*
-* Y = VMINA(A,N)
-* SETS
-* Y = MIN(ABS(A(I)), I=1,N)
-*
- ENTRY VMINA
- VFD 30/5HVMINA,30/VMINA
- VMINA DATA 0
- SB7 -1
- SA3 A1-B7
- SB1 X1+B7
- SA2 X3
- MX6 0
- SB3 X2
- GE B0,B3,VMINA
- SA1 B1+B3
- BX5 X1
- AX5 60
- BX6 X5-X1
- LOOP BX3 X1
- AX1 60
- SB3 B3-1
- BX4 X1-X3
- SA1 B1+B3
- FX5 X6-X4
- NG X5,ENDLP
- BX6 X4
- ENDLP LT B0,B3,LOOP
- EQ B0,B0,VMINA
- END
-#ifdef CERNLIB_TCGEN_VMINA
-#undef CERNLIB_TCGEN_VMINA
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/vmod.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/vmod.s
deleted file mode 100644
index fe5fce4..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/vmod.s
+++ /dev/null
@@ -1,51 +0,0 @@
-*
-* $Id: vmod.s,v 1.1.1.1 1996/02/15 17:51:28 mclareni Exp $
-*
-* $Log: vmod.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:28 mclareni
-* Kernlib
-*
-*
- IDENT VMOD
-*
-* CERN PROGLIB# F121 VMOD .VERSION KERNCDC 0.1 750820
-*
-* Y = VMOD(A,N)
-* SETS
-* Y = MODULUS OF A (A HAVING DIMENSION N)
-*
-*
- ENTRY VMOD
- EXT SQRT
- VFD 24/4HVMOD,36/VMOD
- VMOD DATA 0
- SB5 -1
- SA3 A1-B5
- MX6 0
- SA2 X3
- SB1 X1
- ZR X2,VMOD
- SB6 X2+B5
- NG X2,VMOD
- LOOP SA1 B1+B6
- FX3 X1*X1
- SB6 B6+B5
- FX7 X6+X3
- NX6 X7
- GE B6,B0,LOOP
- SA6 LOC
- SB1 A6
- SX7 B1
- SA7 ARG
- MX6 0
- SA6 A7-B5
- SA1 ARG
- + RJ SQRT
- - LT B0,B1,VMOD-1
- EQ B0,B0,VMOD
- LOC DATA 0
- ARG BSS 2
- END
-#ifdef CERNLIB_TCGEN_VMOD
-#undef CERNLIB_TCGEN_VMOD
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/vmul.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/vmul.s
deleted file mode 100644
index 5eb20ad..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/vmul.s
+++ /dev/null
@@ -1,39 +0,0 @@
-*
-* $Id: vmul.s,v 1.1.1.1 1996/02/15 17:51:28 mclareni Exp $
-*
-* $Log: vmul.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:28 mclareni
-* Kernlib
-*
-*
- IDENT VMUL
-*
-* CERN PROGLIB# F121 VMUL .VERSION KERNCDC 0.1 750820
-*
-* CALL VMUL(A,B,X,N)
-* SETS
-* X(I) = A(I) * B(I) FOR I = 1,N
-*
-*
- ENTRY VMUL
- VFD 24/4HVMUL,36/VMUL
- VMUL DATA 0
- SB5 -1
- SA2 A1-B5
- SA3 A2-B5
- SA5 A3-B5
- SA4 X5
- ZR X4,VMUL
- SB6 X4+B5
- NG X4,VMUL
- LOOP SA4 X1+B6
- SA5 X2+B6
- FX7 X4*X5
- SA7 X3+B6
- SB6 B6+B5
- GE B6,B0,LOOP
- EQ B0,B0,VMUL
- END
-#ifdef CERNLIB_TCGEN_VMUL
-#undef CERNLIB_TCGEN_VMUL
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/vscale.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/vscale.s
deleted file mode 100644
index 4826e68..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/vscale.s
+++ /dev/null
@@ -1,39 +0,0 @@
-*
-* $Id: vscale.s,v 1.1.1.1 1996/02/15 17:51:28 mclareni Exp $
-*
-* $Log: vscale.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:28 mclareni
-* Kernlib
-*
-*
- IDENT VSCALE
-*
-* CERN PROGLIB# F121 VSCALE .VERSION KERNCDC 0.1 750820
-*
-* CALL VSCALE(A,ALPHA,X,N)
-* SETS
-* X(I) = A(I) * ALPHA FOR I = 1,N
-*
-*
- ENTRY VSCALE
- VFD 36/6HVSCALE,24/VSCALE
- VSCALE DATA 0
- SB5 -1
- SA4 A1-B5
- SA3 A4-B5
- SA2 X4
- SA5 A3-B5
- SA4 X5
- SB6 X4+B5
- ZR X4,VSCALE
- NG X4,VSCALE
- LOOP SA4 X1+B6
- FX6 X4*X2
- SA6 X3+B6
- SB6 B6+B5
- GE B6,B0,LOOP
- EQ B0,B0,VSCALE
- END
-#ifdef CERNLIB_TCGEN_VSCALE
-#undef CERNLIB_TCGEN_VSCALE
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/vsub.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/vsub.s
deleted file mode 100644
index 4536829..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/vsub.s
+++ /dev/null
@@ -1,46 +0,0 @@
-*
-* $Id: vsub.s,v 1.1.1.1 1996/02/15 17:51:28 mclareni Exp $
-*
-* $Log: vsub.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:28 mclareni
-* Kernlib
-*
-*
- IDENT VSUB
-*
-* CERN PROGLIB# F121 VSUB .VERSION KERNCDC 0.1 750820
-*
-* CALL VSUB(A,B,X,N)
-* SETS
-* X(I) = A(I) - B(I) FOR I = 1,N
-*
-*
- ENTRY VSUB
- VFD 24/4HVSUB,36/VSUB
- VSUB DATA 0
- SB5 -1
- SA2 A1-B5
- SA4 A2-B5
- SB3 X4+1
- SA5 A4-B5
- SA4 X5
- SB6 X4+B5
- SA1 X1+B6
- SA2 X2+B6
- LT B6,B0,VSUB
- EQ B6,B0,FIN
- LOOP FX6 X1-X2
- SA1 A1+B5
- SA2 A2+B5
- NX7 X6
- SB6 B6+B5
- SA7 B3+B6
- GT B6,B0,LOOP
- FIN FX6 X1-X2
- NX7 X6
- SA7 B3+B5
- EQ B0,B0,VSUB
- END
-#ifdef CERNLIB_TCGEN_VSUB
-#undef CERNLIB_TCGEN_VSUB
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/vsum.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/vsum.s
deleted file mode 100644
index dd484b5..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/vsum.s
+++ /dev/null
@@ -1,37 +0,0 @@
-*
-* $Id: vsum.s,v 1.1.1.1 1996/02/15 17:51:28 mclareni Exp $
-*
-* $Log: vsum.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:28 mclareni
-* Kernlib
-*
-*
- IDENT VSUM
-*
-* CERN PROGLIB# F121 VSUM .VERSION KERNCDC 0.1 750820
-*
-* Y = VSUM(A,N)
-* SETS
-* Y = A(1) + A(2) + ...... + A(N)
-*
-*
- ENTRY VSUM
- VFD 24/4HVSUM,36/VSUM
- VSUM DATA 0
- SB5 -1
- SA3 A1-B5
- MX6 0
- SA2 X3
- SB6 X2+B5
- ZR X2,VSUM
- NG X2,VSUM
- LOOP SA4 X1+B6
- FX3 X6+X4
- SB6 B6+B5
- NX6 X3
- GE B6,B0,LOOP
- EQ B0,B0,VSUM
- END
-#ifdef CERNLIB_TCGEN_VSUM
-#undef CERNLIB_TCGEN_VSUM
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/vunit.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/vunit.s
deleted file mode 100644
index fa9efaf..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/vunit.s
+++ /dev/null
@@ -1,83 +0,0 @@
-*
-* $Id: vunit.s,v 1.1.1.1 1996/02/15 17:51:28 mclareni Exp $
-*
-* $Log: vunit.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:28 mclareni
-* Kernlib
-*
-*
- IDENT VUNIT
-*
-* CERN PROGLIB# F121 VUNIT .VERSION KERNCDC 0.1 750820
-*
-* CALL VUNIT(A,X,N)
-* SETS
-* X(I) = A(I) / MODULUS(A) FOR I = 1,N
-*
-*
- ENTRY VUNIT
- EXT SQRT
- VFD 30/5HVUNIT,30/VUNIT
- VUNIT DATA 0
- SB7 -1
- SA2 A1-B7
- SB1 X1
- BX6 X2
- SA4 A2-B7
- SA6 TEMP2 STORE B
- SA3 X4 PICK UP N
- MX6 0 X6 IS TO HOLD SUM OF SQUARES
- SB5 X3 B5 = N
- BX7 X3
- LE B5,B0,VUNIT RETURN IF N LE ZERO
- SB4 B0 B4 IS TO HOLD I-1
- SA7 TEMP3 STORE N
- LOOP1 SA1 B1+B4 PICK UP NEXT A(I)
- RX4 X1*X1 X4 = A(I)**2
- SB4 B4+1 INCREMENT B4 (I)
- RX7 X6+X4 ADD ON A(I)**2
- NX6 B0,X7 NORMALISE
- LT B4,B5,LOOP1 LOOP
- SA6 TEMP4 STORE SUM OF SQUARES
- SX7 B1
- SX6 TEMP4
- SA7 TEMP1 STORE A
- SA6 ARG
- MX7 0
- SA7 A6-B7
- SA1 ARG
- + RJ SQRT
- - LT B0,B1,VUNIT-1
- SA5 =1.0 X5 = 1.0
- RX4 X5/X6 FORM INVERSE OF X6
- SA3 TEMP3 PICK UP N
- SA1 TEMP1 PICK UP A
- SA2 TEMP2 PICK UP B
- SB5 X3-1 B5 = N-1
- SA3 X1 PICK UP A(1)
- ZR X6,ZERO JUMP IF SUM OF SQUARES IS ZERO
- SB4 B0 B4 IS TO HOLD I-1
- RX6 X3*X4 MULTIPLY IT BY REQUIRED FACTOR
- EQ B5,B0,FIN
- LOOP2 SA6 X2+B4 STORE RESULT IN B(I)
- SB4 B4+1 INCREMENT I
- NO
- SA3 X1+B4 PICK UP NEXT A(I)
- RX6 X3*X4 MULTIPLY IT BY REQUIRED FACTOR
- LT B4,B5,LOOP2 LOOP
- FIN SA6 X2+B4 STORE B(N)
- EQ B0,B0,VUNIT RETURN
- ZERO SX6 B0 RETURN A ZERO VECTOR
- LOOP3 SA6 X2+B5
- SB5 B5-1
- GE B5,B0,LOOP3
- EQ B0,B0,VUNIT
- TEMP1 BSS 1
- TEMP2 BSS 1
- TEMP3 BSS 1
- TEMP4 BSS 1
- ARG BSS 2
- END
-#ifdef CERNLIB_TCGEN_VUNIT
-#undef CERNLIB_TCGEN_VUNIT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/vzero.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/vzero.s
deleted file mode 100644
index ca60cbf..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcftn/vzero.s
+++ /dev/null
@@ -1,36 +0,0 @@
-*
-* $Id: vzero.s,v 1.1.1.1 1996/02/15 17:51:28 mclareni Exp $
-*
-* $Log: vzero.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:28 mclareni
-* Kernlib
-*
-*
- IDENT VZERO
-*
-* CERN PROGLIB# F121 VZERO .VERSION KERNCDC 0.1 750820
-*
-* (WRITTEN FOR SCOPE 3.3 - FTN)
-* CALL VZERO(X,N)
-* SETS
-* X(I) = 0 FOR I = 1,N
-*
-*
- ENTRY VZERO
- VFD 30/5HVZERO,30/VZERO
- VZERO DATA 0
- SA4 A1+1
- SB4 -1
- SA2 X4 X2= N
- MX6 0
- SB3 X2+B4
- ZR X2,VZERO
- NG X2,VZERO
- LOOP SA6 X1+B3
- SB3 B3+B4
- GE B3,B0,LOOP
- EQ B0,B0,VZERO
- END
-#ifdef CERNLIB_TCGEN_VZERO
-#undef CERNLIB_TCGEN_VZERO
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcnos/defmodel.inc b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcnos/defmodel.inc
deleted file mode 100644
index 166a8b4..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcnos/defmodel.inc
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: defmodel.inc,v 1.1.1.1 1996/02/15 17:51:29 mclareni Exp $
-*
-* $Log: defmodel.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:51:29 mclareni
-* Kernlib
-*
-*
-*
-* defmodel.inc
-*
- MODEL MICRO 1,,*74*
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcnos/detach.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcnos/detach.s
deleted file mode 100644
index 28bf55c..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcnos/detach.s
+++ /dev/null
@@ -1,58 +0,0 @@
-*
-* $Id: detach.s,v 1.1.1.1 1996/02/15 17:51:29 mclareni Exp $
-*
-* $Log: detach.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:29 mclareni
-* Kernlib
-*
-*
- IDENT DETACH
-*
-* CERN PROGLIB# K511 DETACH .VERSION KERNCDC 1.16 820129
-*
- ENTRY DETACH
- EXT GETFIT.
- SST
-*
-* CALL DETACH (LUN)
-* TO RETURN A DISK FILE TO THE SYSTEM DURING EXECUTION
-*
-* SHORT VERSION OF RETRNF FOR DISK FILES, 3-MAY-78, JZ
-*
- TRACE. VFD 42/0HDETACH,18/DETACH
- TEMPA0 BSS 1
- LFIT BSS 1
-*
- HOME BSS 0
- HOMEX BSS 0
- SA5 TEMPA0
- SA0 X5
- DETACH BSSZ 1
- MX6 1
- BX1 X1+X6
- + RJ GETFIT.
- - VFD 30/TRACE.
- SX6 A0
- SA6 TEMPA0
- BX6 X1
- SA6 LFIT SAVE ADR OF FIT
- STORE X1,EX=ERROR
- FETCH X1,OC,X2
- SX3 X2-1
- ZR X3,OPENED
- OPENM X1,I-O,R
- SA1 LFIT X1= LFIT RESTORED
-*
- OPENED BSS 0
- CLOSEM X1,U
- SA1 LFIT X1= LFIT RESTORED
- EQ HOME
-*
- ERROR BSS 1
- SA1 LFIT X1= LFIT RESTORED
- STORE X1,ES=0 CLEAR FIES
- EQ HOMEX
- END
-#ifdef CERNLIB_CDCSYS_DETACH
-#undef CERNLIB_CDCSYS_DETACH
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcnos/dmpfit.F b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcnos/dmpfit.F
deleted file mode 100644
index dec1b5e..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcnos/dmpfit.F
+++ /dev/null
@@ -1,115 +0,0 @@
-*
-* $Id: dmpfit.F,v 1.1.1.1 1996/02/15 17:51:29 mclareni Exp $
-*
-* $Log: dmpfit.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:29 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE DMPFIT (LUNP,NWFIT,COMMENT)
-
-C CERN PROGLIB# DMPFIT .VERSION KERNCDC 1.16 820129
-
-C- DEBUG ROUTINE TO PRINT FIT CONTENTS WITH MNEMONICS
-C- LUNP LOGICAL UNIT
-C- NWFIT NUMBER OF FIT-WORDS TO BE PRINTED
-C- COMMENT TEXT-STRING TERMINATED BY . FOR PRINTING
-
-C- EXAMPLE: CALL DMPFIT (3LPAM, 100,"PAM OPENED.")
-C- ALL FIT-WORDS
-
- COMMON /COMFIT/ LUN,LFIT,MFIT(40),MWK(40)
- COMMON /IDFIT/ IDI(200)
- DIMENSION COMMENT (9)
- DIMENSION MCM(80)
- EQUIVALENCE (MCM,LUN)
- DIMENSION MFMT(20), KFMT(15)
-
- DATA MFMT / 10H(5X3HL + ,10HI2,3X, , 18*0 /
- DATA MFMTE/ 3H1X) /
- DATA KFMT / 10HO1,1X,A5, ,10HO2,1X,A5, ,10HO3,1X,A5,
- +, 10HO4,1X,A5, ,10HO5,1X,A5, ,10HO6,1X,A5,
- +, 10HO7,1X,A5, ,10HO8,1X,A5, ,10HO9,1X,A5,
- +, 10HO10,1X,A5, ,10HO11,1X,A5, ,10HO12,1X,A5,
- +, 10HO13,1X,A5, ,10HO14,1X,A5, ,10HO15,1X,A5, /
- DATA IDOT / 1H. /
- DATA IFALL /4HO20) /
-
- DATA IDI /0, 12,3HDVT, 1,3H- , 1,3HRDR, 9,3H- , 1,3HFF , 1
- + 6,3H- , 6,3HDC , 6,3HLGF, 18,3HFWB, 0,0,0,0,0,0,0,0, 1+
- +0, 24,3HLBL, 1,3HLCR, 1,3H- , 7,3HFP , 3,3HULP, 2,3HLT , 10
- + 22,3HLA , 10+
- +0, 24,3HRL , 1,3HCM , 2,3HOF , 3,3HCF , 2,3HVF , 4,3HRT , 11
- + 3,3HBT , 3,3HFO , 18,3HLX , 11+
- +0, 24,3HMRL, 18,3H- , 18,3HDX , 12
- +0, 2,3H- , 2,3HDFC, 2,3HEFC, 9,3HECT, 9,3HERL, 1,3H- , 13
- + 1,3HPEF, 3,3H- , 4,3HSES, 9,3HES , 18,3HEX , 0, 13+
- +0, 24,3HHL , 3,3H- , 3,3HEO , 1,3H- , 1,3HBAL, 1,3HSTF, 15
- + 1,3HPDF, 1,3HSBF, 1,3HSPR, 1,3H- , 1,3HORG, 22,3HWSA, 15+
- +0, 24,3HTL , 6,3HCL , 6,3HPC , 6,3HMUL, 18,3HHRL, 16
- +0, 1,3HFNF, 2,3HOC , 3,3HPD , 6,3H- , 1,3HB8F, 1,3HC1 , 17
- + 1,3HSB , 24,3HCP , 1,3H- , 1,3HCNF, 1,3HBBH, 18,3HBFS, 17+
- +0, 24,3HPTL, 6,3HLOP, 30,3HRC , 18
- +0, 24,3HMBL, 6,3HVNO, 30,3HBN , 19
- + 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 /
-
-
- CALL VBLANK (MFMT(3),18)
- CALL UBLOW (COMMENT,MCM,80)
- NCM = IUFIND (IDOT,MCM,1,79)
- PRINT 9001, (MCM(J),J=1,NCM)
-
- LUN = LUNP
- CALL LOAFIT (LUN)
- PRINT 9004, LUN,LFIT
- JX = 1
- JW = 0
- NWPR= MIN0 (NWFIT,35)
-
-C---- START FIT
- MWK(1) = 0
-
-C-- NEXT WORD
-
- 21 JW = JW + 1
- MWD = MFIT(JW)
- JB = 61
- JFMT = 3
- JPUT = 1
- IF (IDI(JX).EQ.0) GO TO 26
-
-C-- NEXT ITEM
-
- 24 NB = IDI(JX)
- IF (NB.EQ.0) GO TO 27
- JB = JB - NB
- JPUT = JPUT + 2
- MWK(JPUT-1) = JBYT (MWD,JB,NB)
- MWK(JPUT) = IDI(JX+1)
- J = (NB-1)/3
- MFMT(JFMT) = KFMT(J+1)
- JFMT = JFMT + 1
- JX = JX + 2
- GO TO 24
-
-C-- PRINT 1 WORD
-
- 26 JPUT = JPUT+1
- MWK(JPUT) = MWD
- MFMT(JFMT)= IFALL
- JFMT = JFMT+1
-
- 27 MFMT(JFMT) = MFMTE
- PRINT MFMT, (MWK(J),J=1,JPUT)
- MWK(1) = MWK(1) + 1
- JX = JX + 1
- IF (MWK(1).LT.NWPR) GO TO 21
- PRINT 9099
- RETURN
-
- 9001 FORMAT ("0DMPFIT. ",80A1)
- 9004 FORMAT ("0FIT FOR FILE ",A7," AT ",O6/1X)
- 9099 FORMAT (1X)
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcnos/loafit.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcnos/loafit.s
deleted file mode 100644
index b7c7dd1..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcnos/loafit.s
+++ /dev/null
@@ -1,44 +0,0 @@
-*
-* $Id: loafit.s,v 1.1.1.1 1996/02/15 17:51:29 mclareni Exp $
-*
-* $Log: loafit.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:29 mclareni
-* Kernlib
-*
-*
- IDENT LOAFIT
-*
-* CERN PROGLIB# LOAFIT .VERSION KERNCDC 1.16 820129
-*
- ENTRY LOAFIT
- EXT UCOPY,GETFIT.
-*
-* CALL LOAFIT (LUN) COPIES FIT FOR LUN INTO MFIT IN /COMFIT/
-*
- USE /COMFIT/
- LUN BSS 1
- LFIT BSS 1
- MFIT BSS 40
- MWK BSS 40
- USE
-*
- TRACE VFD 36/6HLOAFIT,24/LOAFIT
- LOAFIT DATA 0
- MX6 1
- BX1 X1+X6
-+RJGETFIT
- BX6 X1
- SA6 LFIT
- SA6 PARI
-*
- SA1 PARI
-+RJUCOPY
-- VFD 30/TRACE
- EQ LOAFIT
-*
- NF DATA 35
- PARI DATA 0
- VFD 42/0,18/MFIT
- VFD 42/0,18/NF
- DATA 0
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcnos/retrnf.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcnos/retrnf.s
deleted file mode 100644
index 0ec1b70..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcnos/retrnf.s
+++ /dev/null
@@ -1,59 +0,0 @@
-*
-* $Id: retrnf.s,v 1.1.1.1 1996/02/15 17:51:29 mclareni Exp $
-*
-* $Log: retrnf.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:29 mclareni
-* Kernlib
-*
-*
- IDENT RETRNF
-*
-* CERN PROGLIB# K510 RETRNF .VERSION KERNCDC 1.18 820317
-*
- ENTRY RETRNF
- EXT GETFIT.
- SST
-*
-* CALL RETRNF (LUN,ERROR) RETURN FILE LUN
-* DERIVED FROM P=CDCNOS, D=DETACH
-*
- TRACE. VFD 42/0HRETRNF,18/RETRNF
- TEMPA0 BSS 1
- LFIT BSS 1
-*
- HOME BSS 0
- HOMEX BSS 0
- SA5 TEMPA0
- SA0 X5
- RETRNF BSSZ 1
- SA2 A1+1
- MX6 0
- SA6 X2 RETURN ERROR=0
- MX6 1
- BX1 X1+X6
- + RJ GETFIT.
- - VFD 30/TRACE.
- SX6 A0
- SA6 TEMPA0
- BX6 X1
- SA6 LFIT SAVE ADR OF FIT
- STORE X1,EX=ERROR
- FETCH X1,OC,X2
- SX3 X2-1
- ZR X3,OPENED
- OPENM X1,I-O,R
- SA1 LFIT X1= LFIT RESTORED
-*
- OPENED BSS 0
- CLOSEM X1,U
- SA1 LFIT X1= LFIT RESTORED
- EQ HOME
-*
- ERROR BSS 1
- SA1 LFIT X1= LFIT RESTORED
- STORE X1,ES=0 CLEAR FIES
- EQ HOMEX
- END
-#ifdef CERNLIB_CDCSYS_RETRNF
-#undef CERNLIB_CDCSYS_RETRNF
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcnosbe/defmodel.inc b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcnosbe/defmodel.inc
deleted file mode 100644
index 3d455d4..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcnosbe/defmodel.inc
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: defmodel.inc,v 1.1.1.1 1996/02/15 17:51:28 mclareni Exp $
-*
-* $Log: defmodel.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:51:28 mclareni
-* Kernlib
-*
-*
-*
-* defmodel.inc
-*
- MODEL MICRO 1,,*74*
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcnosbe/intrac.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcnosbe/intrac.s
deleted file mode 100644
index 79dddcc..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcnosbe/intrac.s
+++ /dev/null
@@ -1,39 +0,0 @@
-*
-* $Id: intrac.s,v 1.1.1.1 1996/02/15 17:51:28 mclareni Exp $
-*
-* $Log: intrac.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:28 mclareni
-* Kernlib
-*
-*
- IDENT INTRAC
-*
-* CERN PROGLIB# Z044 INTRAC .VERSION KERNCDC 2.14 850320
-* ORIG. 20/02/83 HRR FROM GENLIB
-*
-* LOGICAL FUNCTION INTRAC(DUMMY)
-* RETURNS INTRAC = .TRUE. IF CALLED IN AN INTERACTIVE JOB
-*
- ENTRY INTRAC
- INTRAC EQ *+400000B
- SX7 B0
- SA7 RWEP+1
- SB7 1
- SA2 RWEP
- BX7 X2
- + SA3 B7
- NZ X3,*
- SA7 B7
- + SA3 RWEP+1
- ZR X3,*
- AX6 B7,X3
- LX6 59
- AX6 58
- SA6 X1
- EQ INTRAC
- RWEP VFD 42/0LRWEP,18/*+1
- BSSZ 1
- END
-#ifdef CERNLIB_TCGEN_INTRAC
-#undef CERNLIB_TCGEN_INTRAC
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcsys/abend.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcsys/abend.s
deleted file mode 100644
index 500adf5..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcsys/abend.s
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: abend.s,v 1.1.1.1 1996/02/15 17:51:33 mclareni Exp $
-*
-* $Log: abend.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:33 mclareni
-* Kernlib
-*
-*
- IDENT ABEND
-*
-* CERN PROGLIB# Z035 ABEND .VERSION KERNCDC 0.1 760623
-*
- ENTRY ABEND
- MESS VFD 36/6HABEND.,24/0
- ABEND BSS 1
- MESSAGE MESS
- MX6 0
- RJ =XSYSEND.
- ABORT ,NODUMP
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcsys/datime.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcsys/datime.s
deleted file mode 100644
index 2c44929..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcsys/datime.s
+++ /dev/null
@@ -1,107 +0,0 @@
-*
-* $Id: datime.s,v 1.1.1.1 1996/02/15 17:51:33 mclareni Exp $
-*
-* $Log: datime.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:33 mclareni
-* Kernlib
-*
-*
- IDENT DATIME
-*
-* CERN PROGLIB# Z007 DATIME .VERSION KERNCDC 1.13 820111
-*
- ENTRY DATIME
- EXT DATE,TIME
-*
-* CALL DATIME (ND,NT) RETURNS INTEGER DATE ND = YYMMDD
-* INTEGER TIME NT = HHMM
-* AUG-76, JZ.
-*
- TRACE VFD 36/6HDATIME,24/DATIME
- DATIME DATA 0
- SB7 1
- SA2 A1+B7
- BX6 X1
- BX7 X2
- SA6 SAVE ADR(ND) SAVED
- SA7 A6+B7 ADR(NT) SAVED
-+RJDATEBCDDATE,CDCSYSTEMROUTINE
-- VFD 12/0,18/TRACE
-#if !defined(CERNLIB_USADATE)
-* X6= BCD-DATE .DD/MM/YY.
-* 9 6 3
- MX0 12 X0= 12-BIT MASK
- LX0 18 PICK YY FROM 3/2
- BX1 X0*X6
- LX1 42 YY INTO 10/9
- LX0 18 PICK MM FROM 6/5
- BX5 X0*X6
- LX5 12 MM INTO 8/7
- BX1 X1+X5
- LX0 18 PICK DD FROM 9/8
- BX5 X0*X6
- LX5 42 DD INTO 6/5
- BX7 X1+X5 X7= 6HYYMMDD0000
-* 9 7 5
-#endif
-#if defined(CERNLIB_USADATE)
-* X6= BCD-DATE .MM/DD/YY.
-* 9 6 3
- MX0 12 X0= 12-BIT MASK
- LX0 18 PICK YY FROM 3/2
- BX1 X0*X6
- LX1 42 YY INTO 10/9
- LX0 36 PICK MM FROM 9/8
- BX5 X0*X6
- LX5 54 MM INTO 8/7
- BX1 X1+X5
- LX0 42 PICK DD FROM 6/5
- BX5 X0*X6
- BX7 X1+X5 X7= 6HYYMMDD0000
-* 9 8 5
-#endif
- SA2 SAVE
- SB2 6 B2= 6, LOOP COUNT
- SB3 B2 B3 .NE.0 FLAG FOR DATE
-*
- CONV SX4 10 X4= 10
- SX5 33B X5= DISPLAY-CODE VALUE OF ZERO
- MX0 6
- LX0 6 X0= ..00077
- SB7 1 B7= 1
- MX6 0
-*
- LOOP DX6 X4*X6 X6= 10*(ACCU)
- LX7 6 READY NEXT DIGIT
- BX1 X0*X7
- IX3 X1-X5 X3= INTEGER-VALE OF DIGIT
- SB2 B2-B7
- IX6 X6+X3 ACCU = 10*ACCU + DIGIT
- NE B0,B2,LOOP
- SA6 X2 STORE RESULT
- EQ B0,B3,DATIME
-*
-* PROCESS TIME
-*
- SA1 SAVE+1
-+RJTIMEBCDTIME,CDCSYSTEMROUTINE
-- VFD 12/0,18/TRACE
-*
- LX6 6 X6= 8HHH.MM.SS.
- MX0 12
- BX7 X0*X6
- LX6 6
- BX6 -X0*X6
- BX7 X6+X7 X1= 7HHHMM.SS
-*
- SA2 SAVE+1
- SB2 4 B2= 4, LOOP COUNT
- SB3 B0 B3= 0, FLAG FOR TIME
- EQ CONV
-*
- SAVE DATA 0
- DATA 0
- END
-#ifdef CERNLIB_TCGEN_DATIME
-#undef CERNLIB_TCGEN_DATIME
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcsys/datimh.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcsys/datimh.s
deleted file mode 100644
index c7ee785..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcsys/datimh.s
+++ /dev/null
@@ -1,50 +0,0 @@
-*
-* $Id: datimh.s,v 1.1.1.1 1996/02/15 17:51:33 mclareni Exp $
-*
-* $Log: datimh.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:33 mclareni
-* Kernlib
-*
-*
- IDENT DATIMH
-*
-* CERN PROGLIB# Z007 DATIMH .VERSION KERNCDC 2.06 830901
-*
- ENTRY DATIMH
- EXT DATE,TIME
-*
-* CALL DATIMH (ND,NT) RETURNS HOLL. DATE ND = 8HDD/MM/YY
-* HOLL. TIME NT = 8HHH.MM.SS
-* AUG-76, JZ.
-* MODIFIED JULY 83 TO ACCEPT CHARACTER TYPE ARGUMENTS WHICH ARE
-* EITHER SCALAR OR THE FIRST ELEMENT OF AN ARRAY. H.RENSHALL/DD
-*
- TRACE VFD 36/6HDATIMH,24/DATIMH
- DATIMH DATA 0
- SB7 1
- SA2 A1+B7
- MX0 42B
- BX1 -X0*X1
- BX6 X1
- BX7 -X0*X2
- SA6 SAVE ADR(ND) SAVED
- SA7 A6+B7 ADR(NT) SAVED
-+RJDATEBCDDATE,CDCSYSTEMROUTINE
-- VFD 12/0,18/TRACE
- SA1 SAVE
- LX6 6
- SA6 X1
-*
- SA1 SAVE+1
-+RJTIMEBCDTIME,CDCSYSTEMROUTINE
-- VFD 12/0,18/TRACE
- SA1 SAVE+1
- LX6 6
- SA6 X1
- EQ DATIMH
- SAVE DATA 0
- DATA 0
- END
-#ifdef CERNLIB_TCGEN_DATIMH
-#undef CERNLIB_TCGEN_DATIMH
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcsys/detach.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcsys/detach.s
deleted file mode 100644
index ca1a3d7..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcsys/detach.s
+++ /dev/null
@@ -1,74 +0,0 @@
-*
-* $Id: detach.s,v 1.1.1.1 1996/02/15 17:51:33 mclareni Exp $
-*
-* $Log: detach.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:33 mclareni
-* Kernlib
-*
-*
- IDENT DETACH
-*
-* CERN PROGLIB# K511 DETACH .VERSION KERNCDC 1.16 820129
-*
- ENTRY DETACH
- EXT GETFIT.
- SST
-*
-* CALL DETACH (LUN)
-* TO RETURN A DISK FILE TO THE SYSTEM DURING EXECUTION
-*
-* SHORT VERSION OF RETRNF FOR DISK FILES, 3-MAY-78, JZ
-*
- TRACE. VFD 42/0HDETACH,18/DETACH
-#if defined(CERNLIB_CDC60SYS)
- TEMPA0 BSS 1
-#endif
- FICF BSS 1
- #NEVOPN# EQU 0
-*
- HOME BSS 0
- HOMEX BSS 0
- STORE X1,RC=0
- STORE X1,BN=0
- SA4 FICF
- STORE X1,CF=X4 RESTORE THE ORIGINAL CF IN THE FIT
- STORE X1,OC=NEVOPN SET FIOC TO NEVER OPENED
-#if defined(CERNLIB_CDC60SYS)
- SA5 TEMPA0
- SA0 X5
-#endif
- DETACH BSSZ 1
- MX6 1
- BX1 X1+X6
- + RJ GETFIT.
- - VFD 30/TRACE.
-#if defined(CERNLIB_CDC60SYS)
- SX6 A0
- SA6 TEMPA0
- SA0 X1 SAVE X1 WHICH WILL BE DESTROYED BY 6R
-#endif
- STORE X1,EX=ERROR
- FETCH X1,CF,X6
- SA6 FICF SAVE THE ORIGINAL CF
- FETCH X1,OC,X2
- SX3 X2-1
- ZR X3,OPENED
- OPENM X1,I-O,R
-#if defined(CERNLIB_CDC60SYS)
- SX1 A0 RESTORE X1 DESTROYED BY 6RM
-#endif
-*
- OPENED BSS 0
- CLOSEM X1,U
-#if defined(CERNLIB_CDC60SYS)
- SX1 A0 RESTORE X1 DESTROYED BY 6RM
-#endif
- EQ HOME
-*
- ERROR BSS 1
-#if defined(CERNLIB_CDC60SYS)
- SX1 A0 RESTORE X1 DESTROYED BY 6RM
-#endif
- STORE X1,ES=0 CLEAR FIES
- EQ HOMEX
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcsys/dumrzl.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcsys/dumrzl.s
deleted file mode 100644
index a3b2a8e..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcsys/dumrzl.s
+++ /dev/null
@@ -1,304 +0,0 @@
-*
-* $Id: dumrzl.s,v 1.1.1.1 1996/02/15 17:51:33 mclareni Exp $
-*
-* $Log: dumrzl.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:33 mclareni
-* Kernlib
-*
-*
- IDENT DUMRZL
-*
-* CERN PROGLIB# N202 DUMRZL .VERSION KERNCDC 1.02 771015
-*
- ENTRY DUMRZL,RESRZL,STORZL
- EXT DUMRZLX
-*
-*
-* CALL DUMRZL
-* CALL STORZL
-* CALL RESRZL
-*
-* PROGRAM TAKEN FROM CERN PROGLIB 15-OCT-77
-*
- NAME2 VFD 36/6HSTORZL,24/STORZL
- STORZL BSS 1 STORE AND RESTORE REGISTER CONT.
- RJ STOR
- SA2 STORZL STORE RETURN ADDRESS AT DUMRZL
- BX6 X2
- SA6 DUMRZL
- EQ B0,B0,JUMP
- NAME VFD 36/6HDUMRZL,24/DUMRZL
- DUMRZL BSS 1
- RJ STOR
- SA2 DUMRZL
- AX2 30
- MX1 42
- BX7 -X1*X2 CA(1)=LOC. DUMRZL CALLED FROM
- SX7 X7-1
- SA7 CA
- SB1 B0-7 FILL CA
- SB2 SA+7
- SB3 CA+7
- LOOP SB1 B1+1
- SA2 B2+B1
- SA2 X2
- BX6 X2
- SA6 B3+B1
- NE B0,B1,LOOP
- SX6 SA SET UP CALLING SEQUENCE
- SA6 ARG
- SX7 SB
- SA7 ARG+1
- SX6 SX
- SA6 ARG+2
- SX7 CA
- SA7 ARG+3
- SA1 ARG ADD. FIRST ARG.
-*
-+RJDUMRZLX
- - LT B0,B4,NAME
- EQ B0,B0,JUMP
- NAME1 VFD 36/6HRESRZL,24/RESRZL
- RESRZL BSS 1 RESTORE REGISTER CONTENTS
- SA2 RESRZL STORE RETURN ADDRESS AT DUMRZL
- BX6 X2
- SA6 DUMRZL
- JUMP MX0 18 PREPARE THE RESTOR OF X5 AND
- SA5 SX+5 CONTENTS OF X5
- SB2 B0
- SA2 BREG
- SA1 MASK B1 - B7
- BX6 -X1*X2 PRESET TO CORRECT SHIFT COUNT
- PL X5,*+1
- BX6 X6+X1
- UX5 X5,B6
- SB3 7
- NO
- LX0 33
- SB4 15
- LOOP2 SA6 BREG+B2 PLUG B-REGISTER CONTENTS
- SB2 B2+1
- SA1 SB+B2
- SA2 BREG+B2
- LX3 X1,B4
- BX4 -X0*X2 CLEAR OUT
- BX7 X0*X3 RESTRICT TO 18 BITS
- IX6 X7+X4 INSERT
- NE B2,B3,LOOP2
- LX0 15 ADJUST FOR B7
- BX4 -X0*X2
- SA1 SA CONTENTS OF A0
- LX7 15
- IX6 X7+X4
- SA3 SX CONTENTS OF X0
- MX4 60
- BX0 X3 X0
- SA6 A2
- SB7 X4+777777B B7= (-0)
- LX5 11
- SA0 X1+B7 A0
- UX5 X5,B5
- SA1 SA+6 CONTENTS OF A6
- SA3 X1+B7 AND WHAT IT STORED
- LX5 11
- SA2 SA+7 CONTENTS OF A7
- SA4 X2+B7 AND WHAT IT STORED
- BX6 X3
- SA3 SA+1 CONTENTS OF A1
- BX7 X4
- SA6 X1+B7 A6
- UX5 X5,B4
- SA7 X2+B7 A7
- LX5 11
- SA2 SX+6 CONTENTS OF X6
- SA1 X3+B7 A1
- BX6 X2 X6
- UX5 X5,B3
- SA3 SX+7 CONTENTS OF X7
- SA4 SX+1 CONTENTS OF X1
- LX5 11
- BX7 X3 X7
- SA2 SA+2 CONTENTS OF A2
- UX5 X5,B2
- BX1 X4 X1
- SA3 SX+2 CONTENTS OF X2
- LX5 11
- SA2 X2+B7 A2
- SA4 SA+3 CONTENTS OF A3
- UX5 X5,B1
- BX2 X3 X2
- SA3 X4+B7 A3
- SA5 SX+3 CONTENTS OF X3
- NO
- SA4 SA+4 CONTENTS OF A4
- BX3 X5 X3
- SA5 SX+4 CONTENTS OF X4
- SA4 X4+B7 A4
- NO
- BX4 X5 X4
- SA5 SA+5 CONTENTS OF A5
- BREG SA5 X5+B7 A5
- NO
- NO
- MX5 0
- PX5 X5,B1 SEQUENCE TO RESTOR B1-B7 AND X5
- SB1 B7+0
- LX5 49
- PX5 X5,B2
- SB2 B7+0
- LX5 49
- PX5 X5,B3
- SB3 B7+0
- LX5 49
- PX5 X5,B4
- SB4 B7+0
- LX5 49
- PX5 X5,B5
- SB5 B7+0
- LX5 49
- PX5 X5,B6
- SB6 B7+0
- SB7 B7+0
- EQ B0,B0,DUMRZL
- STOR PS
- + PL B7,*+2 BIT 17 OF B7 STORE REGISTERS
- RJ *+1
- W7 DATA 0
- SB7 B7+B7
- + PL B7,*+2 BIT 16
- RJ *+1
- DATA 0
- SB7 B7+B7
- + PL B7,*+2 BIT 15
- RJ *+1
- DATA 0
- SB7 B7+B7
- + PL B7,*+2 BIT 14
- RJ *+1
- DATA 0
- SB7 B7+B7
- + PL B7,*+2 BIT 13
- RJ *+1
- DATA 0
- SB7 B7+B7
- + PL B7,*+2 BIT 12
- RJ *+1
- DATA 0
- SB7 B7+B7
- + PL B7,*+2 BIT 11
- RJ *+1
- DATA 0
- SB7 B7+B7
- + PL B7,*+2 BIT 10
- RJ *+1
- DATA 0
- SB7 B7+B7
- + PL B7,*+2 BIT 9
- RJ *+1
- DATA 0
- SB7 B7+B7
- + PL B7,*+2 BIT 8
- RJ *+1
- DATA 0
- SB7 B7+B7
- + PL B7,*+2 BIT 7
- RJ *+1
- DATA 0
- SB7 B7+B7
- + PL B7,*+2 BIT 6
- RJ *+1
- DATA 0
- SB7 B7+B7
- + PL B7,*+2 BIT 5
- RJ *+1
- DATA 0
- SB7 B7+B7
- + PL B7,*+2 BIT 4
- RJ *+1
- DATA 0
- SB7 B7+B7
- + PL B7,*+2 BIT 3
- RJ *+1
- DATA 0
- SB7 B7+B7
- + PL B7,*+2 BIT 2
- RJ *+1
- DATA 0
- SB7 B7+B7
- + PL B7,*+2 BIT 1
- RJ *+1
- DATA 0
- SB7 B7+B7
- + PL B7,*+2 BIT 0
- RJ *+1
- DATA 0
- SB7 A7
- SA7 SX+7 X7
- SX7 A6
- SA6 SX+6 X6
- SA7 SA+6 A6
- BX6 X0
- LX7 X1,B0
- SA6 SX X0
- SA7 SX+1 X1
- BX6 X2
- LX7 X3,B0
- SA6 SX+2 X2
- SA7 SX+3 X3
- BX6 X4
- LX7 X5,B0
- SA6 SX+4 X4
- SA7 SX+5 X5
- SX6 A0-B0
- SX7 A1-B0
- SA6 SA A0
- SA7 SA+1 A1
- SX6 A2-B0
- SX7 A3-B0
- SA6 SA+2 A2
- SA7 SA+3 A3
- SX6 A4-B0
- SX7 A5-B0
- SA6 SA+4 A4
- SA7 SA+5 A5
- SX6 B7-B0
- SX7 B1-B0
- SA6 SA+7 A7
- SA7 SB+1 B1
- SX6 B2-B0
- SX7 B3-B0
- SA6 SB+2 B2
- SA7 SB+3 B3
- SX6 B4-B0
- SX7 B5-B0
- SA6 SB+4 B4
- SA7 SB+5 B5
- SX6 B6-B0
- MX2 0
- SA6 SB+6 B6
- BX7 X2
- MX4 1
- SA3 W7 NOW RECONSTRUCT B7
- SB1 1
- SB2 17
- SB3 3
- LOOP1 ZR X3,*+1
- SA7 A3 RESET TO ZERO
- BX2 X4+X2
- SB2 B2-B1
- NO
- SA3 A3+B3
- LX2 1
- PL B2,LOOP1
- BX6 X2
- MX7 0
- SA6 SB+7 B7
- SA7 SB B0
- EQ B0,B0,STOR
- MASK DATA 74B
- CA BSS 8
- SA BSSZ 8
- SB BSSZ 8
- SX BSSZ 8
- ARG BSSZ 5 PARAM. ADDRESSES FOR PRIRZL
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcsys/dumrzlx.F b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcsys/dumrzlx.F
deleted file mode 100644
index 93d49d3..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcsys/dumrzlx.F
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: dumrzlx.F,v 1.1.1.1 1996/02/15 17:51:33 mclareni Exp $
-*
-* $Log: dumrzlx.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:33 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE DUMRZLX (A,B,X,CA)
-
-C CERN PROGLIB# N202 DUMRZLX .VERSION KERNCDC 1.13 820111
-
-C- PROGRAM TAKEN FROM CERN PROGLIB 15-OCT-77
-
- DIMENSION A(8),B(8),X(8),CA(8)
-
- PRINT 2,A(1),B(1),X(1)
- DO 100 I=1,7
- IF(I.EQ.2) PRINT 1,CA(1),I,A(I+1),I,B(I+1),I,CA(I+1),I,X(I+1)
- IF(I.NE.2) PRINT 3, I,A(I+1),I,B(I+1),I,CA(I+1),I,X(I+1)
-100 CONTINUE
- PRINT 4
- RETURN
-
- 1 FORMAT (20H DUMRZL CALLED FROM ,O6,5X,1HA,I1,2X,O6,4X,1HB,I1,2X,
- + O6,4X,3HC(A,I1,4H)= ,O20,4X,1HX,I1,2X,O20)
- 2 FORMAT (18H0REGISTER CONTENTS,13X,4HA0 ,O6,4X,4HB0 ,O6,36X,
- + 4HX0 ,O20)
- 3 FORMAT (31X,1HA,I1,2X,O6,4X,1HB,I1,2X,O6,4X,3HC(A,I1,4H)= ,O20,
- + 4X,1HX,I1,2X,O20)
- 4 FORMAT (1X)
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcsys/equbuf.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcsys/equbuf.s
deleted file mode 100644
index 10e1886..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcsys/equbuf.s
+++ /dev/null
@@ -1,132 +0,0 @@
-*
-* $Id: equbuf.s,v 1.1.1.1 1996/02/15 17:51:33 mclareni Exp $
-*
-* $Log: equbuf.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:33 mclareni
-* Kernlib
-*
-*
- IDENT EQUBUF
-*
-* CERN PROGLIB# Z260 EQUBUF .VERSION KERNCDC 2.12 840712
-*
- ENTRY EQUBUF
- EXT FNNUM,GETFIT.
- SST
-*
-* CALL EQUBUF (LUNEXT,LUNINT,CLOPT,NERROR)
-* CLOPT CLOSING OPTION: N, R, U - ABSENT=U
-* NERROR RETURN RM ERROR - ABSENT: ERROR IGNORED
-*
- USE /SLATE/
- DUMMY BSS 10
- SAVEA0 BSS 1 A0 SAVED
- ARGE BSS 1 NEW FILE NAME
- LARG3 BSS 1 ADR OF 3RD ARGUMENT
- LARG4 BSS 1 ADR OF 4TH ARGUMENT
- FITADR BSS 26 ADR OF FIT
- USE
-*
- TRACE VFD 36/6HEQUBUF,24/EQUBUF
- EQUBUF DATA 0
- SB1 1
-* X1= LARG1 = ADR(ARG1=LUNEXT)
- SA2 A1+B1 X2= LARG2 = ADR(ARG2=LUNINT)
- SA3 A2+B1 X3= LARG3 = ADR(ARG3=CLOPT)
- SA5 X1 X5= ARG1 = LUNEXT
- BX1 X2 X1= ADR(LUNINT)
- SX6 A0
- SA6 SAVEA0
- BX6 X5
- SA6 A6+B1 SAVE ARG1 INTO ARGE
- BX6 X3
- SA6 A6+B1 SAVE LARG3
- MX7 0
- SA7 A6+B1 SET LARG4 = 0
- ZR X3,ALLSVD
- SA4 A3+B1 X4= LARG4 = ADR(ARG4=NERROR)
- ZR X4,ALLSVD
- SA7 X4 SET ARG4=0
- BX7 X4
- SA7 A6+B1 SAVE LARG4
-*
- ALLSVD BSS 0
- MX6 1
- BX1 X1+X6
-+RJGETFIT
-- VFD 30/TRACE
- BX7 X1
- SA7 FITADR SAVE ADR OF FIT
- SB1 1 B1= 1 RESET TO BE SAFE
- STORE X1,EX=RMERROR
- FETCH X1,OC,X4
- SB3 X4
- NE B3,B1,CLEAN JUMP IF FILE NOT OPEN
- SA3 LARG3
- ZR X3,UNLD NO ARG3
- SA4 X3 X4= ARG3
- MX0 6
- BX6 X0*X4 ISOLATE FIRST CHAR IN ARG3
- LX6 6
- SX5 X6-1RR
- SX4 X6-1RN
- ZR X5,REWD
- ZR X4,NORE
-*
- UNLD CLOSEM X1,U
- JP CLEAN
- REWD CLOSEM X1,R
- JP CLEAN
- NORE CLOSEM X1,N
-*
-*-- OPEN/CLOSE DUMMY FILE TO CLEAR FIT
-*
- CLEAN BSS 0
-**** SA1 FITADR
-**** SA2 DUMYLFN
-**** STORE X1,LFN=X2
-**** OPENM X1,I-O,N
-**** SA1 FITADR
-**** CLOSEM X1,U
-#if defined(CERNLIB_CDC76SYS)
-*
-*-- CLEAR FIT - SET TO ZERO WORDS FIT+1 TO FIT+14
-*
- SA1 FITADR
- FETCH X1,EO,X2 SAVE EO INTO X2
- MX6 0
- SB1 1
- SB2 14
- LOOP76 SA6 X1+B2
- SB2 B2-B1
- NE B2,B0,LOOP76
- STORE X1,EO=X2
-#endif
-*
-*-- SET LFN INTO FIT
-*
- SETLFN SA1 ADRARGE CONVERT FILE-NAME TO 7LXXXXXXX
-+RJFNNUM
-- VFD 30/TRACE
- SA1 FITADR X1= ADR OF FIT
- STORE X1,LFN=X6 STORE FILE NAME
- STORE X1,EX=0 CANCEL ERROR EXIT
- STORE X1,CF=N STORE -NO REWIND ON CLOSE-
- STORE X1,OF=N STORE -NO REWIND ON OPEN-
- SA4 SAVEA0 RESTORE A0
- SA0 X4
- JP EQUBUF
- ADRARGE VFD 42/0,18/ARGE
-**** DUMYLFN VFD 42/7HZQZZQQZ,18/0
-*
-*---- HANDLE RM ERROR
-*
- RMERROR DATA 0
- SA1 FITADR
- FETCH X1,ES,X6
- SA2 LARG4
- ZR X2,QUIT
- SA6 X2 STORE ERROR NUMBER
- QUIT STORE X1,ES=0
- JP RMERROR
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcsys/fnblan.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcsys/fnblan.s
deleted file mode 100644
index 0c9a663..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcsys/fnblan.s
+++ /dev/null
@@ -1,35 +0,0 @@
-*
-* $Id: fnblan.s,v 1.1.1.1 1996/02/15 17:51:33 mclareni Exp $
-*
-* $Log: fnblan.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:33 mclareni
-* Kernlib
-*
-*
- IDENT FNBLAN
-*
-* CERN PROGLIB# Z204 FNBLAN .VERSION KERNCDC 1.02 771015
-*
- ENTRY FNBLAN
-*
-* CALL FNBLAN (LUN) RETURN LUN MODIFIED :
-* CDC FILE-NAME WITH BLANK-FILL
-*
-* PROGRAM WRITTEN 15-OCT-77, JZ
-*
- VFD 36/6HFNBLAN,24/FNBLAN
- FNBLAN BSSZ 1
- SA1 X1
- MX2 42
- BX1 X1*X2 KEEP FIRST 7 CHAR.
- MX2 54 X2= 00 IN POS. 10
- SX3 55B X3= 55 IN POS. 10
- LOOP BX1 X1+X3 MERGE BLANK INTO POS. N
- LX2 6 X2= 00 IN POS. N = N-1
- LX3 6 X3= 55 IN POS. N
- BX4 -X2*X1 X4= CHAR. N ISOLATED
- ZR X4,LOOP
- BX6 X1
- SA6 A1
- EQ FNBLAN
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcsys/fnnum.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcsys/fnnum.s
deleted file mode 100644
index 5bebee5..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcsys/fnnum.s
+++ /dev/null
@@ -1,38 +0,0 @@
-*
-* $Id: fnnum.s,v 1.1.1.1 1996/02/15 17:51:34 mclareni Exp $
-*
-* $Log: fnnum.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:34 mclareni
-* Kernlib
-*
-*
- IDENT FNNUM
-*
-* CERN PROGLIB# Z204 FNNUM .VERSION KERNCDC 1.08 790126
-*
- ENTRY FNNUM
-*
-* NAME = FNNUM (NAME)
-*
- VFD 30/5HFNNUM,30/FNNUM
- FNNUM DATA 0
- SA1 X1
- MX0 53
- BX6 X0*X1
- NZ X6,FNNUM
- SA4 =5LTAPE0
- SB2 -10
- SX5 1R0
- SX6 X1+B2
- LX1 30
- NG X6,JOIN
- TWO SX5 X5+100B
- BX7 X6
- SX6 X6+B2
- PL X6,TWO
- IX1 X5+X7
- LX1 24
- JOIN IX6 X4+X1
- SA6 A1
- JP FNNUM
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcsys/fnzero.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcsys/fnzero.s
deleted file mode 100644
index 321d878..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcsys/fnzero.s
+++ /dev/null
@@ -1,35 +0,0 @@
-*
-* $Id: fnzero.s,v 1.1.1.1 1996/02/15 17:51:34 mclareni Exp $
-*
-* $Log: fnzero.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:34 mclareni
-* Kernlib
-*
-*
- IDENT FNZERO
-*
-* CERN PROGLIB# Z204 FNZERO .VERSION KERNCDC 1.02 771015
-*
- ENTRY FNZERO
-*
-* CALL FNZERO (LUN) RETURN LUN MODIFIED :
-* CDC FILE-NAME WITH ZERO-FILL
-*
-* PROGRAM WRITTEN 15-OCT-77, JZ
-*
- VFD 36/6HFNZERO,24/FNZERO
- FNZERO BSSZ 1
- SA1 X1
- MX2 42 X2= 00 IN POS. N=8
- SX3 55B
- LX3 12 X3= 55 IN POS. N=8
- LOOP BX1 X1*X2 KEEP FIRST N-1 CHAR.
- LX2 6 X2= 00 IN POS. N = N-1
- LX3 6 X3= 55 IN POS. N
- BX4 -X2*X1 X4= CHAR. N ISOLATED
- BX4 X4-X3 X4= CHAR. N - 55B
- ZR X4,LOOP
- BX6 X1
- SA6 A1
- EQ FNZERO
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcsys/incmem.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcsys/incmem.s
deleted file mode 100644
index 4e1ff98..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcsys/incmem.s
+++ /dev/null
@@ -1,71 +0,0 @@
-*
-* $Id: incmem.s,v 1.1.1.1 1996/02/15 17:51:34 mclareni Exp $
-*
-* $Log: incmem.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:34 mclareni
-* Kernlib
-*
-*
- IDENT INCMEM
-*
-* CERN PROGLIB# Z027 INCMEM .VERSION KERNCDC 0.1 751115
-*
- ENTRY INCMEM
-*
-* CALL INCMEM (NEW)
-* N = INCMEM (NEW)
-*
-* NEW: NO. OF WORDS INCREASE (+) OR DECREASE (-)
-* INPUT: REQUEST TO CHANGE BY NEW
-* OUTPUT: ACTUALLY CHANGED BY NEW
-* FUNCTION VALUE: NEW FIELD LENGTH
-*
- VFD 36/6HINCMEM,24/INCMEM
- SVA0 DATA 0
- SVX1 DATA 0
- BEFORE DATA 0
-#include "incmem1.inc"
- AFTER DATA 0
- INCMEM DATA 0
- SB7 1 B7= 1
- SX6 A0
- BX7 X1
- SA6 SVA0 SAVE A0
- SA7 A6+B7 SAVE X1
- MX7 0
- SA7 A7+B7 ZERO BEFORE
-#include "incmem2.inc"
- MEMORY SCM,BEFORE,RECALL
-*
- SB7 1 B7= 1
- SA1 SVX1 X1= ADR(NEW)
- SA2 A1+B7 X2= BEFORE (LH)
- SA3 A2+B7 X3= MAXFLD
- SA4 X1 X4= NEW
- AX2 30 X2= BEFORE (RH)
- ZR X4,RETN
- IX6 X2+X4 X6= BEFORE + NEW = AFTER
-#include "incmem7.inc"
- IX5 X6-X3 X5= AFTER - MAXFLD = EXCESS REQUEST
- AX5 59
- BX6 X5*X6 TAKE AFTER IF IN-LIMIT
- BX3 -X5*X3 TAKE MAXFLD IF EX-LIMIY
- BX6 X3+X6 X6= AFTER TO BE USED
- LX6 30 X6= AFTER (LH)
- SA6 A3+B7 STORE AFTER
- MEMORY SCM,AFTER,RECALL
-*
- SA1 SVX1 X1= ADR(NEW)
- SB7 1 B7= 1
- SA2 AFTER X2= AFTER (LH)
- SA3 A1+B7 X3= BEFORE (LH)
- AX2 30
- AX3 30
- IX7 X2-X3 X7= NEW
- SA7 X1 STORE -NEW-
-*
- RETN SA5 A1-B7
- BX6 X2 X6= AFTER AS FUNCTION-VALUE
- SA0 X5 A0 RESTORED
- EQ INCMEM
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcsys/iuweed.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcsys/iuweed.s
deleted file mode 100644
index fafa759..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcsys/iuweed.s
+++ /dev/null
@@ -1,39 +0,0 @@
-*
-* $Id: iuweed.s,v 1.1.1.1 1996/02/15 17:51:34 mclareni Exp $
-*
-* $Log: iuweed.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:34 mclareni
-* Kernlib
-*
-*
- IDENT IUWEED
-*
-* CERN PROGLIB# N103 IUWEED .VERSION KERNCDC 0.1 750820
-*
- ENTRY IUWEED
-* FUNCTION IUWEED (IVEC,N)
-*
-* IT RETURNS THE RELATIVE ADDRESS WITHIN THE N-ELEME
-* VECTOR IVEC OF THE FIRST ELEMENT CONTAINING A QUANTITY EITHER
-* INDEFINITE OR OUT OF RANGE IF ANY, 0 OTHERWISE.
-*
- VFD 36/6HIUWEED,24/IUWEED
- IUWEED BSS 1
- SA3 A1+1 X3= ADDR (N)
- SB1 X1
- SA1 X1
- BX7 X1
- SA2 X3 X2= N
- SX0 1 X0= 1
- LX6 B0,X0 X6= IUWEED
- LOOP SB6 X6
- SA1 B1+X6
- ID X7,IUWEED
- OR X7,IUWEED
- BX7 X1
- IX6 X6+X0
- IX2 X2-X0
- NZ X2,LOOP
- MX6 0
- EQ IUWEED
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcsys/jobnam.F b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcsys/jobnam.F
deleted file mode 100644
index 60802fa..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcsys/jobnam.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: jobnam.F,v 1.1.1.1 1996/02/15 17:51:34 mclareni Exp $
-*
-* $Log: jobnam.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:34 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- FUNCTION JOBNAM (NAM)
-
-C CERN PROGLIB# Z100 JOBNAM .VERSION KERNCDC 1.12 801111
-
- DATA IBLANK /7H /
-
-
- NAM = IBLANK
- JOBNAM = IBLANK
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcsys/kfile.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcsys/kfile.s
deleted file mode 100644
index 068eda1..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcsys/kfile.s
+++ /dev/null
@@ -1,57 +0,0 @@
-*
-* $Id: kfile.s,v 1.1.1.1 1996/02/15 17:51:34 mclareni Exp $
-*
-* $Log: kfile.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:34 mclareni
-* Kernlib
-*
-*
- IDENT KFILE
-*
-* CERN PROGLIB# Z261 KFILE .VERSION KERNCDC 2.07 831121
-*
- ENTRY KFILE
-*
-* WITH FORTRAN 4.7 (MARCH 1978, REVISION D OF DOCUMENT 60497800)
-* CDC HAVE CHANGED THE HANDLING OF FORTRAN FILES
-* THIS VERSION OF KFILE FOLLOWS THIS CHANGE IF +USE, FTN47.
-*
-* X6/X7 = KFILE (J)
-*
-* WITH FORTRAN 5 CDC HAVE CHANGED THE HANDLING AGAIN
-* IT SEEMS NOT POSSIBLE TO GET THE INTERNAL FILE NAME
-* HENCE X7 WILL CONTAIN ANYTHING
-*
- KFILE DATA 0
- SA1 X1 X1= J= 1,2,3,... J-TH FILE
- MX6 0 X6= 0 PRE-SET
-*
-#if defined(CERNLIB_F77)
-* FOR LOF.FTN SEE FORTRAN MANUAL, SECTION 15
- SA3 =XLOF.FTN X3= ADR(FILE-TABLE)
- SB4 X1 B4= J = 1,2,3,...
- SB4 B4+X1 B4= 2*J = 2,4,6
- SA2 X3+B4 X2= TABLE-ENTRY FOR FILE J
-#endif
-#if (defined(CERNLIB_FTN47))&&(!defined(CERNLIB_F77))
-* FOR LOF.FTN SEE FORTRAN MANUAL, SECTION 15
- SA3 =XLOF.FTN FTN 4.7 X3= ADR(FILE-TABLE)
- SB4 X1-1 FTN 4.7 B4= J-1= 0,1,2,...
- SA2 X3+B4 FTN 4.7 X2= TABLE-ENTRY FOR FILE J
-*** SA2 X1+1 EARLIER X2= TABLE-ENTRY FOR FILE J
-#endif
-#if (!defined(CERNLIB_FTN47))&&(!defined(CERNLIB_F77))
-*** FOR LOF.FTN SEE FORTRAN MANUAL, SECTION 15
-*** SA3 =XLOF.FTN FTN 4.7 X3= ADR(FILE-TABLE)
-*** SB4 X1-1 FTN 4.7 B4= J-1= 0,1,2,...
-*** SA2 X3+B4 FTN 4.7 X2= TABLE-ENTRY FOR FILE J
- SA2 X1+1 EARLIER X2= TABLE-ENTRY FOR FILE J
-#endif
-*
- MX4 42 X4= MASK FILE-NAME
- BX7 X4*X2 X7= INTERNAL FILE-NAME
- ZR X7,KFILE QUIT IF END OF TABLE
- SA3 X2
- BX6 X4*X3 X6= EXTERNAL FILE NAME
- JP KFILE
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcsys/namezz.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcsys/namezz.s
deleted file mode 100644
index 7234783..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcsys/namezz.s
+++ /dev/null
@@ -1,144 +0,0 @@
-*
-* $Id: namezz.s,v 1.1.1.1 1996/02/15 17:51:34 mclareni Exp $
-*
-* $Log: namezz.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:34 mclareni
-* Kernlib
-*
-*
- IDENT NAMEZZ
-*
-* CERN PROGLIB# NAMEZZ .VERSION KERNCDC 1.16 820129
-*
- ENTRY NAMEZZ
- EXT NAMEZZP
- PRNW EQU NAMEZZP
-* IMPROVED CERN PROG LIB J 402 21-JUNE-76
-* CHIPPEWA VERSION OF D.B. NAMEZB . 12.12.66 G V F
-*
-* SUBROUTINE NAMEZZ (8HABCDEFGH)
-*
- STORZZ MACRO
- LX6 6
- BX6 X6+X7
- SB5 B5-B1
- + NZ B5,*+2
- SA6 BUFF+B3
- + SB3 B3+B1
- SX6 B0
- SB5 10
- ENDM
-*
- NM1 VFD 36/6HNAMEZZ,24/NAMEZZ
- NAMEZZ DATA 0
- SA1 X1
- BX6 X1
- SA6 NAME
- SB7 10 NO. OF LINES OF PRINTING
- SB1 1 CONSTANT
- SB4 0 WHICH ONE OF PAIR OF WORDS/TABLE
- NEXTLIN SB6 8 NO OF LETTERS/LINE
- SB5 10 STORE 10 CHARACTERS/WORD IN BUFF
- SB3 1 CURRENT WORD IN PRINT BUFFER
- SA2 NAME
- SX5 77B MASK
- SX6 B0
- CHAR LX2 6
- BX4 X2*X5 NEXT LETTER TO PRINT
- LX4 1
- SX4 X4+B4
- SA1 X4+TABLE PICKUP APPROP CODE WORD(SHIFTED)
- SB2 12 NO OF CHARS PRINTED/LETTER
- NEXT SX7 55B BLANK CHARACTER
- + PL X1,*+1
- SX7 B1
- + STORZZ
- SB2 B2-B1
- LX1 1
- NZ B2,NEXT STILL MORE TO DO WITH CURRENT
- SX7 55B 2 BLANKS BETWEEN LETTES
- STORZZ
- SX7 55B
- STORZZ
- SB6 B6-B1 IS LINE FINISHED
- NZ B6,CHAR
-* PRNW N,(S),(BUFF),(BUFF+12),12,0
- SX7 B7
- SA7 DEPB7
- SX6 B4
- SA6 DEPB4
- SA1 BUFA
- + RJ PRNW
- - LT B0,B1,NM1
- SB1 1
- SA1 DEPB4
- SB4 X1
- SA2 DEPB7
- SB7 X2
- SB6 126
- + ZR B4,*+1
- SB6 127
- SHIFT SA1 B6+TABLE
- LX1 12
- BX6 X1
- SA6 A1
- SB6 B6-2
- PL B6,SHIFT
- SB7 B7-B1
- SB6 5
- EQ B7,B6,RESETB4
- NZ B7,NEXTLIN
- ZR B0,NAMEZZ
- RESETB4 SB4 B1
- ZR B0,NEXTLIN
- NAME BSS 1
- DEPB4 BSS 1
- DEPB7 BSS 1
- BUFA VFD 60/BUFF
- BSSZ 1
- BUFF DATA 55555555555555555555B
- BSSZ 11
- TABLE BSSZ 2
- DATA 01400220022004100410B,10041774200220024001B A
- DATA 77744002400140027774B,40024001400140027774B B
- DATA 03611004200240004000B,40004000200210040360B C
- DATA 77404010400240004001B,40014000400240107740B D
- DATA 77774000400040007774B,40004000400040007777B E
- DATA 77774000400040007774B,40004000400040004000B F
- DATA 03601004200240004000B,40164002200210040360B G
- DATA 40014001400140017777B,40014001400140014001B H
- DATA 01000100010001000100B,01000100010001000100B I
- DATA 00010001000100010001B,00010000200204100240B J
- DATA 40014004402041004400B,64004100402040044001B K
- DATA 40004000400040004000B,40004000400040007777B L
- DATA 40016003500544114221B,41414001400140014001B M
- DATA 60015001440142014101B,40414021401140054003B N
- DATA 03601004200240014001B,40014001200210040360B O
- DATA 77744002400140014002B,77744000400040004000B P
- DATA 03601004200240014001B,40014011200610060361B Q
- DATA 77744002400140014002B,77744400410040204004B R
- DATA 03601004200010000360B,00040002200210040360B S
- DATA 77760100010001000100B,01000100010001000100B T
- DATA 40014001400140014001B,40010000200204100140B U
- DATA 40012002200210041004B,04100410022002200140B V
- DATA 40014001400140014141B,42214411500560034001B W
- DATA 20021004041002200140B,01400220041010042002B X
- DATA 40022004101004200240B,01000100010001000100B
- DATA 37770004001000200040B,01000200040010003776B Z
- DATA 03600410100420022002B,20022002100404100360B
- DATA 01400240044000400040B,00400040004000400040B
- DATA 03701002200140010004B,00200100040020007777B
- DATA 77770004002001000770B,00020001400120020770B
- DATA 00140024004401040204B,04041004377600040004B
- DATA 07771000200077700002B,00010001400120020770B
- DATA 01000200040017702002B,40014001400120020770B
- DATA 77770001000200040010B,00200040010002000400B
- DATA 03601004200210040360B,10042002200210040360B
- DATA 07702002400140014001B,20020770001000200040B
-*
- BSSZ 12
- BSSZ 14
- BSSZ 14
- BSSZ 14
- BSSZ 3 LET SEE WHAT HAPPENS
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcsys/namezzp.F b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcsys/namezzp.F
deleted file mode 100644
index 29d980d..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcsys/namezzp.F
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: namezzp.F,v 1.1.1.1 1996/02/15 17:51:34 mclareni Exp $
-*
-* $Log: namezzp.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:34 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE NAMEZZP (A)
- DIMENSION A(12)
-
-C CERN PROGLIB# NAMEZZP .VERSION KERNCDC 1.08 790126
-
- PRINT 9000, A
- RETURN
-
- 9000 FORMAT (12A10)
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcsys/namjob.F b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcsys/namjob.F
deleted file mode 100644
index 8736e42..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcsys/namjob.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: namjob.F,v 1.1.1.1 1996/02/15 17:51:34 mclareni Exp $
-*
-* $Log: namjob.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:34 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- FUNCTION NAMJOB (NAM)
-
-C CERN PROGLIB# NAMJOB .VERSION KERNCDC 0.1 760623
-
- DATA IBLANK /7H /
-
-
- NAM = IBLANK
- NAMJOB = IBLANK
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcsys/noarg.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcsys/noarg.s
deleted file mode 100644
index 5df7c2e..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcsys/noarg.s
+++ /dev/null
@@ -1,47 +0,0 @@
-*
-* $Id: noarg.s,v 1.1.1.1 1996/02/15 17:51:34 mclareni Exp $
-*
-* $Log: noarg.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:34 mclareni
-* Kernlib
-*
-*
- IDENT NOARG
-*
-* CERN PROGLIB# Z029 NOARG .VERSION KERNCDC 1.16 820129
-*
-* SUBROUTINE NOARG (N)
-*
-* A. YULE/L. POPE CERN DECEMBER 1971
-* CONDITIONAL ASSEMBLY FOR THE -RUN- COMPILER REMOVED JAN 1982
-*
- ENTRY NOARG
- VFD 42/0LNOARG,18/1
- NOARG DATA 0
-*
-* ROUTINE FOR ZERO NUMBER OF ARGUMENTS
-*
- SA2 NOARG EQ00AAAAAA0000000000
- AX2 30 ALIGN ADDRESS OF CALL+1
- SA3 X2-1 GO BACK TO +RJ-TRACE
- SA2 X3 POINT TO TRACE WORD
- SX7 X2 LOOK AT LAST 18 BITS
- NZ X7,ARGS
- SA7 X1 STORE AT ARG ADDRESS
- ZR B0,NOARG RETURN
-*
-* CODE FOR NON-ZERO NUMBER OF ARGUMENTS
-*
- ARGS SA2 A0 POINT TO ARG LIST
- SB1 1 INIT INCREMENT REG
- SX7 B0 ZERO OUT X7 FOR COUNT
- ZR X2,ENDSCAN IF FIRST ADDRESS ZERO - END
- VFDSCAN SA2 A2+B1 NEXT ARG ADDRESS
- SX7 X7+B1 INCREMENT COUNTER
- NZ X2,VFDSCAN SCAN UNTIL ZERO
- ENDSCAN SA7 X1 STORE AT ARG ADDRESS
- ZR B0,NOARG RETURN
- END
-#ifdef CERNLIB_TCGEN_NOARG
-#undef CERNLIB_TCGEN_NOARG
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcsys/qnexte.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcsys/qnexte.s
deleted file mode 100644
index 85b36b1..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcsys/qnexte.s
+++ /dev/null
@@ -1,48 +0,0 @@
-*
-* $Id: qnexte.s,v 1.1.1.1 1996/02/15 17:51:35 mclareni Exp $
-*
-* $Log: qnexte.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:35 mclareni
-* Kernlib
-*
-*
- IDENT QNEXTE
-*
-* CERN PROGLIB# Z041 QNEXTE .VERSION KERNCDC 2.13 840827
-* ORIG. 1981, JZ, CERN
-*
- ENTRY QNEXTE
- EXT QNEXT
-*
- TRACE VFD 36/6HQNEXTE,24/QNEXTE
- QNEXTE DATA 0
- SA1 SAVEEE
- NZ X1,REENT
-*
-*-- FIRST ENTRY
-*
- SA1 QNEXTE SAVE ENTRY/EXIT LINE
- SX6 A0 SAVE A0
- SA6 SAVEA0
- BX7 X1
- SA7 SAVEEE
- JP GO
-*
-*-- RE-ENTRY
-*
- REENT BX7 X1 RESTORE ENTRY/EXIT LINE
- SA7 QNEXTE
-*
-*-- TRANSFER TO QNEXT
-*
- GO RJ QNEXT
-- VFD 30/TRACE
- SA2 SAVEA0
- SA0 X2
- SAVEEE DATA 0
-*
- SAVEA0 DATA 0
- END
-#ifdef CERNLIB_TCGEN_QNEXTE
-#undef CERNLIB_TCGEN_QNEXTE
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcsys/repdmp2.F b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcsys/repdmp2.F
deleted file mode 100644
index a34e3aa..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcsys/repdmp2.F
+++ /dev/null
@@ -1,37 +0,0 @@
-*
-* $Id: repdmp2.F,v 1.1.1.1 1996/02/15 17:51:36 mclareni Exp $
-*
-* $Log: repdmp2.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:36 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE REPDMP2 (LUNP,MEM,NTOT,LADRP)
-
-C CERN PROGLIB# Z038 REPDMP2 .VERSION KERNCDC 1.13 820111
-
- COMMON /EXCHPAK/JERRNO(2),LREP,AB(8),X(8),PARITY,USER
- DIMENSION MEM(99)
-
-
- LUN = LUNP
- WRITE (LUN,9000) JERRNO
- WRITE (LUN,9001) (AB(J),X(J),J=1,8)
- IF (NTOT.EQ.0) RETURN
-
- WRITE (LUN,9012)
- LADR = LADRP
- DO 19 LA=1,NTOT,4
- LE = LA+3
- WRITE (LUN,9016) LADR,(MEM(J),J=LA,LE),(MEM(J),J=LA,LE)
- 19 LADR= LADR + 4
- RETURN
-
- 9000 FORMAT (22H0REPRIEVED CONDITION,I4,A12/
- + 40H0 P----.A----.B----. X - + -)
- 9001 FORMAT (2O22)
- 9012 FORMAT (9H0SCM DUMP/1X)
- 9016 FORMAT (1X,O6,4O21,4A11)
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcsys/repdump.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcsys/repdump.s
deleted file mode 100644
index c4f9307..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcsys/repdump.s
+++ /dev/null
@@ -1,91 +0,0 @@
-*
-* $Id: repdump.s,v 1.1.1.1 1996/02/15 17:51:35 mclareni Exp $
-*
-* $Log: repdump.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:35 mclareni
-* Kernlib
-*
-*
- IDENT REPDUMP
-*
-* CERN PROGLIB# Z038 REPDUMP .VERSION KERNCDC 0.1 740511
-*
- ENTRY REPDUMP
- EXT REPDMP2
-* 30-NOV-73
-*
- USE /EXCHPAK/
- JCONDT BSS 1
- JCODE BSS 1
- LREP BSS 1
- XCHC BSS 16
- PARITY BSS 2
- USE
-*
- VFD 42/7HREPDUMP,18/REPDUMP
- REPDUMP DATA 0
- SB7 1 B7= 1
- SA5 X1 X5= LUN
- SA2 A1+B7 X2= ADR(NBEF)
- NZ X5,LUN
- SA5 LUNDEF
- LUN BX6 X5
- SA6 PLUN SET LUN AS PARAMETER
- SA5 XCHC
- LX5 24
- SB1 X5 B1= P
- EQ B1,B0,NODUMP
-*
-*---- LOAD X2=LADR & X3=NTOT
-*
- ZR X2,NODUMP PARAMETER 2 MISSING
- SA3 A2+B7
- SA2 X2 X2= NBEF
- SA3 X3 X3= NTOT
- NG X2,NODUMP
- NG X3,NODUMP
-*
-*---- VERIFY LADR & LADR+NTOT ARE IN RANGE
-*
- SB2 X2
- SB2 B1-B2 B2= LADR = P - NBEF
- GE B2,B0,OK1
- SB2 B7
- OK1 MX7 0
- SA7 LADR
- MEMORY CM,LADR,RECALL
- SA1 LADR
- LX1 30
- SB6 X1-4 B6= FLU = FL - 4
- GE B1,B6,NODUMP IF P OUT OF RANGE
- GE B2,B6,NODUMP IF LADR OUT OF RANGE
- SB5 B2+X3 B5= LADR + NTOT
- LT B5,B6,OK2
- SX3 B6-B2 NTOT= FLU - LADR IF OUT OF RANGE
- NG X3,NODUMP
- OK2 SX6 X3-4000
- NG X6,SDUMP NTOT .GE. 4000 IS NOT ALLOWED
-*
- NODUMP MX3 0
- SDUMP SX6 B2
- BX7 X3
- SA6 PARAM+1
- SA6 PADR
- SA7 PNTOT
- SA1 PARAM
-+RJREPDMP2
-- VFD 30/REPDUMP-1
- EQ REPDUMP
-*
- LUNDEF VFD 36/6HOUTPUT,24/0
- PLUN DATA 0
- PNTOT DATA 0
- PADR DATA 0
- LADR EQU PADR
-*
- PARAM VFD 42/0,18/PLUN
- DATA 0
- VFD 42/0,18/PNTOT
- VFD 42/0,18/PADR
- DATA 0
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcsys/repfl.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcsys/repfl.s
deleted file mode 100644
index cd25d3e..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcsys/repfl.s
+++ /dev/null
@@ -1,72 +0,0 @@
-*
-* $Id: repfl.s,v 1.1.1.1 1996/02/15 17:51:36 mclareni Exp $
-*
-* $Log: repfl.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:36 mclareni
-* Kernlib
-*
-*
- IDENT REPFL
-*
-* CERN PROGLIB# Z039 REPFL .VERSION KERNCDC 0.1 740511
-*
- ENTRY REPFL
- EXT SYSERR.
-* 30-NOV-73
-*
- USE /EXCHPAK/
- JCONDT BSS 1
- JCODE BSS 1
- LREP BSS 1
- XCHC BSS 16
- PARITY BSS 2
- USE
-*
-*------ REPFL, ENTRY POINT FOR FORTRAN LIBRARY ERRORS
-*
- DSYST VFD 36/6HSYSTEM,24/SYSERR. TRACE-WORD -SYSTEM-
- RJ DQREC
-- VFD 30/DSYST
-*
- VFD 30/5HREPFL,30/DQREC
- DQREC EQ DSYST+2 TRACE SIMULATION, ENTRY -REPFL-
-- VFD 30/0
- REPFL DATA 0
- SB7 1 B7= 1
- SA4 B1 X4= ERR. NO
- MX7 0
- BX6 X4
- SA6 JCONDT JCONDT= ERR NO
- SA7 A6+B7 JCODE = 0
-*
- SA3 A7+B7 SET RJ TO RECOVERY ROUTINE
- SA4 RJINST2
- LX3 30
- BX6 X3+X4
- SA6 RJ2
-*
- SA5 B1+B7 X5= ADR(CODE WORD)
- SA5 X5 X5= CODE WORD
- BX6 X5
- SA6 A3+B7 STORE CODE 1
- SA7 A6+B7 ZERO CODE 2
- SA7 A7+B7 ZERO CODE 3
- SA7 A7+B7
- SA7 A7+B7
- SA7 A7+B7
-*
- MX0 54
- SB6 5 B6= 5 LOOP COUNTER
- LOOP BX6 -X0*X6
- ZR X6,EXIT
- SA5 A5+B7 X5= NEXT CODE WORD
- SB6 B6-B7
- BX6 X5
- SA6 A6+B7
- EQ B0,B6,LOOP
- EXIT BSS 0
- RJ2 DATA 0
- EQ REPFL
-*
- RJINST2 VFD 6/1,54/DQREC-1
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcsys/retrnf.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcsys/retrnf.s
deleted file mode 100644
index 9d171bd..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcsys/retrnf.s
+++ /dev/null
@@ -1,140 +0,0 @@
-*
-* $Id: retrnf.s,v 1.1.1.1 1996/02/15 17:51:36 mclareni Exp $
-*
-* $Log: retrnf.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:36 mclareni
-* Kernlib
-*
-*
- IDENT RETRNF
-*
-* CERN PROGLIB# K510 RETRNF .VERSION KERNCDC 1.16 820129
-*
- ENTRY RETRNF
- SST
-*
-* SUBROUTINE RETRNF (LUN,NERROR)
-* TO RETURN A FILE DURING EXECUTION (USEFULL FOR P.F.)
-*
-* LUN IS THE LOGICAL UNIT NR OF THE FILE INVOLVED
-* NERROR IS THE RETURN CODE (OPTIONAL)
-* IF NOT SUPPLIED, RETRNF WILL ABORT IF A RM ERROR OCCU
-* IF SUPPLIED, IT RETURNS THE RM ERROR IF ANY ( 0 OTHER
-*
-* NEW VERSION OF PROGRAM K510 TAKEN FROM CERN PROGLIB 29-APR-78
-*
-#include "defmodel.inc"
-*
- TRACE. VFD 42/0HRETRNF,18/RETRNF
- TEMPA0 BSS 1
- FICF BSS 1
- FILT BSS 1
- ADRC BSSZ 1 TO SAVE RC ADDRESS
- RC BSS 1 TO SAVE RC
- MSG DATA H*RETRNF - RM ERROR =* *BL
- RMNR DATA H* ON * *BL
- LFN BSSZ 1
- #NEVOPN# EQU 0
-*
- END BSS 0
- #MD IFC LT, "MODEL" 75
- SX1 A0 RESTORE X1 DESTROYED BY 6RM
- #MD ENDIF
- STORE X1,RC=0
- STORE X1,BN=0
- #MD IFC GT, "MODEL" 75
- SA4 FILT
- NZ X4,NOLT JUMP, FILE WAS NOT LABELLED
- LABEL X1
- NOLT BSS 0
- #MD ENDIF
- SA4 FICF
- STORE X1,CF=X4 RESTORE THE ORIGINAL CF IN THE FIT
- STORE X1,OC=NEVOPN SET FIOC TO NEVER OPENED
- SA5 TEMPA0
- SA2 ADRC
- SA0 X5
- ZR X2,RETRNF NO RC, RETURN
- SA3 RC
- BX6 X3
- SA6 X2 RETURN RC
-*
- RETRNF EQ *+1BS17
- SX6 A0
- MX7 0
- SA6 TEMPA0
- SA2 A1+1 X2= ADDRESS OF NERROR
- BX6 X2
- SA7 RC PRESET RC TO ZERO
- SA6 ADRC SAVE ADDRESS OF RC
- MX6 1
- BX1 X1+X6
- + RJ =XGETFIT.
- - VFD 30/TRACE.
- #MD IFC LT, "MODEL" 75
- SA0 X1 SAVE X1 WHICH WILL BE DESTROYED BY 6R
- #MD ENDIF
- STORE X1,EX=RMERROR
- FETCH X1,CF,X6
- SA6 FICF SAVE THE ORIGINAL CF
- FETCH X1,OC,X2
- SX3 X2-1
- ZR X3,OPENED
- OPENM X1,I-O,R
- #MD IFC LT, "MODEL" 75
- SX1 A0 RESTORE X1 DESTROYED BY 6RM
- #MD ENDIF
- OPENED BSS 0
- #MD IFC GT, "MODEL" 75
- FETCH X1,LT,X6
- SA6 FILT SAVE THE ORIGINAL LT
- #MD ENDIF
- CLOSEM X1,U
- EQ END
-*
- RMERROR DATA 0
- #MD IFC LT, "MODEL" 75
- SX1 A0 RESTORE X1 DESTROYED BY 6RM
- #MD ENDIF
- FETCH X1,IRS,X6
- SA6 RC SAVE FIES
- BX3 X6
-*
-* TRANSFORM INTEGER IN DISPLAY CODE
- MX6 0
- MX0 60-3
- SB5 3 ONLY 3 DIGITS IN RM ERROR
- LX3 51
- SB1 1
- SB4 1R0
- COD1 BSS 0
- LX3 3
- BX4 -X0*X3
- SX5 X4+B4
- LX6 6
- IX6 X6+X5
- SB5 B5-B1
- NZ B5,COD1
- LX6 42
- MX0 18
- SA5 RMNR
- BX4 -X0*X5
- BX6 X0*X6
- IX6 X4+X6
- SA6 A5 STORE RMNR
- SA2 X1
- BX6 X2
- SA6 LFN SAVE LFN NAME
- MESSAGE MSG
- SA2 ADRC
- ZR X2,ABT NO RC, ABORT
- #MD IFC LT, "MODEL" 75
- SX1 A0 RESTORE X1 DESTROYED BY MESSAGE
- #MD ENDIF
- STORE X1,ES=0 CLEAR FIES
- EQ END
- ABT BSS 0
- MX6 0
- RJ =XSYSEND. NO RC, ABORT
- ABORT
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcsys/timed.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcsys/timed.s
deleted file mode 100644
index 932a30c..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcsys/timed.s
+++ /dev/null
@@ -1,37 +0,0 @@
-*
-* $Id: timed.s,v 1.1.1.1 1996/02/15 17:51:36 mclareni Exp $
-*
-* $Log: timed.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:36 mclareni
-* Kernlib
-*
-*
- IDENT TIMED
-*
-* CERN PROGLIB# Z007 TIMED .VERSION KERNCDC 0.1 760901
-*
- ENTRY TIMED
- EXT SECOND
-*
-* CALL TIMED (T) RETURNS RUNNING TIME SINCE LAST CALL
-* AUG-76, JZ.
-*
- TRACE VFD 30/5HTIMED,30/TIMED
- TIMED DATA 0
- BX6 X1
- SA6 SVX1 ADR(N) SAVED
-+RJSECONDFLOATINGTIME,CDCSYSTEMROUTINE
-- VFD 12/0,18/TRACE
- SA5 LAST
- SA2 SVX1
- FX1 X6-X5
- SA6 A5 STORE LAST
- NX6 B0,X1
- SA6 X2 STORE RESULT
- EQ TIMED
- SVX1 DATA 0
- LAST DATA 0
- END
-#ifdef CERNLIB_TCGEN_TIMED
-#undef CERNLIB_TCGEN_TIMED
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcsys/timel.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcsys/timel.s
deleted file mode 100644
index 41b4f06..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcsys/timel.s
+++ /dev/null
@@ -1,55 +0,0 @@
-*
-* $Id: timel.s,v 1.1.1.1 1996/02/15 17:51:36 mclareni Exp $
-*
-* $Log: timel.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:36 mclareni
-* Kernlib
-*
-*
- IDENT TIMEL
-*
-* CERN PROGLIB# Z007 TIMEL .VERSION KERNCDC 0.1 760901
-*
- ENTRY TIMEL
-*
-* CALL TIMEL (T) RETURNS REMAINING TIME IN FLOATING SECONDS
-* AUG-76, JZ.
-*
- TRACE VFD 30/5HTIMEL,30/TIMEL
- TIMEL DATA 0
- BX6 X1
- SA6 SVX1 ADR(N) SAVED
- TIME REC TIME MACRO RQUEST
- SA1 REC A1= 24/JL, 24/JS, 12/JM
- SB7 1 B7= 1
- MX0 24
- BX5 X0*X1 X5= 24/JL, 36/0
- LX0 24
- LX1 48
- BX4 X0*X1 X4= JS SEC DONE
- AX0 12
- LX1 12
- BX3 X0*X1 X3= JM MILI-SEC DONE
- SA1 A1+B7 X1= .001
- PX0 B0,X3 JM
- PX6 B0,X4 JS
- NX3 B0,X0 X3= AJM
- FX0 X1*X3 .001 * AJM
- NX4 B0,X6 X4= AJS
- LX5 24 X5= JL SEC ALLOWED
- SA2 A1+B7 X2= ADR(T)
- PX7 B0,X5
- NX5 B0,X7 X5= AJL
- NX3 B0,X0 X3= .001 * AJM
- FX6 X3+X4 X6= AJS + .001*AJM TIME DONE
- FX0 X5-X6
- NX7 B0,X0 X7= AJL - AJS+M
- SA7 X2 STORE RESULT
- EQ TIMEL
- REC DATA 0
- DATA .001
- SVX1 DATA 0
- END
-#ifdef CERNLIB_TCGEN_TIMEL
-#undef CERNLIB_TCGEN_TIMEL
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcsys/timex.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcsys/timex.s
deleted file mode 100644
index 23378c0..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcsys/timex.s
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: timex.s,v 1.1.1.1 1996/02/15 17:51:37 mclareni Exp $
-*
-* $Log: timex.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:37 mclareni
-* Kernlib
-*
-*
- IDENT TIMEX
-*
-* CERN PROGLIB# Z007 TIMEX .VERSION KERNCDC 0.1 760901
-*
- ENTRY TIMEX
- EXT SECOND
-*
-* CALL TIMEX (T) RETURNS RUNNING TIME IN FLOATING SECONDS
-* AUG-76, JZ.
-*
- TRACE VFD 30/5HTIMEX,30/TIMEX
- TIMEX DATA 0
-+RJSECOND
-- VFD 12/0,18/TRACE
- EQ TIMEX
- END
-#ifdef CERNLIB_TCGEN_TIMEX
-#undef CERNLIB_TCGEN_TIMEX
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcsys/trac0q.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcsys/trac0q.s
deleted file mode 100644
index 6b9b1a6..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcsys/trac0q.s
+++ /dev/null
@@ -1,141 +0,0 @@
-*
-* $Id: trac0q.s,v 1.1.1.1 1996/02/15 17:51:38 mclareni Exp $
-*
-* $Log: trac0q.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:38 mclareni
-* Kernlib
-*
-*
- IDENT TRAC0Q
-*
-* CERN PROGLIB# N105 TRAC0Q .VERSION KERNCDC 1.03 771219
-*
- ENTRY TRAC0Q
-* 30-NOV-73
-*
- USE /EXCHPAK/
- JCONDT BSS 1
- JCODE BSS 1
- LREP BSS 1
- XCHC BSS 16
- PARITY BSS 2
-*
- USE /SLATE/
- NAME BSS 1
- LINE BSS 1
- LADR BSS 1
- LOK BSS 1
- LWK BSS 36
-*
- USE
- TRAC0Q DATA 0
- SB7 -1 B7= -1
- SX6 B7
- SA6 LOK LOK-FLAG= -1 (NO TRACE FOUND)
- SA6 A6+B7 LADR = -1 IF EXCHJPK NOT SET
- SA1 JCODE CHECK IF SET
- ZR X1,TRAC0Q
- SB6 X1
- SB6 A1-B6
- EQ B6,B0,TRAC0Q EXIT FOR JCODE PRESET INDEF
-*
-* GET FIELD LENGTH
- MX7 0
- SA7 LWK
- MEMORY CM,LWK,RECALL
- SA1 LWK
- SB7 -1 B7= -1
- LX1 30
- SB6 X1 B6= RFL
- SX6 B6
- SA6 LWK LWK= RFL FOR TRAC2Q
-*
-* GET P-COUNTER
- SA1 XCHC
- LX1 24
- SB4 X1 B4= P
- SX6 B4
- SA6 LADR LADR= P
- SB5 100B B5= 100B (PROGRAM START)
- LT B4,B5,TRAC0Q EXIT FOR PROGRAM RANGE
- GE B4,B6,TRAC0Q
-*
-* SEARCH MATCHING RETURN-JUMP/HOME-JUMP (RJ/HJ)
- SB1 4100
- SX6 B4-B1
- PL X6,FULL
- SB1 B4
- FULL SB1 B1-B5 B1= MIN0(4000,P-100B)
- SB1 B1-B7
- MX4 42
- LX4 30 X4= MASK 12/7777,18/0,30/777...
- MX5 1
- LX5 57 X5= MASK 6/04,54/0 (EQ 0/ 0)
- MX0 30 X0= MASK 30/777..., 30/0
- SA1 B4-B7 A1= P+1
-*
-* SEARCH LOOP
- LOOPS SA1 A1+B7 X1= EQ HOME-ADR / 0 SUPPOSED
- SB1 B1+B7
- EQ B1,B0,TRAC0Q EXIT FOR RANGE EXHAUSTED
- BX6 X1*X4
- BX6 X6-X5 COMPARE TO EQ 0 / 0
- NZ X6,LOOPS
- BX6 X1
- LX6 30
- SB2 X6+B7 B2= ADR OF RJ = HOME-ADR - 1
- LT B2,B5,LOOPS ADR OF RJ OUT OF RANGE
- GE B2,B6,LOOPS
- SA2 B2 X2= RJ ENTRY-ADR/ -- SUPPOSED
- BX6 X2*X0
- LX6 30 0 / RJ ENTRY-ADR
- SB4 A1 B4= ENTRY-ADR
- SB3 X6 B3= ADR IN RJ
- NE B3,B4,LOOPS ADR MIS-MATCH
- AX6 18
- SB3 X6-100B
- NE B3,B0,LOOPS FUNCTION CODE NOT RJ
-*
-* A MATCH HAS BEEN FOUND, LOOK WHETHER THERE IS A TRACE STARTING
- SB3 X2 B3= ADR OF UPPER TRACE-WORD SUPPOSED
- LT B3,B5,LOOPS CHECK B3 IN RANGE
- GE B3,B6,LOOPS
-*
-* LOOKS FINE, NOW FIND THE TRACE-WORD IN LOWER ROUTINE
- SX6 B4
- SA6 LINE LINE= SUPPOSED ENTRY ADR
- SB2 B1
- SA2 A1
- LOOPT SA2 A2+B7 X2= SUPPOSED TRACE-WORD
- SB2 B2+B7
- EQ B2,B0,LOOPS NO TRACE-WORD FOUND: TRY DIFFERENT
- SB3 X2 B3= ADR IN TRACE-WORD
- EQ B3,B4,IFNAME ADRS MATCH, CHECK NAME LEGAL
- BX3 X2-X1 CHECK SAME ENTRY/EXIT LINE
- NZ X3,LOOPT
- SB4 A2 UPDATE ENTRY-ADR
- EQ LOOPT
-*
-* CHECK ROUTINE NAME LEGAL (FORTRAN CHAR. SET)
- IFNAME MX7 42
- BX2 X7*X2 X2= NNNNNNN 000
- MX7 54
- SX6 48 X6= FORTRAN SET LIMIT
- LOOPN LX2 6
- BX3 -X7*X2 X3= SINGLE CHARACTER
- BX2 X7*X2 X2= REMAINING CHARACTERS
- ZR X3,LOOPT CHAR. ZERO
- IX3 X6-X3 X3= 48-CHAR.VALUE
- NG X3,LOOPT NOT FORTRAN CHAR.
- NZ X2,LOOPN
-*
-* ALL LOOKS WELL, EVERYTHING FOUND
- MX7 0
- SA7 LOK LOK=0
- SX6 A2 ADR(TRACE-WORD)
- SA6 LWK+1
- SA2 X6 TRACE-WORD
- BX6 X2
- SA6 NAME
- EQ TRAC0Q
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcsys/trac1q.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcsys/trac1q.s
deleted file mode 100644
index 60c1a57..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcsys/trac1q.s
+++ /dev/null
@@ -1,90 +0,0 @@
-*
-* $Id: trac1q.s,v 1.1.1.1 1996/02/15 17:51:38 mclareni Exp $
-*
-* $Log: trac1q.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:38 mclareni
-* Kernlib
-*
-*
- IDENT TRAC1Q
-*
-* CERN PROGLIB# N105 TRAC1Q .VERSION KERNCDC 1.13 820111
-*
- ENTRY TRAC1Q,TRAC2Q
-* 30-NOV-73
-*
-* M-LAN ROUTINE FTN CDC 6/7000 FOR TRACEQ
-*
- USE /SLATE/
- NAME BSS 1
- LINE BSS 1
- LADR BSS 1
- LOK BSS 1
- LWK BSS 36
-*
- USE
- TRAC1Q DATA 0
- SA1 TRAC1Q X1= ENTRY-EXIT LINE OF TRAC1Q
- SB7 -1
- SX6 B7
- SA6 LADR
- LX1 30
- SA2 X1+B7 X2= RJ TO TRACE1Q
- SA3 X2 X3= TRACE-WORD OF TRACEQ
- BX6 X3
- SA6 NAME STORE TRACE-WORD OF TRACEQ
-*
- MX7 0
- SA7 LWK
- MEMORY CM,LWK,RECALL GET FIELD LENGTH
- SA1 LWK X1= FIELD LENGTH IN LEFT HALF
- AX1 30
- BX7 X1
- SA7 A1 LWK= FIELD-LENGTH RIGHT JUSTIFIED
- EQ TRAC1Q
-*
- TRAC2Q DATA 0
- SA1 NAME X1= DOWN TRACE-WORD
- SA5 LWK
- SB7 -1 B7= -1
- SB2 X1 B2= ADR OF DOWN ENTRY-EXIT LINE
- SB5 X5 B5= FIELD-LENGTH
- LT B2,B0,FAULT B2 OUT OF RANGE
- GE B2,B5,FAULT
- SA2 B2 X2= ENTRY-EXIT LINE DOWN
- BX6 X2
- AX6 54 CHECK OP-CODE 04
- SB1 X6-4
- NE B1,B0,MAIN
- LX2 30
- SB1 X2+B7 B1= ADR OF RJ TO DOWN
- LT B1,B0,FAULT B1 OUT OF RANGE
- GE B1,B5,FAULT
- SX6 B1
- SA6 LADR
- SA1 B1 X1= RJ-WORD TO DOWN
- BX4 X1 CHECK OP-CODE 0100B
- AX4 48
- SB4 X4-100B
- NE B4,B0,FAULT
- SB3 X1 B3= ADR OF UP TRACE-WORD
- LX1 30
- MX4 12
- BX6 X1*X4
- LX6 12
- SA6 LINE STORE LINE NUMBER
- LT B3,B0,FAULT B3 OUT OF RANGE
- GE B3,B5,FAULT
- SA4 B3 X4= UP TRACE-WORD
- BX7 X4
- SA7 A6+B7 STORE UP TRACE-WORD INTO NAME
- SX6 B1
- SA6 A6-B7 STORE ADR OF RJ-WORD INTO LADR
- EQ TRAC2Q
- MAIN SX6 B0-B7
- SA6 LOK LOK = +1
- EQ TRAC2Q
- FAULT SX6 B7
- SA6 LOK LOK = -1
- EQ TRAC2Q
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcsys/traceqr.F b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcsys/traceqr.F
deleted file mode 100644
index 2878ca0..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcsys/traceqr.F
+++ /dev/null
@@ -1,72 +0,0 @@
-*
-* $Id: traceqr.F,v 1.1.1.1 1996/02/15 17:51:38 mclareni Exp $
-*
-* $Log: traceqr.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:38 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE TRACEQR (LUNP,NP)
-
-C CERN PROGLIB# N106 TRACEQR .VERSION KERNCDC 1.13 820111
-
-C- THIS SUBROUTINE IS DERIVED FROM TRACEQ
-C- IF JCODE=0 IN /EXCHJPK/ IT PRINTS THE NORMAL TRACE-BACK AS TRACEQ
-C- IF JCODE.NE.0 IT TRIES TO FIND AND PRINT THE TRACE-BACK LEADING
-C- TO A REPRIEVED HARDWARE CONDITION.
-C- FOR HARDWARE REPRIEVAL IT WORKS IN CONJUNCTION WITH REPINIT/REPOK
-C- FOR STARTING THE TRACE-BACK IT RELIES ON TRAC0Q.
-
- COMMON /SLATE/ NAME,LINE,LADR,LOK,LWK(36) A6M
- COMMON /EXCHPAK/JCONDT,JCODE,LREP,AB(8),X(8),PARITY,USER
-#if !defined(CERNLIB_F77)
- DATA LUNDEF /6LOUTPUT /
-#endif
-#if defined(CERNLIB_F77)
- DATA LUNDEF /L"OUTPUT"/
-#endif
-
-
- LUN = LUNP
- N = NP
- IF (LUN.EQ.0) LUN=LUNDEF CDC
- IF (JCODE.EQ.0) GO TO 21
-
-C---- NON-LIBRARY ERROR, FIND POSSIBLE TRACE-BACK
-
- CALL TRAC0Q
- IF (LOK.EQ.0) GO TO 16
- IF (LADR.LT.0) GO TO 21
- WRITE (LUN,9012) LADR
- GO TO 21
-
- 16 WRITE (LUN,9016) LADR,NAME,LINE,LWK(2)
- GO TO 24
-
-C---- NORMAL FORTRAN-LIBRARY ERROR
-
- 21 WRITE (LUN,9021)
- LINE= 0
- LOK = 0
- CALL TRAC1Q
-
- 24 N = N-1
- CALL TRAC2Q
- IF (LOK) 31,25,99
- 25 WRITE (LUN,9025) NAME,LINE,LADR
- IF (N.GT.0) GO TO 24
- RETURN
-
- 31 WRITE (LUN,9031) LADR
- 99 RETURN
-
- 9012 FORMAT (36H0TRACEQR FINDS NO TRACE BACK FOR P= ,O6)
- 9016 FORMAT (45H0TRACEQR SUGGESTS POSSIBLE TRACE BACK FOR P= ,O6/
- +13H ASSUMED IN ,A7,21H ENTRY/EXIT LINE AT ,O6,
- +17H, TRACE-WORD AT ,O6)
- 9021 FORMAT (8H0TRACEQR)
- 9025 FORMAT (13H CALLED FROM ,A7,6H LINE,I5,15H AT LOCATION ,O6)
- 9031 FORMAT (46H ****** TRACE ENDS BADLY ****** AT LOCATION ,O6)
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcsys/weor.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcsys/weor.s
deleted file mode 100644
index 3fc798d..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cdcsys/weor.s
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: weor.s,v 1.1.1.1 1996/02/15 17:51:38 mclareni Exp $
-*
-* $Log: weor.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:38 mclareni
-* Kernlib
-*
-*
- IDENT WEOR
-*
-* CERN PROGLIB# K402 WEOR .VERSION KERNCDC 1.16 820129
-*
- SST
- ENTRY WEOR
- EXT GETFIT.
-*
-* CALL WEOR (LUN)
-*
- TRACE VFD 24/4HWEOR,36/WEOR
- SVA0 BSSZ 1
- WEOR BSSZ 1
- SX6 A0
- SA6 SVA0
- MX6 1
- BX1 X1+X6
-+RJGETFIT
-- VFD 30/TRACE
- WEOR X1
- SA5 SVA0
- SA0 X5
- EQ WEOR
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cern7600/comment.inc b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cern7600/comment.inc
deleted file mode 100644
index 5ddf183..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cern7600/comment.inc
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: comment.inc,v 1.1.1.1 1996/02/15 17:51:38 mclareni Exp $
-*
-* $Log: comment.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:51:38 mclareni
-* Kernlib
-*
-*
-*
-* comment.inc
-*
-
-
-
-
-C- THIS PATCH CONTAINS ROUTINES WRITTEN FOR THE CERN 7600, SCOPE 2.0
-C- THEY ARE HIGHLY MACHINE DEPENDENT AND NOT NORMALLY NEEDED
-C- UNLESS ONE WANTS TO DO CLEVER THINGS.
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cern7600/inbcd.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cern7600/inbcd.s
deleted file mode 100644
index e6e04c8..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cern7600/inbcd.s
+++ /dev/null
@@ -1,175 +0,0 @@
-*
-* $Id: inbcd.s,v 1.1.1.1 1996/02/15 17:51:38 mclareni Exp $
-*
-* $Log: inbcd.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:38 mclareni
-* Kernlib
-*
-*
- IDENT INBCD
-*
-* CERN PROGLIB# I410 INBCD .VERSION KERNCDC 1.16 820129
-*
- SST
- ENTRY INBCD
- EXT GETFIT. NEW SYSTEM
-* EXT GETFIT$ OLD SYSTEM
-*
-* NCH = INBCD (LUN,VECT,NCHMAX,NWR)
-*
- TRACE VFD 30/5HINBCD,30/INBCD
- INBCD DATA 0
- SA2 LUNH X2= PREVIOUS LFN
- SA5 X1 X5= LUN
- SX6 A1
- SB1 A1 B1= ADR (PAR. LIST) SAVED
- SA6 SVA1 SAVE START ADR OF PARAMETER LIST
-*
-* CHECK IF THIS PARTICULAR FILE WAS THE LAST USED
-* IF FILE IS NOT OPEN, OPEN IT
-*
- IX2 X2-X5
- SA4 STOFIT FIT ADR
- NZ X2,NOFIT
- BX1 X4 X1= FIT ADR
- FETCH X1,OC,X3 GET OPEN/CLOSE FLAG
- SX3 X3-1
- NZ X3,OPEN JUMP IF FILE NOT OPEN
-*
-* GET RECORD , RETURN NCH IN X3
-*
- NJUMP SX4 DEXIT X4= END-OF-DATA EXIT
- SA2 B1+1 X2= ADR OF VECT
- SA3 A2+1 ADR OF MAXCHR
- SA3 X3 X3= MAXCHR
- GETP X1,X2,X3,X4,,SKIP
- SA1 SVA1 ADR OF PARAMETER LIST
- SB7 1 B7= 1
- SA1 X1+B7
- SB1 B7+B7
- SA4 A1+B1
- SB6 B0-B7 B6= -1
- SB5 X1 B5= ADR (VECT)
- SB4 X4 B4= ADR (NWR)
- SA5 BLANK X5= ALL BLANKS
- SA4 TENTH X4= 1/10 WITH SPECIAL NORMALISATION
- ZR X3,ZEROCH
-*
-* CALCULATE B1=(NW-1), B2= NU, B3=6*NU - 1
-* NW = NUMBER OF WORDS READ
-* NU = NUMBER OF CHARACTERS USED IN LAST WORD
- SX7 X3+B6 X7= NCH-1
- PX7 B0,X7 X7= NCH-1 FLOAT
- SX2 10
- FX4 X4*X7 X4= (NCH-1)/10 = NW-1
- PX2 B0,X2 X2= 10 FLOAT
- SB1 X4 B1= NW-1
- DX2 X2*X4 X2= 10*(NW-1) FLOAT
- UX2 B0,X2 X2= 10*(NW-1)
- IX2 X3-X2 X2= NCH - 10*(NW-1) = NU
- SB2 X2 B2= NU
- LX2 1 2*NU
- SB3 X2+B2 3*NU
- SB3 B3+B3 6*NU
- SB3 B3-B7 B3= 6*NU - 1
-*
-* BLANK-FILL LAST WORD FOR UNUSED CHARACTERS
- SA1 B5+B1 A1= ADR (LAST WORD OF VECT USED)
- MX0 1
- AX0 B3,X0 X0= MASK OF 6*NU BITS
- BX6 -X0*X5
- BX1 X0*X1
- BX1 X1+X6 X1= LAST WORD WITH BLANK-FILL
- BX7 X1
- SA7 A1 STORED BACK
-*
-* DISCARD TRAILING BLANKS
- MX0 54 X0= MASK LAST CHARACTER
- BX6 -X0*X5 X6= 55B
- IX7 X1-X5 TEST LAST WORD ALL BLANKS
- ZR X7,ALLBL
- SB3 B3+B7 B3= 6*NU
- LX1 B3,X1 ALIGN LAST CHAR. USED
-*
- LOOPBL BX7 -X0*X1 ISOLATE LAST CHAR
- IX7 X7-X6
- NZ X7,NOTBL CHECK BLANK
- SB2 B2-B7 NU = NU-1
- LX1 54 POSITION PREVIOUS CHAR
- NE B2,B0,LOOPBL
- ALLBL EQ B1,B0,ZEROCH
- SB1 B1-B7 (NW-1) = (NW-1) - 1
- SA1 A1-B7 FETCH PREVIOUS WORD
- IX7 X1-X5
- ZR X7,ALLBL CHECK ALL BLANKS
- SB2 10 NU = 10
- EQ LOOPBL
-*
-* EXIT FOR NCH .NE. 0
- NOTBL SX2 B1 X2= NW-1
- SX7 10
- PX2 B0,X2
- PX7 B0,X7
- DX7 X2*X7 10*(NW-1)
- SX6 X7+B2 NCH = 10*(NW-1) + NU
- SX7 B1+B7 NWR = (NW-1) + 1
- SA7 B4
- EQ INBCD
-*
-* EXIT FOR NCH = 0
- ZEROCH BX7 X5
- SA7 B5 VECT(1)= BLANK
- SX7 B7
- MX6 0 NCH = 0
- SA7 B4 NWR= 1
- EQ INBCD
-*
-*------- END-OF-DATA EXIT. RESET NCH DEPENDING ON FP
-*
- DEXIT DATA 0
- SA4 SVA1
- SA1 STOFIT
- SA5 X4+3 X5=ADR NWR
- MX7 0
- SA7 X5 RETURN NWR=0
- FETCH X1,FP,X6
- AX6 5
- ZR X6,EOS
- AX6 1
- ZR X6,EOP
- SX6 -3
- EQ INBCD END-OF-INFORMATION RETURN
- EOP SX6 -2
- EQ INBCD END-OF-PARTITION RETURN
- EOS SX6 -1
- EQ INBCD END-OF-SECTION RETURN
-*
-*---- FIND THE FIT ADDRESS AND STORE IT IN STOFIT
-*
- NOFIT BX6 X5
- SA6 LUNH STORE LUN
- MX6 1
- BX1 X1+X6
-+RJGETFIT
-- VFD 30/TRACE
- BX6 X1
- SA2 SVA1
- SA6 STOFIT STORE FIT ADDRESS
- FETCH X1,OC,X3
- SX3 X3-1
- SB1 X2 B1 RESTORED
- ZR X3,NJUMP
-*
-* OPEN THE FILE
-*
- OPEN OPENM X1,I-O
- SA4 SVA1
- SB1 X4 B1= ADR (PAR.LIST) RESTORED
- EQ B0,B0,NJUMP
-*
- SVA1 DATA 0
- STOFIT DATA 1L1
- LUNH DATA 1L2
- TENTH DATA O17170631463146314632
- BLANK DATA 10H
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cern7600/outbcd.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cern7600/outbcd.s
deleted file mode 100644
index 854086f..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cern7600/outbcd.s
+++ /dev/null
@@ -1,105 +0,0 @@
-*
-* $Id: outbcd.s,v 1.1.1.1 1996/02/15 17:51:38 mclareni Exp $
-*
-* $Log: outbcd.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:38 mclareni
-* Kernlib
-*
-*
- IDENT OUTBCD
-*
-* CERN PROGLIB# I410 OUTBCD .VERSION KERNCDC 1.16 820129
-*
- SST
- ENTRY OUTBCD
- EXT GETFIT. NEW SYSTEM
-* EXT GETFIT$ OLD SYSTEM
-*
-* SUBROUTINE OUTBCD (LUN,VECT,NCHAR,NW)
-*
- TRACE VFD 36/6HOUTBCD,24/OUTBCD
- OUTBCD DATA 0
- SA2 LUNH X2= PREVIOUS LFN
- SA5 X1 X5= LUN
- SB1 A1 B1= ADR (PAR. LIST) SAVED
-*
-* CHECK IF THIS PARTICULAR FILE WAS THE LAST USED
-* IF FILE IS NOT OPEN, OPEN IT
-*
- IX2 X2-X5
- SA4 STOFIT FIT ADR
- NZ X2,NOFIT
- BX1 X4 X1= FIT ADR
- FETCH X1,OC,X3 GET OPEN/CLOSE FLAG
- SX3 X3-1
- NZ X3,OPEN JUMP IF FILE NOT OPEN
-*
-*---- READY PUTTING
-*
- NJUMP SB7 1
- SA2 B1+B7 X2= ADR OF VECT
- SA3 A2+B7
- SA4 A3+B7
- SA3 X3 X3=NCHAR
- SA4 X4 X4= NW
- NZ X3,CHARS
-*
-* ACTION FOR NCHAR = 0
-* IF NW=0 BLANK CARD: SET NCH = 1
- NZ X4,WORDS
- SX2 BLANKX X2= ADR OF BLANKX
- SX3 B7 X3= 1
- EQ PUT
-*
-* CONVERT WORDS TO CHARACTERS
- WORDS SX7 10 X7= 10
- PX4 B0,X4
- PX7 B0,X7
- DX7 X4*X7 NCH = 10*NW
- SX3 X7+B0 X3= NCH
-*
- CHARS NG X3,EODATA IF NCHAR.LT.0, WRITE END-OF-DATA
- PUT PUT X1,X2,X3
- EQ OUTBCD
-*
-* WRITE APPROPRIATE END-OF-DATA MARKS
-*
- EODATA SX3 X3+B7
- ZR X3,EOS
- ENDFILE X1 WRITE END-OF-INFORMATION MARK
- EQ OUTBCD
- EOS WEOR X1,0 WRITE END-OF-SECTION MARK
- EQ OUTBCD
-*
-*---- FIND THE FIT ADDRESS AND STORE IT IN STOFIT
-*
- NOFIT BX6 X5
- SX7 B1
- SA6 LUNH STORE LUN
- SA7 SVA1 B1 SAVED
- MX6 1
- BX1 X1+X6
-+RJGETFIT
-- VFD 30/TRACE
- BX6 X1
- SA2 SVA1
- SA6 STOFIT STORE FIT ADDRESS
- FETCH X1,OC,X3
- SX3 X3-1
- SB1 X2 B1 RESTORED
- ZR X3,NJUMP
-*
-* OPEN THE FILE
-*
- OPEN SX7 B1
- SA7 SVA1 B1 SAVED
- OPENM X1,I-O,N
- SA4 SVA1
- SB1 X4 B1= ADR (PAR.LIST) RESTORED
- EQ B0,B0,NJUMP
-*
- SVA1 DATA 0
- STOFIT DATA 1L1
- LUNH DATA 1L2
- BLANKX DATA 10H X
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cernosbe/inbcd.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cernosbe/inbcd.s
deleted file mode 100644
index 45db22d..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cernosbe/inbcd.s
+++ /dev/null
@@ -1,198 +0,0 @@
-*
-* $Id: inbcd.s,v 1.1.1.1 1996/02/15 17:51:39 mclareni Exp $
-*
-* $Log: inbcd.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:39 mclareni
-* Kernlib
-*
-*
- IDENT INBCD
-*
-* CERN PROGLIB# I410 INBCD .VERSION KERNCDC 2.11 840706
-*
- SST
- ENTRY INBCD
- EXT GETFIT.
-*
-* NCH = INBCD (LUN,VECT,NCHMAX,NWR)
-*
- TRACE VFD 30/5HINBCD,30/INBCD
- INBCD DATA 0
- SA2 LUNH X2= PREVIOUS LFN
- SA5 X1 X5= LUN
- SX6 A1
- SA6 SVA1 SAVE START ADR OF PARAMETER LIST
-*
-* CHECK IF THIS PARTICULAR FILE WAS THE LAST USED
-* IF FILE IS NOT OPEN, OPEN IT
-*
- IX2 X2-X5
- SA4 STOFIT FIT ADR
- NZ X2,NOFIT
- BX1 X4 X1= FIT ADR
- FETCH X1,OC,X3 GET OPEN/CLOSE FLAG
- SX3 X3-1
- NZ X3,OPEN JUMP IF FILE NOT OPEN
-*
-* GET RECORD , RETURN NCH IN X3
-*
- NJUMP SX2 WSA X2= ADR OF INPUT BUFFER WSA
- GET X1,X2
- SA1 STOFIT
- FETCH X1,RL,X3 X3= NO. OF CHARACTERS READ INTO WSA
- SA1 SVA1 ADR OF PARAMETER LIST
- SB7 1 B7= 1
- SA1 X1+B7 X1= ADR (VECT)
- SA2 A1+B7 X2= ADR (NCHMAX)
- SA4 A2+B7 X4= ADR (NWR)
- SB6 B0-B7 B6= -1
- SB5 X1 B5= ADR (VECT)
- SB4 X4 B4= ADR (NWR)
- SA5 BLANK X5= ALL BLANKS
- SA4 TENTH X4= 1/10 WITH SPECIAL NORMALISATION
- ZR X3,ZEROCH
-*
-* NCH = MIN0 (NCHR,NCHMAX)
-*
- SA2 X2 X2= NCHMAX
- IX6 X2-X3
- AX6 59
- BX2 X6*X2 X2= ZERO OR NCHMAX
- BX3 -X6*X3 X3= ZERO OR NCHR
- BX3 X2+X3 X3= NCH
-*
-* CALCULATE B1=(NW-1), B2= NU, B3=6*NU - 1
-* NW = NUMBER OF WORDS READ
-* NU = NUMBER OF CHARACTERS USED IN LAST WORD
- SX7 X3+B6 X7= NCH-1
- PX7 B0,X7 X7= NCH-1 FLOAT
- SX2 10
- FX4 X4*X7 X4= (NCH-1)/10 = NW-1
- PX2 B0,X2 X2= 10 FLOAT
- SB1 X4 B1= NW-1
- DX2 X2*X4 X2= 10*(NW-1) FLOAT
- UX2 B0,X2 X2= 10*(NW-1)
- IX2 X3-X2 X2= NCH - 10*(NW-1) = NU
- SB2 X2 B2= NU
- LX2 1 2*NU
- SB3 X2+B2 3*NU
- SB3 B3+B3 6*NU
- SB3 B3-B7 B3= 6*NU - 1
-*
-* COPY WORDS FROM WSA TO VECT
-*
- SB6 -B7
- COPY SB6 B6+B7
- SA1 B6+WSA
- BX6 X1
- SA6 B5+B6
- NE B6,B1,COPY
-*
-* BLANK-FILL LAST WORD FOR UNUSED CHARACTERS
- SA1 B5+B1 A1= ADR (LAST WORD OF VECT USED)
- MX0 1
- AX0 B3,X0 X0= MASK OF 6*NU BITS
- BX6 -X0*X5
- BX1 X0*X1
- BX1 X1+X6 X1= LAST WORD WITH BLANK-FILL
- BX7 X1
- SA7 A1 STORED BACK
-*
-* DISCARD TRAILING BLANKS
- MX0 54 X0= MASK LAST CHARACTER
- BX6 -X0*X5 X6= 55B
- IX7 X1-X5 TEST LAST WORD ALL BLANKS
- ZR X7,ALLBL
- SB3 B3+B7 B3= 6*NU
- LX1 B3,X1 ALIGN LAST CHAR. USED
-*
- LOOPBL BX7 -X0*X1 ISOLATE LAST CHAR
- IX7 X7-X6
- NZ X7,NOTBL CHECK BLANK
- SB2 B2-B7 NU = NU-1
- LX1 54 POSITION PREVIOUS CHAR
- NE B2,B0,LOOPBL
- ALLBL EQ B1,B0,ZEROCH
- SB1 B1-B7 (NW-1) = (NW-1) - 1
- SA1 A1-B7 FETCH PREVIOUS WORD
- IX7 X1-X5
- ZR X7,ALLBL CHECK ALL BLANKS
- SB2 10 NU = 10
- EQ LOOPBL
-*
-* EXIT FOR NCH .NE. 0
- NOTBL SX2 B1 X2= NW-1
- SX7 10
- PX2 B0,X2
- PX7 B0,X7
- DX7 X2*X7 10*(NW-1)
- SX6 X7+B2 NCH = 10*(NW-1) + NU
- SX7 B1+B7 NWR = (NW-1) + 1
- SA7 B4
- EQ INBCD
-*
-* EXIT FOR NCH = 0
- ZEROCH BX7 X5
- SA7 B5 VECT(1)= BLANK
- SX7 B7
- MX6 0 NCH = 0
- SA7 B4 NWR= 1
- EQ INBCD
-*
-*------- END-OF-DATA EXIT. RESET NCH DEPENDING ON FP
-*
- DEXIT DATA 0
- SA4 SVA1
- SA1 STOFIT
- SA5 X4+3 X5=ADR NWR
- MX7 0
- SA7 X5 RETURN NWR=0
- FETCH X1,FP,X6
- AX6 5
- ZR X6,EOS
- AX6 1
- ZR X6,EOP
- SX6 -3
- EQ INBCD END-OF-INFORMATION RETURN
- EOP SX6 -2
- EQ INBCD END-OF-PARTITION RETURN
- EOS SX6 -1
- EQ INBCD END-OF-SECTION RETURN
-*
-*---- FIND THE FIT ADDRESS AND STORE IT IN STOFIT
-*
- NOFIT BX6 X5
- SA6 LUNH STORE LUN
-#if defined(CERNLIB_F77)
- MX6 1
- BX1 X1+X6
-#endif
-+RJGETFIT
-- VFD 30/TRACE
- BX6 X1
- SA2 SVA1
- SA6 STOFIT STORE FIT ADDRESS
- SX4 DEXIT
- STORE X1,DX=X4
- FETCH X1,OC,X3
- SX3 X3-1
- ZR X3,NJUMP
-*
-* OPEN THE FILE
-*
- OPEN BSS 0
- STORE X1,RT=Z
- STORE X1,BT=C
- STORE X1,FL=120
- STORE X1,MRL=120
- OPENM X1,I-O,N
- SA1 STOFIT
- EQ B0,B0,NJUMP
-*
- WSA BSS 15 INTERMEDIATE INPUT BUFFER
- SVA1 DATA 0
- STOFIT DATA 1L1
- LUNH DATA 1L2
- TENTH DATA O17170631463146314632
- BLANK DATA 10H
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cernosbe/outbcd.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/cernosbe/outbcd.s
deleted file mode 100644
index a4bbbbe..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/cernosbe/outbcd.s
+++ /dev/null
@@ -1,128 +0,0 @@
-*
-* $Id: outbcd.s,v 1.1.1.1 1996/02/15 17:51:39 mclareni Exp $
-*
-* $Log: outbcd.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:39 mclareni
-* Kernlib
-*
-*
- IDENT OUTBCD
- RTZ EQU 3
- RTS EQU 8
- RTW EQU 0
- BTC EQU 2
- BTI EQU 1
- BT0 EQU 0 UNBLOCKED
-***
-*** CHOOSE YOUR OPTIONS...
-***
- RECTYP EQU RTZ
- BLTYP EQU BTC
- FLENGTH EQU 136
-***
- ENTRY OUTBCD
- EXT GETFIT. NEW SYSTEM
-* SUBROUTINE OUTBCD (LUN,VECT,NCHAR,NW)
-*
- TRACE VFD 36/6HOUTBCD,24/OUTBCD
- OUTBCD DATA 0
- SA2 LUNH X2= PREVIOUS LFN
- SA5 X1 X5= LUN
- SB1 A1 B1= ADR (PAR. LIST) SAVED
-*
-* CHECK IF THIS PARTICULAR FILE WAS THE LAST USED
-* IF FILE IS NOT OPEN, OPEN IT
-*
- IX2 X2-X5
- SA4 STOFIT FIT ADR
- NZ X2,NOFIT
- BX1 X4 X1= FIT ADR
- FETCH X1,OC,X3 GET OPEN/CLOSE FLAG
- SX3 X3-1
- NZ X3,OPEN JUMP IF FILE NOT OPEN
-*
-*---- READY PUTTING
-*
- NJUMP SB7 1
- SA2 B1+B7 X2= ADR OF VECT
- SA3 A2+B7
- SA4 A3+B7
- SA3 X3 X3=NCHAR
- SA4 X4 X4= NW
- NZ X3,CHARS
-*
-* ACTION FOR NCHAR = 0
-* IF NW=0 BLANK CARD: SET NCH = 1
- NZ X4,WORDS
- SX2 BLANKX X2= ADR OF BLANKX
- SX3 B7 X3= 1
- EQ PUT
-*
-* CONVERT WORDS TO CHARACTERS
- WORDS SX7 10 X7= 10
- PX4 B0,X4
- PX7 B0,X7
- DX7 X4*X7 NCH = 10*NW
- SX3 X7+B0 X3= NCH
-*
- CHARS NG X3,EODATA IF NCHAR.LT.0, WRITE END-OF-DATA
- PUT PUT X1,X2,X3
- EQ OUTBCD
-*
-* WRITE APPROPRIATE END-OF-DATA MARKS
-*
- EODATA SX3 X3+B7
- ZR X3,EOS
- ENDFILE X1 WRITE END-OF-INFORMATION MARK
- EQ OUTBCD
- EOS WEOR X1,0 WRITE END-OF-SECTION MARK
- EQ OUTBCD
-*
-*---- FIND THE FIT ADDRESS AND STORE IT IN STOFIT
-*
- NOFIT BX6 X5
- SX7 B1
- SA6 LUNH STORE LUN
- SA7 SVA1 B1 SAVED
-+RJGETFIT
-- VFD 30/TRACE
- BX6 X1
- SA2 SVA1
- SA6 STOFIT STORE FIT ADDRESS
- FETCH X1,OC,X3
- SX3 X3-1
- SB1 X2 B1 RESTORED
- ZR X3,NJUMP
-*
-* OPEN THE FILE
-*
- OPEN SX7 B1
- SA7 SVA1 B1 SAVED
-*** SET REQUESTED RT , BT , FL IN FIT.
- SA5 X1+1
- MX0 4
- SX6 RECTYP
- LX0 26
- LX6 22
- BX5 -X0*X5
- BX5 X5+X6
- MX0 3
- SX6 BLTYP
- LX0 31
- LX6 28
- BX5 -X0*X5
- BX6 X5+X6
- SA6 A5
- STORE X1,FL=FLENGTH
- STORE X1,ERL=128 ERROR LIMIT
- OPENM X1,I-O,N
- SA1 STOFIT
- SA4 SVA1
- SB1 X4 B1= ADR (PAR.LIST) RESTORED
- EQ B0,B0,NJUMP
-*
- SVA1 DATA 0
- STOFIT DATA 1L1
- LUNH DATA 1L2
- BLANKX DATA 10H X
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/history/gcdcup1.dat b/src/packlib/kernlib/kerngen/obsolete/kerncdc/history/gcdcup1.dat
deleted file mode 100644
index fdf30be..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/history/gcdcup1.dat
+++ /dev/null
@@ -1,281 +0,0 @@
-*
-* $Id: gcdcup1.dat,v 1.1.1.1 1996/02/15 17:51:11 mclareni Exp $
-*
-* $Log: gcdcup1.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:51:11 mclareni
-* Kernlib
-*
-*
-#if !defined(CERNLIB_KERNCDC)
-
- UP-DATE RECORD FOR GENCDC VERSIONS 1.01 TO 1.99
- -----------------------------------------------
-
-
- FIRST RELEASE OF THE GENCDC MINI-PAM : 1-NOV-76
-
----------------------------------------------------------------------
-
-
-UPDATE 1.02 : 18-OCT-77
--------------------------
-
-REPLACING FILE GENCDC 1.01 761115 15.41
-
-NEW DECKS : P=XSCOPE, D=IXFPZL
- P=CDCFTN, D=NORRAN, RNDM, UBITS, UFLINT
- P=CDCSYS, D=DUMRZL,+, FNBLAN, FNZERO
-
-CORRECTIONS : P=CDCFTN, D= IUBIN, IUCHAN, IUHIST
- ASSURE ROUNDING UPWARDS
-
-BUGS FIXED : P=CDCFTN, D=TRASAT, TRATSA
-
-COMMENTS ONLY CORRECTED IN P=CDCFTN, D=LORENB, LORENF
-
----------------------------------------------------------------------
-
-UPDATE 1.03 : 20-DEC-77
--------------------------
-
-REPLACING FILE GENCDC 1.02 771018 17.33
-
-NEW DECKS : P=CDC60SYS, D=NAMJOB, PRFIFET+LDFIFET
- P=CDCSYS, D=WEOR
-
-CORRECTIONS : P=CDCSYS, D=TRAC0Q
- ALLOW FOR TRACE-BACK OF ONLY 1 LEVEL
-
----------------------------------------------------------------------
-
-UPDATE 1.04 : 11-FEB-78
--------------------------
-
-REPLACING FILE GENCDC 1.03 771220 12.22
-
-CORRECTIONS : P=CDCFTN, D=IUBIN,IUCHAN,IUHIST
- SERIOUS BUG WITH LARGE OVERFLOWS FIXED
-
----------------------------------------------------------------------
-
-UPDATE 1.05 : 3-MAY-78
--------------------------
-
-REPLACING FILE GENCDC 1.04 780211 21.45
-
-NEW DECKS : P=XSCOPE, D=XREADB, XREADC, XREADS
- TO UNCOUPLE LOADING OF BINARY/CODED IO-ROUTINES
-
- P=CDCFTN, D=FLPSOR, INTSOR
- P=CDCSYS, D=DETACH SHORT VERSION OF RETRNF
-
-CORRECTIONS : P=XSCOPE, D=XREAD TO USE XREADB + XREADC
- P=CDCFTN, D=POWEZE ENTRY TIDIED UP
- D=SORTZV ENTRY/EXIT LINE CORRECTED
- P=CDCSYS, D=RETRNF CORRECTED FOR SCOPE 3.4
-
----------------------------------------------------------------------
-
-UPDATE 1.06 : 14-JUNE-78
---------------------------
-
-REPLACING FILE GENCDC 1.05 780503 18.49
-
-NEW DECKS : P=CDCFTN, D=IUBACK,IUFORW,ULEFT,URIGHT,USET
-
----------------------------------------------------------------------
-
-UPDATE 1.07 : 18-DEC-78
--------------------------
-
-REPLACING FILE GENCDC 1.06 780614 18.10
-
-NEW PATCH : P=XVECTCDC.
-
-NEW DECK : P=CDCFTN, D=GSHOW TO PRINT GENSEC VERSION USED
-
----------------------------------------------------------------------
-
-UPDATE 1.08 : 26-JAN-79
--------------------------
-
-REPLACING FILE GENCDC 1.07 781218 22.25
-
-NEW PATCHES : P=*GNOS, CDCNOS FOR THE NOS OPERATING SYSTEM
-
-NEW DECK : P=CDCFTN, D=FNNUM
-
-MODIFIED : P=CDCFTN, D=KFILE TO ALSO HANDLE CONVENTIONS OF
- FORTRAN VERSION 4.7
- P=CDCSYS, D=NAMEZB CHANGE NAMEZB TO NAMEZZ
- TO KEEP CERN PROGLIB HAPPY
-
----------------------------------------------------------------------
-
-UPDATE 1.09 : 29-JAN-79
--------------------------
-
-REPLACING FILE GENCDC 1.08 790126 21.42
-
-CORRECTED : P=CDCNOS, D=EQUBUF ARGUMENTS WERE INVERTED
-
-DELETED : P=CDCSYS, D=DATEZB,IDATZA OBSOLETE ROUTINES
-
----------------------------------------------------------------------
-
-UPDATE 1.10 : 6-APR-79
--------------------------
-
-REPLACING FILE GENCDC 1.09 790129 22.44
-
-CORRECTED : P=CDCNOS, D=DETACH,EQUBUF PSEUDO-OP 'SST' ADDED
-
-NEW DECK : P=CDCFTN, D=IUMODE
-
----------------------------------------------------------------------
-
-UPDATE 1.11 : 1-AUG-80
--------------------------
-
-REPLACING FILE GENCDC 1.10 790406 16.42
-
-CORRECTED : P=XSCOPE3, D=IXLONG, IXPTR, IXRL + P=XSCOPE, D=IXFPZL
-
- USE IXPTRZL FOR IXPTR EVERYWHERE
- IXRLZL IXRL
- IXFPZL IXFP
-
- P=*GCDC ADD +USE, QMCDC
- MACHINE SELECTOR FOR GENSECPAM
-
----------------------------------------------------------------------
-
-UPDATE 1.12 : 11-NOV-80
--------------------------
-
-REPLACING FILE GENCDC 1.11 800801 14.39
-
-NEW PATCHES : P= *GNOSBE & CDCNOSBE FOR SYSTEM NOS/BE
-
-NEW DECKS : D=JOBNAM TO EVENTUALLY REPLACE D=NAMJOB
-
-CORRECTED : P= *GNOS & CDCNOS, BLANK DECKS SLIGHT SHUFFLING
-
- P=*GCDC, D=DELETES CONNECT ML VERSION OF TR-PACK
-
-DELETED : P=CDCSYS, D=NAMEZB, NAMEZBP BECAUSE OF THE PROGLIB
- USE NAMEZZ INSTEAD OF NAMEZB, EXCEPT FOR THE NAMES
- NAMEZZ IS AN IDENTICAL COPY
-
----------------------------------------------------------------------
-
-UPDATE 1.13 : 11-JAN-82
--------------------------
-
-REPLACING FILE GENCDC 1.12 801110 18.31
-
-NEW PATCHES : P= *GCDCV76 PILOT FOR CDC 7600, FORTRAN V
- XIOCDCV XIN ROUTINES FOR FORTRAN V
-
-NEW DECKS : P= CDCFTN, D=UCTOH,UHTOC NEW ROUTINES
- P= CDCFTN, D=FLOARG,INTARG FOR KERNLIB
- P= CDC76SYS, D=LBCMZB FOR KERNLIB
-
-CORRECTED : P= XVECTCDC,D=XINCF, P=XSCOPE,XREADC REMOVE TAGS
- P= CDCFTN, D=UBLOW,UBUNCH ADDED ENTRIES UCTOH1,UH1TOC
- P= CDCSYS, D=DATIME ADD US-DATE OPTION
- P= CDCSYS, D=DUMRZLX, REPDMP2 FORMATS TIDIED FOR FV
- P= CDCSYS, D=TRACEQR,TRAC1Q IMPROVE DIAGNOSTICS
----------------------------------------------------------------------
-
-UPDATE 1.14 : 14-JAN-82
--------------------------
-
-REPLACING FILE GENCDC 1.13 820113 18.51
-
-NEW DECKS : P= CDC76SYS, D=TIMED IMPROVE PRECISION
----------------------------------------------------------------------
-
-UPDATE 1.15 : 27-JAN-82
--------------------------
-
-REPLACING FILE GENCDC 1.14 820114 17.46
-
-CONVERSION BY PROGRAM FOR KERN LIB
-
----------------------------------------------------------------------
-
-UPDATE 1.16 : 29-JAN-82
--------------------------
-
-REPLACING FILE GENCDC 1.15 820127 15.00
-
-DELETED : P=CDCFTN, D=MXADD,MXDMA,MXDMAL LONG OBSOLETE
- P=CDCNOSBE, D=EQUBUF USE NEW DEFAULT
- P=CDCNOS, D=EQUBUF USE NEW DEFAULT
-
-NEW PATCHES : PILOTS FOR FORTRAN 5
-
-NEW DECKS : P=XSCOPE, D=LXBITS
- P=CDCFTN, D=BLOW,BUNCH FOR KERNLIB
- P=CDC60SYS, D=EQUBUF OLD DEFAULT MOVED TO THIS
- P=CDCSYS, D=EQUBUF NEW DEFAULT
- P=CDCSYS, D=NOARG FOR KERNLIB
-
-CORRECTED : FIX TROUBLE UNDER NOS WITH MACRO 'STORE OC=NOP'
- P=CDCNOS, D=DETACH,EQUBUF
-
- SET SIGN BIT IN X1 FOR CALL TO SYSTEM GETFIT.
- P=XSCOPE2, D=LXBITS
- P=XSCOPE3, D=IXPTR,IXRL
- P=XSCOPE, D=IXFPZL,XTPCH2
- P=CDCNOSBE, D=DETACH,EQUBUF,RETRNF
- P=CDCNOS, D=DETACH,EQUBUF,LOAFIT
- P=CDC60SYS, D=LDFIFET
- P=CDCSYS, D=DETACH,RETRNF,WEOR
- P=CERN7600, D=INBCD,OUTBCD
-
- CORRECT FOR FORTRAN 77
- P=CDCNOS, D=DMPFIT
- P=CDCSYS, D=NAMEZZ
----------------------------------------------------------------------
-
-UPDATE 1.17 : 4-FEB-82
--------------------------
-
-REPLACING FILE GENCDC 1.16 820129 19.38
-
-RE-ORGANISE PATCHES P=CDCNOSBE + CDCNOS
-
----------------------------------------------------------------------
-
-UPDATE 1.18 : 17-MAR-82
--------------------------
-
-REPLACING FILE GENCDC 1.17 820204 18.00
-
-RE-ORGANISE PILOT PATCHES : RENAME *G... TO *K... FOR KERNLIB
- MAKE NEW *G... TO SELECT *K...
- FOR EASY TRANSITION
-
-CORRECTED : CHANGE ALL BLANK CARDS IN ASSEMBLER ROUTINES TO *
- (OUR ASSEMBLER DOES NOT OBJECT)
-
- REMOVE QUOTES FROM COMMENT-FIELDS TO AVOID TROUBLE
-
- P=CDCNOS, D=RETRNF BUG CORRECTED
----------------------------------------------------------------------
-
-UPDATE 1.19 : 29-MAR-82
--------------------------
-
-REPLACING FILE GENCDC 1.18 820317 14.30
-
-TIDY UP FOR KERNLIB
-
----------------------------------------------------------------------
-
- KERNCDC 2.00 = GENCDC 1.19
-
----------------------------------------------------------------------
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/history/history.dat b/src/packlib/kernlib/kerngen/obsolete/kerncdc/history/history.dat
deleted file mode 100644
index 711fdb8..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/history/history.dat
+++ /dev/null
@@ -1,268 +0,0 @@
-*
-* $Id: history.dat,v 1.1.1.1 1996/02/15 17:51:12 mclareni Exp $
-*
-* $Log: history.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:51:12 mclareni
-* Kernlib
-*
-*
-* This directory was created from kerncdc.car patch kerncdc
-#if !defined(CERNLIB_KERNCDC)
-
- KERNLIB ROUTINES IN MACHINE LANGUAGE OR OTHERWISE SPECIAL
- FOR CDC MACHINES
-
----------------------------------------------------------------------
-
- THIS FILE CONTAINS THE FOLLOWING PATCHES :
-
-
-PILOT PATCHES
--------------
-
-*KVCDC76 KERNLIB FOR CDC FORTRAN 5 ON 7600
-
-*KVNOSBE KERNLIB FOR CDC FORTRAN 5 FOR NOS/BE
-
-*KVNOS KERNLIB FOR CDC FORTRAN 5 FOR NOS
-
-*KCDC76 KERNLIB FOR CDC FORTRAN 4 ON 7600
-
-*KCDC60 KERNLIB FOR CDC FORTRAN 4 FOR SCOPE 3.4
-
-*KNOSBE KERNLIB FOR CDC FORTRAN 4 FOR NOS/BE
-
-*KNOS KERNLIB FOR CDC FORTRAN 4 FOR NOS
-
-*KCDC COMMON SUB-PILOT
-
-OTHER PATCHES
--------------
-
-XIOCDCV CDC FORTRAN 5 VERSION OF XIN-ROUTINES OF P=XVECT
-
-XVECTCDC CDC FORTRAN 4 VERSION OF XIN-ROUTINES OF P=XVECT
-
-XSCOPE2 X-PACKAGE FOR 7600 WITH SCOPE 2
-
-XSCOPE3 X-PACKAGE FOR 6000 WITH SCOPE 3.4
-
-XSCOPE COMMON SUB-SET
-
-CDCFTN ML-VERSIONS OF NORMAL SYSTEM-INDEPENDENT KERNLIB ROUTINES
-
-CDCNOSBE SYSTEM COMMUNICATION ROUTINES FOR SYSTEM NOS/BE
-
-CDCNOS SYSTEM COMMUNICATION ROUTINES FOR SYSTEM NOS
-
-CDC76SYS SYSTEM COMMUNICATION ROUTINES FOR CDC 7600
-
-CDC60SYS SYSTEM COMMUNICATION ROUTINES FOR CDC 6000
-
-CDCSYS COMMON SUB-SET
-
-=====================================================================
-
-
- UP-DATE RECORD FOR THE PAM-FILE KERNCDC, VERSION 2
- ---------------------------------------------------
-
-
-UP-DATE 2.19 : 12-JULY-1988
-----------------------------
-
-REPLACING FILE KERNCDC 2.18 870602 11.41
-
-CORRECT : P=CDCSYS, D=NOARG to delete the dummy in TCGEN
-
----------------------------------------------------------------------
-
-UP-DATE 2.18 : 2-JUNE-1987
-----------------------------
-
-REPLACING FILE KERNCDC 2.17 861204 21.04
-
-NEW DECKS : P=CDCFTN, D=IANDETC, BITPOS.
- D=JBYTOR.
- D=ISHFT, ISHFTC.
- D=BTEST,IBITS,IBCLR,IBSET,MVBITS.
-
----------------------------------------------------------------------
-
-UP-DATE 2.17 : 4-DEC-1986
-----------------------------
-
-REPLACING FILE KERNCDC 2.16 860514 15.45
-
-NEW DECKS : P=CDCFTN, D=IE3FOS, IE3FOD, IE3TOS, IE3TOD
-
----------------------------------------------------------------------
-
-UP-DATE 2.16 : 14-MAY-1986
-----------------------------
-
-REPLACING FILE KERNCDC 2.15 850813 19.51
-
-NEW DECKS : P=CDCFTN, D=CFROMI, IFROMC
-
----------------------------------------------------------------------
-
-UP-DATE 2.15 : 13-AUG-1985
-----------------------------
-
-REPLACING FILE KERNCDC 2.14 850320 20.49
-
-NEW DECKS : P=CDCFTN, D=MBYTET,MBYTOR,MCBYT
- D=MSBIT,MSBIT0,MSBIT1,MSBYT
-
----------------------------------------------------------------------
-
-UP-DATE 2.14 : 20-MAR-1985
-----------------------------
-
-REPLACING FILE KERNCDC 2.13 840827 17.14
-
-NEW DECK : P=CDCNOSBE, D=INTRAC
-
-CORRECTIONS : P=CDCFTN, D=UH1TOC BUG FIXED FOR CHARACTER VECTOR
- P=CDC60SYS, D=JOBNAM NAME WITH BLANK-FILL
-
----------------------------------------------------------------------
-
-UP-DATE 2.13 : 27-AUG-1984
-----------------------------
-
-REPLACING FILE KERNCDC 2.12 840712 18.17
-
-NEW DECK : P=CDCSYS, D=QNEXTE TAKEN OVER FROM HYDRA
-
----------------------------------------------------------------------
-
-UP-DATE 2.12 : 12-JUL-1984
-----------------------------
-
-REPLACING FILE KERNCDC 2.11 840706 16.57
-
-CORRECTIONS : P=CDCSYS, D=EQUBUF TRIAL TO FIX INTERMITTENT BUG
-
----------------------------------------------------------------------
-
-UP-DATE 2.11 : 6-JUL-1984
-----------------------------
-
-REPLACING FILE KERNCDC 2.10 840704 19.36
-
-CORRECTIONS : P=CERNOSBE, D=INBCD FIXED TO WORK ALSO FOR F77
-
----------------------------------------------------------------------
-
-UP-DATE 2.10 : 3-JUL-1984
-----------------------------
-
-REPLACING FILE KERNCDC 2.09 840618 11.14
-
-CORRECTIONS : P=CERNOSBE, D=INBCD FIXED TO WORK
-
----------------------------------------------------------------------
-
-UP-DATE 2.09 : 18-JUN-1984
-----------------------------
-
-REPLACING FILE KERNCDC 2.08 840426 13.09
-
-CORRECTIONS : P=XIOCDCV HANDLE LIST EXCEEDS DATA
-
----------------------------------------------------------------------
-
-UP-DATE 2.08 : 26-APR-1984
-----------------------------
-
-REPLACING FILE KERNCDC 2.07 831121 18.51
-
-NEW PATCH : P=CERNOSBE FOR USE AT CERN
-
----------------------------------------------------------------------
-
-UP-DATE 2.07 : 21-NOV-1983
-----------------------------
-
-REPLACING FILE KERNCDC 2.06 830901 18.16
-
-CORRECTIONS: P=CDCFTN, D=UCTOH,UHTOC NEW VERSIONS
- D=UCTOH1,UH1TOC NEW ROUTINES FOR F77
- D=UBLOW,UBUNCH ENTRY UCTOH1,UH1TOC
- CONDITIONAL IF=-F77
-
- P=CDCSYS, D=KFILE ADD FIX FOR F77
-
----------------------------------------------------------------------
-
-UP-DATE 2.06 : 1-SEP-1983
-----------------------------
-
-REPLACING FILE KERNCDC 2.05 821202 15.55
-
-CORRECTIONS: P=XIOCDCV, D=. ADD USE-SELECTION OF XERROR
-
- P=CDCSYS, D=DATIMH ACCEPT HOLLERITH OR CHAR TYPE
-
----------------------------------------------------------------------
-
-UP-DATE 2.05 : 2-DEC-1982
-----------------------------
-
-REPLACING FILE KERNCDC 2.04 821124 22.24
-
-
-CORRECTIONS: D=UHTOC CORRECT ERROR IN CALLING SEQUENCE
-
----------------------------------------------------------------------
-
-UP-DATE 2.04 : 24-NOV-1982
-----------------------------
-
-REPLACING FILE KERNCDC 2.03 821007 17.10
-
-
-DELETION : P=CDCFTN, D=FINT. USE FORTRAN STANDARD VERSION
-
----------------------------------------------------------------------
-
-UP-DATE 2.03 : 7-OCT-1982
-----------------------------
-
-REPLACING FILE KERNCDC 2.02 820818 17.58
-
-
-CORRECTIONS: P=XIOCDCV ADD USE-SELECTION OF XSETIO
-
- D=LOCF,DATIME,... ADD +USE,...,T=INH
-
----------------------------------------------------------------------
-
-UP-DATE 2.02 : 18-AUG-1982
-----------------------------
-
-REPLACING FILE KERNCDC 2.01 820801 12.00
-
-
-CORRECTIONS: P=XVECTCDC, D=XINB,XINBS REMOVE USE OF IXLONG
-
----------------------------------------------------------------------
-
-UP-DATE 2.01 : 27-JUL-1982
-----------------------------
-
-REPLACING FILE KERNCDC 2.00 820401 12.00
-
-DELETED : P=CDCFTN, D=NORRAN
-
-NEW DECKS : P=CDCFTN, D=CVT360, FTO360
-
-CORRECTIONS: P=*KV... ACTIVATE LXBITS FOR FORTRAN 77
- P=*KVCDC76 INHIBIT INCMEM, LBCMZB
- P=CDCFTN, D=UCOPY,UCOPY2 FIX FOR FORTRAN 77
-
----------------------------------------------------------------------
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/inhibit.list b/src/packlib/kernlib/kerngen/obsolete/kerncdc/inhibit.list
deleted file mode 100644
index 33ee537..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/inhibit.list
+++ /dev/null
@@ -1,165 +0,0 @@
-cdc76sys/lbcmzb
-cdcsys/incmem
-cdcsys/incmem
-cdcsys/incmem
-cdcsys/incmem
-cdcsys/incmem
-tcgen/locf
-xvect/xinb
-xvect/xinbf
-xvect/xinbs
-xvect/xincf
-xvect/xinb
-xvect/xinbf
-xvect/xinbs
-xvect/xincf
-xscope/lxbits
-tcgen/gshow
-tcgen/bitpos
-tcgen/blow
-tcgen/btest
-tcgen/bunch
-tcgen/cbyt
-tcgen/cfromi
-tcgen/floarg
-tcgen/flpsor
-tcgen/ibits
-tcgen/ibclr
-tcgen/ibset
-tcgen/ie3fos
-tcgen/ie3fod
-tcgen/ie3tos
-tcgen/ie3tod
-tcgen/ifromc
-tcgen/incbyt
-tcgen/intarg
-tcgen/intsor
-tcgen/ishft
-tcgen/ishftc
-tcgen/iuback
-tcgen/iubin
-tcgen/iuchan
-tcgen/iucomp
-tcgen/iufind
-tcgen/iuforw
-tcgen/iuhist
-tcgen/iuhunt
-tcgen/iumode
-tcgen/iusame
-tcgen/jbit
-tcgen/jbyt
-tcgen/jbytet
-tcgen/jbytor
-tcgen/jbytpk
-tcgen/jrsbyt
-tcgen/locbyt
-tcgen/lorenb
-tcgen/lorenf
-tcgen/loren4
-tcgen/lvmax
-tcgen/lvmaxa
-tcgen/lvmin
-tcgen/lvmina
-tcgen/mbytet
-tcgen/mbytor
-tcgen/mcbyt
-tcgen/msbit
-tcgen/msbyt
-tcgen/mvbits
-tcgen/mxequ
-tcgen/mxmad
-tcgen/mxmlrt
-tcgen/mxtrp
-tcgen/mxuty
-tcgen/pkbyt
-tcgen/pkchar
-tcgen/poweze
-tcgen/proxim
-tcgen/sbit
-tcgen/sbyt
-tcgen/sbytor
-tcgen/sbytpk
-tcgen/sortzv
-tcgen/traat
-tcgen/tral
-tcgen/tralt
-tcgen/tras
-tcgen/trasat
-tcgen/trata
-tcgen/tratsa
-tcgen/trchlu
-tcgen/trchul
-tcgen/trinv
-tcgen/trla
-tcgen/trlta
-tcgen/trpck
-tcgen/trqsq
-tcgen/trsat
-tcgen/trats
-tcgen/trsa
-tcgen/trsmlu
-tcgen/trsmul
-tcgen/trupck
-tcgen/ubits
-tcgen/ublank
-tcgen/ublow
-tcgen/uctoh1
-tcgen/ubunch
-tcgen/uh1toc
-tcgen/ucocop
-tcgen/ucopy
-tcgen/ucopy2
-tcgen/uctoh
-tcgen/uctoh1
-tcgen/udicop
-tcgen/ufill
-tcgen/uflint
-tcgen/uhtoc
-tcgen/uh1toc
-tcgen/uleft
-tcgen/uopt
-tcgen/upkbyt
-tcgen/upkch
-tcgen/uright
-tcgen/uset
-tcgen/uswop
-tcgen/uzero
-tcgen/vadd
-tcgen/vasum
-tcgen/vbias
-tcgen/vblank
-tcgen/vdot
-tcgen/vdotn
-tcgen/vdotn2
-tcgen/vfill
-tcgen/vline
-tcgen/vmatl
-tcgen/vmatr
-tcgen/vmax
-tcgen/vmaxa
-tcgen/vmin
-tcgen/vmina
-tcgen/vmod
-tcgen/vmul
-tcgen/vscale
-tcgen/vsub
-tcgen/vsum
-tcgen/vunit
-tcgen/vzero
-tcgen/intrac
-cdcsys/detach
-cdcsys/retrnf
-cdcsys/jobnam
-cdcsys/namjob
-cdcsys/timed
-tcgen/timed
-cdcsys/equbuf
-cdcsys/jobnam
-cdcsys/namjob
-tcgen/datime
-tcgen/datimh
-tcgen/noarg
-tcgen/qnexte
-tcgen/timed
-tcgen/timel
-tcgen/timex
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/kerncdc/cdc60sys.h b/src/packlib/kernlib/kerngen/obsolete/kerncdc/kerncdc/cdc60sys.h
deleted file mode 100644
index 7e46f55..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/kerncdc/cdc60sys.h
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: cdc60sys.h,v 1.1.1.1 1996/02/15 17:51:13 mclareni Exp $
-*
-* $Log: cdc60sys.h,v $
-* Revision 1.1.1.1 1996/02/15 17:51:13 mclareni
-* Kernlib
-*
-*
-* This directory was created from kerncdc.car patch cdc60sys
-#ifndef CERNLIB_CDCSYS
-#define CERNLIB_CDCSYS
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/kerncdc/cdc76sys.h b/src/packlib/kernlib/kerngen/obsolete/kerncdc/kerncdc/cdc76sys.h
deleted file mode 100644
index 4f23611..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/kerncdc/cdc76sys.h
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: cdc76sys.h,v 1.1.1.1 1996/02/15 17:51:13 mclareni Exp $
-*
-* $Log: cdc76sys.h,v $
-* Revision 1.1.1.1 1996/02/15 17:51:13 mclareni
-* Kernlib
-*
-*
-* This directory was created from kerncdc.car patch cdc76sys
-#ifndef CERNLIB_CDCSYS
-#define CERNLIB_CDCSYS
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/kerncdc/cdcnos.h b/src/packlib/kernlib/kerngen/obsolete/kerncdc/kerncdc/cdcnos.h
deleted file mode 100644
index 5d37805..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/kerncdc/cdcnos.h
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: cdcnos.h,v 1.1.1.1 1996/02/15 17:51:13 mclareni Exp $
-*
-* $Log: cdcnos.h,v $
-* Revision 1.1.1.1 1996/02/15 17:51:13 mclareni
-* Kernlib
-*
-*
-* This directory was created from kerncdc.car patch cdcnos
-#ifndef CERNLIB_CDCSYS
-#define CERNLIB_CDCSYS
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/kerncdc/cdcnosbe.h b/src/packlib/kernlib/kerngen/obsolete/kerncdc/kerncdc/cdcnosbe.h
deleted file mode 100644
index 62a922d..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/kerncdc/cdcnosbe.h
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: cdcnosbe.h,v 1.1.1.1 1996/02/15 17:51:13 mclareni Exp $
-*
-* $Log: cdcnosbe.h,v $
-* Revision 1.1.1.1 1996/02/15 17:51:13 mclareni
-* Kernlib
-*
-*
-* This directory was created from kerncdc.car patch cdcnosbe
-#ifndef CERNLIB_CDCSYS
-#define CERNLIB_CDCSYS
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/kerncdc/pilot.h b/src/packlib/kernlib/kerngen/obsolete/kerncdc/kerncdc/pilot.h
deleted file mode 100644
index 0ca41ce..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/kerncdc/pilot.h
+++ /dev/null
@@ -1,54 +0,0 @@
-#if 0
-* This pilot patch was created from kerncdc.car patch _kcdc
-#endif
-#ifndef CERNLIB_QMCDC
-#define CERNLIB_QMCDC
-#endif
-#ifndef CERNLIB_TCGEN
-#define CERNLIB_TCGEN
-#endif
-#ifndef CERNLIB_CDCFTN
-#define CERNLIB_CDCFTN
-#endif
-#ifdef CERNLIB_TCGEN_LOCF
-#undef CERNLIB_TCGEN_LOCF
-#endif
-#ifndef CERNLIB_B60
-#define CERNLIB_B60
-#endif
-#ifndef CERNLIB_B60M
-#define CERNLIB_B60M
-#endif
-#ifndef CERNLIB_B48M
-#define CERNLIB_B48M
-#endif
-#ifndef CERNLIB_B36M
-#define CERNLIB_B36M
-#endif
-#ifndef CERNLIB_A10
-#define CERNLIB_A10
-#endif
-#ifndef CERNLIB_A8M
-#define CERNLIB_A8M
-#endif
-#ifndef CERNLIB_A6M
-#define CERNLIB_A6M
-#endif
-#ifndef CERNLIB_A5M
-#define CERNLIB_A5M
-#endif
-#if 0
-* In-line AND / OR
-#endif
-#ifndef CERNLIB_QANDORINL
-#define CERNLIB_QANDORINL
-#endif
-#if 0
-* In-line SHIFT L/R
-#endif
-#ifndef CERNLIB_QSHIFTINL
-#define CERNLIB_QSHIFTINL
-#endif
-#ifndef CERNLIB_QSHICOINL
-#define CERNLIB_QSHICOINL
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/kerncdc/q_andor.inc b/src/packlib/kernlib/kerngen/obsolete/kerncdc/kerncdc/q_andor.inc
deleted file mode 100644
index 19d0c2a..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/kerncdc/q_andor.inc
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: q_andor.inc,v 1.1.1.1 1996/02/15 17:51:12 mclareni Exp $
-*
-* $Log: q_andor.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:51:12 mclareni
-* Kernlib
-*
-*
-#ifndef CERNLIB_KERNCDC_Q_ANDOR_INC
-#define CERNLIB_KERNCDC_Q_ANDOR_INC
-*
-*
-* q_andor.inc
-*
-#if 0
- IAND (IZV,IZW) = IZV .AND. IZW
-#endif
-#if 0
- IOR (IZV,IZW) = IZV .OR. IZW
-#endif
-#if 0
- IEOR (IZV,IZW) = IZV .XOR. IZW
-#endif
-#if 0
- NOT (IZW) = .NOT. IZW
-#endif
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/kerncdc/q_cbyt.inc b/src/packlib/kernlib/kerngen/obsolete/kerncdc/kerncdc/q_cbyt.inc
deleted file mode 100644
index f38aea3..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/kerncdc/q_cbyt.inc
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: q_cbyt.inc,v 1.1.1.1 1996/02/15 17:51:12 mclareni Exp $
-*
-* $Log: q_cbyt.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:51:12 mclareni
-* Kernlib
-*
-*
-#ifndef CERNLIB_KERNCDC_Q_CBYT_INC
-#define CERNLIB_KERNCDC_Q_CBYT_INC
-*
-*
-* q_cbyt.inc
-*
-#if 0
- MCBYT (MZ,IZQ,IZW,IZP,NZB) = SHIFT (
-#endif
-#if 0
- + (SHIFT(IZW,61-IZP-NZB) .AND. .NOT.MASK(NZB))
-#endif
-#if 0
- + .OR. (SHIFT (MZ,61-IZQ-NZB) .AND. MASK(NZB)), IZP+NZB-1)
-#endif
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/kerncdc/q_jbit.inc b/src/packlib/kernlib/kerngen/obsolete/kerncdc/kerncdc/q_jbit.inc
deleted file mode 100644
index c76a112..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/kerncdc/q_jbit.inc
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: q_jbit.inc,v 1.1.1.1 1996/02/15 17:51:12 mclareni Exp $
-*
-* $Log: q_jbit.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:51:12 mclareni
-* Kernlib
-*
-*
-#ifndef CERNLIB_KERNCDC_Q_JBIT_INC
-#define CERNLIB_KERNCDC_Q_JBIT_INC
-*
-*
-* q_jbit.inc
-*
-#if 0
- JBIT (IZW,IZP) = SHIFT(IZW,61-IZP) .AND. .NOT.MASK(59)
-#endif
-#if 0
- JBYT (IZW,IZP,NZB) = SHIFT(IZW,61-IZP) .AND. .NOT.MASK(60-NZB)
-#endif
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/kerncdc/q_jbytet.inc b/src/packlib/kernlib/kerngen/obsolete/kerncdc/kerncdc/q_jbytet.inc
deleted file mode 100644
index a51a808..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/kerncdc/q_jbytet.inc
+++ /dev/null
@@ -1,40 +0,0 @@
-*
-* $Id: q_jbytet.inc,v 1.1.1.1 1996/02/15 17:51:12 mclareni Exp $
-*
-* $Log: q_jbytet.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:51:12 mclareni
-* Kernlib
-*
-*
-#ifndef CERNLIB_KERNCDC_Q_JBYTET_INC
-#define CERNLIB_KERNCDC_Q_JBYTET_INC
-*
-*
-* q_jbytet.inc
-*
-#if 0
- JBYTET (MZ,IZW,IZP,NZB) = MZ .AND. SHIFT(IZW,61-IZP)
-#endif
-#if 0
- + .AND. .NOT.MASK(60-NZB)
-#endif
-#if 0
- JBYTOR (MZ,IZW,IZP,NZB) = MZ .OR. (SHIFT(IZW,61-IZP)
-#endif
-#if 0
- + .AND. .NOT.MASK(60-NZB) )
-#endif
-#if 0
- MBYTET (MZ,IZW,IZP,NZB) = IZW .AND.
-#endif
-#if 0
- + SHIFT (MZ .OR. MASK(60-NZB),IZP-1)
-#endif
-#if 0
- MBYTOR (MZ,IZW,IZP,NZB) = IZW .OR.
-#endif
-#if 0
- + SHIFT (MZ .AND. .NOT.MASK(60-NZB),IZP-1)
-#endif
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/kerncdc/q_sbit.inc b/src/packlib/kernlib/kerngen/obsolete/kerncdc/kerncdc/q_sbit.inc
deleted file mode 100644
index 26fe1df..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/kerncdc/q_sbit.inc
+++ /dev/null
@@ -1,37 +0,0 @@
-*
-* $Id: q_sbit.inc,v 1.1.1.1 1996/02/15 17:51:12 mclareni Exp $
-*
-* $Log: q_sbit.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:51:12 mclareni
-* Kernlib
-*
-*
-#ifndef CERNLIB_KERNCDC_Q_SBIT_INC
-#define CERNLIB_KERNCDC_Q_SBIT_INC
-*
-*
-* q_sbit.inc
-*
-#if 0
- MSBIT0 (IZW,IZP) = IZW .AND. .NOT.SHIFT(MASK(1),IZP)
-#endif
-#if 0
- MSBIT1 (IZW,IZP) = IZW .OR. SHIFT(MASK(1),IZP)
-#endif
-#if 0
- MSBIT (MZ,IZW,IZP) =(IZW .AND. .NOT.SHIFT(MASK(1),IZP))
-#endif
-#if 0
- + .OR. SHIFT(MZ .AND. .NOT.MASK(59),IZP-1)
-#endif
-#if 0
- MSBYT (MZ,IZW,IZP,NZB) = SHIFT (
-#endif
-#if 0
- + (SHIFT(IZW,61-IZP-NZB) .AND. .NOT.MASK(NZB))
-#endif
-#if 0
- + .OR. (SHIFT (MZ,60-NZB) .AND. MASK(NZB)), IZP+NZB-1)
-#endif
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/kerncdc/q_shift.inc b/src/packlib/kernlib/kerngen/obsolete/kerncdc/kerncdc/q_shift.inc
deleted file mode 100644
index 301c1ce..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/kerncdc/q_shift.inc
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: q_shift.inc,v 1.1.1.1 1996/02/15 17:51:12 mclareni Exp $
-*
-* $Log: q_shift.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:51:12 mclareni
-* Kernlib
-*
-*
-#ifndef CERNLIB_KERNCDC_Q_SHIFT_INC
-#define CERNLIB_KERNCDC_Q_SHIFT_INC
-*
-*
-* q_shift.inc
-*
-#if 0
- ISHFTL (IZW,NZB) = SHIFT (IZW,NZB) .AND. MASK(60-NZB)
-#endif
-#if 0
- ISHFTR (IZW,NZB) = SHIFT (IZW.AND.MASK(60-NZB), 60-NZB)
-#endif
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/kerncdc/xiocdcv.h b/src/packlib/kernlib/kerngen/obsolete/kerncdc/kerncdc/xiocdcv.h
deleted file mode 100644
index 1a26721..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/kerncdc/xiocdcv.h
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: xiocdcv.h,v 1.1.1.1 1996/02/15 17:51:13 mclareni Exp $
-*
-* $Log: xiocdcv.h,v $
-* Revision 1.1.1.1 1996/02/15 17:51:13 mclareni
-* Kernlib
-*
-*
-* This directory was created from kerncdc.car patch xiocdcv
-#ifndef CERNLIB_XVECT
-#define CERNLIB_XVECT
-#endif
-#ifndef CERNLIB_XSCOPE_XSETIO
-#define CERNLIB_XSCOPE_XSETIO
-#endif
-#ifndef CERNLIB_XSCOPE_XERROR
-#define CERNLIB_XSCOPE_XERROR
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/kerncdc/xscope2.h b/src/packlib/kernlib/kerngen/obsolete/kerncdc/kerncdc/xscope2.h
deleted file mode 100644
index 946be88..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/kerncdc/xscope2.h
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: xscope2.h,v 1.1.1.1 1996/02/15 17:51:13 mclareni Exp $
-*
-* $Log: xscope2.h,v $
-* Revision 1.1.1.1 1996/02/15 17:51:13 mclareni
-* Kernlib
-*
-*
-* This directory was created from kerncdc.car patch xscope2
-#ifndef CERNLIB_XSCOPE
-#define CERNLIB_XSCOPE
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/kerncdc/xscope3.h b/src/packlib/kernlib/kerngen/obsolete/kerncdc/kerncdc/xscope3.h
deleted file mode 100644
index ea3ab8b..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/kerncdc/xscope3.h
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: xscope3.h,v 1.1.1.1 1996/02/15 17:51:13 mclareni Exp $
-*
-* $Log: xscope3.h,v $
-* Revision 1.1.1.1 1996/02/15 17:51:13 mclareni
-* Kernlib
-*
-*
-* This directory was created from kerncdc.car patch xscope3
-#ifndef CERNLIB_XSCOPE
-#define CERNLIB_XSCOPE
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/kerncdc/xvectcdc.h b/src/packlib/kernlib/kerngen/obsolete/kerncdc/kerncdc/xvectcdc.h
deleted file mode 100644
index 0fbc714..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/kerncdc/xvectcdc.h
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: xvectcdc.h,v 1.1.1.1 1996/02/15 17:51:13 mclareni Exp $
-*
-* $Log: xvectcdc.h,v $
-* Revision 1.1.1.1 1996/02/15 17:51:13 mclareni
-* Kernlib
-*
-*
-* This directory was created from kerncdc.car patch xvectcdc
-#ifndef CERNLIB_XVECT
-#define CERNLIB_XVECT
-#endif
-#ifdef CERNLIB_XVECT_XINB
-#undef CERNLIB_XVECT_XINB
-#endif
-#ifdef CERNLIB_XVECT_XINBF
-#undef CERNLIB_XVECT_XINBF
-#endif
-#ifdef CERNLIB_XVECT_XINBS
-#undef CERNLIB_XVECT_XINBS
-#endif
-#ifdef CERNLIB_XVECT_XINCF
-#undef CERNLIB_XVECT_XINCF
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/xiocdcv/xinb.F b/src/packlib/kernlib/kerngen/obsolete/kerncdc/xiocdcv/xinb.F
deleted file mode 100644
index d7067c6..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/xiocdcv/xinb.F
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: xinb.F,v 1.1.1.1 1996/02/15 17:51:16 mclareni Exp $
-*
-* $Log: xinb.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:16 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE XINB (LUN,XBV,NXB)
-
-C CERN PROGLIB# Z203 XINB .VERSION KERNCDC 2.09 840618
-
- DIMENSION XBV(99)
-
- READ (LUN,IOSTAT=NSTAT) N,(XBV(J),J=1,MIN0(N,NXB))
- IF (NSTAT) 61,24,64
- 24 NXB = MIN0 (N,NXB)
- RETURN
-
- 61 NXB = 0
- RETURN
-
- 64 IF (NSTAT.EQ.63) GO TO 61
- IF (NSTAT.EQ.89) GO TO 24
- NXB = -7
- RETURN
- END
-#ifdef CERNLIB_XVECT_XINB
-#undef CERNLIB_XVECT_XINB
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/xiocdcv/xinbf.F b/src/packlib/kernlib/kerngen/obsolete/kerncdc/xiocdcv/xinbf.F
deleted file mode 100644
index f1d17df..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/xiocdcv/xinbf.F
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: xinbf.F,v 1.1.1.1 1996/02/15 17:51:16 mclareni Exp $
-*
-* $Log: xinbf.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:16 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE XINBF (LUN,XBV,NXB)
-
-C CERN PROGLIB# Z203 XINBF .VERSION KERNCDC 2.09 840618
-
- DIMENSION XBV(NXB)
-
- READ (LUN,IOSTAT=NSTAT) XBV
- IF (NSTAT) 61,24,64
- 24 CONTINUE
- RETURN
-
- 61 NXB = 0
- RETURN
-
- 64 IF (NSTAT.EQ.63) GO TO 61
- IF (NSTAT.EQ.89) GO TO 24
- NXB = -7
- RETURN
- END
-#ifdef CERNLIB_XVECT_XINBF
-#undef CERNLIB_XVECT_XINBF
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/xiocdcv/xinbs.F b/src/packlib/kernlib/kerngen/obsolete/kerncdc/xiocdcv/xinbs.F
deleted file mode 100644
index c875013..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/xiocdcv/xinbs.F
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: xinbs.F,v 1.1.1.1 1996/02/15 17:51:16 mclareni Exp $
-*
-* $Log: xinbs.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:16 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE XINBS (LUN,XAV,NA,XBV,NXB)
-
-C CERN PROGLIB# Z203 XINBS .VERSION KERNCDC 2.09 840618
-
- DIMENSION XBV(99), XAV(NA)
-
- READ (LUN,IOSTAT=NSTAT) N,XAV,(XBV(J),J=1,MIN0(N,NXB))
- IF (NSTAT) 61,24,64
- 24 NXB = MIN0 (N,NXB)
- RETURN
-
- 61 NXB = 0
- RETURN
-
- 64 IF (NSTAT.EQ.63) GO TO 61
- IF (NSTAT.EQ.89) GO TO 24
- NXB = -7
- RETURN
- END
-#ifdef CERNLIB_XVECT_XINBS
-#undef CERNLIB_XVECT_XINBS
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/xiocdcv/xincf.F b/src/packlib/kernlib/kerngen/obsolete/kerncdc/xiocdcv/xincf.F
deleted file mode 100644
index 9c8b731..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/xiocdcv/xincf.F
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: xincf.F,v 1.1.1.1 1996/02/15 17:51:16 mclareni Exp $
-*
-* $Log: xincf.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:16 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE XINCF (LUN,XBV,NXB)
-
-C CERN PROGLIB# Z203 XINCF .VERSION KERNCDC 1.13 820111
-
- DIMENSION XBV(NXB)
-
- READ (LUN,8000,IOSTAT=NSTAT) XBV
- IF (NSTAT) 61,24,64
- 24 CONTINUE
- RETURN
-
- 61 NXB = 0
- RETURN
-
- 64 IF (NSTAT.EQ.65) GO TO 61
- NXB = -7
- RETURN
-
- 8000 FORMAT (14A10)
- END
-#ifdef CERNLIB_XVECT_XINCF
-#undef CERNLIB_XVECT_XINCF
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/xscope/ixfpzl.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/xscope/ixfpzl.s
deleted file mode 100644
index f36817b..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/xscope/ixfpzl.s
+++ /dev/null
@@ -1,38 +0,0 @@
-*
-* $Id: ixfpzl.s,v 1.1.1.1 1996/02/15 17:51:17 mclareni Exp $
-*
-* $Log: ixfpzl.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:17 mclareni
-* Kernlib
-*
-*
- IDENT IXFPZL
-*
-* CERN PROGLIB# Z200 IXFPZL .VERSION KERNCDC 1.16 820129
-*
- ENTRY IXFPZL
-*
-* FUNCTION IXFPZL (LUN)
-*
-* IT RETURNS 1 FOR E.O.R
-* 2 FOR E.O.S
-* 4 FOR E.O.P
-* 8 FOR E.O.I
-*
-* PROGRAM TAKEN FROM CERN PROGLIB 15-OCT-77, CHL
-*
- TRACE. VFD 36/6HIXFPZL,24/IXFPZL
- TEMPA0 BSSZ 1
- IXFPZL EQ *+1BS17
- MX6 1
- BX1 X1+X6
-+RJ=XGETFIT
-- VFD 30/TRACE.
- SX6 A0
- SA6 TEMPA0
- FETCH X1,FP,X6
- SA1 TEMPA0
- AX6 3
- SA0 X1
- EQ IXFPZL
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/xscope/lxbits.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/xscope/lxbits.s
deleted file mode 100644
index 3db0c3c..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/xscope/lxbits.s
+++ /dev/null
@@ -1,37 +0,0 @@
-*
-* $Id: lxbits.s,v 1.1.1.1 1996/02/15 17:51:17 mclareni Exp $
-*
-* $Log: lxbits.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:17 mclareni
-* Kernlib
-*
-*
- IDENT LXBITS
-*
-* CERN PROGLIB# Z200 LXBITS .VERSION KERNCDC 1.16 820129
-*
-* FUNCTION LXBITS (IUNIT) VERSION CDC SCOPE 3
-* RETURNS IN X6 THE LENGTH IN BITS OF RECORD
-*
- ENTRY LXBITS
- TRACE VFD 42/7HLXBITS ,18/LXBITS
- STOREA0 BSS 1
- LXBITS DATA 0
- SX6 A0 SAVE A0
- SA6 STOREA0
- SA0 A1 IUNIT IN X1
- SA1 A0
- MX6 1
- BX1 X1+X6
-+RJ=XGETFIT
-- VFD 30/TRACE
- FETCH X1,RL,X6
- SB1 1
- LX5 X6,B1
- SB1 2
- LX7 X6,B1
- IX6 X5+X7
- SA5 STOREA0 RESTORE A0
- SA0 X5
- EQ LXBITS
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/xscope/xback.F b/src/packlib/kernlib/kerngen/obsolete/kerncdc/xscope/xback.F
deleted file mode 100644
index 948265d..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/xscope/xback.F
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: xback.F,v 1.1.1.1 1996/02/15 17:51:17 mclareni Exp $
-*
-* $Log: xback.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:17 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE XBACK (LUN)
-
-C CERN PROGLIB# Z200 XBACK .VERSION KERNCDC 0.1 750926
-
- BACKSPACE LUN
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/xscope/xeof.F b/src/packlib/kernlib/kerngen/obsolete/kerncdc/xscope/xeof.F
deleted file mode 100644
index b1aa7d8..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/xscope/xeof.F
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: xeof.F,v 1.1.1.1 1996/02/15 17:51:17 mclareni Exp $
-*
-* $Log: xeof.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:17 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- LOGICAL FUNCTION XEOF (LUN)
-
-C CERN PROGLIB# Z200 XEOF .VERSION KERNCDC 0.1 750926
-
- XEOF=.FALSE.
- IF (EOF (LUN)) 10,20
- 10 XEOF=.TRUE.
- 20 RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/xscope/xerror.F b/src/packlib/kernlib/kerngen/obsolete/kerncdc/xscope/xerror.F
deleted file mode 100644
index 4ae0e00..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/xscope/xerror.F
+++ /dev/null
@@ -1,39 +0,0 @@
-*
-* $Id: xerror.F,v 1.1.1.1 1996/02/15 17:51:17 mclareni Exp $
-*
-* $Log: xerror.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:17 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE ER78
-
-C CERN PROGLIB# Z200 XERROR .VERSION KERNCDC 2.06 830901
-
- COMMON/ERFLG/IF78
- LOGICAL IF78
- DATA IF78 / .FALSE./
-
- IF78=.TRUE.
- RETURN
- END
-*================================================
- SUBROUTINE ER89
-
- RETURN
- END
-*==============================================
- SUBROUTINE SETERR (NERROR,ERNB)
-
- EXTERNAL ERNB
- DIMENSION IARG(6)
- DATA IARG / 0, 0, 0, 0, 0, -1/
- ENTRY SETERC
-
-
- IARG(5)=LOCF (ERNB)
- CALL SYSTEMC (NERROR,IARG)
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/xscope/xilleg.F b/src/packlib/kernlib/kerngen/obsolete/kerncdc/xscope/xilleg.F
deleted file mode 100644
index b61e930..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/xscope/xilleg.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: xilleg.F,v 1.1.1.1 1996/02/15 17:51:17 mclareni Exp $
-*
-* $Log: xilleg.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:17 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- LOGICAL FUNCTION XILLEG (LUN)
-
-C CERN PROGLIB# Z200 XILLEG .VERSION KERNCDC 0.1 750926
-
- COMMON/ERFLG/IF78
- LOGICAL IF78
-
- XILLEG=IF78
- IF78=.FALSE.
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/xscope/xrdin.F b/src/packlib/kernlib/kerngen/obsolete/kerncdc/xscope/xrdin.F
deleted file mode 100644
index fe5f974..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/xscope/xrdin.F
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: xrdin.F,v 1.1.1.1 1996/02/15 17:51:17 mclareni Exp $
-*
-* $Log: xrdin.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:17 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- LOGICAL FUNCTION XRDIN (LUN)
-
-C CERN PROGLIB# Z200 XRDIN .VERSION KERNCDC 0.1 750926
-
- XRDIN=.FALSE.
- IF (IOCHEC(LUN)) 15,25
- 15 XRDIN=.TRUE.
- 25 RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/xscope/xread.F b/src/packlib/kernlib/kerngen/obsolete/kerncdc/xscope/xread.F
deleted file mode 100644
index 7ee089c..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/xscope/xread.F
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: xread.F,v 1.1.1.1 1996/02/15 17:51:17 mclareni Exp $
-*
-* $Log: xread.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:17 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE XREAD (ITAP,IPAR,ISTOR,JA,JE)
-
-C CERN PROGLIB# Z200 XREAD .VERSION KERNCDC 1.05 780503
-
- DIMENSION ISTOR(256)
-
-
- NWORDS = JE+1 - JA
-
- IF (IPAR) 99, 21, 11
-
- 11 CALL XREADB (ITAP,ISTOR(JA),NWORDS)
- RETURN
-
- 21 CALL XREADC (ITAP,ISTOR(JA),NWORDS)
- 99 RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/xscope/xreadb.F b/src/packlib/kernlib/kerngen/obsolete/kerncdc/xscope/xreadb.F
deleted file mode 100644
index 3b08292..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/xscope/xreadb.F
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: xreadb.F,v 1.1.1.1 1996/02/15 17:51:17 mclareni Exp $
-*
-* $Log: xreadb.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:17 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE XREADB (LUN,MV,N)
-
-C CERN PROGLIB# Z200 XREADB .VERSION KERNCDC 1.05 780503
-
-C- ROUTINE TO READ 1 BINARY RECORD, 29/04/78 JZ
-
- DIMENSION MV(N)
-
-
- READ (LUN) MV
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/xscope/xreadc.F b/src/packlib/kernlib/kerngen/obsolete/kerncdc/xscope/xreadc.F
deleted file mode 100644
index 64d689f..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/xscope/xreadc.F
+++ /dev/null
@@ -1,30 +0,0 @@
-*
-* $Id: xreadc.F,v 1.1.1.1 1996/02/15 17:51:17 mclareni Exp $
-*
-* $Log: xreadc.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:17 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE XREADC (LUN,MV,N)
-
-C CERN PROGLIB# Z200 XREADC .VERSION KERNCDC 1.13 820111
-
-C- ROUTINE TO READ 1 CODED RECORD, 29/04/78 JZ
-
- DIMENSION MV(N)
-
- DATA LBCD / 14 /
-
-
- IF (N.LE.LBCD) GO TO 22
- READ (LUN,1000) (MV(J),J=1,LBCD)
- RETURN
-
- 22 READ (LUN,1000) MV
- RETURN
-
- 1000 FORMAT (13A10,A6)
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/xscope/xreads.F b/src/packlib/kernlib/kerngen/obsolete/kerncdc/xscope/xreads.F
deleted file mode 100644
index 8300d6f..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/xscope/xreads.F
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: xreads.F,v 1.1.1.1 1996/02/15 17:51:18 mclareni Exp $
-*
-* $Log: xreads.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:18 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE XREADS (LUN,MVA,NA,MVB,NB)
-
-C CERN PROGLIB# Z200 XREADS .VERSION KERNCDC 1.05 780503
-
-C- ROUTINE TO READ 1 BINARY RECORD SPLIT INTO 2 PARTS, 29/04/78 JZ
-
- DIMENSION MVA(NA), MVB(NB)
-
-
- IF (NA.LE.0) GO TO 31
- IF (NB.LE.0) GO TO 24
- READ (LUN) MVA, MVB
- RETURN
-
- 24 READ (LUN) MVA
- RETURN
-
- 31 IF (NB.LE.0) RETURN
- READ (LUN) MVB
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/xscope/xrew.F b/src/packlib/kernlib/kerngen/obsolete/kerncdc/xscope/xrew.F
deleted file mode 100644
index e1408ef..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/xscope/xrew.F
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: xrew.F,v 1.1.1.1 1996/02/15 17:51:18 mclareni Exp $
-*
-* $Log: xrew.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:18 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE XREW (LUN)
-
-C CERN PROGLIB# Z200 XREW .VERSION KERNCDC 0.1 750926
-
- REWIND LUN
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/xscope/xsetio.F b/src/packlib/kernlib/kerngen/obsolete/kerncdc/xscope/xsetio.F
deleted file mode 100644
index 78023cc..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/xscope/xsetio.F
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: xsetio.F,v 1.1.1.1 1996/02/15 17:51:18 mclareni Exp $
-*
-* $Log: xsetio.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:18 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE XSETIO
-
-C CERN PROGLIB# Z200 XSETIO .VERSION KERNCDC 0.1 750926
-
- EXTERNAL ER89
-
- CALL SETERR (89,ER89)
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/xscope/xtpch.F b/src/packlib/kernlib/kerngen/obsolete/kerncdc/xscope/xtpch.F
deleted file mode 100644
index 4eda91a..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/xscope/xtpch.F
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: xtpch.F,v 1.1.1.1 1996/02/15 17:51:18 mclareni Exp $
-*
-* $Log: xtpch.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:18 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE XTPCH (LUN)
-
-C CERN PROGLIB# Z200 XTPCH .VERSION KERNCDC 0.1 750926
-
- CALL CLVLZL (LUN,IFLAG)
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/xscope/xtpch2.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/xscope/xtpch2.s
deleted file mode 100644
index 3626b2a..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/xscope/xtpch2.s
+++ /dev/null
@@ -1,84 +0,0 @@
-*
-* $Id: xtpch2.s,v 1.1.1.1 1996/02/15 17:51:18 mclareni Exp $
-*
-* $Log: xtpch2.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:18 mclareni
-* Kernlib
-*
-*
- IDENT CLVLZL
-*
-* CERN PROGLIB# Z200 XTPCH2 .VERSION KERNCDC 1.16 820129
-*
- ENTRY CLVLZL
- ENTRY XTPCH2
-* SUBROUTINE XTPCH2(LUN,NERROR)
-* SUBROUTINE CLVLZL (LUN,NERROR)
- TRACE. VFD 42/0HCLVLZL,18/CLVLZL
-*
- TEMPA0 BSS 1
- RC BSSZ 1 TO SAVE RC
- ADRC BSSZ 1 TO SAVE RC ADDRESS
- MSG DATA H*CLVLZL - RM ERROR = *
- RMNR DATA H* ON *
- LFN BSSZ 1
-*
- CLVLZL DATA 0
- XTPCH2 EQU CLVLZL
- SX6 A0
- MX7 0
- SA2 A1+1 X2=ADDRESS OF NERROR
- SA6 TEMPA0
- SA7 RC PRESET RC TO ZERO
- BX6 X2
- NO
- SA6 ADRC SAVE ADDRESS OF NERROR
- MX6 1
- BX1 X1+X6
- + RJ =XGETFIT.
- - VFD 30/TRACE.
- STORE X1,EX=RECOV
- CLOSEM X1,R,VOLUME
- END BSS 0
- SA2 ADRC
- SA5 TEMPA0
- SA0 X5 .RESTORE A0
- SA3 RC
- BX6 X3
- SA6 X2 RETURN RC TO USER
- EQ CLVLZL
-*
- RECOV BSS 1 ENTRY FOR RM ERROR
- FETCH X1,IRS,X6
- SA6 RC SAVE FIES
- BX3 X6
-*
-* TRANSFORM INTEGER IN DISPLAY CODE
- MX6 0
- MX0 60-3
- SB5 3 ONLY 3 DIGITS IN RM ERROR
- LX3 51
- SB1 1
- SB4 1R0
- COD1 BSS 0
- LX3 3
- BX4 -X0*X3
- SX5 X4+B4
- LX6 6
- IX6 X6+X5
- SB5 B5-B1
- NZ B5,COD1
- LX6 42
- MX0 18
- SA5 RMNR
- BX4 -X0*X5
- BX6 X0*X6
- IX6 X4+X6
- SA6 A5 STORE RMNR
- SA2 X1
- BX6 X2
- SA6 LFN SAVE LFN NAME
- MESSAGE MSG
- STORE X1,ES=0 CLEAR FIES
- EQ END
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/xscope/xtpfw.F b/src/packlib/kernlib/kerngen/obsolete/kerncdc/xscope/xtpfw.F
deleted file mode 100644
index 8ab06a7..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/xscope/xtpfw.F
+++ /dev/null
@@ -1,37 +0,0 @@
-*
-* $Id: xtpfw.F,v 1.1.1.1 1996/02/15 17:51:18 mclareni Exp $
-*
-* $Log: xtpfw.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:18 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE XTPFW (LUN,NFILE)
-
-C CERN PROGLIB# Z200 XTPFW .VERSION KERNCDC 0.1 750926
-
- LOGICAL XEOF,XRDIN
- DATA (MAXRED =5)
-
- NF=MAX0 (NFILE,1)
-
- 10 NRED=0
- 15 READ (LUN) X
- IF (XEOF (LUN)) GO TO 50
- IF (XRDIN (LUN)) GO TO 20
- GO TO 10
-
-C-- PARITIES
- 20 NRED=NRED+1
- IF (NRED.NE.MAXRED) GO TO 15
- CALL REMARK (40HXTPFW DOES NOT WORK FOR BCD FILES, EXIT.)
- CALL EXIT
-
-C-- ONE E.O.F HAS BEEN CROSSED
- 50 NF=NF-1
- IF (XRDIN (LUN)) CONTINUE
- IF (NF.NE.0) GO TO 10
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/xscope2/ixlong.F b/src/packlib/kernlib/kerngen/obsolete/kerncdc/xscope2/ixlong.F
deleted file mode 100644
index 2cb63ae..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/xscope2/ixlong.F
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: ixlong.F,v 1.1.1.1 1996/02/15 17:51:17 mclareni Exp $
-*
-* $Log: ixlong.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:17 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- FUNCTION IXLONG (LUN)
-
-C CERN PROGLIB# Z200 IXLONG .VERSION KERNCDC 0.1 750926
-
- LB = LXBITS(LUN)
- LW = (LB+59)/60
- IXLONG = LW
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/xscope2/lxbits.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/xscope2/lxbits.s
deleted file mode 100644
index f6b4cf7..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/xscope2/lxbits.s
+++ /dev/null
@@ -1,43 +0,0 @@
-*
-* $Id: lxbits.s,v 1.1.1.1 1996/02/15 17:51:17 mclareni Exp $
-*
-* $Log: lxbits.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:17 mclareni
-* Kernlib
-*
-*
- IDENT LXBITS
-*
-* CERN PROGLIB# Z200 LXBITS .VERSION KERNCDC 1.16 820129
-*
- ENTRY LXBITS
-*
-*FUNCTION LXBITS(IUNIT)
-*RETURNS IN X6 THE LENGTH IN BITS OF RECORD
-*
- VFD 42/7HLXBITS ,18/LXBITS
- STOREA0 BSS 1
- LXBITS DATA 0
- SX6 A0 SAVE A0
- SA6 STOREA0
- SA0 A1 IUNIT IN X1
- SA1 A0
- MX6 1
- BX1 X1+X6
- RJ =XGETFIT. GET ADDRESS OF FIT IN X1
- FETCH X1,PTLW,X6
- SX5 X6 X5=NW
- AX6 18 X6=UBC
- SB1 2
- LX7 X5,B1 4*NW
- SB1 B1+B1
- LX5 X7,B1 64*NW
- IX4 X5-X7 60*NW
- IX6 X4-X6 60*
- SA5 STOREA0 RESTORE A0
- SA0 X5
- EQ LXBITS
- END
-#ifdef CERNLIB_XSCOPE_LXBITS
-#undef CERNLIB_XSCOPE_LXBITS
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/xscope3/ixlong.F b/src/packlib/kernlib/kerngen/obsolete/kerncdc/xscope3/ixlong.F
deleted file mode 100644
index e4670a0..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/xscope3/ixlong.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: ixlong.F,v 1.1.1.1 1996/02/15 17:51:17 mclareni Exp $
-*
-* $Log: ixlong.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:17 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- FUNCTION IXLONG (LUN)
-
-C CERN PROGLIB# Z200 IXLONG .VERSION KERNCDC 1.11 800801
-
- LC = IXPTRZL (LUN)
- LC2 = IXRLZL (LUN)
-
-C IXPTRZL MAY RETURN LENGTH TOO LONG FOR RT=S
-C IXRLZL RETURNS FULL RECORD LENGTH FOR RT=W
-C** THEREFOR TAKE THE MINIMUM OF THE TWO
-
- LC = MIN0 (LC,LC2)
- LCW =(LC+9) / 10
- IXLONG = LCW
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/xscope3/ixptr.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/xscope3/ixptr.s
deleted file mode 100644
index ca9cce6..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/xscope3/ixptr.s
+++ /dev/null
@@ -1,30 +0,0 @@
-*
-* $Id: ixptr.s,v 1.1.1.1 1996/02/15 17:51:17 mclareni Exp $
-*
-* $Log: ixptr.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:17 mclareni
-* Kernlib
-*
-*
- IDENT IXPTRZL
-*
-* CERN PROGLIB# Z200 IXPTR .VERSION KERNCDC 1.16 820129
-*
- ENTRY IXPTRZL
-*
-* FUNCTION IXPTRZL (LUN)
-*
- TRACE. VFD 42/0HIXPTRZL,18/IXPTRZL
- TEMPA0 BSS 1
- IXPTRZL EQ *+1BS17
- MX6 1
- BX1 X1+X6
-+RJ=XGETFIT
-- VFD 30/TRACE.
- SX6 A0
- SA6 TEMPA0
- FETCH X1,PTL,X6
- SA1 TEMPA0
- SA0 X1
- EQ IXPTRZL
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/xscope3/ixrl.s b/src/packlib/kernlib/kerngen/obsolete/kerncdc/xscope3/ixrl.s
deleted file mode 100644
index 1b8e0bd..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/xscope3/ixrl.s
+++ /dev/null
@@ -1,30 +0,0 @@
-*
-* $Id: ixrl.s,v 1.1.1.1 1996/02/15 17:51:17 mclareni Exp $
-*
-* $Log: ixrl.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:17 mclareni
-* Kernlib
-*
-*
- IDENT IXRLZL
-*
-* CERN PROGLIB# Z200 IXRL .VERSION KERNCDC 1.16 820129
-*
- ENTRY IXRLZL
-*
-* FUNCTION IXRLZL (LUN)
-*
- TEMPA0 BSS 1
- TRACE. VFD 36/0HIXRLZL,24/IXRLZL
- IXRLZL EQ *+1BS17
- MX6 1
- BX1 X1+X6
- + RJ =XGETFIT.
- - VFD 30/TRACE.
- SX6 A0
- SA6 TEMPA0
- FETCH X1,RL,X6
- SA1 TEMPA0
- SA0 X1
- EQ IXRLZL
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/xvectcdc/xinb.F b/src/packlib/kernlib/kerngen/obsolete/kerncdc/xvectcdc/xinb.F
deleted file mode 100644
index e18c51d..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/xvectcdc/xinb.F
+++ /dev/null
@@ -1,30 +0,0 @@
-*
-* $Id: xinb.F,v 1.1.1.1 1996/02/15 17:51:16 mclareni Exp $
-*
-* $Log: xinb.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:16 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE XINB (LUN,XBV,NXB)
-
-C CERN PROGLIB# Z203 XINB .VERSION KERNCDC 2.02 820818
-
- DIMENSION XBV(NXB)
- LOGICAL XEOF, XRDIN
-
- READ (LUN) N,XBV
- IF (XEOF (LUN)) GO TO 61
- IF (XRDIN(LUN)) GO TO 64
- N = MIN0 (N,NXB)
- NXB = MAX0 (N,1)
- RETURN
-
- 61 NXB = 0
- RETURN
-
- 64 NXB = -7
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/xvectcdc/xinbf.F b/src/packlib/kernlib/kerngen/obsolete/kerncdc/xvectcdc/xinbf.F
deleted file mode 100644
index 5436f30..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/xvectcdc/xinbf.F
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: xinbf.F,v 1.1.1.1 1996/02/15 17:51:16 mclareni Exp $
-*
-* $Log: xinbf.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:16 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE XINBF (LUN,XBV,NXB)
-
-C CERN PROGLIB# Z203 XINBF .VERSION KERNCDC 1.07 781218
-
- DIMENSION XBV(NXB)
- LOGICAL XEOF, XRDIN
-
- READ (LUN) XBV
- IF (XEOF (LUN)) GO TO 61
- IF (XRDIN(LUN)) GO TO 64
- N = IXLONG (LUN)
- N = MIN0 (N,NXB)
- NXB = MAX0 (N,1)
- RETURN
-
- 61 NXB = 0
- RETURN
-
- 64 NXB = -7
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/xvectcdc/xinbs.F b/src/packlib/kernlib/kerngen/obsolete/kerncdc/xvectcdc/xinbs.F
deleted file mode 100644
index 7717eb1..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/xvectcdc/xinbs.F
+++ /dev/null
@@ -1,30 +0,0 @@
-*
-* $Id: xinbs.F,v 1.1.1.1 1996/02/15 17:51:16 mclareni Exp $
-*
-* $Log: xinbs.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:16 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE XINBS (LUN,XAV,NA,XBV,NXB)
-
-C CERN PROGLIB# Z203 XINBS .VERSION KERNCDC 2.02 820818
-
- DIMENSION XBV(NXB), XAV(NA)
- LOGICAL XEOF, XRDIN
-
- READ (LUN) N,XAV,XBV
- IF (XEOF (LUN)) GO TO 61
- IF (XRDIN(LUN)) GO TO 64
- N = MIN0 (N,NXB)
- NXB = MAX0 (N,1)
- RETURN
-
- 61 NXB = 0
- RETURN
-
- 64 NXB = -7
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncdc/xvectcdc/xincf.F b/src/packlib/kernlib/kerngen/obsolete/kerncdc/xvectcdc/xincf.F
deleted file mode 100644
index 04fabc7..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncdc/xvectcdc/xincf.F
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: xincf.F,v 1.1.1.1 1996/02/15 17:51:16 mclareni Exp $
-*
-* $Log: xincf.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:16 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE XINCF (LUN,XBV,NXB)
-
-C CERN PROGLIB# Z203 XINCF .VERSION KERNCDC 1.13 820111
-
- DIMENSION XBV(NXB)
- LOGICAL XEOF, XRDIN
-
- READ (LUN,8000) XBV
- IF (XEOF (LUN)) GO TO 61
- IF (XRDIN(LUN)) GO TO 64
- N = IXLONG (LUN)
- N = MIN0 (N,NXB)
- NXB = MAX0 (N,1)
- RETURN
-
- 61 NXB = 0
- RETURN
-
- 64 NXB = -7
- RETURN
-
- 8000 FORMAT (14A10)
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncms/fcasplit/fcasplit.F b/src/packlib/kernlib/kerngen/obsolete/kerncms/fcasplit/fcasplit.F
deleted file mode 100644
index 20c7c7d..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncms/fcasplit/fcasplit.F
+++ /dev/null
@@ -1,628 +0,0 @@
-*
-* $Id: fcasplit.F,v 1.1.1.1 1996/02/15 17:52:00 mclareni Exp $
-*
-* $Log: fcasplit.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:00 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- PROGRAM FCASPLIT
-
-C CERN PROGLIB# FCASPLIT .VERSION KERNFOR 4.32 920229
-C ORIG. 01/10/88 JZ
-
- PARAMETER (NARADD = 0)
- CHARACTER CHIDF*8, CHIDC*8, CHIDA*8, CHIDD*4
- CHARACTER CHIDX*7, CHIDY*6, CHOVER*(*)
- CHARACTER CHPOF*(*), CHPOC*(*), CHPOA*(*)
- CHARACTER CHEXFOR*(*), CHEXCC*(*), CHEXAS*(*)
- CHARACTER CHWHF*(*), CHWHC*(*), CHWHA*(*)
- CHARACTER CHEXOBJ*(*)
-
- PARAMETER (CHIDF = 'CDECK I' )
- PARAMETER (CHIDC = '/*DECK I' )
- PARAMETER (CHIDX = 'DECK I' )
- PARAMETER (CHIDY = 'DECK I' )
- PARAMETER (CHIDD = 'D>, ' )
-
- PARAMETER (CHIDA = '|DECK I' )
- PARAMETER (CHOVER= 'UNKNOWN')
-
- PARAMETER (CHPOF = '( OPT(2)')
- PARAMETER (CHPOC = '( ALIAS($*) ')
- PARAMETER (CHPOA = ' ')
-
- PARAMETER (CHEXFOR = '.fortran ')
- PARAMETER (CHEXCC = '.c ')
- PARAMETER (CHEXAS = '.assemble ')
- PARAMETER (CHEXOBJ = ' TEXT ')
-
- PARAMETER (CHWHF = 'FORTVS2 ')
- PARAMETER (CHWHC = 'EXEC CC ')
- PARAMETER (CHWHA = 'HASM ')
-
- PARAMETER (MLMKLN=100)
- PARAMETER (MXLENG=128, MXMKLN=64)
- CHARACTER CHHOLD*(MXLENG)
- CHARACTER CHOPT(7)*(MXLENG)
- DIMENSION NCHOPT(7)
- EQUIVALENCE (NOPF,NCHOPT(1))
- EQUIVALENCE (NOPC,NCHOPT(2))
- EQUIVALENCE (NOPA,NCHOPT(3))
-
- CHARACTER CHCMP(3)*(MXLENG)
- DIMENSION NCHCMP(3)
- EQUIVALENCE (CHCMP(1),CHOPT(4)), (NCHCMP(1),NCHOPT(4))
- EQUIVALENCE (NNF,NCHCMP(1))
- EQUIVALENCE (NNC,NCHCMP(2))
- EQUIVALENCE (NNA,NCHCMP(3))
-
- CHARACTER CHFIN*(MXLENG)
- EQUIVALENCE (CHFIN,CHOPT(7)), (NCHFIN,NCHOPT(7))
-
- CHARACTER CHFSH*(MXLENG), CHFMK*(MXLENG)
- CHARACTER CHMKLN*(MXMKLN+4)
-
- PARAMETER (MXCBUF=100)
- DIMENSION LXCBUF(MXCBUF)
- CHARACTER*80 CHCBUF(MXCBUF)
-
- CHARACTER CHLINE*80, CHNAME*80, CHTEXT*511
- CHARACTER CHUSE*1
- CHARACTER*21 UXTOVM,FILNAM
- CHARACTER*2 OFM
- LOGICAL LEXIST
-
- PARAMETER (NKEYS=11)
- CHARACTER CHKEYS(NKEYS)*4
- DATA CHKEYS / '-noh', '-log'
- +, '-fo ', '-co ', '-ao '
- +, '-f ', '-c ', '-a '
- +, '+fo ', '+co ', '+ao ' /
-
-
- PRINT 9001
- 9001 FORMAT (' FCASPLIT executing.')
-
-
- 9002 FORMAT (
- F ' FCASPLIT [-f nmft] [-c nmcc] [-a nmas] [-noh] [-log]'
- F/' [+fo incf] [+co incc] [+ao incs]'
- F/' [-fo optf] [-co optc] [-ao opts]'
- F/' f.e [fca_n] [optf [optc [opts]]]'/
- F/' splits file f.e having a mixture of Fortran / C / assembler'
- F/' routines into separate files n.f or n.c or n.s, "n" being the'
- F/' name of each routine, creating at the same time a Shell script'
- F/' y.shfca and a Make file y.mkfca either of which can be used'
- F/' to compile all routines individually.'/
- F/' Defaults are defined in fcasplit for the names by which the'
- F/' compilers are called; with the -f, -c, -a options they could'
- F/' be changed.'/
- F/' Defaults are also defined for the options with which they are'
- F/' called; with the -fo, -co, -ao options they can be re-defined;'
- F/' with the +fo, +co, +ao options they can be incremented.'/
- F/' To be backward compatible the options can also be specified by'
- F/' the positional parameters after the file-name.')
- 9003 FORMAT (1X
- F/' If the -noh option is given (or if the first parameter after'
- F/' the file-name is "fca_n") the identifying header line of each'
- F/' routine is not written out. If the -log option is given'
- F/' the name of each routine is printed on standard output.')
- 9004 FORMAT (1X
- F/' Each routine must start with an identifying line :'
- F/' "', A, 'D>, " in cols. 1-12 for Fortran'
- F/' "', A, 'D>, " in cols. 1-12 for C'
- F/' "', A, 'D>, " in cols. 1-12 for assembler'
- F/' "DECK ID>, " in cols. 2-12 or'
- F/' "DECK ID>, " in cols. 3-12 for anything else'
- F/' "name" in cols. 13-40 gives the name'/
- F/' In the last two cases, or if "name" contains an'
- F/' extension, the file created will be "name"'
- F/' without extension .f, .c or .s added to it'
- F/' and without an entry into the script.'/
- F/' A trailing blank terminates the name,'
- F/' symbol . followed by blank also terminates,'
- F/' symbols ; < # ! all terminate,'
- F/' symbol */ also terminates.'
- F/1X)
-
-C------ Acquire the parameters
-
- NARGS = IARGC() + NARADD
-
- CHOPT(1) = CHPOF
- CHOPT(2) = CHPOC
- CHOPT(3) = CHPOA
-
- CHCMP(1) = CHWHF
- CHCMP(2) = CHWHC
- CHCMP(3) = CHWHA
- CHFIN = 'f.e'
-
- IFINFI = 0
- IFLNH = 0
- IFLLOG = 0
-
-C-- Get the keyed options, until the input file name
-
- OFM ='A'
- JARG = 0
- 11 JOPT = 0
- 12 IF (JARG.GE.NARGS) GO TO 21
- JARG = JARG + 1
- CALL GETARG (JARG, CHHOLD)
-
- IF(CHHOLD(1:5).EQ.'-mode') THEN
- JARG=JARG+1
- CALL GETARG(JARG,OFM)
- GOTO 11
- ENDIF
- IF (JOPT.EQ.0) GO TO 13
-
-C---- Store option values read
-
-C-- positional trailing options
- IF (JOPT.LT.0) THEN
- IF (JOPT.EQ.-1) THEN
- IF (CHHOLD(1:5).EQ.'fca_n') THEN
- IFLNH = 7
- GO TO 12
- ENDIF
- ENDIF
- CHOPT(-JOPT) = CHHOLD
- JOPT = JOPT - 1
- GO TO 12
- ENDIF
-
-C-- keyed options
- IF (JOPT.LE.6) THEN
- CHOPT(JOPT) = CHHOLD
- IF(CHHOLD(1:1).NE.'('.AND.JOPT.LE.3)
- + CHOPT(JOPT) = '('//CHHOLD
- ELSE
- IPAR=1
- IF (CHHOLD(1:1).EQ.'(') IPAR=2
- IF (JOPT.EQ.7) CHOPT(1) = CHPOF // ' ' // CHHOLD(IPAR:)
- IF (JOPT.EQ.8) CHOPT(2) = CHPOC // ' ' // CHHOLD(IPAR:)
- IF (JOPT.EQ.9) CHOPT(3) = CHPOA // ' ' // CHHOLD(IPAR:)
- ENDIF
- GO TO 11
-
-C---- Analyse key, if any
-
-C- -noh -log -fo -co -ao -f -c -a +fo +co +ao
-C- 1 2 3 4 5 6 7 8 9 10 11
-C- 1 2 3 4 5 6 7 8 9
-
- 13 DO 14 JKEY=1,NKEYS
- IF (CHHOLD(1:4).EQ.CHKEYS(JKEY)) THEN
- IF (JKEY.EQ.1) THEN
- IFLNH = 7
- GO TO 11
- ENDIF
- IF (JKEY.EQ.2) THEN
- IFLLOG = 7
- GO TO 11
- ENDIF
- JOPT = JKEY - 2
- GO TO 12
- ENDIF
- 14 CONTINUE
-
-C---- File-name read
-
- CHFIN = CHHOLD
- IFINFI = 7
-
-C---- Get the positional options if given
-
- JOPT = -1
- GO TO 12
-
-C------ Parameters have all been read
-
-C-- Length of the option strings = true length + 2 (blanks)
-
- 21 DO 24 JJ=1,7
- DO 23 J=MXLENG,1,-1
- IF (CHOPT(JJ)(J:J).NE.' ') GO TO 24
- 23 CONTINUE
- J = 0
- 24 NCHOPT(JJ) = J + 2
- NCHFIN = NCHFIN - 2
-
-C-- Derive the name of the script yyy.shfca
-C- from the input file, say dir/yyy.ext
-
- N = NCHFIN
- JA = 1
- JE = N
- J = N
- 26 IF (CHFIN(J:J).EQ.'/') THEN
- JA = J + 1
- GO TO 27
- ELSEIF (CHFIN(J:J).EQ.'.') THEN
- IF (JE.EQ.N) JE = J - 1
- ENDIF
- J = J - 1
- IF (J.NE.0) GO TO 26
- 27 CONTINUE
-C--- Remove filetype if CHFIN=fn.ft.fm
- IDOT=INDEX(CHFIN(JA:JE),'.')
- IF(IDOT.GT.0) JE=IDOT-1
- CHFSH = 'sh'//CHFIN(JA:JE) // '.exec'
- CHFMK = 'mk'//CHFIN(JA:JE) // '.exec'
- NCHFSH = JE+8 - JA
-
- IF (IFINFI.EQ.0) THEN
- PRINT 9002
- PRINT 9003
- PRINT 9004, CHIDF, CHIDC, CHIDA
- ENDIF
-
- PRINT 9026, CHFIN(1:NCHFIN), CHFSH(1:NCHFSH), CHFMK(1:NCHFSH)
- PRINT 9027, CHCMP(1)(1:NNF),CHOPT(1)(1:NOPF)
- PRINT 9028, CHCMP(2)(1:NNC),CHOPT(2)(1:NOPC)
- PRINT 9029, CHCMP(3)(1:NNA),CHOPT(3)(1:NOPA)
- 9026 FORMAT (5X,' Input file : ',A/
- F 5X,' Shell script : ',A/
- F 5X,' Make file : ',A)
- 9027 FORMAT (5X,' Fortran name : ',A/
- F 5X,' Fortran options : ',A)
- 9028 FORMAT (5X,' CC name : ',A/
- F 5X,' CC options : ',A)
- 9029 FORMAT (5X,' Assembler name : ',A/
- F 5X,' Assembler options : ',A)
-
-C---- Stop if no file-name, help information printed
-
- IF (IFINFI.EQ.0) THEN
- PRINT 9030
- STOP
- ENDIF
-
- 9030 FORMAT (' !!! No file-name given, no execution !!!')
-
-C------------ Process the input file ------------------
-
- FILNAM=UXTOVM(CHFIN(1:NCHFIN))
- LF=LENOCC(FILNAM)
- INQUIRE(FILE=FILNAM(1:LF),EXIST=LEXIST)
- IF (.NOT.LEXIST) THEN
- PRINT 9031,FILNAM(1:LF)
- STOP
- ENDIF
-
- 9031 FORMAT (' fcasplit: input file ',A,' not found ')
-
-C-- Open input and .shfca file
- OPEN (11, FILE=FILNAM(1:LF),STATUS='OLD',ACTION='READ',
- + FORM='UNFORMATTED')
- FILNAM=UXTOVM(CHFSH(1:NCHFSH)//'.'//OFM)
- LF=LENOCC(FILNAM)
- CALL FILEINF(I,'RECFM','U')
- OPEN (21, FILE=FILNAM(1:LF),STATUS=CHOVER)
- FILNAM=UXTOVM(CHFMK(1:NCHFSH)//'.'//OFM)
- LF=LENOCC(FILNAM)
- CALL FILEINF(I,'RECFM','U')
- OPEN (22, FILE=FILNAM(1:LF),STATUS=CHOVER)
- REWIND 11
- REWIND 21
- REWIND 22
- WRITE(21,*) '/* Compilation exec */'
- WRITE(21,*) ' Address Command'
-C WRITE(21,*) ' Trace C'
- WRITE(21,*) ' cc=0'
-
- CHMKLN = 'ROUTINES = '
- NXMKLN = 11
-
- NTEXT = -12
- NIGNOR = 0
- NROUT = 0
- NLINES = 0
- NTCBUF = 0
- NXCBUF = 0
-
- NLMKLN = 0
- NPCSMK = 0
-
- CALL CLTOU(CHFIN(JA:JE))
-C------- Read next line -------------------------
-
- 31 CONTINUE
- READ (11,NUM=N,END=81) CHLINE
-C N = LEN(CHLINE)
-
- DO 33 NCHLN=N,2,-1
- IF (CHLINE(NCHLN:NCHLN).NE.' ') GO TO 34
- 33 CONTINUE
- NCHLN = 1
-
- 34 IF (NCHLN.GE.13) THEN
- IF (CHLINE(9:12).EQ.CHIDD) GO TO 59
- ENDIF
- 35 IF (NTEXT.LT.0) GO TO 58
- 36 IF (JTYPE.NE.1) GO TO 41
-
-C-- Check new line is a Fortran comment line
-
- IF (CHLINE(1:1).EQ.'C') GO TO 38
- IF (CHLINE(1:1).EQ.'c') GO TO 38
- IF (CHLINE(1:1).EQ.'*') GO TO 38
- IF (NCHLN.NE.1) GO TO 41
- IF (CHLINE(1:1).NE.' ') GO TO 41
-
- 38 IF (NXCBUF.EQ.MXCBUF) GO TO 41
- NXCBUF = NXCBUF + 1
- CHCBUF(NXCBUF)(1:NCHLN) = CHLINE(1:NCHLN)
- LXCBUF(NXCBUF) = NCHLN
- GO TO 31
-
-C------- Write next line -------------------------
-
-C-- NTEXT = <0 idle unheaded lines (not coming here)
-C- 0 normal running
-C- >0 about to write the first line of new routine
-C- if =1 : no entry to script and make file
-
-C- start a new routine only when the first true line is ready
-
- 41 IF (NTEXT.EQ.0) GO TO 46
- IF (NTEXT.EQ.1) GO TO 44
-
-C-- compilation command for this routine to the shell script
-
-C-- Substitute $* by filename in command line
- INM=INDEX(CHTEXT(1:NTEXT),'$*')
- IF(INM.GT.0) THEN
-C CALL UCOPY2(CHTEXT(INM+2:),CHTEXT(INM+NPUT:),NTEXT-INM-1)
- DO 42 N=NTEXT+NPUT-2,INM+NPUT,-1
- CHTEXT(N:N)=CHTEXT(N-NPUT+2:N-NPUT+2)
- 42 CONTINUE
- CHTEXT(INM:INM+NPUT-1)=CHNAME(1:NPUT)
- NTEXT=NTEXT+NPUT-2
- ENDIF
-
- WRITE (21,8000) 'cmd="'//CHTEXT(1:NTEXT)//'"'
- WRITE (21,8000) 'Say " "cmd ; cmd ; If rc>cc Then cc=rc'
- WRITE (21,8000) 'If rc=0 Then Do'
- WRITE (21,8000) ' tfile="'//CHNAME(1:NPUT)//' TEXT A"'
- WRITE (21,8000)
- + '"COPY" tfile "'//CHFIN(JA:JE)//' = = (APP" ;'
- + //'"ERASE" tfile'
- WRITE (21,8000) 'End'
-
-C-- register the routine name for the Make file
-
- CHTEXT = CHNAME(1:NPUT) // CHEXOBJ // ' '
- NTEXT = NPUT + LEN(CHEXOBJ) + 1
- IF (NXMKLN+NTEXT.GT.MXMKLN) THEN
- NLMKLN = NLMKLN + 1
- IF (NLMKLN.LT.MLMKLN) THEN
- NXMKLN = NXMKLN + 1
- CHMKLN(NXMKLN:NXMKLN) = CHAR(92)
- WRITE (22,8000) CHMKLN(1:NXMKLN)
- NXMKLN = 0
- ELSE
- WRITE (22,8000) CHMKLN(1:NXMKLN)
- NXMKLN = 0
- NLMKLN = 0
- WRITE (22,9042)
- NPCSMK = NPCSMK + 1
- WRITE (CHMKLN,9043) NPCSMK
- NXMKLN = 11
- ENDIF
- ENDIF
-
- 9042 FORMAT('#')
- 9043 FORMAT('ROUTINE',I1,' = ')
-
- CHMKLN(NXMKLN+1:NXMKLN+NTEXT) = CHTEXT(1:NTEXT)
- NXMKLN = NXMKLN + NTEXT
-
-C-- Open the output file if first line ready
- 44 CONTINUE
- IF(INDEX(CHNAME(1:NCUM),'.assemble').EQ.0)
- + CALL FILEINF(I,'RECFM','U')
- OPEN (27, FILE=UXTOVM(CHNAME(1:NCUM)//'.'//OFM),STATUS=CHOVER)
- REWIND 27
-
- NTEXT = 0
- NROUT = NROUT + 1
- IF (IFLLOG.NE.0) PRINT 9044, NROUT,CHNAME(1:NCUM)
- 9044 FORMAT (' make',I4,1X,A)
-
-C-- Transfer the comment lines from the buffer
-
- 46 IF (NXCBUF.EQ.0) GO TO 48
- DO 47 J=1,NXCBUF
- WRITE (27,8000) CHCBUF(J)(1:LXCBUF(J))
- 47 CONTINUE
- NLINES = NLINES + NXCBUF
- NXCBUF = 0
-
-C-- Transfer the current line
-
- 48 WRITE (27,8000) CHLINE(1:NCHLN)
- NLINES = NLINES + 1
- GO TO 31
-
-C-- Ignore leading unheaded lines
-
- 58 NIGNOR = NIGNOR + 1
- IF (NTEXT.EQ.-1) GO TO 31
- PRINT 9058, CHLINE(1:NCHLN)
- NTEXT = NTEXT + 1
- IF (NTEXT.NE.-1) GO TO 31
- PRINT 9059
- GO TO 31
- 9058 FORMAT (' ignored: ',A)
- 9059 FORMAT (10X,'...')
-
-C------- Start new routine ? -------------------------
-
- 59 JTYNX = 0
- IF (CHLINE(1:8).EQ.CHIDF) GO TO 61
- IF (CHLINE(1:8).EQ.CHIDC) GO TO 62
- IF (CHLINE(1:8).EQ.CHIDA) GO TO 63
- IF (CHLINE(2:8).EQ.CHIDX) GO TO 60
- IF (CHLINE(3:8).EQ.CHIDY) GO TO 60
- GO TO 35
-
-C-- Yes, start new routine
-
- 63 JTYNX = 1
- 62 JTYNX = JTYNX + 1
- 61 JTYNX = JTYNX + 1
- 60 JPUT = 0
- JDOT = 0
- JDOP = 0
- NUS = MIN(NCHLN,40)
-
-C-- skip leading blanks before the name
-
- JGO = 13
- 65 IF (CHLINE(JGO:JGO).EQ.' ') THEN
- JGO = JGO + 1
- GO TO 65
- ENDIF
-
- IF (JGO.GT.NUS) GO TO 35
-
-C-- Convert name to lower case and find termination
-
- DO 66 JTK=JGO,NUS
- CHUSE = CHLINE(JTK:JTK)
- JV = ICHAR(CHUSE)
- IF (CHUSE.EQ.' ') GO TO 67
- IF (CHUSE.EQ.'.') THEN
- IF (CHLINE(JTK+1:JTK+1).EQ.' ') GO TO 67
- JDOP = JDOT
- JDOT = JPUT+1
- ENDIF
- IF (CHUSE.EQ.';') GO TO 67
- IF (CHUSE.EQ.'<') GO TO 67
- IF (CHUSE.EQ.'#') GO TO 67
- IF (CHUSE.EQ.'!') GO TO 67
- IF (CHUSE.EQ.'*') THEN
- IF (CHLINE(JTK+1:JTK+1).EQ.'/') GO TO 67
- ENDIF
-C IF (JV.LT.91) THEN
-C IF (JV.GE.65) CHUSE = CHAR(JV+32)
-C ENDIF
- JPUT = JPUT + 1
- CHNAME(JPUT:JPUT) = CHUSE
- 66 CONTINUE
-
-C-- Handle explicit extension
-
- 67 JTYPE = JTYNX
- IF (JDOT.EQ.JPUT) THEN
- JDOT = JDOP
- JPUT = JPUT - 1
- ENDIF
-
- NTEXT = 1
- NPUT = JPUT
- NCUM = NPUT
- IF (JDOT.NE.0) JTYPE = -JTYPE
-
-C---- Handle normal case with standard extensions
-
- IF (JTYPE.LE.0) GO TO 80
-
-C-- Fortran
-
- IF (JTYPE.NE.1) GO TO 74
- N = LEN(CHEXFOR)
- CHNAME(NPUT+1:NPUT+N) = CHEXFOR
- NCUM = NPUT + N
- CHTEXT = CHCMP(1)(1:NNF)//CHNAME(1:NPUT)//' '//CHOPT(1)(1:NOPF)
- NTEXT = NNF + NOPF + NPUT+1
- GO TO 80
-
-C-- CC
-
- 74 IF (JTYPE.NE.2) GO TO 77
- N = LEN(CHEXCC)
- CHNAME(NPUT+1:NPUT+N) = CHEXCC
- NCUM = NPUT + N
- CHTEXT = CHCMP(2)(1:NNC)//CHNAME(1:NPUT)//' '//CHOPT(2)(1:NOPC)
- NTEXT = NNC + NOPC + NPUT+1
- GO TO 80
-
-C-- Assembler
-
- 77 IF (JTYPE.NE.3) GO TO 80
- N = LEN(CHEXAS)
- CHNAME(NPUT+1:NPUT+N) = CHEXAS
- NCUM = NPUT + N
- CHTEXT = CHCMP(3)(1:NNA)//CHNAME(1:NPUT)//' '//CHOPT(3)(1:NOPA)
- NTEXT = NNA + NOPA + NPUT+1
-
- 80 CLOSE (27)
- NTCBUF = NTCBUF + NXCBUF
- NXCBUF = 0
- IF (JTYPE.LT.1) GO TO 31
- IF (IFLNH.NE.0) GO TO 31
- GO TO 36
-
-C------- Done -------------------------
-
-C---- Complete the Make file
-
- 81 WRITE (22,8000) CHMKLN(1:NXMKLN-1)
-
-C-- Fortran inference
-
- CHNAME = CHEXFOR // CHEXOBJ // ':'
- NPUT = LEN(CHEXFOR) + LEN(CHEXOBJ) + 1
- CHTEXT = CHAR(9) // CHCMP(1)(1:NNF) // CHOPT(1)(1:NOPF) //
- + '$*' // CHEXFOR
- NTEXT = 3 + NNF + NOPF + LEN(CHEXFOR)
- WRITE (22,9083) CHNAME(1:NPUT), CHTEXT(1:NTEXT)
-
-C-- CC inference
-
- CHNAME = CHEXCC // CHEXOBJ // ':'
- NPUT = LEN(CHEXCC) + LEN(CHEXOBJ) + 1
- CHTEXT = CHAR(9) // CHCMP(2)(1:NNC) // CHOPT(2)(1:NOPC) //
- + '$*' // CHEXCC
- NTEXT = 3 + NNC + NOPC + LEN(CHEXCC)
- WRITE (22,9083) CHNAME(1:NPUT), CHTEXT(1:NTEXT)
-
-C-- Assembler inference
-
- CHNAME = CHEXAS // CHEXOBJ // ':'
- NPUT = LEN(CHEXAS) + LEN(CHEXOBJ) + 1
- CHTEXT = CHAR(9) // CHCMP(3)(1:NNA) // CHOPT(3)(1:NOPA) //
- + '-o $*.o $*' // CHEXAS
- NTEXT = 12 + NNA + NOPA + LEN(CHEXAS)
- WRITE (22,9083) CHNAME(1:NPUT), CHTEXT(1:NTEXT)
-
- IF (NPCSMK.EQ.0) THEN
- WRITE (22,9084) CHFIN(JA:JE)
- ELSE
- WRITE (22,9085) CHFIN(JA:JE),(I,I=1,NPCSMK)
- WRITE (22,9086) (I,I,I=1,NPCSMK)
- ENDIF
-
- WRITE(21,*) ' Exit cc'
-C-- Print summary
-
- PRINT 9087, NLINES,NROUT
- IF (NIGNOR.NE.0) PRINT 9088, NIGNOR
- IF (NTCBUF.NE.0) PRINT 9089, NTCBUF
- 8000 FORMAT (A)
- 9083 FORMAT (/A/A)
- 9084 FORMAT(/A,': $(ROUTINES)',/)
- 9085 FORMAT(/A,':',10(' rout',I1))
- 9086 FORMAT(/,'rout: $(ROUTINES)',/,
- + ('rout',I1,': $(ROUTINE',I1,')',/))
- 9087 FORMAT (1X,I6,' lines written for',I6,' decks')
- 9088 FORMAT (1X,I6,' leading unheaded lines ignored.')
- 9089 FORMAT (1X,I6,' trailing comment lines ignored.')
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncms/history/history.dat b/src/packlib/kernlib/kerngen/obsolete/kerncms/history/history.dat
deleted file mode 100644
index d649346..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncms/history/history.dat
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: history.dat,v 1.1.1.1 1996/02/15 17:51:41 mclareni Exp $
-*
-* $Log: history.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:51:41 mclareni
-* Kernlib
-*
-*
-* This directory was created from kerncms.car patch dkerncms
-KERNCMS 0.00 000000 00.00 CERN KERNLIB for IBM VM/CMS
- Kernel library machine PAM for IBM machines
- containing system interface routines for VM/CMS
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncms/history/inform.dat b/src/packlib/kernlib/kerngen/obsolete/kerncms/history/inform.dat
deleted file mode 100644
index 911443b..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncms/history/inform.dat
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: inform.dat,v 1.1.1.1 1996/02/15 17:51:40 mclareni Exp $
-*
-* $Log: inform.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:51:40 mclareni
-* Kernlib
-*
-*
- System interface routines for IBM with system VM / CMS
- to be put onto the binary KERNLIB library
-
- This file must be used in the concatenation KERNIBM / KERNCMS / KERNFOR
-
-This file contains the following patches :
-
- SYCERNV system routines for system VM at CERN only
- SYVM system routines for system VM
-
-The material of this file uses the following Patchy options :
-
- QMIBMXA system version XA
- QMIBMVF to generate code for the vector facility
- QCMS4 CMS version 4 or earlier
- QCMS6 CMS version 6 and on
- QEXTRACT Flag to replace the HEPVM-EXTRACT macro
-
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncms/history/v100.dat b/src/packlib/kernlib/kerngen/obsolete/kerncms/history/v100.dat
deleted file mode 100644
index 5e1cc46..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncms/history/v100.dat
+++ /dev/null
@@ -1,14 +0,0 @@
-*
-* $Id: v100.dat,v 1.1.1.1 1996/02/15 17:51:41 mclareni Exp $
-*
-* $Log: v100.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:51:41 mclareni
-* Kernlib
-*
-*
-* Version 1.00 890222 22.00
- First release of the KERNCMS Pam : 22-feb-89
-
- obtained by moving the VM/CMS material
- from KERNIBM 2.25 to a separate Pam file
-
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncms/history/v101.dat b/src/packlib/kernlib/kerngen/obsolete/kerncms/history/v101.dat
deleted file mode 100644
index df7ec95..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncms/history/v101.dat
+++ /dev/null
@@ -1,11 +0,0 @@
-*
-* $Id: v101.dat,v 1.1.1.1 1996/02/15 17:51:41 mclareni Exp $
-*
-* $Log: v101.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:51:41 mclareni
-* Kernlib
-*
-*
-* Version 1.01 890224 10.11
-Add: P=SYVM , D=MAXDSK new routine
-
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncms/history/v102.dat b/src/packlib/kernlib/kerngen/obsolete/kerncms/history/v102.dat
deleted file mode 100644
index c311ae2..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncms/history/v102.dat
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: v102.dat,v 1.1.1.1 1996/02/15 17:51:40 mclareni Exp $
-*
-* $Log: v102.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:51:40 mclareni
-* Kernlib
-*
-*
-* Version 1.02 890608 09.32
-Replace: P=SYCERNV, D=JOB$VM Rewritten for public release
- P=SYCERNV, D=JOBNAM Altered for change to JOB$VM
- P=SYCERNV, D=TIMEX Altered for change to JOB$VM
- P=SYVM , D=VMRTRM Change for XA compatibility
- P=SYVM , D=VMSATN Change for XA compatibility
- P=SYVM , D=VMCMS Change for XA compatibility
- P=SYVM , D=VMREXX Extra code for XA capability
- P=SYVM , D=VMBEEP Extra code for XA capability
-
-Add: P=SYVM , D=DATIME VM timer calls
- P=SYVM , D=DATIMH VM timer calls
- P=SYVM , D=IOSPAK2 Screen Handling Routines
- P=SYVM , D=JOB$VM Fortran version for non-HepVM
-
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncms/history/v103.dat b/src/packlib/kernlib/kerngen/obsolete/kerncms/history/v103.dat
deleted file mode 100644
index 0212024..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncms/history/v103.dat
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: v103.dat,v 1.1.1.1 1996/02/15 17:51:40 mclareni Exp $
-*
-* $Log: v103.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:51:40 mclareni
-* Kernlib
-*
-*
-* Version 1.03 891017 13.30
-Correct: P=SYVM , D=VMBEEP Activate +SELF cards related
- to 3 sequences, so they are
- used only in XA.
- P=SYCERNV, D=JOB$VM Clear R15 before SVC 204
- Allow 1digit time limits
-Replace: P=SYVM , D=DATIME Store date, time in /SLATE/
- P=SYVM , D=IOSPAK2 Update IOSRD, IOSWRT
-
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncms/history/v104.dat b/src/packlib/kernlib/kerngen/obsolete/kerncms/history/v104.dat
deleted file mode 100644
index e3af74b..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncms/history/v104.dat
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: v104.dat,v 1.1.1.1 1996/02/15 17:51:40 mclareni Exp $
-*
-* $Log: v104.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:51:40 mclareni
-* Kernlib
-*
-*
-* Version 1.04 900924 16.02
-Add: P=SYVM , D=VMSTAK Push information into the stack
- P=SYVM , D=VMQFIL emulation of QUERY FILE
- P=SYVM , D=VMRTNE Read Terminal (Non-Echoed)
- for CMS 5 onwards
-Replace: P=SYVM , D=TIMEX New check for BATCH JOBSTOP
- forced timeout
-Correct: P=SYVM , D=DATIME Fix storing of seconds
- P=SYVM , D=IOSPAK2 Fix hex 02 in header
- P=SYCERNV, D=JOB$VM Skip EXTRACT code via QEXTRACT
-
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncms/history/v105.dat b/src/packlib/kernlib/kerngen/obsolete/kerncms/history/v105.dat
deleted file mode 100644
index a2c60ff..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncms/history/v105.dat
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: v105.dat,v 1.1.1.1 1996/02/15 17:51:40 mclareni Exp $
-*
-* $Log: v105.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:51:40 mclareni
-* Kernlib
-*
-*
-* Version 1.05 910320 8.20
-Add: P=SYVM , D=GETARG Emulation of the Unix function
- P=SYVM , D=IARGC emulation of the Unix function
- P=SYVM , D=SYSTEMF emulation of the Unix function
- P=SYVM , D=SLEEPF emulation of the Unix function
- P=SYVM , D=VMBRK Interactive BREAK from FORTRAN
-
-Correct: P=SYVM , D=VMSTAK Make it CMS4-compatible
- P=SYVM , D=VMRTNE Make it CMS4-compatible
-
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncms/history/v106.dat b/src/packlib/kernlib/kerngen/obsolete/kerncms/history/v106.dat
deleted file mode 100644
index 0843869..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncms/history/v106.dat
+++ /dev/null
@@ -1,39 +0,0 @@
-*
-* $Id: v106.dat,v 1.1.1.1 1996/02/15 17:51:40 mclareni Exp $
-*
-* $Log: v106.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:51:40 mclareni
-* Kernlib
-*
-*
-* Version 1.06 910901 16.25
-Revise: Structure of pam file to match CPL codes
- Create one patch per CPL entry
-
-Add: P=Z100 , D=JOBNAM General version using JOBINFO
- P=Z265 , D=SETENV Set environment variable (exec)
- P=Z265 , D=GETENVF Get environment variable
- P=Z313 , D=JOBINFO Extraction of Job parameters
- (usable at non-HEPVM sites)
- P=Z305 , D=VMREXX, IF=QCMS6.
- This version uses SVC 204
- and APPLMSG, it does NOT move
- parms in memory (to below 16MB)
- This version of VMREXX works in
- CMS 7 too since REXX is 31bit.
-
-Correct: P=Z264 , D=GETARG Initialize GOPARM string
- Set IP2 for last argument
- P=Z264 , D=IARGC Fix case when nargs=0
- P=Z305 , D=VMREXX Fix bugs for code 'N'.
- P=Z307 , D=JOB$VM Correct CPU factor in interac-
- tive jobs at CERNVM
- Fix storage and node determina-
- tion in non-XA systems
-
-Replace: P=Z262 , D=GOPARM Find parm string from R0 at
- entry, not NUCPLIST entry.
- Ensure no parms returned after
- LOAD command.
-
-
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncms/history/v107.dat b/src/packlib/kernlib/kerngen/obsolete/kerncms/history/v107.dat
deleted file mode 100644
index 35dd1c7..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncms/history/v107.dat
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: v107.dat,v 1.1.1.1 1996/02/15 17:51:40 mclareni Exp $
-*
-* $Log: v107.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:51:40 mclareni
-* Kernlib
-*
-*
-* Version 1.07 920307 15.30
-Change: P=Z007 , D=TIMEL Add QMNOGVAR flag which removes
- obsolete call to GVARIABLE to
- check for forced job timeout.
-Change: P=Z036 , D=ABUSER Avoid operation exception caused
- by VS FORTRAN 2.5 test for
- hardware SQRT instruction.
-Change: P=Z265 , D=SETENV Remove leading+trailing quotes
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncms/history/v108.dat b/src/packlib/kernlib/kerngen/obsolete/kerncms/history/v108.dat
deleted file mode 100644
index f33b57f..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncms/history/v108.dat
+++ /dev/null
@@ -1,15 +0,0 @@
-*
-* $Id: v108.dat,v 1.1.1.1 1996/02/15 17:51:40 mclareni Exp $
-*
-* $Log: v108.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:51:40 mclareni
-* Kernlib
-*
-*
-* Version 1.08 930227 1.40
-Correct: P=Z264 , D=GETARG Treat quote-delimited strings
- as single arguments
- P=Z264 , D=IARGC Ditto
-
-Add: P=FCASPLIT New, until placed in KERNFOR
-
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncms/inhibit.list b/src/packlib/kernlib/kerngen/obsolete/kerncms/inhibit.list
deleted file mode 100644
index 96ed217..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncms/inhibit.list
+++ /dev/null
@@ -1,10 +0,0 @@
-tcgen/timed
-tcgen/timel
-tcgen/timex
-tcgen/timest
-tcgen/datime
-tcgen/datimh
-tcgen/intrac
-tcgen/jobnam
-tcgen/jobnam
-tcgen/jobinfo
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncms/kerncms/kerncms.h b/src/packlib/kernlib/kerngen/obsolete/kerncms/kerncms/kerncms.h
deleted file mode 100644
index 3df14fe..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncms/kerncms/kerncms.h
+++ /dev/null
@@ -1,51 +0,0 @@
-*
-* $Id: kerncms.h,v 1.1.1.1 1996/02/15 17:51:43 mclareni Exp $
-*
-* $Log: kerncms.h,v $
-* Revision 1.1.1.1 1996/02/15 17:51:43 mclareni
-* Kernlib
-*
-*
-* This directory was created from kerncms.car patch skerncms
-#ifndef CERNLIB_Z007
-#define CERNLIB_Z007
-#endif
-#ifndef CERNLIB_Z036
-#define CERNLIB_Z036
-#endif
-#ifndef CERNLIB_Z044
-#define CERNLIB_Z044
-#endif
-#ifndef CERNLIB_Z100
-#define CERNLIB_Z100
-#endif
-#ifndef CERNLIB_Z262
-#define CERNLIB_Z262
-#endif
-#ifndef CERNLIB_Z264
-#define CERNLIB_Z264
-#endif
-#ifndef CERNLIB_Z265
-#define CERNLIB_Z265
-#endif
-#ifndef CERNLIB_Z304
-#define CERNLIB_Z304
-#endif
-#ifndef CERNLIB_Z305
-#define CERNLIB_Z305
-#endif
-#ifndef CERNLIB_Z306
-#define CERNLIB_Z306
-#endif
-#ifndef CERNLIB_Z307
-#define CERNLIB_Z307
-#endif
-#ifndef CERNLIB_Z308
-#define CERNLIB_Z308
-#endif
-#ifndef CERNLIB_Z310
-#define CERNLIB_Z310
-#endif
-#ifndef CERNLIB_Z313
-#define CERNLIB_Z313
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncms/kerncms/sycernv.h b/src/packlib/kernlib/kerngen/obsolete/kerncms/kerncms/sycernv.h
deleted file mode 100644
index 65767b8..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncms/kerncms/sycernv.h
+++ /dev/null
@@ -1,15 +0,0 @@
-*
-* $Id: sycernv.h,v 1.1.1.1 1996/02/15 17:51:42 mclareni Exp $
-*
-* $Log: sycernv.h,v $
-* Revision 1.1.1.1 1996/02/15 17:51:42 mclareni
-* Kernlib
-*
-*
-* This directory was created from kerncms.car patch sycernv
-#ifndef CERNLIB_SKERNCMS
-#define CERNLIB_SKERNCMS
-#endif
-#ifndef CERNLIB_CERN
-#define CERNLIB_CERN
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncms/kerncms/syvm.h b/src/packlib/kernlib/kerngen/obsolete/kerncms/kerncms/syvm.h
deleted file mode 100644
index 6a90ce5..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncms/kerncms/syvm.h
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: syvm.h,v 1.1.1.1 1996/02/15 17:51:43 mclareni Exp $
-*
-* $Log: syvm.h,v $
-* Revision 1.1.1.1 1996/02/15 17:51:43 mclareni
-* Kernlib
-*
-*
-* This directory was created from kerncms.car patch syvm
-#ifndef CERNLIB_SKERNCMS
-#define CERNLIB_SKERNCMS
-#endif
-#ifndef CERNLIB_SYVMOS
-#define CERNLIB_SYVMOS
-#endif
-#ifndef CERNLIB_SYOS_DTZ007
-#define CERNLIB_SYOS_DTZ007
-#endif
-#ifndef CERNLIB_SYOS_NOARG
-#define CERNLIB_SYOS_NOARG
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncms/kerncms/z007.h b/src/packlib/kernlib/kerngen/obsolete/kerncms/kerncms/z007.h
deleted file mode 100644
index 2d50ded..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncms/kerncms/z007.h
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: z007.h,v 1.1.1.1 1996/02/15 17:51:44 mclareni Exp $
-*
-* $Log: z007.h,v $
-* Revision 1.1.1.1 1996/02/15 17:51:44 mclareni
-* Kernlib
-*
-*
-* This directory was created from kerncms.car patch z007
-#ifdef CERNLIB_TCGEN_TIMED
-#undef CERNLIB_TCGEN_TIMED
-#endif
-#ifdef CERNLIB_TCGEN_TIMEL
-#undef CERNLIB_TCGEN_TIMEL
-#endif
-#ifdef CERNLIB_TCGEN_TIMEX
-#undef CERNLIB_TCGEN_TIMEX
-#endif
-#ifdef CERNLIB_TCGEN_TIMEST
-#undef CERNLIB_TCGEN_TIMEST
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncms/z007/datime.s b/src/packlib/kernlib/kerngen/obsolete/kerncms/z007/datime.s
deleted file mode 100644
index 4a30d25..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncms/z007/datime.s
+++ /dev/null
@@ -1,107 +0,0 @@
-*
-* $Id: datime.s,v 1.1.1.1 1996/02/15 17:51:47 mclareni Exp $
-*
-* $Log: datime.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:47 mclareni
-* Kernlib
-*
-*
- PRINT NOGEN
-DATIME CSECT
-#if defined(CERNLIB_QMIBMXA)
-DATIME AMODE ANY
-DATIME RMODE ANY
-#endif
-***********************************************************************
-* *
-* CERN Program Library Z007 for VM/CMS *
-* *
-* CALL DATIME(IDAY,ITIME) *
-* *
-* IDAY returned as YYMMDD *
-* ITIME as HHMM *
-* *
-***********************************************************************
-* *
-* Modification Log *
-* *
-* Original: Tony Cass CERN/DD March 1989 *
-* *
-* 1.01: Fill variables in /SLATE/ *
-* Tony Cass CERN/DD October 1989 *
-* *
-***********************************************************************
- USING DATIME,R15
- B SAVEREGS
- DC AL1(7),CL7'DATIME' Name
- DC CL4'1.01' Version.modification
-SAVEREGS STM R14,R12,12(R13)
- LR R4,R13
- CNOP 0,4
- BAL R13,CARRYON
-SAVEAREA DC 18F'0'
- DROP R15
- USING SAVEAREA,R13
-CARRYON ST R13,8(,R4)
- ST R4,R4(,R13)
- XC 8(4,R13),8(R13)
-*
- LM R1,R2,0(R1) Get Arg addresses
- LA R3,DIAGBUFF Point to Diag 0C buffer
- DC X'8333000C' Diagnose x'0C'
-*
- L R5,=A(IYEAR)
- USING IYEAR,R5
-*
- PACK PKTBCD,DIAGBUFF+6(2) Convert year
- CVB R4,PKTBCD
- ST R4,IYEAR
- MH R4,=H'100' YY00
- PACK PKTBCD,DIAGBUFF(2) Convert Month
- CVB R3,PKTBCD
- ST R3,IMONTH
- AR R4,R3
- MH R4,=H'100' YYMM00
- PACK PKTBCD,DIAGBUFF+3(2) Convert date
- CVB R3,PKTBCD
- ST R3,IDATE
- AR R4,R3
- ST R4,0(R1) YYMMDD
-*
- PACK PKTBCD,DIAGBUFF+8(2) Convert Hours
- CVB R4,PKTBCD
- ST R4,IHOUR
- MH R4,=H'100' HH00
- PACK PKTBCD,DIAGBUFF+11(2) Convert Minutes
- CVB R3,PKTBCD
- ST R3,IMINUTE
- AR R4,R3
- ST R4,0(R2) HHMM
- PACK PKTBCD,DIAGBUFF+14(2) Convert Seconds
- CVB R3,PKTBCD
- ST R3,ISECOND Only common for seconds
-*
-RETURN L R13,4(,R13)
- LM R14,R12,12(R13)
- OI 12(R13),X'FF'
- BR R14
-*
- DS 0D
-DIAGBUFF DC 4CL8' '
-PKTBCD DC XL8'00'
-*
- LTORG
-*
-SLATE COM
-IYEAR DS F
-IMONTH DS F
-IDATE DS F
-IHOUR DS F
-IMINUTE DS F
-ISECOND DS F
- DS 34F
- REGEQU
- END
-#ifdef CERNLIB_TCGEN_DATIME
-#undef CERNLIB_TCGEN_DATIME
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncms/z007/datimh.s b/src/packlib/kernlib/kerngen/obsolete/kerncms/z007/datimh.s
deleted file mode 100644
index d2ca88a..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncms/z007/datimh.s
+++ /dev/null
@@ -1,68 +0,0 @@
-*
-* $Id: datimh.s,v 1.1.1.1 1996/02/15 17:51:47 mclareni Exp $
-*
-* $Log: datimh.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:47 mclareni
-* Kernlib
-*
-*
- PRINT NOGEN
-DATIMH CSECT
-#if defined(CERNLIB_QMIBMXA)
-DATIMH AMODE ANY
-DATIMH RMODE ANY
-#endif
-***********************************************************************
-* *
-* CERN Program Library Z007 for VM/CMS *
-* *
-* CHARACTER*8 CDAY,CTIME *
-* CALL DATIMH(IDAY,ITIME) *
-* *
-* CDAY returned as DD/MM/YY *
-* CTIME as HH.MM.SS *
-* *
-***********************************************************************
-* *
-* Modification Log *
-* *
-* Original: Tony Cass CERN/DD March 1989 *
-* *
-***********************************************************************
- USING DATIMH,R15
- B SAVEREGS
- DC AL1(7),CL7'DATIMH' Name
- DC CL4'1.00' Version.modification
-SAVEREGS STM R14,R12,12(R13)
- LR R4,R13
- CNOP 0,4
- BAL R13,CARRYON
-SAVEAREA DC 18F'0'
- DROP R15
- USING SAVEAREA,R13
-CARRYON ST R13,8(,R4)
- ST R4,R4(,R13)
- XC 8(4,R13),8(R13)
-*
- LM R1,R2,0(R1) Get Arg addresses
- LA R3,DIAGBUFF Point to Diag 0C buffer
- DC X'8333000C' Diagnose x'0C'
- MVC 0(3,R1),DIAGBUFF+3 DD section of date
- MVC 3(3,R1),DIAGBUFF MM section of date
- MVC 6(2,R1),DIAGBUFF+6 YY section of date
- MVC 0(8,R2),DIAGBUFF+8 Time with ':' separator
- MVI 2(R2),C'.' Add period
- MVI 5(R2),C'.' ditto
-*
-RETURN L R13,4(,R13)
- LM R14,R12,12(R13)
- OI 12(R13),X'FF'
- BR R14
-*
- DS 0D
-DIAGBUFF DC 4CL8' '
- REGEQU
- END
-#ifdef CERNLIB_TCGEN_DATIMH
-#undef CERNLIB_TCGEN_DATIMH
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncms/z007/timex.F b/src/packlib/kernlib/kerngen/obsolete/kerncms/z007/timex.F
deleted file mode 100644
index 22ab54c..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncms/z007/timex.F
+++ /dev/null
@@ -1,266 +0,0 @@
-*
-* $Id: timex.F,v 1.1.1.1 1996/02/15 17:51:46 mclareni Exp $
-*
-* $Log: timex.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:46 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
-#if !defined(CERNLIB_CERN)
-TIMEX CSECT
-*
-* CERN PROGLIB# Z007 TIMEX .VERSION KERNIBM 2.11 850320
-*
-* TITLE : TIMEL/TIMEX/TIMED/TIMEST CERN ROUTINES FOR CMS
-* =====
-*
-* FUNCTION : RETURNS THE TIME USED BY OR LEFT TO A JOB IN SECONDS.
-* ======== THE JOB MAY BE RUNNING IN CMS BATCH OR ONLINE.
-*
-* AUTHOR : C. P. WOOD, USER SUPPORT, CD RAL, 26TH APRIL 1982
-* ======
-*
-* DESCRIPTION
-* ===========
-* SEE CERN LIBRARY SPECIFICATION FOR Z007 FOR TIMED/TIMEL/TIMEX.
-* TIMEST USAGE:
-* CALL TIMEST(TIME,IFLAG)
-* WHERE TIME IS A REAL*8 NUMBER SPECIFYING THE TIME LIMIT IN SECONDS
-* FOR THE JOB, RELATIVE TO THE CURRENT CPU TIME. IF IFLAG IS EQUAL
-* TO ONE, THEN IF A CALL IS MADE TO TIMEX AFTER THE TIME LIMIT HAS
-* EXPIRED, AN ABEND WILL BE FORCED. IF IFLAG IS EQUAL TO ZERO, THEN
-* EXECUTION WILL CONTINUE. THE IFLAG ARGUMENT IS OPTIONAL AND IS
-* DEFAULTS TO ONE. SUBSEQUENT CALLS TO TIMEST ARE IGNORED. IN CMS
-* BATCH, ALL CALLS TO TIMEST ARE IGNORED.
-*
-*********************************************************************
-* MODIFICATION LOG:
-* 17/5/83 CHECK WHETHER RUNNING IN BATCH MODE BY TESTING FOR
-* PRESENCE OF JOB LIMIT CONTROL BLOCK INSTEAD OF TESTING
-* BATCH FLAG IN NUCLEUS. THIS IS FOR THE NEW (BATMAN
-* AND ROBIN) BATCH SYSTEM, WHICH DOES NOT SET THE FLAG.
-*********************************************************************
-*
-#if defined(CERNLIB_QMIBMXA)
-* SPLEVEL SET=1
-*TIMEX AMODE 31
-*TIMEX RMODE ANY
-#endif
-R0 EQU 0
-R1 EQU 1
-R2 EQU 2
-R3 EQU 3
-R4 EQU 4
-R5 EQU 5
-R6 EQU 6
-R7 EQU 7
-R8 EQU 8
-R9 EQU 9
-R10 EQU 10
-R11 EQU 11
-R12 EQU 12
-R13 EQU 13
-R14 EQU 14
-R15 EQU 15
-*
-FR0 EQU 0
-FR2 EQU 2
-FR4 EQU 4
-FR6 EQU 6
-*
- USING TIMEX,R15
- B 12(R15)
- DC X'7'
- DC CL7'TIMEX'
-EPTIMEX EQU X'00'
- MVI EPNAME,EPTIMEX IDENTIFY ENTRY POINT
- LA R15,START
- BR R15
-*
- ENTRY TIMEL
-TIMEL EQU *
- USING TIMEL,R15
- B 12(R15)
- DC X'7'
- DC CL7'TIMEL'
-EPTIMEL EQU X'01'
- MVI EPNAME,EPTIMEL IDENTIFY ENTRY POINT
- LA R15,START
- USING START,R15
- BR R15
-*
- ENTRY TIMED
-TIMED EQU *
- USING TIMED,R15
- B 12(R15)
- DC X'7'
- DC CL7'TIMED'
-EPTIMED EQU X'02'
- MVI EPNAME,EPTIMED IDENTIFY ENTRY POINT
- LA R15,START
- USING START,R15
- BR R15
-*
- ENTRY TIMEST
-TIMEST EQU *
- USING TIMEST,R15
- B 12(R15)
- DC X'7'
- DC CL7'TIMEST'
-EPTIMEST EQU X'03'
- MVI EPNAME,EPTIMEST IDENTIFY ENTRY POINT
- LA R15,START
- USING START,R15
-*
-START SAVE (14,12) COMMON CODE SECTION
- LR R10,R1 SAVE ARGUMENT LIST ADDRESS
-*
-*********************************************************************
-* ACCESS CMS CONSTANT AREAS. USED TO CHECK WHETHER PROGRAM IS RUNNING
-* IN CMS BATCH AND YIELDS TIME INFORMATION IF IT IS.
-*********************************************************************
-*
- USING NUCON,0 CMS NUCLEUS CONSTANT AREA
- USING BATLSECT,R2 CMS BATCH CONSTANT AREA
- L R2,ABATLIMT
-*
-*********************************************************************
-* BRANCH TO DIFFERENT CODE FOR TIMED/TIMEL/TIMEX.
-*********************************************************************
-*
- CLI EPNAME,EPTIMEST
- BNE TEST
-*
-*********************************************************************
-* T I M E S T CODE SECTION
-*********************************************************************
-*
- C R2,=F'0' TIMEST IS IGNORED IN CMS BATCH 170583
- BNE RETURN 170583
-*
- CLI TIMESTCL,CALLED PREVIOUS CALL TO TIMEST?
- BE RETURN YES - IGNORE CALL
-*
- MVI TIMESTCL,CALLED INDICATE TIMEST CALLED
- BAL R12,GETCPUTM GET TIME USED SINCE SESSION BEGAN
- STD FR0,CPUSTART STORE IT
- L R11,0(R10) FETCH FIRST ARGUMENT ADDRESS
- AD FR0,0(R11) ADD USER LIMIT
- STD FR0,CPUEND STORE IMAGINARY TIME LIMIT
- MVI ABENDFLG,ABENDDEF DEFAULT VALUE FOR ABENDFLG
- LTR R11,R11 TEST FOR SECOND ARGUMENT
- BM RETURN
- L R11,4(R10) FETCH SECOND ARGUMENT ADDRESS
- MVC ABENDFLG(1),3(R11) SET ABEND FLAG
- B RETURN
-*
-*********************************************************************
-* T I M E X / T I M E L / T I M E D CODE SECTION
-*********************************************************************
-*
-TEST L R11,0(R10) FETCH ARGUMENT ADDRESS
- C R2,=F'0' SEPARATE CODE FOR BATCH 170583
- BNE CPULFTBT 170583
-*
- CLI TIMESTCL,CALLED MUST BE PREVIOUS CALL TO TIMEST
- BE CPULFTOL WHEN RUNNING ONLINE
- LD FR0,DEFAULT RETURN DEFAULT IF THERE IS NOT
- B RETTIME
-*
-*********************************************************************
-* CODE FOR TIMEX/TIMEL/TIMED WHEN RUNNING ONLINE.
-*********************************************************************
-*
-CPULFTOL BAL R12,GETCPUTM GET CURRENT CPU TIME
- CD FR0,CPUEND HAS TIME LIMIT EXPIRED?
- BM NOABEND NO
- CLI ABENDFLG,X'00' YES - DOES USER WANT ABEND?
- BE NOABEND NO
-*
- WTO '***TIMED/TIMEL/TIMEX*** TIME LIMIT EXCEEDED',ROUTCDE=11
- DMSABN 322 ISSUE MESSAGE AND FORCE ABEND
-*
-NOABEND CLI EPNAME,EPTIMEL WANT TIME USED OR TIME LEFT?
- BNE CPUUSDOL BRANCH FOR TIMEL
-*
- SD FR0,CPUEND DIFFERENCE BETWEEN LIMIT AND
- LCDR FR0,FR0 CURRENT CPU TIME GIVES TIME LEFT
- B RETTIME
-*
-CPUUSDOL SD FR0,CPUSTART SUBTRACT START TIME FROM CURRENT
- B RETTIME TO GIVE TIME USED
-*
-*********************************************************************
-* CODE FOR TIMED/TIMEL/TIMEX WHEN RUNNING IN CMS BATCH.
-*********************************************************************
-*
-CPULFTBT BAL R12,GETCPUTM GET CURRENT CPU TIME
- CLI EPNAME,EPTIMEL TIME USED OR TIME LEFT?
- BNE CPUUSDBT BRANCH FOR TIMEL
-*
- LH R0,BATCPUL BATCH LIMIT
- ST R0,TIME+4 CONVERT INTEGER TO FLOATING POINT
- LD FR2,TIME
- AD FR2,ZERO NORMALISE IT
- SDR FR2,FR0 MINUS BATCH TIME USED GIVES TIME
- LDR FR0,FR2 REMAINING IN SECONDS
-*
-CPUUSDBT EQU * RETURN TIME USED AS IT IS
-*
-*********************************************************************
-* RETURN TIME TO USER - MORE TO DO IF CALL WAS TO TIMED
-*********************************************************************
-*
-RETTIME CLI EPNAME,EPTIMED SPECIAL CODE FOR TIMED
- BNE TIMEEND
- LDR FR2,FR0 SUBTRACT TIME USED AT LAST TIMED
- SD FR0,LASTTIME CALL FROM CURRENT TIME USED
- STD FR2,LASTTIME SAVE CURRENT TIME FOR NEXT CALL
-TIMEEND STE FR0,0(R11) RETURN TIME TO USER
-*
-*********************************************************************
-* COMMON RETURN POINT
-*********************************************************************
-*
-RETURN RETURN (14,12),T,RC=0
-*
-*********************************************************************
-* SUBROUTINE TO FIND TOTAL CPU TIME USED SINCE START OF SESSION.
-* TIME IN SECONDS IS RETURNED IN FR0. ONLY R1 IS CHANGED BESIDES FR0.
-* INTERROGATES PSEUDO TIMER TO GET TIME USING DIAGNOSE CODE '0C'.
-*********************************************************************
-*
-GETCPUTM LA R1,TIMEAREA POINT TO DATA AREA
- DIAG R1,R1,X'000C' INTERROGATE PSEUDO TIMER
-*
- MVC TIME+1(7),TIMEAREA+TOTCPU+1 CONVERT DOUBLE WORD
- LD FR0,TIME UNSIGNED INTEGER GIVING TIME IN
- DD FR0,MUSTOSEC MICROSECONDS TO REAL*8 GIVING
- BR R12 TIME IN SECONDS
-*
-*********************************************************************
-* DATA AREA.
-*********************************************************************
-TIMEAREA DS 4D DATA AREA FOR PSEUDO TIMER
-TOTCPU EQU 24 OFFSET IN AREA FOR TOTAL CPU TIME
-TIME DC XL4'4E000000' DATA FOR CONVERTING INTEGER TO REAL
- DS F
-MUSTOSEC DC D'1.0E6' MICROSECONDS TO SECONDS FACTOR
-CPUSTART DS D ONLINE CPU START TIME
-CPUEND DS D ONLINE CPU END TIME
-LASTTIME DC D'0.0' CPU USED AT LAST TIMED CALL
-DEFAULT DC D'0.0' ONLINE CPU DEFAULT IF NO TIMEST CALL
-ZERO DC D'0.0'
-ABENDFLG DS X ONLINE ABEND FLAG
-ABENDDEF EQU X'01' DEFAULT VALUE
-EPNAME DS X ENTRY POINT IDENTIFICATION
-TIMESTCL DC X'00' TIMEST CALL CHECK
-CALLED EQU X'FF' FLAG VALUE TO SHOW TIMEST CALLED
-*
- LTORG 170583
- NUCON CMS NUCLEUS DATA AREA LAYOUT
- BATLIMIT CMS BATCH DATA AREA LAYOUT
- END
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncms/z007/timexce.s b/src/packlib/kernlib/kerngen/obsolete/kerncms/z007/timexce.s
deleted file mode 100644
index c95cf8c..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncms/z007/timexce.s
+++ /dev/null
@@ -1,281 +0,0 @@
-*
-* $Id: timexce.s,v 1.1.1.1 1996/02/15 17:51:45 mclareni Exp $
-*
-* $Log: timexce.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:45 mclareni
-* Kernlib
-*
-*
-#if defined(CERNLIB_CERN)
- PRINT OFF
- MACRO
-&NAME GETCPUTM
-&NAME DIAG R12,R12,X'000C' Return time information
- MVI TOTCPU,X'4E' Unnormalised FP number
- LD F0,TOTCPU
- DD F0,=D'1.0E6' Microseconds -> Seconds
- TM FLAGS,INBATCH In batch?
- BO *+4
- SD F0,CPUSTART No, Adjust time
- MEND
- PRINT ON,NOGEN
-TIMEX CSECT
-#if defined(CERNLIB_QMIBMXA)
-TIMEX AMODE ANY
-TIMEX RMODE ANY
-#endif
-*
-* CERN PROGLIB# Z007 TIMEX
-*
-*********************************************************************
-*
-* TITLE : TIMEL/TIMEX/TIMED/TIMEST CERN routines for VM/CMS SLAC batch
-* =====
-*
-* FUNCTION : Returns the time used by or left to a job in seconds.
-* ======== The job may be running in SLAC batch or online. An
-* interface to the SLAC JOBSTOP command to return no
-* time left is included.
-*
-* DESCRIPTION
-* ===========
-*
-* See CERN library specification for Z007 for TIMED/TIMEL/TIMEX.
-*
-* TIMEST usage: CALL TIMEST(TIME)
-* where TIME is a REAL*4 number specifying the time limit in seconds
-* for the job, relative to the current CPU time.
-* Subsequent calls to TIMEST are ignored.
-* In SLAC batch, all calls to TIMEST are ignored.
-*
-*********************************************************************
-*
-* M O D I F I C A T I O N L O G
-*
-* Original Version:
-*
-* H.R.Renshall CERN/DD February 1985
-* Based on the Rutherford Lab version for IBM Batch by C.P.Wood RL
-*
-* Modified 17 05 85 to return TIMEL=9999. by default
-* KERNIBM 2.12 CNL 179 H.R.Renshall/CERN/DD
-*
-* Modified 21 06 85 to use the normalised time limit plus the
-* CPU normalisation constant now returned by JOB$VM
-* KERNIBM 2.13 CNL 180 H.R.Renshall/CERN/DD
-*
-* Modified extensively 15/03/89 to use the now public JOB$VM routine.
-* Code considerably simplified (My opinion at least...)
-* KERNCMS 1.02 CNL 195 Tony Cass CERN/DD
-*
-* Modified 15/03/89 to use the new HEPVM JOBSTOP check
-* KERNCMS 1.05 CNL 200 Tony Cass CERN/DD
-*
-*********************************************************************
-*
-*
-* P R O L O G U E
-*
- USING NUCON,R0
-*
- USING TIMEX,R15
- B 16(R15)
- DC AL1(7),CL7'TIMEX' Identifier
- DC C'2.00' Version.Modification level
- OI FLAGS,EPTIMEX Identify Entry Point
- LA R15,START
- USING START,R15
- BR R15
-*
- ENTRY TIMEL
-TIMEL EQU *
- USING TIMEL,R15
- B 12(R15)
- DC X'7'
- DC CL7'TIMEL'
- OI FLAGS,EPTIMEL Identify Entry Point
- LA R15,START
- USING START,R15
- BR R15
-*
- ENTRY TIMED
-TIMED EQU *
- USING TIMED,R15
- B 12(R15)
- DC X'7'
- DC CL7'TIMED'
- OI FLAGS,EPTIMED Identify Entry Point
- LA R15,START
- USING START,R15
- BR R15
-*
- ENTRY TIMEST
-TIMEST EQU *
- USING TIMEST,R15
- B 12(R15)
- DC X'7'
- DC CL7'TIMEST'
- OI FLAGS,EPTIMEST Identify Entry Point
- LA R15,START
- USING START,R15
-*
-START STM R14,R12,12(R13)
- LR R4,R13
- CNOP 0,4
- BAL R13,AROUNDSA
-SAVEAREA DC A(RETURN),17F'0'
- DROP R15
- USING SAVEAREA,R13
-AROUNDSA ST R13,8(0,R4)
- ST R4,4(0,R13)
- XC 8(4,R13),8(R13)
-*
-REALCODE L R11,0(,R1) Argument address
- LA R12,TIMEAREA For Diagnose X'000C'
- USING TIMEAREA,R12
-*
-*********************************************************************
-* Access CMS constant areas. Call CERN library routine JOB$VM
-* to see if interactive or batch (and find time limit if batch)
-*********************************************************************
-*
- TM FLAGS,JOBDONE How's the initialisation?
- BO WHICHEP
- LA R1,ARG$VM
- L R15,=V(JOB$VM)
- BALR R14,R15
- OI FLAGS,JOBDONE
- LTR R0,R0 Are we in batch?
- BZ WHICHEP No...
- LD F0,BATMXTME Limit in accounting seconds
- DD F0,BATTFACT Convert to native seconds
- STD F0,BATMXTME
- OI FLAGS,INBATCH Yes, set the flags
- OI FLAGS,SETTIME Make's life simpler
-*
-WHICHEP TM FLAGS,EPTIMEST Call to TIMEST?
- BNO REALWORK No...
-*
-*********************************************************************
-* T I M E S T CODE SECTION
-*********************************************************************
-*
- TM FLAGS,SETTIME Previous call to TIMEST?
- BO RETURN Yes - ignore this call
-*
- GETCPUTM Get time used since session began
- STD F0,CPUSTART Store it
- MVC BATMXTME(4),0(R11) Store user limit
- OI FLAGS,SETTIME Show it's all been done
- B RETURN And that's all
-*
-*********************************************************************
-* T I M E X / T I M E L CODE SECTION
-*********************************************************************
-*
-REALWORK TM FLAGS,EPTIMED TIMED call?
- BO DOTIMED Yes...
-*
- LD F0,=D'0.0' Default time used so far
- TM FLAGS,EPTIMEL For TIMEL, check if JOBSTOP is set
- BNO NOTFORCD Not TIMEL
- TM BATFLAG2,BATSTOP New, official HEPVM test
-#if defined(CERNLIB_QMNOGVAR)
- BNO NOTFORCD Not BATCH JOPSTOPped...
-#endif
-#if !defined(CERNLIB_QMNOGVAR)
- BO FORCED
-* Keep old test for now
- L R15,=V(JOBSTP) Have we been forcibly timed out?
- BALR R14,R15
- LTR R0,R0
- BZ NOTFORCD No....
-#endif
-FORCED LD F0,BATMXTME Yes, pretend we're at time limit
- B GOTTIME
-*
-NOTFORCD TM FLAGS,SETTIME Do we want real limits?
- BNO GOTTIME No, 0 CPU used is fine and dandy
-*
- GETCPUTM Interrogate timer
-*
-GOTTIME TM FLAGS,EPTIMEL Want time used or time left?
- BNO RETTIME Time used - but got that already
-*
- SD F0,BATMXTME Difference between limit and
- LCDR F0,F0 Current CPU time gives time left
- B RETTIME
-*
-*********************************************************************
-* Code for T I M E D
-*********************************************************************
-*
-DOTIMED GETCPUTM Get current CPU time
- LDR F2,F0
- SD F0,LASTIMED Subtract time at last call
- STD F2,LASTIMED And reset
-*
-*********************************************************************
-* Return time to user
-*********************************************************************
-*
-RETTIME STE F0,0(R11)
-*
-*********************************************************************
-* Common return point
-*********************************************************************
-*
-RETURN EQU *
- NI FLAGS,X'0F' Clear Entry Point identifier
- L R13,4(0,R13)
- LM R14,R12,12(R13)
- MVI 12(R13),X'FF'
- BR R14
-*
-*
-*********************************************************************
-* DATA AREA.
-*********************************************************************
-*
- DS 0D
-BATUSER DS CL8 Sender's UserID
-BATACNT DS CL8 Sender's Account
-BATBIN DS CL8 Sender's Dist code
-BATMACH DS CL8 Virtual Machine ID
-BATJOBID DS CL8 Job ID
-VSTORE DS CL8
-BATSTRST DS CL8 Start/Restart
-BATNODE DS CL8 Master NodeID
-BATMONID DS CL8 BMON ID
-BATMASTR DS CL8 Master monitor ID
-BATMXTME DS D Max CPU time (in accounting seconds)
-BATTFACT DS D DP CPU time normalisation factor
-MACHTYPE DS D
- DS 3D
-*
-ARG$VM DC A(BATUSER)
-*
-FLAGS DC XL1'00'
-JOBDONE EQU X'01' Show JOB$VM has been called
-INBATCH EQU X'02' Distinguish batch/interactive
-SETTIME EQU X'04' Show if TIMEST has been called
-NOTUSED EQU X'08'
-EPTIMEX EQU X'10' Entry point TIMEX
-EPTIMEL EQU X'20' TIMEL
-EPTIMED EQU X'40' TIMED
-EPTIMEST EQU X'80' TIMEST
-*
- LTORG 170583
-*
- DS 0D
-TIMEAREA EQU * Data area for Pseudo Timer
- DS 2CL8' ' Date and time in character format
-VIRTCPU DC D'0.0' Virtual CPU time used
-TOTCPU DC D'0.0' Total CPU time used
-CPUSTART DC D'0.0' Online CPU start time
-LASTIMED DC D'0.0' CPU used at last TIMED call
-*
- REGEQU
- NUCON
- END
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncms/z036/abuser.s b/src/packlib/kernlib/kerngen/obsolete/kerncms/z036/abuser.s
deleted file mode 100644
index 8d85cd5..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncms/z036/abuser.s
+++ /dev/null
@@ -1,252 +0,0 @@
-*
-* $Id: abuser.s,v 1.1.1.1 1996/02/15 17:51:48 mclareni Exp $
-*
-* $Log: abuser.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:48 mclareni
-* Kernlib
-*
-*
- PRINT NOGEN
-ABUSER CSECT
-#if defined(CERNLIB_QMIBMXA)
-ABUSER AMODE ANY
-ABUSER RMODE ANY
-#endif
-*
-* CERN PROGLIB# Z036 ABUSER .VERSION KERNIBM 2.25 881103
-*
-* System : VM / CMS
-*
-* Function: Saves the address of a user specified exit routine
-* to which control is passed after an abend
-*
-* Called by: EXTERNAL NAME
-* CALL ABUSER(NAME) To set up user exit
-* CALL ABUSER(0) To cancel existing exit
-* or: CALL REENT(NAME) to set up user exit
-* CALL REENT(0) to cancel existing exit
-*
-* ABUSER may be called at any time before an abend
-* to specify, respecify or cancel the user exit routine.
-*
-* Calls: After an ABEND control is transferred to the user exit
-* routine via a call of the form CALL NAME(KODES,KODEU).
-* The two arguments kept only for compatibility with MVS
-* and are set to zero.
-* On return from the user exit routine control passes on
-* to the standard Fortran ABEND processing routines.
-*
-* Notes: ABUSER uses storage in NUCON which must not be
-* overwritten: 8bytes at NUSERFWD
-* 8bytes at NUCCOPYR for CMS4 and previous
-* NUCUSER1 for CMS5 on
-*
-*********************************************************************
-*
-* Modification log:
-*
-* 1.00 Original version Tony Cass CERN/DD 19th July 1988
-*
-*********************************************************************
-*
-* 1.01 For XA change DMSKEY NUCLEUS to SPKA 224(0)
-* DMSKEY USER SPKA 0
-* For CMS 5 onwards use NUCUSER1 & NUCUSER2 instead of NUCCOPYR
-*
-* Tony Cass CERN/DD 3rd November 1988
-*
-*********************************************************************
-*
-* 1.02 VS Fortran 2.5 generates an operation exception testing for
-* presence of hardware SQRT instruction. Add call to S#QRT so that
-* this exception does not lead to call to user exit routine.
-*
-* Tony Cass CERN/DD 7th January 1992
-*
-*********************************************************************
-*
- PRINT NOGEN
- ENTRY REENT
-REENT EQU *
-*
- USING ABUSER,R15
- B SAVE
- DC AL1(7),CL7'ABUSER' Name
- DC CL4'1.02' Version.modification
-SAVE STM R14,R12,12(R13)
- LR R4,R13
- CNOP 0,4
- BAL R13,CARRYON
-ABUSSAVE DC 18F'0'
- DROP R15
- USING ABUSSAVE,R13
-CARRYON ST R13,8(,R4)
- ST R4,R4(,R13)
- XC 8(4,R13),8(R13)
-*
- USING NUCON,R0
-*
- L R1,0(,R1) -> address of user exit routine
- L R1,0(,R1) = ditto
- C R1,=F'0' Setting or unsetting?
- BE UNSET
-*
-SET ST R1,USEREXIT Save it so I know where to go
- TM PSWSTATE,MINE Is s/he resetting exit address?
- BNZ RETURN Yup, so I've finished
-*
-* Make sure the operation exception generated when Fortran tests for
-* hardware SQRT won't cause a call here.
-*
- EXTRN S#QRT
- EXTRN D#SQRT
- LA R1,SQRTPARM
- L R15,=A(S#QRT)
- BALR R14,R15
- LA R1,SQRTPARM
- L R15,=A(D#SQRT)
- BALR R14,R15
-*
- LA R1,HALFWAY Set up new program interrupt handler
- TM X'5EA'(0),X'80' XA mode?
- BNO SETNPSW No, basic address is fine
- O R1,=X'80000000' Yes, say so ...
-*
-SETNPSW SPKA 0(0)
- MVC PSWSTORE(8),PGMNPSW
- ST R1,PGMNPSW+4
- SPKA 224(0)
- OI PSWSTATE,MINE and show it's been done
-*
-* Intercept return to system so I can reset PROGNPSW if necessary
-*
- USING SVCSECT,R11
- USING SSAVE,R12
-*
- TM THRUME,YES Check I've not already done this
- BNZ RETURN
- L R11,ASVCSECT Follow the tortuous path
- L R12,CURRALOC to get the address of the
- L R1,USAVEPTR save area of 'caller'
- MVC TOSYSTEM(4),12(R1) Save the return address
- LA R5,PUTBACK
- TM X'5EA'(0),X'80' XA mode?
- BNO SETRETN No, basic address is fine
- O R5,=X'80000000' Yes, say so ...
-*
-SETRETN ST R5,12(,R1) and put mine there instead
- OI THRUME,YES Flag it as done
-*
- B RETURN
-*
-UNSET TM PSWSTATE,MINE Check psw needs resetting
- BZ RETURN
- SPKA 0(0) Yes, put back cms interrupt handler
- MVC PGMNPSW(8),PSWSTORE
- SPKA 224(0)
- NI PSWSTATE,255-MINE and show it's been done
-*
-RETURN L R13,4(,R13)
- LM R14,R12,12(R13)
- OI 12(R13),X'FF'
- BR R14
-*
-* Here when the ABEND happens
-*
- DROP R13
-HALFWAY ST R13,NUSERFWD
- BALR R13,0 Where on earth am I?
- USING *,R13
- CNOP 0,4
- BAL R13,AROUNDSA Do this for nice FORTRAN linkage
- DROP R13
- USING SAVEAREA,R13
-SAVEAREA DC 18F'0'
-AROUNDSA STM R14,R12,MYSAVE and save registers for later
-*
-* Check which type of interrupt I've got
-*
- LA R1,43 Location of interrupt code
- TM PGMOPSW+1,BCMODE depends on control mode
- BZ WHICH
- LA R1,143
-WHICH CLI 0(R1),X'06'
- BH TONORMAL Ignore maths problems
-*
-* Now go to exit routine after checking idiot isn't already ABENDing
-*
- TM LOOPING,YES
- BNZ PROBLEMS
- OI LOOPING,YES
- SPKA 224(0) Stop user overwriting nucleus
- LA R1,AKODES For compatibility with MVS
- L R15,USEREXIT
- BALR R14,R15
- SPKA 0(0)
-*
-* Be nice and put back real program new PSW
-*
-RESETPSW SPKA 0(0)
- MVC PGMNPSW(8),PSWSTORE
- SPKA 224(0)
- NI PSWSTATE,255-MINE and show it's been done
-*
-* Now go to real interrupt processor
-*
-TONORMAL LM R14,R12,MYSAVE
- L R13,NUSERFWD
- LPSW PSWSTORE Not PGMNPSW since here for maths also
-*
-* Here if user's ABEND routine ABENDs...
-*
-PROBLEMS WRTERM '**************************************************'
- WRTERM '** SORRY, YOUR ABEND PROCESSING ROUTINE ABENDED **'
- WRTERM '**************************************************'
- B RESETPSW
-*
-* Here on the way back to CMS - replace PGMNPSW
-*
- USING *,R14 Return is BR 14 with R15=return code
-PUTBACK STM R15,R13,MYSAVE Just in case...
- TM PSWSTATE,MINE Check psw needs resetting
- BZ ALLOVER No
- SPKA 0(0) Yes
- MVC PGMNPSW(8),PSWSTORE
- SPKA 224(0)
- NI PSWSTATE,255-MINE and show it's been done
-*
-ALLOVER LM R15,R13,MYSAVE
- L R14,TOSYSTEM Return address to CMS
- BR R14 And now it really is all over
-*
- DS 0D
-USEREXIT DC AL4(0)
-TOSYSTEM DC AL4(0)
-MYSAVE DC 18F'0'
-AKODES DC AL4(KODES)
-AKODEU DC AL4(KODEU+X'80000000')
-KODES DC F'0'
-KODEU DC F'0'
-SQRTPARM DC AL4(FOUR+X'80000000')
-FOUR DC F'41400000'
- DC F'0'
-BCMODE EQU X'08'
-LOOPING DC X'00'
-THRUME DC X'00'
-YES EQU X'01'
-PSWSTATE DC X'00'
-MINE EQU X'01'
- DS 0D
- LTORG
- DS 0D
- NUCON
-#if defined(CERNLIB_QCMS4)
-PSWSTORE EQU NUCCOPYR For CMS4 and previous
-#endif
-#if !defined(CERNLIB_QCMS4)
-PSWSTORE EQU NUCUSER1 For CMS5 [ONWARDS...]
-#endif
- SVCSECT
- CMSAVE
- REGEQU
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncms/z044/intrac.s b/src/packlib/kernlib/kerngen/obsolete/kerncms/z044/intrac.s
deleted file mode 100644
index 381de03..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncms/z044/intrac.s
+++ /dev/null
@@ -1,85 +0,0 @@
-*
-* $Id: intrac.s,v 1.1.1.1 1996/02/15 17:51:48 mclareni Exp $
-*
-* $Log: intrac.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:48 mclareni
-* Kernlib
-*
-*
- PRINT NOGEN
-INTRAC CSECT
-#if defined(CERNLIB_QMIBMXA)
-INTRAC AMODE ANY
-INTRAC RMODE ANY
-#endif
-*
-* CERN PROGLIB# Z044 INTRAC .VERSION KERNIBM 2.25 881103
-*
-* LOGICAL FUNCTION WHICH RETURNS THE VALUE 'TRUE' IF THE VIRTUAL
-* MACHINE IS RUNNING INTERACTIVELY, (I.E. IT HAS A VIRTUAL CONSOLE
-* WHICH IS ASSOCIATED WITH A REAL DEVICE); AND THE VALUE 'FALSE' IF
-* IT IS RUNNING NON-INTERACTIVELY, (I.E. A VIRTUAL CONSOLE DOES NOT
-* EXIST OR IS NOT ASSOCIATED WITH A REAL DEVICE).
-*
-*********************************************************************
-*
-* M O D I F I C A T I O N L O G
-*
-* 1.00 ORIGINAL VERSION.
-* R. MATTHEWS, UNIVERSITE DE GENEVE, OCTOBRE 1988.
-*
-*********************************************************************
-R0 EQU 0
-R1 EQU 1
-R2 EQU 2
-R3 EQU 3
-R4 EQU 4
-R5 EQU 5
-R6 EQU 6
-R7 EQU 7
-R8 EQU 8
-R9 EQU 9
-R10 EQU 10
-R11 EQU 11
-R12 EQU 12
-R13 EQU 13
-R14 EQU 14
-R15 EQU 15
-*
-* P R O L O G U E
-*
- USING INTRAC,R15
- B SAVEREGS
- DC AL1(7),CL7'INTRAC' IDENTIFIER
- DC C'1.00' VERSION.MODIFICATION LEVEL
-SAVEREGS STM R14,R12,12(R13)
- LR R4,R13
- CNOP 0,4
- BAL R13,AROUNDSA
-SAVEAREA DC A(EPILOGUE),17F'0'
- DROP R15
- USING SAVEAREA,R13
-AROUNDSA ST R13,8(0,R4)
- ST R4,4(0,R13)
- XC 8(4,R13),8(R13)
-*
- SR R2,R2 R2 := 0
- BCTR R2,0 R2 := -1
- DIAG R2,R3,X'24' ISSUE DIAGNOSE CODE X'24'
- BC 3,DISCO BRANCH IF CC=2 OR CC=3
- LA R0,1 FUNCTION VALUE = 1
- B EPILOGUE RETURN
-DISCO SR R0,R0 FUNCTION VALUE = 0
-*
-* E P I L O G U E
-*
-EPILOGUE EQU *
- L R13,4(0,R13)
- LM R14,R15,12(R13)
- LM R1,R12,24(R13)
- MVI 12(R13),X'FF'
- BR R14
- END
-#ifdef CERNLIB_TCGEN_INTRAC
-#undef CERNLIB_TCGEN_INTRAC
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncms/z100/jobnam.F b/src/packlib/kernlib/kerngen/obsolete/kerncms/z100/jobnam.F
deleted file mode 100644
index e0dd170..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncms/z100/jobnam.F
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: jobnam.F,v 1.1.1.1 1996/02/15 17:51:49 mclareni Exp $
-*
-* $Log: jobnam.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:49 mclareni
-* Kernlib
-*
-*
-*IF=-CERN.
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE JOBNAM(NAME)
-C
-C CERN PROGLIB# Z100 JOBNAM .VERSION KERNCMS 1.06 910721
-C
-C Returns Batch Job identifier or INTERACT if interactive
-C Usable with SLAC-Batch and VMBatch
-C
- CHARACTER*8 NAME,JOBINFO
-C
- NAME = JOBINFO('JOBID')
-C
- RETURN
- END
-#ifdef CERNLIB_TCGEN_JOBNAM
-#undef CERNLIB_TCGEN_JOBNAM
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncms/z100/jobnamce.F b/src/packlib/kernlib/kerngen/obsolete/kerncms/z100/jobnamce.F
deleted file mode 100644
index 0048fc7..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncms/z100/jobnamce.F
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: jobnamce.F,v 1.1.1.1 1996/02/15 17:51:49 mclareni Exp $
-*
-* $Log: jobnamce.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:49 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
-#if (defined(CERNLIB_CERN))&&(defined(CERNLIB_NEVER))
- SUBROUTINE JOBNAM(NAME)
-C
-C CERN PROGLIB# Z100 JOBNAM .VERSION KERNCMS 1.02 890308
-C
-C Version for (Hep)VM with SLAC Batch
-C
-C Function: Returns SLAC Batch Job identifier if in batch
-C or 'INTERACT' if interactive.
-C
-C This version of JOBNAM merely provides a convenient interface to
-C the JOB$VM routine.
-C
- CHARACTER*8 INFO(16),NAME
-C
- CALL JOB$VM(INFO)
- NAME = INFO(5)
-C
- RETURN
- END
-#ifdef CERNLIB_TCGEN_JOBNAM
-#undef CERNLIB_TCGEN_JOBNAM
-#endif
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncms/z262/goparm.s b/src/packlib/kernlib/kerngen/obsolete/kerncms/z262/goparm.s
deleted file mode 100644
index 52421e5..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncms/z262/goparm.s
+++ /dev/null
@@ -1,152 +0,0 @@
-*
-* $Id: goparm.s,v 1.1.1.1 1996/02/15 17:51:49 mclareni Exp $
-*
-* $Log: goparm.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:49 mclareni
-* Kernlib
-*
-*
- PRINT NOGEN
-GOPARM CSECT
-#if defined(CERNLIB_QMIBMXA)
-GOPARM AMODE ANY
-GOPARM RMODE ANY
-#endif
-*
-* CERN PROGLIB# Z262 GOPARM .VERSION KERNIBM 2.23 880425
-* ORIG. 01/12/85 RM, 22/9/87 HRR for VS Fortran Release 2
-*
-* FORTRAN CALLABLE ROUTINE TO OBTAIN THE PARM STRING PASSED WITH A
-* START OR MODULE-NAME COMMAND IN VM/CMS RELEASE 3 WITH VS FORTRAN
-* RELEASE 2. A TRIVIAL CHANGE IS NEEDED FOR VS FORTRAN RELEASE 1.
-*
-* CALL GOPARM(LENGTH,PARMS)
-*
-* 1ST ARGUMENT= INTEGER LENGTH
-* 2ND ARGUMENT= CHARACTER*100 PARMS OR LOGICAL*1 PARMS(100)
-* RETURNED LENGTH IS THE INTEGER LENGTH OF PARMS
-* RETURNED PARMS IS THE UNTOKENIZED PARM LIST (SEE CMS USERS GUIDE)
-*
-* THIS ROUTINE MAY BE USED FOR MODULES VIA
-* MODULENAME PARAMETER-STRING
-* OR AFTER A LOAD IN THE START COMMAND VIA
-* START ENTRY-NAME PARAMETER-STRING
-* NOTE THAT ANY (UNECESSARY) BRACKETS APPEAR AS PART OF THE STRING.
-* AFTER A LOAD WITH START AS OPTION NO PARAMETERS MAY BE GIVEN AND
-* A LENGTH OF ZERO IS RETURNED. THE MAXIMUM LENGTH RETURNED IS 100
-*
-*
-* NOTE: THIS VERSION OPERATES IN A VS FORTRAN RELEASE 2 ENVIRONMENT
-* ONLY AS IT CALLS AFBVLCIN FROM THE RUN-TIME LIBRARY. FOR VS FORTRAN
-* RELEASE 1 CHANGE THIS TO CALL IFYVLCIN.
-*
-* Version 1.01 January 1988
-*
-* Modified January 1988 to pick up the address of start and end
-* of the parameter string from the Nucleus - this should work for
-* all VSFortran Releases.
-* Tony Cass CERN/DD
-*
-* Version 1.02 July 1991
-*
-* ... but not all CMS releases!
-* On entry to the program R0 points to an extended plist, use this.
-* Tony Cass CERN/CN
-*
-*********************************************************************
-*
-R0 EQU 0
-R1 EQU 1
-R2 EQU 2
-R3 EQU 3
-R4 EQU 4
-R5 EQU 5
-R6 EQU 6
-R7 EQU 7
-R8 EQU 8
-R9 EQU 9
-R10 EQU 10
-R11 EQU 11 ADDRESS OF VS FORTRAN COMMON WORK AREA
-R12 EQU 12
-R13 EQU 13
-R14 EQU 14
-R15 EQU 15
-*
- PRINT NOGEN
-*
-* P R O L O G U E
-*
- USING GOPARM,R15
- USING NUCON,0
- B SAVEREGS
- DC AL1(7),CL7'GOPARM' IDENTIFIER
- DC C'1.02' VERSION.MODIFICATION LEVEL
-SAVEREGS STM R14,R12,12(R13)
- LR R4,R13
- CNOP 0,4
- BAL R13,AROUNDSA
-SAVEAREA DC A(EPILOGUE),17F'0'
- DROP R15
- USING SAVEAREA,R13
-AROUNDSA ST R13,8(0,R4)
- ST R4,4(0,R13)
- XC 8(4,R13),8(R13)
-*
- LM R9,R10,0(R1) R9 -> ARG1, R10 -> ARG2
- XC 0(4,R9),0(R9) SET A TENTATIVE PARM LENGTH OF ZERO
-*
-* Find what R0 was when called from SVC save area - version 1.02
-*
- USING SVCSECT,R5
- USING SSAVE,R6
- L R5,ASVCSECT
- L R6,CURRALOC
- L R7,EGPR0
- L R2,4(,R7)
- L R3,8(,R7)
- L R7,0(,R7)
-*
-* use nucleus plist pointers - version 1.01
-*
-* L R2,NUCPLBEG
-* L R3,NUCPLEND R2,R3 := ARGSTART, ARGEND
-* L R7,NUCPLCMD
-*
-* Common code for versions 1.01 & 1.02
-*
- MVC COMMAND,0(R7) copy the command, GOP01060
- OC COMMAND,=C' ' translate to upper case GOP01070
- CLC COMMAND,=C'LOAD ' and quit if it was LOAD... GOP01080
- BE EPILOGUE GOP01090
- SR R3,R2 R3 := PARM LENGTH
- BZ EPILOGUE BRANCH IF IT IS ZERO
- C R3,=F'100' IS IT GT 100?
- BNH STLEN NO, BRANCH
- L R3,=F'100' SET IT TO 100
-STLEN ST R3,0(0,R9) ELSE STORE IT FOR THE USER
- BCTR R3,0 SUBTRACT 1 FOR MVC
- EX R3,MVC MOVE THE PARM FIELD TO USER'S AREA
-*
-* E P I L O G U E
-*
-EPILOGUE EQU *
- L R13,4(0,R13)
- LM R14,R12,12(R13)
- MVI 12(R13),X'FF'
- BR R14
-*
-* D A T A A R E A S
-*
- DS 0H
-MVC MVC 0(*-*,R10),0(R2)
-COMMAND DS CL5
-*
- LTORG
- NUCON
-*
-* Next two equates added for version 1.02
-*
- SVCSECT
- CMSAVE
-*
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncms/z264/getarg.F b/src/packlib/kernlib/kerngen/obsolete/kerncms/z264/getarg.F
deleted file mode 100644
index 08a3a5b..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncms/z264/getarg.F
+++ /dev/null
@@ -1,61 +0,0 @@
-*
-* $Id: getarg.F,v 1.1.1.1 1996/02/15 17:51:51 mclareni Exp $
-*
-* $Log: getarg.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:51 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE GETARG(JW,PARM)
-C
-C CERN PROGLIB# Z264 IARGC .VERSION KERNCMS 1.05 910308
-C
-C Returns JWth argument in command line
-C Author: Miguel Marquina 91/03/08
-C
-C Mods Date Comments
-C M.Marquina 91/09/01 Initialize STRING before calling GOPARM
-C Set IP2=ISLEN for the last argument
-C M.Marquina 92/12/05 Treat quote-delimited strings as single args
-C
- COMMON/Z264/IREAD,ISLEN,STRING
- CHARACTER*100 STRING
- LOGICAL LB,LQ
- CHARACTER*(*) PARM
- IF(IREAD.EQ.0) THEN
- STRING=' '
- CALL GOPARM(ISLEN,STRING)
- IREAD=1
- ENDIF
- NW =0
- LB =.TRUE.
- LQ =.FALSE.
- IP1=0
- IP2=ISLEN
- DO 10 N=1,ISLEN
- IF(STRING(N:N).NE.' ') THEN
- IF(STRING(N:N).EQ.'"') LQ=.NOT.LQ
- IF(NW.EQ.JW-1.AND.IP1.EQ.0) IP1=N
- IF(LB) LB=.FALSE.
- ENDIF
- IF(LQ) GOTO 10
- IF(STRING(N:N).EQ.' '.AND..NOT.LB) THEN
- LB=.TRUE.
- NW=NW+1
- ENDIF
- IF(NW.EQ.JW) THEN
- IP2=N-1
- GOTO 20
- ENDIF
-10 CONTINUE
-20 CONTINUE
- PARM=' '
- IF(IP1.GT.0) THEN
- IF(STRING(IP1:IP1).EQ.'"') IP1=IP1+1
- IF(STRING(IP2:IP2).EQ.'"') IP2=IP2-1
- IF(IP1.LE.IP2) PARM=STRING(IP1:IP2)
- ENDIF
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncms/z264/iargc.F b/src/packlib/kernlib/kerngen/obsolete/kerncms/z264/iargc.F
deleted file mode 100644
index 193ce11..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncms/z264/iargc.F
+++ /dev/null
@@ -1,48 +0,0 @@
-*
-* $Id: iargc.F,v 1.1.1.1 1996/02/15 17:51:51 mclareni Exp $
-*
-* $Log: iargc.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:51 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- FUNCTION IARGC(DUMMY)
-C
-C CERN PROGLIB# Z264 IARGC .VERSION KERNCMS 1.05 910308
-C
-C Returns number of arguments in command line
-C Author: Miguel Marquina 91/03/08
-C
-C Mods Date Comments
-C M.Marquina 91/09/01 Initialize STRING before calling GOPARM
-C Return 0 when ISLEN=0
-C M.Marquina 92/12/05 Treat quote-delimited strings as single args
-C
- COMMON/Z264/IREAD,ISLEN,STRING
- CHARACTER*100 STRING
- LOGICAL LB,LQ
- IF(IREAD.EQ.0) THEN
- STRING=' '
- CALL GOPARM(ISLEN,STRING)
- IREAD=1
- ENDIF
- NW=0
- IF(ISLEN.EQ.0) GOTO 20
- LB=.TRUE.
- LQ=.FALSE.
- DO 10 N=1,ISLEN
- IF(STRING(N:N).EQ.'"') LQ=.NOT.LQ
- IF(LQ) GOTO 10
- IF(STRING(N:N).NE.' '.AND.LB) LB=.FALSE.
- IF(STRING(N:N).EQ.' '.AND..NOT.LB) THEN
- LB=.TRUE.
- NW=NW+1
- ENDIF
-10 CONTINUE
- IF(STRING(N-1:N-1).NE.' ') NW=NW+1
-20 CONTINUE
- IARGC=NW
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncms/z265/getenvf.F b/src/packlib/kernlib/kerngen/obsolete/kerncms/z265/getenvf.F
deleted file mode 100644
index 0c04827..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncms/z265/getenvf.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: getenvf.F,v 1.1.1.1 1996/02/15 17:51:53 mclareni Exp $
-*
-* $Log: getenvf.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:53 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE GETENVF(CHENV,CHVAL)
-C
-C CERN PROGLIB# Z265 GETENVF .VERSION KERNCMS 1.06 910716
-C ORIG. 11/07/91, Jamie Shiers
-C
- COMMON/SLATE/IS(40)
- CHARACTER*(*) CHENV,CHVAL
- INTEGER SYSTEMF
- IRC=SYSTEMF('EXEC SETENV '//CHENV(1:LEN(CHENV))//' (STACK')
- CALL VMRTRM(CHVAL,IS(1))
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncms/z265/setenv.dat b/src/packlib/kernlib/kerngen/obsolete/kerncms/z265/setenv.dat
deleted file mode 100644
index 64c30d3..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncms/z265/setenv.dat
+++ /dev/null
@@ -1,48 +0,0 @@
-*
-* $Id: setenv.dat,v 1.1.1.1 1996/02/15 17:51:53 mclareni Exp $
-*
-* $Log: setenv.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:51:53 mclareni
-* Kernlib
-*
-*
-/*DECK ID>, setenv.exec */
-/*********************************************************************
- * *
- * SETENV EXEC v1.04 *
- * *
- * Emulation of the Unix command. Used as a function returns the val.*
- * *
- * Author: M.Marquina 90/05/10 *
- * *
- * Mods Date Comments *
- * MARQUINA 90/11/01 Use Address Command *
- * 91/03/12 Support DISPLAY *
- * 91/03/12 Add STACK option *
- * 92/03/07 Strip off leading+trailing quotes (as UNIX) *
- * *
- *********************************************************************/
- Address Command
- Arg var value "(" options
-
- Parse Source . act .
- f.fnc = act='FUNCTION'
- f.stack= 'FIND'(options,"STACK")
- 'IDENTIFY ( LIFO'
- Parse Pull . . node .
-
- group="*"node
- If var="DISPLAY" Then Do
- group="CENV" ; 'GLOBAL TXTLIB IBMLIB'
- If 'INDEX'(value,":")=0 Then value=value":0"
- End
- If var^="" & ^f.stack Then Do
- If f.fnc Then Do
- 'GLOBALV SELECT' group 'GET' var
- Return 'VALUE'(var)
- End
- value='STRIP'(value,,"'")
- value='STRIP'(value,,'"')
- 'GLOBALV SELECT' group 'SETL' var value
- End
- Else 'GLOBALV SELECT' group 'WORD'("LIST STACK",f.stack+1) var
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncms/z265/sleepf.F b/src/packlib/kernlib/kerngen/obsolete/kerncms/z265/sleepf.F
deleted file mode 100644
index 1234714..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncms/z265/sleepf.F
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: sleepf.F,v 1.1.1.1 1996/02/15 17:51:53 mclareni Exp $
-*
-* $Log: sleepf.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:53 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE SLEEPF(ISEC)
-C
-C CERN PROGLIB# Z265 SLEEPF .VERSION KERNCMS 1.05 910308
-C ORIG. 08/03/91, Miguel Marquina
-C Fortran interface to SLEEP
-C
- CHARACTER*2 TIME
- IF (ISEC.GT.(60*60)) THEN
- WRITE(TIME,'(I2)') ISEC/(60*60)
- CALL VMCMS('CP SLEEP '//TIME//' HR',IRET)
- ISEC = MOD(ISEC,60*60)
- ENDIF
- IF (ISEC.GT.60) THEN
- WRITE(TIME,'(I2)') ISEC/60
- CALL VMCMS('CP SLEEP '//TIME//' MIN',IRET)
- ISEC = MOD(ISEC,60)
- ENDIF
- IF (ISEC.GT.0) THEN
- WRITE(TIME,'(I2)') ISEC
- CALL VMCMS('CP SLEEP '//TIME//' SEC',IRET)
- ENDIF
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncms/z265/systemf.F b/src/packlib/kernlib/kerngen/obsolete/kerncms/z265/systemf.F
deleted file mode 100644
index d8be5f7..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncms/z265/systemf.F
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: systemf.F,v 1.1.1.1 1996/02/15 17:51:54 mclareni Exp $
-*
-* $Log: systemf.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:54 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- INTEGER FUNCTION SYSTEMF (NAME)
-C
-C CERN PROGLIB# Z265 SYSTEMF .VERSION KERNCMS 1.05 910308
-C ORIG. 08/03/91, Miguel Marquina
-C Fortran interface routine to system
-C
- CHARACTER NAME*(*)
-
- LGN = LNBLNK (NAME)
- CALL VMCMS(NAME(1:LGN),IRC)
- SYSTEMF = IRC
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncms/z304/iospack.s b/src/packlib/kernlib/kerngen/obsolete/kerncms/z304/iospack.s
deleted file mode 100644
index eb6aa0d..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncms/z304/iospack.s
+++ /dev/null
@@ -1,266 +0,0 @@
-*
-* $Id: iospack.s,v 1.1.1.1 1996/02/15 17:51:54 mclareni Exp $
-*
-* $Log: iospack.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:54 mclareni
-* Kernlib
-*
-*
-*
-* CERN PROGLIB# Z304 IOSPACK .VERSION KERNIBM 2.20 870601
-* ORIG. 03/07/85 E.PEROTTO
-*
-* GENERAL PURPOSE FULL SCREEN INTERFACE PACKAGE FOR IBM VM/CMS
-*
- TITLE 'MACROS'
-*--------------------------------------------------------------------
- MACRO
- PAGE
- PUNCH '$SPB' TELL LOADER TO START AT NEXT PAGE
- MEND
-*--------------------------------------------------------------------
- MACRO
- DISPW &ADR,&BYTES=,&LINE=,&CANCEL=NO,&ERASE=NO,&DISPLAY=NO
- LA R1,DISPCCW GET CCW ADDRESS IN R1
- STCM &ADR(1),B'0111',1(R1) STORE BUFFER ADDRESS
- AIF ('&LINE' EQ '').NOLINE
- STC &LINE(1),5(R1) STORE LINE NUMBER
-.NOLINE AIF ('&ERASE' NE 'YES').NOERASE
- OI 5(R1),X'80' SET 'MORE...' FLAG
-.NOERASE AIF ('&CANCEL' NE 'YES').NOCANCL
- OI 5(R1),X'FF' SET CLEAR FLAG
-.NOCANCL STH &BYTES(1),6(R1) STORE BYTE COUNT
- AIF ('&DISPLAY' EQ 'YES').DISPL
- B DISPLAY
- MEXIT
-.DISPL ANOP
-DISPLAY LA R2,9 GET CONSOLE ADDRESS
- DIAG R1,R2,X'58' WRITE TO SCREEN
- B DISPCCW+8
-*
-DISPCCW CCW X'19',0,SILI,0 DISPLAY CCW
-SILI EQU X'20' SUPPRESS INCORRECT LENGTH INDICATION
-*
- MEND
-*--------------------------------------------------------------------
-*-- PAGE LOAD ON A FULL PAGE BOUNDARY
- TITLE 'GENERAL PURPOSE FULL-SCREEN INTERFACE ROUTINES'
-*--------------------------------------------------------------------
-* ROUTINE TO WRITE A LINE ON FULL-SCREEN TERMINAL
-*--------------------------------------------------------------------
-*
-* IRC = IOSPACK(LINE,LENGTH,LINENO)
-*
-* IRC = INTEGER RETURN CODE: 0 = ALL OK
-* -1 = TERMINAL BUSY
-* -2 = UNRECOVERABLE I/O ERROR
-* LINE = CHARACTER ARRAY OR HOLLERITH CONSTANT
-* LENGTH = LENGTH OF STRING IN BYTES (MAY BE 0)
-* LINENO >0: SCREEN LINE NUMBER (ABSOLUTE)
-* =0: NEXT AVAILABLE LINE (OUTPUT AREA = 1 TO LAST-2)
-* <0: OVERWRITE PREVIOUS LINES (UP TO TOP LINE, ELSE CLEAR)
-* -1: OVERWRITE LAST LINE
-* OUT >LAST: 1ST LINE ON NEXT SCREEN AFTER MORE...
-* OUT <0: CLEAR SCREEN
-* OUT = 98: LAST LINE-2 (NORMALLY PROTECTED)
-* OUT = 99: 1ST INPUT LINE (LAST LINE-1)
-* OUT =100: 2ND INPUT LINE (LAST SCREEN LINE)
-* OUT >100: 1ST LINE ON NEXT SCREEN AFTER MORE...
-*
-* ALTERNATE ENTRY POINTS:
-* IRC = IOSPUT(LINE,LENGTH,LINENO) EQ. TO IOSPACK
-* IRC = IOSSIZ(LINES) LINES = ADDRESSABLE OUTPUT LINES
-* IRC = IOSCLR() CLEARS THE SCREEN
-* LINENO = IOSLIN() LINENO = NEXT FREE LINE ON SCREEN
-*
-* AUTHOR: ELIA PEROTTO - CERN DD DIVISION - TEL. 7672303
-* - CNUCE/CNR - PISA - TEL. 593246
-* VERSION 2.0 - 25 JULY 1985
-*
-IOSPACK CSECT
-#if defined(CERNLIB_QMIBMXA)
-IOSPACK AMODE ANY
-IOSPACK RMODE ANY
-#endif
- ENTRY IOSPUT,IOSSIZ,IOSCLR,IOSLIN
-IOSPUT EQU *
-&DT SETC 'IOSPACK &SYSDATE&SYSTIME'
- SAVE (14,12),,&DT
- LR R12,R15
- USING IOSPACK,R12
-IOSTART LR R10,R1 SAVE ARGS POINTER
- HNDINT SET,(CON1,NETINT,009,ASAP) START INTERRUPT HANDL.
-GATE B INIT FETCH REAL CONSOLE CHARACTERISTICS
-*
- LM R3,R5,0(R10) LOAD ARGS ADDRESSES
- L R4,0(,R4) R4 = BUFFER LENGTH
- LA R2,0(,R3) R2 = BUFFER ADDRESS
- LTR R4,R4 IS IT A NULL LINE?
- BH NOTNULL NO, FINE
- LA R2,BLANK YES, 0 YELDS A CHANNEL PROGRAM CHECK
- LA R4,1 MUST SEND AT LEAST ONE BYTE
-NOTNULL EQU *
- ICM R5,B'1111',0(R5) LINE NUMBER ON 3270 SCREEN (1 TO 24)
- BL BACKLINE OVERWRITE A LINE
- BZ NEXTLINE NEXT AVAILABLE LINE
- BCTR R5,0 FROM (1 TO 24) TO (0 TO 23)
- BAL R14,CHECKLIN DOES IT FIT INTO SCREEN?
- BNH ADDRLINE YES
- SH R5,=H'99' IS IT <99 (100)?
- BH ERASE NO, SHOW IT ON A NEW SCREEN
- A R5,LASTLINE GET ABSOLUTE SCREEN LINE NUMBER
- BM ERASE NEGATIVE, SHOW IT ON A NEW SCREEN
- B ADDRLINE WRITE IT THERE
-*
-BACKLINE AH R5,CURLINE GO BACK -N LINES
- BL CLEAR OUT OF SCREEN
- STH R5,CURLINE UPDATE CURRENT LINE POINTER
-NEXTLINE LH R5,CURLINE GET CURRENT LINE POINTER
- BAL R14,CHECKLIN CHECK LINE LENGTH
- BH ERASE SCREEN OVERFLOW, GO TO NEXT
-BLANK STH R6,CURLINE UPDATE CURRENT LINE POINTER
-ADDRLINE LH R0,=H'-1' ENTRY FOR DIRECT LINE WRITE (1 TO 23)
- TS FLAG IS THE PATH CLEAR?
- BNZ ERROR NO, SIGNAL ERROR TO CALLER
- STH R5,DISPLINE SAVE HERE FOR TRACE
- DISPW (R2),BYTES=(R4),LINE=(R5),DISPLAY=YES
- LH R0,=H'-2' ERROR CODE FOR I/O ERROR
- BNZ ERROR SOMETHING WENT WRONG IN THE DIAGNOSE
- WAITD CON1 WAIT FOR CONSOLE I/O (WAITT DOES NOT WORK)
-RETURN XR R0,R0 SIGNAL NO ERRORS
-ERROR ST R0,20(R13) SAVE IT ON CALLER'S R0
- HNDINT CLR,CON1 STOP INTERRUPT HANDLING
- MVI FLAG,0 RESET FLAG
- RETURN (14,12) RETURN TO FORTRAN CALLER
-*
-*--------------------------------------------------------------------
-* CHECK IF LINE FITS INTO SCREEN
-*--------------------------------------------------------------------
-*
-* IN: R4 = BUFFER LENGTH
-* R5 = SCREEN LINE NUMBER (0 TO 23)
-*
-* OUT: R6 = NEXT AVAILABLE LINE NUMBER
-* R7 = BUFFER LENGTH IN LINES
-* CC SET
- MNOTE ''
-CHECKLIN LR R7,R4 COPY BUFFER LENGTH
- BCTR R7,0 NOT TO SKIP A LINE IF 80 BYTES
- XR R6,R6 CLEAR FOR DIVIDE
- D R6,LINELEN YELDS FULL SCREEN LINES
- LA R6,1(R7,R5) NEXT AVAILABLE LINE
- C R6,LASTOUTL MORE THAN LAST OUTPUT LINE
- BR R14
-*
-*--------------------------------------------------------------------
-* PUT SCREEN INTO MORE... STATE
-*--------------------------------------------------------------------
-ERASE EQU *
- LA R7,1(R7) ROUND TO NEXT FULL LINE
- STH R7,CURLINE UPDATE NEXT AVAILABLE LINE
- XR R5,R5 SET LINE 0
- TS FLAG
- BNZ ERROR
- DISPW (R2),BYTES=(R4),LINE=(R5),ERASE=YES
-*
-*--------------------------------------------------------------------
-* CLEAR SCREEN
-*--------------------------------------------------------------------
-CLEAR EQU * OUT OF SCREEN
- XR R1,R1 UPDATE NEXT AVAILABLE LINE
- STH R1,CURLINE
- TS FLAG
- BNZ ERROR
- DISPW (R2),BYTES=(R4),CANCEL=YES
-*
-*--------------------------------------------------------------------
-* INITIALIZE DEVICE CHARACTERISTICS
-*--------------------------------------------------------------------
-INIT BAL R14,GETMODEL
- B GATE
-*
-GETMODEL XR R0,R0 CLEAR ERROR CODE
- LA R4,9 CONSOLE ADDRESS
- DIAG R4,R5,X'24' GET CONSOLE INFORMATION
- STM R4,R6,CONSINFO SAVE IT HERE
- MVI GATE+1,0 NOP THE BRANCH
- LA R1,24 MODEL 2 HAS 24 LINES
- CLI CONSINFO+10,2 IS IT A MODEL 2?
- BE MODELX YES IT IS
- LA R1,27 DEFAULT MODEL 5 LINES (27)
- LA R4,DEVINFO BUFFER ADDRESS
- LA R5,9 CONSOLE ADDRESS
- LA R6,8 BUFFER LENGTH
- DIAG R4,R6,X'8C' GET MODEL 5 SCREEN DIMENSIONS
- LTR R0,R5 ANY ERROR?
- BNZ MODELX YES
- LH R1,DEVINFO+2 GET SCREEN WIDTH
- ST R1,LINELEN
- LH R1,DEVINFO+4 GET SCREEN HEIGHT
-MODELX LR R5,R1
- BCTR R5,0 PUT IT IN DISPLACEMENT FORM
- ST R5,LASTLINE LAST SCREEN LINE
- BCTR R5,0 PROTECT THE TWO...
- BCTR R5,0 ...INPUT LINES
- ST R5,LASTOUTL LAST OUTPUT LINE
- STH R5,CURLINE NEXT SEQ. WRITE WILL GO INTO MORE...
- BR R14 BACK TO NORMAL OPERATION
-*
- USING IOSSIZ,R15
-IOSSIZ SAVE (14,12)
- L R12,=A(IOSPACK)
- DROP R15
- L R2,0(R1)
- BAL R14,GETMODEL GET 3270 MODEL INFORMATION
- ST R1,0(R2) STORE INTO USER'S VARIABLE
- ST R0,20(R13)
- RETURN (14,12)
-*
- USING IOSLIN,R15
-IOSLIN SAVE 14
- LH R0,CURLINE
- RETURN 14
- DROP R15
-*
- USING IOSCLR,R15
-IOSCLR SAVE (14,12)
- L R12,=A(IOSPACK)
- DROP R15
- LA R1,CLRPLIST
- B IOSTART
-*
-*--------------------------------------------------------------------
-* DEVICE I/O INTERRUPT HANDLER
-*--------------------------------------------------------------------
-NETINT EQU *
- USING *,R15
- CLI FLAG,X'FF' IS IT OUR START I/O?
- BNE INTPASS NO
- CH R4,=H'9' IS IT CONSOLE?
- BNE INTPASS NO
- STM R2,R3,CSW SAVE CSW
- TM CSW+4,DE LAST INTERRUPT?
- BZ INTEXIT NO, WAIT FOR NEXT
- MVI FLAG,0 YES, CLEAR FLAG TO SIGNAL COMPLETION
-INTPASS XR R15,R15 DISPATCH MAIN TASK
-INTEXIT BR R14 RETURN TO CMS INTERRUPT HANDLER
-*
-FLAG DC X'00' SYNCHRONIZATION FLAG (0 = FREE)
-CSW DS D SAVED FROM LAST INTERRUPT
-DE EQU X'04' DEVICE END BIT IN CSW
-*
-DEVINFO DS 0D BUFFER FOR DIAGNOSE 24
-CONSINFO DS 3F BUFFER FOR DIAGNOSE 8C
-DISPLINE DC H'0' LAST DISPLAY BUFFER START LINE (0 TO 23)
-CURLINE DC H'21' NEXT SCREEN LINE NUMBER (0 TO 23)
-LASTLINE DC F'23' 2ND INPUT LINE
-LASTOUTL DC F'21' LEAVE LINES 22 & 23 FOR INPUT
-LINELEN DC F'80' DEFAULT LINE LENGTH
-*
-CLRCOUNT DC F'-255' FOR IOSCLR()
-CLRPLIST DC A(*,LINELEN,CLRCOUNT)
-*
- LTORG
-*
- REGEQU
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncms/z305/vmbeep.s b/src/packlib/kernlib/kerngen/obsolete/kerncms/z305/vmbeep.s
deleted file mode 100644
index aa48a20..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncms/z305/vmbeep.s
+++ /dev/null
@@ -1,149 +0,0 @@
-*
-* $Id: vmbeep.s,v 1.1.1.1 1996/02/15 17:51:55 mclareni Exp $
-*
-* $Log: vmbeep.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:55 mclareni
-* Kernlib
-*
-*
-VMBEEP CSECT
-#if defined(CERNLIB_QMIBMXA)
-VMBEEP AMODE ANY
-VMBEEP RMODE ANY
-#endif
-*
-* CERN PROGLIB# Z305 VMBEEP .VERSION KERNIBM 2.25 881103
-* ORIG. 01/01/86 RM
-*
-* REFER TO CERN PROGRAM LIBRARY MEMBER Z305 FOR DETAILS
-*
-* M O D I F I C A T I O N L O G
-* ===============================
-*
-* 1 . 0 0
-*
-*
-* ORIGINAL VERSION.
-* R. MATTHEWS, CERN/DD, JANUARY 1986.
-*
-* 1 . 0 1
-*
-* Add a 'NOP' CCW so VMBEEP works in CMS/370 under CP/XA. This doesn't
-* harm HPO behaviour.
-*
-* Jonathan Wood (?) RAL, October 1988.
-*
-* 1 . 0 2
-*
-* Modify to work in 370 or XA mode CMS machines
-*
-* Tony Cass CERN/DD May 1989 - With thanks to Dick Newson IBM
-*
-*********************************************************************
-*
-R0 EQU 0
-R1 EQU 1
-R2 EQU 2
-R3 EQU 3
-R4 EQU 4
-R5 EQU 5
-R6 EQU 6
-R7 EQU 7
-R8 EQU 8
-R9 EQU 9
-R10 EQU 10
-R11 EQU 11
-R12 EQU 12
-R13 EQU 13
-R14 EQU 14
-R15 EQU 15
-*
- PRINT NOGEN
-*
-* P R O L O G U E
-*
- USING VMBEEP,R15
- B SAVEREGS
- DC AL1(7),CL7'VMBEEP' IDENTIFIER
- DC C'1.02' VERSION.MODIFICATION LEVEL
-SAVEREGS STM R14,R12,12(R13)
- LR R4,R13
- CNOP 0,4
- BAL R13,AROUNDSA
-SAVEAREA DC A(EPILOGUE),17F'0'
- DROP R15
- USING SAVEAREA,R13
-AROUNDSA ST R13,8(0,R4)
- ST R4,4(0,R13)
- XC 8(4,R13),8(R13)
-*
- USING NUCON,0
-*
- WAITT COMPLETION OF PENDING I/O
- L R1,=F'-1' R1 INDICATES CONSOLE DATA REQUIRED
- DC X'83',X'12',X'0024' DIAGNOSE, CODE X'24'
- BNZ EPILOGUE BRANCH IF COMPLETION ABNORMAL
-*
-#if defined(CERNLIB_QMIBMXA)
- TM NUCMFLAG,NUCMXA XA/370?
- BO BEEPXA Yup, better avoid SIOs
-*
-#endif
- DMSKEY NUCLEUS
- TIO 0(R1) TEST AVAILABILITY
- BNZ *-4
- LA R2,ALARM R2 := ADDRESS OF ALARM CCW
- ST R2,CAW STORE IT IN THE CAW
- SIO 0(R1) START I/O
- TIO 0(R1) AWAIT COMPLETION
- BNZ *-4
- DMSKEY RESET
-#if defined(CERNLIB_QMIBMXA)
- B EPILOGUE
-*
-BEEPXA DS 0H
- STNSM RESETIO,X'00' Disable interrupts
- LR R2,R1
- GETSID DEVICE=(R2),ERROR=EPILOGUE Dev code in R1
-LOOP1 TSCH IRB
- BZ LOOP1
- SSCH ORB Start the beeping
-LOOP TSCH IRB
- BZ LOOP
- STOSM JUNK,X'00' Re-enable Interrupts
-RESETIO EQU *-3
-#endif
-*
-* E P I L O G U E
-*
-EPILOGUE EQU *
- L R13,4(0,R13)
- LM R14,R12,12(R13)
- MVI 12(R13),X'FF'
- BR R14
-*
-* D A T A A R E A S
-*
-* XA seems to get op-code 0B wrong in the case where it is XABUG
-* the only opcode (ie: one CCW) but not if there are more! XABUG
-* Hence we chain a No-op to the Beep. XABUG
-* XABUG
- DS 0D
-ALARM CCW X'0B',0,X'60',1 XABUG
- CCW X'03',0,X'20',1 XABUG
-#if defined(CERNLIB_QMIBMXA)
-ALARMXA CCW1 X'0B',0,X'60',1
- CCW1 X'03',0,X'20',1
-ORB DC F'0'
-KEY DC B'00000000'
- DC B'11000000'
- DC B'11111111'
- DC B'10000000'
- DC A(ALARMXA)
-IRB DS 16F
-JUNK DS X
-#endif
-*
- LTORG
- NUCON
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncms/z305/vmbrk.s b/src/packlib/kernlib/kerngen/obsolete/kerncms/z305/vmbrk.s
deleted file mode 100644
index 44d4656..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncms/z305/vmbrk.s
+++ /dev/null
@@ -1,267 +0,0 @@
-*
-* $Id: vmbrk.s,v 1.1.1.1 1996/02/15 17:51:55 mclareni Exp $
-*
-* $Log: vmbrk.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:55 mclareni
-* Kernlib
-*
-*
-*
-* CERN PROGLIB# Z305 VMBRK .VERSION KERNCMS 1.05 910320
-* Author: L.S.Lowe - Birmingham Nov 84
-*
-#if defined(CERNLIB_QMIBMXA)
-VMBRK RMODE ANY XA
-VMBRK AMODE ANY XA
-#endif
-#if !defined(CERNLIB_QMIBMXA)
- MACRO
- EXTUAREA
-EXTUAREA DSECT
-EXTUGPRS DS 16F General registers at interrupt time
-EXTUFRS DS 4D Floating point registers at interrupt time
-EXTUPSW DS 1D External Old PSW at interrupt time
- MEND
-#endif
-VMBRK CSECT
-*
-* CALL VMBRK(0) clears traps
-* CALL VMBRK(1,iflagv,itime) sets trap, clears iflagv, set timer if >0
-* CALL VMBRK(2) increment trap inhibit level
-* CALL VMBRK(3) decrement trap inhibit level
-* CALL VMBRK(4,igetv) gets current value of iflagv
-* CALL VMBRK(5,iset) sets new current value of iflagv
-*
-* This routine allows a program to trap an event such as an immediate
-* command BREAK entered, a time expiration, or a software event.
-*
-* Because a change in program flow is most easily achieved in CMS
-* when in an external interrupt exit, because this exit has access
-* to the user's registers and PSW, we arrange that an event causes
-* an external interrupt to be stacked using CP. When the interrupt
-* is taken, the external exit handles the change in program flow.
-*
-* When changing program flow, we have to ensure that the code we are
-* interrupting is user code at the same SVC level as the user program.
-*
-* The programmer should bear in mind that code optimisation can mean
-* that variable values are carried around in registers rather than
-* storage. Variables in the routine which sets the trap may not reflect
-* their latest value if and when a trap occurs. Note that variables
-* that reside in Common always contain their latest values when a call
-* to another routine is made.
-*
-* Author: L.S.Lowe, Birmingham, Nov 84. 021-414-4621.
-* Consult author before making external changes to this routine.
-*
-* Updated LSL 24 Jun 85 to run under MVS and in 370E as well as CMS.
-* Updated LSL 29 Aug 89 to remove checks for Fortran I/O
-* Updated LSL 29 Aug 89 to run under CMS 5.5 as well as other releases
-* Updated LSL 19 Nov 90 changes for 370/XA and 24/31 amode.
-* Updated LSL 20 Nov 90 to use specific HNDEXT, and use EXTUAREA dsect.
-* Updated LSL 22 Mar 91 to avoid issuing messages during external exit.
-* Updated LSL 25 Mar 91 to avoid replacing program mask in BC mode.
-*
- USING *,R12
- USING NUCON,0
- SAVE (14,12),,* SAVE REGS
- STM R0,R15,PTEMP-VMBRK(R15) KEEP REGS
- LR R12,R15 GET LOCAL BASE
- LM R2,R4,0(R1) PICK UP ARGUMENT ADDRESSES
- L R2,0(,R2) LOAD OPTION
- CL R2,=F'5' CHECK OPTION IS IN RANGE
- BH PBREXIT EXIT IF INVALID
- SLL R2,2 OPTION TIMES 4
- B *+4(R2) BRANCH ON OPTION
- B PBRCLR 0 - CLEAR
- B PBRSET 1 - SET
- B PBRINH 2 - INHIBIT
- B PBRUNH 3 - UNINHIBIT
- B PBRGET 4 - GET FLAG
- B PBRPUT 5 - PUT FLAG AND CHECK BREAK
-*
-PBRCLR TM PINIT,X'40' CHECK IF IMMCMD IS SET
- BZ PBRCLRA NO - JUMP
-#if defined(CERNLIB_QMIBMXA)
- HNDEXT CLR,CODE=0040 CLEAR EXTERNAL EXIT
-#endif
-#if !defined(CERNLIB_QMIBMXA)
- HNDEXT CLR CLEAR EXTERNAL EXIT
-#endif
- IMMCMD CLR,NAME='BREAK' CLEAR THE IMMEDIATE COMMAND
-PBRCLRA TM PINIT,X'20' CHECK IF TIMER WAS SET
- BZ PBRCLRB NO - JUMP
- TTIMER CANCEL CLEAR THE TIMER EXIT
-PBRCLRB TM PINIT,X'01' TEST BREAK-BYPASSED FLAG
- BZ PBRCLRX NOT SET - JUMP
-#if defined(CERNLIB_QMIBMXA)
- APPLMSG TEXT='VMBRK warning: one or more breaks were ignored w*
- hile system code was executing',APPLID=XYZ
-#endif
-#if !defined(CERNLIB_QMIBMXA)
- LINEDIT TEXT='VMBRK warning: one or more breaks were ignored w*
- hile system code was executing',DOT=NO
-#endif
-PBRCLRX MVI PINIT,X'00' CLEAR FLAGS
- B PBREXIT AND EXIT
-*
-PBRSET MVC 0(4,R3),=F'0' CLEAR FLAG TO ZERO
- ST R3,PFLAGAD KEEP POINTER TO USER'S FLAG
- MVC PKEEP(64),PTEMP KEEP REGISTERS ON ENTRY
- ZAP PINHIBIT,=P'0' CLEAR INHIBIT LEVEL
- OI PINIT,X'80' INDICATE TRAP IS ENABLED
- L R1,CVTPTR PICK UP CVT POINTER
- TM CVTDCB(R1),CVTCMS CHECK FOR CMS
- BZ PBREXIT NO - BYPASS IMMCMD AND STIMER
- TM BATFLAGS,X'80' ARE WE IN ORDINARY IBM CMSBATCH
- BO PBREXIT YES - BYPASS IMMCMD AND STIMER
- L R5,ASVCSECT PICK UP SVCSECT ADDR FROM NUCON
- MVC PDEPTH,DEPTH-SVCSECT(R5) KEEP CURRENT CMS SVC DEPTH
-#if defined(CERNLIB_QMIBMXA)
- HNDEXT SET,PEXT,CODE=0040 SET THE EXTERNAL EXIT
-#endif
-#if !defined(CERNLIB_QMIBMXA)
- HNDEXT SET,PEXT SET THE EXTERNAL EXIT
-#endif
- IMMCMD SET,NAME='BREAK',EXIT=PIMM SET THE IMMMEDIATE COMMAND
- OI PINIT,X'40' INDICATE IMMCMD IS SET
-PBRSETT ICM R0,15,0(R4) CHECK FOR A STIMER TIMER VALUE
- BNP PBREXIT NO - JUMP
- STIMER TASK,PTIM,BINTVL=(R4) SET TIMER EXIT
- OI PINIT,X'20' INDICATE TIMER IS SET
- B PBREXIT INITIALISED - EXIT
-*
-PBRINH TM PINIT,X'80' CHECK THAT TRAP IS ENABLED
- BZ PBREXIT IGNORE IF NOT
- AP PINHIBIT,=P'1' INCREMENT INHIBIT LEVEL
- B PBRCHEX EXIT VIA TRAP CHECK
-*
-PBRUNH TM PINIT,X'80' CHECK THAT TRAP IS ENABLED
- BZ PBREXIT IGNORE IF NOT
- SP PINHIBIT,=P'1' DECREMENT INHIBIT LEVEL
- B PBRCHEX EXIT VIA TRAP CHECK
-*
-PBRGET TM PINIT,X'80' CHECK THAT TRAP IS ENABLED
- BZ PBREXIT IGNORE IF NOT
- L R6,PFLAGAD PICK UP USER'S FLAG ADDR
- MVC 0(4,R3),0(R6) SET USER ARG FROM FLAG VALUE
- B PBRCHEX EXIT VIA TRAP CHECK
-*
-PBRPUT TM PINIT,X'80' CHECK THAT TRAP IS ENABLED
- BZ PBREXIT IGNORE IF NOT
- L R6,PFLAGAD PICK UP USER'S FLAG ADDR
- MVC 0(4,R6),0(R3) SET FLAG FROM USER ARG
- B PBRCHEX EXIT VIA TRAP CHECK
-*
-PBRCHEX CP PINHIBIT,=P'0' CHECK INHIBIT LEVEL
- BH PBREXIT NORMAL EXIT IF TRAP INHIBITED
- L R6,PFLAGAD PICK UP USER'S FLAG ADDR
- ICM R0,R15,0(R6) CHECK VALUE
- BZ PBREXIT NORMAL EXIT IF ZERO
- NI PINIT,255-X'01' CLEAR BREAK-BYPASSED FLAG
- LM R0,R14,PKEEP LOAD ORIGINAL CALL REGISTERS
- SR R15,R15 CLEAR RETURN CODE
- BR R14 TRAP TO ORIGINAL CALL POINT
-*
-PBREXIT RETURN (14,12),T,RC=0 NORMAL RETURN TO CALLER
- DROP R12
-*
-* This closed routine is entered if the timer interval expires.
-* An External interrupt is stacked in order to provoke a trap.
-*
-* Aug 89: this routine no longer uses the code of the external
-* interrupt routine, because the stimer exit does not now use
-* the register conventions of an external exit (CMS 5.5).
-*
-PTIM DS 0H
- USING *,R12
- SAVE (14,12) SAVE REGS
- LR R12,R15 GET BASE REG
- L R3,PFLAGAD PICK UP FLAG ADDRESS
- MVC 0(4,R3),=F'1' SET FLAG TO 1 FOR TIMER
- LM R6,R7,PCPREGS GET REGS FOR CP COMMAND
- DIAG R6,R7,X'0008' STACK AN EXTERNAL INTERRUPT
- RETURN (14,12),T,RC=0 RETURN TO SYSTEM
-*
-* This closed routine is entered if the user enters a BREAK command.
-* An External interrupt is stacked in order to provoke a trap.
-*
-PIMM DS 0H
- USING *,R12
- SAVE (14,12) SAVE REGS
- LR R12,R15 GET BASE REG
- L R3,PFLAGAD PICK UP FLAG ADDRESS
- MVC 0(4,R3),=F'2' SET FLAG TO 2 FOR IMMCMD
- LM R6,R7,PCPREGS GET REGS FOR CP COMMAND
- DIAG R6,R7,X'0008' STACK AN EXTERNAL INTERRUPT
- RETURN (14,12),T,RC=0 RETURN TO SYSTEM
-*
-* This closed routine is entered when an external interrupt is
-* received. If the trap is possible, the registers and PSW are
-* modified in order to provoke a return to the trapping point.
-*
-* To cater for various CMS environments, we allow a PSW format of
-* BC mode, XA with AMODE 24 (similar to EC mode), or XA with AMODE 31.
-* We also allow for the original call of this routine to be via a BALR
-* or via a BASR instruction, or indeed from a BR with R14 preset. This
-* means that for BC or XA/24 we can't rely on contents of R14 byte 0,
-* and so we don't modify PSW byte 4 (ILC/CC/PM for BC, 0 for XA/24).
-* Note: an external exit is called in the same AMODE as at HNDEXT SET.
-*
-PEXT DS 0H
- USING *,R12
- USING EXTUAREA,R2
- SAVE (14,12) SAVE REGS
- LR R12,R15 COPY BASE REG
- LR R2,R1 COPY PARM REG
- L R3,PFLAGAD PICK UP USER FLAG ADDRESS
- CLC 0(4,R3),=F'0' SEE IF FLAG IS ALREADY SET
- BNE PEXTCHI JUMP IF YES
- MVC 0(4,R3),=F'2' SET FLAG TO 2 FOR EXTERNAL
-PEXTCHI DS 0H
- CP PINHIBIT,=P'0' CHECK INHIBIT LEVEL
- BH PEXTRET RETURN IF TRAPS ARE INHIBITED
- L R5,ASVCSECT PICK UP SVCSECT ADDR FROM NUCON
- CLC PDEPTH,DEPTH-SVCSECT(R5) CHECK CURRENT SVC DEPTH
- BNE PEXTSYS JUMP IF DIFFERENT SVC LEVEL
- TM EXTUPSW+0,X'03' CHECK FOR USER MASK IN PSW
- BNO PEXTSYS JUMP IF NOT NORMAL ENABLES
- TM EXTUPSW+1,X'E0' CHECK FOR USER KEY IN PSW
- BNO PEXTSYS JUMP IF NOT IN USER PROTECT
- TM EXTUPSW+1,X'10' CHECK FOR USER KEY IN PSW
- BO PEXTSYS JUMP IF NOT IN USER PROTECT
-* OK, so set up the registers and PSW to return after original call.
- NI PINIT,255-X'01' CLEAR BREAK-BYPASSED FLAG
- MVC EXTUGPRS(60),PKEEP COPY KEPT REGISTERS TO EXT AREA
- MVC EXTUGPRS+60(4),=F'0' SET USER'S R15 TO ZERO
- LA R3,1 AMODE CHECK: MAKE AN
- SLL R3,24 ADDR WHICH IS OUTSIDE 24 BITS
- LA R3,0(,R3) LOAD THIS ADDR IN USER'S AMODE
- LTR R3,R3 AND SEE WHAT HAPPENED
- BNZ PEXTAM31 JUMP IF AMODE 31
-PEXTAM24 MVC EXTUPSW+5(3),PKEEP+57 SET 24-BIT ADDR FROM ORIG R14
- B PEXTRET RETURN FROM INTERRUPT
-PEXTAM31 MVC EXTUPSW+4(4),PKEEP+56 SET 31-BIT ADDR FROM ORIG R14
- OI EXTUPSW+4,X'80' ENSURE NEW PSW HAS AMODE 31
- B PEXTRET RETURN FROM INTERRUPT
-PEXTSYS OI PINIT,X'01' SET BREAK-BYPASSED FLAG
-PEXTRET RETURN (14,12),T,RC=0 RETURN TO SYSTEM
- DROP R2
-*
-CVTPTR EQU X'10',4
-CVTDCB EQU X'74',4
-CVTCMS EQU X'40'
-PCPREGS DC A(PCPCMND,L'PCPCMND)
-PCPCMND DC C'EXTERNAL'
-PINIT DC X'00'
-PINHIBIT DC PL7'0'
-PDEPTH DC F'0'
-PFLAGAD DC F'0'
-PTEMP DC 16F'0'
-PKEEP DC 16F'0'
- LTORG
- NUCON
- SVCSECT
- EXTUAREA
- REGEQU
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncms/z305/vmcms.s b/src/packlib/kernlib/kerngen/obsolete/kerncms/z305/vmcms.s
deleted file mode 100644
index 1bdb639..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncms/z305/vmcms.s
+++ /dev/null
@@ -1,177 +0,0 @@
-*
-* $Id: vmcms.s,v 1.1.1.1 1996/02/15 17:51:54 mclareni Exp $
-*
-* $Log: vmcms.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:54 mclareni
-* Kernlib
-*
-*
-VMCMS CSECT
-#if defined(CERNLIB_QMIBMXA)
-VMCMS AMODE ANY
-VMCMS RMODE ANY
-#endif
-*
-* CERN PROGLIB# Z305 VMCMS .VERSION KERNIBM 2.17 860131
-* ORIG. 01/12/85 RM
-*
-* REFER TO CERN PROGRAM LIBRARY MEMBER Z305 FOR DETAILS
-*
-* M O D I F I C A T I O N L O G
-* ===============================
-*
-*
-* 2 . 0 1
-*
-* Adapted for XA: uses the documented SCAN macro and then
-* CMSCALL to issue the command.
-*
-* 14th April 1989 Tony Cass CERN/DD
-*
-* 2 . 0 0
-*
-* THIS VERSION USES A DIRECT INTERFACE TO CMS VIA SVC 202 WITH AN R1
-* HIGH-ORDER BYTE VALUE OF X'01', ('ADDRESS COMMAND'), IN PLACE OF
-* THE PREVIOUSLY USED SUBCOM INTERFACE. THIS TECHNIQUE ENABLES THE
-* USE OF IOS3270, WHICH USES THE VALUE X'01' TO DETERMINE WHETHER
-* EXECOMM IS AVAILABLE. THE 'ADDRESS COMMAND' FLAG REQUIRES THAT EXEC
-* NAMES AND CP COMMANDS ARE PREFIXED WITH 'EXEC' AND 'CP' RESPECTIVELY
-* WHEN THEY ARE INVOKED, AS IN REXX EXECS.
-* THE SYSTEM COMMAND SCAN ROUTINE IS CALLED TO BUILD THE PLIST AND
-* EXTENDED PLIST. THIS REQUIRES THE USE OF DMSKEY TO CHANGE THE PSW
-* KEY.
-* R. MATTHEWS, CERN/DD, JANUARY 1986.
-*
-* 1 . 0 1
-*
-* DETECTION OF JZLINIT# USED TO DETERMINE COMPILER ENVIRONMENT TO
-* ENSURE CORRECT OPERATION IN VS FORTRAN LOAD MODE.
-* R. MATTHEWS, CERN/DD, NOVEMBER 1985.
-*
-* 1 . 0 0
-*
-* ORIGINAL VERSION.
-*
-* R. MATTHEWS, CERN/DD, JULY 1985.
-*
-*********************************************************************
-*
-R0 EQU 0
-R1 EQU 1
-R2 EQU 2
-R3 EQU 3
-R4 EQU 4
-R5 EQU 5
-R6 EQU 6
-R7 EQU 7
-R8 EQU 8
-R9 EQU 9
-R10 EQU 10
-R11 EQU 11
-R12 EQU 12
-R13 EQU 13
-R14 EQU 14
-R15 EQU 15
-*
- PRINT NOGEN
-*
-* P R O L O G U E
-*
- USING VMCMS,R15
- B SAVEREGS
- DC AL1(7),CL7'VMCMS' IDENTIFIER
- DC C'2.00' VERSION.MODIFICATION LEVEL
-SAVEREGS STM R14,R12,12(R13)
- LR R4,R13
- CNOP 0,4
- BAL R13,AROUNDSA
-SAVEAREA DC A(EPILOGUE),17F'0'
- DROP R15
- USING SAVEAREA,R13
-AROUNDSA ST R13,8(0,R4)
- ST R4,4(0,R13)
- XC 8(4,R13),8(R13)
-*
- LR R11,R1 R11 -> ARGUMENT LIST
-*
-* E N S U R E T H E O P E R A T I N G S Y S T E M I S C M S
-*
- L R2,16 R2 -> CVT
- TM 116(R2),X'40' IS IT CMS ?
- BNO ERROR1 NO, BRANCH
-*
-* G E T T H E C O M M A N D A N D I T S L E N G T H
-*
- LR R2,R11 R2 -> ARGUMENT LIST
- S R2,=F'4' R2 -> ARGUMENT LIST PREFIX
- L R2,0(0,R2) R2 := ARGUMENT LIST PREFIX
- L R0,VJZLINIT R0 := ADDRESS OF JZLINIT#
- LTR R0,R0 IS IT PRESENT ?
- BNZ FUJITSU YES, BRANCH
-*
- AR R2,R11 R2 -> SECONDARY ARGUMENT LIST
- L R2,0(0,R2) R2 -> COMMAND LENGTH
- L R0,0(0,R2) R0 := COMMAND LENGTH
- B DOCMD
-*
-FUJITSU LH R0,0(0,R2) R0 := COMMAND LENGTH
-*
-* B U I L D T H E P L I S T A N D T H E E P L I S T
-*
-DOCMD EQU *
-#if !defined(CERNLIB_QMIBMXA)
- L R1,0(0,R11) R1 -> COMMAND
- USING NUCON,0
- DMSKEY NUCLEUS
- L R15,ASCANN
- BALR R14,R15
- DMSKEY RESET
-*
-* I S S U E T H E C O M M A N D
-*
- LA R0,NUCPLIST R0 -> EXTENDED PLIST
- ICM R1,B'1000',=X'01' INSERT THE 'ADDRESS COMMAND' FLAG
- SVC 202 ISSUE THE COMMAND
- DC AL4(1)
-#endif
-#if defined(CERNLIB_QMIBMXA)
- L R7,0(,R11)
- LR R8,R0
- SCAN TEXT=((R7),(R8)),BUFFER=(SCANBUFF,512)
- CMSCALL PLIST=(R1),EPLIST=(R0)
-#endif
- L R2,4(0,R11) R2 -> SECOND ARGUMENT
- ST R15,0(0,R2) STORE THE RETURN CODE
- B EPILOGUE
-*
-* E R R O R P R O C E S S I N G
-*
-ERROR1 WTO MF=(E,WTOLIST1)
- ABEND 999,DUMP
-*
-* E P I L O G U E
-*
-EPILOGUE EQU *
- L R13,4(0,R13)
- L R14,12(0,R13)
- LM R2,R12,28(R13)
- MVI 12(R13),X'FF'
- BR R14
-*
-* D A T A A R E A S
-*
- WXTRN JZLINIT#
-VJZLINIT DC A(JZLINIT#)
-*
-WTOLIST1 WTO 'CRNVM999 VMCMS: THE OPERATING SYSTEM IS NOT CMS', &
- ROUTCDE=(11),DESC=(6),MF=L
-*
-#if defined(CERNLIB_QMIBMXA)
-SCANBUFF DS 128F
-*
-#endif
- LTORG
-*
- NUCON
-*
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncms/z305/vmqfil.s b/src/packlib/kernlib/kerngen/obsolete/kerncms/z305/vmqfil.s
deleted file mode 100644
index f661860..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncms/z305/vmqfil.s
+++ /dev/null
@@ -1,119 +0,0 @@
-*
-* $Id: vmqfil.s,v 1.1.1.1 1996/02/15 17:51:55 mclareni Exp $
-*
-* $Log: vmqfil.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:55 mclareni
-* Kernlib
-*
-*
-#if defined(CERNLIB_QMIBMXA)
-VMQFIL AMODE ANY
-VMQFIL RMODE ANY
-#endif
-VMQFIL CSECT
-* Obtain details on input file. Returns recfm, lrecl, nrecs, nblocks
-* date, time and status.
-* J.D. Shiers CN/AS/PA July 1990
-R0 EQU 0
-R1 EQU 1
-R2 EQU 2
-R3 EQU 3
-R4 EQU 4
-R5 EQU 5
-R6 EQU 6
-R7 EQU 7
-R8 EQU 8
-R9 EQU 9
-R10 EQU 10
-R11 EQU 11
-R12 EQU 12
-R13 EQU 13
-R14 EQU 14
-R15 EQU 15
-*
- PRINT NOGEN
-*
-* P R O L O G U E
-*
- USING VMQFIL,R15
- B SAVEREGS
- DC AL1(7),CL7'VMQFIL' IDENTIFIER
- DC C'1.00' VERSION.MODIFICATION LEVEL
-SAVEREGS STM R14,R12,12(R13)
- LR R4,R13
- CNOP 0,4
- BAL R13,AROUNDSA
-SAVEAREA DC A(EPILOGUE),17F'0'
- DROP R15
- USING SAVEAREA,R13
-AROUNDSA ST R13,8(0,R4)
- ST R4,4(0,R13)
- XC 8(4,R13),8(R13)
-*
-* CALL VMQFIL(fn,recfm,lrecl,nrecs,nblocks,chdate,istat,irc)
-*
- LM R2,R9,0(R1) R2->FN,,,R9->IRC
- LR R12,R1
- S R12,=F'4'
- L R12,0(,R12)
- AR R12,R1
- L R12,0(,R12)
- L R12,0(,R12) Length of first argument
-*
-QFILE EQU *
- LA R10,FILENAME Address of filename
- LA R11,FILETYPE Address of filetype
- MVC 0(20,R10),10(R11) Blank filename
-COMPARE CLI 0(R2),C' ' Look for a blank
- BE NEXT Next field
-MOVE MVC 0(1,R10),0(R2) Move this character over
- LA R2,1(R2) Increment by one character
- LA R10,1(R10) Same for output buffer
- S R12,=F'1' Countdown length of input string
- LTR R12,R12 Have we reached the end?
- BZ THEBIZZO Yes, do the bizzo...
- B COMPARE No, go and compare next characte
-*
-NEXT EQU * Last character was a blank
- CR R10,R11 Trailing blanks?
- BH THEBIZZO
- LA R2,1(R2) Increment pointer
- S R12,=F'1' and decrease length counter
- LTR R12,R12 Have we reached end of string?
- BZ THEBIZZO Yes
- CLI 0(R2),C' ' Look for the next non-blank
- BE NEXT
- LR R10,R11 Address of next field
- LA R11,FILEMODE Address of field after that
- B MOVE Go back and move last character
-THEBIZZO EQU *
- LA R2,FILENAME
-*
- FSSTATE (R2),FSCB=TESTFSCB
- LH R10,26(0,R1) NRECORDS
- ST R10,0(R5)
- FSSTATE (R2),FSCB=TESTFSCB,FORM=E
-* R1->File Status Table (FST)
- MVC 0(1,R3),30(R1) RECFM (F/V)
- MVC 0(4,R4),32(R1) LRECL
- MVC 0(4,R6),44(R1) NBLOCKS
- LA R10,DATE Buffer for date
- UNPK 0(13,R10),54(7,R1) Unpack to 13 byte field
- MVC 0(12,R7),0(R10) Move back to user's area
- MVC 0(1,R8),31(R1) ISTAT
- ST R15,0(,R9) RETURN CODE
-*
-EPILOGUE EQU *
- L R13,4(0,R13)
- L R14,12(0,R13)
- LM R2,R12,28(R13)
- MVI 12(R13),X'FF'
- BR R14
- DS 0D
-TESTFSCB FSCB
-FILENAME DC 8C' '
-FILETYPE DC 8C' '
-FILEMODE DC 2C' '
-BLANK20 DC 20C' '
-DATE DS 13C
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncms/z305/vmrexx.s b/src/packlib/kernlib/kerngen/obsolete/kerncms/z305/vmrexx.s
deleted file mode 100644
index 294259e..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncms/z305/vmrexx.s
+++ /dev/null
@@ -1,679 +0,0 @@
-*
-* $Id: vmrexx.s,v 1.1.1.1 1996/02/15 17:51:55 mclareni Exp $
-*
-* $Log: vmrexx.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:55 mclareni
-* Kernlib
-*
-*
-VMREXX CSECT
-#if defined(CERNLIB_QMIBMXA)||defined(CERNLIB_QCMS6)
-VMREXX AMODE ANY
-VMREXX RMODE ANY
-#endif
-*
-* CERN PROGLIB# Z305 VMREXX .VERSION KERNIBM 2.24 880809
-* ORIG. 01/12/85 RM
-*
-* REFER TO CERN PROGRAM LIBRARY MEMBER Z305 FOR DETAILS
-*
-* M O D I F I C A T I O N L O G
-* ===============================
-*
-* 3.00 Version for XA capable REXX in CMS 7.
-* The code is essentially that from -QMIBMXA changed to use the
-* APPLMSG macro and SVC 204.
-* Tony Cass, CERN/DD, July 1991.
-*
-* 2.01 Fix a bug in the code for function 'N' in QMIBMXA and -QMIBMXA
-* versions
-*
-* 2.00 Rewritten for XA:users a buffer in 24bit addressable memory for
-* interface to REXX; responses are copied to user (flagged v1.04)
-* Tony Cass, CERN/DD, May 1989.
-*
-* 1.03 Code for functions 'A' and 'B' improved - number in stem.0
-* no longer needs to be left-justified.Code also slightly faster.
-* Tony Cass, CERN/DD, July 1988.
-*
-* 1.02 Stem variable set and fetch functions added
-* with new function codes 'A' and 'B'
-* Tony Cass, CERN/DD, March 1988.
-*
-* 1.01 DETECTION OF JZLINIT# USED TO DETERMINE COMPILER ENVIRONMENT TO
-* ENSURE CORRECT OPERATION IN VS FORTRAN LOAD MODE.
-* R. MATTHEWS, CERN/DD, NOVEMBER 1985.
-*
-* 1.00 ORIGINAL VERSION.
-* R. MATTHEWS, CERN/DD, JULY 1985.
-*
-*********************************************************************
-*
-R0 EQU 0
-R1 EQU 1
-R2 EQU 2
-R3 EQU 3 -> Return code
-R4 EQU 4 -> name portion of acquired storage
-R5 EQU 5
-R6 EQU 6 -> buffer portion of acquired storage
-R7 EQU 7
-R8 EQU 8 -> caller's name
-R9 EQU 9 Len(caller's name)
-R10 EQU 10 -> caller's buffer
-R11 EQU 11 LEN(caller's buffer)
-R12 EQU 12 -> SHVBLOCK
-R13 EQU 13 Base
-R14 EQU 14 Holds #bytes acquired by CMSSTOR
-R15 EQU 15 Linkage
-*
- PRINT NOGEN
-*
-* P R O L O G U E
-*
- USING VMREXX,R15
- B SAVEREGS
- DC AL1(7),CL7'VMREXX' IDENTIFIER
- DC C'3.00' VERSION.MODIFICATION LEVEL
-SAVEREGS STM R14,R12,12(R13)
- LR R4,R13
- CNOP 0,4
- BAL R13,AROUNDSA
-SAVEAREA DC A(EPILOGUE),17F'0'
- DROP R15
- USING SAVEAREA,R13
-AROUNDSA ST R13,8(0,R4)
- ST R4,4(0,R13)
- XC 8(4,R13),8(R13)
-*
-#if !defined(CERNLIB_QMIBMXA)||defined(CERNLIB_QCMS6)
- LR R11,R1 R11 -> ARGUMENT LIST
-#endif
-#if (defined(CERNLIB_QMIBMXA))&&(!defined(CERNLIB_QCMS6))
- USING SHVBLOCK,R12
-#endif
-*
-* E N S U R E T H E O P E R A T I N G S Y S T E M I S C M S
-*
- L R2,16 R2 -> CVT
- TM 116(R2),X'40' IS IT CMS ?
- BNO ERROR1 NO, BRANCH
-#if (defined(CERNLIB_QMIBMXA))&&(!defined(CERNLIB_QCMS6))
-*
-* P R O C E S S T H E A R G U M E N T L I S T
-*
- L R3,12(,R1) R3 = Return Code address
- LM R7,R9,0(R1)
- LR R10,R9
- LR R5,R1 R5 -> ARGUMENT LIST
- S R5,=F'4' R5 -> ARGUMENT LIST PREFIX
- L R5,0(0,R5) R5 := ARGUMENT LIST PREFIX
- L R0,VJZLINIT R0 := ADDRESS OF JZLINIT#
- LTR R0,R0 IS IT PRESENT ?
- BNZ FUJITSU YES, BRANCH
-*
- AR R5,R1 R5 -> SECONDARY ARGUMENT LIST
- LM R5,R6,4(R5) R5 -> NAME LEN; R6 -> BUFFER/VALUE LEN
- L R9,0(0,R5) R9 := NAME LENGTH
- L R11,0(0,R6) R10 := BUFFER/VALUE LENGTH
- B SHVBMAKE
-*
-FUJITSU LH R9,2(0,R5) R4 := NAME LENGTH
- LH R11,4(0,R5) R3 := BUFFER/VALUE LENGTH
-#endif
-*
-* C O N S T R U C T T H E S H V B L O C K
-*
-#if !defined(CERNLIB_QMIBMXA)||defined(CERNLIB_QCMS6)
- LA R10,SHVB1 R10 -> SHVBLOCK
- USING SHVBLOCK,R10 MAKE IT ADDRESSABLE USING R10
- MVI SHVBLOCK,0 ZERO IT...
- MVC SHVBLOCK+1(SHVBLEN-1),SHVBLOCK
- LM R2,R4,0(R11) R2 -> CODE; R3 -> NAME; R4 -> BUFFER/VAL
- MVC SHVCODE,0(R2) MOVE THE FUNCTION CODE INTO THE SHVBLOCK
- ST R3,SHVNAMA STORE THE NAME POINTER
- ST R4,SHVVALA STORE THE BUFFER/VALUE POINTER
- LR R5,R11 R5 -> ARGUMENT LIST
- S R5,=F'4' R5 -> ARGUMENT LIST PREFIX
- L R5,0(0,R5) R5 := ARGUMENT LIST PREFIX
- L R0,VJZLINIT R0 := ADDRESS OF JZLINIT#
- LTR R0,R0 IS IT PRESENT ?
- BNZ FUJITSU YES, BRANCH
-*
- AR R5,R11 R5 -> SECONDARY ARGUMENT LIST
- LM R5,R6,4(R5) R5 -> NAME LEN; R6 -> BUFFER/VALUE LEN
- L R5,0(0,R5) R5 := NAME LENGTH
- L R6,0(0,R6) R6 := BUFFER/VALUE LENGTH
- B STORELEN
-*
-FUJITSU LH R6,4(0,R5) R6 := BUFFER/VALUE LENGTH
- LH R5,2(0,R5) R5 := NAME LENGTH
-*
-STORELEN ST R5,SHVNAML STORE THE NAME LENGTH
- ST R5,SHVUSER .
- ST R6,SHVVALL STORE THE VALUE LENGTH
- ST R6,SHVBUFL STORE THE BUFFER LENGTH
-*
- CLI SHVCODE,C'A' IS THE FUNCTION CODE 'A' ?
- BE STEM YES, BRANCH
- CLI SHVCODE,C'B' IS THE FUNCTION CODE 'B' ?
- BE STEM YES, BRANCH
- CLI SHVCODE,C'F' IS THE FUNCTION CODE 'F' ?
- BE FETCH YES, BRANCH
-*
-* The function code 'f' in the next line MUST be in lowercase
-*
- CLI SHVCODE,C'f' IS THE FUNCTION CODE 'f' ?
- BE FETCH YES, BRANCH
- CLI SHVCODE,C'N' IS THE FUNCTION CODE 'N' ?
- BNE DOCMD NO, BRANCH
- S R5,=F'2' ADJUST THE NAME LENGTH FOR USE IN MVC
- MVI 0(R3),C' ' BLANK THE NAME FOR FUNCTION CODE 'N'
- EX R5,CLRNAME .
- B FETCH
-*
-CLRBUFF MVC 1(*-*,R4),0(R4)
-CLRNAME MVC 1(*-*,R3),0(R3)
-*
-FETCH S R6,=F'2' ADJUST THE BUFFER LENGTH FOR USE IN MVC
- MVI 0(R4),C' ' BLANK THE BUFFER FOR FUNCTION CODE 'F'
- EX R6,CLRBUFF .
-#endif
-#if (defined(CERNLIB_QMIBMXA))&&(!defined(CERNLIB_QCMS6))
-SHVBMAKE LR R14,R9
- AR R14,R11 Add name + value lengths and SHVBLOCK
- LA R14,SHVBLEN(,R14) length to find storage needed
- CMSSTOR OBTAIN,BYTES=(R14),LOC=BELOW
- LR R12,R1 R12 -> SHVBLOCK
- ST R12,ASHVB Store address in EPLIST
- XC SHVBLOCK(SHVBLEN),SHVBLOCK Zero it...
- MVC SHVCODE,0(R7) Move the function code into the SHVBLOCK
- LA R4,32(R1) This is the address of the name
- ST R4,SHVNAMA store it in the SHVBLOCK
- LA R6,0(R9,R4) This is the address of the value buffer
- ST R6,SHVVALA store it in the SHVBLOCK
- ST R9,SHVNAML Store the name length
- ST R9,SHVUSER here as well for code 'N'
- ST R11,SHVBUFL Store the buffer length
- ST R11,SHVVALL and store it as Value length for set
-*
- CLI SHVCODE,C'A' Is the function code 'A' ?
- BE STEM Yes, branch
- CLI SHVCODE,C'B' Is the function code 'B' ?
- BE STEM Yes, branch
-#endif
-*
-* I S S U E T H E C O M M A N D
-*
-#if (defined(CERNLIB_QMIBMXA))&&(!defined(CERNLIB_QCMS6))
- STM R5,R11,MVCLSAVE Protect the registers
- LR R5,R9
- MVCL R4,R8 Move the name below 16MB
- LR R7,R11
- MVCL R6,R10 Move buffer contents below 16MB
- LM R5,R11,MVCLSAVE and now restore them
-*
-#endif
-#if !defined(CERNLIB_QMIBMXA)||defined(CERNLIB_QCMS6)
-DOCMD EQU *
- LA R0,EPLIST R0 -> EXTENDED PLIST
- LA R1,PLIST R1 -> PLIST
-#endif
-#if !defined(CERNLIB_QMIBMXA)
- ICM R1,B'1000',=X'02' INSERT THE 'SUBCOMMAND CALL' FLAG
- SVC 202 ISSUE THE COMMAND
- DC AL4(1)
-#endif
-#if defined(CERNLIB_QCMS6)
- L R15,=X'0200B000'
- SVC 204 ISSUE THE COMMAND
-#endif
-#if !defined(CERNLIB_QMIBMXA)||defined(CERNLIB_QCMS6)
- L R2,12(0,R11) R2 -> SECOND ARGUMENT
- ST R15,0(0,R2) STORE THE RETURN CODE
- LTR R15,R15 R15 := 0 ?
- BNZ EPILOGUE NO, RETURN
- IC R15,SHVRET R15 := RETURN CODE FROM THE SHVBLOCK
- ST R15,0(0,R2) STORE IT
- B EPILOGUE
-#endif
-#if (defined(CERNLIB_QMIBMXA))&&(!defined(CERNLIB_QCMS6))
- LA R0,EPLIST R0 -> EXTENDED PLIST
- LA R1,PLIST R1 -> PLIST
- L R15,=X'0200B000'
- SVC 204 ISSUE THE COMMAND
- ST R15,0(0,R3) STORE THE RETURN CODE
- LTR R15,R15 R15 := 0 ?
- BNZ DROPMEM NO, RETURN
- IC R15,SHVRET R15 := RETURN CODE FROM THE SHVBLOCK
- ST R15,0(0,R3) STORE IT
- OI SHVCODE,X'F0' Force upper case function
- CLI SHVCODE,C'S' Set?
- BE DROPMEM Yup, finished
- CLI SHVCODE,C'D' Drop?
- BE DROPMEM Yup, finished
- L R7,SHVVALL Length of value returned
- ICM R7,B'1000',=C' ' Pad with blanks
- MVCL R10,R6 Move back to user
- CLI SHVCODE,C'N' Fetching variable names too?
- BNE DROPMEM No, finished
- L R5,SHVNAML Length of name returned
- ICM R5,B'1000',=C' ' Pad with blanks
- MVCL R8,R4 Move name back to user
-DROPMEM CMSSTOR RELEASE,BYTES=(R14),ADDR=(R12)
- B EPILOGUE
-#endif
-*
-* S T E M F E T C H / S T O R E F U N C T I O N S
-*
-#if !defined(CERNLIB_QMIBMXA)||defined(CERNLIB_QCMS6)
-MOVENAME MVC STEMBUFF(*-*),0(R3)
-MOVESUBS MVC 0(*-*,R2),LEOUT+1
-*
-STEM S R5,=F'1' FOR MVC
- EX R5,MOVENAME MOVE NAME INTO MY BUFFER
- LA R3,STEMBUFF
- ST R3,SHVNAMA AND POINT THERE IN SHVBLOCK
- LA R5,1(R5) REAL LENGTH
- LA R2,0(R5,R3) NEXT FREE CHARACTER IN STEMBUFF
- MVI 0(R2),C'0' STEM.0 HOLDS NUMBER OF ELEMENTS
- LA R1,1(R5) NEW LENGTH WITH SUBSCRIPT
- ST R1,SHVNAML STORE IT
- ST R1,SHVUSER
-*
- LA R3,0 DON'T NEED R3 AS POINTER ANYMORE
- CLI SHVCODE,C'B' SO USE IT AS FLAG TO
- BNE GETZERO CHOOSE BETWEEN
- LA R3,1 FETCH AND SET FUNCTIONS
-GETZERO MVI SHVCODE,C'F'
-*
- LA R9,ZEROBUFF BUFFER FOR FIRST FETCH
- ST R9,SHVVALA STORE
- LA R1,9 9 DIGITS SO NO PROBLEMS WITH CVB
- ST R1,SHVBUFL STORE
-*
- LA R0,EPLIST R0 -> EXTENDED PLIST
- LA R1,PLIST R1 -> PLIST
-#endif
-#if defined(CERNLIB_QCMS6)
- L R15,=X'0200B000'
- STM R15,R1,CALLREGS Makes life easier...
-*
- L R14,12(0,R11) REMEMBER ADDRESS OF RETURN CODE
-*
- SVC 204 ISSUE THE COMMAND
-#endif
-#if !defined(CERNLIB_QMIBMXA)
- ICM R1,B'1000',=X'02' INSERT THE 'SUBCOMMAND CALL' FLAG
-*
- L R14,12(0,R11) REMEMBER ADDRESS OF RETURN CODE
- LR R11,R0 KEEP R0 AND R1 FOR USE BY SVC202
- LR R12,R1 AS THEY ARE DESTROYED BY LINEDIT
-*
- SVC 202 ISSUE THE COMMAND
- DC AL4(1)
-#endif
-#if !defined(CERNLIB_QMIBMXA)||defined(CERNLIB_QCMS6)
- LTR R15,R15 CHECK RETURN CODE
- BZ SHVCHECK
- ST R15,0(R14) PROBLEMS WITH EXECCOMM
- B EPILOGUE
-SHVCHECK ICM R15,B'0001',SHVRET
- BZ NUMCHECK
- ST R15,0(R14) PROBABLY BAD VARIABLE NAME
- B EPILOGUE
-*
-* CHANGE LEFT ADJUSTED STRING FROM FETCH TO RIGHT ADJUSTED
-* IN PCVBUFF FOR PACK AND CVB. FETCH SETS LENGTH OF STRING RETURNED
-*
-NUMCHECK MVC PCVBUFF(10),BLANKS
- L R1,SHVVALL LENGTH OF STEM.0 SET
- S R1,=F'1' ONE LESS TO POINT AT LAST CHARACTER
- LA R7,EPCVBUFF
- SR R7,R1
-*
-COMPARE IC R8,0(R1,R9) R9 POINTS TO ZEROBUFF STILL
-*
- CLM R8,B'0001',=C' ' JUNK LEADING BLANKS
- BNE NOTBLANK
- L R8,SHVVALL BUT MAKE SURE THERE
- S R8,=F'1' WAS AT LEAST ONE
- CR R1,R8 VALID DIGIT
- BE NUMERR
- B CONVERT
-*
-NOTBLANK CLM R8,B'0001',=C'9' BUT IS
- BH NUMERR IT A
- CLM R8,B'0001',=C'0' VALID
- BL NUMERR DIGIT?
-*
- STC R8,0(R1,R7) YES, SO MOVE IT
-*
-NEXT S R1,=F'1' ALTER POINTER FOR NEXT CHARACTER
- BNM COMPARE AND ON WE GO
-*
-CONVERT PACK PCVBUFF(10),PCVBUFF(10) ZONED TO PACKED CONVERSION
- CVB R8,CVBSTART NOW A HEX INTEGER
-*
-* NOW TO READ IN ALL THE VALUES
-*
- ST R4,SHVVALA PUT BACK REAL BUFFER ADDRESS
- ST R6,SHVBUFL AND LENGTH
- ST R6,SHVVALL AND LENGTH
- S R6,=F'2' ADJUST THE BUFFER LENGTH FOR USE IN MVC
-*
- LTR R3,R3 CHANGE OF SHVCODE
- BZ REALWORK NEEDED FOR
- MVI SHVCODE,C'S' SET FUNCTION
-*
-#endif
-#if !defined(CERNLIB_QMIBMXA)
-REALWORK LA R7,1
- LA R9,1
- MVC LEOUT(10),ZEROS ONLY FIRST TIME AS NUMBERS GET BIGGER
-*
-DOTHEM LINEDIT TEXTA=LEIN,DOT=NO,SUB=(DEC,(R7)),DISP=NONE,BUFFA=LEOUT
- SR R1,R1
-TESTLEN IC R1,LEOUT(R9) FIND OUT HOW LONG THE SUBSCRIPT IS
- LTR R1,R1
- BZ GOTLEN BY LOOKING FOR FIRST '00' BYTE
- LA R9,1(0,R9) IN LEOUT BUFFER
- B TESTLEN
-GOTLEN S R9,=F'1' SUBSCRIPT IS ONE SHORTER
- EX R9,MOVESUBS
- LA R1,0(R9,R5) LENGTH FOR EXECCOMM
- ST R1,SHVNAML STORE IT
- ST R1,SHVUSER
-*
- LTR R3,R3 CLEAR BUFFER FOR FETCH
- BNZ NOCLEAR
- MVI 0(R4),C' '
- EX R6,CLRBUFF
-*
-NOCLEAR LR R0,R11
- LR R1,R12
- SVC 202 ISSUE THE COMMAND
- DC AL4(1)
-#endif
-#if defined(CERNLIB_QCMS6)
-REALWORK LA R7,1
- LR R9,R5 Length of name including 0
- S R5,=F'1'
- LA R5,STEMBUFF(R5) R5 now points to '.' of stem
- XC 1(10,R5),1(R5) Zero stem number position
-*
-DOTHEM MVI 0(R5),X'0A' APPLMSG buffer is 10bytes long
- APPLMSG APPLID=CMS,TEXT='&&1',SUB=(DEC,(R7)), -
- BUFFA=(R5),DISP=NONE
- MVI 0(R5),C'.' Put in the stem '.'
- SR R1,R1
-TESTLEN IC R1,STEMBUFF(R9) FIND OUT HOW LONG THE SUBSCRIPT IS
- LTR R1,R1
- BZ GOTLEN BY LOOKING FOR FIRST '00' BYTE
- LA R9,1(0,R9) IN LEOUT BUFFER
- B TESTLEN
-GOTLEN ST R9,SHVNAML STORE IT
-*
- LTR R3,R3 CLEAR BUFFER FOR FETCH
- BNZ NOCLEAR
- MVI 0(R4),C' '
- EX R6,CLRBUFF
-*
-NOCLEAR LM R15,R1,CALLREGS
- SVC 204 ISSUE THE COMMAND
-#endif
-#if !defined(CERNLIB_QMIBMXA)||defined(CERNLIB_QCMS6)
-*
- LA R4,2(R6,R4) NEXT ELEMENT. 2 AS R6 CHANGED FOR EXED MVC
- ST R4,SHVVALA
- LA R7,1(0,R7)
- CR R7,R8
- BNH DOTHEM
-*
- SR R15,R15 GOT/SET THEM ALL - FORCE A
- ST R15,0(R14) ZERO RETURN CODE
-*
- B EPILOGUE
-*
-* E R R O R P R O C E S S I N G
-*
-NUMERR LA R15,16 RETURN CODE 16 MEANS THAT CONTENTS
- ST R15,0(R14) OF STEM.0 AREN'T A VALID NUMBER
- B EPILOGUE
-*
-ERROR1 WTO MF=(E,WTOLIST1)
- ABEND 999,DUMP
-*
-* E P I L O G U E
-*
-EPILOGUE EQU *
- L R13,4(0,R13)
- L R14,12(0,R13)
- LM R2,R12,28(R13)
- MVI 12(R13),X'FF'
- BR R14
-*
-* D A T A A R E A S
-*
-EPLIST DC A(PLIST) EXTENDED PARAMETER LIST
-BEGARGS DC A(0) .
-ENDARGS DC A(0) .
- DC A(SHVB1) .
-*
-PLIST DC CL8'EXECCOMM' PARAMETER LIST
-*
-SHVB1 DS XL32 STORAGE FOR THE SHVBLOCK
-*
- WXTRN JZLINIT#
-VJZLINIT DC A(JZLINIT#)
-*
-WTOLIST1 WTO 'CRNVM999 VMREXX: THE OPERATING SYSTEM IS NOT CMS', &
- ROUTCDE=(11),DESC=(6),MF=L
-*
-#endif
-#if (defined(CERNLIB_QMIBMXA))&&(!defined(CERNLIB_QCMS6))
-*R0 EQU 0
-*R1 EQU 1
-*R2 EQU 2
-*R3 EQU 3 -> Return code
-*R4 EQU 4 -> Stem name buffer
-*R5 EQU 5 Length of stem name: points to '.'
-*R6 EQU 6 -> buffer portion of acquired storage
-*R7 EQU 7
-*R8 EQU 8 counter of items to transfer
-*R9 EQU 9 Length of stem + subscript in buffer
-*R10 EQU 10 -> caller's buffer
-*R11 EQU 11 LEN(caller's buffer)
-*R12 EQU 12 -> SHVBLOCK
-*R13 EQU 13 Base
-*R14 EQU 14 Holds #bytes acquired by CMSSTOR
-*R15 EQU 15 Linkage
-*
-STEM CMSSTOR OBTAIN,BYTES=64,LOC=BELOW For my name buffer
- LR R4,R1 R4 -> My name buffer
- ST R4,SHVNAMA
- LR R5,R9 Users name length
- MVCL R4,R8 Move name into my buffer
- MVI 0(R4),C'0' STEM.0 HOLDS NUMBER OF ELEMENTS
- SR R4,1
- LA R5,1(,R4) Length of name now
- ST R5,SHVNAML Store it
- LR R4,R1 Remember the address of this storage
-*
- MVC AORB(1),SHVCODE Remember which function is wanted
- MVI SHVCODE,C'F'
- MVC SHVBUFL,=F'9' Max 9 digits so no problems with CVB
-*
- LA R0,EPLIST R0 -> EXTENDED PLIST
- LA R1,PLIST R1 -> PLIST
- L R15,=X'0200B000'
- STM R15,R1,CALLREGS Makes life easier
- SVC 204 ISSUE THE COMMAND
- LTR R15,R15 CHECK RETURN CODE
- BZ SHVCHECK
- ST R15,0(R14) PROBLEMS WITH EXECCOMM
- B EPILOGUE
-SHVCHECK ICM R15,B'0001',SHVRET
- BZ NUMCHECK
- ST R15,0(R14) PROBABLY BAD VARIABLE NAME
- B BUFFDROP
-*
-* CHANGE LEFT ADJUSTED STRING FROM FETCH TO RIGHT ADJUSTED
-* IN PCVBUFF FOR PACK AND CVB. FETCH SETS LENGTH OF STRING RETURNED
-*
-NUMCHECK MVC PCVBUFF(10),BLANKS
- L R1,SHVVALL LENGTH OF STEM.0 SET
- S R1,=F'1' ONE LESS TO POINT AT LAST CHARACTER
- LA R9,EPCVBUFF
- SR R9,R1
-*
-COMPARE IC R2,0(R1,R6) R10 points to value buffer
-*
- CLM R2,B'0001',=C' ' JUNK LEADING BLANKS
- BNE NOTBLANK
- L R2,SHVVALL BUT MAKE SURE THERE
- S R2,=F'1' WAS AT LEAST ONE
- CR R1,R2 VALID DIGIT
- BE NUMERR
- B CONVERT
-*
-NOTBLANK CLM R2,B'0001',=C'9' BUT IS
- BH NUMERR IT A
- CLM R2,B'0001',=C'0' VALID
- BL NUMERR DIGIT?
-*
- STC R2,0(R1,R9) YES, SO MOVE IT
-*
-NEXT S R1,=F'1' ALTER POINTER FOR NEXT CHARACTER
- BNM COMPARE AND ON WE GO
-*
-CONVERT PACK PCVBUFF(10),PCVBUFF(10) ZONED TO PACKED CONVERSION
- CVB R2,CVBSTART NOW A HEX INTEGER
-*
-* NOW TO READ IN OR SET ALL THE VALUES
-*
- ST R11,SHVBUFL Put back real buffer length for fetch
- ST R11,SHVVALL and for set
-*
- CLI AORB,C'B' CHANGE OF SHVCODE
- BNE REALWORK NEEDED FOR
- MVI SHVCODE,C'S' SET FUNCTION
-*
-REALWORK LA R8,1
- LR R9,R5 Length of name including '0'
- S R5,=F'2' Length of stem name
- LA R5,0(R5,R4) R5 now points to '.' of stem
- XC 0(10,R5),0(R5) Zero the stem number position
-*
-DOTHEM MVI 0(R5),X'0A' APPLMSG buffer is 10bytes long
- APPLMSG APPLID=CMS,TEXT='&&1',SUB=(DEC,(R8)), -
- BUFFA=(R5),DISP=NONE
- MVI 0(R5),C'.' Put in the stem '.'
- SR R1,R1
-TESTLEN IC R1,0(R9,R4) Find out how long the new name is
- LTR R1,R1
- BZ GOTLEN by looking for the first '00' byte
- LA R9,1(0,R9) in the name buffer
- B TESTLEN
-GOTLEN ST R9,SHVNAML Store it
-*
- CLI AORB,C'B' Is it a SET ?
- BNE DOCMD No, fetch value
- LR R7,R11
- STM R6,R11,MVCLSAVE Save the registers
- MVCL R6,R10 Move the value into the low buffer
- LM R6,R11,MVCLSAVE Restore
- LA R10,0(R11,R10) And point to next array element
-*
-DOCMD LM R15,R1,CALLREGS
- SVC 204 ISSUE THE COMMAND
-*
- CLI AORB,C'A' Is it a FETCH?
- BNE AGAIN No, see if we trip again
-*
- L R7,SHVVALL Length of value returned
- ICM R7,B'1000',=C' '
- STM R6,R11,MVCLSAVE Save the registers
- MVCL R10,R6 Move the value to the user
- LM R6,R11,MVCLSAVE Restore
- LA R10,0(R11,R10) Point to next array element
- B AGAIN And see if we need more
-*
-AGAIN LA R8,1(,R8)
- CR R8,R2
- BNH DOTHEM
-*
- SR R15,R15 GOT/SET THEM ALL - FORCE A
- ST R15,0(,R3) ZERO RETURN CODE
-*
-BUFFDROP CMSSTOR RELEASE,BYTES=64,ADDR=(R4)
- CMSSTOR RELEASE,BYTES=(R14),ADDR=(R12)
- B EPILOGUE
-*
-* E R R O R P R O C E S S I N G
-*
-NUMERR MVC 0(4,R3),=F'16'
- B BUFFDROP
-*
-ERROR1 WTO MF=(E,WTOLIST1)
- ABEND 999,DUMP
-*
-* E P I L O G U E
-*
-EPILOGUE EQU *
- L R13,4(0,R13)
- L R14,12(0,R13)
- LM R2,R12,28(R13)
- MVI 12(R13),X'FF'
- BR R14
-*
-* D A T A A R E A S
-*
-EPLIST DC A(PLIST) EXTENDED PARAMETER LIST
-BEGARGS DC A(0) .
-ENDARGS DC A(0) .
-ASHVB DC A(0) Address of SHVBLOCK
-*
-PLIST DC CL8'EXECCOMM' PARAMETER LIST
- DC 2F'-1'
-*
-MVCLSAVE DC 8F'0'
-CALLREGS DC 3F'0'
-*
- WXTRN JZLINIT#
-VJZLINIT DC A(JZLINIT#)
-*
-WTOLIST1 WTO 'CRNVM999 VMREXX: THE OPERATING SYSTEM IS NOT CMS', &
- ROUTCDE=(11),DESC=(6),MF=L
-*
-#endif
-#if defined(CERNLIB_QCMS6)
-CALLREGS DS 3F
-#endif
-#if !defined(CERNLIB_QMIBMXA)||defined(CERNLIB_QCMS6)
-STEMBUFF DC CL250' '
-ZEROBUFF DC CL10' '
-#endif
- CNOP 6,8
-PCVBUFF DC CL2' '
-CVBSTART DC CL7' '
-EPCVBUFF DC CL1' '
-BLANKS DC CL10' '
-#if !defined(CERNLIB_QMIBMXA)
-LEIN DC X'0A'
- DC CL10'..........'
-LEOUT DC XL10'00'
-ZEROS DC XL10'00'
-#endif
-#if (defined(CERNLIB_QMIBMXA))&&(!defined(CERNLIB_QCMS6))
-AORB DS X
-#endif
-#if defined(CERNLIB_QCMS6)
-LEOUTLEN DC X'0A'
-LEOUT DC XL10'00'
-#endif
-*
- LTORG
-*
- SHVBLOCK
-*
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncms/z305/vmrtnea.s b/src/packlib/kernlib/kerngen/obsolete/kerncms/z305/vmrtnea.s
deleted file mode 100644
index 1d9ef93..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncms/z305/vmrtnea.s
+++ /dev/null
@@ -1,50 +0,0 @@
-*
-* $Id: vmrtnea.s,v 1.1.1.1 1996/02/15 17:51:55 mclareni Exp $
-*
-* $Log: vmrtnea.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:55 mclareni
-* Kernlib
-*
-*
-#if !defined(CERNLIB_QCMS4)
- PRINT NOGEN
-VMRTNE CSECT
-#if defined(CERNLIB_QMIBMXA)
-VMRTNE AMODE ANY
-VMRTNE RMODE ANY
-#endif
-*
-* Read a line with echo turned off. Based on VMRTRM
-*
- USING VMRTNE,R15 ESTABLISH ADDRESSABILITY
- DS 0H ALIGN
- B VMRTNEN BRANCH AROUND THE NAME
- DC AL1(7) LENGTH OF NAME
- DC C'VMRTNE' DEFINE THE NAME
-VMRTNEN SAVE (14,12) SAVE THE REGS
- LR R12,R15 SET UP THE BASE
- DROP R15 ADDRESSABILITY REESTABLISHED
- USING VMRTNE,R12 ESTABLISH ADDRESSABILITY
- L R2,0(R1) POINTER TO CHAR STRING ADDRESS
- LR R3,R1 COPY R1
- S R3,=F'4' POINT TO ARG LENGTH BLOCK DISPLACEMENT
- L R3,0(R3) PICK UP THE ARG LEN BLOCK DISPLACEMENT
- AR R3,R1 COMPUTE THE ARG LEN BLOCK ADDRESS
- L R3,0(R3) GET LENGTH POINTER ADDRESS
- L R3,0(R3) GET THE LENGTH OF THE CHAR VARIABLE
- LA R6,LREAD DEFAULT LENGTH OF STRING READ
- TM 0(R1),X'80' IS THERE A SECOND ARG
- BO ENDARG2 BRANCH IF NO SECOND ARG
- L R6,4(R1) POINT R6 AT LENGTH ADDRESS
-* NOW DO THE READ
-ENDARG2 LINERD DATA=((R2),(R3)),CASE=MIXED,TYPE=INVISIBLE,WAIT=YES
- ST R0,0(R6) SAVE THE LENGTH ACTUALLY READ
- RETURN (14,12) GO BACK TO THE FORTRAN
-*
-* DATA AREAS
-LREAD DS 1F DUMMY LENGTH READ
-BLANKR5 DC C' ',X'000000' BLANK CHAR OF ZERO LENGTH
-*
- REGEQU
- END
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncms/z305/vmrtnee.dat b/src/packlib/kernlib/kerngen/obsolete/kerncms/z305/vmrtnee.dat
deleted file mode 100644
index 424473f..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncms/z305/vmrtnee.dat
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: vmrtnee.dat,v 1.1.1.1 1996/02/15 17:51:55 mclareni Exp $
-*
-* $Log: vmrtnee.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:51:55 mclareni
-* Kernlib
-*
-*
-#if defined(CERNLIB_QCMS4)
-/*DECK ID>, vmrtne.exec */
-/**/ pw='DOCONS'("INHIBIT") ; Push pw
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncms/z305/vmrtnef.F b/src/packlib/kernlib/kerngen/obsolete/kerncms/z305/vmrtnef.F
deleted file mode 100644
index 6c144e5..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncms/z305/vmrtnef.F
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: vmrtnef.F,v 1.1.1.1 1996/02/15 17:51:55 mclareni Exp $
-*
-* $Log: vmrtnef.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:55 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
-#if defined(CERNLIB_QCMS4)
-C
-C CERN PROGLIB# Z305 VMRTNE .VERSION KERNCMS 1.05 910308
-C ORIG. 08/03/91, Miguel Marquina
-C FORTRAN version of VMRTNE in CMS4 (using Rexx Local Function DOCONS)
-C
- SUBROUTINE VMRTNE(PW,LENG)
- CHARACTER*(*) PW
- CALL VMCMS('EXEC VMRTNE',IRC)
- CALL VMRTRM(PW,LENG)
- RETURN
- END
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncms/z305/vmrtrm.s b/src/packlib/kernlib/kerngen/obsolete/kerncms/z305/vmrtrm.s
deleted file mode 100644
index 35e6625..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncms/z305/vmrtrm.s
+++ /dev/null
@@ -1,78 +0,0 @@
-*
-* $Id: vmrtrm.s,v 1.1.1.1 1996/02/15 17:51:55 mclareni Exp $
-*
-* $Log: vmrtrm.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:55 mclareni
-* Kernlib
-*
-*
- PRINT NOGEN
-VMRTRM CSECT
-#if defined(CERNLIB_QMIBMXA)
-VMRTRM AMODE ANY
-VMRTRM RMODE ANY
-#endif
-*
-* CERN PROGLIB# Z305 VMRTRM .VERSION KERNIBM 2.23 880425
-* ORIG. 19/09/87 HRR
-*
-* TITLE 'VMRTRM READ DATA FROM THE CONSOLE IN CMS FOR FORTRAN77'
-*
-* A. BANKS (WITH ENTRY NAME RDTERM)
-*
-* CALL FROM FORTRAN 77 IS:
-* CALL VMRTRM(STRING[,LENGTH])
-*
-* STRING (RETURNED) CHARACTER*(*) THE STRING READ
-* LENGTH (RETURNED) INTEGER*4 THE SMALLER LENGTH OF EITHER THE
-* CHARACTER STRING LENGTH, OR THE
-* LENGTH OF STRING ACTUALLY READ.
-* SURPLUS CHARACTERS ENTERED ARE
-* IGNORED. STRING IS BLANK PADDED.
-*
-* Modified to use LINERD for XA compatibility
-* Tony Cass CERN/DD May 1989
-*
- USING VMRTRM,R15 ESTABLISH ADDRESSABILITY
- DS 0H ALIGN
- B VMRTRMN BRANCH AROUND THE NAME
- DC AL1(7) LENGTH OF NAME
- DC C'VMRTRM' DEFINE THE NAME
-VMRTRMN SAVE (14,12) SAVE THE REGS
- LR R12,R15 SET UP THE BASE
- DROP R15 ADDRESSABILITY REESTABLISHED
- USING VMRTRM,R12 ESTABLISH ADDRESSABILITY
- L R2,0(R1) POINTER TO CHAR STRING ADDRESS
- LR R3,R1 COPY R1
- S R3,=F'4' POINT TO ARG LENGTH BLOCK DISPLACEMENT
- L R3,0(R3) PICK UP THE ARG LEN BLOCK DISPLACEMENT
- AR R3,R1 COMPUTE THE ARG LEN BLOCK ADDRESS
- L R3,0(R3) GET LENGTH POINTER ADDRESS
- L R3,0(R3) GET THE LENGTH OF THE CHAR VARIABLE
- LA R6,LREAD DEFAULT LENGTH OF STRING READ
- TM 0(R1),X'80' IS THERE A SECOND ARG
- BO ENDARG2 BRANCH IF NO SECOND ARG
- L R6,4(R1) POINT R6 AT LENGTH ADDRESS
-* NOW DO THE READ
-#if defined(CERNLIB_QMIBMXA)
-ENDARG2 LINERD DATA=((R2),(R3)),CASE=MIXED,TYPE=STACK,WAIT=YES
- ST R0,0(R6) SAVE THE LENGTH ACTUALLY READ
-#endif
-#if !defined(CERNLIB_QMIBMXA)
-ENDARG2 RDTERM (R2),EDIT=PHYS,LENGTH=(R3),ATTREST=NO
- ST R0,0(R6) SAVE THE LENGTH ACTUALLY READ
-* SET THE REST OF THE STRING TO TRAILING BLANKS
- AR R2,R0 POINT R2 TO THE NEXT UNREAD CHAR
- SR R3,R0 SET R3 TO COUNT BLANKS REQUIRED
- LA R4,0 R4 UNIMPORTANT
- L R5,BLANKR5 PUT BLANK PAD INTO R5
- MVCL R2,R4 CLEAR REMAINING CHARS TO BLANKS
-#endif
- RETURN (14,12) GO BACK TO THE FORTRAN
-*
-* DATA AREAS
-LREAD DS 1F DUMMY LENGTH READ
-BLANKR5 DC C' ',X'000000' BLANK CHAR OF ZERO LENGTH
-*
- REGEQU
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncms/z305/vmsatn.s b/src/packlib/kernlib/kerngen/obsolete/kerncms/z305/vmsatn.s
deleted file mode 100644
index b7805c7..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncms/z305/vmsatn.s
+++ /dev/null
@@ -1,128 +0,0 @@
-*
-* $Id: vmsatn.s,v 1.1.1.1 1996/02/15 17:51:55 mclareni Exp $
-*
-* $Log: vmsatn.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:55 mclareni
-* Kernlib
-*
-*
-VMSATN CSECT
-*
-* CERN PROGLIB# Z305 VMSATN/VMTATN .VERSION KERNIBM 2.19 861204
-* ORIG. 01/01/86 RM
-*
-* REFER TO CERN PROGRAM LIBRARY MEMBER Z305 FOR DETAILS
-*
-* M O D I F I C A T I O N L O G
-* ===============================
-*
-* 1 . 0 0
-*
-*
-* ORIGINAL VERSION.
-*
-* R. MATTHEWS, CERN/DD, JANUARY 1986.
-*
-*********************************************************************
-*
-#if defined(CERNLIB_QMIBMXA)
- SPLEVEL SET=2
-VMSATN AMODE ANY
-VMSATN RMODE ANY
-#endif
-R0 EQU 0
-R1 EQU 1
-R2 EQU 2
-R3 EQU 3
-R4 EQU 4
-R5 EQU 5
-R6 EQU 6
-R7 EQU 7
-R8 EQU 8
-R9 EQU 9
-R10 EQU 10
-R11 EQU 11
-R12 EQU 12
-R13 EQU 13
-R14 EQU 14
-R15 EQU 15
-*
- PRINT NOGEN
-*
-* P R O L O G U E
-*
- USING VMSATN,R15
- B SAVEREGS
- DC AL1(7),CL7'VMSATN' IDENTIFIER
- DC C'1.00' VERSION.MODIFICATION LEVEL
-SAVEREGS STM R14,R12,12(R13)
- LR R4,R13
- CNOP 0,4
- BAL R13,AROUNDSA
-SAVEAREA DC A(EPILOGUE),17F'0'
- DROP R15
- USING SAVEAREA,R13
-AROUNDSA ST R13,8(0,R4)
- ST R4,4(0,R13)
- XC 8(4,R13),8(R13)
-*
-* D E T E R M I N E I F A N E X I T A L R E A D Y E X I S T S
-*
- USING NUCON,0
- L R2,0(0,R1) R2 -> FIRST ARGUMENT
- L R3,TAXEADDR R3 := EXIT ADDRESS
- LTR R3,R3 IS THERE ALREADY AN EXIT ADDRESS ?
- BZ STAX NO, BRANCH
- ST R3,0(0,R2) USE IT AS A NON-ZERO RETURN CODE
- B EPILOGUE
-*
-* E S T A B L I S H A N A T T E N T I O N E X I T
-*
-STAX STAX EXIT ISSUE THE STAX MACRO
- SRA R15,2 DIVIDE THE RETURN CODE BY 4
- ST R15,0(0,R2) STORE IT FOR THE CALLER
- B EPILOGUE
-*
-* A T T E N T I O N E X I T
-*
-EXIT EQU *
- USING EXIT,R15
- MVI FLAG+3,1 SWITCH ON THE ATTENTION FLAG
- BR R14 RETURN TO THE SYSTEM
- DROP R15
-*
-*
-*********************************************************************
-*
-* V M T A T N
-* ===========
-*
-*********************************************************************
-*
- ENTRY VMTATN
- USING VMTATN,R15
-VMTATN EQU *
- L R1,0(0,R1) R1 -> FIRST ARGUMENT
- L R0,FLAG R0 := ATTENTION FLAG
- ST R0,0(0,R1) STORE IT FOR THE CALLER
- MVI FLAG+3,0 SWITCH OFF THE ATTENTION FLAG
- BR R14 RETURN TO THE CALLER
- DROP R15
-*
-* E P I L O G U E
-*
-EPILOGUE EQU *
- L R13,4(0,R13)
- LM R14,R12,12(R13)
- MVI 12(R13),X'FF'
- BR R14
-*
-* D A T A A R E A S
-*
-FLAG DC F'0'
-*
- LTORG
-*
- NUCON
-*
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncms/z305/vmstak.s b/src/packlib/kernlib/kerngen/obsolete/kerncms/z305/vmstak.s
deleted file mode 100644
index 138b91e..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncms/z305/vmstak.s
+++ /dev/null
@@ -1,149 +0,0 @@
-*
-* $Id: vmstak.s,v 1.1.1.1 1996/02/15 17:51:55 mclareni Exp $
-*
-* $Log: vmstak.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:55 mclareni
-* Kernlib
-*
-*
-VMSTAK CSECT
-#if defined(CERNLIB_QMIBMXA)
-VMSTAK AMODE ANY
-VMSTAK RMODE ANY
-#endif
-*
-* CERN PROGLIB# Z305 VMSTAK .VERSION KERNCMS 1.05 900713
-* J.D. Shiers, 9-JUL-1990, BASED ON Z305 VMPACK routines
-*
-* Mods Date Comments
-* J.Shiers 90/07/12 for CMS 4 - use ATTN function instead
-* I.Reguero 90/11/19 for CMS 4 - use SVC 202 instead of CMSCALL
-*
-* TITLE 'VMSTAK WRITE LINE OF UP TO 255 CHARS TO PROGRAM STACK'
-*
-* CALL FROM FORTRAN 77 IS:
-* CALL VMSTAK(STRING,OPT,IRC)
-*
-* STRING (INPUT) CHARACTER*(*) THE COMMAND
-* OPT (INPUT) CHARACTER*1 'L' (LIFO) OR 'F' (FIFO)
-* IRC (OUTPUT) RETURN CODE
-*
-R0 EQU 0
-R1 EQU 1
-R2 EQU 2
-R3 EQU 3
-R4 EQU 4
-R5 EQU 5
-R6 EQU 6
-R7 EQU 7
-R8 EQU 8
-R9 EQU 9
-R10 EQU 10
-R11 EQU 11
-R12 EQU 12
-R13 EQU 13
-R14 EQU 14
-R15 EQU 15
-*
- PRINT NOGEN
-*
-* P R O L O G U E
-*
- USING VMSTAK,R15
- B SAVEREGS
- DC AL1(7),CL7'VMSTAK' IDENTIFIER
- DC C'1.00' VERSION.MODIFICATION LEVEL
-SAVEREGS STM R14,R12,12(R13)
- LR R4,R13
- CNOP 0,4
- BAL R13,AROUNDSA
-SAVEAREA DC A(EPILOGUE),17F'0'
- DROP R15
- USING SAVEAREA,R13
-AROUNDSA ST R13,8(0,R4)
- ST R4,4(0,R13)
- XC 8(4,R13),8(R13)
-*
-*
- LR R11,R1 R11 -> ARGUMENT LIST
-*
-* E N S U R E T H E O P E R A T I N G S Y S T E M I S C M S
-*
- L R2,16 R2 -> CVT
- TM 116(R2),X'40' IS IT CMS ?
- BNO ERROR1 NO, BRANCH
-*
-* G E T T H E C O M M A N D A N D I T S L E N G T H
-*
- LR R2,R11 R2 -> ARGUMENT LIST
- S R2,=F'4' R2 -> ARGUMENT LIST PREFIX
- L R2,0(0,R2) R2 := ARGUMENT LIST PREFIX
- L R0,VJZLINIT R0 := ADDRESS OF JZLINIT#
- LTR R0,R0 IS IT PRESENT ?
- BNZ FUJITSU YES, BRANCH
-*
- AR R2,R11 R2 -> SECONDARY ARGUMENT LIST
- L R2,0(0,R2) R2 -> COMMAND LENGTH
- L R5,0(0,R2) R5 := COMMAND LENGTH
- B DOCMD
-*
-FUJITSU LH R5,0(0,R2) R5 := COMMAND LENGTH
-*
-DOCMD LM R2,R4,0(R1) R2->COMMAND,R3->IFLAG,R4->IRC
- L R3,0(,R3) R3 = IFLAG
- CLI R3,C'L' LIFO?
- BNE PUTSTAK
-#if defined(CERNLIB_QMIBMXA)
- SR R3,R3 FIFO
-* Need to store FIFO or LIFO in PLIST
-#endif
-#if defined(CERNLIB_QCMS4)
- MVI PLIST+8,C'F'
-*
-#endif
-#if defined(CERNLIB_QMIBMXA)
-PUTSTAK CMSSTACK TEXT=((R2),(R5)),ORDER=(R3)
-* Version for CMS 4 - no CMSSTACK MACRO
-#endif
-#if defined(CERNLIB_QCMS4)
-PUTSTAK ST R2,PLIST+12 Store address of line in PLIST
- STC R5,PLIST+12 Store length
- LA R1,PLIST Address of PLIST
-* CMSCALL PLIST=(R1) Here we go...
- SVC 202
- DC AL4(1)
-#endif
- ST R15,0(,R4) Store return code
- B EPILOGUE
-*
-* E R R O R P R O C E S S I N G
-*
-ERROR1 WTO MF=(E,WTOLIST1)
- ABEND 999,DUMP
-*
-EPILOGUE EQU *
- L R13,4(0,R13)
- L R14,12(0,R13)
- LM R2,R12,28(R13)
- MVI 12(R13),X'FF'
- BR R14
-*
-* D A T A A R E A S
-*
- WXTRN JZLINIT#
-VJZLINIT DC A(JZLINIT#)
-*
-#if defined(CERNLIB_QCMS4)
-PLIST DS 0D
- DC CL8'ATTN'
- DC CL4'LIFO'
- DS 1D length + address of line
-#endif
-WTOLIST1 WTO 'CRNVM999 VMCMS: THE OPERATING SYSTEM IS NOT CMS', &
- ROUTCDE=(11),DESC=(6),MF=L
-*
- LTORG
-*
- NUCON
-*
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncms/z306/maxdsk.s b/src/packlib/kernlib/kerngen/obsolete/kerncms/z306/maxdsk.s
deleted file mode 100644
index 088b43f..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncms/z306/maxdsk.s
+++ /dev/null
@@ -1,93 +0,0 @@
-*
-* $Id: maxdsk.s,v 1.1.1.1 1996/02/15 17:51:56 mclareni Exp $
-*
-* $Log: maxdsk.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:56 mclareni
-* Kernlib
-*
-*
- PRINT NOGEN
-MAXDSK CSECT
-#if defined(CERNLIB_QMIBMXA)
-MAXDSK AMODE ANY
-MAXDSK RMODE ANY
-#endif
-*
-***********************************************************************
-* *
-* CERN Program Library Z306 MAXDSK *
-* *
-* Function: Returns the mode of the CMS R/W minidisk with the *
-* most free space. Returns ' ' if none found. *
-* *
-* Called by: CHARACTER*1 DISK *
-* CALL MAXDSK(DISK,NFREE,ISIZE) *
-* DISK will be returned as the appropriate mode letter *
-* or blank if none was found. When DISK is non-blank *
-* NFREE and ISIZE will be returned as the number of *
-* free blocks and the blocksize respectively. *
-* *
-* Also: CHARACTER*1 FUNCTION CMXDSK,DISK *
-* DISK = CMXDSK() *
-* *
-***********************************************************************
-* *
-* Modification log: *
-* *
-* 1.00 Original version Tony Cass CERN/DD 16th January 1989 *
-* *
-***********************************************************************
-* *
- ENTRY CMXDSK
-CMXDSK DS 0H
- USING MAXDSK,R15
- USING NUCON,0
- USING ADTSECT,R1
- B SAVEREGS
- DC AL1(7),CL7'MAXDSK' Name
- DC CL4'1.00' Version.modification
-SAVEREGS STM R14,R12,12(R13)
- LR R4,R13
- CNOP 0,4
- BAL R13,CARRYON
-SAVEAREA DC 18F'0'
- DROP R15
- USING SAVEAREA,R13
-CARRYON ST R13,8(,R4)
- ST R4,R4(,R13)
- XC 8(4,R13),8(R13)
-*
- LR R11,R1 R11 -> parameter list
- L R2,0(R11) R2 -> reply area
- MVI 0(R2),C' ' Blank it out
-*
- LA R1,QUERY-24 Need ADTLKW's ?? function
- L R15,AADTLKW
- BALR R14,R15 Call the function
- BNZ RETURN No disk found
- MVC 0(1,R2),ADTM Send back the mode
- TM 0(R11),X'80' Any more arguments?
- BO RETURN No
- LA R11,4(,R11) Point to address of next arg
- L R2,0(R11) Get address
- L R3,ADTNUM Total blocks
- S R3,ADTUSED Subtract number used
- ST R3,0(,R2) Send back number free
- TM 0(R11),X'80' Any more arguments?
- BO RETURN No
- LA R11,4(,R11) Point to address of next arg
- L R2,0(R11) Get address
- MVC 0(4,R2),ADTDBSIZ Send back block size
-*
-RETURN L R13,4(,R13)
- LM R14,R12,12(R13)
- OI 12(R13),X'FF'
- BR R14
-*
-QUERY DC CL2'??'
-*
- NUCON
- ADT
-*
- REGEQU
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncms/z307/job_vm.F b/src/packlib/kernlib/kerngen/obsolete/kerncms/z307/job_vm.F
deleted file mode 100644
index 7be77d6..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncms/z307/job_vm.F
+++ /dev/null
@@ -1,51 +0,0 @@
-*
-* $Id: job_vm.F,v 1.1.1.1 1996/02/15 17:51:56 mclareni Exp $
-*
-* $Log: job_vm.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:56 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
-#if !defined(CERNLIB_CERN)
- LOGICAL FUNCTION JOB$VM(INFO)
-C
-C Dummy Batch interface routine for non-HepVM sites.
-C See Patch SYCERNV for original assembler and detailed description
-C
- CHARACTER*128 INFO,DEFAULT
- CHARACTER*80 SPACES
- REAL NUMBRS(32)
- EQUIVALENCE (SPACES,DEFAULT) , (NUMBRS(1),DEFAULT)
-C
-C Blank out undecidable fields
-C
- DATA SPACES/' '/
-C
-C Default job time limit
-C
- DATA NUMBRS(21)/ 9999.0 /
- DATA NUMBRS(22)/ 0.0 /
-C
-C Default CPU normalisation
-C
- DATA NUMBRS(23)/ 1.0 /
- DATA NUMBRS(24)/ 0.0 /
-C
-C Don't know whether we're 370 or XA
-C
- DATA NUMBRS(23)/ 0.0 /
- DATA NUMBRS(24)/ 0.0 /
-C
-C Send back all the default details
-C
- INFO = DEFAULT
-C
-C And we're not in SLAC Batch either...
-C
- JOB$VM = .FALSE.
-C
- RETURN
- END
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncms/z307/job_vmce.s b/src/packlib/kernlib/kerngen/obsolete/kerncms/z307/job_vmce.s
deleted file mode 100644
index 6febaf9..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncms/z307/job_vmce.s
+++ /dev/null
@@ -1,10 +0,0 @@
-*
-* $Id: job_vmce.s,v 1.1.1.1 1996/02/15 17:51:56 mclareni Exp $
-*
-* $Log: job_vmce.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:56 mclareni
-* Kernlib
-*
-*
-#if defined(CERNLIB_CERN)
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncms/z307/jobstp.s b/src/packlib/kernlib/kerngen/obsolete/kerncms/z307/jobstp.s
deleted file mode 100644
index 22b2483..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncms/z307/jobstp.s
+++ /dev/null
@@ -1,77 +0,0 @@
-*
-* $Id: jobstp.s,v 1.1.1.1 1996/02/15 17:51:56 mclareni Exp $
-*
-* $Log: jobstp.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:56 mclareni
-* Kernlib
-*
-*
-#if defined(CERNLIB_CERN)
- PRINT NOGEN
-JOBSTP CSECT
-#if defined(CERNLIB_QMIBMXA)
-JOBSTP AMODE ANY
-JOBSTP RMODE ANY
-#endif
-*
-* CERN PROGLIB# JOBSTP .VERSION KERNIBM 2.11 850320
-* ORIG. 01/03/85 HRR
-*
-*
-* THIS FORTRAN CALLABLE FUNCTION SUBROUTINE CAN BE USED TO TELL
-* IF JOBSTOP IS NOW SET IN THE VIRTUAL MACHINE. THIS IS A MORE
-* EFFICIENT METHOD FOR DOING THIS THAN CALLING THE JOBSTOP EXEC
-* USING KMAND.
-*
-* FORTRAN CALLING SEQUENCE: I=JOBSTP(N)
-*
-* WHERE: N IS IGNORED
-*
-* I = INTEGER*4
-* 0, JOB IS NOT REQUESTED TO STOP.
-* 4, JOB IS REQUESTED TO STOP.
-*
-* DJOHNSON 05/02/84
-*
- USING JOBSTP,R15 TEMPORARY ADDRESSABILITY
- B JOBSTP0 BYPASS IDENTIFICATION
- DC XL1'7' ...
- DC CL7'JOBSTP' FOR STANDARD REPORTS
-JOBSTP0 STM R14,R12,12(R13) SAVE CALLING REGISTERS
- LR R12,R15 BASE ADDRESS IN R12
- DROP R15 DROP TEMPORARY BASE
- USING JOBSTP,R12 PERMANENT BASE
- SR R4,R4 SET DEFAULT RETCODE
- ST R4,RETCODE ...
-*--------------------------------------------------------------------
-* - ISSUE CP VARIABLE QUERY JOBSTOP_COMMAND, AND LOOK AT RESPONSE
-*--------------------------------------------------------------------
- LA R4,CPCOM ADDRESS OF CP COMMAND
- LA R6,L'CPCOM LENGTH OF COMMAND
- ICM R6,B'1000',=X'40' WANT ANSWER IN BUFFER
- LA R5,BUF RESPONSE BUFFER
- LA R7,L'BUF LENGTH OF RESPONSE BUFFER
- DC X'83460008' CP CONSOLE FUNCTION DIAGNOSE
- CLC YES,BUF ARE WE STOPPING?
- BNE EXIT NO, RC=0
- MVC RETCODE,=F'4' YES, RC=4
-*--------------------------------------------------------------------
-* - RESTORE REGISTERS AND RETURN TO CALLER
-*--------------------------------------------------------------------
-EXIT L R14,12(,R13) RESTORE REGISTER 14
- L R0,RETCODE GIVE BACK FUNCTION VALUE
- LM R2,R12,28(R13) RESTORE REGISTERS 2 THRU 12
- MVI 12(R13),X'FF' INDICATE CONTROL RETURNED
- SR R15,R15 CLEAR R15
- BR R14 RETURN TO CALLER
-*
-*--------------------------------------------------------------------
-* - DATA AREAS
-*--------------------------------------------------------------------
-RETCODE DC F'0' 0 OR 4
-YES DC C'JOBSTOP_COMMAND NOW ' YES ANSWER
-BUF DS CL256 CP COMMAND RESPONSE
-CPCOM DC C'GVAR QUERY JOBSTOP_COMMAND' STOPPING?
- REGEQU
- END
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncms/z307/normfact.inc b/src/packlib/kernlib/kerngen/obsolete/kerncms/z307/normfact.inc
deleted file mode 100644
index a55a7d7..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncms/z307/normfact.inc
+++ /dev/null
@@ -1,340 +0,0 @@
-*
-* $Id: normfact.inc,v 1.1.1.1 1996/02/15 17:51:56 mclareni Exp $
-*
-* $Log: normfact.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:51:56 mclareni
-* Kernlib
-*
-*
-* CPU factor at CERNVM
-*
-* normfact.inc
-*
-#if defined(CERNLIB_CERN)
-#if (defined(CERNLIB_CERN))&&(!defined(CERNLIB_CERNVMB))
-NORMFACT DC D'20.0'
-#endif
-#endif
-* CPU factor at CERNVMB
-#if defined(CERNLIB_CERN)
-#if (defined(CERNLIB_CERN))&&(defined(CERNLIB_CERNVMB))
-NORMFACT DC D'5.0'
-#endif
-#endif
-* CPU factor elsewhere
-#if defined(CERNLIB_CERN)
-NORMFACT DC D'1.0'
-#endif
- PRINT NOGEN
-JOB$VM CSECT
-#if defined(CERNLIB_QMIBMXA)
-JOB$VM AMODE ANY
-JOB$VM RMODE ANY
-#endif
-*
-***********************************************************************
-* *
-* CERN Program Library Z307 JOB$VM *
-* *
-* Function: Returns various details about the current CMS *
-* environment for HepVM sites. *
-* *
-* Usage Example: *
-* *
-* DIMENSION SPACE(32) *
-* LOGICAL BATCH,JOB$VM *
-* CHARACTER*8 INFO(10) *
-* EQUIVALENCE (INFO(1),SPACE(1)) *
-* EQUIVALENCE (TIME,SPACE(21)) *
-* EQUIVALENCE (TNORM,SPACE(23)) *
-* EQUIVALENCE (MACH,SPACE(25)) *
-*C *
-* BATCH = JOB$VM(SPACE) *
-* *
-* *
-* The information returned is: *
-* *
-* BATCH = .TRUE. if the job is running under SLAC Batch *
-* .FALSE. otherwise *
-* *
-* INFO(1 ) = (Batch job submitter's) user ID *
-* INFO(2 ) = Account code *
-* INFO(3 ) = Distribution code *
-* INFO(4 ) = Machine ID (= user ID if interactive) *
-* INFO(5 ) = Job ID (INTERACT if interactive) *
-* INFO(6 ) = Virtual Machine Storage size *
-* INFO(7 ) = START/RESTART for a batch job *
-* INFO(8 ) = Node *
-* INFO(9 ) = BMON ID *
-* INFO(10) = Master BMON ID *
-* *
-* TIME = Time limit for job in accounting units *
-* TNORM = Conversion factor between accounting and machine units *
-* TNORM = (accounting second) / (machine second) *
-* MACH = 0 -> Machine type unknown *
-* 1 -> 370 Machine *
-* 2 -> XA Machine *
-* *
-***********************************************************************
-* *
-* Information is gleaned from the results of a $B$INFO$ query and *
-* a call to the HepVM EXTRACT Diagnose function. *
-* NODE comes from CP QUERY USERID for an interactive machine *
-* *
-* Virtual Machine type determined by examining NUCMFLAG (previously *
-* a reserved field). $B$INFO$ called by SVC 202 or SVC 204 as *
-* appropriate. *
-* *
-* *
-***********************************************************************
-* *
-* Modification log: *
-* *
-* 2.00 Drastically rewritten for public release. This code should *
-* now run correctly on all Hep$VM sites. *
-* Simple Fortran code in Patch SYVM for other sites - however *
-* those using SLAC batch but without the HepVM EXTRACT code *
-* may prefer just to avoid the DIAGNOSE instruction. *
-* *
-* 2.01 Clear R15 before OR before SVC 204 *
-* Allow for 1digit time limits *
-* *
-* 2.02 Fix storage and Node determination for non-XA systems *
-* *
-* Tony Cass CERN/DD 8th March 1989 *
-* Acknowledgments to H. Renshall/CERN and J. Wood/RAL *
-* *
-***********************************************************************
-* *
- USING JOB$VM,R15
- B SAVEREGS
- DC AL1(7),CL7'JOB$VM' Identifier
- DC C'2.02' Version.Modification level
-SAVEREGS STM R14,R12,12(R13)
- LR R4,R13
- CNOP 0,4
- BAL R13,AROUNDSA
-SAVEAREA DC 18F'0'
- DROP R15
- USING SAVEAREA,R13
-AROUNDSA ST R13,8(0,R4)
- ST R4,4(0,R13)
- XC 8(4,R13),8(R13)
-*
- L R11,0(0,R1) R11 -> Argument address
-*
- TM JOBFLAGS,CALLED Already done the work?
- BO COPYDATA Yes, just copy the info
-*
- LM R5,R8,SIZEDIAG First find virtual storage
- DIAG R5,R7,X'0008'
- MVC VSTORE(5),RETSTORE+10 Copy over size
- CLI RETSTORE+14,C'M' Pre XA response?
- BE WHATTYPE No, got all the details
- MVI VSTORE+5,C'K' Yes, give storage units
-*
-WHATTYPE TM X'5EA'(0),X'80' XA/370? (No mnemonics to allow
- BO MACHXA for earlier CMSes
-*
-MACH370 MVI MACHTYPE+3,ITS370
- LA R1,$B$PLIST
- ICM R1,B'1000',=X'05' Want nucleus extension
- SVC 202
- DC AL4(1)
- B MACHALL
-*
-MACHXA MVI MACHTYPE+3,ITSXA
- LA R1,$B$PLIST Expand CMSCALL for non CMS 5.5
- LA R15,0
- O R15,=X'0000A000'
- SVC 204
-*
-MACHALL LTR R15,R15
- BM NOTBATCH Not in Slac batch
-*
- OI INBATCH+3,X'01' In Slac Batch
-*
- USING BATINFO,R15
-* Copy interesting fields over
- MVC USERID,BATUSER
- MVC ACCOUNT,BATACNT
- MVC DISTCODE,BATBIN
- MVC JOBID,BATJOBID
- MVC RESTART,BATSTRST
- MVC NODE,BATNODE
- MVC BMONID,BATMONID
- MVC BMASTER,BATMASTR
-*
- LA R9,8 Find end of time limit
-TESTLIM LA R8,BATMXTME-1(R9)
- CLI 0(R8),C' '
- BNE PACKLIM
- BCT R9,TESTLIM
- B EXTRACT Zero length limit is pretty silly
-*
-IPACKLIM PACK PKTLIM,BATMXTME(*-*)
-IPACKNRM PACK PKTNORM,BATTNORM(*-*)
-*
-PACKLIM BCTR R9,0
- EX R9,IPACKLIM Pack time limit
- CVB R9,PKTLIM and convert to binary
-*
- LA R10,7 Find end of normalisation factor
-TESTNORM LA R8,BATTNORM(R10)
- CLI 0(R8),C' '
- BNE PACKNORM
- BCT R10,TESTNORM
- LA R10,1 Make norm factor 1.0
- B FLOATEM
-*
-PACKNORM EX R10,IPACKNRM Pack normalisation factor
- CVB R10,PKTNORM and convert to binary
-*
-FLOATEM ST R9,REALLIM+4 Make unnormalised REAL*8 values
- ST R10,REALNORM+4 for time limit and norm. factor
- LD F0,REALLIM
- AD F0,ZERO Normalise limit
- STD F0,TIMELIM and store it
- LD F0,REALNORM
- AD F0,ZERO Normalise normalisation factor(!)
- DD F0,=D'100.0' scaled by 100 by $B$INFO$
- STE F0,NORMFACT and store it
- B EXTRACT
-*
-NOTBATCH LM R5,R8,NODEDIAG Set up registers for DIAG 8
- DIAG R5,R7,X'0008' Issue command
-#if defined(CERNLIB_QMIBMXA)
- BCTR R8,0 Point at x'15' added by CP
- LA R6,0(R8,R6)
- MVI 0(R6),C' ' And replace by a blank
- MVC NODE,INTNODE Copy node name across
-#endif
-#if !defined(CERNLIB_QMIBMXA)
- S R8,=F'3' Skip x'15' and node must be
-* at least 1 character long
- LA R6,0(R8,R6)
- LA R5,0 Look backwards for
- IC R7,=C' ' a space
-NODECOMP CLM R7,B'0001',0(R6)
- BE NODEMOVE
- LA R5,1(,R5)
- BCT R6,NODECOMP
-*
-EXMOVE MVC NODE(*-*),1(R6)
-*
-NODEMOVE EX R5,EXMOVE And replace by a blank
-#endif
-*
-EXTRACT LA R1,EXTRLIST Find details from CP
- LA R2,NKEYS
-#if !defined(CERNLIB_QEXTRACT)
- DIAG R1,R2,X'0180' HepVM Extract
-*
- BC 1,COPYDATA Extract failed or not available
-*
- MVC USERID,EXTRNAME Copy over useful details
- MVC MACHINE,EXTRMACH
- MVC ACCOUNT,EXTRACNT
- MVC DISTCODE,EXTRDIST
-#endif
-COPYDATA MVC 0(128,R11),USERID Return the information
- L R0,INBATCH Return function value
- OI JOBFLAGS,CALLED Say we've already been called
-RETURN L R13,4(0,R13)
- LM R14,R15,12(R13)
- LM R1,R12,24(R13)
- MVI 12(R13),X'FF'
- BR R14
-*
- DS 0D
-*
-* PLIST for call to $B$INFO$ command via SVC 202 or SVC 204
-*
-$B$PLIST DC CL8'$B$INFO$'
- DC 8X'FF'
-*
-* Extract parameter list & work area
-*
-EXTRLIST DC CL8'USER'
-EXTRMACH DC CL8' '
- DC CL8'USERNAME'
-EXTRNAME DC CL8' '
- DC CL8'ACCOUNT'
-EXTRACNT DC CL8' '
- DC CL8'DISTCODE'
-EXTRDIST DC CL8' '
-NKEYS EQU (*-EXTRLIST)/16
-*
-* Default answers or completed info for future calls
-*
-USERID DC CL8' '
-ACCOUNT DC CL8' '
-DISTCODE DC CL8' '
-MACHINE DC CL8' '
-JOBID DC CL8'INTERACT'
-VSTORE DC CL8' '
-RESTART DC CL8' '
-NODE DC CL8' '
-BMONID DC CL8' '
-BMASTER DC CL8' '
-TIMELIM DC D'9999.0'
-* The following sequence is used to set the CPU normalization factor
-* in JOB$VM. At CERNVM (IBM 9000/900 ) accounted CPU =20 x native CPU
-* (IBM 3090/600J) accounted CPU = 8 x native CPU
-* (IBM 3090/600E) accounted CPU = 5 x native CPU
-#include "normfact.inc"
-MACHTYPE DC 2F'0'
- DC 6F'0'
-ITS370 EQU X'01'
-ITSXA EQU X'02'
-*
-PKTLIM DC D'0.0'
-REALLIM DC XL4'4E000000',F'0'
-PKTNORM DC D'0.0'
-REALNORM DC XL4'4E000000',F'0'
-ZERO DC D'0.0'
-*
-INBATCH DC F'0'
-JOBFLAGS DC X'00'
-CALLED EQU X'01'
-*
- DS 0D DIAG 08 for Storage Query
-SIZEDIAG DC A(QVSTORE) Rx -> command
- DC A(RETSTORE) Rx+1 -> Return buffer
- DC XL4'40000015' Ry = x'40' flag + L'command
-#if defined(CERNLIB_QMIBMXA)
- DC F'16' Ry+1 = L'return buffer
-QVSTORE DC CL21'QUERY VIRTUAL STORAGE'
-RETSTORE DC CL16' '
-#endif
-#if !defined(CERNLIB_QMIBMXA)
- DC F'20' Ry+1 = L'return buffer
-QVSTORE DC CL21'QUERY VIRTUAL STORAGE'
-RETSTORE DC CL20' '
-#endif
-*
- DS 0D For DIAG 08 if interactive
-NODEDIAG DC A(QUSERID) Rx -> command
- DC A(DIAG8BUF) Rx+1 -> Return buffer
- DC XL4'4000000C' Ry = x'40' flag + L'command
- DC F'20' Ry+1 = L'return buffer
-QUSERID DC CL12'QUERY USERID'
-DIAG8BUF DC CL12' '
-INTNODE DC CL8' '
-*
- LTORG
-*
-BATINFO DSECT
-BATUSER DS CL8 SENDER'S USERID
-BATACNT DS CL8 SENDER'S ACCOUNT
-BATBIN DS CL8 SENDER'S DIST CODE
-BATJOBID DS CL8 JOB ID
-BATMONID DS CL8 BMON ID
-BATMASTR DS CL8 MASTER MONITOR ID, OR "*"
-BATNODE DS CL8 MASTER NODEID, OR "*"
-BATSTRST DS CL8 START/RESTART
-BATMXTME DS CL8 MAX CPU TIME (NORMALISED SECONDS)
-BATTNORM DS CL8 100*CPU TIME NORMALISATION FACTOR
-*
- REGEQU
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncms/z308/iospak2.s b/src/packlib/kernlib/kerngen/obsolete/kerncms/z308/iospak2.s
deleted file mode 100644
index c7a03aa..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncms/z308/iospak2.s
+++ /dev/null
@@ -1,873 +0,0 @@
-*
-* $Id: iospak2.s,v 1.1.1.1 1996/02/15 17:51:57 mclareni Exp $
-*
-* $Log: iospak2.s,v $
-* Revision 1.1.1.1 1996/02/15 17:51:57 mclareni
-* Kernlib
-*
-*
-*--------------------------------------------------------------------
- PUNCH 'SPB' TELL LOADER TO START AT NEXT PAGE
-* The '"' character in previous statement is a X'02'.
-* Do not edit the line without CMS SET INPUT " 02 first.
-*--------------------------------------------------------------------
- TITLE 'FULL-SCREEN OUTPUT ROUTINES FOR VM/CMS'
-* FLAG IOSWRT
-*--------------------------------------------------------------------
-* Routine to write a field on full-screen terminal
-*--------------------------------------------------------------------
-*
-* IRC = IOSWRT(LINE,LENGTH,LINENO,NCOL[,IATTR[,IBUF]])
-* IRC = IOSWRT('CLEAR')
-* IRC = IOSWRT()
-* IRC = IOSWRT('WRITE')
-* IRC = IOSWRT(0)
-* IRC = IOSWRT(IBUF)
-*
-* IRC = Integer return code: 0 = all ok
-* -1 = Terminal busy (CP)
-* -2 = Invalid Line Number
-* -3 = Invalid Column
-* -4 = String too long
-* -5 = No room for attribute
-* -6 = No Length
-* -7 = Interrupt Error
-* -8 = Diag Error
-* -10 = Device End missing
-* -11 = I/O still active
-* -12 = Too many arguments
-* -2xx = HNDINT SET error 'xx'
-* -3xx = WAITD error 'xx'
-* -4xx = HNDINT CLR error 'xx'
-*
-* LINE = Character array, Hollerith constant or Integer array;
-* 'CLEAR', 'CL' or no parameter clears the screen,
-* 'WRITE', 'WR' or 0 writes screen from internal buffer,
-* IBUF as the only parm writes screen from IBUF,
-* subsequent writes to screen are superposed.
-* LENGTH = Length of string in bytes (0 for an empty field).
-* If negative the cursor is moved to LINENO, NCOL, and
-* no new field is generated (IATTR ignored).
-* LINENO = Screen Line number (0 = unchanged).
-* NCOL = Screen Column number (0 = unchanged).
-* If both LINENO and NCOL = 0 the string is appended
-* to last string, in the last field defined.
-* IATTR = Attribute Byte, forces the start of a new field; if
-* missing, the string is placed in the existing field.
-* It is ignored if LENGTH < 0.
-* IBUF = Optional parameter - when missing an immediate write
-* of the field is executed, otherwise it is must be an
-* INTEGER*4 user buffer used to set up a screen. The
-* field is just assembled into the buffer, if it is a
-* zero, the internal buffer is used instead. The first
-* two integers of IBUF must contain the buffer length
-* in bytes (dimension*4-8 or less) and the amount used
-* by previous calls (0 = buffer empty). This quantity
-* is updated by the routine.
-*
-* Note: the screen must be cleared to force CP to relinquish the
-* control. Error -8 signals the user when CP has regained
-* control of the screen (in case of a message) destroying
-* all the information displayed; in this case the display
-* must be rebuilt by the user.
-*
-* 3270 Attribute Byte layout:
-*
-* 0 1 2 3 4 5 6 7
-* +-------------+------+------+------+------+------+------+
-* | see table | Prot | Num | Int | L.P. | -- | MDT |
-* +-------------+------+------+------+------+------+------+
-*
-* Table for Bits 0-1:
-*
-* Bits 4-7 -> 0 1 2-9 A-F
-* Bits 2-3 +----+-----------+------+
-* | 00 | 40 | C0 | 40 | Unprotected Alphanum.
-* V | | | |
-* 01 | 40 | C0 | 40 | Unprotected Numeric
-* | +----+ | |
-* 10 | 40 | C0 | 40 | Protected Alphanum.
-* +---------+ | |
-* 11 | C0 | 40 | Protected Numeric
-* +----------------+------+
-*
-* Bits 4-5: 00 01 10 11
-*
-* * * * - Display
-* - - * - Intensified
-* - * * - Selector Pen detectable
-* * * * - Printable
-*
-* Bit 6: Reserved
-*
-* Bit 7: Modified Data Tag (may be set by program write)
- SPACE 2
-* Author: Elia PEROTTO - CERN EP Division - tel. 7672303
-* - CNUCE/CNR - Pisa - tel. 593268
-* VERSION 1.0 - 14 Dec 1987
-* 1.1 - 11 Apr 1989 CMS 5.5 compatible (macro HNDINT modified)
- SPACE 2
-IOSWRT CSECT
-#if defined(CERNLIB_QMIBMXA)
-IOSWRT AMODE ANY
-IOSWRT RMODE ANY
-#endif
-&DT SETC 'IOSWRT &SYSDATE&SYSTIME' For debugging
- SAVE (14,12),,&DT
- LR R12,R15
- USING IOSWRT,R12
- LR R10,R1 Save args pointer
-GATE B INIT Fetch real console characteristics
-*
- LA R11,INTBUFF Default to internal buffer
- MVI STAT,0 Clear status flags
- LTR R10,R10 Any Parm?
- BZ CLEAR None, clear then
-*
- LM R3,R8,0(R10) Load args addresses
- LTR R2,R3 R2 = buffer address
- BH NOONE Branch if not last parm
-*
- ICM R1,15,0(R2) Is it a zero?
- BZ REWRITE Yes, rewrite buffer
- BH USWRITE Write user buffer
-* Negative, EBCDIC string
- CLC 0(2,R2),=C'WR' Is it a keyword?
- BE REWRITE Yes, write then
-*
- CLC 0(2,R2),=C'CL' Is it a keyword?
- BE CLEAR Yes, clear then
-*
-ERROR6 LH R0,=H'-6' Code for no length specified
- B ERROR
- SPACE 1
-NOONE LR R1,R4 Save length addr
- ICM R4,15,0(R4) R4 = buffer length
- BNL GO Positive
- OI STAT,CURSOR Negative, put cursor here
-*
-GO ST R4,LENGTH Save length here
- LTR R1,R1 Was it last parm?
- BL GO2 Yes
-*
- LR R1,R5 Save Line Number addr
- ICM R5,15,0(R5) Get Line Number
- BNZ CHLINE
- OI STAT,SAMELIN Do not change line
- B GO4
- SPACE 1
-CHLINE BCTR R5,0 Decrement for displacement form
- CL R5,LASTLINE Is it outside screen?
- BNL ERROR2 -2
-*
- ST R5,LINENO
-GO4 LTR R1,R1 Was it last parm?
- BL GO2 Yes
-*
- LR R1,R6 Save Column addr
- ICM R6,15,0(R6) Get Column
- BNZ CHCOL If zero...
- OI STAT,SAMECOL ...do not change column
- TM STAT,NOSBA Line unchanged too?
- BM GO5
- MVC COLUMN,OLDCOL Get last position
- B GO5
- SPACE 1
-CHCOL BCTR R6,0 Decrement for displacement form
- CL R6,LINELEN Is it outside line length?
- BNL ERROR3 -3
-*
- ST R6,COLUMN Save Column
-GO5 LTR R1,R1 Was it last parm?
- BNL GO3 No
- OI STAT,NOFIELD No new Field
- B GO2 Skip Attr & Buffer processing
- SPACE 1
- USING SCRNBUF,R11
-GO3 LTR R7,R7 Was it last parm?
- BNL STORE No, store in buffer
- LA R0,1
- ST R0,LDONE Init LDONE with WCC
- OI STAT,IMMED Remember it
- B GO1
- SPACE 1
-STORE OI STAT,SAVE Assemble field into buffer
- LTR R11,R8 Copy buffer addr in R11
- BNL ERROR12 Too many arguments -12
-*
- ICM R1,15,BUFLEN Is a user buffer there?
- BNZ GO1 Yes
-*
- LA R11,INTBUFF No, use our internal buffer
-GO1 L R7,0(R7) Get Attribute
- ST R7,ATTR Save Attribute (for debug)
-GO2 LM R5,R7,LINENO Load Line, Column & Attribute
- TM STAT,CURSOR+NOFIELD Attribute required?
- BNZ NOATTR No attribute
-*
- TM STAT,NOSBA Concatenate?
- BO NOATTR Yes, leave space for Attribute
-*
- BCTR R6,0 Back up Column for Attribute
-NOATTR BAL R14,GETADDR0
- ICM R1,15,LDONE Get used bytes
- BNZ WCC1 WCC place left
- LA R1,1 Save place for WCC (first call)
-WCC1 LA R5,BUFFER(R1) Starting byte
- TM STAT,NOSBA Concatenate?
-* BO SKIPSBA Yes, skip SBA business
- MVI 0(R5),SBA Store Set Buffer Address
- STCM R8,3,1(R5) Store 2 6-bit screen address parts
- TR 1(2,R5),ATAB Translate to EBCDIC
- LA R5,3(R5) Skip over SBA + addr
- LA R1,3(R1) Count SBA + addr
-SKIPSBA LTR R4,R4 Negative length?
- BL INSCUR
-*
- L R8,BUFLEN Get last byte addr
- SR R8,R4 Subtract String Length
- CR R1,R8 Is R5 too forward?
- BH ERROR4 Yes, error -4
-*
- TM STAT,NOFIELD Start Field required?
- BNZ NOSF No Start Field
-*
- MVI 0(R5),SF Deposit Start Field
- N R7,=F'63' Clear high bits
- IC R0,ATAB(R7) Translate Attribute
- STC R0,1(R5) Deposit attribute
- LA R5,2(R5) Skip over SF,Attr
- LA R1,2(R1) Count SF,Attr
-NOSF LTR R9,R4 Is it a null String?
- BZ NULLSTR Yes
-*
- BCTR R9,0 Decrement for Execute
- EX R9,MOVESTR Move String
-NULLSTR LA R1,0(R4,R1) Add String length
-INSCUR2 ST R1,LDONE
- A R4,COLUMN Calculate end of string
- ST R4,OLDCOL Remember last position
- TM STAT,SAVE Just save?
- BZ USWRITE2 No, write to screen
- B RETURN Yes
- SPACE 1
-INSCUR MVI 0(R5),IC Insert Cursor
- LA R1,1(R1) Count IC, no need to update R5
- B INSCUR2 Branch on negative length
- SPACE 1
-* 3270 Orders:
-*
-SBA EQU X'11' Set Buffer Address
-IC EQU X'13' Insert Cursor
-SF EQU X'1D' Start Field
-RA EQU X'3C' Repeat to Address
- SPACE 2
-MOVESTR MVC 0(0,R5),0(R2) Executed MVC
- EJECT
-*--------------------------------------------------------------------
-* Write a Buffer to Screen
-*--------------------------------------------------------------------
-USWRITE LR R11,R2 User buffer address
-USWRITE2 LA R1,2 Keyboard restore
- B WCCDONE
- SPACE 1
-REWRITE LA R11,INTBUFF Use our internal buffer
- LA R1,3 Keyboard restore + Reset MDT
-WCCDONE L R4,LDONE
- IC R1,ATAB(R1) Translate WCC
- STC R1,WCC Deposit WCC
- LA R5,DISPCCW Get ccw address in R5
- LA R2,BUFFER
- STCM R2,B'0111',1(R5) Store buffer address
- STH R4,6(R5) Store byte count
- TS FLAG Is the path clear?
- BNZ ERROR11 No, signal error -11 to caller
-*
- L R6,CONSADDR Get console address
- BAL R14,HNDINT Start interrupt handling *5.5*
-* HNDINT issued past here *ERROR
- LH R2,=H'-8' Error code for I/O error
- DIAG R5,R6,X'58' Write to screen
- BNZ ERROR8 Something went wrong in the diagnose
- XR R2,R2 Clear error code
- CLI FLAG,0 Is Flag clear
- BZ NOWAIT Yes, interrupt already gone
- BAL R14,WAIT Wait for I/O to finish *5.5*
-*--------------------------- Wait for I/O ---------------------------
-NOWAIT BAL R14,HNDINT0 Disable Interrupt Handler *5.5*
- LTR R0,R2 Any previous error?
- BNZ ERROR Yes, signal error to caller
-*
- CLI FLAG,0 Is Flag clear
- BNZ ERROR7 No, signal error -7 to caller
-*
- TM CSWST,DE Attention signalled?
- BZ ERROR10 No, signal error -10 to caller
-*
- CLI CSWST,X'8E' Screen in use (busy)?
- BZ ERROR1 Yes, signal error -1 to caller
-*
- MVI CCWCT,0 Clear Erase/Write flag
-* SH R4,CSW+6 Subtract residual count
- TM STAT,IMMED Should this field be saved?
- BZ RETURN Yes, leave pointer
-*
- LA R0,1 Initialize buffer count...
- ST R0,LDONE ...to 1 (WCC)
-RETURN EQU *
-ERROR ST R0,20(R13) Save it on caller's R0
- RETURN (14,12) Return to fortran caller
- SPACE 1
-ERROR1 LH R0,=H'-1' Code for Screen Busy for CP
- B ERROR
- SPACE 1
-ERROR2 LH R0,=H'-2' Code for invalid line no.
- B ERROR
- SPACE 1
-ERROR3 LH R0,=H'-3' Code for invalid column
- B ERROR
- SPACE 1
-ERROR4 LH R0,=H'-4' Code for overflow error
- B ERROR
- SPACE 1
-ERROR5 LH R0,=H'-5' Code for underflow error
- B ERROR
- SPACE 1
-ERROR7 LH R0,=H'-7' Error code for Interrupt error
- B ERROR
- SPACE 1
-ERROR8 MVI FLAG,0 -8 I/O not started
- B NOWAIT Release Interrupt Handling
- SPACE 1
-ERROR10 LH R0,=H'-10' Error code for DE miss
- B ERROR
- SPACE 1
-ERROR11 LH R0,=H'-11' Error code for Screen Busy for us
- B ERROR
- SPACE 1
-ERROR12 LH R0,=H'-12' Error code for too many arguments
- B ERROR
- SPACE 1
-ERROR20 LH R0,=H'-200' Error code for HNDINT
- B ERRADD
- SPACE 1
-ERROR40 LH R0,=H'-400' Error code for HNDINT
-ERRADD SR R0,R15
- B ERROR
- SPACE 1
- EJECT
-* FLAG IOSDIM
-*--------------------------------------------------------------------
-* Routine to retrieve the screen dimensions
-*--------------------------------------------------------------------
-*
-* CALL IOSDIM(LINES,NCOL)
-*
- ENTRY IOSDIM
- USING IOSDIM,R15
-IOSDIM SAVE (14,12)
- L R12,=A(IOSWRT) Get Module addressability
- DROP R15
- LM R7,R8,0(R1) Get argument addresses
- BAL R14,GETMODEL Get 3270 information
- ST R1,0(R7) Store number of lines
- ST R2,0(R8) Store number of columns
- RETURN (14,12)
- SPACE 3
-*--------------------------------------------------------------------
-* Clear Screen and Internal Buffer
-*--------------------------------------------------------------------
-CLEAR OI CCWCT,X'80' Set Erase/Write flag
- LA R11,INTBUFF Empty internal buffer
- XR R1,R1 Clear number of...
- ST R1,LDONE ...bytes assembled
- B RETURN
- EJECT
-*--------------------------------------------------------------------
-* Get 3270 buffer address
-*--------------------------------------------------------------------
-*
-GETADDR0 LR R8,R5 Get line no.
- MH R8,LINELEN+2 Multiply by line length
- AR R8,R6 Add column no.
- BL ERROR5 -5
-*
- SRDL R8,6 Push lower 6 bits into R9
- SRL R9,2 Add 2 zero bits
- SLDL R8,8 Pull 8 bits in R8
- BR R14
- SPACE 3
-*--------------------------------------------------------------------
-* Initialize Device Characteristics
-*--------------------------------------------------------------------
-INIT BAL R14,GETMODEL Find 3270 model
- B GATE
- SPACE 1
-GETMODEL XR R0,R0 Clear error code
- LR R4,R0 Console address...
- BCTR R4,0 ...unknown
- DIAG R4,R5,X'24' Get console information
- BNZR R14 Terminal disconnected...
-*
- MVI GATE+1,0 Nop the branch
- STM R4,R6,CONSADDR Save it here...
-* STH R4,HNDINT+24 ...and in HNDINT Plist (CMS 4.0)
-* STH R4,HNDINT+28 ...and in HNDINT Plist (CMS 5.5)
- XR R1,R1
- IC R1,CONSMODL Get 327X Model number
- BCTR R1,0 Table Displacement
- IC R1,MODELTAB(R1) Get screen lines
- XR R2,R2
- IC R2,CONSLLEN Get line length
- LA R4,DEVINFO Buffer address
- L R5,CONSADDR Console address
- LA R6,8 Buffer length
- DIAG R4,R6,X'8C' Get model 5 screen dimensions
- LTR R0,R5 Any error?
- BNZ MODELX Yes
-*
- LH R2,DEVINFO+2 Get screen width
- LH R1,DEVINFO+4 Get screen height
-MODELX STM R1,R2,LASTLINE Last screen line
- BR R14 Back to normal operation
- SPACE 1
-MODELTAB DC AL1(12,24,35,43,27) Model 1..5 screen lines
- EJECT
-*--------------------------------------------------------------------
-* Initialize Interrupt Handler
-*--------------------------------------------------------------------
-*
-HNDINT HNDINT SET,(CON1,NETINT,009,ASAP),ERROR=ERROR20
- BR R14
- SPACE 1
-*--------------------------------------------------------------------
-* Wait for Console I/O completion
-*--------------------------------------------------------------------
-*
-* Wait for console I/O (WAITT does not work)
-WAIT WAITD CON1,ERROR=ERROR30
- BR R14
- SPACE 1
-ERROR30 LH R2,=H'-300' Base error code for WAITD
- SR R2,R15 Add positive WAITD error
- BR R14 We must deactivate HNDINT
- SPACE 1
-*--------------------------------------------------------------------
-* Disable Interrupt Handler
-*--------------------------------------------------------------------
-*
-HNDINT0 HNDINT CLR,CON1,ERROR=ERROR40 Stop interrupt handling
- BR R14
- EJECT
-*--------------------------------------------------------------------
-* DEVICE I/O INTERRUPT HANDLER
-*--------------------------------------------------------------------
-* FLAG NETINT
- USING NETINT,R15
-NETINT C R4,CONSADDR Is it console?
- BNE INTPASS No
-*
- CLI FLAG,X'FF' Is it our start I/O?
- BNE INTPASS No
-*
- STM R2,R3,CSW Save csw
- TM CSWST,DE+ATTN Last interrupt (Device End)?
- BZ INTEXIT No, wait for next
-*
- MVI FLAG,0 Yes, clear flag to signal completion
-INTPASS XR R15,R15 Dispatch main task
-INTEXIT BR R14 Return to cms interrupt handler
- SPACE 2
-FLAG DC X'00' Synchronization flag (0 = free)
-STAT DC X'00' Status flags
-SAVE EQU X'80' Save field in buffer
-IMMED EQU X'40' Immediate write
-SAMELIN EQU X'20' Same Line as previous Field
-SAMECOL EQU X'10' Same Col. as previous Field
-NOSBA EQU SAMELIN+SAMECOL Concatenate strings
-CURSOR EQU X'02' Insert Cursor
-NOFIELD EQU X'01' No new field
-*
-DISPCCW CCW X'29',0,SILI,0 Write CCW
-CCWCT EQU DISPCCW+5 CCW Control Byte
-SILI EQU X'20' Suppress incorrect length indication
-CSW DS D Saved from last interrupt
-CSWST EQU CSW+4 CSW Status Byte
-ATTN EQU X'80' Attention Bit
-DE EQU X'04' Device End Bit
-*
-DEVINFO DS D Buffer for diagnose 24
-CONSADDR DS 2F Buffer for diagnose 8c
-CONSRCLS DS X RDEVTYPC Class
-CONSRTYP DS X RDEVTYPE Type
-CONSMODL DS X RDEVMDL Model
-CONSLLEN DS X RDEVLLEN Line Length
-LASTLINE DC F'24' Last Screen Line
-LINELEN DC F'80' Default line length
-LENGTH DC F'0' Arg string length
-LINENO DC F'1' Line number
-COLUMN DC F'2' First usable column in line 1
-ATTR DC F'0' 3270 attribute byte
-OLDCOL DC F'0'
-ATAB DC C' ABCDEFGHI',X'4A4B4C4D4E4F' '\.<(+|'
- DC C'&&JKLMNOPQR',X'5A5B5C5D5E5F' '!$*);~'
- DC C'-/STUVWXYZ',X'6A6B6C6D6E6F' '^,%_>?'
- DC C'0123456789',X'7A7B7C7D7E7F' ':#@''="'
- SPACE 2
- LTORG
-*
-BLEN EQU 4096-*+IOSWRT-12
-INTBUFF DC A(BLEN,0) Internal buffer length
- DS (BLEN)X Internal buffer
-ENDMOD EQU *
- SPACE 1
-SCRNBUF DSECT
-BUFLEN DC A(BLEN) Length of SCREEN Buffer
-LDONE DC A(1) Bytes in SCREEN Buffer
-BUFFER EQU *
-WCC DS X
- SPACE 3
- REGEQU
- END
- TITLE 'MACROS'
-*--------------------------------------------------------------------
- MACRO
- PAGE
- PUNCH 'SPB' TELL LOADER TO START AT NEXT PAGE
- MEND
-*--------------------------------------------------------------------
- PAGE LOAD ON A FULL PAGE BOUNDARY
- TITLE 'FULL-SCREEN INPUT ROUTINES FOR VM/CMS'
-*--------------------------------------------------------------------
-* Routine to read a field on full-screen terminal
-*--------------------------------------------------------------------
-*
-* IRC = IOSRD (ECB)
-* IRC = IOSRD (LINE,LENGTH,LINENO,NCOL)
-* IRC = IOSFLD(LINE,LENGTH,LINENO,NCOL)
-*
-* ECB = Event Control Block (Integer 0)
-*
-* IRC = INTEGER RETURN CODE: 0 = All OK (Enter pressed)
-* R0 1..24 = PFKey pressed
-* R0 -1 = Terminal Busy
-* R0 -2 = PA2 Key
-* R0 -3 = CLEAR Key
-* R0 -4 = Unsolicited Read (no AID)
-* R0 -5 = Incorrect Parm Number
-* R0 -6 = Attention Error
-* R0 -7 = Attention Miss
-* R0 -8 = Diagnose Error
-* R0 -9 = Device End Miss
-* LINE = Character array or Hollerith constant
-* LENGTH = Length of string in bytes (may be 0)
-* LINENO = Screen Line number
-* NCOL = Screen Column number
-*
-* Author: Elia PEROTTO - CERN EP Division - tel. 7672303
-* - CNUCE/CNR - Pisa - tel. 593268
-* VERSION 1.0 - 10 Dec 1987
-*
-IOSRD CSECT
-#if defined(CERNLIB_QMIBMXA)
-IOSRD AMODE ANY
-IOSRD RMODE ANY
-#endif
-&DT SETC 'IOSRD &SYSDATE&SYSTIME' For debugging
- SAVE (14,12),,&DT
- LR R12,R15
- USING IOSRD,R12
- LR R10,R1 Save args pointer
-GATE B INIT Fetch real console characteristics
-*
- LTR R10,R10 No args?
- BZ ERROR5 Yes, error -5
-*
- LM R3,R6,0(R10) Load args addresses
- STM R3,R6,PARMS Save parms
- LTR R1,R3 Is it last and only Parm?
- BL ECBSET Yes, just set ECB
-*
- LTR R6,R6 Is it last Parm?
- BNL ERROR5
-*
- XR R1,R1 No need of ECB any more
- BAL R14,SETINT Go set interrupt trap
-*
- WAITD CON1 Wait for console ATTN (WAITT doesn't work)
-*----------------------------------------------------------------------
- XC ECBADR,ECBADR Forget ECB
- TS FLAG Is the path clear?
- BNZ ERRORI6
-*
- TM CSWST,ATTN Attention signalled?
- BZ ERRORI7
-*
- CLI CSWST,ATTN Attention signalled?
- BNE ERROR256
-*
- L R7,0(R4) Get length
- CH R7,=H'4' More than 4?
- BH USRBUF Yes, use his buffer
-*
- LA R3,BUFFER Use internal buffer
- LA R7,L'BUFFER-4 Its length (less AID code)
-USRBUF LA R1,DISPCCW Get ccw address in R1
- MVI 0(R3),0 Clear old AID byte
- ST R3,BUFADR Save for IOSFLD
- STCM R3,B'0111',1(R1) Store buffer address
- OI 5(R1),X'80' Set Read Modified flag
- STH R7,6(R1) Store byte count
- LA R2,9 Get console address
- DIAG R1,R2,X'58' Read screen
- BNZ ERRORI8 Something went wrong in the diagnose
-*
- WAITD CON1 Wait for console I/O (WAITT does not work)
-*--------------------------------------------------------------------
- BAL R14,CLRINT Go clear interrupt trap
- SH R7,CSW+6 Subtract residual count
- ST R7,0(R4) Update length
- ST R7,LENGTH Update length
- A R7,BUFADR Find last addr
- ST R7,EOB Store as End Of Block
- TM CSWST,CE+DE Device End arrived?
- BNO IOERR9 No, signal error to caller
-*
- LA R7,31 Error code for BUSY
- CLI CSWST,X'8E' Device Busy?
- BE IOERR2 Yes, signal error to caller
-*
- LA R7,3 AID + ADDR1 + ADDR2
- ST R7,LDONE Init length done
- IC R7,0(R3) Get AID byte
- N R7,=F'31' Clear high bits
-IOERR2 SLL R7,1 Multiply by 2
- LH R1,AIDCODE(R7) Get PFKey number
- STH R1,ERC Save for user
- SLL R7,1 Multiply by 2
- L R1,AIDTAB(R7) Get descriptive word
-*
- LR R7,R3 Load 3270 buffer address
- BAL R14,GETADDR Translate to Line/Column
- L R3,PARMS Restore user buffer
-RETURN LH R0,ERC Signal no errors
-ERROR ST R0,20(R13) Save it on caller's R0
- XC ERC,ERC Clear return code
- RETURN (14,12) Return to fortran caller
- SPACE 1
-IOERR MVC 0(2,R3),CSWST Copy CSW Status to User Buffer
- B ERROR
- SPACE 1
-ECBSET BAL R14,SETINT Go set interrupt trap
- B RETURN
- SPACE 1
-ERROR1 LH R0,=H'-1' Error code for Terminal Busy
- B ERROR
- SPACE 1
-ERROR5 LH R0,=H'-5' No Parms error code
- B ERROR
- SPACE 1
-ERRORI6 LH R0,=H'-6' Error code for Attn
- B ERRORI
- SPACE 1
-ERRORI7 LH R0,=H'-7' Error code for Attn miss
- B ERRORI
- SPACE 1
-ERROR256 LH R0,CSWST Error code for Attn plus
- B ERRORI
- SPACE 1
-ERRORI8 LH R0,=H'-8' Error code for I/O error
-ERRORI STH R0,ERC
- BAL R14,CLRINT Go clear interrupt trap
- B RETURN
- SPACE 1
-IOERR9 LH R0,=H'-9' Error code for DE miss
- B IOERR
- SPACE 1
-ERC DC H'0' Return code
-*
-*--------------------------------------------------------------------
-* Initialize Device Characteristics
-*--------------------------------------------------------------------
-INIT BAL R14,GETMODEL
- MVI GATE+1,0 Nop the branch
- B GATE
-*
-GETMODEL XR R0,R0 Clear error code
- LA R4,9 Console address
- DIAG R4,R5,X'24' Get console information
- STM R4,R6,CONSINFO Save it here
- LA R1,24 Model 2 has 24 lines
- CLI CONSINFO+10,2 Is it a model 2?
- BE MODELX Yes it is
-*
- LA R1,27 Default model 5 lines (27)
- LA R4,DEVINFO Buffer address
- LA R5,9 Console address
- LA R6,8 Buffer length
- DIAG R4,R6,X'8C' Get model 5 screen dimensions
- LTR R0,R5 Any error?
- BNZ MODELX Yes
-*
- LH R1,DEVINFO+2 Get screen width
- ST R1,LINELEN
- LH R1,DEVINFO+4 Get screen height
-MODELX LR R5,R1
- BCTR R5,0 Put it in displacement form
- ST R5,LASTLINE Last screen line
- BR R14 Back to normal operation
-*
-*--------------------------------------------------------------------
-* Set I/O Interrupt Trap
-*--------------------------------------------------------------------
-SETINT XR R0,R0
- C R0,ECBADR Interr. already cared for?
- BNZR R14 Yes, HNDINT already set
-*
- ST R1,ECBADR Save user ECB address or 0
- TS FLAG Is the path clear?
- BNZ ERROR1 No, signal error to caller
-*
- HNDINT SET,(CON1,NETINT,009,ASAP) start interrupt handl.
- BR R14
-*
-*--------------------------------------------------------------------
-* Clear I/O Interrupt Trap
-*--------------------------------------------------------------------
-CLRINT HNDINT CLR,CON1 Stop interrupt handling
- BR R14
-*
-*--------------------------------------------------------------------
-* DEVICE I/O INTERRUPT HANDLER
-*--------------------------------------------------------------------
-NETINT EQU *
- USING *,R15
- CH R4,=H'9' Is it console?
- BNE INTPASS No
-*
- CLI FLAG,X'FF' Is it our start i/o?
- BNE INTPASS No
-*
- STM R2,R3,CSW Save CSW
- TM CSWST,DE+ATTN Last interrupt (Device End)?
- BZ INTEXIT No, wait for next
-*
- MVI FLAG,0 Yes, clear flag to signal completion
- ICM R1,15,ECBADR Get ECB address if any
- BZ INTPASS None
-*
- ST R3,0(R1) Store CSW Status and residual count
-INTPASS XR R15,R15 Dispatch main task
- BR R14 Return to cms interrupt handler
-*
-INTEXIT STM R2,R3,CSW1 Save CSW
- BR R14 Return to cms interrupt handler
-*
-FLAG DC X'00' Synchronization flag (0 = free)
-*
-DISPCCW CCW X'2A',0,SILI,0 Read CCW
-SILI EQU X'20' Suppress incorrect length indication
-CSW1 DS D Saved from first interrupt
-CSW DS D Saved from last interrupt
-CSWST EQU CSW+4 CSW Status Byte
-ATTN EQU X'80' Attention Bit
-CE EQU X'08' Channel End Bit
-DE EQU X'04' Device End Bit
-*
-DEVINFO DS 0D Buffer for diagnose 24
-CONSINFO DS 3F Buffer for diagnose 8c
-LASTLINE DC F'23' 2nd input line
-LINELEN DC F'80' Default line length
-PARMS DS 4F
-LENGTH DC F'0' Bytes read
-LDONE DC F'0' Bytes seen
-BUFADR DS A User or Our buffer address
-ECBADR DC A(0) Event Control Block address
- EJECT
-*--------------------------------------------------------------------
-* FIELD ENTRY POINT
-*--------------------------------------------------------------------
-*
- ENTRY IOSFLD
- USING IOSFLD,R15
-&DT SETC 'IOSFLD &SYSDATE&SYSTIME' For debugging
-IOSFLD SAVE (14,12),,&DT
-IOSF2 L R12,=A(IOSRD)
- DROP R15
- LM R3,R6,0(R1) Load args addresses
-* R3 = buffer address
-* R4 = buffer length addr
-* R5 = line number addr
-* R6 = column number addr
- XR R2,R2
- BCTR R2,0 Set to -1
- L R7,LDONE Load Pointer
- C R7,LENGTH Check if finished
- BNL EOS2 Finished already
-*
- STM R3,R6,PARMS Save parms
- A R7,BUFADR
- BAL R14,GETADDR
- L R8,0(R4) Get Length
- XR R2,R2 Init length
-LOOP C R7,EOB Is it End Of Block?
- BNL EOS Yes
-*
- CLI 0(R7),X'11' Is it SBA?
- BE EOF Yes, End Of Field
-*
- LA R2,1(R2) Count next byte
- CR R2,R8 Past user buffer?
- BH USRFULL Yes
-*
- MVC 0(1,R3),0(R7) Move 1 byte
- LA R3,1(R3) Update Target Pointer
-USRFULL LA R7,1(R7) Update Source Pointer
- B LOOP No
- SPACE 1
-EOF S R7,BUFADR Get length
-EOS ST R7,LDONE Store length done
-EOS2 ST R2,0(R4) Store String (real) Length
- RETURN (14,12) Return to fortran caller
- EJECT
-*--------------------------------------------------------------------
-* Translate Buffer Address to Line/Column
-*--------------------------------------------------------------------
-*
-GETADDR LA R7,1(R7) Skip AID or SBA
- XR R8,R8
- ICM R8,3,0(R7) Load in addr
- LA R7,2(R7) Skip Addr
- SRDL R8,6 Push lower 6 bits
- SRL R8,2 Discard 2 bits
- SRDL R8,6 Push upper 6 bits
- SRL R9,20 Right adjust the 12 bits
- XR R8,R8 Clear for divide
- D R8,LINELEN Divide by line length
- LA R8,1(R8) Start from 1
- LA R9,1(R9) " " "
- ST R8,0(R6) Store column
- ST R9,0(R5) Store line
- BR R14
- SPACE 2
-LINE DS F
-COLUMN DS F
-EOB DS A
- LTORG
- DS 0D
-AIDCODE DC AL2(99,13,14,15,16,17,18,19)
- DC AL2(20,21,22,23,24,-3,-2,99)
- DC AL2(-4,01,02,03,04,05,06,07)
- DC AL2(08,09,10,11,12,00,00,-1)
-AIDTAB DC C'-- PF13PF14PF15PF16PF17PF18PF19'
- DC C'PF20PF21PF22PF23PF24CLR PA2 ????'
- DC C'TREQPF01PF02PF03PF04PF05PF06PF07'
- DC C'PF08PF09PF10PF11PF12ENTRSLPABUSY'
-*
- LTORG
-*
-BLEN EQU 4096-*+IOSRD-4
-BUFFER DS XL(BLEN) Screen Buffer
-*
- REGEQU
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncms/z310/cfclos.F b/src/packlib/kernlib/kerngen/obsolete/kerncms/z310/cfclos.F
deleted file mode 100644
index bd0896c..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncms/z310/cfclos.F
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: cfclos.F,v 1.1.1.1 1996/02/15 17:51:57 mclareni Exp $
-*
-* $Log: cfclos.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:57 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE CFCLOS (LUNDES, MEDIUM)
-C
-C CERN PROGLIB# Z310 CFIO .VERSION KERNCMS 1.07 911119
-C ORIG. 19/11/91, Miguel Marquina
-C Dummy version of CFIO routines for portability of code
-C
- PRINT *,'Z310 CFCLOS: routine not available on VM/CMS.' ,
- + 'Program stopped.'
- STOP
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncms/z310/cfget.F b/src/packlib/kernlib/kerngen/obsolete/kerncms/z310/cfget.F
deleted file mode 100644
index 1caeab1..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncms/z310/cfget.F
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: cfget.F,v 1.1.1.1 1996/02/15 17:51:57 mclareni Exp $
-*
-* $Log: cfget.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:57 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE CFGET (LUNDES, MEDIUM, NWREC, NWTAK, MBUF, ISTAT)
-C
-C CERN PROGLIB# Z310 CFIO .VERSION KERNCMS 1.07 911119
-C ORIG. 19/11/91, Miguel Marquina
-C Dummy version of CFIO routines for portability of code
-C
- PRINT *,'Z310 CFGET : routine not available on VM/CMS.' ,
- + 'Program stopped.'
- STOP
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncms/z310/cfopen.F b/src/packlib/kernlib/kerngen/obsolete/kerncms/z310/cfopen.F
deleted file mode 100644
index 6322728..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncms/z310/cfopen.F
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: cfopen.F,v 1.1.1.1 1996/02/15 17:51:57 mclareni Exp $
-*
-* $Log: cfopen.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:57 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE CFOPEN (LUNDES, MEDIUM, NWREC, MODE, NBUF, NAME, ISTAT)
-C
-C CERN PROGLIB# Z310 CFIO .VERSION KERNCMS 1.07 911119
-C ORIG. 19/11/91, Miguel Marquina
-C Dummy version of CFIO routines for portability of code
-C
- PRINT *,'Z310 CFOPEN: routine not available on VM/CMS.' ,
- + 'Program stopped.'
- STOP
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncms/z310/cfput.F b/src/packlib/kernlib/kerngen/obsolete/kerncms/z310/cfput.F
deleted file mode 100644
index 9c87f69..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncms/z310/cfput.F
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: cfput.F,v 1.1.1.1 1996/02/15 17:51:58 mclareni Exp $
-*
-* $Log: cfput.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:58 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE CFPUT (LUNDES, MEDIUM, NWREC, MBUF, ISTAT)
-C
-C CERN PROGLIB# Z310 CFIO .VERSION KERNCMS 1.07 911119
-C ORIG. 19/11/91, Miguel Marquina
-C Dummy version of CFIO routines for portability of code
-C
- PRINT *,'Z310 CFPUT : routine not available on VM/CMS.' ,
- + 'Program stopped.'
- STOP
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncms/z310/cfseek.F b/src/packlib/kernlib/kerngen/obsolete/kerncms/z310/cfseek.F
deleted file mode 100644
index 1da0944..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncms/z310/cfseek.F
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: cfseek.F,v 1.1.1.1 1996/02/15 17:51:57 mclareni Exp $
-*
-* $Log: cfseek.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:57 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE CFSEEK (LUNDES, MEDIUM, NWREC, JCREC, ISTAT)
-C
-C CERN PROGLIB# Z310 CFIO .VERSION KERNCMS 1.07 911119
-C ORIG. 19/11/91, Miguel Marquina
-C Dummy version of CFIO routines for portability of code
-C
- PRINT *,'Z310 CFSEEK: routine not available on VM/CMS.' ,
- + 'Program stopped.'
- STOP
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncms/z313/jobinfo.F b/src/packlib/kernlib/kerngen/obsolete/kerncms/z313/jobinfo.F
deleted file mode 100644
index fc2056e..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncms/z313/jobinfo.F
+++ /dev/null
@@ -1,123 +0,0 @@
-*
-* $Id: jobinfo.F,v 1.1.1.1 1996/02/15 17:51:58 mclareni Exp $
-*
-* $Log: jobinfo.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:58 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- CHARACTER*(*) FUNCTION JOBINFO(PAR)
-C
-C CERN PROGLIB# Z313 JOBINFO .VERSION KERNCMS 1.06 910721
-C ORIG. 16/07/91, Miguel Marquina
-C Extraction of Job Information for SLAC-Batch and VMBatch systems
-C
- CHARACTER*(*) PAR
- PARAMETER (JBDATA=20)
- COMMON/Z313IN/JINFO(JBDATA,2)
- CHARACTER*8 JREQ(JBDATA), INFO(JBDATA), JINFO
- CHARACTER*8 USERID,HOSTID,STORSZ
- INTEGER SYSTEMF
-
- CHARACTER*80 LINE
-
- DATA JREQ/'SENDERID','ACCOUNT ','DISTCODE','USERID ','JOBID ',
- + 'STORAGE ','JOBSTAT ','HOSTID ','BMONID ','MBMONID ',
- + 'CPUTIME ','CPUFACT ','MACHINE ','BATCHSYS','GID ',
- + ' ',' ',' ',' ',' '/
- DATA INFO/'userid ','account ','distcode','userid ','INTERACT',
- + 'storage ',' ','nodeid ',' ',' ',
- + '9999. ','100 ','Unknown ','SLACBATC',' ',
- + ' ',' ',' ',' ',' '/
-
- IF(JFILL.EQ.1) GOTO 100
- JFILL =1
-C
- INFO(4)=USERID()
- INFO(6)=STORSZ()
- INFO(8)=HOSTID()
- INFO(1)=INFO(4)
-C
- IF(INFO(4)(1:5).EQ.'BATCH') INFO(14)='SLACBATC'
- IF(INFO(4)(1:5).EQ.'VMBAT') INFO(14)='VMBATCH '
- IF(INFO(4)(1:5).EQ.'?????') INFO(14)='CMSBATCH'
-C
- IF(INFO(14).EQ.'SLACBATC') THEN
-C*** SLAC-Batch
- NLINE=0
- OPEN(7,FILE='/BATCHSUB NAMES A',FORM='UNFORMATTED',ERR=50)
- 10 CONTINUE
- LINE=' '
- READ(7,NUM=NBYT,END=40) LINE
- NLINE=NLINE+1
- IF(LINE(1: 6).NE.':NICK.') GOTO 10
- NC=7
- DO 20 N=7,NBYT
- NC=NC+1
- IF(LINE(N:N).EQ.':') GOTO 30
- 20 CONTINUE
- 30 CONTINUE
- IF(LINE(NC-1:NC+5).NE.':VALUE.') GOTO 10
- NC=NC+6
- IF(LINE(7:14).EQ.'USERID ') INFO( 1)=LINE(NC:NC+7)
- IF(LINE(7:14).EQ.'ACCOUNT ') INFO( 2)=LINE(NC:NC+7)
- IF(LINE(7: 9).EQ.'BIN' ) INFO( 3)=LINE(NC:NC+7)
- IF(LINE(7:14).EQ.'JOBNAME ') INFO( 5)=LINE(NC:NC+7)
- IF(LINE(7:14).EQ.'STORAGE ') INFO( 6)=LINE(NC:NC+7)
- IF(LINE(7:14).EQ.'START_TY') THEN
- INFO( 7)=LINE(NC:NC+7)
- IF(INFO(7)(1:1).EQ.'s') INFO( 7)='START '
- IF(INFO(7)(1:1).EQ.'r') INFO( 7)='RESTART '
- ENDIF
- IF(LINE(7:14).EQ.'ORIGNODE') INFO( 8)=LINE(NC:NC+7)
- IF(LINE(7:10).EQ.'BMON' ) INFO( 9)=LINE(NC:NC+7)
- IF(LINE(7:10).EQ.'BMON' ) INFO(10)=LINE(NC:NC+7)
- IF(LINE(7:14).EQ.'TIME ') INFO(11)=LINE(NC:NC+7)
- IF(LINE(7:14).EQ.'CPU_FACT') INFO(12)=LINE(NC:NC+7)
- GOTO 10
- 40 CONTINUE
- CLOSE(7)
- 50 CONTINUE
- IF(INFO(6)(5:5).NE.'M') THEN
- MSTOR=ICHARN(INFO(6))/1024
- MS1=MSTOR/100
- MS2=MSTOR/10 - 10*MS1 +ICHAR('0')
- MS1=MSTOR/100 +ICHAR('0')
- MS3=MOD(MSTOR,10) +ICHAR('0')
- INFO(6)='0'//CHAR(MS1)//CHAR(MS2)//CHAR(MS3)//'M'
- ENDIF
- ELSEIF(INFO(14).EQ.'VMBATCH ') THEN
- IRC=SYSTEMF('VMBATCH SERVICE STACK $USER')
- IF(IRC.EQ.0) THEN
- CALL VMRTRM(LINE,LENS)
- INFO(1)=LINE(1:MIN(8,LENS))
- ENDIF
- IRC=SYSTEMF('VMBATCH SERVICE STACK NAME ')
- IF(IRC.EQ.0) THEN
- CALL VMRTRM(LINE,LENS)
- INFO(5)=LINE(1:MIN(8,LENS))
- ENDIF
- ELSEIF(INFO(14).EQ.'CMSBATCH') THEN
-C*** CMS-Batch system from IBM
- ENDIF
- CALL UCOPY(JREQ,JINFO(1,1),2*JBDATA)
- CALL UCOPY(INFO,JINFO(1,2),2*JBDATA)
-100 CONTINUE
-C-- Fill Job request
- JOBINFO=' '
- LPAR=LEN(PAR)
- IF(LPAR.LT.1) GOTO 120
- LINF=LEN(JOBINFO)
- DO 110 N=1,JBDATA
- IF(PAR.NE.JREQ(N)(1:LPAR)) GOTO 110
- JOBINFO=INFO(N)(1:MIN(8,LINF))
- GOTO 120
-110 CONTINUE
-120 CONTINUE
- RETURN
- END
-#ifdef CERNLIB_TCGEN_JOBINFO
-#undef CERNLIB_TCGEN_JOBINFO
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncms/z313/nodeid.F b/src/packlib/kernlib/kerngen/obsolete/kerncms/z313/nodeid.F
deleted file mode 100644
index 4d4cb64..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncms/z313/nodeid.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: nodeid.F,v 1.1.1.1 1996/02/15 17:51:59 mclareni Exp $
-*
-* $Log: nodeid.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:59 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- CHARACTER*8 FUNCTION HOSTID()
-C
-C CERN PROGLIB# Z313 HOSTID .VERSION KERNCMS 1.06 910716
-C ORIG. 16/07/91, Miguel Marquina
-C Extraction of Host Identifier
-C
- COMMON /Z313ID/ IREAD, STRING
- CHARACTER*40 STRING
- INTEGER SYSTEMF
-C
- IF(IREAD.NE.1) THEN
- IRC=SYSTEMF('IDENTIFY (LIFO')
- CALL VMRTRM(STRING,LENS)
- IREAD=1
- ENDIF
- HOSTID=STRING(13:20)
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncms/z313/rscsid.F b/src/packlib/kernlib/kerngen/obsolete/kerncms/z313/rscsid.F
deleted file mode 100644
index 127a7f4..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncms/z313/rscsid.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: rscsid.F,v 1.1.1.1 1996/02/15 17:51:59 mclareni Exp $
-*
-* $Log: rscsid.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:59 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- CHARACTER*8 FUNCTION RSCSID()
-C
-C CERN PROGLIB# Z313 RSCSID .VERSION KERNCMS 1.06 910716
-C ORIG. 16/07/91, Miguel Marquina
-C Extraction of RSCS Identifier
-C
- COMMON /Z313ID/ IREAD, STRING
- CHARACTER*40 STRING
- INTEGER SYSTEMF
-C
- IF(IREAD.NE.1) THEN
- IRC=SYSTEMF('IDENTIFY (LIFO')
- CALL VMRTRM(STRING,LENS)
- IREAD=1
- ENDIF
- RSCSID=STRING(26:33)
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncms/z313/storsz.F b/src/packlib/kernlib/kerngen/obsolete/kerncms/z313/storsz.F
deleted file mode 100644
index 990f76a..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncms/z313/storsz.F
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: storsz.F,v 1.1.1.1 1996/02/15 17:52:00 mclareni Exp $
-*
-* $Log: storsz.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:00 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- CHARACTER*8 FUNCTION STORSZ()
-C
-C CERN PROGLIB# Z313 STORSZ .VERSION KERNCMS 1.06 910721
-C ORIG. 21/07/91, Miguel Marquina
-C Extraction of Storage size
-C
- CHARACTER*15 STRING
- INTEGER SYSTEMF
-C
- IRC=SYSTEMF('QUERY STORAGE (LIFO')
- CALL VMRTRM(STRING,LENS)
- STORSZ=STRING(11:15)
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncms/z313/userid.F b/src/packlib/kernlib/kerngen/obsolete/kerncms/z313/userid.F
deleted file mode 100644
index 1d420df..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncms/z313/userid.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: userid.F,v 1.1.1.1 1996/02/15 17:51:59 mclareni Exp $
-*
-* $Log: userid.F,v $
-* Revision 1.1.1.1 1996/02/15 17:51:59 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- CHARACTER*8 FUNCTION USERID()
-C
-C CERN PROGLIB# Z313 USERID .VERSION KERNCMS 1.06 910716
-C ORIG. 16/07/91, Miguel Marquina
-C Extraction of User Identifier
-C
- COMMON /Z313ID/ IREAD, STRING
- CHARACTER*40 STRING
- INTEGER SYSTEMF
-C
- IF(IREAD.NE.1) THEN
- IRC=SYSTEMF('IDENTIFY (LIFO')
- CALL VMRTRM(STRING,LENS)
- IREAD=1
- ENDIF
- USERID=STRING( 1: 8)
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncry/_kcray/pilot.h b/src/packlib/kernlib/kerngen/obsolete/kerncry/_kcray/pilot.h
deleted file mode 100644
index 9df3206..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncry/_kcray/pilot.h
+++ /dev/null
@@ -1,21 +0,0 @@
-#if 0
-* This pilot patch was created from kerncry.car patch _kcray
-#endif
-#if 0
-* Pilot for system COS
-#endif
-#ifndef CERNLIB_QMCRY
-#define CERNLIB_QMCRY
-#endif
-#ifndef CERNLIB_CRYGS
-#define CERNLIB_CRYGS
-#endif
-#ifndef CERNLIB_CRYCOS
-#define CERNLIB_CRYCOS
-#endif
-#ifndef CERNLIB_TCGEN
-#define CERNLIB_TCGEN
-#endif
-#ifndef CERNLIB_XVECT
-#define CERNLIB_XVECT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncry/_kcru/normal.cra b/src/packlib/kernlib/kerngen/obsolete/kerncry/_kcru/normal.cra
deleted file mode 100644
index a88c862..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncry/_kcru/normal.cra
+++ /dev/null
@@ -1,26 +0,0 @@
-#if !defined(CERNLIB_P5BOOT)
-#ifndef CERNLIB_CRYGS
-#define CERNLIB_CRYGS
-#endif
-#ifndef CERNLIB_CRYUNI
-#define CERNLIB_CRYUNI
-#endif
-#ifndef CERNLIB_CCGEN
-#define CERNLIB_CCGEN
-#endif
-#ifndef CERNLIB_CCGENCX
-#define CERNLIB_CCGENCX
-#endif
-#ifndef CERNLIB_CCGENCF
-#define CERNLIB_CCGENCF
-#endif
-#ifndef CERNLIB_CCGENCI
-#define CERNLIB_CCGENCI
-#endif
-#ifndef CERNLIB_XVECT
-#define CERNLIB_XVECT
-#endif
-#ifndef CERNLIB_TCGEN
-#define CERNLIB_TCGEN
-#endif
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncry/_kcru/patchy.cra b/src/packlib/kernlib/kerngen/obsolete/kerncry/_kcru/patchy.cra
deleted file mode 100644
index 1c461b1..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncry/_kcru/patchy.cra
+++ /dev/null
@@ -1,68 +0,0 @@
-#if 0
-* Patch boot-strap
-#endif
-#if defined(CERNLIB_P5BOOT)
-#ifndef CERNLIB_P5_CC
-#define CERNLIB_P5_CC
-#endif
-#ifndef CERNLIB_P5_CI
-#define CERNLIB_P5_CI
-#endif
-#ifndef CERNLIB_CRYGS_DATIME
-#define CERNLIB_CRYGS_DATIME
-#endif
-#ifndef CERNLIB_CRYGS_IANDETC
-#define CERNLIB_CRYGS_IANDETC
-#endif
-#ifndef CERNLIB_CRYGS_ISHFT
-#define CERNLIB_CRYGS_ISHFT
-#endif
-#ifndef CERNLIB_CRYGS_JBIT
-#define CERNLIB_CRYGS_JBIT
-#endif
-#ifndef CERNLIB_CRYGS_JBYT
-#define CERNLIB_CRYGS_JBYT
-#endif
-#ifndef CERNLIB_CRYGS_LOCF
-#define CERNLIB_CRYGS_LOCF
-#endif
-#ifndef CERNLIB_CRYGS_SBIT0
-#define CERNLIB_CRYGS_SBIT0
-#endif
-#ifndef CERNLIB_CRYGS_SBIT1
-#define CERNLIB_CRYGS_SBIT1
-#endif
-#ifndef CERNLIB_CRYGS_SBYT
-#define CERNLIB_CRYGS_SBYT
-#endif
-#ifndef CERNLIB_CRYGS_TRACEQ
-#define CERNLIB_CRYGS_TRACEQ
-#endif
-#ifndef CERNLIB_CRYGS_UCTOH
-#define CERNLIB_CRYGS_UCTOH
-#endif
-#ifndef CERNLIB_CRYUNI_GETENVF
-#define CERNLIB_CRYUNI_GETENVF
-#endif
-#ifndef CERNLIB_CRYUNI_INTRAC
-#define CERNLIB_CRYUNI_INTRAC
-#endif
-#ifndef CERNLIB_CRYUNI_SIGNALF
-#define CERNLIB_CRYUNI_SIGNALF
-#endif
-#ifndef CERNLIB_CRYUNI_STATF
-#define CERNLIB_CRYUNI_STATF
-#endif
-#ifndef CERNLIB_CRYUNI_SYSTEMF
-#define CERNLIB_CRYUNI_SYSTEMF
-#endif
-#ifndef CERNLIB_CRYUNI_TMPRO
-#define CERNLIB_CRYUNI_TMPRO
-#endif
-#ifndef CERNLIB_CRYUNI_TMREAD
-#define CERNLIB_CRYUNI_TMREAD
-#endif
-#ifndef CERNLIB_CRYUNI_UNLINKF
-#define CERNLIB_CRYUNI_UNLINKF
-#endif
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncry/_kcru/pilot.h b/src/packlib/kernlib/kerngen/obsolete/kerncry/_kcru/pilot.h
deleted file mode 100644
index f6f217d..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncry/_kcru/pilot.h
+++ /dev/null
@@ -1,12 +0,0 @@
-#if 0
-* This pilot patch was created from kerncry.car patch _kcru
-#endif
-#if 0
-* Pilot for system UNICOS
-#endif
-#ifndef CERNLIB_QMCRU
-#define CERNLIB_QMCRU
-#endif
-#ifndef CERNLIB_QMCRY
-#define CERNLIB_QMCRY
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncry/crycos/Imakefile b/src/packlib/kernlib/kerngen/obsolete/kerncry/crycos/Imakefile
deleted file mode 100644
index 0259144..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncry/crycos/Imakefile
+++ /dev/null
@@ -1,7 +0,0 @@
-SRCS_F= \ @@\
- abend.F detach.F incmem.F jobnam.F timel.F xinb.F xinbf.F xinbs.F
-
-SRCS_S= \ @@\
- noarg.s
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncry/crycos/abend.F b/src/packlib/kernlib/kerngen/obsolete/kerncry/crycos/abend.F
deleted file mode 100644
index 6c83991..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncry/crycos/abend.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: abend.F,v 1.1.1.1 1996/02/15 17:52:41 mclareni Exp $
-*
-* $Log: abend.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:41 mclareni
-* Kernlib
-*
-*
-#include "kerncry/pilot.h"
- SUBROUTINE ABEND
-C
-C CERN PROGLIB# Z035 ABEND .VERSION KERNCRY 1.01 830712
-C ORIG. 12/06/83 JZ
-C
-
- CALL SETRPV (0,0,0)
- CALL ABORT ('***** ABEND.')
- END
-#ifdef CERNLIB_TCGEN_ABEND
-#undef CERNLIB_TCGEN_ABEND
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncry/crycos/detach.F b/src/packlib/kernlib/kerngen/obsolete/kerncry/crycos/detach.F
deleted file mode 100644
index 258982a..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncry/crycos/detach.F
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: detach.F,v 1.1.1.1 1996/02/15 17:52:41 mclareni Exp $
-*
-* $Log: detach.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:41 mclareni
-* Kernlib
-*
-*
-#include "kerncry/pilot.h"
- SUBROUTINE DETACH (LUNP)
-C
-C CERN PROGLIB# K511 DETACH .VERSION KERNCRY 1.00 830612
-C ORIG. 12/06/83 D.LELLOUCH, LPNHE
-C
-
- LUN = LUNP
- CALL FNNUM (LUN)
- CALL RELEASE (IRTC,'DN'L,LUN)
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncry/crycos/incmem.F b/src/packlib/kernlib/kerngen/obsolete/kerncry/crycos/incmem.F
deleted file mode 100644
index c15b004..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncry/crycos/incmem.F
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: incmem.F,v 1.1.1.1 1996/02/15 17:52:41 mclareni Exp $
-*
-* $Log: incmem.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:41 mclareni
-* Kernlib
-*
-*
-#include "kerncry/pilot.h"
- FUNCTION INCMEM (NINC)
-C
-C CERN PROGLIB# Z027 INCMEM .VERSION KERNCRY 1.03 840215
-C ORIG. 18/01/84 W.W. SACLAY/DPHPE
-C NEW ROUTINE FOR CRAY SYSTEM COS 1.13 / CFT 1.11
-C
- N = NINC
- CALL MEMORY ('CURFL',MEMB)
- IF (N.NE.0) CALL MEMORY ('UC',N)
- CALL MEMORY ('CURFL',MEMA)
- NINC = MEMA-MEMB
- INCMEM = MEMA
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncry/crycos/jobnam.F b/src/packlib/kernlib/kerngen/obsolete/kerncry/crycos/jobnam.F
deleted file mode 100644
index 2f93410..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncry/crycos/jobnam.F
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: jobnam.F,v 1.1.1.1 1996/02/15 17:52:41 mclareni Exp $
-*
-* $Log: jobnam.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:41 mclareni
-* Kernlib
-*
-*
-#include "kerncry/pilot.h"
- SUBROUTINE JOBNAM (ID)
-C
-C CERN PROGLIB# Z100 JOBNAM .VERSION KERNCRY 1.00 830612
-C ORIG. 12/06/83 JZ
-C
- ID = JNAME (X)
- RETURN
- END
-#ifdef CERNLIB_TCGEN_JOBNAM
-#undef CERNLIB_TCGEN_JOBNAM
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncry/crycos/noarg.s b/src/packlib/kernlib/kerngen/obsolete/kerncry/crycos/noarg.s
deleted file mode 100644
index 91ce844..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncry/crycos/noarg.s
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: noarg.s,v 1.1.1.1 1996/02/15 17:52:41 mclareni Exp $
-*
-* $Log: noarg.s,v $
-* Revision 1.1.1.1 1996/02/15 17:52:41 mclareni
-* Kernlib
-*
-*
- IDENT NOARG
-*
-* CERN PROGLIB# Z029 NOARG .VERSION KERNCRY 1.09 881102
-* ORIG. 13/10/88 J-Ph Baud, CERN
-*
-NOARG ENTER NP=1,MODE=USER,TYPE=ADDRESS
- NUMARG A0,ARGPTR=A6
- ARGADD A5,1,ARGPTR=A6
- A2 B02
- A3 2,A2
- GETF,S2 S7,ARN,A3
- S1 S2
- $IF AN
- 0,A5 S1
- $ENDIF
- EXIT MODE=USER
- END
-#ifdef CERNLIB_TCGEN_NOARG
-#undef CERNLIB_TCGEN_NOARG
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncry/crycos/timel.F b/src/packlib/kernlib/kerngen/obsolete/kerncry/crycos/timel.F
deleted file mode 100644
index 689acb2..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncry/crycos/timel.F
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: timel.F,v 1.1.1.1 1996/02/15 17:52:41 mclareni Exp $
-*
-* $Log: timel.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:41 mclareni
-* Kernlib
-*
-*
-#include "kerncry/pilot.h"
- SUBROUTINE TIMEL (T)
-C
-C CERN PROGLIB# Z007 TIMEL .VERSION KERNCRY 1.03 840215
-C ORIG. 18/01/84 W.W. SACLAY/DPHPE
-C
- CALL TREMAIN (T)
- RETURN
- END
-#ifdef CERNLIB_TCGEN_TIMEL
-#undef CERNLIB_TCGEN_TIMEL
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncry/crycos/xinb.F b/src/packlib/kernlib/kerngen/obsolete/kerncry/crycos/xinb.F
deleted file mode 100644
index 668ac96..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncry/crycos/xinb.F
+++ /dev/null
@@ -1,39 +0,0 @@
-*
-* $Id: xinb.F,v 1.1.1.1 1996/02/15 17:52:42 mclareni Exp $
-*
-* $Log: xinb.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:42 mclareni
-* Kernlib
-*
-*
-#include "kerncry/pilot.h"
- SUBROUTINE XINB (LUN,XBV,NXB)
-C
-C CERN PROGLIB# Z203 XINB .VERSION KERNCRY 1.00 830612
-C ORIG. 12/06/83 DL + JZ
-C
- DIMENSION XBV(999)
-C
-
- BUFFERIN (LUN,-1) (N,N)
- IF (UNIT(LUN)) 22,61,64
-
- 22 N = MIN0 (N,NXB)
- BUFFERIN (LUN,0) (XBV,XBV(N))
-
- IF (UNIT(LUN)) 24,61,64
- 24 NXB = LENGTH (LUN)
- RETURN
-C
- 61 NXB = 0
- RETURN
-C
- 64 NXB = -7
- RETURN
- END
-#ifdef CERNLIB_TCGEN_XINB
-#undef CERNLIB_TCGEN_XINB
-#endif
-#ifdef CERNLIB_XVECT_XINB
-#undef CERNLIB_XVECT_XINB
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncry/crycos/xinbf.F b/src/packlib/kernlib/kerngen/obsolete/kerncry/crycos/xinbf.F
deleted file mode 100644
index e20ae2b..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncry/crycos/xinbf.F
+++ /dev/null
@@ -1,35 +0,0 @@
-*
-* $Id: xinbf.F,v 1.1.1.1 1996/02/15 17:52:42 mclareni Exp $
-*
-* $Log: xinbf.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:42 mclareni
-* Kernlib
-*
-*
-#include "kerncry/pilot.h"
- SUBROUTINE XINBF (LUN,XBV,NXB)
-C
-C CERN PROGLIB# Z203 XINBF .VERSION KERNCRY 1.00 830612
-C ORIG. 12/06/83 DL + JZ
-C
- DIMENSION XBV(999)
-C
-
- BUFFERIN (LUN,0) (XBV,XBV(NXB))
-
- IF (UNIT(LUN)) 24,61,64
- 24 NXB = LENGTH (LUN)
- RETURN
-C
- 61 NXB = 0
- RETURN
-C
- 64 NXB = -7
- RETURN
- END
-#ifdef CERNLIB_TCGEN_XINBF
-#undef CERNLIB_TCGEN_XINBF
-#endif
-#ifdef CERNLIB_XVECT_XINBF
-#undef CERNLIB_XVECT_XINBF
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncry/crycos/xinbs.F b/src/packlib/kernlib/kerngen/obsolete/kerncry/crycos/xinbs.F
deleted file mode 100644
index 724f3bf..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncry/crycos/xinbs.F
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: xinbs.F,v 1.1.1.1 1996/02/15 17:52:42 mclareni Exp $
-*
-* $Log: xinbs.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:42 mclareni
-* Kernlib
-*
-*
-#include "kerncry/pilot.h"
- SUBROUTINE XINBS (LUN,XAV,NA,XBV,NXB)
-C
-C CERN PROGLIB# Z203 XINBS .VERSION KERNCRY 1.00 830612
-C ORIG. 12/06/83 DL + JZ
-C
- DIMENSION XBV(999), XAV(9)
-C
-
- BUFFERIN (LUN,-1) (N,N)
- IF (UNIT(LUN)) 22,61,64
- 22 BUFFERIN (LUN,-1) (XAV,XAV(NA))
- IF (UNIT(LUN)) 23,61,64
-
- 23 N = MIN0 (N,NXB)
- BUFFERIN (LUN,0) (XBV,XBV(N))
-
- IF (UNIT(LUN)) 24,61,64
- 24 NXB = LENGTH (LUN)
- RETURN
-C
- 61 NXB = 0
- RETURN
-C
- 64 NXB = -7
- RETURN
- END
-#ifdef CERNLIB_TCGEN_XINBS
-#undef CERNLIB_TCGEN_XINBS
-#endif
-#ifdef CERNLIB_XVECT_XINBS
-#undef CERNLIB_XVECT_XINBS
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/Imakefile b/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/Imakefile
deleted file mode 100644
index eaf904d..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/Imakefile
+++ /dev/null
@@ -1,13 +0,0 @@
-SRCS_F= \ @@\
- btest.F datime.F datimh.F fnblan.F fnnum.F fnzero.F iandetc.F \ @@\
- ibclr.F ibits.F ibset.F ie3fod.F ie3fos.F ie3tod.F ie3tos.F \ @@\
- ishft.F ishftc.F iuforw.F iuweed.F jbit.F jbyt.F jbytet.F jbytor.F \ @@\
- kerngt.F legvar.F locf.F mbytet.F mbytor.F mcbyt.F msbit.F msbit0.F \ @@\
- msbit1.F msbyt.F mvbits.F rndm.F sbit.F sbit0.F sbit1.F sbyt.F \ @@\
- timed.F timex.F traceq.F ublow.F ubunch.F uctoh.F uctoh1.F uh1toc.F \ @@\
- uhtoc.F vmatl.F vmatr.F
-
-SRCS_S= \ @@\
- qnexte.s
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/btest.F b/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/btest.F
deleted file mode 100644
index 6142fc3..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/btest.F
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: btest.F,v 1.1.1.1 1996/02/15 17:52:35 mclareni Exp $
-*
-* $Log: btest.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:35 mclareni
-* Kernlib
-*
-*
-#include "kerncry/pilot.h"
- LOGICAL FUNCTION BTEST(I,N)
-C
-C CERN PROGLIB# M441 BTEST .VERSION KERNCRY 1.06 870527
-C ORIG. 17/11/86 CNAF,DBOLOGNA, corrected 19/5/87
-C
-C CRAY VERSION OF ANSI/ISA FUNCTION BTEST
-C N IS THE BIT TO BE TESTED
-C
- BTEST = AND(I, SHIFTL(1,N)) .NE. 0
- END
-#ifdef CERNLIB_TCGEN_BTEST
-#undef CERNLIB_TCGEN_BTEST
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/datime.F b/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/datime.F
deleted file mode 100644
index 73fc441..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/datime.F
+++ /dev/null
@@ -1,54 +0,0 @@
-*
-* $Id: datime.F,v 1.1.1.1 1996/02/15 17:52:35 mclareni Exp $
-*
-* $Log: datime.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:35 mclareni
-* Kernlib
-*
-*
-#include "kerncry/pilot.h"
- SUBROUTINE DATIME (ND,NT)
-C
-C CERN PROGLIB# Z007 DATIME .VERSION KERNCRY 1.12 890913
-C ORIG. 12/06/83 JZ
-C MOD. 27/07/89 add /SLATE/, JZ
-C
- COMMON /SLATE/ ISL(10), MM(6), RM(4), M(20)
-C
-C
- RM(1) = DATE ()
- RM(2) = CLOCK ()
- CALL UBLOW (RM,M,16)
-C
-C- -US D D / M M / Y Y H H . M M . S S
-C- 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6
-C- US M M / D D / Y Y H H . M M . S S
-C
-#if !defined(CERNLIB_USADATE)
- MM(1) = IUFORW (M,7,8)
- MM(2) = IUFORW (M,4,5)
- MM(3) = IUFORW (M,1,2)
-#endif
-#if defined(CERNLIB_USADATE)
- MM(1) = IUFORW (M,7,8)
- MM(2) = IUFORW (M,1,2)
- MM(3) = IUFORW (M,4,5)
-#endif
- MM(4) = IUFORW (M,9,10)
- MM(5) = IUFORW (M,12,13)
- MM(6) = IUFORW (M,15,16)
-
- ND = (MM(1)*100+MM(2))*100 + MM(3)
- NT = MM(4) *100 + MM(5)
-
- MM(1) = MM(1) + 1900
- DO 24 J=1,6
- 24 ISL(J) = MM(J)
- RETURN
- END
-#ifdef CERNLIB_CCGEN_DATIME
-#undef CERNLIB_CCGEN_DATIME
-#endif
-#ifdef CERNLIB_TCGEN_DATIME
-#undef CERNLIB_TCGEN_DATIME
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/datimh.F b/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/datimh.F
deleted file mode 100644
index e96b2c8..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/datimh.F
+++ /dev/null
@@ -1,47 +0,0 @@
-*
-* $Id: datimh.F,v 1.1.1.1 1996/02/15 17:52:35 mclareni Exp $
-*
-* $Log: datimh.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:35 mclareni
-* Kernlib
-*
-*
-#include "kerncry/pilot.h"
- SUBROUTINE DATIMH (AID,AIT)
-C
-C CERN PROGLIB# Z007 DATIMH .VERSION KERNCRY 1.00 830612
-C ORIG. 12/06/83 JZ
-C
-C
-C- CALL DATIMH (ND,NT) RETURNS HOLLERITH DATE ND = DD/MM/YY
-C- HOLLERITH TIME NT = HH:MM:SS
-C
- COMMON /SLATE/ SAFE(10), RM(4), L(3), M(23)
-C
-C
- RM(1) = DATE ()
- RM(2) = CLOCK ()
-C
-C- -US D D / M M / Y Y H H . M M . S S
-C- 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6
-C- US M M / D D / Y Y H H . M M . S S
-C
-#if defined(CERNLIB_USADATE)
- CALL UBLOW (RM,M,8)
- L(1) = M(4)
- L(2) = M(5)
- L(3) = M(6)
- M(4) = M(7)
- M(5) = M(8)
- CALL UBUNCH (L,RM,8)
-#endif
- AID = RM(1)
- AIT = RM(2)
- RETURN
- END
-#ifdef CERNLIB_CCGEN_DATIMH
-#undef CERNLIB_CCGEN_DATIMH
-#endif
-#ifdef CERNLIB_TCGEN_DATIMH
-#undef CERNLIB_TCGEN_DATIMH
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/fnblan.F b/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/fnblan.F
deleted file mode 100644
index 81bb80a..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/fnblan.F
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: fnblan.F,v 1.1.1.1 1996/02/15 17:52:35 mclareni Exp $
-*
-* $Log: fnblan.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:35 mclareni
-* Kernlib
-*
-*
-#include "kerncry/pilot.h"
- INTEGER FUNCTION FNBLAN (NAMEP)
-C
-C CERN PROGLIB# Z204 FNBLAN .VERSION KERNCRY 1.00 830612
-C ORIG. 12/06/83 JZ
-C
-
- NAME = NAMEP
-
- DO 17 JR=1,7
- IF ((NAME.AND.255).NE.0) GO TO 21
- NAME = NAME .OR. 32
- NAME = SHIFT (NAME,56)
- 17 CONTINUE
- JR = 8
-
- 21 NAME = SHIFT (NAME,8*(JR-1))
- NAMEP = NAME
- FNBLAN= NAME
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/fnnum.F b/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/fnnum.F
deleted file mode 100644
index 5d8af2c..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/fnnum.F
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: fnnum.F,v 1.1.1.1 1996/02/15 17:52:35 mclareni Exp $
-*
-* $Log: fnnum.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:35 mclareni
-* Kernlib
-*
-*
-#include "kerncry/pilot.h"
- INTEGER FUNCTION FNNUM (NAMEP)
-C
-C CERN PROGLIB# Z204 FNNUM .VERSION KERNCRY 1.00 830612
-C ORIG. 12/06/83 JZ
-C
-
- NAME = NAMEP
- IF (SHIFTR(NAME,8).NE.0) GO TO 29
- IF (NAME.LT.100) GO TO 12
- IF (NAME.GE.103) GO TO 29
- IF (NAME.EQ.100) NAME=3L$IN
- IF (NAME.EQ.101) NAME=4L$OUT
- IF (NAME.EQ.102) NAME=6L$PUNCH
- GO TO 28
-
- 12 IONE = MOD (NAME,10)
- ITEN = NAME/10
-
- NAME = 2LFT .OR. SHIFTL (SHIFTL(ITEN+48,8).OR.(IONE+48),32)
-
- 28 NAMEP = NAME
- 29 FNNUM = NAME
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/fnzero.F b/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/fnzero.F
deleted file mode 100644
index 4f6e9f5..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/fnzero.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: fnzero.F,v 1.1.1.1 1996/02/15 17:52:35 mclareni Exp $
-*
-* $Log: fnzero.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:35 mclareni
-* Kernlib
-*
-*
-#include "kerncry/pilot.h"
- INTEGER FUNCTION FNZERO (NAMEP)
-C
-C CERN PROGLIB# Z204 FNZERO .VERSION KERNCRY 1.00 830612
-C ORIG. 12/06/83 JZ
-C
-
- NAME = NAMEP
-
- DO 17 JR=1,7
- IF ((NAME.AND.255).NE.32) GO TO 21
- NAME = SHIFTR (NAME,8)
- 17 CONTINUE
- JR = 8
-
- 21 NAME = SHIFT (NAME,8*(JR-1))
- NAMEP = NAME
- FNZERO= NAME
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/iandetc.F b/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/iandetc.F
deleted file mode 100644
index 635ddb2..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/iandetc.F
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: iandetc.F,v 1.1.1.1 1996/02/15 17:52:35 mclareni Exp $
-*
-* $Log: iandetc.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:35 mclareni
-* Kernlib
-*
-*
-#include "kerncry/pilot.h"
- FUNCTION IAND (I,J)
-C
-C CERN PROGLIB# M441 IANDETC .VERSION KERNCRY 1.06 870527
-C
-C CRAY versions of functions IAND, IOR, IEOR, NOT
-
- IAND = AND(I,J)
- RETURN
- END
- FUNCTION IOR (I,J)
-
- IOR = OR(I,J)
- RETURN
- END
- FUNCTION IEOR (I,J)
-
- IEOR = XOR(I,J)
- RETURN
- END
- FUNCTION NOT (I)
-
- NOT = COMPL(I)
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/ibclr.F b/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/ibclr.F
deleted file mode 100644
index 36e9137..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/ibclr.F
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: ibclr.F,v 1.1.1.1 1996/02/15 17:52:35 mclareni Exp $
-*
-* $Log: ibclr.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:35 mclareni
-* Kernlib
-*
-*
-#include "kerncry/pilot.h"
- FUNCTION IBCLR(I,N)
-C
-C CERN PROGLIB# M441 IBCLR .VERSION KERNCRY 1.06 870527
-C ORIG. 17/11/86 CNAF, BOLOGNA
-C
-C CRAY VERSION OF ANSI/ISA FUNCTION IBCLR
-C N IS THE POSTION OF THE BIT TO BE CLEARED
-C
- IBCLR = AND(I, COMPL(SHIFTL(1,N)))
- END
-#ifdef CERNLIB_TCGEN_IBCLR
-#undef CERNLIB_TCGEN_IBCLR
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/ibits.F b/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/ibits.F
deleted file mode 100644
index c9abc4c..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/ibits.F
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: ibits.F,v 1.1.1.1 1996/02/15 17:52:35 mclareni Exp $
-*
-* $Log: ibits.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:35 mclareni
-* Kernlib
-*
-*
-#include "kerncry/pilot.h"
- FUNCTION IBITS(I,N,L)
-C
-C CERN PROGLIB# M441 IBITS .VERSION KERNCRY 1.06 870527
-C ORIG. 17/11/86 CNAF, BOLOGNA
-C
-C CRAY VERSION OF MIL-STD-1753 FUNCTION IBITS
-C N IS THE RIGHTMOST BIT OF THE REQUIRED FIELD
-C L IS THE LENGTH OF THE REQUIRED FIELD
-C
-C
- IBITS = AND(SHIFTR(I,N),MASK(128-L))
- END
-#ifdef CERNLIB_TCGEN_IBITS
-#undef CERNLIB_TCGEN_IBITS
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/ibset.F b/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/ibset.F
deleted file mode 100644
index 7ac4351..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/ibset.F
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: ibset.F,v 1.1.1.1 1996/02/15 17:52:36 mclareni Exp $
-*
-* $Log: ibset.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:36 mclareni
-* Kernlib
-*
-*
-#include "kerncry/pilot.h"
- FUNCTION IBSET(I,N)
-C
-C CERN PROGLIB# M441 IBSET .VERSION KERNCRY 1.06 870527
-C ORIG. 17/11/86 CNAF, BOLOGNA
-C
-C CRAY VERSION OF ANSI/ISA FUNCTION IBSET
-C N IS THE POSITION OF THE BIT TO BE SET
-C
- IBSET = OR(I, SHIFTL(1,N))
- END
-#ifdef CERNLIB_TCGEN_IBSET
-#undef CERNLIB_TCGEN_IBSET
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/ie3fod.F b/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/ie3fod.F
deleted file mode 100644
index 72e5ed3..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/ie3fod.F
+++ /dev/null
@@ -1,70 +0,0 @@
-*
-* $Id: ie3fod.F,v 1.1.1.1 1996/02/15 17:52:36 mclareni Exp $
-*
-* $Log: ie3fod.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:36 mclareni
-* Kernlib
-*
-*
-#include "kerncry/pilot.h"
- SUBROUTINE IE3FOD (MS,MT,NDPN,JBAD)
-C
-C CERN PROGLIB# M220 IE3FOD .VERSION KERNCRY 1.10 890322
-
-C- Convert double precision for output with copy
-C- from source in native to target in IEEE data format
-
- DIMENSION MS(99), MT(99)
-
- DOUBLE PRECISION THDB
- DIMENSION THIS(2)
- EQUIVALENCE (THDB,THIS)
- EQUIVALENCE (ITHA,THA,THIS(1)), (ITHB,THB,THIS(2))
-
- PARAMETER (IOVPCS = 17740000000 B)
- PARAMETER (IOVPCD = 17774000000 B)
- PARAMETER (IOVNCS = 37740000000 B)
- PARAMETER (IOVNCD = 37774000000 B)
-
-
- JFAI = 0
- JMS = 0
- JMT = 0
-
-C- Cray single-pr. to IEEE double, ignoring 2nd word
-C- for the moment (loss of 5 bits)
- DO 449 JL=1,NDPN
- ITHA = MS(JMS+1)
- IF (ITHA.EQ.0) GO TO 442
- JSIGN = SHIFTR (MASK(1).AND.ITHA, 32)
- JEXP = SHIFTR (SHIFTL(ITHA,1), 49)
- JEXP = JEXP - 40000B + 1022
- IF (JEXP.LE.0) GO TO 441
- IF (JEXP.GE.2047) GO TO 433
- JMANT = MASK(128-20) .AND. SHIFTR (ITHA,27)
- ITHB = SHIFTL (ITHA, 5) .AND. MASK(128-32)
- ITHA = JSIGN .OR. SHIFTL(JEXP,20) .OR. JMANT
- GO TO 447
-
-C-- overflow
- 433 JFAI = JL
- IF (JSIGN.EQ.0) THEN
- ITHA = IOVPCD
- ELSE
- ITHA = IOVNCD
- ENDIF
- GO TO 442
-
- 441 ITHA = 0
- 442 ITHB = 0
- 447 MT(JMT+1) = ITHA
- MT(JMT+2) = ITHB
- JMT = JMT + 2
- 449 JMS = JMS + 2
-
- JBAD = JFAI
- RETURN
- END
-#ifdef CERNLIB_TCGEN_IE3FOD
-#undef CERNLIB_TCGEN_IE3FOD
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/ie3fos.F b/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/ie3fos.F
deleted file mode 100644
index 39f383c..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/ie3fos.F
+++ /dev/null
@@ -1,76 +0,0 @@
-*
-* $Id: ie3fos.F,v 1.1.1.1 1996/02/15 17:52:36 mclareni Exp $
-*
-* $Log: ie3fos.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:36 mclareni
-* Kernlib
-*
-*
-#include "kerncry/pilot.h"
- SUBROUTINE IE3FOS (MS,MT,NWDO,JBAD)
-C
-C CERN PROGLIB# M220 IE3FOS .VERSION KERNCRY 1.05 861204
-
-C- Convert single precision for output with copy
-C- from source in native to target in IEEE data format
-
- DIMENSION MS(99), MT(99)
-
- DOUBLE PRECISION THDB
- DIMENSION THIS(2)
- EQUIVALENCE (THDB,THIS)
- EQUIVALENCE (ITHA,THA,THIS(1)), (ITHB,THB,THIS(2))
-
- PARAMETER (IOVPCS = 17740000000 B)
- PARAMETER (IOVPCD = 17774000000 B)
- PARAMETER (IOVNCS = 37740000000 B)
- PARAMETER (IOVNCD = 37774000000 B)
-
-
- JBAD = 0
- JMS = 0
- JMT = 0
-
- 301 DO 349 JL=1,NWDO
- ITHA = MS(JMS+1)
- IF (ITHA.EQ.0) GO TO 347
- JSIGN = SHIFTR (MASK(1).AND.ITHA, 32)
- JEXP = SHIFTR (SHIFTL(ITHA,1), 49)
- JEXP = JEXP - 40000B + 126
- JMANT = MASK(128-24) .AND. SHIFTR(ITHA,23)
- IF (JMANT.EQ.MASK(128-24)) THEN
- JMANT = 0
- JEXP = JEXP + 1
- ELSE
- JMANT = SHIFTR(JMANT+1,1)
- ENDIF
- IF (JEXP.LE.0) GO TO 331
- IF (JEXP.GE.255) GO TO 333
- ITHA = JSIGN .OR. SHIFTL(JEXP,23) .OR. JMANT
- GO TO 347
-
-C-- make de-normalized number
- 331 IF (JEXP.LT.-23) GO TO 341
- JMANT = SHIFTR (JMANT+40000000B,1-JEXP)
- ITHA = JSIGN .OR. JMANT
- GO TO 347
-
-C-- overflow
- 333 JBAD = JL
- IF (JSIGN.EQ.0) THEN
- ITHA = IOVPCS
- ELSE
- ITHA = IOVNCS
- ENDIF
- GO TO 347
-
- 341 ITHA = 0
- 347 MT(JMT+1) = ITHA
- JMT = JMT + 1
- 349 JMS = JMS + 1
-
- RETURN
- END
-#ifdef CERNLIB_TCGEN_IE3FOS
-#undef CERNLIB_TCGEN_IE3FOS
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/ie3tod.F b/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/ie3tod.F
deleted file mode 100644
index d9cfa5e..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/ie3tod.F
+++ /dev/null
@@ -1,97 +0,0 @@
-*
-* $Id: ie3tod.F,v 1.1.1.1 1996/02/15 17:52:36 mclareni Exp $
-*
-* $Log: ie3tod.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:36 mclareni
-* Kernlib
-*
-*
-#include "kerncry/pilot.h"
- SUBROUTINE IE3TOD (MS,MT,NDPN,JBAD)
-C
-C CERN PROGLIB# M220 IE3TOD .VERSION KERNCRY 1.05 861204
-
-C- Convert double precision for input with copy
-C- from source in IEEE to target in native data format
-
- DIMENSION MS(99), MT(99)
-
- DOUBLE PRECISION THDB
- DIMENSION THIS(2)
- EQUIVALENCE (THDB,THIS)
- EQUIVALENCE (ITHA,THA,THIS(1)), (ITHB,THB,THIS(2))
-
- PARAMETER (JEXMIN = -1023, JEXMAX=1023)
- PARAMETER (IOVPMS = 0 60000 40000000 00000000 B)
- PARAMETER (IOVNMS = 1 60000 40000000 00000000 B)
- PARAMETER (IBADMS = IOVPMS)
- PARAMETER (IBADMD = IBADMS, IBADME = 0)
- PARAMETER (IOVPMD = IOVPMS, IOVNMD = IOVNMS)
- PARAMETER (IBL32 = 4010020040 B)
-
-#include "kerncry/q_jbit.inc"
-* Ignoring t=pass
-
- JFAI = 0
- JMS = 0
- JMT = 0
-
- DO 449 JL=1,NDPN
- ITHA = MS(JMS+1)
- IF (ITHA.EQ.0) GO TO 442
- ITHB = MS(JMS+2)
- JSIGN = JBIT (ITHA,32)
- JEXP = JBYT (ITHA,21,11)
- JMANT = JBYT (ITHA, 1,20)
- IF (JEXP.EQ.0) GO TO 431
- IF (JEXP.EQ.2047) GO TO 433
-
- JMANT = JMANT + 1 048 576
- JEXP = JEXP - 1023
- IF (JEXP.GT.JEXMAX) GO TO 432
- 424 IF (JEXP.LT.JEXMIN) GO TO 441
-
- JMANS = JBYT (ITHB,17,16)
- JMANR = JBYT (ITHB, 1,16)
-
- JPRE = ISIGN (48,JEXP)
- THDB = ( DBLE(JMANT)
- + + DBLE(FLOAT(JMANS)*2.**(-16))
- + + DBLE(FLOAT(JMANR)*2.**(-32)) ) * 2.**(JPRE-20)
- THDB = THDB * 2.**(JEXP-JPRE)
- IF (JSIGN.EQ.0) GO TO 447
- THDB = -THDB
- GO TO 447
-
- 431 IF (JMANT.EQ.0) GO TO 441
- JEXP = -1022
- GO TO 424
-
- 432 JMANT = 0
- 433 IF (JMANT.EQ.0) THEN
- IF (JSIGN.EQ.0) THEN
- ITHB = IOVPMD
- ELSE
- ITHB = IOVNMD
- ENDIF
- ELSE
- ITHB = IBADMD
- ENDIF
- JFAI = JL
- ITHA = ITHB
- ITHB = IBADME
- GO TO 447
-
- 441 ITHA = 0
- 442 ITHB = 0
- 447 MT(JMT+1) = ITHA
- MT(JMT+2) = ITHB
- JMT = JMT + 2
- 449 JMS = JMS + 2
-
- JBAD = JFAI
- RETURN
- END
-#ifdef CERNLIB_TCGEN_IE3TOD
-#undef CERNLIB_TCGEN_IE3TOD
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/ie3tos.F b/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/ie3tos.F
deleted file mode 100644
index fe30777..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/ie3tos.F
+++ /dev/null
@@ -1,86 +0,0 @@
-*
-* $Id: ie3tos.F,v 1.1.1.1 1996/02/15 17:52:36 mclareni Exp $
-*
-* $Log: ie3tos.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:36 mclareni
-* Kernlib
-*
-*
-#include "kerncry/pilot.h"
- SUBROUTINE IE3TOS (MS,MT,NWDO,JBAD)
-C
-C CERN PROGLIB# M220 IE3TOS .VERSION KERNCRY 1.05 861204
-
-C- Convert single precision for input with copy
-C- from source in IEEE to target in native data format
-
- DIMENSION MS(99), MT(99)
-
- DOUBLE PRECISION THDB
- DIMENSION THIS(2)
- EQUIVALENCE (THDB,THIS)
- EQUIVALENCE (ITHA,THA,THIS(1)), (ITHB,THB,THIS(2))
-
- PARAMETER (JEXMIN = -1023, JEXMAX=1023)
- PARAMETER (IOVPMS = 0 60000 40000000 00000000 B)
- PARAMETER (IOVNMS = 1 60000 40000000 00000000 B)
- PARAMETER (IBADMS = IOVPMS)
- PARAMETER (IBADMD = IBADMS, IBADME = 0)
- PARAMETER (IOVPMD = IOVPMS, IOVNMD = IOVNMS)
- PARAMETER (IBL32 = 4010020040 B)
-
-#include "kerncry/q_jbit.inc"
-* Ignoring t=pass
-
- JBAD = 0
- JMS = 0
- JMT = 0
-
- 301 DO 349 JL=1,NWDO
- ITHA = MS(JMS+1)
- IF (ITHA.EQ.0) GO TO 347
- JSIGN = JBIT (ITHA,32)
- JEXP = JBYT (ITHA,24,8)
- JMANT = JBYT (ITHA,1,23)
- IF (JEXP.EQ.0) GO TO 331
- IF (JEXP.EQ.255) GO TO 333
- JMANT = JMANT + 8 388 608
- JEXP = JEXP - 127
- JPRE = ISIGN (23,JEXP)
- THA = FLOAT(JMANT) * 2.**(JPRE-23)
- THA = THA * 2.**(JEXP-JPRE)
- IF (JSIGN.EQ.0) GO TO 347
- THA = -THA
- GO TO 347
-
- 331 IF (JMANT.EQ.0) GO TO 341
- THA = FLOAT(JMANT) * 2.**(-63)
- THA = THA * 2.**(-86)
- IF (ITHA .EQ.0) GO TO 347
- IF (JSIGN.EQ.0) GO TO 347
- THA = -THA
- GO TO 347
-
- 333 IF (JMANT.EQ.0) THEN
- IF (JSIGN.EQ.0) THEN
- ITHB = IOVPMS
- ELSE
- ITHB = IOVNMS
- ENDIF
- ELSE
- ITHB = IBADMS
- ENDIF
- JBAD = JL
- ITHA = ITHB
- GO TO 347
-
- 341 ITHA = 0
- 347 MT(JMT+1) = ITHA
- JMT = JMT + 1
- 349 JMS = JMS + 1
-
- RETURN
- END
-#ifdef CERNLIB_TCGEN_IE3TOS
-#undef CERNLIB_TCGEN_IE3TOS
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/ishft.F b/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/ishft.F
deleted file mode 100644
index 359581c..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/ishft.F
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: ishft.F,v 1.1.1.1 1996/02/15 17:52:36 mclareni Exp $
-*
-* $Log: ishft.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:36 mclareni
-* Kernlib
-*
-*
-#include "kerncry/pilot.h"
- FUNCTION ISHFT(I,K)
-C
-C CERN PROGLIB# M441 ISHFT .VERSION KERNCRY 1.06 870527
-C ORIG. 17/11/86 CNAF, BOLOGNA
-C
-C CRAY VERSION OF ANSI/ISA FUNCTION ISHFT
-C K IS THE SHIFT COUNT - NEGATIVE TO THE RIGHT
-C POSITIVE TO THE LEFT
-C
- IF (K.GT.0) THEN
- ISHFT = SHIFTL(I,K)
- ELSEIF (K.LT.0) THEN
- ISHFT = SHIFTR(I,-K)
- ELSE
- ISHFT = I
- ENDIF
- END
-#ifdef CERNLIB_TCGEN_ISHFT
-#undef CERNLIB_TCGEN_ISHFT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/ishftc.F b/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/ishftc.F
deleted file mode 100644
index 9c3f4b3..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/ishftc.F
+++ /dev/null
@@ -1,39 +0,0 @@
-*
-* $Id: ishftc.F,v 1.1.1.1 1996/02/15 17:52:36 mclareni Exp $
-*
-* $Log: ishftc.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:36 mclareni
-* Kernlib
-*
-*
-#include "kerncry/pilot.h"
- FUNCTION ISHFTC(I,K,L)
-C
-C CERN PROGLIB# M441 ISHFTC .VERSION KERNCRY 1.06 870527
-C ORIG. 17/11/86 CNAF, BOLOGNA
-C
-C CRAY VERSION OF MIL-STD-1753 ISHFTC FUNCTION
-C K IS THE SHIFT COUNT - NEGATIVE TO THE RIGHT
-C POSITIVE TO THE LEFT
-C L IS THE NUMBER OF THE RIGHTMOST BITS TO BE SHIFTED, ALL
-C OTHER BITS ARE LEFT UNCHANGED
-C
- IF (K.GT.0) THEN
- IF (L.EQ.64) THEN
- ISHFTC = SHIFT(I,K)
- ELSE
- ISHFTC=OR(SHIFTR(AND(MASK(128-L),I),L-K),
- + AND(MASK(128-L),SHIFTL(AND(MASK(128-L),I),K)))
- ISHFTC=OR(ISHFTC,AND(MASK(64-L),I))
- ENDIF
- ELSEIF (K.LT.0) THEN
- ISHFTC=OR(AND(MASK(128-L),SHIFTL(AND(MASK(128-L),I),L+K)),
- + SHIFTR(AND(MASK(128-L),I),-K))
- ISHFTC=OR(ISHFTC,AND(MASK(64-L),I))
- ELSE
- ISHFTC = I
- ENDIF
- END
-#ifdef CERNLIB_TCGEN_ISHFTC
-#undef CERNLIB_TCGEN_ISHFTC
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/iuforw.F b/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/iuforw.F
deleted file mode 100644
index 38d0f55..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/iuforw.F
+++ /dev/null
@@ -1,38 +0,0 @@
-*
-* $Id: iuforw.F,v 1.1.1.1 1996/02/15 17:52:36 mclareni Exp $
-*
-* $Log: iuforw.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:36 mclareni
-* Kernlib
-*
-*
-#include "kerncry/pilot.h"
- FUNCTION IUFORW (IC,JL,JR)
-C
-C CERN PROGLIB# M410 IUFORW .VERSION KERNCRY 1.00 830612
-C ORIG. 12/06/83 JZ
-C
- DIMENSION IC(99)
- COMMON /SLATE/ ND,JEND, DUMMY(38)
-
- ND = 0
- JEND = JL
- IVAL = 0
-
- 12 IF (JEND.GT.JR) GO TO 20
- K = SHIFTR (IC(JEND),56)
- IF (K.EQ.32) GO TO 19
- IF (K.GE.58) GO TO 20
- K = K - 48
- IF (K.LT.0) GO TO 20
- 14 IVAL = 10*IVAL + K
- ND = ND + 1
- 19 JEND = JEND + 1
- GO TO 12
-
- 20 IUFORW = IVAL
- RETURN
- END
-#ifdef CERNLIB_TCGEN_IUFORW
-#undef CERNLIB_TCGEN_IUFORW
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/iuweed.F b/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/iuweed.F
deleted file mode 100644
index 3a53321..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/iuweed.F
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: iuweed.F,v 1.1.1.1 1996/02/15 17:52:36 mclareni Exp $
-*
-* $Log: iuweed.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:36 mclareni
-* Kernlib
-*
-*
-#include "kerncry/pilot.h"
- FUNCTION IUWEED (IA,N)
-C
-C CERN PROGLIB# N103 IUWEED .VERSION KERNCRY 1.16 911111
-C ORIG. 24/10/91 JZ
-C- Find position of first number which is infinity or not-a-number
-C- in the N word vector IA, return zero if none
-
- DIMENSION IA(*)
-
- DO 24 J=1,N
- M = SHIFTR (IA(J),48)
- IF (M.EQ.0) GO TO 24
- IF (M.EQ.177777B) GO TO 24
-
- M = M .AND. 77777B
- IF (M.GE.60000B) GO TO 29
- 24 CONTINUE
- J = 0
-
- 29 IUWEED = J
- RETURN
- END
-#ifdef CERNLIB_TCGEN_IUWEED
-#undef CERNLIB_TCGEN_IUWEED
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/jbit.F b/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/jbit.F
deleted file mode 100644
index 38f45b3..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/jbit.F
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: jbit.F,v 1.1.1.1 1996/02/15 17:52:36 mclareni Exp $
-*
-* $Log: jbit.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:36 mclareni
-* Kernlib
-*
-*
-#include "kerncry/pilot.h"
- FUNCTION JBIT (IZW,IZP)
-C
-C CERN PROGLIB# M421 JBIT .VERSION KERNCRY 1.16 911111
-C ORIG. 24/10/91 JZ
-C
- JBIT = SHIFTR(IZW,IZP-1) .AND. 1
- RETURN
- END
-#ifdef CERNLIB_TCGEN_JBIT
-#undef CERNLIB_TCGEN_JBIT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/jbyt.F b/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/jbyt.F
deleted file mode 100644
index 6cdea86..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/jbyt.F
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: jbyt.F,v 1.1.1.1 1996/02/15 17:52:36 mclareni Exp $
-*
-* $Log: jbyt.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:36 mclareni
-* Kernlib
-*
-*
-#include "kerncry/pilot.h"
- FUNCTION JBYT (IZW,IZP,NZB)
-C
-C CERN PROGLIB# M421 JBYT .VERSION KERNCRY 1.16 911111
-C ORIG. 24/10/91 JZ
-C
- JBYT = SHIFTR(IZW,IZP-1) .AND. MASK(128-NZB)
- RETURN
- END
-#ifdef CERNLIB_TCGEN_JBYT
-#undef CERNLIB_TCGEN_JBYT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/jbytet.F b/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/jbytet.F
deleted file mode 100644
index a6d550b..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/jbytet.F
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: jbytet.F,v 1.1.1.1 1996/02/15 17:52:36 mclareni Exp $
-*
-* $Log: jbytet.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:36 mclareni
-* Kernlib
-*
-*
-#include "kerncry/pilot.h"
- FUNCTION JBYTET (MZ,IZW,IZP,NZB)
-C
-C CERN PROGLIB# M421 JBYTET .VERSION KERNCRY 1.06 870527
-C ORIG. 19/05/87 JZ
-C
- JBYTET = MZ .AND. SHIFTR (IZW,IZP-1) .AND. MASK(128-NZB)
- RETURN
- END
-#ifdef CERNLIB_TCGEN_JBYTET
-#undef CERNLIB_TCGEN_JBYTET
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/jbytor.F b/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/jbytor.F
deleted file mode 100644
index 66f97f3..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/jbytor.F
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: jbytor.F,v 1.1.1.1 1996/02/15 17:52:37 mclareni Exp $
-*
-* $Log: jbytor.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:37 mclareni
-* Kernlib
-*
-*
-#include "kerncry/pilot.h"
- FUNCTION JBYTOR (MZ,IZW,IZP,NZB)
-C
-C CERN PROGLIB# M421 JBYTOR .VERSION KERNCRY 1.06 870527
-C ORIG. 19/05/87 JZ
-C
- JBYTOR = MZ .OR. (SHIFTR(IZW,IZP-1) .AND. MASK(128-NZB))
- RETURN
- END
-#ifdef CERNLIB_TCGEN_JBYTOR
-#undef CERNLIB_TCGEN_JBYTOR
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/kerngt.F b/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/kerngt.F
deleted file mode 100644
index 01b0f56..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/kerngt.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: kerngt.F,v 1.1.1.1 1996/02/15 17:52:35 mclareni Exp $
-*
-* $Log: kerngt.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:35 mclareni
-* Kernlib
-*
-*
-#include "kerncry/pilot.h"
- SUBROUTINE KERNGT (LUN)
-C
-C CERN PROGLIB# Z001 KERNGT .VERSION KERNCRY 1.10 890322
-C ORIG. 16/03/89 JZ
-C
-C-- Store Pam title into /SLATE/ for printing by GSHOWF
-C
- COMMON /SLATE/ MCH(40)
-
- CALL UBLOW (
- + 40H CPP_TITLE
- +, MCH,40)
- CALL GSHOWF (LUN)
- RETURN
- END
-#ifdef CERNLIB_TCGEN_KERNGT
-#undef CERNLIB_TCGEN_KERNGT
-#endif
-#include "kerncry/TITLE.kerncry"
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/legvar.F b/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/legvar.F
deleted file mode 100644
index 6456202..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/legvar.F
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: legvar.F,v 1.1.1.1 1996/02/15 17:52:37 mclareni Exp $
-*
-* $Log: legvar.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:37 mclareni
-* Kernlib
-*
-*
-#include "kerncry/pilot.h"
- FUNCTION LEGVAR (WORD)
-C
-C CERN PROGLIB# LEGVAR .VERSION KERNCRY 1.00 830612
-C ORIG. 12/06/83 JZ
-C
-C-- CRAY VERSION OF THE CDC FUNCTION LEGVAR
-C-- INDICATING WHETHER THE ARGUMENT IS OVERFLOW/INDEFINITE
-C-- RETURNS ZERO IF WELL-BEHAVED FLOATING NUMBER, OR INTEGER
-
-
- LEGVAR = 0
-
- NN = SHIFTR (WORD,48)
- IF (NN.EQ.0) RETURN
- IF (NN.EQ.177777B) RETURN
-
- NN = NN .AND. 77777B
- IF (NN.LT.20000B) GO TO 27
- IF (NN.LT.60000B) RETURN
- 27 LEGVAR = 1
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/locf.F b/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/locf.F
deleted file mode 100644
index ea40163..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/locf.F
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: locf.F,v 1.1.1.1 1996/02/15 17:52:37 mclareni Exp $
-*
-* $Log: locf.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:37 mclareni
-* Kernlib
-*
-*
-#include "kerncry/pilot.h"
- FUNCTION LOCF (AM)
-C
-C CERN PROGLIB# N100 LOCF .VERSION KERNCRY 1.00 830612
-C
- DIMENSION AM(9)
-
- LOCF= LOC (AM(1))
- RETURN
- END
-#ifdef CERNLIB_CCGEN_LOCF
-#undef CERNLIB_CCGEN_LOCF
-#endif
-#ifdef CERNLIB_TCGEN_LOCF
-#undef CERNLIB_TCGEN_LOCF
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/mbytet.F b/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/mbytet.F
deleted file mode 100644
index 78df092..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/mbytet.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: mbytet.F,v 1.1.1.1 1996/02/15 17:52:37 mclareni Exp $
-*
-* $Log: mbytet.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:37 mclareni
-* Kernlib
-*
-*
-#include "kerncry/pilot.h"
- FUNCTION MBYTET (MZ,IZW,IZP,NZB)
-C
-C CERN PROGLIB# M421 MBYTET .VERSION KERNCRY 1.06 870527
-C ORIG. 19/05/87 JZ
-C
-
- MBYTET = IZW .AND. SHIFT (MZ.OR. MASK(64-NZB), IZP-1)
- RETURN
- END
-#ifdef CERNLIB_TCGEN_MBYTET
-#undef CERNLIB_TCGEN_MBYTET
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/mbytor.F b/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/mbytor.F
deleted file mode 100644
index bff9404..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/mbytor.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: mbytor.F,v 1.1.1.1 1996/02/15 17:52:37 mclareni Exp $
-*
-* $Log: mbytor.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:37 mclareni
-* Kernlib
-*
-*
-#include "kerncry/pilot.h"
- FUNCTION MBYTOR (MZ,IZW,IZP,NZB)
-C
-C CERN PROGLIB# M421 MBYTOR .VERSION KERNCRY 1.06 870527
-C ORIG. 19/05/87 JZ
-C
-
- MBYTOR = IZW .OR. SHIFT (MZ.AND.MASK(128-NZB),IZP-1)
- RETURN
- END
-#ifdef CERNLIB_TCGEN_MBYTOR
-#undef CERNLIB_TCGEN_MBYTOR
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/mcbyt.F b/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/mcbyt.F
deleted file mode 100644
index cd22e16..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/mcbyt.F
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: mcbyt.F,v 1.1.1.1 1996/02/15 17:52:37 mclareni Exp $
-*
-* $Log: mcbyt.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:37 mclareni
-* Kernlib
-*
-*
-#include "kerncry/pilot.h"
- FUNCTION MCBYT (MZ,IZQ,IZW,IZP,NZB)
-C
-C CERN PROGLIB# M421 MCBYT .VERSION KERNCRY 1.06 870527
-C ORIG. 19/05/87 JZ
-C
-
- MCBYT = (IZW.AND.SHIFT(MASK(64-NZB),IZP-1))
- + .OR. SHIFT(SHIFTR(MZ,IZQ-1).AND.MASK(128-NZB),IZP-1)
- RETURN
- END
-#ifdef CERNLIB_TCGEN_MCBYT
-#undef CERNLIB_TCGEN_MCBYT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/msbit.F b/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/msbit.F
deleted file mode 100644
index be84a05..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/msbit.F
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: msbit.F,v 1.1.1.1 1996/02/15 17:52:37 mclareni Exp $
-*
-* $Log: msbit.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:37 mclareni
-* Kernlib
-*
-*
-#include "kerncry/pilot.h"
- FUNCTION MSBIT (MZ,IZW,IZP)
-C
-C CERN PROGLIB# M421 MSBIT .VERSION KERNCRY 1.06 870527
-C ORIG. 19/05/87 JZ
-C
-
- MSBIT = (IZW .AND. SHIFT(MASK(65),IZP))
- + .OR. SHIFT(MZ.AND.MASK(127),IZP-1)
- RETURN
- END
-#ifdef CERNLIB_TCGEN_MSBIT
-#undef CERNLIB_TCGEN_MSBIT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/msbit0.F b/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/msbit0.F
deleted file mode 100644
index b5e903b..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/msbit0.F
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: msbit0.F,v 1.1.1.1 1996/02/15 17:52:37 mclareni Exp $
-*
-* $Log: msbit0.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:37 mclareni
-* Kernlib
-*
-*
-#include "kerncry/pilot.h"
- FUNCTION MSBIT0 (IZW,IZP)
-C
-C CERN PROGLIB# M421 MSBIT0 .VERSION KERNCRY 1.06 870527
-C ORIG. 19/05/87 JZ
-C
- MSBIT0 = IZW .AND. SHIFT(MASK(65),IZP)
- RETURN
- END
-#ifdef CERNLIB_TCGEN_MSBIT0
-#undef CERNLIB_TCGEN_MSBIT0
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/msbit1.F b/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/msbit1.F
deleted file mode 100644
index 98b74d7..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/msbit1.F
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: msbit1.F,v 1.1.1.1 1996/02/15 17:52:37 mclareni Exp $
-*
-* $Log: msbit1.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:37 mclareni
-* Kernlib
-*
-*
-#include "kerncry/pilot.h"
- FUNCTION MSBIT1 (IZW,IZP)
-C
-C CERN PROGLIB# M421 MSBIT1 .VERSION KERNCRY 1.06 870527
-C ORIG. 19/05/87 JZ
-C
- MSBIT1 = IZW .OR. SHIFT(MASK(1), IZP)
- RETURN
- END
-#ifdef CERNLIB_TCGEN_MSBIT1
-#undef CERNLIB_TCGEN_MSBIT1
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/msbyt.F b/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/msbyt.F
deleted file mode 100644
index d697750..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/msbyt.F
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: msbyt.F,v 1.1.1.1 1996/02/15 17:52:37 mclareni Exp $
-*
-* $Log: msbyt.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:37 mclareni
-* Kernlib
-*
-*
-#include "kerncry/pilot.h"
- FUNCTION MSBYT (MZ,IZW,IZP,NZB)
-C
-C CERN PROGLIB# M421 MSBYT .VERSION KERNCRY 1.06 870527
-C ORIG. 19/05/87 JZ
-C
-
- MSBYT = (IZW .AND. SHIFT(MASK(64-NZB),IZP-1))
- + .OR. SHIFT(MZ.AND.MASK(128-NZB),IZP-1)
- RETURN
- END
-#ifdef CERNLIB_TCGEN_MSBYT
-#undef CERNLIB_TCGEN_MSBYT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/mvbits.F b/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/mvbits.F
deleted file mode 100644
index 82ad79d..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/mvbits.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: mvbits.F,v 1.1.1.1 1996/02/15 17:52:37 mclareni Exp $
-*
-* $Log: mvbits.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:37 mclareni
-* Kernlib
-*
-*
-#include "kerncry/pilot.h"
- SUBROUTINE MVBITS(I,N,L,J,M)
-C
-C CERN PROGLIB# M441 MVBITS .VERSION KERNCRY 1.06 870527
-C ORIG. 17/11/86 CNAF, BOLOGNA
-C
-C CRAY VERSION OF MIL-STD-1753 SUBROUTINE MVBITS
-C N IS THE POSITION IN I FROM WHICH BITS ARE EXTRACTED
-C L IS THE NUMBER OF BITS TO BE EXTRACTED
-C M IS THE POSITION IN J INTO WHICH BITS ARE TO BE PLACED
-C
-C
- J = OR(AND(MASK(128-M),J),AND(MASK(64-M-L),J))
- J = OR(J,SHIFTL(AND(SHIFTR(I,N),MASK(128-L)),M))
- END
-#ifdef CERNLIB_TCGEN_MVBITS
-#undef CERNLIB_TCGEN_MVBITS
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/qnexte.s b/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/qnexte.s
deleted file mode 100644
index f7a4722..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/qnexte.s
+++ /dev/null
@@ -1,38 +0,0 @@
-*
-* $Id: qnexte.s,v 1.1.1.1 1996/02/15 17:52:37 mclareni Exp $
-*
-* $Log: qnexte.s,v $
-* Revision 1.1.1.1 1996/02/15 17:52:37 mclareni
-* Kernlib
-*
-*
- IDENT QNEXTE
-*
-* CERN PROGLIB# Z041 QNEXTE .VERSION KERNCRY 1.04 840816
-* ORIG. 12/06/83 D.LELLOUCH, LPNHE
-*
- EXT QNEXT
- ENTRY QNEXTE
-FIRST BSSZ 4
-QNEXTE = *
- A0 FIRST,
- JAN NOTFIRST
- A1 1
- FIRST, A1
- A2 B00
- A3 B01
- FIRST+1, A2
- FIRST+2, A3
- J QNEXT
-NOTFIRST A2 FIRST+1,
- A3 FIRST+2,
- B00 A2
- B01 A3
- J QNEXT
- END
-#ifdef CERNLIB_CCGEN_QNEXTE
-#undef CERNLIB_CCGEN_QNEXTE
-#endif
-#ifdef CERNLIB_TCGEN_QNEXTE
-#undef CERNLIB_TCGEN_QNEXTE
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/rndm.F b/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/rndm.F
deleted file mode 100644
index d35cea9..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/rndm.F
+++ /dev/null
@@ -1,36 +0,0 @@
-*
-* $Id: rndm.F,v 1.1.1.1 1996/02/15 17:52:37 mclareni Exp $
-*
-* $Log: rndm.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:37 mclareni
-* Kernlib
-*
-*
-#include "kerncry/pilot.h"
- FUNCTION RNDM (X)
-C
-C CERN PROGLIB# V104 RNDM .VERSION KERNCRY 1.05 861204
-C ORIG. 18/01/84 W.W. SACLAY/DPHPE
-C
- RNDM = RANF ()
- RETURN
- END
-
- FUNCTION IRNDM (X)
- CALL RANGET(ISTOR)
- IRNDM = ISTOR
- RETURN
- END
-
- SUBROUTINE RDMOUT (ISEED)
- CALL RANGET(ISEED)
- RETURN
- END
-
- SUBROUTINE RDMIN (ISEED)
- CALL RANSET (ISEED)
- RETURN
- END
-#ifdef CERNLIB_TCGEN_RNDM
-#undef CERNLIB_TCGEN_RNDM
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/sbit.F b/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/sbit.F
deleted file mode 100644
index 46c08f6..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/sbit.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: sbit.F,v 1.1.1.1 1996/02/15 17:52:37 mclareni Exp $
-*
-* $Log: sbit.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:37 mclareni
-* Kernlib
-*
-*
-#include "kerncry/pilot.h"
- SUBROUTINE SBIT (MZ,IZW,IZP)
-C
-C CERN PROGLIB# M421 SBIT .VERSION KERNCRY 1.16 911111
-C ORG. 24/10/91, JZ
-C
- IZW = (IZW .AND. SHIFT(MASK(65),IZP))
- + .OR. SHIFT(MZ.AND.MASK(127),IZP-1)
- RETURN
- END
-#ifdef CERNLIB_TCGEN_SBIT
-#undef CERNLIB_TCGEN_SBIT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/sbit0.F b/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/sbit0.F
deleted file mode 100644
index 2a234de..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/sbit0.F
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: sbit0.F,v 1.1.1.1 1996/02/15 17:52:38 mclareni Exp $
-*
-* $Log: sbit0.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:38 mclareni
-* Kernlib
-*
-*
-#include "kerncry/pilot.h"
- SUBROUTINE SBIT0 (IZW,IZP)
-C
-C CERN PROGLIB# M421 SBIT0 .VERSION KERNCRY 1.16 911111
-C ORG. 24/10/91, JZ
-C
- IZW = IZW .AND. SHIFT(MASK(65),IZP)
- RETURN
- END
-#ifdef CERNLIB_TCGEN_SBIT0
-#undef CERNLIB_TCGEN_SBIT0
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/sbit1.F b/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/sbit1.F
deleted file mode 100644
index d9add83..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/sbit1.F
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: sbit1.F,v 1.1.1.1 1996/02/15 17:52:38 mclareni Exp $
-*
-* $Log: sbit1.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:38 mclareni
-* Kernlib
-*
-*
-#include "kerncry/pilot.h"
- SUBROUTINE SBIT1 (IZW,IZP)
-C
-C CERN PROGLIB# M421 SBIT1 .VERSION KERNCRY 1.16 911111
-C ORG. 24/10/91, JZ
-C
- IZW = IZW .OR. SHIFT(MASK(1), IZP)
- RETURN
- END
-#ifdef CERNLIB_TCGEN_SBIT1
-#undef CERNLIB_TCGEN_SBIT1
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/sbyt.F b/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/sbyt.F
deleted file mode 100644
index 75d15db..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/sbyt.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: sbyt.F,v 1.1.1.1 1996/02/15 17:52:38 mclareni Exp $
-*
-* $Log: sbyt.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:38 mclareni
-* Kernlib
-*
-*
-#include "kerncry/pilot.h"
- SUBROUTINE SBYT (MZ,IZW,IZP,NZB)
-C
-C CERN PROGLIB# M421 SBYT .VERSION KERNCRY 1.16 911111
-C ORG. 24/10/91, JZ
-C
- IZW = (IZW .AND. SHIFT(MASK(64-NZB),IZP-1))
- + .OR. SHIFT(MZ.AND.MASK(128-NZB),IZP-1)
- RETURN
- END
-#ifdef CERNLIB_TCGEN_SBYT
-#undef CERNLIB_TCGEN_SBYT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/timed.F b/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/timed.F
deleted file mode 100644
index 7718e33..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/timed.F
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: timed.F,v 1.1.1.1 1996/02/15 17:52:38 mclareni Exp $
-*
-* $Log: timed.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:38 mclareni
-* Kernlib
-*
-*
-#include "kerncry/pilot.h"
- SUBROUTINE TIMED (T)
-C
-C CERN PROGLIB# Z007 TIMED .VERSION KERNCRY 1.03 840215
-C ORIG. 18/01/84 W.W. SACLAY/DPHPE
-C
- REAL LAST, NOW
- SAVE LAST
- DATA LAST / 0. /
-
- NOW = SECOND ()
- T = NOW - LAST
- LAST = NOW
- RETURN
- END
-#ifdef CERNLIB_CCGEN_TIMED
-#undef CERNLIB_CCGEN_TIMED
-#endif
-#ifdef CERNLIB_TCGEN_TIMED
-#undef CERNLIB_TCGEN_TIMED
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/timex.F b/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/timex.F
deleted file mode 100644
index 934a4a2..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/timex.F
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: timex.F,v 1.1.1.1 1996/02/15 17:52:38 mclareni Exp $
-*
-* $Log: timex.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:38 mclareni
-* Kernlib
-*
-*
-#include "kerncry/pilot.h"
- SUBROUTINE TIMEX (T)
-C
-C CERN PROGLIB# Z007 TIMEX .VERSION KERNCRY 1.03 840215
-C ORIG. 18/01/84 W.W. SACLAY/DPHPE
-C
- T = SECOND ()
- RETURN
- END
-#ifdef CERNLIB_CCGEN_TIMEX
-#undef CERNLIB_CCGEN_TIMEX
-#endif
-#ifdef CERNLIB_TCGEN_TIMEX
-#undef CERNLIB_TCGEN_TIMEX
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/traceq.F b/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/traceq.F
deleted file mode 100644
index 03253e6..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/traceq.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: traceq.F,v 1.1.1.1 1996/02/15 17:52:38 mclareni Exp $
-*
-* $Log: traceq.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:38 mclareni
-* Kernlib
-*
-*
-#include "kerncry/pilot.h"
- SUBROUTINE TRACEQ (LUNP,LEV)
-C
-C CERN PROGLIB# N105 TRACEQ .VERSION KERNCRY 1.07 880428
-C ORIG. 12/06/83 JZ
-C
-
- LUN = LUNP
-#if defined(CERNLIB_QMCRU)
- IF (LUN.EQ.0) LUN=6
-#endif
-#if !defined(CERNLIB_QMCRU)
- IF (LUN.EQ.0) LUN=4L$OUT
-#endif
- CALL TRBK (LUN)
- RETURN
- END
-#ifdef CERNLIB_TCGEN_TRACEQ
-#undef CERNLIB_TCGEN_TRACEQ
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/ublow.F b/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/ublow.F
deleted file mode 100644
index f1d6bf6..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/ublow.F
+++ /dev/null
@@ -1,53 +0,0 @@
-*
-* $Id: ublow.F,v 1.1.1.1 1996/02/15 17:52:38 mclareni Exp $
-*
-* $Log: ublow.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:38 mclareni
-* Kernlib
-*
-*
-#include "kerncry/pilot.h"
- SUBROUTINE UBLOW (MS,MT,NCHP)
-C
-C CERN PROGLIB# M409 UBLOW .VERSION KERNCRY 1.06 870527
-C ORIG. 12/06/83 JZ, 20/05/87 remove entry UCTOH1
-C
-
- DIMENSION MS(99), MT(99)
- DATA IBLANK / ' 'R /
-
- JT = 1
- NCH = NCHP
- IF (NCH.LE.0) RETURN
-
- NW = (NCH-1)/8 + 1
- IF (NCH.LT.9) GO TO 31
-
-C-- UNPACK THE INITIAL COMPLETE WORDS
-
- NWL = NCH/8
- NCHL= 8*NWL
-
- CALL UNPACK (MS,8,MT,NCHL)
-
- DO 24 J=1,NCHL
- 24 MT(J) = SHIFT(MT(J),56) .OR. IBLANK
-
- IF (NWL.EQ.NW) RETURN
- JT = NCHL + 1
-
-C-- UNPACK THE LAST INCOMPLETE WORD
-
-CDIR$ NOVECTOR
-
- 31 M8 = MASK (8)
- MM = MS(NW)
-
- DO 34 J=JT,NCH
- MT(J) = (MM.AND.M8) .OR. IBLANK
- 34 MM = SHIFT (MM,8)
- RETURN
- END
-#ifdef CERNLIB_TCGEN_UBLOW
-#undef CERNLIB_TCGEN_UBLOW
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/ubunch.F b/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/ubunch.F
deleted file mode 100644
index 735c2fb..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/ubunch.F
+++ /dev/null
@@ -1,57 +0,0 @@
-*
-* $Id: ubunch.F,v 1.1.1.1 1996/02/15 17:52:39 mclareni Exp $
-*
-* $Log: ubunch.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:39 mclareni
-* Kernlib
-*
-*
-#include "kerncry/pilot.h"
-C
-C CERN PROGLIB# M409 UBUNCH .VERSION KERNCRY 1.06 870527
-C ORIG. 12/06/83 JZ, 20/05/87 remove entry UH1TOC
-C
- SUBROUTINE UBUNCH (MS,MT,NCHP)
-
- DIMENSION MS(99), MT(99)
- DATA IBLANK / 8H /
-
- JS = 1
- NCH = NCHP
- IF (NCH.LE.0) RETURN
-
- NW = (NCH-1)/8 + 1
- NWL = NCH/8
- IF (NCH.LT.8) GO TO 31
-
-C-- PACK THE LEADING COMPLETE WORDS
-
- DO 24 JW=1,NWL
- MM = SHIFTR(MS(JS+0),56)
- MM = SHIFT(MM,8) .OR. SHIFTR(MS(JS+1),56)
- MM = SHIFT(MM,8) .OR. SHIFTR(MS(JS+2),56)
- MM = SHIFT(MM,8) .OR. SHIFTR(MS(JS+3),56)
- MM = SHIFT(MM,8) .OR. SHIFTR(MS(JS+4),56)
- MM = SHIFT(MM,8) .OR. SHIFTR(MS(JS+5),56)
- MM = SHIFT(MM,8) .OR. SHIFTR(MS(JS+6),56)
- MM = SHIFT(MM,8) .OR. SHIFTR(MS(JS+7),56)
- MT(JW) = MM
- 24 JS = JS + 8
-
- IF (NWL.EQ.NW) RETURN
-
-C-- PACK THE TRAILING WORD
-
-CDIR$ NOVECTOR
-
- 31 N = NCH+1 - JS
-
- DO 34 J=JS,NCH
- 34 MM = SHIFTL(MM,8) .OR. SHIFTR(MS(J),56)
-
- MT(NW) = SHIFTL(MM,8*(8-N)) .OR. SHIFTR(IBLANK,8*N)
- RETURN
- END
-#ifdef CERNLIB_TCGEN_UBUNCH
-#undef CERNLIB_TCGEN_UBUNCH
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/uctoh.F b/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/uctoh.F
deleted file mode 100644
index 1b16085..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/uctoh.F
+++ /dev/null
@@ -1,63 +0,0 @@
-*
-* $Id: uctoh.F,v 1.1.1.1 1996/02/15 17:52:39 mclareni Exp $
-*
-* $Log: uctoh.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:39 mclareni
-* Kernlib
-*
-*
-#include "kerncry/pilot.h"
- SUBROUTINE UCTOH (VC,MVH,NHL,NCH)
-C
-C CERN PROGLIB# M409 UCTOH .VERSION KERNCRY 1.06 870527
-C ORIG. 20/05/87 Federico Carminati + Julius Zoll
-C
- CHARACTER*(*) VC
- DIMENSION MVH(9), IBLV(8)
-
- DATA IBLV / X'0020202020202020'
- +, X'0000202020202020'
- +, X'0000002020202020'
- +, X'0000000020202020'
- +, X'0000000000202020'
- +, X'0000000000002020'
- +, X'0000000000000020'
- +, X'0000000000000000' /
-
- IF (NCH.LE.0) RETURN
-
- NHPW = MIN(NHL,8)
- NFULL = NCH / NHPW
- NREST = MOD (NCH,NHPW)
- JCH = 0
- IF (NFULL.EQ.0) GO TO 21
-
- IBLANK = IBLV(NHPW)
-
- DO 17 JWORD=1,NFULL
- IWD = IBLANK
- JSH = 64
-
- DO 16 J=1,NHPW
- JCH = JCH + 1
- JSH = JSH - 8
- 16 IWD = IWD .OR. SHIFT(ICHAR(VC(JCH:JCH)), JSH)
- 17 MVH(JWORD) = IWD
- IF (NREST.EQ.0) RETURN
-
-C-- Do the last incomplete word
-
- 21 IWD = IBLV(NREST)
- JSH = 64
-
- DO 24 J=1,NREST
- JCH = JCH + 1
- JSH = JSH - 8
- IWD = IWD .OR. SHIFT(ICHAR(VC(JCH:JCH)), JSH)
- 24 CONTINUE
- MVH(NFULL+1) = IWD
- RETURN
- END
-#ifdef CERNLIB_TCGEN_UCTOH
-#undef CERNLIB_TCGEN_UCTOH
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/uctoh1.F b/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/uctoh1.F
deleted file mode 100644
index ad905e7..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/uctoh1.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: uctoh1.F,v 1.1.1.1 1996/02/15 17:52:40 mclareni Exp $
-*
-* $Log: uctoh1.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:40 mclareni
-* Kernlib
-*
-*
-#include "kerncry/pilot.h"
- SUBROUTINE UCTOH1 (VC,MVH,NCH)
-C
-C CERN PROGLIB# M409 UCTOH1 .VERSION KERNCRY 1.06 870527
-C ORIG. 20/05/87 Federico Carminati + Julius Zoll
-C
- CHARACTER*(*) VC
- DIMENSION MVH(9)
-
- DATA IBLANK / X'0020202020202020' /
-
- IF (NCH.LE.0) RETURN
-
- DO 16 JCH=1,NCH
- 16 MVH(JCH) = IBLANK .OR. SHIFT(ICHAR(VC(JCH:JCH)), 56)
- RETURN
- END
-#ifdef CERNLIB_TCGEN_UCTOH1
-#undef CERNLIB_TCGEN_UCTOH1
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/uh1toc.F b/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/uh1toc.F
deleted file mode 100644
index d2c2f55..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/uh1toc.F
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: uh1toc.F,v 1.1.1.1 1996/02/15 17:52:40 mclareni Exp $
-*
-* $Log: uh1toc.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:40 mclareni
-* Kernlib
-*
-*
-#include "kerncry/pilot.h"
- SUBROUTINE UH1TOC (MVH,VC,NCH)
-C
-C CERN PROGLIB# M409 UH1TOC .VERSION KERNCRY 1.06 870527
-C ORIG. 20/05/87 Federico Carminati + Julius Zoll
-C
- CHARACTER*(*) VC
- DIMENSION MVH(9)
-
- IF (NCH.LE.0) RETURN
-
- DO 16 JCH=1,NCH
- ICH = SHIFT(MVH(JCH),8) .AND. MASK(128-8)
- 16 VC(JCH:JCH) = CHAR(ICH)
- RETURN
- END
-#ifdef CERNLIB_TCGEN_UH1TOC
-#undef CERNLIB_TCGEN_UH1TOC
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/uhtoc.F b/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/uhtoc.F
deleted file mode 100644
index d16da63..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/uhtoc.F
+++ /dev/null
@@ -1,52 +0,0 @@
-*
-* $Id: uhtoc.F,v 1.1.1.1 1996/02/15 17:52:40 mclareni Exp $
-*
-* $Log: uhtoc.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:40 mclareni
-* Kernlib
-*
-*
-#include "kerncry/pilot.h"
- SUBROUTINE UHTOC (MVH,NHL,VC,NCH)
-C
-C CERN PROGLIB# M409 UHTOC .VERSION KERNCRY 1.06 870527
-C ORIG. 20/05/87 Federico Carminati + Julius Zoll
-C
- CHARACTER*(*) VC
- DIMENSION MVH(9)
-
- IF (NCH.LE.0) RETURN
-
- NHPW = MIN(NHL,8)
- NFULL = NCH / NHPW
- NREST = MOD (NCH,NHPW)
- JCH = 0
- IF (NFULL.EQ.0) GO TO 21
-
-C-- Do the complete words
-
- DO 17 JWORD=1,NFULL
- IWD = MVH(JWORD)
-
- DO 16 J=1,NHPW
- IWD = SHIFT(IWD,8)
- ICH = IWD .AND. MASK(128-8)
- JCH = JCH + 1
- 16 VC(JCH:JCH) = CHAR(ICH)
- 17 CONTINUE
- IF (NREST.EQ.0) RETURN
-
-C-- Do the last incomplete word
-
- 21 IWD = MVH(NFULL+1)
-
- DO 24 J=1,NREST
- IWD = SHIFT(IWD,8)
- ICH = IWD .AND. MASK(128-8)
- JCH = JCH + 1
- 24 VC(JCH:JCH) = CHAR(ICH)
- RETURN
- END
-#ifdef CERNLIB_TCGEN_UHTOC
-#undef CERNLIB_TCGEN_UHTOC
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/vmatl.F b/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/vmatl.F
deleted file mode 100644
index 9fdc49d..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/vmatl.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: vmatl.F,v 1.1.1.1 1996/02/15 17:52:40 mclareni Exp $
-*
-* $Log: vmatl.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:40 mclareni
-* Kernlib
-*
-*
-#include "kerncry/pilot.h"
- SUBROUTINE VMATL (H,A,X,K,N)
-C
-C CERN PROGLIB# F121 VMATL .VERSION KERNCRY 1.11 890627
-C ORIG. 30/05/89 FCA
-C
- DIMENSION A(*),X(*),H(N,K)
-C
- CALL SGEMV ('T',N,K,1.,H,N,A,1,0.,X,1)
- END
-#ifdef CERNLIB_TCGEN_VMATL
-#undef CERNLIB_TCGEN_VMATL
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/vmatr.F b/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/vmatr.F
deleted file mode 100644
index 6f8f164..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncry/crygs/vmatr.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: vmatr.F,v 1.1.1.1 1996/02/15 17:52:41 mclareni Exp $
-*
-* $Log: vmatr.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:41 mclareni
-* Kernlib
-*
-*
-#include "kerncry/pilot.h"
- SUBROUTINE VMATR (A,G,X,N,K)
-C
-C CERN PROGLIB# F121 VMATR .VERSION KERNCRY 1.11 890627
-C ORIG. 30/05/89 FCA
-C
- DIMENSION A(*),X(*),G(K,N)
-C
- CALL SGEMV ('N',K,N,1.,G,K,A,1,0.,X,1)
- END
-#ifdef CERNLIB_TCGEN_VMATR
-#undef CERNLIB_TCGEN_VMATR
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncry/cryuni/Imakefile b/src/packlib/kernlib/kerngen/obsolete/kerncry/cryuni/Imakefile
deleted file mode 100644
index b5aca14..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncry/cryuni/Imakefile
+++ /dev/null
@@ -1,10 +0,0 @@
-SRCS_F= \ @@\
- chdirf.F getenvf.F jobnam.F statf.F systemf.F unlinkf.F xinbf.F
-
-SRCS_C= \ @@\
- iargv.c intrac.c memor.c signalf.c sigon.c timel.c tmpro.c tmread.c
-
-SRCS_S= \ @@\
- noarg.s
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncry/cryuni/chdirf.F b/src/packlib/kernlib/kerngen/obsolete/kerncry/cryuni/chdirf.F
deleted file mode 100644
index a15f56e..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncry/cryuni/chdirf.F
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: chdirf.F,v 1.1.1.1 1996/02/15 17:52:42 mclareni Exp $
-*
-* $Log: chdirf.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:42 mclareni
-* Kernlib
-*
-*
-#include "kerncry/pilot.h"
- INTEGER FUNCTION CHDIRF (NAME)
-C
-C CERN PROGLIB# Z265 CHDIRF .VERSION KERNCRY 1.16 911111
-C ORIG. 17/10/91, JZ
-C Fortran interface routine to chdir
-C
- CHARACTER NAME*(*)
- INTEGER CHDIR
-
- CHDIRF = CHDIR (NAME)
- RETURN
- END
-#ifdef CERNLIB_CCGEN_CHDIRF
-#undef CERNLIB_CCGEN_CHDIRF
-#endif
-#ifdef CERNLIB_CCGEN_CHDIRI
-#undef CERNLIB_CCGEN_CHDIRI
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncry/cryuni/getenvf.F b/src/packlib/kernlib/kerngen/obsolete/kerncry/cryuni/getenvf.F
deleted file mode 100644
index 2e89d63..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncry/cryuni/getenvf.F
+++ /dev/null
@@ -1,35 +0,0 @@
-*
-* $Id: getenvf.F,v 1.1.1.1 1996/02/15 17:52:42 mclareni Exp $
-*
-* $Log: getenvf.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:42 mclareni
-* Kernlib
-*
-*
-#include "kerncry/pilot.h"
- SUBROUTINE GETENVF (NAME, TEXT)
-C
-C CERN PROGLIB# Z265 GETENVF .VERSION KERNCRY 1.17 920229
-C ORIG. 17/10/91, JZ
-C Fortran interface routine to getenv
-C
- COMMON /SLATE/ISL(40)
- CHARACTER*(*) NAME, TEXT
- INTEGER GETENV
-
- LGN = LNBLNK (NAME)
- ISTAT = GETENV (NAME(1:LGN),TEXT)
- IF (ISTAT.NE.0) THEN
- ISL(1) = LNBLNK(TEXT)
- ELSE
- ISL(1) = 0
- TEXT = ' '
- ENDIF
- RETURN
- END
-#ifdef CERNLIB_CCGEN_GETENVF
-#undef CERNLIB_CCGEN_GETENVF
-#endif
-#ifdef CERNLIB_CCGEN_GETENI
-#undef CERNLIB_CCGEN_GETENI
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncry/cryuni/iargv.c b/src/packlib/kernlib/kerngen/obsolete/kerncry/cryuni/iargv.c
deleted file mode 100644
index cae89fb..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncry/cryuni/iargv.c
+++ /dev/null
@@ -1,28 +0,0 @@
-/*
- * $Id: iargv.c,v 1.1.1.1 1996/02/15 17:52:43 mclareni Exp $
- *
- * $Log: iargv.c,v $
- * Revision 1.1.1.1 1996/02/15 17:52:43 mclareni
- * Kernlib
- *
- */
-#include "kerncry/pilot.h"
-/*> ROUTINE IARGV
- CERN PROGLIB# IARGV .VERSION KERNCRY 1.14 910318
- ORIG. 28/04/88 FCA
-*/
-#include <sys/types.h>
-#include <fortran.h>
-extern char **_argv;
-IARGV(jarg,gotext)
- _fcd gotext;
- int *jarg;
-{
- int i, j, ilen;
- char *arg = _argv[*jarg];
- char *cp = _fcdtocp(gotext);
- unsigned len = _fcdlen(gotext);
- for(ilen=0 ; ilen < len && (cp[ilen]=arg[ilen]) != '\0'; ilen++);
- return(ilen);
-}
-/*> END <----------------------------------------------------------*/
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncry/cryuni/intrac.c b/src/packlib/kernlib/kerngen/obsolete/kerncry/cryuni/intrac.c
deleted file mode 100644
index d152c0f..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncry/cryuni/intrac.c
+++ /dev/null
@@ -1,25 +0,0 @@
-/*
- * $Id: intrac.c,v 1.1.1.1 1996/02/15 17:52:43 mclareni Exp $
- *
- * $Log: intrac.c,v $
- * Revision 1.1.1.1 1996/02/15 17:52:43 mclareni
- * Kernlib
- *
- */
-#include "kerncry/pilot.h"
-/*> ROUTINE INTRAC
- CERN PROGLIB# Z044 INTRAC .VERSION KERNCRY 1.16 911111
-*/
-#include <fortran.h>
-long INTRAC()
-{
- int isatty();
- return (_btol ((long) isatty(0)));
-}
-/*> END <----------------------------------------------------------*/
-#ifdef CERNLIB_CCGEN_INTRAC
-#undef CERNLIB_CCGEN_INTRAC
-#endif
-#ifdef CERNLIB_TCGEN_INTRAC
-#undef CERNLIB_TCGEN_INTRAC
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncry/cryuni/jobnam.F b/src/packlib/kernlib/kerngen/obsolete/kerncry/cryuni/jobnam.F
deleted file mode 100644
index 1cd9e8c..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncry/cryuni/jobnam.F
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: jobnam.F,v 1.1.1.1 1996/02/15 17:52:43 mclareni Exp $
-*
-* $Log: jobnam.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:43 mclareni
-* Kernlib
-*
-*
-#include "kerncry/pilot.h"
- SUBROUTINE JOBNAM (ID)
-C
-C CERN PROGLIB# Z100 JOBNAM .VERSION KERNCRY 1.10 890322
-C ORIG. 20/12/88 FCA
-C
- CHARACTER*8 ID, RNAME
- INTEGER GETENV
-C
- IB = GETENV ('ENVIRONMENT'L, K, 1)
- IF (IB .NE. 0) THEN
-C The ENVIRONMENT variable is defined, we are a batch job
- IRC = GETENV ('QSUB_REQNAME'L, RNAME, 1)
- I = INDEX (RNAME, '_')
- IF (I .EQ. 0) I = INDEX (RNAME, '.')
- IF (I .NE. 0) RNAME = RNAME(1:I-1)
- ELSE
-C We are an interactive process
- IRC = GETENV ('LOGNAME'L, RNAME, 1)
- ENDIF
- ID = RNAME
- END
-#ifdef CERNLIB_TCGEN_JOBNAM
-#undef CERNLIB_TCGEN_JOBNAM
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncry/cryuni/memor.c b/src/packlib/kernlib/kerngen/obsolete/kerncry/cryuni/memor.c
deleted file mode 100644
index 95ca7d3..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncry/cryuni/memor.c
+++ /dev/null
@@ -1,32 +0,0 @@
-/*
- * $Id: memor.c,v 1.1.1.1 1996/02/15 17:52:43 mclareni Exp $
- *
- * $Log: memor.c,v $
- * Revision 1.1.1.1 1996/02/15 17:52:43 mclareni
- * Kernlib
- *
- */
-#include "kerncry/pilot.h"
-/*> ROUTINE MEMOR
- CERN PROGLIB# MEMOR .VERSION KERNCRY 1.14 910318
- ORIG. 27/06/89 FCA
-*/
-#include <sys/types.h>
-#include <sys/category.h>
-#include <sys/jtab.h>
-#include <sys/resource.h>
-#include <fortran.h>
-MEMOR (memuse, memlimit)
-long *memuse, *memlimit;
-{
- int j;
- long limit();
- struct jtab jtab;
- int getjtab();
- j = getjtab(&jtab);
- if (j > 0) {
- *memuse= jtab.j_memuse*512;
- }
- *memlimit = limit (C_PROC, 0, L_MEM, -1)*512;
-}
-/*> END <----------------------------------------------------------*/
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncry/cryuni/noarg.s b/src/packlib/kernlib/kerngen/obsolete/kerncry/cryuni/noarg.s
deleted file mode 100644
index 1151e83..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncry/cryuni/noarg.s
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: noarg.s,v 1.1.1.1 1996/02/15 17:52:43 mclareni Exp $
-*
-* $Log: noarg.s,v $
-* Revision 1.1.1.1 1996/02/15 17:52:43 mclareni
-* Kernlib
-*
-*
- IDENT NOARG
-*
-* CERN PROGLIB# Z029 NOARG .VERSION KERNCRY 1.09 881102
-* ORIG. 13/10/88 J-Ph Baud, CERN
-*
- SECTION CODE
-NOARG ENTER NP=1,MODE=USER,TYPE=ADDRESS
- NUMARG A0,ARGPTR=A6
- ARGADD A5,1,ARGPTR=A6
- A2 B02
- A3 2,A2
- GETF,S2 S7,ARN,A3
- S1 S2
- $IF AN
- 0,A5 S1
- $ENDIF
- EXIT MODE=USER
- END
-#ifdef CERNLIB_TCGEN_NOARG
-#undef CERNLIB_TCGEN_NOARG
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncry/cryuni/signalf.c b/src/packlib/kernlib/kerngen/obsolete/kerncry/cryuni/signalf.c
deleted file mode 100644
index c64504c..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncry/cryuni/signalf.c
+++ /dev/null
@@ -1,42 +0,0 @@
-/*
- * $Id: signalf.c,v 1.1.1.1 1996/02/15 17:52:43 mclareni Exp $
- *
- * $Log: signalf.c,v $
- * Revision 1.1.1.1 1996/02/15 17:52:43 mclareni
- * Kernlib
- *
- */
-#include "kerncry/pilot.h"
-/*> ROUTINE SIGNALF
- CERN PROGLIB# SIGNALF .VERSION KERNCRY 1.16 911111
- ORIG. 16/10/91, J-Ph. Baud
- FORTRAN interface routine to sigaction */
-#include <signal.h>
-int SIGNALF(signum,funct,flag)
- int *signum, *flag;
- void (*funct)();
-{
- int sigaction();
- int istat, signo;
-
- struct sigaction newbuf;
- struct sigaction oldbuf;
-
- signo = *signum;
-
- if (*flag < 0) newbuf.sa_handler = funct;
- else if (*flag == 0) newbuf.sa_handler = SIG_DFL;
- else if (*flag == 1) newbuf.sa_handler = SIG_IGN;
- else newbuf.sa_handler = (void (*)())*flag;
-
- newbuf.sa_flags = 0;
- sigemptyset(&newbuf.sa_mask);
-
- istat = sigaction(signo,&newbuf,&oldbuf);
- if (istat == 0) return (int)oldbuf.sa_handler;
- return -1;
-}
-/*> END <----------------------------------------------------------*/
-#ifdef CERNLIB_CCGEN_SIGNALF
-#undef CERNLIB_CCGEN_SIGNALF
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncry/cryuni/sigon.c b/src/packlib/kernlib/kerngen/obsolete/kerncry/cryuni/sigon.c
deleted file mode 100644
index 099c5c3..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncry/cryuni/sigon.c
+++ /dev/null
@@ -1,23 +0,0 @@
-/*
- * $Id: sigon.c,v 1.1.1.1 1996/02/15 17:52:43 mclareni Exp $
- *
- * $Log: sigon.c,v $
- * Revision 1.1.1.1 1996/02/15 17:52:43 mclareni
- * Kernlib
- *
- */
-#include "kerncry/pilot.h"
-/*> ROUTINE SIGON
- CERN PROGLIB# SIGON .VERSION KERNIRT 1.03 910314
- ORIG. 25/10/91, JZ
- Fortran interface routine to sigon / sigoff
-*/
-int SIGON()
-{
- return ((int) sigon());
-}
-int SIGOFF()
-{
- return ((int) sigoff());
-}
-/*> END <----------------------------------------------------------*/
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncry/cryuni/statf.F b/src/packlib/kernlib/kerngen/obsolete/kerncry/cryuni/statf.F
deleted file mode 100644
index 6e4657a..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncry/cryuni/statf.F
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: statf.F,v 1.1.1.1 1996/02/15 17:52:43 mclareni Exp $
-*
-* $Log: statf.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:43 mclareni
-* Kernlib
-*
-*
-#include "kerncry/pilot.h"
- INTEGER FUNCTION STATF (NAME, INFO)
-C
-C CERN PROGLIB# Z265 STATF .VERSION KERNCRY 1.16 911111
-C ORIG. 17/10/91, JZ
-C Fortran interface routine to stat
-C
-C NAME the name of the file of which information is required
-C INFO(12) buffer returning the information about "file"
-C
-C A succesfull call returns 0. A failed call returns -1.
-C
- CHARACTER*(*) NAME
- INTEGER INFO(12), STAT
-
- STATF = STAT (NAME, INFO)
- RETURN
- END
-#ifdef CERNLIB_CCGEN_STATF
-#undef CERNLIB_CCGEN_STATF
-#endif
-#ifdef CERNLIB_CCGEN_STATI
-#undef CERNLIB_CCGEN_STATI
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncry/cryuni/systemf.F b/src/packlib/kernlib/kerngen/obsolete/kerncry/cryuni/systemf.F
deleted file mode 100644
index 512ed7d..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncry/cryuni/systemf.F
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: systemf.F,v 1.1.1.1 1996/02/15 17:52:43 mclareni Exp $
-*
-* $Log: systemf.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:43 mclareni
-* Kernlib
-*
-*
-#include "kerncry/pilot.h"
- INTEGER FUNCTION SYSTEMF (CMD)
-C
-C CERN PROGLIB# SYSTEMF .VERSION KERNCRY 1.15 910318
-C ORIG. 19/06/91, Miguel Marquina
-C Fortran interface routine to ISHELL
- CHARACTER*(*) CMD
-
- SYSTEMF = ISHELL (CMD)
- RETURN
- END
-#ifdef CERNLIB_CCGEN_SYSTEMF
-#undef CERNLIB_CCGEN_SYSTEMF
-#endif
-#ifdef CERNLIB_CCGEN_SYSTEI
-#undef CERNLIB_CCGEN_SYSTEI
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncry/cryuni/timel.c b/src/packlib/kernlib/kerngen/obsolete/kerncry/cryuni/timel.c
deleted file mode 100644
index 8cc8834..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncry/cryuni/timel.c
+++ /dev/null
@@ -1,93 +0,0 @@
-/*
- * $Id: timel.c,v 1.1.1.1 1996/02/15 17:52:44 mclareni Exp $
- *
- * $Log: timel.c,v $
- * Revision 1.1.1.1 1996/02/15 17:52:44 mclareni
- * Kernlib
- *
- */
-#include "kerncry/pilot.h"
-/*> ROUTINE TIMEL
- CERN PROGLIB# Z007 TIMEL .VERSION KERNCRY 1.15 910318
- ORIG. 28/04/88 FCA
- MOD. 28/02/91 FCA
-*/
-#include <sys/types.h>
-#include <sys/category.h>
-#include <sys/jtab.h>
-#include <sys/resource.h>
-#include <sys/times.h>
-#include <sys/machd.h>
-
-struct tms tms;
-static float timlim, invhz;
-static time_t timstart, timlast;
-static long init = 1;
-float deftim = 105263157000.;
-
-int getjtab();
-long times();
-char *getenv();
-int strcmp();
-
-void TIMEST(timl)
-float *timl;
-{
- if (init != 0) {
- char *env;
- times(&tms);
- invhz = 1./ (float) HZ;
- timlim = *timl;
- timstart = tms.tms_utime+tms.tms_stime;
- timlast = timstart;
- env = getenv("ENVIRONMENT");
- if ( strcmp( env, "BATCH" ) == 0 ) timlim = deftim ;
- else timlim = *timl + (float) timstart * invhz;
-/* printf("%f %f \n",timlim,*timl); */
- init = 0;
- }
- return;
-}
-
-void TIMEL(tl)
-/*
-C
- CERN PROGLIB# Z007 TIMEL .VERSION KERNCRY 1.15 910318
-C
-*/
-float *tl;
-{
- struct jtab jtab;
- time_t timnow, jtleft, ptleft;
- long plimit, iflag, limit();
- float timtst, timjob;
-
- if (init) {
- TIMEST(&deftim);
- }
- plimit = limit (C_PROC, 0, L_CPU, -1);
- if (plimit != -1) {
- timtst = (float) plimit * invhz;
- if (timtst < timlim) timlim = timtst;
- }
- times(&tms);
- timnow = tms.tms_utime+tms.tms_stime;
- timtst = timlim - (float) timnow * invhz;
- if (getjtab(&jtab) > 0) {
- jtleft = jtab.j_cpulimit - (jtab.j_ucputime + jtab.j_scputime);
- timjob = (float) jtleft * invhz;
- if (timjob < timtst ) timtst = timjob;
- }
- *tl = timtst;
- return;
-}
-/*> END <----------------------------------------------------------*/
-#ifdef CERNLIB_CCGEN_TIMEL
-#undef CERNLIB_CCGEN_TIMEL
-#endif
-#ifdef CERNLIB_TCGEN_TIMEL
-#undef CERNLIB_TCGEN_TIMEL
-#endif
-#ifdef CERNLIB_TCGEN_TIMEST
-#undef CERNLIB_TCGEN_TIMEST
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncry/cryuni/tmpro.c b/src/packlib/kernlib/kerngen/obsolete/kerncry/cryuni/tmpro.c
deleted file mode 100644
index 3a3a3b3..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncry/cryuni/tmpro.c
+++ /dev/null
@@ -1,34 +0,0 @@
-/*
- * $Id: tmpro.c,v 1.1.1.1 1996/02/15 17:52:44 mclareni Exp $
- *
- * $Log: tmpro.c,v $
- * Revision 1.1.1.1 1996/02/15 17:52:44 mclareni
- * Kernlib
- *
- */
-#include "kerncry/pilot.h"
-/*> ROUTINE TMPRO
- CERN PROGLIB# TMPRO .VERSION KERNCRY 1.16 911111
- ORIG. 20/10/91, JZ
- Fortran interface routine to print a prompt string
-*/
-#include <fortran.h>
-#include <stdio.h>
-void TMPRO(text)
- _fcd text;
-{
- char *buf;
- int blen;
-
- buf = _fcdtocp(text);
- blen = _fcdlen(text);
- write (1, buf, blen);
- return;
-}
-/*> END <----------------------------------------------------------*/
-#ifdef CERNLIB_CCGEN_TMPRO
-#undef CERNLIB_CCGEN_TMPRO
-#endif
-#ifdef CERNLIB_CCGEN_TMPROI
-#undef CERNLIB_CCGEN_TMPROI
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncry/cryuni/tmread.c b/src/packlib/kernlib/kerngen/obsolete/kerncry/cryuni/tmread.c
deleted file mode 100644
index 5665690..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncry/cryuni/tmread.c
+++ /dev/null
@@ -1,55 +0,0 @@
-/*
- * $Id: tmread.c,v 1.1.1.1 1996/02/15 17:52:45 mclareni Exp $
- *
- * $Log: tmread.c,v $
- * Revision 1.1.1.1 1996/02/15 17:52:45 mclareni
- * Kernlib
- *
- */
-#include "kerncry/pilot.h"
-/*> ROUTINE TMREAD
- CERN PROGLIB# TMREAD .VERSION KERNCRY 1.16 911111
- ORIG. 20/10/91, JZ
- read the next line from stdin :
- CALL TMREAD (MAXCH, LINE, NCH, ISTAT)
- MAXCH maxim. # of characters into LINE
- NCH actual # of characters read into LINE
- ISTAT status return, zero : OK -ve : EoF
-*/
-#include <fortran.h>
-#include <stdio.h>
-void TMREAD(alim, line, anch, astat)
- _fcd line;
- int *alim, *anch, *astat;
-{
- char *cols;
- int ch, jcol, lim;
-
-/*-- read the text */
- cols = _fcdtocp(line);
- lim = *alim;
- jcol = 0;
- while (lim-- > 0)
- { ch = getchar();
- if (ch == EOF) goto endf;
- if (ch == '\n') goto endl;
- *cols++ = ch;
- jcol++;
- }
-/* discard excess characters */
-loop: ch = getchar();
- if (ch == '\n') goto endl;
- if (ch != EOF) goto loop;
-
-endf: *astat = -1;
- clearerr(stdin);
- return;
-
-endl: *anch = jcol;
- *astat = 0;
- return;
-}
-/*> END <----------------------------------------------------------*/
-#ifdef CERNLIB_CCGEN_TMREAD
-#undef CERNLIB_CCGEN_TMREAD
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncry/cryuni/unlinkf.F b/src/packlib/kernlib/kerngen/obsolete/kerncry/cryuni/unlinkf.F
deleted file mode 100644
index 9849a56..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncry/cryuni/unlinkf.F
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: unlinkf.F,v 1.1.1.1 1996/02/15 17:52:45 mclareni Exp $
-*
-* $Log: unlinkf.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:45 mclareni
-* Kernlib
-*
-*
-#include "kerncry/pilot.h"
- INTEGER FUNCTION UNLINKF (NAME)
-C
-C CERN PROGLIB# Z265 UNLINKF .VERSION KERNCRY 1.16 911111
-C ORIG. 17/10/91, JZ
-C Fortran interface routine to unlink
-C
- CHARACTER NAME*(*)
- INTEGER UNLINK
-
- LGNAME = LNBLNK (NAME)
- UNLINKF = UNLINK (NAME(1:LGNAME))
- RETURN
- END
-#ifdef CERNLIB_CCGEN_UNLINKF
-#undef CERNLIB_CCGEN_UNLINKF
-#endif
-#ifdef CERNLIB_CCGEN_UNLINI
-#undef CERNLIB_CCGEN_UNLINI
-#endif
-#ifdef CERNLIB_TCGEN_UNLINKF
-#undef CERNLIB_TCGEN_UNLINKF
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncry/cryuni/xinbf.F b/src/packlib/kernlib/kerngen/obsolete/kerncry/cryuni/xinbf.F
deleted file mode 100644
index cf932ec..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncry/cryuni/xinbf.F
+++ /dev/null
@@ -1,44 +0,0 @@
-*
-* $Id: xinbf.F,v 1.1.1.1 1996/02/15 17:52:45 mclareni Exp $
-*
-* $Log: xinbf.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:45 mclareni
-* Kernlib
-*
-*
-#include "kerncry/pilot.h"
- SUBROUTINE XINBF (LUN,XBV,NXB)
-C
-C CERN PROGLIB# Z203 XINBF .VERSION KERNCRY 1.09 881102
-C ORIG. 02/11/88 Judy Richards
-C
- DIMENSION XBV(NXB)
-
-C : READ (LUN,END=61,ERR=64) XBV
- 11 NXU = NXB
- CALL READ (LUN,XBV,NXU,ISTAT,IUBC)
- IF (ISTAT .GE. 4) GO TO 64
- IF (ISTAT .GE. 2) GO TO 61
- IF (ISTAT .EQ. 1) GO TO 11
- NXB = NXU
- RETURN
-
- 61 NXB = 0
- RETURN
-
- 64 NXB = -ISTAT
- CALL SKIPBAD (LUN,NBLOCK,ISTAT)
- PRINT 9064, LUN,NBLOCK,ISTAT
- IF (ISTAT.GT.0) GO TO 61
- RETURN
-
- 9064 FORMAT (' !!!!! Read error in XINBF for LUN=',I3,
- F', SKIPBAD discards'/1X,I15,
- F' bad blocks and returns status=',Z17,' hex.')
- END
-#ifdef CERNLIB_TCGEN_XINBF
-#undef CERNLIB_TCGEN_XINBF
-#endif
-#ifdef CERNLIB_XVECT_XINBF
-#undef CERNLIB_XVECT_XINBF
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncry/history/history.dat b/src/packlib/kernlib/kerngen/obsolete/kerncry/history/history.dat
deleted file mode 100644
index 31d62b0..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncry/history/history.dat
+++ /dev/null
@@ -1,35 +0,0 @@
-*
-* $Id: history.dat,v 1.1.1.1 1996/02/15 17:52:31 mclareni Exp $
-*
-* $Log: history.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:52:31 mclareni
-* Kernlib
-*
-*
-* This directory was created from kerncry.car patch kerncry
-#if !defined(CERNLIB_KERNCRY)
-
- KERNLIB routines particular to the Cray
-
----------------------------------------------------------------------
-
- This file contains the following patches :
-
-*KCRAY Pilot-patch selecting KERNLIB for system COS
-*KCRU Pilot-patch selecting KERNLIB for system UNICOS
-
-QMCRY Machine patch for system COS or UNICOS
-QMCRU Machine patch for system UNICOS only
-
-CRYGS ML and Fortran versions of general KERNLIB routines
-
-CRYCOS special routines for system COS
-
-CRYUNI special routines for system UNICOS
-
-Options: USADATE : system routine DATE delivers the date
- in US format : mm/dd/yy
- else: dd/mm/yy
-
-=====================================================================
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncry/history/previous.dat b/src/packlib/kernlib/kerngen/obsolete/kerncry/history/previous.dat
deleted file mode 100644
index f2308c5..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncry/history/previous.dat
+++ /dev/null
@@ -1,233 +0,0 @@
-*
-* $Id: previous.dat,v 1.1.1.1 1996/02/15 17:52:31 mclareni Exp $
-*
-* $Log: previous.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:52:31 mclareni
-* Kernlib
-*
-*
-#if !defined(CERNLIB_KERNSUN)
-
-UP-DATE 1.18 : 21-Nov-1992
-----------------------------
-
-Replacing file KERNCRY 1.17 920229 19.41
-
-Correct: add definition +KEEP, Q$SBYT
- delete Fortran default of UNLINKF on KERNFOR
-
----------------------------------------------------------------------
-
-UP-DATE 1.17 : 29-Feb-1992
-----------------------------
-
-Replacing file KERNCRY 1.16 911111 23.57
-
-Correct: P=CRYUNI, D=GETENVF
- delete definition +KEEP, Q$ANDOR.
-
----------------------------------------------------------------------
-
-UP-DATE 1.16 : 11-Nov-1991
-----------------------------
-
-Replacing file KERNCRY 1.15 910719 13.01
-
-New Decks: P=CRYGS, D=IUWEED
- P=CRYUNI,D=CHDIRF,GETENVF,SIGON,STATF,UNLINKF,TMPRO,TMREAD
-
-Correct: P=CRYGS, D=JBIT,JBYT,SBIT,SBIT0,SBIT1,SBYT
- avoiding assembler
-Correct: P=CRYUNI,D=SIGNALF,INTRAC new versions
-
-Deleted: P=CRAYC, moving its routines into P=CRYUNI
-
----------------------------------------------------------------------
-
-UP-DATE 1.15 : 18-Jul-1991
-----------------------------
-
-Replacing file KERNCRY 1.14 910318 19.13
-
-New Deck: SYSTEMF of P=CRYUNI new routine
-
-Correct : P=CRAYC, D=TIMEL
-
-Delete : GSHOW
-
----------------------------------------------------------------------
-
-UP-DATE 1.14 : 18-Mar-1991
-----------------------------
-
-Replacing file KERNCRY 1.13 891120 23.09
-
-New Deck: SIGNALF of P=CRYUNI new routine
-
-Correct : connect CCGEN and CCGENCF of KERNFOR
- re-organize P=CRAYC for FCASPLIT
-
----------------------------------------------------------------------
-
-UP-DATE 1.13 : 20-Nov-1989
-----------------------------
-
-Replacing file KERNCRY 1.12 890913 21.10
-
-Correct : JUMPX2 add delete default in KERNFOR
-
-Delete : ABEND, P=CRYUNI use default on KERNFOR
-
----------------------------------------------------------------------
-
-UP-DATE 1.12 : 13-Sept-1989
-----------------------------
-
-Replacing file KERNCRY 1.11 890628 11.53
-
-Correct : DATIME to return seconds in /SLATE/
- JUMPX2 add entries JUMPX1 and JUMPX0
-
----------------------------------------------------------------------
-
-UP-DATE 1.11 : 27-June-1989
-----------------------------
-
-Replacing file KERNCRY 1.10 890322 15.04
-
-New Decks: VMATL, VMATR for speed
- MEMOR of P=CRAYC
-
-Correct : TIMEL of P=CRAYC
-
-Deleted : IARGC of P=CRAYC now in the Cray library
-
----------------------------------------------------------------------
-
-UP-DATE 1.10 : 22-mar-1989
-----------------------------
-
-Replacing file KERNCRY 1.09 881121 19.10
-
-New Deck: JOBNAM of P=CRYUNI new routine
- KERNGT to eventually replace GSHOW
-
-Correct : TIMEL of P=CRAYC new version for UNICOS
- IE3FOD set left half to zero
-
----------------------------------------------------------------------
-
-UP-DATE 1.09 : 2-nov-1988
-----------------------------
-
-Replacing file KERNCRY 1.08 880913 18.30
-
-New Deck: NOARG of P=CRYUNI new routine
- XINBF of P=CRYUNI new routine
- NOARG of P=CRYCOS new routine
-
-Delete : D=NOARG, P=CRYGS delete dummy
-
----------------------------------------------------------------------
-
-UP-DATE 1.08 : 28-JUL-1988
-----------------------------
-
-Replacing file KERNCRY 1.07 880525 16.40
-
-New Patch: P=CRAYC C routines for system UNICOS
-
-Correct : XINB,XINBS,XINBF move the old routines into P=CRYCOS
-
----------------------------------------------------------------------
-
-UP-DATE 1.07 : 28-APR-1988
-----------------------------
-
-Replacing file KERNCRY 1.06 870527 15.51
-
-New Patches: P=*KCRU pilot for Cray system UNICOS
-
- P=CRYCOS with system COS specific routines
- old D=ABEND,DETACH,INCMEM,TIMEL to here
-
- P=CRYUNI with system UNICOS specific routines
- new D=ABEND,INTRAC,TIMEL
-
-New decks : D=JUMPAD, JUMPX2
-
-Modified : move routines XIN... from P=XVECTCRY into P=CRYGS
- delete P=XVECTCRY
-
----------------------------------------------------------------------
-
-UP-DATE 1.06 : 27-MAY-1987
-----------------------------
-
-Replacing file KERNCRY 1.05 861204 21.05
-
-New Decks : P=CRYGS, D=IANDETC, JBYTET, JBYTOR
- D=MBYTET, MBYTOR, MCBYT
- D=MSBIT0, MSBIT1, MSBIT, MSBYT
- D=BTEST, IBITS, IBCLR, IBSET, MVBITS
- D=ISHFT, ISHFTC
- D=UCTOH, UCTOH1, UHTOC, UH1TOC
- D=NOARG do-nothing dummy
-
-Modified : P=CRYGS, D=UBLOW, UBUNCH entries UCTOH1,UH1TOC removed
-
----------------------------------------------------------------------
-
-UP-DATE 1.05 : 4-DEC-1986
-----------------------------
-
-Replacing file KERNCRY 1.04 840815 21.01
-
-New Decks : P=CRYGS, D=IE3FOD,IE3FOS,IE3TOD,IE3TOS
-
-Correct : P=CRYGS, D=RNDM to call RANGET as subroutine
-
----------------------------------------------------------------------
-
-UP-DATE 1.04 : 16-AUG-1984
-----------------------------
-
-Replacing file KERNCRY 1.03 840216 11.42
-
-New : P=CRYGS, D=QNEXTE FROM HYDRA FOR 'NEXT EVENT'
-
----------------------------------------------------------------------
-
-UP-DATE 1.03 : 15-FEB-1984
-----------------------------
-
-Replacing file KERNCRY 1.02 830728 17.29
-
-New : P=CRYGS, D=INCMEM2 FOR NEW MEMORY REQUEST
- D=RNDM, TIMED, TIMEL, TIMEX
-
----------------------------------------------------------------------
-
-UP-DATE 1.02 : 28-JUL-1983
-----------------------------
-
-Replacing file KERNCRY 1.01 830712 12.35
-
-Modified : CORRECT REPRESENTATION OF THE VERTICAL BAR
-
----------------------------------------------------------------------
-
-UP-DATE 1.01 : 12-JUL-1983
-----------------------------
-
-Replacing file KERNCRY 1.00 830612 11.00
-
-Modified : P=CRYGS, D=ABEND
-
----------------------------------------------------------------------
-
- FIRST RELEASE OF THE KERNCRY PAM : 12-JUNE-83
-
----------------------------------------------------------------------
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncry/history/update.dat b/src/packlib/kernlib/kerngen/obsolete/kerncry/history/update.dat
deleted file mode 100644
index 5c6650d..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncry/history/update.dat
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: update.dat,v 1.1.1.1 1996/02/15 17:52:31 mclareni Exp $
-*
-* $Log: update.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:52:31 mclareni
-* Kernlib
-*
-*
-#if !defined(CERNLIB_KERNSUN)
-
-
- UP-DATE RECORD FOR THE PAM-FILE KERNCRY
- ----------------------------------------
-
-
-UP-DATE 1.19 : 11-May-1994
-----------------------------
-
-Replacing file KERNCRY 1.18 921020 17.29
-
-Selection on P=P5BOOT for the Patchy boot-strap export
-
-Delete: p=CRYGS,d=JUMPAD,JUMPX2 use KERNFOR
-
----------------------------------------------------------------------
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncry/inhibit.list b/src/packlib/kernlib/kerngen/obsolete/kerncry/inhibit.list
deleted file mode 100644
index 1438ece..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncry/inhibit.list
+++ /dev/null
@@ -1,94 +0,0 @@
-tcgen/kerngt
-tcgen/btest
-ccgen/datime
-tcgen/datime
-ccgen/datimh
-tcgen/datimh
-tcgen/ibits
-tcgen/ibclr
-tcgen/ibset
-tcgen/ie3fod
-tcgen/ie3fos
-tcgen/ie3tod
-tcgen/ie3tos
-tcgen/ishft
-tcgen/ishftc
-tcgen/iuforw
-tcgen/iuweed
-tcgen/jbit
-tcgen/jbyt
-tcgen/jbytet
-tcgen/jbytor
-ccgen/locf
-tcgen/locf
-tcgen/mbytet
-tcgen/mbytor
-tcgen/mcbyt
-tcgen/msbit
-tcgen/msbit0
-tcgen/msbit1
-tcgen/msbyt
-tcgen/mvbits
-ccgen/qnexte
-tcgen/qnexte
-tcgen/rndm
-tcgen/sbit
-tcgen/sbit0
-tcgen/sbit1
-tcgen/sbyt
-ccgen/timed
-tcgen/timed
-ccgen/timex
-tcgen/timex
-tcgen/traceq
-tcgen/ublow
-tcgen/ubunch
-tcgen/uctoh
-tcgen/uctoh1
-tcgen/uhtoc
-tcgen/uh1toc
-tcgen/vmatl
-tcgen/vmatr
-tcgen/abend
-tcgen/jobnam
-tcgen/noarg
-tcgen/timel
-tcgen/xinb
-xvect/xinb
-tcgen/xinbf
-xvect/xinbf
-tcgen/xinbs
-xvect/xinbs
-ccgen/chdirf
-ccgen/chdiri
-ccgen/getenvf
-ccgen/geteni
-ccgen/intrac
-tcgen/intrac
-tcgen/jobnam
-tcgen/noarg
-ccgen/signalf
-ccgen/statf
-ccgen/stati
-ccgen/systemf
-ccgen/systei
-ccgen/timel
-tcgen/timel
-tcgen/timest
-ccgen/tmpro
-ccgen/tmproi
-ccgen/tmread
-ccgen/unlinkf
-ccgen/unlini
-tcgen/unlinkf
-tcgen/xinbf
-xvect/xinbf
-cryuni/iargc
-tcgen/jbit
-tcgen/jbyt
-tcgen/sbit
-tcgen/sbit0
-tcgen/sbit1
-tcgen/sbyt
-ccgen/jumpxn
-tcgen/jumpxn
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncry/kerncry/iallbl.inc b/src/packlib/kernlib/kerngen/obsolete/kerncry/kerncry/iallbl.inc
deleted file mode 100644
index 564e7fc..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncry/kerncry/iallbl.inc
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: iallbl.inc,v 1.1.1.1 1996/02/15 17:52:32 mclareni Exp $
-*
-* $Log: iallbl.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:52:32 mclareni
-* Kernlib
-*
-*
-#ifndef CERNLIB_KERNCRY_IALLBL_INC
-#define CERNLIB_KERNCRY_IALLBL_INC
-*
-* set a word of all blanks
-*
-* iallbl.inc
-*
-#if defined(CERNLIB_P5BOOT)
- PARAMETER (IALLBL = X'2020202020202020')
-#endif
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncry/kerncry/q_cbyt.inc b/src/packlib/kernlib/kerngen/obsolete/kerncry/kerncry/q_cbyt.inc
deleted file mode 100644
index b609beb..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncry/kerncry/q_cbyt.inc
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: q_cbyt.inc,v 1.1.1.1 1996/02/15 17:52:32 mclareni Exp $
-*
-* $Log: q_cbyt.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:52:32 mclareni
-* Kernlib
-*
-*
-#ifndef CERNLIB_KERNCRY_Q_CBYT_INC
-#define CERNLIB_KERNCRY_Q_CBYT_INC
-*
-*
-* q_cbyt.inc
-*
-#if defined(CERNLIB_P5BOOT)
- MCBYT (MZ,IZQ,IZW,IZP,NZB)=(IZW.AND.SHIFT(MASK(64-NZB),IZP-1))
- + .OR. SHIFT(SHIFTR(MZ,IZQ-1).AND.MASK(128-NZB),IZP-1)
-#endif
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncry/kerncry/q_jbit.inc b/src/packlib/kernlib/kerngen/obsolete/kerncry/kerncry/q_jbit.inc
deleted file mode 100644
index 761bd4e..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncry/kerncry/q_jbit.inc
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: q_jbit.inc,v 1.1.1.1 1996/02/15 17:52:32 mclareni Exp $
-*
-* $Log: q_jbit.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:52:32 mclareni
-* Kernlib
-*
-*
-#ifndef CERNLIB_KERNCRY_Q_JBIT_INC
-#define CERNLIB_KERNCRY_Q_JBIT_INC
-*
-*
-* q_jbit.inc
-*
-#if defined(CERNLIB_P5BOOT)
- JBIT (IZW,IZP) = SHIFTR(IZW,IZP-1) .AND. MASK(127)
- JBYT (IZW,IZP,NZB) = SHIFTR(IZW,IZP-1) .AND. MASK(128-NZB)
-#endif
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncry/kerncry/q_jbytet.inc b/src/packlib/kernlib/kerngen/obsolete/kerncry/kerncry/q_jbytet.inc
deleted file mode 100644
index dbd3892..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncry/kerncry/q_jbytet.inc
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: q_jbytet.inc,v 1.1.1.1 1996/02/15 17:52:34 mclareni Exp $
-*
-* $Log: q_jbytet.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:52:34 mclareni
-* Kernlib
-*
-*
-#ifndef CERNLIB_KERNCRY_Q_JBYTET_INC
-#define CERNLIB_KERNCRY_Q_JBYTET_INC
-*
-*
-* q_jbytet.inc
-*
-#if defined(CERNLIB_P5BOOT)
- JBYTET (MZ,IZW,IZP,NZB) = MZ .AND. SHIFTR(IZW,IZP-1)
- + .AND. MASK(128-NZB)
- JBYTOR (MZ,IZW,IZP,NZB) = MZ .OR. (SHIFTR(IZW,IZP-1)
- + .AND. MASK(128-NZB) )
- MBYTET (MZ,IZW,IZP,NZB) = IZW .AND.
- + SHIFT (MZ.OR. MASK(64-NZB), IZP-1)
- MBYTOR (MZ,IZW,IZP,NZB) = IZW .OR.
- + SHIFT (MZ.AND.MASK(128-NZB),IZP-1)
-#endif
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncry/kerncry/q_sbit.inc b/src/packlib/kernlib/kerngen/obsolete/kerncry/kerncry/q_sbit.inc
deleted file mode 100644
index 6555824..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncry/kerncry/q_sbit.inc
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: q_sbit.inc,v 1.1.1.1 1996/02/15 17:52:32 mclareni Exp $
-*
-* $Log: q_sbit.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:52:32 mclareni
-* Kernlib
-*
-*
-#ifndef CERNLIB_KERNCRY_Q_SBIT_INC
-#define CERNLIB_KERNCRY_Q_SBIT_INC
-*
-*
-* q_sbit.inc
-*
-#if defined(CERNLIB_P5BOOT)
- MSBIT0 (IZW,IZP) = IZW .AND. SHIFT(MASK(65),IZP)
- MSBIT1 (IZW,IZP) = IZW .OR. SHIFT(MASK(1), IZP)
- MSBIT (MZ,IZW,IZP) = (IZW .AND. SHIFT(MASK(65),IZP))
- + .OR. SHIFT(MZ.AND.MASK(127),IZP-1)
-#endif
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncry/kerncry/q_sbyt.inc b/src/packlib/kernlib/kerngen/obsolete/kerncry/kerncry/q_sbyt.inc
deleted file mode 100644
index 4f723cf..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncry/kerncry/q_sbyt.inc
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: q_sbyt.inc,v 1.1.1.1 1996/02/15 17:52:32 mclareni Exp $
-*
-* $Log: q_sbyt.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:52:32 mclareni
-* Kernlib
-*
-*
-#ifndef CERNLIB_KERNCRY_Q_SBYT_INC
-#define CERNLIB_KERNCRY_Q_SBYT_INC
-*
-*
-* q_sbyt.inc
-*
-#if defined(CERNLIB_P5BOOT)
- MSBYT (MZ,IZW,IZP,NZB) = (IZW .AND. SHIFT(MASK(64-NZB),IZP-1))
- + .OR. SHIFT(MZ.AND.MASK(128-NZB),IZP-1)
-#endif
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncry/kerncry/q_shift.inc b/src/packlib/kernlib/kerngen/obsolete/kerncry/kerncry/q_shift.inc
deleted file mode 100644
index c0d7d23..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncry/kerncry/q_shift.inc
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: q_shift.inc,v 1.1.1.1 1996/02/15 17:52:32 mclareni Exp $
-*
-* $Log: q_shift.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:52:32 mclareni
-* Kernlib
-*
-*
-#ifndef CERNLIB_KERNCRY_Q_SHIFT_INC
-#define CERNLIB_KERNCRY_Q_SHIFT_INC
-*
-*
-* q_shift.inc
-*
-#if defined(CERNLIB_P5BOOT)
- ISHFTL (IZW,NZB) = SHIFTL (IZW, NZB)
- ISHFTR (IZW,NZB) = SHIFTR (IZW, NZB)
-#endif
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncry/kerncry/qmcry.h b/src/packlib/kernlib/kerngen/obsolete/kerncry/kerncry/qmcry.h
deleted file mode 100644
index ee5b439..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncry/kerncry/qmcry.h
+++ /dev/null
@@ -1,61 +0,0 @@
-*
-* $Id: qmcry.h,v 1.1.1.1 1996/02/15 17:52:34 mclareni Exp $
-*
-* $Log: qmcry.h,v $
-* Revision 1.1.1.1 1996/02/15 17:52:34 mclareni
-* Kernlib
-*
-*
-* This directory was created from kerncry.car patch qmcry
-#ifndef CERNLIB_F77
-#define CERNLIB_F77
-#endif
-#ifndef CERNLIB_B64
-#define CERNLIB_B64
-#endif
-#ifndef CERNLIB_B60M
-#define CERNLIB_B60M
-#endif
-#ifndef CERNLIB_B48M
-#define CERNLIB_B48M
-#endif
-#ifndef CERNLIB_B36M
-#define CERNLIB_B36M
-#endif
-#ifndef CERNLIB_A8
-#define CERNLIB_A8
-#endif
-#ifndef CERNLIB_A6M
-#define CERNLIB_A6M
-#endif
-#ifndef CERNLIB_A5M
-#define CERNLIB_A5M
-#endif
-* system delivers Date in US format
-#ifndef CERNLIB_USADATE
-#define CERNLIB_USADATE
-#endif
-* System 5 has not getwd
-#ifndef CERNLIB_QGETCWD
-#define CERNLIB_QGETCWD
-#endif
-* external names capital
-#ifndef CERNLIB_QXCAPT
-#define CERNLIB_QXCAPT
-#endif
-* Character set is ASCII
-#ifndef CERNLIB_QASCII
-#define CERNLIB_QASCII
-#endif
-* Hollerith constants exist
-#ifndef CERNLIB_QHOLL
-#define CERNLIB_QHOLL
-#endif
-* EQUIVALENCE Hollerith/Character ok
-#ifndef CERNLIB_EQUHOLCH
-#define CERNLIB_EQUHOLCH
-#endif
-* Orthodox Hollerith storage left to right
-#ifndef CERNLIB_QORTHOLL
-#define CERNLIB_QORTHOLL
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncry/kerncry/wordsizc.inc b/src/packlib/kernlib/kerngen/obsolete/kerncry/kerncry/wordsizc.inc
deleted file mode 100644
index a4d31df..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncry/kerncry/wordsizc.inc
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: wordsizc.inc,v 1.1.1.1 1996/02/15 17:52:31 mclareni Exp $
-*
-* $Log: wordsizc.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:52:31 mclareni
-* Kernlib
-*
-*
-#ifndef CERNLIB_KERNCRY_WORDSIZC_INC
-#define CERNLIB_KERNCRY_WORDSIZC_INC
-*
-*
-* wordsizc.inc
-*
-#if defined(CERNLIB_P5BOOT)
-#define NBITPW 64 /* Number of bits per word */
-#define NBYTPW 8 /* Number of bytes per word */
-#endif
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncry/kerncry/wordsize.inc b/src/packlib/kernlib/kerngen/obsolete/kerncry/kerncry/wordsize.inc
deleted file mode 100644
index c53c9e6..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncry/kerncry/wordsize.inc
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: wordsize.inc,v 1.1.1.1 1996/02/15 17:52:31 mclareni Exp $
-*
-* $Log: wordsize.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:52:31 mclareni
-* Kernlib
-*
-*
-#ifndef CERNLIB_KERNCRY_WORDSIZE_INC
-#define CERNLIB_KERNCRY_WORDSIZE_INC
-*
-*
-* wordsize.inc
-*
-#if defined(CERNLIB_P5BOOT)
- PARAMETER (NBITPW=64, NCHAPW=8, NBITPC=8)
-#endif
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncry/obsolete/iargc.c b/src/packlib/kernlib/kerngen/obsolete/kerncry/obsolete/iargc.c
deleted file mode 100644
index 769f906..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncry/obsolete/iargc.c
+++ /dev/null
@@ -1,19 +0,0 @@
-/*
- * $Id: iargc.c,v 1.1.1.1 1996/02/15 17:52:45 mclareni Exp $
- *
- * $Log: iargc.c,v $
- * Revision 1.1.1.1 1996/02/15 17:52:45 mclareni
- * Kernlib
- *
- */
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
-extern int _argc;
-IARGC()
-{
- int i = _argc-1;
- return(i);
-}
-#ifdef CERNLIB_CRYUNI_IARGC
-#undef CERNLIB_CRYUNI_IARGC
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncry/obsolete/jbit.s b/src/packlib/kernlib/kerngen/obsolete/kerncry/obsolete/jbit.s
deleted file mode 100644
index 24d3d9e..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncry/obsolete/jbit.s
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: jbit.s,v 1.1.1.1 1996/02/15 17:52:45 mclareni Exp $
-*
-* $Log: jbit.s,v $
-* Revision 1.1.1.1 1996/02/15 17:52:45 mclareni
-* Kernlib
-*
-*
- IDENT JBIT
-*
-* CERN PROGLIB# M421 JBIT .VERSION KERNCRY 1.00 830612
-* ORIG. 12/06/83 H.LIPPS, CERN
-*
-JBIT ENTER NP=2 (A,LA)
- ARGADD A6,1 A6=(A)
- ARGADD A7,2 A7=(LA)
- S6 ,A6 S6=A
- A7 ,A7 A7=LA
- S7 1 S7=1
- A7 A7-1 A7=LA-1
- S6 S6>A7 S6=A*S**(1-LA)
- S1 S6&S7 S1=MOD(S6,2)=JBIT
- EXIT
- END
-#ifdef CERNLIB_TCGEN_JBIT
-#undef CERNLIB_TCGEN_JBIT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncry/obsolete/jbyt.s b/src/packlib/kernlib/kerngen/obsolete/kerncry/obsolete/jbyt.s
deleted file mode 100644
index f9953f4..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncry/obsolete/jbyt.s
+++ /dev/null
@@ -1,30 +0,0 @@
-*
-* $Id: jbyt.s,v 1.1.1.1 1996/02/15 17:52:45 mclareni Exp $
-*
-* $Log: jbyt.s,v $
-* Revision 1.1.1.1 1996/02/15 17:52:45 mclareni
-* Kernlib
-*
-*
- IDENT JBYT
-*
-* CERN PROGLIB# M421 JBYT .VERSION KERNCRY 1.00 830612
-* ORIG. 12/06/83 H.LIPPS, CERN
-*
-JBYT ENTER NP=3 (A,LA,NBITS)
- ARGADD A5,1 A5=(A)
- ARGADD A6,2 A6=(LA)
- ARGADD A7,3 A7=(NBITS)
- S5 ,A5 S5=A
- A6 ,A6 A6=LA
- A7 ,A7 A7=NBITS
- A6 A6-1 A6=LA-1
- S5 S5>A6 S5=A*2**(1-LA)
- S7 -1 S7=FFFF FFFF FFFF FFFF
- S7 S7<A7 S7=FFFF FFFF FFFF FF00
- S1 #S7&S5 S1=MOD(S5,2**NBITS)
- EXIT
- END
-#ifdef CERNLIB_TCGEN_JBYT
-#undef CERNLIB_TCGEN_JBYT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncry/obsolete/jumpad.F b/src/packlib/kernlib/kerngen/obsolete/kerncry/obsolete/jumpad.F
deleted file mode 100644
index 2c0142b..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncry/obsolete/jumpad.F
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: jumpad.F,v 1.1.1.1 1996/02/15 17:52:46 mclareni Exp $
-*
-* $Log: jumpad.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:46 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- FUNCTION JUMPAD (ITARGT)
-C
-C CERN PROGLIB# Z042 JUMPAD .VERSION KERNCRY 1.07 880428
-C ORIG. 26/04/88 JZ
-C
-C- Get target address for use with JUMPXn
-
- JUMPAD = LOC (ITARGT)
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncry/obsolete/jumpx2.F b/src/packlib/kernlib/kerngen/obsolete/kerncry/obsolete/jumpx2.F
deleted file mode 100644
index 3467999..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncry/obsolete/jumpx2.F
+++ /dev/null
@@ -1,67 +0,0 @@
-*
-* $Id: jumpx2.F,v 1.1.1.1 1996/02/15 17:52:46 mclareni Exp $
-*
-* $Log: jumpx2.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:46 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE JUMPX2 (IPARA,IPARB)
-C
-C CERN PROGLIB# Z042 JUMPX2 .VERSION KERNCRY 1.12 890913
-C ORIG. 26/04/88 JZ
-C MOD. 12/09/89 JZ, add entries JUMPX1, JUMPX0
-C
-C- To transfer to the user routine TARGET (say) with 2 parameters
-C- three steps are needed :
-
-C- 1) EXTERNAL TARGET to get the address of TARGET
-C- IADR = JUMPAD (TARGET)
-
-C- 2) CALL JUMPST (IADR) to set the tranfer address
-
-C- 3) CALL JUMPX2 (par1,par2) to transfer
-
- DIMENSION IPARA(9), IPARB(9)
- POINTER (JPOINT, TARGET)
- SAVE JPOINT
-
- CALL JUMPY2 (TARGET,IPARA,IPARB)
- RETURN
-
- ENTRY JUMPX1 (IPARA)
- CALL JUMPY1 (TARGET,IPARA)
- RETURN
-
- ENTRY JUMPX0
- CALL JUMPY0 (TARGET)
- RETURN
-
- ENTRY JUMPST (JADR)
- JPOINT = JADR
- RETURN
- END
-C-----------------------------------------------------
- SUBROUTINE JUMPY2 (TARSUB,IPARA,IPARB)
- DIMENSION IPARA(9), IPARB(9)
- EXTERNAL TARSUB
-
- CALL TARSUB (IPARA,IPARB)
- RETURN
-
- ENTRY JUMPY1 (TARSUB,IPARA)
- CALL TARSUB (IPARA)
- RETURN
-
- ENTRY JUMPY0 (TARSUB)
- CALL TARSUB
- RETURN
- END
-#ifdef CERNLIB_CCGEN_JUMPXN
-#undef CERNLIB_CCGEN_JUMPXN
-#endif
-#ifdef CERNLIB_TCGEN_JUMPXN
-#undef CERNLIB_TCGEN_JUMPXN
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncry/obsolete/sbit.s b/src/packlib/kernlib/kerngen/obsolete/kerncry/obsolete/sbit.s
deleted file mode 100644
index e2df938..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncry/obsolete/sbit.s
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: sbit.s,v 1.1.1.1 1996/02/15 17:52:45 mclareni Exp $
-*
-* $Log: sbit.s,v $
-* Revision 1.1.1.1 1996/02/15 17:52:45 mclareni
-* Kernlib
-*
-*
- IDENT SBIT
-*
-* CERN PROGLIB# M421 SBIT .VERSION KERNCRY 1.00 830612
-* ORIG. 12/06/83 H.LIPPS, CERN
-*
-SBIT ENTER NP=3 (A,X,LX)
- ARGADD A5,1 A5=(A)
- ARGADD A6,2 A6=(X)
- ARGADD A7,3 A7=(LX)
- S7 1 S7=1
- S5 ,A5 S5=A
- S6 ,A6 S6=X
- A7 ,A7 A7=LX
- S1 S5&S7 S1=MOD(A,2)
- A7 A7-1 A7=LX-1
- S7 S7<A7 S7=1*2**(LX-1)
- S1 S1<A7 S1=MOD(A,2)*2**(LX-1)
- S6 S1!S6&S7 COPY BIT S7 OF S1 INTO S6
- ,A6 S6 X=S6
- EXIT
- END
-#ifdef CERNLIB_TCGEN_SBIT
-#undef CERNLIB_TCGEN_SBIT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncry/obsolete/sbit0.s b/src/packlib/kernlib/kerngen/obsolete/kerncry/obsolete/sbit0.s
deleted file mode 100644
index f4ef74d..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncry/obsolete/sbit0.s
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: sbit0.s,v 1.1.1.1 1996/02/15 17:52:46 mclareni Exp $
-*
-* $Log: sbit0.s,v $
-* Revision 1.1.1.1 1996/02/15 17:52:46 mclareni
-* Kernlib
-*
-*
- IDENT SBIT0
-*
-* CERN PROGLIB# M421 SBIT0 .VERSION KERNCRY 1.00 830612
-* ORIG. 12/06/83 H.LIPPS, CERN
-*
-SBIT0 ENTER NP=2 (X,LX)
- ARGADD A6,1 A6=(X)
- ARGADD A7,2 A7=(LX)
- S6 ,A6 S6=X
- A7 ,A7 A7=LX
- S7 1 S7=1
- A7 A7-1 A7=LX-1
- S7 S7<A7 S7=1*2**(LX-1)
- S1 #S7&S6 CLEAR BIT LX IN S6
- ,A6 S1 X=S1
- EXIT
- END
-#ifdef CERNLIB_TCGEN_SBIT0
-#undef CERNLIB_TCGEN_SBIT0
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncry/obsolete/sbit1.s b/src/packlib/kernlib/kerngen/obsolete/kerncry/obsolete/sbit1.s
deleted file mode 100644
index 798cc59..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncry/obsolete/sbit1.s
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: sbit1.s,v 1.1.1.1 1996/02/15 17:52:46 mclareni Exp $
-*
-* $Log: sbit1.s,v $
-* Revision 1.1.1.1 1996/02/15 17:52:46 mclareni
-* Kernlib
-*
-*
- IDENT SBIT1
-*
-* CERN PROGLIB# M421 SBIT1 .VERSION KERNCRY 1.00 830612
-* ORIG. 12/06/83 H.LIPPS, CERN
-*
-SBIT1 ENTER NP=2 (X,LX)
- ARGADD A6,1 A6=(X)
- ARGADD A7,2 A7=(LX)
- S6 ,A6 S6=X
- A7 ,A7 A7=LX
- S7 1 S7=1
- A7 A7-1 A7=LX-1
- S7 S7<A7 S7=1*2**(LX-1)
- S1 S7!S6 SET BIT LX IN S6
- ,A6 S1 X=S1
- EXIT
- END
-#ifdef CERNLIB_TCGEN_SBIT1
-#undef CERNLIB_TCGEN_SBIT1
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncry/obsolete/sbyt.s b/src/packlib/kernlib/kerngen/obsolete/kerncry/obsolete/sbyt.s
deleted file mode 100644
index c2e5026..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncry/obsolete/sbyt.s
+++ /dev/null
@@ -1,35 +0,0 @@
-*
-* $Id: sbyt.s,v 1.1.1.1 1996/02/15 17:52:46 mclareni Exp $
-*
-* $Log: sbyt.s,v $
-* Revision 1.1.1.1 1996/02/15 17:52:46 mclareni
-* Kernlib
-*
-*
- IDENT SBYT
-*
-* CERN PROGLIB# M421 SBYT .VERSION KERNCRY 1.00 830612
-* ORIG. 12/06/83 H.LIPPS, CERN
-*
-SBYT ENTER NP=4 (A,X,LX,NBITS)
- ARGADD A4,1 A4=(A)
- ARGADD A5,2 A5=(X)
- ARGADD A6,3 A6=(LX)
- ARGADD A7,4 A7=(NBITS)
- S3 -1 S3=FFFF FFFF FFFF FFFF
- S4 ,A4 S4=AAAA AAAA AAAA AAAA
- S5 ,A5 S5=XXXX XXXX XXXX XXXX
- A6 ,A6 A6=LX
- A7 ,A7 A7=NBITS
- S3 S3<A7 S3=FFFF FFFF FFFF FF00
- A6 A6-1 A6=LX-1
- S3 #S3 S3=0000 0000 0000 00FF
- S4 S4<A6 S4=AAAA AAAA AAAA 0000
- S3 S3<A6 S3=0000 0000 00FF 0000
- S5 S4!S5&S3 S5=XXXX XXXX XXAA XXXX
- ,A5 S5
- EXIT
- END
-#ifdef CERNLIB_TCGEN_SBYT
-#undef CERNLIB_TCGEN_SBYT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncvx/_kcvx/pilot.h b/src/packlib/kernlib/kerngen/obsolete/kerncvx/_kcvx/pilot.h
deleted file mode 100644
index a83ef40..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncvx/_kcvx/pilot.h
+++ /dev/null
@@ -1,33 +0,0 @@
-#if 0
-* This pilot patch was created from kerncvx.car patch _kcvx
-#endif
-#if 0
-* 64-bit, native floating point mode
-#endif
-#ifndef CERNLIB_QMCVX
-#define CERNLIB_QMCVX
-#endif
-#ifndef CERNLIB_QMCV64
-#define CERNLIB_QMCV64
-#endif
-#ifndef CERNLIB_CV64GS
-#define CERNLIB_CV64GS
-#endif
-#ifndef CERNLIB_CVXGS
-#define CERNLIB_CVXGS
-#endif
-#ifndef CERNLIB_XVECT
-#define CERNLIB_XVECT
-#endif
-#ifndef CERNLIB_TCGEN
-#define CERNLIB_TCGEN
-#endif
-#ifdef CERNLIB_TCGEN_IBITS
-#undef CERNLIB_TCGEN_IBITS
-#endif
-#ifdef CERNLIB_TCGEN_ISHFTC
-#undef CERNLIB_TCGEN_ISHFTC
-#endif
-#ifdef CERNLIB_TCGEN_LNBLNK
-#undef CERNLIB_TCGEN_LNBLNK
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncvx/_kcvx/qcardl.inc b/src/packlib/kernlib/kerngen/obsolete/kerncvx/_kcvx/qcardl.inc
deleted file mode 100644
index 2fde706..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncvx/_kcvx/qcardl.inc
+++ /dev/null
@@ -1,14 +0,0 @@
-*
-* $Id: qcardl.inc,v 1.1.1.1 1996/02/15 17:52:05 mclareni Exp $
-*
-* $Log: qcardl.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:52:05 mclareni
-* Kernlib
-*
-*
-*
-* qcardl.inc
-*
-#if 0
-C====================================================================
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncvx/_kcvy/normal.cra b/src/packlib/kernlib/kerngen/obsolete/kerncvx/_kcvy/normal.cra
deleted file mode 100644
index 50848c7..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncvx/_kcvy/normal.cra
+++ /dev/null
@@ -1,26 +0,0 @@
-#if !defined(CERNLIB_P5BOOT)
-#ifndef CERNLIB_CV32GS
-#define CERNLIB_CV32GS
-#endif
-#ifndef CERNLIB_CVXGS
-#define CERNLIB_CVXGS
-#endif
-#ifndef CERNLIB_CCGEN
-#define CERNLIB_CCGEN
-#endif
-#ifndef CERNLIB_CCGENCX
-#define CERNLIB_CCGENCX
-#endif
-#ifndef CERNLIB_CCGENCF
-#define CERNLIB_CCGENCF
-#endif
-#ifndef CERNLIB_CCGENCI
-#define CERNLIB_CCGENCI
-#endif
-#ifndef CERNLIB_XVECT
-#define CERNLIB_XVECT
-#endif
-#ifndef CERNLIB_TCGEN
-#define CERNLIB_TCGEN
-#endif
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncvx/_kcvy/patchy.cra b/src/packlib/kernlib/kerngen/obsolete/kerncvx/_kcvy/patchy.cra
deleted file mode 100644
index d8c77e1..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncvx/_kcvy/patchy.cra
+++ /dev/null
@@ -1,50 +0,0 @@
-#if 0
-* Patch boot-strap
-#endif
-#if defined(CERNLIB_P5BOOT)
-#ifndef CERNLIB_CV32GS_LOCF32
-#define CERNLIB_CV32GS_LOCF32
-#endif
-#ifndef CERNLIB_CVXGS_DATIME
-#define CERNLIB_CVXGS_DATIME
-#endif
-#ifndef CERNLIB_CVXGS_GETENVF
-#define CERNLIB_CVXGS_GETENVF
-#endif
-#ifndef CERNLIB_CVXGS_IARGV
-#define CERNLIB_CVXGS_IARGV
-#endif
-#ifndef CERNLIB_CVXGS_INTRAC
-#define CERNLIB_CVXGS_INTRAC
-#endif
-#ifndef CERNLIB_CVXGS_PERRORF
-#define CERNLIB_CVXGS_PERRORF
-#endif
-#ifndef CERNLIB_CVXGS_SIGNALF
-#define CERNLIB_CVXGS_SIGNALF
-#endif
-#ifndef CERNLIB_CVXGS_STATF
-#define CERNLIB_CVXGS_STATF
-#endif
-#ifndef CERNLIB_CVXGS_SYSTEMF
-#define CERNLIB_CVXGS_SYSTEMF
-#endif
-#ifndef CERNLIB_CVXGS_TMINIT
-#define CERNLIB_CVXGS_TMINIT
-#endif
-#ifndef CERNLIB_CVXGS_TMPRO
-#define CERNLIB_CVXGS_TMPRO
-#endif
-#ifndef CERNLIB_CVXGS_TMPROI
-#define CERNLIB_CVXGS_TMPROI
-#endif
-#ifndef CERNLIB_CVXGS_TMREAD
-#define CERNLIB_CVXGS_TMREAD
-#endif
-#ifndef CERNLIB_CVXGS_TMREADI
-#define CERNLIB_CVXGS_TMREADI
-#endif
-#ifndef CERNLIB_CVXGS_TRACEQ
-#define CERNLIB_CVXGS_TRACEQ
-#endif
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncvx/_kcvy/pilot.h b/src/packlib/kernlib/kerngen/obsolete/kerncvx/_kcvy/pilot.h
deleted file mode 100644
index 2752632..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncvx/_kcvy/pilot.h
+++ /dev/null
@@ -1,24 +0,0 @@
-#if 0
-* This pilot patch was created from kerncvx.car patch _kcvy
-#endif
-#if 0
-* 32-bit, IEEE fp mode
-#endif
-#ifndef CERNLIB_QIEEE
-#define CERNLIB_QIEEE
-#endif
-#ifndef CERNLIB_QMCVX
-#define CERNLIB_QMCVX
-#endif
-#ifndef CERNLIB_QMCV32
-#define CERNLIB_QMCV32
-#endif
-#ifdef CERNLIB_TCGEN_IBITS
-#undef CERNLIB_TCGEN_IBITS
-#endif
-#ifdef CERNLIB_TCGEN_ISHFTC
-#undef CERNLIB_TCGEN_ISHFTC
-#endif
-#ifdef CERNLIB_TCGEN_LNBLNK
-#undef CERNLIB_TCGEN_LNBLNK
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncvx/cv32gs/ie3fod32.F b/src/packlib/kernlib/kerngen/obsolete/kerncvx/cv32gs/ie3fod32.F
deleted file mode 100644
index 765aec9..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncvx/cv32gs/ie3fod32.F
+++ /dev/null
@@ -1,73 +0,0 @@
-*
-* $Id: ie3fod32.F,v 1.1.1.1 1996/02/15 17:52:21 mclareni Exp $
-*
-* $Log: ie3fod32.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:21 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE IE3FOD (MS,MT,NDPN,JBAD)
-C
-C CERN PROGLIB# M220 IE3FOD .VERSION KERNCVX 1.09 910815
-C Orig. 31/05/89 JZ
-
-C- Convert REAL*8 to double precision for output with copy
-C- from source in native to target in IEEE data format
-
- DIMENSION MS(99), MT(99)
-
- INTEGER*4 MTHIS(2), ITHA, ITHB
- EQUIVALENCE (ITHA,MTHIS(1)), (ITHB,MTHIS(2))
-
- PARAMETER (MSKEXP = '7FF00000'X)
- PARAMETER (IBADCD = '7FF01FC0'X)
- PARAMETER (IOVPCD = '7FF00000'X)
- PARAMETER (IOVNCD = 'FFF00000'X)
-
-
- JFAI = 0
- JMS = 0
- JMT = 0
-
- DO 449 JL=1,NDPN
- ITHA = MS(JMS+1)
- IF (ITHA.EQ.0) GO TO 442
- JSIGN = ishft (ITHA, -31)
- JEXP = ishft (ITHA.AND.MSKEXP, -20)
- IF (JEXP.EQ.0) GO TO 435
- IF (JEXP.EQ.2047) GO TO 433
- JEXP = JEXP - 2
- IF (JEXP.LE.0) GO TO 441
- ITHA = (ITHA .AND. .NOT.MSKEXP) .OR. ISHFT(JEXP,20)
- ITHB = MS(JMS+2)
- GO TO 447
-
-C-- overflow
- 433 IF (JSIGN.EQ.0) THEN
- ITHA = IOVPCD
- ELSE
- ITHA = IOVNCD
- ENDIF
- GO TO 437
-
-C-- NaN
- 435 IF (JSIGN.EQ.0) GO TO 441
- ITHA = IBADCD
- 437 JFAI = JL
- GO TO 442
-
- 441 ITHA = 0
- 442 ITHB = 0
- 447 MT(JMT+1) = ITHA
- MT(JMT+2) = ITHB
- JMT = JMT + 2
- 449 JMS = JMS + 2
-
- JBAD = JFAI
- RETURN
- END
-#ifdef CERNLIB_TCGEN_IE3FOD
-#undef CERNLIB_TCGEN_IE3FOD
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncvx/cv32gs/ie3fos32.F b/src/packlib/kernlib/kerngen/obsolete/kerncvx/cv32gs/ie3fos32.F
deleted file mode 100644
index a1d7449..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncvx/cv32gs/ie3fos32.F
+++ /dev/null
@@ -1,76 +0,0 @@
-*
-* $Id: ie3fos32.F,v 1.1.1.1 1996/02/15 17:52:21 mclareni Exp $
-*
-* $Log: ie3fos32.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:21 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE IE3FOS (MS,MT,NWDO,JBAD)
-C
-C CERN PROGLIB# M220 IE3FOS .VERSION KERNCVX 1.09 910815
-C Orig. 06/08/91 JZ
-
-C- Convert REAL*4 to single precision for output with copy
-C- from source in native to target in IEEE data format
-
- DIMENSION MS(99), MT(99)
-
- INTEGER*4 ITHA
-
- PARAMETER (MSKEXP = '7F800000'X)
- PARAMETER (MSKMAN = '007FFFFF'X)
- PARAMETER (IBADCS = '7F80FE00'X)
- PARAMETER (IOVPCS = '7F800000'X)
- PARAMETER (IOVNCS = 'FF800000'X)
-
-
- JFAI = 0
- JMS = 0
- JMT = 0
-
- DO 349 JL=1,NWDO
- ITHA = MS(JMS+1)
- IF (ITHA.EQ.0) GO TO 347
- JSIGN = ishft (ITHA, -31)
- JEXP = ishft (ITHA.AND.MSKEXP, -23)
- IF (JEXP.EQ.0) GO TO 335
- IF (JEXP.EQ.255) GO TO 333
- JEXP = JEXP - 2
- JMANT = MSKMAN .AND. ITHA
- IF (JEXP.LE.0) GO TO 331
- ITHA = ISHFT(JSIGN,31) .OR. ISHFT(JEXP,23) .OR. JMANT
- GO TO 347
-
-C-- make de-normalized number
- 331 JMANT = ishft (JMANT+'800000'X,JEXP-1)
- ITHA = ISHFT(JSIGN,31) .OR. JMANT
- GO TO 347
-
-C-- overflow
- 333 IF (JSIGN.EQ.0) THEN
- ITHA = IOVPCS
- ELSE
- ITHA = IOVNCS
- ENDIF
- GO TO 337
-
-C-- NaN
- 335 IF (JSIGN.EQ.0) GO TO 341
- ITHA = IBADCS
- 337 JFAI = JL
- GO TO 347
-
- 341 ITHA = 0
- 347 MT(JMT+1) = ITHA
- JMT = JMT + 1
- 349 JMS = JMS + 1
-
- JBAD = JFAI
- RETURN
- END
-#ifdef CERNLIB_TCGEN_IE3FOS
-#undef CERNLIB_TCGEN_IE3FOS
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncvx/cv32gs/ie3tod32.F b/src/packlib/kernlib/kerngen/obsolete/kerncvx/cv32gs/ie3tod32.F
deleted file mode 100644
index c5b896a..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncvx/cv32gs/ie3tod32.F
+++ /dev/null
@@ -1,78 +0,0 @@
-*
-* $Id: ie3tod32.F,v 1.1.1.1 1996/02/15 17:52:22 mclareni Exp $
-*
-* $Log: ie3tod32.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:22 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE IE3TOD (MS,MT,NDPN,JBAD)
-C
-C CERN PROGLIB# M220 IE3TOD .VERSION KERNCVX 1.09 910815
-C Orig. 31/05/89 JZ
-
-C- Convert double precision from input with copy
-C- from source in IEEE to target in native REAL*8 format
-
- DIMENSION MS(99), MT(99)
-
- INTEGER*8 ITHL, IOVPMD, IOVNMD, IBADMD
- INTEGER*4 ITHV(2), ITHA, ITHB
- EQUIVALENCE (ITHL,ITHV)
- EQUIVALENCE (ITHA,ITHV(1)), (ITHB,ITHV(2))
-
- PARAMETER (MSK20R = '000FFFFF'X)
- PARAMETER (MSKEXP = '7FF00000'X)
- PARAMETER (IOVPMD = '7FF7FFFFFFFFFFFF'X)
- PARAMETER (IOVNMD = 'FFF7FFFFFFFFFFFF'X)
- PARAMETER (IBADMD = '80007FFFFFFFFFFF'X)
-
-
- JFAI = 0
- JMS = 0
- JMT = 0
-
- DO 449 JL=1,NDPN
- ITHA = MS(JMS+1)
- IF (ITHA.EQ.0) GO TO 441
- ITHB = MS(JMS+2)
- JSIGN = ishft (ITHA, -31)
- JEXP = ishft (ITHA.AND.MSKEXP, -20)
- JMANT = ITHA .AND. MSK20R
- IF (JEXP.EQ.0) GO TO 441
- IF (JEXP.EQ.2047) GO TO 433
- IF (JEXP.EQ.2046) GO TO 434
-
- JEXP = JEXP + 2
- ITHA = ISHFT (JSIGN,31) .OR.
- + ISHFT (JEXP,20) .OR. JMANT
- GO TO 447
-
-C-- overflow
- 433 IF (JMANT.NE.0) GO TO 435
- 434 IF (JSIGN.EQ.0) THEN
- ITHL = IOVPMD
- ELSE
- ITHL = IOVNMD
- ENDIF
- GO TO 437
-
-C-- NaN
- 435 ITHL = IBADMD
- 437 JFAI = JL
- GO TO 447
-
- 441 ITHL = 0
- 447 MT(JMT+1) = ITHA
- MT(JMT+2) = ITHB
- JMT = JMT + 2
- 449 JMS = JMS + 2
-
- JBAD = JFAI
- RETURN
- END
-#ifdef CERNLIB_TCGEN_IE3TOD
-#undef CERNLIB_TCGEN_IE3TOD
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncvx/cv32gs/ie3tos32.F b/src/packlib/kernlib/kerngen/obsolete/kerncvx/cv32gs/ie3tos32.F
deleted file mode 100644
index 2f5e322..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncvx/cv32gs/ie3tos32.F
+++ /dev/null
@@ -1,81 +0,0 @@
-*
-* $Id: ie3tos32.F,v 1.1.1.1 1996/02/15 17:52:22 mclareni Exp $
-*
-* $Log: ie3tos32.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:22 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE IE3TOS (MS,MT,NWDO,JBAD)
-C
-C CERN PROGLIB# M220 IE3TOS .VERSION KERNCVX 1.09 910815
-C Orig. 31/05/89 JZ
-
-C- Convert single precision for input with copy
-C- from source in IEEE to target in native REAL*4 format
-
- DIMENSION MS(99), MT(99)
-
- REAL*4 VALUE
- INTEGER*4 ITHA
- EQUIVALENCE (VALUE,ITHA)
-
- PARAMETER (MSK23R = '007FFFFF'X)
- PARAMETER (MSKEXP = '7F800000'X)
- PARAMETER (IOVPMS = '7FBFFFFF'X)
- PARAMETER (IOVNMS = 'FFBFFFFF'X)
- PARAMETER (IBADMS = '80007FFF'X)
-
-
- JFAI = 0
- JMS = 0
- JMT = 0
-
- DO 349 JL=1,NWDO
- ITHA = MS(JMS+1)
- IF (ITHA.EQ.0) GO TO 347
- JSIGN = ishft (ITHA, -31)
- JEXP = ishft (ITHA.AND.MSKEXP, -23)
- JMANT = ITHA .AND. MSK23R
- IF (JEXP.EQ.0) GO TO 331
- IF (JEXP.EQ.255) GO TO 333
- IF (JEXP.EQ.254) GO TO 334
- JEXP = JEXP + 2
- ITHA = ISHFT (JSIGN,31) .OR. ISHFT (JEXP,23) .OR. JMANT
- GO TO 347
-
-C-- de-normalized number
- 331 IF (JMANT.EQ.0) GO TO 341
- VALUE = FLOAT(JMANT) * 2.**(-63)
- VALUE = VALUE * 2.**(-86)
- IF (ITHA .EQ.0) GO TO 347
- IF (JSIGN.EQ.0) GO TO 347
- VALUE = -VALUE
- GO TO 347
-
-C-- overflow / NaN
- 333 IF (JMANT.NE.0) GO TO 336
- 334 IF (JSIGN.EQ.0) THEN
- ITHA = IOVPMS
- ELSE
- ITHA = IOVNMS
- ENDIF
- GO TO 337
-
- 336 ITHA = IBADMS
- 337 JFAI = JL
- GO TO 347
-
- 341 ITHA = 0
- 347 MT(JMT+1) = ITHA
- JMT = JMT + 1
- 349 JMS = JMS + 1
-
- JBAD = JFAI
- RETURN
- END
-#ifdef CERNLIB_TCGEN_IE3TOS
-#undef CERNLIB_TCGEN_IE3TOS
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncvx/cv32gs/legvar32.F b/src/packlib/kernlib/kerngen/obsolete/kerncvx/cv32gs/legvar32.F
deleted file mode 100644
index ee1cd75..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncvx/cv32gs/legvar32.F
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: legvar32.F,v 1.1.1.1 1996/02/15 17:52:22 mclareni Exp $
-*
-* $Log: legvar32.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:22 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- FUNCTION LEGVAR (IWORD)
-C
-C CERN PROGLIB# LEGVAR .VERSION KERNCVX 1.09 910815
-C ORIG. 22/06/89 JZ
-C
-C- CONVEX version of the CDC function LEGVAR
-C- Returns zero for normal floating point numbers
-C- Returns 1 for maximum exponent (kind of overflow)
-C- Returns 2 for reserved operand
-
-
- LEGVAR = 0
-
- NN = ISHFT (IWORD, -23)
- IF (NN.EQ.'400'O) GO TO 27
- NN = NN .AND. '377'O
- IF (NN .NE. '377'O) RETURN
- LEGVAR = 1
- RETURN
-
- 27 LEGVAR = 2
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncvx/cv32gs/locf32.F b/src/packlib/kernlib/kerngen/obsolete/kerncvx/cv32gs/locf32.F
deleted file mode 100644
index 05263c8..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncvx/cv32gs/locf32.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: locf32.F,v 1.1.1.1 1996/02/15 17:52:22 mclareni Exp $
-*
-* $Log: locf32.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:22 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- FUNCTION LOCF (AM)
-C
-C CERN PROGLIB# N100 LOCF .VERSION KERNCVX 1.09 910815
-C ORIG. 01/01/89 AGA+MAV, Convex
-C
- DIMENSION AM(9)
-
- LOCF= %LOC (AM(1)) / 4
- RETURN
- END
-#ifdef CERNLIB_TCGEN_LOCF
-#undef CERNLIB_TCGEN_LOCF
-#endif
-#ifdef CERNLIB_CCGEN_LOCF
-#undef CERNLIB_CCGEN_LOCF
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncvx/cv32gs/noarg32.s b/src/packlib/kernlib/kerngen/obsolete/kerncvx/cv32gs/noarg32.s
deleted file mode 100644
index a229f67..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncvx/cv32gs/noarg32.s
+++ /dev/null
@@ -1,61 +0,0 @@
-*
-* $Id: noarg32.s,v 1.1.1.1 1996/02/15 17:52:22 mclareni Exp $
-*
-* $Log: noarg32.s,v $
-* Revision 1.1.1.1 1996/02/15 17:52:22 mclareni
-* Kernlib
-*
-*
-; SUBROUTINE NOARG (NARGS)
-;
-; CERN PROGLIB# Z029 NOARG .VERSION KERNCVX 1.09 910815
-; ORIG. 01/01/89 JV, CONVEX
-;
-#if !defined(CERNLIB_QIEEE)
- .fpmode native
-#endif
-#if defined(CERNLIB_QIEEE)
- .fpmode ieee
-#endif
-
-; INITIALIZED DATA
-
- .data
- .align 8
-LI:
-
-; UNINITIALIZED DATA
-
- .bss
- .align 8
-LU:
-
-; INSTRUCTIONS
-
- .text
- ds.w 0x4010000
- ds.b "-O\0\0"
- .globl _noarg_ ;ENTRY
-_noarg_:
- sub.w #Lfs1,sp ;
- ld.w 8(fp),a1 ;get the previous frame pointer
- ld.w 12(a1),a1 ;get the previous argument pointer
- ld.w -4(a1),s0 ;get the number of arguments
- mov s0,s1
- mul.w #4,s1 ;
-loop:
- sub.w #4,s1
- mov a1,a2
- add.w s1,a2
- ld.w (a2),s2
- leu.w #0x80000000,s2
- jmps.t exit
- sub.w #1,s0
- jmp loop
-exit:
- st.w s0, at 0(ap) ;
- rtn ; #4
-Lfs1 = 8
-#ifdef CERNLIB_TCGEN_NOARG
-#undef CERNLIB_TCGEN_NOARG
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncvx/cv64gs/alcfio.F b/src/packlib/kernlib/kerngen/obsolete/kerncvx/cv64gs/alcfio.F
deleted file mode 100644
index e410ea1..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncvx/cv64gs/alcfio.F
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: alcfio.F,v 1.1.1.1 1996/02/15 17:52:14 mclareni Exp $
-*
-* $Log: alcfio.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:14 mclareni
-* Kernlib
-*
-*
-* CFIO not ready for -p8
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE CFCLOS
- ENTRY CFGET
- ENTRY CFOPEI
- ENTRY CFPUT
- ENTRY CFREW
- ENTRY CFSEEK
- ENTRY CFSIZE
- ENTRY CFTELL
-
- PRINT 9009
- 9009 FORMAT(/' ******** CFIO is not ready for -p8 **********'/)
-
- CALL ABEND
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncvx/cv64gs/ie3fod.F b/src/packlib/kernlib/kerngen/obsolete/kerncvx/cv64gs/ie3fod.F
deleted file mode 100644
index eeac402..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncvx/cv64gs/ie3fod.F
+++ /dev/null
@@ -1,75 +0,0 @@
-*
-* $Id: ie3fod.F,v 1.1.1.1 1996/02/15 17:52:14 mclareni Exp $
-*
-* $Log: ie3fod.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:14 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE IE3FOD (MS,MT,NDPN,JBAD)
-C
-C CERN PROGLIB# M220 IE3FOD .VERSION KERNCVX 1.09 910815
-C Orig. 31/05/89 JZ
-
-C- Convert REAL*8 to double precision for output with copy
-C- from source in native to target in IEEE data format
-
- DIMENSION MS(99), MT(99)
-
- INTEGER*8 MTHIS(2), ITHA, ITHB
- EQUIVALENCE (ITHA,MTHIS(1)), (ITHB,MTHIS(2))
-
- PARAMETER (MSK32R = '00000000FFFFFFFF'X)
- PARAMETER (MSKEXP = '7FF0000000000000'X)
- PARAMETER (IBADCD = '000000007FF01FC0'X)
- PARAMETER (IOVPCD = '000000007FF00000'X)
- PARAMETER (IOVNCD = '00000000FFF00000'X)
-
-
- JFAI = 0
- JMS = 0
- JMT = 0
-
- DO 449 JL=1,NDPN
- ITHA = MS(JMS+1)
- IF (ITHA.EQ.0) GO TO 442
- JSIGN = ishft (ITHA, -63)
- JEXP = ishft (ITHA.AND.MSKEXP, -52)
- IF (JEXP.EQ.0) GO TO 435
- IF (JEXP.EQ.2047) GO TO 433
- JEXP = JEXP - 2
- IF (JEXP.LE.0) GO TO 441
- ITHB = ITHA .AND. MSK32R
- ITHA = (ITHA .AND. .NOT.MSKEXP) .OR. ISHFT(JEXP,52)
- ITHA = ishft (ITHA, -32)
- GO TO 447
-
-C-- overflow
- 433 IF (JSIGN.EQ.0) THEN
- ITHA = IOVPCD
- ELSE
- ITHA = IOVNCD
- ENDIF
- GO TO 437
-
-C-- NaN
- 435 IF (JSIGN.EQ.0) GO TO 441
- ITHA = IBADCD
- 437 JFAI = JL
- GO TO 442
-
- 441 ITHA = 0
- 442 ITHB = 0
- 447 MT(JMT+1) = ITHA
- MT(JMT+2) = ITHB
- JMT = JMT + 2
- 449 JMS = JMS + 2
-
- JBAD = JFAI
- RETURN
- END
-#ifdef CERNLIB_TCGEN_IE3FOD
-#undef CERNLIB_TCGEN_IE3FOD
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncvx/cv64gs/ie3fos.F b/src/packlib/kernlib/kerngen/obsolete/kerncvx/cv64gs/ie3fos.F
deleted file mode 100644
index 700fb51..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncvx/cv64gs/ie3fos.F
+++ /dev/null
@@ -1,84 +0,0 @@
-*
-* $Id: ie3fos.F,v 1.1.1.1 1996/02/15 17:52:15 mclareni Exp $
-*
-* $Log: ie3fos.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:15 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE IE3FOS (MS,MT,NWDO,JBAD)
-C
-C CERN PROGLIB# M220 IE3FOS .VERSION KERNCVX 1.09 910815
-C Orig. 31/05/89 JZ
-
-C- Convert REAL*8 to single precision for output with copy
-C- from source in native to target in IEEE data format
-
- DIMENSION MS(99), MT(99)
-
- INTEGER*8 ITHA
-
- PARAMETER (MSK32R = '00000000FFFFFFFF'X)
- PARAMETER (MSK24R = '0000000000FFFFFF'X)
- PARAMETER (MSKEXP = '7FF0000000000000'X)
- PARAMETER (IBADCS = '000000007F80FE00'X)
- PARAMETER (IOVPCS = '000000007F800000'X)
- PARAMETER (IOVNCS = '00000000FF800000'X)
-
-
- JFAI = 0
- JMS = 0
- JMT = 0
-
- DO 349 JL=1,NWDO
- ITHA = MS(JMS+1)
- IF (ITHA.EQ.0) GO TO 347
- JSIGN = ishft (ITHA, -63)
- JEXP = ishft (ITHA.AND.MSKEXP, -52)
- IF (JEXP.EQ.0) GO TO 335
- JEXP = JEXP - 1025 + 127
- JMANT = MSK24R .AND. ishft(ITHA,-28)
- IF (JMANT.EQ.MSK24R) THEN
- JMANT = 0
- JEXP = JEXP + 1
- ELSE
- JMANT = ishft(JMANT+1,-1)
- ENDIF
- IF (JEXP.LE.0) GO TO 331
- IF (JEXP.GE.255) GO TO 333
- ITHA = ISHFT(JSIGN,31) .OR. ISHFT(JEXP,23) .OR. JMANT
- GO TO 347
-
-C-- make de-normalized number
- 331 IF (JEXP.LT.-23) GO TO 341
- JMANT = ishft (JMANT+'800000'X,JEXP-1)
- ITHA = ISHFT(JSIGN,31) .OR. JMANT
- GO TO 347
-
-C-- overflow
- 333 IF (JSIGN.EQ.0) THEN
- ITHA = IOVPCS
- ELSE
- ITHA = IOVNCS
- ENDIF
- GO TO 337
-
-C-- NaN
- 335 IF (JSIGN.EQ.0) GO TO 341
- ITHA = IBADCS
- 337 JFAI = JL
- GO TO 347
-
- 341 ITHA = 0
- 347 MT(JMT+1) = ITHA
- JMT = JMT + 1
- 349 JMS = JMS + 1
-
- JBAD = JFAI
- RETURN
- END
-#ifdef CERNLIB_TCGEN_IE3FOS
-#undef CERNLIB_TCGEN_IE3FOS
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncvx/cv64gs/ie3tod.F b/src/packlib/kernlib/kerngen/obsolete/kerncvx/cv64gs/ie3tod.F
deleted file mode 100644
index 504fb68..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncvx/cv64gs/ie3tod.F
+++ /dev/null
@@ -1,78 +0,0 @@
-*
-* $Id: ie3tod.F,v 1.1.1.1 1996/02/15 17:52:16 mclareni Exp $
-*
-* $Log: ie3tod.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:16 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE IE3TOD (MS,MT,NDPN,JBAD)
-C
-C CERN PROGLIB# M220 IE3TOD .VERSION KERNCVX 1.09 910815
-C Orig. 31/05/89 JZ
-
-C- Convert double precision from input with copy
-C- from source in IEEE to target in native REAL*8 format
-
- DIMENSION MS(99), MT(99)
-
- INTEGER*8 MTHIS(2), ITHA, ITHB
- EQUIVALENCE (ITHA,MTHIS(1)), (ITHB,MTHIS(2))
-
- PARAMETER (MSK20R = '00000000000FFFFF'X)
- PARAMETER (MSKEXP = '000000007FF00000'X)
- PARAMETER (IOVPMD = '7FF7FFFFFFFFFFFF'X)
- PARAMETER (IOVNMD = 'FFF7FFFFFFFFFFFF'X)
- PARAMETER (IBADMD = '80007FFFFFFFFFFF'X)
-
-
- JFAI = 0
- JMS = 0
- JMT = 0
-
- DO 449 JL=1,NDPN
- ITHA = MS(JMS+1)
- IF (ITHA.EQ.0) GO TO 447
- ITHB = MS(JMS+2)
- JSIGN = ishft (ITHA, -31)
- JEXP = ishft (ITHA.AND.MSKEXP, -20)
- JMANT = ITHA .AND. MSK20R
- IF (JEXP.EQ.0) GO TO 441
- IF (JEXP.EQ.2047) GO TO 433
- IF (JEXP.EQ.2046) GO TO 434
-
- JEXP = JEXP + 2
- ITHA = ISHFT (JSIGN,63) .OR.
- + ISHFT (JEXP,52) .OR.
- + ISHFT (JMANT,32) .OR.
- + ITHB
- GO TO 447
-
-C-- overflow
- 433 IF (JMANT.NE.0) GO TO 435
- 434 IF (JSIGN.EQ.0) THEN
- ITHA = IOVPMD
- ELSE
- ITHA = IOVNMD
- ENDIF
- GO TO 437
-
-C-- NaN
- 435 ITHA = IBADMD
- 437 JFAI = JL
- GO TO 447
-
- 441 ITHA = 0
- 447 MT(JMT+1) = ITHA
- MT(JMT+2) = 0
- JMT = JMT + 2
- 449 JMS = JMS + 2
-
- JBAD = JFAI
- RETURN
- END
-#ifdef CERNLIB_TCGEN_IE3TOD
-#undef CERNLIB_TCGEN_IE3TOD
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncvx/cv64gs/ie3tos.F b/src/packlib/kernlib/kerngen/obsolete/kerncvx/cv64gs/ie3tos.F
deleted file mode 100644
index f264b47..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncvx/cv64gs/ie3tos.F
+++ /dev/null
@@ -1,84 +0,0 @@
-*
-* $Id: ie3tos.F,v 1.1.1.1 1996/02/15 17:52:16 mclareni Exp $
-*
-* $Log: ie3tos.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:16 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE IE3TOS (MS,MT,NWDO,JBAD)
-C
-C CERN PROGLIB# M220 IE3TOS .VERSION KERNCVX 1.09 910815
-C Orig. 31/05/89 JZ
-
-C- Convert single precision for input with copy
-C- from source in IEEE to target in native REAL*8 format
-
- DIMENSION MS(99), MT(99)
-
- REAL*8 VALUE
- INTEGER*8 MTHIS(2), ITHA, ITHB
- EQUIVALENCE (ITHA,MTHIS(1)), (ITHB,MTHIS(2))
- EQUIVALENCE (VALUE,ITHA)
-
- PARAMETER (MSK23R = '00000000007FFFFF'X)
- PARAMETER (MSKEXP = '000000007F800000'X)
- PARAMETER (IOVPMS = '7FF7FFFFFFFFFFFF'X)
- PARAMETER (IOVNMS = 'FFF7FFFFFFFFFFFF'X)
- PARAMETER (IBADMS = '80007FFFFFFFFFFF'X)
-
-
- JFAI = 0
- JMS = 0
- JMT = 0
-
- DO 349 JL=1,NWDO
- ITHA = MS(JMS+1)
- IF (ITHA.EQ.0) GO TO 347
- JSIGN = ishft (ITHA, -31)
- JEXP = ishft (ITHA.AND.MSKEXP, -23)
- JMANT = ITHA .AND. MSK23R
- IF (JEXP.EQ.0) GO TO 331
- IF (JEXP.EQ.255) GO TO 333
- JEXP = JEXP - 127 + 1025
- ITHA = ISHFT (JSIGN,63) .OR.
- + ISHFT (JEXP,52) .OR.
- + ISHFT (JMANT,29)
- GO TO 347
-
-C-- de-normalized number
- 331 IF (JMANT.EQ.0) GO TO 341
- VALUE = FLOAT(JMANT) * 2.**(-63)
- VALUE = VALUE * 2.**(-86)
- IF (ITHA .EQ.0) GO TO 347
- IF (JSIGN.EQ.0) GO TO 347
- VALUE = -VALUE
- GO TO 347
-
-C-- overflow
- 333 IF (JMANT.NE.0) GO TO 335
- IF (JSIGN.EQ.0) THEN
- ITHA = IOVPMS
- ELSE
- ITHA = IOVNMS
- ENDIF
- GO TO 337
-
-C-- NaN
- 335 ITHA = IBADMS
- 337 JFAI = JL
- GO TO 347
-
- 341 ITHA = 0
- 347 MT(JMT+1) = ITHA
- JMT = JMT + 1
- 349 JMS = JMS + 1
-
- JBAD = JFAI
- RETURN
- END
-#ifdef CERNLIB_TCGEN_IE3TOS
-#undef CERNLIB_TCGEN_IE3TOS
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncvx/cv64gs/legvar.F b/src/packlib/kernlib/kerngen/obsolete/kerncvx/cv64gs/legvar.F
deleted file mode 100644
index a64e257..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncvx/cv64gs/legvar.F
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: legvar.F,v 1.1.1.1 1996/02/15 17:52:16 mclareni Exp $
-*
-* $Log: legvar.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:16 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- FUNCTION LEGVAR (IWORD)
-C
-C CERN PROGLIB# LEGVAR .VERSION KERNCVX 1.04 890626
-C ORIG. 22/06/89 JZ
-C
-C- CONVEX version of the CDC function LEGVAR
-C- Returns zero for normal floating point numbers
-C- Returns 1 for maximum exponent (kind of overflow)
-C- Returns 2 for reserved operand
-
-
- LEGVAR = 0
-
- NN = ISHFT (IWORD, -52)
- IF (NN.EQ.'4000'O) GO TO 27
- NN = NN .AND. '3777'O
- IF (NN .NE. '3777'O) RETURN
- LEGVAR = 1
- RETURN
-
- 27 LEGVAR = 2
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncvx/cv64gs/locf.F b/src/packlib/kernlib/kerngen/obsolete/kerncvx/cv64gs/locf.F
deleted file mode 100644
index c53eaf0..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncvx/cv64gs/locf.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: locf.F,v 1.1.1.1 1996/02/15 17:52:16 mclareni Exp $
-*
-* $Log: locf.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:16 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- FUNCTION LOCF (AM)
-C
-C CERN PROGLIB# N100 LOCF .VERSION KERNCVX 1.00 890315
-C ORIG. 01/01/89 AGA+MAV, Convex
-C
- DIMENSION AM(9)
-
- LOCF= %LOC (AM(1)) / 8
- RETURN
- END
-#ifdef CERNLIB_TCGEN_LOCF
-#undef CERNLIB_TCGEN_LOCF
-#endif
-#ifdef CERNLIB_CCGEN_LOCF
-#undef CERNLIB_CCGEN_LOCF
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncvx/cv64gs/noarg.s b/src/packlib/kernlib/kerngen/obsolete/kerncvx/cv64gs/noarg.s
deleted file mode 100644
index 0939f8f..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncvx/cv64gs/noarg.s
+++ /dev/null
@@ -1,62 +0,0 @@
-*
-* $Id: noarg.s,v 1.1.1.1 1996/02/15 17:52:19 mclareni Exp $
-*
-* $Log: noarg.s,v $
-* Revision 1.1.1.1 1996/02/15 17:52:19 mclareni
-* Kernlib
-*
-*
-; SUBROUTINE NOARG (NARGS)
-;
-; CERN PROGLIB# Z029 NOARG .VERSION KERNCVX 1.10 940228
-; ORIG. 01/01/89 JV, CONVEX
-;
-#if !defined(CERNLIB_QIEEE)
- .fpmode native
-#endif
-#if defined(CERNLIB_QIEEE)
- .fpmode ieee
-#endif
-
-; INITIALIZED DATA
-
- .data
- .align 8
-LI:
-
-; UNINITIALIZED DATA
-
- .bss
- .align 8
-LU:
-
-; INSTRUCTIONS
-
- .text
- ds.w 0x4010000
- ds.b "-O\0\0"
- .globl _noarg_ ;ENTRY
-_noarg_:
- sub.w #Lfs1,sp ;
- ld.w 8(fp),a1 ;get the previous frame pointer
- ld.w 12(a1),a1 ;get the previous argument pointer
- ld.w -4(a1),s0 ;get the number of arguments
- mov s0,s1
- mul.w #4,s1 ;
-loop:
- sub.w #4,s1
- mov a1,a2
- add.w s1,a2
- ld.w (a2),s2
- leu.w #0x80000000,s2
- jmps.t exit
- sub.w #1,s0
- jmp loop
-exit:
- cvtw.l s0,s0
- st.l s0, at 0(ap) ;
- rtn ; #4
-Lfs1 = 8
-#ifdef CERNLIB_TCGEN_NOARG
-#undef CERNLIB_TCGEN_NOARG
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncvx/cv64gs/pack32.F b/src/packlib/kernlib/kerngen/obsolete/kerncvx/cv64gs/pack32.F
deleted file mode 100644
index 0b6890d..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncvx/cv64gs/pack32.F
+++ /dev/null
@@ -1,36 +0,0 @@
-*
-* $Id: pack32.F,v 1.1.1.1 1996/02/15 17:52:19 mclareni Exp $
-*
-* $Log: pack32.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:19 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE PACK32 (MTAK,MPUT,NW)
-C
-C CERN PROGLIB# PACK32 .VERSION KERNCVX 1.00 890315
-C ORIG. 13/03/89, JZ
-C
-C CONVEX special for ZEBRA FZOUT : pack NW words from
-C MTAK to NW/2 words in MPUT, taking the 32 right-most bits
-C MPUT may be MTAK, ie. pack in situ
-
- DIMENSION MTAK(*), MPUT(*)
- PARAMETER (MASK32 = 'FFFFFFFF'X)
-
-
- NLOOP = NW/2
- JTAK = 0
-
- DO 29 JPUT=1,NLOOP
- MWD = ISHFT (MTAK(JTAK+1), 32)
- MWD = MWD .OR. (MTAK(JTAK+2) .AND. MASK32)
- MPUT(JPUT) = MWD
- 29 JTAK = JTAK + 2
- RETURN
- END
-#ifdef CERNLIB_TCGEN_PACK32
-#undef CERNLIB_TCGEN_PACK32
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncvx/cv64gs/rndm.F b/src/packlib/kernlib/kerngen/obsolete/kerncvx/cv64gs/rndm.F
deleted file mode 100644
index 65373cd..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncvx/cv64gs/rndm.F
+++ /dev/null
@@ -1,59 +0,0 @@
-*
-* $Id: rndm.F,v 1.1.1.1 1996/02/15 17:52:19 mclareni Exp $
-*
-* $Log: rndm.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:19 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- FUNCTION RNDM (ISEED)
-C
-C CERN PROGLIB# V104 RNDM .VERSION KERNCVX 1.06 891207
-C ORIG. 22-MAR-88 from IBM version of G.Marsaglia et al., Montreal
-C
-C !!! Version valid only for CONVEX with -p8 !!!
-C
-C- Uniform Random Number Generator,
-
- EQUIVALENCE (AMAN,MANT)
- PARAMETER (MSK1 = '0350000000000000'X)
- PARAMETER (MSK2 = '3CB0000000000000'X)
- SAVE MCGN
- DATA MCGN / '0000358FE5D9FF21'X /
-
-
- MCGN = MCGN * 69069
- MANT = ISHFT (MCGN,-11)
- IF (MANT.EQ.0) GO TO 14
- AMAN = MANT
-C- AMAN in the range 1 to 2**53-1
- MANT = MANT - MSK1
-C- multiply by 2.**(-53)
- RNDM = AMAN
- RETURN
-
-C-- for zero set RNDM = 2.**(-54)
- 14 MANT = MSK2
- RNDM = AMAN
- RETURN
-
-C-- Integer random number
- ENTRY IRNDM (ISEED)
- MCGN = MCGN * 69069
- IRNDM = ISHFT (MCGN,-1)
- RETURN
-
-C-- Set the seed
- ENTRY RDMIN (ISEED)
- MCGN = ISEED
- RETURN
-
-C-- Get the seed
- ENTRY RDMOUT (ISEED)
- ISEED = MCGN
- END
-#ifdef CERNLIB_TCGEN_RNDM
-#undef CERNLIB_TCGEN_RNDM
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncvx/cv64gs/upak32.F b/src/packlib/kernlib/kerngen/obsolete/kerncvx/cv64gs/upak32.F
deleted file mode 100644
index 70cc3da..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncvx/cv64gs/upak32.F
+++ /dev/null
@@ -1,35 +0,0 @@
-*
-* $Id: upak32.F,v 1.1.1.1 1996/02/15 17:52:20 mclareni Exp $
-*
-* $Log: upak32.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:20 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE UPAK32 (MTAK,MPUT,NW)
-C
-C CERN PROGLIB# UPAK32 .VERSION KERNCVX 1.00 890315
-C ORIG. 13/03/89, JZ
-C
-C CONVEX special for ZEBRA FZIN : unpack NW/2 words from
-C MTAK to NW words in MPUT, 32 bits right justified
-
- DIMENSION MTAK(*), MPUT(*)
- PARAMETER (MASK32 = 'FFFFFFFF'X)
-
-
- NLOOP = NW/2
- JPUT = 0
-
- DO 29 JTAK=1,NLOOP
- MWD = MTAK(JTAK)
- MPUT(JPUT+1) = ISHFT(MWD,-32)
- MPUT(JPUT+2) = MWD .AND. MASK32
- 29 JPUT = JPUT + 2
- RETURN
- END
-#ifdef CERNLIB_TCGEN_UPAK32
-#undef CERNLIB_TCGEN_UPAK32
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncvx/cvxgs/chdirf.F b/src/packlib/kernlib/kerngen/obsolete/kerncvx/cvxgs/chdirf.F
deleted file mode 100644
index 122ce48..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncvx/cvxgs/chdirf.F
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: chdirf.F,v 1.1.1.1 1996/02/15 17:52:23 mclareni Exp $
-*
-* $Log: chdirf.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:23 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- INTEGER FUNCTION CHDIRF (NAME)
-C
-C CERN PROGLIB# CHDIRF .VERSION KERNCVX 1.08 910806
-C ORIG. 06/08/91, JZ
-C Fortran interface routine to chdir
-C
- CHARACTER NAME*(*)
- INTEGER CHDIR
-
- N = LNBLNK (NAME)
- CHDIRF = CHDIR (NAME(1:N))
- RETURN
- END
-#ifdef CERNLIB_CCGEN_CHDIRF
-#undef CERNLIB_CCGEN_CHDIRF
-#endif
-#ifdef CERNLIB_CCGEN_CHDIRI
-#undef CERNLIB_CCGEN_CHDIRI
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncvx/cvxgs/ctimef.F b/src/packlib/kernlib/kerngen/obsolete/kerncvx/cvxgs/ctimef.F
deleted file mode 100644
index 38712b2..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncvx/cvxgs/ctimef.F
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: ctimef.F,v 1.1.1.1 1996/02/15 17:52:23 mclareni Exp $
-*
-* $Log: ctimef.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:23 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE CTIMEF (CLOCK, CHTIME)
-C
-C CERN PROGLIB# CTIMEF .VERSION KERNCVX 1.08 910806
-C ORIG. 06/08/91, JZ
-C Fortran interface routine to ctime
-C
-C- CLOCK encoded time (returned by, e.g. STATF)
-C- CHTIME decoded time string of length 24
-
- INTEGER CLOCK
- CHARACTER CHTIME*24, CTIME*24
-
-
- CHTIME = CTIME (CLOCK)
- RETURN
- END
-#ifdef CERNLIB_CCGEN_CTIMEF
-#undef CERNLIB_CCGEN_CTIMEF
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncvx/cvxgs/datime.F b/src/packlib/kernlib/kerngen/obsolete/kerncvx/cvxgs/datime.F
deleted file mode 100644
index 15e83bc..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncvx/cvxgs/datime.F
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: datime.F,v 1.1.1.1 1996/02/15 17:52:23 mclareni Exp $
-*
-* $Log: datime.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:23 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE DATIME (ND,NT)
-C
-C CERN PROGLIB# Z007 DATIME .VERSION KERNCVX 1.09 910815
-C ORIG. 15/02/88 JZ
-C MOD. 27/07/89 add /SLATE/, JZ
-C
-C- CALL DATIME (ND,NT) RETURNS INTEGER DATE ND = YYMMDD
-C- INTEGER TIME NT = HHMM
-C
- COMMON /SLATE/ ISLATE(40)
- DIMENSION MM(6)
-
-
- CALL IDATE (MM(2),MM(3),MM(1))
- CALL ITIME (MM(4))
-
- DO 24 J=1,6
- 24 ISLATE(J) = MM(J)
-
- MM(1) = MOD (MM(1),100)
-
- ND = (MM(1)*100+MM(2))*100 + MM(3)
- NT = MM(4) *100 + MM(5)
- RETURN
- END
-#ifdef CERNLIB_TCGEN_DATIME
-#undef CERNLIB_TCGEN_DATIME
-#endif
-#ifdef CERNLIB_CCGEN_DATIME
-#undef CERNLIB_CCGEN_DATIME
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncvx/cvxgs/datimh.F b/src/packlib/kernlib/kerngen/obsolete/kerncvx/cvxgs/datimh.F
deleted file mode 100644
index 4e03d29..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncvx/cvxgs/datimh.F
+++ /dev/null
@@ -1,55 +0,0 @@
-*
-* $Id: datimh.F,v 1.1.1.1 1996/02/15 17:52:24 mclareni Exp $
-*
-* $Log: datimh.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:24 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE DATIMH (ND,NT)
-C
-C CERN PROGLIB# Z007 DATIMH .VERSION KERNCVX 1.09 910815
-C ORIG. 15/06/89 JZ
-C
-
-C- CALL DATIMH (ND,NT) RETURNS HOLLERITH DATE ND = DD/MM/YY
-C- HOLLERITH TIME NT = HH.MM.SS
-
- COMMON /SLATE/ ISL(10),M(20),MM(10)
-
- CHARACTER ND*8, NT*8, CHV*16
-
-
-C- D D / M M / Y Y H H . M M . S S
-C- 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6
-
-C- m d y
- CALL IDATE (MM(2),MM(3),MM(1))
- CALL ITIME (MM(4))
-
- DO 24 J=1,6
- 24 M(J) = MM(J)
-
- M(1) = MOD (M(1),100)
-
- CHV ='0 /0 /000 .0 .00'
-
- CALL CSETDI (M(1), CHV, 7, 8)
- CALL CSETDI (M(2), CHV, 4, 5)
- CALL CSETDI (M(3), CHV, 1, 2)
- CALL CSETDI (M(4), CHV, 9,10)
- CALL CSETDI (M(5), CHV,12,13)
- CALL CSETDI (M(6), CHV,15,16)
-
- ND(1:8) = CHV(1:8)
- NT(1:8) = CHV(9:16)
- RETURN
- END
-#ifdef CERNLIB_TCGEN_DATIMH
-#undef CERNLIB_TCGEN_DATIMH
-#endif
-#ifdef CERNLIB_CCGEN_DATIMH
-#undef CERNLIB_CCGEN_DATIMH
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncvx/cvxgs/getenvf.F b/src/packlib/kernlib/kerngen/obsolete/kerncvx/cvxgs/getenvf.F
deleted file mode 100644
index 9713b7a..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncvx/cvxgs/getenvf.F
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: getenvf.F,v 1.1.1.1 1996/02/15 17:52:24 mclareni Exp $
-*
-* $Log: getenvf.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:24 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE GETENVF (NAME, TEXT)
-C
-C CERN PROGLIB# GETENVF .VERSION KERNCVX 1.08 910806
-C ORIG. 06/08/91, JZ
-C Fortran interface routine to getenv
-C
- COMMON /SLATE/ISL(40)
- CHARACTER*(*) NAME, TEXT
-
- CALL GETENV (NAME,TEXT)
- ISL(1) = LNBLNK (TEXT)
- RETURN
- END
-#ifdef CERNLIB_CCGEN_GETENVF
-#undef CERNLIB_CCGEN_GETENVF
-#endif
-#ifdef CERNLIB_CCGEN_GETENI
-#undef CERNLIB_CCGEN_GETENI
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncvx/cvxgs/getpidf.F b/src/packlib/kernlib/kerngen/obsolete/kerncvx/cvxgs/getpidf.F
deleted file mode 100644
index 4055dd2..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncvx/cvxgs/getpidf.F
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: getpidf.F,v 1.1.1.1 1996/02/15 17:52:24 mclareni Exp $
-*
-* $Log: getpidf.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:24 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE GETPIDF (IPID)
-C
-C CERN PROGLIB# GETPIDF .VERSION KERNCVX 1.08 910806
-C ORIG. 06/08/91, JZ
-C Fortran interface routine to getpid
-C
- INTEGER GETPID
-
- IPID = GETPID ()
- RETURN
- END
-#ifdef CERNLIB_CCGEN_GETPIDF
-#undef CERNLIB_CCGEN_GETPIDF
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncvx/cvxgs/getwdf.F b/src/packlib/kernlib/kerngen/obsolete/kerncvx/cvxgs/getwdf.F
deleted file mode 100644
index 02c4e80..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncvx/cvxgs/getwdf.F
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: getwdf.F,v 1.1.1.1 1996/02/15 17:52:26 mclareni Exp $
-*
-* $Log: getwdf.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:26 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE GETWDF (TEXT)
-C
-C CERN PROGLIB# GETWDF .VERSION KERNCVX 1.08 910806
-C ORIG. 06/08/91, JZ
-C Fortran interface routine to getwd
-C
- COMMON /SLATE/ISL(40)
- CHARACTER TEXT*(*)
-
- CALL GETCWD (TEXT)
- ISL(1) = LNBLNK (TEXT)
- RETURN
- END
-#ifdef CERNLIB_CCGEN_GETWDF
-#undef CERNLIB_CCGEN_GETWDF
-#endif
-#ifdef CERNLIB_CCGEN_GETWDI
-#undef CERNLIB_CCGEN_GETWDI
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncvx/cvxgs/gmtimef.F b/src/packlib/kernlib/kerngen/obsolete/kerncvx/cvxgs/gmtimef.F
deleted file mode 100644
index 9fd0e50..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncvx/cvxgs/gmtimef.F
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: gmtimef.F,v 1.1.1.1 1996/02/15 17:52:26 mclareni Exp $
-*
-* $Log: gmtimef.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:26 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE GMTIMEF (CLOCK, ITIMEV)
-C
-C CERN PROGLIB# GMTIMEF .VERSION KERNCVX 1.08 910806
-C ORIG. 06/08/91, JZ
-C Fortran interface routine to gmtime
-C
-C- CLOCK encoded time (returned by, e.g. STATF)
-C- ITIMEV decoded time
-
- INTEGER ITIMEV(9)
- INTEGER CLOCK
-
- CALL GMTIME (CLOCK,ITIMEV)
-
- RETURN
- END
-#ifdef CERNLIB_CCGEN_GMTIMEF
-#undef CERNLIB_CCGEN_GMTIMEF
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncvx/cvxgs/iargv.F b/src/packlib/kernlib/kerngen/obsolete/kerncvx/cvxgs/iargv.F
deleted file mode 100644
index 8af5dfa..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncvx/cvxgs/iargv.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: iargv.F,v 1.1.1.1 1996/02/15 17:52:26 mclareni Exp $
-*
-* $Log: iargv.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:26 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- FUNCTION IARGV (INARG,ARGV)
-C
-C CERN PROGLIB# Z264 IARGV .VERSION KERNCVX 1.09 910815
-C ORIG. 01/01/89 AGA+MAV, Convex
-C
- CHARACTER ARGV*(*)
-C! INTEGER*4 JARG
-
- JARG = INARG
- CALL GETARG (JARG,ARGV)
- IARGV = LNBLNK (ARGV)
- RETURN
- END
-#ifdef CERNLIB_TCGEN_IARGV
-#undef CERNLIB_TCGEN_IARGV
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncvx/cvxgs/intrac.F b/src/packlib/kernlib/kerngen/obsolete/kerncvx/cvxgs/intrac.F
deleted file mode 100644
index fe24011..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncvx/cvxgs/intrac.F
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: intrac.F,v 1.1.1.1 1996/02/15 17:52:26 mclareni Exp $
-*
-* $Log: intrac.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:26 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- LOGICAL FUNCTION INTRAC (DUMMY)
-C
-C CERN PROGLIB# Z044 INTRAC .VERSION KERNCVX 1.00 890315
-C ORIG. 22/02/88 JZ
-C
-C- The program is considered interactive if standard input
-C- is connected to the terminal
-
- LOGICAL ISATTY
-
- INTRAC = ISATTY (5)
- RETURN
- END
-#ifdef CERNLIB_TCGEN_INTRAC
-#undef CERNLIB_TCGEN_INTRAC
-#endif
-#ifdef CERNLIB_CCGEN_INTRAC
-#undef CERNLIB_CCGEN_INTRAC
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncvx/cvxgs/jumpad.F b/src/packlib/kernlib/kerngen/obsolete/kerncvx/cvxgs/jumpad.F
deleted file mode 100644
index cb2cbfa..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncvx/cvxgs/jumpad.F
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: jumpad.F,v 1.1.1.1 1996/02/15 17:52:27 mclareni Exp $
-*
-* $Log: jumpad.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:27 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- FUNCTION JUMPAD (ITARGT)
-C
-C CERN PROGLIB# Z042 JUMPAD .VERSION KERNCVX 1.00 890315
-C ORIG. 01/01/89 AGA+MAV, Convex
-C
-C- GET TARGET ADDRESS FOR USE WITH JUMPXN
-
- JUMPAD = %LOC (ITARGT)
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncvx/cvxgs/jumpx2.F b/src/packlib/kernlib/kerngen/obsolete/kerncvx/cvxgs/jumpx2.F
deleted file mode 100644
index 826c93b..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncvx/cvxgs/jumpx2.F
+++ /dev/null
@@ -1,66 +0,0 @@
-*
-* $Id: jumpx2.F,v 1.1.1.1 1996/02/15 17:52:27 mclareni Exp $
-*
-* $Log: jumpx2.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:27 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE JUMPX2 (IPARA,IPARB)
-C
-C CERN PROGLIB# Z042 JUMPX2 .VERSION KERNCVX 1.05 890913
-C ORIG. 01/01/89 AGA+MAV, Convex
-C MOD. 12/09/89 JZ, add entries JUMPX1, JUMPX0
-C
-C- TO TRANSFER TO THE USER ROUTINE TARGET (SAY) WITH 2 PARAMETERS
-C- THREE STEPS ARE NEEDED :
-
-C- 1) EXTERNAL TARGET TO GET THE ADDRESS OF TARGET
-C- IADR = JUMPAD (TARGET)
-
-C- 2) CALL JUMPST (IADR) TO SET THE TRANFER ADDRESS
-
-C- 3) CALL JUMPX2 (PAR1,PAR2) TO TRANSFER
-
- DIMENSION IPARA(9), IPARB(9)
- SAVE JPOINT
-
- CALL JUMPY2 (%VAL(INT4(JPOINT)),IPARA,IPARB)
- RETURN
-
- ENTRY JUMPX1 (IPARA)
- CALL JUMPY1 (%VAL(INT4(JPOINT)),IPARA)
- RETURN
-
- ENTRY JUMPX0
- CALL JUMPY0 (%VAL(INT4(JPOINT)))
- RETURN
-
- ENTRY JUMPST (JADR)
- JPOINT = JADR
- RETURN
- END
-C-----------------------------------------------------
- SUBROUTINE JUMPY2 (TARSUB,IPARA,IPARB)
- DIMENSION IPARA(9), IPARB(9)
- EXTERNAL TARSUB
-
- CALL TARSUB (IPARA,IPARB)
- RETURN
-
- ENTRY JUMPY1 (TARSUB,IPARA)
- CALL TARSUB (IPARA)
- RETURN
-
- ENTRY JUMPY0 (TARSUB)
- CALL TARSUB
- RETURN
- END
-#ifdef CERNLIB_TCGEN_JUMPXN
-#undef CERNLIB_TCGEN_JUMPXN
-#endif
-#ifdef CERNLIB_CCGEN_JUMPXN
-#undef CERNLIB_CCGEN_JUMPXN
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncvx/cvxgs/kerngt.F b/src/packlib/kernlib/kerngen/obsolete/kerncvx/cvxgs/kerngt.F
deleted file mode 100644
index 6730b2d..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncvx/cvxgs/kerngt.F
+++ /dev/null
@@ -1,36 +0,0 @@
-*
-* $Id: kerngt.F,v 1.1.1.1 1996/02/15 17:52:23 mclareni Exp $
-*
-* $Log: kerngt.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:23 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE KERNGT (LUN)
-C
-C CERN PROGLIB# Z001 KERNGT .VERSION KERNCVX 1.10 940228
-C ORIG. 16/03/89
-C
-C-- Store Pam title into /SLATE/ for printing by GSHOWF
-
- COMMON /SLATE/ MCH(40)
- CHARACTER VIDQQ*(*)
- PARAMETER (VIDQQ = '@(#)' //
- + CPP_TITLE_CH
- + // ' '
- + // '>')
-
- CALL CLEFT (VIDQQ,1,0)
- CALL UCTOH1 (
- + CPP_TITLE_CH
- + // ' '
- +, MCH, 40)
- CALL GSHOWF (LUN)
- RETURN
- END
-#ifdef CERNLIB_TCGEN_KERNGT
-#undef CERNLIB_TCGEN_KERNGT
-#endif
-#include "TITLE.kerncvx"
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncvx/cvxgs/killf.F b/src/packlib/kernlib/kerngen/obsolete/kerncvx/cvxgs/killf.F
deleted file mode 100644
index 0bdc31d..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncvx/cvxgs/killf.F
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: killf.F,v 1.1.1.1 1996/02/15 17:52:27 mclareni Exp $
-*
-* $Log: killf.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:27 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- FUNCTION KILLF (IPID,ISIG)
-C
-C CERN PROGLIB# KILLF .VERSION KERNCVX 1.08 910806
-C ORIG. 06/08/91, JZ
-C Fortran interface routine to kill
-C
-
- KILLF = KILL (IPID,ISIG)
- RETURN
- END
-#ifdef CERNLIB_CCGEN_KILLF
-#undef CERNLIB_CCGEN_KILLF
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncvx/cvxgs/locb.F b/src/packlib/kernlib/kerngen/obsolete/kerncvx/cvxgs/locb.F
deleted file mode 100644
index 22ecb26..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncvx/cvxgs/locb.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: locb.F,v 1.1.1.1 1996/02/15 17:52:27 mclareni Exp $
-*
-* $Log: locb.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:27 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- FUNCTION LOCB (AM)
-C
-C CERN PROGLIB# N100 LOCB .VERSION KERNCVX 1.06 891207
-C ORIG. 17/11/89 AGA+MAV, Convex
-C
- DIMENSION AM(9)
-
- LOCB= %LOC (AM(1))
- RETURN
- END
-#ifdef CERNLIB_TCGEN_LOCB
-#undef CERNLIB_TCGEN_LOCB
-#endif
-#ifdef CERNLIB_CCGEN_LOCB
-#undef CERNLIB_CCGEN_LOCB
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncvx/cvxgs/perrorf.F b/src/packlib/kernlib/kerngen/obsolete/kerncvx/cvxgs/perrorf.F
deleted file mode 100644
index c8da153..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncvx/cvxgs/perrorf.F
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: perrorf.F,v 1.1.1.1 1996/02/15 17:52:27 mclareni Exp $
-*
-* $Log: perrorf.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:27 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE PERRORF (TEXT)
-C
-C CERN PROGLIB# PERRORF .VERSION KERNCVX 1.08 910806
-C ORIG. 06/08/91, JZ
-C Fortran interface routine to perror
-C
- CHARACTER TEXT*(*)
-
- CALL PERROR (TEXT)
- RETURN
- END
-#ifdef CERNLIB_CCGEN_PERRORF
-#undef CERNLIB_CCGEN_PERRORF
-#endif
-#ifdef CERNLIB_CCGEN_PERROI
-#undef CERNLIB_CCGEN_PERROI
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncvx/cvxgs/qnexte.c b/src/packlib/kernlib/kerngen/obsolete/kerncvx/cvxgs/qnexte.c
deleted file mode 100644
index 50674a3..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncvx/cvxgs/qnexte.c
+++ /dev/null
@@ -1,40 +0,0 @@
-/*
- * $Id: qnexte.c,v 1.1.1.1 1996/02/15 17:52:27 mclareni Exp $
- *
- * $Log: qnexte.c,v $
- * Revision 1.1.1.1 1996/02/15 17:52:27 mclareni
- * Kernlib
- *
- */
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
-/*> ROUTINE QNEXTE
-*/
-#include <setjmp.h>
-
-static int first = 0;
-static jmp_buf env;
-int
-qnexte_()
-{
- int val;
- if (first) {
- longjmp(env, val);
- first = 0;
- } else {
- setjmp(env);
- if (first)
- return;
- else {
- qnext_();
- first = 1;
- }
- }
-}
-/*> END <----------------------------------------------------------*/
-#ifdef CERNLIB_TCGEN_QNEXTE
-#undef CERNLIB_TCGEN_QNEXTE
-#endif
-#ifdef CERNLIB_CCGEN_QNEXTE
-#undef CERNLIB_CCGEN_QNEXTE
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncvx/cvxgs/renamef.F b/src/packlib/kernlib/kerngen/obsolete/kerncvx/cvxgs/renamef.F
deleted file mode 100644
index 360a6fe..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncvx/cvxgs/renamef.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: renamef.F,v 1.1.1.1 1996/02/15 17:52:27 mclareni Exp $
-*
-* $Log: renamef.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:27 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- INTEGER FUNCTION RENAMEF (FROM,TO)
-C
-C CERN PROGLIB# RENAMEF .VERSION KERNCVX 1.08 910806
-C ORIG. 06/08/91, JZ
-C Fortran interface routine to rename
-C
- CHARACTER*(*) FROM, TO
- INTEGER RENAME
-
- RENAMEF = RENAME (FROM, TO)
- RETURN
- END
-#ifdef CERNLIB_CCGEN_RENAMEF
-#undef CERNLIB_CCGEN_RENAMEF
-#endif
-#ifdef CERNLIB_CCGEN_RENAMI
-#undef CERNLIB_CCGEN_RENAMI
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncvx/cvxgs/signalf.F b/src/packlib/kernlib/kerngen/obsolete/kerncvx/cvxgs/signalf.F
deleted file mode 100644
index 2fc0c8b..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncvx/cvxgs/signalf.F
+++ /dev/null
@@ -1,37 +0,0 @@
-*
-* $Id: signalf.F,v 1.1.1.1 1996/02/15 17:52:28 mclareni Exp $
-*
-* $Log: signalf.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:28 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- INTEGER FUNCTION SIGNALF (NUMSIGL,PROC,IFLAGL)
-C
-C CERN PROGLIB# SIGNALF .VERSION KERNCVX 1.08 910806
-C ORIG. 06/08/91, JZ
-C Fortran interface routine to signal
-C
-C- NUMSIG : signal number
-C- PROC : external of the handler, if IFLAG = -1
-C- IFLAG : < 0 instal PROC
-C- = 0 default action
-C- = 1 ignore signal
-C- > 1 adr of handler as returned earlier
-C- function value = adr of previous handler
-
- INTEGER SIGNAL
- EXTERNAL PROC
-
-
- NUMSIG = NUMSIGL
- IFLAG = IFLAGL
- SIGNALF = -SIGNAL (NUMSIG,PROC,IFLAG)
-
- RETURN
- END
-#ifdef CERNLIB_CCGEN_SIGNALF
-#undef CERNLIB_CCGEN_SIGNALF
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncvx/cvxgs/sleepf.F b/src/packlib/kernlib/kerngen/obsolete/kerncvx/cvxgs/sleepf.F
deleted file mode 100644
index a120e81..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncvx/cvxgs/sleepf.F
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: sleepf.F,v 1.1.1.1 1996/02/15 17:52:28 mclareni Exp $
-*
-* $Log: sleepf.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:28 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE SLEEPF (NSECS)
-C
-C CERN PROGLIB# SLEEPF .VERSION KERNCVX 1.08 910806
-C ORIG. 06/08/91, JZ
-C Fortran interface routine to sleep
-C
-
- CALL SLEEP (NSECS)
- RETURN
- END
-#ifdef CERNLIB_CCGEN_SLEEPF
-#undef CERNLIB_CCGEN_SLEEPF
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncvx/cvxgs/statf.F b/src/packlib/kernlib/kerngen/obsolete/kerncvx/cvxgs/statf.F
deleted file mode 100644
index e5361d6..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncvx/cvxgs/statf.F
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: statf.F,v 1.1.1.1 1996/02/15 17:52:28 mclareni Exp $
-*
-* $Log: statf.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:28 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- INTEGER FUNCTION STATF (NAME, INFO)
-C
-C CERN PROGLIB# STATF .VERSION KERNCVX 1.08 910806
-C ORIG. 06/08/91, JZ
-C Fortran interface routine to stat
-C
-C NAME the name of the file of which information is required
-C INFO(12) buffer returning the information about "file"
-C
-C A succesfull call returns 0. A failed call returns -1.
-C
- CHARACTER*(*) NAME
- INTEGER STAT, INFO(12), INST(16)
-
- STATF = STAT (NAME,INST)
-
- JPUT = 1
- DO 24 JTAK=1,13
- IF (JTAK.EQ.7) GO TO 24
- INFO(JPUT) = INST(JTAK)
- JPUT = JPUT + 1
- 24 CONTINUE
-
- RETURN
- END
-#ifdef CERNLIB_CCGEN_STATF
-#undef CERNLIB_CCGEN_STATF
-#endif
-#ifdef CERNLIB_CCGEN_STATI
-#undef CERNLIB_CCGEN_STATI
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncvx/cvxgs/systemf.F b/src/packlib/kernlib/kerngen/obsolete/kerncvx/cvxgs/systemf.F
deleted file mode 100644
index efaf918..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncvx/cvxgs/systemf.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: systemf.F,v 1.1.1.1 1996/02/15 17:52:28 mclareni Exp $
-*
-* $Log: systemf.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:28 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- INTEGER FUNCTION SYSTEMF (NAME)
-C
-C CERN PROGLIB# SYSTEMF .VERSION KERNCVX 1.08 910806
-C ORIG. 06/08/91, JZ
-C Fortran interface routine to system
-C
- CHARACTER NAME*(*)
- INTEGER SYSTEM
-
- SYSTEMF = SYSTEM (NAME)
- RETURN
- END
-#ifdef CERNLIB_CCGEN_SYSTEMF
-#undef CERNLIB_CCGEN_SYSTEMF
-#endif
-#ifdef CERNLIB_CCGEN_SYSTEI
-#undef CERNLIB_CCGEN_SYSTEI
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncvx/cvxgs/timed.F b/src/packlib/kernlib/kerngen/obsolete/kerncvx/cvxgs/timed.F
deleted file mode 100644
index 0cd11ab..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncvx/cvxgs/timed.F
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: timed.F,v 1.1.1.1 1996/02/15 17:52:28 mclareni Exp $
-*
-* $Log: timed.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:28 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE TIMED (T)
-C
-C CERN PROGLIB# Z007 TIMED .VERSION KERNCVX 1.09 910815
-C ORIG. 01/12/89 KP, MM, JZ
-C
-C! REAL*4 ARRAY(2),DTIME
- REAL ARRAY(2)
-
- T = DTIME(ARRAY)
- RETURN
- END
-#ifdef CERNLIB_TCGEN_TIMED
-#undef CERNLIB_TCGEN_TIMED
-#endif
-#ifdef CERNLIB_CCGEN_TIMED
-#undef CERNLIB_CCGEN_TIMED
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncvx/cvxgs/timel.F b/src/packlib/kernlib/kerngen/obsolete/kerncvx/cvxgs/timel.F
deleted file mode 100644
index 189128f..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncvx/cvxgs/timel.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: timel.F,v 1.1.1.1 1996/02/15 17:52:28 mclareni Exp $
-*
-* $Log: timel.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:28 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- OPTIONS -sa
- SUBROUTINE TIMEL (T)
-C
-C CERN PROGLIB# Z007 TIMEL .VERSION KERNCVX 1.09 910815
-C ORIG. 01/01/89 AGA+MAV, Convex
-C
- REAL*4 TLARG
-
- CALL TIMELCC (TLARG)
- T = TLARG
- RETURN
- END
-#ifdef CERNLIB_TCGEN_TIMEL
-#undef CERNLIB_TCGEN_TIMEL
-#endif
-#ifdef CERNLIB_CCGEN_TIMEL
-#undef CERNLIB_CCGEN_TIMEL
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncvx/cvxgs/timelcc.c b/src/packlib/kernlib/kerngen/obsolete/kerncvx/cvxgs/timelcc.c
deleted file mode 100644
index f03009a..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncvx/cvxgs/timelcc.c
+++ /dev/null
@@ -1,33 +0,0 @@
-/*
- * $Id: timelcc.c,v 1.1.1.1 1996/02/15 17:52:28 mclareni Exp $
- *
- * $Log: timelcc.c,v $
- * Revision 1.1.1.1 1996/02/15 17:52:28 mclareni
- * Kernlib
- *
- */
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
-/*> ROUTINE TIMELCC
-*/
-#include <sys/vlimit.h>
-#include <sys/time.h>
-#include <sys/resource.h>
-
-void timelcc_(left)
-float *left ;
-
-{
- struct rusage ru ;
- double hold;
-
- (void) getrusage(RUSAGE_SELF, &ru) ;
- hold = (double) vlimit ( LIM_CPU , -1 )
- -(double) ru.ru_utime.tv_sec
- -(double) ru.ru_utime.tv_usec/1000000.0
- -(double) ru.ru_stime.tv_sec
- -(double) ru.ru_stime.tv_usec/1000000.0;
- *left = hold;
- return;
- }
-/*> END <----------------------------------------------------------*/
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncvx/cvxgs/timex.F b/src/packlib/kernlib/kerngen/obsolete/kerncvx/cvxgs/timex.F
deleted file mode 100644
index 9462995..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncvx/cvxgs/timex.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: timex.F,v 1.1.1.1 1996/02/15 17:52:28 mclareni Exp $
-*
-* $Log: timex.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:28 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE TIMEX (T)
-C
-C CERN PROGLIB# Z007 TIMEX .VERSION KERNCVX 1.06 891207
-C ORIG. 1/12/89 KP, MM, JZ
-C
- REAL*4 ARRAY(2),ETIME
-
- T = ETIME(ARRAY)
- RETURN
- END
-#ifdef CERNLIB_TCGEN_TIMEX
-#undef CERNLIB_TCGEN_TIMEX
-#endif
-#ifdef CERNLIB_CCGEN_TIMEX
-#undef CERNLIB_CCGEN_TIMEX
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncvx/cvxgs/tminit.F b/src/packlib/kernlib/kerngen/obsolete/kerncvx/cvxgs/tminit.F
deleted file mode 100644
index b6871f3..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncvx/cvxgs/tminit.F
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: tminit.F,v 1.1.1.1 1996/02/15 17:52:28 mclareni Exp $
-*
-* $Log: tminit.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:28 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE TMINIT (INIT)
-C
-C CERN PROGLIB# TMINIT .VERSION KERNCVX 1.08 910806
-C ORIG. 06/08/91, JZ
-C Fortran interface routine to initialize TMPRO / TMREAD
-
-C
- INIT = 7
- RETURN
- END
-#ifdef CERNLIB_CCGEN_TMINIT
-#undef CERNLIB_CCGEN_TMINIT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncvx/cvxgs/tmpro.F b/src/packlib/kernlib/kerngen/obsolete/kerncvx/cvxgs/tmpro.F
deleted file mode 100644
index 7da4cd0..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncvx/cvxgs/tmpro.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: tmpro.F,v 1.1.1.1 1996/02/15 17:52:29 mclareni Exp $
-*
-* $Log: tmpro.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:29 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- OPTIONS -sa
- SUBROUTINE TMPRO (TEXT)
-C
-C CERN PROGLIB# TMPRO .VERSION KERNCVX 1.08 910806
-C ORIG. 06/08/91, JZ
-C
-C Fortran interface : print a prompt string
-C
- CHARACTER TEXT*(*)
- INTEGER*4 LGTEXT
-
- LGTEXT = LEN (TEXT)
- CALL TMPROI (TEXT,LGTEXT)
- RETURN
- END
-#ifdef CERNLIB_CCGEN_TMPRO
-#undef CERNLIB_CCGEN_TMPRO
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncvx/cvxgs/tmproi.F b/src/packlib/kernlib/kerngen/obsolete/kerncvx/cvxgs/tmproi.F
deleted file mode 100644
index 52fe2e5..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncvx/cvxgs/tmproi.F
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: tmproi.F,v 1.1.1.1 1996/02/15 17:52:29 mclareni Exp $
-*
-* $Log: tmproi.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:29 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
-/*> ROUTINE TMPROI
- CERN PROGLIB# TMPROI .VERSION KERNCVX 1.08 910806
- ORIG. 06/08/91, JZ
- Fortran interface routine to print a prompt string
- CALL TMPRO (TEXT)
-*/
-#include <unistd.h>
-
-void tmproi_(text, ant)
- char *text;
- int *ant;
-{
- write (1, text, *ant);
- return;
-}
-/*> END <----------------------------------------------------------*/
-#ifdef CERNLIB_CCGEN_TMPROI
-#undef CERNLIB_CCGEN_TMPROI
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncvx/cvxgs/tmread.F b/src/packlib/kernlib/kerngen/obsolete/kerncvx/cvxgs/tmread.F
deleted file mode 100644
index ef9c3dc..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncvx/cvxgs/tmread.F
+++ /dev/null
@@ -1,36 +0,0 @@
-*
-* $Id: tmread.F,v 1.1.1.1 1996/02/15 17:52:29 mclareni Exp $
-*
-* $Log: tmread.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:29 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- OPTIONS -sa
- SUBROUTINE TMREAD (MAXCHL, LINE, NCHL, ISTATL)
-C
-C CERN PROGLIB# TMREAD .VERSION KERNCVX 1.08 910806
-C ORIG. 06/08/91, JZ
-C
-C- read the next line from stdin :
-C-
-C- MAXCH maxim. # of characters into LINE
-C- NCH actual # of characters read into LINE
-C- ISTAT status return, zero : OK -ve : EoF
-
- CHARACTER LINE*(*)
-
- INTEGER*4 MAXCH, NCH, ISTAT
-
-
- MAXCH = MAXCHL
- CALL TMREADI (MAXCH, LINE, NCH, ISTAT)
- NCHL = NCH
- ISTATL = ISTAT
- RETURN
- END
-#ifdef CERNLIB_CCGEN_TMREAD
-#undef CERNLIB_CCGEN_TMREAD
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncvx/cvxgs/tmreadi.F b/src/packlib/kernlib/kerngen/obsolete/kerncvx/cvxgs/tmreadi.F
deleted file mode 100644
index 6109f39..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncvx/cvxgs/tmreadi.F
+++ /dev/null
@@ -1,51 +0,0 @@
-*
-* $Id: tmreadi.F,v 1.1.1.1 1996/02/15 17:52:29 mclareni Exp $
-*
-* $Log: tmreadi.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:29 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
-/*> ROUTINE TMREADI
- CERN PROGLIB# TMREAD .VERSION KERNCVX 1.08 910806
- ORIG. 06/08/91, JZ
- read the next line from stdin :
- CALL TMREAD (MAXCH, LINE, NCH, ISTAT)
- MAXCH maxim. # of characters into LINE
- NCH actual # of characters read into LINE
- ISTAT status return, zero : OK -ve : EoF
-*/
-#include <stdio.h>
-
-void tmreadi_(alim, cols, anch, astat)
- char *cols;
- int *alim, *anch, *astat;
-{
- int ch, jcol, lim;
-
-/*-- read the text */
- lim = *alim;
- jcol = 0;
- while (lim-- > 0)
- { ch = getchar();
- if (ch == EOF) goto endf;
- if (ch == '\n') goto endl;
- cols[jcol] = ch;
- jcol = jcol + 1;
- }
-/* discard excess characters */
-loop: ch = getchar();
- if (ch == '\n') goto endl;
- if (ch != EOF) goto loop;
-
-endf: *astat = -1;
- clearerr(stdin);
- return;
-
-endl: *anch = jcol;
- *astat = 0;
- return;
-}
-/*> END <----------------------------------------------------------*/
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncvx/cvxgs/traceq.F b/src/packlib/kernlib/kerngen/obsolete/kerncvx/cvxgs/traceq.F
deleted file mode 100644
index 3a9a89d..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncvx/cvxgs/traceq.F
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: traceq.F,v 1.1.1.1 1996/02/15 17:52:29 mclareni Exp $
-*
-* $Log: traceq.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:29 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE TRACEQ (LUNP,LEV)
-C
-C CERN PROGLIB# N105 TRACEQ .VERSION KERNCVX 1.00 890315
-C ORIG. 01/01/89 AGA+MAV, Convex
-C
-
- CALL TRACEBACK
- RETURN
- END
-#ifdef CERNLIB_TCGEN_TRACEQ
-#undef CERNLIB_TCGEN_TRACEQ
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncvx/cvxprogs/fcasplit.F b/src/packlib/kernlib/kerngen/obsolete/kerncvx/cvxprogs/fcasplit.F
deleted file mode 100644
index ce5a63d..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncvx/cvxprogs/fcasplit.F
+++ /dev/null
@@ -1,13 +0,0 @@
-*
-* $Id: fcasplit.F,v 1.1.1.1 1996/02/15 17:52:13 mclareni Exp $
-*
-* $Log: fcasplit.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:13 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
-#ifndef CERNLIB_UTYGEN_FCASPLIT
-#define CERNLIB_UTYGEN_FCASPLIT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncvx/history/history.dat b/src/packlib/kernlib/kerngen/obsolete/kerncvx/history/history.dat
deleted file mode 100644
index 058e5a5..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncvx/history/history.dat
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: history.dat,v 1.1.1.1 1996/02/15 17:52:02 mclareni Exp $
-*
-* $Log: history.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:52:02 mclareni
-* Kernlib
-*
-*
-* This directory was created from kerncvx.car patch kerncvx
-#if !defined(CERNLIB_KERNCVX)
-
- KERNLIB routines particular to CONVEX
-
----------------------------------------------------------------------
-
- This file contains the following patches :
-
- *KCVX pilot for Convex Kernlib, 64-bit, native floating point mode
- *KCVY pilot for Convex Kernlib, 32-bit, IEEE fp mode
-
- QMCV64 machine patch for 64-bit
- QMCV32 machine patch for 32-bit
-
- CV64GS Convex variants of Kernlib routines, 64-bit version
- CV32GS Convex variants of Kernlib routines, 32-bit version
- CVXGS valid both for 32-bit and 64-bit version
-
-=====================================================================
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncvx/history/previous.dat b/src/packlib/kernlib/kerngen/obsolete/kerncvx/history/previous.dat
deleted file mode 100644
index 8c25621..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncvx/history/previous.dat
+++ /dev/null
@@ -1,136 +0,0 @@
-*
-* $Id: previous.dat,v 1.1.1.1 1996/02/15 17:52:02 mclareni Exp $
-*
-* $Log: previous.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:52:02 mclareni
-* Kernlib
-*
-*
-#if !defined(CERNLIB_KERNCVX)
-
-UP-DATE 1.10 : 28-Feb-1994
-----------------------------
-
-Replacing File KERNCVX 1.09 910815 15.07
-
-Correct: *KCVX selects 64-bit, native mode, as before
- *KCVY selects 32-bit, IEEE mode, from now on
-
- change QM significance:
-
- QMCV64 64-bit mode (old: QMCVX)
- QMCV32 32-bit mode (old: QMCVY)
- QMCVX either mode (old: QMCVX OR QMCVY)
-
- change patch names: CVXGS -> CV64GS
- CVYGS -> CV32GS
- CVALLGS -> CVXGS
-
- re-write TIMELCC
-
----------------------------------------------------------------------
-
-UP-DATE 1.09 : 15-Aug-1991
-----------------------------
-
-Replacing File KERNCVX 1.08 910806 15.48
-
-New patches: *KCVY to trigger 32-bit Kernlib version
- CVYGS routines specific for 32-bit
- (64-bit specifics are in P=CVXGS)
- CVALLGS common routines for 32-bit and 64-bit
-
-Corrections: Convex have changed the Fortran library:
- before routines like GETARG expected 32-bit word parameters,
- now 64-bit parameters are expected if compilation
- -> and <- linking is done with 'fc -p8'
- this affected routines: DATIME, DATIMH, IARGV, TIMEL
-
- IE3 conversion routines:
- there was a factor of 2 in both directions
- this affects Zebra FZ files in exchange mode
-
- UBLOW, UBUNCH use standard version from KERNFOR
-
----------------------------------------------------------------------
-
-UP-DATE 1.08 : 6-Aug-1991
-----------------------------
-
-Replacing File KERNCVX 1.07 900726 20.02
-
-New decks : Interface routines to the C library
- CHDIRF, CTIMEF, GETENVF, GETPIDF, GETWDF, GMTIMEF, KILLF,
- PERRORF, RENAMEF, SIGNALF, SLEEPF, STATF, SYSTEMF,
- TMINIT, TMPRO, TMPROI, TMREAD, TMREADI,
-
----------------------------------------------------------------------
-
-UP-DATE 1.07 : 26-July-1990
-----------------------------
-
-Replacing File KERNCVX 1.06 891207 22.25
-
-Delete : XBANNER which is now on KERNFOR
-
-Correct: Connect some routines from CCGEN
-
----------------------------------------------------------------------
-
-UP-DATE 1.06 : 7-Dec-1989
-----------------------------
-
-Replacing File KERNCVX 1.05 890913 21.08
-
-New decks : LOCB return the byte adr of a variable
- XBANNER for banner pages
-
-Correct : DATIMH, RNDM, TIMED, TIMEX
-
-Delete : ABEND, IUFORW use default on KERNFOR
-
----------------------------------------------------------------------
-
-UP-DATE 1.05 : 13-Sept-1989
-----------------------------
-
-Replacing File KERNCVX 1.04 890626 15.24
-
-Correct : DATIME to return seconds in /SLATE/
- JUMPX2 add entries JUMPX1 and JUMPX0
-
----------------------------------------------------------------------
-
-UP-DATE 1.04 : 26-June-1989
-----------------------------
-
-Replacing File KERNCVX 1.03 890602 15.26
-
-Corrections after verification run at PSI, Villigen
-
----------------------------------------------------------------------
-
-UP-DATE 1.02 : 1-June-1989
-----------------------------
-
-Replacing File KERNCVX 1.01 890531 15.23
-
-Correct : NOARG
-
----------------------------------------------------------------------
-
-UP-DATE 1.01 : 31-May-1989
-----------------------------
-
-Replacing File KERNCVX 1.00 890317 13.10
-
-New Decks : IE3xxy IEEE conversion routines
-
----------------------------------------------------------------------
-
- First release of the KERNCVX Pam : 15-mar-1989
-
----------------------------------------------------------------------
-
-C====================================================================
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncvx/history/update.dat b/src/packlib/kernlib/kerngen/obsolete/kerncvx/history/update.dat
deleted file mode 100644
index 89d49e0..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncvx/history/update.dat
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: update.dat,v 1.1.1.1 1996/02/15 17:52:02 mclareni Exp $
-*
-* $Log: update.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:52:02 mclareni
-* Kernlib
-*
-*
-#if !defined(CERNLIB_KERNCVX)
-
-
- UP-DATE RECORD FOR THE PAM-FILE KERNCVX
- ----------------------------------------
-
-
-UP-DATE 1.11 : 11-May-1994
-----------------------------
-
-Replacing File KERNCVX 1.10 940224 12.28
-
-Selection on P=P5BOOT for the Patchy boot-strap export
-
----------------------------------------------------------------------
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncvx/inhibit.list b/src/packlib/kernlib/kerngen/obsolete/kerncvx/inhibit.list
deleted file mode 100644
index f6874b1..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncvx/inhibit.list
+++ /dev/null
@@ -1,75 +0,0 @@
-tcgen/ibits
-tcgen/ishftc
-tcgen/lnblnk
-tcgen/ibits
-tcgen/ishftc
-tcgen/lnblnk
-tcgen/ie3fod
-tcgen/ie3fos
-tcgen/ie3tod
-tcgen/ie3tos
-tcgen/locf
-ccgen/locf
-tcgen/noarg
-tcgen/pack32
-tcgen/rndm
-tcgen/upak32
-tcgen/ie3fod
-tcgen/ie3fos
-tcgen/ie3tod
-tcgen/ie3tos
-tcgen/locf
-ccgen/locf
-tcgen/noarg
-tcgen/kerngt
-ccgen/chdirf
-ccgen/chdiri
-ccgen/ctimef
-tcgen/datime
-ccgen/datime
-tcgen/datimh
-ccgen/datimh
-ccgen/getenvf
-ccgen/geteni
-ccgen/getpidf
-ccgen/getwdf
-ccgen/getwdi
-ccgen/gmtimef
-tcgen/iargv
-tcgen/intrac
-ccgen/intrac
-tcgen/jumpxn
-ccgen/jumpxn
-ccgen/killf
-tcgen/locb
-ccgen/locb
-ccgen/perrorf
-ccgen/perroi
-tcgen/qnexte
-ccgen/qnexte
-ccgen/renamef
-ccgen/renami
-ccgen/signalf
-ccgen/sleepf
-ccgen/statf
-ccgen/stati
-ccgen/systemf
-ccgen/systei
-tcgen/timed
-ccgen/timed
-tcgen/timel
-ccgen/timel
-tcgen/timex
-ccgen/timex
-ccgen/tminit
-ccgen/tmpro
-ccgen/tmproi
-ccgen/tmread
-tcgen/traceq
-tcgen/ublow
-tcgen/ubunch
-tcgen/jbit
-tcgen/jbyt
-tcgen/sbit
-tcgen/sbit1
-tcgen/sbit0
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncvx/keeporig/timelcc.c b/src/packlib/kernlib/kerngen/obsolete/kerncvx/keeporig/timelcc.c
deleted file mode 100644
index 9bca50d..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncvx/keeporig/timelcc.c
+++ /dev/null
@@ -1,31 +0,0 @@
-/*
- * $Id: timelcc.c,v 1.1.1.1 1996/02/15 17:52:29 mclareni Exp $
- *
- * $Log: timelcc.c,v $
- * Revision 1.1.1.1 1996/02/15 17:52:29 mclareni
- * Kernlib
- *
- */
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
-/*> ROUTINE TIMELCC
-*/
-#include <sys/vlimit.h>
-#include <sys/time.h>
-#include <sys/resource.h>
-
-long long int timelcc_(left)
-double *left ;
-
-{
- struct rusage *ru ;
- ru = (struct rusage *) malloc( sizeof(struct rusage) ) ;
- getrusage(RUSAGE_SELF,ru) ;
- *left = (double) vlimit ( LIM_CPU , -1 )
- -(double) ru->ru_utime.tv_sec
- -(double)ru->ru_utime.tv_usec/1000000.0
- -(double) ru->ru_stime.tv_sec
- -(double)ru->ru_stime.tv_usec/1000000.0;
- return(*left);
- }
-/*> END <----------------------------------------------------------*/
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncvx/keeporig/ublow.F b/src/packlib/kernlib/kerngen/obsolete/kerncvx/keeporig/ublow.F
deleted file mode 100644
index a0774f0..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncvx/keeporig/ublow.F
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: ublow.F,v 1.1.1.1 1996/02/15 17:52:29 mclareni Exp $
-*
-* $Log: ublow.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:29 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE UBLOW (VM, V1, NCH)
-C
-C CERN PROGLIB# M409 UBLOW .VERSION KERNCVX 1.00 890315
-C ORIG. 01/01/89 AGA+MAV, Convex
-C
-C DISPERSES THE STRING OF NCH HOLLERITH CHARACTERS FROM VM INTO VI
-C
- CHARACTER*1 VM(*)
- CHARACTER*8 V1(*)
-
- DO I=1,NCH
- V1(I) = ' '
- ENDDO
-
- DO I=1,NCH
- V1(I)(1:1)=VM(I)
- ENDDO
- RETURN
- END
-#ifdef CERNLIB_TCGEN_UBLOW
-#undef CERNLIB_TCGEN_UBLOW
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncvx/keeporig/ubunch.F b/src/packlib/kernlib/kerngen/obsolete/kerncvx/keeporig/ubunch.F
deleted file mode 100644
index 261cce4..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncvx/keeporig/ubunch.F
+++ /dev/null
@@ -1,36 +0,0 @@
-*
-* $Id: ubunch.F,v 1.1.1.1 1996/02/15 17:52:29 mclareni Exp $
-*
-* $Log: ubunch.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:29 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE UBUNCH (V1, VM, NCH)
-C
-C CERN PROGLIB# M409 UBUNCH .VERSION KERNCVX 1.00 890315
-C ORIG. 15/03/89 JZ, CERN
-C
-C CONCENTRATES THE STRING OF HOLLERITH CHARACTERS FROM V1 INTO VM
-C
- CHARACTER*1 VM(*)
- CHARACTER*8 V1(*)
-
-
- DO 14 J=1,NCH
- 14 VM(J) = V1(J)(1:1)
-
-C-- Blank-fill last incomplete word
-
- NTRAIL = MOD (NCH,8)
- IF (NTRAIL.EQ.0) RETURN
-
- DO 17 J=NCH+1,NCH+8-NTRAIL
- 17 VM(J) = ' '
- RETURN
- END
-#ifdef CERNLIB_TCGEN_UBUNCH
-#undef CERNLIB_TCGEN_UBUNCH
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncvx/kerncvx/qmcv32.h b/src/packlib/kernlib/kerngen/obsolete/kerncvx/kerncvx/qmcv32.h
deleted file mode 100644
index 8b5e542..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncvx/kerncvx/qmcv32.h
+++ /dev/null
@@ -1,30 +0,0 @@
-*
-* $Id: qmcv32.h,v 1.1.1.1 1996/02/15 17:52:04 mclareni Exp $
-*
-* $Log: qmcv32.h,v $
-* Revision 1.1.1.1 1996/02/15 17:52:04 mclareni
-* Kernlib
-*
-*
-* This directory was created from kerncvx.car patch qmcv32
-#ifndef CERNLIB_B32
-#define CERNLIB_B32
-#endif
-#ifndef CERNLIB_A4
-#define CERNLIB_A4
-#endif
-#ifndef CERNLIB_HEX
-#define CERNLIB_HEX
-#endif
-* external names with underscores
-#ifndef CERNLIB_QX_SC
-#define CERNLIB_QX_SC
-#endif
-* MIL standard routines, IBITS, MVBITS, ISHFTC
-#ifndef CERNLIB_QMILSTD
-#define CERNLIB_QMILSTD
-#endif
-* ISA standard routines, ISHFT, IOR, etc
-#ifndef CERNLIB_QISASTD
-#define CERNLIB_QISASTD
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncvx/kerncvx/qmcv64.h b/src/packlib/kernlib/kerngen/obsolete/kerncvx/kerncvx/qmcv64.h
deleted file mode 100644
index 582fab8..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncvx/kerncvx/qmcv64.h
+++ /dev/null
@@ -1,45 +0,0 @@
-*
-* $Id: qmcv64.h,v 1.1.1.1 1996/02/15 17:52:04 mclareni Exp $
-*
-* $Log: qmcv64.h,v $
-* Revision 1.1.1.1 1996/02/15 17:52:04 mclareni
-* Kernlib
-*
-*
-* This directory was created from kerncvx.car patch qmcv64
-#ifndef CERNLIB_B64
-#define CERNLIB_B64
-#endif
-#ifndef CERNLIB_B60M
-#define CERNLIB_B60M
-#endif
-#ifndef CERNLIB_B48M
-#define CERNLIB_B48M
-#endif
-#ifndef CERNLIB_B36M
-#define CERNLIB_B36M
-#endif
-#ifndef CERNLIB_A8
-#define CERNLIB_A8
-#endif
-#ifndef CERNLIB_A6M
-#define CERNLIB_A6M
-#endif
-#ifndef CERNLIB_A5M
-#define CERNLIB_A5M
-#endif
-#ifndef CERNLIB_HEX
-#define CERNLIB_HEX
-#endif
-* external names with underscores
-#ifndef CERNLIB_QX_SC
-#define CERNLIB_QX_SC
-#endif
-* MIL standard routines, IBITS, MVBITS, ISHFTC
-#ifndef CERNLIB_QMILSTD
-#define CERNLIB_QMILSTD
-#endif
-* ISA standard routines, ISHFT, IOR, etc
-#ifndef CERNLIB_QISASTD
-#define CERNLIB_QISASTD
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncvx/qmcv32/q_jbit.inc b/src/packlib/kernlib/kerngen/obsolete/kerncvx/qmcv32/q_jbit.inc
deleted file mode 100644
index 648e5d1..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncvx/qmcv32/q_jbit.inc
+++ /dev/null
@@ -1,15 +0,0 @@
-*
-* $Id: q_jbit.inc,v 1.1.1.1 1996/02/15 17:52:11 mclareni Exp $
-*
-* $Log: q_jbit.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:52:11 mclareni
-* Kernlib
-*
-*
-*
-* q_jbit.inc
-*
-#if defined(CERNLIB_P5BOOT)
- JBIT (IZW,IZP) = IBITS (IZW,IZP-1,1)
- JBYT (IZW,IZP,NZB) = IBITS (IZW,IZP-1,NZB)
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncvx/qmcv32/q_jbytet.inc b/src/packlib/kernlib/kerngen/obsolete/kerncvx/qmcv32/q_jbytet.inc
deleted file mode 100644
index 6de50ef..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncvx/qmcv32/q_jbytet.inc
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: q_jbytet.inc,v 1.1.1.1 1996/02/15 17:52:13 mclareni Exp $
-*
-* $Log: q_jbytet.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:52:13 mclareni
-* Kernlib
-*
-*
-*
-* q_jbytet.inc
-*
-#if defined(CERNLIB_P5BOOT)
- JBYTET (MZ,IZW,IZP,NZB) = MZ .AND. IBITS(IZW,IZP-1,NZB)
- JBYTOR (MZ,IZW,IZP,NZB) = MZ .OR. IBITS(IZW,IZP-1,NZB)
-#ifndef CERNLIB_QDEFAULT
-#define CERNLIB_QDEFAULT
-#endif
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncvx/qmcv32/q_sbit.inc b/src/packlib/kernlib/kerngen/obsolete/kerncvx/qmcv32/q_sbit.inc
deleted file mode 100644
index 8dcd289..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncvx/qmcv32/q_sbit.inc
+++ /dev/null
@@ -1,15 +0,0 @@
-*
-* $Id: q_sbit.inc,v 1.1.1.1 1996/02/15 17:52:11 mclareni Exp $
-*
-* $Log: q_sbit.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:52:11 mclareni
-* Kernlib
-*
-*
-*
-* q_sbit.inc
-*
-#if defined(CERNLIB_P5BOOT)
- MSBIT0 (IZW,IZP) = IBCLR (IZW,IZP-1)
- MSBIT1 (IZW,IZP) = IBSET (IZW,IZP-1)
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncvx/qmcv32/q_shift.inc b/src/packlib/kernlib/kerngen/obsolete/kerncvx/qmcv32/q_shift.inc
deleted file mode 100644
index 3a5ba7a..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncvx/qmcv32/q_shift.inc
+++ /dev/null
@@ -1,15 +0,0 @@
-*
-* $Id: q_shift.inc,v 1.1.1.1 1996/02/15 17:52:11 mclareni Exp $
-*
-* $Log: q_shift.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:52:11 mclareni
-* Kernlib
-*
-*
-*
-* q_shift.inc
-*
-#if defined(CERNLIB_P5BOOT)
- ISHFTL (IZW,NZB) = ISHFT (IZW, NZB)
- ISHFTR (IZW,NZB) = ISHFT (IZW, -NZB)
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncvx/qmcv64/iallbl.inc b/src/packlib/kernlib/kerngen/obsolete/kerncvx/qmcv64/iallbl.inc
deleted file mode 100644
index 29fb639..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncvx/qmcv64/iallbl.inc
+++ /dev/null
@@ -1,15 +0,0 @@
-*
-* $Id: iallbl.inc,v 1.1.1.1 1996/02/15 17:52:07 mclareni Exp $
-*
-* $Log: iallbl.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:52:07 mclareni
-* Kernlib
-*
-*
-* set a word of all blanks
-*
-* iallbl.inc
-*
-#if defined(CERNLIB_P5BOOT)
- PARAMETER (IALLBL = '2020202020202020'X)
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncvx/qmcv64/q_jbit.inc b/src/packlib/kernlib/kerngen/obsolete/kerncvx/qmcv64/q_jbit.inc
deleted file mode 100644
index 1eaec3c..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncvx/qmcv64/q_jbit.inc
+++ /dev/null
@@ -1,15 +0,0 @@
-*
-* $Id: q_jbit.inc,v 1.1.1.1 1996/02/15 17:52:08 mclareni Exp $
-*
-* $Log: q_jbit.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:52:08 mclareni
-* Kernlib
-*
-*
-*
-* q_jbit.inc
-*
-#if defined(CERNLIB_P5BOOT)
- JBIT (IZW,IZP) = IBITS (IZW,IZP-1,1)
- JBYT (IZW,IZP,NZB) = IBITS (IZW,IZP-1,NZB)
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncvx/qmcv64/q_jbytet.inc b/src/packlib/kernlib/kerngen/obsolete/kerncvx/qmcv64/q_jbytet.inc
deleted file mode 100644
index cff0a79..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncvx/qmcv64/q_jbytet.inc
+++ /dev/null
@@ -1,15 +0,0 @@
-*
-* $Id: q_jbytet.inc,v 1.1.1.1 1996/02/15 17:52:10 mclareni Exp $
-*
-* $Log: q_jbytet.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:52:10 mclareni
-* Kernlib
-*
-*
-*
-* q_jbytet.inc
-*
-#if defined(CERNLIB_P5BOOT)
- JBYTET (MZ,IZW,IZP,NZB) = MZ .AND. IBITS(IZW,IZP-1,NZB)
- JBYTOR (MZ,IZW,IZP,NZB) = MZ .OR. IBITS(IZW,IZP-1,NZB)
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncvx/qmcv64/q_sbit.inc b/src/packlib/kernlib/kerngen/obsolete/kerncvx/qmcv64/q_sbit.inc
deleted file mode 100644
index 19c4e03..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncvx/qmcv64/q_sbit.inc
+++ /dev/null
@@ -1,15 +0,0 @@
-*
-* $Id: q_sbit.inc,v 1.1.1.1 1996/02/15 17:52:08 mclareni Exp $
-*
-* $Log: q_sbit.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:52:08 mclareni
-* Kernlib
-*
-*
-*
-* q_sbit.inc
-*
-#if defined(CERNLIB_P5BOOT)
- MSBIT0 (IZW,IZP) = IBCLR (IZW,IZP-1)
- MSBIT1 (IZW,IZP) = IBSET (IZW,IZP-1)
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncvx/qmcv64/q_shift.inc b/src/packlib/kernlib/kerngen/obsolete/kerncvx/qmcv64/q_shift.inc
deleted file mode 100644
index 2dcaf8a..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncvx/qmcv64/q_shift.inc
+++ /dev/null
@@ -1,15 +0,0 @@
-*
-* $Id: q_shift.inc,v 1.1.1.1 1996/02/15 17:52:08 mclareni Exp $
-*
-* $Log: q_shift.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:52:08 mclareni
-* Kernlib
-*
-*
-*
-* q_shift.inc
-*
-#if defined(CERNLIB_P5BOOT)
- ISHFTL (IZW,NZB) = ISHFT (IZW, NZB)
- ISHFTR (IZW,NZB) = ISHFT (IZW, -NZB)
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncvx/qmcv64/wordsizc.inc b/src/packlib/kernlib/kerngen/obsolete/kerncvx/qmcv64/wordsizc.inc
deleted file mode 100644
index c11e191..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncvx/qmcv64/wordsizc.inc
+++ /dev/null
@@ -1,15 +0,0 @@
-*
-* $Id: wordsizc.inc,v 1.1.1.1 1996/02/15 17:52:07 mclareni Exp $
-*
-* $Log: wordsizc.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:52:07 mclareni
-* Kernlib
-*
-*
-*
-* wordsizc.inc
-*
-#if defined(CERNLIB_P5BOOT)
-#define NBITPW 64 /* Number of bits per word */
-#define NBYTPW 8 /* Number of bytes per word */
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncvx/qmcv64/wordsize.inc b/src/packlib/kernlib/kerngen/obsolete/kerncvx/qmcv64/wordsize.inc
deleted file mode 100644
index b875264..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncvx/qmcv64/wordsize.inc
+++ /dev/null
@@ -1,14 +0,0 @@
-*
-* $Id: wordsize.inc,v 1.1.1.1 1996/02/15 17:52:07 mclareni Exp $
-*
-* $Log: wordsize.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:52:07 mclareni
-* Kernlib
-*
-*
-*
-* wordsize.inc
-*
-#if defined(CERNLIB_P5BOOT)
- PARAMETER (NBITPW=64, NCHAPW=8, NBITPC=8)
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncvx/speed/jbit.F b/src/packlib/kernlib/kerngen/obsolete/kerncvx/speed/jbit.F
deleted file mode 100644
index 05df4b2..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncvx/speed/jbit.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: jbit.F,v 1.1.1.1 1996/02/15 17:52:30 mclareni Exp $
-*
-* $Log: jbit.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:30 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- FUNCTION JBIT (IW,J)
-C
-C CERN PROGLIB# M421 JBIT .VERSION KERNCVX 1.00 890315
-C ORIG. 01/01/89 AGA+MAV, Convex
-C
- JBYT = IBITS (IW,J-1,1)
- RETURN
- END
-#ifdef CERNLIB_TCGEN_JBIT
-#undef CERNLIB_TCGEN_JBIT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncvx/speed/jbyt.F b/src/packlib/kernlib/kerngen/obsolete/kerncvx/speed/jbyt.F
deleted file mode 100644
index bedcb21..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncvx/speed/jbyt.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: jbyt.F,v 1.1.1.1 1996/02/15 17:52:30 mclareni Exp $
-*
-* $Log: jbyt.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:30 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- FUNCTION JBYT (IW,J,NBITS)
-C
-C CERN PROGLIB# M421 JBYT .VERSION KERNCVX 1.00 890315
-C ORIG. 01/01/89 AGA+MAV, Convex
-C
- JBYT = IBITS(IW,J-1,NBITS)
- RETURN
- END
-#ifdef CERNLIB_TCGEN_JBYT
-#undef CERNLIB_TCGEN_JBYT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncvx/speed/sbit.F b/src/packlib/kernlib/kerngen/obsolete/kerncvx/speed/sbit.F
deleted file mode 100644
index ce4b8a2..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncvx/speed/sbit.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: sbit.F,v 1.1.1.1 1996/02/15 17:52:30 mclareni Exp $
-*
-* $Log: sbit.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:30 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE SBIT (IA,IX,J)
-C
-C CERN PROGLIB# M421 SBIT .VERSION KERNCVX 1.00 890315
-C ORIG. 01/01/89 AGA+MAV, Convex
-C
-
- IF (BTEST(IA,0)) THEN
- IX=IBSET(IX,J-1)
- ELSE
- IX=IBCLR(IX,J-1)
- ENDIF
- RETURN
- END
-#ifdef CERNLIB_TCGEN_SBIT
-#undef CERNLIB_TCGEN_SBIT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncvx/speed/sbit0.F b/src/packlib/kernlib/kerngen/obsolete/kerncvx/speed/sbit0.F
deleted file mode 100644
index fcdce33..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncvx/speed/sbit0.F
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: sbit0.F,v 1.1.1.1 1996/02/15 17:52:30 mclareni Exp $
-*
-* $Log: sbit0.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:30 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE SBIT0(IX,J)
-C
-C CERN PROGLIB# M421 SBIT0 .VERSION KERNCVX 1.00 890315
-C ORIG. 01/01/89 AGA+MAV, Convex
-C
-
- IX = IBCLR(IX,J-1)
-
- RETURN
- END
-#ifdef CERNLIB_TCGEN_SBIT0
-#undef CERNLIB_TCGEN_SBIT0
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncvx/speed/sbit1.F b/src/packlib/kernlib/kerngen/obsolete/kerncvx/speed/sbit1.F
deleted file mode 100644
index 51a1335..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncvx/speed/sbit1.F
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: sbit1.F,v 1.1.1.1 1996/02/15 17:52:30 mclareni Exp $
-*
-* $Log: sbit1.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:30 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE SBIT1 (IX,J)
-C
-C CERN PROGLIB# M421 SBIT1 .VERSION KERNCVX 1.00 890315
-C ORIG. 01/01/89 AGA+MAV, Convex
-C
-
- IX = IBSET(IX,J-1)
-
- RETURN
- END
-#ifdef CERNLIB_TCGEN_SBIT1
-#undef CERNLIB_TCGEN_SBIT1
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncvx/testie3/tieeed.F b/src/packlib/kernlib/kerngen/obsolete/kerncvx/testie3/tieeed.F
deleted file mode 100644
index c6e0ee9..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncvx/testie3/tieeed.F
+++ /dev/null
@@ -1,314 +0,0 @@
-*
-* $Id: tieeed.F,v 1.1.1.1 1996/02/15 17:52:30 mclareni Exp $
-*
-* $Log: tieeed.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:30 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- PROGRAM TEST
-
-C-- converted values = IEEE
- INTEGER*8 IOVPCD, IOVNCD, IBADCD, IONECD, IZERCD
- PARAMETER (IOVPCD = '7FF0000000000000'X)
- PARAMETER (IOVNCD = 'FFF0000000000000'X)
- PARAMETER (IBADCD = '7FF01FC000000000'X)
- PARAMETER (IONECD = '3FF0000000000000'X)
- PARAMETER (IZERCD = '8000000000000000'X)
-
-C-- machine values = native
- INTEGER*8 IOVPMD, IOVNMD, IBADMD
- PARAMETER (IOVPMD = '7FF7FFFFFFFFFFFF'X)
- PARAMETER (IOVNMD = 'FFF7FFFFFFFFFFFF'X)
- PARAMETER (IBADMD = '80007FFFFFFFFFFF'X)
-
- INTEGER*8 MSKSIG, MSK32R
- PARAMETER (MSKSIG = 'FFFFFFFFFFFFFFF0'X)
- PARAMETER (MSK32R = '00000000FFFFFFFF'X)
-
- PARAMETER (NEL = 328)
- PARAMETER (NED = 2*NEL)
-
- REAL*8 ORG(NEL), ORGPR(NEL)
- INTEGER*8 IORG(NEL)
- EQUIVALENCE (IORG,ORG)
-
- REAL*8 TONEW(NEL), FRNEW(NEL)
- INTEGER*8 ITONEW(NEL),IFRNEW(NEL)
- EQUIVALENCE (ITONEW,TONEW)
- EQUIVALENCE (IFRNEW,FRNEW)
-
- CHARACTER CBADTO(NEL)*5, CBADFR(NEL)*5, CNOTE(NEL)*20
-
- CHARACTER CHPG*1
- CHARACTER CHDATE*8, CHTIME*8
- DIMENSION MDATE(2), MTIME(2)
- EQUIVALENCE (CHDATE,MDATE), (CHTIME,MTIME)
-
- INTEGER*4 NEXP(NEL)
- REAL*8 VAL, VALU, FACT
- DIMENSION MTRANA(NED), MTRANB(NED)
-
- INTEGER*8 MSPEC(5), MIEEE(5)
-
-C-- Test top of range
- DATA MSPEC(1) / '7FBFFFFFFFFFFFFF'X /
- DATA MSPEC(2) / '7FCFFFFFFFFFFFFF'X /
- DATA MSPEC(3) / '7FDFFFFFFFFFFFFF'X /
- DATA MSPEC(4) / '7FEFFFFFFFFFFFFF'X /
-C-- Special cases
- DATA MSPEC(5) / 'C000000000000000'X /
-
-C-- Test top of range
- DATA MIEEE(1) / '7FE7777777777777'X /
- DATA MIEEE(2) / '7FE0000077777777'X /
-C-- Test bottom of range
- DATA MIEEE(3) / '0010000100000000'X /
- DATA MIEEE(4) / '0001000000000000'X /
- DATA MIEEE(5) / '8000000000000000'X /
-
-
-#if defined(CERNLIB_QMCV64)
- OPEN (6,FILE='tie3d_64.lis',STATUS='UNKNOWN')
- 9001 FORMAT ('1Program TIEEED 64-bit executing'/1X)
-#endif
-#if defined(CERNLIB_QMCV32)
- OPEN (6,FILE='tie3d_32.lis',STATUS='UNKNOWN')
- 9001 FORMAT ('1Program TIEEED 32-bit executing'/1X)
-#endif
-
- ITER = 0
- 12 WRITE (6,9001)
-
- DO 13 J=1,NEL
- CBADTO(J) = ' '
- CBADFR(J) = ' '
- 13 CNOTE(J) = ' '
- JWHICH = 0
-
- FACT = 2.**60
- VAL = 17.123456789012D0
- VAL = VAL * FACT
-
- DO 14 I=1,NEL
- FACT = 1.0D0 + FLOAT(I) * 0.00001D0
- VALU = VAL * FACT
- IF (ITER.EQ.0) THEN
- ORG(I)= VALU
- ELSE
- ORG(I)= -VALU
- ENDIF
- VAL = VAL/2.
- 14 CONTINUE
-
-C-- Special values
-
- CNOTE(32) = '-> high CVX range'
- IORG(32) = MSPEC(1)
- IORG(33) = MSPEC(2)
- IORG(34) = MSPEC(3)
- IORG(35) = MSPEC(4)
- CBADTO(32)(4:4) = '!'
- CBADTO(33)(4:4) = '!'
- CBADTO(34)(4:4) = '!'
- CBADTO(35)(4:4) = '!'
-
- CNOTE(71) = '-> exact 1.0'
- ORG(71) = 1.0D0
- ORG(72) = 1.0D0
- CBADTO(71)(4:4) = '!'
- CBADTO(72)(4:4) = '!'
-
- CNOTE(97) = '-> NaN'
- IORG(97) = IBADMD
- CBADTO(97)(4:4) = '!'
-
- CNOTE(144) = '-> +ve overflow'
- IORG(144) = IOVPMD
- CBADTO(144)(4:4) = '!'
-
- CNOTE(184) = '-> -ve overflow'
- IORG(184) = IOVNMD
- CBADTO(184)(4:4) = '!'
-
- CNOTE(161) = '-> test zero'
- IORG(161) = 0
- IORG(162) = 0
- CBADTO(161)(4:4) = '!'
-
-#if defined(CERNLIB_QMCV64)
- CALL UCOPY (ORG,ORGPR,NEL)
-#endif
-#if defined(CERNLIB_QMCV32)
- CALL UCOPY (ORG,ORGPR,NED)
-#endif
-
-C---- 'Writing'
-
- NDN = 0
- NUSE = 0
- 42 NUSE = NUSE + 1
- IF (NUSE.EQ.11) NUSE = 41
- NWDS = MIN (NEL-NDN,NUSE)
- CBADTO(NDN+1)(1:1) = '.'
-
- CALL VZERO (MTRANA,NED)
-#if defined(CERNLIB_QMCV64)
- CALL UCOCOP (IORG(NDN+1),MTRANA,NWDS,1,1,2)
-#endif
-#if defined(CERNLIB_QMCV32)
- CALL UCOPY (IORG(NDN+1),MTRANA,2*NWDS)
-#endif
- MTRANB(2*NWDS+1) = 77
- CALL IE3FOD (MTRANA,MTRANB,NWDS,JBAD)
- IF (JBAD.LT.0 .OR. JBAD.GT.NWDS) GO TO 82
- IF (JBAD.NE.0) CBADTO(NDN+JBAD)(3:3) = 't'
- IF (MTRANB(2*NWDS+1).NE.77) GO TO 91
-
-#if defined(CERNLIB_QMCV64)
- JTAK = 1
- JPUT = NDN + 1
- DO 44 J=1,NWDS
- ITONEW(JPUT) = ISHFT (MTRANB(JTAK),32) .OR. MTRANB(JTAK+1)
- JTAK = JTAK + 2
- 44 JPUT = JPUT + 1
-#endif
-#if defined(CERNLIB_QMCV32)
- CALL UCOPY (MTRANB,ITONEW(NDN+1),2*NWDS)
-#endif
-
- NDN = NDN + NWDS
- IF (NDN.LT.NEL) GO TO 42
-
-C-- Special values
-
- CNOTE(51) = '<- +ve overflow'
- CNOTE(52) = '<- -ve overflow'
- ITONEW(51) = IOVPCD
- ITONEW(52) = IOVNCD
- CBADTO(51)(4:4) = ':'
- CBADTO(52)(4:4) = ':'
-
- CNOTE(61) = '<- NaN'
- ITONEW(61) = IBADCD
- CBADTO(61)(4:4) = ':'
-
- CNOTE(72) = '<- exact 1.0'
- ITONEW(72) = IONECD
- CBADTO(72)(4:4) = ':'
-
- CNOTE(81) = '<- high IEEE range'
- ITONEW(81) = MIEEE(1)
- ITONEW(82) = MIEEE(2)
- CBADTO(81)(4:4) = ':'
- CBADTO(82)(4:4) = ':'
-
- CNOTE(85) = '<- low IEEE range'
- ITONEW(85) = MIEEE(3)
- ITONEW(86) = MIEEE(4)
- CBADTO(85)(4:4) = ':'
- CBADTO(86)(4:4) = ':'
-
- CNOTE(162) = '<- test -0.0'
- ITONEW(162) = IZERCD
- CBADTO(162)(4:4) = ':'
-
-C---- 'reading'
-
- NDN = 0
- NUSE = 0
- 52 NUSE = NUSE + 1
- IF (NUSE.EQ.11) NUSE = 41
- NWDS = MIN (NEL-NDN,NUSE)
-
- CALL VZERO (MTRANA,NED)
-#if defined(CERNLIB_QMCV64)
- JTAK = NDN + 1
- JPUT = 0
- DO 54 J=1,NWDS
- MTRANA(JPUT+1) = ISHFT (ITONEW(JTAK),-32)
- MTRANA(JPUT+2) = ITONEW(JTAK) .AND. MSK32R
- JTAK = JTAK + 1
- 54 JPUT = JPUT + 2
-#endif
-#if defined(CERNLIB_QMCV32)
- CALL UCOPY (ITONEW(NDN+1),MTRANA,2*NWDS)
-#endif
- MTRANB(2*NWDS+1) = 77
- CALL IE3TOD (MTRANA,MTRANB,NWDS,JBAD)
- IF (JBAD.LT.0 .OR. JBAD.GT.NWDS) GO TO 84
- IF (JBAD.NE.0) CBADFR(NDN+JBAD)(2:2) = 'f'
- IF (MTRANB(2*NWDS+1).NE.77) GO TO 92
-
-#if defined(CERNLIB_QMCV64)
- CALL UCOCOP (MTRANB,IFRNEW(NDN+1),NWDS,1,2,1)
-#endif
-#if defined(CERNLIB_QMCV32)
- CALL UCOPY (MTRANB,IFRNEW(NDN+1),2*NWDS)
-#endif
-
- NDN = NDN + NWDS
- IF (NDN.LT.NEL) GO TO 52
-
-C---- Compare and print
-
- DO 69 I=1,NEL
-
- IF ((IFRNEW(I).AND.MSKSIG) .NE. (IORG(I).AND.MSKSIG))
- + CBADFR(I)(4:4) = 'N'
-
-#if defined(CERNLIB_QMCV64)
- NEXP(I) = JBYT (IORG(I),53,11) - 1024
-#endif
-#if defined(CERNLIB_QMCV32)
- NEXP(I) = JBYT (IORG(I),21,11) - 1024
-#endif
- 69 CONTINUE
-
- CHPG = ' '
- IE = 0
- 71 N = MIN (NEL-IE,50)
- IA = IE + 1
- IE = IE + N
-
- WRITE (6,9071) CHPG
- CHPG = '1'
-
- WRITE (6,9074)
- + (I,CBADTO(I),ORGPR(I),NEXP(I),
- + IORG(I),IFRNEW(I),ITONEW(I),
- + CBADFR(I), CNOTE(I),
- + I=IA,IE)
- IF (IE.LT.NEL) GO TO 71
-
- 9071 FORMAT (A,' bad ',13X,
- F'exp',10X,'original',10X,'frnew',13X,'tonew',7X,'flags')
- 9074 FORMAT (/I4,A,D11.4,I5,3Z18.16,1X,A,1X,A)
-
- CALL KERNGT (6)
- CALL DATIMH (MDATE, MTIME)
- WRITE (6,9079) CHDATE,CHTIME
- 9079 FORMAT (10X,'Today : ',A,2X,A)
-
- IF (ITER.NE.0) STOP
- ITER = 7
- GO TO 12
-
- 84 JWHICH = 1
- 83 JWHICH = JWHICH + 1
- 82 JWHICH = JWHICH + 1
- 81 JWHICH = JWHICH + 1
- WRITE (6,9081) JWHICH
- 9081 FORMAT (' Faulty JBAD from',I2)
- STOP
-
- 91 WRITE (6,9091) NDN,NWDS
- 9091 FORMAT (1X/' IE3FOD overshoots for NDN/NWDS =',2I5)
- STOP
-
- 92 WRITE (6,9092) NDN,NWDS
- 9092 FORMAT (1X/' IE3TOD overshoots for NDN/NWDS =',2I5)
- STOP
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerncvx/testie3/tieees.F b/src/packlib/kernlib/kerngen/obsolete/kerncvx/testie3/tieees.F
deleted file mode 100644
index 20e26cf..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerncvx/testie3/tieees.F
+++ /dev/null
@@ -1,308 +0,0 @@
-*
-* $Id: tieees.F,v 1.1.1.1 1996/02/15 17:52:30 mclareni Exp $
-*
-* $Log: tieees.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:30 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- PROGRAM TEST
-
-#if defined(CERNLIB_QMCV64)
-C-- converted values = IEEE
- PARAMETER (IOVPCS = '000000007F800000'X)
- PARAMETER (IOVNCS = '00000000FF800000'X)
- PARAMETER (IBADCS = '000000007F80FE00'X)
- PARAMETER (IONECS = '000000003F800000'X)
- PARAMETER (IZERCS = '0000000080000000'X)
-
-C-- machine values = native
- PARAMETER (IOVPMS = '7FF7FFFFFFFFFFFF'X)
- PARAMETER (IOVNMS = 'FFF7FFFFFFFFFFFF'X)
- PARAMETER (IBADMS = '80007FFFFFFFFFFF'X)
- PARAMETER (MSKSIG = 'FFFFFFFE00000000'X)
-#endif
-#if defined(CERNLIB_QMCV32)
-C-- converted values = IEEE
- PARAMETER (IOVPCS = '7F800000'X)
- PARAMETER (IOVNCS = 'FF800000'X)
- PARAMETER (IBADCS = '7F80FE00'X)
- PARAMETER (IONECS = '3F800000'X)
- PARAMETER (IZERCS = '80000000'X)
-
-C-- machine values = native
- PARAMETER (IOVPMS = '7FBFFFFF'X)
- PARAMETER (IOVNMS = 'FFBFFFFF'X)
- PARAMETER (IBADMS = '80007FFF'X)
- PARAMETER (MSKSIG = 'FFFFFFFE'X)
-#endif
-
- PARAMETER (NEL = 220)
-
- DIMENSION ORG(NEL), ORGPR(NEL)
- DIMENSION IORG(NEL)
- EQUIVALENCE (IORG,ORG)
-
- DIMENSION TONEW(NEL), FRNEW(NEL)
- DIMENSION ITONEW(NEL),IFRNEW(NEL)
- EQUIVALENCE (ITONEW,TONEW)
- EQUIVALENCE (IFRNEW,FRNEW)
-
- CHARACTER CBADTO(NEL)*5, CBADFR(NEL)*5, CNOTE(NEL)*20
-
- CHARACTER CHPG*1
- CHARACTER CHDATE*8, CHTIME*8
- DIMENSION MDATE(2), MTIME(2)
- EQUIVALENCE (CHDATE,MDATE), (CHTIME,MTIME)
-
- INTEGER*4 NEXP(NEL)
-
- DIMENSION MSPEC(11)
-
-#if defined(CERNLIB_QMCV64)
-C-- Test top of range
- DATA MSPEC(1) / '47CFFFFFFFFFFFFF'X /
- DATA MSPEC(2) / '47DFFFFFFFFFFFFF'X /
- DATA MSPEC(3) / '47EFFFFFFFFFFFFF'X /
- DATA MSPEC(4) / '47FFFFFFFFFFFFFF'X /
-C-- Special cases
- DATA MSPEC(5) / '80007FFFFFFFFFFF'X /
- DATA MSPEC(6) / '7FF7FFFFFFFFFFFF'X /
- DATA MSPEC(7) / 'FFF7FFFFFFFFFFFF'X /
-C-- Bottom of range
- DATA MSPEC(8) / '3830000000000000'X /
- DATA MSPEC(9) / '3820000000000000'X /
- DATA MSPEC(10) / '3810000000000000'X /
- DATA MSPEC(11) / '3800000000000000'X /
-#endif
-#if defined(CERNLIB_QMCV32)
-C-- Test top of range
- DATA MSPEC(1) / '7DFFFFFF'X /
- DATA MSPEC(2) / '7E7FFFFF'X /
- DATA MSPEC(3) / '7EFFFFFF'X /
- DATA MSPEC(4) / '7F7FFFFF'X /
-C-- Special cases
- DATA MSPEC(5) / '80007FFF'X /
- DATA MSPEC(6) / '7FBFFFFF'X /
- DATA MSPEC(7) / 'FFBFFFFF'X /
-C-- Bottom of range
- DATA MSPEC(8) / '00A00000'X /
- DATA MSPEC(9) / '00800000'X /
- DATA MSPEC(10) / '00400000'X /
- DATA MSPEC(11) / '00200000'X /
-#endif
-
-
-#if defined(CERNLIB_QMCV64)
- OPEN (6,FILE='tie3s_64.lis',STATUS='UNKNOWN')
- 9001 FORMAT ('1Program TIEEES 64-bit executing'/1X)
-#endif
-#if defined(CERNLIB_QMCV32)
- OPEN (6,FILE='tie3s_32.lis',STATUS='UNKNOWN')
- 9001 FORMAT ('1Program TIEEES 32-bit executing'/1X)
-#endif
-
- ITER = 0
- 12 WRITE (6,9001)
-
- DO 13 J=1,NEL
- CBADTO(J) = ' '
- CBADFR(J) = ' '
- 13 CNOTE(J) = ' '
- JWHICH = 0
-
- FACT = 2.**60
- VAL = 17.123456789012
- VAL = VAL * FACT
-
- DO 14 I=1,NEL
- FACT = 1.0 + FLOAT(I) * 0.00001
- VALU = VAL * FACT
- IF (ITER.EQ.0) THEN
- ORG(I)= VALU
- ELSE
- ORG(I)= -VALU
- ENDIF
- VAL = VAL/2.
- 14 CONTINUE
-
-C-- Special values
-
- CNOTE(32) = '-> high range'
- IF (ITER.EQ.0) THEN
- CALL UCOPY (MSPEC,IORG(32),4)
- ELSE
- CALL VCOPYN (MSPEC,IORG(32),4)
- ENDIF
- CBADTO(32)(4:4) = '!'
- CBADTO(33)(4:4) = '!'
- CBADTO(34)(4:4) = '!'
- CBADTO(35)(4:4) = '!'
-
- CNOTE(71) = '-> exact 1.0'
- ORG(71) = 1.0
- ORG(72) = 1.0
- CBADTO(71)(4:4) = '!'
- CBADTO(72)(4:4) = '!'
-
- CNOTE(97) = '-> NaN'
- IORG(97) = IBADMS
- CBADTO(97)(4:4) = '!'
-
- CNOTE(144) = '-> +ve overflow'
- IORG(144) = IOVPMS
- CBADTO(144)(4:4) = '!'
-
- CNOTE(184) = '-> -ve overflow'
- IORG(184) = IOVNMS
- CBADTO(184)(4:4) = '!'
-
- CNOTE(161) = '-> test zero'
- IORG(161) = 0
- IORG(162) = 0
- CBADTO(161)(4:4) = '!'
-
- CNOTE(171) = '-> low range'
- IF (ITER.EQ.0) THEN
- CALL UCOPY (MSPEC(8),IORG(171),4)
- ELSE
- CALL VCOPYN (MSPEC(8),IORG(171),4)
- ENDIF
- CBADTO(171)(4:4) = '!'
- CBADTO(172)(4:4) = '!'
- CBADTO(173)(4:4) = '!'
- CBADTO(174)(4:4) = '!'
-
- CALL UCOPY (ORG,ORGPR,NEL)
-
-C---- 'Writing'
-
- NDN = 0
- NUSE = 0
- 42 NUSE = NUSE + 1
- IF (NUSE.EQ.11) NUSE = 41
- NWDS = MIN (NEL-NDN,NUSE)
- JTE = NDN + NWDS + 1
- IF (JTE.GT.NEL) JTE = 0
- CBADTO(NDN+1)(1:1) = '.'
-
- IF (JTE.NE.0) ITONEW(JTE) = 77
- CALL IE3FOS (ORG(NDN+1),TONEW(NDN+1),NWDS,JBAD)
- IF (JBAD.LT.0 .OR. JBAD.GT.NWDS) GO TO 82
- IF (JBAD.NE.0) CBADTO(NDN+JBAD)(3:3) = 't'
- IF (JTE.NE.0) THEN
- IF (ITONEW(JTE).NE.77) GO TO 91
- ENDIF
-
- NDN = NDN + NWDS
- IF (NDN.LT.NEL) GO TO 42
-
-C-- Special values
-
- CNOTE(51) = '<- +ve overflow'
- CNOTE(52) = '<- -ve overflow'
- ITONEW(51) = IOVPCS
- ITONEW(52) = IOVNCS
- CBADTO(51)(4:4) = ':'
- CBADTO(52)(4:4) = ':'
-
- CNOTE(61) = '<- NaN'
- ITONEW(61) = IBADCS
- CBADTO(61)(4:4) = ':'
-
- CNOTE(72) = '<- exact 1.0'
- ITONEW(72) = IONECS
- CBADTO(72)(4:4) = ':'
-
- CNOTE(162) = '<- test -0.0'
- ITONEW(162) = IZERCS
- CBADTO(162)(4:4) = ':'
-
-C---- 'reading'
-
- NDN = 0
- NUSE = 0
- 52 NUSE = NUSE + 1
- IF (NUSE.EQ.11) NUSE = 41
- NWDS = MIN (NEL-NDN,NUSE)
- JTE = NDN + NWDS + 1
- IF (JTE.GT.NEL) JTE = 0
-
- IF (JTE.NE.0) IFRNEW(JTE) = 77
- CALL IE3TOS (TONEW(NDN+1),FRNEW(NDN+1),NWDS,JBAD)
- IF (JBAD.LT.0 .OR. JBAD.GT.NWDS) GO TO 84
- IF (JBAD.NE.0) CBADFR(NDN+JBAD)(2:2) = 'f'
- IF (JTE.NE.0) THEN
- IF (IFRNEW(JTE).NE.77) GO TO 92
- ENDIF
-
- NDN = NDN + NWDS
- IF (NDN.LT.NEL) GO TO 52
-
-C---- Compare and print
-
- DO 69 I=1,NEL
-
- IF ((IFRNEW(I).AND.MSKSIG) .NE. (IORG(I).AND.MSKSIG))
- + CBADFR(I)(4:4) = 'N'
-
-#if defined(CERNLIB_QMCV64)
- NEXP(I) = JBYT (IORG(I),53,11) - 1024
-#endif
-#if defined(CERNLIB_QMCV32)
- NEXP(I) = JBYT (IORG(I),24,9) - 128
-#endif
- 69 CONTINUE
-
- CHPG = ' '
- IE = 0
- 71 N = MIN (NEL-IE,50)
- IA = IE + 1
- IE = IE + N
-
- WRITE (6,9071) CHPG
- CHPG = '1'
-
- WRITE (6,9074)
- + (I,CBADTO(I),ORGPR(I),NEXP(I),
- + IORG(I),IFRNEW(I),ITONEW(I),
- + CBADFR(I), CNOTE(I),
- + I=IA,IE)
- IF (IE.LT.NEL) GO TO 71
-
- 9071 FORMAT (A,' bad ',13X,
- F'exp',10X,'original',10X,'frnew',13X,'tonew',7X,'flags')
-#if defined(CERNLIB_QMCV64)
- 9074 FORMAT (/I4,A,E11.4,I5,3Z18.16,1X,A,1X,A)
-#endif
-#if defined(CERNLIB_QMCV32)
- 9074 FORMAT ((/I4,A,E11.4,I5,3(10X,Z8.8),1X,A,1X,A))
-#endif
-
- CALL KERNGT (6)
- CALL DATIMH (MDATE, MTIME)
- WRITE (6,9079) CHDATE,CHTIME
- 9079 FORMAT (10X,'Today : ',A,2X,A)
-
- IF (ITER.NE.0) STOP
- ITER = 7
- GO TO 12
-
- 84 JWHICH = 1
- 83 JWHICH = JWHICH + 1
- 82 JWHICH = JWHICH + 1
- 81 JWHICH = JWHICH + 1
- WRITE (6,9081) JWHICH
- 9081 FORMAT (' Faulty JBAD from',I2)
- STOP
-
- 91 WRITE (6,9091) NDN,NWDS
- 9091 FORMAT (1X/' IE3FOS overshoots for NDN/NWDS =',2I5)
- STOP
-
- 92 WRITE (6,9092) NDN,NWDS
- 9092 FORMAT (1X/' IE3TOS overshoots for NDN/NWDS =',2I5)
- STOP
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerndge/dgegs/Imakefile b/src/packlib/kernlib/kerngen/obsolete/kerndge/dgegs/Imakefile
deleted file mode 100644
index 7ffecdf..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerndge/dgegs/Imakefile
+++ /dev/null
@@ -1,8 +0,0 @@
-SRCS_F= \ @@\
- cbyt.F gshow.F iuforw.F iumode.F kerngt.F locb.F locf.F xinb.F \ @@\
- xinbs.F
-
-SRCS_S= \ @@\
- ublow.s ubunch.s ucopy2.s uctoh.s uctoh1.s uh1toc.s uhtoc.s
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerndge/dgegs/cbyt.F b/src/packlib/kernlib/kerngen/obsolete/kerndge/dgegs/cbyt.F
deleted file mode 100644
index 9718b33..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerndge/dgegs/cbyt.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: cbyt.F,v 1.1.1.1 1996/02/15 17:54:25 mclareni Exp $
-*
-* $Log: cbyt.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:25 mclareni
-* Kernlib
-*
-*
-#include "kerndge/pilot.h"
- SUBROUTINE CBYT (IA,LA,IZW,IZP,NZB)
-C
-C CERN PROGLIB# M421 CBYT .VERSION KERNDGE 1.01 860217
-C ORIG. 03/02/86 JZ
-C
-C
- CALL MVBITS (IA,LA-1,NZB,IZW,IZP-1)
- RETURN
- END
-#ifdef CERNLIB_TCGEN_CBYT
-#undef CERNLIB_TCGEN_CBYT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerndge/dgegs/gshow.F b/src/packlib/kernlib/kerngen/obsolete/kerndge/dgegs/gshow.F
deleted file mode 100644
index 568d452..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerndge/dgegs/gshow.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: gshow.F,v 1.1.1.1 1996/02/15 17:54:25 mclareni Exp $
-*
-* $Log: gshow.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:25 mclareni
-* Kernlib
-*
-*
-#include "kerndge/pilot.h"
- SUBROUTINE GSHOW (LUN)
-C
-C CERN PROGLIB# Z001 GSHOW .VERSION KERNDGE 1.01 860217
-C ORIG. 03/02/86 JZ
-C
-C-- STORE PAM TITLE INTO /SLATE/ FOR PRINTING BY GSHOWF
-C
- COMMON /SLATE/ CH(40)
-C
- CALL UBLOW (
- + 40H CPP_TITLE
- +, CH,40)
- CALL GSHOWF (LUN)
- RETURN
- END
-#ifdef CERNLIB_TCGEN_GSHOW
-#undef CERNLIB_TCGEN_GSHOW
-#endif
-#include "kerndge/TITLE.kerndge"
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerndge/dgegs/iuforw.F b/src/packlib/kernlib/kerngen/obsolete/kerndge/dgegs/iuforw.F
deleted file mode 100644
index 364bcb3..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerndge/dgegs/iuforw.F
+++ /dev/null
@@ -1,38 +0,0 @@
-*
-* $Id: iuforw.F,v 1.1.1.1 1996/02/15 17:54:26 mclareni Exp $
-*
-* $Log: iuforw.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:26 mclareni
-* Kernlib
-*
-*
-#include "kerndge/pilot.h"
- FUNCTION IUFORW (IC,JL,JR)
-C
-C CERN PROGLIB# M410 IUFORW .VERSION KERNDGE 1.01 860217
-C ORIG. 03/02/86 JZ
-C
- DIMENSION IC(99)
- COMMON /SLATE/ ND,JEND, DUMMY(38)
-
- ND = 0
- JEND = JL
- IVAL = 0
-
- 12 IF (JEND.GT.JR) GO TO 20
- K = ISHFT (IC(JEND),-24)
- IF (K.EQ.32) GO TO 19
- IF (K.GE.58) GO TO 20
- K = K - 48
- IF (K.LT.0) GO TO 20
- IVAL = 10*IVAL + K
- ND = ND + 1
- 19 JEND = JEND + 1
- GO TO 12
-
- 20 IUFORW = IVAL
- RETURN
- END
-#ifdef CERNLIB_TCGEN_IUFORW
-#undef CERNLIB_TCGEN_IUFORW
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerndge/dgegs/iumode.F b/src/packlib/kernlib/kerngen/obsolete/kerndge/dgegs/iumode.F
deleted file mode 100644
index a5c2aa3..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerndge/dgegs/iumode.F
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: iumode.F,v 1.1.1.1 1996/02/15 17:54:26 mclareni Exp $
-*
-* $Log: iumode.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:26 mclareni
-* Kernlib
-*
-*
-#include "kerndge/pilot.h"
- FUNCTION IUMODE (IWORD)
-C
-C CERN PROGLIB# M506 IUMODE .VERSION KERNDGE 1.01 860217
-C ORIG. 03/02/86 JZ
-C
-C
- J = ISHFT (IWORD,-24)
- IF (J.EQ. 255) J=0
-C
- IUMODE= J
- RETURN
- END
-#ifdef CERNLIB_TCGEN_IUMODE
-#undef CERNLIB_TCGEN_IUMODE
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerndge/dgegs/kerngt.F b/src/packlib/kernlib/kerngen/obsolete/kerndge/dgegs/kerngt.F
deleted file mode 100644
index 55e3414..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerndge/dgegs/kerngt.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: kerngt.F,v 1.1.1.1 1996/02/15 17:54:25 mclareni Exp $
-*
-* $Log: kerngt.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:25 mclareni
-* Kernlib
-*
-*
-#include "kerndge/pilot.h"
- SUBROUTINE KERNGT (LUN)
-C
-C CERN PROGLIB# Z001 KERNGT .VERSION KERNDGE 1.07 891003
-C ORIG. 16/03/89 JZ
-C
-C-- Store Pam title into /SLATE/ for printing by GSHOWF
-C
- COMMON /SLATE/ MCH(40)
-
- CALL UBLOW (
- + 40H CPP_TITLE
- +, MCH,40)
- CALL GSHOWF (LUN)
- RETURN
- END
-#ifdef CERNLIB_TCGEN_KERNGT
-#undef CERNLIB_TCGEN_KERNGT
-#endif
-#include "kerndge/TITLE.kerndge"
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerndge/dgegs/locb.F b/src/packlib/kernlib/kerngen/obsolete/kerndge/dgegs/locb.F
deleted file mode 100644
index 4a20723..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerndge/dgegs/locb.F
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: locb.F,v 1.1.1.1 1996/02/15 17:54:26 mclareni Exp $
-*
-* $Log: locb.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:26 mclareni
-* Kernlib
-*
-*
-#include "kerndge/pilot.h"
- FUNCTION LOCB (AM)
-C
-C CERN PROGLIB# LOCB .VERSION KERNDGE 1.08 891120
-C ORIG. 17/11/89 JZ
-C
- BYTE AM(8)
-
- LOCB= BYTEADDR (AM(1))
- RETURN
- END
-#ifdef CERNLIB_TCGEN_LOCB
-#undef CERNLIB_TCGEN_LOCB
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerndge/dgegs/locf.F b/src/packlib/kernlib/kerngen/obsolete/kerndge/dgegs/locf.F
deleted file mode 100644
index c61b057..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerndge/dgegs/locf.F
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: locf.F,v 1.1.1.1 1996/02/15 17:54:26 mclareni Exp $
-*
-* $Log: locf.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:26 mclareni
-* Kernlib
-*
-*
-#include "kerndge/pilot.h"
- FUNCTION LOCF (AM)
-C
-C CERN PROGLIB# LOCF .VERSION KERNDGE 1.01 860217
-C ORIG. 03/02/86 JZ
-C
- DIMENSION AM(9)
-
- LOCF= WORDADDR (AM(1)) /2
- RETURN
- END
-#ifdef CERNLIB_TCGEN_LOCF
-#undef CERNLIB_TCGEN_LOCF
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerndge/dgegs/ublow.s b/src/packlib/kernlib/kerngen/obsolete/kerndge/dgegs/ublow.s
deleted file mode 100644
index d0a13a5..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerndge/dgegs/ublow.s
+++ /dev/null
@@ -1,54 +0,0 @@
-*
-* $Id: ublow.s,v 1.1.1.1 1996/02/15 17:54:26 mclareni Exp $
-*
-* $Log: ublow.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:26 mclareni
-* Kernlib
-*
-*
- .TITLE UBLOW
-;
-; CERN PROGLIB# M409 UBLOW .VERSION KERNDGE 1.01 860217
-; ORIG. 03/02/86 M.BERNABE, DGC MADRID
-;
- .ENT UBLOW
- .DUSR ARG1 = -12. ; POINTER TO ARG 1
- .DUSR ARG2 = -14. ; POINTER TO ARG 2
- .DUSR ARG3 = -16. ; POINTER TO ARG 3
- .NREL 0
-SVAC3: 0
-INDEX: 0
-NUMBT: 0
- .NREL 1
-UBLOW:
- WSAVS 0 ; NO STACK USAGE.
- LWSTA 3,SVAC3 ; SAVE AC3 - WFP.
- LWLDA 0, at ARG3,3 ; PICK # 32B WORDS IN TARGET,
-; = # BYTES IN SOURCE.
- LWSTA 0,NUMBT ; SAVE THAT NUMBER.
- WLSI 2,0 ; CONVERT TO BYTES.
- LWSTA 0,INDEX ; SAVE # BYTES IN TARGET.
- WSUB 1,1 ; CLEAR 1 TO MOVE SPACES.
- LWLDA 2,ARG2,3 ; PICK TARGET ADDRESS.
- WLSI 1,2 ; CONVERT TO BYTEADDR.
- LWLDA 3,ARG1,3 ; PICK SOURCE ADDRESS.
- WLSI 1,3 ; CONVERT TO BYTEADDR.
- WCMV ; CLEAN TARGET TO SPACES.
- LWSUB 2,INDEX ; RESTORE TARGET BYTEADDR.
- LWSTA 1,INDEX ; CLEAR LOOP INDEX.
- LWLDA 0,NUMBT ; RESTORE # BYTES IN SOURCE.
-MLOOP:
- LWDO 0,ENDRT,INDEX ; LOOP. IF END, END ROUTINE.
- WLDB 3,1 ; PICK BYTE TO BE MLOOPD.
- WSTB 2,1 ; STORE IN TARGET.
- WADI 1,3 ; PICK NEXT SOURCE BYTE,
- WADI 4,2 ; NEXT TARGET 32B WORD,
- LWLDA 0,NUMBT ; RESET LOOP LIMIT.
- WBR MLOOP ; AND CONTINUE THE LOOP.
-ENDRT:
- LWLDA 3,SVAC3 ; RESTORE AC3 - WFP.
- WRTN ; RETURN TO CALLER.
- .END
-#ifdef CERNLIB_TCGEN_UBLOW
-#undef CERNLIB_TCGEN_UBLOW
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerndge/dgegs/ubunch.s b/src/packlib/kernlib/kerngen/obsolete/kerndge/dgegs/ubunch.s
deleted file mode 100644
index e39b8e7..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerndge/dgegs/ubunch.s
+++ /dev/null
@@ -1,57 +0,0 @@
-*
-* $Id: ubunch.s,v 1.1.1.1 1996/02/15 17:54:26 mclareni Exp $
-*
-* $Log: ubunch.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:26 mclareni
-* Kernlib
-*
-*
- .TITLE UBUNCH
-;
-; CERN PROGLIB# M409 UBUNCH .VERSION KERNDGE 1.01 860217
-; ORIG. 03/02/86 M.BERNABE, DGC MADRID
-;
- .ENT UBUNCH
- .DUSR ARG1 = -12. ; POINTER TO ARG 1
- .DUSR ARG2 = -14. ; POINTER TO ARG 2
- .DUSR ARG3 = -16. ; POINTER TO ARG 3
- .NREL 0
-SVAC3: 0
-NUMBT: 0
-INDEX: 0
- .NREL 1
-UBUNCH:
- WSAVS 0 ; NO STACK USAGE.
- LWSTA 3,SVAC3 ; SAVE AC3 - WFP.
- LWLDA 0, at ARG3,3 ; PICK # 32B WORDS IN TARGET,
-; = # BYTES IN SOURCE.
- LWSTA 0,NUMBT ; SAVE THAT NUMBER.
- WADI 3,0 ; AC0 = AC0 + 3 / 4
- WMOVR 0 ; TO ROUND UP
- WMOVR 0 ; TO 32B WORDS.
- WLSI 2,0 ; CONVERT TO BYTES.
- LWSTA 0,INDEX ; SAVE # BYTES IN TARGET.
- WSUB 1,1 ; CLEAR 1 TO MOVE SPACES.
- LWLDA 2,ARG2,3 ; PICK TARGET ADDRESS.
- WLSI 1,2 ; CONVERT TO BYTEADDR.
- LWLDA 3,ARG1,3 ; PICK SOURCE ADDRESS.
- WLSI 1,3 ; CONVERT TO BYTEADDR.
- WCMV ; CLEAN TARGET TO SPACES.
- LWSUB 2,INDEX ; RESTORE TARGET BYTEADDR.
- LWSTA 1,INDEX ; CLEAR LOOP INDEX.
- LWLDA 0,NUMBT ; RESTORE # BYTES IN SOURCE.
-MLOOP:
- LWDO 0,ENDRT,INDEX ; LOOP. IF END, END ROUTINE.
- WLDB 3,1 ; PICK BYTE TO BE MLOOPD.
- WSTB 2,1 ; STORE IN TARGET.
- WADI 4,3 ; PICK NEXT SOURCE 32B WORD,
- WADI 1,2 ; NEXT TARGET BYTE,
- LWLDA 0,NUMBT ; RESET LOOP LIMIT.
- WBR MLOOP ; AND CONTINUE THE LOOP.
-ENDRT:
- LWLDA 3,SVAC3 ; RESTORE AC3 - WFP.
- WRTN ; RETURN TO CALLER.
- .END
-#ifdef CERNLIB_TCGEN_UBUNCH
-#undef CERNLIB_TCGEN_UBUNCH
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerndge/dgegs/ucopy2.s b/src/packlib/kernlib/kerngen/obsolete/kerndge/dgegs/ucopy2.s
deleted file mode 100644
index 2df1c23..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerndge/dgegs/ucopy2.s
+++ /dev/null
@@ -1,44 +0,0 @@
-*
-* $Id: ucopy2.s,v 1.1.1.1 1996/02/15 17:54:27 mclareni Exp $
-*
-* $Log: ucopy2.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:27 mclareni
-* Kernlib
-*
-*
- .TITLE UCOPY2
-;
-; CERN PROGLIB# V301 UCOPY2 .VERSION KERNDGE 1.01 860217
-; ORIG. 03/02/86 M.BERNABE, DGC MADRID
-;
- .ENT UCOPY2
- .DUSR ARG1 = -12. ; POINTER TO ARG 1
- .DUSR ARG2 = -14. ; POINTER TO ARG 2
- .DUSR ARG3 = -16. ; POINTER TO ARG 3
- .NREL 1
-UCOPY2:
- WSAVS 0 ; NO STACK USAGE.
- LWLDA 1, at ARG3,3 ; PICK # 32B WORDS TO BE COPIED.
- WLSI 1,1 ; CONVERT TO 16B WORDS.
- LWLDA 2,ARG1,3 ; PICK SOURCE ADDRESS.
- WMOV 3,0 ; SAVE AC3 - WFP.
- LWLDA 3,ARG2,3 ; PICK TARGET
- WSGT 3,2 ; IF T > S, THERE IS
-; DESTRUCTIVE OVERLAP,
-; AND COPY IS RIGHT TO LEFT,
-; COMPLEMENTING AC1,
-; AND POSITIONING 2 & 3
-; AT END OF FIELD.
- WBR COPY ; IF NOT, COPY AS USUAL.
- WADD 1,2 ; POSITION END SOURCE.
- WADD 1,3 ; POSITION END TARGET.
- WCOM 1,1 ; COMPLEMENT AC1 TO 1.
- WADI 1,1 ; COMPLEMENT AC1 TO 2.
-COPY:
- WBLM ; MAKE THE MOVEMENT.
- WMOV 0,3 ; RESTORE AC3 - WFP.
- WRTN ; RETURN TO CALLER.
- .END
-#ifdef CERNLIB_TCGEN_UCOPY2
-#undef CERNLIB_TCGEN_UCOPY2
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerndge/dgegs/uctoh.s b/src/packlib/kernlib/kerngen/obsolete/kerndge/dgegs/uctoh.s
deleted file mode 100644
index 4e0adf6..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerndge/dgegs/uctoh.s
+++ /dev/null
@@ -1,83 +0,0 @@
-*
-* $Id: uctoh.s,v 1.1.1.1 1996/02/15 17:54:27 mclareni Exp $
-*
-* $Log: uctoh.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:27 mclareni
-* Kernlib
-*
-*
- .TITLE UCTOH
-;
-; CERN PROGLIB# M409 UCTOH .VERSION KERNDGE 1.01 860217
-; ORIG. 03/02/86 M.BERNABE, DGC MADRID
-;
- .ENT UCTOH
- .DUSR ARG1 = -12. ; POINTER TO ARG 1
- .DUSR ARG2 = -14. ; POINTER TO ARG 2
- .DUSR ARG3 = -16. ; POINTER TO ARG 3
- .DUSR ARG4 = -18. ; POINTER TO ARG 4
- .NREL 0
-SVAC3: 0
-NUMBT: 0
-NUMBP: 0
-INDEX: 0
-INDEX1: 0
-SRCE: 0
- .NREL 1
-UCTOH:
- WSAVS 0 ; NO STACK USAGE.
- LWSTA 3,SVAC3 ; SAVE AC3 - WFP.
- LWLDA 0, at ARG3,3 ; PICK # BYTES IN A PACK.
- LWSTA 0,NUMBP ; SAVE THAT NUMBER.
- LWLDA 0, at ARG4,3 ; PICK # BYTES IN SOURCE.
- LWSTA 0,NUMBT ; SAVE THAT NUMBER.
-;
-; CONVERSION TO # 16B WORDS AS A FUNCTION OF THE
-; LENGTH OF A PACKET (ARG3).
-;
- WSBI 1,0 ; TOTAL #BYTES - 1
- LWADD 0, at ARG3,3 ; + #BYTES IN A PACK
- LWDIV 0, at ARG3,3 ; / #BYTES IN A PACK = # 32B W.
- WLSI 2,0 ; CONVERT TO BYTES.
-;
- LWSTA 0,INDEX ; SAVE # BYTES IN TARGET.
- WSUB 1,1 ; CLEAR 1 TO MOVE SPACES.
- LWLDA 2,ARG2,3 ; PICK TARGET ADDRESS.
- WLSI 1,2 ; CONVERT TO BYTEADDR.
- LWLDA 3,ARG1,3 ; PICK SOURCE ADDRESS.
- WMOV 3,0 ; CHECK FIRST BIT TO SEE IF IT IS
- WSKBO 0 ; A BYTEADDR -A ONE-.
- WLSI 1,3 ; IF NOT, CONVERT TO BYTEADDR.
- LWSTA 3,SRCE ; KEEP SOURCE BYTEADDR.
- LWLDA 0,INDEX ; RESTORE # BYTES TO CLEAN.
- WCMV ; CLEAN TARGET TO SPACES.
- LWLDA 0,NUMBT ; PICK # BYTES IN SOURCE.
- LWSUB 2,INDEX ; RESTORE TARGET ADDRESS.
- LWLDA 3,SRCE ; PICK SOURCE ADDRESS.
- LWSTA 1,INDEX ; CLEAR MAIN INDEX.
- LWSTA 1,INDEX1 ; CLEAR PACK INDEX.
-MLOOP:
- LWLDA 0,NUMBT ; RESTORE # BYTES IN SOURCE.
- LWDO 0,ENDRT,INDEX ; LOOP. IF END, END ROUTINE.
-PLOOP:
- LWLDA 0,NUMBP ; RESTORE # BYTES IN A PACK.
- LWDO 0,NEXT,INDEX1 ; LOOP. IF END, NEXT PACK.
- WLDB 3,1 ; PICK BYTE TO BE MOVED.
- WSTB 2,1 ; STORE IN TARGET.
- WADI 1,3 ; PICK NEXT PACK BYTE.
- WADI 1,2 ; PICK NEXT TARGET BYTE.
- WBR MLOOP ; CONTINUE PACK LOOP.
-NEXT:
- WSUB 1,1 ; CLEAR AC1 TO RESET INDEX.
- LWSTA 1,INDEX1 ; RESET PACK INDEX.
- WADI 4,2 ; PICK NEXT 32B WORD.
- LWSUB 2,NUMBP ; SUBTRACT #BYTES IN A PACK.
-; SO, PICK NEXT PACK.
- WBR PLOOP ; CONTINUE MAIN LOOP.
-ENDRT:
- LWLDA 3,SVAC3 ; RESTORE AC3 - WFP.
- WRTN ; RETURN TO CALLER.
- .END
-#ifdef CERNLIB_TCGEN_UCTOH
-#undef CERNLIB_TCGEN_UCTOH
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerndge/dgegs/uctoh1.s b/src/packlib/kernlib/kerngen/obsolete/kerndge/dgegs/uctoh1.s
deleted file mode 100644
index 28f0cf0..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerndge/dgegs/uctoh1.s
+++ /dev/null
@@ -1,57 +0,0 @@
-*
-* $Id: uctoh1.s,v 1.1.1.1 1996/02/15 17:54:27 mclareni Exp $
-*
-* $Log: uctoh1.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:27 mclareni
-* Kernlib
-*
-*
- .TITLE UCTOH1
-;
-; CERN PROGLIB# M409 UCTOH1 .VERSION KERNDGE 1.01 860217
-; ORIG. 03/02/86 M.BERNABE, DGC MADRID
-;
- .ENT UCTOH1
- .DUSR ARG1 = -12. ; POINTER TO ARG 1
- .DUSR ARG2 = -14. ; POINTER TO ARG 2
- .DUSR ARG3 = -16. ; POINTER TO ARG 3
- .NREL 0
-SVAC3: 0
-INDEX: 0
-NUMBT: 0
- .NREL 1
-UCTOH1:
- WSAVS 0 ; NO STACK USAGE.
- LWSTA 3,SVAC3 ; SAVE AC3 - WFP.
- LWLDA 0, at ARG3,3 ; PICK # 32B WORDS IN TARGET,
-; = # BYTES IN SOURCE.
- LWSTA 0,NUMBT ; SAVE THAT NUMBER.
- WLSI 2,0 ; CONVERT TO BYTES.
- LWSTA 0,INDEX ; SAVE # BYTES IN TARGET.
- WSUB 1,1 ; CLEAR 1 TO MOVE SPACES.
- LWLDA 2,ARG2,3 ; PICK TARGET ADDRESS.
- WLSI 1,2 ; CONVERT TO BYTEADDR.
- LWLDA 3,ARG1,3 ; PICK SOURCE ADDRESS.
- WMOV 3,0 ; CHECK FIRST BIT TO SEE IF IT IS
- WSKBO 0 ; A BYTEADDR -A ONE-.
- WLSI 1,3 ; IF NOT, CONVERT TO BYTEADDR.
- LWLDA 0,INDEX ; RESTORE # BYTES TO CLEAN.
- WCMV ; CLEAN TARGET TO SPACES.
- LWSUB 2,INDEX ; RESTORE TARGET BYTEADDR.
- LWSTA 1,INDEX ; CLEAR LOOP INDEX.
- LWLDA 0,NUMBT ; RESTORE # BYTES IN SOURCE.
-MLOOP:
- LWDO 0,ENDRT,INDEX ; LOOP. IF END, END ROUTINE.
- WLDB 3,1 ; PICK BYTE TO BE MLOOPD.
- WSTB 2,1 ; STORE IN TARGET.
- WADI 1,3 ; PICK NEXT SOURCE BYTE,
- WADI 4,2 ; NEXT TARGET 32B WORD,
- LWLDA 0,NUMBT ; RESET LOOP LIMIT.
- WBR MLOOP ; AND CONTINUE THE LOOP.
-ENDRT:
- LWLDA 3,SVAC3 ; RESTORE AC3 - WFP.
- WRTN ; RETURN TO CALLER.
- .END
-#ifdef CERNLIB_TCGEN_UCTOH1
-#undef CERNLIB_TCGEN_UCTOH1
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerndge/dgegs/uh1toc.s b/src/packlib/kernlib/kerngen/obsolete/kerndge/dgegs/uh1toc.s
deleted file mode 100644
index 82f0a71..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerndge/dgegs/uh1toc.s
+++ /dev/null
@@ -1,59 +0,0 @@
-*
-* $Id: uh1toc.s,v 1.1.1.1 1996/02/15 17:54:27 mclareni Exp $
-*
-* $Log: uh1toc.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:27 mclareni
-* Kernlib
-*
-*
- .TITLE UH1TOC
-;
-; CERN PROGLIB# M409 UH1TOC .VERSION KERNDGE 1.01 860217
-; ORIG. 03/02/86 M.BERNABE, DGC MADRID
-;
- .ENT UH1TOC
- .DUSR ARG1 = -12. ; POINTER TO ARG 1
- .DUSR ARG2 = -14. ; POINTER TO ARG 2
- .DUSR ARG3 = -16. ; POINTER TO ARG 3
- .NREL 0
-SVAC3: 0
-NUMBT: 0
-INDEX: 0
- .NREL 1
-UH1TOC:
- WSAVS 0 ; NO STACK USAGE.
- LWSTA 3,SVAC3 ; SAVE AC3 - WFP.
- WSUB 1,1 ; CLEAR 1 TO MOVE SPACES.
- LWLDA 2,ARG2,3 ; PICK TARGET ADDRESS.
- WMOV 2,0 ; CHECK FIRST BIT TO SEE IF IT IS
- WSKBO 0 ; A BYTEADDR -A ONE-.
- WLSI 1,2 ; IF NOT, CONVERT TO BYTEADDR.
- LWLDA 0, at ARG3,3 ; PICK # 32B WORDS IN TARGET,
-; = # BYTES IN SOURCE.
- LWSTA 0,NUMBT ; SAVE THAT NUMBER.
- WADI 3,0 ; AC0 = AC0 + 3 / 4
- WMOVR 0 ; TO ROUND UP
- WMOVR 0 ; TO 32B WORDS.
- WLSI 2,0 ; CONVERT TO BYTES.
- LWSTA 0,INDEX ; SAVE # BYTES IN TARGET.
- LWLDA 3,ARG1,3 ; PICK SOURCE ADDRESS.
- WLSI 1,3 ; CONVERT TO BYTEADDR.
- WCMV ; CLEAN TARGET TO SPACES.
- LWSUB 2,INDEX ; RESTORE TARGET BYTEADDR.
- LWSTA 1,INDEX ; CLEAR LOOP INDEX.
- LWLDA 0,NUMBT ; RESTORE # BYTES IN SOURCE.
-MLOOP:
- LWDO 0,ENDRT,INDEX ; LOOP. IF END, END ROUTINE.
- WLDB 3,1 ; PICK BYTE TO BE MLOOPD.
- WSTB 2,1 ; STORE IN TARGET.
- WADI 4,3 ; PICK NEXT SOURCE BYTE,
- WADI 1,2 ; NEXT TARGET 32B WORD,
- LWLDA 0,NUMBT ; RESET LOOP LIMIT.
- WBR MLOOP ; AND CONTINUE THE LOOP.
-ENDRT:
- LWLDA 3,SVAC3 ; RESET AC3 - WFP.
- WRTN ; RETURN TO CALLER.
- .END
-#ifdef CERNLIB_TCGEN_UH1TOC
-#undef CERNLIB_TCGEN_UH1TOC
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerndge/dgegs/uhtoc.s b/src/packlib/kernlib/kerngen/obsolete/kerndge/dgegs/uhtoc.s
deleted file mode 100644
index cb8dde2..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerndge/dgegs/uhtoc.s
+++ /dev/null
@@ -1,73 +0,0 @@
-*
-* $Id: uhtoc.s,v 1.1.1.1 1996/02/15 17:54:27 mclareni Exp $
-*
-* $Log: uhtoc.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:27 mclareni
-* Kernlib
-*
-*
- .TITLE UHTOC
-;
-; CERN PROGLIB# M409 UHTOC .VERSION KERNDGE 1.01 860217
-; ORIG. 03/02/86 M.BERNABE, DGC MADRID
-;
- .ENT UHTOC
- .DUSR ARG1 = -12. ; POINTER TO ARG 1
- .DUSR ARG2 = -14. ; POINTER TO ARG 2
- .DUSR ARG3 = -16. ; POINTER TO ARG 3
- .DUSR ARG4 = -18. ; POINTER TO ARG 4
- .NREL 0
-SVAC3: 0
-NUMBT: 0
-NUMBP: 0
-INDEX: 0
-INDEX1: 0
-SRCE: 0
- .NREL 1
-UHTOC:
- WSAVS 0 ; NO STACK USAGE.
- LWSTA 3,SVAC3 ; SAVE AC3 - WFP.
- LWLDA 0, at ARG2,3 ; PICK # BYTES IN A PACK.
- LWSTA 0,NUMBP ; SAVE THAT NUMBER.
- LWLDA 0, at ARG4,3 ; PICK # BYTES IN TARGET.
- LWSTA 0,NUMBT ; SAVE THAT NUMBER.
- WSUB 1,1 ; CLEAR 1 TO MOVE SPACES.
- LWLDA 2,ARG3,3 ; PICK TARGET ADDRESS.
- WMOV 2,0 ; CHECK FIRST BIT TO SEE IF IT IS
- WSKBO 0 ; A BYTEADDR -A ONE-.
- WLSI 1,2 ; IF NOT, CONVERT TO BYTEADDR.
- LWLDA 3,ARG1,3 ; PICK SOURCE ADDRESS.
- WLSI 1,3 ; CONVERT TO BYTEADDR.
- LWSTA 3,SRCE ; KEEP SOURCE BYTEADDR.
- LWLDA 0,INDEX ; RESTORE # BYTES TO CLEAN.
- WCMV ; CLEAN TARGET TO SPACES.
- LWLDA 0,NUMBT ; PICK # BYTES IN TARGET.
- LWSUB 2,INDEX ; RESTORE TARGET ADDRESS.
- LWLDA 3,SRCE ; PICK SOURCE ADDRESS.
- LWSTA 1,INDEX ; CLEAR MAIN INDEX.
- LWSTA 1,INDEX1 ; CLEAR PACK INDEX.
-MLOOP:
- LWLDA 0,NUMBT ; RESTORE # BYTES IN SOURCE.
- LWDO 0,ENDRT,INDEX ; LOOP. IF END, END ROUTINE.
-PLOOP:
- LWLDA 0,NUMBP ; RESTORE # BYTES IN A PACK.
- LWDO 0,NEXT,INDEX1 ; LOOP. IF END, NEXT PACK.
- WLDB 3,1 ; PICK BYTE TO BE MOVED.
- WSTB 2,1 ; STORE IN TARGET.
- WADI 1,3 ; PICK NEXT PACK BYTE.
- WADI 1,2 ; PICK NEXT TARGET BYTE.
- WBR MLOOP ; CONTINUE MAIN LOOP.
-NEXT:
- WSUB 1,1 ; CLEAR AC1 TO RESET INDEX.
- LWSTA 1,INDEX1 ; RESET PACK INDEX.
- WADI 4,3 ; PICK NEXT 32B WORD,
- LWSUB 3,NUMBP ; - # BYTES IN A PACK
-; SO, PICK NEXT PACK.
- WBR PLOOP ; CONTINUE PACK LOOP.
-ENDRT:
- LWLDA 3,SVAC3 ; RESTORE AC3 - WFP.
- WRTN ; RETURN TO CALLER.
- .END
-#ifdef CERNLIB_TCGEN_UHTOC
-#undef CERNLIB_TCGEN_UHTOC
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerndge/dgegs/xinb.F b/src/packlib/kernlib/kerngen/obsolete/kerndge/dgegs/xinb.F
deleted file mode 100644
index 90439d4..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerndge/dgegs/xinb.F
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: xinb.F,v 1.1.1.1 1996/02/15 17:54:27 mclareni Exp $
-*
-* $Log: xinb.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:27 mclareni
-* Kernlib
-*
-*
-#include "kerndge/pilot.h"
- SUBROUTINE XINB (LUN,XBV,NXB)
-C
-C CERN PROGLIB# Z203 XINB .VERSION KERNDGE 1.01 860217
-C ORIG. 03/02/86 JZ
-C
- DIMENSION XBV(99)
-C
- READ (LUN,END=61,ERR=64) N, (XBV(J),J=1,MIN0(N,NXB))
- N = MIN0 (N,NXB)
- NXB = MAX0 (N,1)
- RETURN
-C
- 61 NXB = 0
- RETURN
-C
- 64 NXB = -7
- RETURN
- END
-#ifdef CERNLIB_TCGEN_XINB
-#undef CERNLIB_TCGEN_XINB
-#endif
-#ifdef CERNLIB_XVECT_XINB
-#undef CERNLIB_XVECT_XINB
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerndge/dgegs/xinbs.F b/src/packlib/kernlib/kerngen/obsolete/kerndge/dgegs/xinbs.F
deleted file mode 100644
index b448e03..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerndge/dgegs/xinbs.F
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: xinbs.F,v 1.1.1.1 1996/02/15 17:54:27 mclareni Exp $
-*
-* $Log: xinbs.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:27 mclareni
-* Kernlib
-*
-*
-#include "kerndge/pilot.h"
- SUBROUTINE XINBS (LUN,XAV,NA,XBV,NXB)
-C
-C CERN PROGLIB# Z203 XINBS .VERSION KERNDGE 1.01 860217
-C ORIG. 03/02/86 JZ
-C
- DIMENSION XBV(99), XAV(NA)
-C
- READ (LUN,END=61,ERR=64) N,XAV,(XBV(J),J=1,MIN0(N,NXB))
- N = MIN0 (N,NXB)
- NXB = MAX0 (N,1)
- RETURN
-C
- 61 NXB = 0
- RETURN
-C
- 64 NXB = -7
- RETURN
- END
-#ifdef CERNLIB_TCGEN_XINBS
-#undef CERNLIB_TCGEN_XINBS
-#endif
-#ifdef CERNLIB_XVECT_XINBS
-#undef CERNLIB_XVECT_XINBS
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerndge/dgemakelib/Imakefile b/src/packlib/kernlib/kerngen/obsolete/kerndge/dgemakelib/Imakefile
deleted file mode 100644
index 69cf663..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerndge/dgemakelib/Imakefile
+++ /dev/null
@@ -1,4 +0,0 @@
-SRCS_F= \ @@\
- makelib.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerndge/dgemakelib/makelib.F b/src/packlib/kernlib/kerngen/obsolete/kerndge/dgemakelib/makelib.F
deleted file mode 100644
index 0218408..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerndge/dgemakelib/makelib.F
+++ /dev/null
@@ -1,239 +0,0 @@
-*
-* $Id: makelib.F,v 1.1.1.1 1996/02/15 17:54:29 mclareni Exp $
-*
-* $Log: makelib.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:29 mclareni
-* Kernlib
-*
-*
-* This directory was created from kerndge.car patch dgemakelib
- PROGRAM MAKELIB
-
-C CERN PROGLIB# MAKELIB .VERSION KERNDGE 1.01 860217
-C ORIG. 03/02/86 M.BERNABE, DGC MADRID + J.ZOLL, CERN
-
-C- GIVEN A FILE MAKELIB.SRC CONTAINING THE SOURCE
-C- OF SEVERAL ROUTINES, MAYBE MIXING FORTRAN AND ASSEMBLER,
-C- THIS PROGRAM WILL COMPILE ONE ROUTINE AT A TIME AND PLACE THE
-C- RESULTING OBJECT MODULE INTO THE LIBRARY FILE MAKELIB.LB.
-
-C- TO SEPARATE THE SOURCE DECKS FROM EACH OTHER, EACH DECK
-C- MUST START WITH A 'ROUTINE HEADER CARD' (WHICH CAN BE
-C- GENERATED WITH YPATCHY) AS FOLLOWS :
-C- FORTRAN : CDECKDGE, NAME [ COMMENT]
-C- ASSEMBLER : *DECKDGE, NAME [ COMMENT]
-
-C- THE REASON FOR THE EXISTENCE OF THIS PROGRAM IS THE ABSENCE
-C- ON DATA GENERAL COMPUTERS OF THE SYSTEM FUNCTION TO
-C- CONVERT A MANY-MODULE OBJECT FILE INTO A LIBRARY.
-
-%LIST (OFF)
-%INCLUDE 'QSYM.F77.IN'
-%LIST (ON)
-
-C- PACKET TO START A CLI PROCESS IN ORDER TO :
-C- COMPILE / ASSEMBLE THE SELECTED SOURCE,
-C- ADD THE OBJECT TO THE LIBRARY,
-C- DELETE SOURCE AND OBJECT.
-
- INTEGER*2 PROC_PACK(0:ISYS_PLTH-1)/ISYS_PLTH*-1/
- INTEGER*2 FLAGS
- INTEGER*4 AD_PROG_CLI
- INTEGER*4 AD_INIT_IPC_HEAD
- EQUIVALENCE (FLAGS,PROC_PACK(ISYS_PFLG))
- EQUIVALENCE (AD_PROG_CLI,PROC_PACK(ISYS_PSNM))
- EQUIVALENCE (AD_INIT_IPC_HEAD,PROC_PACK(ISYS_PIPC))
-
-C- PACKET TO HANDLE THE IPC RELATED TO PROC_PACK.
-C- IT WILL CONTAIN THE COMMANDS -AS AN INITIAL IPC-
-C- TO EXECUTE THE STEPS SPECIFIED ABOVE (COMPILE, ADD, DELETE).
-
- INTEGER*2 ISR_PACK(0:ISYS_IPLTH-1)/ISYS_IPLTH*0/
- INTEGER*2 LT_INIT_IPC
- INTEGER*4 AD_INIT_IPC
- EQUIVALENCE (LT_INIT_IPC,ISR_PACK(ISYS_ILTH))
- EQUIVALENCE (AD_INIT_IPC,ISR_PACK(ISYS_IPTR))
-
- INTEGER*4 AC0,AC1,AC2 ! ACUMULATORS
- CHARACTER*8 CH_PROG_CLI
- CHARACTER*50 INIT_IPC ! WILL CONTAIN THE COMMANDS.
- CHARACTER*88 LINE ! ONE LINE OF DATA.
- CHARACTER*32 FILENAME ! THE MODULE NAME.
-
-C INTEGER*2 INZERO / 0 /
- CHARACTER*1 CHZERO ! TERMINATING ZERO
-C EQUIVALENCE (INZERO,CHZERO)
- DATA CHZERO / '<0>' /
-
- CH_PROG_CLI = ':CLI.PR'//CHZERO
-
- PRINT 9011
- 9011 FORMAT ('0MAKELIB EXECUTING'
- +/'0IT EXPECTS ON FILE MAKELIB.SCR THE SOUCE DECKS SEPARATED BY'
- +/' LINES "CDECKDGE, NAME" FOR COMPILATION, OR'
- +/' "*DECKDGE, NAME" FOR ASSEMBLY.'
- +/'0FILE MAKELIB.ERRORS MUST NOT PRE-EXIST.')
-
- OPEN (77,FILE='MAKELIB.ERRORS',STATUS='OLD',IOSTAT=IER,RECFM='DS')
- IF (IER.EQ.21) GO TO 14
- PRINT *,'0***** MAKELIB.ERRORS EXISTS - STOP - *****'
- STOP
-
-C---- CREATE FILE MAKELIB.CLI TO BE EXECUTED
-
- 14 OPEN (33,FILE='MAKELIB.CLI',STATUS='FRESH')
-
- WRITE (33,9014)
- WRITE (33,9015)
- WRITE (33,9016)
- WRITE (33,9017)
- 9014 FORMAT
- +('DEL/1=I/2=I MAKELIB.ERR'
- +/'[!EQ [!EEXT %1%],.F77]'
- +/' X/L=MAKELIB.ERR F77/CARD/OPT/NOW/STR=ANSI [!ENAM %1%]'
- +/'[!ELSE]'
- +/' X/L=MAKELIB.ERR MASM [!ENAM %1%]'
- +/'[!END]'
- +/'[!UNE 1,[!SIZE MAKELIB.ERR]]'
- +/' [!EQ [!EEXT %1%],.F77]'
- +/' WR/L=MAKELIB.ERRORS Compilation error in %1%.'
- +/' [!ELSE]'
- +/' WR/L=MAKELIB.ERRORS Assembly error in %1%.'
- +/' [!END]' )
- 9015 FORMAT
- +('[!ELSE]'
- +/' DEL %1%'
- +/' CLASS1 WARNING'
- +/' [!NE [!FILENAM MAKELIB.LB],=MAKELIB.LB]'
- +/' CLASS1 ERROR'
- +/' DEL/1=I/2=I MAKELIB.ERR'
- +/' X/L=MAKELIB.ERR LFE N MAKELIB.LB/O [!ENAM %1%].OB'
- +/' [!UNE 1,[!SIZE MAKELIB.ERR]]'
- +/' WR/L=MAKELIB.ERRORS Error creating Library.'
- +/' DEL/1=I/2=I MAKELIB.LB'
- +/' [!END]'
- +/' DEL [!ENAME %1%].OB' )
- 9016 FORMAT
- +(' [!ELSE]'
- +/' CLASS1 ERROR'
- +/' RENAM MAKELIB.LB MAKELIB_OLD.LB'
- +/' DEL/1=I/2=I MAKELIB.ERR'
- +/' X/L=MAKELIB.ERR LFE I MAKELIB_OLD.LB/I &'
- +/' MAKELIB.LB/O [!ENAM %1%].OB'
- +/' [!UEQ 1,[!SIZE MAKELIB.ERR]]'
- +/' DEL MAKELIB_OLD.LB'
- +/' [!ELSE]'
- +/' WR/L=MAKELIB.ERRORS Cataloging error &'
- +/' in %1%.'
- +/' RENAM MAKELIB_OLD.LB MAKELIB.LB'
- +/' [!END]' )
- 9017 FORMAT
- +(' DEL [!ENAM %1%].OB'
- +/' [!END]'
- +/'[!END]'
- +/'BYE' )
-
- CLOSE (33)
-
-C---- SKIP LEADING LINES, BEFORE THE FIRST HEADER, IF ANY
-
- JCARD = 0
- JDECK = 0
- JFLEOF= 0
- OPEN (44,FILE='MAKELIB.SRC',STATUS='OLD',IOINTENT='INPUT'
- +, PAD='YES')
-
- 24 READ (44,8024,END=98) LINE
- 8024 FORMAT (A)
- JCARD = JCARD + 1
- IF (LINE(2:9).NE.'DECKDGE,') GO TO 24
-
-C---- START NEXT DECK
-
- 31 DO 33 JA=10,32
- IF (LINE(JA:JA).NE.' ') GO TO 34
- 33 CONTINUE
-
- 34 DO 36 JE=JA+1,JA+28
- IF (LINE(JE:JE).EQ.' ') GO TO 37
- 36 CONTINUE
-
- 37 LT_FILENAME = JE - JA + 5
- IF (LINE(1:1).EQ.'C') THEN
- FILENAME = LINE(JA:JE-1)//'.F77'//CHZERO
- ELSE
- FILENAME = LINE(JA:JE-1)//'.SR'//CHZERO
- ENDIF
-
-C-- READ FIRST TRUE LINE OF DECK, CHECK HEADER AGAIN
-
- READ (44,8024,RETURNRECL=NCHLI,END=91) LINE
- JCARD = JCARD + 1
- IF (LINE(2:9).EQ.'DECKDGE,') GO TO 31
-
- OPEN (55,FILE=FILENAME,STATUS='FRESH')
-
-C-- COPY COMPLETE DECK TO FILE 55
-
- 44 WRITE (55,8024) LINE(1:MAX(1,NCHLI))
- READ (44,8024,RETURNRECL=NCHLI,END=48) LINE
- JCARD=JCARD+1
- IF (LINE(2:9).EQ.'DECKDGE,') GO TO 49
- GO TO 44
-
- 48 JFLEOF = 7
- 49 CLOSE (55)
-
-C---- COMPILE / ADD TO LIBRARY / ERASE FILES
-
- JDECK = JDECK + 1
-
-C-- FILL THE BUFFER WITH THE COMMANDS TO BE EXECUTED :
-
- INIT_IPC = "MAKELIB.CLI "//FILENAME(1:LT_FILENAME)
-
-C-- PREPARE THE REST OF THE PACKET :
-
- FLAGS = ISYS_PFEX ! BLOCK FATHER.
- AD_PROG_CLI = BYTEADDR (CH_PROG_CLI) ! WILL EXECUTE CLI.
- AD_INIT_IPC_HEAD = WORDADDR(ISR_PACK) ! INITIAL IPC.
- LT_INIT_IPC = 25 ! LENGTH IN WORDS.
- AD_INIT_IPC = WORDADDR(INIT_IPC) ! COMMANDS TO EXECUTE.
-
-C-- SET UP ACUMULATORS AND ISSUE THE SYSTEM CALL :
-
- AC0 = 0
- AC1 = 0
- AC2 = WORDADDR(PROC_PACK)
- IER = ISYS(ISYS_PROC,AC0,AC1,AC2) ! START PROCESS.
- IF (IER.NE.0) THEN
- PRINT *,'ERROR IN PROCESS : ',IER
- STOP
- ENDIF
-
- IF (JFLEOF.EQ.0) GO TO 31
-
- 91 OPEN (77,FILE='MAKELIB.ERRORS',STATUS='OLD',IOSTAT=IER,RECFM='DS')
- IF (IER.EQ.0) GO TO 92
- IF (IER.EQ.21) GO TO 93
- PRINT *,'UNEXPECTED ERROR ',IER,
- + ' WHEN TRYING TO OPEN FILE MAKELIB.ERRORS.'
- STOP
-
- 92 PRINT 9092, JDECK, JCARD
- 9092 FORMAT ('0***** THERE HAVE BEEN COMPILATION ERRORS *****',
- +/7X,'MAKELIB HAS PLACED ONLY THE GOOD ROUTINES ONTO MAKELIB.LB,'
- +/7X,'FOR THE BAD ROUTINES IT HAS CREATED ONE SOURCE FILE EACH'
- +/7X,'AND YOU FIND THE ERROR MESSAGES ON FILE MAKELIB.ERRORS'
- +/,'0 PROCESSED ',I7,' CARDS IN',I5,' DECKS.')
- STOP
-
- 93 PRINT 9093, JDECK, JCARD
- 9093 FORMAT ('0MAKELIB.LB BUILT FROM',I7,' CARDS IN',I5,' DECKS.')
- STOP
-
- 98 PRINT 9098, JCARD
- 9098 FORMAT ('0*****',I7,' CARDS READ AND NO HEADER CARD FOUND,'
- +, ' NO COMPILATIONS *****')
- STOP
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerndge/dgesys/Imakefile b/src/packlib/kernlib/kerngen/obsolete/kerndge/dgesys/Imakefile
deleted file mode 100644
index 1cb03d1..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerndge/dgesys/Imakefile
+++ /dev/null
@@ -1,4 +0,0 @@
-SRCS_F= \ @@\
- datime.F datimh.F traceq.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerndge/dgesys/datime.F b/src/packlib/kernlib/kerngen/obsolete/kerndge/dgesys/datime.F
deleted file mode 100644
index 0dc4c9d..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerndge/dgesys/datime.F
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: datime.F,v 1.1.1.1 1996/02/15 17:54:27 mclareni Exp $
-*
-* $Log: datime.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:27 mclareni
-* Kernlib
-*
-*
-#include "kerndge/pilot.h"
- SUBROUTINE DATIME (ND,NT)
-C
-C CERN PROGLIB# Z007 DATIME .VERSION KERNDGE 1.07 891003
-C ORIG. 03/02/86 JZ
-C
-C- CALL DATIME (ND,NT) RETURNS INTEGER DATE ND = YYMMDD
-C- INTEGER TIME NT = HHMM
-C
- COMMON /SLATE/ MM(40)
-
-
- CALL DATE (MM)
- CALL TIME (MM(4))
-
- MM(9) = MOD (MM(1),100)
-
- ND = (MM(9)*100+MM(2))*100 + MM(3)
- NT = MM(4) *100 + MM(5)
- RETURN
- END
-#ifdef CERNLIB_TCGEN_DATIME
-#undef CERNLIB_TCGEN_DATIME
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerndge/dgesys/datimh.F b/src/packlib/kernlib/kerngen/obsolete/kerndge/dgesys/datimh.F
deleted file mode 100644
index bf2e970..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerndge/dgesys/datimh.F
+++ /dev/null
@@ -1,47 +0,0 @@
-*
-* $Id: datimh.F,v 1.1.1.1 1996/02/15 17:54:27 mclareni Exp $
-*
-* $Log: datimh.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:27 mclareni
-* Kernlib
-*
-*
-#include "kerndge/pilot.h"
- SUBROUTINE DATIMH (ND,NT)
-C
-C CERN PROGLIB# Z007 DATIMH .VERSION KERNDGE 1.01 860217
-C ORIG. 03/02/86 JZ
-C
-C
-C- CALL DATIMH (ND,NT) RETURNS HOLLERITH DATE ND = DD/MM/YY
-C- HOLLERITH TIME NT = HH.MM.SS
-C
- COMMON /SLATE/ ISAFE(10), M(24), MM(6)
-C
- DIMENSION ND(2), NT(2)
-
-
- CALL UBLOW (16H0 /0 /000 .0 .00, M, 16)
-C
-C- D D / M M / Y Y H H . M M . S S
-C- 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6
-C
- CALL DATE (MM)
- CALL TIME (MM(4))
-
- MM(1) = MOD (MM(1),100)
-
- CALL USET (MM(1), M, 7, 8)
- CALL USET (MM(2), M, 4, 5)
- CALL USET (MM(3), M, 1, 2)
- CALL USET (MM(4), M, 9,10)
- CALL USET (MM(5), M,12,13)
- CALL USET (MM(6), M,15,16)
-
- CALL UBUNCH (M(1),ND,8)
- CALL UBUNCH (M(9),NT,8)
- RETURN
- END
-#ifdef CERNLIB_TCGEN_DATIMH
-#undef CERNLIB_TCGEN_DATIMH
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerndge/dgesys/traceq.F b/src/packlib/kernlib/kerngen/obsolete/kerndge/dgesys/traceq.F
deleted file mode 100644
index 352ce9f..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerndge/dgesys/traceq.F
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: traceq.F,v 1.1.1.1 1996/02/15 17:54:27 mclareni Exp $
-*
-* $Log: traceq.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:27 mclareni
-* Kernlib
-*
-*
-#include "kerndge/pilot.h"
- SUBROUTINE TRACEQ (LUN,LEV)
-C
-C CERN PROGLIB# N105 TRACEQ .VERSION KERNDGE 1.01 860217
-C ORIG. 03/02/86 JZ
-C
-
- WRITE (LUN,9001)
- RETURN
- 9001 FORMAT ('0TRACEQ. IN-LINE TRACE-BACK STILL NOT AVAILABLE.')
- END
-#ifdef CERNLIB_TCGEN_TRACEQ
-#undef CERNLIB_TCGEN_TRACEQ
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerndge/history/history.dat b/src/packlib/kernlib/kerngen/obsolete/kerndge/history/history.dat
deleted file mode 100644
index a2aec12..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerndge/history/history.dat
+++ /dev/null
@@ -1,84 +0,0 @@
-*
-* $Id: history.dat,v 1.1.1.1 1996/02/15 17:54:23 mclareni Exp $
-*
-* $Log: history.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:54:23 mclareni
-* Kernlib
-*
-*
-* This directory was created from kerndge.car patch kerndge
-#if !defined(CERNLIB_KERNDGE)
-
- KERNLIB ROUTINES PARTICULAR TO DATA GENERAL
-
----------------------------------------------------------------------
-
- THIS FILE CONTAINS THE FOLLOWING PATCHES :
-
-*KDGE PILOT-PATCH SELECTING THE FULL STANDARD GENERAL KERNLIB
- FOR THE MV ECLIPSE
-
-QMDGE DGE MACHINE PATCH
-
-DGEGS DGE VERSIONS OF GENERAL KERNLIB ROUTINES, ECLIPSE
-
-DGESYS DGE VERSIONS OF KERNLIB SYSTEM ROUTINES, ECLIPSE
-
-=====================================================================
-
-
- UP-DATE RECORD FOR THE PAM-FILE KERNDGE
- ----------------------------------------
-
-
-UP-DATE 1.08 : 20-Nov-1989
-----------------------------
-
-REPLACING FILE KERNDGE 1.07 891003 18.13
-
-New decks : LOCB return the byte adr of a variable
-
-Deleted : routines which are now available from KERNFOR :
- JBIT, JBYTxx, MBYTxx, MCBYT, MSBxxx,
- SBITx, SBYTxx
- PKBYT, UPKBYT, ABEND
-
----------------------------------------------------------------------
-
-UP-DATE 1.07 : 3-Oct-1989
-----------------------------
-
-REPLACING FILE KERNDGE 1.06 870525 15.19
-
-New decks : KERNGT to eventually replace GSHOW
-
-Corrections : DATIME introduce /SLATE/
-
----------------------------------------------------------------------
-
-UP-DATE 1.06 : 24-MAY-1987
-----------------------------
-
-REPLACING FILE KERNDGE 1.05 860514 19.55
-
-NEW DECKS : P=DGEGS, D=JBYTOR, MBYTET, MBYTOR, MCBYT
- D=MCBYT, MSBIT, MSBIT0, MSBIT1, MSBYT,
-
-CORRECTIONS : P=QMDGE sequences Q$SBIT, Q$CBYT added
-
----------------------------------------------------------------------
-
-UP-DATE 1.05 : 14-MAY-1986
-----------------------------
-
-REPLACING FILE KERNDGE 1.04 860221 13.23
-
-CORRECTIONS : P=QMDGE sequences Q$ANDOR, Q$SHIFT added
-
----------------------------------------------------------------------
-
- FIRST RELEASE OF THE KERNDGE PAM : 21-FEB-1986
-
----------------------------------------------------------------------
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerndge/inhibit.list b/src/packlib/kernlib/kerngen/obsolete/kerndge/inhibit.list
deleted file mode 100644
index 39d1d26..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerndge/inhibit.list
+++ /dev/null
@@ -1,28 +0,0 @@
-tcgen/btest
-tcgen/ibits
-tcgen/ibclr
-tcgen/ibset
-tcgen/mvbits
-tcgen/ishft
-tcgen/ishftc
-tcgen/kerngt
-tcgen/gshow
-tcgen/cbyt
-tcgen/iuforw
-tcgen/iumode
-tcgen/locb
-tcgen/locf
-tcgen/ublow
-tcgen/ubunch
-tcgen/ucopy2
-tcgen/uctoh1
-tcgen/uctoh
-tcgen/uh1toc
-tcgen/uhtoc
-tcgen/xinb
-xvect/xinb
-tcgen/xinbs
-xvect/xinbs
-tcgen/datime
-tcgen/datimh
-tcgen/traceq
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerndge/kerndge/pilot.h b/src/packlib/kernlib/kerngen/obsolete/kerndge/kerndge/pilot.h
deleted file mode 100644
index ccf61b7..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerndge/kerndge/pilot.h
+++ /dev/null
@@ -1,39 +0,0 @@
-#if 0
-* This pilot patch was created from kerndge.car patch _kdge
-#endif
-#ifndef CERNLIB_QMDGE
-#define CERNLIB_QMDGE
-#endif
-#ifndef CERNLIB_DGEGS
-#define CERNLIB_DGEGS
-#endif
-#ifndef CERNLIB_DGESYS
-#define CERNLIB_DGESYS
-#endif
-#ifndef CERNLIB_XVECT
-#define CERNLIB_XVECT
-#endif
-#ifndef CERNLIB_TCGEN
-#define CERNLIB_TCGEN
-#endif
-#ifdef CERNLIB_TCGEN_BTEST
-#undef CERNLIB_TCGEN_BTEST
-#endif
-#ifdef CERNLIB_TCGEN_IBITS
-#undef CERNLIB_TCGEN_IBITS
-#endif
-#ifdef CERNLIB_TCGEN_IBCLR
-#undef CERNLIB_TCGEN_IBCLR
-#endif
-#ifdef CERNLIB_TCGEN_IBSET
-#undef CERNLIB_TCGEN_IBSET
-#endif
-#ifdef CERNLIB_TCGEN_MVBITS
-#undef CERNLIB_TCGEN_MVBITS
-#endif
-#ifdef CERNLIB_TCGEN_ISHFT
-#undef CERNLIB_TCGEN_ISHFT
-#endif
-#ifdef CERNLIB_TCGEN_ISHFTC
-#undef CERNLIB_TCGEN_ISHFTC
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerndge/kerndge/q_andor.inc b/src/packlib/kernlib/kerngen/obsolete/kerndge/kerndge/q_andor.inc
deleted file mode 100644
index 574e713..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerndge/kerndge/q_andor.inc
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: q_andor.inc,v 1.1.1.1 1996/02/15 17:54:24 mclareni Exp $
-*
-* $Log: q_andor.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:54:24 mclareni
-* Kernlib
-*
-*
-#ifndef CERNLIB_KERNDGE_Q_ANDOR_INC
-#define CERNLIB_KERNDGE_Q_ANDOR_INC
-*
-*
-* q_andor.inc
-*
-* IAND / IOR / IEOR / NOT are standard on DGE
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerndge/kerndge/q_cbyt.inc b/src/packlib/kernlib/kerngen/obsolete/kerndge/kerndge/q_cbyt.inc
deleted file mode 100644
index 6c3da69..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerndge/kerndge/q_cbyt.inc
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: q_cbyt.inc,v 1.1.1.1 1996/02/15 17:54:24 mclareni Exp $
-*
-* $Log: q_cbyt.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:54:24 mclareni
-* Kernlib
-*
-*
-#ifndef CERNLIB_KERNDGE_Q_CBYT_INC
-#define CERNLIB_KERNDGE_Q_CBYT_INC
-*
-*
-* q_cbyt.inc
-*
- MCBYT (MZ,IZQ,IZW,IZP,NZB) = IOR ( IAND (IZW, NOT(
- + ISHFT (ISHFT(NOT(0),-32+NZB), IZP-1)))
- + , ISHFT (ISHFT(ISHFT(MZ,-IZQ+1),32-NZB), -33+IZP+NZB) )
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerndge/kerndge/q_jbit.inc b/src/packlib/kernlib/kerngen/obsolete/kerndge/kerndge/q_jbit.inc
deleted file mode 100644
index ae9db8e..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerndge/kerndge/q_jbit.inc
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: q_jbit.inc,v 1.1.1.1 1996/02/15 17:54:25 mclareni Exp $
-*
-* $Log: q_jbit.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:54:25 mclareni
-* Kernlib
-*
-*
-#ifndef CERNLIB_KERNDGE_Q_JBIT_INC
-#define CERNLIB_KERNDGE_Q_JBIT_INC
-*
-*
-* q_jbit.inc
-*
- JBIT (IZW,IZP) = IBITS (IZW,IZP-1,1)
- JBYT (IZW,IZP,NZB) = IBITS (IZW,IZP-1,NZB)
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerndge/kerndge/q_jbytet.inc b/src/packlib/kernlib/kerngen/obsolete/kerndge/kerndge/q_jbytet.inc
deleted file mode 100644
index a08dde9..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerndge/kerndge/q_jbytet.inc
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: q_jbytet.inc,v 1.1.1.1 1996/02/15 17:54:25 mclareni Exp $
-*
-* $Log: q_jbytet.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:54:25 mclareni
-* Kernlib
-*
-*
-#ifndef CERNLIB_KERNDGE_Q_JBYTET_INC
-#define CERNLIB_KERNDGE_Q_JBYTET_INC
-*
-*
-* q_jbytet.inc
-*
- JBYTET (MZ,IZW,IZP,NZB) = IAND (MZ, IBITS(IZW,IZP-1,NZB))
- JBYTOR (MZ,IZW,IZP,NZB) = IOR (MZ, IBITS(IZW,IZP-1,NZB))
- MBYTET (MZ,IZW,IZP,NZB) = IAND (IZW, NOT(ISHFT (
- + ISHFT(NOT(MZ),32-NZB),-33+IZP+NZB)) )
- MBYTOR (MZ,IZW,IZP,NZB) = IOR (IZW, ISHFT (
- + ISHFT(MZ,32-NZB),-33+IZP+NZB) )
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerndge/kerndge/q_sbit.inc b/src/packlib/kernlib/kerngen/obsolete/kerndge/kerndge/q_sbit.inc
deleted file mode 100644
index 75b1df1..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerndge/kerndge/q_sbit.inc
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: q_sbit.inc,v 1.1.1.1 1996/02/15 17:54:25 mclareni Exp $
-*
-* $Log: q_sbit.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:54:25 mclareni
-* Kernlib
-*
-*
-#ifndef CERNLIB_KERNDGE_Q_SBIT_INC
-#define CERNLIB_KERNDGE_Q_SBIT_INC
-*
-*
-* q_sbit.inc
-*
- MSBIT0 (IZW,IZP) = IAND (IZW, NOT(ISHFT(1,IZP-1)) )
- MSBIT1 (IZW,IZP) = IOR (IZW, ISHFT(1,IZP-1) )
- MSBIT (MZ,IZW,IZP) = IOR (IAND (IZW, NOT(ISHFT(1,IZP-1)) )
- + , ISHFT(IAND(MZ,1),IZP-1))
- MSBYT (MZ,IZW,IZP,NZB) = IOR ( IAND (IZW, NOT(
- + ISHFT (ISHFT(NOT(0),-32+NZB), IZP-1)))
- + , ISHFT (ISHFT(MZ, 32-NZB), -33+IZP+NZB) )
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerndge/kerndge/q_shift.inc b/src/packlib/kernlib/kerngen/obsolete/kerndge/kerndge/q_shift.inc
deleted file mode 100644
index 5d95bcb..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerndge/kerndge/q_shift.inc
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: q_shift.inc,v 1.1.1.1 1996/02/15 17:54:25 mclareni Exp $
-*
-* $Log: q_shift.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:54:25 mclareni
-* Kernlib
-*
-*
-#ifndef CERNLIB_KERNDGE_Q_SHIFT_INC
-#define CERNLIB_KERNDGE_Q_SHIFT_INC
-*
-*
-* q_shift.inc
-*
- ISHFTL (IZW,NZB) = ISHFT (IZW, NZB)
- ISHFTR (IZW,NZB) = ISHFT (IZW, -NZB)
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerndge/kerndge/qcardl.inc b/src/packlib/kernlib/kerngen/obsolete/kerndge/kerndge/qcardl.inc
deleted file mode 100644
index b036e9a..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerndge/kerndge/qcardl.inc
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: qcardl.inc,v 1.1.1.1 1996/02/15 17:54:24 mclareni Exp $
-*
-* $Log: qcardl.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:54:24 mclareni
-* Kernlib
-*
-*
-#ifndef CERNLIB_KERNDGE_QCARDL_INC
-#define CERNLIB_KERNDGE_QCARDL_INC
-*
-*
-* qcardl.inc
-*
-#if 0
-C====================================================================
-#endif
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerndge/kerndge/qmdge.h b/src/packlib/kernlib/kerngen/obsolete/kerndge/kerndge/qmdge.h
deleted file mode 100644
index 0a31763..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerndge/kerndge/qmdge.h
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: qmdge.h,v 1.1.1.1 1996/02/15 17:54:24 mclareni Exp $
-*
-* $Log: qmdge.h,v $
-* Revision 1.1.1.1 1996/02/15 17:54:24 mclareni
-* Kernlib
-*
-*
-* This directory was created from kerndge.car patch qmdge
-#ifndef CERNLIB_F77
-#define CERNLIB_F77
-#endif
-#ifndef CERNLIB_A4
-#define CERNLIB_A4
-#endif
-#ifndef CERNLIB_B32
-#define CERNLIB_B32
-#endif
-#ifndef CERNLIB_HEX
-#define CERNLIB_HEX
-#endif
-* In-line AND / OR
-#ifndef CERNLIB_QANDORINL
-#define CERNLIB_QANDORINL
-#endif
-* In-line SHIFT L/R
-#ifndef CERNLIB_QSHIFTINL
-#define CERNLIB_QSHIFTINL
-#endif
-#ifndef CERNLIB_QSHICOINL
-#define CERNLIB_QSHICOINL
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerndos/dosprogs/fcasplit.F b/src/packlib/kernlib/kerngen/obsolete/kerndos/dosprogs/fcasplit.F
deleted file mode 100644
index 8b9f1d5..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerndos/dosprogs/fcasplit.F
+++ /dev/null
@@ -1,13 +0,0 @@
-*
-* $Id: fcasplit.F,v 1.1.1.1 1996/02/15 17:54:20 mclareni Exp $
-*
-* $Log: fcasplit.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:20 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
-#ifndef CERNLIB_UTYGEN_FCASPLIT
-#define CERNLIB_UTYGEN_FCASPLIT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernfor/qmalt/README b/src/packlib/kernlib/kerngen/obsolete/kernfor/qmalt/README
deleted file mode 100644
index d67b346..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernfor/qmalt/README
+++ /dev/null
@@ -1,42 +0,0 @@
-*
-* $Id: README,v 1.1.1.1 1996/02/15 17:54:09 mclareni Exp $
-*
-* $Log: README,v $
-* Revision 1.1.1.1 1996/02/15 17:54:09 mclareni
-* Kernlib
-*
-*
-* for Alliant
-* This directory was created from kernfor.car patch qmalt
-#ifndef CERNLIB_B32
-#define CERNLIB_B32
-#endif
-#ifndef CERNLIB_A4
-#define CERNLIB_A4
-#endif
-#ifndef CERNLIB_HEX
-#define CERNLIB_HEX
-#endif
-* running Unix
-#ifndef CERNLIB_QS_UNIX
-#define CERNLIB_QS_UNIX
-#endif
-* running BSD
-#ifndef CERNLIB_QSYSBSD
-#define CERNLIB_QSYSBSD
-#endif
-* BSD version for SETENVF
-#ifndef CERNLIB_QENVBSD
-#define CERNLIB_QENVBSD
-#endif
-* IEEE floating point
-#ifndef CERNLIB_QIEEE
-#define CERNLIB_QIEEE
-#endif
-* MIL standard routines, IBITS, MVBITS, etc
-#ifndef CERNLIB_QMILSTD
-#define CERNLIB_QMILSTD
-#endif
-#ifndef CERNLIB_QDEFAULT
-#define CERNLIB_QDEFAULT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernfor/qmamx/README b/src/packlib/kernlib/kerngen/obsolete/kernfor/qmamx/README
deleted file mode 100644
index 3d042c2..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernfor/qmamx/README
+++ /dev/null
@@ -1,38 +0,0 @@
-*
-* $Id: README,v 1.1.1.1 1996/02/15 17:54:09 mclareni Exp $
-*
-* $Log: README,v $
-* Revision 1.1.1.1 1996/02/15 17:54:09 mclareni
-* Kernlib
-*
-*
-* for Amiga Unix
-* This directory was created from kernfor.car patch qmamx
-#ifndef CERNLIB_B32
-#define CERNLIB_B32
-#endif
-#ifndef CERNLIB_A4
-#define CERNLIB_A4
-#endif
-#ifndef CERNLIB_HEX
-#define CERNLIB_HEX
-#endif
-* running Unix
-#ifndef CERNLIB_QS_UNIX
-#define CERNLIB_QS_UNIX
-#endif
-* Posix call for setjmp/longjmp
-#ifndef CERNLIB_QSIGJMP
-#define CERNLIB_QSIGJMP
-#endif
-* IEEE floating point
-#ifndef CERNLIB_QIEEE
-#define CERNLIB_QIEEE
-#endif
-* MIL standard routines, IBITS, MVBITS, etc
-#ifndef CERNLIB_QMILSTD
-#define CERNLIB_QMILSTD
-#endif
-#ifndef CERNLIB_QDEFAULT
-#define CERNLIB_QDEFAULT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernfor/qmapo/README b/src/packlib/kernlib/kerngen/obsolete/kernfor/qmapo/README
deleted file mode 100644
index fddc5fb..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernfor/qmapo/README
+++ /dev/null
@@ -1,45 +0,0 @@
-*
-* $Id: README,v 1.1.1.1 1996/02/15 17:54:09 mclareni Exp $
-*
-* $Log: README,v $
-* Revision 1.1.1.1 1996/02/15 17:54:09 mclareni
-* Kernlib
-*
-*
-* for Apollo
-* This directory was created from kernfor.car patch qmapo
-#ifndef CERNLIB_B32
-#define CERNLIB_B32
-#endif
-#ifndef CERNLIB_A4
-#define CERNLIB_A4
-#endif
-#ifndef CERNLIB_HEX
-#define CERNLIB_HEX
-#endif
-* double indirect adr for externals
-#ifndef CERNLIB_QCCINDAD
-#define CERNLIB_QCCINDAD
-#endif
-* running Unix
-#ifndef CERNLIB_QS_UNIX
-#define CERNLIB_QS_UNIX
-#endif
-* BSD version for SETENVF
-#ifndef CERNLIB_QENVBSD
-#define CERNLIB_QENVBSD
-#endif
-* IEEE floating point
-#ifndef CERNLIB_QIEEE
-#define CERNLIB_QIEEE
-#endif
-#if defined(CERNLIB_QMAPOF77)
-#ifndef CERNLIB_QF_APO77
-#define CERNLIB_QF_APO77
-#endif
-#endif
-#if defined(CERNLIB_QMAPOFTN)
-#ifndef CERNLIB_QF_APO
-#define CERNLIB_QF_APO
-#endif
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernfor/qmapo/iall1s.inc b/src/packlib/kernlib/kerngen/obsolete/kernfor/qmapo/iall1s.inc
deleted file mode 100644
index f13dfd2..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernfor/qmapo/iall1s.inc
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: iall1s.inc,v 1.1.1.1 1996/02/15 17:54:10 mclareni Exp $
-*
-* $Log: iall1s.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:54:10 mclareni
-* Kernlib
-*
-*
-* set a word of all ones
-*
-* iall1s.inc
-*
- INTEGER*4 IALL11
- PARAMETER (IALL11 = -1)
-#ifndef CERNLIB_QDEFAULT
-#define CERNLIB_QDEFAULT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernfor/qmapo/q_andor.inc b/src/packlib/kernlib/kerngen/obsolete/kernfor/qmapo/q_andor.inc
deleted file mode 100644
index d60b4c5..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernfor/qmapo/q_andor.inc
+++ /dev/null
@@ -1,14 +0,0 @@
-*
-* $Id: q_andor.inc,v 1.1.1.1 1996/02/15 17:54:09 mclareni Exp $
-*
-* $Log: q_andor.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:54:09 mclareni
-* Kernlib
-*
-*
-*
-* q_andor.inc
-*
- IAND (IZV,IZW) = AND (IZV, IZW)
- IOR (IZV,IZW) = OR (IZV, IZW)
- IEOR (IZV,IZW) = XOR (IZV, IZW)
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernfor/qmapo/q_shift.inc b/src/packlib/kernlib/kerngen/obsolete/kernfor/qmapo/q_shift.inc
deleted file mode 100644
index a6c3d09..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernfor/qmapo/q_shift.inc
+++ /dev/null
@@ -1,13 +0,0 @@
-*
-* $Id: q_shift.inc,v 1.1.1.1 1996/02/15 17:54:10 mclareni Exp $
-*
-* $Log: q_shift.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:54:10 mclareni
-* Kernlib
-*
-*
-*
-* q_shift.inc
-*
- ISHFTL (IZW,NZB) = LSHFT (IZW, NZB)
- ISHFTR (IZW,NZB) = RSHFT (IZW, NZB)
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernfor/qmcdc/README b/src/packlib/kernlib/kerngen/obsolete/kernfor/qmcdc/README
deleted file mode 100644
index 780cfca..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernfor/qmcdc/README
+++ /dev/null
@@ -1,38 +0,0 @@
-*
-* $Id: README,v 1.1.1.1 1996/02/15 17:54:10 mclareni Exp $
-*
-* $Log: README,v $
-* Revision 1.1.1.1 1996/02/15 17:54:10 mclareni
-* Kernlib
-*
-*
-* for CDC Fortran 4
-* This directory was created from kernfor.car patch qmcdc
-#ifndef CERNLIB_B60
-#define CERNLIB_B60
-#endif
-#ifndef CERNLIB_B60M
-#define CERNLIB_B60M
-#endif
-#ifndef CERNLIB_B48M
-#define CERNLIB_B48M
-#endif
-#ifndef CERNLIB_B36M
-#define CERNLIB_B36M
-#endif
-#ifndef CERNLIB_A10
-#define CERNLIB_A10
-#endif
-#ifndef CERNLIB_A8M
-#define CERNLIB_A8M
-#endif
-#ifndef CERNLIB_A6M
-#define CERNLIB_A6M
-#endif
-#ifndef CERNLIB_A5M
-#define CERNLIB_A5M
-#endif
-* ENTRY SYNTAX FOR CDC FORTRAN 4
-#ifndef CERNLIB_ENTRCDC
-#define CERNLIB_ENTRCDC
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernfor/qmcdc/iall1s.inc b/src/packlib/kernlib/kerngen/obsolete/kernfor/qmcdc/iall1s.inc
deleted file mode 100644
index 94cd719..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernfor/qmcdc/iall1s.inc
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: iall1s.inc,v 1.1.1.1 1996/02/15 17:54:10 mclareni Exp $
-*
-* $Log: iall1s.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:54:10 mclareni
-* Kernlib
-*
-*
-* set a word of all ones
-*
-* iall1s.inc
-*
- DATA IALL11 / -0 /
-#ifndef CERNLIB_QDEFAULT
-#define CERNLIB_QDEFAULT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernfor/qmcdc/wordsize.inc b/src/packlib/kernlib/kerngen/obsolete/kernfor/qmcdc/wordsize.inc
deleted file mode 100644
index f114cad..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernfor/qmcdc/wordsize.inc
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: wordsize.inc,v 1.1.1.1 1996/02/15 17:54:10 mclareni Exp $
-*
-* $Log: wordsize.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:54:10 mclareni
-* Kernlib
-*
-*
-*
-* wordsize.inc
-*
- DATA NBITPW/60/, NCHAPW/10/, NBITPC/6/
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernfor/qmcdcv/README b/src/packlib/kernlib/kerngen/obsolete/kernfor/qmcdcv/README
deleted file mode 100644
index 0f198f3..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernfor/qmcdcv/README
+++ /dev/null
@@ -1,37 +0,0 @@
-*
-* $Id: README,v 1.1.1.1 1996/02/15 17:54:10 mclareni Exp $
-*
-* $Log: README,v $
-* Revision 1.1.1.1 1996/02/15 17:54:10 mclareni
-* Kernlib
-*
-*
-* for CDC Cyber
-* This directory was created from kernfor.car patch qmcdcv
-#ifndef CERNLIB_B60
-#define CERNLIB_B60
-#endif
-#ifndef CERNLIB_B60M
-#define CERNLIB_B60M
-#endif
-#ifndef CERNLIB_B48M
-#define CERNLIB_B48M
-#endif
-#ifndef CERNLIB_B36M
-#define CERNLIB_B36M
-#endif
-#ifndef CERNLIB_A10
-#define CERNLIB_A10
-#endif
-#ifndef CERNLIB_A8M
-#define CERNLIB_A8M
-#endif
-#ifndef CERNLIB_A6M
-#define CERNLIB_A6M
-#endif
-#ifndef CERNLIB_A5M
-#define CERNLIB_A5M
-#endif
-#ifndef CERNLIB_QMCDC
-#define CERNLIB_QMCDC
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernfor/qmcdcv/iall1s.inc b/src/packlib/kernlib/kerngen/obsolete/kernfor/qmcdcv/iall1s.inc
deleted file mode 100644
index 87e839f..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernfor/qmcdcv/iall1s.inc
+++ /dev/null
@@ -1,13 +0,0 @@
-*
-* $Id: iall1s.inc,v 1.1.1.1 1996/02/15 17:54:10 mclareni Exp $
-*
-* $Log: iall1s.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:54:10 mclareni
-* Kernlib
-*
-*
-* set a word of all ones
-*
-* iall1s.inc
-*
- PARAMETER (IALL11 = .NOT. 0)
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernfor/qmcdcv/iallbl.inc b/src/packlib/kernlib/kerngen/obsolete/kernfor/qmcdcv/iallbl.inc
deleted file mode 100644
index ab9c5de..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernfor/qmcdcv/iallbl.inc
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: iallbl.inc,v 1.1.1.1 1996/02/15 17:54:10 mclareni Exp $
-*
-* $Log: iallbl.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:54:10 mclareni
-* Kernlib
-*
-*
-* set a word of all blanks
-*
-* iallbl.inc
-*
- PARAMETER (IALLBL = 8H )
-#ifndef CERNLIB_QDEFAULT
-#define CERNLIB_QDEFAULT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernfor/qmcdcv/wordsize.inc b/src/packlib/kernlib/kerngen/obsolete/kernfor/qmcdcv/wordsize.inc
deleted file mode 100644
index 8e285a0..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernfor/qmcdcv/wordsize.inc
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: wordsize.inc,v 1.1.1.1 1996/02/15 17:54:10 mclareni Exp $
-*
-* $Log: wordsize.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:54:10 mclareni
-* Kernlib
-*
-*
-*
-* wordsize.inc
-*
- PARAMETER (NBITPW=60, NCHAPW=10, NBITPC=6)
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernfor/qmcry/README b/src/packlib/kernlib/kerngen/obsolete/kernfor/qmcry/README
deleted file mode 100644
index 4e3f548..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernfor/qmcry/README
+++ /dev/null
@@ -1,39 +0,0 @@
-*
-* $Id: README,v 1.1.1.1 1996/02/15 17:54:11 mclareni Exp $
-*
-* $Log: README,v $
-* Revision 1.1.1.1 1996/02/15 17:54:11 mclareni
-* Kernlib
-*
-*
-* for Cray
-* This directory was created from kernfor.car patch qmcry
-#ifndef CERNLIB_B64
-#define CERNLIB_B64
-#endif
-#ifndef CERNLIB_B60M
-#define CERNLIB_B60M
-#endif
-#ifndef CERNLIB_B48M
-#define CERNLIB_B48M
-#endif
-#ifndef CERNLIB_B36M
-#define CERNLIB_B36M
-#endif
-#ifndef CERNLIB_A8
-#define CERNLIB_A8
-#endif
-#ifndef CERNLIB_A6M
-#define CERNLIB_A6M
-#endif
-#ifndef CERNLIB_A5M
-#define CERNLIB_A5M
-#endif
-* running Unix
-#ifndef CERNLIB_QS_UNIX
-#define CERNLIB_QS_UNIX
-#endif
-* external names capital
-#ifndef CERNLIB_QXCAPT
-#define CERNLIB_QXCAPT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernfor/qmcry/iallbl.inc b/src/packlib/kernlib/kerngen/obsolete/kernfor/qmcry/iallbl.inc
deleted file mode 100644
index c3133a0..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernfor/qmcry/iallbl.inc
+++ /dev/null
@@ -1,13 +0,0 @@
-*
-* $Id: iallbl.inc,v 1.1.1.1 1996/02/15 17:54:11 mclareni Exp $
-*
-* $Log: iallbl.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:54:11 mclareni
-* Kernlib
-*
-*
-* set a word of all blanks
-*
-* iallbl.inc
-*
- PARAMETER (IALLBL = X'2020202020202020')
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernfor/qmcry/q_andor.inc b/src/packlib/kernlib/kerngen/obsolete/kernfor/qmcry/q_andor.inc
deleted file mode 100644
index bbb1f3c..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernfor/qmcry/q_andor.inc
+++ /dev/null
@@ -1,15 +0,0 @@
-*
-* $Id: q_andor.inc,v 1.1.1.1 1996/02/15 17:54:11 mclareni Exp $
-*
-* $Log: q_andor.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:54:11 mclareni
-* Kernlib
-*
-*
-*
-* q_andor.inc
-*
- IAND (IZV,IZW) = IZV .AND. IZW
- IOR (IZV,IZW) = IZV .OR. IZW
- IEOR (IZV,IZW) = IZV .XOR. IZW
- NOT (IZW) = .NOT. IZW
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernfor/qmcry/q_shift.inc b/src/packlib/kernlib/kerngen/obsolete/kernfor/qmcry/q_shift.inc
deleted file mode 100644
index 913d651..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernfor/qmcry/q_shift.inc
+++ /dev/null
@@ -1,13 +0,0 @@
-*
-* $Id: q_shift.inc,v 1.1.1.1 1996/02/15 17:54:11 mclareni Exp $
-*
-* $Log: q_shift.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:54:11 mclareni
-* Kernlib
-*
-*
-*
-* q_shift.inc
-*
- ISHFTL (IZW,NZB) = SHIFTL (IZW, NZB)
- ISHFTR (IZW,NZB) = SHIFTR (IZW, NZB)
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernfor/qmcry/ublowx1.inc b/src/packlib/kernlib/kerngen/obsolete/kernfor/qmcry/ublowx1.inc
deleted file mode 100644
index 7156b3f..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernfor/qmcry/ublowx1.inc
+++ /dev/null
@@ -1,13 +0,0 @@
-*
-* $Id: ublowx1.inc,v 1.1.1.1 1996/02/15 17:54:11 mclareni Exp $
-*
-* $Log: ublowx1.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:54:11 mclareni
-* Kernlib
-*
-*
-*
-* ublowx1.inc
-*
- PARAMETER (IBLAN1 = X'0020202020202020')
- PARAMETER (MASK1 = X'FF00000000000000')
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernfor/qmcry/ubnchx1.inc b/src/packlib/kernlib/kerngen/obsolete/kernfor/qmcry/ubnchx1.inc
deleted file mode 100644
index fccf185..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernfor/qmcry/ubnchx1.inc
+++ /dev/null
@@ -1,15 +0,0 @@
-*
-* $Id: ubnchx1.inc,v 1.1.1.1 1996/02/15 17:54:11 mclareni Exp $
-*
-* $Log: ubnchx1.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:54:11 mclareni
-* Kernlib
-*
-*
-*
-* ubnchx1.inc
-*
- PARAMETER (MASK1 = X'FF00000000000000')
-#ifndef CERNLIB_QDEFAULT
-#define CERNLIB_QDEFAULT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernfor/qmcry/wordsizc.inc b/src/packlib/kernlib/kerngen/obsolete/kernfor/qmcry/wordsizc.inc
deleted file mode 100644
index 9331532..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernfor/qmcry/wordsizc.inc
+++ /dev/null
@@ -1,13 +0,0 @@
-*
-* $Id: wordsizc.inc,v 1.1.1.1 1996/02/15 17:54:11 mclareni Exp $
-*
-* $Log: wordsizc.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:54:11 mclareni
-* Kernlib
-*
-*
-*
-* wordsizc.inc
-*
-#define NBITPW 64 /* Number of bits per word */
-#define NBYTPW 8 /* Number of bytes per word */
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernfor/qmcry/wordsize.inc b/src/packlib/kernlib/kerngen/obsolete/kernfor/qmcry/wordsize.inc
deleted file mode 100644
index efc831c..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernfor/qmcry/wordsize.inc
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: wordsize.inc,v 1.1.1.1 1996/02/15 17:54:11 mclareni Exp $
-*
-* $Log: wordsize.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:54:11 mclareni
-* Kernlib
-*
-*
-*
-* wordsize.inc
-*
- PARAMETER (NBITPW=64, NCHAPW=8, NBITPC=8)
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernfor/qmcv32/README b/src/packlib/kernlib/kerngen/obsolete/kernfor/qmcv32/README
deleted file mode 100644
index 036deda..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernfor/qmcv32/README
+++ /dev/null
@@ -1,37 +0,0 @@
-*
-* $Id: README,v 1.1.1.1 1996/02/15 17:54:11 mclareni Exp $
-*
-* $Log: README,v $
-* Revision 1.1.1.1 1996/02/15 17:54:11 mclareni
-* Kernlib
-*
-*
-* for Convex 32 bits
-* This directory was created from kernfor.car patch qmcv32
-#ifndef CERNLIB_QMCVX
-#define CERNLIB_QMCVX
-#endif
-#ifndef CERNLIB_B32
-#define CERNLIB_B32
-#endif
-#ifndef CERNLIB_A4
-#define CERNLIB_A4
-#endif
-#ifndef CERNLIB_HEX
-#define CERNLIB_HEX
-#endif
-* running Unix
-#ifndef CERNLIB_QS_UNIX
-#define CERNLIB_QS_UNIX
-#endif
-* Posix call for setjmp/longjmp
-#ifndef CERNLIB_QSIGJMP
-#define CERNLIB_QSIGJMP
-#endif
-* MIL standard routines, IBITS, MVBITS, etc
-#ifndef CERNLIB_QMILSTD
-#define CERNLIB_QMILSTD
-#endif
-#ifndef CERNLIB_QDEFAULT
-#define CERNLIB_QDEFAULT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernfor/qmcv64/README b/src/packlib/kernlib/kerngen/obsolete/kernfor/qmcv64/README
deleted file mode 100644
index 5a7929a..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernfor/qmcv64/README
+++ /dev/null
@@ -1,49 +0,0 @@
-*
-* $Id: README,v 1.1.1.1 1996/02/15 17:54:12 mclareni Exp $
-*
-* $Log: README,v $
-* Revision 1.1.1.1 1996/02/15 17:54:12 mclareni
-* Kernlib
-*
-*
-* for Convex 64 bits
-* This directory was created from kernfor.car patch qmcv64
-#ifndef CERNLIB_QMCVX
-#define CERNLIB_QMCVX
-#endif
-#ifndef CERNLIB_B64
-#define CERNLIB_B64
-#endif
-#ifndef CERNLIB_B60M
-#define CERNLIB_B60M
-#endif
-#ifndef CERNLIB_B48M
-#define CERNLIB_B48M
-#endif
-#ifndef CERNLIB_B36M
-#define CERNLIB_B36M
-#endif
-#ifndef CERNLIB_A8
-#define CERNLIB_A8
-#endif
-#ifndef CERNLIB_A6M
-#define CERNLIB_A6M
-#endif
-#ifndef CERNLIB_A5M
-#define CERNLIB_A5M
-#endif
-#ifndef CERNLIB_HEX
-#define CERNLIB_HEX
-#endif
-* running Unix
-#ifndef CERNLIB_QS_UNIX
-#define CERNLIB_QS_UNIX
-#endif
-* Posix call for setjmp/longjmp
-#ifndef CERNLIB_QSIGJMP
-#define CERNLIB_QSIGJMP
-#endif
-* MIL standard routines, IBITS, MVBITS, etc
-#ifndef CERNLIB_QMILSTD
-#define CERNLIB_QMILSTD
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernfor/qmcv64/iallbl.inc b/src/packlib/kernlib/kerngen/obsolete/kernfor/qmcv64/iallbl.inc
deleted file mode 100644
index b2cc412..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernfor/qmcv64/iallbl.inc
+++ /dev/null
@@ -1,13 +0,0 @@
-*
-* $Id: iallbl.inc,v 1.1.1.1 1996/02/15 17:54:12 mclareni Exp $
-*
-* $Log: iallbl.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:54:12 mclareni
-* Kernlib
-*
-*
-* set a word of all blanks
-*
-* iallbl.inc
-*
- PARAMETER (IALLBL = '2020202020202020'X)
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernfor/qmcv64/ublowx1.inc b/src/packlib/kernlib/kerngen/obsolete/kernfor/qmcv64/ublowx1.inc
deleted file mode 100644
index 8c68453..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernfor/qmcv64/ublowx1.inc
+++ /dev/null
@@ -1,13 +0,0 @@
-*
-* $Id: ublowx1.inc,v 1.1.1.1 1996/02/15 17:54:12 mclareni Exp $
-*
-* $Log: ublowx1.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:54:12 mclareni
-* Kernlib
-*
-*
-*
-* ublowx1.inc
-*
- PARAMETER (IBLAN1 = '0020202020202020'X)
- PARAMETER (MASK1 = 'FF00000000000000'X)
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernfor/qmcv64/ubnchx1.inc b/src/packlib/kernlib/kerngen/obsolete/kernfor/qmcv64/ubnchx1.inc
deleted file mode 100644
index 30ceff0..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernfor/qmcv64/ubnchx1.inc
+++ /dev/null
@@ -1,15 +0,0 @@
-*
-* $Id: ubnchx1.inc,v 1.1.1.1 1996/02/15 17:54:12 mclareni Exp $
-*
-* $Log: ubnchx1.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:54:12 mclareni
-* Kernlib
-*
-*
-*
-* ubnchx1.inc
-*
- PARAMETER (MASK1 = 'FF00000000000000'X)
-#ifndef CERNLIB_QDEFAULT
-#define CERNLIB_QDEFAULT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernfor/qmcv64/wordsizc.inc b/src/packlib/kernlib/kerngen/obsolete/kernfor/qmcv64/wordsizc.inc
deleted file mode 100644
index f5f235d..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernfor/qmcv64/wordsizc.inc
+++ /dev/null
@@ -1,13 +0,0 @@
-*
-* $Id: wordsizc.inc,v 1.1.1.1 1996/02/15 17:54:12 mclareni Exp $
-*
-* $Log: wordsizc.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:54:12 mclareni
-* Kernlib
-*
-*
-*
-* wordsizc.inc
-*
-#define NBITPW 64 /* Number of bits per word */
-#define NBYTPW 8 /* Number of bytes per word */
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernfor/qmcv64/wordsize.inc b/src/packlib/kernlib/kerngen/obsolete/kernfor/qmcv64/wordsize.inc
deleted file mode 100644
index c51a9f4..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernfor/qmcv64/wordsize.inc
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: wordsize.inc,v 1.1.1.1 1996/02/15 17:54:12 mclareni Exp $
-*
-* $Log: wordsize.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:54:12 mclareni
-* Kernlib
-*
-*
-*
-* wordsize.inc
-*
- PARAMETER (NBITPW=64, NCHAPW=8, NBITPC=8)
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernfor/qmdge/README b/src/packlib/kernlib/kerngen/obsolete/kernfor/qmdge/README
deleted file mode 100644
index da3fc33..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernfor/qmdge/README
+++ /dev/null
@@ -1,30 +0,0 @@
-*
-* $Id: README,v 1.1.1.1 1996/02/15 17:54:12 mclareni Exp $
-*
-* $Log: README,v $
-* Revision 1.1.1.1 1996/02/15 17:54:12 mclareni
-* Kernlib
-*
-*
-* for Data General
-* This directory was created from kernfor.car patch qmdge
-#ifndef CERNLIB_B32
-#define CERNLIB_B32
-#endif
-#ifndef CERNLIB_A4
-#define CERNLIB_A4
-#endif
-#ifndef CERNLIB_HEX
-#define CERNLIB_HEX
-#endif
-* ISA standard routines, ISHFT, IOR, etc
-#ifndef CERNLIB_QISASTD
-#define CERNLIB_QISASTD
-#endif
-* MIL standard routines, IBITS, MVBITS, etc
-#ifndef CERNLIB_QMILSTD
-#define CERNLIB_QMILSTD
-#endif
-#ifndef CERNLIB_QDEFAULT
-#define CERNLIB_QDEFAULT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernfor/qmibm/README b/src/packlib/kernlib/kerngen/obsolete/kernfor/qmibm/README
deleted file mode 100644
index a0928bc..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernfor/qmibm/README
+++ /dev/null
@@ -1,39 +0,0 @@
-*
-* $Id: README,v 1.1.1.1 1996/02/15 17:54:13 mclareni Exp $
-*
-* $Log: README,v $
-* Revision 1.1.1.1 1996/02/15 17:54:13 mclareni
-* Kernlib
-*
-*
-* for IBM
-* This directory was created from kernfor.car patch qmibm
-* temporary for back-compatibility
-#if defined(CERNLIB_QMIBMFSI)
-#ifndef CERNLIB_QF_SIEM
-#define CERNLIB_QF_SIEM
-#endif
-#endif
-#if !defined(CERNLIB_QF_SIEM)
-#ifndef CERNLIB_QF_IBM
-#define CERNLIB_QF_IBM
-#endif
-#endif
-#ifndef CERNLIB_B32
-#define CERNLIB_B32
-#endif
-#ifndef CERNLIB_A4
-#define CERNLIB_A4
-#endif
-#ifndef CERNLIB_HEX
-#define CERNLIB_HEX
-#endif
-#ifndef CERNLIB_QEBCDIC
-#define CERNLIB_QEBCDIC
-#endif
-* ISA standard routines, ISHFT, IOR, etc
-#if defined(CERNLIB_QF_IBM)
-#ifndef CERNLIB_QISASTD
-#define CERNLIB_QISASTD
-#endif
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernfor/qmibm/iallbl.inc b/src/packlib/kernlib/kerngen/obsolete/kernfor/qmibm/iallbl.inc
deleted file mode 100644
index a7dba4e..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernfor/qmibm/iallbl.inc
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: iallbl.inc,v 1.1.1.1 1996/02/15 17:54:13 mclareni Exp $
-*
-* $Log: iallbl.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:54:13 mclareni
-* Kernlib
-*
-*
-* set a word of all blanks
-*
-* iallbl.inc
-*
- PARAMETER (IALLBL = 1077952576)
-#ifndef CERNLIB_QDEFAULT
-#define CERNLIB_QDEFAULT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernfor/qmibm/qnatch.inc b/src/packlib/kernlib/kerngen/obsolete/kernfor/qmibm/qnatch.inc
deleted file mode 100644
index 43a37a9..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernfor/qmibm/qnatch.inc
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: qnatch.inc,v 1.1.1.1 1996/02/15 17:54:13 mclareni Exp $
-*
-* $Log: qnatch.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:54:13 mclareni
-* Kernlib
-*
-*
-* Siemens compiler
-*
-* qnatch.inc
-*
-#if defined(CERNLIB_QF_SIEM)
- COMMON /QNATCH/ NATCH(256)
- INTEGER*2 NATCH
-#include "qnatchdata.inc"
-#endif
- INTEGER*2 NATCH(256)
-#include "qnatchdata.inc"
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernfor/qmibm/qnatchdata.inc b/src/packlib/kernlib/kerngen/obsolete/kernfor/qmibm/qnatchdata.inc
deleted file mode 100644
index ca78094..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernfor/qmibm/qnatchdata.inc
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: qnatchdata.inc,v 1.1.1.1 1996/02/15 17:54:13 mclareni Exp $
-*
-* $Log: qnatchdata.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:54:13 mclareni
-* Kernlib
-*
-*
-*
-* qnatchdata.inc
-*
- DATA NATCH / 64*0, 1, 9*0, 0, 6*1, 9*0, 8*1, 8*0, 6*1, 9*0
- +, 7*1, 0, 9*3, 0, 1, 5*0, 9*3, 0, 1, 5*0
- +, 0, 8*3, 3*0, 1, 15*0, 1, 2*0, 0, 9*4, 6*0
- +, 0, 9*4, 6*0, 1, 0, 8*4, 6*0, 10*2, 6*0 /
-C- Nature : 0 unseen, 1 others, 2 numeric, 3 lower, 4 upper case
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernfor/qmibx/README b/src/packlib/kernlib/kerngen/obsolete/kernfor/qmibx/README
deleted file mode 100644
index dd28857..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernfor/qmibx/README
+++ /dev/null
@@ -1,38 +0,0 @@
-*
-* $Id: README,v 1.1.1.1 1996/02/15 17:54:13 mclareni Exp $
-*
-* $Log: README,v $
-* Revision 1.1.1.1 1996/02/15 17:54:13 mclareni
-* Kernlib
-*
-*
-* for IBM 3090 with AIX
-* This directory was created from kernfor.car patch qmibx
-#ifndef CERNLIB_B32
-#define CERNLIB_B32
-#endif
-#ifndef CERNLIB_A4
-#define CERNLIB_A4
-#endif
-#ifndef CERNLIB_HEX
-#define CERNLIB_HEX
-#endif
-* running Unix
-#ifndef CERNLIB_QS_UNIX
-#define CERNLIB_QS_UNIX
-#endif
-* Posix call for setjmp/longjmp
-#ifndef CERNLIB_QSIGJMP
-#define CERNLIB_QSIGJMP
-#endif
-* ISA standard routines, ISHFT, IOR, etc
-#ifndef CERNLIB_QISASTD
-#define CERNLIB_QISASTD
-#endif
-* Double indirect adr for externals
-#ifndef CERNLIB_QCCINDAD
-#define CERNLIB_QCCINDAD
-#endif
-#ifndef CERNLIB_QDEFAULT
-#define CERNLIB_QDEFAULT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernfor/qmnd3/README b/src/packlib/kernlib/kerngen/obsolete/kernfor/qmnd3/README
deleted file mode 100644
index 58a3c92..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernfor/qmnd3/README
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: README,v 1.1.1.1 1996/02/15 17:54:14 mclareni Exp $
-*
-* $Log: README,v $
-* Revision 1.1.1.1 1996/02/15 17:54:14 mclareni
-* Kernlib
-*
-*
-* for Nord 500
-* This directory was created from kernfor.car patch qmnd3
-#ifndef CERNLIB_B32
-#define CERNLIB_B32
-#endif
-#ifndef CERNLIB_A4
-#define CERNLIB_A4
-#endif
-* ISA standard routines, ISHFT, IOR, etc
-#ifndef CERNLIB_QISASTD
-#define CERNLIB_QISASTD
-#endif
-#ifndef CERNLIB_ENTRET
-#define CERNLIB_ENTRET
-#endif
-#ifndef CERNLIB_QDEFAULT
-#define CERNLIB_QDEFAULT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernfor/qmpdp/README b/src/packlib/kernlib/kerngen/obsolete/kernfor/qmpdp/README
deleted file mode 100644
index 452f91e..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernfor/qmpdp/README
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: README,v 1.1.1.1 1996/02/15 17:54:14 mclareni Exp $
-*
-* $Log: README,v $
-* Revision 1.1.1.1 1996/02/15 17:54:14 mclareni
-* Kernlib
-*
-*
-* for PDP 10/20
-* This directory was created from kernfor.car patch qmpdp
-#ifndef CERNLIB_B36
-#define CERNLIB_B36
-#endif
-#ifndef CERNLIB_B36M
-#define CERNLIB_B36M
-#endif
-#ifndef CERNLIB_A5
-#define CERNLIB_A5
-#endif
-#ifndef CERNLIB_A5M
-#define CERNLIB_A5M
-#endif
-* ISA standard routines, ISHFT, IOR, etc
-#ifndef CERNLIB_QISASTD
-#define CERNLIB_QISASTD
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernfor/qmpdp/iallbl.inc b/src/packlib/kernlib/kerngen/obsolete/kernfor/qmpdp/iallbl.inc
deleted file mode 100644
index d98f865..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernfor/qmpdp/iallbl.inc
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: iallbl.inc,v 1.1.1.1 1996/02/15 17:54:14 mclareni Exp $
-*
-* $Log: iallbl.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:54:14 mclareni
-* Kernlib
-*
-*
-* set a word of all blanks
-*
-* iallbl.inc
-*
- PARAMETER (IALLBL = 5H )
-#ifndef CERNLIB_QDEFAULT
-#define CERNLIB_QDEFAULT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernfor/qmpdp/wordsize.inc b/src/packlib/kernlib/kerngen/obsolete/kernfor/qmpdp/wordsize.inc
deleted file mode 100644
index d6d4bb7..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernfor/qmpdp/wordsize.inc
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: wordsize.inc,v 1.1.1.1 1996/02/15 17:54:14 mclareni Exp $
-*
-* $Log: wordsize.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:54:14 mclareni
-* Kernlib
-*
-*
-*
-* wordsize.inc
-*
- PARAMETER (NBITPW=36, NCHAPW=5, NBITPC=7)
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernfor/qmtmo/README b/src/packlib/kernlib/kerngen/obsolete/kernfor/qmtmo/README
deleted file mode 100644
index 3fdcce6..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernfor/qmtmo/README
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: README,v 1.1.1.1 1996/02/15 17:54:15 mclareni Exp $
-*
-* $Log: README,v $
-* Revision 1.1.1.1 1996/02/15 17:54:15 mclareni
-* Kernlib
-*
-*
-* for Transputer
-* This directory was created from kernfor.car patch qmtmo
-#ifndef CERNLIB_B32
-#define CERNLIB_B32
-#endif
-#ifndef CERNLIB_A4
-#define CERNLIB_A4
-#endif
-#ifndef CERNLIB_HEX
-#define CERNLIB_HEX
-#endif
-* IEEE floating point
-#ifndef CERNLIB_QIEEE
-#define CERNLIB_QIEEE
-#endif
-* ISA standard routines, ISHFT, IOR, etc
-#ifndef CERNLIB_QISASTD
-#define CERNLIB_QISASTD
-#endif
-* Hollerith storage not orthodox
-#ifdef CERNLIB_QORTHOLL
-#undef CERNLIB_QORTHOLL
-#endif
-#ifndef CERNLIB_QDEFAULT
-#define CERNLIB_QDEFAULT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernfor/qmuni/README b/src/packlib/kernlib/kerngen/obsolete/kernfor/qmuni/README
deleted file mode 100644
index f6ec0b2..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernfor/qmuni/README
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: README,v 1.1.1.1 1996/02/15 17:54:15 mclareni Exp $
-*
-* $Log: README,v $
-* Revision 1.1.1.1 1996/02/15 17:54:15 mclareni
-* Kernlib
-*
-*
-* for Univac, Fortran 4
-* This directory was created from kernfor.car patch qmuni
-#ifndef CERNLIB_B36
-#define CERNLIB_B36
-#endif
-#ifndef CERNLIB_B36M
-#define CERNLIB_B36M
-#endif
-#ifndef CERNLIB_A6
-#define CERNLIB_A6
-#endif
-#ifndef CERNLIB_A6M
-#define CERNLIB_A6M
-#endif
-#ifndef CERNLIB_A5M
-#define CERNLIB_A5M
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernfor/qmuni/wordsize.inc b/src/packlib/kernlib/kerngen/obsolete/kernfor/qmuni/wordsize.inc
deleted file mode 100644
index bfde37c..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernfor/qmuni/wordsize.inc
+++ /dev/null
@@ -1,15 +0,0 @@
-*
-* $Id: wordsize.inc,v 1.1.1.1 1996/02/15 17:54:15 mclareni Exp $
-*
-* $Log: wordsize.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:54:15 mclareni
-* Kernlib
-*
-*
-*
-* wordsize.inc
-*
- DATA NBITPW/36/, NCHAPW/6/, NBITPC/6/
-#ifndef CERNLIB_QDEFAULT
-#define CERNLIB_QDEFAULT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernfor/qmuno/README b/src/packlib/kernlib/kerngen/obsolete/kernfor/qmuno/README
deleted file mode 100644
index 55090d7..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernfor/qmuno/README
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: README,v 1.1.1.1 1996/02/15 17:54:15 mclareni Exp $
-*
-* $Log: README,v $
-* Revision 1.1.1.1 1996/02/15 17:54:15 mclareni
-* Kernlib
-*
-*
-* for Univac
-* This directory was created from kernfor.car patch qmuno
-#ifndef CERNLIB_B36
-#define CERNLIB_B36
-#endif
-#ifndef CERNLIB_B36M
-#define CERNLIB_B36M
-#endif
-#ifndef CERNLIB_A4
-#define CERNLIB_A4
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernfor/qmuno/iallbl.inc b/src/packlib/kernlib/kerngen/obsolete/kernfor/qmuno/iallbl.inc
deleted file mode 100644
index e9bd986..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernfor/qmuno/iallbl.inc
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: iallbl.inc,v 1.1.1.1 1996/02/15 17:54:15 mclareni Exp $
-*
-* $Log: iallbl.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:54:15 mclareni
-* Kernlib
-*
-*
-* set a word of all blanks
-*
-* iallbl.inc
-*
- PARAMETER (IALLBL = 4H )
-#ifndef CERNLIB_QDEFAULT
-#define CERNLIB_QDEFAULT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernfor/qmuno/wordsize.inc b/src/packlib/kernlib/kerngen/obsolete/kernfor/qmuno/wordsize.inc
deleted file mode 100644
index 0475bef..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernfor/qmuno/wordsize.inc
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: wordsize.inc,v 1.1.1.1 1996/02/15 17:54:15 mclareni Exp $
-*
-* $Log: wordsize.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:54:15 mclareni
-* Kernlib
-*
-*
-*
-* wordsize.inc
-*
- PARAMETER (NBITPW=36, NCHAPW=4, NBITPC=9)
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernfor/tcgen/pkbytsv.F b/src/packlib/kernlib/kerngen/obsolete/kernfor/tcgen/pkbytsv.F
deleted file mode 100644
index e97fd19..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernfor/tcgen/pkbytsv.F
+++ /dev/null
@@ -1,74 +0,0 @@
-*
-* $Id: pkbytsv.F,v 1.1.1.1 1996/02/15 17:54:17 mclareni Exp $
-*
-* $Log: pkbytsv.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:17 mclareni
-* Kernlib
-*
-*
-* slow version saved
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_NOSHIFT)
- SUBROUTINE PKBYT (MIV,MBV,JTHP,NINTP,NBITS)
-C
-C CERN PROGLIB# M422 PKBYT .VERSION KERNFOR 4.08 840613
-C ORIG. 10/02/71, RE-WRITE 16/12/83 JZ
-C
- DIMENSION MIV(*), MBV(*), JTHP(9), NINTP(9), NBITS(2)
-C
-C
- JTH = JTHP(1)
- NINT = NINTP(1)
- IF (NINT.LE.0) RETURN
-C
- NZB = NBITS(1)
- IF (NZB.GT.0) GO TO 11
- NZB = 1
-#if defined(CERNLIB_B32)
- NPWD = 32
-#endif
-#if defined(CERNLIB_B36)
- NPWD = 36
-#endif
-#if defined(CERNLIB_B48)
- NPWD = 48
-#endif
-#if defined(CERNLIB_B60)
- NPWD = 60
-#endif
-#if defined(CERNLIB_B64)
- NPWD = 64
-#endif
- GO TO 12
-C
- 11 NPWD = NBITS(2)
-C
- 12 JBV = 1
- JIV = 0
- IF (JTH.LT.2) GO TO 21
- JBV = (JTH-1)/NPWD + 1
- JPOS = JTH - (JBV-1)*NPWD - 1
- IF (JPOS.EQ.0) GO TO 21
- JJ = JPOS*NZB + 1
- JIVE = NPWD - JPOS
- GO TO 22
-C
-C-- PACK EACH WORD
-C
- 21 JJ = 1
- JIVE = JIV + NPWD
- 22 JIVE = MIN0 (NINT,JIVE)
- IZW = MBV(JBV)
-C
- 24 JIV = JIV + 1
- CALL SBYT (MIV(JIV),IZW,JJ,NZB)
- IF (JIV.EQ.JIVE) GO TO 27
- JJ = JJ + NZB
- GO TO 24
-C
- 27 MBV(JBV) = IZW
- IF (JIV.EQ.NINT) RETURN
- JBV = JBV + 1
- GO TO 21
- END
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernfor/tcgen/traceqx.F b/src/packlib/kernlib/kerngen/obsolete/kernfor/tcgen/traceqx.F
deleted file mode 100644
index 6d9eedd..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernfor/tcgen/traceqx.F
+++ /dev/null
@@ -1,98 +0,0 @@
-*
-* $Id: traceqx.F,v 1.1.1.1 1996/02/15 17:54:17 mclareni Exp $
-*
-* $Log: traceqx.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:17 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QMCDC)||defined(CERNLIB_QMPDP)||defined(CERNLIB_QMUNO)
- SUBROUTINE TRACEQ (LUNP,NP)
-C
-C CERN PROGLIB# N105 TRACEQ .VERSION KERNFOR 4.23 891215
-C ORIG. 25/08/73 JZ
-C
-C- SUBROUTINE TO PRINT ON UNIT LUN THE FORTRAN SUBROUTINE TRACE-BACK
-C- NP LEVELS DEEP
-C- IT NEEDS A MACHINE LANGUAGE ROUTINE WITH 2 ENTRY-POINTS
-C- TRAC1Q -- INITIALISE TRACE-BACK
-C- TRAC2Q -- DELIVER NEXT STEP
-C- LOK -VE TRACE DESTROYED
-C- ZERO STEP OK, NAME,LINE,LADR ARE SET READY
-C- +VE STOP BECAUSE MAIN PROGRAM HAS BEEN DONE
-C- NAME BCD NAME OF THE CALLING ROUTINE
-C- LINE LINE NUMBER OF THE CALL IN THE CALLING ROUTINE
-C- (IF NEEDED)
-C- LADR ADDRESS OF THIS CALL
-C
-C--- SAMPLE OUTPUT
-C- TRACEQ
-C- CALLED FROM SUB2 LINE 45 AT LOCATION 002531
-C- CALLED FROM SUB1 LINE 164 AT LOCATION 007524
-C- CALLED FROM MAIN LINE 12 AT LOCATION 000632
-C
-#if !defined(CERNLIB_A6M)
- COMMON /SLATE/ NAME(2),LINE,LADR,LOK,LWK(35)
-#endif
-#if defined(CERNLIB_A6M)
- COMMON /SLATE/ NAME, LINE,LADR,LOK,LWK(36)
-#endif
-C
-C
- LUN = LUNP
- N = NP
- IF (LUN.NE.0) GO TO 21
- LUN = 6
-#if defined(CERNLIB_QMCDC)
- LUN = L"OUTPUT"
-#endif
-#if defined(CERNLIB_QMPDP)
- LUN = 3
-#endif
-#include "kerngen/traceqlun.inc"
-* Ignoring t=pass
-
- 21 WRITE (LUN,9021)
- LINE= 0
- LOK = 0
- CALL TRAC1Q
-C
- 24 N = N-1
- CALL TRAC2Q
- IF (LOK) 31,25,99
- 25 WRITE (LUN,9025) NAME,LINE,LADR
- IF (N.GT.0) GO TO 24
- RETURN
-C
- 31 WRITE (LUN,9031)
- 99 RETURN
-C
- 9021 FORMAT (7H0TRACEQ)
-#if (defined(CERNLIB_A6M))&&(!defined(CERNLIB_HEX))
- 9025 FORMAT (13H CALLED FROM ,A7, 6H LINE,I5,15H AT LOCATION ,O6)
-#endif
-#if (defined(CERNLIB_A6M))&&(defined(CERNLIB_HEX))
- 9025 FORMAT (13H CALLED FROM ,A7, 6H LINE,I5,15H AT LOCATION ,Z6)
-#endif
-#if (defined(CERNLIB_A5))&&(!defined(CERNLIB_HEX))
- 9025 FORMAT (13H CALLED FROM ,A5,A2,6H LINE,I5,15H AT LOCATION ,O6)
-#endif
-#if (defined(CERNLIB_A5))&&(defined(CERNLIB_HEX))
- 9025 FORMAT (13H CALLED FROM ,A5,A2,6H LINE,I5,15H AT LOCATION ,Z6)
-#endif
-#if (defined(CERNLIB_A4))&&(!defined(CERNLIB_HEX))
- 9025 FORMAT (13H CALLED FROM ,A4,A3,6H LINE,I5,15H AT LOCATION ,O6)
-#endif
-#if (defined(CERNLIB_A4))&&(defined(CERNLIB_HEX))
- 9025 FORMAT (13H CALLED FROM ,A4,A3,6H LINE,I5,15H AT LOCATION ,Z6)
-#endif
- 9031 FORMAT (26H ******* TRACE ENDS BADLY.)
- END
-#ifdef CERNLIB_TCGEN
-#undef CERNLIB_TCGEN
-#endif
-#ifdef CERNLIB_TRACEQ
-#undef CERNLIB_TRACEQ
-#endif
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernfor/tcgen/uflint.F b/src/packlib/kernlib/kerngen/obsolete/kernfor/tcgen/uflint.F
deleted file mode 100644
index 9035cfd..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernfor/tcgen/uflint.F
+++ /dev/null
@@ -1,84 +0,0 @@
-*
-* $Id: uflint.F,v 1.1.1.1 1996/02/15 17:54:17 mclareni Exp $
-*
-* $Log: uflint.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:17 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
-#if !defined(CERNLIB_TCGEN)
- SUBROUTINE UFLINT (VECT,NWP,MODEP)
-C
-C CERN PROGLIB# M251 UFLINT .VERSION KERNFOR 4.23 891215
-C ORIG. 01/10/77 JZ
-C
-C- CONVERT VECT(1->NWP) IN SITU TO FLOATING OR INTEGERS ACCORDING
-C- TO MODEP
-C
-C- PROGRAM WRITTEN 12-AUG-77, JZ
-C
- DIMENSION VECT(99), NWP(9), MODEP(9)
- EQUIVALENCE (A,IA), (B,IB)
- LOGICAL VARY
-C
-#if defined(CERNLIB_QMCV64)
- PARAMETER (JEX=53, NEX=12, NEG=4095 )
-#endif
-#if defined(CERNLIB_QMCRY)
- PARAMETER (JEX=49, NEX=16, NEG=65535)
-#endif
-#if defined(CERNLIB_QMCDC)
- PARAMETER (JEX=49, NEX=12, NEG=4095 )
-#endif
-#if defined(CERNLIB_QMUNI)||defined(CERNLIB_QMUNO)
- PARAMETER (JEX=28, NEX= 9, NEG= 511 )
-#endif
-#if defined(CERNLIB_QMPDP)
- PARAMETER (JEX=28, NEX= 9, NEG= 511 )
-#endif
-#if defined(CERNLIB_QMDGE)||defined(CERNLIB_QMIBM)
- PARAMETER (JEX=25, NEX= 8, NEG= 255 )
-#endif
-#if (defined(CERNLIB_QIEEE))&&(defined(CERNLIB_B32))
- PARAMETER (JEX=24, NEX= 9, NEG= 511 )
-#endif
-#if defined(CERNLIB_QMND3)
- PARAMETER (JEX=23, NEX=10, NEG=1023 )
-#endif
-C
-#include "kerngen/q_jbit.inc"
-* Ignoring t=pass
-C
-C
- NW = NWP(1)
- MODE= MODEP(1)
- N = 1 - NW
- VARY= .TRUE.
- IF (NW.LT.0) GO TO 31
- N = NW + 1
- VARY= .FALSE.
- JUSE= JBIT (MODE,1)
- GO TO 31
-C
- 30 VECT(N) = B
- 31 N = N - 1
- IF (N.EQ.0) RETURN
- IF (VARY) JUSE=JBIT(MODE,N)
- A = VECT(N)
- JCH = JBYT (IA,JEX,NEX)
- IF (JCH.EQ.0) GO TO 36
- IF (JCH.EQ.NEG) GO TO 36
-C
-C-- CONVERT TO INTEGER
-C
- IF (JUSE.EQ.0) GO TO 31
- IB = A
- GO TO 30
-C
-C-- CONVERT TO FLOATING
- 36 IF (JUSE.NE.0) GO TO 31
- B = IA
- GO TO 30
- END
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernfor/tcgen/uhollr.F b/src/packlib/kernlib/kerngen/obsolete/kernfor/tcgen/uhollr.F
deleted file mode 100644
index d9715ed..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernfor/tcgen/uhollr.F
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: uhollr.F,v 1.1.1.1 1996/02/15 17:54:17 mclareni Exp $
-*
-* $Log: uhollr.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:17 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
-#if !defined(CERNLIB_TCGEN)
- SUBROUTINE UHOLLR (VECT,NC,WORD)
-C
-C CERN PROGLIB# M415 UHOLLR .VERSION KERNFOR 4.18 880425
-C ORIG. 01/01/65
-C
- DIMENSION VECT(9),WORD(9)
-C
-#include "kerngen/wordsize.inc"
-C
- NW=(NC-1)/NCHAPW+1
- CALL UCOPY (WORD,VECT,NW)
- RETURN
- END
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernfor/tcgen/upkbytsv.F b/src/packlib/kernlib/kerngen/obsolete/kernfor/tcgen/upkbytsv.F
deleted file mode 100644
index 9b138dc..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernfor/tcgen/upkbytsv.F
+++ /dev/null
@@ -1,75 +0,0 @@
-*
-* $Id: upkbytsv.F,v 1.1.1.1 1996/02/15 17:54:17 mclareni Exp $
-*
-* $Log: upkbytsv.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:17 mclareni
-* Kernlib
-*
-*
-* slow version saved
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_NOSHIFT)
- SUBROUTINE UPKBYT (MBV,JTHP,MIV,NINTP,NBITS)
-C
-C CERN PROGLIB# M422 UPKBYT .VERSION KERNFOR 4.08 840613
-C ORIG. 10/02/71, RE-WRITE 16/12/83 JZ
-C
- DIMENSION MIV(*), MBV(*), JTHP(9), NINTP(9), NBITS(2)
-C
-#include "kerngen/q_jbit.inc"
-* Ignoring t=pass
-C
- JTH = JTHP(1)
- NINT = NINTP(1)
- IF (NINT.LE.0) RETURN
-C
- NZB = NBITS(1)
- IF (NZB.GT.0) GO TO 11
- NZB = 1
-#if defined(CERNLIB_B32)
- NPWD = 32
-#endif
-#if defined(CERNLIB_B36)
- NPWD = 36
-#endif
-#if defined(CERNLIB_B48)
- NPWD = 48
-#endif
-#if defined(CERNLIB_B60)
- NPWD = 60
-#endif
-#if defined(CERNLIB_B64)
- NPWD = 64
-#endif
- GO TO 12
-C
- 11 NPWD = NBITS(2)
-C
- 12 JBV = 1
- JIV = 0
- IF (JTH.LT.2) GO TO 21
- JBV = (JTH-1)/NPWD + 1
- JPOS = JTH - (JBV-1)*NPWD - 1
- IF (JPOS.EQ.0) GO TO 21
- JIVE = NPWD - JPOS
- JJ = JPOS*NZB + 1
- GO TO 22
-C
-C-- UNPACK EACH WORD
-C
- 21 JIVE = JIV + NPWD
- JJ = 1
- 22 JIVE = MIN0 (NINT,JIVE)
- IZW = MBV(JBV)
-C
- 24 JIV = JIV + 1
- MIV(JIV) = JBYT (IZW,JJ,NZB)
- IF (JIV.EQ.JIVE) GO TO 27
- JJ = JJ + NZB
- GO TO 24
-C
- 27 IF (JIV.EQ.NINT) RETURN
- JBV = JBV + 1
- GO TO 21
- END
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernfor/tcnum/Imakefile b/src/packlib/kernlib/kerngen/obsolete/kernfor/tcnum/Imakefile
deleted file mode 100644
index c965cba..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernfor/tcnum/Imakefile
+++ /dev/null
@@ -1,4 +0,0 @@
-SRCS_F= \ @@\
- atg.F erf.F fint.F freq.F prob.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernfor/tcnum/atg.F b/src/packlib/kernlib/kerngen/obsolete/kernfor/tcnum/atg.F
deleted file mode 100644
index 3ebb497..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernfor/tcnum/atg.F
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: atg.F,v 1.1.1.1 1996/02/15 17:54:15 mclareni Exp $
-*
-* $Log: atg.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:15 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- FUNCTION ATG (RSINA,RCOSA)
-C
-C CERN PROGLIB# B101 ATG .VERSION KERNFOR 4.21 890323
-C ORIG. 15/11/66 JZ, re-write 8/03/89 K.S.Koelbig
-C
- PARAMETER (PI = 3.14159 26535 89793)
-
- ATG = ATAN2(RSINA,RCOSA) + (PI-SIGN(PI,RSINA))
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernfor/tcnum/erf.F b/src/packlib/kernlib/kerngen/obsolete/kernfor/tcnum/erf.F
deleted file mode 100644
index 04c5215..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernfor/tcnum/erf.F
+++ /dev/null
@@ -1,242 +0,0 @@
-*
-* $Id: erf.F,v 1.1.1.1 1996/02/15 17:54:16 mclareni Exp $
-*
-* $Log: erf.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:16 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- FUNCTION ERF(X)
- LOGICAL CFN
-C ( CFN IS SET .FALSE. FOR ENTRY ERF AND .TRUE. FOR ENTRY ERFC. )
-C
-C ******************************************************************
-C
-C ENTRY POINTS ... ERF, ERFC.
-C
-C THESE TWO FUNCTIONS ARE COMPUTED FROM THE RATIONAL APPROXIMAT-
-C IONS OF W.J.CODY, MATHEMATICS OF COMPUTATION, VOLUME 22 (1969),
-C PAGES 631-637.
-C
-C FOR ABS(X) LE 0.47 THE BASIC FUNCTION IS ERF. FOR ABS(X) GT 0.47
-C THE BASIC FUNCTION IS ERFC. THE FINAL RESULT IS OBTAINED IN TERMS
-C OF THE BASIC FUNCTION AS SHOWN IN THE FOLLOWING TABLE, IN WHICH
-C A=ABS(X).
-C
-C FUNCTION A.LE.(0.47) A.GT.(0.47)
-C REQUIRED (ALL X) (NEGATIVE X) (POSITIVE X)
-C
-C ERF(X) ERF(X) ERFC(A)-1 1-ERFC(X)
-C
-C ERFC(X) 1-ERF(X) 2-ERFC(A) ERFC(X)
-C
-C ******************************************************************
-C
-#if defined(CERNLIB_NUMHIPRE)
- DIMENSION P1(4),Q1(4), P2(8),Q2(8), P3(5),Q3(5)
-C
-C (EACH DECIMAL CONSTANT HAS MAXMIMUM CDC NO-DIAGNOSTIC PRECISION.)
-C
- DATA CONST/ 0.56418 95835 4776 /
-C ( CONST=SQRT(1/PI). )
-C
-#endif
-#if defined(CERNLIB_NUMLOPRE)
- DIMENSION P1(3),Q1(3), P2(5),Q2(5), P3(3),Q3(3)
-C
- DATA CONST/ 0.56418 9584 /
-C ( CONST=SQRT(1/PI) . )
-C
-#endif
-#if defined(CERNLIB_NUME293)
- DATA XMAX/ 25.8 /
-#endif
-#if defined(CERNLIB_NUME75)
- DATA XMAX/ 13.0 /
-#endif
-#if defined(CERNLIB_NUME38)
- DATA XMAX/ 8.9 /
-#endif
-C ( XMAX=SQRT(-ALOG(RMIN)-10.0), WHERE RMIN IS THE SMALLEST NORMAL-
-C IZED REPRESENTABLE NUMBER. ERFC(XMAX) IS CLOSE TO THE UNDERFLOW
-C THRESHOLD. )
-C
-#if defined(CERNLIB_NUME293)
- DATA XUNIT/ 5.8 /
-#endif
-#if defined(CERNLIB_NUME75)
- DATA XUNIT/ 3.9 /
-#endif
-#if defined(CERNLIB_NUME38)
- DATA XUNIT/ 4.4 /
-#endif
-C ( XUNIT=SQRT(-ALOG(RELPR)+1.0), WHERE RELPR IS THE SMALLEST NUMBER
-C FOR WHICH 1.0+RELPR DIFFERS FROM 1.0. ERF(XUNIT) IS INDISTIN-
-C GUISHABLE FROM 1.0. )
-C
-#if defined(CERNLIB_NUMHIPRE)
- DATA P1/2.42667 95523 0532 E2,
- * 2.19792 61618 2942 E1,
- * 6.99638 34886 191 E0,
- * -3.56098 43701 815 E-2/
- DATA Q1/2.15058 87586 9861 E2,
- * 9.11649 05404 515 E1,
- * 1.50827 97630 4078 E1,
- * 1.00000 00000 0000 E0/
- DATA P2/3.00459 26102 016 E2,
- * 4.51918 95371 187 E2,
- * 3.39320 81673 434 E2,
- * 1.52989 28504 6940 E2,
- * 4.31622 27222 057 E1,
- * 7.21175 82508 831 E0,
- * 5.64195 51747 897 E-1,
- * -1.36864 85738 2717 E-7/
- DATA Q2/3.00459 26095 698 E2,
- * 7.90950 92532 790 E2,
- * 9.31354 09485 061 E2,
- * 6.38980 26446 563 E2,
- * 2.77585 44474 3988 E2,
- * 7.70001 52935 229 E1,
- * 1.27827 27319 6294 E1,
- * 1.00000 00000 0000 E0/
- DATA P3/-2.99610 70770 354 E-3,
- * -4.94730 91062 325 E-2,
- * -2.26956 59353 9687 E-1,
- * -2.78661 30860 9648 E-1,
- * -2.23192 45973 4185 E-2/
- DATA Q3/1.06209 23052 8468 E-2,
- * 1.91308 92610 7830 E-1,
- * 1.05167 51070 6793 E0,
- * 1.98733 20181 7135 E0,
- * 1.00000 00000 0000 E0/
-#endif
-#if defined(CERNLIB_NUMLOPRE)
- DATA P1/2.13853 322 E1,
- * 1.72227 577 E0,
- * 3.16652 891 E-1/
- DATA Q1/1.89522 572 E1,
- * 7.84374 571 E0,
- * 1.00000 000 E0/
- DATA P2/7.37388 831 E0,
- * 6.86501 848 E0,
- * 3.03179 934 E0,
- * 5.63169 619 E-1,
- * 4.31877 874 E-5/
- DATA Q2/7.37396 089 E0,
- * 1.51849 082 E1,
- * 1.27955 295 E1,
- * 5.35421 679 E0,
- * 1.00000 000 E0/
- DATA P3/-4.25799 644 E-2,
- * -1.96068 974 E-1,
- * -5.16882 262 E-2/
- DATA Q3/1.50942 071 E-1,
- * 9.21452 412 E-1,
- * 1.00000 000 E0/
-#endif
-C
-C ******************************************************************
-C
-C START.
-C
- CFN=.FALSE.
- T=X
- A=ABS(T)
- IF(A.LE.XUNIT) GO TO 2
- ERF=SIGN(1.0,T)
- RETURN
-C
-#if defined(CERNLIB_ENTRCDC)
- ENTRY ERFC
-#endif
-#if !defined(CERNLIB_ENTRCDC)
- ENTRY ERFC(X)
-#endif
- CFN=.TRUE.
- T=X
- A=ABS(T)
- IF(T.GE.-XUNIT) GO TO 1
-#if defined(CERNLIB_ENTRET)
- ERFC=2.0
-#endif
-#if !defined(CERNLIB_ENTRET)
- ERF=2.0
-#endif
- RETURN
- 1 IF(T.LE.XMAX) GO TO 2
-#if defined(CERNLIB_ENTRET)
- ERFC=0.0
-#endif
-#if !defined(CERNLIB_ENTRET)
- ERF=0.0
-#endif
- RETURN
-C
- 2 S=T**2
- IF(A.GT.0.47) GO TO 4
-C
-C SET Y=ERF(X), THEN TERMINATE.
-C
-#if defined(CERNLIB_NUMHIPRE)
- Y=T*(P1(1)+S*(P1(2)+S*(P1(3)+S*P1(4) )))
- * /(Q1(1)+S*(Q1(2)+S*(Q1(3)+S*Q1(4) )))
-#endif
-#if defined(CERNLIB_NUMLOPRE)
- Y=T*(P1(1)+S*(P1(2)+S*P1(3) ))
- * /(Q1(1)+S*(Q1(2)+S*Q1(3) ))
-#endif
- IF(CFN) GO TO 3
- ERF=Y
- RETURN
-#if defined(CERNLIB_ENTRET)
- 3 ERFC=1.0-Y
-#endif
-#if !defined(CERNLIB_ENTRET)
- 3 ERF=1.0-Y
-#endif
- RETURN
-C
-C SET Y=ERFC(A), THEN TERMINATE.
-C
- 4 IF(A.GT.4.) GO TO 5
-C
-#if defined(CERNLIB_NUMHIPRE)
- Y=EXP(-S)*(P2(1)+A*(P2(2)+A*(P2(3)+A*(P2(4)+A*(P2(5)+
- * A*(P2(6)+A*(P2(7)+A*P2(8) )))))))
- * /(Q2(1)+A*(Q2(2)+A*(Q2(3)+A*(Q2(4)+A*(Q2(5)+
- * A*(Q2(6)+A*(Q2(7)+A*Q2(8) )))))))
- GO TO 6
-C
- 5 R=1./A
- U=R**2
- Y=R*EXP(-S)*( CONST +
- * U*(P3(1)+U*(P3(2)+U*(P3(3)+U*(P3(4)+U*P3(5) ))))
- * /(Q3(1)+U*(Q3(2)+U*(Q3(3)+U*(Q3(4)+U*Q3(5) )))) )
-#endif
-#if defined(CERNLIB_NUMLOPRE)
- Y=EXP(-S)*(P2(1)+A*(P2(2)+A*(P2(3)+A*(P2(4)+A*P2(5) ))))
- * /(Q2(1)+A*(Q2(2)+A*(Q2(3)+A*(Q2(4)+A*Q2(5) ))))
- GO TO 6
-C
- 5 R=1.0/A
- U=R**2
- Y=R*EXP(-S)*( CONST + U*(P3(1)+U*P3(2))/(Q3(1)+U*Q3(2)) )
-#endif
-C
- 6 IF(CFN) GO TO 7
- ERF=SIGN(1.0-Y,T)
- RETURN
- 7 IF(T.LT.0.) Y=2.0-Y
-#if defined(CERNLIB_ENTRET)
- ERFC=Y
-#endif
-#if !defined(CERNLIB_ENTRET)
- ERF=Y
-#endif
- RETURN
-C
- END
-#ifdef CERNLIB_C300FORT_C300XX
-#undef CERNLIB_C300FORT_C300XX
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernfor/tcnum/fint.F b/src/packlib/kernlib/kerngen/obsolete/kernfor/tcnum/fint.F
deleted file mode 100644
index 4bd043a..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernfor/tcnum/fint.F
+++ /dev/null
@@ -1,74 +0,0 @@
-*
-* $Id: fint.F,v 1.1.1.1 1996/02/15 17:54:16 mclareni Exp $
-*
-* $Log: fint.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:16 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- FUNCTION FINT(NARG,ARG,NENT,ENT,TABLE)
-C
-C INTERPOLATION ROUTINE. AUTHOR C. LETERTRE.
-C MODIFIED BY B. SCHORR, 1.07.1982.
-C
- INTEGER NENT(NARG)
- REAL ARG(NARG),ENT(9), TABLE(9)
- INTEGER INDEX(32)
- REAL WEIGHT(32)
- FINT = 0.
- IF(NARG .LT. 1 .OR. NARG .GT. 5) RETURN
- LMAX = 0
- ISTEP = 1
- KNOTS = 1
- INDEX(1) = 1
- WEIGHT(1) = 1.
- DO 100 N = 1, NARG
- X = ARG(N)
- NDIM = NENT(N)
- LOCA = LMAX
- LMIN = LMAX + 1
- LMAX = LMAX + NDIM
- IF(NDIM .GT. 2) GOTO 10
- IF(NDIM .EQ. 1) GOTO 100
- H = X - ENT(LMIN)
- IF(H .EQ. 0.) GOTO 90
- ISHIFT = ISTEP
- IF(X-ENT(LMIN+1) .EQ. 0.) GOTO 21
- ISHIFT = 0
- ETA = H / (ENT(LMIN+1) - ENT(LMIN))
- GOTO 30
- 10 LOCB = LMAX + 1
- 11 LOCC = (LOCA+LOCB) / 2
- IF(X-ENT(LOCC)) 12, 20, 13
- 12 LOCB = LOCC
- GOTO 14
- 13 LOCA = LOCC
- 14 IF(LOCB-LOCA .GT. 1) GOTO 11
- LOCA = MIN( MAX(LOCA,LMIN), LMAX-1 )
- ISHIFT = (LOCA - LMIN) * ISTEP
- ETA = (X - ENT(LOCA)) / (ENT(LOCA+1) - ENT(LOCA))
- GOTO 30
- 20 ISHIFT = (LOCC - LMIN) * ISTEP
- 21 DO 22 K = 1, KNOTS
- INDEX(K) = INDEX(K) + ISHIFT
- 22 CONTINUE
- GOTO 90
- 30 DO 31 K = 1, KNOTS
- INDEX(K) = INDEX(K) + ISHIFT
- INDEX(K+KNOTS) = INDEX(K) + ISTEP
- WEIGHT(K+KNOTS) = WEIGHT(K) * ETA
- WEIGHT(K) = WEIGHT(K) - WEIGHT(K+KNOTS)
- 31 CONTINUE
- KNOTS = 2*KNOTS
- 90 ISTEP = ISTEP * NDIM
- 100 CONTINUE
- DO 200 K = 1, KNOTS
- I = INDEX(K)
- FINT = FINT + WEIGHT(K) * TABLE(I)
- 200 CONTINUE
- RETURN
- END
-#ifdef CERNLIB_E104FORT_FINT
-#undef CERNLIB_E104FORT_FINT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernfor/tcnum/freq.F b/src/packlib/kernlib/kerngen/obsolete/kernfor/tcnum/freq.F
deleted file mode 100644
index 75cbd0d..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernfor/tcnum/freq.F
+++ /dev/null
@@ -1,42 +0,0 @@
-*
-* $Id: freq.F,v 1.1.1.1 1996/02/15 17:54:16 mclareni Exp $
-*
-* $Log: freq.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:16 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- FUNCTION FREQ(X)
-#if defined(CERNLIB_NUMHIPRE)
- DATA CONST/ 0.70710 67811 8655 /
-#endif
-#if defined(CERNLIB_NUMLOPRE)
- DATA CONST/ 0.70710 6781 /
-#endif
-C ( CONST=SQRT(1/2). )
-C
-#if defined(CERNLIB_NUME293)
- DATA XMAX/ 25.8 /
-#endif
-#if defined(CERNLIB_NUME75)
- DATA XMAX/ 13.0 /
-#endif
-#if defined(CERNLIB_NUME38)
- DATA XMAX/ 8.9 /
-#endif
-C ( XMAX=SQRT(-ALOG(RMIN)-10.0), WHERE RMIN IS THE SMALLEST NORMAL-
-C IZED REPRESENTABLE NUMBER. ERFC(XMAX) IS CLOSE TO THE UNDERFLOW
-C THRESHOLD. )
-C
-C START.
- CX=CONST*X
- FREQ=0.
- IF(CX.LT.-XMAX) RETURN
- IF(CX.GE.0.) FREQ=0.5+0.5*ERF(CX)
- IF(CX.LT.0.) FREQ=0.5*ERFC(-CX)
- RETURN
- END
-#ifdef CERNLIB_C300FORT_FREQ
-#undef CERNLIB_C300FORT_FREQ
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernfor/tcnum/prob.F b/src/packlib/kernlib/kerngen/obsolete/kernfor/tcnum/prob.F
deleted file mode 100644
index 46d3d65..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernfor/tcnum/prob.F
+++ /dev/null
@@ -1,70 +0,0 @@
-*
-* $Id: prob.F,v 1.1.1.1 1996/02/15 17:54:16 mclareni Exp $
-*
-* $Log: prob.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:16 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- FUNCTION PROB (CHI2,N)
-C AUTHOR C.LETERTRE, REVISED BY B.SCHORR, 23.10.81
-C
-#if defined(CERNLIB_NUMHIPRE)
- DATA SRTOPI /0.79788456080287/
-#endif
-#if defined(CERNLIB_NUMLOPRE)
- DATA SRTOPI /0.7978846/
-#endif
-#if defined(CERNLIB_NUME293)
- DATA UPL /1300./
-#endif
-#if defined(CERNLIB_NUME75)
- DATA UPL /340./
-#endif
-#if defined(CERNLIB_NUME38)
- DATA UPL /170./
-#endif
- PROB=0.
- IF (N .LE. 0 .OR. CHI2 .LT. 0.) RETURN
- IF (N .GT. 100) GO TO 30
- IF (CHI2 .GT. UPL) RETURN
- EMYO2=EXP(-0.5*CHI2)
- SUM=1.
- TERM=1.
- M=N/2
- IF (2*M .NE. N) GO TO 1
-C-- ENTRY IF N IS EVEN
- IF (M .EQ. 1) GO TO 11
- DO 10 I=2,M
- FI=I-1
- TERM=0.5*TERM*CHI2/FI
- 10 SUM=SUM+TERM
- 11 PROB=EMYO2*SUM
- RETURN
-C-- ENTRY IF N IS ODD
- 1 SRTY=SQRT (CHI2)
- VALUE=2.*(1.-FREQ (SRTY))
- IF (N .NE. 1) GO TO 2
- PROB=VALUE
- RETURN
- 2 CONST=SRTOPI*SRTY*EMYO2
- IF (N .EQ. 3) GO TO 21
- K=M-1
- DO 20 I=1,K
- FI =I
- TERM=TERM*CHI2/(2.*FI+1.)
- 20 SUM=SUM+TERM
- 21 PROB=CONST*SUM+VALUE
- RETURN
-C-- USE ASYMPTOTIC FORMULA
- 30 ANU=1./FLOAT(N)
- AN9=ANU/4.5
- XP=1./3.
- Z=((CHI2*ANU)**XP - (1.-AN9)) / SQRT (AN9)
- PROB=1. - FREQ (Z)
- RETURN
- END
-#ifdef CERNLIB_G100FORT_PROB
-#undef CERNLIB_G100FORT_PROB
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernfor/tcnum/tcnum.h b/src/packlib/kernlib/kerngen/obsolete/kernfor/tcnum/tcnum.h
deleted file mode 100644
index 7de4485..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernfor/tcnum/tcnum.h
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: tcnum.h,v 1.1.1.1 1996/02/15 17:54:16 mclareni Exp $
-*
-* $Log: tcnum.h,v $
-* Revision 1.1.1.1 1996/02/15 17:54:16 mclareni
-* Kernlib
-*
-*
-* This directory was created from kernfor.car patch tcnum
-#if !defined(CERNLIB_TCNUM)
-
- GENSEC ROUTINES EXTRACTED FROM KERNNUM PAM
- THIS PATCH SHOULD ONLY BE +USE'ED TO BUILD A GENSEC LIBRARY
- BUT NOT FOR MAKING A FULL KERNLIB
-
-#endif
-#if defined(CERNLIB_B32)
-#ifndef CERNLIB_NUMLOPRE
-#define CERNLIB_NUMLOPRE
-#endif
-#endif
-#if defined(CERNLIB_B60M)
-#ifndef CERNLIB_NUME293
-#define CERNLIB_NUME293
-#endif
-#endif
-#if defined(CERNLIB_QMND3)||defined(CERNLIB_QMVAX)
-#ifndef CERNLIB_NUME38
-#define CERNLIB_NUME38
-#endif
-#endif
-#if !defined(CERNLIB_NUMLOPRE)
-#ifndef CERNLIB_NUMHIPRE
-#define CERNLIB_NUMHIPRE
-#endif
-#endif
-#if (!defined(CERNLIB_NUME38))&&(!defined(CERNLIB_NUME293))
-#ifndef CERNLIB_NUME75
-#define CERNLIB_NUME75
-#endif
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernfor/utygen/Imakefile b/src/packlib/kernlib/kerngen/obsolete/kernfor/utygen/Imakefile
deleted file mode 100644
index dfd737d..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernfor/utygen/Imakefile
+++ /dev/null
@@ -1,4 +0,0 @@
-SRCS_F= \ @@\
- fcasplit.F xbanner.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernfor/utygen/fcasplit.F b/src/packlib/kernlib/kerngen/obsolete/kernfor/utygen/fcasplit.F
deleted file mode 100644
index b9c4c3f..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernfor/utygen/fcasplit.F
+++ /dev/null
@@ -1,1157 +0,0 @@
-*
-* $Id: fcasplit.F,v 1.1.1.1 1996/02/15 17:54:16 mclareni Exp $
-*
-* $Log: fcasplit.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:16 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- PROGRAM FCASPLIT
-
-C CERN PROGLIB# FCASPLIT .VERSION KERNFOR 4.40 940929
-C ORIG. 01/10/88 JZ
-
-#if defined(CERNLIB_QF_APO)
- INTEGER*2 JARGA2, NARGSA2, PGM_$GET_ARG
-#endif
-#if !defined(CERNLIB_QMAMX)
- PARAMETER (NARADD = 0)
-#endif
- CHARACTER CHIDF*8, CHIDC*8, CHIDA*8, CHIDD*4
- CHARACTER CHIDX*7, CHIDY*6, CHOVER*(*)
- CHARACTER CHPOF*(*), CHPOC*(*), CHPOA*(*)
- CHARACTER CHEXFOR*(*), CHEXCC*(*), CHEXAS*(*)
- CHARACTER CHWHF*(*), CHWHC*(*), CHWHA*(*)
- CHARACTER CHEXOBJ*(*)
-
- PARAMETER (CHIDF = 'CDECK I' )
- PARAMETER (CHIDC = '/*DECK I' )
- PARAMETER (CHIDX = 'DECK I' )
- PARAMETER (CHIDY = 'DECK I' )
- PARAMETER (CHIDD = 'D>, ' )
-
-#if (!defined(CERNLIB_QMAPO10))&&(defined(CERNLIB_QF_APO))
- PARAMETER (CHIDA = ';DECK I' )
- PARAMETER (CHOVER= 'OVERWRITE')
-
- PARAMETER (CHPOF =
- + '-bounds_violation -info 1 -indexl -opt 3 -cpu mathlib_sr10')
- PARAMETER (CHPOC = '-c -O')
- PARAMETER (CHPOA = ' ')
-
- PARAMETER (CHEXFOR = '.ftn')
- PARAMETER (CHEXCC = '.c')
- PARAMETER (CHEXAS = '.s')
- PARAMETER (CHEXOBJ = '.bin')
-
- PARAMETER (CHWHF = '/com/ftn ')
- PARAMETER (CHWHC = 'cc ')
- PARAMETER (CHWHA = 'as ')
-#endif
-#if (defined(CERNLIB_QMAPO10))&&(defined(CERNLIB_QF_APO))
- PARAMETER (CHIDA = ';DECK I' )
- PARAMETER (CHOVER= 'OVERWRITE')
-
- PARAMETER (CHPOF =
- + '-bounds_violation -info 1 -indexl -opt 2 -cpu a88k')
- PARAMETER (CHPOC = '-c -O')
- PARAMETER (CHPOA = ' ')
-
- PARAMETER (CHEXFOR = '.ftn')
- PARAMETER (CHEXCC = '.c')
- PARAMETER (CHEXAS = '.s')
- PARAMETER (CHEXOBJ = '.bin')
-
- PARAMETER (CHWHF = '/com/ftn ')
- PARAMETER (CHWHC = 'cc ')
- PARAMETER (CHWHA = 'as ')
-#endif
-#if (!defined(CERNLIB_QMAPO10))&&(defined(CERNLIB_QF_APO77))
- PARAMETER (CHIDA = ';DECK I' )
- PARAMETER (CHOVER= 'OVERWRITE')
-
- PARAMETER (CHPOF = '-c -O3 -A cpu,mathlib_sr10' //
- + ' -W0,-bounds_violation -W0,-info,1 -W0,-indexl')
- PARAMETER (CHPOC = '-c -O')
- PARAMETER (CHPOA = ' ')
-
- PARAMETER (CHEXFOR = '.f')
- PARAMETER (CHEXCC = '.c')
- PARAMETER (CHEXAS = '.s')
- PARAMETER (CHEXOBJ = '.o')
-
- PARAMETER (CHWHF = 'f77 ')
- PARAMETER (CHWHC = 'cc ')
- PARAMETER (CHWHA = 'as ')
-#endif
-#if (defined(CERNLIB_QMAPO10))&&(defined(CERNLIB_QF_APO77))
- PARAMETER (CHIDA = ';DECK I' )
- PARAMETER (CHOVER= 'OVERWRITE')
-
- PARAMETER (CHPOF = '-c -O2 -A cpu,a88k' //
- + ' -W0,-bounds_violation -W0,-info,1 -W0,-indexl')
- PARAMETER (CHPOC = '-c -O')
- PARAMETER (CHPOA = ' ')
-
- PARAMETER (CHEXFOR = '.f')
- PARAMETER (CHEXCC = '.c')
- PARAMETER (CHEXAS = '.s')
- PARAMETER (CHEXOBJ = '.o')
-
- PARAMETER (CHWHF = 'f77 ')
- PARAMETER (CHWHC = 'cc ')
- PARAMETER (CHWHA = 'as ')
-#endif
-#if defined(CERNLIB_QMALT)
- PARAMETER (CHIDA = '|DECK I' )
- PARAMETER (CHOVER= 'UNKNOWN')
-
- PARAMETER (CHPOF = '-c -Og -w')
- PARAMETER (CHPOC = '-c -Og')
- PARAMETER (CHPOA = ' ')
-
- PARAMETER (CHEXFOR = '.f')
- PARAMETER (CHEXCC = '.c')
- PARAMETER (CHEXAS = '.s')
- PARAMETER (CHEXOBJ = '.o')
-
- PARAMETER (CHWHF = 'fortran ')
- PARAMETER (CHWHC = 'fxc ')
- PARAMETER (CHWHA = 'as ')
-#endif
-#if defined(CERNLIB_QMAMX)
- PARAMETER (NARADD = -1)
- PARAMETER (CHIDA = '|DECK I' )
- PARAMETER (CHOVER= 'UNKNOWN')
-
- PARAMETER (CHPOF = '-c -q -O')
- PARAMETER (CHPOC = '-c')
- PARAMETER (CHPOA = ' ')
-
- PARAMETER (CHEXFOR = '.f')
- PARAMETER (CHEXCC = '.c')
- PARAMETER (CHEXAS = '.s')
- PARAMETER (CHEXOBJ = '.o')
-
- PARAMETER (CHWHF = 'ftn ')
- PARAMETER (CHWHC = 'cc ')
- PARAMETER (CHWHA = 'as ')
-#endif
-#if defined(CERNLIB_QMCRY)
- PARAMETER (CHIDA = '*DECK I' )
- PARAMETER (CHOVER= 'UNKNOWN')
-
- PARAMETER (CHPOF = ' ')
- PARAMETER (CHPOC = '-c')
- PARAMETER (CHPOA = ' ')
-
- PARAMETER (CHEXFOR = '.f')
- PARAMETER (CHEXCC = '.c')
- PARAMETER (CHEXAS = '.s')
- PARAMETER (CHEXOBJ = '.o')
-
- PARAMETER (CHWHF = 'cft77 ')
- PARAMETER (CHWHC = 'scc ')
- PARAMETER (CHWHA = 'as ')
-#endif
-#if defined(CERNLIB_QMCV64)
- PARAMETER (CHIDA = ';DECK I' )
- PARAMETER (CHOVER= 'UNKNOWN')
-
- PARAMETER (CHPOF = '-c -O -p8 -72')
- PARAMETER (CHPOC = '-c -O')
- PARAMETER (CHPOA = ' ')
-
- PARAMETER (CHEXFOR = '.f')
- PARAMETER (CHEXCC = '.c')
- PARAMETER (CHEXAS = '.s')
- PARAMETER (CHEXOBJ = '.o')
-
- PARAMETER (CHWHF = 'fc ')
- PARAMETER (CHWHC = 'cc ')
- PARAMETER (CHWHA = 'as ')
-#endif
-#if defined(CERNLIB_QMCV32)
- PARAMETER (CHIDA = ';DECK I' )
- PARAMETER (CHOVER= 'UNKNOWN')
-
- PARAMETER (CHPOF = '-c -O -fi -72')
- PARAMETER (CHPOC = '-c -O')
- PARAMETER (CHPOA = ' ')
-
- PARAMETER (CHEXFOR = '.f')
- PARAMETER (CHEXCC = '.c')
- PARAMETER (CHEXAS = '.s')
- PARAMETER (CHEXOBJ = '.o')
-
- PARAMETER (CHWHF = 'fc ')
- PARAMETER (CHWHC = 'cc ')
- PARAMETER (CHWHA = 'as ')
-#endif
-#if (defined(CERNLIB_QMDOS))&&(defined(CERNLIB_QF_NDP))
- PARAMETER (CHIDA = ';DECK I' )
- PARAMETER (CHOVER= 'UNKNOWN')
-
- PARAMETER (CHPOF = '-c -vm')
- PARAMETER (CHPOC = '-c -n2 -n3 -OLM')
- PARAMETER (CHPOA = '-c')
-
- PARAMETER (CHEXFOR = '.f')
- PARAMETER (CHEXCC = '.c')
- PARAMETER (CHEXAS = '.s')
- PARAMETER (CHEXOBJ = '.obj')
-
- PARAMETER (CHWHF = 'mf486 ')
- PARAMETER (CHWHC = 'cc ')
- PARAMETER (CHWHA = '386ASM ')
-#endif
-#if (defined(CERNLIB_QMDOS))&&(defined(CERNLIB_QF_F2C))
- PARAMETER (CHIDA = ';DECK I' )
- PARAMETER (CHOVER= 'UNKNOWN')
-
- PARAMETER (CHPOF = '-w -Nn802 -Nx802 -NC802')
- PARAMETER (CHPOC = '-c ')
- PARAMETER (CHPOA = '-c')
-
- PARAMETER (CHEXFOR = '.f')
- PARAMETER (CHEXCC = '.c')
- PARAMETER (CHEXAS = '.s')
- PARAMETER (CHEXOBJ = '.o')
-
- PARAMETER (CHWHF = 'f2c ')
- PARAMETER (CHWHC = 'gcc ')
- PARAMETER (CHWHA = 'as ')
-#endif
-#if (defined(CERNLIB_QMDOS))&&(defined(CERNLIB_QF_DEC))
- PARAMETER (CHIDA = ';DECK I' )
- PARAMETER (CHOVER= 'UNKNOWN')
-
- PARAMETER (CHPOF = '-nolink')
- PARAMETER (CHPOC = '-c -DWIN32')
- PARAMETER (CHPOA = '-c')
-
- PARAMETER (CHEXFOR = '.f')
- PARAMETER (CHEXCC = '.c')
- PARAMETER (CHEXAS = '.s')
- PARAMETER (CHEXOBJ = '.obj')
-
- PARAMETER (CHWHF = 'f77 ')
- PARAMETER (CHWHC = 'claxp ')
- PARAMETER (CHWHA = 'ASM ')
-#endif
-#if defined(CERNLIB_QMHPX)
- PARAMETER (CHIDA = '|DECK I' )
- PARAMETER (CHOVER= 'UNKNOWN')
-
- PARAMETER (CHPOF = '-c -O -w +ppu')
- PARAMETER (CHPOC = '-c -O')
- PARAMETER (CHPOA = ' ')
-
- PARAMETER (CHEXFOR = '.f')
- PARAMETER (CHEXCC = '.c')
- PARAMETER (CHEXAS = '.s')
- PARAMETER (CHEXOBJ = '.o')
-
- PARAMETER (CHWHF = 'f77 ')
- PARAMETER (CHWHC = 'cc ')
- PARAMETER (CHWHA = 'as ')
-#endif
-#if defined(CERNLIB_QMIBX)
- PARAMETER (CHIDA = '*DECK I' )
- PARAMETER (CHOVER= 'UNKNOWN')
-
- PARAMETER (CHPOF = '-c -f''opt(3)'' -f''CL(8192)'' ')
- PARAMETER (CHPOC = '-c -O')
- PARAMETER (CHPOA = ' ')
-
- PARAMETER (CHEXFOR = '.f')
- PARAMETER (CHEXCC = '.c')
- PARAMETER (CHEXAS = '.s')
- PARAMETER (CHEXOBJ = '.o')
-
- PARAMETER (CHWHF = 'fvs ')
- PARAMETER (CHWHC = 'cc ')
- PARAMETER (CHWHA = 'as ')
-#endif
-#if defined(CERNLIB_QMIRT)
- PARAMETER (CHIDA = ';DECK I' )
- PARAMETER (CHOVER= 'UNKNOWN')
-
- PARAMETER (CHPOF = '-c -O -qextname -qcharlen=8192')
- PARAMETER (CHPOC = '-c -O')
- PARAMETER (CHPOA = ' ')
-
- PARAMETER (CHEXFOR = '.f')
- PARAMETER (CHEXCC = '.c')
- PARAMETER (CHEXAS = '.s')
- PARAMETER (CHEXOBJ = '.o')
-
- PARAMETER (CHWHF = 'xlf ')
- PARAMETER (CHWHC = 'cc ')
- PARAMETER (CHWHA = 'as ')
-#endif
-#if defined(CERNLIB_QMLNX)
- CHARACTER CHIDA2*8
- PARAMETER (CHIDA2= ' #DECK I' )
- PARAMETER (CHIDA = ';DECK I' )
- PARAMETER (CHOVER= 'UNKNOWN')
-
- PARAMETER (CHPOF = '-c -O2 -Nx800 -Nc200')
- PARAMETER (CHPOC = '-c -O2 -posix')
- PARAMETER (CHPOA = ' ')
-
- PARAMETER (CHEXFOR = '.f')
- PARAMETER (CHEXCC = '.c')
- PARAMETER (CHEXAS = '.s')
- PARAMETER (CHEXOBJ = '.o')
-
- PARAMETER (CHWHF = 'f77 ')
- PARAMETER (CHWHC = 'cc ')
- PARAMETER (CHWHA = 'as ')
-#endif
-#if defined(CERNLIB_QMNXT)
- PARAMETER (CHIDA = '|DECK I' )
- PARAMETER (CHOVER= 'UNKNOWN')
-
-
- PARAMETER (CHPOF = '-c -O')
- PARAMETER (CHPOC = '-c -O')
- PARAMETER (CHPOA = ' ')
-
-
- PARAMETER (CHEXFOR = '.f')
- PARAMETER (CHEXCC = '.c')
- PARAMETER (CHEXAS = '.s')
- PARAMETER (CHEXOBJ = '.o')
-
-
- PARAMETER (CHWHF = 'f77 ')
- PARAMETER (CHWHC = 'cc ')
- PARAMETER (CHWHA = 'as ')
-#endif
-#if defined(CERNLIB_QMOS9)
- PARAMETER (CHIDA = '|DECK I' )
- PARAMETER (CHOVER= 'UNKNOWN')
-
- PARAMETER (CHPOF = '-R -E -!it -A -h')
- PARAMETER (CHPOC = '-c -O')
- PARAMETER (CHPOA = ' ')
-
- PARAMETER (CHEXFOR = '.f')
- PARAMETER (CHEXCC = '.c')
- PARAMETER (CHEXAS = '.s')
- PARAMETER (CHEXOBJ = '.o')
-
- PARAMETER (CHWHF = 'f77 ')
- PARAMETER (CHWHC = 'xcc ')
- PARAMETER (CHWHA = 'as ')
-#endif
-#if defined(CERNLIB_QMSGI)
- PARAMETER (CHIDA = '|DECK I' )
- PARAMETER (CHOVER= 'UNKNOWN')
-
- PARAMETER (CHPOF = '-c -O')
- PARAMETER (CHPOC = '-c -O')
- PARAMETER (CHPOA = ' ')
-
- PARAMETER (CHEXFOR = '.f')
- PARAMETER (CHEXCC = '.c')
- PARAMETER (CHEXAS = '.s')
- PARAMETER (CHEXOBJ = '.o')
-
- PARAMETER (CHWHF = 'f77 ')
- PARAMETER (CHWHC = 'cc ')
- PARAMETER (CHWHA = 'as ')
-#endif
-#if defined(CERNLIB_QMSUN)
- PARAMETER (CHIDA = '|DECK I' )
- PARAMETER (CHOVER= 'UNKNOWN')
-
- PARAMETER (CHPOF = '-c -O -w66')
- PARAMETER (CHPOC = '-c -O')
- PARAMETER (CHPOA = ' ')
-
- PARAMETER (CHEXFOR = '.f')
- PARAMETER (CHEXCC = '.c')
- PARAMETER (CHEXAS = '.s')
- PARAMETER (CHEXOBJ = '.o')
-
- PARAMETER (CHWHF = 'f77 ')
- PARAMETER (CHWHC = 'cc ')
- PARAMETER (CHWHA = 'as ')
-#endif
-#if defined(CERNLIB_QMTMO)
- PARAMETER (CHIDA = '|DECK I' )
- PARAMETER (CHOVER= 'UNKNOWN')
-
- PARAMETER (CHPOF = '-c')
- PARAMETER (CHPOC = '-c')
- PARAMETER (CHPOA = ' ')
-
- PARAMETER (CHEXFOR = '.f')
- PARAMETER (CHEXCC = '.c')
- PARAMETER (CHEXAS = '.s')
- PARAMETER (CHEXOBJ = '.o')
-
- PARAMETER (CHWHF = 'f77 ')
- PARAMETER (CHWHC = 'cc ')
- PARAMETER (CHWHA = 'as ')
-#endif
-#if defined(CERNLIB_QMVAX)
- PARAMETER (CHIDA = ';DECK I' )
- PARAMETER (CHOVER= 'UNKNOWN')
-
- PARAMETER (CHPOF = '/nolist/check=noover')
- PARAMETER (CHPOC = ' ')
-
- PARAMETER (CHEXFOR = '.for')
- PARAMETER (CHEXCC = '.c')
- PARAMETER (CHEXOBJ = '.obj')
-
- PARAMETER (CHWHF = 'fortran')
- PARAMETER (CHWHC = 'cc')
-#endif
-#if defined(CERNLIB_QMVAX)
- PARAMETER (CHPOA = '/nolist')
- PARAMETER (CHEXAS = '.mar')
- PARAMETER (CHWHA = 'macro')
-
- CHARACTER BEGRUT*9, ENDLINE*12
- PARAMETER (BEGRUT = ' .TITLE ')
- PARAMETER (ENDLINE= ' .END')
-#endif
-#if defined(CERNLIB_QMVMI)
- CHARACTER CHIDA2*8
- PARAMETER (CHIDA2= ' #DECK I' )
- PARAMETER (CHIDA = ';DECK I' )
- PARAMETER (CHOVER= 'UNKNOWN')
-
- PARAMETER (CHPOF = '-c -O')
- PARAMETER (CHPOC = '-c -O')
- PARAMETER (CHPOA = ' ')
-
- PARAMETER (CHEXFOR = '.f')
- PARAMETER (CHEXCC = '.c')
- PARAMETER (CHEXAS = '.s')
- PARAMETER (CHEXOBJ = '.o')
-
- PARAMETER (CHWHF = 'f77 ')
- PARAMETER (CHWHC = 'f77 ')
- PARAMETER (CHWHA = 'as ')
-#endif
-#if defined(CERNLIB_QMVAO)
- CHARACTER CHIDA2*8
- PARAMETER (CHIDA2= ' #DECK I' )
- PARAMETER (CHIDA = ';DECK I' )
- PARAMETER (CHOVER= 'UNKNOWN')
-
- PARAMETER (CHPOF = '-c -O')
- PARAMETER (CHPOC = '-c -O')
- PARAMETER (CHPOA = ' ')
-
- PARAMETER (CHEXFOR = '.f')
- PARAMETER (CHEXCC = '.c')
- PARAMETER (CHEXAS = '.s')
- PARAMETER (CHEXOBJ = '.o')
-
- PARAMETER (CHWHF = 'f77 ')
- PARAMETER (CHWHC = 'cc ')
- PARAMETER (CHWHA = 'as ')
-#endif
-
- PARAMETER (MLMKLN=100)
- PARAMETER (MXLENG=128, MXMKLN=64)
- CHARACTER CHHOLD*(MXLENG)
- CHARACTER CHOPT(7)*(MXLENG)
- DIMENSION NCHOPT(7)
- EQUIVALENCE (NOPF,NCHOPT(1))
- EQUIVALENCE (NOPC,NCHOPT(2))
- EQUIVALENCE (NOPA,NCHOPT(3))
-
- CHARACTER CHCMP(3)*(MXLENG)
- DIMENSION NCHCMP(3)
- EQUIVALENCE (CHCMP(1),CHOPT(4)), (NCHCMP(1),NCHOPT(4))
- EQUIVALENCE (NNF,NCHCMP(1))
- EQUIVALENCE (NNC,NCHCMP(2))
- EQUIVALENCE (NNA,NCHCMP(3))
-
- CHARACTER CHFIN*(MXLENG)
- EQUIVALENCE (CHFIN,CHOPT(7)), (NCHFIN,NCHOPT(7))
-
- CHARACTER CHFSH*(MXLENG), CHFMK*(MXLENG)
- CHARACTER CHMKLN*(MXMKLN+4)
-
- PARAMETER (MXCBUF=100)
- DIMENSION LXCBUF(MXCBUF)
- CHARACTER*80 CHCBUF(MXCBUF)
-
- CHARACTER CHLINE*80, CHNAME*80, CHTEXT*511
- CHARACTER CHUSE*1
-
- PARAMETER (NKEYS=11)
- CHARACTER CHKEYS(NKEYS)*4
- DATA CHKEYS / '-noh', '-log'
- +, '-fo ', '-co ', '-ao '
- +, '-f ', '-c ', '-a '
- +, '+fo ', '+co ', '+ao ' /
-
- LUNPR = 6
-#if defined(CERNLIB_QMVAX)
- OPEN (LUNPR,FILE='SYS$OUTPUT',RECL=512,STATUS='OLD')
-#endif
-
- WRITE (LUNPR,9001)
- 9001 FORMAT (' FCASPLIT executing.')
-
-#if defined(CERNLIB_QMIBX)
- CALL ERRSET (212, 300,-1,1,1)
-#endif
-
- 9002 FORMAT (
- F ' FCASPLIT [-f nmft] [-c nmcc] [-a nmas] [-noh] [-log]'
- F/' [+fo incf] [+co incc] [+ao incs]'
- F/' [-fo optf] [-co optc] [-ao opts]'
- F/' f.e [fca_n] [optf [optc [opts]]]'/
- F/' splits file f.e having a mixture of Fortran / C / assembler'
- F/' routines into separate files n.f or n.c or n.s, "n" being the'
- F/' name of each routine, creating at the same time a Shell script'
- F/' y.shfca and a Make file y.mkfca either of which can be used'
- F/' to compile all routines individually.'/
- F/' Defaults are defined in fcasplit for the names by which the'
- F/' compilers are called; with the -f, -c, -a options they could'
- F/' be changed.'/
- F/' Defaults are also defined for the options with which they are'
- F/' called; with the -fo, -co, -ao options they can be re-defined;'
- F/' with the +fo, +co, +ao options they can be incremented.'/
- F/' To be backward compatible the options can also be specified by'
- F/' the positional parameters after the file-name.')
- 9003 FORMAT (1X
- F/' If the -noh option is given (or if the first parameter after'
- F/' the file-name is "fca_n") the identifying header line of each'
- F/' routine is not written out. If the -log option is given'
- F/' the name of each routine is printed on standard output.')
- 9004 FORMAT (1X
- F/' Each routine must start with an identifying line :'
- F/' "', A, 'D>, " in cols. 1-12 for Fortran'
- F/' "', A, 'D>, " in cols. 1-12 for C'
- F/' "', A, 'D>, " in cols. 1-12 for assembler'
- F/' "DECK ID>, " in cols. 2-12 or'
- F/' "DECK ID>, " in cols. 3-12 for anything else'
- F/' "name" in cols. 13-40 gives the name'/
- F/' In the last two cases, or if "name" contains an'
- F/' extension, the file created will be "name"'
- F/' without extension .f, .c or .s added to it'
- F/' and without an entry into the script.'/
- F/' A trailing blank terminates the name,'
- F/' symbol . followed by blank also terminates,'
- F/' symbols ; < # ! all terminate,'
- F/' symbol */ also terminates.'
- F/1X)
-
-C------ Acquire the parameters
-
-#if !defined(CERNLIB_QF_APO)
- NARGS = IARGC() + NARADD
-#endif
-#if defined(CERNLIB_QF_APO)
- CALL PGM_$GET_ARGS (NARGSA2,LPOIARG)
- NARGS = NARGSA2 - 1
-#endif
-
- CHOPT(1) = CHPOF
- CHOPT(2) = CHPOC
- CHOPT(3) = CHPOA
-
- CHCMP(1) = CHWHF
- CHCMP(2) = CHWHC
- CHCMP(3) = CHWHA
- CHFIN = 'f.e'
-
- IFINFI = 0
- IFLNH = 0
- IFLLOG = 0
-
-C-- Get the keyed options, until the input file name
-
- JARG = 0
- 11 JOPT = 0
- 12 IF (JARG.GE.NARGS) GO TO 21
- JARG = JARG + 1
-#if (!defined(CERNLIB_QF_APO))&&(!defined(CERNLIB_QMHPX))
- CALL GETARG (JARG, CHHOLD)
-#endif
-#if defined(CERNLIB_QMHPX)
- N = IGETARG (JARG, CHHOLD, MXLENG)
-#endif
-#if defined(CERNLIB_QF_APO)
- JARGA2 = JARG
- N = PGM_$GET_ARG (JARGA2,CHHOLD,ISTAT)
- CHHOLD(N+1:) = ' '
-#endif
-#if defined(CERNLIB_QMVAX)
- CALL CUTOL(CHHOLD)
-#endif
-
- IF (JOPT.EQ.0) GO TO 13
-
-C---- Store option values read
-
-C-- positional trailing options
- IF (JOPT.LT.0) THEN
- IF (JOPT.EQ.-1) THEN
- IF (CHHOLD(1:5).EQ.'fca_n') THEN
- IFLNH = 7
- GO TO 12
- ENDIF
- ENDIF
- CHOPT(-JOPT) = CHHOLD
- JOPT = JOPT - 1
- GO TO 12
- ENDIF
-
-C-- keyed options
- IF (JOPT.LE.6) THEN
- CHOPT(JOPT) = CHHOLD
- ELSE
-#if !defined(CERNLIB_QMVAX)
- IF (JOPT.EQ.7) CHOPT(1) = CHPOF // ' ' // CHHOLD
- IF (JOPT.EQ.8) CHOPT(2) = CHPOC // ' ' // CHHOLD
- IF (JOPT.EQ.9) CHOPT(3) = CHPOA // ' ' // CHHOLD
-#endif
-#if defined(CERNLIB_QMVAX)
- IF (JOPT.EQ.7) CHOPT(1) = CHPOF // CHHOLD
- IF (JOPT.EQ.8) CHOPT(2) = CHPOC // CHHOLD
- IF (JOPT.EQ.9) CHOPT(3) = CHPOA // CHHOLD
-#endif
- ENDIF
- GO TO 11
-
-C---- Analyse key, if any
-
-C- -noh -log -fo -co -ao -f -c -a +fo +co +ao
-C- 1 2 3 4 5 6 7 8 9 10 11
-C- 1 2 3 4 5 6 7 8 9
-
- 13 DO 14 JKEY=1,NKEYS
- IF (CHHOLD(1:4).EQ.CHKEYS(JKEY)) THEN
- IF (JKEY.EQ.1) THEN
- IFLNH = 7
- GO TO 11
- ENDIF
- IF (JKEY.EQ.2) THEN
- IFLLOG = 7
- GO TO 11
- ENDIF
- JOPT = JKEY - 2
- GO TO 12
- ENDIF
- 14 CONTINUE
-
-C---- File-name read
-
- CHFIN = CHHOLD
- IFINFI = 7
-
-C---- Get the positional options if given
-
- JOPT = -1
- GO TO 12
-
-C------ Parameters have all been read
-
-C-- Length of the option strings = true length + 2 (blanks)
-
- 21 DO 24 JJ=1,7
- DO 23 J=MXLENG,1,-1
- IF (CHOPT(JJ)(J:J).NE.' ') GO TO 24
- 23 CONTINUE
- J = 0
- 24 NCHOPT(JJ) = J + 2
- NCHFIN = NCHFIN - 2
-#if defined(CERNLIB_QMVAX)
- NCHOPT(4) = NCHOPT(4) - 2
- NCHOPT(5) = NCHOPT(5) - 2
- NCHOPT(6) = NCHOPT(6) - 2
-#endif
-
-C-- Derive the name of the script yyy.shfca
-C- from the input file, say dir/yyy.ext
-
- N = NCHFIN
- JA = 1
- JE = N
- J = N
- 26 IF (CHFIN(J:J).EQ.'/') THEN
- JA = J + 1
- GO TO 27
-#if defined(CERNLIB_QMDOS)
- ELSEIF (CHFIN(J:J).EQ.CHAR(92)) THEN
- JA = J + 1
- GO TO 27
-#endif
- ELSEIF (CHFIN(J:J).EQ.'.') THEN
- IF (JE.EQ.N) JE = J - 1
- ENDIF
- J = J - 1
- IF (J.NE.0) GO TO 26
- 27 CHFSH = CHFIN(JA:JE) // '.shfca'
- CHFMK = CHFIN(JA:JE) // '.mkfca'
- NCHFSH = JE+7 - JA
-
- IF (IFINFI.EQ.0) THEN
- WRITE (LUNPR,9002)
- WRITE (LUNPR,9003)
- WRITE (LUNPR,9004) CHIDF, CHIDC, CHIDA
- ENDIF
-
- WRITE (LUNPR,9026) CHFIN(1:NCHFIN), CHFSH(1:NCHFSH)
- +, CHFMK(1:NCHFSH)
- WRITE (LUNPR,9027) CHCMP(1)(1:NNF),CHOPT(1)(1:NOPF)
- WRITE (LUNPR,9028) CHCMP(2)(1:NNC),CHOPT(2)(1:NOPC)
- WRITE (LUNPR,9029) CHCMP(3)(1:NNA),CHOPT(3)(1:NOPA)
- 9026 FORMAT (5X,' Input file : ',A/
- F 5X,' Shell script : ',A/
- F 5X,' Make file : ',A)
- 9027 FORMAT (5X,' Fortran name : ',A/
- F 5X,' Fortran options : ',A)
- 9028 FORMAT (5X,' CC name : ',A/
- F 5X,' CC options : ',A)
- 9029 FORMAT (5X,' Assembler name : ',A/
- F 5X,' Assembler options : ',A)
-
-C---- Stop if no file-name, help information printed
-
- IF (IFINFI.EQ.0) THEN
- WRITE (LUNPR,9030)
- STOP
- ENDIF
-
- 9030 FORMAT (' !!! No file-name given, no execution !!!')
-
-C------------ Process the input file ------------------
-
-C-- Open input and .shfca file
-
- OPEN (11, FILE=CHFIN(1:NCHFIN),STATUS='OLD')
- REWIND 11
-
- OPEN (21, FILE=CHFSH(1:NCHFSH),STATUS='OLD',ERR=301)
- CLOSE (21, STATUS='DELETE')
- 301 OPEN (22, FILE=CHFMK(1:NCHFSH),STATUS='OLD',ERR=302)
- CLOSE (22, STATUS='DELETE')
-#if defined(CERNLIB_QMVAX)
- 302 OPEN (21, FILE=CHFSH(1:NCHFSH),RECL=512,STATUS=CHOVER)
- OPEN (22, FILE=CHFMK(1:NCHFSH),RECL=512,STATUS=CHOVER)
-#endif
-#if !defined(CERNLIB_QMVAX)
- 302 OPEN (21, FILE=CHFSH(1:NCHFSH),STATUS=CHOVER)
- OPEN (22, FILE=CHFMK(1:NCHFSH),STATUS=CHOVER)
-#endif
-
-#if defined(CERNLIB_WINNT)
- write(22,8000) "# Some nmake macros for Win32 apps development"
-#endif
-#if (defined(CERNLIB_WINNT))&&(defined(CERNLIB_QF_DEC))
- write(22,8000) ".SUFFIXES : .f"
- write(22,8000) "!include <f77.mak>"
-#endif
-#if defined(CERNLIB_WINNT)
- write(22,8000) "!include <ntwin32.mak>"
-#endif
-
- CHMKLN = 'ROUTINES = '
- NXMKLN = 11
-
- NTEXT = -12
- NIGNOR = 0
- NROUT = 0
- NLINES = 0
- NTCBUF = 0
- NXCBUF = 0
-
- NLMKLN = 0
- NPCSMK = 0
-#if defined(CERNLIB_QMVAX)
-C- Write SHFCA header
- WRITE(21,8000) '$! Command file to compile fortran,c,macro source'
- WRITE(21,8000) '$ PROC_VER = F$ENVIRONMENT("VERIFY_PROCEDURE")'
- WRITE(21,8000) '$ IMAG_VER = F$ENVIRONMENT("VERIFY_IMAGE")'
- WRITE(21,8000) '$ SET VERIFY=(PROCEDURE,NOIMAGE)'
- JTYLA = 0
-#endif
-
-C------- Read next line -------------------------
-
- 31 CONTINUE
-#if (!defined(CERNLIB_QMVAX))&&(!defined(CERNLIB_QMVMI))&&(!defined(CERNLIB_QMVAO))
- READ (11,8000,END=83) CHLINE
- N = LEN(CHLINE)
-#endif
-#if defined(CERNLIB_QMVAX)||defined(CERNLIB_QMVMI)||defined(CERNLIB_QMVAO)
- READ (11,8031,END=83) N,CHLINE(1:MIN(80,N+1))
- 8031 FORMAT (Q,A)
-#endif
-
- DO 33 NCHLN=N,1,-1
- IF (CHLINE(NCHLN:NCHLN).NE.' ') GO TO 34
- 33 CONTINUE
- NCHLN = 0
-
- 34 IF (NCHLN.GE.13) THEN
- IF (CHLINE(9:12).EQ.CHIDD) GO TO 59
- ENDIF
- 35 IF (NTEXT.LT.0) GO TO 58
- 36 IF (JTYPE.NE.1) GO TO 41
-
-C-- Check new line is a Fortran comment line
-
- IF (NCHLN.EQ.0) GO TO 38
- IF (CHLINE(1:1).EQ.'C') GO TO 38
- IF (CHLINE(1:1).EQ.'c') GO TO 38
- IF (CHLINE(1:1).NE.'*') GO TO 41
-
- 38 IF (NXCBUF.EQ.MXCBUF) GO TO 41
- NXCBUF = NXCBUF + 1
- IF (NCHLN.GT.0) CHCBUF(NXCBUF)(1:NCHLN) = CHLINE(1:NCHLN)
- LXCBUF(NXCBUF) = NCHLN
- GO TO 31
-
-C------- Write next line -------------------------
-
-C-- NTEXT = <0 idle unheaded lines (not coming here)
-C- 0 normal running
-C- >0 about to write the first line of new routine
-C- if =1 : no entry to script and make file
-
-C- start a new routine only when the first true line is ready
-
- 41 IF (NTEXT.EQ.0) GO TO 46
- IF (NTEXT.NE.1) GO TO 81
-
-C-- Open the output file if first line ready
-
- 44 OPEN (27, FILE=CHNAME(1:NCUM),STATUS='OLD',ERR=441)
- CLOSE (27, STATUS='DELETE')
- 441 OPEN (27, FILE=CHNAME(1:NCUM),STATUS=CHOVER)
-
- NTEXT = 0
- NROUT = NROUT + 1
- IF (IFLLOG.NE.0) WRITE (LUNPR,9044) NROUT,CHNAME(1:NCUM)
- 9044 FORMAT (' make',I4,1X,A)
-
-#if defined(CERNLIB_QMVAX)
-C-- Create .TITLE line for assembler
- JTYLA = JTYPE
- IF (JTYPE.EQ.3) WRITE (27,9045) BEGRUT,CHNAME(1:NNAM)
- 9045 FORMAT (A,A)
-#endif
-
-C-- Transfer the comment lines from the buffer
-
- 46 IF (NXCBUF.EQ.0) GO TO 48
- DO 47 J=1,NXCBUF
- N = LXCBUF(J)
- IF (N.EQ.0) THEN
- WRITE (27,8000)
- ELSE
- WRITE (27,8000) CHCBUF(J)(1:LXCBUF(J))
- ENDIF
- 47 CONTINUE
- NLINES = NLINES + NXCBUF
- NXCBUF = 0
-
-C-- Transfer the current line
-
- 48 IF (NCHLN.EQ.0) THEN
- WRITE (27,8000)
- ELSE
- WRITE (27,8000) CHLINE(1:NCHLN)
- ENDIF
- NLINES = NLINES + 1
- GO TO 31
-
-C-- Ignore leading unheaded lines
-
- 58 NIGNOR = NIGNOR + 1
- IF (NTEXT.EQ.-1) GO TO 31
- WRITE (LUNPR,9058) CHLINE(1:NCHLN)
- NTEXT = NTEXT + 1
- IF (NTEXT.NE.-1) GO TO 31
- WRITE (LUNPR,9059)
- GO TO 31
- 9058 FORMAT (' ignored: ',A)
- 9059 FORMAT (10X,'...')
-
-C------- Start new routine ? -------------------------
-
- 59 JTYNX = 0
- IF (CHLINE(1:8).EQ.CHIDF) GO TO 61
- IF (CHLINE(1:8).EQ.CHIDC) GO TO 62
- IF (CHLINE(1:8).EQ.CHIDA) GO TO 63
- IF (CHLINE(2:8).EQ.CHIDX) GO TO 60
- IF (CHLINE(3:8).EQ.CHIDY) GO TO 60
-#if defined(CERNLIB_QMVMI)||defined(CERNLIB_QMVAO)
- IF (CHLINE(1:8).EQ.CHIDA2) GO TO 63
-#endif
- GO TO 35
-
-C-- Yes, start new routine
-
- 63 JTYNX = 1
- 62 JTYNX = JTYNX + 1
- 61 JTYNX = JTYNX + 1
- 60 JPUT = 0
- JDOT = 0
- JDOP = 0
- NUS = MIN(NCHLN,40)
-
-C-- skip leading blanks before the name
-
- JGO = 13
- 65 IF (CHLINE(JGO:JGO).EQ.' ') THEN
- JGO = JGO + 1
- GO TO 65
- ENDIF
-
- IF (JGO.GT.NUS) GO TO 35
-
-C-- Convert name to lower case and find termination
-
- DO 66 JTK=JGO,NUS
- CHUSE = CHLINE(JTK:JTK)
- JV = ICHAR(CHUSE)
- IF (CHUSE.EQ.' ') GO TO 67
- IF (CHUSE.EQ.'.') THEN
- IF (CHLINE(JTK+1:JTK+1).EQ.' ') GO TO 67
- JDOP = JDOT
- JDOT = JPUT+1
- ENDIF
- IF (CHUSE.EQ.';') GO TO 67
- IF (CHUSE.EQ.'<') GO TO 67
- IF (CHUSE.EQ.'#') GO TO 67
- IF (CHUSE.EQ.'!') GO TO 67
- IF (CHUSE.EQ.'*') THEN
- IF (CHLINE(JTK+1:JTK+1).EQ.'/') GO TO 67
- ENDIF
- IF (JV.LT.91) THEN
- IF (JV.GE.65) CHUSE = CHAR(JV+32)
- ENDIF
- JPUT = JPUT + 1
- CHNAME(JPUT:JPUT) = CHUSE
- 66 CONTINUE
-
-C-- Handle explicit extension
-
- 67 JTYPE = JTYNX
- IF (JDOT.EQ.JPUT) THEN
- JDOT = JDOP
- JPUT = JPUT - 1
- ENDIF
-
- NTEXT = 1
- NPUT = JPUT
- NCUM = NPUT
- NNAM = NPUT
- IF (JDOT.NE.0) THEN
- NNAM = JDOT - 1
- JTYPE = -JTYPE
- ENDIF
-
-C---- Handle normal case with standard extensions
-
- IF (JTYPE.LE.0) GO TO 80
-
-C-- Fortran
-
- IF (JTYPE.NE.1) GO TO 74
- N = LEN(CHEXFOR)
- CHNAME(NPUT+1:NPUT+N) = CHEXFOR
- NCUM = NPUT + N
-#if (!defined(CERNLIB_QF_APO))&&(!defined(CERNLIB_QMVAX))
- CHTEXT = CHCMP(1)(1:NNF) // CHOPT(1)(1:NOPF) // CHNAME(1:NCUM)
- NTEXT = NNF + NOPF + NCUM
-#endif
-#if defined(CERNLIB_QF_APO)
- CHTEXT = CHCMP(1)(1:NNF) // CHNAME(1:NCUM) // ' ' //
- + CHOPT(1)(1:NOPF)
- NTEXT = NNF + NCUM + NOPF
-#endif
-#if defined(CERNLIB_QMVAX)
- CHTEXT ='$ '//CHCMP(1)(1:NNF)//CHOPT(1)(1:NOPF)//CHNAME(1:NCUM)
- NTEXT = NNF + NOPF + NCUM +2
-#endif
- GO TO 80
-
-C-- CC
-
- 74 IF (JTYPE.NE.2) GO TO 77
- N = LEN(CHEXCC)
- CHNAME(NPUT+1:NPUT+N) = CHEXCC
- NCUM = NPUT + N
-#if !defined(CERNLIB_QMVAX)
- CHTEXT = CHCMP(2)(1:NNC) // CHOPT(2)(1:NOPC) // CHNAME(1:NCUM)
- NTEXT = NNC + NOPC + NCUM
-#endif
-#if defined(CERNLIB_QMVAX)
- CHTEXT ='$ '//CHCMP(2)(1:NNC)//CHOPT(2)(1:NOPC)//CHNAME(1:NCUM)
- NTEXT = NNC + NOPC + NCUM + 2
-#endif
- GO TO 80
-
-C-- Assembler
-
- 77 IF (JTYPE.NE.3) GO TO 80
- N = LEN(CHEXAS)
- CHNAME(NPUT+1:NPUT+N) = CHEXAS
- NCUM = NPUT + N
-#if (!defined(CERNLIB_QMSUN))&&(!defined(CERNLIB_QMVAX))&&(!defined(CERNLIB_QMVMI))&&(!defined(CERNLIB_QMVAO))
- CHTEXT = CHCMP(3)(1:NNA) // CHOPT(3)(1:NOPA) // CHNAME(1:NCUM)
- NTEXT = NNA + NOPA + NCUM
-#endif
-#if defined(CERNLIB_QMSUN)||defined(CERNLIB_QMVMI)||defined(CERNLIB_QMVAO)
- CHTEXT = CHCMP(3)(1:NNA) // '-o ' // CHNAME(1:NPUT) // '.o ' //
- + CHOPT(3)(1:NOPA) // CHNAME(1:NCUM)
- NTEXT = NNA + NPUT+7 + NOPA + NCUM
-#endif
-#if defined(CERNLIB_QMVAX)
- CHTEXT ='$ '//CHCMP(3)(1:NNA)//CHOPT(3)(1:NOPA)//CHNAME(1:NCUM)
- NTEXT = NNA + NOPA + NCUM + 2
-#endif
-
- 80 CONTINUE
-#if defined(CERNLIB_QMVAX)
-C-- write .END line for assembler
- IF (JTYLA.EQ.3) WRITE (27,8000) ENDLINE
-#endif
- CLOSE (27)
- NTCBUF = NTCBUF + NXCBUF
- NXCBUF = 0
-#if defined(CERNLIB_QMVAX)||defined(CERNLIB_QMVMI)||defined(CERNLIB_QMVAO)
- IF (JTYPE.EQ.3) GO TO 31
-#endif
- IF (JTYPE.LT.1) GO TO 31
- IF (IFLNH.NE.0) GO TO 31
- GO TO 36
-
-C------ Output of the new deck is just starting
-
-C-- compilation command for this routine to the shell script
-
- 81 WRITE (21,8000) CHTEXT(1:NTEXT)
-
-C-- register the routine name for the Make file
-
- CHTEXT = CHNAME(1:NPUT) // CHEXOBJ // ' '
- NTEXT = NPUT + LEN(CHEXOBJ) + 1
- IF (NXMKLN+NTEXT.GT.MXMKLN) THEN
- NLMKLN = NLMKLN + 1
- IF (NLMKLN.LT.MLMKLN) THEN
- NXMKLN = NXMKLN + 1
- CHMKLN(NXMKLN:NXMKLN) = CHAR(92)
- WRITE (22,8000) CHMKLN(1:NXMKLN)
- NXMKLN = 0
- ELSE
- WRITE (22,8000) CHMKLN(1:NXMKLN)
- NXMKLN = 0
- NLMKLN = 0
- WRITE (22,9042)
- NPCSMK = NPCSMK + 1
- WRITE (CHMKLN,9043) NPCSMK
- NXMKLN = 11
- ENDIF
- ENDIF
-
- 9042 FORMAT('#')
- 9043 FORMAT('ROUTINE',I1,' = ')
-
- CHMKLN(NXMKLN+1:NXMKLN+NTEXT) = CHTEXT(1:NTEXT)
- NXMKLN = NXMKLN + NTEXT
- GO TO 44
-
-C------- Done -------------------------
-
-C---- Complete the Make file
-
- 83 WRITE (22,8000) CHMKLN(1:NXMKLN-1)
-
-C-- Fortran inference
-
- CHNAME = CHEXFOR // CHEXOBJ // ':'
- NPUT = LEN(CHEXFOR) + LEN(CHEXOBJ) + 1
-#if !defined(CERNLIB_QF_APO)
- CHTEXT = CHAR(9) // CHCMP(1)(1:NNF) // CHOPT(1)(1:NOPF) //
- + '$*' // CHEXFOR
- NTEXT = 3 + NNF + NOPF + LEN(CHEXFOR)
-#endif
-#if defined(CERNLIB_QF_APO)
- CHTEXT = CHAR(9) // CHCMP(1)(1:NNF) // '$*' // CHEXFOR //
- + ' ' // CHOPT(1)(1:NOPF)
- NTEXT = 2 + NNF + LEN(CHEXFOR) + NOPF
-#endif
-#if (defined(CERNLIB_QMDOS))&&(defined(CERNLIB_QF_F2C))
-C
-C-- For F2C Fortran to C conversion is followed by gcc compilation
-C
- WRITE (22,8000) CHTEXT(1:NTEXT)
-#endif
- WRITE (22,9083) CHNAME(1:NPUT), CHTEXT(1:NTEXT)
-
-C-- CC inference
-
- CHNAME = CHEXCC // CHEXOBJ // ':'
- NPUT = LEN(CHEXCC) + LEN(CHEXOBJ) + 1
- CHTEXT = CHAR(9) // CHCMP(2)(1:NNC) // CHOPT(2)(1:NOPC) //
- + '$*' // CHEXCC
- NTEXT = 3 + NNC + NOPC + LEN(CHEXCC)
-#if defined(CERNLIB_QF_APO)
- CHTEXT(NTEXT+1:NTEXT+16) = '; mv $*.o $*.bin'
- NTEXT = NTEXT + 16
-#endif
- WRITE (22,9083) CHNAME(1:NPUT), CHTEXT(1:NTEXT)
-
-C-- Assembler inference
-
- CHNAME = CHEXAS // CHEXOBJ // ':'
- NPUT = LEN(CHEXAS) + LEN(CHEXOBJ) + 1
-#if (!defined(CERNLIB_QMSUN))&&(!defined(CERNLIB_QMVAX))&&(!defined(CERNLIB_QMVMI))&&(!defined(CERNLIB_QMVAO))
- CHTEXT = CHAR(9) // CHCMP(3)(1:NNA) // CHOPT(3)(1:NOPA) //
- + '$*' // CHEXAS
- NTEXT = 3 + NNA + NOPA + LEN(CHEXAS)
-#endif
-#if defined(CERNLIB_QMSUN)||defined(CERNLIB_QMVAX)||defined(CERNLIB_QMVMI)||defined(CERNLIB_QMVAO)
- CHTEXT = CHAR(9) // CHCMP(3)(1:NNA) // CHOPT(3)(1:NOPA) //
- + '-o $*.o $*' // CHEXAS
- NTEXT = 12 + NNA + NOPA + LEN(CHEXAS)
-#endif
- WRITE (22,9083) CHNAME(1:NPUT), CHTEXT(1:NTEXT)
-
- IF (NPCSMK.EQ.0) THEN
- WRITE (22,9084) CHFIN(JA:JE)
- ELSE
- WRITE (22,9085) CHFIN(JA:JE),(I,I=1,NPCSMK)
- WRITE (22,9086) (I,I,I=1,NPCSMK)
- ENDIF
-
-C-- Print summary
-
- WRITE (LUNPR,9087) NLINES,NROUT
- IF (NIGNOR.NE.0) WRITE (LUNPR,9088) NIGNOR
- IF (NTCBUF.NE.0) WRITE (LUNPR,9089) NTCBUF
-#if defined(CERNLIB_QMVAX)
- WRITE(21,8000) '$!Restore original user settings '
- WRITE(21,8000) '$ TEMP=F$VERIFY(PROC_VER,IMAG_VER)'
-#endif
-#if defined(CERNLIB_QMAPO)
- CALL PGM_$EXIT
-#endif
- 8000 FORMAT (A)
- 9083 FORMAT (/A/A)
- 9084 FORMAT(/A,'_all: $(ROUTINES)',/)
- 9085 FORMAT(/A,'_all:',10(' rout',I1))
- 9086 FORMAT(/,'rout: $(ROUTINES)',/,
- + ('rout',I1,': $(ROUTINE',I1,')',/))
- 9087 FORMAT (1X,I6,' lines written for',I6,' decks')
- 9088 FORMAT (1X,I6,' leading unheaded lines ignored.')
- 9089 FORMAT (1X,I6,' trailing comment lines ignored.')
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernfor/utygen/xbanner.F b/src/packlib/kernlib/kerngen/obsolete/kernfor/utygen/xbanner.F
deleted file mode 100644
index c1f0408..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernfor/utygen/xbanner.F
+++ /dev/null
@@ -1,229 +0,0 @@
-*
-* $Id: xbanner.F,v 1.1.1.1 1996/02/15 17:54:16 mclareni Exp $
-*
-* $Log: xbanner.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:16 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- PROGRAM XBANNER
-
-C CERN PROGLIB# J403 XBANNER .VERSION KERNFOR 4.39 940228
-C ORIG. 22/09/89 JZ
-
-* unit number for standard output
- PARAMETER (LUNSTP=6)
-#if !defined(CERNLIB_QMAMX)
- PARAMETER (NARADD = 0)
-#endif
- CHARACTER CHAPO*1
-#if (defined(CERNLIB_QASCII))&&(!defined(CERNLIB_QMAMX))&&(!defined(CERNLIB_QMIRT))
- PARAMETER (CHAPO=CHAR(39))
-#endif
-#if defined(CERNLIB_QMAMX)
- PARAMETER (NARADD = -1)
- PARAMETER (CHAPO='27'X)
-#endif
-#if defined(CERNLIB_QMIRT)
- PARAMETER (CHAPO='27'X)
-#endif
- COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT, DUMMY(36)
- PARAMETER (MXLENG=256)
- CHARACTER TEXT*(MXLENG), CHFILE*(MXLENG)
- CHARACTER TXLINE*9
- DIMENSION MDATE(2), MTIME(2)
- CHARACTER CHEJECT*1, CHJOB*16, CHDATE*16, CHTIME*5
- EQUIVALENCE (CHDATE,MDATE), (CHTIME,MTIME)
- LOGICAL THERE
-
- CHARACTER*(*) OLD, NEW, APP, OVER, UNK, FMTT
- PARAMETER (OLD = 'OLD')
- PARAMETER (NEW = 'NEW')
- PARAMETER (APP = 'APPEND')
- PARAMETER (OVER= 'OVERWRITE')
- PARAMETER (UNK = 'UNKNOWN')
- PARAMETER (FMTT= 'FORMATTED')
-
- DATA CHJOB / ' ' /
-
-
- LUNPR = LUNSTP
- NARGS = IARGC () + NARADD
- IF (NARGS.LE.1) GO TO 17
- JGO = 1
- CALL GETARG (JGO,TEXT)
- NTX = LNBLNK (TEXT)
- JGO = 2
- GO TO 21
-
-C-- No text parameters, do HELP
-
- 17 PRINT 9002
- PRINT 9003
- GO TO 99
- 9002 FORMAT (1X
- F/' XBANNER param1 param2 param3 ...'
- F/' prints a banner of one or several lines of large text.'
- F/' The first parameter controls the output file :'
- F/' the file-name maybe prefixed with :'
- F/' + to append to an existing file,'
- F/' = to overwrite an existing file,'
- F/' otherwise a new file is created.'
- F/' 2 to signal page-eject and double-page repeat,'
- F/' 1 to signal page-eject,'
- F/' 0 no page eject.'
- F/' If no file-name is given, standard output is used;'
- F/' in this case a stand-alone prefix must be given.')
- 9003 FORMAT (1X
- F/' Further parameters give one or several lines of text :'
- F/' Multiple : if the first and the last character of a'
- F/' parameter are identical and non-alpha this'
- F/' is split on each such character to a new line.'
- F/' Single : otherwise the whole parameter gives one line.'
- F/' Any resulting line is always truncated to 9 characters.'
- F/' Examples :'
- F/' xbanner 0 "LOOK OUT"'
- F/' gives 1 line of text on standard output, no eject.'
- F/' xbanner 1 KERN UPDATE // 1.18 APOLLO'
- F/' xbanner 1=y.lis /KERN/UPDATE//1.18/APOLLO/'
- F/' xbanner 2+y.lis KERN UPDATE "oct 89" 1.18 APOLLO'
- F/' all give 1 or 2 pages with 5 lines of text each.')
-
-C------ Analyse parameter 1, and open output file if nec.
-
- 21 CHEJECT = ' '
- NPG = 0
- JTK = 1
- JOPEN = INDEX ('=+012',TEXT(1:1))
- IF (JOPEN.GE.3) GO TO 22
- IF (JOPEN.EQ.0) GO TO 24
-
-C-- Parameter 1 starts with = or +
-
- JTK = 2
- NPG = INDEX ('012',TEXT(2:2))
- IF (NPG.EQ.0) GO TO 24
- NPG = NPG - 1
- JTK = 3
- GO TO 24
-
-C-- Parameter 1 starts with 0, 1, or 2
-
- 22 JTK = 2
- NPG = JOPEN - 3
- JOPEN = INDEX ('=+',TEXT(2:2))
- IF (JOPEN.NE.0) JTK = 3
- GO TO 24
-
-C-- get the file name, if any
-
- 24 NCHF = NTX+1 - JTK
- IF (NCHF.LE.0) GO TO 29
- CHFILE = TEXT(JTK:NTX)
-
-#if !defined(CERNLIB_QMVAX)
- IF (JOPEN.NE.2) THEN
- INQUIRE (FILE=CHFILE(1:NCHF),EXIST=THERE)
- IF (THERE) THEN
- OPEN (LUNPR,FILE=CHFILE(1:NCHF),STATUS=OLD,IOSTAT=J)
- CLOSE (LUNPR,STATUS='DELETE',IOSTAT=J)
- ENDIF
- ENDIF
-
-#endif
-#if defined(CERNLIB_QMAPO)
- IF (JOPEN.EQ.2) THEN
- OPEN (LUNPR,FILE=CHFILE(1:NCHF),STATUS=APP)
- ELSE
- IF (THERE) THEN
- OPEN (LUNPR,FILE=CHFILE(1:NCHF),STATUS=OLD,IOSTAT=J)
- CLOSE (LUNPR,STATUS='DELETE',IOSTAT=J)
- ENDIF
- OPEN (LUNPR,FILE=CHFILE(1:NCHF),STATUS=OVER)
- ENDIF
-#endif
-#if defined(CERNLIB_QMALT)||defined(CERNLIB_QMCVX)||defined(CERNLIB_QMSGI)||defined(CERNLIB_QMSUN)||defined(CERNLIB_QMVMI)||defined(CERNLIB_QMVAO)
- IF (JOPEN.EQ.2) THEN
- OPEN (LUNPR,FILE=CHFILE(1:NCHF),STATUS=UNK,ACCESS=APP)
- ELSE
- OPEN (LUNPR,FILE=CHFILE(1:NCHF),STATUS=UNK)
- ENDIF
-#endif
-#if defined(CERNLIB_QMCRY)
- IF (JOPEN.NE.2) GO TO 26
- OPEN (LUNPR,FILE=CHFILE(1:NCHF),STATUS=OLD,POSITION=APP
- +, FORM=FMTT, ERR=26)
- GO TO 29
-
- 26 OPEN (LUNPR,FILE=CHFILE(1:NCHF),STATUS=NEW,FORM=FMTT)
-#endif
-#if defined(CERNLIB_QMIBX)||defined(CERNLIB_QMIRT)
- OPEN (LUNPR,FILE=CHFILE(1:NCHF),STATUS=UNK)
- IF (JOPEN.NE.2) REWIND LUNPR
-#endif
-#if defined(CERNLIB_QMVAX)
- IF (JOPEN.EQ.0) THEN
- OPEN (LUNPR,FILE=CHFILE(1:NCHF),STATUS=NEW)
- ELSEIF (JOPEN.EQ.1) THEN
- OPEN (LUNPR,FILE=CHFILE(1:NCHF),STATUS=UNK)
- ELSEIF (JOPEN.EQ.2) THEN
- OPEN (LUNPR,FILE=CHFILE(1:NCHF),STATUS=UNK,ACCESS=APP)
- ENDIF
-#endif
- 29 IF (NPG.GE.1) CHEJECT='1'
-
- CHDATE = ' '
- CALL DATIMH (MDATE,MTIME)
- CHDATE(11:15) = CHTIME
-
-C---- Print one page
-
- 41 WRITE (LUNPR,9041) CHEJECT,CHJOB,CHDATE,CHDATE
- 9041 FORMAT (A/3X,A,6X,A,12X,A)
-
- DO 69 JARG=JGO,NARGS
- CALL GETARG (JARG,TEXT)
- NTX = LNBLNK (TEXT)
- IF (NTX.EQ.0) GO TO 69
- IF (TEXT(1:1).NE.TEXT(NTX:NTX)) GO TO 67
- JV = ICHAR(TEXT(1:1))
- IF (JV.GE.65) THEN
- IF (JV.LE.90) GO TO 67
- IF (JV.GE.97) THEN
- IF (JV.LE.122) GO TO 67
- ENDIF
- ENDIF
-
-C-- Handle multiple like /KERN/UPDATE//1.18/APOLLO/
-
- JNX = 1
- 54 JTX = JNX + 1
- JNX = ICFIND (TEXT(1:1),TEXT,JTX,NTX)
- NCH = JNX - JTX
- IF (NCH.EQ.0) THEN
- NCH = 1
- TXLINE(1:1) = ' '
- ELSE
- NCH = MIN (NCH,9)
- TXLINE(1:NCH) = TEXT(JTX:JTX+NCH-1)
- ENDIF
-
- CALL VIZPRI (0, TXLINE(1:NCH))
-
- IF (JNX.LT.NTX) GO TO 54
- GO TO 69
-
-C-- Handle single like MIPS.PAM
-
- 67 NCH = MIN (NTX,9)
- CALL VIZPRI (0, TEXT(1:NCH))
- 69 CONTINUE
-
- 91 NPG = NPG - 1
- IF (NPG.GT.0) GO TO 41
- 99 CONTINUE
-#if defined(CERNLIB_QMAPO)
- CALL PGM_$EXIT
-#endif
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerngen/pilot.h b/src/packlib/kernlib/kerngen/obsolete/kerngen/pilot.h
deleted file mode 100644
index 6568cc0..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerngen/pilot.h
+++ /dev/null
@@ -1,224 +0,0 @@
-#if 0
-* This pilot patch was created from kerngen.car patch _kerngen
-#endif
-#if defined(CERNLIB_IBMVM)||defined(CERNLIB_IBMMVS)
-#ifndef CERNLIB_IBM
-#define CERNLIB_IBM
-#endif
-#ifndef CERNLIB_F77
-#define CERNLIB_F77
-#endif
-#endif
-#if (defined(CERNLIB_CONVEX))&&(defined(CERNLIB_SINGLE))
-#ifndef CERNLIB_CONVEX64
-#define CERNLIB_CONVEX64
-#endif
-#endif
-#if (defined(CERNLIB_CONVEX))&&(!defined(CERNLIB_CONVEX64))
-#ifndef CERNLIB_CONVEX32
-#define CERNLIB_CONVEX32
-#endif
-#endif
-#if (defined(CERNLIB_IBMVM))&&(defined(CERNLIB_CERN)||defined(CERNLIB_LEPICS)||defined(CERNLIB_SLAC))
-#ifndef CERNLIB_SLACBATCH
-#define CERNLIB_SLACBATCH
-#endif
-#endif
-#if (defined(CERNLIB_ALLIANT))&&(defined(CERNLIB_QMINTEL))
-#ifndef CERNLIB__KALI
-#define CERNLIB__KALI
-#endif
-#endif
-#if (defined(CERNLIB_ALLIANT))&&(!defined(CERNLIB_QMINTEL))
-#ifndef CERNLIB__KALT
-#define CERNLIB__KALT
-#endif
-#endif
-#if defined(CERNLIB_AMIGAUX)
-#ifndef CERNLIB__KAMX
-#define CERNLIB__KAMX
-#endif
-#endif
-#if (defined(CERNLIB_APOLLO))&&(!defined(CERNLIB_APOF77))
-#ifndef CERNLIB__KAPO
-#define CERNLIB__KAPO
-#endif
-#endif
-#if (defined(CERNLIB_APOLLO))&&(defined(CERNLIB_APOF77))
-#ifndef CERNLIB__KAPOF77
-#define CERNLIB__KAPOF77
-#endif
-#endif
-#if defined(CERNLIB_CDC)
-#ifndef CERNLIB__KCDC
-#define CERNLIB__KCDC
-#endif
-#endif
-#if defined(CERNLIB_CRAY)
-#ifndef CERNLIB__KCRU
-#define CERNLIB__KCRU
-#endif
-#endif
-#if defined(CERNLIB_CONVEX64)
-#ifndef CERNLIB__KCVX
-#define CERNLIB__KCVX
-#endif
-#endif
-#if defined(CERNLIB_CONVEX32)
-#ifndef CERNLIB__KCVY
-#define CERNLIB__KCVY
-#endif
-#endif
-#if defined(CERNLIB_DGE)
-#ifndef CERNLIB__KDGE
-#define CERNLIB__KDGE
-#endif
-#endif
-#if defined(CERNLIB_MSDOS)
-#ifndef CERNLIB__KDOS
-#define CERNLIB__KDOS
-#endif
-#endif
-#if (defined(CERNLIB_DECS))&&(!defined(CERNLIB_QMVAOS))
-#ifndef CERNLIB__KVMI
-#define CERNLIB__KVMI
-#endif
-#endif
-#if (defined(CERNLIB_DECS))&&(defined(CERNLIB_QMVAOS))
-#ifndef CERNLIB__KVAOS
-#define CERNLIB__KVAOS
-#endif
-#endif
-#if defined(CERNLIB_HPUX)
-#ifndef CERNLIB__KHPX
-#define CERNLIB__KHPX
-#endif
-#endif
-#if defined(CERNLIB_IBMAIX)
-#ifndef CERNLIB__KIBX
-#define CERNLIB__KIBX
-#endif
-#endif
-#if defined(CERNLIB_IBMMVS)
-#ifndef CERNLIB__KIMVSSP
-#define CERNLIB__KIMVSSP
-#endif
-#endif
-#if defined(CERNLIB_IBMRT)
-#ifndef CERNLIB__KIRT
-#define CERNLIB__KIRT
-#endif
-#endif
-#if (defined(CERNLIB_IBMVM))&&(defined(CERNLIB_CERN))
-#ifndef CERNLIB__KICERNV
-#define CERNLIB__KICERNV
-#endif
-#endif
-#if (defined(CERNLIB_IBMVM))&&(!defined(CERNLIB_SLACBATCH))
-#ifndef CERNLIB__KIVM
-#define CERNLIB__KIVM
-#endif
-#endif
-#if (defined(CERNLIB_IBM))&&(!defined(CERNLIB_CERN))
-#ifndef CERNLIB__KIBMVS
-#define CERNLIB__KIBMVS
-#endif
-#endif
-#if defined(CERNLIB_LINUX)
-#ifndef CERNLIB__KLNX
-#define CERNLIB__KLNX
-#endif
-#endif
-#if defined(CERNLIB_MACMPW)
-#ifndef CERNLIB__KMPW
-#define CERNLIB__KMPW
-#endif
-#endif
-#if defined(CERNLIB_NORD500)
-#ifndef CERNLIB__KNORD3
-#define CERNLIB__KNORD3
-#endif
-#endif
-#if defined(CERNLIB_NECSX)
-#ifndef CERNLIB__KNSX
-#define CERNLIB__KNSX
-#endif
-#endif
-#if defined(CERNLIB_NEXT)
-#ifndef CERNLIB__KNXT
-#define CERNLIB__KNXT
-#endif
-#endif
-#if 0
-* Added at release 94B
-#endif
-#if defined(CERNLIB_OS9)
-#ifndef CERNLIB__KOS9
-#define CERNLIB__KOS9
-#endif
-#endif
-#if defined(CERNLIB_SGI)
-#ifndef CERNLIB__KSGI
-#define CERNLIB__KSGI
-#endif
-#endif
-#if defined(CERNLIB_SUN)
-#ifndef CERNLIB__KSUN
-#define CERNLIB__KSUN
-#endif
-#endif
-#if defined(CERNLIB_TMO)
-#ifndef CERNLIB__KTMO
-#define CERNLIB__KTMO
-#endif
-#endif
-#if (defined(CERNLIB_VAXVMS))&&(!defined(CERNLIB_QMALPH))
-#ifndef CERNLIB__KVAX
-#define CERNLIB__KVAX
-#endif
-#endif
-#if (defined(CERNLIB_VAXVMS))&&(defined(CERNLIB_QMALPH))
-#ifndef CERNLIB__KALPH
-#define CERNLIB__KALPH
-#endif
-#endif
-#if defined(CERNLIB_IBM)
-#ifndef CERNLIB_QMIBMXA
-#define CERNLIB_QMIBMXA
-#endif
-#endif
-#if (defined(CERNLIB_IBMVM))&&(defined(CERNLIB_CERN))
-#ifndef CERNLIB_3090J
-#define CERNLIB_3090J
-#endif
-#endif
-#if defined(CERNLIB_CRAY)
-#ifndef CERNLIB_CRAYC
-#define CERNLIB_CRAYC
-#endif
-#endif
-#if defined(CERNLIB_QX_SC)
-#ifdef CERNLIB_QXNO_SC
-#undef CERNLIB_QXNO_SC
-#endif
-#endif
-#if defined(CERNLIB_QXNO_SC)
-#ifdef CERNLIB_QX_SC
-#undef CERNLIB_QX_SC
-#endif
-#endif
-#if defined(CERNLIB_QXNO_SC)||defined(CERNLIB_QX_SC)
-#ifdef CERNLIB_QXCAPT
-#undef CERNLIB_QXCAPT
-#endif
-#endif
-#if defined(CERNLIB_APOLLO)
-#ifndef CERNLIB_QSYSBSD
-#define CERNLIB_QSYSBSD
-#endif
-#endif
-#if defined(CERNLIB_SHIFT)
-#ifndef CERNLIB_PROJSHIFT
-#define CERNLIB_PROJSHIFT
-#endif
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernhyw/_khywgc/pilot.h b/src/packlib/kernlib/kerngen/obsolete/kernhyw/_khywgc/pilot.h
deleted file mode 100644
index d63dbec..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernhyw/_khywgc/pilot.h
+++ /dev/null
@@ -1,39 +0,0 @@
-#if 0
-* This pilot patch was created from kernhyw.car patch _khywgc
-#endif
-#ifndef CERNLIB_QMHYW
-#define CERNLIB_QMHYW
-#endif
-#ifndef CERNLIB_QMHYWGC
-#define CERNLIB_QMHYWGC
-#endif
-#ifndef CERNLIB_HYWGC
-#define CERNLIB_HYWGC
-#endif
-#ifndef CERNLIB_XVECT
-#define CERNLIB_XVECT
-#endif
-#ifndef CERNLIB_TCGEN
-#define CERNLIB_TCGEN
-#endif
-#ifdef CERNLIB_TCGEN_BTEST
-#undef CERNLIB_TCGEN_BTEST
-#endif
-#ifdef CERNLIB_TCGEN_IBITS
-#undef CERNLIB_TCGEN_IBITS
-#endif
-#ifdef CERNLIB_TCGEN_IBCLR
-#undef CERNLIB_TCGEN_IBCLR
-#endif
-#ifdef CERNLIB_TCGEN_IBSET
-#undef CERNLIB_TCGEN_IBSET
-#endif
-#ifdef CERNLIB_TCGEN_MVBITS
-#undef CERNLIB_TCGEN_MVBITS
-#endif
-#ifdef CERNLIB_TCGEN_ISHFT
-#undef CERNLIB_TCGEN_ISHFT
-#endif
-#ifdef CERNLIB_TCGEN_ISHFTC
-#undef CERNLIB_TCGEN_ISHFTC
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernhyw/_khywgc/qcardl.inc b/src/packlib/kernlib/kerngen/obsolete/kernhyw/_khywgc/qcardl.inc
deleted file mode 100644
index 15f2032..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernhyw/_khywgc/qcardl.inc
+++ /dev/null
@@ -1,14 +0,0 @@
-*
-* $Id: qcardl.inc,v 1.1.1.1 1996/02/15 17:52:47 mclareni Exp $
-*
-* $Log: qcardl.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:52:47 mclareni
-* Kernlib
-*
-*
-*
-* qcardl.inc
-*
-#if 0
-C====================================================================
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernhyw/_khywmx/pilot.h b/src/packlib/kernlib/kerngen/obsolete/kernhyw/_khywmx/pilot.h
deleted file mode 100644
index 534be57..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernhyw/_khywmx/pilot.h
+++ /dev/null
@@ -1,42 +0,0 @@
-#if 0
-* This pilot patch was created from kernhyw.car patch _khywmx
-#endif
-#ifndef CERNLIB_QMHYW
-#define CERNLIB_QMHYW
-#endif
-#ifndef CERNLIB_QMHYWMX
-#define CERNLIB_QMHYWMX
-#endif
-#ifndef CERNLIB_HYWMX
-#define CERNLIB_HYWMX
-#endif
-#ifndef CERNLIB_HYWPL1
-#define CERNLIB_HYWPL1
-#endif
-#ifndef CERNLIB_XVECT
-#define CERNLIB_XVECT
-#endif
-#ifndef CERNLIB_TCGEN
-#define CERNLIB_TCGEN
-#endif
-#ifdef CERNLIB_TCGEN_BTEST
-#undef CERNLIB_TCGEN_BTEST
-#endif
-#ifdef CERNLIB_TCGEN_IBITS
-#undef CERNLIB_TCGEN_IBITS
-#endif
-#ifdef CERNLIB_TCGEN_IBCLR
-#undef CERNLIB_TCGEN_IBCLR
-#endif
-#ifdef CERNLIB_TCGEN_IBSET
-#undef CERNLIB_TCGEN_IBSET
-#endif
-#ifdef CERNLIB_TCGEN_MVBITS
-#undef CERNLIB_TCGEN_MVBITS
-#endif
-#ifdef CERNLIB_TCGEN_ISHFT
-#undef CERNLIB_TCGEN_ISHFT
-#endif
-#ifdef CERNLIB_TCGEN_ISHFTC
-#undef CERNLIB_TCGEN_ISHFTC
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernhyw/_khywmx/qcardl.inc b/src/packlib/kernlib/kerngen/obsolete/kernhyw/_khywmx/qcardl.inc
deleted file mode 100644
index 5872807..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernhyw/_khywmx/qcardl.inc
+++ /dev/null
@@ -1,14 +0,0 @@
-*
-* $Id: qcardl.inc,v 1.1.1.1 1996/02/15 17:52:54 mclareni Exp $
-*
-* $Log: qcardl.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:52:54 mclareni
-* Kernlib
-*
-*
-*
-* qcardl.inc
-*
-#if 0
-C====================================================================
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernhyw/history/history.dat b/src/packlib/kernlib/kerngen/obsolete/kernhyw/history/history.dat
deleted file mode 100644
index b4301ca..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernhyw/history/history.dat
+++ /dev/null
@@ -1,85 +0,0 @@
-*
-* $Id: history.dat,v 1.1.1.1 1996/02/15 17:52:58 mclareni Exp $
-*
-* $Log: history.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:52:58 mclareni
-* Kernlib
-*
-*
-* This directory was created from kernhyw.car patch kernhyw
-#if !defined(CERNLIB_KERNHYW)
-
- KERNLIB ROUTINES PARTICULAR TO THE HONEYWELL-BULL
-
----------------------------------------------------------------------
-
- THIS FILE CONTAINS THE FOLLOWING PATCHES :
-
-*KHYWGC PILOT TO MAKE GENERAL KERNLIB FOR SYSTEM GCOS
-
-QMHYWGC MACHINE PATCH FOR SYSTEM GCOS
-
-HYWGC ML / FORTRAN VERSIONS OF KERNLIB ROUTINES FOR GCOS
-
-*KHYWMX PILOT TO MAKE GENERAL KERNLIB FOR SYSTEM MULTIX
-
-QMHYWMX MACHINE PATCH FOR SYSTEM MULTIX
-
-HYWMX ML / FORTRAN VERSIONS OF KERNLIB ROUTINES FOR MULTIX
-
-HYWPL1 PL-ONE VERSIONS OF KERNLIB ROUTINES FOR MULTIX
-
-=====================================================================
-
-
- UP-DATE RECORD FOR THE PAM-FILE KERNHYW
- ----------------------------------------
-
-
-UP-DATE 1.07 : 24-JUN-1987
-----------------------------
-
-REPLACING FILE KERNHYW 1.06 870613 11.12
-
-NEW DECKS : P=HYWGC, D=ABEND Provisional routine for ABEND
- D=HYW8T9,HYW9T8 Byte transformations
- D=XINBF to use IOSTAT
-CORRECT : P=HYWGC, D=LOCF Fortran Comment line removed
- D=XINB,XINBS to use IOSTAT
-
----------------------------------------------------------------------
-
-UP-DATE 1.06 : 12-JUN-1987
-----------------------------
-
-REPLACING FILE KERNHYW 1.05 870602 19.01
-
-NEW DECKS : P=HYWGC,D=IE3FOS,IE3FOD,IE3TOS,IE3TOD convert IEEE
- D=IUFORW, PKBYT, UPKBYT
-
----------------------------------------------------------------------
-
-UP-DATE 1.05 : 2-JUNE-1987
-----------------------------
-
-REPLACING FILE KERNHYW 1.04 870522 10.22
-
-NEW DECKS : P=HYWGC, D=JBYTOR, MBYTET, MBYTOR, MCBYT
- D=MSBIT, MSBIT0, MSBIT1, MSBYT
-
----------------------------------------------------------------------
-
-UP-DATE 1.04 : 22-MAY-1987
-----------------------------
-
-REPLACING FILE KERNHYW 1.03 841023 18.55
-
-Re-order the Pam file to completely separate GCOS / MULTIX
-
----------------------------------------------------------------------
-
- FIRST RELEASE OF THE KERNHYW PAM : 12-SEPT-84
-
----------------------------------------------------------------------
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywgc/abend.F b/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywgc/abend.F
deleted file mode 100644
index 024d1ee..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywgc/abend.F
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: abend.F,v 1.1.1.1 1996/02/15 17:52:48 mclareni Exp $
-*
-* $Log: abend.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:48 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE ABEND
-C
-C CERN PROGLIB# ABEND .VERSION KERNHYW 1.07 870624
-C ORIG. 22/06/87 JZ
-C Provisional routine for abnormal job termination
-C
- STOP 77
- END
-#ifdef CERNLIB_TCGEN_ABEND
-#undef CERNLIB_TCGEN_ABEND
-#endif
-* ==================================================
-#include "qcardl.inc"
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywgc/cbyt.F b/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywgc/cbyt.F
deleted file mode 100644
index 34f9afb..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywgc/cbyt.F
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: cbyt.F,v 1.1.1.1 1996/02/15 17:52:48 mclareni Exp $
-*
-* $Log: cbyt.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:48 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE CBYT (IWS,JPS,IWT,JPT,NBITS)
-C
-C CERN PROGLIB# M421 CBYT .VERSION KERNHYW 1.03 841013
-C ORIG. 13/10/84 JZ
-C
- JPTH = 37 - JPT - NBITS
- FLD(JPTH,NBITS,IWT) = FLD(37-JPS-NBITS,NBITS,IWS)
- RETURN
- END
-#ifdef CERNLIB_TCGEN_CBYT
-#undef CERNLIB_TCGEN_CBYT
-#endif
-* ==================================================
-#include "qcardl.inc"
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywgc/datime.F b/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywgc/datime.F
deleted file mode 100644
index 9045521..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywgc/datime.F
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: datime.F,v 1.1.1.1 1996/02/15 17:52:48 mclareni Exp $
-*
-* $Log: datime.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:48 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE DATIME (ID,IT)
-C
-C CERN PROGLIB# Z007 DATIME .VERSION KERNHYW 1.03 841013
-C ORIG. 13/10/84 JZ
-C
- DIMENSION M(8)
- CHARACTER*8 DCH
-
- CALL DATIM (DCH,T)
- CALL UBLOW (DCH,M,8)
-
- MY = IUFORW (M,7,8)
- MM = IUFORW (M,1,2)
- MD = IUFORW (M,4,5)
- ID = 100*(100*MY+MM)+MD
- IT = 100.*T
- RETURN
- END
-#ifdef CERNLIB_TCGEN_DATIME
-#undef CERNLIB_TCGEN_DATIME
-#endif
-* ==================================================
-#include "qcardl.inc"
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywgc/gshow.F b/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywgc/gshow.F
deleted file mode 100644
index 3d64730..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywgc/gshow.F
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: gshow.F,v 1.1.1.1 1996/02/15 17:52:48 mclareni Exp $
-*
-* $Log: gshow.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:48 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE GSHOW (LUN)
-C
-C CERN PROGLIB# GSHOW .VERSION KERNHYW 1.00 840910
-C ORIG. 17/05/83 HRR
-C
-C-- STORE PAM TITLE INTO /SLATE/ FOR PRINTING BY GSHOWF
-C
- COMMON /SLATE/ CH(40)
-C
- CALL UBLOW (
- + 40H CPP_TITLE
- +, CH,40)
- CALL GSHOWF (LUN)
- RETURN
- END
-#ifdef CERNLIB_TCGEN_GSHOW
-#undef CERNLIB_TCGEN_GSHOW
-#endif
-* ==================================================
-#include "qcardl.inc"
-#include "TITLE.kernhyw"
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywgc/hyw8t9.F b/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywgc/hyw8t9.F
deleted file mode 100644
index 118411a..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywgc/hyw8t9.F
+++ /dev/null
@@ -1,38 +0,0 @@
-*
-* $Id: hyw8t9.F,v 1.1.1.1 1996/02/15 17:52:48 mclareni Exp $
-*
-* $Log: hyw8t9.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:48 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE HYW8T9 (IV8,IV9,NW)
-C
-C CERN PROGLIB# HYW8T9 .VERSION KERNHYW 1.07 870624
-C ORIG. 22/06/87 JZ
-C Expand 8-bit bytes to 9-bit bytes
-C
- DIMENSION IV8(99),IV9(99)
-
-C- 0 9 18 27 35
-C- | | | | |
-C- | | | | | ||||| | | | | ||||| | | | | ||||| | | | | |||||
-C- | | | |
-C- 4 12 20 28 35
-
- DO 24 JL=1,NW
- M8 = IV8(JL)
- M9 = FLD(28,8,M8)
- FLD(19,8,M9) = FLD(20,8,M8)
- FLD(10,8,M9) = FLD(12,8,M8)
- FLD (1,8,M9) = FLD (4,8,M8)
- 24 IV9(JL) = M9
- RETURN
- END
-#ifdef CERNLIB_TCGEN_HYW8T9
-#undef CERNLIB_TCGEN_HYW8T9
-#endif
-* ==================================================
-#include "qcardl.inc"
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywgc/hyw9t8.F b/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywgc/hyw9t8.F
deleted file mode 100644
index 25df30d..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywgc/hyw9t8.F
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: hyw9t8.F,v 1.1.1.1 1996/02/15 17:52:49 mclareni Exp $
-*
-* $Log: hyw9t8.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:49 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE HYW9T8 (IV9,IV8,NW)
-C
-C CERN PROGLIB# HYW9T8 .VERSION KERNHYW 1.07 870624
-C ORIG. 22/06/87 JZ
-C Contract 9-bit bytes to 8-bit bytes
-C
- DIMENSION IV9(99),IV8(99)
-
-
- DO 24 JL=1,NW
- M9 = IV9(JL)
- M8 = FLD(28,8,M9)
- FLD(20,8,M8) = FLD(19,8,M9)
- FLD(12,8,M8) = FLD(10,8,M9)
- FLD (4,8,M8) = FLD (1,8,M9)
- 24 IV8(JL) = M8
- RETURN
- END
-#ifdef CERNLIB_TCGEN_HYW9T8
-#undef CERNLIB_TCGEN_HYW9T8
-#endif
-* ==================================================
-#include "qcardl.inc"
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywgc/ie3fod.F b/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywgc/ie3fod.F
deleted file mode 100644
index 2175980..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywgc/ie3fod.F
+++ /dev/null
@@ -1,103 +0,0 @@
-*
-* $Id: ie3fod.F,v 1.1.1.1 1996/02/15 17:52:50 mclareni Exp $
-*
-* $Log: ie3fod.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:50 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE IE3FOD (MS,MT,NDPN,JBAD)
-C
-C CERN PROGLIB# M220 IE3FOD .VERSION KERNHYW 1.06 870612
-C ORIG. 12-june-87 JZ
-
-C- Convert double precision for output with copy
-C- from source in native to target in IEEE data format
-
- DIMENSION MS(99), MT(99)
-
- DOUBLE PRECISION THDB
- DIMENSION THIS(2)
- EQUIVALENCE (THDB,THIS)
- EQUIVALENCE (ITHA,THA,THIS(1)), (ITHB,THB,THIS(2))
-
- PARAMETER (IBADCD = O'17774017700')
- PARAMETER (IOVPCD = O'17774000000')
- PARAMETER (IOVNCD = O'37774000000')
-
- PARAMETER (IBADMS = O'376777777776')
- PARAMETER (IOVPMS = O'376777777777')
- PARAMETER (IOVNMS = O'377000000000')
-
-C- IBAD : Not-a-number
-C- IOV : overflow P +ve / N -ve
-C- letter M machine internal / C converted
-C- letter S single / D double
-
-#include "q_shift.inc"
-
- JFAI = 0
- JMS = 0
- JMT = 0
-
- DO 449 JL=1,NDPN
- ITHA = MS(JMS+1)
- IF (THA.EQ.0.) GO TO 441
- IF (ITHA.EQ.0) GO TO 442
- IF (ITHA.EQ.IBADMS) GO TO 437
- IF (ITHA.EQ.IOVPMS) GO TO 438
- IF (ITHA.EQ.IOVNMS) GO TO 438
- ITHB = MS(JMS+2)
- JSIGN = 0
- IF (THIS.LT.0.) THEN
- THIS = -THIS
- JSIGN = 2048
- ENDIF
- JEXP = ISHFTR (ITHA, 28)
- IF (JEXP.GE.128) JEXP= JEXP-256
- JEXPC = JEXP + 1022
-
-C-- Check mantissa normalized
-
- JMANT = ISHFTL (ITHA,9)
- IF (JMANT.EQ.0) GO TO 441
- IF (JMANT.GT.0) GO TO 437
-
-C-- Zero the hidden bit,
-C- Keep the next 20 bits on the right in word 1,
-C- and the remaining 6 bits on the left in word 2,
-C- with the last 26 bits taken from ITHB
-
- 421 JMANT = ISHFTL (JMANT,1)
- ITHB = IOR (ISHFTR(ISHFTL(JMANT,20),4), ISHFTR(ITHB,10))
- ITHA = IOR (ISHFTL(JSIGN+JEXPC,20), ISHFTR(JMANT,16))
- GO TO 447
-
-C-- Not-a-Number / Overflows
- 437 JFAI = JL
- ITHA = IBADCD
- GO TO 442
- 438 JFAI = JL
- ITHA = IOVPCD
- GO TO 442
- 439 JFAI = JL
- ITHA = IOVNCD
- GO TO 442
-
- 441 ITHA = 0
- 442 ITHB = 0
- 447 MT(JMT+1) = ITHA
- MT(JMT+2) = ITHB
- JMT = JMT + 2
- 449 JMS = JMS + 2
-
- JBAD = JFAI
- RETURN
- END
-#ifdef CERNLIB_TCGEN_IE3FOD
-#undef CERNLIB_TCGEN_IE3FOD
-#endif
-* ==================================================
-#include "qcardl.inc"
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywgc/ie3fos.F b/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywgc/ie3fos.F
deleted file mode 100644
index 6b26c06..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywgc/ie3fos.F
+++ /dev/null
@@ -1,110 +0,0 @@
-*
-* $Id: ie3fos.F,v 1.1.1.1 1996/02/15 17:52:50 mclareni Exp $
-*
-* $Log: ie3fos.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:50 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE IE3FOS (MS,MT,NWDO,JBAD)
-C
-C CERN PROGLIB# M220 IE3FOS .VERSION KERNHYW 1.06 870612
-C ORIG. 11-june-87 JZ
-
-C- Convert single precision for output with copy
-C- from source in native to target in IEEE data format
-
- DIMENSION MS(99), MT(99)
-
- EQUIVALENCE (ITHA,THA)
-
- PARAMETER (IBADCS = O'17740177000')
- PARAMETER (IOVPCS = O'17740000000')
- PARAMETER (IOVNCS = O'37740000000')
-
- PARAMETER (IBADMS = O'376777777776')
- PARAMETER (IOVPMS = O'376777777777')
- PARAMETER (IOVNMS = O'377000000000')
-
-C- IBAD : Not-a-number
-C- IOV : overflow P +ve / N -ve
-C- letter M machine internal / C converted
-C- letter S single / D double
-
-#include "q_shift.inc"
-
- JFAI = 0
- JMS = 0
- JMT = 0
-
- 301 DO 349 JL=1,NWDO
- ITHA = MS(JMS+1)
- IF (THA.EQ.0.) GO TO 341
- IF (ITHA.EQ.0) GO TO 347
- IF (ITHA.EQ.IBADMS) GO TO 337
- IF (ITHA.EQ.IOVPMS) GO TO 338
- IF (ITHA.EQ.IOVNMS) GO TO 338
- JSIGN = 0
- IF (THA.LT.0.) THEN
- THA = -THA
- JSIGN = 256
- ENDIF
- JEXP = ISHFTR (ITHA, 28)
- IF (JEXP.GE.128) JEXP= JEXP-256
- JEXPC = JEXP + 126
-
-C-- Check mantissa normalized
-
- JMANT = ISHFTL (ITHA,9)
- IF (JMANT.EQ.0) GO TO 341
- 317 IF (JEXPC.LE.0) GO TO 331
- IF (JMANT.LT.0) GO TO 321
- JMANT = ISHFTL (JMANT,1)
- JEXPC = JEXPC - 1
- GO TO 317
-
-C-- Zero the hidden bit,
-C- Keep the next 23 signf. bits, plus 1 for rounding
-
- 321 JMANT = ISHFTR (ISHFTL(JMANT,1), 12)
- IF (JMANT.EQ.O'77777777') THEN
- JMANT = 0
- JEXPC = JEXPC + 1
- ELSE
- JMANT = ISHFTR(JMANT+1,1)
- ENDIF
- ITHA = IOR (ISHFTL(JSIGN+JEXPC,23), JMANT)
- GO TO 347
-
-C-- make de-normalized number
- 331 JMANT = ISHFTR (JMANT,13-JEXPC)
- IF (JMANT.EQ.0) GO TO 341
- ITHA = IOR (LSHFT(JSIGN,23), JMANT)
- GO TO 347
-
-C-- Not-a-Number / Overflows
- 337 JFAI = JL
- ITHA = IBADCS
- GO TO 347
- 338 JFAI = JL
- ITHA = IOVPCS
- GO TO 347
- 339 JFAI = JL
- ITHA = IOVNCS
- GO TO 347
-
- 341 ITHA = 0
- 347 MT(JMT+1) = ITHA
- JMT = JMT + 1
- 349 JMS = JMS + 1
-
- JBAD = JFAI
- RETURN
- END
-#ifdef CERNLIB_TCGEN_IE3FOS
-#undef CERNLIB_TCGEN_IE3FOS
-#endif
-* ==================================================
-#include "qcardl.inc"
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywgc/ie3tod.F b/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywgc/ie3tod.F
deleted file mode 100644
index 8c0d3e9..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywgc/ie3tod.F
+++ /dev/null
@@ -1,98 +0,0 @@
-*
-* $Id: ie3tod.F,v 1.1.1.1 1996/02/15 17:52:50 mclareni Exp $
-*
-* $Log: ie3tod.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:50 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE IE3TOD (MS,MT,NDPN,JBAD)
-C
-C CERN PROGLIB# M220 IE3TOD .VERSION KERNHYW 1.06 870612
-
-C- Convert double precision for input with copy
-C- from source in IEEE to target in native data format
-
- DIMENSION MS(99), MT(99)
-
- DOUBLE PRECISION THDB
- DIMENSION THIS(2)
- EQUIVALENCE (THDB,THIS)
- EQUIVALENCE (ITHA,THA,THIS(1)), (ITHB,THB,THIS(2))
-
- PARAMETER (JEXMIN = -127, JEXMAX=126)
- PARAMETER (IOVPMS = O'376777777777')
- PARAMETER (IOVNMS = O'377000000000')
- PARAMETER (IBADMS = O'376777777776')
- PARAMETER (IBADMD = IBADMS, IBADME = 0)
- PARAMETER (IOVPMD = IOVPMS, IOVNMD = IOVNMS)
-
-#include "q_jbit.inc"
-
- JFAI = 0
- JMS = 0
- JMT = 0
-
- DO 449 JL=1,NDPN
- ITHA = MS(JMS+1)
- IF (ITHA.EQ.0) GO TO 442
- ITHB = MS(JMS+2)
- JSIGN = JBIT (ITHA,32)
- JEXP = JBYT (ITHA,21,11)
- JMANT = JBYT (ITHA, 1,20)
- IF (JEXP.EQ.0) GO TO 431
- IF (JEXP.EQ.2047) GO TO 433
-
- JMANT = JMANT + 1 048 576
- JEXP = JEXP - 1023
- IF (JEXP.GT.JEXMAX) GO TO 432
- 424 IF (JEXP.LT.JEXMIN) GO TO 441
-
- JMANS = JBYT (ITHB,17,16)
- JMANR = JBYT (ITHB, 1,16)
-
- JPRE = ISIGN (48,JEXP)
- THDB = ( DBLE(JMANT)
- + + DBLE(FLOAT(JMANS)*2.**(-16))
- + + DBLE(FLOAT(JMANR)*2.**(-32)) ) * 2.**(JPRE-20)
- THDB = THDB * 2.**(JEXP-JPRE)
- IF (JSIGN.EQ.0) GO TO 447
- THDB = -THDB
- GO TO 447
-
- 431 IF (JMANT.EQ.0) GO TO 441
- JEXP = -1022
- GO TO 424
-
- 432 JMANT = 0
- 433 IF (JMANT.EQ.0) THEN
- IF (JSIGN.EQ.0) THEN
- ITHB = IOVPMD
- ELSE
- ITHB = IOVNMD
- ENDIF
- ELSE
- ITHB = IBADMD
- ENDIF
- JFAI = JL
- ITHA = ITHB
- ITHB = IBADME
- GO TO 447
-
- 441 ITHA = 0
- 442 ITHB = 0
- 447 MT(JMT+1) = ITHA
- MT(JMT+2) = ITHB
- JMT = JMT + 2
- 449 JMS = JMS + 2
-
- JBAD = JFAI
- RETURN
- END
-#ifdef CERNLIB_TCGEN_IE3TOD
-#undef CERNLIB_TCGEN_IE3TOD
-#endif
-* ==================================================
-#include "qcardl.inc"
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywgc/ie3tos.F b/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywgc/ie3tos.F
deleted file mode 100644
index aeab281..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywgc/ie3tos.F
+++ /dev/null
@@ -1,87 +0,0 @@
-*
-* $Id: ie3tos.F,v 1.1.1.1 1996/02/15 17:52:50 mclareni Exp $
-*
-* $Log: ie3tos.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:50 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE IE3TOS (MS,MT,NWDO,JBAD)
-C
-C CERN PROGLIB# M220 IE3TOS .VERSION KERNHYW 1.06 870612
-
-C- Convert single precision for input with copy
-C- from source in IEEE to target in native data format
-
- DIMENSION MS(99), MT(99)
-
- DOUBLE PRECISION THDB
- DIMENSION THIS(2)
- EQUIVALENCE (THDB,THIS)
- EQUIVALENCE (ITHA,THA,THIS(1)), (ITHB,THB,THIS(2))
-
- PARAMETER (JEXMIN = -127, JEXMAX=126)
- PARAMETER (IOVPMS = O'376777777777')
- PARAMETER (IOVNMS = O'377000000000')
- PARAMETER (IBADMS = O'376777777776')
-
-#include "q_jbit.inc"
-
- JBAD = 0
- JMS = 0
- JMT = 0
-
- 301 DO 349 JL=1,NWDO
- ITHA = MS(JMS+1)
- IF (ITHA.EQ.0) GO TO 347
- JSIGN = JBIT (ITHA,32)
- JEXP = JBYT (ITHA,24,8)
- JMANT = JBYT (ITHA,1,23)
- IF (JEXP.EQ.0) GO TO 331
- IF (JEXP.EQ.255) GO TO 333
- JMANT = JMANT + 8 388 608
- JEXP = JEXP - 127
- IF (JEXP.GT.JEXMAX) GO TO 332
- JPRE = ISIGN (23,JEXP)
- THA = FLOAT(JMANT) * 2.**(JPRE-23)
- THA = THA * 2.**(JEXP-JPRE)
- IF (JSIGN.EQ.0) GO TO 347
- THA = -THA
- GO TO 347
-
- 331 IF (JMANT.EQ.0) GO TO 341
- THA = FLOAT(JMANT) * 2.**(-63)
- THA = THA * 2.**(-86)
- IF (ITHA .EQ.0) GO TO 347
- IF (JSIGN.EQ.0) GO TO 347
- THA = -THA
- GO TO 347
-
- 332 JMANT = 0
- 333 IF (JMANT.EQ.0) THEN
- IF (JSIGN.EQ.0) THEN
- ITHB = IOVPMS
- ELSE
- ITHB = IOVNMS
- ENDIF
- ELSE
- ITHB = IBADMS
- ENDIF
- JBAD = JL
- ITHA = ITHB
- GO TO 347
-
- 341 ITHA = 0
- 347 MT(JMT+1) = ITHA
- JMT = JMT + 1
- 349 JMS = JMS + 1
-
- RETURN
- END
-#ifdef CERNLIB_TCGEN_IE3TOS
-#undef CERNLIB_TCGEN_IE3TOS
-#endif
-* ==================================================
-#include "qcardl.inc"
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywgc/iuforw.F b/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywgc/iuforw.F
deleted file mode 100644
index 401c493..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywgc/iuforw.F
+++ /dev/null
@@ -1,43 +0,0 @@
-*
-* $Id: iuforw.F,v 1.1.1.1 1996/02/15 17:52:50 mclareni Exp $
-*
-* $Log: iuforw.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:50 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- FUNCTION IUFORW (IC,JL,JR)
-C
-C CERN PROGLIB# M410 IUFORW .VERSION KERNHYW 1.06 870612
-C ORIG. 12-june-87 JZ
-C
- DIMENSION IC(99)
- COMMON /SLATE/ ND,JEND, DUMMY(38)
-
-#include "q_shift.inc"
-
- ND = 0
- JEND = JL
- IVAL = 0
-
- 12 IF (JEND.GT.JR) GO TO 20
- K = ISHFTR (IC(JEND),27)
- IF (K.EQ.32) GO TO 19
- IF (K.GE.58) GO TO 20
- K = K - 48
- IF (K.LT.0) GO TO 20
- IVAL = 10*IVAL + K
- ND = ND + 1
- 19 JEND = JEND + 1
- GO TO 12
-
- 20 IUFORW = IVAL
- RETURN
- END
-#ifdef CERNLIB_TCGEN_IUFORW
-#undef CERNLIB_TCGEN_IUFORW
-#endif
-* ==================================================
-#include "qcardl.inc"
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywgc/jbit.F b/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywgc/jbit.F
deleted file mode 100644
index 0c738fb..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywgc/jbit.F
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: jbit.F,v 1.1.1.1 1996/02/15 17:52:50 mclareni Exp $
-*
-* $Log: jbit.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:50 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- FUNCTION JBIT (IW,JPOS)
-C
-C CERN PROGLIB# M421 JBIT .VERSION KERNHYW 1.03 841013
-C ORIG. 13/10/84 JZ
-C
- JBIT = FLD(36-JPOS,1,IW)
- RETURN
- END
-#ifdef CERNLIB_TCGEN_JBIT
-#undef CERNLIB_TCGEN_JBIT
-#endif
-* ==================================================
-#include "qcardl.inc"
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywgc/jbyt.F b/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywgc/jbyt.F
deleted file mode 100644
index 32280cb..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywgc/jbyt.F
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: jbyt.F,v 1.1.1.1 1996/02/15 17:52:50 mclareni Exp $
-*
-* $Log: jbyt.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:50 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- FUNCTION JBYT (IW,JPOS,NBITS)
-C
-C CERN PROGLIB# M421 JBYT .VERSION KERNHYW 1.03 841013
-C ORIG. 13/10/84 JZ
-C
- JBYT = FLD(37-JPOS-NBITS,NBITS,IW)
- RETURN
- END
-#ifdef CERNLIB_TCGEN_JBYT
-#undef CERNLIB_TCGEN_JBYT
-#endif
-* ==================================================
-#include "qcardl.inc"
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywgc/jbytet.F b/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywgc/jbytet.F
deleted file mode 100644
index a389db1..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywgc/jbytet.F
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: jbytet.F,v 1.1.1.1 1996/02/15 17:52:50 mclareni Exp $
-*
-* $Log: jbytet.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:50 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- FUNCTION JBYTET (MASK,IW,JPOS,NBITS)
-C
-C CERN PROGLIB# M421 JBYTET .VERSION KERNHYW 1.03 841013
-C ORIG. 13/10/84 JZ
-C
- JBYTET = AND (MASK,FLD(37-JPOS-NBITS,NBITS,IW))
- RETURN
- END
-#ifdef CERNLIB_TCGEN_JBYTET
-#undef CERNLIB_TCGEN_JBYTET
-#endif
-* ==================================================
-#include "qcardl.inc"
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywgc/jbytor.F b/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywgc/jbytor.F
deleted file mode 100644
index 98826df..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywgc/jbytor.F
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: jbytor.F,v 1.1.1.1 1996/02/15 17:52:50 mclareni Exp $
-*
-* $Log: jbytor.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:50 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- FUNCTION JBYTOR (MZ,IZW,IZP,NZB)
-C
-C CERN PROGLIB# M421 JBYTOR .VERSION KERNHYW 1.05 870602
-C ORIG. 19/05/87 JZ
-C
- JBYTOR = IOR (MZ, IBITS(IZW,IZP-1,NZB))
- RETURN
- END
-#ifdef CERNLIB_TCGEN_JBYTOR
-#undef CERNLIB_TCGEN_JBYTOR
-#endif
-* ==================================================
-#include "qcardl.inc"
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywgc/locf.s b/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywgc/locf.s
deleted file mode 100644
index 5585d16..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywgc/locf.s
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: locf.s,v 1.1.1.1 1996/02/15 17:52:51 mclareni Exp $
-*
-* $Log: locf.s,v $
-* Revision 1.1.1.1 1996/02/15 17:52:51 mclareni
-* Kernlib
-*
-*
- SYMDEF LOCF
-LOCF XED 0,1
- ARL 18
- STA 0,QU
- TRA 2,1
- END
-#ifdef CERNLIB_TCGEN_LOCF
-#undef CERNLIB_TCGEN_LOCF
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywgc/mbytet.F b/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywgc/mbytet.F
deleted file mode 100644
index 0df9d05..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywgc/mbytet.F
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: mbytet.F,v 1.1.1.1 1996/02/15 17:52:52 mclareni Exp $
-*
-* $Log: mbytet.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:52 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- FUNCTION MBYTET (MZ,IZW,IZP,NZB)
-C
-C CERN PROGLIB# M421 MBYTET .VERSION KERNHYW 1.05 870602
-C ORIG. 19/05/87 JZ
-C
-
- MBYTET = IAND (IZW,
- + NOT(IRL (ILS(NOT(MZ),36-NZB), 37-IZP-NZB)))
- RETURN
- END
-#ifdef CERNLIB_TCGEN_MBYTET
-#undef CERNLIB_TCGEN_MBYTET
-#endif
-* ==================================================
-#include "qcardl.inc"
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywgc/mbytor.F b/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywgc/mbytor.F
deleted file mode 100644
index c7e4424..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywgc/mbytor.F
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: mbytor.F,v 1.1.1.1 1996/02/15 17:52:52 mclareni Exp $
-*
-* $Log: mbytor.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:52 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- FUNCTION MBYTOR (MZ,IZW,IZP,NZB)
-C
-C CERN PROGLIB# M421 MBYTOR .VERSION KERNHYW 1.05 870602
-C ORIG. 19/05/87 JZ
-C
-
- MBYTOR = IOR (IZW, IRL (ILS(MZ,36-NZB), 37-IZP-NZB) )
- RETURN
- END
-#ifdef CERNLIB_TCGEN_MBYTOR
-#undef CERNLIB_TCGEN_MBYTOR
-#endif
-* ==================================================
-#include "qcardl.inc"
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywgc/mcbyt.F b/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywgc/mcbyt.F
deleted file mode 100644
index 050ef47..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywgc/mcbyt.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: mcbyt.F,v 1.1.1.1 1996/02/15 17:52:52 mclareni Exp $
-*
-* $Log: mcbyt.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:52 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- FUNCTION MCBYT (MZ,IZQ,IZW,IZP,NZB)
-C
-C CERN PROGLIB# M421 MCBYT .VERSION KERNHYW 1.05 870602
-C ORIG. 19/05/87 JZ
-C
-
- MCBYT = IOR ( IAND (IZW,
- + NOT(ILS (IRL(NOT(0),36-NZB), IZP-1)))
- +, IRL (ILS(IRL(MZ,IZQ-1),36-NZB), 37-IZP-NZB) )
- RETURN
- END
-#ifdef CERNLIB_TCGEN_MCBYT
-#undef CERNLIB_TCGEN_MCBYT
-#endif
-* ==================================================
-#include "qcardl.inc"
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywgc/msbit.F b/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywgc/msbit.F
deleted file mode 100644
index a432b3b..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywgc/msbit.F
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: msbit.F,v 1.1.1.1 1996/02/15 17:52:52 mclareni Exp $
-*
-* $Log: msbit.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:52 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- FUNCTION MSBIT (MZ,IZW,IZP)
-C
-C CERN PROGLIB# M421 MSBIT .VERSION KERNHYW 1.05 870602
-C ORIG. 19/05/87 JZ
-C
-
- MSBIT = IOR (IAND (IZW, NOT(ILS(1,IZP-1)) )
- +, ILS(IAND(MZ,1),IZP-1))
- RETURN
- END
-#ifdef CERNLIB_TCGEN_MSBIT
-#undef CERNLIB_TCGEN_MSBIT
-#endif
-* ==================================================
-#include "qcardl.inc"
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywgc/msbit0.F b/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywgc/msbit0.F
deleted file mode 100644
index f055193..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywgc/msbit0.F
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: msbit0.F,v 1.1.1.1 1996/02/15 17:52:52 mclareni Exp $
-*
-* $Log: msbit0.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:52 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- FUNCTION MSBIT0 (IZW,IZP)
-C
-C CERN PROGLIB# M421 MSBIT0 .VERSION KERNHYW 1.05 870602
-C ORIG. 19/05/87 JZ
-C
- MSBIT0 = IAND (IZW, NOT(ILS(1,IZP-1)) )
- RETURN
- END
-#ifdef CERNLIB_TCGEN_MSBIT0
-#undef CERNLIB_TCGEN_MSBIT0
-#endif
-* ==================================================
-#include "qcardl.inc"
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywgc/msbit1.F b/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywgc/msbit1.F
deleted file mode 100644
index a9f757e..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywgc/msbit1.F
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: msbit1.F,v 1.1.1.1 1996/02/15 17:52:52 mclareni Exp $
-*
-* $Log: msbit1.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:52 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- FUNCTION MSBIT1 (IZW,IZP)
-C
-C CERN PROGLIB# M421 MSBIT1 .VERSION KERNHYW 1.05 870602
-C ORIG. 19/05/87 JZ
-C
- MSBIT1 = IOR (IZW, ILS(1,IZP-1) )
- RETURN
- END
-#ifdef CERNLIB_TCGEN_MSBIT1
-#undef CERNLIB_TCGEN_MSBIT1
-#endif
-* ==================================================
-#include "qcardl.inc"
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywgc/msbyt.F b/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywgc/msbyt.F
deleted file mode 100644
index 901a9a6..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywgc/msbyt.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: msbyt.F,v 1.1.1.1 1996/02/15 17:52:52 mclareni Exp $
-*
-* $Log: msbyt.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:52 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- FUNCTION MSBYT (MZ,IZW,IZP,NZB)
-C
-C CERN PROGLIB# M421 MSBYT .VERSION KERNHYW 1.05 870602
-C ORIG. 19/05/87 JZ
-C
-
- MSBYT = IOR ( IAND (IZW,
- + NOT(ILS (IRL(NOT(0),36-NZB), IZP-1)))
- +, IRL (ILS(MZ, 36-NZB), 37-IZP-NZB) )
- RETURN
- END
-#ifdef CERNLIB_TCGEN_MSBYT
-#undef CERNLIB_TCGEN_MSBYT
-#endif
-* ==================================================
-#include "qcardl.inc"
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywgc/pkbyt.F b/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywgc/pkbyt.F
deleted file mode 100644
index d69a30c..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywgc/pkbyt.F
+++ /dev/null
@@ -1,70 +0,0 @@
-*
-* $Id: pkbyt.F,v 1.1.1.1 1996/02/15 17:52:52 mclareni Exp $
-*
-* $Log: pkbyt.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:52 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE PKBYT (MIV,MBV,JTHP,NINTP,NBITS)
-C
-C CERN PROGLIB# M422 PKBYT .VERSION KERNHYW 1.06 870612
-C ORIG. 12-june-87 JZ
-C
- DIMENSION MIV(99), MBV(99), JTHP(9), NINTP(9), NBITS(2)
-
-#include "q_shift.inc"
-
- JTH = JTHP(1)
- NINT = NINTP(1)
- IF (NINT.LE.0) RETURN
-
- NZB = NBITS(1)
- IF (NZB.GT.0) GO TO 11
- NZB = 1
- NPWD = 36
- MASK = 1
- GO TO 12
-
- 11 NPWD = NBITS(2)
- MASK = ISHFTR (-1,36-NZB)
-
- 12 JBV = 1
- JIV = 0
- IF (JTH.LT.2) GO TO 21
- JBV = (JTH-1)/NPWD + 1
- JPOS = JTH - (JBV-1)*NPWD - 1
- IF (JPOS.EQ.0) GO TO 21
- NL = JPOS*NZB
- MSKU = ISHFTL (MASK,NL)
- JIVE = NPWD - JPOS
- GO TO 22
-
-C-- PACK EACH WORD
-
- 21 NL = 0
- MSKU = MASK
- JIVE = JIV + NPWD
- 22 JIVE = MIN0 (NINT,JIVE)
- IZW = MBV(JBV)
-
- 24 JIV = JIV + 1
- IZW = OR (AND(NOT(MSKU),IZW),
- + AND(MSKU,ISHFTL(MIV(JIV),NL)))
- IF (JIV.EQ.JIVE) GO TO 27
- NL = NL + NZB
- MSKU = ISHFTL (MSKU,NZB)
- GO TO 24
-
- 27 MBV(JBV) = IZW
- IF (JIV.EQ.NINT) RETURN
- JBV = JBV + 1
- GO TO 21
- END
-#ifdef CERNLIB_TCGEN_PKBYT
-#undef CERNLIB_TCGEN_PKBYT
-#endif
-* ==================================================
-#include "qcardl.inc"
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywgc/sbit.F b/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywgc/sbit.F
deleted file mode 100644
index 184c657..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywgc/sbit.F
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: sbit.F,v 1.1.1.1 1996/02/15 17:52:52 mclareni Exp $
-*
-* $Log: sbit.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:52 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE SBIT (IT,IW,JPOS)
-C
-C CERN PROGLIB# M421 SBIT .VERSION KERNHYW 1.03 841013
-C ORIG. 13/10/84 JZ
-C
- JPH = 36 - JPOS
- FLD(JPH,1,IW) = IT
- RETURN
- END
-#ifdef CERNLIB_TCGEN_SBIT
-#undef CERNLIB_TCGEN_SBIT
-#endif
-* ==================================================
-#include "qcardl.inc"
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywgc/sbit0.F b/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywgc/sbit0.F
deleted file mode 100644
index 1c41ae5..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywgc/sbit0.F
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: sbit0.F,v 1.1.1.1 1996/02/15 17:52:52 mclareni Exp $
-*
-* $Log: sbit0.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:52 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE SBIT0 (IW,JPOS)
-C
-C CERN PROGLIB# M421 SBIT0 .VERSION KERNHYW 1.03 841013
-C ORIG. 13/10/84 JZ
-C
- JPH = 36 - JPOS
- FLD(JPH,1,IW) = 0
- RETURN
- END
-#ifdef CERNLIB_TCGEN_SBIT0
-#undef CERNLIB_TCGEN_SBIT0
-#endif
-* ==================================================
-#include "qcardl.inc"
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywgc/sbit1.F b/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywgc/sbit1.F
deleted file mode 100644
index 131ac9e..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywgc/sbit1.F
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: sbit1.F,v 1.1.1.1 1996/02/15 17:52:52 mclareni Exp $
-*
-* $Log: sbit1.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:52 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE SBIT1 (IW,JPOS)
-C
-C CERN PROGLIB# M421 SBIT1 .VERSION KERNHYW 1.03 841013
-C ORIG. 13/10/84 JZ
-C
- JPH = 36 - JPOS
- FLD(JPH,1,IW) = 1
- RETURN
- END
-#ifdef CERNLIB_TCGEN_SBIT1
-#undef CERNLIB_TCGEN_SBIT1
-#endif
-* ==================================================
-#include "qcardl.inc"
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywgc/sbyt.F b/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywgc/sbyt.F
deleted file mode 100644
index b73222c..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywgc/sbyt.F
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: sbyt.F,v 1.1.1.1 1996/02/15 17:52:53 mclareni Exp $
-*
-* $Log: sbyt.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:53 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE SBYT (IT,IW,JPOS,NBITS)
-C
-C CERN PROGLIB# M421 SBYT .VERSION KERNHYW 1.03 841013
-C ORIG. 13/10/84 JZ
-C
- JPH = 37 - JPOS - NBITS
- FLD(JPH,NBITS,IW) = IT
- RETURN
- END
-#ifdef CERNLIB_TCGEN_SBYT
-#undef CERNLIB_TCGEN_SBYT
-#endif
-* ==================================================
-#include "qcardl.inc"
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywgc/sbytor.F b/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywgc/sbytor.F
deleted file mode 100644
index bdcb3b0..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywgc/sbytor.F
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: sbytor.F,v 1.1.1.1 1996/02/15 17:52:53 mclareni Exp $
-*
-* $Log: sbytor.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:53 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE SBYTOR (MASK,IW,JPOS,NBITS)
-C
-C CERN PROGLIB# M421 SBYTOR .VERSION KERNHYW 1.03 841013
-C ORIG. 13/10/84 JZ
-C
- JPH = 37 - JPOS - NBITS
- FLD(JPH,NBITS,IW) = OR (MASK,FLD(JPH,NBITS,IW))
- RETURN
- END
-#ifdef CERNLIB_TCGEN_SBYTOR
-#undef CERNLIB_TCGEN_SBYTOR
-#endif
-* ==================================================
-#include "qcardl.inc"
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywgc/ublow.F b/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywgc/ublow.F
deleted file mode 100644
index a508fae..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywgc/ublow.F
+++ /dev/null
@@ -1,53 +0,0 @@
-*
-* $Id: ublow.F,v 1.1.1.1 1996/02/15 17:52:53 mclareni Exp $
-*
-* $Log: ublow.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:53 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE UBLOW (IV4,IV,NCH)
-C
-C CERN PROGLIB# M409 UBLOW .VERSION KERNHYW 1.03 841013
-C ORIG. 13/10/84 JZ
-C
- DIMENSION IV4(99),IV(99)
- DATA IBLANK /4H /
-
- IF (NCH.EQ.0) RETURN
- NW = NCH/4
- NC = NCH - 4*NW
- J1 = 0
- M = IBLANK
- IF (NW.EQ.0) GO TO 41
-
- DO 24 J=1,NW
- MW = IV4(J)
- FLD(0,9,M) = FLD(0,9,MW)
- IV(J1+1) = M
- FLD(0,9,M) = FLD(9,9,MW)
- IV(J1+2) = M
- FLD(0,9,M) = FLD(18,9,MW)
- IV(J1+3) = M
- FLD(0,9,M) = FLD(27,9,MW)
- IV(J1+4) = M
- 24 J1 = J1 + 4
- IF (NC.EQ.0) RETURN
-
- 41 JP = 0
- MW = IV4(NW+1)
-
- DO 44 J=1,NC
- FLD(0,9,M) = FLD(JP,9,MW)
- IV(J1+1) = M
- J1 = J1 + 1
- 44 JP = JP + 9
- RETURN
- END
-#ifdef CERNLIB_TCGEN_UBLOW
-#undef CERNLIB_TCGEN_UBLOW
-#endif
-* ==================================================
-#include "qcardl.inc"
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywgc/ubunch.F b/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywgc/ubunch.F
deleted file mode 100644
index 20c67af..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywgc/ubunch.F
+++ /dev/null
@@ -1,48 +0,0 @@
-*
-* $Id: ubunch.F,v 1.1.1.1 1996/02/15 17:52:53 mclareni Exp $
-*
-* $Log: ubunch.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:53 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE UBUNCH (IV,IV4,NCH)
-C
-C CERN PROGLIB# M409 UBUNCH .VERSION KERNHYW 1.03 841013
-C ORIG. 13/10/84 JZ
-C
- DIMENSION IV(99),IV4(99)
- DATA IBLANK /4H /
-
- IF (NCH.EQ.0) RETURN
- NW = NCH/4
- NC = NCH - 4*NW
- J1 = 0
- IF (NW.EQ.0) GO TO 41
-
- DO 24 J4=1,NW
- FLD(0,9,M) = FLD(0,9,IV(J1+1))
- FLD(9,9,M) = FLD(0,9,IV(J1+2))
- FLD(18,9,M) = FLD(0,9,IV(J1+3))
- FLD(27,9,M) = FLD(0,9,IV(J1+4))
- IV4(J4) = M
- 24 J1 = J1 + 4
- IF (NC.EQ.0) RETURN
-
- 41 M = IBLANK
- JP = 0
-
- DO 44 J=1,NC
- FLD(JP,9,M) = FLD(0,9,IV(J1+1))
- JP = JP + 9
- 44 J1 = J1 + 1
- IV4(NW+1) = M
- RETURN
- END
-#ifdef CERNLIB_TCGEN_UBUNCH
-#undef CERNLIB_TCGEN_UBUNCH
-#endif
-* ==================================================
-#include "qcardl.inc"
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywgc/upkbyt.F b/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywgc/upkbyt.F
deleted file mode 100644
index 8d4fba9..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywgc/upkbyt.F
+++ /dev/null
@@ -1,65 +0,0 @@
-*
-* $Id: upkbyt.F,v 1.1.1.1 1996/02/15 17:52:53 mclareni Exp $
-*
-* $Log: upkbyt.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:53 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE UPKBYT (MBV,JTHP,MIV,NINTP,NBITS)
-C
-C CERN PROGLIB# M422 UPKBYT .VERSION KERNHYW 1.06 870612
-C ORIG. 12-june-87 JZ
-C
- DIMENSION MIV(99), MBV(99), JTHP(9), NINTP(9), NBITS(2)
-
-#include "q_shift.inc"
-
- JTH = JTHP(1)
- NINT = NINTP(1)
- IF (NINT.LE.0) RETURN
-
- NZB = NBITS(1)
- IF (NZB.GT.0) GO TO 11
- NZB = 1
- NPWD = 36
- MASK = 1
- GO TO 12
-
- 11 NPWD = NBITS(2)
- MASK = ISHFTR (-1,36-NZB)
-
- 12 JBV = 1
- JIV = 0
- IF (JTH.LT.2) GO TO 21
- JBV = (JTH-1)/NPWD + 1
- JPOS = JTH - (JBV-1)*NPWD - 1
- IF (JPOS.EQ.0) GO TO 21
- NR = JPOS*NZB
- JIVE = NPWD - JPOS
- IZW = ISHFTR (MBV(JBV),NR)
- GO TO 22
-
-C-- UNPACK EACH WORD
-
- 21 JIVE = JIV + NPWD
- IZW = MBV(JBV)
- 22 JIVE = MIN0 (NINT,JIVE)
-
- 24 JIV = JIV + 1
- MIV(JIV) = AND (MASK,IZW)
- IF (JIV.EQ.JIVE) GO TO 27
- IZW = ISHFTR (IZW,NZB)
- GO TO 24
-
- 27 IF (JIV.EQ.NINT) RETURN
- JBV = JBV + 1
- GO TO 21
- END
-#ifdef CERNLIB_TCGEN_UPKBYT
-#undef CERNLIB_TCGEN_UPKBYT
-#endif
-* ==================================================
-#include "qcardl.inc"
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywgc/xinb.F b/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywgc/xinb.F
deleted file mode 100644
index 28ac980..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywgc/xinb.F
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: xinb.F,v 1.1.1.1 1996/02/15 17:52:53 mclareni Exp $
-*
-* $Log: xinb.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:53 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE XINB (LUN,XBV,NXB)
-C
-C CERN PROGLIB# Z203 XINB .VERSION KERNHYW 1.07 870624
-C ORIG. 1/09/84 JZ, changed to use IOSTAT 22/06/87
-C
- DIMENSION XBV(999)
-C
- NIN = NXB
- READ (LUN,IOSTAT=JSTAT) NR,(XBV(J),J=1,MIN0(NR,NIN))
- IF (JSTAT) 61, 17, 64
- 17 NXB = MIN0(NR,NIN)
- RETURN
-C
- 61 NXB = 0
- RETURN
-C
- 64 NXB = -JSTAT
- RETURN
- END
-#ifdef CERNLIB_XVECT_XINB
-#undef CERNLIB_XVECT_XINB
-#endif
-* ==================================================
-#include "qcardl.inc"
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywgc/xinbf.F b/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywgc/xinbf.F
deleted file mode 100644
index 93d7ca3..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywgc/xinbf.F
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: xinbf.F,v 1.1.1.1 1996/02/15 17:52:54 mclareni Exp $
-*
-* $Log: xinbf.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:54 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE XINBF (LUN,XBV,NXB)
-C
-C CERN PROGLIB# Z203 XINBF .VERSION KERNHYW 1.07 870624
-C ORIG. 22/06/87 JZ
-C
- DIMENSION XBV(NXB)
-C
- READ (LUN,IOSTAT=JSTAT) XBV
- IF (JSTAT) 61, 17, 64
-C
- 61 NXB = 0
- 17 RETURN
-C
- 64 NXB = -JSTAT
- RETURN
- END
-#ifdef CERNLIB_XVECT_XINBF
-#undef CERNLIB_XVECT_XINBF
-#endif
-* ==================================================
-#include "qcardl.inc"
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywgc/xinbs.F b/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywgc/xinbs.F
deleted file mode 100644
index 887140c..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywgc/xinbs.F
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: xinbs.F,v 1.1.1.1 1996/02/15 17:52:54 mclareni Exp $
-*
-* $Log: xinbs.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:54 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE XINBS (LUN,XAV,NA,XBV,NXB)
-C
-C CERN PROGLIB# Z203 XINBS .VERSION KERNHYW 1.07 870624
-C ORIG. 1/09/84 JZ, changed to use IOSTAT 22/06/87
-C
- DIMENSION XBV(999), XAV(NA)
-C
- NIN = NXB
- READ (LUN,IOSTAT=JSTAT) NR,XAV,(XBV(J),J=1,MIN0(NR,NIN))
- IF (JSTAT) 61, 17, 64
- 17 NXB = MIN0(NR,NIN)
- RETURN
-C
- 61 NXB = 0
- RETURN
-C
- 64 NXB = -JSTAT
- RETURN
- END
-#ifdef CERNLIB_XVECT_XINBS
-#undef CERNLIB_XVECT_XINBS
-#endif
-* ==================================================
-#include "qcardl.inc"
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywmx/gshow.F b/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywmx/gshow.F
deleted file mode 100644
index 476148d..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywmx/gshow.F
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: gshow.F,v 1.1.1.1 1996/02/15 17:52:56 mclareni Exp $
-*
-* $Log: gshow.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:56 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE GSHOW (LUN)
-C
-C CERN PROGLIB# GSHOW .VERSION KERNHYW 1.00 840910
-C ORIG. 17/05/83 HRR
-C
-C-- STORE PAM TITLE INTO /SLATE/ FOR PRINTING BY GSHOWF
-C
- COMMON /SLATE/ CH(40)
-C
- CALL UBLOW (
- + 40H CPP_TITLE
- +, CH,40)
- CALL GSHOWF (LUN)
- RETURN
- END
-#ifdef CERNLIB_TCGEN_GSHOW
-#undef CERNLIB_TCGEN_GSHOW
-#endif
-#include "TITLE.kernhyw"
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywmx/xinb.F b/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywmx/xinb.F
deleted file mode 100644
index ff44a89..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywmx/xinb.F
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: xinb.F,v 1.1.1.1 1996/02/15 17:52:56 mclareni Exp $
-*
-* $Log: xinb.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:56 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE XINB (LUN,XBV,NXB)
-C
-C CERN PROGLIB# Z203 XINB .VERSION KERNHYW 1.02 840921
-C ORIG. 9/10/79 JZ
-C
- DIMENSION XBV(999)
-C
- NIN = NXB
- READ (LUN,END=61,ERR=64) NR,(XBV(J),J=1,MIN0(NR,NIN))
- NXB = MIN0(NR,NIN)
- RETURN
-C
- 61 NXB = 0
- RETURN
-C
- 64 NXB = -7
- RETURN
- END
-#ifdef CERNLIB_XVECT_XINB
-#undef CERNLIB_XVECT_XINB
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywmx/xinbs.F b/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywmx/xinbs.F
deleted file mode 100644
index 222c2af..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywmx/xinbs.F
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: xinbs.F,v 1.1.1.1 1996/02/15 17:52:56 mclareni Exp $
-*
-* $Log: xinbs.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:56 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE XINBS (LUN,XAV,NA,XBV,NXB)
-C
-C CERN PROGLIB# Z203 XINBS .VERSION KERNHYW 1.02 840921
-C ORIG. 9/10/79 JZ
-C
- DIMENSION XBV(999), XAV(NA)
-C
- NIN = NXB
- READ (LUN,END=61,ERR=64) NR,XAV,(XBV(J),J=1,MIN0(NR,NIN))
- NXB = MIN0(NR,NIN)
- RETURN
-C
- 61 NXB = 0
- RETURN
-C
- 64 NXB = -7
- RETURN
- END
-#ifdef CERNLIB_XVECT_XINBS
-#undef CERNLIB_XVECT_XINBS
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywpl1/datime.dat b/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywpl1/datime.dat
deleted file mode 100644
index 6c6053a..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywpl1/datime.dat
+++ /dev/null
@@ -1,44 +0,0 @@
-*
-* $Id: datime.dat,v 1.1.1.1 1996/02/15 17:52:56 mclareni Exp $
-*
-* $Log: datime.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:52:56 mclareni
-* Kernlib
-*
-*
-datime : proc (id, it);
-
-/* *****************************************************************
- * *
- * datime(id,it) id=10000*an+100*mois+jour *
- * it=100*heure+minute *
- * *
- ***************************************************************** */
-
-/* declarations des subroutiunes */
-
-dcl clock_ entry () returns (fixed bin (71));
-dcl decode_clock_value_$date_time entry (fixed bin (71), fixed bin
-, fixed bin, fixed bin, fixed bin
-, fixed bin, fixed bin, fixed bin (71), fixed bin, char (3)
-, fixed bin (35));
-
-/* declarations des variables */
-
-dcl (clock, microsecond) bin fixed (71);
-dcl (id, it, code) bin fixed (35);
-dcl (month, year, dom, hour, minute, second, dow) fixed bin;
-dcl zone char (3);
-
-
-
- zone = "";
- clock = clock_ ();
- call decode_clock_value_$date_time (clock, month, dom, year
-, hour, minute, second, microsecond, dow, zone, code);
- id = 10000* (year-1900)+100*month+dom;
- it = 100*hour+minute;
- END datime;
-#ifdef CERNLIB_TCGEN_DATIME
-#undef CERNLIB_TCGEN_DATIME
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywpl1/jbit.dat b/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywpl1/jbit.dat
deleted file mode 100644
index aff126a..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywpl1/jbit.dat
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: jbit.dat,v 1.1.1.1 1996/02/15 17:52:56 mclareni Exp $
-*
-* $Log: jbit.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:52:56 mclareni
-* Kernlib
-*
-*
-jbit : proc (a, la) returns (bin fixed (35));
-
-/* *****************************************************************
- * *
- * jbit(a,la) a bin fixed(35) *
- * la numero du bit a aller prendre dans a *
- * *
- ***************************************************************** */
-dcl (temp, a, la) bin fixed (35);
- temp = 0;
- substr (unspec (temp), 36, 1) =
-substr (unspec (a), 37-la, 1);
- return (temp);
- END jbit;
-#ifdef CERNLIB_TCGEN_JBIT
-#undef CERNLIB_TCGEN_JBIT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywpl1/jbyt.dat b/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywpl1/jbyt.dat
deleted file mode 100644
index a5b3fa4..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywpl1/jbyt.dat
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: jbyt.dat,v 1.1.1.1 1996/02/15 17:52:56 mclareni Exp $
-*
-* $Log: jbyt.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:52:56 mclareni
-* Kernlib
-*
-*
-jbyt : proc (a, la, nbits) returns (bin fixed (35));
-
-/* *****************************************************************
- * *
- * JBYT(a,la,nbits) prendre bits la a la-1+nbits de a *
- * *
- ***************************************************************** */
-dcl (temp, a, la, nbits) bin fixed (35);
- temp = 0;
- substr (unspec (temp), 37-nbits, nbits) =
-substr (unspec (a), 38-la-nbits, nbits);
- return (temp);
- END jbyt;
-#ifdef CERNLIB_TCGEN_JBYT
-#undef CERNLIB_TCGEN_JBYT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywpl1/jbytet.dat b/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywpl1/jbytet.dat
deleted file mode 100644
index 0a501fc..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywpl1/jbytet.dat
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: jbytet.dat,v 1.1.1.1 1996/02/15 17:52:56 mclareni Exp $
-*
-* $Log: jbytet.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:52:56 mclareni
-* Kernlib
-*
-*
-jbytet : proc (msk, a, la, nbits) returns (bin fixed (35));
-
-dcl (temp, msk, a, la, nbits) bin fixed (35);
- temp = 0;
- substr (unspec (temp), 37-nbits, nbits) =
-substr (unspec (a), 38-la-nbits, nbits);
- unspec(temp) = unspec(temp) & unspec(msk);
- return (temp);
- END jbytet;
-#ifdef CERNLIB_TCGEN_JBYTET
-#undef CERNLIB_TCGEN_JBYTET
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywpl1/locf.dat b/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywpl1/locf.dat
deleted file mode 100644
index 6e453bd..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywpl1/locf.dat
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: locf.dat,v 1.1.1.1 1996/02/15 17:52:57 mclareni Exp $
-*
-* $Log: locf.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:52:57 mclareni
-* Kernlib
-*
-*
-locf : proc (a) returns (bin fixed (35));
-
-/* *****************************************************************
- * *
- * locf(a) rend adresse de a *
- * *
- ***************************************************************** */
-
-dcl p pointer;
-dcl (a, temp) bin fixed (35);
- p = addr (a);
- temp = convert (temp, rel (p));
- return (temp);
- END locf;
-#ifdef CERNLIB_TCGEN_LOCF
-#undef CERNLIB_TCGEN_LOCF
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywpl1/sbit.dat b/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywpl1/sbit.dat
deleted file mode 100644
index ed8d87f..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywpl1/sbit.dat
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: sbit.dat,v 1.1.1.1 1996/02/15 17:52:57 mclareni Exp $
-*
-* $Log: sbit.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:52:57 mclareni
-* Kernlib
-*
-*
-sbit : proc (a, x, lx) ;
-
-/* *****************************************************************
- * *
- * sbit(a,x,lx) x avec bit lx = bit lx de a *
- * *
- **************************************************************** */
-dcl (a, x, lx) bin fixed (35);
- substr (unspec (x), 37-lx, 1) = substr (unspec (a),36,1);
- END sbit;
-#ifdef CERNLIB_TCGEN_SBIT
-#undef CERNLIB_TCGEN_SBIT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywpl1/sbit0.dat b/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywpl1/sbit0.dat
deleted file mode 100644
index 435a051..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywpl1/sbit0.dat
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: sbit0.dat,v 1.1.1.1 1996/02/15 17:52:57 mclareni Exp $
-*
-* $Log: sbit0.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:52:57 mclareni
-* Kernlib
-*
-*
-sbit0 : proc (x, lx) ;
-
-/* *****************************************************************
- * *
- * sbit0(x,lx) x avec bit lx=0 *
- * *
- ***************************************************************** */
-dcl (a, x, lx) bin fixed (35);
- substr (unspec (x), 37-lx, 1) = "0"b;
- END sbit0;
-#ifdef CERNLIB_TCGEN_SBIT0
-#undef CERNLIB_TCGEN_SBIT0
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywpl1/sbit1.dat b/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywpl1/sbit1.dat
deleted file mode 100644
index 0c26d31..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywpl1/sbit1.dat
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: sbit1.dat,v 1.1.1.1 1996/02/15 17:52:57 mclareni Exp $
-*
-* $Log: sbit1.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:52:57 mclareni
-* Kernlib
-*
-*
-sbit1 : proc (x, lx) ;
-
-/* *****************************************************************
- * *
- * sbit1(x,lx) x avec bit lx=1 *
- * *
- ***************************************************************** */
-dcl (a, x, lx) bin fixed (35);
- substr (unspec (x), 37-lx, 1) = "1"b;
- END sbit1;
-#ifdef CERNLIB_TCGEN_SBIT1
-#undef CERNLIB_TCGEN_SBIT1
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywpl1/sbyt.dat b/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywpl1/sbyt.dat
deleted file mode 100644
index d0aad7b..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywpl1/sbyt.dat
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: sbyt.dat,v 1.1.1.1 1996/02/15 17:52:57 mclareni Exp $
-*
-* $Log: sbyt.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:52:57 mclareni
-* Kernlib
-*
-*
-sbyt : proc (a, x, lx, nbits);
-
-/* *****************************************************************
- * *
- * sbyt(a,x,lx,nbits) mettre les derniers nbits de a *
- * dans bits lx a lx-nbits-1 de x *
- * *
- ***************************************************************** */
-
-dcl (a, x, lx, nbits) bin fixed (35);
-
- substr (unspec (x), 38-lx-nbits, nbits) =
-substr (unspec (a), 37-nbits, nbits);
- END sbyt;
-#ifdef CERNLIB_TCGEN_SBYT
-#undef CERNLIB_TCGEN_SBYT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywpl1/sbytor.dat b/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywpl1/sbytor.dat
deleted file mode 100644
index 5c94e5e..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywpl1/sbytor.dat
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: sbytor.dat,v 1.1.1.1 1996/02/15 17:52:57 mclareni Exp $
-*
-* $Log: sbytor.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:52:57 mclareni
-* Kernlib
-*
-*
-sbytor : proc (a, x, lx, nbits);
-
-dcl (a, x, lx, nbits) bin fixed (35);
-
- substr (unspec (x), 38-lx-nbits, nbits) =
- substr (unspec (x), 38-lx-nbits, nbits)
- | substr (unspec (a), 37-nbits, nbits);
- END sbytor;
-#ifdef CERNLIB_TCGEN_SBYTOR
-#undef CERNLIB_TCGEN_SBYTOR
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywpl1/timed.dat b/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywpl1/timed.dat
deleted file mode 100644
index 706ec8f..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywpl1/timed.dat
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: timed.dat,v 1.1.1.1 1996/02/15 17:52:57 mclareni Exp $
-*
-* $Log: timed.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:52:57 mclareni
-* Kernlib
-*
-*
-timed : proc (t);
-
-/* *****************************************************************
- * *
- * timed(t) : t nombre de secondes depuis dernier appel *
- * si pas appele depuis debut du process *
- * *
- ***************************************************************** */
-dcl t bin fixed (35);
-dcl vti fixed bin (71) static init (0);
-dcl vclock builtin;
-dcl (vt, vtt) bin fixed (71);
-
- vt = vclock ();
- vtt = vt;
- vt = vt-vti;
- vti = vtt;
- t = vt/1000000;
- return;
- END timed;
-#ifdef CERNLIB_TCGEN_TIMED
-#undef CERNLIB_TCGEN_TIMED
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywpl1/ublow.dat b/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywpl1/ublow.dat
deleted file mode 100644
index 8a0310a..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywpl1/ublow.dat
+++ /dev/null
@@ -1,36 +0,0 @@
-*
-* $Id: ublow.dat,v 1.1.1.1 1996/02/15 17:52:57 mclareni Exp $
-*
-* $Log: ublow.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:52:57 mclareni
-* Kernlib
-*
-*
-ublow : proc (it, iv, n);
-
-/* *****************************************************************
- * *
- * ublow(it,iv,n) it en a4 dans iv a1 *
- * si n=0 rien faire *
- * si n< 0 message erreur *
- * *
- ***************************************************************** */
-
-dcl com_err_ entry () options (variable);
-dcl (it (*), iv (*)) bin fixed (35);
-dcl ivv (n) char (4) based (addr (iv));
-dcl itt char (n) based (addr (it));
-dcl (n, i) bin fixed (35);
- if n = 0 then return;
- if n <0 then do;
- call com_err_ (0, "ublow", "n est negatif");
- return;
- end;
- do i = 1 to n;
- ivv (i) = substr (itt, i, 1);
- end;
- return;
- END ublow;
-#ifdef CERNLIB_TCGEN_UBLOW
-#undef CERNLIB_TCGEN_UBLOW
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywpl1/ubunch.dat b/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywpl1/ubunch.dat
deleted file mode 100644
index a6cb0da..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernhyw/hywpl1/ubunch.dat
+++ /dev/null
@@ -1,40 +0,0 @@
-*
-* $Id: ubunch.dat,v 1.1.1.1 1996/02/15 17:52:57 mclareni Exp $
-*
-* $Log: ubunch.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:52:57 mclareni
-* Kernlib
-*
-*
-ubunch : proc (iv, it, n);
-
-/* *****************************************************************
- * *
- * ubunch(IV,IT,n) iv en a1 -> it en a4
- * si n=0 rien faire *
- * si n< 0 message erreur *
- * *
- ***************************************************************** */
-
-dcl com_err_ entry () options (variable);
-DCL TRUNC BUILTIN
-dcl (it (*), iv (*)) bin fixed (35);
-dcl ivv (n) char (4) based (addr (iv));
-dcl itt char (n) based (addr (it));
-dcl iTCH (n) char (4) based (addr (iT));
-dcl (n, N4, i) bin fixed (35);
- if n = 0 then return;
- if n <0 then do;
- call com_err_ (0, "ubunch", "n est negatif");
- return;
- end;
- N4 = TRUNC ((n-1)/4 + 1);
- ITCH(N4) = " ";
- do i = 1 to n;
- substr (itt, i, 1) = substr (ivv (i), 1, 1);
- end;
- return;
- END ubunch;
-#ifdef CERNLIB_TCGEN_UBUNCH
-#undef CERNLIB_TCGEN_UBUNCH
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernhyw/inhibit.list b/src/packlib/kernlib/kerngen/obsolete/kernhyw/inhibit.list
deleted file mode 100644
index b5cc932..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernhyw/inhibit.list
+++ /dev/null
@@ -1,65 +0,0 @@
-tcgen/btest
-tcgen/ibits
-tcgen/ibclr
-tcgen/ibset
-tcgen/mvbits
-tcgen/ishft
-tcgen/ishftc
-tcgen/gshow
-tcgen/abend
-tcgen/cbyt
-tcgen/datime
-tcgen/hyw8t9
-tcgen/hyw9t8
-tcgen/ie3fos
-tcgen/ie3fod
-tcgen/ie3tos
-tcgen/ie3tod
-tcgen/iuforw
-tcgen/jbit
-tcgen/jbyt
-tcgen/jbytet
-tcgen/jbytor
-tcgen/locf
-tcgen/mbytet
-tcgen/mbytor
-tcgen/mcbyt
-tcgen/msbit
-tcgen/msbit0
-tcgen/msbit1
-tcgen/msbyt
-tcgen/pkbyt
-tcgen/sbit
-tcgen/sbit0
-tcgen/sbit1
-tcgen/sbyt
-tcgen/sbytor
-tcgen/ublow
-tcgen/ubunch
-tcgen/upkbyt
-xvect/xinb
-xvect/xinbf
-xvect/xinbs
-tcgen/btest
-tcgen/ibits
-tcgen/ibclr
-tcgen/ibset
-tcgen/mvbits
-tcgen/ishft
-tcgen/ishftc
-tcgen/gshow
-xvect/xinb
-xvect/xinbs
-tcgen/datime
-tcgen/jbit
-tcgen/jbyt
-tcgen/jbytet
-tcgen/locf
-tcgen/sbit
-tcgen/sbit0
-tcgen/sbit1
-tcgen/sbyt
-tcgen/sbytor
-tcgen/timed
-tcgen/ublow
-tcgen/ubunch
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernhyw/qmhywgc/q_andor.inc b/src/packlib/kernlib/kerngen/obsolete/kernhyw/qmhywgc/q_andor.inc
deleted file mode 100644
index f0fa5b6..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernhyw/qmhywgc/q_andor.inc
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: q_andor.inc,v 1.1.1.1 1996/02/15 17:52:47 mclareni Exp $
-*
-* $Log: q_andor.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:52:47 mclareni
-* Kernlib
-*
-*
-*
-* q_andor.inc
-*
-* IAND / IOR / IEOR / NOT are standard on Honywell
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernhyw/qmhywgc/q_cbyt.inc b/src/packlib/kernlib/kerngen/obsolete/kernhyw/qmhywgc/q_cbyt.inc
deleted file mode 100644
index 27104e6..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernhyw/qmhywgc/q_cbyt.inc
+++ /dev/null
@@ -1,14 +0,0 @@
-*
-* $Id: q_cbyt.inc,v 1.1.1.1 1996/02/15 17:52:47 mclareni Exp $
-*
-* $Log: q_cbyt.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:52:47 mclareni
-* Kernlib
-*
-*
-*
-* q_cbyt.inc
-*
- MCBYT (MZ,IZQ,IZW,IZP,NZB) = IOR ( IAND (IZW, NOT(
- + ILS (IRL(NOT(0),36-NZB), IZP-1)))
- + , IRL (ILS(IRL(MZ,IZQ-1),36-NZB), 37-IZP-NZB) )
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernhyw/qmhywgc/q_jbit.inc b/src/packlib/kernlib/kerngen/obsolete/kernhyw/qmhywgc/q_jbit.inc
deleted file mode 100644
index 03ace39..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernhyw/qmhywgc/q_jbit.inc
+++ /dev/null
@@ -1,13 +0,0 @@
-*
-* $Id: q_jbit.inc,v 1.1.1.1 1996/02/15 17:52:47 mclareni Exp $
-*
-* $Log: q_jbit.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:52:47 mclareni
-* Kernlib
-*
-*
-*
-* q_jbit.inc
-*
- JBIT (IZW,IZP) = IBITS (IZW,IZP-1,1)
- JBYT (IZW,IZP,NZB) = IBITS (IZW,IZP-1,NZB)
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernhyw/qmhywgc/q_jbytet.inc b/src/packlib/kernlib/kerngen/obsolete/kernhyw/qmhywgc/q_jbytet.inc
deleted file mode 100644
index 28eab28..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernhyw/qmhywgc/q_jbytet.inc
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: q_jbytet.inc,v 1.1.1.1 1996/02/15 17:52:47 mclareni Exp $
-*
-* $Log: q_jbytet.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:52:47 mclareni
-* Kernlib
-*
-*
-*
-* q_jbytet.inc
-*
- JBYTET (MZ,IZW,IZP,NZB) = IAND (MZ, IBITS(IZW,IZP-1,NZB))
- JBYTOR (MZ,IZW,IZP,NZB) = IOR (MZ, IBITS(IZW,IZP-1,NZB))
- MBYTET (MZ,IZW,IZP,NZB) = IAND (IZW, NOT(IRL (
- + ILS(NOT(MZ),36-NZB), 37-IZP-NZB)) )
- MBYTOR (MZ,IZW,IZP,NZB) = IOR (IZW, IRL (
- + ILS(MZ,36-NZB), 37-IZP-NZB) )
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernhyw/qmhywgc/q_sbit.inc b/src/packlib/kernlib/kerngen/obsolete/kernhyw/qmhywgc/q_sbit.inc
deleted file mode 100644
index d68687d..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernhyw/qmhywgc/q_sbit.inc
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: q_sbit.inc,v 1.1.1.1 1996/02/15 17:52:47 mclareni Exp $
-*
-* $Log: q_sbit.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:52:47 mclareni
-* Kernlib
-*
-*
-*
-* q_sbit.inc
-*
- MSBIT0 (IZW,IZP) = IAND (IZW, NOT(ILS(1,IZP-1)) )
- MSBIT1 (IZW,IZP) = IOR (IZW, ILS(1,IZP-1) )
- MSBIT (MZ,IZW,IZP) = IOR (IAND (IZW, NOT(ILS(1,IZP-1)) )
- + , ILS(IAND(MZ,1),IZP-1) )
- MSBYT (MZ,IZW,IZP,NZB) = IOR ( IAND (IZW, NOT(
- + ILS (IRL(NOT(0),36-NZB), IZP-1)))
- + , IRL (ILS(MZ,36-NZB), 37-IZP-NZB) )
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernhyw/qmhywgc/q_shift.inc b/src/packlib/kernlib/kerngen/obsolete/kernhyw/qmhywgc/q_shift.inc
deleted file mode 100644
index e682641..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernhyw/qmhywgc/q_shift.inc
+++ /dev/null
@@ -1,13 +0,0 @@
-*
-* $Id: q_shift.inc,v 1.1.1.1 1996/02/15 17:52:47 mclareni Exp $
-*
-* $Log: q_shift.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:52:47 mclareni
-* Kernlib
-*
-*
-*
-* q_shift.inc
-*
- ISHFTL (IZW,NZB) = ILS (IZW, NZB)
- ISHFTR (IZW,NZB) = IRL (IZW, NZB)
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernhyw/qmhywgc/qmhywgc.h b/src/packlib/kernlib/kerngen/obsolete/kernhyw/qmhywgc/qmhywgc.h
deleted file mode 100644
index 4c21ff0..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernhyw/qmhywgc/qmhywgc.h
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: qmhywgc.h,v 1.1.1.1 1996/02/15 17:52:47 mclareni Exp $
-*
-* $Log: qmhywgc.h,v $
-* Revision 1.1.1.1 1996/02/15 17:52:47 mclareni
-* Kernlib
-*
-*
-* This directory was created from kernhyw.car patch qmhywgc
-#ifndef CERNLIB_F77
-#define CERNLIB_F77
-#endif
-#ifndef CERNLIB_B36
-#define CERNLIB_B36
-#endif
-#ifndef CERNLIB_B36M
-#define CERNLIB_B36M
-#endif
-#ifndef CERNLIB_A4
-#define CERNLIB_A4
-#endif
-* In-line AND / OR
-#ifndef CERNLIB_QANDORINL
-#define CERNLIB_QANDORINL
-#endif
-* In-line SHIFT L/R
-#ifndef CERNLIB_QSHIFTINL
-#define CERNLIB_QSHIFTINL
-#endif
-#ifndef CERNLIB_QSHICOINL
-#define CERNLIB_QSHICOINL
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernhyw/qmhywmx/q_andor.inc b/src/packlib/kernlib/kerngen/obsolete/kernhyw/qmhywmx/q_andor.inc
deleted file mode 100644
index 35d3273..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernhyw/qmhywmx/q_andor.inc
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: q_andor.inc,v 1.1.1.1 1996/02/15 17:52:55 mclareni Exp $
-*
-* $Log: q_andor.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:52:55 mclareni
-* Kernlib
-*
-*
-*
-* q_andor.inc
-*
-* IAND / IOR / IEOR / NOT are standard on Honywell
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernhyw/qmhywmx/q_cbyt.inc b/src/packlib/kernlib/kerngen/obsolete/kernhyw/qmhywmx/q_cbyt.inc
deleted file mode 100644
index 3771d3f..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernhyw/qmhywmx/q_cbyt.inc
+++ /dev/null
@@ -1,14 +0,0 @@
-*
-* $Id: q_cbyt.inc,v 1.1.1.1 1996/02/15 17:52:55 mclareni Exp $
-*
-* $Log: q_cbyt.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:52:55 mclareni
-* Kernlib
-*
-*
-*
-* q_cbyt.inc
-*
- MCBYT (MZ,IZQ,IZW,IZP,NZB) = IOR ( IAND (IZW, NOT(
- + ILS (IRL(NOT(0),36-NZB), IZP-1)))
- + , IRL (ILS(IRL(MZ,IZQ-1),36-NZB), 37-IZP-NZB) )
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernhyw/qmhywmx/q_jbit.inc b/src/packlib/kernlib/kerngen/obsolete/kernhyw/qmhywmx/q_jbit.inc
deleted file mode 100644
index 66a9cfb..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernhyw/qmhywmx/q_jbit.inc
+++ /dev/null
@@ -1,13 +0,0 @@
-*
-* $Id: q_jbit.inc,v 1.1.1.1 1996/02/15 17:52:55 mclareni Exp $
-*
-* $Log: q_jbit.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:52:55 mclareni
-* Kernlib
-*
-*
-*
-* q_jbit.inc
-*
- JBIT (IZW,IZP) = IBITS (IZW,IZP-1,1)
- JBYT (IZW,IZP,NZB) = IBITS (IZW,IZP-1,NZB)
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernhyw/qmhywmx/q_jbytet.inc b/src/packlib/kernlib/kerngen/obsolete/kernhyw/qmhywmx/q_jbytet.inc
deleted file mode 100644
index 461663c..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernhyw/qmhywmx/q_jbytet.inc
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: q_jbytet.inc,v 1.1.1.1 1996/02/15 17:52:55 mclareni Exp $
-*
-* $Log: q_jbytet.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:52:55 mclareni
-* Kernlib
-*
-*
-*
-* q_jbytet.inc
-*
- JBYTET (MZ,IZW,IZP,NZB) = IAND (MZ, IBITS(IZW,IZP-1,NZB))
- JBYTOR (MZ,IZW,IZP,NZB) = IOR (MZ, IBITS(IZW,IZP-1,NZB))
- MBYTET (MZ,IZW,IZP,NZB) = IAND (IZW, NOT(IRL (
- + ILS(NOT(MZ),36-NZB), 37-IZP-NZB)) )
- MBYTOR (MZ,IZW,IZP,NZB) = IOR (IZW, IRL (
- + ILS(MZ,36-NZB), 37-IZP-NZB) )
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernhyw/qmhywmx/q_sbit.inc b/src/packlib/kernlib/kerngen/obsolete/kernhyw/qmhywmx/q_sbit.inc
deleted file mode 100644
index 062adbe..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernhyw/qmhywmx/q_sbit.inc
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: q_sbit.inc,v 1.1.1.1 1996/02/15 17:52:55 mclareni Exp $
-*
-* $Log: q_sbit.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:52:55 mclareni
-* Kernlib
-*
-*
-*
-* q_sbit.inc
-*
- MSBIT0 (IZW,IZP) = IAND (IZW, NOT(ILS(1,IZP-1)) )
- MSBIT1 (IZW,IZP) = IOR (IZW, ILS(1,IZP-1) )
- MSBIT (MZ,IZW,IZP) = IOR (IAND (IZW, NOT(ILS(1,IZP-1)) )
- + , ILS(IAND(MZ,1),IZP-1) )
- MSBYT (MZ,IZW,IZP,NZB) = IOR ( IAND (IZW, NOT(
- + ILS (IRL(NOT(0),36-NZB), IZP-1)))
- + , IRL (ILS(MZ,36-NZB), 37-IZP-NZB) )
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernhyw/qmhywmx/q_shift.inc b/src/packlib/kernlib/kerngen/obsolete/kernhyw/qmhywmx/q_shift.inc
deleted file mode 100644
index 56f88c0..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernhyw/qmhywmx/q_shift.inc
+++ /dev/null
@@ -1,13 +0,0 @@
-*
-* $Id: q_shift.inc,v 1.1.1.1 1996/02/15 17:52:55 mclareni Exp $
-*
-* $Log: q_shift.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:52:55 mclareni
-* Kernlib
-*
-*
-*
-* q_shift.inc
-*
- ISHFTL (IZW,NZB) = ILS (IZW, NZB)
- ISHFTR (IZW,NZB) = IRL (IZW, NZB)
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernhyw/qmhywmx/qmhywmx.h b/src/packlib/kernlib/kerngen/obsolete/kernhyw/qmhywmx/qmhywmx.h
deleted file mode 100644
index 46c68c3..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernhyw/qmhywmx/qmhywmx.h
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: qmhywmx.h,v 1.1.1.1 1996/02/15 17:52:56 mclareni Exp $
-*
-* $Log: qmhywmx.h,v $
-* Revision 1.1.1.1 1996/02/15 17:52:56 mclareni
-* Kernlib
-*
-*
-* This directory was created from kernhyw.car patch qmhywmx
-#ifndef CERNLIB_F77
-#define CERNLIB_F77
-#endif
-#ifndef CERNLIB_A4
-#define CERNLIB_A4
-#endif
-#ifndef CERNLIB_B36
-#define CERNLIB_B36
-#endif
-#ifndef CERNLIB_B36M
-#define CERNLIB_B36M
-#endif
-* In-line AND / OR
-#ifndef CERNLIB_QANDORINL
-#define CERNLIB_QANDORINL
-#endif
-* In-line SHIFT L/R
-#ifndef CERNLIB_QSHIFTINL
-#define CERNLIB_QSHIFTINL
-#endif
-#ifndef CERNLIB_QSHICOINL
-#define CERNLIB_QSHICOINL
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernhyw/tieee/tdouble.F b/src/packlib/kernlib/kerngen/obsolete/kernhyw/tieee/tdouble.F
deleted file mode 100644
index ca6e31b..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernhyw/tieee/tdouble.F
+++ /dev/null
@@ -1,100 +0,0 @@
-*
-* $Id: tdouble.F,v 1.1.1.1 1996/02/15 17:52:58 mclareni Exp $
-*
-* $Log: tdouble.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:58 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- PROGRAM TIEEED
-
- PARAMETER (NWDP=12)
- PARAMETER (NVEC=2*NWDP)
- PARAMETER (NWUSE=NVEC)
- DOUBLE PRECISION DPOR(NWDP), DPEE(NWDP), DPRE(NWDP)
- DIMENSION VOR(NVEC), VEE(NVEC), VRE(NVEC)
- DIMENSION KOR(NVEC), KEE(NVEC), KRE(NVEC)
- DIMENSION MORLH(60), MEELH(60), MRELH(60)
- DIMENSION MORRH(60), MEERH(60), MRERH(60)
- EQUIVALENCE (DPOR,VOR,KOR), (DPEE,VEE,KEE), (DPRE,VRE,KRE)
-
- EQUIVALENCE (IWORLH,WORLH), (IWEELH,WEELH), (IWRELH,WRELH)
- EQUIVALENCE (IWORRH,WORRH), (IWEERH,WEERH), (IWRERH,WRERH)
-
- CALL VZERO (VOR,NVEC)
-
- DPOR(1) = 1.
- DPOR(2) = -1.D0
- DPOR(3) = 2.
- DPOR(4) = 4.
- DPOR(5) = 8.
- DPOR(6) = 16.
- DPOR(7) = 32.
- DPOR(8) = DPOR(1) + DPOR(1) * 2.**(-45)
- DPOR(9) = DPOR(1) + DPOR(2) * 2.**(-45)
- DPOR(10) = DPOR(3) + DPOR(1) * 2.**(-50)
- DPOR(11) = DPOR(4) + DPOR(2) * 2.**(-50)
- DPOR(12) = DPOR(1) - DPOR(6)
-
-C- test exponent at upper limit
-
-C- test exponent at lower limit
-
-C- test special cases
-
- CALL IE3FOD (VOR,VEE,NWUSE/2,JBAD)
- PRINT 9001, JBAD
- 9001 FORMAT ('1PROGRAM TIEEEF EXECUTING.'/1X
- +/' DONE TO IEEE, JBAD=',I6)
-
- CALL IE3TOD (VEE,VRE,NWUSE/2,JBAD)
- PRINT 9002, JBAD
- 9002 FORMAT (1X/' DONE FR IEEE, JBAD=',I6)
-
- DO 79 JL=1,NWUSE,2
- WORLH = VOR(JL)
- WEELH = VEE(JL)
- WRELH = VRE(JL)
-
- WORRH = VOR(JL+1)
- WEERH = VEE(JL+1)
- WRERH = VRE(JL+1)
-
- IFLLH = 0
- IF (IWORLH.NE.IWRELH) IFLLH=7777
-
- IFLRH = 0
- IF (IWORRH.NE.IWRERH) IFLRH=77777
-
- PRINT 9021, JL,WORLH,WRELH,WORLH,WRELH,IFLLH,WORRH,WRERH,IFLRH
- 9021 FORMAT (1X/1X,20(1H-)/' WORD',I3,2E18.10/2(8X,2O18,2X,I3/),1X)
-
- CALL UPKBYT (WORLH,1,MORLH,36,0)
- CALL UPKBYT (WEELH,1,MEELH,32,0)
- CALL UPKBYT (WRELH,1,MRELH,36,0)
-
- CALL UPKBYT (WORRH,1,MORRH,36,0)
- CALL UPKBYT (WEERH,1,MEERH,32,0)
- CALL UPKBYT (WRERH,1,MRERH,36,0)
-
- JEXO = JBYT (WOR,28,9)
- IF (JEXO.GE.128) JEXO=JEXO-256
-
- JEXR = JBYT (WRE,28,9)
- IF (JEXR.GE.128) JEXR=JEXR-256
-
- JEXE = JBYT (WEELH,21,11) - 1023
-
- PRINT 9041, JEXE,(MEELH(J),J=32,1,-1),(MEERH(J),J=32,1,-1)
- 9041 FORMAT (' E EXP=',I5,5X, 9I1, 3X,20I1, 1X,32I1,1X,5I1)
-
- PRINT 9043, JEXO,(MORLH(J),J=36,1,-1), (MORRH(J),J=36, 1,-1)
- 9043 FORMAT (' O EXP=',I5,6X, 8I1, 1X,I1, 1X,27I1, 1X,25I1, 1X,14I1)
-
- PRINT 9044, JEXR,(MRELH(J),J=36,1,-1), (MRERH(J),J=36, 1,-1)
- 9044 FORMAT (' R EXP=',I5,6X, 8I1, 1X,I1, 1X,27I1, 1X,25I1, 1X,14I1)
-
- 79 CONTINUE
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernhyw/tieee/tsingle.F b/src/packlib/kernlib/kerngen/obsolete/kernhyw/tieee/tsingle.F
deleted file mode 100644
index 290b3d2..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernhyw/tieee/tsingle.F
+++ /dev/null
@@ -1,101 +0,0 @@
-*
-* $Id: tsingle.F,v 1.1.1.1 1996/02/15 17:52:58 mclareni Exp $
-*
-* $Log: tsingle.F,v $
-* Revision 1.1.1.1 1996/02/15 17:52:58 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- PROGRAM TIEEES
-
- PARAMETER (NVEC=44)
-
-C- original IEEE read-back
- DIMENSION VOR(NVEC), VEE(NVEC), VRE(NVEC)
- DIMENSION KOR(NVEC), KEE(NVEC), KRE(NVEC)
- DIMENSION MOR(60), MEE(60), MRE(60)
- EQUIVALENCE (KOR,VOR), (KEE,VEE), (KRE,VRE)
- EQUIVALENCE (WOR,IWOR), (WRE,IWRE)
-
- DIMENSION GRA(10)
- EQUIVALENCE (VOR(1),GRA(1))
- DIMENSION GROVF(10)
- EQUIVALENCE (VOR(11),GROVF(1))
- DIMENSION GRDEN(20)
- EQUIVALENCE (VOR(21),GRDEN(1))
- DIMENSION GRSPE(4)
- EQUIVALENCE (VOR(41),GRSPE(1))
-
- DATA GRA / 1.,-1., 2., 4., 8., 16.,-16., 0., 12345.,-12345. /
-
-C- test special cases
- DATA GRSPE(1) / O'376777777776' /
- DATA GRSPE(2) / O'376777777777' /
- DATA GRSPE(3) / O'377000000000' /
- DATA GRSPE(4) / O'400000000000' /
-
-C- test exponent at upper limit
-
- GROVF(1) = 7. * 2.**24
- GROVF(1) = GROVF(1) * 2.**100
- GROVF(2) = -GROVF(1)
-
- DO 16 J=3,9,2
- GROVF(J) = GROVF(J-2) / 2.
- 16 GROVF(J+1) = -GROVF(J)
-
-C- test exponent at lower limit
-
- GRDEN(1) = 7. * 2.**(-124)
- GRDEN(2) = - GRDEN(1)
-
- DO 17 J=3,19,2
- GRDEN(J) = GRDEN(J-2) / 2.
- 17 GRDEN(J+1) = -GRDEN(J)
-
- CALL IE3FOS (VOR,VEE,NVEC,JBAD)
- PRINT 9001, JBAD
- 9001 FORMAT ('1PROGRAM TIEEEF EXECUTING.'/1X
- +/' DONE TO IEEE, JBAD=',I6)
-
- CALL IE3TOS (VEE,VRE,NVEC,JBAD)
- PRINT 9002, JBAD
- 9002 FORMAT (1X/' DONE FR IEEE, JBAD=',I6)
-
- DO 79 JL=1,NVEC
- WOR = VOR(JL)
- WEE = VEE(JL)
- WRE = VRE(JL)
-
- JFL = 0
- IF (IWOR.NE.IWRE) JFL=77777
-
- PRINT 9021, JL,WOR,WRE,WOR,WRE,JFL
- 9021 FORMAT (1X/1X,20(1H-)/' WORD',I3,2E18.10/8X,2O18,3X,I3/1X)
-
- CALL UPKBYT (WOR,1,MOR,36,0)
- CALL UPKBYT (WEE,1,MEE,32,0)
- CALL UPKBYT (WRE,1,MRE,36,0)
-
- JEXO = JBYT (WOR,28,9)
- IF (JEXO.GE.128) JEXO=JEXO-256
-
- JEXR = JBYT (WRE,28,9)
- IF (JEXR.GE.128) JEXR=JEXR-256
-
- JEXE = JBYT (WEE,24,8) - 127
- JNUL = 0
-
- PRINT 9041, JEXE, (MEE(J),J=32,1,-1)
- 9041 FORMAT (' E EXP=',I5,5X, 9I1, 3X,23I1)
-
- PRINT 9043, JEXO,(MOR(J),J=36,1,-1)
- 9043 FORMAT (' O EXP=',I5,6X, 8I1, 1X,I1, 1X,23I1, 1X,24I1)
-
- PRINT 9044, JEXR,(MRE(J),J=36,1,-1)
- 9044 FORMAT (' R EXP=',I5,6X, 8I1, 1X,I1, 1X,23I1, 1X,24I1)
-
- 79 CONTINUE
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/_kicernv/pilot.h b/src/packlib/kernlib/kerngen/obsolete/kernibm/_kicernv/pilot.h
deleted file mode 100644
index b591136..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/_kicernv/pilot.h
+++ /dev/null
@@ -1,12 +0,0 @@
-#if 0
-* This pilot patch was created from kernibm.car patch _kicernv
-#endif
-#if 0
-* Pilot Cern IBM, Fort 77, system VM/CMS
-#endif
-#ifndef CERNLIB_SYCERNV
-#define CERNLIB_SYCERNV
-#endif
-#ifndef CERNLIB__KIVM
-#define CERNLIB__KIVM
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/_kimvs/pilot.h b/src/packlib/kernlib/kerngen/obsolete/kernibm/_kimvs/pilot.h
deleted file mode 100644
index a611f3a..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/_kimvs/pilot.h
+++ /dev/null
@@ -1,12 +0,0 @@
-#if 0
-* This pilot patch was created from kernibm.car patch _kimvs
-#endif
-#if 0
-* Pilot IBM, system OS MVS
-#endif
-#ifndef CERNLIB_SYMVS
-#define CERNLIB_SYMVS
-#endif
-#ifndef CERNLIB__KIOS
-#define CERNLIB__KIOS
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/_kimvsse/pilot.h b/src/packlib/kernlib/kerngen/obsolete/kernibm/_kimvsse/pilot.h
deleted file mode 100644
index 5b3c3ff..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/_kimvsse/pilot.h
+++ /dev/null
@@ -1,12 +0,0 @@
-#if 0
-* This pilot patch was created from kernibm.car patch _kimvsse
-#endif
-#if 0
-* Pilot IBM, system OS MVS/SE
-#endif
-#ifndef CERNLIB_SYMVSSE
-#define CERNLIB_SYMVSSE
-#endif
-#ifndef CERNLIB__KIOS
-#define CERNLIB__KIOS
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/_kimvssp/pilot.h b/src/packlib/kernlib/kerngen/obsolete/kernibm/_kimvssp/pilot.h
deleted file mode 100644
index c62e2d6..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/_kimvssp/pilot.h
+++ /dev/null
@@ -1,12 +0,0 @@
-#if 0
-* This pilot patch was created from kernibm.car patch _kimvssp
-#endif
-#if 0
-* Pilot IBM, system OS MVS/SP
-#endif
-#ifndef CERNLIB_SYMVSSP
-#define CERNLIB_SYMVSSP
-#endif
-#ifndef CERNLIB__KIOS
-#define CERNLIB__KIOS
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/_kimvt/pilot.h b/src/packlib/kernlib/kerngen/obsolete/kernibm/_kimvt/pilot.h
deleted file mode 100644
index ab95cc8..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/_kimvt/pilot.h
+++ /dev/null
@@ -1,12 +0,0 @@
-#if 0
-* This pilot patch was created from kernibm.car patch _kimvt
-#endif
-#if 0
-* Pilot IBM, system OS MVT
-#endif
-#ifndef CERNLIB_SYMVT
-#define CERNLIB_SYMVT
-#endif
-#ifndef CERNLIB__KIOS
-#define CERNLIB__KIOS
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/_kios/pilot.h b/src/packlib/kernlib/kerngen/obsolete/kernibm/_kios/pilot.h
deleted file mode 100644
index e0f3792..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/_kios/pilot.h
+++ /dev/null
@@ -1,42 +0,0 @@
-#if 0
-* This pilot patch was created from kernibm.car patch _kios
-#endif
-#if 0
-* Pilot IBM, system OS
-#endif
-#ifndef CERNLIB_SYOS
-#define CERNLIB_SYOS
-#endif
-#if defined(CERNLIB_SIEMENS)
-#ifndef CERNLIB_QF_SIEM
-#define CERNLIB_QF_SIEM
-#endif
-#endif
-#if !defined(CERNLIB_SIEMENS)
-#ifndef CERNLIB_QF_IBM
-#define CERNLIB_QF_IBM
-#endif
-#endif
-#if defined(CERNLIB_QF_SIEM)
-#ifndef CERNLIB_XVECTSI
-#define CERNLIB_XVECTSI
-#endif
-#endif
-#ifndef CERNLIB_XVECTIBM
-#define CERNLIB_XVECTIBM
-#endif
-#if 0
-* inhibit this if you have only 360 instructions
-#endif
-#ifndef CERNLIB_IBM370
-#define CERNLIB_IBM370
-#endif
-#ifndef CERNLIB_IBM360
-#define CERNLIB_IBM360
-#endif
-#ifndef CERNLIB_XVECT
-#define CERNLIB_XVECT
-#endif
-#ifndef CERNLIB_TCGEN
-#define CERNLIB_TCGEN
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/_kivm/pilot.h b/src/packlib/kernlib/kerngen/obsolete/kernibm/_kivm/pilot.h
deleted file mode 100644
index 7fd79dc..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/_kivm/pilot.h
+++ /dev/null
@@ -1,45 +0,0 @@
-#if 0
-* This pilot patch was created from kernibm.car patch _kivm
-#endif
-#if 0
-* Pilot IBM, system VM/CMS
-#endif
-#ifndef CERNLIB_SYVM
-#define CERNLIB_SYVM
-#endif
-#if defined(CERNLIB_SIEMENS)
-#ifndef CERNLIB_QF_SIEM
-#define CERNLIB_QF_SIEM
-#endif
-#endif
-#if !defined(CERNLIB_SIEMENS)
-#ifndef CERNLIB_QF_IBM
-#define CERNLIB_QF_IBM
-#endif
-#endif
-#if defined(CERNLIB_QF_SIEM)
-#ifndef CERNLIB_XVECTSI
-#define CERNLIB_XVECTSI
-#endif
-#endif
-#ifndef CERNLIB_XVECTIBM
-#define CERNLIB_XVECTIBM
-#endif
-#if 0
-* inhibit this if you have only 360 instructions
-#endif
-#ifndef CERNLIB_IBM370
-#define CERNLIB_IBM370
-#endif
-#ifndef CERNLIB_IBM360
-#define CERNLIB_IBM360
-#endif
-#ifndef CERNLIB_XVECT
-#define CERNLIB_XVECT
-#endif
-#ifndef CERNLIB_TCGEN
-#define CERNLIB_TCGEN
-#endif
-#ifndef CERNLIB_SYCERN_ABEND
-#define CERNLIB_SYCERN_ABEND
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/_kjcern/pilot.h b/src/packlib/kernlib/kerngen/obsolete/kernibm/_kjcern/pilot.h
deleted file mode 100644
index 31a5b47..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/_kjcern/pilot.h
+++ /dev/null
@@ -1,18 +0,0 @@
-#if 0
-* This pilot patch was created from kernibm.car patch _kjcern
-#endif
-#if 0
-* Pilot Cern IBM, Fort 77, system MVS
-#endif
-#ifndef CERNLIB_SIEMENS
-#define CERNLIB_SIEMENS
-#endif
-#ifndef CERNLIB_SYCERNJ
-#define CERNLIB_SYCERNJ
-#endif
-#ifndef CERNLIB_SYCERN
-#define CERNLIB_SYCERN
-#endif
-#ifndef CERNLIB__KIMVSSP
-#define CERNLIB__KIMVSSP
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/history/gibmup1.dat b/src/packlib/kernlib/kerngen/obsolete/kernibm/history/gibmup1.dat
deleted file mode 100644
index efb4ee1..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/history/gibmup1.dat
+++ /dev/null
@@ -1,179 +0,0 @@
-*
-* $Id: gibmup1.dat,v 1.1.1.1 1996/02/15 17:52:59 mclareni Exp $
-*
-* $Log: gibmup1.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:52:59 mclareni
-* Kernlib
-*
-*
-#if !defined(CERNLIB_KERNIBM)
-
- UP-DATE RECORD FOR GENIBM VERSIONS 1.01 TO 1.99
- -----------------------------------------------
-
-
- FIRST RELEASE OF THE GENIBM MINI-PAM : 1-NOV-76
-
----------------------------------------------------------------------
-
-UPDATE 1.02 : 26-FEB-78
---------------------------
-
-Replacing file GENIBM 1.01 761110 18.20
-
-New patches : P= *GIBM370, IBM370
-
-New decks : P=IBM360, D=RANNOR, RNDM, UBITS
-
-Corrections : P=IBM360, D=IUBIN GUARD AGAINST VERY LARGE OVERFLOWS
- D=IUCHAN AVOID MACRO 'REGISTER'
- D=UCOPY2 BUG FIXED
- D=UCOPYN HANDLE INTEGERS, NOT FLOATING
-
----------------------------------------------------------------------
-
-UPDATE 1.03 : 15-JULY-78
---------------------------
-
-Replacing file GENIBM 1.02 780226 12.10
-
-New patches : P= IBMOBSOL OBSOLETE GENSEC ROUTINES
- AFROMI, IOFPAR, MXADD, MXDMA, MXDMAL
-
-New decks : P=IBM360, D=TIMEX
-
-Corrections : P=*GIBM, *GIBM370 ADD +USE, XVECT.
-
- P=IBM370, D=UCOPY370 SYMBOL 'UCOPY' WAS DOUBLE DEFINED
- D=UZERO370 SYMBOL 'UZERO' WAS DOUBLE DEFINED
-
- P=IBM360, D=AFROMI, ..., RANNOR, SORTZV Deleted
- D=INCBYT BUG FIXED
-
----------------------------------------------------------------------
-
-UPDATE 1.04 : 18-DEC-78
--------------------------
-
-Replacing file GENIBM 1.03 780714 19.36
-
-New patches : P= XVECTIBM IBM VERSION OF XIN - ROUTINES
-
-New decks : P=IBM370, D=TIMEX TAKEN OUT OF IBM360
-
- P=IBM360, D=GSHOW PRINTS GENSEC VERSION USED
-
- D=XSETIO RECOVERY OF 'LIST EXCEEDS DATA'
-
-Corrections : P=*GIBM, *GIBM370 ADD +USE, XVECTIBM
-
----------------------------------------------------------------------
-
-UPDATE 1.05 : 5-FEB-79
--------------------------
-
-Replacing file GENIBM 1.04 781218 21.42
-
-Corrections : P=IBM360, D=IUBIN,IUCHAN BRING ROUNDING BY EPSILON
-
----------------------------------------------------------------------
-
-UPDATE 1.06 : 18-MAY-79
--------------------------
-
-Replacing file GENIBM 1.05 790205 21.24
-
-Corrections : P=XVECTIBM DELETE LOGIC CHANGED
-
-New decks : P=XVECTIBM, D=XINBML ML VERSIONS OF XINB, XINBS
- D=XINBSML TO SOLVE THE LENGTH PROBLEM
-
----------------------------------------------------------------------
-
-UPDATE 1.07 : 30-MAY-79
--------------------------
-
-Replacing file GENIBM 1.06 790518 12.56
-
-Corrections : P=XVECTIBM, D=XINBML FORMAL CHANGE TO AVOID
- D=XINBSML PROBLEMS WITH PRELIB
- P=IBM360, D=REENT
-
----------------------------------------------------------------------
-
-UPDATE 1.08 : 27-MAY-80
--------------------------
-
-Replacing file GENIBM 1.07 790530 22.33
-
-Corrections : P=*GIBM + *GIBM370 INHIBIT USE OF D=ACOS IN P=TCGEN
-
-New decks : P=IBM360 D=FREQ ROUTINE ERF WITH ENTRIES ERF/ERFC REMOVED
-
----------------------------------------------------------------------
-
-UPDATE 1.09 : 19-JAN-82
--------------------------
-
-Replacing file GENIBM 1.08 800527 12.23
-
-New decks : P=IBM370, D=VZERO370 VZERO TAKEN OUT FROM UZERO
- P=IBM360, D=ERF TO DELETE FORTRAN ERF
- D=UZERO,VZERO SEPARATED FROM UFILL,VFILL
- D=FLOARG,INTARG NEW ROUTINES FOR KERNLIB
-
-Deleted : P=IBM360, D=FREQ FORTRAN FREQ CAN NOW BE USED
-
-Corrections : P=*GIBM370 +USE,QMIBM ADDED
- P=XVECTIBM, D=XINCF REMOVE TAGS
- P=IBM370, D=UZERO370 ENTRIES VZERO/VBLANK REMOVED
- P=IBM360, D=IUBACK,IULOOK,ULEFT HANDLING OF /SLATE/
- D=LOCF ENTRY XLOC REMOVED
- D=MATIN1 NEW VERSION
- D=RNDM NEW VERSION
- D=UBITS ENTRY TUBITS REMOVED
- D=UFILL,VFILL ENTRIES UZERO,VZERO REMOVED
-
-GETTING READY FOR KERNLIB
----------------------------------------------------------------------
-
-UPDATE 1.10 : 1-FEB-82
--------------------------
-
-Replacing file GENIBM 1.09 820120 10.44
-
-TRANSLATE BY PROGRAM FOR KERNLIB
-
----------------------------------------------------------------------
-
-UPDATE 1.11 : 28-MAR-82
--------------------------
-
-Replacing file GENIBM 1.10 820201 21.10
-
-New patches : *KI... KERN IBM PILOTS
-
-New deck : D=XOUTCF, P=XVECTIBM
-
-Correction : D=XINCF, P=XVECTIBM FORMAT FOR LONG RECORDS
-
-NEW ORDINARY KERNLIB ROUTINES : BLOW, BUNCH
-
-NEW SYSTEM ROUTINES FOR KERNLIB : ABEND, ABUSER, LINEPG, FIO999,
- GOPARM, JOBNAM, NOARG
-
----------------------------------------------------------------------
-
-UPDATE 1.12 : 29-MAR-82
--------------------------
-
-Replacing file GENIBM 1.11 820328 18.40
-
-TIDY UP COMMENTS AND PILOTS FOR KERNLIB
-
----------------------------------------------------------------------
-
- KERNIBM 2.00 = GENIBM 1.12
-
----------------------------------------------------------------------
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/history/history.dat b/src/packlib/kernlib/kerngen/obsolete/kernibm/history/history.dat
deleted file mode 100644
index e8e1582..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/history/history.dat
+++ /dev/null
@@ -1,95 +0,0 @@
-*
-* $Id: history.dat,v 1.1.1.1 1996/02/15 17:52:59 mclareni Exp $
-*
-* $Log: history.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:52:59 mclareni
-* Kernlib
-*
-*
-* This directory was created from kernibm.car patch kernibm
-#if !defined(CERNLIB_KERNIBM)
-
- KERNLIB routines in machine language or otherwise special
- for IBM 360/370
-
- The specific material for system VM/CMS if found
- the separate Pam file KERNCMS
-
----------------------------------------------------------------------
-
- This file contains the following Patches :
-
-PILOT PATCHES
--------------
-
-*KJCERN Kern IBM pilot for system OS at CERN with Siemens compiler
-
-*KICERNV Kern IBM pilot for system VM at CERN with VSFORT compiler
-
-*KICERN Kern IBM pilot for system OS at CERN, Fortran 4
-
-
-*KIMVSSP Kern IBM pilot for system OS mvs/sp
-
-*KIMVSSE Kern IBM pilot for system OS mvs/se
-
-*KIMVS Kern IBM pilot for system OS mvs
-
-*KIMVT Kern IBM pilot for system OS mvt
-
-*KIOS Kern IBM pilot for system OS
-
-*KIVM Kern IBM pilot for system VM/CMS
-
-OTHER PATCHES
--------------
-
-QF_IBM using the VSFORT compiler
-
-QF_SIEM using the SIEMENS compiler
-
-QMIBMXA option : system VM /XA
-
-QMIBMVF option : using the Vector Facility
-
-QCMS4 option : system CMS version 4 or earlier
-
-XVECTSI Siemens versions of routines of P=XVECT
-XVECTIBM IBM versions of routines of P=XVECT
-
-IBM370 Routines taking advantage of special /370 features
- Give +USE,IBM370,T=INH. if hardware not available
-
-IBM360 IBM specific normal routines
-
-SYCERNV System routines for system VM at CERN only
-
-SYVM System routines for system VM
-
-SYCERNJ System routines for Siemens compiler at CERN only
-
-SYCERN System routines for use at CERN only
-
-SYMVSSP System routines for system OS mvs/sp
-
-SYMVSSE System routines for system OS mvs/se
-
-SYMVS System routines for system OS mvs
-
-SYMVT System routines for system OS mvt
-
-SYOS System routines for system OS
-
-SYVMOS System routines for both VM or OS
-
-PRELIB Library creation program
-
-OPTION PATCHES
---------------
-
-IBM370 See above
-
-SIEMENS Siemens compiler, not VSFORT
-
-=====================================================================
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/history/previous.dat b/src/packlib/kernlib/kerngen/obsolete/kernibm/history/previous.dat
deleted file mode 100644
index 0352d2a..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/history/previous.dat
+++ /dev/null
@@ -1,415 +0,0 @@
-*
-* $Id: previous.dat,v 1.1.1.1 1996/02/15 17:52:59 mclareni Exp $
-*
-* $Log: previous.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:52:59 mclareni
-* Kernlib
-*
-*
-#if !defined(CERNLIB_KERNIBM)
-
-UP-DATE 2.34 : 9-Feb-1993
-----------------------------
-
-Replacing file KERNIBM 2.33 920302 22.09
-
-Correct: add definition +KEEP, Q$SBYT
- P=QMIBMVF, D=RANECU correct bug for vectors
-
----------------------------------------------------------------------
-
-UP-DATE 2.33 : 29-Feb-1992
-----------------------------
-
-Replacing file KERNIBM 2.32 910719 13.02
-
-Correct : SLEEPF to be a subroutine, not function
-
----------------------------------------------------------------------
-
-UP-DATE 2.32 : 18-Jul-1991
-----------------------------
-
-Replacing file KERNIBM 2.31 901108 8.45
-
-Change patch names : QMIBMSI --> QMIBMFSI Fortran Siemens
- QMIBMVS --> QMIBMFVS Fortran VS
-
-New decks : SLEEPF, DELAY for MVS
-
-Correct : P=SYOS, D=REENT to run above the line
-
----------------------------------------------------------------------
-
-UP-DATE 2.31 : 5-Nov-1990
-----------------------------
-
-Replacing file KERNIBM 2.30 900508 21.00
-
-New decks : TIMEXXA new version of TIMEX for XA
-
-Correct : P=IBM360, D=IE3FOS
- P=QMIBMVF, D=RANECU
-
-Change : all pilots select F77
-
----------------------------------------------------------------------
-
-UP-DATE 2.30 : 8-May-1990
-----------------------------
-
-Replacing file KERNIBM 2.28 891004 17.45
-
-New decks : VCLOCQ,VCLOC in P=QMIBMVF. Elapsed, CPU and Vector time
-
-Correct : UBUNCH in P=QMIBMVF
-
----------------------------------------------------------------------
-
-UP-DATE 2.29 : 20-Nov-1989
-----------------------------
-
-Replacing file KERNIBM 2.28 891004 17.45
-
-New decks : LOCB return the byte adr of a variable
-
----------------------------------------------------------------------
-
-UP-DATE 2.28 : 4-Oct-1989
-----------------------------
-
-Replacing file KERNIBM 2.27 890628 18.34
-
-New : TRACEQ trace-back routine calling ERRTRA
- UBUNCH in P=QMIBMVF UBUNCH + UBLOW, vector version
-
-Correct : DATIME to return seconds in /SLATE/
- JUMPX2 add entries JUMPX1 and JUMPX0
-
----------------------------------------------------------------------
-
-UP-DATE 2.27 : 28-June-1989
-----------------------------
-
-Replacing file KERNIBM 2.26 890316 17.13
-
-New : P=QMIBMVF material using the Vector Facility
- P=XVECTSI moving XINB, XINBS for Siemens to here
-
-Correct : XINB, XINBF, XINBS of P=XVECTIBM
- change to use the NUM= parameter in
- the READ statements, so XSETIO is no
- longer needed
-
- remove the SPLEVEL directives for XA
- change AMODE 31 to AMODE ANY for XA
- there are now new DATIME/DATIMH on KERNCMS
-
-Delete : XINBML, XINBSML of P=XVECTIBM
- reading is now pure Fortran for VS
-
----------------------------------------------------------------------
-
-UP-DATE 2.26 : 16-Mar-1989
-----------------------------
-
-Replacing file KERNIBM 2.25 881103 12.43
-
-Move the material of P=SYCERNV and P=SYVM to the new file KERNCMS
-
-New : P=QMIBMVF for the Vector Facility
- KERNGT to eventually replace GSHOW
-
-Change : P=*KICERNV remove +USE, QCMS4
-
-Correct : P=IBM360, D=IE3xxx new versions
- P=IBM360, D=IUBACK, IULOOK correct for /XA
-
----------------------------------------------------------------------
-
-UP-DATE 2.25 : 3-Nov-1988
-----------------------------
-
-Replacing file KERNIBM 2.24 880905 16.00
-
-Correct : P=SYVM, D=ABUSER new version
- P=SYVM, D=INTRAC new version
- P=SYVM, D=VMBEEP new version
-
-Delete : P=SYCERNV, D=INTRAC
-
-Change : P=*KICERNV add +USE, QCMS4
- P=*KIVM add +USE, SYCERN, D=ABEND.
-
----------------------------------------------------------------------
-
-UP-DATE 2.24 : 9-AUG-1988
-----------------------------
-
-Replacing file KERNIBM 2.23 880425 20.54
-
-Correct : P=SYOS, D=NOARG. delete dummy in TCGEN
- P=SYVM, D=VMREXX
-
-New Decks : P=SYVM, D=ABUSER
-
-New feature: option patch QMIBMXA to select controls for XA
-
----------------------------------------------------------------------
-
-UP-DATE 2.23 : 25-APR-1988
-----------------------------
-
-Replacing file KERNIBM 2.22 870922 23.17
-
-Correct : P=SYVM, D=GOPARM,VMREXX,VMRTRM update
-
-New Decks : P=SYVMOS, D=JUMPAD, JUMPX2
-
----------------------------------------------------------------------
-
-UP-DATE 2.22 : 22-SEP-1987
-----------------------------
-
-Replacing file KERNIBM 2.21 870703 12.00
-
-Correct : P=IBM360, D=IBITS bug fixed
- P=SYVM, D=GOPARM update for VS Fortran 2
-
-New Decks : P=SYVM, D=VMRTRM read a line from the terminal
-
-New Patch : P=PRELIB Library creation program
-
----------------------------------------------------------------------
-
-UP-DATE 2.21 : 3-JULY-1987
-----------------------------
-
-Replacing file KERNIBM 2.20 870601 15.31
-
-Correct : routine JOB$VM in P=SYCERNV upgraded for CP release 4 :
- D=JOB$VM contains now the routine for CP V4
- D=JOB$VM3 is the old routine for CP V3
- this is inhibited from D=JOB$VM
-
----------------------------------------------------------------------
-
-UP-DATE 2.20 : 1-JUNE-1987
-----------------------------
-
-Replacing file KERNIBM 2.19 861204 21.06
-
-New Patches : P=QMIBMVS, QMIBMSI, QMIBM4
-
-New Decks : P=IBM360, D=BITPOS, IANDETC, IBITS
-
-Correct : P=SYVM,D=IOSPACK,C=120. bug fixed
- P=IBM360,D=IE3FOD,IE3FOD use the new shift functions
-
-Modify the Pilot patches to select the right QMIBMx
-
----------------------------------------------------------------------
-
-UP-DATE 2.19 : 4-DEC-1986
-----------------------------
-
-Replacing file KERNIBM 2.18 860514 16.05
-
-New decks : P=IBM360, D=IE3FOS, IE3TOS, IE3FOD, IE3TOD
- P=SYVM, D=VMBEEP, VMSATN
-
----------------------------------------------------------------------
-
-UP-DATE 2.18 : 14-MAY-1986
-----------------------------
-
-Replacing file KERNIBM 2.17 860303 18.31
-
-New deck : P=SYVM, D=IOSPACK
-
----------------------------------------------------------------------
-
-UP-DATE 2.17 : 31-JAN-1986 (RE-DONE 3-MAR-86)
-----------------------------
-
-Replacing file KERNIBM 2.16 860113 13.03
-
-Corrections : P=SYCERNV, D=JOBNAM FIX SIZE OF BATLST
- P=SYCERNV, D=INTRAC FIX BUG
- P=SYVM, D=VMCMS NEW VERSION 2.00
-
----------------------------------------------------------------------
-
-UP-DATE 2.16 : 13-JAN-1986
-----------------------------
-
-Replacing file KERNIBM 2.15 851212 20.26
-
-Corrections : P=XVECTIBM, D=XINBMLJ,XINBSMLJ FIX FAULTY USE T=INH.
-
----------------------------------------------------------------------
-
-UP-DATE 2.15 : 12-DEC-1985
-----------------------------
-
-Replacing file KERNIBM 2.14 851016 20.24
-
-New patch : P=*KICERNV CERN PILOT FOR VM/CMS
-
-New decks : P=XVECTIBM, D=XINBMLJ,XINBSMLJ FOR SIEMENS ONLY, UNTIL
- TRACE-BACK BUG FIXED
- P=SYVM, D=VMCMS, VMREXX
-
-Corrections : P=IBM360, D=UBITS FASTER CODE
- P=SYVM, D=GOPARM HOPEFULLY NOW WORKING
-
----------------------------------------------------------------------
-
-UP-DATE 2.14 : 16-OCT-1985
-----------------------------
-
-Replacing file KERNIBM 2.13 850702 21.42
-
-New decks : P=IBM360, D= MBYTET, MBYTOR, MCBYT
- D= MSBIT, MSBIT0, MSBIT1, MSBYT.
-
----------------------------------------------------------------------
-
-UP-DATE 2.13 : 2-JULY-1985
-----------------------------
-
-Replacing file KERNIBM 2.12 850529 14.37
-
-Corrections : P=SYCERNV, D=JOB$VM, TIMEX
-
----------------------------------------------------------------------
-
-UP-DATE 2.12 : 29-MAY-1985
-----------------------------
-
-Replacing file KERNIBM 2.11 850320 20.50
-
-Corrections : P=SYCERNV, D=TIMEX
- P=SYCERN, D=LINEPG
-
----------------------------------------------------------------------
-
-UP-DATE 2.11 : 20-MAR-1985
-----------------------------
-
-Replacing file KERNIBM 2.10 840827 16.03
-
-New patches : P=*KJCERNV NEW PILOT
- P=SYCERNV VM SYSTEM ROUTINES FOR CERN
-
-New decks : P=SYVM, D=INTRAC, GOPARM
- P=SYOS, D=INTRAC
-
-Corrections : P=IBM360, D=MXMAD GET TRACE-BACK ON FAILURE
- P=SYVM, D=TIMEX
- P=SYCERNJ, D=ABUSER
-
-Deleted : P=SYCERNJ, D=FTRECL
-
----------------------------------------------------------------------
-
-UP-DATE 2.10 : 27-AUG-1984
-----------------------------
-
-Replacing file KERNIBM 2.09 840710 16.49
-
-New deck : P=SYVMOS, D=QNEXTE FOR 'NEXT EVENT'
-
----------------------------------------------------------------------
-
-UP-DATE 2.09 : 10-JUL-1984
-----------------------------
-
-Replacing file KERNIBM 2.08 840706 14.31
-
-New patch : P=*KJCERN NEW PILOT FOR CERN FORTRAN 77
-Correction : P=SYCERNJ, D=ABUSER ONE MORE FIX
-
----------------------------------------------------------------------
-
-UP-DATE 2.08 : 6-JUL-1984
-----------------------------
-
-Replacing file KERNIBM 2.07 831205 22.16
-
-Correction : P=SYCERNJ, D=ABUSER FIX FOR CHANGE IN FORTRAN LIB
-
----------------------------------------------------------------------
-
-UP-DATE 2.07 : 5-DEC-1983
-----------------------------
-
-Replacing file KERNIBM 2.06 830901 17.40
-
-New decks : P=IBM360,D=UHTOC,UH1TOC NEW ML ROUTINES
-
----------------------------------------------------------------------
-
-UP-DATE 2.06 : 1-SEP-1983
-----------------------------
-
-Replacing file KERNIBM 2.05 830421 18.45
-
-New decks : P=SYVM,D=TIMEX. NEW ML ROUTINES
-
-Modified : P=IBM360,D=INTARG,FLOARG. FORTRAN REPLACED BY BETTER ML
-
----------------------------------------------------------------------
-
-UP-DATE 2.05 : 21-APR-1983
-----------------------------
-
-Replacing file KERNIBM 2.04 830202 15.21
-
-New patches : P=*KIVM, SYVM, SYVMOS FOR SYSTEM VM/CMS
-
-New decks : P=IBM360,D=PKBYT,UPKBYT NEW ML ROUTINES
-
----------------------------------------------------------------------
-
-UP-DATE 2.04 : 2-FEB-1983
-----------------------------
-
-Replacing file KERNIBM 2.03 821124 22.08
-
-New patch : P=SYCERNJ CERN SYSTEM ROUTINES
- WITH SIEMENS COMPILER
-Modified : P=IBM360, D=UBITS TO BE FASTER
-
----------------------------------------------------------------------
-
-UP-DATE 2.03 : 24-NOV-1982
-----------------------------
-
-Replacing file KERNIBM 2.02 821007 16.31
-
-Modified : D=ABEND, REENT ADD +USE,...,T=INH
-
-Deleted : DUMMY D=ERF
-
----------------------------------------------------------------------
-
-UP-DATE 2.02 : 7-OCT-1982
-----------------------------
-
-Replacing file KERNIBM 2.01 820801 12.00
-
-Modified : D=LOCF, TIMEX ADD +USE,...,T=INH
-
----------------------------------------------------------------------
-
-UP-DATE 2.01 : 26-JUL-1982
-----------------------------
-
-Replacing file KERNIBM 2.00 820401 12.00
-
-Modified : P=IBM360, D=FLOARG,INTARG TO BE FAST AND DIRTY
-
----------------------------------------------------------------------
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/history/update.dat b/src/packlib/kernlib/kerngen/obsolete/kernibm/history/update.dat
deleted file mode 100644
index 7e92fe7..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/history/update.dat
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: update.dat,v 1.1.1.1 1996/02/15 17:52:59 mclareni Exp $
-*
-* $Log: update.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:52:59 mclareni
-* Kernlib
-*
-*
-#if !defined(CERNLIB_KERNIBM)
-
-
- UP-DATE RECORD FOR THE PAM-FILE KERNIBM, VERSION 2
- ---------------------------------------------------
-
-
-UP-DATE 2.35 : 24-Feb-1994
-----------------------------
-
-Replacing file KERNIBM 2.34 930209 23.37
-
-Standardize: QMIBMFVS -> QF_IBM VS compiler
- QMIBMFSI -> QF_SIEM Siemens compiler
-
-Correct: delete usage of Fortran 4, remove the F77 flag
-
-Delete: P=*KICERN, P=QMIBM4
- P=SYOS, D=FIO999
-
----------------------------------------------------------------------
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/bitpos.s b/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/bitpos.s
deleted file mode 100644
index 3e704e1..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/bitpos.s
+++ /dev/null
@@ -1,107 +0,0 @@
-*
-* $Id: bitpos.s,v 1.1.1.1 1996/02/15 17:53:10 mclareni Exp $
-*
-* $Log: bitpos.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:10 mclareni
-* Kernlib
-*
-*
-BITPOS CSECT
-*
-* CERN PROGLIB# M508 BITPOS .VERSION KERNIBM 2.20 870601
-* ORIG. OCT 81, R.MATTHEWS
-*
-* CALL BITPOS (STRING,LENGTH,LOCS,NUMBER)
-*
-* FUNCTION: EXAMINE A STRING OF BITS AND STORE THE LOCATIONS OF
-* THE BITS HAVING THE VALUE 1 IN SUCCESSIVE WORDS OF
-* AN ARRAY.
-*
-* ARGUMENTS: STRING - AN ARRAY OF FULLWORDS CONTAINING THE BIT STRING
-*
-* LENGTH - THE NUMBER OF BITS IN THE BIT STRING
-*
-* LOCS - AN INTEGER*4 ARRAY TO RECEIVE THE LOCATIONS
-* OF THE BITS WHOSE VALUE IS 1
-*
-* NUMBER - THE NUMBER OF BITS FOUND TO HAVE THE VALUE 1
-*
-#if defined(CERNLIB_QMIBMXA)
-* SPLEVEL SET=2
-BITPOS AMODE ANY
-BITPOS RMODE ANY
-#endif
-R0 EQU 0
-R1 EQU 1
-R2 EQU 2
-R3 EQU 3
-R4 EQU 4
-R5 EQU 5
-R6 EQU 6
-R7 EQU 7
-R8 EQU 8
-R9 EQU 9
-R10 EQU 10
-R11 EQU 11
-R12 EQU 12
-R13 EQU 13
-R14 EQU 14
-R15 EQU 15
-*
- PRINT NOGEN
-*
-* P R O L O G U E
-*
- USING BITPOS,R15
- B SAVEREGS
- DC AL1(7),CL7'BITPOS' IDENTIFIER
- DC C'1.00' VERSION.MODIFICATION LEVEL
-SAVEREGS STM R14,R12,12(R13)
- LR R4,R13
- CNOP 0,4
- BAL R13,AROUNDSA
-SAVEAREA DC A(EPILOGUE),17F'0'
- DROP R15
- USING SAVEAREA,R13
-AROUNDSA ST R13,8(0,R4)
- ST R4,4(0,R13)
- XC 8(4,R13),8(R13)
-*
- LM R9,R12,0(R1) R9 -> STRING, R10 -> LENGTH,
-* R11 -> LOCS, R12 -> NUMBER
- LA R2,1 R2 := 1 (LOOP INCREMENT)
- L R3,0(0,R10) R3 := LENGTH (LOOP COMPARAND)
- SR R3,R2
- SR R4,R4 R4 := 0 (LOOP COUNTER)
- SR R5,R5 R5 := 0 (INDEX FOR LOCS)
-*
-NEWORD L R6,0(0,R9) R6 := NEW WORD OF STRING
- LA R9,4(0,R9) R9 -> NEXT WORD OF STRING
- LA R8,32 PRIME THE COUNTER
-TESTBIT SR R8,R2 R8 := NUMBER OF BITS UNTESTED IN WORD
- SRDL R6,1 SHIFT LEAST SIGNIFICANT BIT OF R6 INTO R7
- LTR R7,R7 IS IT 1 ?
- BNM TESTWORD NO, BRANCH
- ST R4,0(R5,R11) STORE ITS LOCATION IN LOCS
- LA R5,4(0,R5) INCREMENT THE INDEX FOR LOCS
-TESTWORD LTR R6,R6 ARE THERE ANY MORE 1 BITS IN THE WORD ?
- BNZ LOOPEND YES, BRANCH TO PROCESS THEM
- AR R4,R8 OTHERWISE INCREMENT THE LOOP COUNTER BY
- BXLE R4,R2,NEWORD THE NUMBER OF BITS REMAINING UNTESTED
-LOOPEND BXLE R4,R2,TESTBIT AND TEST WHETHER FINISHED
-*
- SRA R5,2 NUMBER = (R5)/4
- ST R5,0(0,R12) STORE NUMBER
-*
-* E P I L O G U E
-*
-EPILOGUE EQU *
- L R13,4(0,R13)
- LM R14,R12,12(R13)
- MVI 12(R13),X'FF'
- BR R14
-*
- END
-#ifdef CERNLIB_TCGEN_BITPOS
-#undef CERNLIB_TCGEN_BITPOS
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/blow.s b/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/blow.s
deleted file mode 100644
index c38a298..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/blow.s
+++ /dev/null
@@ -1,96 +0,0 @@
-*
-* $Id: blow.s,v 1.1.1.1 1996/02/15 17:53:10 mclareni Exp $
-*
-* $Log: blow.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:10 mclareni
-* Kernlib
-*
-*
-BLOW CSECT
-*
-* CERN PROGLIB# Z035 BLOW .VERSION KERNIBM 1.11 820328
-*
-* CALL BLOW (INPUT,OUTPUT,'NBYTES',BITS/'BYTE')
-*
-* MODIFIED JAN 1982 TO IGNORE CALLS WITH ERRONEOUS PARAMETER VALUES
-*
-#if defined(CERNLIB_QMIBMXA)
-* SPLEVEL SET=2
-BLOW AMODE ANY
-BLOW RMODE ANY
-#endif
- USING *,15
- B ROUNDSA
- DC X'07'
- DC CL7'BLOW '
-SAVEAREA DS 18F
-ROUNDSA STM 14,12,12(13)
- LR 12,13
- LA 13,SAVEAREA
- ST 13,8(12)
- ST 12,4(,13)
- USING SAVEAREA,13
- DROP 15
-*
-* REGISTERS
-* 1 INDEX FOR STORE OF OUTPUT
-* 2 INCREMENT
-* 3 COMPARAND NR ENTRIES-1 *4
-* 4 MASK
-* 5 NR BITS LEFT AFTER SHIFT
-* 6 NR BITS/'BYTE'
-* 7 OFFSET OF INPUT
-* 8 ADDRESS OF INPUT
-* 9 ADDRESS OF OUTPUT
-* 10
-* 11 REGS FOR SHIFT
-* 12 TEMPORARY REG
-*
- LM 8,9,0(1) GET ADDRESS OF INPUT & OUTPUT ARRAYS
- L 3,8(1) GET NUMBER OF BYTES
- L 3,0(3)
- L 6,12(1) LOAD NR OF BITS/'BYTE'
- L 6,0(6)
-*
-* TEST FOR VALIDITY OF ARGUMENTS
- LTR 12,3 ZERO NUMBER OF BYTES
- BC 12,END IGNORE AND RETURN
- LTR 12,6 <1 BITS/'BYTE'
- BC 12,END IGNORE AND RETURN
- LA 12,32(0)
- SR 12,6 >31 BITS/'BYTE'
- BC 12,END IGNORE AND RETURN
-*
- S 3,=F'1' SUBTRACT ONE FROM NR OF 'BYTES'
- SLA 3,2(0) MULTIPLY BY 4
- L 5,=X'FFFFFFFF'
- SR 4,4
- SLDL 4,0(6) CONSTRUCT MASK
- LA 2,4(0) SET UP INCREMENT = 4 BYTES = 1 FULL WORD
- LA 1,0(0) ZERO INDEX TO START WITH
- LA 7,0(0) ZERO INPUT OFFSET
- L 11,0(7,8) LOAD FIRST WORD
- LA 5,32(0) SET UP NUMBER OF BITS THAT CAN BE SHIFTED
-LOOP SLDL 10,0(6) SHIFT
- SR 5,6 SUBTRACT NUMBER OF BITS SHIFTED
- BC 4,LOAD BRANCH TO LOAD IF < ZERO
-LOOP2 NR 10,4 MASK
- ST 10,0(1,9) STORE
- BXH 1,2,END BRANCH OUT IF STORE COMPLETE
- B LOOP
-LOAD LPR 12,5 LOAD NUMBER OF BITS TO SHIFT BACK
- SRDL 10,0(12) SHIFT BACK
- LA 7,4(7) LOAD NEW INPUT OFFSET
- L 11,0(7,8) LOAD NEW 11
- A 5,=F'32'
- SLDL 10,0(12) SHIFT AGAIN
- B LOOP2
-END L 13,4(,13)
- LM 2,12,28(13)
- L 14,12(,13)
- MVI 12(13),X'FF'
- BR 14
- END
-#ifdef CERNLIB_TCGEN_BLOW
-#undef CERNLIB_TCGEN_BLOW
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/bunch.s b/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/bunch.s
deleted file mode 100644
index 9237285..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/bunch.s
+++ /dev/null
@@ -1,100 +0,0 @@
-*
-* $Id: bunch.s,v 1.1.1.1 1996/02/15 17:53:11 mclareni Exp $
-*
-* $Log: bunch.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:11 mclareni
-* Kernlib
-*
-*
-BUNCH CSECT
-*
-* CERN PROGLIB# Z035 BUNCH .VERSION KERNIBM 1.11 820328
-*
-* CALL BUNCH( INPUT,OUTPUT,'NBYTES',BITS/'BYTE')
-*
-* MODIFIED JAN 1982 TO IGNORE CALLS WITH ERRONEOUS PARAMETER VALUES
-*
-#if defined(CERNLIB_QMIBMXA)
-* SPLEVEL SET=2
-BUNCH AMODE ANY
-BUNCH RMODE ANY
-#endif
- USING *,15
- B ROUNDSA
- DC X'07'
- DC CL7'BUNCH '
-SAVEAREA DS 18F
-ROUNDSA STM 14,12,12(13)
- LR 12,13
- LA 13,SAVEAREA
- ST 13,8(12)
- ST 12,4(,13)
- USING SAVEAREA,13
- DROP 15
-*
-* REGISTERS
-* 1 INDEX FOR FETCH OF INPUT
-* 2 INCREMENT
-* 3 COMPARAND NR ENTRIES-1 *4
-* 5 NR BITS LEFT AFTER SHIFT
-* 6 NR BITS/'BYTE'
-* 7 OFFSET OF OUTPUT
-* 8 ADDRESS OF OUTPUT
-* 9 ADDRESS OF INPUT
-* 10
-* 11 REGS FOR SHIFT
-* 12 TEMPORARY REG
-*
- L 9,0(1) GET ADDRESS OF OUTPUT & INPUT ARRAYS
- L 8,4(1)
- L 3,8(1) GET NUMBER OF BYTES
- L 3,0(3)
- L 6,12(1) LOAD NR OF BITS/'BYTE'
- L 6,0(6)
-*
-* TEST FOR VALIDITY OF ARGUMENTS
- LTR 12,3 ZERO NUMBER OF BYTES
- BC 12,END IGNORE AND RETURN
- LTR 12,6 <1 BITS/'BYTE'
- BC 12,END IGNORE AND RETURN
- LA 12,32(0)
- SR 12,6 >31 BITS/'BYTE'
- BC 12,END IGNORE AND RETURN
-*
- S 3,=F'1' SUBTRACT ONE FROM NR OF 'BYTES'
- SLA 3,2(0) MULTIPLY BY 4
- LA 2,4(0) SET UP INCREMENT = 4 BYTES = 1 FULL WORD
- LA 1,0(0) ZERO INDEX TO START WITH
- LA 7,0(0) ZERO OUTPUT OFFSET
- LA 5,32(0) SET UP NUMBER OF BITS THAT CAN BE SHIFTED
- SR 10,10 ZERO OUT FIRST UTPUT REG
-LOOP L 11,0(1,9) LOAD A 'BYTE'
- LA 12,32(0) FIGURE OUT HOW MUCH TO SHIFT TO GET RID
- SR 12,6 OF LEADING ZEROES IN 'BYTE'
- SLL 11,0(12) SHIFT
- SR 5,6 CAN BE SHIFTED WITHOUT SPILL
- BC 4,STORE IF NOT GO TO STORE
- SLDL 10,0(6) SHIFT INTO REG 10
-LOOP2 BXH 1,2,END TEST IF ALL DONE
- B LOOP
-STORE LPR 14,5 ABS OF SPILL
- LR 12,6
- SR 12,14 HOW MANY CAN BE SHIFTED WITHOUT SPILL?
- SLDL 10,0(12) SHIFT
- ST 10,0(7,8) STORE PACKED 'BYTES'
- LA 7,4(7) INCREMENT OFFSET FOR STORE
- SR 10,10 ZERO OUT 10
- SLDL 10,0(14) SHIFT REST
- A 5,=F'32' CORRECT NUMBER OF BITS THAT CAN BE SHIFTED
- B LOOP2 WITHOUT SPILL
-END SLDL 10,0(5) SHIFT TO DELETE REMAINING ZEROES
- ST 10,0(7,8) STORE LAST REG 10
- L 13,4(,13)
- LM 2,12,28(13)
- L 14,12(,13)
- MVI 12(13),X'FF'
- BR 14
- END
-#ifdef CERNLIB_TCGEN_BUNCH
-#undef CERNLIB_TCGEN_BUNCH
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/cbyt.s b/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/cbyt.s
deleted file mode 100644
index 83e30a4..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/cbyt.s
+++ /dev/null
@@ -1,70 +0,0 @@
-*
-* $Id: cbyt.s,v 1.1.1.1 1996/02/15 17:53:11 mclareni Exp $
-*
-* $Log: cbyt.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:11 mclareni
-* Kernlib
-*
-*
-CBYT CSECT
-*
-* CERN PROGLIB# M421 CBYT .VERSION KERNIBM 0.1 720321
-*
-#if defined(CERNLIB_QMIBMXA)
-* SPLEVEL SET=2
-CBYT AMODE ANY
-CBYT RMODE ANY
-#endif
- ENTRY CBYT
- BC 15,12(15)
- DC X'07'
- DC CL7'CBYT '
- STM 14,12,12(13)
- LR 11,15
- USING CBYT,11
- ST 13,SA+4
- LR 12,13
- LA 13,SA
- ST 13,8(12)
- L 2,0(1)
- L 2,0(2)
- L 3,4(1)
- L 3,0(3)
- BCTR 3,0
- SRL 2,0(3)
- L 3,8(1)
- L 4,0(3)
- L 5,12(1)
- L 5,0(5)
- BCTR 5,0
- L 6,16(1)
- L 6,0(6)
- LA 7,STOREC
-STOREC STC 2,BYTE
- TM BYTE,X'01'
- BC 8,ZERO
- LA 8,1
- SLL 8,0(5)
- OR 4,8
- B TESTR6
-ZERO L 12,FE
- L 13,FF
- SLDL 12,0(5)
- NR 4,12
-TESTR6 BCT 6,*+8
- B STOREX
- LA 5,1(5)
- SRL 2,1
- BCR 15,7
-STOREX ST 4,0(3)
- L 13,SA+4
- LM 14,12,12(13)
- BCR 15,14
-SA DS 18F
-FF DC X'FFFFFFFF'
-FE DC X'FFFFFFFE'
-BYTE DS C
- END
-#ifdef CERNLIB_TCGEN_CBYT
-#undef CERNLIB_TCGEN_CBYT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/floarg.s b/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/floarg.s
deleted file mode 100644
index 872921f..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/floarg.s
+++ /dev/null
@@ -1,101 +0,0 @@
-*
-* $Id: floarg.s,v 1.1.1.1 1996/02/15 17:53:12 mclareni Exp $
-*
-* $Log: floarg.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:12 mclareni
-* Kernlib
-*
-*
-FLOARG CSECT
-*
-* CERN PROGLIB# M250 FLOARG .VERSION KERNIBM 2.06 830901
-*
-* R. MATTHEWS, CERN/DD, AUGUST 1983.
-*
-#if defined(CERNLIB_QMIBMXA)
-* SPLEVEL SET=2
-FLOARG AMODE ANY
-FLOARG RMODE ANY
-#endif
-R0 EQU 0
-R1 EQU 1
-R2 EQU 2
-R3 EQU 3
-R4 EQU 4
-R5 EQU 5
-R6 EQU 6
-R7 EQU 7
-R8 EQU 8
-R9 EQU 9
-R10 EQU 10
-R11 EQU 11
-R12 EQU 12
-R13 EQU 13
-R14 EQU 14
-R15 EQU 15
-*
-F0 EQU 0
-F2 EQU 2
-F4 EQU 4
-F6 EQU 6
-*
- PRINT NOGEN
-*
-* P R O L O G U E
-*
- USING FLOARG,R15
- B SAVEREGS
- DC AL1(7),CL7'FLOARG' IDENTIFIER
- DC C'1.00' VERSION.MODIFICATION LEVEL
-SAVEREGS STM R14,R12,12(R13)
- LR R4,R13
- CNOP 0,4
- BAL R13,AROUNDSA
-SAVEAREA DC A(EPILOGUE),17F'0'
- DROP R15
- USING SAVEAREA,R13
-AROUNDSA ST R13,8(0,R4)
- ST R4,4(0,R13)
- XC 8(4,R13),8(R13)
-*
- L R2,0(0,R1) R2 -> ARGUMENT
- LE F0,0(0,R2) F0 := ARGUMENT
- L R3,0(0,R2) R3 := ARGUMENT
- TM 0(R2),X'80' IS THE SIGN BIT ON ?
- BO NEGATIVE YES, BRANCH
-*
- TM 0(R2),X'7F' IS THE ARGUMENT FLOATING POINT ?
- BNZ EPILOGUE PROBABLY, RETURN
-*
- L R2,=X'4E000000' R2 := CHARACTERISTIC
- STM R2,R3,FPNUM STORE THE UNNORMALIZED NUMBER
- LD F0,FPNUM F0 := UNNORMALIZED NUMBER
- AD F0,=D'0.0' NORMALIZE IT
- B EPILOGUE RETURN
-*
-NEGATIVE TM 0(R2),X'7F' IS THE ARGUMENT FLOATING POINT ?
- BNO EPILOGUE PROBABLY, RETURN
-*
- LPR R3,R3 R3 := ABS(ARGUMENT)
- L R2,=X'CE000000' R2 := CHARACTERISTIC
- STM R2,R3,FPNUM STORE THE UNNORMALIZED NUMBER
- LD F0,FPNUM F0 := UNNORMALIZED NUMBER
- AD F0,=D'0.0' NORMALIZE IT
-*
-* E P I L O G U E
-*
-EPILOGUE EQU *
- L R13,4(0,R13)
- LM R14,R12,12(R13)
- MVI 12(R13),X'FF'
- BR R14
-*
-* D A T A A R E A S
-*
-FPNUM DS D
-*
- LTORG
- END
-#ifdef CERNLIB_TCGEN_FLOARG
-#undef CERNLIB_TCGEN_FLOARG
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/gshow.F b/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/gshow.F
deleted file mode 100644
index 0432e7a..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/gshow.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: gshow.F,v 1.1.1.1 1996/02/15 17:53:10 mclareni Exp $
-*
-* $Log: gshow.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:10 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE GSHOW (LUN)
-C
-C CERN PROGLIB# Z001 GSHOW .VERSION KERNIBM 1.04 781218
-C
-C-- STORE PAM TITLE INTO /SLATE/ FOR PRINTING BY GSHOWF
-C
- COMMON /SLATE/ CH(40)
-C
- CALL UBLOW (
- + 40H CPP_TITLE
- +, CH,40)
- CALL GSHOWF (LUN)
- RETURN
- END
-#ifdef CERNLIB_TCGEN_GSHOW
-#undef CERNLIB_TCGEN_GSHOW
-#endif
-#include "TITLE.kernibm"
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/iandetc.F b/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/iandetc.F
deleted file mode 100644
index fcf4ccf..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/iandetc.F
+++ /dev/null
@@ -1,36 +0,0 @@
-*
-* $Id: iandetc.F,v 1.1.1.1 1996/02/15 17:53:12 mclareni Exp $
-*
-* $Log: iandetc.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:12 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
-#if defined(CERNLIB_QF_SIEM)
- FUNCTION IAND (I,J)
-C
-C CERN PROGLIB# M441 IANDETC .VERSION KERNIBM 2.20 870601
-C
-C IBM Fortran 4 versions of functions IAND, IOR, IEOR, NOT
-
- IAND = LAND(I,J)
- RETURN
- END
- FUNCTION IOR (I,J)
-
- IOR = LOR(I,J)
- RETURN
- END
- FUNCTION IEOR (I,J)
-
- IEOR = LXOR(I,J)
- RETURN
- END
- FUNCTION NOT (I)
-
- NOT = LCOMPL(I)
- RETURN
- END
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/ibits.s b/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/ibits.s
deleted file mode 100644
index f78c9a1..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/ibits.s
+++ /dev/null
@@ -1,89 +0,0 @@
-*
-* $Id: ibits.s,v 1.1.1.1 1996/02/15 17:53:12 mclareni Exp $
-*
-* $Log: ibits.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:12 mclareni
-* Kernlib
-*
-*
-IBITS CSECT
-*
-* CERN PROGLIB# M441 BITPAK .VERSION KERNIBM 2.22 870922
-* ORIG. MAY 87, K.M.STORR, CERN/DD
-*
-* FUNCTION IBITS : J=IBITS(I,N,L)
-* is J=ISHFT(ISHFT(I,32-L-N),L-32)
-*
-#if defined(CERNLIB_QMIBMXA)
-* SPLEVEL SET=2
-IBITS AMODE ANY
-IBITS RMODE ANY
-#endif
-R0 EQU 0
-R1 EQU 1
-R2 EQU 2
-R3 EQU 3
-R4 EQU 4
-R5 EQU 5
-R6 EQU 6
-R7 EQU 7
-R8 EQU 8
-R9 EQU 9
-R10 EQU 10
-R11 EQU 11
-R12 EQU 12
-R13 EQU 13
-R14 EQU 14
-R15 EQU 15
- PRINT NOGEN
-*
-* P R O L O G U E
-*
- USING IBITS,R15
- B SAVEREGS
- DC AL1(7),CL7'IBITS' IDENTIFIER
- DC C'1.01' VERSION.MODIFICATION LEVEL
-* VERSION 1.01 CHANGES R2 TO R4 BELOW. 30/07/87, HRR, DD/CERN.
-SAVEREGS STM R14,R4,12(R13)
- LR R4,R13
- CNOP 0,4
- BAL R13,AROUNDSA
-SAVEAREA DC A(EPILOGUE),17F'0'
- DROP R15
- USING SAVEAREA,R13
-AROUNDSA ST R13,8(0,R4)
- ST R4,4(0,R13)
- XC 8(4,R13),8(R13)
-*
- L 2,0(0,1) ADDRESS OF I
- L 0,0(0,2) I
- L 2,4(0,1) ADDRESS OF N
- L 1,8(0,1) ADDRESS OF L
- L 1,0(0,1) L
- ST 1,LENGTH
-*
- A 1,0(0,2) L+N
- LA 2,32
- SR 2,1 32-L-N
- SLL 0,0(2) SHIFT OUT UNWANTED LHS BITS
-*
- LA 2,32
- S 2,LENGTH 32-L
- SRL 0,0(2) FINAL RESULT
-*
-* E P I L O G U E
-*
-EPILOGUE EQU *
- L R13,4(0,R13)
- LM R1,R4,24(R13)
- MVI 12(R13),X'FF'
- BR R14
-*
-* D A T A A R E A S
-*
-LENGTH DS F
- LTORG
- END
-#ifdef CERNLIB_TCGEN_IBITS
-#undef CERNLIB_TCGEN_IBITS
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/ie3fod.F b/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/ie3fod.F
deleted file mode 100644
index dc04730..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/ie3fod.F
+++ /dev/null
@@ -1,180 +0,0 @@
-*
-* $Id: ie3fod.F,v 1.1.1.1 1996/02/15 17:53:13 mclareni Exp $
-*
-* $Log: ie3fod.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:13 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
-#if defined(CERNLIB_QMIBMVF)
- at PROCESS DIRECTIVE ('*VDIR:') OPT(3) VECTOR
-#endif
- SUBROUTINE IE3FOD (MS,MT,NDPN,JBAD)
-C
-C CERN PROGLIB# M220 IE3FOD .VERSION KERNIBM 2.26 890316
-
-C 02/03/89 M.Roethlisberger/IBM + J.Zoll/CERN Optimise / Vectorise
-C
-C- Convert double precision for output with copy
-C- from source in native to target in IEEE data format
-
-C- Reference: ZEBRA REFERENCE MANUAL book FZ, para. 3.03
-C-
-C- IBM Representation: sccc cccc mmmm mmmm mmmm mmmm mmmm mmmm
-C- mmmm mmmm mmmm mmmm mmmm mmmm mmmm mmmm
-
-C- IEEE Representation: sccc cccc cccc mmmm mmmm mmmm mmmm mmmm
-C- mmmm mmmm mmmm mmmm mmmm mmmm mmmm mmmm
-C-
-C- m: Mant (I3E) = Mant (IBM)/J1 (right-shifting)
-C- and left-most bit discarded (hidden bit)
-
-C- c: Exp (I3E) = 4*(Exp (IBM) - 64) - 1019 + J2
-C- = 4*Exp(IBM) - 763 + J2
-C-
-C- s: Sign (IBM) = Sign (IE3)
-C-
-C- Where J1 and J2 are both function of the 4 left-most bits
-C- of IBM mantissa.
-C-
-C-
- DIMENSION MS(99) , MT(99)
- DIMENSION J1(0:15) , J2(0:15) , J3(0:15)
-
-C PARAMETER (IBADMS = Z 7FFFFFFF)
- PARAMETER (IBADMS = 2147 483 647)
-C PARAMETER (MSKA31 = Z 7FFFFFFF)
- PARAMETER (MSKA31 = 2147 483 647)
-C PARAMETER (MSKA7F = Z 7F000000)
- PARAMETER (MSKA7F = 2130 706 432)
-C PARAMETER (MN2131 = Z 800FFFFF)
- PARAMETER (MN2131 =-2146 435 073)
-C PARAMETER (MSKA24 = Z 00FFFFFF)
- PARAMETER (MSKA24 = 16 777 215)
-C PARAMETER (MSK00F = Z 00F00007)
- PARAMETER (MSK00F = 15 728 640)
-C PARAMETER (IBADCD = Z 7FF01FC0)
- PARAMETER (IBADCD = 2146 443 200)
-C PARAMETER (IOVPCD = Z 7FF00000)
- PARAMETER (IOVPCD = 2146 435 072)
-C PARAMETER (IOVNCD = Z FFF00000)
- PARAMETER (IOVNCD = -1 048 576)
-
- PARAMETER (LVMIN = 38)
-
- DATA (J1 (II),II=0,15) /
-C
-C II= 0000, 0001, 0010, 0011, 0100, 0101, 0110, 0111,
- + 1, 1, 2, 2, 4, 4, 4, 4,
-C
-C II= 1000, 1001, 1010, 1011, 1100, 1101, 1110, 1111,
- + 8, 8, 8, 8, 8, 8, 8, 8/
-
- DATA (J2 (II),II=0,15) /
-C
-C II = 0000, 0001, 0010, 0011,
-C J2 = 00000000, 00000000, 00100000, 00100000,
- + 0, 0, 1 048 576, 1 048 576,
-C
-C II = 0100, 0101, 0110, 0111,
-C J2 = 00200000, 00200000, 00200000, 00200000,
- + 2 097 152, 2 097 152, 2 097 152, 2 097 152,
-C
-C II = 1000, 1001, 1010, 1011,
-C J2 = 00300000, 00300000, 00300000, 00300000,
- + 3 145 728, 3 145 728, 3 145 728, 3 145 728,
-C
-C II = 1100, 1101, 1110, 1111
-C J2 = 00300000, 00300000, 00300000, 00300000,
- + 3 145 728, 3 145 728, 3 145 728, 3 145 728/
-
-
- DATA (J3 (II),II=0,15) /
-C
-C II= 0000, 0001, 0010, 0011, 0100, 0101, 0110, 0111,
- + 8, 8, 4, 4, 2, 2, 2, 2,
-C
-C II= 1000, 1001, 1010, 1011, 1100, 1101, 1110, 1111,
- + 1, 1, 1, 1, 1, 1, 1, 1/
-
-#include "q_andor.inc"
-#include "q_shift.inc"
-
- JBAD = 0
- NLOOP = 2*NDPN
-
-#if defined(CERNLIB_QMIBMVF)
-C*VDIR: PREFER VECTOR
- IF (NDPN.LT.LVMIN) GO TO 336
-
-C---- Vector loop
-
- DO 334 JL=1,NLOOP,2
-
-C Stores the 4 left-most bits of IBM mantissa
- JMOST = ISHFTR (ISHFTL(MS(JL),8), 28)
-
-C Stores I3E exponent
- JEXP = ISHFTR (IAND(MS(JL),MSKA7F), 2)
- + + J2(JMOST) + 800 063 488
-
-C Stores I3E left part of mantissa
- JMANT = IAND (IAND(MS(JL),MSKA24) / J1(JMOST), MN2131)
-
-C Stores lost bits due to right-shifting
- LOST = IOR (ISHFTL(MS(JL),29), ISHFTL (
- + ISHFTR(MS(JL+1),31), 28) ) * J3(JMOST)
-
-C Concatenates left part of I3E mantissa, exponent and sign
- MT(JL) = IOR ( IOR(JMANT,JEXP),IAND(MS(JL),NOT(MSKA31)))
-
-C Concatenates lost bits and right part of mantissa
- MT(JL+1) = IOR (LOST,IAND (MS(JL+1),MSKA31)/J1(JMOST) )
- 334 CONTINUE
- GO TO 341
-C*VDIR: PREFER SCALAR ON
-#endif
-C---- Scalar loop
-
- 336 DO 339 JL=1,NLOOP,2
- JMOST = ISHFTR (ISHFTL(MS(JL),8), 28)
- JEXP = ISHFTR (IAND(MS(JL),MSKA7F), 2)
- + + J2(JMOST) + 800 063 488
- JMANT = IAND (IAND(MS(JL),MSKA24) / J1(JMOST), MN2131)
- LOST = IOR (ISHFTL(MS(JL),29), ISHFTL (
- + ISHFTR(MS(JL+1),31), 28) ) * J3(JMOST)
- MT(JL) = IOR ( IOR(JMANT,JEXP),IAND(MS(JL),NOT(MSKA31)))
- MT(JL+1) = IOR (LOST,IAND (MS(JL+1),MSKA31)/J1(JMOST) )
- 339 CONTINUE
-
-C---- Second loop for exceptions handling
-
- 341 DO 349 JL=1,NLOOP,2
- IF (IAND (MS(JL),MSK00F).EQ.0) THEN
-C Floating point zero/underflow
- MT(JL ) = 0
- MT(JL+1) = 0
- GO TO 349
- ENDIF
-
- IF (IAND (MS(JL),MSKA7F).EQ.MSKA7F) THEN
-C Error conditions
- JBAD = (JL+1) / 2
- IF (MS(JL).NE.IBADMS) THEN
-C Signed infinity
- MT(JL) = IOR (IOVPCD, IAND(MS(JL),NOT(MSKA31)) )
- MT(JL+1) = 0
- ELSE
-C Not a Number (NaN)
- MT(JL) = IBADCD
- MT(JL+1) = 0
- ENDIF
- ENDIF
- 349 CONTINUE
- RETURN
- END
-#ifdef CERNLIB_TCGEN_IE3FOD
-#undef CERNLIB_TCGEN_IE3FOD
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/ie3fos.F b/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/ie3fos.F
deleted file mode 100644
index 68d6daf..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/ie3fos.F
+++ /dev/null
@@ -1,183 +0,0 @@
-*
-* $Id: ie3fos.F,v 1.1.1.1 1996/02/15 17:53:13 mclareni Exp $
-*
-* $Log: ie3fos.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:13 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
-#if defined(CERNLIB_QMIBMVF)
- at PROCESS DIRECTIVE ('*VDIR:') OPT(3) VECTOR
-#endif
- SUBROUTINE IE3FOS (MS,MT,NWDO,JBAD)
-C
-C CERN PROGLIB# M220 IE3FOS .VERSION KERNIBM 2.31 901105
-C
-C 02/03/89 M.Roethlisberger/IBM + J.Zoll/CERN Optimise / Vectorise
-C 01/11/90 M.Roethlisberger/IBM Explicit sectioning, Bug fixed
-C (null mantissa implies now MT=0)
-
-C- Convert single precision for output with copy
-C- from source in native to target in IEEE data format
-C-
-C- Reference: ZEBRA REFERENCE MANUAL book FZ, para. 3.03
-C-
-C- IBM Representation: sccc cccc mmmm mmmm mmmm mmmm mmmm mmmm
-C- IEEE Representation: sccc cccc cmmm mmmm mmmm mmmm mmmm mmmm
-
-C- m: Mant(I3E) = Mant (IBM)*J1 (left-shifting)
-C- and discards left-most bit (hidden bit)
-
-C- c: Exp (I3E) = 4*(Exp(IBM)-64) + J2 + 126 =
-C- = 4*EXP(IBM) + J2 -130
-
-C- s: Sign (I3E) = Sign(IBM)
-C-
-C- Where J1 and J2 are both function of the 4 leftmost bits
-C- of IBM mantissa.
-C-
-#if defined(CERNLIB_3090S)||defined(CERNLIB_3090J)
- PARAMETER (IS = 256)
-#endif
-#if (!defined(CERNLIB_3090S))&&(!defined(CERNLIB_3090J))
- PARAMETER (IS = 128)
-#endif
- DIMENSION MS(*) , MT(*)
- DIMENSION J1 (0:15) , J2 (0:15)
- DIMENSION JEXP(IS) , INP(IS)
-
-C-- PARAMETER (IBADMS = Z 7FFFFFFF)
- PARAMETER (IBADMS = 2147 483 647)
-C-- PARAMETER (MSKA7F = Z 7F000000)
- PARAMETER (MSKA7F = 2130 706 432)
-C-- PARAMETER (MSKA23 = Z 007FFFFF)
- PARAMETER (MSKA23 = 8 388 607)
-C-- PARAMETER (MSKA24 = Z 00FFFFFF)
- PARAMETER (MSKA24 = 16 777 215)
-C-- PARAMETER (MSKA31 = Z 7FFFFFFF)
- PARAMETER (MSKA31 = 2147 483 647)
-C-- PARAMETER (IBADCS = Z 7F80FE00)
- PARAMETER (IBADCS = 2139 160 064)
-C-- PARAMETER (IOVPCS = Z 7F800000)
- PARAMETER (IOVPCS = 2139 095 040)
-C-- PARAMETER (IOVNCS = Z FF800000)
- PARAMETER (IOVNCS = -8 388 608)
-
- PARAMETER (M130 = -130 )
- PARAMETER (LVMIN = 30 )
-
- DATA (J1 (II),II=0,15) /
-C
-C II= 0000, 0001, 0010, 0011, 0100, 0101, 0110, 0111,
- + 16, 8, 4, 4, 2, 2, 2, 2,
-C
-C II= 1000, 1001, 1010, 1011, 1100, 1101, 1110, 1111,
- + 1, 1, 1, 1, 1, 1, 1, 1/
-
-
- DATA (J2 (K),K=0,15) /
-C
-C II= 0000, 0001, 0010, 0011, 0100, 0101, 0110, 0111,
- + -4, -3, -2, -2, -1, -1, -1, -1,
-C
-C II= 1000, 1001, 1010, 1011, 1100, 1101, 1110, 1111
- + 0, 0, 0, 0, 0, 0, 0, 0/
-
-
- ISHFTL (IZW,NZB) = ISHFT (IZW, NZB)
- ISHFTR (IZW,NZB) = ISHFT (IZW,-NZB)
-
- JBAD = 0
-
- DO 100 I = 1,NWDO,IS
-#if defined(CERNLIB_QMIBMVF)
- IF (NWDO-I+1.LT.LVMIN) GO TO 336
-C*VDIR: PREFER VECTOR
-
-C---- Vector loop
-
-
- DO 334 JL=I,MIN0(NWDO,I+IS-1)
- JEXP (JL-I+1) = ISHFTR (IAND (MS(JL),MSKA7F),22)
- + + J2 (ISHFTR (IAND (MS(JL),MSKA24),20) )
- INP (JL-I+1) = MS (JL)
- J4B = ISHFTR (IAND (MS(JL),MSKA24),20)
-
- MT (JL) = IOR (IOR
-
-C Shift left IBM mantissa and discards the left-most significant bit
-C (hidden bit)
- + (IAND (MSKA23,IAND (MS(JL),MSKA24)
- + * J1 (J4B)),
-
-C Multiply IBM exponent by 4, add J2, add -130 and shift it
-C back 23 positions left.
- + ISHFTL(JEXP(JL-I+1) + M130,23) )
-
-C Add sign bit
- + ,IAND (MS(JL),NOT(MSKA31)))
- IF (J4B.EQ.0) MT(JL) = 0
- 334 CONTINUE
- GO TO 341
-C*VDIR: PREFER SCALAR ON
-#endif
-C---- Scalar loop
-
- 336 DO 339 JL=I,MIN0(NWDO,I+IS-1)
- JEXP (JL-I+1) = ISHFTR (IAND (MS(JL),MSKA7F),22)
- + + J2 (ISHFTR (IAND (MS(JL),MSKA24),20) )
- INP (JL-I+1) = MS (JL)
- J4B = ISHFTR (IAND (MS(JL),MSKA24),20)
-
- MT (JL) = IOR (IOR
- + (IAND (MSKA23,IAND (MS(JL),MSKA24)
- + * J1 (J4B)),
- + ISHFTL(JEXP(JL-I+1) + M130,23) )
- + ,IAND (MS(JL),NOT(MSKA31)))
- IF (J4B.EQ.0) MT(JL) = 0
-
- 339 CONTINUE
-
-
-C---- Second loop for exceptions handling
-
- 341 DO 349 JL=I,MIN0(NWDO,I+IS-1)
-
-C Stored Exp (IBM) + 130
-
- IF (JEXP(JL-I+1).LE.130) THEN
-
-C Exp (IBM) <= 0
- IF (JEXP(JL-I+1).GT.107) THEN
-
-C Exp (IBM) > - 23.and. <= 0: 'De-normalized number'
- MT(JL) = ISHFTR ( IAND (INP(JL-I+1),MSKA24)
- + * J1 (ISHFTR (IAND (INP(JL-I+1),MSKA24),20)),
- + 131-JEXP(JL-I+1))
- + + IAND (INP(JL-I+1),NOT(MSKA31))
- ELSE
-
-C Exp (IBM) <= -23 : floating point zero/underflow
- MT(JL) = 0
- ENDIF
- ENDIF
-
- IF (JEXP(JL-I+1).GE.385) THEN
-C Exp (IBM) >= 255 : Error conditions, Overflow/NaN
- JBAD = JL
- IF (INP(JL-I+1).NE.IBADMS) THEN
-C Signed infinity
- MT(JL) = IOR (IOVPCS, IAND(INP(JL-I+1),NOT(MSKA31)) )
- ELSE
- MT(JL) = IBADCS
- ENDIF
- ENDIF
- 349 CONTINUE
- 100 CONTINUE
- RETURN
- END
-#ifdef CERNLIB_TCGEN_IE3FOS
-#undef CERNLIB_TCGEN_IE3FOS
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/ie3tod.F b/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/ie3tod.F
deleted file mode 100644
index 3762777..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/ie3tod.F
+++ /dev/null
@@ -1,177 +0,0 @@
-*
-* $Id: ie3tod.F,v 1.1.1.1 1996/02/15 17:53:13 mclareni Exp $
-*
-* $Log: ie3tod.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:13 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
-#if defined(CERNLIB_QMIBMVF)
- at PROCESS DIRECTIVE ('*VDIR:') OPT(3) VECTOR
-#endif
- SUBROUTINE IE3TOD (MS,MT,NDPN,JBAD)
-C
-C CERN PROGLIB# M220 IE3TOD .VERSION KERNIBM 2.26 890316
-
-C 02/03/89 M.Roethlisberger/IBM + J.Zoll/CERN Optimise / Vectorise
-C
-C- Convert double precision for input with copy
-C- from source in IEEE to target in native data format
-C-
-C- Reference: ZEBRA REFERENCE MANUAL book FZ, para. 3.03
-C-
-C- IEEE Representation: sccc cccc cccc mmmm mmmm mmmm mmmm mmmm
-C- mmmm mmmm mmmm mmmm mmmm mmmm mmmm mmmm
-C-
-C- IBM Representation: sccc cccc mmmm mmmm mmmm mmmm mmmm mmmm
-C- mmmm mmmm mmmm mmmm mmmm mmmm mmmm mmmm
-
-C- m: Mant (IBM) = (00100000 + Mant (IE3))*J1 (left-shifting)
-
-C- c: Exp (IBM) = (Exp (IE3)-1019+J2)/4 + 64 =
-C- = (Exp (IE3)- 763+J2)/4
-C-
-C- s: Sign (IBM) = Sign (IE3)
-C
-C Where J1 and J2 are both function of the 2 right-most bits
-C of I3E exponent
-C
- DIMENSION MS(99), MT(99)
- DIMENSION J1(0:3) , J2(0:3), J3(0:3)
-
-C PARAMETER (IBADMS = Z 7FFFFFFF)
- PARAMETER (IBADMS = 2147 483 647)
- PARAMETER (JEXMIN = -259, JEXMAX=251)
-C PARAMETER (IOVPMS = Z 7FFFFFF0)
- PARAMETER (IOVPMS = 2147 483 632)
-C PARAMETER (IOVNMS = Z FFFFFFF0)
- PARAMETER (IOVNMS = -16)
-C PARAMETER (MSKA31 = Z 7FFFFFFF)
- PARAMETER (MSKA31 = 2147 483 647)
-C PARAMETER (MSKA20 = Z 000FFFFF)
- PARAMETER (MSKA20 = 1 048 575)
-C PARAMETER (MSKB21 = Z 00100000)
- PARAMETER (MSKB21 = 1 048 576)
-C PARAMETER (MSK7FF = Z 7FF00000)
- PARAMETER (MSK7FF = 2146 435 072)
-C PARAMETER (MSKC7F = Z 7F000000)
- PARAMETER (MSKC7F = 2130 706 432)
-C PARAMETER (MSKC03 = Z 00300000)
- PARAMETER (MSKC03 = 3 145 728)
- PARAMETER (IBADMD = IBADMS, IBADME = 0)
- PARAMETER (IOVPMD = IOVPMS, IOVNMD = IOVNMS)
- PARAMETER (M763SH = -800 063 488 )
-
- PARAMETER (LVMIN = 41 )
-
-
- DATA (J1 (II),II=0,3) /
- + 2, 4, 8, 1/
-
- DATA (J2 (II),II=0,3) /
-
-C Respectively -1, -2, -3 and 0 but 20 positions left-shifted
-C FFF00000, FFE00000, FFD00000, 00000000
- + -1 048 576, -2 097 152, -3 145 728, 0/
-
- DATA (J3 (II),II=0,3) /
- + 4, 2, 1, 8/
-
-#include "q_andor.inc"
-#include "q_shift.inc"
-
- JBAD = 0
- NLOOP = 2*NDPN
-
-#if defined(CERNLIB_QMIBMVF)
- IF (NDPN.LT.LVMIN) GO TO 336
-C*VDIR: PREFER VECTOR
-
-C---- Vector loop
-
- DO 334 JL=1,NLOOP,2
-
-C Stores the 2 right-most bits of I3E exponent
- JMOST = ISHFTR (IAND (MS(JL),MSKC03),20)
-
-C Stores IBM exponent
- JXP = IAND (ISHFTL ((IAND (MS(JL), MSK7FF)
- + + J2(JMOST) + M763SH),2) ,MSKC7F)
-
-C Stores IBM left part of mantissa
- JMAN = (IOR(IAND (MS(JL),MSKA20),MSKB21))* J1(JMOST)
-
-C Stores lost bits due to left-shifting of mantissa
- LOST = ISHFTR (MS(JL+1),29)/J3(JMOST)
-
-C Concatenates lost bits, left part of mantissa, exponent, and sign
- MT(JL) = IOR (IOR (IOR (LOST,JMAN),JXP),
- + IAND (MS(JL),NOT(MSKA31)) )
-
-C Shift left the right part of IBM mantissa
- MT(JL+1) = (MS(JL+1)*J1(JMOST))
- 334 CONTINUE
- GO TO 341
-C*VDIR: PREFER SCALAR ON
-#endif
-C---- Scalar loop
-
- 336 DO 339 JL=1,NLOOP,2
- JMOST = ISHFTR (IAND (MS(JL),MSKC03),20)
- JXP = IAND (ISHFTL ((IAND (MS(JL), MSK7FF)
- + + J2(JMOST) + M763SH),2) ,MSKC7F)
- JMAN = (IOR(IAND (MS(JL),MSKA20),MSKB21))* J1(JMOST)
- LOST = ISHFTR (MS(JL+1),29)/J3(JMOST)
- MT(JL) = IOR (IOR (IOR (LOST,JMAN),JXP),
- + IAND (MS(JL),NOT(MSKA31)) )
- MT(JL+1) = (MS(JL+1)*J1(JMOST))
- 339 CONTINUE
-
-C---- Second loop for exceptions handling
-
- 341 DO 349 JL=1,NLOOP,2
-
- IF (MS(JL).EQ.0) THEN
-C Floating Point zero
- MT(JL) = 0
- MT(JL+1) = 0
- GOTO 349
- ENDIF
-
-C Stored Exp (I3E) - 1023
- JEXP = ISHFTR (IAND(MS(JL), MSK7FF), 20)-1023
- IF (JEXP.LT.JEXMIN) THEN
-C Underflow
- MT(JL) = 0
- MT(JL+1) = 0
- GOTO 349
- ENDIF
-
- IF (JEXP.GT.JEXMAX) THEN
-C Error conditions
- JBAD = (JL+1) / 2
- IF (JEXP.NE.1024) THEN
-C Exp > 251 : Signed infinity
- MT(JL) = IOR (IOVPMD, IAND(MS(JL),NOT(MSKA31)) )
- MT(JL+1) = 0
- GO TO 349
- ENDIF
-
- IF (IAND(MS(JL),MSKA20).EQ.0) THEN
-C Exp = 1024 ; Mant = 0 : Signed infinity
- MT(JL) = IOR (IOVPMD, IAND(MS(JL),NOT(MSKA31)) )
- MT(JL+1) = 0
- ELSE
-C Exp = 1024 ; mant ~= 0 : Not a number (NaN)
- MT(JL) = IBADMD
- MT(JL+1) = 0
- ENDIF
- ENDIF
- 349 CONTINUE
- RETURN
- END
-#ifdef CERNLIB_TCGEN_IE3TOD
-#undef CERNLIB_TCGEN_IE3TOD
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/ie3tos.F b/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/ie3tos.F
deleted file mode 100644
index 01f6f28..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/ie3tos.F
+++ /dev/null
@@ -1,150 +0,0 @@
-*
-* $Id: ie3tos.F,v 1.1.1.1 1996/02/15 17:53:13 mclareni Exp $
-*
-* $Log: ie3tos.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:13 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
-#if defined(CERNLIB_QMIBMVF)
- at PROCESS DIRECTIVE ('*VDIR:') OPT(3) VECTOR
-#endif
- SUBROUTINE IE3TOS (MS,MT,NWDO,JBAD)
-C
-C CERN PROGLIB# M220 IE3TOS .VERSION KERNIBM 2.26 890316
-C
-C 02/03/89 M.Roethlisberger/IBM + J.Zoll/CERN Optimise / Vectorise
-
-C- Convert single precision for input with copy
-C- from source in IEEE to target in native data format
-C-
-C- Reference: ZEBRA REFERENCE MANUAL book FZ, para. 3.03
-C-
-C- IEEE Representation: sccc cccc cmmm mmmm mmmm mmmm mmmm mmmm
-C- IBM Representation: sccc cccc mmmm mmmm mmmm mmmm mmmm mmmm
-C-
-C- m: Mant (IBM) = (00800000+ Mant (IE3))/J1 (Right-shifting)
-
-C- c: Exp (IBM) = (Exp (IE3)-126+J2)/4 + 64 =
-C- = (Exp (IE3)+130+J2)/4
-C-
-C- s: Sign (IBM) = Sign (IE3)
-C
-C Where J1 and J2 are both function of the 2 right-most bits
-C of I3E exponent.
-
- DIMENSION MS (99) , MT (99)
- DIMENSION J1 (0:3) , J2 (0:3)
-
- EQUIVALENCE (ITHA , THA)
-
-C PARAMETER (MSKA31 = Z 7FFFFFFF)
- PARAMETER (MSKA31 = 2147 483 647)
-C PARAMETER (MSKA7F = Z 7F000003)
- PARAMETER (MSKA7F = 2130 706 432)
-C PARAMETER (MSKA23 = Z 007FFFFF)
- PARAMETER (MSKA23 = 8 388 607)
-C PARAMETER (MSKB24 = Z 00800000)
- PARAMETER (MSKB24 = 8 388 608)
-C PARAMETER (MSKC18 = Z 01800000)
- PARAMETER (MSKC18 = 25 165 864)
-C PARAMETER (IBADMS = Z 7FFFFFFF)
- PARAMETER (IBADMS = 2147 483 647)
-C PARAMETER (IOVPMS = Z 7FFFFFF0)
- PARAMETER (IOVPMS = 2147 483 632)
-C PARAMETER (IOVNMS = Z FFFFFFF0)
- PARAMETER (IOVNMS = -16)
-
- PARAMETER (LVMIN = 44)
-
-
- DATA (J1 (II),II=0,3) /
- + 4, 2, 1, 8/
-
- DATA (J2 (II),II=0,3) /
-
-C- Respectively 2, 1, 0 and 3 but 22 positions left-shifted.
-C- 00800000, 00400000, 00000000, 00C00000
- + 8 388 608, 4 194 304, 0, 12 582 912/
-
-#include "q_andor.inc"
-#include "q_shift.inc"
-
- JBAD = 0
-
-#if defined(CERNLIB_QMIBMVF)
- IF (NWDO.LT.LVMIN) GO TO 336
-C*VDIR: PREFER VECTOR
-
-C---- Vector loop
-
- DO 334 JL=1,NWDO
- MT(JL) = IOR( IOR(
-
-C Add 1 bit in front of I3E mantissa, shift it right (0-3 positions)
- + IOR (IAND(MS(JL),MSKA23),MSKB24)
- + /J1(ISHFTR(IAND(MS(JL),MSKC18),23))
-
-C Shift I3E exponent 1 position to right, add 20800000 (130 22 positions
-C left-shifted), add J2 (also shifted) and discard all non-IBM exponents
-C bits (i.e. /4)
- + ,IAND(ISHFTR (ISHFTL(MS(JL),1),2) + 545 259 520
- + +J2(ISHFTR(IAND(MS(JL),MSKC18),23)),MSKA7F))
-C Add sign bit
- + ,IAND (MS(JL),NOT(MSKA31)) )
- 334 CONTINUE
- GO TO 341
-C*VDIR: PREFER SCALAR ON
-#endif
-C---- Scalar loop
-
- 336 DO 339 JL=1,NWDO
- MT(JL) = IOR( IOR(
- + IOR (IAND(MS(JL),MSKA23),MSKB24)
- + /J1(ISHFTR(IAND(MS(JL),MSKC18),23))
- + ,IAND(ISHFTR (ISHFTL(MS(JL),1),2) + 545 259 520
- + +J2(ISHFTR(IAND(MS(JL),MSKC18),23)),MSKA7F))
- + ,IAND (MS(JL),NOT(MSKA31)) )
- 339 CONTINUE
-
-C---- Second loop for exceptions handling
-
- 341 DO 349 JL=1,NWDO
-
-C Stored Exp (I3E)
- JEXP3 = ISHFTR (ISHFTL(MS(JL),1),24)
- IF (JEXP3.EQ.0) THEN
- JMAN3 = IAND (MS(JL), MSKA23)
- IF (JMAN3.EQ.0) THEN
-C Exp=0 ; Mant=0 : Floating-point zero
- MT(JL)=0
- ELSE
-
-C Exp=0 ; Mant ~= 0 : De-normalized number
- THA = FLOAT(JMAN3) * 2.**(-63)
- THA = THA * 2.**(-86)
- IF (IAND (MS(JL),NOT(MSKA31)).NE.0) THA=-THA
- MT(JL)=ITHA
- ENDIF
- ENDIF
-
- IF (JEXP3.EQ.255) THEN
-C Error conditions
- JBAD = JL
- JMAN3 = IAND (MS(JL), MSKA23)
- IF (JMAN3.EQ.0) THEN
-C Exp=255 ; Mant = 0 : Signed infinity
- MT(JL) = IOR (IOVPMS, IAND(MS(JL),NOT(MSKA31)) )
- ELSE
-C Exp = 255 ; Mant ~= 0 : Not a Number (NaN)
- MT(JL) = IBADMS
- ENDIF
- ENDIF
- 349 CONTINUE
- RETURN
- END
-#ifdef CERNLIB_TCGEN_IE3TOS
-#undef CERNLIB_TCGEN_IE3TOS
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/incbyt.s b/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/incbyt.s
deleted file mode 100644
index 6102b18..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/incbyt.s
+++ /dev/null
@@ -1,64 +0,0 @@
-*
-* $Id: incbyt.s,v 1.1.1.1 1996/02/15 17:53:13 mclareni Exp $
-*
-* $Log: incbyt.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:13 mclareni
-* Kernlib
-*
-*
-INCBYT CSECT
-*
-* CERN PROGLIB# M423 INCBYT .VERSION KERNIBM 1.03 780715
-*
-* CODED FOR FAST EXECUTION H.WATKINS,LIVERPOOL JULY 1974
-#if defined(CERNLIB_QMIBMXA)
-* SPLEVEL SET=2
-INCBYT AMODE ANY
-INCBYT RMODE ANY
-#endif
- USING *,15
- B BEG
- DC X'6'
- DC CL6'INCBYT'
-BEG STM 1,9,24(13)
- LM 1,4,0(1) R1->INC,R2->X,R3->JX,R4->MPACK
- SR 0,0
- L 1,0(1)
- L 7,0(3) R7=JX
- L 3,0(4) R3=NBITS
- LR 9,7 R9=JX
- BCTR 7,0 R7=JX-1
- SR 6,6
- D 6,4(4) R7=JWORD-1
- LR 5,7
- SLL 5,2
- SR 6,6
- M 6,4(4) R7=(JWORD-1)*INWORD
- SR 9,7 R9=JPOS
- SR 8,8
- MR 8,3
- L 6,0(2,5) R6=X(JWORD)
- SRDL 6,0(9)
- SR 6,6
- SLDL 6,0(3)
- LR 7,6
- ALR 6,1
- C 6,8(4)
- BH OVFL
-GOBACK SR 9,3
- SLL 1,0(9)
- AL 1,0(2,5)
- ST 1,0(2,5)
-RETURN LM 1,9,24(13)
- MVI 12(13),X'FF'
- SR 15,15
- BR 14
-OVFL S 6,8(4)
- LR 0,6
- L 1,8(4)
- SR 1,7
- B GOBACK
- END
-#ifdef CERNLIB_TCGEN_INCBYT
-#undef CERNLIB_TCGEN_INCBYT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/intarg.s b/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/intarg.s
deleted file mode 100644
index 872c209..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/intarg.s
+++ /dev/null
@@ -1,103 +0,0 @@
-*
-* $Id: intarg.s,v 1.1.1.1 1996/02/15 17:53:13 mclareni Exp $
-*
-* $Log: intarg.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:13 mclareni
-* Kernlib
-*
-*
-INTARG CSECT
-*
-* CERN PROGLIB# M250 INTARG .VERSION KERNIBM 2.06 830901
-*
-* R. MATTHEWS, CERN/DD, AUGUST 1983.
-*
-#if defined(CERNLIB_QMIBMXA)
-* SPLEVEL SET=2
-INTARG AMODE ANY
-INTARG RMODE ANY
-#endif
-R0 EQU 0
-R1 EQU 1
-R2 EQU 2
-R3 EQU 3
-R4 EQU 4
-R5 EQU 5
-R6 EQU 6
-R7 EQU 7
-R8 EQU 8
-R9 EQU 9
-R10 EQU 10
-R11 EQU 11
-R12 EQU 12
-R13 EQU 13
-R14 EQU 14
-R15 EQU 15
-*
-F0 EQU 0
-F2 EQU 2
-F4 EQU 4
-F6 EQU 6
-*
- PRINT NOGEN
-*
-* P R O L O G U E
-*
- USING INTARG,R15
- B SAVEREGS
- DC AL1(7),CL7'INTARG' IDENTIFIER
- DC C'1.00' VERSION.MODIFICATION LEVEL
-SAVEREGS STM R14,R12,12(R13)
- LR R4,R13
- CNOP 0,4
- BAL R13,AROUNDSA
-SAVEAREA DC A(EPILOGUE),17F'0'
- DROP R15
- USING SAVEAREA,R13
-AROUNDSA ST R13,8(0,R4)
- ST R4,4(0,R13)
- XC 8(4,R13),8(R13)
-*
- L R2,0(0,R1) R2 -> ARGUMENT
- L R0,0(0,R2) R0 := ARGUMENT
- TM 0(R2),X'80' IS THE SIGN BIT ON ?
- BO NEGATIVE YES, BRANCH
-*
- TM 0(R2),X'7F' IS THE ARGUMENT INTEGER ?
- BZ EPILOGUE PROBABLY, RETURN
-*
- SDR F0,F0 CLEAR THE LOW-ORDER PART OF F0
- LE F0,0(0,R2) F0 := ARGUMENT
- AW F0,=X'4E00000000000000' SHIFT OUT THE FRACTIONAL PART
- STD F0,FPNUM STORE THE RESULT
- L R0,FPNUM+4 R0 := INTEGER PART
- B EPILOGUE RETURN
-*
-NEGATIVE TM 0(R2),X'7F' IS THE ARGUMENT INTEGER ?
- BO EPILOGUE PROBABLY, RETURN
-*
- SDR F0,F0 CLEAR THE LOW-ORDER PART OF F0
- LE F0,0(0,R2) F0 := ARGUMENT
- AW F0,=X'4E00000000000000' SHIFT OUT THE FRACTIONAL PART
- STD F0,FPNUM STORE THE RESULT
- L R0,FPNUM+4 R0 := INTEGER PART
- LNR R0,R0 NEGATE IT
-*
-* E P I L O G U E
-*
-EPILOGUE EQU *
- L R13,4(0,R13)
- L R14,12(R13)
- LM R1,R12,24(R13)
- MVI 12(R13),X'FF'
- BR R14
-*
-* D A T A A R E A S
-*
-FPNUM DS D
-*
- LTORG
- END
-#ifdef CERNLIB_TCGEN_INTARG
-#undef CERNLIB_TCGEN_INTARG
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/iuback.s b/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/iuback.s
deleted file mode 100644
index 91b15d2..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/iuback.s
+++ /dev/null
@@ -1,153 +0,0 @@
-*
-* $Id: iuback.s,v 1.1.1.1 1996/02/15 17:53:13 mclareni Exp $
-*
-* $Log: iuback.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:13 mclareni
-* Kernlib
-*
-*
-IUBACK CSECT
-*
-* CERN PROGLIB# M410 IUBACK .VERSION KERNIBM 2.26 890316
-*
-#if defined(CERNLIB_QMIBMXA)
-* SPLEVEL SET=2
-IUBACK AMODE ANY
-IUBACK RMODE ANY
-#endif
- EXTRN IUCOMP
- USING *,15
- BC 15,12(15)
- DC X'7'
- DC CL7'IUBACK '
- STM 14,12,12(13)
- LR 3,13
- LA 13,SAVEAREA
- ST 13,8(3)
- ST 3,4(13)
- B BEGIN
- ENTRY IUFORW
- USING *,15
-IUFORW BC 15,12(15)
- DC X'7'
- DC CL7'IUFORW '
- STM 14,12,12(13)
- LR 3,13
- ST 13,8(3)
- LA 13,SAVEAREA
- ST 3,4(13)
- B BEGIN2
- CNOP 0,4
- USING *,13
-SAVEAREA DS 18F
-NUM DC CL4' '
- DC CL4'0 '
- DC CL4'1 '
- DC CL4'2 '
- DC CL4'3 '
- DC CL4'4 '
- DC CL4'5 '
- DC CL4'6 '
- DC CL4'7 '
- DC CL4'8 '
- DC CL4'9 '
-AD11 DC F'11'
-ADCON DC A(IUCOMP)
-ERSTARG DC AL4(ERSTARG)
- DC AL4(NUM)
- DC AL4(AD11+X'80000000')
-ND DC A(SLATE)
-BEGIN L 2,0(1)
- L 7,8(1)
- L 7,0(7)
- L 9,4(1)
- L 9,0(9)
- SR 6,6
- SR 8,8
- LA 12,1 R12=1
- LA 4,4 R4=4
- MR 6,4 R7=JEND
- MR 8,4 R9=JL
- SR 6,6 R6=0
- LR 10,6
- SR 5,5 R5=IVAL
- LA 8,10 R8=10
- SR 2,4
- SR 3,3 R3=ND
- LR 11,12 R11=IPOW
-ST12 CR 7,9
- BL ST20
- LA 15,0(2,7)
- ST 15,ERSTARG
- LA 1,ERSTARG
- L 15,ADCON
- BALR 14,15
- LR 15,0
- SR 15,12
- CR 15,6
- BL ST20
- BE ST19
- SR 15,12
- LR 14,6
- MR 14,11
- AR 5,15 IVAL=(K-1)*IPOW+IVAL
- MR 10,8
- AR 3,12
-ST19 SR 7,4
- B ST12
-ST20 DR 6,4
- L 12,ND
- ST 7,4(12)
- ST 3,0(12)
- LR 0,5
- L 13,4(13)
- LM 2,12,28(13)
- L 14,12(13)
- MVI 12(13),X'FF'
- BCR 15,14
-BEGIN2 L 2,0(1)
- L 7,4(1)
- L 7,0(7)
- L 9,8(1)
- L 9,0(9)
- LA 12,1
- LA 4,4
- SR 6,6
- SR 8,8
- MR 8,4 R7=JEND
- MR 6,4 R9=JR
- SR 2,4
- SR 3,3 R3=ND
- SR 11,11 R11=IVAL
- SR 10,10
- SR 6,6
- LA 8,10 R8=10
-ST22 CR 7,9
- BH ST30
- LA 15,0(2,7)
- ST 15,ERSTARG
- LA 1,ERSTARG
- L 15,ADCON
- BALR 14,15
- LR 15,0
- SR 15,12
- CR 15,6
- BL ST30
- BE ST29
- SR 15,12
- MR 10,8
- AR 11,15
- AR 3,12
-ST29 AR 7,4
- B ST22
-ST30 LR 5,11
- B ST20
-SLATE COM
- DS 40F
- END
-#ifdef CERNLIB_TCGEN_IUBACK
-#undef CERNLIB_TCGEN_IUBACK
-#endif
-#ifdef CERNLIB_TCGEN_IUFORW
-#undef CERNLIB_TCGEN_IUFORW
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/iubin.s b/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/iubin.s
deleted file mode 100644
index 04da155..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/iubin.s
+++ /dev/null
@@ -1,63 +0,0 @@
-*
-* $Id: iubin.s,v 1.1.1.1 1996/02/15 17:53:13 mclareni Exp $
-*
-* $Log: iubin.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:13 mclareni
-* Kernlib
-*
-*
-IUBIN CSECT
-*
-* CERN PROGLIB# Y202 IUBIN .VERSION KERNIBM 1.05 790205
-*
-* CODED FOR FAST EXECUTION H.WATKINS,LIVERPOOL JULY 1974
-* MODIFIED FOR EPSILON A.BERGLUND, 5-FEB-79
-#if defined(CERNLIB_QMIBMXA)
-* SPLEVEL SET=2
-IUBIN AMODE ANY
-IUBIN RMODE ANY
-#endif
- USING *,15
- B BEGIN
- DC X'5'
- DC CL5'IUBIN'
-BEGIN STM 1,5,24(13)
- LM 1,3,0(1) R1->X,R2->PAR,R3->SPILL
- SR 4,4 R4=FALSE
- SDR 0,0
- LE 0,0(1)
- SE 0,8(2)
- DE 0,4(2) F0=(X-XLOW)/DX
- AE 0,ONEPE ADD 1. + EPSILON
- CE 0,ONE
- BL UNDFL
- CE 0,MAXNUM
- BNH OK
- LE 0,MAXNUM
-OK L 5,0(2)
- LA 5,1(5) R5=NX+1
- AW 0,FOURE
- STD 0,TWO
- L 0,TWO+4 R0=F0 IN INTEGER FORM
- CR 0,5
- BNM OVFL
- B RET
-UNDFL SR 5,5
-OVFL LR 0,5
-RET1 LA 4,1(4)
-RET ST 4,0(3) R4=TRUE
- LM 1,5,24(13)
- SR 15,15
- MVI 12(13),X'FF'
- BR 14
- DS 0D
-TWO DS D
-FOURE DC X'4E000000'
- DC F'0'
-ONE DC X'41100000'
-ONEPE DC E'1.00001' 1. + EPSILON
-MAXNUM DC X'487FFFFF'
- END
-#ifdef CERNLIB_TCGEN_IUBIN
-#undef CERNLIB_TCGEN_IUBIN
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/iuchan.s b/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/iuchan.s
deleted file mode 100644
index 0f71eee..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/iuchan.s
+++ /dev/null
@@ -1,64 +0,0 @@
-*
-* $Id: iuchan.s,v 1.1.1.1 1996/02/15 17:53:13 mclareni Exp $
-*
-* $Log: iuchan.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:13 mclareni
-* Kernlib
-*
-*
-IUCHAN CSECT
-*
-* CERN PROGLIB# Y201 IUCHAN .VERSION KERNIBM 1.05 790205
-*
-* CODE OF IUBIN ADAPTED FOR IUCHAN A.BERGLUND, 5-FEB-79
-#if defined(CERNLIB_QMIBMXA)
-* SPLEVEL SET=2
-IUCHAN AMODE ANY
-IUCHAN RMODE ANY
-#endif
- USING *,15
- B BEGIN
- DC X'5'
- DC CL7'IUCHAN'
-BEGIN STM 1,5,24(13)
- L 2,4(1) ADDRESS OF XLOW
- L 3,8(1) ADDRESS OF DX
- L 4,12(1) ADDRESS OF NX
- L 1,0(1) ADDRESS OF X
- SDR 0,0
- LE 0,0(1)
- SE 0,0(2)
- DE 0,0(3) F0=(X-XLOW)/DX
- AE 0,ONEPE ADD ONE PLUS EPSILON
- CE 0,ONE
- BL UNDFL
- CE 0,MAXNUM
- BNH OK
- LE 0,MAXNUM
-OK L 5,0(4)
- LA 5,1(5) R5=NX+1
- AW 0,FOURE
- STD 0,TWO
- L 0,TWO+4 R0=F0 IN INTEGER FORM
- CR 0,5
- BNM OVFL
- B RET
-UNDFL SR 5,5
-OVFL LR 0,5
-RET1 EQU *
-RET EQU *
- LM 1,5,24(13)
- SR 15,15
- MVI 12(13),X'FF'
- BR 14
- DS 0D
-TWO DS D
-FOURE DC X'4E000000'
- DC F'0'
-ONE DC X'41100000'
-ONEPE DC E'1.00001' 1. + EPSILON
-MAXNUM DC X'487FFFFF'
- END
-#ifdef CERNLIB_TCGEN_IUCHAN
-#undef CERNLIB_TCGEN_IUCHAN
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/iucomp.s b/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/iucomp.s
deleted file mode 100644
index 45757df..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/iucomp.s
+++ /dev/null
@@ -1,50 +0,0 @@
-*
-* $Id: iucomp.s,v 1.1.1.1 1996/02/15 17:53:13 mclareni Exp $
-*
-* $Log: iucomp.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:13 mclareni
-* Kernlib
-*
-*
-IUCOMP CSECT
-*
-* CERN PROGLIB# V304 IUCOMP .VERSION KERNIBM 0.1 741009
-*
-* CODED FOR FAST EXECUTION H.WATKINS,LIVERPOOL JULY 1974
-#if defined(CERNLIB_QMIBMXA)
-* SPLEVEL SET=2
-IUCOMP AMODE ANY
-IUCOMP RMODE ANY
-#endif
- USING *,15
- B BEGIN
- DC X'6'
- DC CL6'IUCOMP'
-BEGIN STM 1,6,24(13)
- LM 1,3,0(1) R1->IT,R2->IVEC,R3->N
- L 3,0(3)
- LTR 3,3
- BNP ZERO
- L 1,0(1) R1=IT
- LA 4,4(0) R4=4
- LR 6,2 SAVE ADDRESS OF IVEC
- SLL 3,2
- SR 3,4
- LA 5,0(3,2) R5->IVEC(N)
-LOOP C 1,0(2)
- BE FOUND
- BXLE 2,4,LOOP
-ZERO SR 0,0
-RET LM 1,6,24(13)
- SR 15,15
- MVI 12(13),X'FF'
- BR 14
-FOUND SR 2,6
- SRL 2,2
- LA 2,1(2)
- LR 0,2
- B RET
- END
-#ifdef CERNLIB_TCGEN_IUCOMP
-#undef CERNLIB_TCGEN_IUCOMP
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/iufind.s b/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/iufind.s
deleted file mode 100644
index 37e9535..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/iufind.s
+++ /dev/null
@@ -1,54 +0,0 @@
-*
-* $Id: iufind.s,v 1.1.1.1 1996/02/15 17:53:13 mclareni Exp $
-*
-* $Log: iufind.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:13 mclareni
-* Kernlib
-*
-*
-IUFIND CSECT
-*
-* CERN PROGLIB# V304 IUFIND .VERSION KERNIBM 0.1 741009
-*
-* CODED FOR FAST EXECUTION H.WATKINS,LIVERPOOL JULY 1974
-#if defined(CERNLIB_QMIBMXA)
-* SPLEVEL SET=2
-IUFIND AMODE ANY
-IUFIND RMODE ANY
-#endif
- USING *,15
- B BEGIN
- DC X'6'
- DC CL6'IUFIND'
-BEGIN STM 1,6,24(13)
- LM 1,4,0(1) R1->IT,R2->IVEC,R3->JL,R4->JR
- L 3,0(3)
- L 4,0(4)
- LA 0,1(4) R0=JR+1
- BCTR 4,0
- SLL 4,2 R4=4*(JR-1)
- LA 5,0(4,2)
- LR 6,2 SAVE ADDRESS OF IVEC
- BCTR 3,0
- SLL 3,2 R3=4*(JL-1)
- LA 2,0(2,3) R2->IVEC(JL)
- SR 4,3
- BM RET
- L 1,0(1)
- LA 4,4
-LOOP C 1,0(2)
- BE FOUND
- BXLE 2,4,LOOP
-RET LM 1,6,24(13)
- SR 15,15
- MVI 12(13),X'FF'
- BR 14
-FOUND SR 2,6
- SRL 2,2
- LA 2,1(2)
- LR 0,2
- B RET
- END
-#ifdef CERNLIB_TCGEN_IUFIND
-#undef CERNLIB_TCGEN_IUFIND
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/iulast.s b/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/iulast.s
deleted file mode 100644
index ac8ce2a..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/iulast.s
+++ /dev/null
@@ -1,43 +0,0 @@
-*
-* $Id: iulast.s,v 1.1.1.1 1996/02/15 17:53:14 mclareni Exp $
-*
-* $Log: iulast.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:14 mclareni
-* Kernlib
-*
-*
-IULAST CSECT
-*
-* CERN PROGLIB# V305 IULAST .VERSION KERNIBM 0.1 720321
-*
-#if defined(CERNLIB_QMIBMXA)
-* SPLEVEL SET=2
-IULAST AMODE ANY
-IULAST RMODE ANY
-#endif
- USING *,15
- BC 15,12(15)
- DC X'7'
- DC CL7'IULAST '
- STM 14,8,12(13)
- LM 2,4,0(1)
- L 2,0(2)
- L 5,0(4)
- SR 4,4
- LTR 6,5
- BZ ST20
- LA 7,4
- MR 4,7
-ST12 SR 5,7
- L 8,0(3,5)
- CR 2,8
- BNE ST20
- BCT 6,ST12
-ST20 LR 0,6
- LM 2,8,28(13)
- MVI 12(13),X'FF'
- BCR 15,14
- END ,
-#ifdef CERNLIB_TCGEN_IULAST
-#undef CERNLIB_TCGEN_IULAST
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/iulook.s b/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/iulook.s
deleted file mode 100644
index 922a3c8..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/iulook.s
+++ /dev/null
@@ -1,85 +0,0 @@
-*
-* $Id: iulook.s,v 1.1.1.1 1996/02/15 17:53:14 mclareni Exp $
-*
-* $Log: iulook.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:14 mclareni
-* Kernlib
-*
-*
-IULOOK CSECT
-*
-* CERN PROGLIB# M410 IULOOK .VERSION KERNIBM 2.26 890316
-*
-#if defined(CERNLIB_QMIBMXA)
-* SPLEVEL SET=2
-IULOOK AMODE ANY
-IULOOK RMODE ANY
-#endif
- EXTRN UBUNCH
- USING *,15
- BC 15,12(15)
- DC X'7'
- DC CL7'IULOOK '
- STM 14,12,12(13)
- LR 3,13
- LA 13,SAVEAREA
- ST 13,8(3)
- ST 3,4(13)
- B BEGIN
- CNOP 0,4
- USING *,13
-SAVEAREA DS 18F
-ADCON DC A(UBUNCH)
-ERSTARG DC A(SLATE)
- DC AL4(RESULT)
- DC AL4(I+X'80000000')
-I DS 1F
-BLANKS DC CL4' '
-RESULT DS 1F
-BEGIN LM 2,5,0(1)
- L 12,ERSTARG
- L 11,BLANKS
- ST 11,0(12)
- L 7,0(4)
- L 5,0(5)
- LA 10,1
- SR 4,4
- SR 6,6
- LA 8,4
- MR 6,8 R7=JL
- MR 4,8 R5=JR
- L 2,0(2)
- SR 3,8
- SR 4,4 R4=I
- SR 6,6 R6=I*4
-ST20 L 9,0(3,7)
- CR 9,11
- BE ST24
- CR 4,2
- BNL ST29
- AR 4,10
- ST 9,0(12,6)
- AR 6,8
-ST24 AR 7,8
- CR 7,5
- BNH ST20
-ST29 SR 6,6
- CR 6,4
- BNE SKIP
- LR 4,10
-SKIP ST 4,I
- LA 1,ERSTARG
- L 15,ADCON
- BALR 14,15
- L 0,RESULT
- L 13,4(13)
- LM 2,12,28(13)
- L 14,12(13)
- MVI 12(13),X'FF'
- BCR 15,14
-SLATE COM
- DS 40F
- END
-#ifdef CERNLIB_TCGEN_IULOOK
-#undef CERNLIB_TCGEN_IULOOK
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/iunext.s b/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/iunext.s
deleted file mode 100644
index 2d0b5e3..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/iunext.s
+++ /dev/null
@@ -1,48 +0,0 @@
-*
-* $Id: iunext.s,v 1.1.1.1 1996/02/15 17:53:14 mclareni Exp $
-*
-* $Log: iunext.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:14 mclareni
-* Kernlib
-*
-*
-IUNEXT CSECT
-*
-* CERN PROGLIB# M410 IUNEXT .VERSION KERNIBM 0.1 720518
-*
-#if defined(CERNLIB_QMIBMXA)
-* SPLEVEL SET=2
-IUNEXT AMODE ANY
-IUNEXT RMODE ANY
-#endif
- USING *,15
- BC 15,12(15)
- DC X'7'
- DC CL7'IUNEXT '
- STM 14,7,12(13)
- L 2,0(1)
- L 3,4(1)
- L 7,0(3)
- LR 3,7
- LA 4,4
- LA 1,1
- SR 6,6
- MR 6,4
- SR 2,4
- L 5,BLANKS
-ST10 L 6,0(2,7)
- CR 5,6
- BNE ST12
- AR 7,4
- AR 3,1
- B ST10
-ST12 LR 0,3
- LM 2,7,28(13)
- MVI 12(13),X'FF'
- BCR 15,14
- CNOP 0,4
-BLANKS DC CL4' '
- END ,
-#ifdef CERNLIB_TCGEN_IUNEXT
-#undef CERNLIB_TCGEN_IUNEXT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/iusame.s b/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/iusame.s
deleted file mode 100644
index bdc1825..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/iusame.s
+++ /dev/null
@@ -1,65 +0,0 @@
-*
-* $Id: iusame.s,v 1.1.1.1 1996/02/15 17:53:14 mclareni Exp $
-*
-* $Log: iusame.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:14 mclareni
-* Kernlib
-*
-*
-IUSAME CSECT
-*
-* CERN PROGLIB# M501 IUSAME .VERSION KERNIBM 0.1 720321
-*
-#if defined(CERNLIB_QMIBMXA)
-* SPLEVEL SET=2
-IUSAME AMODE ANY
-IUSAME RMODE ANY
-#endif
- ENTRY IUSAME IUS = IUSAME(IA,JST,N,MIN,JSAME)
- BC 15,12(15)
- DC X'07'
- DC CL7'IUSAME '
- STM 14,12,12(13)
- LR 11,15
- USING IUSAME,11
- ST 13,SA+4
- LR 12,13
- LA 13,SA
- ST 13,8(12)
- LM 2,6,0(1)
- L 3,0(3)
- BCTR 3,0
- SLA 3,2
- L 4,0(4)
- BCTR 4,0
- SLA 4,2
- L 5,0(5)
-ZWEI1 SR 8,8
- LR 9,3
-ZWEI4 LA 8,1(8)
- CR 3,4
- BE DREI1
- L 7,0(3,2)
- LA 3,4(3)
- C 7,0(3,2)
- BE ZWEI4
- CR 8,5
- BL ZWEI1
- B DREI2
-DREI1 CR 8,5
- BNL DREI2
- SR 8,8
- LA 9,4(4)
-DREI2 LR 0,8
- SRA 9,2
- LA 9,1(9)
- ST 9,0(6)
- L 13,SA+4
- LM 14,15,12(13)
- LM 1,12,24(13)
- BCR 15,14
-SA DS 18F
- END
-#ifdef CERNLIB_TCGEN_IUSAME
-#undef CERNLIB_TCGEN_IUSAME
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/jbit.s b/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/jbit.s
deleted file mode 100644
index b614b7e..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/jbit.s
+++ /dev/null
@@ -1,37 +0,0 @@
-*
-* $Id: jbit.s,v 1.1.1.1 1996/02/15 17:53:14 mclareni Exp $
-*
-* $Log: jbit.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:14 mclareni
-* Kernlib
-*
-*
-JBIT CSECT
-*
-* CERN PROGLIB# M421 JBIT .VERSION KERNIBM 0.1 741009
-*
-* CODED FOR FAST EXECUTION H.WATKINS,LIVERPOOL JULY 1974
-#if defined(CERNLIB_QMIBMXA)
-* SPLEVEL SET=2
-JBIT AMODE ANY
-JBIT RMODE ANY
-#endif
- USING *,15
- B BEGIN
- DC X'4'
- DC CL4'JBIT'
-BEGIN STM 1,2,24(13)
- LM 1,2,0(1) R1->A,R2->LA
- L 0,0(1)
- L 2,0(2) R2=LA
- SRDL 0,0(2) SHIFT SO THAT LA TH BIT IS AT
- SR 0,0 FAR LEFT OF R1
- SLDL 0,1
- LM 1,2,24(13)
- MVI 12(13),X'FF'
- SR 15,15
- BR 14
- END
-#ifdef CERNLIB_TCGEN_JBIT
-#undef CERNLIB_TCGEN_JBIT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/jbyt.s b/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/jbyt.s
deleted file mode 100644
index ef94115..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/jbyt.s
+++ /dev/null
@@ -1,39 +0,0 @@
-*
-* $Id: jbyt.s,v 1.1.1.1 1996/02/15 17:53:14 mclareni Exp $
-*
-* $Log: jbyt.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:14 mclareni
-* Kernlib
-*
-*
-JBYT CSECT
-*
-* CERN PROGLIB# M421 JBYT .VERSION KERNIBM 0.1 741009
-*
-* CODED FOR FAST EXECUTION H.WATKINS,LIVERPOOL JULY 1974
-#if defined(CERNLIB_QMIBMXA)
-* SPLEVEL SET=2
-JBYT AMODE ANY
-JBYT RMODE ANY
-#endif
- USING *,15
- B BEGIN
- DC X'4'
- DC CL4'JBYT'
-BEGIN STM 1,4,24(13)
- LM 1,3,0(1) R1->A,R2->LA,R3->NBITS
- L 4,0(3) R4=NBITS
- L 3,0(2) R3=LA
- AR 3,4
- L 0,0(1)
- SRDL 0,63(3) MOVE LA+NBITS-1 INTO R1
- SR 0,0
- SLDL 0,0(4) MOVE NBITS BACK INTO R0
- LM 1,4,24(13)
- MVI 12(13),X'FF'
- SR 15,15
- BR 14
- END
-#ifdef CERNLIB_TCGEN_JBYT
-#undef CERNLIB_TCGEN_JBYT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/jbytet.s b/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/jbytet.s
deleted file mode 100644
index e6bf6d4..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/jbytet.s
+++ /dev/null
@@ -1,51 +0,0 @@
-*
-* $Id: jbytet.s,v 1.1.1.1 1996/02/15 17:53:14 mclareni Exp $
-*
-* $Log: jbytet.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:14 mclareni
-* Kernlib
-*
-*
-JBYTET CSECT
-*
-* CERN PROGLIB# M421 JBYTET .VERSION KERNIBM 0.1 720321
-*
-#if defined(CERNLIB_QMIBMXA)
-* SPLEVEL SET=2
-JBYTET AMODE ANY
-JBYTET RMODE ANY
-#endif
- ENTRY JBYTET
- BC 15,12(15)
- DC X'07'
- DC CL7'JBYTET '
- STM 14,12,12(13)
- LR 11,15
- USING JBYTET,11
- ST 13,SA+4
- LR 12,13
- LA 13,SA
- ST 13,8(12)
- L 2,0(1)
- L 0,0(2)
- L 3,4(1)
- L 3,0(3)
- L 4,8(1)
- L 4,0(4)
- L 5,12(1)
- L 5,0(5)
- BCTR 4,0
- SRL 3,0(4)
- LA 6,32
- SR 6,5
- SLL 0,0(6)
- SRL 0,0(6)
- NR 0,3
- L 13,SA+4
- LM 1,12,24(13)
- BCR 15,14
-SA DS 18F
- END
-#ifdef CERNLIB_TCGEN_JBYTET
-#undef CERNLIB_TCGEN_JBYTET
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/kerngt.F b/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/kerngt.F
deleted file mode 100644
index 404c877..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/kerngt.F
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: kerngt.F,v 1.1.1.1 1996/02/15 17:53:10 mclareni Exp $
-*
-* $Log: kerngt.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:10 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE KERNGT (LUN)
-C
-C CERN PROGLIB# Z001 KERNGT .VERSION KERNIBM 2.26 890316
-C ORIG. 16/03/89 JZ
-C
-C-- Store Pam title into /SLATE/ for printing by GSHOWF
-C
- COMMON /SLATE/ MCH(40)
-
- CALL UBLOW (
- + 40H CPP_TITLE
- +, MCH, 40)
- CALL GSHOWF (LUN)
- RETURN
- END
-#ifdef CERNLIB_TCGEN_KERNGT
-#undef CERNLIB_TCGEN_KERNGT
-#endif
-#include "TITLE.kernibm"
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/locb.s b/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/locb.s
deleted file mode 100644
index ee2bc17..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/locb.s
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: locb.s,v 1.1.1.1 1996/02/15 17:53:14 mclareni Exp $
-*
-* $Log: locb.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:14 mclareni
-* Kernlib
-*
-*
-LOCB CSECT
-*
-* CERN PROGLIB# LOCB .VERSION KERNIBM 2.29 891120
-*
-#if defined(CERNLIB_QMIBMXA)
-* SPLEVEL SET=2
-LOCB AMODE ANY
-LOCB RMODE ANY
-#endif
- L 15,0(1)
- LA 15,0(15)
- LR 0,15 . R0 = BYTE - ADR
- BCR 15,14
- END
-#ifdef CERNLIB_TCGEN_LOCB
-#undef CERNLIB_TCGEN_LOCB
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/locf.s b/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/locf.s
deleted file mode 100644
index 353ee4f..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/locf.s
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: locf.s,v 1.1.1.1 1996/02/15 17:53:14 mclareni Exp $
-*
-* $Log: locf.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:14 mclareni
-* Kernlib
-*
-*
-LOCF CSECT
-*
-* CERN PROGLIB# LOCF .VERSION KERNIBM 1.09 820119
-*
-#if defined(CERNLIB_QMIBMXA)
-* SPLEVEL SET=2
-LOCF AMODE ANY
-LOCF RMODE ANY
-#endif
- L 15,0(1)
- LA 15,0(15)
- LR 0,15 . R0 = BYTE - ADR
- SRA 0,2 . R0 = WORD - ADR
- BCR 15,14
- END
-#ifdef CERNLIB_TCGEN_LOCF
-#undef CERNLIB_TCGEN_LOCF
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/matin1.s b/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/matin1.s
deleted file mode 100644
index 7785144..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/matin1.s
+++ /dev/null
@@ -1,181 +0,0 @@
-*
-* $Id: matin1.s,v 1.1.1.1 1996/02/15 17:53:15 mclareni Exp $
-*
-* $Log: matin1.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:15 mclareni
-* Kernlib
-*
-*
-MATIN1 CSECT
-*
-* CERN PROGLIB# F100 MATIN1 .VERSION KERNIBM 1.09 820119
-*
-#if defined(CERNLIB_QMIBMXA)
-* SPLEVEL SET=2
-MATIN1 AMODE ANY
-MATIN1 RMODE ANY
-#endif
- ENTRY MATIN1 .CALL MATIN1(A,DIM,N,DIM2,N2
-* INDEX,NERROR,DETERM)
- BC 15,12(15)
- DC X'07'
- DC CL7'MATIN1 '
- STM 14,12,12(13)
- LR 2,15
- USING MATIN1,2
- ST 13,SA+4
- LR 12,13
- LA 13,SA
- ST 13,8(12)
- LD 6,FLOATONE DETER = 1. IN FL.REG. 6
- L 15,8(1)
- L 15,0(15)
- SLL 15,2(0)
- S 15,FIXVIER 4*(N-1) IN REG. 15
- L 3,0(1) ADR. OF A IN REG. 3
- L 4,20(1) ADR OF INDEX IN REG. 4
- L 5,16(1)
- L 5,0(5)
- SLL 5,2(0)
- AR 5,15 EMAT = 4(N-1)+4*N2 IN REG.5
- L 6,4(1)
- L 6,0(6)
- SLL 6,2(0) 4*DIM IN REG. 6
- LNR 7,6 PIVCOL=-DIM IN REG. 7
- LA 8,0(0) MAIN IN REG. 8
-LOOPM SDR 4,4 PIVOT = 0. IN FL.REG. 4
- AR 7,6 PIVCOL = PIVCOL + DIM IN REG. 7
- LR 9,7
- AR 9,8 PIVCL1=PIVCOL+MAIN IN REG. 9
- LR 10,7
- AR 10,15 PIVCL2=PIVCOL+NMIN1 IN REG. 10
- LR 11,9 I = PIVCL1 IN REG. 11
-LOOPI1 LPDR 0,4 ABS(PIVOT) IN FL.REG. 0
- SDR 2,2 CLEAR FL.REG. 2
- LE 2,0(11,3) A(I) IN FL.REG. 2
- LPDR 2,2 ABS( A(I) ) IN FL.REG. 2
- CDR 2,0
- BC 12,ZWEI IF ABS(A(I)) LE ABS(PIVOT) GOTO2
- SDR 4,4 CLEAR FL.REG. 4
- LE 4,0(11,3) PIVOT = A(I) IN FL.REG. 4
- LR 0,11 LPIV = I IN REG. 0
-ZWEI LA 11,4(11) INCREASE I
- CR 11,10
- BC 12,LOOPI1
- LTDR 4,4
- BC 8,EINS5 IF PIVOT = 0 GO TO 15
- LR 12,0
- SR 12,7 ICOL=LPIV-PIVCOL IN REG. 12
- ST 12,0(8,4) INDEX(MAIN) = ICOL
- CR 12,8
- BC 12,SECHS IF ICOL LE MAIN GO TO 6
- SDR 2,2 CLEAR FL.REG. 2
- SDR 2,6
- LDR 6,2 DETER = -DETER IN FL.REG. 6
- SR 12,6 ICOL=ICOL-DIM IN REG. 12
- LR 14,8
- SR 14,6 I3 = MAIN-DIM IN REG. 14
- LA 11,0(0) I = 0 IN REG. 11
-LOOPI2 AR 12,6 ICOL = ICOL+DIM IN REG. 12
- AR 14,6 I3 = I3+DIM IN REG. 14
- LE 2,0(14,3) SWAP = A(I3) IN FL.REG. 2
- LE 0,0(12,3)
- STE 0,0(14,3) A(I3) = A(ICOL)
- STE 2,0(12,3) A(ICOL) = SWAP
- LA 11,4(11) INCREASE I
- CR 11,5
- BC 12,LOOPI2
-SECHS MDR 6,4 DETER = DETER*PIVOT
- LD 0,FLOATONE 1. IN FL.REG. 0
- DDR 0,4 1./PIVOT IN FL.REG. 0
- LDR 4,0 PIVOT = 1./PIVOT IN FL.REG. 4
- LR 14,7
- AR 14,15 I3 = PIVCOL+NMIN1 IN REG. 14
- LR 11,7 I = PIVCOL IN REG. 7
-LOOPI3 SDR 0,0 CLEAR FL.REG. 0
- SE 0,0(11,3) -A(I) IN FL.REG. 0
- MDR 0,4 -A(I)*PIVOT IN FL.REG. 0
- STE 0,0(11,3) A(I) = -A(I)*PIVOT
- LA 11,4(11) INCREASE I
- CR 11,14
- BC 12,LOOPI3
- STE 4,0(9,3) A(PIVCL1) = PIVOT
- LR 10,8
- SR 10,6 I1 = MAIN-DIM IN REG. 10
- LNR 12,6 ICOL = -DIM IN REG. 12
- LA 11,0(0) I = 0 IN REG. 11
-LOOPI4 AR 12,6 ICOL = ICOL+DIM
- AR 10,6 I1 = I1+DIM IN REG. 10
- CR 11,8
- BC 8,ZEHN IF I .EQ. MAIN GO TO 10
- LR 13,12
- AR 13,15 JCOL = ICOL+NMIN1 IN REG. 13
- SDR 2,2 CLEAR FL.REG. 2
- LE 2,0(10,3) SWAP = A(I1) IN FL.REG. 2
- LR 14,7
- S 14,FIXVIER I3 = PIVCOL-1 IN REG. 14
- LR 9,12 I2 = ICOL IN REG. 9
-LOOPI21 LA 14,4(14) I3 = I3+1 IN REG. 14
- SDR 0,0 CLEAR FL.REG. 0
- LE 0,0(14,3) A(I3) IN FL.REG. 0
- MDR 0,2 SWAP*A(I3) IN FL.REG. 0
- AE 0,0(9,3) A(I2)+SWAP*A(I3) IN FL.REG. 0
- STE 0,0(9,3) A(I2)=A(I2)+SWAP*A(I3)
- LA 9,4(9) INCREASE I3
- CR 9,13
- BC 12,LOOPI21
- MDR 2,4
- STE 2,0(10,3) A(I1) = SWAP*PIVOT
-ZEHN LA 11,4(11) INCREASE I
- CR 11,5
- BC 12,LOOPI4
- LA 8,4(8) INCREASE MAIN
- CR 8,15
- BC 12,LOOPM
- LA 14,0(0) I1 = 0 IN REG. 14
-LOOPI11 LR 9,15
- SR 9,14 MAIN = NMIN1 - I1 IN REG. 9
- L 11,0(9,4) LPIV=INDEX(MAIN) IN REG. 11
- CR 11,9
- BC 8,EINS4 IF LPIV .EQ. MAIN GO TO 14
- MR 10,6 ICOL=LPIV*DIM IN REG. 11
- SRL 11,2(0)
- LR 10,11
- AR 10,15 JCOL=ICOL+NMIN1 IN REG. 10
- MR 8,6
- SRL 9,2(0)
- SR 9,11 PIVCOL=MAIN*DIM-ICOL IN REG. 9
- LR 12,11 I2 = ICOL IN REG. 12
-LOOPI22 LR 13,12
- AR 13,9 I3 = I2+PIVCOL IN REG. 13
- LE 2,0(12,3) SWAP = A(I2) IN FL.REG. 2
- LE 0,0(13,3)
- STE 0,0(12,3) A(I2) = A(I3)
- STE 2,0(13,3) A(I3) = SWAP
- LA 12,4(12) INCREASE I2
- CR 12,10
- BC 12,LOOPI22
-EINS4 LA 14,4(14) INCREASE I1
- CR 14,15
- BC 12,LOOPI11
- L 3,28(1) ADR. OF DETERM IN REG. 3
- STE 6,0(3) DETERM = DETER
- L 3,24(1) ADR. OF NERROR IN REG. 3
- LA 0,0(0) 0 IN REG. 0
- ST 0,0(3) NERROR = 0
- B RETURN
-EINS5 EQU *
- L 3,24(1) ADR. OF NERROR IN REG. 3
- ST 8,0(3) NERROR=MAIN
- L 3,28(1) ADR. OF DETERM IN REG. 3
- XC 0(4,3),0(3) DETERM=0.
-RETURN L 13,SA+4
- LM 14,12,12(13)
- BCR 15,14
-FLOATONE DC D'1.'
-FIXVIER DC F'4'
-SA DS 18F
- END
-#ifdef CERNLIB_TCGEN_MATIN1
-#undef CERNLIB_TCGEN_MATIN1
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/mbytet.s b/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/mbytet.s
deleted file mode 100644
index 4b5b297..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/mbytet.s
+++ /dev/null
@@ -1,59 +0,0 @@
-*
-* $Id: mbytet.s,v 1.1.1.1 1996/02/15 17:53:15 mclareni Exp $
-*
-* $Log: mbytet.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:15 mclareni
-* Kernlib
-*
-*
-MBYTET CSECT
-*
-* CERN PROGLIB# M421 MBYTET .VERSION KERNIBM 2.14 851016
-* ORIG. SEPT 85, HRR
-*
-#if defined(CERNLIB_QMIBMXA)
-* SPLEVEL SET=2
-MBYTET AMODE ANY
-MBYTET RMODE ANY
-#endif
- ENTRY MBYTET
- BC 15,12(15)
- DC X'07'
- DC CL7'MBYTET '
- STM 14,12,12(13)
- LR 11,15
- USING MBYTET,11
- ST 13,SA+4
- LR 12,13
- LA 13,SA
- ST 13,8(12)
- L 2,0(1)
- L 2,0(2)
- L 3,4(1)
- L 0,0(3)
- L 5,8(1)
- L 5,0(5)
- L 6,12(1)
- L 6,0(6)
- LA 7,32
- SR 7,6
- SLL 2,0(7)
- L 4,FF
- SLL 4,0(7)
- SR 7,5
- LA 7,1(7)
- SRL 2,0(7)
- SRL 4,0(7)
- X 4,FF
- OR 2,4
- NR 0,2
- L 13,SA+4
- LM 14,15,12(13)
- LM 1,12,24(13)
- BCR 15,14
-SA DS 18F
-FF DC X'FFFFFFFF'
- END
-#ifdef CERNLIB_TCGEN_MBYTET
-#undef CERNLIB_TCGEN_MBYTET
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/mbytor.s b/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/mbytor.s
deleted file mode 100644
index 3832453..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/mbytor.s
+++ /dev/null
@@ -1,53 +0,0 @@
-*
-* $Id: mbytor.s,v 1.1.1.1 1996/02/15 17:53:15 mclareni Exp $
-*
-* $Log: mbytor.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:15 mclareni
-* Kernlib
-*
-*
-MBYTOR CSECT
-*
-* CERN PROGLIB# M421 MBYTOR .VERSION KERNIBM 2.14 851016
-* ORIG. SEPT 85, HRR
-*
-#if defined(CERNLIB_QMIBMXA)
-* SPLEVEL SET=2
-MBYTOR AMODE ANY
-MBYTOR RMODE ANY
-#endif
- ENTRY MBYTOR
- BC 15,12(15)
- DC X'07'
- DC CL7'MBYTOR '
- STM 14,12,12(13)
- LR 11,15
- USING MBYTOR,11
- ST 13,SA+4
- LR 12,13
- LA 13,SA
- ST 13,8(12)
- L 2,0(1)
- L 2,0(2)
- L 3,4(1)
- L 0,0(3)
- L 5,8(1)
- L 5,0(5)
- L 6,12(1)
- L 6,0(6)
- LA 7,32
- SR 7,6
- SLL 2,0(7)
- SR 7,5
- LA 7,1(7)
- SRL 2,0(7)
- OR 0,2
- L 13,SA+4
- LM 14,15,12(13)
- LM 1,12,24(13)
- BCR 15,14
-SA DS 18F
- END
-#ifdef CERNLIB_TCGEN_MBYTOR
-#undef CERNLIB_TCGEN_MBYTOR
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/mcbyt.s b/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/mcbyt.s
deleted file mode 100644
index bc15f2a..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/mcbyt.s
+++ /dev/null
@@ -1,71 +0,0 @@
-*
-* $Id: mcbyt.s,v 1.1.1.1 1996/02/15 17:53:15 mclareni Exp $
-*
-* $Log: mcbyt.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:15 mclareni
-* Kernlib
-*
-*
-MCBYT CSECT
-*
-* CERN PROGLIB# M421 MCBYT .VERSION KERNIBM 2.14 851016
-* ORIG. SEPT 85, HRR
-*
-#if defined(CERNLIB_QMIBMXA)
-* SPLEVEL SET=2
-MCBYT AMODE ANY
-MCBYT RMODE ANY
-#endif
- ENTRY MCBYT
- BC 15,12(15)
- DC X'07'
- DC CL7'MCBYT '
- STM 14,12,12(13)
- LR 11,15
- USING MCBYT,11
- ST 13,SA+4
- LR 12,13
- LA 13,SA
- ST 13,8(12)
- L 2,0(1)
- L 2,0(2)
- L 3,4(1)
- L 3,0(3)
- BCTR 3,0
- SRL 2,0(3)
- L 3,8(1)
- L 0,0(3)
- L 5,12(1)
- L 5,0(5)
- BCTR 5,0
- L 6,16(1)
- L 6,0(6)
- LA 7,STOREC
-STOREC STC 2,BYTE
- TM BYTE,X'01'
- BC 8,ZERO
- LA 8,1
- SLL 8,0(5)
- OR 0,8
- B TESTR6
-ZERO L 12,FE
- L 13,FF
- SLDL 12,0(5)
- NR 0,12
-TESTR6 BCT 6,*+8
- B STOREX
- LA 5,1(5)
- SRL 2,1
- BCR 15,7
-STOREX L 13,SA+4
- LM 14,15,12(13)
- LM 1,12,24(13)
- BCR 15,14
-SA DS 18F
-FF DC X'FFFFFFFF'
-FE DC X'FFFFFFFE'
-BYTE DS C
- END
-#ifdef CERNLIB_TCGEN_MCBYT
-#undef CERNLIB_TCGEN_MCBYT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/msbit.s b/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/msbit.s
deleted file mode 100644
index 93a9dea..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/msbit.s
+++ /dev/null
@@ -1,49 +0,0 @@
-*
-* $Id: msbit.s,v 1.1.1.1 1996/02/15 17:53:15 mclareni Exp $
-*
-* $Log: msbit.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:15 mclareni
-* Kernlib
-*
-*
-MSBIT CSECT
-*
-* CERN PROGLIB# M421 MSBIT .VERSION KERNIBM 2.14 851016
-* ORIG. SEPT 85, HRR
-*
-#if defined(CERNLIB_QMIBMXA)
-* SPLEVEL SET=2
-MSBIT AMODE ANY
-MSBIT RMODE ANY
-#endif
- USING *,15
- B BEGIN
- DC X'4'
- DC CL7'MSBIT '
-BEGIN STM 2,5,28(13)
- LM 2,4,0(1) R2->A,R3->X,R4->LX
- L 4,0(4) R4=LX
- LTR 4,4
- BNP RET2 RETURN IF LX.LE.0
- L 2,0(2)
- LA 5,1
- NR 5,2 R5 HAS SAME LOW ORDER BIT AS A
- LTR 5,5
- BZ BIT0
-BIT1 SLL 5,63(4)
- O 5,0(3)
- B RET
-BIT0 LA 5,1
- SLL 5,63(4)
- X 5,FF
- N 5,0(3)
-RET LR 0,5
-RET2 LM 2,5,28(13)
- MVI 12(13),X'FF'
- SR 15,15
- BR 14
-FF DC F'-1'
- END
-#ifdef CERNLIB_TCGEN_MSBIT
-#undef CERNLIB_TCGEN_MSBIT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/msbit0.s b/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/msbit0.s
deleted file mode 100644
index 8c70da7..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/msbit0.s
+++ /dev/null
@@ -1,49 +0,0 @@
-*
-* $Id: msbit0.s,v 1.1.1.1 1996/02/15 17:53:15 mclareni Exp $
-*
-* $Log: msbit0.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:15 mclareni
-* Kernlib
-*
-*
-MSBIT0 CSECT
-*
-* CERN PROGLIB# M421 MSBIT0 .VERSION KERNIBM 2.14 851016
-* ORIG. SEPT 85, HRR
-*
-#if defined(CERNLIB_QMIBMXA)
-* SPLEVEL SET=2
-MSBIT0 AMODE ANY
-MSBIT0 RMODE ANY
-#endif
- ENTRY MSBIT0
- BC 15,12(15)
- DC X'07'
- DC CL7'MSBIT0 '
- STM 14,12,12(13)
- LR 11,15
- USING MSBIT0,11
- ST 13,SA+4
- LR 12,13
- LA 13,SA
- ST 13,8(12)
- L 2,0(1)
- L 0,0(2)
- L 4,4(1)
- L 4,0(4)
- BCTR 4,0
- L 6,FE
- L 7,FF
- SLDL 6,0(4)
- NR 0,6
- L 13,SA+4
- LM 14,15,12(13)
- LM 1,12,24(13)
- BCR 15,14
-SA DS 18F
-FE DC X'FFFFFFFE'
-FF DC X'FFFFFFFF'
- END
-#ifdef CERNLIB_TCGEN_MSBIT0
-#undef CERNLIB_TCGEN_MSBIT0
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/msbit1.s b/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/msbit1.s
deleted file mode 100644
index f920ca5..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/msbit1.s
+++ /dev/null
@@ -1,46 +0,0 @@
-*
-* $Id: msbit1.s,v 1.1.1.1 1996/02/15 17:53:15 mclareni Exp $
-*
-* $Log: msbit1.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:15 mclareni
-* Kernlib
-*
-*
-MSBIT1 CSECT
-*
-* CERN PROGLIB# M421 MSBIT1 .VERSION KERNIBM 2.14 851016
-* ORIG. SEPT 85, HRR
-*
-#if defined(CERNLIB_QMIBMXA)
-* SPLEVEL SET=2
-MSBIT1 AMODE ANY
-MSBIT1 RMODE ANY
-#endif
- ENTRY MSBIT1
- BC 15,12(15)
- DC X'07'
- DC CL7'MSBIT1 '
- STM 14,12,12(13)
- LR 11,15
- USING MSBIT1,11
- ST 13,SA+4
- LR 12,13
- LA 13,SA
- ST 13,8(12)
- L 2,0(1)
- L 0,0(2)
- L 4,4(1)
- L 4,0(4)
- BCTR 4,0
- LA 5,1
- SLL 5,0(4)
- OR 0,5
- L 13,SA+4
- LM 14,15,12(13)
- LM 1,12,24(13)
- BCR 15,14
-SA DS 18F
- END
-#ifdef CERNLIB_TCGEN_MSBIT1
-#undef CERNLIB_TCGEN_MSBIT1
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/msbyt.s b/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/msbyt.s
deleted file mode 100644
index c884e04..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/msbyt.s
+++ /dev/null
@@ -1,46 +0,0 @@
-*
-* $Id: msbyt.s,v 1.1.1.1 1996/02/15 17:53:15 mclareni Exp $
-*
-* $Log: msbyt.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:15 mclareni
-* Kernlib
-*
-*
-MSBYT CSECT
-*
-* CERN PROGLIB# M421 MSBYT .VERSION KERNIBM 2.14 851016
-* ORIG. SEPT 85, HRR
-*
-#if defined(CERNLIB_QMIBMXA)
-* SPLEVEL SET=2
-MSBYT AMODE ANY
-MSBYT RMODE ANY
-#endif
- USING *,15
- B BEG
- DC X'4'
- DC CL7'MSBYT '
-BEG STM 1,7,24(13)
- LM 2,5,0(1) R2->A,R3->X,R4->LX,R5->NBITS
- L 5,0(5) R5=NBITS
- L 4,0(4) R4=LX
- L 0,0(2) R0=A
- SR 1,1
- SRDL 0,0(5) R1 HAS LEFT MOST BITS = BYTE A
- L 6,0(3)
- AR 4,5
- SRDL 6,63(4)
- LR 0,6
- SLDL 0,0(5)
- SLL 7,0(5)
- LR 1,7
- SR 4,5
- SLDL 0,63(4)
- LM 1,7,24(13)
- MVI 12(13),X'FF'
- SR 15,15
- BR 14
- END
-#ifdef CERNLIB_TCGEN_MSBYT
-#undef CERNLIB_TCGEN_MSBYT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/mxequ.s b/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/mxequ.s
deleted file mode 100644
index 6103273..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/mxequ.s
+++ /dev/null
@@ -1,215 +0,0 @@
-*
-* $Id: mxequ.s,v 1.1.1.1 1996/02/15 17:53:15 mclareni Exp $
-*
-* $Log: mxequ.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:15 mclareni
-* Kernlib
-*
-*
-MXEQU CSECT
-*
-* CERN PROGLIB# F109 MXEQU .VERSION KERNIBM 0.1 720518
-*
-#if defined(CERNLIB_QMIBMXA)
-* SPLEVEL SET=2
-MXEQU AMODE ANY
-MXEQU RMODE ANY
-#endif
- ENTRY MXEQU CALL MXEQU(A,B,I,J)
- ENTRY MXEQU1 CALL MXEQU1(A,B,I,J)
- BC 15,12(15)
- DC X'07'
- DC CL7'MXEQU '
- STM 14,12,12(13)
- LR 2,15
- USING MXEQU,2
- L 5,8(1) ADR(I)
- L 5,0(5) I IN REG. 5
- LTR 5,5
- BC 12,RETURN1 IF I=0 RETURN
- ST 13,SA+4 STORE SA
- LR 12,13
- LA 13,SA
- ST 13,8(12)
- ST 1,REG1
- LA 15,4(0) 4 IN REG. 15
- L 3,0(1) ADR(A) IN REG. 3
- L 4,4(1) ADR(B) IN REG. 4
- B ZEHN
- DS 0F
-MXEQU1 BC 15,16(15)
- DC X'07'
- DC CL7'MXEQU1 '
- DC A(MXEQU)
- STM 14,12,12(13)
- L 2,12(15)
- USING MXEQU,2
- L 5,8(1) ADR(I)
- L 5,0(5) I IN REG. 5
- LTR 5,5
- BC 12,RETURN1 IF I=0 RETURN
- ST 13,SA+4 STORE SA
- LR 12,13
- LA 13,SA
- ST 13,8(12)
- ST 1,REG1
- LA 15,4(0) 4 IN REG. 15
- L 3,0(1) ADR(A) IN REG. 3
- L 4,4(1) ADR(B) IN REG. 4
- B TESTJ
-ZEHN LA 8,1(0) L = 1 IN REG. 8
-LOOPL1 LR 1,8 COMPUTE ADR OF A(L,L)
- MR 0,5
- SR 1,5
- AR 1,8
- SLL 1,2(0)
- SR 1,15 ADR OF A(L,L) IN REG. 1
- SDR 0,0
- LE 0,0(1,3) DIAG=A(L,L) IN FL.REG. 0
- LA 7,1(0) M = 1 IN REG. 7
-LOOPM1 CR 7,8
- BC 8,ZWOELF IF M = L GO TO 12
- LR 1,7 COMPUTE ADR OF A(L,M)
- MR 0,5
- SR 1,5
- AR 1,8
- SLL 1,2(0)
- SR 1,15 ADR OF A(L,M) IN REG. 1
- SDR 2,2
- SDR 4,4
- LE 4,0(1,3) A(L,M) IN FL.REG. 4
- SDR 2,4 -A(L,M) IN FL.REG. 2
- DDR 2,0 -A(L,M)/DIAG IN FL.REG. 2
- STE 2,0(1,3) A(L,M)=-A(L,M)/DIAG
-ZWOELF LA 7,1(7) INCREASE M
- CR 7,5
- BC 12,LOOPM1 IS LOOPM1 FINISHED &
- LR 9,8
- LA 9,1(9) LPL1=L+1 IN REG. 9
- CR 9,5
- BC 2,TESTJ IF LPL1 > I GO TO TESTJ
-LOOPLPL1 LA 7,1(0) M = 1 IN REG. 7
-LOOPM2 CR 8,7
- BC 8,EINS5 IF M=L GO TO 15
- LR 1,7 COMPUTE ADR. OF A(LPL1,M)
- MR 0,5
- SR 1,5
- AR 1,9
- SLL 1,2(0)
- SR 1,15
- LR 10,1 ADR. OF A(L1,M) IN REG. 10
- LR 1,8 COMPUTE ADR. OF A(L1,L)
- MR 0,5
- SR 1,5
- AR 1,9
- SLL 1,2(0)
- SR 1,15
- LR 11,1 ADR. OF A(L1,L) IN REG. 11
- LR 1,7 COMPUTE ADR. OF A(L,M)
- MR 0,5
- SR 1,5
- AR 1,8
- SLL 1,2(0)
- SR 1,15 ADR. OF A(L,M) IN REG. 1
- SDR 0,0
- SDR 2,2
- SDR 4,4
- LE 0,0(1,3) A(L,M) IN FL.REG. 0
- LE 2,0(11,3) A(L1,L) IN FL.REG. 2
- MDR 0,2 A(L,M)*A(L1,L)
- LE 4,0(10,3) A(L1,M) IN FL.REG. 4
- ADR 0,4 A(L1,M) + A(L,M)*A(L1,L)
- STE 0,0(10,3) STORE A(L1,M)
-EINS5 LA 7,1(7) INCREASE M
- CR 7,5
- BC 12,LOOPM2 IS LOOPM2 FINISHED
- LA 9,1(9) INCREASE LPL1
- CR 9,5
- BC 12,LOOPLPL1 IS LOOPLPL1 FINISHED
- LA 8,1(8) INCREASE L
- CR 8,5
- BC 12,LOOPL1 IS LOOPL1 FINISHED &
-TESTJ L 6,REG1
- L 6,12(6)
- L 6,0(6) J IN REG. 6
- LTR 6,6
- BC 12,RETURN IF J=0 RETURN
- LA 8,1(0) L = 1 IN REG. 8
-LOOPL2 LA 7,1(0) M = 1 IN REG. 7
-LOOPM3 LA 9,1(0) N = 1 IN REG. 9
-LOOPN CR 8,9
- BC 8,ZWEI5 IF L=N GO TO 25
- LR 1,9 COMPUTE ADR. OF B(M,N)
- MR 0,6
- SR 1,6
- AR 1,7
- SLL 1,2(0)
- SR 1,15
- LR 10,1 ADR. OF B(M,N) IN REG. 10
- LR 1,8 COMPUTE ADR. OF B(M,L)
- MR 0,6
- SR 1,6
- AR 1,7
- SLL 1,2(0)
- SR 1,15
- LR 11,1 ADR. OF B(M,L) IN REG. 11
- LR 1,9 COMPUTE ADR. OF A(L,N)
- MR 0,5
- SR 1,5
- AR 1,8
- SLL 1,2(0)
- SR 1,15 ADR. OF A(L,N) IN REG. 1
- SDR 0,0
- SDR 2,2
- SDR 4,4
- LE 0,0(1,3) A(L,N) IN FL.REG. 0
- LE 2,0(11,4) B(M,L) IN FL.REG. 2
- MDR 0,2 A(L,N)*B(M,L)
- LE 4,0(10,4) B(M,N) IN FL.REG. 4
- ADR 0,4 A(L,N)*B(M,L)+B(M,N)
- STE 0,0(10,4) STORE NEW B(M,N)
-ZWEI5 LA 9,1(9) INCREASE N
- CR 9,5
- BC 12,LOOPN IS LOOP N FINISHED &
- LA 7,1(7) INCREASE M
- CR 7,6
- BC 12,LOOPM3 IS LOOP M FINISHED
- LA 8,1(8) INCREASE L
- CR 8,5
- BC 12,LOOPL2
- LA 7,1(0) M = 1 IN REG. 7
-LOOPM4 LA 9,1(0) N = 1 IN REG. 9
-LOOPN1 LR 1,9 COMPUTE ADR. OF B(M,N)
- MR 0,6
- SR 1,6
- AR 1,7
- SLL 1,2(0)
- SR 1,15
- LR 10,1 ADR. OF B(M,N) IN REG. 10
- LR 1,9 COMPUTE ADR. OF A(N,N)
- MR 0,5
- SR 1,5
- AR 1,9
- SLL 1,2(0)
- SR 1,15 ADR. OF A(N,N) IN REG. 1
- SDR 0,0
- SDR 2,2
- LE 0,0(10,4) B(M,N) IN FL.REG. 0
- LE 2,0(1,3) A(N,N) IN FL.REG. 2
- DDR 0,2 B7
- STE 0,0(10,4) STORE NEW B(M,N)
- LA 9,1(9) INCREASE N
- CR 9,5
- BC 12,LOOPN1 IS LOOP N FINISHED &
- LA 7,1(7) INCREASE M
- CR 7,6
- BC 12,LOOPM4 IS LOOP M FINISHED
-RETURN L 13,SA+4
-RETURN1 LM 14,12,12(13)
- BCR 15,14
-REG1 DS 1F
-SA DS 18F
- END
-#ifdef CERNLIB_TCGEN_MXEQU
-#undef CERNLIB_TCGEN_MXEQU
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/mxmad.s b/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/mxmad.s
deleted file mode 100644
index e85b87f..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/mxmad.s
+++ /dev/null
@@ -1,555 +0,0 @@
-*
-* $Id: mxmad.s,v 1.1.1.1 1996/02/15 17:53:15 mclareni Exp $
-*
-* $Log: mxmad.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:15 mclareni
-* Kernlib
-*
-*
-MXMAD CSECT
-*
-* CERN PROGLIB# F110 MXMAD .VERSION KERNIBM 2.11 850320
-*
-* MXMAD WITH ENTRIES MXMAD, MXMAD1, MXMAD2, MXMAD3, MXMPY, MXMPY1
-* MXMPY2 WITH ENTRIES MXMPY2, MXMPY3, MXMUB, MXMUB1, MXMUB2, MXMUB3
-*
-* STANDARD PROLOGUE, ENTRY CODE AND EPILOGUE ADDED.
-* R. MATTHEWS, CERN/DD, FEBRUARY 1985.
-*
-********************************************************************
-*
-#if defined(CERNLIB_QMIBMXA)
-* SPLEVEL SET=2
-MXMAD AMODE ANY
-MXMAD RMODE ANY
-#endif
-R0 EQU 0
-R1 EQU 1
-R2 EQU 2
-R3 EQU 3
-R4 EQU 4
-R5 EQU 5
-R6 EQU 6
-R7 EQU 7
-R8 EQU 8
-R9 EQU 9
-R10 EQU 10
-R11 EQU 11
-R12 EQU 12
-R13 EQU 13
-R14 EQU 14
-R15 EQU 15
-*
- PRINT NOGEN
-*
-* P R O L O G U E
-*
- USING MXMAD,R15
- B SAVEREGS
- DC AL1(7),CL7'MXMAD' IDENTIFIER
- DC C'2.00' VERSION.MODIFICATION LEVEL
-SAVEREGS STM R14,R12,12(R13)
- LR R4,R13
- CNOP 0,4
- BAL R13,AROUNDSA
-SAVEAREA DC A(EPILOGUE),17F'0'
- DROP R15
- USING SAVEAREA,R13
-AROUNDSA ST R13,8(0,R4)
- ST R4,4(0,R13)
- XC 8(4,R13),8(R13)
-*
- LA 4,0(0)
- LA 5,0(0)
- B TESTIK
-*
-* E N T R Y P O I N T M X M A D 1
-*
- ENTRY MXMAD1 CALL MXMAD1(A,B,C,I,J,K)
- USING MXMAD1,R15
- CNOP 0,4
-MXMAD1 B EP0102
- DC AL1(7),CL7'MXMAD1'
-EP0101 DC A(SAVEAREA)
-EP0102 STM R14,R12,12(R13)
- LR R4,R13
- L R13,EP0101
- ST R13,8(0,R4)
- ST R4,4(0,R13)
- XC 8(4,R13),8(R13)
- DROP R15
-*
- LA 4,0(0)
- LA 5,1(0)
- B TESTIK
-*
-* E N T R Y P O I N T M X M A D 2
-*
- ENTRY MXMAD2 CALL MXMAD2(A,B,C,I,J,K)
- USING MXMAD2,R15
- CNOP 0,4
-MXMAD2 B EP0202
- DC AL1(7),CL7'MXMAD2'
-EP0201 DC A(SAVEAREA)
-EP0202 STM R14,R12,12(R13)
- LR R4,R13
- L R13,EP0201
- ST R13,8(0,R4)
- ST R4,4(0,R13)
- XC 8(4,R13),8(R13)
- DROP R15
-*
- LA 4,1(0)
- LA 5,0(0)
- B TESTIK
-*
-* E N T R Y P O I N T M X M A D 3
-*
- ENTRY MXMAD3 CALL MXMAD3(A,B,C,I,J,K)
- USING MXMAD3,R15
- CNOP 0,4
-MXMAD3 B EP0302
- DC AL1(7),CL7'MXMAD3'
-EP0301 DC A(SAVEAREA)
-EP0302 STM R14,R12,12(R13)
- LR R4,R13
- L R13,EP0301
- ST R13,8(0,R4)
- ST R4,4(0,R13)
- XC 8(4,R13),8(R13)
- DROP R15
-*
- LA 4,1(0)
- LA 5,1(0)
- B TESTIK
-*
-* E N T R Y P O I N T M X M P Y
-*
- ENTRY MXMPY CALL MXMPY(A,B,C,I,J,K)
- USING MXMPY,R15
- CNOP 0,4
-MXMPY B EP0402
- DC AL1(7),CL7'MXMPY'
-EP0401 DC A(SAVEAREA)
-EP0402 STM R14,R12,12(R13)
- LR R4,R13
- L R13,EP0401
- ST R13,8(0,R4)
- ST R4,4(0,R13)
- XC 8(4,R13),8(R13)
- DROP R15
-*
- LA 4,0(0)
- LA 5,0(0)
- B CZERO
-*
-* E N T R Y P O I N T M X M P Y 1
-*
- ENTRY MXMPY1 CALL MXMPY1(A,B,C,I,J,K)
- USING MXMPY1,R15
- CNOP 0,4
-MXMPY1 B EP0502
- DC AL1(7),CL7'MXMPY1'
-EP0501 DC A(SAVEAREA)
-EP0502 STM R14,R12,12(R13)
- LR R4,R13
- L R13,EP0501
- ST R13,8(0,R4)
- ST R4,4(0,R13)
- XC 8(4,R13),8(R13)
- DROP R15
-*
- LA 4,0(0)
- LA 5,1(0)
-*
-CZERO L 10,12(1) I IN REG. 10
- L 10,0(10) I IM REG. 10
- L 15,20(1)
- L 15,0(15) K IN REG. 15
- MR 14,10 I*K IN REG. 15
- LTR 15,15
- BC 9,RETURN1 IF I=0 OR K=0 RETURN
- SLL 15,2(0)
- S 15,FIXVIER I*K-1 IN REG. 15
- L 6,8(1) C
- LA 7,0(0) IC = 1 IN REG. 7
- SDR 0,0 CLEAR FL.REG. 0
-LOOPIC STE 0,0(7,6) C(IC) = 0.
- LA 7,4(7) IC = IC + 1
- CR 7,15
- BC 12,LOOPIC
- B TESTJ
-TESTIK L 10,12(1)
- L 10,0(10) I IM REG. 10
- L 15,20(1)
- L 15,0(15) K IN REG. 15
- MR 14,10 I*K IN REG. 15
- LTR 15,15
- BC 9,RETURN1 IF I=0 OR K=0 RETURN
-TESTJ L 3,16(1)
- L 3,0(3) J IN REG. 3
- LTR 3,3
- BC 9,RETURN1
-STOSA L 15,12(1) I IN REG. 15
- L 15,0(15)
- ST 15,I SAVE I
- L 15,20(1) K IN REG. 15
- L 15,0(15)
- ST 15,K SAVE K
- LTR 4,4
- BC 9,DREI TEST ENTRY
- L 10,I
- SLL 10,2(0) IIA = 4*I IN REG. 10
- MVC IOA,FIXVIER IOA = 4*1
- SLL 3,2(0) 4*J IN REG. 3
- B SIEBEN
-DREI LA 10,4(0) IIA = 1*4
- L 3,16(1) J
- L 3,0(3)
- SLL 3,2(0) 4*J IN REG. 3
- ST 3,IOA IOA = 4*J
-SIEBEN LTR 5,5
- BC 9,NEUN TEST ENTRY
- LA 11,4(0) IIB = 1*4 IN REG. 11
- ST 3,IOB IOB = 4*J
- B DREIZEHN
-NEUN LR 11,15
- SLL 11,2(0) IIB = 4*K IN REG. 11
- MVC IOB,FIXVIER IOB = 1*4
-DREIZEHN MVC IA,FIXNULL IA = 0*1
- LA 7,0(0) IC = 0*1 IN REG. 7
- L 4,0(1) A
- L 5,4(1) B
- L 6,8(1) C
- LA 14,1(0) L = 1 IN REG. 14
-LOOPL L 15,K
- LA 0,0(0) IB=1 IN REG. 0
- LA 12,1(0) M = 1 IN REG. 12
-LOOPM L 8,IA JA = IA IN REG. 8
- LR 9,0 JB = IB IN REG. 9
- LA 1,4(0) N = 1*4 IN REG. 1
- SDR 0,0 CLEAR FL.REG. 0
- SDR 4,4 CLEAR FL.REG. 4
-LOOPN LE 2,0(8,4) A(JA) IN FL.REG. 2
- ME 2,0(9,5)
- ADR 4,2
- AR 8,10 JA = JA + IIA
- AR 9,11 JB = JB + IIB
- LA 1,4(1) INCREASE N
- CR 1,3
- BC 12,LOOPN
- LE 0,0(7,6)
- ADR 0,4
- STE 0,0(7,6) C = C + A*B
- A 0,IOB IB = IB + IOB
-ZWEIDREI LA 7,4(7) IC = IC + 1
- LA 12,1(12) INCREASE M
- CR 12,15
- BC 12,LOOPM
- L 1,IA
- A 1,IOA
- ST 1,IA IA = IA + IOA
- LA 14,1(14) INCREASE L
- L 15,I
- CR 14,15
- BC 12,LOOPL
-*
-* E P I L O G U E
-*
-EPILOGUE EQU *
-RETURN1 EQU *
- L R13,4(0,R13)
- LM R14,R12,12(R13)
- MVI 12(R13),X'FF'
- BR R14
-*
-* D A T A A R E A S
-*
-I DS 1F
-K DS 1F
-FIXVIER DC F'4'
-FIXNULL DC F'0'
-IA DS 1F
-IOA DS 1F
-IOB DS 1F
-*
- END
-* ========================================
-MXMPY2 CSECT
-#if defined(CERNLIB_QMIBMXA)
-* SPLEVEL SET=2
-MXMPY2 AMODE ANY
-MXMPY2 RMODE ANY
-#endif
-R0 EQU 0
-R1 EQU 1
-R2 EQU 2
-R3 EQU 3
-R4 EQU 4
-R5 EQU 5
-R6 EQU 6
-R7 EQU 7
-R8 EQU 8
-R9 EQU 9
-R10 EQU 10
-R11 EQU 11
-R12 EQU 12
-R13 EQU 13
-R14 EQU 14
-R15 EQU 15
-*
- PRINT NOGEN
-*
-* P R O L O G U E
-*
- USING MXMPY2,R15
- B SAVEREGS
- DC AL1(7),CL7'MXMPY2' IDENTIFIER
- DC C'2.00' VERSION.MODIFICATION LEVEL
-SAVEREGS STM R14,R12,12(R13)
- LR R4,R13
- CNOP 0,4
- BAL R13,AROUNDSA
-SAVEAREA DC A(EPILOGUE),17F'0'
- DROP R15
- USING SAVEAREA,R13
-AROUNDSA ST R13,8(0,R4)
- ST R4,4(0,R13)
- XC 8(4,R13),8(R13)
-*
- LA 4,1(0)
- LA 5,0(0)
- B CZERO
-*
-* E N T R Y P O I N T M X M P Y 3
-*
- ENTRY MXMPY3 CALL MXMPY3(A,B,C,I,J,K)
- USING MXMPY3,R15
- CNOP 0,4
-MXMPY3 B EP0102
- DC AL1(7),CL7'MXMPY3'
-EP0101 DC A(SAVEAREA)
-EP0102 STM R14,R12,12(R13)
- LR R4,R13
- L R13,EP0101
- ST R13,8(0,R4)
- ST R4,4(0,R13)
- XC 8(4,R13),8(R13)
- DROP R15
-*
- LA 4,1(0)
- LA 5,1(0)
- B CZERO
-*
-* E N T R Y P O I N T M X M U B
-*
- ENTRY MXMUB CALL MXMUB(A,B,C,I,J,K)
- USING MXMUB,R15
- CNOP 0,4
-MXMUB B EP0202
- DC AL1(7),CL7'MXMUB'
-EP0201 DC A(SAVEAREA)
-EP0202 STM R14,R12,12(R13)
- LR R4,R13
- L R13,EP0201
- ST R13,8(0,R4)
- ST R4,4(0,R13)
- XC 8(4,R13),8(R13)
- DROP R15
-*
- LA 4,0(0)
- LA 5,0(0)
- B CMINUS
-*
-* E N T R Y P O I N T M X M U B 1
-*
- ENTRY MXMUB1 CALL MXMUB1(A,B,C,I,J,K)
- USING MXMUB1,R15
- CNOP 0,4
-MXMUB1 B EP0302
- DC AL1(7),CL7'MXMUB1'
-EP0301 DC A(SAVEAREA)
-EP0302 STM R14,R12,12(R13)
- LR R4,R13
- L R13,EP0301
- ST R13,8(0,R4)
- ST R4,4(0,R13)
- XC 8(4,R13),8(R13)
- DROP R15
-*
- LA 4,0(0)
- LA 5,1(0)
- B CMINUS
-*
-* E N T R Y P O I N T M X M U B 2
-*
- ENTRY MXMUB2 CALL MXMUB2(A,B,C,I,J,K)
- USING MXMUB2,R15
- CNOP 0,4
-MXMUB2 B EP0402
- DC AL1(7),CL7'MXMUB2'
-EP0401 DC A(SAVEAREA)
-EP0402 STM R14,R12,12(R13)
- LR R4,R13
- L R13,EP0401
- ST R13,8(0,R4)
- ST R4,4(0,R13)
- XC 8(4,R13),8(R13)
- DROP R15
-*
- LA 4,1(0)
- LA 5,0(0)
- B CMINUS
-*
-* E N T R Y P O I N T M X M U B 3
-*
- ENTRY MXMUB3 CALL MXMUB3(A,B,C,I,J,K)
- USING MXMUB3,R15
- CNOP 0,4
-MXMUB3 B EP0502
- DC AL1(7),CL7'MXMUB3'
-EP0501 DC A(SAVEAREA)
-EP0502 STM R14,R12,12(R13)
- LR R4,R13
- L R13,EP0501
- ST R13,8(0,R4)
- ST R4,4(0,R13)
- XC 8(4,R13),8(R13)
- DROP R15
-*
- LA 4,1(0)
- LA 5,1(0)
-*
-CMINUS L 10,12(1)
- L 10,0(10) I IM REG. 10
- L 15,20(1)
- L 15,0(15)
- MR 14,10 I*K IN REG. 15
- LTR 15,15
- BC 9,RETURN1 IF I=0 OR K=0 RETURN
- SLL 15,2(0)
- S 15,FIXVIER I*K-1 IN REG. 15
- L 6,8(1)
- LA 7,0(0) IC = 1 IN REG. 7
-LOOPIC1 SER 0,0
- SE 0,0(7,6)
- STE 0,0(7,6)
- LA 7,4(7)
- CR 7,15
- BC 12,LOOPIC1
- B TESTJ
-CZERO L 10,12(1) I IN REG. 10
- L 10,0(10) I IM REG. 10
- L 15,20(1)
- L 15,0(15) K IN REG. 15
- MR 14,10 I*K IN REG. 15
- LTR 15,15
- BC 9,RETURN1 IF I=0 OR K=0 RETURN
- SLL 15,2(0)
- S 15,FIXVIER I*K-1 IN REG. 15
- L 6,8(1) C
- LA 7,0(0) IC = 1 IN REG. 7
- SDR 0,0 CLEAR FL.REG. 0
-LOOPIC STE 0,0(7,6) C(IC) = 0.
- LA 7,4(7) IC = IC + 1
- CR 7,15
- BC 12,LOOPIC
- B TESTJ
-TESTIK L 10,12(1)
- L 10,0(10) I IM REG. 10
- L 15,20(1)
- L 15,0(15) K IN REG. 15
- MR 14,10 I*K IN REG. 15
- LTR 15,15
- BC 9,RETURN1 IF I=0 OR K=0 RETURN
-TESTJ L 3,16(1)
- L 3,0(3) J IN REG. 3
- LTR 3,3
- BC 9,RETURN1
-STOSA L 15,12(1) I IN REG. 15
- L 15,0(15)
- ST 15,I SAVE I
- L 15,20(1) K IN REG. 15
- L 15,0(15)
- ST 15,K SAVE K
- LTR 4,4
- BC 9,DREI TEST ENTRY
- L 10,I
- SLL 10,2(0) IIA = 4*I IN REG. 10
- MVC IOA,FIXVIER IOA = 4*1
- SLL 3,2(0) 4*J IN REG. 3
- B SIEBEN
-DREI LA 10,4(0) IIA = 1*4
- L 3,16(1) J
- L 3,0(3)
- SLL 3,2(0) 4*J IN REG. 3
- ST 3,IOA IOA = 4*J
-SIEBEN LTR 5,5
- BC 9,NEUN TEST ENTRY
- LA 11,4(0) IIB = 1*4 IN REG. 11
- ST 3,IOB IOB = 4*J
- B DREIZEHN
-NEUN LR 11,15
- SLL 11,2(0) IIB = 4*K IN REG. 11
- MVC IOB,FIXVIER IOB = 1*4
-DREIZEHN MVC IA,FIXNULL IA = 0*1
- LA 7,0(0) IC = 0*1 IN REG. 7
- L 4,0(1) A
- L 5,4(1) B
- L 6,8(1) C
- LA 14,1(0) L = 1 IN REG. 14
-LOOPL L 15,K
- LA 0,0(0) IB=1 IN REG. 0
- LA 12,1(0) M = 1 IN REG. 12
-LOOPM L 8,IA JA = IA IN REG. 8
- LR 9,0 JB = IB IN REG. 9
- LA 1,4(0) N = 1*4 IN REG. 1
- SDR 0,0 CLEAR FL.REG. 0
- SDR 4,4 CLEAR FL.REG. 4
-LOOPN LE 2,0(8,4) A(JA) IN FL.REG. 2
- ME 2,0(9,5)
- ADR 4,2
- AR 8,10 JA = JA + IIA
- AR 9,11 JB = JB + IIB
- LA 1,4(1) INCREASE N
- CR 1,3
- BC 12,LOOPN
- LE 0,0(7,6)
- ADR 0,4
- STE 0,0(7,6) C = C + A*B
- A 0,IOB IB = IB + IOB
-ZWEIDREI LA 7,4(7) IC = IC + 1
- LA 12,1(12) INCREASE M
- CR 12,15
- BC 12,LOOPM
- L 1,IA
- A 1,IOA
- ST 1,IA IA = IA + IOA
- LA 14,1(14) INCREASE L
- L 15,I
- CR 14,15
- BC 12,LOOPL
-*
-* E P I L O G U E
-*
-EPILOGUE EQU *
-RETURN1 EQU *
- L R13,4(0,R13)
- LM R14,R12,12(R13)
- MVI 12(R13),X'FF'
- BR R14
-*
-* D A T A A R E A S
-*
-I DS 1F
-K DS 1F
-FIXVIER DC F'4'
-FIXNULL DC F'0'
-IA DS 1F
-IOA DS 1F
-IOB DS 1F
-*
- END
-#ifdef CERNLIB_TCGEN_MXMAD
-#undef CERNLIB_TCGEN_MXMAD
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/mxtrp.s b/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/mxtrp.s
deleted file mode 100644
index 91bd528..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/mxtrp.s
+++ /dev/null
@@ -1,62 +0,0 @@
-*
-* $Id: mxtrp.s,v 1.1.1.1 1996/02/15 17:53:15 mclareni Exp $
-*
-* $Log: mxtrp.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:15 mclareni
-* Kernlib
-*
-*
-MXTRP CSECT
-*
-* CERN PROGLIB# F110 MXTRP .VERSION KERNIBM 0.1 720518
-*
-#if defined(CERNLIB_QMIBMXA)
-* SPLEVEL SET=2
-MXTRP AMODE ANY
-MXTRP RMODE ANY
-#endif
- ENTRY MXTRP CALL MXTRP(A,B,I,J)
- BC 15,12(15)
- DC X'07'
- DC CL7'MXTRP '
- STM 14,12,12(13)
- LR 2,15
- USING MXTRP,2
- ST 13,SA+4
- LR 12,13
- LA 13,SA
- ST 13,8(12)
- L 5,8(1) I
- L 5,0(5) I IN REG. 5
- LTR 5,5
- BC 9,RETURN IF I=0 RETURN
- L 7,12(1) J
- L 7,0(7)
- LTR 7,7
- BC 9,RETURN IF J=0 RETURN
- S 7,EINS
- SLL 7,2(0) 4*(J-1) IN REG. 7
- LA 4,1(0) INKREMENT 1 IN REG. 4
- LA 6,4(0) INKREMENT 4 IN REG. 6
- L 3,0(1) A
- L 8,4(1) B
- LA 9,0(0) IB = 1 IN REG. 9
- LA 10,0(0) K = 1 IN REG. 10
-LOOPK LR 11,10 IA = K IN REG. 11
- LA 12,1(0) L = 1 IN REG. 12
-LOOPL LE 2,0(11,3)
- STE 2,0(9,8) B(IB) = A(IA)
- AR 11,7
- AR 11,6 IA = IA + J
- AR 9,6 IB = IB + 1
- BXLE 12,4,LOOPL
- BXLE 10,6,LOOPK
-RETURN L 13,SA+4
- LM 14,12,12(13)
- BCR 15,14
-SA DS 18F
-EINS DC F'1'
- END
-#ifdef CERNLIB_TCGEN_MXTRP
-#undef CERNLIB_TCGEN_MXTRP
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/mxuty.s b/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/mxuty.s
deleted file mode 100644
index 0bb7eee..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/mxuty.s
+++ /dev/null
@@ -1,62 +0,0 @@
-*
-* $Id: mxuty.s,v 1.1.1.1 1996/02/15 17:53:16 mclareni Exp $
-*
-* $Log: mxuty.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:16 mclareni
-* Kernlib
-*
-*
-MXUTY CSECT
-*
-* CERN PROGLIB# F110 MXUTY .VERSION KERNIBM 0.1 720518
-*
-#if defined(CERNLIB_QMIBMXA)
-* SPLEVEL SET=2
-MXUTY AMODE ANY
-MXUTY RMODE ANY
-#endif
- ENTRY MXUTY CALL MXUTY(A,I)
- BC 15,12(15)
- DC X'07'
- DC CL7'MXUTY '
- STM 14,12,12(13)
- LR 2,15
- USING MXUTY,2
- ST 13,SA+4
- LR 12,13
- LA 13,SA
- ST 13,8(12)
- L 5,4(1) I
- L 5,0(5)
- LTR 5,5
- BC 9,RETURN IF I=0 RETURN
- LA 6,0(0) J = 1 IN REG. 6
- L 7,0(1) A
- LE 2,EINS
- S 5,FIXEINS I - 1 IN REG. 5
- BC 9,SKIP IF I=1 BRANCH TO SKIP
- LA 3,1(0) K = 2 IN REG. 3
- LE 4,NULL
-LOOPK STE 2,0(6,7) A(J) = 1.
- LA 6,4(6)
- LA 8,0(0) L = 1 IN REG. 8
-LOOPL STE 4,0(6,7) A(J) = 0.
- LA 6,4(6)
- LA 8,1(8) INCREASE L
- CR 8,5
- BC 12,LOOPL
- LA 3,1(3) INCREASE K
- CR 3,5 TEST K
- BC 12,LOOPK
-SKIP STE 2,0(6,7) A(J) = 1.
-RETURN L 13,SA+4
- LM 14,12,12(13)
- BCR 15,14
-SA DS 18F
-NULL DC E'0.'
-EINS DC E'1.'
-FIXEINS DC F'1'
- END
-#ifdef CERNLIB_TCGEN_MXUTY
-#undef CERNLIB_TCGEN_MXUTY
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/pkbyt.s b/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/pkbyt.s
deleted file mode 100644
index d58b9e1..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/pkbyt.s
+++ /dev/null
@@ -1,136 +0,0 @@
-*
-* $Id: pkbyt.s,v 1.1.1.1 1996/02/15 17:53:16 mclareni Exp $
-*
-* $Log: pkbyt.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:16 mclareni
-* Kernlib
-*
-*
-PKBYT CSECT
-*
-* CERN PROGLIB# M422 PKBYT .VERSION KERNIBM 2.05 830421
-* ORIG. FEB 83, R.MATTHEWS, CERN/DD
-*
-* CALL PKBYT (IB,X,JX,N,MPACK)
-*
-#if defined(CERNLIB_QMIBMXA)
-* SPLEVEL SET=2
-PKBYT AMODE ANY
-PKBYT RMODE ANY
-#endif
-R0 EQU 0
-R1 EQU 1
-R2 EQU 2
-R3 EQU 3
-R4 EQU 4
-R5 EQU 5
-R6 EQU 6
-R7 EQU 7
-R8 EQU 8
-R9 EQU 9
-R10 EQU 10
-R11 EQU 11
-R12 EQU 12
-R13 EQU 13
-R14 EQU 14
-R15 EQU 15
-*
- PRINT NOGEN
-*
-* P R O L O G U E
-*
- USING PKBYT,R15
- B SAVEREGS
- DC AL1(7),CL7'PKBYT' IDENTIFIER
- DC C'1.00' VERSION.MODIFICATION LEVEL
-SAVEREGS STM R14,R12,12(R13)
- LR R4,R13
- CNOP 0,4
- BAL R13,AROUNDSA
-SAVEAREA DC A(EPILOGUE),17F'0'
- DROP R15
- USING SAVEAREA,R13
-AROUNDSA ST R13,8(0,R4)
- ST R4,4(0,R13)
- XC 8(4,R13),8(R13)
-*
- LM R2,R6,0(R1) R2 -> IB; R3 -> X; R4 -> JX;
-* R5 -> N; R6 -> MPACK
- L R5,0(0,R5) R5 := N
- LTR R5,R5 N .LE. 0 ?
- BNP EPILOGUE YES, BRANCH
-*
- L R7,4(0,R6) R7 := INWORD
- L R6,0(0,R6) R6 := NBITS
- LTR R6,R6 NBITS .GT.0 ?
- BP L1 YES, BRANCH
-*
- LA R6,1 R6 := 1 (NBITS)
- LA R7,32 R7 := 32 (INWORD)
-*
-L1 SR R0,R0 R0 := 0
- L R1,0(0,R4) R1 := JX
- BCTR R1,0
- DR R0,R7
- SLL R1,2
- LA R3,0(R1,R3) R3 -> FIRST TARGET WORD
-*
- LR R1,R0
- MR R0,R6
- LR R8,R1 R8 -> FIRST TARGET 'BYTE' WITHIN WORD
-*
- LR R1,R7
- BCTR R1,0
- MR R0,R6
- LR R7,R1 R7 -> LAST TARGET 'BYTE' WITHIN WORD
-*
- BCTR R5,0
- SLL R5,2
- LA R5,0(R5,R2) R5 -> LAST INPUT WORD
- LA R4,4 R4 := 4
-*
- L R9,=X'FFFFFFFF'
- LR R11,R9
- SR R10,R10
- SLDL R10,0(R6) R10 := MASK TO ISOLATE INPUT 'BYTE'
- LR R12,R11 R11 & R12 := MASK FOR TARGET 'BYTE'
- XR R11,R9 INVERT BITS
- SLL R11,0(R8) SHIFT TO INITIAL POSITION
- XR R11,R9 INVERT BITS
-*
- L R0,0(0,R3) R0 := FIRST TARGET WORD
- B L4
-*
-L2 ST R0,0(0,R3) STORE THE PACKED WORD
- AR R3,R4 R3 -> NEXT TARGET WORD
- L R0,0(0,R3) R0 := NEXT TARGET WORD
- LNR R8,R6 PRIME R8
- LR R11,R12 INITIALISE MASK FOR TARGET 'BYTES'
-*
-L3 BXH R8,R6,L2
-L4 L R1,0(0,R2) R1 := NEXT INPUT WORD
- NR R1,R10 R1 := NEXT INPUT 'BYTE'
- SLL R1,0(R8) SHIFT IT TO THE CORRECT 'BYTE' LOCATION
- NR R0,R11 CREATE A HOLE IN THE TARGET WORD
- XR R11,R9 FLIP BITS
- SLL R11,0(R6) SHIFT FOR NEXT 'BYTE'
- XR R11,R9 FLIP BITS
- OR R0,R1 PACK IT INTO THE TARGET WORD
- BXLE R2,R4,L3 R2 -> NEXT INPUT WORD
-*
- ST R0,0(0,R3) STORE THE FINAL PACKED WORD
-*
-* E P I L O G U E
-*
-EPILOGUE EQU *
- L R13,4(0,R13)
- LM R14,R12,12(R13)
- MVI 12(R13),X'FF'
- BR R14
-*
- LTORG
-*
- END
-#ifdef CERNLIB_TCGEN_PKBYT
-#undef CERNLIB_TCGEN_PKBYT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/rndm.s b/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/rndm.s
deleted file mode 100644
index 629c928..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/rndm.s
+++ /dev/null
@@ -1,86 +0,0 @@
-*
-* $Id: rndm.s,v 1.1.1.1 1996/02/15 17:53:16 mclareni Exp $
-*
-* $Log: rndm.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:16 mclareni
-* Kernlib
-*
-*
-RNDM CSECT
-*
-* CERN PROGLIB# V104 RNDM .VERSION KERNIBM 1.09 820119
-*
-* UNIFORM RANDOM NUMBER GENERATOR FOR IBM 370
-* G.MARSAGLIA, K.ANANTHANARAYANAN, N.PAUL. MCGILL UNIV., MONTREAL
-* ONE-PARAMETER VERSION
-* ADAPTED AT CERN BY T.LINDELOF, SEPT 1977
-* RDMIN MODIFIED BY T LINDELOF AUG 1978
-* RNDM R=RNDM(DUMMY)
-#if defined(CERNLIB_QMIBMXA)
-* SPLEVEL SET=2
-RNDM AMODE ANY
-RNDM RMODE ANY
-#endif
- ENTRY RDMIN CALL RDMIN(I1)
- ENTRY RDMOUT CALL RDMOUT(I1)
- ENTRY IRNDM K=IRNDM(DUMMY)
-REGB EQU 1
-REGC EQU 2
-REGD EQU 3
-*
-* R=RNDM(DUMMY) RESULT IS NORMALIZED FLOATING POINT VALUE
-* UNIFORMLY DISTRIBUTED ON (0.0,1.0).
- USING *,15
- STM REGB,REGD,24(13) SAVE REGISTERS 1,2,3
- L REGD,MCGN LOAD MCGN INTO REGD
- M REGC,MULT AND MULTIPLY BY 69069
- ST REGD,MCGN STORE RESULT,MODULO 2**32, AS NEW 'MCGN'
- SRL REGD,8 SHIFT REGD RIGHT 8 BITS FOR F.P. FRACTION
- AL REGD,CHAR ADD CHARACTERISTIC X'40' INTO FIRST BYTE
- ST REGD,FWD STORE AT FWD, LOAD INTO FPR 0,
- LE 0,FWD AND ADD NORMALIZED TO ZERO
- AE 0,Z LEAVING RESULT 'RNDM' IN FPR 0.
-RETRN1 LM REGB,REGD,24(13)
- BCR 15,14 RETURN
-*
-* K=IRNDM(DUMMY) UNIFORMLY DISTRIBUTED POSITIVE INTEGER.
-*
- USING IRNDM,15
-IRNDM STM REGB,REGD,24(13) SAVE REGISTERS 1,2,3
- L REGD,MCGN LOAD MCGN INTO REGD
- M REGC,MULT AND MULTIPLY BY 69069
- ST REGD,MCGN STORE RESULT,MODULO 2**32, AS NEW 'MCGN'
- SRL REGD,1 SHIFT LEFT 1 BIT,LEAVING SIGN BIT ZERO
- LR 0,REGD AND MOVE RESULT 'IRNDM' TO GPR 0.
-RETRN5 LM REGB,REGD,24(13)
- BCR 15,14 RETURN
-*
-* CALL RDMIN(I1) I1 IS USED FOR STARTING THE
-* SEQUENCE 'MCGN'
- USING RDMIN,15
-RDMIN STM REGB,REGD,24(13) SAVE REGISTERS 1,2,3
- L REGC,0(1) LOAD ADDRESS OF I1 INTO REGC
- L REGC,0(REGC) LOAD VALUE OF I1 INTO REGC
- LTR REGC,REGC
-ST1 ST REGC,MCGN STORE AT 'MCGN'
-RETRN0 LM REGB,REGD,24(13) RESTORE REGISTERS 1,2,3
- BCR 15,14 AND RETURN
-*
-* CALL RDMOUT(I1)
-*
- USING RDMOUT,15
-RDMOUT STM REGB,REGD,24(13) SAVE REGISTERS 1,2,3
- L REGC,0(1) LOAD ADDR. OF I1 INTO REGC
- MVC 0(4,REGC),MCGN MOVE MCGN TO I1
- LM REGB,REGD,24(13) RESTORE REGISTERS 1,2,3
- BCR 15,14 AND RETURN
-*
-* CONSTANTS AND STORAGE RESERVATION
-*
-MCGN DC F'12345'
-X7FF DC X'000007FF'
-MULT DC F'69069'
-CHAR DC X'40000000'
-FWD DC F'0'
-Z DC E'0.0'
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/sbit.s b/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/sbit.s
deleted file mode 100644
index 3ba9685..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/sbit.s
+++ /dev/null
@@ -1,49 +0,0 @@
-*
-* $Id: sbit.s,v 1.1.1.1 1996/02/15 17:53:16 mclareni Exp $
-*
-* $Log: sbit.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:16 mclareni
-* Kernlib
-*
-*
-SBIT CSECT
-*
-* CERN PROGLIB# M421 SBIT .VERSION KERNIBM 0.1 741009
-*
-* CODED FOR FAST EXECUTION H.WATKINS,LIVERPOOL JULY 1974
-#if defined(CERNLIB_QMIBMXA)
-* SPLEVEL SET=2
-SBIT AMODE ANY
-SBIT RMODE ANY
-#endif
- USING *,15
- B BEGIN
- DC X'4'
- DC CL4'SBIT'
-BEGIN STM 2,5,28(13)
- LM 2,4,0(1) R2->A,R3->X,R4->LX
- L 4,0(4) R4=LX
- LTR 4,4
- BNP RET2 RETURN IF LX.LE.0
- L 2,0(2)
- LA 5,1
- NR 5,2 R5 HAS SAME LOW ORDER BIT AS A
- LTR 5,5
- BZ BIT0
-BIT1 SLL 5,63(4)
- O 5,0(3)
- B RET
-BIT0 LA 5,1
- SLL 5,63(4)
- X 5,FF
- N 5,0(3)
-RET ST 5,0(3)
-RET2 LM 2,5,28(13)
- MVI 12(13),X'FF'
- SR 15,15
- BR 14
-FF DC F'-1'
- END
-#ifdef CERNLIB_TCGEN_SBIT
-#undef CERNLIB_TCGEN_SBIT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/sbit0.s b/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/sbit0.s
deleted file mode 100644
index 50d3a9c..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/sbit0.s
+++ /dev/null
@@ -1,48 +0,0 @@
-*
-* $Id: sbit0.s,v 1.1.1.1 1996/02/15 17:53:16 mclareni Exp $
-*
-* $Log: sbit0.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:16 mclareni
-* Kernlib
-*
-*
-SBIT0 CSECT
-*
-* CERN PROGLIB# M421 SBIT0 .VERSION KERNIBM 0.1 720321
-*
-#if defined(CERNLIB_QMIBMXA)
-* SPLEVEL SET=2
-SBIT0 AMODE ANY
-SBIT0 RMODE ANY
-#endif
- ENTRY SBIT0
- BC 15,12(15)
- DC X'07'
- DC CL7'SBIT0 '
- STM 14,12,12(13)
- LR 11,15
- USING SBIT0,11
- ST 13,SA+4
- LR 12,13
- LA 13,SA
- ST 13,8(12)
- L 2,0(1)
- L 3,0(2)
- L 4,4(1)
- L 4,0(4)
- BCTR 4,0
- L 6,FE
- L 7,FF
- SLDL 6,0(4)
- NR 3,6
- ST 3,0(2)
- L 13,SA+4
- LM 14,12,12(13)
- BCR 15,14
-SA DS 18F
-FE DC X'FFFFFFFE'
-FF DC X'FFFFFFFF'
- END
-#ifdef CERNLIB_TCGEN_SBIT0
-#undef CERNLIB_TCGEN_SBIT0
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/sbit1.s b/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/sbit1.s
deleted file mode 100644
index c45ffdb..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/sbit1.s
+++ /dev/null
@@ -1,45 +0,0 @@
-*
-* $Id: sbit1.s,v 1.1.1.1 1996/02/15 17:53:16 mclareni Exp $
-*
-* $Log: sbit1.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:16 mclareni
-* Kernlib
-*
-*
-SBIT1 CSECT
-*
-* CERN PROGLIB# M421 SBIT1 .VERSION KERNIBM 0.1 720321
-*
-#if defined(CERNLIB_QMIBMXA)
-* SPLEVEL SET=2
-SBIT1 AMODE ANY
-SBIT1 RMODE ANY
-#endif
- ENTRY SBIT1
- BC 15,12(15)
- DC X'07'
- DC CL7'SBIT1 '
- STM 14,12,12(13)
- LR 11,15
- USING SBIT1,11
- ST 13,SA+4
- LR 12,13
- LA 13,SA
- ST 13,8(12)
- L 2,0(1)
- L 3,0(2)
- L 4,4(1)
- L 4,0(4)
- BCTR 4,0
- LA 5,1
- SLL 5,0(4)
- OR 3,5
- ST 3,0(2)
- L 13,SA+4
- LM 14,12,12(13)
- BCR 15,14
-SA DS 18F
- END
-#ifdef CERNLIB_TCGEN_SBIT1
-#undef CERNLIB_TCGEN_SBIT1
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/sbyt.s b/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/sbyt.s
deleted file mode 100644
index 6199074..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/sbyt.s
+++ /dev/null
@@ -1,47 +0,0 @@
-*
-* $Id: sbyt.s,v 1.1.1.1 1996/02/15 17:53:16 mclareni Exp $
-*
-* $Log: sbyt.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:16 mclareni
-* Kernlib
-*
-*
-SBYT CSECT
-*
-* CERN PROGLIB# M421 SBYT .VERSION KERNIBM 0.1 741009
-*
-* CODED FOR FAST EXECUTION H.WATKINS,LIVERPOOL JULY 1974
-#if defined(CERNLIB_QMIBMXA)
-* SPLEVEL SET=2
-SBYT AMODE ANY
-SBYT RMODE ANY
-#endif
- USING *,15
- B BEG
- DC X'4'
- DC CL4'SBYT'
-BEG STM 0,7,20(13)
- LM 2,5,0(1) R2->A,R3->X,R4->LX,R5->NBITS
- L 5,0(5) R5=NBITS
- L 4,0(4) R4=LX
- L 0,0(2) R0=A
- SR 1,1
- SRDL 0,0(5) R1 HAS LEFT MOST BITS = BYTE A
- L 6,0(3)
- AR 4,5
- SRDL 6,63(4)
- LR 0,6
- SLDL 0,0(5)
- SLL 7,0(5)
- LR 1,7
- SR 4,5
- SLDL 0,63(4)
- ST 0,0(3)
- LM 0,7,20(13)
- MVI 12(13),X'FF'
- SR 15,15
- BR 14
- END
-#ifdef CERNLIB_TCGEN_SBYT
-#undef CERNLIB_TCGEN_SBYT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/sbytor.s b/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/sbytor.s
deleted file mode 100644
index 61b4578..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/sbytor.s
+++ /dev/null
@@ -1,52 +0,0 @@
-*
-* $Id: sbytor.s,v 1.1.1.1 1996/02/15 17:53:16 mclareni Exp $
-*
-* $Log: sbytor.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:16 mclareni
-* Kernlib
-*
-*
-SBYTOR CSECT
-*
-* CERN PROGLIB# M421 SBYTOR .VERSION KERNIBM 0.1 720321
-*
-#if defined(CERNLIB_QMIBMXA)
-* SPLEVEL SET=2
-SBYTOR AMODE ANY
-SBYTOR RMODE ANY
-#endif
- ENTRY SBYTOR
- BC 15,12(15)
- DC X'07'
- DC CL7'SBYTOR '
- STM 14,12,12(13)
- LR 11,15
- USING SBYTOR,11
- ST 13,SA+4
- LR 12,13
- LA 13,SA
- ST 13,8(12)
- L 2,0(1)
- L 2,0(2)
- L 3,4(1)
- L 4,0(3)
- L 5,8(1)
- L 5,0(5)
- L 6,12(1)
- L 6,0(6)
- LA 7,32
- SR 7,6
- SLL 2,0(7)
- SR 7,5
- LA 7,1(7)
- SRL 2,0(7)
- OR 4,2
- ST 4,0(3)
- L 13,SA+4
- LM 14,12,12(13)
- BCR 15,14
-SA DS 18F
- END
-#ifdef CERNLIB_TCGEN_SBYTOR
-#undef CERNLIB_TCGEN_SBYTOR
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/shft.s b/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/shft.s
deleted file mode 100644
index a2d4929..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/shft.s
+++ /dev/null
@@ -1,40 +0,0 @@
-*
-* $Id: shft.s,v 1.1.1.1 1996/02/15 17:53:16 mclareni Exp $
-*
-* $Log: shft.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:16 mclareni
-* Kernlib
-*
-*
-SHFT CSECT
-*
-* CERN PROGLIB# SHFT .VERSION KERNIBM 0.1 720321
-*
-#if defined(CERNLIB_QMIBMXA)
-* SPLEVEL SET=2
-SHFT AMODE ANY
-SHFT RMODE ANY
-#endif
- ENTRY SHFT CALL SHFT(A,B)
- BC 15,12(15)
- DC X'07'
- DC CL7'SHFT '
- STM 14,12,12(13)
- LR 11,15
- USING SHFT,11
- ST 13,SA+4
- LR 12,13
- LA 13,SA
- ST 13,8(12)
- L 2,0(1) ADR OF A IN REG 2
- L 5,0(2) A IN REG 5
- L 4,4(1)
- L 4,0(4) B IN REG 4
- SRL 4,24 SHIFT B(1) TO RIGHT OF REG 5
- SRDL 4,8 SHIFT BY ONE BYTE
- ST 5,0(2) STORE A
- L 13,SA+4
- LM 14,12,12(13)
- BCR 15,14
-SA DS 18F
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/smxinv.s b/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/smxinv.s
deleted file mode 100644
index d40849c..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/smxinv.s
+++ /dev/null
@@ -1,152 +0,0 @@
-*
-* $Id: smxinv.s,v 1.1.1.1 1996/02/15 17:53:16 mclareni Exp $
-*
-* $Log: smxinv.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:16 mclareni
-* Kernlib
-*
-*
-SMXINV CSECT
-*
-* CERN PROGLIB# F107 SMXINV .VERSION KERNIBM 0.1 720518
-*
-#if defined(CERNLIB_QMIBMXA)
-* SPLEVEL SET=2
-SMXINV AMODE ANY
-SMXINV RMODE ANY
-#endif
- ENTRY SMXINV CALL SMXINV(A,N,IFAIL)
- STM 14,12,12(13)
- LR 2,15
- USING SMXINV,2
- ST 13,SA+4
- LR 12,13
- LA 13,SA
- ST 13,8(12)
- LA 0,0(0) 0 IN REG. 0
- L 15,8(1) ADR. OF IFAIL IN REG. 15
- ST 0,0(15) IFAIL = 0
- L 3,4(1) ADR. OF N IN REG. 3
- L 3,0(3) N IN REG. 3
- SLL 3,1(0) 2*N IN REG. 3
- S 3,FIXEINS 2*N-1 IN REG. 3
- STC 3,INDEX1+1 DEFINE LENGTH OF INDEX
- A 3,FIXEINS 2*N IN REG. 3
- SLL 3,1(0) 4*N IN REG. 3
- MVI INDEX,X'01'
-INDEX1 MVC INDEX+1,INDEX SET INDEX = 1
- L 4,0(1) ADR. OF A IN REG. 4
- LA 5,INDEX ADR. OF INDEX IN REG. 5
- LA 6,RI ADR. OF RI IN REG. 6
- SDR 4,4
- LE 4,TOL TOL IN FL.REG. 4
- LR 14,3
- LA 14,4(14) NP1 = N + 1 IN REG. 14
- LA 7,0(0) I = 0 IN REG. 7
-LOOPI1 SDR 0,0 PIVOT = 0. IN FL.REG. 0
- LA 8,0(0) JJ = 0 IN REG. 8
- LA 9,0(0) ZAEHLER J IN REG. 9
- LA 10,0(0) INDEX J IN REG. 10
-LOOPJ1 CH 0,0(10,5)
- BC 8,EINS9 IF INDEX(J) = 0 GO TO 19
- SDR 2,2
- LE 2,0(8,4) A(JJ) IN FL.REG. 2
- LPDR 2,2 ELM=ABS( A(JJ) ) IN FL.REG. 2
- CDR 2,0
- BC 12,EINS9 IF ELM .LE. PIVOT GO TO 19
- LDR 0,2 PIVOT = ELM IN FL.REG. 2
- LR 11,10 INDEX K = INDEX J IN REG. 11
- LR 12,8 KK = JJ IN REG. 12
-EINS9 AR 8,14 JJ = JJ + NP1 IN REG. 8
- LA 10,2(10) INCREASE INDEX J
- LA 9,4(9) INCREASE ZAEHLER J
- CR 9,3
- BC 4,LOOPJ1
- SDR 6,6
- LE 6,0(4) A(1) IN FL.REG. 6
- LPDR 6,6 ABS( A(1) ) IN FL.REG. 6
- DDR 0,6 PIVOT/ABS( A(1) ) IN FL.REG. 0
- CDR 0,4
- BC 4,EINS00 IF PIVOT/ABS(A(1)) [ TOL GOTO100
- STH 0,0(11,5) INDEX(K) = 0
- SDR 0,0
- SE 0,0(12,4) PIVOT = -A(KK) IN FL.REG. 0
- SLL 11,1(0) K NO MORE INDEX FOR INDEX
- LR 8,11 KJ = K IN REG. 8
- LR 9,3 NP = N IN REG. 9
- LA 10,0(0) J = 0 IN REG. 10
- LA 15,0(0) INDEX J IN REG. 15
-LOOPJ2 CR 11,10
- BC 6,DREI4 IF K .NE. J GO TO 34
- LD 6,FLOATONE
- DDR 6,0 1./PIVOT IN FL.REG. 6
- STE 6,0(8,4) A(KJ) = 1./PIVOT
- SDR 6,6
- STD 6,0(15,6) RI(J) = 0.
- LA 9,4(0) NP = 1 IN REG. 9
- B SIEBEN0
-DREI4 SDR 2,2
- SE 2,0(8,4) ELM = -A(KJ) IN FL.REG. 2
- LDR 6,2
- DDR 6,0 ELM/PIVOT IN FL.REG. 6
- STD 6,0(15,6) RI(J) = ELM/PIVOT
- SDR 6,6
- CDR 2,6
- BC 8,FUENF0 IF ELM=0. GO TO 50
- LR 13,10 JL = J IN REG. 13
- LA 12,0(0) L = 0 IN REG. 12
-LOOPL LD 6,0(12,6) RI(L) IN FL.REG. 6
- MDR 6,2 RI(L)*ELM IN FL.REG. 6
- AE 6,0(13,4) A(JL)+RI(L)*ELM IN FL.REG. 6
- STE 6,0(13,4) A(JL)=A(JL)+ELM*RI(L)
- AR 13,3 JL = JL + N IN REG. 13
- LA 12,8(12) INCREASE L
- CR 12,15
- BC 12,LOOPL
-FUENF0 LD 6,0(15,6) RI(J) IN FL.REG. 6
- STE 6,0(8,4) A(KJ) = RI(J)
-SIEBEN0 AR 8,9 KJ = KJ + NP IN REG. 8
- LA 15,8(15) INCREASE INDEX J
- LA 10,4(10) INCREASE ZAEHLER J
- CR 10,3
- BC 4,LOOPJ2
- LA 7,4(7) INCREASE I
- CR 7,3
- BC 4,LOOPI1
- LA 7,0(0) IJ0 = 0 IN REG. 7
- LA 8,0(0) JI0 = 0 IN REG. 8
- LA 9,0(0) I = 1 IN REG. 9
-LOOPI2 LR 10,7 IJ = IJ0 IN REG. 10
- LR 11,8 JI = JI0 IN REG. 11
- LA 12,0(0) J = 1 IN REG. 12
-LOOPJ3 SER 6,6
- SE 6,0(10,4) -A(IJ) IN FL.REG. 6
- STE 6,0(10,4) A(IJ) = -A(IJ)
- STE 6,0(11,4) A(JI) = A(IJ)
- AR 10,3 IJ = IJ + N IN REG. 10
- LA 11,4(11) JI = JI + 4
- LA 12,4(12) INCREASE J
- CR 12,9
- BC 12,LOOPJ3
- LA 7,4(7) IJ0 = IJ0 + 4
- AR 8,3 JI0 = JI0 + N IN REG. 8
- LA 9,4(9) INCREASE I
- CR 9,3
- BC 4,LOOPI2
- B RETURN
-EINS00 LA 3,1(0)
- L 15,8(1)
- ST 3,0(15) IFAIL = 1
-RETURN L 13,SA+4
- LM 14,12,12(13)
- BCR 15,14
-RI DS 100D
-FLOATONE DC D'1.'
-SA DS 18F
-FIXEINS DC F'1'
-TOL DC E'1.E-12'
-INDEX DS 100H
- END
-#ifdef CERNLIB_TCGEN_SMXINV
-#undef CERNLIB_TCGEN_SMXINV
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/ubits.s b/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/ubits.s
deleted file mode 100644
index 048b980..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/ubits.s
+++ /dev/null
@@ -1,108 +0,0 @@
-*
-* $Id: ubits.s,v 1.1.1.1 1996/02/15 17:53:16 mclareni Exp $
-*
-* $Log: ubits.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:16 mclareni
-* Kernlib
-*
-*
-UBITS CSECT
-*
-* CERN PROGLIB# M503 UBITS .VERSION KERNIBM 2.15 851212
-* ORIG. OCT 81, R.MATTHEWS, M.METCALF, CERN/DD
-*
-* CALL UBITS (STRING,LENGTH,LOCS,NUMBER)
-*
-* FUNCTION: EXAMINE A STRING OF BITS AND STORE THE LOCATIONS OF
-* THE BITS HAVING THE VALUE 1 IN SUCCESSIVE WORDS OF
-* AN ARRAY.
-*
-* ARGUMENTS: STRING - A FULLWORD ARRAY CONTAINING THE BIT STRING
-*
-* LENGTH - THE NUMBER OF BITS IN THE BIT STRING
-*
-* LOCS - AN INTEGER*4 ARRAY TO RECEIVE THE LOCATIONS
-* OF THE BITS WHOSE VALUE IS 1
-*
-* NUMBER - THE NUMBER OF BITS FOUND TO HAVE THE VALUE 1
-*
-#if defined(CERNLIB_QMIBMXA)
-* SPLEVEL SET=2
-UBITS AMODE ANY
-UBITS RMODE ANY
-#endif
-R0 EQU 0
-R1 EQU 1
-R2 EQU 2
-R3 EQU 3
-R4 EQU 4
-R5 EQU 5
-R6 EQU 6
-R7 EQU 7
-R8 EQU 8
-R9 EQU 9
-R10 EQU 10
-R11 EQU 11
-R12 EQU 12
-R13 EQU 13
-R14 EQU 14
-R15 EQU 15
-*
- PRINT NOGEN
-*
-* P R O L O G U E
-*
- USING UBITS,R15
- B SAVEREGS
- DC AL1(7),CL7'UBITS' IDENTIFIER
- DC C'1.01' VERSION.MODIFICATION LEVEL
-SAVEREGS STM R14,R12,12(R13)
- LR R4,R13
- CNOP 0,4
- BAL R13,AROUNDSA
-SAVEAREA DC A(EPILOGUE),17F'0'
- DROP R15
- USING SAVEAREA,R13
-AROUNDSA ST R13,8(0,R4)
- ST R4,4(0,R13)
- XC 8(4,R13),8(R13)
-*
- LM R9,R12,0(R1) R9 -> STRING, R10 -> LENGTH,
-* R11 -> LOCS, R12 -> NUMBER
- SR R5,R5 R5 := 0 (INDEX FOR LOCS)
- SR R4,R4 R4 := 0 (LOOP COUNTER)
- L R3,0(0,R10) R3 := LENGTH (LOOP COMPARAND)
- LA R2,1 R2 := 1 (LOOP INCREMENT)
- LR R8,R2 R8 := 1
-*
-LOOP BXH R4,R2,ALLDONE
- BCT R8,TESTBIT BRANCH UNLESS CURRENT WORD IS EXHAUSTED
-NEWORD L R6,0(0,R9) R6 := NEW WORD OF STRING
- LA R9,4(0,R9) R9 -> NEXT WORD OF STRING
- LA R8,32 PRIME THE COUNTER
-TESTBIT SRDL R6,1 SHIFT LEAST SIGNIFICANT BIT OF R6 INTO R7
- LTR R7,R7 IS IT 1 ?
- BNM TESTWORD NO, BRANCH
- ST R4,0(R5,R11) STORE ITS LOCATION IN LOCS
- LA R5,4(0,R5) INCREMENT THE INDEX FOR LOCS
-TESTWORD LTR R6,R6 ARE THERE ANY MORE 1 BITS IN THE WORD ?
- BNZ LOOP YES, BRANCH TO PROCESS THEM
- AR R4,R8 OTHERWISE INCREMENT THE LOOP COUNTER BY
- SR R4,R2 THE NUMBER OF BITS REMAINING UNTESTED
- BXLE R4,R2,NEWORD AND TEST WHETHER FINISHED
-*
-ALLDONE SRA R5,2 NUMBER = (R5)/4
- ST R5,0(0,R12) STORE NUMBER
-*
-* E P I L O G U E
-*
-EPILOGUE EQU *
- L R13,4(0,R13)
- LM R14,R12,12(R13)
- MVI 12(R13),X'FF'
- BR R14
-*
- END
-#ifdef CERNLIB_TCGEN_UBITS
-#undef CERNLIB_TCGEN_UBITS
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/ubunch.s b/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/ubunch.s
deleted file mode 100644
index 5f1384e..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/ubunch.s
+++ /dev/null
@@ -1,88 +0,0 @@
-*
-* $Id: ubunch.s,v 1.1.1.1 1996/02/15 17:53:17 mclareni Exp $
-*
-* $Log: ubunch.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:17 mclareni
-* Kernlib
-*
-*
-UBUNCH CSECT
-*
-* CERN PROGLIB# M409 UBUNCH .VERSION KERNIBM 0.1 721010
-*
-#if defined(CERNLIB_QMIBMXA)
-* SPLEVEL SET=2
-UBUNCH AMODE ANY
-UBUNCH RMODE ANY
-#endif
- ENTRY UBLOW
- BC 15,12(15) (BLOWNIS REAL*4)
- DC X'7' (BUNCH IS REAL*1)
- DC CL7'UBUNCH '
- STM 2,11,28(13)
- BALR 2,0
- USING *,2
- LM 3,5,0(1) BLOWN,BUNCH,N IN R3,R4,R5
- LA 6,1 J=1
- LA 7,4 K=4
- SR 3,7 R3=BLOWN-K
- SR 4,6 R4=BUNCH-J
- L 5,0(5) R5=N
- SR 11,11
- CR 5,11
- BNH END
- LR 11,5
- SR 10,10
- DR 10,7
- SR 11,11
-LOOP1 L 9,0(3,7) R9=BLOWN(K)
- SLDL 8,8
- STC 8,0(4,6) BUNCH(J)=BLOWN(K)
- LA 6,1(6) J=J+1
- LA 7,4(7) K=K+4
- BCT 5,LOOP1 IF R5 NOT 1 R5=R5-1 , GO TO LOOP1
- CR 10,11
- BE END
- LA 5,4
- SR 5,10
- L 9,BLANKS
-LOOP3 STC 9,0(4,6)
- LA 6,1(6)
- BCT 5,LOOP3
-END LM 2,11,28(13)
- MVI 12(13),X'FF'
- BCR 15,14 RETURN
-UBLOW BC 15,10(15) ENTRY UBLOW(BUNCH,BLOWN,N)
- DC X'5'
- DC CL5'UBLOW'
- STM 2,9,28(13)
- BALR 2,0
- USING *,2
- LM 3,5,0(1) BUNCH,BLOWN,N IN R3,R4,R5
- LA 6,1 J=1
- LA 7,4 K=4
- SR 3,6 R3=BUNCH-J
- SR 4,7 R4=BLOWN-K
- L 5,0(5) R5=N
- SR 9,9
- CR 5,9
- BNH END1
-LOOP2 L 9,BLANKS
- IC 8,0(3,6) R8=BUNCH(J)
- SRDL 8,8
- ST 9,0(4,7)
- LA 6,1(6) J=J+1
- LA 7,4(7) K=K+4
- BCT 5,LOOP2 IF R5 NOT 1 R5=R5-1, GO TO LOOP2
-END1 LM 2,9,28(13)
- MVI 12(13),X'FF'
- BCR 15,14 RETURN
- CNOP 0,4
-BLANKS DC CL4' '
- END
-#ifdef CERNLIB_TCGEN_UBUNCH
-#undef CERNLIB_TCGEN_UBUNCH
-#endif
-#ifdef CERNLIB_TCGEN_UBLOW
-#undef CERNLIB_TCGEN_UBLOW
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/ucocop.s b/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/ucocop.s
deleted file mode 100644
index 180b2c7..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/ucocop.s
+++ /dev/null
@@ -1,59 +0,0 @@
-*
-* $Id: ucocop.s,v 1.1.1.1 1996/02/15 17:53:17 mclareni Exp $
-*
-* $Log: ucocop.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:17 mclareni
-* Kernlib
-*
-*
-UCOCOP CSECT
-*
-* CERN PROGLIB# V302 UCOCOP .VERSION KERNIBM 0.1 720321
-*
-#if defined(CERNLIB_QMIBMXA)
-* SPLEVEL SET=2
-UCOCOP AMODE ANY
-UCOCOP RMODE ANY
-#endif
- ENTRY UCOCOP
- USING *,15
- BC 15,12(15)
- DC X'7'
- DC CL7'UCOCOP '
- STM 14,12,12(13)
- LM 2,7,0(1)
- L 4,0(4) IDO
- LTR 4,4
- BZ RETURN
- L 5,0(5) IW
- LTR 5,5
- BZ RETURN
- L 9,0(7) NB
- L 7,0(6) NA
- SR 7,5 KK
- SR 9,5 LL
- SR 6,6
- SR 8,8
- LA 10,4
- MR 6,10
- MR 8,10
- SR 6,6
- SR 8,8
- CNOP 0,8
-LOOP1 LR 11,5
-LOOP2 L 12,0(2,6)
- ST 12,0(3,8)
- AR 6,10
- AR 8,10
- BCT 11,LOOP2
- AR 6,7
- AR 8,9
- BCT 4,LOOP1
-RETURN DS 0H
- LM 2,12,28(13)
- MVI 12(13),X'FF'
- BCR 15,14
- END ,
-#ifdef CERNLIB_TCGEN_UCOCOP
-#undef CERNLIB_TCGEN_UCOCOP
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/ucopiv.s b/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/ucopiv.s
deleted file mode 100644
index 575c99c..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/ucopiv.s
+++ /dev/null
@@ -1,51 +0,0 @@
-*
-* $Id: ucopiv.s,v 1.1.1.1 1996/02/15 17:53:17 mclareni Exp $
-*
-* $Log: ucopiv.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:17 mclareni
-* Kernlib
-*
-*
-UCOPIV CSECT
-*
-* CERN PROGLIB# V301 UCOPIV .VERSION KERNIBM 0.1 720321
-*
-#if defined(CERNLIB_QMIBMXA)
-* SPLEVEL SET=2
-UCOPIV AMODE ANY
-UCOPIV RMODE ANY
-#endif
- ENTRY UCOPIV CALL UCOPIV(A,B,N)
- BC 15,12(15)
- DC X'07'
- DC CL7'UCOPIV '
- STM 14,12,12(13)
- LR 11,15
- USING UCOPIV,11
- ST 13,SA+4
- LR 12,13
- LA 13,SA
- ST 13,8(12)
- LM 2,4,0(1)
- L 5,0(4)
- LTR 5,5
- BC 8,RETURN
- LA 4,4(0)
- SLA 5,2
- SR 5,4
- SR 6,6
- LA 7,COPY
-COPY LE 0,0(6,2)
- STE 0,0(5,3)
- LA 6,4(6)
- SR 5,4
- BCR 10,7
-RETURN DS 0H
- L 13,SA+4
- LM 14,12,12(13)
- BCR 15,14
-SA DS 18F
- END
-#ifdef CERNLIB_TCGEN_UCOPIV
-#undef CERNLIB_TCGEN_UCOPIV
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/ucopy.s b/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/ucopy.s
deleted file mode 100644
index 8a1803a..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/ucopy.s
+++ /dev/null
@@ -1,48 +0,0 @@
-*
-* $Id: ucopy.s,v 1.1.1.1 1996/02/15 17:53:17 mclareni Exp $
-*
-* $Log: ucopy.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:17 mclareni
-* Kernlib
-*
-*
-UCOPY CSECT
-*
-* CERN PROGLIB# V301 UCOPY .VERSION KERNIBM 0.1 741009
-*
-* CODED FOR FAST EXECUTION H.WATKINS,LIVERPOOL JULY 1974
-#if defined(CERNLIB_QMIBMXA)
-* SPLEVEL SET=2
-UCOPY AMODE ANY
-UCOPY RMODE ANY
-#endif
- USING *,15
- B BEGIN
- DC X'5'
- DC CL5'UCOPY'
-BEGIN STM 0,11,20(13)
- LM 8,10,0(1)
- SR 11,11
- L 10,0(10)
- SRDA 10,3
- LTR 10,10
- BNP BYPASS
-LOOP LM 0,7,0(8)
- STM 0,7,0(9)
- LA 8,32(8)
- LA 9,32(9)
- BCT 10,LOOP
-BYPASS SLDA 10,3
- BNP END
- LM 0,7,0(8)
- BCTR 10,0
- EX 10,STORE
-END LM 0,11,20(13)
- MVI 12(13),X'FF'
- SR 15,15
- BR 14
-STORE STM 0,0,0(9)
- END
-#ifdef CERNLIB_TCGEN_UCOPY
-#undef CERNLIB_TCGEN_UCOPY
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/ucopy2.s b/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/ucopy2.s
deleted file mode 100644
index 14d6e8d..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/ucopy2.s
+++ /dev/null
@@ -1,81 +0,0 @@
-*
-* $Id: ucopy2.s,v 1.1.1.1 1996/02/15 17:53:17 mclareni Exp $
-*
-* $Log: ucopy2.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:17 mclareni
-* Kernlib
-*
-*
-UCOPY2 CSECT
-*
-* CERN PROGLIB# V301 UCOPY2 .VERSION KERNIBM 1.02 780226
-*
-* CODED FOR FAST EXECUTION H.WATKINS,LIVERPOOL JULY 1974
-#if defined(CERNLIB_QMIBMXA)
-* SPLEVEL SET=2
-UCOPY2 AMODE ANY
-UCOPY2 RMODE ANY
-#endif
- USING *,15
- B BEGIN
- DC X'6'
- DC CL6'UCOPY2'
-BEGIN STM 0,12,20(13)
- LM 8,10,0(1) R8->A,R9->X,R10->N
- L 10,0(10)
- LR 12,8
- SR 12,9
- BZ END
- BP COPY
- LR 11,10
- SLL 11,2
- AR 12,11
- BNP COPY
-REVCOPY SR 11,11 END OF A OVERLAPS
- LR 12,10 BEGINNING OF X
- SLL 12,2
- LA 8,0(8,12)
- LA 9,0(9,12)
- SRDA 10,3
- LTR 10,10
- BNP BYPASS1
- LA 12,32
-LOOP1 SR 8,12
- SR 9,12
- LM 0,7,0(8)
- STM 0,7,0(9)
- BCT 10,LOOP1
-BYPASS1 SLDA 10,3
- BNP END
- LR 11,10
- SLL 11,2
- SR 8,11
- SR 9,11
- LM 0,7,0(8)
- BCTR 10,0 REDUCE R10 BY 1 AS STM GOES
- EX 10,STORE FROM R0
- B END
-COPY SR 11,11 NO OVERLAP,OR BEGINNING OF A
- SRDA 10,3 OVERLAPS END OF X
- LA 12,32
- LTR 10,10
- BNP BYPASS
-LOOP LM 0,7,0(8)
- STM 0,7,0(9)
- AR 8,12
- AR 9,12
- BCT 10,LOOP
-BYPASS SLDA 10,3
- BNP END
- LM 0,7,0(8)
- BCTR 10,0 REDUCE R10 BY 1 AS STM GOES
- EX 10,STORE FROM R0
-END LM 0,12,20(13)
- MVI 12(13),X'FF'
- SR 15,15
- BR 14
-STORE STM 0,0,0(9)
- END
-#ifdef CERNLIB_TCGEN_UCOPY2
-#undef CERNLIB_TCGEN_UCOPY2
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/ucopyn.s b/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/ucopyn.s
deleted file mode 100644
index 5621a27..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/ucopyn.s
+++ /dev/null
@@ -1,49 +0,0 @@
-*
-* $Id: ucopyn.s,v 1.1.1.1 1996/02/15 17:53:17 mclareni Exp $
-*
-* $Log: ucopyn.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:17 mclareni
-* Kernlib
-*
-*
-UCOPYN CSECT
-*
-* CERN PROGLIB# V301 UCOPYN .VERSION KERNIBM 1.02 780226
-*
-#if defined(CERNLIB_QMIBMXA)
-* SPLEVEL SET=2
-UCOPYN AMODE ANY
-UCOPYN RMODE ANY
-#endif
- ENTRY UCOPYN CALL UCOPYN (A,B,N)
- BC 15,12(15)
- DC X'07'
- DC CL7'UCOPYN '
- STM 14,12,12(13)
- LR 11,15
- USING UCOPYN,11
- ST 13,SA+4
- LR 12,13
- LA 13,SA
- ST 13,8(12)
- LM 2,4,0(1)
- L 5,0(4)
- LTR 5,5
- BC 8,RETURN
- LA 4,4(0)
- SLA 5,2
- SR 5,4
- SR 6,6
-COPY L 0,0(6,2)
- LCR 0,0
- ST 0,0(6,3)
- BXLE 6,4,COPY
-RETURN DS 0H
- L 13,SA+4
- LM 14,12,12(13)
- BCR 15,14
-SA DS 18F
- END
-#ifdef CERNLIB_TCGEN_UCOPYN
-#undef CERNLIB_TCGEN_UCOPYN
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/ufill.s b/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/ufill.s
deleted file mode 100644
index 71825d6..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/ufill.s
+++ /dev/null
@@ -1,66 +0,0 @@
-*
-* $Id: ufill.s,v 1.1.1.1 1996/02/15 17:53:17 mclareni Exp $
-*
-* $Log: ufill.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:17 mclareni
-* Kernlib
-*
-*
-UFILL CSECT
-*
-* CERN PROGLIB# V300 UFILL .VERSION KERNIBM 1.09 820119
-*
-* CODED FOR FAST EXECUTION H.WATKINS,LIVERPOOL JULY 1974
-* SEPARATED FROM UZERO/UBLANK BY R.MATTHEWS, OCT 81
-*
-#if defined(CERNLIB_QMIBMXA)
-* SPLEVEL SET=2
-UFILL AMODE ANY
-UFILL RMODE ANY
-#endif
- USING *,15
- B BEG1
- DC X'5'
- DC CL5'UFILL'
-BEG1 STM 14,12,12(13)
- L 2,12(1)
- L 2,0(2)
- LM 8,10,0(1)
- BALR 12,0
- USING *,12
- LR 0,2
- LR 1,0
- LR 3,0
- LR 4,0
- LR 5,0
- LR 6,0
- LR 7,0
- L 9,0(9)
- L 10,0(10)
- SR 10,9
- BM END
- BCTR 9,0
- SLL 9,2
- AR 8,9
- LA 9,32
- LA 10,1(10)
- SR 11,11
- SRDA 10,3
- LTR 10,10
- BNP BYPASS
-LOOP STM 0,7,0(8)
- AR 8,9
- BCT 10,LOOP
-BYPASS SLDA 10,3
- BNP END
- BCTR 10,0
- EX 10,MSTOR
-END LM 14,12,12(13)
- MVI 12(13),X'FF' SET RETURN CODE
- SR 15,15
- BR 14 RETURN
-MSTOR STM 0,0,0(8)
- END
-#ifdef CERNLIB_TCGEN_UFILL
-#undef CERNLIB_TCGEN_UFILL
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/uh1toc.s b/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/uh1toc.s
deleted file mode 100644
index b8750b5..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/uh1toc.s
+++ /dev/null
@@ -1,78 +0,0 @@
-*
-* $Id: uh1toc.s,v 1.1.1.1 1996/02/15 17:53:17 mclareni Exp $
-*
-* $Log: uh1toc.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:17 mclareni
-* Kernlib
-*
-*
-UH1TOC CSECT
-*
-* CERN PROGLIB# M409 UH1TOC .VERSION KERNIBM 2.07 831205
-* ORIG. NOV 83, R.MATTHEWS, CERN/DD
-*
-* CALL UH1TOC (V1,VC,NCH)
-*
-#if defined(CERNLIB_QMIBMXA)
-* SPLEVEL SET=2
-UH1TOC AMODE ANY
-UH1TOC RMODE ANY
-#endif
-R0 EQU 0
-R1 EQU 1
-R2 EQU 2
-R3 EQU 3
-R4 EQU 4
-R5 EQU 5
-R6 EQU 6
-R7 EQU 7
-R8 EQU 8
-R9 EQU 9
-R10 EQU 10
-R11 EQU 11
-R12 EQU 12
-R13 EQU 13
-R14 EQU 14
-R15 EQU 15
-*
- PRINT NOGEN
-*
-* P R O L O G U E
-*
- USING UH1TOC,R15
- B SAVEREGS
- DC AL1(7),CL7'UH1TOC' IDENTIFIER
- DC C'1.00' VERSION.MODIFICATION LEVEL
-SAVEREGS STM R14,R12,12(R13)
- LR R4,R13
- CNOP 0,4
- BAL R13,AROUNDSA
-SAVEAREA DC A(EPILOGUE),17F'0'
- DROP R15
- USING SAVEAREA,R13
-AROUNDSA ST R13,8(0,R4)
- ST R4,4(0,R13)
- XC 8(4,R13),8(R13)
-*
- LM R10,R12,0(R1) R10 -> V1; R11 -> VC; R12 -> NCH
- L R12,0(0,R12) R12 := NCH
- LTR R12,R12 NHC=0 ?
- BZ EPILOGUE YES, BRANCH
-*
-LOOP1 IC R2,0(0,R10) GET THE NEXT CHARACTER FROM V1
- STC R2,0(0,R11) STORE IT IN VC
- LA R10,4(0,R10) R10 -> NEXT INPUT WORD
- LA R11,1(0,R11) R11 -> NEXT LOCATION IN VC
- BCT R12,LOOP1 LOOP TO PROCESS THE NEXT CHARACTER
-*
-* E P I L O G U E
-*
-EPILOGUE EQU *
- L R13,4(0,R13)
- LM R14,R12,12(R13)
- MVI 12(R13),X'FF'
- BR R14
- END
-#ifdef CERNLIB_TCGEN_UH1TOC
-#undef CERNLIB_TCGEN_UH1TOC
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/uhtoc.s b/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/uhtoc.s
deleted file mode 100644
index 1428598..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/uhtoc.s
+++ /dev/null
@@ -1,93 +0,0 @@
-*
-* $Id: uhtoc.s,v 1.1.1.1 1996/02/15 17:53:17 mclareni Exp $
-*
-* $Log: uhtoc.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:17 mclareni
-* Kernlib
-*
-*
-UHTOC CSECT
-*
-* CERN PROGLIB# M409 UHTOC .VERSION KERNIBM 2.07 831205
-* ORIG. NOV 83, R.MATTHEWS, CERN/DD
-*
-* CALL UHTOC (VI,NH,VC,NCH)
-*
-#if defined(CERNLIB_QMIBMXA)
-* SPLEVEL SET=2
-UHTOC AMODE ANY
-UHTOC RMODE ANY
-#endif
-R0 EQU 0
-R1 EQU 1
-R2 EQU 2
-R3 EQU 3
-R4 EQU 4
-R5 EQU 5
-R6 EQU 6
-R7 EQU 7
-R8 EQU 8
-R9 EQU 9
-R10 EQU 10
-R11 EQU 11
-R12 EQU 12
-R13 EQU 13
-R14 EQU 14
-R15 EQU 15
-*
- PRINT NOGEN
-*
-* P R O L O G U E
-*
- USING UHTOC,R15
- B SAVEREGS
- DC AL1(7),CL7'UHTOC' IDENTIFIER
- DC C'1.00' VERSION.MODIFICATION LEVEL
-SAVEREGS STM R14,R12,12(R13)
- LR R4,R13
- CNOP 0,4
- BAL R13,AROUNDSA
-SAVEAREA DC A(EPILOGUE),17F'0'
- DROP R15
- USING SAVEAREA,R13
-AROUNDSA ST R13,8(0,R4)
- ST R4,4(0,R13)
- XC 8(4,R13),8(R13)
-*
- LM R9,R12,0(R1) R9 -> VI; R10 -> NH
-* R11 -> VC; R12 -> NCH
- L R10,0(0,R10) R10 := NH
- L R12,0(0,R12) R12 := NCH
- LTR R12,R12 NHC=0 ?
- BZ EPILOGUE YES, BRANCH
- LA R4,4 R4 := 4
- CR R10,R4 IS NH > 4
- BNH LOOP1 NO, BRANCH
- LR R10,R4 DEFAULT NH=4
-*
-LOOP1 L R3,0(0,R9) R3 := NEXT INPUT WORD
- LR R5,R10 R5 := NH
- CR R5,R12 IS NH > NUMBER OF CHARACTERS REMAINING ?
- BNH LOOP2 NO, BRANCH
- LR R5,R12 R5 := NUMBER OF CHARACTERS REMAINING
-*
-LOOP2 SLDL R2,8 SHIFT ONE CHARACTER INTO R2
- STC R2,0(0,R11) STORE IT IN VC
- LA R11,1(0,R11) R11 -> NEXT LOCATION IN VC
- BCT R5,LOOP2 LOOP TO PROCESS THE NEXT CHARACTER
-*
- AR R9,R4 R9 -> NEXT INPUT WORD
- SR R12,R10 R12 := NUMBER OF CHARACTERS REMAINING
- BP LOOP1 LOOP TO PROCESS THE NEXT WORD
-*
-* E P I L O G U E
-*
-EPILOGUE EQU *
- L R13,4(0,R13)
- LM R14,R12,12(R13)
- MVI 12(R13),X'FF'
- BR R14
- END
-#ifdef CERNLIB_TCGEN_UHTOC
-#undef CERNLIB_TCGEN_UHTOC
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/uleft.s b/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/uleft.s
deleted file mode 100644
index bcb5faa..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/uleft.s
+++ /dev/null
@@ -1,111 +0,0 @@
-*
-* $Id: uleft.s,v 1.1.1.1 1996/02/15 17:53:17 mclareni Exp $
-*
-* $Log: uleft.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:17 mclareni
-* Kernlib
-*
-*
-ULEFT CSECT
-*
-* CERN PROGLIB# M410 ULEFT .VERSION KERNIBM 1.09 820119
-*
-#if defined(CERNLIB_QMIBMXA)
-* SPLEVEL SET=2
-ULEFT AMODE ANY
-ULEFT RMODE ANY
-#endif
- USING *,15
- BC 15,10(15)
- DC X'5'
- DC CL5'ULEFT'
- STM 14,12,12(13)
- L 2,0(1)
- L 7,4(1)
- L 9,8(1)
- L 7,0(7)
- L 9,0(9)
- LA 1,1
- LA 4,4
- SR 6,6
- SR 8,8
- MR 6,4 R7=JP
- MR 8,4 R8=JT
- LR 8,7 R9=JR
- SR 2,4
- SR 11,11 NC
- L 3,BLANKS
- CNOP 0,8
-ST12 CR 8,9
- BH RETURN1
- L 10,0(2,8)
- CR 10,3
- BE ST19
- CR 7,8
- BE ST17
- ST 10,0(2,7)
- ST 3,0(2,8)
-ST17 AR 11,1
- AR 7,4
-ST19 AR 8,4
- B ST12
-RETURN1 L 12,NC
- ST 11,0(12)
- DR 6,4
- ST 7,4(12)
- LM 2,12,28(13)
- MVI 12(13),X'FF'
- BCR 15,14
- ENTRY URIGHT
- USING *,15
-URIGHT BC 15,12(15)
- DC X'7'
- DC CL7'URIGHT '
- STM 14,12,12(13)
- L 2,0(1)
- L 7,8(1)
- L 9,4(1)
- L 7,0(7)
- L 9,0(9)
- LA 1,1
- LA 4,4
- SR 6,6
- SR 8,8
- MR 6,4 R7=JP
- MR 8,4 R8=JT
- LR 8,7 R9=JL
- SR 2,4
- SR 11,11 R11=NC
- L 3,BLANKS
- CNOP 0,8
-ST22 CR 8,9
- BL RETURN2
- L 10,0(2,8)
- CR 10,3
- BE ST29
- CR 7,8
- BE ST27
- ST 10,0(2,7)
- ST 3,0(2,8)
-ST27 AR 11,1
- SR 7,4
-ST29 SR 8,4
- B ST22
-RETURN2 L 12,NC
- ST 11,0(12)
- DR 6,4
- ST 7,4(12)
- LM 2,12,28(13)
- MVI 12(13),X'FF'
- BCR 15,14
-NC DC A(SLATE)
-BLANKS DC CL4' '
-SLATE COM
- DS 40F
- END
-#ifdef CERNLIB_TCGEN_ULEFT
-#undef CERNLIB_TCGEN_ULEFT
-#endif
-#ifdef CERNLIB_TCGEN_URIGHT
-#undef CERNLIB_TCGEN_URIGHT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/upkbyt.s b/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/upkbyt.s
deleted file mode 100644
index f7095b6..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/upkbyt.s
+++ /dev/null
@@ -1,121 +0,0 @@
-*
-* $Id: upkbyt.s,v 1.1.1.1 1996/02/15 17:53:18 mclareni Exp $
-*
-* $Log: upkbyt.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:18 mclareni
-* Kernlib
-*
-*
-UPKBYT CSECT
-*
-* CERN PROGLIB# M422 UPKBYT .VERSION KERNIBM 2.05 830421
-* ORIG. FEB 83, R.MATTHEWS, CERN/DD
-*
-* CALL UPKBYT (A,JA,IY,N,MPACK)
-*
-#if defined(CERNLIB_QMIBMXA)
-* SPLEVEL SET=2
-UPKBYT AMODE ANY
-UPKBYT RMODE ANY
-#endif
-R0 EQU 0
-R1 EQU 1
-R2 EQU 2
-R3 EQU 3
-R4 EQU 4
-R5 EQU 5
-R6 EQU 6
-R7 EQU 7
-R8 EQU 8
-R9 EQU 9
-R10 EQU 10
-R11 EQU 11
-R12 EQU 12
-R13 EQU 13
-R14 EQU 14
-R15 EQU 15
-*
- PRINT NOGEN
-*
-* P R O L O G U E
-*
- USING UPKBYT,R15
- B SAVEREGS
- DC AL1(7),CL7'UPKBYT' IDENTIFIER
- DC C'1.00' VERSION.MODIFICATION LEVEL
-SAVEREGS STM R14,R12,12(R13)
- LR R4,R13
- CNOP 0,4
- BAL R13,AROUNDSA
-SAVEAREA DC A(EPILOGUE),17F'0'
- DROP R15
- USING SAVEAREA,R13
-AROUNDSA ST R13,8(0,R4)
- ST R4,4(0,R13)
- XC 8(4,R13),8(R13)
-*
- LM R2,R6,0(R1) R2 -> A; R3 -> JA; R4 -> IY;
-* R5 -> N; R6 -> MPACK
- L R5,0(0,R5) R5 := N
- LTR R5,R5 N .LE. 0 ?
- BNP EPILOGUE YES, BRANCH
-*
- L R7,4(0,R6) R7 := INWORD
- L R6,0(0,R6) R6 := NBITS
- LTR R6,R6 NBITS .GT.0 ?
- BP L1 YES, BRANCH
-*
- LA R6,1 R6 := 1 (NBITS)
- LA R7,32 R7 := 32 (INWORD)
-*
-L1 SR R0,R0
- L R1,0(0,R3) R1 := JA
- BCTR R1,0
- DR R0,R7
- SLL R1,2
- LA R2,0(R1,R2) R2 -> FIRST PACKED WORD
-*
- LR R8,R7
- SR R8,R0 R8 := NUMBER OF 'BYTES' IN FIRST WORD
-*
- LR R1,R0
- MR R0,R6
- L R0,0(0,R2) R0 := FIRST PACKED WORD
- SRL R0,0(R1) SHIFT OUT UNWANTED 'BYTES'
-*
- BCTR R5,0
- SLL R5,2
- LA R5,0(R5,R4) R5 -> LAST TARGET WORD
-*
- LR R3,R4 R3 -> FIRST TARGET WORD
- LA R4,4
- SR R3,R4
-*
- LA R9,32
- SR R9,R6 R9 := NO. OF HIGH ORDER ZEROS IN TARGET
-*
-L2 BXH R3,R4,EPILOGUE R3 -> NEXT TARGET WORD
- SRDL R0,0(R6) SHIFT NEXT 'BYTE' INTO TOP OF R1
- SRL R1,0(R9) SHIFT IT DOWN TO END OF R1
- ST R1,0(0,R3) STORE IT
- BCT R8,L2 BRANCH TO PROCESS THE NEXT 'BYTE'
-*
- AR R2,R4 R2 -> NEXT PACKED WORD
- L R0,0(0,R2) R0 := NEXT PACKED WORD
- LR R8,R7 R8 := NUMBER OF 'BYTES' TO EXTRACT
- B L2
-*
-* E P I L O G U E
-*
-EPILOGUE EQU *
- L R13,4(0,R13)
- LM R14,R12,12(R13)
- MVI 12(R13),X'FF'
- BR R14
-*
- LTORG
-*
- END
-#ifdef CERNLIB_TCGEN_UPKBYT
-#undef CERNLIB_TCGEN_UPKBYT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/uswop.s b/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/uswop.s
deleted file mode 100644
index 5967d0e..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/uswop.s
+++ /dev/null
@@ -1,44 +0,0 @@
-*
-* $Id: uswop.s,v 1.1.1.1 1996/02/15 17:53:18 mclareni Exp $
-*
-* $Log: uswop.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:18 mclareni
-* Kernlib
-*
-*
-USWOP CSECT
-*
-* CERN PROGLIB# V303 USWOP .VERSION KERNIBM 0.1 720321
-*
-#if defined(CERNLIB_QMIBMXA)
-* SPLEVEL SET=2
-USWOP AMODE ANY
-USWOP RMODE ANY
-#endif
- USING *,15
- BC 15,10(15)
- DC X'5'
- DC CL5'USWOP'
- STM 14,8,12(13)
- L 2,0(1)
- L 3,4(1)
- L 4,8(1)
- L 4,0(4)
- LTR 4,4
- BZ RETURN
- LA 6,4
- SR 5,5
-NOCHMAL L 7,0(2,5)
- L 8,0(3,5)
- ST 7,0(3,5)
- ST 8,0(2,5)
- AR 5,6
- BCT 4,NOCHMAL
-RETURN DS 0H
- LM 2,8,28(13)
- MVI 12(13),X'FF'
- BCR 15,14
- END ,
-#ifdef CERNLIB_TCGEN_USWOP
-#undef CERNLIB_TCGEN_USWOP
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/uzero.s b/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/uzero.s
deleted file mode 100644
index 064ebb7..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/uzero.s
+++ /dev/null
@@ -1,76 +0,0 @@
-*
-* $Id: uzero.s,v 1.1.1.1 1996/02/15 17:53:18 mclareni Exp $
-*
-* $Log: uzero.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:18 mclareni
-* Kernlib
-*
-*
-UZERO CSECT
-*
-* CERN PROGLIB# V300 UZERO .VERSION KERNIBM 1.09 820119
-*
-* CODED FOR FAST EXECUTION H.WATKINS,LIVERPOOL JULY 1974
-* SEPARATED FROM UFILL BY R.MATTHEWS, OCT 81
-*
-#if defined(CERNLIB_QMIBMXA)
-* SPLEVEL SET=2
-UZERO AMODE ANY
-UZERO RMODE ANY
-#endif
- ENTRY UBLANK
- USING *,15
- B BEG1
- DC X'5'
- DC CL5'UZERO'
-BEG1 STM 14,12,12(13)
- SR 2,2
- B DO
- USING *,15
-UBLANK B BEG2
- DC X'6'
- DC CL6'UBLANK'
-BEG2 STM 14,12,12(13)
- L 2,=CL4' '
-DO LM 8,10,0(1)
- BALR 12,0
- USING *,12
- LR 0,2
- LR 1,0
- LR 3,0
- LR 4,0
- LR 5,0
- LR 6,0
- LR 7,0
- L 9,0(9)
- L 10,0(10)
- SR 10,9
- BM END
- BCTR 9,0
- SLL 9,2
- AR 8,9
- LA 9,32
- LA 10,1(10)
- SR 11,11
- SRDA 10,3
- LTR 10,10
- BNP BYPASS
-LOOP STM 0,7,0(8)
- AR 8,9
- BCT 10,LOOP
-BYPASS SLDA 10,3
- BNP END
- BCTR 10,0
- EX 10,MSTOR
-END LM 14,12,12(13)
- MVI 12(13),X'FF' SET RETURN CODE
- SR 15,15
- BR 14 RETURN
-MSTOR STM 0,0,0(8)
- END
-#ifdef CERNLIB_TCGEN_UBLANK
-#undef CERNLIB_TCGEN_UBLANK
-#endif
-#ifdef CERNLIB_TCGEN_UZERO
-#undef CERNLIB_TCGEN_UZERO
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/vfill.s b/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/vfill.s
deleted file mode 100644
index 9c58aff..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/vfill.s
+++ /dev/null
@@ -1,60 +0,0 @@
-*
-* $Id: vfill.s,v 1.1.1.1 1996/02/15 17:53:18 mclareni Exp $
-*
-* $Log: vfill.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:18 mclareni
-* Kernlib
-*
-*
-VFILL CSECT
-*
-* CERN PROGLIB# F121 VFILL .VERSION KERNIBM 1.09 820119
-*
-* CODED FOR FAST EXECUTION H.WATKINS,LIVERPOOL JULY 1974
-* SEPARATED FROM VZERO/VBLANK BY R.MATTHEWS, OCT 81
-*
-#if defined(CERNLIB_QMIBMXA)
-* SPLEVEL SET=2
-VFILL AMODE ANY
-VFILL RMODE ANY
-#endif
- USING *,15
- B BEG1
- DC X'5'
- DC CL5'VFILL'
-BEG1 STM 14,12,12(13)
- L 2,8(1)
- L 2,0(2)
- LM 8,9,0(1)
- BALR 12,0
- USING *,12
- LR 0,2
- LR 1,0
- LR 3,0
- LR 4,0
- LR 5,0
- LR 6,0
- LR 7,0
- L 10,0(9)
- LTR 10,10
- BNP END
- SR 11,11
- SRDA 10,3
- LTR 10,10
- BNP BYPASS
-LOOP STM 0,7,0(8)
- LA 8,32(8)
- BCT 10,LOOP
-BYPASS SLDA 10,3
- BNP END
- BCTR 10,0
- EX 10,MSTOR
-END LM 14,12,12(13)
- MVI 12(13),X'FF'
- SR 15,15
- BR 14
-MSTOR STM 0,0,0(8)
- END
-#ifdef CERNLIB_TCGEN_VFILL
-#undef CERNLIB_TCGEN_VFILL
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/vzero.s b/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/vzero.s
deleted file mode 100644
index bd0f79d..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/vzero.s
+++ /dev/null
@@ -1,70 +0,0 @@
-*
-* $Id: vzero.s,v 1.1.1.1 1996/02/15 17:53:18 mclareni Exp $
-*
-* $Log: vzero.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:18 mclareni
-* Kernlib
-*
-*
-VZERO CSECT
-*
-* CERN PROGLIB# F121 VZERO .VERSION KERNIBM 1.09 820119
-*
-* CODED FOR FAST EXECUTION H.WATKINS,LIVERPOOL JULY 1974
-* SEPARATED FROM VZERO/VBLANK BY R.MATTHEWS, OCT 81
-*
-#if defined(CERNLIB_QMIBMXA)
-* SPLEVEL SET=2
-VZERO AMODE ANY
-VZERO RMODE ANY
-#endif
- ENTRY VBLANK
- USING *,15
- B BEG1
- DC X'5'
- DC CL5'VZERO'
-BEG1 STM 14,12,12(13)
- SR 2,2
- B DO
- USING *,15
-VBLANK B BEG2
- DC X'6'
- DC CL6'VBLANK'
-BEG2 STM 14,12,12(13)
- L 2,=CL4' '
-DO LM 8,9,0(1)
- BALR 12,0
- USING *,12
- LR 0,2
- LR 1,0
- LR 3,0
- LR 4,0
- LR 5,0
- LR 6,0
- LR 7,0
- L 10,0(9)
- LTR 10,10
- BNP END
- SR 11,11
- SRDA 10,3
- LTR 10,10
- BNP BYPASS
-LOOP STM 0,7,0(8)
- LA 8,32(8)
- BCT 10,LOOP
-BYPASS SLDA 10,3
- BNP END
- BCTR 10,0
- EX 10,MSTOR
-END LM 14,12,12(13)
- MVI 12(13),X'FF'
- SR 15,15
- BR 14
-MSTOR STM 0,0,0(8)
- END
-#ifdef CERNLIB_TCGEN_VBLANK
-#undef CERNLIB_TCGEN_VBLANK
-#endif
-#ifdef CERNLIB_TCGEN_VZERO
-#undef CERNLIB_TCGEN_VZERO
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/xsetio.F b/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/xsetio.F
deleted file mode 100644
index f153a35..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm360/xsetio.F
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: xsetio.F,v 1.1.1.1 1996/02/15 17:53:18 mclareni Exp $
-*
-* $Log: xsetio.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:18 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE XSETIO
-C
-C CERN PROGLIB# XSETIO .VERSION KERNIBM 1.04 781218
-C
- CALL ERRSET (213,256,-1,1)
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm370/ucopy370.s b/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm370/ucopy370.s
deleted file mode 100644
index 34cb41b..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm370/ucopy370.s
+++ /dev/null
@@ -1,65 +0,0 @@
-*
-* $Id: ucopy370.s,v 1.1.1.1 1996/02/15 17:53:10 mclareni Exp $
-*
-* $Log: ucopy370.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:10 mclareni
-* Kernlib
-*
-*
-UCOPY CSECT
-*
-* CERN PROGLIB# V301 UCOPY .VERSION KERNIBM 1.03 780715
-*
-* CALL UCOPY (A,B,N)
-* CALL UCOPY2 (A,B,N)
-*
-* USES THE MVCL INSTR.
-* MVCL CHECKS ON DESTRUCTIVE OVERLAP OF A AND B
-* ON THAT CONDITION (3), A REVERSE LOOP IS ENTERED.
-* P. M. HEINEN NIJMEGEN SEPT. 73
-*
-#if defined(CERNLIB_QMIBMXA)
-* SPLEVEL SET=2
-UCOPY AMODE ANY
-UCOPY RMODE ANY
-#endif
- ENTRY UCOPY,UCOPY2
- USING *,15
- STM 2,5,28(13)
- LM 3,5,0(1)
- L 5,0(5) N
- LPR 5,5
- BC 8,MVR
- SLL 5,2 N
- LR 2,4 B
- LR 4,3 A
- LR 3,5 N
- MVCL 2,4
- BC 1,MV10 DESTR. OVERLAP
-MVR LM 2,5,28(13)
- BR 14
-* REVERSE LOOP / A(N) TO B(N), A(N-1) TO B(N-1) , ETC.
-MV10 LA 3,4
- LA 2,0(5,2) B(N+1)
- LA 4,0(5,4) A(N+1)
- SRL 5,2 N
-MV12 SR 2,3 B(N)
- SR 4,3 A(N)
- MVC 0(4,2),0(4) A(N) TO B(N)
- BCT 5,MV12
- B MVR
-UCOPY2 EQU UCOPY
- DROP 15
- END
-#ifdef CERNLIB_IBM360_UCOPY
-#undef CERNLIB_IBM360_UCOPY
-#endif
-#ifdef CERNLIB_IBM360_UCOPY2
-#undef CERNLIB_IBM360_UCOPY2
-#endif
-#ifdef CERNLIB_TCGEN_UCOPY
-#undef CERNLIB_TCGEN_UCOPY
-#endif
-#ifdef CERNLIB_TCGEN_UCOPY2
-#undef CERNLIB_TCGEN_UCOPY2
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm370/uzero370.s b/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm370/uzero370.s
deleted file mode 100644
index 51ca20b..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm370/uzero370.s
+++ /dev/null
@@ -1,65 +0,0 @@
-*
-* $Id: uzero370.s,v 1.1.1.1 1996/02/15 17:53:10 mclareni Exp $
-*
-* $Log: uzero370.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:10 mclareni
-* Kernlib
-*
-*
-UZERO CSECT
-*
-* CERN PROGLIB# V300 UZERO .VERSION KERNIBM 1.09 820119
-*
-* CALL UZERO (A,N1,N2)
-* CALL UBLANK (A,N1,N2)
-*
-* ZERO / BLANK ROUTINES. USE THE MVCL INSTR.
-* PROTECTED AGAINST FIELD LENGTH OF ZERO
-* P. M. HEINEN NIJMEGEN SEPT. 73
-* SEPARATED FROM VZERO/VBLANK BY R.MATTHEWS, OCT 81
-*
-#if defined(CERNLIB_QMIBMXA)
-* SPLEVEL SET=2
-UZERO AMODE ANY
-UZERO RMODE ANY
-#endif
- ENTRY UBLANK
- USING *,15
- STM 2,6,28(13)
- SR 5,5
- B ZB10
- DROP 15
- USING *,15
-UBLANK STM 2,6,28(13)
- LA 5,X'40'
- DROP 15
-ZB10 BALR 6,0
- USING *,6
- LM 2,4,0(1)
- L 4,0(4) N2
- L 3,0(3) N1
- S 3,=F'1'
- BC 4,ZBR
- SR 4,3
- BC 12,ZBR
- SLA 3,2
- LA 2,0(3,2) A(N1)
- SLA 4,2
- BC 12,ZBR
- SLL 5,24 PADD CHAR / ZERO LENGTH
- LR 3,4 LENGTH
- LR 4,2 ADRESS
- MVCL 2,4
-ZBR LM 2,6,28(13)
- BR 14
- LTORG
- END
-#ifdef CERNLIB_IBM360_UZERO
-#undef CERNLIB_IBM360_UZERO
-#endif
-#ifdef CERNLIB_TCGEN_UBLANK
-#undef CERNLIB_TCGEN_UBLANK
-#endif
-#ifdef CERNLIB_TCGEN_UZERO
-#undef CERNLIB_TCGEN_UZERO
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm370/vzero370.s b/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm370/vzero370.s
deleted file mode 100644
index 092b3fe..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/ibm370/vzero370.s
+++ /dev/null
@@ -1,57 +0,0 @@
-*
-* $Id: vzero370.s,v 1.1.1.1 1996/02/15 17:53:10 mclareni Exp $
-*
-* $Log: vzero370.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:10 mclareni
-* Kernlib
-*
-*
-VZERO CSECT
-*
-* CERN PROGLIB# F121 VZERO .VERSION KERNIBM 1.09 820119
-*
-* CALL VZERO (A,N)
-* CALL VBLANK (A,N)
-*
-* ZERO / BLANK ROUTINES. USE THE MVCL INSTR.
-* PROTECTED AGAINST FIELD LENGTH OF ZERO
-* P. M. HEINEN NIJMEGEN SEPT. 73
-* SEPARATED FROM UZERO/UBLANK BY R.MATTHEWS, OCT 81
-*
-#if defined(CERNLIB_QMIBMXA)
-* SPLEVEL SET=2
-VZERO AMODE ANY
-VZERO RMODE ANY
-#endif
- ENTRY VBLANK
- USING *,15
- STM 2,6,28(13)
- SR 5,5
- B ZB10
- DROP 15
- USING *,15
-VBLANK STM 2,6,28(13)
- LA 5,X'40'
- DROP 15
-ZB10 BALR 6,0
- USING *,6
- LM 2,3,0(1)
- L 4,0(3) N
- SLA 4,2
- BC 12,ZBR
- SLL 5,24 PADD CHAR / ZERO LENGTH
- LR 3,4 LENGTH
- LR 4,2 ADRESS
- MVCL 2,4
-ZBR LM 2,6,28(13)
- BR 14
- END
-#ifdef CERNLIB_IBM360_VZERO
-#undef CERNLIB_IBM360_VZERO
-#endif
-#ifdef CERNLIB_TCGEN_VBLANK
-#undef CERNLIB_TCGEN_VBLANK
-#endif
-#ifdef CERNLIB_TCGEN_VZERO
-#undef CERNLIB_TCGEN_VZERO
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/inhibit.list b/src/packlib/kernlib/kerngen/obsolete/kernibm/inhibit.list
deleted file mode 100644
index 2eb7628..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/inhibit.list
+++ /dev/null
@@ -1,162 +0,0 @@
-tcgen/lvmin
-tcgen/lvmax
-tcgen/lvmaxa
-tcgen/lvmina
-tcgen/lvsmi
-tcgen/lvsmx
-tcgen/lvsdmi
-tcgen/lvsdmx
-tcgen/lvsimi
-tcgen/lvsimx
-tcgen/ranecu
-ibm360/ubunch
-ibm360/ublow
-tcgen/ubunch
-tcgen/ublow
-tcgen/vadd
-tcgen/vsub
-tcgen/vmul
-tcgen/vbias
-tcgen/vscale
-tcgen/vlinco
-tcgen/vunit
-tcgen/vmatr
-tcgen/vmatl
-tcgen/vcopyn
-tcgen/vfix
-tcgen/vfloat
-tcgen/vexcum
-tcgen/vdist2
-tcgen/vdist
-tcgen/vdot
-tcgen/vdotn2
-tcgen/vdotn
-tcgen/vmod
-tcgen/vasum
-tcgen/vsum
-tcgen/vmaxa
-tcgen/vmax
-tcgen/vmina
-tcgen/vmin
-xvectibm/xinbml
-xvectibm/xinb
-xvect/xinb
-xvectibm/xinbf
-xvect/xinbf
-xvectibm/xinbsml
-xvectibm/xinbs
-xvect/xinbs
-xvect/xinb
-xvect/xinbf
-xvect/xinbs
-xvect/xincf
-xvect/xoutcf
-ibm360/ucopy
-ibm360/ucopy2
-tcgen/ucopy
-tcgen/ucopy2
-ibm360/uzero
-tcgen/ublank
-tcgen/uzero
-ibm360/vzero
-tcgen/vblank
-tcgen/vzero
-tcgen/kerngt
-tcgen/gshow
-tcgen/bitpos
-tcgen/blow
-tcgen/bunch
-tcgen/cbyt
-tcgen/floarg
-tcgen/ibits
-tcgen/ie3fod
-tcgen/ie3fos
-tcgen/ie3tod
-tcgen/ie3tos
-tcgen/incbyt
-tcgen/intarg
-tcgen/iuback
-tcgen/iuforw
-tcgen/iubin
-tcgen/iuchan
-tcgen/iucomp
-tcgen/iufind
-tcgen/iulast
-tcgen/iulook
-tcgen/iunext
-tcgen/iusame
-tcgen/jbit
-tcgen/jbyt
-tcgen/jbytet
-tcgen/locb
-tcgen/locf
-tcgen/mbytet
-tcgen/mbytor
-tcgen/mcbyt
-tcgen/msbit
-tcgen/msbit0
-tcgen/msbit1
-tcgen/msbyt
-tcgen/matin1
-tcgen/mxequ
-tcgen/mxmad
-tcgen/mxtrp
-tcgen/mxuty
-tcgen/pkbyt
-tcgen/sbit
-tcgen/sbit0
-tcgen/sbit1
-tcgen/sbyt
-tcgen/sbytor
-tcgen/smxinv
-tcgen/ubits
-tcgen/ubunch
-tcgen/ublow
-tcgen/ucocop
-tcgen/ucopiv
-tcgen/ucopy
-tcgen/ucopy2
-tcgen/ucopyn
-tcgen/ufill
-tcgen/uhtoc
-tcgen/uh1toc
-tcgen/uleft
-tcgen/uright
-tcgen/upkbyt
-tcgen/uswop
-tcgen/ublank
-tcgen/uzero
-tcgen/vfill
-tcgen/vblank
-tcgen/vzero
-syos/datime
-syos/datimh
-syos/reent
-sycern/abuser
-tcgen/abend
-syos/reent
-syos/reent
-symvs/timexn
-symvs/timex
-tcgen/timed
-tcgen/timel
-tcgen/timex
-symvs/timex
-tcgen/timed
-tcgen/timel
-tcgen/timex
-tcgen/timed
-tcgen/timel
-tcgen/timex
-tcgen/datime
-tcgen/datimh
-tcgen/intrac
-tcgen/noarg
-tcgen/abend
-tcgen/jumpxn
-tcgen/qnexte
-tcgen/traceq
-tcgen/ie3fod
-tcgen/ie3fos
-tcgen/ie3tod
-tcgen/ie3tos
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/kernibm/sycernv.h b/src/packlib/kernlib/kerngen/obsolete/kernibm/kernibm/sycernv.h
deleted file mode 100644
index bdac53f..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/kernibm/sycernv.h
+++ /dev/null
@@ -1,15 +0,0 @@
-*
-* $Id: sycernv.h,v 1.1.1.1 1996/02/15 17:52:59 mclareni Exp $
-*
-* $Log: sycernv.h,v $
-* Revision 1.1.1.1 1996/02/15 17:52:59 mclareni
-* Kernlib
-*
-*
-* This directory was created from kernibm.car patch sycernv
-#if !defined(CERNLIB_SYCERNV)
-
-The material for running under VM/CMS at CERN is found
-on the separate Pam file KERNCMS.
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/kernibm/symvsse.h b/src/packlib/kernlib/kerngen/obsolete/kernibm/kernibm/symvsse.h
deleted file mode 100644
index a470ef5..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/kernibm/symvsse.h
+++ /dev/null
@@ -1,13 +0,0 @@
-*
-* $Id: symvsse.h,v 1.1.1.1 1996/02/15 17:52:59 mclareni Exp $
-*
-* $Log: symvsse.h,v $
-* Revision 1.1.1.1 1996/02/15 17:52:59 mclareni
-* Kernlib
-*
-*
-* This directory was created from kernibm.car patch symvsse
-#ifndef CERNLIB_SYMVS
-#define CERNLIB_SYMVS
-#endif
-* ROUTINES FOR IBM SYSTEM MVS / SE
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/kernibm/symvssp.h b/src/packlib/kernlib/kerngen/obsolete/kernibm/kernibm/symvssp.h
deleted file mode 100644
index ad45c0f..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/kernibm/symvssp.h
+++ /dev/null
@@ -1,13 +0,0 @@
-*
-* $Id: symvssp.h,v 1.1.1.1 1996/02/15 17:53:00 mclareni Exp $
-*
-* $Log: symvssp.h,v $
-* Revision 1.1.1.1 1996/02/15 17:53:00 mclareni
-* Kernlib
-*
-*
-* This directory was created from kernibm.car patch symvssp
-#ifndef CERNLIB_SYMVSSE
-#define CERNLIB_SYMVSSE
-#endif
-* ROUTINES FOR IBM SYSTEM MVS / SP
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/kernibm/symvt.h b/src/packlib/kernlib/kerngen/obsolete/kernibm/kernibm/symvt.h
deleted file mode 100644
index b893aad..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/kernibm/symvt.h
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: symvt.h,v 1.1.1.1 1996/02/15 17:53:00 mclareni Exp $
-*
-* $Log: symvt.h,v $
-* Revision 1.1.1.1 1996/02/15 17:53:00 mclareni
-* Kernlib
-*
-*
-* This directory was created from kernibm.car patch symvt
-#ifndef CERNLIB_SYOS
-#define CERNLIB_SYOS
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/kernibm/syvm.h b/src/packlib/kernlib/kerngen/obsolete/kernibm/kernibm/syvm.h
deleted file mode 100644
index d11fccc..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/kernibm/syvm.h
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: syvm.h,v 1.1.1.1 1996/02/15 17:53:00 mclareni Exp $
-*
-* $Log: syvm.h,v $
-* Revision 1.1.1.1 1996/02/15 17:53:00 mclareni
-* Kernlib
-*
-*
-* This directory was created from kernibm.car patch syvm
-#ifndef CERNLIB_SYVMOS
-#define CERNLIB_SYVMOS
-#endif
-#ifdef CERNLIB_SYOS_DATIME
-#undef CERNLIB_SYOS_DATIME
-#endif
-#ifdef CERNLIB_SYOS_DATIMH
-#undef CERNLIB_SYOS_DATIMH
-#endif
-#ifndef CERNLIB_SYOS_DTZ007
-#define CERNLIB_SYOS_DTZ007
-#endif
-#ifndef CERNLIB_SYOS_NOARG
-#define CERNLIB_SYOS_NOARG
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/obsolete/ie3fod.F b/src/packlib/kernlib/kerngen/obsolete/kernibm/obsolete/ie3fod.F
deleted file mode 100644
index f129912..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/obsolete/ie3fod.F
+++ /dev/null
@@ -1,98 +0,0 @@
-*
-* $Id: ie3fod.F,v 1.1.1.1 1996/02/15 17:53:24 mclareni Exp $
-*
-* $Log: ie3fod.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:24 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE IE3FOD (MS,MT,NDPN,JBAD)
-C
-C CERN PROGLIB# M220 IE3FOD .VERSION KERNIBM 2.20 870601
-
-C- Convert double precision for output with copy
-C- from source in native to target in IEEE data format
-
- DIMENSION MS(99), MT(99)
-
- DOUBLE PRECISION THDB
- DIMENSION THIS(2)
- EQUIVALENCE (THDB,THIS)
- EQUIVALENCE (ITHA,THA,THIS(1)), (ITHB,THB,THIS(2))
-
-C PARAMETER (IBADMS = Z 7FFFFFFF)
- PARAMETER (IBADMS = 2147 483 647)
-C PARAMETER (MSKA24 = Z 00FFFFFF)
- PARAMETER (MSKA24 = 16 777 215)
-C PARAMETER (MSKB24 = Z 00800000)
- PARAMETER (MSKB24 = 8 388 608)
-C PARAMETER (MN2131 = Z 800FFFFF)
- PARAMETER (MN2131 =-2146 435 073)
-C PARAMETER (IBADCS = Z 7F80FE00)
- PARAMETER (IBADCS = 2139 160 064)
-C PARAMETER (IBADCD = Z 7FF01FC0)
- PARAMETER (IBADCD = 2146 443 200)
-C PARAMETER (IOVPCS = Z 7F800000)
- PARAMETER (IOVPCS = 2139 095 040)
-C PARAMETER (IOVPCD = Z 7FF00000)
- PARAMETER (IOVPCD = 2146 435 072)
-C PARAMETER (IOVNCS = Z FF800000)
- PARAMETER (IOVNCS = -8 388 608)
-C PARAMETER (IOVNCD = Z FFF00000)
- PARAMETER (IOVNCD = -1 048 576)
-
-#include "q_andor.inc"
-#include "q_shift.inc"
-
- JFAI = 0
- JMS = 0
- JMT = 0
-
- DO 449 JL=1,NDPN
- ITHA = MS(JMS+1)
- IF (ITHA.EQ.0) GO TO 442
- ITHB = MS(JMS+2)
- JEXP = ISHFTR (ISHFTL(ITHA,1), 25)
- IF (JEXP.EQ.127) GO TO 433
- JSHF = 0
- JMOST = ISHFTR (ISHFTL(ITHA,8), 28)
- IF (JMOST.EQ.0) GO TO 441
- 422 IF (JMOST.EQ.1) GO TO 424
- THDB = THDB / 2.
- JMOST = ISHFTR (JMOST,1)
- JSHF = JSHF + 1
- GO TO 422
-
- 424 JEXP = 4*(JEXP-65) + JSHF + 1023
- ITHA = IOR ( IAND(ITHA,MN2131), ISHFTL(JEXP,20))
- GO TO 447
-
-C-- overflow / NaN
- 433 JFAI = JL
- IF (ITHA.NE.IBADMS) THEN
- JSIGN = ISHFTR (ITHA,31)
- IF (JSIGN.EQ.0) THEN
- ITHA = IOVPCD
- ELSE
- ITHA = IOVNCD
- ENDIF
- ELSE
- ITHA = IBADCD
- ENDIF
- GO TO 442
-
- 441 ITHA = 0
- 442 ITHB = 0
- 447 MT(JMT+1) = ITHA
- MT(JMT+2) = ITHB
- JMT = JMT + 2
- 449 JMS = JMS + 2
-
- JBAD = JFAI
- RETURN
- END
-#ifdef CERNLIB_TCGEN_IE3FOD
-#undef CERNLIB_TCGEN_IE3FOD
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/obsolete/ie3fos.F b/src/packlib/kernlib/kerngen/obsolete/kernibm/obsolete/ie3fos.F
deleted file mode 100644
index ad97b73..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/obsolete/ie3fos.F
+++ /dev/null
@@ -1,101 +0,0 @@
-*
-* $Id: ie3fos.F,v 1.1.1.1 1996/02/15 17:53:24 mclareni Exp $
-*
-* $Log: ie3fos.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:24 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE IE3FOS (MS,MT,NWDO,JBAD)
-C
-C CERN PROGLIB# M220 IE3FOS .VERSION KERNIBM 2.20 870601
-
-C- Convert single precision for output with copy
-C- from source in native to target in IEEE data format
-
- DIMENSION MS(99), MT(99)
-
- DOUBLE PRECISION THDB
- DIMENSION THIS(2)
- EQUIVALENCE (THDB,THIS)
- EQUIVALENCE (ITHA,THA,THIS(1)), (ITHB,THB,THIS(2))
-
-C PARAMETER (IBADMS = Z 7FFFFFFF)
- PARAMETER (IBADMS = 2147 483 647)
-C PARAMETER (MSKA24 = Z 00FFFFFF)
- PARAMETER (MSKA24 = 16 777 215)
-C PARAMETER (MSKB24 = Z 00800000)
- PARAMETER (MSKB24 = 8 388 608)
-C PARAMETER (MN2131 = Z 800FFFFF)
- PARAMETER (MN2131 =-2146 435 073)
-C PARAMETER (IBADCS = Z 7F80FE00)
- PARAMETER (IBADCS = 2139 160 064)
-C PARAMETER (IBADCD = Z 7FF01FC0)
- PARAMETER (IBADCD = 2146 443 200)
-C PARAMETER (IOVPCS = Z 7F800000)
- PARAMETER (IOVPCS = 2139 095 040)
-C PARAMETER (IOVPCD = Z 7FF00000)
- PARAMETER (IOVPCD = 2146 435 072)
-C PARAMETER (IOVNCS = Z FF800000)
- PARAMETER (IOVNCS = -8 388 608)
-C PARAMETER (IOVNCD = Z FFF00000)
- PARAMETER (IOVNCD = -1 048 576)
-
-#include "q_andor.inc"
-#include "q_shift.inc"
-
- JBAD = 0
- JMS = 0
- JMT = 0
-
- 301 DO 349 JL=1,NWDO
- ITHA = MS(JMS+1)
- IF (ITHA.EQ.0) GO TO 347
- JSIGN = ISHFTR (ITHA,31)
- JEXP = ISHFTR (ISHFTL(ITHA,1), 25)
- JMANT = IAND (ITHA,MSKA24)
- IF (JMANT.EQ.0) GO TO 341
- JEXP = 4*(JEXP-64)
- 322 IF (IAND(JMANT,MSKB24).NE.0) GO TO 324
- JMANT = ISHFTL(JMANT,1)
- JEXP = JEXP - 1
- GO TO 322
-
- 324 JEXP = JEXP + 126
- IF (JEXP.LE.0) GO TO 331
- IF (JEXP.GE.255) GO TO 333
- ITHA = IAND (NOT(MSKB24),JMANT)
- ITHA = IOR ( IOR(ITHA,ISHFTL(JEXP,23)), ISHFTL(JSIGN,31))
- GO TO 347
-
-C-- make de-normalized number
- 331 IF (JEXP.LE.-23) GO TO 341
- ITHA = ISHFTR (JMANT,1-JEXP)
- ITHA = IOR (ITHA, ISHFTL(JSIGN,31))
- GO TO 347
-
-C-- overflow / NaN
- 333 JBAD = JL
- IF (ITHA.NE.IBADMS) THEN
- IF (JSIGN.EQ.0) THEN
- ITHA = IOVPCS
- ELSE
- ITHA = IOVNCS
- ENDIF
- ELSE
- ITHA = IBADCS
- ENDIF
- GO TO 347
-
- 341 ITHA = 0
- 347 MT(JMT+1) = ITHA
- JMT = JMT + 1
- 349 JMS = JMS + 1
-
- RETURN
- END
-#ifdef CERNLIB_TCGEN_IE3FOS
-#undef CERNLIB_TCGEN_IE3FOS
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/obsolete/ie3tod.F b/src/packlib/kernlib/kerngen/obsolete/kernibm/obsolete/ie3tod.F
deleted file mode 100644
index 15bff6a..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/obsolete/ie3tod.F
+++ /dev/null
@@ -1,100 +0,0 @@
-*
-* $Id: ie3tod.F,v 1.1.1.1 1996/02/15 17:53:24 mclareni Exp $
-*
-* $Log: ie3tod.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:24 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE IE3TOD (MS,MT,NDPN,JBAD)
-C
-C CERN PROGLIB# M220 IE3TOD .VERSION KERNIBM 2.19 861204
-
-C- Convert double precision for input with copy
-C- from source in IEEE to target in native data format
-
- DIMENSION MS(99), MT(99)
-
- DOUBLE PRECISION THDB
- DIMENSION THIS(2)
- EQUIVALENCE (THDB,THIS)
- EQUIVALENCE (ITHA,THA,THIS(1)), (ITHB,THB,THIS(2))
-
-C PARAMETER (IBADMS = Z 7FFFFFFF)
- PARAMETER (IBADMS = 2147 483 647)
- PARAMETER (JEXMIN = -259, JEXMAX=251)
-C PARAMETER (IOVPMS = Z 7FFFFFF0)
- PARAMETER (IOVPMS = 2147 483 632)
-C PARAMETER (IOVNMS = Z FFFFFFF0)
- PARAMETER (IOVNMS = -16)
- PARAMETER (IBADMD = IBADMS, IBADME = 0)
- PARAMETER (IOVPMD = IOVPMS, IOVNMD = IOVNMS)
-
-#include "q_jbit.inc"
-* Ignoring t=pass
-
- JFAI = 0
- JMS = 0
- JMT = 0
-
- DO 449 JL=1,NDPN
- ITHA = MS(JMS+1)
- IF (ITHA.EQ.0) GO TO 442
- ITHB = MS(JMS+2)
- JSIGN = JBIT (ITHA,32)
- JEXP = JBYT (ITHA,21,11)
- JMANT = JBYT (ITHA, 1,20)
- IF (JEXP.EQ.0) GO TO 431
- IF (JEXP.EQ.2047) GO TO 433
-
- JMANT = JMANT + 1 048 576
- JEXP = JEXP - 1023
- IF (JEXP.GT.JEXMAX) GO TO 432
- 424 IF (JEXP.LT.JEXMIN) GO TO 441
-
- JMANS = JBYT (ITHB,17,16)
- JMANR = JBYT (ITHB, 1,16)
-
- JPRE = ISIGN (48,JEXP)
- THDB = ( DBLE(JMANT)
- + + DBLE(FLOAT(JMANS)*2.**(-16))
- + + DBLE(FLOAT(JMANR)*2.**(-32)) ) * 2.**(JPRE-20)
- THDB = THDB * 2.**(JEXP-JPRE)
- IF (JSIGN.EQ.0) GO TO 447
- THDB = -THDB
- GO TO 447
-
- 431 IF (JMANT.EQ.0) GO TO 441
- JEXP = -1022
- GO TO 424
-
- 432 JMANT = 0
- 433 IF (JMANT.EQ.0) THEN
- IF (JSIGN.EQ.0) THEN
- ITHB = IOVPMD
- ELSE
- ITHB = IOVNMD
- ENDIF
- ELSE
- ITHB = IBADMD
- ENDIF
- JFAI = JL
- ITHA = ITHB
- ITHB = IBADME
- GO TO 447
-
- 441 ITHA = 0
- 442 ITHB = 0
- 447 MT(JMT+1) = ITHA
- MT(JMT+2) = ITHB
- JMT = JMT + 2
- 449 JMS = JMS + 2
-
- JBAD = JFAI
- RETURN
- END
-#ifdef CERNLIB_TCGEN_IE3TOD
-#undef CERNLIB_TCGEN_IE3TOD
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/obsolete/ie3tos.F b/src/packlib/kernlib/kerngen/obsolete/kernibm/obsolete/ie3tos.F
deleted file mode 100644
index ee7f6e4..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/obsolete/ie3tos.F
+++ /dev/null
@@ -1,87 +0,0 @@
-*
-* $Id: ie3tos.F,v 1.1.1.1 1996/02/15 17:53:24 mclareni Exp $
-*
-* $Log: ie3tos.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:24 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE IE3TOS (MS,MT,NWDO,JBAD)
-C
-C CERN PROGLIB# M220 IE3TOS .VERSION KERNIBM 2.19 861204
-
-C- Convert single precision for input with copy
-C- from source in IEEE to target in native data format
-
- DIMENSION MS(99), MT(99)
-
- DOUBLE PRECISION THDB
- DIMENSION THIS(2)
- EQUIVALENCE (THDB,THIS)
- EQUIVALENCE (ITHA,THA,THIS(1)), (ITHB,THB,THIS(2))
-
-C PARAMETER (IBADMS = Z 7FFFFFFF)
- PARAMETER (IBADMS = 2147 483 647)
- PARAMETER (JEXMIN = -259, JEXMAX=251)
-C PARAMETER (IOVPMS = Z 7FFFFFF0)
- PARAMETER (IOVPMS = 2147 483 632)
-C PARAMETER (IOVNMS = Z FFFFFFF0)
- PARAMETER (IOVNMS = -16)
- PARAMETER (IBADMD = IBADMS, IBADME = 0)
- PARAMETER (IOVPMD = IOVPMS, IOVNMD = IOVNMS)
-
-
- JBAD = 0
- JMS = 0
- JMT = 0
-
- 301 DO 349 JL=1,NWDO
- ITHA = MS(JMS+1)
- IF (ITHA.EQ.0) GO TO 347
- JSIGN = JBIT (ITHA,32)
- JEXP = JBYT (ITHA,24,8)
- JMANT = JBYT (ITHA,1,23)
- IF (JEXP.EQ.0) GO TO 331
- IF (JEXP.EQ.255) GO TO 333
- JMANT = JMANT + 8 388 608
- JEXP = JEXP - 127
- JPRE = ISIGN (23,JEXP)
- THA = FLOAT(JMANT) * 2.**(JPRE-23)
- THA = THA * 2.**(JEXP-JPRE)
- IF (JSIGN.EQ.0) GO TO 347
- THA = -THA
- GO TO 347
-
- 331 IF (JMANT.EQ.0) GO TO 341
- THA = FLOAT(JMANT) * 2.**(-63)
- THA = THA * 2.**(-86)
- IF (ITHA .EQ.0) GO TO 347
- IF (JSIGN.EQ.0) GO TO 347
- THA = -THA
- GO TO 347
-
- 333 IF (JMANT.EQ.0) THEN
- IF (JSIGN.EQ.0) THEN
- ITHB = IOVPMS
- ELSE
- ITHB = IOVNMS
- ENDIF
- ELSE
- ITHB = IBADMS
- ENDIF
- JBAD = JL
- ITHA = ITHB
- GO TO 347
-
- 341 ITHA = 0
- 347 MT(JMT+1) = ITHA
- JMT = JMT + 1
- 349 JMS = JMS + 1
-
- RETURN
- END
-#ifdef CERNLIB_TCGEN_IE3TOS
-#undef CERNLIB_TCGEN_IE3TOS
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/prelib/prelib.F b/src/packlib/kernlib/kerngen/obsolete/kernibm/prelib/prelib.F
deleted file mode 100644
index f89435a..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/prelib/prelib.F
+++ /dev/null
@@ -1,191 +0,0 @@
-*
-* $Id: prelib.F,v 1.1.1.1 1996/02/15 17:53:24 mclareni Exp $
-*
-* $Log: prelib.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:24 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- PROGRAM PRELIB
-C PROGRAM PRELIB FOR PRE-LIBRARY PROCESSING OF OBJECT-DECK FILES
-C J.ZOLL & M.SOLDI, PISA, FEB-1976, MODIF. MAR-83
-C modified : Dec. 1986
-C
- COMMON /NAMES/ JMAIN,NMAIN,MAINS(200)
- COMMON /ALIAS/ JCSECT,MCSECT(2), NALIAS,MALIAS(100)
- COMMON /KARD/ MW(20), NAME(3), ISOL, INTG, NCONT
- COMMON /BUF/ KARD(50000)
-C
- LOGICAL*1 MB(80), LNAME(12), LISOL(4), LINTG(4), LCONT(4)
- EQUIVALENCE (MB(1),MW(1)), (LNAME(1),NAME(1)), (LISOL(1),ISOL)
- +, (LINTG(1),INTG), (LCONT(1),NCONT)
-C
- LOGICAL*1 LRAPP(4)
- EQUIVALENCE (LRAPP(1),IRAPP)
- DATA IRAPP / 4H(R) /
-C
- DATA MMESD/Z02C5E2C4/, MMEND/Z02C5D5C4/
- DATA MMMAIN/4HMain/, MMDEC/4HDeck/
- DATA IBLANK/4H /, IQUES/4H????/
-C
-C
-C------- READ NAMES FOR MAIN PROGRAMS
-C
- PRINT 9001
- 9001 FORMAT ('1PROGRAM PRELIB EXECUTING.'/1X)
-C
- JMAIN = 1
- NMAIN = 0
- 21 READ (5,8000,END=24) MAINS(NMAIN+1),MAINS(NMAIN+2)
- IF (MAINS(NMAIN+1).EQ.IBLANK) GO TO 24
- PRINT 9021, MAINS(NMAIN+1),MAINS(NMAIN+2)
- 9021 FORMAT (' Stack Progam name ',2A4)
- NMAIN = NMAIN + 2
- GO TO 21
-C
- 24 IF (NMAIN.NE.0) PRINT 9024
- 9024 FORMAT (1X)
- NDECK = 0
- ISOL = IBLANK
- INTG = 0
- NCONT = 0
-C
-C------- START NEW DECK
-C
- 41 NWKARD = 0
- NALIAS = 0
- JCSECT = 0
- MCSECT(1) = IQUES
- MCSECT(2) = IBLANK
- READ (11,8000,END=91) MW
-C!+
-C PRINT 9841, (MW(J),J= 1,12), (MW(J),J= 1,12)
-C +, (MW(J),J=13,18), (MW(J),J=13,18)
-C9841 FORMAT (1X/4X,12(1X,Z8)/4X,12(5X,A4)/
-C F 1X/22X,6(1X,Z8)/22X,6(5X,A4))
-C!-
- IF (MW(1).EQ.MMEND) GO TO 41
- NDECK = NDECK + 1
- IF (MW(1).EQ.MMESD) GO TO 48
-C
-C---- STORE PREVIOUS CARD, READ NEXT CARD
-C
- 44 IF (NWKARD.GE.50000) GO TO 81
- DO 45 J=1,20
- 45 KARD(NWKARD+J) = MW(J)
- NWKARD = NWKARD + 20
-C
- READ (11,8000,END=96) MW
- IF (MW(1).EQ.MMEND) GO TO 61
- IF (MW(1).NE.MMESD) GO TO 44
-C!+
-C PRINT 9841, (MW(J),J= 1,12), (MW(J),J= 1,12)
-C +, (MW(J),J=13,18), (MW(J),J=13,18)
-C!-
- 48 JW = 5
- JB = 25
-C
-C------- ESD-CARD, TYPES 0/1 ANALYSED ONLY
-C
- LCONT(3)= MB(11)
- LCONT(4)= MB(12)
- NEND = NCONT + 12
-C
- 52 IF (JB.GE.NEND) GO TO 44
- LINTG(4) = MB(JB)
- IF (INTG.NE.0) GO TO 54
- IF (JCSECT.NE.0) GO TO 55
- MCSECT(1)= MW(JW)
- MCSECT(2)= MW(JW+1)
- JCSECT = NWKARD + JW
- GO TO 57
-C
- 54 IF (INTG.NE.1) GO TO 57
- 55 MALIAS(NALIAS+1)= MW(JW)
- MALIAS(NALIAS+2)= MW(JW+1)
- NALIAS = NALIAS + 2
- 57 JW = JW + 4
- JB = JB + 16
- GO TO 52
-C
-C------- END-CARD READ, PUT ALIAS & NAME-CARDS
-C
- 61 CONTINUE
-C!+
-C PRINT 9841, (MW(J),J= 1,12), (MW(J),J= 1,12)
-C!-
- NAME(1) = MCSECT(1)
- NAME(2) = MCSECT(2)
- NAME(3) = IBLANK
- IPDECK = MMDEC
- IF (MW(2).EQ.IBLANK) GO TO 64
- IPDECK = MMMAIN
- IF (JMAIN.GE.NMAIN) GO TO 64
- NAME(1) = MAINS(JMAIN)
- NAME(2) = MAINS(JMAIN+1)
- JMAIN = JMAIN + 2
- IF (JCSECT.EQ.0) GO TO 64
- KARD(JCSECT) = NAME(1)
- KARD(JCSECT+1) = NAME(2)
-C
- 64 PRINT 9064, IPDECK,NAME
- 9064 FORMAT (4X,A4,2X,3A4)
-C
- CALL PREOUT (KARD,NWKARD)
- WRITE (21,8000) MW
-C
-C-- cards ALIAS entry
-C
- IF (NALIAS.EQ.0) GO TO 71
- WRITE (21,9066) (MALIAS(J),J=1,NALIAS)
- PRINT 9067, (MALIAS(J),J=1,NALIAS)
- 9066 FORMAT (8H ALIAS ,2A4)
- 9067 FORMAT (20X,8H ALIAS ,2A4,1X,2A4,1X,2A4,1X,2A4)
-C
-C-- card NAME deck(*) with blank suppression
-C
- 71 JJ = 1
- 75 LISOL(1) = LNAME(JJ)
- IF (ISOL.EQ.IBLANK) GO TO 76
- JJ = JJ + 1
- IF (JJ.LT.9) GO TO 75
-C
- 76 DO 77 J=1,3
- LNAME(JJ) = LRAPP(J)
- 77 JJ = JJ + 1
- WRITE (21,9078) NAME
- 9078 FORMAT (8H NAME ,3A4)
- GO TO 41
-C
-C------- Buffer overflow
-C
- 81 CALL PREOUT (KARD,NWKARD)
- NWKARD = 0
- JCSECT = 0
- GO TO 44
-C
-C------- NORMAL EOF
-C
- 91 PRINT 9091, NDECK
- STOP
-C
-C---- ABNORMAL EOF
-C
- 96 PRINT 9096
- STOP
-C
- 8000 FORMAT (20A4)
- 9091 FORMAT (1H0,I6,' DECKS.')
- 9096 FORMAT (1H0, 3(/1X,12(1H*)),' UNEXPECTED EOF.')
- END
- SUBROUTINE PREOUT (MMM,NW)
-
- DIMENSION MMM(NW)
-
- WRITE (21,8000) MMM
- RETURN
-
- 8000 FORMAT (20A4)
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/qf_ibm/q_andor.inc b/src/packlib/kernlib/kerngen/obsolete/kernibm/qf_ibm/q_andor.inc
deleted file mode 100644
index e5b87b5..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/qf_ibm/q_andor.inc
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: q_andor.inc,v 1.1.1.1 1996/02/15 17:53:02 mclareni Exp $
-*
-* $Log: q_andor.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:53:02 mclareni
-* Kernlib
-*
-*
-*
-* q_andor.inc
-*
-* IAND / IOR / IEOR / NOT are standard on IBM VS
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/qf_ibm/q_shift.inc b/src/packlib/kernlib/kerngen/obsolete/kernibm/qf_ibm/q_shift.inc
deleted file mode 100644
index 2f9b06d..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/qf_ibm/q_shift.inc
+++ /dev/null
@@ -1,13 +0,0 @@
-*
-* $Id: q_shift.inc,v 1.1.1.1 1996/02/15 17:53:02 mclareni Exp $
-*
-* $Log: q_shift.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:53:02 mclareni
-* Kernlib
-*
-*
-*
-* q_shift.inc
-*
- ISHFTL (IZW,NZB) = ISHFT (IZW, NZB)
- ISHFTR (IZW,NZB) = ISHFT (IZW,-NZB)
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/qf_ibm/qf_ibm.h b/src/packlib/kernlib/kerngen/obsolete/kernibm/qf_ibm/qf_ibm.h
deleted file mode 100644
index cfa10b2..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/qf_ibm/qf_ibm.h
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: qf_ibm.h,v 1.1.1.1 1996/02/15 17:53:02 mclareni Exp $
-*
-* $Log: qf_ibm.h,v $
-* Revision 1.1.1.1 1996/02/15 17:53:02 mclareni
-* Kernlib
-*
-*
-* For IBM with VS compiler
-* This directory was created from kernibm.car patch qf_ibm
-#ifndef CERNLIB_B32
-#define CERNLIB_B32
-#endif
-#ifndef CERNLIB_A4
-#define CERNLIB_A4
-#endif
-#ifndef CERNLIB_HEX
-#define CERNLIB_HEX
-#endif
-#ifndef CERNLIB_QMIBM
-#define CERNLIB_QMIBM
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/qf_siem/q_andor.inc b/src/packlib/kernlib/kerngen/obsolete/kernibm/qf_siem/q_andor.inc
deleted file mode 100644
index cd2a833..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/qf_siem/q_andor.inc
+++ /dev/null
@@ -1,15 +0,0 @@
-*
-* $Id: q_andor.inc,v 1.1.1.1 1996/02/15 17:53:02 mclareni Exp $
-*
-* $Log: q_andor.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:53:02 mclareni
-* Kernlib
-*
-*
-*
-* q_andor.inc
-*
- IAND (IZV,IZW) = LAND (IZV, IZW)
- IOR (IZV,IZW) = LOR (IZV, IZW)
- IEOR (IZV,IZW) = LXOR (IZV, IZW)
- NOT (IZW) = LCOMPL (IZW)
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/qf_siem/q_cbyt.inc b/src/packlib/kernlib/kerngen/obsolete/kernibm/qf_siem/q_cbyt.inc
deleted file mode 100644
index cab9e54..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/qf_siem/q_cbyt.inc
+++ /dev/null
@@ -1,14 +0,0 @@
-*
-* $Id: q_cbyt.inc,v 1.1.1.1 1996/02/15 17:53:04 mclareni Exp $
-*
-* $Log: q_cbyt.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:53:04 mclareni
-* Kernlib
-*
-*
-*
-* q_cbyt.inc
-*
- MCBYT (MZ,IZQ,IZW,IZP,NZB) = LOR ( LAND (IZW, LCOMPL(
- + SHFTL (SHFTR(-1,32-NZB), IZP-1)))
- + , SHFTR (SHFTL(SHFTR(MZ,IZQ-1),32-NZB), 33-IZP-NZB) )
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/qf_siem/q_jbit.inc b/src/packlib/kernlib/kerngen/obsolete/kernibm/qf_siem/q_jbit.inc
deleted file mode 100644
index e40e400..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/qf_siem/q_jbit.inc
+++ /dev/null
@@ -1,13 +0,0 @@
-*
-* $Id: q_jbit.inc,v 1.1.1.1 1996/02/15 17:53:03 mclareni Exp $
-*
-* $Log: q_jbit.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:53:03 mclareni
-* Kernlib
-*
-*
-*
-* q_jbit.inc
-*
- JBIT (IZW,IZP) = SHFTR (SHFTL(IZW,32-IZP), 31)
- JBYT (IZW,IZP,NZB)= SHFTR (SHFTL(IZW,33-IZP-NZB), 32-NZB)
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/qf_siem/q_jbytet.inc b/src/packlib/kernlib/kerngen/obsolete/kernibm/qf_siem/q_jbytet.inc
deleted file mode 100644
index 2f16760..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/qf_siem/q_jbytet.inc
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: q_jbytet.inc,v 1.1.1.1 1996/02/15 17:53:04 mclareni Exp $
-*
-* $Log: q_jbytet.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:53:04 mclareni
-* Kernlib
-*
-*
-*
-* q_jbytet.inc
-*
- JBYTET (MZ,IZW,IZP,NZB) = LAND (MZ,
- + SHFTR (SHFTL(IZW,33-IZP-NZB), 32-NZB) )
- JBYTOR (MZ,IZW,IZP,NZB) = LOR (MZ,
- + SHFTR (SHFTL(IZW,33-IZP-NZB), 32-NZB) )
- MBYTET (MZ,IZW,IZP,NZB) = LAND (IZW, LCOMPL(SHFTR (
- + SHFTL(LCOMPL(MZ),32-NZB), 33-IZP-NZB)) )
- MBYTOR (MZ,IZW,IZP,NZB) = LOR (IZW, SHFTR (
- + SHFTL(MZ,32-NZB), 33-IZP-NZB) )
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/qf_siem/q_sbit.inc b/src/packlib/kernlib/kerngen/obsolete/kernibm/qf_siem/q_sbit.inc
deleted file mode 100644
index e4d0f48..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/qf_siem/q_sbit.inc
+++ /dev/null
@@ -1,15 +0,0 @@
-*
-* $Id: q_sbit.inc,v 1.1.1.1 1996/02/15 17:53:03 mclareni Exp $
-*
-* $Log: q_sbit.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:53:03 mclareni
-* Kernlib
-*
-*
-*
-* q_sbit.inc
-*
- MSBIT0 (IZW,IZP) = LAND (IZW, LCOMPL(SHFTL(1,IZP-1)) )
- MSBIT1 (IZW,IZP) = LOR (IZW, SHFTL(1,IZP-1) )
- MSBIT (MZ,IZW,IZP) = LOR (LAND (IZW, LCOMPL(SHFTL(1,IZP-1)) )
- + , SHFTL(LAND(MZ,1),IZP-1) )
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/qf_siem/q_sbyt.inc b/src/packlib/kernlib/kerngen/obsolete/kernibm/qf_siem/q_sbyt.inc
deleted file mode 100644
index 2bcdd10..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/qf_siem/q_sbyt.inc
+++ /dev/null
@@ -1,14 +0,0 @@
-*
-* $Id: q_sbyt.inc,v 1.1.1.1 1996/02/15 17:53:04 mclareni Exp $
-*
-* $Log: q_sbyt.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:53:04 mclareni
-* Kernlib
-*
-*
-*
-* q_sbyt.inc
-*
- MSBYT (MZ,IZW,IZP,NZB) = LOR ( LAND (IZW, LCOMPL(
- + SHFTL (SHFTR(-1,32-NZB), IZP-1)))
- + , SHFTR (SHFTL(MZ,32-NZB), 33-IZP-NZB) )
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/qf_siem/q_shift.inc b/src/packlib/kernlib/kerngen/obsolete/kernibm/qf_siem/q_shift.inc
deleted file mode 100644
index 353171f..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/qf_siem/q_shift.inc
+++ /dev/null
@@ -1,13 +0,0 @@
-*
-* $Id: q_shift.inc,v 1.1.1.1 1996/02/15 17:53:02 mclareni Exp $
-*
-* $Log: q_shift.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:53:02 mclareni
-* Kernlib
-*
-*
-*
-* q_shift.inc
-*
- ISHFTL (IZW,NZB) = SHFTL (IZW, NZB)
- ISHFTR (IZW,NZB) = SHFTR (IZW, NZB)
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/qf_siem/qf_siem.h b/src/packlib/kernlib/kerngen/obsolete/kernibm/qf_siem/qf_siem.h
deleted file mode 100644
index 490e2b5..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/qf_siem/qf_siem.h
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: qf_siem.h,v 1.1.1.1 1996/02/15 17:53:04 mclareni Exp $
-*
-* $Log: qf_siem.h,v $
-* Revision 1.1.1.1 1996/02/15 17:53:04 mclareni
-* Kernlib
-*
-*
-* For IBM with SIEMENS compiler
-* This directory was created from kernibm.car patch qf_siem
-#ifndef CERNLIB_B32
-#define CERNLIB_B32
-#endif
-#ifndef CERNLIB_A4
-#define CERNLIB_A4
-#endif
-#ifndef CERNLIB_HEX
-#define CERNLIB_HEX
-#endif
-#ifndef CERNLIB_QMIBM
-#define CERNLIB_QMIBM
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/lvmax.s b/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/lvmax.s
deleted file mode 100644
index 31b1e88..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/lvmax.s
+++ /dev/null
@@ -1,55 +0,0 @@
-*
-* $Id: lvmax.s,v 1.1.1.1 1996/02/15 17:53:04 mclareni Exp $
-*
-* $Log: lvmax.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:04 mclareni
-* Kernlib
-*
-*
-LVMAX CSECT
-* CERN PROGLIB# F121 LVMAX .VERSION KERNIBM 2.27 890622
-* ORIG. 29/05/89 C.Guerin, IBM
-*
-#if defined(CERNLIB_QMIBMXA)
-LVMAX AMODE ANY
-LVMAX RMODE ANY
-#endif
- USING *,15
- STM 14,05,12(13)
-*
- LM G4,G5,0(G1) GET ADDRESSES
- L G5,0(G5) GET LEN
- LTR G5,G5 TEST IF LEN = 0
- BZ ZERO IF LEN = 0 GO TO ZERO
- LE F0,KF GET MAX NEGATIVE
- LA G0,1 GET 1
- SR G2,G2 ZERO G2 FOR WORK
- SR G3,G3 ZERO G3 FOR WORK
-VLOOP EQU *
- VLVCU G5 SET LOOP
- VLE V0,G4 LOAD V0 WITH A VECTOR
- VMXSE V0,F0,G2 FIND MAXIMUM IN G2
- BC 2,VLOOP LOOP
- AR G0,G2 ADD 1
-* END SUBROUTINE *
-RETURN EQU *
- LM 2,05,28(13) RETURN
- BR 14
-ZERO EQU *
- SR G0,G0
- B RETURN
-* CONSTANTS *
- DS 0D
-KF DC X'FFFFFFFF'
-V0 EQU 0
-G0 EQU 0
-G1 EQU 1
-G2 EQU 2
-G3 EQU 3
-G4 EQU 4
-G5 EQU 5
-F0 EQU 0
- END
-#ifdef CERNLIB_TCGEN_LVMAX
-#undef CERNLIB_TCGEN_LVMAX
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/lvmaxa.s b/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/lvmaxa.s
deleted file mode 100644
index d5c6186..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/lvmaxa.s
+++ /dev/null
@@ -1,55 +0,0 @@
-*
-* $Id: lvmaxa.s,v 1.1.1.1 1996/02/15 17:53:04 mclareni Exp $
-*
-* $Log: lvmaxa.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:04 mclareni
-* Kernlib
-*
-*
-LVMAXA CSECT
-* CERN PROGLIB# F121 LVMAXA .VERSION KERNIBM 2.27 890622
-* ORIG. 29/05/89 C.Guerin, IBM
-*
-#if defined(CERNLIB_QMIBMXA)
-LVMAXA AMODE ANY
-LVMAXA RMODE ANY
-#endif
- USING *,15
- STM 14,05,12(13)
-*
- LM G4,G5,0(G1) GET ADDRESSES
- L G5,0(G5) GET LEN
- LTR G5,G5 TEST IF LEN = 0
- BZ ZERO IF LEN = 0 GO TO ZERO
- LE F0,KF GET MAX NEGATIVE
- LA G0,1 GET 1
- SR G2,G2 ZERO G2 FOR WORK
- SR G3,G3 ZERO G3 FOR WORK
-VLOOP EQU *
- VLVCU G5 SET LOOP
- VLE V0,G4 LOAD V0 WITH A VECTOR
- VMXAE V0,F0,G2 FIND MAXIMUM ABSOLUTE IN G2
- BC 2,VLOOP LOOP
- AR G0,G2 ADD 1
-* END SUBROUTINE *
-RETURN EQU *
- LM 2,05,28(13) RETURN
- BR 14
-ZERO EQU *
- SR G0,G0
- B RETURN
-* CONSTANTS *
- DS 0D
-KF DC X'00000000'
-V0 EQU 0
-G0 EQU 0
-G1 EQU 1
-G2 EQU 2
-G3 EQU 3
-G4 EQU 4
-G5 EQU 5
-F0 EQU 0
- END
-#ifdef CERNLIB_TCGEN_LVMAXA
-#undef CERNLIB_TCGEN_LVMAXA
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/lvmin.s b/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/lvmin.s
deleted file mode 100644
index f17dbbb..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/lvmin.s
+++ /dev/null
@@ -1,55 +0,0 @@
-*
-* $Id: lvmin.s,v 1.1.1.1 1996/02/15 17:53:04 mclareni Exp $
-*
-* $Log: lvmin.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:04 mclareni
-* Kernlib
-*
-*
-LVMIN CSECT
-* CERN PROGLIB# F121 LVMIN .VERSION KERNIBM 2.27 890622
-* ORIG. 29/05/89 C.Guerin, IBM
-*
-#if defined(CERNLIB_QMIBMXA)
-LVMIN AMODE ANY
-LVMIN RMODE ANY
-#endif
- USING *,15
- STM 14,05,12(13)
-*
- LM G4,G5,0(G1) GET ADDRESSES
- L G5,0(G5) GET LEN
- LTR G5,G5 TEST IF LEN = 0
- BZ ZERO IF LEN= 0 GO TO ZERO
- LE F0,KF GET MAX POSITIVE
- LA G0,1 GET 1
- SR G2,G2 ZERO G2 FOR WORK
- SR G3,G3 ZERO G3 FOR WORK
-VLOOP EQU *
- VLVCU G5 SET LOOP
- VLE V0,G4 LOAD V0 WITH A VECTOR
- VMNSE V0,F0,G2 FIND MINIMUM IN G2
- BC 2,VLOOP LOOP
- AR G0,G2 ADD 1
-* END SUBROUTINE *
-RETURN EQU *
- LM 2,05,28(13) RETURN
- BR 14
-ZERO EQU *
- SR G0,G0
- B RETURN
-* CONSTANTS *
- DS 0D
-KF DC X'7FFFFFFF'
-V0 EQU 0
-G0 EQU 0
-G1 EQU 1
-G2 EQU 2
-G3 EQU 3
-G4 EQU 4
-G5 EQU 5
-F0 EQU 0
- END
-#ifdef CERNLIB_TCGEN_LVMIN
-#undef CERNLIB_TCGEN_LVMIN
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/lvmina.s b/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/lvmina.s
deleted file mode 100644
index 30721b7..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/lvmina.s
+++ /dev/null
@@ -1,56 +0,0 @@
-*
-* $Id: lvmina.s,v 1.1.1.1 1996/02/15 17:53:04 mclareni Exp $
-*
-* $Log: lvmina.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:04 mclareni
-* Kernlib
-*
-*
-LVMINA CSECT
-* CERN PROGLIB# F121 LVMINA .VERSION KERNIBM 2.27 890622
-* ORIG. 29/05/89 C.Guerin, IBM
-*
-#if defined(CERNLIB_QMIBMXA)
-LVMINA AMODE ANY
-LVMINA RMODE ANY
-#endif
- USING *,15
- STM 14,05,12(13)
-*
- LM G4,G5,0(G1) GET ADDRESSES
- L G5,0(G5) GET LEN
- LTR G5,G5 TEST IF LEN = 0
- BZ ZERO IF LEN = 0 GO TO ZERO
- LE F0,KF GET MAXIMUM POSITIVE
- LA G0,1 GET 1
- SR G2,G2 ZERO G2 FOR WORK
- SR G3,G3 ZERO G3 FOR WORK
-VLOOP EQU *
- VLVCU G5 SET LOOP
- VLE V0,G4 LOAD V0 WITH A VECTOR
- VLPER V0,V0 CONVERT TO ABSOLUTE VALUE
- VMNSE V0,F0,G2 FIND MINIMUM IN G2
- BC 2,VLOOP LOOP
- AR G0,G2 ADD 1
-* END SUBROUTINE *
-RETURN EQU *
- LM 2,05,28(13) RETURN
- BR 14
-ZERO EQU *
- SR G0,G0
- B RETURN
-* CONSTANTS *
- DS 0D
-KF DC X'7FFFFFFF'
-V0 EQU 0
-G0 EQU 0
-G1 EQU 1
-G2 EQU 2
-G3 EQU 3
-G4 EQU 4
-G5 EQU 5
-F0 EQU 0
- END
-#ifdef CERNLIB_TCGEN_LVMINA
-#undef CERNLIB_TCGEN_LVMINA
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/lvsdmi.s b/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/lvsdmi.s
deleted file mode 100644
index f79612c..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/lvsdmi.s
+++ /dev/null
@@ -1,58 +0,0 @@
-*
-* $Id: lvsdmi.s,v 1.1.1.1 1996/02/15 17:53:04 mclareni Exp $
-*
-* $Log: lvsdmi.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:04 mclareni
-* Kernlib
-*
-*
-LVSDMI CSECT
-* CERN PROGLIB# F121 LVSDMI .VERSION KERNIBM 2.27 890622
-* ORIG. 29/05/89 C.Guerin, IBM
-*
-#if defined(CERNLIB_QMIBMXA)
-LVSDMI AMODE ANY
-LVSDMI RMODE ANY
-#endif
- USING *,15 FIND MINIMUM IN SCATTERED VECTOR, DBL PR
- STM 14,05,12(13)
-*
- LM G1,G3,0(G1) GET ADDRESSES
- L G2,0(G2) GET LEN
- LTR G2,G2 TEST IF LEN = 0
- BZ ZERO IF LEN = 0 GO TO ZERO
- L G3,0(G3) GET STRIDE
- LD F0,KF GET MAX POSITIVE
- LA G0,1 GET 1
- SR G4,G4 ZERO G4 FOR WORK
- SR G5,G5 ZERO G5 FOR WORK
-VLOOP EQU *
- VLVCU G2 SET LOOP
- VLD V0,G1(G3) LOAD V0 WITH A AND STRIDE
- VMNSD V0,F0,G4 FIND MINIMUM IN G6
- BC 2,VLOOP LOOP
- MR G2,G4 MULT BY STRIDE
- AR G0,G3 ADD 1
-* END SUBROUTINE *
-RETURN EQU *
- LM 2,05,28(13) RETURN
- BR 14
-ZERO EQU *
- SR G0,G0
- B RETURN
-* CONSTANTS *
- DS 0D
-KF DC X'7FFFFFFF'
- DC X'FFFFFFFF'
-V0 EQU 0
-G0 EQU 0
-G1 EQU 1
-G2 EQU 2
-G3 EQU 3
-G4 EQU 4
-G5 EQU 5
-F0 EQU 0
- END
-#ifdef CERNLIB_TCGEN_LVSDMI
-#undef CERNLIB_TCGEN_LVSDMI
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/lvsdmx.s b/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/lvsdmx.s
deleted file mode 100644
index be61194..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/lvsdmx.s
+++ /dev/null
@@ -1,58 +0,0 @@
-*
-* $Id: lvsdmx.s,v 1.1.1.1 1996/02/15 17:53:04 mclareni Exp $
-*
-* $Log: lvsdmx.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:04 mclareni
-* Kernlib
-*
-*
-LVSDMX CSECT
-* CERN PROGLIB# F121 LVSDMX .VERSION KERNIBM 2.27 890622
-* ORIG. 29/05/89 C.Guerin, IBM
-*
-#if defined(CERNLIB_QMIBMXA)
-LVSDMX AMODE ANY
-LVSDMX RMODE ANY
-#endif
- USING *,15 FIND MAXIMUM IN SCATTERED VECTOR, DBL PR
- STM 14,05,12(13)
-*
- LM G1,G3,0(G1) GET ADDRESSES
- L G2,0(G2) GET LEN
- LTR G2,G2 TEST IF LEN = 0
- BZ ZERO IF LEN = 0 GO TO ZERO
- L G3,0(G3) GET STRIDE
- LD F0,KF GET MAX NEGATIVE
- LA G0,1 GET 1
- SR G4,G4 ZERO G4 FOR WORK
- SR G5,G5 ZERO G5 FOR WORK
-VLOOP EQU *
- VLVCU G2 SET LOOP
- VLD V0,G1(G3) LOAD V0 WITH A AND STRIDE
- VMXSD V0,F0,G4 FIND MAXIMUM IN G6
- BC 2,VLOOP LOOP
- MR G2,G4 MULT BY STRIDE
- AR G0,G3 ADD 1
-* END SUBROUTINE *
-RETURN EQU *
- LM 2,05,28(13) RETURN
- BR 14
-ZERO EQU *
- SR G0,G0
- B RETURN
-* CONSTANTS *
- DS 0D
-KF DC X'FFFFFFFF'
- DC X'FFFFFFFF'
-V0 EQU 0
-G0 EQU 0
-G1 EQU 1
-G2 EQU 2
-G3 EQU 3
-G4 EQU 4
-G5 EQU 5
-F0 EQU 0
- END
-#ifdef CERNLIB_TCGEN_LVSDMX
-#undef CERNLIB_TCGEN_LVSDMX
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/lvsimi.s b/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/lvsimi.s
deleted file mode 100644
index a7c8761..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/lvsimi.s
+++ /dev/null
@@ -1,65 +0,0 @@
-*
-* $Id: lvsimi.s,v 1.1.1.1 1996/02/15 17:53:04 mclareni Exp $
-*
-* $Log: lvsimi.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:04 mclareni
-* Kernlib
-*
-*
-LVSIMI CSECT
-* CERN PROGLIB# F121 LVSIMI .VERSION KERNIBM 2.27 890622
-* ORIG. 29/05/89 C.Guerin, IBM
-*
-#if defined(CERNLIB_QMIBMXA)
-LVSIMI AMODE ANY
-LVSIMI RMODE ANY
-#endif
- USING *,15 FIND MINIMUM IN SCATTERED VECTOR INTEG
- STM 14,05,12(13)
-*
- LM G1,G3,0(G1) GET ADDRESSES
- L G2,0(G2) GET LEN
- LTR G2,G2 TEST IF LEN = 0
- BZ ZERO IF LEN = 0 GO TO ZERO
- L G3,0(G3) GET STRIDE
- LD F2,KF GET MAX POSITIVE
- LA G0,1 GET 1
- SR G4,G4 ZERO G4 FOR WORK
- SR G5,G5 ZERO G5 FOR WORK
- LD F0,C GET C FOR CONVERSION
-VLOOP EQU *
- VLVCU G2 SET LOOP
- VLDQ V0,F0 SET V0 TO C
- VX V1,V1,G1(G3) EXCL OR IN V1 WITH A AND STRIDE
- VSDQ V0,F0,V0 SUB C IN V0/V1 CONVERT I TO F
- VMNSD V0,F2,G4 FIND MINIMUM IN G6
- BC 2,VLOOP LOOP
- MR G2,G4 MULT BY STRIDE
- AR G0,G3 ADD 1
-* END SUBROUTINE *
-RETURN EQU *
- LM 2,05,28(13) RETURN
- BR 14
-ZERO EQU *
- SR G0,G0
- B RETURN
-* CONSTANTS *
- DS 0D
-KF DC X'7FFFFFFF'
- DC X'FFFFFFFF'
-C DC X'CE000000'
- DC X'80000000'
-V0 EQU 0
-V1 EQU 1
-G0 EQU 0
-G1 EQU 1
-G2 EQU 2
-G3 EQU 3
-G4 EQU 4
-G5 EQU 5
-F0 EQU 0
-F2 EQU 2
- END
-#ifdef CERNLIB_TCGEN_LVSIMI
-#undef CERNLIB_TCGEN_LVSIMI
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/lvsimx.s b/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/lvsimx.s
deleted file mode 100644
index 3853a49..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/lvsimx.s
+++ /dev/null
@@ -1,65 +0,0 @@
-*
-* $Id: lvsimx.s,v 1.1.1.1 1996/02/15 17:53:04 mclareni Exp $
-*
-* $Log: lvsimx.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:04 mclareni
-* Kernlib
-*
-*
-LVSIMX CSECT
-* CERN PROGLIB# F121 LVSIMX .VERSION KERNIBM 2.27 890622
-* ORIG. 29/05/89 C.Guerin, IBM
-*
-#if defined(CERNLIB_QMIBMXA)
-LVSIMX AMODE ANY
-LVSIMX RMODE ANY
-#endif
- USING *,15 FIND MAXIMUM IN SCATTERED VECTOR, INTEG
- STM 14,05,12(13)
-*
- LM G1,G3,0(G1) GET ADDRESSES
- L G2,0(G2) GET LEN
- LTR G2,G2 TEST IF LEN = 0
- BZ ZERO IF LEN = 0 GO TO ZERO
- L G3,0(G3) GET STRIDE
- LE F2,KF GET MAX NEGATIVE
- LA G0,1 GET 1
- SR G4,G4 ZERO G4 FOR WORK
- SR G5,G5 ZERO G5 FOR WORK
- LD F0,C GET C FOR CONVERSION
-VLOOP EQU *
- VLVCU G2 SET LOOP
- VLDQ V0,F0 SET V0 WITH C
- VX V1,V1,G1(G3) EXCL OR IN V1 WITH A AND STRIDE
- VSDQ V0,F0,V0 SUB C IN V0/V1 CONVERT I TO F
- VMXSD V0,F2,G4 FIND MAXIMUM IN G6
- BC 2,VLOOP LOOP
- MR G2,G4 MULT BY STRIDE
- AR G0,G3 ADD 1
-* END SUBROUTINE *
-RETURN EQU *
- LM 2,05,28(13)
- BR 14
-ZERO EQU *
- SR G0,G0
- B RETURN
-* CONSTANTS *
- DS 0D
-KF DC X'FFFFFFFF'
- DC X'FFFFFFFF'
-C DC X'CE000000'
- DC X'80000000'
-V0 EQU 0
-V1 EQU 1
-G0 EQU 0
-G1 EQU 1
-G2 EQU 2
-G3 EQU 3
-G4 EQU 4
-G5 EQU 5
-F0 EQU 0
-F2 EQU 2
- END
-#ifdef CERNLIB_TCGEN_LVSIMX
-#undef CERNLIB_TCGEN_LVSIMX
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/lvsmi.s b/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/lvsmi.s
deleted file mode 100644
index 4ea6665..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/lvsmi.s
+++ /dev/null
@@ -1,58 +0,0 @@
-*
-* $Id: lvsmi.s,v 1.1.1.1 1996/02/15 17:53:04 mclareni Exp $
-*
-* $Log: lvsmi.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:04 mclareni
-* Kernlib
-*
-*
-LVSMI CSECT
-* CERN PROGLIB# F121 LVSMI .VERSION KERNIBM 2.27 890622
-* ORIG. 29/05/89 C.Guerin, IBM
-*
-#if defined(CERNLIB_QMIBMXA)
-LVSMI AMODE ANY
-LVSMI RMODE ANY
-#endif
- USING *,15 FIND MINIMUM IN SCATTERED VECTOR, SGLE PR
- STM 14,05,12(13)
-*
- LM G1,G3,0(G1) GET ADDRESSES
- L G2,0(G2) GET LEN
- LTR G2,G2 TEST IF LEN = 0
- BZ ZERO IF LEN = 0 GO TO ZERO
- L G3,0(G3) GET STRIDE
- LE F0,KF GET MAX POSITIVE
- LA G0,1 GET 1
- SR G4,G4 ZERO G4 FOR WORK
- SR G5,G5 ZERO G5 FOR WORK
-VLOOP EQU *
- VLVCU G2 SET LOOP
- VLE V0,G1(G3) LOAD V0 WITH A AND STRIDE
- VMNSE V0,F0,G4 FIND MINIMUM IN G6
- BC 2,VLOOP LOOP
- MR G2,G4 MULT BY STRIDE
- AR G0,G3 ADD 1
-* END SUBROUTINE *
-RETURN EQU *
- LM 2,05,28(13) RETURN
- BR 14
-ZERO EQU *
- SR G0,G0
- B RETURN
-* CONSTANTS *
- DS 0D
-KF DC X'7FFFFFFF'
- DC X'FFFFFFFF'
-V0 EQU 0
-G0 EQU 0
-G1 EQU 1
-G2 EQU 2
-G3 EQU 3
-G4 EQU 4
-G5 EQU 5
-F0 EQU 0
- END
-#ifdef CERNLIB_TCGEN_LVSMI
-#undef CERNLIB_TCGEN_LVSMI
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/lvsmx.s b/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/lvsmx.s
deleted file mode 100644
index e1496a4..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/lvsmx.s
+++ /dev/null
@@ -1,58 +0,0 @@
-*
-* $Id: lvsmx.s,v 1.1.1.1 1996/02/15 17:53:04 mclareni Exp $
-*
-* $Log: lvsmx.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:04 mclareni
-* Kernlib
-*
-*
-LVSMX CSECT
-* CERN PROGLIB# F121 LVSMX .VERSION KERNIBM 2.27 890622
-* ORIG. 29/05/89 C.Guerin, IBM
-*
-#if defined(CERNLIB_QMIBMXA)
-LVSMX AMODE ANY
-LVSMX RMODE ANY
-#endif
- USING *,15 F MAXIMUM IN A SCATTERED VECTOR, SGLE P
- STM 14,05,12(13)
-*
- LM G1,G3,0(G1) GET ADDRESSES
- L G2,0(G2) GET LEN
- LTR G2,G2 TEST IF LEN = 0
- BZ ZERO IF LEN = 0 GO TO ZERO
- L G3,0(G3) GET STRIDE
- LE F0,KF GET MAX NEGATIVE
- LA G0,1 GET 1
- SR G4,G4 ZERO G4 FOR WORK
- SR G5,G5 ZERO G5 FOR WORK
-VLOOP EQU *
- VLVCU G2 SET LOOP
- VLE V0,G1(G3) LOAD V0 WITH A AND STRIDE
- VMXSE V0,F0,G4 FIND MAXIMUM IN G6
- BC 2,VLOOP LOOP
- MR G2,G4 MULT BY STRIDE
- AR G0,G3 ADD 1
-* END SUBROUTINE *
-RETURN EQU *
- LM 2,05,28(13) RETURN
- BR 14
-ZERO EQU *
- SR G0,G0
- B RETURN
-* CONSTANTS *
- DS 0D
-KF DC X'FFFFFFFF'
- DC X'FFFFFFFF'
-V0 EQU 0
-G0 EQU 0
-G1 EQU 1
-G2 EQU 2
-G3 EQU 3
-G4 EQU 4
-G5 EQU 5
-F0 EQU 0
- END
-#ifdef CERNLIB_TCGEN_LVSMX
-#undef CERNLIB_TCGEN_LVSMX
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/qmibmvf.h b/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/qmibmvf.h
deleted file mode 100644
index a7fbdae..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/qmibmvf.h
+++ /dev/null
@@ -1,15 +0,0 @@
-*
-* $Id: qmibmvf.h,v 1.1.1.1 1996/02/15 17:53:08 mclareni Exp $
-*
-* $Log: qmibmvf.h,v $
-* Revision 1.1.1.1 1996/02/15 17:53:08 mclareni
-* Kernlib
-*
-*
-* For IBM vector facility
-* This directory was created from kernibm.car patch qmibmvf
-#if defined(CERNLIB_3090S)||defined(CERNLIB_3090J)
-#ifndef CERNLIB_SZ256
-#define CERNLIB_SZ256
-#endif
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/ranecu.s b/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/ranecu.s
deleted file mode 100644
index 45d19b4..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/ranecu.s
+++ /dev/null
@@ -1,329 +0,0 @@
-*
-* $Id: ranecu.s,v 1.1.1.1 1996/02/15 17:53:05 mclareni Exp $
-*
-* $Log: ranecu.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:05 mclareni
-* Kernlib
-*
-*
-RANECU CSECT
-*
-* CERN PROGLIB# V114 RANECU .VERSION KERNIBM 2.34 930209
-* ORIG. 29/05/89 C.Guerin, **** IBM corr.18/12/92 MRO/CG
-*
-#if defined(CERNLIB_QMIBMXA)
-RANECU AMODE ANY
-RANECU RMODE ANY
-#endif
- EXTRN RANEC1
-#if defined(CERNLIB_SZ256)
-SZ EQU 256 SECTION SIZE EQUATE
-#endif
-#if !defined(CERNLIB_SZ256)
-SZ EQU 128 SECTION SIZE EQUATE
-#endif
- USING *,15
- STM 14,12,12(13) SAVE REG
-****************************************
-* SEE AT THE END FOR FORTRAN ALGORITHM *
-****************************************
- L G11,ARANEC1 ADCON FOR COMMON
- LA G5,SZ G5 = SECTION SIZE
- LM G2,G4,0(G1) GET ADDRESSES
- L G3,0(G3) GET LEN
- ST G3,RESCNT STORE TOTAL CNT = RES CNT
- L G9,0(G4) VALUE OF KSEQ
- LTR G9,G9 IF(KESQ.GT.0)
- BC 12,ELSE BRANCH IF NOT GT THAN ZERO
- ST G9,0(G11) JSEQ(1)=KSEQ
- B SHIFT ISEQ IN G9
-* B ENDIF
-ELSE L G9,0(G11) ISEQ=JSEQ(1)
-SHIFT SLL G9,4 correct. 18/12/92 SLL G9,3 to SLL G9,4
- S G9,K8 added 18/12/92
- AR G9,G11 (1,ISEQ) ADDR IN G9
- LD F4,0(G9) F4 = ISEED1 = (ISEED(1,ISEQ)
- LD F6,8(G9) F6 = ISEED2 = (ISEED(2,ISEQ)
- LA G12,8 SET G12 = 8
- LR G4,G3 SET G4 FOR VLVCU
-* INIT ** LOOP ***** DO 100 I=1,LEN
-INIT EQU * BEGIN LOOPS
- SR G11,G11 ZERO INDEX
- L G3,RESCNT GET RESID CNT
- SR G3,G5 SUBTRACT SIZE
- BM LESS IF MINUS LESS THAN SECT SIZE (LAST)
- ST G3,RESCNT SAVE RES CNT
- LR G3,G5 IF GT SET TO SECT SIZE
-* LOOP ** ISEED1 ***** DO 100 I=1,LEN
-SCALARP EQU *
- LD F0,KC1 KC1 = 1/53668 K=ISEED1/53668
- MDR F0,F4 F4 = ISEED1
- AD F0,K4F08 CONVERT TO
- LE F0,D4E INTEGER THEN
- SDR F2,F2 TO FLOATING
- ADR F2,F0 POINT AGAIN
- LDR F0,F2 COPY F2/F0
- MD F0,K44D4M MULT BY 53668 NEG -K*53668 IN F0
- ADR F0,F4 ADD ISEED1(I-1) +ISEED1 IN F0
- MD F0,K449C MULT BY 40014 40014*(ISEED1-K*53668)
- MD F2,K442F MULT BY 12211 K*12211
- SDR F0,F2 F0=ISEED1=40014*(ISEED1-K*53668)-K*12211
- BP EXITA IF GT ZERO STORE
- AD F0,K487F IF LT ZERO ADD 2147483563
-EXITA EQU *
- STD F0,ISEED1(G11) ISEED1 IN F0
- LDR F4,F0 COPY IN F4
-* SCALAR PART ** ISEED2 *****
- LD F0,KC2 KC2 = 1/52774 K=ISEED2/52774
- MDR F0,F6 F6 = ISEED2
- AD F0,K4F08 CONVERT TO
- LE F0,D4E INTEGER THEN
- SDR F2,F2 TO FLOATING
- ADR F2,F0 POINT AGAIN
- LDR F0,F2 COPY F2/F0
- MD F0,K44CEM MULT BY 52774 NEG -K*52774 IN F0
- ADR F0,F6 ADD ISEED2(I-1) +ISEED2 IN F0
- MD F0,K449E MULT BY 40692 40692*(ISEED2-K*52774)
- MD F2,K43EC MULT BY 3791 K*3791
- SDR F0,F2 F0=ISEED2=40692*(ISEED2-K*52774)-K*3791
- BP EXITB IF GT ZERO STORE
- AD F0,K487FB IF LT ZERO ADD 2147483399
-EXITB EQU *
- STD F0,ISEED2(G11) ISEED2 IN F0
- LDR F6,F0 COPY IN F6
-**** LA G11,8(G11) SET ISEED INDEX +8
- AR G11,G12
- BCT G3,SCALARP LOOP
-* VECTOR LOOP ****************
- LM G6,G7,AISEED1 GET VECT ADDR ISEED1 ISEED2
- LD F0,KF1 F0 = 1.0
- LD F2,K4656 F2 = 4.6566128 E-10
- VLVCU G4
- VLD V0,G6 V0 = ISEED1 ADDR IN G6
- VSD V0,V0,G7 V0 = ISEED1-ISEED2 ISEED2 ADDR IN G7
- VCDQ 2,F0,V0 V0 = IZ .LT. F0 (F0 = 1.0)
- LD F0,K21562 F0 = 2147485362
- VSVMM 1 IF IZ .LT. 1.
- VADQ V0,F0,V0 IZ = IZ + 2147485362
- VSVMM 0
- VMDQ V0,F2,V0 MULT IZ * 4.6566128 E-10 (F2)
- VSTE V0,G2 STORE IN RVEC(I)
- LTR G4,G4
- BC 2,INIT
-* 100 CONTINUE **************
-** STM G0,G1,0(G9) ISEED(1,ISEQ)=ISEED1;ISEED(2,ISEQ)=ISEED2
- STD F4,0(G9)
- STD F6,8(G9)
-* RETURN *********************
- LM 2,12,28(13) *
- BR 14 *
-* END SUBROUTINE *************
-LESS EQU * LAST PASS SCALAR THEN VECTOR
- AR G3,G5 RESET COUNT
- C G3,K30 LAST VECTOR LONGER THAN 30
- BH SCALARP GO BACK SCAL THEN VECT
-ALLSCA EQU * IF LESS GO ALL SCALAR
- LD F0,KC1 KC1 = 1/53668 K=ISEED1/53668 MODIF
- MDR F0,F4 F4 = ISEED1
- AD F0,K4F08 CONVERT TO
- LE F0,D4E INTEGER THEN
- SDR F2,F2 TO FLOATING
- ADR F2,F0 POINT AGAIN
- LDR F0,F2 COPY F2/F0
- MD F0,K44D4M MULT BY 53668 NEG -K*53668 IN F0
- ADR F0,F4 ADD ISEED1(I-1) +ISEED1 IN F0
- MD F0,K449C MULT BY 40014 40014*(ISEED1-K*53668)
- MD F2,K442F MULT BY 12211 K*12211
- SDR F0,F2 F0=ISEED1=40014*(ISEED1-K*53668)-K*12211
- BP EXIT3 IF GT ZERO STORE
- AD F0,K487F IF LT ZERO ADD 2147483563
-EXIT3 EQU *
- LDR F4,F0 COPY IN F4
-* SCALAR PART ** ISEED2 *****
- LD F0,KC2 KC2 = 1/52774 K=ISEED2/52774 MODIF
- MDR F0,F6 F6 = ISEED2
- AD F0,K4F08 CONVERT TO
- LE F0,D4E INTEGER THEN
- SDR F2,F2 TO FLOATING
- ADR F2,F0 POINT AGAIN
- LDR F0,F2 COPY F2/F0
- MD F0,K44CEM MULT BY 52774 NEG -K*52774 IN F0
- ADR F0,F6 ADD ISEED2(I-1) +ISEED2 IN F0
- MD F0,K449E MULT BY 40692 40692*(ISEED2-K*52774)
- MD F2,K43EC MULT BY 3791 K*3791
- SDR F0,F2 F0=ISEED2=40692*(ISEED2-K*52774)-K*3791
- BP EXITB3 IF GT ZERO STORE
- AD F0,K487FB IF LT ZERO ADD 2147483399
-EXITB3 EQU *
- LDR F6,F0 COPY IN F6
-* SUITE SCALAIRE ************
- LDR F0,F4 FO = ISEED1 F4 = ISEED2
- SDR F0,F6 FO = IZ = ISEED1 - ISEED2
- CD F0,KF1 IF IZ(I) .GE.1 GO TO MULT
- BNL MULT IF IZ(I) .LT.1 IZ(I)=IZ(I)+2147483562
- AD F0,K21562
-MULT EQU *
- MD F0,K4656 IZ(I)=IZ(I)*4.6566128 E -10
- STE F0,0(G2) STORE IN RVEC(I)
- LA G2,4(G2) SET RVEC INDEX +4
- BCT G3,ALLSCA LOOP SCALAIRE
-* 100 CONTINUE **************
-** STM G0,G1,0(G9) ISEED(1,ISEQ)=ISEED1;ISEED(2,ISEQ)=ISEED2
- STD F4,0(G9)
- STD F6,8(G9)
-* RETURN *********************
- LM 2,12,28(13) *
- BR 14 *
-* END SUBROUTINE *************
-* CONSTANTS *****************
-K8 DC F'8'
- DS 0D
-DB DC D'0'
-D4E DC X'4E000000'
- DC X'00000000'
-KC1 DC X'3D1389C7' KC1 = 1./53668 OLD VERSION
- DC X'54E4331C' KC1 = 1.D0+1.D-11/53668 NEW
-K4F08 DC X'4F080000'
- DC X'00000000'
-K44D4M DC X'C4D1A400' K44D4M = - 53668.
- DC X'00000000'
-K449C DC X'449C4E00' K449C = 40014.
- DC X'00000000'
-K442F DC X'442FB300' K442F = 12211.
- DC X'00000000'
-ISEED1 DC (SZ)D'0'
-K487F DC X'487FFFFF' K487F = 2147483563.
- DC X'AB000000'
-KC2 DC X'3D13DE82' KC2 = 1./52774. OLD VERSION
- DC X'731FCFC7' KC2 = 1.D0+1.D-11/52774 NEW
-K44CEM DC X'C4CE2600' K44CEM = - 52774.
- DC X'00000000'
-K449E DC X'449EF400' K449E = 40692.
- DC X'00000000'
-K43EC DC X'43ECF000' K43EC = 3791.
- DC X'00000000'
-K487FB DC X'487FFFFF' K487FB = 2147483399.
- DC X'07000000'
-KF1 DC X'41100000' KF1 = 1.
- DC X'00000000'
-K21562 DC X'487FFFFF' K21562 = 2147485362.
- DC X'00000000'
-K4656 DC X'39200000' K4656 = 4.6566128 E-10
- DC X'00000000'
-ARANEC1 DC A(RANEC1)
-AISEED1 DC A(ISEED1)
-AISEED2 DC A(ISEED2)
-K30 DC F'30'
-RESCNT DC F'0'
-ISEED2 DC (SZ)D'0'
-*********************************************************************
-******* ORIGINAL FORTRAN ALGORITHM *********************************
-*********************************************************************
-*** SUBROUTINE RANECU(RVEC,LEN,ISEQ)
-* COMMENT OUT PRINT OFF STATEMENT TO GET FORTRAN PROGRAM ************
-* PRINT OFF
-*** DIMENSION RVEC(*)
-*** COMMON / ECUSED / ISEED(2,1)
-*C
-*** ISEED1 = ISEED(1,ISEQ)
-*** ISEED2 = ISEED(2,ISEQ)
-*** DO 100 I= 1, LEN
-*** K = ISEED1/53668
-*** ISEED1 = 40014*(ISEED1 - K*53668) - K*12211
-*** IF (ISEED1 .LT. 0) ISEED1=ISEED1+2147483563
-*C
-*** K = ISEED2/52774
-*** ISEED2 = 40692*(ISEED2 - K*52774) - K* 3791
-*** IF (ISEED2 .LT. 0) ISEED2=ISEED2+2147483399
-***
-*** IZ = ISEED1 - ISEED2
-*** IF (IZ .LT. 1) IZ = IZ + 2147483562
-*C
-*** RVEC(I) = IZ * 4.6566128E-10
-* 100 CONTINUE
-*** ISEED(1,ISEQ) = ISEED1
-*** ISEED(2,ISEQ) = ISEED2
-*** RETURN
-*C
-*** ENTRY RECUIN(IS1,IS2,ISEQ)
-*** ISEED(1,ISEQ) = IS1
-*** ISEED(2,ISEQ) = IS2
-*** ENTRY RECUUT(IS1,IS2,ISEQ)
-*** IS1 = ISEED(1,ISEQ)
-*** IS2 = ISEED(2,ISEQ)
-*** END
-***************** SECOND ALGORITHM ****************
-*** SUBROUTINE RANECF(RVEC,LEN,KSEQ)
-*
-*** DOUBLE PRECISION ISEED, ISEED1, ISEED2, K, C1, C2, IZ
-*** PARAMETER (C1=(1.D0+1.D-11)/53668.D0,C2=(1.D0+1.D-11)/52774.D0)
-*** PARAMETER (MAXSEQ=100)
-*** DIMENSION RVEC(*)
-*** COMMON / RANEC1 / JSEQ(2), ISEED(2,MAXSEQ)
-*** SAVE /RANEC1/
-*C
-*** IF(KSEQ.GT.0) THEN
-*** JSEQ(1) = KSEQ
-*** ISEQ = KSEQ
-*** ELSE
-*** ISEQ = JSEQ(1)
-*** ENDIF
-*** ISEED1 = ISEED(1,ISEQ)
-*** ISEED2 = ISEED(2,ISEQ)
-*** DO 100 I= 1, LEN
-*** K = INT (ISEED1*C1)
-*** ISEED1 = 40014*(ISEED1 - K*53668) - K*12211
-*** IF (ISEED1 .LT. 0) ISEED1=ISEED1+2147483563
-*C
-*** K = INT(ISEED2*C2)
-*** ISEED2 = 40692*(ISEED2 - K*52774) - K* 3791
-*** IF (ISEED2 .LT. 0) ISEED2=ISEED2+2147483399
-*C
-*** IZ = ISEED1 - ISEED2
-*** IF (IZ .LE. 0) IZ = IZ + 2147483562
-*C
-*** RVEC(I) = IZ * 4.6566128E-10
-* 100 CONTINUE
-*** ISEED(1,ISEQ) = ISEED1
-*** ISEED(2,ISEQ) = ISEED2
-*** END
-G0 EQU 0
-G1 EQU 1
-G2 EQU 2
-G3 EQU 3
-G4 EQU 4
-G5 EQU 5
-G6 EQU 6
-G7 EQU 7
-G8 EQU 8
-G9 EQU 9
-G10 EQU 10
-G11 EQU 11
-G12 EQU 12
-G13 EQU 13
-G14 EQU 14
-G15 EQU 15
-F0 EQU 0
-F2 EQU 2
-F4 EQU 4
-F6 EQU 6
-V0 EQU 0
-V1 EQU 1
-V2 EQU 2
-V3 EQU 3
-V4 EQU 4
-V5 EQU 5
-V6 EQU 6
-V7 EQU 7
-V8 EQU 8
-V9 EQU 9
-V10 EQU 10
-V11 EQU 11
-V12 EQU 12
-V13 EQU 13
-V14 EQU 14
-V15 EQU 15
- END
-#ifdef CERNLIB_TCGEN_RANECU
-#undef CERNLIB_TCGEN_RANECU
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/ubunch.s b/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/ubunch.s
deleted file mode 100644
index 23c440f..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/ubunch.s
+++ /dev/null
@@ -1,278 +0,0 @@
-*
-* $Id: ubunch.s,v 1.1.1.1 1996/02/15 17:53:05 mclareni Exp $
-*
-* $Log: ubunch.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:05 mclareni
-* Kernlib
-*
-*
-UBUNCH CSECT VECTOR VERSION FOR UBUNCH
-*
-* CERN PROGLIB# M409 UBUNCH .VERSION KERNIBM 2.30 900508
-*
-#if defined(CERNLIB_QMIBMXA)
-UBUNCH AMODE 31
-UBUNCH RMODE ANY
-#endif
- USING *,15
- STM 14,12,12(13)
-*****************************************************************
- LM G4,G6,0(G1) get addresses
- L G6,0(G6) get count
- C G6,BEV compare count with bev
- BL TZERO if lower go to TZERO
- SR G7,G7 zero G7
- SRDL G6,2 divide count by 4
- LR G1,G4 copy input vect addr from G4 to G1
- LA G1,4(G1) add +4 to G1 for word 2
- LR G2,G4 copy input vect addr from G4 to G2
- LA G2,8(G2) add +8 to G2 for word 3
- LR G3,G4 copy input vect addr from G4 to G3
- LA G3,12(G3) add +12 to G3 for word 4
- LA G8,4 set stride to 4
- LM G9,G12,MASK0 load masks in G9 to G12
-VLOOP EQU *
- VLVCU G6 set vector loop
- VL V0,G4(G8) load V0 from G4 addr
- VL V1,G1(G8) load V1 from G1 addr
- VL V2,G2(G8) load V2 from G2 addr
- VL V3,G3(G8) load V3 from G3 addr
- VNQ V0,G9,V0 and V0 elemt with x'FF000000'
- VSRL V1,V1,8 shift right V1 for 2nd byte
- VNQ V1,G10,V1 and V1 elemt with x'00FF0000'
- VSRL V2,V2,16 shift right V2 for 3rd byte
- VNQ V2,G11,V2 and V2 elemt with x'0000FF00'
- VSRL V3,V3,24 shift right V3 for 4th byte
- VNQ V3,G12,V3 and V3 elemt with x'000000FF'
- VOR V0,V0,V1 or V1 and V0 in V0 (byte 1 & 2)
- VOR V2,V3,V2 or V2 and V3 in V2 (byte 3 & 4)
- VOR V0,V0,V2 or V0 and V2 (byte 1 to 4)
- VST V0,G5 store V0 (4 bytes) result with G5 addr
- BC 2,VLOOP go back vector
- SRL G7,30 shift remainder
- LTR G7,G7 is any remainder
- BZ RETURN2 if no return
- L G12,BLKS load G12 with blanks
- L G11,0(G4) load next input vect elemt
- SRL G11,24 shift byte to low order position
- ST G12,0(G5) store a word of blks
- STC G11,0(G5) store one byte from low order
- BCT G7,NEX1 update count in G7 and test any more
- B RETURN2 if no more return
-NEX1 L G11,4(G4) load next input vect elemt
- SRL G11,24 shift byte to low order position
- STC G11,1(G5) store one byte from low order
- BCT G7,NEX2 update count in G7 and test any more
- B RETURN2 if no more return
-NEX2 L G11,8(G4) load next input vect elemt
- SRL G11,24 shift byte to low order position
- STC G11,2(G5) store one byte from low order
- B RETURN2 if no more return
-* END SUBROUTINE ************
-RETURN2 LM 2,12,28(13) RETURN
- BR 14
-* SCALAR ********************
-TZERO EQU *
- C G6,KZ compare count with 0
- BC LE,RETURN2 if le return
-SL L G1,BLKS load G1 with blanks
- LR G9,G5 copy G5 output addr vect in G9
-LW EQU *
- ST G1,0(G9) store G1 blanks in output vect
- ICM G0,B'1000',0(G4) get 1 byte from input vect
- STCM G0,B'1000',0(G5) put 1 byte in output vect
- BCT G6,NEXT1 update count and test
- B EXIT if no more exit
-NEXT1 ICM G0,B'1000',4(G4) get 1 byte from input vect
- STCM G0,B'1000',1(G5) put 1 byte in output vect
- BCT G6,NEXT2 update count and test
- B EXIT if no more exit
-NEXT2 ICM G0,B'1000',8(G4) get 1 byte from input vect
- STCM G0,B'1000',2(G5) put 1 byte in output vect
- BCT G6,NEXT3 update count and test
- B EXIT if no more exit
-NEXT3 ICM G0,B'1000',12(G4) get 1 byte from input vect
- STCM G0,B'1000',3(G5) put 1 byte from output vect
- LA G5,4(G5) add +4 to G5 output vect addr
- LA G4,16(G4) add +16 to input vect addr
- LA G9,4(G9) add +4 to G9 output vect addr
- BCT G6,LW update count and test
-EXIT B RETURN2 if no more return
-* CONSTANTS *****************************************************
- DS 0D
-BLKS DC X'40404040'
-BEV DC F'64'
-KZ DC F'0'
-MASK0 DC X'FF000000'
-MASK1 DC X'00FF0000'
-MASK2 DC X'0000FF00'
-MASK3 DC X'000000FF'
-LE EQU 12
- PRINT OFF
-V0 EQU 0
-V1 EQU 1
-V2 EQU 2
-V3 EQU 3
-V4 EQU 4
-V5 EQU 5
-V6 EQU 6
-V7 EQU 7
-V8 EQU 8
-V9 EQU 9
-V10 EQU 10
-V11 EQU 11
-V12 EQU 12
-V13 EQU 13
-V14 EQU 14
-V15 EQU 15
-G0 EQU 0
-G1 EQU 1
-G2 EQU 2
-G3 EQU 3
-G4 EQU 4
-G5 EQU 5
-G6 EQU 6
-G7 EQU 7
-G8 EQU 8
-G9 EQU 9
-G10 EQU 10
-G11 EQU 11
-G12 EQU 12
-G13 EQU 13
-G14 EQU 14
-G15 EQU 15
-F0 EQU 0
-F2 EQU 2
-F4 EQU 4
-F6 EQU 6
- END
-*----------------------------------------------------------------
-UBLOW CSECT VECTOR VERSION FOR UBLOW
-*
-* CERN PROGLIB# M409 UBLOW .VERSION KERNIBM 2.28 891004
-*
-#if defined(CERNLIB_QMIBMXA)
-UBLOW AMODE 31
-UBLOW RMODE ANY
-#endif
- USING *,15
- STM 14,12,12(13)
-*****************************************************************
- LM G4,G6,0(G1) get addresses
- L G0,BLANKS load G0 with 3 blanks x'00404040'
- L G6,0(G6) get count
- C G6,BEV compare count with bev
- BL TZERO if lower than bev go to TZERO
- SR G7,G7 zero G7
- SRDL G6,1 divide count by 2
- ST G7,WORD store remainder
- LR G8,G5 copy output address G5 in G8
- LA G8,4(G8) +4 in G8
- LA G2,2 set stride=2
-VLOOP EQU *
- VLVCU G6 set vector loop
- VLH V0,G4 load halfword from input in V0
- VSLL V1,V0,24 shift second byte left 24 in V1
- VSRL V0,V0,8 shift first byte right 8 in V0
- VSLL V0,V0,24 shift first byte left 24 in V0
- VOQ V0,G0,V0 set 3 low order bytes to blank
- VOQ V1,G0,V1 set 3 low order bytes to blank
- VST V0,G5(G2) store first byte in output thru G5
- VST V1,G8(G2) store 2nd byte in output +4 thru G8
- BC 2,VLOOP go back vector loop
- TM WORD,X'80' test remanider
- BZ RETURN if no return
- L G9,BLANK4 load G9 with 4 blanks x'40404040'
- ST G9,0(G5) store in output vector
- IC G3,0(G4) get next character
- STC G3,0(G5) store in output vector
-* END SUBROUTINE ************
-RETURN EQU *
- LM 2,12,28(13) RETURN
- BR 14
-* NON VECTOR ****************
-TZERO EQU *
- C G6,KZ compare vector count with zero
- BC LE,RETURN if le 0 return
-ST4 L G10,0(G4) get input vector word 1
- L G11,BLANK4 get 4 blanks
- ST G11,0(G5) store in ouput vector
- STCM G10,B'1000',0(G5) store first character
- BCT G6,NEX1 test any more if yes go on
- B RR if no more return
-NEX1 ST G11,4(G5) store 4 blanks in next word
- STCM G10,B'0100',4(G5) store next character
- BCT G6,NEX2 test any more if yes go on
- B RR if no more return
-NEX2 ST G11,8(G5) store 4 blanks in next word
- STCM G10,B'0010',8(G5) store next character
- BCT G6,NEX3 test any more if yes go on
- B RR if no more return
-NEX3 ST G11,12(G5) store 4 blanks in next word
- STCM G10,B'0001',12(G5) store next character
- LA G4,4(G4) add +4 to G4 input vector addr
- LA G5,16(G5) add +16 to G5 output vector addr
- BCT G6,ST4 test count if yes go on scalar
-RR B RETURN
-* CONSTANTS *****************************************************
- DS 0D
-BLANK4 DC X'40404040'
-BLANKS DC X'00404040'
- DC X'00404040'
- DC X'00404040'
- DC X'00404040'
- DS 0D
-BEV DC F'40'
-KZ DC F'0'
-WORD DC F'0'
-LE EQU 12
- PRINT OFF
-V0 EQU 0
-V1 EQU 1
-V2 EQU 2
-V3 EQU 3
-V4 EQU 4
-V5 EQU 5
-V6 EQU 6
-V7 EQU 7
-V8 EQU 8
-V9 EQU 9
-V10 EQU 10
-V11 EQU 11
-V12 EQU 12
-V13 EQU 13
-V14 EQU 14
-V15 EQU 15
-G0 EQU 0
-G1 EQU 1
-G2 EQU 2
-G3 EQU 3
-G4 EQU 4
-G5 EQU 5
-G6 EQU 6
-G7 EQU 7
-G8 EQU 8
-G9 EQU 9
-G10 EQU 10
-G11 EQU 11
-G12 EQU 12
-G13 EQU 13
-G14 EQU 14
-G15 EQU 15
-F0 EQU 0
-F2 EQU 2
-F4 EQU 4
-F6 EQU 6
- END
-#ifdef CERNLIB_IBM360_UBUNCH
-#undef CERNLIB_IBM360_UBUNCH
-#endif
-#ifdef CERNLIB_IBM360_UBLOW
-#undef CERNLIB_IBM360_UBLOW
-#endif
-#ifdef CERNLIB_TCGEN_UBUNCH
-#undef CERNLIB_TCGEN_UBUNCH
-#endif
-#ifdef CERNLIB_TCGEN_UBLOW
-#undef CERNLIB_TCGEN_UBLOW
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/vadd.F b/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/vadd.F
deleted file mode 100644
index b4738ca..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/vadd.F
+++ /dev/null
@@ -1,38 +0,0 @@
-*
-* $Id: vadd.F,v 1.1.1.1 1996/02/15 17:53:05 mclareni Exp $
-*
-* $Log: vadd.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:05 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- at PROCESS DIRECTIVE ('*VDIR:') OPT(3) VECTOR
- SUBROUTINE VADD (B,C,A,N)
-C
-C CERN PROGLIB# F121 VADD .VERSION KERNIBM 2.27 890622
-C ORIG. 01/07/71
-C 31/03/89 M.Roethlisberger/IBM Optimize/Vectorize
-C
- DIMENSION A(*),B(*),C(*)
- PARAMETER (LVMIN = 15)
-C
- IF (N.GE.LVMIN) THEN
-C*VDIR: PREFER VECTOR
-
- DO 90 I= 1,N
- 90 A(I)= B(I) + C(I)
-
- ELSE
-
-C*VDIR: PREFER SCALAR
-
- DO 95 I= 1,N
- 95 A(I)= B(I) + C(I)
-
- ENDIF
- END
-#ifdef CERNLIB_TCGEN_VADD
-#undef CERNLIB_TCGEN_VADD
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/vasum.F b/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/vasum.F
deleted file mode 100644
index c701c38..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/vasum.F
+++ /dev/null
@@ -1,43 +0,0 @@
-*
-* $Id: vasum.F,v 1.1.1.1 1996/02/15 17:53:07 mclareni Exp $
-*
-* $Log: vasum.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:07 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- at PROCESS DIRECTIVE ('*VDIR:') OPT(3) VECTOR
- FUNCTION VASUM (A,N)
-C
-C CERN PROGLIB# F121 VASUM .VERSION KERNIBM 2.27 890622
-C ORIG. 01/07/71
-C 28/02/89 M.Roethlisberger/IBM Optimization/Vectorization
-C
- DIMENSION A(*)
- REAL*8 XS
- PARAMETER (LVMIN = 40)
-C
- IF (N.GE.LVMIN) THEN
-C*VDIR: PREFER VECTOR
-
- XV= 0.
- DO 90 I= 1,N
- 90 XV= XV + ABS (A(I))
- VASUM=XV
-
- ELSE
-C
-C*VDIR: PREFER SCALAR
-
- XS= 0.
- DO 95 I= 1,N
- 95 XS= XS + ABS (A(I))
- VASUM=XS
-
- ENDIF
- END
-#ifdef CERNLIB_TCGEN_VASUM
-#undef CERNLIB_TCGEN_VASUM
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/vbias.F b/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/vbias.F
deleted file mode 100644
index efa259b..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/vbias.F
+++ /dev/null
@@ -1,38 +0,0 @@
-*
-* $Id: vbias.F,v 1.1.1.1 1996/02/15 17:53:05 mclareni Exp $
-*
-* $Log: vbias.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:05 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- at PROCESS DIRECTIVE ('*VDIR:') OPT(3) VECTOR
- SUBROUTINE VBIAS (B,ALPHA,A,N)
-C
-C CERN PROGLIB# F121 VBIAS .VERSION KERNIBM 2.27 890622
-C ORIG. 01/07/71
-C 03/04/89 M.Roethlisberger/IBM Optimize/Vectorize
-C
- DIMENSION A(*),B(*)
- PARAMETER (LVMIN = 20)
-C
- IF (N.GE.LVMIN) THEN
-C*VDIR: PREFER VECTOR
-
- DO 90 I= 1,N
- 90 A(I)= B(I) + ALPHA
-
- ELSE
-
-C*VDIR: PREFER SCALAR
-
- DO 95 I= 1,N
- 95 A(I)= B(I) + ALPHA
-
- ENDIF
- END
-#ifdef CERNLIB_TCGEN_VBIAS
-#undef CERNLIB_TCGEN_VBIAS
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/vcloc.s b/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/vcloc.s
deleted file mode 100644
index 9cf9b24..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/vcloc.s
+++ /dev/null
@@ -1,49 +0,0 @@
-*
-* $Id: vcloc.s,v 1.1.1.1 1996/02/15 17:53:05 mclareni Exp $
-*
-* $Log: vcloc.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:05 mclareni
-* Kernlib
-*
-*
-VCLOC CSECT CALLING SEQUENCE
-* CERN PROGLIB# Z004 VCLOC .VERSION KERNIBM 2.30 900508
-* ORIG. 13/03/90 C.GUERIN, IBM
-*
-#if defined(CERNLIB_QMIBMXA)
-VCLOC AMODE 31
-VCLOC RMODE ANY
-#endif
-*****************************************************************
-* Read the system clocks an return the result in microseconds *
-* *
-* The format is CALL VCLOC ( TIME) *
-* *
-* TIME(1) = elapsed time *
-* TIME(2) = total cpu time *
-* TIME(3) = virtual cpu time *
-* TIME(4) = vector cpu time *
-* *
-* where TIME is declared REAL*8 TIME(4) *
-*****************************************************************
- USING *,15 CALL VCLOC (TIME)
- L 1,0(1) GET ADDRESS OF ARG
-************** ELAPSED TIME IN MICROSECONDS
- STCK 1(1) STORE TOD SHIFTED 1 BYTE
- MVI 0(1),X'4D' MAKE RESULT FLOATING POINT
-************** VECTOR ACTIVITY IN MICROSECONDS
- VACSV ITIME STORE VECTOR ACTIVITY
- MVI ITIME,X'4B' MAKE RESULT FLOATING POINT
- MVC 24(8,1),ITIME VECTOR TIME TO RESULT
-************** CPU TIME IN MICROSECONDS
- LA 0,ITIME ADDRESS OF 4 DOUBLE WORDS
- DC X'8300000C' GET TOTAL AND VIRTUAL CPU TIME
- MVI ITIME+16,X'4E' MAKE VIRTUAL TIME FLOATING POINT
- MVI ITIME+24,X'4E' MAKE TOTAL TIME FLOATING POINT
- MVC 16(8,1),ITIME+16 VIRTUAL CPU TIME TO RESULT
- MVC 8(8,1),ITIME+24 TOTAL CPU TIME TO RESULT
-************** RETURN
- BR 14
- DS 0D
-ITIME DS 4D
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/vclocq.F b/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/vclocq.F
deleted file mode 100644
index e4ffd2c..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/vclocq.F
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: vclocq.F,v 1.1.1.1 1996/02/15 17:53:05 mclareni Exp $
-*
-* $Log: vclocq.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:05 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
-C at PROCESS DIR('*VDIR:') VECTOR OPT(3) NOSDUMP
- SUBROUTINE VCLOCQ
-C CERN PROGLIB# Z004 VCLOC .VERSION KERNIBM 2.30 900508
-C
-C Initialise vector timings
-C
-C Should be invoked before the first CALL to VCLOC
-C
-C Author: M.Roethlisberger/IBM
-C Date : 12-03-90
-C --------------------------------------------------------------------
- PARAMETER (LEN = 2)
- DIMENSION A(LEN)
-C*VDIR: PREFER VECTOR
- DO I = 1,LEN
- A(I) = 0.
- ENDDO
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/vcopyn.F b/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/vcopyn.F
deleted file mode 100644
index 7bd3c53..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/vcopyn.F
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: vcopyn.F,v 1.1.1.1 1996/02/15 17:53:06 mclareni Exp $
-*
-* $Log: vcopyn.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:06 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- at PROCESS DIRECTIVE ('*VDIR:') OPT(3) VECTOR
- SUBROUTINE VCOPYN (A,X,N)
-C
-C CERN PROGLIB# F121 VCOPYN .VERSION KERNIBM 2.27 890622
-C ORIG. 01/04/73
-C 20/03/89 M.Roethlisberger?IBM Optimization/Vectorization
-C
- DIMENSION A(*), X(*)
- PARAMETER (LVMIN = 25)
-C
- IF (N.GE.LVMIN) THEN
-C*VDIR: PREFER VECTOR
- DO 14 I=1,N
- 14 X(I)= -A(I)
- ELSE
-
-C*VDIR: PREFER SCALAR
- DO 19 I=1,N
- 19 X(I)= -A(I)
- ENDIF
- END
-#ifdef CERNLIB_TCGEN_VCOPYN
-#undef CERNLIB_TCGEN_VCOPYN
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/vdist.F b/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/vdist.F
deleted file mode 100644
index 2387831..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/vdist.F
+++ /dev/null
@@ -1,43 +0,0 @@
-*
-* $Id: vdist.F,v 1.1.1.1 1996/02/15 17:53:07 mclareni Exp $
-*
-* $Log: vdist.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:07 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- at PROCESS DIRECTIVE ('*VDIR:') OPT(3) VECTOR
- FUNCTION VDIST (X,Y,N)
-C
-C CERN PROGLIB# F121 VDIST .VERSION KERNIBM 2.27 890622
-C ORIG. 26/09/76
-C 28/02/89 M.Roethlisberger/IBM Optimization/Vectorization
-C
- DIMENSION X(*), Y(*)
- REAL*8 XX8
- PARAMETER (LVMIN = 27)
-
- IF (N.GE.LVMIN) THEN
-C*VDIR: PREFER VECTOR
-
- XX = 0.
- DO 90 J=1,N
- 90 XX = XX + (X(J)-Y(J)) **2
- XX = SQRT (XX)
- VDIST = XX
- ELSE
-
-C*VDIR: PREFER SCALAR
-
- XX8 = 0.
- DO 95 J=1,N
- 95 XX8 = XX8 + (DBLE(X(J)-Y(J))) **2
- XX = SQRT (SNGL(XX8))
- VDIST = XX
- ENDIF
- END
-#ifdef CERNLIB_TCGEN_VDIST
-#undef CERNLIB_TCGEN_VDIST
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/vdist2.F b/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/vdist2.F
deleted file mode 100644
index c0a6ecd..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/vdist2.F
+++ /dev/null
@@ -1,42 +0,0 @@
-*
-* $Id: vdist2.F,v 1.1.1.1 1996/02/15 17:53:07 mclareni Exp $
-*
-* $Log: vdist2.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:07 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- at PROCESS DIRECTIVE ('*VDIR:') OPT(3) VECTOR
- FUNCTION VDIST2 (X,Y,N)
-C
-C CERN PROGLIB# F121 VDIST2 .VERSION KERNIBM 2.27 890622
-C ORIG. 26/09/76
-C 28/02/89 M.Roethlisberger Optimization/Vectorization
-C
- DIMENSION X(*), Y(*)
- REAL*8 XX8
- PARAMETER (LVMIN = 27)
-
- IF (N.GE.LVMIN) THEN
-C*VDIR: PREFER VECTOR
-
- XX = 0.
- DO 90 J=1,N
- 90 XX = XX + (X(J)-Y(J)) **2
- VDIST2 = XX
- ELSE
-
-C*VDIR: PREFER SCALAR
-
- XX8 = 0.
- DO 95 J=1,N
- 95 XX8 = XX8 + (DBLE(X(J)-Y(J))) **2
- VDIST2 = XX8
- ENDIF
- RETURN
- END
-#ifdef CERNLIB_TCGEN_VDIST2
-#undef CERNLIB_TCGEN_VDIST2
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/vdot.F b/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/vdot.F
deleted file mode 100644
index 8f26c25..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/vdot.F
+++ /dev/null
@@ -1,43 +0,0 @@
-*
-* $Id: vdot.F,v 1.1.1.1 1996/02/15 17:53:07 mclareni Exp $
-*
-* $Log: vdot.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:07 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- at PROCESS DIRECTIVE ('*VDIR:') OPT(3) VECTOR
- FUNCTION VDOT (X,Y,N)
-C
-C CERN PROGLIB# F121 VDOT .VERSION KERNIBM 2.27 890622
-C ORIG. 01/07/71
-C 28/02/89 M.Roethlisberger/IBM Optimization/Vectorization
-C
- DIMENSION X(*),Y(*)
- REAL*8 XS
- PARAMETER (LVMIN = 28)
-C
- IF (N.GE.LVMIN) THEN
-C*VDIR: PREFER VECTOR
-
- XV= 0.
- DO 90 I= 1,N
- 90 XV= XV + X(I)*Y(I)
- VDOT=XV
-
- ELSE
-
-C*VDIR: PREFER SCALAR
-
- XS= 0.
- DO 95 I= 1,N
- 95 XS= XS + DBLE(X(I))*DBLE(Y(I))
- VDOT=XS
-
- ENDIF
- END
-#ifdef CERNLIB_TCGEN_VDOT
-#undef CERNLIB_TCGEN_VDOT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/vdotn.F b/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/vdotn.F
deleted file mode 100644
index cd4f85c..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/vdotn.F
+++ /dev/null
@@ -1,67 +0,0 @@
-*
-* $Id: vdotn.F,v 1.1.1.1 1996/02/15 17:53:07 mclareni Exp $
-*
-* $Log: vdotn.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:07 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- at PROCESS DIRECTIVE ('*VDIR:') OPT(3) VECTOR
- FUNCTION VDOTN (X,Y,N)
-C
-C CERN PROGLIB# F121 VDOTN .VERSION KERNIBM 2.27 890622
-C ORIG. 01/07/71
-C 28/02/89 M.Roethlisberger/IBM Optimization/Vectorization
-C
- DIMENSION X(*), Y(*)
- REAL*8 XX8, XY8, YY8
- PARAMETER (LVMIN = 25)
-C
- IF (N.GE.LVMIN) THEN
-C*VDIR: PREFER VECTOR
-
- XX= 0.
- XY= 0.
- YY= 0.
-C
- DO 90 J=1,N
- XX = XX + X(J)*X(J)
- XY = XY + X(J)*Y(J)
- 90 YY = YY + Y(J)*Y(J)
-C
- VDOTN= XY / SQRT(XX*YY)
- IF (ABS (VDOTN).LT.1.) RETURN
- VDOTN= SIGN (1.,VDOTN)
-
- ELSE IF (N.GT.0) THEN
-C
-C*VDIR: PREFER SCALAR
-
- XX8 = 0.
- XY8 = 0.
- YY8 = 0.
-C
- DO 95 J=1,N
- XX8 = XX8 + DBLE(X(J))*DBLE(X(J))
- XY8 = XY8 + DBLE(X(J))*DBLE(Y(J))
- 95 YY8 = YY8 + DBLE(Y(J))*DBLE(Y(J))
-C
- XX = XX8
- XY = XY8
- YY = YY8
-
- VDOTN= XY / SQRT(XX*YY)
- IF (ABS (VDOTN).LT.1.) RETURN
- VDOTN= SIGN (1.,VDOTN)
-
- ELSE
-
- VDOTN = 0.0
-
- ENDIF
- END
-#ifdef CERNLIB_TCGEN_VDOTN
-#undef CERNLIB_TCGEN_VDOTN
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/vdotn2.F b/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/vdotn2.F
deleted file mode 100644
index b95cd08..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/vdotn2.F
+++ /dev/null
@@ -1,63 +0,0 @@
-*
-* $Id: vdotn2.F,v 1.1.1.1 1996/02/15 17:53:07 mclareni Exp $
-*
-* $Log: vdotn2.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:07 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- at PROCESS DIRECTIVE ('*VDIR:') OPT(3) VECTOR
- FUNCTION VDOTN2 (X,Y,N)
-C
-C CERN PROGLIB# F121 VDOTN2 .VERSION KERNIBM 2.27 890622
-C ORIG. 20/06/72
-C 28/02/89 M.Roethlisberger Optimization/Vectorization
-C
- DIMENSION X(*),Y(*)
- REAL*8 XX8, XY8, YY8
- PARAMETER (LVMIN = 30)
-C
- IF (N.GE.LVMIN) THEN
-C*VDIR: PREFER VECTOR
-
- XX = 0.
- XY = 0.
- YY = 0.
-C
- DO 90 J=1,N
- XX = XX + X(J)*X(J)
- XY = XY + X(J)*Y(J)
- 90 YY = YY + Y(J)*Y(J)
-C
- VDOTN2= XY**2/(XX*YY)
-
- ELSE IF (N.GT.0) THEN
-C
-C*VDIR: PREFER SCALAR
-
- XX8 = 0.
- XY8 = 0.
- YY8 = 0.
-C
- DO 95 J=1,N
- XX8 = XX8 + DBLE(X(J))*DBLE(X(J))
- XY8 = XY8 + DBLE(X(J))*DBLE(Y(J))
- 95 YY8 = YY8 + DBLE(Y(J))*DBLE(Y(J))
-C
-
- XX=XX8
- XY=XY8
- YY=YY8
- VDOTN2= XY**2/(XX*YY)
-
- ELSE
-
- VDOTN2 = 0.0
-
- ENDIF
- END
-#ifdef CERNLIB_TCGEN_VDOTN2
-#undef CERNLIB_TCGEN_VDOTN2
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/vexcum.F b/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/vexcum.F
deleted file mode 100644
index 9c7494e..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/vexcum.F
+++ /dev/null
@@ -1,43 +0,0 @@
-*
-* $Id: vexcum.F,v 1.1.1.1 1996/02/15 17:53:07 mclareni Exp $
-*
-* $Log: vexcum.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:07 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- at PROCESS DIRECTIVE ('*VDIR:') OPT(3) VECTOR
- SUBROUTINE VEXCUM (A,EX,N)
-
-C
-C CERN PROGLIB# F121 VEXCUM .VERSION KERNIBM 2.27 890622
-C ORIG. 01/07/71
-C 20/03/89 M.ROETHLISBERGER/IBM OPTIMIZATION/VECTORIZATION
-C
- DIMENSION A(*), EX(3)
- PARAMETER (LVMIN = 45 )
-
- IF (N.GE.LVMIN) THEN
-C*VDIR: PREFER VECTOR
-
- DO 190 J=1,N
- EX(1)= AMIN1(EX(1),A(J))
- EX(2)= AMAX1(EX(2),A(J))
- 190 EX(3)= EX(3) + A(J)
-
- ELSE
-
-C*VDIR: PREFER SCALAR
-
- DO 195 J=1,N
- EX(1)= AMIN1(EX(1),A(J))
- EX(2)= AMAX1(EX(2),A(J))
- 195 EX(3)= EX(3) + A(J)
-
- ENDIF
- END
-#ifdef CERNLIB_TCGEN_VEXCUM
-#undef CERNLIB_TCGEN_VEXCUM
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/vfix.F b/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/vfix.F
deleted file mode 100644
index 0c3cf03..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/vfix.F
+++ /dev/null
@@ -1,38 +0,0 @@
-*
-* $Id: vfix.F,v 1.1.1.1 1996/02/15 17:53:06 mclareni Exp $
-*
-* $Log: vfix.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:06 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- at PROCESS DIRECTIVE ('*VDIR:') OPT(3) VECTOR
- SUBROUTINE VFIX (A,IA,N)
-C
-C CERN PROGLIB# F121 VFIX .VERSION KERNIBM 2.27 890622
-C ORIG. 03/05/72
-C 01/03/89 M.Roethlisberger/IBM Optimization/Vectorization
-C
- DIMENSION A(*), IA(*)
- PARAMETER (LVMIN = 12 )
-
- IF (N.GE.LVMIN) THEN
-C*VDIR: PREFER VECTOR
-
- DO 90 J=1,N
- 90 IA(J)= A(J)
-
- ELSE
-
-C*VDIR: PREFER SCALAR
-
- DO 95 J=1,N
- 95 IA(J)= A(J)
-
- ENDIF
- END
-#ifdef CERNLIB_TCGEN_VFIX
-#undef CERNLIB_TCGEN_VFIX
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/vfloat.F b/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/vfloat.F
deleted file mode 100644
index 9568ea8..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/vfloat.F
+++ /dev/null
@@ -1,39 +0,0 @@
-*
-* $Id: vfloat.F,v 1.1.1.1 1996/02/15 17:53:07 mclareni Exp $
-*
-* $Log: vfloat.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:07 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- at PROCESS DIRECTIVE ('*VDIR:') OPT(3) VECTOR
- SUBROUTINE VFLOAT (IA,A,N)
-C
-C CERN PROGLIB# F121 VFLOAT .VERSION KERNIBM 2.27 890622
-C ORIG. 03/05/72
-C 01/03/89 M.Roethlisberger/IBM Optimization/Vectorizatin
-C
- DIMENSION A(*), IA(*)
- PARAMETER (LVMIN = 10)
-
- IF (N.GE.LVMIN) THEN
-C*VDIR: PREFER VECTOR
-
- DO 90 J=1,N
- 90 A(J)= IA(J)
-
- ELSE
-
-C*VDIR: PREFER SCALAR
-
- DO 95 J=1,N
- 95 A(J)= IA(J)
-
- ENDIF
-
- END
-#ifdef CERNLIB_TCGEN_VFLOAT
-#undef CERNLIB_TCGEN_VFLOAT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/vlinco.F b/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/vlinco.F
deleted file mode 100644
index 49b9b67..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/vlinco.F
+++ /dev/null
@@ -1,38 +0,0 @@
-*
-* $Id: vlinco.F,v 1.1.1.1 1996/02/15 17:53:06 mclareni Exp $
-*
-* $Log: vlinco.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:06 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- at PROCESS DIRECTIVE ('*VDIR:') OPT(3) VECTOR
- SUBROUTINE VLINCO (B,ALPHA,C,BETA,A,N)
-C
-C CERN PROGLIB# F121 VLINCO .VERSION KERNIBM 2.27 890622
-C ORIG. 01/07/71
-C 01/03/89 M.Roethlisberger/IBM Optimization/Vectorization
-C
- DIMENSION A(*),B(*),C(*)
- PARAMETER (LVMIN = 20)
-
- IF (N.GE.LVMIN) THEN
-C*VDIR: PREFER VECTOR
-
- DO 90 I= 1,N
- 90 A(I)= B(I)*ALPHA + C(I)*BETA
-
- ELSE
-
-C*VDIR: PREFER SCALAR
-
- DO 95 I= 1,N
- 95 A(I)= B(I)*ALPHA + C(I)*BETA
-
- ENDIF
- END
-#ifdef CERNLIB_TCGEN_VLINCO
-#undef CERNLIB_TCGEN_VLINCO
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/vmatl.F b/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/vmatl.F
deleted file mode 100644
index cfe1298..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/vmatl.F
+++ /dev/null
@@ -1,71 +0,0 @@
-*
-* $Id: vmatl.F,v 1.1.1.1 1996/02/15 17:53:06 mclareni Exp $
-*
-* $Log: vmatl.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:06 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- at PROCESS DIRECTIVE ('*VDIR:') OPT(3) VECTOR
- SUBROUTINE VMATL (H,A,X,K,N)
-C
-C CERN PROGLIB# F121 VMATL .VERSION KERNIBM 2.27 890622
-C ORIG. 01/07/71
-C 24/05/89 M.Roethlisberger/IBM Optimized/Vectorized
-C
- DIMENSION A(99),X(99),H(N,K)
- PARAMETER (LVMIN = 7, NS = 96)
- REAL*8 TMPI, TMPJ
-
- IF (MAX0(N,K).GE.LVMIN) THEN
-
- IF (N.GT.K.OR.N.GT.NS) THEN
-C
-C Vectorize over J
-C
- DO 71 I=1,K
- X(I)=0.
- 71 CONTINUE
-
- DO 79 J = 1,N
- TEMP = A(J)
- DO 75 I= 1,K
- X(I)= X(I) + TEMP*H(J,I)
- 75 CONTINUE
- 79 CONTINUE
-
- RETURN
- ENDIF
-
-C
-C Vectorize over I
-C
-C*VDIR: PREFER VECTOR
- DO 89 I= 1,K
- TMPI=0.
- DO 85 J= 1,N
- TMPJ= A(J)
- TMPI= TMPI + TMPJ*H(J,I)
- 85 CONTINUE
- X(I)=TMPI
- 89 CONTINUE
- RETURN
- ENDIF
-
-C*VDIR: PREFER SCALAR ON
-
- DO 99 I= 1,K
- TMPI= 0.
-
- DO 95 J= 1,N
- TMPJ= A(J)
- TMPI= TMPI + TMPJ*H(J,I)
- 95 CONTINUE
- X(I)=TMPI
- 99 CONTINUE
- END
-#ifdef CERNLIB_TCGEN_VMATL
-#undef CERNLIB_TCGEN_VMATL
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/vmatr.F b/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/vmatr.F
deleted file mode 100644
index 59c3c08..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/vmatr.F
+++ /dev/null
@@ -1,72 +0,0 @@
-*
-* $Id: vmatr.F,v 1.1.1.1 1996/02/15 17:53:06 mclareni Exp $
-*
-* $Log: vmatr.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:06 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- at PROCESS DIRECTIVE ('*VDIR:') OPT(3) VECTOR
- SUBROUTINE VMATR (A,G,X,N,K)
-C
-C CERN PROGLIB# F121 VMATR .VERSION KERNIBM 2.27 890622
-C ORIG. 01/07/71
-C 24/05/89 M.Roethlisberger/IBM Optimized/Vectorized
-C
- DIMENSION A(99),X(99),G(K,N)
- PARAMETER (LVMIN = 7, KS = 128)
- REAL*8 TMPI, TMPJ
-
- IF (MAX0(K,N).GE.LVMIN) THEN
-
- IF (K.GT.N.OR.K.GT.KS) THEN
-C
-C Vectorize over I
-C
- DO 79 I= 1,K
- TMPI=0
- DO 75 J= 1,N
- TMPJ= A(J)
- TMPI= TMPI + TMPJ*G(I,J)
- 75 CONTINUE
- X(I)=TMPI
- 79 CONTINUE
-
- RETURN
- ENDIF
-C
-C Vectorize over J
-C
- DO 81 I=1,K
- X(I)=0.
- 81 CONTINUE
-
-C*VDIR: PREFER VECTOR
- DO 89 J= 1,N
- TEMP = A(J)
-C*VDIR: PREFER SCALAR
- DO 85 I= 1,K
- X(I) = X(I)+TEMP*G(I,J)
- 85 CONTINUE
- 89 CONTINUE
-
- RETURN
- ENDIF
-
-C*VDIR: PREFER SCALAR ON
-
- DO 99 I= 1,K
- TMPI= 0.
- DO 95 J= 1,N
- TMPJ=A(J)
- TMPI= TMPI + TMPJ*G(I,J)
- 95 CONTINUE
- X(I)=TMPI
- 99 CONTINUE
-
- END
-#ifdef CERNLIB_TCGEN_VMATR
-#undef CERNLIB_TCGEN_VMATR
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/vmax.F b/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/vmax.F
deleted file mode 100644
index 220c9f7..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/vmax.F
+++ /dev/null
@@ -1,45 +0,0 @@
-*
-* $Id: vmax.F,v 1.1.1.1 1996/02/15 17:53:07 mclareni Exp $
-*
-* $Log: vmax.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:07 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- at PROCESS DIRECTIVE ('*VDIR:') OPT(3) VECTOR
- FUNCTION VMAX (A,N)
-C
-C CERN PROGLIB# F121 VMAX .VERSION KERNIBM 2.27 890622
-C ORIG. 01/07/71
-C 27/02/89 M.Roethlisberger/IBM Optimization/Vectorization
-C
- DIMENSION A(*)
- PARAMETER (LVMIN = 30)
-C
- IF (N.GE.LVMIN) THEN
-C*VDIR: PREFER VECTOR
-
- AMAX = A(1)
- DO 90 I= 2,N
- 90 AMAX = AMAX1 (A(I),AMAX)
- VMAX = AMAX
-
- ELSE IF (N.GT.0) THEN
-C*VDIR: PREFER SCALAR
-
- AMAX = A(1)
- DO 95 I= 2,N
- 95 AMAX = AMAX1 (A(I),AMAX)
- VMAX = AMAX
-
- ELSE
-
- VMAX = 0.
-
- END IF
- END
-#ifdef CERNLIB_TCGEN_VMAX
-#undef CERNLIB_TCGEN_VMAX
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/vmaxa.F b/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/vmaxa.F
deleted file mode 100644
index 81e4db6..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/vmaxa.F
+++ /dev/null
@@ -1,45 +0,0 @@
-*
-* $Id: vmaxa.F,v 1.1.1.1 1996/02/15 17:53:07 mclareni Exp $
-*
-* $Log: vmaxa.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:07 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- at PROCESS DIRECTIVE ('*VDIR:') OPT(3) VECTOR
- FUNCTION VMAXA (A,N)
-C
-C CERN PROGLIB# F121 VMAXA .VERSION KERNIBM 2.27 890622
-C ORIG. 01/07/71
-C 27/02/89 M.Roethlisberger/IBM Optimization/Vectorization
-C
- DIMENSION A(*)
- PARAMETER (LVMIN = 25)
-C
- IF (N.GE.LVMIN) THEN
-C*VDIR: PREFER VECTOR
-
- AMAX = ABS (A(1))
- DO 90 I= 2,N
- 90 AMAX = AMAX1 (ABS (A(I)),AMAX)
- VMAXA = AMAX
-
- ELSE IF (N.GT.0) THEN
-C*VDIR: PREFER SCALAR
-
- AMAX = ABS (A(1))
- DO 95 I= 2,N
- 95 AMAX = AMAX1 (ABS (A(I)),AMAX)
- VMAXA = AMAX
-
- ELSE
-
- VMAXA = 0.
-
- END IF
- END
-#ifdef CERNLIB_TCGEN_VMAXA
-#undef CERNLIB_TCGEN_VMAXA
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/vmin.F b/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/vmin.F
deleted file mode 100644
index f0ac23c..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/vmin.F
+++ /dev/null
@@ -1,45 +0,0 @@
-*
-* $Id: vmin.F,v 1.1.1.1 1996/02/15 17:53:08 mclareni Exp $
-*
-* $Log: vmin.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:08 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- at PROCESS DIRECTIVE ('*VDIR:') OPT(3) VECTOR
- FUNCTION VMIN (A,N)
-C
-C CERN PROGLIB# F121 VMIN .VERSION KERNIBM 2.27 890622
-C ORIG. 01/07/71
-C 24/02/89 M.Roethlisbeger/IBM Optimization/Vectorization
-C
- DIMENSION A(*)
- PARAMETER (LVMIN = 30)
-C
- IF (N.GE.LVMIN) THEN
-C*VDIR: PREFER VECTOR
-
- AMIN= A(1)
- DO 90 I= 2,N
- 90 AMIN = AMIN1 (A(I),AMIN)
- VMIN= AMIN
-
- ELSE IF (N.GT.0) THEN
-C*VDIR: PREFER SCALAR
-
- AMIN= A(1)
- DO 95 I= 2,N
- 95 AMIN = AMIN1 (A(I),AMIN)
- VMIN= AMIN
-
- ELSE
-
- VMIN = 0.
-
- END IF
- END
-#ifdef CERNLIB_TCGEN_VMIN
-#undef CERNLIB_TCGEN_VMIN
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/vmina.F b/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/vmina.F
deleted file mode 100644
index 115b86c..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/vmina.F
+++ /dev/null
@@ -1,45 +0,0 @@
-*
-* $Id: vmina.F,v 1.1.1.1 1996/02/15 17:53:07 mclareni Exp $
-*
-* $Log: vmina.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:07 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- at PROCESS DIRECTIVE ('*VDIR:') OPT(3) VECTOR
- FUNCTION VMINA (A,N)
-C
-C CERN PROGLIB# F121 VMINA .VERSION KERNIBM 2.27 890622
-C ORIG. 01/07/71
-C 24/02/89 M.Roethlisberger/IBM Optimization/Vectorization
-C
- DIMENSION A(*)
- PARAMETER (LVMIN = 25)
-C
- IF (N.GE.LVMIN) THEN
-C*VDIR: PREFER VECTOR
-
- AMIN= ABS (A(1))
- DO 90 I= 2,N
- 90 AMIN = AMIN1 (ABS (A(I)),AMIN)
- VMINA= AMIN
-
- ELSE IF (N.GT.0) THEN
-C*VDIR: PREFER SCALAR
-
- AMIN= ABS (A(1))
- DO 95 I= 2,N
- 95 AMIN = AMIN1 (ABS (A(I)),AMIN)
- VMINA= AMIN
-
- ELSE
-
- VMINA = 0.
-
- END IF
- END
-#ifdef CERNLIB_TCGEN_VMINA
-#undef CERNLIB_TCGEN_VMINA
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/vmod.F b/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/vmod.F
deleted file mode 100644
index 9af3a63..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/vmod.F
+++ /dev/null
@@ -1,43 +0,0 @@
-*
-* $Id: vmod.F,v 1.1.1.1 1996/02/15 17:53:07 mclareni Exp $
-*
-* $Log: vmod.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:07 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- at PROCESS DIRECTIVE ('*VDIR:') OPT(3) VECTOR
- FUNCTION VMOD (A,N)
-C
-C CERN PROGLIB# F121 VMOD .VERSION KERNIBM 2.27 890622
-C ORIG. 01/07/71
-C 24/02/89 M.Roethlisberger/IBM Optimization/Vectorization
-C
- DIMENSION A(*)
- REAL*8 XS
- PARAMETER (LVMIN = 30)
-C
- IF (N.GE.LVMIN) THEN
-C*VDIR: PREFER VECTOR
- XV = 0.
-
- DO 90 I=1,N
- 90 XV = XV + A(I)*A(I)
-
- VMOD=SQRT(XV)
- ELSE
-
-C*VDIR: PREFER SCALAR
-
- XS = 0.
- DO 95 I=1,N
- 95 XS = XS + DBLE(A(I))*DBLE(A(I))
-
- VMOD=SQRT(SNGL(XS))
- ENDIF
- END
-#ifdef CERNLIB_TCGEN_VMOD
-#undef CERNLIB_TCGEN_VMOD
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/vmul.F b/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/vmul.F
deleted file mode 100644
index 970da9b..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/vmul.F
+++ /dev/null
@@ -1,38 +0,0 @@
-*
-* $Id: vmul.F,v 1.1.1.1 1996/02/15 17:53:05 mclareni Exp $
-*
-* $Log: vmul.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:05 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- at PROCESS DIRECTIVE ('*VDIR:') OPT(3) VECTOR
- SUBROUTINE VMUL (A,B,X,N)
-C
-C CERN PROGLIB# F121 VMUL .VERSION KERNIBM 2.27 890622
-C ORIG. 01/07/71
-C 01/03/89 M.Roethlisberger/IBM Optimization/Vectorization
-C
- DIMENSION A(*),B(*),X(*)
- PARAMETER (LVMIN = 40)
-
- IF (N.GE.LVMIN) THEN
-C*VDIR: PREFER VECTOR
-
- DO 90 I= 1,N
- 90 X(I)= A(I) * B(I)
-
- ELSE
-
-C*VDIR: PREFER SCALAR
-
- DO 95 I= 1,N
- 95 X(I)= A(I) * B(I)
-
- ENDIF
- END
-#ifdef CERNLIB_TCGEN_VMUL
-#undef CERNLIB_TCGEN_VMUL
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/vscale.F b/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/vscale.F
deleted file mode 100644
index 3aef721..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/vscale.F
+++ /dev/null
@@ -1,38 +0,0 @@
-*
-* $Id: vscale.F,v 1.1.1.1 1996/02/15 17:53:05 mclareni Exp $
-*
-* $Log: vscale.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:05 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- at PROCESS DIRECTIVE ('*VDIR:') OPT(3) VECTOR
- SUBROUTINE VSCALE (B,ALPHA,A,N)
-C
-C CERN PROGLIB# F121 VSCALE .VERSION KERNIBM 2.27 890622
-C ORIG. 01/07/71
-C 01/03/89 M.Roethlisberger/IBM Optimization/Vectorization
-C
- DIMENSION A(*),B(*)
- PARAMETER (LVMIN = 30)
-
- IF (N.GE.LVMIN) THEN
-C*VDIR: PREFER VECTOR
-
- DO 90 I= 1,N
- 90 A(I)= B(I) * ALPHA
-
- ELSE
-
-C*VDIR: PREFER SCALAR
-
- DO 95 I= 1,N
- 95 A(I)= B(I) * ALPHA
-
- ENDIF
- END
-#ifdef CERNLIB_TCGEN_VSCALE
-#undef CERNLIB_TCGEN_VSCALE
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/vsub.F b/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/vsub.F
deleted file mode 100644
index c2d112d..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/vsub.F
+++ /dev/null
@@ -1,38 +0,0 @@
-*
-* $Id: vsub.F,v 1.1.1.1 1996/02/15 17:53:05 mclareni Exp $
-*
-* $Log: vsub.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:05 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- at PROCESS DIRECTIVE ('*VDIR:') OPT(3) VECTOR
- SUBROUTINE VSUB (A,B,X,N)
-C
-C CERN PROGLIB# F121 VSUB .VERSION KERNIBM 2.27 890622
-C ORIG. 01/07/71
-C 01/03/89 M.Roethlisberger/IBM Optimization/Vectorization
-C
- DIMENSION A(*),B(*),X(*)
- PARAMETER (LVMIN = 30)
-
- IF (N.GE.LVMIN) THEN
-C*VDIR: PREFER VECTOR
-
- DO 90 I= 1,N
- 90 X(I)= A(I) - B(I)
-
- ELSE
-
-C*VDIR: PREFER SCALAR
-
- DO 95 I= 1,N
- 95 X(I)= A(I) - B(I)
-
- ENDIF
- END
-#ifdef CERNLIB_TCGEN_VSUB
-#undef CERNLIB_TCGEN_VSUB
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/vsum.F b/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/vsum.F
deleted file mode 100644
index 82b1643..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/vsum.F
+++ /dev/null
@@ -1,43 +0,0 @@
-*
-* $Id: vsum.F,v 1.1.1.1 1996/02/15 17:53:07 mclareni Exp $
-*
-* $Log: vsum.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:07 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- at PROCESS DIRECTIVE ('*VDIR:') OPT(3) VECTOR
- FUNCTION VSUM (A,N)
-C
-C CERN PROGLIB# F121 VSUM .VERSION KERNIBM 2.27 890622
-C ORIG. 01/07/71
-C 20/02/89 M.Roethlisberger/IBM Optimization/vectorization
-C
- DIMENSION A(*)
- REAL*8 XS
- PARAMETER (LVMIN = 45)
-C
- IF (N.GE.LVMIN) THEN
-C*VDIR: PREFER VECTOR
-
- XV = 0.
- DO 90 I= 1,N
- 90 XV = XV + A(I)
-
- VSUM=XV
- ELSE
-
-C*VDIR: PREFER SCALAR
-
- XS=0.
- DO 95 I= 1,N
- 95 XS= XS + A(I)
-
- VSUM=XS
- ENDIF
- END
-#ifdef CERNLIB_TCGEN_VSUM
-#undef CERNLIB_TCGEN_VSUM
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/vunit.F b/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/vunit.F
deleted file mode 100644
index 1c37060..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/qmibmvf/vunit.F
+++ /dev/null
@@ -1,55 +0,0 @@
-*
-* $Id: vunit.F,v 1.1.1.1 1996/02/15 17:53:06 mclareni Exp $
-*
-* $Log: vunit.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:06 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- at PROCESS DIRECTIVE ('*VDIR:') OPT(3) VECTOR
- SUBROUTINE VUNIT (A,B,N)
-C
-C CERN PROGLIB# F121 VUNIT .VERSION KERNIBM 2.27 890622
-C ORIG. 01/07/71
-C 01/03/89 M.Roethlisberger/IBM Optimization/Vectorization
-C
- DIMENSION A(*), B(*)
- REAL*8 XX8
- PARAMETER (LVMIN = 30)
-
- IF (N.GE.LVMIN) THEN
-C*VDIR: PREFER VECTOR
-
- XX= 0.
- DO 90 I=1,N
- 90 XX= XX + A(I)*A(I)
-
- IF (XX.LE.0.) RETURN
- YY=1./ SQRT (XX)
-
-C*VDIR: PREFER VECTOR
-
- DO 190 I = 1,N
- 190 B(I)=A(I) * YY
-
- ELSE
-
-C*VDIR: PREFER SCALAR ON
-
- XX8= 0.
- DO 95 I=1,N
- 95 XX8= XX8 + DBLE(A(I))*DBLE(A(I))
-
- IF (XX8.LE.0.) RETURN
- YY=1./ SQRT (SNGL(XX8))
-
- DO 195 I = 1,N
- 195 B(I)=A(I) * YY
-
- ENDIF
- END
-#ifdef CERNLIB_TCGEN_VUNIT
-#undef CERNLIB_TCGEN_VUNIT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/sycern/abend.s b/src/packlib/kernlib/kerngen/obsolete/kernibm/sycern/abend.s
deleted file mode 100644
index 16415bf..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/sycern/abend.s
+++ /dev/null
@@ -1,95 +0,0 @@
-*
-* $Id: abend.s,v 1.1.1.1 1996/02/15 17:53:19 mclareni Exp $
-*
-* $Log: abend.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:19 mclareni
-* Kernlib
-*
-*
-ABEND CSECT
-*
-* CERN PROGLIB# Z035 ABEND .VERSION KERNIBM 1.11 820328
-*
-#if defined(CERNLIB_QMIBMXA)
-ABEND AMODE ANY
-ABEND RMODE ANY
-#endif
-*
-* FUNCTION: ABEND A JOB STEP WITH A USER COMPLETION CODE.
-*
-* CALLING SEQUENCE: CALL ABEND(KODEU)
-*
-* ARGUMENTS: KODEU - AN INTEGER CONSTANT OR 4-BYTE INTEGER
-* VARIABLE WITH A VALUE IN THE RANGE 0-4095.
-* IF A VALUE OUTSIDE THIS RANGE IS GIVEN,
-* A VALUE OF 1 WILL BE USED. THIS ARGUMENT
-* IS OPTIONAL; IF OMITTED, A USER COMPLETION
-* CODE OF 1 WILL BE USED.
-*
-*********************************************************************
-*
-* M O D I F I C A T I O N L O G
-*
-* ORIGINAL VERSION : 1.00
-*
-* R. MATTHEWS, CERN/DD, MAY 1980.
-*
-*********************************************************************
-*
-R0 EQU 0
-R1 EQU 1
-R2 EQU 2
-R3 EQU 3
-R4 EQU 4
-R5 EQU 5
-R6 EQU 6
-R7 EQU 7
-R8 EQU 8
-R9 EQU 9
-R10 EQU 10
-R11 EQU 11
-R12 EQU 12
-R13 EQU 13
-R14 EQU 14
-R15 EQU 15
-*
- PRINT NOGEN
-*
-* P R O L O G U E
-*
- USING ABEND,R15
- B SAVEREGS
- DC AL1(7),CL7'ABEND' IDENTIFIER
- DC C'1.00' VERSION.MODIFICATION LEVEL
-SAVEREGS STM R14,R12,12(R13)
- LR R4,R13
- CNOP 0,4
- BAL R13,AROUNDSA
-SAVEAREA DC 18F'0'
- DROP R15
- USING SAVEAREA,R13
-AROUNDSA ST R13,8(0,R4)
- ST R4,4(0,R13)
- XC 8(4,R13),8(R13)
-*
- LTR R1,R1 IS THERE AN ARGUMENT ?
- BZ DEFAULT NO, BRANCH
-*
- L R1,0(0,R1) R1 -> ARGUMENT
- L R1,0(0,R1) R1 := USER-SUPPLIED COMPLETION CODE
- CL R1,=F'4095' IS IT IN THE RANGE 0-4095 ?
- BNH ABEND1 YES, BRANCH
-*
-DEFAULT LA R1,1 DEFAULT COMPLETION CODE TO 1
-*
-ABEND1 ABEND (R1),DUMP ISSUE ABEND MACRO
-*
- LTORG
-*
- END
-#ifdef CERNLIB_TCGEN_ABEND
-#undef CERNLIB_TCGEN_ABEND
-#endif
-#ifdef CERNLIB_SYOS_REENT
-#undef CERNLIB_SYOS_REENT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/sycern/abuser.s b/src/packlib/kernlib/kerngen/obsolete/kernibm/sycern/abuser.s
deleted file mode 100644
index 9a46cc7..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/sycern/abuser.s
+++ /dev/null
@@ -1,127 +0,0 @@
-*
-* $Id: abuser.s,v 1.1.1.1 1996/02/15 17:53:19 mclareni Exp $
-*
-* $Log: abuser.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:19 mclareni
-* Kernlib
-*
-*
-ABUSER CSECT
-*
-* CERN PROGLIB# Z036 ABUSER .VERSION KERNIBM 1.11 820328
-*
-*********************************************************************
-*
-* CALLING SEQUENCE: CALL ABUSER(NAME)
-*
-* FUNCTION: SUPPLIES THE CERN FORTRAN ABEND PROCESSOR WITH THE
-* NAME OF A USER-SUPPLIED SUBROUTINE TO BE CALLED
-* DURING ABEND PROCESSING. THE ENTRY POINT ADDRESS
-* OF THE USER-SUPPLIED SUBROUTINE IS STORED IN THE SCB
-* BY ISSUING THE ESTAE MACRO IN OVERRIDE MODE, (IT IS
-* ASSUMED THAT THE CURRENT SCB IS THE ONE ESTABLISHED
-* BY IHOECOMH). THE ENTRY POINT ADDRESS IS
-* SUBSEQUENTLY RECEIVED BY IHOSTAE IN THE SDWAPARM
-* FIELD OF THE SDWA. THE USER-SUPPLIED SUBROUTINE MUST
-* BE CAPABLE OF RECEIVING A CALL OF THE FORM
-* CALL NAME(KODES,KODEU) WHERE KODES WILL BE THE SYSTEM
-* COMPLETION CODE AND KODEU THE USER COMPLETION CODE.
-* ABUSER MAY BE CALLED AT ANY TIME DURING NORMAL PROGRAM
-* EXECUTION, (I.E. BEFORE ABEND), TO RE-SPECIFY THE
-* NAME OF THE USER-SUPPLIED SUBROUTINE. CALL ABUSER(0)
-* CAUSES THE NAME TO BE CANCELLED. THE USER-SUPPLIED
-* SUBROUTINE WILL BE CALLED DURING ABEND PROCESSING TO
-* PERFORM PRE-TERMINATION CLEAN UP AND IS INTENDED TO
-* BE A USER-SUPPLIED EXTENSION OF ABEND PROCESSING.
-* THE USER-SUPPLIED SUBROUTINE MUST BE IN VIRTUAL
-* STORAGE WHEN THE ABEND OCCURS (I.E. IT SHOULD BE
-* IN THE ROOT SEGMENT OF AN OVERLAY PROGRAM).
-*
-* ARGUMENTS: NAME - THE NAME OF A USER-SUPPLIED SUBROUTINE.
-* IT MUST APPEAR IN AN EXTERNAL STATEMENT
-* IN THE PROGRAM WHICH CALLS ABUSER.
-*
-*********************************************************************
-*
-*********************************************************************
-*
-* M O D I F I C A T I O N L O G
-* ===============================
-*
-*********************************************************************
-*
-* 1 . 0 1
-* =======
-*
-* ENTRY POINT REENT ADDED FOR HYDRA USERS. CALL REENT(NAME) HAS THE
-* SAME EFFECT AS CALL ABUSER(NAME).
-*
-* R. MATTHEWS, CERN/DD, MAY 1980.
-*
-*********************************************************************
-*
-R0 EQU 0
-R1 EQU 1
-R2 EQU 2
-R3 EQU 3
-R4 EQU 4
-R5 EQU 5
-R6 EQU 6
-R7 EQU 7
-R8 EQU 8
-R9 EQU 9
-R10 EQU 10
-R11 EQU 11
-R12 EQU 12
-R13 EQU 13
-R14 EQU 14
-R15 EQU 15
-*
- PRINT NOGEN
-*
- ENTRY REENT
-*
-REENT EQU *
-*
-* P R O L O G U E
-*
- USING ABUSER,R15
- B SAVEREGS
- DC AL1(7),CL7'ABUSER' IDENTIFIER
- DC C'1.01' VERSION.MODIFICATION LEVEL
-SAVEREGS STM R14,R12,12(R13)
- LR R4,R13
- CNOP 0,4
- BAL R13,AROUNDSA
-SAVEAREA DC A(EPILOGUE),17F'0'
- DROP R15
- USING SAVEAREA,R13
-AROUNDSA ST R13,8(0,R4)
- ST R4,4(0,R13)
- XC 8(4,R13),8(R13)
-*
- LR R11,R1 R11 -> ARGUMENT LIST
-*
- L R3,0(0,R11) R3 -> E.P. ADDRESS OF USER ROUTINE
- L R3,0(0,R3) R3 := E.P. ADDRESS OF USER ROUTINE
-*
- L R2,16 R2 -> CVT
- L R2,0(0,R2) R2 := CVTTCBP
- L R2,4(0,R2) R2 -> TCB
- L R2,160(0,R2) R2 -> CURRENT SCB
- L R2,4(0,R2) R2 := ESTAE EXIT ROUTINE ADDRESS
-*
- ESTAE (R2),OV,PARAM=(R3),PURGE=QUIESCE,ASYNCH=NO,TERM=YES
-*
-* E P I L O G U E
-*
-EPILOGUE EQU *
- L R13,4(0,R13)
- LM R14,R12,12(R13)
- OI 12(R13),X'FF'
- BR R14
-*
- END
-#ifdef CERNLIB_SYOS_REENT
-#undef CERNLIB_SYOS_REENT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/sycern/linepg.s b/src/packlib/kernlib/kerngen/obsolete/kernibm/sycern/linepg.s
deleted file mode 100644
index b23dd01..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/sycern/linepg.s
+++ /dev/null
@@ -1,327 +0,0 @@
-*
-* $Id: linepg.s,v 1.1.1.1 1996/02/15 17:53:19 mclareni Exp $
-*
-* $Log: linepg.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:19 mclareni
-* Kernlib
-*
-*
-LINEPG CSECT
-*
-* CERN PROGLIB# Z033 LINEPG .VERSION KERNIBM 2.12 850529
-*
-* THIS ROUTINE RETURNS THE VALUE OF THE JES (JOB ENTRY SUBSYSTEM)
-* LINES PER PAGE PARAMETER. IT USES A CERN WRITTEN SVC NUMBER 250
-* ($XGET) AND A SHADOW JES JCT DSECT (MACRO $XJES). IT WILL NOT
-* WORK OUTSIDE OF CERN. TO ASSEMBLE AT CERN REQUIRES 800K REGION PLUS
-*
-* ALB1='SYS2.CRNMAC',
-* ALB2='SYS1.MACLIB',
-* ALB3='SYS1.AMODGEN,VOL=REF=PASSWORD'
-*
-**************************************************
-*
-* A. BERGLUND / CERN DATE: MARCH 1981
-*
-**************************************************
-*
-*
-* CALL FROM FORTRAN LIKE
-*
-* CALL LINEPG(FTN STREAM NO OR 'DDNAME' ,IARRAY)
-* IARRAY(1)= 'NORMAL' LINES PER PAGE
-* 2 PHYSICAL NR LINES ON THE PAPER
-* 3 HW IMPOSED TOP MARGIN
-* 4 HW IMPOSED BOTTOM MARGIN
-* 5 EXTRA TOP MARGIN AT PAGE THROW
-* 6 EXTRA BOTTOM MARGIN
-*
-* LINES PER PAGE IS I*4
-*
-*
-*-----
-R0 EQU 0
-R1 EQU 1
-JCTF EQU 2
-R3 EQU 3
-R4 EQU 4
-R5 EQU 5
-R6 EQU 6
-R7 EQU 7
-R8 EQU 8
-R9 EQU 9
-R10 EQU 10
-R11 EQU 11
-R12 EQU 12
-R13 EQU 13
-R14 EQU 14
-R15 EQU 15
-*---------
-*
-* P R O L O G U E
-*
- USING LINEPG,R15
- B SAVEREGS
- DC AL1(7),CL7'LINEPG' IDENTIFIER
- DC C'1.00' VERSION.MODIFICATION LEVEL
-SAVEREGS STM R14,R12,12(R13)
- LR R4,R13
- CNOP 0,4
- BAL R13,AROUNDSA
-SAVEAREA DC A(EPILOGUE),17F'0'
- DROP R15
- USING SAVEAREA,R13
-AROUNDSA ST R13,8(0,R4)
- ST R4,4(0,R13)
- XC 8(4,R13),8(R13)
-*
- LR R12,R1 R12 -> ARGUMENT LIST
-*---------
-*
-* GET THE INTERESTING PARTS OF THE JCT
-* USING THE CERN WRITTEN SVC 250
-*
- $XGET AREA=FJCT,FIELDS=(J2)
- LTR R15,R15
- BNZ ERROR
- LA JCTF,FJCT ADDRESS OF FILED
- USING XJ2DSECT,JCTF
- SR R3,R3 CLEAR R3
- IC R3,XCTLINCT GET LINECOUNT BYTE
- LTR R3,R3 CHECK IF ZERO (IE DEFAULT)
- BZ DEFAULT
- L R4,4(R12) ADDRESS OF 2ND ARG
- ST R3,0(R4) STORE RESULT
- ST R3,4(R4) STORE AS 2ND ELEMENT
- MVC 8(16,R4),ZERO MOVE 4 FULLWORDS OF ZERO
- B EPILOGUE RETURN
-ZERO DC 4F'0'
-*
-* FOR DEFAULT YOU HAVE TO GET THE PHYSICAL
-* CAPABILITY OF THE DEVICE
-*
-DEFAULT EQU *
-*
-* SEE FIRST IF IT IS R4 AT CERN
-* I.E. GOING TO CDC
-*
- CLC XCTPROUT,=X'1104' NODE 11 RMT 4
- BE CDC IF SO GO AND SET UP CDC
- SR 10,10
- L 2,0(R12) ADDRESS OF 1ST PARAMETER
- SR 3,3
- IC 3,0(2) FIRST BYTE - 0 IF INTEGER
- LTR 3,3 SEE IF ZERO
- BZ CONCAT CONSTRUCT DDNAME
- LD 2,0(2) DDNAME IN FLPR 2/3
- B CVTF
-CONCAT L 3,0(2) I*4 STREAM NO
- CVD 3,TEMP8
- MVC EDITAREA(L'PATTERN1),PATTERN1
- ED EDITAREA(L'PATTERN1),TEMP8+6
- MVC FTFILE+2(2),EDITAREA+1
- LD 2,FTFILE DDNAME INTO FLPR 2/3
-CVTF L 11,16 ADDRESS OF CVT
- L 11,0(11) ADDRESS OF TCB WORDS
- L 11,4(11) ADDRESS OF CURRENT TCB
- L 11,12(11) ADDRESS OF USER'S TIOT
- LA 11,24(11) ADDRESS OF FIRST DD ENTRY IN TIOT
-*
-NEXTDD IC 10,0(11) BYTE COUNT LENGTH OF DD ENTRY
- LTR 10,10 SEE IF ZERO (END OF TIOT)
- BZ ENDTIOT
- CD 2,4(11) COMPARE DDNAME
- BE FOUND
- AR 11,10 SKIP THIS DD ENTRY
- B NEXTDD
-*
-* DDNAME WAS NOT IN TIOT DDNAME LIST
-*
-ENDTIOT EQU * CODE FOR DDNAME MISSING
-SET56 EQU * VARIOUS BRANCHES TO HERE TO SET DEFAULT 56
-* MOSTLY DUE TO ERRORS OF ONE SORT OR OTHER
- LA R3,NORMAL SET IT TO DEFAULT 56
- L R4,4(R12) ADDRESS OF SECOND ARGUMENT
- MVC 0(24,R4),0(R3) MOVE 6 FULLWORDS
- B EPILOGUE AND RETURN
-FOUND L 6,11(11) ADDRESS OF JFCB-10(HEX)
- LA 6,16(6) ADDRESS OF JCFB
- USING INFMJFCB,6
-*
-* WE NEED THE SIOT FOR SYSOUT CLASS
- L 11,16 CVT
- L 11,0(11) TCB WORDS
- L 11,4(11) CURRENT TCB
- L 11,180(11) JSCB
- L 11,260(11) JCT-10 HEX
- L 11,47(11) SCT-10 HEX
-LOOP L 10,35(11) NEXT SCT-10
- LTR 10,10 TEST IF ZERO
- BZ LAST
- LR 11,10
- B LOOP
-LAST L 11,27(11) START OF SIOT QUEUE OF CURRENT STEP
-* THEN LOOK FOR THE SIOT FOR PROPER
- LA 11,16(11) UPDATE TO START OF SIOT
- CD 2,4(11) COMPARE FIRST ONE IN QUEUE
-* DDNAME
- BNE SIOTLP IF NOT GO INTO LOOP
- B SIOTFND
-SIOTLP L 8,152(11) NEXT SIOT
- LTR 8,8 END OF QUEUE?
- BZ NOSIOT
- LR 11,8
- CD 2,4(11) COMPARE DDNAMES
- BE SIOTFND
- B SIOTLP
-NOSIOT EQU * TAKE THE DEFAULT
- B SET56 SET DEFAULT AND RETURN
-SIOTFND EQU *
- USING INDMSIOT,11
- TM JFCBTSDM,JFCSDS TEST IF SYSIN OR SYSOUT
- BZ SET56 IF NOT SET DEFAULT
- CLI SCTOUTPN,C'W' SEE IF SYSOUT=W
- BE CLASSW
- CLI SCTOUTPN,C'F' SEE IF SYSOUT=F
- BE CLASSF
- CLI SCTOUTPN,C'C' SEE IF SYSOUT=C
- BE CLASSC
-*
-* NOT ON THE 3800
-*
- B SET56 SO SET IT TO 56
-*
-CLASSW EQU *
- CLC JFCFCBID(4),=C'W6 '
- BNE W2
- LA R3,W66 66 LINES PER PAGE
- B SETR3
-W2 CLC JFCFCBID(4),=C'W8 '
- BNE W3
- LA R3,W88 88 LINES PER PAGE
- B SETR3
-W3 CLC JFCFCBID(4),=C'W12 '
- BNE SET56 IF USER GOOFED => 56
- LA R3,W132 132 LINES PER PAGE
- B SETR3
-CLASSF EQU *
- CLC JFCFCBID(4),=C'N6 '
- BNE F2
- LA R3,F44 44 LINES PER PAGE
- B SETR3
-F2 CLC JFCFCBID(4),=C'N8 '
- BNE F3
- LA R3,F58 58 LINES PER PAGE
- B SETR3
-F3 CLC JFCFCBID(4),=C'N12 '
- BNE SET56 IF USER GOOFED => 56
- LA R3,F88 88 LINES PER PAGE
- B SETR3
-CLASSC EQU *
- LA R3,CNORMAL XEROX DEFAULT VALUES
- B SETR3
-CDC EQU *
- LA R3,CDCR CDC 'RIOS' VALUES
-SETR3 EQU *
- L R4,4(R12) ADDRESS OF SECOND ARGUMENT
- MVC 0(24,R4),0(R3) MOVE 6 FULLWORDS
- B EPILOGUE
-ERROR EQU *
- L R4,4(R12) ADDRESS OF 2ND ARGUMENT
- ST R15,4(R4) 2ND ELEMENT OF ARRAY
- LA R15,999(0)
- ST R15,0(R4) SET 'ERROR VALUE'
- B EPILOGUE
-* E P I L O G U E
-*
-EPILOGUE EQU *
- L R13,4(0,R13)
- LM R14,R12,12(R13)
- OI 12(R13),X'FF'
- BR R14
-*---------
-* D A T A A R E A S
-*
-TEMP8 DS D
-EDITAREA DS 3C
-PATTERN1 DC X'212020'
-FTFILE DC CL8'FT??F001'
- LTORG
-NORMAL DC F'56' MAX LINES PER PAGE
- DC F'64' PHYSICAL SIZE OF PAGE
- DC F'0' IMPOSED TOP MARGIN
- DC F'0' IMPOSED BOTTOM MARGIN
- DC F'2' EXTRA TOP MARGIN (AT PAGE EJECT)
- DC F'6' EXTRA BOTTOM MARGIN
-W66 DC F'66' MAX LINES PER PAGE
- DC F'72' PHYSICAL SIZE OF PAGE
- DC F'3' IMPOSED TOP MARGIN
- DC F'3' IMPOSED BOTTOM MARGIN
- DC F'0' EXTRA TOP MARGIN (AT PAGE EJECT)
- DC F'0' EXTRA BOTTOM MARGIN
-W88 DC F'88' MAX LINES PER PAGE
- DC F'96' PHYSICAL SIZE OF PAGE
- DC F'4' IMPOSED TOP MARGIN
- DC F'4' IMPOSED BOTTOM MARGIN
- DC F'0' EXTRA TOP MARGIN (AT PAGE EJECT)
- DC F'0' EXTRA BOTTOM MARGIN
-W132 DC F'132' MAX LINES PER PAGE
- DC F'144' PHYSICAL SIZE OF PAGE
- DC F'6' IMPOSED TOP MARGIN
- DC F'6' IMPOSED BOTTOM MARGIN
- DC F'0' EXTRA TOP MARGIN (AT PAGE EJECT)
- DC F'0' EXTRA BOTTOM MARGIN
-F44 DC F'44' MAX LINES PER PAGE
- DC F'50' PHYSICAL SIZE OF PAGE
- DC F'4' IMPOSED TOP MARGIN
- DC F'2' IMPOSED BOTTOM MARGIN
- DC F'0' EXTRA TOP MARGIN (AT PAGE EJECT)
- DC F'0' EXTRA BOTTOM MARGIN
-F58 DC F'58' MAX LINES PER PAGE
- DC F'67' PHYSICAL SIZE OF PAGE
- DC F'6' IMPOSED TOP MARGIN
- DC F'3' IMPOSED BOTTOM MARGIN
- DC F'0' EXTRA TOP MARGIN (AT PAGE EJECT)
- DC F'0' EXTRA BOTTOM MARGIN
-F88 DC F'88' MAX LINES PER PAGE
- DC F'100' PHYSICAL SIZE OF PAGE
- DC F'8' IMPOSED TOP MARGIN
- DC F'4' IMPOSED BOTTOM MARGIN
- DC F'0' EXTRA TOP MARGIN (AT PAGE EJECT)
- DC F'0' EXTRA BOTTOM MARGIN
-CNORMAL DC F'56' MAX LINES PER PAGE
- DC F'58' PHYSICAL SIZE OF PAGE
- DC F'1' IMPOSED TOP MARGIN
- DC F'1' IMPOSED BOTTOM MARGIN
- DC F'0' EXTRA TOP MARGIN (AT PAGE EJECT)
- DC F'0' EXTRA BOTTOM MARGIN
-CDCR DC F'62' MAX LINES PER PAGE
- DC F'64' PHYSICAL SIZE OF PAGE
- DC F'0' IMPOSED TOP MARGIN
- DC F'0' IMPOSED BOTTOM MARGIN
- DC F'2' EXTRA TOP MARGIN (AT PAGE EJECT)
- DC F'0' EXTRA BOTTOM MARGIN
-FJCT DS XL(XJ2L) JCT FIELDS
-*---------
- PRINT NOGEN
- TITLE 'DSECTS'
-JFCB DSECT
- IEFJFCBN
-SIOT DSECT
- IEFASIOT
-CVT DSECT
- CVT ,
-*--------- ,
- IKJTCB ,
-*--------- ,
- IEZJSCB ,
- $XJES FIELDS=(J2)
-* EJECT ,
-* CSECT , (JES DSECT MACROS ALWAYS REVERT TO A CSECT)!
-* $SSIB ,
-* $BUFFER , (NEEDED FOR $JCT EXPANSION)
-* $JCT ,
-* $SJB ,
-*
-*--
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/sycern/sycern.h b/src/packlib/kernlib/kerngen/obsolete/kernibm/sycern/sycern.h
deleted file mode 100644
index cb2b02c..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/sycern/sycern.h
+++ /dev/null
@@ -1,13 +0,0 @@
-*
-* $Id: sycern.h,v 1.1.1.1 1996/02/15 17:53:19 mclareni Exp $
-*
-* $Log: sycern.h,v $
-* Revision 1.1.1.1 1996/02/15 17:53:19 mclareni
-* Kernlib
-*
-*
-* This directory was created from kernibm.car patch sycern
-#ifndef CERNLIB_SYMVSSP
-#define CERNLIB_SYMVSSP
-#endif
-* ROUTINES RELYING ON CERN SYSTEM MODIFICATIONS
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/sycernj/abuser.s b/src/packlib/kernlib/kerngen/obsolete/kernibm/sycernj/abuser.s
deleted file mode 100644
index 7c10d41..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/sycernj/abuser.s
+++ /dev/null
@@ -1,177 +0,0 @@
-*
-* $Id: abuser.s,v 1.1.1.1 1996/02/15 17:53:18 mclareni Exp $
-*
-* $Log: abuser.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:18 mclareni
-* Kernlib
-*
-*
-ABUSER CSECT
-*
-* CERN PROGLIB# Z036 ABUSER .VERSION KERNIBM 2.11 850320
-*
-*********************************************************************
-*
-* FUNCTION: RECORD THE ADDRESS OF A USER EXIT ROUTINE AND
-* SUBSEQUENTLY PASS CONTROL TO IT DURING ABEND
-* PROCESSING. THE USER EXIT ROUTINE MUST BE ABLE TO
-* RECEIVE A CALL OF THE FORM 'CALL NAME(KODES,KODEU)'
-* WHERE KODES WILL BE THE SYSTEM COMPLETION CODE AND
-* KODEU THE USER COMPLETION CODE. IT MUST RETURN
-* WHEN ITS PROCESSING IS COMPLETE.
-* ABUSER MAY BE CALLED AT ANY TIME DURING NORMAL
-* PROGRAM EXECUTION TO RE-SPECIFY THE ADDRESS OF THE
-* USER EXIT ROUTINE. CALL ABUSER(0) CANCELS THE EFFECT
-* OF ALL PREVIOUS CALLS.
-*
-* CALLING SEQUENCE: CALL ABUSER(NAME)
-*
-* ARGUMENTS: NAME - THE NAME OF THE USER EXIT ROUTINE WHICH
-* MUST APPEAR IN A FORTRAN EXTERNAL STATEMENT
-*
-* ENTRY POINT: REENT - CALL REENT(NAME) HAS THE SAME EFFECT AS
-* CALL ABUSER(NAME)
-*
-* NOTES: THIS VERSION IS ONLY FOR USE IN A SIEMENS FORTRAN 77
-* ENVIRONMENT. IT CALLS THE SIEMENS SERVICE SUBPROGRAM
-* ENDXIT.
-*
-*********************************************************************
-*
-* MODIFICATION LOG :
-*
-* 1.02 : CMS-COMPATIBLE CODE ADDED.
-* R. MATTHEWS, CERN/DD, DECEMBER 1984.
-*
-* 1.01 : MODIFIED TO TEST THE DETAIL CODE RECEIVED FROM THE FORTRAN
-* LIBRARY; IF IT IS FOUND TO BE ZERO THE USER EXIT IS NOT
-* CALLED. THIS MODIFICATION WAS MADE NECESSARY BY A CORRECTION
-* TO V10L20 OF THE FORTRAN LIBRARY WHICH CAUSES THE EXIT
-* IDENTIFIED IN THE CALL TO ENDXIT TO RECEIVE CONTROL FOR NORMAL
-* TERMINATION AS WELL AS ABNORMAL TERMINATION, (PREVIOUSLY
-* CONTROL WAS ONLY RECEIVED FOR ABNORMAL TERMINATION).
-* R. MATTHEWS, CERN/DD, JULY 1984.
-*
-* 1.00 : ORIGINAL VERSION, R. MATTHEWS, CERN/DD, DECEMBER 1982.
-*
-*********************************************************************
-*
-R0 EQU 0
-R1 EQU 1
-R2 EQU 2
-R3 EQU 3
-R4 EQU 4
-R5 EQU 5
-R6 EQU 6
-R7 EQU 7
-R8 EQU 8
-R9 EQU 9
-R10 EQU 10
-R11 EQU 11
-R12 EQU 12
-R13 EQU 13
-R14 EQU 14
-R15 EQU 15
-*
- PRINT NOGEN
-*
- ENTRY REENT
-*
-REENT EQU *
-*
-* P R O L O G U E
-*
- USING ABUSER,R15
- B SAVEREGS
- DC AL1(7),CL7'ABUSER' IDENTIFIER
- DC C'1.02' VERSION.MODIFICATION LEVEL
-SAVEREGS STM R14,R12,12(R13)
- LR R4,R13
- CNOP 0,4
- BAL R13,AROUNDSA
-SAVEAREA DC A(EPILOGUE),17F'0'
- DROP R15
- USING SAVEAREA,R13
-AROUNDSA ST R13,8(0,R4)
- ST R4,4(0,R13)
- XC 8(4,R13),8(R13)
-*
-* C A L L E N D X I T
-*
- L R2,0(0,R1) R2 -> ADDRESS OF USER EXIT
- L R2,0(0,R2) R2 := ADDRESS OF USER EXIT
- LTR R2,R2 IS IT ZERO ?
- BZ CANCEL YES, BRANCH
-*
- ST R2,USEREXIT STORE IT
- CALL ENDXIT,(F1,AABEXIT,IRC,F0),VL
- B EPILOGUE
-*
-CANCEL CALL ENDXIT,(F0,AABEXIT,IRC,F0),VL
- B EPILOGUE
-*
-* C A L L U S E R E X I T W I T H S C C A N D U C C
-*
- CNOP 0,4
-ABEXIT EQU *
- USING ABEXIT,R15 ESTABLISH ADDRESSABILITY
- B EP0102
-EP0101 DC A(SAVEAREA)
-EP0102 STM R14,R12,12(R13)
- LR R4,R13
- L R13,EP0101
- ST R13,8(0,R4)
- ST R4,4(0,R13)
- XC 8(4,R13),8(R13)
- DROP R15
-*
- LM R2,R3,0(R1) R2 -> RETURN CODE; R3 -> DETAIL CODE
- L R3,0(0,R3) R3 := DETAIL CODE
- LTR R3,R3 IS IT ZERO ?
- BZ EPILOGUE YES, DO NOT CALL THE USER EXIT
-*
-#if defined(CERNLIB_SYCERNV)
- L R2,0(0,R2) R3 := RETURN CODE
- ST R2,UCC STORE THE RETURN CODE
- ST R3,SCC STORE THE DETAIL CODE
-#endif
-#if !defined(CERNLIB_SYCERNV)
- L R2,16 R2 -> CVT
- L R2,0(0,R2) R2 := CVTTCBP
- L R2,4(0,R2) R2 -> TCB
- L R2,224(0,R2) R2 -> RTM2WA
- L R2,28(0,R2) R2 := COMPLETION CODES
- LA R2,0(0,R2) ZERO THE HIGH ORDER BYTE
- SRDL R2,12 R2 := SYSTEM COMPLETION CODE
- ST R2,SCC STORE IT
- SRL R3,20 R3 := USER COMPLETION CODE
- ST R3,UCC STORE IT
-#endif
- L R15,USEREXIT R15 -> USER EXIT
- CALL (15),(SCC,UCC),VL
-*
-* E P I L O G U E
-*
-EPILOGUE EQU *
- L R13,4(0,R13)
- LM R14,R12,12(R13)
- MVI 12(R13),X'FF'
- BR R14
-*
-* D A T A A R E A S
-*
-AABEXIT DC A(ABEXIT)
-F0 DC F'0'
-F1 DC F'1'
-IRC DS F
-SCC DS F
-UCC DS F
-USEREXIT DS F
-*
- END
-#ifdef CERNLIB_SYOS_REENT
-#undef CERNLIB_SYOS_REENT
-#endif
-#ifdef CERNLIB_SYCERN_ABUSER
-#undef CERNLIB_SYCERN_ABUSER
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/symvs/delay.s b/src/packlib/kernlib/kerngen/obsolete/kernibm/symvs/delay.s
deleted file mode 100644
index 340102d..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/symvs/delay.s
+++ /dev/null
@@ -1,52 +0,0 @@
-*
-* $Id: delay.s,v 1.1.1.1 1996/02/15 17:53:19 mclareni Exp $
-*
-* $Log: delay.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:19 mclareni
-* Kernlib
-*
-*
-DELAY CSECT
-*
-* DELAY Wait for some real time and then return to caller
-*
-* USAGE: CALL DELAY (NHSEC)
-*
-* NHSEC Input, INTEGER, number of time units to wait
-* time unit is 26 usec
-*
-* Restrictions: Usage mutually exclusive with that of TMLOG
-*
-* Author: D. Moenkemeyer March 1981
-*
-* ORIGINAL UNEXPANDED FOLLOWS
-*DELAY BEG *,MODE=RENT,RMODE=ANY
-* L 2,0(1) GET ADDRESS OF TIMER UNITS
-* STIMER WAIT,TUINTVL=(2) WAIT
-* SCHL RET=0,MODE=RENT
-* END
-*
-DELAY RMODE ANY
-DELAY AMODE ANY
- ENTRY DELAY
- USING *,12
- B 10(0,15) BRANCH AROUND ID
- DC AL1(5) LENGTH OF ID
- DC CL5'DELAY'
- STM 14,12,12(13) SAVE CALLER'S REGISTER
- LR 12,15 LOAD BASE
- GETMAIN R,LV=72
- ST 13,4(1) BACKWARD CHAIN
- ST 1,8(13) FORWARD CHAIN
- LR 15,13
- LR 13,1
- LM 15,1,16(15) RESTORE ALL REGISTER
- L 2,0(1) GET ADDRESS OF TIMER UNITS
- STIMER WAIT,TUINTVL=(2) WAIT
- LR 1,13
- L 13,4(13) RELOAD SA-REG
- FREEMAIN R,LV=72,A=(1)
- LM 14,12,12(13) RESTORE CALLER'S REGISTER
- XR 15,15
- BR 14 RETURN TO CALLER
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/symvs/sleepf.F b/src/packlib/kernlib/kerngen/obsolete/kernibm/symvs/sleepf.F
deleted file mode 100644
index c6c114d..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/symvs/sleepf.F
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: sleepf.F,v 1.1.1.1 1996/02/15 17:53:19 mclareni Exp $
-*
-* $Log: sleepf.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:19 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE SLEEPF (ISEC)
-C
-C CERN PROGLIB# Z265 SLEEPF .VERSION KERNIBM 2.33 920229
-C ORIG. 08/03/91, Harald Keller / DESY
-C Fortran interface to SLEEP
-C
- DATA CYCLE/26E-6/
-
- NCYCS=IFIX(1./CYCLE) * ISEC
- CALL DELAY(NCYCS)
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/symvs/symvs.h b/src/packlib/kernlib/kerngen/obsolete/kernibm/symvs/symvs.h
deleted file mode 100644
index 709d969..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/symvs/symvs.h
+++ /dev/null
@@ -1,13 +0,0 @@
-*
-* $Id: symvs.h,v 1.1.1.1 1996/02/15 17:53:20 mclareni Exp $
-*
-* $Log: symvs.h,v $
-* Revision 1.1.1.1 1996/02/15 17:53:20 mclareni
-* Kernlib
-*
-*
-* This directory was created from kernibm.car patch symvs
-#ifndef CERNLIB_SYOS
-#define CERNLIB_SYOS
-#endif
-* ROUTINES FOR IBM SYSTEM MVS
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/symvs/timex.s b/src/packlib/kernlib/kerngen/obsolete/kernibm/symvs/timex.s
deleted file mode 100644
index 8dcb6fb..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/symvs/timex.s
+++ /dev/null
@@ -1,146 +0,0 @@
-*
-* $Id: timex.s,v 1.1.1.1 1996/02/15 17:53:20 mclareni Exp $
-*
-* $Log: timex.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:20 mclareni
-* Kernlib
-*
-*
-TIMEX CSECT
-*
-* CERN PROGLIB# Z007 TIMEX .VERSION KERNIBM 1.04 781218
-*
-* ENTRY TIMEX .ELAPSED JOB STEP TIME
-#if defined(CERNLIB_QMIBMXA)
-* SPLEVEL SET=2
-TIMEX AMODE ANY
-TIMEX RMODE ANY
-#endif
- ENTRY TIMED .CP TIME SINCE LAST CALL
- ENTRY TIMEL .REMAINING JOB STEP TIME
-*
-* THIS IS THE MOST SIMPLE MVS VERSION OF TIMED REQUIRING ONLY
-* ADDRESSIBILITY TO THE ASCB CONTROL BLOCK. THE ACCURACY FOR ALL
-* ENTRY POINTS IS HENCE 10'S OF MILLISECONDS WITH UPDATES ONLY WHEN
-* DISPATCHED HENCE VERY INNACURATE (BY SECONDS) RESULTS ARE POSSIBLE.
-*
-R0 EQU 0
-R1 EQU 1
-R2 EQU 2
-R3 EQU 3
-R4 EQU 4
-R5 EQU 5
-R6 EQU 6
-R7 EQU 7
-R8 EQU 8
-R9 EQU 9
-R10 EQU 10
-R11 EQU 11
-R12 EQU 12
-R13 EQU 13
-R14 EQU 14
-R15 EQU 15
-*
-F0 EQU 0
-F2 EQU 2
-*
- USING TIMEX,R12 SET ADDRESSABILITY
- BC 15,12(R15)
- DC X'7'
- DC CL7'TIMEX '
- STM R2,R12,28(R13)
- LR R12,R15
- B BEGIN
- DS 0F FORCE ALIGNMENT ON WORD BOUNDARY
-TIMED BC 15,16(R15)
- DC X'7'
- DC CL7'TIMED '
- DC A(TIMEX)
- STM R2,R12,28(R13)
- L R12,12(R15)
- B BEGIN
-TIMEL BC 15,16(R15)
- DC X'7'
- DC CL7'TIMEL '
- DC A(TIMEX)
- STM R2,R12,28(R13)
- L R12,12(R15)
- USING CVT,R2 ESTABLISH CVT ADDRESSABILITY
- USING ASCB,R4 ESTABLISH ASCB ADDRESSABILITY
-*
-BEGIN L R2,CVTPTR GET CVT POINTER
- L R3,CVTTCBP GET ADDRESS OF 4-WORD LIST
- L R4,12(R3) GET CURRENT ASCB ADDRESS
- LM R6,R7,ASCBEJST GET ELAPSED JOB STEP TIME
- SRDA R6,12 (R6,R7) BIT 51 = 1 MICROSECOND
- D R6,=F'100' CONVERT INTO TENTHS OF MILLISECOND
- X R7,FOURE+4
- ST R7,TEMPF+4
- LD F0,TEMPF
- SD F0,FOURE
- DE F0,=E'10000.' CONVERT INTO SECONDS
- CLI 9(R15),C'X'
- BE STRESULT
-*
- CLI 9(R15),C'L'
- BE TIMLEFT
- LER F2,F0
- SE F0,LAST SUBTRACT PRECEDING TIME VALUE
- STE F2,LAST STORE NEW TIME VALUE
- B STRESULT
-*
-TIMLEFT L R11,ASCBJSTL GET JOB STEP TIME LIMIT
- X R11,FOURE+4
- ST R11,TEMPF+4
- LD F2,TEMPF
-* TIME IS ACTUALLY IN 1.048576 SECS
-* CF PRINC. OF OPER. PG 47...
-* MOD. BY ANDERS BERGLUND OCTOBER 1978
- SD F2,FOURE JOB STEP TIME LIMIT (FLOATING POINT
- MD F2,=D'1.048576'
- SER F2,F0 REMAINING JOB STEP TIME
- LER F0,F2
- BNM OPSTOP
- SER F0,F0
-*---SET REMAINING TIME TO ZERO IF OPERATOR HAS ISSUED A STOP COMMAND
-*---MODIFIED BY WIEGANDT/RICHARDS JAN 17 1977
-OPSTOP ICM R3,15,COMECBAD
- BNZ TESTECB
- LR R5,R1 SAVE R1 HERE
- EXTRACT CPTR,FIELDS=COMM
- LR R1,R5 RESTORE CONTENTS OF R1
- L R3,CPTR
- L R3,0(R3) ADDRESS(COMMUNICATIONS ECB)
- ST R3,COMECBAD
-TESTECB TM 0(R3),X'40' ECB POSTED
- BNO STRESULT
- SER F0,F0
-STRESULT L R9,0(R1)
- STE F0,0(R9) STORE RESULT
- LM R2,R12,28(R13)
- SR R15,R15 SET RETURN CODE
- BCR 15,R14 RETURN
-*
- DS 0D FORCE ALIGNMENT ON DOUBLEWORD BOUNDARY
-FOURE DC X'4E000000'
- DC X'80000000'
-TEMPF DC X'4E000000'
- DC F'0'
-LAST DC F'0'
-CPTR DC F'0'
-COMECBAD DC F'0' INITIALIZE TO ZERO
-PATCH DC 64S(*) PATCH AREA
-*
-* CVT DSECT=YES,LIST=YES
- CVT DSECT=YES,LIST=NO
- IHAASCB DSECT=YES
- END
-#ifdef CERNLIB_TCGEN_TIMED
-#undef CERNLIB_TCGEN_TIMED
-#endif
-#ifdef CERNLIB_TCGEN_TIMEL
-#undef CERNLIB_TCGEN_TIMEL
-#endif
-#ifdef CERNLIB_TCGEN_TIMEX
-#undef CERNLIB_TCGEN_TIMEX
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/symvs/timexn.s b/src/packlib/kernlib/kerngen/obsolete/kernibm/symvs/timexn.s
deleted file mode 100644
index 01cd079..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/symvs/timexn.s
+++ /dev/null
@@ -1,207 +0,0 @@
-*
-* $Id: timexn.s,v 1.1.1.1 1996/02/15 17:53:19 mclareni Exp $
-*
-* $Log: timexn.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:19 mclareni
-* Kernlib
-*
-*
-TIMEX CSECT
-*
-* CERN PROGLIB# Z007 TIMEX NEW .VERSION KERNIBM 1.11 820328
-*
-* TIMEX EXECUTION TIME USED SO FAR (SECONDS)
-#if defined(CERNLIB_QMIBMXA)
-* SPLEVEL SET=2
-TIMEX AMODE ANY
-TIMEX RMODE ANY
-#endif
- ENTRY TIMED EXECUTION TIME SINCE LAST CALL (SEC)
- ENTRY TIMEL EXECUTION TIME LEFT UNTIL TIME LIMIT (S)
-*
-* IN CASE OF TROUBLE YOU MAY DELETE THIS DECK,
-* WHICH GIVES YOU THE OLD TIMEX IN THE NEXT DECK
-*
-*******************************************************************
-*
-* A. BERGLUND / CERN DATE: 27/02/80
-*
-* THE STEP TIME LIMIT IS GIVEN BY ASCBJSTL (4 BYTES)
-* IN UNITS OF 1.048576 SECONDS.
-*
-* THE ELAPSED TIME UP TO THE LAST DISPATCH IS GIVEN BY
-* ASCBEJST (8 BYTES) WITH BIT 51 = 1 MICROSECOND.
-* IT IS HOWEVER ONLY UPDATED BY THE DISPATCHER WHEN
-* ANOTHER ADDRESS SPACE IS GIVEN CONTROL
-*
-* IN MVS/SE UPDATING OF THE ASCBEJST IS FORCED BY
-* AN SVC 137 (CALLDISP) CALL.
-*
-* IN A NON SE SYSTEM ONE CAN USE THE FOLLOWING
-* THE BEST ESTIMATE FOR THE CURRENT ELAPSED TIME
-* IS THE ASCBEJST +
-* THE CURRENT TOD - TOD AT LAST DISPATCH (FROM LCCADTOD).
-*
-* THE CORRECT CALCULATION IS MADE FOR TIMED ONLY
-* SINCE THE ACCURACY OF THE ASCBEJST IS SOME
-* 10'S OF MILLISECONDS - GOOD ENOUGH FOR TIMEX & TIMEL.
-* ACCURACY OF TIMED IS AROUND 50 MICROSECONDS FOR A NON SE
-* SYSTEM. IN MVS/SE THE ACCURACY IS ABOUT 20 MICROSECONDS
-* (RMS OF DISTRIBUTION). TIME BETWEEN TWO CONSECUTIVE CALLS
-* WITH NO CODE IN BETWEEN IS ABOUT 50 MICROSECONDS.
-*
-*******************************************************************
-*
-R1 EQU 1
-R2 EQU 2
-R3 EQU 3
-R4 EQU 4
-R5 EQU 5
-R6 EQU 6
-R13 EQU 13
-R14 EQU 14
-R15 EQU 15
-F0 EQU 0
-F2 EQU 2
-F4 EQU 4
-F6 EQU 6
-*
- STM R2,R5,28(R13) SAVE REGS
- USING TIMEX,R15 ADDRESSABILITY
- L R4,CVTPTR
- USING CVT,R4 ADDRESSABILITY OF CVT
- L R5,CVTTCBP ADDRESS OF 4 WORD LIST
- L R5,12(R5) CURRENT ASCB
- USING ASCB,R5 ADDRESSABILITY OF ASCB
- LM R2,R3,ASCBEJST ELAPSED JOB STEP TIME
- SRDA R2,12 BIT 51 = 1 MICROSECOND
- STM R2,R3,TEMPD STORE TEMPORARILY
- MVI TEMPD,X'4E' MOVE IN EXPONENT
- LD F0,TEMPD LOAD FP (UNNORM)
- DD F0,=D'1000000.' GET INTO SECONDS
- L R2,0(R1) ADDRESS OF TARGET
- STE F0,0(R2) STORE AS REAL*4
- LM R2,R5,28(R13) RESTORE REGS
- BR R14 & RETURN
- DROP R15
- DROP R4
- DROP R5
-*
-TIMED EQU * TIME SINCE LAST ENTRY
- USING TIMED,R15
- STM R2,R5,28(R13) SAVE REGS
- L R4,CVTPTR
- USING CVT,R4 ADDRESSABILITY OF CVT
- L R5,CVTTCBP ADDRESS OF 4 WORD LIST
- L R5,12(R5) CURRENT ASCB
-#if defined(CERNLIB_SYMVSSE)
-* FORCE ASCB UPDATING MVS/SE
- LR R2,R15 MVS/SE
- LR R3,R1 MVS/SE
- CALLDISP MVS/SE
- LR R15,R2 MVS/SE
- LR R1,R3 MVS/SE
-#endif
- USING ASCB,R5 ADDRESSABILITY OF ASCB
- LM R2,R3,ASCBEJST ELAPSED JOB STEP TIME
- SRDA R2,12 BIT 51 = 1 MICROSECOND
- STM R2,R3,TEMPD STORE TEMPORARILY
- MVI TEMPD,X'4E' MOVE IN EXPONENT
- LD F0,TEMPD LOAD FP (UNNORM)
- DD F0,=D'1000000.' GET INTO SECONDS
- DROP R4
- DROP R5
-#if !defined(CERNLIB_SYMVSSE)
- L R4,PSALCCAV-PSA VIRT ADDRESS OF LCCA
- USING LCCA,R4 ADDRESSABILITY OF LCCA
- LM R2,R3,LCCADTOD TOD WHEN TCB IS DESPATCHED
- STCK TODCLOCK TOD NOW
- N R2,=X'7FFFFFFF' MASK OFF SIGN BIT
- SRDA R2,12 BIT 51 = 1 MICROSECOND
- STM R2,R3,TEMPD STORE TEMPORARILY
- MVI TEMPD,X'4E' MOVE IN EXPONENT
- LD F4,TEMPD
- DD F4,=D'1000000.' GET INTO SECONDS
- LM R2,R3,TODCLOCK LOAD TODCLOCK
- N R2,=X'7FFFFFFF' MASK OFF SIGN BIT
- SRDA R2,12 BIT 51 = 1 MICROSECOND
- STM R2,R3,TEMPD STORE TEMPORARILY
- MVI TEMPD,X'4E' MOVE IN EXPONENT
- LD F6,TEMPD LOAD FP
- DD F6,=D'1000000.' GET INTO SECONDS
- SDR F6,F4 TOD NOW - TOD AT LAST DISPATCH
- ADR F0,F6 ADD ON TO ELAPSED AT LAST DISP
-#endif
- LDR F2,F0 SAVE
- SD F0,LAST SUBTRACT TIME AT LAST ENTRY
- STD F2,LAST SAVE THIS ELAPSED
- L R5,0(R1) ADDRESS OF RESULT
- STE F0,0(R5) STORE AS REAL*4
- LM R2,R5,28(R13) RESTORE REGS
- BR R14 & RETURN
- DROP R15
-*
-TIMEL EQU * TIME LEFT UNTIL TIME LIMIT
- STM R2,R6,28(R13) SAVE REGS
- LR R6,R15
- USING TIMEL,R6
- L R4,CVTPTR
- USING CVT,R4 ADDRESSABILITY OF CVT
- L R5,CVTTCBP ADDRESS OF 4 WORD LIST
- L R5,12(R5) CURRENT ASCB
- USING ASCB,R5 ADDRESSABILITY OF ASCB
- L R2,ASCBJSTL JOB STEP TIME LIMIT
- S R2,ASCBEJST SUBTRACT OFF TOP HALF OF ELAPSED
- ST R2,TEMPD+4 STORE TEMPORARILY
- MVC TEMPD(4),=X'4E000000' MOVE IN EXPONENT HALF
- LD F2,TEMPD OAD FP
- MD F2,=D'1.048576' INTO SECONDS
- LDR F0,F2 LOAD & TEST
- BNM OPSTOP
- SDR F0,F0 IF NEG SET TO ZERO
- DROP R4
- DROP R5
-*---SET REMAINING TIME TO ZERO IF OPERATOR HAS ISSUED A STOP COMMAND
-*---MODIFIED BY WIEGANDT/RICHARDS JAN 17 1977
-OPSTOP ICM R3,15,COMECBAD
- BNZ TESTECB
- LR R5,R1 SAVE R1 HERE
- EXTRACT CPTR,FIELDS=COMM
- LR R1,R5 RESTORE CONTENTS OF R1
- L R3,CPTR
- L R3,0(R3) ADDRESS(COMMUNICATIONS ECB)
- ST R3,COMECBAD
-TESTECB TM 0(R3),X'40' ECB POSTED
- BNO STRESULT
- SER F0,F0
-STRESULT EQU *
- L R4,0(R1) ADDRESS OF RESULT
- STE F0,0(R4) STORE AS REAL*4
- LM R2,R6,28(R13) RESTORE REGS
- BR R14 & RETURN
-LAST DC D'0' ELAPSED TIME AT LAST ENTRY
-TODCLOCK DS D TOD
-TEMPD DS D TEMPORARY FOR FIX -> FLOAT
-CPTR DC F'0'
-COMECBAD DC F'0'
- LTORG
-*
- CVT DSECT=YES,LIST=YES
- IHAASCB DSECT=YES
-#if !defined(CERNLIB_SYMVSSE)
- IHALCCA
- IHAPSA
-#endif
- END
-#ifdef CERNLIB_SYMVS_TIMEX
-#undef CERNLIB_SYMVS_TIMEX
-#endif
-#ifdef CERNLIB_TCGEN_TIMED
-#undef CERNLIB_TCGEN_TIMED
-#endif
-#ifdef CERNLIB_TCGEN_TIMEL
-#undef CERNLIB_TCGEN_TIMEL
-#endif
-#ifdef CERNLIB_TCGEN_TIMEX
-#undef CERNLIB_TCGEN_TIMEX
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/symvs/timexxa.s b/src/packlib/kernlib/kerngen/obsolete/kernibm/symvs/timexxa.s
deleted file mode 100644
index bb16f3c..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/symvs/timexxa.s
+++ /dev/null
@@ -1,215 +0,0 @@
-*
-* $Id: timexxa.s,v 1.1.1.1 1996/02/15 17:53:19 mclareni Exp $
-*
-* $Log: timexxa.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:19 mclareni
-* Kernlib
-*
-*
-#if defined(CERNLIB_QMIBMXA)
-TIMEX CSECT
-*
-* CERN PROGLIB# Z007 TIMEX NEW .VERSION KERNIBM 2.31 901105
-*
-* TIMEX EXECUTION TIME USED SO FAR (SECONDS)
-*
-* There was a problem at DESY: TIMEX specifies AMODE ANY to be
-* able to run "above the line". But it calls the EXTRACT macro.
-* which, with MVS/XA, canNOT run up there.
-* There fore the code was modified by Klaus Tietgen, DESY-R1.
-* Lines added are flagged Tie-A
-* Lines deleted are flagged Tie-D
-*
-* SPLEVEL SET=2
-TIMEX AMODE ANY
-TIMEX RMODE ANY
- ENTRY TIMED EXECUTION TIME SINCE LAST CALL (SEC)
- ENTRY TIMEL EXECUTION TIME LEFT UNTIL TIME LIMIT (S)
-*
-* IN CASE OF TROUBLE YOU MAY DELETE THIS DECK,
-* WHICH GIVES YOU THE OLD TIMEX IN THE NEXT DECK
-*
-*******************************************************************
-*
-* A. BERGLUND / CERN DATE: 27/02/80
-*
-* THE STEP TIME LIMIT IS GIVEN BY ASCBJSTL (4 BYTES)
-* IN UNITS OF 1.048576 SECONDS.
-*
-* THE ELAPSED TIME UP TO THE LAST DISPATCH IS GIVEN BY
-* ASCBEJST (8 BYTES) WITH BIT 51 = 1 MICROSECOND.
-* IT IS HOWEVER ONLY UPDATED BY THE DISPATCHER WHEN
-* ANOTHER ADDRESS SPACE IS GIVEN CONTROL
-*
-* IN MVS/SE UPDATING OF THE ASCBEJST IS FORCED BY
-* AN SVC 137 (CALLDISP) CALL.
-*
-* IN A NON SE SYSTEM ONE CAN USE THE FOLLOWING
-* THE BEST ESTIMATE FOR THE CURRENT ELAPSED TIME
-* IS THE ASCBEJST +
-* THE CURRENT TOD - TOD AT LAST DISPATCH (FROM LCCADTOD).
-*
-* THE CORRECT CALCULATION IS MADE FOR TIMED ONLY
-* SINCE THE ACCURACY OF THE ASCBEJST IS SOME
-* 10'S OF MILLISECONDS - GOOD ENOUGH FOR TIMEX & TIMEL.
-* ACCURACY OF TIMED IS AROUND 50 MICROSECONDS FOR A NON SE
-* SYSTEM. IN MVS/SE THE ACCURACY IS ABOUT 20 MICROSECONDS
-* (RMS OF DISTRIBUTION). TIME BETWEEN TWO CONSECUTIVE CALLS
-* WITH NO CODE IN BETWEEN IS ABOUT 50 MICROSECONDS.
-*
-*******************************************************************
-*
-R1 EQU 1
-R2 EQU 2
-R3 EQU 3
-R4 EQU 4
-R5 EQU 5
-R6 EQU 6
-R13 EQU 13
-R14 EQU 14
-R15 EQU 15
-F0 EQU 0
-F2 EQU 2
-F4 EQU 4
-F6 EQU 6
-*
- STM R2,R5,28(R13) SAVE REGS
- USING TIMEX,R15 ADDRESSABILITY
- L R4,CVTPTR
- USING CVT,R4 ADDRESSABILITY OF CVT
- L R5,CVTTCBP ADDRESS OF 4 WORD LIST
- L R5,12(R5) CURRENT ASCB
- USING ASCB,R5 ADDRESSABILITY OF ASCB
- LM R2,R3,ASCBEJST ELAPSED JOB STEP TIME
- SRDA R2,12 BIT 51 = 1 MICROSECOND
- STM R2,R3,TEMPD STORE TEMPORARILY
- MVI TEMPD,X'4E' MOVE IN EXPONENT
- LD F0,TEMPD LOAD FP (UNNORM)
- DD F0,=D'1000000.' GET INTO SECONDS
- L R2,0(R1) ADDRESS OF TARGET
- STE F0,0(R2) STORE AS REAL*4
- LM R2,R5,28(R13) RESTORE REGS
- BR R14 & RETURN
- DROP R15
- DROP R4
- DROP R5
-*
-TIMED EQU * TIME SINCE LAST ENTRY
- USING TIMED,R15
- STM R2,R5,28(R13) SAVE REGS
- L R4,CVTPTR
- USING CVT,R4 ADDRESSABILITY OF CVT
- L R5,CVTTCBP ADDRESS OF 4 WORD LIST
- L R5,12(R5) CURRENT ASCB
-* FORCE ASCB UPDATING MVS/SE
- LR R2,R15 MVS/SE
- LR R3,R1 MVS/SE
- CALLDISP MVS/SE
- LR R15,R2 MVS/SE
- LR R1,R3 MVS/SE
- USING ASCB,R5 ADDRESSABILITY OF ASCB
- LM R2,R3,ASCBEJST ELAPSED JOB STEP TIME
- SRDA R2,12 BIT 51 = 1 MICROSECOND
- STM R2,R3,TEMPD STORE TEMPORARILY
- MVI TEMPD,X'4E' MOVE IN EXPONENT
- LD F0,TEMPD LOAD FP (UNNORM)
- DD F0,=D'1000000.' GET INTO SECONDS
- DROP R4
- DROP R5
- LDR F2,F0 SAVE
- SD F0,LAST SUBTRACT TIME AT LAST ENTRY
- STD F2,LAST SAVE THIS ELAPSED
- L R5,0(R1) ADDRESS OF RESULT
- STE F0,0(R5) STORE AS REAL*4
- LM R2,R5,28(R13) RESTORE REGS
- BR R14 & RETURN
- DROP R15
-*
-TIMEL EQU * TIME LEFT UNTIL TIME LIMIT
- STM R2,R6,28(R13) SAVE REGS
- LR R6,R15
- USING TIMEL,R6
- L R4,CVTPTR
- USING CVT,R4 ADDRESSABILITY OF CVT
- L R5,CVTTCBP ADDRESS OF 4 WORD LIST
- L R5,12(R5) CURRENT ASCB
- USING ASCB,R5 ADDRESSABILITY OF ASCB
- L R2,ASCBJSTL JOB STEP TIME LIMIT
- S R2,ASCBEJST SUBTRACT OFF TOP HALF OF ELAPSED
- ST R2,TEMPD+4 STORE TEMPORARILY
- MVC TEMPD(4),=X'4E000000' MOVE IN EXPONENT HALF
- LD F2,TEMPD OAD FP
- MD F2,=D'1.048576' INTO SECONDS
- LDR F0,F2 LOAD & TEST
- BNM OPSTOP
- SDR F0,F0 IF NEG SET TO ZERO
- DROP R4
- DROP R5
-*---SET REMAINING TIME TO ZERO IF OPERATOR HAS ISSUED A STOP COMMAND
-*---MODIFIED BY WIEGANDT/RICHARDS JAN 17 1977
-OPSTOP ICM R3,15,COMECBAD
- BNZ TESTECB
- STM R4,R2,SVZTI Tie-A
- L R15,EXPG Tie-A
- LTR R15,R15 Tie-A
- BNZ EXPGJ Tie-A
- GETMAIN R,LV=EXMUL Tie-A
- ST R1,EXPG Tie-A
- MVC 0(EXMUL-24,R1),EXMU Tie-A
- LR R15,R1 Tie-A
-EXPGJ BASSM R14,R15 Tie-A
- LM R4,R2,SVZTI Tie-A
-* LR R5,R1 SAVE R1 HERE Tie-D
-* EXTRACT CPTR,FIELDS=COMM Tie-D
-* LR R1,R5 RESTORE CONTENTS OF R1 Tie-D
-* L R3,CPTR Tie-D
- L R3,0(R3) ADDRESS(COMMUNICATIONS ECB)
- ST R3,COMECBAD
-TESTECB TM 0(R3),X'40' ECB POSTED
- BNO STRESULT
- SER F0,F0
-STRESULT EQU *
- L R4,0(R1) ADDRESS OF RESULT
- STE F0,0(R4) STORE AS REAL*4
- LM R2,R6,28(R13) RESTORE REGS
- BR R14 & RETURN
-SVZTI DS 15F Tie-A
-LAST DC D'0' ELAPSED TIME AT LAST ENTRY
-TODCLOCK DS D TOD
-TEMPD DS D TEMPORARY FOR FIX -> FLOAT
-*CPTR DC F'0' Tie-D
-COMECBAD DC F'0'
-EXPG DC F'0' Tie-A
-EXMU STM R14,R2,HV-*(R15) MUSTERPROGRAMM ZUM KOPIEREN Tie-A
- BALR R14,0 Tie-A
- DROP R6 Tie-A
- USING *,R14 Tie-A
- LA R2,HV-4 Tie-A
- EXTRACT (2),FIELDS=COMM Tie-A
- L R3,HV-4 RESULT IN R3 Tie-A
- LM R14,R2,HV Tie-A
- BSM 0,R14 Tie-A
- DS 0F Tie-A
-HV EQU *+4 Tie-A
-EXMUL EQU *-EXMU+24 Tie-A
- LTORG
-*
- CVT DSECT=YES,LIST=YES
- IHAASCB DSECT=YES
- END
-#ifdef CERNLIB_SYMVS_TIMEXN
-#undef CERNLIB_SYMVS_TIMEXN
-#endif
-#ifdef CERNLIB_SYMVS_TIMEX
-#undef CERNLIB_SYMVS_TIMEX
-#endif
-#ifdef CERNLIB_TCGEN_TIMED
-#undef CERNLIB_TCGEN_TIMED
-#endif
-#ifdef CERNLIB_TCGEN_TIMEL
-#undef CERNLIB_TCGEN_TIMEL
-#endif
-#ifdef CERNLIB_TCGEN_TIMEX
-#undef CERNLIB_TCGEN_TIMEX
-#endif
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/syos/datime.F b/src/packlib/kernlib/kerngen/obsolete/kernibm/syos/datime.F
deleted file mode 100644
index 0d0a3f0..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/syos/datime.F
+++ /dev/null
@@ -1,48 +0,0 @@
-*
-* $Id: datime.F,v 1.1.1.1 1996/02/15 17:53:20 mclareni Exp $
-*
-* $Log: datime.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:20 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE DATIME (ND,NT)
-C
-C CERN PROGLIB# Z007 DATIME .VERSION KERNIBM 2.28 891004
-C MOD. 27/07/89 add /SLATE/, JZ
-C
-C
-C- CALL DATIME (ND,NT) RETURNS INTEGER DATE ND = YYMMDD
-C- INTEGER TIME NT = HHMM
-C- returns also ISL (1) y (2) m (3) d (4) h (5) m (6) s
-C
- COMMON /SLATE/ ISL(10), MM(10), M(20)
-C
-C
- CALL DTZ007 (MM)
- CALL UBLOW (MM,M,16)
-C
-C- D D / M M / Y Y H H . M M . S S
-C- 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6
-C
- MM(1) = IUFORW (M,7,8)
- MM(2) = IUFORW (M,4,5)
- MM(3) = IUFORW (M,1,2)
-C
- MM(4) = IUFORW (M,9,10)
- MM(5) = IUFORW (M,12,13)
- MM(6) = IUFORW (M,15,16)
-C
- ND = (MM(1)*100+MM(2))*100 + MM(3)
- NT = MM(4) *100 + MM(5)
-C
- MM(1) = MM(1) + 1900
- DO 24 J=1,6
- 24 ISL(J) = MM(J)
- RETURN
- END
-#ifdef CERNLIB_TCGEN_DATIME
-#undef CERNLIB_TCGEN_DATIME
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/syos/datimh.s b/src/packlib/kernlib/kerngen/obsolete/kernibm/syos/datimh.s
deleted file mode 100644
index 8f081d1..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/syos/datimh.s
+++ /dev/null
@@ -1,152 +0,0 @@
-*
-* $Id: datimh.s,v 1.1.1.1 1996/02/15 17:53:21 mclareni Exp $
-*
-* $Log: datimh.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:21 mclareni
-* Kernlib
-*
-*
-DATIMH CSECT
-*
-* CERN PROGLIB# Z007 DATIMH .VERSION KERNIBM 1.11 820328
-*
-*******************************************************************
-*
-* A. BERGLUND / CERN DATE: 28/02/80
-*
-* CALL DATIMH(ND,NT) RETURNS HOLLERITH DATE + TIME
-* ND=8HDD/MM/YY
-* NT=8HHH.MM.SS
-*
-*******************************************************************
-*
-#if defined(CERNLIB_QMIBMXA)
-* SPLEVEL SET=2
-DATIMH AMODE ANY
-DATIMH RMODE ANY
-#endif
-R0 EQU 0
-R1 EQU 1
-R2 EQU 2
-R3 EQU 3
-R4 EQU 4
-R5 EQU 5
-R6 EQU 6
-R7 EQU 7
-R8 EQU 8
-R9 EQU 9
-R10 EQU 10
-R11 EQU 11
-R12 EQU 12
-R13 EQU 13
-R14 EQU 14
-R15 EQU 15
-*
-*
-* P R O L O G U E
-*
- USING DATIMH,R15
- B SAVEREGS
- DC AL1(7),CL7'DATIMH' IDENTIFIER
- DC C'1.00' VERSION.MODIFICATION LEVEL
-SAVEREGS STM R14,R12,12(R13)
- LR R4,R13
- CNOP 0,4
- BAL R13,AROUNDSA
-SAVEAREA DC A(EPILOGUE),17F'0'
- DROP R15
- USING SAVEAREA,R13
-AROUNDSA ST R13,8(0,R4)
- ST R4,4(0,R13)
- XC 8(4,R13),8(R13)
-*
- LR R11,R1 R11 -> ARGUMENT LIST
-*
- TIME BIN
- LR R9,R1 SAVE DATE
- L R1,4(R11) ADDRESS OF TIME PART
- BAL R14,TIME CONVERT TO PRINTABLE
- LR R0,R9
- L R1,0(R11) ADDRESS OF DATE PART
- BAL R14,DATE CONVERT TO PRINTABLE
-* E P I L O G U E
-*
-EPILOGUE EQU *
- L R13,4(0,R13)
- LM R14,R12,12(R13)
- OI 12(R13),X'FF'
- BR R14
-*
-DATE LA R6,DW FIND DOUBLE WORD
- N R6,=XL4'FFFFF8'
- ST 0,DEC+4 PLANT DATE
- UNPK DEC(3),DEC+5(2) CONVERT YEAR
- MVC 6(2,1),DEC PUT INTO AREA
- PACK DEC(8),6(2,1) REPACK IT
- CVB R3,DEC CONVERT TO BINARY
- ST 0,DEC+4 STORE ORIG VALUE AGAIN
- XC DEC(6),DEC CLEAR FOR CVB
- NI DEC+7,X'F0' SET SIGN
- OI DEC+7,X'0C'
- CVB R2,DEC DAY OF YEAR
- CL R2,=A(31+28) BEFORE FEB 28?
- BNH LEAP BR IF SO
- N R3,=F'3' FOR
- BZ LEAP BR IF SO
- LA R2,1(,R2) ALLOW FOR FEB 29
-LEAP LA R4,10 SET MONTH TO JAN
- LA R3,MONTHS
-ML CH R2,0(,R3) THIS MONTH?
- BNH MF BR IF SO
- SH R2,0(,R3) R3Y NEXT MONTH
- LA R4,10(,R4)
- LA R3,2(,R3)
- B ML
-*
-MF CVD R4,DEC CONVERT MONTH
- UNPK 3(3,1),DEC+6(2)
- MH R2,=H'10'
- CVD R2,DEC CONVERT DAY
- UNPK 0(3,1),DEC+6(2)
- MVI 2(1),C'/'
- MVI 5(1),C'/'
- BR 14
-* CONVERT TIME TO PRINTABLE FORMAT
-*
-TIME LA R6,DW FIND DOUBLE WORD
- N R6,=XL4'FFFFF8'
- LR R3,0
- SR R2,R2
- D R2,=F'100' DISPOSE OF 100THS
- SR R2,R2
- D R2,=F'60' GET SECONDS
- MH R2,=H'10'
- CVD R2,DEC
- UNPK DEC(3),DEC+6(2)
- MVC 6(2,1),DEC
- SR R2,R2
- D R2,=F'60' GET MINUTES
- MH R2,=H'10'
- CVD R2,DEC
- UNPK 3(3,1),DEC+6(2)
- MH R3,=H'10'
- CVD R3,DEC HOURS
- UNPK 0(3,1),DEC+6(2)
- MVI 2(1),C'.'
- MVI 5(1),C'.'
- BR 14
-* CONSTANTS
-*
-MONTHS DC H'31,29,31,30,31,30,31,31,30,31,30,31,999'
-DW DS 2F DOUBLE WORD
-*
-*
-DEC DS D
-* D A T A A R E A S
-*
- LTORG
-*
- END
-#ifdef CERNLIB_TCGEN_DATIMH
-#undef CERNLIB_TCGEN_DATIMH
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/syos/dtz007.s b/src/packlib/kernlib/kerngen/obsolete/kernibm/syos/dtz007.s
deleted file mode 100644
index 64512f3..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/syos/dtz007.s
+++ /dev/null
@@ -1,121 +0,0 @@
-*
-* $Id: dtz007.s,v 1.1.1.1 1996/02/15 17:53:21 mclareni Exp $
-*
-* $Log: dtz007.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:21 mclareni
-* Kernlib
-*
-*
-DTZ007 CSECT
-*
-* CERN PROGLIB# Z007 DTZ007 .VERSION KERNIBM 1.11 820328
-*
-* CALL DTZ007 (DATIME) RETURNS THE BCD DATE/TIME
-* IN THE 16-BYTE VECTOR DATIME THUS DD/MM/YYHH.MM.SS
-* HAMBURG, AUGUST 1973 (H.BUTENSCHOEN)
-* JAN 82 : CHANGED ENTRY-NAME 'DATE' TO 'DTZ007'
-*
-#if defined(CERNLIB_QMIBMXA)
-* SPLEVEL SET=2
-DTZ007 AMODE ANY
-DTZ007 RMODE ANY
-#endif
- STM 14,6,12(13)
- BALR 2,0
- USING *,2
- L 4,0(1)
- LA 6,8(4)
- LA 1,2(0,0) LOAD REG 1 TO SPECIFY UNIT
- SVC 11 ISSUE TIME SVC
- ST 1,ZW2
- CLC ZW2+2(2),SIGN+2
- BC 8,NULL
- UNPK DECMAL(8),ZW2(4)
- MVC 6(2,4),DECMAL+3
- MVI 5(4),X'61'
- MVI 2(4),X'61'
- N 1,NOSIGN
- O 1,SIGN
- STH 1,DAY2+2
- SRL 1,12
- N 1,NOSIGN
- O 1,SIGN
- MVI YEAR,X'00'
- STH 1,YEAR+1
- DP YEAR(3),FOUR(1)
- CP YEAR+2(1),SIGN+3(1)
- BC 7,NOSW
- CP DAY2+2(2),SIXTY(2)
- BC 4,NOSW
- BC 8,FEB29
- SP DAY2+2(2),ONE(1)
-NOSW ZAP DAY1(10),DAY2(4)
- DP DAY1(10),THIRTY(2)
- CVB 3,DAY1
- LR 5,3
- SLL 5,1
- LH 5,TABEL(5)
- CH 5,DAY2+2
- BC 10,SETDAY
- LA 3,1(3)
-SETDAY LR 5,3
- S 5,RONE
- CVD 3,DAY1
- UNPK DECMAL(8),DAY1+6(2)
- OI DECMAL+7,X'F0'
- MVC 3(2,4),DECMAL+6
- SLL 5,1
- LH 5,TABEL(5)
- STH 5,ZW
- SP DAY2+2(2),ZW(2)
- LH 5,DAY2+2
- ST 5,ZW2
- UNPK DECMAL(8),ZW2(4)
- OI DECMAL+7,X'F0'
- MVC 0(2,4),DECMAL+6
-END ST 0,ZW2
- UNPK DECMAL(8),ZW2(4)
- MVC 0(2,6),DECMAL+1
- MVI 2(6),X'4B'
- MVC 3(2,6),DECMAL+3
- MVI 5(6),X'4B'
- MVC 6(2,6),DECMAL+5
- LM 2,6,28(13)
- MVI 12(13),X'FF'
- BCR 15,14
-FEB29 MVC 0(5,4),SONDAY
- BC 15,END
-NULL MVC 0(8,4),NULLD
- B END
-NULLD DC C'00/00/00'
-DECMAL DS 1D
-DAY1 DS 1D
- DS 1H
- DS 0F
-RONE DC FL4'1'
-ZW2 DS 1F
-NOSIGN DC X'00FFFFF0'
-SIGN DC X'0000000C'
-DAY2 DC X'00000000'
- DC X'00'
-YEAR DC X'000000'
-FOUR DC X'4C'
-SIXTY DC X'060C'
-ONE DC X'1C'
-THIRTY DC X'030C'
-ZW DS 1H
-TABEL DC X'000C'
- DC X'031C'
- DC X'059C'
- DC X'090C'
- DC X'120C'
- DC X'151C'
- DC X'181C'
- DC X'212C'
- DC X'243C'
- DC X'273C'
- DC X'304C'
- DC X'334C'
- DC X'400C'
-SONDAY DC X'F2F961F0F2'
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/syos/goparm.s b/src/packlib/kernlib/kerngen/obsolete/kernibm/syos/goparm.s
deleted file mode 100644
index d498d2b..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/syos/goparm.s
+++ /dev/null
@@ -1,118 +0,0 @@
-*
-* $Id: goparm.s,v 1.1.1.1 1996/02/15 17:53:21 mclareni Exp $
-*
-* $Log: goparm.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:21 mclareni
-* Kernlib
-*
-*
-GOPARM CSECT
-*
-* CERN PROGLIB# Z262 GOPARM .VERSION KERNIBM 1.11 820328
-*
-*********************************************************************
-*
-* C E R N M O D I F I C A T I O N L O G
-* =========================================
-*
-* THIS MODULE HAS BEEN MODIFIED AT CERN. THE CERN MODIFICATIONS ARE
-* DESCRIBED BELOW.
-*
-*********************************************************************
-*
-* C R N 0 0 1
-* ===========
-*
-* THIS MODIFICATION CAUSES GOPARM TO RETURN THE PARAMETER STRING
-* WHICH WAS PASSED TO THE CURRENT TASK FROM THE MOTHER TASK.
-* THIS ENSURES THAT THE CORRECT PARAMETER STRING IS RETURNED WHEN
-* A USER'S PROGRAM IS RUN IN THE FOREGROUND UNDER TSO AND SIMPLIFIES
-* THE PROBLEM OF OBTAINING THE CORRECT PARAMETER STRING WHEN THE
-* USER'S PROGRAM IS ATTACHED BY THE LOADER.
-*
-* R. MATTHEWS, NOVEMBER 1979.
-*
-*********************************************************************
-*
-*
-*
-* SUBROUTINE GOPARM (LENGTH, BYTES)
-*
-* RETURNS LENGTH OF GO-STEP PARAMETER STRING IN THE FULLWORD
-* INTEGER VARIABLE "LENGTH", AND THE STRING OF PARAMETER
-* CHARACTERS IN THE STRING "BYTES". NATURALLY, LENGTH MUST
-* BE CHECKED BEFORE LOOKING AT THE TEXT.
-*
-* (NOTE -- IF TREATED AS A FUNCTION, THE VALUE OF GOPARM WILL
-* BE THE LENGTH OF THE PARM STRING.)
-*
-* VERSION 0, MOD 0
-* JUNE 18, 1976
-*
-* VERSION 0, MOD 1 (USE JOBSTEP TCB, FOR TASKING JOBS)
-* JUNE 29, 1976
-*
-*
-* WRITTEN BY
-*
-* JOHN R. EHRMAN
-* SCS-SCIP, SLAC USER SERVICES GROUP
-* STANFORD LINEAR ACCELERATOR CENTER
-* P.O. BOX 4349
-* STANFORD, CALIFORNIA 94305
-*
-*
-#if defined(CERNLIB_QMIBMXA)
-* SPLEVEL SET=2
-GOPARM AMODE ANY
-GOPARM RMODE ANY
-#endif
- USING *,BASE
- SAVE (14,5),,GOPARM-V0M1 SAVE CALLER'S REGISTERS
- LM R1,R2,0(R1) GET POINTERS TO CALLER'S ARGUMENTS
- SR R0,R0 INITIALIZE LENGTH TO 0
- ST R0,0(,R1) STORE TENTATIVE RESULT LENGTH
- L R3,16(,0) GET CVT POINTER
- L R3,0(,R3) GET POINTER TO TCB WORDS
- L R3,4(,R3) GET POINTER TO CURRENT TCB
- L R3,TCBFSA(,R3) GET POINTER TO FIRST PROB PROG SAVE
-CHECKIT DS 0H
- L R3,24(,R3) GET VALUE OF R1 AT ENTRY TO MAIN
- LTR R3,R3 CHECK FOR ZERO, JUST IN CASE
- BZ NOPARMS BRANCH IF NO PARMS
- L R3,0(,R3) GET POINTER TO PARM DATA
- LTR R3,R3 CHECK FOR ZERO
- BZ NOPARMS BRANCH IF NONE
- LH R0,0(,R3) PICK UP PARM STRING LENGTH
- LTR R0,R0 CHECK FOR NULL PARMS
- BZ NOPARMS BRANCH IF ZERO LENGTH
-*
-* HAVE A NON-NULL PARM STRING
-*
- CH R0,PARMMAX CHECK FOR EXCESSIVE LENGTH
- BNH MOVEPARM BRANCH IF NOT EXCESSIVE
- LH R0,PARMMAX MAX MOVE OF 100
-MOVEPARM DS 0H
- ST R0,0(,R1) STORE RESULT LENGTH
- LR R1,R0 MOVE TO AN EXECUTABLE REGISTER
- BCTR R1,0 DECREMENT BY 1 FOR MOVE
- EX R1,PARMMVC MOVE THE PARM STRING
-*
-NOPARMS DS 0H
- RETURN (2,5),T RETURN TO CALLER
-*
-PARMMVC MVC 0(*-*,R2),2(R3) MOVE PARM STRING TO USER AREA
-PARMMAX DC Y(PARMLEN) MAX LEGAL PARM STRING SIZE
-*
-BASE EQU 15 LOCAL BASE REGISTER
-PARMLEN EQU 100 MAX ALLOWED PARM SIZE
-TCBFSA EQU 112 OFFSET OF A(FIRST PP SAVEAREA)
-TCBJSTCB EQU 124 OFFSET OF JOBSTEP TCB ADDRESS
-TCBLTC EQU 136 OFFSET OF LAST SUBTASK OF THIS TCB
-R0 EQU 0
-R1 EQU 1
-R2 EQU 2
-R3 EQU 3
-R4 EQU 4
-R5 EQU 5
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/syos/intrac.s b/src/packlib/kernlib/kerngen/obsolete/kernibm/syos/intrac.s
deleted file mode 100644
index 4f1616a..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/syos/intrac.s
+++ /dev/null
@@ -1,71 +0,0 @@
-*
-* $Id: intrac.s,v 1.1.1.1 1996/02/15 17:53:21 mclareni Exp $
-*
-* $Log: intrac.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:21 mclareni
-* Kernlib
-*
-*
-INTRAC CSECT
-*
-* CERN PROGLIB# Z044 INTRAC .VERSION KERNIBM 2.11 850320
-*
-* CALLING SEQUENCE: VALUE = INTRAC(DUMMY)
-* OR: IF (INTRAC(DUMMY)) .....
-*
-* FUNCTION: A LOGICAL*4 FUNCTION TO DETERMINE WHETHER A
-* PROGRAM IS RUNNING IN A TSO OR BATCH ENVIRONMENT.
-* THE FUNCTION HAS THE VALUE .TRUE. IF RUNNING IN A
-* TSO ENVIRONMENT OTHERWISE THE VALUE IS .FALSE.
-* THE ENVIRONMENT IS DETERMINED BY THE CONTENTS OF
-* ASCBTSB WHICH IS ASSUMED TO CONTAIN ZERO IF IN
-* BATCH AND NON-ZERO IF IN TSO.
-*
-* ARGUMENTS: DUMMY - A DUMMY ARGUMENT TO SATISFY THE COMPILER.
-* THE ARGUMENT IS NOT CHANGED BY THE
-* SUBPROGRAM REFERENCE.
-*
-* R. MATTHEWS, CERN/DD, MAY 1980.
-*
-#if defined(CERNLIB_QMIBMXA)
-* SPLEVEL SET=2
-INTRAC AMODE ANY
-INTRAC RMODE ANY
-#endif
-R0 EQU 0
-R1 EQU 1
-R2 EQU 2
-R3 EQU 3
-R4 EQU 4
-R5 EQU 5
-R6 EQU 6
-R7 EQU 7
-R8 EQU 8
-R9 EQU 9
-R10 EQU 10
-R11 EQU 11
-R12 EQU 12
-R13 EQU 13
-R14 EQU 14
-R15 EQU 15
-*
-*
- USING INTRAC,R15
-*
- B START
-*
- DC AL1(7),CL7'INTRAC' IDENTIFIER
- DC C'2.00' VERSION.MODIFICATION LEVEL
-*
-START L R1,548 R1 -> ASCB
- L R0,60(0,R1) R0 := ASCBTSB
- LTR R0,R0 TEST THE VALUE OF ASCBTSB
- BZR R14 ZERO, RETURN
-*
- LA R0,1 SET FUNCTION VALUE := .TRUE.
- BR R14 RETURN
-*
- END
-#ifdef CERNLIB_TCGEN_INTRAC
-#undef CERNLIB_TCGEN_INTRAC
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/syos/jobnam.s b/src/packlib/kernlib/kerngen/obsolete/kernibm/syos/jobnam.s
deleted file mode 100644
index 42b55d6..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/syos/jobnam.s
+++ /dev/null
@@ -1,47 +0,0 @@
-*
-* $Id: jobnam.s,v 1.1.1.1 1996/02/15 17:53:21 mclareni Exp $
-*
-* $Log: jobnam.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:21 mclareni
-* Kernlib
-*
-*
-JOBNAM CSECT
-*
-* CERN PROGLIB# Z100 JOBNAM .VERSION KERNIBM 1.11 820328
-*
-* CERN IBM 370/168 PROGRAM LIBRARY. 13/09/77.
-* ASSEMBLER ROUTINE TO RETURN JOB NAME OF CALLING JOB.
-* AUTHOR : J.HART,RHEL.
-* SUBMITTER : H.RENSHALL,CERN.
-* CALLED FROM FORTRAN LIKE -
-*
-* REAL*8 JBNAME
-* CALL JOBNAM (JBNAME)
-*
-* THEN JBNAME IS THE 8 CHARACTER JOB NAME OF THE CALLING JOB.
-* NO EXTERNAL ROUTINES ARE REFERENCED.
-* JOBNAM SHOULD WORK ON ALL OS/360 AND OS/370 SYSTEMS.
-*
-#if defined(CERNLIB_QMIBMXA)
-* SPLEVEL SET=2
-JOBNAM AMODE ANY
-JOBNAM RMODE ANY
-#endif
- BC 15,12(,15)
- DC X'7'
- DC CL7'JOBNAM'
- STM 14,12,12(13) SAVE CALLING PROGRAMS REGISTERS.
- BALR 12,0 LOAD BASE REGISTER.
- USING *,12
-* FIND JOB NAME FROM TIOT.
- L 2,16 LOAD CVT ADDRESS.
- L 3,0(,2) LOAD TCB WORDS ADDRESS.
- L 4,4(,3) LOAD TCB ADDRESS.
- L 5,12(,4) LOAD TIOT ADDRESS.
- L 6,0(,1) FETCH ARGUMENT ADDRESS.
- MVC 0(8,6),0(5) MOVE 8 CHARACTER JOB NAME.
- LM 2,12,28(13) RESTORE REGISTERS.
- MVI 12(13),X'FF'
- BR 14 RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/syos/noarg.s b/src/packlib/kernlib/kerngen/obsolete/kernibm/syos/noarg.s
deleted file mode 100644
index f8ad997..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/syos/noarg.s
+++ /dev/null
@@ -1,45 +0,0 @@
-*
-* $Id: noarg.s,v 1.1.1.1 1996/02/15 17:53:22 mclareni Exp $
-*
-* $Log: noarg.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:22 mclareni
-* Kernlib
-*
-*
-NOARG CSECT
-*
-* CERN PROGLIB# Z029 NOARG .VERSION KERNIBM 1.11 820328
-*
-* THIS IS A SUBROUTINE TO DETERMINE THE NUMBER OF ARGS
-* WHICH IS NOT VERY SAFE IF NO ARGS ARE SUPPLIED
-* CALLING SEQUENCE : "CALL NOARG(N)"
-*
-* AUTHOR: P.BREITENLOHNER, MAX-PLANCK-INSTITUT FUER PHYSIK
-* FOEHRINGER RING 6, D-8 MUENCHEN 40. 14. FEB 1975
-*
-#if defined(CERNLIB_QMIBMXA)
-* SPLEVEL SET=2
-NOARG AMODE ANY
-NOARG RMODE ANY
-#endif
- USING *,15
- ST 2,28(,13)
- L 2,4(,13) GET PREVIOUS SAVE AREA
- L 2,24(,2) GET PREVIOUS PARM POINTER
- LA 2,0(,2) STRIP OFF HIGH BYTE
- LTR 0,2 SAVE IT
- BZ EXIT0 DEFINITELY NO ARGS
-LOOP TM 0(2),X'80' IS THIS LAST ARG ?
- LA 2,4(,2) STEP TO NEXT ARG
- BNO LOOP LOOP IF NOT YET LAST
- SR 2,0 4*NUMBER
- SRA 2,2 NUMBER
- LR 0,2
-EXIT0 L 2,0(,1) LOC TO STORE RESULT
- ST 0,0(,2)
- L 2,28(,13)
- BR 14
- END
-#ifdef CERNLIB_TCGEN_NOARG
-#undef CERNLIB_TCGEN_NOARG
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/syos/reent.s b/src/packlib/kernlib/kerngen/obsolete/kernibm/syos/reent.s
deleted file mode 100644
index 2464614..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/syos/reent.s
+++ /dev/null
@@ -1,93 +0,0 @@
-*
-* $Id: reent.s,v 1.1.1.1 1996/02/15 17:53:22 mclareni Exp $
-*
-* $Log: reent.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:22 mclareni
-* Kernlib
-*
-*
-REENT CSECT
-*
-* CERN PROGLIB# Z035 REENT .VERSION KERNIBM 2.32 910718
-*
-* RECOVER FROM FATAL ERROR STOP (0C1 TO 0C6) FOR DIAGNOSTIC DUMP
-* INITIALIZE RECOVERY WITH
-* EXTERNAL QFATAL (FOR EXAMPLE)
-* CALL REENT (QFATAL)
-* WHEN AN ERROR OCCURS, CONTROL IS TRANSFERRED TO QFATAL.
-* THIS ROUTINE MAY THEN PRINT ANY TERMINATION INFORMATION AND IT
-* MUST STOP WITH CALL ABEND
-*
-* HAMBURG, AUGUST 1973 (H.BUTENSCHOEN)
-*
-* CORRECTION FOR MVS/XA OR VM/XA :
-* There was a problem at DESY: REENT specifies AMODE ANY to be
-* able to run "above the line". But it calls the SPIE macro
-* which, with MVS/XA, canNOT run up there.
-* There fore the code was modified by Klaus Tietgen, DESY-R1.
-*---------------------------------------------------------------------
-*
-#if defined(CERNLIB_QMIBMXA)
-* SPLEVEL SET=2
-REENT AMODE ANY
-REENT RMODE ANY
-#endif
- ENTRY ABEND
- USING *,10
- SAVE (14,12),,*
- LR 10,15
- L 3,0(1)
- LA 3,0(3)
- L 3,0(3)
-#if defined(CERNLIB_QMIBMXA)
- BSM 1,0
- LA 0,1
- SLL 0,31
- NR 1,0
- OR 3,1
- ST 3,QF ADDRESS OF EXTERNAL ROUTINE INTO QF
- LA 3,SPEXIT
- ESPIE SET,(3),((1,6))
- ST 1,PICAAD
- RETURN (14,12)
- USING *,12
-ABEND SAVE (14,12),,*
- LR 12,15
- ABEND 1,DUMP
-SPEXIT DS 0H
- DROP
- USING *,15
- STM 0,15,SPREG
- MVC PI(96),0(1)
- L 3,QF
- ST 3,76(1)
- BR 14
-PI DC 96X'0',CL2'PI'
-#endif
-#if !defined(CERNLIB_QMIBMXA)
- ST 3,QF ADDRESS OF EXTERNAL ROUTINE INTO QF
- SPIE SPEXIT,((1,6))
- ST 1,PICAAD
- B EXIT
-EXIT RETURN (14,12)
-SPEXIT BALR 10,0
- USING *,10
- STM 0,15,SPREG
- MVC PI(36),0(1)
- L 3,QF
- ST 3,8(1)
- ST 3,16(1)
- BR 14
- USING *,12
-ABEND SAVE (14,12),,*
- LR 12,15
- ABEND 1
-PI DC 36X'0',CL2'PI'
-#endif
-SPREG DC 16F'0'
-PICAAD DC F'0'
-QF DC F'0'
- END
-#ifdef CERNLIB_TCGEN_ABEND
-#undef CERNLIB_TCGEN_ABEND
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/syos/syos.h b/src/packlib/kernlib/kerngen/obsolete/kernibm/syos/syos.h
deleted file mode 100644
index f5290ba..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/syos/syos.h
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: syos.h,v 1.1.1.1 1996/02/15 17:53:22 mclareni Exp $
-*
-* $Log: syos.h,v $
-* Revision 1.1.1.1 1996/02/15 17:53:22 mclareni
-* Kernlib
-*
-*
-* This directory was created from kernibm.car patch syos
-#ifndef CERNLIB_SYVMOS
-#define CERNLIB_SYVMOS
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/syvmos/jumpad.F b/src/packlib/kernlib/kerngen/obsolete/kernibm/syvmos/jumpad.F
deleted file mode 100644
index d254c75..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/syvmos/jumpad.F
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: jumpad.F,v 1.1.1.1 1996/02/15 17:53:23 mclareni Exp $
-*
-* $Log: jumpad.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:23 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- FUNCTION JUMPAD (ITARGT)
-C
-C CERN PROGLIB# Z042 JUMPAD .VERSION KERNIBM 2.23 880425
-C ORIG. 21/04/88 JZ
-C
-C- Get target address for use with JUMPXn
-
- JUMPAD = ITARGT
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/syvmos/jumpx2.F b/src/packlib/kernlib/kerngen/obsolete/kernibm/syvmos/jumpx2.F
deleted file mode 100644
index 6489a74..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/syvmos/jumpx2.F
+++ /dev/null
@@ -1,62 +0,0 @@
-*
-* $Id: jumpx2.F,v 1.1.1.1 1996/02/15 17:53:23 mclareni Exp $
-*
-* $Log: jumpx2.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:23 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE JUMPX2 (IPARA,IPARB)
-C
-C CERN PROGLIB# Z042 JUMPX2 .VERSION KERNIBM 2.28 891004
-C ORIG. 21/04/88 JZ
-C MOD. 12/09/89 JZ, add entries JUMPX1, JUMPX0
-C
-C- To transfer to the user routine TARGET (say) with 2 parameters
-C- three steps are needed :
-C
-C- 1) EXTERNAL TARGET to get the address of TARGET
-C- IADR = JUMPAD (TARGET)
-C
-C- 2) CALL JUMPST (IADR) to set the tranfer address
-C
-C- 3) CALL JUMPX2 (par1,par2) to transfer
-C
- DIMENSION IPARA(9), IPARB(9)
-C
- CALL JUMPY2 (JPOINT,IPARA,IPARB)
- RETURN
-C
- ENTRY JUMPX1 (IPARA)
- CALL JUMPY1 (JPOINT,IPARA)
- RETURN
-C
- ENTRY JUMPX0
- CALL JUMPY0 (JPOINT)
- RETURN
-C
- ENTRY JUMPST (JADR)
- JPOINT = JADR
- RETURN
- END
-C-----------------------------------------------------
- SUBROUTINE JUMPY2 (TARSUB,IPARA,IPARB)
- DIMENSION IPARA(9), IPARB(9)
- EXTERNAL TARSUB
-C
- CALL TARSUB (IPARA,IPARB)
- RETURN
-C
- ENTRY JUMPY1 (TARSUB,IPARA)
- CALL TARSUB (IPARA)
- RETURN
-C
- ENTRY JUMPY0 (TARSUB)
- CALL TARSUB
- RETURN
- END
-#ifdef CERNLIB_TCGEN_JUMPXN
-#undef CERNLIB_TCGEN_JUMPXN
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/syvmos/qnexte.s b/src/packlib/kernlib/kerngen/obsolete/kernibm/syvmos/qnexte.s
deleted file mode 100644
index b3f7ca1..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/syvmos/qnexte.s
+++ /dev/null
@@ -1,94 +0,0 @@
-*
-* $Id: qnexte.s,v 1.1.1.1 1996/02/15 17:53:23 mclareni Exp $
-*
-* $Log: qnexte.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:23 mclareni
-* Kernlib
-*
-*
-QNEXTE CSECT
-*
-* CERN PROGLIB# Z041 QNEXTE .VERSION KERNIBM 2.10 840827
-*
-* FUNCTION: ON FIRST ENTRY, STANDARD REGISTER SAVING AND SAVE AREA
-* CHAINING ARE PERFORMED AND ROUTINE QNEXT IS CALLED.
-* ON RE-ENTRY, REGISTER SAVING AND
-* SAVE AREA CHAINING ARE NOT PERFORMED BUT QNEXT IS
-* CALLED AFTER APPROPRIATE VALUES ARE PLACED IN THE
-* LINKAGE REGISTERS 13,14,15 AND 1. WHEN CONTROL IS
-* RETURNED BY QNEXT, A STANDARD RETURN TO MAIN IS MADE.
-* AT ALL TIMES IT THEREFORE APPEARS, (E.G. IN A FORTRAN
-* TRACEBACK), AS THOUGH THE CHAIN OF CALLS WAS MAIN,
-* QNEXTE, QNEXT ... , AND A CHAIN OF RETURNS LEADS BACK
-* TO MAIN.
-*
-* CALLING SEQUENCE: CALL QNEXTE
-*
-* ORIGINAL VERSION : R. MATTHEWS, CERN/DD, OCTOBER 1981.
-*
-#if defined(CERNLIB_QMIBMXA)
-* SPLEVEL SET=2
-QNEXTE AMODE ANY
-QNEXTE RMODE ANY
-#endif
-R0 EQU 0
-R1 EQU 1
-R2 EQU 2
-R3 EQU 3
-R4 EQU 4
-R5 EQU 5
-R6 EQU 6
-R7 EQU 7
-R8 EQU 8
-R9 EQU 9
-R10 EQU 10
-R11 EQU 11
-R12 EQU 12
-R13 EQU 13
-R14 EQU 14
-R15 EQU 15
- SPACE 2
- SPACE
-* P R O L O G U E
- SPACE
- USING QNEXTE,R15
- B SAVEREGS
- DC AL1(7),CL7'QNEXTE' IDENTIFIER
- DC C'1.00' VERSION.MODIFICATION LEVEL
-SAVEREGS CLI ENTRY,1 IS THIS THE FIRST ENTRY ?
- BNE CALL NO, BRANCH
- MVI ENTRY,0 TURN OFF THE FIRST ENTRY FLAG
- STM R14,R12,12(R13) DO STANDARD SAVE AND S.A. CHAINING...
- LR R4,R13
- CNOP 0,4
- BAL R13,AROUNDSA
-SAVEAREA DC A(EPILOGUE),17F'0'
-AROUNDSA ST R13,8(0,R4)
- ST R4,4(0,R13)
- SPACE 2
-* C A L L Q N E X T
- SPACE
-CALL EQU *
- L R13,=A(SAVEAREA) ENSURE R13 -> SAVE AREA IN THIS CSECT
- XC 8(4,R13),8(R13) ZERO THE LOWER S.A. POINTER
- SR R1,R1 R1 := 0, (NO ARGUMENTS)
- L R15,=V(QNEXT) R15 -> QNEXT
- BALR R14,R15 BRANCH TO QNEXT
- SPACE 2
-* E P I L O G U E
- SPACE
-EPILOGUE EQU * PERFORM A STANDARD RETURN...
- L R13,4(0,R13)
- LM R14,R12,12(R13)
- MVI 12(R13),X'FF'
- BR R14
-* D A T A A R E A S
- SPACE
-ENTRY DC X'01' FIRST ENTRY FLAG
- SPACE 2
- LTORG
- SPACE 2
- END
-#ifdef CERNLIB_TCGEN_QNEXTE
-#undef CERNLIB_TCGEN_QNEXTE
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/syvmos/traceq.F b/src/packlib/kernlib/kerngen/obsolete/kernibm/syvmos/traceq.F
deleted file mode 100644
index f20daec..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/syvmos/traceq.F
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: traceq.F,v 1.1.1.1 1996/02/15 17:53:23 mclareni Exp $
-*
-* $Log: traceq.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:23 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE TRACEQ (LUNP,NP)
-C
-C CERN PROGLIB# N105 TRACEQ .VERSION KERNIBM 2.28 891004
-C ORIG. 12/09/89 JZ
-C
-C- SUBROUTINE TO PRINT THE FORTRAN SUBROUTINE TRACE-BACK
-C
- CALL ERRTRA
- RETURN
- END
-#ifdef CERNLIB_TCGEN_TRACEQ
-#undef CERNLIB_TCGEN_TRACEQ
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/xvectibm/xinb.F b/src/packlib/kernlib/kerngen/obsolete/kernibm/xvectibm/xinb.F
deleted file mode 100644
index 4cbedc1..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/xvectibm/xinb.F
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: xinb.F,v 1.1.1.1 1996/02/15 17:53:08 mclareni Exp $
-*
-* $Log: xinb.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:08 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE XINB (LUN,XBV,NXB)
-C
-C CERN PROGLIB# Z203 XINB .VERSION KERNIBM 2.27 890622
-C
- COMMON /SLATE/ NXR, DUMMY(39)
- DIMENSION XBV(NXB)
-C
- READ (LUN,IOSTAT=JSTAT,NUM=NBYTES) NR,XBV
- IF (JSTAT) 61, 24, 64
- 24 NXR = NR
- NR = MIN (NR,NXB)
- NXB = MAX (NR,1)
- RETURN
-C
- 61 NXB = 0
- RETURN
-C
- 64 NXB = -JSTAT
- READ (LUN) NR
- RETURN
- END
-#ifdef CERNLIB_XVECT_XINB
-#undef CERNLIB_XVECT_XINB
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/xvectibm/xinbf.F b/src/packlib/kernlib/kerngen/obsolete/kernibm/xvectibm/xinbf.F
deleted file mode 100644
index 5bb1bd8..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/xvectibm/xinbf.F
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: xinbf.F,v 1.1.1.1 1996/02/15 17:53:09 mclareni Exp $
-*
-* $Log: xinbf.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:09 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE XINBF (LUN,XBV,NXB)
-C
-C CERN PROGLIB# Z203 XINBF .VERSION KERNIBM 2.27 890622
-C
- DIMENSION XBV(NXB)
-C
- READ (LUN,IOSTAT=JSTAT,NUM=NBYTES) XBV
- IF (JSTAT) 61, 24, 64
- 24 NXB = MAX (1, NBYTES/4)
- RETURN
-C
- 61 NXB = 0
- RETURN
-C
- 64 NXB = -JSTAT
- READ (LUN) N
- RETURN
- END
-#ifdef CERNLIB_XVECT_XINBF
-#undef CERNLIB_XVECT_XINBF
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/xvectibm/xinbs.F b/src/packlib/kernlib/kerngen/obsolete/kernibm/xvectibm/xinbs.F
deleted file mode 100644
index 3667e63..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/xvectibm/xinbs.F
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: xinbs.F,v 1.1.1.1 1996/02/15 17:53:09 mclareni Exp $
-*
-* $Log: xinbs.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:09 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE XINBS (LUN,XAV,NA,XBV,NXB)
-C
-C CERN PROGLIB# Z203 XINBS .VERSION KERNIBM 2.27 890622
-C
- COMMON /SLATE/ NXR, DUMMY(39)
- DIMENSION XBV(NXB), XAV(NA)
-C
- READ (LUN,IOSTAT=JSTAT,NUM=NBYTES) NR,XAV,XBV
- IF (JSTAT) 61, 24, 64
- 24 NXR = NR
- NR = MIN (NR,NXB)
- NXB = MAX (NR,1)
- RETURN
-C
- 61 NXB = 0
- RETURN
-C
- 64 NXB = -JSTAT
- READ (LUN) N
- RETURN
- END
-#ifdef CERNLIB_XVECT_XINBS
-#undef CERNLIB_XVECT_XINBS
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/xvectibm/xincf.F b/src/packlib/kernlib/kerngen/obsolete/kernibm/xvectibm/xincf.F
deleted file mode 100644
index 49329e6..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/xvectibm/xincf.F
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: xincf.F,v 1.1.1.1 1996/02/15 17:53:09 mclareni Exp $
-*
-* $Log: xincf.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:09 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE XINCF (LUN,XBV,NXB)
-C
-C CERN PROGLIB# Z203 XINCF .VERSION KERNIBM 1.12 820329
-C
- DIMENSION XBV(NXB)
-C
- READ (LUN,8000,END=61,ERR=64) XBV
- RETURN
-C
- 61 NXB = 0
- RETURN
-C
- 64 NXB = -7
- READ (LUN,8000) N
- RETURN
-C
- 8000 FORMAT (200(90A4))
- END
-#ifdef CERNLIB_XVECT_XINCF
-#undef CERNLIB_XVECT_XINCF
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/xvectibm/xoutcf.F b/src/packlib/kernlib/kerngen/obsolete/kernibm/xvectibm/xoutcf.F
deleted file mode 100644
index e1d6853..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/xvectibm/xoutcf.F
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: xoutcf.F,v 1.1.1.1 1996/02/15 17:53:09 mclareni Exp $
-*
-* $Log: xoutcf.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:09 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE XOUTCF (LUN,BV,NB)
-C
-C CERN PROGLIB# Z203 XOUTCF .VERSION KERNIBM 1.12 820329
-C ORIG. 15/07/78 JZ
-C
- DIMENSION BV(NB)
-C
- WRITE (LUN,8000) BV
- RETURN
-C
- 8000 FORMAT (200(90A4))
- END
-#ifdef CERNLIB_XVECT_XOUTCF
-#undef CERNLIB_XVECT_XOUTCF
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/xvectibm/xvectibm.h b/src/packlib/kernlib/kerngen/obsolete/kernibm/xvectibm/xvectibm.h
deleted file mode 100644
index da67444..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/xvectibm/xvectibm.h
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: xvectibm.h,v 1.1.1.1 1996/02/15 17:53:09 mclareni Exp $
-*
-* $Log: xvectibm.h,v $
-* Revision 1.1.1.1 1996/02/15 17:53:09 mclareni
-* Kernlib
-*
-*
-* This directory was created from kernibm.car patch xvectibm
-#ifndef CERNLIB_XVECT
-#define CERNLIB_XVECT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/xvectsi/xinbf.F b/src/packlib/kernlib/kerngen/obsolete/kernibm/xvectsi/xinbf.F
deleted file mode 100644
index 195422f..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/xvectsi/xinbf.F
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: xinbf.F,v 1.1.1.1 1996/02/15 17:53:08 mclareni Exp $
-*
-* $Log: xinbf.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:08 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE XINBF (LUN,XBV,NXB)
-C
-C CERN PROGLIB# Z203 XINBF .VERSION KERNIBM 1.06 790518
-C
- DIMENSION XBV(NXB)
-C
- READ (LUN,END=61,ERR=64) XBV
- RETURN
-C
- 61 NXB = 0
- RETURN
-C
- 64 NXB = -7
- READ (LUN) N
- RETURN
- END
-#ifdef CERNLIB_XVECTIBM_XINBF
-#undef CERNLIB_XVECTIBM_XINBF
-#endif
-#ifdef CERNLIB_XVECT_XINBF
-#undef CERNLIB_XVECT_XINBF
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/xvectsi/xinbmlj.s b/src/packlib/kernlib/kerngen/obsolete/kernibm/xvectsi/xinbmlj.s
deleted file mode 100644
index 5b41bcb..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/xvectsi/xinbmlj.s
+++ /dev/null
@@ -1,174 +0,0 @@
-*
-* $Id: xinbmlj.s,v 1.1.1.1 1996/02/15 17:53:08 mclareni Exp $
-*
-* $Log: xinbmlj.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:08 mclareni
-* Kernlib
-*
-*
-* .
-XINB CSECT
-*
-* CERN PROGLIB# Z203 XINB ML .VERSION KERNIBM 2.16 860113
-*
-* THIS VERSION IS FOR USE WITH THE SIEMENS/FUJITSU LIBRARY ONLY
-*
-* CALLING SEQUENCE: CALL XINB(LUN,XBV,NXB)
-*
-* FUNCTION: THIS ROUTINE CALLS THE FORTRAN LIBRARY TO PERFORM A
-* READ OF THE FORM:
-* READ(LUN,END=10,ERR=20) N,(XBV(J),J=1,L)
-* WHERE L=MIN0(NXB,N) IF N > 0
-* L=1 IF N < 1
-*
-* ARGUMENTS: LUN - FORTRAN DATA SET REFERENCE NUMBER
-* XBV - ARRAY TO CONTAIN DATA
-* NXB - ON ENTRY: MAXIMUM NUMBER OF FULLWORDS
-* WHICH CAN BE PLACED IN XBV
-* ON RETURN: THE NUMBER OF WORDS ACTUALLY
-* TRANSFERRED TO XBV IF NXB > 0
-* EOF READ IF NXB = 0
-* READ ERROR IF NXB = -7
-*
-*********************************************************************
-*
-* R.MATTHEWS, CERN/DD, 31-OCTOBER-85
-*
-*
-R0 EQU 0
-R1 EQU 1
-R2 EQU 2
-R3 EQU 3
-R4 EQU 4
-R5 EQU 5
-R6 EQU 6
-R7 EQU 7
-R8 EQU 8
-R9 EQU 9
-R10 EQU 10
-R11 EQU 11
-R12 EQU 12
-R13 EQU 13
-R14 EQU 14
-R15 EQU 15
-*---------
- PRINT NOGEN
-*
-* I N I T I A L I S A T I O N S E Q U E N C E
-*
- USING XINB,R15
- B SAVEREGS
- DC AL1(7),CL7'XINB' IDENTIFIER
- DC C'2.00' VERSION.MODIFICATION LEVEL
-SAVEREGS STM R14,R12,12(R13)
- LR R4,R13
- CNOP 0,4
- BAL R13,AROUNDSA
-SAVEAREA DC A(EPILOGUE),17F'0'
- DROP R15
- USING SAVEAREA,R13
-AROUNDSA ST R13,8(0,R4)
- ST R4,4(0,R13)
- XC 8(4,R13),8(R13)
-*
- LR R11,R1 R11 -> ARGUMENT LIST
- LM R8,R10,0(R11) R8 -> LUN; R9 -> XBV; R10-> NXB
- ST R8,PARM1+4 STORE THE ADDRESS OF LUN
- ST R8,PARM4+4 STORE THE ADDRESS OF LUN FOR ERR EXIT
- ST R9,PARM3+12 STORE THE ADDRESS OF XBV
- L R5,=V(JZLSUFI#) R5 -> JZLSUFI#
-*
-* I N I T I A L I S A T I O N C A L L
-*
- LR R15,R5 R15 -> JZLSUFI#
- LA R1,PARM1
- BALR R14,R15
-*
-* R E A D N
-*
- LR R15,R5 R15 -> JZLSUFI#
- LA R1,PARM2
- BALR R14,R15
-*
-* C A L C U L A T E L
-*
- L R0,N R0 := N
- LTR R0,R0 N > 0 ?
- BP MIN0 YES, BRANCH
- LA R0,1 L = 1
- B STOREL
-MIN0 L R1,0(0,R10) R1 := NXB
- CR R0,R1 N < NXB ?
- BNH STOREL NO, L = N
- LR R0,R1 L = NXB
-STOREL ST R0,PARM3+4 STORE L IN READ PARAMETER LIST
- ST R0,0(0,R10) STORE L IN CALLER'S ARGUMENT
-*
-* R E A D X B V
-*
- LR R15,R5 R15 -> JZLSUFI#
- LA R1,PARM3
- BALR R14,R15
-*
- B EPILOGUE
-*
-* E O F E X I T
-*
-EOF EQU *
- XC 0(4,R10),0(R10) NXB := 0
- B EPILOGUE
-*
-* E R R E X I T
-*
-ERR EQU *
- MVC 0(4,R10),ERRFLAG NXB := ERRFLAG
- LR R15,R5 R15 -> JZLSUFI#
- LA R1,PARM4
- BALR R14,R15
- B EPILOGUE
-*---------
-* R E T U R N S E Q U E N C E
-*
-EPILOGUE EQU *
- L R13,4(0,R13)
- LM R14,R12,12(R13)
- OI 12(R13),X'FF'
- BR R14
-*
-ERRFLAG DC F'-7'
-JUNK DS F
-N DS F
-*
-PARM1 DC X'14000000'
- DS A
- DC A(0)
- DC A(ERR)
- DC A(EOF)
-*
-PARM2 DC X'04050004'
- DC A(N)
-*
-PARM3 DC X'0E000101'
- DS F
- DC X'00270004'
- DS A
- DC F'4'
-*
-PARM4 DC X'10000000'
- DS A
- DC 3A(0)
- DC X'06050004'
- DC A(JUNK)
-*
- LTORG
-*
- END
-#ifdef CERNLIB_XVECTIBM_XINBML
-#undef CERNLIB_XVECTIBM_XINBML
-#endif
-#ifdef CERNLIB_XVECTIBM_XINB
-#undef CERNLIB_XVECTIBM_XINB
-#endif
-#ifdef CERNLIB_XVECT_XINB
-#undef CERNLIB_XVECT_XINB
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/xvectsi/xinbsmlj.s b/src/packlib/kernlib/kerngen/obsolete/kernibm/xvectsi/xinbsmlj.s
deleted file mode 100644
index 5e0ee88..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/xvectsi/xinbsmlj.s
+++ /dev/null
@@ -1,193 +0,0 @@
-*
-* $Id: xinbsmlj.s,v 1.1.1.1 1996/02/15 17:53:08 mclareni Exp $
-*
-* $Log: xinbsmlj.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:08 mclareni
-* Kernlib
-*
-*
-* .
-XINBS CSECT
-*
-* CERN PROGLIB# Z203 XINBS ML .VERSION KERNIBM 2.16 860113
-*
-* THIS VERSION IS FOR USE WITH THE SIEMENS/FUJITSU LIBRARY ONLY
-*
-* CALLING SEQUENCE: CALL XINBS(LUN,XAV,NA,XBV,NXB)
-*
-* FUNCTION: THIS ROUTINE CALLS THE FORTRAN LIBRARY TO PERFORM A
-* READ OF THE FORM:
-* READ(LUN,END=10,ERR=20) N,(XAV(I),I=1,NA),
-* (XBV(J),J=1,L)
-* WHERE L=MIN0(NXB,N) IF N > 0
-* L=1 IF N < 1
-*
-* ARGUMENTS: LUN - FORTRAN DATA SET REFERENCE NUMBER
-* XAV - ARRAY TO CONTAIN DATA
-* NA - NUMBER OF FULLWORDS TO BE PLACED IN XAV
-* XBV - ARRAY TO CONTAIN DATA
-* NXB - ON ENTRY: MAXIMUM NUMBER OF FULLWORDS
-* WHICH CAN BE PLACED IN XBV
-* ON RETURN: THE NUMBER OF WORDS ACTUALLY
-* TRANSFERRED TO XBV IF NXB > 0
-* EOF READ IF NXB = 0
-* READ ERROR IF NXB = -7
-*
-*********************************************************************
-*
-* R.MATTHEWS, CERN/DD, 31-OCTOBER-85
-*
-*
-R0 EQU 0
-R1 EQU 1
-R2 EQU 2
-R3 EQU 3
-R4 EQU 4
-R5 EQU 5
-R6 EQU 6
-R7 EQU 7
-R8 EQU 8
-R9 EQU 9
-R10 EQU 10
-R11 EQU 11
-R12 EQU 12
-R13 EQU 13
-R14 EQU 14
-R15 EQU 15
-*---------
- PRINT NOGEN
-*
-* I N I T I A L I S A T I O N S E Q U E N C E
-*
- USING XINBS,R15
- B SAVEREGS
- DC AL1(7),CL7'XINBS' IDENTIFIER
- DC C'2.00' VERSION.MODIFICATION LEVEL
-SAVEREGS STM R14,R12,12(R13)
- LR R4,R13
- CNOP 0,4
- BAL R13,AROUNDSA
-SAVEAREA DC A(EPILOGUE),17F'0'
- DROP R15
- USING SAVEAREA,R13
-AROUNDSA ST R13,8(0,R4)
- ST R4,4(0,R13)
- XC 8(4,R13),8(R13)
-*
- LR R11,R1 R11 -> ARGUMENT LIST
- LM R6,R10,0(R11) R6 -> LUN; R7 -> XAV; R8-> NA
-* R9 -> XBV; R10-> NXB
- ST R6,PARM1+4 STORE THE ADDRESS OF LUN
- ST R6,PARM4+4 STORE THE ADDRESS OF LUN FOR ERR EXIT
- ST R7,PARM5+12 STORE THE ADDRESS OF XAV
- L R8,0(0,R8) R8 := NA
- ST R8,PARM5+4 STORE NA
- ST R9,PARM3+12 STORE THE ADDRESS OF XBV
- L R5,=V(JZLSUFI#) R5 -> JZLSUFI#
-*
-* I N I T I A L I S A T I O N C A L L
-*
- LR R15,R5 R15 -> JZLSUFI#
- LA R1,PARM1
- BALR R14,R15
-*
-* R E A D N
-*
- LR R15,R5 R15 -> JZLSUFI#
- LA R1,PARM2
- BALR R14,R15
-*
-* R E A D X A V
-*
- LR R15,R5 R15 -> JZLSUFI#
- LA R1,PARM5
- BALR R14,R15
-*
-* C A L C U L A T E L
-*
- L R0,N R0 := N
- LTR R0,R0 N > 0 ?
- BP MIN0 YES, BRANCH
- LA R0,1 L = 1
- B STOREL
-MIN0 L R1,0(0,R10) R1 := NXB
- CR R0,R1 N < NXB ?
- BNH STOREL NO, L = N
- LR R0,R1 L = NXB
-STOREL ST R0,PARM3+4 STORE L IN READ PARAMETER LIST
- ST R0,0(0,R10) STORE L IN CALLER'S ARGUMENT
-*
-* R E A D X B V
-*
- LR R15,R5 R15 -> JZLSUFI#
- LA R1,PARM3
- BALR R14,R15
-*
- B EPILOGUE
-*
-* E O F E X I T
-*
-EOF EQU *
- XC 0(4,R10),0(R10) NXB := 0
- B EPILOGUE
-*
-* E R R E X I T
-*
-ERR EQU *
- MVC 0(4,R10),ERRFLAG NXB := ERRFLAG
- LR R15,R5 R15 -> JZLSUFI#
- LA R1,PARM4
- BALR R14,R15
- B EPILOGUE
-*---------
-* R E T U R N S E Q U E N C E
-*
-EPILOGUE EQU *
- L R13,4(0,R13)
- LM R14,R12,12(R13)
- OI 12(R13),X'FF'
- BR R14
-*
-ERRFLAG DC F'-7'
-JUNK DS F
-N DS F
-*
-PARM1 DC X'14000000'
- DS A
- DC A(0)
- DC A(ERR)
- DC A(EOF)
-*
-PARM2 DC X'04050004'
- DC A(N)
-*
-PARM3 DC X'0E000101'
- DS F
- DC X'00270004'
- DS A
- DC F'4'
-*
-PARM4 DC X'10000000'
- DS A
- DC 3A(0)
- DC X'06050004'
- DC A(JUNK)
-*
-PARM5 DC X'0C000101'
- DS F
- DC X'00270004'
- DS A
- DC F'4'
-*
- LTORG
-*
- END
-#ifdef CERNLIB_XVECTIBM_XINBSML
-#undef CERNLIB_XVECTIBM_XINBSML
-#endif
-#ifdef CERNLIB_XVECTIBM_XINBS
-#undef CERNLIB_XVECTIBM_XINBS
-#endif
-#ifdef CERNLIB_XVECT_XINBS
-#undef CERNLIB_XVECT_XINBS
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibm/xvectsi/xvectsi.h b/src/packlib/kernlib/kerngen/obsolete/kernibm/xvectsi/xvectsi.h
deleted file mode 100644
index d0cf1d5..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibm/xvectsi/xvectsi.h
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: xvectsi.h,v 1.1.1.1 1996/02/15 17:53:08 mclareni Exp $
-*
-* $Log: xvectsi.h,v $
-* Revision 1.1.1.1 1996/02/15 17:53:08 mclareni
-* Kernlib
-*
-*
-* This directory was created from kernibm.car patch xvectsi
-#ifndef CERNLIB_XVECTIBM
-#define CERNLIB_XVECTIBM
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/_kibx/pilot.h b/src/packlib/kernlib/kerngen/obsolete/kernibx/_kibx/pilot.h
deleted file mode 100644
index 4260eb3..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/_kibx/pilot.h
+++ /dev/null
@@ -1,27 +0,0 @@
-#if 0
-* This pilot patch was created from kernibx.car patch _kibx
-#endif
-#if 0
-* Pilot IBM 3090, system AIX
-#endif
-#ifndef CERNLIB_QMIBX
-#define CERNLIB_QMIBX
-#endif
-#ifndef CERNLIB_IBXGS
-#define CERNLIB_IBXGS
-#endif
-#ifndef CERNLIB_IBXSYS
-#define CERNLIB_IBXSYS
-#endif
-#ifndef CERNLIB_CCGEN
-#define CERNLIB_CCGEN
-#endif
-#ifndef CERNLIB_CCGENCF
-#define CERNLIB_CCGENCF
-#endif
-#ifndef CERNLIB_XVECT
-#define CERNLIB_XVECT
-#endif
-#ifndef CERNLIB_TCGEN
-#define CERNLIB_TCGEN
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/_kibxvf/pilot.h b/src/packlib/kernlib/kerngen/obsolete/kernibx/_kibxvf/pilot.h
deleted file mode 100644
index 0f7f238..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/_kibxvf/pilot.h
+++ /dev/null
@@ -1,12 +0,0 @@
-#if 0
-* This pilot patch was created from kernibx.car patch _kibxvf
-#endif
-#if 0
-* Pilot IBM 3090, system AIX, vector
-#endif
-#ifndef CERNLIB_QMIBXVF
-#define CERNLIB_QMIBXVF
-#endif
-#ifndef CERNLIB__KIBX
-#define CERNLIB__KIBX
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/history/history.dat b/src/packlib/kernlib/kerngen/obsolete/kernibx/history/history.dat
deleted file mode 100644
index f65f7d3..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/history/history.dat
+++ /dev/null
@@ -1,36 +0,0 @@
-*
-* $Id: history.dat,v 1.1.1.1 1996/02/15 17:54:30 mclareni Exp $
-*
-* $Log: history.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:54:30 mclareni
-* Kernlib
-*
-*
-* This directory was created from kernibx.car patch kernibx
-#if !defined(CERNLIB_KERNIBX)
-
- KERNLIB routines in machine language or otherwise special
- for IBM 3090 with AIX
-
----------------------------------------------------------------------
-
- This file contains the following Patches :
-
-Pilot patches
--------------
-
-*KIBX Kern IBM pilot for system AIX 370
-
-*KIBXVF Kern pilot for the vector facility
-
-Other patches
--------------
-
-QMIBXVF option : using the Vector Facility
-
-IBXGS IBM specific normal routines
-
-IBXSYS System routines for system AIX 370
-
-=====================================================================
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/history/previous.dat b/src/packlib/kernlib/kerngen/obsolete/kernibx/history/previous.dat
deleted file mode 100644
index 685747d..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/history/previous.dat
+++ /dev/null
@@ -1,74 +0,0 @@
-*
-* $Id: previous.dat,v 1.1.1.1 1996/02/15 17:54:30 mclareni Exp $
-*
-* $Log: previous.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:54:30 mclareni
-* Kernlib
-*
-*
-#if !defined(CERNLIB_KERNIBX)
-
-Up-date 1.05 : 11-May-1992
-----------------------------
-
-Replacing File KERNIBX 1.04 910719 13.18
-
-New decks : LENOCC, LNBLNK for speed
-
----------------------------------------------------------------------
-
-Up-date 1.04 : 18-July-1991
-----------------------------
-
-Replacing File KERNIBX 1.03 910315 17.06
-
-Deleted : P=IBXSYS, D=QNEXTE use default on KERNFOR
- P=IBXSYS, D=KWNOCR was temporary
-
----------------------------------------------------------------------
-
-Up-date 1.03 : 15-Mar-1991
-----------------------------
-
-Replacing File KERNIBX 1.02 900803 10.33
-
-New decks : SIGNALF
-
-Correct : Connect P=CCGEN of KERNFOR
- D=RNDM, KWNORCR bugs fixed
-
-Deleted : CHDIR, GETCWD, GETENV, PERROR, RENAME
-
----------------------------------------------------------------------
-
-Up-date 1.02 : 1-Aug-1990
-----------------------------
-
-Replacing File KERNIBX 1.01 900530 15.00
-
-New patch : *KIBXVF
-
-New decks : CHDIR, GETCWD, GETENV, PERROR, RENAME, SIGNAL, SYSTEM
-
-Deleted : INTRAC
-
-Correct : Connect CCGEN, D= INTRAC, TMNBUF, TMPROM, TMREAD
-
----------------------------------------------------------------------
-
-Up-date 1.01 : 30-May-1990
-----------------------------
-
-Replacing File KERNIBX 1.00 900328 19.00
-
-New patch : QMIBXVF routines using the vector facility
-
-Correct : General tidying up of version 1.00
-
----------------------------------------------------------------------
-
- First release of the KERNIBX Pam : 28-Mar-1990
-
----------------------------------------------------------------------
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/history/update.dat b/src/packlib/kernlib/kerngen/obsolete/kernibx/history/update.dat
deleted file mode 100644
index 0114bb5..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/history/update.dat
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: update.dat,v 1.1.1.1 1996/02/15 17:54:30 mclareni Exp $
-*
-* $Log: update.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:54:30 mclareni
-* Kernlib
-*
-*
-#if !defined(CERNLIB_KERNIBX)
-
-
- Up-date record for the Pam-file KERNIBX
- ----------------------------------------
-
-
-Up-date 1.06 : 24-Feb-1994
-----------------------------
-
-Replacing File KERNIBX 1.05 920521 16.29
-
-Correct: a bug in IE3FOS (correction copied from KERNIBM)
-
----------------------------------------------------------------------
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/bitpos.s b/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/bitpos.s
deleted file mode 100644
index 2513660..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/bitpos.s
+++ /dev/null
@@ -1,87 +0,0 @@
-*
-* $Id: bitpos.s,v 1.1.1.1 1996/02/15 17:54:35 mclareni Exp $
-*
-* $Log: bitpos.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:35 mclareni
-* Kernlib
-*
-*
-BITPOS CSECT
-*
-* CERN PROGLIB# M508 BITPOS .VERSION KERNIBX 1.01 900523
-* ORIG. OCT 81, R.MATTHEWS
-* Modified for AIX, Roger Howard, January 1990
-*
-* CALL BITPOS (STRING,LENGTH,LOCS,NUMBER)
-*
-* FUNCTION: EXAMINE A STRING OF BITS AND STORE THE LOCATIONS OF
-* THE BITS HAVING THE VALUE 1 IN SUCCESSIVE WORDS OF
-* AN ARRAY.
-*
-* ARGUMENTS: STRING - AN ARRAY OF FULLWORDS CONTAINING THE BIT STRING
-*
-* LENGTH - THE NUMBER OF BITS IN THE BIT STRING
-*
-* LOCS - AN INTEGER*4 ARRAY TO RECEIVE THE LOCATIONS
-* OF THE BITS WHOSE VALUE IS 1
-*
-* NUMBER - THE NUMBER OF BITS FOUND TO HAVE THE VALUE 1
-*
-R0 EQU 0
-R1 EQU 1
-R2 EQU 2
-R3 EQU 3
-R4 EQU 4
-R5 EQU 5
-R6 EQU 6
-R7 EQU 7
-R8 EQU 8
-R9 EQU 9
-R10 EQU 10
-R11 EQU 11
-R12 EQU 12
-R13 EQU 13
-R14 EQU 14
-R15 EQU 15
-*
-* P R O L O G U E
-*
- USING *,R15
- ENTRY _bitpos_
-_bitpos_ STM R2,R1,16(R13)
- LR R9,R0 AIX: address of arg1 = STRING
- LR R11,R2 AIX: address of arg3 = LOCS
- LR R12,R3 AIX: address of arg4 = NUMBER
- L R3,0(,R1) AIX: value of arg2 = LENGTH
- LA R2,1 R2 := 1 (LOOP INCREMENT)
- SR R3,R2
- SR R4,R4 R4 := 0 (LOOP COUNTER)
- SR R5,R5 R5 := 0 (INDEX FOR LOCS)
-*
-NEWORD L R6,0(0,R9) R6 := NEW WORD OF STRING
- LA R9,4(0,R9) R9 -> NEXT WORD OF STRING
- LA R8,32 PRIME THE COUNTER
-TESTBIT SR R8,R2 R8 := NUMBER OF BITS UNTESTED IN WORD
- SRDL R6,1 SHIFT LEAST SIGNIFICANT BIT OF R6 INTO R7
- LTR R7,R7 IS IT 1 ?
- BNM TESTWORD NO, BRANCH
- ST R4,0(R5,R11) STORE ITS LOCATION IN LOCS
- LA R5,4(0,R5) INCREMENT THE INDEX FOR LOCS
-TESTWORD LTR R6,R6 ARE THERE ANY MORE 1 BITS IN THE WORD ?
- BNZ LOOPEND YES, BRANCH TO PROCESS THEM
- AR R4,R8 OTHERWISE INCREMENT THE LOOP COUNTER BY
- BXLE R4,R2,NEWORD THE NUMBER OF BITS REMAINING UNTESTED
-LOOPEND BXLE R4,R2,TESTBIT AND TEST WHETHER FINISHED
-*
- SRA R5,2 NUMBER = (R5)/4
- ST R5,0(0,R12) STORE NUMBER
-*
-* E P I L O G U E
-*
-EPILOGUE EQU *
- LM R2,R1,16(R13)
- BR R14
- END
-#ifdef CERNLIB_TCGEN_BITPOS
-#undef CERNLIB_TCGEN_BITPOS
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/blow.s b/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/blow.s
deleted file mode 100644
index 9d73c38..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/blow.s
+++ /dev/null
@@ -1,79 +0,0 @@
-*
-* $Id: blow.s,v 1.1.1.1 1996/02/15 17:54:35 mclareni Exp $
-*
-* $Log: blow.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:35 mclareni
-* Kernlib
-*
-*
-BLOW CSECT
-*
-* CERN PROGLIB# Z035 BLOW .VERSION KERNIBX 1.01 900523
-*
-* CALL BLOW (INPUT,OUTPUT,'NBYTES',BITS/'BYTE')
-*
-* MODIFIED JAN 1982 TO IGNORE CALLS WITH ERRONEOUS PARAMETER VALUES
-* Modified for AIX, Roger Howard, January 1990
-*
- USING *,15
- ENTRY _blow_
-_blow_ STM 2,1,16(13)
-*
-* REGISTERS
-* 1 INDEX FOR STORE OF OUTPUT
-* 2 INCREMENT
-* 3 COMPARAND NR ENTRIES-1 *4
-* 4 MASK
-* 5 NR BITS LEFT AFTER SHIFT
-* 6 NR BITS/'BYTE'
-* 7 OFFSET OF INPUT
-* 8 ADDRESS OF INPUT
-* 9 ADDRESS OF OUTPUT
-* 10
-* 11 REGS FOR SHIFT
-* 12 TEMPORARY REG
-*
- LR 8,0 AIX: address of arg1 = INPUT
- LR 9,1 AIX: address of arg2 = OUTPUT
- L 6,0(,3) AIX: value of arg4 = "bits/byte"
- L 3,0(,2) AIX: value of arg3 = "nbytes"
-*
-* TEST FOR VALIDITY OF ARGUMENTS
- LTR 12,3 ZERO NUMBER OF BYTES
- BC 12,END IGNORE AND RETURN
- LTR 12,6 <1 BITS/'BYTE'
- BC 12,END IGNORE AND RETURN
- LA 12,32(0)
- SR 12,6 >31 BITS/'BYTE'
- BC 12,END IGNORE AND RETURN
-*
- S 3,=F'1' SUBTRACT ONE FROM NR OF 'BYTES'
- SLA 3,2(0) MULTIPLY BY 4
- L 5,=X'FFFFFFFF'
- SR 4,4
- SLDL 4,0(6) CONSTRUCT MASK
- LA 2,4(0) SET UP INCREMENT = 4 BYTES = 1 FULL WORD
- LA 1,0(0) ZERO INDEX TO START WITH
- LA 7,0(0) ZERO INPUT OFFSET
- L 11,0(7,8) LOAD FIRST WORD
- LA 5,32(0) SET UP NUMBER OF BITS THAT CAN BE SHIFTED
-LOOP SLDL 10,0(6) SHIFT
- SR 5,6 SUBTRACT NUMBER OF BITS SHIFTED
- BC 4,LOAD BRANCH TO LOAD IF < ZERO
-LOOP2 NR 10,4 MASK
- ST 10,0(1,9) STORE
- BXH 1,2,END BRANCH OUT IF STORE COMPLETE
- B LOOP
-LOAD LPR 12,5 LOAD NUMBER OF BITS TO SHIFT BACK
- SRDL 10,0(12) SHIFT BACK
- LA 7,4(7) LOAD NEW INPUT OFFSET
- L 11,0(7,8) LOAD NEW 11
- A 5,=F'32'
- SLDL 10,0(12) SHIFT AGAIN
- B LOOP2
-END LM 2,1,16(13)
- BR 14
- END
-#ifdef CERNLIB_TCGEN_BLOW
-#undef CERNLIB_TCGEN_BLOW
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/bunch.s b/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/bunch.s
deleted file mode 100644
index 7f6aedf..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/bunch.s
+++ /dev/null
@@ -1,82 +0,0 @@
-*
-* $Id: bunch.s,v 1.1.1.1 1996/02/15 17:54:36 mclareni Exp $
-*
-* $Log: bunch.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:36 mclareni
-* Kernlib
-*
-*
-BUNCH CSECT
-*
-* CERN PROGLIB# Z035 BUNCH .VERSION KERNIBX 1.01 900523
-*
-* CALL BUNCH( INPUT,OUTPUT,'NBYTES',BITS/'BYTE')
-*
-* MODIFIED JAN 1982 TO IGNORE CALLS WITH ERRONEOUS PARAMETER VALUES
-* Modified for AIX, Roger Howard, January 1990
-*
- USING *,15
- ENTRY _bunch_
-_bunch_ STM 2,1,16(13)
-*
-* REGISTERS
-* 1 INDEX FOR FETCH OF INPUT
-* 2 INCREMENT
-* 3 COMPARAND NR ENTRIES-1 *4
-* 5 NR BITS LEFT AFTER SHIFT
-* 6 NR BITS/'BYTE'
-* 7 OFFSET OF OUTPUT
-* 8 ADDRESS OF OUTPUT
-* 9 ADDRESS OF INPUT
-* 10
-* 11 REGS FOR SHIFT
-* 12 TEMPORARY REG
-*
- LR 9,0 AIX: address of arg1 = INPUT
- LR 8,1 AIX: address of arg2 = OUTPUT
- L 6,0(,3) AIX: value of arg4 = "bits/byte"
- L 3,0(,2) AIX: value of arg3 = "nbytes"
-*
-* TEST FOR VALIDITY OF ARGUMENTS
- LTR 12,3 ZERO NUMBER OF BYTES
- BC 12,END IGNORE AND RETURN
- LTR 12,6 <1 BITS/'BYTE'
- BC 12,END IGNORE AND RETURN
- LA 12,32(0)
- SR 12,6 >31 BITS/'BYTE'
- BC 12,END IGNORE AND RETURN
-*
- S 3,=F'1' SUBTRACT ONE FROM NR OF 'BYTES'
- SLA 3,2(0) MULTIPLY BY 4
- LA 2,4(0) SET UP INCREMENT = 4 BYTES = 1 FULL WORD
- LA 1,0(0) ZERO INDEX TO START WITH
- LA 7,0(0) ZERO OUTPUT OFFSET
- LA 5,32(0) SET UP NUMBER OF BITS THAT CAN BE SHIFTED
- SR 10,10 ZERO OUT FIRST OUTPUT REG
-LOOP L 11,0(1,9) LOAD A 'BYTE'
- LA 12,32(0) FIGURE OUT HOW MUCH TO SHIFT TO GET RID
- SR 12,6 OF LEADING ZEROES IN 'BYTE'
- SLL 11,0(12) SHIFT
- SR 5,6 CAN BE SHIFTED WITHOUT SPILL
- BC 4,STORE IF NOT GO TO STORE
- SLDL 10,0(6) SHIFT INTO REG 10
-LOOP2 BXH 1,2,END TEST IF ALL DONE
- B LOOP
-STORE LPR 14,5 ABS OF SPILL
- LR 12,6
- SR 12,14 HOW MANY CAN BE SHIFTED WITHOUT SPILL?
- SLDL 10,0(12) SHIFT
- ST 10,0(7,8) STORE PACKED 'BYTES'
- LA 7,4(7) INCREMENT OFFSET FOR STORE
- SR 10,10 ZERO OUT 10
- SLDL 10,0(14) SHIFT REST
- A 5,=F'32' CORRECT NUMBER OF BITS THAT CAN BE SHIFTED
- B LOOP2 WITHOUT SPILL
-END SLDL 10,0(5) SHIFT TO DELETE REMAINING ZEROES
- ST 10,0(7,8) STORE LAST REG 10
- LM 2,1,16(13)
- BR 14
- END
-#ifdef CERNLIB_TCGEN_BUNCH
-#undef CERNLIB_TCGEN_BUNCH
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/cbyt.s b/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/cbyt.s
deleted file mode 100644
index cfb2a57..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/cbyt.s
+++ /dev/null
@@ -1,64 +0,0 @@
-*
-* $Id: cbyt.s,v 1.1.1.1 1996/02/15 17:54:36 mclareni Exp $
-*
-* $Log: cbyt.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:36 mclareni
-* Kernlib
-*
-*
-CBYT CSECT
-*
-* CERN PROGLIB# M421 CBYT .VERSION KERNIBX 1.01 900523
-*
- USING *,15
- ENTRY _cbyt_
-_cbyt_ STM 2,12,16(13)
- LR 12,13 ... added for AIX
- USING STACK,13
- S 13,=A(STEND-STACK) ... added for AIX
- ST 12,4(0,13) ... added for AIX
- L 6,88(,12) AIX: address of arg5
- L 5,0(,3) AIX: value of arg4
- LR 12,2 AIX: address of arg3
- LR 2,0 AIX: address of arg1
- L 2,0(2) AIX: value of arg1
- L 3,0(,1) AIX: value of arg2
- BCTR 3,0
- SRL 2,0(3)
- L 4,0(,12) AIX: value of arg3
- BCTR 5,0
- L 6,0(6)
- LA 7,STOREC
-STOREC STC 2,BYTE
- TM BYTE,X'01'
- BC 8,ZERO
- LA 8,1
- SLL 8,0(5)
- OR 4,8
- B TESTR6
-ZERO L 10,FE
- L 11,FF
- SLDL 10,0(5)
- NR 4,10
-TESTR6 BCT 6,*+8
- B STOREX
- LA 5,1(5)
- SRL 2,1
- BCR 15,7
-STOREX ST 4,0(,12) return arg3
- L 13,4(0,13)
- LM 2,12,16(13)
- BCR 15,14
-FF DC X'FFFFFFFF'
-FE DC X'FFFFFFFE'
- LTORG
-STACK DSECT
-SAVEAREA DS 18F
-AIXOUT DS 4F
-LINKR23 DS 2F
-BYTE DS C
-STEND DS 0F
- END
-#ifdef CERNLIB_TCGEN_CBYT
-#undef CERNLIB_TCGEN_CBYT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/floarg.s b/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/floarg.s
deleted file mode 100644
index bc7952e..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/floarg.s
+++ /dev/null
@@ -1,91 +0,0 @@
-*
-* $Id: floarg.s,v 1.1.1.1 1996/02/15 17:54:36 mclareni Exp $
-*
-* $Log: floarg.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:36 mclareni
-* Kernlib
-*
-*
-FLOARG CSECT
-*
-* CERN PROGLIB# M250 FLOARG .VERSION KERNIBX 1.01 900523
-*
-* R. MATTHEWS, CERN/DD, AUGUST 1983.
-* Modified for AIX, Roger Howard, January 1990
-*
-R0 EQU 0
-R1 EQU 1
-R2 EQU 2
-R3 EQU 3
-R4 EQU 4
-R5 EQU 5
-R6 EQU 6
-R7 EQU 7
-R8 EQU 8
-R9 EQU 9
-R10 EQU 10
-R11 EQU 11
-R12 EQU 12
-R13 EQU 13
-R14 EQU 14
-R15 EQU 15
-*
-F0 EQU 0
-F2 EQU 2
-F4 EQU 4
-F6 EQU 6
-*
-* P R O L O G U E
-*
- USING *,R15
- ENTRY _floarg_
-_floarg_ STM R2,R1,16(R13)
- LR R4,R13
- USING STACK,R13
- S R13,=A(STEND-STACK)
- ST R4,4(0,R13)
-*
- LR R2,0 AIX: address of argument
- LE F0,0(0,R2) F0 := ARGUMENT
- L R3,0(0,R2) R3 := ARGUMENT
- TM 0(R2),X'80' IS THE SIGN BIT ON ?
- BO NEGATIVE YES, BRANCH
-*
- TM 0(R2),X'7F' IS THE ARGUMENT FLOATING POINT ?
- BNZ EPILOGUE PROBABLY, RETURN
-*
- L R2,=X'4E000000' R2 := CHARACTERISTIC
- STM R2,R3,FPNUM STORE THE UNNORMALIZED NUMBER
- LD F0,FPNUM F0 := UNNORMALIZED NUMBER
- AD F0,=D'0.0' NORMALIZE IT
- B EPILOGUE RETURN
-*
-NEGATIVE TM 0(R2),X'7F' IS THE ARGUMENT FLOATING POINT ?
- BNO EPILOGUE PROBABLY, RETURN
-*
- LPR R3,R3 R3 := ABS(ARGUMENT)
- L R2,=X'CE000000' R2 := CHARACTERISTIC
- STM R2,R3,FPNUM STORE THE UNNORMALIZED NUMBER
- LD F0,FPNUM F0 := UNNORMALIZED NUMBER
- AD F0,=D'0.0' NORMALIZE IT
-*
-* E P I L O G U E
-*
-EPILOGUE EQU *
- L R13,4(0,R13)
- LM R2,R12,16(R13)
- BR R14
- LTORG
-*
-* D A T A A R E A S
-*
-STACK DSECT
-SAVEAREA DS 18F
-AIXOUT DS 0F
-LINKR23 DS 2F
-FPNUM DS D
-STEND DS 0D
- END
-#ifdef CERNLIB_TCGEN_FLOARG
-#undef CERNLIB_TCGEN_FLOARG
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/ibits.s b/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/ibits.s
deleted file mode 100644
index 8d61b78..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/ibits.s
+++ /dev/null
@@ -1,39 +0,0 @@
-*
-* $Id: ibits.s,v 1.1.1.1 1996/02/15 17:54:36 mclareni Exp $
-*
-* $Log: ibits.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:36 mclareni
-* Kernlib
-*
-*
-IBITS CSECT
-*
-* CERN PROGLIB# M441 BITPAK .VERSION KERNIBX 1.01 900523
-* ORIG. MAY 87, K.M.STORR, CERN/DD
-* Modified for AIX, Roger Howard, January 1990
-*
-* FUNCTION IBITS : J=IBITS(I,N,L)
-* is J=ISHFT(ISHFT(I,32-L-N),L-32)
-*
- USING *,15
- ENTRY _ibits_
-_ibits_ STM 2,4,16(13)
- LR 4,0
- L 0,0(,4) AIX: value of arg1 = I
-* AIX: address of arg2 is in GR1
- L 2,0(,2) AIX: value of arg3 = L
- L 2,0(,2) AIX: value of arg3 = L
- LR 4,2 make copy of L
- A 2,0(0,1) L+N
- LA 3,32
- SR 3,2 32-L-N
- SLL 0,0(3) shift out unwanted lhs bits
- LA 3,32
- SR 3,4 32-L
- SRL 0,0(3) FINAL RESULT
- LM 2,4,16(13)
- BR 14
- END
-#ifdef CERNLIB_TCGEN_IBITS
-#undef CERNLIB_TCGEN_IBITS
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/ie3fod.F b/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/ie3fod.F
deleted file mode 100644
index 8d20bdf..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/ie3fod.F
+++ /dev/null
@@ -1,180 +0,0 @@
-*
-* $Id: ie3fod.F,v 1.1.1.1 1996/02/15 17:54:36 mclareni Exp $
-*
-* $Log: ie3fod.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:36 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
-#if defined(CERNLIB_QMIBXVF)
- at PROCESS DIRECTIVE ('*VDIR:') OPT(3) VECTOR
-#endif
- SUBROUTINE IE3FOD (MS,MT,NDPN,JBAD)
-C
-C CERN PROGLIB# M220 IE3FOD .VERSION KERNIBX 1.00 900101
-
-C 02/03/89 M.Roethlisberger/IBM + J.Zoll/CERN Optimise / Vectorise
-C
-C- Convert double precision for output with copy
-C- from source in native to target in IEEE data format
-
-C- Reference: ZEBRA REFERENCE MANUAL book FZ, para. 3.03
-C-
-C- IBM Representation: sccc cccc mmmm mmmm mmmm mmmm mmmm mmmm
-C- mmmm mmmm mmmm mmmm mmmm mmmm mmmm mmmm
-
-C- IEEE Representation: sccc cccc cccc mmmm mmmm mmmm mmmm mmmm
-C- mmmm mmmm mmmm mmmm mmmm mmmm mmmm mmmm
-C-
-C- m: Mant (I3E) = Mant (IBM)/J1 (right-shifting)
-C- and left-most bit discarded (hidden bit)
-
-C- c: Exp (I3E) = 4*(Exp (IBM) - 64) - 1019 + J2
-C- = 4*Exp(IBM) - 763 + J2
-C-
-C- s: Sign (IBM) = Sign (IE3)
-C-
-C- Where J1 and J2 are both function of the 4 left-most bits
-C- of IBM mantissa.
-C-
-C-
- DIMENSION MS(99) , MT(99)
- DIMENSION J1(0:15) , J2(0:15) , J3(0:15)
-
-C PARAMETER (IBADMS = Z 7FFFFFFF)
- PARAMETER (IBADMS = 2147 483 647)
-C PARAMETER (MSKA31 = Z 7FFFFFFF)
- PARAMETER (MSKA31 = 2147 483 647)
-C PARAMETER (MSKA7F = Z 7F000000)
- PARAMETER (MSKA7F = 2130 706 432)
-C PARAMETER (MN2131 = Z 800FFFFF)
- PARAMETER (MN2131 =-2146 435 073)
-C PARAMETER (MSKA24 = Z 00FFFFFF)
- PARAMETER (MSKA24 = 16 777 215)
-C PARAMETER (MSK00F = Z 00F00007)
- PARAMETER (MSK00F = 15 728 640)
-C PARAMETER (IBADCD = Z 7FF01FC0)
- PARAMETER (IBADCD = 2146 443 200)
-C PARAMETER (IOVPCD = Z 7FF00000)
- PARAMETER (IOVPCD = 2146 435 072)
-C PARAMETER (IOVNCD = Z FFF00000)
- PARAMETER (IOVNCD = -1 048 576)
-
- PARAMETER (LVMIN = 38)
-
- DATA (J1 (II),II=0,15) /
-C
-C II= 0000, 0001, 0010, 0011, 0100, 0101, 0110, 0111,
- + 1, 1, 2, 2, 4, 4, 4, 4,
-C
-C II= 1000, 1001, 1010, 1011, 1100, 1101, 1110, 1111,
- + 8, 8, 8, 8, 8, 8, 8, 8/
-
- DATA (J2 (II),II=0,15) /
-C
-C II = 0000, 0001, 0010, 0011,
-C J2 = 00000000, 00000000, 00100000, 00100000,
- + 0, 0, 1 048 576, 1 048 576,
-C
-C II = 0100, 0101, 0110, 0111,
-C J2 = 00200000, 00200000, 00200000, 00200000,
- + 2 097 152, 2 097 152, 2 097 152, 2 097 152,
-C
-C II = 1000, 1001, 1010, 1011,
-C J2 = 00300000, 00300000, 00300000, 00300000,
- + 3 145 728, 3 145 728, 3 145 728, 3 145 728,
-C
-C II = 1100, 1101, 1110, 1111
-C J2 = 00300000, 00300000, 00300000, 00300000,
- + 3 145 728, 3 145 728, 3 145 728, 3 145 728/
-
-
- DATA (J3 (II),II=0,15) /
-C
-C II= 0000, 0001, 0010, 0011, 0100, 0101, 0110, 0111,
- + 8, 8, 4, 4, 2, 2, 2, 2,
-C
-C II= 1000, 1001, 1010, 1011, 1100, 1101, 1110, 1111,
- + 1, 1, 1, 1, 1, 1, 1, 1/
-
-#include "q_andor.inc"
-#include "q_shift.inc"
-
- JBAD = 0
- NLOOP = 2*NDPN
-
-#if defined(CERNLIB_QMIBXVF)
-C*VDIR: PREFER VECTOR
- IF (NDPN.LT.LVMIN) GO TO 336
-
-C---- Vector loop
-
- DO 334 JL=1,NLOOP,2
-
-C Stores the 4 left-most bits of IBM mantissa
- JMOST = ISHFTR (ISHFTL(MS(JL),8), 28)
-
-C Stores I3E exponent
- JEXP = ISHFTR (IAND(MS(JL),MSKA7F), 2)
- + + J2(JMOST) + 800 063 488
-
-C Stores I3E left part of mantissa
- JMANT = IAND (IAND(MS(JL),MSKA24) / J1(JMOST), MN2131)
-
-C Stores lost bits due to right-shifting
- LOST = IOR (ISHFTL(MS(JL),29), ISHFTL (
- + ISHFTR(MS(JL+1),31), 28) ) * J3(JMOST)
-
-C Concatenates left part of I3E mantissa, exponent and sign
- MT(JL) = IOR ( IOR(JMANT,JEXP),IAND(MS(JL),NOT(MSKA31)))
-
-C Concatenates lost bits and right part of mantissa
- MT(JL+1) = IOR (LOST,IAND (MS(JL+1),MSKA31)/J1(JMOST) )
- 334 CONTINUE
- GO TO 341
-C*VDIR: PREFER SCALAR ON
-#endif
-C---- Scalar loop
-
- 336 DO 339 JL=1,NLOOP,2
- JMOST = ISHFTR (ISHFTL(MS(JL),8), 28)
- JEXP = ISHFTR (IAND(MS(JL),MSKA7F), 2)
- + + J2(JMOST) + 800 063 488
- JMANT = IAND (IAND(MS(JL),MSKA24) / J1(JMOST), MN2131)
- LOST = IOR (ISHFTL(MS(JL),29), ISHFTL (
- + ISHFTR(MS(JL+1),31), 28) ) * J3(JMOST)
- MT(JL) = IOR ( IOR(JMANT,JEXP),IAND(MS(JL),NOT(MSKA31)))
- MT(JL+1) = IOR (LOST,IAND (MS(JL+1),MSKA31)/J1(JMOST) )
- 339 CONTINUE
-
-C---- Second loop for exceptions handling
-
- 341 DO 349 JL=1,NLOOP,2
- IF (IAND (MS(JL),MSK00F).EQ.0) THEN
-C Floating point zero/underflow
- MT(JL ) = 0
- MT(JL+1) = 0
- GO TO 349
- ENDIF
-
- IF (IAND (MS(JL),MSKA7F).EQ.MSKA7F) THEN
-C Error conditions
- JBAD = (JL+1) / 2
- IF (MS(JL).NE.IBADMS) THEN
-C Signed infinity
- MT(JL) = IOR (IOVPCD, IAND(MS(JL),NOT(MSKA31)) )
- MT(JL+1) = 0
- ELSE
-C Not a Number (NaN)
- MT(JL) = IBADCD
- MT(JL+1) = 0
- ENDIF
- ENDIF
- 349 CONTINUE
- RETURN
- END
-#ifdef CERNLIB_TCGEN_IE3FOD
-#undef CERNLIB_TCGEN_IE3FOD
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/ie3fos.F b/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/ie3fos.F
deleted file mode 100644
index c0cc313..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/ie3fos.F
+++ /dev/null
@@ -1,183 +0,0 @@
-*
-* $Id: ie3fos.F,v 1.1.1.1 1996/02/15 17:54:36 mclareni Exp $
-*
-* $Log: ie3fos.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:36 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
-#if defined(CERNLIB_QMIBXVF)
- at PROCESS DIRECTIVE ('*VDIR:') OPT(3) VECTOR
-#endif
- SUBROUTINE IE3FOS (MS,MT,NWDO,JBAD)
-C
-C CERN PROGLIB# M220 IE3FOS .VERSION KERNIBX 1.06 940224
-C
-C 02/03/89 M.Roethlisberger/IBM + J.Zoll/CERN Optimise / Vectorise
-C 01/11/90 M.Roethlisberger/IBM Explicit sectioning, Bug fixed
-C (null mantissa implies now MT=0)
-
-C- Convert single precision for output with copy
-C- from source in native to target in IEEE data format
-C-
-C- Reference: ZEBRA REFERENCE MANUAL book FZ, para. 3.03
-C-
-C- IBM Representation: sccc cccc mmmm mmmm mmmm mmmm mmmm mmmm
-C- IEEE Representation: sccc cccc cmmm mmmm mmmm mmmm mmmm mmmm
-
-C- m: Mant(I3E) = Mant (IBM)*J1 (left-shifting)
-C- and discards left-most bit (hidden bit)
-
-C- c: Exp (I3E) = 4*(Exp(IBM)-64) + J2 + 126 =
-C- = 4*EXP(IBM) + J2 -130
-
-C- s: Sign (I3E) = Sign(IBM)
-C-
-C- Where J1 and J2 are both function of the 4 leftmost bits
-C- of IBM mantissa.
-C-
-#if defined(CERNLIB_3090S)||defined(CERNLIB_3090J)
- PARAMETER (IS = 256)
-#endif
-#if (!defined(CERNLIB_3090S))&&(!defined(CERNLIB_3090J))
- PARAMETER (IS = 128)
-#endif
- DIMENSION MS(*) , MT(*)
- DIMENSION J1 (0:15) , J2 (0:15)
- DIMENSION JEXP(IS) , INP(IS)
-
-C-- PARAMETER (IBADMS = Z 7FFFFFFF)
- PARAMETER (IBADMS = 2147 483 647)
-C-- PARAMETER (MSKA7F = Z 7F000000)
- PARAMETER (MSKA7F = 2130 706 432)
-C-- PARAMETER (MSKA23 = Z 007FFFFF)
- PARAMETER (MSKA23 = 8 388 607)
-C-- PARAMETER (MSKA24 = Z 00FFFFFF)
- PARAMETER (MSKA24 = 16 777 215)
-C-- PARAMETER (MSKA31 = Z 7FFFFFFF)
- PARAMETER (MSKA31 = 2147 483 647)
-C-- PARAMETER (IBADCS = Z 7F80FE00)
- PARAMETER (IBADCS = 2139 160 064)
-C-- PARAMETER (IOVPCS = Z 7F800000)
- PARAMETER (IOVPCS = 2139 095 040)
-C-- PARAMETER (IOVNCS = Z FF800000)
- PARAMETER (IOVNCS = -8 388 608)
-
- PARAMETER (M130 = -130 )
- PARAMETER (LVMIN = 30 )
-
- DATA (J1 (II),II=0,15) /
-C
-C II= 0000, 0001, 0010, 0011, 0100, 0101, 0110, 0111,
- + 16, 8, 4, 4, 2, 2, 2, 2,
-C
-C II= 1000, 1001, 1010, 1011, 1100, 1101, 1110, 1111,
- + 1, 1, 1, 1, 1, 1, 1, 1/
-
-
- DATA (J2 (K),K=0,15) /
-C
-C II= 0000, 0001, 0010, 0011, 0100, 0101, 0110, 0111,
- + -4, -3, -2, -2, -1, -1, -1, -1,
-C
-C II= 1000, 1001, 1010, 1011, 1100, 1101, 1110, 1111
- + 0, 0, 0, 0, 0, 0, 0, 0/
-
-
- ISHFTL (IZW,NZB) = ISHFT (IZW, NZB)
- ISHFTR (IZW,NZB) = ISHFT (IZW,-NZB)
-
- JBAD = 0
-
- DO 100 I = 1,NWDO,IS
-#if defined(CERNLIB_QMIBMVF)
- IF (NWDO-I+1.LT.LVMIN) GO TO 336
-C*VDIR: PREFER VECTOR
-
-C---- Vector loop
-
-
- DO 334 JL=I,MIN0(NWDO,I+IS-1)
- JEXP (JL-I+1) = ISHFTR (IAND (MS(JL),MSKA7F),22)
- + + J2 (ISHFTR (IAND (MS(JL),MSKA24),20) )
- INP (JL-I+1) = MS (JL)
- J4B = ISHFTR (IAND (MS(JL),MSKA24),20)
-
- MT (JL) = IOR (IOR
-
-C Shift left IBM mantissa and discards the left-most significant bit
-C (hidden bit)
- + (IAND (MSKA23,IAND (MS(JL),MSKA24)
- + * J1 (J4B)),
-
-C Multiply IBM exponent by 4, add J2, add -130 and shift it
-C back 23 positions left.
- + ISHFTL(JEXP(JL-I+1) + M130,23) )
-
-C Add sign bit
- + ,IAND (MS(JL),NOT(MSKA31)))
- IF (J4B.EQ.0) MT(JL) = 0
- 334 CONTINUE
- GO TO 341
-C*VDIR: PREFER SCALAR ON
-#endif
-C---- Scalar loop
-
- 336 DO 339 JL=I,MIN0(NWDO,I+IS-1)
- JEXP (JL-I+1) = ISHFTR (IAND (MS(JL),MSKA7F),22)
- + + J2 (ISHFTR (IAND (MS(JL),MSKA24),20) )
- INP (JL-I+1) = MS (JL)
- J4B = ISHFTR (IAND (MS(JL),MSKA24),20)
-
- MT (JL) = IOR (IOR
- + (IAND (MSKA23,IAND (MS(JL),MSKA24)
- + * J1 (J4B)),
- + ISHFTL(JEXP(JL-I+1) + M130,23) )
- + ,IAND (MS(JL),NOT(MSKA31)))
- IF (J4B.EQ.0) MT(JL) = 0
-
- 339 CONTINUE
-
-
-C---- Second loop for exceptions handling
-
- 341 DO 349 JL=I,MIN0(NWDO,I+IS-1)
-
-C Stored Exp (IBM) + 130
-
- IF (JEXP(JL-I+1).LE.130) THEN
-
-C Exp (IBM) <= 0
- IF (JEXP(JL-I+1).GT.107) THEN
-
-C Exp (IBM) > - 23.and. <= 0: 'De-normalized number'
- MT(JL) = ISHFTR ( IAND (INP(JL-I+1),MSKA24)
- + * J1 (ISHFTR (IAND (INP(JL-I+1),MSKA24),20)),
- + 131-JEXP(JL-I+1))
- + + IAND (INP(JL-I+1),NOT(MSKA31))
- ELSE
-
-C Exp (IBM) <= -23 : floating point zero/underflow
- MT(JL) = 0
- ENDIF
- ENDIF
-
- IF (JEXP(JL-I+1).GE.385) THEN
-C Exp (IBM) >= 255 : Error conditions, Overflow/NaN
- JBAD = JL
- IF (INP(JL-I+1).NE.IBADMS) THEN
-C Signed infinity
- MT(JL) = IOR (IOVPCS, IAND(INP(JL-I+1),NOT(MSKA31)) )
- ELSE
- MT(JL) = IBADCS
- ENDIF
- ENDIF
- 349 CONTINUE
- 100 CONTINUE
- RETURN
- END
-#ifdef CERNLIB_TCGEN_IE3FOS
-#undef CERNLIB_TCGEN_IE3FOS
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/ie3tod.F b/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/ie3tod.F
deleted file mode 100644
index 0c827ac..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/ie3tod.F
+++ /dev/null
@@ -1,177 +0,0 @@
-*
-* $Id: ie3tod.F,v 1.1.1.1 1996/02/15 17:54:36 mclareni Exp $
-*
-* $Log: ie3tod.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:36 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
-#if defined(CERNLIB_QMIBXVF)
- at PROCESS DIRECTIVE ('*VDIR:') OPT(3) VECTOR
-#endif
- SUBROUTINE IE3TOD (MS,MT,NDPN,JBAD)
-C
-C CERN PROGLIB# M220 IE3TOD .VERSION KERNIBX 1.00 900101
-
-C 02/03/89 M.Roethlisberger/IBM + J.Zoll/CERN Optimise / Vectorise
-C
-C- Convert double precision for input with copy
-C- from source in IEEE to target in native data format
-C-
-C- Reference: ZEBRA REFERENCE MANUAL book FZ, para. 3.03
-C-
-C- IEEE Representation: sccc cccc cccc mmmm mmmm mmmm mmmm mmmm
-C- mmmm mmmm mmmm mmmm mmmm mmmm mmmm mmmm
-C-
-C- IBM Representation: sccc cccc mmmm mmmm mmmm mmmm mmmm mmmm
-C- mmmm mmmm mmmm mmmm mmmm mmmm mmmm mmmm
-
-C- m: Mant (IBM) = (00100000 + Mant (IE3))*J1 (left-shifting)
-
-C- c: Exp (IBM) = (Exp (IE3)-1019+J2)/4 + 64 =
-C- = (Exp (IE3)- 763+J2)/4
-C-
-C- s: Sign (IBM) = Sign (IE3)
-C
-C Where J1 and J2 are both function of the 2 right-most bits
-C of I3E exponent
-C
- DIMENSION MS(99), MT(99)
- DIMENSION J1(0:3) , J2(0:3), J3(0:3)
-
-C PARAMETER (IBADMS = Z 7FFFFFFF)
- PARAMETER (IBADMS = 2147 483 647)
- PARAMETER (JEXMIN = -259, JEXMAX=251)
-C PARAMETER (IOVPMS = Z 7FFFFFF0)
- PARAMETER (IOVPMS = 2147 483 632)
-C PARAMETER (IOVNMS = Z FFFFFFF0)
- PARAMETER (IOVNMS = -16)
-C PARAMETER (MSKA31 = Z 7FFFFFFF)
- PARAMETER (MSKA31 = 2147 483 647)
-C PARAMETER (MSKA20 = Z 000FFFFF)
- PARAMETER (MSKA20 = 1 048 575)
-C PARAMETER (MSKB21 = Z 00100000)
- PARAMETER (MSKB21 = 1 048 576)
-C PARAMETER (MSK7FF = Z 7FF00000)
- PARAMETER (MSK7FF = 2146 435 072)
-C PARAMETER (MSKC7F = Z 7F000000)
- PARAMETER (MSKC7F = 2130 706 432)
-C PARAMETER (MSKC03 = Z 00300000)
- PARAMETER (MSKC03 = 3 145 728)
- PARAMETER (IBADMD = IBADMS, IBADME = 0)
- PARAMETER (IOVPMD = IOVPMS, IOVNMD = IOVNMS)
- PARAMETER (M763SH = -800 063 488 )
-
- PARAMETER (LVMIN = 41 )
-
-
- DATA (J1 (II),II=0,3) /
- + 2, 4, 8, 1/
-
- DATA (J2 (II),II=0,3) /
-
-C Respectively -1, -2, -3 and 0 but 20 positions left-shifted
-C FFF00000, FFE00000, FFD00000, 00000000
- + -1 048 576, -2 097 152, -3 145 728, 0/
-
- DATA (J3 (II),II=0,3) /
- + 4, 2, 1, 8/
-
-#include "q_andor.inc"
-#include "q_shift.inc"
-
- JBAD = 0
- NLOOP = 2*NDPN
-
-#if defined(CERNLIB_QMIBXVF)
- IF (NDPN.LT.LVMIN) GO TO 336
-C*VDIR: PREFER VECTOR
-
-C---- Vector loop
-
- DO 334 JL=1,NLOOP,2
-
-C Stores the 2 right-most bits of I3E exponent
- JMOST = ISHFTR (IAND (MS(JL),MSKC03),20)
-
-C Stores IBM exponent
- JXP = IAND (ISHFTL ((IAND (MS(JL), MSK7FF)
- + + J2(JMOST) + M763SH),2) ,MSKC7F)
-
-C Stores IBM left part of mantissa
- JMAN = (IOR(IAND (MS(JL),MSKA20),MSKB21))* J1(JMOST)
-
-C Stores lost bits due to left-shifting of mantissa
- LOST = ISHFTR (MS(JL+1),29)/J3(JMOST)
-
-C Concatenates lost bits, left part of mantissa, exponent, and sign
- MT(JL) = IOR (IOR (IOR (LOST,JMAN),JXP),
- + IAND (MS(JL),NOT(MSKA31)) )
-
-C Shift left the right part of IBM mantissa
- MT(JL+1) = (MS(JL+1)*J1(JMOST))
- 334 CONTINUE
- GO TO 341
-C*VDIR: PREFER SCALAR ON
-#endif
-C---- Scalar loop
-
- 336 DO 339 JL=1,NLOOP,2
- JMOST = ISHFTR (IAND (MS(JL),MSKC03),20)
- JXP = IAND (ISHFTL ((IAND (MS(JL), MSK7FF)
- + + J2(JMOST) + M763SH),2) ,MSKC7F)
- JMAN = (IOR(IAND (MS(JL),MSKA20),MSKB21))* J1(JMOST)
- LOST = ISHFTR (MS(JL+1),29)/J3(JMOST)
- MT(JL) = IOR (IOR (IOR (LOST,JMAN),JXP),
- + IAND (MS(JL),NOT(MSKA31)) )
- MT(JL+1) = (MS(JL+1)*J1(JMOST))
- 339 CONTINUE
-
-C---- Second loop for exceptions handling
-
- 341 DO 349 JL=1,NLOOP,2
-
- IF (MS(JL).EQ.0) THEN
-C Floating Point zero
- MT(JL) = 0
- MT(JL+1) = 0
- GOTO 349
- ENDIF
-
-C Stored Exp (I3E) - 1023
- JEXP = ISHFTR (IAND(MS(JL), MSK7FF), 20)-1023
- IF (JEXP.LT.JEXMIN) THEN
-C Underflow
- MT(JL) = 0
- MT(JL+1) = 0
- GOTO 349
- ENDIF
-
- IF (JEXP.GT.JEXMAX) THEN
-C Error conditions
- JBAD = (JL+1) / 2
- IF (JEXP.NE.1024) THEN
-C Exp > 251 : Signed infinity
- MT(JL) = IOR (IOVPMD, IAND(MS(JL),NOT(MSKA31)) )
- MT(JL+1) = 0
- GO TO 349
- ENDIF
-
- IF (IAND(MS(JL),MSKA20).EQ.0) THEN
-C Exp = 1024 ; Mant = 0 : Signed infinity
- MT(JL) = IOR (IOVPMD, IAND(MS(JL),NOT(MSKA31)) )
- MT(JL+1) = 0
- ELSE
-C Exp = 1024 ; mant ~= 0 : Not a number (NaN)
- MT(JL) = IBADMD
- MT(JL+1) = 0
- ENDIF
- ENDIF
- 349 CONTINUE
- RETURN
- END
-#ifdef CERNLIB_TCGEN_IE3TOD
-#undef CERNLIB_TCGEN_IE3TOD
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/ie3tos.F b/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/ie3tos.F
deleted file mode 100644
index 696e341..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/ie3tos.F
+++ /dev/null
@@ -1,150 +0,0 @@
-*
-* $Id: ie3tos.F,v 1.1.1.1 1996/02/15 17:54:36 mclareni Exp $
-*
-* $Log: ie3tos.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:36 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
-#if defined(CERNLIB_QMIBXVF)
- at PROCESS DIRECTIVE ('*VDIR:') OPT(3) VECTOR
-#endif
- SUBROUTINE IE3TOS (MS,MT,NWDO,JBAD)
-C
-C CERN PROGLIB# M220 IE3TOS .VERSION KERNIBX 1.00 900101
-C
-C 02/03/89 M.Roethlisberger/IBM + J.Zoll/CERN Optimise / Vectorise
-
-C- Convert single precision for input with copy
-C- from source in IEEE to target in native data format
-C-
-C- Reference: ZEBRA REFERENCE MANUAL book FZ, para. 3.03
-C-
-C- IEEE Representation: sccc cccc cmmm mmmm mmmm mmmm mmmm mmmm
-C- IBM Representation: sccc cccc mmmm mmmm mmmm mmmm mmmm mmmm
-C-
-C- m: Mant (IBM) = (00800000+ Mant (IE3))/J1 (Right-shifting)
-
-C- c: Exp (IBM) = (Exp (IE3)-126+J2)/4 + 64 =
-C- = (Exp (IE3)+130+J2)/4
-C-
-C- s: Sign (IBM) = Sign (IE3)
-C
-C Where J1 and J2 are both function of the 2 right-most bits
-C of I3E exponent.
-
- DIMENSION MS (99) , MT (99)
- DIMENSION J1 (0:3) , J2 (0:3)
-
- EQUIVALENCE (ITHA , THA)
-
-C PARAMETER (MSKA31 = Z 7FFFFFFF)
- PARAMETER (MSKA31 = 2147 483 647)
-C PARAMETER (MSKA7F = Z 7F000003)
- PARAMETER (MSKA7F = 2130 706 432)
-C PARAMETER (MSKA23 = Z 007FFFFF)
- PARAMETER (MSKA23 = 8 388 607)
-C PARAMETER (MSKB24 = Z 00800000)
- PARAMETER (MSKB24 = 8 388 608)
-C PARAMETER (MSKC18 = Z 01800000)
- PARAMETER (MSKC18 = 25 165 864)
-C PARAMETER (IBADMS = Z 7FFFFFFF)
- PARAMETER (IBADMS = 2147 483 647)
-C PARAMETER (IOVPMS = Z 7FFFFFF0)
- PARAMETER (IOVPMS = 2147 483 632)
-C PARAMETER (IOVNMS = Z FFFFFFF0)
- PARAMETER (IOVNMS = -16)
-
- PARAMETER (LVMIN = 44)
-
-
- DATA (J1 (II),II=0,3) /
- + 4, 2, 1, 8/
-
- DATA (J2 (II),II=0,3) /
-
-C- Respectively 2, 1, 0 and 3 but 22 positions left-shifted.
-C- 00800000, 00400000, 00000000, 00C00000
- + 8 388 608, 4 194 304, 0, 12 582 912/
-
-#include "q_andor.inc"
-#include "q_shift.inc"
-
- JBAD = 0
-
-#if defined(CERNLIB_QMIBXVF)
- IF (NWDO.LT.LVMIN) GO TO 336
-C*VDIR: PREFER VECTOR
-
-C---- Vector loop
-
- DO 334 JL=1,NWDO
- MT(JL) = IOR( IOR(
-
-C Add 1 bit in front of I3E mantissa, shift it right (0-3 positions)
- + IOR (IAND(MS(JL),MSKA23),MSKB24)
- + /J1(ISHFTR(IAND(MS(JL),MSKC18),23))
-
-C Shift I3E exponent 1 position to right, add 20800000 (130 22 positions
-C left-shifted), add J2 (also shifted) and discard all non-IBM exponents
-C bits (i.e. /4)
- + ,IAND(ISHFTR (ISHFTL(MS(JL),1),2) + 545 259 520
- + +J2(ISHFTR(IAND(MS(JL),MSKC18),23)),MSKA7F))
-C Add sign bit
- + ,IAND (MS(JL),NOT(MSKA31)) )
- 334 CONTINUE
- GO TO 341
-C*VDIR: PREFER SCALAR ON
-#endif
-C---- Scalar loop
-
- 336 DO 339 JL=1,NWDO
- MT(JL) = IOR( IOR(
- + IOR (IAND(MS(JL),MSKA23),MSKB24)
- + /J1(ISHFTR(IAND(MS(JL),MSKC18),23))
- + ,IAND(ISHFTR (ISHFTL(MS(JL),1),2) + 545 259 520
- + +J2(ISHFTR(IAND(MS(JL),MSKC18),23)),MSKA7F))
- + ,IAND (MS(JL),NOT(MSKA31)) )
- 339 CONTINUE
-
-C---- Second loop for exceptions handling
-
- 341 DO 349 JL=1,NWDO
-
-C Stored Exp (I3E)
- JEXP3 = ISHFTR (ISHFTL(MS(JL),1),24)
- IF (JEXP3.EQ.0) THEN
- JMAN3 = IAND (MS(JL), MSKA23)
- IF (JMAN3.EQ.0) THEN
-C Exp=0 ; Mant=0 : Floating-point zero
- MT(JL)=0
- ELSE
-
-C Exp=0 ; Mant ~= 0 : De-normalized number
- THA = FLOAT(JMAN3) * 2.**(-63)
- THA = THA * 2.**(-86)
- IF (IAND (MS(JL),NOT(MSKA31)).NE.0) THA=-THA
- MT(JL)=ITHA
- ENDIF
- ENDIF
-
- IF (JEXP3.EQ.255) THEN
-C Error conditions
- JBAD = JL
- JMAN3 = IAND (MS(JL), MSKA23)
- IF (JMAN3.EQ.0) THEN
-C Exp=255 ; Mant = 0 : Signed infinity
- MT(JL) = IOR (IOVPMS, IAND(MS(JL),NOT(MSKA31)) )
- ELSE
-C Exp = 255 ; Mant ~= 0 : Not a Number (NaN)
- MT(JL) = IBADMS
- ENDIF
- ENDIF
- 349 CONTINUE
- RETURN
- END
-#ifdef CERNLIB_TCGEN_IE3TOS
-#undef CERNLIB_TCGEN_IE3TOS
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/incbyt.s b/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/incbyt.s
deleted file mode 100644
index 48a872d..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/incbyt.s
+++ /dev/null
@@ -1,58 +0,0 @@
-*
-* $Id: incbyt.s,v 1.1.1.1 1996/02/15 17:54:37 mclareni Exp $
-*
-* $Log: incbyt.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:37 mclareni
-* Kernlib
-*
-*
-INCBYT CSECT
-*
-* CERN PROGLIB# M423 INCBYT .VERSION KERNIBX 1.01 900523
-*
-* CODED FOR FAST EXECUTION H.WATKINS,LIVERPOOL JULY 1974
-* Modified for AIX, Roger Howard, January 1990
- USING *,15
- ENTRY _incbyt_
-_incbyt_ STM 2,9,16(13)
- LR 4,3 AIX: address of arg4 = MPACK
- L 7,0(,2) AIX: value of arg3 = JX
- LR 2,1 AIX: address of arg2 = X
- LR 1,0
- L 1,0(1) AIX: value of arg1 = INC
- SR 0,0
- L 3,0(4) R3=NBITS
- LR 9,7 R9=JX
- BCTR 7,0 R7=JX-1
- SR 6,6
- D 6,4(4) R7=JWORD-1
- LR 5,7
- SLL 5,2
- SR 6,6
- M 6,4(4) R7=(JWORD-1)*INWORD
- SR 9,7 R9=JPOS
- SR 8,8
- MR 8,3
- L 6,0(2,5) R6=X(JWORD)
- SRDL 6,0(9)
- SR 6,6
- SLDL 6,0(3)
- LR 7,6
- ALR 6,1
- C 6,8(4)
- BH OVFL
-GOBACK SR 9,3
- SLL 1,0(9)
- AL 1,0(2,5)
- ST 1,0(2,5)
-RETURN LM 2,9,16(13)
- BR 14
-OVFL S 6,8(4)
- LR 0,6
- L 1,8(4)
- SR 1,7
- B GOBACK
- END
-#ifdef CERNLIB_TCGEN_INCBYT
-#undef CERNLIB_TCGEN_INCBYT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/intarg.s b/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/intarg.s
deleted file mode 100644
index 944d734..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/intarg.s
+++ /dev/null
@@ -1,85 +0,0 @@
-*
-* $Id: intarg.s,v 1.1.1.1 1996/02/15 17:54:37 mclareni Exp $
-*
-* $Log: intarg.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:37 mclareni
-* Kernlib
-*
-*
-INTARG CSECT
-*
-* CERN PROGLIB# M250 INTARG .VERSION KERNIBX 1.01 900523
-*
-* R. MATTHEWS, CERN/DD, AUGUST 1983.
-* Modified for AIX, Roger Howard, January 1990
-*
-R0 EQU 0
-R1 EQU 1
-R2 EQU 2
-R3 EQU 3
-R4 EQU 4
-R5 EQU 5
-R6 EQU 6
-R7 EQU 7
-R8 EQU 8
-R9 EQU 9
-R10 EQU 10
-R11 EQU 11
-R12 EQU 12
-R13 EQU 13
-R14 EQU 14
-R15 EQU 15
-*
-F0 EQU 0
-F2 EQU 2
-F4 EQU 4
-F6 EQU 6
-*
- USING *,R15
- ENTRY _intarg_
-_intarg_ STM R2,R1,16(R13)
- LR R4,R13
- USING STACK,R13
- S R13,=A(STEND-STACK) ... added for AIX
- ST R4,4(0,R13)
- LR 2,0 R2 -> ARGUMENT
- L R0,0(0,R2) R0 := ARGUMENT
- TM 0(R2),X'80' IS THE SIGN BIT ON ?
- BO NEGATIVE YES, BRANCH
-*
- TM 0(R2),X'7F' IS THE ARGUMENT INTEGER ?
- BZ EPILOGUE PROBABLY, RETURN
-*
- SDR F0,F0 CLEAR THE LOW-ORDER PART OF F0
- LE F0,0(0,R2) F0 := ARGUMENT
- AW F0,=X'4E00000000000000' SHIFT OUT THE FRACTIONAL PART
- STD F0,136(0,R13) STORE THE RESULT
- L R0,140(0,R13) R0 := INTEGER PART
- B EPILOGUE RETURN
-*
-NEGATIVE TM 0(R2),X'7F' IS THE ARGUMENT INTEGER ?
- BO EPILOGUE PROBABLY, RETURN
-*
- SDR F0,F0 CLEAR THE LOW-ORDER PART OF F0
- LE F0,0(0,R2) F0 := ARGUMENT
- AW F0,=X'4E00000000000000' SHIFT OUT THE FRACTIONAL PART
- STD F0,136(0,R13) STORE THE RESULT
- L R0,140(0,R13) R0 := INTEGER PART
- LNR R0,R0 NEGATE IT
-EPILOGUE L R13,4(0,R13)
- LM R2,R12,16(R13)
- BR R14
- LTORG
-*
-* D A T A A R E A S
-*
-STACK DSECT
-SAVEAREA DS 18F
-AIXOUT DS 4F
-LINKR23 DS 2F
-FPNUM DS D
-STEND DS D
- END
-#ifdef CERNLIB_TCGEN_INTARG
-#undef CERNLIB_TCGEN_INTARG
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/iubin.s b/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/iubin.s
deleted file mode 100644
index 44c5b06..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/iubin.s
+++ /dev/null
@@ -1,68 +0,0 @@
-*
-* $Id: iubin.s,v 1.1.1.1 1996/02/15 17:54:37 mclareni Exp $
-*
-* $Log: iubin.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:37 mclareni
-* Kernlib
-*
-*
-IUBIN CSECT
-*
-* CERN PROGLIB# Y202 IUBIN .VERSION KERNIBX 1.01 900523
-*
-* CODED FOR FAST EXECUTION H.WATKINS,LIVERPOOL JULY 1974
-* MODIFIED FOR EPSILON A.BERGLUND, 5-FEB-79
-* Modified for AIX, Roger Howard, January 1990
- USING *,15
- ENTRY _iubin_
-_iubin_ STM 2,5,16(13)
- LR 4,13 ... added for AIX
- USING STACK,13
- S 13,=A(STEND-STACK) ... added for AIX
- ST 4,4(0,13) ... added for AIX
- LR 3,2 AIX: address of arg3 = SPILL
- LR 2,1 AIX: address of arg2 = PAR
- LR 1,0 AIX: address of arg1 = X
- SR 4,4 R4=FALSE
- SDR 0,0
- LE 0,0(1)
- SE 0,8(2)
- DE 0,4(2) F0=(X-XLOW)/DX
- AE 0,ONEPE ADD 1. + EPSILON
- CE 0,ONE
- BL UNDFL
- CE 0,MAXNUM
- BNH OK
- LE 0,MAXNUM
-OK L 5,0(2)
- LA 5,1(5) R5=NX+1
- AW 0,FOURE
- STD 0,TWO
- L 0,TWO+4 R0=F0 IN INTEGER FORM
- CR 0,5
- BNM OVFL
- B RET
-UNDFL SR 5,5
-OVFL LR 0,5
-RET1 LA 4,1(4)
-RET ST 4,0(3) R4=TRUE
- L 13,4(0,13) ... added for AIX
- LM 2,5,16(13)
- BR 14
- DS 0D
-FOURE DC X'4E000000'
- DC F'0'
-ONE DC X'41100000'
-ONEPE DC E'1.00001' 1. + EPSILON
-MAXNUM DC X'487FFFFF'
- LTORG
-STACK DSECT
-SAVEAREA DS 18F
-AIXOUT DS 4F
-LINKR23 DS 2F
-TWO DS D
-STEND DS 0D
- END
-#ifdef CERNLIB_TCGEN_IUBIN
-#undef CERNLIB_TCGEN_IUBIN
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/iuchan.s b/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/iuchan.s
deleted file mode 100644
index c256d14..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/iuchan.s
+++ /dev/null
@@ -1,67 +0,0 @@
-*
-* $Id: iuchan.s,v 1.1.1.1 1996/02/15 17:54:37 mclareni Exp $
-*
-* $Log: iuchan.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:37 mclareni
-* Kernlib
-*
-*
-IUCHAN CSECT
-*
-* CERN PROGLIB# Y201 IUCHAN .VERSION KERNIBX 1.01 900523
-*
-* CODE OF IUBIN ADAPTED FOR IUCHAN A.BERGLUND, 5-FEB-79
-* Modified for AIX, Roger Howard, January 1990
- USING *,15
- ENTRY _iuchan_
-_iuchan_ STM 2,5,16(13)
- LR 4,13 ... added for AIX
- USING STACK,13
- S 13,=A(STEND-STACK) ... added for AIX
- ST 4,4(13) ... added for AIX
- LR 4,3 AIX: address of arg4 = NX
- LR 3,2 AIX: address of arg3 = DX
- LR 2,1 AIX: address of arg2 = XLOW
- LR 1,0 AIX: address of arg1 = X
- SDR 0,0
- LE 0,0(1)
- SE 0,0(2)
- DE 0,0(3) F0=(X-XLOW)/DX
- AE 0,ONEPE ADD ONE PLUS EPSILON
- CE 0,ONE
- BL UNDFL
- CE 0,MAXNUM
- BNH OK
- LE 0,MAXNUM
-OK L 5,0(4)
- LA 5,1(5) R5=NX+1
- AW 0,FOURE
- STD 0,TWO
- L 0,TWO+4 R0=F0 IN INTEGER FORM
- CR 0,5
- BNM OVFL
- B RET
-UNDFL SR 5,5
-OVFL LR 0,5
-RET1 EQU *
-RET EQU *
- L 13,4(0,13) ... added for AIX
- LM 2,5,16(13)
- BR 14
- DS 0D
-FOURE DC X'4E000000'
- DC F'0'
-ONE DC X'41100000'
-ONEPE DC E'1.00001' 1. + EPSILON
-MAXNUM DC X'487FFFFF'
- LTORG
-STACK DSECT
-SAVEAREA DS 18F
-AIXOUT DS 4F
-LINKR23 DS 2F
-TWO DS D
-STEND DS 0D
- END
-#ifdef CERNLIB_TCGEN_IUCHAN
-#undef CERNLIB_TCGEN_IUCHAN
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/iucomp.s b/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/iucomp.s
deleted file mode 100644
index dff4d9d..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/iucomp.s
+++ /dev/null
@@ -1,43 +0,0 @@
-*
-* $Id: iucomp.s,v 1.1.1.1 1996/02/15 17:54:37 mclareni Exp $
-*
-* $Log: iucomp.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:37 mclareni
-* Kernlib
-*
-*
-IUCOMP CSECT
-*
-* CERN PROGLIB# V304 IUCOMP .VERSION KERNIBX 1.01 900524
-*
-* CODED FOR FAST EXECUTION H.WATKINS,LIVERPOOL JULY 1974
-* Modified for AIX, Roger Howard, January 1990
- USING *,15
- ENTRY _iucomp_
-_iucomp_ STM 2,6,16(13)
- L 3,0(,2) AIX: value of arg3 = N
- LR 2,1 AIX: address of arg2 = IVEC
- LR 1,0 AIX: address of arg1 = IT
- LTR 3,3
- BNP ZERO
- L 1,0(1) R1=IT
- LA 4,4(0) R4=4
- LR 6,2 SAVE ADDRESS OF IVEC
- SLL 3,2
- SR 3,4
- LA 5,0(3,2) R5->IVEC(N)
-LOOP C 1,0(2)
- BE FOUND
- BXLE 2,4,LOOP
-ZERO SR 0,0
-RET LM 2,6,16(13)
- BR 14
-FOUND SR 2,6
- SRL 2,2
- LA 2,1(2)
- LR 0,2
- B RET
- END
-#ifdef CERNLIB_TCGEN_IUCOMP
-#undef CERNLIB_TCGEN_IUCOMP
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/iufind.s b/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/iufind.s
deleted file mode 100644
index fb7fca6..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/iufind.s
+++ /dev/null
@@ -1,47 +0,0 @@
-*
-* $Id: iufind.s,v 1.1.1.1 1996/02/15 17:54:37 mclareni Exp $
-*
-* $Log: iufind.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:37 mclareni
-* Kernlib
-*
-*
-IUFIND CSECT
-*
-* CERN PROGLIB# V304 IUFIND .VERSION KERNIBX 1.01 900524
-*
-* CODED FOR FAST EXECUTION H.WATKINS,LIVERPOOL JULY 1974
-* Modified for AIX, Roger Howard, January 1990
- USING *,15
- ENTRY _iufind_
-_iufind_ STM 2,6,16(13)
- L 4,0(,3) AIX: value of arg4 = JR
- L 3,0(,2) AIX: value of arg3 = JL
- LR 2,1 AIX: address of arg2 = IVEC
- LR 1,0 AIX: address of arg1 = IT
- LA 0,1(4) R0=JR+1
- BCTR 4,0
- SLL 4,2 R4=4*(JR-1)
- LA 5,0(4,2)
- LR 6,2 SAVE ADDRESS OF IVEC
- BCTR 3,0
- SLL 3,2 R3=4*(JL-1)
- LA 2,0(2,3) R2->IVEC(JL)
- SR 4,3
- BM RET
- L 1,0(1)
- LA 4,4
-LOOP C 1,0(2)
- BE FOUND
- BXLE 2,4,LOOP
-RET LM 2,6,16(13)
- BR 14
-FOUND SR 2,6
- SRL 2,2
- LA 2,1(2)
- LR 0,2
- B RET
- END
-#ifdef CERNLIB_TCGEN_IUFIND
-#undef CERNLIB_TCGEN_IUFIND
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/iulast.s b/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/iulast.s
deleted file mode 100644
index b84066c..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/iulast.s
+++ /dev/null
@@ -1,35 +0,0 @@
-*
-* $Id: iulast.s,v 1.1.1.1 1996/02/15 17:54:37 mclareni Exp $
-*
-* $Log: iulast.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:37 mclareni
-* Kernlib
-*
-*
-IULAST CSECT
-*
-* CERN PROGLIB# V305 IULAST .VERSION KERNIBX 1.01 900524
-*
- USING *,15
- ENTRY _iulast_
-_iulast_ STM 2,8,16(13)
- L 5,0(,2) AIX: value of arg2
- LR 2,0 AIX: address of arg1
- L 2,0(2)
- SR 4,4
- LTR 6,5
- BZ ST20
- LA 7,4
- MR 4,7
-ST12 SR 5,7
- L 8,0(1,5) AIX: arg2 address in GR1
- CR 2,8
- BNE ST20
- BCT 6,ST12
-ST20 LR 0,6
- LM 2,8,16(13)
- BCR 15,14
- END
-#ifdef CERNLIB_TCGEN_IULAST
-#undef CERNLIB_TCGEN_IULAST
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/iulook.s b/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/iulook.s
deleted file mode 100644
index 6824b98..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/iulook.s
+++ /dev/null
@@ -1,87 +0,0 @@
-*
-* $Id: iulook.s,v 1.1.1.1 1996/02/15 17:54:37 mclareni Exp $
-*
-* $Log: iulook.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:37 mclareni
-* Kernlib
-*
-*
-IULOOK CSECT
-*
-* CERN PROGLIB# M410 IULOOK .VERSION KERNIBX 1.01 900524
-*
- USING *,15
- ENTRY _iulook_
-_iulook_ STM 2,1,16(13)
- LR 6,13
- USING STACK,13
- S 13,=A(STEND-STACK)
- ST 6,4(13)
- LR 5,3 AIX: address of arg4
- LR 4,2 AIX: address of arg3
- LR 3,1 AIX: address of arg2
- LR 2,0 AIX: address of arg1
- L 14,=A(DATA)
- USING DATA,14
- L 12,ERSTARG
- L 11,BLANKS
- ST 11,0(12)
- L 7,0(4)
- L 5,0(5)
- LA 10,1
- SR 4,4
- SR 6,6
- LA 8,4
- MR 6,8 R7=JL
- MR 4,8 R5=JR
- L 2,0(2)
- SR 3,8
- SR 4,4 R4=I
- SR 6,6 R6=I*4
-ST20 L 9,0(3,7)
- CR 9,11
- BE ST24
- CR 4,2
- BNL ST29
- AR 4,10
- ST 9,0(12,6)
- AR 6,8
-ST24 AR 7,8
- CR 7,5
- BNH ST20
-ST29 SR 6,6
- CR 6,4
- BNE SKIP
- LR 4,10
-SKIP ST 4,I
- STM 14,15,MYREGS Save segment registers
- LM 0,3,ERSTARG
- L 15,=V(_ubunch_)
- BALR 14,15
- LM 14,15,MYREGS Restore segment registers
- L 0,RESULT
- L 13,4(13)
- LM 2,14,16(13)
- BCR 15,14
- LTORG
-DATA PSECT
- DS 0F
-ERSTARG DC V(_slate_)
- DC AL4(RESULT)
- DC AL4(I)
- DC F'-1'
-I DS 1F
-BLANKS DC CL4' '
-RESULT DS 1F
-STACK DSECT
-SAVEAREA DS 18F
-AIXOUT DS 4F
-LINKR23 DS 2F
-MYREGS DS 2F
-STEND DS 0F
-SLATE DSECT
- DS 40F
- END
-#ifdef CERNLIB_TCGEN_IULOOK
-#undef CERNLIB_TCGEN_IULOOK
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/iunext.s b/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/iunext.s
deleted file mode 100644
index 4ac54f9..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/iunext.s
+++ /dev/null
@@ -1,39 +0,0 @@
-*
-* $Id: iunext.s,v 1.1.1.1 1996/02/15 17:54:37 mclareni Exp $
-*
-* $Log: iunext.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:37 mclareni
-* Kernlib
-*
-*
-IUNEXT CSECT
-*
-* CERN PROGLIB# M410 IUNEXT .VERSION KERNIBX 1.01 900524
-*
- USING *,15
- ENTRY _iunext_
-_iunext_ STM 2,7,16(13)
- LR 2,0 AIX: address of arg1
- L 7,0(,1) AIX: value of arg2
- LR 3,7
- LA 4,4
- LA 1,1
- SR 6,6
- MR 6,4
- SR 2,4
- L 5,BLANKS
-ST10 L 6,0(2,7)
- CR 5,6
- BNE ST12
- AR 7,4
- AR 3,1
- B ST10
-ST12 LR 0,3
- LM 2,7,16(13)
- BCR 15,14
- CNOP 0,4
-BLANKS DC CL4' '
- END
-#ifdef CERNLIB_TCGEN_IUNEXT
-#undef CERNLIB_TCGEN_IUNEXT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/iusame.s b/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/iusame.s
deleted file mode 100644
index 1666887..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/iusame.s
+++ /dev/null
@@ -1,50 +0,0 @@
-*
-* $Id: iusame.s,v 1.1.1.1 1996/02/15 17:54:39 mclareni Exp $
-*
-* $Log: iusame.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:39 mclareni
-* Kernlib
-*
-*
-IUSAME CSECT
-*
-* CERN PROGLIB# M501 IUSAME .VERSION KERNIBX 1.01 900524
-*
- USING *,15
- ENTRY _iusame_
-_iusame_ STM 2,9,16(13)
- L 6,88(,13) AIX: address of arg5=JSAME
- L 5,0(,3) AIX: value of arg4=MIN
- L 4,0(,2) AIX: value of arg3=N
- L 3,0(,1) AIX: value of arg2=JST
- LR 2,0 AIX: address of arg1=IA
- BCTR 3,0
- SLA 3,2
- BCTR 4,0
- SLA 4,2
-ZWEI1 SR 8,8
- LR 9,3
-ZWEI4 LA 8,1(8)
- CR 3,4
- BE DREI1
- L 7,0(3,2)
- LA 3,4(3)
- C 7,0(3,2)
- BE ZWEI4
- CR 8,5
- BL ZWEI1
- B DREI2
-DREI1 CR 8,5
- BNL DREI2
- SR 8,8
- LA 9,4(4)
-DREI2 LR 0,8
- SRA 9,2
- LA 9,1(9)
- ST 9,0(6)
- LM 2,9,16(13)
- BCR 15,14
- END
-#ifdef CERNLIB_TCGEN_IUSAME
-#undef CERNLIB_TCGEN_IUSAME
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/jbit.s b/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/jbit.s
deleted file mode 100644
index 9495f46..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/jbit.s
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: jbit.s,v 1.1.1.1 1996/02/15 17:54:39 mclareni Exp $
-*
-* $Log: jbit.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:39 mclareni
-* Kernlib
-*
-*
-JBIT CSECT
-*
-* CERN PROGLIB# M421 JBIT .VERSION KERNIBX 1.01 900524
-*
-* CODED FOR FAST EXECUTION H.WATKINS,LIVERPOOL JULY 1974
-* Modified for AIX, Roger Howard, January 1990
- USING *,15
- ENTRY _jbit_
-_jbit_ ST 2,16(,13)
- LR 2,0 AIX: address of arg1
- L 0,0(,2) AIX: value of arg1 = A
- L 2,0(,1) AIX: value of arg2 = LA
- SRDL 0,0(2) SHIFT SO THAT LA TH BIT IS AT
- SR 0,0 FAR LEFT OF R1
- SLDL 0,1
- L 2,16(,13)
- BR 14
- END
-#ifdef CERNLIB_TCGEN_JBIT
-#undef CERNLIB_TCGEN_JBIT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/jbyt.s b/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/jbyt.s
deleted file mode 100644
index 0ec29ec..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/jbyt.s
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: jbyt.s,v 1.1.1.1 1996/02/15 17:54:39 mclareni Exp $
-*
-* $Log: jbyt.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:39 mclareni
-* Kernlib
-*
-*
-JBYT CSECT
-*
-* CERN PROGLIB# M421 JBYT .VERSION KERNIBX 1.01 900524
-*
-* CODED FOR FAST EXECUTION H.WATKINS,LIVERPOOL JULY 1974
-* Modified for AIX, Roger Howard, January 1990
- USING *,15
- ENTRY _jbyt_
-_jbyt_ STM 2,3,16(13)
- LR 3,0 AIX: address of arg1
- L 0,0(,3) AIX: value of arg1 = A
- L 3,0(,2) AIX: value of arg3 = NBITS
- L 2,0(,1) AIX: value of arg2 = LA
- AR 2,3 LA+NBITS
- SRDL 0,63(2) MOVE LA+NBITS-1 INTO R1
- SR 0,0
- SLDL 0,0(3) MOVE NBITS BACK INTO R0
- LM 2,3,16(13)
- BR 14
- END
-#ifdef CERNLIB_TCGEN_JBYT
-#undef CERNLIB_TCGEN_JBYT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/jbytet.s b/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/jbytet.s
deleted file mode 100644
index 446a9a3..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/jbytet.s
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: jbytet.s,v 1.1.1.1 1996/02/15 17:54:40 mclareni Exp $
-*
-* $Log: jbytet.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:40 mclareni
-* Kernlib
-*
-*
-JBYTET CSECT
-*
-* CERN PROGLIB# M421 JBYTET .VERSION KERNIBX 1.01 900524
-*
- USING *,15
- ENTRY _jbytet_
-_jbytet_ STM 2,4,16(13)
- LR 4,0 AIX: address or arg1
- L 0,0(,4) AIX: value of arg1
- L 1,0(,1) AIX: value of arg2
- L 2,0(,2) AIX: value of arg3
- L 3,0(,3) AIX: value of arg4
- BCTR 2,0
- SRL 1,0(2)
- LA 4,32
- SR 4,3
- SLL 0,0(4)
- SRL 0,0(4)
- NR 0,1
- LM 2,4,16(13)
- BCR 15,14
- END
-#ifdef CERNLIB_TCGEN_JBYTET
-#undef CERNLIB_TCGEN_JBYTET
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/kerngt.F b/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/kerngt.F
deleted file mode 100644
index a408cf5..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/kerngt.F
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: kerngt.F,v 1.1.1.1 1996/02/15 17:54:35 mclareni Exp $
-*
-* $Log: kerngt.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:35 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE KERNGT (LUN)
-C
-C CERN PROGLIB# Z001 KERNGT .VERSION KERNIBX 1.04 910718
-C ORIG. 16/03/89 JZ
-C
-C-- Store Pam title into /SLATE/ for printing by GSHOWF
-C
- COMMON /SLATE/ MCH(40)
-
-
- CALL UCTOH1 (
- + CPP_TITLE_CH
- + // ' '
- +, MCH, 40)
- CALL GSHOWF (LUN)
- RETURN
- END
-#ifdef CERNLIB_TCGEN_KERNGT
-#undef CERNLIB_TCGEN_KERNGT
-#endif
-#include "TITLE.kernibx"
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/lenocc.c b/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/lenocc.c
deleted file mode 100644
index 4517c98..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/lenocc.c
+++ /dev/null
@@ -1,64 +0,0 @@
-/*
- * $Id: lenocc.c,v 1.1.1.1 1996/02/15 17:54:40 mclareni Exp $
- *
- * $Log: lenocc.c,v $
- * Revision 1.1.1.1 1996/02/15 17:54:40 mclareni
- * Kernlib
- *
- */
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
-/*> ROUTINE LENOCC
- CERN PROGLIB# M507 LENOCC .VERSION KERNIBX 1.05 920511
- ORIG. 30/04/92, RDM + JZ
-
- N = LENOCC (CHLINE) find last non-blank character in CHLINE
-*/
- int lenocc_(chline, lenpar)
- char *chline;
- int *lenpar;
-{
- static unsigned int blnk = 0x20202020;
- unsigned int *wdcur;
- char *chcur;
- int ntail, i;
- int len;
-
- len = *lenpar;
- chcur = chline + len;
- if (len <= 24) goto small;
-
-/* ---- handle long string */
-
-/* look at the last ntail characters */
-
- ntail = ((int)chcur & 3);
- for (i = ntail; i > 0; i--)
- { if (*--chcur != ' ') goto exit; }
-
-/* look for trailing blank words */
-
- wdcur = (unsigned int*) (chcur-4);
- while (wdcur >= (unsigned int*)chline )
- { if (*wdcur != blnk) break; wdcur--; }
-
-/* find last non-blank character */
-
- chcur = (char*) (wdcur+1);
- while (chcur > chline)
- { if (*--chcur != ' ') goto exit; }
- return 0;
-
-exit: return chcur+1 - chline;
-
-/* ---- handle short string */
-
-small:
- while (chcur > chline)
- { if (*--chcur != ' ') goto exit; }
- return 0;
-}
-/*> END <----------------------------------------------------------*/
-#ifdef CERNLIB_TCGEN_LENOCC
-#undef CERNLIB_TCGEN_LENOCC
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/lnblnk.c b/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/lnblnk.c
deleted file mode 100644
index 6d0a550..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/lnblnk.c
+++ /dev/null
@@ -1,64 +0,0 @@
-/*
- * $Id: lnblnk.c,v 1.1.1.1 1996/02/15 17:54:40 mclareni Exp $
- *
- * $Log: lnblnk.c,v $
- * Revision 1.1.1.1 1996/02/15 17:54:40 mclareni
- * Kernlib
- *
- */
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
-/*> ROUTINE LNBLNK
- CERN PROGLIB# M507 LNBLNK .VERSION KERNIBX 1.05 920511
- ORIG. 30/04/92, RDM + JZ
-
- N = LNBLNK (CHLINE) find last non-blank character in CHLINE
-*/
- int lnblnk_(chline, lenpar)
- char *chline;
- int *lenpar;
-{
- static unsigned int blnk = 0x20202020;
- unsigned int *wdcur;
- char *chcur;
- int ntail, i;
- int len;
-
- len = *lenpar;
- chcur = chline + len;
- if (len <= 24) goto small;
-
-/* ---- handle long string */
-
-/* look at the last ntail characters */
-
- ntail = ((int)chcur & 3);
- for (i = ntail; i > 0; i--)
- { if (*--chcur != ' ') goto exit; }
-
-/* look for trailing blank words */
-
- wdcur = (unsigned int*) (chcur-4);
- while (wdcur >= (unsigned int*)chline )
- { if (*wdcur != blnk) break; wdcur--; }
-
-/* find last non-blank character */
-
- chcur = (char*) (wdcur+1);
- while (chcur > chline)
- { if (*--chcur != ' ') goto exit; }
- return 0;
-
-exit: return chcur+1 - chline;
-
-/* ---- handle short string */
-
-small:
- while (chcur > chline)
- { if (*--chcur != ' ') goto exit; }
- return 0;
-}
-/*> END <----------------------------------------------------------*/
-#ifdef CERNLIB_TCGEN_LNBLNK
-#undef CERNLIB_TCGEN_LNBLNK
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/locb.s b/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/locb.s
deleted file mode 100644
index 730aab9..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/locb.s
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: locb.s,v 1.1.1.1 1996/02/15 17:54:40 mclareni Exp $
-*
-* $Log: locb.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:40 mclareni
-* Kernlib
-*
-*
-LOCB CSECT
-*
-* CERN PROGLIB# LOCB .VERSION KERNIBX 1.01 900524
-*
-** This routine does nothing in AIX: the argument address is in GR0
-** on entry, and is to be returned in GR0 as the function value!
- ENTRY _locb_
-_locb_ BCR 15,14
- END
-#ifdef CERNLIB_CCGEN_LOCB
-#undef CERNLIB_CCGEN_LOCB
-#endif
-#ifdef CERNLIB_TCGEN_LOCB
-#undef CERNLIB_TCGEN_LOCB
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/locf.s b/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/locf.s
deleted file mode 100644
index 7f0a15d..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/locf.s
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: locf.s,v 1.1.1.1 1996/02/15 17:54:40 mclareni Exp $
-*
-* $Log: locf.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:40 mclareni
-* Kernlib
-*
-*
-LOCF CSECT
-*
-* CERN PROGLIB# LOCF .VERSION KERNIBX 1.01 900524
-*
-* AIX linkage conventions: arguemnt address is in GR0 on entry;
-* function value is to bne returned in GR0.
-*
- ENTRY _locf_
-_locf_ SRA 0,2 result = (arg address)/4
- BCR 15,14
- END
-#ifdef CERNLIB_CCGEN_LOCF
-#undef CERNLIB_CCGEN_LOCF
-#endif
-#ifdef CERNLIB_TCGEN_LOCF
-#undef CERNLIB_TCGEN_LOCF
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/mbytet.s b/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/mbytet.s
deleted file mode 100644
index fcbbc5b..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/mbytet.s
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: mbytet.s,v 1.1.1.1 1996/02/15 17:54:40 mclareni Exp $
-*
-* $Log: mbytet.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:40 mclareni
-* Kernlib
-*
-*
-MBYTET CSECT
-*
-* CERN PROGLIB# M421 MBYTET .VERSION KERNIBX 1.01 900524
-* ORIG. SEPT 85, HRR
-* Modified for AIX, Roger Howard, January 1990
-*
- USING *,15
- ENTRY _mbytet_
-_mbytet_ STM 2,7,16(13)
- L 6,0(,3) AIX: value of arg4
- L 5,0(,2) AIX: value of arg3
- LR 2,0 AIX: address of arg1
- L 2,0(,2) AIX: value of arg1
- L 0,0(,1) AIX: value of arg2
- LA 7,32
- SR 7,6
- SLL 2,0(7)
- L 4,FF
- SLL 4,0(7)
- SR 7,5
- LA 7,1(7)
- SRL 2,0(7)
- SRL 4,0(7)
- X 4,FF
- OR 2,4
- NR 0,2
- LM 2,7,16(13)
- BCR 15,14
-FF DC X'FFFFFFFF'
- END
-#ifdef CERNLIB_TCGEN_MBYTET
-#undef CERNLIB_TCGEN_MBYTET
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/mbytor.s b/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/mbytor.s
deleted file mode 100644
index cd880fa..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/mbytor.s
+++ /dev/null
@@ -1,35 +0,0 @@
-*
-* $Id: mbytor.s,v 1.1.1.1 1996/02/15 17:54:40 mclareni Exp $
-*
-* $Log: mbytor.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:40 mclareni
-* Kernlib
-*
-*
-MBYTOR CSECT
-*
-* CERN PROGLIB# M421 MBYTOR .VERSION KERNIBX 1.01 900524
-* ORIG. SEPT 85, HRR
-* Modified for AIX, Roger Howard, January 1990
-*
- USING *,15
- ENTRY _mbytor_
-_mbytor_ STM 2,7,16(13)
- L 6,0(,3) AIX: value of arg4
- L 5,0(,2) AIX: value of arg3
- LR 2,0 AIX: address of arg1
- L 2,0(,2) AIX: value of arg1
- L 0,0(,1) AIX: value of arg2
- LA 7,32
- SR 7,6
- SLL 2,0(7)
- SR 7,5
- LA 7,1(7)
- SRL 2,0(7)
- OR 0,2
- LM 2,7,16(13)
- BCR 15,14
- END
-#ifdef CERNLIB_TCGEN_MBYTOR
-#undef CERNLIB_TCGEN_MBYTOR
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/mcbyt.s b/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/mcbyt.s
deleted file mode 100644
index 822fa25..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/mcbyt.s
+++ /dev/null
@@ -1,65 +0,0 @@
-*
-* $Id: mcbyt.s,v 1.1.1.1 1996/02/15 17:54:40 mclareni Exp $
-*
-* $Log: mcbyt.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:40 mclareni
-* Kernlib
-*
-*
-MCBYT CSECT
-*
-* CERN PROGLIB# M421 MCBYT .VERSION KERNIBX 1.01 900524
-* ORIG. SEPT 85, HRR
-* Modified for AIX, Roger Howard, January 1990
-*
- USING *,15
- ENTRY _mcbyt_
-_mcbyt_ STM 2,1,16(13)
- L 6,88(0,13) AIX: address of arg5
- L 6,0(,6) AIX: value of arg5
- LR 4,13 ... added for AIX
- USING STACK,13
- S 13,=A(STEND-STACK) ... added for AIX
- ST 4,4(0,13) ... added for AIX
- L 5,0(,3) AIX: value of arg4
- L 3,0(,1) AIX: value of arg2
- LR 1,0 AIX: address of arg1
- L 0,0(,2) AIX: value of arg3
- L 2,0(,1) AIX: value of arg1
- BCTR 3,0
- SRL 2,0(3)
- BCTR 5,0
- LA 7,STOREC
-STOREC STC 2,BYTE
- TM BYTE,X'01'
- BC 8,ZERO
- LA 8,1
- SLL 8,0(5)
- OR 0,8
- B TESTR6
-ZERO L 10,FE
- L 11,FF
- SLDL 10,0(5)
- NR 0,10
-TESTR6 BCT 6,*+8
- B STOREX
- LA 5,1(5)
- SRL 2,1
- BCR 15,7
-STOREX L 13,4(0,13)
- LM 2,12,16(13)
- BCR 15,14
- DS 0F
-FF DC X'FFFFFFFF'
-FE DC X'FFFFFFFE'
- LTORG
-STACK DSECT
-SAVEAREA DS 18F
-AIXOUT DS 0F
-LINKR23 DS 2F
-BYTE DS C
-STEND DS F
- END
-#ifdef CERNLIB_TCGEN_MCBYT
-#undef CERNLIB_TCGEN_MCBYT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/msbit.s b/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/msbit.s
deleted file mode 100644
index ed7bcba..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/msbit.s
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: msbit.s,v 1.1.1.1 1996/02/15 17:54:41 mclareni Exp $
-*
-* $Log: msbit.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:41 mclareni
-* Kernlib
-*
-*
-MSBIT CSECT
-*
-* CERN PROGLIB# M421 MSBIT .VERSION KERNIBX 1.01 900524
-* ORIG. SEPT 85, HRR
-* Modified for AIX, Roger Howard, January 1990
-*
- USING *,15
- ENTRY _msbit_
-_msbit_ STM 2,5,16(13)
- L 4,0(,2) AIX: value of arg3 = LX
- LTR 4,4
- BNP RET2 RETURN IF LX.LE.0
- LR 2,0 AIX: address of arg1
- L 2,0(,2) AIX: value of arg1 = A
- LA 5,1
- NR 5,2 R5 HAS SAME LOW ORDER BIT AS A
- LTR 5,5
- BZ BIT0
-BIT1 SLL 5,63(4)
- O 5,0(,1) AIX: address of arg2 is in GR1
- B RET
-BIT0 LA 5,1
- SLL 5,63(4)
- X 5,FF
- N 5,0(,1) AIX: address of arg2 is in GR1
-RET LR 0,5
-RET2 LM 2,5,16(13)
- BR 14
-FF DC F'-1'
- END
-#ifdef CERNLIB_TCGEN_MSBIT
-#undef CERNLIB_TCGEN_MSBIT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/msbit0.s b/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/msbit0.s
deleted file mode 100644
index 744ae99..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/msbit0.s
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: msbit0.s,v 1.1.1.1 1996/02/15 17:54:41 mclareni Exp $
-*
-* $Log: msbit0.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:41 mclareni
-* Kernlib
-*
-*
-MSBIT0 CSECT
-*
-* CERN PROGLIB# M421 MSBIT0 .VERSION KERNIBX 1.01 900524
-* ORIG. SEPT 85, HRR
-* Modified for AIX, Roger Howard, January 1990
-*
- USING *,15
- ENTRY _msbit0_
-_msbit0_ STM 2,1,16(13)
- LR 4,0 AIX: address of arg1
- L 0,0(,4) AIX: value of arg1
- L 4,0(,1) AIX: value of arg2
- BCTR 4,0
- L 6,FE
- L 7,FF
- SLDL 6,0(4)
- NR 0,6
- LM 2,7,16(13)
- BCR 15,14
- DS 0F
-FE DC X'FFFFFFFE'
-FF DC X'FFFFFFFF'
- END
-#ifdef CERNLIB_TCGEN_MSBIT0
-#undef CERNLIB_TCGEN_MSBIT0
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/msbit1.s b/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/msbit1.s
deleted file mode 100644
index 6dbae73..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/msbit1.s
+++ /dev/null
@@ -1,30 +0,0 @@
-*
-* $Id: msbit1.s,v 1.1.1.1 1996/02/15 17:54:41 mclareni Exp $
-*
-* $Log: msbit1.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:41 mclareni
-* Kernlib
-*
-*
-MSBIT1 CSECT
-*
-* CERN PROGLIB# M421 MSBIT1 .VERSION KERNIBX 1.01 900524
-* ORIG. SEPT 85, HRR
-* Modified for AIX, Roger Howard, January 1990
-*
- USING *,15
- ENTRY _msbit1_
-_msbit1_ STM 2,5,16(13)
- LR 2,0 AIX: address of arg1
- L 0,0(,2) AIX: value of arg1
- L 4,0(,1) AIX: value of arg2
- BCTR 4,0
- LA 5,1
- SLL 5,0(4)
- OR 0,5
- LM 2,5,16(13)
- BCR 15,14
- END
-#ifdef CERNLIB_TCGEN_MSBIT1
-#undef CERNLIB_TCGEN_MSBIT1
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/msbyt.s b/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/msbyt.s
deleted file mode 100644
index b1683fc..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/msbyt.s
+++ /dev/null
@@ -1,38 +0,0 @@
-*
-* $Id: msbyt.s,v 1.1.1.1 1996/02/15 17:54:41 mclareni Exp $
-*
-* $Log: msbyt.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:41 mclareni
-* Kernlib
-*
-*
-MSBYT CSECT
-*
-* CERN PROGLIB# M421 MSBYT .VERSION KERNIBX 1.01 900524
-* ORIG. SEPT 85, HRR
-* Modified for AIX, Roger Howard, January 1990
-*
- USING *,15
- ENTRY _msbyt_
-_msbyt_ STM 2,7,16(13)
- L 6,0(,1) AIX: value of arg4 = X
- L 5,0(,3) AIX: value of arg4 = NBITS
- L 4,0(,2) AIX: value of arg3 = LX
- LR 1,0 AIX: address of arg1
- L 0,0(,1) AIX: value of arg1 = A
- SR 1,1
- SRDL 0,0(5) R1 HAS LEFT MOST BITS = BYTE A
- AR 4,5
- SRDL 6,63(4)
- LR 0,6
- SLDL 0,0(5)
- SLL 7,0(5)
- LR 1,7
- SR 4,5
- SLDL 0,63(4)
- LM 2,7,16(13)
- BR 14
- END
-#ifdef CERNLIB_TCGEN_MSBYT
-#undef CERNLIB_TCGEN_MSBYT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/pkbyt.s b/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/pkbyt.s
deleted file mode 100644
index 9367fec..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/pkbyt.s
+++ /dev/null
@@ -1,98 +0,0 @@
-*
-* $Id: pkbyt.s,v 1.1.1.1 1996/02/15 17:54:41 mclareni Exp $
-*
-* $Log: pkbyt.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:41 mclareni
-* Kernlib
-*
-*
-PKBYT CSECT
-*
-* CERN PROGLIB# M422 PKBYT .VERSION KERNIBX 1.01 900524
-* ORIG. FEB 83, R.MATTHEWS, CERN/DD
-* Modified for AIX, Roger Howard, February 1990
-*
-* CALL PKBYT (IB,X,JX,N,MPACK)
-*
-R0 EQU 0
-R1 EQU 1
-R2 EQU 2
-R3 EQU 3
-R4 EQU 4
-R5 EQU 5
-R6 EQU 6
-R7 EQU 7
-R8 EQU 8
-R9 EQU 9
-R10 EQU 10
-R11 EQU 11
-R12 EQU 12
-R13 EQU 13
-R14 EQU 14
-R15 EQU 15
-*
- USING *,R15
- ENTRY _pkbyt_
-_pkbyt_ STM R2,R1,16(R13)
- L R6,88(,R13) AIX: address of arg5 = MPACK
- L R5,0(,R3) AIX: value of arg4 = N
- LTR R5,R5 N .LE. 0 ?
- BNP EPILOGUE YES, BRANCH
- LR R3,R1 AIX: address of arg2 = X
- L R1,0(,R2) AIX: value of arg3 = JX
- LR R2,R0 AIX: address of arg1 = IB
- L R7,4(0,R6) R7 := INWORD
- L R6,0(0,R6) R6 := NBITS
- LTR R6,R6 NBITS .GT.0 ?
- BP L1 YES, BRANCH
- LA R6,1 R6 := 1 (NBITS)
- LA R7,32 R7 := 32 (INWORD)
-L1 SR R0,R0 R0 := 0
- BCTR R1,0
- DR R0,R7
- SLL R1,2
- LA R3,0(R1,R3) R3 -> FIRST TARGET WORD
- LR R1,R0
- MR R0,R6
- LR R8,R1 R8 -> FIRST TARGET 'BYTE' WITHIN WORD
- LR R1,R7
- BCTR R1,0
- MR R0,R6
- LR R7,R1 R7 -> LAST TARGET 'BYTE' WITHIN WORD
- BCTR R5,0
- SLL R5,2
- LA R5,0(R5,R2) R5 -> LAST INPUT WORD
- LA R4,4 R4 := 4
- L R9,=X'FFFFFFFF'
- LR R11,R9
- SR R10,R10
- SLDL R10,0(R6) R10 := MASK TO ISOLATE INPUT 'BYTE'
- LR R12,R11 R11 & R12 := MASK FOR TARGET 'BYTE'
- XR R11,R9 INVERT BITS
- SLL R11,0(R8) SHIFT TO INITIAL POSITION
- XR R11,R9 INVERT BITS
- L R0,0(0,R3) R0 := FIRST TARGET WORD
- B L4
-L2 ST R0,0(0,R3) STORE THE PACKED WORD
- AR R3,R4 R3 -> NEXT TARGET WORD
- L R0,0(0,R3) R0 := NEXT TARGET WORD
- LNR R8,R6 PRIME R8
- LR R11,R12 INITIALISE MASK FOR TARGET 'BYTES'
-L3 BXH R8,R6,L2
-L4 L R1,0(0,R2) R1 := NEXT INPUT WORD
- NR R1,R10 R1 := NEXT INPUT 'BYTE'
- SLL R1,0(R8) SHIFT IT TO THE CORRECT 'BYTE' LOCATION
- NR R0,R11 CREATE A HOLE IN THE TARGET WORD
- XR R11,R9 FLIP BITS
- SLL R11,0(R6) SHIFT FOR NEXT 'BYTE'
- XR R11,R9 FLIP BITS
- OR R0,R1 PACK IT INTO THE TARGET WORD
- BXLE R2,R4,L3 R2 -> NEXT INPUT WORD
- ST R0,0(0,R3) STORE THE FINAL PACKED WORD
-EPILOGUE EQU *
- LM R2,R12,16(R13)
- BR R14
- END
-#ifdef CERNLIB_TCGEN_PKBYT
-#undef CERNLIB_TCGEN_PKBYT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/rndm.s b/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/rndm.s
deleted file mode 100644
index a706287..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/rndm.s
+++ /dev/null
@@ -1,85 +0,0 @@
-*
-* $Id: rndm.s,v 1.1.1.1 1996/02/15 17:54:41 mclareni Exp $
-*
-* $Log: rndm.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:41 mclareni
-* Kernlib
-*
-*
-RNDM CSECT
-*
-* CERN PROGLIB# V104 RNDM .VERSION KERNIBX 1.03 910315
-*
-* UNIFORM RANDOM NUMBER GENERATOR FOR IBM 370
-* G.MARSAGLIA, K.ANANTHANARAYANAN, N.PAUL. MCGILL UNIV., MONTREAL
-* ONE-PARAMETER VERSION
-* ADAPTED AT CERN BY T.LINDELOF, SEPT 1977
-* RDMIN MODIFIED BY T LINDELOF AUG 1978
- ENTRY _rndm_ R=RNDM(DUMMY)
- ENTRY _rdmin_ CALL RDMIN(I1)
- ENTRY _rdmout_ CALL RDMOUT(I1)
- ENTRY _irndm_ K=IRNDM(DUMMY)
-*
-* R=RNDM(DUMMY) RESULT IS NORMALIZED FLOATING POINT VALUE
-* UNIFORMLY DISTRIBUTED ON (0.0,1.0).
- USING *,15
-_rndm_ STM 2,1,16(13) SAVE REGISTERS
- L 12,=A(MCGN)
- USING MCGN,12
- L 3,MCGN LOAD MCGN INTO REGD
- M 2,MULT AND MULTIPLY BY 69069
- ST 3,MCGN STORE RESULT,MODULO 2**32, AS NEW 'MCGN'
- SRL 3,8 SHIFT 3 RIGHT 8 BITS FOR F.P. FRACTION
- AL 3,CHAR ADD CHARACTERISTIC X'40' INTO FIRST BYTE
- ST 3,FWD STORE AT FWD, LOAD INTO FPR 0,
- LE 0,FWD AND ADD NORMALIZED TO ZERO
- AE 0,Z LEAVING RESULT 'RNDM' IN FPR 0.
-RETRN1 LM 2,1,16(13)
- BCR 15,14 RETURN
-*
-* K=IRNDM(DUMMY) UNIFORMLY DISTRIBUTED POSITIVE INTEGER.
-*
- USING *,15
-_irndm_ STM 2,1,16(13) SAVE REGISTERS
- L 12,=A(MCGN)
- L 3,MCGN LOAD MCGN INTO 3
- M 2,MULT AND MULTIPLY BY 69069
- ST 3,MCGN STORE RESULT,MODULO 2**32, AS NEW 'MCGN'
- SRL 3,1 SHIFT LEFT 1 BIT,LEAVING SIGN BIT ZERO
- LR 0,3 AND MOVE RESULT 'IRNDM' TO GPR 0.
-RETRN5 LM 2,1,16(13)
- BCR 15,14 RETURN
-*
-* CALL RDMIN(I1) I1 IS USED FOR STARTING THE
-* SEQUENCE 'MCGN'
- USING *,15
-_rdmin_ STM 2,1,16(13) SAVE REGISTERS
- L 12,=A(MCGN)
- LR 2,0 address of argument
- L 2,0(0,2) LOAD VALUE OF I1 INTO REGC
- LTR 2,2
-ST1 ST 2,MCGN STORE AT 'MCGN'
-RETRN0 LM 2,1,16(13) RESTORE REGISTERS
- BCR 15,14 AND RETURN
-*
-* CALL RDMOUT(I1)
-*
- USING *,15
-_rdmout_ STM 2,1,16(13) SAVE REGISTERS
- L 12,=A(MCGN)
- LR 2,0 address of argument
- MVC 0(4,2),MCGN MOVE MCGN TO I1
- LM 2,1,16(13) RESTORE REGISTERS
- BCR 15,14 AND RETURN
-*
-* CONSTANTS AND STORAGE RESERVATION
-*
- LTORG ... adcon must be in CSECT
-DATA PSECT
-MCGN DC F'12345'
-X7FF DC X'000007FF'
-MULT DC F'69069'
-CHAR DC X'40000000'
-FWD DC F'0'
-Z DC E'0.0'
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/sbit.s b/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/sbit.s
deleted file mode 100644
index afe2de4..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/sbit.s
+++ /dev/null
@@ -1,42 +0,0 @@
-*
-* $Id: sbit.s,v 1.1.1.1 1996/02/15 17:54:41 mclareni Exp $
-*
-* $Log: sbit.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:41 mclareni
-* Kernlib
-*
-*
-SBIT CSECT
-*
-* CERN PROGLIB# M421 SBIT .VERSION KERNIBX 1.01 900524
-*
-* CODED FOR FAST EXECUTION H.WATKINS,LIVERPOOL JULY 1974
-* Modified for AIX, Roger Howard, January 1990
-*
- USING *,15
- ENTRY _sbit_
-_sbit_ STM 2,5,16(13)
- L 4,0(,2) AIX: value of arg3 = LX
- LTR 4,4
- BNP RET2 RETURN IF LX.LE.0
- LR 2,0 AIX: address of arg1
- L 2,0(2) AIX: value of arg1 = A
- LA 5,1
- NR 5,2 R5 HAS SAME LOW ORDER BIT AS A
- LTR 5,5
- BZ BIT0
-BIT1 SLL 5,63(4)
- O 5,0(1) AIX: address of arg2 in GR1
- B RET
-BIT0 LA 5,1
- SLL 5,63(4)
- X 5,FF
- N 5,0(1) AIX: address of arg2 in GR1
-RET ST 5,0(1) AIX: address of arg2 in GR1
-RET2 LM 2,5,16(13)
- BR 14
-FF DC F'-1'
- END
-#ifdef CERNLIB_TCGEN_SBIT
-#undef CERNLIB_TCGEN_SBIT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/sbit0.s b/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/sbit0.s
deleted file mode 100644
index ff02372..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/sbit0.s
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: sbit0.s,v 1.1.1.1 1996/02/15 17:54:41 mclareni Exp $
-*
-* $Log: sbit0.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:41 mclareni
-* Kernlib
-*
-*
-SBIT0 CSECT
-*
-* CERN PROGLIB# M421 SBIT0 .VERSION KERNIBX 1.01 900524
-*
- USING *,15
- ENTRY _sbit0_
-_sbit0_ STM 2,7,16(13)
- LR 2,0 AIX: address of arg1
- L 3,0(,2) AIX: value of arg1
- L 4,0(,1) AIX: value of arg2
- BCTR 4,0
- L 6,FE
- L 7,FF
- SLDL 6,0(4)
- NR 3,6
- ST 3,0(2)
- LM 2,7,16(13)
- BCR 15,14
-FE DC X'FFFFFFFE'
-FF DC X'FFFFFFFF'
- END
-#ifdef CERNLIB_TCGEN_SBIT0
-#undef CERNLIB_TCGEN_SBIT0
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/sbit1.s b/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/sbit1.s
deleted file mode 100644
index e2ae0ad..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/sbit1.s
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: sbit1.s,v 1.1.1.1 1996/02/15 17:54:41 mclareni Exp $
-*
-* $Log: sbit1.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:41 mclareni
-* Kernlib
-*
-*
-SBIT1 CSECT
-*
-* CERN PROGLIB# M421 SBIT1 .VERSION KERNIBX 1.01 900524
-*
- USING *,15
- ENTRY _sbit1_
-_sbit1_ STM 2,5,16(13)
- LR 2,0 AIX: address of arg1
- L 3,0(,2) AIX: value of arg1
- L 4,0(,1) AIX: value of arg2
- BCTR 4,0
- LA 5,1
- SLL 5,0(4)
- OR 3,5
- ST 3,0(2)
- LM 2,5,16(13)
- BCR 15,14
- END
-#ifdef CERNLIB_TCGEN_SBIT1
-#undef CERNLIB_TCGEN_SBIT1
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/sbyt.s b/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/sbyt.s
deleted file mode 100644
index e716de7..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/sbyt.s
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: sbyt.s,v 1.1.1.1 1996/02/15 17:54:42 mclareni Exp $
-*
-* $Log: sbyt.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:42 mclareni
-* Kernlib
-*
-*
-SBYT CSECT
-*
-* CERN PROGLIB# M421 SBYT .VERSION KERNIBX 1.01 900524
-*
-* CODED FOR FAST EXECUTION H.WATKINS,LIVERPOOL JULY 1974
-* Modified for AIX, Roger Howard, January 1990
-*
- USING *,15
- ENTRY _sbyt_
-_sbyt_ STM 2,7,16(13)
- L 5,0(,3) AIX: value of arg4 = NBITS
- L 4,0(,2) AIX: value of arg3 = LX
- LR 3,1 AIX: address of arg2 = X
- LR 2,0 AIX: address of arg1
- L 0,0(,2) AIX: value of arg1 = A
- SR 1,1
- SRDL 0,0(5) R1 HAS LEFT MOST BITS = BYTE A
- L 6,0(3)
- AR 4,5
- SRDL 6,63(4)
- LR 0,6
- SLDL 0,0(5)
- SLL 7,0(5)
- LR 1,7
- SR 4,5
- SLDL 0,63(4)
- ST 0,0(3)
- LM 2,7,16(13)
- BR 14
- END
-#ifdef CERNLIB_TCGEN_SBYT
-#undef CERNLIB_TCGEN_SBYT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/sbytor.s b/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/sbytor.s
deleted file mode 100644
index 622aff5..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/sbytor.s
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: sbytor.s,v 1.1.1.1 1996/02/15 17:54:42 mclareni Exp $
-*
-* $Log: sbytor.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:42 mclareni
-* Kernlib
-*
-*
-SBYTOR CSECT
-*
-* CERN PROGLIB# M421 SBYTOR .VERSION KERNIBX 1.01 900524
-*
- USING *,15
- ENTRY _sbytor_
-_sbytor_ STM 2,7,16(13)
- L 6,0(,3) AIX: value of arg4
- L 5,0(,2) AIX: value of arg3
- LR 2,0 AIX: address of arg1
- L 2,0(,2) AIX: value of arg1
- L 4,0(,1) AIX: value of arg2
- LA 7,32
- SR 7,6
- SLL 2,0(7)
- SR 7,5
- LA 7,1(7)
- SRL 2,0(7)
- OR 4,2
- ST 4,0(1) AIX: address of arg2 in GR1
- LM 2,7,16(13)
- BCR 15,14
- END
-#ifdef CERNLIB_TCGEN_SBYTOR
-#undef CERNLIB_TCGEN_SBYTOR
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/ubits.s b/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/ubits.s
deleted file mode 100644
index c9554cd..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/ubits.s
+++ /dev/null
@@ -1,83 +0,0 @@
-*
-* $Id: ubits.s,v 1.1.1.1 1996/02/15 17:54:42 mclareni Exp $
-*
-* $Log: ubits.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:42 mclareni
-* Kernlib
-*
-*
-UBITS CSECT
-*
-* CERN PROGLIB# M503 UBITS .VERSION KERNIBX 1.01 900524
-* ORIG. OCT 81, R.MATTHEWS, M.METCALF, CERN/DD
-* Modified for AIX, Roger Howard, January 1990
-*
-* CALL UBITS (STRING,LENGTH,LOCS,NUMBER)
-*
-* FUNCTION: EXAMINE A STRING OF BITS AND STORE THE LOCATIONS OF
-* THE BITS HAVING THE VALUE 1 IN SUCCESSIVE WORDS OF
-* AN ARRAY.
-*
-* ARGUMENTS: STRING - A FULLWORD ARRAY CONTAINING THE BIT STRING
-*
-* LENGTH - THE NUMBER OF BITS IN THE BIT STRING
-*
-* LOCS - AN INTEGER*4 ARRAY TO RECEIVE THE LOCATIONS
-* OF THE BITS WHOSE VALUE IS 1
-*
-* NUMBER - THE NUMBER OF BITS FOUND TO HAVE THE VALUE 1
-*
-R0 EQU 0
-R1 EQU 1
-R2 EQU 2
-R3 EQU 3
-R4 EQU 4
-R5 EQU 5
-R6 EQU 6
-R7 EQU 7
-R8 EQU 8
-R9 EQU 9
-R10 EQU 10
-R11 EQU 11
-R12 EQU 12
-R13 EQU 13
-R14 EQU 14
-R15 EQU 15
-*
-* P R O L O G U E
-*
- USING *,R15
- ENTRY _ubits_
-_ubits_ STM R2,R1,16(R13)
- LR R9,R0 AIX: address or arg1 = STRING
- LR R11,R2 AIX: address of arg3 = LOCS
- LR R12,R3 AIX: address of arg4 = NUMBER
- L R3,0(,R1) AIX: value of arg2 = LENGTH
- SR R5,R5 R5 := 0 (INDEX FOR LOCS)
- SR R4,R4 R4 := 0 (LOOP COUNTER)
- LA R2,1 R2 := 1 (LOOP INCREMENT)
- LR R8,R2 R8 := 1
-LOOP BXH R4,R2,ALLDONE
- BCT R8,TESTBIT BRANCH UNLESS CURRENT WORD IS EXHAUSTED
-NEWORD L R6,0(0,R9) R6 := NEW WORD OF STRING
- LA R9,4(0,R9) R9 -> NEXT WORD OF STRING
- LA R8,32 PRIME THE COUNTER
-TESTBIT SRDL R6,1 SHIFT LEAST SIGNIFICANT BIT OF R6 INTO R7
- LTR R7,R7 IS IT 1 ?
- BNM TESTWORD NO, BRANCH
- ST R4,0(R5,R11) STORE ITS LOCATION IN LOCS
- LA R5,4(0,R5) INCREMENT THE INDEX FOR LOCS
-TESTWORD LTR R6,R6 ARE THERE ANY MORE 1 BITS IN THE WORD ?
- BNZ LOOP YES, BRANCH TO PROCESS THEM
- AR R4,R8 OTHERWISE INCREMENT THE LOOP COUNTER BY
- SR R4,R2 THE NUMBER OF BITS REMAINING UNTESTED
- BXLE R4,R2,NEWORD AND TEST WHETHER FINISHED
-ALLDONE SRA R5,2 NUMBER = (R5)/4
- ST R5,0(0,R12) STORE NUMBER
-EPILOGUE EQU *
- LM R2,R12,16(R13)
- BR R14
- END
-#ifdef CERNLIB_TCGEN_UBITS
-#undef CERNLIB_TCGEN_UBITS
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/ubunch.s b/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/ubunch.s
deleted file mode 100644
index 4de8795..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/ubunch.s
+++ /dev/null
@@ -1,76 +0,0 @@
-*
-* $Id: ubunch.s,v 1.1.1.1 1996/02/15 17:54:42 mclareni Exp $
-*
-* $Log: ubunch.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:42 mclareni
-* Kernlib
-*
-*
-UBUNCH CSECT
-*
-* CERN PROGLIB# M409 UBUNCH .VERSION KERNIBX 1.01 900524
-*
- USING *,15
- ENTRY _ubunch_
- ENTRY _ublow_
-_ubunch_ STM 2,12,16(13)
- LR 3,0 AIX: address of arg1 = BLOWN
- LR 4,1 AIX: address of arg2 = BUNCH
- L 5,0(,2) AIX: value of arg3 = N
- LA 6,1 J=1
- LA 7,4 K=4
- SR 3,7 R3=BLOWN-K
- SR 4,6 R4=BUNCH-J
- SR 11,11
- CR 5,11
- BNH END
- LR 11,5
- SR 10,10
- DR 10,7
- SR 11,11
-LOOP1 L 9,0(3,7) R9=BLOWN(K)
- SLDL 8,8
- STC 8,0(4,6) BUNCH(J)=BLOWN(K)
- LA 6,1(6) J=J+1
- LA 7,4(7) K=K+4
- BCT 5,LOOP1 IF R5 NOT 1 R5=R5-1 , GO TO LOOP1
- CR 10,11
- BE END
- LA 5,4
- SR 5,10
- L 9,BLANKS
-LOOP3 STC 9,0(4,6)
- LA 6,1(6)
- BCT 5,LOOP3
-END LM 2,12,16(13)
- BCR 15,14 RETURN
- USING *,15
-_ublow_ STM 2,12,16(13)
- LR 3,0 AIX: address of arg1 = BUNCH
- LR 4,1 AIX: address of arg2 = BLOWN
- L 5,0(,2) AIX: value of arg3 = N
- LA 6,1 J=1
- LA 7,4 K=4
- SR 3,6 R3=BUNCH-J
- SR 4,7 R4=BLOWN-K
- SR 9,9
- CR 5,9
- BNH END1
-LOOP2 L 9,BLANKS
- IC 8,0(3,6) R8=BUNCH(J)
- SRDL 8,8
- ST 9,0(4,7)
- LA 6,1(6) J=J+1
- LA 7,4(7) K=K+4
- BCT 5,LOOP2 IF R5 NOT 1 R5=R5-1, GO TO LOOP2
-END1 LM 2,12,16(13)
- BCR 15,14 RETURN
- CNOP 0,4
-BLANKS DC CL4' '
- END
-#ifdef CERNLIB_TCGEN_UBUNCH
-#undef CERNLIB_TCGEN_UBUNCH
-#endif
-#ifdef CERNLIB_TCGEN_UBLOW
-#undef CERNLIB_TCGEN_UBLOW
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/ucocop.s b/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/ucocop.s
deleted file mode 100644
index e772753..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/ucocop.s
+++ /dev/null
@@ -1,51 +0,0 @@
-*
-* $Id: ucocop.s,v 1.1.1.1 1996/02/15 17:54:42 mclareni Exp $
-*
-* $Log: ucocop.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:42 mclareni
-* Kernlib
-*
-*
-UCOCOP CSECT
-*
-* CERN PROGLIB# V302 UCOCOP .VERSION KERNIBX 1.01 900524
-*
- USING *,15
- ENTRY _ucocop_
-_ucocop_ STM 2,1,16(13)
- LM 6,7,88(13) AIX: addresses of arg5=NA,arg6=NB
- L 4,0(,2) AIX: value of arg3 = IDO
- LTR 4,4
- BZ RETURN
- L 5,0(,3) AIX: value of arg4 = IW
- LTR 5,5
- BZ RETURN
- LR 3,1 AIX: address of arg2
- LR 2,0 AIX: address of arg1
- L 9,0(7) NB
- L 7,0(6) NA
- SR 7,5 KK
- SR 9,5 LL
- SR 6,6
- SR 8,8
- LA 10,4
- MR 6,10
- MR 8,10
- SR 6,6
- SR 8,8
- CNOP 0,8
-LOOP1 LR 11,5
-LOOP2 L 12,0(2,6)
- ST 12,0(3,8)
- AR 6,10
- AR 8,10
- BCT 11,LOOP2
- AR 6,7
- AR 8,9
- BCT 4,LOOP1
-RETURN LM 2,12,16(13)
- BCR 15,14
- END
-#ifdef CERNLIB_TCGEN_UCOCOP
-#undef CERNLIB_TCGEN_UCOCOP
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/ucopiv.s b/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/ucopiv.s
deleted file mode 100644
index 3ceb060..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/ucopiv.s
+++ /dev/null
@@ -1,35 +0,0 @@
-*
-* $Id: ucopiv.s,v 1.1.1.1 1996/02/15 17:54:42 mclareni Exp $
-*
-* $Log: ucopiv.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:42 mclareni
-* Kernlib
-*
-*
-UCOPIV CSECT
-*
-* CERN PROGLIB# V301 UCOPIV .VERSION KERNIBX 1.01 900524
-*
- USING *,15
- ENTRY _ucopiv_
-_ucopiv_ STM 2,7,16(13)
- L 5,0(,2) AIX: value of arg3 = N
- LTR 5,5
- BC 8,RETURN
- LR 2,0 AIX: address of arg1 = A
- LA 4,4(0)
- SLA 5,2
- SR 5,4
- SR 6,6
- LA 7,COPY
-COPY LE 0,0(6,2)
- STE 0,0(5,1) AIX: address of arg2 in GR1
- LA 6,4(6)
- SR 5,4
- BCR 10,7
-RETURN LM 2,7,16(13)
- BCR 15,14
- END
-#ifdef CERNLIB_TCGEN_UCOPIV
-#undef CERNLIB_TCGEN_UCOPIV
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/ucopy.s b/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/ucopy.s
deleted file mode 100644
index 9b2f519..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/ucopy.s
+++ /dev/null
@@ -1,56 +0,0 @@
-*
-* $Id: ucopy.s,v 1.1.1.1 1996/02/15 17:54:42 mclareni Exp $
-*
-* $Log: ucopy.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:42 mclareni
-* Kernlib
-*
-*
-UCOPY CSECT
-*
-* CERN PROGLIB# V301 UCOPY .VERSION KERNIBX 1.01 900524
-*
-* CALL UCOPY (A,B,N)
-* CALL UCOPY2 (A,B,N)
-*
-* USES THE MVCL INSTR.
-* MVCL CHECKS ON DESTRUCTIVE OVERLAP OF A AND B
-* ON THAT CONDITION (3), A REVERSE LOOP IS ENTERED.
-* P. M. HEINEN NIJMEGEN SEPT. 73
-* Modified for AIX, Roger Howard, January 1990
-*
- USING *,15
- ENTRY _ucopy_
- ENTRY _ucopy2_
-_ucopy_ DS 0H
-_ucopy2_ STM 2,5,16(13)
- LR 3,0 AIX: address of arg1 = A
- LR 4,1 AIX: address of arg2 = B
- L 5,0(,2) AIX: value of arg3 = N
- LPR 5,5
- BC 8,MVR
- SLL 5,2 N
- LR 2,4 B
- LR 4,3 A
- LR 3,5 N
- MVCL 2,4
- BC 1,MV10 DESTR. OVERLAP
-MVR LM 2,5,16(13)
- BR 14
-* REVERSE LOOP / A(N) TO B(N), A(N-1) TO B(N-1) , ETC.
-MV10 LA 3,4
- LA 2,0(5,2) B(N+1)
- LA 4,0(5,4) A(N+1)
- SRL 5,2 N
-MV12 SR 2,3 B(N)
- SR 4,3 A(N)
- MVC 0(4,2),0(4) A(N) TO B(N)
- BCT 5,MV12
- B MVR
- END
-#ifdef CERNLIB_TCGEN_UCOPY
-#undef CERNLIB_TCGEN_UCOPY
-#endif
-#ifdef CERNLIB_TCGEN_UCOPY2
-#undef CERNLIB_TCGEN_UCOPY2
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/ucopyn.s b/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/ucopyn.s
deleted file mode 100644
index 6b613eb..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/ucopyn.s
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: ucopyn.s,v 1.1.1.1 1996/02/15 17:54:42 mclareni Exp $
-*
-* $Log: ucopyn.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:42 mclareni
-* Kernlib
-*
-*
-UCOPYN CSECT
-*
-* CERN PROGLIB# V301 UCOPYN .VERSION KERNIBX 1.01 900524
-*
- USING *,15
- ENTRY _ucopyn_
-_ucopyn_ STM 2,7,16(13)
- L 5,0(,2) AIX: value of arg3
- LR 2,0 AIX: address of arg1
- LTR 5,5
- BC 8,RETURN
- LA 4,4(0)
- SLA 5,2
- SR 5,4
- SR 6,6
-COPY L 0,0(6,2)
- LCR 0,0
- ST 0,0(6,1) AIX: arg2 address in GR1
- BXLE 6,4,COPY
-RETURN LM 2,7,16(13)
- BCR 15,14
- END
-#ifdef CERNLIB_TCGEN_UCOPYN
-#undef CERNLIB_TCGEN_UCOPYN
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/ufill.s b/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/ufill.s
deleted file mode 100644
index dc0b488..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/ufill.s
+++ /dev/null
@@ -1,55 +0,0 @@
-*
-* $Id: ufill.s,v 1.1.1.1 1996/02/15 17:54:42 mclareni Exp $
-*
-* $Log: ufill.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:42 mclareni
-* Kernlib
-*
-*
-UFILL CSECT
-*
-* CERN PROGLIB# V300 UFILL .VERSION KERNIBX 1.01 900524
-*
-* CODED FOR FAST EXECUTION H.WATKINS,LIVERPOOL JULY 1974
-* SEPARATED FROM UZERO/UBLANK BY R.MATTHEWS, OCT 81
-* Modified for AIX, Roger Howard, January 1990
-*
- USING *,15
- ENTRY _ufill_
-_ufill_ STM 2,12,16(13)
- LR 8,0 AIX: address of arg1
- L 9,0(,1) AIX: value of arg2
- L 10,0(,2) AIX: value of arg3
- L 2,0(,3) AIX: value of arg4
- LR 0,2
- LR 1,0
- LR 3,0
- LR 4,0
- LR 5,0
- LR 6,0
- LR 7,0
- SR 10,9
- BM END
- BCTR 9,0
- SLL 9,2
- AR 8,9
- LA 9,32
- LA 10,1(10)
- SR 11,11
- SRDA 10,3
- LTR 10,10
- BNP BYPASS
-LOOP STM 0,7,0(8)
- AR 8,9
- BCT 10,LOOP
-BYPASS SLDA 10,3
- BNP END
- BCTR 10,0
- EX 10,MSTOR
-END LM 2,12,16(13)
- BR 14 RETURN
-MSTOR STM 0,0,0(8)
- END
-#ifdef CERNLIB_TCGEN_UFILL
-#undef CERNLIB_TCGEN_UFILL
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/uh1toc.s b/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/uh1toc.s
deleted file mode 100644
index 135481b..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/uh1toc.s
+++ /dev/null
@@ -1,57 +0,0 @@
-*
-* $Id: uh1toc.s,v 1.1.1.1 1996/02/15 17:54:42 mclareni Exp $
-*
-* $Log: uh1toc.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:42 mclareni
-* Kernlib
-*
-*
-UH1TOC CSECT
-*
-* CERN PROGLIB# M409 UH1TOC .VERSION KERNIBX 1.01 900524
-* ORIG. NOV 83, R.MATTHEWS, CERN/DD
-* Modified for AIX, Roger Howard, January 1990
-*
-* CALL UH1TOC (V1,VC,NCH)
-*
-R0 EQU 0
-R1 EQU 1
-R2 EQU 2
-R3 EQU 3
-R4 EQU 4
-R5 EQU 5
-R6 EQU 6
-R7 EQU 7
-R8 EQU 8
-R9 EQU 9
-R10 EQU 10
-R11 EQU 11
-R12 EQU 12
-R13 EQU 13
-R14 EQU 14
-R15 EQU 15
-*
-* P R O L O G U E
-*
- USING *,R15
- ENTRY _uh1toc_
-_uh1toc_ STM R2,R12,16(R13)
- L R12,0(,R2) AIX: value of arg3 = NCH
- LR R11,R1 AIX: address of arg2 = VC
- LR R10,R0 AIX: address of arg1 = V1
- LTR R12,R12 NHC=0 ?
- BZ EPILOGUE YES, BRANCH
-*
-LOOP1 IC R2,0(0,R10) GET THE NEXT CHARACTER FROM V1
- STC R2,0(0,R11) STORE IT IN VC
- LA R10,4(0,R10) R10 -> NEXT INPUT WORD
- LA R11,1(0,R11) R11 -> NEXT LOCATION IN VC
- BCT R12,LOOP1 LOOP TO PROCESS THE NEXT CHARACTER
-*
-EPILOGUE EQU *
- LM R2,R12,16(R13)
- BR R14
- END
-#ifdef CERNLIB_TCGEN_UH1TOC
-#undef CERNLIB_TCGEN_UH1TOC
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/uhtoc.s b/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/uhtoc.s
deleted file mode 100644
index f7b6aa4..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/uhtoc.s
+++ /dev/null
@@ -1,71 +0,0 @@
-*
-* $Id: uhtoc.s,v 1.1.1.1 1996/02/15 17:54:42 mclareni Exp $
-*
-* $Log: uhtoc.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:42 mclareni
-* Kernlib
-*
-*
-UHTOC CSECT
-*
-* CERN PROGLIB# M409 UHTOC .VERSION KERNIBX 1.01 900524
-* ORIG. NOV 83, R.MATTHEWS, CERN/DD
-* Modified for AIX, Roger Howard, January 1990
-*
-* CALL UHTOC (VI,NH,VC,NCH)
-*
-R0 EQU 0
-R1 EQU 1
-R2 EQU 2
-R3 EQU 3
-R4 EQU 4
-R5 EQU 5
-R6 EQU 6
-R7 EQU 7
-R8 EQU 8
-R9 EQU 9
-R10 EQU 10
-R11 EQU 11
-R12 EQU 12
-R13 EQU 13
-R14 EQU 14
-R15 EQU 15
-*
-* P R O L O G U E
-*
- USING *,R15
- ENTRY _uhtoc_
-_uhtoc_ STM R2,R12,16(R13)
- L R12,0(,R3) AIX: value of arg4 = NCH
- LR R11,R2 AIX: address of arg3 = VC
- L R10,0(,R1) AIX: value of arg2 = NH
- LR R9,R0 AIX: address of arg1 = VI
- LTR R12,R12 NHC=0 ?
- BZ EPILOGUE YES, BRANCH
- LA R4,4 R4 := 4
- CR R10,R4 IS NH > 4
- BNH LOOP1 NO, BRANCH
- LR R10,R4 DEFAULT NH=4
-*
-LOOP1 L R3,0(0,R9) R3 := NEXT INPUT WORD
- LR R5,R10 R5 := NH
- CR R5,R12 IS NH > NUMBER OF CHARACTERS REMAINING ?
- BNH LOOP2 NO, BRANCH
- LR R5,R12 R5 := NUMBER OF CHARACTERS REMAINING
-*
-LOOP2 SLDL R2,8 SHIFT ONE CHARACTER INTO R2
- STC R2,0(0,R11) STORE IT IN VC
- LA R11,1(0,R11) R11 -> NEXT LOCATION IN VC
- BCT R5,LOOP2 LOOP TO PROCESS THE NEXT CHARACTER
-*
- AR R9,R4 R9 -> NEXT INPUT WORD
- SR R12,R10 R12 := NUMBER OF CHARACTERS REMAINING
- BP LOOP1 LOOP TO PROCESS THE NEXT WORD
-*
-EPILOGUE EQU *
- LM R2,R12,16(R13)
- BR R14
- END
-#ifdef CERNLIB_TCGEN_UHTOC
-#undef CERNLIB_TCGEN_UHTOC
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/upkbyt.s b/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/upkbyt.s
deleted file mode 100644
index 6e87a52..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/upkbyt.s
+++ /dev/null
@@ -1,84 +0,0 @@
-*
-* $Id: upkbyt.s,v 1.1.1.1 1996/02/15 17:54:42 mclareni Exp $
-*
-* $Log: upkbyt.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:42 mclareni
-* Kernlib
-*
-*
-UPKBYT CSECT
-*
-* CERN PROGLIB# M422 UPKBYT .VERSION KERNIBX 1.01 900524
-* ORIG. FEB 83, R.MATTHEWS, CERN/DD
-* Modified for AIX, Roger Howard, February 1990
-*
-* CALL UPKBYT (A,JA,IY,N,MPACK)
-*
-R0 EQU 0
-R1 EQU 1
-R2 EQU 2
-R3 EQU 3
-R4 EQU 4
-R5 EQU 5
-R6 EQU 6
-R7 EQU 7
-R8 EQU 8
-R9 EQU 9
-R10 EQU 10
-R11 EQU 11
-R12 EQU 12
-R13 EQU 13
-R14 EQU 14
-R15 EQU 15
-*
- USING *,R15
- ENTRY _upkbyt_
-_upkbyt_ STM R2,R1,16(R13)
- L R6,88(,R13) AIX: address of arg5 = MPACK
- L R5,0(,R3) AIX: value of arg4 = N
- LTR R5,R5 N .LE. 0 ?
- BNP EPILOGUE YES, BRANCH
- LR R4,R2 AIX: address of arg3 = IY
- L R1,0(,R1) AIX: value of arg2 = JA
- LR R2,R0 AIX: address of arg1 = JA
- L R7,4(0,R6) R7 := INWORD
- L R6,0(0,R6) R6 := NBITS
- LTR R6,R6 NBITS .GT.0 ?
- BP L1 YES, BRANCH
- LA R6,1 R6 := 1 (NBITS)
- LA R7,32 R7 := 32 (INWORD)
-L1 SR R0,R0
- BCTR R1,0
- DR R0,R7
- SLL R1,2
- LA R2,0(R1,R2) R2 -> FIRST PACKED WORD
- LR R8,R7
- SR R8,R0 R8 := NUMBER OF 'BYTES' IN FIRST WORD
- LR R1,R0
- MR R0,R6
- L R0,0(0,R2) R0 := FIRST PACKED WORD
- SRL R0,0(R1) SHIFT OUT UNWANTED 'BYTES'
- BCTR R5,0
- SLL R5,2
- LA R5,0(R5,R4) R5 -> LAST TARGET WORD
- LR R3,R4 R3 -> FIRST TARGET WORD
- LA R4,4
- SR R3,R4
- LA R9,32
- SR R9,R6 R9 := NO. OF HIGH ORDER ZEROS IN TARGET
-L2 BXH R3,R4,EPILOGUE R3 -> NEXT TARGET WORD
- SRDL R0,0(R6) SHIFT NEXT 'BYTE' INTO TOP OF R1
- SRL R1,0(R9) SHIFT IT DOWN TO END OF R1
- ST R1,0(0,R3) STORE IT
- BCT R8,L2 BRANCH TO PROCESS THE NEXT 'BYTE'
- AR R2,R4 R2 -> NEXT PACKED WORD
- L R0,0(0,R2) R0 := NEXT PACKED WORD
- LR R8,R7 R8 := NUMBER OF 'BYTES' TO EXTRACT
- B L2
-EPILOGUE EQU *
- LM R2,R12,16(R13)
- BR R14
- END
-#ifdef CERNLIB_TCGEN_UPKBYT
-#undef CERNLIB_TCGEN_UPKBYT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/uswop.s b/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/uswop.s
deleted file mode 100644
index 8df9bd0..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/uswop.s
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: uswop.s,v 1.1.1.1 1996/02/15 17:54:43 mclareni Exp $
-*
-* $Log: uswop.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:43 mclareni
-* Kernlib
-*
-*
-USWOP CSECT
-*
-* CERN PROGLIB# V303 USWOP .VERSION KERNIBX 1.01 900524
-*
- USING *,15
- ENTRY _uswop_
-_uswop_ STM 2,8,16(13)
- L 4,0(,2) AIX: value of arg3
- LR 2,0 AIX: address of arg1
- LTR 4,4
- BZ RETURN
- LA 6,4
- SR 5,5
-NOCHMAL L 7,0(2,5)
- L 8,0(1,5) AIX: address of arg2 in GR1
- ST 7,0(1,5)
- ST 8,0(2,5)
- AR 5,6
- BCT 4,NOCHMAL
-RETURN DS 0H
- LM 2,8,16(13)
- BCR 15,14
- END
-#ifdef CERNLIB_TCGEN_USWOP
-#undef CERNLIB_TCGEN_USWOP
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/uzero.s b/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/uzero.s
deleted file mode 100644
index ac1ff29..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/uzero.s
+++ /dev/null
@@ -1,58 +0,0 @@
-*
-* $Id: uzero.s,v 1.1.1.1 1996/02/15 17:54:43 mclareni Exp $
-*
-* $Log: uzero.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:43 mclareni
-* Kernlib
-*
-*
-UZERO CSECT
-*
-* CERN PROGLIB# V300 UZERO .VERSION KERNIBX 1.01 900524
-*
-* CALL UZERO (A,N1,N2)
-* CALL UBLANK (A,N1,N2)
-*
-* ZERO / BLANK ROUTINES. USE THE MVCL INSTR.
-* PROTECTED AGAINST FIELD LENGTH OF ZERO
-* P. M. HEINEN NIJMEGEN SEPT. 73
-* SEPARATED FROM VZERO/VBLANK BY R.MATTHEWS, OCT 81
-* Modified for AIX, Roger Howard, January 1990
-*
- USING *,15
- ENTRY _uzero_
- ENTRY _ublank_
-_uzero_ STM 2,6,16(13)
- SR 5,5
- B ZB10
- USING *,15
-_ublank_ STM 2,6,16(13)
- LA 5,X'20' ... use ascii on AIX
- DROP 15
-ZB10 BALR 6,0
- USING *,6
- L 4,0(,2) AIX: value of arg3 = N2
- L 3,0(,1) AIX: value of arg2 = N1
- LR 2,0 AIX: address of arg1 = A
- S 3,=F'1'
- BC 4,ZBR
- SR 4,3
- BC 12,ZBR
- SLA 3,2
- LA 2,0(3,2) A(N1)
- SLA 4,2
- BC 12,ZBR
- SLL 5,24 PADD CHAR / ZERO LENGTH
- LR 3,4 LENGTH
- LR 4,2 ADRESS
- MVCL 2,4
-ZBR LM 2,6,16(13)
- BR 14
- LTORG
- END
-#ifdef CERNLIB_TCGEN_UBLANK
-#undef CERNLIB_TCGEN_UBLANK
-#endif
-#ifdef CERNLIB_TCGEN_UZERO
-#undef CERNLIB_TCGEN_UZERO
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/vfill.s b/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/vfill.s
deleted file mode 100644
index b9caf70..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/vfill.s
+++ /dev/null
@@ -1,50 +0,0 @@
-*
-* $Id: vfill.s,v 1.1.1.1 1996/02/15 17:54:43 mclareni Exp $
-*
-* $Log: vfill.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:43 mclareni
-* Kernlib
-*
-*
-VFILL CSECT
-*
-* CERN PROGLIB# F121 VFILL .VERSION KERNIBX 1.01 900524
-*
-* CODED FOR FAST EXECUTION H.WATKINS,LIVERPOOL JULY 1974
-* SEPARATED FROM VZERO/VBLANK BY R.MATTHEWS, OCT 81
-* Modified for AIX, Roger Howard, January 1990
-*
- USING *,15
- ENTRY _vfill_
-_vfill_ STM 2,12,16(13)
- LR 8,0 AIX: address of arg1
- LR 9,1 AIX: address of arg2
- L 2,0(2) AIX: value of arg3
- LR 0,2
- LR 1,0
- LR 3,0
- LR 4,0
- LR 5,0
- LR 6,0
- LR 7,0
- L 10,0(9)
- LTR 10,10
- BNP END
- SR 11,11
- SRDA 10,3
- LTR 10,10
- BNP BYPASS
-LOOP STM 0,7,0(8)
- LA 8,32(8)
- BCT 10,LOOP
-BYPASS SLDA 10,3
- BNP END
- BCTR 10,0
- EX 10,MSTOR
-END LM 2,12,16(13)
- BR 14
-MSTOR STM 0,0,0(8)
- END
-#ifdef CERNLIB_TCGEN_VFILL
-#undef CERNLIB_TCGEN_VFILL
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/vzero.s b/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/vzero.s
deleted file mode 100644
index f9c321c..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/vzero.s
+++ /dev/null
@@ -1,50 +0,0 @@
-*
-* $Id: vzero.s,v 1.1.1.1 1996/02/15 17:54:43 mclareni Exp $
-*
-* $Log: vzero.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:43 mclareni
-* Kernlib
-*
-*
-VZERO CSECT
-*
-* CERN PROGLIB# F121 VZERO .VERSION KERNIBX 1.01 900524
-*
-* CALL VZERO (A,N)
-* CALL VBLANK (A,N)
-*
-* ZERO / BLANK ROUTINES. USE THE MVCL INSTR.
-* PROTECTED AGAINST FIELD LENGTH OF ZERO
-* P. M. HEINEN NIJMEGEN SEPT. 73
-* SEPARATED FROM UZERO/UBLANK BY R.MATTHEWS, OCT 81
-* Modified for AIX, Roger Howard, January 1990
-*
- USING *,15
- ENTRY _vzero_
- ENTRY _vblank_
-_vzero_ STM 2,6,16(13)
- SR 5,5
- B ZB10
- USING *,15
-_vblank_ STM 2,6,16(13)
- LA 5,X'20' ... use ascii on AIX
- DROP 15
-ZB10 BALR 6,0
- USING *,6
- L 4,0(,1) AIX: value of arg2 = N
- LR 2,0 AIX: address of arg1 = A
- SLA 4,2
- BC 12,ZBR
- SLL 5,24 PADD CHAR / ZERO LENGTH
- LR 3,4 LENGTH
- LR 4,2 ADRESS
- MVCL 2,4
-ZBR LM 2,6,16(13)
- BR 14
- END
-#ifdef CERNLIB_TCGEN_VBLANK
-#undef CERNLIB_TCGEN_VBLANK
-#endif
-#ifdef CERNLIB_TCGEN_VZERO
-#undef CERNLIB_TCGEN_VZERO
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/xinb.F b/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/xinb.F
deleted file mode 100644
index 1b04d97..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/xinb.F
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: xinb.F,v 1.1.1.1 1996/02/15 17:54:43 mclareni Exp $
-*
-* $Log: xinb.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:43 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE XINB (LUN,XBV,NXB)
-C
-C CERN PROGLIB# Z203 XINB .VERSION KERNIBX 1.00 900101
-C
- COMMON /SLATE/ NXR, DUMMY(39)
- DIMENSION XBV(NXB)
-C
- READ (LUN,IOSTAT=JSTAT,NUM=NBYTES) NR,XBV
- IF (JSTAT) 61, 24, 64
- 24 NXR = NR
- NR = MIN (NR,NXB)
- NXB = MAX (NR,1)
- RETURN
-C
- 61 NXB = 0
- RETURN
-C
- 64 NXB = -JSTAT
- READ (LUN) NR
- RETURN
- END
-#ifdef CERNLIB_XVECT_XINB
-#undef CERNLIB_XVECT_XINB
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/xinbf.F b/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/xinbf.F
deleted file mode 100644
index ee27c79..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/xinbf.F
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: xinbf.F,v 1.1.1.1 1996/02/15 17:54:44 mclareni Exp $
-*
-* $Log: xinbf.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:44 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE XINBF (LUN,XBV,NXB)
-C
-C CERN PROGLIB# Z203 XINBF .VERSION KERNIBX 1.00 900101
-C
- DIMENSION XBV(NXB)
-C
- READ (LUN,IOSTAT=JSTAT,NUM=NBYTES) XBV
- IF (JSTAT) 61, 24, 64
- 24 NXB = MAX (1, NBYTES/4)
- RETURN
-C
- 61 NXB = 0
- RETURN
-C
- 64 NXB = -JSTAT
- READ (LUN) N
- RETURN
- END
-#ifdef CERNLIB_XVECT_XINBF
-#undef CERNLIB_XVECT_XINBF
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/xinbs.F b/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/xinbs.F
deleted file mode 100644
index b934843..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/xinbs.F
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: xinbs.F,v 1.1.1.1 1996/02/15 17:54:44 mclareni Exp $
-*
-* $Log: xinbs.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:44 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE XINBS (LUN,XAV,NA,XBV,NXB)
-C
-C CERN PROGLIB# Z203 XINBS .VERSION KERNIBX 1.00 900101
-C
- COMMON /SLATE/ NXR, DUMMY(39)
- DIMENSION XBV(NXB), XAV(NA)
-C
- READ (LUN,IOSTAT=JSTAT,NUM=NBYTES) NR,XAV,XBV
- IF (JSTAT) 61, 24, 64
- 24 NXR = NR
- NR = MIN (NR,NXB)
- NXB = MAX (NR,1)
- RETURN
-C
- 61 NXB = 0
- RETURN
-C
- 64 NXB = -JSTAT
- READ (LUN) N
- RETURN
- END
-#ifdef CERNLIB_XVECT_XINBS
-#undef CERNLIB_XVECT_XINBS
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/xincf.F b/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/xincf.F
deleted file mode 100644
index a06c978..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/xincf.F
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: xincf.F,v 1.1.1.1 1996/02/15 17:54:44 mclareni Exp $
-*
-* $Log: xincf.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:44 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE XINCF (LUN,XBV,NXB)
-C
-C CERN PROGLIB# Z203 XINCF .VERSION KERNIBX 1.00 900101
-C
- DIMENSION XBV(NXB)
-C
- READ (LUN,8000,END=61,ERR=64) XBV
- RETURN
-C
- 61 NXB = 0
- RETURN
-C
- 64 NXB = -7
- READ (LUN,8000) N
- RETURN
-C
- 8000 FORMAT (200(90A4))
- END
-#ifdef CERNLIB_XVECT_XINCF
-#undef CERNLIB_XVECT_XINCF
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/xoutcf.F b/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/xoutcf.F
deleted file mode 100644
index 07d5da2..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/xoutcf.F
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: xoutcf.F,v 1.1.1.1 1996/02/15 17:54:44 mclareni Exp $
-*
-* $Log: xoutcf.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:44 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE XOUTCF (LUN,BV,NB)
-C
-C CERN PROGLIB# Z203 XOUTCF .VERSION KERNIBX 1.00 900101
-C ORIG. 15/07/78 JZ
-C
- DIMENSION BV(NB)
-C
- WRITE (LUN,8000) BV
- RETURN
-C
- 8000 FORMAT (200(90A4))
- END
-#ifdef CERNLIB_XVECT_XOUTCF
-#undef CERNLIB_XVECT_XOUTCF
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/xsetio.F b/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/xsetio.F
deleted file mode 100644
index 2eaf3c4..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxgs/xsetio.F
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: xsetio.F,v 1.1.1.1 1996/02/15 17:54:44 mclareni Exp $
-*
-* $Log: xsetio.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:44 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE XSETIO
-C
-C CERN PROGLIB# XSETIO .VERSION KERNIBX 1.00 900101
-C
- CALL ERRSET (213,256,-1,1,1)
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxobsol/chdir.c b/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxobsol/chdir.c
deleted file mode 100644
index 987afe8..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxobsol/chdir.c
+++ /dev/null
@@ -1,49 +0,0 @@
-/*
- * $Id: chdir.c,v 1.1.1.1 1996/02/15 17:54:45 mclareni Exp $
- *
- * $Log: chdir.c,v $
- * Revision 1.1.1.1 1996/02/15 17:54:45 mclareni
- * Kernlib
- *
- */
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
-/*> ROUTINE CHDIR
- CERN PROGLIB# CHDIR .VERSION KERNIBX 1.02 900801
- ORIG. 20/07/90, JZ
- Fortran interface routine to chdir */
-#include <stdio.h>
- long chdir_(name, ann)
- char name[];
- long *ann;
-{
- int nname, jcol, nall, istat;
- char *ptname, *ptuse, *malloc();
- int chdir();
-
- nname = *ann;
- jcol = 0;
-
-/*-- find last non-blank of NAME */
- while (--nname >= 0)
- if (name[nname] != ' ') goto endn;
- goto blfi;
-endn: nname = nname + 1;
-
-/* get memory and copy NAME terminated */
-
- nall = nname + 6;
- ptname = malloc (nall);
- if (ptname == NULL) goto blfi;
-
- ptuse = ptname;
- while (jcol < nname) *ptuse++ = name[jcol++];
- *ptuse = '\0';
-
- istat = chdir (ptname);
- free (ptname);
- return istat;
-
-blfi: return 0;
-}
-/*> END <----------------------------------------------------------*/
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxobsol/getcwd.c b/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxobsol/getcwd.c
deleted file mode 100644
index 460aa96..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxobsol/getcwd.c
+++ /dev/null
@@ -1,40 +0,0 @@
-/*
- * $Id: getcwd.c,v 1.1.1.1 1996/02/15 17:54:45 mclareni Exp $
- *
- * $Log: getcwd.c,v $
- * Revision 1.1.1.1 1996/02/15 17:54:45 mclareni
- * Kernlib
- *
- */
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
-/*> ROUTINE GETCWD
- CERN PROGLIB# GETCWD .VERSION KERNIBX 1.02 900801
- ORIG. 20/07/90, JZ
- Fortran interface routine to getcwd */
-#include <stdio.h>
- void getcwd_(text, ant)
- char text[];
- long *ant;
-{
- int ntext, jcol;
- char *pttext, *getcwd();
-
- ntext = *ant;
- jcol = 0;
-
- pttext = getcwd (text, ntext);
- if (pttext == NULL) goto blfi;
-
-/*-- find the terminator in the returned path-name */
- while (jcol < ntext)
- { if (text[jcol] == '\0') goto blfi;
- ++jcol;
- }
- return;
-
-/* blank fill the trailing text */
-blfi: while (jcol < ntext) text[jcol++] = ' ';
- return;
-}
-/*> END <----------------------------------------------------------*/
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxobsol/getenv.c b/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxobsol/getenv.c
deleted file mode 100644
index 9ec37f8..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxobsol/getenv.c
+++ /dev/null
@@ -1,61 +0,0 @@
-/*
- * $Id: getenv.c,v 1.1.1.1 1996/02/15 17:54:45 mclareni Exp $
- *
- * $Log: getenv.c,v $
- * Revision 1.1.1.1 1996/02/15 17:54:45 mclareni
- * Kernlib
- *
- */
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
-/*> ROUTINE GETENV
- CERN PROGLIB# GETENV .VERSION KERNIBX 1.02 900801
- ORIG. 20/07/90, JZ
- Fortran interface routine to getenv */
-#include <stdio.h>
- void getenv_(name, text, ann, ant)
- char name[], text[];
- long *ann, *ant;
-{
- int nname, ntext;
- int jcol, nall;
- char ch;
- char *ptname, *ptuse, *pttx, *getenv(), *malloc();
-
- nname = *ann;
- ntext = *ant;
- jcol = 0;
-
-/*-- find last non-blank of NAME */
- while (--nname >= 0)
- if (name[nname] != ' ') goto endn;
- goto blfi;
-endn: nname = nname + 1;
-
-/* get memory and copy NAME terminated */
-
- nall = nname + 6;
- ptname = malloc (nall);
- if (ptname == NULL) goto blfi;
-
- ptuse = ptname;
- while (jcol < nname) *ptuse++ = name[jcol++];
- *ptuse = '\0';
-
- jcol = 0;
- pttx = getenv (ptname);
- if (pttx == NULL) goto free;
-
-/*-- copy the TEXT to caller */
- while (jcol < ntext)
- { ch = *pttx++;
- if (ch == '\0') goto free;
- text[jcol++] = ch;
- }
-free: free (ptname);
-
-/* blank fill the trailing text */
-blfi: while (jcol < ntext) text[jcol++] = ' ';
- return;
-}
-/*> END <----------------------------------------------------------*/
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxobsol/kwnocr.c b/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxobsol/kwnocr.c
deleted file mode 100644
index 680e827..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxobsol/kwnocr.c
+++ /dev/null
@@ -1,23 +0,0 @@
-/*
- * $Id: kwnocr.c,v 1.1.1.1 1996/02/15 17:54:45 mclareni Exp $
- *
- * $Log: kwnocr.c,v $
- * Revision 1.1.1.1 1996/02/15 17:54:45 mclareni
- * Kernlib
- *
- */
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
-/* SUBROUTINE KWNOCR(CHARST) */
-/* CHARACTER*(*) CHARST */
-/* write characters to the terminal */
-/* with no carriage return */
-/* note that with VS Fortran calling */
-/* conventions the string length */
-/* is in effect a second argument */
-#include <stdio.h>
-void kwnocr_(char charst[],int *number)
-{
-setbuf(stdout,NULL) ;
-fwrite(charst,1,*number,stdout) ;
-}
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxobsol/perror.c b/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxobsol/perror.c
deleted file mode 100644
index 32bdab1..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxobsol/perror.c
+++ /dev/null
@@ -1,41 +0,0 @@
-/*
- * $Id: perror.c,v 1.1.1.1 1996/02/15 17:54:45 mclareni Exp $
- *
- * $Log: perror.c,v $
- * Revision 1.1.1.1 1996/02/15 17:54:45 mclareni
- * Kernlib
- *
- */
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
-/*> ROUTINE PERROR
- CERN PROGLIB# PERROR .VERSION KERNIBX 1.02 900801
- ORIG. 20/07/90, JZ
- Fortran interface routine to perror */
-#include <stdio.h>
- void perror_ (text, ant)
- char text[];
- long *ant;
-{
- int ntext;
- int jcol, nall;
- char *pttext, *ptuse, *malloc();
-
- ntext = *ant;
-
-/* get memory and copy NAME terminated */
-
- nall = ntext + 6;
- pttext = malloc (nall);
- if (pttext == NULL) return;
-
- ptuse = pttext;
- jcol = 0;
- while (jcol < ntext) *ptuse++ = text[jcol++];
- *ptuse = '\0';
-
- perror (pttext);
- free (pttext);
- return;
-}
-/*> END <----------------------------------------------------------*/
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxobsol/qnexte.s b/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxobsol/qnexte.s
deleted file mode 100644
index 8a9ec38..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxobsol/qnexte.s
+++ /dev/null
@@ -1,58 +0,0 @@
-*
-* $Id: qnexte.s,v 1.1.1.1 1996/02/15 17:54:46 mclareni Exp $
-*
-* $Log: qnexte.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:46 mclareni
-* Kernlib
-*
-*
-QNEXTE CSECT
-*
-* CERN PROGLIB# Z041 QNEXTE .VERSION KERNIBX 1.01 900524
-*
-* FUNCTION: ON FIRST ENTRY, STANDARD REGISTER SAVING AND STACK
-* CHAINING ARE PERFORMED AND ROUTINE QNEXT IS CALLED.
-* ON RE-ENTRY, QNEXT IS CALLED AFTER THE ORIGINAL
-* STACK FRAME HAS BEEN RESTORED. WHEN CONTROL IS
-* RETURNED BY QNEXT, A STANDARD RETURN TO MAIN IS MADE.
-* AT ALL TIMES IT THEREFORE APPEARS, (E.G. IN A FORTRAN
-* TRACEBACK), AS THOUGH THE CHAIN OF CALLS WAS MAIN,
-* QNEXTE, QNEXT ... , AND A CHAIN OF RETURNS LEADS BACK
-* TO MAIN.
-*
-* CALLING SEQUENCE: CALL QNEXTE
-*
-* ORIGINAL VERSION : R. MATTHEWS, CERN/DD, OCTOBER 1981.
-*
- USING *,15
- ENTRY _qnexte_
-_qnexte_ STM 2,1,16(13)
- LR 4,13 caller's stack pointer
- S 13,=F'144' set up stack frame
- ST 4,4(0,13) chain to previous frame
- BALR 12,0 GR12 is base register
- DROP 15
- USING *,12
- L 11,=A(DAREA) GR11 addresses data
- USING DAREA,11
- CLI EFLAG,1 first entry?
- BNE CALL no: branch
- ST 4,ANCHOR save original caller's stack frame
- MVI EFLAG,0 turn off first entry flag
-CALL L 0,=F'-1' no subroutine arguments
- L 15,=V(_qnext_) GR15 -> QNEXT
- BALR 14,15 branch to QNEXT
- L 13,ANCHOR restore original caller's stack frame
- LM 2,1,16(13) ... then restore registers
- BR 14 ... and return
- LTORG literals must be in CSECT
-DAREA PSECT data segment
-ANCHOR DC F'0' stack frame address
-EFLAG DC X'01' first entry flag
- END
-#ifdef CERNLIB_CCGEN_QNEXTE
-#undef CERNLIB_CCGEN_QNEXTE
-#endif
-#ifdef CERNLIB_TCGEN_QNEXTE
-#undef CERNLIB_TCGEN_QNEXTE
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxobsol/rename.c b/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxobsol/rename.c
deleted file mode 100644
index 05d5e7a..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxobsol/rename.c
+++ /dev/null
@@ -1,71 +0,0 @@
-/*
- * $Id: rename.c,v 1.1.1.1 1996/02/15 17:54:46 mclareni Exp $
- *
- * $Log: rename.c,v $
- * Revision 1.1.1.1 1996/02/15 17:54:46 mclareni
- * Kernlib
- *
- */
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
-/*> ROUTINE RENAME
- CERN PROGLIB# RENAME .VERSION KERNIBX 1.02 900801
- ORIG. 20/07/90, JZ
- Fortran interface routine to rename */
-#include <stdio.h>
- int rename_ (frpath, topath, anfr, anto)
- char frpath[], topath[];
- long *anfr, *anto;
-{
- int nnfr, ncolfr, nnto, ncolto;
- int jcol, nall, istat;
- char *ptall, *ptfr, *ptto, *ptuse;
- char *malloc();
- int rename();
-
- nnfr = *anfr;
- nnto = *anto;
- istat= -1;
-
-/*-- find last blank of from-path */
- ncolfr = nnfr;
- while (--ncolfr >= 0)
- if (frpath[ncolfr] != ' ') goto endfr;
- goto home;
-
-endfr: ncolfr = ncolfr + 1;
-
-/*-- find last blank of to-path */
- ncolto = nnto;
- while (--ncolto >= 0)
- if (topath[ncolto] != ' ') goto endto;
- goto home;
-
-endto: ncolto = ncolto + 1;
-
-/* get memory and copy file-names terminated */
-
- nall = ncolfr + ncolto + 6;
- ptall = malloc (nall);
- if (ptall == NULL) goto home;
-
- ptfr = ptall;
- ptuse = ptall;
-
- jcol = 0;
- while (jcol < ncolfr) *ptuse++ = frpath[jcol++];
- *ptuse++ = '\0';
-
- ptto = ptuse;
- jcol = 0;
- while (jcol < ncolto) *ptuse++ = topath[jcol++];
- *ptuse = '\0';
-
-/* execute the RENAME */
-
- istat = rename (ptfr, ptto);
-
- free (ptall);
-home: return istat;
-}
-/*> END <----------------------------------------------------------*/
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxsys/datime.F b/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxsys/datime.F
deleted file mode 100644
index 16963b5..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxsys/datime.F
+++ /dev/null
@@ -1,36 +0,0 @@
-*
-* $Id: datime.F,v 1.1.1.1 1996/02/15 17:54:44 mclareni Exp $
-*
-* $Log: datime.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:44 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE DATIME (ND,NT)
-C
-C CERN PROGLIB# Z007 DATIME .VERSION KERNIBX 1.00 900307
-C ORIG. 13/10/89 JZ
-C
-C- CALL DATIME (ND,NT) RETURNS INTEGER DATE ND = YYMMDD
-C- INTEGER TIME NT = HHMM
-C
- COMMON /SLATE/ MM(10), INF(30)
-
-
- CALL DATIM (INF)
-
- DO 24 J=1,6
- 24 MM(J) = INF(9-J)
-
- ND = (MOD(MM(1),100)*100+MM(2))*100 + MM(3)
- NT = MM(4) *100 + MM(5)
- RETURN
- END
-#ifdef CERNLIB_CCGEN_DATIME
-#undef CERNLIB_CCGEN_DATIME
-#endif
-#ifdef CERNLIB_TCGEN_DATIME
-#undef CERNLIB_TCGEN_DATIME
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxsys/datimh.F b/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxsys/datimh.F
deleted file mode 100644
index 4ee2d42..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxsys/datimh.F
+++ /dev/null
@@ -1,38 +0,0 @@
-*
-* $Id: datimh.F,v 1.1.1.1 1996/02/15 17:54:44 mclareni Exp $
-*
-* $Log: datimh.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:44 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE DATIMH(ND,NT)
-C
-C CERN PROGLIB# Z007 DATIMH .VERSION KERNIBX 1.00 900123
-C
-C use VS FORTRAN Version 2 Library routine DATIM
-C
- DIMENSION ND(2),NT(2)
- DIMENSION I(8)
- DIMENSION L(4)
- EQUIVALENCE(L(1),STRG)
- CHARACTER*16 STRG
-
- CALL DATIM(I)
- I(8) = MOD(I(8),100)
- WRITE(STRG,1) I(6),I(7),I(8),I(5),I(4),I(3)
-1 FORMAT(I2.2,'/',I2.2,'/',I2.2,I2.2,'.',I2.2,'.',I2.2)
- ND(1) = L(1)
- ND(2) = L(2)
- NT(1) = L(3)
- NT(2) = L(4)
- RETURN
- END
-#ifdef CERNLIB_CCGEN_DATIMH
-#undef CERNLIB_CCGEN_DATIMH
-#endif
-#ifdef CERNLIB_TCGEN_DATIMH
-#undef CERNLIB_TCGEN_DATIMH
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxsys/getarg.s b/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxsys/getarg.s
deleted file mode 100644
index 1d2aaa8..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxsys/getarg.s
+++ /dev/null
@@ -1,50 +0,0 @@
-*
-* $Id: getarg.s,v 1.1.1.1 1996/02/15 17:54:44 mclareni Exp $
-*
-* $Log: getarg.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:44 mclareni
-* Kernlib
-*
-*
-GETARG CSECT
-*
-* CERN PROGLIB# Z264 GETARG .VERSION KERNIBX 1.01 900524
-* ORIG. March 90, Roger Howard, Vancouver
-*
-* SUBROUTINE GETARG(N,ARG)
-* Return character string ARG: Nth command line argument
-*
- USING *,15
- ENTRY _getarg_
-_getarg_ STM 2,8,16(13) Save registers
- L 3,0(,3) GR3: length of arg2 = ARG
- LR 2,1 GR2: ADDRESS OF ARG2 = ARG
-FILL MVI 0(2),C' ' Fill next byte with blank
- LA 2,1(,2) Advance to next byte
- BCT 3,FILL Repeat for length of ARG
- LR 2,13 GR2: caller's stack frame
- L 3,4(,2) GR3: previous stack frame
-AGAIN L 4,4(,3) pointer in previous stack frame
- LTR 4,4 Check for end of chain
- BC 8,FOUND
- LR 2,3 Move up chain
- LR 3,4
- BC 15,AGAIN
-FOUND L 5,76(,2) GR5: main entry value of GR1
- LR 6,0
- L 6,0(,6) value of arg1 = N
- SLL 6,2 4*N
- L 7,0(6,5) address of Nth ARG
- LR 8,7 copy starting address
-NEXT CLI 0(7),X'00' Is byte a hex zero?
- BC 8,RETURN
- LA 7,1(,7) Address of next byte
- BC 15,NEXT
-RETURN SR 7,8 Byte count minus 1
- BC 12,EXIT Exit on count less than 1
- BCTR 7,0 Remove trailing hex 0
- EX 7,COPY Copy string
-EXIT LM 2,8,16(13)
- BCR 15,14
-COPY MVC 0(0,1),0(8)
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxsys/goparm.s b/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxsys/goparm.s
deleted file mode 100644
index 9db7537..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxsys/goparm.s
+++ /dev/null
@@ -1,48 +0,0 @@
-*
-* $Id: goparm.s,v 1.1.1.1 1996/02/15 17:54:44 mclareni Exp $
-*
-* $Log: goparm.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:44 mclareni
-* Kernlib
-*
-*
-GOPARM CSECT
-*
-* CERN PROGLIB# Z262 GOPARM .VERSION KERNIBX 1.01 900524
-* ORIG. March 90, Roger Howard, Vancouver
-*
-* SUBROUTINE GOPARM(LENGTH,PARMS)
-* Return command line parameter as character string PARMS
-*
- USING *,15
- ENTRY _goparm_
-_goparm_ STM 2,6,16(13) Save registers
- LR 2,13 GR2: caller's stack frame
- L 3,4(,2) GR3: previous stack frame
-AGAIN L 4,4(,3) pointer in previous stack frame
- LTR 4,4 Check for end of chain
- BC 8,FOUND
- LR 2,3 Move up chain
- LR 3,4
- BC 15,AGAIN
-FOUND LM 2,3,72(2) GR0 and GR1 on entry to main
- SR 4,4 zero character count
- BCT 2,GETPAR parameter word count - 1
- BC 15,RETURN
-GETPAR L 5,4(,3) address of 1st word
-NEXT CLI 0(5),X'00' Is byte a hex zero?
- BC 7,MORE
- CLI 1(5),X'00' Is there another hex zero?
- BC 8,RETURN
- MVI 0(1),C' ' replace it with blank
- BC 15,ADVANCE
-MORE MVC 0(1,1),0(5) copy character to arg2
-ADVANCE LA 5,1(,5) Address of next byte
- LA 1,1(,1) Next result byte
- LA 4,1(,4) Increment count
- BC 15,NEXT
-RETURN LR 6,0 Address of arg1 = LENGTH
- ST 4,0(,6) Return arg1 value
- LM 2,6,16(13)
- BCR 15,14
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxsys/iargc.s b/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxsys/iargc.s
deleted file mode 100644
index f08727d..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxsys/iargc.s
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: iargc.s,v 1.1.1.1 1996/02/15 17:54:44 mclareni Exp $
-*
-* $Log: iargc.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:44 mclareni
-* Kernlib
-*
-*
-IARGC CSECT
-*
-* CERN PROGLIB# Z264 IARGC .VERSION KERNIBX 1.01 900524
-* ORIG. March 90, Roger Howard, Vancouver
-*
-* FUNCTION IARGC() returns number of words on command line
-*
- USING *,15
- ENTRY _iargc_
-_iargc_ STM 2,4,16(13) Save registers
- LR 2,13 GR2: caller's stack frame
- L 3,4(,2) GR3: previous stack frame
-AGAIN L 4,4(,3) GR4: pointer in previous frame
- LTR 4,4 Check for end of chain
- BC 8,FOUND
- LR 2,3 Move up chain
- LR 3,4
- BC 15,AGAIN
-FOUND L 0,72(,2) GR0 restored to main entry value
- BCTR 0,0 Reduce count by one
- LM 2,4,16(13)
- BCR 15,14
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxsys/jumpad.s b/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxsys/jumpad.s
deleted file mode 100644
index 7824b65..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxsys/jumpad.s
+++ /dev/null
@@ -1,66 +0,0 @@
-*
-* $Id: jumpad.s,v 1.1.1.1 1996/02/15 17:54:44 mclareni Exp $
-*
-* $Log: jumpad.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:44 mclareni
-* Kernlib
-*
-*
-JUMPAD CSECT
-*
-* CERN PROGLIB# Z042 JUMPAD .VERSION KERNIBX 1.01 900524
-* ORIG. March 90, Roger Howard, Vancouver
-*
-* INTEGER FUNCTION JUMPAD(TARGET)
-* Return address of routine TARGET
-*
- ENTRY _jumpad_
-_jumpad_ ST 2,16(,13)
- LR 2,0 Address of function argument
- L 0,0(,2) Return value of argument
- L 2,16(,13)
- BCR 15,14
-*
-* SUBROUTINE JUMPST(IAD)
-* Set the transfer address for calls to JUMPXn
-*
- USING *,15
- ENTRY _jumpst_
-_jumpst_ L 15,=A(DATA)
- ST 2,16(,13)
- LR 2,0 Address of argument
- L 2,0(,2) Value of argument
- USING DATA,15
- ST 2,ROUTINE Save argument in data segment
- L 2,16(,13)
- BCR 15,14
-*
-* SUBROUTINE JUMPXn(args)
-* Execute transfer to routine whose address is set
-*
-* In assembler the transfer can be made transparent by
-* simply changing the transfer address in GR15 and
-* branching to it; any arguments in GR0 through GR3 or
-* on the stack are then automatically arguments to the
-* transfer routine.
-*
- USING *,15
- ENTRY _jumpx0_
- ENTRY _jumpx1_
- ENTRY _jumpx2_
-_jumpx0_ DS 0H
-_jumpx1_ DS 0H
-_jumpx2_ L 15,=A(DATA)
- USING DATA,15
- L 15,ROUTINE Retrieve the transfer address
- BCR 15,15 and branch to it
- LTORG
-DATA PSECT
-ROUTINE DS F
- END
-#ifdef CERNLIB_CCGEN_JUMPXN
-#undef CERNLIB_CCGEN_JUMPXN
-#endif
-#ifdef CERNLIB_TCGEN_JUMPXN
-#undef CERNLIB_TCGEN_JUMPXN
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxsys/noarg.s b/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxsys/noarg.s
deleted file mode 100644
index 7e96465..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxsys/noarg.s
+++ /dev/null
@@ -1,72 +0,0 @@
-*
-* $Id: noarg.s,v 1.1.1.1 1996/02/15 17:54:44 mclareni Exp $
-*
-* $Log: noarg.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:44 mclareni
-* Kernlib
-*
-*
-NOARG CSECT
-*
-* CERN PROGLIB# Z029 NOARG .VERSION KERNIBX 1.01 900524
-* ORIG. March 90, Roger Howard, Vancouver
-*
-* THIS IS A SUBROUTINE TO DETERMINE THE NUMBER OF ARGS
-* CALLING SEQUENCE : "CALL NOARG(N)"
-*
-* AIX calling sequence: argument addresses are placed in
-* GR0, GR1, GR2, GR3 and then successive stack locations
-* starting at byte 88. The list is terminated by fullword
-* "-1", or by "-2" if it is of double length because
-* there are character arguments.
-* Roger Howard, UBC, Vancouver. 1990/01/25
-*
- USING *,15
- ENTRY _noarg_
-_noarg_ STM 2,1,16(13) save registers
- LR 11,0 argument address
- L 9,4(,13) get previous save area
- SR 0,0 initialize result counter
- LA 8,1 GR8 = 1
- LM 1,2,72(9) previous registers 0 and 1
- AR 1,8 is 1st address -1?
- BC 8,MINUS1
- AR 1,8 is 1st address -2?
- BC 8,MINUS2
- AR 0,8 there is 1 argument
- AR 2,8 is 2nd address -1?
- BC 8,MINUS1
- AR 2,8 is 2nd address -2?
- BC 8,MINUS2
- AR 0,8 there are 2 arguments
- LM 2,3,16(9) previous registers 2 and 3
- AR 2,8 is 3rd address -1?
- BC 8,MINUS1
- AR 2,8 is 3rd address -2?
- BC 8,MINUS2
- AR 0,8 there are 3 arguments
- AR 3,8 is 4th address -1?
- BC 8,MINUS1
- AR 3,8 is 4th address -2?
- BC 8,MINUS2
- AR 0,8 there are 4 arguments
- LA 1,88(,9) stack location of next parameters
-LOOP L 2,0(,1) next parameter
- AR 2,8 is it -1?
- BC 8,MINUS1
- AR 2,8 is it -2?
- BC 8,MINUS2
- AR 0,8 increment argument count
- LA 1,4(,1) address next parameter
- BC 15,LOOP
-MINUS2 SRL 0,1 halve count for character arguments
-MINUS1 ST 0,0(,11) return argument to caller
- LM 2,1,16(13)
- BR 14
- END
-#ifdef CERNLIB_CCGEN_NOARG
-#undef CERNLIB_CCGEN_NOARG
-#endif
-#ifdef CERNLIB_TCGEN_NOARG
-#undef CERNLIB_TCGEN_NOARG
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxsys/signal.c b/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxsys/signal.c
deleted file mode 100644
index 1995644..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxsys/signal.c
+++ /dev/null
@@ -1,40 +0,0 @@
-/*
- * $Id: signal.c,v 1.1.1.1 1996/02/15 17:54:45 mclareni Exp $
- *
- * $Log: signal.c,v $
- * Revision 1.1.1.1 1996/02/15 17:54:45 mclareni
- * Kernlib
- *
- */
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
-/*> ROUTINE SIGNAL
- CERN PROGLIB# SIGNAL .VERSION KERNIBX 1.02 900801
- ORIG. 20/07/90, JZ + RH
- FORTRAN interface routine to sigaction */
-#include <stdio.h>
-#include <signal.h>
- int signal_(asigno,funct,aflag)
- long *asigno, *aflag;
- void (**funct)();
-{
- int sigaction();
- int istat, signo;
-
- struct sigaction {
- void (*sa_handler)();
- sigset_t sa_mask;
- int sa_flags;
- };
-
- struct sigaction buf;
-
- signo = *asigno;
- buf.sa_handler = *funct;
- buf.sa_flags = SA_RESTART;
- sigemptyset(&buf.sa_mask);
-
- istat = sigaction(signo,&buf,NULL);
- return istat;
-}
-/*> END <----------------------------------------------------------*/
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxsys/signalf.c b/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxsys/signalf.c
deleted file mode 100644
index 1a51394..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxsys/signalf.c
+++ /dev/null
@@ -1,51 +0,0 @@
-/*
- * $Id: signalf.c,v 1.1.1.1 1996/02/15 17:54:45 mclareni Exp $
- *
- * $Log: signalf.c,v $
- * Revision 1.1.1.1 1996/02/15 17:54:45 mclareni
- * Kernlib
- *
- */
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
-/*> ROUTINE SIGNALF
- CERN PROGLIB# SIGNALF .VERSION KERNIBX 1.03 910315
- ORIG. 12/03/91, JZ
- FORTRAN interface routine to sigaction */
-#include <stdio.h>
-#include <signal.h>
-#include <errno.h>
-int signalf_(signum,funct,flag)
-int *signum, *flag;
- int *funct;
-{
- int sigaction();
- int istat, signo;
-
- struct mysig {
- int sa_handler;
- sigset_t sa_mask;
- int sa_flags;
- };
-
- struct mysig newbuf;
- struct mysig oldbuf;
-
- signo = *signum;
-
- if (*flag < 0) newbuf.sa_handler = *funct;
- else if (*flag == 0) newbuf.sa_handler = (int)SIG_DFL;
- else if (*flag == 1) newbuf.sa_handler = (int)SIG_IGN;
- else newbuf.sa_handler = *flag;
-
- newbuf.sa_flags = 0;
- sigemptyset(&newbuf.sa_mask);
-
- istat = sigaction(signo,&newbuf,&oldbuf);
- if (istat == 0) return oldbuf.sa_handler;
- return -errno;
-}
-/*> END <----------------------------------------------------------*/
-#ifdef CERNLIB_CCGEN_SIGNALF
-#undef CERNLIB_CCGEN_SIGNALF
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxsys/system.c b/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxsys/system.c
deleted file mode 100644
index 318da5e..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxsys/system.c
+++ /dev/null
@@ -1,41 +0,0 @@
-/*
- * $Id: system.c,v 1.1.1.1 1996/02/15 17:54:45 mclareni Exp $
- *
- * $Log: system.c,v $
- * Revision 1.1.1.1 1996/02/15 17:54:45 mclareni
- * Kernlib
- *
- */
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
-/*> ROUTINE SYSTEM
- CERN PROGLIB# SYSTEM .VERSION KERNIBX 1.02 900801
- ORIG. 20/07/90, JZ
- Fortran interface routine to system */
-#include <stdio.h>
- int system_ (text, anc)
- char text[];
- long *anc;
-{
- int ncmd, jcol, istat;
- char ch;
- int system();
-
- ncmd = *anc;
-
-/*-- find last blank of command line */
- jcol = ncmd;
- while (--jcol >= 0)
- if (text[jcol] != ' ') goto endn;
- return 7;
-
-endn: jcol = jcol + 1;
- ch = text[jcol];
- text[jcol] = '\0';
-
- istat = system (text);
-
- text[jcol] = ch;
- return istat;
-}
-/*> END <----------------------------------------------------------*/
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxsys/timex.F b/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxsys/timex.F
deleted file mode 100644
index 494a819..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxsys/timex.F
+++ /dev/null
@@ -1,84 +0,0 @@
-*
-* $Id: timex.F,v 1.1.1.1 1996/02/15 17:54:45 mclareni Exp $
-*
-* $Log: timex.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:45 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE TIMEX (T)
-C
-C CERN PROGLIB# Z007 TIMEX etc .VERSION KERNIBX 1.02 900801
-C ORIG. 20/07/90 RH
-C
- LOGICAL FIRST
- REAL*8 TEND, BASE, LAST, NOW, DDB
- SAVE TEND, BASE, LAST, TLORG, FIRST
- PARAMETER (FACT = 1.E-6)
-
- DATA FIRST / .TRUE. /
- DATA LAST / 0.0 /
-
- IF (FIRST) THEN
- T = 0.
- RETURN
- ENDIF
-
- CALL CPUTIME (NOW,IRC)
- DDB = NOW - BASE
- T = DDB * FACT
- RETURN
-
-C---- TIMEL
-
- ENTRY TIMEL (T)
-
- IF (FIRST) THEN
- T = 999.
- RETURN
- ENDIF
-
- CALL CPUTIME (NOW,IRC)
- DDB = TEND - NOW
- T = DDB * FACT
- RETURN
-
-C---- TIMEST
-
- ENTRY TIMEST (TLIM)
-
- IF (.NOT.FIRST) RETURN
- TLORG = TLIM
- CALL CPUTIME (NOW,IRC)
- BASE = NOW
- TEND = BASE + TLORG
- FIRST = .FALSE.
- RETURN
-
-C---- TIMED
-
- ENTRY TIMED (T)
-
- CALL CPUTIME (NOW,IRC)
- DDB = NOW - LAST
- LAST = NOW
- T = DDB * FACT
- RETURN
- END
-#ifdef CERNLIB_CCGEN_TIMEL
-#undef CERNLIB_CCGEN_TIMEL
-#endif
-#ifdef CERNLIB_TCGEN_TIMEX
-#undef CERNLIB_TCGEN_TIMEX
-#endif
-#ifdef CERNLIB_TCGEN_TIMEL
-#undef CERNLIB_TCGEN_TIMEL
-#endif
-#ifdef CERNLIB_TCGEN_TIMED
-#undef CERNLIB_TCGEN_TIMED
-#endif
-#ifdef CERNLIB_TCGEN_TIMEST
-#undef CERNLIB_TCGEN_TIMEST
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxsys/traceq.F b/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxsys/traceq.F
deleted file mode 100644
index 1bc5332..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/ibxsys/traceq.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: traceq.F,v 1.1.1.1 1996/02/15 17:54:45 mclareni Exp $
-*
-* $Log: traceq.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:45 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE TRACEQ (LUNP,NP)
-C
-C CERN PROGLIB# N105 TRACEQ .VERSION KERNIBX 1.00 900101
-C ORIG. 12/09/89 JZ
-C
-C- SUBROUTINE TO PRINT THE FORTRAN SUBROUTINE TRACE-BACK
-C
- CALL ERRTRA
- RETURN
- END
-#ifdef CERNLIB_CCGEN_TRACEQ
-#undef CERNLIB_CCGEN_TRACEQ
-#endif
-#ifdef CERNLIB_TCGEN_TRACEQ
-#undef CERNLIB_TCGEN_TRACEQ
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/inhibit.list b/src/packlib/kernlib/kerngen/obsolete/kernibx/inhibit.list
deleted file mode 100644
index 45268c0..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/inhibit.list
+++ /dev/null
@@ -1,123 +0,0 @@
-tcgen/lvmin
-tcgen/lvmax
-tcgen/lvmaxa
-tcgen/lvmina
-tcgen/lvsmi
-tcgen/lvsmx
-tcgen/lvsdmi
-tcgen/lvsdmx
-tcgen/lvsimi
-tcgen/lvsimx
-tcgen/ranecu
-ibxgs/ubunch
-tcgen/ubunch
-tcgen/ublow
-tcgen/vadd
-tcgen/vsub
-tcgen/vmul
-tcgen/vbias
-tcgen/vscale
-tcgen/vlinco
-tcgen/vunit
-tcgen/vmatr
-tcgen/vmatl
-tcgen/vcopyn
-tcgen/vfix
-tcgen/vfloat
-tcgen/vexcum
-tcgen/vdist2
-tcgen/vdist
-tcgen/vdot
-tcgen/vdotn2
-tcgen/vdotn
-tcgen/vmod
-tcgen/vasum
-tcgen/vsum
-tcgen/vmaxa
-tcgen/vmax
-tcgen/vmina
-tcgen/vmin
-tcgen/kerngt
-tcgen/bitpos
-tcgen/blow
-tcgen/bunch
-tcgen/cbyt
-tcgen/floarg
-tcgen/ibits
-tcgen/ie3fod
-tcgen/ie3fos
-tcgen/ie3tod
-tcgen/ie3tos
-tcgen/incbyt
-tcgen/intarg
-tcgen/iubin
-tcgen/iuchan
-tcgen/iucomp
-tcgen/iufind
-tcgen/iulast
-tcgen/iulook
-tcgen/iunext
-tcgen/iusame
-tcgen/jbit
-tcgen/jbyt
-tcgen/jbytet
-tcgen/lenocc
-tcgen/lnblnk
-ccgen/locb
-tcgen/locb
-ccgen/locf
-tcgen/locf
-tcgen/mbytet
-tcgen/mbytor
-tcgen/mcbyt
-tcgen/msbit
-tcgen/msbit0
-tcgen/msbit1
-tcgen/msbyt
-tcgen/pkbyt
-tcgen/sbit
-tcgen/sbit0
-tcgen/sbit1
-tcgen/sbyt
-tcgen/sbytor
-tcgen/ubits
-tcgen/ubunch
-tcgen/ublow
-tcgen/ucocop
-tcgen/ucopiv
-tcgen/ucopy
-tcgen/ucopy2
-tcgen/ucopyn
-tcgen/ufill
-tcgen/uhtoc
-tcgen/uh1toc
-tcgen/upkbyt
-tcgen/uswop
-tcgen/ublank
-tcgen/uzero
-tcgen/vfill
-tcgen/vblank
-tcgen/vzero
-xvect/xinb
-xvect/xinbf
-xvect/xinbs
-xvect/xincf
-xvect/xoutcf
-ccgen/datime
-tcgen/datime
-ccgen/datimh
-tcgen/datimh
-ccgen/jumpxn
-tcgen/jumpxn
-ccgen/noarg
-tcgen/noarg
-ccgen/signalf
-ccgen/timel
-tcgen/timex
-tcgen/timel
-tcgen/timed
-tcgen/timest
-ccgen/traceq
-tcgen/traceq
-ccgen/qnexte
-tcgen/qnexte
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/kernibx/q_andor.inc b/src/packlib/kernlib/kerngen/obsolete/kernibx/kernibx/q_andor.inc
deleted file mode 100644
index 528ca56..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/kernibx/q_andor.inc
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: q_andor.inc,v 1.1.1.1 1996/02/15 17:54:30 mclareni Exp $
-*
-* $Log: q_andor.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:54:30 mclareni
-* Kernlib
-*
-*
-#ifndef CERNLIB_KERNIBX_Q_ANDOR_INC
-#define CERNLIB_KERNIBX_Q_ANDOR_INC
-*
-*
-* q_andor.inc
-*
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/kernibx/q_shift.inc b/src/packlib/kernlib/kerngen/obsolete/kernibx/kernibx/q_shift.inc
deleted file mode 100644
index 509a013..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/kernibx/q_shift.inc
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: q_shift.inc,v 1.1.1.1 1996/02/15 17:54:30 mclareni Exp $
-*
-* $Log: q_shift.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:54:30 mclareni
-* Kernlib
-*
-*
-#ifndef CERNLIB_KERNIBX_Q_SHIFT_INC
-#define CERNLIB_KERNIBX_Q_SHIFT_INC
-*
-*
-* q_shift.inc
-*
- ISHFTL (IZW,NZB) = ISHFT (IZW, NZB)
- ISHFTR (IZW,NZB) = ISHFT (IZW,-NZB)
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/kernibx/qmibx.h b/src/packlib/kernlib/kerngen/obsolete/kernibx/kernibx/qmibx.h
deleted file mode 100644
index a89d91e..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/kernibx/qmibx.h
+++ /dev/null
@@ -1,53 +0,0 @@
-*
-* $Id: qmibx.h,v 1.1.1.1 1996/02/15 17:54:30 mclareni Exp $
-*
-* $Log: qmibx.h,v $
-* Revision 1.1.1.1 1996/02/15 17:54:30 mclareni
-* Kernlib
-*
-*
-* This directory was created from kernibx.car patch qmibx
-#ifndef CERNLIB_A4
-#define CERNLIB_A4
-#endif
-#ifndef CERNLIB_B32
-#define CERNLIB_B32
-#endif
-#ifndef CERNLIB_HEX
-#define CERNLIB_HEX
-#endif
-* Normal Unix system machine
-#ifndef CERNLIB_QMUIX
-#define CERNLIB_QMUIX
-#endif
-* Posix call for setjmp/longjmp
-#ifndef CERNLIB_QSIGJMP
-#define CERNLIB_QSIGJMP
-#endif
-* Double indirect adr for externals
-#ifndef CERNLIB_QCCINDAD
-#define CERNLIB_QCCINDAD
-#endif
-#ifndef CERNLIB_QX_SCEXTERNALNAMESWITHUNDERSCORES
-#define CERNLIB_QX_SCEXTERNALNAMESWITHUNDERSCORES
-#endif
-* Character set is ASCII
-#ifndef CERNLIB_QASCII
-#define CERNLIB_QASCII
-#endif
-* Hollerith constants exist
-#ifndef CERNLIB_QHOLL
-#define CERNLIB_QHOLL
-#endif
-* EQUIVALENCE Hollerith/Character ok
-#ifndef CERNLIB_EQUHOLCH
-#define CERNLIB_EQUHOLCH
-#endif
-* Orthodox Hollerith storage left to right
-#ifndef CERNLIB_QORTHOLL
-#define CERNLIB_QORTHOLL
-#endif
-* ISA standard functions available
-#ifndef CERNLIB_QISASTD
-#define CERNLIB_QISASTD
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/lvmax.s b/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/lvmax.s
deleted file mode 100644
index 98e62ce..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/lvmax.s
+++ /dev/null
@@ -1,53 +0,0 @@
-*
-* $Id: lvmax.s,v 1.1.1.1 1996/02/15 17:54:31 mclareni Exp $
-*
-* $Log: lvmax.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:31 mclareni
-* Kernlib
-*
-*
-LVMAX CSECT
-* CERN PROGLIB# F121 LVMAX .VERSION KERNIBX 1.01 900525
-* ORIG. 29/05/89 C.Guerin, IBM
-* Modified for AIX, April 1990, Roger Howard
-*
- USING *,15
- ENTRY _lvmax_
-_lvmax_ STM 2,5,16(13)
-*
- LR G4,G0 AIX: address of arg1
- L G5,0(,G1) AIX: value of arg2
- LTR G5,G5 TEST IF LEN = 0
- BZ ZERO IF LEN = 0 GO TO ZERO
- LE F0,KF GET MAX NEGATIVE
- LA G0,1 GET 1
- SR G2,G2 ZERO G2 FOR WORK
- SR G3,G3 ZERO G3 FOR WORK
-VLOOP EQU *
- VLVCU G5 SET LOOP
- VLE V0,G4 LOAD V0 WITH A VECTOR
- VMXSE V0,F0,G2 FIND MAXIMUM IN G2
- BC 2,VLOOP LOOP
- AR G0,G2 ADD 1
-* END SUBROUTINE *
-RETURN EQU *
- LM 2,5,16(13)
- BR 14
-ZERO EQU *
- SR G0,G0
- B RETURN
-* CONSTANTS *
- DS 0D
-KF DC X'FFFFFFFF'
-V0 EQU 0
-G0 EQU 0
-G1 EQU 1
-G2 EQU 2
-G3 EQU 3
-G4 EQU 4
-G5 EQU 5
-F0 EQU 0
- END
-#ifdef CERNLIB_TCGEN_LVMAX
-#undef CERNLIB_TCGEN_LVMAX
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/lvmaxa.s b/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/lvmaxa.s
deleted file mode 100644
index aa11abf..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/lvmaxa.s
+++ /dev/null
@@ -1,53 +0,0 @@
-*
-* $Id: lvmaxa.s,v 1.1.1.1 1996/02/15 17:54:31 mclareni Exp $
-*
-* $Log: lvmaxa.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:31 mclareni
-* Kernlib
-*
-*
-LVMAXA CSECT
-* CERN PROGLIB# F121 LVMAXA .VERSION KERNIBX 1.01 900525
-* ORIG. 29/05/89 C.Guerin, IBM
-* Modified for AIX, April 1990, Roger Howard
-*
- USING *,15
- ENTRY _lvmaxa_
-_lvmaxa_ STM 2,5,16(13)
-*
- LR G4,G0 AIX: address of arg1
- L G5,0(,G1) AIX: value of arg2
- LTR G5,G5 TEST IF LEN = 0
- BZ ZERO IF LEN = 0 GO TO ZERO
- LE F0,KF GET MAX NEGATIVE
- LA G0,1 GET 1
- SR G2,G2 ZERO G2 FOR WORK
- SR G3,G3 ZERO G3 FOR WORK
-VLOOP EQU *
- VLVCU G5 SET LOOP
- VLE V0,G4 LOAD V0 WITH A VECTOR
- VMXAE V0,F0,G2 FIND MAXIMUM ABSOLUTE IN G2
- BC 2,VLOOP LOOP
- AR G0,G2 ADD 1
-* END SUBROUTINE *
-RETURN EQU *
- LM 2,5,16(13)
- BR 14
-ZERO EQU *
- SR G0,G0
- B RETURN
-* CONSTANTS *
- DS 0D
-KF DC X'00000000'
-V0 EQU 0
-G0 EQU 0
-G1 EQU 1
-G2 EQU 2
-G3 EQU 3
-G4 EQU 4
-G5 EQU 5
-F0 EQU 0
- END
-#ifdef CERNLIB_TCGEN_LVMAXA
-#undef CERNLIB_TCGEN_LVMAXA
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/lvmin.s b/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/lvmin.s
deleted file mode 100644
index 950c356..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/lvmin.s
+++ /dev/null
@@ -1,53 +0,0 @@
-*
-* $Id: lvmin.s,v 1.1.1.1 1996/02/15 17:54:31 mclareni Exp $
-*
-* $Log: lvmin.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:31 mclareni
-* Kernlib
-*
-*
-LVMIN CSECT
-* CERN PROGLIB# F121 LVMIN .VERSION KERNIBX 1.01 900525
-* ORIG. 29/05/89 C.Guerin, IBM
-* Modified for AIX, April 1990, Roger Howard
-*
- USING *,15
- ENTRY _lvmin_
-_lvmin_ STM 2,5,16(13)
-*
- LR G4,G0 AIX: address of arg1
- L G5,0(,G1) AIX: value of arg2
- LTR G5,G5 TEST IF LEN = 0
- BZ ZERO IF LEN= 0 GO TO ZERO
- LE F0,KF GET MAX POSITIVE
- LA G0,1 GET 1
- SR G2,G2 ZERO G2 FOR WORK
- SR G3,G3 ZERO G3 FOR WORK
-VLOOP EQU *
- VLVCU G5 SET LOOP
- VLE V0,G4 LOAD V0 WITH A VECTOR
- VMNSE V0,F0,G2 FIND MINIMUM IN G2
- BC 2,VLOOP LOOP
- AR G0,G2 ADD 1
-* END SUBROUTINE *
-RETURN EQU *
- LM 2,5,16(13)
- BR 14
-ZERO EQU *
- SR G0,G0
- B RETURN
-* CONSTANTS *
- DS 0D
-KF DC X'7FFFFFFF'
-V0 EQU 0
-G0 EQU 0
-G1 EQU 1
-G2 EQU 2
-G3 EQU 3
-G4 EQU 4
-G5 EQU 5
-F0 EQU 0
- END
-#ifdef CERNLIB_TCGEN_LVMIN
-#undef CERNLIB_TCGEN_LVMIN
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/lvmina.s b/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/lvmina.s
deleted file mode 100644
index 94979d7..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/lvmina.s
+++ /dev/null
@@ -1,54 +0,0 @@
-*
-* $Id: lvmina.s,v 1.1.1.1 1996/02/15 17:54:31 mclareni Exp $
-*
-* $Log: lvmina.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:31 mclareni
-* Kernlib
-*
-*
-LVMINA CSECT
-* CERN PROGLIB# F121 LVMINA .VERSION KERNIBX 1.01 900525
-* ORIG. 29/05/89 C.Guerin, IBM
-* Modified for AIX, April 1990, Roger Howard
-*
- USING *,15
- ENTRY _lvmina_
-_lvmina_ STM 2,5,16(13)
-*
- LR G4,G0 AIX: address of arg1
- L G5,0(,G1) AIX: value of arg2
- LTR G5,G5 TEST IF LEN = 0
- BZ ZERO IF LEN = 0 GO TO ZERO
- LE F0,KF GET MAXIMUM POSITIVE
- LA G0,1 GET 1
- SR G2,G2 ZERO G2 FOR WORK
- SR G3,G3 ZERO G3 FOR WORK
-VLOOP EQU *
- VLVCU G5 SET LOOP
- VLE V0,G4 LOAD V0 WITH A VECTOR
- VLPER V0,V0 CONVERT TO ABSOLUTE VALUE
- VMNSE V0,F0,G2 FIND MINIMUM IN G2
- BC 2,VLOOP LOOP
- AR G0,G2 ADD 1
-* END SUBROUTINE *
-RETURN EQU *
- LM 2,5,16(13)
- BR 14
-ZERO EQU *
- SR G0,G0
- B RETURN
-* CONSTANTS *
- DS 0D
-KF DC X'7FFFFFFF'
-V0 EQU 0
-G0 EQU 0
-G1 EQU 1
-G2 EQU 2
-G3 EQU 3
-G4 EQU 4
-G5 EQU 5
-F0 EQU 0
- END
-#ifdef CERNLIB_TCGEN_LVMINA
-#undef CERNLIB_TCGEN_LVMINA
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/lvsdmi.s b/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/lvsdmi.s
deleted file mode 100644
index e4b4111..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/lvsdmi.s
+++ /dev/null
@@ -1,56 +0,0 @@
-*
-* $Id: lvsdmi.s,v 1.1.1.1 1996/02/15 17:54:31 mclareni Exp $
-*
-* $Log: lvsdmi.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:31 mclareni
-* Kernlib
-*
-*
-LVSDMI CSECT
-* CERN PROGLIB# F121 LVSDMI .VERSION KERNIBX 1.01 900525
-* ORIG. 29/05/89 C.Guerin, IBM
-* Modified for AIX, April 1990, Roger Howard
-*
- USING *,15
- ENTRY _lvsdmi_
-_lvsdmi_ STM 2,5,16(13)
-*
- L G3,0(,G2) AIX: value of arg3
- L G2,0(,G1) AIX: value of arg2
- LR G1,G0 AIX: address of arg1
- LTR G2,G2 TEST IF LEN = 0
- BZ ZERO IF LEN = 0 GO TO ZERO
- LD F0,KF GET MAX POSITIVE
- LA G0,1 GET 1
- SR G4,G4 ZERO G4 FOR WORK
- SR G5,G5 ZERO G5 FOR WORK
-VLOOP EQU *
- VLVCU G2 SET LOOP
- VLD V0,G1(G3) LOAD V0 WITH A AND STRIDE
- VMNSD V0,F0,G4 FIND MINIMUM IN G6
- BC 2,VLOOP LOOP
- MR G2,G4 MULT BY STRIDE
- AR G0,G3 ADD 1
-* END SUBROUTINE *
-RETURN EQU *
- LM 2,5,16(13)
- BR 14
-ZERO EQU *
- SR G0,G0
- B RETURN
-* CONSTANTS *
- DS 0D
-KF DC X'7FFFFFFF'
- DC X'FFFFFFFF'
-V0 EQU 0
-G0 EQU 0
-G1 EQU 1
-G2 EQU 2
-G3 EQU 3
-G4 EQU 4
-G5 EQU 5
-F0 EQU 0
- END
-#ifdef CERNLIB_TCGEN_LVSDMI
-#undef CERNLIB_TCGEN_LVSDMI
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/lvsdmx.s b/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/lvsdmx.s
deleted file mode 100644
index 40e6863..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/lvsdmx.s
+++ /dev/null
@@ -1,56 +0,0 @@
-*
-* $Id: lvsdmx.s,v 1.1.1.1 1996/02/15 17:54:31 mclareni Exp $
-*
-* $Log: lvsdmx.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:31 mclareni
-* Kernlib
-*
-*
-LVSDMX CSECT
-* CERN PROGLIB# F121 LVSDMX .VERSION KERNIBX 1.01 900525
-* ORIG. 29/05/89 C.Guerin, IBM
-* Modified for AIX, April 1990, Roger Howard
-*
- USING *,15
- ENTRY _lvsdmx_
-_lvsdmx_ STM 2,5,16(13)
-*
- L G3,0(,G2) AIX: value of arg3
- L G2,0(,G1) AIX: value of arg2
- LR G1,G0 AIX: address of arg1
- LTR G2,G2 TEST IF LEN = 0
- BZ ZERO IF LEN = 0 GO TO ZERO
- LD F0,KF GET MAX NEGATIVE
- LA G0,1 GET 1
- SR G4,G4 ZERO G4 FOR WORK
- SR G5,G5 ZERO G5 FOR WORK
-VLOOP EQU *
- VLVCU G2 SET LOOP
- VLD V0,G1(G3) LOAD V0 WITH A AND STRIDE
- VMXSD V0,F0,G4 FIND MAXIMUM IN G6
- BC 2,VLOOP LOOP
- MR G2,G4 MULT BY STRIDE
- AR G0,G3 ADD 1
-* END SUBROUTINE *
-RETURN EQU *
- LM 2,5,16(13)
- BR 14
-ZERO EQU *
- SR G0,G0
- B RETURN
-* CONSTANTS *
- DS 0D
-KF DC X'FFFFFFFF'
- DC X'FFFFFFFF'
-V0 EQU 0
-G0 EQU 0
-G1 EQU 1
-G2 EQU 2
-G3 EQU 3
-G4 EQU 4
-G5 EQU 5
-F0 EQU 0
- END
-#ifdef CERNLIB_TCGEN_LVSDMX
-#undef CERNLIB_TCGEN_LVSDMX
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/lvsimi.s b/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/lvsimi.s
deleted file mode 100644
index 3c219ba..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/lvsimi.s
+++ /dev/null
@@ -1,63 +0,0 @@
-*
-* $Id: lvsimi.s,v 1.1.1.1 1996/02/15 17:54:32 mclareni Exp $
-*
-* $Log: lvsimi.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:32 mclareni
-* Kernlib
-*
-*
-LVSIMI CSECT
-* CERN PROGLIB# F121 LVSIMI .VERSION KERNIBX 1.01 900525
-* ORIG. 29/05/89 C.Guerin, IBM
-* Modified for AIX, April 1990, Roger Howard
-*
- USING *,15
- ENTRY _lvsimi_
-_lvsimi_ STM 2,5,16(13)
-*
- L G3,0(,G2) AIX: value of arg3
- L G2,0(,G1) AIX: value of arg2
- LR G1,G0 AIX: address of arg1
- LTR G2,G2 TEST IF LEN = 0
- BZ ZERO IF LEN = 0 GO TO ZERO
- LD F2,KF GET MAX POSITIVE
- LA G0,1 GET 1
- SR G4,G4 ZERO G4 FOR WORK
- SR G5,G5 ZERO G5 FOR WORK
- LD F0,C GET C FOR CONVERSION
-VLOOP EQU *
- VLVCU G2 SET LOOP
- VLDQ V0,F0 SET V0 TO C
- VX V1,V1,G1(G3) EXCL OR IN V1 WITH A AND STRIDE
- VSDQ V0,F0,V0 SUB C IN V0/V1 CONVERT I TO F
- VMNSD V0,F2,G4 FIND MINIMUM IN G6
- BC 2,VLOOP LOOP
- MR G2,G4 MULT BY STRIDE
- AR G0,G3 ADD 1
-* END SUBROUTINE *
-RETURN EQU *
- LM 2,5,16(13)
- BR 14
-ZERO EQU *
- SR G0,G0
- B RETURN
-* CONSTANTS *
- DS 0D
-KF DC X'7FFFFFFF'
- DC X'FFFFFFFF'
-C DC X'CE000000'
- DC X'80000000'
-V0 EQU 0
-V1 EQU 1
-G0 EQU 0
-G1 EQU 1
-G2 EQU 2
-G3 EQU 3
-G4 EQU 4
-G5 EQU 5
-F0 EQU 0
-F2 EQU 2
- END
-#ifdef CERNLIB_TCGEN_LVSIMI
-#undef CERNLIB_TCGEN_LVSIMI
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/lvsimx.s b/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/lvsimx.s
deleted file mode 100644
index e799955..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/lvsimx.s
+++ /dev/null
@@ -1,63 +0,0 @@
-*
-* $Id: lvsimx.s,v 1.1.1.1 1996/02/15 17:54:32 mclareni Exp $
-*
-* $Log: lvsimx.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:32 mclareni
-* Kernlib
-*
-*
-LVSIMX CSECT
-* CERN PROGLIB# F121 LVSIMX .VERSION KERNIBX 1.01 900525
-* ORIG. 29/05/89 C.Guerin, IBM
-* Modified for AIX, April 1990, Roger Howard
-*
- USING *,15
- ENTRY _lvsimx_
-_lvsimx_ STM 2,5,16(13)
-*
- L G3,0(,G2) AIX: value of arg3
- L G2,0(,G1) AIX: value of arg2
- LR G1,G0 AIX: address of arg1
- LTR G2,G2 TEST IF LEN = 0
- BZ ZERO IF LEN = 0 GO TO ZERO
- LE F2,KF GET MAX NEGATIVE
- LA G0,1 GET 1
- SR G4,G4 ZERO G4 FOR WORK
- SR G5,G5 ZERO G5 FOR WORK
- LD F0,C GET C FOR CONVERSION
-VLOOP EQU *
- VLVCU G2 SET LOOP
- VLDQ V0,F0 SET V0 WITH C
- VX V1,V1,G1(G3) EXCL OR IN V1 WITH A AND STRIDE
- VSDQ V0,F0,V0 SUB C IN V0/V1 CONVERT I TO F
- VMXSD V0,F2,G4 FIND MAXIMUM IN G6
- BC 2,VLOOP LOOP
- MR G2,G4 MULT BY STRIDE
- AR G0,G3 ADD 1
-* END SUBROUTINE *
-RETURN EQU *
- LM 2,5,16(13)
- BR 14
-ZERO EQU *
- SR G0,G0
- B RETURN
-* CONSTANTS *
- DS 0D
-KF DC X'FFFFFFFF'
- DC X'FFFFFFFF'
-C DC X'CE000000'
- DC X'80000000'
-V0 EQU 0
-V1 EQU 1
-G0 EQU 0
-G1 EQU 1
-G2 EQU 2
-G3 EQU 3
-G4 EQU 4
-G5 EQU 5
-F0 EQU 0
-F2 EQU 2
- END
-#ifdef CERNLIB_TCGEN_LVSIMX
-#undef CERNLIB_TCGEN_LVSIMX
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/lvsmi.s b/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/lvsmi.s
deleted file mode 100644
index d44cdf3..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/lvsmi.s
+++ /dev/null
@@ -1,56 +0,0 @@
-*
-* $Id: lvsmi.s,v 1.1.1.1 1996/02/15 17:54:31 mclareni Exp $
-*
-* $Log: lvsmi.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:31 mclareni
-* Kernlib
-*
-*
-LVSMI CSECT
-* CERN PROGLIB# F121 LVSMI .VERSION KERNIBX 1.01 900525
-* ORIG. 29/05/89 C.Guerin, IBM
-* Modified for AIX, April 1990, Roger Howard
-*
- USING *,15
- ENTRY _lvsmi_
-_lvsmi_ STM 2,5,16(13)
-*
- L G3,0(,G2) AIX: value of arg3
- L G2,0(,G1) AIX: value of arg2
- LR G1,G0 AIX: address of arg1
- LTR G2,G2 TEST IF LEN = 0
- BZ ZERO IF LEN = 0 GO TO ZERO
- LE F0,KF GET MAX POSITIVE
- LA G0,1 GET 1
- SR G4,G4 ZERO G4 FOR WORK
- SR G5,G5 ZERO G5 FOR WORK
-VLOOP EQU *
- VLVCU G2 SET LOOP
- VLE V0,G1(G3) LOAD V0 WITH A AND STRIDE
- VMNSE V0,F0,G4 FIND MINIMUM IN G6
- BC 2,VLOOP LOOP
- MR G2,G4 MULT BY STRIDE
- AR G0,G3 ADD 1
-* END SUBROUTINE *
-RETURN EQU *
- LM 2,5,16(13)
- BR 14
-ZERO EQU *
- SR G0,G0
- B RETURN
-* CONSTANTS *
- DS 0D
-KF DC X'7FFFFFFF'
- DC X'FFFFFFFF'
-V0 EQU 0
-G0 EQU 0
-G1 EQU 1
-G2 EQU 2
-G3 EQU 3
-G4 EQU 4
-G5 EQU 5
-F0 EQU 0
- END
-#ifdef CERNLIB_TCGEN_LVSMI
-#undef CERNLIB_TCGEN_LVSMI
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/lvsmx.s b/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/lvsmx.s
deleted file mode 100644
index c347130..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/lvsmx.s
+++ /dev/null
@@ -1,56 +0,0 @@
-*
-* $Id: lvsmx.s,v 1.1.1.1 1996/02/15 17:54:31 mclareni Exp $
-*
-* $Log: lvsmx.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:31 mclareni
-* Kernlib
-*
-*
-LVSMX CSECT
-* CERN PROGLIB# F121 LVSMX .VERSION KERNIBX 1.01 900525
-* ORIG. 29/05/89 C.Guerin, IBM
-* Modified for AIX, April 1990, Roger Howard
-*
- USING *,15
- ENTRY _lvsmx_
-_lvsmx_ STM 2,5,16(13)
-*
- L G3,0(,G2) AIX: value of arg3
- L G2,0(,G1) AIX: value of arg2
- LR G1,G0 AIX: address of arg1
- LTR G2,G2 TEST IF LEN = 0
- BZ ZERO IF LEN = 0 GO TO ZERO
- LE F0,KF GET MAX NEGATIVE
- LA G0,1 GET 1
- SR G4,G4 ZERO G4 FOR WORK
- SR G5,G5 ZERO G5 FOR WORK
-VLOOP EQU *
- VLVCU G2 SET LOOP
- VLE V0,G1(G3) LOAD V0 WITH A AND STRIDE
- VMXSE V0,F0,G4 FIND MAXIMUM IN G6
- BC 2,VLOOP LOOP
- MR G2,G4 MULT BY STRIDE
- AR G0,G3 ADD 1
-* END SUBROUTINE *
-RETURN EQU *
- LM 2,5,16(13)
- BR 14
-ZERO EQU *
- SR G0,G0
- B RETURN
-* CONSTANTS *
- DS 0D
-KF DC X'FFFFFFFF'
- DC X'FFFFFFFF'
-V0 EQU 0
-G0 EQU 0
-G1 EQU 1
-G2 EQU 2
-G3 EQU 3
-G4 EQU 4
-G5 EQU 5
-F0 EQU 0
- END
-#ifdef CERNLIB_TCGEN_LVSMX
-#undef CERNLIB_TCGEN_LVSMX
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/ranecu.s b/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/ranecu.s
deleted file mode 100644
index 6654c91..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/ranecu.s
+++ /dev/null
@@ -1,321 +0,0 @@
-*
-* $Id: ranecu.s,v 1.1.1.1 1996/02/15 17:54:32 mclareni Exp $
-*
-* $Log: ranecu.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:32 mclareni
-* Kernlib
-*
-*
-RANECU CSECT
-*
-* CERN PROGLIB# V114 RANECU .VERSION KERNIBX 1.01 900524
-* ORIG. 29/05/89 C.Guerin, IBM
-* Modified for AIX, April 1990, Roger Howard
-*
-SZ EQU 128 SECTION SIZE EQUATE
- USING *,15
- ENTRY _ranecu_
-_ranecu_ STM 2,1,16(13)
- L G11,=V(_ranec1_) ADCON FOR COMMON
-****************************************
-* SEE AT THE END FOR FORTRAN ALGORITHM *
-****************************************
- L G10,=A(DATA) AIX: address data segment
- USING DATA,G10
- LA G5,SZ G5 = SECTION SIZE
- LR G4,G2 AIX: address of arg3
- L G3,0(,G1) AIX: value of arg2
- LR G2,G0 AIX: address of arg1
- ST G3,RESCNT STORE TOTAL CNT = RES CNT
- L G9,0(G4) VALUE OF KSEQ
- LTR G9,G9 IF(KESQ.GT.0)
- BC 12,ELSE BRANCH IF NOT GT
- ST G9,0(G11) JSEQ(1)=KSEQ
- B SHIFT ISEQ IN G9
-* B ENDIF
-ELSE L G9,0(G11) ISEQ=JSEQ(1)
-SHIFT SLL G9,3
- AR G9,G11 (1,ISEQ) ADDR IN G9
- LD F4,0(G9) F4 = ISEED1 = (ISEED(1,ISEQ)
- LD F6,8(G9) F6 = ISEED2 = (ISEED(2,ISEQ)
- LA G12,8 SET G12 = 8
- LR G4,G3 SET G4 FOR VLVCU
-* INIT ** LOOP ***** DO 100 I=1,LEN
-INIT EQU * BEGIN LOOPS
- SR G11,G11 ZERO INDEX
- L G3,RESCNT GET RESID CNT
- SR G3,G5 SUBTRACT SIZE
- BM LESS IF MINUS LESS THAN SECT SIZE (LAST)
- ST G3,RESCNT SAVE RES CNT
- LR G3,G5 IF GT SET TO SECT SIZE
-* LOOP ** ISEED1 ***** DO 100 I=1,LEN
-SCALARP EQU *
- LD F0,KC1 KC1 = 1/53668 K=ISEED1/53668
- MDR F0,F4 F4 = ISEED1
- AD F0,K4F08 CONVERT TO
- LE F0,D4E INTEGER THEN
- SDR F2,F2 TO FLOATING
- ADR F2,F0 POINT AGAIN
- LDR F0,F2 COPY F2/F0
- MD F0,K44D4M MULT BY 53668 NEG -K*53668 IN F0
- ADR F0,F4 ADD ISEED1(I-1) +ISEED1 IN F0
- MD F0,K449C MULT BY 40014 40014*(ISEED1-K*53668)
- MD F2,K442F MULT BY 12211 K*12211
- SDR F0,F2 F0=ISEED1=40014*(ISEED1-K*53668)-K*12211
- BP EXITA IF GT ZERO STORE
- AD F0,K487F IF LT ZERO ADD 2147483563
-EXITA EQU *
- STD F0,ISEED1(G11) ISEED1 IN F0
- LDR F4,F0 COPY IN F4
-* SCALAR PART ** ISEED2 *****
- LD F0,KC2 KC2 = 1/52774 K=ISEED2/52774
- MDR F0,F6 F6 = ISEED2
- AD F0,K4F08 CONVERT TO
- LE F0,D4E INTEGER THEN
- SDR F2,F2 TO FLOATING
- ADR F2,F0 POINT AGAIN
- LDR F0,F2 COPY F2/F0
- MD F0,K44CEM MULT BY 52774 NEG -K*52774 IN F0
- ADR F0,F6 ADD ISEED2(I-1) +ISEED2 IN F0
- MD F0,K449E MULT BY 40692 40692*(ISEED2-K*52774)
- MD F2,K43EC MULT BY 3791 K*3791
- SDR F0,F2 F0=ISEED2=40692*(ISEED2-K*52774)-K*3791
- BP EXITB IF GT ZERO STORE
- AD F0,K487FB IF LT ZERO ADD 2147483399
-EXITB EQU *
- STD F0,ISEED2(G11) ISEED2 IN F0
- LDR F6,F0 COPY IN F6
-**** LA G11,8(G11) SET ISEED INDEX +8
- AR G11,G12
- BCT G3,SCALARP LOOP
-* VECTOR LOOP ****************
- LM G6,G7,AISEED1 GET VECT ADDR ISEED1 ISEED2
- LD F0,KF1 F0 = 1.0
- LD F2,K4656 F2 = 4.6566128 E-10
- VLVCU G4
- VLD V0,G6 V0 = ISEED1 ADDR IN G6
- VSD V0,V0,G7 V0 = ISEED1-ISEED2 ISEED2 ADDR IN G7
- VCDQ 2,F0,V0 V0 = IZ .LT. F0 (F0 = 1.0)
- LD F0,K21562 F0 = 2147485362
- VSVMM 1 IF IZ .LT. 1.
- VADQ V0,F0,V0 IZ = IZ + 2147485362
- VSVMM 0
- VMDQ V0,F2,V0 MULT IZ * 4.6566128 E-10 (F2)
- VSTE V0,G2 STORE IN RVEC(I)
- LTR G4,G4
- BC 2,INIT
-* 100 CONTINUE **************
-** STM G0,G1,0(G9) ISEED(1,ISEQ)=ISEED1;ISEED(2,ISEQ)=ISEED2
- STD F4,0(G9)
- STD F6,8(G9)
-* RETURN *********************
- LM 2,12,16(13) *
- BR 14 *
-* END SUBROUTINE *************
-LESS EQU * LAST PASS SCALAR THEN VECTOR
- AR G3,G5 RESET COUNT
- C G3,K30 LAST VECTOR LONGER THAN 30
- BH SCALARP GO BACK SCAL THEN VECT
-ALLSCA EQU * IF LESS GO ALL SCALAR
- LD F0,KC1 KC1 = 1/53668 K=ISEED1/53668 MODIF
- MDR F0,F4 F4 = ISEED1
- AD F0,K4F08 CONVERT TO
- LE F0,D4E INTEGER THEN
- SDR F2,F2 TO FLOATING
- ADR F2,F0 POINT AGAIN
- LDR F0,F2 COPY F2/F0
- MD F0,K44D4M MULT BY 53668 NEG -K*53668 IN F0
- ADR F0,F4 ADD ISEED1(I-1) +ISEED1 IN F0
- MD F0,K449C MULT BY 40014 40014*(ISEED1-K*53668)
- MD F2,K442F MULT BY 12211 K*12211
- SDR F0,F2 F0=ISEED1=40014*(ISEED1-K*53668)-K*12211
- BP EXIT3 IF GT ZERO STORE
- AD F0,K487F IF LT ZERO ADD 2147483563
-EXIT3 EQU *
- LDR F4,F0 COPY IN F4
-* SCALAR PART ** ISEED2 *****
- LD F0,KC2 KC2 = 1/52774 K=ISEED2/52774 MODIF
- MDR F0,F6 F6 = ISEED2
- AD F0,K4F08 CONVERT TO
- LE F0,D4E INTEGER THEN
- SDR F2,F2 TO FLOATING
- ADR F2,F0 POINT AGAIN
- LDR F0,F2 COPY F2/F0
- MD F0,K44CEM MULT BY 52774 NEG -K*52774 IN F0
- ADR F0,F6 ADD ISEED2(I-1) +ISEED2 IN F0
- MD F0,K449E MULT BY 40692 40692*(ISEED2-K*52774)
- MD F2,K43EC MULT BY 3791 K*3791
- SDR F0,F2 F0=ISEED2=40692*(ISEED2-K*52774)-K*3791
- BP EXITB3 IF GT ZERO STORE
- AD F0,K487FB IF LT ZERO ADD 2147483399
-EXITB3 EQU *
- LDR F6,F0 COPY IN F6
-* SUITE SCALAIRE ************
- LDR F0,F4 FO = ISEED1 F4 = ISEED2
- SDR F0,F6 FO = IZ = ISEED1 - ISEED2
- CD F0,KF1 IF IZ(I) .GE.1 GO TO MULT
- BNL MULT IF IZ(I) .LT.1 IZ(I)=IZ(I)+2147483562
- AD F0,K21562
-MULT EQU *
- MD F0,K4656 IZ(I)=IZ(I)*4.6566128 E -10
- STE F0,0(G2) STORE IN RVEC(I)
- LA G2,4(G2) SET RVEC INDEX +4
- BCT G3,ALLSCA LOOP SCALAIRE
-* 100 CONTINUE **************
-** STM G0,G1,0(G9) ISEED(1,ISEQ)=ISEED1;ISEED(2,ISEQ)=ISEED2
- STD F4,0(G9)
- STD F6,8(G9)
-* RETURN *********************
- LM 2,12,16(13) *
- BR 14 *
- LTORG AIX: keep literals in CSECT
-* END SUBROUTINE *************
-* CONSTANTS *****************
-DATA PSECT
- DS 0D
-DB DC D'0'
-D4E DC X'4E000000'
- DC X'00000000'
-KC1 DC X'3D1389C7' KC1 = 1./53668 OLD VERSION
- DC X'54E4331C' KC1 = 1.D0+1.D-11/53668 NEW
-K4F08 DC X'4F080000'
- DC X'00000000'
-K44D4M DC X'C4D1A400' K44D4M = - 53668.
- DC X'00000000'
-K449C DC X'449C4E00' K449C = 40014.
- DC X'00000000'
-K442F DC X'442FB300' K442F = 12211.
- DC X'00000000'
-ISEED1 DC (SZ)D'0'
-K487F DC X'487FFFFF' K487F = 2147483563.
- DC X'AB000000'
-KC2 DC X'3D13DE82' KC2 = 1./52774. OLD VERSION
- DC X'731FCFC7' KC2 = 1.D0+1.D-11/52774 NEW
-K44CEM DC X'C4CE2600' K44CEM = - 52774.
- DC X'00000000'
-K449E DC X'449EF400' K449E = 40692.
- DC X'00000000'
-K43EC DC X'43ECF000' K43EC = 3791.
- DC X'00000000'
-K487FB DC X'487FFFFF' K487FB = 2147483399.
- DC X'07000000'
-KF1 DC X'41100000' KF1 = 1.
- DC X'00000000'
-K21562 DC X'487FFFFF' K21562 = 2147485362.
- DC X'00000000'
-K4656 DC X'39200000' K4656 = 4.6566128 E-10
- DC X'00000000'
-AISEED1 DC A(ISEED1)
-AISEED2 DC A(ISEED2)
-K30 DC F'30'
-RESCNT DC F'0'
-ISEED2 DC (SZ)D'0'
-*********************************************************************
-******* ORIGINAL FORTRAN ALGORITHM *********************************
-*********************************************************************
-*** SUBROUTINE RANECU(RVEC,LEN,ISEQ)
-*** DIMENSION RVEC(*)
-*** COMMON / ECUSED / ISEED(2,1)
-*C
-*** ISEED1 = ISEED(1,ISEQ)
-*** ISEED2 = ISEED(2,ISEQ)
-*** DO 100 I= 1, LEN
-*** K = ISEED1/53668
-*** ISEED1 = 40014*(ISEED1 - K*53668) - K*12211
-*** IF (ISEED1 .LT. 0) ISEED1=ISEED1+2147483563
-*C
-*** K = ISEED2/52774
-*** ISEED2 = 40692*(ISEED2 - K*52774) - K* 3791
-*** IF (ISEED2 .LT. 0) ISEED2=ISEED2+2147483399
-***
-*** IZ = ISEED1 - ISEED2
-*** IF (IZ .LT. 1) IZ = IZ + 2147483562
-*C
-*** RVEC(I) = IZ * 4.6566128E-10
-* 100 CONTINUE
-*** ISEED(1,ISEQ) = ISEED1
-*** ISEED(2,ISEQ) = ISEED2
-*** RETURN
-*C
-*** ENTRY RECUIN(IS1,IS2,ISEQ)
-*** ISEED(1,ISEQ) = IS1
-*** ISEED(2,ISEQ) = IS2
-*** ENTRY RECUUT(IS1,IS2,ISEQ)
-*** IS1 = ISEED(1,ISEQ)
-*** IS2 = ISEED(2,ISEQ)
-*** END
-***************** SECOND ALGORITHM ****************
-*** SUBROUTINE RANECF(RVEC,LEN,KSEQ)
-*
-*** DOUBLE PRECISION ISEED, ISEED1, ISEED2, K, C1, C2, IZ
-*** PARAMETER (C1=(1.D0+1.D-11)/53668.D0,C2=(1.D0+1.D-11)/52774.D0)
-*** PARAMETER (MAXSEQ=100)
-*** DIMENSION RVEC(*)
-*** COMMON / RANEC1 / JSEQ(2), ISEED(2,MAXSEQ)
-*** SAVE /RANEC1/
-*C
-*** IF(KSEQ.GT.0) THEN
-*** JSEQ(1) = KSEQ
-*** ISEQ = KSEQ
-*** ELSE
-*** ISEQ = JSEQ(1)
-*** ENDIF
-*** ISEED1 = ISEED(1,ISEQ)
-*** ISEED2 = ISEED(2,ISEQ)
-*** DO 100 I= 1, LEN
-*** K = INT (ISEED1*C1)
-*** ISEED1 = 40014*(ISEED1 - K*53668) - K*12211
-*** IF (ISEED1 .LT. 0) ISEED1=ISEED1+2147483563
-*C
-*** K = INT(ISEED2*C2)
-*** ISEED2 = 40692*(ISEED2 - K*52774) - K* 3791
-*** IF (ISEED2 .LT. 0) ISEED2=ISEED2+2147483399
-*C
-*** IZ = ISEED1 - ISEED2
-*** IF (IZ .LE. 0) IZ = IZ + 2147483562
-*C
-*** RVEC(I) = IZ * 4.6566128E-10
-* 100 CONTINUE
-*** ISEED(1,ISEQ) = ISEED1
-*** ISEED(2,ISEQ) = ISEED2
-*** END
-G0 EQU 0
-G1 EQU 1
-G2 EQU 2
-G3 EQU 3
-G4 EQU 4
-G5 EQU 5
-G6 EQU 6
-G7 EQU 7
-G8 EQU 8
-G9 EQU 9
-G10 EQU 10
-G11 EQU 11
-G12 EQU 12
-G13 EQU 13
-G14 EQU 14
-G15 EQU 15
-F0 EQU 0
-F2 EQU 2
-F4 EQU 4
-F6 EQU 6
-V0 EQU 0
-V1 EQU 1
-V2 EQU 2
-V3 EQU 3
-V4 EQU 4
-V5 EQU 5
-V6 EQU 6
-V7 EQU 7
-V8 EQU 8
-V9 EQU 9
-V10 EQU 10
-V11 EQU 11
-V12 EQU 12
-V13 EQU 13
-V14 EQU 14
-V15 EQU 15
- END
-#ifdef CERNLIB_TCGEN_RANECU
-#undef CERNLIB_TCGEN_RANECU
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/ubunch.s b/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/ubunch.s
deleted file mode 100644
index 95992cb..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/ubunch.s
+++ /dev/null
@@ -1,272 +0,0 @@
-*
-* $Id: ubunch.s,v 1.1.1.1 1996/02/15 17:54:32 mclareni Exp $
-*
-* $Log: ubunch.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:32 mclareni
-* Kernlib
-*
-*
-UBUNCH CSECT VECTOR VERSION FOR UBUNCH
-*
-* CERN PROGLIB# M409 UBUNCH .VERSION KERNIBX 1.01 900525
-*
- USING *,15
- ENTRY _ubunch_
-_ubunch_ STM 2,1,16(13)
-*****************************************************************
- L G6,0(,G2) AIX: value of arg3
- LR G5,G1 AIX: address of arg2
- LR G4,G0 AIX: address of arg1
- C G6,BEV compare count with bev
- BL TZERO if lower go to TZERO
- SR G7,G7 zero G7
- SRDL G6,2 divide count by 4
- LR G1,G4 copy input vect addr from G4 to G1
- LA G1,4(G1) add +4 to G1 for word 2
- LR G2,G4 copy input vect addr from G4 to G2
- LA G2,8(G2) add +8 to G2 for word 3
- LR G3,G4 copy input vect addr from G4 to G3
- LA G3,12(G3) add +12 to G3 for word 4
- LA G8,4 set stride to 4
- LM G9,G12,MASK0 load masks in G9 to G12
-VLOOP EQU *
- VLVCU G6 set vector loop
- VL V0,G4(G8) load V0 from G4 addr
- VL V1,G1(G8) load V1 from G1 addr
- VL V2,G2(G8) load V2 from G2 addr
- VL V3,G3(G8) load V3 from G3 addr
- VNQ V0,G9,V0 and V0 elemt with x'FF000000'
- VSRL V1,V1,8 shift right V1 for 2nd byte
- VNQ V1,G10,V1 and V1 elemt with x'00FF0000'
- VSRL V2,V2,16 shift right V2 for 3rd byte
- VNQ V2,G11,V2 and V2 elemt with x'0000FF00'
- VSRL V3,V3,24 shift right V3 for 4th byte
- VNQ V3,G12,V3 and V3 elemt with x'000000FF'
- VOR V0,V0,V1 or V1 and V0 in V0 (byte 1 & 2)
- VOR V2,V3,V2 or V2 and V3 in V2 (byte 3 & 4)
- VOR V0,V0,V2 or V0 and V2 (byte 1 to 4)
- VST V0,G5 store V0 (4 bytes) result with G5 addr
- BC 2,VLOOP go back vector
- SRL G7,30 shift remainder
- LTR G7,G7 is any remainder
- BZ RETURN2 if no return
- L G12,BLKS load G12 with blanks
- L G11,0(G4) load next input vect elemt
- SRL G11,24 shift byte to low order position
- ST G12,0(G5) store a word of blks
- STC G11,0(G5) store one byte from low order
- BCT G7,NEX1 update count in G7 and test any more
- B RETURN2 if no more return
-NEX1 L G11,4(G4) load next input vect elemt
- SRL G11,24 shift byte to low order position
- STC G11,1(G5) store one byte from low order
- BCT G7,NEX2 update count in G7 and test any more
- B RETURN2 if no more return
-NEX2 L G11,8(G4) load next input vect elemt
- SRL G11,24 shift byte to low order position
- STC G11,2(G5) store one byte from low order
- B RETURN2 if no more return
-* END SUBROUTINE ************
-RETURN2 LM 2,12,16(13)
- BR 14
-* SCALAR ********************
-TZERO EQU *
- C G6,KZ compare count with 0
- BC LE,RETURN2 if le return
-SL L G1,BLKS load G1 with blanks
- LR G9,G5 copy G5 output addr vect in G9
-LW EQU *
- ST G1,0(G9) store G1 blanks in output vect
- ICM G0,B'1000',0(G4) get 1 byte from input vect
- STCM G0,B'1000',0(G5) put 1 byte in output vect
- BCT G6,NEXT1 update count and test
- B EXIT if no more exit
-NEXT1 ICM G0,B'1000',4(G4) get 1 byte from input vect
- STCM G0,B'1000',1(G5) put 1 byte in output vect
- BCT G6,NEXT2 update count and test
- B EXIT if no more exit
-NEXT2 ICM G0,B'1000',8(G4) get 1 byte from input vect
- STCM G0,B'1000',2(G5) put 1 byte in output vect
- BCT G6,NEXT3 update count and test
- B EXIT if no more exit
-NEXT3 ICM G0,B'1000',12(G4) get 1 byte from input vect
- STCM G0,B'1000',3(G5) put 1 byte from output vect
- LA G5,4(G5) add +4 to G5 output vect addr
- LA G4,16(G4) add +16 to input vect addr
- LA G9,4(G9) add +4 to G9 output vect addr
- BCT G6,LW update count and test
-EXIT B RETURN2 if no more return
-* CONSTANTS *****************************************************
- DS 0D
-BLKS DC X'20202020'
-BEV DC F'64'
-KZ DC F'0'
-MASK0 DC X'FF000000'
-MASK1 DC X'00FF0000'
-MASK2 DC X'0000FF00'
-MASK3 DC X'000000FF'
-LE EQU 12
-V0 EQU 0
-V1 EQU 1
-V2 EQU 2
-V3 EQU 3
-V4 EQU 4
-V5 EQU 5
-V6 EQU 6
-V7 EQU 7
-V8 EQU 8
-V9 EQU 9
-V10 EQU 10
-V11 EQU 11
-V12 EQU 12
-V13 EQU 13
-V14 EQU 14
-V15 EQU 15
-G0 EQU 0
-G1 EQU 1
-G2 EQU 2
-G3 EQU 3
-G4 EQU 4
-G5 EQU 5
-G6 EQU 6
-G7 EQU 7
-G8 EQU 8
-G9 EQU 9
-G10 EQU 10
-G11 EQU 11
-G12 EQU 12
-G13 EQU 13
-G14 EQU 14
-G15 EQU 15
-F0 EQU 0
-F2 EQU 2
-F4 EQU 4
-F6 EQU 6
- END
-UBLOW CSECT VECTOR VERSION FOR UBLOW
-*
-* CERN PROGLIB# M409 UBLOW .VERSION KERNIBX 1.01 900525
-*
- USING *,15
- ENTRY _ublow_
-_ublow_ STM 2,1,16(13)
-*****************************************************************
- L G12,=A(DATA) AIX: address data segment
- USING DATA,G12
- L G6,0(,G2) AIX: value of arg3
- LR G5,G1 AIX: address of arg2
- LR G4,G0 AIX: address of arg1
- L G0,BLANKS load G0 with 3 blanks x'00202020'
- C G6,BEV compare count with bev
- BL TZERO if lower than bev go to TZERO
- SR G7,G7 zero G7
- SRDL G6,1 divide count by 2
- ST G7,WORD store remainder
- LR G8,G5 copy output address G5 in G8
- LA G8,4(G8) +4 in G8
- LA G2,2 set stride=2
-VLOOP EQU *
- VLVCU G6 set vector loop
- VLH V0,G4 load halfword from input in V0
- VSLL V1,V0,24 shift second byte left 24 in V1
- VSRL V0,V0,8 shift first byte right 8 in V0
- VSLL V0,V0,24 shift first byte left 24 in V0
- VOQ V0,G0,V0 set 3 low order bytes to blank
- VOQ V1,G0,V1 set 3 low order bytes to blank
- VST V0,G5(G2) store first byte in output thru G5
- VST V1,G8(G2) store 2nd byte in output +4 thru G8
- BC 2,VLOOP go back vector loop
- TM WORD,X'80' test remanider
- BZ RETURN if no return
- L G9,BLANK4 load G9 with 4 blanks x'20202020'
- ST G9,0(G5) store in output vector
- IC G3,0(G4) get next character
- STC G3,0(G5) store in output vector
-* END SUBROUTINE ************
-RETURN EQU *
- LM 2,12,16(13)
- BR 14
-* NON VECTOR ****************
-TZERO EQU *
- C G6,KZ compare vector count with zero
- BC LE,RETURN if le 0 return
-ST4 L G10,0(G4) get input vector word 1
- L G11,BLANK4 get 4 blanks
- ST G11,0(G5) store in ouput vector
- STCM G10,B'1000',0(G5) store first character
- BCT G6,NEX1 test any more if yes go on
- B RR if no more return
-NEX1 ST G11,4(G5) store 4 blanks in next word
- STCM G10,B'0100',4(G5) store next character
- BCT G6,NEX2 test any more if yes go on
- B RR if no more return
-NEX2 ST G11,8(G5) store 4 blanks in next word
- STCM G10,B'0010',8(G5) store next character
- BCT G6,NEX3 test any more if yes go on
- B RR if no more return
-NEX3 ST G11,12(G5) store 4 blanks in next word
- STCM G10,B'0001',12(G5) store next character
- LA G4,4(G4) add +4 to G4 input vector addr
- LA G5,16(G5) add +16 to G5 output vector addr
- BCT G6,ST4 test count if yes go on scalar
-RR B RETURN
- LTORG AIX: literals must be in CSECT
-* CONSTANTS *****************************************************
-DATA PSECT
- DS 0D
-BLANK4 DC X'20202020'
-BLANKS DC X'00202020'
- DC X'00202020'
- DC X'00202020'
- DC X'00202020'
- DS 0D
-BEV DC F'40'
-KZ DC F'0'
-WORD DC F'0'
-LE EQU 12
-V0 EQU 0
-V1 EQU 1
-V2 EQU 2
-V3 EQU 3
-V4 EQU 4
-V5 EQU 5
-V6 EQU 6
-V7 EQU 7
-V8 EQU 8
-V9 EQU 9
-V10 EQU 10
-V11 EQU 11
-V12 EQU 12
-V13 EQU 13
-V14 EQU 14
-V15 EQU 15
-G0 EQU 0
-G1 EQU 1
-G2 EQU 2
-G3 EQU 3
-G4 EQU 4
-G5 EQU 5
-G6 EQU 6
-G7 EQU 7
-G8 EQU 8
-G9 EQU 9
-G10 EQU 10
-G11 EQU 11
-G12 EQU 12
-G13 EQU 13
-G14 EQU 14
-G15 EQU 15
-F0 EQU 0
-F2 EQU 2
-F4 EQU 4
-F6 EQU 6
- END
-#ifdef CERNLIB_IBXGS_UBUNCH
-#undef CERNLIB_IBXGS_UBUNCH
-#endif
-#ifdef CERNLIB_TCGEN_UBUNCH
-#undef CERNLIB_TCGEN_UBUNCH
-#endif
-#ifdef CERNLIB_TCGEN_UBLOW
-#undef CERNLIB_TCGEN_UBLOW
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/vadd.F b/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/vadd.F
deleted file mode 100644
index b6c2116..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/vadd.F
+++ /dev/null
@@ -1,38 +0,0 @@
-*
-* $Id: vadd.F,v 1.1.1.1 1996/02/15 17:54:33 mclareni Exp $
-*
-* $Log: vadd.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:33 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- at PROCESS DIRECTIVE ('*VDIR:') OPT(3) VECTOR
- SUBROUTINE VADD (B,C,A,N)
-C
-C CERN PROGLIB# F121 VADD .VERSION KERNIBM 2.27 890622
-C ORIG. 01/07/71
-C 31/03/89 M.Roethlisberger/IBM Optimize/Vectorize
-C
- DIMENSION A(*),B(*),C(*)
- PARAMETER (LVMIN = 15)
-C
- IF (N.GE.LVMIN) THEN
-C*VDIR: PREFER VECTOR
-
- DO 90 I= 1,N
- 90 A(I)= B(I) + C(I)
-
- ELSE
-
-C*VDIR: PREFER SCALAR
-
- DO 95 I= 1,N
- 95 A(I)= B(I) + C(I)
-
- ENDIF
- END
-#ifdef CERNLIB_TCGEN_VADD
-#undef CERNLIB_TCGEN_VADD
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/vasum.F b/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/vasum.F
deleted file mode 100644
index 8220aae..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/vasum.F
+++ /dev/null
@@ -1,43 +0,0 @@
-*
-* $Id: vasum.F,v 1.1.1.1 1996/02/15 17:54:35 mclareni Exp $
-*
-* $Log: vasum.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:35 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- at PROCESS DIRECTIVE ('*VDIR:') OPT(3) VECTOR
- FUNCTION VASUM (A,N)
-C
-C CERN PROGLIB# F121 VASUM .VERSION KERNIBM 2.27 890622
-C ORIG. 01/07/71
-C 28/02/89 M.Roethlisberger/IBM Optimization/Vectorization
-C
- DIMENSION A(*)
- REAL*8 XS
- PARAMETER (LVMIN = 40)
-C
- IF (N.GE.LVMIN) THEN
-C*VDIR: PREFER VECTOR
-
- XV= 0.
- DO 90 I= 1,N
- 90 XV= XV + ABS (A(I))
- VASUM=XV
-
- ELSE
-C
-C*VDIR: PREFER SCALAR
-
- XS= 0.
- DO 95 I= 1,N
- 95 XS= XS + ABS (A(I))
- VASUM=XS
-
- ENDIF
- END
-#ifdef CERNLIB_TCGEN_VASUM
-#undef CERNLIB_TCGEN_VASUM
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/vbias.F b/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/vbias.F
deleted file mode 100644
index 2d7e223..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/vbias.F
+++ /dev/null
@@ -1,38 +0,0 @@
-*
-* $Id: vbias.F,v 1.1.1.1 1996/02/15 17:54:33 mclareni Exp $
-*
-* $Log: vbias.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:33 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- at PROCESS DIRECTIVE ('*VDIR:') OPT(3) VECTOR
- SUBROUTINE VBIAS (B,ALPHA,A,N)
-C
-C CERN PROGLIB# F121 VBIAS .VERSION KERNIBM 2.27 890622
-C ORIG. 01/07/71
-C 03/04/89 M.Roethlisberger/IBM Optimize/Vectorize
-C
- DIMENSION A(*),B(*)
- PARAMETER (LVMIN = 20)
-C
- IF (N.GE.LVMIN) THEN
-C*VDIR: PREFER VECTOR
-
- DO 90 I= 1,N
- 90 A(I)= B(I) + ALPHA
-
- ELSE
-
-C*VDIR: PREFER SCALAR
-
- DO 95 I= 1,N
- 95 A(I)= B(I) + ALPHA
-
- ENDIF
- END
-#ifdef CERNLIB_TCGEN_VBIAS
-#undef CERNLIB_TCGEN_VBIAS
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/vcopyn.F b/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/vcopyn.F
deleted file mode 100644
index dd9a5f0..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/vcopyn.F
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: vcopyn.F,v 1.1.1.1 1996/02/15 17:54:33 mclareni Exp $
-*
-* $Log: vcopyn.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:33 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- at PROCESS DIRECTIVE ('*VDIR:') OPT(3) VECTOR
- SUBROUTINE VCOPYN (A,X,N)
-C
-C CERN PROGLIB# F121 VCOPYN .VERSION KERNIBM 2.27 890622
-C ORIG. 01/04/73
-C 20/03/89 M.Roethlisberger?IBM Optimization/Vectorization
-C
- DIMENSION A(*), X(*)
- PARAMETER (LVMIN = 25)
-C
- IF (N.GE.LVMIN) THEN
-C*VDIR: PREFER VECTOR
- DO 14 I=1,N
- 14 X(I)= -A(I)
- ELSE
-
-C*VDIR: PREFER SCALAR
- DO 19 I=1,N
- 19 X(I)= -A(I)
- ENDIF
- END
-#ifdef CERNLIB_TCGEN_VCOPYN
-#undef CERNLIB_TCGEN_VCOPYN
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/vdist.F b/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/vdist.F
deleted file mode 100644
index 39a7b5e..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/vdist.F
+++ /dev/null
@@ -1,43 +0,0 @@
-*
-* $Id: vdist.F,v 1.1.1.1 1996/02/15 17:54:34 mclareni Exp $
-*
-* $Log: vdist.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:34 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- at PROCESS DIRECTIVE ('*VDIR:') OPT(3) VECTOR
- FUNCTION VDIST (X,Y,N)
-C
-C CERN PROGLIB# F121 VDIST .VERSION KERNIBM 2.27 890622
-C ORIG. 26/09/76
-C 28/02/89 M.Roethlisberger/IBM Optimization/Vectorization
-C
- DIMENSION X(*), Y(*)
- REAL*8 XX8
- PARAMETER (LVMIN = 27)
-
- IF (N.GE.LVMIN) THEN
-C*VDIR: PREFER VECTOR
-
- XX = 0.
- DO 90 J=1,N
- 90 XX = XX + (X(J)-Y(J)) **2
- XX = SQRT (XX)
- VDIST = XX
- ELSE
-
-C*VDIR: PREFER SCALAR
-
- XX8 = 0.
- DO 95 J=1,N
- 95 XX8 = XX8 + (DBLE(X(J)-Y(J))) **2
- XX = SQRT (SNGL(XX8))
- VDIST = XX
- ENDIF
- END
-#ifdef CERNLIB_TCGEN_VDIST
-#undef CERNLIB_TCGEN_VDIST
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/vdist2.F b/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/vdist2.F
deleted file mode 100644
index 82ec433..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/vdist2.F
+++ /dev/null
@@ -1,42 +0,0 @@
-*
-* $Id: vdist2.F,v 1.1.1.1 1996/02/15 17:54:34 mclareni Exp $
-*
-* $Log: vdist2.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:34 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- at PROCESS DIRECTIVE ('*VDIR:') OPT(3) VECTOR
- FUNCTION VDIST2 (X,Y,N)
-C
-C CERN PROGLIB# F121 VDIST2 .VERSION KERNIBM 2.27 890622
-C ORIG. 26/09/76
-C 28/02/89 M.Roethlisberger Optimization/Vectorization
-C
- DIMENSION X(*), Y(*)
- REAL*8 XX8
- PARAMETER (LVMIN = 27)
-
- IF (N.GE.LVMIN) THEN
-C*VDIR: PREFER VECTOR
-
- XX = 0.
- DO 90 J=1,N
- 90 XX = XX + (X(J)-Y(J)) **2
- VDIST2 = XX
- ELSE
-
-C*VDIR: PREFER SCALAR
-
- XX8 = 0.
- DO 95 J=1,N
- 95 XX8 = XX8 + (DBLE(X(J)-Y(J))) **2
- VDIST2 = XX8
- ENDIF
- RETURN
- END
-#ifdef CERNLIB_TCGEN_VDIST2
-#undef CERNLIB_TCGEN_VDIST2
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/vdot.F b/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/vdot.F
deleted file mode 100644
index 9b502ae..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/vdot.F
+++ /dev/null
@@ -1,43 +0,0 @@
-*
-* $Id: vdot.F,v 1.1.1.1 1996/02/15 17:54:34 mclareni Exp $
-*
-* $Log: vdot.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:34 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- at PROCESS DIRECTIVE ('*VDIR:') OPT(3) VECTOR
- FUNCTION VDOT (X,Y,N)
-C
-C CERN PROGLIB# F121 VDOT .VERSION KERNIBM 2.27 890622
-C ORIG. 01/07/71
-C 28/02/89 M.Roethlisberger/IBM Optimization/Vectorization
-C
- DIMENSION X(*),Y(*)
- REAL*8 XS
- PARAMETER (LVMIN = 28)
-C
- IF (N.GE.LVMIN) THEN
-C*VDIR: PREFER VECTOR
-
- XV= 0.
- DO 90 I= 1,N
- 90 XV= XV + X(I)*Y(I)
- VDOT=XV
-
- ELSE
-
-C*VDIR: PREFER SCALAR
-
- XS= 0.
- DO 95 I= 1,N
- 95 XS= XS + DBLE(X(I))*DBLE(Y(I))
- VDOT=XS
-
- ENDIF
- END
-#ifdef CERNLIB_TCGEN_VDOT
-#undef CERNLIB_TCGEN_VDOT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/vdotn.F b/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/vdotn.F
deleted file mode 100644
index fdbb40b..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/vdotn.F
+++ /dev/null
@@ -1,67 +0,0 @@
-*
-* $Id: vdotn.F,v 1.1.1.1 1996/02/15 17:54:34 mclareni Exp $
-*
-* $Log: vdotn.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:34 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- at PROCESS DIRECTIVE ('*VDIR:') OPT(3) VECTOR
- FUNCTION VDOTN (X,Y,N)
-C
-C CERN PROGLIB# F121 VDOTN .VERSION KERNIBM 2.27 890622
-C ORIG. 01/07/71
-C 28/02/89 M.Roethlisberger/IBM Optimization/Vectorization
-C
- DIMENSION X(*), Y(*)
- REAL*8 XX8, XY8, YY8
- PARAMETER (LVMIN = 25)
-C
- IF (N.GE.LVMIN) THEN
-C*VDIR: PREFER VECTOR
-
- XX= 0.
- XY= 0.
- YY= 0.
-C
- DO 90 J=1,N
- XX = XX + X(J)*X(J)
- XY = XY + X(J)*Y(J)
- 90 YY = YY + Y(J)*Y(J)
-C
- VDOTN= XY / SQRT(XX*YY)
- IF (ABS (VDOTN).LT.1.) RETURN
- VDOTN= SIGN (1.,VDOTN)
-
- ELSE IF (N.GT.0) THEN
-C
-C*VDIR: PREFER SCALAR
-
- XX8 = 0.
- XY8 = 0.
- YY8 = 0.
-C
- DO 95 J=1,N
- XX8 = XX8 + DBLE(X(J))*DBLE(X(J))
- XY8 = XY8 + DBLE(X(J))*DBLE(Y(J))
- 95 YY8 = YY8 + DBLE(Y(J))*DBLE(Y(J))
-C
- XX = XX8
- XY = XY8
- YY = YY8
-
- VDOTN= XY / SQRT(XX*YY)
- IF (ABS (VDOTN).LT.1.) RETURN
- VDOTN= SIGN (1.,VDOTN)
-
- ELSE
-
- VDOTN = 0.0
-
- ENDIF
- END
-#ifdef CERNLIB_TCGEN_VDOTN
-#undef CERNLIB_TCGEN_VDOTN
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/vdotn2.F b/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/vdotn2.F
deleted file mode 100644
index 5edb41d..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/vdotn2.F
+++ /dev/null
@@ -1,63 +0,0 @@
-*
-* $Id: vdotn2.F,v 1.1.1.1 1996/02/15 17:54:34 mclareni Exp $
-*
-* $Log: vdotn2.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:34 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- at PROCESS DIRECTIVE ('*VDIR:') OPT(3) VECTOR
- FUNCTION VDOTN2 (X,Y,N)
-C
-C CERN PROGLIB# F121 VDOTN2 .VERSION KERNIBM 2.27 890622
-C ORIG. 20/06/72
-C 28/02/89 M.Roethlisberger Optimization/Vectorization
-C
- DIMENSION X(*),Y(*)
- REAL*8 XX8, XY8, YY8
- PARAMETER (LVMIN = 30)
-C
- IF (N.GE.LVMIN) THEN
-C*VDIR: PREFER VECTOR
-
- XX = 0.
- XY = 0.
- YY = 0.
-C
- DO 90 J=1,N
- XX = XX + X(J)*X(J)
- XY = XY + X(J)*Y(J)
- 90 YY = YY + Y(J)*Y(J)
-C
- VDOTN2= XY**2/(XX*YY)
-
- ELSE IF (N.GT.0) THEN
-C
-C*VDIR: PREFER SCALAR
-
- XX8 = 0.
- XY8 = 0.
- YY8 = 0.
-C
- DO 95 J=1,N
- XX8 = XX8 + DBLE(X(J))*DBLE(X(J))
- XY8 = XY8 + DBLE(X(J))*DBLE(Y(J))
- 95 YY8 = YY8 + DBLE(Y(J))*DBLE(Y(J))
-C
-
- XX=XX8
- XY=XY8
- YY=YY8
- VDOTN2= XY**2/(XX*YY)
-
- ELSE
-
- VDOTN2 = 0.0
-
- ENDIF
- END
-#ifdef CERNLIB_TCGEN_VDOTN2
-#undef CERNLIB_TCGEN_VDOTN2
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/vexcum.F b/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/vexcum.F
deleted file mode 100644
index d936e04..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/vexcum.F
+++ /dev/null
@@ -1,43 +0,0 @@
-*
-* $Id: vexcum.F,v 1.1.1.1 1996/02/15 17:54:34 mclareni Exp $
-*
-* $Log: vexcum.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:34 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- at PROCESS DIRECTIVE ('*VDIR:') OPT(3) VECTOR
- SUBROUTINE VEXCUM (A,EX,N)
-
-C
-C CERN PROGLIB# F121 VEXCUM .VERSION KERNIBM 2.27 890622
-C ORIG. 01/07/71
-C 20/03/89 M.ROETHLISBERGER/IBM OPTIMIZATION/VECTORIZATION
-C
- DIMENSION A(*), EX(3)
- PARAMETER (LVMIN = 45 )
-
- IF (N.GE.LVMIN) THEN
-C*VDIR: PREFER VECTOR
-
- DO 190 J=1,N
- EX(1)= AMIN1(EX(1),A(J))
- EX(2)= AMAX1(EX(2),A(J))
- 190 EX(3)= EX(3) + A(J)
-
- ELSE
-
-C*VDIR: PREFER SCALAR
-
- DO 195 J=1,N
- EX(1)= AMIN1(EX(1),A(J))
- EX(2)= AMAX1(EX(2),A(J))
- 195 EX(3)= EX(3) + A(J)
-
- ENDIF
- END
-#ifdef CERNLIB_TCGEN_VEXCUM
-#undef CERNLIB_TCGEN_VEXCUM
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/vfix.F b/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/vfix.F
deleted file mode 100644
index de7ddd4..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/vfix.F
+++ /dev/null
@@ -1,38 +0,0 @@
-*
-* $Id: vfix.F,v 1.1.1.1 1996/02/15 17:54:34 mclareni Exp $
-*
-* $Log: vfix.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:34 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- at PROCESS DIRECTIVE ('*VDIR:') OPT(3) VECTOR
- SUBROUTINE VFIX (A,IA,N)
-C
-C CERN PROGLIB# F121 VFIX .VERSION KERNIBM 2.27 890622
-C ORIG. 03/05/72
-C 01/03/89 M.Roethlisberger/IBM Optimization/Vectorization
-C
- DIMENSION A(*), IA(*)
- PARAMETER (LVMIN = 12 )
-
- IF (N.GE.LVMIN) THEN
-C*VDIR: PREFER VECTOR
-
- DO 90 J=1,N
- 90 IA(J)= A(J)
-
- ELSE
-
-C*VDIR: PREFER SCALAR
-
- DO 95 J=1,N
- 95 IA(J)= A(J)
-
- ENDIF
- END
-#ifdef CERNLIB_TCGEN_VFIX
-#undef CERNLIB_TCGEN_VFIX
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/vfloat.F b/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/vfloat.F
deleted file mode 100644
index c7fd26c..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/vfloat.F
+++ /dev/null
@@ -1,39 +0,0 @@
-*
-* $Id: vfloat.F,v 1.1.1.1 1996/02/15 17:54:34 mclareni Exp $
-*
-* $Log: vfloat.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:34 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- at PROCESS DIRECTIVE ('*VDIR:') OPT(3) VECTOR
- SUBROUTINE VFLOAT (IA,A,N)
-C
-C CERN PROGLIB# F121 VFLOAT .VERSION KERNIBM 2.27 890622
-C ORIG. 03/05/72
-C 01/03/89 M.Roethlisberger/IBM Optimization/Vectorizatin
-C
- DIMENSION A(*), IA(*)
- PARAMETER (LVMIN = 10)
-
- IF (N.GE.LVMIN) THEN
-C*VDIR: PREFER VECTOR
-
- DO 90 J=1,N
- 90 A(J)= IA(J)
-
- ELSE
-
-C*VDIR: PREFER SCALAR
-
- DO 95 J=1,N
- 95 A(J)= IA(J)
-
- ENDIF
-
- END
-#ifdef CERNLIB_TCGEN_VFLOAT
-#undef CERNLIB_TCGEN_VFLOAT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/vlinco.F b/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/vlinco.F
deleted file mode 100644
index 3b373cb..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/vlinco.F
+++ /dev/null
@@ -1,38 +0,0 @@
-*
-* $Id: vlinco.F,v 1.1.1.1 1996/02/15 17:54:33 mclareni Exp $
-*
-* $Log: vlinco.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:33 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- at PROCESS DIRECTIVE ('*VDIR:') OPT(3) VECTOR
- SUBROUTINE VLINCO (B,ALPHA,C,BETA,A,N)
-C
-C CERN PROGLIB# F121 VLINCO .VERSION KERNIBM 2.27 890622
-C ORIG. 01/07/71
-C 01/03/89 M.Roethlisberger/IBM Optimization/Vectorization
-C
- DIMENSION A(*),B(*),C(*)
- PARAMETER (LVMIN = 20)
-
- IF (N.GE.LVMIN) THEN
-C*VDIR: PREFER VECTOR
-
- DO 90 I= 1,N
- 90 A(I)= B(I)*ALPHA + C(I)*BETA
-
- ELSE
-
-C*VDIR: PREFER SCALAR
-
- DO 95 I= 1,N
- 95 A(I)= B(I)*ALPHA + C(I)*BETA
-
- ENDIF
- END
-#ifdef CERNLIB_TCGEN_VLINCO
-#undef CERNLIB_TCGEN_VLINCO
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/vmatl.F b/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/vmatl.F
deleted file mode 100644
index 17f88f0..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/vmatl.F
+++ /dev/null
@@ -1,71 +0,0 @@
-*
-* $Id: vmatl.F,v 1.1.1.1 1996/02/15 17:54:33 mclareni Exp $
-*
-* $Log: vmatl.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:33 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- at PROCESS DIRECTIVE ('*VDIR:') OPT(3) VECTOR
- SUBROUTINE VMATL (H,A,X,K,N)
-C
-C CERN PROGLIB# F121 VMATL .VERSION KERNIBM 2.27 890622
-C ORIG. 01/07/71
-C 24/05/89 M.Roethlisberger/IBM Optimized/Vectorized
-C
- DIMENSION A(99),X(99),H(N,K)
- PARAMETER (LVMIN = 7, NS = 96)
- REAL*8 TMPI, TMPJ
-
- IF (MAX0(N,K).GE.LVMIN) THEN
-
- IF (N.GT.K.OR.N.GT.NS) THEN
-C
-C Vectorize over J
-C
- DO 71 I=1,K
- X(I)=0.
- 71 CONTINUE
-
- DO 79 J = 1,N
- TEMP = A(J)
- DO 75 I= 1,K
- X(I)= X(I) + TEMP*H(J,I)
- 75 CONTINUE
- 79 CONTINUE
-
- RETURN
- ENDIF
-
-C
-C Vectorize over I
-C
-C*VDIR: PREFER VECTOR
- DO 89 I= 1,K
- TMPI=0.
- DO 85 J= 1,N
- TMPJ= A(J)
- TMPI= TMPI + TMPJ*H(J,I)
- 85 CONTINUE
- X(I)=TMPI
- 89 CONTINUE
- RETURN
- ENDIF
-
-C*VDIR: PREFER SCALAR ON
-
- DO 99 I= 1,K
- TMPI= 0.
-
- DO 95 J= 1,N
- TMPJ= A(J)
- TMPI= TMPI + TMPJ*H(J,I)
- 95 CONTINUE
- X(I)=TMPI
- 99 CONTINUE
- END
-#ifdef CERNLIB_TCGEN_VMATL
-#undef CERNLIB_TCGEN_VMATL
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/vmatr.F b/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/vmatr.F
deleted file mode 100644
index bef0a7a..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/vmatr.F
+++ /dev/null
@@ -1,72 +0,0 @@
-*
-* $Id: vmatr.F,v 1.1.1.1 1996/02/15 17:54:33 mclareni Exp $
-*
-* $Log: vmatr.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:33 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- at PROCESS DIRECTIVE ('*VDIR:') OPT(3) VECTOR
- SUBROUTINE VMATR (A,G,X,N,K)
-C
-C CERN PROGLIB# F121 VMATR .VERSION KERNIBM 2.27 890622
-C ORIG. 01/07/71
-C 24/05/89 M.Roethlisberger/IBM Optimized/Vectorized
-C
- DIMENSION A(99),X(99),G(K,N)
- PARAMETER (LVMIN = 7, KS = 128)
- REAL*8 TMPI, TMPJ
-
- IF (MAX0(K,N).GE.LVMIN) THEN
-
- IF (K.GT.N.OR.K.GT.KS) THEN
-C
-C Vectorize over I
-C
- DO 79 I= 1,K
- TMPI=0
- DO 75 J= 1,N
- TMPJ= A(J)
- TMPI= TMPI + TMPJ*G(I,J)
- 75 CONTINUE
- X(I)=TMPI
- 79 CONTINUE
-
- RETURN
- ENDIF
-C
-C Vectorize over J
-C
- DO 81 I=1,K
- X(I)=0.
- 81 CONTINUE
-
-C*VDIR: PREFER VECTOR
- DO 89 J= 1,N
- TEMP = A(J)
-C*VDIR: PREFER SCALAR
- DO 85 I= 1,K
- X(I) = X(I)+TEMP*G(I,J)
- 85 CONTINUE
- 89 CONTINUE
-
- RETURN
- ENDIF
-
-C*VDIR: PREFER SCALAR ON
-
- DO 99 I= 1,K
- TMPI= 0.
- DO 95 J= 1,N
- TMPJ=A(J)
- TMPI= TMPI + TMPJ*G(I,J)
- 95 CONTINUE
- X(I)=TMPI
- 99 CONTINUE
-
- END
-#ifdef CERNLIB_TCGEN_VMATR
-#undef CERNLIB_TCGEN_VMATR
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/vmax.F b/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/vmax.F
deleted file mode 100644
index 1818a88..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/vmax.F
+++ /dev/null
@@ -1,45 +0,0 @@
-*
-* $Id: vmax.F,v 1.1.1.1 1996/02/15 17:54:35 mclareni Exp $
-*
-* $Log: vmax.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:35 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- at PROCESS DIRECTIVE ('*VDIR:') OPT(3) VECTOR
- FUNCTION VMAX (A,N)
-C
-C CERN PROGLIB# F121 VMAX .VERSION KERNIBM 2.27 890622
-C ORIG. 01/07/71
-C 27/02/89 M.Roethlisberger/IBM Optimization/Vectorization
-C
- DIMENSION A(*)
- PARAMETER (LVMIN = 30)
-C
- IF (N.GE.LVMIN) THEN
-C*VDIR: PREFER VECTOR
-
- AMAX = A(1)
- DO 90 I= 2,N
- 90 AMAX = AMAX1 (A(I),AMAX)
- VMAX = AMAX
-
- ELSE IF (N.GT.0) THEN
-C*VDIR: PREFER SCALAR
-
- AMAX = A(1)
- DO 95 I= 2,N
- 95 AMAX = AMAX1 (A(I),AMAX)
- VMAX = AMAX
-
- ELSE
-
- VMAX = 0.
-
- END IF
- END
-#ifdef CERNLIB_TCGEN_VMAX
-#undef CERNLIB_TCGEN_VMAX
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/vmaxa.F b/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/vmaxa.F
deleted file mode 100644
index b26e1dd..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/vmaxa.F
+++ /dev/null
@@ -1,45 +0,0 @@
-*
-* $Id: vmaxa.F,v 1.1.1.1 1996/02/15 17:54:35 mclareni Exp $
-*
-* $Log: vmaxa.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:35 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- at PROCESS DIRECTIVE ('*VDIR:') OPT(3) VECTOR
- FUNCTION VMAXA (A,N)
-C
-C CERN PROGLIB# F121 VMAXA .VERSION KERNIBM 2.27 890622
-C ORIG. 01/07/71
-C 27/02/89 M.Roethlisberger/IBM Optimization/Vectorization
-C
- DIMENSION A(*)
- PARAMETER (LVMIN = 25)
-C
- IF (N.GE.LVMIN) THEN
-C*VDIR: PREFER VECTOR
-
- AMAX = ABS (A(1))
- DO 90 I= 2,N
- 90 AMAX = AMAX1 (ABS (A(I)),AMAX)
- VMAXA = AMAX
-
- ELSE IF (N.GT.0) THEN
-C*VDIR: PREFER SCALAR
-
- AMAX = ABS (A(1))
- DO 95 I= 2,N
- 95 AMAX = AMAX1 (ABS (A(I)),AMAX)
- VMAXA = AMAX
-
- ELSE
-
- VMAXA = 0.
-
- END IF
- END
-#ifdef CERNLIB_TCGEN_VMAXA
-#undef CERNLIB_TCGEN_VMAXA
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/vmin.F b/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/vmin.F
deleted file mode 100644
index e6c5532..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/vmin.F
+++ /dev/null
@@ -1,45 +0,0 @@
-*
-* $Id: vmin.F,v 1.1.1.1 1996/02/15 17:54:35 mclareni Exp $
-*
-* $Log: vmin.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:35 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- at PROCESS DIRECTIVE ('*VDIR:') OPT(3) VECTOR
- FUNCTION VMIN (A,N)
-C
-C CERN PROGLIB# F121 VMIN .VERSION KERNIBM 2.27 890622
-C ORIG. 01/07/71
-C 24/02/89 M.Roethlisbeger/IBM Optimization/Vectorization
-C
- DIMENSION A(*)
- PARAMETER (LVMIN = 30)
-C
- IF (N.GE.LVMIN) THEN
-C*VDIR: PREFER VECTOR
-
- AMIN= A(1)
- DO 90 I= 2,N
- 90 AMIN = AMIN1 (A(I),AMIN)
- VMIN= AMIN
-
- ELSE IF (N.GT.0) THEN
-C*VDIR: PREFER SCALAR
-
- AMIN= A(1)
- DO 95 I= 2,N
- 95 AMIN = AMIN1 (A(I),AMIN)
- VMIN= AMIN
-
- ELSE
-
- VMIN = 0.
-
- END IF
- END
-#ifdef CERNLIB_TCGEN_VMIN
-#undef CERNLIB_TCGEN_VMIN
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/vmina.F b/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/vmina.F
deleted file mode 100644
index 4d05034..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/vmina.F
+++ /dev/null
@@ -1,45 +0,0 @@
-*
-* $Id: vmina.F,v 1.1.1.1 1996/02/15 17:54:35 mclareni Exp $
-*
-* $Log: vmina.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:35 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- at PROCESS DIRECTIVE ('*VDIR:') OPT(3) VECTOR
- FUNCTION VMINA (A,N)
-C
-C CERN PROGLIB# F121 VMINA .VERSION KERNIBM 2.27 890622
-C ORIG. 01/07/71
-C 24/02/89 M.Roethlisberger/IBM Optimization/Vectorization
-C
- DIMENSION A(*)
- PARAMETER (LVMIN = 25)
-C
- IF (N.GE.LVMIN) THEN
-C*VDIR: PREFER VECTOR
-
- AMIN= ABS (A(1))
- DO 90 I= 2,N
- 90 AMIN = AMIN1 (ABS (A(I)),AMIN)
- VMINA= AMIN
-
- ELSE IF (N.GT.0) THEN
-C*VDIR: PREFER SCALAR
-
- AMIN= ABS (A(1))
- DO 95 I= 2,N
- 95 AMIN = AMIN1 (ABS (A(I)),AMIN)
- VMINA= AMIN
-
- ELSE
-
- VMINA = 0.
-
- END IF
- END
-#ifdef CERNLIB_TCGEN_VMINA
-#undef CERNLIB_TCGEN_VMINA
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/vmod.F b/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/vmod.F
deleted file mode 100644
index 6b8691a..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/vmod.F
+++ /dev/null
@@ -1,43 +0,0 @@
-*
-* $Id: vmod.F,v 1.1.1.1 1996/02/15 17:54:34 mclareni Exp $
-*
-* $Log: vmod.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:34 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- at PROCESS DIRECTIVE ('*VDIR:') OPT(3) VECTOR
- FUNCTION VMOD (A,N)
-C
-C CERN PROGLIB# F121 VMOD .VERSION KERNIBM 2.27 890622
-C ORIG. 01/07/71
-C 24/02/89 M.Roethlisberger/IBM Optimization/Vectorization
-C
- DIMENSION A(*)
- REAL*8 XS
- PARAMETER (LVMIN = 30)
-C
- IF (N.GE.LVMIN) THEN
-C*VDIR: PREFER VECTOR
- XV = 0.
-
- DO 90 I=1,N
- 90 XV = XV + A(I)*A(I)
-
- VMOD=SQRT(XV)
- ELSE
-
-C*VDIR: PREFER SCALAR
-
- XS = 0.
- DO 95 I=1,N
- 95 XS = XS + DBLE(A(I))*DBLE(A(I))
-
- VMOD=SQRT(SNGL(XS))
- ENDIF
- END
-#ifdef CERNLIB_TCGEN_VMOD
-#undef CERNLIB_TCGEN_VMOD
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/vmul.F b/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/vmul.F
deleted file mode 100644
index 3ac5cfb..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/vmul.F
+++ /dev/null
@@ -1,38 +0,0 @@
-*
-* $Id: vmul.F,v 1.1.1.1 1996/02/15 17:54:33 mclareni Exp $
-*
-* $Log: vmul.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:33 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- at PROCESS DIRECTIVE ('*VDIR:') OPT(3) VECTOR
- SUBROUTINE VMUL (A,B,X,N)
-C
-C CERN PROGLIB# F121 VMUL .VERSION KERNIBM 2.27 890622
-C ORIG. 01/07/71
-C 01/03/89 M.Roethlisberger/IBM Optimization/Vectorization
-C
- DIMENSION A(*),B(*),X(*)
- PARAMETER (LVMIN = 40)
-
- IF (N.GE.LVMIN) THEN
-C*VDIR: PREFER VECTOR
-
- DO 90 I= 1,N
- 90 X(I)= A(I) * B(I)
-
- ELSE
-
-C*VDIR: PREFER SCALAR
-
- DO 95 I= 1,N
- 95 X(I)= A(I) * B(I)
-
- ENDIF
- END
-#ifdef CERNLIB_TCGEN_VMUL
-#undef CERNLIB_TCGEN_VMUL
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/vscale.F b/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/vscale.F
deleted file mode 100644
index bc32fbe..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/vscale.F
+++ /dev/null
@@ -1,38 +0,0 @@
-*
-* $Id: vscale.F,v 1.1.1.1 1996/02/15 17:54:33 mclareni Exp $
-*
-* $Log: vscale.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:33 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- at PROCESS DIRECTIVE ('*VDIR:') OPT(3) VECTOR
- SUBROUTINE VSCALE (B,ALPHA,A,N)
-C
-C CERN PROGLIB# F121 VSCALE .VERSION KERNIBM 2.27 890622
-C ORIG. 01/07/71
-C 01/03/89 M.Roethlisberger/IBM Optimization/Vectorization
-C
- DIMENSION A(*),B(*)
- PARAMETER (LVMIN = 30)
-
- IF (N.GE.LVMIN) THEN
-C*VDIR: PREFER VECTOR
-
- DO 90 I= 1,N
- 90 A(I)= B(I) * ALPHA
-
- ELSE
-
-C*VDIR: PREFER SCALAR
-
- DO 95 I= 1,N
- 95 A(I)= B(I) * ALPHA
-
- ENDIF
- END
-#ifdef CERNLIB_TCGEN_VSCALE
-#undef CERNLIB_TCGEN_VSCALE
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/vsub.F b/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/vsub.F
deleted file mode 100644
index 272002c..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/vsub.F
+++ /dev/null
@@ -1,38 +0,0 @@
-*
-* $Id: vsub.F,v 1.1.1.1 1996/02/15 17:54:33 mclareni Exp $
-*
-* $Log: vsub.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:33 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- at PROCESS DIRECTIVE ('*VDIR:') OPT(3) VECTOR
- SUBROUTINE VSUB (A,B,X,N)
-C
-C CERN PROGLIB# F121 VSUB .VERSION KERNIBM 2.27 890622
-C ORIG. 01/07/71
-C 01/03/89 M.Roethlisberger/IBM Optimization/Vectorization
-C
- DIMENSION A(*),B(*),X(*)
- PARAMETER (LVMIN = 30)
-
- IF (N.GE.LVMIN) THEN
-C*VDIR: PREFER VECTOR
-
- DO 90 I= 1,N
- 90 X(I)= A(I) - B(I)
-
- ELSE
-
-C*VDIR: PREFER SCALAR
-
- DO 95 I= 1,N
- 95 X(I)= A(I) - B(I)
-
- ENDIF
- END
-#ifdef CERNLIB_TCGEN_VSUB
-#undef CERNLIB_TCGEN_VSUB
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/vsum.F b/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/vsum.F
deleted file mode 100644
index 8e32434..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/vsum.F
+++ /dev/null
@@ -1,43 +0,0 @@
-*
-* $Id: vsum.F,v 1.1.1.1 1996/02/15 17:54:35 mclareni Exp $
-*
-* $Log: vsum.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:35 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- at PROCESS DIRECTIVE ('*VDIR:') OPT(3) VECTOR
- FUNCTION VSUM (A,N)
-C
-C CERN PROGLIB# F121 VSUM .VERSION KERNIBM 2.27 890622
-C ORIG. 01/07/71
-C 20/02/89 M.Roethlisberger/IBM Optimization/vectorization
-C
- DIMENSION A(*)
- REAL*8 XS
- PARAMETER (LVMIN = 45)
-C
- IF (N.GE.LVMIN) THEN
-C*VDIR: PREFER VECTOR
-
- XV = 0.
- DO 90 I= 1,N
- 90 XV = XV + A(I)
-
- VSUM=XV
- ELSE
-
-C*VDIR: PREFER SCALAR
-
- XS=0.
- DO 95 I= 1,N
- 95 XS= XS + A(I)
-
- VSUM=XS
- ENDIF
- END
-#ifdef CERNLIB_TCGEN_VSUM
-#undef CERNLIB_TCGEN_VSUM
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/vunit.F b/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/vunit.F
deleted file mode 100644
index 76cd658..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernibx/qmibxvf/vunit.F
+++ /dev/null
@@ -1,55 +0,0 @@
-*
-* $Id: vunit.F,v 1.1.1.1 1996/02/15 17:54:33 mclareni Exp $
-*
-* $Log: vunit.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:33 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- at PROCESS DIRECTIVE ('*VDIR:') OPT(3) VECTOR
- SUBROUTINE VUNIT (A,B,N)
-C
-C CERN PROGLIB# F121 VUNIT .VERSION KERNIBM 2.27 890622
-C ORIG. 01/07/71
-C 01/03/89 M.Roethlisberger/IBM Optimization/Vectorization
-C
- DIMENSION A(*), B(*)
- REAL*8 XX8
- PARAMETER (LVMIN = 30)
-
- IF (N.GE.LVMIN) THEN
-C*VDIR: PREFER VECTOR
-
- XX= 0.
- DO 90 I=1,N
- 90 XX= XX + A(I)*A(I)
-
- IF (XX.LE.0.) RETURN
- YY=1./ SQRT (XX)
-
-C*VDIR: PREFER VECTOR
-
- DO 190 I = 1,N
- 190 B(I)=A(I) * YY
-
- ELSE
-
-C*VDIR: PREFER SCALAR ON
-
- XX8= 0.
- DO 95 I=1,N
- 95 XX8= XX8 + DBLE(A(I))*DBLE(A(I))
-
- IF (XX8.LE.0.) RETURN
- YY=1./ SQRT (SNGL(XX8))
-
- DO 195 I = 1,N
- 195 B(I)=A(I) * YY
-
- ENDIF
- END
-#ifdef CERNLIB_TCGEN_VUNIT
-#undef CERNLIB_TCGEN_VUNIT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernirt/irtobsol/chdir.c b/src/packlib/kernlib/kerngen/obsolete/kernirt/irtobsol/chdir.c
deleted file mode 100644
index 06d8aa5..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernirt/irtobsol/chdir.c
+++ /dev/null
@@ -1,48 +0,0 @@
-/*
- * $Id: chdir.c,v 1.1.1.1 1996/02/15 17:54:22 mclareni Exp $
- *
- * $Log: chdir.c,v $
- * Revision 1.1.1.1 1996/02/15 17:54:22 mclareni
- * Kernlib
- *
- */
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
-/*> ROUTINE CHDIR
- CERN PROGLIB# CHDIR .VERSION KERNIRT 1.02 900925
- ORIG. 20/07/90, JZ
- Fortran interface routine to chdir */
-#include <stdio.h>
- long chdir_(name, nname)
- char name[];
- int nname;
-{
- int jcol, nall, istat;
- char *ptname, *ptuse, *malloc();
- int chdir();
-
- jcol = 0;
-
-/*-- find last non-blank of NAME */
- while (--nname >= 0)
- if (name[nname] != ' ') goto endn;
- goto blfi;
-endn: nname = nname + 1;
-
-/* get memory and copy NAME terminated */
-
- nall = nname + 6;
- ptname = malloc (nall);
- if (ptname == NULL) goto blfi;
-
- ptuse = ptname;
- while (jcol < nname) *ptuse++ = name[jcol++];
- *ptuse = '\0';
-
- istat = chdir (ptname);
- free (ptname);
- return istat;
-
-blfi: return 0;
-}
-/*> END <----------------------------------------------------------*/
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernirt/irtobsol/getcwd.c b/src/packlib/kernlib/kerngen/obsolete/kernirt/irtobsol/getcwd.c
deleted file mode 100644
index c0bbf94..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernirt/irtobsol/getcwd.c
+++ /dev/null
@@ -1,39 +0,0 @@
-/*
- * $Id: getcwd.c,v 1.1.1.1 1996/02/15 17:54:22 mclareni Exp $
- *
- * $Log: getcwd.c,v $
- * Revision 1.1.1.1 1996/02/15 17:54:22 mclareni
- * Kernlib
- *
- */
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
-/*> ROUTINE GETCWD
- CERN PROGLIB# GETCWD .VERSION KERNIRT 1.02 900925
- ORIG. 20/07/90, JZ
- Fortran interface routine to getcwd */
-#include <stdio.h>
- void getcwd_(text, ntext)
- char text[];
- int ntext;
-{
- int jcol;
- char *pttext, *getcwd();
-
- jcol = 0;
-
- pttext = getcwd (text, ntext);
- if (pttext == NULL) goto blfi;
-
-/*-- find the terminator in the returned path-name */
- while (jcol < ntext)
- { if (text[jcol] == '\0') goto blfi;
- ++jcol;
- }
- return;
-
-/* blank fill the trailing text */
-blfi: while (jcol < ntext) text[jcol++] = ' ';
- return;
-}
-/*> END <----------------------------------------------------------*/
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernirt/irtobsol/perror.c b/src/packlib/kernlib/kerngen/obsolete/kernirt/irtobsol/perror.c
deleted file mode 100644
index 8c98262..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernirt/irtobsol/perror.c
+++ /dev/null
@@ -1,39 +0,0 @@
-/*
- * $Id: perror.c,v 1.1.1.1 1996/02/15 17:54:22 mclareni Exp $
- *
- * $Log: perror.c,v $
- * Revision 1.1.1.1 1996/02/15 17:54:22 mclareni
- * Kernlib
- *
- */
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
-/*> ROUTINE PERROR
- CERN PROGLIB# PERROR .VERSION KERNIRT 1.02 900925
- ORIG. 20/07/90, JZ
- Fortran interface routine to perror */
-#include <stdio.h>
- void perror_ (text, ntext)
- char text[];
- int ntext;
-{
- int jcol, nall;
- char *pttext, *ptuse, *malloc();
-
-
-/* get memory and copy NAME terminated */
-
- nall = ntext + 6;
- pttext = malloc (nall);
- if (pttext == NULL) return;
-
- ptuse = pttext;
- jcol = 0;
- while (jcol < ntext) *ptuse++ = text[jcol++];
- *ptuse = '\0';
-
- perror (pttext);
- free (pttext);
- return;
-}
-/*> END <----------------------------------------------------------*/
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernirt/irtobsol/rename.c b/src/packlib/kernlib/kerngen/obsolete/kernirt/irtobsol/rename.c
deleted file mode 100644
index 8e1dbb6..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernirt/irtobsol/rename.c
+++ /dev/null
@@ -1,69 +0,0 @@
-/*
- * $Id: rename.c,v 1.1.1.1 1996/02/15 17:54:22 mclareni Exp $
- *
- * $Log: rename.c,v $
- * Revision 1.1.1.1 1996/02/15 17:54:22 mclareni
- * Kernlib
- *
- */
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
-/*> ROUTINE RENAME
- CERN PROGLIB# RENAME .VERSION KERNIRT 1.02 900925
- ORIG. 20/07/90, JZ
- Fortran interface routine to rename */
-#include <stdio.h>
- int rename_ (frpath, topath, nnfr, nnto)
- char frpath[], topath[];
- int nnfr, nnto;
-{
- int ncolfr, ncolto;
- int jcol, nall, istat;
- char *ptall, *ptfr, *ptto, *ptuse;
- char *malloc();
- int rename();
-
- istat= -1;
-
-/*-- find last blank of from-path */
- ncolfr = nnfr;
- while (--ncolfr >= 0)
- if (frpath[ncolfr] != ' ') goto endfr;
- goto home;
-
-endfr: ncolfr = ncolfr + 1;
-
-/*-- find last blank of to-path */
- ncolto = nnto;
- while (--ncolto >= 0)
- if (topath[ncolto] != ' ') goto endto;
- goto home;
-
-endto: ncolto = ncolto + 1;
-
-/* get memory and copy file-names terminated */
-
- nall = ncolfr + ncolto + 6;
- ptall = malloc (nall);
- if (ptall == NULL) goto home;
-
- ptfr = ptall;
- ptuse = ptall;
-
- jcol = 0;
- while (jcol < ncolfr) *ptuse++ = frpath[jcol++];
- *ptuse++ = '\0';
-
- ptto = ptuse;
- jcol = 0;
- while (jcol < ncolto) *ptuse++ = topath[jcol++];
- *ptuse = '\0';
-
-/* execute the RENAME */
-
- istat = rename (ptfr, ptto);
-
- free (ptall);
-home: return istat;
-}
-/*> END <----------------------------------------------------------*/
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernirt/irtobsol/signal.c b/src/packlib/kernlib/kerngen/obsolete/kernirt/irtobsol/signal.c
deleted file mode 100644
index c09776d..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernirt/irtobsol/signal.c
+++ /dev/null
@@ -1,40 +0,0 @@
-/*
- * $Id: signal.c,v 1.1.1.1 1996/02/15 17:54:22 mclareni Exp $
- *
- * $Log: signal.c,v $
- * Revision 1.1.1.1 1996/02/15 17:54:22 mclareni
- * Kernlib
- *
- */
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
-/*> ROUTINE SIGNAL
- CERN PROGLIB# SIGNAL .VERSION KERNIRT 1.02 900925
- ORIG. 20/07/90, JZ
- FORTRAN interface routine to sigaction */
-#include <stdio.h>
-#include <signal.h>
- int signal_(asigno,funct,aflag)
- long *asigno, *aflag;
- void (*funct)();
-{
- int sigaction();
- int istat, signo;
-
- struct sigaction {
- void (*sa_handler)();
- sigset_t sa_mask;
- int sa_flags;
- };
-
- struct sigaction buf;
-
- signo = *asigno;
- buf.sa_handler = *funct;
- buf.sa_flags = SA_RESTART;
- sigemptyset(&buf.sa_mask);
-
- istat = sigaction(signo,&buf,NULL);
- return istat;
-}
-/*> END <----------------------------------------------------------*/
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernlnx/lnxobsol/vxinvb.F b/src/packlib/kernlib/kerngen/obsolete/kernlnx/lnxobsol/vxinvb.F
deleted file mode 100644
index 3ca7444..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernlnx/lnxobsol/vxinvb.F
+++ /dev/null
@@ -1,43 +0,0 @@
-*
-* $Id: vxinvb.F,v 1.1.1.1 1996/02/15 17:54:23 mclareni Exp $
-*
-* $Log: vxinvb.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:23 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE VXINVB (MVI,NW)
-
-C CERN PROGLIB# M434 VXINVB .VERSION KERNLNX 1.00 930829
-C ORIG. 25-June-92, JZ
-
-C- VX invert bytes, in-place
-
- DIMENSION MVI(99)
- DATA MASK1 /X'FF'/
-
- IF (NW .LE. 0) RETURN
- DO 29 J=1,NW
-C 1-st byte
- IIN = MVI(J)
- IOT = LSHIFT(AND(IIN,MASK1), 24)
-C 2-nd byte
- IIN = ISHFT(IIN, -8)
- IWORK = AND(IIN,MASK1)
- IOT = OR(IOT, LSHIFT(IWORK,16))
-C 3-d byte
- IIN = ISHFT(IIN, -8)
- IWORK = AND(IIN,MASK1)
- IOT = OR(IOT, LSHIFT(IWORK,8))
-C last byte
- IIN = ISHFT(IIN, -8)
- IOT = OR(IOT, IIN)
-
- MVI(J) = IOT
- 29 CONTINUE
- END
-#ifdef CERNLIB_TCGEN_VXINVB
-#undef CERNLIB_TCGEN_VXINVB
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernlnx/lnxobsol/vxinvc.F b/src/packlib/kernlib/kerngen/obsolete/kernlnx/lnxobsol/vxinvc.F
deleted file mode 100644
index dd3f507..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernlnx/lnxobsol/vxinvc.F
+++ /dev/null
@@ -1,43 +0,0 @@
-*
-* $Id: vxinvc.F,v 1.1.1.1 1996/02/15 17:54:23 mclareni Exp $
-*
-* $Log: vxinvc.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:23 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE VXINVC (MVI,MVX,NW)
-
-C CERN PROGLIB# M434 VXINVC .VERSION KERNLNX 1.00 930829
-C ORIG. 25-June-92, JZ
-
-C- VX invert bytes and copy
-
- DIMENSION MVI(99), MVX(99)
- DATA MASK1 /X'FF'/
-
- IF (NW .LE. 0) RETURN
- DO 29 J=1,NW
-C 1-st byte
- IIN = MVI(J)
- IOT = LSHIFT(AND(IIN,MASK1), 24)
-C 2-nd byte
- IIN = ISHFT(IIN, -8)
- IWORK = AND(IIN,MASK1)
- IOT = OR(IOT, LSHIFT(IWORK,16))
-C 3-d byte
- IIN = ISHFT(IIN, -8)
- IWORK = AND(IIN,MASK1)
- IOT = OR(IOT, LSHIFT(IWORK,8))
-C last byte
- IIN = ISHFT(IIN, -8)
- IOT = OR(IOT, IIN)
-
- MVX(J) = IOT
- 29 CONTINUE
- END
-#ifdef CERNLIB_TCGEN_VXINVC
-#undef CERNLIB_TCGEN_VXINVC
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnor/history/gnorup1.dat b/src/packlib/kernlib/kerngen/obsolete/kernnor/history/gnorup1.dat
deleted file mode 100644
index e15b34c..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnor/history/gnorup1.dat
+++ /dev/null
@@ -1,166 +0,0 @@
-*
-* $Id: gnorup1.dat,v 1.1.1.1 1996/02/15 17:54:46 mclareni Exp $
-*
-* $Log: gnorup1.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:54:46 mclareni
-* Kernlib
-*
-*
-#if !defined(CERNLIB_KERNNOR)
-
- UP-DATE RECORD FOR GENNOR VERSIONS 1.01 TO 1.16
- -----------------------------------------------
-
-
- FIRST RELEASE OF THE GENNOR MINI-PAM : 18 JULY 1980
-
----------------------------------------------------------------------
-
-
-UP-DATE 1.02 : 30-JULY-1980
------------------------------
-
-REPLACING FILE GENNOR 1.01 10-JULY-1980
-
-CORRECTIONS : P=NORD2, D=IUMODE CHANGE OF CALLING SEQUENCE
-
----------------------------------------------------------------------
-
-UP-DATE 1.03 : 24-MAR-1981
------------------------------
-
-REPLACING FILE GENNOR 1.02 30-JULY-1980
-
-NEW PATCH : P=*GNORD3 AND P=NORD3 FOR THE NORD 500
-CORRECTIONS : CHANGE NAME P=NORD50 TO P=NORD2
- D=IUMODE CHANGED TO ALLOW 24-BIT INTEGERS
-
----------------------------------------------------------------------
-
-UP-DATE 1.04 : 18-MAY-1981
------------------------------
-
-REPLACING FILE GENNOR 1.03 24-MAR-1981
-
-NEW PATCH : P=NORDSYS ROUTINES COMMON TO 500 AND 50
-
----------------------------------------------------------------------
-
-UP-DATE 1.05 : 21-MAY-1981
------------------------------
-
-REPLACING FILE GENNOR 1.04 18-MAY-1981
-
-MANY NEW MACHINE LANGUAGE ROUTINES FOR THE NORD 500
-
----------------------------------------------------------------------
-
-UP-DATE 1.06 : 9-JUNE-1981
------------------------------
-
-REPLACING FILE GENNOR 1.05 21-MAY-1981
-
-ADD DUMMY ROUTINE TRACEQ
-
----------------------------------------------------------------------
-
-UP-DATE 1.07 : 29-JUNE-1981
------------------------------
-
-REPLACING FILE GENNOR 1.06 9-JUNE-1981
-
-CORRECTED PKBYT, PKCHAR
-REPLACED DUMMY ROUTINE TRACEQ
-ADDED NEW M.L. INCBYT, IUBIN, IUHIST, NOARG, UBITS
- UPKBYT, UPKCH
- TRAC1Q, TRAC2Q
-
----------------------------------------------------------------
-
-UP-DATE 1.08 : 7-AUG-1981
-------------------------------
-
-REPLACING FILE GENNOR 1.07
-
-ADDED ROUTINES FOR TIMING: TIMEX,TIMED,TIMEL(DUMMY)
-
-------------------------------------------------------------------
-
-UP-DATE 1.09 : 5-NOV-1981
-------------------------------
-
-REPLACING FILE GENNOR 1.08 7-AUG-81
-
-ADDED ROUTINE D=ABEND IN P=NORDSYS
-
-------------------------------------------------------------------
-
-UP-DATE 1.10 : 16-NOV-1981
-------------------------------
-
-REPLACING FILE GENNOR 1.09 5-NOV-81
-
-BUG FIXED IN D=INCBYT OF P=NORD3
-USE OF PER-CENT IN MACHINE-LANGUAGE COMMENTS CORRECTED
-
-------------------------------------------------------------------
-
-UP-DATE 1.11 : 24-NOV-1981
-------------------------------
-
-REPLACING FILE GENNOR 1.10 16-NOV-81
-
-BUG FIXED IN D=NOARG OF P=NORD3
-
-------------------------------------------------------------------
-
-UP-DATE 1.12 : 26-NOV-1981
-------------------------------
-
-REPLACING FILE GENNOR 1.11 24-NOV-81
-
-NEW VERSION OF UBUNCH
-
-------------------------------------------------------------------
-
-UP-DATE 1.13 : 2-DEC-1981
-------------------------------
-
-REPLACING FILE GENNOR 1.12 26-NOV-81
-
-NEW ROUTINES: UCTOH1, UCTOH, UH1TOC, UHTOC
-
-------------------------------------------------------------------
-
-UP-DATE 1.14 : 29-JUL-1982
-------------------------------
-
-REPLACING FILE GENNOR 1.13 2-DEC-81
-
-TIDY UP COMMENT CARDS ONLY TO PREPARE FOR KERNNOR PAM
-
-------------------------------------------------------------------
-
-UP-DATE 1.15 : 7-OCT-1982
-------------------------------
-
-REPLACING FILE GENNOR 1.14 29-JUL-82
-
-NEW PATCHES P= *KNORD3, *KNORD2
-ADD USE,T=INH CARDS TO LOCF
-
-------------------------------------------------------------------
-
-UP-DATE 1.16 : 2-DEC-1982
-------------------------------
-
-REPLACING FILE GENNOR 1.15 821007 12.48
-
-CORRECT TIMED, TIDY UP TIMEX, REMOVE DUMMY TIMEL
-
-------------------------------------------------------------------
-
- KERNNOR 2.00 = GENNOR 1.16
-
----------------------------------------------------------------------
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnor/history/history.dat b/src/packlib/kernlib/kerngen/obsolete/kernnor/history/history.dat
deleted file mode 100644
index a809cdb..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnor/history/history.dat
+++ /dev/null
@@ -1,119 +0,0 @@
-*
-* $Id: history.dat,v 1.1.1.1 1996/02/15 17:54:46 mclareni Exp $
-*
-* $Log: history.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:54:46 mclareni
-* Kernlib
-*
-*
-* This directory was created from kernnor.car patch kernnor
-#if !defined(CERNLIB_KERNNOR)
-
- KERNLIB routines in machine language or otherwise special
- for NORSK DATA 500
-
----------------------------------------------------------------------
-
- This file contains the following Patches :
-
-
-*KNORD3 KERN Pilot for NORD 500
-
-QMND3 Machine Patch for NORD 500
-
-NORD3 NORD 500 versions of normal routines
-
-NORDSYS system interface routines for ND 500
-
-=====================================================================
-
-
- UP-DATE RECORD FOR THE PAM-FILE KERNNOR, VERSION 2
- ---------------------------------------------------
-
-
-UP-DATE 2.08 : 20-Nov-1989
-------------------------------
-
-Replacing file KERNNOR 2.07 880912 19.42
-
-Correct : LOCF add entry LOCB
-
-Delete : ABEND use default on KERNFOR
-
----------------------------------------------------------------------
-
-UP-DATE 2.07 : 12-Sept-1989
-------------------------------
-
-Replacing file KERNNOR 2.06 880712 21.18
-
-Correct : DATIME to return seconds in /SLATE/
-
----------------------------------------------------------------------
-
-UP-DATE 2.06 : 12-JUL-1988
-------------------------------
-
-Replacing file KERNNOR 2.05 880419 20.21
-
-Correct : D=NOARG delete dummy in P=TCGEN
-
----------------------------------------------------------------------
-
-UP-DATE 2.05 : 19-APR-1988
-------------------------------
-
-Replacing file KERNNOR 2.04 870525 15.22
-
-New decks : P=NORD3, D=RNDM, RNDM2
-
-Correct : D=UHTOC bug fixed
- D=UCOPY,UCOPIV,UCOPYN,UCOPY2, small
- D=VBLANK,VCOPYN,VFILL,VFIX,VFLOAT,VZERO improvments
-
-Move: D=XINB,XINBS to P=NORD3, delete P=XVECTNOR
-
----------------------------------------------------------------------
-
-UP-DATE 2.04 : 24-MAY-1987
-------------------------------
-
-Replacing file KERNNOR 2.03 861204 21.07
-
-New decks : P=NORD3, D=JBYTOR, MBYTET, MBYTOR, MCBYT
- D=MSBIT, MSBIT0, MSBIT1, MSBYT,
- D=BTEST, IBCLR, IBSET
-
- All material for the NORD 50 has been removed
-
----------------------------------------------------------------------
-
-UP-DATE 2.03 : 4-DEC-1986
-------------------------------
-
-Replacing file KERNNOR 2.02 850320 21.20
-
-New decks : P=NORD3, D=IE3FOD,IE3FOS,IE3TOD,IE3TOS
-
----------------------------------------------------------------------
-
-UP-DATE 2.02 : 20-MAR-1985
-------------------------------
-
-Replacing file KERNNOR 2.01 840815 23.00
-
-New deck : P=NORDSYS, D=INTRAC
-
----------------------------------------------------------------------
-
-UP-DATE 2.01 : 16-AUG-1984
-------------------------------
-
-Replacing file KERNNOR 2.00 2-DEC-82
-
-ADDED ROUTINE D=QNEXTE IN P=NORDSYS
-
----------------------------------------------------------------------
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnor/inhibit.list b/src/packlib/kernlib/kerngen/obsolete/kernnor/inhibit.list
deleted file mode 100644
index 3e550ff..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnor/inhibit.list
+++ /dev/null
@@ -1,76 +0,0 @@
-tcgen/btest
-tcgen/cbyt
-tcgen/ibclr
-tcgen/ibset
-tcgen/ie3fod
-tcgen/ie3fos
-tcgen/ie3tod
-tcgen/ie3tos
-tcgen/incbyt
-tcgen/iuback
-tcgen/iubin
-tcgen/iucomp
-tcgen/iufind
-tcgen/iuforw
-tcgen/iuhist
-tcgen/iuhunt
-tcgen/iulast
-tcgen/iusame
-tcgen/jbit
-tcgen/jbyt
-tcgen/jbytet
-tcgen/jbytor
-tcgen/jbytpk
-tcgen/jrsbyt
-tcgen/locf
-tcgen/mbytet
-tcgen/mbytor
-tcgen/mcbyt
-tcgen/msbit
-tcgen/msbit0
-tcgen/msbit1
-tcgen/msbyt
-tcgen/noarg
-tcgen/pkbyt
-tcgen/pkchar
-tcgen/sbit
-tcgen/sbit0
-tcgen/sbit1
-tcgen/sbyt
-tcgen/sbytor
-tcgen/sbytpk
-tcgen/traceq
-tcgen/ubits
-tcgen/ublank
-tcgen/ublow
-tcgen/ubunch
-tcgen/ucopy
-tcgen/ucopiv
-tcgen/ucopyn
-tcgen/ucopy2
-tcgen/uctoh1
-tcgen/uctoh
-tcgen/ufill
-tcgen/uh1toc
-tcgen/uhtoc
-tcgen/uopt
-tcgen/upkbyt
-tcgen/upkch
-tcgen/vblank
-tcgen/vcopyn
-tcgen/vfill
-tcgen/vfix
-tcgen/vfloat
-tcgen/vzero
-tcgen/xinb
-xvect/xinb
-tcgen/xinbs
-xvect/xinbs
-tcgen/gshow
-tcgen/datime
-tcgen/datimh
-tcgen/intrac
-tcgen/iumode
-tcgen/qnexte
-tcgen/timex
-tcgen/timed
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnor/kernnor/pilot.h b/src/packlib/kernlib/kerngen/obsolete/kernnor/kernnor/pilot.h
deleted file mode 100644
index cdf4e5f..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnor/kernnor/pilot.h
+++ /dev/null
@@ -1,18 +0,0 @@
-#if 0
-* This pilot patch was created from kernnor.car patch _knord3
-#endif
-#ifndef CERNLIB_QMND3
-#define CERNLIB_QMND3
-#endif
-#ifndef CERNLIB_NORD3
-#define CERNLIB_NORD3
-#endif
-#ifndef CERNLIB_NORDSYS
-#define CERNLIB_NORDSYS
-#endif
-#ifndef CERNLIB_XVECT
-#define CERNLIB_XVECT
-#endif
-#ifndef CERNLIB_TCGEN
-#define CERNLIB_TCGEN
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnor/kernnor/q_andor.inc b/src/packlib/kernlib/kerngen/obsolete/kernnor/kernnor/q_andor.inc
deleted file mode 100644
index 8ebb37d..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnor/kernnor/q_andor.inc
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: q_andor.inc,v 1.1.1.1 1996/02/15 17:54:47 mclareni Exp $
-*
-* $Log: q_andor.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:54:47 mclareni
-* Kernlib
-*
-*
-#ifndef CERNLIB_KERNNOR_Q_ANDOR_INC
-#define CERNLIB_KERNNOR_Q_ANDOR_INC
-*
-*
-* q_andor.inc
-*
-* IAND / IOR / IEOR / NOT are standard on NORD 500
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnor/kernnor/q_cbyt.inc b/src/packlib/kernlib/kerngen/obsolete/kernnor/kernnor/q_cbyt.inc
deleted file mode 100644
index 5ea846c..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnor/kernnor/q_cbyt.inc
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: q_cbyt.inc,v 1.1.1.1 1996/02/15 17:54:47 mclareni Exp $
-*
-* $Log: q_cbyt.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:54:47 mclareni
-* Kernlib
-*
-*
-#ifndef CERNLIB_KERNNOR_Q_CBYT_INC
-#define CERNLIB_KERNNOR_Q_CBYT_INC
-*
-*
-* q_cbyt.inc
-*
- MCBYT (MZ,IZQ,IZW,IZP,NZB) = IOR ( IAND (IZW, NOT(
- + ISHFT (ISHFT(NOT(0),-32+NZB), IZP-1)))
- + , ISHFT (ISHFT(ISHFT(MZ,-IZQ+1),32-NZB), -33+IZP+NZB) )
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnor/kernnor/q_jbit.inc b/src/packlib/kernlib/kerngen/obsolete/kernnor/kernnor/q_jbit.inc
deleted file mode 100644
index 4721165..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnor/kernnor/q_jbit.inc
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: q_jbit.inc,v 1.1.1.1 1996/02/15 17:54:47 mclareni Exp $
-*
-* $Log: q_jbit.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:54:47 mclareni
-* Kernlib
-*
-*
-#ifndef CERNLIB_KERNNOR_Q_JBIT_INC
-#define CERNLIB_KERNNOR_Q_JBIT_INC
-*
-*
-* q_jbit.inc
-*
- JBIT (IZW,IZP) = ISHFT (ISHFT(IZW,32-IZP), -31)
- JBYT (IZW,IZP,NZB) = ISHFT (ISHFT(IZW,33-IZP-NZB), -32+NZB)
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnor/kernnor/q_jbytet.inc b/src/packlib/kernlib/kerngen/obsolete/kernnor/kernnor/q_jbytet.inc
deleted file mode 100644
index 12626f3..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnor/kernnor/q_jbytet.inc
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: q_jbytet.inc,v 1.1.1.1 1996/02/15 17:54:47 mclareni Exp $
-*
-* $Log: q_jbytet.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:54:47 mclareni
-* Kernlib
-*
-*
-#ifndef CERNLIB_KERNNOR_Q_JBYTET_INC
-#define CERNLIB_KERNNOR_Q_JBYTET_INC
-*
-*
-* q_jbytet.inc
-*
- JBYTET (MZ,IZW,IZP,NZB) = IAND (MZ,
- + ISHFT (ISHFT(IZW,33-IZP-NZB),-32+NZB) )
- JBYTOR (MZ,IZW,IZP,NZB) = IOR (MZ,
- + ISHFT (ISHFT(IZW,33-IZP-NZB),-32+NZB) )
- MBYTET (MZ,IZW,IZP,NZB) = IAND (IZW, NOT(ISHFT (
- + ISHFT(NOT(MZ),32-NZB),-33+IZP+NZB)) )
- MBYTOR (MZ,IZW,IZP,NZB) = IOR (IZW, ISHFT (
- + ISHFT(MZ,32-NZB),-33+IZP+NZB) )
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnor/kernnor/q_sbit.inc b/src/packlib/kernlib/kerngen/obsolete/kernnor/kernnor/q_sbit.inc
deleted file mode 100644
index 5fde69d..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnor/kernnor/q_sbit.inc
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: q_sbit.inc,v 1.1.1.1 1996/02/15 17:54:47 mclareni Exp $
-*
-* $Log: q_sbit.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:54:47 mclareni
-* Kernlib
-*
-*
-#ifndef CERNLIB_KERNNOR_Q_SBIT_INC
-#define CERNLIB_KERNNOR_Q_SBIT_INC
-*
-*
-* q_sbit.inc
-*
- MSBIT0 (IZW,IZP) = IAND (IZW, NOT(ISHFT(1,IZP-1)) )
- MSBIT1 (IZW,IZP) = IOR (IZW, ISHFT(1,IZP-1) )
- MSBIT (MZ,IZW,IZP) = IOR (IAND (IZW, NOT(ISHFT(1,IZP-1)) )
- + , ISHFT(IAND(MZ,1),IZP-1))
- MSBYT (MZ,IZW,IZP,NZB) = IOR ( IAND (IZW, NOT(
- + ISHFT (ISHFT(NOT(0),-32+NZB), IZP-1)))
- + , ISHFT (ISHFT(MZ, 32-NZB), -33+IZP+NZB) )
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnor/kernnor/q_shift.inc b/src/packlib/kernlib/kerngen/obsolete/kernnor/kernnor/q_shift.inc
deleted file mode 100644
index 5f08d84..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnor/kernnor/q_shift.inc
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: q_shift.inc,v 1.1.1.1 1996/02/15 17:54:47 mclareni Exp $
-*
-* $Log: q_shift.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:54:47 mclareni
-* Kernlib
-*
-*
-#ifndef CERNLIB_KERNNOR_Q_SHIFT_INC
-#define CERNLIB_KERNNOR_Q_SHIFT_INC
-*
-*
-* q_shift.inc
-*
- ISHFTL (IZW,NZB) = ISHFT (IZW, NZB)
- ISHFTR (IZW,NZB) = ISHFT (IZW, -NZB)
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnor/kernnor/qmnor.h b/src/packlib/kernlib/kerngen/obsolete/kernnor/kernnor/qmnor.h
deleted file mode 100644
index 211598f..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnor/kernnor/qmnor.h
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: qmnor.h,v 1.1.1.1 1996/02/15 17:54:46 mclareni Exp $
-*
-* $Log: qmnor.h,v $
-* Revision 1.1.1.1 1996/02/15 17:54:46 mclareni
-* Kernlib
-*
-*
-* This directory was created from kernnor.car patch qmnd3
-#ifndef CERNLIB_F77
-#define CERNLIB_F77
-#endif
-#ifndef CERNLIB_B32
-#define CERNLIB_B32
-#endif
-#ifndef CERNLIB_A4
-#define CERNLIB_A4
-#endif
-#ifndef CERNLIB_HEX
-#define CERNLIB_HEX
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/Imakefile b/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/Imakefile
deleted file mode 100644
index 308f02d..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/Imakefile
+++ /dev/null
@@ -1,15 +0,0 @@
-SRCS_F= \ @@\
- btest.F ibclr.F ibset.F ie3fod.F ie3fos.F ie3tod.F ie3tos.F \ @@\
- jbytor.F mbytet.F mbytor.F mcbyt.F msbit.F msbit0.F msbit1.F \ @@\
- msbyt.F traceq.F xinb.F xinbs.F
-
-SRCS_S= \ @@\
- cbyt.s incbyt.s iuback.s iubin.s iucomp.s iufind.s iuforw.s \ @@\
- iuhist.s iuhunt.s iulast.s iusame.s jbit.s jbyt.s jbytet.s jbytpk.s \ @@\
- jrsbyt.s locf.s noarg.s pkbyt.s pkchar.s rndm.s rndm2.s sbit.s \ @@\
- sbit0.s sbit1.s sbyt.s sbytor.s sbytpk.s ubits.s ublank.s ublow.s \ @@\
- ubunch.s ucopiv.s ucopy.s ucopy2.s ucopyn.s uctoh.s uctoh1.s \ @@\
- ufill.s uh1toc.s uhtoc.s uopt.s upkbyt.s upkch.s vblank.s vcopyn.s \ @@\
- vfill.s vfix.s vfloat.s vzero.s
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/btest.F b/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/btest.F
deleted file mode 100644
index 9ef7fa3..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/btest.F
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: btest.F,v 1.1.1.1 1996/02/15 17:54:47 mclareni Exp $
-*
-* $Log: btest.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:47 mclareni
-* Kernlib
-*
-*
-#include "kernnor/pilot.h"
- LOGICAL FUNCTION BTEST(I,N)
-C
-C CERN PROGLIB# M441 BTEST .VERSION KERNNOR 2.04 870524
-C ORIG. 01/11/85 H.RENSHALL
-C
-C NORD-500 VERSION OF ANSI/ISA FUNCTION BTEST
-C N IS THE BIT TO BE TESTED
-C
- BTEST = .FALSE.
- IF (IBIT(I,N).NE.0) BTEST=.TRUE.
- END
-#ifdef CERNLIB_TCGEN_BTEST
-#undef CERNLIB_TCGEN_BTEST
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/cbyt.s b/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/cbyt.s
deleted file mode 100644
index 4629688..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/cbyt.s
+++ /dev/null
@@ -1,35 +0,0 @@
-*
-* $Id: cbyt.s,v 1.1.1.1 1996/02/15 17:54:47 mclareni Exp $
-*
-* $Log: cbyt.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:47 mclareni
-* Kernlib
-*
-*
- MODULE M_CBYT
-%
-% CERN PROGLIB# M421 CBYT .VERSION KERNNOR 1.01 800718
-% ORIG. H.OVERAS, CERN, 791213
-%
-% CALL CBYT(AM,JA,XTM,JT,NBIT) COPY BYTE JA TO BYTE JT
-%
- EXPORT CBYT
- ROUTINE CBYT
- LIB CBYT
-VBAS: STACK FIXED
-PAR: W BLOCK 5
- ENDSTACK
-CBYT: ENTF VBAS
- W2:=IND(B.PAR+4)
- W2-1
- W3:=IND(B.PAR+12)
- W3-1
- W4:=IND(B.PAR+16)
- W1 GETBF IND(B.PAR),BY2,BY4
- W1 PUTBF IND(B.PAR+8),BY3,BY4
- RET
- ENDROUTINE
- ENDMODULE
-#ifdef CERNLIB_TCGEN_CBYT
-#undef CERNLIB_TCGEN_CBYT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/ibclr.F b/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/ibclr.F
deleted file mode 100644
index 5853693..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/ibclr.F
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: ibclr.F,v 1.1.1.1 1996/02/15 17:54:47 mclareni Exp $
-*
-* $Log: ibclr.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:47 mclareni
-* Kernlib
-*
-*
-#include "kernnor/pilot.h"
- FUNCTION IBCLR(I,N)
-C
-C CERN PROGLIB# M441 IBCLR .VERSION KERNNOR 2.04 870524
-C ORIG. 01/11/85 H.RENSHALL
-C
-C NORD-500 VERSION OF ANSI/ISA FUNCTION IBCLR
-C N IS THE POSTION OF THE BIT TO BE CLEARED
-C
- J= I
- CALL CLBIT(J,N)
- IBCLR= J
- END
-#ifdef CERNLIB_TCGEN_IBCLR
-#undef CERNLIB_TCGEN_IBCLR
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/ibset.F b/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/ibset.F
deleted file mode 100644
index 6d380f8..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/ibset.F
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: ibset.F,v 1.1.1.1 1996/02/15 17:54:47 mclareni Exp $
-*
-* $Log: ibset.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:47 mclareni
-* Kernlib
-*
-*
-#include "kernnor/pilot.h"
- FUNCTION IBSET(I,N)
-C
-C CERN PROGLIB# M441 IBSET .VERSION KERNNOR 2.04 870524
-C ORIG. 01/11/85 H.RENSHALL
-C
-C NORD-500 VERSION OF ANSI/ISA FUNCTION IBSET
-C N IS THE POSITION OF THE BIT TO BE SET
-C
- J= I
- CALL STBIT(J,N)
- IBSET= J
- END
-#ifdef CERNLIB_TCGEN_IBSET
-#undef CERNLIB_TCGEN_IBSET
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/ie3fod.F b/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/ie3fod.F
deleted file mode 100644
index 40502da..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/ie3fod.F
+++ /dev/null
@@ -1,75 +0,0 @@
-*
-* $Id: ie3fod.F,v 1.1.1.1 1996/02/15 17:54:47 mclareni Exp $
-*
-* $Log: ie3fod.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:47 mclareni
-* Kernlib
-*
-*
-#include "kernnor/pilot.h"
- SUBROUTINE IE3FOD (MS,MT,NDPN,JBAD)
-C
-C CERN PROGLIB# M220 IE3FOD .VERSION KERNNOR 2.03 861204
-
-C- Convert double precision for output with copy
-C- from source in native to target in IEEE data format
-
- DIMENSION MS(99), MT(99)
-
- DOUBLE PRECISION THDB
- DIMENSION THIS(2)
- EQUIVALENCE (THDB,THIS)
- EQUIVALENCE (ITHA,THA,THIS(1)), (ITHB,THB,THIS(2))
-
- PARAMETER (IBADMS = 17777777777 B)
- PARAMETER (IBADCS = 17740177000 B)
- PARAMETER (IBADCD = 17774017700 B)
- PARAMETER (IOVPCS = 17740000000 B)
- PARAMETER (IOVPCD = 17774000000 B)
- PARAMETER (IOVNCS = 37740000000 B)
- PARAMETER (IOVNCD = 37774000000 B)
-
-
- JFAI = 0
- JMS = 0
- JMT = 0
-
- DO 449 JL=1,NDPN
- ITHA = MS(JMS+1)
- IF (ITHA.EQ.0) GO TO 442
- ITHB = MS(JMS+2)
- JSIGN = ISHFT (ITHA,-31)
- JEXP = ISHFT (ISHFT(ITHA,1), -23)
- IF (JEXP.EQ.0) GO TO 441
- IF (JEXP.EQ.511) GO TO 433
- JMANT = ISHFT (ISHFT(ITHA,10), -12)
- ITHB = ISHFT (ITHA,30) .OR. ISHFT (ITHB,-2)
- ITHA = ISHFT(JSIGN,31) .OR. ISHFT(JEXP+766,20) .OR. JMANT
- GO TO 447
-
-C-- overflow / NaN
- 433 JFAI = JL
- IF (ITHA.NE.IBADMS) THEN
- IF (JSIGN.EQ.0) THEN
- ITHA = IOVPCD
- ELSE
- ITHA = IOVNCD
- ENDIF
- ELSE
- ITHA = IBADCD
- ENDIF
- GO TO 442
-
- 441 ITHA = 0
- 442 ITHB = 0
- 447 MT(JMT+1) = ITHA
- MT(JMT+2) = ITHB
- JMT = JMT + 2
- 449 JMS = JMS + 2
-
- JBAD = JFAI
- RETURN
- END
-#ifdef CERNLIB_TCGEN_IE3FOD
-#undef CERNLIB_TCGEN_IE3FOD
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/ie3fos.F b/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/ie3fos.F
deleted file mode 100644
index cba8541..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/ie3fos.F
+++ /dev/null
@@ -1,78 +0,0 @@
-*
-* $Id: ie3fos.F,v 1.1.1.1 1996/02/15 17:54:47 mclareni Exp $
-*
-* $Log: ie3fos.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:47 mclareni
-* Kernlib
-*
-*
-#include "kernnor/pilot.h"
- SUBROUTINE IE3FOS (MS,MT,NWDO,JBAD)
-C
-C CERN PROGLIB# M220 IE3FOS .VERSION KERNNOR 2.03 861204
-
-C- Convert single precision for output with copy
-C- from source in native to target in IEEE data format
-
- DIMENSION MS(99), MT(99)
-
- DOUBLE PRECISION THDB
- DIMENSION THIS(2)
- EQUIVALENCE (THDB,THIS)
- EQUIVALENCE (ITHA,THA,THIS(1)), (ITHB,THB,THIS(2))
-
- PARAMETER (IBADMS = 17777777777 B)
- PARAMETER (IBADCS = 17740177000 B)
- PARAMETER (IBADCD = 17774017700 B)
- PARAMETER (IOVPCS = 17740000000 B)
- PARAMETER (IOVPCD = 17774000000 B)
- PARAMETER (IOVNCS = 37740000000 B)
- PARAMETER (IOVNCD = 37774000000 B)
-
-
- JBAD = 0
- JMS = 0
- JMT = 0
-
- 301 DO 349 JL=1,NWDO
- ITHA = MS(JMS+1)
- IF (ITHA.EQ.0) GO TO 347
- JSIGN = ISHFT (ITHA,-31)
- JEXP = ISHFT (ISHFT(ITHA,1), -23)
- JEXP = JEXP - 130
- IF (JEXP.LE.0) GO TO 331
- IF (JEXP.GE.255) GO TO 333
- JMANT = ISHFT (ISHFT(ITHA,10), -9)
- ITHA = ISHFT(JSIGN,31) .OR. ISHFT(JEXP,23) .OR. JMANT
- GO TO 347
-
-C-- make de-normalized number
- 331 IF (JEXP.LE.-23) GO TO 341
- ITHA = ITHA .OR. 20000000 B
- ITHA = ISHFT (ISHFT(ITHA,9),JEXP-9)
- ITHA = ITHA .OR. ISHFT(JSIGN,31)
- GO TO 347
-
-C-- overflow
- 333 JBAD = JL
- IF (ITHA.NE.IBADMS) THEN
- IF (JSIGN.EQ.0) THEN
- ITHA = IOVPCS
- ELSE
- ITHA = IOVNCS
- ENDIF
- ELSE
- ITHA = IBADCS
- ENDIF
- GO TO 347
-
- 341 ITHA = 0
- 347 MT(JMT+1) = ITHA
- JMT = JMT + 1
- 349 JMS = JMS + 1
-
- RETURN
- END
-#ifdef CERNLIB_TCGEN_IE3FOS
-#undef CERNLIB_TCGEN_IE3FOS
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/ie3tod.F b/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/ie3tod.F
deleted file mode 100644
index 2c1d48b..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/ie3tod.F
+++ /dev/null
@@ -1,96 +0,0 @@
-*
-* $Id: ie3tod.F,v 1.1.1.1 1996/02/15 17:54:47 mclareni Exp $
-*
-* $Log: ie3tod.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:47 mclareni
-* Kernlib
-*
-*
-#include "kernnor/pilot.h"
- SUBROUTINE IE3TOD (MS,MT,NDPN,JBAD)
-C
-C CERN PROGLIB# M220 IE3TOD .VERSION KERNNOR 2.03 861204
-
-C- Convert double precision for input with copy
-C- from source in IEEE to target in native data format
-
- DIMENSION MS(99), MT(99)
-
- DOUBLE PRECISION THDB
- DIMENSION THIS(2)
- EQUIVALENCE (THDB,THIS)
- EQUIVALENCE (ITHA,THA,THIS(1)), (ITHB,THB,THIS(2))
-
- PARAMETER (IBADMS = 17777777777 B)
- PARAMETER (JEXMIN = -255, JEXMAX=253)
- PARAMETER (IOVPMS = 17777777770 B)
- PARAMETER (IOVNMS = 37777777770 B)
- PARAMETER (IBADMD = IBADMS, IBADME = 0)
- PARAMETER (IOVPMD = IOVPMS, IOVNMD = IOVNMS)
-
-#include "kernnor/q_jbit.inc"
-* Ignoring t=pass
-
- JFAI = 0
- JMS = 0
- JMT = 0
-
- DO 449 JL=1,NDPN
- ITHA = MS(JMS+1)
- IF (ITHA.EQ.0) GO TO 442
- ITHB = MS(JMS+2)
- JSIGN = JBIT (ITHA,32)
- JEXP = JBYT (ITHA,21,11)
- JMANT = JBYT (ITHA, 1,20)
- IF (JEXP.EQ.0) GO TO 431
- IF (JEXP.EQ.2047) GO TO 433
-
- JMANT = JMANT + 1 048 576
- JEXP = JEXP - 1023
- IF (JEXP.GT.JEXMAX) GO TO 432
- 424 IF (JEXP.LT.JEXMIN) GO TO 441
-
- JMANS = JBYT (ITHB,17,16)
- JMANR = JBYT (ITHB, 1,16)
-
- JPRE = ISIGN (48,JEXP)
- THDB = ( DBLE(JMANT)
- + + DBLE(FLOAT(JMANS)*2.**(-16))
- + + DBLE(FLOAT(JMANR)*2.**(-32)) ) * 2.**(JPRE-20)
- THDB = THDB * 2.**(JEXP-JPRE)
- IF (JSIGN.EQ.0) GO TO 447
- THDB = -THDB
- GO TO 447
-
- 431 IF (JMANT.EQ.0) GO TO 441
- JEXP = -1022
- GO TO 424
-
- 432 JMANT = 0
- 433 IF (JMANT.EQ.0) THEN
- IF (JSIGN.EQ.0) THEN
- ITHB = IOVPMD
- ELSE
- ITHB = IOVNMD
- ENDIF
- ELSE
- ITHB = IBADMD
- ENDIF
- JFAI = JL
- ITHA = ITHB
- ITHB = IBADME
- GO TO 447
-
- 441 ITHA = 0
- 442 ITHB = 0
- 447 MT(JMT+1) = ITHA
- MT(JMT+2) = ITHB
- JMT = JMT + 2
- 449 JMS = JMS + 2
-
- JBAD = JFAI
- RETURN
- END
-#ifdef CERNLIB_TCGEN_IE3TOD
-#undef CERNLIB_TCGEN_IE3TOD
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/ie3tos.F b/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/ie3tos.F
deleted file mode 100644
index 67f1a39..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/ie3tos.F
+++ /dev/null
@@ -1,85 +0,0 @@
-*
-* $Id: ie3tos.F,v 1.1.1.1 1996/02/15 17:54:48 mclareni Exp $
-*
-* $Log: ie3tos.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:48 mclareni
-* Kernlib
-*
-*
-#include "kernnor/pilot.h"
- SUBROUTINE IE3TOS (MS,MT,NWDO,JBAD)
-C
-C CERN PROGLIB# M220 IE3TOS .VERSION KERNNOR 2.03 861204
-
-C- Convert single precision for input with copy
-C- from source in IEEE to target in native data format
-
- DIMENSION MS(99), MT(99)
-
- DOUBLE PRECISION THDB
- DIMENSION THIS(2)
- EQUIVALENCE (THDB,THIS)
- EQUIVALENCE (ITHA,THA,THIS(1)), (ITHB,THB,THIS(2))
-
- PARAMETER (IBADMS = 17777777777 B)
- PARAMETER (JEXMIN = -255, JEXMAX=253)
- PARAMETER (IOVPMS = 17777777770 B)
- PARAMETER (IOVNMS = 37777777770 B)
- PARAMETER (IBADMD = IBADMS, IBADME = 0)
- PARAMETER (IOVPMD = IOVPMS, IOVNMD = IOVNMS)
-
-#include "kernnor/q_jbit.inc"
-* Ignoring t=pass
-
- JBAD = 0
- JMS = 0
- JMT = 0
-
- 301 DO 349 JL=1,NWDO
- ITHA = MS(JMS+1)
- IF (ITHA.EQ.0) GO TO 347
- JSIGN = JBIT (ITHA,32)
- JEXP = JBYT (ITHA,24,8)
- JMANT = JBYT (ITHA,1,23)
- IF (JEXP.EQ.0) GO TO 331
- IF (JEXP.EQ.255) GO TO 333
- JMANT = JMANT + 8 388 608
- JEXP = JEXP - 127
- JPRE = ISIGN (23,JEXP)
- THA = FLOAT(JMANT) * 2.**(JPRE-23)
- THA = THA * 2.**(JEXP-JPRE)
- IF (JSIGN.EQ.0) GO TO 347
- THA = -THA
- GO TO 347
-
- 331 IF (JMANT.EQ.0) GO TO 341
- THA = FLOAT(JMANT) * 2.**(-63)
- THA = THA * 2.**(-86)
- IF (ITHA .EQ.0) GO TO 347
- IF (JSIGN.EQ.0) GO TO 347
- THA = -THA
- GO TO 347
-
- 333 IF (JMANT.EQ.0) THEN
- IF (JSIGN.EQ.0) THEN
- ITHB = IOVPMS
- ELSE
- ITHB = IOVNMS
- ENDIF
- ELSE
- ITHB = IBADMS
- ENDIF
- JBAD = JL
- ITHA = ITHB
- GO TO 347
-
- 341 ITHA = 0
- 347 MT(JMT+1) = ITHA
- JMT = JMT + 1
- 349 JMS = JMS + 1
-
- RETURN
- END
-#ifdef CERNLIB_TCGEN_IE3TOS
-#undef CERNLIB_TCGEN_IE3TOS
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/incbyt.s b/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/incbyt.s
deleted file mode 100644
index 0e3f8c9..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/incbyt.s
+++ /dev/null
@@ -1,42 +0,0 @@
-*
-* $Id: incbyt.s,v 1.1.1.1 1996/02/15 17:54:48 mclareni Exp $
-*
-* $Log: incbyt.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:48 mclareni
-* Kernlib
-*
-*
- MODULE M_INCBYT
-%
-% CERN PROGLIB# M423 INCBYT .VERSION KERNNOR 1.10 811116
-% ORIG. H.OVERAS, CERN, 810609
-%
-% IX = INCBYT(INC,A,JTH,NBITS) INCREMENT PACKED BYTE
-% NBITS(3)=NBIT,INWORD,MA
-%
- EXPORT INCBYT
- ROUTINE INCBYT
- LIB INCBYT
-VBAS: STACK FIXED
-PAR: W BLOCK 4
- ENDSTACK
-INCBYT: ENTF VBAS
- W RLADDR IND(B.PAR+12)
- W4:=IND(B.PAR+8)
- W4-1
- W2 DIV4 R4,R.4,R4
- W2*R.0
- W3 GETBF IND(B.PAR+4)(R4),BY2,R.3
- W3+IND(B.PAR)
- W1 CLR
- W3 COMP R.8
- IF<=GO BACK
- W SUB3 R3,R.8,R1
- W3:=R.8
-BACK: W3 PUTBF IND(B.PAR+4)(R4),BY2,R.3
- RET
- ENDROUTINE
- ENDMODULE
-#ifdef CERNLIB_TCGEN_INCBYT
-#undef CERNLIB_TCGEN_INCBYT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/iuback.s b/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/iuback.s
deleted file mode 100644
index 1a99509..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/iuback.s
+++ /dev/null
@@ -1,55 +0,0 @@
-*
-* $Id: iuback.s,v 1.1.1.1 1996/02/15 17:54:48 mclareni Exp $
-*
-* $Log: iuback.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:48 mclareni
-* Kernlib
-*
-*
- MODULE M_IUBACK
-%
-% CERN PROGLIB# M410 IUBACK .VERSION KERNNOR 1.01 800718
-% ORIG. H.OVERAS, CERN, 791213
-%
-% IX = IUBACK(AVM,JL,JR) READ A1-SECTION BACKWARD FOR INTEGER
-%
- IMPORT-D SLATE
- EXPORT IUBACK
- ROUTINE IUBACK
- LIB IUBACK
-VBAS: STACK FIXED
-PAR: W BLOCK 3
-BLANK: W DATA ' '
-TENTON:W DATA 1
- ENDSTACK
-IUBACK: ENTF VBAS
- W1 CLR
- W2:=IND(B.PAR+8)
- W2-1
- W4:=IND(B.PAR+4)
- W4-2
- W SET1 B.TENTON
- W STZ SLATE
-L12: W2 COMP R4
- IF=GO L20
- W3:=IND(B.PAR)(R2)
- W3 COMP B.BLANK
- IF=GO L19
- W SHL R3,-24
- BY3 COMP 60B:B
- IF < GO L20
- BY3 COMP 71B:B
- IF > GO L20
- BY3-60B:B
- W1 PSUM B.TENTON,R3
- W MUL2 B.TENTON,10
- W INCR SLATE
-L19: W2-1
- GO L12
-L20: W ADD3 R2,1,SLATE+4
- RET
- ENDROUTINE
- ENDMODULE
-#ifdef CERNLIB_TCGEN_IUBACK
-#undef CERNLIB_TCGEN_IUBACK
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/iubin.s b/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/iubin.s
deleted file mode 100644
index ea82822..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/iubin.s
+++ /dev/null
@@ -1,44 +0,0 @@
-*
-* $Id: iubin.s,v 1.1.1.1 1996/02/15 17:54:48 mclareni Exp $
-*
-* $Log: iubin.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:48 mclareni
-* Kernlib
-*
-*
- MODULE M_IUBIN
-%
-% CERN PROGLIB# Y202 IUBIN .VERSION KERNNOR 1.05 810521
-% ORIG. H.OVERAS, CERN, 810609
-%
-% IX = IUBIN(A,PAR,SPILL) HISTOGRAM BIN. PAR=NA,DA,ALOW
-%
- EXPORT IUBIN
- ROUTINE IUBIN
- LIB IUBIN
-VBAS: STACK FIXED
-ARG: W BLOCK 3
- ENDSTACK
-IUBIN: ENTF VBAS
- W SET1 IND(B.ARG+8)
- W RLADDR IND(B.ARG+4)
- F SUB3 IND(B.ARG+0),R.8,R1
- F DIV2 R1,R.4
- F1+1.000001
- F WCONV R1,R1
- IF<=GO UNDER
- W2:=R.0
- W1 COMP R2
- IF>GO OVER
- W STZ IND(B.ARG+8)
- RET
-UNDER: W1 CLR
- RET
-OVER: W1:=R2
- W INCR R1
- RET
- ENDROUTINE
- ENDMODULE
-#ifdef CERNLIB_TCGEN_IUBIN
-#undef CERNLIB_TCGEN_IUBIN
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/iucomp.s b/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/iucomp.s
deleted file mode 100644
index c83947a..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/iucomp.s
+++ /dev/null
@@ -1,39 +0,0 @@
-*
-* $Id: iucomp.s,v 1.1.1.1 1996/02/15 17:54:48 mclareni Exp $
-*
-* $Log: iucomp.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:48 mclareni
-* Kernlib
-*
-*
- MODULE M_IUCOMP
-%
-% CERN PROGLIB# V304 IUCOMP .VERSION KERNNOR 1.01 800718
-% ORIG. H.OVERAS, CERN, 791213
-%
-% JX = IUCOMP(CM,AVM,N) FIND C IN AV, JX=0 IF NOT FOUND
-%
- EXPORT IUCOMP
- ROUTINE IUCOMP
- LIB IUCOMP
-VBAS: STACK FIXED
-PAR: W BLOCK 3
- ENDSTACK
-IUCOMP: ENTF VBAS
- W1:=0
- W2:=IND(B.PAR+8)
- IF=GO OUT
- W2-1
- W3:=IND(B.PAR)
-BEGLP: W3 COMP IND(B.PAR+4)(R1)
- IF=GO MATCH
- W LOOPI R1,R2,BEGLP
- W1:=0
-OUT: RET
-MATCH: W1+1
- RET
- ENDROUTINE
- ENDMODULE
-#ifdef CERNLIB_TCGEN_IUCOMP
-#undef CERNLIB_TCGEN_IUCOMP
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/iufind.s b/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/iufind.s
deleted file mode 100644
index e1cf61e..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/iufind.s
+++ /dev/null
@@ -1,37 +0,0 @@
-*
-* $Id: iufind.s,v 1.1.1.1 1996/02/15 17:54:48 mclareni Exp $
-*
-* $Log: iufind.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:48 mclareni
-* Kernlib
-*
-*
- MODULE M_IUFIND
-%
-% CERN PROGLIB# V304 IUFIND .VERSION KERNNOR 1.01 800718
-% ORIG. H.OVERAS, CERN, 791213
-%
-% JX = IUFIND(CM,AVM,JL,JR) FIND C IN AV(JL/JR), JX=JR+1 NOT FOUND
-%
- EXPORT IUFIND
- ROUTINE IUFIND
- LIB IUFIND
-VBAS: STACK FIXED
-PAR: W BLOCK 4
- ENDSTACK
-IUFIND: ENTF VBAS
- W1:=IND(B.PAR+8)
- W1-1
- W2:=IND(B.PAR+12)
- W2-1
- W3:=IND(B.PAR)
-BEGLP: W3 COMP IND(B.PAR+4)(R1)
- IF=GO FIN
- W LOOPI R1,R2,BEGLP
-FIN: W1+1
- RET
- ENDROUTINE
- ENDMODULE
-#ifdef CERNLIB_TCGEN_IUFIND
-#undef CERNLIB_TCGEN_IUFIND
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/iuforw.s b/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/iuforw.s
deleted file mode 100644
index fb5c8f8..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/iuforw.s
+++ /dev/null
@@ -1,51 +0,0 @@
-*
-* $Id: iuforw.s,v 1.1.1.1 1996/02/15 17:54:48 mclareni Exp $
-*
-* $Log: iuforw.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:48 mclareni
-* Kernlib
-*
-*
- MODULE M_IUFORW
-%
-% CERN PROGLIB# M410 IUFORW .VERSION KERNNOR 1.01 800718
-% ORIG. H.OVERAS, CERN, 791213
-%
-% IX = IUFORW(AVM,JL,JR) READ A1-SECTION FORWARD FOR INTEGER
-%
- IMPORT-D SLATE
- EXPORT IUFORW
- ROUTINE IUFORW
- LIB IUFORW
-VBAS: STACK FIXED
-PAR: W BLOCK 3
-BLANK: W DATA ' '
- ENDSTACK
-IUFORW: ENTF VBAS
- W1 CLR
- W2:=IND(B.PAR+4)
- W2-1
- W4:=IND(B.PAR+8)
- W STZ SLATE
-L12: W2 COMP R4
- IF=GO L20
- W3:=IND(B.PAR)(R2)
- W3 COMP B.BLANK
- IF=GO L19
- W SHL R3,-24
- BY3 COMP 60B:B
- IF < GO L20
- BY3 COMP 71B:B
- IF > GO L20
- BY3-60B:B
- W1 MULAD 10,R3
- W INCR SLATE
-L19: W2+1
- GO L12
-L20: W ADD3 R2,1,SLATE+4
- RET
- ENDROUTINE
- ENDMODULE
-#ifdef CERNLIB_TCGEN_IUFORW
-#undef CERNLIB_TCGEN_IUFORW
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/iuhist.s b/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/iuhist.s
deleted file mode 100644
index cf2a67a..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/iuhist.s
+++ /dev/null
@@ -1,43 +0,0 @@
-*
-* $Id: iuhist.s,v 1.1.1.1 1996/02/15 17:54:48 mclareni Exp $
-*
-* $Log: iuhist.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:48 mclareni
-* Kernlib
-*
-*
- MODULE M_IUHIST
-%
-% CERN PROGLIB# Y203 IUHIST .VERSION KERNNOR 1.05 810521
-% ORIG. H.OVERAS, CERN, 810609
-%
-% IX = IUHIST(A,PAR,SPILL) HISTOGRAM BIN. PAR=NA,1./DA,ALOW
-%
- EXPORT IUHIST
- ROUTINE IUHIST
- LIB IUHIST
-VBAS: STACK FIXED
-ARG: W BLOCK 3
- ENDSTACK
-IUHIST: ENTF VBAS
- W SET1 IND(B.ARG+8)
- W RLADDR IND(B.ARG+4)
- F SUB3 IND(B.ARG+0),R.8,R1
- F1 MULAD R.4,1.000001
- F WCONV R1,R1
- IF<=GO UNDER
- W2:=R.0
- W1 COMP R2
- IF>GO OVER
- W STZ IND(B.ARG+8)
- RET
-UNDER: W1 CLR
- RET
-OVER: W1:=R2
- W INCR R1
- RET
- ENDROUTINE
- ENDMODULE
-#ifdef CERNLIB_TCGEN_IUHIST
-#undef CERNLIB_TCGEN_IUHIST
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/iuhunt.s b/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/iuhunt.s
deleted file mode 100644
index eba2f0a..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/iuhunt.s
+++ /dev/null
@@ -1,40 +0,0 @@
-*
-* $Id: iuhunt.s,v 1.1.1.1 1996/02/15 17:54:48 mclareni Exp $
-*
-* $Log: iuhunt.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:48 mclareni
-* Kernlib
-*
-*
- MODULE M_IUHUNT
-%
-% CERN PROGLIB# V304 IUHUNT .VERSION KERNNOR 1.01 800718
-% ORIG. H.OVERAS, CERN, 791213
-%
-% JX = IUHUNT(CM,AVM,N,NA) FIND C IN AV,EVERY NA, JX=0 NOT FOUND
-%
- EXPORT IUHUNT
- ROUTINE IUHUNT
- LIB IUHUNT
-VBAS: STACK FIXED
-PAR: W BLOCK 3
- ENDSTACK
-IUHUNT: ENTF VBAS
- W1:=0
- W2:=IND(B.PAR+8)
- IF=GO OUT
- W2-1
- W3:=IND(B.PAR)
- W4:=IND(B.PAR+12)
-BEGLP: W3 COMP IND(B.PAR+4)(R1)
- IF=GO MATCH
- W LOOP R1,R4,R2,BEGLP
- W1:=0
-OUT: RET
-MATCH: W1+1
- RET
- ENDROUTINE
- ENDMODULE
-#ifdef CERNLIB_TCGEN_IUHUNT
-#undef CERNLIB_TCGEN_IUHUNT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/iulast.s b/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/iulast.s
deleted file mode 100644
index 589f2dc..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/iulast.s
+++ /dev/null
@@ -1,38 +0,0 @@
-*
-* $Id: iulast.s,v 1.1.1.1 1996/02/15 17:54:48 mclareni Exp $
-*
-* $Log: iulast.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:48 mclareni
-* Kernlib
-*
-*
- MODULE M_IULAST
-%
-% CERN PROGLIB# V305 IULAST .VERSION KERNNOR 1.01 800718
-% ORIG. H.OVERAS, CERN, 791213
-%
-% JX = IULAST(CM,AVM,N) LAST WORD IN AV NOT CONTAINING C
-%
- EXPORT IULAST
- ROUTINE IULAST
- LIB IULAST
-VBAS: STACK FIXED
-PAR: W BLOCK 3
- ENDSTACK
-IULAST: ENTF VBAS
- W1:=IND(B.PAR+8)
- IF=GO OUT
- W1-1
- W3:=IND(B.PAR)
-BEGLP: W3 COMP IND(B.PAR+4)(R1)
- IF><GO DIFF
- W LOOPD R1,0,BEGLP
- W1:=0
-OUT: RET
-DIFF: W1+1
- RET
- ENDROUTINE
- ENDMODULE
-#ifdef CERNLIB_TCGEN_IULAST
-#undef CERNLIB_TCGEN_IULAST
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/iusame.s b/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/iusame.s
deleted file mode 100644
index 4c250fd..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/iusame.s
+++ /dev/null
@@ -1,54 +0,0 @@
-*
-* $Id: iusame.s,v 1.1.1.1 1996/02/15 17:54:48 mclareni Exp $
-*
-* $Log: iusame.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:48 mclareni
-* Kernlib
-*
-*
- MODULE M_IUSAME
-%
-% CERN PROGLIB# M501 IUSAME .VERSION KERNNOR 1.01 800718
-% ORIG. H.OVERAS, CERN, 791213
-%
-% NX = IUSAME(AVM,JL,JR,MIN,JXS) FIND STRING OF MIN SAME ELEMENTS
-%
- EXPORT IUSAME
- ROUTINE IUSAME
- LIB IUSAME
-VBAS: STACK FIXED
-PAR: W BLOCK 5
-MIN: W BLOCK 1
- ENDSTACK
-IUSAME: ENTF VBAS
- W1:=IND(B.PAR+4:B)
- W1-1
- W2:=IND(B.PAR+8:B)
- W MOVE IND(B.PAR+12:B),B.MIN:S
-RSTRT: W4:=1
- W3:=IND(B.PAR:B)(R1)
-BEGLP: W1+1
- W1 COMP R2
- IF=GO AFTLP
- W3 COMP IND(B.PAR:B)(R1)
- IF><GO DIFF
- W4+1
- GO BEGLP
-DIFF: W4 COMP B.MIN:S
- IF>=GO OUT
- GO RSTRT
-AFTLP: W4 COMP B.MIN:S
- IF>=GO OUT
- W1+1
- W1=:IND(B.PAR+16:B)
- W1:=0
- RET
-OUT: W1+1
- W SUB3 R1,R4,IND(B.PAR+16:B)
- W1:=W4
- RET
- ENDROUTINE
- ENDMODULE
-#ifdef CERNLIB_TCGEN_IUSAME
-#undef CERNLIB_TCGEN_IUSAME
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/jbit.s b/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/jbit.s
deleted file mode 100644
index 519b1d4..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/jbit.s
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: jbit.s,v 1.1.1.1 1996/02/15 17:54:48 mclareni Exp $
-*
-* $Log: jbit.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:48 mclareni
-* Kernlib
-*
-*
- MODULE M_JBIT
-%
-% CERN PROGLIB# M421 JBIT .VERSION KERNNOR 1.01 800718
-% ORIG. H.OVERAS, CERN, 791213
-%
-% IX = JBIT(AM,J) GET 1 BIT
-%
- EXPORT JBIT
- ROUTINE JBIT
- LIB JBIT
-VBAS: STACK FIXED
-PAR: W BLOCK 2
- ENDSTACK
-JBIT: ENTF VBAS
- W2:=IND(B.PAR+4)
- W2-1
- W1 GETBI IND(B.PAR),BY2
- RET
- ENDROUTINE
- ENDMODULE
-#ifdef CERNLIB_TCGEN_JBIT
-#undef CERNLIB_TCGEN_JBIT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/jbyt.s b/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/jbyt.s
deleted file mode 100644
index 348671f..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/jbyt.s
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: jbyt.s,v 1.1.1.1 1996/02/15 17:54:48 mclareni Exp $
-*
-* $Log: jbyt.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:48 mclareni
-* Kernlib
-*
-*
- MODULE M_JBYT
-%
-% CERN PROGLIB# M421 JBYT .VERSION KERNNOR 1.01 800718
-% ORIG. H.OVERAS, CERN, 791213
-%
-% IX = JBYT(AM,J,NBIT) GET 1 BYTE OF NBIT BITS
-%
- EXPORT JBYT
- ROUTINE JBYT
- LIB JBYT
-VBAS: STACK FIXED
-PAR: W BLOCK 3
- ENDSTACK
-JBYT: ENTF VBAS
- W2:=IND(B.PAR+4)
- W2-1
- W3:=IND(B.PAR+8)
- W1 GETBF IND(B.PAR),BY2,BY3
- RET
- ENDROUTINE
- ENDMODULE
-#ifdef CERNLIB_TCGEN_JBYT
-#undef CERNLIB_TCGEN_JBYT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/jbytet.s b/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/jbytet.s
deleted file mode 100644
index 023a4ad..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/jbytet.s
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: jbytet.s,v 1.1.1.1 1996/02/15 17:54:48 mclareni Exp $
-*
-* $Log: jbytet.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:48 mclareni
-* Kernlib
-*
-*
- MODULE M_JBYTET
-%
-% CERN PROGLIB# M421 JBYTET .VERSION KERNNOR 1.01 800718
-% ORIG. H.OVERAS, CERN, 791213
-%
-% IX = JBYTET(AM,BM,JB,NBIT) GET LOGICAL AND OF BYTES
-%
- EXPORT JBYTET
- ROUTINE JBYTET
- LIB JBYTET
-VBAS: STACK FIXED
-PAR: W BLOCK 4
- ENDSTACK
-JBYTET: ENTF VBAS
- W2:=IND(B.PAR+8)
- W2-1
- W3:=IND(B.PAR+12)
- W1 GETBF IND(B.PAR+4),BY2,BY3
- W1 AND IND(B.PAR)
- RET
- ENDROUTINE
- ENDMODULE
-#ifdef CERNLIB_TCGEN_JBYTET
-#undef CERNLIB_TCGEN_JBYTET
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/jbytor.F b/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/jbytor.F
deleted file mode 100644
index f6ee210..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/jbytor.F
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: jbytor.F,v 1.1.1.1 1996/02/15 17:54:48 mclareni Exp $
-*
-* $Log: jbytor.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:48 mclareni
-* Kernlib
-*
-*
-#include "kernnor/pilot.h"
- FUNCTION JBYTOR (MZ,IZW,IZP,NZB)
-C
-C CERN PROGLIB# M421 JBYTOR .VERSION KERNNOR 2.04 870524
-C ORIG. 19/05/87 JZ
-C
- JBYTOR = IOR (MZ, ISHFT (ISHFT(IZW,33-IZP-NZB),-32+NZB) )
- RETURN
- END
-#ifdef CERNLIB_TCGEN_JBYTOR
-#undef CERNLIB_TCGEN_JBYTOR
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/jbytpk.s b/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/jbytpk.s
deleted file mode 100644
index ec41584..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/jbytpk.s
+++ /dev/null
@@ -1,46 +0,0 @@
-*
-* $Id: jbytpk.s,v 1.1.1.1 1996/02/15 17:54:48 mclareni Exp $
-*
-* $Log: jbytpk.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:48 mclareni
-* Kernlib
-*
-*
- MODULE M_JBYTPK
-%
-% CERN PROGLIB# M422 JBYTPK .VERSION KERNNOR 1.01 800718
-% ORIG. H.OVERAS, CERN, 791213
-%
-% IX = JBYTPK(AVM,J,MPAK) MPAK=NBIT,INWORD GET PACKED BYTE
-%
- EXPORT JBYTPK
- ROUTINE JBYTPK
- LIB JBYTPK
-VBAS: STACK FIXED
-PAR: W BLOCK 3
-INWORD:W BLOCK 1
-NBIT: BY BLOCK 1
- ENDSTACK
-JBYTPK: ENTF VBAS
- W BYCONV IND(B.PAR+8),B.NBIT
- IF>GO L11
- BY SET1 B.NBIT
- W MOVE 32,B.INWORD
- GO L12
-L11: W4:=1
- W MOVE IND(B.PAR+8)(R4),B.INWORD
-L12: W4:=IND(B.PAR+4)
- W4-1
- IF<=GO L17
- W3 DIV4 R4,B.INWORD,R1
- BY3*B.NBIT
- GO L24
-L17: W1 CLR
- W3 CLR
-L24: W1 GETBF IND(B.PAR)(R1),BY3,B.NBIT
- RET
- ENDROUTINE
- ENDMODULE
-#ifdef CERNLIB_TCGEN_JBYTPK
-#undef CERNLIB_TCGEN_JBYTPK
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/jrsbyt.s b/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/jrsbyt.s
deleted file mode 100644
index 012139e..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/jrsbyt.s
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: jrsbyt.s,v 1.1.1.1 1996/02/15 17:54:48 mclareni Exp $
-*
-* $Log: jrsbyt.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:48 mclareni
-* Kernlib
-*
-*
- MODULE M_JRSBYT
-%
-% CERN PROGLIB# M421 JRSBYT .VERSION KERNNOR 1.01 800718
-% ORIG. H.OVERAS, CERN, 791213
-%
-% IX = JRSBYT(IM,XM,J,NBIT) READ BYTE AND RESET TO IM
-%
- EXPORT JRSBYT
- ROUTINE JRSBYT
- LIB JRSBYT
-VBAS: STACK FIXED
-PAR: W BLOCK 4
- ENDSTACK
-JRSBYT: ENTF VBAS
- W2:=IND(B.PAR+8)
- W2-1
- W4:=IND(B.PAR+12)
- W1 GETBF IND(B.PAR+4),BY2,BY4
- W3:=IND(B.PAR)
- W3 PUTBF IND(B.PAR+4),BY2,BY4
- RET
- ENDROUTINE
- ENDMODULE
-#ifdef CERNLIB_TCGEN_JRSBYT
-#undef CERNLIB_TCGEN_JRSBYT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/locf.s b/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/locf.s
deleted file mode 100644
index 545f2c8..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/locf.s
+++ /dev/null
@@ -1,50 +0,0 @@
-*
-* $Id: locf.s,v 1.1.1.1 1996/02/15 17:54:48 mclareni Exp $
-*
-* $Log: locf.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:48 mclareni
-* Kernlib
-*
-*
- MODULE ADRVAR
-%
-% CERN PROGLIB# N100 LOCF .VERSION KERNNOR 2.08 891120
-% ORIG. H.OVERAS, CERN, 791003
-%
-% LOCF RETURNS ADDRESS OF VARIABLE OR DESCRIPTOR
-% LOCSTR RETURNS ADDRESS OF CHARACTER STRING
-%
- EXPORT LOCF,LOCB,LOCSTR
- ROUTINE LOCF
- LIB LOCF
-LOCF: ENTF VBAS
- W1 LADDR IND(B.PAR)
- W SHL W1,-2
- RET
-VBAS: STACK FIXED
-PAR: W BLOCK 1
- ENDSTACK
- ENDROUTINE
- ROUTINE LOCB
- LIB LOCB
-LOCB: ENTF VBAS
- W1 LADDR IND(B.PAR)
- RET
-VBAS: STACK FIXED
-PAR: W BLOCK 1
- ENDSTACK
- ENDROUTINE
- ROUTINE LOCSTR
- LIB LOCSTR
-LOCSTR: ENTF VBAS
- W1:=1
- W1:=IND(B.PAR)(R1)
- RET
-VBAS: STACK FIXED
-PAR: W BLOCK 1
- ENDSTACK
- ENDROUTINE
- ENDMODULE
-#ifdef CERNLIB_TCGEN_LOCF
-#undef CERNLIB_TCGEN_LOCF
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/mbytet.F b/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/mbytet.F
deleted file mode 100644
index 3ae284b..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/mbytet.F
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: mbytet.F,v 1.1.1.1 1996/02/15 17:54:48 mclareni Exp $
-*
-* $Log: mbytet.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:48 mclareni
-* Kernlib
-*
-*
-#include "kernnor/pilot.h"
- FUNCTION MBYTET (MZ,IZW,IZP,NZB)
-C
-C CERN PROGLIB# M421 MBYTET .VERSION KERNNOR 2.04 870524
-C ORIG. 19/05/87 JZ
-C
-
- MBYTET = IAND (IZW,
- + NOT(ISHFT (ISHFT(NOT(MZ),32-NZB), -33+IZP+NZB)))
- RETURN
- END
-#ifdef CERNLIB_TCGEN_MBYTET
-#undef CERNLIB_TCGEN_MBYTET
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/mbytor.F b/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/mbytor.F
deleted file mode 100644
index 6f87b2f..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/mbytor.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: mbytor.F,v 1.1.1.1 1996/02/15 17:54:49 mclareni Exp $
-*
-* $Log: mbytor.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:49 mclareni
-* Kernlib
-*
-*
-#include "kernnor/pilot.h"
- FUNCTION MBYTOR (MZ,IZW,IZP,NZB)
-C
-C CERN PROGLIB# M421 MBYTOR .VERSION KERNNOR 2.04 870524
-C ORIG. 19/05/87 JZ
-C
-
- MBYTOR = IOR (IZW, ISHFT (ISHFT(MZ,32-NZB), -33+IZP+NZB) )
- RETURN
- END
-#ifdef CERNLIB_TCGEN_MBYTOR
-#undef CERNLIB_TCGEN_MBYTOR
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/mcbyt.F b/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/mcbyt.F
deleted file mode 100644
index a5c696f..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/mcbyt.F
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: mcbyt.F,v 1.1.1.1 1996/02/15 17:54:49 mclareni Exp $
-*
-* $Log: mcbyt.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:49 mclareni
-* Kernlib
-*
-*
-#include "kernnor/pilot.h"
- FUNCTION MCBYT (MZ,IZQ,IZW,IZP,NZB)
-C
-C CERN PROGLIB# M421 MCBYT .VERSION KERNNOR 2.04 870524
-C ORIG. 19/05/87 JZ
-C
-
- MCBYT = IOR ( IAND (IZW,
- + NOT(ISHFT (ISHFT(NOT(0),-32+NZB), IZP-1)))
- +, ISHFT (ISHFT(ISHFT(MZ,-IZQ+1),32-NZB), -33+IZP+NZB) )
- RETURN
- END
-#ifdef CERNLIB_TCGEN_MCBYT
-#undef CERNLIB_TCGEN_MCBYT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/msbit.F b/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/msbit.F
deleted file mode 100644
index ac87e72..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/msbit.F
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: msbit.F,v 1.1.1.1 1996/02/15 17:54:49 mclareni Exp $
-*
-* $Log: msbit.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:49 mclareni
-* Kernlib
-*
-*
-#include "kernnor/pilot.h"
- FUNCTION MSBIT (MZ,IZW,IZP)
-C
-C CERN PROGLIB# M421 MSBIT .VERSION KERNNOR 2.04 870524
-C ORIG. 19/05/87 JZ
-C
-
- MSBIT = IOR (IAND (IZW, NOT(ISHFT(1,IZP-1)) )
- +, ISHFT(IAND(MZ,1),IZP-1))
- RETURN
- END
-#ifdef CERNLIB_TCGEN_MSBIT
-#undef CERNLIB_TCGEN_MSBIT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/msbit0.F b/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/msbit0.F
deleted file mode 100644
index 5664bce..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/msbit0.F
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: msbit0.F,v 1.1.1.1 1996/02/15 17:54:49 mclareni Exp $
-*
-* $Log: msbit0.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:49 mclareni
-* Kernlib
-*
-*
-#include "kernnor/pilot.h"
- FUNCTION MSBIT0 (IZW,IZP)
-C
-C CERN PROGLIB# M421 MSBIT0 .VERSION KERNNOR 2.04 870524
-C ORIG. 19/05/87 JZ
-C
- MSBIT0 = IAND (IZW, NOT(ISHFT(1,IZP-1)) )
- RETURN
- END
-#ifdef CERNLIB_TCGEN_MSBIT0
-#undef CERNLIB_TCGEN_MSBIT0
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/msbit1.F b/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/msbit1.F
deleted file mode 100644
index 040780c..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/msbit1.F
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: msbit1.F,v 1.1.1.1 1996/02/15 17:54:49 mclareni Exp $
-*
-* $Log: msbit1.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:49 mclareni
-* Kernlib
-*
-*
-#include "kernnor/pilot.h"
- FUNCTION MSBIT1 (IZW,IZP)
-C
-C CERN PROGLIB# M421 MSBIT1 .VERSION KERNNOR 2.04 870524
-C ORIG. 19/05/87 JZ
-C
- MSBIT1 = IOR (IZW, ISHFT(1,IZP-1) )
- RETURN
- END
-#ifdef CERNLIB_TCGEN_MSBIT1
-#undef CERNLIB_TCGEN_MSBIT1
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/msbyt.F b/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/msbyt.F
deleted file mode 100644
index 2c44c5a..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/msbyt.F
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: msbyt.F,v 1.1.1.1 1996/02/15 17:54:49 mclareni Exp $
-*
-* $Log: msbyt.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:49 mclareni
-* Kernlib
-*
-*
-#include "kernnor/pilot.h"
- FUNCTION MSBYT (MZ,IZW,IZP,NZB)
-C
-C CERN PROGLIB# M421 MSBYT .VERSION KERNNOR 2.04 870524
-C ORIG. 19/05/87 JZ
-C
-
- MSBYT = IOR ( IAND (IZW,
- + NOT(ISHFT (ISHFT(NOT(0),-32+NZB), IZP-1)))
- +, ISHFT (ISHFT(MZ, 32-NZB), -33+IZP+NZB) )
- RETURN
- END
-#ifdef CERNLIB_TCGEN_MSBYT
-#undef CERNLIB_TCGEN_MSBYT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/noarg.s b/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/noarg.s
deleted file mode 100644
index 81bfd94..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/noarg.s
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: noarg.s,v 1.1.1.1 1996/02/15 17:54:49 mclareni Exp $
-*
-* $Log: noarg.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:49 mclareni
-* Kernlib
-*
-*
- MODULE M_NOARG
-%
-% CERN PROGLIB# Z029 NOARG .VERSION KERNNOR 1.11 811124
-% ORIG. H.OVERAS, CERN, 810803
-%
-% RETURNS NUMBER OF ARGUMENTS IN A SUBPROGRAM CALL
-% BOTH AS FUNCTION VALUE AND IN ARGUMENT
-%
- EXPORT NOARG
- ROUTINE NOARG
- LIB NOARG
-VBAS: STACK FIXED
-PAR: W BLOCK 1
- ENDSTACK
-NOARG: ENTF VBAS
- W2:=4
- W1:=IND(B.0)(R2)
- W1=:IND(B.PAR)
- RET
- ENDROUTINE
- ENDMODULE
-#ifdef CERNLIB_TCGEN_NOARG
-#undef CERNLIB_TCGEN_NOARG
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/pkbyt.s b/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/pkbyt.s
deleted file mode 100644
index f45a51f..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/pkbyt.s
+++ /dev/null
@@ -1,65 +0,0 @@
-*
-* $Id: pkbyt.s,v 1.1.1.1 1996/02/15 17:54:49 mclareni Exp $
-*
-* $Log: pkbyt.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:49 mclareni
-* Kernlib
-*
-*
- MODULE M_PKBYT
-%
-% CERN PROGLIB# M422 PKBYT .VERSION KERNNOR 1.05 810521
-% ORIG. H.OVERAS, CERN, 810527
-%
-% M422 CALL PKBYT(IV,XVM,J,N,MPAK) PACK BYT-VECTOR
-% MPAK=NBITS,INWORD
- EXPORT PKBYT
- ROUTINE PKBYT
- LIB PKBYT
-VBAS: STACK FIXED
-PAR: W BLOCK 5
-INWORD:W BLOCK 1
-INCR: W BLOCK 1
-JH1: W BLOCK 1
-N1: W BLOCK 1
-NBIT: BY BLOCK 1
- ENDSTACK
-PKBYT: ENTF VBAS
- W SUB3 IND(B.PAR+12),1,B.N1
- IF<GO OUT:H
- W2 CLR
- W BYCONV IND(B.PAR+16),B.NBIT
- IF>GO L11
- BY SET1 B.NBIT
- W MOVE 32,B.INWORD
- GO L12
-L11: W4:=1
- W MOVE IND(B.PAR+16)(R4),B.INWORD
-L12: W SUB3 B.INWORD,1,B.INCR
- W4:=IND(B.PAR+8)
- W4-1
- IF<=GO L17
- W3 DIV4 R4,B.INWORD,R1
- W SUB3 B.INCR,R3,B.JH1
- BY3*B.NBIT
- GO L22
-L17: W1 CLR
-L21: W ADD3 R2,B.INCR,B.JH1
- W3 CLR
-L22: W COMP2 B.JH1,B.N1
- IF<=GO L24
- W MOVE B.N1,B.JH1
-L24: W4:=IND(B.PAR)(R2)
- W4 PUTBF IND(B.PAR+4)(R1),BY3,B.NBIT
- BY3+B.NBIT
- W LOOPI R2,B.JH1,L24
- W2 COMP B.N1
- IF>GO OUT
- W1+1
- GO L21
-OUT: RET
- ENDROUTINE
- ENDMODULE
-#ifdef CERNLIB_TCGEN_PKBYT
-#undef CERNLIB_TCGEN_PKBYT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/pkchar.s b/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/pkchar.s
deleted file mode 100644
index 897dec9..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/pkchar.s
+++ /dev/null
@@ -1,132 +0,0 @@
-*
-* $Id: pkchar.s,v 1.1.1.1 1996/02/15 17:54:49 mclareni Exp $
-*
-* $Log: pkchar.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:49 mclareni
-* Kernlib
-*
-*
- MODULE M_PKCHAR
-%
-% CERN PROGLIB# M427 PKCHAR .VERSION KERNNOR 1.05 810521
-% ORIG. H.OVERAS, CERN, 810609
-%
-% CALL PKCHAR(IV,XVM,N,MPAR) PACK CHARACTER-VECTOR
-% MPAR = NBITS,NCHAR,NZONE,IGNOR,NFILL
-%
- IMPORT-D SLATE
- EXPORT PKCHAR
- ROUTINE PKCHAR
- LIB PKCHAR
-VBAS: STACK FIXED
-PAR: W BLOCK 4
-NBITS: W BLOCK 1
-NCHAR: W BLOCK 1
-NZONE: W BLOCK 1
-IGNOR: W BLOCK 1
-NFILL: W BLOCK 1
-NM: W BLOCK 1
-TEMP: W BLOCK 1
-NBDONE:W BLOCK 1
-NBE: W BLOCK 1
-JGM: W BLOCK 1
-NBITSW:W DATA 32
-NHIGH: W BLOCK 1
-NLOW: W BLOCK 1
- ENDSTACK
-PKCHAR: ENTF VBAS
- W1:=IND(B.PAR+8)
- IF><GO IN
- W STZ SLATE
- RET
-IN: W1-1
- W1=:B.NM
- W1 CLR
-LP: W MOVE IND(B.PAR+12)(R1),B.NBITS(R1)
- W LOOPI R1,3,LP
- W MOVE IND(B.PAR+12)(R1),B.NFILL
- W1 CLR
- W2 CLR
- W MOVE B.NFILL,IND(B.PAR+4)
- W TEST B.NZONE
- IF><GO L41:H
-L21: W SUB3 B.NBITSW,B.IGNOR,B.JGM
- W MOVE B.NBITS,B.NBE
- W TEST B.NCHAR
- IF=GO L22
- W4:=1
- W4-B.NCHAR
- W4 MULAD B.NBITS,B.JGM
- W4 COMP B.NBE
- IF<GO L22
- W4=:B.NBE
-L22: W3:=B.JGM
-L24: W3-B.NBITS
- W4:=IND(B.PAR)(R2)
- W4 PUTBF IND(B.PAR+4)(R1),BY3,B.NBITS+3
- W LOOPI R2,B.NM,L25
- GO OUT:H
-L25: W3 COMP B.NBE
- IF>=GO L24
- W1+1
- W MOVE B.NFILL,IND(B.PAR+4)(R1)
- GO L22
-L41: W COMP2 B.NZONE,B.NBITSW
- IF=GO L21
- W SUB3 B.NBITSW,B.IGNOR,R3
- W SUB3 B.NZONE,B.NBITS,B.NBE
- W INCR B.NBE
- W4:=B.NCHAR
- IF=GO L42
- W4 MULAD B.NBITS,B.IGNOR
- W4 COMP B.NBE
- IF>=GO L42
- W4=:B.NBE
-L42: W MOVE B.IGNOR,B.NBDONE
-L43: W TEST R3
- IF>=GO L44
- W3+B.NBITSW
- W1+1
- W MOVE B.NFILL,IND(B.PAR+4)(R1)
- GO L43
-L44: W3-B.NBITS
- IF<GO L51
- W4:=IND(B.PAR)(R2)
- W4 PUTBF IND(B.PAR+4)(R1),BY3,B.NBITS+3
- GO L58
-L51: W3+B.NBITSW
- W1+1
- W MOVE B.NFILL,IND(B.PAR+4)(R1)
- W4 DIV4 R3,8,B.TEMP
- W4=:B.JGM
- W SUB3 B.PAR+4,B.TEMP,B.TEMP
- W4+B.NBITS
- W4-B.NBITSW
- IF>GO SPEC
- W4:=IND(B.PAR)(R2)
- W4 PUTBF IND(B.TEMP)(R1),B.JGM+3,B.NBITS+3
- GO L58
-SPEC: W4=:B.NHIGH
- W SUB3 B.NBITSW,B.JGM,B.NLOW
- W4:=IND(B.PAR)(R2)
- W4 PUTBF IND(B.TEMP)(R1),B.JGM+3,B.NLOW+3
- W MUL2 B.NLOW,-1:B
- W SUB2 B.TEMP,4
- W SHL R4,B.NLOW+3
- W4 PUTBF IND(B.TEMP)(R1),0:B,B.NHIGH+3
-L58: W LOOPI R2,B.NM,L59
-OUT: W INCR R1
- W1=:SLATE
- RET
-L59: W ADD2 B.NBDONE,B.NBITS
- W COMP2 B.NBDONE,B.NBE
- IF<GO L44
- W3-B.NZONE
- W3+B.NBDONE
- W3-B.IGNOR
- GO L42
- ENDROUTINE
- ENDMODULE
-#ifdef CERNLIB_TCGEN_PKCHAR
-#undef CERNLIB_TCGEN_PKCHAR
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/rndm.s b/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/rndm.s
deleted file mode 100644
index 99a6f41..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/rndm.s
+++ /dev/null
@@ -1,67 +0,0 @@
-*
-* $Id: rndm.s,v 1.1.1.1 1996/02/15 17:54:49 mclareni Exp $
-*
-* $Log: rndm.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:49 mclareni
-* Kernlib
-*
-*
- MODULE M_RNDM
-%
-% CERN PROGLIB# V104 RNDM .VERSION KERNNOR 2.05 880419
-% ORIG. 24-oct-87, P.S.Iversen, Dep. of Physics, Univ. Bergen
-%
-% Fast random routine with same sequence as on IBM + VAX
-%
- EXPORT RNDM,IRNDM,RDMIN,RDMOUT
-%
-SEED: W DATA 30071B % Initial seed, if not set by user.
-%
- ROUTINE RNDM
- LIB RNDM
-VBAS: STACK FIXED
-INPT: W BLOCK 1
- ENDSTACK
-RNDM: ENTF VBAS % REAL=RNDM(DUMMY)
- W1 := SEED % Get SEED value.
- W1 * 2503625B % Multiply SEED.
- W1 =: SEED % Put result back to SEED.
- W SHL W1,-1D % Left shift SEED 1 bit.
- W FCONV W1,F1 % Convert to float in A1.
- F MUL2 F1,07040000000B % Normalize result.
- RET % Return, finished.
- ENDROUTINE
-%
- ROUTINE IRNDM
- LIB IRNDM
-VBAS: STACK FIXED
-INPT: W BLOCK 1
- ENDSTACK
-IRNDM: ENTF VBAS % INTEGER=IRNDM(DUMMY)
- W1 := SEED % Get SEED value.
- W1 * 2503625B % Multiply SEED.
- W1 =: SEED % Put result back to SEED.
- W SHL W1,-1D % Left shift SEED 1 bit.
- RET % Return, finished.
- ENDROUTINE
-%
- ROUTINE RDMIN % CALL RDMIN(IX)
- LIB RDMIN
-VBAS: STACK FIXED
-INPT: W BLOCK 1
- ENDSTACK
-RDMIN: ENTF VBAS
- W MOVE IND(B.INPT),SEED % Set SEED value.
- RET % Return, finished.
- ENDROUTINE
-%
- ROUTINE RDMOUT % CALL RDMOUT(IX)
- LIB RDMOUT
-VBAS: STACK FIXED
-INPT: W BLOCK 1
- ENDSTACK
-RDMOUT:ENTF VBAS
- W MOVE SEED,IND(B.INPT) % Get SEED value.
- RET % Return, finished.
- ENDROUTINE
- ENDMODULE
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/rndm2.s b/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/rndm2.s
deleted file mode 100644
index c8c429e..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/rndm2.s
+++ /dev/null
@@ -1,90 +0,0 @@
-*
-* $Id: rndm2.s,v 1.1.1.1 1996/02/15 17:54:49 mclareni Exp $
-*
-* $Log: rndm2.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:49 mclareni
-* Kernlib
-*
-*
- MODULE M_RNDM2
-%
-% CERN PROGLIB# V107 RNDM2 .VERSION KERNNOR 2.05 880419
-% ORIG. 24-oct-87, P.S.Iversen, Dep. of Physics, Univ. Bergen
-%
-% Random routine with same sequence as on VAX
-%
- EXPORT RNDM2,IRNDM2,RD2OUT,RD2IN
-%
-MCGN: W DATA 30071B % 12345 decimal.
-SRGN: W DATA 2061B % 1073 decimal.
-%
- ROUTINE RNDM2
- LIB RNDM2
-VBAS: STACK FIXED
-INPT: W BLOCK 1
- ENDSTACK
-RNDM2: ENTF VBAS % REAL=RNDM2(DUMMY)
- W2 := SRGN % REGB <- SRGN
- W1 := W2 % REGC <- REGB
- W SHL W1,-15D % Right shift REGC 15 bits.
- W2 XOR W1 % REGB <- XOR(REGB,REGC)
- W1 := W2 % REGC <- REGB
- W SHL W1,17D % Left shift REGC 17 bits.
- W2 XOR W1 % REGB <- XOR(REGB,REGC)
- W2 =: SRGN % SRGN <- REGB
- W1 := MCGN % REGD <- MCGN
- W1 * 206715B % REGD <- REGD*69069
- W1 =: MCGN % MCGN <- REGD
- W1 XOR W2 % REGD <- XOR(REGD,REGB)
- W SHL W1,-1D % Left shift REGD 1 bit.
- W FCONV W1,F1 % Convert to float in A1.
- F MUL2 F1,07040000000B % Normalize result.
- RET % Return, finished.
- ENDROUTINE
-%
- ROUTINE IRNDM2
- LIB IRNDM2
-VBAS: STACK FIXED
-INPT: W BLOCK 1
- ENDSTACK
-IRNDM2:ENTF VBAS % INTEGER=IRNDM2(DUMMY)
- W2 := SRGN % REGB <- SRGN
- W1 := W2 % REGC <- REGB
- W SHL W1,-15D % Right shift REGC 15 bits.
- W2 XOR W1 % REGB <- XOR(REGB,REGC)
- W1 := W2 % REGC <- REGB
- W SHL W1,17D % Left shift REGC 17 bits.
- W2 XOR W1 % REGB <- XOR(REGB,REGC)
- W2 =: SRGN % SRGN <- REGB
- W1 := MCGN % REGD <- MCGN
- W1 * 206715B % REGD <- REGD*69069
- W1 =: MCGN % MCGN <- REGD
- W1 XOR W2 % REGD <- XOR(REGD,REGB)
- W SHL W1,-1D % Left shift REGD 1 bit, return value.
- RET % Return, finished.
- ENDROUTINE
-%
- ROUTINE RD2IN % CALL RD2IN(IX,IY)
- LIB RD2IN
-VBAS: STACK FIXED
-IX: W BLOCK 1
-IY: W BLOCK 1
- ENDSTACK
-RD2IN: ENTF VBAS
- W MOVE IND(B.IX),MCGN % Set MCGN value.
- W MOVE IND(B.IY),SRGN % Set SRGN value.
- RET % Return, finished.
- ENDROUTINE
-%
- ROUTINE RD2OUT % CALL RD2OUT(IX,IY)
- LIB RD2OUT
-VBAS: STACK FIXED
-IX: W BLOCK 1
-IY: W BLOCK 1
- ENDSTACK
-RD2OUT:ENTF VBAS
- W MOVE MCGN,IND(B.IX) % Get MCGN value.
- W MOVE SRGN,IND(B.IY) % Get SRGN value.
- RET % Return, finished.
- ENDROUTINE
- ENDMODULE
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/sbit.s b/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/sbit.s
deleted file mode 100644
index fbba9b0..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/sbit.s
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: sbit.s,v 1.1.1.1 1996/02/15 17:54:49 mclareni Exp $
-*
-* $Log: sbit.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:49 mclareni
-* Kernlib
-*
-*
- MODULE M_SBIT
-%
-% CERN PROGLIB# M421 SBIT .VERSION KERNNOR 1.01 800718
-% ORIG. H.OVERAS, CERN, 791213
-%
-% CALL SBIT(IM,XM,J) SET BIT J TO IM
-%
- EXPORT SBIT
- ROUTINE SBIT
- LIB SBIT
-VBAS: STACK FIXED
-PAR: W BLOCK 3
- ENDSTACK
-SBIT: ENTF VBAS
- W2:=IND(B.PAR+8)
- W2-1
- W1:=IND(B.PAR)
- W1 PUTBI IND(B.PAR+4),BY2
- RET
- ENDROUTINE
- ENDMODULE
-#ifdef CERNLIB_TCGEN_SBIT
-#undef CERNLIB_TCGEN_SBIT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/sbit0.s b/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/sbit0.s
deleted file mode 100644
index 43fd2bc..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/sbit0.s
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: sbit0.s,v 1.1.1.1 1996/02/15 17:54:49 mclareni Exp $
-*
-* $Log: sbit0.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:49 mclareni
-* Kernlib
-*
-*
- MODULE M_SBIT0
-%
-% CERN PROGLIB# M421 SBIT0 .VERSION KERNNOR 1.01 800718
-% ORIG. H.OVERAS, CERN, 791213
-%
-% CALL SBIT0(XM,J) SET BIT J TO 0
-%
- EXPORT SBIT0
- ROUTINE SBIT0
- LIB SBIT0
-VBAS: STACK FIXED
-PAR: W BLOCK 2
- ENDSTACK
-SBIT0: ENTF VBAS
- W1:=0
- W2:=IND(B.PAR+4)
- W2-1
- W1 PUTBI IND(B.PAR),BY2
- RET
- ENDROUTINE
- ENDMODULE
-#ifdef CERNLIB_TCGEN_SBIT0
-#undef CERNLIB_TCGEN_SBIT0
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/sbit1.s b/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/sbit1.s
deleted file mode 100644
index 40d4dfa..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/sbit1.s
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: sbit1.s,v 1.1.1.1 1996/02/15 17:54:49 mclareni Exp $
-*
-* $Log: sbit1.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:49 mclareni
-* Kernlib
-*
-*
- MODULE M_SBIT1
-%
-% CERN PROGLIB# M421 SBIT1 .VERSION KERNNOR 1.01 800718
-% ORIG. H.OVERAS, CERN, 791213
-%
-% CALL SBIT1(XM,J) SET BIT J TO 1
-%
- EXPORT SBIT1
- ROUTINE SBIT1
- LIB SBIT1
-VBAS: STACK FIXED
-PAR: W BLOCK 2
- ENDSTACK
-SBIT1: ENTF VBAS
- W1:=1
- W2:=IND(B.PAR+4)
- W2-1
- W1 PUTBI IND(B.PAR),BY2
- RET
- ENDROUTINE
- ENDMODULE
-#ifdef CERNLIB_TCGEN_SBIT1
-#undef CERNLIB_TCGEN_SBIT1
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/sbyt.s b/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/sbyt.s
deleted file mode 100644
index 68fc59c..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/sbyt.s
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: sbyt.s,v 1.1.1.1 1996/02/15 17:54:50 mclareni Exp $
-*
-* $Log: sbyt.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:50 mclareni
-* Kernlib
-*
-*
- MODULE M_SBYT
-%
-% CERN PROGLIB# M421 SBYT .VERSION KERNNOR 1.01 800718
-% ORIG. H.OVERAS, CERN, 791213
-%
-% CALL SBYT(IM,XM,J,NBIT) SET BYTE OF NBIT BITS
-%
- EXPORT SBYT
- ROUTINE SBYT
- LIB SBYT
-VBAS: STACK FIXED
-PAR: W BLOCK 4
- ENDSTACK
-SBYT: ENTF VBAS
- W2:=IND(B.PAR+8)
- W2-1
- W3:=IND(B.PAR+12)
- W1:=IND(B.PAR)
- W1 PUTBF IND(B.PAR+4),BY2,BY3
- RET
- ENDROUTINE
- ENDMODULE
-#ifdef CERNLIB_TCGEN_SBYT
-#undef CERNLIB_TCGEN_SBYT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/sbytor.s b/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/sbytor.s
deleted file mode 100644
index 56ea7fd..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/sbytor.s
+++ /dev/null
@@ -1,35 +0,0 @@
-*
-* $Id: sbytor.s,v 1.1.1.1 1996/02/15 17:54:50 mclareni Exp $
-*
-* $Log: sbytor.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:50 mclareni
-* Kernlib
-*
-*
- MODULE M_SBYTOR
-%
-% CERN PROGLIB# M421 SBYTOR .VERSION KERNNOR 1.01 800718
-% ORIG. H.OVERAS, CERN, 791213
-%
-% CALL SBYTOR(IM,XM,J,NBIT) SET LOGICAL OR OF BYTES
-%
- EXPORT SBYTOR
- ROUTINE SBYTOR
- LIB SBYTOR
-VBAS: STACK FIXED
-PAR: W BLOCK 4
- ENDSTACK
-SBYTOR: ENTF VBAS
- W2:=IND(B.PAR+8)
- W2-1
- W3:=IND(B.PAR+12)
- W1 GETBF IND(B.PAR+4),BY2,BY3
- W4:=R1
- W4 OR IND(B.PAR)
- W4 PUTBF IND(B.PAR+4),BY2,BY3
- RET
- ENDROUTINE
- ENDMODULE
-#ifdef CERNLIB_TCGEN_SBYTOR
-#undef CERNLIB_TCGEN_SBYTOR
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/sbytpk.s b/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/sbytpk.s
deleted file mode 100644
index 2063b09..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/sbytpk.s
+++ /dev/null
@@ -1,48 +0,0 @@
-*
-* $Id: sbytpk.s,v 1.1.1.1 1996/02/15 17:54:50 mclareni Exp $
-*
-* $Log: sbytpk.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:50 mclareni
-* Kernlib
-*
-*
- MODULE M_SBYTPK
-%
-% CERN PROGLIB# M422 SBYTPK .VERSION KERNNOR 1.01 800718
-% ORIG. H.OVERAS, CERN, 791213
-%
-% CALL SBYTPK(IM,XVM,J,MPAK) SET PACKED BYTE
-% MPAK=NBIT,INWORD
-%
- EXPORT SBYTPK
- ROUTINE SBYTPK
- LIB SBYTPK
-VBAS: STACK FIXED
-PAR: W BLOCK 4
-INWORD:W BLOCK 1
-NBIT: BY BLOCK 1
- ENDSTACK
-SBYTPK: ENTF VBAS
- W BYCONV IND(B.PAR+12),B.NBIT
- IF>GO L11
- BY SET1 B.NBIT
- W MOVE 32,B.INWORD
- GO L12
-L11: W4:=1
- W MOVE IND(B.PAR+12)(R4),B.INWORD
-L12: W4:=IND(B.PAR+8)
- W4-1
- IF<=GO L17
- W3 DIV4 R4,B.INWORD,R1
- BY3*B.NBIT
- GO L24
-L17: W1 CLR
- W3 CLR
-L24: W4:=IND(B.PAR)
- W4 PUTBF IND(B.PAR+4)(R1),BY3,B.NBIT
- RET
- ENDROUTINE
- ENDMODULE
-#ifdef CERNLIB_TCGEN_SBYTPK
-#undef CERNLIB_TCGEN_SBYTPK
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/traceq.F b/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/traceq.F
deleted file mode 100644
index 9919f26..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/traceq.F
+++ /dev/null
@@ -1,44 +0,0 @@
-*
-* $Id: traceq.F,v 1.1.1.1 1996/02/15 17:54:50 mclareni Exp $
-*
-* $Log: traceq.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:50 mclareni
-* Kernlib
-*
-*
-#include "kernnor/pilot.h"
- SUBROUTINE TRACEQ (LUNP,NP)
-C
-C CERN PROGLIB# N105 TRACEQ .VERSION KERNNOR 1.07 810629
-C ORIG. H.OVERAS, CERN, 810622
-C
-C ROUTINE TO PRINT TRACEBACK INFORMATION: MEMORY ADDRESSES OF
-C ROUTINE ENTRIES,VBAS AND CALLING LOCATION. IT DOES NOT PROVIDE
-C SYMB SOURCE INFORM LIKE SUBR NAMES AND LINE NUMBER OF CALLS!
-C
- COMMON /SLATE/ NAM1,NAM2,LINE,LADR,LOK,LWK(35)
- LUN=LUNP
- N=NP
-C IF(LUN.EQ.0) LUN=LUNDEF
- WRITE(LUN,9021)
- LINE=0
- LOK=0
- CALL TRAC1Q
-24 N=N-1
- CALL TRAC2Q
- IF(LOK) 31,25,99
-25 WRITE(LUN,9025) NAM1,NAM2,LADR
-C WRITE(1,8000) LWK
- IF(N.GT.0) GOTO 24
- RETURN
-31 WRITE(LUN,9031)
-99 RETURN
-9021 FORMAT(7H0TRACEQ)
-9025 FORMAT(' CALLED FROM ROUT ENTADDR:',O11,' VBAS:',O11,
- + ' AT LOC:',O11)
-9031 FORMAT(26H ******* TRACE ENDS BADLY.)
-8000 FORMAT(16(X,O3))
- END
-#ifdef CERNLIB_TCGEN_TRACEQ
-#undef CERNLIB_TCGEN_TRACEQ
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/ubits.s b/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/ubits.s
deleted file mode 100644
index 9004ab8..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/ubits.s
+++ /dev/null
@@ -1,43 +0,0 @@
-*
-* $Id: ubits.s,v 1.1.1.1 1996/02/15 17:54:50 mclareni Exp $
-*
-* $Log: ubits.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:50 mclareni
-* Kernlib
-*
-*
- MODULE M_UBITS
-%
-% CERN PROGLIB# M503 UBITS .VERSION KERNNOR 1.07 810629
-% ORIG. H.OVERAS, CERN, 810603
-%
-% CALL UBITS(IM,NBIT,IXV,NX) LIST OF BIT-NUMBERS OF NON-ZERO BITS
-%
- EXPORT UBITS
- ROUTINE UBITS
- LIB UBITS
-VBAS: STACK FIXED
-PAR: W BLOCK 4
-W32: W DATA 32
- ENDSTACK
-UBITS: ENTF VBAS
- W4:=IND(B.PAR) %IM
- W3:=IND(B.PAR+4) %NBIT
- IF<=GO OUT
- W3 COMP B.W32 %MIN(NBIT,32)
- IF<=GO OK
- W3:=B.W32
-OK: W SET1 R1 %LOOP INDEX OF IM
- W2 CLR %INDEX OF IXV
-BEGLP: W SHR R4,-1 %BIT0 INTO SIGNBIT
- IF>GO ENDLP
- W1=:IND(B.PAR+8)(R2) %POSIT OF BIT INTO IXV(R2+1)
- W INCR R2
-ENDLP: W LOOPI R1,R3,BEGLP
- W2=:IND(B.PAR+12)
-OUT: RET
- ENDROUTINE
- ENDMODULE
-#ifdef CERNLIB_TCGEN_UBITS
-#undef CERNLIB_TCGEN_UBITS
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/ublank.s b/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/ublank.s
deleted file mode 100644
index aaee765..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/ublank.s
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: ublank.s,v 1.1.1.1 1996/02/15 17:54:50 mclareni Exp $
-*
-* $Log: ublank.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:50 mclareni
-* Kernlib
-*
-*
- MODULE M_UBLANK
-%
-% CERN PROGLIB# V300 UBLANK .VERSION KERNNOR 1.05 810521
-% ORIG. H.OVERAS, CERN, 810330
-%
-% CALL UBLANK(XVM,JL,JR) XVM(J)=BLANK J=(JL/JR)
-%
- EXPORT UBLANK
- ROUTINE UBLANK
- LIB UBLANK
-VBAS: STACK FIXED
-PAR: W BLOCK 3
- ENDSTACK
-UBLANK: ENTF VBAS
- W SUB3 IND(B.PAR+8), IND(B.PAR+4),R1
- W1+1
- W2:=IND(B.PAR+4)
- W2-1
- W BMOVE 4010020040B,IND(B.PAR)(R2),R1
- RET
- ENDROUTINE
- ENDMODULE
-#ifdef CERNLIB_TCGEN_UBLANK
-#undef CERNLIB_TCGEN_UBLANK
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/ublow.s b/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/ublow.s
deleted file mode 100644
index c9d843c..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/ublow.s
+++ /dev/null
@@ -1,37 +0,0 @@
-*
-* $Id: ublow.s,v 1.1.1.1 1996/02/15 17:54:50 mclareni Exp $
-*
-* $Log: ublow.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:50 mclareni
-* Kernlib
-*
-*
- MODULE M_UBLOW
-%
-% CERN PROGLIB# M409 UBLOW .VERSION KERNNOR 1.01 800718
-% ORIG. H.OVERAS, CERN, 791213
-%
-% CALL UBLOW(AVM,XVM,N) CONVERT HOLLERITH STRING A4 TO A1
-%
- EXPORT UBLOW
- ROUTINE UBLOW
- LIB UBLOW
-VBAS: STACK FIXED
-PAR: W BLOCK 3
- ENDSTACK
-UBLOW: ENTF VBAS
- W1:=0
- W2:=IND(B.PAR+8)
- IF<=GO OUT
- W2-1
-BEGLP: BY3:=IND(B.PAR)(R1)
- W SHR R3,-8
- W3+10020040B
- W3=:IND(B.PAR+4)(R1)
- W LOOPI R1,R2,BEGLP
-OUT: RET
- ENDROUTINE
- ENDMODULE
-#ifdef CERNLIB_TCGEN_UBLOW
-#undef CERNLIB_TCGEN_UBLOW
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/ubunch.s b/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/ubunch.s
deleted file mode 100644
index c933d64..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/ubunch.s
+++ /dev/null
@@ -1,40 +0,0 @@
-*
-* $Id: ubunch.s,v 1.1.1.1 1996/02/15 17:54:50 mclareni Exp $
-*
-* $Log: ubunch.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:50 mclareni
-* Kernlib
-*
-*
- MODULE M_UBUNCH
-%
-% CERN PROGLIB# M409 UBUNCH .VERSION KERNNOR 1.12 811126
-% ORIG. H.OVERAS, CERN, 791213
-%
-% CALL UBUNCH(AVM,XVM,N) CONVERT HOLLERITH STRING A1 TO A4
-%
- EXPORT UBUNCH
- ROUTINE UBUNCH
- LIB UBUNCH
-VBAS: STACK FIXED
-PAR: W BLOCK 3
- ENDSTACK
-UBUNCH: ENTF VBAS
- W1:=0
- W2:=IND(B.PAR+8)
- IF<=GO OUT
- W2-1
- W4:=R2
- W4/4
- W3:=10020040B
- W3 PUTBF IND(B.PAR+4)(R4),0,24
-BEGLP: W3:=IND(B.PAR)(R1)
- W SHR R3,8
- BY3=:IND(B.PAR+4)(R1)
- W LOOPI R1,R2,BEGLP
-OUT: RET
- ENDROUTINE
- ENDMODULE
-#ifdef CERNLIB_TCGEN_UBUNCH
-#undef CERNLIB_TCGEN_UBUNCH
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/ucopiv.s b/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/ucopiv.s
deleted file mode 100644
index 768ac68..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/ucopiv.s
+++ /dev/null
@@ -1,37 +0,0 @@
-*
-* $Id: ucopiv.s,v 1.1.1.1 1996/02/15 17:54:50 mclareni Exp $
-*
-* $Log: ucopiv.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:50 mclareni
-* Kernlib
-*
-*
- MODULE M_UCOPIV
-%
-% CERN PROGLIB# V301 UCOPIV .VERSION KERNNOR 2.05 880419
-% ORIG. H.OVERAS, CERN, 791213
-% MODIF. P.S.Iversen, 8-dec-87
-%
-% CALL UCOPIV(AVM,XVM,N) COPY INVERSE, E.G X(1)=A(N)
-%
- EXPORT UCOPIV
- ROUTINE UCOPIV
- LIB UCOPIV
-VBAS: STACK FIXED
-PAR: W BLOCK 3
- ENDSTACK
-UCOPIV: ENTF VBAS
- W1:=0
- W2:=IND(B.PAR+8)
- IF <= GO OUT % If <= zero, exit
- W2-1
- W3:=R2
-BEGLP: W MOVE IND(B.PAR)(R1),IND(B.PAR+4)(R3)
- W3-1
- W LOOPI R1,R2,BEGLP
-OUT: RET
- ENDROUTINE
- ENDMODULE
-#ifdef CERNLIB_TCGEN_UCOPIV
-#undef CERNLIB_TCGEN_UCOPIV
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/ucopy.s b/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/ucopy.s
deleted file mode 100644
index eca054b..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/ucopy.s
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: ucopy.s,v 1.1.1.1 1996/02/15 17:54:50 mclareni Exp $
-*
-* $Log: ucopy.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:50 mclareni
-* Kernlib
-*
-*
- MODULE M_UCOPY
-%
-% CERN PROGLIB# V301 UCOPY .VERSION KERNNOR 2.05 880419
-% ORIG. H.OVERAS, CERN, 791213
-% MODIF. P.S.Iversen, 8-dec-87
-%
-% CALL UCOPY(AVM,XVM,N) COPY A TO X
-%
- EXPORT UCOPY
- ROUTINE UCOPY
- LIB UCOPY
-VBAS: STACK FIXED
-PAR: W BLOCK 3
- ENDSTACK
-UCOPY: ENTF VBAS
- W3:=IND(B.PAR+8)
- IF <= GO OUT % If N <= zero, exit
- W BMOVE IND(B.PAR),IND(B.PAR+4),W3 % Move words
-OUT: RET % Exit
- ENDROUTINE
- ENDMODULE
-#ifdef CERNLIB_TCGEN_UCOPY
-#undef CERNLIB_TCGEN_UCOPY
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/ucopy2.s b/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/ucopy2.s
deleted file mode 100644
index d2e5161..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/ucopy2.s
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: ucopy2.s,v 1.1.1.1 1996/02/15 17:54:50 mclareni Exp $
-*
-* $Log: ucopy2.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:50 mclareni
-* Kernlib
-*
-*
- MODULE M_UCOPY2
-%
-% CERN PROGLIB# V301 UCOPY2 .VERSION KERNNOR 2.05 880419
-% ORIG. H.OVERAS, CERN, 791213
-% MODIF. P.S.Iversen, 8-dec-87
-%
-% CALL UCOPY2(AVM,XVM,N) COPY A TO X , ANY OVERLAP
-%
- EXPORT UCOPY2
- ROUTINE UCOPY2
- LIB UCOPY2
-VBAS: STACK FIXED
-PAR: W BLOCK 3
- ENDSTACK
-UCOPY2: ENTF VBAS
- W3 := IND(B.PAR+8) % Load N
- IF <= GO OUT % If <= zero, exit
- W BMOVE IND(B.PAR),IND(B.PAR+4),W3 % Move words
-OUT: RET % Exit
- ENDROUTINE
- ENDMODULE
-#ifdef CERNLIB_TCGEN_UCOPY2
-#undef CERNLIB_TCGEN_UCOPY2
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/ucopyn.s b/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/ucopyn.s
deleted file mode 100644
index 9abec28..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/ucopyn.s
+++ /dev/null
@@ -1,37 +0,0 @@
-*
-* $Id: ucopyn.s,v 1.1.1.1 1996/02/15 17:54:50 mclareni Exp $
-*
-* $Log: ucopyn.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:50 mclareni
-* Kernlib
-*
-*
- MODULE M_UCOPYN
-%
-% CERN PROGLIB# V301 UCOPYN .VERSION KERNNOR 2.05 880419
-% ORIG. H.OVERAS, CERN, 791213
-% MODIF. P.S.Iversen, 8-dec-87
-%
-% CALL UCOPYN(IV,IXV,N) COPY NEGATIVE, IXV(J)=-IV(J)
-%
- EXPORT UCOPYN
- ROUTINE UCOPYN
- LIB UCOPYN
-VBAS: STACK FIXED
-PAR: W BLOCK 3
- ENDSTACK
-UCOPYN: ENTF VBAS
- W1:=0
- W2:=IND(B.PAR+8)
- IF <= GO OUT % If <= zero, exit
- W2-1
-BEGLP: W3:=IND(B.PAR)(R1)
- W3 NEG
- W3=:IND(B.PAR+4)(R1)
- W LOOPI R1,R2,BEGLP
-OUT: RET
- ENDROUTINE
- ENDMODULE
-#ifdef CERNLIB_TCGEN_UCOPYN
-#undef CERNLIB_TCGEN_UCOPYN
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/uctoh.s b/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/uctoh.s
deleted file mode 100644
index d544c2e..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/uctoh.s
+++ /dev/null
@@ -1,65 +0,0 @@
-*
-* $Id: uctoh.s,v 1.1.1.1 1996/02/15 17:54:50 mclareni Exp $
-*
-* $Log: uctoh.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:50 mclareni
-* Kernlib
-*
-*
- MODULE M_UCTOH
-%
-% CERN PROGLIB# M409 UCTOH .VERSION KERNNOR 1.13 811202
-% ORIG. H.OVERAS, CERN, 811201
-%
-% CALL UCTOH(CHAR,AN,N,NCH) CONVERT CHAR TO HOLLERITH AN
-% HOLLERITH INPUT IF TYPE CHARACTER UNLIKELY
-%
- IMPORT-D SLATE
- EXPORT UCTOH
- ROUTINE UCTOH
- LIB UCTOH
-VBAS: STACK FIXED
-PAR: W BLOCK 4
-MAX: W BLOCK 1
-NBLK: W BLOCK 1
- ENDSTACK
-UCTOH: ENTF VBAS
- W1:=IND(B.PAR+12)
- IF <= GO OUT
- W1-1
- W1=:B.MAX
- W RLADDR IND(B.PAR)
- W COMP2 R.0,177777B %IF TOO BIG, TRY HOLLERITH
- IF > GO LAB1
- W MOVE R.4,B.PAR %CHANGE POINTER TO STRING ITSELF
-LAB1: W1 CLR
- W2 CLR
- W3:=5
- W4:=IND(B.PAR+8)
- IF <= GO OUT
- W4 COMP 4
- IF <= GO LAB2
- W4:=4
-LAB2: W SUB3 4,R4,B.NBLK
- W2-B.NBLK
-BEGLP: W3 COMP R4
- IF <= GO LAB3
- W2+B.NBLK
- W3:=R2
- W3/4
- W MOVE 4010020040B,IND(B.PAR+4)(R3) %PRESET EACH WORD
- W SET1 R3
-LAB3: BY MOVE IND(B.PAR)(R1),IND(B.PAR+4)(R2)
- W2+1
- W3+1
- W LOOPI R1,B.MAX,BEGLP
- W2-1
- W2/4
- W2+1
- W2=:SLATE %# WORDS INTO COMMON /SLATE/NI
-OUT: RET
- ENDROUTINE
- ENDMODULE
-#ifdef CERNLIB_TCGEN_UCTOH
-#undef CERNLIB_TCGEN_UCTOH
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/uctoh1.s b/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/uctoh1.s
deleted file mode 100644
index 310cb10..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/uctoh1.s
+++ /dev/null
@@ -1,42 +0,0 @@
-*
-* $Id: uctoh1.s,v 1.1.1.1 1996/02/15 17:54:50 mclareni Exp $
-*
-* $Log: uctoh1.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:50 mclareni
-* Kernlib
-*
-*
- MODULE M_UCTOH1
-%
-% CERN PROGLIB# M409 UCTOH1 .VERSION KERNNOR 1.13 811202
-% ORIG. H.OVERAS, CERN, 811201
-%
-% CALL UCTOH1(CHAR,A1,NCH) CONVERT CHAR TO HOLLERITH A1
-% HOLLERITH INPUT IF TYPE CHARACTER UNLIKELY
-%
- EXPORT UCTOH1
- ROUTINE UCTOH1
- LIB UCTOH1
-VBAS: STACK FIXED
-PAR: W BLOCK 3
- ENDSTACK
-UCTOH1: ENTF VBAS
- W1:=0
- W2:=IND(B.PAR+8)
- IF<=GO OUT
- W2-1
- W RLADDR IND(B.PAR)
- W COMP2 R.0,177777B %IF LEN TOO BIG, TRY HOLLERITH
- IF > GO BEGLP
- W MOVE R.4,B.PAR %CHANGE POINTER TO STRING ITSELF
-BEGLP: BY3:=IND(B.PAR)(R1)
- W SHR R3,-8
- W3+10020040B
- W3=:IND(B.PAR+4)(R1)
- W LOOPI R1,R2,BEGLP
-OUT: RET
- ENDROUTINE
- ENDMODULE
-#ifdef CERNLIB_TCGEN_UCTOH1
-#undef CERNLIB_TCGEN_UCTOH1
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/ufill.s b/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/ufill.s
deleted file mode 100644
index abce047..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/ufill.s
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: ufill.s,v 1.1.1.1 1996/02/15 17:54:50 mclareni Exp $
-*
-* $Log: ufill.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:50 mclareni
-* Kernlib
-*
-*
- MODULE M_UFILL
-%
-% CERN PROGLIB# V300 UFILL .VERSION KERNNOR 1.05 810521
-% ORIG. H.OVERAS, CERN, 810330
-%
-% CALL UFILL(XVM,JL,JR,CM) XVM(J)=CM
-%
- EXPORT UFILL
- ROUTINE UFILL
- LIB UFILL
-VBAS: STACK FIXED
-PAR: W BLOCK 4
- ENDSTACK
-UFILL: ENTF VBAS
- W SUB3 IND(B.PAR+8),IND(B.PAR+4),R1
- W1+1
- W2:=IND(B.PAR+4)
- W2-1
- W3:=IND(B.PAR+12)
- W BMOVE R3,IND(B.PAR)(R2),R1
- RET
- ENDROUTINE
- ENDMODULE
-#ifdef CERNLIB_TCGEN_UFILL
-#undef CERNLIB_TCGEN_UFILL
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/uh1toc.s b/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/uh1toc.s
deleted file mode 100644
index efc8b8d..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/uh1toc.s
+++ /dev/null
@@ -1,42 +0,0 @@
-*
-* $Id: uh1toc.s,v 1.1.1.1 1996/02/15 17:54:50 mclareni Exp $
-*
-* $Log: uh1toc.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:50 mclareni
-* Kernlib
-*
-*
- MODULE M_UH1TOC
-%
-% CERN PROGLIB# M409 UH1TOC .VERSION KERNNOR 1.13 811202
-% ORIG. H.OVERAS, CERN, 811201
-%
-% CALL UH1TOC(A1,CHAR,NCH) CONVERT HOLLERITH A1 TO CHARACTER
-%
- EXPORT UH1TOC
- ROUTINE UH1TOC
- LIB UH1TOC
-VBAS: STACK FIXED
-PAR: W BLOCK 3
- ENDSTACK
-UH1TOC: ENTF VBAS
- W1:=0
- W2:=IND(B.PAR+8)
- IF<=GO OUT
- W2-1
- W RLADDR IND(B.PAR+4)
- W MOVE R.4,B.PAR+4 %CHANGE POINTER TO STRING ITSELF
- W4:=R2
- W4/4
- W3:=10020040B
- W3 PUTBF IND(B.PAR+4)(R4),0,24 %TRAILING BALNKS IN LAST BYTES
-BEGLP: W3:=IND(B.PAR)(R1)
- W SHR R3,8
- BY3=:IND(B.PAR+4)(R1)
- W LOOPI R1,R2,BEGLP
-OUT: RET
- ENDROUTINE
- ENDMODULE
-#ifdef CERNLIB_TCGEN_UH1TOC
-#undef CERNLIB_TCGEN_UH1TOC
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/uhtoc.s b/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/uhtoc.s
deleted file mode 100644
index 9a3b4ce..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/uhtoc.s
+++ /dev/null
@@ -1,60 +0,0 @@
-*
-* $Id: uhtoc.s,v 1.1.1.1 1996/02/15 17:54:50 mclareni Exp $
-*
-* $Log: uhtoc.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:50 mclareni
-* Kernlib
-*
-*
- MODULE M_UHTOC
-%
-% CERN PROGLIB# M409 UHTOC .VERSION KERNNOR 2.05 880419
-% ORIG. H.OVERAS, CERN, 811201
-% MODIF. P.S.Iversen, 8-dec-87
-%
-% CALL UHTOC(AN,N,CHAR,NCH) CONVERT HOLLERITH AN TO CHARACTER
-%
- IMPORT-D SLATE
- EXPORT UHTOC
- ROUTINE UHTOC
- LIB UHTOC
-VBAS: STACK FIXED
-PAR: W BLOCK 4
-MAX: W BLOCK 1
-NBLK: W BLOCK 1
- ENDSTACK
-UHTOC: ENTF VBAS
- W1:=IND(B.PAR+12)
- IF <= GO OUT
- W1-1
- W1=:B.MAX
- W RLADDR IND(B.PAR+8)
- W MOVE R.4,B.PAR+8 %CHANGE POINTER TO STRING ITSELF
-LAB1: W1 CLR
- W2 CLR
- W3:=5
- W4:=IND(B.PAR+4)
- IF <= GO OUT
- W4 COMP 4
- IF <= GO LAB2
- W4:=4
-LAB2: W SUB3 4,R4,B.NBLK
- W2-B.NBLK
-BEGLP: W3 COMP R4
- IF <= GO LAB3
- W2+B.NBLK
- W SET1 R3
-LAB3: BY MOVE IND(B.PAR)(R2),IND(B.PAR+8)(R1)
- W2+1
- W3+1
- W LOOPI R1,B.MAX,BEGLP
- W1-1
- W3 DIV4 R1,4,R2
- W2+1
- W2=:SLATE
-OUT: RET
- ENDROUTINE
- ENDMODULE
-#ifdef CERNLIB_TCGEN_UHTOC
-#undef CERNLIB_TCGEN_UHTOC
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/uopt.s b/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/uopt.s
deleted file mode 100644
index bba77f8..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/uopt.s
+++ /dev/null
@@ -1,43 +0,0 @@
-*
-* $Id: uopt.s,v 1.1.1.1 1996/02/15 17:54:50 mclareni Exp $
-*
-* $Log: uopt.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:50 mclareni
-* Kernlib
-*
-*
- MODULE M_UOPT
-%
-% CERN PROGLIB# M502 UOPT .VERSION KERNNOR 1.01 800718
-% ORIG. H.OVERAS, CERN, 791213
-%
-% CALL UOPT(ACTVM,POSSVM,IX,N) SELECT OPTIONS FROM POSSIBILITES
-%
- EXPORT UOPT
- ROUTINE UOPT
- LIB UOPT
-VBAS: STACK FIXED
-PAR: W BLOCK 4
- ENDSTACK
-UOPT: ENTF VBAS
- W1:=0
- W2:=IND(B.PAR+12)
- W2-1
-ZERO: W MOVE 0,IND(B.PAR+8)(R1)
- W LOOPI R1,R2,ZERO
- W1:=0
- W3:=0
-OULP: BY4:=IND(B.PAR)(R3)
-INLP: BY4 COMP IND(B.PAR+4)(R1)
- IF=GO ONE
- W LOOPI R1,R2,INLP
- RET
-ONE: W MOVE 1,IND(B.PAR+8)(R1)
- W3+1
- W1:=0
- GO OULP
- ENDROUTINE
- ENDMODULE
-#ifdef CERNLIB_TCGEN_UOPT
-#undef CERNLIB_TCGEN_UOPT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/upkbyt.s b/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/upkbyt.s
deleted file mode 100644
index 09bee2c..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/upkbyt.s
+++ /dev/null
@@ -1,66 +0,0 @@
-*
-* $Id: upkbyt.s,v 1.1.1.1 1996/02/15 17:54:50 mclareni Exp $
-*
-* $Log: upkbyt.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:50 mclareni
-* Kernlib
-*
-*
- MODULE M_UPKBYT
-%
-% CERN PROGLIB# M422 UPKBYT .VERSION KERNNOR 1.05 810521
-% ORIG. H.OVERAS, CERN, 810527
-%
-% CALL UPKBYT(AVM,JA,IXV,N,MPAK) UNPACK BYT-VECTOR
-% MPAK=NBITS,INWORD
-%
- EXPORT UPKBYT
- ROUTINE UPKBYT
- LIB UPKBYT
-VBAS: STACK FIXED
-PAR: W BLOCK 5
-INWORD:W BLOCK 1
-INCR: W BLOCK 1
-JH1: W BLOCK 1
-N1: W BLOCK 1
-NBIT: BY BLOCK 1
- ENDSTACK
-UPKBYT: ENTF VBAS
- W SUB3 IND(B.PAR+12),1,B.N1
- IF<GO OUT:H
- W2 CLR
- W BYCONV IND(B.PAR+16),B.NBIT
- IF>GO L11
- BY SET1 B.NBIT
- W MOVE 32,B.INWORD
- GO L12
-L11: W4:=1
- W MOVE IND(B.PAR+16)(R4),B.INWORD
-L12: W SUB3 B.INWORD,1,B.INCR
- W4:=IND(B.PAR+4)
- W4-1
- IF<=GO L17
- W3 DIV4 R4,B.INWORD,R1
- W SUB3 B.INCR,R3,B.JH1
- BY3*B.NBIT
- GO L22
-L17: W1 CLR
-L21: W ADD3 R2,B.INCR,B.JH1
- W3 CLR
-L22: W COMP2 B.JH1,B.N1
- IF<=GO L24
- W MOVE B.N1,B.JH1
-L24: W4 GETBF IND(B.PAR)(R1),BY3,B.NBIT
- W4=:IND(B.PAR+8)(R2)
- BY3+B.NBIT
- W LOOPI R2,B.JH1,L24
- W2 COMP B.N1
- IF>GO OUT
- W1+1
- GO L21
-OUT: RET
- ENDROUTINE
- ENDMODULE
-#ifdef CERNLIB_TCGEN_UPKBYT
-#undef CERNLIB_TCGEN_UPKBYT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/upkch.s b/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/upkch.s
deleted file mode 100644
index 65be130..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/upkch.s
+++ /dev/null
@@ -1,124 +0,0 @@
-*
-* $Id: upkch.s,v 1.1.1.1 1996/02/15 17:54:51 mclareni Exp $
-*
-* $Log: upkch.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:51 mclareni
-* Kernlib
-*
-*
- MODULE M_UPKCH
-%
-% CERN PROGLIB# M427 UPKCH .VERSION KERNNOR 1.05 810521
-% ORIG. H.OVERAS, CERN, 810609
-%
-% CALL UPKCH(AVM,IXV,N,MPAR) UNPACK CHARACTER-VECTOR
-% MPAR=NBITS,NCHAR,NZONE,IGNOR,NFILL
- IMPORT-D SLATE
- EXPORT UPKCH
- ROUTINE UPKCH
- LIB UPKCH
-VBAS: STACK FIXED
-PAR: W BLOCK 4
-NBITS: W BLOCK 1
-NCHAR: W BLOCK 1
-NZONE: W BLOCK 1
-IGNOR: W BLOCK 1
-NM: W BLOCK 1
-TEMP: W BLOCK 1
-NBDONE:W BLOCK 1
-NBE: W BLOCK 1
-JGM: W BLOCK 1
-NBITSW:W DATA 32
-NHIGH: W BLOCK 1
-NLOW: W BLOCK 1
- ENDSTACK
-UPKCH: ENTF VBAS
- W1:=IND(B.PAR+8)
- IF><GO IN
- W STZ SLATE
-IN: W1-1
- W1=:B.NM
- W1 CLR
-LP: W MOVE IND(B.PAR+12)(R1),B.NBITS(R1)
- W LOOPI R1,3,LP
- W1 CLR
- W2 CLR
- W TEST B.NZONE
- IF><GO L41:H
-L21: W SUB3 B.NBITSW,B.IGNOR,B.JGM
- W MOVE B.NBITS,B.NBE
- W TEST B.NCHAR
- IF=GO L22
- W4:=1
- W4-B.NCHAR
- W4 MULAD B.NBITS,B.JGM
- W4 COMP B.NBE
- IF<GO L22
- W4=:B.NBE
-L22: W3:=B.JGM
-L24: W3-B.NBITS
- W4 GETBF IND(B.PAR)(R1),BY3,B.NBITS+3
- W4=:IND(B.PAR+4)(R2)
- W LOOPI R2,B.NM,L25
- GO OUT:H
-L25: W3 COMP B.NBE
- IF>=GO L24
- W1+1
- GO L22
-L41: W COMP2 B.NZONE,B.NBITSW
- IF=GO L21
- W SUB3 B.NBITSW,B.IGNOR,R3
- W SUB3 B.NZONE,B.NBITS,B.NBE
- W INCR B.NBE
- W4:=B.NCHAR
- IF=GO L42
- W4 MULAD B.NBITS,B.IGNOR
- W4 COMP B.NBE
- IF>=GO L42
- W4=:B.NBE
-L42: W MOVE B.IGNOR,B.NBDONE
-L43: W TEST R3
- IF>=GO L44
- W3+B.NBITSW
- W1+1
- GO L43
-L44: W3-B.NBITS
- IF<GO L51
- W4 GETBF IND(B.PAR)(R1),BY3,B.NBITS+3
- W4=:IND(B.PAR+4)(R2)
- GO L58
-L51: W3+B.NBITSW
- W1+1
- W4 DIV4 R3,8,B.TEMP
- W4=:B.JGM
- W SUB3 B.PAR,B.TEMP,B.TEMP
- W4+B.NBITS
- W4-B.NBITSW
- IF>GO SPEC
- W4 GETBF IND(B.TEMP)(R1),B.JGM+3,B.NBITS+3
- W4=:IND(B.PAR+4)(R2)
- GO L58
-SPEC: W4=:B.NHIGH
- W SUB3 B.NBITSW,B.JGM,B.NLOW
- W4 GETBF IND(B.TEMP)(R1),B.JGM+3,B.NLOW+3
- W4=:IND(B.PAR+4)(R2)
- W SUB2 B.TEMP,4
- W4 GETBF IND(B.TEMP)(R1),0:B,B.NHIGH+3
- W SHL R4,B.NLOW+3
- W ADD2 IND(B.PAR+4)(R2),R4
-L58: W LOOPI R2,B.NM,L59
-OUT: W INCR R1
- W1=:SLATE
- RET
-L59: W ADD2 B.NBDONE,B.NBITS
- W COMP2 B.NBDONE,B.NBE
- IF<GO L44
- W3-B.NZONE
- W3+B.NBDONE
- W3-B.IGNOR
- GO L42
- ENDROUTINE
- ENDMODULE
-#ifdef CERNLIB_TCGEN_UPKCH
-#undef CERNLIB_TCGEN_UPKCH
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/vblank.s b/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/vblank.s
deleted file mode 100644
index e2d53de..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/vblank.s
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: vblank.s,v 1.1.1.1 1996/02/15 17:54:51 mclareni Exp $
-*
-* $Log: vblank.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:51 mclareni
-* Kernlib
-*
-*
- MODULE M_VBLANK
-%
-% CERN PROGLIB# F121 VBLANK .VERSION KERNNOR 2.05 880419
-% ORIG. H.OVERAS, CERN, 810330
-% MODIF. P.S.Iversen, 8-dec-87
-%
-% CALL VBLANK(XVM,N) XVM(I)=HOLLERITH BLANK
-%
- EXPORT VBLANK
- ROUTINE VBLANK
- LIB VBLANK
-VBAS: STACK FIXED
-PAR: W BLOCK 2
- ENDSTACK
-VBLANK: ENTF VBAS
- W3 := IND(B.PAR+4) % Load N
- IF <= GO OUT % If <= zero, exit
- W BMOVE 4010020040B,IND(B.PAR),W3 % Fill words
-OUT: RET % Exit
- ENDROUTINE
- ENDMODULE
-#ifdef CERNLIB_TCGEN_VBLANK
-#undef CERNLIB_TCGEN_VBLANK
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/vcopyn.s b/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/vcopyn.s
deleted file mode 100644
index 0aee3cc..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/vcopyn.s
+++ /dev/null
@@ -1,37 +0,0 @@
-*
-* $Id: vcopyn.s,v 1.1.1.1 1996/02/15 17:54:51 mclareni Exp $
-*
-* $Log: vcopyn.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:51 mclareni
-* Kernlib
-*
-*
- MODULE M_VCOPYN
-%
-% CERN PROGLIB# F121 VCOPYN .VERSION KERNNOR 2.05 880419
-% ORIG. H.OVERAS, CERN, 791213
-% MODIF. P.S.Iversen, 8-dec-87
-%
-% CALL VCOPYN(AV,XV,N) XV(I)=-AV(I)
-%
- EXPORT VCOPYN
- ROUTINE VCOPYN
- LIB VCOPYN
-VBAS: STACK FIXED
-PAR: W BLOCK 3
- ENDSTACK
-VCOPYN: ENTF VBAS
- W1:=0
- W2:=IND(B.PAR+8)
- IF <= GO OUT % If <= zero, exit
- W2-1
-BEGLP: F3:=IND(B.PAR)(R1)
- F3 NEG
- F3=:IND(B.PAR+4)(R1)
- W LOOPI R1,R2,BEGLP
-OUT: RET
- ENDROUTINE
- ENDMODULE
-#ifdef CERNLIB_TCGEN_VCOPYN
-#undef CERNLIB_TCGEN_VCOPYN
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/vfill.s b/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/vfill.s
deleted file mode 100644
index d8d6e05..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/vfill.s
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: vfill.s,v 1.1.1.1 1996/02/15 17:54:51 mclareni Exp $
-*
-* $Log: vfill.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:51 mclareni
-* Kernlib
-*
-*
- MODULE M_VFILL
-%
-% CERN PROGLIB# F121 VFILL .VERSION KERNNOR 2.05 880419
-% ORIG. H.OVERAS, CERN, 810330
-% MODIF. P.S.Iversen, 8-dec-87
-%
-% CALL VFILL(XVM,N,CM) XVM(I)=CM
-%
- EXPORT VFILL
- ROUTINE VFILL
- LIB VFILL
-VBAS: STACK FIXED
-PAR: W BLOCK 3
- ENDSTACK
-VFILL: ENTF VBAS
- W2 := IND(B.PAR+4) % Load N
- IF <= GO OUT % If <= zero, exit
- W3 := IND(B.PAR+8) % Fill pattern
- W BMOVE W3,IND(B.PAR),W2 % Fill words
-OUT: RET % Exit
- ENDROUTINE
- ENDMODULE
-#ifdef CERNLIB_TCGEN_VFILL
-#undef CERNLIB_TCGEN_VFILL
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/vfix.s b/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/vfix.s
deleted file mode 100644
index 3785732..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/vfix.s
+++ /dev/null
@@ -1,35 +0,0 @@
-*
-* $Id: vfix.s,v 1.1.1.1 1996/02/15 17:54:51 mclareni Exp $
-*
-* $Log: vfix.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:51 mclareni
-* Kernlib
-*
-*
- MODULE M_VFIX
-%
-% CERN PROGLIB# F121 VFIX .VERSION KERNNOR 2.05 880419
-% ORIG. H.OVERAS, CERN, 791213
-% MODIF. P.S.Iversen, 8-dec-87
-%
-% CALL VFIX(AV,IXV,N) IXV(I)=AV(I)
-%
- EXPORT VFIX
- ROUTINE VFIX
-VBAS: STACK FIXED
-PAR: W BLOCK 3
- ENDSTACK
- LIB VFIX
-VFIX: ENTF VBAS
- W1:=0
- W2:=IND(B.PAR+8)
- IF <= GO OUT % If <= zero, exit
- W2-1
-BEGLP: F WCONV IND(B.PAR)(R1),IND(B.PAR+4)(R1)
- W LOOPI R1,R2,BEGLP
-OUT: RET
- ENDROUTINE
- ENDMODULE
-#ifdef CERNLIB_TCGEN_VFIX
-#undef CERNLIB_TCGEN_VFIX
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/vfloat.s b/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/vfloat.s
deleted file mode 100644
index 6c46b3b..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/vfloat.s
+++ /dev/null
@@ -1,35 +0,0 @@
-*
-* $Id: vfloat.s,v 1.1.1.1 1996/02/15 17:54:51 mclareni Exp $
-*
-* $Log: vfloat.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:51 mclareni
-* Kernlib
-*
-*
- MODULE M_VFLOAT
-%
-% CERN PROGLIB# F121 VFLOAT .VERSION KERNNOR 2.05 880419
-% ORIG. H.OVERAS, CERN, 791213
-% MODIF. P.S.Iversen, 8-dec-87
-%
-% CALL VFLOAT(IV,XV,N) XV(I)=IV(I)
-%
- EXPORT VFLOAT
- ROUTINE VFLOAT
- LIB VFLOAT
-VBAS: STACK FIXED
-PAR: W BLOCK 3
- ENDSTACK
-VFLOAT: ENTF VBAS
- W1:=0
- W2:=IND(B.PAR+8)
- IF <= GO OUT % If <= zero, exit
- W2-1
-BEGLP: W FCONV IND(B.PAR)(R1),IND(B.PAR+4)(R1)
- W LOOPI R1,R2,BEGLP
-OUT: RET
- ENDROUTINE
- ENDMODULE
-#ifdef CERNLIB_TCGEN_VFLOAT
-#undef CERNLIB_TCGEN_VFLOAT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/vzero.s b/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/vzero.s
deleted file mode 100644
index b053314..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/vzero.s
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: vzero.s,v 1.1.1.1 1996/02/15 17:54:51 mclareni Exp $
-*
-* $Log: vzero.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:51 mclareni
-* Kernlib
-*
-*
- MODULE M_VZERO
-%
-% CERN PROGLIB# F121 VZERO .VERSION KERNNOR 2.05 880419
-% ORIG. H.OVERAS, CERN, 810330
-% MODIF. P.S.Iversen, 8-dec-87
-%
-% CALL VZERO(XVM,N) XVM(I)=0.
-%
- EXPORT VZERO
- ROUTINE VZERO
- LIB VZERO
-VBAS: STACK FIXED
-PAR: W BLOCK 2
- ENDSTACK
-VZERO: ENTF VBAS
- W3 := IND(B.PAR+4) % Load N
- IF <= GO OUT % If <= zero, exit
- W BMOVE 0B,IND(B.PAR),W3 % Fill with zero
-OUT: RET % Exit
- ENDROUTINE
- ENDMODULE
-#ifdef CERNLIB_TCGEN_VZERO
-#undef CERNLIB_TCGEN_VZERO
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/xinb.F b/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/xinb.F
deleted file mode 100644
index 3ba2bc8..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/xinb.F
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: xinb.F,v 1.1.1.1 1996/02/15 17:54:51 mclareni Exp $
-*
-* $Log: xinb.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:51 mclareni
-* Kernlib
-*
-*
-#include "kernnor/pilot.h"
- SUBROUTINE XINB (LUN,XBV,NXB)
-C
-C CERN PROGLIB# Z203 XINB .VERSION KERNNOR 0.99 790518
-C
- DIMENSION XBV(99)
-
- READ (LUN,END=61,ERR=64) N, (XBV(J),J=1,MIN0(N,NXB))
- N = MIN0 (N,NXB)
- NXB = MAX0 (N,1)
- RETURN
-
- 61 NXB = 0
- RETURN
-
- 64 NXB = -7
- RETURN
- END
-#ifdef CERNLIB_TCGEN_XINB
-#undef CERNLIB_TCGEN_XINB
-#endif
-#ifdef CERNLIB_XVECT_XINB
-#undef CERNLIB_XVECT_XINB
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/xinbs.F b/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/xinbs.F
deleted file mode 100644
index 14eb169..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnor/nord3/xinbs.F
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: xinbs.F,v 1.1.1.1 1996/02/15 17:54:51 mclareni Exp $
-*
-* $Log: xinbs.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:51 mclareni
-* Kernlib
-*
-*
-#include "kernnor/pilot.h"
- SUBROUTINE XINBS (LUN,XAV,NA,XBV,NXB)
-C
-C CERN PROGLIB# Z203 XINBS .VERSION KERNNOR 0.99 790518
-C
- DIMENSION XBV(99), XAV(NA)
-
- READ (LUN,END=61,ERR=64) N,XAV,(XBV(J),J=1,MIN0(N,NXB))
- N = MIN0 (N,NXB)
- NXB = MAX0 (N,1)
- RETURN
-
- 61 NXB = 0
- RETURN
-
- 64 NXB = -7
- RETURN
- END
-#ifdef CERNLIB_TCGEN_XINBS
-#undef CERNLIB_TCGEN_XINBS
-#endif
-#ifdef CERNLIB_XVECT_XINBS
-#undef CERNLIB_XVECT_XINBS
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnor/nordsys/Imakefile b/src/packlib/kernlib/kerngen/obsolete/kernnor/nordsys/Imakefile
deleted file mode 100644
index 9887338..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnor/nordsys/Imakefile
+++ /dev/null
@@ -1,7 +0,0 @@
-SRCS_F= \ @@\
- datime.F datimh.F gshow.F intrac.F iumode.F timed.F timex.F
-
-SRCS_S= \ @@\
- qnexte.s tracxq.s
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnor/nordsys/datime.F b/src/packlib/kernlib/kerngen/obsolete/kernnor/nordsys/datime.F
deleted file mode 100644
index c41d1b8..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnor/nordsys/datime.F
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: datime.F,v 1.1.1.1 1996/02/15 17:54:51 mclareni Exp $
-*
-* $Log: datime.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:51 mclareni
-* Kernlib
-*
-*
-#include "kernnor/pilot.h"
- SUBROUTINE DATIME (ND,NT)
-C
-C CERN PROGLIB# Z007 DATIME .VERSION KERNNOR 2.07 890912
-C MOD. 27/07/89 add /SLATE/, JZ
-C
- COMMON /SLATE/ MM(20), M(20)
-
- CALL CLOCK (M)
-
- DO 24 J=1,6
- 24 MM(J) = M(8-J)
-
- M(7) = MOD(M(7),100)
- ND = 10000*M(7)+100*M(6)+M(5)
- NT = 100*M(4)+M(3)
- RETURN
- END
-#ifdef CERNLIB_TCGEN_DATIME
-#undef CERNLIB_TCGEN_DATIME
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnor/nordsys/datimh.F b/src/packlib/kernlib/kerngen/obsolete/kernnor/nordsys/datimh.F
deleted file mode 100644
index 526d85b..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnor/nordsys/datimh.F
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: datimh.F,v 1.1.1.1 1996/02/15 17:54:51 mclareni Exp $
-*
-* $Log: datimh.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:51 mclareni
-* Kernlib
-*
-*
-#include "kernnor/pilot.h"
- SUBROUTINE DATIMH (ND,NT)
-C
-C CERN PROGLIB# Z007 DATIMH .VERSION KERNNOR 0.99 771101
-C
- DIMENSION ND(2),NT(2),CH(8),IH(7),CA(10)
- DATA CA/1H0,1H1,1H2,1H3,1H4,1H5,1H6,1H7,1H8,1H9/
- DATA SLA/1H//,DOT/1H./
-
- CALL CLOCK (IH)
- CH(1) = CA(1+IH(5)/10)
- CH(2) = CA(1+MOD(IH(5),10))
- CH(3) = SLA
- CH(4) = CA(1+IH(6)/10)
- CH(5) = CA(1+MOD(IH(6),10))
- CH(6) = SLA
- CH(7) = CA(1+MOD(IH(7)/10,10))
- CH(8) = CA(1+MOD(IH(7),10))
- CALL UBUNCH (CH,ND,8)
- CH(1) = CA(1+IH(4)/10)
- CH(2) = CA(1+MOD(IH(4),10))
- CH(3) = DOT
- CH(4) = CA(1+IH(3)/10)
- CH(5) = CA(1+MOD(IH(3),10))
- CH(6) = DOT
- CH(7) = CA(1+IH(2)/10)
- CH(8) = CA(1+MOD(IH(2),10))
- CALL UBUNCH (CH,NT,8)
- RETURN
- END
-#ifdef CERNLIB_TCGEN_DATIMH
-#undef CERNLIB_TCGEN_DATIMH
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnor/nordsys/gshow.F b/src/packlib/kernlib/kerngen/obsolete/kernnor/nordsys/gshow.F
deleted file mode 100644
index 02bf45d..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnor/nordsys/gshow.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: gshow.F,v 1.1.1.1 1996/02/15 17:54:51 mclareni Exp $
-*
-* $Log: gshow.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:51 mclareni
-* Kernlib
-*
-*
-#include "kernnor/pilot.h"
- SUBROUTINE GSHOW (LUN)
-C
-C CERN PROGLIB# Z001 GSHOW .VERSION KERNNOR 1.07 810629
-C
-C
-C-- STORE PAM TITLE INTO /SLATE/ FOR PRINTING BY GSHOWF
-C
- COMMON /SLATE/ CH(40)
-C
- CALL UBLOW (
- + 40H CPP_TITLE
- +, CH,40)
- CALL GSHOWF (LUN)
- RETURN
- END
-#ifdef CERNLIB_TCGEN_GSHOW
-#undef CERNLIB_TCGEN_GSHOW
-#endif
-#include "kernnor/TITLE.kernnor"
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnor/nordsys/intrac.F b/src/packlib/kernlib/kerngen/obsolete/kernnor/nordsys/intrac.F
deleted file mode 100644
index bb65104..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnor/nordsys/intrac.F
+++ /dev/null
@@ -1,60 +0,0 @@
-*
-* $Id: intrac.F,v 1.1.1.1 1996/02/15 17:54:51 mclareni Exp $
-*
-* $Log: intrac.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:51 mclareni
-* Kernlib
-*
-*
-#include "kernnor/pilot.h"
- LOGICAL FUNCTION INTRAC(DUMMY)
-C
-C CERN PROGLIB# Z044 INTRAC .VERSION KERNNOR 2.02 850320
-C ORIG. 20/02/83 HRR FROM GENLIB
-C
-C INTRAC CERN COMPUTER CENTER PROGRAM LIBRARY Z044
-C
-C AUTHOR : H.RENSHALL, DD, CERN
-C
-C LANGUAGE : NORD-500 FORTRAN
-C
-C PURPOSE : IDENTIFY A JOB AS INTERACTIVE
-C
-C STRUCTURE : LOGICAL FUNCTION SUBPROGRAM.
-C
-C USER ENTRY NAMES : INTRAC
-C INTERNAL ENTRY NAMES : -NONE-
-C FILES REFERENCED : -NONE-
-C EXTERNAL ROUTINES REFERENCED : RSIO (NORD SYSTEM ROUTINE)
-C COMMON BLOCKS NAMES AND LENGTHS : -NONE-
-C
-C USAGE : LOGICAL INTRAC
-C IF ( INTRAC(DUMMY) ) GO TO ...
-C
-C THE VALUE OF THE LOGICAL FUNCTION INTRAC WILL BE .TRUE. IF THE
-C JOB IS RUNNING INTERACTIVELY, AND WILL BE .FALSE. IF IT WAS
-C SUBMITTED THROUGH A BATCH QUEUE OR IS A MODE JOB.
-C
-C
-C CALL NORD SYSTEM ROUTINE
-C
-C CALL RSIO ( IMODE, INDEV, IOUT, IUSER)
-C
-C IMODE= O INTERACTIVE
-C IMODE= 1 MODE JOB (PROCEDURE FILE)
-C IMODE= 2 BATCH (APPEND-BATCH)
-C
-C INDEV= SINTRAN LOGICAL UNIT OF INPUT DEVICE (TERMINAL IF INTERACTIVE)
-C
-C IOUT= SINTRAN LOGICAL UNIT OF OUTPUT DEVICE (TERMINAL IF INTERACTIVE)
-C
-C IUSER= LOGGED ON USER NUMBER
-C
- CALL RSIO ( IMODE, INDEV, IOUT, IUSER)
- INTRAC = .FALSE.
- IF( IMODE.EQ.0) INTRAC= .TRUE.
- RETURN
- END
-#ifdef CERNLIB_TCGEN_INTRAC
-#undef CERNLIB_TCGEN_INTRAC
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnor/nordsys/iumode.F b/src/packlib/kernlib/kerngen/obsolete/kernnor/nordsys/iumode.F
deleted file mode 100644
index a3648f6..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnor/nordsys/iumode.F
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: iumode.F,v 1.1.1.1 1996/02/15 17:54:51 mclareni Exp $
-*
-* $Log: iumode.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:51 mclareni
-* Kernlib
-*
-*
-#include "kernnor/pilot.h"
- FUNCTION IUMODE (WORD)
-C
-C CERN PROGLIB# M506 IUMODE .VERSION KERNNOR 1.03 810324
-C
-
- J = JBYT (WORD,25,8)
- IF (J.EQ.255) J=0
- IUMODE = J
- RETURN
- END
-#ifdef CERNLIB_TCGEN_IUMODE
-#undef CERNLIB_TCGEN_IUMODE
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnor/nordsys/qnexte.s b/src/packlib/kernlib/kerngen/obsolete/kernnor/nordsys/qnexte.s
deleted file mode 100644
index b1c9207..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnor/nordsys/qnexte.s
+++ /dev/null
@@ -1,37 +0,0 @@
-*
-* $Id: qnexte.s,v 1.1.1.1 1996/02/15 17:54:51 mclareni Exp $
-*
-* $Log: qnexte.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:51 mclareni
-* Kernlib
-*
-*
- MODULE M_QNEXTE
-%
-% CERN PROGLIB# Z041 QNEXTE .VERSION KERNNOR 2.01 840816
-% ORIG. W.JANK, CERN, 811104
-%
- EXPORT QNEXTE
- ROUTINE QNEXTE
- LIB QNEXTE
- IMPORT-P QNEXT
-VBAS: STACK FIXED
-RETADD: W BLOCK 1
-BPREV: W BLOCK 1
- ENDSTACK
-QNEXTE: ENTF VBAS
- W TEST B.BPREV %FIRST CALL
- IF=GO FIRST %YES, INITIALISE
- W MOVE B.RETADD,B.4 %SET RET.ADDRESS
- W MOVE B.BPREV,B.0 %AND PREVIOUS B
- CALL QNEXT,0 %CALL ROUTINE WITH NO ARGS.
- RET %RETURN
-FIRST: W MOVE B.4,B.RETADD %INIT. RETURN ADDR.
- W MOVE B.0,B.BPREV %INIT. PREVIOUS B
- CALL QNEXT,0 %CALL ROUTINE WITH NO ARGS.
- RET
- ENDROUTINE
- ENDMODULE
-#ifdef CERNLIB_TCGEN_QNEXTE
-#undef CERNLIB_TCGEN_QNEXTE
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnor/nordsys/timed.F b/src/packlib/kernlib/kerngen/obsolete/kernnor/nordsys/timed.F
deleted file mode 100644
index 302a8fb..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnor/nordsys/timed.F
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: timed.F,v 1.1.1.1 1996/02/15 17:54:52 mclareni Exp $
-*
-* $Log: timed.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:52 mclareni
-* Kernlib
-*
-*
-#include "kernnor/pilot.h"
- SUBROUTINE TIMED (DELTA)
-C
-C CERN PROGLIB# Z007 TIMED .VERSION KERNNOR 1.16 821202
-C
-C- TIME ELAPSED SINCE LAST CALL
-C
- INTEGER*4 TUSED
- DATA LAST / 0 /
-C
-C
-C TUSED GIVES THE CPU TIME OF JOB IN JIFFIES (20MS)
- ITIM = TUSED (IDEL)
- IDEL = ITIM - LAST
- LAST = ITIM
-C JIFFIES TO SECONDS
- DELTA = FLOAT(IDEL) / 50.
- END
-#ifdef CERNLIB_TCGEN_TIMED
-#undef CERNLIB_TCGEN_TIMED
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnor/nordsys/timex.F b/src/packlib/kernlib/kerngen/obsolete/kernnor/nordsys/timex.F
deleted file mode 100644
index 8fe323e..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnor/nordsys/timex.F
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: timex.F,v 1.1.1.1 1996/02/15 17:54:52 mclareni Exp $
-*
-* $Log: timex.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:52 mclareni
-* Kernlib
-*
-*
-#include "kernnor/pilot.h"
- SUBROUTINE TIMEX (TXQT)
-C
-C CERN PROGLIB# Z007 TIMEX .VERSION KERNNOR 1.16 821202
-C
-C- EXECUTION TIME OF JOB
-C
- INTEGER*4 TUSED
-C
- ITIM = TUSED (DUMMY)
-C CONVERT FROM JIFFIES (20MS) TO SECONDS
- TXQT = FLOAT(ITIM)/50.
- END
-#ifdef CERNLIB_TCGEN_TIMEX
-#undef CERNLIB_TCGEN_TIMEX
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnor/nordsys/tracxq.s b/src/packlib/kernlib/kerngen/obsolete/kernnor/nordsys/tracxq.s
deleted file mode 100644
index 11e9ee5..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnor/nordsys/tracxq.s
+++ /dev/null
@@ -1,137 +0,0 @@
-*
-* $Id: tracxq.s,v 1.1.1.1 1996/02/15 17:54:52 mclareni Exp $
-*
-* $Log: tracxq.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:52 mclareni
-* Kernlib
-*
-*
-#if defined(CERNLIB_QMND3)
- MODULE M_TRACXQ
-%
-% CERN PROGLIB# N105 TRACXQ .VERSION KERNNOR 1.07 810629
-% ORIG. H.OVERAS, CERN, 810621
-%
-% PROVIDE TRACEBACK WHEN CALLED VIA TRACEQ (IN FTN)
-% WILL HANDLE CORRECTLY A ROUTINE HIERARCHY CONTAINING ONLY:
-% A) CALL TO ENTF
-% B) CALLG TO ENTF WITH LOCAL INDIRECT SUBR ADDRESS
-% CALL TRAC1Q INITIALIZE TRACEBACK
-% CALL TRAC2Q DELIVER NEXT STEP
-%
- IMPORT-D SLATE
- EXPORT TRAC1Q,TRAC2Q
- ROUTINE TRAC1Q,TRAC2Q
- LIB TRAC1Q,TRAC2Q
-VBAS: STACK FIXED
-BN: W BLOCK 1 %VBAS (B) OF CALLER
-RANP: W BLOCK 1 %RETURN ADDRESS OF CALLER
-CALA: W BLOCK 1 %LOCATION OF CALL
-ENTA: W BLOCK 1 %DIR OR IND POINTER TO ENTF OF CALLER
-PADR: W BLOCK 1 %P POINTER TO NEAR RET ADDR
-HOP: W BLOCK 1 % #BYTES TAKEN BY SUBROUT REF
-BUFP: W BLOCK 3 %ROLLING BUFFER FOR PROG BYTES
-ENDBF: W BLOCK 1 %POINTER TO FIRST LOC AFTER BUFP
-ENINS: W BLOCK 1
-IFLG: W BLOCK 1 %0 DURING INITIALIZATION
-MFLG: W BLOCK 1 %0 UNTIL MAIN REACHED
-R3LMT: W BLOCK 1 %MOVING LOWER LIMIT OF P BYTE POINTER
-ZRO: W DATA 0
-MON60: W DATA 37000000060B
- ENDSTACK
-TRAC1Q: ENTF VBAS
- W STZ B.IFLG
- W STZ B.MFLG
- W MOVE B.0,B.BN
- GO FIRST
-FINIT: W SET1 B.IFLG
- RET
-TRAC2Q: ENTF VBAS
- W TEST B.MFLG
- IF=GO ON
- W SET1 SLATE+16 %MAIN PROG WAS REACHED
- RET
-ON: R:=B.BN
- W MOVE R.0,B.BN
- W MOVE B.CALA,SLATE+12 %RETURN LOCATION OF CALL
- W STZ SLATE+16
-FIRST: W2 LADDR B.ENDBF
- W2=:B.ENDBF
- R:=B.BN
- W MOVE R.4,B.RANP
- IF=GO MAIN:H
- W MOVE B.RANP,B.PADR
- W4:=-2 %INITIALIZE P WORD CONTER
- W3:=-1 %INITIALIZE P BYTE COUNTER
- W MOVE -4,B.R3LMT
-LP1: W SUB2 B.PADR,4 %START NEW P WORD LOOP
- IF<=GO BADLY:H
- W MOVE B.BUFP+4,B.BUFP+8 %ROLL BUFFER
- W MOVE B.BUFP,B.BUFP+4
- CALLG B.MON60,3:B,B.ZRO,B.PADR,B.BUFP %GET 4 P BYTES
- W TEST R1
- IF><GO BADLY:H %ERR FROM MON60
-LP2: W2:=R3 %START NEXT (EARLIER) P BYTE LOOP
- W2 PSUM R4,4
- W ADD2 R2,B.ENDBF
- W MOVE R2.1,B.ENTA %P POINTER (DIR OR IND)TO ENTF INSTR
- W MOVE 4,B.HOP
- BY1:=R2.0
- BY1 COMP 303B:B %TEST OPCODE CALL
- IF=GO FETCH
- BY1 COMP 265B:B %TEST OPCODE CALLG
- IF><GO NXTBY:H
- BY1:=R2.1
- BY1-305B:B %LOCAL INDIRECT SUBR REF?
- IF=GO BYDSP
- BY1 COMP 1:B
- IF=GO HDSP
- BY1 COMP 2:B
- IF=GO WDSP
- GO NXTBY
-BYDSP: W MOVE 2,B.HOP
- BY1:=R2.2
- GO PREP
-HDSP: W MOVE 3,B.HOP
- H1:=R2.2
- GO PREP
-WDSP: W MOVE 5,B.HOP
- W1:=R2.2
-PREP: W ADD2 R1,R.0
- W MOVE R1.0,B.ENTA
- W MOVE IND(B.ENTA),B.ENTA
-FETCH: CALLG B.MON60,3:B,B.ZRO,B.ENTA,B.ENINS %4 FIRST BYTES OF ENTF
- W TEST R1
- IF><GO BADLY:H %ERR FROM MON60
- BY COMP2 B.ENINS,335B:B %TEST OPCODE ENTF
- IF><GO NXTBY
- W ADD2 R2,B.HOP %HOP OVER SUBROUT ADDR BYTES
- BY COMP2 R2.1,R.19 %COMP ARG # IN CALL AND IN STACK
- IF><GO NXTBY
- W MOVE B.ENTA,SLATE %RETURN ENTRY ADDRESS OF CALLER
- W INCR B.ENTA %P POINTER TO VBAS VALUE
- CALLG B.MON60,3:B,B.ZRO,B.ENTA,SLATE+4 %GET VBAS FROM ENTF INST
- W TEST R1
- IF><GO BADLY:H %ERR FROM MON60
- R=:R1
- W1 COMP SLATE+4 %COMP WITH VBAS FROM STACK
- IF=GO FOUND
-NXTBY: W LOOPD R3,B.R3LMT,LP2
- W SUB2 B.R3LMT,4
- W LOOPI R4,100,LP1
- GO BADLY
-FOUND: W ADD3 B.RANP,R3,B.CALA %DEFINE LOC OF NEXT HIGHER CALL
- W TEST B.IFLG
- IF=GO FINIT
- W COMP2 SLATE,SLATE+12 %CALL ADDR AFTER SUBR START?
- IF>=GO BADLY
- RET
-MAIN: W MOVE 4,SLATE %ENTADDR AND VBAS OF MAIN ARE 4
- W MOVE 4,SLATE+4
- W SET1 B.MFLG
- RET
-BADLY: W MOVE -1,SLATE+16 %TRACEBACK FAILED
- RET
- ENDROUTINE
- ENDMODULE
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnxt/history/history.dat b/src/packlib/kernlib/kerngen/obsolete/kernnxt/history/history.dat
deleted file mode 100644
index c0d4442..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnxt/history/history.dat
+++ /dev/null
@@ -1,81 +0,0 @@
-*
-* $Id: history.dat,v 1.1.1.1 1996/02/15 17:53:29 mclareni Exp $
-*
-* $Log: history.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:53:29 mclareni
-* Kernlib
-*
-*
-* This directory was created from kernnxt.car patch kernnxt
-#if !defined(CERNLIB_KERNNXT)
-
- KERNLIB ROUTINES PARTICULAR TO THE Next
-
----------------------------------------------------------------------
-
- This file contains the following patches :
-
-*KNXT Pilot-patch selecting the standard KERNLIB for Next
-
-QMNXT Next machine patch
-
-NXTPROGS Next utility programs
-
-NXTGS Next versions of general KERNLIB routines
-
-=====================================================================
-
-
- UP-DATE RECORD FOR THE PAM-FILE KERNNXT
- ----------------------------------------
-
- UP-DATE 2.02 : 03-dec-1992 (Dino Ferrero/Cern ECP)
-----------------------------
-
-Replacing file KERNNXT 2.01
-
-Correct: trailing underscores management on external symbols
-
-
----------------------------------------------------------------------
-
-UP-DATE 2.00 : 18-Sep-1992 (F.Dittus/Uni Bern + F-H.Heinsius/Uni Hamburg)
-----------------------------
-
-Replacing file KERNNXT 1.01 901112 15.50
-
-Correct : P=*KNXT
-
- removed +USE, QMILSTD, T=INH.
- added +USE, CCGEN, CCGENCF.
- added +USE, CCGEN, D=QNEXTE, TIMEL, T=INH.
- added +USE, CCGEN, D=ABEND, DATIME, DATIMU, T=INH.
- added +USE, CCGEN, D=INTRAC, JUMPXN, LOCB, LOCF, T=INH.
- removed +USE, TCGEN, D=LNBLNK, T=INH.
-
-Correct : P=*QMNXT
-
- added +USE, QMUIX, QDEFAULT, QX_SC, QSYSBSD.
-
-Correct : P=*NXTGS,D=TIMEL
-
- add also stime,cstime to timstart,timnow.
-
-
-Correct : P=*NXTGS,D=GETARG
-
- iargc returns number of arguments, not counting the 0'th one,
- for compatibility with iargc on other Unix machines.
-
-Remove : P=NXTPROGS,D=FCASPLIT
-
- use FCASPLIT from KERNFOR, to always use the latest version!
-
-
----------------------------------------------------------------------
-
- First release of the KERNNXT Pam : 5-Nov-1990
-
----------------------------------------------------------------------
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnxt/inhibit.list b/src/packlib/kernlib/kerngen/obsolete/kernnxt/inhibit.list
deleted file mode 100644
index 1b76d61..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnxt/inhibit.list
+++ /dev/null
@@ -1,24 +0,0 @@
-ccgen/qnexte
-ccgen/timel
-ccgen/abend
-ccgen/datime
-ccgen/datimu
-ccgen/intrac
-ccgen/jumpxn
-ccgen/locb
-ccgen/locf
-tcgen/kerngt
-tcgen/gshow
-tcgen/abend
-tcgen/datime
-tcgen/datimh
-tcgen/intrac
-tcgen/jumpxn
-tcgen/locb
-tcgen/locf
-tcgen/qnexte
-tcgen/ublow
-tcgen/timest
-tcgen/timex
-tcgen/timed
-tcgen/timel
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnxt/kernnxt/jobnn.inc b/src/packlib/kernlib/kerngen/obsolete/kernnxt/kernnxt/jobnn.inc
deleted file mode 100644
index 443c6ec..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnxt/kernnxt/jobnn.inc
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: jobnn.inc,v 1.1.1.1 1996/02/15 17:53:30 mclareni Exp $
-*
-* $Log: jobnn.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:53:30 mclareni
-* Kernlib
-*
-*
-#ifndef CERNLIB_KERNNXT_JOBNN_INC
-#define CERNLIB_KERNNXT_JOBNN_INC
-*
-*
-* jobnn.inc
-*
- PARAMETER (JOBNN='NEXT')
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnxt/kernnxt/pilot.h b/src/packlib/kernlib/kerngen/obsolete/kernnxt/kernnxt/pilot.h
deleted file mode 100644
index 6ea32d0..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnxt/kernnxt/pilot.h
+++ /dev/null
@@ -1,48 +0,0 @@
-#if 0
-* This pilot patch was created from kernnxt.car patch _knxt
-#endif
-#ifndef CERNLIB_QMNXT
-#define CERNLIB_QMNXT
-#endif
-#ifndef CERNLIB_NXTGS
-#define CERNLIB_NXTGS
-#endif
-#ifndef CERNLIB_XVECT
-#define CERNLIB_XVECT
-#endif
-#ifndef CERNLIB_TCGEN
-#define CERNLIB_TCGEN
-#endif
-#ifndef CERNLIB_CCGEN
-#define CERNLIB_CCGEN
-#endif
-#ifndef CERNLIB_CCGENCF
-#define CERNLIB_CCGENCF
-#endif
-#ifdef CERNLIB_CCGEN_QNEXTE
-#undef CERNLIB_CCGEN_QNEXTE
-#endif
-#ifdef CERNLIB_CCGEN_TIMEL
-#undef CERNLIB_CCGEN_TIMEL
-#endif
-#ifdef CERNLIB_CCGEN_ABEND
-#undef CERNLIB_CCGEN_ABEND
-#endif
-#ifdef CERNLIB_CCGEN_DATIME
-#undef CERNLIB_CCGEN_DATIME
-#endif
-#ifdef CERNLIB_CCGEN_DATIMU
-#undef CERNLIB_CCGEN_DATIMU
-#endif
-#ifdef CERNLIB_CCGEN_INTRAC
-#undef CERNLIB_CCGEN_INTRAC
-#endif
-#ifdef CERNLIB_CCGEN_JUMPXN
-#undef CERNLIB_CCGEN_JUMPXN
-#endif
-#ifdef CERNLIB_CCGEN_LOCB
-#undef CERNLIB_CCGEN_LOCB
-#endif
-#ifdef CERNLIB_CCGEN_LOCF
-#undef CERNLIB_CCGEN_LOCF
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnxt/kernnxt/qcardl.inc b/src/packlib/kernlib/kerngen/obsolete/kernnxt/kernnxt/qcardl.inc
deleted file mode 100644
index 8185256..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnxt/kernnxt/qcardl.inc
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: qcardl.inc,v 1.1.1.1 1996/02/15 17:53:29 mclareni Exp $
-*
-* $Log: qcardl.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:53:29 mclareni
-* Kernlib
-*
-*
-#ifndef CERNLIB_KERNNXT_QCARDL_INC
-#define CERNLIB_KERNNXT_QCARDL_INC
-*
-*
-* qcardl.inc
-*
-#if 0
-C====================================================================
-#endif
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnxt/kernnxt/qmnxt.h b/src/packlib/kernlib/kerngen/obsolete/kernnxt/kernnxt/qmnxt.h
deleted file mode 100644
index 7f28996..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnxt/kernnxt/qmnxt.h
+++ /dev/null
@@ -1,48 +0,0 @@
-*
-* $Id: qmnxt.h,v 1.1.1.1 1996/02/15 17:53:29 mclareni Exp $
-*
-* $Log: qmnxt.h,v $
-* Revision 1.1.1.1 1996/02/15 17:53:29 mclareni
-* Kernlib
-*
-*
-* This directory was created from kernnxt.car patch qmnxt
-#ifndef CERNLIB_F77
-#define CERNLIB_F77
-#endif
-#ifndef CERNLIB_A4
-#define CERNLIB_A4
-#endif
-#ifndef CERNLIB_B32
-#define CERNLIB_B32
-#endif
-#ifndef CERNLIB_HEX
-#define CERNLIB_HEX
-#endif
-* Normal Unix system machine
-#ifndef CERNLIB_QMUIX
-#define CERNLIB_QMUIX
-#endif
-* Default option setting
-#ifndef CERNLIB_QDEFAULT
-#define CERNLIB_QDEFAULT
-#endif
-* external names with underscore
-#ifndef CERNLIB_QX_SC
-#define CERNLIB_QX_SC
-#endif
-* running BSD
-#ifndef CERNLIB_QSYSBSD
-#define CERNLIB_QSYSBSD
-#endif
-#ifndef CERNLIB_QIEEE
-#define CERNLIB_QIEEE
-#endif
-* ISA standard routines, ISHFT, IOR, etc
-#ifndef CERNLIB_QISASTD
-#define CERNLIB_QISASTD
-#endif
-* MIL standard routines, IBITS, MVBITS, ISHFTC
-#ifndef CERNLIB_QMILSTD
-#define CERNLIB_QMILSTD
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnxt/nxtgs/Imakefile b/src/packlib/kernlib/kerngen/obsolete/kernnxt/nxtgs/Imakefile
deleted file mode 100644
index 8277918..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnxt/nxtgs/Imakefile
+++ /dev/null
@@ -1,8 +0,0 @@
-SRCS_F= \ @@\
- kerngt.F ublow.F
-
-SRCS_C= \ @@\
- abend.c datime.c datimh.c getarg.c intrac.c jumpxn.c locb.c \ @@\
- locf.c qnexte.c timest.c
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnxt/nxtgs/abend.c b/src/packlib/kernlib/kerngen/obsolete/kernnxt/nxtgs/abend.c
deleted file mode 100644
index a2fc438..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnxt/nxtgs/abend.c
+++ /dev/null
@@ -1,29 +0,0 @@
-/*
- * $Id: abend.c,v 1.1.1.1 1996/02/15 17:53:30 mclareni Exp $
- *
- * $Log: abend.c,v $
- * Revision 1.1.1.1 1996/02/15 17:53:30 mclareni
- * Kernlib
- *
- */
-#include "kernnxt/pilot.h"
-/*> ROUTINE ABEND
- CERN PROGLIB# Z035 ABEND .VERSION KERNNXT 1.00 901105
- */
-#if defined(CERNLIB_QX_SC)
-void abend_()
-#endif
-#if defined(CERNLIB_QXNO_SC)
-void abend()
-#endif
-#if defined(CERNLIB_QXCAPT)
-void ABEND()
-#endif
-{
- abort();
- return;
-}
-/*> END <----------------------------------------------------------*/
-#ifdef CERNLIB_TCGEN_ABEND
-#undef CERNLIB_TCGEN_ABEND
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnxt/nxtgs/datime.c b/src/packlib/kernlib/kerngen/obsolete/kernnxt/nxtgs/datime.c
deleted file mode 100644
index 749a983..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnxt/nxtgs/datime.c
+++ /dev/null
@@ -1,51 +0,0 @@
-/*
- * $Id: datime.c,v 1.1.1.1 1996/02/15 17:53:30 mclareni Exp $
- *
- * $Log: datime.c,v $
- * Revision 1.1.1.1 1996/02/15 17:53:30 mclareni
- * Kernlib
- *
- */
-#include "kernnxt/pilot.h"
-/*> ROUTINE DATIME
- CERN PROGLIB# Z007 DATIME .VERSION KERNNXT 1.00 901105
- */
-#include <sys/types.h>
-#include <time.h>
-
-struct tm *tp;
-#if defined(CERNLIB_QX_SC)
-#define slate slate_
-struct { int inum[39]; } slate_;
-void datime_(id, it)
-#endif
-#if defined(CERNLIB_QXNO_SC)
-struct { int inum[39]; } slate;
-void datime(id, it)
-#endif
-#if defined(CERNLIB_QXCAPT)
-#define slate SLATE
-struct { int inum[39]; } SLATE;
-void DATIME(id, it)
-#endif
-long *id, *it;
-{
- time_t tloc = time(0);
- tp = localtime(&tloc);
- slate_.inum[0] = tp->tm_year + 1900;
- slate_.inum[1] = tp->tm_mon + 1;
- slate_.inum[2] = tp->tm_mday;
- slate_.inum[3] = tp->tm_hour;
- slate_.inum[4] = tp->tm_min;
- slate_.inum[5] = tp->tm_sec;
- *id = tp->tm_year * 10000;
- *id += (tp->tm_mon + 1) * 100;
- *id += tp->tm_mday;
- *it = tp->tm_hour * 100;
- *it += tp->tm_min;
- return;
-}
-/*> END <----------------------------------------------------------*/
-#ifdef CERNLIB_TCGEN_DATIME
-#undef CERNLIB_TCGEN_DATIME
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnxt/nxtgs/datimh.c b/src/packlib/kernlib/kerngen/obsolete/kernnxt/nxtgs/datimh.c
deleted file mode 100644
index b1fa18f..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnxt/nxtgs/datimh.c
+++ /dev/null
@@ -1,51 +0,0 @@
-/*
- * $Id: datimh.c,v 1.1.1.1 1996/02/15 17:53:30 mclareni Exp $
- *
- * $Log: datimh.c,v $
- * Revision 1.1.1.1 1996/02/15 17:53:30 mclareni
- * Kernlib
- *
- */
-#include "kernnxt/pilot.h"
-/*> ROUTINE DATIMH
- CERN PROGLIB# Z007 DATIMH .VERSION KERNNXT 1.00 901105
- */
-#include <sys/types.h>
-#include <time.h>
-
-struct tm *tp;
-#if defined(CERNLIB_QX_SC)
-void datimh_(dh, th)
-#endif
-#if defined(CERNLIB_QXNO_SC)
-void datimh(dh, th)
-#endif
-#if defined(CERNLIB_QXCAPT)
-void DATIMH(dh, th)
-#endif
-char dh[7], th[7];
-{
- time_t tloc = time(0);
- tp = localtime(&tloc);
- dh[0] = tp->tm_mday / 10 + '0';
- dh[1] = tp->tm_mday % 10 + '0';
- dh[2] = '/';
- dh[3] = (tp->tm_mon + 1) / 10 + '0';
- dh[4] = (tp->tm_mon + 1) % 10 + '0';
- dh[5] = '/';
- dh[6] = tp->tm_year / 10 + '0';
- dh[7] = tp->tm_year % 10 + '0';
- th[0] = tp->tm_hour / 10 + '0';
- th[1] = tp->tm_hour % 10 + '0';
- th[2] = '.';
- th[3] = tp->tm_min / 10 + '0';
- th[4] = tp->tm_min % 10 + '0';
- th[5] = '.';
- th[6] = tp->tm_sec / 10 + '0';
- th[7] = tp->tm_sec % 10 + '0';
- return;
-}
-/*> END <----------------------------------------------------------*/
-#ifdef CERNLIB_TCGEN_DATIMH
-#undef CERNLIB_TCGEN_DATIMH
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnxt/nxtgs/getarg.c b/src/packlib/kernlib/kerngen/obsolete/kernnxt/nxtgs/getarg.c
deleted file mode 100644
index 6dfac0a..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnxt/nxtgs/getarg.c
+++ /dev/null
@@ -1,93 +0,0 @@
-/*
- * $Id: getarg.c,v 1.1.1.1 1996/02/15 17:53:30 mclareni Exp $
- *
- * $Log: getarg.c,v $
- * Revision 1.1.1.1 1996/02/15 17:53:30 mclareni
- * Kernlib
- *
- */
-#include "kernnxt/pilot.h"
-/*> ROUTINE GETARG
- CERN PROGLIB# GETARG .VERSION KERNNXT 1.00 901105
- ORIG. Written for NeXT OS 1.0 by Paul Kunz, SLAC, August 1990
- *
- * ==> iargc modified to give # arguments, not counting the 0'th. This
- * ==> is to be compatible with iargc on most other Unix machines.
- * ==> (F.Dittus, 92/09/22)
- *
- * getarg, iargc - return to Fortran a command line argument
- *
- * Usage:
- *
- * character*N c
- * integer i,j
- * integer function iargc
- *
- * call getarg(i,c)
- * j = iargc
- *
- * getarg returns the i-th command line argument of the current
- * process, filled with trailing blanks as needed.
- * The 0th command line argument is the full pathname of
- * the application's executable file.
- *
- * iargc returns the index of the last argument.
- *
- * restrictions:
- * It is up to the FORTRAN programmer to provide
- * a character array that is big enough.
- *
- * notes:
- * The 3rd + 4th dummy arguments are passed implicitly
- * by the Absoft compiler.
- */
-
-#if defined(CERNLIB_QX_SC)
-int iargc_()
-#endif
-#if defined(CERNLIB_QXNO_SC)
-int iargc()
-#endif
-#if defined(CERNLIB_QXCAPT)
-int IARGC()
-#endif
-{
- extern int NXArgc; /* argc saved in crt0 */
-
- return (NXArgc)-1;
-}
-
-#if defined(CERNLIB_QX_SC)
-int getarg_( iarg, carray, dummy, esize )
-#endif
-#if defined(CERNLIB_QXNO_SC)
-int getarg( iarg, carray, dummy, esize )
-#endif
-#if defined(CERNLIB_QXCAPT)
-int GETARG( iarg, carray, dummy, esize )
-#endif
-
-long *iarg; /* pointer to fortran integer*4 */
-char *carray; /* pointer to fortran character array */
-int dummy; /* dummy size for iarg */
-int esize; /* size of fortran character array */
-
-{
- extern int NXArgc; /* argc saved in crt0 */
- extern char **NXArgv; /* argv saved in crt0 */
- int i, j;
- char *c;
-
- i = *iarg;
- j = esize;
- if ( i >= 0 && i < NXArgc ) {
- c = NXArgv[i];
- while (*c) { /* copy characters until null */
- *carray++ = *c++;
- j--;
- }
- }
- for ( ; j > 0 ; j-- ) /* add any trailing blanks needed */
- *carray++ = ' ';
-}
-/*> END <----------------------------------------------------------*/
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnxt/nxtgs/intrac.c b/src/packlib/kernlib/kerngen/obsolete/kernnxt/nxtgs/intrac.c
deleted file mode 100644
index 36b248e..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnxt/nxtgs/intrac.c
+++ /dev/null
@@ -1,28 +0,0 @@
-/*
- * $Id: intrac.c,v 1.1.1.1 1996/02/15 17:53:30 mclareni Exp $
- *
- * $Log: intrac.c,v $
- * Revision 1.1.1.1 1996/02/15 17:53:30 mclareni
- * Kernlib
- *
- */
-#include "kernnxt/pilot.h"
-/*> ROUTINE INTRAC
- CERN PROGLIB# Z044 INTRAC .VERSION KERNNXT 1.00 901105
- */
-#if defined(CERNLIB_QX_SC)
-long intrac_()
-#endif
-#if defined(CERNLIB_QXNO_SC)
-long intrac()
-#endif
-#if defined(CERNLIB_QXCAPT)
-long INTRAC()
-#endif
-{
- return ((long) isatty(0));
-}
-/*> END <----------------------------------------------------------*/
-#ifdef CERNLIB_TCGEN_INTRAC
-#undef CERNLIB_TCGEN_INTRAC
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnxt/nxtgs/jumpxn.c b/src/packlib/kernlib/kerngen/obsolete/kernnxt/nxtgs/jumpxn.c
deleted file mode 100644
index 8d3a9fb..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnxt/nxtgs/jumpxn.c
+++ /dev/null
@@ -1,99 +0,0 @@
-/*
- * $Id: jumpxn.c,v 1.1.1.1 1996/02/15 17:53:30 mclareni Exp $
- *
- * $Log: jumpxn.c,v $
- * Revision 1.1.1.1 1996/02/15 17:53:30 mclareni
- * Kernlib
- *
- */
-#include "kernnxt/pilot.h"
-/*> ROUTINE JUMPXN
- CERN PROGLIB# Z042 JUMPXN .VERSION KERNNXT 1.00 901105
- ORIG. 21/04/88 JZ+FCA
-
- To transfer to the user routine TARGET (say) with 2 parameters
- three steps are needed :
-
- 1) EXTERNAL TARGET to get the address of TARGET
- IADR = JUMPAD (TARGET)
-
- 2) CALL JUMPST (IADR) to set the tranfer address
-
- 3) CALL JUMPX2 (par1,par2) to transfer
-*/
-static void (*tarsub)();
-/* ---- jumpst --------------------------------------------- */
-#if defined(CERNLIB_QX_SC)
-int jumpst_(iadr)
-#endif
-#if defined(CERNLIB_QXNO_SC)
-int jumpst(iadr)
-#endif
-#if defined(CERNLIB_QXCAPT)
-int JUMPST(iadr)
-#endif
-void (**iadr)();
-{
- tarsub = *iadr;
-}
-/* ---- jumpxn --------------------------------------------- */
-char *ipara, *iparb;
-#if defined(CERNLIB_QX_SC)
-int jumpx0_()
-#endif
-#if defined(CERNLIB_QXNO_SC)
-int jumpx0()
-#endif
-#if defined(CERNLIB_QXCAPT)
-int JUMPX0()
-#endif
-{
- (*tarsub)();
- return;
-}
-
-#if defined(CERNLIB_QX_SC)
-int jumpx1_(ipara)
-#endif
-#if defined(CERNLIB_QXNO_SC)
-int jumpx0(ipara)
-#endif
-#if defined(CERNLIB_QXCAPT)
-int JUMPX1(ipara)
-#endif
-{
- (*tarsub)(ipara);
- return;
-}
-
-#if defined(CERNLIB_QX_SC)
-int jumpx2_(ipara,iparb)
-#endif
-#if defined(CERNLIB_QXNO_SC)
-int jumpx@(ipara,iparb)
-#endif
-#if defined(CERNLIB_QXCAPT)
-int JUMPX2(ipara,iparb)
-#endif
-{
- (*tarsub)(ipara, iparb);
- return;
-}
-/* ---- jumpad --------------------------------------------- */
-#if defined(CERNLIB_QX_SC)
-void *jumpad_(ifun)
-#endif
-#if defined(CERNLIB_QXNO_SC)
-void *jumpad(ifun)
-#endif
-#if defined(CERNLIB_QXCAPT)
-void *JUMPAD(ifun)
-#endif
-char **ifun;
-{
- return *ifun;
-}
-/*> END <----------------------------------------------------------*/
-#ifdef CERNLIB_TCGEN_JUMPXN
-#undef CERNLIB_TCGEN_JUMPXN
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnxt/nxtgs/kerngt.F b/src/packlib/kernlib/kerngen/obsolete/kernnxt/nxtgs/kerngt.F
deleted file mode 100644
index 19364cd..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnxt/nxtgs/kerngt.F
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: kerngt.F,v 1.1.1.1 1996/02/15 17:53:30 mclareni Exp $
-*
-* $Log: kerngt.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:30 mclareni
-* Kernlib
-*
-*
-#include "kernnxt/pilot.h"
- SUBROUTINE KERNGT (LUN)
-C
-C CERN PROGLIB# Z001 KERNGT .VERSION KERNNXT 1.00 901105
-C ORIG. 16/03/89 JZ
-C
-C-- Store Pam title into /SLATE/ for printing by GSHOWF
-C
- COMMON /SLATE/ MCH(40)
-
- ENTRY GSHOW(LUN)
-
- CALL UBLOW (
- + 40H CPP_TITLE
- +, MCH,40)
- CALL GSHOWF (LUN)
- RETURN
- END
-#ifdef CERNLIB_TCGEN_KERNGT
-#undef CERNLIB_TCGEN_KERNGT
-#endif
-#ifdef CERNLIB_TCGEN_GSHOW
-#undef CERNLIB_TCGEN_GSHOW
-#endif
-#include "kernnxt/TITLE.kernnxt"
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnxt/nxtgs/locb.c b/src/packlib/kernlib/kerngen/obsolete/kernnxt/nxtgs/locb.c
deleted file mode 100644
index 664d099..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnxt/nxtgs/locb.c
+++ /dev/null
@@ -1,29 +0,0 @@
-/*
- * $Id: locb.c,v 1.1.1.1 1996/02/15 17:53:30 mclareni Exp $
- *
- * $Log: locb.c,v $
- * Revision 1.1.1.1 1996/02/15 17:53:30 mclareni
- * Kernlib
- *
- */
-#include "kernnxt/pilot.h"
-/*> ROUTINE LOCB
- CERN PROGLIB# N101 LOCB .VERSION KERNNXT 1.00 901105
- */
-#if defined(CERNLIB_QX_SC)
-long locb_(iadr)
-#endif
-#if defined(CERNLIB_QXNO_SC)
-long locb(iadr)
-#endif
-#if defined(CERNLIB_QXCAPT)
-long LOCB(iadr)
-#endif
-char *iadr;
-{
- return( (long) iadr );
-}
-/*> END <----------------------------------------------------------*/
-#ifdef CERNLIB_TCGEN_LOCB
-#undef CERNLIB_TCGEN_LOCB
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnxt/nxtgs/locf.c b/src/packlib/kernlib/kerngen/obsolete/kernnxt/nxtgs/locf.c
deleted file mode 100644
index 853b3d1..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnxt/nxtgs/locf.c
+++ /dev/null
@@ -1,31 +0,0 @@
-/*
- * $Id: locf.c,v 1.1.1.1 1996/02/15 17:53:31 mclareni Exp $
- *
- * $Log: locf.c,v $
- * Revision 1.1.1.1 1996/02/15 17:53:31 mclareni
- * Kernlib
- *
- */
-#include "kernnxt/pilot.h"
-/*> ROUTINE LOCF
- CERN PROGLIB# N100 LOCF .VERSION KERNNXT 1.00 901105
- */
-#if defined(CERNLIB_QX_SC)
-long locf_(iadr)
-#endif
-#if defined(CERNLIB_QXNO_SC)
-long locf(iadr)
-#endif
-#if defined(CERNLIB_QXCAPT)
-long LOCF(iadr)
-#endif
-#define NADUPW 4 /* Number of ADdress Units Per Word */
-#define LADUPW 2 /* Logarithm base 2 of ADdress Units Per Word */
-char *iadr;
-{
- return( (unsigned) iadr / NADUPW );
-}
-/*> END <----------------------------------------------------------*/
-#ifdef CERNLIB_TCGEN_LOCF
-#undef CERNLIB_TCGEN_LOCF
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnxt/nxtgs/qnexte.c b/src/packlib/kernlib/kerngen/obsolete/kernnxt/nxtgs/qnexte.c
deleted file mode 100644
index 52d51b8..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnxt/nxtgs/qnexte.c
+++ /dev/null
@@ -1,99 +0,0 @@
-/*
- * $Id: qnexte.c,v 1.1.1.1 1996/02/15 17:53:31 mclareni Exp $
- *
- * $Log: qnexte.c,v $
- * Revision 1.1.1.1 1996/02/15 17:53:31 mclareni
- * Kernlib
- *
- */
-#include "kernnxt/pilot.h"
-/*> ROUTINE QNEXTE
- CERN PROGLIB# Z041 QNEXTE .VERSION KERNNXT 1.00 901105
- */
-#include <setjmp.h>
-#if defined(CERNLIB_QX_SC)
-void qnext_();
-static void (* unext_)() = 0;
-static long init_ = 1;
-static jmp_buf env_;
-void qnset_(ufun_)
-void (* ufun_)();
-{
- unext_ = ufun_;
- init_ = 1;
- return;
-}
-#endif
-#if defined(CERNLIB_QXNO_SC)
-void qnext();
-static void (* unext)() = 0;
-static long init = 1;
-static jmp_buf env;
-void qnset(ufun)
-void (* ufun)();
-{
- unext = ufun;
- init = 1;
- return;
-}
-#endif
-#if defined(CERNLIB_QXCAPT)
-void QNEXT()
-static void (* UNEXT)() = 0;
-static long INIT = 1;
-static jmp_buf ENV;
-void QNSET(UFUN)
-void (* UFUN)();
-{
- UNEXT = UFUN;
- INIT = 1;
- return;
-}
-#endif
-
-#if defined(CERNLIB_QX_SC)
-void qnexte_()
-{
-if (init_)
-{
- if (unext_ == 0) unext_ = qnext_;
- init_ = 0;
- setjmp(env_);
- (* unext_)();
-}
-else
- longjmp(env_,1);
-}
-#endif
-#if defined(CERNLIB_QXNO_SC)
-void qnexte()
-{
-if (init)
-{
- if (unext == 0) unext = qnext;
- init = 0;
- setjmp(env);
- (* unext)();
-}
-else
- longjmp(env,1);
-}
-#endif
-#if defined(CERNLIB_QXCAPT)
-void QNEXTE()
-{
-if (INIT)
-{
- if (UNEXT == 0) UNEXT = QNEXT;
- INIT = 0;
- setjmp(ENV);
- (* UNEXT)();
-}
-else
- longjmp(ENV,1);
-}
-#endif
-/*> END <----------------------------------------------------------*/
-#ifdef CERNLIB_TCGEN_QNEXTE
-#undef CERNLIB_TCGEN_QNEXTE
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnxt/nxtgs/timest.c b/src/packlib/kernlib/kerngen/obsolete/kernnxt/nxtgs/timest.c
deleted file mode 100644
index 7ba0116..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnxt/nxtgs/timest.c
+++ /dev/null
@@ -1,162 +0,0 @@
-/*
- * $Id: timest.c,v 1.1.1.1 1996/02/15 17:53:31 mclareni Exp $
- *
- * $Log: timest.c,v $
- * Revision 1.1.1.1 1996/02/15 17:53:31 mclareni
- * Kernlib
- *
- */
-#include "kernnxt/pilot.h"
-/*> ROUTINE TIMEST
- CERN PROGLIB# Z007 TIMEST .VERSION KERNNXT 1.00 901105
- ORIG. 01/03/85 FCA
- */
-#include <sys/types.h>
-#include <sys/times.h>
-
-struct tms tps;
-static float timlim;
-static time_t timstart, timlast;
-static long init = 1;
-float deftim = 999999.; /* FHH + stime !*/
-float HZ = 60.;
-
-#if defined(CERNLIB_QX_SC)
-void timest_(timl)
-#endif
-#if defined(CERNLIB_QXNO_SC)
-void timest(timl)
-#endif
-#if defined(CERNLIB_QXCAPT)
-void TIMEST(timl)
-#endif
-float *timl;
-{
- if (init != 0) {
- times(&tps);
- timlim = *timl;
- timstart = tps.tms_utime+tps.tms_cutime+tps.tms_stime+tps.tms_cstime;
- timlast = timstart;
- init = 0;
- }
- return;
-}
-
-#if defined(CERNLIB_QX_SC)
-void timex_(tx)
-#endif
-#if defined(CERNLIB_QXNO_SC)
-void timex(tx)
-#endif
-#if defined(CERNLIB_QXCAPT)
-void TIMEX(tx)
-#endif
-/*
- CERN PROGLIB# Z007 TIMEX .VERSION KERNNXT 1.00 901105
- */
-float *tx;
-{
- time_t timnow;
- if (init) {
-#if defined(CERNLIB_QX_SC)
- timest_(&deftim);
-#endif
-#if defined(CERNLIB_QXNO_SC)
- timest(&deftim);
-#endif
-#if defined(CERNLIB_QXCAPT)
- TIMEST(&deftim);
-#endif
- *tx = 0.;
- }
- else {
- times(&tps);
- timnow = tps.tms_utime+tps.tms_cutime+tps.tms_stime+tps.tms_cstime;
- *tx = (float) (timnow - timstart) / HZ;
- }
- return;
-}
-
-#if defined(CERNLIB_QX_SC)
-void timed_(td)
-#endif
-#if defined(CERNLIB_QXNO_SC)
-void timed(td)
-#endif
-#if defined(CERNLIB_QXCAPT)
-void TIMED(td)
-#endif
-/*
- CERN PROGLIB# Z007 TIMED .VERSION KERNNXT 1.00 901105
- */
-float *td;
-{
- time_t timnow;
- if (init) {
-#if defined(CERNLIB_QX_SC)
- timest_(&deftim);
-#endif
-#if defined(CERNLIB_QXNO_SC)
- timest(&deftim);
-#endif
-#if defined(CERNLIB_QXCAPT)
- TIMEST(&deftim);
-#endif
- *td = deftim;
- }
- else {
- times(&tps);
- timnow = tps.tms_utime+tps.tms_cutime+tps.tms_stime+tps.tms_cstime;
- *td = (float) (timnow - timlast) / HZ;
- timlast = timnow;
- }
- return;
-}
-
-#if defined(CERNLIB_QX_SC)
-void timel_(tl)
-#endif
-#if defined(CERNLIB_QXNO_SC)
-void timel(tl)
-#endif
-#if defined(CERNLIB_QXCAPT)
-void TIMEL(tl)
-#endif
-/*
- CERN PROGLIB# Z007 TIMEL .VERSION KERNNXT 1.00 901105
- */
-float *tl;
-{
- time_t timnow;
- if (init) {
-#if defined(CERNLIB_QX_SC)
- timest_(&deftim);
-#endif
-#if defined(CERNLIB_QXNO_SC)
- timest(&deftim);
-#endif
-#if defined(CERNLIB_QXCAPT)
- TIMEST(&deftim);
-#endif
- *tl = deftim;
- }
- else {
- times(&tps);
- timnow = tps.tms_utime+tps.tms_cutime+tps.tms_stime+tps.tms_cstime;
- *tl = timlim - (float) (timnow - timstart) / HZ;
- }
- return;
-}
-/*> END <----------------------------------------------------------*/
-#ifdef CERNLIB_TCGEN_TIMEST
-#undef CERNLIB_TCGEN_TIMEST
-#endif
-#ifdef CERNLIB_TCGEN_TIMEX
-#undef CERNLIB_TCGEN_TIMEX
-#endif
-#ifdef CERNLIB_TCGEN_TIMED
-#undef CERNLIB_TCGEN_TIMED
-#endif
-#ifdef CERNLIB_TCGEN_TIMEL
-#undef CERNLIB_TCGEN_TIMEL
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernnxt/nxtgs/ublow.F b/src/packlib/kernlib/kerngen/obsolete/kernnxt/nxtgs/ublow.F
deleted file mode 100644
index 8325b0b..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernnxt/nxtgs/ublow.F
+++ /dev/null
@@ -1,58 +0,0 @@
-*
-* $Id: ublow.F,v 1.1.1.1 1996/02/15 17:53:31 mclareni Exp $
-*
-* $Log: ublow.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:31 mclareni
-* Kernlib
-*
-*
-#include "kernnxt/pilot.h"
- SUBROUTINE UBLOW (MS,MT,NCHP)
-C
-C CERN PROGLIB# M409 UBLOW .VERSION KERNNXT 1.00 901105
-C ORIG. 05/12/89, FCA+JZ
-C
-
- DIMENSION MS(99), MT(99), NCHP(9)
-C- - PARAMETER (IALLBL = X'20202020')
- PARAMETER (IALLBL = 538976288 )
-C- - PARAMETER (MASK1 = X'FF000000')
- PARAMETER (MASK1 = -16777216 )
-C - PARAMETER (IBLAN1 = ISHFT (IALLBL,-8))
- PARAMETER (IBLAN1 = 2105376 )
-
-
- NCH = NCHP(1)
- IF (NCH) 91, 29, 11
- 11 NWS = ISHFT (NCH,-2)
- NTRAIL = IAND (NCH,3)
- JT = 0
- IF (NWS.EQ.0) GO TO 26
-
-C-- Unpack the initial complete words
-
- DO 24 JS=1,NWS
- MWD = MS(JS)
- MT(JT+1) = IOR (IBLAN1,IAND(MASK1,MWD))
- MT(JT+2) = IOR (IBLAN1,IAND(MASK1,ISHFT(MWD, 8)))
- MT(JT+3) = IOR (IBLAN1,IAND(MASK1,ISHFT(MWD,16)))
- MT(JT+4) = IOR (IBLAN1, ISHFT(MWD,24) )
- 24 JT = JT + 4
-
- IF (NTRAIL.EQ.0) RETURN
-
-C-- Unpack the trailing word
-
- 26 MWD = MS(NWS+1)
-
- DO 28 JS=1,NTRAIL
- MT(JT+1) = IOR (IBLAN1,IAND(MASK1,MWD))
- MWD = ISHFT (MWD,8)
- 28 JT = JT + 1
- 29 RETURN
-
- 91 CALL ABEND
- END
-#ifdef CERNLIB_TCGEN_UBLOW
-#undef CERNLIB_TCGEN_UBLOW
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernpdp/_gpdp10/pilot.h b/src/packlib/kernlib/kerngen/obsolete/kernpdp/_gpdp10/pilot.h
deleted file mode 100644
index 913e3f5..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernpdp/_gpdp10/pilot.h
+++ /dev/null
@@ -1,6 +0,0 @@
-#if 0
-* This pilot patch was created from kernpdp.car patch _gpdp10
-#endif
-#ifndef CERNLIB__KPDP10
-#define CERNLIB__KPDP10
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernpdp/_kpdp10/pilot.h b/src/packlib/kernlib/kerngen/obsolete/kernpdp/_kpdp10/pilot.h
deleted file mode 100644
index d00768d..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernpdp/_kpdp10/pilot.h
+++ /dev/null
@@ -1,18 +0,0 @@
-#if 0
-* This pilot patch was created from kernpdp.car patch _kpdp10
-#endif
-#ifndef CERNLIB_HELP
-#define CERNLIB_HELP
-#endif
-#ifndef CERNLIB_PDP10MLN
-#define CERNLIB_PDP10MLN
-#endif
-#ifndef CERNLIB_PDP10MLR
-#define CERNLIB_PDP10MLR
-#endif
-#ifndef CERNLIB_TCGEN
-#define CERNLIB_TCGEN
-#endif
-#ifndef CERNLIB_XVECT
-#define CERNLIB_XVECT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernpdp/help/comment.inc b/src/packlib/kernlib/kerngen/obsolete/kernpdp/help/comment.inc
deleted file mode 100644
index e3384fe..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernpdp/help/comment.inc
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: comment.inc,v 1.1.1.1 1996/02/15 17:53:33 mclareni Exp $
-*
-* $Log: comment.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:53:33 mclareni
-* Kernlib
-*
-*
-*
-* comment.inc
-*
-
-
-C-- THIS PATCH CONTAINS THE DEFINITION OF MACROS
-C-- HELLO, CALL, ENTER, GOODBY
-C-- USED IN ALL THE PDP10 ASSEMBLER ROUTINES IN
-C-- PATCHES PDP10MLR AND PDP10MLN.
-
-
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernpdp/help/help.s b/src/packlib/kernlib/kerngen/obsolete/kernpdp/help/help.s
deleted file mode 100644
index b3bda39..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernpdp/help/help.s
+++ /dev/null
@@ -1,46 +0,0 @@
-*
-* $Id: help.s,v 1.1.1.1 1996/02/15 17:53:33 mclareni Exp $
-*
-* $Log: help.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:33 mclareni
-* Kernlib
-*
-*
- UNIVERSAL HELP
- PASS2
- DEFINE HELLO(NAME,NAME1,NAME2)<
- ENTRY NAME
- IFNB <NAME1>,<ENTRY NAME1>
- IFNB <NAME2>,<ENTRY NAME2>
- SIXBIT/NAME/
-IFNB <NAME1>, <NAME1::>
-IFNB <NAME2>, <NAME2::>
-NAME::
-> ;END OF HELLO MACRO
- DEFINE CALL(NAME)<
- PUSHJ 17,NAME
-> ;END OF CALL MACRO
- DEFINE ENTER(NAME,ARGBLK)<
- PUSH 17,16
- IFB <ARGBLK>,< MOVEI 16,.+3>
- IFNB <ARGBLK>,< MOVEI 16,ARGBLK>
- PUSHJ 17,NAME
- POP 17,16
-> ; END OF ENTER MACRO
- DEFINE GOODBY<
- POPJ 17,>
- DEFINE SAVACS(NUM)<
- ZZ=2
- REPEAT NUM-1,<
- PUSH 17,ZZ
- ZZ=ZZ+1
->
->
- DEFINE RESTOR(NUM)<
- ZZ=2
- REPEAT NUM-1,<
- POP 17,ZZ
- ZZ=ZZ+1
->
->
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernpdp/history/gpdpup1.dat b/src/packlib/kernlib/kerngen/obsolete/kernpdp/history/gpdpup1.dat
deleted file mode 100644
index 680290c..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernpdp/history/gpdpup1.dat
+++ /dev/null
@@ -1,43 +0,0 @@
-*
-* $Id: gpdpup1.dat,v 1.1.1.1 1996/02/15 17:53:32 mclareni Exp $
-*
-* $Log: gpdpup1.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:53:32 mclareni
-* Kernlib
-*
-*
-#if !defined(CERNLIB_KERNPDP)
-
- UP-DATE RECORD FOR GENPDP VERSIONS 1.01 TO 1.99
- -----------------------------------------------
-
-
-C. 1.01 MAR 76 UBUNCH: BUG + SPEED
-
-C. 1.02 OCT 76 IUHUNT: BUG, UBLOW: SPEED
- DATIME,DATIMH,TIMED,TIMEL,TIMEX NEW ROUT.
-
-C. 1.03 OCT 76 DELETES MOVED FROM PILOTES TO DECKS.
-
-C. 1.04 NOV 76 DELETE-LOGIC FINALIZED.
-
-C. 1.05 OCT 77 VFIX : BUG CORRECTED
- TIMEX : COMMENT ADDED
- DELETED : DATEZB, IDATZA, TIMEZB
- USE INSTEAD DATIM... , TIME...
-
-C. 1.06 OCT 82 CLEAN-UP FOR PATCHY4 STANDARD
-
-C. 1.07 MAR 84 NEW DECKS : GSHOW, IBMTP, IBMTP2
- NEW PATCH : PDP10OBS FOR OBSOLETE ROUTINES
- D=LORENC,MXADD,MXDMA,MXDMAL,VMODUL
- DELETE P=PDP10F40
- CORRECT : P=HELP, D=HELP.
-
----------------------------------------------------------------------
-
- KERNPDP 2.01 = GENPDP 1.07
-
----------------------------------------------------------------------
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernpdp/history/history.dat b/src/packlib/kernlib/kerngen/obsolete/kernpdp/history/history.dat
deleted file mode 100644
index f75bf57..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernpdp/history/history.dat
+++ /dev/null
@@ -1,102 +0,0 @@
-*
-* $Id: history.dat,v 1.1.1.1 1996/02/15 17:53:32 mclareni Exp $
-*
-* $Log: history.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:53:32 mclareni
-* Kernlib
-*
-*
-* This directory was created from kernpdp.car patch kernpdp
-#if !defined(CERNLIB_KERNPDP)
-
-ROUTINES OF THE GENERAL SECTION PARTICULAR TO THE DEC PDP
-
-
----------------------------------------------------------------------
-FIRST RELEASE OF THE GENPDP MINI-PAM : 1-NOV-76
----------------------------------------------------------------------
-
-THIS FILE CONTAINS THE FOLLOWING PATCHES :
-
-*KPDP10 PILOT-PATCH SELECTING THE FULL STANDARD GENERAL SECTION
-
-REENTR OPTION PATCH TO SELECT RE-ENTRANCE
-
-UUOTAPOP OPTION PATCH TO SELECT INSTALLATION FOR A SYSTEM
- WHICH PROVIDES THE NEW UUO 'TAPOP' (SEE D=TAPOP, QPDP9T)
-
-HELP UNIVERSAL MACRO DEFINITIONS
-
-PDP10MLN ML VERSIONS OF GENSEC ROUTINES IN NON-REENTRANT FORM
-
-PDP10MLR ML VERSIONS OF GENSEC ROUTINES IN REENTRANT FORM
-
-PDP10OBS OBSOLETE GENSEC ROUTINES
-
-=====================================================================
-
-USAGE :
-
- THE FORTRAN AND THE ASSEMBLER ROUTINES HAVE TO BE COMPILED
- SEPARATELY, THEY MUST BE ON TWO SEPARATE PATCHY OUTPUT FILES.
- FOR THE ASSEMBLER ONE NEEDS IN ADDITION A THIRD FILE WHICH
- CONTAINS THE DEFINITION OF SOME MACRO INSTRUCTIONS.
-
- WITH PATCHY THESE THREE FILES CAN BE CREATED IN ONE GO WITH
- THE FOLLOWING CRADLE
-
- +EXE.
- +USE, REENTR. IF AND ONLY IF RE-ENTRANCE
- +USE, UUOTAPOP. IF AND ONLY IF THE 'TAPOP' UUO
- +USE, *KPDP10.
- +ASM, 22. FILE FOR ASSEMBLER
- +ASM, 32. FILE FOR DIVERTED ASSEMBLER
- +DIVERT, HELP. DIVERT MACRO DEFINITIONS
- +PAM. READ CONCATENATED KERNPDP + KERNFOR
-
-
- IF YOU WANT TO MAKE A REENTRANT LIBRARY YOU MUST GIVE UP
- SOME ASSEMBLER ROUTINES WHICH EXIST ONLY IN NON-REENTRANT FORM
- AND TAKE THEIR FORTRAN VERSION INSTEAD.
- THIS IS TRIGGERED BY +USE, REENTR.
-
- SETTING INDUSTRY COMPATIBLE-MODE IS SOMEWHAT OF A MESS.
- TWO ALTERNATIVE ROUTINES ARE PROVIDED IN D=TAPOP, QPDP9T
- NEAR THE BEGINNING OF P=PDP10MLN, YOU BETTER LOOK AT THEM.
- TAPOP USES THE NEW UUO 'TAPOP', QPDP9T NEEDS SITE-DEPENDENT
- PARAMETERS.
-
- THIS GENERAL SECTION WAS USED ON CERN ERASME PDP10.
- CARE HAS BEEN TAKEN THAT IT DOES NOT CONTAIN KI10 CODE.
-
-
-=====================================================================
-
-UPDATE 2.01 : 22-MAR-84
--------------------------
-
-REPLACING FILE GENPDP 1.07 840321 19.16
-
-NEW DECKS : P=PDP10MLN, D=QPDP9T (COPIED FROM HYDRA)
-
----------------------------------------------------------------------
-
-UPDATE 2.02 : 27-MAR-84
--------------------------
-
-REPLACING FILE KERNPDP 2.01 840322 18.51
-
-CORRECTIONS : P=PDP10MLN, D=IBMTP,QPDP9T TO BE COMPATIBLE
-
----------------------------------------------------------------------
-
-UPDATE 2.03 : 28-NOV-84
--------------------------
-
-REPLACING FILE KERNPDP 2.02 840327 16.04
-
-NEW DECKS : P=PDP10MLN, D=UCTOH1, UCTOH, UH1TOC, UHTOC
-
----------------------------------------------------------------------
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernpdp/inhibit.list b/src/packlib/kernlib/kerngen/obsolete/kernpdp/inhibit.list
deleted file mode 100644
index 0d39347..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernpdp/inhibit.list
+++ /dev/null
@@ -1,103 +0,0 @@
-pdp10mln
-tcgen/gshow
-tcgen/amaxmu
-tcgen/iufind
-tcgen/iuback
-tcgen/iuforw
-tcgen/iuhunt
-tcgen/iulast
-tcgen/iulook
-tcgen/iunext
-tcgen/iusame
-tcgen/lvmax
-tcgen/lvmaxa
-tcgen/lvmin
-tcgen/lvmina
-tcgen/mxmlrt
-tcgen/mxuty
-tcgen/mxtrp
-tcgen/ucopiv
-tcgen/ucopyn
-tcgen/uctoh1
-tcgen/uctoh
-tcgen/udicop
-tcgen/ufill
-tcgen/uh1toc
-tcgen/uhtoc
-tcgen/uleft
-tcgen/uright
-tcgen/uset
-tcgen/uswop
-tcgen/vadd
-tcgen/vasum
-tcgen/vbias
-tcgen/vdot
-tcgen/vdotn
-tcgen/vdotn2
-tcgen/vexcum
-tcgen/vline
-tcgen/vmatl
-tcgen/vmatr
-tcgen/vmax
-tcgen/vmaxa
-tcgen/vmin
-tcgen/vmina
-tcgen/vmod
-tcgen/vmul
-tcgen/vscale
-tcgen/vsub
-tcgen/vsum
-tcgen/vunit
-tcgen/cbyt
-tcgen/jbytet
-tcgen/sbytor
-tcgen/jrsbyt
-tcgen/locbyt
-tcgen/jbytpk
-tcgen/sbytpk
-tcgen/cross
-tcgen/datime
-tcgen/datimh
-tcgen/erf
-tcgen/incbyt
-tcgen/iubin
-tcgen/iuhist
-tcgen/iuchan
-tcgen/iucomp
-tcgen/iuend
-tcgen/jbit
-tcgen/jbyt
-tcgen/locf
-tcgen/mxequ
-#if defined(CERNLIB_MXFLAG3)
-tcgen/mxmad
-#endif
-tcgen/pkchar
-tcgen/proxim
-tcgen/rot
-tcgen/sbit
-tcgen/sbit0
-tcgen/sbit1
-tcgen/sbyt
-tcgen/timed
-tcgen/timel
-tcgen/timex
-tcgen/ublank
-tcgen/ublow
-tcgen/ubunch
-tcgen/ucocop
-tcgen/ucopy
-tcgen/ucopy2
-tcgen/upkch
-tcgen/uzero
-tcgen/vblank
-tcgen/vfill
-tcgen/vfix
-tcgen/vzero
-tcgenr/lorenc
-tcgenr/loren4
-tcgenr/lotran
-tcgenr/mxadd
-tcgenr/mxdma
-tcgenr/mxdmal
-tcgenr/vmodul
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernpdp/kernpdp/reentr.h b/src/packlib/kernlib/kerngen/obsolete/kernpdp/kernpdp/reentr.h
deleted file mode 100644
index 58eb6bf..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernpdp/kernpdp/reentr.h
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: reentr.h,v 1.1.1.1 1996/02/15 17:53:32 mclareni Exp $
-*
-* $Log: reentr.h,v $
-* Revision 1.1.1.1 1996/02/15 17:53:32 mclareni
-* Kernlib
-*
-*
-* This directory was created from kernpdp.car patch reentr
-#ifdef CERNLIB_PDP10MLN
-#undef CERNLIB_PDP10MLN
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/amaxmu.s b/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/amaxmu.s
deleted file mode 100644
index 86e4f8d..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/amaxmu.s
+++ /dev/null
@@ -1,56 +0,0 @@
-*
-* $Id: amaxmu.s,v 1.1.1.1 1996/02/15 17:53:34 mclareni Exp $
-*
-* $Log: amaxmu.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:34 mclareni
-* Kernlib
-*
-*
- TITLE AMAXMU
-;#
-; CERN PROGLIB# E103 AMAXMU .VERSION KERNPDP 1.00 750903
-; ORIG. P. SCHMITZ, AACHEN, 3/9/1975
-;#
- SEARCH HELP
- HELLO (AMAXMU)
- HRRZI ,ACSAVE ;SAVE AC'S
- BLT ,ACSAVE+LOOPX
- MOVEI , at 0(A16) ;ADR(A)
- HRRM ,LOOPB+2
- SKIPG A01, at 1(A16) ;LOAD IDO
- JRST ,LOOPE
- SKIPG A02, at 2(A16) ;LOAD IW
- JRST ,LOOPE
- HRRM A02,LOOPB+10
- MOVE , at 3(A16) ;INSERT NA
- HRRM ,LOOPB+7
- MOVE ,[XWD LOOPB+1,LOOP] ;MOVE LOOP DOWN INTO FAST AC'S
- BLT ,LOOPX
- SETZB ,A05 ;AM=0. II=1
-LOOPB: JRST ,LOOP
- PHASE 6
-LOOP: MOVEM A05,A04 ; DO 19 JN=1,IDO
-LOOP1: MOVM A03,(A04)
- CAMG ,A03 ; DO 17 JK=1,IW
- MOVE ,A03 ; AM = AMAX1(AM,ABS(A(I)))
- AOS ,A04 ;17 I = I+1
- SOJG A02,LOOP1
- ADDI A05,
- MOVEI A02, ;19 II = II+NA
- SOJG A01,LOOP
-LOOPX: JRST ,LOOPE
- DEPHASE
-LOOPE: MOVE LOOPX,[XWD ACSAVE+1,1] ;RESTORE AC'S, EXIT
- BLT LOOPX,LOOPX
- GOODBY
-ACSAVE:BLOCK LOOPX+1
- A01= 1
- A02= 2
- A03= 3
- A04= 4
- A05= 5
- A16=16
- PRGEND
-#ifdef CERNLIB_TCGEN_AMAXMU
-#undef CERNLIB_TCGEN_AMAXMU
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/comment.inc b/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/comment.inc
deleted file mode 100644
index 26baa94..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/comment.inc
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: comment.inc,v 1.1.1.1 1996/02/15 17:53:33 mclareni Exp $
-*
-* $Log: comment.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:53:33 mclareni
-* Kernlib
-*
-*
-*
-* comment.inc
-*
-
-
-C-- THIS PATCH CONTAINS THE ASSEMBLER ROUTINES
-C-- WHICH HAVE BEEN CODED IN NON-REENTRANT FORM.
-
-
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/gshow.F b/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/gshow.F
deleted file mode 100644
index d6375e5..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/gshow.F
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: gshow.F,v 1.1.1.1 1996/02/15 17:53:34 mclareni Exp $
-*
-* $Log: gshow.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:34 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE GSHOW (LUN)
-
-C CERN PROGLIB# GSHOW .VERSION KERNPDP 1.07 840321
-
-C-- STORE PAM TITLE INTO /SLATE/ FOR PRINTING BY GSHOWF
-
- COMMON /SLATE/ CH(40)
-
- CALL UBLOW (
- + 40H CPP_TITLE
- +, CH, 40)
-
- CALL GSHOWF (LUN)
- RETURN
- END
-#ifdef CERNLIB_TCGEN_GSHOW
-#undef CERNLIB_TCGEN_GSHOW
-#endif
-#include "TITLE.kernpdp"
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/ibmtp.s b/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/ibmtp.s
deleted file mode 100644
index b4bc223..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/ibmtp.s
+++ /dev/null
@@ -1,97 +0,0 @@
-*
-* $Id: ibmtp.s,v 1.1.1.1 1996/02/15 17:53:34 mclareni Exp $
-*
-* $Log: ibmtp.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:34 mclareni
-* Kernlib
-*
-*
-#if defined(CERNLIB_UUOTAPOP)
- TITLE IBMTP
-;#
-; CERN PROGLIB# IBMTP .VERSION KERNPDP 2.02 840327
-; ORIG. B. KAHLHOFF, RZ UNI KIEL, MAERZ 84
-;#
-; ISTAT = IBMTP (UNIT) SETS INDUSTRY COMPATIBLE MODE FOR UNIT
-; RETURNS ISTAT=0 IF ALL IS WELL
-; UNIT = LOGICAL DEVICE NUMBER
-
- P==17
-
- ENTRY IBMTP
- ENTRY QPDP9T
-
-QPDP9T:
-IBMTP:
- MOVE 0, at 0(16) ;GET ARG
- MOVEM 0,UNIT
- PUSH P,16 ;SAVE AC 16
- MOVEI 16,ARGLST
- PUSHJ P,TAPOP##
- POP P,16 ;RESTORE AC 16
- POPJ P, ;RETURN TO CALLER
-
- -3,,0
-ARGLST: UNIT
- FCODE
- FARG
-
-UNIT: 0
-FCODE: 2007
-FARG: 2
- PRGEND
- TITLE TAPOP
-;#
-; CERN PROGLIB# TAPOP .VERSION KERNPDP 1.07 840321
-; ORIG. B. KAHLHOFF, RZ UNI KIEL, MAERZ 84
-;#
- ;INTEGER FUNCTION TAPOP(UNIT,FCODE,ARG)
- ;INTEGER UNIT,FCODE,ARG
-
- ;UNIT = LOGICAL DEVICE NUMBER
- ;FCODE = FUNCTION CODE
- ;ARG = ARGUMENT TO TAPOP.
-
- ;RETURN 0 IF O.K.
- ; TAPOP-BITS ON ERRORS
-
- P==17
-
- ENTRY TAPOP
-
-TAPOP:MOVE 0, at 0(16) ;GET LOGICAL DEVICE NUMBER
- JUMPLE 0,ERROR
- PUSH P,2 ;SAVE AC 2
- SETZ 2, ;CLEAR AC 2
-L1: IDIVI 0,12 ;/10
- ADDI 1,20 ;CONVERT TO SIXBIT
- ROTC 1,-6 ;SHIFT INTO AC2
- JUMPN 0,L1
- MOVEM 2,ARGLST+1
- MOVE 1,2 ;GET LOGICAL DEVICE NAME IN SIXBIT
- POP P,2 ;RESTORE AC2
- SETZ 0, ;CLEAR AC 0
- DEVNAM 1, ;GET PHYSICAL DEVICE NAME
- JRST ERROR ;ERROR RETURN
- HLLZ 1,1 ;GET GENERIC PART
- CAME 1,[SIXBIT /MTA/]
- JRST EXIT ;TAPOP CALL IS DUMMY IF DEVICE IS NOT MTA
- MOVE 1, at 1(16) ;GET PARAMETER FCODE
- MOVEM 1,ARGLST
- MOVE 1, at 2(16) ;GET PARAMETER ARG
- MOVEM 1,ARGLST+2
- MOVE 1,[XWD 3,ARGLST]
- TAPOP. 1,
- MOVE 0,1 ;ERROR RETURN
-EXIT: POPJ P,
-
-ERROR:SETO 0,
- JRST EXIT
-
-ARGLST: 0 ;FUNCTION CODE
- 0 ;SIXBIT DEVICE
- 0 ;ARGUMENT
-
-; ------------ ALTERNATIVE ROUTINE IBMTP BELOW ----------------
- PRGEND
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/iufind.s b/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/iufind.s
deleted file mode 100644
index 08a67a1..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/iufind.s
+++ /dev/null
@@ -1,39 +0,0 @@
-*
-* $Id: iufind.s,v 1.1.1.1 1996/02/15 17:53:34 mclareni Exp $
-*
-* $Log: iufind.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:34 mclareni
-* Kernlib
-*
-*
- TITLE IUFIND
-;#
-; CERN PROGLIB# V304 IUFIND .VERSION KERNPDP 1.00 750903
-; ORIG. P. SCHMITZ, AACHEN, 3/9/1975
-;#
- SEARCH HELP
- HELLO (IUFIND)
- MOVEM A01,AC01
- MOVEI , at 1(A16)
- SOS
- HRRM ,LOOP
- MOVE A01, at 2(A16)
-LOOP: MOVE ,(A01)
- CAMN , at 0(A16)
- JRST ,P24
- CAMGE A01, at 3(A16)
- AOJA A01,LOOP
- MOVE , at 3(A16)
- AOS
- MOVE A01,AC01
- GOODBY
-P24: MOVE ,A01
- MOVE A01,AC01
- GOODBY
-AC01: 0
- A01= 1
- A16=16
- PRGEND
-#ifdef CERNLIB_TCGEN_IUFIND
-#undef CERNLIB_TCGEN_IUFIND
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/iuforw.s b/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/iuforw.s
deleted file mode 100644
index f4563f3..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/iuforw.s
+++ /dev/null
@@ -1,105 +0,0 @@
-*
-* $Id: iuforw.s,v 1.1.1.1 1996/02/15 17:53:35 mclareni Exp $
-*
-* $Log: iuforw.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:35 mclareni
-* Kernlib
-*
-*
- TITLE IUFORW
-;#
-; CERN PROGLIB# M410 IUFORW .VERSION KERNPDP 1.00 750903
-;#
-.COMMON SLATE [50]
- SEARCH HELP
- HELLO (IUFORW)
- SETOM ,WAY
- JSR ,ARG1
- JUMPG A01,EXIT ;JL MUST BE .LE. JR
-GOON: MOVE ,[XWD LOOPB+1,LOOP]
- BLT ,LOOPX
- SETZM ;IUFORW = 0
- SETZM ,DIGCNT ;ND = 0
-LOOPB: JRST ,LOOP ;GO ON
- PHASE 3
-LOOP: MOVE A02,(A01) ;THIS LOOP CONVERTS CHARACTERS
- JUMPG A01,END ;IN A1-FORMAT TO 1 WORD CON -
- TLNN A02,574000 ;TAINING AN UNSIGNED INTEGER
- AOJA A01,LOOP ;BLANKS ARE IGNORED
- LSH A02,-35
- SUBI A02,60
- JUMPL A02,END
- CAILE A02,11
- JRST ,END
- IMULI ,12
- ADD ,A02
- AOS ,DIGCNT
-LOOPX: AOJA A01,LOOP
- DEPHASE
-EXIT: SETZM ,DIGCNT ;ERROR EXIT
- SETZM
-END: MOVEI A03,SLATE ;NORMAL END
- MOVE A16,ACSAVE+16 ;SET JEND AND ND FOR IUEND
- ADD A01, at 2(A16)
- MOVE A02,STOPNT
- ADD A02, at 1(A16)
- SKIPN ,WAY
- MOVEM A02,A01
- MOVEM A01,1(A03)
- MOVE A01,DIGCNT
- MOVEM A01,SLATE
- MOVE LOOPX,[XWD ACSAVE+1,1] ;RESTORE AC'S, EXIT
- BLT LOOPX,LOOPX
- GOODBY
- HELLO (IUBACK)
- SETZM ,WAY
- JSR ,ARG1
- MOVNM A01,STOPNT
- MOVNM A01,ACSAVE
- JUMPG A01,EXIT ;JL MUST BE .LE. JR
- ADD ,A01
- HRRM ,SEARCB+1 ;INSERT ADR (IC)
- MOVN A01,A01
- MOVE ,[XWD SEARCB+1,SEARCH]
- BLT ,SEARCX ;MOVE LOOP DOWN INTO FAST AC'S
-SEARCB:JRST ,SEARCH ;GO ON
- PHASE 3
-SEARCH:MOVE A02,(A01) ;THIS LOOP SEARCHES THE FIRST
- JUMPL A01,SA ;ASCII-CODED INTEGER IN ARRAY IC
- TLNN A02,574000 ;BLANKS ARE IGNORED
- SOJA A01,SEARCH
- LSH A02,-35
- SUBI A02,60
- JUMPL A02,SA
- CAIG A02,11
- SOJA A01,SEARCH
-SA: MOVEM A01,STOPNT
- SUB A01,ACSAVE
-SEARCX:AOJA A01,GOON
- DEPHASE
-ARG1: 0
- HRRZI ,ACSAVE ;SAVE AC'S
- BLT ,ACSAVE+LOOPX
- MOVEI , at 0(A16)
- MOVE A01, at 2(A16) ;INSERT ADR (IC)
- ADD ,A01
- SOS
- HRRM ,LOOPB+1
- SUB A01, at 1(A16) ;CALCULATE WORD COUNT
- MOVN A01,A01
- JRST 2, at ARG1
-WAY: 0
-STOPNT:0
-DIGCNT:0
-ACSAVE:BLOCK LOOPX+1
- A01= 1
- A02= 2
- A03= 3
- A16=16
- PRGEND
-#ifdef CERNLIB_TCGEN_IUBACK
-#undef CERNLIB_TCGEN_IUBACK
-#endif
-#ifdef CERNLIB_TCGEN_IUFORW
-#undef CERNLIB_TCGEN_IUFORW
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/iuhunt.s b/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/iuhunt.s
deleted file mode 100644
index 2bf0c62..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/iuhunt.s
+++ /dev/null
@@ -1,40 +0,0 @@
-*
-* $Id: iuhunt.s,v 1.1.1.1 1996/02/15 17:53:36 mclareni Exp $
-*
-* $Log: iuhunt.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:36 mclareni
-* Kernlib
-*
-*
- TITLE IUHUNT
-;#
-; CERN PROGLIB# V304 IUHUNT .VERSION KERNPDP 1.02 761001
-; ORIG. P. SCHMITZ, AACHEN, 3/9/1975
-;#
- SEARCH HELP
- HELLO (IUHUNT)
- SKIPG A01, at 2(A16)
- JRST ,EXIT
- MOVEI 1,1
- MOVEI , at 1(A16)
- SOS
- HRRM ,LOOP
-LOOP: MOVE ,(A01)
- CAMN , at 0(A16)
- JRST ,P21
- CAML A01, at 2(A16)
- JRST ,EXIT
- ADD A01, at 3(A16)
- JRST ,LOOP
-EXIT: MOVE A01,AC01
- SETZM
- GOODBY
-P21: MOVEM A01,
- GOODBY
-AC01: 0
- A01= 1
- A16=16
- PRGEND
-#ifdef CERNLIB_TCGEN_IUHUNT
-#undef CERNLIB_TCGEN_IUHUNT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/iulast.s b/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/iulast.s
deleted file mode 100644
index e76482f..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/iulast.s
+++ /dev/null
@@ -1,38 +0,0 @@
-*
-* $Id: iulast.s,v 1.1.1.1 1996/02/15 17:53:36 mclareni Exp $
-*
-* $Log: iulast.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:36 mclareni
-* Kernlib
-*
-*
- TITLE IULAST
-;#
-; CERN PROGLIB# V305 IULAST .VERSION KERNPDP 1.00 750903
-; ORIG. P. SCHMITZ, AACHEN, 3/9/1975
-;#
- SEARCH HELP
- HELLO (IULAST)
- MOVEM A01,AC01 ;SAVE AC 1
- MOVEI , at 1(A16) ;INSERT ADR (IC)
- HRRM ,LOOP
- MOVE A01, at 2(A16) ;FETCH WORD COUNT N
- SOSGE ,A01 ;SKIP IF N .GT. 0
- JRST ,KO
-LOOP: MOVE ,(A01) ;COMPARE IC WITH ISTUFF
- CAMN , at 0(A16)
- SOJGE A01,LOOP
- AOS ,A01 ;ADD 1 TO GET FORTRAN WORD COUNT
- MOVE ,A01 ;IULAST = J
- MOVE A01,AC01 ;RESTORE AC 1, EXIT
- GOODBY
-KO: SETZM ;ERROR EXIT
- MOVE A01,AC01
- GOODBY
- A01= 1
- A16=16
-AC01: 0
- PRGEND
-#ifdef CERNLIB_TCGEN_IULAST
-#undef CERNLIB_TCGEN_IULAST
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/iulook.s b/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/iulook.s
deleted file mode 100644
index 8e92fb9..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/iulook.s
+++ /dev/null
@@ -1,57 +0,0 @@
-*
-* $Id: iulook.s,v 1.1.1.1 1996/02/15 17:53:36 mclareni Exp $
-*
-* $Log: iulook.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:36 mclareni
-* Kernlib
-*
-*
- TITLE IULOOK
-;#
-; CERN PROGLIB# M410 IULOOK .VERSION KERNPDP 1.00 750903
-; ORIG. P. SCHMITZ, AACHEN, 3/9/1975
-;#
- SEARCH HELP
- HELLO (IULOOK)
- HRRZI ,ACSAVE ;SAVE AC'S
- BLT ,ACSAVE+LOOPX
- MOVE A01, at 2(A16) ;JL
- MOVE A02, at 3(A16) ;JR
- MOVE A03, at 0(A16) ;NCHAR
- CAILE A03,5 ;NCHAR MUST BE .LE. 5
- MOVEI A03,5
- MOVEI , at 1(A16) ;ADR (IC)
- SOS
- HRRM ,LOOPB+1
- MOVE A04,[POINT 7,0,] ;POINTS TO IULOOK
- MOVE ,[XWD LOOPB+1,LOOP] ;MOVE LOOP DOWN INTO FAST AC'S
- BLT ,LOOPX
- MOVE ,BLANK ;PRESET IULOOK WITH BLANK
-LOOPB: JRST ,LOOP
- PHASE 6
-LOOP: MOVE A05,(A01) ;THIS LOOP CONTRACTS A MAXIMUM
- CAMLE A01,A02 ;OF 5 CHARACTERS IN A1-FORMAT
- JRST ,END ;INTO 1 WORD (A5-FORMAT) .
- TLNN A05,574000
- AOJA A01,LOOP
- JUMPLE A03,END
- ROT A05,7
- IDPB A05,A04
- AOS ,A01
-LOOPX: SOJA A03,LOOP
- DEPHASE
-END: MOVE LOOPX,[XWD ACSAVE+1,1] ;RESTORE AC'S, EXIT
- BLT LOOPX,LOOPX
- GOODBY
-BLANK: ASCII / /
-ACSAVE:BLOCK LOOPX+1
- A01= 1
- A02= 2
- A03= 3
- A04= 4
- A05= 5
- A16=16
- PRGEND
-#ifdef CERNLIB_TCGEN_IULOOK
-#undef CERNLIB_TCGEN_IULOOK
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/iunext.s b/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/iunext.s
deleted file mode 100644
index 974eb9f..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/iunext.s
+++ /dev/null
@@ -1,44 +0,0 @@
-*
-* $Id: iunext.s,v 1.1.1.1 1996/02/15 17:53:36 mclareni Exp $
-*
-* $Log: iunext.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:36 mclareni
-* Kernlib
-*
-*
- TITLE IUNEXT
-;#
-; CERN PROGLIB# M410 IUNEXT .VERSION KERNPDP 1.00 750903
-; ORIG. P. SCHMITZ, AACHEN, 3/9/1975
-;#
- SEARCH HELP
- HELLO (IUNEXT)
- HRRZI ,ACSAVE ;SAVE AC'S
- BLT ,ACSAVE+LOOPX
- MOVEI , at 0(A16) ;INSERT ADR (IVEC)
- SOS
- HRRM ,LOOPB+1
- MOVE ,[XWD LOOPB+1,LOOP] ;MOVE LOOP DOWN INTO
- BLT ,LOOPX ;FAST ACCUMULATORS
- MOVE A02,BLANK
- MOVE A01, at 1(A16)
-LOOPB: JRST ,LOOP
- PHASE 3
-LOOP: MOVE ,(A01) ;BLANK IN IVEC ?
- CAMN ,A02
- AOJA A01,LOOP
-LOOPX: JRST ,END
- DEPHASE
-END: MOVEM A01, ;IUNEXT=J
- MOVE LOOPX,[XWD ACSAVE+1,1] ;RESTORE AC'S, EXIT
- BLT LOOPX,LOOPX
- GOODBY
-BLANK: ASCII / /
-ACSAVE:BLOCK LOOPX+1
- A01= 1
- A02= 2
- A16=16
- PRGEND
-#ifdef CERNLIB_TCGEN_IUNEXT
-#undef CERNLIB_TCGEN_IUNEXT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/iusame.s b/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/iusame.s
deleted file mode 100644
index 7288040..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/iusame.s
+++ /dev/null
@@ -1,58 +0,0 @@
-*
-* $Id: iusame.s,v 1.1.1.1 1996/02/15 17:53:36 mclareni Exp $
-*
-* $Log: iusame.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:36 mclareni
-* Kernlib
-*
-*
- TITLE IUSAME
-;#
-; CERN PROGLIB# M501 IUSAME .VERSION KERNPDP 1.00 750903
-; ORIG. P. SCHMITZ, AACHEN, 3/9/1975
-;#
- SEARCH HELP
- HELLO (IUSAME)
- MOVEM A01,AC01
- MOVEM A02,AC02
- MOVEM A03,AC03
- MOVEI , at 0(A16)
- SOS
- HRRM ,SET
- SOS
- HRRM ,SET+1
- MOVE A01, at 1(A16)
-P21: SETZM ,A02
- MOVE A03,A01
-P24: AOS ,A02
- CAMN A01, at 2(A16)
- JRST ,P31
- AOS ,A01
-SET: MOVE ,(A01)
- CAMN ,(A01)
- JRST ,P24
- CAMGE A02, at 3(A16)
- JRST ,P21
- JRST ,P32
-P31: CAML A02, at 3(A16)
- JRST ,P32
- SETZM ,A02
- MOVE A03, at 2(A16)
- AOS ,A03
-P32: MOVE ,A02
- MOVEM A03, at 4(A16)
- MOVE A01,AC01
- MOVE A02,AC02
- MOVE A03,AC03
- GOODBY
-AC01: 0
-AC02: 0
-AC03: 0
- A01= 1
- A02= 2
- A03= 3
- A16=16
- PRGEND
-#ifdef CERNLIB_TCGEN_IUSAME
-#undef CERNLIB_TCGEN_IUSAME
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/lvmima.s b/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/lvmima.s
deleted file mode 100644
index 35521a1..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/lvmima.s
+++ /dev/null
@@ -1,94 +0,0 @@
-*
-* $Id: lvmima.s,v 1.1.1.1 1996/02/15 17:53:36 mclareni Exp $
-*
-* $Log: lvmima.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:36 mclareni
-* Kernlib
-*
-*
- TITLE LVMIMA
-;#
-; CERN PROGLIB# F121 LVMINA .VERSION KERNPDP 1.00 750903
-; ORIG. P. SCHMITZ, AACHEN, 3/9/1975
-;#
- SEARCH HELP
- HELLO (LVMAX)
- MOVEM A01,AC01
- MOVEI A01,0
- JRST ,GO
- HELLO (LVMAXA)
- MOVEM A01,AC01
- MOVEI A01,1
- JRST ,GO
- HELLO (LVMIN)
- MOVEM A01,AC01
- MOVEI A01,2
- JRST ,GO
- HELLO (LVMINA)
- MOVEM A01,AC01
- MOVEI A01,3
- JRST ,GO
-GO: SKIPG , at 1(A16)
- JRST ,P100
- MOVEM A02,AC02
- MOVEM A03,AC03
- MOVEM A04,AC04
- MOVEI A02,1
- XCT ,COM1(A01)
- MOVEI A03,3
- MOVEI , at 0(A16)
- SOS
- HRRM ,COM2(A03)
- SOJGE A03,.-1
- MOVEI A03,1
-LOOP: XCT ,COM2(A01)
- XCT ,COM3(A01)
- JRST ,P9
- MOVEM A04,
- MOVEM A03,A02
- PAGE
-P9: CAMGE A03, at 1(A16)
- AOJA A03,LOOP
- MOVEM A02,
- MOVE A01,AC01
- MOVE A02,AC02
- MOVE A03,AC03
- MOVE A04,AC04
- GOODBY
-P100: SETZM
- MOVE A01,AC01
- GOODBY
-COM1: MOVE , at 0(A16)
- SETZM
- MOVE , at 0(A16)
- MOVM , at 0(A16)
-COM2: MOVE A04,(A03)
- MOVM A04,(A03)
- MOVE A04,(A03)
- MOVM A04,(A03)
-COM3: CAMG A04,
- CAMG A04,
- CAMLE A04,
- CAMLE A04,
- A01= 1
- A02= 2
- A03= 3
- A04= 4
- A16=16
-AC01: 0
-AC02: 0
-AC03: 0
-AC04: 0
- PRGEND
-#ifdef CERNLIB_TCGEN_LVMAX
-#undef CERNLIB_TCGEN_LVMAX
-#endif
-#ifdef CERNLIB_TCGEN_LVMAXA
-#undef CERNLIB_TCGEN_LVMAXA
-#endif
-#ifdef CERNLIB_TCGEN_LVMIN
-#undef CERNLIB_TCGEN_LVMIN
-#endif
-#ifdef CERNLIB_TCGEN_LVMINA
-#undef CERNLIB_TCGEN_LVMINA
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/mxmad.s b/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/mxmad.s
deleted file mode 100644
index 7d78c33..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/mxmad.s
+++ /dev/null
@@ -1,105 +0,0 @@
-*
-* $Id: mxmad.s,v 1.1.1.1 1996/02/15 17:53:36 mclareni Exp $
-*
-* $Log: mxmad.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:36 mclareni
-* Kernlib
-*
-*
- TITLE MXMAD
-;#
-; CERN PROGLIB# F110 MXMAD .VERSION KERNPDP 1.00 750903
-; ORIG. P. SCHMITZ, AACHEN, 3/9/1975
-;#
- SEARCH HELP
- RELOC 0 ; ZUR ERHOEHUNG DER RECHENGESCHWINDIGKEIT I
- HELLO (MXMAD)
- MOVEI 0,25
- JRST ADCEL
- HELLO (MXMAD1)
- MOVEI 0,26
- JRST ADCEL
- HELLO (MXMAD2)
- MOVEI 0,27
- JRST ADCEL
- HELLO (MXMAD3)
- MOVEI 0,30
- JRST ADCEL
- HELLO (MXMPY3)
- MOVEI 0,16
- JRST ADCEL
- HELLO (MXMUB)
- MOVEI 0,37
- JRST ADCEL
- HELLO (MXMUB1)
- MOVEI 0,40
- JRST ADCEL
- HELLO (MXMUB2)
- MOVEI 0,41
- JRST ADCEL
- HELLO (MXMUB3)
- MOVEI 0,42
- RADIX 10
-ADCEL:MOVEM 0,IANDJ
- MOVEM 13,AC15
- MOVEM 15,AC17
- MOVE 15, at 3(14) ;IF (I.LE.0) RETURN , IIA=I
- JUMPLE 15,RETURN
- MOVE 12, at 5(14) ;IF (K.LE.0) RETURN , IIB=K
- JUMPLE 12,RETURN
- MOVE 2,IANDJ ;N1=AC2
- IDIVI 2,10 ;N2=AC3
- MOVEI 11,1 ;IOB=1
- MOVEI 13,1 ;IOA=1
- CAILE 3,2 ; GO TO (3,3,5,5),N2
- JRST A7
- A3:MOVEI 15,1 ;IIA=1
- MOVE 13, at 4(14) ;IOA=J
- A7:IDIVI 3,2 ; GO TO (9,11,9,11),N2
- JUMPN 4,A13
- A11:MOVEI 12,1 ;IIB=1
- MOVE 11, at 4(14) ;IOB=J
- A13:MOVEI 10,@(14) ;IA=1 ALS REELLE ADRESSE DES A-ARRAYS: A(1
- MOVEI 8, at 2(14) ;IC=1 ALS REELLE ADRESSE DES C-ARRAYS: C(1
- MOVEI 5,1 ; DO 25 L=1,I
- DO1:MOVEI 9, at 1(14) ;IB=1 ALS REELLE ADRESSE VON B(1)
- MOVEI 4,1 ; DO 23 M=1,K
- DO2:JRST @DO2(2) ; GO TO (15,18,16),N1
- MOVE A15
- MOVE A18
- MOVE A16
- A15:SETZM (8) ; C(IC)=0.
- JRST A18 ; GO TO 18
- A16:MOVNS (8) ; C(IC)=-C(IC)
- A18:MOVE 1, at 4(14) ; IF (J.EQ.0) GO TO 23
- JUMPE 1,A23
- MOVE 7,10 ; JA=IA
- MOVE 6,9 ; JB=IB
- MOVE 7,10 ; JA=IA
- MOVE 6,9 ; JB=IB
- MOVEI 3,1 ; DO 20 N=1,J
- DO3:MOVE 0,(7)
- FMPR 0,(6) ; C(IC)=C(IC)+A(JA)*B(JB)
- FADRM 0,(8)
- ADD 7,15 ; JA=JA+IIA
- A20:ADD 6,12 ; JB=JB+IIB
- CAMGE 3, at 4(14) ; ENDE DER INNERSTEN DO-SCHLEIFE. *********
- AOJA 3,DO3
- ADD 9,11 ; IB=IB+IOB
- A23:AOS 8 ; IC=IC+1
- CAMGE 4, at 5(14) ; ENDE DER ZWEITEN DO-SCHLEIFE. ***********
- AOJA 4,DO2
- A25:ADD 10,13 ; IA=IA+IOA
- CAMGE 5, at 3(14) ; ENDE DER AEUSSEREN DO-SCHLEIFE. *********
- AOJA 5,DO1
-RETURN:MOVE 13,AC15
- MOVE 15,AC17
- RADIX 8
- GOODBY
-IANDJ:0
-AC15: 0
-AC17: 0
- PRGEND
-#ifndef CERNLIB_MXFLAG1
-#define CERNLIB_MXFLAG1
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/mxmlrt.s b/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/mxmlrt.s
deleted file mode 100644
index 308059e..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/mxmlrt.s
+++ /dev/null
@@ -1,115 +0,0 @@
-*
-* $Id: mxmlrt.s,v 1.1.1.1 1996/02/15 17:53:36 mclareni Exp $
-*
-* $Log: mxmlrt.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:36 mclareni
-* Kernlib
-*
-*
- TITLE MXMLRT
-;#
-; CERN PROGLIB# F110 MXMLRT .VERSION KERNPDP 1.00 750903
-; ORIG. P. SCHMITZ, AACHEN, 3/9/1975
-;#
- SEARCH HELP
-;ACCUMULATOR ASSIGNMENTS:
-;
-; 1 IPA 2 JPA 3 II 4 JJ 5 KC,KJ,KI
-; 6 IA 7 IB 10 IC 11 IA1 12 IB1
-; 13 IC1 14 JA1 15 --- 16 --- 17 JA
- HELLO (MXMLRT)
- JSR ,SAVEAC
- MOVEI A01,1
- MOVE A02, at 4(A16)
- JRST ,GO
- HELLO (MXMLTR)
- JSR ,SAVEAC
- MOVE A01, at 3(A16)
- MOVEI A02,1
-GO: SKIPG , at 3(A16)
- JRST ,EXIT
- SKIPG , at 4(A16)
- JRST ,EXIT
- MOVEI , at 0(A16)
- SOS
- HRRM ,LP20
- HRRM ,LP30
- MOVEI , at 1(A16)
- SOS
- HRRM ,LP20+1
- MOVEI , at 2(A16)
- SOS
- HRRM ,LP30+1
- MOVEI A13,1
- MOVEI A11,1
- MOVEI A03,1
-LP50: MOVEM A13,A10
- MOVEI A05, at 2(A16)
- ADD A05,A10
- SUBI A05,2
- HRRM A05,LP10
- MOVEI A05,1
-LP10: SETZM ,(A05)
- CAMGE A05, at 3(A16)
- AOJA A05,LP10
- MOVEI A12,1
- MOVEI A14,1
- MOVEI A04,1
-LP40: MOVEM A12,A07
- MOVEM A11,A06
- SETZM
- MOVEI A05,1
-LP20: MOVE A15,(A06)
- FMPR A15,(A07)
- FADR ,A15
- ADD A06,A01
- ADD A07, at 4(A16)
- CAMGE A05, at 4(A16)
- AOJA A05,LP20
- MOVEM A14,A17
- MOVEM A13,A10
- MOVEM ,A15
- MOVEI A05,1
-LP30: FMPR ,(A17)
- FADRM ,(A10)
- MOVEM A15,
- AOS ,A10
- ADD A17,A02
- CAMGE A05, at 3(A16)
- AOJA A05,LP30
- PAGE
- AOS ,A12
- ADD A14,A01
- CAMGE A04, at 4(A16)
- AOJA A04,LP40
- ADD A13, at 3(A16)
- ADD A11,A02
- CAMGE A03, at 3(A16)
- AOJA A03,LP50
-EXIT: HRLZI ,ACSAVE
- BLT ,17
- GOODBY
-SAVEAC: 0
- HRRZI ,ACSAVE
- BLT ,ACSAVE+17
- JRST 2, at SAVEAC
-ACSAVE:BLOCK 20
- A01= 1
- A02= 2
- A03= 3
- A04= 4
- A05= 5
- A06= 6
- A07= 7
- A10=10
- A11=11
- A12=12
- A13=13
- A14=14
- A15=15
- A16=16
- A17=17
- PRGEND
-#ifdef CERNLIB_TCGEN_MXMLRT
-#undef CERNLIB_TCGEN_MXMLRT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/mxtrp.s b/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/mxtrp.s
deleted file mode 100644
index 2fb4236..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/mxtrp.s
+++ /dev/null
@@ -1,62 +0,0 @@
-*
-* $Id: mxtrp.s,v 1.1.1.1 1996/02/15 17:53:37 mclareni Exp $
-*
-* $Log: mxtrp.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:37 mclareni
-* Kernlib
-*
-*
- TITLE MXTRP
-;#
-; CERN PROGLIB# F110 MXTRP .VERSION KERNPDP 1.00 750903
-; ORIG. P. SCHMITZ, AACHEN, 3/9/1975
-;#
- SEARCH HELP
- HELLO (MXTRP)
- HRRZI ,ACSAV ;SAVE AC'S
- BLT ,ACSAV+17
- SKIPG A03, at 3(A16) ;IF (I.EQ.0.OR.J.EQ.0) RETURN
- JRST ,END
- SKIPG A04, at 2(A16)
- JRST ,END
- SOS ,A04 ;SET INDICES
- MOVN A04,A04
- HRRM A04,LOOPB+10
- HRRM A03,LOOPB+5
- SOS ,A03
- HRRM A03,LOOPB+11
- MOVEI , at 0(A16) ;SET ADR OF A AND B
- HRRM ,LOOPB+3
- MOVEI , at 1(A16)
- HRRM ,LOOPB+4
- MOVE ,[XWD LOOPB+1,5] ;MOVE LOOP DOWN INTO
- BLT ,17 ;FAST ACCUMULATORS
- SETZM ,A03 ;CLEAR LOOP REGISTERS
- SETZM ,A02
-LOOPB: JRST ,LOOP
- PHASE 5
-LOOP: MOVEM A03,A01 ;IA=K
- AOS ,A03 ;K=K+1
-LOOP1: MOVE ,(A01) ;B(IB)=A(IA)
- MOVEM ,(A02)
- ADDI A01, ;IA=IA+J
- AOS ,A02 ;IB=IB+1
- AOJLE A04,LOOP1 ;END OF INNER LOOP
- HRREI A04,
- CAIG A03, ;END OF OUTER LOOP
- JRST ,LOOP
- JRST ,END
- DEPHASE
-END: HRLZI ,ACSAV ;RESTORE AC'S, EXIT
- BLT ,17
- GOODBY
-ACSAV: BLOCK 20
- A01= 1
- A02= 2
- A03= 3
- A04= 4
- A16= 16
- PRGEND
-#ifdef CERNLIB_TCGEN_MXTRP
-#undef CERNLIB_TCGEN_MXTRP
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/mxuty.s b/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/mxuty.s
deleted file mode 100644
index a0fd516..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/mxuty.s
+++ /dev/null
@@ -1,60 +0,0 @@
-*
-* $Id: mxuty.s,v 1.1.1.1 1996/02/15 17:53:37 mclareni Exp $
-*
-* $Log: mxuty.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:37 mclareni
-* Kernlib
-*
-*
- TITLE MXUTY
-;#
-; CERN PROGLIB# F110 MXUTY .VERSION KERNPDP 1.00 750903
-; ORIG. P. SCHMITZ, AACHEN, 3/9/1975
-;#
- SEARCH HELP
- HELLO (MXUTY)
- HRRZI ,ACSAV
- BLT ,ACSAV+17 ; SUBROUTINE MXUTY (A,I)
- SKIPG A01, at 1(A16) ; IF (I.EQ.0) RETURN
- JRST ,END ; J = 1
- SOS ,A01 ; IF (I.EQ.1) GO TO 2
- SETZM ,A02 ; A(J) = 1.
- MOVSI A05,201400 ; J = J+1
- JUMPE A01,LOOPE ; DO 1 L=1,I
- MOVEI A03,1 ; A(J) = 0.
- MOVEI A04, at 0(A16) ;1 J = J+1
- MOVE ,[XWD LOOPB+1,6] ; RETURN
- BLT ,17 ; END
- HRRM A04,LOOP ;INSERT ADDRESSES
- HRRM A04,LOOP1
- SETZM ,A04
-LOOPB: JRST ,6
- PHASE 6
-LOOP: MOVEM A05,(A02) ;A(J) = 1.
- AOS ,A02 ;J = J+1
-LOOP1: SETZM ,(A02) ;A(J) = 0.
- AOS ,A02 ;END OF INNER LOOP
- CAMGE A04,A01
- AOJA A04,LOOP1
- SETZM ,A04
- CAMGE A03,A01 ;END OF OUTER LOOP
- AOJA A03,LOOP
-LOOP2: JRST ,LOOPE
- DEPHASE
-LOOPE: MOVE A16,ACSAV+16 ;A(J) = 1.
- ADDI A02, at 0(A16)
- MOVEM A05,(A02)
-END: HRLZI ,ACSAV ;RESTORE AC'S , RETURN
- BLT ,17
- GOODBY
-ACSAV: BLOCK 20
- A01= 1
- A02= 2
- A03= 3
- A04= 4
- A05= 5
- A16=16
- PRGEND
-#ifdef CERNLIB_TCGEN_MXUTY
-#undef CERNLIB_TCGEN_MXUTY
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/qpdp9t.s b/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/qpdp9t.s
deleted file mode 100644
index 465d096..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/qpdp9t.s
+++ /dev/null
@@ -1,44 +0,0 @@
-*
-* $Id: qpdp9t.s,v 1.1.1.1 1996/02/15 17:53:34 mclareni Exp $
-*
-* $Log: qpdp9t.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:34 mclareni
-* Kernlib
-*
-*
-#if !defined(CERNLIB_UUOTAPOP)
- TITLE IBMTP
-;#
-; CERN PROGLIB# IBMTP .VERSION KERNPDP 2.02 840327
-; ORIG. 18-MAY-78 RJ PLANO/RUTGERS.
-;#
-; SETS TO HANDLE NINE TRACK TAPE IN INDUSTRY COMPATIBLE MODE.
-
-* LOOK OUT --- SYSTEM DEPENDENT NUMBERS
-#endif
-FLU.TB=231 ;FORTRAN LOGICAL UNIT NUMBER TABLE.
-FLU.MX=77
-CHN.TB=41 ;SOFTWARE CHANNEL TABLE.
-.JBOPS=135 ;LOW SEG DATA RELOCATION.
-A=1
-B=2
-C=3
-ENTRY QPDP9T
-ENTRY IBMTP
-
-IBMTP:
-QPDP9T: MOVE A, @0(16) ;PICK UP LOGICAL UNIT NUMBER.
- HRRZ C, .JBOPS
- HRRZI A, 6(A)
- IDIVI A, 6 ;FORM POINTER TO CHANNEL.
- IMULI B, 6
- ROT B, -6
- IOR B, [POINT 6, FLU.TB(C), 35]
- ADDI B, (A)
- LDB A, B
- LSH A, ^D23
- IOR A, [MTAPE 0, 101]
- XCT A
- SETZM 0
- POPJ 17, 0
- PRGEND
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/ucopiv.s b/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/ucopiv.s
deleted file mode 100644
index 133ad8d..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/ucopiv.s
+++ /dev/null
@@ -1,43 +0,0 @@
-*
-* $Id: ucopiv.s,v 1.1.1.1 1996/02/15 17:53:37 mclareni Exp $
-*
-* $Log: ucopiv.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:37 mclareni
-* Kernlib
-*
-*
- TITLE UCOPIV
-;#
-; CERN PROGLIB# V301 UCOPIV .VERSION KERNPDP 1.00 750903
-;#
- SEARCH HELP
- HELLO (UCOPIV)
- SKIPG , at 2(A16)
- GOODBY
- MOVEM A01,AC01
- MOVEM A02,AC02
- MOVEI A01,1
- MOVE A02, at 2(A16)
- MOVEI , at 0(A16)
- SOS
- HRRM ,LOOP
- MOVEI , at 1(A16)
- SOS
- HRRM ,LOOP+1
-LOOP: MOVE ,(A01)
- MOVEM ,(A02)
- SOS ,A02
- CAMGE A01, at 2(A16)
- AOJA A01,LOOP
- MOVE A01,AC01
- MOVE A02,AC02
- GOODBY
- A01= 1
- A16=16
- A02= 2
-AC01: 0
-AC02: 0
- PRGEND
-#ifdef CERNLIB_TCGEN_UCOPIV
-#undef CERNLIB_TCGEN_UCOPIV
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/ucopyn.s b/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/ucopyn.s
deleted file mode 100644
index 6f1b256..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/ucopyn.s
+++ /dev/null
@@ -1,38 +0,0 @@
-*
-* $Id: ucopyn.s,v 1.1.1.1 1996/02/15 17:53:37 mclareni Exp $
-*
-* $Log: ucopyn.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:37 mclareni
-* Kernlib
-*
-*
- TITLE UCOPYN
-;#
-; CERN PROGLIB# V301 UCOPYN .VERSION KERNPDP 1.00 750903
-; ORIG. P. SCHMITZ, AACHEN, 3/9/1975
-;#
- SEARCH HELP
- HELLO (UCOPYN)
- SKIPG , at 2(A16)
- GOODBY
- MOVEM A01,AC01
- MOVEI , at 0(A16)
- SOS
- HRRM ,LOOP
- MOVEI , at 1(A16)
- SOS
- HRRM ,LOOP+1
- MOVEI A01,1
-LOOP: MOVN ,(A01)
- MOVEM ,(A01)
- CAMGE A01, at 2(A16)
- AOJA A01,LOOP
- MOVE A01,AC01
- GOODBY
- A01= 1
- A16=16
-AC01: 0
- PRGEND
-#ifdef CERNLIB_TCGEN_UCOPYN
-#undef CERNLIB_TCGEN_UCOPYN
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/uctoh.s b/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/uctoh.s
deleted file mode 100644
index d7e8ac5..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/uctoh.s
+++ /dev/null
@@ -1,68 +0,0 @@
-*
-* $Id: uctoh.s,v 1.1.1.1 1996/02/15 17:53:37 mclareni Exp $
-*
-* $Log: uctoh.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:37 mclareni
-* Kernlib
-*
-*
- TITLE UCTOH
-;
-; CERN PROGLIB# M409 UCTOH .VERSION KERNPDP 2.03 841128
-; ORIG. J. MOREELS, I.I.H.E. BRUSSELS, 6-NOV-84
-;
-ENTRY UCTOH
-
-; SUBROUTINE UCTOH(VC,VJ,NH,NCH)
-
- SIXBIT /UCTOH/
-UCTOH: MOVEI 5, at 1(16) ;GET THE ARGUMENTS
- MOVEM 5,VJ
- MOVE 6, at 2(16)
- CAILE 6,5 ;MAXIMUM 5 CHAR/WORD
- MOVEI 6,5
- MOVEM 6,J
- MOVE 7, at 3(16)
- MOVEM 7,NCH
- JUMPLE 7,END ;IF NCH<=0 RETURN
- MOVE 1,(16) ;GET THE INPUT STRING
- LDB 2,[270400,,1] ;GET ARGUMENT TYPE
- CAIN 2,15 ;SKIP IF HOLLERITH CODE
- JRST CHAR ;HANDLE CHARACTER TYPE
- MOVEI 1, at 1 ;SET-UP CALLING SEQUENCE FOR UTRANS
- HRLI 1,440700 ;SET-UP POINTER FOR HOLLERITH
- JRST HOLL
-CHAR: DMOVE 1, at 1 ;GET ILDB POINTER AND STRING
- ;LENGHT
- CAMGE 2,7 ;IF THE CHARACTER STRING IS
- MOVE 7,2 ;SHORTER COPY ONLY THOSE CHARACTERS
- ;AND BLANK FILL VECTOR
-HOLL: MOVE 10,BLANK ;PRESET WORD TO BLANKS
- MOVE 12,NCH ;DETERMINE NUMBER OF WORDS
- IDIV 12,J ;IN HOLLERITH STRING
- CAIE 13,0 ;REST TERM
- ADDI 12,1
-LOOP: MOVEM 10,(5)
- ADDI 5,1
- SOJG 12,LOOP
- MOVE 12,WRD ;GET ILDB POINTER FOR HOLLERITH STRING
-COPY: ILDB 11,1 ;GET NEXT CHARACTER
- IDPB 11,12 ;STORE IT
- SOJG 6,NEXT ;GET RIGHT NUMBER OF CHARACTERS/WORD
- MOVE 6,J ;RESET J
- MOVE 12,WRD ;RESET POINTER
- AOS VJ ;FOR NEXT WORD
-NEXT: SOJG 7,COPY ;COUNT THE NUMBER OF CHAR./WORD
-END: POPJ 17,0
-
- ; VARIABLES
-
-VJ: 0
-NCH: 0
-J: 0
-BLANK: ASCII/ /
-WRD: 440720,,VJ
-PRGEND
-#ifdef CERNLIB_TCGEN_UCTOH
-#undef CERNLIB_TCGEN_UCTOH
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/uctoh1.s b/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/uctoh1.s
deleted file mode 100644
index 93b9b2b..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/uctoh1.s
+++ /dev/null
@@ -1,47 +0,0 @@
-*
-* $Id: uctoh1.s,v 1.1.1.1 1996/02/15 17:53:37 mclareni Exp $
-*
-* $Log: uctoh1.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:37 mclareni
-* Kernlib
-*
-*
- TITLE UCTOH1
-;
-; CERN PROGLIB# M409 UCTOH1 .VERSION KERNPDP 2.03 841128
-; ORIG. J. MOREELS, I.I.H.E. BRUSSELS, 6-NOV-84
-;
-ENTRY UCTOH1
-
-; SUBROUTINE UCTOH1(VC,V1,NCH)
-
- EXTERN UCTOH
-
- SIXBIT /UCTOH1/
-UCTOH1: PUSH 17,16 ;SAVE ARGUMENT LIST
- MOVE 1,(16) ;GET VC
- MOVEM 1,ARGLST
- MOVE 1,1(16) ;GET V1
- MOVEM 1,V1
- MOVE 1,2(16) ;GET NCH
- MOVEM 1,NCH
- MOVEI 16,ARGLST ;CALL UCTOH
- PUSHJ 17,UCTOH
- POP 17,16 ;RESET ARGUMENT LIST
- POPJ 17,0 ;RETURN
-
-; ARGUMENT LIST
-
- -4,,0
-ARGLST: 0
-V1: 0
- 400100,,NH
-NCH: 0
-
-; VARIABLES
-
-NH: 1
-PRGEND
-#ifdef CERNLIB_TCGEN_UCTOH1
-#undef CERNLIB_TCGEN_UCTOH1
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/udicop.s b/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/udicop.s
deleted file mode 100644
index 19a862d..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/udicop.s
+++ /dev/null
@@ -1,65 +0,0 @@
-*
-* $Id: udicop.s,v 1.1.1.1 1996/02/15 17:53:37 mclareni Exp $
-*
-* $Log: udicop.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:37 mclareni
-* Kernlib
-*
-*
- TITLE UDICOP
-;#
-; CERN PROGLIB# V302 UDICOP .VERSION KERNPDP 1.00 750903
-;#
- SEARCH HELP
- HELLO (UDICOP)
- SKIPG , at 2(A16)
- GOODBY
- SKIPG , at 3(A16)
- GOODBY
- HRRZI ,ACSAVE
- BLT ,ACSAVE+7
- MOVE A01, at 2(A16)
- SOS ,A01
- MOVEM A01,A02
- IMUL A01, at 4(A16)
- IMUL A02, at 5(A16)
- ADD A01, at 3(A16)
- ADD A02, at 3(A16)
- MOVE A03, at 4(A16)
- SUB A03, at 3(A16)
- MOVE A04, at 5(A16)
- SUB A04, at 3(A16)
- MOVEI , at 0(A16)
- SOS
- HRRM ,LOOP
- MOVEI , at 1(A16)
- SOS
- HRRM ,LOOP+1
- MOVEI A05,1
- MOVEI A06,1
-LOOP: MOVE ,(A01)
- MOVEM ,(A02)
- SOS ,A01
- SOS ,A02
- CAMGE A06, at 3(A16)
- AOJA A06,LOOP
- MOVEI A06,1
- SUB A01,A03
- SUB A02,A04
- CAMGE A05, at 2(A16)
- AOJA A05,LOOP
- HRLZI ,ACSAVE
- BLT ,7
- GOODBY
-ACSAVE:BLOCK 10
- A01= 1
- A02= 2
- A03= 3
- A04= 4
- A05= 5
- A06= 6
- A16=16
- PRGEND
-#ifdef CERNLIB_TCGEN_UDICOP
-#undef CERNLIB_TCGEN_UDICOP
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/ufill.s b/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/ufill.s
deleted file mode 100644
index adae24d..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/ufill.s
+++ /dev/null
@@ -1,38 +0,0 @@
-*
-* $Id: ufill.s,v 1.1.1.1 1996/02/15 17:53:37 mclareni Exp $
-*
-* $Log: ufill.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:37 mclareni
-* Kernlib
-*
-*
- TITLE UFILL
-;#
-; CERN PROGLIB# V300 UFILL .VERSION KERNPDP 1.00 750903
-; ORIG. P. SCHMITZ, AACHEN, 3/9/1975
-;#
- SEARCH HELP
- HELLO (UFILL)
- HRRZI , at 0(A16) ;SET UP LAST ADR FOR BLT
- ADD , at 2(A16)
- SOS
- HRRM ,BLTG
- HRRZI , at 0(A16) ;BLT START ADR IN AC 0
- ADD , at 1(A16)
- SOS
- EXCH A01, at 3(A16)
- MOVEM A01, at 0 ;SET FIRST WORD OF A TO STUFF
- EXCH A01, at 3(A16)
- HRLI ,251000 ;IF (J1.GE.J2) RETURN
- CAML ,BLTG
- GOODBY
- HRL
- AOS
-BLTG: BLT
- GOODBY
- A01= 1
- A16=16
- PRGEND
-#ifdef CERNLIB_TCGEN_UFILL
-#undef CERNLIB_TCGEN_UFILL
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/uh1toc.s b/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/uh1toc.s
deleted file mode 100644
index 5cccbde..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/uh1toc.s
+++ /dev/null
@@ -1,49 +0,0 @@
-*
-* $Id: uh1toc.s,v 1.1.1.1 1996/02/15 17:53:37 mclareni Exp $
-*
-* $Log: uh1toc.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:37 mclareni
-* Kernlib
-*
-*
- TITLE UH1TOC
-;
-; CERN PROGLIB# M409 UH1TOC .VERSION KERNPDP 2.03 841128
-; ORIG. J. MOREELS, I.I.H.E. BRUSSELS, 6-NOV-84
-;
-ENTRY UH1TOC
-
-; SUBROUTINE UH1TOC(V1,VC,NCH)
-
- EXTERN UHTOC
-
- SIXBIT /UH1TOC/
-UH1TOC: PUSH 17,16 ;SAVE ARGUMENT LIST
- MOVE 1,(16) ;GET V1
- MOVEM 1,V1
- MOVE 1,1(16) ;GET VC
- MOVEM 1,VC
- MOVE 1,2(16) ;GET NCH
- MOVEM 1,NCH
-
- MOVEI 16,ARGLST ;CALL UHTOC
- PUSHJ 17,UHTOC
- POP 17,16 ;RESET ARGUMENT LIST
- POPJ 17,0 ;RETURN
-
-; ARGUMENT LIST
-
- -4,,0
-V1:
-ARGLST: 0
- 400100,,NH
-VC: 0
-NCH: 0
-
-; VARIABLES
-
-NH: 1
-PRGEND
-#ifdef CERNLIB_TCGEN_UH1TOC
-#undef CERNLIB_TCGEN_UH1TOC
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/uhtoc.s b/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/uhtoc.s
deleted file mode 100644
index 2ee9661..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/uhtoc.s
+++ /dev/null
@@ -1,60 +0,0 @@
-*
-* $Id: uhtoc.s,v 1.1.1.1 1996/02/15 17:53:38 mclareni Exp $
-*
-* $Log: uhtoc.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:38 mclareni
-* Kernlib
-*
-*
- TITLE UHTOC
-;
-; CERN PROGLIB# M409 UHTOC .VERSION KERNPDP 2.03 841128
-; ORIG. J. MOREELS, I.I.H.E. BRUSSELS, 6-NOV-84
-;
-ENTRY UHTOC
-
-; SUBROUTINE UHTOC(VI,NH,VC,NCH)
-
- SIXBIT /UHTOC/
-UHTOC: MOVEI 1,@(16) ;GET VI
- MOVEM 1,VI
- MOVE 2, at 1(16) ;GET NH
- CAILE 2,5 ;MAXIMUM 5 CHAR/WORD
- MOVEI 2,5
- MOVEM 2,NH
- MOVE 3, at 3(16) ;GET NCH
- MOVEM 3,NCH
- JUMPLE 3,END ;RETURN IF NCH<=0
-
- MOVE 7,WRD
- MOVE 4,2(16) ;GET VC
- LDB 4,[270400,,4] ;GET TYPE
- CAIN 4,15
- JRST CHAR ;CHARACTER STRING
- MOVEI 4, at 2(16) ;GET VC
- HRLI 4,440700 ;SET-UP ILDB POINTER
- JRST COPY
-CHAR: DMOVE 4, at 2(16) ;GET CHARACTER POINTER
-
- CAMGE 5,3
- MOVE 3,5
-COPY: ILDB 6,7 ;GET CHARACTER
- IDPB 6,4
- SOJG 2,NEXT
- MOVE 2,NH
- MOVE 7,WRD
- AOS VI
-NEXT: SOJG 3,COPY
-END: POPJ 17,0 ;RETURN
-
-; VARIABLES
-
-VI: 0
-NH: 0
-NCH: 0
-VC: 0
-WRD: 440720,,VI
-PRGEND
-#ifdef CERNLIB_TCGEN_UHTOC
-#undef CERNLIB_TCGEN_UHTOC
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/uleft.s b/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/uleft.s
deleted file mode 100644
index 759a9ae..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/uleft.s
+++ /dev/null
@@ -1,92 +0,0 @@
-*
-* $Id: uleft.s,v 1.1.1.1 1996/02/15 17:53:38 mclareni Exp $
-*
-* $Log: uleft.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:38 mclareni
-* Kernlib
-*
-*
- TITLE ULEFT
-;#
-; CERN PROGLIB# M410 ULEFT .VERSION KERNPDP 1.00 750903
-; ORIG. P. SCHMITZ, AACHEN, 3/9/1975
-;#
-.COMMON SLATE [50]
- SEARCH HELP
- HELLO (ULEFT)
- JSR ,ARG
- MOVE ,[XWD LOOPB+1,LOOP] ;MOVE LOOP DOWN INTO
- BLT ,LOOPX ;FAST ACCUMULATORS
- MOVEM A02,A04
- HRRM A01,LOOP+2 ;INSERT ADDRESSES
- HRRM A01,LOOP+5
- HRRM A01,LOOP+6
- MOVE A01,BLANK
-LOOPB: JRST ,LOOP ;GO ON
- PHASE 5
-LOOP: CAMLE A02,A03 ;THIS LOOP CONTRACTS THE VECTOR
- AOJA A04,LOOPE ;IC BY SUPPRESSING THE BLANKS
- MOVE ,(A02) ;AND SHIFTING DOWN
- CAMN ,A01
- AOJA A02,LOOP
- MOVEM A01,(A02)
- MOVEM ,(A04)
- AOS ,A04
-LOOPX: AOJA A02,LOOP
- DEPHASE
-LOOPE: MOVEI A01,SLATE
- MOVEM A04,1(A01) ;SET JEND FOR IUEND
- SUB A04, at 1(A16)
- MOVEM A04,0(A01) ;SET ND FOR IUEND
- JRST ,END
-ARG: 0
- HRRZI ,ACSAVE ;SAVE AC'S
- BLT ,ACSAVE+LOOPX
- MOVEI A01, at 0(A16) ;ADR(IC)
- MOVE A02, at 1(A16) ;JL
- MOVE A03, at 2(A16) ;JR
- SOS ,A02
- SOS ,A03
- JRST 2, at ARG
- HELLO (URIGHT)
- JSR ,ARG
- MOVE ,[XWD LOOP1B+1,LOOP] ;MOVE LOOP DOWN INTO
- BLT ,LOOP1X ;FAST ACCUMULATORS
- MOVEM A03,A04
- HRRM A01,LOOP1+2 ;INSERT ADDRESSES
- HRRM A01,LOOP1+5
- HRRM A01,LOOP1+6
- MOVE A01,BLANK
-LOOP1B:JRST ,LOOP ;GO ON
- PHASE 5
-LOOP1: CAMGE A03,A02 ;THIS LOOP CONTRACTS THE VECTOR
- AOJA A04,LOOP1E ;IC BY SUPRESSING THE BLANKS
- MOVE ,(A03) ;AND SHIFTING THE ELEMENTS UPWAR
- CAMN ,A01
- SOJA A03,LOOP1
- MOVEM A01,(A03)
- MOVEM ,(A04)
- SOS ,A04
-LOOP1X:SOJA A03,LOOP1
- DEPHASE
-LOOP1E:MOVEI A01,SLATE
- MOVEM A04,1(A01) ;SET JEND FOR IUEND
- SUB A04, at 2(A16)
- MOVNM A04,0(A01) ;SET ND FOR IUEND
-END: HRLZI ,ACSAVE ;RESTORE AC'S
- BLT ,LOOPX
- GOODBY
-BLANK: ASCII / /
- A01= 1
- A02= 2
- A03= 3
- A04= 4
- A16=16
-ACSAVE:BLOCK LOOPX+1
- PRGEND
-#ifdef CERNLIB_TCGEN_ULEFT
-#undef CERNLIB_TCGEN_ULEFT
-#endif
-#ifdef CERNLIB_TCGEN_URIGHT
-#undef CERNLIB_TCGEN_URIGHT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/uset.s b/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/uset.s
deleted file mode 100644
index 4b5b059..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/uset.s
+++ /dev/null
@@ -1,66 +0,0 @@
-*
-* $Id: uset.s,v 1.1.1.1 1996/02/15 17:53:38 mclareni Exp $
-*
-* $Log: uset.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:38 mclareni
-* Kernlib
-*
-*
- TITLE USET
-;#
-; CERN PROGLIB# M410 USET .VERSION KERNPDP 1.00 750903
-; ORIG. P. SCHMITZ, AACHEN, 3/9/1975
-;#
-.COMMON SLATE [50]
- SEARCH HELP
- HELLO (USET)
- HRRZI ,ACSAVE ;SAVE AC'S
- BLT ,ACSAVE+LOOPX
- MOVEI A01, at 1(A16) ;ADR(IC)
- MOVE A02, at 2(A16) ;JL
- MOVE A03, at 3(A16) ;JR
- MOVE A04, at 0(A16) ;INT
- SOS ,A01
- MOVE ,[XWD LOOPB+1,LOOP] ;MOVE LOOP DOWN INTO
- BLT ,LOOPX ;FAST ACCUMULATORS
- HRRM A01,LOOP+4 ;INSERT ADDRESSES
- MOVEI A01,SLATE
- SETZM ,SLATE
-LOOPB: JRST ,LOOP
- PHASE 6
-LOOP: CAMGE A03,A02 ;THIS LOOP CONVERTS THE DIGITS
- JRST ,END ;OF AN UNSIGNED INTEGER TO LEFT
- IDIVI A04,12 ;JUSTIFIED ASCII CHARACTERS .
- MOVE ,TABLE(A05)
- MOVEM ,(A03)
- AOS ,SLATE
- CAIL A04,1
- SOJA A03,LOOP
-LOOPX: SOJA A03,END
- DEPHASE
- PAGE
-END: MOVEM A03,1(A01) ;SET JEND FOR IUEND
- HRLZI ,ACSAVE ;RESTORE AC'S , EXIT
- BLT ,LOOPX
- GOODBY
-TABLE: ASCII /0 /
- ASCII /1 /
- ASCII /2 /
- ASCII /3 /
- ASCII /4 /
- ASCII /5 /
- ASCII /6 /
- ASCII /7 /
- ASCII /8 /
- ASCII /9 /
- A01= 1
- A02= 2
- A03= 3
- A04= 4
- A05= 5
- A16=16
-ACSAVE:BLOCK LOOPX+1
- PRGEND
-#ifdef CERNLIB_TCGEN_USET
-#undef CERNLIB_TCGEN_USET
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/uswop.s b/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/uswop.s
deleted file mode 100644
index 99cf172..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/uswop.s
+++ /dev/null
@@ -1,36 +0,0 @@
-*
-* $Id: uswop.s,v 1.1.1.1 1996/02/15 17:53:38 mclareni Exp $
-*
-* $Log: uswop.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:38 mclareni
-* Kernlib
-*
-*
- TITLE USWOP
-;#
-; CERN PROGLIB# V303 USWOP .VERSION KERNPDP 1.00 750903
-;#
- SEARCH HELP
- HELLO (USWOP)
- MOVEM A01,AC01 ;SAVE AC 1
- MOVE A01, at 2(A16) ;FETCH N
- SOSGE ,A01 ;SKIP IF N .GT. 0
- JRST ,END
- MOVEI , at 0(A16) ;INSERT ADDRESSES
- HRRM ,USWO+1
- MOVEI , at 1(A16)
- HRRM ,USWO+0
- HRRM ,USWO+2
-USWO: MOVE ,(A01) ;EXCHANGE A AND B
- EXCH ,(A01)
- MOVEM ,(A01)
- SOJGE A01,USWO
-END: MOVE A01,AC01 ;RESTORE AC 1, EXIT
- GOODBY
-AC01: 0
- A01= 1
- A16=16
- PRGEND
-#ifdef CERNLIB_TCGEN_USWOP
-#undef CERNLIB_TCGEN_USWOP
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/vadd.s b/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/vadd.s
deleted file mode 100644
index 1d5aa4e..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/vadd.s
+++ /dev/null
@@ -1,42 +0,0 @@
-*
-* $Id: vadd.s,v 1.1.1.1 1996/02/15 17:53:38 mclareni Exp $
-*
-* $Log: vadd.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:38 mclareni
-* Kernlib
-*
-*
- TITLE VADD
-;#
-; CERN PROGLIB# F121 VADD .VERSION KERNPDP 1.00 750903
-; ORIG. P. SCHMITZ, AACHEN, 3/9/1975
-;#
- SEARCH HELP
- HELLO (VADD)
- SKIPG , at 3(A16)
- GOODBY
- MOVEI , at 0(A16)
- SOS
- HRRM ,LOOP
- MOVEI , at 1(A16)
- SOS
- HRRM ,LOOP+1
- MOVEI , at 2(A16)
- SOS
- HRRM ,LOOP+2
- MOVEM A01,AC01
- MOVEI A01,1
-LOOP: MOVE ,(A01)
- FADR ,(A01)
- MOVEM ,(A01)
- CAMGE A01, at 3(A16)
- AOJA A01,LOOP
- MOVE A01,AC01
- GOODBY
-AC01: 0
- A01= 1
- A16=16
- PRGEND
-#ifdef CERNLIB_TCGEN_VADD
-#undef CERNLIB_TCGEN_VADD
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/vasum.s b/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/vasum.s
deleted file mode 100644
index 7268b0e..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/vasum.s
+++ /dev/null
@@ -1,40 +0,0 @@
-*
-* $Id: vasum.s,v 1.1.1.1 1996/02/15 17:53:38 mclareni Exp $
-*
-* $Log: vasum.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:38 mclareni
-* Kernlib
-*
-*
- TITLE VASUM
-;#
-; CERN PROGLIB# F121 VASUM .VERSION KERNPDP 1.00 750903
-; ORIG. P. SCHMITZ, AACHEN, 3/9/1975
-;#
- SEARCH HELP
- HELLO (VASUM)
- SETZM
- SKIPG , at 1(A16)
- GOODBY
- MOVEM A01,AC01
- MOVEM A02,AC02
- MOVEI A01, at 0(A16)
- SOS ,A01
- HRRM A01,LOOP
- MOVEI A02,1
-LOOP: MOVM A01,(A02)
- FADR ,A01
- CAMGE A02, at 1(A16)
- AOJA A02,LOOP
- MOVE A01,AC01
- MOVE A02,AC02
- GOODBY
-AC01: 0
-AC02: 0
- A01= 1
- A02= 2
- A16=16
- PRGEND
-#ifdef CERNLIB_TCGEN_VASUM
-#undef CERNLIB_TCGEN_VASUM
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/vbias.s b/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/vbias.s
deleted file mode 100644
index 45df575..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/vbias.s
+++ /dev/null
@@ -1,39 +0,0 @@
-*
-* $Id: vbias.s,v 1.1.1.1 1996/02/15 17:53:39 mclareni Exp $
-*
-* $Log: vbias.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:39 mclareni
-* Kernlib
-*
-*
- TITLE VBIAS
-;#
-; CERN PROGLIB# F121 VBIAS .VERSION KERNPDP 1.00 750903
-; ORIG. P. SCHMITZ, AACHEN, 3/9/1975
-;#
- SEARCH HELP
- HELLO (VBIAS)
- SKIPG , at 3(A16)
- GOODBY
- MOVEI , at 0(A16)
- SOS
- HRRM ,LOOP
- MOVEI , at 2(A16)
- SOS
- HRRM ,LOOP+2
- MOVEM A01,AC01
- MOVEI A01,1
-LOOP: MOVE ,(A01)
- FADR , at 1(A16)
- MOVEM ,(A01)
- CAMGE A01, at 3(A16)
- AOJA A01,LOOP
- MOVE A01,AC01
- GOODBY
-AC01: 0
- A01= 1
- A16=16
- PRGEND
-#ifdef CERNLIB_TCGEN_VBIAS
-#undef CERNLIB_TCGEN_VBIAS
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/vdot.s b/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/vdot.s
deleted file mode 100644
index 2f86e6a..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/vdot.s
+++ /dev/null
@@ -1,44 +0,0 @@
-*
-* $Id: vdot.s,v 1.1.1.1 1996/02/15 17:53:39 mclareni Exp $
-*
-* $Log: vdot.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:39 mclareni
-* Kernlib
-*
-*
- TITLE VDOT
-;#
-; CERN PROGLIB# F121 VDOT .VERSION KERNPDP 1.00 750903
-; ORIG. P. SCHMITZ, AACHEN, 3/9/1975
-;#
- SEARCH HELP
- HELLO (VDOT)
- SETZM
- SKIPG , at 2(A16)
- GOODBY
- MOVEM A01,AC01
- MOVEM A02,AC02
- MOVEI A01, at 0(A16)
- SOS ,A01
- HRRM A01,LOOP
- MOVEI A01, at 1(A16)
- SOS ,A01
- HRRM A01,LOOP+1
- MOVEI A02,1
-LOOP: MOVE A01,(A02)
- FMPR A01,(A02)
- FADR ,A01
- CAMGE A02, at 2(A16)
- AOJA A02,LOOP
- MOVE A01,AC01
- MOVE A02,AC02
- GOODBY
-AC01: 0
-AC02: 0
- A01= 1
- A02= 2
- A16=16
- PRGEND
-#ifdef CERNLIB_TCGEN_VDOT
-#undef CERNLIB_TCGEN_VDOT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/vdotn.s b/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/vdotn.s
deleted file mode 100644
index 8b72050..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/vdotn.s
+++ /dev/null
@@ -1,80 +0,0 @@
-*
-* $Id: vdotn.s,v 1.1.1.1 1996/02/15 17:53:39 mclareni Exp $
-*
-* $Log: vdotn.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:39 mclareni
-* Kernlib
-*
-*
- TITLE VDOTN
-;#
-; CERN PROGLIB# F121 VDOTN .VERSION KERNPDP 1.00 750903
-; ORIG. P. SCHMITZ, AACHEN, 3/9/1975
-;#
- SEARCH HELP
- EXTERN SQRT
- HELLO (VDOTN)
- SETZM
- SKIPG , at 2(A16)
- GOODBY
- JSR ,VD
- ENTER (SQRT)
- JUMP 2,TEMP
- MOVEM ,TEMP
- JRST ,GO
- HELLO (VDOTN2)
- SETZM
- SKIPG , at 2(A16)
- GOODBY
- JSR ,VD
- FMPRM A01,XY
-GO: HRLZI ,ACSAVE
- BLT ,7
- MOVE ,XY
- FDVR ,TEMP
- GOODBY
-VD: 0
- HRRZI ,ACSAVE
- BLT ,ACSAVE+7
- MOVEI , at 0(A16)
- SOS
- HRRM ,LOOP
- MOVEI , at 1(A16)
- SOS
- HRRM ,LOOP+1
- MOVEI A03,1
- SETZM
- SETZM ,A01
- SETZM ,A02
-LOOP: MOVE A04,(A03)
- MOVE A05,(A03)
- MOVEM A04,A06
- FMPR A04,A04
- FADR ,A04
- FMPR A06,A05
- FADR A01,A06
- FMPR A05,A05
- FADR A02,A05
- CAMGE A03, at 2(A16)
- AOJA A03,LOOP
- FMPR ,A02
- MOVEM ,TEMP
- MOVEM A01,XY
- JRST 2, at VD
-ACSAVE:BLOCK 10
-XY: 0
-TEMP: 0
- A01= 1
- A02= 2
- A03= 3
- A04= 4
- A05= 5
- A06= 6
- A16=16
- PRGEND
-#ifdef CERNLIB_TCGEN_VDOTN
-#undef CERNLIB_TCGEN_VDOTN
-#endif
-#ifdef CERNLIB_TCGEN_VDOTN2
-#undef CERNLIB_TCGEN_VDOTN2
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/vexcum.s b/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/vexcum.s
deleted file mode 100644
index 3ffdf3a..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/vexcum.s
+++ /dev/null
@@ -1,44 +0,0 @@
-*
-* $Id: vexcum.s,v 1.1.1.1 1996/02/15 17:53:39 mclareni Exp $
-*
-* $Log: vexcum.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:39 mclareni
-* Kernlib
-*
-*
- TITLE VEXCUM
-;#
-; CERN PROGLIB# F121 VEXCUM .VERSION KERNPDP 1.00 750903
-; ORIG. P. SCHMITZ, AACHEN, 3/9/1975
-;#
- SEARCH HELP
- HELLO (VEXCUM)
- SKIPG , at 2(A16)
- GOODBY
- MOVEM A01,AC01
- MOVEM A02,AC02
- MOVEI , at 0(A16)
- SOS
- HRRM ,LOOP
- MOVEI A01, at 1(A16)
- MOVEI A02,1
-LOOP: MOVE ,(A02)
- CAMGE ,(A01)
- MOVEM ,(A01)
- CAMLE ,1(A01)
- MOVEM ,1(A01)
- FADRM ,2(A01)
- CAMGE A02, at 2(A16)
- AOJA A02,LOOP
- MOVE A01,AC01
- MOVE A02,AC02
- GOODBY
-AC01: 0
-AC02: 0
- A01= 1
- A02= 2
- A16=16
- PRGEND
-#ifdef CERNLIB_TCGEN_VEXCUM
-#undef CERNLIB_TCGEN_VEXCUM
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/vline.s b/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/vline.s
deleted file mode 100644
index 49fc6d7..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/vline.s
+++ /dev/null
@@ -1,49 +0,0 @@
-*
-* $Id: vline.s,v 1.1.1.1 1996/02/15 17:53:39 mclareni Exp $
-*
-* $Log: vline.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:39 mclareni
-* Kernlib
-*
-*
- TITLE VLINE
-;#
-; CERN PROGLIB# F121 VLINE .VERSION KERNPDP 1.00 750903
-; ORIG. P. SCHMITZ, AACHEN, 3/9/1975
-;#
- SEARCH HELP
- HELLO (VLINE)
- SKIPG , at 5(A16)
- GOODBY
- MOVEI , at 4(A16)
- SOS
- HRRM ,LOOP+5
- MOVEI , at 0(A16)
- SOS
- HRRM ,LOOP+2
- MOVEI , at 2(A16)
- SOS
- HRRM ,LOOP
- MOVEM A01,AC01
- MOVEM A02,AC02
- MOVEI A02,1
-LOOP: MOVE ,(A02)
- FMPR , at 3(A16)
- MOVE A01,(A02)
- FMPR A01, at 1(A16)
- FADR ,A01
- MOVEM ,(A02)
- CAMGE A02, at 5(A16)
- AOJA A02,LOOP
- MOVE A01,AC01
- MOVE A02,AC02
- GOODBY
-AC01: 0
-AC02: 0
- A01= 1
- A02= 2
- A16=16
- PRGEND
-#ifdef CERNLIB_TCGEN_VLINE
-#undef CERNLIB_TCGEN_VLINE
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/vmatl.s b/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/vmatl.s
deleted file mode 100644
index 5bc4744..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/vmatl.s
+++ /dev/null
@@ -1,58 +0,0 @@
-*
-* $Id: vmatl.s,v 1.1.1.1 1996/02/15 17:53:39 mclareni Exp $
-*
-* $Log: vmatl.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:39 mclareni
-* Kernlib
-*
-*
- TITLE VMATL
-;#
-; CERN PROGLIB# F121 VMATL .VERSION KERNPDP 1.00 750903
-; ORIG. P. SCHMITZ, AACHEN, 3/9/1975
-;#
- SEARCH HELP
- HELLO (VMATL)
- SKIPG , at 4(A16)
- GOODBY
- MOVEM A01,AC01
- MOVEM A02,AC02
- MOVEM A03,AC03
- MOVEI , at 2(A16)
- SOS
- HRRM ,LOOP
- HRRM ,LOOP1+2
- MOVEI , at 0(16)
- SOS
- HRRM ,LOOP1
- MOVEI , at 1(A16)
- SOS
- HRRM ,LOOP1+1
- MOVEI A01,1
- MOVEI A03,1
- PAGE
-LOOP: SETZM ,(A01)
- MOVEI A02,1
-LOOP1: MOVE ,(A03)
- FMPR ,(A02)
- FADRM ,(A01)
- AOS ,A03
- CAMGE A02, at 4(A16)
- AOJA A02,LOOP1
- CAMGE A01, at 3(A16)
- AOJA A01,LOOP
- MOVE A01,AC01
- MOVE A02,AC02
- MOVE A03,AC03
- GOODBY
- A01= 1
- A02= 2
- A03= 3
- A16=16
-AC01: 0
-AC02: 0
-AC03: 0
- PRGEND
-#ifdef CERNLIB_TCGEN_VMATL
-#undef CERNLIB_TCGEN_VMATL
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/vmatr.s b/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/vmatr.s
deleted file mode 100644
index 5bd5505..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/vmatr.s
+++ /dev/null
@@ -1,57 +0,0 @@
-*
-* $Id: vmatr.s,v 1.1.1.1 1996/02/15 17:53:40 mclareni Exp $
-*
-* $Log: vmatr.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:40 mclareni
-* Kernlib
-*
-*
- TITLE VMATR
-;#
-; CERN PROGLIB# F121 VMATR .VERSION KERNPDP 1.00 750903
-; ORIG. P. SCHMITZ, AACHEN, 3/9/1975
-;#
- SEARCH HELP
- HELLO (VMATR)
- SKIPG , at 3(A16)
- GOODBY
- MOVEM A01,AC01
- MOVEM A02,AC02
- MOVEM A03,AC03
- MOVEI , at 2(A16)
- SOS
- HRRM ,LOOP
- HRRM ,LOOP1+2
- MOVEI , at 0(A16)
- SOS
- HRRM ,LOOP1
- MOVEI , at 1(A16)
- SOS
- HRRM ,LOOP1+1
- MOVEI A01,1
-LOOP: SETZM ,(A01)
- MOVEM A01,A03
- MOVEI A02,1
-LOOP1: MOVE ,(A02)
- FMPR ,(A03)
- FADRM ,(A01)
- ADD A03, at 4(A16)
- CAMGE A02, at 3(A16)
- AOJA A02,LOOP1
- CAMGE A01, at 4(A16)
- AOJA A01,LOOP
- MOVE A01,AC01
- MOVE A02,AC02
- MOVE A03,AC03
- GOODBY
-AC01: 0
-AC02: 0
-AC03: 0
- A01= 1
- A02= 2
- A03= 3
- A16=16
- PRGEND
-#ifdef CERNLIB_TCGEN_VMATR
-#undef CERNLIB_TCGEN_VMATR
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/vmax.s b/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/vmax.s
deleted file mode 100644
index fb994ad..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/vmax.s
+++ /dev/null
@@ -1,84 +0,0 @@
-*
-* $Id: vmax.s,v 1.1.1.1 1996/02/15 17:53:40 mclareni Exp $
-*
-* $Log: vmax.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:40 mclareni
-* Kernlib
-*
-*
- TITLE VMAX
-;#
-; CERN PROGLIB# F121 VMAX .VERSION KERNPDP 1.00 750903
-; ORIG. P. SCHMITZ, AACHEN, 3/9/1975
-;#
- SEARCH HELP
- HELLO (VMAX)
- MOVEM A01,AC01
- MOVEI A01,0
- JRST ,GO
- HELLO (VMAXA)
- MOVEM A01,AC01
- MOVEI A01,1
- JRST ,GO
- HELLO (VMIN)
- MOVEM A01,AC01
- MOVEI A01,2
- JRST ,GO
- HELLO (VMINA)
- MOVEM A01,AC01
- MOVEI A01,3
- JRST ,GO
-GO: SETZM
- SKIPG , at 1(A16)
- JRST ,EXIT
- MOVEM A02,AC02
- MOVEM A03,AC03
- MOVEI A02,3
- XCT ,COM1(A01)
- MOVEI A03, at 0(A16)
- SOS ,A03
- HRRM A03,COM2(A02)
- SOJGE A02,.-1
- MOVEI A02,1
- PAGE
-LOOP: XCT ,COM2(A01)
- XCT ,COM3(A01)
- MOVEM A03,
- CAMGE A02, at 1(A16)
- AOJA A02,LOOP
- MOVE A02,AC02
- MOVE A03,AC03
-EXIT: MOVE A01,AC01
- GOODBY
-COM1: MOVE , at 0(A16)
- SETZM
- MOVE , at 0(A16)
- MOVM , at 0(A16)
-COM2: MOVE A03,(A02)
- MOVM A03,(A02)
- MOVE A03,(A02)
- MOVM A03,(A02)
-COM3: CAMLE A03,
- CAMLE A03,
- CAMGE A03,
- CAMGE A03,
-AC01: 0
-AC02: 0
-AC03: 0
- A01= 1
- A02= 2
- A03= 3
- A16=16
- PRGEND
-#ifdef CERNLIB_TCGEN_VMAX
-#undef CERNLIB_TCGEN_VMAX
-#endif
-#ifdef CERNLIB_TCGEN_VMAXA
-#undef CERNLIB_TCGEN_VMAXA
-#endif
-#ifdef CERNLIB_TCGEN_VMIN
-#undef CERNLIB_TCGEN_VMIN
-#endif
-#ifdef CERNLIB_TCGEN_VMINA
-#undef CERNLIB_TCGEN_VMINA
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/vmod.s b/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/vmod.s
deleted file mode 100644
index 707b09a..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/vmod.s
+++ /dev/null
@@ -1,46 +0,0 @@
-*
-* $Id: vmod.s,v 1.1.1.1 1996/02/15 17:53:40 mclareni Exp $
-*
-* $Log: vmod.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:40 mclareni
-* Kernlib
-*
-*
- TITLE VMOD
-;#
-; CERN PROGLIB# F121 VMOD .VERSION KERNPDP 1.00 750903
-; ORIG. P. SCHMITZ, AACHEN, 3/9/1975
-;#
- SEARCH HELP
- EXTERN SQRT
- HELLO (VMOD)
- SETZM
- SKIPG , at 1(A16)
- GOODBY
- MOVEM A01,AC01
- MOVEM A02,AC02
- MOVEI A01, at 0(A16)
- SOS ,A01
- HRRM A01,LOOP
- MOVEI A01,1
-LOOP: MOVE A02,(A01)
- FMPR A02,A02
- FADR ,A02
- CAMGE A01, at 1(A16)
- AOJA A01,LOOP
- MOVEM ,TEMP
- ENTER (SQRT)
- JUMP 2,TEMP
- MOVE A01,AC01
- MOVE A02,AC02
- GOODBY
-AC01: 0
-AC02: 0
-TEMP: 0
- A01= 1
- A02= 2
- A16=16
- PRGEND
-#ifdef CERNLIB_TCGEN_VMOD
-#undef CERNLIB_TCGEN_VMOD
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/vmul.s b/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/vmul.s
deleted file mode 100644
index ff10f89..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/vmul.s
+++ /dev/null
@@ -1,42 +0,0 @@
-*
-* $Id: vmul.s,v 1.1.1.1 1996/02/15 17:53:40 mclareni Exp $
-*
-* $Log: vmul.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:40 mclareni
-* Kernlib
-*
-*
- TITLE VMUL
-;#
-; CERN PROGLIB# F121 VMUL .VERSION KERNPDP 1.00 750903
-; ORIG. P. SCHMITZ, AACHEN, 3/9/1975
-;#
- SEARCH HELP
- HELLO (VMUL)
- SKIPG , at 3(A16)
- GOODBY
- MOVEI , at 0(A16)
- SOS
- HRRM ,LOOP
- MOVEI , at 1(A16)
- SOS
- HRRM ,LOOP+1
- MOVEI , at 2(A16)
- SOS
- HRRM ,LOOP+2
- MOVEM A01,AC01
- MOVEI A01,1
-LOOP: MOVE ,(A01)
- FMPR ,(A01)
- MOVEM ,(A01)
- CAMGE A01, at 3(A16)
- AOJA A01,LOOP
- MOVE A01,AC01
- GOODBY
-AC01: 0
- A01= 1
- A16=16
- PRGEND
-#ifdef CERNLIB_TCGEN_VMUL
-#undef CERNLIB_TCGEN_VMUL
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/vscale.s b/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/vscale.s
deleted file mode 100644
index 656652c..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/vscale.s
+++ /dev/null
@@ -1,39 +0,0 @@
-*
-* $Id: vscale.s,v 1.1.1.1 1996/02/15 17:53:40 mclareni Exp $
-*
-* $Log: vscale.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:40 mclareni
-* Kernlib
-*
-*
- TITLE VSCALE
-;#
-; CERN PROGLIB# F121 VSCALE .VERSION KERNPDP 1.00 750903
-; ORIG. P. SCHMITZ, AACHEN, 3/9/1975
-;#
- SEARCH HELP
- HELLO (VSCALE)
- SKIPG , at 3(A16)
- GOODBY
- MOVEI , at 0(A16)
- SOS
- HRRM ,LOOP
- MOVEI , at 2(A16)
- SOS
- HRRM ,LOOP+2
- MOVEM A01,AC01
- MOVEI A01,1
-LOOP: MOVE ,(A01)
- FMPR , at 1(A16)
- MOVEM ,(A01)
- CAMGE A01, at 3(A16)
- AOJA A01,LOOP
- MOVE A01,AC01
- GOODBY
-AC01: 0
- A01= 1
- A16=16
- PRGEND
-#ifdef CERNLIB_TCGEN_VSCALE
-#undef CERNLIB_TCGEN_VSCALE
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/vsub.s b/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/vsub.s
deleted file mode 100644
index b611056..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/vsub.s
+++ /dev/null
@@ -1,42 +0,0 @@
-*
-* $Id: vsub.s,v 1.1.1.1 1996/02/15 17:53:41 mclareni Exp $
-*
-* $Log: vsub.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:41 mclareni
-* Kernlib
-*
-*
- TITLE VSUB
-;#
-; CERN PROGLIB# F121 VSUB .VERSION KERNPDP 1.00 750903
-; ORIG. P. SCHMITZ, AACHEN, 3/9/1975
-;#
- SEARCH HELP
- HELLO (VSUB)
- SKIPG , at 3(A16)
- GOODBY
- MOVEI , at 0(A16)
- SOS
- HRRM ,LOOP
- MOVEI , at 1(A16)
- SOS
- HRRM ,LOOP+1
- MOVEI , at 2(A16)
- SOS
- HRRM ,LOOP+2
- MOVEM A01,AC01
- MOVEI A01,1
-LOOP: MOVE ,(A01)
- FSBR ,(A01)
- MOVEM ,(A01)
- CAMGE A01, at 3(A16)
- AOJA A01,LOOP
- MOVE A01,AC01
- GOODBY
-AC01: 0
- A01= 1
- A16=16
- PRGEND
-#ifdef CERNLIB_TCGEN_VSUB
-#undef CERNLIB_TCGEN_VSUB
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/vsum.s b/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/vsum.s
deleted file mode 100644
index af10cd1..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/vsum.s
+++ /dev/null
@@ -1,35 +0,0 @@
-*
-* $Id: vsum.s,v 1.1.1.1 1996/02/15 17:53:41 mclareni Exp $
-*
-* $Log: vsum.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:41 mclareni
-* Kernlib
-*
-*
- TITLE VSUM
-;#
-; CERN PROGLIB# F121 VSUM .VERSION KERNPDP 1.00 750903
-; ORIG. P. SCHMITZ, AACHEN, 3/9/1975
-;#
- SEARCH HELP
- HELLO (VSUM)
- SETZM
- SKIPG , at 1(A16)
- GOODBY
- MOVEM A01,AC01
- MOVEI A01, at 0(A16)
- SOS ,A01
- HRRM A01,LOOP
- MOVEI A01,1
-LOOP: FADR ,(A01)
- CAMGE A01, at 1(A16)
- AOJA A01,LOOP
- MOVE A01,AC01
- GOODBY
-AC01: 0
- A01= 1
- A16=16
- PRGEND
-#ifdef CERNLIB_TCGEN_VSUM
-#undef CERNLIB_TCGEN_VSUM
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/vunit.s b/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/vunit.s
deleted file mode 100644
index 25c87fc..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mln/vunit.s
+++ /dev/null
@@ -1,61 +0,0 @@
-*
-* $Id: vunit.s,v 1.1.1.1 1996/02/15 17:53:41 mclareni Exp $
-*
-* $Log: vunit.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:41 mclareni
-* Kernlib
-*
-*
- TITLE VUNIT
-;#
-; CERN PROGLIB# F121 VUNIT .VERSION KERNPDP 1.00 750903
-; ORIG. P. SCHMITZ, AACHEN, 3/9/1975
-;#
- SEARCH HELP
- EXTERN SQRT
- HELLO (VUNIT)
- SKIPG , at 2(A16)
- GOODBY
- SETZM
- MOVEM A01,AC01
- MOVEI A01, at 0(A16)
- SOS ,A01
- HRRM A01,LOOP
- HRRM A01,LOOP1
- MOVEI A01, at 1(A16)
- SOS ,A01
- HRRM A01,LOOP1+2
- MOVEI A01,1
- MOVEM A02,AC02
-LOOP: MOVE A02,(A01)
- FMPR A02,A02
- FADR ,A02
- CAMGE A01, at 2(A16)
- AOJA A01,LOOP
- PAGE
- JUMPLE ,EXIT
- MOVEM ,TEMP
- ENTER (SQRT)
- JUMP 2,TEMP
- MOVE A02,EINS
- FDVR A02,
- MOVEI A01,1
-LOOP1: MOVE ,(A01)
- FMPR ,A02
- MOVEM ,(A01)
- CAMGE A01, at 2(A16)
- AOJA A01,LOOP1
-EXIT: MOVE A01,AC01
- MOVE A02,AC02
- GOODBY
-EINS: EXP ^D1.0
-AC01: 0
-AC02: 0
-TEMP: 0
- A01= 1
- A02= 2
- A16=16
- PRGEND
-#ifdef CERNLIB_TCGEN_VUNIT
-#undef CERNLIB_TCGEN_VUNIT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/bytops.s b/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/bytops.s
deleted file mode 100644
index d4f01ba..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/bytops.s
+++ /dev/null
@@ -1,241 +0,0 @@
-*
-* $Id: bytops.s,v 1.1.1.1 1996/02/15 17:53:41 mclareni Exp $
-*
-* $Log: bytops.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:41 mclareni
-* Kernlib
-*
-*
- TITLE BYTOPS
-;#
-; CERN PROGLIB# M421 CBYT ET AL. .VERSION KERNPDP 1.00 750903
-; ORIG. P. SCHMITZ, AACHEN, 3/9/1975
-;#
-#include "reentr.inc"
- SEARCH HELP
- HELLO (CBYT)
- MOVE A01, at 1(A16)
- MOVE , at 4(A16)
- DPB ,[POINT 6,LDBTB2-1(A01),11]
- MOVE A02, at 3(A16)
- DPB ,[POINT 6,LDBTB2-1(A02),11]
- LDB ,LDBTB2-1(A01)
- ADDI A16,2
- DPB ,LDBTB2-1(A02)
- SUBI A16,2
- GOODBY
- HELLO (JBYTET)
- EXCH A01, at 2(A16)
- MOVE , at 3(A16)
- DPB ,[POINT 6,LDBTB2-1(A01),11]
- AOS ,A16
- LDB ,LDBTB2-1(A01)
- SOS ,A16
- AND , at 0(A16)
- EXCH A01, at 2(A16)
- GOODBY
- HELLO (SBYTOR)
- MOVE A01, at 2(A16)
- MOVE , at 3(A16)
- DPB ,[POINT 6,LDBTB2-1(A01),11]
- AOS ,A16
- LDB ,LDBTB2-1(A01)
- SOS ,A16
- IOR , at 0(A16)
- AOS ,A16
- DPB ,LDBTB2-1(A01)
- SOS ,A16
- GOODBY
- HELLO (JRSBYT)
- AOS ,A16
- EXCH A01, at 1(A16)
- MOVE , at 2(A16)
- DPB ,[POINT 6,LDBTB2-1(A01),11]
- LDB ,LDBTB2-1(A01)
- SOS ,A16
- EXCH , at 0(A16)
- AOS ,A16
- DPB ,LDBTB2-1(A01)
- SOS ,A16
- EXCH , at 0(A16)
- EXCH A01, at 2(A16)
- GOODBY
- HELLO (LOCBYT)
- MOVEM A01,AC01
- MOVEM A02,AC02
- SKIPG , at 2(A16)
- JRST ,P19
- MOVEI A01,1
- MOVE A02, at 4(A16)
- MOVE , at 5(A16)
- DPB ,[POINT 6,LDBTB3-1(A02),11]
-LOOP: MOVEI A10, at 1(A16)
- ADD A10,A01
- SOS ,A10
- LDB ,LDBTB3-1(A02)
- CAMN , at 0(A16)
- JRST ,P21
- CAML A01, at 2(A16)
- JRST ,P19
- ADD A01, at 3(A16)
- JRST ,LOOP
-P19: SETZM
- MOVE A01,AC01
- MOVE A02,AC02
- GOODBY
-P21: MOVEM A01,
- MOVE A01,AC01
- MOVE A02,AC02
- GOODBY
- HELLO (JBYTPK)
- PUSHJ P,JBSETI
- DPB ,[POINT 6,LDBTB3-1(A03),11]
- MOVEI A10, at 0(A16)
- ADD A10,A02
- LDB ,LDBTB3-1(A03)
-JBSETX:MOVE A01,AC01
- MOVE A02,AC02
- MOVE A03,AC03
- MOVE A04,AC04
- MOVE A10,AC10
- GOODBY
- HELLO (SBYTPK)
- AOS ,A16
- PUSHJ P,JBSETI
- SOS ,A16
- DPB ,[POINT 6,LDBTB3-1(A03),11]
- MOVE , at 0(A16)
- MOVEI A10, at 1(A16)
- ADD A10,A02
- DPB ,LDBTB3-1(A03)
- JRST ,JBSETX
-JBSETI: MOVEM A01,AC02
- MOVEM A02,AC02
- MOVEM A03,AC03
- MOVEM A04,AC04
- MOVEM A10,AC10
- MOVE , at 2(A16)
- JUMPG ,P7
- MOVEI A01,^D36
- MOVEI ,1
- JRST ,P11
-P7: MOVEI A01, at 2(A16)
- MOVE A01,1(A01)
-P11: MOVE A02, at 1(A16)
- SOS ,A02
- IDIV A02,A01
- MOVEM A02,A03
- IMUL A03,A01
- SUB A03, at 1(A16)
- MOVN A03,A03
- SOS ,A03
- IMUL A03,
- AOS ,A03
- POPJ P,
-#include "reent1.inc"
-LDBTB2:POINT 1, at 0(A16),35
- POINT 1, at 0(A16),34
- POINT 1, at 0(A16),33
- POINT 1, at 0(A16),32
- POINT 1, at 0(A16),31
- POINT 1, at 0(A16),30
- POINT 1, at 0(A16),29
- POINT 1, at 0(A16),28
- POINT 1, at 0(A16),27
- POINT 1, at 0(A16),26
- POINT 1, at 0(A16),25
- POINT 1, at 0(A16),24
- POINT 1, at 0(A16),23
- POINT 1, at 0(A16),22
- POINT 1, at 0(A16),21
- POINT 1, at 0(A16),20
- POINT 1, at 0(A16),19
- POINT 1, at 0(A16),18
- POINT 1, at 0(A16),17
- POINT 1, at 0(A16),16
- POINT 1, at 0(A16),15
- POINT 1, at 0(A16),14
- POINT 1, at 0(A16),13
- POINT 1, at 0(A16),12
- POINT 1, at 0(A16),11
- POINT 1, at 0(A16),10
- POINT 1, at 0(A16),09
- POINT 1, at 0(A16),08
- POINT 1, at 0(A16),07
- POINT 1, at 0(A16),06
- POINT 1, at 0(A16),05
- POINT 1, at 0(A16),04
- POINT 1, at 0(A16),03
- POINT 1, at 0(A16),02
- POINT 1, at 0(A16),01
- POINT 1, at 0(A16),00
-LDBTB3:POINT 1,(A10),35
- POINT 1,(A10),34
- POINT 1,(A10),33
- POINT 1,(A10),32
- POINT 1,(A10),31
- POINT 1,(A10),30
- POINT 1,(A10),29
- POINT 1,(A10),28
- POINT 1,(A10),27
- POINT 1,(A10),26
- POINT 1,(A10),25
- POINT 1,(A10),24
- POINT 1,(A10),23
- POINT 1,(A10),22
- POINT 1,(A10),21
- POINT 1,(A10),20
- POINT 1,(A10),19
- POINT 1,(A10),18
- POINT 1,(A10),17
- POINT 1,(A10),16
- POINT 1,(A10),15
- POINT 1,(A10),14
- POINT 1,(A10),13
- POINT 1,(A10),12
- POINT 1,(A10),11
- POINT 1,(A10),10
- POINT 1,(A10),9
- POINT 1,(A10),8
- POINT 1,(A10),7
- POINT 1,(A10),6
- POINT 1,(A10),5
- POINT 1,(A10),4
- POINT 1,(A10),3
- POINT 1,(A10),2
- POINT 1,(A10),1
- POINT 1,(A10),0
- P==17
- A01= 1
- A02= 2
- A03= 3
- A04= 4
- A10=10
- A16=16
-AC01: 0
-AC02: 0
-AC03: 0
-AC04: 0
-AC10: 0
- PRGEND
-#ifdef CERNLIB_TCGEN_CBYT
-#undef CERNLIB_TCGEN_CBYT
-#endif
-#ifdef CERNLIB_TCGEN_JBYTET
-#undef CERNLIB_TCGEN_JBYTET
-#endif
-#ifdef CERNLIB_TCGEN_SBYTOR
-#undef CERNLIB_TCGEN_SBYTOR
-#endif
-#ifdef CERNLIB_TCGEN_JRSBYT
-#undef CERNLIB_TCGEN_JRSBYT
-#endif
-#ifdef CERNLIB_TCGEN_LOCBYT
-#undef CERNLIB_TCGEN_LOCBYT
-#endif
-#ifdef CERNLIB_TCGEN_JBYTPK
-#undef CERNLIB_TCGEN_JBYTPK
-#endif
-#ifdef CERNLIB_TCGEN_SBYTPK
-#undef CERNLIB_TCGEN_SBYTPK
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/comment.inc b/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/comment.inc
deleted file mode 100644
index 6f7b72f..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/comment.inc
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: comment.inc,v 1.1.1.1 1996/02/15 17:53:41 mclareni Exp $
-*
-* $Log: comment.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:53:41 mclareni
-* Kernlib
-*
-*
-*
-* comment.inc
-*
-
-
-C-- THIS PATCH CONTAINS THE ASSEMBLER ROUTINES
-C-- WHICH HAVE BEEN CODED IN REENTRANT FORM.
-C--
-C-- THE PATCHY SEQUENCES REENTR AND REENT1 ARE
-C-- DEFINED IN THIS PATCH, BY DEFAULT, AS DUMMY
-C-- THEY ARE DEFINED IN PATCH REENTR IN CASE A
-C-- REENTRANT VERSION IS DESIRED
-
-
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/cross.s b/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/cross.s
deleted file mode 100644
index e8163fc..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/cross.s
+++ /dev/null
@@ -1,58 +0,0 @@
-*
-* $Id: cross.s,v 1.1.1.1 1996/02/15 17:53:41 mclareni Exp $
-*
-* $Log: cross.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:41 mclareni
-* Kernlib
-*
-*
- TITLE CROSS
-;#
-; CERN PROGLIB# F117 CROSS .VERSION KERNPDP 1.00 750903
-; ORIG. P. SCHMITZ, AACHEN, 3/9/1975
-;#
-#include "reentr.inc"
-.COMMON SLATE [50]
- SEARCH HELP
- HELLO (CROSS)
- HRRZI ,ACSAV ;SAVE THE AC'S
- BLT ,ACSAV+5
- MOVEI A02,SLATE ;FETCH ADDRESSES
- MOVEI A03, at 0(A16)
- MOVEI A04, at 1(A16)
- MOVEI A05, at 2(A16)
- MOVE ,1(A03) ;Z1=X(1)*Y(3)-X(3)*Y(2)
- FMPR ,2(A04)
- MOVE A01,2(A03)
- FMPR A01,1(A04)
- FSBR ,A01
- MOVEM ,0(A02)
- MOVEM ,0(A05)
- MOVE ,2(A03) ;Z2=X(3)*Y(1)-X(1)*Y(3)
- FMPR ,0(A04)
- MOVE A01,0(A03)
- FMPR A01,2(A04)
- FSBR ,A01
- MOVEM ,1(A02)
- MOVEM ,1(A05)
- MOVE ,0(A03) ;Z(3)=X(1)*Y(2)-X(2)*Y(1)
- FMPR ,1(A04)
- MOVE A01,1(A03)
- FMPR A01,0(A04)
- FSBR ,A01
- MOVEM ,2(A05)
- HRLZI ,ACSAV ;RESTORE AC'S
- BLT ,5
- GOODBY
-#include "reent1.inc"
-ACSAV: BLOCK 6
- A01= 1
- A02= 2
- A03= 3
- A04= 4
- A05= 5
- A16=16
- PRGEND
-#ifdef CERNLIB_TCGEN_CROSS
-#undef CERNLIB_TCGEN_CROSS
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/datime.s b/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/datime.s
deleted file mode 100644
index 7b133a7..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/datime.s
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: datime.s,v 1.1.1.1 1996/02/15 17:53:42 mclareni Exp $
-*
-* $Log: datime.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:42 mclareni
-* Kernlib
-*
-*
- TITLE DATIME
-;#
-; CERN PROGLIB# Z007 DATIME .VERSION KERNPDP 1.02 761001
-;#
- SEARCH HELP
-#include "reentr.inc"
- INT=1
- TEMP=2
- RMDR=3
- T4==4
- HELLO(DATIME)
- DATE TEMP,
- IDIVI TEMP,^D31 ;DAY
- MOVEI INT,1(RMDR)
- IDIVI TEMP,^D12 ;MONTH
- IMULI RMDR,^D100
- ADDI INT,^D100(RMDR)
- ADDI TEMP,^D64 ;YEAR
- IMULI TEMP,^D10000
- ADD INT,TEMP
- MOVEM INT,@(16)
- MSTIME TEMP, ;TIME IN MILLI SECONDS
- IDIVI TEMP,^D1000 ;GET SECONDS
- IDIVI TEMP,^D3600 ;GET HOURS
- IDIVI RMDR,^D60 ;GET MINUTES
- IMULI TEMP,^D100
- ADD TEMP,RMDR ;ADD THE SECONDS
- MOVEM TEMP, at 1(16)
- GOODBY
- PRGEND
-#ifdef CERNLIB_TCGEN_DATIME
-#undef CERNLIB_TCGEN_DATIME
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/datimh.s b/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/datimh.s
deleted file mode 100644
index 1e4d796..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/datimh.s
+++ /dev/null
@@ -1,62 +0,0 @@
-*
-* $Id: datimh.s,v 1.1.1.1 1996/02/15 17:53:42 mclareni Exp $
-*
-* $Log: datimh.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:42 mclareni
-* Kernlib
-*
-*
- TITLE DATIMH
-;#
-; CERN PROGLIB# Z007 DATIMH .VERSION KERNPDP 1.02 761001
-;#
- SEARCH HELP
-#include "reentr.inc"
- T0==1
- T1=2
- T2==3
- T3==4
- T4==5
- T5==6
- T6==7
- T7=10
- HELLO(DATIMH)
- DATE T0,
- IDIVI T0,^D31
- MOVEI T2,1(T1) ;DAY
- IDIVI T0,^D12 ;MONTH
- ADDI T1,1
- ADDI T0,^D64 ;YEAR
- MOVEI T6,3
- MOVEI T4,57 ;GET SLASH
- MOVE T5,[POINT 7,0] ;SETUP POINTER
- ADDI T5,@(16)
- PUSHJ 17,CONVER ;DO CONVERSION TO ASCII
- MSTIME T2, ;GET TIME IN MILLI SECONDS
- IDIVI T2,^D1000 ;GET SECONDS
- IDIVI T2,^D3600 ;GET HOURS IN T2
- IDIVI T3,^D60 ;GET MINUTES
- MOVE T1,T3
- MOVE T0,T4 ;GET SECONDS
- MOVEI T6,3
- MOVEI T4,56 ;GET POINT
- MOVE T5,[POINT 7,] ;SET UP POINTER
- ADDI T5, at 1(16)
- PUSHJ 17,CONVER ;DO CONVERSION
- GOODBY
-CONVER: IDIVI T2,12
- ADDI T2,60
- ADDI T3,60 ;GET ASCII
- IDPB T2,T5
- IDPB T3,T5 ;DEPOSIT
-CONT: SOJN T6,AGAIN
- POPJ 17,
-AGAIN: IDPB T4,T5 ;NEXT WORD
- MOVE T2,T1
- CAIE T6,2
- MOVE T2,T0
- JRST CONVER
- PRGEND
-#ifdef CERNLIB_TCGEN_DATIMH
-#undef CERNLIB_TCGEN_DATIMH
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/erf.s b/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/erf.s
deleted file mode 100644
index 17ae5cf..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/erf.s
+++ /dev/null
@@ -1,79 +0,0 @@
-*
-* $Id: erf.s,v 1.1.1.1 1996/02/15 17:53:42 mclareni Exp $
-*
-* $Log: erf.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:42 mclareni
-* Kernlib
-*
-*
- TITLE ERF
-;#
-; CERN PROGLIB# C300 ERF .VERSION KERNPDP 1.00 750903
-; ORIG. P. SCHMITZ, AACHEN, 3/9/1975
-;#
-#include "reentr.inc"
- SEARCH HELP
- HELLO (ERF)
- SETZM ,TF ;ENTERF = .TRUE.
- MOVE 0,@(16)
- JRST BEIDE
- HELLO (FREQ)
- SETOM ,TF ;ENTERF = .FALSE.
- MOVE 0,@(16)
- FMPR 0,KONST ; Y=0.70710678*P
-BEIDE:MOVEM 0,Y ; Y=P
- MOVMM 0,X ; X=ABS(Y)
- MOVEM 1,AC1 ; SICHERE ACCU 1 UND 2
- MOVEM 2,AC2
- MOVE 0,A ; S=SIGN(A(1),Y)
- MOVE 1,Y
- CAIGE 1,0
- MOVN 0,0
- MOVEM 0,S
- MOVE 1,X ; IF (X.LE.1.E6) GO TO 2
- CAMLE 1,MILION
- JRST P4 ; ERF=A(1)*S
- P2:FMPR 1,A+6 ; SUM=A(7)*X
- MOVEI 2,5 ; DO 3 I=1,5
- M3:FADR 1,A(2) ; J=7-I
- FMPR 1,X ; SUM=SUM+A(J)
- CAILE 2,1 ; SUM=SUM*X
- SOJA 2,M3
- FADR 1,A ; SUM=SUM+A(1)
- MOVE 0,A
- FDVR 0,1 ; SUM=A(1)/SUM
- FMPR 0,0 ; SUM=SUM**16
- FMPR 0,0
- FMPR 0,0
- FMPR 0,0
- FSBR 0,A ; ERF=A(1)-SUM
- MOVN 0,0
- FMPR 0,S ; ERF=ERF*S
- P4:SKIPL ,TF ;IF (ENTERF) RETURN
- JRST RETURN
- FADR 0,A ; ERF=0.5*(1.+ERF)
- FMPR 0,HALB
-RETURN:MOVE 1,AC1
- MOVE 2,AC2
- GOODBY
- A:DEC 1.
- DEC 0.070523078
- DEC 0.042282012
- DEC 0.0092705272
- DEC 0.0001520143
- DEC 0.0002765672
- DEC 0.0000430638
- HALB:DEC 0.5
-MILION:DEC 1000000.
-KONST:DEC 0.70710678
-#include "reent1.inc"
- TF:0 ;TRUE-FALSE SWITCH
-AC1: 0
-AC2: 0
- S:0
- X:0
- Y:0
- PRGEND
-#ifdef CERNLIB_TCGEN_ERF
-#undef CERNLIB_TCGEN_ERF
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/incbyt.s b/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/incbyt.s
deleted file mode 100644
index 2ec279b..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/incbyt.s
+++ /dev/null
@@ -1,57 +0,0 @@
-*
-* $Id: incbyt.s,v 1.1.1.1 1996/02/15 17:53:42 mclareni Exp $
-*
-* $Log: incbyt.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:42 mclareni
-* Kernlib
-*
-*
- TITLE INCBYT (INCR,A,JTH,NBITS)
-;#
-; CERN PROGLIB# M423 INCBYT .VERSION KERNPDP 1.00 750903
-;#
- SEARCH HELP
-#include "reentr.inc"
- HELLO( INCBYT)
- MOVEI 0,SAVAC ;SAVE
- HRLI 0,2 ;AC-S
- BLT 0,SAVAC+13
- SETZ 0, ;ZERO AC0
- MOVE 01, at 2(16) ;GET JTH
- MOVEI 02, at 3(16) ;GET ADDR OF NBITS
- MOVE 03,1(02) ;AC3=NBITS(2)
- MOVEI 04,-1(01) ;AC4=JTH-1
- IDIVI 04,(03) ;AC4=AC4/NBITS(2)=JWORD-1
- ADDI 05,1
- MOVE 07,(02) ;AC7=NBITS
- IMULI 05,(07) ;AC5= (REST+1)*NBITS
- MOVEI 03,44
- SUBI 03,(05) ;AC3=36-AC5 = LOC
- MOVEI 11, at 1(16) ;GET ADDR OF A
- ADDI 11,(04) ;GET ADDR OF A(JWORD)
- MOVE 06,(11) ;GET A(JWORD)
- SETZ 05, ;ZERO AC5
- ROT 06,(03) ;PUT THE BYTE
- LSHC 05,(07) ;INTO AC5
- ADD 05,@(16) ;ADD THE INCR
- MOVE 01,2(02) ;AC1=MAX
- CAIL 01,(05) ;COMPARE
- JRST 0,FIN ;JUMP TO FINISH
- SUBI 05,(01) ;AC5=SUMME -MAX
- MOVE 0,05 ;STORE OVFLOW IN AC0
- MOVE 05,01 ;STORE MAX INSTEAD OF SUMME
-FIN: MOVNS 03 ;NEGATE AC3
- MOVNS 07 ;NEGATE AC7
- LSHC 05,(07) ;BRING BYTE
- ROT 06,(03) ;IN RIGHT POSITION
- MOVEM 06,(11) ;STORE RESULT
- MOVSI 1,SAVAC ;GET BACK
- HRRI 1,2 ;AC-S
- BLT 1,15
- GOODBY
-#include "reent1.inc"
-SAVAC: BLOCK 14
- PRGEND
-#ifdef CERNLIB_TCGEN_INCBYT
-#undef CERNLIB_TCGEN_INCBYT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/iubin.s b/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/iubin.s
deleted file mode 100644
index df87d6f..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/iubin.s
+++ /dev/null
@@ -1,87 +0,0 @@
-*
-* $Id: iubin.s,v 1.1.1.1 1996/02/15 17:53:42 mclareni Exp $
-*
-* $Log: iubin.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:42 mclareni
-* Kernlib
-*
-*
- TITLE IUBIN
-;#
-; CERN PROGLIB# Y202 IUBIN .VERSION KERNPDP 1.00 750903
-;#
-#include "reentr.inc"
- SEARCH HELP
-; WRITTEN P. SCHMITZ
- EXTERN FLOAT,IFIX
- HELLO (IUBIN)
- MOVEM A03,AC03
- SETZM ,A03
- JRST ,GO
- HELLO (IUHIST)
- MOVEM A03,AC03
- MOVEI A03,1
- JRST ,GO
-GO: MOVEM A01,AC01
- MOVEM A02,AC02
- SETZM , at 2(A16)
- MOVEI A01, at 1(A16)
- MOVE A02, at 0(A16)
- FSBR A02,2(A01)
- XCT ,COMAND(A03)
- FADR A02,CONST
- CAMGE A02,CONST
- JRST ,P20
- MOVEM A03,TEMP2
- MOVE , at 1(A16)
- AOS
- MOVEM ,TEMP
- MOVEM A02,TEMP1
- ENTER (FLOAT)
- JUMP 0,TEMP
- MOVE A02,TEMP1
- CAML A02,
- JRST ,P18
- ENTER (IFIX)
- JUMP 2,TEMP1
- MOVE A03,TEMP2
- SKIPL
- JRST ,EXIT
- MOVE , at 1(A16)
- AOS
- XCT ,COMAND+2(A03)
- JRST ,EXIT
-P18: SETOM , at 2(A16)
- MOVE , at 1(A16)
- AOS
- JRST ,EXIT
-P20: SETOM , at 2(A16)
- SETZM
- JRST ,EXIT
-EXIT: MOVE A01,AC01
- MOVE A02,AC02
- MOVE A03,AC03
- GOODBY
-COMAND:FDVR A02,1(A01)
- FMPR A02,1(A01)
- SETZM , at 2(A16)
- SETOM , at 2(A16)
-CONST: ^D1.
-#include "reent1.inc"
-AC01: 0
-AC02: 0
-AC03: 0
-TEMP: 0
-TEMP1: 0
-TEMP2: 0
- A01= 1
- A02= 2
- A03= 3
- A16=16
- PRGEND
-#ifdef CERNLIB_TCGEN_IUBIN
-#undef CERNLIB_TCGEN_IUBIN
-#endif
-#ifdef CERNLIB_TCGEN_IUHIST
-#undef CERNLIB_TCGEN_IUHIST
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/iuchan.s b/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/iuchan.s
deleted file mode 100644
index 331543e..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/iuchan.s
+++ /dev/null
@@ -1,38 +0,0 @@
-*
-* $Id: iuchan.s,v 1.1.1.1 1996/02/15 17:53:42 mclareni Exp $
-*
-* $Log: iuchan.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:42 mclareni
-* Kernlib
-*
-*
- TITLE IUCHAN
-;#
-; CERN PROGLIB# Y201 IUCHAN .VERSION KERNPDP 1.00 750903
-; ORIG. P. SCHMITZ, AACHEN, 3/9/1975
-;#
-#include "reentr.inc"
- SEARCH HELP
- EXTERN IFIX
- HELLO (IUCHAN)
- MOVE , at 0(A16) ;AN=(X-XL)/DX+1.
- FSBR , at 1(A16)
- FDVR , at 2(A16)
- FADR ,[EXP ^D1.0]
- SKIPGE ;IF (AN.LT.0.) AN=0.
- SETZM
- MOVEM ,ACSAVE
- ENTER (IFIX)
- JUMP ,ACSAVE
- CAMG , at 3(A16) ;IF (N.GT.NX) NX=NX+1
- GOODBY
- MOVE , at 3(A16)
- AOS
- GOODBY
-#include "reent1.inc"
-ACSAVE:0
- A16=16
- PRGEND
-#ifdef CERNLIB_TCGEN_IUCHAN
-#undef CERNLIB_TCGEN_IUCHAN
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/iucomp.s b/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/iucomp.s
deleted file mode 100644
index ee4b86f..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/iucomp.s
+++ /dev/null
@@ -1,46 +0,0 @@
-*
-* $Id: iucomp.s,v 1.1.1.1 1996/02/15 17:53:42 mclareni Exp $
-*
-* $Log: iucomp.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:42 mclareni
-* Kernlib
-*
-*
- TITLE IUCOMP (IT,IVEC,N)
-;#
-; CERN PROGLIB# V304 IUCOMP .VERSION KERNPDP 1.00 750903
-;#
- ;ACCUMULATORS:
- FUNC=0
- IT=1
- N=2 ;TO HOLD N
- COUNT=3
-#include "reentr.inc"
- SEARCH HELP
- HELLO( IUCOMP)
- MOVEM N,SAV1
- MOVEM COUNT,SAV2
- SETZ FUNC, ;CLEAR FUNC IN CASE IUCOMPFAILS
- MOVE IT,@(16) ;LOAD IT
- MOVE N, at 2(16) ;LOAD N
- MOVN COUNT,N ;
- HRLZI COUNT,(COUNT) ;SET UP COUNTER
- HRRI COUNT, at 1(16) ;LOAD ADR,OF IVEC(1)
- CAME IT,(COUNT) ;COMPARE,SKIP IF SATISFIED
- AOBJN COUNT,.-1 ;LOOP BACK
- HRLI COUNT,0
- SUBI COUNT, at 1(16)
- ADDI COUNT,1
- CAILE COUNT,(N)
- JRST EXIT
- MOVEI FUNC,(COUNT)
-EXIT: MOVE N,SAV1
- MOVE COUNT,SAV2
- GOODBY
-#include "reent1.inc"
-SAV1: 0
-SAV2: 0
- PRGEND
-#ifdef CERNLIB_TCGEN_IUCOMP
-#undef CERNLIB_TCGEN_IUCOMP
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/iuend.s b/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/iuend.s
deleted file mode 100644
index d44df13..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/iuend.s
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: iuend.s,v 1.1.1.1 1996/02/15 17:53:42 mclareni Exp $
-*
-* $Log: iuend.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:42 mclareni
-* Kernlib
-*
-*
- TITLE IUEND
-;#
-; CERN PROGLIB# M410 IUEND .VERSION KERNPDP 1.00 750903
-; ORIG. P. SCHMITZ, AACHEN, 3/9/1975
-;#
-#include "reentr.inc"
-.COMMON SLATE [50]
- SEARCH HELP
- HELLO (IUEND)
- MOVEM A01,ACSAVE
- MOVEI A01,SLATE
- MOVE ,(A01) ;NDA = ND
- MOVEM , at 0(A16)
- MOVE ,1(A01) ;IUEND = JEND
- MOVE A01,ACSAVE
- GOODBY
-#include "reent1.inc"
-ACSAVE:0
- A01= 1
- A16=16
- PRGEND
-#ifdef CERNLIB_TCGEN_IUEND
-#undef CERNLIB_TCGEN_IUEND
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/jbit.s b/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/jbit.s
deleted file mode 100644
index 562b4d4..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/jbit.s
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: jbit.s,v 1.1.1.1 1996/02/15 17:53:42 mclareni Exp $
-*
-* $Log: jbit.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:42 mclareni
-* Kernlib
-*
-*
- TITLE JBIT (X,LX)
-;#
-; CERN PROGLIB# M421 JBIT .VERSION KERNPDP 1.00 750903
-;#
- WORD=0
- LSHIFT=1
- SEARCH HELP
-#include "reentr.inc"
- HELLO( JBIT)
- MOVN LSHIFT, at 1(16)
- MOVE WORD,@(16)
- LSH WORD,1(LSHIFT)
- ANDI WORD,1
- GOODBY
- PRGEND
-#ifdef CERNLIB_TCGEN_JBIT
-#undef CERNLIB_TCGEN_JBIT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/jbyt.s b/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/jbyt.s
deleted file mode 100644
index 97ab6ea..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/jbyt.s
+++ /dev/null
@@ -1,37 +0,0 @@
-*
-* $Id: jbyt.s,v 1.1.1.1 1996/02/15 17:53:43 mclareni Exp $
-*
-* $Log: jbyt.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:43 mclareni
-* Kernlib
-*
-*
- TITLE JBYT (A,LA,NBITS)
-;#
-; CERN PROGLIB# M421 JBYT .VERSION KERNPDP 1.00 750903
-;#
- ;FUNCTION
- ;TAKES 'NBITS' BITS FROM A AT POSITION LA
- ;RETURNS THEM IN FIRST POSITION
- ;REST OF FUNCTION VALUE IS ZERO
- ;ACCUMULATORS:
- LA=1
- NBITS=3
- SEARCH HELP
-#include "reentr.inc"
- HELLO( JBYT)
- MOVEM 3,SAVAC ;TO SAVE AC
- MOVE NBITS, at 2(16) ;LOAD NBITS
- MOVE 0,@(16) ;PREPARE COUNTERS
- MOVN LA, at 1(16)
- SUBI LA,(NBITS)
- LSH 0,45(LA) ;SHIFT OUT LEFTMOST BITS
- LSH 0,-44(NBITS) ;SHIFT OUT RIGHTMOST BITS
- MOVE 3,SAVAC ;STORE BACK AC
- GOODBY
-#include "reent1.inc"
- SAVAC: 0
- PRGEND
-#ifdef CERNLIB_TCGEN_JBYT
-#undef CERNLIB_TCGEN_JBYT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/locf.s b/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/locf.s
deleted file mode 100644
index 9417fdc..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/locf.s
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: locf.s,v 1.1.1.1 1996/02/15 17:53:43 mclareni Exp $
-*
-* $Log: locf.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:43 mclareni
-* Kernlib
-*
-*
- TITLE LOCF (A)
-;#
-; CERN PROGLIB# LOCF .VERSION KERNPDP 1.00 750903
-;#
- ;FUNCTION, RETURNS LOCATION OF VARIABLE A
- SEARCH HELP
-#include "reentr.inc"
- HELLO( LOCF)
- HRRZI 0,@(16)
- GOODBY
- PRGEND
-#ifdef CERNLIB_TCGEN_LOCF
-#undef CERNLIB_TCGEN_LOCF
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/mxequ.s b/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/mxequ.s
deleted file mode 100644
index 690b0d3..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/mxequ.s
+++ /dev/null
@@ -1,143 +0,0 @@
-*
-* $Id: mxequ.s,v 1.1.1.1 1996/02/15 17:53:43 mclareni Exp $
-*
-* $Log: mxequ.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:43 mclareni
-* Kernlib
-*
-*
- TITLE MXEQU
-;#
-; CERN PROGLIB# F109 MXEQU .VERSION KERNPDP 1.00 750903
-;#
-#include "reentr.inc"
-; WRITTEN P. SCHMITZ
- SEARCH HELP
- HELLO (MXEQU)
- RADIX 10
- SETZM 0,SWITCH
- SAVE:MOVEM 13,AC15
- MOVEM 14,AC16
- MOVEM 15,AC17
- MOVEI 15,@(14) ; HOLE DIE ADRESSEN UND ZAEHLER IN DIE ACCU
- SUBI 15,1 ; LOC(A) -1
- MOVE 13, at 2(14) ; I
- MOVE 12, at 3(14) ; J
- MOVEI 14, at 1(14) ; LOC(B)-1
- SUBI 14,1
- JUMPLE 13,RETURN ; IF (I.LE.0) RETURN
- MOVE 0,SWITCH
- JUMPN 0,P20 ; *****************************************
- MOVEI 11,1
- M15:MOVE 9,15 ; DO 15 L=1,I
- ADD 9,11 ; LOC(A)-1+L
- MOVE 1,11
- SUBI 1,1
- IMUL 1,13
- ADD 1,9
- MOVSI 10,^O576400
- FDVR 10,(1) ; DIAG=-1./A(L,L)
- MOVEI 8,1 ; DO 12 M=1,I
- M12:CAMN 8,11 ; IF (L.EQ.M) GO TO 12
- JRST P12
- MOVE 1,8
- SUBI 1,1
- IMUL 1,13
- ADD 1,9
- FMPRM 10,(1) ; A(L,M)=-A(L,M)/DIAG
- P12:CAMGE 8,13 ; 12 CONTINUE
- AOJA 8,M12
- MOVE 6,11
- ADDI 6,1 ; LPLUS1=L+1
- CAMLE 6,13 ; IF (LPLUS1.GT.I) GO TO 20
- JRST P20
- A:MOVEI 8,1 ; DO 15 M=1,I
- B:CAMN 8,11 ; IF (L.EQ.M) GO TO 15
- JRST P15
- MOVE 2,8
- SUBI 2,1
- IMUL 2,13
- MOVE 1,2
- ADD 1,9
- MOVE 0,(1)
- MOVE 1,11
- SUBI 1,1
- IMUL 1,13
- ADD 1,6
- ADD 1,15
- FMPR 0,(1)
- ADD 2,6
- ADD 2,15
- FADRM 0,(2) ; A(L1,M)=A(L1,M)+A(L1,L)*A(L,M)
- P15:CAMGE 8,13 ; 15 CONTINUE
- AOJA 8,B
- CAMGE 6,13
- AOJA 6,A
- CAMGE 11,13
- AOJA 11,M15
- P20:JUMPLE 12,RETURN ; IF (J.LE.0) RETURN
- MOVEI 11,1 ; DO 25 L=1,I
- C:MOVEI 10,1 ; DO 25 M=1,J
- D:MOVEI 9,1 ; DO 25 N=1,I
- E:CAMN 9,11 ; IF (L.EQ.N) GO TO 25
- JRST P25
- MOVE 1,9
- SUBI 1,1
- IMUL 1,13
- ADD 1,11
- ADD 1,15
- MOVE 0,(1)
- MOVE 1,11
- SUBI 1,1
- IMUL 1,12
- ADD 1,10
- ADD 1,14
- FMPR 0,(1)
- MOVE 1,9
- SUBI 1,1
- IMUL 1,12
- ADD 1,10
- ADD 1,14
- FADRM 0,(1) ; B(M,N)=B(M,N)+B(M,L)*A(L,N)
- P25:CAMGE 9,13 ; 25 CONTINUE
- AOJA 9,E
- CAMGE 10,12
- AOJA 10,D
- CAMGE 11,13
- AOJA 11,C
- MOVEI 10,1 ; DO 35 M=1,J
- F:MOVEI 9,1 ; DO 35 N=1,I
- G:MOVE 1,9
- SUBI 1,1
- IMUL 1,13
- ADD 1,9
- ADD 1,15
- MOVE 2,9
- SUBI 2,1
- IMUL 2,12
- ADD 2,10
- ADD 2,14
- MOVE 0,(2)
- FDVR 0,(1) ; B(M,N)=B(M,N)/A(N,N)
- MOVEM 0,(2) ;M2
- P35:CAMGE 9,13 ; 35 CONTINUE
- AOJA 9,G
- CAMGE 10,12
- AOJA 10,F
-RETURN:MOVE 13,AC15
- MOVE 14,AC16
- MOVE 15,AC17
- RADIX 8
- GOODBY
- HELLO (MXEQU1)
- SETOM 0,SWITCH
- JRST SAVE
-#include "reent1.inc"
-AC15: 0
-AC16: 0
-AC17: 0
-SWITCH:0
- PRGEND
-#ifdef CERNLIB_TCGEN_MXEQU
-#undef CERNLIB_TCGEN_MXEQU
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/mxmpy.s b/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/mxmpy.s
deleted file mode 100644
index 92cf64a..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/mxmpy.s
+++ /dev/null
@@ -1,116 +0,0 @@
-*
-* $Id: mxmpy.s,v 1.1.1.1 1996/02/15 17:53:43 mclareni Exp $
-*
-* $Log: mxmpy.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:43 mclareni
-* Kernlib
-*
-*
- TITLE MXMPY (A,B,C,I,J,K)
-;#
-; CERN PROGLIB# F110 MXMPY .VERSION KERNPDP 1.00 750903
-;#
-; SUPER FAST MATRIX MULTIPLY -- TONY LAUCK
-;ORIGINAL C.E.R.N. FORTRAN SOURCE CODE
-; SUBROUTINE MXMPY(A,B,C,I,J,K)
-; DIMENSION A(2),B(2),C(2)
-; IF((I.EQ.0).OR.(K.EQ.0)) GO TO 100
-; 13 IA=1
-; IC=1
-; DO 25 L=1,I
-; IB =1
-; DO 23 M=1,K
-; 15 C(IC)=0.
-; 18 IF (J.EQ.0) GO TO 23
-; JA=IA
-; JB=IB
-; DO 20 N=1,J
-; C(IC)=C(IC)+A(JA)*B(JB)
-; JA=JA+1
-; 20 JB=JB+K
-; IB=IB+1
-; 23 IC=IC+1
-; 25 IA=IA+J
-; 100 RETURN
-; END
-;ACCUMULATORS
-LOOP2=0
-J=1
-IA=2
-IB=3
-JA=4
-JB=5
-Q1=6
-I=7
-K=10
-Q2=11
-Q3=12
-T=13
-T1=14
-N=15
-IC=16
-P=17 ;NOT USED IN CASE OF OVERFLOW
- SEARCH HELP
-#include "reentr.inc"
- HELLO( MXMPY)
- SKIPE I, at 3(16) ;GET I,J,K
- SKIPN K, at 5(16)
- GOODBY
- SKIPN J, at 4(16) ;DO MULTIPLY IF J NOT 0
- JRST ZEROJ ;ELSE ZERO OUT C
- MOVEM 15,SAV15
- MOVEM 17,SAV17
- MOVEM 16,SAV16 ;SAVE AC 16 AND START MULTIPLY
- MOVNM K,NEGK ;SET UP -K FOR AOBJN
- MOVEM I,LCTR ;SET UP OUTER LOOP COUNTER
-;THIS CODE SETS UP THE INNER LOOP AC CODE
- MOVSI LOOP2, (MOVEI T1, ) ;START OF MIDDLE LOOP
- HRLI J, (MOVEI N, )
- MOVSI IA, (HRRI JA, )
- MOVSI IB, (HRRI JB, )
- MOVSI JA, (MOVE T, ) ;BEGIN INNER LOOP
- MOVSI JB, (FMPR T, )
- MOVE Q1, [FADR T1,T]
- HRLI I, (AOJ JA, )
- HRLI K, (ADDI JB, )
- MOVE Q2, [SOJG N,JA] ;END INNER LOOP
- MOVE Q3, [AOJA IB,ENDL2] ;GO FINISH MIDDLE LOOP
-;NOW SET UP ADDRESS OF A,B,C
- HRRI IA,@(16)
- MOVEI T , at 1(16)
- MOVEM T,BADR
- MOVEI IC, at 2(16)
- JRST BEGL3 ;GO START THE ACTION
-ENDL2: MOVEM T1,(IC) ;HERE TO END MIDDLE LOOP
- AOBJN IC,LOOP2
-ENDL3: ADDI IA,(J) ;HERE TO END OUTER LOOP
- SOSG LCTR
- JRST DONE
-BEGL3: HRR IB,BADR ;HERE TO START OUTER LOOP
- HRL IC,NEGK
- JRST LOOP2
-DONE: MOVE 16,SAV16 ;RESTORE AC 16 AND RETURN
- MOVE 15,SAV15
- MOVE 17,SAV17
- GOODBY
-ZEROJ: IMUL I,K ;HERE TO ZERO ARRAY C IF J=0
- HRRZI T, at 2(16)
- ADDI I,-1(T) ;LAST WORD ADDRESS FOR BLT
- SETZM (T) ;ZERO FIRST WORD
- HRL T,T ;MAKE BLT POINTER
- ADDI T,1
- BLT T,(I) ;CLEAR ALL OF C
- GOODBY
-#include "reent1.inc"
-SAV15: 0 ;AC 15 SAVED HERE
-SAV17: 0
-SAV16: 0 ;AC 16 SAVED HERE
-NEGK: 0 ;-K SAVED HERE
-LCTR: 0 ;OUTER LOOP COUNTER
-BADR: 0 ;ADDRESS OF B
- PRGEND
-#if defined(CERNLIB_MXFLAG1)
-#ifndef CERNLIB_MXFLAG2
-#define CERNLIB_MXFLAG2
-#endif
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/mxmpy1.s b/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/mxmpy1.s
deleted file mode 100644
index c5f73ff..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/mxmpy1.s
+++ /dev/null
@@ -1,117 +0,0 @@
-*
-* $Id: mxmpy1.s,v 1.1.1.1 1996/02/15 17:53:43 mclareni Exp $
-*
-* $Log: mxmpy1.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:43 mclareni
-* Kernlib
-*
-*
- TITLE MXMPY1 (A,B,C,I,J,K)
-;#
-; CERN PROGLIB# F110 MXMPY1 .VERSION KERNPDP 1.00 750903
-;#
-; SUPER FAST MATRIX MULTIPLY -- TONY LAUCK
-;ORIGINAL C.E.R.N. FORTRAN SOURCE CODE
-; SUBROUTINE MXMPY1(A,B,C,I,J,K)
-; DIMENSION A(2),B(2),C(2)
-; IF((I.EQ.0).OR.(K.EQ.0)) GO TO 100
-; 13 IA=1
-; IC=1
-; DO 25 L=1,I
-; IB =1
-; DO 23 M=1,K
-; 15 C(IC)=0.
-; 18 IF (J.EQ.0) GO TO 23
-; JA=IA
-; JB=IB
-; DO 20 N=1,J
-; C(IC)=C(IC)+A(JA)*B(JB)
-; JA=JA+1
-; 20 JB=JB+1
-; IB=IB+J
-; 23 IC=IC+1
-; 25 IA=IA+J
-; 100 RETURN
-; END
-;ACCUMULATORS
-LOOP2=0
-J=1
-IA=2
-IB=3
-JA=4
-JB=5
-Q1=6
-I=7
-K=10
-Q2=11
-Q3=12
-T=13
-T1=14
-N=15
-IC=16
-P=17 ;NOT USED IN CASE OF OVERFLOW
- SEARCH HELP
-#include "reentr.inc"
- HELLO( MXMPY1)
- SKIPE I, at 3(16) ;GET I,J,K
- SKIPN K, at 5(16)
- GOODBY
- SKIPN J, at 4(16) ;DO MULTIPLY IF J NOT 0
- JRST ZEROJ ;ELSE ZERO OUT C
- MOVEM 15,SAV15
- MOVEM 17,SAV17
- MOVEM 16,SAV16 ;SAVE AC 16 AND START MULTIPLY
- MOVNM K,NEGK ;SET UP -K FOR AOBJN
- MOVEM I,LCTR ;SET UP OUTER LOOP COUNTER
-;THIS CODE SETS UP THE INNER LOOP AC CODE
- MOVSI LOOP2, (MOVEI T1, ) ;START OF MIDDLE LOOP
- HRLI J, (MOVEI N, )
- MOVSI IA, (HRRI JA, )
- MOVSI IB, (HRRI JB, )
- MOVSI JA, (MOVE T, ) ;BEGIN INNER LOOP
- MOVSI JB, (FMPR T, )
- MOVE Q1, [FADR T1,T]
- HRLI I, (AOJ JA, )
- HRLI K, (AOJ JB, )
- MOVE Q2, [SOJG N,JA] ;END INNER LOOP
- MOVE Q3, [JRST ENDL2] ;GO FINISH MIDDLE LOOP
-;NOW SET UP ADDRESS OF A,B,C
- HRRI IA,@(16)
- MOVEI T, at 1(16)
- MOVEM T,BADR
- MOVEI IC, at 2(16)
- JRST BEGL3 ;GO START THE ACTION
-ENDL2: ADDI IB,(J) ;HERE TO END MIDDLE LOOP
- MOVEM T1,(IC)
- AOBJN IC,LOOP2
-ENDL3: ADDI IA,(J) ;HERE TO END OUTER LOOP
- SOSG LCTR
- JRST DONE
-BEGL3: HRR IB,BADR ;HERE TO START OUTER LOOP
- HRL IC,NEGK
- JRST LOOP2
-DONE: MOVE 16,SAV16 ;RESTORE AC 16 AND RETURN
- MOVE 15,SAV15
- MOVE 17,SAV17
- GOODBY
-ZEROJ: IMUL I,K ;HERE TO ZERO ARRAY C IF J=0
- HRRZI T, at 2(16)
- ADDI I,-1(T) ;LAST WORD ADDRESS FOR BLT
- SETZM (T) ;ZERO FIRST WORD
- HRL T,T ;MAKE BLT POINTER
- ADDI T,1
- BLT T,(I) ;CLEAR ALL OF C
- GOODBY
-#include "reent1.inc"
-SAV15: 0 ;AC 15 SAVED HERE
-SAV17: 0
-SAV16: 0 ;AC 16 SAVED HERE
-NEGK: 0 ;-K SAVED HERE
-LCTR: 0 ;OUTER LOOP COUNTER
-BADR: 0 ;ADDRESS OF B
- PRGEND
-#if defined(CERNLIB_MXFLAG2)
-#ifndef CERNLIB_MXFLAG3
-#define CERNLIB_MXFLAG3
-#endif
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/mxmpy2.s b/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/mxmpy2.s
deleted file mode 100644
index 40cd029..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/mxmpy2.s
+++ /dev/null
@@ -1,116 +0,0 @@
-*
-* $Id: mxmpy2.s,v 1.1.1.1 1996/02/15 17:53:43 mclareni Exp $
-*
-* $Log: mxmpy2.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:43 mclareni
-* Kernlib
-*
-*
- TITLE MXMPY2 (A,B,C,I,J,K)
-;#
-; CERN PROGLIB# F110 MXMPY2 .VERSION KERNPDP 1.00 750903
-;#
-; SUPER FAST MATRIX MULTIPLY -- TONY LAUCK
-;ORIGINAL C.E.R.N. FORTRAN SOURCE CODE
-; SUBROUTINE MXMPY2(A,B,C,I,J,K)
-; DIMENSION A(2),B(2),C(2)
-; IF((I.EQ.0).OR.(K.EQ.0)) GO TO 100
-; 13 IA=1
-; IC=1
-; DO 25 L=1,I
-; IB =1
-; DO 23 M=1,K
-; 15 C(IC)=0.
-; 18 IF (J.EQ.0) GO TO 23
-; JA=IA
-; JB=IB
-; DO 20 N=1,J
-; C(IC)=C(IC)+A(JA)*B(JB)
-; JA=JA+I
-; 20 JB=JB+K
-; IB=IB+1
-; 23 IC=IC+1
-; 25 IA=IA+1
-; 100 RETURN
-; END
-;ACCUMULATORS
-LOOP2=0
-J=1
-IA=2
-IB=3
-JA=4
-JB=5
-Q1=6
-I=7
-K=10
-Q2=11
-Q3=12
-T=13
-T1=14
-N=15
-IC=16
-P=17 ;NOT USED IN CASE OF OVERFLOW
- SEARCH HELP
-#include "reentr.inc"
- HELLO( MXMPY2)
- SKIPE I, at 3(16) ;GET I,J,K
- SKIPN K, at 5(16)
- GOODBY
- SKIPN J, at 4(16) ;DO MULTIPLY IF J NOT 0
- JRST ZEROJ ;ELSE ZERO OUT C
- MOVEM 15,SAV15
- MOVEM 17,SAV17
- MOVEM 16,SAV16 ;SAVE AC 16 AND START MULTIPLY
- MOVNM K,NEGK ;SET UP -K FOR AOBJN
- MOVEM I,LCTR ;SET UP OUTER LOOP COUNTER
-;THIS CODE SETS UP THE INNER LOOP AC CODE
- MOVSI LOOP2, (MOVEI T1, ) ;START OF MIDDLE LOOP
- HRLI J, (MOVEI N, )
- MOVSI IA, (HRRI JA, )
- MOVSI IB, (HRRI JB, )
- MOVSI JA, (MOVE T, ) ;BEGIN INNER LOOP
- MOVSI JB, (FMPR T, )
- MOVE Q1, [FADR T1,T]
- HRLI I, (ADDI JA, )
- HRLI K, (ADDI JB, )
- MOVE Q2, [SOJG N,JA] ;END INNER LOOP
- MOVE Q3, [AOJA IB,ENDL2] ;GO FINISH MIDDLE LOOP
-;NOW SET UP ADDRESS OF A,B,C
- HRRI IA,@(16)
- MOVEI T, at 1(16)
- MOVEM T,BADR
- MOVEI IC, at 2(16)
- JRST BEGL3 ;GO START THE ACTION
-ENDL2: MOVEM T1,(IC) ;HERE TO END MIDDLE LOOP
- AOBJN IC,LOOP2
-ENDL3: ADDI IA,1 ;HERE TO END OUTER LOOP
- SOSG LCTR
- JRST DONE
-BEGL3: HRR IB,BADR ;HERE TO START OUTER LOOP
- HRL IC,NEGK
- JRST LOOP2
-DONE: MOVE 16,SAV16 ;RESTORE AC 16 AND RETURN
- MOVE 15,SAV15
- MOVE 17,SAV17
- GOODBY
-ZEROJ: IMUL I,K ;HERE TO ZERO ARRAY C IF J=0
- HRRZI T, at 2(16)
- ADDI I,-1(T) ;LAST WORD ADDRESS FOR BLT
- SETZM (T) ;ZERO FIRST WORD
- HRL T,T ;MAKE BLT POINTER
- ADDI T,1
- BLT T,(I) ;CLEAR ALL OF C
- GOODBY
-#include "reent1.inc"
-SAV15: 0 ;AC 15 SAVED HERE
-SAV17: 0
-SAV16: 0 ;AC 16 SAVED HERE
-NEGK: 0 ;-K SAVED HERE
-LCTR: 0 ;OUTER LOOP COUNTER
-BADR: 0 ;ADDRESS OF B
- PRGEND
-#if defined(CERNLIB_MXFLAG3)
-#ifdef CERNLIB_TCGEN_MXMAD
-#undef CERNLIB_TCGEN_MXMAD
-#endif
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/pkchar.s b/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/pkchar.s
deleted file mode 100644
index 846f807..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/pkchar.s
+++ /dev/null
@@ -1,125 +0,0 @@
-*
-* $Id: pkchar.s,v 1.1.1.1 1996/02/15 17:53:43 mclareni Exp $
-*
-* $Log: pkchar.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:43 mclareni
-* Kernlib
-*
-*
- TITLE PKCHAR (INT,CHAR,N,IPAR)
-;#
-; CERN PROGLIB# M427 PKCHAR .VERSION KERNPDP 1.00 750903
-;#
- ;IPAR(1)= NBITS
- ;IPAR(2)= NCHAR PER ZONE
- ;IPAR(3)= NBITS PER ZONE
- ;IPAR(4)=NIGN
- ;IPAR(5)= NFILL
- ;ACCUMULATORS:
- N=1
- NFILL=2
- ZERO=3
- NIGN=4
- NBITS=5
- TRAIL=7
- NCHAR=10
- BPT=11
- COUNT1=12
- TEMP=13
- TEMP1=14
- P=15
- WDCOUN=17
-.COMMON SLATE [50]
- SEARCH HELP
-#include "reentr.inc"
- HELLO( PKCHAR)
- MOVEM P,SAV15
- MOVEM WDCOUN,SAV17
- MOVN N, at 2(16) ;GET N,RETURN FOR =0
- JUMPE N,RETURN
- MOVEI 02, at 3(16) ;AC2=ADR OF IPAR
- SKIPN 03,2(02) ;AC3 = NZONE,SKIP FOR = 0
- MOVEI 03,44 ;NZONE =36
- MOVE NIGN,3(2)
- MOVE NBITS,(02) ;GET NBITS
- MOVE 06,03 ;AC6= NZONE
- SUB 06,NIGN ;AC6=
- IDIV 06,NBITS ;(NZONE-NIGN)/NBITS
- SKIPN 10,1(02) ;GET NCHAR,SKIP FOR =0
- MOVE 10,06 ;NCHAR=MAXIMUM
- CAMGE 6,10 ;SET NCHAR TO THE
- MOVE 10,6 ;MAX IF NEEDED
- MOVNS 10
- MOVE COUNT1,10
- HRLI COUNT1,@(16) ;COUNT1
- MOVSS COUNT1
- MOVEI WDCOUN,1 ;START WDCOUNT
- MOVE NFILL,4(02) ;GET NFILL
- HRRZI BPT, at 1(16) ;GET ADDR OF CHAR
- MOVEM NFILL,(BPT) ;FILL 1ST WORD
- HRRZI P,44 ;CALCULATE POSITION
- SUBI P,(NIGN) ;OF FIRST BYTE
- DPB NBITS,[POINT 6,BPT,11]
- DPB P ,[POINT 6,BPT,5]
- CAIE 03,44 ;COMPARE NZONE WITH 36
- JUMPA ,WAY2 ;THEN GO WAY2
-LOOP1: MOVE TEMP,(COUNT1);GET INTEGER
- IDPB TEMP,BPT ;STORE BYTE
- AOJGE N,FINISH ;ASK FOR END
- AOBJN COUNT1,LOOP1 ;ASK FOR END OF WORD
- ADDI WDCOUN,1 ;INCREMENT WORDCOUNT
- HRL COUNT1,NCHAR ;RESET CHAR COUNT
- ADDI BPT,1 ;BUMP ADDRESS
- MOVEM NFILL,(BPT) ;FILL NEXT WORD
- DPB P,[POINT 6,BPT,5]
- JUMPA LOOP1
-FINISH: MOVEM WDCOUN,SLATE
-RETURN: MOVE P,SAV15
- MOVE WDCOUN,SAV17
- GOODBY
-WAY2: SETZ ZERO, ;CLEAR AC3
- SETZ TEMP,
- SETZ TEMP1,
- ADD 6,NCHAR ;CORRECT
- IMUL 6,NBITS ;TRAILING
- ADD TRAIL,6 ;BITS
- ADD TRAIL,NIGN
-LOOP2: MOVE TEMP,(COUNT1) ;GET INTEGER
- SUB P,NBITS ;PREPARE P
- JUMPL P,WDEND ;CHECK FOR END OF WORD
- DPB P,[POINT 6,BPT,5]
- DPB TEMP,BPT ;STORE BYTE
- AOJGE N,FINISH ;ASK FOR END
- AOBJN COUNT1,LOOP2 ;LOOP BACK IF NOT END OF ZONE
-ZONEND: HRL COUNT1,NCHAR ;RESTORE COUNT
- SUB P,TRAIL ;JUMP OVER TRAILINGS
- JUMPGE P,LOOP2 ;END OF WORD?
- MOVEI P,44(P) ;P=36-P
- ADDI BPT,1
- ADDI WDCOUN,1 ;BUMP WORD COUNTER
- JUMPA ,LOOP2 ;LOOP BACK
-WDEND: LSHC TEMP,(P) ;SHIFT OVER END OF WORD
- ADD P,NBITS ;BUMP P
- DPB P,[POINT 6,BPT,11]
- DPB ZERO,[POINT 6,BPT,5]
- DPB TEMP,BPT ;DEPOSIT THE BYTE
- MOVNS P ;GET P= NBITS-P
- ADD P,NBITS
- LSHC TEMP,(P) ;SHIFT BACK
- ADDI BPT,1
- DPB P,[POINT 6,BPT,11]
- SUBI P,44 ;CALCULATE
- MOVNS P ;NEW P
- DPB P,[POINT 6,BPT,5] ;STORE NEW POSITION
- MOVEM NFILL,(BPT) ;FILL NEXT WORD
- DPB TEMP,BPT ;STORE RIGHT HALF
- DPB NBITS,[POINT 6,BPT,11] ;RESTORE BYTE LENGTH
- ADDI WDCOUN,1 ;BUMP WORD COUNTER
- JUMPA ,LOOP2+5 ;JOIN NORMAL WAY
-#include "reent1.inc"
-SAV15: 0
-SAV17: 0
- PRGEND
-#ifdef CERNLIB_TCGEN_PKCHAR
-#undef CERNLIB_TCGEN_PKCHAR
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/proxim.s b/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/proxim.s
deleted file mode 100644
index e003678..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/proxim.s
+++ /dev/null
@@ -1,52 +0,0 @@
-*
-* $Id: proxim.s,v 1.1.1.1 1996/02/15 17:53:43 mclareni Exp $
-*
-* $Log: proxim.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:43 mclareni
-* Kernlib
-*
-*
- TITLE PROXIM
-;#
-; CERN PROGLIB# B102 PROXIM .VERSION KERNPDP 1.00 750903
-;#
-#include "reentr.inc"
- SEARCH HELP
-; WRITTEN P. SCHMITZ
- HELLO (PROXIM)
- MOVEM A01,AC01
- MOVEM A02,AC02
- MOVEM A03,AC03
- MOVE , at 0(A16)
-P10: MOVEM ,A01
- FSBR A01, at 1(A16)
- JUMPG A01,P30
- JUMPE A01,P99
- MOVE A02,PI
- FADR A02,A01
- JUMPGE A02,P99
-P21: FADR ,PI2
- JRST ,P10
-P30: MOVE A03,PI
- FSBR A03,A01
- JUMPGE A03,P99
-P31: FSBR ,PI2
- JRST ,P10
-P99: MOVE A01,AC01
- MOVE A02,AC02
- MOVE A03,AC03
- GOODBY
-PI: EXP ^D3.14159265
-PI2: EXP ^D6.28318530
- A01= 1
- A02= 2
- A03= 3
- A16=16
-#include "reent1.inc"
-AC01: 0
-AC02: 0
-AC03: 0
- PRGEND
-#ifdef CERNLIB_TCGEN_PROXIM
-#undef CERNLIB_TCGEN_PROXIM
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/reent1.inc b/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/reent1.inc
deleted file mode 100644
index 8746deb..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/reent1.inc
+++ /dev/null
@@ -1,11 +0,0 @@
-*
-* $Id: reent1.inc,v 1.1.1.1 1996/02/15 17:53:41 mclareni Exp $
-*
-* $Log: reent1.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:53:41 mclareni
-* Kernlib
-*
-*
-*
-* reent1.inc
-*
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/reentr.inc b/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/reentr.inc
deleted file mode 100644
index 71d6396..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/reentr.inc
+++ /dev/null
@@ -1,11 +0,0 @@
-*
-* $Id: reentr.inc,v 1.1.1.1 1996/02/15 17:53:41 mclareni Exp $
-*
-* $Log: reentr.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:53:41 mclareni
-* Kernlib
-*
-*
-*
-* reentr.inc
-*
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/rot.s b/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/rot.s
deleted file mode 100644
index fe90fd4..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/rot.s
+++ /dev/null
@@ -1,65 +0,0 @@
-*
-* $Id: rot.s,v 1.1.1.1 1996/02/15 17:53:43 mclareni Exp $
-*
-* $Log: rot.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:43 mclareni
-* Kernlib
-*
-*
- TITLE ROT
-;#
-; CERN PROGLIB# F118 ROT .VERSION KERNPDP 1.00 750903
-; ORIG. P. SCHMITZ, AACHEN, 3/9/1975
-;#
-#include "reentr.inc"
- SEARCH HELP
- EXTERN SIN,COS
-.COMMON SLATE [50]
- HELLO (ROT)
- HRRZI ,ACSAV ;SAVE AC'S
- BLT ,ACSAV+7
- MOVE , at 1(A16)
- MOVEM ,TEMP
- ENTER (COS)
- JUMP ,TEMP
- MOVEI A02,SLATE
- MOVEM ,2(A02)
- ENTER (SIN)
- JUMP ,TEMP
- MOVEM ,3(A02)
- MOVEI A03, at 0(A16) ;ADR(A)
- MOVEI A04, at 2(A16) ;ADR(B)
- MOVE A06,0(A03) ;B1=A(1)*COSTH-A(2)*SINTH
- FMPR A06,2(A02)
- MOVE ,1(A03)
- FMPR ,3(A02)
- FSBR A06,
- MOVE A07,0(A03) ;B2=A(1)*SINTH+A(2)*COSTH
- FMPR A07,3(A02)
- MOVE ,1(A03)
- FMPR ,2(A02)
- FADR A07,
- MOVEM A06,0(A02) ;B(3)=A(3)
- MOVEM A07,1(A02)
- MOVEM A06,0(A04) ;B(2)=B2
- MOVEM A07,1(A04)
- MOVE ,2(A03) ;B(1)=B1
- MOVEM ,2(A04)
- HRLZI ,ACSAV ;RESTORE AC'S, EXIT
- BLT ,7
- GOODBY
-#include "reent1.inc"
-ACSAV: BLOCK 10
-TEMP: 0
- A01= 1
- A02= 2
- A03= 3
- A04= 4
- A05= 5
- A06= 6
- A07= 7
- A16=16
- PRGEND
-#ifdef CERNLIB_TCGEN_ROT
-#undef CERNLIB_TCGEN_ROT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/sbit.s b/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/sbit.s
deleted file mode 100644
index 81a9727..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/sbit.s
+++ /dev/null
@@ -1,48 +0,0 @@
-*
-* $Id: sbit.s,v 1.1.1.1 1996/02/15 17:53:44 mclareni Exp $
-*
-* $Log: sbit.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:44 mclareni
-* Kernlib
-*
-*
- TITLE SBIT (A,X,LX)
-;#
-; CERN PROGLIB# M421 SBIT .VERSION KERNPDP 1.00 750903
-;#
- ;COPIES BIT 1 FROM A INTO
- ;BIT LX OF X
- TEMP= 1
- BIT= 2
- IPT=3
- SEARCH HELP
-#include "reentr.inc"
- HELLO( SBIT)
- MOVE BIT,@(16)
- HRRZI IPT, at 1(16)
- MOVE TEMP, at 2(16)
-ENTR: SUBI TEMP,1
- HRLI IPT,100
- DPB TEMP,[POINT 6,IPT,5]
- DPB BIT,IPT
- GOODBY
- HELLO( SBIT1)
- MOVE TEMP, at 1(16)
- HRRZI IPT,@(16)
- MOVEI BIT,1
- JUMPA ENTR
- HELLO( SBIT0)
- HRRZI IPT,@(16)
- MOVE TEMP, at 1(16)
- SETZ BIT,
- JUMPA ENTR
- PRGEND
-#ifdef CERNLIB_TCGEN_SBIT
-#undef CERNLIB_TCGEN_SBIT
-#endif
-#ifdef CERNLIB_TCGEN_SBIT0
-#undef CERNLIB_TCGEN_SBIT0
-#endif
-#ifdef CERNLIB_TCGEN_SBIT1
-#undef CERNLIB_TCGEN_SBIT1
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/sbyt.s b/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/sbyt.s
deleted file mode 100644
index db58ce5..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/sbyt.s
+++ /dev/null
@@ -1,45 +0,0 @@
-*
-* $Id: sbyt.s,v 1.1.1.1 1996/02/15 17:53:44 mclareni Exp $
-*
-* $Log: sbyt.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:44 mclareni
-* Kernlib
-*
-*
- TITLE SBYT (A,X,LX,NBITS)
-;#
-; CERN PROGLIB# M421 SBYT .VERSION KERNPDP 1.00 750903
-;#
- ;PUTS THE FIRST 'NBITS' BITS OF A IN X AT LX
- ;LX COUNTED FROM RIGHT STARTING WITH 1
- ;ACCUMULATORS:
- MASK=1
- NBITS=2
- LX=3
- X=4
- TEMP=5
- SEARCH HELP
-#include "reentr.inc"
- HELLO( SBYT)
- MOVE NBITS, at 3(16) ;GET NBITS
- SETO MASK, ;PREPARE MASK
- LSH MASK,(NBITS)
- ANDCA MASK,@(16) ;LOAD BITS FROM A
- MOVE LX, at 2(16)
- SETZ TEMP, ;PREPARE COUNTERS
- SUBI TEMP,(NBITS)
- SUBI TEMP,(LX)
- MOVE X, at 1(16) ;GET A
- ROT X,1(TEMP)
- LSH X,(NBITS)
- MOVEM X,SECO
- IOR MASK,SECO
- ROT MASK,-1(LX) ;GET RESULT
- MOVEM MASK, at 1(16) ; AND STORE IT AWAY
-RETURN: GOODBY
-#include "reent1.inc"
-SECO: 0
- PRGEND
-#ifdef CERNLIB_TCGEN_SBYT
-#undef CERNLIB_TCGEN_SBYT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/timed.s b/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/timed.s
deleted file mode 100644
index 9a76bf1..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/timed.s
+++ /dev/null
@@ -1,35 +0,0 @@
-*
-* $Id: timed.s,v 1.1.1.1 1996/02/15 17:53:44 mclareni Exp $
-*
-* $Log: timed.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:44 mclareni
-* Kernlib
-*
-*
- TITLE TIMED
-;#
-; CERN PROGLIB# Z007 TIMED .VERSION KERNPDP 1.02 761001
-;#
- SEARCH HELP
-#include "reentr.inc"
- EXTERNAL TIMEX
- T1==1
- T2==2
- HELLO(TIMED)
- ENTER(TIMEX,ARG) ;GET RUNTIME
- MOVE T2,TIME
- MOVE T1,OLDT ;GET LAST TIME
- FSBR T2,T1 ;SUBTRACT
- MOVEM T2,@(16)
- MOVE T2,TIME ;GET TIME
- MOVEM T2,OLDT ;STORE NEW TIME AS OLD TIME
- GOODBY
- -1
-#include "reent1.inc"
-ARG: TIME
-TIME: 0
-OLDT: 0
- PRGEND
-#ifdef CERNLIB_TCGEN_TIMED
-#undef CERNLIB_TCGEN_TIMED
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/timel.s b/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/timel.s
deleted file mode 100644
index 07be1ef..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/timel.s
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: timel.s,v 1.1.1.1 1996/02/15 17:53:44 mclareni Exp $
-*
-* $Log: timel.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:44 mclareni
-* Kernlib
-*
-*
- TITLE TIMEL
-;#
-; CERN PROGLIB# Z007 TIMEL .VERSION KERNPDP 1.02 761001
-;#
-;THIS ROUTINE IS ONLY USEFUL FOR JOBS WHICH RUN UNDER
-;BATCH, AS THIS IS THE ONLY CASE IN WHICH TIMELIMIT IS USED.
- SEARCH HELP
-#include "reentr.inc"
- T1==1
- T2==2
- T3==3
- HELLO(TIMEL)
- MOVE T1,[XWD -1,40]
- GETTAB T1,
- JRST ERROR
- MOVE T2,[POINT 12,T1,24]
- LDB T3,T2 ;GET TIME IN JIFFIES
- IMULI T3,^D20 ;MAKE MILLISECONDS
- FSC T3,233 ;MAKE FLOATING POINT
- FDVRI T3,212764 ;DIVIDE BY 1000
- MOVEM T3,@(16)
-ERROR: GOODBY
- PRGEND
-#ifdef CERNLIB_TCGEN_TIMEL
-#undef CERNLIB_TCGEN_TIMEL
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/timex.s b/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/timex.s
deleted file mode 100644
index a60687f..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/timex.s
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: timex.s,v 1.1.1.1 1996/02/15 17:53:44 mclareni Exp $
-*
-* $Log: timex.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:44 mclareni
-* Kernlib
-*
-*
- TITLE TIMEX
-;#
-; CERN PROGLIB# Z007 TIMEX .VERSION KERNPDP 1.02 761001
-;#
-; FOR 50 HZ CLOCK
- SEARCH HELP
-#include "reentr.inc"
- T0==1
- T1==2
- T1==2
- HELLO(TIMEX)
- PJOB T0, ;GET JOBNUMBER
- JUMPE T0,ERROR ;NO JOB
- RUNTIM T0, ;GET RUNTIME OF THE JOB
- FSC T0,233 ;MAKE FLOATING POINT
- FDVRI T0,212764 ;DIVID BY 1000
- MOVEM T0,@(16)
- GOODBY
-ERROR: OUTSTR [ASCIZ/NO JOB
- /]
- PRGEND
-#ifdef CERNLIB_TCGEN_TIMEX
-#undef CERNLIB_TCGEN_TIMEX
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/tracq.s b/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/tracq.s
deleted file mode 100644
index 5cb6e76..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/tracq.s
+++ /dev/null
@@ -1,105 +0,0 @@
-*
-* $Id: tracq.s,v 1.1.1.1 1996/02/15 17:53:44 mclareni Exp $
-*
-* $Log: tracq.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:44 mclareni
-* Kernlib
-*
-*
- TITLE TRACQ
-;#
-; CERN PROGLIB# N105 TRACEQ .VERSION KERNPDP 1.00 750903
-;#
-#include "reentr.inc"
- ENTRY TRAC1Q,TRAC2Q
- EXTERNAL .JBREL,.JBDA
-.COMMON SLATE [50]
- T1==1
- PRVLVL==2
- T2==3
- T3==4
- T4==5
- T5==6
-TRAC1Q: JRST 0,.+5
- SETOM F40
- MOVE T1,TRAC1Q ;F40 TAKES INITIAL ROUTINE ENTRY
- ;FROM TRAC1Q
- MOVEM T1,THSLVL
- JRA 16,(16)
- MOVE PRVLVL,17 ;GET PUSHDOWN POINTER
- POP PRVLVL,T1 ;LAST ENTRY WE DO NOT NEED
- MOVEM PRVLVL,THSLVL ;STORE THAT POINTER
- POPJ 17,0
-TRAC2Q: JRST 0,F10
- HLRZ T1,THSLVL ;GET ADDRESS OF ROUTINE CALLING THIS LEVEL
- JUMPE T1,EXIT ;BACK AT MAIN PROGRAM IF ZERO
- CAILE T1,.JBDA ;CHECK THE ADDRESS IS REASONABLE
- CAMLE T1,.JBREL
- JRST TRCERR ;NO GOOD
- MOVE PRVLVL,(T1) ;ELSE GET PREVIOUS ROUTINE ENTRY
- HRRZ T1,THSLVL ;GET ADDRESS TO RETURN TO 2 LEVELS BACK
-CHECK: CAILE T1,.JBDA ;CHECK ADRESS IS REASONABLE
- CAMLE T1,.JBREL
- JRST TRCERR ;SOMETHING WRONG
- MOVEM T1,STOCK
- MOVE T1,F40
- CAIE T1,0
- JRST ROUT40
- JRST ROUT10
-RETUR: SETZM SLATE+2
- MOVE T1,STOCK
- SUBI T1,1 ;BACK OFF ONE LOCATION
- MOVEM T1,SLATE+3 ;THAT'S THE ADDRESS
- SETZM SLATE+4 ;AND IT IS A NORMAL RETURN
- MOVEM PRVLVL,THSLVL ;SO BACK ONE STEP READY FOR THE NEXT CALL
- JRST RETURN
-EXIT: MOVEI T1,1
- MOVEM T1,SLATE+4
-RETURN: SKIPE F40
- JRA 16,(16)
- POPJ 17,0
-TRCERR: SETOM SLATE+4 ;TAKE ERROR RETURN
- JRST RETURN
-F10: MOVE PRVLVL,THSLVL ;GET CURRENT POINTER
- POP PRVLVL,T1 ;GET WHAT IT POINTS TO
- TLZ T1,777777 ;CLEAR OF CALLING ADDRESS
- HLRZ T2,PRVLVL ;TEST FOR LAST OF STACK
- CAIN T2,-100
- JRST EXIT
- MOVEM PRVLVL,THSLVL
- JRST CHECK
-ROUT40: SETZM SLATE
- SETZM SLATE+1
- JRST RETUR
-ROUT10: MOVE T1,THSLVL
- MOVEM T1,COUNT
- HRRZ T2,COUNT
- MOVE T1,(T2)
- MOVEM T1,COUNT
- HRRZ T3,COUNT
- SOJ T3,
- MOVE T2,(T3)
- MOVEM T2,COUNT
- HRRZ T1,COUNT
- SOJ T1,
- SETZM COUNT
- MOVE T2,(T1)
- MOVE T4,[POINT 7,SLATE]
- MOVE T3,[POINT 6,T2]
-NEXTCH: ILDB T1,T3
- ADDI T1,40
- IDPB T1,T4
- AOS T5,COUNT
- CAIE T5,5
- JRST NEXTCH
- MOVE T4,[POINT 7,SLATE+1]
- ILDB T1,T3
- ADDI T1,40
- IDPB T1,T4
- JRST RETUR
-#include "reent1.inc"
-STOCK: 0
-COUNT: 0
-F40: 0
-THSLVL: 0
- PRGEND
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/ublank.s b/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/ublank.s
deleted file mode 100644
index b46e8ba..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/ublank.s
+++ /dev/null
@@ -1,40 +0,0 @@
-*
-* $Id: ublank.s,v 1.1.1.1 1996/02/15 17:53:44 mclareni Exp $
-*
-* $Log: ublank.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:44 mclareni
-* Kernlib
-*
-*
- TITLE UBLANK (IV,JL,JR)
-;#
-; CERN PROGLIB# V300 UBLANK .VERSION KERNPDP 1.00 750903
-;#
-;ACCUMULATORS:
- JL=1
- JR=2
- B=3
- F=4
- T=5
- SEARCH HELP
-#include "reentr.inc"
- HELLO( UBLANK)
- MOVE T,[ASCII / /] ;GET 5 BLANKS
- HRRZI B,@(16) ;LOAD @ADR. OF IV
- MOVE JL, at 1(16) ;LOAD JL
- MOVE JR, at 2(16) ;LOAD JR
- CAIG JR,(JL) ;WORRY at ABOUT
- JRST ONCE ;ONE PASS?THROUGH
- ADDI JR,-1(B) ;ADR. OF IV(JR)
- ADDI B,(JL) ;ADR.?OF at IV(JL+1)
- HRLI B,-1(B) ; BLT POINTER
- MOVEM T,-1(B) ;BLANK?1ST WORD
- BLT B,(JR) ;BLT at BLANKS
- GOODBY
-ONCE: ADDI B,-1(JL) ;ADR.?OF?IV(JL)
- MOVEM T,(B) ;BLANK 1 WORD
- GOODBY
- PRGEND
-#ifdef CERNLIB_TCGEN_UBLANK
-#undef CERNLIB_TCGEN_UBLANK
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/ublow.s b/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/ublow.s
deleted file mode 100644
index c616127..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/ublow.s
+++ /dev/null
@@ -1,38 +0,0 @@
-*
-* $Id: ublow.s,v 1.1.1.1 1996/02/15 17:53:44 mclareni Exp $
-*
-* $Log: ublow.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:44 mclareni
-* Kernlib
-*
-*
- TITLE UBLOW (A5,A1,N)
-;#
-; CERN PROGLIB# M409 UBLOW .VERSION KERNPDP 1.02 761001
-;#
- ;ACCUMULATORS:
- BPT=0
- COUNT=1
- TEMP=2
- TEMP1=3
- SEARCH HELP
-#include "reentr.inc"
- HELLO( UBLOW)
- MOVN COUNT, at 2(16)
- JUMPGE COUNT,RETURN
- HRLZI BPT,440700 ;INIT BYTE POINTER
- HRRI BPT,@(16) ;LOAD ADR. OF A5
- HRLZI COUNT,(COUNT) ;THE COUNTER
- HRRI COUNT, at 1(16) ;WORD
- MOVE TEMP,BLANK
-LOOP: ILDB TEMP1,BPT
- DPB TEMP1,[POINT 7,(COUNT),6]
- DPB TEMP,[POINT 29,(COUNT),35]
- AOBJN COUNT,LOOP ;LOOP
-RETURN: GOODBY
-#include "reent1.inc"
-BLANK: ASCII/ / ;WORD OF BLANKS
- PRGEND
-#ifdef CERNLIB_TCGEN_UBLOW
-#undef CERNLIB_TCGEN_UBLOW
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/ubunch.s b/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/ubunch.s
deleted file mode 100644
index 04c91d8..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/ubunch.s
+++ /dev/null
@@ -1,106 +0,0 @@
-*
-* $Id: ubunch.s,v 1.1.1.1 1996/02/15 17:53:44 mclareni Exp $
-*
-* $Log: ubunch.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:44 mclareni
-* Kernlib
-*
-*
- TITLE UBUNCH (IN,OUT,NCH)
-;#
-; CERN PROGLIB# M409 UBUNCH .VERSION KERNPDP 1.01 760321
-;#
-; NEW VERSION: CLEAR BIT 35, SPEED. D.BERTRAND, JZ
- A1=1
- A2=2
- JIN=3
- JOUT=4
- NCH=5
- NEND=6
- NSTOP=7
-;--
- SEARCH HELP
-#include "reentr.inc"
- HELLO (UBUNCH)
-;--
- HRRZI JIN,@(16) ;JIN = ADR(IN(1))
- HRRZI JOUT, at 1(16) ;JOUT = ADR(OUT(1))
- MOVE NCH, at 2(16) ;NCH
- CAIL NCH,5
- JRST CH5M ; JUMP FOR NCH .GE. 5
- JUMPL NCH,BRANCH ; JUMP FOR NCH .LT. 0
- MOVE A1,BLANK
- JRST @BRANCH(NCH)
-;--
-;---- NCH = 1, 2, 3, 4 CHARACTERS
-CH1: MOVE A2,(JIN)
- LSHC A1,7
- ROT A1,-7
- JRST RETURN
-;--
-CH2: MOVE A2,(JIN)
- LSHC A1,7
- MOVE A2,1(JIN)
- LSHC A1,7
- ROT A1,-16
- JRST RETURN
-;--
-CH3: MOVE A2,(JIN)
- LSHC A1,7
- MOVE A2,1(JIN)
- LSHC A1,7
- MOVE A2,2(JIN)
- LSHC A1,7
- ROT A1,17
- JRST RETURN
-;--
-CH4: MOVE A2,(JIN)
- LSHC A1,7
- MOVE A2,1(JIN)
- LSHC A1,7
- MOVE A2,2(JIN)
- LSHC A1,7
- MOVE A2,3(JIN)
- LSHC A1,7
- ROT A1,10
- JRST RETURN
-;--
-;---- NCH = 5 OR MORE CHARACTERS
-CH5M: MOVE NEND,JIN
- ADD NEND,NCH ;NEND = JIN+NCH = ADR(IN(NCH+1))
- MOVEI NSTOP,-4(NEND) ;NSTOP= JIN+NCH-4 = LOOP STOP ADR
-LOOP: MOVE A2,(JIN)
- LSHC A1,7
- MOVE A2,1(JIN)
- LSHC A1,7
- MOVE A2,2(JIN)
- LSHC A1,7
- MOVE A2,3(JIN)
- LSHC A1,7
- MOVE A2,4(JIN)
- LSHC A1,7
- LSH A1,1
- MOVEM A1,(JOUT)
-;--
- ADDI JOUT,1 ; BUMP JOUT: ADR (OUT(NEXT)
- ADDI JIN,5 ; BUMP JIN : ADR (IN(NEXT))
- CAMGE JIN,NSTOP
- JRST LOOP ; LOOP UNTIL JIN .GE. NSTOP
- MOVE NCH,NEND
- SUB NCH,JIN ;NCH = NEND-JIN = NO OF CHAR. REMAINING
- MOVE A1,BLANK
- JRST @BRANCH(NCH)
-;--
-RETURN:MOVEM A1,(JOUT)
-CH0: GOODBY
-;--
-BLANK: ASCII/ /
-BRANCH:XWD 0,CH0
- XWD 0,CH1
- XWD 0,CH2
- XWD 0,CH3
- XWD 0,CH4
- PRGEND
-#ifdef CERNLIB_TCGEN_UBUNCH
-#undef CERNLIB_TCGEN_UBUNCH
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/ucocop.s b/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/ucocop.s
deleted file mode 100644
index 6421420..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/ucocop.s
+++ /dev/null
@@ -1,49 +0,0 @@
-*
-* $Id: ucocop.s,v 1.1.1.1 1996/02/15 17:53:44 mclareni Exp $
-*
-* $Log: ucocop.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:44 mclareni
-* Kernlib
-*
-*
- TITLE UCOCOP
-;#
-; CERN PROGLIB# V302 UCOCOP .VERSION KERNPDP 1.00 750903
-;#
-#include "reentr.inc"
- SEARCH HELP
- HELLO (UCOCOP)
- SKIPG , at 2(A16)
- GOODBY
- SKIPG , at 3(A16)
- GOODBY
- HRRZI ,ACSAVE ;SAVE AC'S
- BLT ,ACSAVE+4
- HRLI A01, at 0(A16) ;BLT POINTER [A,B] IN AC 1
- HRRI A01, at 1(A16)
- HRL A02, at 4(A16) ;INCREMENT OF BLT WORD
- HRR A02, at 5(A16)
- MOVE , at 2(A16) ;LOOP COUNT IDO
- MOVEI A03, at 1(A16) ;FINAL BLT ADDRESS
- SOS ,A03
- ADD A03, at 3(A16)
- MOVEM A01,A04 ;SAVE BLT POINTER IF INTERRUPT
-LOOP: BLT A01,(A03) ;CONTRACT VECTOR A INTO B
- ADD A04,A02
- MOVEM A04,A01
- ADD A03, at 5(A16)
- SOJG ,LOOP
- HRLZI ,ACSAVE ;RESTORE AC'S, EXIT
- BLT ,4
- GOODBY
- A01= 1
- A02= 2
- A03= 3
- A04= 4
- A16=16
-#include "reent1.inc"
-ACSAVE:BLOCK 5
- PRGEND
-#ifdef CERNLIB_TCGEN_UCOCOP
-#undef CERNLIB_TCGEN_UCOCOP
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/ucopy.s b/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/ucopy.s
deleted file mode 100644
index 8da0f42..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/ucopy.s
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: ucopy.s,v 1.1.1.1 1996/02/15 17:53:44 mclareni Exp $
-*
-* $Log: ucopy.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:44 mclareni
-* Kernlib
-*
-*
- TITLE UCOPY (A,B,N)
-;#
-; CERN PROGLIB# V301 UCOPY .VERSION KERNPDP 1.00 750903
-;#
-;ACCUMULATORS:
- N=1
- B=2
- J=3
- SEARCH HELP
-#include "reentr.inc"
- HELLO( UCOPY)
- SKIPG N, at 2(16) ;LOAD N, SKIP IF >0
- JRST RETURN
- HRLZI B,@(16) ;FORM BLT POINER
- HRRI B, at 1(16)
- MOVEI J,(B) ;GET LAST WORD ADDRESS
- ADDI J,-1(N)
- BLT B,(J) ;DO TRANSFER
-RETURN: GOODBY
- PRGEND
-#ifdef CERNLIB_TCGEN_UCOPY
-#undef CERNLIB_TCGEN_UCOPY
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/ucopy2.s b/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/ucopy2.s
deleted file mode 100644
index d619d0d..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/ucopy2.s
+++ /dev/null
@@ -1,46 +0,0 @@
-*
-* $Id: ucopy2.s,v 1.1.1.1 1996/02/15 17:53:44 mclareni Exp $
-*
-* $Log: ucopy2.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:44 mclareni
-* Kernlib
-*
-*
- TITLE UCOPY2 (A,B,N)
-;#
-; CERN PROGLIB# V301 UCOPY2 .VERSION KERNPDP 1.00 750903
-;#
- B=1
- N=2
- J=3
- A=4
- TEMP=5
- ;UCOPY ALLOWING OVERLAPS
- SEARCH HELP
-#include "reentr.inc"
- HELLO( UCOPY2)
- SKIPG N, at 2(16) ;LOAD N,RETURN FOR SMALLER 0
- JRST 0,RETURN
- HRRZI A,@(16) ;GET ADDR OF A
- HRRZI B, at 1(16) ;GET ADDR OF B
- CAIL B,(A) ;SKIP FOR NO OVERLAP
- JRST 0,BACKW
- HRL B,A ;PREPARE POINTER
-GO: MOVEI J,(B) ;GET END
- ADDI J,-1(N) ;ADDRESS
- BLT B,(J) ;TRANSFER
-RETURN: GOODBY
-BACKW: CAIN B,(A) ;CHECK ADDR OF A= ADDR OF B
- JRST 0,RETURN
- ADDI B,-1(N) ;PREPARE
- ADDI A,-1(N) ;POINTERS
-LOOP: MOVE TEMP,(A) ;AND
- MOVEM TEMP,(B) ;DO
- SOJ A, ;BACKWARDS
- SOJ B, ;LOOP
- SOJN N,LOOP
- GOODBY
- PRGEND
-#ifdef CERNLIB_TCGEN_UCOPY2
-#undef CERNLIB_TCGEN_UCOPY2
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/upkch.s b/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/upkch.s
deleted file mode 100644
index 1bfd9a9..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/upkch.s
+++ /dev/null
@@ -1,119 +0,0 @@
-*
-* $Id: upkch.s,v 1.1.1.1 1996/02/15 17:53:45 mclareni Exp $
-*
-* $Log: upkch.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:45 mclareni
-* Kernlib
-*
-*
- TITLE UPKCH (CHAR,INT,N,IPAR)
-;#
-; CERN PROGLIB# M427 UPKCH .VERSION KERNPDP 1.00 750903
-;#
-.COMMON SLATE [50]
- ;IPAR(1)= NBITS
- ;IPAR(2)= NCHAR PER ZONE
- ;IPAR(3)= NBITS PER ZONE
- ;IPAR(4)=NIGN
- ;IPAR(5)= NFILL
- ;ACCUMULATORS:
- N=1
- NFILL=2
- ZERO=3
- NIGN=4
- NBITS=5
- TRAIL=7
- NCHAR=10
- BPT=11
- COUNT1=12
- TEMP=13
- TEMP1=14
- P=15
- WDCOUN=17
- SEARCH HELP
-#include "reentr.inc"
- HELLO( UPKCH)
- MOVEM P,SAV15
- MOVEM WDCOUN,SAV17
- MOVN N, at 2(16) ;GET N,RETURN FOR =0
- JUMPE N,RETURN
- MOVEI 02, at 3(16) ;AC2=ADR OF IPAR
- SKIPN 03,2(02) ;AC3 = NZONE,SKIP FOR = 0
- MOVEI 03,44 ;NZONE =36
- MOVE NIGN,3(02) ;GET NIGN
- MOVE NBITS,(02) ;GET NBITS
- MOVE 06,03 ;AC6= NZONE
- SUB 06,NIGN ;AC6=
- IDIV 06,NBITS ;(NZONE-NIGN)/NBITS
- SKIPN 10,1(02) ;GET NCHAR,SKIP FOR =0
- MOVE 10,06 ;NCHAR=MAXIMUM
- CAMGE 06,10 ;LIMIT NCHAR
- MOVE 10,06 ;TO MAX
- MOVNS 10
- MOVE COUNT1,10
- HRLI COUNT1, at 1(16) ;COUNT1
- MOVSS COUNT1
- HRRZI BPT,@(16) ;GET ADDR OF CHAR
- HRRZI P,44 ;CALCULATE POSITION
- SUBI P,(NIGN) ;OF FIRST BYTE
- DPB NBITS,[POINT 6,BPT,11]
- DPB P ,[POINT 6,BPT,5]
- MOVEI WDCOUN,1 ;START WORDCOUNT
- CAIE 03,44 ;COMPARE NZONE WITH 36
- JUMPA ,WAY2 ;THEN GO WAY2
-LOOP1: ILDB TEMP,BPT ;LOAD BYTE
- MOVEM TEMP,(COUNT1) ;AND STORE IT
- AOJGE N,FINISH ;ASK FOR END
- AOBJN COUNT1,LOOP1 ;ASK FOR END OF WORD
- ADDI WDCOUN,1 ;INCREMENT WORDCOUNT
- HRL COUNT1,NCHAR ;RESET CHAR COUNT
- ADDI BPT,1 ;BUMP ADDRESS
- DPB P,[POINT 6,BPT,5]
- JUMPA LOOP1
-FINISH: MOVEM WDCOUN,SLATE
-RETURN: MOVE P,SAV15
- MOVE WDCOUN,SAV17
- GOODBY
-WAY2: SETZ TEMP,
- SETZ TEMP1,
- ADD 6,NCHAR ;CORRECT
- IMUL 6,NBITS ;TRAILING
- ADD TRAIL,6 ;BITS
- ADD TRAIL,NIGN
-LOOP2: SUB P,NBITS ;PREPARE P
- JUMPL P,WDEND ;CHECK FOR END OF WORD
- DPB P,[POINT 6,BPT,5]
- LDB TEMP,BPT ;LOAD BYTE
- MOVEM TEMP,(COUNT1) ;AND STORE IT
- AOJGE N,FINISH ;ASK FOR END
- AOBJN COUNT1,LOOP2 ;LOOP BACK IF NOT END OF ZONE
-ZONEND: HRL COUNT1,NCHAR ;RESTORE COUNT
- SUB P,TRAIL ;JUMP OVER TRAILINGS
- JUMPGE P,LOOP2 ;END OF WORD?
- MOVEI P,44(P) ;P=36-P
- ADDI WDCOUN,1 ;BUMP WORD COUNTER
- ADDI BPT,1
- JUMPA ,LOOP2 ;LOOP BACK
-WDEND: SETZ 0, ;CLEAR AC0
- SETZ TEMP,
- DPB 0,[POINT 6,BPT,5] ;STORE 0 FOR P
- MOVE 0,P ;CALCULATE
- ADD 0,NBITS ;LENGTH OF LEFT PART
- DPB 0,[POINT 6,BPT,11]
- LDB TEMP,BPT ;GET LEFT PART
- ADDI BPT,1 ;BUMP ADDRESS
- MOVE TEMP1,(BPT) ;GET NEXT WORD
- MOVNS P
- LSHC TEMP,(P) ;SHIFT RIGHT PART INTO TEMP
- DPB NBITS,[POINT 6,BPT,11]
- MOVNS P
- ADDI P,44
- ADDI WDCOUN,1 ;BUMP WORD COUNTER
- JUMPA LOOP2+4 ;JOIN NORMAL WAY
-#include "reent1.inc"
-SAV15: 0
-SAV17: 0
- PRGEND
-#ifdef CERNLIB_TCGEN_UPKCH
-#undef CERNLIB_TCGEN_UPKCH
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/uzero.s b/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/uzero.s
deleted file mode 100644
index 8e4d0f7..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/uzero.s
+++ /dev/null
@@ -1,38 +0,0 @@
-*
-* $Id: uzero.s,v 1.1.1.1 1996/02/15 17:53:45 mclareni Exp $
-*
-* $Log: uzero.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:45 mclareni
-* Kernlib
-*
-*
- TITLE UZERO (IV,JL,JR)
-;#
-; CERN PROGLIB# V300 UZERO .VERSION KERNPDP 1.00 750903
-;#
-;ACCUMULATORS:
- JL=1
- JR=2
- B=3
- F=4
- SEARCH HELP
-#include "reentr.inc"
- HELLO( UZERO)
- HRRZI B ,@(16) ;LOAD ADDR OF IV
- MOVE JL, at 1(16) ;LOAD JL, JR
- MOVE JR, at 2(16)
- CAIG JR,(JL) ;WORRY ABOUT
- JRST ONCE ;ONE PASS THROUGH
- ADDI JR,-1(B) ;ADR. OF IV(JR)
- ADDI B,(JL) ;ADR. OF IV(JL+1)
- HRLI B,-1(B) ;BLT POINTER
- SETZM -1(B) ;BLT ZEROS
- BLT B,(JR)
- GOODBY
-ONCE: ADDI B,-1(JL) ;ADR. OF IV(JL)
- SETZM (B) ;ZERO ONE WORD
- GOODBY
- PRGEND
-#ifdef CERNLIB_TCGEN_UZERO
-#undef CERNLIB_TCGEN_UZERO
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/vblank.s b/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/vblank.s
deleted file mode 100644
index 77b19ae..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/vblank.s
+++ /dev/null
@@ -1,30 +0,0 @@
-*
-* $Id: vblank.s,v 1.1.1.1 1996/02/15 17:53:45 mclareni Exp $
-*
-* $Log: vblank.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:45 mclareni
-* Kernlib
-*
-*
- TITLE VBLANK (VEC,N)
-;#
-; CERN PROGLIB# F121 VBLANK .VERSION KERNPDP 1.00 750903
-;#
- PT=1
- BLKS=2
- N=3
- SEARCH HELP
-#include "reentr.inc"
- HELLO( VBLANK)
- MOVN N, at 1(16) ;GET -N
- JUMPE N,RETURN
- MOVE BLKS,[ASCII / /] ;GET BLANKS
- MOVEI PT,@(16) ;GET ADDR OF VEC
- HRL PT,N ;LOAD LEFT HALF POINTER
-LOOP: MOVEM BLKS,(PT) ;STORE BLANKS
- AOBJN PT,LOOP ;LOOP BACK IF NOT END
-RETURN: GOODBY
- PRGEND
-#ifdef CERNLIB_TCGEN_VBLANK
-#undef CERNLIB_TCGEN_VBLANK
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/vfill.s b/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/vfill.s
deleted file mode 100644
index 41f5a96..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/vfill.s
+++ /dev/null
@@ -1,30 +0,0 @@
-*
-* $Id: vfill.s,v 1.1.1.1 1996/02/15 17:53:45 mclareni Exp $
-*
-* $Log: vfill.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:45 mclareni
-* Kernlib
-*
-*
- TITLE VFILL (A,N,STUFF)
-;#
-; CERN PROGLIB# F121 VFILL .VERSION KERNPDP 1.00 750903
-;#
- PT=1
- STUFF=2
- N=3
- SEARCH HELP
-#include "reentr.inc"
- HELLO( VFILL)
- MOVN N, at 1(16) ;GET -N
- JUMPE N,RETURN
- MOVE STUFF, at 2(16) ;GET STUFF
- MOVEI PT,@(16) ;GET ADDR OF VEC
- HRL PT,N ;LOAD LEFT HALF POINTER
-LOOP: MOVEM STUFF,(PT) ;STORE STUFF
- AOBJN PT,LOOP ;LOOP BACK IF NOT END
-RETURN: GOODBY
- PRGEND
-#ifdef CERNLIB_TCGEN_VFILL
-#undef CERNLIB_TCGEN_VFILL
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/vfix.s b/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/vfix.s
deleted file mode 100644
index 92c6733..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/vfix.s
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: vfix.s,v 1.1.1.1 1996/02/15 17:53:45 mclareni Exp $
-*
-* $Log: vfix.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:45 mclareni
-* Kernlib
-*
-*
- TITLE VFIX
-;#
-; CERN PROGLIB# F121 VFIX .VERSION KERNPDP 1.05 771031
-;#
-; LAST MODIF. 31/10/77
- ENTRY VFIX
-#include "reentr.inc"
- EXTERN IFIX
- SEARCH HELP
- T0==0
- T1==4
- T2==2
- T3==3
- HELLO(VFIX)
- MOVE T1, at 2(16)
- JUMPE T1,EXIT
- MOVEI T3, at 1(16)
- MOVEI T2, at 0(16)
-LOOP: MOVE T0,(T2)
- MOVEM T0,ARGY
- ENTER(IFIX)
- ARG ARGY
- MOVEM T0,(T3)
- AOS T2
- AOS T3
- SOJN T1,LOOP
-EXIT: GOODBY
-#include "reent1.inc"
-ARGY: 0
- PRGEND
-#ifdef CERNLIB_TCGEN_VFIX
-#undef CERNLIB_TCGEN_VFIX
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/vzero.s b/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/vzero.s
deleted file mode 100644
index 592646c..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10mlr/vzero.s
+++ /dev/null
@@ -1,30 +0,0 @@
-*
-* $Id: vzero.s,v 1.1.1.1 1996/02/15 17:53:45 mclareni Exp $
-*
-* $Log: vzero.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:45 mclareni
-* Kernlib
-*
-*
- TITLE VZERO (VEC,N)
-;#
-; CERN PROGLIB# F121 VZERO .VERSION KERNPDP 1.00 750903
-;#
- PT=1
- ZERO=2
- N=3
- SEARCH HELP
-#include "reentr.inc"
- HELLO( VZERO)
- MOVN N, at 1(16) ;GET -N
- JUMPE N,RETURN
- SETZM 0,ZERO ;GET ZEROES
- MOVEI PT,@(16) ;GET ADDR OF VEC
- HRL PT,N ;LOAD LEFT HALF POINTER
-LOOP: MOVEM ZERO,(PT) ;STORE ZEROES
- AOBJN PT,LOOP ;LOOP BACK IF NOT END
-RETURN: GOODBY
- PRGEND
-#ifdef CERNLIB_TCGEN_VZERO
-#undef CERNLIB_TCGEN_VZERO
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10obs/comment.inc b/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10obs/comment.inc
deleted file mode 100644
index b5a0065..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10obs/comment.inc
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: comment.inc,v 1.1.1.1 1996/02/15 17:53:46 mclareni Exp $
-*
-* $Log: comment.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:53:46 mclareni
-* Kernlib
-*
-*
-*
-* comment.inc
-*
-
-
-C-- THIS PATCH CONTAINS THE ASSEMBLER VERSIONS
-C-- OF OBSOLETE GENSEC ROUTINES.
-
-
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10obs/lorenc.s b/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10obs/lorenc.s
deleted file mode 100644
index a352f17..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10obs/lorenc.s
+++ /dev/null
@@ -1,147 +0,0 @@
-*
-* $Id: lorenc.s,v 1.1.1.1 1996/02/15 17:53:46 mclareni Exp $
-*
-* $Log: lorenc.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:46 mclareni
-* Kernlib
-*
-*
- TITLE LORENC ;P. SCHMITZ JULI 69
- SEARCH HELP
- EXTERN SQRT
- HELLO (LORENC)
- HRRZI ,ACSAVE ;SAVE AC'S
- BLT ,ACSAVE+5
- MOVEI A03, at 0(A16) ;ADR(A)
- MOVEI A04, at 1(A16) ;ADR(B)
- JSR ,MUL
- MOVEM ,A05
- MOVEM A04,A03 ;B(1)*B(1)+ ...
- JSR ,MUL
- FADR ,[EXP ^D1.0] ;+1.0
- MOVEM ,ACSAVE
- ENTER (SQRT)
- JUMP ,ACSAVE
- FADR ,[EXP ^D1.0]
- FDVR A05,
- MOVEI A03, at 0(A16) ;ADR(A)
- MOVEM A03,A04
- JSR ,MUL
- FADR ,[EXP ^D1.0] ;+1.0
- MOVEM ,ACSAVE
- ENTER (SQRT)
- JUMP ,ACSAVE
- FADR A05,
-END: MOVEI A01, at 0(A16) ;ADR(A)
- MOVEI A02, at 1(A16) ;ADR(B)
- MOVEI A03, at 2(A16) ;ADR(C)
- MOVEI A04,2 ;LOOP COUNT
-LOOP: MOVE ,(A02) ; DO 50 I=1,3
- FMPR ,A05
- FADR ,(A01)
- MOVEM ,(A03)
- AOS ,A01
- AOS ,A02
- AOS ,A03
- SOJGE A04,LOOP
- HRLZI ,ACSAVE ;RESTORE AC'S
- BLT ,5
- GOODBY
-MUL: 0
- MOVE A01,(A03) ;MULTIPLY VECTORS
- FMPR A01,(A04)
- MOVE ,1(A03)
- FMPR ,1(A04)
- FADR ,A01
- MOVE A01,2(A03)
- FMPR A01,2(A04)
- FADR ,A01
- JRST 2, at MUL
- HELLO (LOTRAN)
- HRRZI ,ACSAVE ;SAVE AC'S
- BLT ,ACSAVE+5
- MOVEI A03, at 1(A16) ;ADR(B)
- MOVEM A03,A04
- JSR ,MUL
- MOVE A01,3(A03)
- FMPR A01,A01
- FSBR A01, ;B(4)**2 - ...
- MOVEM A01,ACSAVE ;SQRT (...)
- ENTER (SQRT)
- JUMP ,ACSAVE
- MOVEM ,A05
- MOVEI A04, at 0(A16) ;A(1)*B(1) + ...
- JSR ,MUL
- MOVE A02,3(A03)
- FADR A02,A05 ;/ (B(4)+AMASS)
- FDVRM ,A02
- MOVEM A04,A03 ;A(1)*A(1) + ...
- JSR ,MUL
- MOVE A01,3(A03)
- FMPR A01,A01
- FADR ,A01 ;+ A(4)**2
- MOVEM ,ACSAVE
- ENTER (SQRT)
- JUMP ,ACSAVE
- FADR ,A02
- FDVRM ,A05 ;AC 5 CONTAINS NOW X
- MOVEI A01, at 2(A16)
- MOVE ,3(A03) ;C(4) = A(4)
- MOVEM ,3(A01)
- JRST ,END
- HELLO (LOREN4)
- HRRZI ,ACSAVE ;SAVE AC'S
- BLT ,ACSAVE+5
- MOVEI A03, at 0(A16) ;ADR(A)
- MOVEM A03,A04
- JSR ,MUL ;A(1)*A(1) + ...
- MOVEM ,U
- MOVE ,3(A03) ;V = SQRT( ...)
- FMPR
- FSBR ,U
- MOVEM ,ACSAVE
- ENTER (SQRT)
- JUMP ,ACSAVE
- MOVE A01,[EXP ^D1.0]
- FDVR A01,
- MOVEM A01,V
- MOVEI A04, at 1(A16) ;A(1)*B(1) + ...
- JSR ,MUL
- MOVEM ,W
- MOVE ,3(A03) ;X = W* ...
- FMPR ,V
- FSBR ,[EXP ^D1.0]
- FMPR ,W
- FDVR ,U
- MOVE A05,3(A04)
- FMPR A05,V
- FSBRM ,A05
- MOVE ,3(A04) ;C(4) = V* ...
- FMPR ,3(A03)
- FSBR ,W
- FMPR ,V
- MOVEI A03, at 2(A16)
- MOVEM ,3(A03)
- MOVEM A04,A01
- MOVEI A02, at 0(A16)
- JRST ,LOOP-1
-ACSAVE:BLOCK 6
-U: 0
-V: 0
-W: 0
- A01= 1
- A02= 2
- A03= 3
- A04= 4
- A05= 5
- A16=16
- PRGEND
-#ifdef CERNLIB_TCGENR_LORENC
-#undef CERNLIB_TCGENR_LORENC
-#endif
-#ifdef CERNLIB_TCGENR_LOREN4
-#undef CERNLIB_TCGENR_LOREN4
-#endif
-#ifdef CERNLIB_TCGENR_LOTRAN
-#undef CERNLIB_TCGENR_LOTRAN
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10obs/mxadd.s b/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10obs/mxadd.s
deleted file mode 100644
index 48d0ebf..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10obs/mxadd.s
+++ /dev/null
@@ -1,76 +0,0 @@
-*
-* $Id: mxadd.s,v 1.1.1.1 1996/02/15 17:53:46 mclareni Exp $
-*
-* $Log: mxadd.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:46 mclareni
-* Kernlib
-*
-*
- TITLE MXADD
- SUBTTL P. SCHMITZ
- SEARCH HELP
- RELOC 0
- HELLO (MXADD)
- MOVE 0,EINS ; CALL MXADD(A,B,C,I,J)
- JRST A ; C=A+B
- HELLO (MXSUB)
- MOVN 0,EINS ; CALL MXSUB(A,B,C,I,J)
-A: MOVEM 1,SP1 ; C=A-B
- MOVEI 1,0
- JRST START
- HELLO (MXTRA)
- MOVEI 0,1 ; CALL MXTRA(A,B,C,I,J)
- JRST B ; C=A
- HELLO (MXMTR)
- MOVE 0, at 1(16) ; CALL MXMTR(A,B,C,I,J)
- JRST B ; C=B*A
- HELLO (MXNTR)
- RADIX 10
- MOVEI 0,2 ; CALL MXNTR(A,B,C,I,J)
-B: MOVEM 1,SP1 ; C=-A
- MOVEI 1,1
-START: MOVEM 0,WERT
- MOVE 0,BLOUT
- BLT 0,SP3+2
-TEST: MOVE 2, at 3(14)
- JUMPLE 2,RETURN
- IMUL 2, at 4(14)
- JUMPLE 2,RETURN ; I UND J MUESSEN POSITIVE ZAHLEN SEIN.
- ADDI 2,@(14) ; REELLE ENDADRESSE
- MOVEI 3,@(14) ; ADRESSE VON A(1)
- MOVEI 4, at 1(14) ; ADRESSE VON B(1)
- MOVEI 5, at 2(14) ; ADRESSE VON C(1)
-DO: MOVE 0,WERT
- JUMPLE 1,ADDSUB
- CAIN 0,1
- JRST TRA
- CAIN 0,2
- JRST NTR
- FMPR 0,(3)
- JRST ERHOEH
-TRA: MOVE 0,(3)
- JRST ERHOEH
-NTR: MOVN 0,(3)
- JRST ERHOEH
-ADDSUB: FMPR 0,(4) ; EINGANG FUER: MXADD UND MXSUB.
- FADR 0,(3)
-ERHOEH: MOVEM 0,(5) ; ABSPEICHERN DES RESULTATES IN C(I)
- AOS 3 ; ERHOEHEN DER INDICES
- AOS 4
- CAMGE 3,2 ; ENDABFRAGE DER DO-SCHLEIFE.
- AOJA 5,DO
-RETURN: MOVE 5,BLIN
- BLT 5,5
- RADIX 8
- GOODBY
-BLOUT: XWD 3,SP3
-BLIN: XWD SP1,1
-EINS: DEC 1.
-SP1: Z
-SP2: Z
-SP3: BLOCK 3
-WERT: Z
- PRGEND
-#ifdef CERNLIB_TCGENR_MXADD
-#undef CERNLIB_TCGENR_MXADD
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10obs/mxdma.s b/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10obs/mxdma.s
deleted file mode 100644
index 374cdb8..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10obs/mxdma.s
+++ /dev/null
@@ -1,65 +0,0 @@
-*
-* $Id: mxdma.s,v 1.1.1.1 1996/02/15 17:53:46 mclareni Exp $
-*
-* $Log: mxdma.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:46 mclareni
-* Kernlib
-*
-*
- TITLE MXDMA
- SUBTTL P. SCHMITZ
- SEARCH HELP
- HELLO (MXDMA)
- HRRZI ,ACSAV
- BLT ,ACSAV+4
- MOVE , at 4(A16) ; SUBROUTINE MXDMA (A,F,D,B,I)
- SKIPG ; DIMENSION A(400),B(400),D(20
- GOODBY
- MOVEI A10,1 ; IF (I.EQ.1) GO TO 12
- SETZM ,A11 ; DO 11 K=2,I
- SETZM ,A12 ; B(J) = A(J)+F*D(K-1)
- SOS ; DO 11 L=1,I
- JUMPE ,LOOPE ; B(J) = A(J)
- MOVEI A13, at 0(A16) ;12 B(J) = A(J)+F*D(I)
- HRRM A13,LOOP+2 ; RETURN
- HRRM A13,LOOP1 ; END
- HRRM A13,LOOPE+4
- MOVEI A13, at 2(A16)
- SOS ,A13
- HRRM A13,LOOP
- MOVEI A13, at 3(A16)
- HRRM A13,LOOP+3
- HRRM A13,LOOP1+1
- HRRM A13,LOOPE+5
-LOOP: MOVE A13,(A10) ;B(J) = A(J)+F*D(K-1)
- FMPR A13, at 1(A16)
- FADR A13,(A12)
- MOVEM A13,(A12)
- AOS ,A12 ;J = J+1
- SETZM ,A11
-LOOP1: MOVE A13,(A12) ;B(J) = A(J)
- MOVEM A13,(A12)
- AOS ,A12 ;J = J+1
- CAMGE A11, ;END OF INNER LOOP
- AOJA A11,LOOP1
- CAMGE A10, ;END OF OUTER LOOP
- AOJA A10,LOOP
-LOOPE: MOVEI A10, at 2(A16) ;B(J) = A(J)+F*D(I)
- ADD A10,
- MOVE A13,(A10)
- FMPR A13, at 1(A16)
- FADR A13,(A12)
- MOVEM A13,(A12)
- HRLZI ,ACSAV
- BLT ,4
- GOODBY
-ACSAV: BLOCK 5
- A10= 1
- A11= 2
- A12= 3
- A13= 4
- A16=16
- PRGEND
-#ifdef CERNLIB_TCGENR_MXDMA
-#undef CERNLIB_TCGENR_MXDMA
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10obs/mxdmal.s b/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10obs/mxdmal.s
deleted file mode 100644
index bafa94b..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10obs/mxdmal.s
+++ /dev/null
@@ -1,92 +0,0 @@
-*
-* $Id: mxdmal.s,v 1.1.1.1 1996/02/15 17:53:47 mclareni Exp $
-*
-* $Log: mxdmal.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:47 mclareni
-* Kernlib
-*
-*
- TITLE MXDMAL
- SUBTTL P. SCHMITZ
- SEARCH HELP
- HELLO (MXDMAL)
- SETZM
- JRST ,GO ; SUBROUTINE MXDMAL (A,B,R,I,J
- HELLO (MXDMAR)
- MOVEI ,1 ; IF (I.EQ.0.OR.J.EQ.0) RETURN
- JRST ,GO ; IB = 1
- HELLO (MXDML)
- MOVEI ,2 ; R(IB) = R(IB)+B(IB)*A(L)
- JRST ,GO ;21 IB = IB+1
- HELLO (MXDMR)
- MOVEI ,3 ; ENTRY MXDMAR
-GO: MOVEM A01,ACSAV+1 ; IF (I.EQ.0.OR.J.EQ.0) RETURN
- HRRI A01,ACSAV+2 ; IB = 1
- HRLI A01,2 ; DO 31 L=1,I
- BLT A01,ACSAV+17 ; DO 31 K=1,J
- SKIPG A02, at 3(A16) ;31 IB = IB+1
- JRST ,END ; RETURN
- SKIPG A03, at 4(A16) ;
- JRST ,END ; ENTRY MXDML
- MOVEI A01,3 ;
- IMUL A01, ; IF (I.EQ.0.OR.J.EQ.0) RETURN
- MOVEI , at 0(A16) ; DO 41 L=1,I
- HRRM ,COMTAB+0(A01) ; DO 41 K=1,J
- MOVEI , at 1(A16) ; R(IB) = B(IB)*A(L)
- HRRM ,COMTAB+1(A01) ;41 IB = IB+1
- MOVEI , at 2(A16) ; RETURN
- HRRM ,COMTAB+2(A01) ;
- HRLI ,COMTAB(A01) ;
- HRRI ,LOOP ; IF (I.EQ.0.OR.J.EQ.0) RETURN
- BLT ,LOOP+2 ; IB = 1
- MOVE ,[XWD LOOPB+4,7] ; DO 51 L=1,I
- BLT ,17 ; DO 51 K=1,J
- SOS ,A02 ;51 IB = IB + 1
- HRRM A02,LOOP+7 ; RETURN
- SOS ,A03 ; END
- HRRM A03,LOOP+4
- PAGE
- SETZM ,A01 ;CLEAR LOOP REGISTERS
- SETZM ,A02
- SETZM ,A03
-LOOPB: JRST ,4
- PHASE 4
-LOOP: XCT ,COMTAB(A01) ;EXECUTE THE ARITHMETIC
- XCT ,COMTAB+1(A01) ;INSIDE OF THE LOOPS
- XCT ,COMTAB+2(A01)
- AOS ,A03
- CAIGE A02, ;END OF INNER LOOP
- AOJA A02,LOOP
- SETZM ,A02
- CAIGE A01, ;END OF OUTER LOOP
- AOJA A01,LOOP
- JRST ,END
- DEPHASE
-END: HRLZI ,ACSAV ;RESTORE AC'S , RETURN
- BLT ,17
- GOODBY
-COMTAB:MOVE ,(A01) ;R(IB) = R(IB)+B(IB)*A(L)
- FMPR ,(A03)
- FADRM ,(A03)
- MOVE ,(A03) ;R(IB) = R(IB)+A(IB)*B(K)
- FMPR ,(A02)
- FADRM ,(A03)
- MOVE ,(A01) ;R(IB) = B(IB)*A(L)
- FMPR ,(A03)
- MOVEM ,(A03)
- MOVE ,(A03) ;R(IB) = A(IB)*B(K)
- FMPR ,(A02)
- MOVEM ,(A03)
-ACSAV: BLOCK 20
- A01= 1
- A02= 2
- A03= 3
- A04= 4
- A05= 5
- A06= 6
- A07= 7
- A16=16
- PRGEND
-#ifdef CERNLIB_TCGENR_MXDMAL
-#undef CERNLIB_TCGENR_MXDMAL
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10obs/vmodul.s b/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10obs/vmodul.s
deleted file mode 100644
index 7fa0f31..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernpdp/pdp10obs/vmodul.s
+++ /dev/null
@@ -1,40 +0,0 @@
-*
-* $Id: vmodul.s,v 1.1.1.1 1996/02/15 17:53:48 mclareni Exp $
-*
-* $Log: vmodul.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:48 mclareni
-* Kernlib
-*
-*
- TITLE VMODUL
- SUBTTL P. SCHMITZ
-#include "reentr.inc"
- SEARCH HELP
- EXTERN SQRT
- HELLO (VMODUL)
- MOVEM A01,ACSAV ;SAVE AC'S
- MOVEM A02,ACSAV+1
- MOVEI A02, at 0(A16) ;ADR(A)
- MOVE ,(A02)
- FMPR ;A(1)**2
- MOVE A01,1(A02) ;A(1)**2+A(2)**2
- FMPR A01,A01
- FADR ,A01
- MOVE A01,2(A02) ;A(1)**2+A(2)**2+A(3)**2=...
- FMPR A01,A01
- FADR ,A01
- MOVEM ,ACSAV+2
- ENTER (SQRT)
- JUMP ,ACSAV+2
- MOVE A01,ACSAV ;RESTORE AC'S, EXIT
- MOVE A02,ACSAV+1
- GOODBY
-#include "reent1.inc"
-ACSAV: BLOCK 3
- A01= 1
- A02= 2
- A16=16
- PRGEND
-#ifdef CERNLIB_TCGENR_VMODUL
-#undef CERNLIB_TCGENR_VMODUL
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernpdp/reentr/reent1.inc b/src/packlib/kernlib/kerngen/obsolete/kernpdp/reentr/reent1.inc
deleted file mode 100644
index 2c3084a..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernpdp/reentr/reent1.inc
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: reent1.inc,v 1.1.1.1 1996/02/15 17:53:32 mclareni Exp $
-*
-* $Log: reent1.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:53:32 mclareni
-* Kernlib
-*
-*
-*
-* reent1.inc
-*
- RELOC
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernpdp/reentr/reentr.inc b/src/packlib/kernlib/kerngen/obsolete/kernpdp/reentr/reentr.inc
deleted file mode 100644
index 8a3481d..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernpdp/reentr/reentr.inc
+++ /dev/null
@@ -1,14 +0,0 @@
-*
-* $Id: reentr.inc,v 1.1.1.1 1996/02/15 17:53:32 mclareni Exp $
-*
-* $Log: reentr.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:53:32 mclareni
-* Kernlib
-*
-*
-* FOR PATCH PDP10MLR
-*
-* reentr.inc
-*
- TWOSEG
- RELOC 400000
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernsgi/sgiprogs/fcasplit.F b/src/packlib/kernlib/kerngen/obsolete/kernsgi/sgiprogs/fcasplit.F
deleted file mode 100644
index 90d497b..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernsgi/sgiprogs/fcasplit.F
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: fcasplit.F,v 1.1.1.1 1996/02/15 17:54:20 mclareni Exp $
-*
-* $Log: fcasplit.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:20 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
-#ifndef CERNLIB_QMSGI
-#define CERNLIB_QMSGI
-#endif
-#ifndef CERNLIB_UTYGEN_FCASPLIT
-#define CERNLIB_UTYGEN_FCASPLIT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernsun/obsolete/jumpad.F b/src/packlib/kernlib/kerngen/obsolete/kernsun/obsolete/jumpad.F
deleted file mode 100644
index 4e1e5ef..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernsun/obsolete/jumpad.F
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: jumpad.F,v 1.1.1.1 1996/02/15 17:54:21 mclareni Exp $
-*
-* $Log: jumpad.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:21 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- FUNCTION JUMPAD (ITARGT)
-C
-C CERN PROGLIB# Z042 JUMPAD .VERSION KERNSUN 1.00 880922
-C ORIG. 22/09/88, JZ
-C
-C- Get target address for use with JUMPXn
-
- JUMPAD = LOC (ITARGT)
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernsun/obsolete/jumpx2.F b/src/packlib/kernlib/kerngen/obsolete/kernsun/obsolete/jumpx2.F
deleted file mode 100644
index 99858c0..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernsun/obsolete/jumpx2.F
+++ /dev/null
@@ -1,60 +0,0 @@
-*
-* $Id: jumpx2.F,v 1.1.1.1 1996/02/15 17:54:21 mclareni Exp $
-*
-* $Log: jumpx2.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:21 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE JUMPX2 (IPARA,IPARB)
-C
-C CERN PROGLIB# Z042 JUMPX2 .VERSION KERNSUN 1.02 891025
-C ORIG. 22/09/88 JZ
-C MOD. 12/09/89 JZ, add entries JUMPX1, JUMPX0
-C
-C- to transfer
-
- DIMENSION IPARA(9), IPARB(9)
- POINTER (JPOINT, TARGET)
- SAVE JPOINT
-
- CALL JUMPY2 (TARGET,IPARA,IPARB)
- RETURN
-
- ENTRY JUMPX1 (IPARA)
- CALL JUMPY1 (TARGET,IPARA)
- RETURN
-
- ENTRY JUMPX0
- CALL JUMPY0 (TARGET)
- RETURN
-
-C- to set the tranfer address
- ENTRY JUMPST (JADR)
- JPOINT = JADR
- RETURN
- END
-C-----------------------------------------------------
- SUBROUTINE JUMPY2 (TARSUB,IPARA,IPARB)
- DIMENSION IPARA(9), IPARB(9)
- EXTERNAL TARSUB
-
- CALL TARSUB (IPARA,IPARB)
- RETURN
-
- ENTRY JUMPY1 (TARSUB,IPARA)
- CALL TARSUB (IPARA)
- RETURN
-
- ENTRY JUMPY0 (TARSUB)
- CALL TARSUB
- RETURN
- END
-#ifdef CERNLIB_CCGEN_JUMPXN
-#undef CERNLIB_CCGEN_JUMPXN
-#endif
-#ifdef CERNLIB_TCGEN_JUMPXN
-#undef CERNLIB_TCGEN_JUMPXN
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernsun/obsolete/signalf.c b/src/packlib/kernlib/kerngen/obsolete/kernsun/obsolete/signalf.c
deleted file mode 100644
index f2e3fb0..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernsun/obsolete/signalf.c
+++ /dev/null
@@ -1,49 +0,0 @@
-/*
- * $Id: signalf.c,v 1.1.1.1 1996/02/15 17:54:21 mclareni Exp $
- *
- * $Log: signalf.c,v $
- * Revision 1.1.1.1 1996/02/15 17:54:21 mclareni
- * Kernlib
- *
- */
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
-/*> ROUTINE SIGNALF
- CERN PROGLIB# SIGNALF .VERSION KERNSUN 1.05 910318
- ORIG. 12/03/91, JZ
- FORTRAN interface routine to signal */
-#include <stdio.h>
-#include <signal.h>
-#include <errno.h>
-int signalf_(signum,funct,flag)
- int *signum, *flag;
- int *funct;
-{
- int signo, istat;
- int handler;
- void *oldhand;
-
-
- signo = *signum;
-/* printf (" entry signalf fu=%x *fu=%x fl=%x *fl=%x\n",
- funct, *funct, flag, *flag); */
-
- if (*flag < 0) handler = (int)funct;
- else if (*flag == 0) handler = (int)SIG_DFL;
- else if (*flag == 1) handler = (int)SIG_IGN;
- else handler = *flag;
-
-/* printf (" handler = %x\n", handler); */
-
- oldhand = signal(signo,handler);
- istat = (int)oldhand;
- if (istat >= 0) return istat;
- return -errno;
-}
-/*> END <----------------------------------------------------------*/
-#ifdef CERNLIB_CCGEN_SIGNALF
-#undef CERNLIB_CCGEN_SIGNALF
-#endif
-#ifdef CERNLIB_TCGEN_SIGNALF
-#undef CERNLIB_TCGEN_SIGNALF
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerntmo/history/history.dat b/src/packlib/kernlib/kerngen/obsolete/kerntmo/history/history.dat
deleted file mode 100644
index fb3b471..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerntmo/history/history.dat
+++ /dev/null
@@ -1,57 +0,0 @@
-*
-* $Id: history.dat,v 1.1.1.1 1996/02/15 17:53:48 mclareni Exp $
-*
-* $Log: history.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:53:48 mclareni
-* Kernlib
-*
-*
-* This directory was created from kerntmo.car patch kerntmo
-#if !defined(CERNLIB_KERNTMO)
-
- KERNLIB routines particular to MEIKO on Tranputers
-
----------------------------------------------------------------------
-
- This file contains the following patches :
-
-*KTMO Pilot-patch selecting the full standard general KERNLIB
- for Tranputers with the MEIKO compiler
-
-QMTMO TMO machine patch
-
-TMOGS TMO versions of general KERNLIB rotuines
-
-=====================================================================
-
-
- Up-date record for the Pam-file KERNTMO
- ----------------------------------------
-
-
-Up-date 1.02 : 11-Dec-1989
-----------------------------
-
-Replacing file KERNTMO 1.01 890303 12.00
-
-New decks : LOCB byte adr of a variable
- UOPTC KERNFOR version does not work on TMO
-
-Delete : many routines now available on KERNFOR
-
----------------------------------------------------------------------
-
-Up-date 1.01 : 3-mar-1989
-----------------------------
-
-Replacing file KERNTMO 1.00 890208 16.00
-
-New decks : VXINVB, VXINVC byte swopping routines
-
----------------------------------------------------------------------
-
- First release of the KERNTMO Pam : 8-Feb-1989
-
----------------------------------------------------------------------
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerntmo/inhibit.list b/src/packlib/kernlib/kerngen/obsolete/kerntmo/inhibit.list
deleted file mode 100644
index 77334a4..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerntmo/inhibit.list
+++ /dev/null
@@ -1,32 +0,0 @@
-tcgen/btest
-tcgen/!!ibits
-tcgen/ibclr
-tcgen/ibset
-tcgen/mvbits
-tcgen/ishft
-tcgen/ishftc
-tcgen/kerngt
-tcgen/gshow
-tcgen/datime
-tcgen/datimh
-tcgen/timel
-tcgen/timex
-tcgen/timest
-tcgen/timed
-tcgen/intrac
-tcgen/iuforw
-tcgen/locb
-tcgen/locf
-tcgen/ublow
-tcgen/ubunch
-tcgen/uctoh1
-tcgen/uctoh
-tcgen/uh1toc
-tcgen/uhtoc
-tcgen/uoptc
-tcgen/vxinvb
-tcgen/vxinvc
-tcgen/xinb
-xvect/xinb
-tcgen/xinbs
-xvect/xinbs
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerntmo/kerntmo/pilot.h b/src/packlib/kernlib/kerngen/obsolete/kerntmo/kerntmo/pilot.h
deleted file mode 100644
index 9f4e077..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerntmo/kerntmo/pilot.h
+++ /dev/null
@@ -1,39 +0,0 @@
-#if 0
-* This pilot patch was created from kerntmo.car patch _ktmo
-#endif
-#ifndef CERNLIB_QMTMO
-#define CERNLIB_QMTMO
-#endif
-#ifndef CERNLIB_TMOGS
-#define CERNLIB_TMOGS
-#endif
-#ifndef CERNLIB_TMOSYS
-#define CERNLIB_TMOSYS
-#endif
-#ifndef CERNLIB_XVECT
-#define CERNLIB_XVECT
-#endif
-#ifndef CERNLIB_TCGEN
-#define CERNLIB_TCGEN
-#endif
-#ifdef CERNLIB_TCGEN_BTEST
-#undef CERNLIB_TCGEN_BTEST
-#endif
-#ifdef CERNLIB_TCGEN_!!IBITS
-#undef CERNLIB_TCGEN_!!IBITS
-#endif
-#ifdef CERNLIB_TCGEN_IBCLR
-#undef CERNLIB_TCGEN_IBCLR
-#endif
-#ifdef CERNLIB_TCGEN_IBSET
-#undef CERNLIB_TCGEN_IBSET
-#endif
-#ifdef CERNLIB_TCGEN_MVBITS
-#undef CERNLIB_TCGEN_MVBITS
-#endif
-#ifdef CERNLIB_TCGEN_ISHFT
-#undef CERNLIB_TCGEN_ISHFT
-#endif
-#ifdef CERNLIB_TCGEN_ISHFTC
-#undef CERNLIB_TCGEN_ISHFTC
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerntmo/kerntmo/q_andor.inc b/src/packlib/kernlib/kerngen/obsolete/kerntmo/kerntmo/q_andor.inc
deleted file mode 100644
index 1bc1c8b..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerntmo/kerntmo/q_andor.inc
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: q_andor.inc,v 1.1.1.1 1996/02/15 17:53:49 mclareni Exp $
-*
-* $Log: q_andor.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:53:49 mclareni
-* Kernlib
-*
-*
-#ifndef CERNLIB_KERNTMO_Q_ANDOR_INC
-#define CERNLIB_KERNTMO_Q_ANDOR_INC
-*
-*
-* q_andor.inc
-*
-* IAND / IOR / IEOR / NOT are standard on TMO
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerntmo/kerntmo/q_shift.inc b/src/packlib/kernlib/kerngen/obsolete/kerntmo/kerntmo/q_shift.inc
deleted file mode 100644
index e4ddb0e..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerntmo/kerntmo/q_shift.inc
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: q_shift.inc,v 1.1.1.1 1996/02/15 17:53:49 mclareni Exp $
-*
-* $Log: q_shift.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:53:49 mclareni
-* Kernlib
-*
-*
-#ifndef CERNLIB_KERNTMO_Q_SHIFT_INC
-#define CERNLIB_KERNTMO_Q_SHIFT_INC
-*
-*
-* q_shift.inc
-*
- ISHFTL (IZW,NZB) = ISHFT (IZW, NZB)
- ISHFTR (IZW,NZB) = ishft (IZW, -NZB)
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerntmo/kerntmo/qcardl.inc b/src/packlib/kernlib/kerngen/obsolete/kerntmo/kerntmo/qcardl.inc
deleted file mode 100644
index 169aa02..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerntmo/kerntmo/qcardl.inc
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: qcardl.inc,v 1.1.1.1 1996/02/15 17:53:49 mclareni Exp $
-*
-* $Log: qcardl.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:53:49 mclareni
-* Kernlib
-*
-*
-#ifndef CERNLIB_KERNTMO_QCARDL_INC
-#define CERNLIB_KERNTMO_QCARDL_INC
-*
-*
-* qcardl.inc
-*
-#if 0
-C====================================================================
-#endif
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerntmo/kerntmo/qmtmo.h b/src/packlib/kernlib/kerngen/obsolete/kerntmo/kerntmo/qmtmo.h
deleted file mode 100644
index 871685a..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerntmo/kerntmo/qmtmo.h
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: qmtmo.h,v 1.1.1.1 1996/02/15 17:53:49 mclareni Exp $
-*
-* $Log: qmtmo.h,v $
-* Revision 1.1.1.1 1996/02/15 17:53:49 mclareni
-* Kernlib
-*
-*
-* This directory was created from kerntmo.car patch qmtmo
-#ifndef CERNLIB_F77
-#define CERNLIB_F77
-#endif
-#ifndef CERNLIB_A4
-#define CERNLIB_A4
-#endif
-#ifndef CERNLIB_B32
-#define CERNLIB_B32
-#endif
-#ifndef CERNLIB_HEX
-#define CERNLIB_HEX
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerntmo/tmogs/Imakefile b/src/packlib/kernlib/kerngen/obsolete/kerntmo/tmogs/Imakefile
deleted file mode 100644
index dfb7725..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerntmo/tmogs/Imakefile
+++ /dev/null
@@ -1,6 +0,0 @@
-SRCS_F= \ @@\
- datime.F intrac.F iuforw.F kerngt.F locb.F locf.F ublow.F ubunch.F \ @@\
- uctoh.F uctoh1.F uh1toc.F uhtoc.F uoptc.F vxinvb.F vxinvc.F \ @@\
- xinb.F xinbs.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerntmo/tmogs/datime.F b/src/packlib/kernlib/kerngen/obsolete/kerntmo/tmogs/datime.F
deleted file mode 100644
index f658967..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerntmo/tmogs/datime.F
+++ /dev/null
@@ -1,83 +0,0 @@
-*
-* $Id: datime.F,v 1.1.1.1 1996/02/15 17:53:49 mclareni Exp $
-*
-* $Log: datime.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:49 mclareni
-* Kernlib
-*
-*
-#include "kerntmo/pilot.h"
- Subroutine DATIME(id,it)
-C
-C CERN PROGLIB# Z007 DATIME .VERSION KERNTMO 1.00 890208
-C ORIG. 03/02/89 K.M.STORR
-C
- integer*4 ndum(2),ntum(2),nd(2),nt(2)
- data ndum/4h01/0,4h1/89/,ntum/4h00.0,4h0.00/
-C
-c DATIME dummy - lacking appropriate clock function
- id=890101
- it=0000
- return
-c DATIMH dummy - lacking appropriate clock function
- Entry DATIMH(nd,nt)
- nd(1)=ndum(1)
- nd(2)=ndum(2)
- nt(1)=ntum(1)
- nt(2)=ntum(2)
- return
-c TIMEX returns execution time relative to the first call to TIMEST
- entry TIMEX(t)
- if(icall.eq.0)then
- t=0.
- else
- iend=itime()
- t=64.e-6*(iend-istart)
- endif
- return
-c TIMEL returns time remaining until time limit set by call to TIMEST
- entry TIMEL(t)
- if(icall.eq.0)then
- t=999.
- else
- iend=itime()
- time_elapsed=64.e-6*(iend-istart)
- t=tlim-time_elapsed
- endif
- return
-c TIMED returns execution time interval since last call to TIMED
- entry TIMED(t)
- iend=itime()
- t=64.e-6*(iend-iold)
- iold=iend
- return
-c TIMEST initialises timing operations
- entry TIMEST(t)
- data icall/0/
- if(icall.eq.0)then
- istart=itime()
- iold=istart
- tlim=t
- icall=1
- endif
- return
-c
- end
-#ifdef CERNLIB_TCGEN_DATIME
-#undef CERNLIB_TCGEN_DATIME
-#endif
-#ifdef CERNLIB_TCGEN_DATIMH
-#undef CERNLIB_TCGEN_DATIMH
-#endif
-#ifdef CERNLIB_TCGEN_TIMEL
-#undef CERNLIB_TCGEN_TIMEL
-#endif
-#ifdef CERNLIB_TCGEN_TIMEX
-#undef CERNLIB_TCGEN_TIMEX
-#endif
-#ifdef CERNLIB_TCGEN_TIMEST
-#undef CERNLIB_TCGEN_TIMEST
-#endif
-#ifdef CERNLIB_TCGEN_TIMED
-#undef CERNLIB_TCGEN_TIMED
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerntmo/tmogs/intrac.F b/src/packlib/kernlib/kerngen/obsolete/kerntmo/tmogs/intrac.F
deleted file mode 100644
index 66a45d2..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerntmo/tmogs/intrac.F
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: intrac.F,v 1.1.1.1 1996/02/15 17:53:49 mclareni Exp $
-*
-* $Log: intrac.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:49 mclareni
-* Kernlib
-*
-*
-#include "kerntmo/pilot.h"
- LOGICAL FUNCTION INTRAC(DUMMY)
-C
-C CERN PROGLIB# Z044 INTRAC .VERSION KERNTMO 1.00 890208
-C ORIG. 4/01/89 JZ
-C
-C- The program is considered interactive if standard input
-C- is connected to the terminal
-
- LOGICAL ISATTY
-
- INTRAC = ISATTY (5)
- RETURN
- END
-#ifdef CERNLIB_TCGEN_INTRAC
-#undef CERNLIB_TCGEN_INTRAC
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerntmo/tmogs/iuforw.F b/src/packlib/kernlib/kerngen/obsolete/kerntmo/tmogs/iuforw.F
deleted file mode 100644
index d3be9ae..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerntmo/tmogs/iuforw.F
+++ /dev/null
@@ -1,38 +0,0 @@
-*
-* $Id: iuforw.F,v 1.1.1.1 1996/02/15 17:53:50 mclareni Exp $
-*
-* $Log: iuforw.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:50 mclareni
-* Kernlib
-*
-*
-#include "kerntmo/pilot.h"
- FUNCTION IUFORW (IC,JL,JR)
-C
-C CERN PROGLIB# M410 IUFORW .VERSION KERNALT 1.00 890208
-C ORIG. 8/02/89 JZ
-C
- DIMENSION IC(99)
- COMMON /SLATE/ ND,JEND, DUMMY(38)
-
- ND = 0
- JEND = JL
- IVAL = 0
-
- 12 IF (JEND.GT.JR) GO TO 20
- K = IAND (IC(JEND),255)
- IF (K.EQ.32) GO TO 19
- IF (K.GE.58) GO TO 20
- K = K - 48
- IF (K.LT.0) GO TO 20
- IVAL = 10*IVAL + K
- ND = ND + 1
- 19 JEND = JEND + 1
- GO TO 12
-
- 20 IUFORW = IVAL
- RETURN
- END
-#ifdef CERNLIB_TCGEN_IUFORW
-#undef CERNLIB_TCGEN_IUFORW
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerntmo/tmogs/kerngt.F b/src/packlib/kernlib/kerngen/obsolete/kerntmo/tmogs/kerngt.F
deleted file mode 100644
index fef0513..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerntmo/tmogs/kerngt.F
+++ /dev/null
@@ -1,35 +0,0 @@
-*
-* $Id: kerngt.F,v 1.1.1.1 1996/02/15 17:53:49 mclareni Exp $
-*
-* $Log: kerngt.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:49 mclareni
-* Kernlib
-*
-*
-#include "kerntmo/pilot.h"
- SUBROUTINE KERNGT (LUN)
-C
-C CERN PROGLIB# Z001 KERNGT .VERSION KERNTMO 1.02 891211
-C ORIG. 16/03/89
-C
-C-- Store Pam title into /SLATE/ for printing by GSHOWF
-
- COMMON /SLATE/ MCH(40)
-
-C- GSHOW is the old name for KERNGT
- ENTRY GSHOW (LUN)
-
- CALL UCTOH1 (
- + CPP_TITLE_CH
- + // ' '
- +, MCH, 40)
- CALL GSHOWF (LUN)
- RETURN
- END
-#ifdef CERNLIB_TCGEN_KERNGT
-#undef CERNLIB_TCGEN_KERNGT
-#endif
-#ifdef CERNLIB_TCGEN_GSHOW
-#undef CERNLIB_TCGEN_GSHOW
-#endif
-#include "kerntmo/TITLE.kerntmo"
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerntmo/tmogs/locb.F b/src/packlib/kernlib/kerngen/obsolete/kerntmo/tmogs/locb.F
deleted file mode 100644
index ce0b61b..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerntmo/tmogs/locb.F
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: locb.F,v 1.1.1.1 1996/02/15 17:53:50 mclareni Exp $
-*
-* $Log: locb.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:50 mclareni
-* Kernlib
-*
-*
-#include "kerntmo/pilot.h"
- FUNCTION LOCB (VAR)
-C
-C CERN PROGLIB# N100 LOCB .VERSION KERNTMO 1.02 891211
-C ORIG. 07/12/89 J.CARTER
-C
-C THE FUNCTION LOCB(VAR) RETURNS THE MACHINE ADDRESS OF 'VAR'
-C
- LOCB = IADDRESS( VAR )
- RETURN
- END
-#ifdef CERNLIB_TCGEN_LOCB
-#undef CERNLIB_TCGEN_LOCB
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerntmo/tmogs/locf.F b/src/packlib/kernlib/kerngen/obsolete/kerntmo/tmogs/locf.F
deleted file mode 100644
index 038a7a2..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerntmo/tmogs/locf.F
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: locf.F,v 1.1.1.1 1996/02/15 17:53:50 mclareni Exp $
-*
-* $Log: locf.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:50 mclareni
-* Kernlib
-*
-*
-#include "kerntmo/pilot.h"
- FUNCTION LOCF (VAR)
-C
-C CERN PROGLIB# N100 LOCF .VERSION KERNTMO 1.00 890208
-C ORIG. 02/02/89 J.CARTER
-C
-C THE FUNCTION LOCF(VAR) RETURNS
-C THE MACHINE WORD-ADDRESS OF 'VAR', SUCH THAT
-C FOR EXAMPLE LOCF(A(11)) - LOCF(A(1)) GIVES =10
-C
- LOCF = ISHFT ( IADDRESS( VAR ) , -2 )
- RETURN
- END
-#ifdef CERNLIB_TCGEN_LOCF
-#undef CERNLIB_TCGEN_LOCF
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerntmo/tmogs/ublow.F b/src/packlib/kernlib/kerngen/obsolete/kerntmo/tmogs/ublow.F
deleted file mode 100644
index 5e58785..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerntmo/tmogs/ublow.F
+++ /dev/null
@@ -1,54 +0,0 @@
-*
-* $Id: ublow.F,v 1.1.1.1 1996/02/15 17:53:50 mclareni Exp $
-*
-* $Log: ublow.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:50 mclareni
-* Kernlib
-*
-*
-#include "kerntmo/pilot.h"
- SUBROUTINE UBLOW (MS,MT,NCHP)
-C
-C CERN PROGLIB# M409 UBLOW .VERSION KERNTMO 1.00 890208
-C ORIG. 03/02/89 K.M.STORR
-C
-
- DIMENSION MS(99), MT(99), NCHP(9)
- PARAMETER (IBLAN1 = ?I20202000)
- PARAMETER (MASK1 = ?I000000FF)
-
-
- NCH = NCHP(1)
- IF (NCH) 91, 29, 11
- 11 NWS = ishft (NCH,-2)
- NTRAIL = IAND (NCH,3)
- JT = 0
- IF (NWS.EQ.0) GO TO 26
-
-C-- Unpack the initial complete words
-
- DO 24 JS=1,NWS
- MWD = MS(JS)
- MT(JT+1) = IOR (IBLAN1,IAND(MASK1,MWD))
- MT(JT+2) = IOR (IBLAN1,IAND(MASK1,ISHFT(MWD, -8)))
- MT(JT+3) = IOR (IBLAN1,IAND(MASK1,ISHFT(MWD,-16)))
- MT(JT+4) = IOR (IBLAN1, ISHFT(MWD,-24) )
- 24 JT = JT + 4
-
- IF (NTRAIL.EQ.0) RETURN
-
-C-- Unpack the trailing word
-
- 26 MWD = MS(NWS+1)
-
- DO 28 JS=1,NTRAIL
- MT(JT+1) = IOR (IBLAN1,IAND(MASK1,MWD))
- MWD = ISHFT (MWD,-8)
- 28 JT = JT + 1
- 29 RETURN
-
- 91 CALL ABEND
- END
-#ifdef CERNLIB_TCGEN_UBLOW
-#undef CERNLIB_TCGEN_UBLOW
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerntmo/tmogs/ubunch.F b/src/packlib/kernlib/kerngen/obsolete/kerntmo/tmogs/ubunch.F
deleted file mode 100644
index 5d0e328..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerntmo/tmogs/ubunch.F
+++ /dev/null
@@ -1,55 +0,0 @@
-*
-* $Id: ubunch.F,v 1.1.1.1 1996/02/15 17:53:50 mclareni Exp $
-*
-* $Log: ubunch.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:50 mclareni
-* Kernlib
-*
-*
-#include "kerntmo/pilot.h"
- SUBROUTINE UBUNCH (MS,MT,NCHP)
-C
-C CERN PROGLIB# M409 UBUNCH .VERSION KERNTMO 1.00 890208
-C ORIG. 03/02/89 K.M.STORR
-C
-
- DIMENSION MS(99), MT(99), NCHP(9)
- PARAMETER (IBLAN1 = ?I20202020)
- PARAMETER (MASK1 = ?I000000FF)
-
-
- NCH = NCHP(1)
- IF (NCH) 91,39,11
- 11 NWT = ishft (NCH,-2)
- NTRAIL = IAND (NCH,3)
- JS = 0
- IF (NWT.EQ.0) GO TO 31
-
-C-- Pack the initial complete words
-
- DO 24 JT=1,NWT
- MT(JT) = IOR (IOR (IOR (
- + IAND(MS(JS+1),MASK1),
- + ishft (IAND(MS(JS+2),MASK1), 8)),
- + ishft (IAND(MS(JS+3),MASK1),16)),
- + ishft (MS(JS+4), 24) )
- 24 JS = JS + 4
-
- IF (NTRAIL.EQ.0) RETURN
-
-C-- Pack the trailing word
-
- 31 MWD = IBLAN1
- JS = NCH
-
- DO 34 JT=1,NTRAIL
- MWD = IOR (ishft(MWD,8), IAND(MS(JS),MASK1))
- 34 JS = JS - 1
- MT(NWT+1) = MWD
- 39 RETURN
-
- 91 CALL ABEND
- END
-#ifdef CERNLIB_TCGEN_UBUNCH
-#undef CERNLIB_TCGEN_UBUNCH
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerntmo/tmogs/uctoh.F b/src/packlib/kernlib/kerngen/obsolete/kerntmo/tmogs/uctoh.F
deleted file mode 100644
index 170ffe7..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerntmo/tmogs/uctoh.F
+++ /dev/null
@@ -1,30 +0,0 @@
-*
-* $Id: uctoh.F,v 1.1.1.1 1996/02/15 17:53:50 mclareni Exp $
-*
-* $Log: uctoh.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:50 mclareni
-* Kernlib
-*
-*
-#include "kerntmo/pilot.h"
- SUBROUTINE UCTOH (KCHAR,IHOLL,NPW,NCH)
-C
-C CERN PROGLIB# M409 UCTOH .VERSION KERNTMO 1.00 890208
-C ORIG. 3/02/89 K.M.STORR
-C
- CHARACTER*(*) KCHAR
- CHARACTER*1 CHBUF(400)
- INTEGER*4 IHOLL(100),NCH, NPW(100)
- INTEGER*4 HOLPAS(100)
- EQUIVALENCE (CHBUF(1),HOLPAS(1))
-C
- DO 1 JED = 1, NCH
- CHBUF( JED ) = KCHAR( JED:JED )
- 1 CONTINUE
-C
- CALL UTRANS (HOLPAS,IHOLL,NCH,99,NPW)
- RETURN
- END
-#ifdef CERNLIB_TCGEN_UCTOH
-#undef CERNLIB_TCGEN_UCTOH
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerntmo/tmogs/uctoh1.F b/src/packlib/kernlib/kerngen/obsolete/kerntmo/tmogs/uctoh1.F
deleted file mode 100644
index ea5204a..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerntmo/tmogs/uctoh1.F
+++ /dev/null
@@ -1,30 +0,0 @@
-*
-* $Id: uctoh1.F,v 1.1.1.1 1996/02/15 17:53:50 mclareni Exp $
-*
-* $Log: uctoh1.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:50 mclareni
-* Kernlib
-*
-*
-#include "kerntmo/pilot.h"
- SUBROUTINE UCTOH1 (KCHAR,IHOLL,NCH)
-C
-C CERN PROGLIB# M409 UCTOH1 .VERSION KERNTMO 1.00 890208
-C ORIG. 3/02/89 K.M.STORR
-C
- CHARACTER*(*) KCHAR
- CHARACTER*1 CHBUF(400)
- INTEGER*4 IHOLL(100),NCH
- INTEGER*4 HOLPAS(100)
- EQUIVALENCE (HOLPAS(1),CHBUF(1))
-C
- DO 1 JED = 1, NCH
- CHBUF( JED ) = KCHAR( JED:JED )
- 1 CONTINUE
-C
- CALL UBLOW (HOLPAS,IHOLL,NCH)
- RETURN
- END
-#ifdef CERNLIB_TCGEN_UCTOH1
-#undef CERNLIB_TCGEN_UCTOH1
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerntmo/tmogs/uh1toc.F b/src/packlib/kernlib/kerngen/obsolete/kerntmo/tmogs/uh1toc.F
deleted file mode 100644
index c49695c..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerntmo/tmogs/uh1toc.F
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: uh1toc.F,v 1.1.1.1 1996/02/15 17:53:50 mclareni Exp $
-*
-* $Log: uh1toc.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:50 mclareni
-* Kernlib
-*
-*
-#include "kerntmo/pilot.h"
- SUBROUTINE UH1TOC (IHOLL,KCHAR,NCH)
-C
-C CERN PROGLIB# M409 UH1TOC .VERSION KERNTMO 1.00 890208
-C ORIG. 03/02/89 K.M.STORR
-C
- CHARACTER*(*) KCHAR
- CHARACTER*1 CHBUF(400)
- INTEGER*4 IHOLL(100),NCH
- INTEGER*4 HOLPAS(100)
- EQUIVALENCE (CHBUF(1),HOLPAS(1))
-C
- CALL UBUNCH (IHOLL,HOLPAS,NCH)
-C
- DO 1 JED = 1, NCH
- KCHAR( JED:JED ) = CHBUF( JED )
- 1 CONTINUE
-C
- RETURN
- END
-#ifdef CERNLIB_TCGEN_UH1TOC
-#undef CERNLIB_TCGEN_UH1TOC
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerntmo/tmogs/uhtoc.F b/src/packlib/kernlib/kerngen/obsolete/kerntmo/tmogs/uhtoc.F
deleted file mode 100644
index c369384..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerntmo/tmogs/uhtoc.F
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: uhtoc.F,v 1.1.1.1 1996/02/15 17:53:50 mclareni Exp $
-*
-* $Log: uhtoc.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:50 mclareni
-* Kernlib
-*
-*
-#include "kerntmo/pilot.h"
- SUBROUTINE UHTOC (IHOLL,NPW,KCHAR,NCH)
-C
-C CERN PROGLIB# M409 UHTOC .VERSION KERNTMO 1.00 890208
-C ORIG. 03/02/89 K.M.STORR
-C
- CHARACTER* (*) KCHAR
- CHARACTER*1 CHBUF(400)
- INTEGER*4 IHOLL(100),NCH,NPW(100)
- INTEGER*4 HOLPAS(100)
- EQUIVALENCE (CHBUF(1),HOLPAS(1))
-C
- CALL UTRANS (IHOLL,HOLPAS,NCH,NPW,99)
-C
- DO 1 JED = 1, NCH
- KCHAR( JED:JED ) = CHBUF( JED )
- 1 CONTINUE
-C
- RETURN
- END
-#ifdef CERNLIB_TCGEN_UHTOC
-#undef CERNLIB_TCGEN_UHTOC
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerntmo/tmogs/uoptc.F b/src/packlib/kernlib/kerngen/obsolete/kerntmo/tmogs/uoptc.F
deleted file mode 100644
index 73b5b20..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerntmo/tmogs/uoptc.F
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: uoptc.F,v 1.1.1.1 1996/02/15 17:53:50 mclareni Exp $
-*
-* $Log: uoptc.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:50 mclareni
-* Kernlib
-*
-*
-#include "kerntmo/pilot.h"
- SUBROUTINE UOPTC (DATA,POSS,IOPTV)
-C
-C CERN PROGLIB# M502 UOPTC .VERSION KERNTMO 1.02 891211
-C ORIG. 11/12/89, Mik Storr
-C
- INTEGER IOPTV(9)
- CHARACTER*(*) DATA, POSS
-
-
- NP = LEN(POSS)
- ND = LEN(DATA)
- DO 25 J=1,NP
- IOPTV(J) = 0
- DO 24 K=1,ND
- IF (DATA(K:K).EQ.POSS(J:J)) IOPTV(J)=1
- 24 CONTINUE
- 25 CONTINUE
- RETURN
- END
-#ifdef CERNLIB_TCGEN_UOPTC
-#undef CERNLIB_TCGEN_UOPTC
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerntmo/tmogs/vxinvb.F b/src/packlib/kernlib/kerngen/obsolete/kerntmo/tmogs/vxinvb.F
deleted file mode 100644
index cc896ae..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerntmo/tmogs/vxinvb.F
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: vxinvb.F,v 1.1.1.1 1996/02/15 17:53:50 mclareni Exp $
-*
-* $Log: vxinvb.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:50 mclareni
-* Kernlib
-*
-*
-#include "kerntmo/pilot.h"
- SUBROUTINE VXINVB (MV,NW)
-
-C CERN PROGLIB# M434 VXINVB .VERSION KERNTMO 1.01 890303
-C ORIG. 12-June-87, F. Carminati + J. Zoll
-
-C- VX invert bytes, in-place
-C- Fortran version, slower than the machine-language routine
-
- DIMENSION MV(99)
- CHARACTER*1 LLD(4), LST(4)
- EQUIVALENCE (LLD,MLD), (LST,MST)
-
- DO 29 J=1,NW
- MLD = MV(J)
- LST(1) = LLD(4)
- LST(2) = LLD(3)
- LST(3) = LLD(2)
- LST(4) = LLD(1)
- MV(J) = MST
- 29 CONTINUE
- END
-#ifdef CERNLIB_TCGEN_VXINVB
-#undef CERNLIB_TCGEN_VXINVB
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerntmo/tmogs/vxinvc.F b/src/packlib/kernlib/kerngen/obsolete/kerntmo/tmogs/vxinvc.F
deleted file mode 100644
index 49fe85a..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerntmo/tmogs/vxinvc.F
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: vxinvc.F,v 1.1.1.1 1996/02/15 17:53:50 mclareni Exp $
-*
-* $Log: vxinvc.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:50 mclareni
-* Kernlib
-*
-*
-#include "kerntmo/pilot.h"
- SUBROUTINE VXINVC (MVI,MVX,NW)
-
-C CERN PROGLIB# M434 VXINVC .VERSION KERNTMO 1.01 890303
-C ORIG. 12-June-87, F. Carminati + J. Zoll
-
-C- VX invert bytes and copy
-C- Fortran version, slower than the machine-language routine
-
- DIMENSION MVI(99), MVX(99)
- CHARACTER*1 LLD(4), LST(4)
- EQUIVALENCE (LLD,MLD), (LST,MST)
-
- DO 29 J=1,NW
- MLD = MVI(J)
- LST(1) = LLD(4)
- LST(2) = LLD(3)
- LST(3) = LLD(2)
- LST(4) = LLD(1)
- MVX(J) = MST
- 29 CONTINUE
- END
-#ifdef CERNLIB_TCGEN_VXINVC
-#undef CERNLIB_TCGEN_VXINVC
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerntmo/tmogs/xinb.F b/src/packlib/kernlib/kerngen/obsolete/kerntmo/tmogs/xinb.F
deleted file mode 100644
index 528d7a7..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerntmo/tmogs/xinb.F
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: xinb.F,v 1.1.1.1 1996/02/15 17:53:51 mclareni Exp $
-*
-* $Log: xinb.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:51 mclareni
-* Kernlib
-*
-*
-#include "kerntmo/pilot.h"
- SUBROUTINE XINB (LUN,XBV,NXB)
-C
-C CERN PROGLIB# Z203 XINB .VERSION KERNTMO 1.00 890208
-C ORIG. 4/01/89 JZ
-C
- DIMENSION XBV(99)
-
- READ (LUN,IOSTAT=JSTAT) N, (XBV(J),J=1,MIN(N,NXB))
- IF (JSTAT) 61, 24, 64
- 24 N = MIN (N,NXB)
- NXB = MAX (N,1)
- RETURN
-
- 61 NXB = 0
- RETURN
-
- 64 NXB = -JSTAT
- RETURN
- END
-#ifdef CERNLIB_TCGEN_XINB
-#undef CERNLIB_TCGEN_XINB
-#endif
-#ifdef CERNLIB_XVECT_XINB
-#undef CERNLIB_XVECT_XINB
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerntmo/tmogs/xinbs.F b/src/packlib/kernlib/kerngen/obsolete/kerntmo/tmogs/xinbs.F
deleted file mode 100644
index 381a047..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerntmo/tmogs/xinbs.F
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: xinbs.F,v 1.1.1.1 1996/02/15 17:53:51 mclareni Exp $
-*
-* $Log: xinbs.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:51 mclareni
-* Kernlib
-*
-*
-#include "kerntmo/pilot.h"
- SUBROUTINE XINBS (LUN,XAV,NA,XBV,NXB)
-C
-C CERN PROGLIB# Z203 XINBS .VERSION KERNTMO 1.00 890208
-C ORIG. 4/01/89 JZ
-C
- DIMENSION XBV(99), XAV(NA)
-
- READ (LUN,IOSTAT=JSTAT) N,XAV,(XBV(J),J=1,MIN(N,NXB))
- IF (JSTAT) 61, 24, 64
- 24 N = MIN (N,NXB)
- NXB = MAX (N,1)
- RETURN
-
- 61 NXB = 0
- RETURN
-
- 64 NXB = -JSTAT
- RETURN
- END
-#ifdef CERNLIB_TCGEN_XINBS
-#undef CERNLIB_TCGEN_XINBS
-#endif
-#ifdef CERNLIB_XVECT_XINBS
-#undef CERNLIB_XVECT_XINBS
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerntmo/tmoprogs/Imakefile b/src/packlib/kernlib/kerngen/obsolete/kerntmo/tmoprogs/Imakefile
deleted file mode 100644
index 9603826..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerntmo/tmoprogs/Imakefile
+++ /dev/null
@@ -1,4 +0,0 @@
-SRCS_F= \ @@\
- fcasplit.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kerngen/obsolete/kerntmo/tmoprogs/fcasplit.F b/src/packlib/kernlib/kerngen/obsolete/kerntmo/tmoprogs/fcasplit.F
deleted file mode 100644
index 83557e2..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kerntmo/tmoprogs/fcasplit.F
+++ /dev/null
@@ -1,189 +0,0 @@
-*
-* $Id: fcasplit.F,v 1.1.1.1 1996/02/15 17:53:49 mclareni Exp $
-*
-* $Log: fcasplit.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:49 mclareni
-* Kernlib
-*
-*
-#include "kerntmo/pilot.h"
- PROGRAM FCASPLIT
-
- PARAMETER (MXLENA=64)
- PARAMETER (MXLENO=24)
-
- DIMENSION NOPTV(3)
- EQUIVALENCE (NOPTF,NOPTV(1))
- EQUIVALENCE (NOPTC,NOPTV(2))
- EQUIVALENCE (NOPTA,NOPTV(3))
-
- CHARACTER CHFIN*(MXLENA), CHFSH*(MXLENA)
- CHARACTER CHLINE*80, CHNAME*80
- CHARACTER CHIDF*8, CHIDC*8, CHIDA*8, CHIDX*4
-
- PARAMETER (CHIDF = 'CDECK I' )
- PARAMETER (CHIDC = '/*DECK I' )
- PARAMETER (CHIDA = '|DECK I' )
- PARAMETER (CHIDX = 'D>, ' )
-
- CHARACTER CHOPT(3)*(MXLENO)
- CHARACTER CHUSE*1
-
- DATA CHOPT(1) / '-c -Og -w' /
- DATA CHOPT(2) / '-c' /
- DATA CHOPT(3) / ' ' /
-
-
- PRINT 9001
- 9001 FORMAT (' FCASPLIT executing.')
- NARGS = IARGC()
- IF (NARGS.EQ.0) THEN
- PRINT 9002
- 9002 FORMAT (1X
- +/' FCASPLIT x.y optf optc opts splits a file x.y containing'
- +/' a mixture of Fortran/C/assembler routines into separate'
- +/' files n.f or n.c or n.s, n being the name of each routine,'
- +/' creating at the same time a shell script x.sh which can'
- +/' be executed to compile all routines separately.'
- +/' Parameters 2,3,4 are the option-strings to be used for'
- +/' the calls to the Fortran/C/assembly compilers.'
- +/1X
- +/' Each routine must start with an identifying line :'
- +/ ' "CDECK ID>, " in cols. 1-12 for Fortran'
- +/ ' "/*DECK ID>, " in cols. 1-12 for C'
- +/ ' "|DECK ID>, " in cols. 1-12 for assembler'
- +/ ' "n" in cols. 13-40 gives the name'
- +/ ' symbols . | < # ! all terminate'
- +/ ' symbol */ also terminates'
- +/1X)
- STOP 'no execution'
- ENDIF
-
-C------ Acquire the parameters
-
- CALL GETARG (1,CHFIN)
-
- N = LNBLNK (CHFIN)
- JA = 1
- JE = N
- J = N
- 16 IF (CHFIN(J:J).EQ.'/') THEN
- JA = J + 1
- GO TO 17
- ELSEIF (CHFIN(J:J).EQ.'.') THEN
- IF (JE.EQ.N) JE = J - 1
- ENDIF
- J = J - 1
- IF (J.NE.0) GO TO 16
- 17 CHFSH = CHFIN(JA:JE) // '.sh'
-
- DO 18 JJ=2,NARGS
- CALL GETARG (JJ,CHOPT(JJ-1))
- 18 CONTINUE
-
- PRINT 9014, CHFIN(1:LNBLNK(CHFIN))
- PRINT 9015, CHFSH(1:LNBLNK(CHFSH))
- PRINT 9016, CHOPT(1)(1:LNBLNK(CHOPT(1)))
- PRINT 9017, CHOPT(2)(1:LNBLNK(CHOPT(2)))
- PRINT 9018, CHOPT(3)(1:LNBLNK(CHOPT(3)))
- 9014 FORMAT (5X,' Input file : ',A)
- 9015 FORMAT (5X,' Shell script : ',A)
- 9016 FORMAT (5X,' Fortran options : ',A)
- 9017 FORMAT (5X,' cc options : ',A)
- 9018 FORMAT (5X,' Assembly options : ',A)
-
- DO 24 JJ=1,3
- NOPTV(JJ) = LNBLNK (CHOPT(JJ)) + 1
- 24 CONTINUE
-
-C-- Open input and .sh file
-
- 28 OPEN (11, FILE=CHFIN, STATUS='OLD')
- OPEN (21, FILE=CHFSH, STATUS='UNKNOWN')
- REWIND 11
- REWIND 21
-
-C-- Read next line
- ISTART = -12
- NROUT = 0
- NLINES = 0
- 31 READ (11,8031,END=71) CHLINE
- 8031 FORMAT (A)
-
- NCH = LNBLNK (CHLINE)
- NCH = MAX (NCH,1)
-
- 34 IF (CHLINE(9:12).NE.CHIDX) GO TO 35
- JTYPE = 1
- IF (CHLINE(1:8).EQ.CHIDF) GO TO 41
- IF (CHLINE(1:8).EQ.CHIDC) GO TO 42
- IF (CHLINE(1:8).EQ.CHIDA) GO TO 43
- 35 IF (ISTART.NE.0) GO TO 37
- 36 WRITE (22,8031) CHLINE(1:NCH)
- NLINES = NLINES + 1
- GO TO 31
-
-C-- Leading unheaded lines
-
- 37 IF (ISTART.EQ.-1) GO TO 31
- PRINT 9037, CHLINE(1:NCH)
- 9037 FORMAT (' ignored: ',A)
- ISTART = ISTART + 1
- GO TO 31
-
-C---- Start new routine
-
- 43 JTYPE = JTYPE + 1
- 42 JTYPE = JTYPE + 1
- 41 ISTART = 0
- NROUT = NROUT + 1
-
- JPUT = 0
- NUS = MIN(NCH,40)
- DO 44 JTK=13,NUS
- CHUSE = CHLINE(JTK:JTK)
- JV = ICHAR(CHUSE)
- IF (JV.EQ.32) GO TO 44
- IF (JV.EQ.46) GO TO 51
- IF (JV.EQ.124) GO TO 51
- IF (JV.EQ.60) GO TO 51
- IF (JV.EQ.35) GO TO 51
- IF (JV.EQ.33) GO TO 51
- IF (JV.EQ.42) THEN
- JN = ICHAR (CHLINE(JTK+1:JTK+1))
- IF (JN.EQ.47) GO TO 51
- ENDIF
- IF (JV.LT.91) THEN
- IF (JV.GE.65) CHUSE = CHAR(JV+32)
- ENDIF
- JPUT = JPUT + 1
- CHNAME(JPUT:JPUT) = CHUSE
- 44 CONTINUE
-
- 51 NPUT = JPUT + 2
-
- IF (JTYPE.EQ.1) THEN
- CHNAME(NPUT-1:NPUT) = '.f'
- WRITE (21,9052) 'f77',CHOPT(1)(1:NOPTF),CHNAME(1:NPUT)
- ELSEIF (JTYPE.EQ.2) THEN
- CHNAME(NPUT-1:NPUT) = '.c'
- WRITE (21,9052) 'cc',CHOPT(2)(1:NOPTC),CHNAME(1:NPUT)
- ELSEIF (JTYPE.EQ.3) THEN
- CHNAME(NPUT-1:NPUT) = '.s'
- WRITE (21,9052) 'as',CHOPT(3)(1:NOPTA),CHNAME(1:NPUT)
- ENDIF
- 9052 FORMAT (A,2X,A,2X,A)
-
- CLOSE (22)
- OPEN (22, FILE=CHNAME(1:NPUT),STATUS='UNKNOWN')
- REWIND 22
- PRINT 9054, NROUT,CHNAME(1:NPUT)
- 9054 FORMAT (' make',I4,1X,A)
- GO TO 36
-
-C---- Done
-
- 71 PRINT 9071, NLINES
- 9071 FORMAT (1X,I6,' lines written.')
- STOP
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/_guni/pilot.h b/src/packlib/kernlib/kerngen/obsolete/kernuni/_guni/pilot.h
deleted file mode 100644
index bf55dae..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/_guni/pilot.h
+++ /dev/null
@@ -1,15 +0,0 @@
-#if 0
-* This pilot patch was created from kernuni.car patch _guni
-#endif
-#ifndef CERNLIB_GUNI
-#define CERNLIB_GUNI
-#endif
-#ifndef CERNLIB_TCGEN
-#define CERNLIB_TCGEN
-#endif
-#ifndef CERNLIB_XVECTUNI
-#define CERNLIB_XVECTUNI
-#endif
-#ifndef CERNLIB_QMUNI
-#define CERNLIB_QMUNI
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/_guyfore/pilot.h b/src/packlib/kernlib/kerngen/obsolete/kernuni/_guyfore/pilot.h
deleted file mode 100644
index d550ce7..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/_guyfore/pilot.h
+++ /dev/null
@@ -1,24 +0,0 @@
-#if 0
-* This pilot patch was created from kernuni.car patch _guyfore
-#endif
-#ifndef CERNLIB_GUYFORE
-#define CERNLIB_GUYFORE
-#endif
-#if !defined(CERNLIB_U1110)
-#ifndef CERNLIB_U1108
-#define CERNLIB_U1108
-#endif
-#endif
-+EXE,GUYFORT_
-#ifndef CERNLIB_GUY
-#define CERNLIB_GUY
-#endif
-#ifndef CERNLIB_TCGEN
-#define CERNLIB_TCGEN
-#endif
-#ifndef CERNLIB_XVECTUNI
-#define CERNLIB_XVECTUNI
-#endif
-#ifndef CERNLIB_QMUNI
-#define CERNLIB_QMUNI
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/_guyfort/pilot.h b/src/packlib/kernlib/kerngen/obsolete/kernuni/_guyfort/pilot.h
deleted file mode 100644
index 53c19aa..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/_guyfort/pilot.h
+++ /dev/null
@@ -1,24 +0,0 @@
-#if 0
-* This pilot patch was created from kernuni.car patch _guyfort
-#endif
-#ifndef CERNLIB_GUYFORT
-#define CERNLIB_GUYFORT
-#endif
-#if !defined(CERNLIB_U1110)
-#ifndef CERNLIB_U1108
-#define CERNLIB_U1108
-#endif
-#endif
-+EXE,GUYFORT_
-#ifndef CERNLIB_GUY
-#define CERNLIB_GUY
-#endif
-#ifndef CERNLIB_TCGEN
-#define CERNLIB_TCGEN
-#endif
-#ifndef CERNLIB_XVECTUNI
-#define CERNLIB_XVECTUNI
-#endif
-#ifndef CERNLIB_QMUNI
-#define CERNLIB_QMUNI
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/_guyftn/pilot.h b/src/packlib/kernlib/kerngen/obsolete/kernuni/_guyftn/pilot.h
deleted file mode 100644
index 33617ca..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/_guyftn/pilot.h
+++ /dev/null
@@ -1,27 +0,0 @@
-#if 0
-* This pilot patch was created from kernuni.car patch _guyftn
-#endif
-#ifndef CERNLIB_GUYFTN
-#define CERNLIB_GUYFTN
-#endif
-#if !defined(CERNLIB_U1110)
-#ifndef CERNLIB_U1108
-#define CERNLIB_U1108
-#endif
-#endif
-+EXE,GUYFORT_
-#ifndef CERNLIB_GUY
-#define CERNLIB_GUY
-#endif
-#ifndef CERNLIB_TCGEN
-#define CERNLIB_TCGEN
-#endif
-#ifndef CERNLIB_XVECTUNI
-#define CERNLIB_XVECTUNI
-#endif
-#ifndef CERNLIB_QMUNO
-#define CERNLIB_QMUNO
-#endif
-#ifndef CERNLIB_F77
-#define CERNLIB_F77
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/abend.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/abend.s
deleted file mode 100644
index 9993b4d..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/abend.s
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: abend.s,v 1.1.1.1 1996/02/15 17:53:56 mclareni Exp $
-*
-* $Log: abend.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:56 mclareni
-* Kernlib
-*
-*
- . LAST MODIF. 01/09/76
- AXR$
- . CALL ABEND ABNORMAL JOB-STEP TERMINATION
- . STRASSBURG, AUG 1976
-$(1)
-ABEND*
- ER EABT$
- END
-#ifdef CERNLIB_TCGEN_ABEND
-#undef CERNLIB_TCGEN_ABEND
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/asortz.F b/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/asortz.F
deleted file mode 100644
index 3b0d6d0..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/asortz.F
+++ /dev/null
@@ -1,78 +0,0 @@
-*
-* $Id: asortz.F,v 1.1.1.1 1996/02/15 17:53:56 mclareni Exp $
-*
-* $Log: asortz.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:56 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
-C LAST MODIF.
-C FROM COPENHAGEN 3/05/72
- COMPILER (DATA=IBM),(FLD=ABS)
- SUBROUTINE ASORTZ(A,I,N)
- COMMON /SORT/ NSUB,NN1(70),NN2(70)
- DATA MAXMAX /O777777777777/
- DIMENSION A(2),I(2),IC(64)
- DATA (IC(J),J=1,32)
- */38,39,40,41,42,1,12,13,14,15,16,17,18,19,20,21,22,
- *23,24,25,26,27,28,29,30,31,32,33,34,35,36,37/
- DATA (IC(J),J=33,64)
- */43,44,45,46,47,48,49,50,51,52,53,54,55,56,57,58,
- *2,3,4,5,6,7,8,9,10,11,59,60,61,62,63,64/
- N2=0
- DO 30 NN=1,NSUB
- N1=N2+1
- NN1(NN)=N1
- N2=NN2(NN)
- IP=36
- DO 1 L=1,6
- IP=IP-6
- DO 2 K=N1,N2
- MAX=100
- DO 4 M=N1,N2
- IF=FLD(0,2,I(M))
- IF(IF) 5,5,4
- 5 J=FLD(19,17,I(M))
- ICC=FLD(IP,6,A(J))+1
- ICC=IC(ICC)
- IF(ICC-MAX) 6,4,4
- 6 MAX=ICC
- JJ=J
- MM=M
- 4 CONTINUE
- FLD(2,17,I(K))=JJ
- FLD(0,2,I(MM))=1
- 2 CONTINUE
- DO 7 K=N1,N2
- ICC=FLD(2,17,I(K))
- FLD(19,17,I(K))=ICC
- 7 FLD(0,2,I(K))=0
- 1 CONTINUE
- 30 CONTINUE
-C MERGE
- DO 40 K=1,N
- IMAX=MAXMAX
- DO 41 J=1,NSUB
- N1=NN1(J)
- IF(N1-NN2(J)) 42,42,41
- 42 KT=FLD(19,17,I(N1))
- LMAX=MAXMAX
- IP=-6
- DO 51 L=1,6
- IP=IP+6
- ICC=FLD(IP,6,A(KT))+1
- ICC=IC(ICC)-1
- 51 FLD(IP,6,LMAX)=IABS(ICC)
- IF(FLD(0,18,LMAX)-FLD(0,18,IMAX)) 44,45,41
- 45 IF(FLD(18,18,LMAX)-FLD(18,18,IMAX)) 44,41,41
- 44 IMAX=LMAX
- JJ=J
- KTT=KT
- 41 CONTINUE
- NN1(JJ)=NN1(JJ)+1
- FLD(2,17,I(K))=KTT
- 40 CONTINUE
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/cbyt.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/cbyt.s
deleted file mode 100644
index 9bcf941..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/cbyt.s
+++ /dev/null
@@ -1,30 +0,0 @@
-*
-* $Id: cbyt.s,v 1.1.1.1 1996/02/15 17:53:56 mclareni Exp $
-*
-* $Log: cbyt.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:56 mclareni
-* Kernlib
-*
-*
- . LAST MODIF.
- . ADAPTED FROM ORSAY, 1/10/76
-. SUBROUTINE CBYT(A,LA,X,LX,NBITS) *** M 421 ***
- AXR$
-$(1)
-CBYT*
- LNA A0,*3,X11 . -LX
- LNA A3,*1,X11 . -LA
- LA A5,*2,X11 . X
- LA A4,*0,X11 . A
- LA A2,*4,X11 . NBITS
- LSSC A5,37,A0 . THE BYTE AT LX OF X IS RIGHT ADJUSTED
- LSSC A4,37,A3 . THE BYTE AT LA OF A IS RIGHT ADJUSTED
- AN A0,A2 . -LX-NBITS
- DSL A4,0,A2 . INTRODUCE NEW BYTE AT LEFT
- SSC A5,37,A0 .
- SA A5,*2,X11 . NEW X
- J 6,X11
- END
-#ifdef CERNLIB_TCGEN_CBYT
-#undef CERNLIB_TCGEN_CBYT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/datime.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/datime.s
deleted file mode 100644
index 72612a1..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/datime.s
+++ /dev/null
@@ -1,45 +0,0 @@
-*
-* $Id: datime.s,v 1.1.1.1 1996/02/15 17:53:56 mclareni Exp $
-*
-* $Log: datime.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:56 mclareni
-* Kernlib
-*
-*
- . LAST MODIF. 01/09/76
- AXR$
- . CALL DATIME (ID,IT) RETURN INTEGER DATE + TIME
- . ID = YYMMDD, IT = HHMM
- . STRASSBURG, AUG 1976
-$(1)
-DATIME* ER TDATE$
- S A0,WORD
- .
- . PROCESS DATE
- L,S3 A1,WORD
- A,U A1,64 . A1= YY
- MSI,U A1,100 . A1= 100*YY
- L,S1 A2,WORD
- A A1,A2 . A1= 100*YY + MM
- MSI,U A1,100 . A1= 100 * (100*YY+MM)
- L,S2 A2,WORD
- A A1,A2 . A1= 100 * (100*YY+MM) + DD
- S A1,*0,X11
- .
- . PROCESS TIME
- LA,U A0,0
- L,H2 A1,WORD . A1= 60 * (60*HH+MM) + SS
- DI,U A0,60 . A0= 60*HH + MM
- L A1,A0
- LA,U A0,0
- DI,U A0,60 . A0= HH, A1= MM
- MSI,U A0,100
- AA A1,A0 . A1= 100*HH + MM
- S A1,*1,X11
- J 3,X11
-$(0)
-WORD + 0
- END
-#ifdef CERNLIB_TCGEN_DATIME
-#undef CERNLIB_TCGEN_DATIME
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/datimh.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/datimh.s
deleted file mode 100644
index dfde3b4..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/datimh.s
+++ /dev/null
@@ -1,64 +0,0 @@
-*
-* $Id: datimh.s,v 1.1.1.1 1996/02/15 17:53:56 mclareni Exp $
-*
-* $Log: datimh.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:56 mclareni
-* Kernlib
-*
-*
- . LAST MODIF. 01/09/76
- AXR$
- . CALL DATIMH (ND,NT) RETURN HOLLERITH DATE + TIME
- . ND = 8HDD/MM/YY, NT = 8HHH.MM.SS
- . STRASSBURG, AUG 1976
-$(1)
-DATIMH* ER DATE$
- S A1,TIME
- .
- . PROCESS DATE
- L A1,A0 . A1= MMDDYY
- SSL A1,24 . A1= 0000MM
- LSSL A1,6 . A1= 000MM0
- A A1,DM . A1= 00/MM/
- L A3,A0
- SSL A3,12 . A3= 00MMDD
- LSSL A3,24 . A3= DD0000
- A A1,A3 . A1= DD/MM/
- L,H2 A2,0,X11
- LXI,U A2,1
- S A1,0,*A2
- .
- LSSL A0,24 . A0= YY0000
- A A0,YY . A0= YY
- S A0,0,*A2
- .
- . PROCESS TIME
- L A1,TIME
- L A0,A1 . A0= HHMMSS
- SSL A0,24 . A0= 0000HH
- LSSC A0,24 . A0= HH0000
- A A0,W1 . A0= HH.00.
- L A2,A1
- LSSL A2,12 . A2= MMSS00
- SSL A2,24 . A2= 0000MM
- LSSL A2,6 . A2= 000MM0
- A A0,A2 . A0= HH.MM.
- L,H2 A2,1,X11
- LXI,U A2,1
- S A0,0,*A2
- .
- L A0,A1
- LSSL A0,24 . A0= SS0000
- A A0,W2 . A0= SS
- S A0,0,*A2
- J 3,X11
-$(0)
-TIME + 0
-DM + 0000074000074
-YY + 0000005050505
-W1 + 0000075000075
-W2 + 0000005050505
- END
-#ifdef CERNLIB_TCGEN_DATIMH
-#undef CERNLIB_TCGEN_DATIMH
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/erf.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/erf.s
deleted file mode 100644
index 86d43bc..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/erf.s
+++ /dev/null
@@ -1,90 +0,0 @@
-*
-* $Id: erf.s,v 1.1.1.1 1996/02/15 17:53:56 mclareni Exp $
-*
-* $Log: erf.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:56 mclareni
-* Kernlib
-*
-*
- . LAST MODIF. 09/10/74
- . FROM COPENHAGEN 3/05/72
- . FUNCTION ERF
- . FUNCTION ERFC(X)
- . FUNCTION FREQ(X)
- AXR$
-$(1)
- . ENTRY ERF
-ERF* SZ A5 . SET FLAG FOR ERF:
- L A4,*0,X11 . A4=X
- DS A6,REGS . SAVE REGISTERS.
- LM A6,A4 . A6=/X/
- L A7,KONS . A7=SIGN=+1.0
- TP A4 .
- L A7,(-1.0) . X 0 at A7=-1.0
- TG A6,(12.0) .
- J ERF1 . GO TO APPROX X V.LARGE
- L A2,KONS+6 . A2=KONS(7)
- FM A2,A6 . A2=KONS(7)*/X/
- L,U R2,4 . SET UP FOR LOOP
- LXM A1,KONSAD .
- LXI,U A1,-1 . A1=-1,ADR(KONS(6)
-ERF2 FA A2,0,*A1 .
- FM A2,A6 . A2=(A2+KONS(I))*/X/
- JGD R2,ERF2 . LOOP FOR NEXT TERM.
- FA A2,0,A1 . ADD 1.0
- L A3,KONS . A3=1.0
- FD A3,A2 . AND GET RECIPROCAL
- L A2,A3 . GET POWER 16
- FM A3,A2 . A3=S**2
- L A2,A3 .
- FM A3,A2 . A3=S**4
- L A2,A3 .
- FM A3,A2 . A3=S**8
- L A2,A3 .
- FM A3,A2 . A3=S**16
- L A2,KONS .
- FAN A2,A3 . A2=1.0-S**16
-ERF3 FM A2,A7 .
- L A0,A2 . ERF=A0=A2 FOR RETURN.
- DL A6,REGS . RESTORE REGISTERS.
- TNZ A5 . LOOK AT FLAG FOR RIGHT RETURN
- J 2,X11 . FLAG=0 at RETURN FOR ERF
- TP A5 .
- J ERFCR .
- FA A2,KONS . A2=1.0+ERF
- FM A2,KONS0 .
- L A0,A2 . ERF=0.5*(1.0+ERF)
- J 2,X11 . RETURN FROM FREQ.
-ERFCR L A3,KONS .
- FAN A3,A2 .
- L A0,A3 . ERFC=1.0-ERF
- J 2,X11 . RETURN FROM ERFC.
- . ENTRY ERFC
-ERFC* LN A5,KONS . SET FLAG NEGATIVE
- J ERF+1 . AND CARRY ON.
- . ENTRY FREQ
-FREQ* L A4,*0,X11 . A4=X
- FM A4,KONSF . A4=X/SQRT(2)
- L,U A5,1 . SET FLAG
- J ERF+2 . AND CARRY ON
-ERF1 L A2,KONS . HERE IF /X/ LARGE
- J ERF3 . A2=1.0
-$(2)
-KONS0 + 0.5
-KONS + 1.0
- + 0.070523078
- + 0.042282012
- + 0.0092705272
- + 0.0001520143
- + 0.0002765672
- + 0.0000430638
-KONSAD + $-2
-KONSF + 0.70710678 . 1/SQRT(2)
-REGS RES 2
- END
-#ifdef CERNLIB_TCGEN_ERF
-#undef CERNLIB_TCGEN_ERF
-#endif
-#ifdef CERNLIB_TCGEN_FREQ
-#undef CERNLIB_TCGEN_FREQ
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/gshow.F b/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/gshow.F
deleted file mode 100644
index 2ee862e..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/gshow.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: gshow.F,v 1.1.1.1 1996/02/15 17:53:56 mclareni Exp $
-*
-* $Log: gshow.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:56 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE GSHOW (LUN)
-C
-C-- STORE PAM TITLE INTO /SLATE/ FOR PRINTING BY GSHOWF
-C
- COMMON /SLATE/ CH(40)
-C
- CALL UBLOW (
- + 40H CPP_TITLE
- +, CH,40)
- CALL GSHOWF (LUN)
- RETURN
- END
-#ifdef CERNLIB_TCGEN_GSHOW
-#undef CERNLIB_TCGEN_GSHOW
-#endif
-#include "TITLE.kernuni"
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/incbyt.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/incbyt.s
deleted file mode 100644
index 34e4837..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/incbyt.s
+++ /dev/null
@@ -1,55 +0,0 @@
-*
-* $Id: incbyt.s,v 1.1.1.1 1996/02/15 17:53:56 mclareni Exp $
-*
-* $Log: incbyt.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:56 mclareni
-* Kernlib
-*
-*
- . LAST MODIF. 09/10/74
- . FROM COPENHAGEN 3/05/72
- . FUNCTION INCBYT(INC,IA,JTH,NBITS)
- AXR$
-$(1)
-INCBYT* DS A6,REGS . SAVE REGISTERS.
- L A1,3,X11 . A1=ADR(NBITS)
- L A4,0,A1 . A4=NBIT
- L A6,1,A1 . A6=INWORD
- L A5,2,A1 . A5=MAX
- L A1,*2,X11 . A1=JTH
- SZ A0 .
- L A2,A1 . A2=JTH
- AN,U A1,1 . A1=JTH-1
- DI A0,A6 . A0=JA-1=(JTH-1)/INWORD
- L A1,1,X11 . A1=ADR(A)
- A A1,A0 . A1=ADR(A)+JA-1
- MSI A0,A6 . A0=(JA-1)*INWORD
- AN A2,A0 . A2=JPOS=JTH-(JA-1)*INWORD
- L A6,0,A1 . A6=A(JA)
- AN,U A2,1 .
- L,U A3,36 .
- MSI A2,A4 . A2=(JPOS-1)*NBIT
- AN A3,A4 . A3=36-NBIT
- A A2,A4 . A2=LOC+NBIT
- SSC A6,0,A2 . ROT.RIGHT.CIRC.LOC+NBIT
- DSL A6,0,A3 . SHIFT LOG.RIGHT 36-NBIT
- L A3,A4 . A3=NBIT
- A A6,*0,X11 . A6=BYTE+INC
- TG A5,A6 . A6 =MAX<
- J $+5 . YES
- L A0,A6 . NO
- AN A0,A5 . A0=OVERFLOW=A6-MAX.
- L A6,A5 . BYTE=MAX
- J $+2 .
- SZ A0 . OVERFLOW=0
- DSL A6,0,A3 . SHIFT LOG.RIGHT NBIT
- LSSC A7,0,A2 . ROT.LEFT.CIRC. LOC
- S A7,0,A1 . REPLACE A(JA)
- DL A6,REGS . RESTORE REGISTERS.
- J 5,X11 . RETURN
-$(2)
-REGS RES 2
- END
-#ifdef CERNLIB_TCGEN_INCBYT
-#undef CERNLIB_TCGEN_INCBYT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/intsor.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/intsor.s
deleted file mode 100644
index a4be897..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/intsor.s
+++ /dev/null
@@ -1,40 +0,0 @@
-*
-* $Id: intsor.s,v 1.1.1.1 1996/02/15 17:53:56 mclareni Exp $
-*
-* $Log: intsor.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:56 mclareni
-* Kernlib
-*
-*
- . LAST MODIF. 09/10/74
- . FROM COPENHAGEN 3/05/72
- . CALL INTSOR(IA,A)
- AXR$
-$(1)
-INTSOR* L A0,0,X11 . A0=AD(IA)
- L A5,*1,X11 . A5=N
- AN,U A5,1 . A5=N-1
- L X3,A0 .
- LXI,U X3,1 . X3=1,AD(IA)
-SKOP1 L A1,X3 .
- A,U A1,1 . A1=(START AD FOR TESTING)
- L R1,A5 . SET LOOP COUNTER.
- L A2,0,X3 . SET UP AND SAVE
- L A3,A2 . INITIAL VALUE.
- L X2,X3 . SAVE ADDRESS IN X3.
-SKOP3 SLE A2,0,*A1 . FIND A SMALLER VALUE.
- J SKOP4 . NONE SMALLER
- AN,U A1,1 . BACKSPACE A1
- L X2,A1 . AND SAVE ADDRESS OF SMALLER VALUE.
- L A2,0,*A1 . RESET A2
- J SKOP3 . AND CONTINUE TESTING.
-SKOP4 S A2,0,*X3 . SMALLEST TO FIRST PLACE
- S A3,0,X2 . AND FIRST TO VACANCY.
- AN,U A5,1 . DECREMENT A5 FOR NEXT TIME ROUND.
- TZ A5 . ARE WE FINISHED<
- J SKOP1 . NO - LOOP FOR NEXT.
- J 3,X11 . YES - RETURN.
- END
-#ifdef CERNLIB_TCGEN_INTSOR
-#undef CERNLIB_TCGEN_INTSOR
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/isortz.F b/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/isortz.F
deleted file mode 100644
index 5eda0f2..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/isortz.F
+++ /dev/null
@@ -1,63 +0,0 @@
-*
-* $Id: isortz.F,v 1.1.1.1 1996/02/15 17:53:56 mclareni Exp $
-*
-* $Log: isortz.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:56 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
-C LAST MODIF.
-C FROM COPENHAGEN 3/05/72
- SUBROUTINE ISORTZ(IA,I,N)
- DIMENSION IA(2),I(2)
- COMMON /SORT/ NSUB,NN1(70),NN2(70)
-C FIND LARGEST NUMBER IF POSITIVE
- MAX=0
- DO 1 L=1,N
- K=I(L)
- IF(IA(K)) 1,1,2
- 2 IF(IA(K)-MAX) 1,1,3
- 3 MAX=IA(K)
- 1 CONTINUE
- MAX=MAX+1
- N2=0
- DO 30 J=1,NSUB
- N1=N2+1
- NN1(J)=N1
- N2=NN2(J)
- DO 10 L=N1,N2
- IMAX=MAX
- DO 11 M=N1,N2
- IF=FLD(0,2,I(M))
- IF(IF) 7,7,11
- 7 IM=FLD(19,17,I(M))
- IF(IA(IM)-IMAX) 8,11
- 8 IIM=IM
- IIF=M
- IMAX=IA(IM)
- 11 CONTINUE
- FLD(2,17,I(L))=IIM
- FLD(0,2,I(IIF))=1
- 10 CONTINUE
- DO 5 K=N1,N2
- 5 I(K)=FLD(2,17,I(K))
- 30 CONTINUE
-C MERGE SUBSETS
- DO 40 K=1,N
- IMAX=MAX
- DO 41 J=1,NSUB
- N1=NN1(J)
- IF(N1-NN2(J)) 42,42,41
- 42 KT=FLD(19,17,I(N1))
- IF(IA(KT)-IMAX) 44,41
- 44 IMAX=IA(KT)
- JJ=J
- KTT=KT
- 41 CONTINUE
- NN1(JJ)=NN1(JJ)+1
- FLD(2,17,I(K))=KTT
- 40 CONTINUE
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/iubin.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/iubin.s
deleted file mode 100644
index 1e73baa..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/iubin.s
+++ /dev/null
@@ -1,57 +0,0 @@
-*
-* $Id: iubin.s,v 1.1.1.1 1996/02/15 17:53:56 mclareni Exp $
-*
-* $Log: iubin.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:56 mclareni
-* Kernlib
-*
-*
- . LAST MODIF. 09/10/74
- . FROM COPENHAGEN 3/05/72
- . FUNCTIONS IUBIN(X,PAR,SPILL) AND IUHIST(X,PAR,SPILL)
- AXR$
-$(1)
-IUHIST* L A0,1,X11 . PU ADDRESS OF PAR
- L A2,0,A0 . A2=PAR(1)=NX (INTEGER)
- L A3,1,A0 . A3=PAR(2)=1./DX
- L A4,2,A0 . A4=PAR(3)=XLOW
- SZ A5 . SPILL=.FALSE.
- DS A6,XREG6 . SAVE TWO REGISTERS.
- L A6,*0,X11 . A6=X
- FAN A6,A4 .
- FM A6,A3 . A6=(X-XLOW)*(1./DX)
- TP A6 .
- J OVERFL . A6 0.
- FA A6,(1.0) . A6=(X-XLOW)*(1./DX)+1.
- LUF A6,A6 . CONVERT A6 TO INTEGER.
- AN,XU A6,163 .
- JP A6,OVER .
- SMA,H2 A6,$+2 . STORE SIZE OF RIGHT SHIFT.
- LSSC A7,8 . LEFT SHIFT 8 PLACES.
- SSA A7,0 . SHIFT LOADED FROM ABOVE.
-TEST L A0,A7 . IUHIST=N
- TG A2,A7 .
- J SLUTIT .
- L,U A5,1 . SPILL=.TRUE.
- A,U A2,1 .
- L A0,A2 . IUHIST=NX+1
- J SLUTIT .
-OVERFL L,U A5,1 . SPILL=.TRUE.
- SZ A0 . IUHIST=0
-SLUTIT DL A6,XREG6 . RESTORE REGISTERS
- S A5,*2,X11 . SET SPILL
- J 4,X11 . RETURN
-IUBIN* L A0,1,X11 . PU ADR.OF PAR
- L A2,0,A0 . A2=NX
- L A3,(1.0) .
- FD A3,1,A0 . A3=1./DX
- J IUHIST+3 .
-OVER L A7,(0377777777777) .
- J TEST .
-$(2)
-XREG6 + 0
-XREG7 + 0
- END
-#ifdef CERNLIB_TCGEN_IUBIN
-#undef CERNLIB_TCGEN_IUBIN
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/iuchan.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/iuchan.s
deleted file mode 100644
index 7055a9e..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/iuchan.s
+++ /dev/null
@@ -1,40 +0,0 @@
-*
-* $Id: iuchan.s,v 1.1.1.1 1996/02/15 17:53:56 mclareni Exp $
-*
-* $Log: iuchan.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:56 mclareni
-* Kernlib
-*
-*
- . LAST MODIF. 09/10/74
- . FROM COPENHAGEN 3/05/72
- . FUNCTION IUCHAN(X,XLOW,DX,NX)
- AXR$
-$(1)
-IUCHAN* L A0,*0,X11 . A0=X
- L A2,*1,X11 . A2=XLOW
- L A3,*2,X11 . A3=DX
- L A4,*3,X11 . A4=NX
- FAN A0,A2 .
- FD A0,A3 .
- FA A0,(1.0) . A0=AN=(X-XLOW)/DX+1.0
- TP A0 .
- SZ A0 .
- LUF A0,A0 . CONVERT TO INTEGER.
- AN,XU A0,163 .
- JP A0,OVER .
- SMA,H2 A0,$+2 .
- LSSC A1,8 .
- SSA A1,0 .
-TEST L A5,A4 . PRESET A5 FOR OVERFLOW.
- A,U A5,1 .
- L A0,A1 . IUCHAN=N
- TLE A4,A1 . N:NX<<
- L A0,A5 . YES - IUCHAN=NX+1
- J 5,X11 . RETURN
-OVER L A1,(0377777777777) .
- J TEST .
- END
-#ifdef CERNLIB_TCGEN_IUCHAN
-#undef CERNLIB_TCGEN_IUCHAN
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/iucomp.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/iucomp.s
deleted file mode 100644
index 5f0b02c..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/iucomp.s
+++ /dev/null
@@ -1,35 +0,0 @@
-*
-* $Id: iucomp.s,v 1.1.1.1 1996/02/15 17:53:56 mclareni Exp $
-*
-* $Log: iucomp.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:56 mclareni
-* Kernlib
-*
-*
- . LAST MODIF. 09/10/74
- . FROM COPENHAGEN 3/05/72
- . FUNCTION IUCOMP(T,A,N)
- AXR$
-$(1)
-IUCOMP* LM A2,*2,X11 . A2=/N/
- SZ A0
- TNZ A2 .
- J 4,X11 . N=0@@RETURN.
- L A1,1,X11 .
- LXI,U A1,1 . A1=1,AD(A)
- L A3,*0,X11 . A3=T
- AN,U A2,1 . A2=N-1
- L R3,A2 . R3=N-1
- SZ A5 .
- L A4,0,*A1 . PU ELEMENT AND
- A,U A5,1 .
- TNE A4,A3 . TEST IT.
- J $+3 . MATCH at -@LEAVE LOOP.
- JGD R3,$-4 . NO MATCH at -@LOOP FOR NEXT.
- J 4,X11 . NOT FOUND at -@RETURN
- L A0,A5 . IUCOMP=J
- J 4,X11 . FOUND at -@RETURN.
- END
-#ifdef CERNLIB_TCGEN_IUCOMP
-#undef CERNLIB_TCGEN_IUCOMP
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/iufind.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/iufind.s
deleted file mode 100644
index b1b0170..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/iufind.s
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: iufind.s,v 1.1.1.1 1996/02/15 17:53:56 mclareni Exp $
-*
-* $Log: iufind.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:56 mclareni
-* Kernlib
-*
-*
- . LAST MODIF. 09/10/74
- . FROM COPENHAGEN 3/05/72
- . FUNCTION IUFIND(T,A,JL,JR)
- AXR$
-$(1)
-IUFIND* L A2,*2,X11 . A2=JL
- L A3,*3,X11 . A3=JR
- AN A3,A2 . A3-JR-JL
- L R3,A3 . SET LOOP COUNTER.
- AN,U A2,1 . A2=JL-1
- L A1,1,X11 . PU AD(A)
- LXI,U A1,1 .
- L A3,*0,X11 . A3=T
- A A1,A2 . A1=1,AD(A)+JL-1
-OMIGEN A,U A2,1 . INCREMENT J
- L A4,0,*A1 . PU ELEMENT
- TNE A4,A3 . AND TEST IT.
- J $+3 . MATCH at -@LEAVE LOOP.
- JGD R3,OMIGEN . NO MATCH at -@GET NEXT.
- A,U A2,1 . NOT FOUND at -@J=JR+1.
- L A0,A2 . IUFIND=J
- J 5,X11 . RETURN
- END
-#ifdef CERNLIB_TCGEN_IUFIND
-#undef CERNLIB_TCGEN_IUFIND
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/iuhunt.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/iuhunt.s
deleted file mode 100644
index f7b92ec..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/iuhunt.s
+++ /dev/null
@@ -1,37 +0,0 @@
-*
-* $Id: iuhunt.s,v 1.1.1.1 1996/02/15 17:53:57 mclareni Exp $
-*
-* $Log: iuhunt.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:57 mclareni
-* Kernlib
-*
-*
- . LAST MODIF. 09/10/74
- . FROM COPENHAGEN 3/05/72
- . FUNCTION IUHUNT(T,A,N,INC)
- AXR$
-$(1)
-IUHUNT* SZ A0 .
- L A5,*2,X11 . A5=N
- TNZ A5 .
- J 5,X11 . N=0 at -@RETURN
- AN,U A5,1 . A5=N-1
- SZ A4 . PREPARE TO DIVIDE.
- L A3,*3,X11 . A3=INC
- DI A4,A3 . A4=(N-1)/INC
- L R3,A4 . SET LOOP COUNTER.
- L A1,1,X11 . PU AD(A)
- LXI A1,A3 . A1=INC,AD(A)
- L A2,*0,X11 . A2=T
- L,U A0,1 . START VALUE OF IUHUNT.
-PING L A5,0,*A1 . PU WORD AND
- TNE A5,A2 . TEST IT.
- J PONG . MATCH at -@LEAVE LOOP.
- A A0,A3 . INCREMENT J.
- JGD R3,PING . NO MATCH at -@LOOP.
- SZ A0 . NOT FOUND at -@IUHUNT=0.
-PONG J 5,X11 . RETURN
- END
-#ifdef CERNLIB_TCGEN_IUHUNT
-#undef CERNLIB_TCGEN_IUHUNT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/jbit.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/jbit.s
deleted file mode 100644
index a43d565..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/jbit.s
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: jbit.s,v 1.1.1.1 1996/02/15 17:53:57 mclareni Exp $
-*
-* $Log: jbit.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:57 mclareni
-* Kernlib
-*
-*
- . LAST MODIF.
- . ADAPTED FROM ORSAY, 1/10/76
-. FUNCTION JBIT(A,LA) *** M 421 ***
- AXR$
-$(1)
-JBIT*
- LNMA A2,*1,X11 . -LA
- LA A0,*0,X11 .
- LSSL A0,36,A2 . 36-LA
- SSL A0,35 .
- J 3,X11
- END
-#ifdef CERNLIB_TCGEN_JBIT
-#undef CERNLIB_TCGEN_JBIT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/jbyt.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/jbyt.s
deleted file mode 100644
index cf2a7ab..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/jbyt.s
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: jbyt.s,v 1.1.1.1 1996/02/15 17:53:57 mclareni Exp $
-*
-* $Log: jbyt.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:57 mclareni
-* Kernlib
-*
-*
- . LAST MODIF.
- . ADAPTED FROM ORSAY, 1/10/76
-. FUNCTION JBYT(A,LA,NBITS) *** M 421 ***
- AXR$
-$(1)
-JBYT*
- LNMA A2,*2,X11 . -NBITS
- ANU A2,*1,X11 . -LA-NBITS
- LA A0,*0,X11 . A
- LSSL A0,37,A3 . 37-LA-NBITS
- SSL A0,36,A2 . 36-NBITS
- J 4,X11
- END
-#ifdef CERNLIB_TCGEN_JBYT
-#undef CERNLIB_TCGEN_JBYT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/jbytet.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/jbytet.s
deleted file mode 100644
index 2df3c38..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/jbytet.s
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: jbytet.s,v 1.1.1.1 1996/02/15 17:53:57 mclareni Exp $
-*
-* $Log: jbytet.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:57 mclareni
-* Kernlib
-*
-*
-. LAST MODIF. 15/01/77
- . ADAPTED FROM ORSAY, 1/10/76
-. FUNCTION JBYTET(A,X,LX,NBITS) *** M 421 ***
- AXR$
-$(1)
-JBYTET*
- LNMA A0,*3,X11 . -NBITS
- ANU A0,*2,X11 . -LX-NBITS
- LA A4,*1,X11 . X
- LSSL A4,37,A1 . PUSH LEFT AND RIGHT PART OUT OF A4
- SSL A4,36,A0 .
- AND A4,*0,X11 . A.AND.BYTE(X)
- LA A0,A5 .
- J 5,X11
- END
-#ifdef CERNLIB_TCGEN_JBYTET
-#undef CERNLIB_TCGEN_JBYTET
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/jbytpk.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/jbytpk.s
deleted file mode 100644
index a00e801..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/jbytpk.s
+++ /dev/null
@@ -1,49 +0,0 @@
-*
-* $Id: jbytpk.s,v 1.1.1.1 1996/02/15 17:53:57 mclareni Exp $
-*
-* $Log: jbytpk.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:57 mclareni
-* Kernlib
-*
-*
- . LAST MODIF. 09/10/74
- . FROM COPENHAGEN 3/05/72
- . FUNCTION JBYTPK(A,JTH,NBITS)
- AXR$
-$(1)
-JBYTPK* S A6,REGS . SAVE REGISTER.
- L A0,2,X11 . A0=ADR(NBITS)
- L A4,0,A0 . A4=NBIT
- L A5,1,A0 . A5=INWORD
- L A3,*1,X11 . A3=JTH
- SZ A2 .
- L A6,A3 . A6=JTH
- L A1,0,X11 . A1=ADR(A)
- AN,U A3,1 . A3=JTH-1
- TP A4 . IS NBIT 1
- J $+3 .
- TZ A4 .
- J $+3 . NO
- L,U A5,36 . YES-INWORD=36
- L,U A4,1 . AND NBIT=1
- DI A2,A5 . A2=JA-1=(JTH-1)/INWORD
- A A1,A2 . A1=ADR(A)+JA-1
- MSI A2,A5 . A2=(JA-1)*INWORD
- AN A6,A2 . A6=JPOS=JTH-(JA-1)*INWORD
- L,U A2,36 .
- AN,U A6,1 .
- AN A2,A4 . A2=36-NBIT
- MSI A6,A4 .
- L A0,0,A1 . PU PACKED WORD
- A A6,A4 . LOC=(JPOS-1)*NBIT+NBIT
- L A3,A6 . A3=LOC
- SSC A0,0,A3 . ROT.CIRC.LOC PLACES RIGHT.
- SSL A0,0,A2 . SHIFT LOG. 36-NBIT RIGHT.
- L A6,REGS . RESTORE REGISTER.
- J 4,X11 . RETURN
-$(2)
-REGS + 0
- END
-#ifdef CERNLIB_TCGEN_JBYTPK
-#undef CERNLIB_TCGEN_JBYTPK
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/jrsbyt.F b/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/jrsbyt.F
deleted file mode 100644
index 18c75af..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/jrsbyt.F
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: jrsbyt.F,v 1.1.1.1 1996/02/15 17:53:57 mclareni Exp $
-*
-* $Log: jrsbyt.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:57 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- COMPILER(FLD=ABS)
-C LAST MODIF. 21/03/78
-C FROM COPENHAGEN 3/35/72
-
- FUNCTION JRSBYT(IVAL,X,JTH,NBITS)
-
- JRSBYT=FLD(37-JTH-NBITS,NBITS,X)
- FLD(37-JTH-NBITS,NBITS,X)=IVAL
- RETURN
- END
-#ifdef CERNLIB_TCGEN_JRSBYT
-#undef CERNLIB_TCGEN_JRSBYT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/locbyt.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/locbyt.s
deleted file mode 100644
index 2589434..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/locbyt.s
+++ /dev/null
@@ -1,54 +0,0 @@
-*
-* $Id: locbyt.s,v 1.1.1.1 1996/02/15 17:53:57 mclareni Exp $
-*
-* $Log: locbyt.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:57 mclareni
-* Kernlib
-*
-*
- . LAST MODIF.
- . ADAPTED FROM ORSAY, 1/10/76
-. FUNCTION LOCBYT( IT,VEC,N,INC,L,NBITS )***M 428 ***
- AXR$
-$(1)
-LOCBYT*
- L A5,*2,X11 . N
- L A4,*3,X11 . INC
- SZ A0
- LMA A1,A5 . IABS(N)
- JZ A4,IUH1 . IF INC=0 USE N=1
- DI A0,A4 . IABS(N)/INC
-IUH1 L,H2 A2,1,X11 . LOC(VEC)
- LN A3,*5,X11 . -NBITS
- TZ A1
- A,U A0,1 . COVERED DIVIDE
- LN A1,*4,X11 . -L
- SMA A0,R1 . NSCAN
- AN,U A0,1 . NSCAN-1
- JN A5,IUH3
-IUH2
- LN,XU A5,0 . MASK = -0
- LXI A2,A4
- SSL A5,36,A3 . KEEP ONLY NBITS BITS=1
- SSC A5,37,A1 . LEFT SHIFT L-1 PLACES TO GET THE MASK
- S A5,R2
- L A5,*0,X11 . IT
- SSC A5,37,A1 . LEFT SHIFT IT L-1 PLACES
- MSE A5,0,*A2 . SEARCH
- J IUH4
- AN A0,R1
- MSI A0,A4
- A,U A0,1
- J 7,X11
-. . N.LT.0
-IUH3 MSI A0,A4
- A A2,A0 . LOC(VEC(1+(NSCAN-1)*INC))
- LN A4,A4
- SZ A0
- J IUH2
-IUH4 SZ A0
- J 7,X11
- END
-#ifdef CERNLIB_TCGEN_LOCBYT
-#undef CERNLIB_TCGEN_LOCBYT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/locf.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/locf.s
deleted file mode 100644
index 5a8b05a..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/locf.s
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: locf.s,v 1.1.1.1 1996/02/15 17:53:57 mclareni Exp $
-*
-* $Log: locf.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:57 mclareni
-* Kernlib
-*
-*
- . LAST MODIF. 03/05/72
- . FROM COPENHAGEN 3/05/72
- AXR$
- . IADR=LOCF(VAR)
-LOCF* L,H2 A0,0,X11 . A0=ADR(VAR)
- J 2,X11 . RETURN
- END
-#ifdef CERNLIB_TCGEN_LOCF
-#undef CERNLIB_TCGEN_LOCF
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/margin.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/margin.s
deleted file mode 100644
index 7e2f35b..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/margin.s
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: margin.s,v 1.1.1.1 1996/02/15 17:53:57 mclareni Exp $
-*
-* $Log: margin.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:57 mclareni
-* Kernlib
-*
-*
- . LAST MODIF. 01/09/76
- AXR$
- . CALL MARGIN (TEXT,NWTX) PRINTER MARGIN CONTROL
- . STRASSBURG, AUG 1976
-$(1)
-MARGIN* L A0,*1,X11 . LENGTH OF TEXT
- LSSL A0,18 . SHIFT TO H1
- A A0,0,X11 . ADDRESS OF TEXT
- ER PRTCN$ . CALL PRINTER CONTROL
- J 3,X11 . RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/omsort.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/omsort.s
deleted file mode 100644
index d85db22..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/omsort.s
+++ /dev/null
@@ -1,45 +0,0 @@
-*
-* $Id: omsort.s,v 1.1.1.1 1996/02/15 17:53:57 mclareni Exp $
-*
-* $Log: omsort.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:57 mclareni
-* Kernlib
-*
-*
- . LAST MODIF. 09/10/74
- . FROM COPENHAGEN 3/05/72
- . SUBROUTINE OMSORT(A,N)
- AXR$
-$(1)
-OMSORT* L A0,0,X11 .
- AN,U A0,2 .
- LXI,U A0,1 . A0=1,ADR(A)-2
- L A4,*1,X11 .
- AN,U A4,2 . A4=N-2
- L R3,A4 . R3=N-2
- LXI,U A1,-1 .
-OMSOR1 L A2,3,A0 . PU SECOND NUMB.
- TLE A2,2,*A0 . AND COMPARE WITH FIRST.
- J $+3 . WRONG ORDER.
- JGD R3,OMSOR1 . CORRECT ORDER - CONTINUE.
- J 3,X11 . RETURN.
- L A3,1,A0 . EXCHANGE POSITIONS.
- S A2,1,A0 .
- S A3,2,A0 .
- LXM A1,A0 . SET UP TO WALK BACK.
- LN A5,R3 . A5=-R3
- A A5,A4 . A5=N-2-R3
- TNZ A5 . IF A5=0 WE ARE ALREADY THERE.
- J OMSOR1+3 . RETURN TO FORWARD LOOP.
- AN,U A5,1 .
- L R1,A5 . R1=N-2-R3-1
- L A2,1,A1 . PU SECOND NUMBER.
-OMSOR2 TG A2,0,*A1 . COMPARE WITH PREVIOUS.
- J OMSOR1+3 . RETURN TO FORWARD LOOP.
- L A3,1,A1 . EXCHANGE NUMBERS.
- S A2,1,A1 .
- S A3,2,A1 .
- JGD R1,OMSOR2 . TAKE ANOTHER STEP BACK.
- J OMSOR1+3 . WE HAVE REACHED START.
- . RETURN TO FORWARD LOOP.
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/pkbyt.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/pkbyt.s
deleted file mode 100644
index a6fe750..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/pkbyt.s
+++ /dev/null
@@ -1,80 +0,0 @@
-*
-* $Id: pkbyt.s,v 1.1.1.1 1996/02/15 17:53:57 mclareni Exp $
-*
-* $Log: pkbyt.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:57 mclareni
-* Kernlib
-*
-*
- . LAST MODIF. 09/10/74
- . FROM COPENHAGEN 3/05/72
- . PKBYT(M,A,JTH,N,NBITS)
- AXR$
-$(1)
-PKBYT* L A4,*3,X11 . A4=N
- TZ A4 .
- TP A4 .
- J PKBYT5 . N =0,RETURN
- DS A6,REGS . SAVE REGISTERS.
- DS A8,REGS+2 .
- A,U A4,1 . A4=N+1
- L,U A5,1 . A5=1
- L A0,0,X11 .
- LXI,U A0,1 . A0=1,ADR(M)
- L A1,4,X11 . A1=ADR(NBITS)
- L A2,0,A1 . A2=NBIT
- L A6,1,A1 . A6=INWORD
- L A1,1,X11 .
- LXI,U A1,1 . A1=1,ADR(A)
- TP A2 .
- J $+3 .
- TZ A2 .
- J PKBYT1 . NBIT:0
- L,U A2,1 . A2=NBIT=1
- L,U A6,36 . A6=INWORD=36
-PKBYT1 L A7,*2,X11 . A7=JTH
- TLE,U A7,2 .
- J PKBYT2 . JTH 2
- L A9,A7 .
- AN,U A9,1 .
- SZ A8 .
- DI A8,A6 . A8=(JTH-1)/INWORD
- A A1,A8 . FIND ADR.OF WORD IN A.
- LN A9,A8 . A9=-(JA-1)
- MSI A9,A6 .
- A A9,A7 . A9=JTH-(JA-1)*INWORD
- L A3,A9 .
- AN,U A3,1 .
- MSI A3,A2 . A3=LOC=((A9)-1)*NBIT
- L A7,A6 .
- A,U A7,2 .
- AN A7,A9 . A7=JH=INWORD+2-(A9)
- J $+4 .
-PKBYT2 L A7,A5 . JTH 2
- A A7,A6 . A7=JH=JM+INWORD
- SZ A3 . LOC=0
- TG A7,A4 .
- L A7,A4 . JH=MIN0(JH,N1)
-PKBYT4 L A8,0,*A0 . A8=M(JM)
- L A9,0,A1 . A9=A(JA)
- SSC A9,0,A3 . SHIFT RIGHT CIRC. LOC PLACES.
- DSL A8,0,A2 . DOUB.SHIFT LOG. NBIT
- A A3,A2 . LOC=LOC+NBIT
- LSSC A9,0,A3 . SHIFT LEFT CIRC. LOC+NBIT
- S A9,0,A1 . REPLACE WORD IN A
- A,U A5,1 . BUMP JM
- TLE A5,A7 . MORE TO DO<
- J PKBYT4 . YES-DO NEXT BYTE.
- TG A5,A4 . NEXT WORD IN A<
- J PKBYT5 . NO - RETURN
- L A9,0,*A1 . YES - INCREMENT A1.
- J PKBYT2 .
-PKBYT5 DL A6,REGS . RESTORE REGISTERS
- DL A8,REGS+2 .
- J 6,X11 . AND RETURN.
-$(2)
-REGS RES 4
- END
-#ifdef CERNLIB_TCGEN_PKBYT
-#undef CERNLIB_TCGEN_PKBYT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/prob.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/prob.s
deleted file mode 100644
index befd23a..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/prob.s
+++ /dev/null
@@ -1,159 +0,0 @@
-*
-* $Id: prob.s,v 1.1.1.1 1996/02/15 17:53:57 mclareni Exp $
-*
-* $Log: prob.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:57 mclareni
-* Kernlib
-*
-*
- . LAST MODIF. 09/10/74
- . FROM COPENHAGEN 3/05/72
- . FUNCTION PROB(CHI2,N)
- AXR$
-$(1)
-PROB* DS A6,REGS . SAVE REGISTERS
- DS A8,REGS+2 .
- DS A10,REGS+5 .
- S A12,REGS+7 .
- SZ A0 . FOR BLANK RETURNS.
- SX X11,REGS+4 .
- L A3,*0,X11 . A3=CHI2
- TNZ A3 .
- J PROB13 . SPECIAL EXIT IF CHI2=0.0
- L A4,*1,X11 . A4=N
- S A3,CHI2 . SAVE CHI2.
- S A4,N . AND N
- TZ A4 .
- TP A4 .
- J PROB12 . N =0 at RETURN
- TP A3 .
- J PROB12 . CHI2 0 at RETURN
- TG A4,KONS1 .
- J PROB7 . N:100
- TG A3,KONS2 .
- J PROB12 . CHI2:1483.32 at RETURN
- L A1,(-0.5) .
- FM A1,A3 .
- S A1,EMYO2 . EMYO2=-0.5*CHI2
- LMJ X11,EXP .
- + EMYO2 .
- + $-2-PROB,0 .
- S A0,EMYO2 . EMYO2=EXP(-0.5*CHI2)
- L A1,(1.0) . A1=SUM=1.0
- L A11,(1.0) . A11=TERM=1.0
- L A3,N .
- SSL A3,1 . DIVIDE BY 2
- S A3,M . M=N/2
- LSSC A3,1 . MULTIPLY BY 2
- TE A3,N .
- J PROB4 . N IS ODD
- L A3,M . N IS EVEN
- TNE,U A3,1 .
- J PROB3 . M=1
- L,U A10,1 . A10=I-1=1
- L A8,(0.5) . PRELOAD A8=0.5*CHI2
- FM A8,CHI2 .
- L,XU A6,155 . PRELOAD FOR FLOAT OP.
-PROB2 LCF A6,A10 . A7=FLOAT(I-1)
- FM A11,A8 .
- FD A11,A7 . A11=TERM=TERM*0.5*CHI2/FI
- FA A1,A11 . SUM=SUM+TERM
- A,U A10,1 . INCREMENT I-1
- TE A10,M .
- J PROB2 . LOOP FOR NEXT TIME ROUND
-PROB3 L A0,EMYO2 . HERE IF N=1
- FM A0,A1 .
- J PROB12 . RETURN
-PROB4 LMJ X11,SQRT . HERE IF N IS EVEN
- + CHI2 .
- + $-2-PROB,0 .
- S A0,SRTY .
- LMJ X11,FREQ .
- + SRTY .
- + $-2-PROB,0 .
- L A1,(1.0) .
- FAN A1,A0 .
- FM A1,(2.0) .
- L,U A2,1 .
- TE A2,N .
- J $+3 .
- L A0,A1 . PROB=VALUE
- J PROB12 . RETURN
- L A6,A1 .
- L A0,KONS3 .
- FM A0,SRTY .
- FM A0,EMYO2 . A0=.7978846*SRTY*EMYO2
- L,U A2,3 .
- L A11,(1.0) . A11=SUM=1.0
- L A7,(1.0) . A7=TERM=1.0
- TNE A2,N .
- J PROB6 . N=3
- L A3,M .
- AN,U A3,1 . A3=K=M-1
- L,U A2,1 . A2=I=1
- L,XU A4,155 . PRELOAD A4 FOR FLOAT OP.
-PROB5 LCF A4,A2 . A5=FLOAT(I)=FI
- L A9,(2.0) .
- FM A9,A5 .
- FM A7,CHI2 .
- FA A9,(1.0) .
- FD A7,A9 .
- FA A11,A7 . SUM=SUM+TERM
- A,U A2,1 . INCREMENT I
- TG A3,A2 .
- J PROB5 .
-PROB6 FM A0,A11 . N=3
- FA A0,A6 .
- J PROB12 . RETURN
-PROB7 L,XU A1,155 . PRELOAD A1 FOR FLOAT OP.
- LCF A1,A4 . A2=FLOAT(N)
- L A4,(1.0) .
- FD A4,A2 . A4=ANU=1./FLOAT(N)
- L A5,A4 .
- L A6,CHI2 .
- FD A5,(4.5) . A5=AN9=ANU/4.5
- FM A6,A4 .
- S A5,EMYO2 . SAVE RESULT
- S A6,N . SAVE RESULT
- LMJ X11,NEXP6$ .
- + N . A0=(A6)**KONS4
- + KONS4 .
- + $-3-PROB,0 .
- FA A0,EMYO2 .
- FAN A0,(1.0) .
- S A0,CHI2 .
- LMJ X11,SQRT .
- + EMYO2 .
- + $-2-PROB .
- L A1,CHI2 .
- FD A1,A0 .
- S A1,CHI2 .
- LMJ X11,FREQ .
- + CHI2 .
- + $-2-PROB,0 .
- L A1,(1.0) .
- FAN A1,A0 .
- L A0,A1 .
-PROB12 DL A6,REGS . RETURN SEQUENCE.
- DL A8,REGS+2 . RESTORE REGISTERS.
- DL A10,REGS+5 .
- L A12,REGS+7 .
- LX X11,REGS+4 .
- J 3,X11 . RETURN
-PROB13 L A0,(1.0) . CHI2=0.0@@SET PROB=1.0
- J PROB12 . AND EXIT.
-$(2)
-REGS RES 8
-KONS1 + 100
-KONS2 + 1483.32
-KONS3 + 0.7978846
-KONS4 + 0.3333333333
-CHI2 + 0
-N + 0
-EMYO2 + 0
-M + 0
-SRTY + 0
- END
-#ifdef CERNLIB_TCGEN_PROB
-#undef CERNLIB_TCGEN_PROB
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/sbit.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/sbit.s
deleted file mode 100644
index 805113a..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/sbit.s
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: sbit.s,v 1.1.1.1 1996/02/15 17:53:57 mclareni Exp $
-*
-* $Log: sbit.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:57 mclareni
-* Kernlib
-*
-*
- . LAST MODIF.
- . ADAPTED FROM ORSAY, 1/10/76
-. SUBROUTINE SBIT(A,X,LX) *** M 421 ***
- AXR$
-$(1)
-SBIT*
- LNA A0,*2,X11 . -LX
- LA A5,*1,X11 . X
- LA A4,*0,X11 . A
- LSSC A5,37,A0 . THE BIT LX IS RIGHT ADJUSTED
- DSL A4,1 .
- SSC A5,36,A0 .
- SA A5,*1,X11 .
- J 4,X11
- END
-#ifdef CERNLIB_TCGEN_SBIT
-#undef CERNLIB_TCGEN_SBIT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/sbit0.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/sbit0.s
deleted file mode 100644
index a17d0c1..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/sbit0.s
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: sbit0.s,v 1.1.1.1 1996/02/15 17:53:57 mclareni Exp $
-*
-* $Log: sbit0.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:57 mclareni
-* Kernlib
-*
-*
- . LAST MODIF.
- . ADAPTED FROM ORSAY, 1/10/76
-. SUBROUTINE SBIT0(X,LX) *** M 421 ***
- AXR$
-$(1)
-SBIT0*
- LNA A0,*1,X11 . -LX
- LA A5,*0,X11 . X
- LSSC A5,37,A0 . THE BIT LX IS RIGHT ADJUSTED
- SSL A5,1 . BIT = ZERO INTRODUCED AT LEFT
- SSC A5,36,A0 .
- SA A5,*0,X11 . NEW X
- J 3,X11
- END
-#ifdef CERNLIB_TCGEN_SBIT0
-#undef CERNLIB_TCGEN_SBIT0
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/sbit1.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/sbit1.s
deleted file mode 100644
index 5ff741e..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/sbit1.s
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: sbit1.s,v 1.1.1.1 1996/02/15 17:53:58 mclareni Exp $
-*
-* $Log: sbit1.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:58 mclareni
-* Kernlib
-*
-*
- . LAST MODIF.
- . ADAPTED FROM ORSAY, 1/10/76
-. SUBROUTINE SBIT1(X,LX) *** M 421 ***
- AXR$
-$(1)
-SBIT1*
- LNA A0,*1,X11 . -LX
- LA A5,*0,X11 . X
- LA,U A4,1 .
- LSSC A5,37,A0 . THE BIT LX IS RIGHT ADJUSTED
- DSL A4,1 . BIT = 1 INTRODUCED AT LEFT
- SSC A5,36,A0
- SA A5,*0,X11 . NEW X
- J 3,X11
- END
-#ifdef CERNLIB_TCGEN_SBIT1
-#undef CERNLIB_TCGEN_SBIT1
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/sbyt.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/sbyt.s
deleted file mode 100644
index 4d730ba..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/sbyt.s
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: sbyt.s,v 1.1.1.1 1996/02/15 17:53:58 mclareni Exp $
-*
-* $Log: sbyt.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:58 mclareni
-* Kernlib
-*
-*
- . LAST MODIF.
- . ADAPTED FROM ORSAY, 1/10/76
-. SUBROUTINE SBYT(A,X,LX,NBITS) *** M 421 ***
- AXR$
-$(1)
-SBYT*
- LNA A0,*2,X11 . -LX
- LA A5,*1,X11 . X
- LA A4,*0,X11 . A
- LA A2,*3,X11 . NBITS
- LSSC A5,37,A0 . THE BYTE AT LX OF X IS RUGHT ADJUSTED
- AN A0,A2 .
- DSL A4,0,A2 . NEW BYTE IS INTRODUCED AT LEFT
- SSC A5,37,A0 .
- SA A5,*1,X11 . NEW X
- J 5,X11
- END
-#ifdef CERNLIB_TCGEN_SBYT
-#undef CERNLIB_TCGEN_SBYT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/sbytor.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/sbytor.s
deleted file mode 100644
index 22b9dfc..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/sbytor.s
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: sbytor.s,v 1.1.1.1 1996/02/15 17:53:58 mclareni Exp $
-*
-* $Log: sbytor.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:58 mclareni
-* Kernlib
-*
-*
- . LAST MODIF.
- . ADAPTED FROM ORSAY, 1/10/76
-. SUBROUTINE SBYTOR(A,X,LX,NBITS) *** M 421 ***
- AXR$
-$(1)
-SBYTOR*
- LNA A0,*2,X11 . -LX
- LA A2,*1,X11 . X
- LA A1,*3,X11 . NBITS
- LSSC A2,37,A0 . THE BYTE AT LX IS RIGHT ADJUSTED
- AN A0,A1 . -LX-NBITS
- OR A2,*0,X11
- DSC A2,0,A1 . INTRODUCE NEW BYTE AT LEFT
- SSC A2,37,A0
- S A2,*1,X11
- J 5,X11
- END
-#ifdef CERNLIB_TCGEN_SBYTOR
-#undef CERNLIB_TCGEN_SBYTOR
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/sbytpk.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/sbytpk.s
deleted file mode 100644
index 4d661f9..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/sbytpk.s
+++ /dev/null
@@ -1,45 +0,0 @@
-*
-* $Id: sbytpk.s,v 1.1.1.1 1996/02/15 17:53:58 mclareni Exp $
-*
-* $Log: sbytpk.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:58 mclareni
-* Kernlib
-*
-*
- . LAST MODIF. 09/10/74
- . FROM COPENHAGEN 3/05/72
- . SUBROUTINE SBYTPK(M,A,JTH,NBITS)
- AXR$
-$(1)
-SBYTPK* L A0,3,X11 . A0=ADR(NBITS)
- L A2,0,A0 . A2=NBIT
- L A5,1,A0 . A5=INWORD
- L A4,*2,X11 . A4=JTH
- SZ A3 .
- L A1,A4 . SAVE VALUE OF JTH
- L A0,1,X11 . A0=ADR(A)
- AN,U A4,1 . A4=JTH-1
- TP A2 . IS NBIT 1<
- J $+3 .
- TZ A2 .
- J $+3 .
- L,U A5,36 . YES-INWORD=36
- L,U A2,1 . AND NBIT=1
- DI A3,A5 . A3=JA-1=(JTH-1)/INWORD
- A A0,A3 . A0=ADR(A)+JA-1
- MSI A3,A5 . A3=(JA-1)*INWORD
- AN A1,A3 . A1=JPOS=JTH-(JA-1)*INWORD
- L A5,0,A0 . PU CONTENTS OF A(JA)
- AN,U A1,1 .
- L A4,*0,X11 . PU M TO A4
- MSI A1,A2 . A1=LOC=(JPOS-1)*NBIT
- SSC A5,0,A1 . ROT.RIGHT LOC PLACES
- DSL A4,0,A2 . SHIFT LOGICAL RIGHT NBIT PLACES
- A A1,A2 . A1=LOC+NBIT
- LSSC A5,0,A1 . ROT LEFT LOC+NBIT PLACES
- S A5,0,A0 . REPLACE A(JA)
- J 5,X11 . RETURN
- END
-#ifdef CERNLIB_TCGEN_SBYTPK
-#undef CERNLIB_TCGEN_SBYTPK
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/sortzv.F b/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/sortzv.F
deleted file mode 100644
index 8046940..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/sortzv.F
+++ /dev/null
@@ -1,94 +0,0 @@
-*
-* $Id: sortzv.F,v 1.1.1.1 1996/02/15 17:53:58 mclareni Exp $
-*
-* $Log: sortzv.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:58 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
-C LAST MODIF.
-C FROM COPENHAGEN 3/05/72
- SUBROUTINE SORTZV(A,I,N,MODE,IWAY,ISEQ)
- DIMENSION A(2),I(2)
- COMMON /SORT/ NSUB,NN1(70),NN2(70)
- DATA BMAX /1.0E38/
- IF(N.LT.2) RETURN
-C SPLIT UP INTO SUBSETS
- AN=N
- AN=SQRT(AN/2.)
- NSUB=AN
- IF(N.LE.10) NSUB=1
- IF(NSUB.GT.70) NSUB=70
-C SET UP LIMITS
- LEN=N/NSUB
- NN2(1)=LEN
- IF(NSUB.EQ.1) GO TO 20
- DO 55 L=2,NSUB
- 55 NN2(L)=NN2(L-1)+LEN
- 20 NN2(NSUB)=N
- IF(ISEQ) 1,2,1
- 2 DO 3 L=1,N
- 3 I(L)=L
- 1 IF(MODE) 4,555,6
- 555 CALL ASORTZ(A,I,N)
- GO TO 100
- 4 CALL ISORTZ(A,I,N)
- GO TO 100
-C SORT FLOATING
- 6 CONTINUE
- N2=0
- DO 30 J=1,NSUB
- N1=N2+1
- NN1(J)=N1
- N2=NN2(J)
- DO 10 L=N1,N2
- AMAX=BMAX
- DO 11 M=N1,N2
- IF=(FLD(0,2,I(M))
- IF(IF) 7,7,11
- 7 IM=FLD(19,17,I(M))
- IF(A(IM)-AMAX) 8,11,11
- 8 IIM=IM
- IIF=M
- AMAX=A(IM)
- 11 CONTINUE
- FLD(2,17,I(L))=IIM
- FLD(0,2,I(IIF))=1
- 10 CONTINUE
- DO 5 K=N1,N2
- 5 I(K)=FLD(2,17,I(K))
- 30 CONTINUE
-C MERGE SUBSETS
- DO 40 K=1,N
- AMAX=BMAX
- DO 41 J=1,NSUB
- N1=NN1(J)
- IF(N1-NN2(J)) 42,42,41
- 42 KT=FLD(19,17,I(N1))
- IF(A(KT)-AMAX) 44,41
- 44 AMAX=A(KT)
- JJ=J
- KTT=KT
- 41 CONTINUE
- NN1(JJ)=NN1(JJ)+1
- FLD(2,17,I(K))=KTT
- 40 CONTINUE
-C REMOVE FLAGS AND FOLD
- 100 DO 12 L=1,N
- IRES=FLD(2,17,I(L))
- 12 I(L)=IRES
-C ORDER IWAY
- IF(IWAY) 13,14,13
- 13 NN=N/2
- DO 15 L=1,NN
- LL=N-L+1
- II=I(L)
- I(L)=I(LL)
- 15 I(LL)=II
- 14 RETURN
- END
-#ifdef CERNLIB_TCGEN_SORTZV
-#undef CERNLIB_TCGEN_SORTZV
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/timed.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/timed.s
deleted file mode 100644
index ea6456c..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/timed.s
+++ /dev/null
@@ -1,37 +0,0 @@
-*
-* $Id: timed.s,v 1.1.1.1 1996/02/15 17:53:58 mclareni Exp $
-*
-* $Log: timed.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:58 mclareni
-* Kernlib
-*
-*
- . LAST MODIF. 01/09/76
- AXR$
- . CALL TIMED (TD) TD = TIME - LAST, EXECUTION TIME INTERVAL
- . STRASSBURG, AUG 1976
-$(1)
-TIMED* L,U A1,2
- ER TWAIT$ . WAIT 2 MILLISECONDS
- L A0,(014,PCT) . LENGTH AND BUFFER ADDRESS
- ER PCT$
- LA,XU A2,155
- LCF A2,PCT+013
- FM A3,(2.0*-4) . TIME = TIME / 5000.
- L A0,LAST . TIME-VALUE OF LAST ENTRY
- S A3,LAST . SET TIME-VALE OF THIS ENTRY
- FAN A3,A0 . TD = TIME - LAST
- SA A3,*0,X11
- J 2,X11 . RETURN
-$(0)
-LAST + 0
- .
- . COMMON /SLATE/ PCT(14),DUMM(26)
-SLATE* INFO 2 4
-$(4)
-PCT RES 14
-DUM RES 26
- END
-#ifdef CERNLIB_TCGEN_TIMED
-#undef CERNLIB_TCGEN_TIMED
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/timel.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/timel.s
deleted file mode 100644
index 604f88b..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/timel.s
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: timel.s,v 1.1.1.1 1996/02/15 17:53:58 mclareni Exp $
-*
-* $Log: timel.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:58 mclareni
-* Kernlib
-*
-*
- . LAST MODIF. 01/09/76
- AXR$
- . CALL TIMEL (T) EXECUTION TIME LEFT
- . GENEVA UNIVERSITY, SEPTEMBER 1976
-$(1)
-TIMEL* L,U A1,2
- ER TWAIT$ . WAIT 2 MILLISECONDS
- L A0,(014,PCT) . LENGTH AND BUFFER ADDRESS
- ER PCT$
- LA A0,PCT+3 . NT TIME LIMIT IN SUP'S
- ANA A0,PCT+013 . - NU TIME USED IN SUP'S
- LA,XU A2,155
- LCF A2,A0 . TIME = FLOAT(NT-NU) SUP'S
- FM A3,(2.0*-4) . TIME = TIME / 5000.
- SA A3,*0,X11
- J 2,X11 . RETURN
- .
- . COMMON /SLATE/ PCT(14),DUMM(26)
-SLATE* INFO 2 4
-$(4)
-PCT RES 14
-DUM RES 26
- END
-#ifdef CERNLIB_TCGEN_TIMEL
-#undef CERNLIB_TCGEN_TIMEL
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/timex.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/timex.s
deleted file mode 100644
index 92bb24b..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/timex.s
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: timex.s,v 1.1.1.1 1996/02/15 17:53:58 mclareni Exp $
-*
-* $Log: timex.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:58 mclareni
-* Kernlib
-*
-*
- . LAST MODIF. 01/09/76
- AXR$
- . CALL TIMEX (T) T = EXECUTION TIME PAST
- . STRASSBURG, AUG 1976
-$(1)
-TIMEX* L,U A1,2
- ER TWAIT$ . WAIT 2 MILLISECONDS
- L A0,(014,PCT) . LENGTH AND BUFFER ADDRESS
- ER PCT$
- LA,XU A2,155
- LCF A2,PCT+013
- FM A3,(2.0*-4) . TIME = TIME / 5000.
- SA A3,*0,X11
- J 2,X11 . RETURN
- .
- . COMMON /SLATE/ PCT(14),DUMM(26)
-SLATE* INFO 2 4
-$(4)
-PCT RES 14
-DUM RES 26
- END
-#ifdef CERNLIB_TCGEN_TIMEX
-#undef CERNLIB_TCGEN_TIMEX
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/trac1q.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/trac1q.s
deleted file mode 100644
index b697014..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/trac1q.s
+++ /dev/null
@@ -1,66 +0,0 @@
-*
-* $Id: trac1q.s,v 1.1.1.1 1996/02/15 17:53:58 mclareni Exp $
-*
-* $Log: trac1q.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:58 mclareni
-* Kernlib
-*
-*
- . LAST MODIF.
- . FROM COPENHAGEN 3/05/72
- AXR$
-. COMMON/SLATE/ NAME,LINE,LADR,LOK,LASTWB,DUMMY(35)
-SLATE INFO 2 4
-$(4).
-NAME RES 1
-LINE RES 1
-LADR RES 1
-LOK RES 1
-LASTWB RES 1
-DUMMY RES 35
-$(2) LIT
-$(1)
-TRAC1Q* L,H2 A0,0,X11
- S A0,LASTWB
- J 1,X11
-.
-TRAC2Q* L A0,LASTWB
- TNZ A0
- J MAINEX
- L,XH2 A0,1,A0
- S A0,LADR . STORE LADR
-. ***************** VERIFY LADR LEGAL
- LMJ A1,CHECK
-FIND L,XH1 A1,0,A0
- TZ A1
- J GOTIT
- L,U A0,1,A0
- J FIND
-.
-GOTIT S A1,LINE .STORE LINE
- L,XH2 A0,0,A0
- S A0,LASTWB . STORE LWBP
- TNZ A0
- J MAIN
-. **************** VERIFY LWBP LEGAL
- LMJ A1,CHECK
- L A1,0,A0
-HOME S A1,NAME . STORE NAME
- J 1,X11
-MAIN L A1,('MAIN ')
- J HOME
-.
-CHECK TNG,U A0,01000
- J BAD
- TNG,U A0,LASTI$
- J 0,A1
- TNG,U A0,040000
- J BAD
- TNG,U A0,LASTD$
- J 0,A1
-BAD L A12,X11 . LOK= -VE
- SN A12,LOK
- J 1,X11
-MAINEX S X11,LOK . LOK= +VE
- J 1,X11
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/ublank.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/ublank.s
deleted file mode 100644
index 824fa10..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/ublank.s
+++ /dev/null
@@ -1,51 +0,0 @@
-*
-* $Id: ublank.s,v 1.1.1.1 1996/02/15 17:53:58 mclareni Exp $
-*
-* $Log: ublank.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:58 mclareni
-* Kernlib
-*
-*
- . LAST MODIF.
- . ADAPTED FROM ORSAY, 1/10/76
-. SUBROUTINE UBLANK(A,JL,JR) *** V300 ***
-. SUBROUTINE UZERO(A,JL,JR)
-. SUBROUTINE UFILL(A,JL,JR,STUFF)
-
- AXR$
-BLANK ' '
-$(1)
-UFILL*
- L A5,*3,X11 . STUFF
- L,U A1,1
- J UZR2
-UBLANK*
- L A5,BLANK
- J UZR1
-UZERO*
- SZ A5
-UZR1 L,U A1,0
-UZR2
- L A2,*1,X11 . JL
- L,U A0,A5
- JGD A2,$+2
- SZ A2 . MAX0(1,JL)-1
- ANU A2,*2,X11 . -JR+JL-1
- A,H2 A2,0,X11 . LOC(A(JL))
- TN A3
- J EX . DO NOTHING FOR JL.GT.JR
- SMA A3,R1
- LXI,U A2,1
- BT A2,0,*A0 . TRANSFER (A5) TO ARRAY A
-EX A X11,A1
- J 4,X11
- END
-#ifdef CERNLIB_TCGEN_UBLANK
-#undef CERNLIB_TCGEN_UBLANK
-#endif
-#ifdef CERNLIB_TCGEN_UFILL
-#undef CERNLIB_TCGEN_UFILL
-#endif
-#ifdef CERNLIB_TCGEN_UZERO
-#undef CERNLIB_TCGEN_UZERO
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/ublow.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/ublow.s
deleted file mode 100644
index 18ed8c2..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/ublow.s
+++ /dev/null
@@ -1,60 +0,0 @@
-*
-* $Id: ublow.s,v 1.1.1.1 1996/02/15 17:53:58 mclareni Exp $
-*
-* $Log: ublow.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:58 mclareni
-* Kernlib
-*
-*
- . LAST MODIF. 03/05/72
- . FROM COPENHAGEN 3/05/72
- AXR$
-$(2) LIT
- . CALL UBLOW (B,A,N)
-$(1)
-UBLOW* L,H2 A1,0,X11 . A1=ADR(B)
- L,H2 A0,1,X11
- LXI,U A0,1 . A0= (1, ADR(A))
- L A2,*2,X11 . A2= N
- L R2,(007777777777)
- TNG,U A2,6
- J SHORT
-.
- LXI,U A1,1
-NEXT L A3,0,*A1
- MLU A3,BLANK
- S A4,0,*A0
- LSSL A3,6
-CH5 MLU A3,BLANK
- S A4,0,*A0
- LSSL A3,6
-CH4 MLU A3,BLANK
- S A4,0,*A0
- LSSL A3,6
-CH3 MLU A3,BLANK
- S A4,0,*A0
- LSSL A3,6
-CH2 MLU A3,BLANK
- S A4,0,*A0
- LSSL A3,6
-CH1 MLU A3,BLANK
- S A4,0,*A0
-.
- AN,U A2,6
- TG,U A2,6
- J NEXT
-SHORT TNG,U A2,1
- J 4,X11 . EXIT
- L A3,0,A1
- J *KEY-1,A2
-$(2)
-BLANK + ' '
-KEY + CH1
- + CH2
- + CH3
- + CH4
- + CH5
- END
-#ifdef CERNLIB_TCGEN_UBLOW
-#undef CERNLIB_TCGEN_UBLOW
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/ubunch.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/ubunch.s
deleted file mode 100644
index 5ed355e..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/ubunch.s
+++ /dev/null
@@ -1,80 +0,0 @@
-*
-* $Id: ubunch.s,v 1.1.1.1 1996/02/15 17:53:58 mclareni Exp $
-*
-* $Log: ubunch.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:58 mclareni
-* Kernlib
-*
-*
- . LAST MODIF. 03/05/72
- . FROM COPENHAGEN 3/05/72
- AXR$
-$(2) LIT
- . CALL UBUNCH (A,B,N)
-$(1)
-UBUNCH* L,H2 A0,0,X11 . A0= ADR(A)
- LXI,U A0,1
- L,H2 A1,1,X11 . A1= ADR(B)
- L A2,*2,X11 . A2= N
- TNG,U A2,6
- J SHORT . LESS THAN 6 CHAR'S
-.
- LXI,U A1,1
-NEXT L,S1 A4,0,*A0
- LSSL A4,30 . CHAR 1
- L,S1 A3,0,*A0
- LSSL A3,24 . CHAR 2
- OR A3,A4
- L,S1 A3,0,*A0
- LSSL A3,18 . CHAR 3
- OR A3,A4
- L,S1 A3,0,*A0
- LSSL A3,12 . CHAR 4
- OR A3,A4
- L,S1 A3,0,*A0
- LSSL A3,6 . CHAR 5
- OR A3,A4
- L,S1 A3,0,*A0
- OR A3,A4
- S A4,0,*A1
-.
- AN,U A2,6
- TG,U A2,6
- J NEXT
-.
-SHORT TNG,U A2,1
- J 4,X11 . EXIT FOR NO TAIL
- L A4,(' ')
- L,H1 A3,KEY-1,A2
- J 0,A3
- .
-CH5 LSSL A4,6
- L,S1 A3,0,*A0
- OR A3,A4
-CH4 LSSL A4,6
- L,S1 A3,0,*A0
- OR A3,A4
-CH3 LSSL A4,6
- L,S1 A3,0,*A0
- OR A3,A4
-CH2 LSSL A4,6
- L,S1 A3,0,*A0
- OR A3,A4
-CH1 LSSL A4,6
- L,S1 A3,0,*A0
- OR A3,A4
-.
- L,H2 A3,KEY-1,A2
- LSSC A4,0,A3
- S A4,0,A1
- J 4,X11
-$(2)
-KEY + CH1,30
- + CH2,24
- + CH3,18
- + CH4,12
- + CH5,6
- END
-#ifdef CERNLIB_TCGEN_UBUNCH
-#undef CERNLIB_TCGEN_UBUNCH
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/ucocop.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/ucocop.s
deleted file mode 100644
index e6f52d9..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/ucocop.s
+++ /dev/null
@@ -1,63 +0,0 @@
-*
-* $Id: ucocop.s,v 1.1.1.1 1996/02/15 17:53:59 mclareni Exp $
-*
-* $Log: ucocop.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:59 mclareni
-* Kernlib
-*
-*
- . LAST MODIF. 09/10/74
- . FROM COPENHAGEN 3/05/72
- . UCOCOP AND UDICOP
- AXR$
-$(1)
- . ENTRY UDICOP(A,B,IDO,IW,NA,NB)
-UDICOP* L,U A5,1 . SET MODE FLAG.
- J $+2 .
- . ENTRY UCOCOP(A,B,IDO,IW,NA,NB)
-UCOCOP* SZ A5 . SET MODE FLAG.
- L A0,0,X11 . PU ADR(A)
- L A1,1,X11 . PU ADR(B)
- LXI,U A0,1 . A0=1,ADR(A)
- LXI,U A1,1 . A1=1,ADR(B)
- L A2,*2,X11 . A2=IDO
- L A3,*3,X11 . A3=IW
- TNZ A2 .
- J 7,X11 . RETURN@@-IDO=0
- TNZ A3 .
- J 7,X11 . RETURN@@-IW=0
- AN,U A2,1 . A2=IDO-1
- TNZ A5 . WHICH FUNCTION<
- J COCO . UCOCOP.
- L A4,A2 . UDICOP - GO BACKWARDS.
- MSI A4,*4,X11 . GET ADDRESS OF LAST
- A A4,A3 . WORD IN A
- AN,U A4,1 .
- A A0,A4 .
- L A4,A2 .
- MSI A4,*5,X11 . GET ADDRESS OF LAST
- A A4,A3 . WORD IN B
- AN,U A4,1 .
- A A1,A4 .
- LN A4,*4,X11 .
- A A4,A3 . A4=IW-NA
- LN A5,*5,X11 .
- A A5,A3 . A5=IW-NB
- LXI,U A0,-1 . REVERSE INDEX DIRECTION.
- LXI,U A1,-1 .
- J COPYAL .
-COCO L A4,*4,X11 .
- AN A4,A3 . A4=NA-IW
- L A5,*5,X11 .
- AN A5,A3 . A5=NB-IW
-COPYAL LR R3,A2 . R3=IDO-1
- LR R1,A3 . R1=IW
- BT A1,0,*A0 . SHIFT 'EM
- A A0,A4 . UPDATE ADDRESSES FOR
- A A1,A5 . NEXT BLOCK.
- JGD R3,$-4 . LOOP FOR NEXT BLOCK.
- J 7,X11 . ALL DONE at -RETURN.
- END
-#ifdef CERNLIB_TCGEN_UCOCOP
-#undef CERNLIB_TCGEN_UCOCOP
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/ucopy.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/ucopy.s
deleted file mode 100644
index 3c7f648..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/ucopy.s
+++ /dev/null
@@ -1,83 +0,0 @@
-*
-* $Id: ucopy.s,v 1.1.1.1 1996/02/15 17:53:59 mclareni Exp $
-*
-* $Log: ucopy.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:59 mclareni
-* Kernlib
-*
-*
- . LAST MODIF. 09/10/74
- . FROM COPENHAGEN 3/05/72
- . ROUTINES FOR TRANSFERRING DATA FROM ONE VECTOR TO
- . ANOTHER.
- . ENTRY UCOPY(A,B,N)
- AXR$
-$(1)
-UCOPY* L A0,*2,X11 . PICK UP N
- TNG,U A0,1 . AND TEST IT
- J 4,X11 . RETURN at -N =0.
- S A0,R1 . SET UP COUNTER
- L A0,0,X11 . GET ADDRESS OF A
- L A1,1,X11 . GET ADDRESS OF B
- LXI,U A0,1 .
- LXI,U A1,1 .
- J NORMAL . GO AND MOVE 'EM.
- . ENTRY UCOPY2(A,B,N)
-UCOPY2* L A2,*2,X11 . PICK UP N
- TNG,U A2,1 . AND TEST IT.
- J 4,X11 . RETURN
- S A2,R1 . SET COUNTER
- L A0,0,X11 .
- L A1,1,X11 .
- LXI,U A0,1 .
- LXI,U A1,1 .
- TNE A0,A1 .
- J 4,X11 . RETURN IF TOTAL OVERLAP
- TG A0,A1 . WHICH STARTS FIRST
- J NORMAL . A BEFORE B
- LXI,U A0,-1 . A BEFORE B
- LXI,U A1,-1 . GO BACKWARDS.
- AN,U A2,1 . A2=N-1
- A A0,A2 . GET LAST ADDRESS IN A
- A A1,A2 . AND IN B
-NORMAL BT A1,0,*A0 . MOVE N WORDS.
- J 4,X11 . RETURN at -ALL DONE.
- . ENTRY UCOPIV(A,B,N)
-UCOPIV* L A2,*2,X11 . PICK UP N AND
- TNG,U A2,1 . TEST IT.
- J 4,X11 . RETURN.
- L A0,0,X11 .
- LR R1,A2 . SET UP COUNTER
- L A1,1,X11 .
- AN,U A2,1 . A2=N-1
- LXI,U A0,1 .
- A A1,A2 . BACKWRDS THROUGH B
- LXI,U A1,-1 .
- J NORMAL . GO MOCE 'EM.
- . ENTRY UCOPYN(A,B,N)
-UCOPYN* L A2,*2,X11 . PICK UP N
- TNG,U A2,1 .
- J 4,X11 .
- AN,U A2,1 . A2=N-1
- LR R3,A2 .
- L A0,0,X11 .
- L A1,1,X11 .
- LXI,U A0,1 .
- LXI,U A1,1 .
-LODNEG LN A3,0,*A0 . P.U. (-B)
- S A3,0,*A1 . AND MOVE IT.
- JGD R3,LODNEG . LOOP FOR NEXT.
- J 4,X11 . RETURN
- END
-#ifdef CERNLIB_TCGEN_UCOPY
-#undef CERNLIB_TCGEN_UCOPY
-#endif
-#ifdef CERNLIB_TCGEN_UCOPY2
-#undef CERNLIB_TCGEN_UCOPY2
-#endif
-#ifdef CERNLIB_TCGEN_UCOPIV
-#undef CERNLIB_TCGEN_UCOPIV
-#endif
-#ifdef CERNLIB_TCGEN_UCOPYN
-#undef CERNLIB_TCGEN_UCOPYN
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/upkbyt.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/upkbyt.s
deleted file mode 100644
index 7f66a59..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/upkbyt.s
+++ /dev/null
@@ -1,84 +0,0 @@
-*
-* $Id: upkbyt.s,v 1.1.1.1 1996/02/15 17:53:59 mclareni Exp $
-*
-* $Log: upkbyt.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:59 mclareni
-* Kernlib
-*
-*
- . LAST MODIF. 09/10/74
- . FROM COPENHAGEN 3/05/72
- . SUBROUTINE UPKBYT(A,JTH,M,N,NBITS)
- AXR$
-$(1)
-UPKBYT* L A4,*3,X11 . A4=N
- TZ A4 .
- TP A4 .
- J 6,X11 . RETURN,N =0
- DS A6,REGS . SAVE REGISTERS.
- DS A8,REGS+2 .
- S A10,REGS+4 .
- A,U A4,1 . A4=N1=N+1
- L A0,2,X11 .
- L,U A5,1 . A5=JM=1
- LXI,U A0,1 . A0=1,ADR(M)
- L A1,4,X11 . A1=ADR(NBITS)
- L A2,0,A1 . A2=NBIT
- L A6,1,A1 . A6=INWORD
- L A1,0,X11 .
- LXI,U A1,1 . A1=1,ADR(A)
- TP A2 .
- J $+3 .
- TZ A2 .
- J UPKBT1 . NBIT:0
- L,U A2,1 . NBIT=1
- L,U A6,36 . INWORD=36
-UPKBT1 L A7,*1,X11 . A7=JTH
- L A10,A2 . SAVE VALUE OF NBIT.
- TLE,U A7,2 .
- J UPKBT2 . JTH 2
- L A9,A7 .
- SZ A8 .
- AN,U A9,1 . A9=JTH-1
- DI A8,A6 . A8=JA-1=(JTH-1)/INWORD
- A A1,A8 . MODIFY ADR. IN ARRAY A.
- LN A9,A8 . A9=-(JA-1)
- MSI A9,A6 .
- A A9,A7 . A9=JPOS=JTH-(JA-1)*INWORD
- L A3,A9 .
- L A7,A6 .
- AN,U A3,1 .
- A,U A7,2 .
- MSI A3,A2 . A3=LOC=(JPOS-1)*NBIT
- AN A7,A9 . A7=JH=INWORD+2-JPOS
- A A3,A2 . A3=LOC+NBIT
- J $+4 .
-UPKBT2 L A7,A5 . HERE IF JTH 2.
- L A3,A10 . A3=LOC=NBIT
- A A7,A6 . A7=JH=JM+INWORD
- TG A7,A4 .
- L A7,A4 . JH=MINO(JH,N1)
- L,U A2,36 .
- AN A2,A10 .
-UPKBT4 L A8,0,A1 . A8=A(JA)
- SSC A8,0,A3 . RIGHT CIRC. ROTATE LOC+NBIT
- A A3,A10 . A3=A3+NBIT
- SSL A8,0,A2 . RIGHT LOG. SHIFT 36-NBIT
- A,U A5,1 . BUMP JM
- S A8,0,*A0 . RESULT TO M(JM)
- TLE A5,A7 . MORE TO DO<
- J UPKBT4 . YES - LOOP.
- TG A5,A4 . NEXT WORD IN A<
- J UPKBT5 . NO - RETURN.
- L A8,0,*A1 . YES - INCREMENT ADR(A)
- J UPKBT2 . RESET AND CONTINUE.
-UPKBT5 DL A6,REGS . RESTORE REGISTERS.
- DL A8,REGS+2 .
- L A10,REGS+4 .
- J 6,X11 . RETURN
-$(2)
-REGS RES 5 . REGISTER STORAGE.
- END .
-#ifdef CERNLIB_TCGEN_UPKBYT
-#undef CERNLIB_TCGEN_UPKBYT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/vblank.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/vblank.s
deleted file mode 100644
index 3d0d456..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guni/vblank.s
+++ /dev/null
@@ -1,46 +0,0 @@
-*
-* $Id: vblank.s,v 1.1.1.1 1996/02/15 17:53:59 mclareni Exp $
-*
-* $Log: vblank.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:59 mclareni
-* Kernlib
-*
-*
- . LAST MODIF.
- . ADAPTED FROM ORSAY, 1/10/76
-. SUBROUTINE VBLANK( A,N ) *** F 121 ***
-. SUBROUTINE VZERO(A,N)
-. SUBROUTINE VFILL(A,N,STUFF)
- AXR$
-BLANK ' '
-$(1)
-VFILL*
- L A5,*2,X11
- L,U A1,1
- J VZR2
-VBLANK*
- L A5,BLANK
- J VZR1
-VZERO*
- SZ A5
-VZR1 L,U A1,0
-VZR2
- L A4,*1,X11 . N
- L,H2 A2,0,X11 . LOC( A )
- L,U A0,A5
- JZ A4,VZR3 . DO NOTHING IF N.EQ.0
- L R1,A4
- LXI,U A2,1
- BT A2,0,*A0
-VZR3 A X11,A1
- J 3,X11
- END
-#ifdef CERNLIB_TCGEN_VBLANK
-#undef CERNLIB_TCGEN_VBLANK
-#endif
-#ifdef CERNLIB_TCGEN_VFILL
-#undef CERNLIB_TCGEN_VFILL
-#endif
-#ifdef CERNLIB_TCGEN_VZERO
-#undef CERNLIB_TCGEN_VZERO
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/abend.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/abend.s
deleted file mode 100644
index bed433d..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/abend.s
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: abend.s,v 1.1.1.1 1996/02/15 17:53:59 mclareni Exp $
-*
-* $Log: abend.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:59 mclareni
-* Kernlib
-*
-*
-. ***************************** LAST MODIF.
-.
- . CALL ABEND ABNORMAL JOB-STEP TERMINATION
- . STRASSBURG, AUG 1976
- AXR$
-$(1)
-ABEND*
- ER EABT$
- END
-#ifdef CERNLIB_TCGEN_ABEND
-#undef CERNLIB_TCGEN_ABEND
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/cbyt.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/cbyt.s
deleted file mode 100644
index e35e5e1..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/cbyt.s
+++ /dev/null
@@ -1,43 +0,0 @@
-*
-* $Id: cbyt.s,v 1.1.1.1 1996/02/15 17:53:59 mclareni Exp $
-*
-* $Log: cbyt.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:59 mclareni
-* Kernlib
-*
-*
-. *****$$$*****$$$*****$$$*****
-.
-. SUBROUTINE CBYT(A,LA,X,LX,NBITS) *** M 421 ***
-. COPIES THE BYTE AT LA OF A INTO THE BYTE AT LX OF X
-. * DOES NOT CHECK LA, LX, NBITS VALUES
-. * SEE JBIT
-.
-. *****$$$*****$$$*****$$$*****
-
- AXR$
- FORT$
-$(1)
-CBYT*
-#include "ftnors1.inc"
-#include "spyuse.inc"
-* Ignoring t=pass
- DL A2,0,XARG
- L A4,0,A2 . A
- DL A1,2,XARG
- LNA A3,0,A3 . -LA
- L A0,4,XARG
- L A5,0,A1 . X
- LNA A2,0,A2 . -LX
- LSSC A4,37,A3 . THE BYTE AT LA OF A IS RIGHT ADJUSTED
- L A0,0,A0 . NBITS
- LSSC A5,37,A2 . THE BYTE AT LX OF X IS RIGHT ADJUSTED
- AN A2,A0 . -LX -NBITS
- DSC A4,0,A0 . INTRODUCE NEW BYTE AT LEFT
- SSC A5,37,A2
- S A5,0,A1 . NEW X
- J RETUR5
- END
-#ifdef CERNLIB_TCGEN_CBYT
-#undef CERNLIB_TCGEN_CBYT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/datime.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/datime.s
deleted file mode 100644
index 363a15c..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/datime.s
+++ /dev/null
@@ -1,51 +0,0 @@
-*
-* $Id: datime.s,v 1.1.1.1 1996/02/15 17:53:59 mclareni Exp $
-*
-* $Log: datime.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:59 mclareni
-* Kernlib
-*
-*
-. **************************************
-.
-. SUBROUTINE DATIME( ID, IT ) *** Z007 ***
-. RETURNS INTEGER DATE AND TIME
-. ID = YYMMDD, IT = HHMM
-.
-. **************************************
-
- AXR$
- FORT$
-SLATE INFO 2 2
-$(2),WORD RES 1
-
-$(1)
-DATIME*
-#include "ftnors1.inc"
-#include "spyuse.inc"
-* Ignoring t=pass
- DO FTN , S XARG,A3
- ER TDATE$
- S A0,WORD
- SZ A1
- L,S3 A4,WORD
- L,H2 A2,WORD
- A,U A4,64
- DI,U A1,60
- MSI,U A4,100
- SZ A0
- A,S1 A4,WORD
- DI,U A0,60
- DO FOR , DL A2,0,XARG . LOC(ID), LOC(IT)
- DO FTN , DL A2,0,A3
- MSI,U A4,100
- MSI,U A0,100
- A,S2 A4,WORD
- A A0,A1
- S A4,0,A2 . ID
- S A0,0,A3 . IT
- J RETUR2
- END
-#ifdef CERNLIB_TCGEN_DATIME
-#undef CERNLIB_TCGEN_DATIME
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/datimh.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/datimh.s
deleted file mode 100644
index e6234a7..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/datimh.s
+++ /dev/null
@@ -1,96 +0,0 @@
-*
-* $Id: datimh.s,v 1.1.1.1 1996/02/15 17:53:59 mclareni Exp $
-*
-* $Log: datimh.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:59 mclareni
-* Kernlib
-*
-*
-. **************************************
-.
-. SUBROUTINE DATIMH( ND, NT ) *** Z007 ***
-#if defined(CERNLIB_GUYFORE)||defined(CERNLIB_GUYFORT)
-. RETURNS FIELDATA DATE AND TIME
-#endif
-#if defined(CERNLIB_GUYFTN)
-. RETURNS ASCII DATE AND TIME
-#endif
-. ND = 8HDD/MM/YY, NT = 8HHH.MM.SS
-.
-. **************************************
-
- AXR$
- FORT$
-
-#if defined(CERNLIB_GUYFORE)||defined(CERNLIB_GUYFORT)
-$(0)
-PERIOD + 0750000750000
-SLASH + 0007400007400
-
-#include "gerr_c.inc"
-
-$(1)
-DATIMH*
-#include "ftnors1.inc"
-#include "spyuse.inc"
-* Ignoring t=pass
- ER DATE$
- L A5,BLANK
- S A0,A4
- S A5,A2
- DSL A4,12 . --------MMDDYYBBBB
- DSL A1,12 . --------HHMMSSBBBB
- SSC A4,12 . ------DD--MMYYBBBB
- LDSL A0,24 . ----HHMM----SSBBBB
- LDSL A3,12 . ----DD--MM--YYBBBB
- SSC A1,6 . ----HH-MM---SSBBBB
- A A4,SLASH . ----DD-/MM/-YYBBBB
- A A1,PERIOD . HH.MM.--SSBBBB
- LSSC A4,6 . ----DD/MM/--YYBBBB
- DSC A0,12 . ------HH.MM.SSBBBB
- DSC A3,12 . ------DD/MM/YYBBBB
- L A0,0,X11 . LOC(DATE)
- L A3,1,X11 . LOC(TIME)
- DS A4,0,A0 . DATE
- DS A1,0,A3 . TIME
- J RETUR2
-#endif
-#if defined(CERNLIB_GUYFTN)
-SLATE INFO 2 2
-$(2),WORD RES 2
-$(1)
-DATIMH*
- DL A2,0,XARG
- ER DATE$
- DS A0,WORD
- L,U A1,056000
- L,S3 A4,WORD
- L,S1 A0,WORD+1
- L,S2 A5,WORD
- LXI,S4 A1,WORD+1
- SSC A4,27
- SSC A0,27
- SSC A5,18
- A,S4 A4,WORD
- A,S2 A0,WORD+1
- A,U A5,057000
- A,S5 A1,WORD+1
- SSC A4,18
- SSC A0,18
- A,S5 A5,WORD
- SSC A1,27
- A,U A4,057000
- A,U A0,056000
- SSC A5,27
- A,S6 A1,WORD+1
- A,S1 A4,WORD
- A,S3 A0,WORD+1
- A,S6 A5,WORD
- DS A0,0,A3 . TIME
- DS A4,0,A2 . DATE
- J RETUR2
-#endif
- END
-#ifdef CERNLIB_TCGEN_DATIMH
-#undef CERNLIB_TCGEN_DATIMH
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/gshow.F b/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/gshow.F
deleted file mode 100644
index 733911f..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/gshow.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: gshow.F,v 1.1.1.1 1996/02/15 17:53:59 mclareni Exp $
-*
-* $Log: gshow.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:59 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE GSHOW (LUN)
-C
-C-- STORE PAM TITLE INTO /SLATE/ FOR PRINTING BY GSHOWF
-C
- COMMON /SLATE/ CH(40)
-C
- CALL UBLOW (
- + 40H CPP_TITLE
- +, CH,40)
- CALL GSHOWF (LUN)
- RETURN
- END
-#ifdef CERNLIB_TCGEN_GSHOW
-#undef CERNLIB_TCGEN_GSHOW
-#endif
-#include "TITLE.kernuni"
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/incbyt.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/incbyt.s
deleted file mode 100644
index 70361f2..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/incbyt.s
+++ /dev/null
@@ -1,86 +0,0 @@
-*
-* $Id: incbyt.s,v 1.1.1.1 1996/02/15 17:53:59 mclareni Exp $
-*
-* $Log: incbyt.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:59 mclareni
-* Kernlib
-*
-*
-. *****$$$*****$$$*****$$$*****
-.
-. FUNCTION INCBYT( INC,X,JX,MPACK ) *** M 423 ***
-. ADDS INCREMENT INC TO BYTE JX OF BYTE-VECTOR X
-. RETURNS OVERFLOW VALUE IF (BYTE+INC).GT.MPACK(3)
-. * ERROR EXIT GERR$ IF NBITS.LE.0 .OR. JX.LE.0
-. * NOT PROTECTED FOR INWORD=0
-. * NBITS MUST BE .LE.35 (GENERALLY NBITS.LE.18 )
-.
-. *****$$$*****$$$*****$$$*****
-
- AXR$
- FORT$
-$(1),FIRS01
- + 'INCBYT'
-INCBYT*
-#include "ftnors1.inc"
-#include "spyuse.inc"
-* Ignoring t=pass
- DL A3,0,XARG . LOC(INC), LOC(X)
- SZ A1
- L R1,0,A3 . INC
- DL A2,2,XARG . LOC(JX), LOC(MPACK)
- L A0,0,A3 . NBITS
- L A2,0,A2 . JX
- TG,U A0,1 . TEST NBITS.GT.0
- JGD A2,$+2
-LMJER1 SLJ GERR$ . ERROR EXIT IF JX.LE.0 .OR. NBITS.LE.0
- DI A1,1,A3 . (A1)=(JX-1)/INWORD=JW-1, (A2)=JB-1
- A,U A2,1 . JB
- A A1,A4 . LOC( X(JW) )
- MSI A2,A0 . JB*NBITS
- L A4,0,A1 . X(JW)
- LN A0,A0 . -NBITS
- L A3,2,A3 . MAX
- SSC A4,0,A2 . ADJUST BYTE AT LEFT OF A4
- DSL A4,36,A0 . PUSH RIGHT PART IN A5
- A A4,R1 . BYTE+INC
- TLE A3,A4 . TEST BYTE.GT.MAX
- J INCB40
- SZ A3
-INCB20
- LDSL A4,36,A0
- LSSC A4,0,A2 .
- L A0,A3
- SA A4,0,A1 .
- J RETUR4
-INCB40
- AN A4,A3 . LOST = BYTE-MAX
- DSC A3,36 . BYTE = MAX
- J INCB20
-
-#if (defined(CERNLIB_GUYDIAGP))&&(defined(CERNLIB_GUYFORT))
-. DIAGNOSTIC PACKETS FOR FORT
-#include "gerr_c.inc"
-F FORM 6,6,6,18
- INFO 010 03
-$(3)
-DIAG1 F 077,050,3,INCBYT
- + 0,DYN$
- + 'INCBYT'
- ON GERMAX
-DIAG2 F 077,067,2,0
- + LMJER1-FIRS01,DYN$
-DIAG3 F 077,047,LDIAG3,LMJER1+1
- + LDIAG3-2,DIAG2
- 'INCBYT(INC,X,JX,MPACK) ERROR: LX<1 OR MPACK(1)<1'
-LDIAG3 EQU $-DIAG3
- OFF
- ON GERMAX=0
-DIAG2 F 077,062,2,LMJER1+1
- + LMJER1-FIRS01,DIAG1
- OFF
-#endif
- END
-#ifdef CERNLIB_TCGEN_INCBYT
-#undef CERNLIB_TCGEN_INCBYT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/iubin.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/iubin.s
deleted file mode 100644
index ec55ffc..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/iubin.s
+++ /dev/null
@@ -1,70 +0,0 @@
-*
-* $Id: iubin.s,v 1.1.1.1 1996/02/15 17:53:59 mclareni Exp $
-*
-* $Log: iubin.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:59 mclareni
-* Kernlib
-*
-*
-. **************************************
-.
-. FUNCTION IUBIN( X, PAR, SPILL ) *** Y 202 ***
-. FUNCTION IUHIST( X, PAR, SPILL ) *** Y 203 ***
-. PAR(1)=NCHAN, PAR(2)=DX, PAR(3)=XLOW
-. RETURNS IUBIN = (X-XLOW)/DX+1. 0 FOR UNDERFLOW, NCHAN+1 FOR OVERFLOW
-. SPILL = .FALSE. WITHIN RANGE, .TRUE. FOR UNDERFLOW AND OVERFLOW
-. * DOES NOT CHECK PAR(2)>0, PAR(1) POSITIVE INTEGER
-. * ASSUMES NCHAN.LT.2**27
-. IUHIST: SAME AS IUBIN EXCEPTED FOR PAR(2)=1./DX
-.
-. **************************************
-
- AXR$
- FORT$
-$(1)
-IUBIN*
- L,U A3,0
-IUB0
-#include "ftnors1.inc"
-#include "spyuse.inc"
-* Ignoring t=pass
- DL A1,1,XARG . LOC(PAR), LOC(SPILL)
- L A0,0,XARG . LOC(X)
- LN A4,2,A1 . -XLOW
- FA A4,0,A0 . X-XLOW
- EX FDFM,A3 . (X-XLOW)/BINWIDTH
- JN A4,UNDFL
- LUF A4,A4 . CONVERT TO INTEGER
- L A0,0,A1 . NX
- TG,U A4,0234
- J OVFL . IUBIN.GE.2**27
- TLE,U A4,0201
- L,U A5,0 . IUBIN=1
- LN A3,A4
- SSA A5,0233,A3
- TG A5,A0
- J OVFL . IUBIN.GT.NX
- L A0,A5
- L,U A1,0
-IUB20
- A,U A0,1
- S A1,0,A2 . SPILL
- J RETUR3
-
-UNDFL LN,U A0,1
-OVFL L,U A1,1
- J IUB20
-
-IUHIST*
- L,U A3,1
- J IUB0
-
-FDFM FD A4,1,A1 . /DX
- FM A4,1,A1 . *(1./DX)
- END
-#ifdef CERNLIB_TCGEN_IUBIN
-#undef CERNLIB_TCGEN_IUBIN
-#endif
-#ifdef CERNLIB_TCGEN_IUHIST
-#undef CERNLIB_TCGEN_IUHIST
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/iuchan.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/iuchan.s
deleted file mode 100644
index 115dd52..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/iuchan.s
+++ /dev/null
@@ -1,48 +0,0 @@
-*
-* $Id: iuchan.s,v 1.1.1.1 1996/02/15 17:53:59 mclareni Exp $
-*
-* $Log: iuchan.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:59 mclareni
-* Kernlib
-*
-*
-. **************************************
-.
-. FUNCTION IUCHAN( X, XLOW, DX, NX ) *** Y 201 ***
-. * DOES NOT CHECK DX.GT.0) , NX.GT.0
-. * ASSUMES NX.LT.2**27
-.
-. **************************************
-
- AXR$
- FORT$
-$(1)
-IUCHAN*
-#include "ftnors1.inc"
-#include "spyuse.inc"
-* Ignoring t=pass
- DL A2,0,XARG . LOC(X), LOC(XLOW)
- DL A0,2,XARG . LOC(DX), LOC(NX)
- L A4,0,A2 . X
- FAN A4,0,A3 . X-XLOW
- FD A4,0,A0 . (X-XLOW)/DX
- JN A4,UNDFL . X.LT.XLOW
- LUF A4,A4
- L A0,0,A1 . NX
- TG,U A4,0234
- J OVFL . IUCHAN.GE.2**27
- TLE,U A4,0201
- L,U A5,0
- LN A3,A4
- SSA A5,0233,A3 .
- TG A5,A0
- J OVFL
- L A0,A5
-OVFL A,U A0,1
- J RETUR4
-UNDFL L,U A0,0
- J RETUR4 . RETURN
- END
-#ifdef CERNLIB_TCGEN_IUCHAN
-#undef CERNLIB_TCGEN_IUCHAN
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/iucomp.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/iucomp.s
deleted file mode 100644
index c5ce700..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/iucomp.s
+++ /dev/null
@@ -1,77 +0,0 @@
-*
-* $Id: iucomp.s,v 1.1.1.1 1996/02/15 17:53:59 mclareni Exp $
-*
-* $Log: iucomp.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:59 mclareni
-* Kernlib
-*
-*
-. $$$*****$$$*****$$$*****$$$*****
-.
-. FUNCTION IUCOMP( IT, IVEC,N ) *** V 304 ***
-. COMPARE WORD IT TO IVEC(1),...,IVEC(N) IF N.GT.0
-. COMPARE WORD IT TO IVEC(N),...,IVEC(1) IF N.LT.0
-. RETURNS IUCOMP=J AT FIRST MATCH W=V(J)
-. RETURNS IUCOMP=0 IF NO FIND OR N.EQ.0
-. * INTEGER OR SINGLE PRECISION IT, IVEC
-. * THIS IS A BIT TO BIT COMPARISON EXCEPTED IF IT=0
-. * WORKS IF IT = +0 OR -0
-.
-. $$$*****$$$*****$$$*****$$$*****
-
- AXR$
- FORT$
-$(1)
-IUCOMP*
-#include "ftnors1.inc"
-#include "spyuse.inc"
-* Ignoring t=pass
- L A3,2,XARG . LOC( N )
- DL A1,0,XARG . LOC( IT ), LOC( IVEC )
- L A0,0,A3 . N
- L A4,0,A1 . IT
- JZ A0,RETUR3
- SMA A0,R1
- JN A0,IUC3
-. IT .NE. 0 AND N.GT.0
- LXI,U A2,1
- JZ A4,IUC4
- SE A4,0,*A2
-IUC1 L A0,R1 . NO FIND
-IUC2 AN A0,R1 . FORTRAN LOCATION OF RESULT
- J RETUR3
-. IT .NE. 0 AND N.LT.0
-IUC3 A,U A0,1 . -N+1
- AN A2,A0
- LXI,U A2,-1
- JZ A4,IUC6
- L,U A0,1
- SE A4,0,*A2
- L,XU R1,-1
- A A0,R1
- J RETUR3
-. IT = +0 OR -0 AND N.GT.0
-IUC4 JGD R1,IUC5 . N-1
-IUC5 TNZ 0,*A2 . LOOP
- J IUC2
- JGD R1,IUC5
- J IUC1 . NO FIND
-. IT = +0 OR -0 AND N.LT.0
-IUC6 LN A0,A0 . N-1
-IUC7 TZ 0,*A2
- JGD A0,IUC7
- A,U A0,1 . FORTRAN LOCATION OF RESULT
- J RETUR3
-
-#if (defined(CERNLIB_WBACK))&&(defined(CERNLIB_GUYDIAGP))&&(defined(CERNLIB_GUYFORT))
- INFO 010 3
-$(3) + 0776003,IUCOMP
- + 0,SAVX11
- + 'IUCOMP'
-#include "gerr_c.inc"
-SAVX11 RES 1
-#endif
- END
-#ifdef CERNLIB_TCGEN_IUCOMP
-#undef CERNLIB_TCGEN_IUCOMP
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/iufind.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/iufind.s
deleted file mode 100644
index 1daa45a..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/iufind.s
+++ /dev/null
@@ -1,78 +0,0 @@
-*
-* $Id: iufind.s,v 1.1.1.1 1996/02/15 17:53:59 mclareni Exp $
-*
-* $Log: iufind.s,v $
-* Revision 1.1.1.1 1996/02/15 17:53:59 mclareni
-* Kernlib
-*
-*
-. *****$$$*****$$$*****$$$*****
-.
-. FUNCTION IUFIND( IT,IVEC,JL,JR ) *** V 304 ***
-. COMPARES THE WORD IT TO WORDS IVEC(JL), ... ,IVEC(JR)
-. RETURNS IUFIND=J AT FIRST MATCH IT=IVEC(J)
-. RETURNS IUFIND=JR+1 IF THE COMPARISON FAILS
-. * IF JL.LE.0 REPLACE BY JL=1
-. * ERROR EXIT GERRB$ IF JR.LT.MAX0(1,JL)
-. * WORKS IF IT = +0 OR -0
-. * SINGLE PRECISION IT,IVEC
-.
-. *****$$$*****$$$*****$$$*****
-
- AXR$
- FORT$
-$(1),FIRS01
- + 'IUFIND'
-IUFIND*
-#include "ftnors1.inc"
-#include "spyuse.inc"
-* Ignoring t=pass
- DL A2,2,XARG . LOC(JL), LOC(JR)
- DL A0,0,XARG . LOC( IT ),( LOC( IVEC )
- L A2,0,A2 . JL
- L A4,0,A0 . IT
- L A0,0,A3 . JR
- JGD A2,$+2
- SZ A2 . MAX0(1,JL)-1
- ANU A2,A0 . -JR+JL-1
- A A2,A1 . LOC(IVEC(JL))
- TN A3
-LMJER1 SLJ GERR$ . IF(JR-JL+1).LT.0
- SMA A3,R1
- LXI,U A2,1
- JZ A4,IUF2
- SE A4,0,*A2
- L,XU R1,-1
-IUF1 AN A0,R1 . FORTRAN LOCATION OF RESULT
- J RETUR4
-. IT = +0 OR -0
-IUF2 JGD R1,IUF3
-IUF3 TZ 0,*A2
- JGD R1,IUF3
- J IUF1
-
-#if (defined(CERNLIB_GUYDIAGP))&&(defined(CERNLIB_GUYFORT))
-. DIAGNOSTIC PACKETS FOR FORT
-#include "gerr_c.inc"
-F FORM 6,6,6,18
- INFO 010 03
-$(3),DIAG1 F 077,050,3,IUFIND
- + 0,DYN$
- + 'IUFIND'
- ON GERMAX
-DIAG2 F 077,067,2,0
- + LMJER1-FIRS01,DYN$
-DIAG3 F 077,047,LDIAG3,LMJER1+1
- + LDIAG3-2,DIAG2
- 'IUFIND(IT,IVEC,JL,JR) ERROR: JR<MAX0(1,JL)'
-LDIAG3 EQU $-DIAG3
- OFF
- ON GERMAX=0
-DIAG2 F 077,062,2,LMJER1+1
- + LMJER1-FIRS01,DIAG1
- OFF
-#endif
- END
-#ifdef CERNLIB_TCGEN_IUFIND
-#undef CERNLIB_TCGEN_IUFIND
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/jbit.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/jbit.s
deleted file mode 100644
index 08cb5e4..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/jbit.s
+++ /dev/null
@@ -1,37 +0,0 @@
-*
-* $Id: jbit.s,v 1.1.1.1 1996/02/15 17:54:00 mclareni Exp $
-*
-* $Log: jbit.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:00 mclareni
-* Kernlib
-*
-*
-. *****$$$*****$$$*****$$$*****
-.
-. FUNCTION JBIT(A,LA) *** M 421 ***
-. RETURNS BIT LA OF A
-. * RESTRICTIONS FOR ALL THE SHIFT ROUTINES OF PACKAGE
-. M 421, M 422, M 423, M 427, M 428
-. * NO CHECK IS DONE FOR THE VALUES OF LA,LX,NBITS
-. * ERRONEOUS VALUES WILL GIVE UNPREDICTABLE RESULTS
-. * SINGLE PRECISION A,X
-.
-. *****$$$*****$$$*****$$$*****
-
- AXR$
- FORT$
-$(1)
-JBIT*
-#include "ftnors1.inc"
-#include "spyuse.inc"
-* Ignoring t=pass
- DL A1,0,XARG . LOC(A), LOC(LA)
- LNMA A2,0,A2 . -LA
- L A0,0,A1 . A
- LSSL A0,36,A2 . 36-LA
- SSL A0,35 .
- J RETUR2
- END
-#ifdef CERNLIB_TCGEN_JBIT
-#undef CERNLIB_TCGEN_JBIT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/jbyt.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/jbyt.s
deleted file mode 100644
index fd3172b..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/jbyt.s
+++ /dev/null
@@ -1,35 +0,0 @@
-*
-* $Id: jbyt.s,v 1.1.1.1 1996/02/15 17:54:00 mclareni Exp $
-*
-* $Log: jbyt.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:00 mclareni
-* Kernlib
-*
-*
-. *****$$$*****$$$*****$$$*****
-.
-. FUNCTION JBYT(A,LA,NBITS) *** M 421 ***
-. RETURNS THE BYTE AT LA OF A
-. * SEE JBIT
-.
-. *****$$$*****$$$*****$$$*****
-
- AXR$
- FORT$
-$(1)
-JBYT*
-#include "ftnors1.inc"
-#include "spyuse.inc"
-* Ignoring t=pass
- DL A1,1,XARG . LOC(LA), LOC(NBITS)
- L A0,0,XARG . LOC(A)
- LNMA A2,0,A2 . -NBITS
- ANU A2,0,A1 . -LA-NBITS
- L A0,0,A0 . A
- LSSL A0,37,A3 . 37-LA-NBITS
- SSL A0,36,A2 . 36-NBITS
- J RETUR3
- END
-#ifdef CERNLIB_TCGEN_JBYT
-#undef CERNLIB_TCGEN_JBYT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/jbytet.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/jbytet.s
deleted file mode 100644
index 8fb769e..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/jbytet.s
+++ /dev/null
@@ -1,37 +0,0 @@
-*
-* $Id: jbytet.s,v 1.1.1.1 1996/02/15 17:54:00 mclareni Exp $
-*
-* $Log: jbytet.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:00 mclareni
-* Kernlib
-*
-*
-. *****$$$*****$$$*****$$$*****
-.
-. FUNCTION JBYTET(A,X,LX,NBITS) *** M 421 ***
-. RETURNS LOGICAL .AND. OF BYTE AT 1 IN A AND BYTE AT LX IN X
-. * SEE JBIT
-.
-. *****$$$*****$$$*****$$$*****
-
- AXR$
- FORT$
-$(1)
-JBYTET*
-#include "ftnors1.inc"
-#include "spyuse.inc"
-* Ignoring t=pass
- DL A1,2,XARG
- LNMA A2,0,A2 . -NBITS
- ANU A2,0,A1 . -LX-NBITS
- DL A0,0,XARG
- L A4,0,A1 . X
- LSSL A4,37,A3
- SSL A4,36,A2
- AND A4,0,A0 . A.AND.BYTE(X)
- LA A0,A5 .
- J RETUR4
- END
-#ifdef CERNLIB_TCGEN_JBYTET
-#undef CERNLIB_TCGEN_JBYTET
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/jbytpk.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/jbytpk.s
deleted file mode 100644
index a2a328e..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/jbytpk.s
+++ /dev/null
@@ -1,74 +0,0 @@
-*
-* $Id: jbytpk.s,v 1.1.1.1 1996/02/15 17:54:00 mclareni Exp $
-*
-* $Log: jbytpk.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:00 mclareni
-* Kernlib
-*
-*
-. *****$$$*****$$$*****$$$*****
-.
-. FUNCTION JBYTPK( A,JA,MPACK ) *** M 422 ***
-. RETURNS BYTE JA OF BYTE-VECTOR A
-. * RESTRICTIONS : SEE JBIT
-. * IF MPACK(1)=0 SET NBITS=1, INWORD=36
-. * DOES NOT CHECK NBITS,INWORD
-. * ERROR EXIT GERR$ IF JA.LE.0
-.
-. *****$$$*****$$$*****$$$*****
-
- AXR$
- FORT$
-$(0)
-PKBA + 1
- + 36
-$(1),FIRS01
- + 'JBYTPK'
-JBYTPK*
-#include "ftnors1.inc"
-#include "spyuse.inc"
-* Ignoring t=pass
- DL A2,1,XARG . LOC(JA), LOC(MPACK)
- L A2,0,A2 . JA
- DL A3,0,A3 . NBITS, INWORD
- SZ A1
- JGD A2,$+2 . JA-1
-LMJER3 SLJ GERR$ . ERROR EXIT IF JA.LE.0
- TNZ A3
- DL A3,PKBA . IF NBITS=0( SET NBITS=1, INWORD=36
- DI A1,A4 . (A1)=(JA-1)/INWORD=JW-1, (A2)=JB-1
- A,H2 A1,0,XARG . LOC(A(JW))
- A,U A2,1 . JB
- MSI A2,A3 . JB*NBITS
- L A0,0,A1 . A(JW)
- LN A3,A3 . -NBITS
- SSC A0,0,A2 . THE BYTE IS LEFT ADJUSTED
- SSL A0,36,A3 . THEN IT IS RIGHT ADJUSTED
- J RETUR3
-
-#if (defined(CERNLIB_GUYDIAGP))&&(defined(CERNLIB_GUYFORT))
-. DIAGNOSTIC PACKETS
-#include "gerr_c.inc"
-F FORM 6,6,6,18
- INFO 010 03
-$(3)
-DIAG21 F 077,050,3,JBYTPK
- + 0,DYN$
- + 'JBYTPK'
- ON GERMAX
-DIAG2 + 0776702,0
- + LMJER3-FIRS01,DYN$
-DIAG23 F 077,047,LDIA23,LMJER3+1
- + LDIA23-2,DIAG2
- 'JBYTPK( A,JA,MPACK ) ERROR: JA.LE.0'
-LDIA23 EQU $-DIAG23
- OFF
- ON GERMAX=0
-DIAG22 F 077,062,02,LMJER3+1
- + LMJER3-FIRS01,DIAG21
- OFF
-#endif
- END
-#ifdef CERNLIB_TCGEN_JBYTPK
-#undef CERNLIB_TCGEN_JBYTPK
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/jrsbyt.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/jrsbyt.s
deleted file mode 100644
index 71da727..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/jrsbyt.s
+++ /dev/null
@@ -1,45 +0,0 @@
-*
-* $Id: jrsbyt.s,v 1.1.1.1 1996/02/15 17:54:00 mclareni Exp $
-*
-* $Log: jrsbyt.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:00 mclareni
-* Kernlib
-*
-*
-. *****$$$*****$$$*****$$$*****
-.
-. FUNCTION JRSBYT(A,X,LX,NBITS) *** M 421 ***
-. READS AND RESET THE BYTE AT LX OF X
-. IX = JRSBYT(...) IS IDENTICAL TO
-. IX = JBYT(X,LX,NBITS) FOLLOWED BY
-. CALL SBYT(A,X,LX,NBITS)
-. RETURNS THE BYTE AT LX OF X AND REPLACE (IN LOCATION X)
-. THIS BYTE BY THE BYTE AT 1 IN A
-.
-. *****$$$*****$$$*****$$$*****
-
- AXR$
- FORT$
-$(1)
-JRSBYT*
-#include "ftnors1.inc"
-#include "spyuse.inc"
-* Ignoring t=pass
- DL A1,2,XARG . LOC(LX), LOC(NBITS)
- S A6,R1 . 7 REGISTERS NEEDED
- LNMA A2,0,A2 . -NBITS
- ANU A2,0,A1 . -LX-NBITS
- DL A0,0,XARG . LOC(A), LOC(X)
- L A4,0,A1 . X
- L A6,0,A0 . A
- LSSC A4,37,A3
- DSL A4,36,A2
- LDSC A5,36,A2
- L A0,A4 . BYTE(X)
- SSC A6,37,A3
- S A6,0,A1 . NEW X
- J RETUR4
- END
-#ifdef CERNLIB_TCGEN_JRSBYT
-#undef CERNLIB_TCGEN_JRSBYT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/locbyt.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/locbyt.s
deleted file mode 100644
index 9eca2e4..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/locbyt.s
+++ /dev/null
@@ -1,101 +0,0 @@
-*
-* $Id: locbyt.s,v 1.1.1.1 1996/02/15 17:54:00 mclareni Exp $
-*
-* $Log: locbyt.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:00 mclareni
-* Kernlib
-*
-*
-. $$$*****$$$*****$$$*****$$$*****
-.
-. FUNCTION LOCBYT( IT,VEC,N,INC,L,NBITS )***M 428 ***
-. SEARCHES VECTOR VEC EVERY INC WORD FOR THE FIRST WORD
-. WHICH CONTAINS 'IT' IN THE BYTE (L,NBITS)
-. THE ADDRESS OF THAT WORD IS THE FUNCTION VALVE
-. SCANS FROM VEC(1) TO VEC(1+((N-1)/INC)*INC) IF N.GT.0
-. SCANS THE SAME WORDS WITH REVERSED ORDER IF N.LT.0
-. RETURNS LOCBYT=0 IF NO FIND OR N=0
-. * ERROR EXIT GERRB$ IF INC.LT.0
-. * DOES NOT CHECK L AND NBITS VALUES
-. * USES N=1 IF INC=0
-. * THE COMPARISON DOES NOT USE THE FULL WORD IT , BUT
-. * ONLY THE NBITS RIGHMOST BITS
-.
-. $$$*****$$$*****$$$*****$$$*****
-
- AXR$
- FORT$
-$(1),FIRS01
- + 'LOCBYT'
-LOCBYT*
-#include "ftnors1.inc"
-#include "spyuse.inc"
-* Ignoring t=pass
- DL A2,0,XARG . LOC(IT), (A3) = LOC(VEC)
- L A4,0,A2 . IT
- DL A1,4,XARG . LOC(L), LOC(NBITS)
- LN,XU A5,0 . MASK = -0
- LN A2,0,A2 . -NBITS
- LN A1,0,A1 . -L
- SSL A5,36,A2 . KEEP ONLY NBITS BITS IN MASK
- SSC A4,37,A1 . IT SHIFTED LEFT L-1 PLACES
- SSC A5,37,A1 . SHIFT LEFT L-1 PLACES TO GET THE MASK
- DL A1,2,XARG . LOC(N), LOC(INC)
- S A5,R2
- L A5,0,A2 . INC
- L A2,0,A1 . N
- SZ A0
- LMA A1,A2 . IABS(N)
- JZ A5,IUH20 . IF INC=0 USE N=1
- TP A5
-LMJER1 SLJ GERR$ . ERROR EXIT IF INC.LT.0
- DI A0,A5 . IABS(N)/INC
-IUH20 TZ A1
- A,U A0,1 . COVERED DIVIDE
- S A0,R1 . NSCAN
- AN,U A0,1 . NSCAN-1
- JN A2,IUH60
-IUH30 LXI A3,A5
-
- MSE A4,0,*A3
- J IUH80
- AN A0,R1
- MSI A0,A5
- A,U A0,1
- J RETUR6
-IUH60 . N.LT.0
- MSI A0,A5
- A A3,A0
- LN A5,A5
- SZ A0
- J IUH30
-IUH80 . RETURN IF NO MATCH
- SZ A0
- J RETUR6
-
-#if (defined(CERNLIB_GUYDIAGP))&&(defined(CERNLIB_GUYFORT))
-. DIAGNOSTIC PACKETS FOR FORT
-#include "gerr_c.inc"
-F FORM 6,6,6,18
- INFO 010 03
-$(3)
-DIAG1 F 077,050,3,LOCBYT
- + 0,DYN$
- + 'LOCBYT'
- ON GERMAX
-DIAG2 F 077,067,2,0
- + LMJER1-FIRS01,DYN$
-DIAG3 F 077,047,LDIAG3,LMJER1+1
- + LDIAG3-2,DIAG2
- 'LOCBYT( BYT,VEC,N,INC,L,NB ) ERROR: INC<0'
-LDIAG3 EQU $-DIAG3
- OFF
- ON GERMAX=0
-DIAG2 F 077,062,2,LMJER1+1
- + LMJER1-FIRS01,DIAG1
- OFF
-#endif
- END
-#ifdef CERNLIB_TCGEN_LOCBYT
-#undef CERNLIB_TCGEN_LOCBYT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/locf.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/locf.s
deleted file mode 100644
index 18964f7..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/locf.s
+++ /dev/null
@@ -1,40 +0,0 @@
-*
-* $Id: locf.s,v 1.1.1.1 1996/02/15 17:54:00 mclareni Exp $
-*
-* $Log: locf.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:00 mclareni
-* Kernlib
-*
-*
-. $$$*****$$$*****$$$*****$$$*****
-.
-. FUNCTION LOCF ( X ) *** N 100 ***
-. RETURNS THE LOCATION OF X ( MACHINE ADDRESS )
-. ENTRY NAMES LOC, LOCF, XLOC
-.
-. $$$*****$$$*****$$$*****$$$*****
-
- AXR$
- FORT$
-$(1)
-LOCF*
-XLOC*
-#include "ftnors1.inc"
-#include "spyuse.inc"
-* Ignoring t=pass
- L A0,0,XARG . LOC(X)
- LXI,U A0,0
- J RETUR1
-
-#if (defined(CERNLIB_WBACK))&&(defined(CERNLIB_GUYDIAGP))&&(defined(CERNLIB_GUYFORT))
- INFO 010 3
-$(3) + 0776003,LOCF
- + 0,SAVX11
- + 'LOCF '
-#include "gerr_c.inc"
-SAVX11 RES 1
-#endif
- END
-#ifdef CERNLIB_TCGEN_LOCF
-#undef CERNLIB_TCGEN_LOCF
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/margin.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/margin.s
deleted file mode 100644
index 5167c83..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/margin.s
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: margin.s,v 1.1.1.1 1996/02/15 17:54:00 mclareni Exp $
-*
-* $Log: margin.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:00 mclareni
-* Kernlib
-*
-*
-. **************************************
-.
-. SUBROUTINE MARGIN( TEXT, LTEXT )
-. TRANSMITS A PRINT CONTROL IMAGE TO EXEC
-.
-. **************************************
-
- AXR$
- FORT$
-$(1)
-MARGIN*
-#include "ftnors1.inc"
-#include "spyuse.inc"
-* Ignoring t=pass
- DL A0,0,XARG
- LXI A0,0,A1 . LTEXT, LOC(TEXT)
- DO FOR , ER PRTCN$
- DO FTN , ER APRTCN$
- J RETUR2
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/pkbyt.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/pkbyt.s
deleted file mode 100644
index 322cb1f..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/pkbyt.s
+++ /dev/null
@@ -1,132 +0,0 @@
-*
-* $Id: pkbyt.s,v 1.1.1.1 1996/02/15 17:54:00 mclareni Exp $
-*
-* $Log: pkbyt.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:00 mclareni
-* Kernlib
-*
-*
-. *****$$$*****$$$*****$$$*****
-.
-. THIS A SET OF FOUR ROUTINES
-. PKBYT PAKCS A VECTOR OF SMALL INTEGERS INTO A BYTE STRING
-. UPKBYT UNPACKS A BYTE STRING ONTO A VECTOR OF SMALL INTEGERS
-. JBYTPK EXTRACTS ONE BYTE OUT OF THE STRING
-. SBYTPK STORES ONE BYTE INTO THE STRING
-.
-. $$$*****$$$*****$$$*****$$$*****
-.
-. SUBROUTINE PKBYT(IA,X,JX,N,MPACK) *** M 422 ***
-. PACKS N-VECTOR IA (1 BYTE PER WORD)
-. INTO ARRAY X, BYTE LOCATIONS JX TO JX+N-1
-. * SEE NOTICE M 422 FOR JW,JB,INWORD
-. NOTATION JX = BYTE INDEX IN ARRAY X
-. JW = WORD INDEX IN ARRAY X
-. JB = BYTE INDEX IN WORD JW
-. JW = (JX-1)/INWORD+1
-. JB = JX-(JW-1)*INWORD
-. MPACK(1) = NBITS
-. MPACK(2) = INWORD
-. DOES NOT CHECK NBITS WITHIN (1,36) AND INWORD WITHIN(1,36/NBITS)
-. DO NOTHING IF N=0
-. IF NBITS=0 SETS NBITS=1, INWORD=36
-. * ERROR EXIT GERRB$ IF N.LT.0 OR JX.LE.0
-.
-. *****$$$*****$$$*****$$$*****
-
- AXR$
- FORT$
-SAVX10 EQU R2
-SAVA6 EQU R3
-$(0)
-PKBA +1
- +36
-$(1),FIRS01
- + 'PKBYT '
-PKBYT*
-#include "ftnors1.inc"
-#include "spyuse.inc"
-* Ignoring t=pass
- L A3,4,XARG . LOC(MPACK)
- DL A1,2,XARG . LOC(JX), LOC(N)
- DL A3,0,A3 . NBITS, INWORD
- S X10,SAVX10
- LN A5,0,A2 . -N
- L A2,0,A1 . JX
- JZ A5,RETUR5 . DO NOTHING IF N=0
- JP A5,LMJER1 . ERROR EXIT IF N.LT.0
- JGD A2,$+2 . JX-1
-LMJER1 SLJ GERR$
- SZ A1
- TNZ A3
- DL A3,PKBA . IF NBITS=0 THEN NBITS=1, INWORD=36
- L X10,A5
- DI A1,A4 . (A1)=(JX-1)/INWORD=JW-1, (A2)=JB-1
- S A6,SAVA6
- A,U X10,2 . 2-N
- S A4,R1
- A,H2 A1,1,XARG . LOC(X(BYTE JX))
- AN,U A4,1 . NORMAL VALUE OF LOOP-COUNTER=INWORD-1
- L A0,0,XARG . LOC(IA)
- AN A4,A2 . FIRST VALVE OF LOOP COUNTER=INWORD-JB
- L A6,0,A1 . X(JW)
- MSI A2,A3
- LXI,U X10,1
- SSC A6,0,A2 . KEEP (JB-1) BYTES OF X(JW)
- LXI,U A0,1
- LN A2,A3 . -NBITS
- LXI,U A1,1
- MSI A2,R1 . -NBITS*INWORD
- JGD R1,$+2 . INWORD-1 IN BACKUP FOR LOOP COUNTER
-PKB40 . LOOP1-FILL A NEW WORD
- L A6,0,A1 . X(I)
-PKB42 . LOOP2-FETCH NEXT BYTE
- L A5,0,*A0
- DSL A5,0,A3
- JMGI X10,PKB60
- JGD A4,PKB42
- SSC A6,36,A2 . ADJUST
- L A4,R1
- S A6,0,*A1
- J PKB40
-PKB60 . LAST WORD
- MSI A4,A3
- L X10,SAVX10
- A A2,A4 . - NBITS * NBYTES STORED
- SSC A6,36,A2
- S A6,0,A1
- L A6,SAVA6
- J RETUR5
-
-#if (defined(CERNLIB_GUYDIAGP))&&(defined(CERNLIB_GUYFORT))
-. DIAGNOSTIC PACKETS
-#include "gerr_c.inc"
-F FORM 6,6,6,18
- INFO 010 03
-$(3)
-DIAG1 F 077,050,3,PKBYT
- + 0,DYN$
- + 'PKBYT '
- ON GERMAX
-DIAG0 F 077,067,2,0
- + 0,DYN$
-DIAG00 F 077,047,LDIA01,0
- + LDIA01-2,DIAG0
- 'CURRENT MPACK VALUE NOT CHECKED'
-LDIA01 EQU $-DIAG00
-DIAG01 F 077,062,2,0
- + DIAG00
-DIAG3 F 077,047,LDIAG3,LMJER1+1
- + LDIAG3-2,DIAG01
- 'PKBYT(A,X,JX,N,MPAK) ERROR: N<0 OR JX.LE.0'
-LDIAG3 EQU $-DIAG3
- OFF
- ON GERMAX=0
-DIAG2 F 077,062,02,LMJER1+1
- + LMJER1-FIRS01,DIAG1
- OFF
-#endif
- END
-#ifdef CERNLIB_TCGEN_PKBYT
-#undef CERNLIB_TCGEN_PKBYT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/sbit.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/sbit.s
deleted file mode 100644
index f6f154b..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/sbit.s
+++ /dev/null
@@ -1,37 +0,0 @@
-*
-* $Id: sbit.s,v 1.1.1.1 1996/02/15 17:54:00 mclareni Exp $
-*
-* $Log: sbit.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:00 mclareni
-* Kernlib
-*
-*
-. *****$$$*****$$$*****$$$*****
-.
-. SUBROUTINE SBIT(A,X,LX) *** M 421 ***
-. COPIES BIT 1 OF A INTO BIT LX OF X
-. * SEE JBIT
-.
-. *****$$$*****$$$*****$$$*****
-
- AXR$
- FORT$
-$(1)
-SBIT*
-#include "ftnors1.inc"
-#include "spyuse.inc"
-* Ignoring t=pass
- DL A1,1,XARG . LOC(X), LOC(LX)
- L A3,0,XARG . LOC(A)
- LNA A2,0,A2 . -LX
- L A5,0,A1 . X
- L A4,0,A3 . A
- LSSC A5,37,A2 . THE BIT LX IS RIGHT ADJUSTED
- DSL A4,1 . NEW BIT INTRODUCED AT LEFT
- SSC A5,36,A2
- S A5,0,A1
- J RETUR3
- END
-#ifdef CERNLIB_TCGEN_SBIT
-#undef CERNLIB_TCGEN_SBIT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/sbit0.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/sbit0.s
deleted file mode 100644
index d033865..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/sbit0.s
+++ /dev/null
@@ -1,35 +0,0 @@
-*
-* $Id: sbit0.s,v 1.1.1.1 1996/02/15 17:54:00 mclareni Exp $
-*
-* $Log: sbit0.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:00 mclareni
-* Kernlib
-*
-*
-. *****$$$*****$$$*****$$$*****
-.
-. SUBROUTINE SBIT0(X,LX) *** M 421 ***
-. SETS 0 INTO BIT LX OF X
-. * SEE JBIT
-.
-. *****$$$*****$$$*****$$$*****
-
- AXR$
- FORT$
-$(1)
-SBIT0*
-#include "ftnors1.inc"
-#include "spyuse.inc"
-* Ignoring t=pass
- DL A1,0,XARG
- L A5,0,A1 . X
- LNA A2,0,A2 . -LX
- LSSC A5,37,A2 . THE BIT LX IS RIGHT ADJUSTED
- SSL A5,1 . BIT 0 INTRODUCED AT LEFT
- SSC A5,36,A2
- S A5,0,A1
- J RETUR2
- END
-#ifdef CERNLIB_TCGEN_SBIT0
-#undef CERNLIB_TCGEN_SBIT0
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/sbit1.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/sbit1.s
deleted file mode 100644
index 5124f9e..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/sbit1.s
+++ /dev/null
@@ -1,36 +0,0 @@
-*
-* $Id: sbit1.s,v 1.1.1.1 1996/02/15 17:54:00 mclareni Exp $
-*
-* $Log: sbit1.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:00 mclareni
-* Kernlib
-*
-*
-. *****$$$*****$$$*****$$$*****
-.
-. SUBROUTINE SBIT1(X,LX) *** M 421 ***
-. SETS 1 INTO BIT LX OF X
-. * SEE JBIT
-.
-. *****$$$*****$$$*****$$$*****
-
- AXR$
- FORT$
-$(1)
-SBIT1*
-#include "ftnors1.inc"
-#include "spyuse.inc"
-* Ignoring t=pass
- DL A1,0,XARG
- L,U A4,1
- L A5,0,A1 . X
- LNA A2,0,A2 . -LX
- LSSC A5,37,A2 . THE BIT LX IS RIGHT ADJUSTED
- DSL A4,1 . BIT 1 INTRODUCED AT LEFT
- SSC A5,36,A2
- S A5,0,A1
- J RETUR2
- END
-#ifdef CERNLIB_TCGEN_SBIT1
-#undef CERNLIB_TCGEN_SBIT1
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/sbyt.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/sbyt.s
deleted file mode 100644
index 881accc..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/sbyt.s
+++ /dev/null
@@ -1,39 +0,0 @@
-*
-* $Id: sbyt.s,v 1.1.1.1 1996/02/15 17:54:01 mclareni Exp $
-*
-* $Log: sbyt.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:01 mclareni
-* Kernlib
-*
-*
-. *****$$$*****$$$*****$$$*****
-.
-. SUBROUTINE SBYT(A,X,LX,NBITS) *** M 421 ***
-. COPIES THE BYTE AT 1 OF A INTO THE BYTE AT LX OF X
-. * SEE JBIT
-.
-. *****$$$*****$$$*****$$$*****
-
- AXR$
- FORT$
-$(1)
-SBYT*
-#include "ftnors1.inc"
-#include "spyuse.inc"
-* Ignoring t=pass
- DL A2,2,XARG . LOC(LX), LOC(NBITS)
- DL A0,0,XARG . LOC(A), LOC(X)
- LN A2,0,A2 . -LX
- L A3,0,A3 . NBITS
- L A5,0,A1 . X
- L A4,0,A0 . A
- LSSC A5,37,A2 . RIGHT ADJUST BYTE
- AN A2,A3 . -LX-NBITS
- DSL A4,0,A3 . INTRODUCE NEW BYTE AT LEFT
- SSC A5,37,A2
- S A5,0,A1
- J RETUR4
- END
-#ifdef CERNLIB_TCGEN_SBYT
-#undef CERNLIB_TCGEN_SBYT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/sbytor.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/sbytor.s
deleted file mode 100644
index c3fe1a7..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/sbytor.s
+++ /dev/null
@@ -1,40 +0,0 @@
-*
-* $Id: sbytor.s,v 1.1.1.1 1996/02/15 17:54:01 mclareni Exp $
-*
-* $Log: sbytor.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:01 mclareni
-* Kernlib
-*
-*
-. *****$$$*****$$$*****$$$*****
-.
-. SUBROUTINE SBYTOR(A,X,LX,NBITS) *** M 421 ***
-. REPLACES THE BYTE AT LX OF X BY THE LOGICAL
-. .OR. OF THIS BYTE AND THE BYTE AT 1 OF A
-. * SEE JBIT
-.
-. *****$$$*****$$$*****$$$*****
-
- AXR$
- FORT$
-$(1)
-SBYTOR*
-#include "ftnors1.inc"
-#include "spyuse.inc"
-* Ignoring t=pass
- DL A2,2,XARG
- DL A0,0,XARG
- LN A2,0,A2 . -LX
- L A4,0,A1 . X
- L A3,0,A3 . NBITS
- LSSC A4,37,A2 . THE BYTE AT LX IS RIGHT ADJUSTED
- OR A4,0,A0 . .OR. WITH A
- AN A2,A3
- DSC A4,0,A3 . INTRODUCE RESULT ST LEFT
- SSC A4,37,A2
- S A4,0,A1
- J RETUR4
- END
-#ifdef CERNLIB_TCGEN_SBYTOR
-#undef CERNLIB_TCGEN_SBYTOR
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/sbytpk.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/sbytpk.s
deleted file mode 100644
index 9775e57..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/sbytpk.s
+++ /dev/null
@@ -1,75 +0,0 @@
-*
-* $Id: sbytpk.s,v 1.1.1.1 1996/02/15 17:54:01 mclareni Exp $
-*
-* $Log: sbytpk.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:01 mclareni
-* Kernlib
-*
-*
-. *****$$$*****$$$*****$$$*****
-.
-. SUBROUTINE SBYTPK( A,X,JX,MPACK ) *** M 422 ***
-. COPIES BYTE AT 1 OF A INTO BYTE JX OF BYTE-VECTOR X
-. * ERROR EXIT GERRB$ IF JX.LE.0
-. * IF MPACK(1)=0 SET NBITS=1, INWORD=36
-.
-. *****$$$*****$$$*****$$$*****
-
- AXR$
- FORT$
-$(0)
-PKBA + 1
- + 36
-$(1),FIRS01
- + 'SBYTPK'
-SBYTPK*
-#include "ftnors1.inc"
-#include "spyuse.inc"
-* Ignoring t=pass
- DL A2,2,XARG . LOC(JX), LOC(MPACK)
- SZ A1
- L A2,0,A2 . JX
- DL A3,0,A3 . NBITS, INWORD
- JGD A2,$+2 . JX-1
-LMJER4 SLJ GERR$ . ERROR EXIT IF JX.LE.0
- TNZ A3
- DL A3,PKBA
- DI A1,A4 . JW-1, JB-1
- A,H2 A1,1,XARG . LOC(A(JW))
- MSI A2,A3 . (JB-1)*NBITS
- L A0,0,XARG . LOC(A)
- L A5,0,A1 . X
- L A4,0,A0 . A
- SSC A5,0,A2 . RIGHT ADJUST BYTE
- A A2,A3 . JB*NBITS
- DSL A4,0,A3 . PUSH A-BYTE INTO X
- LSSC A5,0,A2 . RE-ORDER
- S A5,0,A1
- J RETUR4
-
-#if (defined(CERNLIB_GUYDIAGP))&&(defined(CERNLIB_GUYFORT))
-. DIAGNOSTIC PACKETS
-#include "gerr_c.inc"
-F FORM 6,6,6,18
- INFO 010 03
-$(3)
-DIAG31 F 077,050,3,SBYTPK
- + 0,DYN$
- + 'SBYTPK'
- ON GERMAX
-DIAG2 + 0776702,0
- + LMJER4-FIRS01,DYN$
-DIAG33 F 077,047,LDIA33,LMJER4+1
- + LDIA33-2,DIAG2
- 'SBYTPK( A,X,JX,MPACK) ERROR: JX.LE.0'
-LDIA33 EQU $-DIAG33
- OFF
- ON GERMAX=0
-DIAG32 F 077,062,02,LMJER4+1
- + LMJER4-FIRS01,DIAG31
- OFF
-#endif
- END
-#ifdef CERNLIB_TCGEN_SBYTPK
-#undef CERNLIB_TCGEN_SBYTPK
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/sortzv.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/sortzv.s
deleted file mode 100644
index af676f4..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/sortzv.s
+++ /dev/null
@@ -1,202 +0,0 @@
-*
-* $Id: sortzv.s,v 1.1.1.1 1996/02/15 17:54:01 mclareni Exp $
-*
-* $Log: sortzv.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:01 mclareni
-* Kernlib
-*
-*
-. **************************************
-.
-. SUBROUTINE SORTZV( A, INDEX, N, MODE, NWAY, NSORT )
-. METHOD = ALGORITHM 'QUICKERSORT', JACM
-. LUT IS THE STACK USED BY QUICKERSORT
- . * DO NOTHING IF N=0
-. * ERROR EXIT IF N.LT .0
-. * DOES NOT CHECK N.LT.2**17 ( N IS LIMITED BY THE DEPTH OF THE STACK)
- . * SORT OF ALPHANUMERIC ARRAYS NOT IMPLEMENTED (USE INTEGER SORT)
-.
-. **************************************
-.
- AXR$
- FORT$
-SAVI EQU R1
-SAVJ EQU R2
-SAVIT EQU R3
-SAVX11 EQUF SAVXX,,H2
-
- ON FTN
-SAVXARG EQUF SAVXX,,H1
- OFF . FTN
-
-SLATE INFO 2 2
-$(2)
-SAVX10 RES 1
-SAVXX RES 1
-LUT RES 38
-
-$(1),FIRS01
- + 'SORTZV'
-SORTZV*
- DL A1,1,XARG . LOC( INDEX ), LOC( N )
- L R1,0,A2 . N
- L A3,5,XARG . LOC( NSORT )
- TNZ R1
- J RETUR6 . DO NOTHING IF N = 0
- JGD R1,$+2
-LMJER1 SLJ GERR$ . ERROR EXIT IF N.LT.0
- TZ 0,A3
- J SORT20 . GO TO 'CALL INSORT'
-
- LXI,U A1,1 . FILL INDEX
- L,U A4,1
-SORT2 S A4,0,*A1 . INDEX(I) = I
- A,U A4,1
- JGD R1,SORT2
-SORT20
- DO FTN , S XARG,SAVXARG
-
-. ................... INSORT
- S X11,SAVX11
- L A2,0,XARG
- S X10,SAVX10
- DO FOR , L A0,2,XARG
- L X11,1,XARG
- DO FTN , L A0,2,XARG
- L A0,0,A0 . N
- L,U X10,LUT
- AN,U A2,1 . LOC( A(1) ) - 1
- AN,U A0,1 . N - 1
- LXI,U X10,2
- A A0,X11 . LOC( INDEX(N) )
-INT10
- ANU A0,X11 . J - I
- TLE,U A1,2
- J INT200 . SEGMENT LENGTH .LE. 2
- AU A0,X11 . I + J
- S X11,SAVI
- SSA A1,1 . IP = (I+J) / 2
- S A0,SAVJ
- L A4,0,A1 . IT = INDEX(IP)
- AU A2,A4 .
- S A4,SAVIT
- L A5,0,A3 . T = A( IT )
- L A4,0,X11 . INDEX(I)
- A,U X11,1 . K= I+1
- S A4,0,A1 . INDEX(IP) = INDEX(I)
-INT20
- AU A2,0,X11 . LOC( A(INDEX(K) ) )
- TG A5,0,A3
- J INT40 . A(INDEX(K)) .LE. T
-INT24
- AU A2,0,A0
- L A4,0,A3 . A(INDEX(IQ) )
- TG A4,A5
- J INT30 . A(INDEX(IQ)) .GE. T
- L A3,0,X11 . SWAP INDEX(K) AND INDEX(IQ)
- L A4,0,A0 . I(IQ)
- S A3,0,A0 . I(IQ) = I(K)
- S A4,0,X11 . I(K) = I(IQ)
- AN,U A0,1 . IQ = IQ - 1
-INT40 . NEXT K
- A,U X11,1 . K= K+1
- TG A0,X11
- J INT20
-INT100
- L X11,SAVI
- L A4,0,A0 . I(IQ)
- AU A0,A0 . IQ + IQ
- S A4,0,X11 . I(I) = I(IQ)
- AN A1,X11 . 2*IQ - I
- S SAVIT,0,A0 . I(IQ) = IT
- AN A1,SAVJ . 2*IQ - (I+J)
- JN A1,INT110
-. LARGER SEGMENT IS ( I, IQ-1 )
- AN,U A0,1
- S X11,0,X10
- S A0,1,*X10 . LIMITS SAVED IN LUT
- L,U X11,2
- A X11,A0 . NEW I = IQ+1
- L A0,SAVJ . NEW J = OLD J
- J INT10
-INT110 . LARGER SEGMENT IS ( IQ+1, J )
- A,U A0,1 . IQ+1
- L A1,SAVJ
- DS A0,0,*X10
- AN,U A0,2 . NEW J = IQ-1
- J INT10
-INT30 . NEXT IQ
- AN,U A0,1
- TG A0,X11
- J INT24
- J INT100
-INT200
- TE,U A1,1 . IS IT A 2-WORD SEGMENT
- J INT220 . NO
- DL A4,0,X11 . INDEX(I), INDEX(I+1)
- AU A2,A5
- L A1,0,A3 . A(INDEX(I+1))
- AU A2,A4
- TG A1,0,A3
- J INT220 . A(INDEX(I)) .LE. A(INDEX(I+1))
- DSC A4,36
- DS A4,0,X11
-INT220
- A,XU X10,-2 . X10 = X10 - 2
- L A1,X10
- L X11,0,X10
- LXI,U A1,0
- L A0,1,X10
- TG,U A1,LUT
- J INT10
- L X10,SAVX10
- L X11,SAVX11
-. ..................... END INSORT
-
- DO FTN , L XARG,SAVXARG
- L A3,4,XARG . LOC( NWAY )
- L A5,0,A3 . NWAY
- JZ A5,RETUR6
- DL A1,1,XARG . REORDER INDEX IF NWAY.NE.0
- L A2,0,A2 . N
- L A3,A1
- AN,U A2,2
- JN A2,RETUR6
- A A3,A2
- LXI,U A1,1
- SSA A2,1 . N/2
- LXI,U A3,-1
-SORT44 . REORDER
- L A4,0,A1
- L A5,1,A3
- S A4,1,*A3
- S A5,0,*A1
- JGD A2,SORT44
- J RETUR6
-
-#if (defined(CERNLIB_GUYDIAGP))&&(defined(CERNLIB_GUYFORT))
-. DIAGNOSTIC PACKETS
-#include "gerr_c.inc"
-F FORM 6,6,6,18
- INFO 010 03
-$(3)
-DIAG1 F 077,050,03,SORTZV
- + 0,DYN$
- + 'SORTZV'
- ON GERMAX
-DIAG2 F 077,067,02,0
- + LMJER1-FIRS01,DYN$
-DIAG3 F 077,047,LDIAG3,LMJER1+1
- + LDIAG3-2,DIAG2
- 'SORTZV( ,,N,,, ) ERROR: N<0'
-LDIAG3 EQU $-DIAG3
- OFF
- ON GERMAX=0
-DIAG2 F 077,062,02,LMJER1+1
- + LMJER1-FIRS01,DIAG1
- OFF
-#endif
- END
-#ifdef CERNLIB_TCGEN_SORTZV
-#undef CERNLIB_TCGEN_SORTZV
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/timed.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/timed.s
deleted file mode 100644
index b083e65..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/timed.s
+++ /dev/null
@@ -1,65 +0,0 @@
-*
-* $Id: timed.s,v 1.1.1.1 1996/02/15 17:54:01 mclareni Exp $
-*
-* $Log: timed.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:01 mclareni
-* Kernlib
-*
-*
-. **************************************
-.
-. SUBROUTINE TIMED( T ) *** Z007 ***
-. RETURNS EXECUTION TIME INTERVAL SINCE LAST CALL TO TIMED
-.
-. **************************************
-
- AXR$
- FORT$
-AP EQU 013
-
-#if defined(CERNLIB_U1108)
-SLATE INFO 2 2
-$(2)
-PCT RES AP+1
-
-#endif
-$(0)
-LAST + 0
-
-$(1)
-TIMED*
-#include "ftnors1.inc"
-#include "spyuse.inc"
-* Ignoring t=pass
-#if defined(CERNLIB_U1110)
- LXI,U A1,PCTBD$
- L,U A2,RPCTA$
- LDJ A1,$+1
- L A4,AP,A2 . SUP
- LDJ A1,$+1
- ANU A4,LAST
- L,U A2,0233
- S A4,LAST
- LCF A2,A5
- L A0,0,XARG . LOC(T)
- FD A3,( 5000.0)
- S A3,0,A0 . T
-#endif
-#if defined(CERNLIB_U1108)
- L A2,0,XARG . LOC(T)
- L,U A0,PCT
- LXI,U A0,AP+1
- ER PCT$
- L A4,PCT+AP . SUP
- ANU A4,LAST
- L,U A3,0233
- S A4,LAST
- LCF A3,A5
- FD A4,( 5000.0)
- S A4,0,A2 . T
-#endif
- J RETUR1
- END
-#ifdef CERNLIB_TCGEN_TIMED
-#undef CERNLIB_TCGEN_TIMED
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/timel.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/timel.s
deleted file mode 100644
index fbeda31..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/timel.s
+++ /dev/null
@@ -1,62 +0,0 @@
-*
-* $Id: timel.s,v 1.1.1.1 1996/02/15 17:54:01 mclareni Exp $
-*
-* $Log: timel.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:01 mclareni
-* Kernlib
-*
-*
-. *****$$$*****$$$*****$$$*****
-.
-. SUBROUTINE TIMEL( T ) *** Z007 ***
-. RETURNS THE VALUE ( SECONDS) OF SUP TIME STILL AVAILABLE FOR THE RUN
-.
-. *****$$$*****$$$*****$$$*****
-
- AXR$
- FORT$
-
-AD EQU 03
-AP EQU 013
-
-#if defined(CERNLIB_U1108)
-SLATE INFO 2 2
-$(2)
-PCT RES AP+1
-
-#endif
-$(1)
-TIMEL*
-#include "ftnors1.inc"
-#include "spyuse.inc"
-* Ignoring t=pass
-#if defined(CERNLIB_U1110)
- LXI,U A1,PCTBD$
- L,U A2,RPCTA$
- LDJ A1,$+1
- L A4,AD,A2 . TIME LIMIT
- L,U A3,0233
- AN A4,AP,A2 . TIME LEFT
- LDJ A1,$+1
- LCF A3,A4
- L A0,0,XARG . LOC(T)
- FD A4,( 5000.0)
- S A4,0,A0 . T
-#endif
-#if defined(CERNLIB_U1108)
- L A2,0,XARG . LOC(T)
- L,U A0,PCT
- LXI,U A0,AP+1
- ER PCT$
- L A4,PCT+AD . TIME LIMIT
- L,U A3,0233
- AN A4,PCT+AP . TIME LEFT
- LCF A3,A4
- FD A4,( 5000.0)
- S A4,0,A2 . T
-#endif
- J RETUR1
- END
-#ifdef CERNLIB_TCGEN_TIMEL
-#undef CERNLIB_TCGEN_TIMEL
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/timex.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/timex.s
deleted file mode 100644
index 40bd5fd..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/timex.s
+++ /dev/null
@@ -1,58 +0,0 @@
-*
-* $Id: timex.s,v 1.1.1.1 1996/02/15 17:54:01 mclareni Exp $
-*
-* $Log: timex.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:01 mclareni
-* Kernlib
-*
-*
-. *****$$$*****$$$*****$$$*****
-.
-. SUBROUTINE TIMEX( T ) *** Z007 ***
-. RETURNS SUP TIME SINCE THE BEGINNING OF THE RUN (SECONDS)
-. T = REAL, SINGLE PRECISION VARIABLE
-.
-. *****$$$*****$$$*****$$$*****
-
- AXR$
- FORT$
-AP EQU 013 . CURRENT VALUE OF S.U.P COUNTER
-
-#if defined(CERNLIB_U1108)
-SLATE INFO 2 2
-$(2)
-PCT RES AP+1
-
-#endif
-$(1)
-TIMEX*
-#include "ftnors1.inc"
-#include "spyuse.inc"
-* Ignoring t=pass
-#if defined(CERNLIB_U1110)
- LXI,U A1,PCTBD$
- L,U A2,RPCTA$
- LDJ A1,$+1
- L A4,AP,A2 . SUP
- L,U A3,0233
- LDJ A1,$+1
- LCF A3,A4
- L A0,0,XARG . LOC(T)
- FD A4,( 5000.0)
- S A4,0,A0 . T
-#endif
-#if defined(CERNLIB_U1108)
- L A2,0,XARG . LOC(T)
- L,U A0,PCT
- LXI,U A0,AP+1
- ER PCT$
- L,U A3,0233
- LCF A3,PCT+AP . SUP
- FD A4,( 5000.0)
- S A4,0,A2 . T
-#endif
- J RETUR1
- END
-#ifdef CERNLIB_TCGEN_TIMEX
-#undef CERNLIB_TCGEN_TIMEX
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/trac1q.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/trac1q.s
deleted file mode 100644
index 13f93df..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/trac1q.s
+++ /dev/null
@@ -1,70 +0,0 @@
-*
-* $Id: trac1q.s,v 1.1.1.1 1996/02/15 17:54:01 mclareni Exp $
-*
-* $Log: trac1q.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:01 mclareni
-* Kernlib
-*
-*
-#if defined(CERNLIB_GUYFORE)
-. ***************************** LAST MODIF.
-.
-. TRAC1Q, TRAC2Q --- SUBSIDIARY TO TRACEQ
-. FROM KOBENHAVN 3/05/72
- AXR$
-. COMMON/SLATE/ NAME,LINE,LADR,LOK,LASTWB,DUMMY(35)
-SLATE INFO 2 4
-$(4).
-NAME RES 1
-LINE RES 1
-LADR RES 1
-LOK RES 1
-LASTWB RES 1
-DUMMY RES 35
-$(2) LIT
-$(1)
-TRAC1Q* L,H2 A0,0,X11
- S A0,LASTWB
- J 1,X11
-.
-TRAC2Q* L A0,LASTWB
- TNZ A0
- J MAINEX
- L,XH2 A0,1,A0
- S A0,LADR . STORE LADR
-. ***************** VERIFY LADR LEGAL
- LMJ A1,CHECK
-FIND L,XH1 A1,0,A0
- TZ A1
- J GOTIT
- L,U A0,1,A0
- J FIND
-.
-GOTIT S A1,LINE .STORE LINE
- L,XH2 A0,0,A0
- S A0,LASTWB . STORE LWBP
- TNZ A0
- J MAIN
-. **************** VERIFY LWBP LEGAL
- LMJ A1,CHECK
- L A1,0,A0
-HOME S A1,NAME . STORE NAME
- J 1,X11
-MAIN L A1,('MAIN ')
- J HOME
-.
-CHECK TNG,U A0,01000
- J BAD
- TNG,U A0,LASTI$
- J 0,A1
- TNG,U A0,040000
- J BAD
- TNG,U A0,LASTD$
- J 0,A1
-BAD L A12,X11 . LOK= -VE
- SN A12,LOK
- J 1,X11
-MAINEX S X11,LOK . LOK= +VE
- J 1,X11
- END
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/traceq.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/traceq.s
deleted file mode 100644
index f8eaf7c..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/traceq.s
+++ /dev/null
@@ -1,61 +0,0 @@
-*
-* $Id: traceq.s,v 1.1.1.1 1996/02/15 17:54:01 mclareni Exp $
-*
-* $Log: traceq.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:01 mclareni
-* Kernlib
-*
-*
-#if defined(CERNLIB_GUYFORT)||defined(CERNLIB_GUYFTN)
-. **************************************
-.
-. SUBROUTINE TRACEQ( LUN, N )
-.
-. **************************************
-.
- AXR$
- FORT$
-
-#endif
-#if defined(CERNLIB_GUYFORT)
-#include "gerr_c.inc"
- RES 1
-
-$(1),FIRS01
-TRACEQ*
-#include "ftnors1.inc"
-#include "spyuse.inc"
-* Ignoring t=pass
- S,H2 X11,DYN$
-LMJSTR LMJ X11,STRACE
- L,H2 X11,DYN$
- J RETUR2
-
- INFO 010 3
-$(3),DIAG1 + 0776003,TRACEQ
- + 0,DYN$
- + 'TRACEQ'
-DIAG2 + 0776202,LMJSTR+1
- + LMJSTR-FIRS01,DIAG1
- END
-#endif
-#if defined(CERNLIB_GUYFTN)
-PF FORM 12,6,18
-$(0)
-TRAMSG 'NO TRACEQ OR STRACE ROUTINE CU'
- 'RRENTLY PROVIDED WITHIN FTN'
-LMSG EQU $-TRAMSG
-TRAPR PF 1,LMSG,TRAMSG
-$(1)
-TRACEQ*
-STRACE*
- L A0,TRAPR
- ER PRINT$
- J 0,X11
- END
-#endif
-#if defined(CERNLIB_GUYFORT)||defined(CERNLIB_GUYFTN)
-#ifdef CERNLIB_TCGEN_TRACEQ
-#undef CERNLIB_TCGEN_TRACEQ
-#endif
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/ublank.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/ublank.s
deleted file mode 100644
index 3c97b63..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/ublank.s
+++ /dev/null
@@ -1,88 +0,0 @@
-*
-* $Id: ublank.s,v 1.1.1.1 1996/02/15 17:54:01 mclareni Exp $
-*
-* $Log: ublank.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:01 mclareni
-* Kernlib
-*
-*
-. $$$*****$$$*****$$$*****$$$*****
-.
-. SUBROUTINE UBLANK(A,JL,JR) *** V300 ***
-. SUBROUTINE UZERO(A,JL,JR)
-. SUBROUTINE UFILL(A,JL,JR,STUFF)
-. SET 'BLANK','ZERO' OR STUFF IN CONSECUTIVE LOCATIONS
-. A(JL),THRU,A(JR) OF ARRAY A
-. * IF JL.LE.0 SET JL=1
-. * ERROR EXIT GERRB$ IF JR.LT.JL
-. * SINGLE PRECISION VARIABLES A,STUFF
-.
-. $$$*****$$$*****$$$*****$$$*****
-
- AXR$
- FORT$
-#include "gerr_c.inc"
-
-$(1),FIRS01
- + 'UFILL '
-UFILL*
- L A2,3,XARG . LOC(STUFF)
- DO FOR , L,U A4,1
- L A5,0,A2 . STUFF
- J UZR2
- + 'UBLANK'
-UBLANK*
- L A5,BLANK
- J UZR1
- + 'UZERO '
-UZERO*
- SZ A5
-UZR1
- DO FOR , L,U A4,0
-UZR2
- DL A1,1,XARG . LOC(JL), LOC(JR)
- L,U A3,A5
- L A1,0,A1 . JL
- JGD A1,$+2
- SZ A1 . MAX0(1,JL) - 1
- ANU A1,0,A2 . (JL-1) - JR
- A,H2 A1,0,XARG . LOC(A(JL))
- TN A2
-LMJER1 SLJ GERR$ . ERROR EXIT IF JR.LT.MAX0(1,JL)
- SMA A2,R1
- LXI,U A1,1
- DO FOR , A X11,A4
- BT A1,0,*A3
- J RETUR3
-
-#if (defined(CERNLIB_GUYDIAGP))&&(defined(CERNLIB_GUYFORT))
-. DIAGNOSTIC PACKETS FOR FORT
-F FORM 6,6,6,18
- INFO 010 03
-$(3)
-DIAG1 F 077,050,4
- + 0,DYN$
- + 'UZEROPACKAGE'
- ON GERMAX
-DIAG2 F 077,062,2,0
- + LMJER1-FIRS01,DIAG1
-DIAG3 F 077,047,LDIAG3,LMJER1+1
- + LDIAG3-2,DIAG2
- 'UBLANK,FILL,ZERO( A,JL,JR,) ERROR: JR<MAX0(1,JL)'
-LDIAG3 EQU $-DIAG3
- OFF
- ON GERMAX=0
-DIAG2 F 077,062,2,LMJER1+1
- + LMJER1-FIRS01,DIAG1
- OFF
-#endif
- END
-#ifdef CERNLIB_TCGEN_UBLANK
-#undef CERNLIB_TCGEN_UBLANK
-#endif
-#ifdef CERNLIB_TCGEN_UFILL
-#undef CERNLIB_TCGEN_UFILL
-#endif
-#ifdef CERNLIB_TCGEN_UZERO
-#undef CERNLIB_TCGEN_UZERO
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/ublow.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/ublow.s
deleted file mode 100644
index d5573a4..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/ublow.s
+++ /dev/null
@@ -1,196 +0,0 @@
-*
-* $Id: ublow.s,v 1.1.1.1 1996/02/15 17:54:01 mclareni Exp $
-*
-* $Log: ublow.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:01 mclareni
-* Kernlib
-*
-*
-. $$$*****$$$*****$$$*****$$$*****
-.
-. SUBROUTINE UBLOW(IT,IV,N) *** M 409 ***
-. DISPERSE N FIRST CHARACTERS OF TEXT IT IN N CONSECUTIVE
-. LOCATIONS OF VECTOR IV USING A1 FORMAT
-. (IDENTICAL TO DECODE(F,IT)IV WITH F=(N A1))
-. DO NOTHING IF N.EQ.0
-. * ERROR EXIT GERRB$ IF N.LT.0
-.
-. $$$*****$$$*****$$$*****$$$*****
-
- AXR$
- FORT$
-
-UBL* PROC 0
- LDSC A4,NBITCH
- SSC A4,NBITCH
- S A4,0,*A1
- END . UBL
-
-#include "gerr_c.inc"
-
-$(1),FIRS01
- + 'UBLOW '
-UBLOW*
-#include "ftnors1.inc"
-#include "spyuse.inc"
-* Ignoring t=pass
-#if defined(CERNLIB_GUYFORE)||defined(CERNLIB_GUYFORT)
-. THIS ROUTINE UBLOW HAS THE SHORTEST CODE
-. BUT IS NOT THE FASTEST ROUTINE
-. BECAUSE OF THE JMGI TEST IN THE LOOP
-
- L A2,2,XARG
- DL A0,0,XARG
- LN A2,0,A2 . - N
- L A4,BLANK
- JZ A2,RETUR3 . DO NOTHING IF N .EQ. 0
- TN A2
-LMJER1 SLJ GERR$ . ERROR EXIT IF N.LT.0
- A,U A2,2
- LXI,U A0,1
- LXI,U A1,1
- LXI,U A2,1
-UBLW12
- L A5,0,*A0
- L,U R1,NCHWD-1
-UBLW14
- UBL
- JMGI A2,RETUR3
- JGD R1,UBLW14
- J UBLW12
-#endif
-#if defined(CERNLIB_GUYFTN)
-. INTERMEDIATE LENGTH, INTERMEDIATE SPEED
-. CODED FOR FTN, USE DI INSTEAD OF DSL FOR E OR T
-.
-. L A2,2,XARG
-. DL A0,0,XARG
-. L A2,0,A2 . N
-. L A4,BLANK
-. JZ A2,RETUR3 . DO NOTHING IF N.EQ.0
-. JGD A2,$+2
-. LMJER1 SLJ GERR$ . ERROR EXIT IF N.LT.0
-. DSL A2,2 . (N-1)/NCHWD
-. SSL A3,34 . MOD( (N-1), NCHWD )
-. LXI,U A0,1
-. LXI,U A1,1
-. JGD A2,UBLW18
-. UBLW16 . N LEFT .LE. NCHWD
-. L R1,A3
-. LN,U A3,0 . SET FLAG (A3 NEG)
-. J $+2
-. UBLW18 . LOOP ON FULL WORDS
-. L A5,0,*A0
-. L,U R1,NCHWD-1
-. UBLW20 . LOOP ON CHARACTERS INSIDE ONE WORD
-. UBL
-. JGD R1,UBLW20
-. JGD A2,UBLW18
-. JP A3,UBLW16
-. J RETUR3
-. FASTEST ROUTINE BUT LONG CODE
- L A2,2,XARG
- DL A0,0,XARG
- L A2,0,A2 . N
- L A4,BLANK
- JZ A2,RETUR3 . DO NOTHING IF N=0
- TP A2
-LMJER1 SLJ GERR$ . ERROR EXIT IF N.LT.0
- DSL A2,2 . N / NCHWD
- LXI,U A0,1
- LXI,U A1,1
- J UBL30
-UBL16 . LOOP ON COMPLETE WORDS
- L A5,0,*A0
- DO NCHWD , UBL
-UBL30
- JGD A2,UBL16
- SSL A3,34 . MOD( N, NCHWD )
- JZ A3,RETUR3
- L A5,0,A0 . LAST WORD TO UNPACK
-UBL40
- J *UBL40,A3
-I DO NCHWD-1 , + UBL30-3*I
-#endif
-/
-. *****$$$*****$$$*****$$$*****$$$------
-.
-. SUBROUTINE UBUNCH(IV,IT,N)
-. COMPRESS N CONSECUTIVE WORDS OF ARRAY IV IN N CONSECUTIVE CHARACTERS OF
-. ARRAY IT, KEEPING THE FIRST CHARACTER OF IV(J) - LAST WORD PADDED
-. WITH 'BLANK'
-. CONTRARY OF UBLOW
-. IDENTICAL TO ENCODE(F,IV)IT WITH F=(N A1)
-. DO NOTHING IF N.EQ.0
-. * ERROR EXIT GERRB$ IF N.LT.0
-.
-. $$$*****$$$*****$$$*****$$$*****
-
- + 'UBUNCH'
-UBUNCH*
-#include "ftnors1.inc"
-#include "spyuse.inc"
-* Ignoring t=pass
- L A3,2,XARG
- DL A0,0,XARG
- LN A3,0,A3 . -N
- JZ A3,RETUR3 . DO NOTHING IF L.EQ.0
- TN A3
-LMJER2 SLJ GERR$ . ERROR EXIT IF N.LT.0
- A,U A3,2 . 2-N
- LXI,U A0,1
- LXI,U A1,1
- LXI,U A3,1
-UBC1
- L,U A2,NCHWD-1
-UBC2
- LSSL A4,NBITCH
- DO FOR , A,S1 A4,0,*A0
- DO FTN , A,Q1 A4,0,*A0
- JMGI A3,UBC3
- JGD A2,UBC2
- S A4,0,*A1
- J UBC1
-UBC3 MSI,U A2,NBITCH
- L A5,BLANK
- LDSL A4,0,A2
- S A4,0,A1
- J RETUR3
-
-#if (defined(CERNLIB_GUYDIAGP))&&(defined(CERNLIB_GUYFORT))
-. DIAGNOSTIC PACKETS FOR FORT
-F FORM 6,6,6,18
- INFO 010 03
-$(3)
-DIAG1 F 077,050,3,UBLOW
- + 0,DYN$
- + 'UBLOW '
-DIAG11 F 077,050,3,UBUNCH
- + 0,DYN$
- + 'UBUNCH'
- ON GERMAX
-DIAG2 F 077,067,2,0
- + 0,DYN$
-DIAG3 F 077,047,LDIAG3,0
- + LDIAG3-2,DIAG2
- 'UBLOW,UBUNCH( IV,IT,N ) ERROR: N<0'
-LDIAG3 EQU $-DIAG3
-DIAG4 F 077,062,2,LMJER1+1
- + LMJER1-FIRS01,DIAG3
-DIAG14 F 077,062,2,LMJER2+1
- + LMJER2-FIRS01,DIAG3
- OFF
- ON GERMAX=0
-DIAG2 F 077,062,2,LMJER1+1
- + LMJER1-FIRS01,DIAG1
-DIAG12 F 077,062,2,LMJER2+1
- + LMJER2-FIRS01,DIAG11
- OFF
-#endif
- END
-#ifdef CERNLIB_TCGEN_UBLOW
-#undef CERNLIB_TCGEN_UBLOW
-#endif
-#ifdef CERNLIB_TCGEN_UBUNCH
-#undef CERNLIB_TCGEN_UBUNCH
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/ucopy2.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/ucopy2.s
deleted file mode 100644
index 45b63a2..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/ucopy2.s
+++ /dev/null
@@ -1,79 +0,0 @@
-*
-* $Id: ucopy2.s,v 1.1.1.1 1996/02/15 17:54:02 mclareni Exp $
-*
-* $Log: ucopy2.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:02 mclareni
-* Kernlib
-*
-*
-. **************************************
-.
-. SUBROUTINE UCOPY2( A, B, N ) *** V 301 ***
-. COPY A(1)...A(N) INTO B(1)...B(N)
-. ANY OVERLAP
-. * ERROR EXIT GERR$ IF N.LT.0 (UCOPY,UCOPY2 )
-. DO NOTHING IF N.EQ.0
-. * ONLY ONE ROUTINE WITH ENTRY POINTS UCOPY, UCOPY2
-. * OBSOLETE ENTRY POINT MOVE TRANSFERED ELSEWHERE
-.
-. **************************************
-
- AXR$
- FORT$
-$(1),FIRS01
- + 'UCOPY '
-UCOPY*
-UCOPY2*
-#include "ftnors1.inc"
-#include "spyuse.inc"
-* Ignoring t=pass
- L A2,2,XARG . LOC(N)
- DL A0,0,XARG . LOC(A), LOC(B)
- L A2,0,A2 . N
-UCOP1 . *** ENTRY POINT FOR MOVE ***
- JZ A2,RETUR3 . DO NOTHING IF N.EQ.0
- S A2,R1 .
- JGD A2,$+2
-LMJER1 SLJ GERR$ . ERROR EXIT IF N.LT.0
- TLE A0,A1
- J UCOP3 . IF LOC(B).GT.LOC(A)
- LXI,U A0,1 . LOC(B).LE.LOC(A)
- LXI,U A1,1
-UCOP2 BT A1,0,*A0
- J RETUR3
-UCOP3 . LOC(B).GT.LOC(A)
- A A0,A2
- A A1,A2
- LXI,U A0,-1
- LXI,U A1,-1
- J UCOP2
-
-#if (defined(CERNLIB_GUYDIAGP))&&(defined(CERNLIB_GUYFORT))
-. DIAGNOSTIC PACKETS FOR FORT
-#include "gerr_c.inc"
-F FORM 6,6,6,18
- INFO 010 03
-$(3)
-DIAG1 F 077,050,3,UCOPY
- + 0,DYN$
- + 'UCOPY '
- ON GERMAX
-DIAG2 F 077,067,2,0
- + LMJER1-FIRS01,DYN$
-DIAG3 F 077,047,LDIAG3,LMJER1+1
- + LDIAG3-2,DIAG2
- 'UCOPY,UCOPY2( A,B,N ) ERROR: N<0'
-LDIAG3 EQU $-DIAG3
- OFF
- ON GERMAX=0
-DIAG2 F 077,062,2,LMJER1+1
- + LMJER1-FIRS01,DIAG1
- OFF
-#endif
- END
-#ifdef CERNLIB_TCGEN_UCOPY
-#undef CERNLIB_TCGEN_UCOPY
-#endif
-#ifdef CERNLIB_TCGEN_UCOPY2
-#undef CERNLIB_TCGEN_UCOPY2
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/uopt.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/uopt.s
deleted file mode 100644
index ac6bcb5..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/uopt.s
+++ /dev/null
@@ -1,124 +0,0 @@
-*
-* $Id: uopt.s,v 1.1.1.1 1996/02/15 17:54:02 mclareni Exp $
-*
-* $Log: uopt.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:02 mclareni
-* Kernlib
-*
-*
-. $$$*****$$$*****$$$*****$$$*****
-.
-. SUBROUTINE UOPT(DAT,POSS,IOPT,N) *** M 502 ***
-. POSS IS A STRING OF N POSSIBLE OPTIONS.
-. DAT IS THE STRING OF OPTIONS YOU ACTUALLY WANT TO STEER
-. IOPT IS A N-VECTOR
-. IOPT(J)=0 OR 1
-. DEPENDING ON THE ABSCENCE OR PRESENCE OF CHARACTER NUMBER J
-. OF POSS IN THE STRING DAT
-. * ERROR EXIT IF N.LE.0 .OR. N.GT.30
-.
-. $$$*****$$$*****$$$*****$$$*****
-
- AXR$
- FORT$
-MXOPT EQU 30
-
-SLATE INFO 2 2
-$(2)
-UOPTB RES MXOPT
-
-$(1),FIRS01
- + 'UOPT '
-UOPT*
-#include "ftnors1.inc"
-#include "spyuse.inc"
-* Ignoring t=pass
-. ***** CHECK N WITHIN RANGE
-. ***** CALL VZERO( IOPT,N )
- DL A2,2,XARG . LOC(IOPT), LOC(N)
- L,U A1,A4
- SZ A4
- L A3,0,A3 . N
- LXI,U A2,1
- TG,U A3,1
- TG,U A3,MXOPT+1
-LMJER1 SLJ GERR$ . ERROR EXIT IF N.LE.0 .OR. N.GT.30
- S A3,R1
- BT A2,0,*A1 . VZERO( IOPT, N )
- AN,U A2,1
- DL A0,0,XARG . LOC(DAT), LOC(POSS)
- DS A2,R2 . SAVE LOC( IOPT(N) ), N
-. ***** CALL UBLOWZ( POSS,UOPTB,N )
- LXI,U A1,1
- L,U A2,UOPTB
- L,U A3,2
- LXI,U A2,1
- AN A3,R3 . 2-N
- LXI,U A0,1
- LXI,U A3,1
-UOPT40
- L A4,0,*A1 . NEXT WORD TO UNPACK
- L,U R1,NCHWD-1
-UOPT42
- SZ A5
- LDSC A4,NBITCH
- S A5,0,*A2
- JMGI A3,UOPT60 . END OF BLOWZ
- JGD R1,UOPT42
- J UOPT40
-. ***** LOOP
-. EXTRACT SUCCESSIVE CHARACTERS FROM DAT
-. COMPARE TO THE STRING POSS OF POSSIBLE OPTIONS
-. IF ICH FOUND IN POSS SET THE CORRESPONDING FLAG IN VECTOR IOPT
-UOPT60
- L,U A5,1
-UOPT62
- EX UOPT80,*A3
- LXM,U A2,UOPTB
- L R1,R3 . N
- SE A4,0,*A2
- J RETUR4
- L A1,R2 . LOC( IOPT(N-1) )
- AN A1,R1
-UOPT80
- S A5,0,A1
- J UOPT62
- ON FOR
-I DO 5 , L,14-I A4,0,A0
- OFF . FOR
- ON FTN
- L,Q1 A4,0,A0
- L,Q2 A4,0,A0
- L,Q3 A4,0,A0
- OFF . FTN
- J $+1
- DO FOR , L,S6 A4,0,*A0
- DO FTN , L,Q4 A4,0,*A0
- LXM,U A3,2
- J UOPT62+1
-#if (defined(CERNLIB_GUYDIAGP))&&(defined(CERNLIB_GUYFORT))
-. DIAGNOSTIC PACKETS FOR FORT
-#include "gerr_c.inc"
-F FORM 6,6,6,18
- INFO 010 03
-$(3)
-DIAG1 F 077,050,3,UOPT
- + 0,DYN$
- + 'UOPT '
- ON GERMAX
-DIAG2 F 077,067,2,0
- + LMJER1-FIRS01,DYN$
-DIAG3 F 077,047,LDIAG3,LMJER1+1
- + LDIAG3-2,DIAG2
- 'UOPT( D,P,O,N ) ERROR:N.LE.0 OR N>30'
-LDIAG3 EQU $-DIAG3
- OFF
- ON GERMAX=0
-DIAG2 F 077,062,2,LMJER1+1
- + LMJER1-FIRS01,DIAG1
- OFF
-#endif
- END
-#ifdef CERNLIB_TCGEN_UOPT
-#undef CERNLIB_TCGEN_UOPT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/upkbyt.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/upkbyt.s
deleted file mode 100644
index 05d6eb2..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/upkbyt.s
+++ /dev/null
@@ -1,96 +0,0 @@
-*
-* $Id: upkbyt.s,v 1.1.1.1 1996/02/15 17:54:02 mclareni Exp $
-*
-* $Log: upkbyt.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:02 mclareni
-* Kernlib
-*
-*
-. $$$*****$$$*****$$$*****$$$*****
-.
-. SUBROUTINE UPKBYT(A,JA,IY,N,MPACK) *** M 422 ***
-. UNPACKS THE VECTOR A OF SMALL INTEGERS STARTING AT JA
-. INTO THE VECTOR IY
-. DEFINITION OF MPACK. SEE MANUAL/MPACK(1)=NBITS,MPACK(2)=INWORD/
-. DO NOTHING IF N.EQ.0
-. IF NBITS=0 USES NBITS=1,INWORD=36
-. * ERROR EXIT GERRB$ IF N.LT.0 OR JA.LE.0
-. * DOES NOT CHECK NBITS WITHIN(1,36) AND INWORD WITHIN(1,36/NBITS)
-.
-. $$$*****$$$*****$$$*****$$$*****
-
- AXR$
- FORT$
-$(0)
-PKBA + 1
- + 36
-$(1),FIRS01
- + 'UPKBYT'
-UPKBYT*
-#include "ftnors1.inc"
-#include "spyuse.inc"
-* Ignoring t=pass
- L A1,4,XARG . LOC(MPACK)
- L A3,1,XARG . LOC(JA)
- DL A4,0,A1 . NBITS, INWORD
- L A1,3,XARG . LOC(N)
- L A3,0,A3 . JA
- LN A1,0,A1 . -N
- SZ A2
- JZ A1,RETUR5 . DO NOTHING IF N=0
- JP A1,LMJER2 . ERROR EXIT IF N.LT.0
- JGD A3,$+2 . JA-1
-LMJER2 SLJ GERR$ . ERROR EXIT IF JA.LE.0
- TNZ A4
- DL A4,PKBA
- DI A2,A5 . JW-1, JB-1
- A,U A1,2
- AN,U A5,1 . INWORD-1
- LXI,U A1,1
- A,H2 A2,0,XARG . LOC(A(BYTE JA))
- S A5,R2 . BACKUP FOR LOOP COUNTER
- AN A5,A3 . FIRST VALUE OF LOOP COUNTER
- L A0,2,XARG . LOC(IY)
- MSI A3,A4
- S A5,R1
- L A5,0,A2 . A(JW)
- LXI,U A2,1
- SSL A5,0,A3 . RIGHT ADJUST THE BYTES TO UNPACK
- LXI,U A0,1
- L A3,A4 . NBITS
- SZ A4
-UPK40 . LOOP
- DSC A4,0,A3 . EXTRACT BYTE
- LSSC A4,0,A3 . RIGHT ADJUST BYTE
- S A4,0,*A0
- JMGI A1,RETUR5
- JGD R1,UPK40
- L A5,1,*A2
- L R1,R2
- J UPK40
-
-#if (defined(CERNLIB_GUYDIAGP))&&(defined(CERNLIB_GUYFORT))
-. DIAGNOSTIC PACKETS
-#include "gerr_c.inc"
-F FORM 6,6,6,18
- INFO 010 03
-$(3)
-DIAG11 F 077,050,3,UPKBYT
- + 0,DYN$
- + 'UPKBYT'
- ON GERMAX
-DIAG2 + 0776702,0
- + LMJER2-FIRS01,DYN$
-DIAG13 F 077,047,LDIA13,LMJER2+1
- + LDIA13-2,DIAG2
- 'UPKBYT( A,JA,IY,N,MPACK ) ERROR: N<0 OR JA.LE.0'
-LDIA13 EQU $-DIAG13
- ON GERMAX=0
-DIAG12 F 077,062,02,LMJER2+1
- + LMJER2-FIRS01,DIAG11
- OFF
-#endif
- END
-#ifdef CERNLIB_TCGEN_UPKBYT
-#undef CERNLIB_TCGEN_UPKBYT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/uswop.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/uswop.s
deleted file mode 100644
index 7517d7a..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/uswop.s
+++ /dev/null
@@ -1,70 +0,0 @@
-*
-* $Id: uswop.s,v 1.1.1.1 1996/02/15 17:54:02 mclareni Exp $
-*
-* $Log: uswop.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:02 mclareni
-* Kernlib
-*
-*
-. *****$$$*****$$$*****$$$*****
-.
-. SUBROUTINE USWOP( A,B,N ) *** V 303 ***
-. EXCHANGES THE CONTENTS OF ARRAYS A AND B (N FIRST WORDS)
-. DO NOTHING IF N.EQ.0
-. * ERROR EXIT GERR$ IF OVERLAP OR N.LT.0
-.
-. *****$$$*****$$$*****$$$*****
-
- AXR$
- FORT$
-
-$(1),FIRS01
- + 'USWOP '
-USWOP*
-#include "ftnors1.inc"
-#include "spyuse.inc"
-* Ignoring t=pass
- L A3,2,XARG . LOC(N)
- DL A0,0,XARG . LOC(A), LOC(B)
- L A3,0,A3 . N
- ANU A1,A0 .
- JZ A3,RETUR3 . DO NOTHING IF N.EQ.0
- LMA A2,A2 . (A2)=IABS(B-A)
- LXI,U A0,1
- TG A2,A3
- JGD A3,$+2
-LMJER1 SLJ GERR$ . ERROR EXIT IF OVERLAP OR N.LT.0
- LXI,U A1,1
-USW1 LA A4,0,A0 . LOOP
- LA A5,0,A1 .
- SA A4,0,*A1 .
- SA A5,0,*A0 .
- JGD A3,USW1
- J RETUR3
-
-#if (defined(CERNLIB_GUYDIAGP))&&(defined(CERNLIB_GUYFORT))
-. DIAGNOSTIC PACKETS FOR FORT
-#include "gerr_c.inc"
-F FORM 6,6,6,18
- INFO 010 03
-$(3)
-DIAG1 F 077,050,3,USWOP
- + 0,DYN$
- + 'USWOP '
- ON GERMAX
-DIAG2 F 077,067,2,0
- + LMJER1-FIRS01,DYN$
-DIAG3 F 077,047,LDIAG3,LMJER1+1
- + LDIAG3-2,DIAG2
- 'USWOP( A,B,N ) ERROR: OVERLAP OR N<0'
-LDIAG3 EQU $-DIAG3
- OFF
- ON GERMAX=0
-DIAG2 F 077,062,2,LMJER1+1
- + LMJER1-FIRS01,DIAG1
- OFF
-#endif
- END
-#ifdef CERNLIB_TCGEN_USWOP
-#undef CERNLIB_TCGEN_USWOP
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/vblank.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/vblank.s
deleted file mode 100644
index 96c1ef7..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guy/vblank.s
+++ /dev/null
@@ -1,103 +0,0 @@
-*
-* $Id: vblank.s,v 1.1.1.1 1996/02/15 17:54:02 mclareni Exp $
-*
-* $Log: vblank.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:02 mclareni
-* Kernlib
-*
-*
-. $$$*****$$$*****$$$*****$$$*****
-.
-. SUBROUTINE VBLANK( A,N ) *** F 121 ***
-. SUBROUTINE VZERO(A,N)
-. SUBROUTINE VFILL(A,N,STUFF)
-. SET 'BLANK','ZERO' OR STUFF IN N CONSECUTIVE LOCATIONS OF ARRAY A
-. DO NOTHING IF N.EQ.0
-. * SINGLE PRECISION VARIABLE A
-. * ERROR EXIT GERRB$ IF N.LT.0
-.
-. $$$*****$$$*****$$$*****$$$*****
-
- AXR$
- FORT$
-
-#include "gerr_c.inc"
-
-$(1),FIRS01
- + 'VFILL '
-VFILL*
-#include "ftnors1.inc"
- L A2,2,XARG . LOC(STUFF)
- DO FOR , L,U A3,1
- L A5,0,A2 . STUFF
- J VZR2
- + 'VBLANK'
-VBLANK*
- L A5,BLANK
- J VZR1
- + 'VZERO '
-VZERO*
- SZ A5
-VZR1
-#include "ftnors1.inc"
- DO FOR , L,U A3,0
-VZR2
-#include "spyuse.inc"
-* Ignoring t=pass
- DL A0,0,XARG . LOC(A), LOC(N)
- L,U A2,A5
- L A1,0,A1 . N
- LXI,U A0,1
- DO FOR , JZ A1,VZR12
- DO FTN , JZ A1,RETUR2 . DO NOTHING IF N=0
- TP A1
-LMJER1 SLJ GERR$ . ERROR EXIT IF N.LT.0
- S A1,R1
- BT A0,0,*A2
- DO FOR ,VZR12 A X11,A3
- J RETUR2
-
-#if (defined(CERNLIB_GUYDIAGP))&&(defined(CERNLIB_GUYFORT))
-. DIAGNOSTIC PACKETS FOR FORT
-F FORM 6,6,6,18
- INFO 010 03
-$(3)
- ON GERMAX
-DIAG1 F 077,050,3,VFILL
- + 0,DYN$
- + 'VFILL '
-DIAG11 F 077,050,3,VBLANK
- + 0,DYN$
- + 'VBLANK'
-DIAG21 F 077,050,3,VZERO
- + 0,DYN$
- + 'VZERO '
-DIAG2 F 077,067,2,0
- + LMJER1-FIRS01,DYN$
-DIAG3 F 077,047,LDIAG3,LMJER1+1
- + LDIAG3-2,DIAG2
- 'VZERO,VBLANK,VFILL( A,N ) ERROR: N<0'
-LDIAG3 EQU $-DIAG3
- OFF
- ON GERMAX=0
-DIAG1 F 077,050,4,VZERO
- + 0,DYN$
- + 'VZER,BLK,FIL'
-DIAG11 F 077,061,2,VFILL
- + 0,DIAG1
-DIAG21 F 077,061,2,VBLANK
- + 0,DIAG1
-DIAG2 F 077,062,2,LMJER1+1
- + LMJER1-FIRS01,DIAG1
- OFF
-#endif
- END
-#ifdef CERNLIB_TCGEN_VBLANK
-#undef CERNLIB_TCGEN_VBLANK
-#endif
-#ifdef CERNLIB_TCGEN_VFILL
-#undef CERNLIB_TCGEN_VFILL
-#endif
-#ifdef CERNLIB_TCGEN_VZERO
-#undef CERNLIB_TCGEN_VZERO
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/amaxmu.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/amaxmu.s
deleted file mode 100644
index 370f44f..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/amaxmu.s
+++ /dev/null
@@ -1,104 +0,0 @@
-*
-* $Id: amaxmu.s,v 1.1.1.1 1996/02/15 17:54:02 mclareni Exp $
-*
-* $Log: amaxmu.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:02 mclareni
-* Kernlib
-*
-*
-. $$$*****$$$*****$$$*****$$$*****
-.
-. FUNCTION AMAXMU( A, IDO, IW, NA ) *** E 103 ***
-. LOOKS FOR THE LARGEST ABSOLUTE VALUE IN THE SCATTERED VECTOR A
-. OF NORMALIZED FLOATING-POINT NUMBERS (OR INTEGERS, BUT NOT A MIXTURE)
-. A IS COMPOSED OF IDO SUBSETS, EACH ONE IW WORDS LONG
-. NA IS THE DISTANCE BTWEEN THE FIRST WORD OF TWO SUBSETS
-. * ERROR EXIT GERRB$ IF IDO.LE.0 .OR. IW.LE.0
-. * INTEGER OR SINGLE PRECESION A
-
-. FUNCTION LMAXMU(A,IDO,IW,NA)
-. RETURNS THE INDEX VALUE J OF A(J) FOUND BY AMAXMU(A,IDO,IW,NA)
-.
-. $$$*****$$$*****$$$*****$$$*****
-
- AXR$
- FORT$
-SAVLOCA EQU A15+1
-SAVIWM1 EQU A15+2
-$(1),FIRS01
- 'LMAXMU'
-LMAXMU*
- L,U R3,1
- J AMAX1
- 'AMAXMU'
-AMAXMU*
- SZ R3
-AMAX1
-#include "ftnors1.inc"
-#include "spyuse.inc"
-* Ignoring t=pass
- DL A2,0,XARG . LOC(A),LOC(IDO)
- DL A0,2,XARG
- L R1,0,A3 . IDO
- L A3,0,A0 . IW
- L A0,0,A1 . NA
- ANU A0,A3 . (A1) = NA-IW
- JGD R1,$+2 . IDO-
- J LMJER1 . ERROR EXIT IF IDO.LE.0
- JGD A3,$+2
-LMJER1 SLJ GERR$ . ERROR EXIT IF IW.LE.0
- TNZ A0
- SZ R1 . IF( NA=0 ) IDO = 1
- LXI,U A2,1
- DS A2,SAVLOCA
- LMA A5,0,*A2
-LMX10 . A NEW CANDIDATE
- L A4,A5 . CURRENT AMAXMU
- L A0,A2 . CURRENT LMAXMU
- J LMX20
-LMX14 . LOOP ON IDO SUBSETS
- A A2,A1
- L A3,SAVIWM1
-LMX16
- LMA A5,0,*A2
- TLE A4,A5
- J LMX10
-LMX20 JGD A3,LMX16
- JGD R1,LMX14
- TNZ R3
- J LMX30
- AN A0,SAVLOCA . END LMAXMU
- J RETUR4
-LMX30
- L A0,A4 . AMAXMU
- J RETUR4
-
-#if (defined(CERNLIB_GUYDIAGP))&&(defined(CERNLIB_GUYFORT))
-. ------- DIAGNOSTICS PACKETS FOR FORT ----------
-#include "gerr_c.inc"
-F FORM 6,6,6,18
- INFO 010 3
-$(3)
-DIAG1 F 077,050,3,LMAXMU
- + 0,DYN$
- 'LMAXMU'
-DIAG12 F 077,050,3,AMAXMU
- + 0,DYN$
- 'AMAXMU'
- ON GERMAX
-DIAG2 F 077,067,2,0
- + LMJER1-FIRS01,DYN$
-DIAG3 F 077,047,LDIAG3,LMJER1+1
- + LDIAG3-2,DIAG2
- 'AMAXMU( A,IDO,IW,N )ERROR: IDO.LE.0 OR IW.LE.0'
-LDIAG3 EQU $-DIAG3
- OFF
- ON GERMAX=0
-DIAG2 F 077,062,2,LMJER1+1
- + LMJER1-FIRS01,DIAG1
- OFF
-#endif
- END
-#ifdef CERNLIB_TCGEN_AMAXMU
-#undef CERNLIB_TCGEN_AMAXMU
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/atg.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/atg.s
deleted file mode 100644
index 5f12026..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/atg.s
+++ /dev/null
@@ -1,77 +0,0 @@
-*
-* $Id: atg.s,v 1.1.1.1 1996/02/15 17:54:02 mclareni Exp $
-*
-* $Log: atg.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:02 mclareni
-* Kernlib
-*
-*
-. $$$*****$$$*****$$$*****$$$*****
-.
-. FUNCTION ATG( RSIN, RCOS ) *** B 101 ***
-. THE RESULT IS IN THE RANGE 0,2PI WHILE THE RESULT OF ATAN2 IS
-. IN THE RANGE -PI,+PI
-.
-. $$$*****$$$*****$$$*****$$$*****
-
- AXR$
- FORT$
- ON FORT++FTN
-#include "gerr_c.inc"
-SAVX11 RES 1
- OFF .
- ON FTN
-SLATE INFO 2 2
-$(2),ATG1 RES 2
- OFF . FTN
-$(0)
- ON FORE
-ATGA 'ATG '
-SAVX11 + 2,0
- OFF
-PI2 + 6.2831853072
-
-$(1),FIRS01
-ATG*
-#include "ftnors1.inc"
-#include "spyuse.inc"
-* Ignoring t=pass
- DL A0,0,XARG
- S,H2 X11,SAVX11
- ON FORE++FORT**OPTR
- DS A0,ATG1
-LMJATA LMJ X11,ATAN2
-ATG1 RES 2
- DO FORE , +$-ATG-3,ATGA
- DO FORT**NNOP , NOP
- OFF . FORE++FORT**OPTR
- ON FORT**(-OPTR)
- LXI,U X11,RMATH$
-LMJATA LIJ X11,ATAN2$
- OFF . FORT**(-OPTR)
- ON FTN
- DS A0,ATG1
- L,U A0,ATG1
-LMJATA LMJ X11,ATAN2
- OFF . FTN
- JP A0,ATG2
- FA A0,PI2
-ATG2 L X11,SAVX11
- J RETUR2
-
-. ------- DIAGNOSTICS PACKETS FOR FORT ----------
- ON FORT
-F FORM 6,6,6,18
- INFO 010 03
-$(3)
-DIAG1 F 077,050,3,ATG
- + 0,DYN$
- 'ATG'
- DO OPTR ,DIAG2 + 0776202,LMJATA+1
- DO OPTR=0 ,DIAG2 + 0777302,LMJATA+1
- + LMJATA-FIRS01,DIAG1
- OFF
- END
-#ifdef CERNLIB_TCGEN_ATG
-#undef CERNLIB_TCGEN_ATG
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/cross.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/cross.s
deleted file mode 100644
index 1fb2ca4..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/cross.s
+++ /dev/null
@@ -1,51 +0,0 @@
-*
-* $Id: cross.s,v 1.1.1.1 1996/02/15 17:54:02 mclareni Exp $
-*
-* $Log: cross.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:02 mclareni
-* Kernlib
-*
-*
-. *****$$$*****$$$*****$$$*****
-.
-. SUBROUTINE CROSS(A,B,C) *** F 117 ***
-. DIMENSION A(3),B(3),C(3)
-. C = CROSS PRODUCT A*B
-. * SINGLE PRECISION A,B,C
-. * C MAY OVERLAP A OR/AND B
-.
-. *****$$$*****$$$*****$$$*****
-
- AXR$
- FORT$
-$(1)
-CROSS*
-#include "ftnors1.inc"
-#include "spyuse.inc"
-* Ignoring t=pass
- DL A1,0,XARG . LOC(A), LOC(B)
- DS A6,R1
- L A5,2,A1 . A(3)
- L A3,2,A2 . B(3)
- FM A5,1,A2 . A(3)*B(2)
- FM A3,1,A1 . B(3)*A(2)
- L A6,0,A1 . A(1)
- FAN A3,A5 . C(1)=A(2)*B(3)-A(3)*B(2)
- FM A6,2,A2 . A(1)*B(3)
- L A4,2,A1 . A(3)
- L A0,2,XARG . LOC(C)
- FM A4,0,A2 . A(3)*B(1)
- FAN A4,A6 . C(2)=A(3)*B(1)-A(1)*B(3)
- L A6,1,A1 . A(2)
- L A1,0,A1 . A(1)
- FM A6,0,A2 . A(2)*B(1)
- FM A1,1,A2 . A(1)*B(2)
- DS A3,0,A0
- FAN A1,A6 . C(3)=A(1)*B(2)-A(2)*B(1)
- DL A6,R1
- S A1,2,A0 . C(3)
- J RETUR3
- END
-#ifdef CERNLIB_TCGEN_CROSS
-#undef CERNLIB_TCGEN_CROSS
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/erf.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/erf.s
deleted file mode 100644
index 971d429..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/erf.s
+++ /dev/null
@@ -1,99 +0,0 @@
-*
-* $Id: erf.s,v 1.1.1.1 1996/02/15 17:54:02 mclareni Exp $
-*
-* $Log: erf.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:02 mclareni
-* Kernlib
-*
-*
-. **************************************
-.
-. FUNCTION ERF( X ) *** C 300 ***
-. FUNCTION ERFC( X )
-. FUNCTION FREQ( X )
-. METHOD: HASTING
-. SOURCE = COPENHAG
-.
-. **************************************
-
- AXR$
- FORT$
-$(0)
-CONS1 + 0.7071067814 . 1./SQRT(2.)
-XLIM + 12.0
-CONS3 + 2.0
-CONS2
-COEF1 + 1.0
-COEF2 + 0.070523078
-COEF3 + 0.042282012
-COEF4 + 0.0092705272
-COEF5 + 0.0001520143
-COEF6 + 0.0002765672
-COEF7 + 0.0000430638
-
-$(1)
-FREQ*
-#include "ftnors1.inc"
- L A0,0,XARG
- L A4,CONS1
- FM A4,0,A0 . X / SQRT( 2. )
- L,U A5,1
- J ERF2
-ERFC*
- LN,U A5,1 . SET FLAG NEGATIVE
- J ERF1
-ERF*
- L,U A5,0 . FLAG = 0
-ERF1
-#include "ftnors1.inc"
- L A0,0,XARG
- L A4,0,A0 . X
-ERF2
-#include "spyuse.inc"
-* Ignoring t=pass
- LM A2,A4 . /X/
- TG A2,XLIM . TEST /X/ LARGE
- J ERF7
- S A2,R1
- FM A2,COEF7
- FA A2,COEF6
- FM A2,R1
- FA A2,COEF5
- FM A2,R1
- L A0,COEF1
- FA A2,COEF4
- FM A2,R1
- FA A2,COEF3
- FM A2,R1
- FA A2,COEF2
- FM A2,R1
- FA A2,A0
- FD A0,A2
- FM A0,A0
- FM A0,A0
- FM A0,A0
- FM A0,A0
-ERF3
- JZ A5,ERF4 . JUMP IF ERF
- JN A5,ERF6 . JUMP IF ERFC
- FD A0,CONS3 . T / 2.
- JN A4,RETUR1
-ERF4
- FAN A0,CONS2
- JN A4,RETUR1
-ERF5 LN A0,A0
- J RETUR1
-ERF6
- JP A4,RETUR1
- FAN A0,CONS3
- J ERF5
-ERF7
- L,U A0,0
- J ERF3
- END
-#ifdef CERNLIB_TCGEN_ERF
-#undef CERNLIB_TCGEN_ERF
-#endif
-#ifdef CERNLIB_TCGEN_FREQ
-#undef CERNLIB_TCGEN_FREQ
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/iuhunt.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/iuhunt.s
deleted file mode 100644
index cdc96a2..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/iuhunt.s
+++ /dev/null
@@ -1,99 +0,0 @@
-*
-* $Id: iuhunt.s,v 1.1.1.1 1996/02/15 17:54:02 mclareni Exp $
-*
-* $Log: iuhunt.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:02 mclareni
-* Kernlib
-*
-*
-. *****$$$*****$$$*****$$$*****
-.
-. FUNCTION IUHUNT( IT,IVEC,N,INC ) *** V 304 ***
-. COMPARES THE WORD IT TO WORDS IVEC(1),IVEC(1+INC)..IVEC(1+((N-1)/INC)*INC)
-. IF N.GT.0
-. COMPARES THE WORD IT TO THE SAME WORDS WITH REVERSED ORDER IF N.LT.0
-. RETURNS THE FORTRAN LOCATION J OF THE FIRST WORD SUCH THAT IT=IVEC(J)
-. RETURNS IUHUNT=0 IF THE COMPARISON FAILS
-. RETURNS IUHUNT=0 IF N.EQ.0
-. * ERROR EXIT GERRB$ IF INC.LT.0
-. * WORKS IF IT = +0 OR -0
-. * USES N=1 IF INC=0
-. * SINGLE PRECISION IT,IVEC ---- DO NOT CHECK INC.LT.2**17
-.
-. *****$$$*****$$$*****$$$*****
-
- AXR$
- FORT$
-$(1),FIRS01
- + 'IUHUNT'
-IUHUNT*
-#include "ftnors1.inc"
-#include "spyuse.inc"
-* Ignoring t=pass
- DL A2,0,XARG . LOC(IT),LOC(IVEC)
- DL A0,2,XARG . LOC(N), LOC(INC)
- L A5,0,A0 . N
- L A4,0,A1 . INC
- SZ A0
- LMA A1,A5 . IABS(N)
- JZ A4,IUH1 . IF INC=0 USE N=1
- TP A4
-LMJER1 SLJ GERR$ . ERROR EXIT IF INC.LT.0
- DI A0,A4 . IABS(N)/INC
-IUH1
- TZ A1
- A,U A0,1
- S A0,R1
- AN,U A0,1
- JN A5,IUH3
-IUH2
- L A5,0,A2 . IT
- LXI A3,A4
- JZ A5,IUH4
- SE A5,0,*A3
- J IUH6 . NO FIND
-IUH21 AN A0,R1 . COMPUTE FORTRAN LOCATION OF RESULT
- MSI A0,A4
- A,U A0,1
- J RETUR4
-. N.LT.0
-IUH3 MSI A0,A4
- A A3,A0 . LOC(LAST WORD) IN IVEC = FIRST TO SCAN
- LN A4,A4
- SZ A0
- J IUH2
-. IT = 0
-IUH4 JGD R1,IUH5
- J IUH6 . IF N.EQ.0
-IUH5 TNZ 0,*A3
- J IUH21
- JGD R1,IUH5
-IUH6 SZ A0 . NO FIND
- J RETUR4
-
-#if (defined(CERNLIB_GUYDIAGP))&&(defined(CERNLIB_GUYFORT))
-. DIAGNOSTIC PACKETS FOR FORT
-#include "gerr_c.inc"
-F FORM 6,6,6,18
- INFO 010 03
-$(3)
-DIAG1 F 077,050,3,IUHUNT
- + 0,DYN$
- + 'IUHUNT'
- ON GERMAX
-DIAG2 F 077,067,2,0
- + LMJER1-FIRS01,DYN$
-DIAG3 F 077,047,LDIAG3,LMJER1+1
- + LDIAG3-2,DIAG2
- 'IUHUNT(IT,IVEC,N,INC) ERROR: INC<0'
-LDIAG3 EQU $-DIAG3
- OFF
- ON GERMAX=0
-DIAG2 F 077,062,2,LMJER1+1
- + LMJER1-FIRS01,DIAG1
- OFF
-#endif
- END
-#ifdef CERNLIB_TCGEN_IUHUNT
-#undef CERNLIB_TCGEN_IUHUNT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/iulast.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/iulast.s
deleted file mode 100644
index a6406f5..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/iulast.s
+++ /dev/null
@@ -1,117 +0,0 @@
-*
-* $Id: iulast.s,v 1.1.1.1 1996/02/15 17:54:02 mclareni Exp $
-*
-* $Log: iulast.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:02 mclareni
-* Kernlib
-*
-*
-. *****$$$*****$$$*****$$$*****
-.
-. FUNCTION IULAST(IT,IVEC,N) *** V 305 ***
-. IULAST (W,V,N) IS EQUIVALENT TO LNOTEQ (W,V,-N)
-. COMPARES THE WORD IT TO THE WORDS NUMBER N,N-1,...,1 OF ARRAY IVEC
-. THE SCANNING STOPS WITH IULAST=J AT THE FIRST WORD IVEC(J).NE.IT
-. RETURNS IULAST=0 IF ALL WORDS OF ARRAY IVEC CONTAIN IT
-. RETURNS IULAST=0 IF N.EQ.0
-. * ERROR EXIT GERRB$ IF N.LT.0
-. * SINGLE PRECISION IT,IVEC
-.
-. *****$$$*****$$$*****$$$*****
- AXR$
- FORT$
-$(1),FIRS01
- + 'IULAST'
-IULAST*
-#include "ftnors1.inc"
-#include "spyuse.inc"
-* Ignoring t=pass
- L A3,2,XARG
- DL A0,0,XARG
- L A2,0,A0
- LN A0,0,A3
- JN A0,LNOT6
- JZ A0,RETUR3 . RETURNS IULAST=0 IF N.EQ.0
-LMJER1 SLJ GERR$ . IF N.LT.0
-
-. *****$$$*****$$$*****$$$*****
-.
-. FUNCTION LNOTEQ( IT, IVEC, N ) *** V 305 ***
-. SCAN VECT FROM VECT(1) TO VECT(N) IF N.GT.0
-. SCAN VECT FROM VECT(N) TO VECT(1) IF N.LT.0
-. RETURNS THE LOCATION IN ARRAY VECT OF THE FIRST WORD .NE. IT
-. RETURNS 0 IF VECT(1) THRU VECT(N) = WORD
-. RETURNS LNOTEQ=0 IF N.EQ.0
-. * INTEGER OR SINGLE PRECISION IT, IVEC (SHOULD BE INTEGERS )
-. * BIT TO BIT COMPARISON EXCEPTED IF IT = +0 OR -0
-.
-. *****$$$*****$$$*****$$$*****
-
-LNOTEQ*
-#include "ftnors1.inc"
-#include "spyuse.inc"
-* Ignoring t=pass
- L A3,2,XARG . LOC(N)
- DL A0,0,XARG . LOC(IT), LOC(IVEC)
- L A2,0,A0 . IT
- L A0,0,A3 . N
-LNOT6
- JZ A0,RETUR3 . RETURNS 0 IF N.EQ.0
- SMA A0,R1
- JN A0,LNT3
-. IT .NE. 0 AND N.GT.0
- LXI,U A1,1
- JZ A2,LNT4
- SNE A2,0,*A1
-LNT1 L A0,R1 . NO FIND
-LNT2 AN A0,R1 . FORTRAN LOCATION OF RESULT
- J RETUR3
-. IT .NE. 0 AND N.LT.0
-LNT3 A,U A0,1 . -N+1
- ANH A1,A0 . LOC (VEC(N))
- LXI,XU A1,-1
- JZ A2,LNT6
- L,U A0,1
- SNE A2,0,*A1
- L,XU R1,-1
- A A0,R1
- J RETUR3
-. IT = +0 OR -0 AND N.GT.0
-LNT4 JGD R1,LNT5 . N-1
-LNT5 TZ 0,*A1 . LOOP
- J LNT2
- JGD R1,LNT5
- J LNT1 . NO FIND
-. IT = +0 OR -0 AND N.LT.0
-LNT6 LN A0,A0 . N-1
-LNT7 TNZ 0,*A1 . LOOP
- JGD A0,LNT7
- A,U A0,1 . FORTRAN LOCATION OF RESULT
- J RETUR3
-
-#if (defined(CERNLIB_GUYDIAGP))&&(defined(CERNLIB_GUYFORT))
-. DIAGNOSTIC PACKETS FOR FORT
-#include "gerr_c.inc"
-F FORM 6,6,6,18
- INFO 010 03
-$(3)
-DIAG1 F 077,050,3,IULAST
- + 0,DYN$
- + 'IULAST'
- ON GERMAX
-DIAG2 F 077,067,2,0
- + LMJER1-FIRS01,DYN$
-DIAG3 F 077,047,LDIAG3,LMJER1+1
- + LDIAG3-2,DIAG2
- 'IULAST( IT,IV,N ) ERROR: N<0'
-LDIAG3 EQU $-DIAG3
- OFF
- ON GERMAX=0
-DIAG2 F 077,067,2,LMJERR+1
- + LMJER1-FIRS01,DIAG1
- OFF
-#endif
- END
-#ifdef CERNLIB_TCGEN_IULAST
-#undef CERNLIB_TCGEN_IULAST
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/iusame.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/iusame.s
deleted file mode 100644
index d80f2d8..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/iusame.s
+++ /dev/null
@@ -1,93 +0,0 @@
-*
-* $Id: iusame.s,v 1.1.1.1 1996/02/15 17:54:03 mclareni Exp $
-*
-* $Log: iusame.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:03 mclareni
-* Kernlib
-*
-*
-. $$$*****$$$*****$$$*****$$$*****
-.
-. FUNCTION IUSAME(A,JL,JR,MIN,LOC) *** M 501 ***
-. SCANS VECTOR A(JL) THRU A(JR) TO FIND A STRING OF SAME WORDS,
-. AT LEAST MIN WORDS LONG , IF ANY
-. RETURNS IUSAME=NUMBER OF WORDS IN THE STRING
-. RETURNS LOC=FORTRAN INDEX OF THE FIRST WORD OF THE STRING
-. RETURNS IUSAME=0 AND LOC=JR+1 IF NO FIND
-. * IF JL.LE.0 USES JL=1
-. * ERROR EXIT IF JR.LT.MAX0(1,JL) OR MIN.LE.0
-. THIS ROUTINE IS USED BY THE DUMP PROCESSORS.
-.
-. $$$*****$$$*****$$$*****$$$*****
-
- AXR$
- FORT$
-$(1),FIRS01
- + 'IUSAME'
-IUSAME*
-#include "ftnors1.inc"
-#include "spyuse.inc"
-* Ignoring t=pass
- DL A2,1,XARG . LOC(JL), LOC(JR)
- L A2,0,A2 . JL
- LN A5,0,A3 . -JR
- TLE,U A2,1
- L,U A2,1 . JL = MAX0(1,JL)
- AU A2,A5 . (A3) = JL-JR
- A A2,0,XARG . LOC(A(JL)) + 1
- DL A0,3,XARG . LOC(MIN), LOC(LOC)
- AN,U A2,1 LOC(A(JL))
- L A0,0,A0 . MIN
- SMA A3,R1 . LOOP COUNT = JR-JL
- TG,U A0,1
- TG,U A3,1
-LMJER1 SLJ GERR$ . IF MIN.LE.0 .OR. JR.LT.JL
- LXI,U A2,1
- . LOOP
-IUS20 L A3,R1 . SAVE INITIAL VALUE OF COUNTER
- L A4,0,A2 . A(JR-(R1))
- SNE A4,1,*A2
- J IUS40
- ANU A3,R1 . NUMBER OF SAME WORDS
- TLE A4,A0 . COMPARE TO MIN
- J IUS20 . .LT.MIN, TRY AGAIN
-IUS30
- L A0,A4
-IUS31 A A3,A5
- SMA A3,0,A1
- J RETUR5
-IUS40 . END OF SCAN
- AU,U A3,1
- TLE A4,A0
- J IUS44
- J IUS30
-IUS44 LN,U A3,1
- SZ A0
- J IUS31
-
-#if (defined(CERNLIB_GUYDIAGP))&&(defined(CERNLIB_GUYFORT))
-. DIAGNOSTIC PACKETS FOR FORT
-#include "gerr_c.inc"
-F FORM 6,6,6,18
- INFO 010 03
-$(3)
-DIAG1 F 077,050,3,IUSAME
- + 0,DYN$
- + 'IUSAME'
- ON GERMAX
-DIAG2 F 077,067,2,0
- + LMJER1-FIRS01,DYN$
-DIAG3 F 077,047,LDIAG3,LMJER1+1
- + LDIAG3-2,DIAG2
- 'IUSAME(A,JL,JR,MIN,L) ERROR: MIN.LE.0 OR JR<MAX0(1,JL)'
-LDIAG3 EQU $-DIAG3
- OFF
- ON GERMAX=0
-DIAG2 F 077,062,2,LMJER1+1
- + LMJER1-FIRS01,DIAG1
- OFF
-#endif
- END
-#ifdef CERNLIB_TCGEN_IUSAME
-#undef CERNLIB_TCGEN_IUSAME
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/loren4.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/loren4.s
deleted file mode 100644
index 9423261..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/loren4.s
+++ /dev/null
@@ -1,136 +0,0 @@
-*
-* $Id: loren4.s,v 1.1.1.1 1996/02/15 17:54:03 mclareni Exp $
-*
-* $Log: loren4.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:03 mclareni
-* Kernlib
-*
-*
-. *****$$$*****$$$*****$$$*****
-.
-. SUBROUTINE LOREN4( DIR, PIN, POUT ) *** U 101 ***
-. DIMENSION DIR(4), PIN(4), POUT(4)
-. COMPUTES THE NEW COORDINATES POUT OF 4-VECTOR PIN IN THE
-. LORENTZ TRANSFORMATION PARAMETRISED BY DIR
-. * NO CHECK FOR NEGATIVE SQRT, FLOATING POINT OVERFLOW OR DIVIDE FAULT
-. * DIR IS SUPPOSED TO BE TIME-LIKE
-. * POUT=PIN IF DIR=0
-.
-. *****$$$*****$$$*****$$$*****
-
- AXR$
- FORT$
-
-SLATE INFO 2 2
-$(2)
-LORB RES 1
-SAVARG RES 3
-
-$(0)
- ON FORE
-LORA + 'LOREN4' . WALK BACK PACKET FOR 11A
-DYN$ + 0
- OFF
- DO FTN ,LORARG + LORB
-
-$(1),FIRS01
-LOREN4*
-#include "ftnors1.inc"
-#include "spyuse.inc"
-* Ignoring t=pass
- DL A1,1,XARG . LOC(PIN), LOC(POUT)
- L A3,0,XARG . LOC(DIR)
- DS A1,SAVARG+1
- L A4,2,A3 . D3
- DL A0,0,A3 . D1, D2
- FM A4,A4 . D3**2
- FM A1,A1 . D2**2
- S A3,SAVARG
- L A2,3,A3 . D4
- FA A4,A1 . D2**2+D3**2
- FM A0,A0 . D1**2
- FM A2,A2 . D4**2
- FA A4,A0 . (3 VECT DIR)**2
- S X11,DYN$
- FAN A2,A4 . D4**2 - (D1**2+D2**2+D3**2)
- DO FTN , L,U A0,LORARG
- SMA A2,LORB
- ON FORE++FORT**OPTR
-LMJSQ1 LMJ X11,SQRT
- + LORB
- DO FORE , + $-LOREN4-2,LORA
- DO NNOP , NOP
- OFF . FORE++FORT**OPTR
- ON FORT**(-OPTR)
- L,U A0,LORB
- LXI,U X11,RMATH$
-LMJSQ1 LIJ X11,SQRT$
- OFF . FORT**(-OPTR)
- ON FTN
-LMJSQ1 LMJ X11,SQRT
- OFF . FTN
- DL A1,SAVARG+1 . LOC(PIN), LOC(POUT)
- L X11,DYN$
- JZ A0,LOR60
- S A0,R1 . M
- DS A8,A15+1
- L A0,SAVARG . LOC(DIR)
- DL A3,0,A1 . P1, P2
- L A8,2,A0 . D3
- DS A6,R2
- FM A8,2,A1 . D3*P3
- FM A4,1,A0 . P2*D2
- FA A8,A4 . D3*P3+D2*P2
- L A6,3,A1 . P4
- FM A3,0,A0 . P1*D1
- FM A6,3,A0 . P4*D4
- FA A8,A3 . (3VECT DIR)*(3VECT PIN)
- L A3,3,A0 . D4
- FAN A6,A8 . D4*P4-D*P
- FA A3,R1 . D4+M
- FD A6,R1 . POUT(4)
- FD A8,A3 . (D*P)/(E+M)
- S A6,3,A2 .
- FAN A8,3,A1 . D*P/(E+M)-P4
- FD A8,R1 . X=(D*P/(E+M)-P4)/M
- L A3,0,A0 . D1
- L A5,1,A0 . D2
- FM A3,A8 . D1*X
- FM A5,A8 . D2*X
- FM A8,2,A0 . X.D3
- FA A3,0,A1 . D1*X+P1
- FA A5,1,A1 . D2*X+P2
- FA A8,2,A1 . D3*X+P3
- S A3,0,A2 . POUT(1)
- DL A6,R2
- S A5,1,A2 . POUT(2)
- S A8,2,A2 . POUT(3)
- DL A8,A15+1 .
- J RETUR3
-LOR60 . POUT=PIN IF DIR=0
- L,U R1,4
- LXI,U A1,1
- LXI,U A2,1
- BT A2,0,*A1
- J RETUR3
-
-. DIAGNOSTIC PACKETS FOR FORT
- ON FORT++FTN
-#include "gerr_c.inc"
- RES 1
- OFF
- ON FORT
-F FORM 6,6,6,18
- INFO 010 03
-$(3)
-DIAG1 F 077,050,3,LOREN4
- + 0,DYN$
- 'LOREN4'
- DO OPTR ,DIAG2 + 0776202,LMJSQ1+1
- DO OPTR=0 ,DIAG2 + 0777302,LMJSQ1+1
- + LMJSQ1-FIRS01,DIAG1
- OFF
- END
-#ifdef CERNLIB_TCGEN_LOREN4
-#undef CERNLIB_TCGEN_LOREN4
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/lorenb.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/lorenb.s
deleted file mode 100644
index cfb1ef3..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/lorenb.s
+++ /dev/null
@@ -1,68 +0,0 @@
-*
-* $Id: lorenb.s,v 1.1.1.1 1996/02/15 17:54:03 mclareni Exp $
-*
-* $Log: lorenb.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:03 mclareni
-* Kernlib
-*
-*
-. **************************************
-.
-. SUBROUTINE LORENB( U, PS, PI, PF ) *** U102 ***
-. * NOT PROTECTED AGAINST FO OR DF
-.
-. **************************************
-
- AXR$
- FORT$
-$(1)
-LORENB*
-#include "ftnors1.inc"
-#include "spyuse.inc"
-* Ignoring t=pass
- L A3,0,XARG . LOC(U)
- DL A1,1,XARG . LOC(PS), LOC(PI)
- DS A6,R2 . SAVE A6,A7
- L R1,0,A3 . U
- L A3,0,A1 . PS(1)
- DL A5,1,A2 . PI(2), PI(3)
- FM A3,0,A2 . PS(1)*PI(1)
- FM A6,2,A1 . PI(3)*PS(3)
- FA A3,A6
- FM A5,1,A1 . PI(2)*PS(2)
- L A0,3,XARG . LOC(PF)
- L A6,3,A1 . PS(4)
- FA A3,A5
- TNE A6,R1
- J LOR4 . IF( PS(4).EQ.U )
- FM A6,3,A2 . PS(4)*PI(4)
- L A5,3,A1 . PS(4)
- FA A3,A6
- FA A5,R1 . PS(4) + U
- FD A3,R1 . PF4
- SA A3,3,A0 . PF(4)
- FA A3,3,A2 . PF4 + PI(4)
- L A6,2,A1 . PS(3)
- FD A3,A5 . FN
- L A4,0,A1 . PS(1)
- FM A6,A3 . PS(3)*FN
- FM A4,A3 . PS(1)*FN
- FA A6,2,A2 . PF(3)
- FA A4,0,A2 . PF(1)
- S A6,2,A0
- L A5,1,A1 . PS(2)
- FM A5,A3 . PS(2)*FN
- FA A5,1,A2 . PF(2)
-LOR2
- DL A6,R2
- DS A4,0,A0
- J RETUR4
-LOR4 . IF( PS(4).EQ.U )
- DL A6,2,A1
- DL A4,0,A1
- DS A6,2,A0
- J LOR2
- END
-#ifdef CERNLIB_TCGEN_LORENB
-#undef CERNLIB_TCGEN_LORENB
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/lorenf.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/lorenf.s
deleted file mode 100644
index 88c3451..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/lorenf.s
+++ /dev/null
@@ -1,68 +0,0 @@
-*
-* $Id: lorenf.s,v 1.1.1.1 1996/02/15 17:54:03 mclareni Exp $
-*
-* $Log: lorenf.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:03 mclareni
-* Kernlib
-*
-*
-. **************************************
-.
-. SUBROUTINE LORENF( U, PS, PI, PF )
-. * NOT PROTECTED AGAINST FO OR DF
-.
-. **************************************
-
- AXR$
- FORT$
-$(1)
-LORENF*
-#include "ftnors1.inc"
-#include "spyuse.inc"
-* Ignoring t=pass
- L A3,0,XARG . LOC(U)
- DL A1,1,XARG . LOC(PS), LOC(PI)
- DS A6,R2 . SAVE A6,A7
- L R1,0,A3 . U
- L A3,0,A1 . PS(1)
- DL A5,1,A2 . PI(2), PI(3)
- FM A3,0,A2 . PS(1)*PI(1)
- FM A6,2,A1 . PI(3)*PS(3)
- FA A3,A6
- FM A5,1,A1 . PI(2)*PS(2)
- L A0,3,XARG . LOC(PF)
- L A6,3,A1 . PS(4)
- FA A3,A5
- TNE A6,R1
- J LOR4 . IF( PS(4).EQ.U )
- FM A6,3,A2 . PS(4)*PI(4)
- L A5,3,A1 . PS(4)
- FAN A3,A6
- FA A5,R1 . PS(4) + U
- FD A3,R1 . -PF4
- SNA A3,3,A0 . PF(4)
- FAN A3,3,A2 . -PF4 - PI(4)
- L A6,2,A1 . PS(3)
- FD A3,A5 . FN
- L A4,0,A1 . PS(1)
- FM A6,A3 . PS(3)*FN
- FM A4,A3 . PS(1)*FN
- FA A6,2,A2 . PF(3)
- FA A4,0,A2 . PF(1)
- S A6,2,A0
- L A5,1,A1 . PS(2)
- FM A5,A3 . PS(2)*FN
- FA A5,1,A2 . PF(2)
-LOR2
- DL A6,R2
- DS A4,0,A0
- J RETUR4
-LOR4 . IF( PS(4).EQ.U )
- DL A6,2,A1
- DL A4,0,A1
- DS A6,2,A0
- J LOR2
- END
-#ifdef CERNLIB_TCGEN_LORENF
-#undef CERNLIB_TCGEN_LORENF
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/lvmax.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/lvmax.s
deleted file mode 100644
index 9fb9cbc..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/lvmax.s
+++ /dev/null
@@ -1,68 +0,0 @@
-*
-* $Id: lvmax.s,v 1.1.1.1 1996/02/15 17:54:04 mclareni Exp $
-*
-* $Log: lvmax.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:04 mclareni
-* Kernlib
-*
-*
-. $$$*****$$$*****$$$*****$$$*****
-.
-. FUNCTION LVMAX( A,N ) *** F 121 ***
-. RETURNS IVMAX= ADDRESS OF THE WORD WHICH CONTAINS THE MAXIMUM VALUE
-. IN ARRAY A(1) THRU A(N)
-. IF SEVERAL WORDS ARE EQUAL TO AMAX RETURNS THE ADDRESS OF THE FIRST
-. * ERROR EXIT IF N.LE.0 (==>LVMAX=N)
-. * ARRAY A MAY BE INTEGER OR REAL, NOT DOUBLE PRECISION
-.
-. $$$*****$$$*****$$$*****$$$*****
-.
- AXR$
- FORT$
-$(1),FIRS01
- + 'LVMAX '
-LVMAX*
-#include "ftnors1.inc"
-#include "spyuse.inc"
-* Ignoring t=pass
- DL A2,0,XARG . LOC(A), LOC(N)
- L A0,0,A3 . N
- ANU,U A0,1
- LXI,U A2,1
- TP A1
-LMJER1 SLJ GERR$ . ERROR EXIT IF N.LE.0
- S A1,R1
-LVMX1 L A3,0,A2 . ANEW CANDIDATE
- L A1,R1
- SG A3,1,*A2 . LOOP
- J $+2
- J LVMX1
- AN A0,A1
- J RETUR2
-
-#if (defined(CERNLIB_GUYDIAGP))&&(defined(CERNLIB_GUYFORT))
-. DIAGNOSTIC PACKETS FOR FORT
-#include "gerr_c.inc"
-F FORM 6,6,6,18
- INFO 010 03
-$(3)
-DIAG1 F 077,050,3,LVMAX
- + 0,DYN$
- + 'LVMAX '
- ON GERMAX
-DIAG2 F 077,067,2,0
- + LMJER1-FIRS01,DYN$
-DIAG3 F 077,047,LDIAG3,LMJER1+1
- + LDIAG3-2,DIAG2
- 'LVMAX(A,N) ERROR: N.LE.0'
-LDIAG3 EQU $-DIAG3
- OFF
- ON GERMAX=0
-DIAG2 F 077,062,2,LMJER1+1
- + LMJER1-FIRS01,DIAG1
- OFF
-#endif
- END
-#ifdef CERNLIB_TCGEN_LVMAX
-#undef CERNLIB_TCGEN_LVMAX
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/lvmaxa.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/lvmaxa.s
deleted file mode 100644
index ee29450..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/lvmaxa.s
+++ /dev/null
@@ -1,70 +0,0 @@
-*
-* $Id: lvmaxa.s,v 1.1.1.1 1996/02/15 17:54:04 mclareni Exp $
-*
-* $Log: lvmaxa.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:04 mclareni
-* Kernlib
-*
-*
-. $$$*****$$$*****$$$*****$$$*****
-.
-. FUNCTION LVMAXA( A,N ) *** F 121 ***
-. RETURNS LVMAXA = LOCATION OF THE ELEMENT WITH THE MAXIMUM ABSOLUTE VALUE
-. IN VECTOR A(1) THROUGH A(N)
-. IF SEVERAL WORDS ARE EQUAL TO AMAXA RETURNS THE ADDRESS OF THE FIRST
-. * ERROR EXIT IF N.LE.0 (==>LVMAXA=N)
-. * ARRAY A MAY BE INTEGER OR REAL, NOT DOUBLE PRECISION
-.
-. $$$*****$$$*****$$$*****$$$*****
-
- AXR$
- FORT$
-$(1),FIRS01
- + 'LVMAXA'
-LVMAXA*
-#include "ftnors1.inc"
-#include "spyuse.inc"
-* Ignoring t=pass
- DL A2,0,XARG . LOC(A), LOC(N)
- L A0,0,A3 . N
- ANU,U A0,1
- LXI,U A2,1
- TP A1
-LMJER1 SLJ GERR$ . ERROR EXIT IF N.LE.0
- LMA A4,0,*A2
-LVMXA1 L A3,A1 . A NEW CANDIDATE
- L A5,A4
- J LVMXA3
-LVMXA2 LMA A4,0,*A2 . LOOP
- TLE A5,A4
- J LVMXA1
-LVMXA3 JGD A1,LVMXA2
- AN A0,A3
- J RETUR2
-
-#if (defined(CERNLIB_GUYDIAGP))&&(defined(CERNLIB_GUYFORT))
-. DIAGNOSTIC PACKETS FOR FORT
-#include "gerr_c.inc"
-F FORM 6,6,6,18
- INFO 010 03
-$(3)
-DIAG1 F 077,050,3,LVMAXA
- + 0,DYN$
- + 'LVMAXA'
- ON GERMAX
-DIAG2 F 077,067,2,0
- + LMJER1-FIRS01,DYN$
-DIAG3 F 077,047,LDIAG3,LMJER1+1
- + LDIAG3-2,DIAG2
- 'LVMAXA( A,N ) ERROR IF N.LE.0'
-LDIAG3 EQU $-DIAG3
- OFF
- ON GERMAX=0
-DIAG2 F 077,062,2,LMJER1+1
- + LMJER1-FIRS01,DIAG1
- OFF
-#endif
- END
-#ifdef CERNLIB_TCGEN_LVMAXA
-#undef CERNLIB_TCGEN_LVMAXA
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/lvmin.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/lvmin.s
deleted file mode 100644
index c835970..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/lvmin.s
+++ /dev/null
@@ -1,70 +0,0 @@
-*
-* $Id: lvmin.s,v 1.1.1.1 1996/02/15 17:54:04 mclareni Exp $
-*
-* $Log: lvmin.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:04 mclareni
-* Kernlib
-*
-*
-. $$$*****$$$*****$$$*****$$$*****
-.
-. FUNCTION LVMIN( A,N ) *** F 121 ***
-. RETURNS IVMIN= ADDRESS OF THE WORD WHICH CONTAINS THE MINIMUM VALUE
-. IN ARRAY A(1) THRU A(N)
-. IF SEVERAL WORDS ARE EQUAL TO AMIN RETURNS THE ADDRESS OF THE FIRST
-. * ERROR EXIT IF N.LE.0 (==>LVMIN=N)
-. * ARRAY A MAY BE INTEGER OR REAL, NOT DOUBLE PRECISION
-.
-. $$$*****$$$*****$$$*****$$$*****
-
- AXR$
- FORT$
-$(1),FIRS01
- + 'LVMIN '
-LVMIN*
-#include "ftnors1.inc"
-#include "spyuse.inc"
-* Ignoring t=pass
- DL A2,0,XARG . LOC(A), LOC(N)
- L A1,0,A3 . N
- L A0,A1
- JGD A1,$+2 . N-1
-LMJER1 SLJ GERR$ . ERROR EXIT IF N.LE.0
- A A2,A1
- AN,U A2,1
- LXI,XU A2,-1
- S A1,R1
-LVMN1 L A4,1,A2 . NEW CANDIDATE
- L A0,R1
- SLE A4,0,*A2 . LOOP
- J $+2
- J LVMN1
- A,U A0,1
- J RETUR2
-
-#if (defined(CERNLIB_GUYDIAGP))&&(defined(CERNLIB_GUYFORT))
-. DIAGNOSTIC PACKETS FOR FORT
-#include "gerr_c.inc"
-F FORM 6,6,6,18
- INFO 010 03
-$(3)
-DIAG1 F 077,050,3,LVMIN
- + 0,DYN$
- + 'LVMIN '
- ON GERMAX
-DIAG2 F 077,067,2,0
- + LMJER1-FIRS01,DYN$
-DIAG3 F 077,047,LDIAG3,LMJER1+1
- + LDIAG3-2,DIAG2
- 'LVMIN(A,N) ERROR: N.LE.0'
-LDIAG3 EQU $-DIAG3
- OFF
- ON GERMAX=0
-DIAG2 F 077,062,2,LMJER1+1
- + LMJER1-FIRS01,DIAG1
- OFF
-#endif
- END
-#ifdef CERNLIB_TCGEN_LVMIN
-#undef CERNLIB_TCGEN_LVMIN
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/lvmina.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/lvmina.s
deleted file mode 100644
index 3807913..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/lvmina.s
+++ /dev/null
@@ -1,70 +0,0 @@
-*
-* $Id: lvmina.s,v 1.1.1.1 1996/02/15 17:54:04 mclareni Exp $
-*
-* $Log: lvmina.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:04 mclareni
-* Kernlib
-*
-*
-. $$$*****$$$*****$$$*****$$$*****
-.
-. FUNCTION LVMINA( A,N ) *** F 121 ***
-. RETURNS LVMINA= LOCATION OF ELEMENT WITH THE MINIMUM ABSOLUTE VALUE
-. IN VECTOR A(1) THROUGH A(N)
-. IF SEVERAL WORDS ARE EQUAL TO AMINA RETURNS THE ADDRESS OF THE FIRST
-. * ERROR EXIT IF N.LE.0 (==>LVMINA=N)
-. * ARRAY A MAY BE INTEGER OR REAL, NOT DOUBLE PRECISION
-.
-. $$$*****$$$*****$$$*****$$$*****
-
- AXR$
- FORT$
-$(1),FIRS01
- + 'LVMINA'
-LVMINA*
-#include "ftnors1.inc"
-#include "spyuse.inc"
-* Ignoring t=pass
- DL A2,0,XARG . LOC(A), LOC(N)
- L A0,0,A3 . N
- ANU,U A0,1
- LXI,U A2,1
- TP A1
-LMJER1 SLJ GERR$ . ERROR EXIT IF N.LE.0
- LMA A4,0,A2
-LVMNA1 L A3,A1 . NEW CANDIDATE
- L A5,A4
- J LVMNA3
-LVMNA2 LMA A4,1,*A2
- TLE A4,A5
- J LVMNA1
-LVMNA3 JGD A1,LVMNA2
- AN A0,A3
- J RETUR2
-
-#if (defined(CERNLIB_GUYDIAGP))&&(defined(CERNLIB_GUYFORT))
-. DIAGNOSTIC PACKETS FOR FORT
-#include "gerr_c.inc"
-F FORM 6,6,6,18
- INFO 010 03
-$(3)
-DIAG1 F 077,050,3,LVMINA
- + 0,DYN$
- + 'LVMINA'
- ON GERMAX
-DIAG2 F 077,067,2,0
- + LMJER1-FIRS01,DYN$
-DIAG3 F 077,047,LDIAG3,LMJER1+1
- + LDIAG3-2,DIAG2
- 'LVMINA( A,N ) ERROR IF N.LE.0'
-LDIAG3 EQU $-DIAG3
- OFF
- ON GERMAX=0
-DIAG2 F 077,062,2,LMJER1+1
- + LMJER1-FIRS01,DIAG1
- OFF
-#endif
- END
-#ifdef CERNLIB_TCGEN_LVMINA
-#undef CERNLIB_TCGEN_LVMINA
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/mxequ.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/mxequ.s
deleted file mode 100644
index 09fb847..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/mxequ.s
+++ /dev/null
@@ -1,279 +0,0 @@
-*
-* $Id: mxequ.s,v 1.1.1.1 1996/02/15 17:54:04 mclareni Exp $
-*
-* $Log: mxequ.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:04 mclareni
-* Kernlib
-*
-*
-. **************************************
-.
-. SUBROUTINE MXEQU( A, B, NI, NJ ) *** F 109 ***
-. DIMENSION A(NI,NI), B(NJ,NI)
-. SOLVES MATRIX EQUATION AX = B FOR X
-. MXEQU JUST TRANSFORMS MATRIX A IF NJ=0
-. SUBROUTINE MXEQU1( A, B, NI, NJ )
-. SAME AS MXEQU, BUT ASSUMES MATRIX A TRANSFORMED BY A PREVIOUS CALL
-. TO MXEQU
-. DO NOTHING IF NI = 0
-. * ERROR EXIT IF NI.LT.0 .OR. NJ.LT.0
-. METHOD: MILNE, NUMERICAL CALCULUS
-.
-. **************************************
-
- AXR$
- FORT$
-XA2 EQU X10
-XA5 EQU X11
-XA1 EQU A0
-XA3 EQU A1
-XA6 EQU A2
-XA4 EQU A3
-AL1 EQU A4
-AL2 EQU A5
-AC1 EQU A9
-AC2 EQU A10
-AUX1 EQU AC1
-AUX2 EQU AC2
-INCXA4 EQU A12
-INCXA5 EQU A14
-INCXA2 EQU A15
-HOLDIM1 EQU A8
-HOLDAII EQU A7
-HOLDNI EQU A15+2
-HOLDNIM1 EQU A15+1
-RLIG EQU R3
-RNMI EQU R2
-RELT EQU R1
-
-XB3 EQU A1
-XB2 EQU A2
-XC2 EQU A1
-XC3 EQU A2
-HOLDIIM1 EQU A3
-ANIMI EQU A3
-AB1 EQU A4
-AB2 EQU A5
-AUX3 EQU AB1
-INCXB2 EQU A7
-INCXC2 EQU A7
-HOLDNJ EQU A14
-HOLDNJM1 EQU A15
-RNJ EQU R2
-
-SLATE INFO 2 2
-$(2)
-SAVX10 RES 1
-SAVX11 RES 1
-SAVA6 RES 2
-SAVA8 RES 2
-SAVA10 RES 2
-SAVA12 RES 1
-SAVA14 RES 2
-SAVLOCA RES 1
-SAVBJ RES 2
-
-$(1),FIRS01
- + 'MXEQU1'
-MXEQU1*
- L,U A5,1
- J MXEQ01
- + 'MXEQU '
-MXEQU*
- L,U A5,0
-MXEQ01
-#include "ftnors1.inc"
-#include "spyuse.inc"
-* Ignoring t=pass
- DL A2,2,XARG . LOC(NI), LOC(NJ)
- DL A0,0,XARG . LOC(A), LOC(B)
- L A4,0,A2 . NI
- L A2,0,A3 . NJ
- S A4,HOLDNI
- JZ A4,RETUR4 . DO NOTHING IF NI=0
- JGD A4,$+2
-LMJER1 SLJ GERR$
- TZ A2
- JN A2,LMJER1 . ERROR EXIT IF NJ.LT.0
- DS A1,SAVBJ
- DS A6,SAVA6
- LXI,U XA1,1
- DS A14,SAVA14
- S A4,HOLDNIM1
- JNZ A5,MXQ101
- S X11,SAVX11
- S X10,SAVX10
- S A0,SAVLOCA
- DS A8,SAVA8
- L XA5,XA1
- DS A10,SAVA10
- S A4,RLIG
- S A12,SAVA12
- L,U HOLDIM1,0 . I-1
- LXI XA5,HOLDNI
- J MXEQ70
-.
-. TRANSFORM MATRIX A
-.
-MXEQ40
- L RNMI,RLIG
-MXEQ42
- ANU,U HOLDIM1,1 . I - 2
- L AL1,0,XA3
- S HOLDIM1+1,RELT
- L AC1,0,XA6
- JZ HOLDIM1,MXEQ50
-MXEQ44
- L AL2,0,*XA1
- L AC2,0,*XA4
- FM AL2,0,*XA2
- FM AC2,0,*XA5
- FAN AL1,AL2
- FAN AC1,AC2
- JGD RELT,MXEQ44
-MXEQ50
- FD AL1,HOLDAII
- L AC2,0,*XA4
- S AL1,0,*XA3
- A XA4,INCXA4
- FM AC2,0,XA5
- AN XA1,HOLDIM1
- FAN AC1,AC2
- A XA2,INCXA2
- S AC1,0,*XA6
- A XA5,INCXA5
- JGD RNMI,MXEQ42
- A,U HOLDIM1,1 . (I-1) = (I-1) + 1
- A XA1,HOLDNI . 1. +NI
-MXEQ70
- AU XA1,HOLDIM1 . 1. LOC(A(I,I))
- DLN AUX1,HOLDNIM1 . 2.
- L HOLDAII,0,XA1+1 . 1. A(I,I)
- A,U XA5,1
- A AUX1,HOLDIM1 . 2. -(NI-I)
- A,U XA3,1 . 1.
- MSI AUX2,HOLDIM1 . 2. -NI*(I-1)
- AU XA3,HOLDNI . 1.
- SN AUX1,INCXA4 . 2.
- ANU XA6,HOLDIM1 . 1. TO GET XA4
- AU,U AUX2,1 . -NI*(I-1) + 1
- AN,U XA4,1 . 1.
- DS AUX2,INCXA5
- LXI XA6,HOLDNI
- S XA5,XA2
- JGD RLIG,MXEQ40
-
- L X10,SAVX10
- L X11,SAVX11
- L A0,SAVLOCA
- DL A1,SAVBJ
- DL A8,SAVA8
- DL A10,SAVA10
- L A12,SAVA12
-.
-. TRANSFORM MATRIX B
-.
-MXQ101
- JZ A2,MXQFIN
- ANU,U A2,1 . NJ - 1
- DS A2,HOLDNJ
- L RLIG,HOLDNI
- L XB2,XB3
- L,U HOLDIIM1,0 . I-1
- LXI XB2,HOLDNJ
- LXI,U XB3,1
- J MXQ170
-MXQ140
- L RNJ,HOLDNJM1
-MXQ142
- ANU,U HOLDIIM1,1
- S HOLDIIM1+1,RELT
- L AB1,0,XB3
- JZ HOLDIIM1,MXQ150
-MXQ144
- L AB2,0,*XA1
- FM AB2,0,*XB2
- FAN AB1,AB2
- JGD RELT,MXQ144
-MXQ150
- FD AB1,0,XA1
- AN XB2,INCXB2
- S AB1,0,*XB3
- AN XA1,HOLDIIM1
- JGD RNJ,MXQ142
- A,U HOLDIIM1,1 . (I-1) = (I-1) + 1
- A XA1,HOLDNI
- LXM XB2,SAVBJ
-MXQ170
- L AUX3,HOLDNJ . NJ
- MSI AUX3,HOLDIIM1 . NJ*(I-1)
- AN,U AUX3,1 . NJ*(I-1) - 1
- S AUX3,INCXB2
- JGD RLIG,MXQ140
-.
-. GET SOLUTION X (STORED INTO B )
-.
- AN,U XB3,1 . BECOMES XC2
- L,U ANIMI,1 . NI - I
- ANU XC2,HOLDNJ . BECOMES XC3
- L RLIG,HOLDNIM1
- LXI XC2,HOLDNJ
- LXI,U XC3,-1
- J MXQ270
-MXQ240
- L RNJ,HOLDNJM1
-MXQ242
- ANU,U ANIMI,1
- S ANIMI+1,RELT
- L AB1,0,XC3
-MXQ244
- L AB2,0,*XA1
- FM AB2,0,*XC2
- FAN AB1,AB2
- JGD RELT,MXQ244
- S AB1,0,*XC3
- AN XA1,ANIMI
- AN XC2,INCXC2
- JGD RNJ,MXQ242
- A,U ANIMI,1 . (NI-I) = (NI-I) + 1
-MXQ270
- L AUX3,HOLDNJ
- AN XA1,HOLDNI
- MSI AUX3,ANIMI . NJ*(NI-I)
- AN,U XA1,1
- A,U AUX3,1 . NJ*(NI-I) + 1
- S AUX3,INCXC2
- JGD RLIG,MXQ240
-MXQFIN
- DL A14,SAVA14
- DL A6,SAVA6
- J RETUR4
-
-#if (defined(CERNLIB_GUYDIAGP))&&(defined(CERNLIB_GUYFORT))
-. DIAGNOSTIC PACKETS
-#include "gerr_c.inc"
-F FORM 6,6,6,18
- INFO 010 03
-$(3),DIAG1 F 077,050,LDIAG1,MXEQU
- + DYN$
- + 'MXEQU,MXEQU1'
-LDIAG1 EQU $-DIAG1
-DIAG11 + 0776102,MXEQU1
- + DIAG1
- ON GERMAX
-DIAG2 + 0776702,0
- + LMJER1-FIRS01,DYN$
-DIAG3 F 077,047,LDIAG3,LMJER1+1
- + LDIAG3-2,DIAG2
- 'MXEQU,EQU1(,,NI,NJ) ERROR: NI<0 OR NJ<0'
-LDIAG3 EQU $-DIAG3
- OFF . GERMAX
- ON GERMAX=0
-DIAG2 + 0776202,LMJER1+1
- + LMJER1-FIRS01,DIAG1
- OFF . GERMAX=0
-#endif
- END
-#ifdef CERNLIB_TCGEN_MXEQU
-#undef CERNLIB_TCGEN_MXEQU
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/mxmlrt.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/mxmlrt.s
deleted file mode 100644
index 11eb2ae..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/mxmlrt.s
+++ /dev/null
@@ -1,141 +0,0 @@
-*
-* $Id: mxmlrt.s,v 1.1.1.1 1996/02/15 17:54:04 mclareni Exp $
-*
-* $Log: mxmlrt.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:04 mclareni
-* Kernlib
-*
-*
-. **************************************
-.
-. SUBROUTINE MXMLRT( A, B, X, NI, NJ ) *** F 110 ***
-. DIMENSION A(NJ,NI), B(NJ,NJ), X(NI,NI)
-. X = A * B * AT . AT = A TRANSPOSED
-. SUBROUTINE MXMLRT( A, B, X, NI, NJ )
-. DIMENSION A(NI,NJ), B(NJ,NJ), X(NI,NI)
-. X = AT * B * A
-. * ERROR EXIT IF NI.LE.0 .OR. NJ.LE.0
-. MATRICES STORED USING CERN CONVENTION: AIJ STORED IN A(J,I)
-.
-. **************************************
-
- AXR$
- FORT$
-HOLDJM1 EQU A15+1
-HOLDIM1 EQU A15+2
-
-SLATE INFO 2 2
-$(2),SAVA6 RES 2
-
-$(1),FIRS01
- + 'MXMLTR'
-MXMLTR*
- S X11,A15+1
- J MXML01
- + 'MXMLRT'
-MXMLRT*
- SZ A15+1
-MXML01
-#include "ftnors1.inc"
-#include "spyuse.inc"
-* Ignoring t=pass
- DL A2,3,XARG . LOC(NI), LOC(NJ)
- DS A6,SAVA6
- L R2,0,A2 . NI
- L A2,2,XARG . LOC(X)
- L R3,0,A3 . NJ
- DL A0,0,XARG . LOC(A), LOC(B)
- DL A4,R2 . NI, NJ
- JGD R2,$+2 . NI-1
- J LMJER1 . ERROR EXIT IF NI.LE.0
- JGD R3,$+2 . NJ-1
-LMJER1 SLJ GERR$ . ERROR EXIT IF NJ.LE.0
- L A6,A4
- LXI,U A1,1
- L,U A3,A6
- MI A6,A6
- S,H2 A0,MXML69
- LXI,U A2,1
- S,H2 A1,MXML67
- S A7,R1
- BT A2,0,*A3 . VZERO( X, NI**2 )
- S,H2 A7,MXML41
- LXI A2,A4 . NI, LOC(X(...))
- L A3,A0
- TZ A15+1
- J MXML30
- MSI A4,A5 . NI*NJ
- LXI,U A0,1 . MXMLRT
- S,H2 A5,MXML66 . SET PARAMS FOR MXMLRT
- AN,U A4,1 . NI*NJ - 1
- LXI A3,A5 . J,LOC(A)
- S,H2 A4,MXML63
- J MXML36
-MXML30 . SET PARAMS FOR MXMLTR
- L,U A6,1
- MSI A5,A4 . NI*NJ
- SZ,H2 MXML63
- LXI A0,A4 . NI,LOC(A)
- S,H2 A6,MXML66
- LXI,U A3,1
-MXML36
- S,H2 A5,MXML60
- S R3,HOLDJM1
- S R2,HOLDIM1
-MXML40
-MXML41 AN,U A2,$-$ . -NI**2
-MXML42
- L R1,HOLDJM1
- SZ A4
-MXML46
- L A6,0,*A1
- FM A6,0,*A0
- FA A4,A6
- JGD R1,MXML46
- L R1,HOLDIM1
-MXML52
- L A6,0,*A3
- L A5,0,A2
- FM A6,A4
- FA A5,A6
- S A5,0,*A2
- JGD R1,MXML52
-MXML60 AN,U A0,$-$ . -NJ OR -NI*NJ
-MXML63 AN,U A3,$-$ . -NI*NJ+1 OR 0
- JGD R3,MXML40
-MXML66 A,U A0,$-$ . +NJ OR +1
-MXML67 LXM,U A1,$-$ . LOC(B)
- A,U A2,1
-MXML69 LXM,U A3,$-$ . LOC(A)
- L R3,HOLDJM1
- JGD R2,MXML40
- DL A6,SAVA6
- J RETUR5
-
-#if (defined(CERNLIB_GUYDIAGP))&&(defined(CERNLIB_GUYFORT))
-. DIAGNOSTIC PACKETS
-#include "gerr_c.inc"
- INFO 010 03
-$(3),DIAG1 + 0775004,MXMLRT
- + DYN$
- + 'MXMLRT,TR '
-DIAG11 + 0776102,MXMLTR
- + DIAG1
- ON GERMAX
-F FORM 6,6,6,18
-DIAG2 + 0776702,0
- + LMJER1-FIRS01,DYN$
-DIAG3 F 077,047,LDIAG3,LMJER1+1
- + LDIAG3-2,DIAG2
- 'MXMLRT,TR(,,,NI,NJ) ERROR: NI OR NJ.LE.0'
-LDIAG3 EQU $-DIAG3
- OFF . GERMAX
- ON GERMAX=0
-DIAG2 + 0776202,LMJER1+1
- + LMJER1-FIRS01,DIAG1
- OFF . GERMAX=0
-#endif
- END
-#ifdef CERNLIB_TCGEN_MXMLRT
-#undef CERNLIB_TCGEN_MXMLRT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/mxmpy.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/mxmpy.s
deleted file mode 100644
index 7341088..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/mxmpy.s
+++ /dev/null
@@ -1,214 +0,0 @@
-*
-* $Id: mxmpy.s,v 1.1.1.1 1996/02/15 17:54:05 mclareni Exp $
-*
-* $Log: mxmpy.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:05 mclareni
-* Kernlib
-*
-*
-. **************************************
-.
-. SUBROUTINE MXMPY ( A, B, X, NI, NJ, NK ) *** F 110 ***
-. DIMENSION A(NJ,NI), B(NK,NJ), X(NK,NI)
-. X = A*B
-. IF NJ=0 X IS FILLED WITH ZEROS
-. SUBROUTINE MXMAD ( A, B, X, NI, NJ, NK )
-. X = A*B + X
-. IF NJ=0 X IS NOT MODIFIED
-. SUBROUTINE MXMUB ( A, B, X, NI, NJ, NK )
-. X = A*B - X
-. IF NJ=0 X IS REPLACED BY -X
-. * ERROR EXIT IF NI.LE.0 .OR. NJ.LT.0 .OR. NK.LE.0
-.
-. SUBROUTINE MXMPY1( A, Q, X, NI, NJ, NK ) *** F 110 ***
-. DIMENSION A(NJ,NI), Q(NJ,NK), X(NK,NI)
-. X = A*QT
-. SUBROUTINE MXMAD1( A, Q, X, NI, NJ, NK )
-. X = A*QT + X
-. SUBROUTINE MXMUB1( A, Q, X, NI, NJ, NK )
-. X = A*QT - X
-.
-. SUBROUTINE MXMPY2( P, B, X, NI, NJ, NK ) *** F 110 ***
-. DIMENSION P(NI,NJ), B(NK,NJ), X(NK,NI)
-. X = PT*B
-. SUBROUTINE MXMAD2( A, Q, X, NI, NJ, NK )
-. X = PT*B + X
-. SUBROUTINE MXMUB2( A, Q, X, NI, NJ, NK )
-. X = PT*B - X
-.
-. SUBROUTINE MXMPY3( P, Q, X, NI, NJ, NK ) *** F 110 ***
-. DIMENSION P(NI,NJ), Q(NJ,NK), X(NI,NK)
-. X = PT*QT
-. SUBROUTINE MXMAD3( P, Q, X, NI, NJ, NK )
-. X = PT*QT + X
-. SUBROUTINE MXMUB3( P, Q, X, NI, NJ, NK )
-. X = PT*QT - X
-.
-. **************************************
-
- AXR$
- FORT$
-HOLDKM1 EQU A15+2
-HOLDJ EQU A15+1
-
-$(0)
-ADDX LA A3,0,A2 . X(K,I)
-SUBX LNA A3,0,A2 . -X(K,I)
-NOX SZ A3
-
-$(1),FIRS01
- + 'MXMAD3'
-MXMAD3* L A4,ADDX
- LN,XU A5,2
- J MXMP01
- + 'MXMUB3'
-MXMUB3* L A4,SUBX
- LN,XU A5,2
- J MXMP01
- + 'MXMPY3'
-MXMPY3* L A4,NOX
- LN,XU A5,2
- J MXMP01
-
- + 'MXMAD2'
-MXMAD2* L A4,ADDX
- LN,XU A5,1
- J MXMP01
- + 'MXMUB2'
-MXMUB2* L A4,SUBX
- LN,XU A5,1
- J MXMP01
- + 'MXMPY2'
-MXMPY2* L A4,NOX
- LN,XU A5,1
- J MXMP01
-
- + 'MXMAD1'
-MXMAD1* L A4,ADDX
- L,U A5,1
- J MXMP01
- + 'MXMUB1'
-MXMUB1* L A4,SUBX
- L,U A5,1
- J MXMP01
- + 'MXMPY1'
-MXMPY1* L A4,NOX
- L,U A5,1
- J MXMP01
-
- + 'MXMAD '
-MXMAD* L A4,ADDX
- J MXMP00
- + 'MXMUB '
-MXMUB* L A4,SUBX
- J MXMP00
- + 'MXMPY '
-MXMPY* L A4,NOX
-MXMP00 L,U A5,0
-MXMP01
-#include "ftnors1.inc"
-#include "spyuse.inc"
-* Ignoring t=pass
- DL A1,4,XARG . LOC(NJ), LOC(NK)
- S A4,MXMP43
- L R2,0,A2 . NK
- DL A2,2,XARG . LOC(X), LOC(NI)
- L R1,0,A1 . NJ
- DL A0,0,XARG . LOC(A), LOC(B)
- LXI,U A2,1
- L R3,0,A3 . NI
- S,H2 A1,INCAA1
- DL A3,R1 . NJ, NK
- JB A5,MXMP20
- MSI A4,A3 . NJ*NK
- LXI A1,R2 . NK
- AN,U A4,1 . NJ*NK-1
- JN A5,MXMP22
-MXMP18 L A5,A3 . NJ
- LXI,U A0,1
- J MXMP24
-MXMP20 LXI,U A1,1
- L,U A4,0
- JP A5,MXMP18
-MXMP22 MSI A3,R3 . NI*NJ
- LXI A0,R3 . NI
- L,U A5,1
-MXMP24 SM,H2 A4,INCA1
- SM,H2 A3,INCA0
- SM,H2 A5,INCAA0
- JGD R3,$+2 . NI-1
- J LMJER1
- JGD R2,$+2 . NK-1
- J LMJER1
- JZ A3,$+3 . (A3=NJ OR NI*NJ)
- TP R1
-LMJER1 SLJ GERR$
- S R2,HOLDKM1
- S R1,HOLDJ
-MXMP40 . LOOP NI
- L R2,HOLDKM1 . NK - 1
-MXMP42 . LOOP NK
-MXMP43 + $-$ . SZ OR L OR LN A3
- L R1,HOLDJ . NJ-1
- J MXMP50
-MXMP44 . LOOP NJ
- L A4,0,*A1 . B(K,J)
- FM A4,0,*A0 . A(J,I)
- FA A3,A4
-MXMP50 JGD R1,MXMP44
- S A3,0,*A2 . C(K,I)
-INCA0 AN,U A0,$-$
-INCA1 AN,U A1,$-$
- JGD R2,MXMP42
-INCAA0 A,U A0,$-$
-INCAA1 LXM,U A1,$-$ . INC, LOC(B)
- JGD R3,MXMP40
- J RETUR6
-#if (defined(CERNLIB_GUYDIAGP))&&(defined(CERNLIB_GUYFORT))
-. DIAGNOSTIC PACKETS
-#include "gerr_c.inc"
-F FORM 6,6,6,18
- INFO 010 03
-$(3),DIAG1 F 077,050,LDIAG1,MXMPY
- + DYN$
- + 'MXMP.PACKAGE'
-LDIAG1 EQU $-DIAG1
-DIAG11 + 0775102,MXMPY1
- + DIAG1
-DIAG21 + 0775102,MXMPY2
- + DIAG1
-DIAG31 + 0775102,MXMPY3
- + DIAG1
-DIAG41 + 0775102,MXMAD
- + DIAG1
-DIAG51 + 0775102,MXMAD1
- + DIAG1
-DIAG61 + 0775102,MXMAD2
- + DIAG1
-DIAG71 + 0775102,MXMAD3
- + DIAG1
-DIAG81 + 0775102,MXMUB
- + DIAG1
-DIAG91 + 0775102,MXMUB1
- + DIAG1
-DIAG101 + 0775102,MXMUB2
- + DIAG1
-DIAG111 + 0775102,MXMUB3
- + DIAG1
- ON GERMAX
-DIAG2 + 0776702,0
- + LMJER1-FIRS01,DYN$
-DIAG3 F 077,047,LDIAG3,LMJER1+1
- + LDIAG3-2,DIAG2
- 'MXMP..(,,,NI,NJ,NK) ERROR: NI.LE.0 OR NJ<0 OR NK.LE.0'
-LDIAG3 EQU $-DIAG3
- OFF . GERMAX
- ON GERMAX=0
-DIAG2 + 0776202,LMJER1+1
- + LMJER1-FIRS01,DIAG1
- OFF . GERMAX=0
-#endif
- END
-#ifdef CERNLIB_TCGEN_MXMPY
-#undef CERNLIB_TCGEN_MXMPY
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/mxtrp.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/mxtrp.s
deleted file mode 100644
index 4060806..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/mxtrp.s
+++ /dev/null
@@ -1,66 +0,0 @@
-*
-* $Id: mxtrp.s,v 1.1.1.1 1996/02/15 17:54:05 mclareni Exp $
-*
-* $Log: mxtrp.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:05 mclareni
-* Kernlib
-*
-*
-. **************************************
-.
-. SUBROUTINE MXTRP( A, X, NI, NJ ) *** F 110 ***
-. DIMENSION A(NJ,NI), X(NI,NJ)
-. * ERROR EXIT IF NI.LE.0 .OR. NJ.LE.0
-.
-. **************************************
-
- AXR$
- FORT$
-$(1),FIRS01
- + 'MXTRP '
-MXTRP*
-#include "ftnors1.inc"
-#include "spyuse.inc"
-* Ignoring t=pass
- DL A2,2,XARG . LOC(NI), LOC(NJ)
- DL A0,0,XARG . LOC(A), LOC(X)
- L A4,0,A2 . NI
- L A5,0,A3 . NJ
- LXI A1,A4
- LXI,U A0,1
- TG,U A5,1
- JGD A4,$+2
-LMJER1 SLJ GERR$ . ERROR EXIT IF NI.LT.1 .OR. NJ.LT.1
- A A1,A4
-MXTR10
- ANU A1,A4
- S A5,R1
- BT A2,0,*A0
- JGD A4,MXTR10
- J RETUR4
-
-#if (defined(CERNLIB_GUYDIAGP))&&(defined(CERNLIB_GUYFORT))
-. DIAGNOSTIC PACKETS
-#include "gerr_c.inc"
- INFO 010 03
-$(3),DIAG1 + 0775003,MXTRP
- + DYN$
- + 'MXTRP '
- ON GERMAX
-F FORM 6,6,6,18
-DIAG2 + 0776702,0
- + LMJER1-FIRS01,DYN$
-DIAG3 F 077,047,LDIAG3,LMJER1+1
- + LDIAG3-2,DIAG2
- 'MXTRP(,,NI,NJ) ERROR: NI OR NJ.LE.0'
-LDIAG3 EQU $-DIAG3
- OFF . GERMAX
- ON GERMAX=0
-DIAG2 + 0776202,LMJER1+1
- + LMJER1-FIRS01,DIAG1
- OFF . GERMAX=0
-#endif
- END
-#ifdef CERNLIB_TCGEN_MXTRP
-#undef CERNLIB_TCGEN_MXTRP
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/mxuty.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/mxuty.s
deleted file mode 100644
index 40511b4..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/mxuty.s
+++ /dev/null
@@ -1,71 +0,0 @@
-*
-* $Id: mxuty.s,v 1.1.1.1 1996/02/15 17:54:05 mclareni Exp $
-*
-* $Log: mxuty.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:05 mclareni
-* Kernlib
-*
-*
-. **************************************
-.
-. SUBROUTINE MXUTY( A, N )
-. DIMENSION A(N,N)
-. BUILDS UNIT MATRIX
-. DO NOTHING IF N=0
-. * ERROR EXIT IF N.LT.0
-.
-. **************************************
-
- AXR$
- FORT$
-$(1),FIRS01
- + 'MXUTY '
-MXUTY*
-#include "ftnors1.inc"
-#include "spyuse.inc"
-* Ignoring t=pass
- DL A2,0,XARG . LOC(A), LOC(N)
- L,U A1,0
- L,U A0,A1
- LN A3,0,A3 . -N
- LXI,U A2,1
- JZ A3,RETUR2 . DO NOTHING IF N=0
- TG,U A3,1
-LMJER1 SLJ GERR$ . ERROR EXIT IF N<0
- ANU,U A3,1 . -N-1
- MSI A3,A3 . N*N
- AN,U A3,1 . N**2-1
- S A3,R1
- BT A2,0,*A0 . VZERO( A, N*N )
- SMA A4,R1
- LXI,U A1,0201400 . (A1) = +1.0
- LXI A2,A4 . -N-1, LOC(A(N**2))
- JGD R1,$+1
- BT A2,0,*A0 . VFILL(A,N,1.0) EVERY N+1 WORDS
- J RETUR2
-
-#if (defined(CERNLIB_GUYDIAGP))&&(defined(CERNLIB_GUYFORT))
-. DIAGNOSTIC PACKETS
-#include "gerr_c.inc"
- INFO 010 03
-$(3),DIAG1 + 0775003,MXUTY
- + DYN$
- + 'MXUTY '
- ON GERMAX
-F FORM 6,6,6,18
-DIAG2 + 0776702,0
- + LMJER1-FIRS01,DYN$
-DIAG3 F 077,047,LDIAG3,LMJER1+1
- + LDIAG3-2,DIAG2
- 'MXUTY(A,N) ERROR: N<0'
-LDIAG3 EQU $-DIAG3
- OFF . GERMAX
- ON GERMAX=0
-DIAG2 + 0776202,LMJER1+1
- + LMJER1-FIRS01,DIAG1
- OFF . GERMAX=0
-#endif
- END
-#ifdef CERNLIB_TCGEN_MXUTY
-#undef CERNLIB_TCGEN_MXUTY
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/proxim.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/proxim.s
deleted file mode 100644
index c7d561d..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/proxim.s
+++ /dev/null
@@ -1,56 +0,0 @@
-*
-* $Id: proxim.s,v 1.1.1.1 1996/02/15 17:54:05 mclareni Exp $
-*
-* $Log: proxim.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:05 mclareni
-* Kernlib
-*
-*
-. **************************************
-.
-. FUNCTION PROXIM( X, S )
-. RETURNS THE VALUE X + 2*N*PI CLOSEST TO S
-.
-. **************************************
-
- AXR$
- FORT$
-
-$(0)
-PI + 3.1415926536
-BIAS + 0233000000000
-
-$(1),FIRS01
-PROXIM*
-#include "ftnors1.inc"
-#include "spyuse.inc"
-* Ignoring t=pass
- DL A0,0,XARG . LOC(X), LOC(S)
- L A0,0,A0 . X
- L A5,PI
- L R2,0,A1 . S
- L A3,A0
- FAN A3,R2 . X - S
- LM A2,A3
- TG A5,A2
- J RETUR2
- L A0,A3
- FD A3,A5 . (X-S) / PI
- FA A3,BIAS
- LUF A1,A3
- FM A3,A5
- AN,U A1,0200
- LM A2,A2
- LSSL A2,8,A1
- FAN A0,A3
- JP A2,PROX30
- TN A0
- LN A5,A5
- FA A0,A5
-PROX30
- FA A0,R2
- J RETUR2
- END
-#ifdef CERNLIB_TCGEN_PROXIM
-#undef CERNLIB_TCGEN_PROXIM
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/rot.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/rot.s
deleted file mode 100644
index 138e5b3..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/rot.s
+++ /dev/null
@@ -1,123 +0,0 @@
-*
-* $Id: rot.s,v 1.1.1.1 1996/02/15 17:54:05 mclareni Exp $
-*
-* $Log: rot.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:05 mclareni
-* Kernlib
-*
-*
-. *****$$$*****$$$*****$$$*****
-.
-. SUBROUTINE ROT( A, TH, B ) *** F 118 ***
-. DIMENSION A(3),B(3)
-. ROTATE VECTOR A BY TH RADIANS AROUND THE Z AXIS TO GIVE B
-. B(1) = A(1)*COS(TH) - A(2)*SIN(TH)
-. B(2) = A(1)*SIN(TH) + A(2)*COS(TH)
-. B(3) = A(3)
-. * SINGLE PRECISION A,TH,B
-. * ANY OVERLAP
-.
-. *****$$$*****$$$*****$$$*****
-
- AXR$
- FORT$
-SLATE INFO 2 2
-$(2)
-ROTB RES 1
-ROTC RES 1
-LCARGB RES 1 . LCARGB BEFORE LCARGA
-LCARGA RES 1
-
-. WALK BACK PACKET FOR 11A
- ON FORE
-$(0)
-ROTA 'ROTA'
-DYN$ + 0
- OFF
- ON FTN
-$(0)
-LOCARG + ROTB
- OFF . FTN
-
-$(1),FIRS01
-ROT*
-#include "ftnors1.inc"
-#include "spyuse.inc"
-* Ignoring t=pass
- DL A2,0,XARG . LOC(A), LOC(TH)
- L A1,2,XARG
- S,H2 X11,DYN$
- L A3,0,A3 . TH
- DS A1,LCARGB
- DO FTN , L,U A0,LOCARG
- S A3,ROTB
- ON FORE++FORT**OPTR
-LMJSI1 LMJ X11,SIN
- + ROTB
- DO FORE , + $-ROT-2,ROTA
- DO NNOP , NOP
- OFF . FORE++FORT**OPTR
- ON FORT**(-OPTR)
- L,U A0,ROTB
- LXI,U X11,RMATH$
-LMJSI1 LIJ X11,SIN$
- OFF . FORT**(-OPTR)
- ON FTN
-LMJSI1 LMJ X11,SIN
- OFF . FTN
- SA A0,ROTC . ROTC=SIN(TH)
- ON FORE++FORT**OPTR
-LMJCO1 LMJ X11,COS
- + ROTB
- DO FORE , + $-ROT-2,ROTA
- DO NNOP , NOP
- OFF . FORE++FORT**OPTR
- ON FORT**(-OPTR)
- L,U A0,ROTB
- LXI,U X11,RMATH$
-LMJCO1 LIJ X11,COS$
- OFF . FORT**(-OPTR)
- ON FTN
- L,U A0,LOCARG
-LMJCO1 LMJ X11,COS
- OFF . FTN
- L,H2 X11,DYN$
- LA A4,ROTC .
- L A2,LCARGA
- LA A3,A0 . A0=A3=COS(TH)
- FM A0,1,A2 . A(2)*COS(TH)
- FM A4,0,A2 . A(1)*SIN(TH)
- FA A0,A4 . A0=A(2)*COS(TH)+A(1)*SIN(TH)=B(2)
- FM A3,0,A2 . A(1)*COS(TH)
- LA A1,2,A2 . A1=A(3)=B(3)
- LA A4,1,A2 .
- FM A4,ROTC . A(2)*SIN(TH)
- L A2,LCARGB
- FAN A3,A4 .
- DS A0,1,A2 .
- SA A3,0,A2 .
- J RETUR3
-
-. DIAGNOSTIC PACKETS FOR FORT
- ON FORT++FTN
-#include "gerr_c.inc"
- RES 1
- OFF
- ON FORT
-F FORM 6,6,6,18
- INFO 010 03
-$(3)
-DIAG1 F 077,050,3,ROT
- + 0,DYN$
- + 'ROT '
- DO OPTR ,DIAG2 + 0776202,LMJSI1+1
- DO OPTR=0 ,DIAG2 + 0777302,LMJSI1+1
- + LMJSI1-FIRS01,DIAG1
- DO OPTR ,DIAG3 + 0776202,LMJCO1+1
- DO OPTR=0 ,DIAG3 + 0777302,LMJCO1+1
- + LMJCO1-FIRS01,DIAG1
- OFF
- END
-#ifdef CERNLIB_TCGEN_ROT
-#undef CERNLIB_TCGEN_ROT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/ucocop.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/ucocop.s
deleted file mode 100644
index 17173f8..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/ucocop.s
+++ /dev/null
@@ -1,57 +0,0 @@
-*
-* $Id: ucocop.s,v 1.1.1.1 1996/02/15 17:54:05 mclareni Exp $
-*
-* $Log: ucocop.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:05 mclareni
-* Kernlib
-*
-*
-. $$$*****$$$*****$$$*****$$$*****
-.
-. SUBROUTINE UCOCOP(A,X,IDO,IW,NA,NX) *** V 302 ***
-. EXTRACTS IDO TIMES IW CONSECUTIVE WORDS FROM A, EVERY NA WORDS
-. AND PLANTS THEM INTO X, EVERY NX WORDS
-. DO NOTHING IF IW.LE.0 .OR. IDO.LE.0
-.
-. $$$*****$$$*****$$$*****$$$*****
-
- AXR$
- FORT$
-$(1)
-UCOCOP*
-#include "ftnors1.inc"
-#include "spyuse.inc"
-* Ignoring t=pass
- DL A2,2,XARG . LOC(IDO), LOC(IW)
- L R2,0,A2 . IDO
- L A3,0,A3 . IW
- DL A1,4,XARG
- TLE,U A3,1
- J RETUR6 . IF IW.LE.0
- L A4,A3
- ANU A4,0,A1 . IW-NA
- DL A0,0,XARG . LOC(A), LOC(X)
- AN A4,0,A2 . IW-NX
- LXI,U A0,1
- LXI,U A1,1
- J UCP2
-UCP1
- LR R1,A3
- BT A1,0,*A0
- AN A0,A5
- AN A1,A4
-UCP2 JGD R2,UCP1
- J RETUR6
-
-#if (defined(CERNLIB_WBACK))&&(defined(CERNLIB_GUYDIAGP))&&(defined(CERNLIB_GUYFORT))
- INFO 010 3
-$(3) + 0776003,UCOCOP
- + 0,SAVX11
- + 'UCOCOP'
-#include "gerr_c.inc"
-SAVX11 RES 1
-#endif
- END
-#ifdef CERNLIB_TCGEN_UCOCOP
-#undef CERNLIB_TCGEN_UCOCOP
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/ucopiv.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/ucopiv.s
deleted file mode 100644
index b0513dc..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/ucopiv.s
+++ /dev/null
@@ -1,71 +0,0 @@
-*
-* $Id: ucopiv.s,v 1.1.1.1 1996/02/15 17:54:05 mclareni Exp $
-*
-* $Log: ucopiv.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:05 mclareni
-* Kernlib
-*
-*
-. **************************************
-.
-. SUBROUTIN( UCOPIV( A, B, N ) *** V 301 ***
-. COPY A(1)...A(N) INTO B(N)...B(1)
-. DO NOTHING IF N=0
-. * ERROR EXIT GERR$ IF OVERLAP OR N.LT.0
-. * THE CONDITION FOR NO OVERLAP ID N-1.LE.IABS(LOC(B)-LOC(A))
-. * ( A ONE-WORD OVERLAP IS POSSIBLE)
-.
-. **************************************
-
- AXR$
- FORT$
-
-$(1),FIRS01
- + 'UCOPIV'
-UCOPIV*
-#include "ftnors1.inc"
-#include "spyuse.inc"
-* Ignoring t=pass
- L A3,2,XARG . LOC(N)
- DL A0,0,XARG . LOC(A), LOC(B)
- L A3,0,A3 . N
- ANU A1,A0 .
- JZ A3,RETUR3 . DO NOTHING IF N.EQ.0
- LMA A2,A2 . (A2)=IABS(B-A)
- SMA A3,R1
- JGD A3,$+2
-LMJER1 SLJ GERR$ . ERROR EXIT IF OVERLAP OR N.LT.0
- TLE A2,A3
- J LMJER1 . ERROR EXIT IF N-1.GT.ABS(B-A)
- A A1,A3 . LOC (B(N) )
- LXI,U A0,1
- LXI,U A1,-1
- BT A1,0,*A0
- J RETUR3
-
-#if (defined(CERNLIB_GUYDIAGP))&&(defined(CERNLIB_GUYFORT))
-. DIAGNOSTIC PACKETS FOR FORT
-#include "gerr_c.inc"
-F FORM 6,6,6,18
- INFO 010 03
-$(3)
-DIAG1 F 077,050,3,UCOPIV
- + 0,DYN$
- 'UCOPIV'
- ON GERMAX
-DIAG2 F 077,067,2,0
- + LMJER1-FIRS01,DYN$
-DIAG3 F 077,047,LDIAG3,LMJER1+1
- + LDIAG3-2,DIAG2
- 'UCOPIV( A,B,N ) ERROR: OVERLAP OR N<0'
-LDIAG3 EQU $-DIAG3
- OFF
- ON GERMAX=0
-DIAG2 F 077,062,2,LMJER1+1
- + LMJER1-FIRS01,DIAG1
- OFF
-#endif
- END
-#ifdef CERNLIB_TCGEN_UCOPIV
-#undef CERNLIB_TCGEN_UCOPIV
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/ucopyn.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/ucopyn.s
deleted file mode 100644
index 2c21b83..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/ucopyn.s
+++ /dev/null
@@ -1,80 +0,0 @@
-*
-* $Id: ucopyn.s,v 1.1.1.1 1996/02/15 17:54:05 mclareni Exp $
-*
-* $Log: ucopyn.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:05 mclareni
-* Kernlib
-*
-*
-. $$$*****$$$*****$$$*****$$$*****
-.
-. SUBROUTINE UCOPYN( A,B,N ) *** V 301 ***
-. COPY NEGATIVE
-. COPY -A(1)...-A(N) INTO B(1)...B(N)
-. ANY OVERLAP
-. * DO NOTHING IF N.LE.0
-. * SINGLE PRECISION VARIABLE
-. * VCOPYN IS ANOTHER NAME FOR THE SAME ROUTINE ADDED FOR COMPATIBILITY
-. WITH THE CERN LIBRARY
-.
-. $$$*****$$$*****$$$*****$$$*****
-
- AXR$
- FORT$
-$(1),FIRS01
- + 'UCOPYN'
-VCOPYN*
-UCOPYN*
-#include "ftnors1.inc"
-#include "spyuse.inc"
-* Ignoring t=pass
- L A2,2,XARG . LOC(N)
- DL A0,0,XARG . LOC(A), LOC(B)
- L A2,0,A2 . N
- JZ A2,RETUR3 . DO NOTHING IF N.EQ.0
- JGD A2,$+2
-LMJER1 SLJ GERR$ . ERROR EXIT IF N.LT.0
- TLE A0,A1
- J UCOPN2
- LXI,XU A0,1
- LXI,XU A1,1
-UCOPN1 LN A4,0,*A0
- S A4,0,*A1
- JGD A2,UCOPN1
- J RETUR3
-UCOPN2
- A A0,A2
- A A1,A2
- LXI,XU A0,-1
- LXI,XU A1,-1
- J UCOPN1
-
-#if (defined(CERNLIB_GUYDIAGP))&&(defined(CERNLIB_GUYFORT))
-. DIAGNOSTIC PACKETS FOR FORT
-#include "gerr_c.inc"
-F FORM 6,6,6,18
- INFO 010 03
-$(3)
-DIAG1 F 077,050,3,UCOPYN
- + 0,DYN$
- + 'UCOPYN'
- ON GERMAX
-DIAG2 F 077,067,2,0
- + LMJER1-FIRS01,DYN$
-DIAG3 F 077,047,LDIAG3,LMJER1+1
- + LDIAG3-2,DIAG2
- 'UCOPYN( A,B,N ) ERROR: N<0'
-LDIAG3 EQU $-DIAG3
- OFF
- ON GERMAX=0
-DIAG2 F 077,062,2,LMJER1+1
- + LMJER1-FIRS01,DIAG1
- OFF
-#endif
- END
-#ifdef CERNLIB_TCGEN_UCOPYN
-#undef CERNLIB_TCGEN_UCOPYN
-#endif
-#ifdef CERNLIB_TCGEN_VCOPYN
-#undef CERNLIB_TCGEN_VCOPYN
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/udicop.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/udicop.s
deleted file mode 100644
index 3518177..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/udicop.s
+++ /dev/null
@@ -1,56 +0,0 @@
-*
-* $Id: udicop.s,v 1.1.1.1 1996/02/15 17:54:05 mclareni Exp $
-*
-* $Log: udicop.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:05 mclareni
-* Kernlib
-*
-*
-. **************************************
-.
-. SUBROUTINE UDICOP( A, X, IDO, IW, NA, NX ) *** V 302 ***
-. SEE UCOCOP
-.
-. **************************************
-
- AXR$
- FORT$
-$(1)
-UDICOP*
-#include "ftnors1.inc"
-#include "spyuse.inc"
-* Ignoring t=pass
- DL A2,2,XARG . LOC(IDO), LOC(IW)
- L R2,0,A2 . IDO
- L A4,0,A3 . IW
- JGD R2,$+2
- J RETUR6 . DO NOTHING IF IDO.LE.0
- DL A2,4,XARG . LOC(NA), LOC(NX)
- S A4,R1
- DL A0,0,XARG . LOC(A), LOC(X)
- S A4,R3
- L A2,0,A2 . NA
- L A3,0,A3 . NX
- LXI,U A0,-1
- JGD R1,$+2
- J RETUR6 . DO NOTHING IF IW.LE.0
- ANU A4,A2 . (A5) = IW - NA
- LXI,U A1,-1
- A A0,R1
- AN A4,A3 . (A4) = IW - NX
- MSI A2,R2 . NA * (IDO-1)
- A A1,R1
- MSI A3,R2 . NX * (IDO-1)
- A A0,A2 . LOC( A(NA*(IDO-1)+IW) )
- A A1,A3 . LOC( X(NX*(IDO-1)+IW) )
-UDIC40 . LOOP
- L R1,R3 . (R1) = IW
- BT A1,0,*A0
- A A0,A5
- A A1,A4
- JGD R2,UDIC40
- J RETUR6
- END
-#ifdef CERNLIB_TCGEN_UDICOP
-#undef CERNLIB_TCGEN_UDICOP
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/vadd.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/vadd.s
deleted file mode 100644
index bddac2b..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/vadd.s
+++ /dev/null
@@ -1,118 +0,0 @@
-*
-* $Id: vadd.s,v 1.1.1.1 1996/02/15 17:54:06 mclareni Exp $
-*
-* $Log: vadd.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:06 mclareni
-* Kernlib
-*
-*
-. *****$$$*****$$$*****$$$*****
-.
-. SUBROUTINE VADD( A,B,X,N ) *** F121 ***
-. ADDS VECTOR B TO VECTOR A, STORES RESULT IN X
-. SUBROUTINE VSUB( A,B,X,N )
-. ADDS VECTOR -B TO VECTOR A
-. A AND B ARE SINGLE PRECISION, FLOATING POINT ARRAYS
-. SUBROUTINE IVADD( IA,IB,IX,N )
-. ADDS VECTOR IB TO VECTOR IA, STORES RESULT IN IX
-. SUBROUTINE IVSUB( IA,IB,IX,N )
-. ADDS VECTOR -IB TO VECTOR IA
-. IA AND IB ARE INTEGER ARRAYS
-.
-. * DO NOTHING IF N.EQ.0
-. * ERROR EXIT GERRB$ IF N.LT.0
-. * NO CHECK FOR OVERLAPS
-. * (THE END OF X MAY OVERLAP THE BEGINNING OF A OR B BUT NOT VICE-VERSA)
-.
-. *****$$$*****$$$*****$$$*****
-
- AXR$
- FORT$
-$(0)
-VA FA A4,0,*A1 .
-IVA A A4,0,*A1 .
-VS FAN A4,0,*A1 .
-IVS AN A4,0,*A1 .
-$(1),FIRS01
- + 'IVSUB '
-IVSUB*
- LA A5,IVS .
- J ENTRY .
- + IVADD '
-IVADD*
- LA A5,IVA .
- J ENTRY .
- + 'VSUB '
-VSUB*
- LA A5,VS .
- J ENTRY .
- + 'VADD '
-VADD*
- LA A5,VA .
-ENTRY
-#include "ftnors1.inc"
-#include "spyuse.inc"
-* Ignoring t=pass
- DL A2,2,XARG . LOC(X), LOC(N)
- DL A0,0,XARG . LOC(A), LOC(B)
- L A3,0,A3 . N
- S A5,CHG
- LXI,U A0,1
- JZ A3,RETUR4 . DO NOTHING IF N.EQ.0
- LXI,U A1,1
- JGD A3,$+2
-LMJER1 SLJ GERR$ . ERROR EXIF IF N.LT.0
- LXI,U A2,1
-VADD12 L A4,0,*A0
-CHG + $-$ . MODIFIED ACCORDING TO ENTRY POINT
- S A4,0,*A2
- JGD A3,VADD12
- J RETUR4
-
-#if (defined(CERNLIB_GUYDIAGP))&&(defined(CERNLIB_GUYFORT))
-. DIAGNOSTIC PACKETS FOR FORT
-#include "gerr_c.inc"
-F FORM 6,6,6,18
- INFO 010 03
-$(3)
- ON GERMAX
-DIAG1 F 077,050,3,IVSUB
- + 0,DYN$
- + 'IVSUB '
-DIAG11 F 077,050,3,IVADD
- + 0,DYN$
- + 'IVADD '
-DIAG21 F 077,050,3,VSUB
- + 0,DYN$
- + 'VSUB '
-DIAG31 F 077,050,3,VADD
- + 0,DYN$
- + 'VADD '
-DIAG2 F 077,067,2,0
- + LMJER1-FIRS01,DYN$
-DIAG3 F 077,047,LDIAG3,LMJER1+1
- + LDIAG3-2,DIAG2
- 'VADD,VSUB,IVADD,IVSUB( A,B,N ) ERROR: N<0'
-LDIAG3 EQU $-DIAG3
- OFF
- ON GERMAX=0
-DIAG1 F 077,050,4,VADD
- + 0,DYN$
- + 'VADD,VSUB '
-DIAG11 F 077,061,2,IVSUB
- + 0,DIAG1
-DIAG21 F 077,061,2,IVADD
- + 0,DIAG1
-DIAG31 F 077,061,2,VSUB
- + 0,DIAG1
-DIAG2 F 077,062,2,LMJER1+1
- + LMJER1-FIRS01,DIAG1
- OFF
-#endif
- END
-#ifdef CERNLIB_TCGEN_VADD
-#undef CERNLIB_TCGEN_VADD
-#endif
-#ifdef CERNLIB_TCGEN_VSUB
-#undef CERNLIB_TCGEN_VSUB
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/vasum.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/vasum.s
deleted file mode 100644
index 0652e6c..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/vasum.s
+++ /dev/null
@@ -1,63 +0,0 @@
-*
-* $Id: vasum.s,v 1.1.1.1 1996/02/15 17:54:06 mclareni Exp $
-*
-* $Log: vasum.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:06 mclareni
-* Kernlib
-*
-*
-. *************************************
-.
-. FUNCTION VASUM( A,N ) *** F 121 ***
-. Y = ABS( A(1))+ +ABS( A(N))
-. RETURNS VASUM=.0 IF N.EQ.0
-. * ERROR EXIT GERRB$ IF N.LT.0
-.
-. *************************************
-
- AXR$
- FORT$
-$(1),FIRS01
- + 'VASUM '
-VASUM*
-#include "ftnors1.inc"
-#include "spyuse.inc"
-* Ignoring t=pass
- DL A2,0,XARG . LOC(X), LOC(N)
- SZ A0
- L A4,0,A3 . N
- LXI,U A2,1
- JZ A4,RETUR2 . DO NOTHING IF N.EQ.0
- JGD A4,$+2
-LMJER1 SLJ GERR$ . ERROR EXIT IF N.LT.0
-VASM1 LMA A5,0,*A2
- FA A0,A5
- JGD A4,VASM1
- J RETUR2
-
-#if (defined(CERNLIB_GUYDIAGP))&&(defined(CERNLIB_GUYFORT))
-. DIAGNOSTIC PACKETS FOR FORT
-#include "gerr_c.inc"
-F FORM 6,6,6,18
- INFO 010 03
-$(3)
-DIAG1 F 077,050,3,VASUM
- + 0,DYN$
- + 'VASUM '
- ON GERMAX
-DIAG2 F 077,067,2,0
- + LMJER1-FIRS01,DYN$
-DIAG3 F 077,047,LDIAG3,LMJER1+1
- + LDIAG3-2,DIAG2
- 'VASUM( A,N ) ERROR: N<0'
-LDIAG3 EQU $-DIAG3
- OFF
- ON GERMAX=0
-DIAG2 F 077,062,2,LMJER1+1
- + LMJER1-FIRS01,DIAG1
- OFF
-#endif
- END
-#ifdef CERNLIB_TCGEN_VASUM
-#undef CERNLIB_TCGEN_VASUM
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/vbias.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/vbias.s
deleted file mode 100644
index 2f0d2cf..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/vbias.s
+++ /dev/null
@@ -1,69 +0,0 @@
-*
-* $Id: vbias.s,v 1.1.1.1 1996/02/15 17:54:06 mclareni Exp $
-*
-* $Log: vbias.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:06 mclareni
-* Kernlib
-*
-*
-. ************************************
-.
-. SUBROUTINE VBIAS ( A, ALPHA, X, N) *** F 121 ***
-. X(I) = A(I) +ALPHA
-. ALPHA IS A FLOATING POINT SINGLE PRECISION VARIABLE OR CONSTANT
-. A,X ARE FLOATING POINT, SINGLE PRECISION VECTORS
-. * DO NOTHING IF N.EQ.O
-. * ERROR EXIT GERRB$ IF N.LT.0
-.
-. ************************************
-
- AXR$
- FORT$
-$(1),FIRS01
- + 'VBIAS '
-VBIAS*
-#include "ftnors1.inc"
-#include "spyuse.inc"
-* Ignoring t=pass
- DL A2,2,XARG . LOC(X), LOC(N)
- DL A0,0,XARG . LOC(A), LOC(ALPHA)
- L A3,0,A3 . N
- LXI,U A2,1
- LXI,U A0,1
- JZ A3,RETUR4 . DO NOTHING IF N.EQ.0
- L A1,0,A1 . ALPHA
- JGD A3,$+2
-LMJER1 SLJ GERR$ . ERROR EXIT IF N.LT.0
-VBS10 . LOOP
- L A4,A1 . ALPHA
- FA A4,0,*A0 . ALPHA+A(I)
- S A4,0,*A2
- JGD A3,VBS10
- J RETUR4
-
-#if (defined(CERNLIB_GUYDIAGP))&&(defined(CERNLIB_GUYFORT))
-. DIAGNOSTIC PACKETS FOR FORT
-#include "gerr_c.inc"
-F FORM 6,6,6,18
- INFO 010 03
-$(3)
-DIAG1 F 077,050,3,VBIAS
- + 0,DYN$
- + 'VBIAS '
- ON GERMAX
-DIAG2 F 077,067,2,0
- + LMJER1-FIRS01,DYN$
-DIAG3 F 077,047,LDIAG3,LMJER1+1
- + LDIAG3-2,DIAG2
- 'VBIAS( A,N ) ERROR: N<0'
-LDIAG3 EQU $-DIAG3
- OFF
- ON GERMAX=0
-DIAG2 F 077,062,2,LMJER1+1
- + LMJER1-FIRS01,DIAG1
- OFF
-#endif
- END
-#ifdef CERNLIB_TCGEN_VBIAS
-#undef CERNLIB_TCGEN_VBIAS
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/vdist.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/vdist.s
deleted file mode 100644
index 33a814b..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/vdist.s
+++ /dev/null
@@ -1,104 +0,0 @@
-*
-* $Id: vdist.s,v 1.1.1.1 1996/02/15 17:54:06 mclareni Exp $
-*
-* $Log: vdist.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:06 mclareni
-* Kernlib
-*
-*
-. **************************************
-.
-. FUNCTION VDIST( X, Y, N ) *** F121 ***
-. FUNCTION VDIST2( X, Y, N )
-. VDIST2 =( X(I)-Y(I) )**2 , I=1,N
-. VDIST = SQRT( VDIST2 )
-. * ERROR EXIT IF N.LT.0
-.
-. **************************************
-
- AXR$
- FORT$
-
-SLATE INFO 2 2
-$(2),SUM RES 1
-
- ON FORE
-$(0),WBPKT + 'VDIST '
-SAVX11 + 0
- OFF
- ON FTN
-$(0),LOCARG + SUM
- OFF . FTN
-
-$(1),FIRS01
- + 'VDIST2'
-VDIST2*
- L,U R2,1
- J ENTRY
- + 'VDIST '
-VDIST*
- SZ R2
-ENTRY
-#include "ftnors1.inc"
-#include "spyuse.inc"
-* Ignoring t=pass
- L A1,2,XARG . LOC(N)
- DL A2,0,XARG . LOC(X), LOC(Y)
- L A0,0,A1 . N
- LXI,U A2,1
- JZ A0,RETUR3
- JGD A0,$+2
-LMJER1 SLJ GERR$ . ERROR EXIT IF N.LT.0
- S A0,R1
- LXI,U A3,1
- . SZ A0 . NOT NEEDED
-VDI2
- L A4,0,*A2 . X(I)
- FAN A4,0,*A3 . X(I) - Y(I)
- FM A4,A4 . (X(I)-Y(I))**2
- FA A0,A4 . SUM
- JGD R1,VDI2
- TZ R2
- J RETUR3 . RETURN IF VDIST2
- S,H2 X11,SAVX11
- S A0,SUM
- DO FTN , L,U A0,LOCARG
-LMJSQR LMJ X11,SQRT
- DO FOR , + SUM
- DO FORE , + $-FIRS01-2,WBPKT
- DO NNOP , NOP
- L X11,SAVX11
- J RETUR3
-
-. DIAGNOSTIC PACKETS FOR FORT
- ON FORT++FTN
-#include "gerr_c.inc"
-SAVX11 RES 1
- OFF . FORT++FTN
- ON FORT
- INFO 010 3
-$(3),DIAG1 + 0775003,VDIST
- + DYN$
- + 'VDIST '
- ON DIAGP
- ON GERMAX
-DIAG2 F 077,062,2,0
- + LMJER1-FIRS01,DIAG1
-F FORM 6,6,6,18
-DIAG3 F 077,047,LDIAG3,LMJER1+1
- + LDIAG3-2,DIAG2
- 'VDIST,VDIST2(X,Y,N) ERROR: N<0'
-LDIAG3 EQU $-DIAG3
- OFF
- ON GERMAX=0
-DIAG2 + 0776202,LMJER1+1
- + LMJER1-FIRS01,DIAG1
- OFF
- OFF . DIAGP
-DIAG4 + 0776202,LMJSQR+1
- + LMJSQR-FIRS01,DIAG1
- OFF . FORT
- END
-#ifdef CERNLIB_TCGEN_VDIST
-#undef CERNLIB_TCGEN_VDIST
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/vdot.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/vdot.s
deleted file mode 100644
index 66cd7e2..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/vdot.s
+++ /dev/null
@@ -1,69 +0,0 @@
-*
-* $Id: vdot.s,v 1.1.1.1 1996/02/15 17:54:06 mclareni Exp $
-*
-* $Log: vdot.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:06 mclareni
-* Kernlib
-*
-*
-. *************************************
-.
-. FUNCTION VDOT( A, B, N ) *** F 121 ***
-. Y = A.B = A(1)*B(1)+ +A(N)*B(N)
-. A AND B ARE FLOATING POINT SINGLE PRECISION VECTORS
-. RETURNS VDOT=0. IF N.EQ.0
-. * ERROR EXIT GERRB$ IF N.LT.0
-. * NO CHECK ON FLOATING-POINT UNDERFLOW AND OVERFLOW
-.
-. *************************************
-
- AXR$
- FORT$
-$(1),FIRS01
- + 'VDOT '
-VDOT*
-#include "ftnors1.inc"
-#include "spyuse.inc"
-* Ignoring t=pass
- L A1,2,XARG . LOC(N)
- DL A2,0,XARG . LOC(A), LOC(B)
- L A0,0,A1 . N
- LXI,U A2,1
- JZ A0,RETUR3 . RETURNS VDOT=0. IF N=0
- S A0,R1
- LXI,U A3,1
- . SZ A0 . NOT NEEDED
- JGD R1,$+2
-LMJER1 SLJ GERR$ . ERROR EXIT IF N.LT.0
-VDOT1 L A4,0,*A2 . A(I)
- FM A4,0,*A3 . A(I)*B(I)
- FA A0,A4
- JGD R1,VDOT1
- J RETUR3
-
-#if (defined(CERNLIB_GUYDIAGP))&&(defined(CERNLIB_GUYFORT))
-. DIAGNOSTIC PACKETS FOR FORTRAN T.
-#include "gerr_c.inc"
-F FORM 6,6,6,18
- INFO 010 03
-$(3)
-DIAG1 F 077,050,3,VDOT
- + 0,DYN$
- + 'VDOT '
- ON GERMAX
-DIAG2 F 077,067,2,0
- + LMJER1-FIRS01,DYN$
-DIAG3 F 077,047,LDIAG3,LMJER1+1
- + LDIAG3-2,DIAG2
- 'VDOT( A,N ) ERROR: N<0'
-LDIAG3 EQU $-DIAG3
- OFF . GERMAX
- ON GERMAX=0
-DIAG1 F 077,062,2,LMJER1+1
- + LMJER1-FIRS01,DIAG1
- OFF .
-#endif
- END
-#ifdef CERNLIB_TCGEN_VDOT
-#undef CERNLIB_TCGEN_VDOT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/vdotn.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/vdotn.s
deleted file mode 100644
index 9775287..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/vdotn.s
+++ /dev/null
@@ -1,205 +0,0 @@
-*
-* $Id: vdotn.s,v 1.1.1.1 1996/02/15 17:54:06 mclareni Exp $
-*
-* $Log: vdotn.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:06 mclareni
-* Kernlib
-*
-*
-. *************************************
-. FUNCTION VDOTN( A, B, N ) *** F 121 ***
-. 'COSINE' OF THE N-VECTORS A AND B
-. VDOTN = VDOT(A,B,N) / VMOD(A,N)*VMOD(B,N)
-. RETURNS VDOTN=0. IF VMOD(A,N)*VMOD(B,N)=0
-. * ERROR EXIT IF N.LE.0 (==>VDOTN=0.)
-.
-. *************************************
-
- AXR$
- FORT$
-
- ON FORE
-$(0)
-VDTA 'VDOTN ' . WALK-BACK PACKET
-SAVX11 + 0
- OFF . FORE
- ON FORT++FTN
-#include "gerr_c.inc"
-SAVX11 RES 1
- OFF . FORT++FTN
-
-SLATE INFO 2 2
-$(2),VDTB RES 1
- DO FTN , RES 2
-
- ON FTN
-$(0),LOCARG + VDTB
- OFF . FTN
-$(1),FIRS01
- + 'VDOTN '
-VDOTN*
-#include "ftnors1.inc"
-#include "spyuse.inc"
-* Ignoring t=pass
- L A1,2,XARG . LOC(N)
- DL A2,0,XARG . LOC(A), LOC(B)
- DO FOR , SZ A0 . (FTN: H1(A0)=0)
- L R1,0,A1 . N
- S,H2 X11,SAVX11
- JGD R1,$+2 . N-1
-LMJER1 SLJ GERR$ . ERROR EXIT IF N.LE.0
- DO FTN , DS A2,VDTB+1
- S R1,R2
- LMJ X11,VMOD1 . A**2
- S A0,R3 .
- L R1,R2
- L A2,A3
- LMJ X11,VMOD1 . B**2
- FM A0,R3 . A**2 * B**2
- S A0,VDTB
- ON FORE++FORT**OPTR
-LMJSQ1 LMJ X11,SQRT
- + VDTB
- DO FORE , + $-FIRS01-2,VDTA
- DO NNOP , NOP
- OFF . FORE++FORT**OPTR
- ON FORT**(-OPTR)
- L,U A0,VDTB
- LXI,U X11,RMATH$
-LMJSQ1 LIJ X11,SQRT$
- OFF . FORT**(-OPTR)
- ON FTN
- L,U A0,LOCARG
-LMJSQ1 LMJ X11,SQRT
- OFF . FTN
- L X11,SAVX11
- JZ A0,RETUR3 . (THE RESULT OF SQRT IS NORMALIZED)
- DO FOR , DL A2,0,XARG . LOC(A), LOC(B)
- DO FTN , DL A2,VDTB+1
- S A0,R3
- SZ A0
- LXI,U A2,1
- LXI,U A3,1
-VDT2 L A4,0,*A2 . A(I)*B(I)
- FM A4,0,*A3
- FA A0,A4
- JGD R2,VDT2
- FD A0,R3
- J RETUR3
-/
-. $$$*****$$$*****$$$*****$$$*****
-. FUNCTION VMOD(A,N) *** F 121 ***
-. VMOD = SQRT( A(1)**2+...+A(N)**2 )
-. RETURNS VMOD=0. IF N.EQ.0
-. * ERROR EXIT GERRB$ IF N.LT.0
-. $$$*****$$$*****$$$*****$$$*****
-.
-
- ON FORE
-$(0)
-VMDA 'VMOD' . WALK BACK PACKET
- +0
- OFF
-$(1)
- + 'VMOD '
-VMOD*
-#include "ftnors1.inc"
-#include "spyuse.inc"
-* Ignoring t=pass
- DL A2,0,XARG . LOC(A), LOC(N)
- DO FORE , S,H2 X11,VMDA+1
- DO FORT++FTN , S,H2 X11,SAVX11
- L A0,0,A3 . N
- JZ A0,RETUR2 . RETURNS VMOD=0. IF N=0
- JGD A0,$+2 . N-1
-LMJER2 SLJ GERR$ . ERROR EXIT IF N.LT.0
- S A0,R1
- LMJ X11,VMOD1 . A**2
- S A0,VDTB
- ON FORE++FORT**OPTR
-LMJSQ2 LMJ X11,SQRT
- + VDTB
- DO FORE , + $-FIRS01-2,VMDA
- DO NNOP , NOP
- OFF . FORE++FORT**OPTR
- ON FORT**(-OPTR)
- L,U A0,VDTB
- LXI,U X11,RMATH$
-LMJSQ2 LIJ X11,SQRT$
- OFF . FORT**(-OPTR)
- ON FTN
- L,U A0,LOCARG
-LMJSQ2 LMJ X11,SQRT
- OFF . FTN
- DO FORE , L X11,VMDA+1
- DO FORT++FTN , L X11,SAVX11
- J RETUR2
-
-VMOD1
- LXI,U A2,1
- SZ A0
-VMOD2 LMA A4,0,*A2
- FM A4,A4
- FA A0,A4
- JGD R1,VMOD2
- J 0,X11
-
-. DIAGNOSTIC PACKETS FOR FORT
- ON FORT
-F FORM 6,6,6,18
- INFO 010 03
-$(3)
-DIAG1 F 077,050,3,VDOTN
- + 0,DYN$
- + 'VDOTN '
-DIAG11 F 077,050,3,VMOD
- + 0,DYN$
- + 'VMOD '
- ON GERMAX
-DIAG2 F 077,067,2,0
- + LMJER1-FIRS01,DYN$
-DIAG3 F 077,047,LDIAG3,LMJER1+1
- + LDIAG3-2,DIAG2
- 'VDOTN( A,B,N ) ERROR: N.LE.0'
-LDIAG3 EQU $-DIAG3
-DIAG12 F 077,067,2,0
- + LMJER2-FIRS01,DYN$
-DIAG13 F 077,047,LDIAG13,LMJER2+1
- + LDIAG13-2,DIAG12
- 'VMOD( A,N ) ERROR: N<0'
-LDIAG13 EQU $-DIAG13
- ON OPTR
-DIAG14 F 077,067,2,LMJSQ1
- + LMJSQ1-FIRS01,DYN$
-DIAG24 F 077,067,2,LMJSQ2
- + LMJSQ2-FIRS01,DYN$
- OFF . OPTR
- ON OPTR=0
-DIAG14 + 0777302,LMJSQ1+1
- + LMJSQ1-FIRS01,DIAG1
-DIAG24 + 0777302,LMJSQ2+1
- + LMJSQ2-FIRS01,DIAG11
- OFF . OPTR=0
- OFF
- ON GERMAX=0
- ON DIAGP
-DIAG2 F 077,062,2,LMJER1+1
- + LMJER1-FIRS01,DIAG1
-DIAG12 F 077,062,2,LMJER2+1
- + LMJER2-FIRS01,DIAG11
- OFF . DIAGP
- DO OPTR ,DIAG14 + 0776202,LMJSQ1+1
- DO OPTR=0 ,DIAG14 + 0777302,LMJSQ1+1
- + LMJSQ1-FIRS01,DIAG1
- DO OPTR ,DIAG24 + 0776202,LMJSQ2+1
- DO OPTR=0 ,DIAG24 + 0777302,LMJSQ2+1
- + LMJSQ2-FIRS01,DIAG11
- OFF
- OFF
- END
-#ifdef CERNLIB_TCGEN_VDOTN
-#undef CERNLIB_TCGEN_VDOTN
-#endif
-#ifdef CERNLIB_TCGEN_VMOD
-#undef CERNLIB_TCGEN_VMOD
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/vdotn2.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/vdotn2.s
deleted file mode 100644
index 3177406..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/vdotn2.s
+++ /dev/null
@@ -1,88 +0,0 @@
-*
-* $Id: vdotn2.s,v 1.1.1.1 1996/02/15 17:54:06 mclareni Exp $
-*
-* $Log: vdotn2.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:06 mclareni
-* Kernlib
-*
-*
-. *************************************
-.
-. FUNCTION VDOTN2( A,B,N ) *** F 121 ***
-. VDOTN2 = VDOTN( A,B,N) **2 = ( VDOT(A,B,N)/VMOD(A,N)*VMOD(B,N) )**2
-. * ERROR EXIT IF N.LE.0 (==>VDOTN2=0.)
-.
-. *************************************
-
- AXR$
- FORT$
-$(1),FIRS01
- + 'VDOTN2'
-VDOTN2*
-#include "ftnors1.inc"
-#include "spyuse.inc"
-* Ignoring t=pass
- DL A2,0,XARG . LOC(A), LOC(B)
- L A0,2,XARG . LOC( N )
- L R1,0,A0 . N
- S X11,R3
- JGD R1,$+2
-LMJER1 SLJ GERR$ . ERROR EXIT IF N.LE.0
- LXI,U A2,1
- LXI,U A3,1
- DS A2,A15+1
- S R1,R2
- LMJ X11,VMD1
- L A2,A3
- L R1,R2
- S A0,A3
- LMJ X11,VMD1
- FM A0,A3
- L X11,R3
- JZ A0,RETUR3
- DL A2,A15+1
- S A0,R1
- SZ A0
-VDT20
- L A4,0,*A2
- FM A4,0,*A3
- FA A0,A4
- JGD R2,VDT20
- FM A0,A0 . VOT**2
- FD A0,R1
- J RETUR3
-VMD1 . X**2
- SZ A0
-VMD2
- LMA A4,0,*A2
- FM A4,A4
- FA A0,A4
- JGD R1,VMD2
- J 0,X11
-
-#if (defined(CERNLIB_GUYDIAGP))&&(defined(CERNLIB_GUYFORT))
-. DIAGNOSTIC PACKETS
-#include "gerr_c.inc"
-F FORM 6,6,6,18
- INFO 010 3
-$(3)
-DIAG1 + 0775003,VDOTN2
- + 0,DYN$
- + 'VDOTN2'
- ON GERMAX
-DIAG2 + 0776702,0
- + LMJER1-FIRS01,DYN$
-DIAG3 F 077,047,LDIAG3,LMJER1+1
- + LDIAG3-2,DIAG2
- 'VDOTN2( A,B,N ) ERROR: N.LE.0'
-LDIAG3 EQU $-DIAG3
- OFF
- ON GERMAX=0
-DIAG2 + 0776202,LMJER1+1
- + LMJER1-FIRS01,DIAG1
- OFF
-#endif
- END
-#ifdef CERNLIB_TCGEN_VDOTN2
-#undef CERNLIB_TCGEN_VDOTN2
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/vfix.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/vfix.s
deleted file mode 100644
index ecfa21d..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/vfix.s
+++ /dev/null
@@ -1,100 +0,0 @@
-*
-* $Id: vfix.s,v 1.1.1.1 1996/02/15 17:54:06 mclareni Exp $
-*
-* $Log: vfix.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:06 mclareni
-* Kernlib
-*
-*
-. $$$*****$$$*****$$$*****$$$*****
-.
-. SUBROUTINE VFIX( V,IV,N ) *** F 121 ***
-. DO NOTHING IF N.EQ.0
-. DO 1 I=1,N
-. 1 IV(I) = V(I)
-. * ERROR EXIT GERRB$ IF N.LT.0
-. * IF( ABS(V(I)).LT.1. ) IV(I)=0
-. * IF( ABS(V(I)).GE.2**35 ) IV(I)=SIGN(1.,V(I))*(2**35-1)
-. * WORKS IF V AND IV ARE OVERLAPPING ARRAYS
-. * DOESN'T CARE FOR UNNORMALISED VALUES (SEE FLAGGED CARDS)
-. * SINGLE PRECISION VARIABLES
-.
-. $$$*****$$$*****$$$*****$$$*****
-.
- AXR$
- FORT$
-$(0)
-. UNNORM + 0233000,0
-LARGST + 0377777,-0 . LARGEST POSITIVE INTEGER
-
-$(1),FIRS01
- + 'VFIX '
-VFIX*
-#include "ftnors1.inc"
-#include "spyuse.inc"
-* Ignoring t=pass
- L A2,2,XARG . LOC(N)
- DL A0,0,XARG . LOC(V), LOC(IV)
- L A2,0,A2 . N
-. L R2,UNNORM
- JZ A2,RETUR3 . DO NOTHING IF N.EQ.0
- JGD A2,$+2
-LMJER1 SLJ GERR$ . ERROR EXIT IF N.LT.0
- TLE A0,A1 . ADJUST SCANNING DIRECTION
- J VFI6 . ACCORDING TO RELATIVE POSITIONS VANDIV
- LXI,U A0,1
- LXI,U A1,1
-VFI1 . LOOP ENTRY
-. L A4,0,*A0
-. FA A4,R2
-. LUF A4,A4
- LUF A4,0,*A0
- TG,U A4,0244
- J LARGE . ABS(V(I)).GE.2**35
- TLE,U A4,0201
- L,U A5,0
- LN A3,A4
- LSSC A5,8
- SSA A5,0243,A3
- S A5,0,*A1
-VFI2 JGD A2,VFI1
- J RETUR3
-LARGE
- L A4,LARGST
- TP A5
- LN A4,A4
- S A4,0,*A1
- J VFI2
-VFI6
- A A0,A2
- A A1,A2
- LXI,XU A0,-1
- LXI,XU A1,-1
- J VFI1
-
-#if (defined(CERNLIB_GUYDIAGP))&&(defined(CERNLIB_GUYFORT))
-. DIAGNOSTIC PACKETS FOR FORT
-#include "gerr_c.inc"
-F FORM 6,6,6,18
- INFO 010 03
-$(3)
-DIAG1 F 077,050,3,VFIX
- + 0,DYN$
- + 'VFIX '
- ON GERMAX
-DIAG2 F 077,067,2,0
- + LMJER1-FIRS01,DYN$
-DIAG3 F 077,047,LDIAG3,LMJER1+1
- + LDIAG3-2,DIAG2
- 'VFIX( V,IV,N ) ERROR: N<0'
-LDIAG3 EQU $-DIAG3
- OFF
- ON GERMAX=0
-DIAG2 F 077,062,2,LMJER1+1
- + LMJER1-FIRS01,DIAG1
- OFF
-#endif
- END
-#ifdef CERNLIB_TCGEN_VFIX
-#undef CERNLIB_TCGEN_VFIX
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/vfloat.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/vfloat.s
deleted file mode 100644
index 64db195..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/vfloat.s
+++ /dev/null
@@ -1,76 +0,0 @@
-*
-* $Id: vfloat.s,v 1.1.1.1 1996/02/15 17:54:06 mclareni Exp $
-*
-* $Log: vfloat.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:06 mclareni
-* Kernlib
-*
-*
-. $$$*****$$$*****$$$*****$$$*****
-.
-. SUBROUTINE VFLOAT( IV,V,N ) *** F 121 ***
-. IF N.LE.0 DO NOTHING
-. DO 1 I=1,N
-. 1 V(I) = IV(I)
-. DO NOTHING IF N=0
-. * ERROR EXIT GERRB$ IF N.LT.0
-. WORKS WITH OVERLAPPING ARRAYS
-.
-. $$$*****$$$*****$$$*****$$$*****
-.
- AXR$
- FORT$
-$(1),FIRS01
- + 'VFLOAT'
-VFLOAT*
-#include "ftnors1.inc"
-#include "spyuse.inc"
-* Ignoring t=pass
- L A2,2,XARG . LOC(N)
- DL A0,0,XARG . LOC(IV), LOC(V)
- L A2,0,A2 . N
- L,U A4,0233
- JZ A2,RETUR3 . DO NOTHING IF N.EQ.0
- JGD A2,$+2 . N-1
-LMJER1 SLJ GERR$ . ERROR EXIT IF N.LT.0
- TLE A0,A1
- J VFL2
- LXI,U A0,1 .
- LXI,U A1,1 .
-LOOP LCF A4,0,*A0 .
- SA A5,0,*A1 .
- JGD A2,LOOP .
- J RETUR3
-VFL2
- A A0,A2 . LOC (IV(N))
- A A1,A2 . LOC (IV(N))
- LXI,XU A0,-1
- LXI,XU A1,-1
- J LOOP
-
-#if (defined(CERNLIB_GUYDIAGP))&&(defined(CERNLIB_GUYFORT))
-. DIAGNOSTIC PACKETS FOR FORT
-#include "gerr_c.inc"
-F FORM 6,6,6,18
- INFO 010 03
-$(3)
-DIAG1 F 077,050,3,VFLOAT
- + 0,DYN$
- + 'VFLOAT'
- ON GERMAX
-DIAG2 F 077,067,2,0
- + LMJER1-FIRS01,DYN$
-DIAG3 F 077,047,LDIAG3,LMJER1+1
- + LDIAG3-2,DIAG2
- 'VFLOAT( IV,V,N ) ERROR: N<0'
-LDIAG3 EQU $-DIAG3
- OFF
- ON GERMAX=0
-DIAG2 F 077,062,2,LMJER1+1
- + LMJER1-FIRS01,DIAG1
- OFF
-#endif
- END
-#ifdef CERNLIB_TCGEN_VFLOAT
-#undef CERNLIB_TCGEN_VFLOAT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/vline.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/vline.s
deleted file mode 100644
index fb71f17..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/vline.s
+++ /dev/null
@@ -1,106 +0,0 @@
-*
-* $Id: vline.s,v 1.1.1.1 1996/02/15 17:54:06 mclareni Exp $
-*
-* $Log: vline.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:06 mclareni
-* Kernlib
-*
-*
-. *************************************
-.
-. SUBROUTINE VLINE( A, ALPHA, B, BETA, X, N )*** F 121 ***
-. X(I) = ALPHA*A(I) + BETA*B(I) I = 1, N
-. A,ALPHA,B,BETA,X ARE FLOATING-POINT
-. SINGLE PRECISION VARIABLES AND CONSTANTS OR ARRAYS
-. DO NOTHING IF N.EQ.0
-. * ERROR EXIT GERRB$ IF N.LT.0
-. * NO CHECK IS DONE TO DETECT OVERLAPPING ARRAYS
-.
-. *************************************
-
- AXR$
- FORT$
-$(1),FIRS01
- + 'VLINE '
-VLINE*
-#include "spyuse.inc"
-* Ignoring t=pass
-#if defined(CERNLIB_GUYFORE)||defined(CERNLIB_GUYFORT)
-#include "ftnors1.inc"
- DL A0,0,X11 . LOC(A), LOC(ALPHA)
- L R1,0,A1 . ALPHA
- DL A1,2,X11 . LOC(B), LOC(BETA)
- L R2,0,A2 . BETA
- DL A2,4,X11 . LOC(X), LOC(N)
- LXI,U A0,1
- L A3,0,A3 . N
- LXI,U A1,1
- LXI,U A2,1
- JZ A3,RETUR6 . DO NOTHING IF N=0
- JGD A3,$+2
-LMJER1 SLJ GERR$ . ERROR EXIT IF N.LT.0
- DS A6,A15+1 . SAVE A6, A7
-VLIN20
- L A4,0,*A0
- L A6,0,*A1
- FM A4,R1
- FM A6,R2
- FA A4,A6
- S A4,0,*A2
- JGD A3,VLIN20
- DL A6,A15+1
-#endif
-#if defined(CERNLIB_GUYFTN)
- DL A2,0,A0 . LOC(A), LOC(ALPHA)
- L R1,0,A3 . ALPHA
- L A3,A2
- DL A1,2,A0 . LOC(B), LOC(BETA)
- L R2,0,A2 . BETA
- L A2,A1
- DL A0,4,A0 . LOC(X), LOC(N)
- LXI,U A3,1
- L A1,0,A1 . N
- LXI,U A2,1
- LXI,U A0,1
- JZ A1,RETUR6 . DO NOTHING IF N=0
- JGD A1,$+2
-LMJER1 SLJ GERR$ . ERROR EXIT IF N<0
- DS A6,A15+1
-VLIN20
- L A4,0,*A3
- L A6,0,*A2
- FM A4,R1
- FM A6,R2
- FA A4,A6
- S A4,0,*A0
- JGD A1,VLIN20
- DL A6,A15+1
-#endif
- J RETUR6
-
-#if (defined(CERNLIB_GUYDIAGP))&&(defined(CERNLIB_GUYFORT))
-. DIAGNOSTIC PACKETS FOR FORT
-#include "gerr_c.inc"
-F FORM 6,6,6,18
- INFO 010 03
-$(3)
-DIAG1 F 077,050,3,VLINE
- + 0,DYN$
- + 'VLINE '
- ON GERMAX
-DIAG2 F 077,067,2,0
- + LMJER1-FIRS01,DYN$
-DIAG3 F 077,047,LDIAG3,LMJER1+1
- + LDIAG3-2,DIAG2
- 'VLINE( ,,,,,N ) ERROR: N<0'
-LDIAG3 EQU $-DIAG3
- OFF
- ON GERMAX=0
-DIAG2 F 077,062,2,LMJER1+1
- + LMJER1-FIRS01,DIAG1
- OFF
-#endif
- END
-#ifdef CERNLIB_TCGEN_VLINE
-#undef CERNLIB_TCGEN_VLINE
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/vmatl.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/vmatl.s
deleted file mode 100644
index 8514840..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/vmatl.s
+++ /dev/null
@@ -1,82 +0,0 @@
-*
-* $Id: vmatl.s,v 1.1.1.1 1996/02/15 17:54:06 mclareni Exp $
-*
-* $Log: vmatl.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:06 mclareni
-* Kernlib
-*
-*
-. *************************************
-.
-. SUBROUTINE VMATL( G, C, X, N, NJ ) *** F 121 ***
-. X = G * C MATRIX * VECTOR PRODUCT
-. G IS A N*NJ - MATRIX (N ROWS, NJ COLUMNS )
-. C IS A NJ - VECTOR
-. X IS A N - VECTOR
-. N IS THE NUMBER OF ROWS FOR MATRIX G
-. NJ IS THE NUMBER OF COLUMNS FOR MATRIX G
-. MATRIX STORED USING CERN CONVENTION: GIJ STORED IN G(J,I)
-. * ERROR EXIT IF N.LE.0 .OR. NJ.LE.0
-.
-. *************************************
-
- AXR$
- FORT$
-$(1),FIRS01
- + 'VMATL '
-VMATL*
-#include "ftnors1.inc"
-#include "spyuse.inc"
-* Ignoring t=pass
- DL A2,3,XARG . LOC(N), LOC(NJ)
- L R1,0,A2 . N
- L R3,0,A3 . NJ
- DL A1,1,XARG . LOC(C), LOC(X)
- L A0,0,XARG . LOC(G)
- JGD R1,$+2
- J $+2 . ERROR EXIT IF N.LE.0
- JGD R3,$+2
-LMJER1 SLJ GERR$ . ERROR EXIT IF NJ.LE.0
- LXI,U A2,1
- LXI,U A1,1
- LXI,U A0,1
- S A1,A15+1
-VMAL20
- L A1,A15+1 . LOC(C(1))
- L R2,R3
- SZ A3
-VMAL24
- L A4,0,*A0
- FM A4,0,*A1
- FA A3,A4
- JGD R2,VMAL24
- S A3,0,*A2
- JGD R1,VMAL20
- J RETUR5
-
-#if (defined(CERNLIB_GUYDIAGP))&&(defined(CERNLIB_GUYFORT))
-. DIAGNOSTIC PACKETS FOR FORT
-#include "gerr_c.inc"
-F FORM 6,6,6,18
- INFO 010 03
-$(3)
-DIAG1 F 077,050,3,VMATL
- + 0,DYN$
- + 'VMATL '
- ON GERMAX
-DIAG2 F 077,067,2,0
- + LMJER1-FIRS01,DYN$
-DIAG3 F 077,047,LDIAG3,LMJER1+1
- + LDIAG3-2,DIAG2
- 'VMATL:CHECK MATRIX DIMENSIONS'
-LDIAG3 EQU $-DIAG3
- OFF
- ON GERMAX=0
-DIAG2 F 077,062,2,LMJER1+1
- + LMJER1-FIRS01,DIAG1
- OFF
-#endif
- END
-#ifdef CERNLIB_TCGEN_VMATL
-#undef CERNLIB_TCGEN_VMATL
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/vmatr.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/vmatr.s
deleted file mode 100644
index 3dbcb03..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/vmatr.s
+++ /dev/null
@@ -1,90 +0,0 @@
-*
-* $Id: vmatr.s,v 1.1.1.1 1996/02/15 17:54:06 mclareni Exp $
-*
-* $Log: vmatr.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:06 mclareni
-* Kernlib
-*
-*
-. *************************************
-.
-. SUBROUTINE VMATR( A, G, V, N, NJ ) *** F 121 ***
-. V = A * G VECTOR * MATRIX PRODUCT
-. A IS A N - VECTOR
-. G IS A N*NJ - MATRIX (N ROWS, NJ COLUMNS )
-. V IS A NJ - VECTOR
-. N NUMBER OF ROWS OF MATRIX G
-. NJ NUMBER OF COLUMNS OF MATRIX G
-. MATRIX STORED USING CERN CONVENTION: GIJ STORED IN G(J,I)
-. * ERROR EXIT IF N.LE.0 .OR. NJ.LE.0
-.
-. *************************************
-
- AXR$
- FORT$
-VRTEMP EQU A15+2
-
-$(1),FIRS01
- + 'VMATR '
-VMATR*
-#include "ftnors1.inc"
-#include "spyuse.inc"
-* Ignoring t=pass
- DL A2,3,XARG . LOC(N), LOC(NJ)
- L A5,0,A2 . N
- L R3,0,A3 . NJ
- DL A1,1,XARG . LOC(G), LOC(V)
- S A5,R2
- L A0,0,XARG
- MSI A5,R3 . N*NJ
- LXI,U A2,1
- LXI A1,R3
- LXI,U A0,1
- JGD R2,$+2
- J LMJER1 . ERROR EXIT IF N.LE.0
- S A6,VRTEMP
- JGD R3,$+2
-LMJER1 SLJ GERR$ . ERROR EXIT IF NJ.LE.0
- S A0,A15+1
- ANU,U A5,1 . N*NJ-1
-VMAR20
- L A0,A15+1 . LOC( A(1) )
- L R1,R2 . N-1
- SZ A3
-VMAR24
- L A4,0,*A1 . G
- FM A4,0,*A0 . G*A
- FA A3,A4
- JGD R1,VMAR24
- S A3,0,*A2 . V
- AN A1,A6
- JGD R3,VMAR20
- L A6,VRTEMP
- J RETUR5
-
-#if (defined(CERNLIB_GUYDIAGP))&&(defined(CERNLIB_GUYFORT))
-. DIAGNOSTIC PACKETS FOR FORT
-#include "gerr_c.inc"
-F FORM 6,6,6,18
- INFO 010 03
-$(3)
-DIAG1 F 077,050,3,VMATR
- + 0,DYN$
- + 'VMATR '
- ON GERMAX
-DIAG2 F 077,067,2,0
- + LMJER1-FIRS01,DYN$
-DIAG3 F 077,047,LDIAG3,LMJER1+1
- + LDIAG3-2,DIAG2
- 'VMATR:CHECK MATRIX DIMENSIONS'
-LDIAG3 EQU $-DIAG3
- OFF
- ON GERMAX=0
-DIAG2 F 077,062,2,LMJER1+1
- + LMJER1-FIRS01,DIAG1
- OFF
-#endif
- END
-#ifdef CERNLIB_TCGEN_VMATR
-#undef CERNLIB_TCGEN_VMATR
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/vmax.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/vmax.s
deleted file mode 100644
index 1cda4e3..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/vmax.s
+++ /dev/null
@@ -1,64 +0,0 @@
-*
-* $Id: vmax.s,v 1.1.1.1 1996/02/15 17:54:06 mclareni Exp $
-*
-* $Log: vmax.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:06 mclareni
-* Kernlib
-*
-*
-. *************************************
-.
-. FUNCTION VMAX( A,N ) *** F 121 ***
-. FUNCTION IVMAX( IA,N)
-. Y = AMAX1( A(1), A(N))
-. OR IY = MAX0( IA(1), IA(N) )
-. * ERROR EXIT IF N.LE.0 (==>VMAX=0.)
-. * ALL VALUES IN ARRAY A ARE SUPPOSED TO BE NORMALIZED
-.
-. *************************************
-
- AXR$
- FORT$
-$(1),FIRS01
- + 'VMAX '
-IVMAX*
-VMAX*
-#include "ftnors1.inc"
-#include "spyuse.inc"
-* Ignoring t=pass
- DL A2,0,XARG . LOC(A), LOC(N)
- DO FOR , SZ A0 . (FTN: H1(A0)=0)
- L R1,0,A3 . N
- LXI,U A2,1
- JGD R1,$+2 . N-1
-LMJER1 SLJ GERR$ . ERROR EXIT IF N.LE.0
-VMX1 L A0,0,A2 . LOOP
- SG A0,1,*A2
- J RETUR2
- J VMX1
-#if (defined(CERNLIB_GUYDIAGP))&&(defined(CERNLIB_GUYFORT))
-. DIAGNOSTIC PACKETS FOR FORT
-#include "gerr_c.inc"
-F FORM 6,6,6,18
- INFO 010 03
-$(3)
-DIAG1 F 077,050,3,VMAX
- + 0,DYN$
- + 'VMAX '
- ON GERMAX
-DIAG2 F 077,067,2,0
- + LMJER1-FIRS01,DYN$
-DIAG3 F 077,047,LDIAG3,LMJER1+1
- + LDIAG3-2,DIAG2
- 'VMAX( A,N ) ERROR: N.LE.0'
-LDIAG3 EQU $-DIAG3
- OFF
- ON GERMAX=0
-DIAG2 F 077,062,2,LMJER1+1
- + LMJER1-FIRS01,DIAG1
- OFF
-#endif
- END
-#ifdef CERNLIB_TCGEN_VMAX
-#undef CERNLIB_TCGEN_VMAX
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/vmaxa.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/vmaxa.s
deleted file mode 100644
index d253698..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/vmaxa.s
+++ /dev/null
@@ -1,65 +0,0 @@
-*
-* $Id: vmaxa.s,v 1.1.1.1 1996/02/15 17:54:06 mclareni Exp $
-*
-* $Log: vmaxa.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:06 mclareni
-* Kernlib
-*
-*
-. *************************************
-.
-. FUNCTION VMAXA( A,N ) *** F 121 ***
-. FUNCTION IVMAXA( IA,N )
-. Y = AMAX1( ABS(A(1)), ABS(A(N)) )
-. OR IY = MAX0( ABS(IA(1)), ABS(IA(N)) )
-. * ERROR EXIT IF N.LE.0 (==>VMAXA=0.)
-.
-. *************************************
-
- AXR$
- FORT$
-$(1),FIRS01
- + 'VMAXA '
-VMAXA*
-#include "ftnors1.inc"
-#include "spyuse.inc"
-* Ignoring t=pass
- DL A2,0,XARG . LOC(A), LOC(N)
- L A3,0,A3 . N
- SZ A0
- JGD A3,$+2
-LMJER1 SLJ GERR$ . ERROR EXIT IF N.LE.0
- LXI,U A2,1
-VMAX10
- LMA A4,0,*A2
- TLE A0,A4
- L A0,A4
- JGD A3,VMAX10
- J RETUR2
-
-#if (defined(CERNLIB_GUYDIAGP))&&(defined(CERNLIB_GUYFORT))
-. DIAGNOSTIC PACKETS FOR FORT
-#include "gerr_c.inc"
-F FORM 6,6,6,18
- INFO 010 03
-$(3)
-DIAG1 F 077,050,3,VMAXA
- + 0,DYN$
- + 'VMAXA '
- ON GERMAX
-DIAG2 F 077,067,2,0
- + LMJER1-FIRS01,DYN$
-DIAG3 F 077,047,LDIAG3,LMJER1+1
- + LDIAG3-2,DIAG2
- 'VMAXA( A,N ) ERROR: N.LE.0'
-LDIAG3 EQU $-DIAG3
- OFF
- ON GERMAX=0
-DIAG2 F 077,062,2,LMJER1+1
- + LMJER1-FIRS01,DIAG1
- OFF
-#endif
- END
-#ifdef CERNLIB_TCGEN_VMAXA
-#undef CERNLIB_TCGEN_VMAXA
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/vmin.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/vmin.s
deleted file mode 100644
index 7e23bb1..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/vmin.s
+++ /dev/null
@@ -1,63 +0,0 @@
-*
-* $Id: vmin.s,v 1.1.1.1 1996/02/15 17:54:06 mclareni Exp $
-*
-* $Log: vmin.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:06 mclareni
-* Kernlib
-*
-*
-. *************************************
-.
-. FUNCTION VMIN( A,N ) *** F 121 ***
-. FUNCTION IVMIN( IA,N )
-. Y = AMIN1( A(1), A(N) )
-. OR IY = MIN0( IA(1), IA(N) )
-. * ERROR EXIT IF N.LE.0 (==>VMIN=0.)
-.
-. *************************************
-
- AXR$
- FORT$
-$(1),FIRS01
- + 'VMIN '
-VMIN*
-#include "ftnors1.inc"
-#include "spyuse.inc"
-* Ignoring t=pass
- DL A2,0,XARG . LOC(A), LOC(N)
- DO FOR , SZ A0 . (FTN: H1(A0)=0)
- L R1,0,A3 . N
- LXI,U A2,1
- JGD R1,$+2
-LMJER1 SLJ GERR$ . ERROR IXIT IF N.LE.0
-VMN1 L A0,0,A2
- SLE A0,1,*A2
- J RETUR2
- J VMN1
-
-#if (defined(CERNLIB_GUYDIAGP))&&(defined(CERNLIB_GUYFORT))
-. DIAGNOSTIC PACKETS FOR FORT
-#include "gerr_c.inc"
-F FORM 6,6,6,18
- INFO 010 03
-$(3)
-DIAG1 F 077,050,3,VMIN
- + 0,DYN$
- + 'VMIN '
- ON GERMAX
-DIAG2 F 077,067,2,0
- + LMJER1-FIRS01,DYN$
-DIAG3 F 077,047,LDIAG3,LMJER1+1
- + LDIAG3-2,DIAG2
- 'VMIN( A,N ) ERROR: N.LE.0'
-LDIAG3 EQU $-DIAG3
- OFF
- ON GERMAX=0
-DIAG2 F 077,062,2,LMJER1+1
- + LMJER1-FIRS01,DIAG1
- OFF
-#endif
- END
-#ifdef CERNLIB_TCGEN_VMIN
-#undef CERNLIB_TCGEN_VMIN
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/vmina.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/vmina.s
deleted file mode 100644
index 6bdae62..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/vmina.s
+++ /dev/null
@@ -1,66 +0,0 @@
-*
-* $Id: vmina.s,v 1.1.1.1 1996/02/15 17:54:06 mclareni Exp $
-*
-* $Log: vmina.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:06 mclareni
-* Kernlib
-*
-*
-. *************************************
-.
-. FUNCTION VMINA( A,N ) *** F 121 ***
-. FUNCTION IVMINA( IA,N )
-. Y = AMIN1( ABS(A(1)), ABS(A(N)) )
-. OR IY = MINO( ABS(IA(1)), ABS(IA(N)) )
-. * ERROR EXIT IF N.LE.0 (==>VMINA=0.)
-.
-. *************************************
-
- AXR$
- FORT$
-$(1),FIRS01
- + 'VMINA '
-VMINA*
-#include "ftnors1.inc"
-#include "spyuse.inc"
-* Ignoring t=pass
- DL A2,0,XARG . LOC(A), LOC(N)
- DO FOR , SZ A0 . (FTN: H1(A0)=0)
- L A3,0,A3 . N
- LXI,U A2,1
- JGD A3,$+2
-LMJER1 SLJ GERR$ . ERROR EXIT IF N.LE.0
- LMA A0,0,A2
-VMIN10
- LMA A4,0,*A2
- TLE A4,A0
- L A0,A4
- JGD A3,VMIN10
- J RETUR2
-
-#if (defined(CERNLIB_GUYDIAGP))&&(defined(CERNLIB_GUYFORT))
-. DIAGNOSTIC PACKETS FOR FORT
-#include "gerr_c.inc"
-F FORM 6,6,6,18
- INFO 010 03
-$(3)
-DIAG1 F 077,050,3,VMINA
- + 0,DYN$
- + 'VMINA '
- ON GERMAX
-DIAG2 F 077,067,2,0
- + LMJER1-FIRS01,DYN$
-DIAG3 F 077,047,LDIAG3,LMJER1+1
- + LDIAG3-2,DIAG2
- 'VMINA( A,N ) ERROR: N.LE.0'
-LDIAG3 EQU $-DIAG3
- OFF
- ON GERMAX=0
-DIAG2 F 077,062,2,LMJER1+1
- + LMJER1-FIRS01,DIAG1
- OFF
-#endif
- END
-#ifdef CERNLIB_TCGEN_VMINA
-#undef CERNLIB_TCGEN_VMINA
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/vmul.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/vmul.s
deleted file mode 100644
index 2bac3b3..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/vmul.s
+++ /dev/null
@@ -1,68 +0,0 @@
-*
-* $Id: vmul.s,v 1.1.1.1 1996/02/15 17:54:07 mclareni Exp $
-*
-* $Log: vmul.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:07 mclareni
-* Kernlib
-*
-*
-. *************************************
-.
-. SUBROUTINE VMUL ( A,B,X,N ) *** F 121 ***
-. X( I ) = A(I)*B(I) I = 1, N
-. DO NOTHING IF N.EQ.0
-. * ERROR EXIT IF N.LT.0
-.
-. *************************************
-
- AXR$
- FORT$
-$(1),FIRS01
- + 'VMUL '
-VMUL*
-#include "ftnors1.inc"
-#include "spyuse.inc"
-* Ignoring t=pass
- DL A2,2,XARG . LOC(X), LOC(N)
- DL A0,0,XARG . LOC(A), LOC(B)
- L A3,0,A3
- LXI,U A2,1
- LXI,U A0,1
- LXI,U A1,1
- JZ A3,RETUR4 . DO NOTHING IF N.EQ.0
- JGD A3,$+2 . N-1
-LMJER1 SLJ GERR$ . ERROR EXIT IF N.LT.0
-VMLOOP
- L A4,0,*A0
- FM A4,0,*A1
- S A4,0,*A2
-VML1 JGD A3,VMLOOP
- J RETUR4
-
-
-#if (defined(CERNLIB_GUYDIAGP))&&(defined(CERNLIB_GUYFORT))
-. DIAGNOSTIC PACKETS FOR FORT
-#include "gerr_c.inc"
-F FORM 6,6,6,18
- INFO 010 03
-$(3)
-DIAG1 F 077,050,3,VMUL
- + 0,DYN$
- + 'VMUL '
- ON GERMAX
-DIAG2 F 077,067,2,0
- + LMJER1-FIRS01,DYN$
-DIAG3 F 077,047,LDIAG3,LMJER1+1
- + LDIAG3-2,DIAG2
- 'VMUL( ,,,N ) ERROR: N<0'
-LDIAG3 EQU $-DIAG3
- OFF
- ON GERMAX=0
-DIAG2 F 077,062,2,LMJER1+1
- + LMJER1-FIRS01,DIAG1
- OFF
-#endif
- END
-#ifdef CERNLIB_TCGEN_VMUL
-#undef CERNLIB_TCGEN_VMUL
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/vscale.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/vscale.s
deleted file mode 100644
index 605bbef..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/vscale.s
+++ /dev/null
@@ -1,76 +0,0 @@
-*
-* $Id: vscale.s,v 1.1.1.1 1996/02/15 17:54:07 mclareni Exp $
-*
-* $Log: vscale.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:07 mclareni
-* Kernlib
-*
-*
-. $$$*****$$$*****$$$*****$$$*****
-.
-. SUBROUTINE VSCALE( A,ALPHA,X,N ) *** F 121 ***
-. SETS X(I) = ALPHA*A(I) FOR I=1,N
-. DO NOTHING IF N.EQ.0
-. * ERROR EXIT GERRB$ IF N.LT.0
-. * ANY OVERLAP
-. * SINGLE PRECISION A,ALPHA,X
-.
-. $$$*****$$$*****$$$*****$$$*****
-.
- AXR$
- FORT$
-$(1),FIRS01
- + 'VSCALE'
-VSCALE*
-#include "ftnors1.inc"
-#include "spyuse.inc"
-* Ignoring t=pass
- DL A2,2,XARG . LOC(X), LOC(N)
- DL A0,0,XARG . LOC(A), LOC(ALPHA)
- L A3,0,A3 . N
- L A1,0,A1 . ALPHA
- JZ A3,RETUR4 . DO NOTHING IF N=0
- JGD A3,$+2 . N-1
-LMJER1 SLJ GERR$ . IF N.LT.0
- TLE A0,A2
- J VSC2
- LXI,U A0,1
- LXI,U A2,1
-LOOP LA A4,0,*A0 .
- FM A4,A1
- S A4,0,*A2
- JGD A3,LOOP .
- J RETUR4
-VSC2 . LOC(B).GT.LOC(A)
- A A0,A3 . LOC(A(N))
- A A2,A3
- LXI,U A0,-1 .
- LXI,U A2,-1
- J LOOP
-
-#if (defined(CERNLIB_GUYDIAGP))&&(defined(CERNLIB_GUYFORT))
-. DIAGNOSTIC PACKETS FOR FORT
-#include "gerr_c.inc"
-F FORM 6,6,6,18
- INFO 010 03
-$(3)
-DIAG1 F 077,050,3,VSCALE
- + 0,DYN$
- + 'VSCALE'
- ON GERMAX
-DIAG2 F 077,067,2,0
- + LMJER1-FIRS01,DYN$
-DIAG3 F 077,047,LDIAG3,LMJER1+1
- + LDIAG3-2,DIAG2
- 'VSCALE( ,,,N ) ERROR: N<0'
-LDIAG3 EQU $-DIAG3
- OFF
- ON GERMAX=0
-DIAG2 F 077,062,2,LMJER1+1
- + LMJER1-FIRS01,DIAG1
- OFF
-#endif
- END
-#ifdef CERNLIB_TCGEN_VSCALE
-#undef CERNLIB_TCGEN_VSCALE
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/vsum.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/vsum.s
deleted file mode 100644
index 1979895..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/vsum.s
+++ /dev/null
@@ -1,63 +0,0 @@
-*
-* $Id: vsum.s,v 1.1.1.1 1996/02/15 17:54:07 mclareni Exp $
-*
-* $Log: vsum.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:07 mclareni
-* Kernlib
-*
-*
-. *************************************
-.
-. FUNCTION VSUM( A,N ) *** F 121 ***
-. Y = A(1)+ +A(N)
-. RETURNS VSUM=0. IF N.EQ.0
-. * ERROR EXIT GERRB$ IF N.LT.0
-.
-. *************************************
-
- AXR$
- FORT$
-$(1),FIRS01
- + 'VSUM '
-VSUM*
-#include "ftnors1.inc"
-#include "spyuse.inc"
-* Ignoring t=pass
- DL A2,0,XARG . LOC(A), LOC(N)
- SZ A0
- L A4,0,A3 . N
- LXI,U A2,1
- JZ A4,RETUR2 . VSUM=0. IF N.EQ.0
- JGD A4,$+2 . N-1
-LMJER1 SLJ GERR$ . ERROR EXIT IF N.LT.0
-LOOP
- FA A0,0,*A2
-VSUM1 JGD A4,LOOP
- J RETUR2
-
-#if (defined(CERNLIB_GUYDIAGP))&&(defined(CERNLIB_GUYFORT))
-. DIAGNOSTIC PACKETS FOR FORT
-#include "gerr_c.inc"
-F FORM 6,6,6,18
- INFO 010 03
-$(3)
-DIAG1 F 077,050,3,VSUM
- + 0,DYN$
- + 'VSUM '
- ON GERMAX
-DIAG2 F 077,067,2,0
- + LMJER1-FIRS01,DYN$
-DIAG3 F 077,047,LDIAG3,LMJER1+1
- + LDIAG3-2,DIAG2
- 'VSUM( A,N ) ERROR: N<0'
-LDIAG3 EQU $-DIAG3
- OFF
- ON GERMAX=0
-DIAG2 F 077,062,2,LMJER1+1
- + LMJER1-FIRS01,DIAG1
- OFF
-#endif
- END
-#ifdef CERNLIB_TCGEN_VSUM
-#undef CERNLIB_TCGEN_VSUM
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/vunit.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/vunit.s
deleted file mode 100644
index 4bc1d75..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyf/vunit.s
+++ /dev/null
@@ -1,109 +0,0 @@
-*
-* $Id: vunit.s,v 1.1.1.1 1996/02/15 17:54:07 mclareni Exp $
-*
-* $Log: vunit.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:07 mclareni
-* Kernlib
-*
-*
-. *************************************
-. SUBROUTINE VUNIT( A, X, N ) *** F 121 ***
-. X(I) = A(I) / VMOD(A)
-. USES JZ TO TEST VMOD(A,N)=0 INSTEAD OF TOP A0,(0400400,0)
-. BECAUSE THE RESULT OF VMOD IS NORMALISED
-. DO NOTHING IF N.EQ.0
-. * N.LT.0 DETECTED AND SIGNALED BY VMOD
-.
-. *************************************
-
- AXR$
- FORT$
-
-SLATE INFO 2 2
-$(2),VUNB RES 1 . ALSO USED BY UMOD
- ON FTN
-VUN1
-VUN2 RES 4
- OFF . FTN
- ON FORE
-$(0)
-VUNA + 'VUNIT ' . WALK BACK PACKET
-SAVX11 + 0
- OFF
- ON FORT++FTN
-#include "gerr_c.inc"
- RES 1
-SAVX11 RES 1
- OFF
-$(1),FIRS01
-VUNERR . (CALL GERR$ MUST NOT BE THE LAST INSTR. OF A ROUTINE)
- L X11,SAVX11
-LMJER1 SLJ GERR$ . ERROR EXIT IF VMOD(A,N)=0.
-
- + 'VUNIT '
-VUNIT*
-#include "ftnors1.inc"
-#include "spyuse.inc"
-* Ignoring t=pass
- DL A2,1,XARG . LOC(X), LOC(N)
- S,H2 X11,SAVX11
- DS A2,VUN2+2
- L A2,0,XARG . LOC(A)
- DO FTN , L,U A0,VUN1
- DS A2,VUN1
- S A2,VUN2
-LMJVMD LMJ X11,VMOD . CALL VMOD(A,N)
- DO FOR ,VUN1 RES 2
- DO FORE , + $-FIRS01-3,VUNA
- DO NNOP , NOP
- JN A0,VUN4 . ERROR N<0 DIAGNOSED BY VMOD
- JZ A0,VUNERR
- L A2,(1.0)
- FD A2,A0 . 1. / VMOD(A)
- S A2,VUNB
- ON FTN
- L,U A1,VUNB
- L,U A0,VUN2
- S A1,VUN2+1
- OFF . FTN
-LMJVSC LMJ X11,VSCALE
- ON FOR
-VUN2 RES 1 . LOC A
- + VUNB
- RES 2 . LOC(X) AND LOC(N)
- OFF . FOR
- DO FORE , + $-FIRS01-5,VUNA
- DO NNOP , NOP
-VUN4
- L X11,SAVX11
- J RETUR3
-
-. DIAGNOSTIC PACKETS FOR FORT
- ON FORT
-F FORM 6,6,6,18
- INFO 010 03
-$(3)
-DIAG1 F 077,050,3,VUNIT
- + 0,DYN$+1
- + 'VUNIT '
-DIAG4 F 077,062,2,LMJVMD+1
- + LMJVMD-FIRS01,DIAG1
- ON GERMAX
-DIAG2 F 077,067,2,0
- + LMJER1-FIRS01,DYN$+1
-DIAG3 F 077,047,LDIAG3,LMJER1+1
- + LDIAG3-2,DIAG2
- 'VUNIT( A,X,N ) ERROR: VMOD(A,N)=0'
-LDIAG3 EQU $-DIAG3
- OFF
- ON GERMAX=0
-DIAG2 F 077,062,2,LMJER1+1
- + LMJER1-FIRS01,DIAG1
- OFF
-DIAG5 F 077,062,2,LMJVSC+1
- + LMJVSC-FIRS01,DIAG1
- OFF
- END
-#ifdef CERNLIB_TCGEN_VUNIT
-#undef CERNLIB_TCGEN_VUNIT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyfort_/default.dat b/src/packlib/kernlib/kerngen/obsolete/kernuni/guyfort_/default.dat
deleted file mode 100644
index cd926f0..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyfort_/default.dat
+++ /dev/null
@@ -1,8 +0,0 @@
-*
-* $Id: default.dat,v 1.1.1.1 1996/02/15 17:53:55 mclareni Exp $
-*
-* $Log: default.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:53:55 mclareni
-* Kernlib
-*
-*
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyfort_/diagp.inc b/src/packlib/kernlib/kerngen/obsolete/kernuni/guyfort_/diagp.inc
deleted file mode 100644
index b27a28d..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyfort_/diagp.inc
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: diagp.inc,v 1.1.1.1 1996/02/15 17:53:55 mclareni Exp $
-*
-* $Log: diagp.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:53:55 mclareni
-* Kernlib
-*
-*
-*
-* diagp.inc
-*
-#if defined(CERNLIB_GUYFORT)
-#if defined(CERNLIB_GUYDIAGP)
-DIAGP EQU 1
-#endif
-#endif
-*
-* diagp.inc
-*
-DIAGP EQU 0
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyfort_/fort.inc b/src/packlib/kernlib/kerngen/obsolete/kernuni/guyfort_/fort.inc
deleted file mode 100644
index fb312a2..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyfort_/fort.inc
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: fort.inc,v 1.1.1.1 1996/02/15 17:53:55 mclareni Exp $
-*
-* $Log: fort.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:53:55 mclareni
-* Kernlib
-*
-*
-*
-* fort.inc
-*
-#if defined(CERNLIB_GUYFORE)
-FORE EQU 1
-FORT EQU 0
-FTN EQU 0
-#endif
-*
-* fort.inc
-*
-#if defined(CERNLIB_GUYFORT)
-FORE EQU 0
-FORT EQU 1
-FTN EQU 0
-#endif
-*
-* fort.inc
-*
-#if defined(CERNLIB_GUYFTN)
-FORE EQU 0
-FORT EQU 0
-FTN EQU 1
-. ASCII . PROC TO BE INCLUDED WHERE NEEDED ONLY
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyfort_/fort_.dat b/src/packlib/kernlib/kerngen/obsolete/kernuni/guyfort_/fort_.dat
deleted file mode 100644
index 75535bc..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyfort_/fort_.dat
+++ /dev/null
@@ -1,44 +0,0 @@
-*
-* $Id: fort_.dat,v 1.1.1.1 1996/02/15 17:53:55 mclareni Exp $
-*
-* $Log: fort_.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:53:55 mclareni
-* Kernlib
-*
-*
- DEF
-#include "fort.inc"
-#include "other.inc"
-#include "optr.inc"
-#include "nnop.inc"
-#include "lftnors.inc"
-#include "diagp.inc"
-#include "germax.inc"
-#include "lspyuse.inc"
-
-FORT$* PROC 0 .
-#if defined(CERNLIB_GUYFORE)||defined(CERNLIB_GUYFORT)
-XARG* EQU X11
-RETUR0* EQUF 0+NNOP+FORE,X11
-RETUR1* EQUF 1+NNOP+FORE,X11
-RETUR2* EQUF 2+NNOP+FORE,X11
-RETUR3* EQUF 3+NNOP+FORE,X11
-RETUR4* EQUF 4+NNOP+FORE,X11
-RETUR5* EQUF 5+NNOP+FORE,X11
-RETUR6* EQUF 6+NNOP+FORE,X11
-NCHWD* EQU 6
-NBITCH* EQU 6
-#endif
-#if defined(CERNLIB_GUYFTN)
-XARG* EQU A0
-RETUR0* EQUF 0,X11
-RETUR1* EQUF 0,X11
-RETUR2* EQUF 0,X11
-RETUR3* EQUF 0,X11
-RETUR4* EQUF 0,X11
-RETUR5* EQUF 0,X11
-RETUR6* EQUF 0,X11
-NCHWD* EQU 4
-NBITCH* EQU 9
-#endif
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyfort_/ftnors1.inc b/src/packlib/kernlib/kerngen/obsolete/kernuni/guyfort_/ftnors1.inc
deleted file mode 100644
index d11d0a7..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyfort_/ftnors1.inc
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: ftnors1.inc,v 1.1.1.1 1996/02/15 17:53:55 mclareni Exp $
-*
-* $Log: ftnors1.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:53:55 mclareni
-* Kernlib
-*
-*
-*
-* ftnors1.inc
-*
-#if defined(CERNLIB_GUYFORT)
-#if defined(CERNLIB_COMPATIBLE)
- TZ,H1 0,X11
- L,U X11,0,A0
-#endif
-#endif
-* EMPTY SEQUENCE
-*
-* ftnors1.inc
-*
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyfort_/germax.inc b/src/packlib/kernlib/kerngen/obsolete/kernuni/guyfort_/germax.inc
deleted file mode 100644
index 63a68d1..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyfort_/germax.inc
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: germax.inc,v 1.1.1.1 1996/02/15 17:53:55 mclareni Exp $
-*
-* $Log: germax.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:53:55 mclareni
-* Kernlib
-*
-*
-*
-* germax.inc
-*
-#if defined(CERNLIB_GUYFORT)
-#if defined(CERNLIB_GUYGERMAX)
-GERMAX EQU 1
-#endif
-#endif
-*
-* germax.inc
-*
-GERMAX EQU 0
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyfort_/gerr_c.inc b/src/packlib/kernlib/kerngen/obsolete/kernuni/guyfort_/gerr_c.inc
deleted file mode 100644
index 8c7474c..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyfort_/gerr_c.inc
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: gerr_c.inc,v 1.1.1.1 1996/02/15 17:53:55 mclareni Exp $
-*
-* $Log: gerr_c.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:53:55 mclareni
-* Kernlib
-*
-*
-*
-* gerr_c.inc
-*
-GERR$C INFO 2 4
-$(4)
- DO FOR ,FBLANK
- DO FOR ,BLANK + 050505050505
- DO FTN ,BLANK + 040040040040
-DYN$
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyfort_/lftnors.inc b/src/packlib/kernlib/kerngen/obsolete/kernuni/guyfort_/lftnors.inc
deleted file mode 100644
index e343565..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyfort_/lftnors.inc
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: lftnors.inc,v 1.1.1.1 1996/02/15 17:53:55 mclareni Exp $
-*
-* $Log: lftnors.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:53:55 mclareni
-* Kernlib
-*
-*
-*
-* lftnors.inc
-*
-#if defined(CERNLIB_GUYFORT)
-#if defined(CERNLIB_COMPATIBLE)
-LFTNORS EQU 2
-#endif
-#endif
-*
-* lftnors.inc
-*
-LFTNORS EQU 0
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyfort_/lspyuse.inc b/src/packlib/kernlib/kerngen/obsolete/kernuni/guyfort_/lspyuse.inc
deleted file mode 100644
index 5324ac8..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyfort_/lspyuse.inc
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: lspyuse.inc,v 1.1.1.1 1996/02/15 17:53:55 mclareni Exp $
-*
-* $Log: lspyuse.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:53:55 mclareni
-* Kernlib
-*
-*
-*
-* lspyuse.inc
-*
-LSPYUSE EQU 0
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyfort_/nnop.inc b/src/packlib/kernlib/kerngen/obsolete/kernuni/guyfort_/nnop.inc
deleted file mode 100644
index b53af42..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyfort_/nnop.inc
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: nnop.inc,v 1.1.1.1 1996/02/15 17:53:55 mclareni Exp $
-*
-* $Log: nnop.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:53:55 mclareni
-* Kernlib
-*
-*
-*
-* nnop.inc
-*
-#if defined(CERNLIB_GUYFORT)
-#if defined(CERNLIB_GUYNOP)||defined(CERNLIB_GUYNNOP)
-NNOP EQU 1
-#endif
-#endif
-*
-* nnop.inc
-*
-NNOP EQU 0
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyfort_/optr.inc b/src/packlib/kernlib/kerngen/obsolete/kernuni/guyfort_/optr.inc
deleted file mode 100644
index 7468d28..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyfort_/optr.inc
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: optr.inc,v 1.1.1.1 1996/02/15 17:53:55 mclareni Exp $
-*
-* $Log: optr.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:53:55 mclareni
-* Kernlib
-*
-*
-*
-* optr.inc
-*
-#if defined(CERNLIB_GUYFORT)
-#if defined(CERNLIB_GUYOPTR)
-OPTR EQU 1
-#endif
-#endif
-*
-* optr.inc
-*
-OPTR EQU 0
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyfort_/other.inc b/src/packlib/kernlib/kerngen/obsolete/kernuni/guyfort_/other.inc
deleted file mode 100644
index 7f48956..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyfort_/other.inc
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: other.inc,v 1.1.1.1 1996/02/15 17:53:55 mclareni Exp $
-*
-* $Log: other.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:53:55 mclareni
-* Kernlib
-*
-*
-*
-* other.inc
-*
-FOR EQU FORE++FORT
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyfort_/spyuse.inc b/src/packlib/kernlib/kerngen/obsolete/kernuni/guyfort_/spyuse.inc
deleted file mode 100644
index d5c5291..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyfort_/spyuse.inc
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: spyuse.inc,v 1.1.1.1 1996/02/15 17:53:55 mclareni Exp $
-*
-* $Log: spyuse.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:53:55 mclareni
-* Kernlib
-*
-*
-* EMPTY SEQUENCE
-*
-* spyuse.inc
-*
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyfort_/sqfore.dat b/src/packlib/kernlib/kerngen/obsolete/kernuni/guyfort_/sqfore.dat
deleted file mode 100644
index 148aea0..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyfort_/sqfore.dat
+++ /dev/null
@@ -1,10 +0,0 @@
-*
-* $Id: sqfore.dat,v 1.1.1.1 1996/02/15 17:53:54 mclareni Exp $
-*
-* $Log: sqfore.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:53:54 mclareni
-* Kernlib
-*
-*
-#if defined(CERNLIB_GUYFORE)
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyfort_/sqfort.dat b/src/packlib/kernlib/kerngen/obsolete/kernuni/guyfort_/sqfort.dat
deleted file mode 100644
index d0ec7c6..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyfort_/sqfort.dat
+++ /dev/null
@@ -1,10 +0,0 @@
-*
-* $Id: sqfort.dat,v 1.1.1.1 1996/02/15 17:53:55 mclareni Exp $
-*
-* $Log: sqfort.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:53:55 mclareni
-* Kernlib
-*
-*
-#if defined(CERNLIB_GUYFORT)
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyfort_/sqftn.dat b/src/packlib/kernlib/kerngen/obsolete/kernuni/guyfort_/sqftn.dat
deleted file mode 100644
index eb1b9b7..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guyfort_/sqftn.dat
+++ /dev/null
@@ -1,10 +0,0 @@
-*
-* $Id: sqftn.dat,v 1.1.1.1 1996/02/15 17:53:55 mclareni Exp $
-*
-* $Log: sqftn.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:53:55 mclareni
-* Kernlib
-*
-*
-#if defined(CERNLIB_GUYFTN)
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guygerr_/bnconv_.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guygerr_/bnconv_.s
deleted file mode 100644
index 508dff0..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guygerr_/bnconv_.s
+++ /dev/null
@@ -1,94 +0,0 @@
-*
-* $Id: bnconv_.s,v 1.1.1.1 1996/02/15 17:54:08 mclareni Exp $
-*
-* $Log: bnconv_.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:08 mclareni
-* Kernlib
-*
-*
-. ----------------------------------------------------------------------
-. AREA 5 :
-. CODE FOR CONVERSION ROUTINES
-.
-. ASSEMBLER ROUTINE BNOCT
-. BINARY TO FIELDATA OCTAL CONVERSION
-. INPUT IN A5
-. OUTPUT IN A4,A5
-. NO OTHER REGISTERS REQUESTED
-
- AXR$
- FORT$
-
-GERR$C INFO 2 4
-$(4)
- DO FOR ,FBLANK
-BLANK
- DO FOR , + 050505050505
- DO FTN , + 040040040040
-DYN$ RES 2
-BSAV1 RES 2
-
-$(0)
- DO FTN ,FBLANK + 050505050505
-BNOCT$*
- J
- DS A0,BSAV1
- SZ A1
-BNOCT1 L A4,(0666666666666)
- L,U A0,5
-BNOCT2
- LSSC A4,3
- LDSL A4,3
- JGD A0,BNOCT2
- JNZ A1,BNOCT3
- L A1,A4
- J BNOCT1
-BNOCT3 L A5,A4
- L A4,A1
- DL A0,BSAV1
- J *BNOCT$
-
-
-. ASSEMBLER ROUTINE BNDC1$
-. CONVERT THE CONTENT OF A3 FROM BINARY FORM TO DECIMAL FIELDATA CODED FORM
-. RESULT IN A3, RIGHT ADJUSTED (I6 FORMAT)
-. USES REGISTERS AO, A4, A5, R1
-BNDC1$*
- J
- L A5,FBLANK
- L,U R1,5
-BND1 DSA A3,36
- DI,U A3,10
- A,U A4,060
- DSL A4,6
- JZ A3,BND2
- JGD R1,BND1
- J BND3
-BND2 L,U A3,6 . RIGHT ADJUST
- MSI A3,R1
- SSC A5,0,A3
-BND3 L A3,A5
- J *BNDC1$
-
-
-. ASSEMBLER ROUTINE BNDC2$ (EQUIVALENT TO NBTOD$ )
-. CONVERT THE CONTENT OF A3 FROM BINARY FORM TO DECIMAL FIELDATA CODED FORM
-. RESULT IN A3, LEFT ADJUSTED
-. USES REGISTERS A3, A4, A5, R1
-. OFTEN USED TO GET FILE NAME FROM FORTRAN UNIT NUMBER
-
-BNDC2$*
- J
- L A5,FBLANK
- L,U R1,5
-BND11 DSA A3,36
- DI,U A3,10
- A,U A4,060
- DSL A4,6
- JZ A3,BND22
- JGD R1,BND11
-BND22 L A3,A5
- J *BNDC2$
-
-. ----------------------------------------------------------------------
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guygerr_/dcheck.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guygerr_/dcheck.s
deleted file mode 100644
index 1c80682..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guygerr_/dcheck.s
+++ /dev/null
@@ -1,113 +0,0 @@
-*
-* $Id: dcheck.s,v 1.1.1.1 1996/02/15 17:54:08 mclareni Exp $
-*
-* $Log: dcheck.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:08 mclareni
-* Kernlib
-*
-*
-. ----------------------------------------------------------------------
-. AREA 4 :
-. CODE FOR DEVICE-CHECK ROUTINE
-
-. SUBROUTINE DCHECK(UNIT,DEV)
-. INTEGER UNIT,DEV(2)
-. RETURNS DEVICE TYPE FOR FILE UNIT
-. DEV(1) I DEV(2)
-. 0 : NOT ASSIGNED I NOT USED
-. 1 : R.M.S (DISC) I SIZE (WORDS)
-. 2 : TAPE I 7 OR 9 TRACKS
-. 3 : OTHER TYPES I EQUIPMENT TYPE
-.
-
- AXR$
- FORT$
-PF FORM 12,6,18
-TRKW EQU 1792
-POSW EQU 64*TRKW
-EQUIP EQUF FACPKT+6,,S1
-GRANUL EQUF FACPKT+6,,S3
-MXGRAN EQUF FACPKT+8,,H2
-
-GERR$C INFO 2 4
-$(4)
-BLANK RES 1
-DYN$ RES 2
-FACPKT RES 13
-
-$(1),FIRS01
- + 'DCHECK'
-DCHECK*
-#include "ftnors1.inc"
-#include "spyuse.inc"
-* Ignoring t=pass
- DL A1,0,XARG . LOC(UNIT), LOC(DEV)
- L A3,0,A1 . UNIT
- TG,U A3,1
- TG,U A3,NTBSZ$
- J DVKERR . NOT A POSSIBLE FORTRAN UNIT
- SLJ BNDC2$
- S,H1 A3,FACPKT+1 . ' ' IN H1(FACPKT(2))
- L,U A0,FACPKT
- S A3,FACPKT
- LXI,U A0,0377777 . REQUEST MAX-SIZE FOR FITEM$ PACKET
- S,H2 A3,FACPKT+1 . ' ' IN H2(FACPKT(2))
- ER FITEM$
- L A1,EQUIP
- JZ A1,DVKEND . FILE IS NOT ASSIGNED
- TG,U A1,040
- J DVKSYM . A SYMBIONT OR COMMUNICATION FILE
- TG,U A1,020
- J DVKRMS . A R.M.S FILE
-
- L,U A5,9 . A NINE TRACK TAPE
- L,U A4,2
- TE,U A1,014
- L,U A5,7 . A SEVEN TRACK TAPE
- DS A4,0,A2
- J RETUR2
-
-DVKRMS
- L,U A4,1
- L,U A5,TRKW
- TZ GRANUL
- L,U A5,POSW
- MSI A5,MXGRAN
- DS A4,0,A2
- J RETUR2
-
-DVKSYM
- L,U A4,3
- S A1,1,A2 . EQUIPMENT TYPE IN DEV(2)
- S A4,0,A2
- J RETUR2
-
-DVKEND
- SZ 0,A2
- J RETUR2
-
-DVKERR
- SZ 0,A2
-LMJER1 SLJ GERR$
-
-. DIAG PACKETS
-#if (defined(CERNLIB_GUYDIAGP))&&(defined(CERNLIB_GUYFORT))
- INFO 010 03
-$(3),DIAG1 + 0775003,DCHECK
- + DYN$
- + 'DCHECK'
- ON GERMAX
-F FORM 6,6,6,18
-DIAG2 + 0776702,0
- + LMJER1-FIRS01,DYN$
-DIAG3 F 077,047,LDIAG3,LMJER1+1
- + LDIAG3-2,DIAG2
- 'DCHECK(LUN,.) LUN NOT WITHIN ALLOWED RANGE FOR FORTRAN UNITS'
-LDIAG3 EQU $-DIAG3
- OFF . GERMAX
- ON GERMAX=0
-DIAG2 + 0776202,LMJER1+1
- + LMJER1-FIRS01,DIAG1
- OFF . GERMAX=0
-#endif
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guygerr_/flagwd.inc b/src/packlib/kernlib/kerngen/obsolete/kernuni/guygerr_/flagwd.inc
deleted file mode 100644
index 8e6de28..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guygerr_/flagwd.inc
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: flagwd.inc,v 1.1.1.1 1996/02/15 17:54:08 mclareni Exp $
-*
-* $Log: flagwd.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:54:08 mclareni
-* Kernlib
-*
-*
-*
-* flagwd.inc
-*
-FLAGW1 + 0,0,0,0,0,0
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guygerr_/gerr_.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guygerr_/gerr_.s
deleted file mode 100644
index 4b77343..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guygerr_/gerr_.s
+++ /dev/null
@@ -1,323 +0,0 @@
-*
-* $Id: gerr_.s,v 1.1.1.1 1996/02/15 17:54:08 mclareni Exp $
-*
-* $Log: gerr_.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:08 mclareni
-* Kernlib
-*
-*
-. ---------------------------------------
-. UTILITY AND ERROR ROUTINES
-. 1 COMMON/ G$DAT$/ LOAD-TIME PARAMETERS
-. 2 SCRATCH-PAD
-. 3 ERROR ROUTINE GERR$ (REFERENCED BY GNSEC LIBRARY ROUTINES)
-. 4 DEVICE CHECK ROUTINE
-. 5 CONVERSION ROUTINES
-. THIS PACKAGE IS LOADED IN D BANK
-. ---------------------------------------
-
- AXR$
- FORT$
-/
-. -----------------------------------------------------------------------
-. AREA 1.0
-. THIS IS A COMMON WHICH CONTAINS ALL VARIABLES OF INTEREST FOR GERR$
-. AND ROUTINES OUTSIDE THIS PACKAGE DEALING WITH SYSTEM DEPENDENT PARAMETERS
-. (FOR INSTANCE VALUES SET BY @MAP AT LOAD TIME)
-
-G$DAT$ INFO 2 2
-$(2)
-. HYPOTHESIS:ONLY ONE I-BANK,ONLY PSRM USED
-IBKL + FRSTI$-1
- + LASTI$
-DBKL +FRSTD$-1
- + LASTD$
-
-. ----------------------------------------------------------------------
-. AREA 2 :
-. SCRATCH-PAD (COMMMON TO ALL ROUTINES OF THE PACKAGE)
-. THE COMMON GERR$C CONTAINS DYN$ (=SAVX11) FOR ALL ASSEMBLER
-. ROUTINES IN GNSECLIB
-. AND SOME HEAVILY USED CONSTANTS
-GERR$C INFO 2 4
-$(4)
- DO FOR ,FBLANK
-BLANK
- DO FOR , + 050505050505 . SPACE, FIELDATA
- DO FTN , + 040040040040 . SPACE, ASCII
-DYN$
-SAVX11
- + 0
- + 0
-WKB . WALK-BACK WORD FOR GERR$
-. FACPKT* . 13 WORDS PACKET USED BY DCHECK
- RES 1
-. BSAV1 . 2 WORDS USED BY CONVERSION ROUTINE BNOCT$
-. RES 12
-
-. ----------------------------------------------------------------------
-. AREA 3.0 :
-. LOCAL VARIABLES FOR ERROR ROUTINE GERR$
-
-MXARG EQU 6
- ON FORT**DIAGP
-F FORM 6,6,6,18
- INFO 010 5
-$(5)
-DIAG0 F 077,060,3,GERR$
- + WKB
- + 'GERR$ '
-DIAG1 F 077,062,2,LMJSTR+1
- + LMJSTR-FIRS00,DIAG0
-DIAG2 F 077,067,2,LMJNER+1
- + WKB
-DIAG3 F 077,067,2,LMJNR1+1
- + WKB
- OFF
-
-PF FORM 12,6,18
-
-$(0),FIRS00 . LABEL FIRS00 USED TO TO GET RELATIVE ADDRESS INSIDE GERR$
-. . ---- AREA RESERVED TO STORE REGISTERS
-SAVREG RES 9
-. . ----
-#include "flagwd.inc"
-FLAGF1 EQUF FLAGW1,,S6
-FLAGF2 EQUF FLAGW1,,S1
-FLAGF3 EQUF FLAGW1,,S2
- DO FTN ,FBLANK ' ' . FIELDATA BLANK WORD
-MSG1 '***** ERROR IN ROUTINE '
-LMSG1 EQU $-MSG1
-PRPKT1 PF 1,LMSG1,MSG1
-MSG2 'GERR$: ROUTINE NAME CANNOT BE ACCESSED'
-LMSG2 EQU $-MSG2
-PRPKT2 PF 1,LMSG2,MSG2
- ON FORT**DIAGP
-INOP NOP
-BTREG + A3
- + 1,LMJSTR+1
- OFF . FORT**DIAGP
-
-. AREA 3.1 :
-. CODE FOR ERROR ROUTINE GERR$
-
-$(0)
-. ENTRY THRU J OR LMJ
-. GERRR$*
-. SLJ SVREG
-. S,H2 X11,WKB
-. J GER0
-. ENTRY THRU SLJ
-GERR$*
- NOP
- SLJ SVREG . SAVE THE REGISTERS WHICH MAY BE USED BY
- L,H2 A2,GERR$ . LOC( ERROR DETECTION )
- S A2,WKB . WALK-BACK WORD FOR DIAG PACKET
-GER0
- LN,U A0,1
- DL A2,IBKL
- SN A0,FLAGF1
- DL A4,DBKL
- A,H2 A0,SAVX11 . (A0)=(X11)-1
- TNW A2,A0 .
- J $+3 . (X11) WITHIN I-BANK
- TW A4,A0 .
- J GER6 . (X11) NOT WITHIN PROGRAM LIMITS
- LXI,U A0,-1 .
-GER1 L,H1 A1,0,*A0 . . LOOP USED TO FIND LMJ INSTRUCTION
- DO FOR , JZ A1,GER1 . .
- DO FTN , JZ A1,GER6 . .
- TE,U A1,0745660 .
- J GER6 . NOT A LMJ X11
- L,H2 A1,1,A0 . LOC ( EBTRY POINT OF ROUTINE CALLED )
- A,U A0,2
- S,H2 A0,SAVX11 . UPDATE SAVX11 VALUE
- . ( CORRECT KEY FOR DIAG PACKET )
- TG,U A1,0200000 . CHECK NO INDIRECTION
- J GER6 .
- TNW A2,A1
- J $+3 . WITHIN I-BANK LIMITS
- TW A4,A1
- J GER6
- AN,U A1,1
- L A4,0,A1 . ROUTINE NAME OR LOC(ROUTINE NAME)
- L A5,FBLANK
- TNZ,H1 0,A1
- DL A4,*0,A1
- DS A4,MSG1+4
- L A0,PRPKT1
- ER PRINT$
- ON FOR
- SLJ N$ARG . TO GET THE NUMBER OF ARGUMENTS
- S,H2 A0,GER5 . STORE IT IN RETURN INSTRUCTION
- OFF . FOR
- ON FORT**DIAGP
- TNZ FLAGF2
- J GER2 . NO STRACE
- DL A1,BTREG . . SETS THE LIST OF ARGUMENTS
- L A3,INOP . . OF STRACE TO 'NOP'
- L,U R1,MXARG . .
- BT A2,0,*A1
- JZ A0,LMJSTR . IF THERE ARE NO ARGUMENTS
- TG,U A0,MXARG+1 .
- L,U A0,MXARG . CONTROL: NO MORE THAN MXARG ARGUMENTS
- LXI,U X11,1 . . THE ARGUMENT LIST OF THE (USER)
- S A0,R1 . . CALLING ROUTINE IS TRANSFERED
- LXM,U A2,LMJSTR+1 . . INTO STRACE ARGUMENT LIST.
- BT A2,0,*X11 . .
-. SLJ LDREG NOT NEEDED SINCE STRACE NOW RETURNS IN THE CALLING ROUTINE
-. NOT IN THE FIRST UPSTREAM USER ROUTINE AS BEFORE (1976)
-LMJSTR LMJ X11,STRACE .
- RES MXARG .
- OFF . FORT**DIAGP
-GER2
- SLJ LDREG
- TZ FLAGF3
- DO FORE ,LMJNER LMJ X11,NERR$
- DO FORT ,LMJNER LMJ X11,NER$
- DO FTN ,LMJNER LMJ X11,FERR
-
-. CONTROL RETURNED HERE IF ('FERRER') ERROR RECOVERY TURNED ON
- L,H2 X11,SAVX11
-. RETURN IF J OR SLJ OR LMJ
-GER5 J $-$,X11 . RETURN IF LMJ
-
-GER6 . INCORRECT ADDRESSING.
- SLJ LDREG
- ON FORT
-LMJNR1 LMJ X11,NER1$
- + PRPKT2
-. RETURN FROM NER1$ IF ANY IS TO FIRST USER ROUTINE (DIAG PACKET 060)
- OFF . FORT
- DO FORE , J NERR$
- DO FORT , J NER$
- DO FTN , J FERR
-
-SVREG NOP +0
- DS A0,SAVREG
- S,H2 X11,SAVX11
- S R1,SAVREG+6
- DS A2,SAVREG+2
- S R2,SAVREG+7
- S R3,SAVREG+8
- DS A4,SAVREG+4
- J *SVREG
-
-LDREG NOP +0
- DL A0,SAVREG
- L,H2 X11,SAVX11
- L R1,SAVREG+6
- DL A2,SAVREG+2
- L R2,SAVREG+7
- L R3,SAVREG+8
- DL A4,SAVREG+4
- J *LDREG
-
-. ---------------------------------------
-. AREA 3.11
-. CODE FOR ROUTINES LIBCHK AND SETDBG
-.
-. LOGICAL FUNCTION LIBCHK ( DUMMY ARG )
-. TEST AND RESET OF ERROR FLAG FOR LIBRARY ROUTINES
-. LIBCHK=.FALSE. IF NO ERROR DETECTED SINCE LAST CALL TO LIBCHK
-. LIBCHK = .TRUE. IF ONE ERROR AT LEAST DETECTED
-.
-LIBCHK*
- L A0,FLAGF1
- SZ FLAGF1 . RESETS FLAG
- J RETUR1
-.
-. SUBROUTINE SETDBG(LEVEL1,...)
-. SET OR RESET DEBUG FLAG FOR LIBRARY ROUTINES
-. LEVEL=0: RESETS ALL DEBUG OPTIONS ( IF ANY )
-. LEVEL=1: SWITCH-ON WALK BACK AND DUMP OF ARGUMENTS
-. LEVEL=2: JUMP TO STANDARD ERROR ROUTINE NER$.
-.
-SETDBG*
-#include "ftnors1.inc"
- L,U A2,1
- ON FTN
- L A4,XARG
- SSL A4,18
- OFF . FTN
- LXI,U XARG,1
- DO FOR ,SET1 TZ,S1 0,XARG
- DO FTN ,SET1 JGD A4,SET12
- J 0,X11 . RETURN IF ARGUMENT LIST EXHAUSTED
-SET12
- L A1,0,*XARG
- L A1,0,A1 . NEXT ARGUMENT
- TE,U A1,1
- J SET2
- S A2,FLAGF2 . LEVEL=1
- J SET1
-SET2
- TE,U A1,2
- J SET3
- S A2,FLAGF3 . LEVEL=2
- J SET1
-SET3
- JNZ A1,SET1
- SZ FLAGF2 . LEVEL=0
- SZ FLAGF3
- J SET1
-. ----------------------------------------------------------------------
-
-. 3.2
-. CODE FOR ROUTINE N$ARG (SIMILAR TO LIBRARY ROUTINE 'NOARG')
-. RETURNS IN A0 THE NUMBER WHICH MUST BE ADDAD TO X11 FOR CORRECT RETURN
-. ( 'NUMBER OF ARGUMENTS' )
-N$ARG*
- NOP . ENTRY IS THRU SLJ
-#if !defined(CERNLIB_GUYFTN)
- L A0,X11 . SET LOOP INDEX
- LXI,U A0,1 . LOOP INCREMENT
-N1
- L,H1 A2,0,*A0 . H1 OF NEXT WORD IN ARGUMENT STRING
- JZ A2,N1 .
- TNE,U A2,0743000 . IS IT A 'NOP'
- J N3 . YES
- TLE,U A2,010000 . IS IT A W.B. WORD (11A COMPILER)
- J N4 . YES
- TE,U A2,0742000 . IS IT A 'J' INSTRUCTION
- J N3 . NO (CONSIDER IT AS A VALID RETURN POINT
-. NOW HAVE TO DECIDE IF 'J' WAS THE NORMAL RETURN, OR A $NNN ARGUMENT
- L A1,A0 . SAVE PRESENT A0 VALUE
-N2
- L,H1 A2,0,*A0 . H1 OF NEXT WORD
- JZ A2,N1 . RETURN TO NORMAL SEQUENCE IF ZERO
- TNE,U A2,0743000 . IS IT A 'NOP'
- J N3 . YSE
- TLE,U A2,010000 . IS IT A W.B. WORD
- J N4 . YES
- TNE,U A2,0742000 . IS IT A 'J'
- J N2 . YES, LOOK FOR NEXT INSTRUCTION
- L A0,A1 . ANOTHER INSTRUCTION, CONSIDER THE
- . FIRST JUMP INSTRUCTION AS THE NORMAL RETURN POINT
-N3 AN,U A0,1 . TO GET THE CORRECT NUMBER OF ARGS
-N4 ANH A0,X11
- LXI,U A0,0
-#endif
-#if defined(CERNLIB_GUYFTN)
- L,U A0,0
-#endif
- J *N$ARG . AND RETURN
-
-. ---------------------------------------
-. 3.3 FUNCTION VAL( X ) USE RELATED TO NOARG
-
-VAL*
-IVAL*
-LVAL*
-#include "ftnors1.inc"
- L A0,0,XARG
- L A0,0,A0
- J RETUR1
-CVAL*
-DVAL*
-#include "ftnors1.inc"
- L A0,0,XARG
- DL A0,0,A0
- J RETUR1
-
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guysys/dummy.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guysys/dummy.s
deleted file mode 100644
index e88c4fd..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guysys/dummy.s
+++ /dev/null
@@ -1,35 +0,0 @@
-*
-* $Id: dummy.s,v 1.1.1.1 1996/02/15 17:54:07 mclareni Exp $
-*
-* $Log: dummy.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:07 mclareni
-* Kernlib
-*
-*
-. $$$*****$$$*****$$$*****$$$*****
-.
-. ROUTINE DUMMY (ANY NUMBER OF ARGUMENTS) *** N 107 ***
-. TO PREVENT LOADING OF UNWANTED ROUTINES YOU MAY TRANSFORM THEN
-. INTO DUMMY ROUTINES USING THE FOLLOWING TRICK :
-. IN YOUR @MAP INTRODUCE THE DIRECTIVES:
-. IN GNSECLIB.DUMMY
-. EQU XXX/DUMMY (XXX STANDS FOR YOUR ROUTINE NEME)
-.
-. $$$*****$$$*****$$$*****$$$*****
-
- AXR$
-#if defined(CERNLIB_GUYFORE)||defined(CERNLIB_GUYFORT)
-$(1)
-DUMMY*
-. ------------------------- FORTRAN V VERSION (SAME FOR FORTRAN E AND FORTRAN
- SLJ N$ARG . RETURNS IN A0 THE 'RETURN INCREMENT' .
- LXI,XU X11,-1
- AH A0,X11 . (A0) = LOC( RETURN POINT )
- NOP A0,0,*X11 . (X11) = LOC( LMJ INSTRUCTION)
- S,H2 A0,0,X11 . LMJ X11,SUBR TURNED TO LMJ X11,$+RETURN INCREME
- J 0,A0 . RETURN .
-#endif
-#if defined(CERNLIB_GUYFTN)
-$(1),DUMMY* J 0,X11 . RETURN
-#endif
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guysys/hintrfc_.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guysys/hintrfc_.s
deleted file mode 100644
index d35e2cd..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guysys/hintrfc_.s
+++ /dev/null
@@ -1,64 +0,0 @@
-*
-* $Id: hintrfc_.s,v 1.1.1.1 1996/02/15 17:54:07 mclareni Exp $
-*
-* $Log: hintrfc_.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:07 mclareni
-* Kernlib
-*
-*
-. **************************************
-.
-. INTERFACE ROUTINE USED FOR FORTRAN ROUTINES WITH A VARIABLE NUMBER
-. OF ARGUMENTS (SEE HBOOK, GD3...)
-. ROUTINE NOARG WAS DROPPED BECAUSE IT COULD NOT BE USED WITH ALL COMPILERS
-. .FOR EACH ROUTINE CONCERNED YOU MUST PROVIDE A 2 WORDS INTERFACE:
-. . ASSUMING XXX IS THE NAME OF THE ROUTINE WITH A VAR. NUMB. OF ARGS.
-. @ASM,I ,INTERFXXX
-. $(1),XXX* LMJ 14,HINTRFC$
-. + YYY
-. END
-. . AND YOU CHANGE THE NAME (XXX) OF THE ROUTINE TO YYY IN THE FUNCTION OR
-. . SUBROUTINE STATEMENT
-. . YOU MAY THEN MERGE THE ROUTINE YYY AND THE INTERFACE INTO ONE SINGLE
-. . RELOCATABLE ELEMEMT
-. @MAP,IR ,XXX
-. IN YYY,INTERFXXX
-. DEF XXX
-.
-. **************************************
-
- AXR$
- FORT$
-HNOARG INFO 2 2
-$(2),NARG + 0
-
-$(1)
-HINTRFC$*
-#if defined(CERNLIB_GUYFORT)||defined(CERNLIB_GUYFORE)
- L A3,X11
- LXI,U A3,1
- TNZ,S1 0,*A3
- J $-1
- AN,U A3,1,X11 . 'RETURN INCREMENT'
- L,U A1,06
- L A2,0,A2 . LOC( TARGET )
- DO FORT , S,H2 A3,NARG
- DO FORE , ANU,U A3,1
- DO FORE , S,H2 A4,NARG
- TE,S1 A1,0,A2
- J HIN4
- S,S2 A3,*0,A2
- J 0,A2
-HIN4
- LSSL A3,6
- A,U A3,013
- LXI X11,A3
- J 1,A2
-#endif
-#if defined(CERNLIB_GUYFTN)
- L A4,A0
- SSL A4,18
- S,S6 A4,NARG
- J *0,A2
-#endif
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guysys/intsor.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guysys/intsor.s
deleted file mode 100644
index 4de2ba4..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guysys/intsor.s
+++ /dev/null
@@ -1,134 +0,0 @@
-*
-* $Id: intsor.s,v 1.1.1.1 1996/02/15 17:54:07 mclareni Exp $
-*
-* $Log: intsor.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:07 mclareni
-* Kernlib
-*
-*
-. **************************************
-.
-. SUBROUTINE INTSOR( A, N ) *** M 103 ***
-. SUBROUTINE FLPSOR( A, N )
-. SORTS THE N-VECTOR A INTO ITSELF, USING ASCENDING ORDER
-. METHOD = ALGORITHM 'QUICKERSORT' ALGORITM 241, COMM ACM 8(1965)P.669
-. A IS AN ARRAY OF INTEGER VALUES, OR REAL VALUES, OR ALPHANUMERIC VALUES
-. (THE COLLATING SEQUENCE IS THEN FIELDATA OR ASCII)
-. * DO NOTHING IF N=0
-. * ERROR EXIT IF N.LT.0
-. * DOES NOT CHECK N.LT.2**18 ( N LIMITED BY THE DEPTH OF THE STACK )
-.
-. **************************************
-
- AXR$
- FORT$
-SAVI EQU R2
-SAVJ EQU R3
-
-SLATE INFO 2 2
-$(2),LUT RES 40
-. LUT IS THE STACK USED BY QUICKERSORT
-
-$(1),FIRS01
- + 'INTSOR'
-FLPSOR*
-INTSOR*
- DL A1,0,XARG
- L,U A0,2
- L A2,0,A2 . N
- SSC A0,18 . A0 = 2,0 . INDEX WITHIN LUT
- JZ A2,RETUR2 . DO NOTHING IF N=0
- JGD A2,$+2
-LMJER1 SLJ GERR$ . ERROR EXIT IF N.LT.0
- A A2,A1 . LOC( A(N) )
-INT10
- ANU A2,A1 . J-I
- TLE,U A3,2
- J INT200 . SEGMENT LENGTH IS .LE. 2 WORDS
- AU A2,A1 . I + J
- DS A1,SAVI . SAVE I AND J. A1,A2 HOLD K, IQ
- SSA A3,1 . IP = (I+J)/2
- L A4,0,A1 . A(I)
- L A5,0,A3 . T = A(IP)
- S A4,0,A3 . A(IP) = A(I)
- A,U A1,1 . K = I + 1
-INT20
- TG A5,0,A1
- J INT40 . A(K) .LE. T
-INT24
- L A4,0,A2 . A(IQ)
- TG A4,A5
- J INT30 . A(IQ) .GE. T
- L A3,0,A1 . A(K)
- S A4,0,A1 . A(K) = A(IQ)
- S A3,0,A2 . A(IQ) = A(K)
- AN,U A2,1
-INT40 . NEXT K
- A,U A1,1 . K= K + 1
- TG A2,A1
- J INT20
-INT100 . SEGMENT SLITTED, STORE LARGER, PROCESS SHORTER
- L A1,SAVI
- L A4,0,A2 . A(IQ)
- AU A2,A2
- S A4,0,A1 . A(I) = A(IQ)
- AN A3,A1
- S A5,0,A2 . A(IQ) = T
- AN A3,SAVJ
- JN A3,INT110
-. . LARGER IS ( I, IQ-1 )
- AN,U A2,1 . IQ-1
- DS A1,LUT,*A0
- L,U A1,2
- A A1,A2 . NEW I = IQ + 1
- L A2,SAVJ . NEWJ = OLD J
- J INT10
-INT110 . LARGER IS ( IQ+1, J )
- A,U A2,1 . IQ+1
- L A3,SAVJ . J
- DS A2,LUT,*A0 . STORE SEG( IQ+1, J )
- AN,U A2,2 . NEW J = IQ - 1
- J INT10
-INT30 . NEXT IQ
- AN,U A2,1
- TG A2,A1
- J INT24
- J INT100
-INT200 . A SEGMENT WITH 0, 1, OR 2 ELTS
- TE,U A3,1 . IS IT A 2-WORD SEGMEBT
- J INT220 . NO
- DL A3,0,A1 . A(I) AND A(I+1)
- TG A4,A3 . ALREADY ORDERED
- J INT220 . YES
- DSC A3,36
- DS A3,0,A1
-INT220
- AN,U A0,2 . DECREMENT STACK LUT
- AND,U A0,0700 . TRICK TO CHECK A0.LT.0
- JNZ A1,RETUR2
- DL A1,LUT,A0
- J INT10 . PROCESS SEGMENT TAKEN FROM STORE
-
-#if (defined(CERNLIB_GUYDIAGP))&&(defined(CERNLIB_GUYFORT))
-. DIAGNOSTIC PACKETS
-#include "gerr_c.inc"
-F FORM 6,6,6,18
- INFO 010 03
-$(3)
-DIAG1 F 077,050,04,INTSOR
- + 0,DYN$
- 'INTSORFLPSOR'
- ON GERMAX
-DIAG2 F 077,067,02,0
- + LMJER1-FIRS01,DYN$
-DIAG3 F 077,047,LDIAG3,LMJER1+1
- + LDIAG3-2,DIAG2
- 'INTSOR,FLPSOR( A,N ) ERROR: N<0'
-LDIAG3 EQU $-DIAG3
- OFF
- ON GERMAX=0
-DIAG2 F 077,062,2,LMJER1+1
- + LMJER1-FIRS01,DIAG1
- OFF
-#endif
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guysys/irndm.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guysys/irndm.s
deleted file mode 100644
index 3234af6..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guysys/irndm.s
+++ /dev/null
@@ -1,78 +0,0 @@
-*
-* $Id: irndm.s,v 1.1.1.1 1996/02/15 17:54:08 mclareni Exp $
-*
-* $Log: irndm.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:08 mclareni
-* Kernlib
-*
-*
-. $$$*****$$$*****$$$*****$$$*****
-.
-. FUNCTION IRNDM(I) *** V 104 ***
-. SUBROUTINE IRDMIN(OCT)
-. SUBROUTINE IRDOUT(OCT)
-. SUBROUTINE INIRDM(N)
-. GENERATION OF PSEUDO RANDOM INTEGER NUMBERS WITH UNIFORM DISTRIBUTION
-. IN THE RANGE SPECIFIED BY ROUTINE INIRDM
-. DEFAULT RANGE IS (1,2**34-1)
-.
-. $$$*****$$$*****$$$*****$$$*****
-
- AXR$
- FORT$
-$(0)
-ININUM +12113
-T + 1220703125 . FACTEUR CONSTANT, 5**PREMIER
-WI +12113
-N +0200000,0
-$(1)
-. SUBROUTINE INIRDM( N ) SETS THE RANGE TO (0,N-1)
-INIRDM*
-#include "ftnors1.inc"
-#include "spyuse.inc"
-* Ignoring t=pass
- L A1,0,XARG . LOC(N)
- L A4,ININUM
- L A5,0,A1 . N
- DS A4,WI . W AND N
- J RETUR1
-IRNDM*
-#include "ftnors1.inc"
-#include "spyuse.inc"
-* Ignoring t=pass
- L A0,WI
- MSI A0,T . FACTEUR CONSTANT
- AND A0,(0377777777777) . ENLEVER LE SIGNE
- S A1,WI
- MF A1,N
- LA A0,A1 . C'EST UNE FUNCTION
- J RETUR1
-. SUBROUTINE IRDMIN( OCT ) REPLACES THE CURRENT VALUE OF THE GENERATOR BY
-. THE VALUE FOUND IN OCT
-IRDMIN*
-#include "ftnors1.inc"
-#include "spyuse.inc"
-* Ignoring t=pass
- L A1,0,XARG . LOC(OCT)
- L A0,0,A1 . OCT
- S A0,WI
- J RETUR1
-. SUBROUTINE IRDOUT( OCT ) STORES IN OCT THE CURRENT VALUE OF THE GENERATOR
-IRDOUT*
-#include "ftnors1.inc"
-#include "spyuse.inc"
-* Ignoring t=pass
- L A4,WI
- L A1,0,XARG . LOC(OCT)
- S A4,0,A1
- J RETUR1
-
-#if (defined(CERNLIB_WBACK))&&(defined(CERNLIB_GUYDIAGP))&&(defined(CERNLIB_GUYFORT))
- INFO 010 3
-$(3) + 0776003,IRNDM
- + 0,SAVX11
- + 'IRNDM '
-#include "gerr_c.inc"
-SAVX11 RES 1
-#endif
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guysys/memor1.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guysys/memor1.s
deleted file mode 100644
index 6573ad5..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guysys/memor1.s
+++ /dev/null
@@ -1,65 +0,0 @@
-*
-* $Id: memor1.s,v 1.1.1.1 1996/02/15 17:54:08 mclareni Exp $
-*
-* $Log: memor1.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:08 mclareni
-* Kernlib
-*
-*
-. **************************************
-.
-. SUBROUTINE MEMOR1( LCUR, LFIRST, LLAST )
-. LCUR, LFIRST, LLAST ARE ABSOLUTE ADDRESSES
-#if defined(CERNLIB_GUYFORE)||defined(CERNLIB_GUYFORT)
-. * NO ATTEMPT TO PROVIDE A 'FTN COMPATIBLE' VERSION
-#endif
-.
-. **************************************
- AXR$
-. * NO FORT$ PROC: COMPILER DEPENDENT CODING
-
-MEMORC INFO 2 2
-$(2)
-LASTAD RES 1
-LIMABS RES 1
-
-$(1)
-MEMOR1*
-#if defined(CERNLIB_GUYFORT)||defined(CERNLIB_GUYFORE)
-. ----- FORTRAN 5 VERSION -----
- TZ,S1 0,X11
- J 0,X11 . NO ARG
- DL A1,0,X11 . LOC(LCUR), LOC(LFIRST)
- DL A3,LASTAD
- L,U A5,LASTD$+1
- S A3,0,A1 . LCUR
- TZ,S1 1,X11
- J 1,X11 . ONE ARG ONLY
- S A5,0,A2 . LFIRST
- TZ,S1 2,X11
- J 2,X11 . TWO ARGS ONLY
- L A0,2,X11 . LOC(LLAST)
- S A4,0,A0 . LAST
- TZ,S1 3,X11
- J 3,X11 . FORT
- J 4,X11 . FORE
-#endif
-#if defined(CERNLIB_GUYFTN)
-. ----- FTN VERSION -----
- L A5,A0
- SSL A5,18 . NARG
- JZ A5,0,X11 . RETURNS IF NO ARG
- DL A1,0,A0 . LOC(LCUR), LOC(LFIRST)
- DL A3,LASTAD
- S A3,0,A1
- TNE,U A5,1
- J 0,X11 . ONE ARG ONLY
- L,U A3,LASTD$+1
- S A3,0,A2
- TNE,U A5,2
- J 0,X11 . TWO ARGS ONLY
- L A0,2,A0 . LOC(LLAST)
- S A4,0,A0
- J 0,X11
-#endif
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guysys/memor2.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guysys/memor2.s
deleted file mode 100644
index c3df3a5..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guysys/memor2.s
+++ /dev/null
@@ -1,59 +0,0 @@
-*
-* $Id: memor2.s,v 1.1.1.1 1996/02/15 17:54:08 mclareni Exp $
-*
-* $Log: memor2.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:08 mclareni
-* Kernlib
-*
-*
-. **************************************
-.
-. FUNCTION MEMOR2( LADR )
-. * ASSUMES NO MCORE$ PERFORMED BY THE FTN LIBRARY, I.E THE IO BUFFER
-. * NEEDED BY FTN WAS PROVIDED BY USER (ELT F2FCA OF THE FTN LIBRARY)
-.
-. **************************************
-
- AXR$
- FORT$
-
-LIMSIZ EQU 0200000
-MSTEP EQU 010000
-
-MEMORC INFO 2 2
-$(2)
-LASTAD + LASTD$
-LIMABS + LIMSIZ-1
-
-$(1)
-MEMOR2*
- L A2,0,XARG . LOC( LADR )
- L A1,0,A2 . LADR
- SZ A0
- DI,U A0,MSTEP
- MSI,U A0,MSTEP
- A,U A0,MSTEP-1
- ANU A0,LASTAD
- JZ A1,RETUR1
- JN A1,LCOR0
-. ----- MCORE REQUESTED, CHECK LASTAD .LE. LIMABS
- L A4,LIMABS
- TLE,U A4,LASTD$
- S A0,LIMABS
- TG A0,LIMABS
- L A0,LIMABS
- S A0,LASTAD
- ER MCORE$
- J RETUR1
-. ----- CORE REDUCTION REQUESTED, CHECK LASTAD .GE. INITIAL USER SPACE LASTD$
-LCOR0 TLE,U A0,LASTD$
- J LCOR4
-LCOR2 S A0,LASTAD
- ER LCORE$
- J RETUR1
-LCOR4
- L,U A0,LASTD$
- TE A0,LASTAD
- J LCOR2
- J RETUR1
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guysys/memor3.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guysys/memor3.s
deleted file mode 100644
index f7929bb..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guysys/memor3.s
+++ /dev/null
@@ -1,74 +0,0 @@
-*
-* $Id: memor3.s,v 1.1.1.1 1996/02/15 17:54:08 mclareni Exp $
-*
-* $Log: memor3.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:08 mclareni
-* Kernlib
-*
-*
-. **************************************
-.
-. SUBROUTINE MEMOR3( LCUR, LFIRST, LLAST )
-. LCUR, LFIRST, LLAST ARE FORTRAN INDICES IN BLANK$COMMON
-#if defined(CERNLIB_GUYFORE)||defined(CERNLIB_GUYFORT)
-. * NO ATTEMPT TO PROVIDE A 'FTN COMPATIBLE' VERSION
-#endif
-.
-. **************************************
- AXR$
-. * NO FORT$ PROC: COMPILER DEPENDENT CODING
-
- INFO 4 4
-$(4),IQ RES 1
-
-MEMORC INFO 2 2
-$(2)
-LASTAD RES 1
-LIMABS RES 1
-
-$(1)
-MEMOR3*
-#if defined(CERNLIB_GUYFORT)||defined(CERNLIB_GUYFORE)
-. ----- FORTRAN 5 VERSION -----
- TZ,S1 0,X11
- J 0,X11 . NO ARG
- DL A1,0,X11 . LOC(LCUR), LOC(LFIRST)
- DL A3,LASTAD
- L,U A5,LASTD$+1
- AN,U A3,IQ-1
- S A3,0,A1 . LCUR
- TZ,S1 1,X11
- J 1,X11 . ONE ARG ONLY
- AN,U A5,IQ-1
- S A5,0,A2 . LFIRST
- TZ,S1 2,X11
- J 2,X11 . TWO ARGS ONLY
- L A0,2,X11 . LOC(LLAST)
- AN,U A4,IQ-1
- S A4,0,A0 . LAST
- TZ,S1 3,X11
- J 3,X11 . FORT
- J 4,X11 . FORE
-#endif
-#if defined(CERNLIB_GUYFTN)
-. ----- FTN VERSION -----
- L A5,A0
- SSL A5,18 . NARG
- JZ A5,0,X11 . RETURNS IF NO ARG
- DL A3,LASTAD
- DL A1,0,A0 . LOC(LCUR), LOC(LFIRST)
- AN,U A3,IQ-1
- S A3,0,A1
- TNE,U A5,1
- J 0,X11 . ONE ARG ONLY
- L,U A3,LASTD$+1
- AN,U A3,IQ-1
- S A3,0,A2
- TNE,U A5,2
- J 0,X11 . TWO ARGS ONLY
- L A0,2,A0 . LOC(LLAST)
- AN,U A4,IQ-1
- S A4,0,A0
- J 0,X11
-#endif
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guysys/memor4.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guysys/memor4.s
deleted file mode 100644
index e926540..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guysys/memor4.s
+++ /dev/null
@@ -1,66 +0,0 @@
-*
-* $Id: memor4.s,v 1.1.1.1 1996/02/15 17:54:08 mclareni Exp $
-*
-* $Log: memor4.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:08 mclareni
-* Kernlib
-*
-*
-. **************************************
-.
-. FUNCTION MEMOR4( LADR )
-. LADR AND THE FUNCTION VALUE ARE FORTRAN INDICES IN BLANK$COMMON
-. * ASSUMES NO MCORE$ PERFORMED BY THE FTN LIBRARY, I.E THE IO BUFFER
-. * NEEDED BY FTN WAS PROVIDED BY USER (ELT F2FCA OF THE FTN LIBRARY)
-.
-. **************************************
-
- AXR$
- FORT$
-
-LIMSIZ EQU 0200000
-MSTEP EQU 010000
-
- INFO 4 4
-$(4),IQ RES 1
-
-MEMORC INFO 2 2
-$(2)
-LASTAD + LASTD$
-LIMABS + LIMSIZ-1
-
-$(1)
-MEMOR4*
- L A2,0,XARG . LOC( LADR )
- L A1,0,A2 . LADR
- A,U A1,IQ-1
- SZ A0
- DI,U A0,MSTEP
- MSI,U A0,MSTEP
- A,U A0,MSTEP-1
- ANU A0,LASTAD
- JZ A1,MEXIT
- JN A1,LCOR0
-. ----- MCORE REQUESTED, CHECK LASTAD .LE. LIMABS
- L A4,LIMABS
- TLE,U A4,LASTD$
- S A0,LIMABS
- TG A0,LIMABS
- L A0,LIMABS
- S A0,LASTAD
- ER MCORE$
-MEXIT
- AN,U A0,IQ-1
- J RETUR1
-. ----- CORE REDUCTION REQUESTED, CHECK LASTAD .GE. INITIAL USER SPACE LASTD$
-LCOR0 TLE,U A0,LASTD$
- J LCOR4
-LCOR2 S A0,LASTAD
- ER LCORE$
- J MEXIT
-LCOR4
- L,U A0,LASTD$
- TE A0,LASTAD
- J LCOR2
- J MEXIT
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guysys/noarg.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guysys/noarg.s
deleted file mode 100644
index feec4d6..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guysys/noarg.s
+++ /dev/null
@@ -1,90 +0,0 @@
-*
-* $Id: noarg.s,v 1.1.1.1 1996/02/15 17:54:08 mclareni Exp $
-*
-* $Log: noarg.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:08 mclareni
-* Kernlib
-*
-*
-* .CONSIDERED OBSOLETE, BETTER USE HINTRFC$...
-#if defined(CERNLIB_NOARG)
-. *************************************
-.
-. SUBROUTINE NOARG( NARG ) *** Z 029 ***
-. * VERSION FOR FORTRAN COMPILER 11 A
-. THE FOLLOWING SEQUENCE
-. --- SUBROUTINE AAA( A,B,C,D,$,F,G) OR FUNCTION AAA( ... )
-. --- ...
-. --- CALL NOARG( I )
-. --- ...
-. --- RETURN
-. RETURNS I=NUMBER OF ARGUMENTS THE ROUTINE AAA IS CALLED WITH
-. AND PROVIDES A CORRECT RETURN THROUGH THE RETURN INSTRUCTION
-. * SHOULD NOT BE CALLED FROM THE MAIN PROGRAM
-. * STORE THE NUMBER OF ARGUMENTS+1 IN INJP$ OF ROUTINE AAA
-. * THEN YOU DON'T HAVE TO WORRY FOR THE RETURN INSTRUCTION
-. * NOARG MUST BE CALLED IF THE NUMBER OF ARGS. IS NOT CONSTANT
-.
-. *************************************
-
- AXR$
- FORT$
-$(1)
-NOARG*
- L,H2 A0,1,X11
- L,H2 A1,1,A0
- LXI,U A1,1
-N1 L,H1 A2,0,*A1
- JZ A2,N1
- TG,U A2,010000
- J N3
-N2 ANH A1,1,A0
- AN,U A0,2
- ANU,XU A1,1
- S,H2 A1,0,A0
- S,H2 A2,*0,X11
- J 2,X11
-N3 TE,U A2,0742000
- J N2
- J N1
-
-. ------------------
-
-. FUNCTION VAL( X )
-. ENTRY POINTS : IVAL,VAL,LVAL,DVAL,CVAL FOR INTEGER,REAL,LOGICAL,
-. DOUBLE PRECISION,COMPLEX ARGUMENTS
-. VAL = X
-. RETURN
-. END
-
-CVAL*
-DVAL*
-IVAL*
-LVAL*
-VAL*
- DL A0,*0,X11
- J 2,X11
- END
-#endif
-. **************************************
-.
-. SUBROUTINE NOARG( N )
-. COMMON/ HNOARG/ NARG
-. N = NARG
-. RETURN END
-.
-. **************************************
-
- AXR$
- FORT$
-
-HNOARG INFO 2 2
-$(2),NARG RES 1
-
-$(1)
-NOARG*
- L A2,0,XARG
- L A4,NARG
- S A4,0,A2
- J RETUR1
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guysys/print_.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guysys/print_.s
deleted file mode 100644
index 6fe3b59..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guysys/print_.s
+++ /dev/null
@@ -1,66 +0,0 @@
-*
-* $Id: print_.s,v 1.1.1.1 1996/02/15 17:54:08 mclareni Exp $
-*
-* $Log: print_.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:08 mclareni
-* Kernlib
-*
-*
-. *************************************
-.
-. SUBROUTINE PRINT( TEXT, NWORDS, NSKIP )
-. FIRST SKIP NSKIP LINES ON PRINT FILE,THEN PRINT NWORDS WORDS
-. STARTING AT ADDRESS TEXT
-. ALLOWED VALUES FOR NSKIP ARE +0 TO +63
-. * ERROR EXIT GERRB$ IF NWORDS.LT.-0 .OR. NWORDS.GT.22
-.
-. *************************************
-
- AXR$
- FORT$
- DO FOR ,MXWRD EQU 22
- DO FTN ,MXWRD EQU 33
- DO FOR ,PPRINT EQU PRINT$
- DO FTN ,PPRINT EQU APRINT$
-$(1),FIRS01
- + 'PRINT '
-PRINT*
-#include "ftnors1.inc"
-#include "spyuse.inc"
-* Ignoring t=pass
- DL A2,1,XARG . LOC(NW), LOC(NSKIP)
- L A0,0,XARG . LOC(TEXT)
- LN A2,0,A2 . -NWORDS
- LM A3,0,A3 . IABS(NSKIP)
- TLE,U A2,1
- TLE,XU A2,-MXWRD
-LMJER1 SLJ GERR$ . NWORDS OUT OF RANGE (0,MXWRD)
- LSSC A3,6
- AM A3,A2
- LXI A0,A3
- ER PPRINT
- J RETUR3
-
-#if (defined(CERNLIB_GUYDIAGP))&&(defined(CERNLIB_GUYFORT))
-. DIAGNOSTIC PACKETS FOR FORT
-#include "gerr_c.inc"
-F FORM 6,6,6,18
- INFO 010 03
-$(3)
-DIAG1 F 077,050,3,PRINT
- + 0,DYN$
- + 'PRINT '
- ON GERMAX
-DIAG2 F 077,067,2,0
- + LMJER1-FIRS01,DYN$
-DIAG3 F 077,047,LDIAG3,LMJER1+1
- + LDIAG3-2,DIAG2
- 'PRINT( A,NW,NS ),NW NOT WITHIN 0,22'
-LDIAG3 EQU $-DIAG3
- OFF
- ON GERMAX=0
-DIAG2 F 077,062,2,LMJER1+1
- + LMJER1-FIRS01,DIAG1
- OFF
-#endif
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guysys/punch_.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guysys/punch_.s
deleted file mode 100644
index f7c49bc..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guysys/punch_.s
+++ /dev/null
@@ -1,61 +0,0 @@
-*
-* $Id: punch_.s,v 1.1.1.1 1996/02/15 17:54:08 mclareni Exp $
-*
-* $Log: punch_.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:08 mclareni
-* Kernlib
-*
-*
-. ********************************
-.
-. SUBROUTINE PUNCH( TEXT, NWORDS )
-. PUNCHES CARD IMAGE TEXT(1) TO TEXT(NWORDS)
-. * ERROR EXIT GERRB$ IF NWORDS.LT.-0 .OR. NWORDS.GT.14
-.
-. ********************************
-
- AXR$
- FORT$
- DO FOR ,MXWRD EQU 14
- DO FTN ,MXWRD EQU 20
- DO FOR ,PPUNCH EQU PUNCH$
- DO FTN ,PPUNCH EQU APUNCH$
-$(1),FIRS01
- + 'PUNCH '
-PUNCH*
-#include "ftnors1.inc"
-#include "spyuse.inc"
-* Ignoring t=pass
- DL A0,0,XARG . LOC(TEXT), LOC(NW)
- LN A1,0,A1 . -NWORDS
- TLE,U A1,1
- TLE,XU A1,-MXWRD
-LMJER1 SLJ GERR$ . NWORDS OUT OF RANGE (0,MXWRD)
- LN A1,A1
- LXI A0,A1
- ER PPUNCH
- J RETUR2
-
-#if (defined(CERNLIB_GUYDIAGP))&&(defined(CERNLIB_GUYFORT))
-. DIAGNOSTIC PACKETS FOR FORT
-#include "gerr_c.inc"
-F FORM 6,6,6,18
- INFO 010 03
-$(3)
-DIAG1 F 077,050,3,PUNCH
- + 0,DYN$
- + 'PUNCH '
- ON GERMAX
-DIAG2 F 077,067,2,0
- + LMJER1-FIRS01,DYN$
-DIAG3 F 077,047,LDIAG3,LMJER1+1
- + LDIAG3-2,DIAG2
- 'PUNCH( A,N ),N NOT WITHIN 0,14'
-LDIAG3 EQU $-DIAG3
- OFF
- ON GERMAX=0
-DIAG2 F 077,062,2,LMJER1+1
- + LMJER1-FIRS01,DIAG1
- OFF
-#endif
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guysys/rannor.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guysys/rannor.s
deleted file mode 100644
index 0bbd35e..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guysys/rannor.s
+++ /dev/null
@@ -1,169 +0,0 @@
-*
-* $Id: rannor.s,v 1.1.1.1 1996/02/15 17:54:08 mclareni Exp $
-*
-* $Log: rannor.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:08 mclareni
-* Kernlib
-*
-*
-. $$$*****$$$*****$$$*****$$$*****
-.
-. SUBROUTINE RANNOR(A,B) *** V 100 ***
-. GENERATES TWO INDEPENDENT SET OF VALUES WITH NORMAL DISTRIBUTIONS(0,1)
-. METHOD: X AND Y ARE RANDOM NUMBERS UNIFORMLY DISTRIBUTED WITHIN 0,1
-. A = SIN(2.*PI*X)*SQRT(-2.*ALOG(Y))
-. B = COS(2.*PI*X)*SQRT(-2.*ALOG(Y))
-.
-. $$$*****$$$*****$$$*****$$$*****
-
- AXR$
- FORT$
-SLATE INFO 2 2
-$(2)
-COSI
-ARGCOS RES 1
-ARGSQRT
-ARGLOG RES 1
-SINI RES 1
- DO FTN ,SAVARG RES 2
-
-$(0)
-W +5 . AMORCE
-W1 +131071 . AMORCE FIXE POUR L'AMPLITUDE
-TWO +2.0
-T + 1220703125 . FACTEUR CONSTANT, 5**PREMIER
-DEUPI + 6.2831853072 . 2*PI
- ON FORE
-RANA + 'RANNOR'
-DYN$ + 0
- OFF
- ON FTN
-LOCARG2
-LOCARG1 + ARGCOS
-LOCARG4
-LOCARG3 + ARGLOG
- OFF . FTN
-
-$(1),FIRS01
-RANNOR*
-#include "ftnors1.inc"
-#include "spyuse.inc"
-* Ignoring t=pass
- DO FTN , DL A4,0,XARG . LOC(A), LOC(B)
- L A0,W . FACTEUR VARIABLE
- S,H2 X11,DYN$
- MSI A0,T . FACTEUR CONSTANT
- DO FTN , DS A4,SAVARG
- L,U A2,0170 . EXPOSANT POUR X.LT.1
- AND A0,(0377777777777) . ENLEVER LE SIGNE
- LA A4,W1 . 2-EME FACTEUR VARIABLE
- SA A1,W
- MSI A4,T . FACTEUR CONSTANT
- LCF A2,A1
- AND A4,(0377777777777) . ENLEVER LE SIGNE
- FM A3,DEUPI
- SA A5,W1
- SA A3,ARGCOS
- LCF A2,A5
- DO FTN , L,U A0,LOCARG1
- S A3,ARGLOG
- ON FORE++FORT**OPTR
-LMJSIN LMJ X11,SIN
- + ARGCOS
- DO FORE , + $-RANNOR-2,RANA
- DO NNOP , NOP
- OFF . FORE++FORT**OPTR
- ON FORT**(-OPTR)
- L,U A0,ARGCOS
- LXI,U X11,RMATH$
-LMJSIN LIJ X11,SIN$
- OFF . FORT**(-OPTR)
- ON FTN
-LMJSIN LMJ X11,SIN
- OFF . FTN
- S A0,SINI
- ON FORE++FORT**OPTR
-LMJCOS LMJ X11,COS
- + ARGCOS
- DO FORE , + $-RANNOR-2,RANA
- DO NNOP , NOP
- OFF . FORE++FORT**OPTR
- ON FORT**(-OPTR)
- L,U A0,ARGCOS
- LXI,U X11,RMATH$
-LMJCOS LIJ X11,COS$
- OFF . FORT**(-OPTR)
- ON FTN
- L,U A0,LOCARG2
-LMJCOS LMJ X11,COS
- OFF . FTN
- SA A0,COSI . COS(2*PI*N1)
- ON FORE++FORT**OPTR
-LMJLOG LMJ X11,ALOG
- + ARGLOG
- DO FORE , + $-RANNOR-2,RANA
- DO NNOP , NOP
- OFF . FORE++FORT**OPTR
- ON FORT**(-OPTR)
- L,U A0,ARGLOG
- LXI,U X11,RMATH$
-LMJLOG LIJ X11,ALOG$
- OFF . FORT**(-OPTR)
- ON FTN
- L,U A0,LOCARG3
-LMJLOG LMJ X11,ALOG
- OFF . FTN
- FM A0,TWO
- SNA A0,ARGSQRT . - ALOG(N2)
- ON FORE++FORT**OPTR
-LMJSQR LMJ X11,SQRT
- + ARGSQRT
- DO FORE , + $-RANNOR-2,RANA
- DO NNOP , NOP
- OFF . FORE++FORT**OPTR
- ON FORT**(-OPTR)
- L,U A0,ARGSQRT
- LXI,U X11,RMATH$
-LMJSQR LIJ X11,SQRT$
- OFF . FORT**(-OPTR)
- ON FTN
- L,U A0,LOCARG4
-LMJSQR LMJ X11,SQRT
- OFF . FTN
- L A2,A0
- L A4,A0
- L X11,DYN$
- FM A2,SINI
- DO FOR , DL A0,0,XARG
- DO FTN , DL A0,SAVARG
- FM A4,COSI
- S A2,0,A0 . A
- S A4,0,A1 . B
- J RETUR2
-
-. DIAGNOSTIC PACKETS FOR FORT
- ON FORT++FTN
-#include "gerr_c.inc"
- RES 1
- OFF .
- ON FORT
-F FORM 6,6,6,18
- INFO 010 03
-$(3)
-DIAG1 F 077,050,3,RANNOR
- + 0,DYN$
- + 'RANNOR'
- DO OPTR ,DIAG2 + 0776202,LMJSIN+1
- DO OPTR=0 ,DIAG2 + 0777302,LMJSIN+1
- + LMJSIN-FIRS01,DIAG1
- DO OPTR ,DIAG3 + 0776202,LMJCOS+1
- DO OPTR=0 ,DIAG3 + 0777302,LMJCOS+1
- + LMJCOS-FIRS01,DIAG1
- DO OPTR ,DIAG4 + 0776202,LMJLOG+1
- DO OPTR=0 ,DIAG4 + 0777302,LMJLOG+1
- + LMJLOG-FIRS01,DIAG1
- DO OPTR ,DIAG5 + 0776202,LMJSQR+1
- DO OPTR=0 ,DIAG5 + 0777302,LMJSQR+1
- + LMJSQR-FIRS01,DIAG1
- OFF
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guysys/read_.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guysys/read_.s
deleted file mode 100644
index 0a9b7c4..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guysys/read_.s
+++ /dev/null
@@ -1,39 +0,0 @@
-*
-* $Id: read_.s,v 1.1.1.1 1996/02/15 17:54:08 mclareni Exp $
-*
-* $Log: read_.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:08 mclareni
-* Kernlib
-*
-*
-. **************************************
-.
-. INTEGER FUNCTION DATAC( A,$ )
-. ONE CARD IMAGE IS COPIED FROM FILE READ$ TO USER ARRAY A
-. FUNCTION VALUE = NUMBER OF WORDS RECEIVED
-. ARRAY A IS SUPPOSED TO BE AT LEAST 14 WORDS LONG
-. * $ = EOF RETURN. *** THE STATUS IS COPIED INTO A(1), AND
-. * THE CALLING ROUTINE MAY THEN CHECK THE NATURE OF THE EOF ***
-. * FOR 'BLANK' CARDS ONE NORMALY RECEIVES DATAC=0
-. * STRIPS OFF THE FLAG FOR @ADDED CARD IMAGES
-.
-. **************************************
-
- AXR$
- FORT$
-$(1)
-DATAC*
-#include "ftnors1.inc"
-#include "spyuse.inc"
-* Ignoring t=pass
- L A3,XARG
- L A0,0,XARG . LOC( A )
- LXI,U A0,JEOF
- DO FOR , ER READ$
- DO FTN , ER AREAD$
- LXI,U A0,0
- J RETUR2
-JEOF DL A2,0,A3 . LOC( A ), LOC( $ )
- S A0,0,A2 . A(1) = STATUS
- J 0,A3
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/guysys/rndm.s b/src/packlib/kernlib/kerngen/obsolete/kernuni/guysys/rndm.s
deleted file mode 100644
index 762a19a..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/guysys/rndm.s
+++ /dev/null
@@ -1,74 +0,0 @@
-*
-* $Id: rndm.s,v 1.1.1.1 1996/02/15 17:54:08 mclareni Exp $
-*
-* $Log: rndm.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:08 mclareni
-* Kernlib
-*
-*
-. $$$*****$$$*****$$$*****$$$*****
-.
-. PSEUDO RANDOM NUMBERS *** V 104 ***
-. FUNCTION RNDM(X)
-. SUBROUTINE RDMOUT(OCT)
-. SUBROUTINE RDMIN(OCT)
-. SUBROUTINE INRNDM
-. $$$*****$$$*****$$$*****$$$*****
-.
-
- AXR$
- FORT$
-$(0)
-ININUM +12113 . AMORCE
-W + 12113 . FACTEUR VARIABLE
-T + 1220703125 . FACTEUR CONSTANT, 5**PREMIER
-$(1)
-. SUBROUTINE INRNDM RESETS THE VALUE OF THE GENERATOR TO THE INITIAL VALUE
-INRNDM*
-#include "ftnors1.inc"
-#include "spyuse.inc"
-* Ignoring t=pass
- L A0,ININUM
- S A0,W
- J RETUR0
-RNDM*
-#include "ftnors1.inc"
-#include "spyuse.inc"
-* Ignoring t=pass
- L A0,W
- MSI A0,T . FACTEUR CONSTANT
- AND A0,(0377777777777) . ENLEVER LE SIGNE
- SA A1,W
- LA,U A2,0170 . EXPOSANT POUR < 1
- LCF A2,A1
- SA A3,A0 . C'EST UNE FUNCTION
- J RETUR1
-. SUBROUTINE RDMIN( OCT ) REPLACES THE CURRENT VALUE OF THE GENERATOR BY
-. THE VALUE FOUND IN OCT
-RDMIN*
-#include "ftnors1.inc"
-#include "spyuse.inc"
-* Ignoring t=pass
- L A0,0,XARG . LOC(OCT)
- L A0,0,A0 . OCT = NEW VALUE OF GENERATOR
- S A0,W
- J RETUR1
-. SUBROUTINE RDMOUT( OCT ) STORES IN OCT THE CURRENT VALUE OF THE GENERATOR
-RDMOUT*
-#include "ftnors1.inc"
-#include "spyuse.inc"
-* Ignoring t=pass
- L A0,0,XARG . LOC(OCT)
- L A2,W
- S A2,0,A0 . CURRENT VALUE OF GENERATOR
- J RETUR1
-
-#if (defined(CERNLIB_WBACK))&&(defined(CERNLIB_GUYDIAGP))&&(defined(CERNLIB_GUYFORT))
- INFO 010 3
-$(3) + 0776003,RNDM
- + 0,SAVX11
- + 'RNDM '
-#include "gerr_c.inc"
-SAVX11 RES 1
-#endif
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/history/history.dat b/src/packlib/kernlib/kerngen/obsolete/kernuni/history/history.dat
deleted file mode 100644
index 479f56c..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/history/history.dat
+++ /dev/null
@@ -1,121 +0,0 @@
-*
-* $Id: history.dat,v 1.1.1.1 1996/02/15 17:53:52 mclareni Exp $
-*
-* $Log: history.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:53:52 mclareni
-* Kernlib
-*
-*
-* This directory was created from kernuni.car patch genuni
-#if !defined(CERNLIB_GENUNI)
-
-ASSEMBLER ROUTINES FOR UNIVAC 1100
-
----------------------------------------------------------------------
-
-THIS FILE CONTAINS TWO DIFFERENT SETS OF ROUTINES,CALLED GUNI AND GUY.
-'GUNI' ARE THE ROUTINES WHICH HAVE BEEN ON THE GENSEC PAM-FILE FOR
-SOME TIME, EXCEPT SOME BIT-HANDLING ROUTINES WHICH HAVE BEEN ADAPTED
-FROM THE ORSAY LIBRARY. THEY WORK ONLY WITH THE OLD 11A COMPILER.
-
-'GUY' ARE THE ROUTINES FROM THE ORSAY LIBRARY, RECEIVED SEPT. 1976.
-THEY WORK WITH THE NEW FTN COMPILER WITH THE O-OPTION, BUT ALSO
-WITH THE OLD COMPILERS.
-
-
----------------------------------------------------------------------
-GUNI : FOR USE WITH PROGRAMS COMPILED BY THE FORTRAN 'E' COMPILER
- STRAIGHT-FORWARD ROUTINES, MAINLY FROM COPENHAGEN
-
- PILOT: *GUNI
-
-
----------------------------------------------------------------------
-GUY : FOR USE WITH PROGRAMS COMPILED BY FORTRAN 'E', 'T' OR 'FTN' COMPILER
- ROUTINES FROM ORSAY/FRANCE
-
- PILOTS: *GUYFORE FOR FORTRAN V, VERSION 'E' (=11A)
- *GUYFORT FOR FORTRAN V, VERSION 'T' (=T2B)
- *GUYFTN FOR ASCII FORTRAN
-
-
- THESE ROUTINES REQUIRE THE PROCEDURE FORT$ DEFINED
- IN P=GUYFORT$, D=FORT$, SO YOU ALWAYS NEED:
-
- +ASM, 23, LUN=21, R=* . at PDP,IL FILE.*
- +EXE, GUYFORT$.
-
-
- MANY OF THESE ROUTINES CHECK ON THE PARAMETER VALUES AND
- BRANCH TO THE ENTRY POINT GERR$ FOR TROUBLE. YOU CAN
- LEAVE THIS AS AN UNSATISFIED EXTERNAL WHICH WILL NEVER BE
- NEEDED IF THE PROGRAM IS OK; YOU CAN +USE, GUY GERR$.
- WHICH PROVIDES DIAGNOSTICS, OR YOU CAN WRITE YOUR OWN.
- LOOK OUT, GERR$ IS NOT REACHED BY 'CALL' BUT BY SLJ.
-
-
- OPTIONS:
- -------
-
- +USE, U1108. FOR USE WITH 1106, 1108 MACHINES
- +USE, U1110. FOR USE WITH 1110, 1100/XX MACHINES
-
- +USE, COMPATIBL. ONLY FOR ORSAY-MODIFIED COMPILERS
-
-
- ONLY IF *GUYFORT IS SELECTED, ALSO:
-
- +USE, GUYOPTR. HAS THE SAME MEANING AS OPTION R IN @FOR,R
- = CALLS TO RMATH$ USE LMJ (DEFAULT IS LIJ)
- AND UNIVAC-PROVIDED INTERCEPT ROUTINES
- +USE, GUYNNOP. GENERATION OF A NOP INSTRUCTION ARGUMENT
- LISTS.
- +USE, GUYDIAGP. GENERATION OF DIAGNOSTIC PACKETS (FOR USE
- WITH GERR$)
- +USE, GUYGERMAX. EXTRA DIAGNOSTIC PACKETS, RELIES ON
- ORSAY-MODIFIED FORTRAN LIBRARY.
-
-
- FOR CONTACT: B. BOUQUET, LAB. ACC. LIN., UNIV. OF PARIS XI,
- F 91405 ORSAY
-
----------------------------------------------------------------------
-
-FIRST RELEASE OF THE GENUNI MINIPAM : 1-NOV-76
-
----------------------------------------------------------------------
-
-THIS FILE CONTAINS THE FOLLOWING PATCHES:
-
-*GUNI PILOT SELECTING 'GUNI' GENSEC
-
-*GUYFORE PILOT SELECTING 'GUY' GENSEC FOR VERSION 'E' OF FORTRAN V COMPILER
-
-*GUYFORT PILOT SELECTING 'GUY' GENSEC FOR VERSION 'T' OF FORTRAN V COMPILER
-
-*GUYFTN PILOT SELECTING 'GUY' GENSEC FOR ASCII FORTRAN COMPILER
-
-GUYFORT$ DEFINITION OF THE PROCEDURE FORT$ FOR GUY
-
-XVECTUNI UNIVAC VERSIONS OF XIN ROUTINES
-
-GUNI ALL 'GUNI' ROUTINES
-
-GUY ESSENTIAL 'GUY' ROUTINES:
- 1) NO FORTRAN VERSION EXISTING
- 2) FREQUENTLY USED ROUTINE, PRESUMABLY MUCH FASTER
- THAN THE FORTRAN VERSION IN P=TCGEN
-
-GUYF FURTHER 'GUY' ROUTINES, FOR WHICH THE FORTRAN VERSION
- MAY WELL BE JUST AS GOOD. IF YOU ARE COURAGEOUS, YOU TRY
- TO GET THEM OPERATIONAL; BUT BEFORE USING THEM YOU MUST BE
- QUITE SURE THEY WORK PERFECTLY.
-
-GUYSYS SPECIAL 'GUY' ROUTINES, NOT FORMALLY GENSEC
- HERE YOU CAN PICK INDIVIDUAL ROUTINES WHICH YOU NEED,
- BUT YOU MUST LOOK CAREFULLY AT LEAST AT THE COMMENTS
- IN THE CODE.
-
-GUYERR$ ORSAY ERROR HANDLING
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/history/updates.dat b/src/packlib/kernlib/kerngen/obsolete/kernuni/history/updates.dat
deleted file mode 100644
index aeb6df3..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/history/updates.dat
+++ /dev/null
@@ -1,65 +0,0 @@
-*
-* $Id: updates.dat,v 1.1.1.1 1996/02/15 17:53:52 mclareni Exp $
-*
-* $Log: updates.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:53:52 mclareni
-* Kernlib
-*
-*
-#if !defined(CERNLIB_GENUNI)
-
----------------------------------------------------------------------
-UPDATES FOR VERSION 1.02 15-DEC-76
-
-P=GUNI, D=ASORTZ,CLOKZB,DATEZB,ISORTZ,IZZA,SORTZV,TIMEZB,TIMEZZ
- CORRECT FAULTY HEADING COMMENT CARDS
-
----------------------------------------------------------------------
-UPDATES FOR VERSION 1.03 17-JAN-77
-
-FINAL CLEAN-UP CORRECTIONS, FEED-BACK FROM ORSAY:
-
-P=GENUNI, D=JBYTET
-
-P=GUY, D=,INCBYT,IUCOMP,JBYTET,JBYTPK,LOCF,LVMAX,LVMINA,PKBYT,SBYTPK,UBLANK
- D=UCOCOP,UCOPIV,UPKBYT,USWOP,VLINE,VMATL,VMAX,VMIN,VMINA,VMUL,VSCALE,VSUM
- ALSO: ALL DECKS HEADING COMMENTS CHANGED
-
-P=GUYSYS, D=DUMMY,IRNDM,RANNOR,READ$,RNDM
-
-P=GUYGERR$
-
-NEW ROUTINES FROM ORSAY:
-
-P=GUY, D=LORENB,LORENF,VADD,VSUM
-
----------------------------------------------------------------------
-UPDATES FOR VERSION 1.04 21-MAR-78
-
-JRSBYT FROM ORSAY TURNED OUT TO BE WRONG,
-BRING BACK THE OLD COPENHAGEN VERSION INTO BOTH P=GUNI AND P=GUY
-
----------------------------------------------------------------------
-UPDATES FOR VERSION 1.05 24-FEB-81
-
-ALL GUY PATCHES HAVE BEEN RE-IMPORTED FROM ORSAY, WITH
-SOME PATCH NAMES CHANGED.
-
-OBSOLETE ROUTINES SUPPRESSED: P=GUNI, D=CLOKZB, TIMEZB, TIMEZZ
-
----------------------------------------------------------------------
-UPDATES FOR VERSION 1.06 12-FEB-82
-
-ADD +USE,QMUNI OR QMUNO TO THE PILOTS
-
-NEW DECKS: GSHOW
-
-DISABLE JRSBYT IN P=GUY WHICH HAS A BUG
-
-OBSOLETE ROUTINE SUPPRESSED: P=GUNI, D=DATEZB,IZZA
----------------------------------------------------------------------
-UPDATES FOR VERSION 1.07 19-JAN-83
-
-NEW PATCH : XVECTUNI
----------------------------------------------------------------------
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/inhibit.list b/src/packlib/kernlib/kerngen/obsolete/kernuni/inhibit.list
deleted file mode 100644
index 72eae22..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/inhibit.list
+++ /dev/null
@@ -1,144 +0,0 @@
-xvect/xinb
-xvect/xinbs
-tcgen/gshow
-tcgen/abend
-tcgen/cbyt
-tcgen/datime
-tcgen/datimh
-tcgen/erf
-tcgen/freq
-tcgen/incbyt
-tcgen/intsor
-tcgen/iubin
-tcgen/iuchan
-tcgen/iucomp
-tcgen/iufind
-tcgen/iuhunt
-tcgen/jbit
-tcgen/jbyt
-tcgen/jbytet
-tcgen/jbytpk
-tcgen/jrsbyt
-tcgen/locbyt
-tcgen/locf
-tcgen/pkbyt
-tcgen/prob
-tcgen/sbit
-tcgen/sbit0
-tcgen/sbit1
-tcgen/sbyt
-tcgen/sbytor
-tcgen/sbytpk
-tcgen/sortzv
-tcgen/timed
-tcgen/timel
-tcgen/timex
-tcgen/ublank
-tcgen/ufill
-tcgen/uzero
-tcgen/ublow
-tcgen/ubunch
-tcgen/ucocop
-tcgen/ucopy
-tcgen/ucopy2
-tcgen/ucopiv
-tcgen/ucopyn
-tcgen/upkbyt
-tcgen/vblank
-tcgen/vfill
-tcgen/vzero
-guy/jrsbyt
-tcgen/gshow
-tcgen/abend
-tcgen/cbyt
-tcgen/datime
-tcgen/datimh
-tcgen/incbyt
-tcgen/iubin
-tcgen/iuhist
-tcgen/iuchan
-tcgen/iucomp
-tcgen/iufind
-tcgen/jbit
-tcgen/jbyt
-tcgen/jbytet
-tcgen/jbytpk
-tcgen/jrsbyt
-tcgen/locbyt
-tcgen/locf
-tcgen/pkbyt
-tcgen/sbit
-tcgen/sbit0
-tcgen/sbit1
-tcgen/sbyt
-tcgen/sbytor
-tcgen/sbytpk
-tcgen/sortzv
-tcgen/timed
-tcgen/timel
-tcgen/timex
-#if defined(CERNLIB_GUYFORT)||defined(CERNLIB_GUYFTN)
-tcgen/traceq
-#endif
-tcgen/ublank
-tcgen/ufill
-tcgen/uzero
-tcgen/ublow
-tcgen/ubunch
-tcgen/ucopy
-tcgen/ucopy2
-tcgen/uopt
-tcgen/upkbyt
-tcgen/uswop
-tcgen/vblank
-tcgen/vfill
-tcgen/vzero
-tcgen/amaxmu
-tcgen/atg
-tcgen/cross
-tcgen/erf
-tcgen/freq
-tcgen/iuhunt
-tcgen/iulast
-tcgen/iusame
-tcgen/lorenb
-tcgen/lorenf
-tcgen/loren4
-tcgen/lvmax
-tcgen/lvmaxa
-tcgen/lvmin
-tcgen/lvmina
-tcgen/mxequ
-tcgen/mxmlrt
-tcgen/mxmpy
-tcgen/mxtrp
-tcgen/mxuty
-tcgen/proxim
-tcgen/rot
-tcgen/ucocop
-tcgen/ucopiv
-tcgen/ucopyn
-tcgen/vcopyn
-tcgen/udicop
-tcgen/vadd
-tcgen/vsub
-tcgen/vasum
-tcgen/vbias
-tcgen/vdist
-tcgen/vdot
-tcgen/vdotn
-tcgen/vmod
-tcgen/vdotn2
-tcgen/vfix
-tcgen/vfloat
-tcgen/vline
-tcgen/vmatl
-tcgen/vmatr
-tcgen/vmax
-tcgen/vmaxa
-tcgen/vmin
-tcgen/vmina
-tcgen/vmul
-tcgen/vscale
-tcgen/vsum
-tcgen/vunit
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/kernuni/guy.h b/src/packlib/kernlib/kerngen/obsolete/kernuni/kernuni/guy.h
deleted file mode 100644
index 3700216..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/kernuni/guy.h
+++ /dev/null
@@ -1,13 +0,0 @@
-*
-* $Id: guy.h,v 1.1.1.1 1996/02/15 17:53:52 mclareni Exp $
-*
-* $Log: guy.h,v $
-* Revision 1.1.1.1 1996/02/15 17:53:52 mclareni
-* Kernlib
-*
-*
-* This directory was created from kernuni.car patch guy
-* THERE IS A FAULT !!
-#ifdef CERNLIB_GUY_JRSBYT
-#undef CERNLIB_GUY_JRSBYT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/kernuni/xvectuni.h b/src/packlib/kernlib/kerngen/obsolete/kernuni/kernuni/xvectuni.h
deleted file mode 100644
index 113111e..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/kernuni/xvectuni.h
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: xvectuni.h,v 1.1.1.1 1996/02/15 17:53:53 mclareni Exp $
-*
-* $Log: xvectuni.h,v $
-* Revision 1.1.1.1 1996/02/15 17:53:53 mclareni
-* Kernlib
-*
-*
-* This directory was created from kernuni.car patch xvectuni
-#ifndef CERNLIB_XVECT
-#define CERNLIB_XVECT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/xvectuni/xinb.F b/src/packlib/kernlib/kerngen/obsolete/kernuni/xvectuni/xinb.F
deleted file mode 100644
index 2bfb8a1..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/xvectuni/xinb.F
+++ /dev/null
@@ -1,35 +0,0 @@
-*
-* $Id: xinb.F,v 1.1.1.1 1996/02/15 17:53:56 mclareni Exp $
-*
-* $Log: xinb.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:56 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE XINB (LUN,XBV,NXB)
-C
-C CERN PROGLIB# Z203 XINB .VERSION KERNUNI 1.07 830120
-C
- DIMENSION XBV(99)
-
-#if defined(CERNLIB_F77)
- READ (LUN,END=61,ERR=64) N, (XBV(J),J=1,MIN0(N,NXB))
- N = MIN0 (N,NXB)
-#endif
-#if !defined(CERNLIB_F77)
- READ (LUN,END=61,ERR=64) N, (XBV(J),J=1,N)
-#endif
- NXB = MAX0 (N,1)
- RETURN
-
- 61 NXB = 0
- RETURN
-
- 64 NXB = -7
- RETURN
- END
-#ifdef CERNLIB_XVECT_XINB
-#undef CERNLIB_XVECT_XINB
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernuni/xvectuni/xinbs.F b/src/packlib/kernlib/kerngen/obsolete/kernuni/xvectuni/xinbs.F
deleted file mode 100644
index 1297c46..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernuni/xvectuni/xinbs.F
+++ /dev/null
@@ -1,35 +0,0 @@
-*
-* $Id: xinbs.F,v 1.1.1.1 1996/02/15 17:53:56 mclareni Exp $
-*
-* $Log: xinbs.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:56 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE XINBS (LUN,XAV,NA,XBV,NXB)
-C
-C CERN PROGLIB# Z203 XINBS .VERSION KERNUNI 1.07 830120
-C
- DIMENSION XBV(99), XAV(NA)
-
-#if defined(CERNLIB_F77)
- READ (LUN,END=61,ERR=64) N,XAV,(XBV(J),J=1,MIN0(N,NXB))
- N = MIN0 (N,NXB)
-#endif
-#if !defined(CERNLIB_F77)
- READ (LUN,END=61,ERR=64) N,XAV,(XBV(J),J=1,N)
-#endif
- NXB = MAX0 (N,1)
- RETURN
-
- 61 NXB = 0
- RETURN
-
- 64 NXB = -7
- RETURN
- END
-#ifdef CERNLIB_XVECT_XINBS
-#undef CERNLIB_XVECT_XINBS
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernvax/vaxgs/vxinvb.F b/src/packlib/kernlib/kerngen/obsolete/kernvax/vaxgs/vxinvb.F
deleted file mode 100644
index 685dfca..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernvax/vaxgs/vxinvb.F
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: vxinvb.F,v 1.1.1.1 1996/02/15 17:54:19 mclareni Exp $
-*
-* $Log: vxinvb.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:19 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE VXINVB (MV,NW)
-
-C CERN PROGLIB# M434 VXINVB .VERSION KERNVAX 2.23 870612
-C ORIG. 12-June-87, F. Carminati + J. Zoll
-
-C- VX invert bytes, in-place
-C- Fortran version, slower than the machine-language routine
-
- DIMENSION MV(99)
- LOGICAL*1 LLD(4), LST(4)
- EQUIVALENCE (LLD,MLD), (LST,MST)
-
- DO 29 J=1,NW
- MLD = MV(J)
- LST(1) = LLD(4)
- LST(2) = LLD(3)
- LST(3) = LLD(2)
- LST(4) = LLD(1)
- MV(J) = MST
- 29 CONTINUE
- END
-#ifdef CERNLIB_TCGEN_VXINVB
-#undef CERNLIB_TCGEN_VXINVB
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernvax/vaxgs/vxinvc.F b/src/packlib/kernlib/kerngen/obsolete/kernvax/vaxgs/vxinvc.F
deleted file mode 100644
index 26a239e..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernvax/vaxgs/vxinvc.F
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: vxinvc.F,v 1.1.1.1 1996/02/15 17:54:19 mclareni Exp $
-*
-* $Log: vxinvc.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:19 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE VXINVC (MVI,MVX,NW)
-
-C CERN PROGLIB# M434 VXINVC .VERSION KERNVAX 2.23 870612
-C ORIG. 12-June-87, F. Carminati + J. Zoll
-
-C- VX invert bytes and copy
-C- Fortran version, slower than the machine-language routine
-
- DIMENSION MVI(99), MVX(99)
- LOGICAL*1 LLD(4), LST(4)
- EQUIVALENCE (LLD,MLD), (LST,MST)
-
- DO 29 J=1,NW
- MLD = MVI(J)
- LST(1) = LLD(4)
- LST(2) = LLD(3)
- LST(3) = LLD(2)
- LST(4) = LLD(1)
- MVX(J) = MST
- 29 CONTINUE
- END
-#ifdef CERNLIB_TCGEN_VXINVC
-#undef CERNLIB_TCGEN_VXINVC
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernvax/vaxutil/akmult.F b/src/packlib/kernlib/kerngen/obsolete/kernvax/vaxutil/akmult.F
deleted file mode 100644
index ffb518d..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernvax/vaxutil/akmult.F
+++ /dev/null
@@ -1,84 +0,0 @@
-*
-* $Id: akmult.F,v 1.1.1.1 1996/02/15 17:54:18 mclareni Exp $
-*
-* $Log: akmult.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:18 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- PROGRAM AKMULT
-C
-C CERN PROGLIB# AKMULT .VERSION KERNVAX 2.30 881021
-C ORIG. 28/06/82 M.L.LUVISETTO, CNAF BOLOGNA
-C MOD. 30/06/82 JZ
-C
-C SPLIT MULTI-ROUTINES MACRO FILES
-C
-C-- THE FOLLOWING FILES ARE INVOLVED :
-
-C AKMUIN.MAR THE MULTI-ROUTINE INPUT FILE, EACH ROUTINE
-C MUST START WITH A LINE '.TITLE' IN COL 2 !
-
-C AKMUEX.MAR RECEIVES THE FIRST ROUTINE
-C AKM0JJ.MAR RECEIVES ROUTINE NUMBER JJ
-C
-C AKMUEX.COM IS THE COM-FILE TO ASSEMBLE ALL ROUTINES
-C ONTO AKMUEX.OBJ
-C
- CHARACTER LINE*80
- +,FLN*12 /'AKM000.MAR'/
- +,BEGRUT*8 /' .TITLE '/
- +,ENDLINE*80 /' .END'/
- +,MAC_COM*80 /'$ MACRO AKMUEX'/
- +,APD_COM*80 /'$ APPEND AKM000.OBJ AKMUEX.OBJ'/
- +,DEL_COM*80 /'$ DELETE AKM0*.*;*,AKMUEX.MAR;*/NOLOG/NOCONF'/
-C ....+....1....+....2....+....3
- PARAMETER (LUNIN=1 , LUNOUT=2 , LUNCOM=33)
- DATA NEOF / 0 /, JFILE / 1 /
-C
- 8000 FORMAT (A)
-C
-
- TYPE 9001
- 9001 FORMAT (' AKMULT EXECUTION USES :'/
- +' INPUT FILE AKMUIN.MAR WITH .TITLE IN COL 2 !'/
- +' OUTPUT FILE AKMUEX.COM TO EXECUTE ASSEMBLIES ONTO'/
- +' RESULT FILE AKMUEX.OBJ')
-
- OPEN (UNIT=LUNIN,FILE='AKMUIN.MAR',TYPE='OLD',READONLY)
- OPEN (UNIT=LUNCOM,FILE='AKMUEX.COM',TYPE='NEW'
- +, CARRIAGECONTROL='NONE')
-
- 22 READ(LUNIN,8000,END=99) LINE
- IF (LINE(1:8).NE.BEGRUT) GO TO 22
- OPEN (UNIT=LUNOUT,FILE='AKMUEX.MAR',TYPE='NEW'
- +, CARRIAGECONTROL='NONE')
- WRITE(LUNCOM,8000) MAC_COM
- GO TO 43
-
- 31 JFILE = JFILE+1
- NUNI = MOD(JFILE,10)
- NTEN = JFILE/10
- FLN(5:6)=CHAR(NTEN+48)//CHAR(NUNI+48)
- OPEN (UNIT=LUNOUT,FILE=FLN,TYPE='NEW',CARRIAGECONTROL='NONE')
- MAC_COM(10:30)=FLN(1:6)
- APD_COM(11:16)=FLN(1:6)
- WRITE(LUNCOM,8000) MAC_COM
- WRITE(LUNCOM,8000) APD_COM
- GO TO 43
-
- 41 READ(LUNIN,8000,END=46) LINE
- IF (LINE(1:8).EQ.BEGRUT) GO TO 47
- 43 WRITE(LUNOUT,8000) LINE
- GO TO 41
-
- 46 NEOF = 7
- 47 WRITE(LUNOUT,8000) ENDLINE
- CLOSE(LUNOUT)
- IF (NEOF.EQ.0) GO TO 31
-
- 99 WRITE(LUNCOM,8000) DEL_COM
- STOP
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernvax/vaxutil/cd.F b/src/packlib/kernlib/kerngen/obsolete/kernvax/vaxutil/cd.F
deleted file mode 100644
index 0bb7fa0..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernvax/vaxutil/cd.F
+++ /dev/null
@@ -1,175 +0,0 @@
-*
-* $Id: cd.F,v 1.1.1.1 1996/02/15 17:54:18 mclareni Exp $
-*
-* $Log: cd.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:18 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- PROGRAM CD
-C
-C CERN PROGLIB# CD .VERSION KERNVAX 2.45 940228
-C ORIG. 31/07/90, Julius Zoll
-C MODIF. 24/02/94, JZ, to try ./ ../ ~/ name
-C
-C- Program to set the current directory using Unix style
-
- COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT,DUMMY(36)
- CHARACTER CWD*256, TEXT*256, CHINQ*256
- CHARACTER LINE*256, COLM(256)*1
- EQUIVALENCE (LINE,COLM)
- INTEGER*2 LGPAR2
- LOGICAL THERE
-
-
-C! CHARACTER ORG*256
-C! CALL GETWDF (ORG)
-C! NORG = NDSLAT
-C! CALL FFRVAX (ORG,NORG)
-C!
-C! 11 CALL TMPRO (' dir > ')
-C! CALL TMREAD (80, LINE, NNL, ISTAT)
-C! IF (ISTAT.NE.0) THEN
-C! CALL FTOVAX (ORG,NORG)
-C! CALL CHDIRF (ORG(1:NORG))
-C! STOP
-C! ENDIF
-
- IRC = 1
- CALL LIB$GET_FOREIGN (LINE,,LGPAR2)
- NNL = LGPAR2
- IF (NNL.LE.0) GO TO 67
-
- CALL GETWDF (CWD)
- NCWD = NDSLAT
- CALL FFRVAX (CWD,NCWD)
-
- JX = ICNEXT (LINE,1,NNL)
- IF (NDSLAT.EQ.0) GO TO 67
- NNL = NESLAT - 1
- CALL CLEFT (LINE,1,NNL)
- NNL = NDSLAT
- IF (NNL.EQ.1) THEN
- IF (COLM(1).EQ.'?') GO TO 81
- IF (COLM(1).EQ.'.') GO TO 67
- ENDIF
-
- CALL FFRVAX (LINE,NNL)
- IF (NDSLAT.LT.0) GO TO 61
- IF (COLM(NNL).NE.'/') THEN
- NNL = NNL + 1
- COLM(NNL) = '/'
- ENDIF
-
- CALL FTOVAX (LINE,NNL)
- IF (NDSLAT.LT.0) GO TO 61
- CALL FFRVAX (LINE,NNL)
- IF (NDSLAT.LT.0) GO TO 61
-C PRINT 9014, LINE(1:NNL)
-C9014 FORMAT (' FFRVAX returns ',A)
-
- IF (LINE(1:2).EQ.'./') THEN
- IF (NNL.EQ.2) GO TO 67
- ENDIF
-
- IF (COLM(1).EQ.'/') GO TO 51
- IF (COLM(1).EQ.'.') GO TO 51
-
-C---- check existence
-
- TEXT = LINE
- NTX = NNL
-
- NNL = NTX + NCWD
- LINE(1:NNL) = CWD(1:NCWD) // TEXT(1:NTX)
-
-C-- try ./name
-
- JSLA = 0
- 42 JSLA = ICFIND ('/', LINE,JSLA+1,NNL)
- IF (LINE(JSLA:JSLA+1).EQ.'//') GO TO 42
- IF (LINE(JSLA:JSLA+1).EQ.'/=') GO TO 42
-
- NINQ = NNL + 3
- CHINQ(1:NINQ) = LINE(1:NNL-1) // '.DIR'
-
- CALL FTOVAX (CHINQ,NINQ)
- INQUIRE (FILE=CHINQ(1:NINQ), EXIST=THERE)
-C PRINT *, ' Inquire for file ',CHINQ(1:NINQ),' is', THERE
-
- IF (THERE) GO TO 51
-
-C-- try ../name
-
- JSLP = ICFILA ('/', LINE,1,NCWD-1)
- IF (JSLP.EQ.JSLA) GO TO 46
- LINE(JSLP+1:JSLP+NTX) = TEXT(1:NTX)
- NNL = JSLP + NTX
- NINQ = NNL + 3
- CHINQ(1:NINQ) = LINE(1:NNL-1) // '.DIR'
-
- CALL FTOVAX (CHINQ,NINQ)
- INQUIRE (FILE=CHINQ(1:NINQ), EXIST=THERE)
-C PRINT *, ' Inquire for file ',CHINQ(1:NINQ),' is', THERE
-
- IF (THERE) GO TO 51
-
-C-- try ~/name
-
- 46 NNL = NTX + 2
- LINE(1:NNL) = '~/' // TEXT(1:NTX)
- NINQ = NNL + 3
- CHINQ(1:NINQ) = LINE(1:NNL-1) // '.DIR'
-
- CALL FTOVAX (CHINQ,NINQ)
- INQUIRE (FILE=CHINQ(1:NINQ), EXIST=THERE)
-C PRINT *, ' Inquire for file ',CHINQ(1:NINQ),' is', THERE
-
- IF (THERE) GO TO 51
-
- PRINT 9049, TEXT(1:NTX-1)
- 9049 FORMAT (' !! None of ./ ../ ~/ ',A,' found !!')
- GO TO 62
-
-
-C---- Set the directory
-
- 51 CALL FTOVAX (LINE,NNL)
- IF (NDSLAT.LT.0) GO TO 61
-C PRINT 9054, LINE(1:NNL)
-C9054 FORMAT (' FTOVAX returns ',A)
-
- CALL CHDIRF (LINE(1:NNL))
-C PRINT 9801, LINE(1:NNL)
-C9801 FORMAT (' CHDIR entered with >',A,'<')
- GO TO 67
-
- 61 PRINT *, ' !! Faulty syntax !!'
- 62 IRC = 4
- 67 CALL GETWDF (LINE)
- NNL = NDSLAT
- PRINT 9067, LINE(1:NNL)
- 9067 FORMAT (' c.d. = ',A)
- GO TO 99
-
- 81 PRINT 9081
- 9081 FORMAT (/' You may give for example :'/
- F/' Go down: cd patchy/install'
- F/' Go up + over: cd ../log'
- F/' cd .../kern/install'
- F/' Go home + down: cd ~/pam/patchy'
- F/' Go elsewhere: cd /lib/patchy/install'
- F/' cd /=disk$cr/lib/patchy/install'
- F/' cd //vxcern/=disk$cr/lib/patchy/install'/
- F/' As on Unix, if you give:'/
- F/' cd patchy/install'/
- F/' we will try: ./patchy/install'
- F/' ../patchy/install'
- F/' ~/patchy/install'
- F/' Good luck.'/)
- 99 CONTINUE
- CALL SYS$EXIT (%VAL(IRC))
-C! GO TO 11
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernvmi/vmigs/Imakefile b/src/packlib/kernlib/kerngen/obsolete/kernvmi/vmigs/Imakefile
deleted file mode 100644
index 37d28ed..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernvmi/vmigs/Imakefile
+++ /dev/null
@@ -1,4 +0,0 @@
-SRCS_S= \ @@\
- jumpxn.s longjmp.s setjmp.s
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernvmi/vmigs/jumpxn.s b/src/packlib/kernlib/kerngen/obsolete/kernvmi/vmigs/jumpxn.s
deleted file mode 100644
index dee7330..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernvmi/vmigs/jumpxn.s
+++ /dev/null
@@ -1,94 +0,0 @@
-*
-* $Id: jumpxn.s,v 1.1.1.1 1996/02/15 17:54:20 mclareni Exp $
-*
-* $Log: jumpxn.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:20 mclareni
-* Kernlib
-*
-*
- #
- #CERN PROGLIB# Z042 JUMPXN .VERSION KERNVMI 1.01 891208
- #ORIG. 8/11/89 R.WARREN
- #
- .verstamp 1 31
- .lcomm $$6 4
- .lcomm $$7 4
- .text
- .align 2
- .file 2 "jumpxq.f"
- .globl jumpad_
- .loc 2 3
- .ent jumpad_ 2
-jumpad_:
- .option O1
- subu $sp, 48
- sw $31, 20($sp)
- .mask 0x80000000, -28
- .frame $sp, 48, $31
- b $37
-$32:
- .loc 2 5
- .set volatile
- lw $4, 28($sp)
- .set novolatile
- jal locb_
- sw $2, 40($sp)
- b $36
- .globl jumpst_
- .aent jumpst_ 2
-jumpst_:
- subu $sp, 48
- sw $31, 20($sp)
- sw $4, 48($sp)
- b $38
-$33:
- .loc 2 8
- .loc 2 9
- .set volatile
- lw $14, 28($sp)
- .set novolatile
- lw $15, 0($14)
- sw $15, $$7
- b $36
- .globl jumpxq_
- .aent jumpxq_ 2
-jumpxq_:
- .globl jumpx0_
- .aent jumpx0_ 2
-jumpx0_:
- .globl jumpx1_
- .aent jumpx1_ 2
-jumpx1_:
- .globl jumpx2_
- .aent jumpx2_ 2
-jumpx2_:
- .loc 2 15
- lw $24, $$7
- j $24
-$35:
- .lab $$6
-$36:
- .loc 2 17
- lw $2, 40($sp)
- b $39
-$37:
- sw $4, 28($sp)
- b $32
-$38:
- lw $4, 48($sp)
- sw $4, 28($sp)
- b $33
- .endb 12
- .endb 13
- .endb 14
-$39:
- lw $31, 20($sp)
- addu $sp, 48
- j $31
- .end jumpad_
-#ifdef CERNLIB_CCGEN_JUMPXN
-#undef CERNLIB_CCGEN_JUMPXN
-#endif
-#ifdef CERNLIB_TCGEN_JUMPXN
-#undef CERNLIB_TCGEN_JUMPXN
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernvmi/vmigs/longjmp.s b/src/packlib/kernlib/kerngen/obsolete/kernvmi/vmigs/longjmp.s
deleted file mode 100644
index 3d35265..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernvmi/vmigs/longjmp.s
+++ /dev/null
@@ -1,43 +0,0 @@
-*
-* $Id: longjmp.s,v 1.1.1.1 1996/02/15 17:54:20 mclareni Exp $
-*
-* $Log: longjmp.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:20 mclareni
-* Kernlib
-*
-*
- .text
- #
- #CERN PROGLIB# LONGJMP .VERSION KERNVMI 1.01 891208
- #ORIG. 8/11/89 R.WARREN
- #
- .align 2
- .globl longjmp_
- .loc 2 11
- .ent longjmp_ 2
-longjmp_:
- .option O1
- subu $sp, 32
- sw $31, 20($sp)
- sd $4, 32($sp)
- .mask 0x80000000, -12
- .frame $sp, 32, $31
- .loc 2 12
- lw $14, 36($sp)
- lw $15, 0($14)
- sw $15, 28($sp)
- .loc 2 13
- lw $4, 32($sp)
- move $5, $15
- jal longjmp
- .loc 2 14
- lw $31, 20($sp)
- addu $sp, 32
- j $31
- .end longjmp_
-#ifdef CERNLIB_CCGEN_LONGJMP
-#undef CERNLIB_CCGEN_LONGJMP
-#endif
-#ifdef CERNLIB_TCGEN_LONGJMP
-#undef CERNLIB_TCGEN_LONGJMP
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernvmi/vmigs/setjmp.s b/src/packlib/kernlib/kerngen/obsolete/kernvmi/vmigs/setjmp.s
deleted file mode 100644
index a4d786b..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernvmi/vmigs/setjmp.s
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: setjmp.s,v 1.1.1.1 1996/02/15 17:54:20 mclareni Exp $
-*
-* $Log: setjmp.s,v $
-* Revision 1.1.1.1 1996/02/15 17:54:20 mclareni
-* Kernlib
-*
-*
- .text
- #
- #CERN PROGLIB# SETJMP .VERSION KERNVMI 1.01 891208
- #ORIG. 8/11/89 R.WARREN
- #
- .align 2
- .globl setjmp_
- .loc 2 5
- .ent setjmp_ 2
-setjmp_:
- .option O1
- j setjmp
- sw $4, 0($sp)
- .frame $sp, 0, $31
- .loc 2 6
- j $31
- .end setjmp_
-#ifdef CERNLIB_CCGEN_SETJMP
-#undef CERNLIB_CCGEN_SETJMP
-#endif
-#ifdef CERNLIB_TCGEN_SETJMP
-#undef CERNLIB_TCGEN_SETJMP
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernvmi/vmiobsol/qnexte.F b/src/packlib/kernlib/kerngen/obsolete/kernvmi/vmiobsol/qnexte.F
deleted file mode 100644
index 593aaec..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernvmi/vmiobsol/qnexte.F
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: qnexte.F,v 1.1.1.1 1996/02/15 17:54:19 mclareni Exp $
-*
-* $Log: qnexte.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:19 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE QNEXTE
-C
-C CERN PROGLIB# Z041 QNEXTE .VERSION KERNVMI 1.01 891208
-C ORIG. 12/10/89 K.M.STORR from Apollo version
-C
- SAVE MAREA
- DIMENSION MAREA(16)
- DATA MAREA / 16*0 /
-
- IF (MAREA(1).EQ.0) GO TO 21
-C
-C-- RE-ENTRY
-C
- CALL LONGJMP (MAREA(2),J)
-C
-C-- FIRST ENTRY
-C
- 21 MAREA(1) = 77
- CALL SETJMP (MAREA(2))
-C
-C-- GO DOWN
-C
- CALL QNEXT
- RETURN
- END
-#ifdef CERNLIB_CCGEN_QNEXTE
-#undef CERNLIB_CCGEN_QNEXTE
-#endif
-#ifdef CERNLIB_TCGEN_QNEXTE
-#undef CERNLIB_TCGEN_QNEXTE
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernvmi/vmiobsol/vxinvb.F b/src/packlib/kernlib/kerngen/obsolete/kernvmi/vmiobsol/vxinvb.F
deleted file mode 100644
index ae75102..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernvmi/vmiobsol/vxinvb.F
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: vxinvb.F,v 1.1.1.1 1996/02/15 17:54:19 mclareni Exp $
-*
-* $Log: vxinvb.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:19 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE VXINVB (MV,NW)
-
-C CERN PROGLIB# M434 VXINVB .VERSION KERNVMI 1.01 891208
-C ORIG. 12-June-87, F. Carminati + J. Zoll
-
-C- VX invert bytes, in-place
-C- Fortran version, slower than the machine-language routine
-
- DIMENSION MV(99)
- LOGICAL*1 LLD(4), LST(4)
- EQUIVALENCE (LLD,MLD), (LST,MST)
-
- DO 29 J=1,NW
- MLD = MV(J)
- LST(1) = LLD(4)
- LST(2) = LLD(3)
- LST(3) = LLD(2)
- LST(4) = LLD(1)
- MV(J) = MST
- 29 CONTINUE
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernvmi/vmiobsol/vxinvc.F b/src/packlib/kernlib/kerngen/obsolete/kernvmi/vmiobsol/vxinvc.F
deleted file mode 100644
index c3783e1..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernvmi/vmiobsol/vxinvc.F
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: vxinvc.F,v 1.1.1.1 1996/02/15 17:54:19 mclareni Exp $
-*
-* $Log: vxinvc.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:19 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE VXINVC (MVI,MVX,NW)
-
-C CERN PROGLIB# M434 VXINVC .VERSION KERNVMI 1.01 891208
-C ORIG. 12-June-87, F. Carminati + J. Zoll
-
-C- VX invert bytes and copy
-C- Fortran version, slower than the machine-language routine
-
- DIMENSION MVI(99), MVX(99)
- LOGICAL*1 LLD(4), LST(4)
- EQUIVALENCE (LLD,MLD), (LST,MST)
-
- DO 29 J=1,NW
- MLD = MVI(J)
- LST(1) = LLD(4)
- LST(2) = LLD(3)
- LST(3) = LLD(2)
- LST(4) = LLD(1)
- MVX(J) = MST
- 29 CONTINUE
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernvmi/vmiobsol/xinb.F b/src/packlib/kernlib/kerngen/obsolete/kernvmi/vmiobsol/xinb.F
deleted file mode 100644
index b30efed..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernvmi/vmiobsol/xinb.F
+++ /dev/null
@@ -1,35 +0,0 @@
-*
-* $Id: xinb.F,v 1.1.1.1 1996/02/15 17:54:19 mclareni Exp $
-*
-* $Log: xinb.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:19 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE XINB (LUN,XBV,NXB)
-C
-C CERN PROGLIB# Z203 XINB .VERSION KERNVMI 1.01 891208
-C ORIG. 4/01/89 JZ
-C
- DIMENSION XBV(99)
-
- READ (LUN,IOSTAT=JSTAT) N, (XBV(J),J=1,MIN(N,NXB))
- IF (JSTAT) 61, 24, 64
- 24 N = MIN (N,NXB)
- NXB = MAX (N,1)
- RETURN
-
- 61 NXB = 0
- RETURN
-
- 64 NXB = -JSTAT
- RETURN
- END
-#ifdef CERNLIB_TCGEN_XINB
-#undef CERNLIB_TCGEN_XINB
-#endif
-#ifdef CERNLIB_XVECT_XINB
-#undef CERNLIB_XVECT_XINB
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernvmi/vmiobsol/xinbs.F b/src/packlib/kernlib/kerngen/obsolete/kernvmi/vmiobsol/xinbs.F
deleted file mode 100644
index ac5754f..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernvmi/vmiobsol/xinbs.F
+++ /dev/null
@@ -1,35 +0,0 @@
-*
-* $Id: xinbs.F,v 1.1.1.1 1996/02/15 17:54:19 mclareni Exp $
-*
-* $Log: xinbs.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:19 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE XINBS (LUN,XAV,NA,XBV,NXB)
-C
-C CERN PROGLIB# Z203 XINBS .VERSION KERNVMI 1.01 891208
-C ORIG. 4/01/89 JZ
-C
- DIMENSION XBV(99), XAV(NA)
-
- READ (LUN,IOSTAT=JSTAT) N,XAV,(XBV(J),J=1,MIN(N,NXB))
- IF (JSTAT) 61, 24, 64
- 24 N = MIN (N,NXB)
- NXB = MAX (N,1)
- RETURN
-
- 61 NXB = 0
- RETURN
-
- 64 NXB = -JSTAT
- RETURN
- END
-#ifdef CERNLIB_TCGEN_XINBS
-#undef CERNLIB_TCGEN_XINBS
-#endif
-#ifdef CERNLIB_XVECT_XINBS
-#undef CERNLIB_XVECT_XINBS
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/kernvmi/vmiprogs/fcasplit.F b/src/packlib/kernlib/kerngen/obsolete/kernvmi/vmiprogs/fcasplit.F
deleted file mode 100644
index b09440a..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/kernvmi/vmiprogs/fcasplit.F
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: fcasplit.F,v 1.1.1.1 1996/02/15 17:54:19 mclareni Exp $
-*
-* $Log: fcasplit.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:19 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
-#ifndef CERNLIB_QMVMI
-#define CERNLIB_QMVMI
-#endif
-#ifndef CERNLIB_UTYGEN_FCASPLIT
-#define CERNLIB_UTYGEN_FCASPLIT
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/tcgenr/acos.F b/src/packlib/kernlib/kerngen/obsolete/tcgenr/acos.F
deleted file mode 100644
index 72391a5..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/tcgenr/acos.F
+++ /dev/null
@@ -1,56 +0,0 @@
-*
-* $Id: acos.F,v 1.1.1.1 1996/02/15 17:53:25 mclareni Exp $
-*
-* $Log: acos.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:25 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- FUNCTION ACOS (A)
-C LAST MODIF. 16/07/80
- COMMON /SLATE/QXQ(7),ARG(2),C,XQX(30)
- DATA ZERO /1.0E-15/
-C
-C- ENTRY ACOS
-C
- ARG(2) = A
- ARG(1) = ABS(SQRT(1.-ARG(2)**2))
- ACOS = ATAN2(ARG(1),ARG(2))
- RETURN
-C
- ENTRY ASIN CDC
-C ENTRY ASIN (A) -CDC
-C
- ARG(1) = A
- ARG(2) = ABS(SQRT(1.-ARG(1)**2))
-#if defined(CERNLIB_ENTRET)
- ASIN = ATAN2(ARG(1),ARG(2))
-#endif
-#if !defined(CERNLIB_ENTRET)
- ACOS = ATAN2(ARG(1),ARG(2))
-#endif
- RETURN
-C
- ENTRY TAN CDC
-C ENTRY TAN (A) -CDC
-C
- C = COS(A)
- IF (ABS(C).GT.ZERO) GO TO 63
-#if defined(CERNLIB_ENTRET)
- TAN = 10.E20
-#endif
-#if !defined(CERNLIB_ENTRET)
- ACOS = 10.E20
-#endif
- RETURN
-C
-#if defined(CERNLIB_ENTRET)
- 63 TAN = SIN(A)/C
-#endif
-#if !defined(CERNLIB_ENTRET)
- 63 ACOS = SIN(A)/C
-#endif
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/tcgenr/afromi.F b/src/packlib/kernlib/kerngen/obsolete/tcgenr/afromi.F
deleted file mode 100644
index c48c0d4..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/tcgenr/afromi.F
+++ /dev/null
@@ -1,46 +0,0 @@
-*
-* $Id: afromi.F,v 1.1.1.1 1996/02/15 17:53:25 mclareni Exp $
-*
-* $Log: afromi.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:25 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- FUNCTION AFROMI (K)
-C
-C
- EQUIVALENCE (BIN,IBIN)
-C
- DIMENSION ALPHA(64)
- DATA ALPHA / 1H0,
- + 1H1,1H2,1H3,1H4,1H5,1H6,1H7,1H8,
- + 1H9,1H ,1H=,1H",1H ,1H ,1H ,1H+,
- + 1HA,1HB,1HC,1HD,1HE,1HF,1HG,1HH,
- + 1HI,1H ,1H.,1H),1H ,1H ,1H ,1H-,
- + 1HJ,1HK,1HL,1HM,1HN,1HO,1HP,1HQ,
- + 1HR,1H ,1H$,1H*,1H ,1H ,1H ,1H ,
- + 1H/,1HS,1HT,1HU,1HV,1HW,1HX,1HY,
- + 1HZ,1H ,1H,,1H(,1H ,1H ,1H /
-C
-C
-C-- ENTRY AFROMI
-C
- L=K
- IF ((L.LT.0) .OR. (L.GT.63)) L=48
- BIN= ALPHA(L+1)
- GO TO 99
-C
- ENTRY IFROMA CDC
-C ENTRY IFROMA (K) -CDC
-C
- IBIN= K
- I= IUCOMP (BIN,ALPHA,64)
- IF (I.EQ.0) I=49
- IF (I.EQ.11) I=49
- IBIN= I-1
- 99 AFROMI= BIN -IBM
-C 99 IFROMA= IBIN IBM
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/tcgenr/bcdwd.F b/src/packlib/kernlib/kerngen/obsolete/tcgenr/bcdwd.F
deleted file mode 100644
index 55c727f..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/tcgenr/bcdwd.F
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: bcdwd.F,v 1.1.1.1 1996/02/15 17:53:25 mclareni Exp $
-*
-* $Log: bcdwd.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:25 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- FUNCTION BCDWD (NVECT,NCH)
-C
-C
- COMMON /SLATE/A,B(10),XQX(29)
- DIMENSION NVECT(10)
-C
-C
- N= NCH
- DO 7 I=1,N
- 7 B(I)= AFROMI(NVECT(I))
- CALL UBUNCH (B,BCDWD,N)
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/tcgenr/bxyz.F b/src/packlib/kernlib/kerngen/obsolete/tcgenr/bxyz.F
deleted file mode 100644
index 09dfc4d..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/tcgenr/bxyz.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: bxyz.F,v 1.1.1.1 1996/02/15 17:53:25 mclareni Exp $
-*
-* $Log: bxyz.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:25 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE BXYZ(B,X)
-C
-C
- DIMENSION B(3),X(3)
-C
-C
- B(3)=ZFIELD(X(1),X(2),X(3))
- R=SQRT(X(1)**2+X(2)**2)
- B(1)=0.
- B(2)=0.
- IF(R.EQ.0.)GOTO 100
- BR=RFIELD(X(1),X(2),X(3))/R
- B(1)=X(1)*BR
- B(2)=X(2)*BR
- 100 RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/tcgenr/digitn.F b/src/packlib/kernlib/kerngen/obsolete/tcgenr/digitn.F
deleted file mode 100644
index 969b81a..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/tcgenr/digitn.F
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: digitn.F,v 1.1.1.1 1996/02/15 17:53:25 mclareni Exp $
-*
-* $Log: digitn.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:25 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- FUNCTION DIGITN (NN,A)
-C
-C
- COMMON /SLATE/BIN,B(10),XQX(29)
- EQUIVALENCE (BIN,IBIN)
-C
-C
- ICONV= 0
- GO TO 12
-C
- ENTRY IDIGIT CDC
-C ENTRY IDIGIT (NN,A) -CDC
-C
- ICONV= 1
-C
- 12 N= NN
- CALL UBLOW (A,B,N)
- BIN= B(N)
- IF (ICONV.NE.0) IBIN=IFROMA(BIN)
- DIGITN= BIN
-C IDIGIT= IBIN IBM
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/tcgenr/dircos.F b/src/packlib/kernlib/kerngen/obsolete/tcgenr/dircos.F
deleted file mode 100644
index 5faf7c0..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/tcgenr/dircos.F
+++ /dev/null
@@ -1,52 +0,0 @@
-*
-* $Id: dircos.F,v 1.1.1.1 1996/02/15 17:53:25 mclareni Exp $
-*
-* $Log: dircos.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:25 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE DIRCOS(A,B)
-C
-C
- COMMON /SLATE/G(9),F(9),ALAM,APHI,COSL,SINL,COSP,SINP,OUT(3),
- + XQX(13)
- DIMENSION A(2),B(3)
-C
-C-- VARIABLE TRANSFORMATION
-C-- COS X = COS L * COS PHI
-C-- COS Y = COS L * SIN PHI
-C-- COS Z = SIN L
-C
- ALAM= A(1)
- APHI= A(2)
- COSL= COS(ALAM)
- SINL= SIN(ALAM)
- COSP= COS(APHI)
- SINP= SIN(APHI)
- OUT(1)= COSL*COSP
- OUT(2)= COSL*SINP
- OUT(3)= SINL
- CALL UCOPY (OUT,B,3)
- RETURN
-C
-C-- JACOBIAN
-C-- 0 -SIN L * COS PHI -COS L * SIN PHI
-C-- 0 -SIN L * SIN PHI COS L * COS PHI
-C-- 0 COS L 0
-C
- ENTRY ERDIRC CDC
-C ENTRY ERDIRC (A,B) -CDC
-C
- CALL UZERO (F,1,9)
- F(2)= -SINL*COSP
- F(3)= -OUT(2)
- F(5)= -SINL*SINP
- F(6)= OUT(1)
- F(8)= COSL
- CALL MXMPY (F,A,G,3,3,3)
- CALL MXMPY1 (G,F,B,3,3,3)
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/tcgenr/dist.F b/src/packlib/kernlib/kerngen/obsolete/tcgenr/dist.F
deleted file mode 100644
index 8e765b4..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/tcgenr/dist.F
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: dist.F,v 1.1.1.1 1996/02/15 17:53:25 mclareni Exp $
-*
-* $Log: dist.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:25 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- FUNCTION DIST(X,Y)
-C
-C
- DIMENSION X(3),Y(3)
-C
- DIST=SQRT ((X(1)-Y(1))**2+(X(2)-Y(2))**2+(X(3)-Y(3))**2)
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/tcgenr/dot.F b/src/packlib/kernlib/kerngen/obsolete/tcgenr/dot.F
deleted file mode 100644
index 95acfa1..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/tcgenr/dot.F
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: dot.F,v 1.1.1.1 1996/02/15 17:53:25 mclareni Exp $
-*
-* $Log: dot.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:25 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- FUNCTION DOT(X,Y)
-C
- DIMENSION X(4),Y(4)
-C
-C
- N= 3
- GO TO 12
-C
- ENTRY DOT4 CDC
-C ENTRY DOT4 (X,Y) -CDC
- N=4
-C
- 12 A= 0
- DO 19 J=1,N
- 19 A= A + X(J)*Y(J)
- DOT= A
-C DOT4= DOT IBM
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/tcgenr/dotnor.F b/src/packlib/kernlib/kerngen/obsolete/tcgenr/dotnor.F
deleted file mode 100644
index ebc8390..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/tcgenr/dotnor.F
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: dotnor.F,v 1.1.1.1 1996/02/15 17:53:26 mclareni Exp $
-*
-* $Log: dotnor.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:26 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- FUNCTION DOTNOR(X,Y)
- DIMENSION X(3),Y(3)
- DOTNOR=DOT(X,Y)/SQRT (DOT(X,X)*DOT(Y,Y))
- IF (ABS(DOTNOR).GT.1.) DOTNOR=SIGN(1.,DOTNOR)
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/tcgenr/erf.F b/src/packlib/kernlib/kerngen/obsolete/tcgenr/erf.F
deleted file mode 100644
index dcbf8eb..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/tcgenr/erf.F
+++ /dev/null
@@ -1,159 +0,0 @@
-*
-* $Id: erf.F,v 1.1.1.1 1996/02/15 17:53:26 mclareni Exp $
-*
-* $Log: erf.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:26 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- FUNCTION ERF (X)
-C
-C CERN PROGLIB# C300 ERF .VERSION KERNFOR 3.15 820113
-C ORIG. 10/08/76 G.ERSKINE
-C
-C ******************************************************************
-C
-C ENTRY POINTS ... ERF, ERFC.
-C
-C THESE THREE FUNCTIONS ARE COMPUTED FROM THE RATIONAL APPROXIMAT-
-C IONS OF W.J.CODY, MATHEMATICS OF COMPUTATION, VOLUME 22 (1969),
-C PAGES 631-637.
-C
-C FOR ABS(X) LE 0.47 THE BASIC FUNCTION IS ERF. FOR ABS(X) GT 0.47
-C THE BASIC FUNCTION IS ERFC. THE FINAL RESULT IS OBTAINED IN TERMS
-C OF THE BASIC FUNCTION AS SHOWN IN THE FOLLOWING TABLE. A=ABS(X)
-C AND C=SQRT(2).
-C
-C FUNCTION A.LE.(0.47) A.GT.(0.47)
-C REQUIRED (ALL X) (NEGATIVE X) (POSITIVE X)
-C
-C ERF(X) ERF(X) ERFC(A)-1 1-ERFC(X)
-C
-C ERFC(X) 1-ERF(X) 2-ERFC(A) ERFC(X)
-C
-C ******************************************************************
-C
- DIMENSION P1(4),Q1(4), P2(8),Q2(8), P3(5),Q3(5)
- DATA P1/2.42667 95523 0532 E2,
- 1 2.19792 61618 2942 E1,
- 2 6.99638 34886 1914 E0,
- 3 -3.56098 43701 8154 E-2/
- DATA Q1/2.15058 87586 9861 E2,
- 1 9.11649 05404 5149 E1,
- 2 1.50827 97630 4078 E1,
- 3 1.00000 00000 0000 E0/
- DATA P2/3.00459 26102 0162 E2,
- 1 4.51918 95371 1873 E2,
- 2 3.39320 81673 4344 E2,
- 3 1.52989 28504 6940 E2,
- 4 4.31622 27222 0567 E1,
- 5 7.21175 82508 8309 E0,
- 6 5.64195 51747 8974 E-1,
- 7 -1.36864 85738 2717 E-7/
- DATA Q2/3.00459 26095 6983 E2,
- 1 7.90950 92532 7898 E2,
- 2 9.31354 09485 0610 E2,
- 3 6.38980 26446 5631 E2,
- 4 2.77585 44474 3988 E2,
- 5 7.70001 52935 2295 E1,
- 6 1.27827 27319 6294 E1,
- 7 1.00000 00000 0000 E0/
- DATA P3/-2.99610 70770 3542 E-3,
- 1 -4.94730 91062 3251 E-2,
- 2 -2.26956 59353 9687 E-1,
- 3 -2.78661 30860 9648 E-1,
- 4 -2.23192 45973 4185 E-2/
- DATA Q3/1.06209 23052 8468 E-2,
- 1 1.91308 92610 7830 E-1,
- 2 1.05167 51070 6793 E0,
- 3 1.98733 20181 7135 E0,
- 4 1.00000 00000 0000 E0/
- DATA CONST1/ 0.70710 67811 86548 /
-C ( CONST1= SQRT(1/2) )
- DATA CONST2/0.56418 95835 47756 /
-C ( CONST2= SQRT(1/PI) )
-C
-C ******************************************************************
-C
-C ENTRY POINTS. SET IENTRY (=1 FOR ERF, =2 FOR ERFC).
-C
- IENTRY=1
- T=X
- A=ABS(T)
- IF(A.LE.6.0) GO TO 11
- ERF=SIGN(1.0,X)
- RETURN
-C
-#if defined(CERNLIB_ENTRCDC)
- ENTRY ERFC
-#endif
-#if !defined(CERNLIB_ENTRCDC)
- ENTRY ERFC (X)
-#endif
- IENTRY=2
- T=X
- IF(T.GE.-6.0) GO TO 10
-#if defined(CERNLIB_ENTRET)
- ERFC=2.0
-#endif
-#if !defined(CERNLIB_ENTRET)
- ERF=2.0
-#endif
- RETURN
-C
-C SELECT BASIC FUNCTION. SET IBASIC (=1 FOR ERF, =2 FOR ERFC).
-C
- 10 A=ABS(T)
- 11 S=T**2
- IF(A.GT.0.47) GO TO 20
-C
-C IBASIC=1. SET Y=ERF(T).
-C
- IBASIC=1
- Y=T*(P1(1)+S*(P1(2)+S*(P1(3)+S*P1(4) )))
- 1 /(Q1(1)+S*(Q1(2)+S*(Q1(3)+S*Q1(4) )))
- GO TO 30
-C
-C IBASIC=2. SET Y=ERFC(A).
-C
- 20 IBASIC=2
- IF(A.GT.4.0) GO TO 21
- Y=EXP(-S)*(P2(1)+A*(P2(2)+A*(P2(3)+A*(P2(4)+A*(P2(5)+
- 1 A*(P2(6)+A*(P2(7)+A*P2(8) )))))))
- 2 /(Q2(1)+A*(Q2(2)+A*(Q2(3)+A*(Q2(4)+A*(Q2(5)+
- 3 A*(Q2(6)+A*(Q2(7)+A*Q2(8) )))))))
- GO TO 30
-C
- 21 Y=0.0
- IF(A.GT.26.0) GO TO 30
- R=1.0/A
- U=R**2
- Y=R*EXP(-S)*( CONST2 +
- 1 U*(P3(1)+U*(P3(2)+U*(P3(3)+U*(P3(4)+U*P3(5) ))))
- 2 /(Q3(1)+U*(Q3(2)+U*(Q3(3)+U*(Q3(4)+U*Q3(5) )))) )
-C
-C EXPRESS FINAL RESULT IN TERMS OF Y.
-C
- 30 IF(IENTRY.NE.1) GO TO 40
- IF(IBASIC.EQ.2) GO TO 31
- ERF=Y
- RETURN
- 31 ERF=1.0-Y
- IF(X.LT.0.0) ERF=-ERF
- RETURN
-C
- 40 IF(IBASIC.EQ.2) GO TO 41
- Y=1.0-Y
- GO TO 42
- 41 IF(X.LT.0.0) Y=2.0-Y
-#if defined(CERNLIB_ENTRET)
- 42 ERFC=Y
-#endif
-#if !defined(CERNLIB_ENTRET)
- 42 ERF=Y
-#endif
- RETURN
-C
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/tcgenr/erprip.F b/src/packlib/kernlib/kerngen/obsolete/tcgenr/erprip.F
deleted file mode 100644
index 1a74669..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/tcgenr/erprip.F
+++ /dev/null
@@ -1,43 +0,0 @@
-*
-* $Id: erprip.F,v 1.1.1.1 1996/02/15 17:53:26 mclareni Exp $
-*
-* $Log: erprip.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:26 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE ERPRIP(GA1,GA2,GA12,GB)
-C
-C
- DIMENSION GA1(9),GA2(9),GB(9),GA12(9)
- COMMON /SLATE/XQX(9), V(4), G1(9), G2(9), G(9)
-C
- CALL MXMPY (G1, GA1,G,3,3,3)
- CALL MXMPY1 (G,G1,GB,3,3,3)
- CALL MXMPY (G2,GA2,G,3,3,3)
- CALL MXMAD1 (G,G2,GB,3,3,3)
- IF(GA12(1).EQ.0.) GOTO 1
- CALL MXMPY(G1,GA12,G,3,3,3)
- CALL MXMAD1(G,G2,GB,3,3,3)
- CALL MXMPY1(G2,GA12,G,3,3,3)
- CALL MXMAD1(G,G1,GB,3,3,3)
- 1 G(3)=-1./V(4)**3
- G(1)=V(1)*G(3)
- G(2)=V(2)*G(3)
- G(3)=V(3)*G(3)
- G(8)=V(1)**2+V(2)**2
- G(6)=1./(V(4)**2*SQRT(G(8)))
- G(5)=-G(6)*V(3)
- G(4)=V(1)*G(5)
- G(5)=V(2)*G(5)
- G(6)=G(8)*G(6)
- G(8)=1./G(8)
- G(7)=-V(2)*G(8)
- G(8)=V(1)*G(8)
- G(9)=0.
- CALL MXMPY (G,GB,G1,3,3,3)
- CALL MXMPY1(G1,G,GB,3,3,3)
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/tcgenr/fint.F b/src/packlib/kernlib/kerngen/obsolete/tcgenr/fint.F
deleted file mode 100644
index 3272b71..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/tcgenr/fint.F
+++ /dev/null
@@ -1,75 +0,0 @@
-*
-* $Id: fint.F,v 1.1.1.1 1996/02/15 17:53:26 mclareni Exp $
-*
-* $Log: fint.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:26 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- FUNCTION FINT(NARG,ARG,NENT,ENT,TABLE)
-C
-C CERN PROGLIB# E104 FINT .VERSION KERNFOR 4.02 820723
-C ORIG. 09/08/65 CHL.
-C
-C INTERPOLATION ROUTINE. AUTHOR C. LETERTRE.
-C MODIFIED BY B. SCHORR, 1.07.1982.
-C
- INTEGER NENT(NARG)
- REAL ARG(NARG),ENT(9), TABLE(9)
- INTEGER INDEX(32)
- REAL WEIGHT(32)
- FINT = 0.
- IF(NARG .LT. 1 .OR. NARG .GT. 5) RETURN
- LMAX = 0
- ISTEP = 1
- KNOTS = 1
- INDEX(1) = 1
- WEIGHT(1) = 1.
- DO 100 N = 1, NARG
- X = ARG(N)
- NDIM = NENT(N)
- LOCA = LMAX
- LMIN = LMAX + 1
- LMAX = LMAX + NDIM
- IF(NDIM .GT. 2) GOTO 10
- IF(NDIM .EQ. 1) GOTO 100
- H = X - ENT(LMIN)
- IF(H .EQ. 0.) GOTO 90
- ISHIFT = ISTEP
- IF(X-ENT(LMIN+1) .EQ. 0.) GOTO 21
- ISHIFT = 0
- ETA = H / (ENT(LMIN+1) - ENT(LMIN))
- GOTO 30
- 10 LOCB = LMAX + 1
- 11 LOCC = (LOCA+LOCB) / 2
- IF(X-ENT(LOCC)) 12, 20, 13
- 12 LOCB = LOCC
- GOTO 14
- 13 LOCA = LOCC
- 14 IF(LOCB-LOCA .GT. 1) GOTO 11
- LOCA = MIN0( MAX0(LOCA,LMIN), LMAX-1 )
- ISHIFT = (LOCA - LMIN) * ISTEP
- ETA = (X - ENT(LOCA)) / (ENT(LOCA+1) - ENT(LOCA))
- GOTO 30
- 20 ISHIFT = (LOCC - LMIN) * ISTEP
- 21 DO 22 K = 1, KNOTS
- INDEX(K) = INDEX(K) + ISHIFT
- 22 CONTINUE
- GOTO 90
- 30 DO 31 K = 1, KNOTS
- INDEX(K) = INDEX(K) + ISHIFT
- INDEX(K+KNOTS) = INDEX(K) + ISTEP
- WEIGHT(K+KNOTS) = WEIGHT(K) * ETA
- WEIGHT(K) = WEIGHT(K) - WEIGHT(K+KNOTS)
- 31 CONTINUE
- KNOTS = 2*KNOTS
- 90 ISTEP = ISTEP * NDIM
- 100 CONTINUE
- DO 200 K = 1, KNOTS
- I = INDEX(K)
- FINT = FINT + WEIGHT(K) * TABLE(I)
- 200 CONTINUE
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/tcgenr/freq.F b/src/packlib/kernlib/kerngen/obsolete/tcgenr/freq.F
deleted file mode 100644
index 24de587..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/tcgenr/freq.F
+++ /dev/null
@@ -1,62 +0,0 @@
-*
-* $Id: freq.F,v 1.1.1.1 1996/02/15 17:53:26 mclareni Exp $
-*
-* $Log: freq.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:26 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- FUNCTION FREQ (X)
-C
-C CERN PROGLIB# C300 FREQ .VERSION KERNFOR 3.16 820125
-C ORIG. 10/08/76 G.ERSKINE
-C
-C DERIVED FROM D=ERF IN P=TCGEN WITH ERF/ERFC REMOVED.
-C 20/05/80 JZ
-C
-C ******************************************************************
-C
-C FOR ABS(X) LE 0.47 THE BASIC FUNCTION IS ERF. FOR ABS(X) GT 0.47
-C THE BASIC FUNCTION IS ERFC. THE FINAL RESULT IS OBTAINED IN TERMS
-C OF THE BASIC FUNCTION AS SHOWN IN THE FOLLOWING TABLE. A=ABS(X)
-C AND C=SQRT(2).
-C
-C FUNCTION A.LE.(0.47) A.GT.(0.47)
-C REQUIRED (ALL X) (NEGATIVE X) (POSITIVE X)
-C
-C ERF(X) ERF(X) ERFC(A)-1 1-ERFC(X)
-C
-C ERFC(X) 1-ERF(X) 2-ERFC(A) ERFC(X)
-C
-C FREQ(X) 0.5+0.5*ERF(X/C) 0.5*ERFC(A/C) 1-0.5*ERFC(X/C)
-C
-C ******************************************************************
-C
- DATA CONST1/ 0.70710 67811 86548 /
-C ( CONST1= SQRT(1/2) )
-C
-C
- T = CONST1*X
- IF (X.GE.0.) GO TO 31
-C
-C-- -VE ARGUMENT
-C
- IF (X.GE.-.47) GO TO 34
- FREQ = .5 * ERFC(-T)
- RETURN
-C
-C-- POSITIVE ARGUMENT
-C
- 31 IF (X.GT.6.0) GO TO 38
- IF (X.GE.0.47) GO TO 36
- 34 FREQ = .5 + .5 * ERF(T)
- RETURN
-C
- 36 FREQ = 1. - .5 * ERFC(T)
- RETURN
-C
- 38 FREQ = 1.
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/tcgenr/ibad.F b/src/packlib/kernlib/kerngen/obsolete/tcgenr/ibad.F
deleted file mode 100644
index a2204c0..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/tcgenr/ibad.F
+++ /dev/null
@@ -1,44 +0,0 @@
-*
-* $Id: ibad.F,v 1.1.1.1 1996/02/15 17:53:26 mclareni Exp $
-*
-* $Log: ibad.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:26 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- FUNCTION IBAD (MC)
-C
-C
- IMC= MC
- M= 0
- DO 10 I=1,4
- IF (MOD(IMC,4).EQ.2) M=M+1
- 10 IMC= IMC/4
- GO TO 99
-C
- ENTRY IMEA CDC
-C ENTRY IMEA (MC) -CDC
-C
- IMC= MC
- M= 0
- DO 20 I=1,4
- IF (MOD(IMC,4).GE.2) M=M+1
- 20 IMC= IMC/4
- GO TO 99
-C
- ENTRY IUNME CDC
-C ENTRY IUNME (MC) -CDC
-C
- IMC= MC
- M= 0
- DO 30 I=1,4
- IF (MOD(IMC,4).EQ.1) M=M+1
- 30 IMC= IMC/4
-C
- 99 IBAD= M
-C IMEA= IBAD IBM
-C IUNME= IBAD IBM
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/tcgenr/icrd.F b/src/packlib/kernlib/kerngen/obsolete/tcgenr/icrd.F
deleted file mode 100644
index cb74fe1..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/tcgenr/icrd.F
+++ /dev/null
@@ -1,55 +0,0 @@
-*
-* $Id: icrd.F,v 1.1.1.1 1996/02/15 17:53:26 mclareni Exp $
-*
-* $Log: icrd.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:26 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- FUNCTION ICRD (IBLOC)
-C
-C
- COMMON /CARDS/IC( 7)
- COMMON /PHYS/ IP(20)
- EQUIVALENCE (NCBLOC,IC), (NPBLOC,IP)
-C
-C-- ENTRY ICRD
-C
- II= 2
- M= 1
- IBL= IBLOC
- 10 IF (IBL.EQ.IC(II+1)) GO TO 19
- 12 M= M+1
- IF (M.GT.NCBLOC) GO TO 91
- II= IC(II)
- GO TO 10
-C
- 19 ICRD= II+1
- RETURN
-C
- ENTRY NCRD CDC
-C ENTRY NCRD (IBLOC) -CDC
-C
- GO TO 12
-C
- ENTRY ITIT CDC
-C ENTRY ITIT (IBLOC) -CDC
-C
- JJ= 2
-C NPBLC= NPBLOC UNI
-C DO 22 N=1,NPBLC UNI
- DO 22 N=1,NPBLOC -UNI
- IF (IBLOC.EQ.IP(JJ+1)) GO TO 99
- 22 JJ= IP(JJ)
-C
- 91 ICRD= 0
-C NCRD= 0 IBM
-C ITIT= 0 IBM
- RETURN
-C
- 99 ICRD= JJ+1
-C ITIT= ICRD IBM
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/tcgenr/iformt.F b/src/packlib/kernlib/kerngen/obsolete/tcgenr/iformt.F
deleted file mode 100644
index 41794ce..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/tcgenr/iformt.F
+++ /dev/null
@@ -1,50 +0,0 @@
-*
-* $Id: iformt.F,v 1.1.1.1 1996/02/15 17:53:26 mclareni Exp $
-*
-* $Log: iformt.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:26 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- FUNCTION IFORMT (WORD,N1,N2)
-C
-C
- COMMON/SLATE/IBIN(40)
- DIMENSION LSIGN(3)
- DIMENSION WORD(9)
-C
- DIMENSION INT(10)
- DATA LSIGN/ 1H-, 1H , 1H+/
- DATA INT / 1H0, 1H1, 1H2, 1H3, 1H4, 1H5, 1H6, 1H7, 1H8, 1H9/
-C
- KSIGN=1
- IFORMT=0
- CALL UBLOW (WORD,IBIN,N2)
-C
- DO 10 J=N1,N2
- IN=IUCOMP (IBIN(J),INT,10)
- IF (IN.NE.0) GO TO 15
- I=IUCOMP (IBIN(J),LSIGN,3)
- IF (I.EQ.0) GO TO 101
- IF (I.NE.2) GO TO 30
- 10 CONTINUE
- GO TO 25
-C
- 15 DO 20 I=J,N2
- IN=IUCOMP (IBIN(I),INT,10)-1
- IF (IBIN(I).EQ.LSIGN(2)) IN=0
- IF (IN.LT.0) GO TO 101
- 20 IFORMT=IN+10*IFORMT
-C
- 25 IFORMT=KSIGN*IFORMT
- RETURN
-C
- 30 KSIGN=I-2
- J=J+1
- GO TO 15
-C
- 101 IFORMT=-999999999
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/tcgenr/ipack.F b/src/packlib/kernlib/kerngen/obsolete/tcgenr/ipack.F
deleted file mode 100644
index 7eea41f..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/tcgenr/ipack.F
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: ipack.F,v 1.1.1.1 1996/02/15 17:53:26 mclareni Exp $
-*
-* $Log: ipack.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:26 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- FUNCTION IPACK (N,I)
-C
-C
- DIMENSION N(2)
-C
- IPACK=0
- DO 5 J=1,I
- 5 CALL STORE6 (IPACK,J,N(J))
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/tcgenr/jth.F b/src/packlib/kernlib/kerngen/obsolete/tcgenr/jth.F
deleted file mode 100644
index dcaf1d4..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/tcgenr/jth.F
+++ /dev/null
@@ -1,75 +0,0 @@
-*
-* $Id: jth.F,v 1.1.1.1 1996/02/15 17:53:26 mclareni Exp $
-*
-* $Log: jth.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:26 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- FUNCTION JTHB (IWORD,J,IB)
-C
-C
- DIMENSION NPOW2(31)
-C DIMENSION NT(35) A6
-C DIMENSION NT(47) A8
- DIMENSION NT(59) A10
- EQUIVALENCE (NPOW2,NT)
-C
- DIMENSION N2(4)
- EQUIVALENCE (N2,NT(32)) -A4
-C
- DIMENSION N3(12) A8,A10
- EQUIVALENCE (N3,NT(36)) A8,A10
-C
- DIMENSION N4(12) A10
- EQUIVALENCE (N4,NT(48)) A10
-C
- DATA NPOW2 /
- + 1, 2, 4, 8, 16, 32, 64, 128, 256, 512, 1024, 2048, 4096, 8192,
- + 16384, 32768, 65536, 131072, 262144, 524288, 1048576, 2097152,
- + 4194304, 8388608, 16777216, 33554432, 67108864, 134217728,
- + 268435456, 536870912, 1073741824/
-C
- DATA N2 / -A4
- + 2147483648, 4294967296, 8589934592, 17179869184/ -A4
-C
- DATA N3 / A8,A10
- + 34359738368, 68719476736, 137438953472, 274877906944, A8,A10
- + 549755813888, 1099511627776, 2199023255552, 4398046511104, A8,A10
- + 8796093022208, 17592186044416, 35184372088832, 70368744177664/ A8,A10
-C
- DATA N4 / A10
- + 140737488355328, 281474976710656, 562949953421312, A10
- + 1125899906842624, 2251799813685248, 4503599627370496, A10
- + 9007199254740992, 18014398509481984, 36028797018963968, A10
- + 72057594037927936, 144115188075855872, 288230376151711744/ A10
-C
-C- ENTRY JTHB
-C
- IEXP2=IB
- NBASE=NPOW2(IB+1)
- GO TO 10
-C
- ENTRY JTH CDC
-C ENTRY JTH (IWORD,J) -CDC
-C
- IEXP2=6
- NBASE=64
- GO TO 10
-C
- ENTRY JTH1 CDC
-C ENTRY JTH1 (IWORD,J) -CDC
-C
- IEXP2=1
- NBASE=2
-C
-C
- 10 IP=IEXP2*(J-1)+1
- NPOWER=NPOW2(IP)
- JTHB=MOD(IWORD/NPOWER,NBASE)
-C JTH= JTHB IBM
-C JTH1= JTHB IBM
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/tcgenr/jth10.F b/src/packlib/kernlib/kerngen/obsolete/tcgenr/jth10.F
deleted file mode 100644
index edfec24..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/tcgenr/jth10.F
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: jth10.F,v 1.1.1.1 1996/02/15 17:53:27 mclareni Exp $
-*
-* $Log: jth10.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:27 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- FUNCTION JTH10 (IWORD,J)
-C
-C
- NPOWER=10**(J-1)
- IF (J.EQ.1) NPOWER=1
- JTH10=MOD (IWORD/NPOWER,10)
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/tcgenr/jthn.F b/src/packlib/kernlib/kerngen/obsolete/tcgenr/jthn.F
deleted file mode 100644
index 2b29ce7..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/tcgenr/jthn.F
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: jthn.F,v 1.1.1.1 1996/02/15 17:53:27 mclareni Exp $
-*
-* $Log: jthn.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:27 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- FUNCTION JTHN(IWORD,J,N)
-C
-C
- NPOWER = N**(J-1)
- IF(J.EQ.1) NPOWER=1
- JTHN = MOD(IWORD/NPOWER,N)
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/tcgenr/lorenc.F b/src/packlib/kernlib/kerngen/obsolete/tcgenr/lorenc.F
deleted file mode 100644
index 9e44537..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/tcgenr/lorenc.F
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: lorenc.F,v 1.1.1.1 1996/02/15 17:53:27 mclareni Exp $
-*
-* $Log: lorenc.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:27 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE LORENC (A,B,C)
-C
- DIMENSION A(4),B(4),C(4)
-C
-C
- X=(A(1)*B(1)+A(2)*B(2)+A(3)*B(3)) -UNI
- 1 /(SQRT (1.+B(1)*B(1)+B(2)*B(2)+B(3)*B(3)) +1.) -UNI
- 2 +SQRT (1.+A(1)*A(1)+A(2)*A(2)+A(3)*A(3)) -UNI
-C
-C X1=(A(1)*B(1)+A(2)*B(2)+A(3)*B(3)) UNI
-C X2=(SQRT (1.+B(1)*B(1)+B(2)*B(2)+B(3)*B(3)) +1.) UNI
-C X3=SQRT (1.+A(1)*A(1)+A(2)*A(2)+A(3)*A(3)) UNI
-C X = X1/X2 + X3 UNI
-C
-C
- DO 50 I=1,3
- 50 C(I)=A(I)+B(I)*X
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/tcgenr/lotran.F b/src/packlib/kernlib/kerngen/obsolete/tcgenr/lotran.F
deleted file mode 100644
index 9239ff9..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/tcgenr/lotran.F
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: lotran.F,v 1.1.1.1 1996/02/15 17:53:27 mclareni Exp $
-*
-* $Log: lotran.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:27 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE LOTRAN (A,B,C)
-C
- DIMENSION A(4),B(4),C(4)
-C
-C
- AMASS=SQRT (B(4)*B(4)-B(1)*B(1)-B(2)*B(2)-B(3)*B(3))
- X=((A(1)*B(1)+A(2)*B(2)+A(3)*B(3)) /(B(4)+AMASS)
- 1 +SQRT (A(1)*A(1)+A(2)*A(2)+A(3)*A(3)+A(4)*A(4))) /AMASS
- C(4)= A(4)
-C
- DO 50 I=1,3
- 50 C(I)=A(I)+B(I)*X
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/tcgenr/move.F b/src/packlib/kernlib/kerngen/obsolete/tcgenr/move.F
deleted file mode 100644
index 1b6f66a..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/tcgenr/move.F
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: move.F,v 1.1.1.1 1996/02/15 17:53:27 mclareni Exp $
-*
-* $Log: move.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:27 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE MOVE (A,B,N)
-C
- DIMENSION A(2),B(2)
-C
-C
- IF (N) 10,99,20
-C
-C-- BEGINNING OF B ON END OF A
-C
- 10 J= -N
- 11 B(J)= A(J)
- J= J-1
- IF (J.NE.0) GO TO 11
- RETURN
-C
-C-- NO OVERLAP OR BEGINNING OF A ON END OF B
-C
- 20 DO 21 I=1,N
- 21 B(I)= A(I)
- 99 RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/tcgenr/mxadd.F b/src/packlib/kernlib/kerngen/obsolete/tcgenr/mxadd.F
deleted file mode 100644
index c905b74..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/tcgenr/mxadd.F
+++ /dev/null
@@ -1,58 +0,0 @@
-*
-* $Id: mxadd.F,v 1.1.1.1 1996/02/15 17:53:27 mclareni Exp $
-*
-* $Log: mxadd.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:27 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE MXADD(A,B,C,I,J)
-C
-C
- DIMENSION A(400),B(400),C(400)
-C
-C
-C-- ENTRY MXADD
- N=I*J
- IF(N.EQ.0) GO TO 100
- DO 11 L=1,N
- 11 C(L)=A(L)+B(L)
- GO TO 100
-C
- ENTRY MXSUB CDC
-C ENTRY MXSUB (A,B,C,I,J) -CDC
-C
- N=I*J
- IF(N.EQ.0) GO TO 100
- DO 21 L=1,N
- 21 C(L)=A(L)-B(L)
- GO TO 100
-C
- ENTRY MXTRA CDC
-C ENTRY MXTRA (A,B,C,I,J) -CDC
-C
- N=I*J
- IF (N.GT.0) CALL UCOPY (A,C,N)
- GO TO 100
-C
- ENTRY MXMTR CDC
-C ENTRY MXMTR (A,B,C,I,J) -CDC
-C
- N=I*J
- IF(N.EQ.0) GO TO 100
- DO 41 L=1,N
- 41 C(L)=B(1)*A(L)
- GO TO 100
-C
- ENTRY MXNTR CDC
-C ENTRY MXNTR (A,B,C,I,J) -CDC
-C
- N=I*J
- IF(N.EQ.0) GO TO 100
- DO 51 L=1,N
- 51 C(L)=-A(L)
-C
- 100 RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/tcgenr/mxdma.F b/src/packlib/kernlib/kerngen/obsolete/tcgenr/mxdma.F
deleted file mode 100644
index db1bb18..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/tcgenr/mxdma.F
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: mxdma.F,v 1.1.1.1 1996/02/15 17:53:27 mclareni Exp $
-*
-* $Log: mxdma.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:27 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE MXDMA(A,F,D,B,I)
-C
-C
- DIMENSION A(400),B(400),D(20)
-C
- IF (I.EQ.0) GO TO 100
- J=1
- IF (I.EQ.1) GO TO 12
- DO 11 K=2,I
- B(J)=A(J)+F*D(K-1)
- J=J+1
- DO 11 L=1,I
- B(J)=A(J)
- 11 J=J+1
- 12 B(J)=A(J)+F*D(I)
- 100 RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/tcgenr/mxdmal.F b/src/packlib/kernlib/kerngen/obsolete/tcgenr/mxdmal.F
deleted file mode 100644
index 405c005..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/tcgenr/mxdmal.F
+++ /dev/null
@@ -1,57 +0,0 @@
-*
-* $Id: mxdmal.F,v 1.1.1.1 1996/02/15 17:53:27 mclareni Exp $
-*
-* $Log: mxdmal.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:27 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE MXDMAL (A,B,R,I,J)
-C
-C
- DIMENSION A(400), B(400), R(400)
-C
-C-- ENTRY MXDMAL
- IF((I.EQ.0).OR.(J.EQ.0)) GO TO 100
- IB=1
- DO 21 L=1,I
- DO 21 K=1,J
- R(IB)= R(IB) + B(IB)*A(L)
- 21 IB=IB+1
- GO TO 100
-C
- ENTRY MXDMAR CDC
-C ENTRY MXDMAR (A,B,R,I,J) -CDC
-C
- IF((I.EQ.0).OR.(J.EQ.0)) GO TO 100
- IB=1
- DO 31 L=1,I
- DO 31 K=1,J
- R(IB)= R(IB) + A(IB)*B(K)
- 31 IB=IB+1
- GO TO 100
-C
- ENTRY MXDML CDC
-C ENTRY MXDML (A,B,R,I,J) -CDC
-C
- IF((I.EQ.0).OR.(J.EQ.0)) GO TO 100
- IB=1
- DO 41 L=1,I
- DO 41 K=1,J
- R(IB)= B(IB)*A(L)
- 41 IB=IB+1
- GO TO 100
-C
- ENTRY MXDMR CDC
-C ENTRY MXDMR (A,B,R,I,J) -CDC
-C
- IF((I.EQ.0).OR.(J.EQ.0)) GO TO 100
- IB=1
- DO 51 L=1,I
- DO 51 K=1,J
- R(IB)= A(IB)*B(K)
- 51 IB=IB+1
- 100 RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/tcgenr/parofi.F b/src/packlib/kernlib/kerngen/obsolete/tcgenr/parofi.F
deleted file mode 100644
index b50a0a9..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/tcgenr/parofi.F
+++ /dev/null
@@ -1,55 +0,0 @@
-*
-* $Id: parofi.F,v 1.1.1.1 1996/02/15 17:53:27 mclareni Exp $
-*
-* $Log: parofi.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:27 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- FUNCTION PAROFI (IN)
-C
-C- THIS FLOATING/INTEGER FUNCTION CANNOT BE WRITTEN TO SATISFY
-C- ALL COMPILERS. PLEASE PATCHY-MODIFY IT AS NEEDED ON YOURS.
-C- WE ASSERT THIS ROUTINE WILL NOT BE CHANGED AGAIN.
-C
- DIMENSION IN(9), MPP(49),MPT1(30),MPT2(11),MPT3(8)
- EQUIVALENCE (MPT1(1),MPP(1)),(MPT2(1),MPP(31)),(MPT3(1),MPP(42))
- DIMENSION MALT(8), IALT(9)
- EQUIVALENCE (RESULT,IRESUL)
-C
- DATA MPT1 / 1H0, 1HG, 2HNU, 1HE, 2HMU, 3HPI0,
- + 2HPI, 1HK, 2HK0, 1HP, 1HN, 1HL,
- + 2HS+, 2HS0, 2HS-, 3HXI0, 3HXI-, 1HD,
- + 3HTRI, 3HHE3, 3HHE4, 4H(22), 4H(23), 4H(24),
- + 4H(25), 4H(26), 4H(27), 4H(28), 4H(29), 4H(30)/
-C
- DATA MPT2 / 11*4H**** /
-C
- DATA MPT3 / 2HAP, 2HAN, 2HAL, 3HAS+, 3HAS0, 3HAS-,
- + 4HAXI0, 4HAXI-/
-C
- DATA MALT / 4HZERO,1HO,3HPIO,2HKO,2HSO,3HXIO,3HASO,4HAXIO/
- DATA IALT/ 0, 1, 1, 6, 9, 14, 16, 46, 48/
-C
-C----- ENTRY PAROFI
-C
- N = IN(1)
- IF (N.LE.0. OR.N.GT.49) N=40
- IRESUL = MPP(N)
- PAROFI = RESULT
- RETURN
-C
- ENTRY IOFPAR CDC
-C ENTRY IOFPAR (IN) -CDC
-C
- N = IN(1)
- IRESUL = IUCOMP (N,MPP(1),49)
- IF (IRESUL.NE.0) GO TO 39
- IRESUL = IUCOMP (N,MALT(1),8)
- IRESUL = IALT(IRESUL+1)
- 39 PAROFI = RESULT CDC
-C 39 IOFPAR = IRESUL -CDC
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/tcgenr/pripar.F b/src/packlib/kernlib/kerngen/obsolete/tcgenr/pripar.F
deleted file mode 100644
index 87ed274..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/tcgenr/pripar.F
+++ /dev/null
@@ -1,55 +0,0 @@
-*
-* $Id: pripar.F,v 1.1.1.1 1996/02/15 17:53:27 mclareni Exp $
-*
-* $Log: pripar.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:27 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE PRIPAR (A1,A2,B)
-C
-C
- COMMON /SLATE/XQX(9), V(4), G1(9), G2(9), G(9)
- DIMENSION A1(3),A2(3),B(3)
-C
-C
- CALL UCOPY (A1,G,3)
- V(3)=0.
-C
- I= 0
- 1 CONTINUE
- GINV= 1./G(1)
- G2(7)=SIN(G(2))
- G2(8)=COS(G(2))
- G2(2)=COS (G(3))
- G2(5)= SIN(G(3))
- G2(3)=-G2(8)*G2(5)
- G2(6)=G2(8)*G2(2)
- G2(2)=-G2(7)*G2(2)
- G2(5)=-G2(7)*G2(5)
- G2(1)=-G2(6)*GINV
- G2(4)= G2(3)*GINV
- G2(7)=-G2(7)*GINV
- G2(9)=0.
- V(3)=V(3)-G2(7)
-C
- CALL MXMTR (G2,GINV,G2,9,1)
-C
- IF (I.EQ.2) GO TO 5
- CALL UCOPY (G2,G1,9)
- CALL UCOPY (A2,G,3)
- I= 2
- GO TO 1
-C
- 5 V(1)=G1(6)+G2(6)
- V(2)=-G1(3)-G2(3)
- B(1)= V(1)**2+V(2)**2
- B(2)=ATAN(V(3)/SQRT(B(1)))
- V(4)=SQRT(V(3)**2+ B(1))
- B(3)= ATAN2(V(2),V(1))
- IF(B(3).LT.0.) B(3)=B(3)+6.28318
- B(1)=1./V(4)
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/tcgenr/prob.F b/src/packlib/kernlib/kerngen/obsolete/tcgenr/prob.F
deleted file mode 100644
index 69020c4..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/tcgenr/prob.F
+++ /dev/null
@@ -1,63 +0,0 @@
-*
-* $Id: prob.F,v 1.1.1.1 1996/02/15 17:53:26 mclareni Exp $
-*
-* $Log: prob.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:26 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- FUNCTION PROB (CHI2,N)
-C
-C CERN PROGLIB# G100 PROB .VERSION KERNFOR 3.17 820204
-C ORIG. 01/01/64 CH.LETERTRE
-C REVISED BY B.SCHORR, 23.10.81
-C
-C
-#if defined(CERNLIB_B60M)
- DATA SRTOPI,UPL /0.79788456080287,1300./
-#endif
-#if !defined(CERNLIB_B60M)
- DATA SRTOPI,UPL /0.7978846,340./
-#endif
- PROB=0.
- IF (N .LE. 0 .OR. CHI2 .LT. 0.) RETURN
- IF (N .GT. 100) GO TO 30
- IF (CHI2 .GT. UPL) RETURN
- EMYO2=EXP(-0.5*CHI2)
- SUM=1.
- TERM=1.
- M=N/2
- IF (2*M .NE. N) GO TO 1
-C-- ENTRY IF N IS EVEN
- IF (M .EQ. 1) GO TO 11
- DO 10 I=2,M
- FI=I-1
- TERM=0.5*TERM*CHI2/FI
- 10 SUM=SUM+TERM
- 11 PROB=EMYO2*SUM
- RETURN
-C-- ENTRY IF N IS ODD
- 1 SRTY=SQRT (CHI2)
- VALUE=2.*(1.-FREQ (SRTY))
- IF (N .NE. 1) GO TO 2
- PROB=VALUE
- RETURN
- 2 CONST=SRTOPI*SRTY*EMYO2
- IF (N .EQ. 3) GO TO 21
- K=M-1
- DO 20 I=1,K
- FI =I
- TERM=TERM*CHI2/(2.*FI+1.)
- 20 SUM=SUM+TERM
- 21 PROB=CONST*SUM+VALUE
- RETURN
-C-- USE ASYMPTOTIC FORMULA
- 30 ANU=1./FLOAT (N)
- AN9=ANU/4.5
- XP=1./3.
- Z=((CHI2*ANU)**XP - (1.-AN9)) / SQRT (AN9)
- PROB=1. - FREQ (Z)
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/tcgenr/ptor.F b/src/packlib/kernlib/kerngen/obsolete/tcgenr/ptor.F
deleted file mode 100644
index 840d981..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/tcgenr/ptor.F
+++ /dev/null
@@ -1,66 +0,0 @@
-*
-* $Id: ptor.F,v 1.1.1.1 1996/02/15 17:53:27 mclareni Exp $
-*
-* $Log: ptor.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:27 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- FUNCTION PTOR(ARG)
-C
-C
- COMMON/PHYS/PHYSIC(20)
- DIMENSION IPHYS(20)
- EQUIVALENCE(PHYSIC,IPHYS)
- DATA RANGE/5HRANGE/
-C
-C
-C-- ENTRY PTOR
- A=ARG
- GO TO 10
-C
- ENTRY PTOR1 CDC
-C ENTRY PTOR1 (ARG) -CDC
-C
- IF (ARG.EQ.0.) GO TO 50
- A=1./ARG
- 10 INDIC= 0
- GO TO 30
-C
- ENTRY RTOP CDC
-C ENTRY RTOP (ARG) -CDC
-C
- INDIC= 1
- GO TO 20
-C
- ENTRY RTOP1 CDC
-C-- ENTRY RTOP1 (ARG) -CDC
- IF (ARG.EQ.0.) GO TO 50
- INDIC= 2
- 20 A=ARG
-C
- 30 I=ITIT(RANGE)
- J=I+IPHYS(I+2)+3
- IF (INDIC.NE.0) GO TO 40
- PTOR= FINT(1,A,IPHYS(I+2),PHYSIC(J),PHYSIC(I+3)) /PHYSIC(I+1)
-C RTOP= PTOR IBM
-C PTOR1= PTOR IBM
-C RTOP1= PTOR IBM
- GO TO 100
-C
- 40 A= A*PHYSIC(I+1)
- PTOR= FINT(1,A,IPHYS(I+2),PHYSIC(I+3),PHYSIC(J))
- IF (INDIC.EQ.1) GO TO 100
- PTOR= 1./PTOR
-C RTOP= PTOR IBM
-C PTOR1= PTOR IBM
-C RTOP1= PTOR IBM
- GO TO 100
-C
- 50 PTOR=1.E37
-C PTOR1= PTOR IBM
-C RTOP1= PTOR IBM
- 100 RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/tcgenr/store.F b/src/packlib/kernlib/kerngen/obsolete/tcgenr/store.F
deleted file mode 100644
index 26a417a..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/tcgenr/store.F
+++ /dev/null
@@ -1,78 +0,0 @@
-*
-* $Id: store.F,v 1.1.1.1 1996/02/15 17:53:27 mclareni Exp $
-*
-* $Log: store.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:27 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE STOREB (IWORD,J,N0,IB)
-C
-C
- DIMENSION NPOW2(31)
-C DIMENSION NT(35) A6
-C DIMENSION NT(47) A8
- DIMENSION NT(59) A10
- EQUIVALENCE (NPOW2,NT)
-C
- DIMENSION N2(4)
- EQUIVALENCE (N2,NT(32)) -A4
-C
- DIMENSION N3(12) A8,A10
- EQUIVALENCE (N3,NT(36)) A8,A10
-C
- DIMENSION N4(12) A10
- EQUIVALENCE (N4,NT(48)) A10
-C
- DATA NPOW2 /
- + 1, 2, 4, 8, 16, 32, 64, 128, 256, 512, 1024, 2048, 4096, 8192,
- + 16384, 32768, 65536, 131072, 262144, 524288, 1048576, 2097152,
- + 4194304, 8388608, 16777216, 33554432, 67108864, 134217728,
- + 268435456, 536870912, 1073741824/
-C
- DATA N2 / -A4
- + 2147483648, 4294967296, 8589934592, 17179869184/ -A4
-C
- DATA N3 / A8,A10
- + 34359738368, 68719476736, 137438953472, 274877906944, A8,A10
- + 549755813888, 1099511627776, 2199023255552, 4398046511104, A8,A10
- + 8796093022208, 17592186044416, 35184372088832, 70368744177664/ A8,A10
-C
- DATA N4 / A10
- + 140737488355328, 281474976710656, 562949953421312, A10
- + 1125899906842624, 2251799813685248, 4503599627370496, A10
- + 9007199254740992, 18014398509481984, 36028797018963968, A10
- + 72057594037927936, 144115188075855872, 288230376151711744/ A10
-C
-C- ENTRY STOREB
- IEXP2=IB
- N=NPOW2(IB+1)
- GO TO 12
-C
- ENTRY STORE CDC
-C ENTRY STORE (IWORD,J,N0) -CDC
-C
- ENTRY STORE6 CDC
-C ENTRY STORE6 (IWORD,J,N0) -CDC
-C
- IEXP2=6
- N= 64
- GO TO 12
-C
- ENTRY STORE1 CDC
-C ENTRY STORE1 (IWORD,J,N0) -CDC
-C
- IEXP2=1
- N= 2
-C
- 12 IF (IWORD.LT.0) IWORD=-IWORD
- IP=IEXP2*(J-1)+1
- IPOWER=NPOW2(IP)
- IPW=IPOWER*N
- IWORD=(IWORD/IPW)*IPW
- 1 +MOD (N0,N)*IPOWER
- 2 +MOD (IWORD,IPOWER)
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/tcgenr/storen.F b/src/packlib/kernlib/kerngen/obsolete/tcgenr/storen.F
deleted file mode 100644
index 867f89d..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/tcgenr/storen.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: storen.F,v 1.1.1.1 1996/02/15 17:53:28 mclareni Exp $
-*
-* $Log: storen.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:28 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE STOREN(IWORD,J,NO,N)
-C
-C
- 10 IF(IWORD.LT.0) IWORD=-IWORD
- IPOWER=N**(J-1)
- IWORD=(IWORD/(N*IPOWER))*(N*IPOWER)
- 1 +MOD(NO,N)*IPOWER
- 2 +MOD(IWORD,IPOWER)
- RETURN
- END
-C
diff --git a/src/packlib/kernlib/kerngen/obsolete/tcgenr/strag.F b/src/packlib/kernlib/kerngen/obsolete/tcgenr/strag.F
deleted file mode 100644
index ddd1a80..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/tcgenr/strag.F
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: strag.F,v 1.1.1.1 1996/02/15 17:53:28 mclareni Exp $
-*
-* $Log: strag.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:28 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- FUNCTION STRAG(PINV,EM)
-C
- DIMENSION ENT(15),TAB(15)
- DATA ENT/.0,.001,.00189,.00355,.00675,.0128,.0282,.0460,.0875,.16
- + 5,.312,.593,1.012,5.,100000./
- DATA TAB/.1,.01573,.01445,.0134,.0124,.0117,.0112,.0107,.0102,.00
- + 97,.0092,.0087,.0082,0.,0./
-C
- BI =SQRT(1.+1./(PINV*EM)**2)-1.
-C
- DO 1 I=2,15
- IF(ENT(I).GT.BI) GO TO 2
- 1 CONTINUE
- 2 A=(BI-ENT(I-1))*(TAB(I)-TAB(I-1))/(ENT(I)-ENT(I-1))+TAB(I-1)
- STRAG=SQRT(.938213/EM)*A
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/tcgenr/tcgenr.dat b/src/packlib/kernlib/kerngen/obsolete/tcgenr/tcgenr.dat
deleted file mode 100644
index 2179c5d..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/tcgenr/tcgenr.dat
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: tcgenr.dat,v 1.1.1.1 1996/02/15 17:53:28 mclareni Exp $
-*
-* $Log: tcgenr.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:53:28 mclareni
-* Kernlib
-*
-*
-* This directory was created from kernfor.car patch tcgenr
-#if !defined(CERNLIB_TCGENR)
-
- THIS PATCH CONTAINS OBSOLETE ROUTINES REMOVED FROM
- P=TCGEN, IN PARTICULAR ROUTINES SPECIAL TO THE OLD TC
- PRODUCTION PROGRAMS (THRESH - GRIND - SLICE - INDEX),
- SUCH AS ROUTINES USING TITLE INFORMATION, RUN CARDS,
- CODIFICATION OF PARTICLES, ...
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/obsolete/tcgenr/vmodul.F b/src/packlib/kernlib/kerngen/obsolete/tcgenr/vmodul.F
deleted file mode 100644
index 6072228..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/tcgenr/vmodul.F
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: vmodul.F,v 1.1.1.1 1996/02/15 17:53:28 mclareni Exp $
-*
-* $Log: vmodul.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:28 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- FUNCTION VMODUL(A)
-C
-C
- DIMENSION A(3)
- VMODUL=SQRT(A(1)**2+A(2)**2+A(3)**2)
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/tcgenr/vomas.F b/src/packlib/kernlib/kerngen/obsolete/tcgenr/vomas.F
deleted file mode 100644
index 0786460..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/tcgenr/vomas.F
+++ /dev/null
@@ -1,63 +0,0 @@
-*
-* $Id: vomas.F,v 1.1.1.1 1996/02/15 17:53:28 mclareni Exp $
-*
-* $Log: vomas.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:28 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- FUNCTION VOMAS (IN)
-C
-C- THIS FLOATING/INTEGER FUNCTION CANNOT BE WRITTEN TO SATISFY
-C- ALL COMPILERS. PLEASE PATCHY-MODIFY IT AS NEEDED ON YOURS.
-C- WE ASSERT THIS ROUTINE WILL NOT BE CHANGED AGAIN.
-C
- DIMENSION VMASS(21), IN(9)
- EQUIVALENCE (RESULT,IRESUL), (MASS,AMASS)
-C
-C-- , NOUGHT , GAMMA , NU , ELECTRON ,
-C-- , MU , PI0 , PI+- , K+- , K0 , PROTON ,
-C-- , NEUTRON , LAMBDA , SIGMA+ , SIGMA0 , SIGMA- , XI0 ,
-C-- , XI- , DEUTERON , TRITON , HE3++ , HE4++ , =
-C
- DATA VMASS/ 0. ,.1E-10 ,.1E-9 ,.000511006,
- + .105659 ,.13501 ,.13960 ,.4938 ,.4980 ,.938256 ,
- + .939550 ,1.11540 ,1.18941 ,1.1923 ,1.19708 ,1.3143 ,
- + 1.3208 ,1.87549 ,2.80879 ,2.80824 ,3.72718/
-C
-C
-C- RETURN 'IN' AS FUNCTION VALUE, IF 'IN' NOT IN RANGE
-C
- IRESUL = IN(1)
- IF (IRESUL.LT.0) GO TO 19
- IF (IRESUL.GE.4096) GO TO 19
- IPC = MOD (IRESUL,64)
- IF (IPC.GE.22) GO TO 31
- IF (IPC.EQ.0) GO TO 19
-C
-C-- PARTICLES
-C
- RESULT = VMASS(IPC)
- 19 VOMAS = RESULT
- RETURN
-C
-C-- ANTIPARTICLES
-C
- 31 IF (IPC.GE.50) GO TO 19
- IF (IPC.LT.42) GO TO 19
- RESULT = -VMASS(IPC-32)
- GO TO 19
-C
-C
- ENTRY IOFMAS CDC
-C ENTRY IOFMAS (IN) -CDC
-C
- MASS = IN(1)
- IRESUL = IUCOMP (ABS(AMASS),VMASS(1),21)
- IF (AMASS.LT.0.) IRESUL=IRESUL+32
- VOMAS = RESULT CDC
-C IOFMAS = IRESUL -CDC
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/tcgenr/votauf.F b/src/packlib/kernlib/kerngen/obsolete/tcgenr/votauf.F
deleted file mode 100644
index 1c1bde2..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/tcgenr/votauf.F
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: votauf.F,v 1.1.1.1 1996/02/15 17:53:28 mclareni Exp $
-*
-* $Log: votauf.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:28 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- FUNCTION VOTAUF(MCOD)
-C
-C
-C
- DIMENSION VTAU (21)
-C
-C-- , NOUGHT , GAMMA , NU , ELECTRON ,
-C , MU , PI0 , PI+- , K+- , K0 , PROTON ,
-C , NEUTRON , LAMBDA , SIGMA+ , SIGMA0 , SIGMA- , XI0 ,
-C , XI- , DEUTERON , TRITON , HE3++ , HE4++ ,
-C
- DATA VTAU /1.0E8 ,1.0E8 ,1.0E8 ,1.0E8 ,
- +2.2001E-6 ,1.80E-16 ,2.55E-8 ,1.229E-8 ,0.92E-10 ,1.0E8 ,
- +1.0100E3 ,2.62E-10 ,7.88E-11 ,1.0E-15 ,1.58E-10 ,3.06E-10 ,
- +1.74E-10 ,1.0E8 ,1.0E8 ,1.0E8 ,1.0E8/
-C
- MASCOD = MOD(MCOD, 32)
- VOTAUF = 1.0E10
- IF (MASCOD .GT. 0 .AND. MASCOD .LT. 22) VOTAUF = VTAU(MASCOD)
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/tcgenr/xin123.F b/src/packlib/kernlib/kerngen/obsolete/tcgenr/xin123.F
deleted file mode 100644
index 065c325..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/tcgenr/xin123.F
+++ /dev/null
@@ -1,44 +0,0 @@
-*
-* $Id: xin123.F,v 1.1.1.1 1996/02/15 17:53:28 mclareni Exp $
-*
-* $Log: xin123.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:28 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE XIN123 (LUN,IPAR,A,N)
-C
-C
-C- ROUTINE COMMON TO THE BASIC AND THE EXTENDED X-PACKAGE.
-C
- DIMENSION A(N)
- DATA LBCD/14/ A10
-C DATA LBCD/17/ A8
-C DATA LBCD/22/ A6
-C DATA LBCD/27/ A5
-C DATA LBCD/34/ A4
-C
-C
- IF (IPAR) 99,20,10
- 10 READ (LUN) A
- RETURN
-C
- 20 IF (N.LE.LBCD) GO TO 22
- READ (LUN,1000) (A(J),J=1,LBCD)
- RETURN
-C
- 22 READ (LUN,1000) A
- 99 RETURN
-C
- 1000 FORMAT (13A10,A6) A10
-C1000 FORMAT (20A8) A8
-C1000 FORMAT (30A6) A6
-C1000 FORMAT (27A5) A5
-C1000 FORMAT (33A4) A4
-C
-C
-C- USING THE 'SHORT LIST' FORM OF I/O IS 10 TIMES FASTER WITH SIPROS
-C- THAN USING THE 'LONG LIST' FORM READ (LUN) (A(J),J=JA,JE)
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/tcgenr/xot123.F b/src/packlib/kernlib/kerngen/obsolete/tcgenr/xot123.F
deleted file mode 100644
index 0924b1c..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/tcgenr/xot123.F
+++ /dev/null
@@ -1,35 +0,0 @@
-*
-* $Id: xot123.F,v 1.1.1.1 1996/02/15 17:53:28 mclareni Exp $
-*
-* $Log: xot123.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:28 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE XOT123 (LUN,IPAR,A,N)
-C
-C
-C- ROUTINE COMMON TO THE BASIC AND THE EXTENDED X-PACKAGE.
-C
- DIMENSION A(N)
-C
-C
- IF (IPAR) 99,20,10
- 10 WRITE (LUN) A
- RETURN
-C
- 20 WRITE (LUN,1000) A
- 99 RETURN
-C
- 1000 FORMAT (13A10,A6) A10
-C1000 FORMAT (17A8) A8
-C1000 FORMAT (22A6) A6
-C1000 FORMAT (27A5) A5
-C1000 FORMAT (33A4) A4
-C
-C
-C- USING THE 'SHORT LIST' FORM OF I/O IS 10 TIMES FASTER WITH SIPROS
-C- THAN USING THE 'LONG LIST' FORM WRITE (LUN) (A(J),J=JA,JE)
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/tcgenr/xwrbcd.F b/src/packlib/kernlib/kerngen/obsolete/tcgenr/xwrbcd.F
deleted file mode 100644
index 2294ac6..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/tcgenr/xwrbcd.F
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: xwrbcd.F,v 1.1.1.1 1996/02/15 17:53:28 mclareni Exp $
-*
-* $Log: xwrbcd.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:28 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- SUBROUTINE XWRBCD (ITAPE,M,NW,NCH)
-C
-C
-C-- ROUTINE COMMON TO THE BASIC AND THE EXTENDED XPACKAGE.
-C
- DIMENSION M(100)
- DATA NCHW/10/ A10
-C DATA NCHW/ 8/ A8
-C DATA NCHW/6/ A6
-C DATA NCHW/5/ A5
-C DATA NCHW/4/ A4
-C
- NWS= NW
- IF (NWS.LE.0) NWS=(NCH-1)/NCHW + 1
- CALL XOT123 (ITAPE,0,M,NWS)
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/obsolete/tcgenr/zfield.F b/src/packlib/kernlib/kerngen/obsolete/tcgenr/zfield.F
deleted file mode 100644
index a4da766..0000000
--- a/src/packlib/kernlib/kerngen/obsolete/tcgenr/zfield.F
+++ /dev/null
@@ -1,50 +0,0 @@
-*
-* $Id: zfield.F,v 1.1.1.1 1996/02/15 17:53:28 mclareni Exp $
-*
-* $Log: zfield.F,v $
-* Revision 1.1.1.1 1996/02/15 17:53:28 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "pilot.h"
- FUNCTION ZFIELD (X,Y,Z)
-C
-C
- COMMON/SLATE/BINS(34),COOR1,COOR(3),IADR,JADR
- COMMON/PHYS/PHYSIC(20)
- DIMENSION IPHYS(20)
- EQUIVALENCE (PHYSIC,IPHYS)
- DATA FIELD/5HFIELD/, FIELD2/6HRFIELD/
-C
-C
- IADR=ITIT(FIELD)
- GOTO 1
-C
- ENTRY RFIELD CDC
-C ENTRY RFIELD (X,Y,Z) -CDC
-C
- IADR=ITIT(FIELD2)
-C
- 1 IF (IADR.EQ.0) GO TO 101
- IF (PHYSIC(IADR+1).EQ.-1.) GO TO 11
- COOR(1)=X-PHYSIC(IADR+8)
- COOR(2)=Y-PHYSIC(IADR+9)
- IF(COOR(1).EQ.0. .AND. COOR(2).EQ.0.) GOTO 6
- IF (PHYSIC(IADR+1).EQ.0.) GO TO 6
- COOR1=SQRT (COOR(1)**2+COOR(2)**2)
- COOR(2)=57.29578 *ATAN2(COOR(2),COOR(1))
- IF(COOR(2) .LT. 0.) COOR(2)=COOR(2) + 360.
- COOR(1)=COOR1
- 6 COOR(3)=Z-PHYSIC(IADR+10)
- JADR=11+IADR+IPHYS(IADR+5)+IPHYS(IADR+6)+IPHYS(IADR+7)
- ZFIELD= PHYSIC(IADR+2)*FINT(3,COOR ,IPHYS(IADR+5),PHYSIC(IADR
- 1 +11),PHYSIC(JADR))+PHYSIC(IADR+3)
- 100 RETURN
- 11 ZFIELD= PHYSIC(IADR+2)
-C RFIELD= ZFIELD IBM
- GO TO 100
- 101 ZFIELD=0.
-C RFIELD= ZFIELD IBM
- GO TO 100
- END
diff --git a/src/packlib/kernlib/kerngen/other/Imakefile b/src/packlib/kernlib/kerngen/other/Imakefile
deleted file mode 100644
index d348f16..0000000
--- a/src/packlib/kernlib/kerngen/other/Imakefile
+++ /dev/null
@@ -1,27 +0,0 @@
-#define IHaveSubdirs
-#define PassCDebugFlags
-
-#if defined(CERNLIB_WINNT)
-LIBDIRS=wntgs
-#elif defined(CERNLIB_DOS)
-LIBDIRS=dosgs
-#else
-#if defined(CERNLIB_MPW)
-LIBDIRS=mpwgs
-#else
-#undef IHaveSubdirs
-all::
-
-#endif
-#endif
-
-#ifdef IHaveSubdirs
-
-SUBDIRS= $(LIBDIRS)
-
-MakeSubdirs($(SUBDIRS))
-
-SubdirLibraryTarget(kerngen,$(LIBDIRS))
-
-#endif
-
diff --git a/src/packlib/kernlib/kerngen/other/dosgs/Imakefile b/src/packlib/kernlib/kerngen/other/dosgs/Imakefile
deleted file mode 100644
index 8e67214..0000000
--- a/src/packlib/kernlib/kerngen/other/dosgs/Imakefile
+++ /dev/null
@@ -1,12 +0,0 @@
-SRCS_F= \ @@\
- btest.F ibclr.F ibset.F ishftl.F jiand.F jior.F \ @@\
- putget.F vxinvb.F vxinvc.F
-
-SRCS_C= \ @@\
- cbyt.c ckrack.c csethi.c csetoi.c floarg.c iand.c incbyt.c \ @@\
- intarg.c ishft.c ishftc.c ishftl.c ishftr.c iumode.c iuweed.c \ @@\
- jbit.c jbyt.c jbytet.c jbytor.c jbytpk.c jrsbyt.c locbyt.c \ @@\
- mbytet.c mbytor.c mcbyt.c msbyt.c pause.c pkbyt.c sbyt.c sbytor.c \ @@\
- ublow.c ubunch.c uflint.c upkbyt.c upkch.c
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kerngen/other/dosgs/btest.F b/src/packlib/kernlib/kerngen/other/dosgs/btest.F
deleted file mode 100644
index 1400523..0000000
--- a/src/packlib/kernlib/kerngen/other/dosgs/btest.F
+++ /dev/null
@@ -1,15 +0,0 @@
-*
-* $Id: btest.F,v 1.1.1.1 1996/02/15 17:50:04 mclareni Exp $
-*
-* $Log: btest.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:04 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QF_F2C)
- LOGICAL FUNCTION BTEST(IZW,IZP)
- BTEST = AND (IZW,LSHIFT(1,IZP)) .NE. 0
- RETURN
- END
-#endif
diff --git a/src/packlib/kernlib/kerngen/other/dosgs/cbyt.c b/src/packlib/kernlib/kerngen/other/dosgs/cbyt.c
deleted file mode 100644
index e672c96..0000000
--- a/src/packlib/kernlib/kerngen/other/dosgs/cbyt.c
+++ /dev/null
@@ -1,38 +0,0 @@
-/*
- * $Id: cbyt.c,v 1.1.1.1 1996/02/15 17:50:02 mclareni Exp $
- *
- * $Log: cbyt.c,v $
- * Revision 1.1.1.1 1996/02/15 17:50:02 mclareni
- * Kernlib
- *
- */
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QF_F2C)
-/* cbyt.f -- translated by f2c and been corrected by V.E.Fine by hand
- You must link the resulting object file with the libraries:
- -lF77 -lI77 -lm -lc (in that order)
-*/
-
-#include "kerngen/qf_f2c.h"
-
-/* Subroutine */ int cbyt_(m, lm, ix, lx, nb)
-integer *m, *lm, *ix, *lx, *nb;
-{
- /* System generated locals */
- integer i__1;
-
- /* Local variables */
- extern /* Subroutine */ int sbyt_();
-
-
-/* CERN PROGLIB# M421 CBYT .VERSION KERNFOR 4.23 891215 */
-
-/* ORIG. 14/08/70 CL */
-
-
- i__1 = (unsigned) (*m << 33 - *lm - *nb) >> 32 - *nb;
- sbyt_(&i__1, ix, lx, nb);
- return 0;
-} /* cbyt_ */
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/other/dosgs/ckrack.c b/src/packlib/kernlib/kerngen/other/dosgs/ckrack.c
deleted file mode 100644
index d7c86e8..0000000
--- a/src/packlib/kernlib/kerngen/other/dosgs/ckrack.c
+++ /dev/null
@@ -1,573 +0,0 @@
-/*
- * $Id: ckrack.c,v 1.1.1.1 1996/02/15 17:50:02 mclareni Exp $
- *
- * $Log: ckrack.c,v $
- * Revision 1.1.1.1 1996/02/15 17:50:02 mclareni
- * Kernlib
- *
- */
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QF_F2C)
-/* ckrack.f -- translated by f2c and been corrected by V.E.Fine by hand
- You must link the resulting object file with the libraries:
- -lF77 -lI77 -lm -lc (in that order)
-*/
-
-#include "kerngen/qf_f2c.h"
-
-/* Common Block Declarations */
-
-struct {
- integer ndigt, neslat, mode, ngslat, num[2], ivalv[6], nexpv[6], jxop,
- jxme, jxfa, jxfe, jterm, iphase, negm, nege, nexpm, nerr;
- real dummy[12];
-} slate_;
-
-#define slate_1 slate_
-
-/* Table of constant values */
-
-static integer c__27 = 27;
-static struct { integer fill; char val[8+1]; char fill2[3]; } c_b18_st = { 0,
- " .+-EDed" };
-#define c_b18 c_b18_st.val
-static integer c__2 = 2;
-static integer c__1 = 1;
-static struct { integer fill; char val[2+1]; char fill2[1]; } c_b38_st = { 0,
- "+-" };
-#define c_b38 c_b38_st.val
-static real c_b44 = (float)10.;
-static doublereal c_b54 = 10.;
-static struct { integer fill; char val[7+1]; } c_b60_st = { 0,"0OoBbXx" };
-#define c_b60 c_b60_st.val
-static integer c__3 = 3;
-static integer c__4 = 4;
-
-/* Subroutine */ int ckrack_(chv, jlp, jrp, iflagd, chv_len)
-char *chv;
-integer *jlp, *jrp, *iflagd;
-ftnlen chv_len;
-{
- /* System generated locals */
- integer i__1, i__2;
-
- /* Builtin functions */
- integer i_indx();
- double pow_ri(), pow_di();
-
- /* Local variables */
- static integer ndig, ival;
-#define anum ((real *)&slate_1 + 4)
-#define dnum ((doublereal *)&slate_1 + 2)
- static integer j, k, n, nexpu, jj, jr;
- static doublereal dfract;
-#define islate ((integer *)&slate_1)
- static integer ntrail, ivalnt;
-
-
-/* CERN PROGLIB# M432 CKRACK .VERSION KERNFOR 4.29 910718 */
-
-/* ORIG. 12/06/91, JZ */
-
-/* - Read the next number from CHV(JL:JR) */
-/* - formats: (1) bits - #On octal, or #Bn binary, or #Xn hex */
-/* - (2) integer - [+|-]n */
-/* - (3) floating - [+|-][n][.][f][E][+|-][n] */
-/* - (4) double - [+|-][n][.][f]D[+|-][n] */
-/* - */
-/* - Returns: NDSLAT number of numeric digits seen */
-/* - NESLAT COL(NESLAT) is the terminating character */
-/* - NFSLAT mode: -ve bad, 0 blank, 1 B, 2 I, 3 F, 4 D */
-/* - NGSLAT = zero if correct termination */
-/* - = NESLAT otherwise */
-/* - NUM(1) or ANUM(1) or DNUM returns the value */
- /* Parameter adjustments */
- --jrp;
- --jlp;
- --chv;
-
- /* Function Body */
- jj = jlp[1];
- jr = jrp[1];
- for (j = 1; j <= 28; ++j) {
-/* L12: */
- islate[j - 1] = 0;
- }
-/* ---- Look at the first character of the number */
-L17:
- if (jj > jr) {
- goto L90;
- }
- if (chv[jj] == ' ') {
- ++jj;
- goto L17;
- } else if (chv[jj] == '#') {
- goto L71;
- } else if (chv[jj] == '+') {
- ++jj;
- } else if (chv[jj] == '-') {
- slate_1.negm = 7;
- ++jj;
- }
-/* ---- Read an integer */
-L21:
- slate_1.jterm = 0;
- ndig = 0;
- ival = 0;
-L22:
- if (jj > jr) {
- goto L27;
- }
- k = chv[jj];
- k += -48;
- if (k < 0) {
- goto L26;
- }
- if (k >= 10) {
- goto L26;
- }
- if ((unsigned) (ival) >> c__27 != 0) {
- goto L24;
- }
-L23:
- ++jj;
- ival = ival * 10 + k;
- ++ndig;
- goto L22;
-/* -- getting near the integer capacity */
-L24:
- if (slate_1.iphase != 0) {
- goto L93;
- }
- if (slate_1.jxop < 6) {
- ++slate_1.jxop;
- slate_1.ivalv[slate_1.jxop - 1] = ival;
- slate_1.nexpv[slate_1.jxop - 1] = ndig;
- }
- ival = 0;
- goto L23;
-L26:
- slate_1.jterm = i_indx(c_b18, chv + jj, 8L, 1L) - 1;
-/* - 01234567 */
-L27:
- if (ndig != 0) {
- slate_1.ndigt += ndig;
- if (slate_1.jxop < 6) {
- ++slate_1.jxop;
- slate_1.ivalv[slate_1.jxop - 1] = ival;
- slate_1.nexpv[slate_1.jxop - 1] = ndig;
- }
- }
-/* -- IPHASE = 0 : IVAL is the leading integer */
-/* - 2 : is the exponent integer */
- if (slate_1.iphase != 0) {
- goto L51;
- }
- slate_1.jxme = slate_1.jxop;
- if (slate_1.jterm >= 1) {
- goto L31;
- }
-/* -- pure integer */
-L28:
- if (slate_1.ndigt == 0) {
- goto L91;
- }
- slate_1.mode = 2;
- slate_1.num[0] = slate_1.ivalv[0];
- if (slate_1.jxme < 2) {
- goto L29;
- }
- n = slate_1.nexpv[1] - slate_1.nexpv[0];
- if (n >= 2) {
- goto L92;
- }
- slate_1.ivalv[0] = (slate_1.num[0] << c__2) + slate_1.ivalv[0];
- slate_1.num[0] = slate_1.ivalv[0] << c__1;
- if (slate_1.num[0] < 0) {
- goto L92;
- }
- slate_1.num[0] += slate_1.ivalv[1];
- if (slate_1.num[0] < 0) {
- goto L92;
- }
-L29:
- if (slate_1.negm != 0) {
- slate_1.num[0] = -slate_1.num[0];
- }
-L30:
- slate_1.neslat = jj;
- if (slate_1.jterm == 0) {
- return 0;
- }
- slate_1.ngslat = jj;
- return 0;
-/* ---- Read the fraction */
-L31:
- if (slate_1.jterm != 1) {
- goto L41;
- }
- slate_1.jxfa = slate_1.jxop;
- slate_1.mode = 3;
- ++jj;
- slate_1.jterm = 0;
- ndig = 0;
-L32:
- ival = 0;
- ivalnt = 0;
- ntrail = 0;
-L33:
- if (jj > jr) {
- goto L37;
- }
- k = chv[jj];
- k += -48;
- if (k < 0) {
- goto L36;
- }
- if (k >= 10) {
- goto L36;
- }
- if ((unsigned) (ival) >> c__27 != 0) {
- goto L34;
- }
- ++jj;
- ival = ival * 10 + k;
- ++ndig;
- if (k == 0) {
- ++ntrail;
- } else {
- ntrail = 0;
- ivalnt = ival;
- }
- goto L33;
-/* -- getting near the integer capacity */
-L34:
- if (slate_1.jxop < 6) {
- ++slate_1.jxop;
- slate_1.ivalv[slate_1.jxop - 1] = ivalnt;
- slate_1.nexpv[slate_1.jxop - 1] = ntrail - ndig;
- }
- goto L32;
-L36:
- slate_1.jterm = i_indx(c_b18, chv + jj, 8L, 1L) - 1;
-/* - 01234567 */
-L37:
- slate_1.ndigt += ndig;
- if (ival != 0) {
- if (slate_1.jxop < 6) {
- ++slate_1.jxop;
- slate_1.ivalv[slate_1.jxop - 1] = ivalnt;
- slate_1.nexpv[slate_1.jxop - 1] = ntrail - ndig;
- }
- }
- slate_1.jxfe = slate_1.jxop;
- if (slate_1.jterm < 2) {
- goto L52;
- }
-/* ---- Read the exponent */
-L41:
- slate_1.iphase = 2;
- if (slate_1.ndigt == 0) {
- goto L91;
- }
- if (slate_1.jterm >= 4) {
- goto L44;
- }
- if (jj == jr) {
- if (slate_1.mode == 0) {
- goto L28;
- }
- goto L52;
- }
- slate_1.mode = 3;
- slate_1.nege = slate_1.jterm - 2;
- ++jj;
- goto L21;
-L44:
- if (slate_1.jterm >= 6) {
- slate_1.jterm += -2;
- }
- slate_1.mode = slate_1.jterm - 1;
- ++jj;
- if (jj > jr) {
- slate_1.jterm = 0;
- goto L52;
- }
- j = i_indx(c_b38, chv + jj, 2L, 1L);
- if (j == 0) {
- goto L21;
- }
- if (jj == jr) {
- goto L52;
- }
- slate_1.nege = j - 1;
- ++jj;
- goto L21;
-/* -- Exponent complete, construct the number */
-L51:
- slate_1.nexpm = ival;
- if (slate_1.nege != 0) {
- slate_1.nexpm = -slate_1.nexpm;
- }
-L52:
- if (*iflagd >= 0) {
- if (slate_1.mode == 4) {
- goto L61;
- }
- if (*iflagd != 0) {
- goto L61;
- }
- }
- anum[0] = (float)0.;
- anum[1] = (float)0.;
- if (slate_1.jxme == 0) {
- goto L56;
- }
-/* -- single precision, integer part */
- anum[0] = (real) slate_1.ivalv[0];
- if (slate_1.jxme >= 2) {
- n = slate_1.nexpv[1] - slate_1.nexpv[0];
- i__1 = n;
- for (j = 1; j <= i__1; ++j) {
-/* L53: */
- anum[0] *= (float)10.;
- }
- anum[0] += (real) slate_1.ivalv[1];
- }
- if (slate_1.nexpm == 0) {
- goto L56;
- }
- if (slate_1.nexpm < 0) {
- goto L55;
- }
- if (slate_1.nexpm > 9) {
- goto L55;
- }
- i__1 = slate_1.nexpm;
- for (j = 1; j <= i__1; ++j) {
-/* L54: */
- anum[0] *= (float)10.;
- }
- goto L56;
-L55:
- anum[0] *= pow_ri(&c_b44, &slate_1.nexpm);
-/* -- single precision, fraction */
-L56:
- if (slate_1.jxfe <= slate_1.jxfa) {
- goto L60;
- }
- i__1 = slate_1.jxfe;
- for (slate_1.jxop = slate_1.jxfa + 1; slate_1.jxop <= i__1;
- ++slate_1.jxop) {
- anum[1] = (real) slate_1.ivalv[slate_1.jxop - 1];
- nexpu = slate_1.nexpv[slate_1.jxop - 1] + slate_1.nexpm;
- if (nexpu == 0) {
- goto L59;
- }
- if (nexpu < 0) {
- goto L58;
- }
- if (nexpu > 9) {
- goto L58;
- }
- i__2 = nexpu;
- for (j = 1; j <= i__2; ++j) {
-/* L57: */
- anum[1] *= (float)10.;
- }
- goto L59;
-L58:
- anum[1] *= pow_ri(&c_b44, &nexpu);
-L59:
- anum[0] += anum[1];
- }
-L60:
- if (slate_1.negm != 0) {
- anum[0] = -(doublereal)anum[0];
- }
- goto L30;
-/* -- double precision, integer part */
-L61:
- slate_1.mode = 4;
- *dnum = (float)0.;
- if (slate_1.jxme == 0) {
- goto L66;
- }
- *dnum = (doublereal) slate_1.ivalv[0];
- if (slate_1.jxme >= 2) {
- n = slate_1.nexpv[1] - slate_1.nexpv[0];
- i__1 = n;
- for (j = 1; j <= i__1; ++j) {
-/* L63: */
- *dnum *= (float)10.;
- }
- *dnum += (doublereal) slate_1.ivalv[1];
- }
- if (slate_1.nexpm == 0) {
- goto L66;
- }
- if (slate_1.nexpm < 0) {
- goto L65;
- }
- if (slate_1.nexpm > 9) {
- goto L65;
- }
- i__1 = slate_1.nexpm;
- for (j = 1; j <= i__1; ++j) {
-/* L64: */
- *dnum *= (float)10.;
- }
- goto L66;
-L65:
- *dnum *= pow_di(&c_b54, &slate_1.nexpm);
-/* -- double precision, fraction */
-L66:
- if (slate_1.jxfe <= slate_1.jxfa) {
- goto L70;
- }
- i__1 = slate_1.jxfe;
- for (slate_1.jxop = slate_1.jxfa + 1; slate_1.jxop <= i__1;
- ++slate_1.jxop) {
- dfract = (doublereal) slate_1.ivalv[slate_1.jxop - 1];
- nexpu = slate_1.nexpv[slate_1.jxop - 1] + slate_1.nexpm;
- if (nexpu == 0) {
- goto L69;
- }
- if (nexpu < 0) {
- goto L68;
- }
- if (nexpu > 9) {
- goto L68;
- }
- i__2 = nexpu;
- for (j = 1; j <= i__2; ++j) {
-/* L67: */
- dfract *= (float)10.;
- }
- goto L69;
-L68:
- dfract *= pow_di(&c_b54, &nexpu);
-L69:
- *dnum += dfract;
- }
-L70:
- if (slate_1.negm != 0) {
- *dnum = -(*dnum);
- }
- goto L30;
-/* -------- Reading octal or binary or hexadecimal */
-L71:
- j = i_indx(c_b60, chv + (jj + 1), 7L, 1L);
- if (j == 0) {
- goto L94;
- }
- jj += 2;
- if (j >= 6) {
- goto L82;
- }
- if (j >= 4) {
- goto L76;
- }
-/* -- octal */
-L72:
- if (jj > jr) {
- goto L87;
- }
- k = chv[jj];
- if (k == 32) {
- goto L87;
- }
- k += -48;
- if (k < 0) {
- goto L86;
- }
- if (k >= 8) {
- goto L86;
- }
- slate_1.num[0] = (slate_1.num[0] << c__3) + k;
- ++slate_1.ndigt;
- ++jj;
- goto L72;
-/* -- binary */
-L76:
- if (jj > jr) {
- goto L87;
- }
- k = chv[jj];
- if (k == 32) {
- goto L87;
- }
- k += -48;
- if (k < 0) {
- goto L86;
- }
- if (k >= 2) {
- goto L86;
- }
- slate_1.num[0] = (slate_1.num[0] << c__1) + k;
- ++slate_1.ndigt;
- ++jj;
- goto L76;
-/* -- hexadecimal */
-L82:
- if (jj > jr) {
- goto L87;
- }
- k = chv[jj];
- if (k == 32) {
- goto L87;
- }
- k += -48;
- if (k < 0) {
- goto L86;
- }
- if (k < 10) {
- goto L84;
- }
- k += -7;
- if (k < 8) {
- goto L86;
- }
- if (k < 16) {
- goto L84;
- }
- k += -32;
- if (k < 8) {
- goto L86;
- }
- if (k >= 16) {
- goto L86;
- }
-L84:
- slate_1.num[0] = (slate_1.num[0] << c__4) + k;
- ++slate_1.ndigt;
- ++jj;
- goto L82;
-L86:
- slate_1.jterm = -1;
-L87:
- slate_1.mode = 1;
- if (slate_1.ndigt == 0) {
- goto L91;
- }
- goto L30;
-/* ---- Special error exits */
-L94:
- slate_1.nerr = -1;
-L93:
- --slate_1.nerr;
-L92:
- --slate_1.nerr;
-L91:
- --slate_1.nerr;
-L90:
- slate_1.mode = slate_1.nerr;
- slate_1.neslat = jj;
- slate_1.ngslat = jj;
- return 0;
-} /* ckrack_ */
-
-#undef islate
-#undef dnum
-#undef anum
-#endif
diff --git a/src/packlib/kernlib/kerngen/other/dosgs/csethi.c b/src/packlib/kernlib/kerngen/other/dosgs/csethi.c
deleted file mode 100644
index 961858c..0000000
--- a/src/packlib/kernlib/kerngen/other/dosgs/csethi.c
+++ /dev/null
@@ -1,85 +0,0 @@
-/*
- * $Id: csethi.c,v 1.1.1.1 1996/02/15 17:50:02 mclareni Exp $
- *
- * $Log: csethi.c,v $
- * Revision 1.1.1.1 1996/02/15 17:50:02 mclareni
- * Kernlib
- *
- */
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QF_F2C)
-
-
-/* csethi.f -- translated by f2c and been corrected by V.E.Fine by hand
- You must link the resulting object file with the libraries:
- -lF77 -lI77 -lm -lc (in that order)
-*/
-
-#include "kerngen/qf_f2c.h"
-
-/* Common Block Declarations */
-
-struct {
- integer ndslat, neslat, nfslat, ngslat;
- real dummy[36];
-} slate_;
-
-#define slate_1 slate_
-
-/* Table of constant values */
-
-static integer c__15 = 15;
-static integer c__4 = 4;
-
-/* Subroutine */ int csethi_(intp, chv, jlp, jrp, chv_len)
-integer *intp;
-char *chv;
-integer *jlp, *jrp;
-ftnlen chv_len;
-{
- static integer ival, k, jj, jl, ndg;
-
-
-/* CERN PROGLIB# M432 CSETHI .VERSION KERNFOR 4.31 911111 */
-
-/* ORIG. 17/10/89, JZ */
-
-/* - Set hexadecimal integer into CHV(JL:JR) right-justified */
- /* Parameter adjustments */
- --jrp;
- --jlp;
- --intp;
-
- /* Function Body */
- jl = jlp[1];
- jj = jrp[1];
- ival = intp[1];
- ndg = 0;
- slate_1.ngslat = 0;
-L12:
- if (jj < jl) {
- goto L97;
- }
- k = ival & c__15;
- ival = (unsigned) (ival) >> c__4;
- if (k < 10) {
- chv[jj - 1] = (k + 48);
- } else {
- chv[jj - 1] = (k + 55);
- }
- --jj;
- ++ndg;
- if (ival != 0) {
- goto L12;
- }
- goto L98;
-L97:
- slate_1.ngslat = jl;
-L98:
- slate_1.nfslat = jj;
- slate_1.neslat = jj;
- slate_1.ndslat = ndg;
- return 0;
-} /* csethi_ */
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/other/dosgs/csetoi.c b/src/packlib/kernlib/kerngen/other/dosgs/csetoi.c
deleted file mode 100644
index a905ab8..0000000
--- a/src/packlib/kernlib/kerngen/other/dosgs/csetoi.c
+++ /dev/null
@@ -1,79 +0,0 @@
-/*
- * $Id: csetoi.c,v 1.1.1.1 1996/02/15 17:50:02 mclareni Exp $
- *
- * $Log: csetoi.c,v $
- * Revision 1.1.1.1 1996/02/15 17:50:02 mclareni
- * Kernlib
- *
- */
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QF_F2C)
-/* csetoi.f -- translated by f2c and been corrected by V.E.Fine by hand
- You must link the resulting object file with the libraries:
- -lF77 -lI77 -lm -lc (in that order)
-*/
-
-#include "kerngen/qf_f2c.h"
-
-/* Common Block Declarations */
-
-struct {
- integer ndslat, neslat, nfslat, ngslat;
- real dummy[36];
-} slate_;
-
-#define slate_1 slate_
-
-/* Table of constant values */
-
-static integer c__7 = 7;
-static integer c__3 = 3;
-
-/* Subroutine */ int csetoi_(intp, chv, jlp, jrp, chv_len)
-integer *intp;
-char *chv;
-integer *jlp, *jrp;
-ftnlen chv_len;
-{
- static integer ival, k, jj, jl, ndg;
-
-
-/* CERN PROGLIB# M432 CSETOI .VERSION KERNFOR 4.31 911111 */
-
-/* ORIG. 03/06/92, JZ */
-
-/* - Set octal integer into CHV(JL:JR) right-justified */
- /* Parameter adjustments */
- --jrp;
- --jlp;
- --intp;
-
- /* Function Body */
- jl = jlp[1];
- jj = jrp[1];
- ival = intp[1];
- ndg = 0;
- slate_1.ngslat = 0;
-L12:
- if (jj < jl) {
- goto L97;
- }
- k = ival & c__7;
- ival = (unsigned) (ival) >> c__3;
- chv[jj - 1] = (k + 48);
- --jj;
- ++ndg;
- if (ival != 0) {
- goto L12;
- }
- goto L98;
-L97:
- slate_1.ngslat = jl;
-L98:
- slate_1.nfslat = jj;
- slate_1.neslat = jj;
- slate_1.ndslat = ndg;
- return 0;
-} /* csetoi_ */
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/other/dosgs/floarg.c b/src/packlib/kernlib/kerngen/other/dosgs/floarg.c
deleted file mode 100644
index ddf8db8..0000000
--- a/src/packlib/kernlib/kerngen/other/dosgs/floarg.c
+++ /dev/null
@@ -1,66 +0,0 @@
-/*
- * $Id: floarg.c,v 1.1.1.1 1996/02/15 17:50:02 mclareni Exp $
- *
- * $Log: floarg.c,v $
- * Revision 1.1.1.1 1996/02/15 17:50:02 mclareni
- * Kernlib
- *
- */
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QF_F2C)
-/* floarg.f -- translated by f2c and been corrected by V.E.Fine by hand
- You must link the resulting object file with the libraries:
- -lF77 -lI77 -lm -lc (in that order)
-*/
-
-#include "kerngen/qf_f2c.h"
-
-/* Table of constant values */
-
-static integer c__24 = 24;
-static integer c__9 = 9;
-
-doublereal floarg_(argm)
-real *argm;
-{
- /* System generated locals */
- static real equiv_0[1];
-
- /* Local variables */
-#define a (equiv_0)
-#define ia ((integer *)equiv_0)
- static integer jch;
-
-
-/* CERN PROGLIB# M250 FLOARG .VERSION KERNFOR 4.23 891215 */
-
-/* ORIG. 01/8/82 ADAPTED FROM UFLINT */
-
-
-
-
-
-
- /* Parameter adjustments */
- --argm;
-
- /* Function Body */
- *a = argm[1];
- jch = (unsigned) (*ia << 33 - c__24 - c__9) >> 32 - c__9;
- if (jch == 0) {
- goto L36;
- }
- if (jch == 511) {
- goto L36;
- }
- return( *a);
-
-L36:
- return( (real) (*ia));
-} /* floarg_ */
-
-#undef ia
-#undef a
-
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/other/dosgs/iand.c b/src/packlib/kernlib/kerngen/other/dosgs/iand.c
deleted file mode 100644
index 28dc229..0000000
--- a/src/packlib/kernlib/kerngen/other/dosgs/iand.c
+++ /dev/null
@@ -1,20 +0,0 @@
-/*
- * $Id: iand.c,v 1.1.1.1 1996/02/15 17:50:04 mclareni Exp $
- *
- * $Log: iand.c,v $
- * Revision 1.1.1.1 1996/02/15 17:50:04 mclareni
- * Kernlib
- *
- */
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QF_F2C)
-int iand_(ia,ib)
-int *ia, *ib;
- { return *ia & *ib;}
-int ior_(ia,ib)
-int *ia, *ib;
- { return *ia | *ib;}
-int ieor_(ia,ib)
-int *ia, *ib;
- { return *ia ^ *ib;}
-#endif
diff --git a/src/packlib/kernlib/kerngen/other/dosgs/ibclr.F b/src/packlib/kernlib/kerngen/other/dosgs/ibclr.F
deleted file mode 100644
index 0ac273a..0000000
--- a/src/packlib/kernlib/kerngen/other/dosgs/ibclr.F
+++ /dev/null
@@ -1,15 +0,0 @@
-*
-* $Id: ibclr.F,v 1.1.1.1 1996/02/15 17:50:04 mclareni Exp $
-*
-* $Log: ibclr.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:04 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QF_F2C)
- FUNCTION IBCLR(IZW,IZP)
- IBCLR = AND (IZW,NOT(LSHIFT(1,IZP)))
- RETURN
- END
-#endif
diff --git a/src/packlib/kernlib/kerngen/other/dosgs/ibset.F b/src/packlib/kernlib/kerngen/other/dosgs/ibset.F
deleted file mode 100644
index 137c004..0000000
--- a/src/packlib/kernlib/kerngen/other/dosgs/ibset.F
+++ /dev/null
@@ -1,15 +0,0 @@
-*
-* $Id: ibset.F,v 1.1.1.1 1996/02/15 17:50:04 mclareni Exp $
-*
-* $Log: ibset.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:04 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QF_F2C)
- FUNCTION IBSET(IZW,IZP)
- IBSET = OR (IZW,LSHIFT(1,IZP))
- RETURN
- END
-#endif
diff --git a/src/packlib/kernlib/kerngen/other/dosgs/incbyt.c b/src/packlib/kernlib/kerngen/other/dosgs/incbyt.c
deleted file mode 100644
index 837768f..0000000
--- a/src/packlib/kernlib/kerngen/other/dosgs/incbyt.c
+++ /dev/null
@@ -1,55 +0,0 @@
-/*
- * $Id: incbyt.c,v 1.1.1.1 1996/02/15 17:50:02 mclareni Exp $
- *
- * $Log: incbyt.c,v $
- * Revision 1.1.1.1 1996/02/15 17:50:02 mclareni
- * Kernlib
- *
- */
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QF_F2C)
-/* incbyt.f -- translated by f2c and been corrected by V.E.Fine by hand
- You must link the resulting object file with the libraries:
- -lF77 -lI77 -lm -lc (in that order)
-*/
-
-#include "kerngen/qf_f2c.h"
-
-integer incbyt_(inc, a, jth, nbits)
-integer *inc, *a, *jth, *nbits;
-{
- /* Local variables */
- static integer jpos;
- extern /* Subroutine */ int sbyt_();
- static integer jword, loc, ict;
-
-
-/* CERN PROGLIB# M423 INCBYT .VERSION KERNFOR 4.07 830624 */
-
-/* ORIG. 10/02/71 CL */
-
-
-
-
- /* Parameter adjustments */
- --nbits;
- --a;
-
- /* Function Body */
- jword = (*jth - 1) / nbits[2] + 1;
- jpos = *jth - (jword - 1) * nbits[2];
- loc = (jpos - 1) * nbits[1] + 1;
- ict = *inc + ((unsigned) (a[jword] << 33 - loc - nbits[1]) >>
- 32 - nbits[1]);
- if (ict > nbits[3]) {
- goto L2;
- }
- sbyt_(&ict, &a[jword], &loc, &nbits[1]);
- return 0;
-
-L2:
- sbyt_(&nbits[3], &a[jword], &loc, &nbits[1]);
- return ( ict - nbits[3]);
-} /* incbyt_ */
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/other/dosgs/intarg.c b/src/packlib/kernlib/kerngen/other/dosgs/intarg.c
deleted file mode 100644
index c026313..0000000
--- a/src/packlib/kernlib/kerngen/other/dosgs/intarg.c
+++ /dev/null
@@ -1,69 +0,0 @@
-/*
- * $Id: intarg.c,v 1.1.1.1 1996/02/15 17:50:02 mclareni Exp $
- *
- * $Log: intarg.c,v $
- * Revision 1.1.1.1 1996/02/15 17:50:02 mclareni
- * Kernlib
- *
- */
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QF_F2C)
-/* intarg.f -- translated by f2c and been corrected by V.E.Fine by hand
- You must link the resulting object file with the libraries:
- -lF77 -lI77 -lm -lc (in that order)
-*/
-
-#include "kerngen/qf_f2c.h"
-
-/* Table of constant values */
-
-static integer c__24 = 24;
-static integer c__9 = 9;
-
-integer intarg_(argm)
-real *argm;
-{
- /* System generated locals */
- integer ret_val;
- static real equiv_0[1];
-
- /* Local variables */
-#define a (equiv_0)
-#define ia ((integer *)equiv_0)
- static integer jch;
-
-
-/* CERN PROGLIB# M250 INTARG .VERSION KERNFOR 4.23 891215 */
-
-/* ORIG. 01/8/82 ADAPTED FROM UFLINT */
-
-
-
-
-
-
- /* Parameter adjustments */
- --argm;
-
- /* Function Body */
- *a = argm[1];
- jch = (unsigned) (*ia << 33 - c__24 - c__9) >> 32 - c__9;
- if (jch == 0) {
- goto L36;
- }
- if (jch == 511) {
- goto L36;
- }
- ret_val = *a;
- return ret_val;
-
-L36:
- ret_val = *ia;
- return ret_val;
-} /* intarg_ */
-
-#undef ia
-#undef a
-
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/other/dosgs/ishft.c b/src/packlib/kernlib/kerngen/other/dosgs/ishft.c
deleted file mode 100644
index 98dfad6..0000000
--- a/src/packlib/kernlib/kerngen/other/dosgs/ishft.c
+++ /dev/null
@@ -1,19 +0,0 @@
-/*
- * $Id: ishft.c,v 1.1.1.1 1996/02/15 17:50:01 mclareni Exp $
- *
- * $Log: ishft.c,v $
- * Revision 1.1.1.1 1996/02/15 17:50:01 mclareni
- * Kernlib
- *
- */
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QF_F2C)
-unsigned ishft_(izw, nzb)
-unsigned *izw;
-int *nzb;
-{
- if (*nzb > 0) {return *izw << *nzb;}
- else if (*nzb == 0) {return *izw;}
- else {return (unsigned) (*izw) >> -(*nzb);}
-} /* ishft_ */
-#endif
diff --git a/src/packlib/kernlib/kerngen/other/dosgs/ishftc.c b/src/packlib/kernlib/kerngen/other/dosgs/ishftc.c
deleted file mode 100644
index ebed731..0000000
--- a/src/packlib/kernlib/kerngen/other/dosgs/ishftc.c
+++ /dev/null
@@ -1,53 +0,0 @@
-/*
- * $Id: ishftc.c,v 1.1.1.1 1996/02/15 17:50:00 mclareni Exp $
- *
- * $Log: ishftc.c,v $
- * Revision 1.1.1.1 1996/02/15 17:50:00 mclareni
- * Kernlib
- *
- */
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QF_F2C)
-/* ishftc.f -- translated by f2c and been corrected by V.E.Fine by hand
-*/
-
-#include "kerngen/qf_f2c.h"
-
-integer ishftc_(i, k, l)
-integer *i, *k, *l;
-{
- /* System generated locals */
- integer ret_val, i__1, i__2, i__3, i__4, i__5;
-
-
-/* CERN PROGLIB# M441 ISHFTC .VERSION KERNFOR 4.16 870601 */
-
-/* ORIG. 01/10/85 T.LINDELOF */
-
-/* FORTRAN VERSION OF MIL-STD-1753 ISHFTC FUNCTION */
-/* K IS THE SHIFT COUNT - NEGATIVE TO THE RIGHT */
-/* POSITIVE TO THE LEFT */
-/* L IS THE NUMBER OF THE RIGHTMOST BITS TO BE SHIFTED, ALL */
-/* OTHER BITS ARE LEFT UNCHANGED */
-
-
- if (*k > 0) {
- i__1 = -1 << *l;
- i__2 = (unsigned) (*i << 32 - *l) >> 32 - *k;
- i__3 = (unsigned) (*i << 32 - *l + *k) >> 32 - *l;
- i__4 = i__1 & *i;
- i__5 = i__2 | i__3;
- ret_val = i__4 | i__5;
- } else if (*k < 0) {
- i__1 = -1 << *l;
- i__2 = (unsigned) (*i << 32 - *l) >> 32 - *l - *k;
- i__3 = (unsigned) (*i << *k + 32) >> 32 - *l;
- i__4 = i__1 & *i;
- i__5 = i__2 | i__3;
- ret_val = i__4 | i__5;
- } else {
- ret_val = *i;
- }
- return ret_val;
-} /* ishftc_ */
-#endif
diff --git a/src/packlib/kernlib/kerngen/other/dosgs/ishftl.F b/src/packlib/kernlib/kerngen/other/dosgs/ishftl.F
deleted file mode 100644
index 535caad..0000000
--- a/src/packlib/kernlib/kerngen/other/dosgs/ishftl.F
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: ishftl.F,v 1.1.1.1 1996/02/15 17:50:00 mclareni Exp $
-*
-* $Log: ishftl.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:00 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QF_F2C)
- FUNCTION ISHFTL(IZW,NZB)
- IF (NZB .GT. 0) THEN
- ISHFTL = LSHIFT(IZW,NZB)
- ELSE IF (NZB .EQ. 0) THEN
- ISHFTL = IZW
- ELSE
- ISHFTL = ISHFT(IZW,NZB)
- END IF
- END
-#endif
diff --git a/src/packlib/kernlib/kerngen/other/dosgs/ishftl.c b/src/packlib/kernlib/kerngen/other/dosgs/ishftl.c
deleted file mode 100644
index 82475ba..0000000
--- a/src/packlib/kernlib/kerngen/other/dosgs/ishftl.c
+++ /dev/null
@@ -1,20 +0,0 @@
-/*
- * $Id: ishftl.c,v 1.1.1.1 1996/02/15 17:50:02 mclareni Exp $
- *
- * $Log: ishftl.c,v $
- * Revision 1.1.1.1 1996/02/15 17:50:02 mclareni
- * Kernlib
- *
- */
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QF_F2C)
-
-#include "kerngen/qf_f2c.h"
-
-integer ishftl_(izw, nzb)
-integer *izw, *nzb;
-{
- return (*izw << *nzb);
-} /* ishftl_ */
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/other/dosgs/ishftr.c b/src/packlib/kernlib/kerngen/other/dosgs/ishftr.c
deleted file mode 100644
index 529fd41..0000000
--- a/src/packlib/kernlib/kerngen/other/dosgs/ishftr.c
+++ /dev/null
@@ -1,22 +0,0 @@
-/*
- * $Id: ishftr.c,v 1.1.1.1 1996/02/15 17:50:01 mclareni Exp $
- *
- * $Log: ishftr.c,v $
- * Revision 1.1.1.1 1996/02/15 17:50:01 mclareni
- * Kernlib
- *
- */
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QF_F2C)
-
-#include "kerngen/qf_f2c.h"
-
-integer ishftr_(izw, nzb)
-integer *izw, *nzb;
-{
- if (*nzb > 0) {return (unsigned) (*izw) >> *nzb;}
- else if (*nzb == 0) {return *izw;}
- else {return *izw << -(*nzb);}
-} /* ishftr_ */
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/other/dosgs/iumode.c b/src/packlib/kernlib/kerngen/other/dosgs/iumode.c
deleted file mode 100644
index e7994dc..0000000
--- a/src/packlib/kernlib/kerngen/other/dosgs/iumode.c
+++ /dev/null
@@ -1,42 +0,0 @@
-/*
- * $Id: iumode.c,v 1.1.1.1 1996/02/15 17:50:02 mclareni Exp $
- *
- * $Log: iumode.c,v $
- * Revision 1.1.1.1 1996/02/15 17:50:02 mclareni
- * Kernlib
- *
- */
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QF_F2C)
-/* iumode.f -- translated by f2c and been corrected by V.E.Fine by hand
-*/
-
-#include "kerngen/qf_f2c.h"
-
-/* Table of constant values */
-
-static integer c__24 = 24;
-static integer c__9 = 9;
-
-integer iumode_(word)
-integer *word;
-{
- /* Local variables */
- static integer j;
-
-
-/* CERN PROGLIB# M506 IUMODE .VERSION KERNFOR 4.23 891215 */
-
-/* ORIG. 14/04/79 JZ */
-
-/* RETURN ZERO IF WORD CONTAINS AN INTEGER */
-/* PROGRAM WRITTEN 27-APR-79, JZ */
-
- j = (unsigned) (*word << 33 - c__24 - c__9) >> 32 - c__9;
- if (j == 511) {
- j = 0;
- }
- return (j);
-} /* iumode_ */
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/other/dosgs/iuweed.c b/src/packlib/kernlib/kerngen/other/dosgs/iuweed.c
deleted file mode 100644
index 98db070..0000000
--- a/src/packlib/kernlib/kerngen/other/dosgs/iuweed.c
+++ /dev/null
@@ -1,60 +0,0 @@
-/*
- * $Id: iuweed.c,v 1.1.1.1 1996/02/15 17:50:02 mclareni Exp $
- *
- * $Log: iuweed.c,v $
- * Revision 1.1.1.1 1996/02/15 17:50:02 mclareni
- * Kernlib
- *
- */
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QF_F2C)
-/* iuweed.f -- translated by f2c and been corrected by V.E.Fine by hand
- You must link the resulting object file with the libraries:
- -lF77 -lI77 -lm -lc (in that order)
-*/
-
-#include "kerngen/qf_f2c.h"
-
-/* Table of constant values */
-
-static integer c__23 = 23;
-static integer c__255 = 255;
-
-integer iuweed_(ia, n)
-integer *ia, *n;
-{
- /* System generated locals */
- integer ret_val, i__1, i__2;
-
- /* Local variables */
- static integer ival, j;
-
-
-/* CERN PROGLIB# N103 IUWEED .VERSION KERNFOR 4.31 911111 */
-
-/* ORIG. 16/10/91 JZ */
-/* - Find position of first number which is infinity or not-a-number */
-
-/* - in the N word vector IA, return zero if none */
-/* - --- this version only for machines with IEEE representation ---
-*/
- /* Parameter adjustments */
- --ia;
-
- /* Function Body */
- i__1 = *n;
- for (j = 1; j <= i__1; ++j) {
- i__2 = (unsigned) (ia[j]) >> c__23;
- ival = i__2 & c__255;
- if (ival == 255) {
- goto L29;
- }
-/* L24: */
- }
- j = 0;
-L29:
- ret_val = j;
- return ret_val;
-} /* iuweed_ */
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/other/dosgs/jbit.c b/src/packlib/kernlib/kerngen/other/dosgs/jbit.c
deleted file mode 100644
index fb24ef6..0000000
--- a/src/packlib/kernlib/kerngen/other/dosgs/jbit.c
+++ /dev/null
@@ -1,41 +0,0 @@
-/*
- * $Id: jbit.c,v 1.1.1.1 1996/02/15 17:50:02 mclareni Exp $
- *
- * $Log: jbit.c,v $
- * Revision 1.1.1.1 1996/02/15 17:50:02 mclareni
- * Kernlib
- *
- */
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QF_F2C)
-/* jbit.f -- translated by f2c and been corrected by V.E.Fine by hand
- You must link the resulting object file with the libraries:
- -lF77 -lI77 -lm -lc (in that order)
-*/
-
-#include "kerngen/qf_f2c.h"
-
-/* Table of constant values */
-
-static integer c__1 = 1;
-
-integer jbit_(izw, izp)
-integer *izw, *izp;
-{
- /* System generated locals */
- integer ret_val, i__1, i__2;
-
-
-/* CERN PROGLIB# M421 JBIT .VERSION KERNFOR 4.23 891215 */
-
-/* ORIG. 13/03/89 JZ */
-
-/* This non-ANSI code is a default which may be slow, if so */
-/* it should be replaced by a machine-specific fast routine */
- i__1 = *izp - 1;
- i__2 = (unsigned) (*izw) >> i__1;
- ret_val = i__2 & c__1;
- return ret_val;
-} /* jbit_ */
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/other/dosgs/jbyt.c b/src/packlib/kernlib/kerngen/other/dosgs/jbyt.c
deleted file mode 100644
index 3167b03..0000000
--- a/src/packlib/kernlib/kerngen/other/dosgs/jbyt.c
+++ /dev/null
@@ -1,37 +0,0 @@
-/*
- * $Id: jbyt.c,v 1.1.1.1 1996/02/15 17:50:03 mclareni Exp $
- *
- * $Log: jbyt.c,v $
- * Revision 1.1.1.1 1996/02/15 17:50:03 mclareni
- * Kernlib
- *
- */
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QF_F2C)
-/* jbyt.f -- translated by f2c and been corrected by V.E.Fine by hand
- You must link the resulting object file with the libraries:
- -lF77 -lI77 -lm -lc (in that order)
-*/
-
-#include "kerngen/qf_f2c.h"
-
-integer jbyt_(izw, izp, nzb)
-integer *izw, *izp, *nzb;
-{
- /* System generated locals */
- integer i__1, i__2, i__3;
-
-
-/* CERN PROGLIB# M421 JBYT .VERSION KERNFOR 4.23 891215 */
-
-/* ORIG. 13/03/89 JZ */
-
-/* This non-ANSI code is a default which may be slow, if so */
-/* it should be replaced by a machine-specific fast routine */
- i__1 = 33 - *izp - *nzb;
- i__2 = *izw << i__1;
- i__3 = 32 - *nzb;
- return (unsigned) (i__2) >> i__3;
-} /* jbyt_ */
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/other/dosgs/jbytet.c b/src/packlib/kernlib/kerngen/other/dosgs/jbytet.c
deleted file mode 100644
index a988c96..0000000
--- a/src/packlib/kernlib/kerngen/other/dosgs/jbytet.c
+++ /dev/null
@@ -1,36 +0,0 @@
-/*
- * $Id: jbytet.c,v 1.1.1.1 1996/02/15 17:50:03 mclareni Exp $
- *
- * $Log: jbytet.c,v $
- * Revision 1.1.1.1 1996/02/15 17:50:03 mclareni
- * Kernlib
- *
- */
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QF_F2C)
-/* jbytet.f -- translated by f2c and been corrected by V.E.Fine by hand
-*/
-
-#include "kerngen/qf_f2c.h"
-
-integer jbytet_(mz, izw, izp, nzb)
-integer *mz, *izw, *izp, *nzb;
-{
- /* System generated locals */
- integer i__1, i__2, i__3, i__4;
-
-
-/* CERN PROGLIB# M421 JBYTET .VERSION KERNFOR 4.23 891215 */
-
-/* ORIG. 13/03/89 JZ */
-
-/* This non-ANSI code is a default which may be slow, if so */
-/* it should be replaced by a machine-specific fast routine */
- i__1 = 33 - *izp - *nzb;
- i__2 = *izw << i__1;
- i__3 = 32 - *nzb;
- i__4 = (unsigned) (i__2) >> i__3;
- return *mz & i__4;
-} /* jbytet_ */
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/other/dosgs/jbytor.c b/src/packlib/kernlib/kerngen/other/dosgs/jbytor.c
deleted file mode 100644
index 1231303..0000000
--- a/src/packlib/kernlib/kerngen/other/dosgs/jbytor.c
+++ /dev/null
@@ -1,38 +0,0 @@
-/*
- * $Id: jbytor.c,v 1.1.1.1 1996/02/15 17:50:03 mclareni Exp $
- *
- * $Log: jbytor.c,v $
- * Revision 1.1.1.1 1996/02/15 17:50:03 mclareni
- * Kernlib
- *
- */
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QF_F2C)
-/* jbytor.f -- translated by f2c and been corrected by V.E.Fine by hand
- You must link the resulting object file with the libraries:
- -lF77 -lI77 -lm -lc (in that order)
-*/
-
-#include "kerngen/qf_f2c.h"
-
-integer jbytor_(mz, izw, izp, nzb)
-integer *mz, *izw, *izp, *nzb;
-{
- /* System generated locals */
- integer i__1, i__2, i__3, i__4;
-
-
-/* CERN PROGLIB# M421 JBYTOR .VERSION KERNFOR 4.23 891215 */
-
-/* ORIG. 13/03/89 JZ */
-
-/* This non-ANSI code is a default which may be slow, if so */
-/* it should be replaced by a machine-specific fast routine */
- i__1 = 33 - *izp - *nzb;
- i__2 = *izw << i__1;
- i__3 = 32 - *nzb;
- i__4 = (unsigned) (i__2) >> i__3;
- return *mz | i__4;
-} /* jbytor_ */
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/other/dosgs/jbytpk.c b/src/packlib/kernlib/kerngen/other/dosgs/jbytpk.c
deleted file mode 100644
index 94dba3c..0000000
--- a/src/packlib/kernlib/kerngen/other/dosgs/jbytpk.c
+++ /dev/null
@@ -1,55 +0,0 @@
-/*
- * $Id: jbytpk.c,v 1.1.1.1 1996/02/15 17:50:04 mclareni Exp $
- *
- * $Log: jbytpk.c,v $
- * Revision 1.1.1.1 1996/02/15 17:50:04 mclareni
- * Kernlib
- *
- */
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QF_F2C)
-/* jbytpk.f -- translated by f2c and been corrected by V.E.Fine by hand
- You must link the resulting object file with the libraries:
- -lF77 -lI77 -lm -lc (in that order)
-*/
-
-#include "kerngen/qf_f2c.h"
-
-integer jbytpk_(a, jth, nbits)
-integer *a, *jth, *nbits;
-{
- /* System generated locals */
- integer ret_val;
-
- /* Local variables */
- static integer nbit, jpos, jword, inword, loc;
-
-
-/* CERN PROGLIB# M422 JBYTPK .VERSION KERNFOR 4.07 830624 */
-
-/* ORIG. 10/02/71 CL */
-
- /* Parameter adjustments */
- --nbits;
- --a;
-
- /* Function Body */
- nbit = nbits[1];
- if (nbit > 0) {
- goto L7;
- }
- nbit = 1;
- inword = 32;
- goto L11;
-
-L7:
- inword = nbits[2];
-L11:
- jword = (*jth - 1) / inword + 1;
- jpos = *jth - (jword - 1) * inword;
- loc = (jpos - 1) * nbit + 1;
- ret_val = (unsigned) (a[jword] << 33 - loc - nbit) >> 32 - nbit;
- return ret_val;
-} /* jbytpk_ */
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/other/dosgs/jiand.F b/src/packlib/kernlib/kerngen/other/dosgs/jiand.F
deleted file mode 100644
index 0feb937..0000000
--- a/src/packlib/kernlib/kerngen/other/dosgs/jiand.F
+++ /dev/null
@@ -1,13 +0,0 @@
-*
-* $Id: jiand.F,v 1.1.1.1 1996/02/15 17:50:04 mclareni Exp $
-*
-* $Log: jiand.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:04 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- function jiand(ia,ib)
-#include "kerngen/q_andor.inc"
- jiand = iand(ia,ib)
- end
diff --git a/src/packlib/kernlib/kerngen/other/dosgs/jior.F b/src/packlib/kernlib/kerngen/other/dosgs/jior.F
deleted file mode 100644
index 6e22a8b..0000000
--- a/src/packlib/kernlib/kerngen/other/dosgs/jior.F
+++ /dev/null
@@ -1,13 +0,0 @@
-*
-* $Id: jior.F,v 1.1.1.1 1996/02/15 17:50:05 mclareni Exp $
-*
-* $Log: jior.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:05 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- function jior(ia,ib)
-#include "kerngen/q_andor.inc"
- jior = ior(ia,ib)
- end
diff --git a/src/packlib/kernlib/kerngen/other/dosgs/jrsbyt.c b/src/packlib/kernlib/kerngen/other/dosgs/jrsbyt.c
deleted file mode 100644
index d880615..0000000
--- a/src/packlib/kernlib/kerngen/other/dosgs/jrsbyt.c
+++ /dev/null
@@ -1,37 +0,0 @@
-/*
- * $Id: jrsbyt.c,v 1.1.1.1 1996/02/15 17:50:04 mclareni Exp $
- *
- * $Log: jrsbyt.c,v $
- * Revision 1.1.1.1 1996/02/15 17:50:04 mclareni
- * Kernlib
- *
- */
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QF_F2C)
-/* jrsbyt.f -- translated by f2c and been corrected by V.E.Fine by hand
- You must link the resulting object file with the libraries:
- -lF77 -lI77 -lm -lc (in that order)
-*/
-
-#include "kerngen/qf_f2c.h"
-
-integer jrsbyt_(val, x, jth, nbits)
-integer *val, *x, *jth, *nbits;
-{
- /* System generated locals */
- integer ret_val;
-
- /* Local variables */
- extern /* Subroutine */ int sbyt_();
-
-
-/* CERN PROGLIB# M421 JRSBYT .VERSION KERNFOR 4.07 830624 */
-
-/* ORIG. 03/05/72 JZ */
-
- ret_val = (unsigned) (*x << 33 - *jth - *nbits) >> 32 - *nbits;
- sbyt_(val, x, jth, nbits);
- return ret_val;
-} /* jrsbyt_ */
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/other/dosgs/locbyt.c b/src/packlib/kernlib/kerngen/other/dosgs/locbyt.c
deleted file mode 100644
index a5fefcf..0000000
--- a/src/packlib/kernlib/kerngen/other/dosgs/locbyt.c
+++ /dev/null
@@ -1,56 +0,0 @@
-/*
- * $Id: locbyt.c,v 1.1.1.1 1996/02/15 17:50:04 mclareni Exp $
- *
- * $Log: locbyt.c,v $
- * Revision 1.1.1.1 1996/02/15 17:50:04 mclareni
- * Kernlib
- *
- */
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QF_F2C)
-/* locbyt.f -- translated by f2c and been corrected by V.E.Fine by hand
- You must link the resulting object file with the libraries:
- -lF77 -lI77 -lm -lc (in that order)
-*/
-
-#include "kerngen/qf_f2c.h"
-
-integer locbyt_(it, ia, n, nw, la, nbits)
-integer *it, *ia, *n, *nw, *la, *nbits;
-{
- /* System generated locals */
- integer ret_val, i__1, i__2;
-
- /* Local variables */
- static integer j;
-
-
-/* CERN PROGLIB# M428 LOCBYT .VERSION KERNFOR 4.07 830624 */
-
-/* ORIG. 03/05/72 */
-
- /* Parameter adjustments */
- --ia;
-
- /* Function Body */
- if (*n == 0) {
- goto L19;
- }
- i__1 = *n;
- i__2 = *nw;
- for (j = 1; i__2 < 0 ? j >= i__1 : j <= i__1; j += i__2) {
- if ((unsigned) (ia[j] << 33 - *la - *nbits) >> 32 - *nbits == *it) {
- goto L21;
- }
-/* L18: */
- }
-L19:
- ret_val = 0;
- return ret_val;
-
-L21:
- ret_val = j;
- return ret_val;
-} /* locbyt_ */
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/other/dosgs/mbytet.c b/src/packlib/kernlib/kerngen/other/dosgs/mbytet.c
deleted file mode 100644
index 3c985cb..0000000
--- a/src/packlib/kernlib/kerngen/other/dosgs/mbytet.c
+++ /dev/null
@@ -1,40 +0,0 @@
-/*
- * $Id: mbytet.c,v 1.1.1.1 1996/02/15 17:50:04 mclareni Exp $
- *
- * $Log: mbytet.c,v $
- * Revision 1.1.1.1 1996/02/15 17:50:04 mclareni
- * Kernlib
- *
- */
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QF_F2C)
-/* mbytet.f -- translated by f2c and been corrected by V.E.Fine by hand
- You must link the resulting object file with the libraries:
- -lF77 -lI77 -lm -lc (in that order)
-*/
-
-#include "kerngen/qf_f2c.h"
-
-integer mbytet_(mz, izw, izp, nzb)
-integer *mz, *izw, *izp, *nzb;
-{
- /* System generated locals */
- integer ret_val, i__1, i__2, i__3, i__4, i__5;
-
-
-/* CERN PROGLIB# M421 MBYTET .VERSION KERNFOR 4.23 891215 */
-
-/* ORIG. 13/03/89 JZ */
-
-/* This non-ANSI code is a default which may be slow, if so */
-/* it should be replaced by a machine-specific fast routine */
- i__1 = ~ (*mz);
- i__2 = 32 - *nzb;
- i__3 = i__1 << i__2;
- i__4 = 33 - *izp - *nzb;
- i__5 = ~ ((unsigned) (i__3) >> i__4);
- ret_val = *izw & i__5;
- return ret_val;
-} /* mbytet_ */
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/other/dosgs/mbytor.c b/src/packlib/kernlib/kerngen/other/dosgs/mbytor.c
deleted file mode 100644
index 5cbb1a4..0000000
--- a/src/packlib/kernlib/kerngen/other/dosgs/mbytor.c
+++ /dev/null
@@ -1,39 +0,0 @@
-/*
- * $Id: mbytor.c,v 1.1.1.1 1996/02/15 17:50:04 mclareni Exp $
- *
- * $Log: mbytor.c,v $
- * Revision 1.1.1.1 1996/02/15 17:50:04 mclareni
- * Kernlib
- *
- */
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QF_F2C)
-/* mbytor.f -- translated by f2c and been corrected by V.E.Fine by hand
- You must link the resulting object file with the libraries:
- -lF77 -lI77 -lm -lc (in that order)
-*/
-
-#include "kerngen/qf_f2c.h"
-
-integer mbytor_(mz, izw, izp, nzb)
-integer *mz, *izw, *izp, *nzb;
-{
- /* System generated locals */
- integer ret_val, i__1, i__2, i__3, i__4;
-
-
-/* CERN PROGLIB# M421 MBYTOR .VERSION KERNFOR 4.23 891215 */
-
-/* ORIG. 13/03/89 JZ */
-
-/* This non-ANSI code is a default which may be slow, if so */
-/* it should be replaced by a machine-specific fast routine */
- i__1 = 32 - *nzb;
- i__2 = *mz << i__1;
- i__3 = 33 - *izp - *nzb;
- i__4 = (unsigned) (i__2) >> i__3;
- ret_val = *izw | i__4;
- return ret_val;
-} /* mbytor_ */
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/other/dosgs/mcbyt.c b/src/packlib/kernlib/kerngen/other/dosgs/mcbyt.c
deleted file mode 100644
index a1cd544..0000000
--- a/src/packlib/kernlib/kerngen/other/dosgs/mcbyt.c
+++ /dev/null
@@ -1,47 +0,0 @@
-/*
- * $Id: mcbyt.c,v 1.1.1.1 1996/02/15 17:50:04 mclareni Exp $
- *
- * $Log: mcbyt.c,v $
- * Revision 1.1.1.1 1996/02/15 17:50:04 mclareni
- * Kernlib
- *
- */
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QF_F2C)
-/* mcbyt.f -- translated by f2c and been corrected by V.E.Fine by hand
- You must link the resulting object file with the libraries:
- -lF77 -lI77 -lm -lc (in that order)
-*/
-
-#include "kerngen/qf_f2c.h"
-
-integer mcbyt_(mz, izq, izw, izp, nzb)
-integer *mz, *izq, *izw, *izp, *nzb;
-{
- /* System generated locals */
- integer ret_val, i__1, i__2, i__3, i__4, i__5, i__6, i__7, i__8, i__9,
- i__10, i__11;
-
-
-/* CERN PROGLIB# M421 MCBYT .VERSION KERNFOR 4.23 891215 */
-
-/* ORIG. 13/03/89 JZ */
-
-/* This non-ANSI code is a default which may be slow, if so */
-/* it should be replaced by a machine-specific fast routine */
- i__1 = 32 - *nzb;
- i__2 = (unsigned) (-1) >> i__1;
- i__3 = *izp - 1;
- i__4 = ~ (i__2 << i__3);
- i__5 = *izq - 1;
- i__6 = (unsigned) (*mz) >> i__5;
- i__7 = 32 - *nzb;
- i__8 = i__6 << i__7;
- i__9 = 33 - *izp - *nzb;
- i__10 = *izw & i__4;
- i__11 = (unsigned) (i__8) >> i__9;
- ret_val = i__10 | i__11;
- return ret_val;
-} /* mcbyt_ */
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/other/dosgs/msbyt.c b/src/packlib/kernlib/kerngen/other/dosgs/msbyt.c
deleted file mode 100644
index 8aed766..0000000
--- a/src/packlib/kernlib/kerngen/other/dosgs/msbyt.c
+++ /dev/null
@@ -1,44 +0,0 @@
-/*
- * $Id: msbyt.c,v 1.1.1.1 1996/02/15 17:50:04 mclareni Exp $
- *
- * $Log: msbyt.c,v $
- * Revision 1.1.1.1 1996/02/15 17:50:04 mclareni
- * Kernlib
- *
- */
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QF_F2C)
-/* msbyt.f -- translated by f2c and been corrected by V.E.Fine by hand
- You must link the resulting object file with the libraries:
- -lF77 -lI77 -lm -lc (in that order)
-*/
-
-#include "kerngen/qf_f2c.h"
-
-integer msbyt_(mz, izw, izp, nzb)
-integer *mz, *izw, *izp, *nzb;
-{
- /* System generated locals */
- integer ret_val, i__1, i__2, i__3, i__4, i__5, i__6, i__7, i__8, i__9;
-
-
-/* CERN PROGLIB# M421 MSBYT .VERSION KERNFOR 4.23 891215 */
-
-/* ORIG. 13/03/89 JZ */
-
-/* This non-ANSI code is a default which may be slow, if so */
-/* it should be replaced by a machine-specific fast routine */
- i__1 = 32 - *nzb;
- i__2 = (unsigned) (-1) >> i__1;
- i__3 = *izp - 1;
- i__4 = ~ (i__2 << i__3);
- i__5 = 32 - *nzb;
- i__6 = *mz << i__5;
- i__7 = 33 - *izp - *nzb;
- i__8 = *izw & i__4;
- i__9 = (unsigned) (i__6) >> i__7;
- ret_val = i__8 | i__9;
- return ret_val;
-} /* msbyt_ */
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/other/dosgs/pause.c b/src/packlib/kernlib/kerngen/other/dosgs/pause.c
deleted file mode 100644
index b9ff25c..0000000
--- a/src/packlib/kernlib/kerngen/other/dosgs/pause.c
+++ /dev/null
@@ -1,19 +0,0 @@
-/*
- * $Id: pause.c,v 1.1.1.1 1996/02/15 17:50:00 mclareni Exp $
- *
- * $Log: pause.c,v $
- * Revision 1.1.1.1 1996/02/15 17:50:00 mclareni
- * Kernlib
- *
- */
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_WINNT)
-#include <conio.h>
-int pause_()
- {
- int first_char;
- first_char = _getch();
- if (first_char == 0 ^ first_char == 0xE0) first_char = -_getch();
- return first_char;
- }
-#endif
diff --git a/src/packlib/kernlib/kerngen/other/dosgs/pkbyt.c b/src/packlib/kernlib/kerngen/other/dosgs/pkbyt.c
deleted file mode 100644
index 1cf8b74..0000000
--- a/src/packlib/kernlib/kerngen/other/dosgs/pkbyt.c
+++ /dev/null
@@ -1,106 +0,0 @@
-/*
- * $Id: pkbyt.c,v 1.1.1.1 1996/02/15 17:50:04 mclareni Exp $
- *
- * $Log: pkbyt.c,v $
- * Revision 1.1.1.1 1996/02/15 17:50:04 mclareni
- * Kernlib
- *
- */
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QF_F2C)
-/* pkbyt.f -- translated by f2c and been corrected by V.E.Fine by hand
- You must link the resulting object file with the libraries:
- -lF77 -lI77 -lm -lc (in that order)
-*/
-
-#include "kerngen/qf_f2c.h"
-
-/* Subroutine */ int pkbyt_(miv, mbv, jthp, nintp, nbits)
-integer *miv, *mbv, *jthp, *nintp, *nbits;
-{
- /* System generated locals */
- integer i__1, i__2, i__3, i__4;
-
- /* Local variables */
- static integer mska, jive, nint, npwd, jpos, msku, nl, jbv, jth, jiv, nzb,
- izw;
-
-
-/* CERN PROGLIB# M422 PKBYT .VERSION KERNFOR 4.23 891215 */
-
-/* ORIG. 13/03/89 JZ */
-
-/* This non-ANSI code is a default which may be slow, if so */
-/* it should be replaced by a machine-specific fast routine */
-
- /* Parameter adjustments */
- --nbits;
- --nintp;
- --jthp;
- --mbv;
- --miv;
-
- /* Function Body */
- jth = jthp[1];
- nint = nintp[1];
- if (nint <= 0) {
- return 0;
- }
- nzb = nbits[1];
- if (nzb > 0) {
- goto L11;
- }
- nzb = 1;
- npwd = 32;
- mska = 1;
- goto L12;
-L11:
- npwd = nbits[2];
- i__1 = 32 - nzb;
- mska = (unsigned) (-1) >> i__1;
-L12:
- jbv = 1;
- jiv = 0;
- if (jth < 2) {
- goto L21;
- }
- jbv = (jth - 1) / npwd + 1;
- jpos = jth - (jbv - 1) * npwd - 1;
- if (jpos == 0) {
- goto L21;
- }
- nl = jpos * nzb;
- msku = mska << nl;
- jive = npwd - jpos;
- goto L22;
-/* -- PACK EACH WORD */
-L21:
- nl = 0;
- msku = mska;
- jive = jiv + npwd;
-L22:
- jive = min(nint,jive);
- izw = mbv[jbv];
-L24:
- ++jiv;
- i__1 = ~ msku;
- i__2 = miv[jiv] << nl;
- i__3 = i__1 & izw;
- i__4 = msku & i__2;
- izw = i__3 | i__4;
- if (jiv == jive) {
- goto L27;
- }
- nl += nzb;
- msku <<= nzb;
- goto L24;
-L27:
- mbv[jbv] = izw;
- if (jiv == nint) {
- return 0;
- }
- ++jbv;
- goto L21;
-} /* pkbyt_ */
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/other/dosgs/putget.F b/src/packlib/kernlib/kerngen/other/dosgs/putget.F
deleted file mode 100644
index 0b667b6..0000000
--- a/src/packlib/kernlib/kerngen/other/dosgs/putget.F
+++ /dev/null
@@ -1,313 +0,0 @@
-*
-* $Id: putget.F,v 1.1.1.1 1996/02/15 17:50:00 mclareni Exp $
-*
-* $Log: putget.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:00 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QS_DOS)
- SUBROUTINE PUTGET(EINSTR,LCHSTR,HISCMD,MAXCUR,HICMD)
-*
-* PARAMETERS:
-*
-* EINSTR C ENTERED COMMAND STRING
-* LCHSTR I LENGTH OF THE INSTR
-* HISCMD C STACK CONTAINING STRINGS ENTERED EARLIER
-* MAXCUR I MAX CAPACITY OF THE STACK
-* HICMD I CURRENT POSITION INSIDE STACK
-*
-c
-c These are the keyboard scan codes used
-
- PARAMETER (k_ctrl_C = 3, k_ctrl_Z=26,k_ctrl_Q=17)
- PARAMETER (k_ctrl_K =11)
- PARAMETER (k_rt_arr = -77, k_lt_arr = -75)
- PARAMETER (k_up_arr = -72, k_dn_arr = -80)
- PARAMETER (k_PGUP = -73, k_PGDW = -81)
- PARAMETER (k_HOME = -71, k_END = -79)
- PARAMETER (k_INS = -82, k_DEL = -83, k_ENTER = 13)
- PARAMETER (k_CR = 13)
- PARAMETER (k_BS = 8, k_ESC = 27)
- PARAMETER (k_alt_H = -35)
- PARAMETER (k_beep = 7)
-
-*
-*
- INTEGER HICMD
- CHARACTER*(*) HISCMD(*)
- INTEGER*2 MAXCUR
-
- PARAMETER (ICRCOL = 2)
- integer*2 icur, lstr, ival, isym, iupdt, icurod, INS
- CHARACTER*(*) EINSTR
- CHARACTER*(255) INSTR
- CHARACTER*1 CURSOR,CURTYP(2)
-#include "kerngen/grex.inc"
- ixg(ix) = ix*8
- iyg(iy) = iy*16+5
- IND(I) = ISHFT(I+2,-1)+1
-*
- data ins /1/
- * CURTYP / '','_'/
-*
-* Init work
-*
-CCC MAXLIN = min(LEN(EINSTR),LEN(INSTR))
- MAXLIN = LEN(INSTR)
- icur = 1
- lstr = icur
- ival = 0
- einstr = ' '
- instr = ' '
- ivideo = get_video_mode(max_row,max_column)
-** WRITE(77,*) ' video MODE=',IVIDEO
- ier = get_cursor(ixc,iyc)
- ixc = ixc-1
- if (ivideo .ne. 3) then
- icurod = icur
- ier = magnify_text(1,1)
-** iii = get_clip_limits(imlimx,imlimy,ixlimx,ixlimy)
- iii = get_device_limits(limx,limy,limc)
- ier = set_clip_limits(0,0,limx,limy)
- CURSOR =CURTYP(IND(INS))
-*
-* Set Graphic cursor
-*
- ier=graphic_text(CURSOR,
- * ixg(icur+ixc),iyg(iyc),ICRCOL)
- ELSE
- ier = locate(icur+ixc,iyc)
- END IF
-
-*
- 10 continue
-*
-* Reading next char from keyboard
-*
- isym = pause()
- chone =char(isym)
-*** write(77,222) ' Input char=',chone,' lstr=',lstr
-*** 222 format(3a,i2)
-*
- IUPDT = -1
- if (isym .ge. 32 .AND. LSTR .LE. MAXLIN-2) then
- IF (INS.EQ.1) THEN
- do i=lstr,icur,-1
- j = i+1
- INSTR(j:j)=INSTR(i:i)
- end do
- INSTR(ICUR:ICUR)=chone
- LSTR = LSTR+1
-*
-* Clear the next free positon
-*
- INSTR(LSTR:LSTR)=' '
- ELSE
- INSTR(ICUR:ICUR)=chone
- IF (ICUR .EQ. LSTR) LSTR=LSTR+1
- END IF
- ICUR = ICUR+1
- isht = 1
- IUPDT = LSTR-isht
-*
- else if (isym .eq. k_enter) then
- lstr = lstr-1
- go to 999
-*
- else if (isym .eq. k_ctrl_Z) then
-* lstr = -lstr
- lstr = -1
- go to 999
-*
-*
- else if (isym .eq. k_up_arr) then
- if (ival .ge. maxcur) then
- ier = beep()
- go to 500
- end if
- ival = ival+1
- go to 20
-*
- else if (isym .eq. k_dn_arr) then
- ival = ival-1
-*******
- 20 if (ival .gt. 0 .AND. HICMD .GT. 0) then
- I = HICMD - IVAL+1
- IF (I .LT. 1) I = MAXCUR+I
- LFUL = LENOCC(HISCMD(I))
- IF (LFUL .LT. MAXLIN) THEN
- IF (LFUL .GE. ICUR) THEN
-*
-* Copy line from history into the current string
-*
- INSTR(ICUR:LFUL)=HISCMD(I)(ICUR:LFUL)
- IF (LFUL .LT. LSTR) THEN
- INSTR(LFUL+1:LSTR) = ' '
- END IF
- IUPDT = MAX(LSTR,LFUL+1)
- LSTR = LENOCC(INSTR)+1
- END IF
- ELSE
- ier = beep()
- go to 500
- END IF
- else
-*
-* Clear line
-*
- ier = beep()
- IUPDT = LSTR
- ICUR = 1
- LSTR = ICUR
- INSTR = ' '
- IVAL = 0
- end if
-*
- else if (isym .eq. k_rt_arr) then
- icur = MIN(ICUR,LSTR)+1
- IF (ICUR .EQ. LSTR+1) THEN
- IER = BEEP()
- ICUR = ICUR - 1
- END IF
-*
- else if (isym .eq. k_lt_arr) then
- icur = MAX(1,ICUR)-1
- IF (ICUR .EQ. 0) THEN
- IER = BEEP()
- ICUR = ICUR + 1
- END IF
-*
- else if (isym .eq. k_DEL) then
- IF (ICUR .LE. LSTR-1) THEN
- INSTR(ICUR:LSTR)=INSTR(ICUR+1:LSTR)//' '
- IUPDT = LSTR
- LSTR = LSTR - 1
- ELSE
- IER = BEEP()
- END IF
-*
- else if (isym .eq. k_BS) then
- ICUR = ICUR-1
- IF (ICUR .GE. 1) THEN
- IUPDT = LSTR
- INSTR(ICUR:LSTR)=INSTR(ICUR+1:LSTR)//' '
- LSTR = MAX(ICUR,LSTR-1)
- ELSE
- IER = BEEP()
- ICUR = 1
- END IF
-*
- else if (isym .eq. k_INS) then
- INS = -INS
- IF (IVIDEO .GT. 3) THEN
- IER = SET_XOR(1)
-*
-* Clear OLD Graphic cursor
-*
- ier=graphic_text(CURSOR,
- * ixg(icur+ixc),iyg(iyc),ICRCOL)
- CURSOR = CURTYP(IND(INS))
-*
-* Set NEW Graphic cursor
-*
- ier=graphic_text(CURSOR,
- * ixg(icur+ixc),iyg(iyc),ICRCOL)
- IER = SET_XOR(0)
- END IF
-*
- else if (isym .eq. k_END) then
- ICUR = LSTR
-*
- else if (isym .eq. k_HOME) then
- ICUR = 1
-*
- else if (isym .eq. k_ESC) then
- IUPDT = LSTR
- ICUR = 1
- LSTR = ICUR
- INSTR = ' '
-*
- else if (isym .eq. k_ctrl_K) then
- IUPDT = LSTR
- INSTR(ICUR:LSTR) = ' '
- LSTR = ICUR
-*
- else if (isym .eq. k_ctrl_Q) then
-* CALL KIFLTH(2)
- LSTR = -2
- GO TO 999
-*
- else if (isym .eq. k_ctrl_C) then
-* CALL KIFLTH(2)
- LSTR = -2
- GO TO 999
-*
-*
- else
- IER = BEEP()
- end if
-*
-* Update the displaied line
-*
- IF (ivideo .le. 3) THEN
- ier = locate(icur+ixc-ISHT,iyc)
- ELSE
-*
-* Clear Graphic cursor
-*
- IER = SET_XOR(1)
- ier=graphic_text(CURSOR,
- * ixg(icurod+ixc),iyg(iyc),ICRCOL)
- IER = SET_XOR(0)
- END IF
- if (IUPDT .GT. 0) then
- if (ivideo .le. 3) then
- call write_string(instr(icur-isht:iupdt))
- ier = locate(icur+ixc,iyc)
- else
- ls = iupdt-(icur-isht)+1
- icol = set_color(0)
-**
- ier = filled_rectangle(
- * ixg(icur+ixc-isht),iyg(iyc),
- * ixg(icur+ixc-isht+ls),iyg(iyc+1))
-
- ier=graphic_text(instr(icur-isht:iupdt),
- * ixg(icur+ixc-isht),iyg(iyc),1)
-
- icol = set_color(1)
-* icol = set_color(icol)
- end if
- isht = 0
- end if
- IF (IVIDEO .GT. 3) THEN
-*
-* Set Graphic cursor
-*
- IER = SET_XOR(1)
- ier=graphic_text(CURSOR,
- * ixg(icur+ixc),iyg(iyc),ICRCOL)
- IER = SET_XOR(0)
- ICUROD = ICUR
- END IF
-*
- 500 go to 10
-
- 999 continue
- IF (IVIDEO .GT. 3) THEN
-*
-* Clear Graphic cursor
-*
- IER = SET_XOR(1)
- ier=graphic_text(CURSOR,
- * ixg(icurod+ixc),iyg(iyc),ICRCOL)
- IER = SET_XOR(0)
- END IF
- IF (LSTR .GT. MAXLIN) LSTR=MAXLIN
- lchstr = lstr
-CC EINSTR(:lstr) = INSTR(:lstr)
- return
- end
-#endif
diff --git a/src/packlib/kernlib/kerngen/other/dosgs/sbyt.c b/src/packlib/kernlib/kerngen/other/dosgs/sbyt.c
deleted file mode 100644
index 871ca35..0000000
--- a/src/packlib/kernlib/kerngen/other/dosgs/sbyt.c
+++ /dev/null
@@ -1,47 +0,0 @@
-/*
- * $Id: sbyt.c,v 1.1.1.1 1996/02/15 17:50:04 mclareni Exp $
- *
- * $Log: sbyt.c,v $
- * Revision 1.1.1.1 1996/02/15 17:50:04 mclareni
- * Kernlib
- *
- */
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QF_F2C)
-/* sbyt.f -- translated by f2c and been corrected by V.E.Fine by hand
- You must link the resulting object file with the libraries:
- -lF77 -lI77 -lm -lc (in that order)
-*/
-
-#include "kerngen/qf_f2c.h"
-
-/* Subroutine */ int sbyt_(it, izw, izp, nzb)
-integer *it, *izw, *izp, *nzb;
-{
- /* System generated locals */
- integer i__1, i__2, i__3, i__4, i__5, i__6;
-
- /* Local variables */
- static integer msk;
-
-
-/* CERN PROGLIB# M421 SBYT .VERSION KERNFOR 4.23 891215 */
-
-/* MOD. true default 24/2/89, JZ */
-
-/* This non-ANSI code is a default which may be slow, if so */
-/* it should be replaced by a machine-specific fast routine */
-
- i__1 = 32 - *nzb;
- msk = (unsigned) (-1) >> i__1;
- i__1 = *izp - 1;
- i__2 = ~ (msk << i__1);
- i__3 = *it & msk;
- i__4 = *izp - 1;
- i__5 = *izw & i__2;
- i__6 = i__3 << i__4;
- *izw = i__5 | i__6;
- return 0;
-} /* sbyt_ */
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/other/dosgs/sbytor.c b/src/packlib/kernlib/kerngen/other/dosgs/sbytor.c
deleted file mode 100644
index 0ce453c..0000000
--- a/src/packlib/kernlib/kerngen/other/dosgs/sbytor.c
+++ /dev/null
@@ -1,41 +0,0 @@
-/*
- * $Id: sbytor.c,v 1.1.1.1 1996/02/15 17:50:04 mclareni Exp $
- *
- * $Log: sbytor.c,v $
- * Revision 1.1.1.1 1996/02/15 17:50:04 mclareni
- * Kernlib
- *
- */
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QF_F2C)
-/* sbytor.f -- translated by f2c and been corrected by V.E.Fine by hand
- You must link the resulting object file with the libraries:
- -lF77 -lI77 -lm -lc (in that order)
-*/
-
-#include "kerngen/qf_f2c.h"
-
-/* Subroutine */ int sbytor_(it, izw, izp, nzb)
-integer *it, *izw, *izp, *nzb;
-{
- /* System generated locals */
- integer i__1, i__2, i__3, i__4, i__5;
-
-
-/* CERN PROGLIB# M421 SBYTOR .VERSION KERNFOR 4.23 891215 */
-
-/* ORIG. 13/03/89 JZ */
-
-/* This non-ANSI code is a default which may be slow, if so */
-/* it should be replaced by a machine-specific fast routine */
-
- i__1 = 32 - *nzb;
- i__2 = (unsigned) (-1) >> i__1;
- i__3 = *it & i__2;
- i__4 = *izp - 1;
- i__5 = i__3 << i__4;
- *izw |= i__5;
- return 0;
-} /* sbytor_ */
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/other/dosgs/ublow.c b/src/packlib/kernlib/kerngen/other/dosgs/ublow.c
deleted file mode 100644
index c28eecb..0000000
--- a/src/packlib/kernlib/kerngen/other/dosgs/ublow.c
+++ /dev/null
@@ -1,80 +0,0 @@
-/*
- * $Id: ublow.c,v 1.1.1.1 1996/02/15 17:50:01 mclareni Exp $
- *
- * $Log: ublow.c,v $
- * Revision 1.1.1.1 1996/02/15 17:50:01 mclareni
- * Kernlib
- *
- */
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QF_F2C)
-/* ublow.f -- translated by f2c and been corrected by V.E.Fine by hand
-*/
-
-#include "kerngen/qf_f2c.h"
-
-/* Subroutine */ int ublow_(ms, mt, nchp)
-integer *ms, *mt, *nchp;
-{
- /* System generated locals */
- integer i__1;
-
- /* Local variables */
- extern /* Subroutine */ int abend_();
- static integer js, jt, ntrail, nch, mwd, nws;
-
-
-/* CERN PROGLIB# M409 UBLOW .VERSION KERNDOS 1.00 920624 */
-
-/* ORIG. 03/02/89 K.M.STORR */
-
- /* Parameter adjustments */
- --nchp;
- --mt;
- --ms;
-
- /* Function Body */
- nch = nchp[1];
- if (nch < 0) {
- goto L91;
- } else if (nch == 0) {
- goto L29;
- }
-L11:
- nws = (unsigned) (nch) >> 2;
- ntrail = nch & 3;
- jt = 0;
- if (nws == 0) {
- goto L26;
- }
-/* -- Unpack the initial complete words */
- i__1 = nws;
- for (js = 1; js <= i__1; ++js) {
- mwd = ms[js];
- mt[jt + 1] = 538976256 | 255 & mwd;
- mt[jt + 2] = 538976256 | 255 & (unsigned) (mwd) >> 8;
- mt[jt + 3] = 538976256 | 255 & (unsigned) (mwd) >> 16;
- mt[jt + 4] = 538976256 | (unsigned) (mwd) >> 24;
-/* L24: */
- jt += 4;
- }
- if (ntrail == 0) {
- return 0;
- }
-/* -- Unpack the trailing word */
-L26:
- mwd = ms[nws + 1];
- i__1 = ntrail;
- for (js = 1; js <= i__1; ++js) {
- mt[jt + 1] = 538976256 | 255 & mwd;
- mwd = (unsigned) (mwd) >> 8;
-/* L28: */
- ++jt;
- }
-L29:
- return 0;
-L91:
- abend_();
-} /* ublow_ */
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/other/dosgs/ubunch.c b/src/packlib/kernlib/kerngen/other/dosgs/ubunch.c
deleted file mode 100644
index efd10d5..0000000
--- a/src/packlib/kernlib/kerngen/other/dosgs/ubunch.c
+++ /dev/null
@@ -1,80 +0,0 @@
-/*
- * $Id: ubunch.c,v 1.1.1.1 1996/02/15 17:50:01 mclareni Exp $
- *
- * $Log: ubunch.c,v $
- * Revision 1.1.1.1 1996/02/15 17:50:01 mclareni
- * Kernlib
- *
- */
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QF_F2C)
-/* ubunch.f -- translated by f2c and been corrected by V.E.Fine by hand
- You must link the resulting object file with the libraries:
- -lF77 -lI77 -lm -lc (in that order)
-*/
-
-#include "kerngen/qf_f2c.h"
-
-/* Subroutine */ int ubunch_(ms, mt, nchp)
-integer *ms, *mt, *nchp;
-{
- /* System generated locals */
- integer i__1;
-
- /* Local variables */
- extern /* Subroutine */ int abend_();
- static integer js, jt, ntrail, nch, mwd, nwt;
-
-
-/* CERN PROGLIB# M409 UBUNCH .VERSION KERNDOS 1.00 920624 */
-
-/* ORIG. 03/02/89 K.M.STORR */
-
- /* Parameter adjustments */
- --nchp;
- --mt;
- --ms;
-
- /* Function Body */
- nch = nchp[1];
- if (nch < 0) {
- goto L91;
- } else if (nch == 0) {
- goto L39;
- }
-L11:
- nwt = (unsigned) (nch) >> 2;
- ntrail = nch & 3;
- js = 0;
- if (nwt == 0) {
- goto L31;
- }
-/* -- Pack the initial complete words */
- i__1 = nwt;
- for (jt = 1; jt <= i__1; ++jt) {
- mt[jt] = ms[js + 1] & 255 | (ms[js + 2] & 255) << 8 | (ms[js + 3] &
- 255) << 16 | ms[js + 4] << 24;
-/* L24: */
- js += 4;
- }
- if (ntrail == 0) {
- return 0;
- }
-/* -- Pack the trailing word */
-L31:
- mwd = 538976288;
- js = nch;
- i__1 = ntrail;
- for (jt = 1; jt <= i__1; ++jt) {
- mwd = mwd << 8 | ms[js] & 255;
-/* L34: */
- --js;
- }
- mt[nwt + 1] = mwd;
-L39:
- return 0;
-L91:
- abend_();
-} /* ubunch_ */
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/other/dosgs/uflint.c b/src/packlib/kernlib/kerngen/other/dosgs/uflint.c
deleted file mode 100644
index feebc1d..0000000
--- a/src/packlib/kernlib/kerngen/other/dosgs/uflint.c
+++ /dev/null
@@ -1,115 +0,0 @@
-/*
- * $Id: uflint.c,v 1.1.1.1 1996/02/15 17:50:04 mclareni Exp $
- *
- * $Log: uflint.c,v $
- * Revision 1.1.1.1 1996/02/15 17:50:04 mclareni
- * Kernlib
- *
- */
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QF_F2C)
-/* uflint.f -- translated by f2c and been corrected by V.E.Fine by hand
- You must link the resulting object file with the libraries:
- -lF77 -lI77 -lm -lc (in that order)
-*/
-
-#include "kerngen/qf_f2c.h"
-
-/* Table of constant values */
-
-static integer c__1 = 1;
-static integer c__24 = 24;
-static integer c__9 = 9;
-
-/* Subroutine */ int uflint_(vect, nwp, modep)
-real *vect;
-integer *nwp, *modep;
-{
- /* System generated locals */
- static real equiv_0[1], equiv_1[1];
-
- /* Local variables */
- static integer mode, juse;
- static logical vary;
-#define a (equiv_0)
-#define b (equiv_1)
- static integer n;
-#define ia ((integer *)equiv_0)
-#define ib ((integer *)equiv_1)
- static integer nw, jch;
-
-
-/* CERN PROGLIB# M251 UFLINT .VERSION KERNFOR 4.23 891215 */
-
-/* ORIG. 01/10/77 JZ */
-
-/* - CONVERT VECT(1->NWP) IN SITU TO FLOATING OR INTEGERS ACCORDING */
-/* - TO MODEP */
-
-/* - PROGRAM WRITTEN 12-AUG-77, JZ */
-
-
-
-
-
- /* Parameter adjustments */
- --modep;
- --nwp;
- --vect;
-
- /* Function Body */
- nw = nwp[1];
- mode = modep[1];
- n = 1 - nw;
- vary = TRUE_;
- if (nw < 0) {
- goto L31;
- }
- n = nw + 1;
- vary = FALSE_;
- juse = (unsigned) (mode) >> c__1 - 1 & 1;
- goto L31;
-
-L30:
- vect[n] = *b;
-L31:
- --n;
- if (n == 0) {
- return 0;
- }
- if (vary) {
- juse = (unsigned) (mode) >> n - 1 & 1;
- }
- *a = vect[n];
- jch = (unsigned) (*ia << 33 - c__24 - c__9) >> 32 - c__9;
- if (jch == 0) {
- goto L36;
- }
- if (jch == 511) {
- goto L36;
- }
-
-/* -- CONVERT TO INTEGER */
-
- if (juse == 0) {
- goto L31;
- }
- *ib = *a;
- goto L30;
-
-/* -- CONVERT TO FLOATING */
-L36:
- if (juse != 0) {
- goto L31;
- }
- *b = (real) (*ia);
- goto L30;
-} /* uflint_ */
-
-#undef ib
-#undef ia
-#undef b
-#undef a
-
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/other/dosgs/upkbyt.c b/src/packlib/kernlib/kerngen/other/dosgs/upkbyt.c
deleted file mode 100644
index e146f9a..0000000
--- a/src/packlib/kernlib/kerngen/other/dosgs/upkbyt.c
+++ /dev/null
@@ -1,92 +0,0 @@
-/*
- * $Id: upkbyt.c,v 1.1.1.1 1996/02/15 17:50:04 mclareni Exp $
- *
- * $Log: upkbyt.c,v $
- * Revision 1.1.1.1 1996/02/15 17:50:04 mclareni
- * Kernlib
- *
- */
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QF_F2C)
-#include "kerngen/qf_f2c.h"
-
-/* Subroutine */ int upkbyt_(mbv, jthp, miv, nintp, nbits)
-integer *mbv, *jthp, *miv, *nintp, *nbits;
-{
- /* System generated locals */
- integer i__1;
-
- /* Local variables */
- static integer mska, jive, nint, npwd, jpos, nr, jbv, jth, jiv, nzb, izw;
-
-
-/* CERN PROGLIB# M422 UPKBYT .VERSION KERNFOR 4.23 891215 */
-
-/* ORIG. 13/03/89 JZ */
-
-/* This non-ANSI code is a default which may be slow, if so */
-/* it should be replaced by a machine-specific fast routine */
-
- /* Parameter adjustments */
- --nbits;
- --nintp;
- --miv;
- --jthp;
- --mbv;
-
- /* Function Body */
- jth = jthp[1];
- nint = nintp[1];
- if (nint <= 0) {
- return 0;
- }
- nzb = nbits[1];
- if (nzb > 0) {
- goto L11;
- }
- nzb = 1;
- npwd = 32;
- mska = 1;
- goto L12;
-L11:
- npwd = nbits[2];
- i__1 = 32 - nzb;
- mska = (unsigned) (-1) >> i__1;
-L12:
- jbv = 1;
- jiv = 0;
- if (jth < 2) {
- goto L21;
- }
- jbv = (jth - 1) / npwd + 1;
- jpos = jth - (jbv - 1) * npwd - 1;
- if (jpos == 0) {
- goto L21;
- }
- nr = jpos * nzb;
- jive = npwd - jpos;
- izw = (unsigned) (mbv[jbv]) >> nr;
- goto L22;
-/* -- UNPACK EACH WORD */
-L21:
- jive = jiv + npwd;
- izw = mbv[jbv];
-L22:
- jive = min(nint,jive);
-L24:
- ++jiv;
- miv[jiv] = mska & izw;
- if (jiv == jive) {
- goto L27;
- }
- izw = (unsigned) (izw) >> nzb;
- goto L24;
-L27:
- if (jiv == nint) {
- return 0;
- }
- ++jbv;
- goto L21;
-} /* upkbyt_ */
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/other/dosgs/upkch.c b/src/packlib/kernlib/kerngen/other/dosgs/upkch.c
deleted file mode 100644
index a40a9e7..0000000
--- a/src/packlib/kernlib/kerngen/other/dosgs/upkch.c
+++ /dev/null
@@ -1,162 +0,0 @@
-/*
- * $Id: upkch.c,v 1.1.1.1 1996/02/15 17:50:04 mclareni Exp $
- *
- * $Log: upkch.c,v $
- * Revision 1.1.1.1 1996/02/15 17:50:04 mclareni
- * Kernlib
- *
- */
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QF_F2C)
-#include "kerngen/qf_f2c.h"
-
-/* Common Block Declarations */
-
-struct {
- integer jch, n, nbits, nchar, nzone, ignor, jin, nbdone, nbend, jgo, jbt,
- nleft, nrigh;
- real dummy[27];
-} slate_;
-
-#define slate_1 slate_
-
-/* Table of constant values */
-
-static integer c__1 = 1;
-
-/* Subroutine */ int upkch_(ichv, igv, nn, ipar)
-integer *ichv, *igv, *nn, *ipar;
-{
- /* System generated locals */
- integer i__1, i__2;
-
- /* Local variables */
- extern /* Subroutine */ int cbyt_();
-
-
-/* CERN PROGLIB# M427 UPKCH .VERSION KERNFOR 4.20 881028 */
-
-/* ORIG. 07/07/72 JZ */
-
-/* . */
-
- /* Parameter adjustments */
- --ipar;
- --igv;
- --ichv;
-
- /* Function Body */
- slate_1.n = *nn;
- if (slate_1.n == 0) {
- return 0;
- }
- slate_1.nbits = ipar[1];
- slate_1.nchar = ipar[2];
- slate_1.nzone = ipar[3];
- slate_1.ignor = ipar[4];
- slate_1.jin = 1;
- slate_1.jch = 1;
- if (slate_1.nzone != 0) {
- goto L41;
- }
-
-/* ---- ZONE = WORD */
-
-L21:
- slate_1.jgo = 33 - slate_1.ignor;
- slate_1.nbend = slate_1.nbits + 1;
- if (slate_1.nchar == 0) {
- goto L22;
- }
-/* Computing MAX */
- i__1 = slate_1.nbend, i__2 = slate_1.jgo - slate_1.nbits * (slate_1.nchar
- - 1);
- slate_1.nbend = max(i__1,i__2);
-
-L22:
- slate_1.jbt = slate_1.jgo;
-
-L24:
- slate_1.jbt -= slate_1.nbits;
- igv[slate_1.jin] =
- (unsigned) (ichv[slate_1.jch] << 33 - slate_1.jbt - slate_1.nbits)
- >> 32 - slate_1.nbits;
- if (slate_1.jin == slate_1.n) {
- return 0;
- }
- ++slate_1.jin;
- if (slate_1.jbt >= slate_1.nbend) {
- goto L24;
- }
- ++slate_1.jch;
- goto L22;
-
-/* ---- ZONE NOT EQUALS A WORD */
-
-L41:
- if (slate_1.nzone == 32) {
- goto L21;
- }
- slate_1.jbt = 32 - slate_1.ignor;
- slate_1.nbend = slate_1.nzone + 1 - slate_1.nbits;
- if (slate_1.nchar == 0) {
- goto L42;
- }
-/* Computing MIN */
- i__1 = slate_1.nbend, i__2 = slate_1.ignor + slate_1.nchar *
- slate_1.nbits;
- slate_1.nbend = min(i__1,i__2);
-
-L42:
- slate_1.nbdone = slate_1.ignor;
-L43:
- if (slate_1.jbt >= 0) {
- goto L44;
- }
- slate_1.jbt += 32;
- ++slate_1.jch;
- goto L43;
-
-L44:
- slate_1.jbt -= slate_1.nbits;
- if (slate_1.jbt < 0) {
- goto L51;
- }
- i__1 = slate_1.jbt + 1;
- igv[slate_1.jin] = (unsigned) (ichv[slate_1.jch]
- << 33 - i__1 - slate_1.nbits)
- >> 32 - slate_1.nbits;
- goto L58;
-
-/* -- CHARACTER ACROSS WORD BOUNDARY */
-L51:
- slate_1.nleft = slate_1.nbits + slate_1.jbt;
- slate_1.nrigh = -slate_1.jbt;
- slate_1.jbt += 32;
- i__1 = slate_1.jbt + 1;
- igv[slate_1.jin] = (unsigned)
- (ichv[slate_1.jch + 1] << 33 - i__1 - slate_1.nrigh)
- >> 32 - slate_1.nrigh;
- if (slate_1.nleft == 0) {
- goto L54;
- }
- i__1 = slate_1.nrigh + 1;
- cbyt_(&ichv[slate_1.jch], &c__1, &igv[slate_1.jin], &i__1, &slate_1.nleft)
- ;
-L54:
- ++slate_1.jch;
-
-L58:
- if (slate_1.jin == slate_1.n) {
- return 0;
- }
- ++slate_1.jin;
- slate_1.nbdone += slate_1.nbits;
- if (slate_1.nbdone < slate_1.nbend) {
- goto L44;
- }
- slate_1.jbt = slate_1.jbt - (slate_1.nzone - slate_1.nbdone) -
- slate_1.ignor;
- goto L42;
-} /* upkch_ */
-#endif
diff --git a/src/packlib/kernlib/kerngen/other/dosgs/vxinvb.F b/src/packlib/kernlib/kerngen/other/dosgs/vxinvb.F
deleted file mode 100644
index c48a6bc..0000000
--- a/src/packlib/kernlib/kerngen/other/dosgs/vxinvb.F
+++ /dev/null
@@ -1,62 +0,0 @@
-*
-* $Id: vxinvb.F,v 1.1.1.1 1996/02/15 17:50:00 mclareni Exp $
-*
-* $Log: vxinvb.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:00 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE VXINVB (MVI,NW)
-
-C CERN PROGLIB# M434 VXINVB .VERSION KERNDOS 1.00 920624
-C ORIG. 25-June-92, JZ
-
-C- VX invert bytes, in-place
-
- DIMENSION MVI(99)
-#if defined(CERNLIB_QF_NDP)||defined(CERNLIB_QF_DEC)
- PARAMETER (MASK1 = X'00FF00FF')
- PARAMETER (MASK2 = X'FF00FF00')
-#endif
-#if defined(CERNLIB_QF_F2C)
- DATA MASK1 /X'FF'/
-#endif
-
-#include "kerngen/q_andor.inc"
-#include "kerngen/q_shift.inc"
-
- IF (NW .LE. 0) RETURN
- DO 29 J=1,NW
-#if defined(CERNLIB_QF_NDP)||defined(CERNLIB_QF_DEC)
-C. 1 2 3 4
- MWW = ISHFTC (MVI(J),8,32)
-C. 2 3 4 1
- MST = IAND (MWW, MASK1)
-C. 0 3 0 1
- MWW = IAND (ISHFTC(MWW,16,32), MASK2)
-C. 4 1 2 3
-C. 4 0 2 0
- MVI(J) = IOR (MST,MWW)
-C. 4 3 2 1
-#endif
-#if defined(CERNLIB_QF_F2C)
-C 1-st byte
- IIN = MVI(J)
- IOT = LSHIFT(IAND(IIN,MASK1), 24)
-C 2-nd byte
- IIN = ISHFT(IIN, -8)
- IWORK = IAND(IIN,MASK1)
- IOT = IOR(IOT, LSHIFT(IWORK,16))
-C 3-d byte
- IIN = ISHFT(IIN, -8)
- IWORK = IAND(IIN,MASK1)
- IOT = IOR(IOT, LSHIFT(IWORK,8))
-C last byte
- IIN = ISHFT(IIN, -8)
- IOT = IOR(IOT, IIN)
-
- MVI(J) = IOT
-#endif
- 29 CONTINUE
- END
diff --git a/src/packlib/kernlib/kerngen/other/dosgs/vxinvc.F b/src/packlib/kernlib/kerngen/other/dosgs/vxinvc.F
deleted file mode 100644
index 45d1f70..0000000
--- a/src/packlib/kernlib/kerngen/other/dosgs/vxinvc.F
+++ /dev/null
@@ -1,61 +0,0 @@
-*
-* $Id: vxinvc.F,v 1.1.1.1 1996/02/15 17:50:00 mclareni Exp $
-*
-* $Log: vxinvc.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:00 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE VXINVC (MVI,MVX,NW)
-
-C CERN PROGLIB# M434 VXINVC .VERSION KERNDOS 1.00 920624
-C ORIG. 25-June-92, JZ
-
-C- VX invert bytes and copy
-
- DIMENSION MVI(99), MVX(99)
-#if defined(CERNLIB_QF_NDP)||defined(CERNLIB_QF_DEC)
- PARAMETER (MASK1 = X'00FF00FF')
- PARAMETER (MASK2 = X'FF00FF00')
-#endif
-#if defined(CERNLIB_QF_F2C)
- DATA MASK1 /X'FF'/
-#endif
-
-#include "kerngen/q_andor.inc"
-
- IF (NW .LE. 0) RETURN
- DO 29 J=1,NW
-#if defined(CERNLIB_QF_NDP)||defined(CERNLIB_QF_DEC)
-C. 1 2 3 4
- MWW = ISHFTC (MVI(J),8,32)
-C. 2 3 4 1
- MST = IAND (MWW, MASK1)
-C. 0 3 0 1
- MWW = IAND (ISHFTC(MWW,16,32), MASK2)
-C. 4 1 2 3
-C. 4 0 2 0
- MVX(J) = IOR (MST,MWW)
-C. 4 3 2 1
-#endif
-#if defined(CERNLIB_QF_F2C)
-C 1-st byte
- IIN = MVI(J)
- IOT = LSHIFT(IAND(IIN,MASK1), 24)
-C 2-nd byte
- IIN = ISHFT(IIN, -8)
- IWORK = IAND(IIN,MASK1)
- IOT = IOR(IOT, LSHIFT(IWORK,16))
-C 3-d byte
- IIN = ISHFT(IIN, -8)
- IWORK = IAND(IIN,MASK1)
- IOT = IOR(IOT, LSHIFT(IWORK,8))
-C last byte
- IIN = ISHFT(IIN, -8)
- IOT = IOR(IOT, IIN)
-
- MVX(J) = IOT
-#endif
- 29 CONTINUE
- END
diff --git a/src/packlib/kernlib/kerngen/other/mpwgs/Imakefile b/src/packlib/kernlib/kerngen/other/mpwgs/Imakefile
deleted file mode 100644
index 3e01970..0000000
--- a/src/packlib/kernlib/kerngen/other/mpwgs/Imakefile
+++ /dev/null
@@ -1,4 +0,0 @@
-SRCS_F= \ @@\
- jumpad.F time.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kerngen/other/mpwgs/jumpad.F b/src/packlib/kernlib/kerngen/other/mpwgs/jumpad.F
deleted file mode 100644
index 674815b..0000000
--- a/src/packlib/kernlib/kerngen/other/mpwgs/jumpad.F
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: jumpad.F,v 1.1.1.1 1996/02/15 17:50:05 mclareni Exp $
-*
-* $Log: jumpad.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:05 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- FUNCTION JUMPAD (ITARGT)
-C
-C CERN PROGLIB# Z042 JUMPAD .VERSION KERNMPW 1.00 891208
-C ORIG. 21/04/88 FCA
-C
-C- Get target address for use with JUMPXn
-
- JUMPAD = %LOC (ITARGT)
- END
diff --git a/src/packlib/kernlib/kerngen/other/mpwgs/time.F b/src/packlib/kernlib/kerngen/other/mpwgs/time.F
deleted file mode 100644
index 5c42b06..0000000
--- a/src/packlib/kernlib/kerngen/other/mpwgs/time.F
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: time.F,v 1.1.1.1 1996/02/15 17:50:05 mclareni Exp $
-*
-* $Log: time.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:05 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE TIMEST(TIMINT)
-C
-C CERN PROGLIB# Z007 TIMEST .VERSION KERNMPW 1.00 891208
-C ORIG. 01/12/89 FCA
-C MODIF.06/10/92 Cees de Laat correct TIMED
-C
- SAVE HTIME, TIMLIM, TIMLAS
- DATA HTIME, TIMLAS, TIMLIM /0., 0., 10000./
- HTIME = SECNDS(0.)
- TIMLAS = HTIME
- TIMLIM = TIMINT
- RETURN
- ENTRY TIMEX(T)
- T=SECNDS(HTIME)
- RETURN
- ENTRY TIMEL(T)
- T = TIMLIM - SECNDS(HTIME)
- RETURN
- ENTRY TIMED(T)
- T = SECNDS(TIMLAS)
- TIMLAS = TIMLAS + T
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/Imakefile b/src/packlib/kernlib/kerngen/tcgen/Imakefile
deleted file mode 100644
index b9f128d..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/Imakefile
+++ /dev/null
@@ -1,66 +0,0 @@
-SRCS_F= amaxmu.F bitpos.F blow.F bunch.F ccopiv.F \ @@\
- ccopyl.F ccopyr.F ccosub.F cenvir.F cfill.F cfromi.F cfweof.F
-
-SRCS_F= amaxmu.F bitpos.F blow.F bunch.F ccopiv.F \ @@\
- ccopyl.F ccopyr.F ccosub.F cenvir.F cfill.F cfromi.F cfweof.F \ @@\
- cleft.F cltou.F cright.F cross.F csetdi.F \ @@\
- csetvi.F csetvm.F csqmbl.F csqmch.F ctrans.F \ @@\
- cutol.F doti.F ffsize.F floarg.F flpsor.F \ @@\
- gshow.F gshowf.F icdeci.F icequ.F icfila.F icfind.F \ @@\
- icfmul.F icfnbl.F ichexi.F icinq.F icinql.F icinqu.F icloc.F \ @@\
- iclocl.F iclocu.F icluns.F icnext.F icnth.F icnthl.F icnthu.F \ @@\
- icnum.F icnuma.F icnumu.F icocti.F ictype.F ie3fod.F \ @@\
- ie3tod.F ifromc.F intarg.F intsor.F \ @@\
- iuback.F iubin.F iuchan.F iucola.F \ @@\
- iuend.F iufila.F iufnbl.F iuforw.F iuhist.F \ @@\
- iulast.F iulook.F iumode.F iunext.F \ @@\
- kerngt.F loren4.F lorenb.F \ @@\
- lorenf.F lvsdmi.F lvsdmx.F \ @@\
- lvsimi.F lvsimx.F lvsmi.F lvsmx.F matin1.F \ @@\
- mxequ.F mxmad.F \ @@\
- mxmlrt.F mxtrp.F mxuty.F ncdeci.F nchexi.F ncocti.F \ @@\
- poweze.F proxim.F pscale.F \ @@\
- ranecq.F ranecu.F ranmar.F rannor.F rmmaq.F rmmar.F \ @@\
- rot.F \ @@\
- setfmt.F smxinv.F sorcha.F sortd.F sorti.F \ @@\
- sortr.F sortx.F sortzv.F tcdump.F \ @@\
- tlerr.F tlpiv.F tlres.F tls.F tlsc.F tlsmsq.F \ @@\
- tlstep.F tlswop.F tluk.F traat.F traceq.F tral.F tralt.F \ @@\
- tras.F trasat.F trata.F trats.F tratsa.F trchlu.F trchul.F trinv.F \ @@\
- trla.F trlta.F trpck.F trqsq.F trsa.F trsat.F trsinv.F trsmlu.F \ @@\
- trsmul.F trupck.F ubits.F ucocop.F udicop.F \ @@\
- uleft.F uopt.F uoptc.F uright.F uset.F \ @@\
- utrans.F vdist.F vdist2.F \ @@\
- vizpri.F vlinco.F
-
-#if !defined(CERNLIB_DOS) || defined(CERNLIB_QFMSOFT)
-SRCS_F := $(SRCS_F) ckrack.F csethi.F csetoi.F incbyt.F iuweed.F locbyt.F
-#endif
-
-/* Mil Standard routines usually are availbale, if not add here */
-#if defined(CERNLIB_SUN) || defined(CERNLIB_SGI)
-SRCS_F := $(SRCS_F) ibits.F mvbits.F ishftc.F
-#endif
-
-#if defined(CERNLIB_DOS) && !defined(CERNLIB_QFMSOFT)
-SRCS_F := $(SRCS_F) ibits.F mvbits.F
-#endif
-
-#ifdef CERNLIB_VAX
-SRCS_F := $(SRCS_F) getarg.F lenocc.F
-#endif
-#if defined(CERNLIB_DOS) || defined(CERNLIB_MPW) || defined(CERNLIB_LNX) || defined(CERNLIB_WINNT)
-SRCS_F := $(SRCS_F) lenocc.F
-#endif
-#ifdef CERNLIB_HPUX
-SRCS_F := $(SRCS_F) getarg.F
-#endif
-
-/* IBM mainfarme has ebcdic chars, all other use ascii */
-#ifdef CERNLIB_IBM
-SRCS_F := $(SRCS_F) chtoig.F
-#else
-SRCS_F := $(SRCS_F) chtoi.F itoch.F
-#endif
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kerngen/tcgen/allgs/kerngt.F b/src/packlib/kernlib/kerngen/tcgen/allgs/kerngt.F
deleted file mode 100644
index 758be07..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/allgs/kerngt.F
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: kerngt.F,v 1.1.1.1 1996/02/15 17:49:57 mclareni Exp $
-*
-* $Log: kerngt.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:57 mclareni
-* Kernlib
-*
-*
- SUBROUTINE KERNGT (LUN)
-C
-C CERN PROGLIB# KERNGT .VERSION KERNVMI 1.01 891208
-C ORIG. 3/02/89 K.M.STORR
-C
-C-- STORE PAM TITLE INTO /SLATE/ FOR PRINTING BY GSHOWF
-
- COMMON /SLATE/ ISLATE(40)
-
- CALL UCTOH1 (
- + ' KERNVMI 1.10 1995/07/18 13.50 '
- +, ISLATE, 40 )
- CALL GSHOWF (LUN)
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/amaxmu.F b/src/packlib/kernlib/kerngen/tcgen/amaxmu.F
deleted file mode 100644
index 2e62178..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/amaxmu.F
+++ /dev/null
@@ -1,30 +0,0 @@
-*
-* $Id: amaxmu.F,v 1.1.1.1 1996/02/15 17:49:51 mclareni Exp $
-*
-* $Log: amaxmu.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:51 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- FUNCTION AMAXMU (A,IDO,IW,NA)
-C
-C CERN PROGLIB# E103 AMAXMU .VERSION KERNFOR 1.0 680315
-C ORIG. 15/03/68
-C
- DIMENSION A(99)
-C
- AM=0.
- II=1
-C
- DO 19 JN=1,IDO
- I=II
-C
- DO 17 JK=1,IW
- AM = MAX (AM, ABS(A(I)))
- 17 I=I+1
- 19 II=II+NA
-C
- AMAXMU=AM
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/bitpos.F b/src/packlib/kernlib/kerngen/tcgen/bitpos.F
deleted file mode 100644
index cb37264..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/bitpos.F
+++ /dev/null
@@ -1,61 +0,0 @@
-*
-* $Id: bitpos.F,v 1.1.1.1 1996/02/15 17:49:41 mclareni Exp $
-*
-* $Log: bitpos.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:41 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE BITPOS(I,N,K,M)
-C
-C CERN PROGLIB# M508 BITPOS .VERSION KERNFOR 4.16 870601
-C ORIG. OCT 81, M.METCALF, CERN/DD
-C
-C TO INDICATE WHICH BITS IN A SERIES OF WORDS ARE SET.
-C BITS WITHIN A WORD ARE NUMBERED RIGHT-TO-LEFT, STARTING AT 0.
-C
-C I=INPUT WORDS
-C N=NO. OF BITS TO BE TESTED
-C K=POSITION ARRAY
-C M=NO. OF SET BITS IN THE FIRST N POSITIONS
-C
-#include "kerngen/wordsize.inc"
- PARAMETER (LBIT = NBITPW)
-C
- INTEGER I(*),K(*)
- LOGICAL BTEST
-C
-C INITIALIZE
- NWORD=(N-1)/LBIT+1
- M=0
- JND=1
- NBIT = LBIT
-C
-C UNPACK EACH WORD
- DO 1 MM=1,NWORD
- NSET = 0
- IMM = I(MM)
- IF(MM.EQ.NWORD) NBIT=N-(NWORD-1)*LBIT
- JU = JND-1
-C
-C LOCATE SET BITS
- DO 4 MMU = 1,NBIT
- IF (BTEST(IMM,0)) THEN
- JU = JU+1
- K(JU)=MMU-1
- NSET = NSET+1
- ENDIF
- IMM = ISHFT(IMM,-1)
- 4 CONTINUE
- 9 M = JU
- IF(MM.EQ.1) GO TO 2
-C
-C BIAS WORDS OTHER THAN THE FIRST
- KND=JND+NSET-1
- IBIAS=(MM-1)*LBIT
- DO 3 NN=JND,KND
- 3 K(NN)=K(NN)+IBIAS
- 2 JND=JND+NSET
- 1 CONTINUE
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/blow.F b/src/packlib/kernlib/kerngen/tcgen/blow.F
deleted file mode 100644
index da2e71d..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/blow.F
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: blow.F,v 1.1.1.1 1996/02/15 17:49:41 mclareni Exp $
-*
-* $Log: blow.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:41 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE BLOW (CHAR,INT,NCHP,NBITS)
-C
-C CERN PROGLIB# M426 BLOW .VERSION KERNFOR 4.31 911111
-C
- DIMENSION CHAR(*), INT(*)
- DIMENSION NCHP(9), IPAR(4)
- DATA IPAR / 0, 0, 0, 0 /
-C
- NCH = NCHP(1)
- IPAR(1) = NBITS
- IPAR(3) = NCH*IPAR(1) + 127
-C
- CALL UPKCH (CHAR,INT,NCH,IPAR)
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/bunch.F b/src/packlib/kernlib/kerngen/tcgen/bunch.F
deleted file mode 100644
index 90b0157..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/bunch.F
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: bunch.F,v 1.1.1.1 1996/02/15 17:49:41 mclareni Exp $
-*
-* $Log: bunch.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:41 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE BUNCH (INT,CHAR,NCHP,NBITS)
-C
-C CERN PROGLIB# M436 BUNCH .VERSION KERNFOR 4.31 911111
-C
- DIMENSION CHAR(*), INT(*)
- DIMENSION NCHP(9), IPAR(5)
- DATA IPAR / 0, 0, 0, 0, 0 /
-C
- NCH = NCHP(1)
- IPAR(1) = NBITS
- IPAR(3) = NCH*IPAR(1) + 127
-C
- CALL PKCHAR (INT,CHAR,NCH,IPAR)
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/ccopiv.F b/src/packlib/kernlib/kerngen/tcgen/ccopiv.F
deleted file mode 100644
index 97db78c..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/ccopiv.F
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: ccopiv.F,v 1.1.1.1 1996/02/15 17:49:42 mclareni Exp $
-*
-* $Log: ccopiv.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:42 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE CCOPIV (FR,TO,NCH)
-C
-C CERN PROGLIB# M432 CCOPIV .VERSION KERNFOR 4.39 940228
-C ORIG. 20/01/93, JZ
-C
-C- Copy NCH characters from FR to TO inverted
-
- CHARACTER FR(512)*1, TO(512)*1
-
- DO 24 J=1,NCH
- 24 TO(J) = FR(NCH+1-J)
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/ccopyl.F b/src/packlib/kernlib/kerngen/tcgen/ccopyl.F
deleted file mode 100644
index aa9ef14..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/ccopyl.F
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: ccopyl.F,v 1.1.1.1 1996/02/15 17:49:42 mclareni Exp $
-*
-* $Log: ccopyl.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:42 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE CCOPYL (FR,TO,NCH)
-C
-C CERN PROGLIB# M432 CCOPYL .VERSION KERNFOR 4.39 940228
-C ORIG. 08/10/91, JZ
-C
-C- Copy NCH characters from FR to TO shifting left
-
- CHARACTER FR(512)*1, TO(512)*1
-
- DO 24 J=1,NCH
- 24 TO(J) = FR(J)
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/ccopyr.F b/src/packlib/kernlib/kerngen/tcgen/ccopyr.F
deleted file mode 100644
index ce0f44b..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/ccopyr.F
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: ccopyr.F,v 1.1.1.1 1996/02/15 17:49:42 mclareni Exp $
-*
-* $Log: ccopyr.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:42 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE CCOPYR (FR,TO,NCH)
-C
-C CERN PROGLIB# M432 CCOPYR .VERSION KERNFOR 4.39 940228
-C ORIG. 08/10/91, JZ
-C
-C- Copy NCH characters from FR to TO shifting right
-
- CHARACTER FR(512)*1, TO(512)*1
-
- DO 24 J=NCH,1,-1
- 24 TO(J) = FR(J)
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/ccosub.F b/src/packlib/kernlib/kerngen/tcgen/ccosub.F
deleted file mode 100644
index 5db95be..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/ccosub.F
+++ /dev/null
@@ -1,83 +0,0 @@
-*
-* $Id: ccosub.F,v 1.1.1.1 1996/02/15 17:49:42 mclareni Exp $
-*
-* $Log: ccosub.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:42 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE CCOSUB (CHIN,NNIN,CHEX,JLP,JRP, TOKEN,SUBST)
-C
-C CERN PROGLIB# M432 CCOSUB .VERSION KERNFOR 4.41 950228
-C ORIG. 20/01/94, JZ
-C
-C- Copy CHIN(1:NNIN) to CHEX(JL:JR) substituting each occurrence
-C- of TOKEN by SUBST.
-C- Return NDSLAT number of characters stored
-C- NESLAT first character after the last stored
-C- NFSLAT non-zero: CHEX too small to receive the copy
-C- NGSLAT = 0 if the copy is identical to the original
-C- 1 if changed
-
- COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT, DUMMY(36)
- CHARACTER CHIN*512, CHEX*512, TOKEN*(*), SUBST*(*)
-
-
- NTO = LEN(TOKEN)
- NSU = LEN(SUBST)
- LIM = NNIN+1 - NTO
-
- NEX = JLP - 1
- NNEX = JRP
-
- NOSP = 0
- MODI = 0
-
-C-- look for the start of TOKEN
-
- NIN = 0
- 21 JS = NIN
- 22 IF (JS.LT.LIM) THEN
- JS = ICFIND (TOKEN(1:1), CHIN,JS+1,LIM)
- IF (NGSLAT.NE.0) GO TO 23
- ENDIF
-
- JS = NNIN + 1
- NGSLAT = 0
-
-C-- copy leading text
-
- 23 N = JS-1 - NIN
- IF (N.GT.0) THEN
- NN = MIN (N, NNEX-NEX)
- IF (NN.LE.0) GO TO 28
- CHEX(NEX+1:NEX+NN) = CHIN(NIN+1:NIN+NN)
- NEX = NEX + NN
- IF (NN.NE.N) GO TO 28
- ENDIF
-
- IF (NGSLAT.EQ.0) GO TO 29
-
- NIN = JS - 1
- IF (CHIN(NIN+1:NIN+NTO).NE.TOKEN(1:NTO)) GO TO 22
-
-C-- copy substitution
-
- MODI = 1
- NN = MIN (NSU, NNEX-NEX)
- IF (NN.GT.0) CHEX(NEX+1:NEX+NN) = SUBST(1:NN)
- NEX = NEX + NN
- NIN = NIN + NTO
- IF (NN.EQ.NSU) GO TO 21
-
-C-- CHEX overflows
-
- 28 NOSP = 1
-
- 29 NESLAT = NEX + 1
- NDSLAT = NESLAT - JLP
- NFSLAT = NOSP
- NGSLAT = MODI
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/cenvir.F b/src/packlib/kernlib/kerngen/tcgen/cenvir.F
deleted file mode 100644
index 7cf99c4..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/cenvir.F
+++ /dev/null
@@ -1,125 +0,0 @@
-*
-* $Id: cenvir.F,v 1.1.1.1 1996/02/15 17:49:42 mclareni Exp $
-*
-* $Log: cenvir.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:42 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE CENVIR (CHIN,NINP, CHEX,JLP,JRP, IFLEX)
-C
-C CERN PROGLIB# M432 CENVIR .VERSION KERNFOR 4.41 950228
-C ORIG. 07/12/93, JZ
-C
-C- Copy CHIN(1:NINP) to CHEX(JLP:JRP) substituting environment
-C- variables designated by ${name}; on machines running UNIX
-C- the form $name is also recognised.
-C- For undefined variables the original text is either skipped
-C- or copied if IFLEX is zero or not zero.
-C- Return NFSLAT bit 1 undefined env.v. encountered
-C- 2 syntax error
-C- 3 not enough space to translate the complete
-C- line
-C- NGSLAT = 0 if the copy is identical to the original
-C- 1 if changed
-
- COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT, DUMMY(36)
- CHARACTER CHIN*512, CHEX*512
-
-
- NNIN = NINP
- NEX = JLP - 1
- NNEX = JRP
-#if !defined(CERNLIB_QS_UNIX)
- LIM = NNIN - 3
-#endif
-#if defined(CERNLIB_QS_UNIX)
- LIM = NNIN - 1
-#endif
-
- MISS = 0
- NFAI = 0
- NOSP = 0
- MODI = 0
-
-C-- look for the start of ${SYMBOL}
-
- NIN = 0
- 21 JS = NIN
- 22 IF (JS.LT.LIM) THEN
- JS = ICFIND ('$', CHIN,JS+1,LIM)
- IF (NGSLAT.NE.0) GO TO 23
- ENDIF
-
- JS = NNIN + 1
- NGSLAT = 0
-
-C-- copy leading text
-
- 23 N = JS-1 - NIN
- IF (N.GT.0) THEN
- NN = MIN (N, NNEX-NEX)
- IF (NN.LE.0) GO TO 28
- CHEX(NEX+1:NEX+NN) = CHIN(NIN+1:NIN+NN)
- NEX = NEX + NN
- IF (NN.NE.N) GO TO 28
- ENDIF
-
- IF (NGSLAT.EQ.0) GO TO 29
- NIN = JS - 1
-
-C-- get env. variable name
-
- JA = JS + 1
- IF (CHIN(JA:JA).NE.'{') THEN
-#if !defined(CERNLIB_QS_UNIX)
- GO TO 22
-#endif
-#if defined(CERNLIB_QS_UNIX)
- JB = ICFIND (' ', CHIN,JA,NNIN)
- IF (JB.EQ.JA) GO TO 22
- JE = ICNUMU (CHIN,JA,JB-1) - 1
- N = NDSLAT
- IF (N.EQ.0) GO TO 22
-#endif
- ELSE
- JA = JA + 1
- JE = ICFIND ('}', CHIN,JA,NNIN)
- IF (NGSLAT.EQ.0) GO TO 27
- N = JE - JA
- IF (N.EQ.0) GO TO 27
- ENDIF
-
-C-- copy env. variable value
-
- CALL GETENVF (CHIN(JA:JA+N-1), CHEX(NEX+1:NNEX))
- IF (NDSLAT.EQ.0) GO TO 26
- NEX = NEX + NDSLAT
- MODI = 1
- NIN = JE
- GO TO 21
-
-C-- environment variable not defined
-
- 26 MISS = 1
- IF (IFLEX.NE.0) GO TO 22
- MODI = 1
- NIN = JE
- GO TO 21
-
-C-- syntax problems
-
- 27 NFAI = 1
- GO TO 22
-
-C-- CHEX overflows
-
- 28 NOSP = 1
-
- 29 NESLAT = NEX + 1
- NDSLAT = NESLAT - JLP
- NFSLAT = MISS + 2*NFAI + 4*NOSP
- NGSLAT = MODI
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/cfill.F b/src/packlib/kernlib/kerngen/tcgen/cfill.F
deleted file mode 100644
index 241e1e4..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/cfill.F
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: cfill.F,v 1.1.1.1 1996/02/15 17:49:42 mclareni Exp $
-*
-* $Log: cfill.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:42 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE CFILL (CHI, CHV,JL,JR)
-C
-C CERN PROGLIB# M432 CFILL .VERSION KERNFOR 4.21 890323
-C ORIG. 06/02/89, JZ
-C
-C- Fill CHV(JL:JR) with as many copies of CHI as possible
-
- CHARACTER CHV*(*), CHI*(*)
-
- NI = LEN (CHI)
- JJ = JL
-
- 12 II = 1
- 14 IF (JJ.GT.JR) RETURN
- CHV(JJ:JJ) = CHI(II:II)
- JJ = JJ + 1
- IF (II.EQ.NI) GO TO 12
- II = II + 1
- GO TO 14
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/cfromi.F b/src/packlib/kernlib/kerngen/tcgen/cfromi.F
deleted file mode 100644
index bfd82c8..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/cfromi.F
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: cfromi.F,v 1.1.1.1 1996/02/15 17:49:42 mclareni Exp $
-*
-* $Log: cfromi.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:42 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- CHARACTER*(*) FUNCTION CFROMI(I)
-C
-C CERN PROGLIB# M431 CFROMI .VERSION KERNFOR 4.18 880425
-C ORIG. 10/02/86 M.METCALF
-C
-C TO CONVERT 4 PACKED ASCII CODES TO CHARACTERS
-C ANSI FORTRAN
-C
-C FOLLOWING STATEMENT IS ANSI EQUIVALENT OF M8 = ZFF
- PARAMETER (M8 = 255)
-#if defined(CERNLIB_SGI)
- CHARACTER CHTMP
-#endif
-C
- CFROMI = ' '
- J = I
- LENCH = MIN(LEN(CFROMI), 4)
- JJ = LENCH
- DO 19 II = 4, 1, -1
- IF (II.LE.LENCH) THEN
-#if defined(CERNLIB_SGI)
- CALL ITOCH(IAND(J, M8), CHTMP, *16)
- 16 CFROMI(JJ:JJ)=CHTMP
- JJ = JJ-1
-#else
- CALL ITOCH(IAND(J, M8), CFROMI(JJ:JJ), *16)
- 16 JJ = JJ-1
-#endif
- ENDIF
- J = ISHFT(J, -8)
- 19 CONTINUE
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/cfweof.F b/src/packlib/kernlib/kerngen/tcgen/cfweof.F
deleted file mode 100644
index c020947..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/cfweof.F
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: cfweof.F,v 1.1.1.1 1996/02/15 17:49:44 mclareni Exp $
-*
-* $Log: cfweof.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:44 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE CFWEOF (LUNPTR, MEDIUM, NEOF)
-C CERN PROGLIB# CFWEOF .VERSION KERNFOR 4.26 910313
-C write NEOF system file marks, dummy routine
-C LUNPTR file pointer
-C MEDIUM = 0,1,2,3 : primary disk/tape, secondary disk/tape
-C *NEOF* number of file marke to be writtin / actually written
-
- NEOF = 0
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/chtoi.F b/src/packlib/kernlib/kerngen/tcgen/chtoi.F
deleted file mode 100644
index 9fa4f3c..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/chtoi.F
+++ /dev/null
@@ -1,30 +0,0 @@
-*
-* $Id: chtoi.F,v 1.1.1.1 1996/02/15 17:49:42 mclareni Exp $
-*
-* $Log: chtoi.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:42 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QASCII)
- SUBROUTINE CHTOI (CH,I,*)
-C
-C CERN PROGLIB# M400 CHTOI .VERSION KERNFOR 4.23 891215
-C ORIG. 29/05/84 H.RENSHALL
-C MOD. 06/11/89 JZ for UNIX & for speed
-C
-C CHTOI - convert CH*1 to its ASCII value
-C error exit if 'unseen' character
-C
- CHARACTER CH*1
-C
- I = ICHAR(CH)
- IF (I.GE.32) THEN
- IF (I.LE.126) RETURN
- ENDIF
-C
- I = 0
- RETURN 1
- END
-#endif
diff --git a/src/packlib/kernlib/kerngen/tcgen/chtoig.F b/src/packlib/kernlib/kerngen/tcgen/chtoig.F
deleted file mode 100644
index f4e4ab9..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/chtoig.F
+++ /dev/null
@@ -1,57 +0,0 @@
-*
-* $Id: chtoig.F,v 1.1.1.1 1996/02/15 17:49:42 mclareni Exp $
-*
-* $Log: chtoig.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:42 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
-#if !defined(CERNLIB_QASCII)
- SUBROUTINE CHTOI(CH,I,*)
-C
-C CERN PROGLIB# M400 CHTOI .VERSION KERNFOR 4.11 850529
-C ORIG. 29/05/84 H.RENSHALL
-C
-C SUBROUTINE WITH TWO ENTRY POINTS :
-C CHTOI - CONVERT INPUT SINGLE CHARACTER CH (OF TYPE CHARACTER) TO AN
-C OUTPUT INTEGER I VIA THE LOOK-UP TABLE STORED IN CHSTR.
-C ITOCH - CONVERT INPUT SINGLE INTEGER I TO AN OUTPUT SINGLE CHARACTER
-C CH (OF TYPE CHARACTER) VIA THE LOOK-UP TABLE STORED IN CHSTR.
-C A VALUE OUTSIDE THE ALLOWED SET OF 95 CHARACTERS RESULTS IN THE
-C ALTERNATE RETURN BEING TAKEN, WITH THE VALUE ZERO RETURNED IN I FOR
-C A CALL TO CHTOI, OR THE VALUE '?' BEING RETURNED IN CH FOR ITOCH.
-C THE INTEGER REPRESENTATIONS ARE THOSE OF 8-BIT ASCII RANGING FROM
-C 32 (FOR BLANK) TO 126 (FOR ~). SOME OF THE MORE EXOTIC CHARACTERS
-C PRODUCE STRANGE (BUT NON-FATAL) CONVERSIONS ON SOME MACHINES.
-C
- INTEGER CHMAX2
- CHARACTER CH
- PARAMETER(CHMAX2=128)
- CHARACTER*(CHMAX2)CHSTR
-C
-C INTEGERS 0 TO 127 MAP CONSECUTIVELY INTO THE CHARACTERS STORED
-C IN CHSTR AS DEFINED BELOW. NOTE CHSTR(39:39)=' (APOSTROPHE)
-C
- DATA
- +CHSTR(32:47)/' !"#$%&''()*+,-./'/
- +CHSTR(48:57)/'0123456789'/
- +CHSTR(58:64)/':;<=>?@'/
- +CHSTR(65:90)/'ABCDEFGHIJKLMNOPQRSTUVWXYZ'/
- +CHSTR(91:96)/'[\]^_`'/
- +CHSTR(97:122)/'abcdefghijklmnopqrstuvwxyz'/
- +CHSTR(123:126)/'{|}~'/
-C
- I= INDEX(CHSTR(32:126),CH)
- IF(I.LT.1) RETURN 1
- I= I + 31
- RETURN
-C
- ENTRY ITOCH(I,CH,*)
-C SET ILLEGAL VALUE OF I TO RETURN CHARACTER '?'
- CH= CHSTR(63:63)
- IF(I.LT.32.OR.I.GT.126) RETURN 1
- CH=CHSTR(I:I)
- RETURN
- END
-#endif
diff --git a/src/packlib/kernlib/kerngen/tcgen/ckrack.F b/src/packlib/kernlib/kerngen/tcgen/ckrack.F
deleted file mode 100644
index 9c6bf84..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/ckrack.F
+++ /dev/null
@@ -1,453 +0,0 @@
-*
-* $Id: ckrack.F,v 1.1.1.1 1996/02/15 17:49:42 mclareni Exp $
-*
-* $Log: ckrack.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:42 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE CKRACK (CHV,JLP,JRP,IFLAGD)
-C
-C CERN PROGLIB# M432 CKRACK .VERSION KERNFOR 4.29 910718
-C ORIG. 12/06/91, JZ
-C
-C- Read the next number from CHV(JL:JR)
-C- formats: (1) bits - #On octal, or #Bn binary, or #Xn hex
-C- (2) integer - [+|-]n
-C- (3) floating - [+|-][n][.][f][E][+|-][n]
-C- (4) double - [+|-][n][.][f]D[+|-][n]
-C-
-C- Returns: NDSLAT number of numeric digits seen
-C- NESLAT COL(NESLAT) is the terminating character
-C- NFSLAT mode: -ve bad, 0 blank, 1 B, 2 I, 3 F, 4 D
-C- NGSLAT = zero if correct termination
-C- = NESLAT otherwise
-C- NUM(1) or ANUM(1) or DNUM returns the value
-
- DIMENSION JLP(9), JRP(9)
- CHARACTER CHV(512)*1
-
- COMMON /SLATE/ NDIGT,NESLAT,MODE,NGSLAT,NUM(2)
- +, IVALV(6),NEXPV(6), JXOP,JXME,JXFA,JXFE
- +, JTERM,IPHASE, NEGM,NEGE,NEXPM, NERR, DUMMY(12)
-
- REAL ANUM(2)
- DOUBLE PRECISION DNUM, DFRACT
- EQUIVALENCE (ANUM(1),NUM(1))
- EQUIVALENCE (DNUM,NUM(1))
-
- DIMENSION ISLATE(40)
- EQUIVALENCE (ISLATE(1),NDIGT)
-
-#include "kerngen/wordsize.inc"
-#if !defined(CERNLIB_QISASTD)
-#include "kerngen/q_shift.inc"
-#endif
-
- JJ = JLP(1)
- JR = JRP(1)
-
- DO 12 J=1,28
- 12 ISLATE(J) = 0
-
-C---- Look at the first character of the number
-
- 17 IF (JJ.GT.JR) GO TO 90
- IF (CHV(JJ).EQ.' ') THEN
- JJ = JJ + 1
- GO TO 17
- ELSEIF (CHV(JJ).EQ.'#') THEN
- GO TO 71
- ELSEIF (CHV(JJ).EQ.'+') THEN
- JJ = JJ + 1
- ELSEIF (CHV(JJ).EQ.'-') THEN
- NEGM = 7
- JJ = JJ + 1
- ENDIF
-
-C---- Read an integer
-
- 21 JTERM = 0
- NDIG = 0
- IVAL = 0
- 22 IF (JJ.GT.JR) GO TO 27
-#if defined(CERNLIB_QASCII)
- K = ICHAR (CHV(JJ))
- K = K - 48
- IF (K.LT.0) GO TO 26
- IF (K.GE.10) GO TO 26
-#endif
-#if defined(CERNLIB_QEBCDIC)
- K = ICHAR (CHV(JJ))
- K = K - 240
- IF (K.LT.0) GO TO 26
- IF (K.GE.10) GO TO 26
-#endif
-#if !defined(CERNLIB_QISASTD)
- IF (ISHFTR(IVAL,NBITPW-5).NE.0) GO TO 24
-#endif
-#if defined(CERNLIB_QISASTD)
- IF (ISHFT(IVAL,5-NBITPW).NE.0) GO TO 24
-#endif
- 23 JJ = JJ + 1
- IVAL = 10*IVAL + K
- NDIG = NDIG + 1
- GO TO 22
-
-C-- getting near the integer capacity
-
- 24 IF (IPHASE.NE.0) GO TO 93
- IF (JXOP.LT.6) THEN
- JXOP = JXOP + 1
- IVALV(JXOP) = IVAL
- NEXPV(JXOP) = NDIG
- ENDIF
- IVAL = 0
- GO TO 23
-
- 26 JTERM = INDEX (' .+-EDed', CHV(JJ)) - 1
-C- 01234567
-
- 27 IF (NDIG.NE.0) THEN
- NDIGT = NDIGT + NDIG
- IF (JXOP.LT.6) THEN
- JXOP = JXOP + 1
- IVALV(JXOP) = IVAL
- NEXPV(JXOP) = NDIG
- ENDIF
- ENDIF
-
-C-- IPHASE = 0 : IVAL is the leading integer
-C- 2 : is the exponent integer
-
- IF (IPHASE.NE.0) GO TO 51
- JXME = JXOP
- IF (JTERM.GE.1) GO TO 31
-
-C-- pure integer
-
- 28 IF (NDIGT.EQ.0) GO TO 91
- MODE = 2
- NUM(1) = IVALV(1)
- IF (JXME.LT.2) GO TO 29
- N = NEXPV(2) - NEXPV(1)
- IF (N.GE.2) GO TO 92
-#if !defined(CERNLIB_QISASTD)
- IVALV(1) = ISHFTL(NUM(1),2) + IVALV(1)
- NUM(1) = ISHFTL(IVALV(1),1)
-#endif
-#if defined(CERNLIB_QISASTD)
- IVALV(1) = ISHFT(NUM(1),2) + IVALV(1)
- NUM(1) = ISHFT(IVALV(1),1)
-#endif
- IF (NUM(1).LT.0) GO TO 92
- NUM(1) = NUM(1) + IVALV(2)
- IF (NUM(1).LT.0) GO TO 92
- 29 IF (NEGM.NE.0) NUM(1) = -NUM(1)
- 30 NESLAT = JJ
- IF (JTERM.EQ.0) RETURN
- NGSLAT = JJ
- RETURN
-
-C---- Read the fraction
-
- 31 IF (JTERM.NE.1) GO TO 41
- JXFA = JXOP
- MODE = 3
- JJ = JJ + 1
-
- JTERM = 0
- NDIG = 0
- 32 IVAL = 0
- IVALNT = 0
- NTRAIL = 0
- 33 IF (JJ.GT.JR) GO TO 37
-#if defined(CERNLIB_QASCII)
- K = ICHAR (CHV(JJ))
- K = K - 48
- IF (K.LT.0) GO TO 36
- IF (K.GE.10) GO TO 36
-#endif
-#if defined(CERNLIB_QEBCDIC)
- K = ICHAR (CHV(JJ))
- K = K - 240
- IF (K.LT.0) GO TO 36
- IF (K.GE.10) GO TO 36
-#endif
-#if !defined(CERNLIB_QISASTD)
- IF (ISHFTR(IVAL,NBITPW-5).NE.0) GO TO 34
-#endif
-#if defined(CERNLIB_QISASTD)
- IF (ISHFT(IVAL,5-NBITPW).NE.0) GO TO 34
-#endif
- JJ = JJ + 1
- IVAL = 10*IVAL + K
- NDIG = NDIG + 1
- IF (K.EQ.0) THEN
- NTRAIL = NTRAIL + 1
- ELSE
- NTRAIL = 0
- IVALNT = IVAL
- ENDIF
- GO TO 33
-
-C-- getting near the integer capacity
-
- 34 IF (JXOP.LT.6) THEN
- JXOP = JXOP + 1
- IVALV(JXOP) = IVALNT
- NEXPV(JXOP) = NTRAIL - NDIG
- ENDIF
- GO TO 32
-
- 36 JTERM = INDEX (' .+-EDed', CHV(JJ)) - 1
-C- 01234567
-
- 37 NDIGT = NDIGT + NDIG
- IF (IVAL.NE.0) THEN
- IF (JXOP.LT.6) THEN
- JXOP = JXOP + 1
- IVALV(JXOP) = IVALNT
- NEXPV(JXOP) = NTRAIL - NDIG
- ENDIF
- ENDIF
- JXFE = JXOP
- IF (JTERM.LT.2) GO TO 52
-
-C---- Read the exponent
-
- 41 IPHASE = 2
- IF (NDIGT.EQ.0) GO TO 91
- IF (JTERM.GE.4) GO TO 44
- IF (JJ.EQ.JR) THEN
- IF (MODE.EQ.0) GO TO 28
- GO TO 52
- ENDIF
- MODE = 3
- NEGE = JTERM - 2
- JJ = JJ + 1
- GO TO 21
-
- 44 IF (JTERM.GE.6) JTERM = JTERM - 2
- MODE = JTERM - 1
- JJ = JJ + 1
- IF (JJ.GT.JR) THEN
- JTERM = 0
- GO TO 52
- ENDIF
-
- J = INDEX ('+-', CHV(JJ))
- IF (J.EQ.0) GO TO 21
- IF (JJ.EQ.JR) GO TO 52
- NEGE = J - 1
- JJ = JJ + 1
- GO TO 21
-
-C-- Exponent complete, construct the number
-
- 51 NEXPM = IVAL
- IF (NEGE.NE.0) NEXPM = -NEXPM
- 52 IF (IFLAGD.GE.0) THEN
- IF (MODE.EQ.4) GO TO 61
- IF (IFLAGD.NE.0) GO TO 61
- ENDIF
- ANUM(1) = 0.
- ANUM(2) = 0.
- IF (JXME.EQ.0) GO TO 56
-
-C-- single precision, integer part
-
- ANUM(1) = REAL(IVALV(1))
- IF (JXME.GE.2) THEN
- N = NEXPV(2) - NEXPV(1)
- DO 53 J=1,N
- 53 ANUM(1) = 10. * ANUM(1)
- ANUM(1) = ANUM(1) + REAL(IVALV(2))
- ENDIF
-
- IF (NEXPM.EQ.0) GO TO 56
- IF (NEXPM.LT.0) GO TO 55
- IF (NEXPM.GT.9) GO TO 55
- DO 54 J=1,NEXPM
- 54 ANUM(1) = ANUM(1) * 10.
- GO TO 56
-
- 55 ANUM(1) = ANUM(1) * 10.**NEXPM
-
-C-- single precision, fraction
-
- 56 IF (JXFE.LE.JXFA) GO TO 60
- DO 59 JXOP=JXFA+1,JXFE
- ANUM(2) = REAL(IVALV(JXOP))
- NEXPU = NEXPV(JXOP) + NEXPM
- IF (NEXPU.EQ.0) GO TO 59
- IF (NEXPU.LT.0) GO TO 58
- IF (NEXPU.GT.9) GO TO 58
- DO 57 J=1,NEXPU
- 57 ANUM(2) = ANUM(2) * 10.
- GO TO 59
-
- 58 ANUM(2) = ANUM(2) * 10.**NEXPU
- 59 ANUM(1) = ANUM(1) + ANUM(2)
- 60 IF (NEGM.NE.0) ANUM(1) = -ANUM(1)
- GO TO 30
-
-C-- double precision, integer part
-
- 61 MODE = 4
- DNUM = 0.
- IF (JXME.EQ.0) GO TO 66
-
- DNUM = DBLE(IVALV(1))
- IF (JXME.GE.2) THEN
- N = NEXPV(2) - NEXPV(1)
- DO 63 J=1,N
- 63 DNUM = DNUM * 10.
- DNUM = DNUM + DBLE(IVALV(2))
- ENDIF
-
- IF (NEXPM.EQ.0) GO TO 66
- IF (NEXPM.LT.0) GO TO 65
- IF (NEXPM.GT.9) GO TO 65
- DO 64 J=1,NEXPM
- 64 DNUM = DNUM * 10.
- GO TO 66
-
- 65 DNUM = DNUM * 10.D0**NEXPM
-
-C-- double precision, fraction
-
- 66 IF (JXFE.LE.JXFA) GO TO 70
- DO 69 JXOP=JXFA+1,JXFE
- DFRACT = DBLE(IVALV(JXOP))
- NEXPU = NEXPV(JXOP) + NEXPM
- IF (NEXPU.EQ.0) GO TO 69
- IF (NEXPU.LT.0) GO TO 68
- IF (NEXPU.GT.9) GO TO 68
- DO 67 J=1,NEXPU
- 67 DFRACT = DFRACT * 10.
- GO TO 69
-
- 68 DFRACT = DFRACT * 10.D0**NEXPU
- 69 DNUM = DNUM + DFRACT
- 70 IF (NEGM.NE.0) DNUM = -DNUM
- GO TO 30
-
-C-------- Reading octal or binary or hexadecimal
-
- 71 J = INDEX ('0OoBbXx', CHV(JJ+1))
- IF (J.EQ.0) GO TO 94
- JJ = JJ + 2
- IF (J.GE.6) GO TO 82
- IF (J.GE.4) GO TO 76
-
-C-- octal
-
- 72 IF (JJ.GT.JR) GO TO 87
-#if defined(CERNLIB_QASCII)
- K = ICHAR (CHV(JJ))
- IF (K.EQ.32) GO TO 87
- K = K - 48
- IF (K.LT.0) GO TO 86
- IF (K.GE.8) GO TO 86
-#endif
-#if defined(CERNLIB_QEBCDIC)
- K = ICHAR (CHV(JJ))
- IF (K.EQ.64) GO TO 87
- K = K - 240
- IF (K.LT.0) GO TO 86
- IF (K.GE.8) GO TO 86
-#endif
-#if !defined(CERNLIB_QISASTD)
- NUM(1) = ISHFTL(NUM(1),3) + K
-#endif
-#if defined(CERNLIB_QISASTD)
- NUM(1) = ISHFT(NUM(1),3) + K
-#endif
- NDIGT = NDIGT + 1
- JJ = JJ + 1
- GO TO 72
-
-C-- binary
-
- 76 IF (JJ.GT.JR) GO TO 87
-#if defined(CERNLIB_QASCII)
- K = ICHAR (CHV(JJ))
- IF (K.EQ.32) GO TO 87
- K = K - 48
- IF (K.LT.0) GO TO 86
- IF (K.GE.2) GO TO 86
-#endif
-#if defined(CERNLIB_QEBCDIC)
- K = ICHAR (CHV(JJ))
- IF (K.EQ.64) GO TO 87
- K = K - 240
- IF (K.LT.0) GO TO 86
- IF (K.GE.2) GO TO 86
-#endif
-#if !defined(CERNLIB_QISASTD)
- NUM(1) = ISHFTL(NUM(1),1) + K
-#endif
-#if defined(CERNLIB_QISASTD)
- NUM(1) = ISHFT(NUM(1),1) + K
-#endif
- NDIGT = NDIGT + 1
- JJ = JJ + 1
- GO TO 76
-
-C-- hexadecimal
-
- 82 IF (JJ.GT.JR) GO TO 87
-#if defined(CERNLIB_QASCII)
- K = ICHAR (CHV(JJ))
- IF (K.EQ.32) GO TO 87
- K = K - 48
- IF (K.LT.0) GO TO 86
- IF (K.LT.10) GO TO 84
- K = K - 7
- IF (K.LT.8) GO TO 86
- IF (K.LT.16) GO TO 84
- K = K - 32
- IF (K.LT.8) GO TO 86
- IF (K.GE.16) GO TO 86
-#endif
-#if defined(CERNLIB_QEBCDIC)
- K = ICHAR (CHV(JJ))
- IF (K.EQ.64) GO TO 87
- K = K - 240
- IF (K.GE.10) GO TO 86
- IF (K.GE.0) GO TO 84
- K = K + 57
- IF (K.GE.16) GO TO 86
- IF (K.GE.8) GO TO 84
- K = K + 64
- IF (K.GE.16) GO TO 86
- IF (K.LT.8) GO TO 86
-#endif
-#if !defined(CERNLIB_QISASTD)
- 84 NUM(1) = ISHFTL(NUM(1),4) + K
-#endif
-#if defined(CERNLIB_QISASTD)
- 84 NUM(1) = ISHFT(NUM(1),4) + K
-#endif
- NDIGT = NDIGT + 1
- JJ = JJ + 1
- GO TO 82
-
- 86 JTERM = -1
- 87 MODE = 1
- IF (NDIGT.EQ.0) GO TO 91
- GO TO 30
-
-C---- Special error exits
-
- 94 NERR = -1
- 93 NERR = NERR - 1
- 92 NERR = NERR - 1
- 91 NERR = NERR - 1
- 90 MODE = NERR
- NESLAT = JJ
- NGSLAT = JJ
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/cleft.F b/src/packlib/kernlib/kerngen/tcgen/cleft.F
deleted file mode 100644
index f019729..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/cleft.F
+++ /dev/null
@@ -1,51 +0,0 @@
-*
-* $Id: cleft.F,v 1.1.1.1 1996/02/15 17:49:42 mclareni Exp $
-*
-* $Log: cleft.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:42 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE CLEFT (CHV,JLP,JRP)
-C
-C CERN PROGLIB# M432 CLEFT .VERSION KERNFOR 4.21 890323
-C ORIG. 04/10/88, JZ
-C
-C- Left-justify CHV(JL:JR)
-
- DIMENSION JLP(9), JRP(9)
-
- COMMON /SLATE/ NDSLAT,NESLAT, DUMMY(38)
- CHARACTER CHV*(*)
-
-C-- Find the first blank
-
- JL = JLP(1)
- JR = JRP(1)
-
- JP = JR + 1
- JJ = JL
- 12 IF (JJ.GE.JP) GO TO 99
- IF (CHV(JJ:JJ).NE.' ') THEN
- JJ = JJ + 1
- GO TO 12
- ENDIF
-
-C-- Copy shifted
-
- JP = JJ
- JJ = JJ + 1
- 21 IF (JJ.GT.JR) GO TO 91
- IF (CHV(JJ:JJ).NE.' ') THEN
- CHV(JP:JP) = CHV(JJ:JJ)
- JP = JP+1
- ENDIF
- JJ = JJ+1
- GO TO 21
-
- 91 CHV(JP:JR) = ' '
- 99 NESLAT = JP
- NDSLAT = JP - JL
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/cltou.F b/src/packlib/kernlib/kerngen/tcgen/cltou.F
deleted file mode 100644
index 2096ed7..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/cltou.F
+++ /dev/null
@@ -1,37 +0,0 @@
-*
-* $Id: cltou.F,v 1.1.1.1 1996/02/15 17:49:43 mclareni Exp $
-*
-* $Log: cltou.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:43 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE CLTOU (CHV)
-C
-C CERN PROGLIB# M432 CLTOU .VERSION KERNFOR 4.21 890323
-C ORIG. 11/02/86 A. PETRILLI
-C NEW 9/02/89 JZ, for speed
-C
-C- Convert character string CHV from lower to upper case.
-
- CHARACTER CHV*(*)
-
-#include "kerngen/qnatch.inc"
-* Ignoring t=pass
-
-
- DO 19 JJ=1,LEN(CHV)
-#if defined(CERNLIB_QASCII)
- J = ICHAR(CHV(JJ:JJ))
- IF (J.LT.97) GO TO 19
- IF (J.GE.123) GO TO 19
- CHV(JJ:JJ) = CHAR(J-32)
-#endif
-#if defined(CERNLIB_QEBCDIC)
- J = ICHAR(CHV(JJ:JJ))
- IF (NATCH(J+1).NE.3) GO TO 19
- CHV(JJ:JJ) = CHAR(J+64)
-#endif
- 19 CONTINUE
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/cright.F b/src/packlib/kernlib/kerngen/tcgen/cright.F
deleted file mode 100644
index f651bab..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/cright.F
+++ /dev/null
@@ -1,51 +0,0 @@
-*
-* $Id: cright.F,v 1.1.1.1 1996/02/15 17:49:42 mclareni Exp $
-*
-* $Log: cright.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:42 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE CRIGHT (CHV,JLP,JRP)
-C
-C CERN PROGLIB# M432 CRIGHT .VERSION KERNFOR 4.21 890323
-C ORIG. 04/10/88, JZ
-C
-C- Right-justify CHV(JL:JR)
-
- DIMENSION JLP(9), JRP(9)
-
- COMMON /SLATE/ NDSLAT,NESLAT, DUMMY(38)
- CHARACTER CHV*(*)
-
-C-- Find first blank
-
- JL = JLP(1)
- JR = JRP(1)
-
- JP = JL - 1
- JJ = JR
- 12 IF (JJ.LE.JP) GO TO 99
- IF (CHV(JJ:JJ).NE.' ') THEN
- JJ = JJ - 1
- GO TO 12
- ENDIF
-
-C-- Copy shifted
-
- JP = JJ
- JJ = JJ - 1
- 21 IF (JJ.LT.JL) GO TO 91
- IF (CHV(JJ:JJ).NE.' ') THEN
- CHV(JP:JP) = CHV(JJ:JJ)
- JP = JP - 1
- ENDIF
- JJ = JJ - 1
- GO TO 21
-
- 91 CHV(JL:JP) = ' '
- 99 NESLAT = JP
- NDSLAT = JR - JP
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/cross.F b/src/packlib/kernlib/kerngen/tcgen/cross.F
deleted file mode 100644
index 93686e2..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/cross.F
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: cross.F,v 1.1.1.1 1996/02/15 17:49:51 mclareni Exp $
-*
-* $Log: cross.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:51 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE CROSS(X,Y,Z)
-C
-C CERN PROGLIB# F117 CROSS .VERSION KERNFOR 2.02 730125
-C ORIG. 01/01/64
-C
- COMMON /SLATE/Z1,Z2,XQX(38)
- DIMENSION X(3),Y(3),Z(3)
-C
-C
- Z1=X(2)*Y(3)-X(3)*Y(2)
- Z2=X(3)*Y(1)-X(1)*Y(3)
- Z(3)=X(1)*Y(2)-X(2)*Y(1)
- Z(1)=Z1
- Z(2)=Z2
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/csetdi.F b/src/packlib/kernlib/kerngen/tcgen/csetdi.F
deleted file mode 100644
index e96b800..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/csetdi.F
+++ /dev/null
@@ -1,55 +0,0 @@
-*
-* $Id: csetdi.F,v 1.1.1.1 1996/02/15 17:49:43 mclareni Exp $
-*
-* $Log: csetdi.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:43 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE CSETDI (INTP, CHV,JLP,JRP)
-C
-C CERN PROGLIB# M432 CSETDI .VERSION KERNFOR 4.29 910718
-C ORIG. 04/10/88, JZ
-C
-C- Set decimal integer into CHV(JL:JR) right-justified
-
- DIMENSION INTP(9), JLP(9), JRP(9)
-
- COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT, DUMMY(36)
- CHARACTER CHV*(*)
-
-
- INT = INTP(1)
- JL = JLP(1)
- JJ = JRP(1)
-
- IVAL = IABS (INT)
- NDG = 0
- NGSLAT = 0
-
- 12 IF (JJ.LT.JL) GO TO 97
- K = MOD (IVAL,10)
- IVAL = IVAL/10
-#if defined(CERNLIB_QASCII)
- CHV(JJ:JJ) = CHAR(K+48)
-#endif
-#if defined(CERNLIB_QEBCDIC)
- CHV(JJ:JJ) = CHAR(K+240)
-#endif
-
- JJ = JJ - 1
- NDG = NDG + 1
- IF (IVAL.NE.0) GO TO 12
- IF (INT.GE.0) GO TO 98
- IF (JJ.LT.JL) GO TO 97
- CHV(JJ:JJ) = '-'
- NFSLAT = JJ - 1
- GO TO 99
-
- 97 NGSLAT = JL
- 98 NFSLAT = JJ
- 99 NESLAT = JJ
- NDSLAT = NDG
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/csethi.F b/src/packlib/kernlib/kerngen/tcgen/csethi.F
deleted file mode 100644
index 0f9848d..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/csethi.F
+++ /dev/null
@@ -1,65 +0,0 @@
-*
-* $Id: csethi.F,v 1.1.1.1 1996/02/15 17:49:43 mclareni Exp $
-*
-* $Log: csethi.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:43 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE CSETHI (INTP, CHV,JLP,JRP)
-C
-C CERN PROGLIB# M432 CSETHI .VERSION KERNFOR 4.31 911111
-C ORIG. 17/10/89, JZ
-C
-C- Set hexadecimal integer into CHV(JL:JR) right-justified
-
- DIMENSION INTP(9), JLP(9), JRP(9)
-
- COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT, DUMMY(36)
- CHARACTER CHV*(*)
-
-#if !defined(CERNLIB_QISASTD)
-#include "kerngen/q_andor.inc"
-#include "kerngen/q_shift.inc"
-#endif
-
- JL = JLP(1)
- JJ = JRP(1)
-
- IVAL = INTP(1)
- NDG = 0
- NGSLAT = 0
-
- 12 IF (JJ.LT.JL) GO TO 97
- K = IAND (IVAL,15)
-#if !defined(CERNLIB_QISASTD)
- IVAL = ISHFTR (IVAL,4)
-#endif
-#if defined(CERNLIB_QISASTD)
- IVAL = ISHFT (IVAL,-4)
-#endif
- IF (K.LT.10) THEN
-#if defined(CERNLIB_QASCII)
- CHV(JJ:JJ) = CHAR(K+48)
- ELSE
- CHV(JJ:JJ) = CHAR(K+55)
-#endif
-#if defined(CERNLIB_QEBCDIC)
- CHV(JJ:JJ) = CHAR(K+240)
- ELSE
- CHV(JJ:JJ) = CHAR(K+183)
-#endif
- ENDIF
-
- JJ = JJ - 1
- NDG = NDG + 1
- IF (IVAL.NE.0) GO TO 12
- GO TO 98
-
- 97 NGSLAT = JL
- 98 NFSLAT = JJ
- NESLAT = JJ
- NDSLAT = NDG
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/csetoi.F b/src/packlib/kernlib/kerngen/tcgen/csetoi.F
deleted file mode 100644
index 24d9d40..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/csetoi.F
+++ /dev/null
@@ -1,59 +0,0 @@
-*
-* $Id: csetoi.F,v 1.1.1.1 1996/02/15 17:49:43 mclareni Exp $
-*
-* $Log: csetoi.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:43 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE CSETOI (INTP, CHV,JLP,JRP)
-C
-C CERN PROGLIB# M432 CSETOI .VERSION KERNFOR 4.33 920511
-C ORIG. 03/06/92, JZ
-C
-C- Set octal integer into CHV(JL:JR) right-justified
-
- DIMENSION INTP(9), JLP(9), JRP(9)
-
- COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT, DUMMY(36)
- CHARACTER CHV*(*)
-
-#if !defined(CERNLIB_QISASTD)
-#include "kerngen/q_andor.inc"
-#include "kerngen/q_shift.inc"
-#endif
-
- JL = JLP(1)
- JJ = JRP(1)
-
- IVAL = INTP(1)
- NDG = 0
- NGSLAT = 0
-
- 12 IF (JJ.LT.JL) GO TO 97
- K = IAND (IVAL,7)
-#if !defined(CERNLIB_QISASTD)
- IVAL = ISHFTR (IVAL,3)
-#endif
-#if defined(CERNLIB_QISASTD)
- IVAL = ISHFT (IVAL,-3)
-#endif
-#if defined(CERNLIB_QASCII)
- CHV(JJ:JJ) = CHAR(K+48)
-#endif
-#if defined(CERNLIB_QEBCDIC)
- CHV(JJ:JJ) = CHAR(K+240)
-#endif
-
- JJ = JJ - 1
- NDG = NDG + 1
- IF (IVAL.NE.0) GO TO 12
- GO TO 98
-
- 97 NGSLAT = JL
- 98 NFSLAT = JJ
- NESLAT = JJ
- NDSLAT = NDG
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/csetvi.F b/src/packlib/kernlib/kerngen/tcgen/csetvi.F
deleted file mode 100644
index 083a22c..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/csetvi.F
+++ /dev/null
@@ -1,62 +0,0 @@
-*
-* $Id: csetvi.F,v 1.1.1.1 1996/02/15 17:49:43 mclareni Exp $
-*
-* $Log: csetvi.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:43 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE CSETVI (NINTP,INTV,NBIASP,CHV,JLP,JRP,NSTEPP,IFLSQP)
-C
-C CERN PROGLIB# M432 CSETVI .VERSION KERNFOR 4.36 930602
-C ORIG. 01/04/92, JZ
-C
-C- Set NINT decimal integers INTV(J)+NBIAS into CHV(JL:JR)
-C- every NSTEP columns, each with one leading blank
-C- and right-justified within its field;
-C- squeeze multiple blanks if IFLSQ non-zero.
-
- COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT, DUMMY(36)
-
- DIMENSION NINTP(9), NBIASP(9)
- DIMENSION JLP(9), JRP(9), NSTEPP(9), IFLSQP(9)
- DIMENSION INTV(*)
- CHARACTER CHV*(*)
-
-
- NINT = NINTP(1)
- NBIAS = NBIASP(1)
- JL = JLP(1)
- NSTEP = NSTEPP(1)
- LIMIT = JRP(1) - NSTEP + 1
- IFLSQ = IFLSQP(1)
- JWK = JL - 1
-
- DO 24 JIN=1,NINT
- IF (JWK.GE.LIMIT) THEN
- IF (IFLSQ.EQ.0) GO TO 91
- IF (JIN.EQ.1) GO TO 91
- CALL CSQMBL (CHV,JL,JWK)
- JWK = NESLAT - 1
- IF (JWK.GE.LIMIT) GO TO 91
- ENDIF
- JVAL = INTV(JIN) + NBIAS
- CALL CSETDI (JVAL,CHV,JWK+2,JWK+NSTEP)
- 24 JWK = JWK + NSTEP
-
- IF (IFLSQ.NE.0) THEN
- CALL CSQMBL (CHV,JL,JWK)
- JWK = NESLAT - 1
- ENDIF
-
- NESLAT = JWK
- NGSLAT = 0
- RETURN
-
-C---- Errors
-
- 91 NESLAT = JWK
- NGSLAT = JIN
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/csetvm.F b/src/packlib/kernlib/kerngen/tcgen/csetvm.F
deleted file mode 100644
index 859792a..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/csetvm.F
+++ /dev/null
@@ -1,62 +0,0 @@
-*
-* $Id: csetvm.F,v 1.1.1.1 1996/02/15 17:49:43 mclareni Exp $
-*
-* $Log: csetvm.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:43 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE CSETVM (NTIMEP,NINCP,JVALP,CHV,JLP,JRP,NSTEPP,IFLSQP)
-C
-C CERN PROGLIB# M432 CSETVM .VERSION KERNFOR 4.36 930602
-C ORIG. 01/04/92, JZ
-C
-C- Set NTIME decimal integers JVAL + n*NINC into CHV(JL:JR)
-C- every NSTEP columns, each with one leading blank
-C- and right-justified within its field;
-C- squeeze multiple blanks if IFLSQ non-zero.
-
- COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT, DUMMY(36)
-
- DIMENSION NTIMEP(9), NINCP(9), JVALP(9)
- DIMENSION JLP(9), JRP(9), NSTEPP(9), IFLSQP(9)
- CHARACTER CHV*(*)
-
-
- NTIME = NTIMEP(1)
- NINC = NINCP(1)
- JVAL = JVALP(1)
- JL = JLP(1)
- NSTEP = NSTEPP(1)
- LIMIT = JRP(1) - NSTEP + 1
- IFLSQ = IFLSQP(1)
- JWK = JL - 1
-
- DO 24 JIN=1,NTIME
- IF (JWK.GE.LIMIT) THEN
- IF (IFLSQ.EQ.0) GO TO 91
- IF (JIN.EQ.1) GO TO 91
- CALL CSQMBL (CHV,JL,JWK)
- JWK = NESLAT - 1
- IF (JWK.GE.LIMIT) GO TO 91
- ENDIF
- CALL CSETDI (JVAL,CHV,JWK+2,JWK+NSTEP)
- JVAL = JVAL + NINC
- 24 JWK = JWK + NSTEP
-
- IF (IFLSQ.NE.0) THEN
- CALL CSQMBL (CHV,JL,JWK)
- JWK = NESLAT - 1
- ENDIF
-
- NESLAT = JWK
- NGSLAT = 0
- RETURN
-
-C---- Errors
-
- 91 NESLAT = JWK
- NGSLAT = JIN
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/csqmbl.F b/src/packlib/kernlib/kerngen/tcgen/csqmbl.F
deleted file mode 100644
index debb82d..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/csqmbl.F
+++ /dev/null
@@ -1,73 +0,0 @@
-*
-* $Id: csqmbl.F,v 1.1.1.1 1996/02/15 17:49:43 mclareni Exp $
-*
-* $Log: csqmbl.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:43 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE CSQMBL (CHV,JLP,JRP)
-C
-C CERN PROGLIB# M432 CSQMBL .VERSION KERNFOR 4.22 890913
-C ORIG. 28/06/89, JZ
-C
-C- Squeeze multiple blanks in CHV(JL:JR), shifting left
-
- DIMENSION JLP(9), JRP(9)
-
- COMMON /SLATE/ NDSLAT,NESLAT, DUMMY(38)
- CHARACTER CHV*(*)
-
-C---- Find the first blank
-
- JL = JLP(1)
- JR = JRP(1)
-
- JP = JR + 1
- JJ = JL
- 12 IF (JJ.GE.JP) GO TO 99
- IF (CHV(JJ:JJ).NE.' ') THEN
- JJ = JJ + 1
- GO TO 12
- ENDIF
-
-C-- is it multiple ?
-
- JJ = JJ + 1
- IF (JJ.GE.JP) GO TO 99
- IF (CHV(JJ:JJ).NE.' ') GO TO 12
-
- JP = JJ
- JJ = JJ + 1
- 16 IF (JJ.GT.JR) GO TO 99
- IF (CHV(JJ:JJ).EQ.' ') THEN
- JJ = JJ + 1
- GO TO 16
- ENDIF
-
-C---- Copy shifted
-
- 24 CHV(JP:JP) = CHV(JJ:JJ)
- JP = JP + 1
- JJ = JJ + 1
- IF (JJ.GT.JR) GO TO 91
- IF (CHV(JJ:JJ).NE.' ') GO TO 24
-
- IF (JJ.EQ.JR) GO TO 91
- IF (CHV(JJ+1:JJ+1).NE.' ') GO TO 24
- CHV(JP:JP) = ' '
- JP = JP + 1
- JJ = JJ + 1
-
- 26 IF (JJ.GT.JR) GO TO 91
- IF (CHV(JJ:JJ).NE.' ') GO TO 24
- JJ = JJ + 1
- GO TO 26
-
- 91 CHV(JP:JR) = ' '
- 99 IF (CHV(JP-1:JP-1).EQ.' ') JP = JP - 1
- NESLAT = JP
- NDSLAT = JP - JL
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/csqmch.F b/src/packlib/kernlib/kerngen/tcgen/csqmch.F
deleted file mode 100644
index 92057d5..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/csqmch.F
+++ /dev/null
@@ -1,68 +0,0 @@
-*
-* $Id: csqmch.F,v 1.1.1.1 1996/02/15 17:49:44 mclareni Exp $
-*
-* $Log: csqmch.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:44 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE CSQMCH (CHAPAR,CHV,JLP,JRP)
-C
-C CERN PROGLIB# M432 CSQMCH .VERSION KERNFOR 4.24 900424
-C ORIG. 13/03/90, Jamie Shiers
-C
-C- Squeeze multiple occurrences of the character CHA in CHV(JL:JR),
-C- shifting left
-
- DIMENSION JLP(9), JRP(9)
-
- COMMON /SLATE/ NDSLAT,NESLAT, DUMMY(38)
- CHARACTER CHV*(*)
- CHARACTER*1 CHAPAR, CHA
-
-C---- Find the first occurrence of CHA
-
- CHA = CHAPAR
- JL = JLP(1)
- JR = JRP(1)
-
- JP = JR + 1
- JJ = JL
- 12 IF (JJ.GE.JP) GO TO 99
- IF (CHV(JJ:JJ).NE.CHA) THEN
- JJ = JJ + 1
- GO TO 12
- ENDIF
-
-C-- is it multiple ?
-
- JJ = JJ + 1
- IF (JJ.GE.JP) GO TO 99
- IF (CHV(JJ:JJ).NE.CHA) GO TO 12
-
- JP = JJ
- JJ = JJ + 1
- 16 IF (JJ.GT.JR) GO TO 91
- IF (CHV(JJ:JJ).EQ.CHA) THEN
- JJ = JJ + 1
- GO TO 16
- ENDIF
-
-C---- Copy shifted
-
- 24 CHV(JP:JP) = CHV(JJ:JJ)
- JP = JP + 1
- JJ = JJ + 1
- IF (JJ.GT.JR) GO TO 91
- IF (CHV(JJ-1:JJ-1).NE.CHA) GO TO 24
-
- 26 IF (CHV(JJ:JJ).NE.CHA) GO TO 24
- JJ = JJ + 1
- IF (JJ.LE.JR) GO TO 26
-
- 91 CHV(JP:JR) = ' '
- 99 NESLAT = JP
- NDSLAT = JP - JL
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/ctrans.F b/src/packlib/kernlib/kerngen/tcgen/ctrans.F
deleted file mode 100644
index db52170..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/ctrans.F
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: ctrans.F,v 1.1.1.1 1996/02/15 17:49:44 mclareni Exp $
-*
-* $Log: ctrans.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:44 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE CTRANS (CHOLD,CHNEW,CHV,JLP,JRP)
-C
-C CERN PROGLIB# M432 CTRANS .VERSION KERNFOR 4.24 900424
-C ORIG. 13/03/90, Jamie Shiers
-C
-C- Replace all occurrences of CHOLD in CHV(JLP:JRP) by CHNEW
-
- CHARACTER*(*) CHV
- CHARACTER*1 CHOLD,CHNEW
-
- DO 24 J=JLP,JRP
- 24 IF(CHV(J:J).EQ.CHOLD) CHV(J:J) = CHNEW
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/cutol.F b/src/packlib/kernlib/kerngen/tcgen/cutol.F
deleted file mode 100644
index 80688ed..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/cutol.F
+++ /dev/null
@@ -1,36 +0,0 @@
-*
-* $Id: cutol.F,v 1.1.1.1 1996/02/15 17:49:43 mclareni Exp $
-*
-* $Log: cutol.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:43 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE CUTOL (CHV)
-C
-C CERN PROGLIB# M432 CUTOL .VERSION KERNFOR 4.21 890323
-C ORIG. 11/02/86 A. PETRILLI
-C NEW 9/02/89 JZ, for speed
-C
-C- Convert character string CHV from upper to lower case.
-
- CHARACTER CHV*(*)
-#include "kerngen/qnatch.inc"
-* Ignoring t=pass
-
-
- DO 19 JJ=1,LEN(CHV)
-#if defined(CERNLIB_QASCII)
- J = ICHAR(CHV(JJ:JJ))
- IF (J.LT.65) GO TO 19
- IF (J.GE.91) GO TO 19
- CHV(JJ:JJ) = CHAR(J+32)
-#endif
-#if defined(CERNLIB_QEBCDIC)
- J = ICHAR(CHV(JJ:JJ))
- IF (NATCH(J+1).NE.4) GO TO 19
- CHV(JJ:JJ) = CHAR(J-64)
-#endif
- 19 CONTINUE
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/dosgs/ibits.F b/src/packlib/kernlib/kerngen/tcgen/dosgs/ibits.F
deleted file mode 100644
index 634a3ef..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/dosgs/ibits.F
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: ibits.F,v 1.1.1.1 1996/02/15 17:49:57 mclareni Exp $
-*
-* $Log: ibits.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:57 mclareni
-* Kernlib
-*
-*
- FUNCTION IBITS (IZW,IZP,NZB)
- IBITS = ISHFTR (LSHIFT(IZW,32-IZP-NZB), 32-NZB)
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/dosgs/kerngt.F b/src/packlib/kernlib/kerngen/tcgen/dosgs/kerngt.F
deleted file mode 100644
index fbdd242..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/dosgs/kerngt.F
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: kerngt.F,v 1.1.1.1 1996/02/15 17:49:57 mclareni Exp $
-*
-* $Log: kerngt.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:57 mclareni
-* Kernlib
-*
-*
- SUBROUTINE KERNGT (LUN)
-C
-C CERN PROGLIB# Z001 KERNGT .VERSION KERNDOS 1.00 920624
-C ORIG. 16/03/89
-C
-C-- Store Pam title into /SLATE/ for printing by GSHOWF
-
- COMMON /SLATE/ MCH(40)
-
-
- CALL UCTOH1 (
- + ' KERNDOS 1.01/5 940309 10.40 '
- +, MCH, 40)
- CALL GSHOWF (LUN)
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/doti.F b/src/packlib/kernlib/kerngen/tcgen/doti.F
deleted file mode 100644
index aeaa878..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/doti.F
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: doti.F,v 1.1.1.1 1996/02/15 17:49:51 mclareni Exp $
-*
-* $Log: doti.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:51 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- FUNCTION DOTI (X,Y)
-C
-C CERN PROGLIB# F116 DOTI .VERSION KERNFOR 3.03 780429
-C ORIG. 01/07/71
-C
- DIMENSION X(4),Y(4)
-C
- DOTI = X(1)*Y(1) + X(2)*Y(2) + X(3)*Y(3) - X(4)*Y(4)
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/ffsize.F b/src/packlib/kernlib/kerngen/tcgen/ffsize.F
deleted file mode 100644
index b7cb191..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/ffsize.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: ffsize.F,v 1.1.1.1 1996/02/15 17:49:44 mclareni Exp $
-*
-* $Log: ffsize.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:44 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QMHPX)
-#include "hpxgs/ffsize.F"
-#elif defined(CERNLIB_QMSGI)
-#include "sgigs/ffsize.F"
-#elif defined(CERNLIB_QMSUN)
-#include "sungs/ffsize.F"
-#else
- SUBROUTINE FFSIZE (LUN,NWREC,JREC,ISTAT)
-C
-C CERN PROGLIB# FFSIZE DUMMY .VERSION KERNFOR 4.26 910313
-C
-C- Get the size of a disk file connected to Fortran unit LUN
-C- dummy version
-
-
- ISTAT = -1
- RETURN
- END
-#endif
diff --git a/src/packlib/kernlib/kerngen/tcgen/floarg.F b/src/packlib/kernlib/kerngen/tcgen/floarg.F
deleted file mode 100644
index 2c24a59..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/floarg.F
+++ /dev/null
@@ -1,63 +0,0 @@
-*
-* $Id: floarg.F,v 1.1.1.1 1996/02/15 17:49:44 mclareni Exp $
-*
-* $Log: floarg.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:44 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QMSUN)
-#include "sungs/floarg.F"
-#elif defined(CERNLIB_QMVAX)
-#include "vaxgs/floarg.F"
-#else
- FUNCTION FLOARG (ARGM)
-C
-C CERN PROGLIB# M250 FLOARG .VERSION KERNFOR 4.23 891215
-C ORIG. 01/8/82 ADAPTED FROM UFLINT
-C
-C
- DIMENSION ARGM(9)
- EQUIVALENCE (A,IA)
-C
-#if defined(CERNLIB_QMCV64)
- PARAMETER (JEX=53, NEX=12, NEG=4095 )
-#endif
-#if defined(CERNLIB_QMCRY)
- PARAMETER (JEX=49, NEX=16, NEG=65535)
-#endif
-#if defined(CERNLIB_QMCDC)
- PARAMETER (JEX=49, NEX=12, NEG=4095 )
-#endif
-#if defined(CERNLIB_QMUNI)||defined(CERNLIB_QMUNO)
- PARAMETER (JEX=28, NEX= 9, NEG= 511 )
-#endif
-#if defined(CERNLIB_QMPDP)
- PARAMETER (JEX=28, NEX= 9, NEG= 511 )
-#endif
-#if defined(CERNLIB_QMDGE)||defined(CERNLIB_QMIBM)
- PARAMETER (JEX=25, NEX= 8, NEG= 255 )
-#endif
-#if (defined(CERNLIB_QIEEE))&&(defined(CERNLIB_B32))
- PARAMETER (JEX=24, NEX= 9, NEG= 511 )
-#endif
-#if defined(CERNLIB_QMND3)
- PARAMETER (JEX=23, NEX=10, NEG=1023 )
-#endif
-C
-#include "kerngen/q_jbit.inc"
-* Ignoring t=pass
-C
-C
- A = ARGM(1)
- JCH = JBYT (IA,JEX,NEX)
- IF (JCH.EQ.0) GO TO 36
- IF (JCH.EQ.NEG) GO TO 36
- FLOARG = A
- RETURN
-C
- 36 FLOARG = IA
- RETURN
- END
-#endif
diff --git a/src/packlib/kernlib/kerngen/tcgen/flpsor.F b/src/packlib/kernlib/kerngen/tcgen/flpsor.F
deleted file mode 100644
index 4285409..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/flpsor.F
+++ /dev/null
@@ -1,69 +0,0 @@
-*
-* $Id: flpsor.F,v 1.1.1.1 1996/02/15 17:49:44 mclareni Exp $
-*
-* $Log: flpsor.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:44 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE FLPSOR(A,N)
-C
-C CERN PROGLIB# M103 FLPSOR .VERSION KERNFOR 3.15 820113
-C ORIG. 29/04/78
-C
-C SORT THE ONE-DIMENSIONAL FLOATING POINT ARRAY A(1),...,A(N) BY
-C INCREASING VALUES
-C
-C- PROGRAM M103 TAKEN FROM CERN PROGRAM LIBRARY, 29-APR-78
-C
- DIMENSION A(N)
- COMMON /SLATE/ LT(20),RT(20)
- INTEGER R,RT
-C
- LEVEL=1
- LT(1)=1
- RT(1)=N
- 10 L=LT(LEVEL)
- R=RT(LEVEL)
- LEVEL=LEVEL-1
- 20 IF(R.GT.L) GO TO 200
- IF(LEVEL) 50,50,10
-C
-C SUBDIVIDE THE INTERVAL L,R
-C L : LOWER LIMIT OF THE INTERVAL (INPUT)
-C R : UPPER LIMIT OF THE INTERVAL (INPUT)
-C J : UPPER LIMIT OF LOWER SUB-INTERVAL (OUTPUT)
-C I : LOWER LIMIT OF UPPER SUB-INTERVAL (OUTPUT)
-C
- 200 I=L
- J=R
- M=(L+R)/2
- X=A(M)
- 220 IF(A(I).GE.X) GO TO 230
- I=I+1
- GO TO 220
- 230 IF(A(J).LE.X) GO TO 231
- J=J-1
- GO TO 230
-C
- 231 IF(I.GT.J) GO TO 232
- W=A(I)
- A(I)=A(J)
- A(J)=W
- I=I+1
- J=J-1
- IF(I.LE.J) GO TO 220
-C
- 232 LEVEL=LEVEL+1
- IF((R-I).GE.(J-L)) GO TO 30
- LT(LEVEL)=L
- RT(LEVEL)=J
- L=I
- GO TO 20
- 30 LT(LEVEL)=I
- RT(LEVEL)=R
- R=J
- GO TO 20
- 50 RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/getarg.F b/src/packlib/kernlib/kerngen/tcgen/getarg.F
deleted file mode 100644
index 58b4dfd..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/getarg.F
+++ /dev/null
@@ -1,14 +0,0 @@
-*
-* $Id: getarg.F,v 1.1.1.1 1996/02/15 17:49:40 mclareni Exp $
-*
-* $Log: getarg.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:40 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QMHPX)
-#include "hpxgs/getarg.F"
-#elif defined(CERNLIB_QMVAX)
-#include "vaxsys/getarg.F"
-#endif
diff --git a/src/packlib/kernlib/kerngen/tcgen/gshow.F b/src/packlib/kernlib/kerngen/tcgen/gshow.F
deleted file mode 100644
index d74876f..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/gshow.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: gshow.F,v 1.1.1.1 1996/02/15 17:49:41 mclareni Exp $
-*
-* $Log: gshow.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:41 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QMVAX)
-#include "vaxgs/gshow.F"
-#else
- SUBROUTINE GSHOW (LUN)
-C
-C CERN PROGLIB# Z001 GSHOW .VERSION KERNFOR 4.29 910718
-C ORIG. 18/12/78
-C
- CALL KERNGT (LUN)
- RETURN
- END
-#endif
diff --git a/src/packlib/kernlib/kerngen/tcgen/gshowf.F b/src/packlib/kernlib/kerngen/tcgen/gshowf.F
deleted file mode 100644
index 5027bc2..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/gshowf.F
+++ /dev/null
@@ -1,30 +0,0 @@
-*
-* $Id: gshowf.F,v 1.1.1.1 1996/02/15 17:49:41 mclareni Exp $
-*
-* $Log: gshowf.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:41 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE GSHOWF (LUNP)
-C
-C CERN PROGLIB# Z001 GSHOWF .VERSION KERNFOR 4.39 940228
-C ORIG. 18/12/78
-C
- COMMON /SLATE/ ICH(32),DUM(8)
- CHARACTER VIDQQ*(*)
- PARAMETER (VIDQQ = '@(#)' //
- + ' KERNFOR 4.42 1995/10/11 17.43 >')
- PARAMETER (LUNSTP=6)
-
- LUN = LUNP
- IF (LUN.EQ.0) LUN = LUNSTP
-
- WRITE (LUN,9002) ICH
- CALL CLEFT (VIDQQ,1,0)
- RETURN
-
- 9002 FORMAT (1X/25H KERNGT. KERNLIB from: , 32A1/25X,
- + ' KERNFOR 4.42 1995/10/11 17.43 ')
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/hpxgs/ffsize.F b/src/packlib/kernlib/kerngen/tcgen/hpxgs/ffsize.F
deleted file mode 100644
index dde13f8..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/hpxgs/ffsize.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: ffsize.F,v 1.1.1.1 1996/02/15 17:49:57 mclareni Exp $
-*
-* $Log: ffsize.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:57 mclareni
-* Kernlib
-*
-*
- SUBROUTINE FFSIZE (LUN,NWREC,JREC,ISTAT)
-C
-C CERN PROGLIB# FFSIZE .VERSION KERNHPX 1.01 920304
-C ORIG. 01/02/91 JZ
-C
-C- Get the size of a disk file connected to Fortran unit LUN
-
-
- LUNPTR = FNUM (LUN)
- IF (LUNPTR.EQ.0) GO TO 91
-
- CALL CFSIZE (LUNPTR,0,NWREC,JREC,ISTAT)
- RETURN
-
- 91 ISTAT = -7
- JREC = 0
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/hpxgs/getarg.F b/src/packlib/kernlib/kerngen/tcgen/hpxgs/getarg.F
deleted file mode 100644
index 9ab5c5b..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/hpxgs/getarg.F
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: getarg.F,v 1.1.1.1 1996/02/15 17:49:57 mclareni Exp $
-*
-* $Log: getarg.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:57 mclareni
-* Kernlib
-*
-*
- SUBROUTINE GETARG (JARG, CHARG)
-C
-C CERN PROGLIB# GETARG .VERSION KERNHPX 1.00 910201
-C ORIG. 13/03/91 JZ
-C
-C- interface to HPX routine IGETARG
-
- CHARACTER CHARG*(*)
-
-
- NCHMX = LEN (CHARG)
- NCH = IGETARG (JARG, CHARG, NCHMX)
-
- IF (NCH.LT.NCHMX) CHARG(NCH+1:) = ' '
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/hpxgs/kerngt.F b/src/packlib/kernlib/kerngen/tcgen/hpxgs/kerngt.F
deleted file mode 100644
index 551de22..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/hpxgs/kerngt.F
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: kerngt.F,v 1.1.1.1 1996/02/15 17:49:57 mclareni Exp $
-*
-* $Log: kerngt.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:57 mclareni
-* Kernlib
-*
-*
- SUBROUTINE KERNGT (LUN)
-C
-C CERN PROGLIB# Z001 KERNGT .VERSION KERNHPX 1.03 940511
-C ORIG. 16/03/89
-C
-C-- Store Pam title into /SLATE/ for printing by GSHOWF
-
- COMMON /SLATE/ MCH(40)
- CHARACTER VIDQQ*(*)
- PARAMETER (VIDQQ = '@(#)' //
- + ' KERNHPX 1.04 1995/09/28 19.17 >')
-
- CALL CLEFT (VIDQQ,1,0)
- CALL UCTOH1 (
- + 'KERNHPX 1.04 1995/09/28 19.17 '
- +, MCH, 40)
- CALL GSHOWF (LUN)
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/hpxgs/traceq.F b/src/packlib/kernlib/kerngen/tcgen/hpxgs/traceq.F
deleted file mode 100644
index 11a157f..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/hpxgs/traceq.F
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: traceq.F,v 1.1.1.1 1996/02/15 17:49:57 mclareni Exp $
-*
-* $Log: traceq.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:57 mclareni
-* Kernlib
-*
-*
- SUBROUTINE TRACEQ (LUNP,LEV)
-C
-C CERN PROGLIB# N105 TRACEQ .VERSION KERNHPX 1.04 950928
-C ORIG. 3/05/95 FR, JZ
-C
-* unit number for standard output
- PARAMETER (LUNSTP=6)
-
- LUN = LUNP
- IF (LUN.EQ.0) LUN = LUNSTP
- WRITE (LUN,9001)
- 9001 FORMAT (/' TRACEQ. Trace-back printed to standard output.')
-
- CALL TRACEQC
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/ibits.F b/src/packlib/kernlib/kerngen/tcgen/ibits.F
deleted file mode 100644
index cd03f53..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/ibits.F
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: ibits.F,v 1.2 2006/09/15 09:35:19 mclareni Exp $
-*
-* $Log: ibits.F,v $
-* Revision 1.2 2006/09/15 09:35:19 mclareni
-* Submitted mods for gcc4/gfortran and MacOSX, corrected to work also on slc4 with gcc3.4 and 4.1
-*
-* Revision 1.1.1.1 1996/02/15 17:49:44 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QMDOS)
-#include "dosgs/ibits.F"
-#elif defined(CERNLIB_QMLNX) && !defined(CERNLIB_GFORTRAN)
-#include "lnxgs/ibits.F"
-#elif !defined(CERNLIB_QMILSTD)
- FUNCTION IBITS(I,N,L)
-C
-C CERN PROGLIB# M441 IBITS .VERSION KERNFOR 4.16 870601
-C ORIG. 01/03/85 M.METCALF
-C
-C FORTRAN VERSION OF MIL-STD-1753 FUNCTION IBITS
-C N IS THE RIGHTMOST BIT OF THE REQUIRED FIELD
-C L IS THE LENGTH OF THE REQUIRED FIELD
-C
-#include "kerngen/wordsize.inc"
-C
- IBITS = ISHFT(ISHFT(I, NBITPW-L-N), L-NBITPW)
- END
-#endif
diff --git a/src/packlib/kernlib/kerngen/tcgen/icdeci.F b/src/packlib/kernlib/kerngen/tcgen/icdeci.F
deleted file mode 100644
index 38c7dc0..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/icdeci.F
+++ /dev/null
@@ -1,67 +0,0 @@
-*
-* $Id: icdeci.F,v 1.1.1.1 1996/02/15 17:49:44 mclareni Exp $
-*
-* $Log: icdeci.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:44 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- FUNCTION ICDECI (CHV,JLP,JRP)
-C
-C CERN PROGLIB# M432 ICDECI .VERSION KERNFOR 4.22 890913
-C ORIG. 04/10/88, JZ
-C
-C- Read decimal integer from CHV(JL:JR)
-
- DIMENSION JLP(9), JRP(9)
-
- COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT, DUMMY(36)
- CHARACTER CHV*(*)
-
- JJ = JLP(1)
- JR = JRP(1)
-
- IVAL = 0
- NDG = 0
- NEG = 0
- NGSLAT = 0
-
- 12 IF (JJ.GT.JR) GO TO 99
- IF (CHV(JJ:JJ).EQ.' ') THEN
- JJ = JJ + 1
- GO TO 12
- ELSEIF (CHV(JJ:JJ).EQ.'+') THEN
- JJ = JJ + 1
- ELSEIF (CHV(JJ:JJ).EQ.'-') THEN
- NEG = 7
- JJ = JJ + 1
- ENDIF
-
- 21 IF (JJ.GT.JR) GO TO 99
-#if defined(CERNLIB_QASCII)
- K = ICHAR (CHV(JJ:JJ))
- K = K - 48
- IF (K.LT.0) GO TO 98
- IF (K.GE.10) GO TO 98
-#endif
-#if defined(CERNLIB_QEBCDIC)
- K = ICHAR (CHV(JJ:JJ))
- K = K - 240
- IF (K.LT.0) GO TO 98
- IF (K.GE.10) GO TO 98
-#endif
- IVAL = 10*IVAL + K
- NDG = NDG + 1
- JJ = JJ + 1
- GO TO 21
-
- 98 IF (CHV(JJ:JJ).NE.' ') NGSLAT = JJ
- 99 NDSLAT = NDG
- NESLAT = JJ
- IF (NEG.NE.0) THEN
- IF (IVAL.NE.0) IVAL = -IVAL
- ENDIF
- ICDECI = IVAL
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/icequ.F b/src/packlib/kernlib/kerngen/tcgen/icequ.F
deleted file mode 100644
index 29ba9b5..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/icequ.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: icequ.F,v 1.1.1.1 1996/02/15 17:49:44 mclareni Exp $
-*
-* $Log: icequ.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:44 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- FUNCTION ICEQU (CHXA, CHXB, NTX)
-C
-C CERN PROGLIB# M432 ICEQU .VERSION KERNFOR 4.39 940228
-C ORIG. 08/11/93, JZ
-C
-C- Check CHXA and CHXB are identical, return zero if so
-
- CHARACTER CHXA(512)*1, CHXB(512)*1
-
-
- DO 16 JJ=1,NTX
- IF (CHXA(JJ).NE.CHXB(JJ)) GO TO 19
- 16 CONTINUE
- ICEQU = 0
- RETURN
-
- 19 ICEQU = JJ
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/icfila.F b/src/packlib/kernlib/kerngen/tcgen/icfila.F
deleted file mode 100644
index 7f2be5e..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/icfila.F
+++ /dev/null
@@ -1,38 +0,0 @@
-*
-* $Id: icfila.F,v 1.1.1.1 1996/02/15 17:49:45 mclareni Exp $
-*
-* $Log: icfila.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:45 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- FUNCTION ICFILA (CHI, CHV,JLP,JRP)
-C
-C CERN PROGLIB# M432 ICFILA .VERSION KERNFOR 4.21 890323
-C ORIG. 04/10/88, JZ
-C
-C- Find last occurrence of CHI(1:1) in CHV(JL:JR)
-
- DIMENSION JLP(9), JRP(9)
-
- COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT, DUMMY(36)
- CHARACTER CHV*(*), CHI*1
-
- JL = JLP(1)
- JR = JRP(1)
- JJ = JR
-
- 11 IF (JJ.LT.JL) GO TO 19
- IF (CHV(JJ:JJ).NE.CHI) THEN
- JJ = JJ - 1
- GO TO 11
- ENDIF
- NGSLAT = JJ
- ICFILA = JJ
- RETURN
-
- 19 NGSLAT = 0
- ICFILA = JR+1
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/icfind.F b/src/packlib/kernlib/kerngen/tcgen/icfind.F
deleted file mode 100644
index 2aa8e56..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/icfind.F
+++ /dev/null
@@ -1,37 +0,0 @@
-*
-* $Id: icfind.F,v 1.1.1.1 1996/02/15 17:49:45 mclareni Exp $
-*
-* $Log: icfind.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:45 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- FUNCTION ICFIND (CHI, CHV,JLP,JRP)
-C
-C CERN PROGLIB# M432 ICFIND .VERSION KERNFOR 4.21 890323
-C ORIG. 04/10/88, JZ
-C
-C- Find first occurrence of CHI(1:1) in CHV(JL:JR)
-
- DIMENSION JLP(9), JRP(9)
-
- COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT, DUMMY(36)
- CHARACTER CHV*(*), CHI*1
-
- JJ = JLP(1)
- JR = JRP(1)
-
- 11 IF (JJ.GT.JR) GO TO 19
- IF (CHV(JJ:JJ).NE.CHI) THEN
- JJ = JJ + 1
- GO TO 11
- ENDIF
- NGSLAT = JJ
- ICFIND = JJ
- RETURN
-
- 19 NGSLAT = 0
- ICFIND = JR + 1
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/icfmul.F b/src/packlib/kernlib/kerngen/tcgen/icfmul.F
deleted file mode 100644
index 6c731b7..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/icfmul.F
+++ /dev/null
@@ -1,40 +0,0 @@
-*
-* $Id: icfmul.F,v 1.1.1.1 1996/02/15 17:49:45 mclareni Exp $
-*
-* $Log: icfmul.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:45 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- FUNCTION ICFMUL (CHI, CHV,JLP,JRP)
-C
-C CERN PROGLIB# M432 ICFMUL .VERSION KERNFOR 4.21 890323
-C ORIG. 04/10/88, JZ
-C
-C- Find first occurrence of any of CHI(j:j) in CHV(JL:JR)
-
- DIMENSION JLP(9), JRP(9)
-
- COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT, DUMMY(36)
- CHARACTER CHV*(*), CHI*(*)
-
- JJ = JLP(1)
- JR = JRP(1)
-
- 11 IF (JJ.GT.JR) GO TO 19
- JTH = INDEX (CHI,CHV(JJ:JJ))
- IF (JTH.EQ.0) THEN
- JJ = JJ + 1
- GO TO 11
- ENDIF
- NDSLAT = JTH
- NGSLAT = JJ
- ICFMUL = JJ
- RETURN
-
- 19 NDSLAT = 0
- NGSLAT = 0
- ICFMUL = JR+1
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/icfnbl.F b/src/packlib/kernlib/kerngen/tcgen/icfnbl.F
deleted file mode 100644
index 925c1c2..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/icfnbl.F
+++ /dev/null
@@ -1,37 +0,0 @@
-*
-* $Id: icfnbl.F,v 1.1.1.1 1996/02/15 17:49:45 mclareni Exp $
-*
-* $Log: icfnbl.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:45 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- FUNCTION ICFNBL (CHV,JLP,JRP)
-C
-C CERN PROGLIB# M432 ICFNBL .VERSION KERNFOR 4.21 890323
-C ORIG. 04/10/88, JZ
-C
-C- Find first non-blank character in CHV(JL:JR)
-
- DIMENSION JLP(9), JRP(9)
-
- COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT, DUMMY(36)
- CHARACTER CHV*(*)
-
- JJ = JLP(1)
- JR = JRP(1)
-
- 12 IF (JJ.GT.JR) GO TO 19
- IF (CHV(JJ:JJ).EQ.' ') THEN
- JJ = JJ + 1
- GO TO 12
- ENDIF
- NGSLAT = JJ
- ICFNBL = JJ
- RETURN
-
- 19 NGSLAT = 0
- ICFNBL = JJ
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/ichexi.F b/src/packlib/kernlib/kerngen/tcgen/ichexi.F
deleted file mode 100644
index 36c8d65..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/ichexi.F
+++ /dev/null
@@ -1,93 +0,0 @@
-*
-* $Id: ichexi.F,v 1.1.1.1 1996/02/15 17:49:45 mclareni Exp $
-*
-* $Log: ichexi.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:45 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- FUNCTION ICHEXI (CHV,JLP,JRP)
-C
-C CERN PROGLIB# M432 ICHEXI .VERSION KERNFOR 4.35 930308
-C ORIG. 04/10/88, JZ
-C
-C- Read hexadecimal integer from CHV(JL:JR)
-
- DIMENSION JLP(9), JRP(9)
-
- COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT, DUMMY(36)
- CHARACTER CHV*(*)
-
-#if !defined(CERNLIB_QISASTD)
-#include "kerngen/q_andor.inc"
-#include "kerngen/q_shift.inc"
-#endif
-
- JJ = JLP(1)
- JR = JRP(1)
-
- IVAL = 0
- NDG = 0
- NEG = 0
- NGSLAT = 0
-
- 12 IF (JJ.GT.JR) GO TO 99
- IF (CHV(JJ:JJ).EQ.' ') THEN
- JJ = JJ + 1
- GO TO 12
- ELSEIF (CHV(JJ:JJ).EQ.'+') THEN
- JJ = JJ + 1
- ELSEIF (CHV(JJ:JJ).EQ.'-') THEN
- NEG = 7
- JJ = JJ + 1
- ENDIF
-
- 21 IF (JJ.GT.JR) GO TO 99
-#if defined(CERNLIB_QASCII)
- K = ICHAR (CHV(JJ:JJ))
- K = K - 48
- IF (K.LT.0) GO TO 98
- IF (K.GE.10) THEN
- K = K - 7
- IF (K.LT.10) GO TO 98
- IF (K.GE.16) THEN
- K = K - 32
- IF (K.LT.10) GO TO 98
- IF (K.GE.16) GO TO 98
- ENDIF
- ENDIF
-#endif
-#if defined(CERNLIB_QEBCDIC)
- K = ICHAR (CHV(JJ:JJ))
- K = K - 119
- IF (K.LT.10) GO TO 98
- IF (K.GE.16) THEN
- K = K - 64
- IF (K.LT.10) GO TO 98
- IF (K.GE.16) THEN
- K = K - 57
- IF (K.LT.0) GO TO 98
- IF (K.GE.10) GO TO 98
- ENDIF
- ENDIF
-#endif
-#if !defined(CERNLIB_QISASTD)
- IVAL = IOR (ISHFTL(IVAL,4), K)
-#endif
-#if defined(CERNLIB_QISASTD)
- IVAL = IOR (ISHFT (IVAL,4), K)
-#endif
- NDG = NDG + 1
- JJ = JJ + 1
- GO TO 21
-
- 98 IF (CHV(JJ:JJ).NE.' ') NGSLAT = JJ
- 99 NDSLAT = NDG
- NESLAT = JJ
- IF (NEG.NE.0) THEN
- IF (IVAL.NE.0) IVAL = -IVAL
- ENDIF
- ICHEXI = IVAL
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/icinq.F b/src/packlib/kernlib/kerngen/tcgen/icinq.F
deleted file mode 100644
index 20b21b9..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/icinq.F
+++ /dev/null
@@ -1,63 +0,0 @@
-*
-* $Id: icinq.F,v 1.1.1.1 1996/02/15 17:49:45 mclareni Exp $
-*
-* $Log: icinq.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:45 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- FUNCTION ICINQ (TEXT,POSS,NPOSS)
-C
-C CERN PROGLIB# M432 ICINQ .VERSION KERNFOR 4.36 930602
-C ORIG. 24/05/93, JZ
-C
-C- Match TEXT against POSS(NPOSS), case sensitive
-
- CHARACTER*(*) TEXT, POSS(99)
- CHARACTER*1 CHT, CHP
-
-
- NTX = LEN(TEXT)
- NPO = LEN(POSS(1))
-
- JPOSS = 0
- 11 JPOSS = JPOSS + 1
- IF (JPOSS.GT.NPOSS) GO TO 98
- CHP = POSS(JPOSS)(1:1)
- CHT = TEXT(1:1)
- JC = 1
- 12 IF (CHT.NE.CHP) GO TO 11
- JC = JC + 1
- IF (JC.GT.NPO) GO TO 99
- CHP = POSS(JPOSS)(JC:JC)
- IF (CHP.EQ.' ') GO TO 71
- IF (JC.GT.NTX) GO TO 11
- CHT = TEXT(JC:JC)
- IF (CHT.NE.'*') GO TO 12
-
-C---- First '*' seen on TEXT
-
- 61 JC = JC + 1
- IF (JC.GT.NTX) GO TO 99
- CHT = TEXT(JC:JC)
- IF (CHT.EQ.'*') GO TO 99
- IF (CHT.EQ.' ') GO TO 99
- IF (CHP.NE.CHT) GO TO 11
- IF (JC.GT.NPO) GO TO 99
- CHP = POSS(JPOSS)(JC:JC)
- IF (CHP.NE.' ') GO TO 61
- GO TO 99
-
-C---- POSS blank terminated
-
- 71 IF (JC.GT.NTX) GO TO 99
- CHT = TEXT(JC:JC)
- IF (CHT.EQ.' ') GO TO 99
- IF (CHT.EQ.'*') GO TO 99
- GO TO 11
-
- 98 JPOSS = 0
- 99 ICINQ = JPOSS
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/icinql.F b/src/packlib/kernlib/kerngen/tcgen/icinql.F
deleted file mode 100644
index f6f96a2..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/icinql.F
+++ /dev/null
@@ -1,89 +0,0 @@
-*
-* $Id: icinql.F,v 1.1.1.1 1996/02/15 17:49:45 mclareni Exp $
-*
-* $Log: icinql.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:45 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- FUNCTION ICINQL (TEXT,POSS,NPOSS)
-C
-C CERN PROGLIB# M432 ICINQL .VERSION KERNFOR 4.36 930602
-C ORIG. 24/05/93, JZ
-C
-C- Match TEXT against lower case POSS(NPOSS), case insensitive
-
- CHARACTER*(*) TEXT, POSS(99)
- CHARACTER*1 CHT, CHP
-
-#include "kerngen/qnatch.inc"
-* Ignoring t=pass
-
- NTX = LEN(TEXT)
- NPO = LEN(POSS(1))
-
- JPOSS = 0
- 11 JPOSS = JPOSS + 1
- IF (JPOSS.GT.NPOSS) GO TO 98
- CHP = POSS(JPOSS)(1:1)
- CHT = TEXT(1:1)
- JC = 1
- 12 IF (CHT.NE.CHP) THEN
- IVT = ICHAR(CHT)
- IVP = ICHAR(CHP)
-#if defined(CERNLIB_QASCII)
- IF (IVP-IVT.NE.32) GO TO 11
- IF (IVT.LT.65) GO TO 11
- IF (IVT.GT.90) GO TO 11
-#endif
-#if defined(CERNLIB_QEBCDIC)
- IF (IVT-IVP.NE.64) GO TO 11
- IF (NATCH(IVT+1).NE.4) GO TO 11
-#endif
- ENDIF
- JC = JC + 1
- IF (JC.GT.NPO) GO TO 99
- CHP = POSS(JPOSS)(JC:JC)
- IF (CHP.EQ.' ') GO TO 71
- IF (JC.GT.NTX) GO TO 11
- CHT = TEXT(JC:JC)
- IF (CHT.NE.'*') GO TO 12
-
-C---- First '*' seen on TEXT
-
- 61 JC = JC + 1
- IF (JC.GT.NTX) GO TO 99
- CHT = TEXT(JC:JC)
- IF (CHT.EQ.'*') GO TO 99
- IF (CHT.EQ.' ') GO TO 99
- IF (CHP.NE.CHT) THEN
- IVT = ICHAR(CHT)
- IVP = ICHAR(CHP)
-#if defined(CERNLIB_QASCII)
- IF (IVP-IVT.NE.32) GO TO 11
- IF (IVT.LT.65) GO TO 11
- IF (IVT.GT.90) GO TO 11
-#endif
-#if defined(CERNLIB_QEBCDIC)
- IF (IVT-IVP.NE.64) GO TO 11
- IF (NATCH(IVT+1).NE.4) GO TO 11
-#endif
- ENDIF
- IF (JC.GT.NPO) GO TO 99
- CHP = POSS(JPOSS)(JC:JC)
- IF (CHP.NE.' ') GO TO 61
- GO TO 99
-
-C---- POSS blank terminated
-
- 71 IF (JC.GT.NTX) GO TO 99
- CHT = TEXT(JC:JC)
- IF (CHT.EQ.' ') GO TO 99
- IF (CHT.EQ.'*') GO TO 99
- GO TO 11
-
- 98 JPOSS = 0
- 99 ICINQL = JPOSS
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/icinqu.F b/src/packlib/kernlib/kerngen/tcgen/icinqu.F
deleted file mode 100644
index 01894d6..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/icinqu.F
+++ /dev/null
@@ -1,89 +0,0 @@
-*
-* $Id: icinqu.F,v 1.1.1.1 1996/02/15 17:49:46 mclareni Exp $
-*
-* $Log: icinqu.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:46 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- FUNCTION ICINQU (TEXT,POSS,NPOSS)
-C
-C CERN PROGLIB# M432 ICINQU .VERSION KERNFOR 4.36 930602
-C ORIG. 24/05/93, JZ
-C
-C- Match TEXT against upper case POSS(NPOSS), case insensitive
-
- CHARACTER*(*) TEXT, POSS(99)
- CHARACTER*1 CHT, CHP
-
-#include "kerngen/qnatch.inc"
-* Ignoring t=pass
-
- NTX = LEN(TEXT)
- NPO = LEN(POSS(1))
-
- JPOSS = 0
- 11 JPOSS = JPOSS + 1
- IF (JPOSS.GT.NPOSS) GO TO 98
- CHP = POSS(JPOSS)(1:1)
- CHT = TEXT(1:1)
- JC = 1
- 12 IF (CHT.NE.CHP) THEN
- IVT = ICHAR(CHT)
- IVP = ICHAR(CHP)
-#if defined(CERNLIB_QASCII)
- IF (IVT-IVP.NE.32) GO TO 11
- IF (IVT.LT.97) GO TO 11
- IF (IVT.GT.122) GO TO 11
-#endif
-#if defined(CERNLIB_QEBCDIC)
- IF (IVP-IVT.NE.64) GO TO 11
- IF (NATCH(IVT+1).NE.3) GO TO 11
-#endif
- ENDIF
- JC = JC + 1
- IF (JC.GT.NPO) GO TO 99
- CHP = POSS(JPOSS)(JC:JC)
- IF (CHP.EQ.' ') GO TO 71
- IF (JC.GT.NTX) GO TO 11
- CHT = TEXT(JC:JC)
- IF (CHT.NE.'*') GO TO 12
-
-C---- First '*' seen on TEXT
-
- 61 JC = JC + 1
- IF (JC.GT.NTX) GO TO 99
- CHT = TEXT(JC:JC)
- IF (CHT.EQ.'*') GO TO 99
- IF (CHT.EQ.' ') GO TO 99
- IF (CHP.NE.CHT) THEN
- IVT = ICHAR(CHT)
- IVP = ICHAR(CHP)
-#if defined(CERNLIB_QASCII)
- IF (IVT-IVP.NE.32) GO TO 11
- IF (IVT.LT.97) GO TO 11
- IF (IVT.GT.122) GO TO 11
-#endif
-#if defined(CERNLIB_QEBCDIC)
- IF (IVP-IVT.NE.64) GO TO 11
- IF (NATCH(IVT+1).NE.3) GO TO 11
-#endif
- ENDIF
- IF (JC.GT.NPO) GO TO 99
- CHP = POSS(JPOSS)(JC:JC)
- IF (CHP.NE.' ') GO TO 61
- GO TO 99
-
-C---- POSS blank terminated
-
- 71 IF (JC.GT.NTX) GO TO 99
- CHT = TEXT(JC:JC)
- IF (CHT.EQ.' ') GO TO 99
- IF (CHT.EQ.'*') GO TO 99
- GO TO 11
-
- 98 JPOSS = 0
- 99 ICINQU = JPOSS
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/icloc.F b/src/packlib/kernlib/kerngen/tcgen/icloc.F
deleted file mode 100644
index 7d23638..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/icloc.F
+++ /dev/null
@@ -1,42 +0,0 @@
-*
-* $Id: icloc.F,v 1.1.1.1 1996/02/15 17:49:46 mclareni Exp $
-*
-* $Log: icloc.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:46 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- FUNCTION ICLOC (CHI,NI,CHV,JL,JR)
-C
-C CERN PROGLIB# M432 ICLOC .VERSION KERNFOR 4.21 890323
-C ORIG. 09/02/89, JZ
-C
-C- Locate CHI of NI characters inside CHV(JL:JR), case sensitive
-
- CHARACTER CHI*(*), CHV*(*), CHWK1*1
-
- JVV = JL - 1
- JVVE = JR+1 - NI
- CHWK1 = CHI(1:1)
-
-C-- Scan CHV to find the first char. of CHI
-
- 12 JVV = JVV + 1
- IF (JVV.GT.JVVE) GO TO 90
- IF (CHV(JVV:JVV).NE.CHWK1) GO TO 12
-
-C-- Match the further characters
-
- JVX = JVV
- JI = 1
- 14 JI = JI + 1
- IF (JI.GT.NI) GO TO 91
- JVX = JVX + 1
- IF (CHV(JVX:JVX).EQ.CHI(JI:JI)) GO TO 14
- GO TO 12
-
- 90 JVV = 0
- 91 ICLOC = JVV
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/iclocl.F b/src/packlib/kernlib/kerngen/tcgen/iclocl.F
deleted file mode 100644
index d0db1d1..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/iclocl.F
+++ /dev/null
@@ -1,71 +0,0 @@
-*
-* $Id: iclocl.F,v 1.1.1.1 1996/02/15 17:49:46 mclareni Exp $
-*
-* $Log: iclocl.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:46 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- FUNCTION ICLOCL (CHI,NI,CHV,JL,JR)
-C
-C CERN PROGLIB# M432 ICLOCL .VERSION KERNFOR 4.22 890913
-C ORIG. 09/02/89, JZ
-C
-C- Locate CHI of NI characters inside CHV(JL:JR),
-C- CHI must be given in lower case, CHV case insensitive
-
- CHARACTER CHI*(*), CHV*(*), CHWK1*1
-#include "kerngen/qnatch.inc"
-* Ignoring t=pass
-
- JVV = JL - 1
- JVVE = JR+1 - NI
- CHWK1 = CHI(1:1)
-#if defined(CERNLIB_QASCII)
- NAT1 = 0
- IVX1 = ICHAR(CHWK1) - 32
- IF (IVX1.LT.65) GO TO 12
- IF (IVX1.GE.91) GO TO 12
- NAT1 = 3
-#endif
-#if defined(CERNLIB_QEBCDIC)
- IVX1 = ICHAR(CHWK1)
- NAT1 = NATCH(IVX1+1)
- IVX1 = IVX1 + 64
-#endif
-
-C-- Scan CHV to find the first char. of CHI
-
- 12 JVV = JVV + 1
- IF (JVV.GT.JVVE) GO TO 90
- IF (CHV(JVV:JVV).NE.CHWK1) THEN
- IF (NAT1.NE.3) GO TO 12
- IF (ICHAR(CHV(JVV:JVV)).NE.IVX1) GO TO 12
- ENDIF
-
-C-- Match the further characters
-
- JVX = JVV
- JI = 1
- 14 JI = JI + 1
- IF (JI.GT.NI) GO TO 91
- JVX = JVX + 1
- IF (CHV(JVX:JVX).EQ.CHI(JI:JI)) GO TO 14
-#if defined(CERNLIB_QASCII)
- IVAL = ICHAR(CHI(JI:JI))
- IF (ICHAR(CHV(JVX:JVX)).NE.IVAL-32) GO TO 12
- IF (IVAL.LT.97) GO TO 12
- IF (IVAL.GE.123) GO TO 12
-#endif
-#if defined(CERNLIB_QEBCDIC)
- IVAL = ICHAR(CHI(JI:JI))
- IF (ICHAR(CHV(JVX:JVX)).NE.IVAL+64) GO TO 12
- IF (NATCH(IVAL+1).NE.3) GO TO 12
-#endif
- GO TO 14
-
- 90 JVV = 0
- 91 ICLOCL = JVV
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/iclocu.F b/src/packlib/kernlib/kerngen/tcgen/iclocu.F
deleted file mode 100644
index 8ce52ac..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/iclocu.F
+++ /dev/null
@@ -1,71 +0,0 @@
-*
-* $Id: iclocu.F,v 1.1.1.1 1996/02/15 17:49:46 mclareni Exp $
-*
-* $Log: iclocu.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:46 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- FUNCTION ICLOCU (CHI,NI,CHV,JL,JR)
-C
-C CERN PROGLIB# M432 ICLOCU .VERSION KERNFOR 4.21 890323
-C ORIG. 09/02/89, JZ
-C
-C- Locate CHI of NI characters inside CHV(JL:JR),
-C- CHI must be given in upper case, CHV case insensitive
-
- CHARACTER CHI*(*), CHV*(*), CHWK1*1
-#include "kerngen/qnatch.inc"
-* Ignoring t=pass
-
- JVV = JL - 1
- JVVE = JR+1 - NI
- CHWK1 = CHI(1:1)
-#if defined(CERNLIB_QASCII)
- NAT1 = 0
- IVX1 = ICHAR(CHWK1) + 32
- IF (IVX1.LT.97) GO TO 12
- IF (IVX1.GE.123) GO TO 12
- NAT1 = 4
-#endif
-#if defined(CERNLIB_QEBCDIC)
- IVX1 = ICHAR(CHWK1)
- NAT1 = NATCH(IVX1+1)
- IVX1 = IVX1 - 64
-#endif
-
-C-- Scan CHV to find the first char. of CHI
-
- 12 JVV = JVV + 1
- IF (JVV.GT.JVVE) GO TO 90
- IF (CHV(JVV:JVV).NE.CHWK1) THEN
- IF (NAT1.NE.4) GO TO 12
- IF (ICHAR(CHV(JVV:JVV)).NE.IVX1) GO TO 12
- ENDIF
-
-C-- Match the further characters
-
- JVX = JVV
- JI = 1
- 14 JI = JI + 1
- IF (JI.GT.NI) GO TO 91
- JVX = JVX + 1
- IF (CHV(JVX:JVX).EQ.CHI(JI:JI)) GO TO 14
-#if defined(CERNLIB_QASCII)
- IVAL = ICHAR(CHI(JI:JI))
- IF (ICHAR(CHV(JVX:JVX)).NE.IVAL+32) GO TO 12
- IF (IVAL.LT.65) GO TO 12
- IF (IVAL.GE.91) GO TO 12
-#endif
-#if defined(CERNLIB_QEBCDIC)
- IVAL = ICHAR(CHI(JI:JI))
- IF (ICHAR(CHV(JVX:JVX)).NE.IVAL-64) GO TO 12
- IF (NATCH(IVAL+1).NE.4) GO TO 12
-#endif
- GO TO 14
-
- 90 JVV = 0
- 91 ICLOCU = JVV
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/icluns.F b/src/packlib/kernlib/kerngen/tcgen/icluns.F
deleted file mode 100644
index 99f6b8b..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/icluns.F
+++ /dev/null
@@ -1,38 +0,0 @@
-*
-* $Id: icluns.F,v 1.1.1.1 1996/02/15 17:49:46 mclareni Exp $
-*
-* $Log: icluns.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:46 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- FUNCTION ICLUNS (CHV,JL,JR)
-C
-C CERN PROGLIB# M432 ICLUNS .VERSION KERNFOR 4.21 890323
-C ORIG. 16/01/89, JZ
-C
-C- Locate the first 'unseen' character in CHV(JL:JR)
-
- CHARACTER CHV*(*)
-#include "kerngen/qnatch.inc"
-* Ignoring t=pass
-
- JX = JL
- 12 IF (JX.GT.JR) GO TO 90
-#if defined(CERNLIB_QASCII)
- IVAL = ICHAR(CHV(JX:JX))
- IF (IVAL.LT.32) GO TO 91
- IF (IVAL.GE.127) GO TO 91
-#endif
-#if defined(CERNLIB_QEBCDIC)
- IVAL = ICHAR(CHV(JX:JX))
- IF (NATCH(IVAL+1).EQ.0) GO TO 91
-#endif
- JX = JX + 1
- GO TO 12
-
- 90 JX = 0
- 91 ICLUNS = JX
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/icnext.F b/src/packlib/kernlib/kerngen/tcgen/icnext.F
deleted file mode 100644
index 4c698cd..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/icnext.F
+++ /dev/null
@@ -1,50 +0,0 @@
-*
-* $Id: icnext.F,v 1.1.1.1 1996/02/15 17:49:46 mclareni Exp $
-*
-* $Log: icnext.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:46 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- FUNCTION ICNEXT (CHV,JLP,JRP)
-C
-C CERN PROGLIB# M432 ICNEXT .VERSION KERNFOR 4.21 890323
-C ORIG. 04/10/88, JZ
-C
-C- Find limits of next word in CHV(JL:JR)
-
- DIMENSION JLP(9), JRP(9)
-
- COMMON /SLATE/ NDSLAT,NESLAT, DUMMY(38)
- CHARACTER CHV*(*)
-
-C-- Ignore leading blanks
-
- JJ = JLP(1)
- JR = JRP(1)
-
- 12 IF (JJ.GT.JR) GO TO 99
- IF (CHV(JJ:JJ).EQ.' ') THEN
- JJ = JJ + 1
- GO TO 12
- ENDIF
-
-C-- Find terminating blank
-
- JF = JJ
- 14 JJ = JJ + 1
- IF (JJ.LE.JR) THEN
- IF (CHV(JJ:JJ).NE.' ') GO TO 14
- ENDIF
-
- NESLAT = JJ
- NDSLAT = JJ - JF
- ICNEXT = JF
- RETURN
-
- 99 NDSLAT = 0
- NESLAT = JJ
- ICNEXT = JJ
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/icnth.F b/src/packlib/kernlib/kerngen/tcgen/icnth.F
deleted file mode 100644
index 0dbb6de..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/icnth.F
+++ /dev/null
@@ -1,72 +0,0 @@
-*
-* $Id: icnth.F,v 1.1.1.1 1996/02/15 17:49:46 mclareni Exp $
-*
-* $Log: icnth.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:46 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- FUNCTION ICNTH (TEXT,POSS,NPOSS)
-C
-C CERN PROGLIB# M432 ICNTH .VERSION KERNFOR 4.36 930602
-C ORIG. 04/10/88, JZ
-C
-C- Match TEXT against POSS(NPOSS), case sensitive
-
- CHARACTER*(*) TEXT,POSS(99)
- CHARACTER*1 CHP, CHT
-
-
- NTX = LEN(TEXT)
- NPO = LEN(POSS(1))
- JPOSS = 0
-C PRINT 9009, NTX,NPO, TEXT
-C9009 FORMAT ('NTX,NPO=',2I4,' find >',A,'<')
-
- 11 JPOSS = JPOSS + 1
- IF (JPOSS.GT.NPOSS) GO TO 98
- JC = 1
-C PRINT 9011, JPOSS,POSS(JPOSS)
-C9011 FORMAT ('JPOSS=',I3,' take >',A,'<')
- CHP = POSS(JPOSS)(1:1)
- 12 CHT = TEXT(JC:JC)
-C PRINT 9012, CHT,CHP
-C9012 FORMAT ('@12 CHT/CHP= ',A,1X,A)
- IF (CHT.NE.CHP) GO TO 11
- JC = JC + 1
- IF (JC.GT.NPO) GO TO 99
- CHP = POSS(JPOSS)(JC:JC)
- IF (CHP.EQ.'*') GO TO 41
- IF (CHP.EQ.' ') GO TO 31
- IF (JC.LE.NTX) GO TO 12
- GO TO 11
-
-C-- POSS blank terminated
-
- 31 IF (JC.GT.NTX) GO TO 99
- CHT = TEXT(JC:JC)
-C PRINT 9031, JC,CHT
-C9031 FORMAT('at col. JC',I3,' >',A,'<')
- IF (CHT.EQ.' ') GO TO 99
- GO TO 11
-
-C-- Check continuation after '*'
-
- 41 IF (JC.GT.NTX) GO TO 99
- CHT = TEXT(JC:JC)
- IF (CHT.EQ.' ') GO TO 99
- JC = JC + 1
- IF (JC.GT.NPO) GO TO 99
- CHP = POSS(JPOSS)(JC:JC)
-C PRINT 9044, CHT,CHP
-C9044 FORMAT ('@44 CHT/CHP= ',A,1X,A)
- IF (CHP.EQ.' ') GO TO 11
- IF (CHP.EQ.'*') GO TO 99
- IF (CHT.EQ.CHP) GO TO 41
- GO TO 11
-
- 98 JPOSS = 0
- 99 ICNTH = JPOSS
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/icnthl.F b/src/packlib/kernlib/kerngen/tcgen/icnthl.F
deleted file mode 100644
index 9a1268c..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/icnthl.F
+++ /dev/null
@@ -1,87 +0,0 @@
-*
-* $Id: icnthl.F,v 1.1.1.1 1996/02/15 17:49:46 mclareni Exp $
-*
-* $Log: icnthl.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:46 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- FUNCTION ICNTHL (TEXT,POSS,NPOSS)
-C
-C CERN PROGLIB# M432 ICNTHL .VERSION KERNFOR 4.36 930602
-C ORIG. 04/10/88, JZ
-C
-C- Match TEXT against lower case POSS(NPOSS), case insensitive
-
- CHARACTER*(*) TEXT,POSS(99)
- CHARACTER*1 CHP, CHT
-
-#include "kerngen/qnatch.inc"
-* Ignoring t=pass
-
- NTX = LEN(TEXT)
- NPO = LEN(POSS(1))
- JPOSS = 0
-
- 11 JPOSS = JPOSS + 1
- IF (JPOSS.GT.NPOSS) GO TO 98
- JC = 1
- CHP = POSS(JPOSS)(1:1)
- 12 CHT = TEXT(JC:JC)
- IF (CHT.NE.CHP) THEN
- IVT = ICHAR(CHT)
- IVP = ICHAR(CHP)
-#if defined(CERNLIB_QASCII)
- IF (IVP-IVT.NE.32) GO TO 11
- IF (IVT.LT.65) GO TO 11
- IF (IVT.GT.90) GO TO 11
-#endif
-#if defined(CERNLIB_QEBCDIC)
- IF (IVT-IVP.NE.64) GO TO 11
- IF (NATCH(IVT+1).NE.4) GO TO 11
-#endif
- ENDIF
- JC = JC + 1
- IF (JC.GT.NPO) GO TO 99
- CHP = POSS(JPOSS)(JC:JC)
- IF (CHP.EQ.'*') GO TO 41
- IF (CHP.EQ.' ') GO TO 31
- IF (JC.LE.NTX) GO TO 12
- GO TO 11
-
-C-- POSS blank terminated
-
- 31 IF (JC.GT.NTX) GO TO 99
- CHT = TEXT(JC:JC)
- IF (CHT.EQ.' ') GO TO 99
- GO TO 11
-
-C-- Check continuation after '*'
-
- 41 IF (JC.GT.NTX) GO TO 99
- CHT = TEXT(JC:JC)
- IF (CHT.EQ.' ') GO TO 99
- JC = JC + 1
- IF (JC.GT.NPO) GO TO 99
- CHP = POSS(JPOSS)(JC:JC)
- IF (CHP.EQ.' ') GO TO 11
- IF (CHP.EQ.'*') GO TO 99
- IF (CHT.EQ.CHP) GO TO 41
- IVT = ICHAR(CHT)
- IVP = ICHAR(CHP)
-#if defined(CERNLIB_QASCII)
- IF (IVP-IVT.NE.32) GO TO 11
- IF (IVT.LT.65) GO TO 11
- IF (IVT.GT.90) GO TO 11
-#endif
-#if defined(CERNLIB_QEBCDIC)
- IF (IVT-IVP.NE.64) GO TO 11
- IF (NATCH(IVT+1).NE.4) GO TO 11
-#endif
- GO TO 41
-
- 98 JPOSS = 0
- 99 ICNTHL = JPOSS
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/icnthu.F b/src/packlib/kernlib/kerngen/tcgen/icnthu.F
deleted file mode 100644
index f091d99..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/icnthu.F
+++ /dev/null
@@ -1,87 +0,0 @@
-*
-* $Id: icnthu.F,v 1.1.1.1 1996/02/15 17:49:46 mclareni Exp $
-*
-* $Log: icnthu.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:46 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- FUNCTION ICNTHU (TEXT,POSS,NPOSS)
-C
-C CERN PROGLIB# M432 ICNTHU .VERSION KERNFOR 4.36 930602
-C ORIG. 04/10/88, JZ
-C
-C- Match TEXT against upper case POSS(NPOSS), case insensitive
-
- CHARACTER*(*) TEXT,POSS(99)
- CHARACTER*1 CHP, CHT
-
-#include "kerngen/qnatch.inc"
-* Ignoring t=pass
-
- NTX = LEN(TEXT)
- NPO = LEN(POSS(1))
- JPOSS = 0
-
- 11 JPOSS = JPOSS + 1
- IF (JPOSS.GT.NPOSS) GO TO 98
- JC = 1
- CHP = POSS(JPOSS)(1:1)
- 12 CHT = TEXT(JC:JC)
- IF (CHT.NE.CHP) THEN
- IVT = ICHAR(CHT)
- IVP = ICHAR(CHP)
-#if defined(CERNLIB_QASCII)
- IF (IVT-IVP.NE.32) GO TO 11
- IF (IVT.LT.97) GO TO 11
- IF (IVT.GT.122) GO TO 11
-#endif
-#if defined(CERNLIB_QEBCDIC)
- IF (IVP-IVT.NE.64) GO TO 11
- IF (NATCH(IVT+1).NE.3) GO TO 11
-#endif
- ENDIF
- JC = JC + 1
- IF (JC.GT.NPO) GO TO 99
- CHP = POSS(JPOSS)(JC:JC)
- IF (CHP.EQ.'*') GO TO 41
- IF (CHP.EQ.' ') GO TO 31
- IF (JC.LE.NTX) GO TO 12
- GO TO 11
-
-C-- POSS blank terminated
-
- 31 IF (JC.GT.NTX) GO TO 99
- CHT = TEXT(JC:JC)
- IF (CHT.EQ.' ') GO TO 99
- GO TO 11
-
-C-- Check continuation after '*'
-
- 41 IF (JC.GT.NTX) GO TO 99
- CHT = TEXT(JC:JC)
- IF (CHT.EQ.' ') GO TO 99
- JC = JC + 1
- IF (JC.GT.NPO) GO TO 99
- CHP = POSS(JPOSS)(JC:JC)
- IF (CHP.EQ.' ') GO TO 11
- IF (CHP.EQ.'*') GO TO 99
- IF (CHT.EQ.CHP) GO TO 41
- IVT = ICHAR(CHT)
- IVP = ICHAR(CHP)
-#if defined(CERNLIB_QASCII)
- IF (IVT-IVP.NE.32) GO TO 11
- IF (IVT.LT.97) GO TO 11
- IF (IVT.GT.122) GO TO 11
-#endif
-#if defined(CERNLIB_QEBCDIC)
- IF (IVP-IVT.NE.64) GO TO 11
- IF (NATCH(IVT+1).NE.3) GO TO 11
-#endif
- GO TO 41
-
- 98 JPOSS = 0
- 99 ICNTHU = JPOSS
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/icnum.F b/src/packlib/kernlib/kerngen/tcgen/icnum.F
deleted file mode 100644
index ffad68e..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/icnum.F
+++ /dev/null
@@ -1,51 +0,0 @@
-*
-* $Id: icnum.F,v 1.1.1.1 1996/02/15 17:49:46 mclareni Exp $
-*
-* $Log: icnum.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:46 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- FUNCTION ICNUM (CHV,JLP,JRP)
-C
-C CERN PROGLIB# M432 ICNUM .VERSION KERNFOR 4.21 890323
-C ORIG. 04/10/88, JZ
-C
-C- Verify CHV(JL:JR) is numeric
-
- DIMENSION JLP(9), JRP(9)
-
- COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT, DUMMY(36)
- CHARACTER CHV*(*)
-
- JJ = JLP(1)
- JR = JRP(1)
-
- NGSLAT = 0
- ND = 0
-
- 12 IF (JJ.GT.JR) GO TO 99
-#if defined(CERNLIB_QASCII)
- K = ICHAR (CHV(JJ:JJ))
- IF (K.EQ.32) GO TO 19
- K = K - 48
- IF (K.LT.0) GO TO 91
- IF (K.GE.10) GO TO 91
-#endif
-#if defined(CERNLIB_QEBCDIC)
- K = ICHAR (CHV(JJ:JJ))
- IF (K.EQ.64) GO TO 19
- K = K - 240
- IF (K.LT.0) GO TO 91
- IF (K.GE.10) GO TO 91
-#endif
- ND = ND + 1
- 19 JJ = JJ + 1
- GO TO 12
-
- 91 NGSLAT = JJ
- 99 NDSLAT = ND
- ICNUM = JJ
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/icnuma.F b/src/packlib/kernlib/kerngen/tcgen/icnuma.F
deleted file mode 100644
index 827c5d6..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/icnuma.F
+++ /dev/null
@@ -1,70 +0,0 @@
-*
-* $Id: icnuma.F,v 1.1.1.1 1996/02/15 17:49:46 mclareni Exp $
-*
-* $Log: icnuma.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:46 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- FUNCTION ICNUMA (CHV,JLP,JRP)
-C
-C CERN PROGLIB# M432 ICNUMA .VERSION KERNFOR 4.21 890323
-C ORIG. 04/10/88, JZ
-C
-C- Verify CHV(JL:JR) is alpha-numeric
-
- DIMENSION JLP(9), JRP(9)
-
- COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT, DUMMY(36)
- CHARACTER CHV*(*), CHWK*1
-
-#include "kerngen/qnatch.inc"
-* Ignoring t=pass
-
- JJ = JLP(1)
- JR = JRP(1)
-
- NGSLAT = 0
- JPN = 0
- JPA = 0
- ND = 0
-
- 12 IF (JJ.GT.JR) GO TO 99
- CHWK = CHV(JJ:JJ)
- IF (CHWK.EQ.' ') GO TO 19
-#if defined(CERNLIB_QASCII)
- K = ICHAR (CHWK)
- IF (K.LT.48) GO TO 91
- IF (K.LT.58) THEN
- IF (JPN.EQ.0) JPN = JJ
- GO TO 18
- ENDIF
-
- IF (K.LT.65) GO TO 91
- IF (K.GE.91) THEN
- IF (K.LT.97) GO TO 91
- IF (K.GE.123) GO TO 91
- ENDIF
-#endif
-#if defined(CERNLIB_QEBCDIC)
- J = ICHAR (CHWK)
- K = NATCH(J+1)
- IF (K.LE.1) GO TO 91
- IF (K.EQ.2) THEN
- IF (JPN.EQ.0) JPN = JJ
- GO TO 18
- ENDIF
-#endif
- IF (JPA.EQ.0) JPA = JJ
- 18 ND = ND + 1
- 19 JJ = JJ + 1
- GO TO 12
-
- 91 NGSLAT = JJ
- 99 NDSLAT = ND
- NESLAT = JPN
- NFSLAT = JPA
- ICNUMA = JJ
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/icnumu.F b/src/packlib/kernlib/kerngen/tcgen/icnumu.F
deleted file mode 100644
index 14cbae2..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/icnumu.F
+++ /dev/null
@@ -1,71 +0,0 @@
-*
-* $Id: icnumu.F,v 1.1.1.1 1996/02/15 17:49:46 mclareni Exp $
-*
-* $Log: icnumu.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:46 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- FUNCTION ICNUMU (CHV,JLP,JRP)
-C
-C CERN PROGLIB# M432 ICNUMU .VERSION KERNFOR 4.40 940929
-C ORIG. 19/07/93, JZ
-C
-C- Verify CHV(JL:JR) is alpha-numeric or underscore
-
- DIMENSION JLP(9), JRP(9)
-
- COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT, DUMMY(36)
- CHARACTER CHV*(*), CHWK*1
-
-#include "kerngen/qnatch.inc"
-* Ignoring t=pass
-
- JJ = JLP(1)
- JR = JRP(1)
-
- NGSLAT = 0
- JPN = 0
- JPA = 0
- ND = 0
-
- 12 IF (JJ.GT.JR) GO TO 99
- CHWK = CHV(JJ:JJ)
- IF (CHWK.EQ.' ') GO TO 19
- IF (CHWK.EQ.'_') GO TO 17
-#if defined(CERNLIB_QASCII)
- K = ICHAR (CHWK)
- IF (K.LT.48) GO TO 91
- IF (K.LT.58) THEN
- IF (JPN.EQ.0) JPN = JJ
- GO TO 18
- ENDIF
-
- IF (K.LT.65) GO TO 91
- IF (K.GE.91) THEN
- IF (K.LT.97) GO TO 91
- IF (K.GE.123) GO TO 91
- ENDIF
-#endif
-#if defined(CERNLIB_QEBCDIC)
- J = ICHAR (CHWK)
- K = NATCH(J+1)
- IF (K.LE.1) GO TO 91
- IF (K.EQ.2) THEN
- IF (JPN.EQ.0) JPN = JJ
- GO TO 18
- ENDIF
-#endif
- 17 IF (JPA.EQ.0) JPA = JJ
- 18 ND = ND + 1
- 19 JJ = JJ + 1
- GO TO 12
-
- 91 NGSLAT = JJ
- 99 NDSLAT = ND
- NESLAT = JPN
- NFSLAT = JPA
- ICNUMU = JJ
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/icocti.F b/src/packlib/kernlib/kerngen/tcgen/icocti.F
deleted file mode 100644
index 8f327fa..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/icocti.F
+++ /dev/null
@@ -1,77 +0,0 @@
-*
-* $Id: icocti.F,v 1.1.1.1 1996/02/15 17:49:46 mclareni Exp $
-*
-* $Log: icocti.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:46 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- FUNCTION ICOCTI (CHV,JLP,JRP)
-C
-C CERN PROGLIB# M432 ICOCTI .VERSION KERNFOR 4.35 930308
-C ORIG. 03/06/92, JZ
-C
-C- Read octal integer from CHV(JL:JR)
-
- DIMENSION JLP(9), JRP(9)
-
- COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT, DUMMY(36)
- CHARACTER CHV*(*)
-
-#if !defined(CERNLIB_QISASTD)
-#include "kerngen/q_andor.inc"
-#include "kerngen/q_shift.inc"
-#endif
-
- JJ = JLP(1)
- JR = JRP(1)
-
- IVAL = 0
- NDG = 0
- NEG = 0
- NGSLAT = 0
-
- 12 IF (JJ.GT.JR) GO TO 99
- IF (CHV(JJ:JJ).EQ.' ') THEN
- JJ = JJ + 1
- GO TO 12
- ELSEIF (CHV(JJ:JJ).EQ.'+') THEN
- JJ = JJ + 1
- ELSEIF (CHV(JJ:JJ).EQ.'-') THEN
- NEG = 7
- JJ = JJ + 1
- ENDIF
-
- 21 IF (JJ.GT.JR) GO TO 99
-#if defined(CERNLIB_QASCII)
- K = ICHAR (CHV(JJ:JJ))
- K = K - 48
- IF (K.LT.0) GO TO 98
- IF (K.GE.8) GO TO 98
-#endif
-#if defined(CERNLIB_QEBCDIC)
- K = ICHAR (CHV(JJ:JJ))
- K = K - 240
- IF (K.LT.0) GO TO 98
- IF (K.GE.8) GO TO 98
-#endif
-#if !defined(CERNLIB_QISASTD)
- IVAL = IOR (ISHFTL(IVAL,3), K)
-#endif
-#if defined(CERNLIB_QISASTD)
- IVAL = IOR (ISHFT (IVAL,3), K)
-#endif
- NDG = NDG + 1
- JJ = JJ + 1
- GO TO 21
-
- 98 IF (CHV(JJ:JJ).NE.' ') NGSLAT = JJ
- 99 NDSLAT = NDG
- NESLAT = JJ
- IF (NEG.NE.0) THEN
- IF (IVAL.NE.0) IVAL = -IVAL
- ENDIF
- ICOCTI = IVAL
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/ictype.F b/src/packlib/kernlib/kerngen/tcgen/ictype.F
deleted file mode 100644
index 864e776..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/ictype.F
+++ /dev/null
@@ -1,48 +0,0 @@
-*
-* $Id: ictype.F,v 1.1.1.1 1996/02/15 17:49:46 mclareni Exp $
-*
-* $Log: ictype.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:46 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- FUNCTION ICTYPE (CHV)
-C
-C CERN PROGLIB# M432 ICTYPE .VERSION KERNFOR 4.23 891215
-C ORIG. 14/11/89, JZ
-C
-C- Return the type of character CHV*1 :
-C- Nature : 0 unseen, 1 others, 2 numeric, 3 lower, 4 upper case
-
- CHARACTER CHV*1
-#include "kerngen/qnatch.inc"
-* Ignoring t=pass
-
-#if defined(CERNLIB_QASCII)
- IVAL = ICHAR(CHV)
- JX = 0
- IF (IVAL.LT.32) GO TO 49
- IF (IVAL.GE.127) GO TO 49
- JX = 1
- IF (IVAL.LT.48) GO TO 49
- IF (IVAL.GE.123) GO TO 49
- IF (IVAL.LE.57) THEN
- JX = 2
- GO TO 49
- ENDIF
- IF (IVAL.LT.65) GO TO 49
- IF (IVAL.LE.90) THEN
- JX = 4
- GO TO 49
- ENDIF
- IF (IVAL.LT.97) GO TO 49
- JX = 3
-#endif
-#if defined(CERNLIB_QEBCDIC)
- IVAL = ICHAR(CHV)
- JX = NATCH(IVAL+1)
-#endif
- 49 ICTYPE = JX
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/ie3fod.F b/src/packlib/kernlib/kerngen/tcgen/ie3fod.F
deleted file mode 100644
index 4959020..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/ie3fod.F
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: ie3fod.F,v 1.1.1.1 1996/02/15 17:49:46 mclareni Exp $
-*
-* $Log: ie3fod.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:46 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QMIRTD)
-#include "irtdgs/ie3fod.F"
-#elif defined(CERNLIB_QMVAX)&&defined(CERNLIB_QMALPH)
-#include "vaxgs/ie3foda.F"
-#elif defined(CERNLIB_QMVAX)&&(!defined(CERNLIB_QMALPH))
-#include "vaxgs/ie3fodv.F"
-#else
- SUBROUTINE IE3FOD (MS,MT,NDPN,JBAD)
-C
-C CERN PROGLIB# M220 IE3FOD .VERSION KERNFOR 4.15 861204
-
-C- Convert double precision for output with copy
-C- from source in native to target in IEEE data format
-C- Dummy routine valid for machines with IEEE internal repr.
-
- DIMENSION MS(99), MT(99)
-
- CALL UCOPY (MS,MT,2*NDPN)
-
- JBAD = 0
- RETURN
- END
-#endif
diff --git a/src/packlib/kernlib/kerngen/tcgen/ie3tod.F b/src/packlib/kernlib/kerngen/tcgen/ie3tod.F
deleted file mode 100644
index 33decee..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/ie3tod.F
+++ /dev/null
@@ -1,30 +0,0 @@
-*
-* $Id: ie3tod.F,v 1.1.1.1 1996/02/15 17:49:46 mclareni Exp $
-*
-* $Log: ie3tod.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:46 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QMIRTD)
-#include "irtdgs/ie3tod.F"
-#elif defined(CERNLIB_QMVAX)
-#include "vaxgs/ie3tod.F"
-#else
- SUBROUTINE IE3TOD (MS,MT,NDPN,JBAD)
-C
-C CERN PROGLIB# M220 IE3TOD .VERSION KERNFOR 4.15 861204
-
-C- Convert double precision for input with copy
-C- from source in IEEE to target in native data format
-C- Dummy routine valid for machines with IEEE internal repr.
-
- DIMENSION MS(99), MT(99)
-
- CALL UCOPY (MS,MT,2*NDPN)
-
- JBAD = 0
- RETURN
- END
-#endif
diff --git a/src/packlib/kernlib/kerngen/tcgen/ifromc.F b/src/packlib/kernlib/kerngen/tcgen/ifromc.F
deleted file mode 100644
index a96643b..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/ifromc.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: ifromc.F,v 1.1.1.1 1996/02/15 17:49:47 mclareni Exp $
-*
-* $Log: ifromc.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:47 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- FUNCTION IFROMC(CH)
-C
-C CERN PROGLIB# M431 IFROMC .VERSION KERNFOR 4.13 860226
-C ORIG. 10/02/86 M.METCALF
-C
-C TO CONVERT 1 TO 4 CHARACTERS TO A PACKED ASCII INTEGER FORM
-C ANSI FORTRAN
-C
- CHARACTER*(*) CH
- PARAMETER (IBLANK = 32*(1+256*(1+256*(1+256))) )
- IFROMC = IBLANK
- LENCH = LEN(CH)
- DO 1 IC = 1, MIN(LENCH,4)
- CALL CHTOI(CH(IC:IC), IVAL, *999)
- IFROMC = ISHFT(IFROMC, 8) + IVAL
- 1 CONTINUE
- IF (LENCH.LT.4) IFROMC = ISHFTC(IFROMC, 8*(4-LENCH), 32)
- 999 RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/incbyt.F b/src/packlib/kernlib/kerngen/tcgen/incbyt.F
deleted file mode 100644
index 6b03c17..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/incbyt.F
+++ /dev/null
@@ -1,37 +0,0 @@
-*
-* $Id: incbyt.F,v 1.1.1.1 1996/02/15 17:49:47 mclareni Exp $
-*
-* $Log: incbyt.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:47 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QMSUN)
-#include "sungs/incbyt.F"
-#else
- FUNCTION INCBYT (INC,A,JTH,NBITS)
-C
-C CERN PROGLIB# M423 INCBYT .VERSION KERNFOR 4.07 830624
-C ORIG. 10/02/71 CL
-C
- DIMENSION A(99),NBITS(3)
- INTEGER A
-C
-#include "kerngen/q_jbit.inc"
-C
-C
- JWORD= (JTH-1)/NBITS(2) + 1
- JPOS = JTH - (JWORD-1)*NBITS(2)
- LOC = (JPOS-1)*NBITS(1) + 1
- ICT = INC + JBYT (A(JWORD),LOC,NBITS(1))
- IF (ICT .GT. NBITS(3)) GO TO 2
- CALL SBYT (ICT,A(JWORD),LOC,NBITS)
- INCBYT= 0
- RETURN
-C
- 2 CALL SBYT (NBITS(3),A(JWORD),LOC,NBITS(1))
- INCBYT= ICT - NBITS(3)
- RETURN
- END
-#endif
diff --git a/src/packlib/kernlib/kerngen/tcgen/intarg.F b/src/packlib/kernlib/kerngen/tcgen/intarg.F
deleted file mode 100644
index f78167f..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/intarg.F
+++ /dev/null
@@ -1,62 +0,0 @@
-*
-* $Id: intarg.F,v 1.1.1.1 1996/02/15 17:49:48 mclareni Exp $
-*
-* $Log: intarg.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:48 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QMSUN)
-#include "sungs/intarg.F"
-#elif defined(CERNLIB_QMVAX)
-#include "vaxgs/intarg.F"
-#else
- FUNCTION INTARG (ARGM)
-C
-C CERN PROGLIB# M250 INTARG .VERSION KERNFOR 4.23 891215
-C ORIG. 01/8/82 ADAPTED FROM UFLINT
-C
-C
- DIMENSION ARGM(9)
- EQUIVALENCE (A,IA)
-C
-#if defined(CERNLIB_QMCV64)
- PARAMETER (JEX=53, NEX=12, NEG=4095 )
-#endif
-#if defined(CERNLIB_QMCRY)
- PARAMETER (JEX=49, NEX=16, NEG=65535)
-#endif
-#if defined(CERNLIB_QMCDC)
- PARAMETER (JEX=49, NEX=12, NEG=4095 )
-#endif
-#if defined(CERNLIB_QMUNI)||defined(CERNLIB_QMUNO)
- PARAMETER (JEX=28, NEX= 9, NEG= 511 )
-#endif
-#if defined(CERNLIB_QMPDP)
- PARAMETER (JEX=28, NEX= 9, NEG= 511 )
-#endif
-#if defined(CERNLIB_QMDGE)||defined(CERNLIB_QMIBM)
- PARAMETER (JEX=25, NEX= 8, NEG= 255 )
-#endif
-#if (defined(CERNLIB_QIEEE))&&(defined(CERNLIB_B32))
- PARAMETER (JEX=24, NEX= 9, NEG= 511 )
-#endif
-#if defined(CERNLIB_QMND3)
- PARAMETER (JEX=23, NEX=10, NEG=1023 )
-#endif
-C
-#include "kerngen/q_jbit.inc"
-C
-C
- A = ARGM(1)
- JCH = JBYT (IA,JEX,NEX)
- IF (JCH.EQ.0) GO TO 36
- IF (JCH.EQ.NEG) GO TO 36
- INTARG = A
- RETURN
-C
- 36 INTARG = IA
- RETURN
- END
-#endif
diff --git a/src/packlib/kernlib/kerngen/tcgen/intsor.F b/src/packlib/kernlib/kerngen/tcgen/intsor.F
deleted file mode 100644
index 95eeba1..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/intsor.F
+++ /dev/null
@@ -1,69 +0,0 @@
-*
-* $Id: intsor.F,v 1.1.1.1 1996/02/15 17:49:48 mclareni Exp $
-*
-* $Log: intsor.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:48 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE INTSOR(A,N)
-C
-C CERN PROGLIB# M103 INTSOR .VERSION KERNFOR 3.15 820113
-C ORIG. 29/04/78
-C
-C SORT THE ONE-DIMENSIONAL INTEGER ARRAY A(1),...,A(N) BY
-C INCREASING VALUES
-C
-C- PROGRAM M103 TAKEN FROM CERN PROGRAM LIBRARY, 29-APR-78
-C
- INTEGER A(N),X,W
- COMMON /SLATE/ LT(20),RT(20)
- INTEGER R,RT
-C
- LEVEL=1
- LT(1)=1
- RT(1)=N
- 10 L=LT(LEVEL)
- R=RT(LEVEL)
- LEVEL=LEVEL-1
- 20 IF(R.GT.L) GO TO 200
- IF(LEVEL) 50,50,10
-C
-C SUBDIVIDE THE INTERVAL L,R
-C L : LOWER LIMIT OF THE INTERVAL (INPUT)
-C R : UPPER LIMIT OF THE INTERVAL (INPUT)
-C J : UPPER LIMIT OF LOWER SUB-INTERVAL (OUTPUT)
-C I : LOWER LIMIT OF UPPER SUB-INTERVAL (OUTPUT)
-C
- 200 I=L
- J=R
- M=(L+R)/2
- X=A(M)
- 220 IF(A(I).GE.X) GO TO 230
- I=I+1
- GO TO 220
- 230 IF(A(J).LE.X) GO TO 231
- J=J-1
- GO TO 230
-C
- 231 IF(I.GT.J) GO TO 232
- W=A(I)
- A(I)=A(J)
- A(J)=W
- I=I+1
- J=J-1
- IF(I.LE.J) GO TO 220
-C
- 232 LEVEL=LEVEL+1
- IF((R-I).GE.(J-L)) GO TO 30
- LT(LEVEL)=L
- RT(LEVEL)=J
- L=I
- GO TO 20
- 30 LT(LEVEL)=I
- RT(LEVEL)=R
- R=J
- GO TO 20
- 50 RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/irtdgs/ie3fod.F b/src/packlib/kernlib/kerngen/tcgen/irtdgs/ie3fod.F
deleted file mode 100644
index f6ba6b6..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/irtdgs/ie3fod.F
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: ie3fod.F,v 1.1.1.1 1996/02/15 17:49:57 mclareni Exp $
-*
-* $Log: ie3fod.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:57 mclareni
-* Kernlib
-*
-*
- at PROCESS AUTODBL(NONE)
- SUBROUTINE IE3FOD(VINT,VIEEE,NV,JCODE)
- INTEGER VINT(4*NV),VIEEE(4*NV)
- DO I=1,NV
- I1 = (I-1)*4 + 1
- I2 = (I-1)*4 + 2
- I3 = (I-1)*4 + 3
- VIEEE(I1) = VINT(I1)
- VIEEE(I3) = VINT(I2)
- ENDDO
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/irtdgs/ie3tod.F b/src/packlib/kernlib/kerngen/tcgen/irtdgs/ie3tod.F
deleted file mode 100644
index 06283ce..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/irtdgs/ie3tod.F
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: ie3tod.F,v 1.1.1.1 1996/02/15 17:49:57 mclareni Exp $
-*
-* $Log: ie3tod.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:57 mclareni
-* Kernlib
-*
-*
- at PROCESS AUTODBL(NONE)
- SUBROUTINE IE3TOD(VIEEE,VINT,NV,JCODE)
- INTEGER VIEEE(4*NV),VINT(4*NV)
- DO I=1,NV
- I1 = (I-1)*4 + 1
- I2 = (I-1)*4 + 2
- I3 = (I-1)*4 + 3
- VINT(I1) = VIEEE(I1)
- VINT(I2) = VIEEE(I3)
- ENDDO
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/irtgs/kerngt.F b/src/packlib/kernlib/kerngen/tcgen/irtgs/kerngt.F
deleted file mode 100644
index d627884..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/irtgs/kerngt.F
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: kerngt.F,v 1.1.1.1 1996/02/15 17:49:57 mclareni Exp $
-*
-* $Log: kerngt.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:57 mclareni
-* Kernlib
-*
-*
- SUBROUTINE KERNGT (LUN)
-C
-C CERN PROGLIB# Z001 KERNGT .VERSION KERNIRT 1.08 940531
-C ORIG. 12/12/83 JZ
-C
-C-- Store Pam title into /SLATE/ for printing by GSHOWF
-C
- COMMON /SLATE/ MCH(40)
- CHARACTER VIDQQ*(*)
- PARAMETER (VIDQQ = '@(#)' //
- + ' KERNIRT 1.08 940526 11.05 >')
-
- CALL CLEFT (VIDQQ,1,0)
- CALL UCTOH1 (
- + ' KERNIRT 1.08 940526 11.05 '
- +, MCH,40)
- CALL GSHOWF (LUN)
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/ishftc.F b/src/packlib/kernlib/kerngen/tcgen/ishftc.F
deleted file mode 100644
index 25d3992..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/ishftc.F
+++ /dev/null
@@ -1,40 +0,0 @@
-*
-* $Id: ishftc.F,v 1.1.1.1 1996/02/15 17:49:48 mclareni Exp $
-*
-* $Log: ishftc.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:48 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
-#if !defined(CERNLIB_QMILSTD)
- FUNCTION ISHFTC(I,K,L)
-C
-C CERN PROGLIB# M441 ISHFTC .VERSION KERNFOR 4.16 870601
-C ORIG. 01/10/85 T.LINDELOF
-C
-C FORTRAN VERSION OF MIL-STD-1753 ISHFTC FUNCTION
-C K IS THE SHIFT COUNT - NEGATIVE TO THE RIGHT
-C POSITIVE TO THE LEFT
-C L IS THE NUMBER OF THE RIGHTMOST BITS TO BE SHIFTED, ALL
-C OTHER BITS ARE LEFT UNCHANGED
-C
-#include "kerngen/wordsize.inc"
-#include "kerngen/iall1s.inc"
-
-#include "kerngen/q_andor.inc"
-* Ignoring t=pass
-C
- IF (K.GT.0) THEN
- ISHFTC = IOR(IAND(ISHFT(IALL11, L), I),
- + IOR(ISHFT(ISHFT(I, NBITPW-L), K-NBITPW),
- + ISHFT(ISHFT(I, NBITPW-L+K), L-NBITPW)))
- ELSEIF (K.LT.0) THEN
- ISHFTC = IOR(IAND(ISHFT(IALL11, L), I),
- + IOR(ISHFT(ISHFT(I, NBITPW-L), L+K-NBITPW),
- + ISHFT(ISHFT(I, NBITPW+K), L-NBITPW) ))
- ELSE
- ISHFTC = I
- ENDIF
- END
-#endif
diff --git a/src/packlib/kernlib/kerngen/tcgen/itoch.F b/src/packlib/kernlib/kerngen/tcgen/itoch.F
deleted file mode 100644
index cf30cb0..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/itoch.F
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: itoch.F,v 1.1.1.1 1996/02/15 17:49:42 mclareni Exp $
-*
-* $Log: itoch.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:42 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QASCII)
- SUBROUTINE ITOCH (I,CH,*)
-C
-C CERN PROGLIB# M400 CHTOI .VERSION KERNFOR 4.23 891215
-C ORIG. 29/05/84 H.RENSHALL
-C MOD. 06/11/89 JZ for UNIX & for speed
-C
-C ITOCH - convert ASCII integer to character CH*1
-C error exit if 'unseen', setting '?'
-C
- CHARACTER CH
-C
- IF (I.GE.32) THEN
- IF (I.LE.126) THEN
- CH = CHAR (I)
- RETURN
- ENDIF
- ENDIF
-C
- CH = '?'
- RETURN 1
- END
-#endif
diff --git a/src/packlib/kernlib/kerngen/tcgen/iuback.F b/src/packlib/kernlib/kerngen/tcgen/iuback.F
deleted file mode 100644
index 725b098..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/iuback.F
+++ /dev/null
@@ -1,37 +0,0 @@
-*
-* $Id: iuback.F,v 1.1.1.1 1996/02/15 17:49:48 mclareni Exp $
-*
-* $Log: iuback.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:48 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- FUNCTION IUBACK (IC,JL,JR)
-C
-C CERN PROGLIB# M410 IUBACK .VERSION KERNFOR 4.08 840613
-C ORIG. 27/05/67
-C
- COMMON /SLATE/ ND,JEND, DUMMY(38)
- DIMENSION IC(80),NUM(11)
- DATA NUM /4H ,4H0 ,4H1 ,4H2 ,4H3 ,4H4 ,4H5 ,
- + 4H6 ,4H7 ,4H8 ,4H9 /
-C
-C
- ND = 0
- JEND= JR
- IVAL= 0
- IPOW= 1
-C
- 12 IF (JEND.LT.JL) GO TO 20
- K= IUCOMP (IC(JEND),NUM,11) - 1
- IF (K) 20,19,14
- 14 IVAL= (K-1)*IPOW + IVAL
- IPOW= 10*IPOW
- ND= ND + 1
- 19 JEND= JEND - 1
- GO TO 12
-C
- 20 IUBACK= IVAL
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/iubin.F b/src/packlib/kernlib/kerngen/tcgen/iubin.F
deleted file mode 100644
index 9594a56..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/iubin.F
+++ /dev/null
@@ -1,44 +0,0 @@
-*
-* $Id: iubin.F,v 1.1.1.1 1996/02/15 17:49:48 mclareni Exp $
-*
-* $Log: iubin.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:48 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- FUNCTION IUBIN (X,PAR,SPILL)
-C
-C CERN PROGLIB# Y202 IUBIN .VERSION KERNFOR 3.15 820113
-C ORIG. 01/01/69 JZ
-C
- DIMENSION PAR(3)
- EQUIVALENCE (NX,A)
- LOGICAL SPILL
-C
-C
- A = PAR(1)
- SPILL=.FALSE.
-#if defined(CERNLIB_B36M)
- AN = (X-PAR(3))/PAR(2) + 1.000001
-#endif
-#if !defined(CERNLIB_B36M)
- AN = (X-PAR(3))/PAR(2) + 1.00001
-#endif
- IF (AN.LT.1.) GO TO 20
- IF (AN.GE.FLOAT(NX+1)) GO TO 18
- N=AN
- IF (N.LT.0) GO TO 18
- IUBIN= N
- RETURN
-C
-C-- OVERFLOW
- 18 SPILL= .TRUE.
- IUBIN=NX+1
- RETURN
-C
-C-- UNDERFLOW
- 20 SPILL=.TRUE.
- IUBIN=0
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/iuchan.F b/src/packlib/kernlib/kerngen/tcgen/iuchan.F
deleted file mode 100644
index e1af600..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/iuchan.F
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: iuchan.F,v 1.1.1.1 1996/02/15 17:49:48 mclareni Exp $
-*
-* $Log: iuchan.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:48 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- FUNCTION IUCHAN (X,XL,DX,NX)
-C
-C CERN PROGLIB# Y201 IUCHAN .VERSION KERNFOR 3.15 820113
-C ORIG. 01/01/66 JZ
-C
-#if defined(CERNLIB_B36M)
- AN= (X-XL)/DX + 1.000001
-#endif
-#if !defined(CERNLIB_B36M)
- AN= (X-XL)/DX + 1.00001
-#endif
- AN= MAX(AN,0.)
- AN= MIN(AN, FLOAT(NX+1))
- N=AN
- IF (N.LT.0) N=NX+1
- IUCHAN=N
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/iucola.F b/src/packlib/kernlib/kerngen/tcgen/iucola.F
deleted file mode 100644
index 93e292a..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/iucola.F
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: iucola.F,v 1.1.1.1 1996/02/15 17:49:48 mclareni Exp $
-*
-* $Log: iucola.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:48 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- FUNCTION IUCOLA (ITEXT,IVECT,N)
-C
-C CERN PROGLIB# V304 IUCOLA .VERSION KERNFOR 4.18 880425
-C ORIG. 25/04/88 JZ
-C
- DIMENSION IVECT(9)
-C
- IF (N.EQ.0) GO TO 18
- DO 12 JF=N,1,-1
- IF (ITEXT.EQ.IVECT(JF)) GO TO 24
- 12 CONTINUE
- 18 JF = 0
-C
- 24 IUCOLA = JF
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/iuend.F b/src/packlib/kernlib/kerngen/tcgen/iuend.F
deleted file mode 100644
index bebb6a4..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/iuend.F
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: iuend.F,v 1.1.1.1 1996/02/15 17:49:48 mclareni Exp $
-*
-* $Log: iuend.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:48 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- FUNCTION IUEND (NDA)
-C
-C CERN PROGLIB# M410 IUEND .VERSION KERNFOR 1.0 670527
-C ORIG. 27/05/67
-C
-C- RETURNS THE SEARCH-PARAMETERS IF IUFORW,IUBACK,ULEFT,URIGHT
-C
- COMMON /SLATE/ ND,JEND, DUMMY(38)
-C
- NDA = ND
- IUEND= JEND
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/iufila.F b/src/packlib/kernlib/kerngen/tcgen/iufila.F
deleted file mode 100644
index d5b4eb7..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/iufila.F
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: iufila.F,v 1.1.1.1 1996/02/15 17:49:48 mclareni Exp $
-*
-* $Log: iufila.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:48 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- FUNCTION IUFILA (IT,ICH,JL,JR)
-C
-C CERN PROGLIB# V304 IUFILA .VERSION KERNFOR 4.18 880425
-C ORIG. 25/04/88 JZ
-C
- DIMENSION ICH(9)
-C
- DO 12 JF=JR,JL,-1
- IF (ICH(JF).EQ.IT) GO TO 24
- 12 CONTINUE
- JF = JR+1
-C
- 24 IUFILA = JF
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/iufnbl.F b/src/packlib/kernlib/kerngen/tcgen/iufnbl.F
deleted file mode 100644
index 9dac195..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/iufnbl.F
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: iufnbl.F,v 1.1.1.1 1996/02/15 17:49:48 mclareni Exp $
-*
-* $Log: iufnbl.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:48 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- FUNCTION IUFNBL (IV,JA,JE)
-C
-C CERN PROGLIB# M410 IUFNBL .VERSION KERNFOR 3.06 780915
-C ORIG. 15/09/78 JZ
-C
- DIMENSION IV(80)
- DATA IBLANK /4H /
-C
-C
- J = JA
- 12 IF (J.GT.JE) GO TO 19
- IF (IV(J).NE.IBLANK) GO TO 19
- J = J + 1
- GO TO 12
-C
- 19 IUFNBL = J
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/iuforw.F b/src/packlib/kernlib/kerngen/tcgen/iuforw.F
deleted file mode 100644
index 33a5bbe..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/iuforw.F
+++ /dev/null
@@ -1,58 +0,0 @@
-*
-* $Id: iuforw.F,v 1.1.1.1 1996/02/15 17:49:48 mclareni Exp $
-*
-* $Log: iuforw.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:48 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QMSUN)
-#include "sungs/iuforw.F"
-#else
- FUNCTION IUFORW (IC,JL,JR)
-C
-C CERN PROGLIB# M410 IUFORW .VERSION KERNFOR 4.23 891215
-C ORIG. 27/05/67
-C
- COMMON /SLATE/ ND,JEND, DUMMY(38)
- DIMENSION IC(80)
-#if !defined(CERNLIB_QASCII)||!defined(CERNLIB_QISASTD)||defined(CERNLIB_B36)||defined(CERNLIB_B48)||defined(CERNLIB_B60)
- DIMENSION NUM(11)
- DATA NUM /4H ,4H0 ,4H1 ,4H2 ,4H3 ,4H4 ,4H5 ,
- + 4H6 ,4H7 ,4H8 ,4H9 /
-#endif
-
- ND = 0
- JEND = JL
- IVAL = 0
-C
- 12 IF (JEND.GT.JR) GO TO 20
-#if !defined(CERNLIB_QASCII)||!defined(CERNLIB_QISASTD)||defined(CERNLIB_B36)||defined(CERNLIB_B48)||defined(CERNLIB_B60)
- K = IUCOMP (IC(JEND),NUM,11) - 2
- IF (K.EQ.-1) GO TO 19
-#endif
-#if (defined(CERNLIB_QASCII))&&(defined(CERNLIB_QISASTD))&&(defined(CERNLIB_QORTHOLL))&&(defined(CERNLIB_B64))
- K = ISHFT (IC(JEND),-56)
-#endif
-#if (defined(CERNLIB_QASCII))&&(defined(CERNLIB_QISASTD))&&(defined(CERNLIB_QORTHOLL))&&(defined(CERNLIB_B32))
- K = ISHFT (IC(JEND),-24)
-#endif
-#if (defined(CERNLIB_QASCII))&&(defined(CERNLIB_QISASTD))&&(!defined(CERNLIB_QORTHOLL))&&(defined(CERNLIB_B32)||defined(CERNLIB_B64))
- K = IAND (IC(JEND),255)
-#endif
-#if (defined(CERNLIB_QASCII))&&(defined(CERNLIB_QISASTD))&&(defined(CERNLIB_B32)||defined(CERNLIB_B64))
- IF (K.EQ.32) GO TO 19
- IF (K.GE.58) GO TO 20
- K = K - 48
-#endif
- IF (K.LT.0) GO TO 20
- IVAL = 10*IVAL + K
- ND = ND + 1
- 19 JEND = JEND + 1
- GO TO 12
-C
- 20 IUFORW = IVAL
- RETURN
- END
-#endif
diff --git a/src/packlib/kernlib/kerngen/tcgen/iuhist.F b/src/packlib/kernlib/kerngen/tcgen/iuhist.F
deleted file mode 100644
index d1735ed..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/iuhist.F
+++ /dev/null
@@ -1,44 +0,0 @@
-*
-* $Id: iuhist.F,v 1.1.1.1 1996/02/15 17:49:48 mclareni Exp $
-*
-* $Log: iuhist.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:48 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- FUNCTION IUHIST (X,PAR,SPILL)
-C
-C CERN PROGLIB# Y203 IUHIST .VERSION KERNFOR 3.15 820113
-C ORIG. 21/08/72 P.RASTL
-C
- DIMENSION PAR(3)
- EQUIVALENCE (NX,A)
- LOGICAL SPILL
-C
-C
- A = PAR(1)
- SPILL=.FALSE.
-#if defined(CERNLIB_B36M)
- AN = (X-PAR(3))*PAR(2) + 1.000001
-#endif
-#if !defined(CERNLIB_B36M)
- AN = (X-PAR(3))*PAR(2) + 1.00001
-#endif
- IF (AN.LT.1.) GO TO 20
- IF (AN.GE.FLOAT(NX+1)) GO TO 18
- N=AN
- IF (N.LT.0) GO TO 18
- IUHIST= N
- RETURN
-C
-C-- OVERFLOW
- 18 SPILL= .TRUE.
- IUHIST=NX+1
- RETURN
-C
-C-- UNDERFLOW
- 20 SPILL=.TRUE.
- IUHIST=0
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/iulast.F b/src/packlib/kernlib/kerngen/tcgen/iulast.F
deleted file mode 100644
index d8d933b..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/iulast.F
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: iulast.F,v 1.1.1.1 1996/02/15 17:49:49 mclareni Exp $
-*
-* $Log: iulast.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:49 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- FUNCTION IULAST (ITEXT,IC,N)
-C
-C CERN PROGLIB# V305 IULAST .VERSION KERNFOR 4.19 880728
-C ORIG. 01/08/69
-C
- DIMENSION IC(80)
-C
- J = N
- IF (J.EQ.0) GO TO 20
-C
- DO 17 J=N,1,-1
- IF (IC(J).NE.ITEXT) GO TO 20
- 17 CONTINUE
- J = 0
-C
- 20 IULAST= J
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/iulook.F b/src/packlib/kernlib/kerngen/tcgen/iulook.F
deleted file mode 100644
index 5a974fb..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/iulook.F
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: iulook.F,v 1.1.1.1 1996/02/15 17:49:49 mclareni Exp $
-*
-* $Log: iulook.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:49 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- FUNCTION IULOOK(NCHAR,IC,JL,JR)
-C
-C CERN PROGLIB# M410 IULOOK .VERSION KERNFOR 3.13 810128
-C ORIG. 27/05/67
-C
- COMMON /SLATE/ MMM,IBUF(39)
-C
- DIMENSION IC(80)
- DATA IBLANK / 4H /
-C
-C
- IBUF(1)=IBLANK
- I=0
- DO 24 J=JL,JR
- IF (IC(J).EQ.IBLANK) GO TO 24
- IF(I.GE.NCHAR) GO TO 29
- I=I+1
- IBUF(I)= IC(J)
- 24 CONTINUE
-C
- 29 IF (I.EQ.0) I=1
- CALL UBUNCH (IBUF,MMM,I)
- IULOOK = MMM
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/iumode.F b/src/packlib/kernlib/kerngen/tcgen/iumode.F
deleted file mode 100644
index 26cedd6..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/iumode.F
+++ /dev/null
@@ -1,57 +0,0 @@
-*
-* $Id: iumode.F,v 1.1.1.1 1996/02/15 17:49:49 mclareni Exp $
-*
-* $Log: iumode.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:49 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QMSUN)
-#include "sungs/iumode.F"
-#elif defined(CERNLIB_QMVAX)
-#include "vaxgs/iumode.F"
-#else
- FUNCTION IUMODE (WORD)
-C
-C CERN PROGLIB# M506 IUMODE .VERSION KERNFOR 4.23 891215
-C ORIG. 14/04/79 JZ
-C
-C RETURN ZERO IF WORD CONTAINS AN INTEGER
-C PROGRAM WRITTEN 27-APR-79, JZ
-C
- INTEGER WORD
-C
-#if defined(CERNLIB_QMCV64)
- PARAMETER (JEX=53, NEX=12, NEG=4095 )
-#endif
-#if defined(CERNLIB_QMCRY)
- PARAMETER (JEX=49, NEX=16, NEG=65535)
-#endif
-#if defined(CERNLIB_QMCDC)
- PARAMETER (JEX=49, NEX=12, NEG=4095 )
-#endif
-#if defined(CERNLIB_QMUNI)||defined(CERNLIB_QMUNO)
- PARAMETER (JEX=28, NEX= 9, NEG= 511 )
-#endif
-#if defined(CERNLIB_QMPDP)
- PARAMETER (JEX=28, NEX= 9, NEG= 511 )
-#endif
-#if defined(CERNLIB_QMDGE)||defined(CERNLIB_QMIBM)
- PARAMETER (JEX=25, NEX= 8, NEG= 255 )
-#endif
-#if (defined(CERNLIB_QIEEE))&&(defined(CERNLIB_B32))
- PARAMETER (JEX=24, NEX= 9, NEG= 511 )
-#endif
-#if defined(CERNLIB_QMND3)
- PARAMETER (JEX=23, NEX=10, NEG=1023 )
-#endif
-C
-#include "kerngen/q_jbit.inc"
-C
- J = JBYT (WORD,JEX,NEX)
- IF (J.EQ.NEG) J=0
- IUMODE= J
- RETURN
- END
-#endif
diff --git a/src/packlib/kernlib/kerngen/tcgen/iunext.F b/src/packlib/kernlib/kerngen/tcgen/iunext.F
deleted file mode 100644
index ef6d4d0..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/iunext.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: iunext.F,v 1.1.1.1 1996/02/15 17:49:49 mclareni Exp $
-*
-* $Log: iunext.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:49 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- FUNCTION IUNEXT (IVEC,N)
-C
-C CERN PROGLIB# M410 IUNEXT .VERSION KERNFOR 4.08 840613
-C ORIG. 27/05/67
-C
- DIMENSION IVEC(80)
- DATA IBLANK /4H /
-C
-C
- J= N
- 10 IF (IVEC(J).NE.IBLANK) GO TO 12
- J= J + 1
- GO TO 10
-C
- 12 IUNEXT= J
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/iuweed.F b/src/packlib/kernlib/kerngen/tcgen/iuweed.F
deleted file mode 100644
index 441d52d..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/iuweed.F
+++ /dev/null
@@ -1,43 +0,0 @@
-*
-* $Id: iuweed.F,v 1.1.1.1 1996/02/15 17:49:49 mclareni Exp $
-*
-* $Log: iuweed.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:49 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QIEEE)
- FUNCTION IUWEED (IA,N)
-C
-C CERN PROGLIB# N103 IUWEED .VERSION KERNFOR 4.31 911111
-C ORIG. 16/10/91 JZ
-C- Find position of first number which is infinity or not-a-number
-C- in the N word vector IA, return zero if none
-C- --- this version only for machines with IEEE representation ---
- DIMENSION IA(*)
-#if defined(CERNLIB_B32)
- PARAMETER (NMANT=23, IVBAD=255)
-#endif
-#if defined(CERNLIB_B64)
- PARAMETER (NMANT=52, IVBAD=2047)
-#endif
-#if !defined(CERNLIB_QISASTD)
-#include "kerngen/q_andor.inc"
-#include "kerngen/q_shift.inc"
-#endif
-
- DO 24 J=1,N
-#if !defined(CERNLIB_QISASTD)
- IVAL = IAND (ISHFTR(IA(J),NMANT), IVBAD)
-#endif
-#if defined(CERNLIB_QISASTD)
- IVAL = IAND (ISHFT(IA(J),-NMANT), IVBAD)
-#endif
- IF (IVAL.EQ.IVBAD) GO TO 29
- 24 CONTINUE
- J = 0
- 29 IUWEED = J
- RETURN
- END
-#endif
diff --git a/src/packlib/kernlib/kerngen/tcgen/kerngt.F b/src/packlib/kernlib/kerngen/tcgen/kerngt.F
deleted file mode 100644
index fb7ca74..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/kerngt.F
+++ /dev/null
@@ -1,53 +0,0 @@
-*
-* $Id: kerngt.F,v 1.3 2006/09/15 09:35:20 mclareni Exp $
-*
-* $Log: kerngt.F,v $
-* Revision 1.3 2006/09/15 09:35:20 mclareni
-* Submitted mods for gcc4/gfortran and MacOSX, corrected to work also on slc4 with gcc3.4 and 4.1
-*
-* Revision 1.2 1997/02/04 17:36:16 mclareni
-* Merge Winnt and 97a versions
-*
-* Revision 1.1.1.1.2.1 1997/01/21 11:31:21 mclareni
-* All mods for Winnt 96a on winnt branch
-*
-* Revision 1.1.1.1 1996/02/15 17:49:40 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_WINNT)
-#include "wntgs/kerngt.F"
-#elif defined(CERNLIB_QMHPX)
-#include "hpxgs/kerngt.F"
-#elif defined(CERNLIB_QMIRT)||defined(CERNLIB_QMIRTD)
-#include "irtgs/kerngt.F"
-#elif defined(CERNLIB_QMLNX) && !defined(CERNLIB_GFORTRAN)
-#include "lnxgs/kerngt.F"
-#elif defined(CERNLIB_QMSGI)
-#include "sgigs/kerngt.F"
-#elif defined(CERNLIB_QMSUN)
-#include "sungs/kerngt.F"
-#elif defined(CERNLIB_QMVMI)||defined(CERNLIB_QMVAO)
-#include "allgs/kerngt.F"
-#elif defined(CERNLIB_QMVAX)
-#include "vaxgs/kerngt.F"
-#elif defined(CERNLIB_QMDOS)
-#include "dosgs/kerngt.F"
-#elif defined(CERNLIB_QMMPW)
-#include "mpwgs/kerngt.F"
-#elif defined(CERNLIB_QMOS9)
-#include "os9gs/kerngt.F"
-#else
- SUBROUTINE KERNGT (LUN)
-C
-C CERN PROGLIB# Z001 KERNGT .VERSION KERNFOR 4.29 910718
-C ORIG. 18/12/78
-C
- COMMON /SLATE/ ICH(32),DUM(8)
-
- CALL VBLANK (ICH,40)
- CALL GSHOWF (LUN)
- RETURN
- END
-#endif
diff --git a/src/packlib/kernlib/kerngen/tcgen/lenocc.F b/src/packlib/kernlib/kerngen/tcgen/lenocc.F
deleted file mode 100644
index 3219e94..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/lenocc.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: lenocc.F,v 1.1.1.1 1996/02/15 17:49:49 mclareni Exp $
-*
-* $Log: lenocc.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:49 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- FUNCTION LENOCC (CHV)
-C
-C CERN PROGLIB# M507 LENOCC .VERSION KERNFOR 4.21 890323
-C ORIG. March 85, A.Petrilli, re-write 21/02/89, JZ
-C
-C- Find last non-blank character in CHV
-
- CHARACTER CHV*(*)
-
- N = LEN(CHV)
-
- DO 17 JJ= N,1,-1
- IF (CHV(JJ:JJ).NE.' ') GO TO 99
- 17 CONTINUE
- JJ = 0
-
- 99 LENOCC = JJ
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/lnxgs/ibits.F b/src/packlib/kernlib/kerngen/tcgen/lnxgs/ibits.F
deleted file mode 100644
index 2c561c2..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/lnxgs/ibits.F
+++ /dev/null
@@ -1,14 +0,0 @@
-*
-* $Id: ibits.F,v 1.1.1.1 1996/02/15 17:49:58 mclareni Exp $
-*
-* $Log: ibits.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:58 mclareni
-* Kernlib
-*
-*
- FUNCTION IBITS (IZW,IZP,NZB)
-*
- IBITS=ISHFTR(LSHIFT(IZW,32-IZP-NZB),32-NZB)
-*
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/lnxgs/kerngt.F b/src/packlib/kernlib/kerngen/tcgen/lnxgs/kerngt.F
deleted file mode 100644
index d43bbd9..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/lnxgs/kerngt.F
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: kerngt.F,v 1.1.1.1 1996/02/15 17:49:58 mclareni Exp $
-*
-* $Log: kerngt.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:58 mclareni
-* Kernlib
-*
-*
- SUBROUTINE KERNGT (LUN)
-C
-C CERN PROGLIB# Z001 KERNGT .VERSION KERNLNX 1.00 930829
-C ORIG. 16/03/89
-C
-C-- Store Pam title into /SLATE/ for printing by GSHOWF
-
- COMMON /SLATE/ MCH(40)
-
-
- CALL UCTOH1 (
- + 'KERNLNX 1.03 1995/07/18 13.54 '
- +, MCH, 40)
- CALL GSHOWF (LUN)
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/lnxgs/utrans.F b/src/packlib/kernlib/kerngen/tcgen/lnxgs/utrans.F
deleted file mode 100644
index dfc7e54..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/lnxgs/utrans.F
+++ /dev/null
@@ -1,80 +0,0 @@
-*
-* $Id: utrans.F,v 1.1.1.1 1996/02/15 17:49:58 mclareni Exp $
-*
-* $Log: utrans.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:58 mclareni
-* Kernlib
-*
-*
- SUBROUTINE UTRANS (AI,AJ,NCH,IP,JP)
-C
-C CERN PROGLIB# M409 UTRANS .VERSION KERNLNX 1.00 930507
-C ORIG. 15/09/78 JZ
-C
- COMMON /SLATE/ NI, NJ, MM(38)
-C
- INTEGER AI(9), AJ(9), NCH(9), IP(9), JP(9)
-C
- PARAMETER (NCHAPW=4)
-C
- NI = 0
- NJ = 0
- NCHL = NCH(1)
- IF (NCHL.LE.0) RETURN
- NCHI = MIN (IP(1), NCHAPW)
- NCHJ = MIN (JP(1), NCHAPW)
- IF (NCHI-NCHJ) 31,41,21
-C
-C---- DISPERSION TO A1
-C
- 21 IF (NCHJ.NE.1) GO TO 41
-C
- 24 N = MIN (NCHL, NCHI)
- NI = NI + 1
- CALL UBLOW (AI(NI),AJ(NJ+1),N)
- NJ = NJ + N
- NCHL = NCHL - N
- IF (NCHL.NE.0) GO TO 24
- RETURN
-C
-C---- CONCENTRATION FROM A1
-C
- 31 IF (NCHI.NE.1) GO TO 41
-C
- 34 N = MIN (NCHL, NCHJ)
- NJ = NJ + 1
- CALL UBUNCH (AI(NI+1),AJ(NJ),N)
- NI = NI + N
- NCHL = NCHL - N
- IF (NCHL.NE.0) GO TO 34
- RETURN
-C
-C---- TRANSFORMATION AI TO AJ
-C
- 41 JA = 0
- JE = 0
- 42 N = MIN (NCHL, NCHJ)
- IF (JA+N.LE.JE) GO TO 47
- IF (JA.NE.JE) GO TO 43
- JA = 1
- JE = 1
- GO TO 44
-C
- 43 IF (JE+NCHI.LT.40) GO TO 44
- NT = JE - JA
- CALL UCOPY (MM(JA),MM(1),NT)
- JA = 1
- JE = NT + 1
-C
- 44 NI = NI + 1
- CALL UBLOW (AI(NI),MM(JE),NCHI)
- JE = JE + NCHI
- IF (JA+N.GT.JE) GO TO 43
-C
- 47 NJ = NJ + 1
- CALL UBUNCH (MM(JA),AJ(NJ),N)
- JA = JA + N
- NCHL = NCHL - N
- IF (NCHL.NE.0) GO TO 42
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/locbyt.F b/src/packlib/kernlib/kerngen/tcgen/locbyt.F
deleted file mode 100644
index d3cf46a..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/locbyt.F
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: locbyt.F,v 1.1.1.1 1996/02/15 17:49:49 mclareni Exp $
-*
-* $Log: locbyt.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:49 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QMSUN)
-#include "sungs/locbyt.F"
-#else
- FUNCTION LOCBYT (IT,IA,N,NW,LA,NBITS)
-C
-C CERN PROGLIB# M428 LOCBYT .VERSION KERNFOR 4.07 830624
-C ORIG. 03/05/72
-C
- DIMENSION IA(9)
-C
-#include "kerngen/q_jbit.inc"
-* Ignoring t=pass
-C
- IF (N.EQ.0) GO TO 19
- DO 18 J=1,N,NW
- IF (JBYT(IA(J),LA,NBITS).EQ.IT) GO TO 21
- 18 CONTINUE
- 19 LOCBYT= 0
- RETURN
-C
- 21 LOCBYT= J
- RETURN
- END
-#endif
diff --git a/src/packlib/kernlib/kerngen/tcgen/loren4.F b/src/packlib/kernlib/kerngen/tcgen/loren4.F
deleted file mode 100644
index 4d7c5c0..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/loren4.F
+++ /dev/null
@@ -1,38 +0,0 @@
-*
-* $Id: loren4.F,v 1.1.1.1 1996/02/15 17:49:49 mclareni Exp $
-*
-* $Log: loren4.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:49 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE LOREN4 (DIR,P4IN,P4OUT)
-C
-C CERN PROGLIB# U101 LOREN4 .VERSION KERNFOR 4.07 830624
-C ORIG. 20/02/68
-C
-#if !defined(CERNLIB_B48M)
- DOUBLE PRECISION PCM2, ONMCM, EPBETA, PROD
-#endif
- DIMENSION DIR(4),P4IN(4),P4OUT(4)
-C
-C-- VN(A) MEANS N-VECTOR A
-C-- GAMMA=ECM/MCM
-C-- EPBETA=ECM*V3(PCM)*V3(BETA)
-C-- V3(BETA)=V3(PCM)/ECM
-C
- PCM2=DIR(1)*DIR(1)+DIR(2)*DIR(2)+DIR(3)*DIR(3)
-#if defined(CERNLIB_B48M)
- ONMCM=1.D0/ SQRT (DIR(4)*DIR(4)-PCM2)
-#endif
-#if !defined(CERNLIB_B48M)
- ONMCM=1.D0/DSQRT (DIR(4)*DIR(4)-PCM2)
-#endif
- EPBETA=P4IN(1)*DIR(1)+P4IN(2)*DIR(2)+P4IN(3)*DIR(3)
- PROD=EPBETA*(DIR(4)*ONMCM-1.D0)/PCM2-P4IN(4)*ONMCM
- P4OUT(4)=ONMCM*(P4IN(4)*DIR(4)-EPBETA)
- DO 50 I=1,3
- 50 P4OUT(I)=P4IN(I)+DIR(I)*PROD
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/lorenb.F b/src/packlib/kernlib/kerngen/tcgen/lorenb.F
deleted file mode 100644
index 4222ccc..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/lorenb.F
+++ /dev/null
@@ -1,38 +0,0 @@
-*
-* $Id: lorenb.F,v 1.1.1.1 1996/02/15 17:49:49 mclareni Exp $
-*
-* $Log: lorenb.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:49 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE LORENB (U,PS,PI,PF)
-C
-C CERN PROGLIB# U102 LORENB .VERSION KERNFOR 4.04 821124
-C ORIG. 20/08/75 L.PAPE
-C
-#if !defined(CERNLIB_B48M)
- DOUBLE PRECISION PF4, FN
-#endif
- DIMENSION PS(4),PI(4),PF(4)
-
- IF (PS(4).EQ.U) GO TO 17
- PF4 = (PI(4)*PS(4)+PI(3)*PS(3)+PI(2)*PS(2)+PI(1)*PS(1)) / U
- FN = (PF4+PI(4)) / (PS(4)+U)
- PF(1)= PI(1) + FN*PS(1)
- PF(2)= PI(2) + FN*PS(2)
- PF(3)= PI(3) + FN*PS(3)
- PF(4)= PF4
- GO TO 18
-C
- 17 PF(1)= PI(1)
- PF(2)= PI(2)
- PF(3)= PI(3)
- PF(4)= PI(4)
-C
- 18 CONTINUE
-C
- RETURN
-C
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/lorenf.F b/src/packlib/kernlib/kerngen/tcgen/lorenf.F
deleted file mode 100644
index 2b21812..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/lorenf.F
+++ /dev/null
@@ -1,38 +0,0 @@
-*
-* $Id: lorenf.F,v 1.1.1.1 1996/02/15 17:49:49 mclareni Exp $
-*
-* $Log: lorenf.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:49 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE LORENF (U,PS,PI,PF)
-C
-C CERN PROGLIB# U102 LORENF .VERSION KERNFOR 4.04 821124
-C ORIG. 20/08/75 L.PAPE
-C
-#if !defined(CERNLIB_B48M)
- DOUBLE PRECISION PF4, FN
-#endif
- DIMENSION PS(4),PI(4),PF(4)
-C
- IF (PS(4).EQ.U) GO TO 17
- PF4 = (PI(4)*PS(4)-PI(3)*PS(3)-PI(2)*PS(2)-PI(1)*PS(1)) / U
- FN = (PF4+PI(4)) / (PS(4)+U)
- PF(1)= PI(1) - FN*PS(1)
- PF(2)= PI(2) - FN*PS(2)
- PF(3)= PI(3) - FN*PS(3)
- PF(4)= PF4
- GO TO 18
-C
- 17 PF(1)= PI(1)
- PF(2)= PI(2)
- PF(3)= PI(3)
- PF(4)= PI(4)
-C
- 18 CONTINUE
-C
- RETURN
-C
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/lvsdmi.F b/src/packlib/kernlib/kerngen/tcgen/lvsdmi.F
deleted file mode 100644
index afb3ce2..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/lvsdmi.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: lvsdmi.F,v 1.1.1.1 1996/02/15 17:49:51 mclareni Exp $
-*
-* $Log: lvsdmi.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:51 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- FUNCTION LVSDMI (A,NDO,INC)
-C
-C CERN PROGLIB# F121 LVSDMI .VERSION KERNFOR 4.21 890323
-C ORIG. 01/03/89 FCA
-C
-C- Find Minimum in scattered vector, double precision
-
- DOUBLE PRECISION A(*), HMIN
-C
- HMIN = A(1)
- LMIN = 1
- DO 10 J = INC+1, (NDO-1)*INC+1, INC
- IF(HMIN.GT.A(J)) THEN
- HMIN = A(J)
- LMIN = J
- ENDIF
- 10 CONTINUE
- LVSDMI = LMIN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/lvsdmx.F b/src/packlib/kernlib/kerngen/tcgen/lvsdmx.F
deleted file mode 100644
index d902230..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/lvsdmx.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: lvsdmx.F,v 1.1.1.1 1996/02/15 17:49:51 mclareni Exp $
-*
-* $Log: lvsdmx.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:51 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- FUNCTION LVSDMX (A,NDO,INC)
-C
-C CERN PROGLIB# F121 LVSDMX .VERSION KERNFOR 4.21 890323
-C ORIG. 01/03/89 FCA
-C
-C- Find Maximum in scattered vector, double precision
-
- DOUBLE PRECISION A(*), HMAX
-C
- HMAX = A(1)
- LMAX = 1
- DO 10 J = INC+1, (NDO-1)*INC+1, INC
- IF(HMAX.LT.A(J)) THEN
- HMAX = A(J)
- LMAX = J
- ENDIF
- 10 CONTINUE
- LVSDMX = LMAX
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/lvsimi.F b/src/packlib/kernlib/kerngen/tcgen/lvsimi.F
deleted file mode 100644
index 0559e13..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/lvsimi.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: lvsimi.F,v 1.1.1.1 1996/02/15 17:49:51 mclareni Exp $
-*
-* $Log: lvsimi.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:51 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- FUNCTION LVSIMI (A,NDO,INC)
-C
-C CERN PROGLIB# F121 LVSIMI .VERSION KERNFOR 4.21 890323
-C ORIG. 01/03/89 FCA
-C
-C- Find Minimum in scattered vector, integer
-
- INTEGER A(*), HMIN
-C
- HMIN = A(1)
- LMIN = 1
- DO 10 J = INC+1, (NDO-1)*INC+1, INC
- IF(HMIN.GT.A(J)) THEN
- HMIN = A(J)
- LMIN = J
- ENDIF
- 10 CONTINUE
- LVSIMI = LMIN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/lvsimx.F b/src/packlib/kernlib/kerngen/tcgen/lvsimx.F
deleted file mode 100644
index c941718..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/lvsimx.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: lvsimx.F,v 1.1.1.1 1996/02/15 17:49:51 mclareni Exp $
-*
-* $Log: lvsimx.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:51 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- FUNCTION LVSIMX (A,NDO,INC)
-C
-C CERN PROGLIB# F121 LVSIMX .VERSION KERNFOR 4.21 890323
-C ORIG. 01/03/89 FCA
-C
-C- Find Maximum in scattered vector, integer
-
- INTEGER A(*), HMAX
-C
- HMAX = A(1)
- LMAX = 1
- DO 10 J = INC+1, (NDO-1)*INC+1, INC
- IF(HMAX.LT.A(J)) THEN
- HMAX = A(J)
- LMAX = J
- ENDIF
- 10 CONTINUE
- LVSIMX = LMAX
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/lvsmi.F b/src/packlib/kernlib/kerngen/tcgen/lvsmi.F
deleted file mode 100644
index 1e97cb1..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/lvsmi.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: lvsmi.F,v 1.1.1.1 1996/02/15 17:49:52 mclareni Exp $
-*
-* $Log: lvsmi.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:52 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- FUNCTION LVSMI (A,NDO,INC)
-C
-C CERN PROGLIB# F121 LVSMI .VERSION KERNFOR 4.21 890323
-C ORIG. 01/03/89 FCA
-C
-C- Find Minimum in scattered vector, single precision
-
- DIMENSION A(*)
-C
- HMIN = A(1)
- LMIN = 1
- DO 10 J = INC+1, (NDO-1)*INC+1, INC
- IF(HMIN.GT.A(J)) THEN
- HMIN = A(J)
- LMIN = J
- ENDIF
- 10 CONTINUE
- LVSMI = LMIN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/lvsmx.F b/src/packlib/kernlib/kerngen/tcgen/lvsmx.F
deleted file mode 100644
index 9ee27a1..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/lvsmx.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: lvsmx.F,v 1.1.1.1 1996/02/15 17:49:52 mclareni Exp $
-*
-* $Log: lvsmx.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:52 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- FUNCTION LVSMX (A,NDO,INC)
-C
-C CERN PROGLIB# F121 LVSMX .VERSION KERNFOR 4.21 890323
-C ORIG. 01/03/89 FCA
-C
-C- Find Maximum in scattered vector, single precision
-
- DIMENSION A(*)
-C
- HMAX = A(1)
- LMAX = 1
- DO 10 J = INC+1, (NDO-1)*INC+1, INC
- IF(HMAX.LT.A(J)) THEN
- HMAX = A(J)
- LMAX = J
- ENDIF
- 10 CONTINUE
- LVSMX = LMAX
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/matin1.F b/src/packlib/kernlib/kerngen/tcgen/matin1.F
deleted file mode 100644
index b6b724e..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/matin1.F
+++ /dev/null
@@ -1,107 +0,0 @@
-*
-* $Id: matin1.F,v 1.1.1.1 1996/02/15 17:49:52 mclareni Exp $
-*
-* $Log: matin1.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:52 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
-#if !defined(CERNLIB_TCGEN)
- SUBROUTINE MATIN1 (A,IDIM1,N1,IDIM2,N2,INDEX,NERROR,DETERM)
-C
-C CERN PROGLIB# F100 MATIN1 .VERSION KERNFOR 3.15 820113
-C ORIG. 03/05/72 H.V.EIKEN
-C
-C MATRIX INVERSION WITH ACCOMPANYING SOLUTION OF LINEAR EQUATIONS
- DIMENSION A(IDIM1),INDEX(IDIM1)
- DETER=1.0
- N=N1
- IEMAT=N+N2
- IDIM=IDIM1
- NMIN1=N-1
-C THE ROUTINE DOES ITS OWN EVALUATION FOR DOUBLE SUBSCRIPTING OF
-C ARRAY A.
- IPIVC=1-IDIM
-C MAIN LOOP TO INVERT THE MATRIX
- DO 11 MAIN=1,N
- PIVOT=0.0
- IPIVC=IPIVC+IDIM
-C SEARCH FOR NEXT PIVOT IN COLUMN MAIN.
- IPIVC1=IPIVC+MAIN-1
- IPIVC2=IPIVC +NMIN1
- DO 2 I=IPIVC1,IPIVC2
- IF(ABS(A(I))-ABS(PIVOT)) 2,2,1
- 1 PIVOT=A(I)
- LPIV=I
- 2 CONTINUE
-C IS PIVOT DIFFERENT FROM ZERO
- IF(PIVOT) 3,15,3
-C GET THE PIVOT-LINE INDICATOR AND SWAP LINES IF NECESSARY
- 3 ICOL=LPIV-IPIVC+1
- INDEX(MAIN)=ICOL
- IF(ICOL-MAIN) 6,6,4
-C COMPLEMENT THE DETERMINANT
- 4 DETER=-DETER
-C POINTER TO LINE PIVOT FOUND
- ICOL=ICOL-IDIM
-C POINTER TO EXACT PIVOT LINE
- I3=MAIN-IDIM
- DO 5 I=1,IEMAT
- ICOL=ICOL+IDIM
- I3=I3+IDIM
- SWAP=A(I3)
- A(I3)=A(ICOL)
- 5 A(ICOL)=SWAP
-C COMPUTE DETERMINANT
- 6 DETER=DETER*PIVOT
- PIVOT=1./PIVOT
-C TRANSFORM PIVOT COLUMN
- I3=IPIVC+NMIN1
- DO 7 I=IPIVC,I3
- 7 A(I)=-A(I)*PIVOT
- A(IPIVC1)=PIVOT
-C PIVOT ELEMENT TRANSFORMED
-C
-C NOW CONVERT REST OF THE MATRIX
- I1=MAIN-IDIM
-C POINTER TO PIVOT LINE ELEMENTS
- ICOL=1-IDIM
-C GENERAL COLUMN POINTER
- DO 10 I=1,IEMAT
- ICOL=ICOL+IDIM
- I1=I1+IDIM
-C POINTERS MOVED
- IF(I-MAIN) 8,10,8
-C PIVOT COLUMN EXCLUDED
- 8 JCOL=ICOL+NMIN1
- SWAP=A(I1)
- I3=IPIVC-1
- DO 9 I2=ICOL,JCOL
- I3=I3+1
- 9 A(I2)=A(I2)+SWAP*A(I3)
- A(I1)=SWAP*PIVOT
- 10 CONTINUE
- 11 CONTINUE
-C NOW REARRANGE THE MATRIX TO GET RIGHT INVERS
- DO 14 I1=1,N
- MAIN=N+1-I1
- LPIV=INDEX(MAIN)
- IF(LPIV-MAIN) 12,14,12
- 12 ICOL=(LPIV-1)*IDIM+1
- JCOL=ICOL+NMIN1
- IPIVC=(MAIN-1)*IDIM+1-ICOL
- DO 13 I2=ICOL,JCOL
- I3=I2+IPIVC
- SWAP=A(I2)
- A(I2)=A(I3)
- 13 A(I3)=SWAP
- 14 CONTINUE
- DETERM=DETER
- NERROR=0
- RETURN
- 15 NERROR=MAIN
- DETERM=DETER
- RETURN
- END
-#endif
diff --git a/src/packlib/kernlib/kerngen/tcgen/mpwgs/kerngt.F b/src/packlib/kernlib/kerngen/tcgen/mpwgs/kerngt.F
deleted file mode 100644
index 16ffc1d..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/mpwgs/kerngt.F
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: kerngt.F,v 1.1.1.1 1996/02/15 17:49:59 mclareni Exp $
-*
-* $Log: kerngt.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:59 mclareni
-* Kernlib
-*
-*
-!!S SEG_KERNGT
- SUBROUTINE KERNGT(LUN)
-C
-C CERN PROGLIB# Z001 KERNGT .VERSION KERNMPW 1.00 891208
-C ORIG. 12/12/83 JZ
-C
-C-- STORE PAM TITLE INTO /SLATE/ FOR PRINTING BY GSHOWF
-C
- COMMON /SLATE/ CH(40)
-C
- ENTRY GSHOW (LUN)
-C
- CALL UBLOW (
- + 40H KERNMPW 1.02 921009 00.35
- +, CH,40)
- CALL GSHOWF (LUN)
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/mvbits.F b/src/packlib/kernlib/kerngen/tcgen/mvbits.F
deleted file mode 100644
index 5db15de..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/mvbits.F
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: mvbits.F,v 1.1.1.1 1996/02/15 17:49:49 mclareni Exp $
-*
-* $Log: mvbits.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:49 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
-#if !defined(CERNLIB_QMILSTD)
- SUBROUTINE MVBITS(I,N,L,J,M)
-C
-C CERN PROGLIB# M441 MVBITS .VERSION KERNFOR 4.16 870601
-C ORIG. 01/10/85 T.LINDELOF
-C
-C FORTRAN VERSION OF MIL-STD-1753 SUBROUTINE MVBITS
-C N IS THE POSITION IN I FROM WHICH BITS ARE EXTRACTED
-C L IS THE NUMBER OF BITS TO BE EXTRACTED
-C M IS THE POSITION IN J INTO WHICH BITS ARE TO BE PLACED
-C
-#include "kerngen/wordsize.inc"
-#include "kerngen/iall1s.inc"
-
-#include "kerngen/q_andor.inc"
-* Ignoring t=pass
-C
- J = IOR(IAND(ISHFT(IALL11, L+M), J),
- + IOR(IAND(NOT(ISHFT(IALL11, M)), J),
- + ISHFT(ISHFT(ISHFT(I, NBITPW-L-N), L-NBITPW), M) ))
- END
-#endif
diff --git a/src/packlib/kernlib/kerngen/tcgen/mxequ.F b/src/packlib/kernlib/kerngen/tcgen/mxequ.F
deleted file mode 100644
index 2b2e623..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/mxequ.F
+++ /dev/null
@@ -1,89 +0,0 @@
-*
-* $Id: mxequ.F,v 1.1.1.1 1996/02/15 17:49:52 mclareni Exp $
-*
-* $Log: mxequ.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:52 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
-#if !defined(CERNLIB_TCGEN)
- SUBROUTINE MXEQU(A,B,I,J)
-C
-C CERN PROGLIB# F109 MXEQU .VERSION KERNFOR 1.0 680220
-C ORIG. 01/01/64 RKB ET AL
-C
- DIMENSION A(*),B(*)
-C
- IF (I.EQ.0) RETURN
-C
-C-- TRANSFORMATION OF A-MATRIX
- 10 LL=1
- DO 17 L=1,I
- DIAG=-1./A(LL)
- LM=L
-C
- DO 12 M=1,I
- IF (L.EQ.M) GO TO 12
- A(LM)=A(LM)*DIAG
- 12 LM=LM+I
-C
- LPLUS1=L+1
- IF (LPLUS1.GT.I) GO TO 20
- L1L=LL+1
-C
- DO 16 L1=LPLUS1,I
- L1M=L1
- LM=L
-C
- DO 15 M=1,I
- IF (L.EQ.M) GO TO 14
- A(L1M)=A(L1M)+A(L1L)*A(LM)
- 14 L1M=L1M+I
- 15 LM=LM+I
-C
- 16 L1L=L1L+1
-C
- 17 LL=LL+I+1
-C
-C
-#if defined(CERNLIB_ENTRCDC)
- ENTRY MXEQU1
-#endif
-#if !defined(CERNLIB_ENTRCDC)
- ENTRY MXEQU1 (A,B,I,J)
-#endif
-C
-C-- TRANSFORMATION OF B-MATRIX
- 20 IF (I*J.EQ.0) RETURN
-C
- ML=1
- DO 26 L=1,I
-C
- DO 26 M=1,J
- MN=M
- LN=L
-C
- DO 25 N=1,I
- IF (L.EQ.N) GO TO 24
- B(MN)=B(MN)+B(ML)*A(LN)
- 24 MN=MN+J
- 25 LN=LN+I
-C
- 26 ML=ML+1
-C
-C-- PUTS FINAL RESULT IN B-MATRIX
- NN=1
- MN=1
- DO 36 N=1,I
- DIAG=1./A(NN)
-C
- DO 35 M=1,J
- B(MN)=B(MN)*DIAG
- 35 MN=MN+1
-C
- 36 NN=NN+I+1
-C
- RETURN
- END
-#endif
diff --git a/src/packlib/kernlib/kerngen/tcgen/mxmad.F b/src/packlib/kernlib/kerngen/tcgen/mxmad.F
deleted file mode 100644
index 53b1814..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/mxmad.F
+++ /dev/null
@@ -1,165 +0,0 @@
-*
-* $Id: mxmad.F,v 1.1.1.1 1996/02/15 17:49:52 mclareni Exp $
-*
-* $Log: mxmad.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:52 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE MXMAD(A,B,C,I,J,K)
-C
-C CERN PROGLIB# F110 MXMAD .VERSION KERNFOR 1.0 650809
-C ORIG. 01/01/64 RKB
-C
- DIMENSION A(*),B(*),C(*)
-C
- IANDJ=21
- GO TO 1
-C
-#if defined(CERNLIB_ENTRCDC)
- ENTRY MXMAD1
-#endif
-#if !defined(CERNLIB_ENTRCDC)
- ENTRY MXMAD1 (A,B,C,I,J,K)
-#endif
-C
- IANDJ=22
- GO TO 1
-C
-#if defined(CERNLIB_ENTRCDC)
- ENTRY MXMAD2
-#endif
-#if !defined(CERNLIB_ENTRCDC)
- ENTRY MXMAD2 (A,B,C,I,J,K)
-#endif
-C
- IANDJ=23
- GO TO 1
-C
-#if defined(CERNLIB_ENTRCDC)
- ENTRY MXMAD3
-#endif
-#if !defined(CERNLIB_ENTRCDC)
- ENTRY MXMAD3 (A,B,C,I,J,K)
-#endif
-C
- IANDJ=24
- GO TO 1
-C
-#if defined(CERNLIB_ENTRCDC)
- ENTRY MXMPY
-#endif
-#if !defined(CERNLIB_ENTRCDC)
- ENTRY MXMPY (A,B,C,I,J,K)
-#endif
-C
- IANDJ=11
- GO TO 1
-C
-#if defined(CERNLIB_ENTRCDC)
- ENTRY MXMPY1
-#endif
-#if !defined(CERNLIB_ENTRCDC)
- ENTRY MXMPY1 (A,B,C,I,J,K)
-#endif
-C
- IANDJ=12
- GO TO 1
-C
-#if defined(CERNLIB_ENTRCDC)
- ENTRY MXMPY2
-#endif
-#if !defined(CERNLIB_ENTRCDC)
- ENTRY MXMPY2 (A,B,C,I,J,K)
-#endif
-C
- IANDJ=13
- GO TO 1
-C
-#if defined(CERNLIB_ENTRCDC)
- ENTRY MXMPY3
-#endif
-#if !defined(CERNLIB_ENTRCDC)
- ENTRY MXMPY3 (A,B,C,I,J,K)
-#endif
-C
- IANDJ=14
- GO TO 1
-C
-#if defined(CERNLIB_ENTRCDC)
- ENTRY MXMUB
-#endif
-#if !defined(CERNLIB_ENTRCDC)
- ENTRY MXMUB (A,B,C,I,J,K)
-#endif
-C
- IANDJ=31
- GO TO 1
-C
-#if defined(CERNLIB_ENTRCDC)
- ENTRY MXMUB1
-#endif
-#if !defined(CERNLIB_ENTRCDC)
- ENTRY MXMUB1 (A,B,C,I,J,K)
-#endif
-C
- IANDJ=32
- GO TO 1
-C
-#if defined(CERNLIB_ENTRCDC)
- ENTRY MXMUB2
-#endif
-#if !defined(CERNLIB_ENTRCDC)
- ENTRY MXMUB2 (A,B,C,I,J,K)
-#endif
-C
- IANDJ=33
- GO TO 1
-C
-#if defined(CERNLIB_ENTRCDC)
- ENTRY MXMUB3
-#endif
-#if !defined(CERNLIB_ENTRCDC)
- ENTRY MXMUB3 (A,B,C,I,J,K)
-#endif
-C
- IANDJ=34
-C
- 1 N1=IANDJ/10
- N2=IANDJ-10*N1
- IF((I.EQ.0).OR.(K.EQ.0)) GO TO 100
- GO TO (3,3,5,5),N2
-C
- 3 IIA=1
- IOA=J
- GO TO 7
- 5 IIA=I
- IOA=1
- 7 GO TO (9,11,9,11),N2
- 9 IIB=K
- IOB=1
- GO TO 13
- 11 IIB=1
- IOB=J
- 13 IA=1
- IC=1
- DO 25 L=1,I
- IB =1
- DO 23 M=1,K
- GO TO (15,18,16),N1
- 15 C(IC)=0.
- GO TO 18
- 16 C(IC)=-C(IC)
- 18 IF (J.EQ.0) GO TO 23
- JA=IA
- JB=IB
- DO 20 N=1,J
- C(IC)=C(IC)+A(JA)*B(JB)
- JA=JA+IIA
- 20 JB=JB+IIB
- IB=IB+IOB
- 23 IC=IC+1
- 25 IA=IA+IOA
- 100 RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/mxmlrt.F b/src/packlib/kernlib/kerngen/tcgen/mxmlrt.F
deleted file mode 100644
index e46533e..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/mxmlrt.F
+++ /dev/null
@@ -1,93 +0,0 @@
-*
-* $Id: mxmlrt.F,v 1.1.1.1 1996/02/15 17:49:52 mclareni Exp $
-*
-* $Log: mxmlrt.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:52 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE MXMLRT (A,B,C,NI,NJ)
-C
-C CERN PROGLIB# F110 MXMLRT .VERSION KERNFOR 2.00 720707
-C ORIG. 01/01/64 RKB
-C
- DIMENSION A(*),B(*),C(*)
-C
-C-- ENTRY MXMLRT
-C
-C-- C = A(I,J) X B(J,J) X A*(J,I)
-C-- A* STANDS FOR A-TRANSPOSED
-C
-C CALL MXMLRT (A,B,C,NI,NJ) IS EQUIVALENT TO
-C CALL MXMPY (A,B,X,NI,NJ,NJ)
-C CALL MXMPY1 (X,A,C,NI,NJ,NI)
-C
-C OR CALL MXMPY1 (B,A,Y,NJ,NJ,NI)
-C CALL MXMPY (A,Y,C,NI,NJ,NI)
-C
- IPA=1
- JPA=NJ
- GO TO 5
-C
-#if defined(CERNLIB_ENTRCDC)
- ENTRY MXMLTR
-#endif
-#if !defined(CERNLIB_ENTRCDC)
- ENTRY MXMLTR (A,B,C,NI,NJ)
-#endif
-C
-C-- C = A*(I,J) X B(J,J) X A(J,I)
-C
-C CALL MXMLTR (A,B,C,NI,NJ) IS EQUIVALENT TO
-C CALL MXMPY2 (A,B,X,NI,NJ,NJ)
-C CALL MXMPY (X,A,C,NI,NJ,NI)
-C
-C OR CALL MXMPY (B,A,Y,NJ,NJ,NI)
-C CALL MXMPY2 (A,Y,C,NI,NJ,NI)
-C
- IPA=NI
- JPA=1
-C
- 5 CONTINUE
- IF (NI.LE.0) RETURN
- IF (NJ.LE.0) RETURN
- IC1=1
- IA1=1
- DO 50 II=1,NI
-C
- IC=IC1
- DO 10 KC=1,NI
- C(IC)=0.
- 10 IC=IC+1
-C
- IB1=1
- JA1=1
- DO 40 JJ=1,NJ
-C
- IB=IB1
- IA=IA1
- X=0.
- DO 20 KJ=1,NJ
- X=X + A(IA)*B(IB)
- IA=IA+IPA
- IB=IB+NJ
- 20 CONTINUE
-C
- JA=JA1
- IC=IC1
- DO 30 KI=1,NI
- C(IC)=C(IC) + X*A(JA)
- IC=IC+1
- JA=JA+JPA
- 30 CONTINUE
-C
- IB1=IB1+1
- JA1=JA1+IPA
- 40 CONTINUE
-C
- IC1=IC1+NI
- IA1=IA1+JPA
- 50 CONTINUE
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/mxtrp.F b/src/packlib/kernlib/kerngen/tcgen/mxtrp.F
deleted file mode 100644
index af8019f..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/mxtrp.F
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: mxtrp.F,v 1.1.1.1 1996/02/15 17:49:52 mclareni Exp $
-*
-* $Log: mxtrp.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:52 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE MXTRP (A,B,I,J)
-C
-C CERN PROGLIB# F110 MXTRP .VERSION KERNFOR 1.0 650809
-C ORIG. 01/01/64 RKB
-C
- DIMENSION A(*),B(*)
-C
-C
- IF((I.EQ.0).OR.(J.EQ.0))GO TO 100
- IB=1
- DO 1 K=1,J
- IA=K
- DO 1 L=1,I
- B(IB)=A(IA)
- IA=IA+J
- 1 IB=IB+1
- 100 RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/mxuty.F b/src/packlib/kernlib/kerngen/tcgen/mxuty.F
deleted file mode 100644
index 9f21562..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/mxuty.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: mxuty.F,v 1.1.1.1 1996/02/15 17:49:52 mclareni Exp $
-*
-* $Log: mxuty.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:52 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE MXUTY(A,I)
-C
-C CERN PROGLIB# F110 MXUTY .VERSION KERNFOR 1.0 650809
-C ORIG. 01/01/64 RKB
-C
- DIMENSION A(*)
-C
- IF(I.EQ.0) GO TO 100
- J=1
- IF(I.EQ.1) GO TO 2
- DO 1 K=2,I
- A(J)=1.
- J=J+1
- DO 1 L=1,I
- A(J)=0.
- 1 J=J+1
- 2 A(J)=1.
- 100 RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/ncdeci.F b/src/packlib/kernlib/kerngen/tcgen/ncdeci.F
deleted file mode 100644
index f73c0b7..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/ncdeci.F
+++ /dev/null
@@ -1,65 +0,0 @@
-*
-* $Id: ncdeci.F,v 1.1.1.1 1996/02/15 17:49:49 mclareni Exp $
-*
-* $Log: ncdeci.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:49 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- FUNCTION NCDECI (CHV)
-C
-C CERN PROGLIB# M432 NCDECI .VERSION KERNFOR 4.33 920511
-C ORIG. 03/06/92, JZ
-C
-C- Read decimal integer from CHV
-
- COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT, DUMMY(36)
- CHARACTER CHV*(*)
-
- JJ = 1
- JR = LEN(CHV)
-
- IVAL = 0
- NDG = 0
- NEG = 0
- NGSLAT = 0
-
- 12 IF (JJ.GT.JR) GO TO 99
- IF (CHV(JJ:JJ).EQ.' ') THEN
- JJ = JJ + 1
- GO TO 12
- ELSEIF (CHV(JJ:JJ).EQ.'+') THEN
- JJ = JJ + 1
- ELSEIF (CHV(JJ:JJ).EQ.'-') THEN
- NEG = 7
- JJ = JJ + 1
- ENDIF
-
- 21 IF (JJ.GT.JR) GO TO 99
-#if defined(CERNLIB_QASCII)
- K = ICHAR (CHV(JJ:JJ))
- K = K - 48
- IF (K.LT.0) GO TO 98
- IF (K.GE.10) GO TO 98
-#endif
-#if defined(CERNLIB_QEBCDIC)
- K = ICHAR (CHV(JJ:JJ))
- K = K - 240
- IF (K.LT.0) GO TO 98
- IF (K.GE.10) GO TO 98
-#endif
- IVAL = 10*IVAL + K
- NDG = NDG + 1
- JJ = JJ + 1
- GO TO 21
-
- 98 IF (CHV(JJ:JJ).NE.' ') NGSLAT = JJ
- 99 NDSLAT = NDG
- NESLAT = JJ
- IF (NEG.NE.0) THEN
- IF (IVAL.NE.0) IVAL = -IVAL
- ENDIF
- NCDECI = IVAL
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/nchexi.F b/src/packlib/kernlib/kerngen/tcgen/nchexi.F
deleted file mode 100644
index a842104..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/nchexi.F
+++ /dev/null
@@ -1,91 +0,0 @@
-*
-* $Id: nchexi.F,v 1.1.1.1 1996/02/15 17:49:49 mclareni Exp $
-*
-* $Log: nchexi.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:49 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- FUNCTION NCHEXI (CHV)
-C
-C CERN PROGLIB# M432 NCHEXI .VERSION KERNFOR 4.35 930308
-C ORIG. 03/06/92, JZ
-C
-C- Read hexadecimal integer from CHV
-
- COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT, DUMMY(36)
- CHARACTER CHV*(*)
-
-#if !defined(CERNLIB_QISASTD)
-#include "kerngen/q_andor.inc"
-#include "kerngen/q_shift.inc"
-#endif
-
- JJ = 1
- JR = LEN(CHV)
-
- IVAL = 0
- NDG = 0
- NEG = 0
- NGSLAT = 0
-
- 12 IF (JJ.GT.JR) GO TO 99
- IF (CHV(JJ:JJ).EQ.' ') THEN
- JJ = JJ + 1
- GO TO 12
- ELSEIF (CHV(JJ:JJ).EQ.'+') THEN
- JJ = JJ + 1
- ELSEIF (CHV(JJ:JJ).EQ.'-') THEN
- NEG = 7
- JJ = JJ + 1
- ENDIF
-
- 21 IF (JJ.GT.JR) GO TO 99
-#if defined(CERNLIB_QASCII)
- K = ICHAR (CHV(JJ:JJ))
- K = K - 48
- IF (K.LT.0) GO TO 98
- IF (K.GE.10) THEN
- K = K - 7
- IF (K.LT.10) GO TO 98
- IF (K.GE.16) THEN
- K = K - 32
- IF (K.LT.10) GO TO 98
- IF (K.GE.16) GO TO 98
- ENDIF
- ENDIF
-#endif
-#if defined(CERNLIB_QEBCDIC)
- K = ICHAR (CHV(JJ:JJ))
- K = K - 119
- IF (K.LT.10) GO TO 98
- IF (K.GE.16) THEN
- K = K - 64
- IF (K.LT.10) GO TO 98
- IF (K.GE.16) THEN
- K = K - 57
- IF (K.LT.0) GO TO 98
- IF (K.GE.10) GO TO 98
- ENDIF
- ENDIF
-#endif
-#if !defined(CERNLIB_QISASTD)
- IVAL = IOR (ISHFTL(IVAL,4), K)
-#endif
-#if defined(CERNLIB_QISASTD)
- IVAL = IOR (ISHFT (IVAL,4), K)
-#endif
- NDG = NDG + 1
- JJ = JJ + 1
- GO TO 21
-
- 98 IF (CHV(JJ:JJ).NE.' ') NGSLAT = JJ
- 99 NDSLAT = NDG
- NESLAT = JJ
- IF (NEG.NE.0) THEN
- IF (IVAL.NE.0) IVAL = -IVAL
- ENDIF
- NCHEXI = IVAL
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/ncocti.F b/src/packlib/kernlib/kerngen/tcgen/ncocti.F
deleted file mode 100644
index 35e77b2..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/ncocti.F
+++ /dev/null
@@ -1,75 +0,0 @@
-*
-* $Id: ncocti.F,v 1.1.1.1 1996/02/15 17:49:49 mclareni Exp $
-*
-* $Log: ncocti.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:49 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- FUNCTION NCOCTI (CHV)
-C
-C CERN PROGLIB# M432 NCOCTI .VERSION KERNFOR 4.35 930308
-C ORIG. 03/06/92, JZ
-C
-C- Read octal integer from CHV
-
- COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT, DUMMY(36)
- CHARACTER CHV*(*)
-
-#if !defined(CERNLIB_QISASTD)
-#include "kerngen/q_andor.inc"
-#include "kerngen/q_shift.inc"
-#endif
-
- JJ = 1
- JR = LEN(CHV)
-
- IVAL = 0
- NDG = 0
- NEG = 0
- NGSLAT = 0
-
- 12 IF (JJ.GT.JR) GO TO 99
- IF (CHV(JJ:JJ).EQ.' ') THEN
- JJ = JJ + 1
- GO TO 12
- ELSEIF (CHV(JJ:JJ).EQ.'+') THEN
- JJ = JJ + 1
- ELSEIF (CHV(JJ:JJ).EQ.'-') THEN
- NEG = 7
- JJ = JJ + 1
- ENDIF
-
- 21 IF (JJ.GT.JR) GO TO 99
-#if defined(CERNLIB_QASCII)
- K = ICHAR (CHV(JJ:JJ))
- K = K - 48
- IF (K.LT.0) GO TO 98
- IF (K.GE.8) GO TO 98
-#endif
-#if defined(CERNLIB_QEBCDIC)
- K = ICHAR (CHV(JJ:JJ))
- K = K - 240
- IF (K.LT.0) GO TO 98
- IF (K.GE.8) GO TO 98
-#endif
-#if !defined(CERNLIB_QISASTD)
- IVAL = IOR (ISHFTL(IVAL,3), K)
-#endif
-#if defined(CERNLIB_QISASTD)
- IVAL = IOR (ISHFT (IVAL,3), K)
-#endif
- NDG = NDG + 1
- JJ = JJ + 1
- GO TO 21
-
- 98 IF (CHV(JJ:JJ).NE.' ') NGSLAT = JJ
- 99 NDSLAT = NDG
- NESLAT = JJ
- IF (NEG.NE.0) THEN
- IF (IVAL.NE.0) IVAL = -IVAL
- ENDIF
- NCOCTI = IVAL
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/os9gs/kerngt.F b/src/packlib/kernlib/kerngen/tcgen/os9gs/kerngt.F
deleted file mode 100644
index 8a82d18..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/os9gs/kerngt.F
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: kerngt.F,v 1.1.1.1 1996/02/15 17:50:00 mclareni Exp $
-*
-* $Log: kerngt.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:00 mclareni
-* Kernlib
-*
-*
- SUBROUTINE KERNGT (LUN)
-C
-C CERN PROGLIB# Z001 KERNGT .VERSION KERNOS9 1.01 940718
-C ORIG. 16/03/89
-C
-C-- Store Pam title into /SLATE/ for printing by GSHOWF
-
- COMMON /SLATE/ MCH(40)
-
-
- CALL UCTOH1 (
- + ' KERNOS9 1.01 940929 16.30 '
- +, MCH, 40)
- CALL GSHOWF (LUN)
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/poweze.F b/src/packlib/kernlib/kerngen/tcgen/poweze.F
deleted file mode 100644
index 592b652..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/poweze.F
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: poweze.F,v 1.1.1.1 1996/02/15 17:49:52 mclareni Exp $
-*
-* $Log: poweze.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:52 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
-#if !defined(CERNLIB_TCGEN)
- SUBROUTINE POWEZE (X,A,N)
-C
-C CERN PROGLIB# B400 POWEZE .VERSION KERNFOR 2.09 751101
-C ORIG. 20/08/75
-C
- DIMENSION A(2)
- A(1)= 1.
- IF (N.LE.1) RETURN
- DO 10 I= 2,N
- 10 A(I)= X * A(I-1)
- RETURN
- END
-#endif
diff --git a/src/packlib/kernlib/kerngen/tcgen/proxim.F b/src/packlib/kernlib/kerngen/tcgen/proxim.F
deleted file mode 100644
index 91de9e9..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/proxim.F
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: proxim.F,v 1.1.1.1 1996/02/15 17:49:52 mclareni Exp $
-*
-* $Log: proxim.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:52 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- FUNCTION PROXIM (ANGL,STAND)
-C
-C CERN PROGLIB# V306 PROXIM .VERSION KERNFOR 4.21 890323
-C ORIG. 15/03/68 JZ, re-write 8/03/89 K.S.Koelbig
-C
- PARAMETER (PI2 = 6.28318 53071 79586D0, RPI2 =1/PI2)
-
- PROXIM = ANGL + PI2*ANINT(RPI2*(STAND-ANGL))
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/pscale.F b/src/packlib/kernlib/kerngen/tcgen/pscale.F
deleted file mode 100644
index 830c052..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/pscale.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: pscale.F,v 1.1.1.1 1996/02/15 17:49:49 mclareni Exp $
-*
-* $Log: pscale.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:49 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- FUNCTION PSCALE (NSC,NMAX,A,NST)
-C
-C CERN PROGLIB# M215 PSCALE .VERSION KERNFOR 1.0 681105
-C ORIG. 05/11/68
-C
-C-- FIND THE LARGEST POWER PSCALE=10.**NSC
-C- SUCH THAT A*PSCALE HAS AT MOST NST DIGITS ON THE
-C- LEFT OF THE DECIMAL POINT
-C- NSC LIMITED TO NSC.LE.NMAX
-C
-C
- NSC=NMAX
- IF (A.EQ.0.) GO TO 9
- N=100.+ LOG10 (ABS (A))+.0001
- N=NST+99-N
- IF (N.LT.NSC) NSC=N
- 9 PSCALE=10.**NSC
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/ranecq.F b/src/packlib/kernlib/kerngen/tcgen/ranecq.F
deleted file mode 100644
index 259a9f8..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/ranecq.F
+++ /dev/null
@@ -1,160 +0,0 @@
-*
-* $Id: ranecq.F,v 1.1.1.1 1996/02/15 17:49:53 mclareni Exp $
-*
-* $Log: ranecq.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:53 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE RANECQ(IS1,IS2,ISEQ,CHOPT)
-C
-C CERN PROGLIB# V114 RANECQ .VERSION KERNFOR 4.21 890323
-C ORIG. 01/03/89 FCA + FJ
-C
- CHARACTER*(*) CHOPT
- CHARACTER*12 CCHOPT
-#if defined(CERNLIB_QMIBM)||defined(CERNLIB_QMIBX)||defined(CERNLIB_QMAPO10)
- DOUBLE PRECISION ISEED
-#endif
-#if defined(CERNLIB_QMCRY)
- REAL ISEED
-#endif
- PARAMETER (MAXSEQ=100)
- DIMENSION LSEQS(2,MAXSEQ)
- COMMON / RANEC1 / JSEQ(2), ISEED(2,MAXSEQ)
- SAVE /RANEC1/
- DATA (LSEQS(J, 1),J=1,2) / 9876, 54321/
- DATA (LSEQS(J, 2),J=1,2) /1058718014,1872605764/
- DATA (LSEQS(J, 3),J=1,2) /1814868809, 849641138/
- DATA (LSEQS(J, 4),J=1,2) /1503041326, 998515605/
- DATA (LSEQS(J, 5),J=1,2) / 628142053, 244439171/
- DATA (LSEQS(J, 6),J=1,2) /1391554630, 846883852/
- DATA (LSEQS(J, 7),J=1,2) /1535236638, 154775958/
- DATA (LSEQS(J, 8),J=1,2) /1747133713,1575487760/
- DATA (LSEQS(J, 9),J=1,2) / 714962706,2107758832/
- DATA (LSEQS(J, 10),J=1,2) /1486824114, 786139113/
- DATA (LSEQS(J, 11),J=1,2) /1323688611, 371658774/
- DATA (LSEQS(J, 12),J=1,2) /1570590541, 630312859/
- DATA (LSEQS(J, 13),J=1,2) /1555058144, 358976382/
- DATA (LSEQS(J, 14),J=1,2) / 952681104,1242126412/
- DATA (LSEQS(J, 15),J=1,2) /1083789165,1890043487/
- DATA (LSEQS(J, 16),J=1,2) / 631749547,1925864168/
- DATA (LSEQS(J, 17),J=1,2) /1178945274,1475158130/
- DATA (LSEQS(J, 18),J=1,2) /1009344940,1502757676/
- DATA (LSEQS(J, 19),J=1,2) /1933972860,1627514572/
- DATA (LSEQS(J, 20),J=1,2) /1875817978, 567972013/
- DATA (LSEQS(J, 21),J=1,2) / 446320203, 273324776/
- DATA (LSEQS(J, 22),J=1,2) / 460899131,1527583930/
- DATA (LSEQS(J, 23),J=1,2) / 35532104, 558897732/
- DATA (LSEQS(J, 24),J=1,2) /2089458455,1339622951/
- DATA (LSEQS(J, 25),J=1,2) /1535926201,1918446533/
- DATA (LSEQS(J, 26),J=1,2) / 669734232,1019772931/
- DATA (LSEQS(J, 27),J=1,2) / 501928827, 285518477/
- DATA (LSEQS(J, 28),J=1,2) / 942354467, 280177956/
- DATA (LSEQS(J, 29),J=1,2) / 192461969,1576639468/
- DATA (LSEQS(J, 30),J=1,2) /1601863355, 661544549/
- DATA (LSEQS(J, 31),J=1,2) /1743728581, 523887323/
- DATA (LSEQS(J, 32),J=1,2) /1703010089,1259731603/
- DATA (LSEQS(J, 33),J=1,2) /1643511188, 875622567/
- DATA (LSEQS(J, 34),J=1,2) /1755559262,2142089492/
- DATA (LSEQS(J, 35),J=1,2) / 114689819, 126275958/
- DATA (LSEQS(J, 36),J=1,2) / 105250298,1127134231/
- DATA (LSEQS(J, 37),J=1,2) / 79402987,1236641847/
- DATA (LSEQS(J, 38),J=1,2) / 387101667,1706644076/
- DATA (LSEQS(J, 39),J=1,2) /1734232502, 664024463/
- DATA (LSEQS(J, 40),J=1,2) /2123161160,1759230139/
- DATA (LSEQS(J, 41),J=1,2) /1811169504,1405252309/
- DATA (LSEQS(J, 42),J=1,2) /1766746084, 274705383/
- DATA (LSEQS(J, 43),J=1,2) / 959435020, 108779126/
- DATA (LSEQS(J, 44),J=1,2) /2062813302,1863432262/
- DATA (LSEQS(J, 45),J=1,2) /1691639052,1503605588/
- DATA (LSEQS(J, 46),J=1,2) /1086444145, 158310100/
- DATA (LSEQS(J, 47),J=1,2) /2058594463, 810394383/
- DATA (LSEQS(J, 48),J=1,2) /2101564568,1105108539/
- DATA (LSEQS(J, 49),J=1,2) / 978826660, 617502647/
- DATA (LSEQS(J, 50),J=1,2) /1436276288, 529578818/
- DATA (LSEQS(J, 51),J=1,2) / 556864235, 606529730/
- DATA (LSEQS(J, 52),J=1,2) /1078146847,1147358663/
- DATA (LSEQS(J, 53),J=1,2) /1447193285,1376658008/
- DATA (LSEQS(J, 54),J=1,2) /1006664521,1311015086/
- DATA (LSEQS(J, 55),J=1,2) /1837174956, 768046385/
- DATA (LSEQS(J, 56),J=1,2) / 896589370, 260492364/
- DATA (LSEQS(J, 57),J=1,2) /1360218380,1414233683/
- DATA (LSEQS(J, 58),J=1,2) /1278625491,1552675421/
- DATA (LSEQS(J, 59),J=1,2) /1011812242,1458050027/
- DATA (LSEQS(J, 60),J=1,2) /1754922946,1785085266/
- DATA (LSEQS(J, 61),J=1,2) /1343566665, 443288238/
- DATA (LSEQS(J, 62),J=1,2) /1437791085,2078825854/
- DATA (LSEQS(J, 63),J=1,2) /2094123993,1341409348/
- DATA (LSEQS(J, 64),J=1,2) /1537730690, 153906788/
- DATA (LSEQS(J, 65),J=1,2) /2127544614, 4856371/
- DATA (LSEQS(J, 66),J=1,2) /1004692237, 786489538/
- DATA (LSEQS(J, 67),J=1,2) / 821800123,1417369188/
- DATA (LSEQS(J, 68),J=1,2) / 312261859, 286397034/
- DATA (LSEQS(J, 69),J=1,2) /1519811572, 144643793/
- DATA (LSEQS(J, 70),J=1,2) / 5329351,1263184329/
- DATA (LSEQS(J, 71),J=1,2) /1416419532,1842707225/
- DATA (LSEQS(J, 72),J=1,2) /1697860185, 840465352/
- DATA (LSEQS(J, 73),J=1,2) /1934192451, 619946463/
- DATA (LSEQS(J, 74),J=1,2) / 170088516,1174161868/
- DATA (LSEQS(J, 75),J=1,2) /1304806046, 108470534/
- DATA (LSEQS(J, 76),J=1,2) /1976265015,1714480092/
- DATA (LSEQS(J, 77),J=1,2) / 783664411, 978542208/
- DATA (LSEQS(J, 78),J=1,2) /1694901962, 55891868/
- DATA (LSEQS(J, 79),J=1,2) /1548123234, 424683817/
- DATA (LSEQS(J, 80),J=1,2) /1042788941,1370039022/
- DATA (LSEQS(J, 81),J=1,2) /1576822555,1268584439/
- DATA (LSEQS(J, 82),J=1,2) / 831708278,1432924432/
- DATA (LSEQS(J, 83),J=1,2) / 993848687, 233811113/
- DATA (LSEQS(J, 84),J=1,2) / 745249148, 738800065/
- DATA (LSEQS(J, 85),J=1,2) /1947731465,1336392610/
- DATA (LSEQS(J, 86),J=1,2) /1402689657,1392469639/
- DATA (LSEQS(J, 87),J=1,2) / 311285254,1241207984/
- DATA (LSEQS(J, 88),J=1,2) /1206768222, 887510662/
- DATA (LSEQS(J, 89),J=1,2) / 762376025,1967748670/
- DATA (LSEQS(J, 90),J=1,2) / 923860508, 824843061/
- DATA (LSEQS(J, 91),J=1,2) / 755432194,1333575913/
- DATA (LSEQS(J, 92),J=1,2) / 233721957, 126133675/
- DATA (LSEQS(J, 93),J=1,2) /1989717210, 691593480/
- DATA (LSEQS(J, 94),J=1,2) /1030990373, 128881640/
- DATA (LSEQS(J, 95),J=1,2) /1322807026, 928284400/
- DATA (LSEQS(J, 96),J=1,2) /1169603884,1077182026/
- DATA (LSEQS(J, 97),J=1,2) / 976273645,1973303129/
- DATA (LSEQS(J, 98),J=1,2) / 530354343,1592879270/
- DATA (LSEQS(J, 99),J=1,2) / 947509404, 205601315/
- DATA (LSEQS(J,100),J=1,2) /1840231302,1716122836/
-C
- CCHOPT = CHOPT
- IF(CCHOPT.EQ.' ') THEN
- JSEQ(1) = 1
- IF(ISEQ.GT.0.AND.ISEQ.LE.MAXSEQ) JSEQ(1) = ISEQ
- ISEED(1,JSEQ(1)) = LSEQS(1,JSEQ(1))
- ISEED(2,JSEQ(1)) = LSEQS(2,JSEQ(1))
- GO TO 999
- ENDIF
- IF(INDEX(CHOPT,'S').NE.0) THEN
- IF(ISEQ.GT.0) JSEQ(1) = ISEQ
- IF(IS1.GT.0.AND.IS2.GT.0) THEN
- ISEED(1,JSEQ(1)) = IS1
- ISEED(2,JSEQ(1)) = IS2
- ENDIF
- ENDIF
- IF(INDEX(CHOPT,'R').NE.0) THEN
- IF(ISEQ.LE.0) ISEQ = JSEQ(1)
- IS1 = ISEED(1,ISEQ)
- IS2 = ISEED(2,ISEQ)
- JSEQ(1) = ISEQ
- ENDIF
- IF(INDEX(CHOPT,'Q').NE.0) THEN
- IF(ISEQ.GE.0.AND.ISEQ.LE.MAXSEQ) THEN
- IS1 = LSEQS(1,ISEQ)
- IS2 = LSEQS(2,ISEQ)
- ELSE
- IS1 = 0
- IS2 = 0
- ENDIF
- ENDIF
-C
- 999 RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/ranecu.F b/src/packlib/kernlib/kerngen/tcgen/ranecu.F
deleted file mode 100644
index 3953150..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/ranecu.F
+++ /dev/null
@@ -1,65 +0,0 @@
-*
-* $Id: ranecu.F,v 1.1.1.1 1996/02/15 17:49:53 mclareni Exp $
-*
-* $Log: ranecu.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:53 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE RANECU(RVEC,LEN,KSEQ)
-#if defined(CERNLIB_QMCRY)
-CDIR$ STACK
-#endif
-C
-C CERN PROGLIB# V114 RANECU .VERSION KERNFOR 4.21 890323
-C ORIG. 01/03/89 FCA + FJ
-C
-#if defined(CERNLIB_QMCRY)
- REAL ISEED, ISEED1, ISEED2, K, C1, C2, IZ
-#endif
-#if defined(CERNLIB_QMIBM)||defined(CERNLIB_QMIBX)||defined(CERNLIB_QMAPO10)
- DOUBLE PRECISION ISEED, ISEED1, ISEED2, K, C1, C2, IZ
-#endif
-#if defined(CERNLIB_QMIBM)||defined(CERNLIB_QMIBX)||defined(CERNLIB_QMCRY)||defined(CERNLIB_QMAPO10)
- PARAMETER (C1=(1.D0+1.D-11)/53668.D0,C2=(1.D0+1.D-11)/52774.D0)
-#endif
- PARAMETER (MAXSEQ=100)
- DIMENSION RVEC(*)
- COMMON / RANEC1 / JSEQ(2), ISEED(2,MAXSEQ)
- SAVE /RANEC1/
-C
- IF(KSEQ.GT.0) THEN
- JSEQ(1) = KSEQ
- ISEQ = KSEQ
- ELSE
- ISEQ = JSEQ(1)
- ENDIF
- ISEED1 = ISEED(1,ISEQ)
- ISEED2 = ISEED(2,ISEQ)
- DO 100 I= 1, LEN
-#if defined(CERNLIB_QMIBM)||defined(CERNLIB_QMIBX)||defined(CERNLIB_QMCRY)||defined(CERNLIB_QMAPO10)
- K = INT(ISEED1*C1)
-#else
- K = ISEED1/53668
-#endif
- ISEED1 = 40014*(ISEED1 - K*53668) - K*12211
- IF (ISEED1 .LT. 0) ISEED1=ISEED1+2147483563
-C
-#if defined(CERNLIB_QMIBM)||defined(CERNLIB_QMIBX)||defined(CERNLIB_QMCRY)||defined(CERNLIB_QMAPO10)
- K = INT(ISEED2*C2)
-#else
- K = ISEED2/52774
-#endif
- ISEED2 = 40692*(ISEED2 - K*52774) - K* 3791
- IF (ISEED2 .LT. 0) ISEED2=ISEED2+2147483399
-C
- IZ = ISEED1 - ISEED2
- IF (IZ .LE. 0) IZ = IZ + 2147483562
-C
- RVEC(I) = IZ * 4.6566128E-10
- 100 CONTINUE
- ISEED(1,ISEQ) = ISEED1
- ISEED(2,ISEQ) = ISEED2
- END
-C
diff --git a/src/packlib/kernlib/kerngen/tcgen/ranmar.F b/src/packlib/kernlib/kerngen/tcgen/ranmar.F
deleted file mode 100644
index 43374e8..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/ranmar.F
+++ /dev/null
@@ -1,128 +0,0 @@
-*
-* $Id: ranmar.F,v 1.1.1.1 1996/02/15 17:49:53 mclareni Exp $
-*
-* $Log: ranmar.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:53 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE RANMAR(RVEC,LENV)
-#if defined(CERNLIB_QMCRY)
-CDIR$ STACK
-#endif
-C
-C CERN PROGLIB# V113 RANMAR .VERSION KERNFOR 4.21 890323
-C ORIG. 01/03/89 FCA + FJ
-C
- DIMENSION RVEC(*)
-C
- COMMON/RANMA1/IJKL,NTOT,NTOT2,I97,J97,C,U(97)
- LOGICAL FIRST
- PARAMETER (TWOM24=2.**(-24),TWOM48=2.**(-48))
- PARAMETER (CD=7654321.*TWOM24,CM=16777213.*TWOM24)
- PARAMETER (CINT=362436.*TWOM24,MODCNS=1000000000)
- SAVE /RANMA1/, FIRST
- DATA FIRST/.TRUE./
-C
- IF(FIRST) THEN
- IJKL = 54217137
- NTOT = 0
- NTOT2 = 0
- GO TO 70
- ENDIF
-C
- 80 CONTINUE
- DO 100 IVEC= 1, LENV
- UNI = U(I97)-U(J97)
- IF (UNI .LT. 0.) UNI=UNI+1.
- U(I97) = UNI
- I97 = I97-1
- IF (I97 .EQ. 0) I97=97
- J97 = J97-1
- IF (J97 .EQ. 0) J97=97
- C = C - CD
- IF (C .LT. 0.) C=C+CM
- UNI = UNI-C
- IF (UNI .LT. 0.) UNI=UNI+1.
-C
-C Replace exact zeroes by uniform distr. *2**-24
-C
- IF (UNI .EQ. 0.) THEN
- UNI = TWOM24*U(2)
-C
-C An exact zero here is very unlikely, but let's be safe.
-C
- IF (UNI .EQ. 0.) UNI= TWOM48
- ENDIF
- RVEC(IVEC) = UNI
- 100 CONTINUE
-C
- NTOT = NTOT + LENV
- IF (NTOT .GE. MODCNS) THEN
- NTOT2 = NTOT2 + 1
- NTOT = NTOT - MODCNS
- ENDIF
- RETURN
- ENTRY RMARIN(IJKLIN,NTOTIN,NTO2IN)
-C
- FIRST = .FALSE.
- IJKL = IJKLIN
- NTOT = NTOTIN
- NTOT2 = NTO2IN
-C
- 70 CONTINUE
- IJ = IJKL/30082
- KL = IJKL - 30082*IJ
- I = MOD(IJ/177, 177) + 2
- J = MOD(IJ, 177) + 2
- K = MOD(KL/169, 178) + 1
- L = MOD(KL, 169)
- DO 30 II= 1, 97
- S = 0.
- T = .5
- DO 20 JJ= 1, 24
- M = MOD(MOD(I*J,179)*K, 179)
- I = J
- J = K
- K = M
- L = MOD(53*L+1, 169)
- IF (MOD(L*M,64) .GE. 32) S = S+T
- T = 0.5*T
- 20 CONTINUE
- U(II) = S
- 30 CONTINUE
- C = CINT
- I97 = 97
- J97 = 33
-C Complete initialization by skipping
-C (NTOT2*MODCNS + NTOT) random numbers
- NITER = MODCNS
- DO 50 LOOP2= 1, NTOT2+1
- IF(LOOP2.GT.NTOT2) NITER=NTOT
- DO 40 IDUM = 1, NITER
- UNI = U(I97)-U(J97)
- IF (UNI .LT. 0.) UNI=UNI+1.
- U(I97) = UNI
- I97 = I97-1
- IF (I97 .EQ. 0) I97=97
- J97 = J97-1
- IF (J97 .EQ. 0) J97=97
- C = C - CD
- IF (C .LT. 0.) C=C+CM
- 40 CONTINUE
- 50 CONTINUE
- NTOT = 0
- NTOT2 = 0
- IF(FIRST) THEN
- FIRST = .FALSE.
- GO TO 80
- ENDIF
- RETURN
- ENTRY RMARUT(IJKLUT,NTOTUT,NTO2UT)
-C
- NTOTUT = NTOT
- NTO2UT = NTOT2
- IJKLUT = IJKL
-C
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/rannor.F b/src/packlib/kernlib/kerngen/tcgen/rannor.F
deleted file mode 100644
index c1ab456..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/rannor.F
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: rannor.F,v 1.1.1.1 1996/02/15 17:49:53 mclareni Exp $
-*
-* $Log: rannor.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:53 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE RANNOR (A,B)
-C
-C CERN PROGLIB# V100 RANNOR .VERSION KERNFOR 4.18 880425
-C ORIG. 18/10/77
-C
- Y = RNDM(-1.)
- IF (Y.EQ.0.) Y = RNDM(-1.)
- Z = RNDM(-1.)
-
- X = 6.283185*Z
- R = SQRT (-2.0*LOG(Y))
- A = R*SIN (X)
- B = R*COS (X)
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/rmmaq.F b/src/packlib/kernlib/kerngen/tcgen/rmmaq.F
deleted file mode 100644
index a2f8a0d..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/rmmaq.F
+++ /dev/null
@@ -1,112 +0,0 @@
-*
-* $Id: rmmaq.F,v 1.1.1.1 1996/02/15 17:49:53 mclareni Exp $
-*
-* $Log: rmmaq.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:53 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE RMMAQ(ISEED,ISEQ,CHOPT)
-C
-C CERN PROGLIB# V113 RMMAQ .VERSION KERNFOR 1.0
-C ORIG. 01/03/89 FCA + FJ
-C
- COMMON/RANMA2/JSEQ,IU(103)
- DIMENSION I97(0:1),J97(0:1),C(0:1),NTOT(0:1)
- DIMENSION NTOT2(0:1),IJKL(0:1),U(97)
- EQUIVALENCE (IJKL(0),IU(1)),(NTOT(0),IU(2)),(NTOT2(0),IU(3))
- EQUIVALENCE (U(1),IU(4)),(C(0),IU(101)),(I97(0),IU(102))
- EQUIVALENCE (J97(0),IU(103))
- DIMENSION ISEED(*),UU(97)
- CHARACTER CHOPT*(*), CCHOPT*12
- PARAMETER (TWOM24=2.**(-24),TWOM48=2.**(-48))
- PARAMETER (CD=7654321.*TWOM24,CM=16777213.*TWOM24)
- PARAMETER (CINT=362436.*TWOM24,MODCNS=1000000000)
- SAVE /RANMA2/
-C
- CCHOPT = CHOPT
- IF(CCHOPT.EQ.' ') THEN
- ISEED(1) = 54217137
- ISEED(2) = 0
- ISEED(3) = 0
- CCHOPT = 'S'
- JSEQ = 1
- ENDIF
-C
- IF(INDEX(CCHOPT,'S').NE.0) THEN
- IF(ISEQ.GT.0) JSEQ=ISEQ
- IBASE = (JSEQ-1)*103
- IF(INDEX(CCHOPT,'V').NE.0) THEN
- DO 10 JJ=1, 103
- IU(IBASE+JJ) = ISEED(JJ)
- 10 CONTINUE
- ELSE
- IJKL(IBASE) = ISEED(1)
- NTOT(IBASE) = ISEED(2)
- NTOT2(IBASE) = ISEED(3)
- IJ = IJKL(IBASE)/30082
- KL = IJKL(IBASE) - 30082*IJ
- I = MOD(IJ/177, 177) + 2
- J = MOD(IJ, 177) + 2
- K = MOD(KL/169, 178) + 1
- L = MOD(KL, 169)
- DO 30 II= 1, 97
- S = 0.
- T = .5
- DO 20 JJ= 1, 24
- M = MOD(MOD(I*J,179)*K, 179)
- I = J
- J = K
- K = M
- L = MOD(53*L+1, 169)
- IF (MOD(L*M,64) .GE. 32) S = S+T
- T = 0.5*T
- 20 CONTINUE
- UU(II) = S
- 30 CONTINUE
- CC = CINT
- II97 = 97
- IJ97 = 33
-C Complete initialization by skipping
-C (NTOT2*MODCNS + NTOT) random numbers
- NITER = MODCNS
- DO 50 LOOP2= 1, NTOT2(IBASE)+1
- IF(LOOP2.GT.NTOT2(IBASE)) NITER=NTOT(IBASE)
- DO 40 IDUM = 1, NITER
- UNI = UU(II97)-UU(IJ97)
- IF (UNI .LT. 0.) UNI=UNI+1.
- UU(II97) = UNI
- II97 = II97-1
- IF (II97 .EQ. 0) II97=97
- IJ97 = IJ97-1
- IF (IJ97 .EQ. 0) IJ97=97
- CC = CC - CD
- IF (CC .LT. 0.) CC=CC+CM
- 40 CONTINUE
- 50 CONTINUE
- I97(IBASE) = II97
- J97(IBASE) = IJ97
- C(IBASE) = CC
- DO 60 JJ=1, 97
- U(IBASE+JJ) = UU(JJ)
- 60 CONTINUE
- ENDIF
- ELSE IF(INDEX(CCHOPT,'R').NE.0) THEN
- IF(ISEQ.GT.0) THEN
- JSEQ=ISEQ
- ELSE
- ISEQ=JSEQ
- ENDIF
- IBASE = (JSEQ-1)*103
- IF(INDEX(CCHOPT,'V').NE.0) THEN
- NCOPY = 103
- ELSE
- NCOPY = 3
- ENDIF
- DO 70 JJ=1,NCOPY
- ISEED(JJ) = IU(IBASE+JJ)
- 70 CONTINUE
- ENDIF
-C
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/rmmar.F b/src/packlib/kernlib/kerngen/tcgen/rmmar.F
deleted file mode 100644
index 18a76ff..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/rmmar.F
+++ /dev/null
@@ -1,64 +0,0 @@
-*
-* $Id: rmmar.F,v 1.1.1.1 1996/02/15 17:49:53 mclareni Exp $
-*
-* $Log: rmmar.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:53 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE RMMAR(RVEC,LENV,ISEQ)
-#if defined(CERNLIB_QMCRY)
-CDIR$ STACK
-#endif
-C
-C CERN PROGLIB# V113 RMMAR .VERSION KERNFOR 1.0
-C ORIG. 01/03/89 FCA + FJ
-C
- DIMENSION RVEC(*)
-C
- COMMON/RANMA2/JSEQ,IU(103)
- DIMENSION I97(0:1),J97(0:1),C(0:1),NTOT(0:1)
- DIMENSION NTOT2(0:1),IJKL(0:1),U(97)
- EQUIVALENCE (IJKL(0),IU(1)),(NTOT(0),IU(2)),(NTOT2(0),IU(3))
- EQUIVALENCE (U(1),IU(4)),(C(0),IU(101)),(I97(0),IU(102))
- EQUIVALENCE (J97(0),IU(103))
- PARAMETER (TWOM24=2.**(-24),TWOM48=2.**(-48))
- PARAMETER (CD=7654321.*TWOM24,CM=16777213.*TWOM24)
- PARAMETER (MODCNS=1000000000)
- SAVE /RANMA2/
-C
- IF(ISEQ.GT.0) JSEQ = ISEQ
- IBASE = (JSEQ-1)*103
-C
- DO 100 IVEC= 1, LENV
- UNI = U(IBASE+I97(IBASE))-U(IBASE+J97(IBASE))
- IF (UNI .LT. 0.) UNI=UNI+1.
- U(IBASE+I97(IBASE)) = UNI
- I97(IBASE) = I97(IBASE)-1
- IF (I97(IBASE) .EQ. 0) I97(IBASE)=97
- J97(IBASE) = J97(IBASE)-1
- IF (J97(IBASE) .EQ. 0) J97(IBASE)=97
- C(IBASE) = C(IBASE) - CD
- IF (C(IBASE) .LT. 0.) C(IBASE)=C(IBASE)+CM
- UNI = UNI-C(IBASE)
- IF (UNI .LT. 0.) UNI=UNI+1.
-C
-C Replace exact zeroes by uniform distr. *2**-24
-C
- IF (UNI .EQ. 0.) THEN
- UNI = TWOM24*U(2)
-C
-C An exact zero here is very unlikely, but let's be safe.
-C
- IF (UNI .EQ. 0.) UNI= TWOM48
- ENDIF
- RVEC(IVEC) = UNI
- 100 CONTINUE
-C
- NTOT(IBASE) = NTOT(IBASE) + LENV
- IF (NTOT(IBASE) .GE. MODCNS) THEN
- NTOT2(IBASE) = NTOT2(IBASE) + 1
- NTOT(IBASE) = NTOT(IBASE) - MODCNS
- ENDIF
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/rot.F b/src/packlib/kernlib/kerngen/tcgen/rot.F
deleted file mode 100644
index f33d4f6..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/rot.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: rot.F,v 1.1.1.1 1996/02/15 17:49:52 mclareni Exp $
-*
-* $Log: rot.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:52 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE ROT (A,TH,B)
-C
-C CERN PROGLIB# F118 ROT .VERSION KERNFOR 1.0 661115
-C ORIG. 15/11/66
-C
- COMMON /SLATE/B1,B2,COSTH,SINTH,XQX(36)
- DIMENSION A(3),B(3)
-C
- COSTH= COS(TH)
- SINTH= SIN(TH)
- B1 = A(1)*COSTH - A(2)*SINTH
- B2 = A(1)*SINTH + A(2)*COSTH
- B(3)= A(3)
- B(2)= B2
- B(1)= B1
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/setfmt.F b/src/packlib/kernlib/kerngen/tcgen/setfmt.F
deleted file mode 100644
index 94977ff..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/setfmt.F
+++ /dev/null
@@ -1,67 +0,0 @@
-*
-* $Id: setfmt.F,v 1.1.1.1 1996/02/15 17:49:49 mclareni Exp $
-*
-* $Log: setfmt.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:49 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
-#if !defined(CERNLIB_TCGEN)
- SUBROUTINE SETFMT (FMTLET,FMTNUM,NDIG,XX,NX)
-C
-C CERN PROGLIB# M224 SETFMT .VERSION KERNFOR 4.08 840613
-C ORIG. 01/08/71
-C
- DIMENSION XX(9)
- INTEGER FMTLET,FMTNUM, FMTN(10),EE,EF
- DATA FMTN / 4H0 ,4H1 ,4H2 ,4H3 ,4H4 ,4H5 ,
- + 4H6 ,4H7 ,4H8 ,4H9 /
- DATA EE,EF / 4HE ,4HF /
- DATA VERYSM / 1.E-36 /
-C
-C
- XBIG= 0.
- MXV = MIN (NDIG,9)
- N = 0
-C
- DO 9 J=1,NX
- 9 XBIG = MAX (ABS(XX(J)), XBIG)
-C
- IF (XBIG .EQ. 0.) GO TO 24
- IF (XBIG .LT. VERYSM) GO TO 21
-C
-C---- NINT = NO. OF DIGITS BEFORE THE DECIMAL POINT
-C-- N = NO. OF DIGITS AFTER THE DECIMAL POINT
-C-- -NINT = NO.OF ZEROES AFTER THE DECIMAL POINT, IF PURE FRACTION
-C
- NINT = INT (LOG10(XBIG)+100.) - 99
- IF (NINT .GT. NDIG) GO TO 21
- IF (-NINT .GT. MXV-2) GO TO 21
- MXV= MIN(9, MAX(0, NDIG-MAX(0,NINT)) )
- BIAS= .25*10.**(-MXV)
- TOL = BIAS+BIAS
-C
- DO 19 J=1,NX
- X = (ABS(XX(J))+BIAS) * 10.**N
-C
- 12 IF (N .GE. MXV) GO TO 24
- X = X - AINT(X)
- IF (X .LT. TOL) GO TO 19
- TOL= 10.*TOL
- X = 10.*X
- N = N+1
- GO TO 12
- 19 CONTINUE
- GO TO 24
-C
- 21 FMTLET= EE
- N = MIN(5, NDIG-5)
- GO TO 25
-C
- 24 FMTLET= EF
- 25 FMTNUM= FMTN(N+1)
- RETURN
-C
- END
-#endif
diff --git a/src/packlib/kernlib/kerngen/tcgen/sgigs/ffsize.F b/src/packlib/kernlib/kerngen/tcgen/sgigs/ffsize.F
deleted file mode 100644
index 9381ea4..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/sgigs/ffsize.F
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: ffsize.F,v 1.1.1.1 1996/02/15 17:49:58 mclareni Exp $
-*
-* $Log: ffsize.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:58 mclareni
-* Kernlib
-*
-*
- SUBROUTINE FFSIZE (LUN,NWREC,JREC,ISTAT)
-
-C- Get the size of a disk file connected to Fortran unit LUN
-
- INTEGER FSEEK, FTELL
-
- ISTAT = FSEEK (LUN, 0, 2)
- IF (ISTAT.NE.0) RETURN
-
- NBYTES = FTELL (LUN)
- IF (NBYTES.LT.0) THEN
- ISTAT = -NBYTES
- RETURN
- ENDIF
-
- NWORDS = NBYTES / 4
- JREC = NWORDS / NWREC
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/sgigs/kerngt.F b/src/packlib/kernlib/kerngen/tcgen/sgigs/kerngt.F
deleted file mode 100644
index c2ff077..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/sgigs/kerngt.F
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: kerngt.F,v 1.1.1.1 1996/02/15 17:49:58 mclareni Exp $
-*
-* $Log: kerngt.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:58 mclareni
-* Kernlib
-*
-*
- SUBROUTINE KERNGT (LUN)
-C
-C CERN PROGLIB# Z001 KERNGT .VERSION KERNSGI 1.07 940120
-C ORIG. 16/03/89 JZ
-C
-C-- Store Pam title into /SLATE/ for printing by GSHOWF
-C
- COMMON /SLATE/ MCH(40)
- CHARACTER VIDQQ*(*)
- PARAMETER (VIDQQ = '@(#)' //
- + ' KERNSGI 1.05 940511 18.45 >')
-
- CALL CLEFT (VIDQQ,1,0)
- CALL UCTOH1 (
- + ' KERNSGI 1.05 940511 18.45 '
- +, MCH,40)
- CALL GSHOWF (LUN)
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/smxinv.F b/src/packlib/kernlib/kerngen/tcgen/smxinv.F
deleted file mode 100644
index 02de64b..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/smxinv.F
+++ /dev/null
@@ -1,94 +0,0 @@
-*
-* $Id: smxinv.F,v 1.1.1.1 1996/02/15 17:49:53 mclareni Exp $
-*
-* $Log: smxinv.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:53 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
-#if !defined(CERNLIB_TCGEN)
- SUBROUTINE SMXINV (A,NDIM,IFAIL)
-C
-C CERN PROGLIB# F107 SMXINV .VERSION KERNFOR 1.0 720503
-C ORIG. 03/05/72 CL
-C
- DIMENSION A(*),INDEX(100),RI(100)
-C
- DATA TOL / 1.E-12/
-C
- IFAIL=0
- N=NDIM
- NP1=N+1
- DO 10 I=1,N
- 10 INDEX(I)=1
-C
- DO 80 I=1,N
-C
-C-- FIND PIVOT
- PIVOT=0.
- JJ=1
- DO 20 J=1,N
- IF (INDEX(J).EQ.0) GO TO 19
- ELM=ABS (A(JJ))
- IF (ELM.LE.PIVOT) GO TO 19
- PIVOT=ELM
- K=J
- KK=JJ
- 19 JJ=JJ+NP1
- 20 CONTINUE
- IF (PIVOT/ABS(A(1)).LT.TOL) GO TO 100
- INDEX(K)=0
- PIVOT=-A(KK)
-C
-C-- ELIMINATION
- KJ=K
- NP=N
-C
- DO 70 J=1,N
- IF (J-K) 34,30,34
-C
- 30 A(KJ)=1./PIVOT
- RI(J)=0.
- NP=1
- GO TO 70
-C
- 34 ELM=-A(KJ)
- 40 RI(J)=ELM/PIVOT
- IF (ELM.EQ.0.) GO TO 50
-C
- JL=J
- DO 45 L=1,J
- A(JL)=A(JL)+ELM*RI(L)
- 45 JL=JL+N
-C
- 50 A(KJ)=RI(J)
-C
- 70 KJ=KJ+NP
-C
- 80 CONTINUE
-C
-C-- CHANGE THE SIGN AND PROVISIONAL FILL-UP
- IJ0=1
- JI0=1
- DO 95 I=1,N
- IJ=IJ0
- JI=JI0
-C
- DO 90 J=1,I
- A(IJ)=-A(IJ)
- A(JI)=A(IJ)
- IJ=IJ+N
- JI=JI+1
- 90 CONTINUE
-C
- IJ0=IJ0+1
- JI0=JI0+N
- 95 CONTINUE
- RETURN
-C
-C-- FAILURE RETURN
- 100 IFAIL=1
- RETURN
- END
-#endif
diff --git a/src/packlib/kernlib/kerngen/tcgen/sorcha.F b/src/packlib/kernlib/kerngen/tcgen/sorcha.F
deleted file mode 100644
index 6081e9a..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/sorcha.F
+++ /dev/null
@@ -1,124 +0,0 @@
-*
-* $Id: sorcha.F,v 1.1.1.1 1996/02/15 17:49:49 mclareni Exp $
-*
-* $Log: sorcha.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:49 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE SORCHA (A,ICH1,ICH2,NPOINT,ITYPE)
-C
-C CERN PROGLIB# M104 SORCHA .VERSION KERNFOR 4.08 840613
-C ORIG. 29/05/84 H.RENSHALL/CERN
-C
-C FORTRAN 77 SUBROUTINE TO DO SLOW LINEAR SORT OF A CHARACTER ARRAY
-C INTO ITSELF IN ASCENDING OR DESCENDING ORDER USING EITHER THE
-C LOGICAL COLLATION SEQUENCE FUNCTIONS (LLE,LGE) OR THE RELATIONAL
-C FUNCTIONS (LE,GE). ON CDC AND VAX THE RESULTS ARE THE SAME AND
-C MATCH THE COLLATION SEQUENCE ORDERING ON IBM IN WHICH BLANK IS
-C LESS THAN NUMBERS WHICH ARE LESS THAN LETTERS. THE SORT MAY BE
-C DONE ON ARRAYS OF UP TO LENGTH 256 CHARACTERS PER ARRAY ELEMENT
-C AND MAY BE DONE ON ANY POSITIONS IN THE CHARACTER FIELD.
-C
-C A = INPUT CHARACTER ARRAY OF DIMENSION NPOINT TO BE SORTED.
-C MAXIMUM LENGTH OF A IS CHARACTER*256
-C ICH1 = FIRST CHARACTER POSTION IN EACH ELEMENT OF A
-C OF THE FIELD TO BE SORTED
-C ICH2 = LAST CHARACTER POSITION IN EACH ELEMENT OF A
-C OF THE FIELD TO BE SORTED
-C NPOINT= THE FIRST NPOINT ELEMENTS OF A WILL BE SORTED INTO THEMSELVES
-C ITYPE = INTEGER BETWEEN 1 AND 4 CONTROLLING THE TYPE OF SORT.
-C 1 = ASCENDING SORT (A(1) WILL BE LOWER THAN A(2))
-C USING COLLATING SEQUENCE
-C 2 = DESCENDING SORT (A(2) WILL BE LOWER THAN A(1))
-C USING COLLATING SEQUENCE
-C 3 = ASCENDING SORT (A(1) WILL BE LOWER THAN A(2))
-C USING RELATIONAL SEQUENCE
-C 4 = DESCENDING SORT (A(2) WILL BE LOWER THAN A(1))
-C USING RELATIONALIEQUENCE
-C FOR PORTABLE RESULTS ITYPE= 1 OR 2 SHOULD BE USED.
-C ON SOME MACHINES (CDC/FTN5 AND VAX/VMS) RESULTS
-C ARE THE SAME AS ITYPE= 3 OR 4. NOTE THAT ITYPE= 3 OR 4
-C MAY BE SUBSTANTIALLY FASTER THAN ITYPE= 1 OR 2.
-C
- CHARACTER*(*) A(NPOINT),STORE*256
- LENA= LEN(A(1))
- GO TO (5,25,45,75),ITYPE
- 5 CONTINUE
-C
-C ASCENDING COLLATION SEQUENCE SORT USING LLE FUNCTION
-C ON MOST MACHINES THIS IS THE ASCII ORDER WHERE
-C BLANK IS LESS THAN NUMBERS IS LESS THAN LETTERS
-C THIS IS TRUE ON IBM/FACOM COMPILER, CDC/FTN5 AND VAX/VMS.
-C
- DO 20 I=1,NPOINT-1
- IPOINT= I
- STORE(1:LENA)= A(I)
- DO 10 J=I+1,NPOINT
- IF(LLE(A(I)(ICH1:ICH2),A(J)(ICH1:ICH2))) GO TO 10
- A(I)= A(J)
- IPOINT= J
- 10 CONTINUE
- A(IPOINT)= STORE(1:LENA)
- 20 CONTINUE
- RETURN
- 25 CONTINUE
-C
-C DESCENDING COLLATION SEQUENCE SORT USING LGE FUNCTION
-C ON MOST MACHINES THIS IS THE ASCII ORDER WHERE
-C BLANK IS LESS THAN NUMBERS IS LESS THAN LETTERS
-C THIS IS TRUE ON IBM/FACOM COMPILER, CDC/FTN5 AND VAX/VMS.
-C
- DO 40 I=1,NPOINT-1
- IPOINT= I
- STORE(1:LENA)= A(I)
- DO 30 J=I+1,NPOINT
- IF(LGE(A(I)(ICH1:ICH2),A(J)(ICH1:ICH2))) GO TO 30
- A(I)= A(J)
- IPOINT= J
- 30 CONTINUE
- A(IPOINT)= STORE(1:LENA)
- 40 CONTINUE
- RETURN
- 45 CONTINUE
-C
-C ASCENDING RELATIONAL SEQUENCE SORT USING LE RELATION
-C ON MANY MACHINES THIS IS THE ASCII ORDER WHERE
-C BLANK IS LESS THAN NUMBERS IS LESS THAN LETTERS
-C THIS IS TRUE ON CDC/FTN5 AND VAX/VMS.
-C ON IBM/FACOM COMPILER HOWEVER THE EBCDIC ORDER IS USED WHERE
-C BLANK IS LESS THAN LETTERS IS LESS THAN NUMBERS
-C
- DO 60 I=1,NPOINT-1
- IPOINT= I
- STORE(1:LENA)= A(I)
- DO 50 J=I+1,NPOINT
- IF(A(I)(ICH1:ICH2).LE.A(J)(ICH1:ICH2)) GO TO 50
- A(I)= A(J)
- IPOINT= J
- 50 CONTINUE
- A(IPOINT)= STORE(1:LENA)
- 60 CONTINUE
- RETURN
- 75 CONTINUE
-C
-C DESCENDING RELATIONAL SEQUENCE SORT USING GE RELATION
-C ON MANY MACHINES THIS IS THE ASCII ORDER WHERE
-C BLANK IS LESS THAN NUMBERS IS LESS THAN LETTERS
-C THIS IS TRUE ON CDC/FTN5 AND VAX/VMS.
-C ON IBM/FACOM COMPILER HOWEVER THE EBCDIC ORDER IS USED WHERE
-C BLANK IS LESS THAN LETTERS IS LESS THAN NUMBERS
-C
- DO 90 I=1,NPOINT-1
- IPOINT= I
- STORE(1:LENA)= A(I)
- DO 80 J=I+1,NPOINT
- IF(A(I)(ICH1:ICH2).GE.A(J)(ICH1:ICH2)) GO TO 80
- A(I)= A(J)
- IPOINT= J
- 80 CONTINUE
- A(IPOINT)= STORE(1:LENA)
- 90 CONTINUE
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/sortapo.F b/src/packlib/kernlib/kerngen/tcgen/sortapo.F
deleted file mode 100644
index b676e75..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/sortapo.F
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: sortapo.F,v 1.1.1.1 1996/02/15 17:49:50 mclareni Exp $
-*
-* $Log: sortapo.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:50 mclareni
-* Kernlib
-*
-*
-* Sequence def. for SORTI, SORTD, SORTR
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QMAPO)
-#endif
diff --git a/src/packlib/kernlib/kerngen/tcgen/sortd.F b/src/packlib/kernlib/kerngen/tcgen/sortd.F
deleted file mode 100644
index c64baf8..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/sortd.F
+++ /dev/null
@@ -1,93 +0,0 @@
-*
-* $Id: sortd.F,v 1.1.1.1 1996/02/15 17:49:50 mclareni Exp $
-*
-* $Log: sortd.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:50 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QMIBMVF)
- at PROCESS DIRECTIVE('*VDIR:') VECTOR
-#endif
- SUBROUTINE SORTD(A,NC,NR,NS)
-C
-C CERN PROGLIB# M107 SORTD .VERSION KERNFOR 4.21 890323
-C ORIG. 15/11/88 FCA
-C
- DOUBLE PRECISION A(NC,NR), HMIN, HMAX, TEMP
-C
- NCS=ABS(NS)
- IF(NCS.EQ.0) GO TO 999
- IF(NCS.GT.NC) GO TO 999
- IF(NR.LE.1) GO TO 999
- IF(NS.LE.0) GO TO 31
-
-C---- Ascending order
-
- DO 30 J=1,NR-1
-#if defined(CERNLIB_QMAPO)
- LMIN = (LVSDMI(A(NCS,J),NR-J+1,NC)-1)/NC+J
-#else
- LMIN = J
- HMIN = A(NCS,J)
- DO 10 K=J+1,NR
- IF(HMIN.GT.A(NCS,K)) THEN
- HMIN = A(NCS,K)
- LMIN = K
- ENDIF
- 10 CONTINUE
-#endif
- IF(LMIN.NE.J) THEN
- DO 25 L=LMIN, J, -1
- IF(A(NCS,L).EQ.A(NCS,J)) THEN
-#if defined(CERNLIB_QMVAX)||defined(CERNLIB_QMAPO)||(defined(CERNLIB_QMIBM)&&(!defined(CERNLIB_QMIBMVF)))
- CALL USWOP(A(1,LMIN),A(1,L),2*NC)
-#else
- DO 20 K=1,NC
- TEMP = A(K,LMIN)
- A(K,LMIN) = A(K,L)
- A(K,L) = TEMP
- 20 CONTINUE
-#endif
- LMIN = L
- ENDIF
- 25 CONTINUE
- ENDIF
- 30 CONTINUE
- GO TO 999
-
-C---- Descending order
-
- 31 DO 60 J=1,NR-1
-#if defined(CERNLIB_QMAPO)
- LMAX = (LVSDMX(A(NCS,J),NR-J+1,NC)-1)/NC+J
-#else
- LMAX = J
- HMAX = A(NCS,J)
- DO 40 K=J+1,NR
- IF(HMAX.LT.A(NCS,K)) THEN
- HMAX = A(NCS,K)
- LMAX = K
- ENDIF
- 40 CONTINUE
-#endif
- IF(LMAX.NE.J) THEN
- DO 55 L=LMAX, J, -1
- IF(A(NCS,L).EQ.A(NCS,J)) THEN
-#if defined(CERNLIB_QMVAX)||defined(CERNLIB_QMAPO)||(defined(CERNLIB_QMIBM)&&(!defined(CERNLIB_QMIBMVF)))
- CALL USWOP(A(1,LMAX),A(1,L),2*NC)
-#else
- DO 50 K=1,NC
- TEMP = A(K,LMAX)
- A(K,LMAX) = A(K,L)
- A(K,L) = TEMP
- 50 CONTINUE
-#endif
- LMAX = L
- ENDIF
- 55 CONTINUE
- ENDIF
- 60 CONTINUE
- 999 RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/sorti.F b/src/packlib/kernlib/kerngen/tcgen/sorti.F
deleted file mode 100644
index a218553..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/sorti.F
+++ /dev/null
@@ -1,93 +0,0 @@
-*
-* $Id: sorti.F,v 1.1.1.1 1996/02/15 17:49:50 mclareni Exp $
-*
-* $Log: sorti.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:50 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QMIBMVF)
- at PROCESS DIRECTIVE('*VDIR:') VECTOR
-#endif
- SUBROUTINE SORTI(A,NC,NR,NS)
-C
-C CERN PROGLIB# M107 SORTI .VERSION KERNFOR 4.21 890323
-C ORIG. 15/11/88 FCA
-C
- INTEGER A(NC,NR), HMIN, HMAX, TEMP
-C
- NCS=ABS(NS)
- IF(NCS.EQ.0) GO TO 999
- IF(NCS.GT.NC) GO TO 999
- IF(NR.LE.1) GO TO 999
- IF(NS.LE.0) GO TO 31
-
-C---- Ascending order
-
- DO 30 J=1,NR-1
-#if defined(CERNLIB_QMAPO)
- LMIN = (LVSIMI(A(NCS,J),NR-J+1,NC)-1)/NC+J
-#else
- LMIN = J
- HMIN = A(NCS,J)
- DO 10 K=J+1,NR
- IF(HMIN.GT.A(NCS,K)) THEN
- HMIN = A(NCS,K)
- LMIN = K
- ENDIF
- 10 CONTINUE
-#endif
- IF(LMIN.NE.J) THEN
- DO 25 L=LMIN, J, -1
- IF(A(NCS,L).EQ.A(NCS,J)) THEN
-#if defined(CERNLIB_QMAPO)||defined(CERNLIB_QMVAX)||(defined(CERNLIB_QMIBM)&&(!defined(CERNLIB_QMIBMVF)))
- CALL USWOP(A(1,LMIN),A(1,L),NC)
-#else
- DO 20 K=1,NC
- TEMP = A(K,LMIN)
- A(K,LMIN) = A(K,L)
- A(K,L) = TEMP
- 20 CONTINUE
-#endif
- LMIN = L
- ENDIF
- 25 CONTINUE
- ENDIF
- 30 CONTINUE
- GO TO 999
-
-C---- Descending order
-
- 31 DO 60 J=1,NR-1
-#if defined(CERNLIB_QMAPO)
- LMAX = (LVSIMX(A(NCS,J),NR-J+1,NC)-1)/NC+J
-#else
- LMAX = J
- HMAX = A(NCS,J)
- DO 40 K=J+1,NR
- IF(HMAX.LT.A(NCS,K)) THEN
- HMAX = A(NCS,K)
- LMAX = K
- ENDIF
- 40 CONTINUE
-#endif
- IF(LMAX.NE.J) THEN
- DO 55 L=LMAX, J, -1
- IF(A(NCS,L).EQ.A(NCS,J)) THEN
-#if defined(CERNLIB_QMAPO)||defined(CERNLIB_QMVAX)||(defined(CERNLIB_QMIBM)&&(!defined(CERNLIB_QMIBMVF)))
- CALL USWOP(A(1,LMAX),A(1,L),NC)
-#else
- DO 50 K=1,NC
- TEMP = A(K,LMAX)
- A(K,LMAX) = A(K,L)
- A(K,L) = TEMP
- 50 CONTINUE
-#endif
- LMAX = L
- ENDIF
- 55 CONTINUE
- ENDIF
- 60 CONTINUE
- 999 RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/sortibm.F b/src/packlib/kernlib/kerngen/tcgen/sortibm.F
deleted file mode 100644
index 19acbbb..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/sortibm.F
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: sortibm.F,v 1.1.1.1 1996/02/15 17:49:50 mclareni Exp $
-*
-* $Log: sortibm.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:50 mclareni
-* Kernlib
-*
-*
-* Sequence def. for SORTI, SORTD, SORTR
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QMIBM)
-#endif
diff --git a/src/packlib/kernlib/kerngen/tcgen/sortr.F b/src/packlib/kernlib/kerngen/tcgen/sortr.F
deleted file mode 100644
index de4366b..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/sortr.F
+++ /dev/null
@@ -1,93 +0,0 @@
-*
-* $Id: sortr.F,v 1.1.1.1 1996/02/15 17:49:50 mclareni Exp $
-*
-* $Log: sortr.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:50 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QMIBMVF)
- at PROCESS DIRECTIVE('*VDIR:') VECTOR
-#endif
- SUBROUTINE SORTR(A,NC,NR,NS)
-C
-C CERN PROGLIB# M107 SORTR .VERSION KERNFOR 4.21 890323
-C ORIG. 15/11/88 FCA
-C
- DIMENSION A(NC,NR)
-C
- NCS=ABS(NS)
- IF(NCS.EQ.0) GO TO 999
- IF(NCS.GT.NC) GO TO 999
- IF(NR.LE.1) GO TO 999
- IF (NS.LE.0) GO TO 31
-
-C---- Ascending order
-
- DO 30 J=1,NR-1
-#if defined(CERNLIB_QMAPO)
- LMIN = (LVSMI(A(NCS,J),NR-J+1,NC)-1)/NC+J
-#else
- LMIN = J
- HMIN = A(NCS,J)
- DO 10 K=J+1,NR
- IF(HMIN.GT.A(NCS,K)) THEN
- HMIN = A(NCS,K)
- LMIN = K
- ENDIF
- 10 CONTINUE
-#endif
- IF(LMIN.NE.J) THEN
- DO 25 L=LMIN, J, -1
- IF(A(NCS,L).EQ.A(NCS,J)) THEN
-#if defined(CERNLIB_QMVAX)||defined(CERNLIB_QMAPO)||(defined(CERNLIB_QMIBM)&&(!defined(CERNLIB_QMIBMVF)))
- CALL USWOP(A(1,LMIN),A(1,L),NC)
-#else
- DO 20 K=1,NC
- TEMP = A(K,LMIN)
- A(K,LMIN) = A(K,L)
- A(K,L) = TEMP
- 20 CONTINUE
-#endif
- LMIN = L
- ENDIF
- 25 CONTINUE
- ENDIF
- 30 CONTINUE
- GO TO 999
-
-C---- Descending order
-
- 31 DO 60 J=1,NR-1
-#if defined(CERNLIB_QMAPO)
- LMAX = (LVSMX(A(NCS,J),NR-J+1,NC)-1)/NC+J
-#else
- LMAX = J
- HMAX = A(NCS,J)
- DO 40 K=J+1,NR
- IF(HMAX.LT.A(NCS,K)) THEN
- HMAX = A(NCS,K)
- LMAX = K
- ENDIF
- 40 CONTINUE
-#endif
- IF(LMAX.NE.J) THEN
- DO 55 L=LMAX, J, -1
- IF(A(NCS,L).EQ.A(NCS,J)) THEN
-#if defined(CERNLIB_QMVAX)||defined(CERNLIB_QMAPO)||(defined(CERNLIB_QMIBM)&&(!defined(CERNLIB_QMIBMVF)))
- CALL USWOP(A(1,LMAX),A(1,L),NC)
-#else
- DO 50 K=1,NC
- TEMP = A(K,LMAX)
- A(K,LMAX) = A(K,L)
- A(K,L) = TEMP
- 50 CONTINUE
-#endif
- LMAX = L
- ENDIF
- 55 CONTINUE
- ENDIF
- 60 CONTINUE
- 999 RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/sortvax.F b/src/packlib/kernlib/kerngen/tcgen/sortvax.F
deleted file mode 100644
index d73b773..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/sortvax.F
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: sortvax.F,v 1.1.1.1 1996/02/15 17:49:50 mclareni Exp $
-*
-* $Log: sortvax.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:50 mclareni
-* Kernlib
-*
-*
-* Sequence def. for SORTI, SORTD, SORTR
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QMVAX)
-#endif
diff --git a/src/packlib/kernlib/kerngen/tcgen/sortx.F b/src/packlib/kernlib/kerngen/tcgen/sortx.F
deleted file mode 100644
index 4119fdb..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/sortx.F
+++ /dev/null
@@ -1,104 +0,0 @@
-*
-* $Id: sortx.F,v 1.1.1.1 1996/02/15 17:49:50 mclareni Exp $
-*
-* $Log: sortx.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:50 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
-#if !defined(CERNLIB_TCGEN)
- SUBROUTINE SORTX(MX,NC,NR,NCS,NK)
-C
-C CERN PROGLIB# M106 SORTX .VERSION KERNFOR 1.0 661115
-C ORIG. 15/11/66 CL
-C
- DIMENSION MX(2),NK(2,2)
- COMMON/SLATE/I,I1,I2,I3,IC,IR,ICMX,N1,N2,N3,N4,N5,NKI,NKI1,NKI2,
- 1 NCSORT,NRM1,INK,JNK,NHELP,NKIP1,XQX(19)
-C
- NCSORT=IABS(NCS)
- IF(NR.LE.1.OR.NCSORT.GT.NC.OR.NCSORT.LE.0) GO TO 1000
- NK(1,1)=NCSORT
- DO 1 I=2,NR
- 1 NK(1,I)=NK(1,I-1)+NC
- I3=0
- NRM1=NR-1
- INK=1
-C
-C-- MAIN PROGRAM (PASSES N1,N2, AND N3 TO MERGE)
-C
- 100 JNK=3-INK
- N3=0
-C
- 101 N1=N3+1
- IF(N1.GT.NRM1) GO TO 113
- DO 103 I=N1,NRM1
- NKI=NK(INK,I)
- NKIP1=NK(INK,I+1)
- IF (MX(NKIP1).LT.MX(NKI)) GO TO 104
- 103 CONTINUE
- 113 N3=NR
- N4=N1
- N5=NR
- GO TO 206
-C
- 104 N2=I+1
- IF (N2.GT.NRM1) GO TO 116
- DO 106 I=N2,NRM1
- NKI=NK(INK,I)
- NKIP1=NK(INK,I+1)
- IF(MX(NKIP1).LT.MX(NKI)) GO TO 107
- 106 CONTINUE
- 116 I=NR
-C
- 107 N3=I
-C
-C-- MERGE SEQUENCE (STRINGS N1-(N2-1), N2-N3)
-C
- I1=N1
- I2=N2
- DO 203 I3=N1,N3
- NKI1=NK(INK,I1)
- NKI2=NK(INK,I2)
- IF(MX(NKI2).LT.MX(NKI1)) GO TO 202
- NK(JNK,I3)=NKI1
- I1=I1+1
- IF(N2-I1) 204,204,203
- 202 NK(JNK,I3)=NKI2
- I2=I2+1
- IF ((N3+1).LE.I2) GO TO 205
- 203 CONTINUE
- GO TO 208
-C
- 204 N4=I2
- N5=N3
- GO TO 206
-C
- 205 N4=I1
- N5=N2-1
- 206 DO 207 I=N4,N5
- I3=I3+1
- 207 NK(JNK,I3)=NK(INK,I)
- IF(NR.GT.N3) GO TO 101
- 208 INK=JNK
- IF (N1.NE.1) GO TO 100
-C
-C-- FINAL PERMUTATION PROGRAM
-C
- JNK=3-INK
- DO 302 IC=1,NC
- DO 301 IR=1,NR
- ICMX=NK(INK,IR)+IC-NCSORT
- 301 NK(JNK,IR)=MX(ICMX)
- ICMX=IC
- DO 302 IR=1,NR
- IF (NCS.GE.0) GO TO 303
- NHELP=NR-IR+1
- MX(ICMX)=NK(JNK,NHELP)
- GO TO 302
- 303 MX(ICMX)=NK(JNK,IR)
- 302 ICMX=ICMX+NC
- 1000 RETURN
- END
-#endif
diff --git a/src/packlib/kernlib/kerngen/tcgen/sortzv.F b/src/packlib/kernlib/kerngen/tcgen/sortzv.F
deleted file mode 100644
index e2ddcd0..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/sortzv.F
+++ /dev/null
@@ -1,186 +0,0 @@
-*
-* $Id: sortzv.F,v 1.1.1.1 1996/02/15 17:49:50 mclareni Exp $
-*
-* $Log: sortzv.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:50 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE SORTZV (A,INDEX,N1,MODE,NWAY,NSORT)
-C
-C CERN PROGLIB# M101 SORTZV .VERSION KERNFOR 3.15 820113
-C ORIG. 02/10/75
-C
- DIMENSION A(N1),INDEX(N1)
-C
-C
- N = N1
- IF (N.LE.0) RETURN
- IF (NSORT.NE.0) GO TO 2
- DO 1 I=1,N
- 1 INDEX(I)=I
-C
- 2 IF (N.EQ.1) RETURN
- IF (MODE) 10,20,30
- 10 CALL SORTTI (A,INDEX,N)
- GO TO 40
-C
- 20 CALL SORTTC(A,INDEX,N)
- GO TO 40
-C
- 30 CALL SORTTF (A,INDEX,N)
-C
- 40 IF (NWAY.EQ.0) GO TO 50
- N2 = N/2
- DO 41 I=1,N2
- ISWAP = INDEX(I)
- K = N+1-I
- INDEX(I) = INDEX(K)
- 41 INDEX(K) = ISWAP
- 50 RETURN
- END
-* ========================================
- SUBROUTINE SORTTF (A,INDEX,N1)
-C
- DIMENSION A(N1),INDEX(N1)
-C
- N = N1
- DO 3 I1=2,N
- I3 = I1
- I33 = INDEX(I3)
- AI = A(I33)
- 1 I2 = I3/2
- IF (I2) 3,3,2
- 2 I22 = INDEX(I2)
- IF (AI.LE.A (I22)) GO TO 3
- INDEX (I3) = I22
- I3 = I2
- GO TO 1
- 3 INDEX (I3) = I33
- 4 I3 = INDEX (N)
- INDEX (N) = INDEX (1)
- AI = A(I3)
- N = N-1
- IF (N-1) 12,12,5
- 5 I1 = 1
- 6 I2 = I1 + I1
- IF (I2.LE.N) I22= INDEX(I2)
- IF (I2-N) 7,9,11
- 7 I222 = INDEX (I2+1)
- IF (A(I22)-A(I222)) 8,9,9
- 8 I2 = I2+1
- I22 = I222
- 9 IF (AI-A(I22)) 10,11,11
- 10 INDEX(I1) = I22
- I1 = I2
- GO TO 6
- 11 INDEX (I1) = I3
- GO TO 4
- 12 INDEX (1) = I3
- RETURN
- END
-* ========================================
- SUBROUTINE SORTTI (A,INDEX,N1)
-C
- INTEGER A,AI
- DIMENSION A(N1),INDEX(N1)
-C
- N = N1
- DO 3 I1=2,N
- I3 = I1
- I33 = INDEX(I3)
- AI = A(I33)
- 1 I2 = I3/2
- IF (I2) 3,3,2
- 2 I22 = INDEX(I2)
- IF (AI.LE.A (I22)) GO TO 3
- INDEX (I3) = I22
- I3 = I2
- GO TO 1
- 3 INDEX (I3) = I33
- 4 I3 = INDEX (N)
- INDEX (N) = INDEX (1)
- AI = A(I3)
- N = N-1
- IF (N-1) 12,12,5
- 5 I1 = 1
- 6 I2 = I1 + I1
- IF (I2.LE.N) I22= INDEX(I2)
- IF (I2-N) 7,9,11
- 7 I222 = INDEX (I2+1)
- IF (A(I22)-A(I222)) 8,9,9
- 8 I2 = I2+1
- I22 = I222
- 9 IF (AI-A(I22)) 10,11,11
- 10 INDEX(I1) = I22
- I1 = I2
- GO TO 6
- 11 INDEX (I1) = I3
- GO TO 4
- 12 INDEX (1) = I3
- RETURN
- END
-* ========================================
- SUBROUTINE SORTTC (A,INDEX,N1)
-C
- INTEGER A,AI
- DIMENSION A(N1),INDEX(N1)
-C
- N = N1
- DO 3 I1=2,N
- I3 = I1
- I33 = INDEX(I3)
- AI = A(I33)
- 1 I2 = I3/2
- IF (I2) 3,3,2
- 2 I22 = INDEX(I2)
- IF(ICMPCH(AI,A(I22)))3,3,21
- 21 INDEX (I3) = I22
- I3 = I2
- GO TO 1
- 3 INDEX (I3) = I33
- 4 I3 = INDEX (N)
- INDEX (N) = INDEX (1)
- AI = A(I3)
- N = N-1
- IF (N-1) 12,12,5
- 5 I1 = 1
- 6 I2 = I1 + I1
- IF (I2.LE.N) I22= INDEX(I2)
- IF (I2-N) 7,9,11
- 7 I222 = INDEX (I2+1)
- IF (ICMPCH(A(I22),A(I222))) 8,9,9
- 8 I2 = I2+1
- I22 = I222
- 9 IF (ICMPCH(AI,A(I22))) 10,11,11
- 10 INDEX(I1) = I22
- I1 = I2
- GO TO 6
- 11 INDEX (I1) = I3
- GO TO 4
- 12 INDEX (1) = I3
- RETURN
- END
-* ========================================
- FUNCTION ICMPCH(IC1,IC2)
-C FUNCTION TO COMPARE TWO 4 CHARACTER EBCDIC STRINGS - IC1,IC2
-C ICMPCH=-1 IF HEX VALUE OF IC1 IS LESS THAN IC2
-C ICMPCH=0 IF HEX VALUES OF IC1 AND IC2 ARE THE SAME
-C ICMPCH=+1 IF HEX VALUES OF IC1 IS GREATER THAN IC2
- I1=IC1
- I2=IC2
- IF(I1.GE.0.AND.I2.GE.0)GOTO 40
- IF(I1.GE.0)GOTO 60
- IF(I2.GE.0)GOTO 80
- I1=-I1
- I2=-I2
- IF(I1-I2)80,70,60
- 40 IF(I1-I2)60,70,80
- 60 ICMPCH=-1
- RETURN
- 70 ICMPCH=0
- RETURN
- 80 ICMPCH=1
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/sungs/ffsize.F b/src/packlib/kernlib/kerngen/tcgen/sungs/ffsize.F
deleted file mode 100644
index 4a88373..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/sungs/ffsize.F
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: ffsize.F,v 1.2 1996/04/02 23:16:08 thakulin Exp $
-*
-* $Log: ffsize.F,v $
-* Revision 1.2 1996/04/02 23:16:08 thakulin
-* Add support for Apogee Fortran.
-*
-* Revision 1.1.1.1 1996/02/15 17:49:58 mclareni
-* Kernlib
-*
-*
- SUBROUTINE FFSIZE (LUN,NWREC,JREC,ISTAT)
-
-C- Get the size of a disk file connected to Fortran unit LUN
-
-#ifdef CERNLIB_QFAPOGEE
-
-C- This is the method we have to use for Apogee compilers
-
- INTEGER APOFSZ
-
- INQUIRE(UNIT=LUN,NAME=FNAME)
- ISTAT = APOFSZ(FNAME,NBYTES)
- IF (ISTAT.NE.0) RETURN
-#else
- INTEGER FSEEK, FTELL
-
- ISTAT = FSEEK (LUN, 0, 2)
- IF (ISTAT.NE.0) RETURN
-
- NBYTES = FTELL (LUN)
-#endif
- IF (NBYTES.LT.0) THEN
- ISTAT = -NBYTES
- RETURN
- ENDIF
-
- NWORDS = NBYTES / 4
- JREC = NWORDS / NWREC
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/sungs/floarg.F b/src/packlib/kernlib/kerngen/tcgen/sungs/floarg.F
deleted file mode 100644
index ece7d5c..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/sungs/floarg.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: floarg.F,v 1.1.1.1 1996/02/15 17:49:58 mclareni Exp $
-*
-* $Log: floarg.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:58 mclareni
-* Kernlib
-*
-*
- FUNCTION FLOARG (ARGM)
-C
-C CERN PROGLIB# M250 FLOARG .VERSION KERNSUN 1.00 880922
-C ORIG. 22/09/88, JZ
-C
-C
- DIMENSION ARGM(9)
- EQUIVALENCE (A,IA)
-C
-C
- A = ARGM(1)
- JCH = RSHIFT (IA,23)
- IF (JCH.EQ.0) GO TO 36
- IF (JCH.EQ.-1) GO TO 36
- FLOARG = A
- RETURN
-C
- 36 FLOARG = IA
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/sungs/incbyt.F b/src/packlib/kernlib/kerngen/tcgen/sungs/incbyt.F
deleted file mode 100644
index 72939a5..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/sungs/incbyt.F
+++ /dev/null
@@ -1,45 +0,0 @@
-*
-* $Id: incbyt.F,v 1.1.1.1 1996/02/15 17:49:58 mclareni Exp $
-*
-* $Log: incbyt.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:58 mclareni
-* Kernlib
-*
-*
- FUNCTION INCBYT (INCP,IA,JTHP,NBITS)
-C
-C CERN PROGLIB# M423 INCBYT .VERSION KERNSUN 1.06 920511
-C ORIG. 22/09/88, JZ
-C
- DIMENSION INCP(9),IA(99),JTHP(9),NBITS(3)
-
- INC = INCP(1)
- JTH = JTHP(1)
- NZB = NBITS(1)
- NPW = NBITS(2)
- NPB = NBITS(3)
-
- INCBYT = 0
-
- JWORD= (JTH-1)/NPW + 1
- JPOS = JTH - (JWORD-1)*NPW
- NL = (JPOS-1)*NZB
-#if defined(CERNLIB_BUGLRSHFT)
- MASK = LSHIFT (ishft(-1,NZB-32),NL)
- IZW = IA(JWORD)
- NEW = INC + ishft (AND(MASK,IZW), -NL)
-#endif
-#if !defined(CERNLIB_BUGLRSHFT)
- MASK = LSHIFT (lrshft(-1,32-NZB),NL)
- IZW = IA(JWORD)
- NEW = INC + lrshft (AND(MASK,IZW), NL)
-#endif
- IF (NEW.GT.NPB) GO TO 21
- 17 IA(JWORD) = OR (AND(NOT(MASK),IZW), LSHIFT(NEW,NL))
- RETURN
-C
- 21 INCBYT = NEW - NPB
- IF (INCBYT.EQ.INC) RETURN
- NEW = NPB
- GO TO 17
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/sungs/intarg.F b/src/packlib/kernlib/kerngen/tcgen/sungs/intarg.F
deleted file mode 100644
index dd15216..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/sungs/intarg.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: intarg.F,v 1.1.1.1 1996/02/15 17:49:58 mclareni Exp $
-*
-* $Log: intarg.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:58 mclareni
-* Kernlib
-*
-*
- FUNCTION INTARG (ARGM)
-C
-C CERN PROGLIB# M250 INTARG .VERSION KERNSUN 1.00 880922
-C ORIG. 22/09/88, JZ
-C
-C
- DIMENSION ARGM(9)
- EQUIVALENCE (A,IA)
-C
-C
- A = ARGM(1)
- JCH = RSHIFT (IA,23)
- IF (JCH.EQ.0) GO TO 36
- IF (JCH.EQ.-1) GO TO 36
- INTARG = A
- RETURN
-C
- 36 INTARG = IA
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/sungs/iuforw.F b/src/packlib/kernlib/kerngen/tcgen/sungs/iuforw.F
deleted file mode 100644
index fa39101..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/sungs/iuforw.F
+++ /dev/null
@@ -1,39 +0,0 @@
-*
-* $Id: iuforw.F,v 1.1.1.1 1996/02/15 17:49:58 mclareni Exp $
-*
-* $Log: iuforw.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:58 mclareni
-* Kernlib
-*
-*
- FUNCTION IUFORW (IC,JL,JR)
-C
-C CERN PROGLIB# M410 IUFORW .VERSION KERNSUN 1.06 920511
-C ORIG. 22/09/88, JZ
-C
- DIMENSION IC(99)
- COMMON /SLATE/ ND,JEND, DUMMY(38)
-
- ND = 0
- JEND = JL
- IVAL = 0
-
- 12 IF (JEND.GT.JR) GO TO 20
-#if defined(CERNLIB_BUGLRSHFT)
- K = ishft (IC(JEND),-24)
-#endif
-#if !defined(CERNLIB_BUGLRSHFT)
- K = lrshft (IC(JEND),24)
-#endif
- IF (K.EQ.32) GO TO 19
- IF (K.GE.58) GO TO 20
- K = K - 48
- IF (K.LT.0) GO TO 20
- IVAL = 10*IVAL + K
- ND = ND + 1
- 19 JEND = JEND + 1
- GO TO 12
-
- 20 IUFORW = IVAL
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/sungs/iumode.F b/src/packlib/kernlib/kerngen/tcgen/sungs/iumode.F
deleted file mode 100644
index cd0c093..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/sungs/iumode.F
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: iumode.F,v 1.1.1.1 1996/02/15 17:49:58 mclareni Exp $
-*
-* $Log: iumode.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:58 mclareni
-* Kernlib
-*
-*
- FUNCTION IUMODE (IWORD)
-C
-C CERN PROGLIB# M506 IUMODE .VERSION KERNSUN 1.00 880922
-C ORIG. 22/09/88, JZ
-C
-C
- J = RSHIFT (IWORD,23)
- IF (J.EQ.-1) J=0
-C
- IUMODE= J
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/sungs/kerngt.F b/src/packlib/kernlib/kerngen/tcgen/sungs/kerngt.F
deleted file mode 100644
index 553e548..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/sungs/kerngt.F
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: kerngt.F,v 1.1.1.1 1996/02/15 17:49:58 mclareni Exp $
-*
-* $Log: kerngt.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:58 mclareni
-* Kernlib
-*
-*
- SUBROUTINE KERNGT (LUN)
-C
-C CERN PROGLIB# Z001 KERNGT .VERSION KERNSUN 1.06 920511
-C ORIG. 16/03/89 JZ
-C
-C-- Store Pam title into /SLATE/ for printing by GSHOWF
-C
- COMMON /SLATE/ MCH(40)
- CHARACTER VIDQQ*(*)
- PARAMETER (VIDQQ = '@(#)' //
- + 'KERNSUN 1.11 1995/09/28 19.14 >')
-
- CALL CLEFT (VIDQQ,1,0)
- CALL UCTOH1 (
- + 'KERNSUN 1.11 1995/09/28 19.14 '
- +, MCH,40)
- CALL GSHOWF (LUN)
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/sungs/locbyt.F b/src/packlib/kernlib/kerngen/tcgen/sungs/locbyt.F
deleted file mode 100644
index 0c2be62..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/sungs/locbyt.F
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: locbyt.F,v 1.1.1.1 1996/02/15 17:49:58 mclareni Exp $
-*
-* $Log: locbyt.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:58 mclareni
-* Kernlib
-*
-*
- FUNCTION LOCBYT (IT,IA,N,NW,LA,NBITS)
-C
-C CERN PROGLIB# M428 LOCBYT .VERSION KERNSUN 1.06 920511
-C ORIG. 22/09/88, JZ
-C
- DIMENSION IA(9)
-C
-C
- IF (N.EQ.0) GO TO 19
-#if defined(CERNLIB_BUGLRSHFT)
- MASK = LSHIFT (ishft(-1,-32+NBITS),LA-1)
-#endif
-#if !defined(CERNLIB_BUGLRSHFT)
- MASK = LSHIFT (lrshft(-1,32-NBITS),LA-1)
-#endif
- ITSH = LSHIFT (IT,LA-1)
-
- DO 18 J=1,N,NW
- IF (AND(IA(J),MASK).EQ.ITSH) GO TO 21
- 18 CONTINUE
- 19 LOCBYT= 0
- RETURN
-C
- 21 LOCBYT= J
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/tcdump.F b/src/packlib/kernlib/kerngen/tcgen/tcdump.F
deleted file mode 100644
index 1cf61cc..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/tcdump.F
+++ /dev/null
@@ -1,74 +0,0 @@
-*
-* $Id: tcdump.F,v 1.1.1.1 1996/02/15 17:49:50 mclareni Exp $
-*
-* $Log: tcdump.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:50 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE TCDUMP (LABEL,IA,NW,IND)
-C
-C CERN PROGLIB# N203 TCDUMP .VERSION KERNFOR 3.14 811130
-C ORIG. 01/08/69
-C
- DIMENSION IA(99),IFM(3),IDN(3)
-C
-C
- CALL UBLOW ( IND,IDN,3)
- CALL UBLOW (3HIFH,IFM,3)
- DO 12 J=1,3
- IF (IUCOMP(IFM(J),IDN,3).EQ.0) IFM(J)=0
- 12 CONTINUE
-C
- PRINT 9020,LABEL
- JB= 0
- LBASE=LOCF(IA(1)) -1
-C
- 20 JA= JB+1
- N=IUSAME (IA,JA,NW,5,LOC)
- IF (LOC.GT.JA) GO TO 30
-C
-C---- NEXT LINE
- 25 NL=N/5
- N5=5*NL
- JB= JA+N5-1
- LOCFF=LBASE + JA
- PRINT 9024, LOCFF,JA,JA,JB,IA(JA),N5,NL
- IF (JB.LT.NW) GO TO 20
- RETURN
-C
-C-- DUMP 5 WORDS
- 30 JB= MIN(JA+4,NW)
- LOCFF=LBASE + JA
- PRINT 9030,LOCFF,JA,JA,(IA(J),J=JA,JB)
- IF (IFM(1).NE.0) PRINT 9031, (IA(J),J=JA,JB)
- IF (IFM(2).NE.0) PRINT 9032, (IA(J),J=JA,JB)
- IF (IFM(3).NE.0) PRINT 9033, (IA(J),J=JA,JB)
-C
- JA=JB+1
- IF (JA.LT.LOC) GO TO 30
- IF (JB.EQ.NW) RETURN
- N=N+LOC-JA
- IF (N.LT.5) GO TO 20
- GO TO 25
-C
- 9020 FORMAT (5H0DUMP,A12,5X,30(1H-))
-#if !defined(CERNLIB_HEX)
- 9024 FORMAT(1X,O6,2X,O5,I6,8H UNTIL,I6,14X,11HALL CONTAIN,O24,11X,
- + I5,6H WORDS,I5,6H LINES/1X)
-#endif
-#if defined(CERNLIB_HEX)
- 9024 FORMAT(1X,Z6,2X,Z5,I6,8H UNTIL,I6,14X,11HALL CONTAIN,Z24,11X,
- + I5,6H WORDS,I5,6H LINES/1X)
-#endif
-#if !defined(CERNLIB_HEX)
- 9030 FORMAT (1X,O6,2X,O5,I6,5O21)
-#endif
-#if defined(CERNLIB_HEX)
- 9030 FORMAT (1X,Z6,2X,Z5,I6,5Z21)
-#endif
- 9031 FORMAT (20X,5(11X,I10))
- 9032 FORMAT (20X,5E21.6)
- 9033 FORMAT (10X,5A21)
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/tlerr.F b/src/packlib/kernlib/kerngen/tcgen/tlerr.F
deleted file mode 100644
index dbbb727..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/tlerr.F
+++ /dev/null
@@ -1,119 +0,0 @@
-*
-* $Id: tlerr.F,v 1.1.1.1 1996/02/15 17:49:53 mclareni Exp $
-*
-* $Log: tlerr.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:53 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE TLERR (A,X,AUX,IPIV)
-C
-C CERN PROGLIB# E230 TLERR .VERSION KERNFOR 2.06 740511
-C ORIG. 11/05/74 WH+WM
-C
-C. SUBROUTINE TLERR L.S. ERROR MATRIX HART/MATT
-C.
-C. CALCULATES INVERSE OF (A-TRANSPOSED*A) DIRECTLY FROM THE
-C. TRIANGULARISED TRANSFORM OF A.
-C. ARGUMENTS
-C. A,X,AUX,IPIV,(M1,M,N,L,IER) DEFINED AS FOR TLSC WITH X THE
-C. COVARIANCE MATRIX. MATRIX X MAY OVERWRITE MATRIX A.
-C. REMARKS
-C. CONSTRAINED AND UNCONSTRAINED VERSION COMBINED
-C.
-C.-------------------------------------------------------------------
-C
- COMMON /TLSDIM/ M1,M,N,L,IER
- COMMON /SLATE/ BETA,H,I,IA,ID,IEND,II,IK,IL,IST,J,JA,JD,JK,JL
- + ,K,KN,KS,K1,LV,NK,PIV,SIG,DUM(17)
- DIMENSION A(*), AUX(*), IPIV(*), X(*)
-C
- K1 = MAX (N,L)
- IF (IABS (IER).EQ.N) GO TO 5
-C--
-C-- COMPLETE HOUSEHOLDER TRANSFORMATION IF IER LESS THAN N.
-C
- IST = IER * (N+1) + 1
- KS = IER + 1
-C
- DO 4 K=KS,N
- LV = M - K + 1
-C
-C-- GENERATE VECTOR UK AND TRANSFORMATION PARAMETER BETA.
-C
- CALL TLUK (A(IST),N,LV,SIG,BETA)
- J = K1 + K
- AUX(J) = -SIG
- IF (K.EQ.N) GO TO 4
-C
-C-- TRANSFORMATION OF MATRIX A.
-C--
- NK = N - K
- IF (LV.EQ.1) GO TO 2
- CALL TLSTEP (A(IST),A(IST+1),N,N,LV,NK,BETA)
- GO TO 4
- 2 DO 3 J=1,NK
- JST = IST + J
- 3 A(JST) = A(JST)*(1.-BETA*A(IST)**2)
- IST = IST + N + 1
- 4 IPIV(K) = K
-C
-C
-C-- COMPUTE X FROM A AND DIAGONAL ELEMENTS OF A-TRANSPOSED.
-C
- 5 DO 40 K=1,N
- KN = N-K+1
- IA = (KN-1)*( N+1)+1
- IK = KN *N
- IL = N*N - K + 1
- II = KN + K1
- PIV=1./AUX(II)
- ID = IPIV(KN)-KN
- JA = IA+1
- JK = IK
- JL = IL
-C
- DO 20 J=1,K
- H=0.
- IF (J.EQ.K .AND. J.LE.N-M1) H = PIV
- IF (K.EQ.1) GO TO 15
- II = JK
-C
- DO 10 I=JA,IK
- II=II+N
- 10 H = H-A(I)*X(II)
-C
- 15 H = H*PIV
- X(JL) = H
- JK = JK - 1
- 20 JL = JL - N
-C
-C-- COMPLETE SYMMETRIC PART.
-C
- IF (K.EQ.1) GO TO 40
- JL = IA
- DO 25 J=JA,IK
- JL = JL + N
- 25 X(J) = X(JL)
-C
-C-- INTERCHANGE OF ROWS AND COLUMNS ALREADY FINISHED.
-C
- IF (ID.EQ.0) GO TO 40
- DO 30 J=IA,IL,N
- II = J + ID
- H = X(II)
- X(II) = X(J)
- 30 X(J) = H
-C
- ID = ID*N
- DO 35 J=IA,IK
- II = J + ID
- H = X(II)
- X(II) = X(J)
- 35 X(J) = H
-C
- 40 CONTINUE
-C
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/tlpiv.F b/src/packlib/kernlib/kerngen/tcgen/tlpiv.F
deleted file mode 100644
index 39f42fd..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/tlpiv.F
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: tlpiv.F,v 1.1.1.1 1996/02/15 17:49:53 mclareni Exp $
-*
-* $Log: tlpiv.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:53 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE TLPIV(A,B,IASEP,IBSEP,M,H,G)
-C
-C CERN PROGLIB# E230 TLPIV .VERSION KERNFOR 2.06 740511
-C ORIG. 11/05/74 WH+WM
-C
-C. SUBROUTINE TLPIV (A,B,IASEP,IBSEP,M,H,G)
-C.
-C. CALCULATES PIVOTING FACTORS FOR TLS
-C.
-C.-------------------------------------------------------------------
-C
- COMMON /SLATE/ DUM(37),I,JA,JB
- DIMENSION A(*),B(*)
-C
- H=0.0
- G=0.0
- JA=1
- JB=1
- DO 2 I=1,M
- G=G+A(JA)*B(JB)
- H=H+A(JA)*A(JA)
- JA=JA+IASEP
- 2 JB=JB+IBSEP
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/tlres.F b/src/packlib/kernlib/kerngen/tcgen/tlres.F
deleted file mode 100644
index b4823be..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/tlres.F
+++ /dev/null
@@ -1,55 +0,0 @@
-*
-* $Id: tlres.F,v 1.1.1.1 1996/02/15 17:49:53 mclareni Exp $
-*
-* $Log: tlres.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:53 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE TLRES (A,B,AUX)
-C
-C CERN PROGLIB# E230 TLRES .VERSION KERNFOR 2.09 751101
-C ORIG. 11/05/74 WH+WM
-C
-C. SUBROUTINE TLRES L.S. REDIDUAL VECTOR HART/MATT
-C.
-C. INVERSE HOUSEHOLDER TRANSFORMATION APPLIED TO LSQ RESIDUALS
-C. THE RESIDUALS ARE RETURNED IN B
-C. ARGUMENTS
-C. A,B,AUX,(M1,M,N,L,IER) WHICH ARE DEFINED AS FOR TLS
-C. REMARK
-C. CONSTRAINED AND UNCONSTRAINED VERSION COMBINED
-C.
-C.-------------------------------------------------------------------
-C
- COMMON /TLSDIM/ M1,M,N,L,IER
- COMMON /SLATE/ BETA,I,IB,IST,KK,KN,K1,LN,LV,KKEND,DUM(30)
- DIMENSION A(*), B(*), AUX(*)
-C
- IF(IER.EQ.0) GO TO 100
- IER = IABS(IER)
-C
-C SET FIRST IER ELEMENTS OF EACH B VECTOR TO ZERO
- LN = L * IER
- DO 10 I=1,LN
- 10 B(I)=0.
-C
-C TRANSFORMATION LOOP
- K1 = MAX (N,L)
- IST = (IER-1) * (N+1) + 1
- KKEND = IER - M1
- DO 30 KK=1,KKEND
- LV = M - IER + KK
- KN = K1 + IER - KK + 1
- BETA = -1./(AUX(KN)*A(IST))
- IB = (IER-KK) * L + 1
- IF (LV.EQ.1) GO TO 20
- CALL TLSTEP(A(IST),B(IB),N,L,LV,L,BETA)
- GO TO 30
- 20 DO 25 J=1,L
- JST = IB + J - 1
- 25 B(JST) = B(JST)*(1.-BETA*A(IST)**2)
- 30 IST = IST -N -1
- 100 RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/tls.F b/src/packlib/kernlib/kerngen/tcgen/tls.F
deleted file mode 100644
index 575b988..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/tls.F
+++ /dev/null
@@ -1,224 +0,0 @@
-*
-* $Id: tls.F,v 1.1.1.1 1996/02/15 17:49:53 mclareni Exp $
-*
-* $Log: tls.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:53 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE TLS (A,B,AUX,IPIV,EPS,X)
-C
-C CERN PROGLIB# E230 TLS .VERSION KERNFOR 2.06 740511
-C ORIG. 11/05/74 W.HART+W.MATT
-C
-C.
-C. SUBROUTINE TLS LINEAR LEAST SQUARES HART/MATT
-C. HOUSEHOLDER ROTATIONS ARE USED TO ROTATE A TO TRIANGULAR
-C. FORM THEN X OBTAINED THRO BACK SUBSTITUTION.
-C. IDENTICAL IN OPERATION TO LIB ROUTINE HLS BUT WITH TC ARRAY
-C. DEFINITIONS. SEE HLS WRITE UP (D520) FOR FURTHER DETAILS.
-C. ARGUMENTS
-C. A M BY N CONSTRAINT/COEFFICIENT MTX (DESTROYED),
-C. CONSTRAINTS FIRST.
-C. B M BY L R.H.S. MTX (DESTROYED)
-C. AUX AUXILIARY STORAGE ARRAY OF DIM=MAX(N,L)+N
-C. ON RETURN THE FIRST L LOCS CONTAIN THE RESULTING
-C. SUM OF SQUARES
-C. IPIV INTEGER VECTOR (DIM=N) WHICH RETURNS THE COLUMN
-C. INTERCHANGES IN MTX A
-C. EPS INPUT PARAM SPECIFYING A TOLERANCE FOR DETERMINING
-C. THE RANK OF MTX A
-C. X N BY L SOLUTION MTX
-C. THE FOLLOWING ARE TRANSMITTED THRO COMMON /TLSDIM/ ...
-C. M1 NUMBER OF CONSTRAINT EQUATIONS = 0
-C. M TOTAL NUMBER OF EQUATIONS
-C. N NUMBER OF UNKNOWNS
-C. L NUMBER OF SYSTEMS TO BE SOLVED
-C. IER OUTPUT PARAM GIVING RANK OF MTX A
-C.
-C.-------------------------------------------------------------------
-C
- COMMON /TLSDIM/ M1,M,N,L,IER
- COMMON /SLATE/ BETA,F,G,H,I,IB,ID,IEND,II,IST,J,JA,JB,JD,JK,JL
- + ,TOL,JX,J1,K,KPIV,KR,KST,KT,K1,K2,K3,LV,NK,NR,N1
- + ,PIV,PIVT,SIG,JST,DUM(5)
- DIMENSION A(*),B(*),X(*),IPIV(*),AUX(*)
-C
-C ERROR TEST
- IF(M-N)31,1,1
-C
-C CALCN OF INITIAL VECTORS S(K),T(K) IN LOCS AUX(1),AUX(K1)
- 1 PIV=0.
- K1 = MAX (N,L)
- IST = 0
- K2 = K1 + 1
- DO 4 K=1,N
- IPIV(K)=K
- IST = IST + 1
- IF (M .EQ. 1) GO TO 40
- CALL TLPIV(A(IST),B,N,L,M,H,G)
- GO TO 41
- 40 G=A(IST)*B(1)
- H=A(IST)*A(IST)
- 41 AUX(K)=H
- AUX(K2) = G
- PIVT = G*G/H
- IF(PIVT-PIV)4,4,3
- 3 PIV = PIVT
- KPIV=K
- 4 K2 = K2 + 1
- IF (M .EQ. 1) GO TO 2
- CALL TLSMSQ(B(1),L,M,F)
- GO TO 7
- 2 F=B(1)*B(1)
-C
-C ERROR TEST
- 7 IF(PIV)31,31,5
-C
-C DEFINE TOLERANCE FOR CHECKING RANK OF A
- 5 TOL = EPS*EPS
- IER = 1
-C
-C
-C DECOMPOSITION LOOP
- 9 IST = -N
- JB = 1 - L
- DO 21 K=1,N
- IF(EPS.EQ.0.) GO TO 12
- IF(EPS.GT.0.) GO TO 11
- IF(PIV.GT.TOL) GO TO 12
- GO TO 34
- 11 IF(F.GT.TOL*FLOAT(M-K+1)) GO TO 12
- 34 IF(K.NE.1) GO TO 32
- TOL = 0.
- IER = -1
- 12 F = F - PIV
- IST = IST + N + 1
- JB = JB + L
- LV = M-K+1
- I=KPIV-K
- IF(I)8,8,6
-C
-C INTERCHANGE K-TH COLUMN OF A WITH KPIV-TH IN CASE KPIV.GT.K
- 6 H=AUX(K)
- AUX(K)=AUX(KPIV)
- AUX(KPIV)=H
- K2 = K1 + K
- K3 = K1 + KPIV
- G = AUX(K2)
- AUX(K2) = AUX(K3)
- AUX(K3) = G
- JA = IST
- JD = IST + I
- NR = M - K + 1
- CALL TLSWOP(A(IST),A(JD),N,NR)
-C
-C COMPUTATION OF PARAMETER SIG
-C GENERATION OF VECTOR UK IN K-TH COLUMN OF MATRIX A AND OF
-C PARAMETER BETA
- 8 CALL TLUK(A(IST),N,LV,SIG,BETA)
-C
- J = K1 + K
- AUX(J)=-SIG
-C
-C SAVE INTERCHANGE INFORMATION
- 13 IPIV(KPIV)=IPIV(K)
- IPIV(K)=KPIV
- IF(K-N)14,19,19
-C
-C TRANSFORMATION OF MATRIX A
- 14 NK = N - K
- CALL TLSTEP(A(IST),A(IST+1),N,N,LV,NK,BETA)
-C
-C TRANSFORMATION OF RIGHT HAND SIDE MATRIX B
- 19 IB = (K-1) * L +1
- CALL TLSTEP(A(IST),B(IB),N,L,LV,L,BETA)
- IF(K-N)10,21,21
-C
-C UPDATING OF S(K),T(K) ELEMENTS STORED IN AUX
- 10 PIV = 0.
- KPIV = K + 1
- J1 = KPIV
- ID = IST
- K2 = K1 + J1
- DO 18 J=J1,N
- ID = ID+1
- H=AUX(J) - A(ID) * A(ID)
- AUX(J)=H
- G = AUX(K2) - A(ID) * B(JB)
- AUX(K2) = G
- PIVT = G*G/H
- IF(PIVT-PIV)18,18,17
- 17 PIV = PIVT
- KPIV=J
- 18 K2 = K2 + 1
- 21 CONTINUE
- GO TO 20
-C END OF DECOMPOSITION LOOP
-C
-C
-C RANK OF MATRIX LESS THAN N, ZERO X,S AND BACK SUBSTITUTE
- 32 KR = K - 1
- KT = KR
- IER = KR
- JK = KR * L + 1
- JL = N * L
- DO 15 JX=JK,JL
- 15 X(JX) = 0.
- GO TO 16
-C
-C BACK SUBSTITUTION AND BACK INTERCHANGE
- 20 IER = N * IER
- KT = N
- JK = (N-1) * L
- K = K1 + N
- PIV=1./AUX(K)
- DO 22 K=1,L
- JK = JK + 1
- 22 X(JK) = PIV * B(JK)
- KR = N - 1
-C
- 16 IF(KR)26,26,23
- 23 JST = KR * (N+1) + 2
- DO 25 J=1,KR
- JST = JST - N - 1
- IEND = (KR-J+1) * N
- K = K1 + KR - J + 1
- PIV=1./AUX(K)
- KST=K-K1
- ID=IPIV(KST)-KST
- KST = (KR-J) * L
- DO 25 K=1,L
- KST = KST + 1
- H=B(KST)
- II = KST
- DO 24 I = JST,IEND
- II = II + L
- 24 H = H - A(I) * X(II)
- II = KST + ID * L
- X(KST) = X(II)
- X(II)=PIV*H
- 25 CONTINUE
-C
-C COMPUTATION OF LEAST SQUARES
- 26 IST = KT * L
- N1 = KT + 1
- DO 29 J=1,L
- IST = IST + 1
- H=0.
- JA = IST
- IF(M-KT)29,29,27
- 27 NR = M - N1 + 1
- IF(NR.EQ.1) GO TO 28
- CALL TLSMSQ(B(IST),L,NR,H)
- GO TO 29
- 28 H = B(IST)*B(IST)
-C
- 29 AUX(J)=H
- RETURN
-C
-C ERROR RETURN IN CASE OF ZERO-MATRIX A OR M.LT.N
- 31 IER = -1001
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/tlsc.F b/src/packlib/kernlib/kerngen/tcgen/tlsc.F
deleted file mode 100644
index 3d976a5..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/tlsc.F
+++ /dev/null
@@ -1,221 +0,0 @@
-*
-* $Id: tlsc.F,v 1.1.1.1 1996/02/15 17:49:53 mclareni Exp $
-*
-* $Log: tlsc.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:53 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE TLSC (A,B,AUX,IPIV,EPS,X)
-C
-C CERN PROGLIB# E230 TLSC .VERSION KERNFOR 2.06 740511
-C ORIG. 11/05/74 WH+WM
-C
-C. SUBROUTINE TLSC CONSTRAINED L.S. HART/MATT
-C.
-C. M1 PARAMETERS ARE ELIMINATED USING THE CONSTRAINTS AND
-C. THE REMAINING DERIVATIVE PART OF MTX A TRIANGULARISED BY
-C. HOUSEHOLDER ROTATIONS. X IS FOUND BY BACK SUBSTITUTION.
-C. ARGUMENTS
-C. A M BY N CONSTRAINT/COEFFICIENT MTX (DESTROYED)
-C. (CONSTRAINTS FIRST).
-C. B M BY L R.H.S. MTX (DESTROYED)
-C. AUX AUXILIARY STORAGE ARRAY OF DIM=MAX(N,L)+N
-C. ON RETURN THE FIRST L LOCS CONTAIN THE RESULTING
-C. SUM OF SQUARES
-C. IPIV INTEGER VECTOR (DIM=N) WHICH RETURNS THE COLUMN
-C. INTERCHANGES IN MTX A
-C. EPS INPUT PARAM SPECIFYING A TOLERANCE FOR PIVOTING.
-C. NO EXCHANGE OF COL(I) UNLESS EPS*PIV(I) .GT. PIV(1).
-C. X N BY L SOLUTION MATRIX.
-C. THE FOLLOWING ARE TRANSMITTED THRO COMMON /TLSDIM/ ...
-C. M1 NUMBER OF CONSTRAINT EQUATIONS.
-C. M TOTAL NUMBER OF EQUATIONS.
-C. N NUMBER OF UNKNOWNS.
-C. L NUMBER OF SYSTEMS TO BE SOLVED.
-C. IER OUTPUT PARAM GIVING RANK OF MTX A
-C. IF VALUE IS -1001 NO SOLUTION CAN BE FOUND.
-C. REMARKS
-C. ONLY PIVOT IF NECESSARY
-C.
-C.-------------------------------------------------------------------
-C
- COMMON /TLSDIM/ M1,M,N,L,IER
- COMMON /SLATE/ BETA,H,I,IB,IB1,ID,ID1,IEND,II,IST,J,JA,JB,JK
- + ,JST,K,KPIV,KR,KST,KT,K1,LV,MR,M11,NK,NR,PIV,PIVT
- + ,SIG,DUM(11)
- DIMENSION A(*), AUX(*), B(*), IPIV(*), X(*)
-C
-C-- ERROR TEST
- IF (N.GT.M.OR.M1.GT.N) GO TO 90
-C-- CALCULATION OF INITIAL VECTORS.
-C--
- K1 = MAX (N,L)
- IER = 1
- DO 5 K=1,N
- 5 IPIV(K) = K
-C
-C-- PERFORM A DECOMPOSITION LOOP.
-C
- IST = - N
- JB = 1 - L
- M11 = M1 + 1
- MR = M1
- DO 50 K=1,N
- IF (K.GT.M1) MR = M
- IST = IST + N + 1
- JB = JB + L
- LV = MR - K + 1
-C
-C-- PIVOT ONLY IF ABSOLUTLY NECESSARY.
-C
- PIV = 0.
- ID = IST - N
- DO 20 J=K,N
- IF (K.EQ.1 .OR. K.EQ.M11) GO TO 10
- PIVT = AUX(J) - A(ID)*A(ID)
- GO TO 15
-C
- 10 I = ID + N
- IF (LV .EQ. 1) GO TO 12
- CALL TLSMSQ (A(I),N,LV,PIVT)
- GO TO 15
- 12 PIVT= A(I)*A(I)
-C
- 15 AUX(J) = PIVT
- ID = ID + 1
- IF (PIVT*EPS.LE.PIV) GO TO 20
- PIV = PIVT
- KPIV = J
- 20 CONTINUE
-C
- I = KPIV - K
- IF (I.LE.0) GO TO 25
- H = AUX(K)
- AUX(K) = AUX(KPIV)
- AUX(KPIV) = H
- ID = IST + I
- NR = M - K + 1
- CALL TLSWOP (A(IST),A(ID),N,NR)
-C
-C-- COMPUTATION OF TRANSFORMATION PARAMETER SIG.
-C-- GENERATION OF VECTOR UK IN K-TH COLUMN OF MATRIX A AND OF
-C-- PARAMETER BETA.
-C
- 25 CALL TLUK (A(IST),N,LV,SIG,BETA)
- IF (LV.EQ.0) GO TO 90
-C
- J = K1 + K
- AUX(J)=-SIG
- IF (K.GE.N) GO TO 30
-C
-C-- TRANSFORMATION OF MATRIX A.
-C
- NK = N - K
- IF (LV.EQ.1) GO TO 27
- CALL TLSTEP (A(IST),A(IST+1),N,N,LV,NK,BETA)
- GO TO 30
- 27 DO 28 J=1,NK
- JST = IST + J
- 28 A(JST) = A(JST)*(1.-BETA*A(IST)**2)
-C
-C-- TRANSFORMATION OF RIGHT HAND SIDE MATRIX B.
-C
- 30 IB = (K-1) * L + 1
- IF (LV.EQ.1) GO TO 32
- CALL TLSTEP (A(IST),B(IB),N,L,LV,L,BETA)
- GO TO 34
- 32 DO 33 J=1,L
- JST = IB + J - 1
- 33 B(JST) = B(JST)*(1.-BETA*A(IST)**2)
- 34 IPIV(KPIV) = IPIV(K)
- IPIV(K) = KPIV
- IF (K.GT.M1) GO TO 50
-C
-C-- REDUCE MATRIX A FOR ONE CONSTRAINT PARAMETER.
-C
- DO 45 I=M11,M
- ID1 = IST + (I-K)*N
- IF (A(ID1).EQ.0) GO TO 45
- H = - A(ID1)/SIG
- A(ID1) = H
- ID1 = ID1 + 1
- ID = IST + 1
-C
- DO 35 J=1,NK
- A(ID1) = A(ID1) - H*A(ID)
- ID1 = ID1 + 1
- 35 ID = ID + 1
-C
- IB1 = 1 + (I-1)*L
- IB = JB
- DO 40 J=1,L
- B(IB1) = B(IB1) - H*B(IB)
- IB1 = IB1 + 1
- 40 IB = IB + 1
-C
- 45 CONTINUE
- 50 CONTINUE
-C
-C-- BACK SUBSTITUTION AND BACK INTERCHANGE.
-C
- IER = N * IER
- KT = N
- JK = (N-1) * L
- K = K1 + N
- PIV = 1./AUX(K)
- DO 55 K=1,L
- JK = JK + 1
- 55 X(JK) = PIV * B(JK)
-C
- KR = N - 1
- IF (KR.LE.0) GO TO 70
-C
- JST = KR * (N+1) + 2
- DO 65 J=1,KR
- JST = JST - N - 1
- IEND= (KR-J+1) * N
- K = K1 + KR - J + 1
- PIV = 1./AUX(K)
- KST = K-K1
- ID = IPIV(KST)-KST
- KST = (KR-J) * L
-C
- DO 65 K=1,L
- KST = KST + 1
- H=B(KST)
-C
- II = KST
- DO 60 I=JST,IEND
- II = II + L
- 60 H = H - A(I) * X(II)
-C
- II = KST + ID *L
- X(KST) = X(II)
- X(II) = PIV * H
- 65 CONTINUE
-C
-C-- COMPUTATION OF LEAST SQUARES.
-C
- 70 IST = KT*L
- DO 80 J=1,L
- IST = IST + 1
- H = 0.
- JA = IST
- IF (M.LE.KT) GO TO 80
- NR = M - KT
- IF (NR.EQ.1) GO TO 75
- CALL TLSMSQ (B(IST),L,NR,H)
- GO TO 80
-C
- 75 H = B(IST)*B(IST)
-C
- 80 AUX(J) = H
- RETURN
-C--
-C-- ERROR RETURN IN CASE OF A ZERO COLUMN IN MATRIX A.
-C
- 90 IER = -1001
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/tlsmsq.F b/src/packlib/kernlib/kerngen/tcgen/tlsmsq.F
deleted file mode 100644
index 058d3ec..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/tlsmsq.F
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: tlsmsq.F,v 1.1.1.1 1996/02/15 17:49:53 mclareni Exp $
-*
-* $Log: tlsmsq.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:53 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE TLSMSQ (B,L,M,F)
-C
-C CERN PROGLIB# E230 TLSMSQ .VERSION KERNFOR 2.06 740511
-C ORIG. 11/05/74 WH+WM
-C
-C. SUBROUTINE TLSMSQ (B,L,M,F)
-C.
-C. CALCULATES THE SUM OF SQUARES OF RESIDUALS.
-C.
-C.-------------------------------------------------------------------
-C
- COMMON /SLATE/ DUM(38),I,JB
- DIMENSION B(*)
-C
- F = 0.
- JB = 1
- DO 10 I=1,M
- F = F + B(JB)*B(JB)
- 10 JB = JB + L
-C
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/tlstep.F b/src/packlib/kernlib/kerngen/tcgen/tlstep.F
deleted file mode 100644
index aff5ad3..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/tlstep.F
+++ /dev/null
@@ -1,46 +0,0 @@
-*
-* $Id: tlstep.F,v 1.1.1.1 1996/02/15 17:49:53 mclareni Exp $
-*
-* $Log: tlstep.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:53 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE TLSTEP (A,B,IASEP,IBSEP,NR,NC,BETA)
-C
-C CERN PROGLIB# E230 TLSTEP .VERSION KERNFOR 2.06 740511
-C ORIG. 11/05/74 WH+WM
-C
-C. SUBROUTINE TLSTEP (A,B,IASEP,IBSEP,NR,NC,BETA)
-C.
-C. PERFORMS AN ORTHOGONAL TRANSFORMATION.
-C.
-C.-------------------------------------------------------------------
-C
- COMMON /SLATE/ DUM(34),H,I,IB,J,JA,JB
- DIMENSION A(*), B(*)
-C
- IB = 0
- DO 30 J=1,NC
- IB = IB + 1
- H = 0.
- JA = 1
- JB = IB
-C
- DO 10 I=1,NR
- H = H + A(JA) * B(JB)
- JA = JA +IASEP
- 10 JB = JB + IBSEP
-C
- H = H * BETA
- JA = 1
- JB = IB
- DO 20 I=1,NR
- B(JB) = B(JB) - A(JA) * H
- JA = JA +IASEP
- 20 JB = JB + IBSEP
- 30 CONTINUE
-C
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/tlswop.F b/src/packlib/kernlib/kerngen/tcgen/tlswop.F
deleted file mode 100644
index d2f66c0..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/tlswop.F
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: tlswop.F,v 1.1.1.1 1996/02/15 17:49:54 mclareni Exp $
-*
-* $Log: tlswop.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:54 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE TLSWOP (A,AD,N,NR)
-C
-C CERN PROGLIB# E230 TLSWOP .VERSION KERNFOR 2.06 740511
-C ORIG. 11/05/74 WH+WM
-C
-C. SUBROUTINE TLSWOP (A,AD,N,NR)
-C.
-C. INTERCHANGES THE FIRST ROW OF MATRICES A AND AD.
-C.
-C.-------------------------------------------------------------------
-C
- COMMON /SLATE/ DUM(37),H,I,JA
- DIMENSION A(*), AD(*)
-C
- JA = 1
- DO 10 I=1,NR
- H = A(JA)
- A(JA) = AD(JA)
- AD(JA) = H
- 10 JA = JA + N
-C
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/tluk.F b/src/packlib/kernlib/kerngen/tcgen/tluk.F
deleted file mode 100644
index 3c24718..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/tluk.F
+++ /dev/null
@@ -1,52 +0,0 @@
-*
-* $Id: tluk.F,v 1.1.1.1 1996/02/15 17:49:54 mclareni Exp $
-*
-* $Log: tluk.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:54 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE TLUK (A,IASEP,NR,SIG,BETA)
-C
-C CERN PROGLIB# E230 TLUK .VERSION KERNFOR 2.06 740511
-C ORIG. 11/05/74 WH+WM
-C
-C. SUBROUTINE TLUK (A,IASEP,NR,SIG,BETA)
-C.
-C. COMPUTE TRANSFORMATION QUANTITIES.
-C. TLUK HAS BEEN MODIFIED FOR KINEMATICS.
-C.
-C.-------------------------------------------------------------------
-C
- COMMON /SLATE/ DUM(37),I,JA,LL
- DIMENSION A(*)
-C--
-C
-C-- COMPUTE MODULUS OF A GIVEN ROW IN A MATRIX AND FIND LAST
-C-- NON-ZERO ELEMENT IN THAT ROW.
-C
- SIG= 0.
- JA = 1
- LL = 0
-C
- DO 10 I=1,NR
- IF (A(JA).EQ.0.) GO TO 10
- LL = I
- SIG= SIG + A(JA)* A(JA)
- 10 JA = JA + IASEP
-C
-C-- FOR A ZERO ROW RETURN.
-C
- NR = LL
- IF (NR.EQ.0) RETURN
-C--
-C-- OTHERWISE TAKE THE MODULUS WITH SIGN OF FIRST ELEMENT OF THAT
-C-- ROW. REDEFINE THAT FIRST ARGUMENT AND VALUE OF BETA.
-C
- SIG = SIGN (SQRT (SIG),A(1))
- BETA = A(1) + SIG
- A(1) = BETA
- BETA = 1. / (SIG * BETA)
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/traat.F b/src/packlib/kernlib/kerngen/tcgen/traat.F
deleted file mode 100644
index 10236c4..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/traat.F
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: traat.F,v 1.1.1.1 1996/02/15 17:49:54 mclareni Exp $
-*
-* $Log: traat.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:54 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE TRAAT (A,S,M,N)
-C
-C CERN PROGLIB# F112 TRAAT .VERSION KERNFOR 4.15 861204
-C ORIG. 18/12/74 WH
-C
-#if defined(CERNLIB_INTDOUBL)
- DOUBLE PRECISION SUM
-#endif
- DIMENSION A(*),S(*)
-C
- IA = 0
- IS = 0
-C
- DO 30 I=1,M
- IPIV = IA
- IPIVN = IPIV + N
- IAT = 0
-C
- DO 30 J=1,I
- IA = IPIV
-C
- SUM = 0.
- 20 IA = IA + 1
- IAT = IAT + 1
- SUM = SUM + A(IA)*A(IAT)
- IF (IA.LT.IPIVN) GO TO 20
-C
- IS = IS + 1
- 30 S(IS) = SUM
-C
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/traceq.F b/src/packlib/kernlib/kerngen/tcgen/traceq.F
deleted file mode 100644
index fe0f451..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/traceq.F
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: traceq.F,v 1.1.1.1 1996/02/15 17:49:51 mclareni Exp $
-*
-* $Log: traceq.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:51 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QMHPX)
-#include "hpxgs/traceq.F"
-#elif defined(CERNLIB_QMVAX)
-#include "vaxsys/traceq.F"
-#else
- SUBROUTINE TRACEQ (LUNP,LEV)
-C
-C CERN PROGLIB# N105 TRACEQ .VERSION KERNFOR 4.23 891215
-C ORIG. 4/01/89 JZ
-C
-* unit number for standard output
- PARAMETER (LUNSTP=6)
-
- LUN = LUNP
- IF (LUN.EQ.0) LUN = LUNSTP
- WRITE (LUN,9001)
- RETURN
- 9001 FORMAT (/' TRACEQ. In-line trace-back still not available.')
- END
-#endif
diff --git a/src/packlib/kernlib/kerngen/tcgen/tral.F b/src/packlib/kernlib/kerngen/tcgen/tral.F
deleted file mode 100644
index 86767e5..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/tral.F
+++ /dev/null
@@ -1,39 +0,0 @@
-*
-* $Id: tral.F,v 1.1.1.1 1996/02/15 17:49:54 mclareni Exp $
-*
-* $Log: tral.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:54 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE TRAL (A,U,B,M,N)
-C
-C CERN PROGLIB# F112 TRAL .VERSION KERNFOR 4.15 861204
-C ORIG. 18/12/74 WH
-C
-#if defined(CERNLIB_INTDOUBL)
- DOUBLE PRECISION SUM
-#endif
- DIMENSION A(*),U(*),B(*)
-C
- IB = 1
-C
- DO 40 I=1,M
- INDU = 0
-C
- DO 40 J=1,N
- INDU = INDU + J
- IA = IB
- IU = INDU
- SUM = 0.
-C
- DO 30 K=J,N
- SUM = SUM + A(IA)*U(IU)
- IA = IA + 1
- 30 IU = IU + K
- B(IB) = SUM
- 40 IB = IB + 1
-C
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/tralt.F b/src/packlib/kernlib/kerngen/tcgen/tralt.F
deleted file mode 100644
index 98d3c48..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/tralt.F
+++ /dev/null
@@ -1,38 +0,0 @@
-*
-* $Id: tralt.F,v 1.1.1.1 1996/02/15 17:49:55 mclareni Exp $
-*
-* $Log: tralt.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:55 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE TRALT (A,U,B,M,N)
-C
-C CERN PROGLIB# F112 TRALT .VERSION KERNFOR 4.15 861204
-C ORIG. 18/12/74 WH
-C
-#if defined(CERNLIB_INTDOUBL)
- DOUBLE PRECISION SUM
-#endif
- DIMENSION A(*),U(*),B(*)
-C
- IB = M*N
- INDU = (N*N+N)/2
-C
- 20 IU = INDU
-C
- DO 40 J=1,N
- IA = IB
- SUM = 0.
-C
- DO 30 K=J,N
- SUM = SUM + A(IA)*U(IU)
- IA = IA - 1
- 30 IU = IU - 1
- B(IB) = SUM
- 40 IB = IB - 1
- IF (IB.GT.0) GO TO 20
-C
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/tras.F b/src/packlib/kernlib/kerngen/tcgen/tras.F
deleted file mode 100644
index ec6a741..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/tras.F
+++ /dev/null
@@ -1,48 +0,0 @@
-*
-* $Id: tras.F,v 1.1.1.1 1996/02/15 17:49:55 mclareni Exp $
-*
-* $Log: tras.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:55 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE TRAS (A,S,B,M,N)
-C
-C CERN PROGLIB# F112 TRAS .VERSION KERNFOR 4.15 861204
-C ORIG. 18/12/74 WH
-C
-#if defined(CERNLIB_INTDOUBL)
- DOUBLE PRECISION SUM
-#endif
- DIMENSION A(*),S(*),B(*)
-C
- IB = 0
- INDS = 0
- I = 0
-C
- 5 INDS = INDS + I
- IA = 0
- IB = I + 1
-C
- DO 40 J=1,M
- IS = INDS
- SUM = 0.
- K = 0
-C
- 10 IF (K.GT.I) GO TO 20
- IS = IS + 1
- GO TO 30
- 20 IS = IS + K
- 30 IA = IA + 1
- SUM = SUM + A(IA)*S(IS)
- K = K + 1
- IF (K.LT.N) GO TO 10
-C
- B(IB) = SUM
- 40 IB = IB + N
- I = I + 1
- IF (I.LT.N) GO TO 5
-C
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/trasat.F b/src/packlib/kernlib/kerngen/tcgen/trasat.F
deleted file mode 100644
index 298f618..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/trasat.F
+++ /dev/null
@@ -1,53 +0,0 @@
-*
-* $Id: trasat.F,v 1.1.1.1 1996/02/15 17:49:55 mclareni Exp $
-*
-* $Log: trasat.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:55 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE TRASAT (A,S,R,M,N)
-C
-C CERN PROGLIB# F112 TRASAT .VERSION KERNFOR 4.15 861204
-C ORIG. 18/12/74 WH
-C
-#if defined(CERNLIB_INTDOUBL)
- DOUBLE PRECISION SUM
-#endif
- DIMENSION S(*),A(*),R(*)
-C
- IMAX = (M*M+M)/2
- CALL VZERO (R,IMAX)
- MN = M*N
- IND = 0
- I = 0
-C
- 5 IND = IND + I
- IA = 0
- IR = 0
-C
- 10 IS = IND
- SUM = 0.
- K = 0
-C
- 15 IF (K.GT.I) GO TO 20
- IS = IS + 1
- GO TO 30
- 20 IS = IS + K
- 30 IA = IA + 1
- SUM = SUM + S(IS)*A(IA)
- K = K + 1
- IF (K.LT.N) GO TO 15
- IAA = I + 1
- 40 IR = IR + 1
- R(IR) = R(IR) + SUM*A(IAA)
- IAA = IAA + N
- IF (IAA.LE.IA) GO TO 40
- IF (IA.LT.MN) GO TO 10
-C
- I = I + 1
- IF (I.LT.N) GO TO 5
-C
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/trata.F b/src/packlib/kernlib/kerngen/tcgen/trata.F
deleted file mode 100644
index c112cf8..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/trata.F
+++ /dev/null
@@ -1,39 +0,0 @@
-*
-* $Id: trata.F,v 1.1.1.1 1996/02/15 17:49:55 mclareni Exp $
-*
-* $Log: trata.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:55 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE TRATA (A,R,M,N)
-C
-C CERN PROGLIB# F112 TRATA .VERSION KERNFOR 4.15 861204
-C ORIG. 18/12/74 WH
-C
-#if defined(CERNLIB_INTDOUBL)
- DOUBLE PRECISION SUM
-#endif
- DIMENSION A(*),R(*)
-C
- MN = M*N
- IR = 0
-C
- DO 30 I=1,M
-C
- DO 30 J=1,I
- IA = I
- IAT = J
-C
- SUM = 0.
- 20 SUM = SUM + A(IA)*A(IAT)
- IA = IA + M
- IAT = IAT + M
- IF (IA.LE.MN) GO TO 20
-C
- IR = IR + 1
- 30 R(IR) = SUM
-C
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/trats.F b/src/packlib/kernlib/kerngen/tcgen/trats.F
deleted file mode 100644
index 58ea66f..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/trats.F
+++ /dev/null
@@ -1,48 +0,0 @@
-*
-* $Id: trats.F,v 1.1.1.1 1996/02/15 17:49:55 mclareni Exp $
-*
-* $Log: trats.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:55 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE TRATS (A,S,B,M,N)
-C
-C CERN PROGLIB# F112 TRATS .VERSION KERNFOR 4.15 861204
-C ORIG. 18/12/74 WH
-C
-#if defined(CERNLIB_INTDOUBL)
- DOUBLE PRECISION SUM
-#endif
- DIMENSION A(*),S(*),B(*)
-C
- IB = 0
- INDS = 0
- I = 0
-C
- 5 INDS = INDS + I
- IB = I + 1
-C
- DO 40 J=1,M
- IA = J
- IS = INDS
- SUM = 0.
- K = 0
-C
- 10 IF (K.GT.I) GO TO 20
- IS = IS + 1
- GO TO 30
- 20 IS = IS + K
- 30 SUM = SUM + A(IA)*S(IS)
- IA = IA + M
- K = K + 1
- IF (K.LT.N) GO TO 10
-C
- B(IB) = SUM
- 40 IB = IB + N
- I = I + 1
- IF (I.LT.N) GO TO 5
-C
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/tratsa.F b/src/packlib/kernlib/kerngen/tcgen/tratsa.F
deleted file mode 100644
index 7fecb6e..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/tratsa.F
+++ /dev/null
@@ -1,53 +0,0 @@
-*
-* $Id: tratsa.F,v 1.1.1.1 1996/02/15 17:49:56 mclareni Exp $
-*
-* $Log: tratsa.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:56 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE TRATSA (A,S,R,M,N)
-C
-C CERN PROGLIB# F112 TRATSA .VERSION KERNFOR 4.15 861204
-C ORIG. 18/12/74 WH
-C
-#if defined(CERNLIB_INTDOUBL)
- DOUBLE PRECISION SUM
-#endif
- DIMENSION S(*),A(*),R(*)
-C
- IMAX = (M*M+M)/2
- CALL VZERO (R,IMAX)
- MN = M*N
- IND = 0
- I = 0
-C
- 5 IND = IND + I
- IR = 0
-C
- DO 40 J=1,M
- IS = IND
- IA = J
- SUM = 0.
- K = 0
-C
- 15 IF (K.GT.I) GO TO 20
- IS = IS + 1
- GO TO 30
- 20 IS = IS + K
- 30 SUM = SUM + S(IS)*A(IA)
- IA = IA + M
- K = K + 1
- IF (K.LT.N) GO TO 15
- IAA = I*M
-C
- DO 40 K=1,J
- IAA = IAA + 1
- IR = IR + 1
- 40 R(IR) = R(IR) + SUM*A(IAA)
- I = I + 1
- IF (I.LT.N) GO TO 5
-C
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/trchlu.F b/src/packlib/kernlib/kerngen/tcgen/trchlu.F
deleted file mode 100644
index 41cbe51..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/trchlu.F
+++ /dev/null
@@ -1,59 +0,0 @@
-*
-* $Id: trchlu.F,v 1.1.1.1 1996/02/15 17:49:54 mclareni Exp $
-*
-* $Log: trchlu.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:54 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE TRCHLU (A,B,N)
-C
-C CERN PROGLIB# F112 TRCHLU .VERSION KERNFOR 4.16 870601
-C ORIG. 18/12/74 W.HART
-C
-#if defined(CERNLIB_INTDOUBL)
- DOUBLE PRECISION SUM, R, DC
-#endif
- DIMENSION A(*),B(*)
-C
- IPIV = 0
-C
- I = 0
- 10 I = I + 1
- IPIV = IPIV + I
- KPIV = IPIV
- R = A(IPIV)
-C
- DO 60 J=I,N
- SUM = 0.
- IF (I.EQ.1) GO TO 40
- IF (R.EQ.0.) GO TO 42
- ID = IPIV - I + 1
- KD = KPIV - I + 1
-C
- 30 SUM = SUM + B(KD)*B(ID)
- KD = KD + 1
- ID = ID + 1
- IF (ID.LT.IPIV) GO TO 30
-C
- 40 SUM = A(KPIV) - SUM
- 42 IF (J.NE.I) GO TO 50
-#if !defined(CERNLIB_INTDOUBL)
- DC = SQRT (SUM)
-#endif
-#if defined(CERNLIB_INTDOUBL)
- DC = DSQRT (SUM)
-#endif
- B(KPIV) = DC
- IF (R .GT. 0.0) R = 1./DC
- GO TO 60
-C
- 50 B(KPIV) = SUM*R
-C
- 60 KPIV = KPIV + J
-C
- IF (I.LT.N) GO TO 10
-C
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/trchul.F b/src/packlib/kernlib/kerngen/tcgen/trchul.F
deleted file mode 100644
index c80774a..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/trchul.F
+++ /dev/null
@@ -1,60 +0,0 @@
-*
-* $Id: trchul.F,v 1.1.1.1 1996/02/15 17:49:54 mclareni Exp $
-*
-* $Log: trchul.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:54 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE TRCHUL (A,B,N)
-C
-C CERN PROGLIB# F112 TRCHUL .VERSION KERNFOR 4.16 870601
-C ORIG. 18/12/74 WH
-C
-#if defined(CERNLIB_INTDOUBL)
- DOUBLE PRECISION SUM, R, DC
-#endif
- DIMENSION A(*),B(*)
-C
- KPIV = (N*N+N)/2
-C
- I = N
- 10 IPIV = KPIV
- R = A(IPIV)
-C
- 20 SUM = 0.
- IF (I.EQ.N) GO TO 40
- IF (R.EQ.0.) GO TO 42
- ID = IPIV
- KD = KPIV
- NSTEP = I
-C
- 30 KD = KD + NSTEP
- ID = ID + NSTEP
- NSTEP = NSTEP + 1
- SUM = SUM + B(ID)*B(KD)
- IF (NSTEP.LT.N) GO TO 30
-C
- 40 SUM = A(KPIV) - SUM
- 42 IF (KPIV.LT.IPIV) GO TO 50
-#if !defined(CERNLIB_INTDOUBL)
- DC = SQRT (SUM)
-#endif
-#if defined(CERNLIB_INTDOUBL)
- DC = DSQRT (SUM)
-#endif
- B(KPIV) = DC
- IF (R .GT. 0.0) R = 1./DC
- GO TO 60
-C
- 50 B(KPIV) = SUM*R
-C
- 60 KPIV = KPIV - 1
- IF (KPIV.GT.IPIV-I) GO TO 20
-C
- I = I - 1
- IF (I.GT.0) GO TO 10
-C
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/trinv.F b/src/packlib/kernlib/kerngen/tcgen/trinv.F
deleted file mode 100644
index a05c3ff..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/trinv.F
+++ /dev/null
@@ -1,53 +0,0 @@
-*
-* $Id: trinv.F,v 1.1.1.1 1996/02/15 17:49:54 mclareni Exp $
-*
-* $Log: trinv.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:54 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE TRINV (T,S,N)
-C
-C CERN PROGLIB# F112 TRINV .VERSION KERNFOR 4.15 861204
-C ORIG. 18/12/74 WH
-C
-#if defined(CERNLIB_INTDOUBL)
- DOUBLE PRECISION SUM, R
-#endif
- DIMENSION T(*),S(*)
-C
- MX = (N*N+N)/2
- IPIV = MX
-C
- I = N
- 10 R = 0.
- IF (T(IPIV).GT.0.) R=1./T(IPIV)
- S(IPIV) = R
- NDSTEP = N
- IND = MX - N + I
-C
- 20 IF (IND.EQ.IPIV) GO TO 50
- SUM = 0.
- IF (R.EQ.0.) GO TO 40
- LHOR = IPIV
- LVER = IND
- J = I
-C
- 30 LHOR = LHOR + J
- LVER = LVER + 1
- SUM = SUM + T(LHOR)*S(LVER)
- J = J + 1
- IF (LHOR.LT.IND) GO TO 30
-C
- 40 S(IND) = - SUM*R
- NDSTEP = NDSTEP - 1
- IND = IND - NDSTEP
- GO TO 20
-C
- 50 IPIV = IPIV - I
- I = I - 1
- IF (I.GT.0) GO TO 10
-C
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/trla.F b/src/packlib/kernlib/kerngen/tcgen/trla.F
deleted file mode 100644
index 3865f76..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/trla.F
+++ /dev/null
@@ -1,40 +0,0 @@
-*
-* $Id: trla.F,v 1.1.1.1 1996/02/15 17:49:54 mclareni Exp $
-*
-* $Log: trla.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:54 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE TRLA (U,A,B,M,N)
-C
-C CERN PROGLIB# F112 TRLA .VERSION KERNFOR 4.15 861204
-C ORIG. 18/12/74 WH
-C
-#if defined(CERNLIB_INTDOUBL)
- DOUBLE PRECISION SUM
-#endif
- DIMENSION A(*),U(*),B(*)
-C
- IB = M*N
- IPIV = (M*M+M)/2
-C
- 20 IA = IB
- IU = IPIV
-C
- SUM = 0.
- 30 SUM = SUM + A(IA)*U(IU)
- IU = IU - 1
- IA = IA - N
- IF (IA.GT.0) GO TO 30
-C
- B(IB) = SUM
- IB = IB - 1
- IF (IA.GT.1-N) GO TO 20
-C
- IPIV = IU
- IF (IU.GT.0) GO TO 20
-C
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/trlta.F b/src/packlib/kernlib/kerngen/tcgen/trlta.F
deleted file mode 100644
index f1077ef..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/trlta.F
+++ /dev/null
@@ -1,47 +0,0 @@
-*
-* $Id: trlta.F,v 1.1.1.1 1996/02/15 17:49:54 mclareni Exp $
-*
-* $Log: trlta.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:54 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE TRLTA (U,A,B,M,N)
-C
-C CERN PROGLIB# F112 TRLTA .VERSION KERNFOR 4.15 861204
-C ORIG. 18/12/74 WH
-C
-#if defined(CERNLIB_INTDOUBL)
- DOUBLE PRECISION SUM
-#endif
- DIMENSION A(*),U(*),B(*)
-C
- IPIV = 0
- MX = M*N
- MXPN = MX + N
- IB = 0
-C
- I = 0
- 10 I = I + 1
- IPIV = IPIV + I
-C
- 20 IU = IPIV
- NSTEP = I
- IB = IB + 1
- IA = IB
-C
- SUM = 0.
- 30 SUM = SUM + A(IA)*U(IU)
- IA = IA + N
- IU = IU + NSTEP
- NSTEP = NSTEP + 1
- IF (IA.LE.MX) GO TO 30
-C
- B(IB) = SUM
- IF (IA.LT.MXPN) GO TO 20
-C
- IF (I.LT.M) GO TO 10
-C
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/trpck.F b/src/packlib/kernlib/kerngen/tcgen/trpck.F
deleted file mode 100644
index fe34c07..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/trpck.F
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: trpck.F,v 1.1.1.1 1996/02/15 17:49:56 mclareni Exp $
-*
-* $Log: trpck.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:56 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE TRPCK (S,U,N)
-C
-C CERN PROGLIB# F112 TRPCK .VERSION KERNFOR 2.08 741218
-C ORIG. 18/12/74 WH
-C
- COMMON /SLATE/ I,IA,IND,IPIV,IDUM(36)
- DIMENSION S(*),U(*)
-C
- IA = 0
- IND = 0
- IPIV = 0
-C
- DO 20 I=1,N
- IPIV = IPIV + I
-C
- 10 IA = IA + 1
- IND = IND + 1
- U(IND) = S(IA)
- IF (IND.LT.IPIV) GO TO 10
-C
- 20 IA = IA + N - I
-C
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/trqsq.F b/src/packlib/kernlib/kerngen/tcgen/trqsq.F
deleted file mode 100644
index 2ed7e67..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/trqsq.F
+++ /dev/null
@@ -1,64 +0,0 @@
-*
-* $Id: trqsq.F,v 1.1.1.1 1996/02/15 17:49:56 mclareni Exp $
-*
-* $Log: trqsq.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:56 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE TRQSQ (Q,S,R,M)
-C
-C CERN PROGLIB# F112 TRQSQ .VERSION KERNFOR 4.15 861204
-C ORIG. 18/12/74 WH
-C
-#if defined(CERNLIB_INTDOUBL)
- DOUBLE PRECISION SUM
-#endif
- DIMENSION S(*),Q(*),R(*)
-C
- IMAX = (M*M+M)/2
- CALL VZERO (R,IMAX)
- INDS = 0
- I = 0
-C
- 5 INDS = INDS + I
- IR = 0
- INDQ = 0
- J = 0
-C
- 10 INDQ = INDQ + J
- IS = INDS
- IQ = INDQ
- SUM = 0.
- K = 0
-C
- 15 IF (K.GT.I) GO TO 20
- IS = IS + 1
- GO TO 30
- 20 IS = IS + K
- 30 IF (K.GT.J) GO TO 40
- IQ = IQ + 1
- GO TO 50
- 40 IQ = IQ + K
- 50 SUM = SUM + S(IS)*Q(IQ)
- K = K + 1
- IF (K.LT.M) GO TO 15
- IQQ = INDS
- L = 0
-C
- 60 IR = IR + 1
- IF (L.GT.I) GO TO 70
- IQQ = IQQ + 1
- GO TO 80
- 70 IQQ = IQQ + L
- 80 R(IR) = R(IR) + Q(IQQ)*SUM
- L = L + 1
- IF (L.LE.J) GO TO 60
- J = J + 1
- IF (J.LT.M) GO TO 10
- I = I + 1
- IF (I.LT.M) GO TO 5
-C
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/trsa.F b/src/packlib/kernlib/kerngen/tcgen/trsa.F
deleted file mode 100644
index 181f278..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/trsa.F
+++ /dev/null
@@ -1,46 +0,0 @@
-*
-* $Id: trsa.F,v 1.1.1.1 1996/02/15 17:49:55 mclareni Exp $
-*
-* $Log: trsa.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:55 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE TRSA (S,A,B,M,N)
-C
-C CERN PROGLIB# F112 TRSA .VERSION KERNFOR 4.15 861204
-C ORIG. 18/12/74 WH
-C
-#if defined(CERNLIB_INTDOUBL)
- DOUBLE PRECISION SUM
-#endif
- DIMENSION S(*),A(*),B(*)
-C
- INDS = 0
- IB = 0
- I = 0
-C
- 5 INDS = INDS + I
-C
- DO 40 J=1,N
- IA = J
- IS = INDS
- SUM = 0.
- K = 0
-C
- 10 IF (K.GT.I) GO TO 20
- IS = IS + 1
- GO TO 30
- 20 IS = IS + K
- 30 SUM = SUM + S(IS)*A(IA)
- IA = IA + N
- K = K + 1
- IF (K.LT.M) GO TO 10
- IB = IB + 1
- 40 B(IB) = SUM
- I = I + 1
- IF (I.LT.M) GO TO 5
-C
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/trsat.F b/src/packlib/kernlib/kerngen/tcgen/trsat.F
deleted file mode 100644
index ae4fd6a..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/trsat.F
+++ /dev/null
@@ -1,47 +0,0 @@
-*
-* $Id: trsat.F,v 1.1.1.1 1996/02/15 17:49:55 mclareni Exp $
-*
-* $Log: trsat.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:55 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE TRSAT (S,A,B,M,N)
-C
-C CERN PROGLIB# F112 TRSAT .VERSION KERNFOR 4.15 861204
-C ORIG. 18/12/74 WH
-C
-#if defined(CERNLIB_INTDOUBL)
- DOUBLE PRECISION SUM
-#endif
- DIMENSION S(*),A(*),B(*)
-C
- MN = M*N
- INDS = 0
- IB = 0
- I = 0
-C
- 5 INDS = INDS + I
- IA = 0
-C
- DO 40 J=1,N
- IS = INDS
- SUM = 0.
- K = 0
-C
- 10 IF (K.GT.I) GO TO 20
- IS = IS + 1
- GO TO 30
- 20 IS = IS + K
- 30 IA = IA + 1
- SUM = SUM + S(IS)*A(IA)
- K = K + 1
- IF (K.LT.M) GO TO 10
- IB = IB + 1
- 40 B(IB) = SUM
- I = I + 1
- IF (I.LT.M) GO TO 5
-C
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/trsinv.F b/src/packlib/kernlib/kerngen/tcgen/trsinv.F
deleted file mode 100644
index 2743aa6..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/trsinv.F
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: trsinv.F,v 1.1.1.1 1996/02/15 17:49:54 mclareni Exp $
-*
-* $Log: trsinv.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:54 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE TRSINV (G,GI,N)
-C
-C CERN PROGLIB# F112 TRSINV .VERSION KERNFOR 2.08 741218
-C ORIG. 18/12/74 WH
-C
- DIMENSION G(2),GI(2)
-C
- CALL TRCHLU (G,GI,N)
- CALL TRINV (GI,GI,N)
- CALL TRSMUL (GI,GI,N)
-C
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/trsmlu.F b/src/packlib/kernlib/kerngen/tcgen/trsmlu.F
deleted file mode 100644
index f6ba724..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/trsmlu.F
+++ /dev/null
@@ -1,37 +0,0 @@
-*
-* $Id: trsmlu.F,v 1.1.1.1 1996/02/15 17:49:54 mclareni Exp $
-*
-* $Log: trsmlu.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:54 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE TRSMLU (U,S,N)
-C
-C CERN PROGLIB# F112 TRSMLU .VERSION KERNFOR 4.15 861204
-C ORIG. 18/12/74 WH
-C
-#if defined(CERNLIB_INTDOUBL)
- DOUBLE PRECISION SUM
-#endif
- DIMENSION U(*),S(*)
-C
- IND = (N*N+N)/2
-C
- DO 30 I=1,N
- LVER = IND
-C
- DO 30 K=I,N
- LHOR = IND
- SUM = 0.
-C
- DO 20 L=K,N
- SUM = SUM + U(LVER)*U(LHOR)
- LVER = LVER - 1
- 20 LHOR = LHOR - 1
- S(IND) = SUM
- 30 IND = IND - 1
-C
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/trsmul.F b/src/packlib/kernlib/kerngen/tcgen/trsmul.F
deleted file mode 100644
index 4ad8ea6..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/trsmul.F
+++ /dev/null
@@ -1,36 +0,0 @@
-*
-* $Id: trsmul.F,v 1.1.1.1 1996/02/15 17:49:54 mclareni Exp $
-*
-* $Log: trsmul.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:54 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE TRSMUL (G,GI,N)
-C
-C CERN PROGLIB# F112 TRSMUL .VERSION KERNFOR 4.15 861204
-C ORIG. 18/12/74 WH
-C
-#if defined(CERNLIB_INTDOUBL)
- DOUBLE PRECISION SUM
-#endif
- DIMENSION G(*),GI(*)
-C
- IND = 1
- LPIV = 0
- DO 30 I=1,N
- LPIV = LPIV + I
- DO 30 J=1,I
- LVER = LPIV
- LHOR = IND
- SUM = 0.
- DO 20 K=I,N
- SUM = SUM + G(LVER)*G(LHOR)
- LHOR = LHOR + K
- 20 LVER = LVER + K
- GI(IND) = SUM
- 30 IND = IND + 1
-C
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/trupck.F b/src/packlib/kernlib/kerngen/tcgen/trupck.F
deleted file mode 100644
index b52a2ab..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/trupck.F
+++ /dev/null
@@ -1,44 +0,0 @@
-*
-* $Id: trupck.F,v 1.1.1.1 1996/02/15 17:49:56 mclareni Exp $
-*
-* $Log: trupck.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:56 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE TRUPCK (U,S,M)
-C
-C CERN PROGLIB# F112 TRUPCK .VERSION KERNFOR 2.08 741218
-C ORIG. 18/12/74 WH
-C
- COMMON /SLATE/ I,IM,IS,IU,IV,IH,M2,DUM(33)
- DIMENSION U(*),S(*)
-C
- M2 = M*M
- IS = M2
- IU = (M2+M)/2
- I = M - 1
-C
- 10 IM = I*M
- 20 S(IS) = U(IU)
- IS = IS - 1
- IU = IU - 1
- IF (IS.GT.IM) GO TO 20
- IS = IS - M + I
- I = I - 1
- IF (I.GE.0) GO TO 10
-C
- IS = 1
- 40 IV = IS
- IH = IS
- 50 IV = IV + M
- IH = IH + 1
- IF (IV.GT.M2) GO TO 60
- S(IH) = S(IV)
- GO TO 50
- 60 IS = IS + M + 1
- IF (IS.LT.M2) GO TO 40
-C
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/ubits.F b/src/packlib/kernlib/kerngen/tcgen/ubits.F
deleted file mode 100644
index 24c0002..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/ubits.F
+++ /dev/null
@@ -1,38 +0,0 @@
-*
-* $Id: ubits.F,v 1.1.1.1 1996/02/15 17:49:51 mclareni Exp $
-*
-* $Log: ubits.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:51 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE UBITS (I,N,K,M)
-C
-C CERN PROGLIB# M503 UBITS .VERSION KERNFOR 3.17 820204
-C
-C ARGUMENTS:
-C I - A FULLWORD ARRAY CONTAINING THE BIT STRING TO BE EXAMINED
-C N - THE NUMBER OF BITS IN THE BIT STRING
-C K - ARRAY TO CONTAIN THE LOCATIONS OF THE BITS WITH VALUE 1
-C M - NUMBER OF BITS FOUND TO HAVE THE VALUE 1
-C
- DIMENSION I(9), K(N)
-C
-C
- CALL UPKBYT (I, 1, K, N, 0)
-C
- J = 0
- DO 10 L=1,N
- IF (K(L).EQ.0) GO TO 10
- J = J + 1
- K(J) = L
- 10 CONTINUE
- M = J
-C
- IF (M.EQ.N) RETURN
- J = J + 1
- DO 20 L=J,N
- 20 K(L) = 0
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/ucocop.F b/src/packlib/kernlib/kerngen/tcgen/ucocop.F
deleted file mode 100644
index 4c518bf..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/ucocop.F
+++ /dev/null
@@ -1,37 +0,0 @@
-*
-* $Id: ucocop.F,v 1.1.1.1 1996/02/15 17:49:51 mclareni Exp $
-*
-* $Log: ucocop.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:51 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE UCOCOP(A,B,IDO,IW,NA,NB)
-C
-C CERN PROGLIB# V302 UCOCOP .VERSION KERNFOR 4.40 940929
-C ORIG. 01/01/70 F.BRUYANT
-C
-#if defined(CERNLIB_QINTCOPY)
- INTEGER A(*),B(*)
-#endif
-#if !defined(CERNLIB_QINTCOPY)
- DIMENSION A(*),B(*)
-#endif
-C
-C
- IF (IDO.EQ.0) RETURN
- IF (IW.EQ.0) RETURN
- K=0
- L=0
- KK=NA-IW
- LL=NB-IW
- DO 20 I=1,IDO
- DO 10 J=1,IW
- K=K+1
- L=L+1
- 10 B(L)=A(K)
- K=K+KK
- 20 L=L+LL
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/udicop.F b/src/packlib/kernlib/kerngen/tcgen/udicop.F
deleted file mode 100644
index 5c36920..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/udicop.F
+++ /dev/null
@@ -1,37 +0,0 @@
-*
-* $Id: udicop.F,v 1.1.1.1 1996/02/15 17:49:51 mclareni Exp $
-*
-* $Log: udicop.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:51 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE UDICOP(A,B,IDO,IW,NA,NB)
-C
-C CERN PROGLIB# V302 UDICOP .VERSION KERNFOR 4.40 940929
-C ORIG. 01/07/71
-C
-#if defined(CERNLIB_QINTCOPY)
- INTEGER A(*),B(*)
-#endif
-#if !defined(CERNLIB_QINTCOPY)
- DIMENSION A(*),B(*)
-#endif
-C
-C
- IF (IDO.EQ.0) RETURN
- IF (IW.EQ.0) RETURN
- K=IW+(IDO-1)*NA
- L=IW+(IDO-1)*NB
- KK=NA-IW
- LL=NB-IW
- DO 40 I=1,IDO
- DO 30 J=1,IW
- B(L)=A(K)
- K=K-1
- 30 L=L-1
- K=K-KK
- 40 L=L-LL
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/uleft.F b/src/packlib/kernlib/kerngen/tcgen/uleft.F
deleted file mode 100644
index a10a41a..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/uleft.F
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: uleft.F,v 1.1.1.1 1996/02/15 17:49:51 mclareni Exp $
-*
-* $Log: uleft.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:51 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE ULEFT (IC,JL,JR)
-C
-C CERN PROGLIB# M410 ULEFT .VERSION KERNFOR 4.08 840613
-C ORIG. 27/05/67
-C
- COMMON /SLATE/NC,JP, DUMMY(38)
- DIMENSION IC(80)
- DATA IBLANK / 4H /
-C
- JP= JL
- JT= JL
- NC= 0
-C
- 12 IF (JT.GT.JR) RETURN
- IF (IC(JT).EQ.IBLANK) GO TO 19
- IF (JP.EQ.JT) GO TO 17
- IC (JP)= IC(JT)
- IC (JT)= IBLANK
- 17 NC= NC+1
- JP= JP+1
- 19 JT= JT+1
- GO TO 12
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/uopt.F b/src/packlib/kernlib/kerngen/tcgen/uopt.F
deleted file mode 100644
index 5be066b..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/uopt.F
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: uopt.F,v 1.1.1.1 1996/02/15 17:49:50 mclareni Exp $
-*
-* $Log: uopt.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:50 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE UOPT (DATA,POSS,IOPT,NP)
-C
-C CERN PROGLIB# M502 UOPT .VERSION KERNFOR 4.18 880425
-C ORIG. 01/08/71
-C
- COMMON /SLATE/IP(30),ID(10)
- DIMENSION DATA(9), POSS(9), IOPT(9)
-#include "kerngen/wordsize.inc"
-C
-C
- CALL UBLOW (POSS,IP,NP)
- CALL VZERO (IOPT,NP)
- L = 1
-C
- 21 CALL UBLOW (DATA(L),ID,NCHAPW)
-C
- DO 24 I=1,NCHAPW
- J = IUCOMP (ID(I),IP,NP)
- IF (J.EQ.0) RETURN
- 24 IOPT(J)= 1
- L = L + 1
- GO TO 21
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/uoptc.F b/src/packlib/kernlib/kerngen/tcgen/uoptc.F
deleted file mode 100644
index b1839d2..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/uoptc.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: uoptc.F,v 1.1.1.1 1996/02/15 17:49:51 mclareni Exp $
-*
-* $Log: uoptc.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:51 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE UOPTC (DATA,POSS,IOPTV)
-C
-C CERN PROGLIB# M502 UOPTC .VERSION KERNFOR 4.10 850320
-C ORIG. 07/11/84, JZ
-C
- INTEGER IOPTV(9)
- CHARACTER *(*) DATA, POSS
-
-
- NP = LEN(POSS)
-
- DO 24 J=1,NP
- IOPTV(J) = 0
- IF (INDEX(DATA,POSS(J:J)).NE.0) IOPTV(J)= 1
- 24 CONTINUE
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/uright.F b/src/packlib/kernlib/kerngen/tcgen/uright.F
deleted file mode 100644
index a82b561..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/uright.F
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: uright.F,v 1.1.1.1 1996/02/15 17:49:51 mclareni Exp $
-*
-* $Log: uright.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:51 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE URIGHT (IC,JL,JR)
-C
-C CERN PROGLIB# M410 URIGHT .VERSION KERNFOR 4.08 840613
-C ORIG. 27/05/67
-C
- COMMON /SLATE/NC,JP, DUMMY(38)
- DIMENSION IC(80)
- DATA IBLANK / 4H /
-C
-C
- JP= JR
- JT= JR
- NC= 0
-C
- 12 IF (JT.LT.JL) RETURN
- IF (IC(JT).EQ.IBLANK) GO TO 19
- IF (JP.EQ.JT) GO TO 17
- IC (JP)= IC(JT)
- IC(JT)= IBLANK
- 17 NC= NC+1
- JP= JP-1
- 19 JT= JT-1
- GO TO 12
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/uset.F b/src/packlib/kernlib/kerngen/tcgen/uset.F
deleted file mode 100644
index a2edb8f..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/uset.F
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: uset.F,v 1.1.1.1 1996/02/15 17:49:51 mclareni Exp $
-*
-* $Log: uset.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:51 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE USET (INT,IC,JL,JR)
-C
-C CERN PROGLIB# M410 USET .VERSION KERNFOR 4.08 840613
-C ORIG. 15/03/68
-C
- COMMON/SLATE/ND,JEND,DUMMY(38)
- DIMENSION IC(80),NUM(11)
- DATA NUM /4H ,4H0 ,4H1 ,4H2 ,4H3 ,4H4 ,4H5 ,
- + 4H6 ,4H7 ,4H8 ,4H9 /
-C
- ND=0
- JEND=JR
- IVAL=INT
-C
- 12 IF (JEND.LT.JL) RETURN
- K=MOD (IVAL,10)
- IC(JEND)=NUM(K+2)
- ND=ND+1
- JEND=JEND-1
- IVAL=IVAL/10
- IF (IVAL.GE.1) GO TO 12
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/utrans.F b/src/packlib/kernlib/kerngen/tcgen/utrans.F
deleted file mode 100644
index 6287edb..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/utrans.F
+++ /dev/null
@@ -1,88 +0,0 @@
-*
-* $Id: utrans.F,v 1.2 2006/09/15 09:35:20 mclareni Exp $
-*
-* $Log: utrans.F,v $
-* Revision 1.2 2006/09/15 09:35:20 mclareni
-* Submitted mods for gcc4/gfortran and MacOSX, corrected to work also on slc4 with gcc3.4 and 4.1
-*
-* Revision 1.1.1.1 1996/02/15 17:49:50 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QMLNX) && !defined(CERNLIB_GFORTRAN)
-#include "lnxgs/utrans.F"
-#else
- SUBROUTINE UTRANS (AI,AJ,NCH,IP,JP)
-C
-C CERN PROGLIB# M409 UTRANS .VERSION KERNFOR 4.18 880425
-C ORIG. 15/09/78 JZ
-C
- COMMON /SLATE/ NI, NJ, MM(38)
-C
- DIMENSION AI(9), AJ(9), NCH(9), IP(9), JP(9)
-C
-#include "kerngen/wordsize.inc"
-C
- NI = 0
- NJ = 0
- NCHL = NCH(1)
- IF (NCHL.LE.0) RETURN
- NCHI = MIN (IP(1), NCHAPW)
- NCHJ = MIN (JP(1), NCHAPW)
- IF (NCHI-NCHJ) 31,41,21
-C
-C---- DISPERSION TO A1
-C
- 21 IF (NCHJ.NE.1) GO TO 41
-C
- 24 N = MIN (NCHL, NCHI)
- NI = NI + 1
- CALL UBLOW (AI(NI),AJ(NJ+1),N)
- NJ = NJ + N
- NCHL = NCHL - N
- IF (NCHL.NE.0) GO TO 24
- RETURN
-C
-C---- CONCENTRATION FROM A1
-C
- 31 IF (NCHI.NE.1) GO TO 41
-C
- 34 N = MIN (NCHL, NCHJ)
- NJ = NJ + 1
- CALL UBUNCH (AI(NI+1),AJ(NJ),N)
- NI = NI + N
- NCHL = NCHL - N
- IF (NCHL.NE.0) GO TO 34
- RETURN
-C
-C---- TRANSFORMATION AI TO AJ
-C
- 41 JA = 0
- JE = 0
- 42 N = MIN (NCHL, NCHJ)
- IF (JA+N.LE.JE) GO TO 47
- IF (JA.NE.JE) GO TO 43
- JA = 1
- JE = 1
- GO TO 44
-C
- 43 IF (JE+NCHI.LT.40) GO TO 44
- NT = JE - JA
- CALL UCOPY (MM(JA),MM(1),NT)
- JA = 1
- JE = NT + 1
-C
- 44 NI = NI + 1
- CALL UBLOW (AI(NI),MM(JE),NCHI)
- JE = JE + NCHI
- IF (JA+N.GT.JE) GO TO 43
-C
- 47 NJ = NJ + 1
- CALL UBUNCH (MM(JA),AJ(NJ),N)
- JA = JA + N
- NCHL = NCHL - N
- IF (NCHL.NE.0) GO TO 42
- RETURN
- END
-#endif
diff --git a/src/packlib/kernlib/kerngen/tcgen/vaxgs/floarg.F b/src/packlib/kernlib/kerngen/tcgen/vaxgs/floarg.F
deleted file mode 100644
index 0105374..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/vaxgs/floarg.F
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: floarg.F,v 1.1.1.1 1996/02/15 17:49:59 mclareni Exp $
-*
-* $Log: floarg.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:59 mclareni
-* Kernlib
-*
-*
- FUNCTION FLOARG (ARGM)
-C
-C CERN PROGLIB# M250 FLOARG .VERSION KERNVAX 2.05 830901
-C ORIG. 22/7/82 ADAPTED FROM UFLINT
-C REPLACED 1/8/83 BY SAFE DO-NOTHING VERSION
-C
- FLOARG= ARGM
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/vaxgs/gshow.F b/src/packlib/kernlib/kerngen/tcgen/vaxgs/gshow.F
deleted file mode 100644
index 468d451..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/vaxgs/gshow.F
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: gshow.F,v 1.1.1.1 1996/02/15 17:49:59 mclareni Exp $
-*
-* $Log: gshow.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:59 mclareni
-* Kernlib
-*
-*
- SUBROUTINE GSHOW (LUN)
-C
-C CERN PROGLIB# Z001 GSHOW .VERSION KERNVAX 1.11 820212
-C ORIG. 12/02/82 JZ
-C
-C-- STORE PAM TITLE INTO /SLATE/ FOR PRINTING BY GSHOWF
-C
- COMMON /SLATE/ CH(40)
-C
- CALL UBLOW(
- + 40HKERNVAX 2.47 1995/07/18 13.58 CERN
- +, CH,40)
- CALL GSHOWF (LUN)
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/vaxgs/ie3foda.F b/src/packlib/kernlib/kerngen/tcgen/vaxgs/ie3foda.F
deleted file mode 100644
index 09aacc0..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/vaxgs/ie3foda.F
+++ /dev/null
@@ -1,37 +0,0 @@
-*
-* $Id: ie3foda.F,v 1.1.1.1 1996/02/15 17:49:59 mclareni Exp $
-*
-* $Log: ie3foda.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:59 mclareni
-* Kernlib
-*
-*
- SUBROUTINE IE3FOD (MS,MT,NDPN,JBAD)
-C
-C CERN PROGLIB# M220 IE3FOD .VERSION KERNVAX 2.44 931108
-C Alfred Nathaniel - 12-Oct-93
-C- Convert double precision for output with copy
-C- from source in native to target in IEEE data format
-
- INTEGER MS(2,*), MT(2,*), IDBL(2)
- DOUBLE PRECISION DBL
- EQUIVALENCE(DBL,IDBL(1))
-
- INCLUDE '($CVTDEF)'
- INTEGER CVT$CONVERT_FLOAT
-
- JBAD = 0
- DO 10 I=1,NDPN
- IDBL(1) = MS(1,I)
- IDBL(2) = MS(2,I)
- ISTAT = CVT$CONVERT_FLOAT(
- + DBL, %VAL(CVT$K_VAX_G),
- + DBL, %VAL(CVT$K_IEEE_T),
- + %VAL(CVT$M_ROUND_TO_NEAREST) )
- IF(.NOT.ISTAT) THEN
- JBAD = I
- ENDIF
- MT(1,I) = IDBL(2)
- MT(2,I) = IDBL(1)
- 10 CONTINUE
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/vaxgs/ie3fodv.F b/src/packlib/kernlib/kerngen/tcgen/vaxgs/ie3fodv.F
deleted file mode 100644
index c8b655d..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/vaxgs/ie3fodv.F
+++ /dev/null
@@ -1,75 +0,0 @@
-*
-* $Id: ie3fodv.F,v 1.1.1.1 1996/02/15 17:49:59 mclareni Exp $
-*
-* $Log: ie3fodv.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:59 mclareni
-* Kernlib
-*
-*
- SUBROUTINE IE3FOD (MS,MT,NDPN,JBAD)
-C
-C CERN PROGLIB# M220 IE3FOD .VERSION KERNVAX 2.20 861204
-
-C- Convert double precision for output with copy
-C- from source in native to target in IEEE data format
-
- DIMENSION MS(99), MT(99)
-
- DOUBLE PRECISION THDB
- DIMENSION THIS(2)
- EQUIVALENCE (THDB,THIS)
- EQUIVALENCE (ITHA,THA,THIS(1)), (ITHB,THB,THIS(2))
-
- PARAMETER (MSKB16 = '00008000'X)
- PARAMETER (IBADCS = '7F80FE00'X)
- PARAMETER (IBADCD = '7FF01FC0'X)
- PARAMETER (IOVPCS = '7F800000'X)
- PARAMETER (IOVPCD = '7FF00000'X)
- PARAMETER (IOVNCS = 'FF800000'X)
- PARAMETER (IOVNCD = 'FFF00000'X)
-
-
- JFAI = 0
- JMS = 0
- JMT = 0
-
- DO 449 JL=1,NDPN
- ITHA = MS(JMS+1)
- IF (ITHA.EQ.0) GO TO 442
- ITHB = MS(JMS+2)
- JSIGN = ITHA .AND. MSKB16
- JEXP = JIBITS (ITHA,7,8)
- IF (JEXP.EQ.0) GO TO 431
- IF (JEXP.EQ.255) GO TO 433
- JMANT = JISHFT (JIBITS(ITHA, 0, 7), 13) .OR. JIBITS(ITHA,19,13)
- ITHB = JISHFT (JIBITS(ITHA,16, 3), 29) .OR.
- + JISHFT (JIBITS(ITHB, 0,16), 13) .OR.
- + JIBITS(ITHB,19,13)
- ITHA = JISHFT(JSIGN,16) .OR. JISHFT(JEXP+894,20) .OR. JMANT
- GO TO 447
-
-C-- zero / NaN
- 431 IF (JSIGN.EQ.0) GO TO 441
- ITHB = IBADCD
- GO TO 436
-
-C-- overflow
- 433 IF (JSIGN.EQ.0) THEN
- ITHB = IOVPCD
- ELSE
- ITHB = IOVNCD
- ENDIF
- 436 JFAI = JL
- ITHA = ITHB
- GO TO 442
-
- 441 ITHA = 0
- 442 ITHB = 0
- 447 MT(JMT+1) = ITHA
- MT(JMT+2) = ITHB
- JMT = JMT + 2
- 449 JMS = JMS + 2
-
- JBAD = JFAI
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/vaxgs/ie3tod.F b/src/packlib/kernlib/kerngen/tcgen/vaxgs/ie3tod.F
deleted file mode 100644
index b074a18..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/vaxgs/ie3tod.F
+++ /dev/null
@@ -1,91 +0,0 @@
-*
-* $Id: ie3tod.F,v 1.1.1.1 1996/02/15 17:49:59 mclareni Exp $
-*
-* $Log: ie3tod.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:59 mclareni
-* Kernlib
-*
-*
- SUBROUTINE IE3TOD (MS,MT,NDPN,JBAD)
-C
-C CERN PROGLIB# M220 IE3TOD .VERSION KERNVAX 2.20 861204
-
-C- Convert double precision for input with copy
-C- from source in IEEE to target in native data format
-
- DIMENSION MS(99), MT(99)
-
- DOUBLE PRECISION THDB
- DIMENSION THIS(2)
- EQUIVALENCE (THDB,THIS)
- EQUIVALENCE (ITHA,THA,THIS(1)), (ITHB,THB,THIS(2))
-
- PARAMETER (JEXMIN = -127, JEXMAX=125)
- PARAMETER (IOVPMS = '00007F81'X)
- PARAMETER (IOVNMS = '0000FF81'X)
- PARAMETER (IBADMS = '00008001'X)
- PARAMETER (IBADMD = IBADMS, IBADME = 0)
- PARAMETER (IOVPMD = IOVPMS, IOVNMD = IOVNMS)
-
-#include "kerngen/q_jbit.inc"
-
- JFAI = 0
- JMS = 0
- JMT = 0
-
- DO 449 JL=1,NDPN
- ITHA = MS(JMS+1)
- IF (ITHA.EQ.0) GO TO 442
- ITHB = MS(JMS+2)
- JSIGN = JBIT (ITHA,32)
- JEXP = JBYT (ITHA,21,11)
- JMANT = JBYT (ITHA, 1,20)
- IF (JEXP.EQ.0) GO TO 431
- IF (JEXP.EQ.2047) GO TO 433
-
- JMANT = JMANT + 1 048 576
- JEXP = JEXP - 1023
- IF (JEXP.GT.JEXMAX) GO TO 432
- 424 IF (JEXP.LT.JEXMIN) GO TO 441
-
- JMANS = JBYT (ITHB,17,16)
- JMANR = JBYT (ITHB, 1,16)
-
- JPRE = ISIGN (48,JEXP)
- THDB = ( DBLE(JMANT)
- + + DBLE(FLOAT(JMANS)*2.**(-16))
- + + DBLE(FLOAT(JMANR)*2.**(-32)) ) * 2.**(JPRE-20)
- THDB = THDB * 2.**(JEXP-JPRE)
- IF (JSIGN.EQ.0) GO TO 447
- THDB = -THDB
- GO TO 447
-
- 431 IF (JMANT.EQ.0) GO TO 441
- JEXP = -1022
- GO TO 424
-
- 432 JMANT = 0
- 433 IF (JMANT.EQ.0) THEN
- IF (JSIGN.EQ.0) THEN
- ITHB = IOVPMD
- ELSE
- ITHB = IOVNMD
- ENDIF
- ELSE
- ITHB = IBADMD
- ENDIF
- JFAI = JL
- ITHA = ITHB
- ITHB = IBADME
- GO TO 447
-
- 441 ITHA = 0
- 442 ITHB = 0
- 447 MT(JMT+1) = ITHA
- MT(JMT+2) = ITHB
- JMT = JMT + 2
- 449 JMS = JMS + 2
-
- JBAD = JFAI
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/vaxgs/intarg.F b/src/packlib/kernlib/kerngen/tcgen/vaxgs/intarg.F
deleted file mode 100644
index 086ea1c..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/vaxgs/intarg.F
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: intarg.F,v 1.1.1.1 1996/02/15 17:49:59 mclareni Exp $
-*
-* $Log: intarg.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:59 mclareni
-* Kernlib
-*
-*
- FUNCTION INTARG (IARGM)
-C
-C CERN PROGLIB# M250 INTARG .VERSION KERNVAX 2.05 830901
-C ORIG. 22/7/82 ADAPTED FROM UFLINT
-C REPLACED 1/8/83 BY SAFE DO-NOTHING VERSION
-C
- INTARG = IARGM
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/vaxgs/iumode.F b/src/packlib/kernlib/kerngen/tcgen/vaxgs/iumode.F
deleted file mode 100644
index d02b1a2..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/vaxgs/iumode.F
+++ /dev/null
@@ -1,47 +0,0 @@
-*
-* $Id: iumode.F,v 1.1.1.1 1996/02/15 17:49:59 mclareni Exp $
-*
-* $Log: iumode.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:59 mclareni
-* Kernlib
-*
-*
- FUNCTION IUMODE (IWP)
-C
-C CERN PROGLIB# M506 IUMODE .VERSION KERNVAX 2.09 840215
-C ORIG. 7/12/79 JZ
-C
- COMMON /CIUMOD/ JMODE, JAMBIG
- DIMENSION IWP(9)
-
-#include "kerngen/q_jbit.inc"
-
- IWORD = IWP(1)
- JAMBIG= 0
- IF (IWORD.EQ.0) GO TO 39
-
- JL = JBYT (IWORD,25,8)
- IF (JMODE.EQ.0) GO TO 31
-
-C-- EXPECT FLOATING
-
- IF (JL.EQ.0) GO TO 24
- IF (JL.NE.255) GO TO 29
- 24 J = JBYT (IWORD,8,8)
- IF (J.EQ.0) GO TO 39
- IF (J.EQ.255) GO TO 39
- JAMBIG = 1
- 29 IUMODE = 1
- RETURN
-
-C-- EXPECT INTEGER
-
- 31 IF (JL.EQ.0) GO TO 32
- IF (JL.NE.255) GO TO 29
- 32 J = JBYT (IWORD,8,8)
- IF (J.EQ.0) GO TO 39
- IF (J.EQ.255) GO TO 39
- JAMBIG = 1
- 39 IUMODE = 0
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/vaxgs/kerngt.F b/src/packlib/kernlib/kerngen/tcgen/vaxgs/kerngt.F
deleted file mode 100644
index 170f582..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/vaxgs/kerngt.F
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: kerngt.F,v 1.1.1.1 1996/02/15 17:49:59 mclareni Exp $
-*
-* $Log: kerngt.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:59 mclareni
-* Kernlib
-*
-*
- SUBROUTINE KERNGT (LUN)
-C
-C CERN PROGLIB# Z001 KERNGT .VERSION KERNVAX 2.31 890323
-C ORIG. 16/03/89 JZ
-C
-C-- Store Pam title into /SLATE/ for printing by GSHOWF
-C
- COMMON /SLATE/ MCH(40)
-
- CALL UBLOW (
- + 40HKERNVAX 2.47 1995/07/18 13.58 CERN
- +, MCH, 40)
- CALL GSHOWF (LUN)
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/vaxsys/getarg.F b/src/packlib/kernlib/kerngen/tcgen/vaxsys/getarg.F
deleted file mode 100644
index c624cea..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/vaxsys/getarg.F
+++ /dev/null
@@ -1,98 +0,0 @@
-*
-* $Id: getarg.F,v 1.1.1.1 1996/02/15 17:49:59 mclareni Exp $
-*
-* $Log: getarg.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:59 mclareni
-* Kernlib
-*
-*
- INTEGER FUNCTION GETARG (JARG,TEXT)
-
-C CERN PROGLIB# Z265 GETARG .VERSION KERNVAX 2.45 940228
-C ORIG. 16/02/94 MM+JS+JZ
-
-C- Simulate UNIX system calls GETARG, IARGC
-
- INCLUDE '($JPIDEF)'
-
- CHARACTER CHWK*1024
- COMMON /CHSLAT/ CHWK
- COMMON /SLATE/ NDSLAT, NESLAT, ISLATE(38)
- CHARACTER TEXT*(*)
- INTEGER*2 LGR
-
- CHARACTER COMD*256
- INTEGER NARGS, NCOMD
- SAVE NARGS, NCOMD, COMD
- DATA NARGS / -1 /
-
-C---- Doing GETARG
-
- GETARG = 0
- MODE = 0
- IF (NARGS.LT.0) GO TO 71
- 22 TEXT = ' '
- IF (JARG.EQ.0) GO TO 41
- IF (JARG.GT.NARGS) RETURN
- IF (JARG.LE.0) RETURN
-
- JNX = 1
- JL = 0
- 24 JL = JL + 1
- JGO = JNX
- JF = ICNEXT (COMD,JGO,NCOMD)
- IF (COMD(JF:JF).EQ.'"') THEN
- JF = JF + 1
- JNX = ICFIND ('"', COMD,JF,NCOMD)
- N = JNX - JF
- JNX = JNX + 1
- ELSE
- JNX = NESLAT
- N = NDSLAT
- ENDIF
- IF (JL.LT.JARG) GO TO 24
- IF (N.GT.0) TEXT(1:N) = COMD(JF:JF+N-1)
- RETURN
-
-C-- doing GETARG (0, TEXT), get image-name as for Unix
-
- 41 NDSLAT = LIB$GETJPI (JPI$_IMAGNAME,,,,CHWK,%REF(LENSTR))
- IF (.NOT.NDSLAT) RETURN
- ISTAT = LIB$TRIM_FILESPEC (CHWK(1:LENSTR),TEXT,LEN(TEXT),)
- NDSLAT = 0
- RETURN
-
-C---- Doing IARGC
-
- ENTRY IARGC()
-
- MODE = 1
- IF (NARGS.LT.0) GO TO 71
- 68 IARGC = NARGS
- RETURN
-
-C---- Load the calling command
-
- 71 COMD = ' '
- CALL LIB$GET_FOREIGN (COMD,,LGR)
-
- NARGS = 0
- IF (LGR.EQ.0) GO TO 77
-
- NCOMD = LNBLNK (COMD(1:LGR))
- IF (NCOMD.EQ.0) GO TO 77
-
- JGO = 1
- 74 NARGS = NARGS + 1
- JF = ICNEXT (COMD,JGO,NCOMD)
- IF (COMD(JF:JF).EQ.'"') THEN
- JF = JF + 1
- JGO = ICFIND ('"', COMD,JF,NCOMD) + 1
- ELSE
- JGO = NESLAT
- ENDIF
- IF (JGO.LE.NCOMD) GO TO 74
-
- 77 IF (MODE.EQ.0) GO TO 22
- GO TO 68
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/vaxsys/traceq.F b/src/packlib/kernlib/kerngen/tcgen/vaxsys/traceq.F
deleted file mode 100644
index da60662..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/vaxsys/traceq.F
+++ /dev/null
@@ -1,30 +0,0 @@
-*
-* $Id: traceq.F,v 1.1.1.1 1996/02/15 17:49:59 mclareni Exp $
-*
-* $Log: traceq.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:59 mclareni
-* Kernlib
-*
-*
- SUBROUTINE TRACEQ (LUN,LEV)
-C
-C CERN PROGLIB# N105 TRACEQ .VERSION KERNVAX 1.09 810226
-C ORIG. 26/02/81, J. BETTELS, CERN
-C
- INTEGER*4 SYS$CRELOG
- CHARACTER ERRFIL*10
-
- ERRFIL = 'FOR000.DAT'
- J = 6
- ND = LUN
- DO 9 I=1,3
- NN = ND/10
- NR = ND - 10*NN
- IF (NR.NE.0) ERRFIL(J:J)=CHAR(NR+ICHAR('0'))
- ND = NN
- J = J - 1
- 9 CONTINUE
- II = SYS$CRELOG (%VAL (2),'SYS$ERROR',ERRFIL,)
- CALL LIB$SIGNAL (%VAL (0))
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/vdist.F b/src/packlib/kernlib/kerngen/tcgen/vdist.F
deleted file mode 100644
index b54f48e..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/vdist.F
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: vdist.F,v 1.1.1.1 1996/02/15 17:49:56 mclareni Exp $
-*
-* $Log: vdist.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:56 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- FUNCTION VDIST (X,Y,N)
-C
-C CERN PROGLIB# F121 VDIST .VERSION KERNFOR 4.06 830526
-C ORIG. 26/09/76
-C
- DIMENSION X(*), Y(*)
-C
- XX = 0.
- IF (N.LE.0) GO TO 24
-C
- DO 9 J=1,N
- 9 XX = XX + (X(J)-Y(J)) **2
- XX = SQRT (XX)
- 24 VDIST = XX
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/vdist2.F b/src/packlib/kernlib/kerngen/tcgen/vdist2.F
deleted file mode 100644
index 2e532c0..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/vdist2.F
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: vdist2.F,v 1.1.1.1 1996/02/15 17:49:56 mclareni Exp $
-*
-* $Log: vdist2.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:56 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- FUNCTION VDIST2 (X,Y,N)
-C
-C CERN PROGLIB# F121 VDIST2 .VERSION KERNFOR 3.01 761204
-C ORIG. 26/09/76
-C
- DIMENSION X(*), Y(*)
-C
- XX = 0.
- IF (N.LE.0) GO TO 24
-C
- DO 9 J=1,N
- 9 XX = XX + (X(J)-Y(J)) **2
- 24 VDIST2 = XX
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/vizpri.F b/src/packlib/kernlib/kerngen/tcgen/vizpri.F
deleted file mode 100644
index c7a6d97..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/vizpri.F
+++ /dev/null
@@ -1,318 +0,0 @@
-*
-* $Id: vizpri.F,v 1.1.1.1 1996/02/15 17:49:51 mclareni Exp $
-*
-* $Log: vizpri.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:51 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE VIZPRI (LUNP,TEXT)
-C
-C CERN PROGLIB# J200 VIZPRI .VERSION KERNFOR 4.22 890913
-C ORIG. 20/07/89, JZ
-C
-C- Visual printing of TEXT
-
- PARAMETER (MXTEXT=9)
- PARAMETER (MXCHAR=14*MXTEXT)
- CHARACTER TEXT*(*)
- CHARACTER LINE*(MXCHAR)
- CHARACTER CHLINE(MXCHAR)*1
- EQUIVALENCE (CHLINE(1),LINE(1:1))
-
- DIMENSION MTRAN(MXTEXT), MBITS(12)
- CHARACTER CHT*1
-
-* unit number for standard output
- PARAMETER (LUNSTP=6)
- INTEGER MPAT(12,93)
- DATA (MPAT(J, 1),J=1,12) / 0, 0, 0, 0, 0, 0,
- + 0, 0, 0, 0, 0, 0 /
- DATA (MPAT(J, 2),J=1,12) / 96, 96, 96, 96, 96, 96,
- + 96, 96, 0, 0, 96, 96 /
- DATA (MPAT(J, 3),J=1,12) / 408, 408, 408, 0, 0, 0,
- + 0, 0, 0, 0, 0, 0 /
- DATA (MPAT(J, 4),J=1,12) / 408, 408, 408,4095,4095, 408,
- + 408,4095,4095, 408, 408, 408 /
- DATA (MPAT(J, 5),J=1,12) / 96,2046,3687, 99, 103,1022,
- + 2044,3680,3168,3687,2046, 96 /
- DATA (MPAT(J, 6),J=1,12) / 0,1564, 788, 412, 192, 96,
- + 48, 24, 460, 326, 451, 0 /
- DATA (MPAT(J, 7),J=1,12) / 120, 252, 204, 204, 252, 120,
- + 3324,3526,1923,1795,4095,3326 /
- DATA (MPAT(J, 8),J=1,12) / 96, 96, 96, 0, 0, 0,
- + 0, 0, 0, 0, 0, 0 /
- DATA (MPAT(J, 9),J=1,12) / 448, 96, 48, 48, 24, 24,
- + 24, 24, 48, 48, 96, 448 /
- DATA (MPAT(J,10),J=1,12) / 56, 96, 192, 192, 384, 384,
- + 384, 384, 192, 192, 96, 56 /
- DATA (MPAT(J,11),J=1,12) / 96,1638,1902,1020, 504,4095,
- + 4095, 504,1020,1902,1638, 96 /
- DATA (MPAT(J,12),J=1,12) / 0, 96, 96, 96, 96,2046,
- + 2046, 96, 96, 96, 96, 0 /
- DATA (MPAT(J,13),J=1,12) / 0, 0, 0, 0, 0, 0,
- + 0, 0, 0, 0, 96, 48 /
- DATA (MPAT(J,14),J=1,12) / 0, 0, 0, 0, 0,2046,
- + 2046, 0, 0, 0, 0, 0 /
- DATA (MPAT(J,15),J=1,12) / 0, 0, 0, 0, 0, 0,
- + 0, 0, 0, 0, 96, 96 /
- DATA (MPAT(J,16),J=1,12) / 0,1536, 768, 384, 192, 96,
- + 48, 24, 12, 6, 3, 0 /
- DATA (MPAT(J,17),J=1,12) /1020,2046,3075,3075,3075,3075,
- + 3075,3075,3075,3075,2046,1020 /
- DATA (MPAT(J,18),J=1,12) / 96, 112, 120, 96, 96, 96,
- + 96, 96, 96, 96,2046,2046 /
- DATA (MPAT(J,19),J=1,12) /2046,4095,3075,3072,3072,1536,
- + 384, 96, 24, 6,4095,4095 /
- DATA (MPAT(J,20),J=1,12) /2046,4095,3075,3072,3072,1920,
- + 1920,3072,3072,3075,4095,2046 /
- DATA (MPAT(J,21),J=1,12) / 448, 480, 432, 408, 396,4094,
- + 4095, 384, 384, 384, 384, 384 /
- DATA (MPAT(J,22),J=1,12) /4095,4095, 3, 3, 3, 511,
- + 1023,1536,3072,3072,4095,2047 /
- DATA (MPAT(J,23),J=1,12) /2046,4095,3075, 3, 3,2047,
- + 4095,3075,3075,3075,4095,2046 /
- DATA (MPAT(J,24),J=1,12) /4095,2047, 771, 384, 192, 96,
- + 96, 96, 96, 96, 96, 96 /
- DATA (MPAT(J,25),J=1,12) /2046,4095,3075,3075,1542,1020,
- + 1020,1542,3075,3075,4095,2046 /
- DATA (MPAT(J,26),J=1,12) /2046,4095,3075,3075,3075,4095,
- + 4095,3072,3072,3075,4095,2046 /
- DATA (MPAT(J,27),J=1,12) / 0, 0, 0, 96, 96, 0,
- + 0, 96, 96, 0, 0, 0 /
- DATA (MPAT(J,28),J=1,12) / 0, 0, 0, 0, 0, 0,
- + 0, 96, 0, 96, 96, 48 /
- DATA (MPAT(J,29),J=1,12) / 384, 192, 96, 48, 24, 12,
- + 12, 24, 48, 96, 192, 384 /
- DATA (MPAT(J,30),J=1,12) / 0, 0, 0,2046,2046, 0,
- + 0,2046,2046, 0, 0, 0 /
- DATA (MPAT(J,31),J=1,12) / 24, 48, 96, 192, 384, 768,
- + 768, 384, 192, 96, 48, 24 /
- DATA (MPAT(J,32),J=1,12) /2046,4095,3075,3072,3584,2016,
- + 992, 96, 96, 0, 96, 96 /
- DATA (MPAT(J,33),J=1,12) /2046,4095,3075,3315,3579,3483,
- + 3483,3571,4083,1795, 63, 62 /
- DATA (MPAT(J,34),J=1,12) /2046,4095,3075,3075,3075,4095,
- + 4095,3075,3075,3075,3075,3075 /
- DATA (MPAT(J,35),J=1,12) /2047,4095,3075,3075,1539,1023,
- + 1023,1539,3075,3075,4095,2047 /
- DATA (MPAT(J,36),J=1,12) /2046,4095,3075, 3, 3, 3,
- + 3, 3, 3,3075,4095,2046 /
- DATA (MPAT(J,37),J=1,12) / 511,1023,1539,3075,3075,3075,
- + 3075,3075,3075,1539,1023, 511 /
- DATA (MPAT(J,38),J=1,12) /4095,4095, 3, 3, 3, 255,
- + 255, 3, 3, 3,4095,4095 /
- DATA (MPAT(J,39),J=1,12) /4095,4095, 3, 3, 3, 255,
- + 255, 3, 3, 3, 3, 3 /
- DATA (MPAT(J,40),J=1,12) /2046,4095,3075, 3, 3, 3,
- + 3971,3971,3075,3075,4095,2046 /
- DATA (MPAT(J,41),J=1,12) /3075,3075,3075,3075,3075,4095,
- + 4095,3075,3075,3075,3075,3075 /
- DATA (MPAT(J,42),J=1,12) /2046,2046, 96, 96, 96, 96,
- + 96, 96, 96, 96,2046,2046 /
- DATA (MPAT(J,43),J=1,12) /4092,4092, 192, 192, 192, 192,
- + 192, 192, 195, 195, 255, 126 /
- DATA (MPAT(J,44),J=1,12) /3075,1539, 771, 387, 195, 127,
- + 127, 195, 387, 771,1539,3075 /
- DATA (MPAT(J,45),J=1,12) / 3, 3, 3, 3, 3, 3,
- + 3, 3, 3, 3,4095,4095 /
- DATA (MPAT(J,46),J=1,12) /3075,3591,3855,3483,3315,3171,
- + 3075,3075,3075,3075,3075,3075 /
- DATA (MPAT(J,47),J=1,12) /3075,3079,3087,3099,3123,3171,
- + 3267,3459,3843,3587,3075,2051 /
- DATA (MPAT(J,48),J=1,12) /4095,4095,3075,3075,3075,3075,
- + 3075,3075,3075,3075,4095,4095 /
- DATA (MPAT(J,49),J=1,12) /2047,4095,3075,3075,3075,4095,
- + 2047, 3, 3, 3, 3, 3 /
- DATA (MPAT(J,50),J=1,12) /2046,4095,3075,3075,3075,3075,
- + 3075,3267,3459,3843,2047,3582 /
- DATA (MPAT(J,51),J=1,12) /2047,4095,3075,3075,3075,4095,
- + 2047, 195, 387, 771,1539,3075 /
- DATA (MPAT(J,52),J=1,12) /2046,4095,3075, 3, 7,1022,
- + 2044,3584,3072,3075,4095,2046 /
- DATA (MPAT(J,53),J=1,12) /4095,4095, 96, 96, 96, 96,
- + 96, 96, 96, 96, 96, 96 /
- DATA (MPAT(J,54),J=1,12) /3075,3075,3075,3075,3075,3075,
- + 3075,3075,3075,3075,4095,2046 /
- DATA (MPAT(J,55),J=1,12) /3075,3075,3075,3075,3075,3075,
- + 3075,1542, 780, 408, 240, 96 /
- DATA (MPAT(J,56),J=1,12) /3075,3075,3075,3075,3075,3075,
- + 3171,3315,3483,3855,3591,3075 /
- DATA (MPAT(J,57),J=1,12) /3075,3075,1542, 780, 408, 240,
- + 240, 408, 780,1542,3075,3075 /
- DATA (MPAT(J,58),J=1,12) /3075,3075,1542, 780, 408, 240,
- + 96, 96, 96, 96, 96, 96 /
- DATA (MPAT(J,59),J=1,12) /4095,4095,1536, 768, 384, 192,
- + 96, 48, 24, 12,4094,4095 /
- DATA (MPAT(J,60),J=1,12) /1020, 12, 12, 12, 12, 12,
- + 12, 12, 12, 12, 12,1020 /
- DATA (MPAT(J,61),J=1,12) / 0, 6, 12, 24, 48, 96,
- + 192, 384, 768,1536,3072, 0 /
- DATA (MPAT(J,62),J=1,12) /1020, 768, 768, 768, 768, 768,
- + 768, 768, 768, 768, 768,1020 /
- DATA (MPAT(J,63),J=1,12) / 96, 240, 408, 780, 0, 0,
- + 0, 0, 0, 0, 0, 0 /
- DATA (MPAT(J,64),J=1,12) / 0, 0, 0, 0, 0, 0,
- + 0, 0, 0, 0,4095,4095 /
- DATA (MPAT(J,65),J=1,12) / 48, 96, 192, 0, 0, 0,
- + 0, 0, 0, 0, 0, 0 /
- DATA (MPAT(J,66),J=1,12) /2046,4095,3075,3075,3075,4095,
- + 4095,3075,3075,3075,3075,3075 /
- DATA (MPAT(J,67),J=1,12) /2047,4095,3075,3075,1539,1023,
- + 1023,1539,3075,3075,4095,2047 /
- DATA (MPAT(J,68),J=1,12) /2046,4095,3075, 3, 3, 3,
- + 3, 3, 3,3075,4095,2046 /
- DATA (MPAT(J,69),J=1,12) / 511,1023,1539,3075,3075,3075,
- + 3075,3075,3075,1539,1023, 511 /
- DATA (MPAT(J,70),J=1,12) /4095,4095, 3, 3, 3, 255,
- + 255, 3, 3, 3,4095,4095 /
- DATA (MPAT(J,71),J=1,12) /4095,4095, 3, 3, 3, 255,
- + 255, 3, 3, 3, 3, 3 /
- DATA (MPAT(J,72),J=1,12) /2046,4095,3075, 3, 3, 3,
- + 3971,3971,3075,3075,4095,2046 /
- DATA (MPAT(J,73),J=1,12) /3075,3075,3075,3075,3075,4095,
- + 4095,3075,3075,3075,3075,3075 /
- DATA (MPAT(J,74),J=1,12) /2046,2046, 96, 96, 96, 96,
- + 96, 96, 96, 96,2046,2046 /
- DATA (MPAT(J,75),J=1,12) /4092,4092, 192, 192, 192, 192,
- + 192, 192, 195, 195, 255, 126 /
- DATA (MPAT(J,76),J=1,12) /3075,1539, 771, 387, 195, 127,
- + 127, 195, 387, 771,1539,3075 /
- DATA (MPAT(J,77),J=1,12) / 3, 3, 3, 3, 3, 3,
- + 3, 3, 3, 3,4095,4095 /
- DATA (MPAT(J,78),J=1,12) /3075,3591,3855,3483,3315,3171,
- + 3075,3075,3075,3075,3075,3075 /
- DATA (MPAT(J,79),J=1,12) /3075,3079,3087,3099,3123,3171,
- + 3267,3459,3843,3587,3075,2051 /
- DATA (MPAT(J,80),J=1,12) /4095,4095,3075,3075,3075,3075,
- + 3075,3075,3075,3075,4095,4095 /
- DATA (MPAT(J,81),J=1,12) /2047,4095,3075,3075,3075,4095,
- + 2047, 3, 3, 3, 3, 3 /
- DATA (MPAT(J,82),J=1,12) /2046,4095,3075,3075,3075,3075,
- + 3075,3267,3459,3843,2047,3582 /
- DATA (MPAT(J,83),J=1,12) /2047,4095,3075,3075,3075,4095,
- + 2047, 195, 387, 771,1539,3075 /
- DATA (MPAT(J,84),J=1,12) /2046,4095,3075, 3, 7,1022,
- + 2044,3584,3072,3075,4095,2046 /
- DATA (MPAT(J,85),J=1,12) /4095,4095, 96, 96, 96, 96,
- + 96, 96, 96, 96, 96, 96 /
- DATA (MPAT(J,86),J=1,12) /3075,3075,3075,3075,3075,3075,
- + 3075,3075,3075,3075,4095,2046 /
- DATA (MPAT(J,87),J=1,12) /3075,3075,3075,3075,3075,3075,
- + 3075,1542, 780, 408, 240, 96 /
- DATA (MPAT(J,88),J=1,12) /3075,3075,3075,3075,3075,3075,
- + 3171,3315,3483,3855,3591,3075 /
- DATA (MPAT(J,89),J=1,12) /3075,3075,1542, 780, 408, 240,
- + 240, 408, 780,1542,3075,3075 /
- DATA (MPAT(J,90),J=1,12) /3075,3075,1542, 780, 408, 240,
- + 96, 96, 96, 96, 96, 96 /
- DATA (MPAT(J,91),J=1,12) /4095,4095,1536, 768, 384, 192,
- + 96, 48, 24, 12,4094,4095 /
- DATA (MPAT(J,92),J=1,12) / 0, 0, 0, 0, 0, 0,
- + 0, 0, 0, 0, 0, 0 /
- DATA (MPAT(J,93),J=1,12) / 96, 96, 96, 96, 96, 96,
- + 96, 96, 96, 96, 96, 96 /
-#if defined(CERNLIB_QEBCDIC)
-C-- EBCDIC to ASCII translation table
- DIMENSION MEBCD(188)
-C- ? ? ? ? ? ? ? ? ? ? ? . < ( + | & ? ?
-C- ? ? ? ? ? ? ? ! $ * ) ; ~ - / ? ? ? ? ?
-C- ? ? ? ^ , % _ > ? ? ? ? ? ? ? ? ? ? ` :
-C- # @ ' = " ? a b c d e f g h i ? { ? ? ?
-C- ? ? j k l m n o p q r ? } ? ? ? ? ? ? s
-C- t u v w x y z ? ? ? [ ? ? ? ? ? ? ? ? ?
-C- ? ? ? ? ? ? ] ? ? ? A B C D E F G H I ?
-C- ? ? ? ? ? ? J K L M N O P Q R ? ? ? ? ?
-C- ? \ ? S T U V W X Y Z ? ? ? ? ? ? 0 1 2
-C- 3 4 5 6 7 8 9
-
- DATA MEBCD / 32, 32, 32, 32, 32, 32, 32, 32, 32, 32
- +, 32, 32, 46, 60, 40, 43,124, 38, 32, 32
- +, 32, 32, 32, 32, 32, 32, 32, 33, 36, 42
- +, 41, 59,126, 45, 47, 32, 32, 32, 32, 32
- +, 32, 32, 32, 94, 44, 37, 95, 62, 63, 32
- +, 32, 32, 32, 32, 32, 32, 32, 32, 96, 58
- +, 35, 64, 39, 61, 34, 32, 97, 98, 99,100
- +, 101,102,103,104,105, 32,123, 32, 32, 32
- +, 32, 32,106,107,108,109,110,111,112,113
- +, 114, 32,125, 32, 32, 32, 32, 32, 32,115
- +, 116,117,118,119,120,121,122, 32, 32, 32
- +, 91, 32, 32, 32, 32, 32, 32, 32, 32, 32
- +, 32, 32, 32, 32, 32, 32, 93, 32, 32, 32
- +, 65, 66, 67, 68, 69, 70, 71, 72, 73, 32
- +, 32, 32, 32, 32, 32, 32, 74, 75, 76, 77
- +, 78, 79, 80, 81, 82, 32, 32, 32, 32, 32
- +, 32, 92, 32, 83, 84, 85, 86, 87, 88, 89
- +, 90, 32, 32, 32, 32, 32, 32, 48, 49, 50
- +, 51, 52, 53, 54, 55, 56, 57, 32 /
-#endif
-
-
- LUN = LUNP
- IF (LUN.EQ.0) LUN = LUNSTP
-
- NTXL = MIN (MXTEXT, LEN(TEXT))
- IF (NTXL.LE.0) GO TO 41
-
-C---- Translate TEXT to table pointers
-
-#if defined(CERNLIB_QASCII)
- DO 24 J=1,NTXL
- JV = ICHAR(TEXT(J:J))
- JV = MAX (JV-31, 1)
- IF (JV.GE.94) JV = 1
- 24 MTRAN(J) = JV
-#endif
-#if defined(CERNLIB_QEBCDIC)
- DO 24 J=1,NTXL
- JV = ICHAR(TEXT(J:J))
- JV = MAX (JV-62, 1)
- JV = MIN (188,JV)
- JV = MEBCD(JV) - 31
- IF (JV.GE.94) JV = 1
- 24 MTRAN(J) = JV
-#endif
-
- 26 IF (MTRAN(NTXL).EQ.1) THEN
- IF (NTXL.EQ.1) GO TO 41
- NTXL = NTXL - 1
- GO TO 26
- ENDIF
- NCHL = NTXL * 14
-
-C----- Print the 1+12+1 lines representing TEXT
-
- WRITE (LUN,9001)
- 9001 FORMAT (1X)
-
- DO 39 JLN=1,12
- LINE(1:NCHL) = ' '
- JCH = 1
-
- DO 37 JTX=1,NTXL
- CHT = TEXT(JTX:JTX)
- JTB = MTRAN(JTX)
- CALL UPKBYT (MPAT(JLN,JTB),1,MBITS,12,0)
-
- JCH = JCH + 1
- DO 35 J=1,12
- IF (MBITS(J).NE.0) CHLINE(JCH) = CHT
- 35 JCH = JCH + 1
- 37 JCH = JCH + 1
-
- N = LNBLNK (LINE(1:NCHL))
- WRITE (LUN,9037) LINE(1:N)
- 9037 FORMAT (A)
-
- 39 CONTINUE
- WRITE (LUN,9001)
- RETURN
-
-C---- TEXT is empty
-
- 41 DO 44 J=1,14
- WRITE (LUN,9001)
- 44 CONTINUE
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/vlinco.F b/src/packlib/kernlib/kerngen/tcgen/vlinco.F
deleted file mode 100644
index 28f3c0d..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/vlinco.F
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: vlinco.F,v 1.1.1.1 1996/02/15 17:49:56 mclareni Exp $
-*
-* $Log: vlinco.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:56 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE VLINCO (B,ALPHA,C,BETA,A,N)
-C
-C CERN PROGLIB# F121 VLINCO .VERSION KERNFOR 4.12 850702
-C ORIG. 01/07/71 VLINE; CHANGE NAME TO VLINCO 02/07/85
-C
- DIMENSION A(*),B(*),C(*)
-C
- IF (N.LE.0) RETURN
- DO 9 I= 1,N
- 9 A(I)= B(I)*ALPHA + C(I)*BETA
-C
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/wntgs/ibits.F b/src/packlib/kernlib/kerngen/tcgen/wntgs/ibits.F
deleted file mode 100644
index 4b1983f..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/wntgs/ibits.F
+++ /dev/null
@@ -1,15 +0,0 @@
-*
-* $Id: ibits.F,v 1.1 1997/02/04 17:36:21 mclareni Exp $
-*
-* $Log: ibits.F,v $
-* Revision 1.1 1997/02/04 17:36:21 mclareni
-* Merge Winnt and 97a versions
-*
-* Revision 1.1.1.1 1996/02/15 17:49:57 mclareni
-* Kernlib
-*
-*
- FUNCTION IBITS (IZW,IZP,NZB)
- IBITS = ISHFTR (LSHIFT(IZW,32-IZP-NZB), 32-NZB)
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgen/wntgs/kerngt.F b/src/packlib/kernlib/kerngen/tcgen/wntgs/kerngt.F
deleted file mode 100644
index 1e37b66..0000000
--- a/src/packlib/kernlib/kerngen/tcgen/wntgs/kerngt.F
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: kerngt.F,v 1.1 1997/02/04 17:36:21 mclareni Exp $
-*
-* $Log: kerngt.F,v $
-* Revision 1.1 1997/02/04 17:36:21 mclareni
-* Merge Winnt and 97a versions
-*
-* Revision 1.1.1.1 1996/02/15 17:49:57 mclareni
-* Kernlib
-*
-*
- SUBROUTINE KERNGT (LUN)
-C
-C CERN PROGLIB# Z001 KERNGT .VERSION KERNDOS 1.00 920624
-C ORIG. 16/03/89
-C
-C-- Store Pam title into /SLATE/ for printing by GSHOWF
-
- COMMON /SLATE/ MCH(40)
-
-
- CALL UCTOH1 (
- + ' KERNNT 1.00/0 960510 12.23 by V.Fine '
- +, MCH, 40)
- CALL GSHOWF (LUN)
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgenc/Imakefile b/src/packlib/kernlib/kerngen/tcgenc/Imakefile
deleted file mode 100644
index e2fb308..0000000
--- a/src/packlib/kernlib/kerngen/tcgenc/Imakefile
+++ /dev/null
@@ -1,11 +0,0 @@
-SRCS_F= abend.F accessf.F exitf.F \ @@\
- intrac.F jumpxn.F lnblnk.F locb.F locf.F qnexte.F unlinkf.F
-
-#ifndef CERNLIB_OS9
-SRCS_F := $(SRCS_F) timed.F timel.F timex.F
-#ifndef CERNLIB_VAXVMS
-SRCS_F := $(SRCS_F) timest.F
-#endif
-#endif
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kerngen/tcgenc/abend.F b/src/packlib/kernlib/kerngen/tcgenc/abend.F
deleted file mode 100644
index c188888..0000000
--- a/src/packlib/kernlib/kerngen/tcgenc/abend.F
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: abend.F,v 1.1.1.1 1996/02/15 17:50:37 mclareni Exp $
-*
-* $Log: abend.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:37 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QMSUN)
-#include "sungs/abend.F"
-#elif defined(CERNLIB_QMVAX)
-#include "vaxgs/abend.F"
-#else
- SUBROUTINE ABEND
-C
-C CERN PROGLIB# Z035 ABEND .VERSION KERNFOR 4.31 911111
-C ORIG. 8/02/88 JZ
-C
-
- STOP 7
- END
-#endif
diff --git a/src/packlib/kernlib/kerngen/tcgenc/accessf.F b/src/packlib/kernlib/kerngen/tcgenc/accessf.F
deleted file mode 100644
index abaa680..0000000
--- a/src/packlib/kernlib/kerngen/tcgenc/accessf.F
+++ /dev/null
@@ -1,67 +0,0 @@
-*
-* $Id: accessf.F,v 1.1.1.1 1996/02/15 17:50:37 mclareni Exp $
-*
-* $Log: accessf.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:37 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- LOGICAL FUNCTION ACCESSF (FNAME, MODE)
-C
-C CERN PROGLIB# Z265 ACCESSF .VERSION KERNFOR 4.39 940228
-C ORIG. 17/02/94, JZ
-C
- CHARACTER FNAME*(*)
- LOGICAL THERE
-
-C-- Does the file exist?
-
- INQUIRE (FILE=FNAME,EXIST=THERE)
- IF (.NOT.THERE) GO TO 39
-
- MRW = JBYT (MODE,1,2)
- IF (MRW.LT.2) GO TO 49
-
-C-- Find a free LUN
-
- DO 17 LUN=8,49
- INQUIRE (UNIT=LUN,OPENED=THERE)
- IF (.NOT.THERE) GO TO 21
- 17 CONTINUE
- GO TO 39
-
-C-- Try to open the file
-
-C- R_OK 4 test for read permission
-C- W_OK 2 test for write permission
-C- X_OK 1 test for execute (search) permission
-C- F_OK 0 test for presence of file
-
-
- 21 IF (MRW.LT.4) GO TO 31
- OPEN (LUN,FILE=FNAME,STATUS='OLD'
- +, FORM='FORMATTED', IOSTAT=ISTAT)
- IF (ISTAT.EQ.0) GO TO 31
-
- OPEN (LUN,FILE=FNAME,STATUS='OLD'
- +, FORM='UNFORMATTED', IOSTAT=ISTAT)
- IF (ISTAT.NE.0) GO TO 38
-
- 31 IF (MRW.EQ.4) GO TO 48
- OPEN (LUN,FILE=FNAME,STATUS='UNKNOWN'
- +, FORM='FORMATTED', IOSTAT=ISTAT)
- IF (ISTAT.EQ.0) GO TO 48
-
- OPEN (LUN,FILE=FNAME,STATUS='UNKNOWN'
- +, FORM='UNFORMATTED', IOSTAT=ISTAT)
- IF (ISTAT.EQ.0) GO TO 48
-
- 38 CLOSE (LUN)
- 39 ACCESSF = .FALSE.
- RETURN
-
- 48 CLOSE (LUN)
- 49 ACCESSF = .TRUE.
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgenc/datime.F b/src/packlib/kernlib/kerngen/tcgenc/datime.F
deleted file mode 100644
index bac3bc9..0000000
--- a/src/packlib/kernlib/kerngen/tcgenc/datime.F
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: datime.F,v 1.1.1.1 1996/02/15 17:50:37 mclareni Exp $
-*
-* $Log: datime.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:37 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QMMPW)
-#include "mpwgs/datime.F"
-#elif defined(CERNLIB_QMSUN)
-#include "sungs/datime.F"
-#elif defined(CERNLIB_QMVAX)
-#include "vaxgs/datime.F"
-#else
- SUBROUTINE DATIME (ID,IT)
-C
-C CERN PROGLIB# Z007 DATIME DUMMY .VERSION KERNFOR 4.22 890913
-C
-C- DUMMY FOR NON-ESSENTIAL ROUTINE STILL MISSING ON YOUR MACHINE
-
- COMMON /SLATE/ ISLATE(40)
-
- DO 24 J=1,6
- 24 ISLATE(J) = 0
-
- ID = 790929
- IT = 1200
- RETURN
- END
-#endif
diff --git a/src/packlib/kernlib/kerngen/tcgenc/datimh.F b/src/packlib/kernlib/kerngen/tcgenc/datimh.F
deleted file mode 100644
index c54327d..0000000
--- a/src/packlib/kernlib/kerngen/tcgenc/datimh.F
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: datimh.F,v 1.1.1.1 1996/02/15 17:50:37 mclareni Exp $
-*
-* $Log: datimh.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:37 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QMMPW)
-#include "mpwgs/datimh.F"
-#elif defined(CERNLIB_QMSUN)
-#include "sungs/datimh.F"
-#elif defined(CERNLIB_QMVAX)
-#include "vaxgs/datimh.F"
-#else
- SUBROUTINE DATIMH (ND,NT)
-C
-C CERN PROGLIB# Z007 DATIMH DUMMY .VERSION KERNFOR 4.03 821008
-C
-C- DUMMY FOR NON-ESSENTIAL ROUTINE STILL MISSING ON YOUR MACHINE
-
- DIMENSION ND(9), NT(9)
- DIMENSION M(8)
-
- CALL UBLOW (8H29/09/79,M,8)
- CALL UBUNCH (M,ND,8)
- CALL UBLOW (8H12.00.00,M,8)
- CALL UBUNCH (M,NT,8)
- RETURN
- END
-#endif
diff --git a/src/packlib/kernlib/kerngen/tcgenc/exitf.F b/src/packlib/kernlib/kerngen/tcgenc/exitf.F
deleted file mode 100644
index 5cef0a8..0000000
--- a/src/packlib/kernlib/kerngen/tcgenc/exitf.F
+++ /dev/null
@@ -1,51 +0,0 @@
-*
-* $Id: exitf.F,v 1.1.1.1 1996/02/15 17:50:37 mclareni Exp $
-*
-* $Log: exitf.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:37 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE EXITF (ICODE)
-C
-C CERN PROGLIB# Z035 EXITF .VERSION KERNFOR 4.39 940228
-C ORIG. 15/12/93 JS + JZ
-C
-
- IC = IABS(ICODE)
-
-#if defined(CERNLIB_QMVAX)
-
- CALL SYS$EXIT(%VAL(IC))
-
-#endif
-#if !defined(CERNLIB_QMVAX)
-
- IF (IC.EQ.0) STOP
-
- GOTO (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20),IC
- STOP 255
-
- 1 STOP 1
- 2 STOP 2
- 3 STOP 3
- 4 STOP 4
- 5 STOP 5
- 6 STOP 6
- 7 STOP 7
- 8 STOP 8
- 9 STOP 9
- 10 STOP 10
- 11 STOP 11
- 12 STOP 12
- 13 STOP 13
- 14 STOP 14
- 15 STOP 15
- 16 STOP 16
- 17 STOP 17
- 18 STOP 18
- 19 STOP 19
- 20 STOP 20
-#endif
- END
diff --git a/src/packlib/kernlib/kerngen/tcgenc/intrac.F b/src/packlib/kernlib/kerngen/tcgenc/intrac.F
deleted file mode 100644
index 759480e..0000000
--- a/src/packlib/kernlib/kerngen/tcgenc/intrac.F
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: intrac.F,v 1.1.1.1 1996/02/15 17:50:37 mclareni Exp $
-*
-* $Log: intrac.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:37 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QMVAX)
-#include "vaxsys/intrac.F"
-#elif defined(CERNLIB_QMMPW)
-#include "mpwgs/intrac.F"
-#elif defined(CERNLIB_QMSUN)
-#include "sungs/intrac.F"
-#else
- LOGICAL FUNCTION INTRAC(DUMMY)
-C
-C CERN PROGLIB# Z044 INTRAC .VERSION KERNFOR 4.10 850320
-C ORIG. 20/02/83 HRR, DUMMY VERSION
-C
- INTRAC = .FALSE.
- RETURN
- END
-#endif
diff --git a/src/packlib/kernlib/kerngen/tcgenc/jumpxn.F b/src/packlib/kernlib/kerngen/tcgenc/jumpxn.F
deleted file mode 100644
index 5e8f676..0000000
--- a/src/packlib/kernlib/kerngen/tcgenc/jumpxn.F
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: jumpxn.F,v 1.1.1.1 1996/02/15 17:50:37 mclareni Exp $
-*
-* $Log: jumpxn.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:37 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QMVAX)
-#include "vaxsys/jumpx2.F"
-#elif defined(CERNLIB_QMMPW)
-#include "mpwgs/jumpxn.F"
-#else
- SUBROUTINE JUMPXN
-C CERN PROGLIB# Z042 JUMPXN dummy .VERSION KERNFOR 4.23 891215
-
- ENTRY JUMPAD (TARGET)
- ENTRY JUMPST (TARGET)
- ENTRY JUMPX0
- ENTRY JUMPX1 (PAR1)
- ENTRY JUMPX2 (PAR1,PAR2)
- ENTRY JUMPX3 (PAR1,PAR2,PAR3)
- ENTRY JUMPX4 (PAR1,PAR2,PAR3,PAR4)
-
- PRINT 9001
- CALL ABEND
-
- 9001 FORMAT (' **** Dummy JUMPAD / JUMPXN reached ****')
- END
-#endif
diff --git a/src/packlib/kernlib/kerngen/tcgenc/lnblnk.F b/src/packlib/kernlib/kerngen/tcgenc/lnblnk.F
deleted file mode 100644
index b3d9565..0000000
--- a/src/packlib/kernlib/kerngen/tcgenc/lnblnk.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: lnblnk.F,v 1.1.1.1 1996/02/15 17:50:38 mclareni Exp $
-*
-* $Log: lnblnk.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:38 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- FUNCTION LNBLNK (CHV)
-C
-C CERN PROGLIB# M432 LNBLNK .VERSION KERNFOR 4.21 890323
-C ORIG. 04/10/88, JZ
-C
-C- Find last non-blank character in CHV
-
- CHARACTER CHV*(*)
-
- N = LEN(CHV)
-
- DO 17 JJ= N,1,-1
- IF (CHV(JJ:JJ).NE.' ') GO TO 99
- 17 CONTINUE
- JJ = 0
-
- 99 LNBLNK = JJ
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgenc/locb.F b/src/packlib/kernlib/kerngen/tcgenc/locb.F
deleted file mode 100644
index 12f3d85..0000000
--- a/src/packlib/kernlib/kerngen/tcgenc/locb.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: locb.F,v 1.1.1.1 1996/02/15 17:50:37 mclareni Exp $
-*
-* $Log: locb.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:37 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QMMPW)
-#include "mpwgs/locb.F"
-#elif defined(CERNLIB_QMSUN)
-#include "sungs/locb.F"
-#elif defined(CERNLIB_QMVAX)
-#include "vaxgs/locb.F"
-#else
- FUNCTION LOCB (IVAR)
-C
-C CERN PROGLIB# N100 LOCB .VERSION KERNFOR 4.23 891215
-C
-C- This is a default which works on several machines
-C
- DIMENSION IVAR(9)
-
- LOCB = LOC (IVAR)
- RETURN
- END
-#endif
diff --git a/src/packlib/kernlib/kerngen/tcgenc/locf.F b/src/packlib/kernlib/kerngen/tcgenc/locf.F
deleted file mode 100644
index b168c47..0000000
--- a/src/packlib/kernlib/kerngen/tcgenc/locf.F
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: locf.F,v 1.1.1.1 1996/02/15 17:50:37 mclareni Exp $
-*
-* $Log: locf.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:37 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QMMPW)
-#include "mpwgs/locf.F"
-#elif defined(CERNLIB_QMSUN)
-#include "sungs/locf.F"
-#elif defined(CERNLIB_QMVAX)
-#include "vaxgs/locf.F"
-#else
- FUNCTION LOCF (IVAR)
-C
-C CERN PROGLIB# N100 LOCF .VERSION KERNFOR 4.34 930114
-C
-C- This is a default which works on several machines
-C
- DIMENSION IVAR(9)
-* Number of ADdress Units Per Word for Fortran
-C and its logarithm base 2
- PARAMETER (NADUPW=4, LADUPW=2)
-
- J = LOC(IVAR)
- LOCF = ISHFT (J, -LADUPW)
- END
-#endif
diff --git a/src/packlib/kernlib/kerngen/tcgenc/mpwgs/datime.F b/src/packlib/kernlib/kerngen/tcgenc/mpwgs/datime.F
deleted file mode 100644
index 170d2e2..0000000
--- a/src/packlib/kernlib/kerngen/tcgenc/mpwgs/datime.F
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: datime.F,v 1.1.1.1 1996/02/15 17:50:40 mclareni Exp $
-*
-* $Log: datime.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:40 mclareni
-* Kernlib
-*
-*
- SUBROUTINE DATIME(ID,IT)
-C
-C CERN PROGLIB# Z007 DATIME .VERSION KERNMPW 1.00 891208
-C
- COMMON / SLATE / IYEAR, IMONTH, IDAY, IHH, IMM, ISS, HDUM(36)
- CHARACTER*8 CTIME
-
- CALL TIME(CTIME)
- CALL IDATE(IMONTH,IDAY,IYEAR)
- READ(CTIME,'(I2,1X,I2,1X,I2)') IHH,IMM,ISS
- ID = IYEAR * 10000 + IMONTH * 100 +IDAY
- IT = IHH * 100 + IMM
- IYEAR = IYEAR + 1900
- END
diff --git a/src/packlib/kernlib/kerngen/tcgenc/mpwgs/datimh.F b/src/packlib/kernlib/kerngen/tcgenc/mpwgs/datimh.F
deleted file mode 100644
index 4944daf..0000000
--- a/src/packlib/kernlib/kerngen/tcgenc/mpwgs/datimh.F
+++ /dev/null
@@ -1,42 +0,0 @@
-*
-* $Id: datimh.F,v 1.1.1.1 1996/02/15 17:50:40 mclareni Exp $
-*
-* $Log: datimh.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:40 mclareni
-* Kernlib
-*
-*
- SUBROUTINE DATIMH(ND,NT)
-C
-C CERN PROGLIB# Z007 DATIMH .VERSION KERNMPW 1.00 891208
-C
- INTEGER NT(2), ND(2)
- CHARACTER*8 CTIME
- CHARACTER*6 CDATE
-C
- CALL TIME(CTIME)
- CALL IDATE(IMONTH,IDAY,IYEAR)
- WRITE(CDATE,'(3I2.2)') IDAY, IMONTH, IYEAR
- NT(1) = 0
- NT(2) = 0
- ND(1) = 0
- ND(2) = 0
-C
- NT(2) = ICHAR(CTIME(8:8))
- NT(2) = IOR(ISHFT(ICHAR(CTIME(7:7)),8),NT(2))
- NT(2) = IOR(ISHFT(ICHAR('.'),16),NT(2))
- NT(2) = IOR(ISHFT(ICHAR(CTIME(5:5)),24),NT(2))
- NT(1) = ICHAR(CTIME(4:4))
- NT(1) = IOR(ISHFT(ICHAR('.'),8),NT(1))
- NT(1) = IOR(ISHFT(ICHAR(CTIME(2:2)),16),NT(1))
- NT(1) = IOR(ISHFT(ICHAR(CTIME(1:1)),24),NT(1))
-C
- ND(2) = ICHAR(CDATE(6:6))
- ND(2) = IOR(ISHFT(ICHAR(CDATE(5:5)),8),ND(2))
- ND(2) = IOR(ISHFT(ICHAR('/'),16),ND(2))
- ND(2) = IOR(ISHFT(ICHAR(CDATE(4:4)),24),ND(2))
- ND(1) = ICHAR(CDATE(3:3))
- ND(1) = IOR(ISHFT(ICHAR('/'),8),ND(1))
- ND(1) = IOR(ISHFT(ICHAR(CDATE(2:2)),16),ND(1))
- ND(1) = IOR(ISHFT(ICHAR(CDATE(1:1)),24),ND(1))
- END
diff --git a/src/packlib/kernlib/kerngen/tcgenc/mpwgs/intrac.F b/src/packlib/kernlib/kerngen/tcgenc/mpwgs/intrac.F
deleted file mode 100644
index edb0771..0000000
--- a/src/packlib/kernlib/kerngen/tcgenc/mpwgs/intrac.F
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: intrac.F,v 1.1.1.1 1996/02/15 17:50:40 mclareni Exp $
-*
-* $Log: intrac.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:40 mclareni
-* Kernlib
-*
-*
- LOGICAL FUNCTION INTRAC (DUMMY)
-C
-C CERN PROGLIB# Z044 INTRAC .VERSION KERNMPW 1.00 891208
-C ORIG. 23/03/88 JZ
-C
-C-- Difficult to say, the MAC is always interactive but...
-
- INTRAC = .TRUE.
- END
diff --git a/src/packlib/kernlib/kerngen/tcgenc/mpwgs/jumpxn.F b/src/packlib/kernlib/kerngen/tcgenc/mpwgs/jumpxn.F
deleted file mode 100644
index 6a2a678..0000000
--- a/src/packlib/kernlib/kerngen/tcgenc/mpwgs/jumpxn.F
+++ /dev/null
@@ -1,64 +0,0 @@
-*
-* $Id: jumpxn.F,v 1.1.1.1 1996/02/15 17:50:40 mclareni Exp $
-*
-* $Log: jumpxn.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:40 mclareni
-* Kernlib
-*
-*
- SUBROUTINE JUMPX2 (IPARA,IPARB)
-C
-C CERN PROGLIB# Z042 JUMPX2 .VERSION KERNMPW 1.00 891208
-C ORIG. 21/04/88 FCA
-C
-C- To transfer to the user routine TARGET (say) with 2 parameters
-C- three steps are needed :
-
-C- 1) EXTERNAL TARGET to get the address of TARGET
-C- IADR = JUMPAD (TARGET)
-
-C- 2) CALL JUMPST (IADR) to set the tranfer address
-
-C- 3) CALL JUMPX2 (par1,par2) to transfer
-
- DIMENSION IPARA(9), IPARB(9)
-
- SAVE JTARGE
-
- CALL JUMPY2 (%VAL(JTARGE),IPARA,IPARB)
- RETURN
-
- ENTRY JUMPX1 (IPARA)
-
- CALL JUMPY1 (%VAL(JTARGE),IPARA)
- RETURN
-
- ENTRY JUMPX0
-
- CALL JUMPY0 (%VAL(JTARGE))
- RETURN
-
- ENTRY JUMPST (JADR)
-
- JTARGE = JADR
- END
-C-----------------------------------------------------
- SUBROUTINE JUMPY2 (TARSUB,IPARA,IPARB)
- DIMENSION IPARA(9), IPARB(9)
- EXTERNAL TARSUB
-
- CALL TARSUB (IPARA,IPARB)
- END
-C-----------------------------------------------------
- SUBROUTINE JUMPY1 (TARSUB,IPARA)
- DIMENSION IPARA(9)
- EXTERNAL TARSUB
-
- CALL TARSUB (IPARA)
- END
-C-----------------------------------------------------
- SUBROUTINE JUMPY0 (TARSUB)
- EXTERNAL TARSUB
-
- CALL TARSUB
- END
diff --git a/src/packlib/kernlib/kerngen/tcgenc/mpwgs/locb.F b/src/packlib/kernlib/kerngen/tcgenc/mpwgs/locb.F
deleted file mode 100644
index fbab999..0000000
--- a/src/packlib/kernlib/kerngen/tcgenc/mpwgs/locb.F
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: locb.F,v 1.1.1.1 1996/02/15 17:50:40 mclareni Exp $
-*
-* $Log: locb.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:40 mclareni
-* Kernlib
-*
-*
- FUNCTION LOCB (AM)
-C
-C CERN PROGLIB# N101 LOCB .VERSION KERNMPW 1.00 891208
-C ORIG. 13/12/83 F.Carminati
-C
- DIMENSION AM(*)
-
- LOCB= %LOC (AM(1))
- END
diff --git a/src/packlib/kernlib/kerngen/tcgenc/mpwgs/locf.F b/src/packlib/kernlib/kerngen/tcgenc/mpwgs/locf.F
deleted file mode 100644
index bba968a..0000000
--- a/src/packlib/kernlib/kerngen/tcgenc/mpwgs/locf.F
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: locf.F,v 1.1.1.1 1996/02/15 17:50:40 mclareni Exp $
-*
-* $Log: locf.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:40 mclareni
-* Kernlib
-*
-*
- FUNCTION LOCF (AM)
-C
-C CERN PROGLIB# N100 LOCF .VERSION KERNMPW 1.00 891208
-C ORIG. 13/12/83 F.Carminati
-C
- DIMENSION AM(*)
-
- LOCF= %LOC (AM(1))
- LOCF= ISHFT(LOCF, -2)
- END
diff --git a/src/packlib/kernlib/kerngen/tcgenc/qnexte.F b/src/packlib/kernlib/kerngen/tcgenc/qnexte.F
deleted file mode 100644
index 01e1e77..0000000
--- a/src/packlib/kernlib/kerngen/tcgenc/qnexte.F
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: qnexte.F,v 1.1.1.1 1996/02/15 17:50:37 mclareni Exp $
-*
-* $Log: qnexte.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:37 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE QNEXTE
-C
-C CERN PROGLIB# Z041 QNEXTE .VERSION KERNFOR 4.09 840827
-C
-C- START PROCESSING, USER CALLED
-C- FORTRAN VERSION, THIS IS NOT GOOD ENOUGH ON MOST MACHINES
-
- CALL QNEXT
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgenc/sungs/abend.F b/src/packlib/kernlib/kerngen/tcgenc/sungs/abend.F
deleted file mode 100644
index 0f6ee0c..0000000
--- a/src/packlib/kernlib/kerngen/tcgenc/sungs/abend.F
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: abend.F,v 1.1.1.1 1996/02/15 17:50:38 mclareni Exp $
-*
-* $Log: abend.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:38 mclareni
-* Kernlib
-*
-*
- SUBROUTINE ABEND
-C
-C CERN PROGLIB# Z035 ABEND .VERSION KERNSUN 1.00 880922
-C ORIG. 22/09/88, JZ
-C
-
- CALL EXIT (127)
- STOP
- END
diff --git a/src/packlib/kernlib/kerngen/tcgenc/sungs/datime.F b/src/packlib/kernlib/kerngen/tcgenc/sungs/datime.F
deleted file mode 100644
index 4738fad..0000000
--- a/src/packlib/kernlib/kerngen/tcgenc/sungs/datime.F
+++ /dev/null
@@ -1,35 +0,0 @@
-*
-* $Id: datime.F,v 1.1.1.1 1996/02/15 17:50:39 mclareni Exp $
-*
-* $Log: datime.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:39 mclareni
-* Kernlib
-*
-*
- SUBROUTINE DATIME (ND,NT)
-C
-C CERN PROGLIB# Z007 DATIME .VERSION KERNSUN 1.02 891025
-C ORIG. 22/09/88, JZ
-C MOD. 27/07/89 add /SLATE/, JZ
-C
-C- CALL DATIME (ND,NT) RETURNS INTEGER DATE ND = YYMMDD
-C- INTEGER TIME NT = HHMM
-C- returns also ISL (1) y (2) m (3) d (4) h (5) m (6) s
-C
- COMMON /SLATE/ ISL(34), MM(6)
-
-
- CALL IDATE (MM)
- CALL ITIME (MM(4))
-
- DO 24 J=1,6
- 24 ISL(J) = MM(J)
- ISL(1) = MM(3)
- ISL(3) = MM(1)
-
- MM(3) = MOD (MM(3),100)
-
- ND = (MM(3)*100+MM(2))*100 + MM(1)
- NT = MM(4) *100 + MM(5)
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgenc/sungs/datimh.F b/src/packlib/kernlib/kerngen/tcgenc/sungs/datimh.F
deleted file mode 100644
index e948e78..0000000
--- a/src/packlib/kernlib/kerngen/tcgenc/sungs/datimh.F
+++ /dev/null
@@ -1,43 +0,0 @@
-*
-* $Id: datimh.F,v 1.1.1.1 1996/02/15 17:50:39 mclareni Exp $
-*
-* $Log: datimh.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:39 mclareni
-* Kernlib
-*
-*
- SUBROUTINE DATIMH (ND,NT)
-C
-C CERN PROGLIB# Z007 DATIMH .VERSION KERNSUN 1.00 880922
-C ORIG. 22/09/88, JZ
-C
-
-C- CALL DATIMH (ND,NT) RETURNS HOLLERITH DATE ND = DD/MM/YY
-C- HOLLERITH TIME NT = HH.MM.SS
-
- COMMON /SLATE/ ISAFE(10), M(24), MM(6)
-
- DIMENSION ND(2), NT(2)
-
-
- CALL UBLOW (16H0 /0 /000 .0 .00, M, 16)
-
-C- D D / M M / Y Y H H . M M . S S
-C- 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6
-
- CALL IDATE (MM)
- CALL ITIME (MM(4))
-
- MM(3) = MOD (MM(3),100)
-
- CALL USET (MM(3), M, 7, 8)
- CALL USET (MM(2), M, 4, 5)
- CALL USET (MM(1), M, 1, 2)
- CALL USET (MM(4), M, 9,10)
- CALL USET (MM(5), M,12,13)
- CALL USET (MM(6), M,15,16)
-
- CALL UBUNCH (M(1),ND,8)
- CALL UBUNCH (M(9),NT,8)
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgenc/sungs/intrac.F b/src/packlib/kernlib/kerngen/tcgenc/sungs/intrac.F
deleted file mode 100644
index 25435e8..0000000
--- a/src/packlib/kernlib/kerngen/tcgenc/sungs/intrac.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: intrac.F,v 1.1.1.1 1996/02/15 17:50:39 mclareni Exp $
-*
-* $Log: intrac.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:39 mclareni
-* Kernlib
-*
-*
- LOGICAL FUNCTION INTRAC(DUMMY)
-C
-C CERN PROGLIB# Z044 INTRAC .VERSION KERNSUN 1.00 880922
-C ORIG. 22/09/88, JZ
-C
-C- The program is considered interactive if standard input
-C- is connected to the terminal
-
- LOGICAL ISATTY
-
- INTRAC = ISATTY (5)
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgenc/sungs/locb.F b/src/packlib/kernlib/kerngen/tcgenc/sungs/locb.F
deleted file mode 100644
index 1c4c2bf..0000000
--- a/src/packlib/kernlib/kerngen/tcgenc/sungs/locb.F
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: locb.F,v 1.1.1.1 1996/02/15 17:50:38 mclareni Exp $
-*
-* $Log: locb.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:38 mclareni
-* Kernlib
-*
-*
- FUNCTION LOCB (AM)
-C
-C CERN PROGLIB# N100 LOCB .VERSION KERNSUN 1.05 910318
-C ORIG. 17/11/88, JZ
-C
- DIMENSION AM(9)
-
- LOCB = LOC(AM)
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgenc/sungs/locf.F b/src/packlib/kernlib/kerngen/tcgenc/sungs/locf.F
deleted file mode 100644
index 94925a5..0000000
--- a/src/packlib/kernlib/kerngen/tcgenc/sungs/locf.F
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: locf.F,v 1.1.1.1 1996/02/15 17:50:38 mclareni Exp $
-*
-* $Log: locf.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:38 mclareni
-* Kernlib
-*
-*
- FUNCTION LOCF (AM)
-C
-C CERN PROGLIB# N100 LOCF .VERSION KERNSUN 1.06 920511
-C ORIG. 22/09/88, JZ
-C
- DIMENSION AM(9)
-
- LLAD = LOC(AM(1))
-#if defined(CERNLIB_BUGLRSHFT)
- LOCF = ishft (LLAD, -2)
-#endif
-#if !defined(CERNLIB_BUGLRSHFT)
- LOCF = lrshft (LLAD, 2)
-#endif
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgenc/timed.F b/src/packlib/kernlib/kerngen/tcgenc/timed.F
deleted file mode 100644
index f0391da..0000000
--- a/src/packlib/kernlib/kerngen/tcgenc/timed.F
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: timed.F,v 1.1.1.1 1996/02/15 17:50:38 mclareni Exp $
-*
-* $Log: timed.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:38 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QMVAX)
-#include "vaxsys/timed.F"
-#else
- SUBROUTINE TIMED (T)
-C
-C CERN PROGLIB# Z007 TIMED DUMMY .VERSION KERNFOR 4.05 821202
-C
-C- DUMMY FOR NON-ESSENTIAL ROUTINE STILL MISSING ON YOUR MACHINE
-
- T = .99
- RETURN
- END
-#endif
diff --git a/src/packlib/kernlib/kerngen/tcgenc/timel.F b/src/packlib/kernlib/kerngen/tcgenc/timel.F
deleted file mode 100644
index 606723c..0000000
--- a/src/packlib/kernlib/kerngen/tcgenc/timel.F
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: timel.F,v 1.1.1.1 1996/02/15 17:50:37 mclareni Exp $
-*
-* $Log: timel.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:37 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QMVAX)
-#include "vaxsys/timel.F"
-#else
- SUBROUTINE TIMEL (T)
-C
-C CERN PROGLIB# Z007 TIMEL DUMMY .VERSION KERNFOR 4.11 850529
-C
-C- DUMMY FOR NON-ESSENTIAL ROUTINE STILL MISSING ON YOUR MACHINE
-
- T = 9999.
- RETURN
- END
-#endif
diff --git a/src/packlib/kernlib/kerngen/tcgenc/timest.F b/src/packlib/kernlib/kerngen/tcgenc/timest.F
deleted file mode 100644
index 8949f02..0000000
--- a/src/packlib/kernlib/kerngen/tcgenc/timest.F
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: timest.F,v 1.1.1.1 1996/02/15 17:50:38 mclareni Exp $
-*
-* $Log: timest.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:38 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE TIMEST(DUMMY)
-C
-C CERN PROGLIB# Z007 TIMEST .VERSION KERNFOR 4.10 850320
-C ORIG. 01/03/85 HRR, DUMMY VERSION FOR NON-INTERACTIVE SYSTEMS.
-C
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgenc/timex.F b/src/packlib/kernlib/kerngen/tcgenc/timex.F
deleted file mode 100644
index 25b0d8b..0000000
--- a/src/packlib/kernlib/kerngen/tcgenc/timex.F
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: timex.F,v 1.1.1.1 1996/02/15 17:50:38 mclareni Exp $
-*
-* $Log: timex.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:38 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QMVAX)
-#include "vaxsys/timex.F"
-#else
- SUBROUTINE TIMEX (T)
-C
-C CERN PROGLIB# Z007 TIMEX DUMMY .VERSION KERNFOR 4.05 821202
-C
-C- DUMMY FOR NON-ESSENTIAL ROUTINE STILL MISSING ON YOUR MACHINE
-
- T = 9.
- RETURN
- END
-#endif
diff --git a/src/packlib/kernlib/kerngen/tcgenc/unlinkf.F b/src/packlib/kernlib/kerngen/tcgenc/unlinkf.F
deleted file mode 100644
index 1d2c223..0000000
--- a/src/packlib/kernlib/kerngen/tcgenc/unlinkf.F
+++ /dev/null
@@ -1,49 +0,0 @@
-*
-* $Id: unlinkf.F,v 1.1.1.1 1996/02/15 17:50:37 mclareni Exp $
-*
-* $Log: unlinkf.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:37 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QMVAX)
-#include "vaxsys/unlinkf.F"
-#else
- SUBROUTINE UNLINKF (CHNAME)
-C
-C CERN PROGLIB# Z265 UNLINKF .VERSION KERNFOR 4.34 930114
-C ORIG. 20/10/92, JZ
-C
- CHARACTER CHNAME*(*)
- LOGICAL THERE
-
-C-- Does the file exist?
-
- INQUIRE (FILE=CHNAME,EXIST=THERE)
- IF (.NOT.THERE) RETURN
-
-C-- Find a free LUN
-
- DO 17 LUN=8,49
- INQUIRE (UNIT=LUN,OPENED=THERE)
- IF (.NOT.THERE) GO TO 21
- 17 CONTINUE
- RETURN
-
-C-- Delete the file
-
- 21 OPEN (LUN,FILE=CHNAME,STATUS='OLD'
- +, FORM='FORMATTED', IOSTAT=ISTAT)
- IF (ISTAT.EQ.0) GO TO 49
-
- OPEN (LUN,FILE=CHNAME,STATUS='OLD'
- +, FORM='UNFORMATTED', IOSTAT=ISTAT)
- IF (ISTAT.EQ.0) GO TO 49
- CLOSE (LUN)
- RETURN
-
- 49 CLOSE (LUN, STATUS='DELETE')
- RETURN
- END
-#endif
diff --git a/src/packlib/kernlib/kerngen/tcgenc/vaxgs/abend.F b/src/packlib/kernlib/kerngen/tcgenc/vaxgs/abend.F
deleted file mode 100644
index 66e3d20..0000000
--- a/src/packlib/kernlib/kerngen/tcgenc/vaxgs/abend.F
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: abend.F,v 1.1.1.1 1996/02/15 17:50:39 mclareni Exp $
-*
-* $Log: abend.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:39 mclareni
-* Kernlib
-*
-*
- SUBROUTINE ABEND
-C
-C CERN PROGLIB# Z035 ABEND .VERSION KERNVAX 2.37 910718
-C ORIG. 10/06/91 J.C.Marin
-C
- INTEGER IVAL
-
- IVAL = '080F8FF4'X
- CALL LIB$STOP (IVAL)
- END
diff --git a/src/packlib/kernlib/kerngen/tcgenc/vaxgs/datime.F b/src/packlib/kernlib/kerngen/tcgenc/vaxgs/datime.F
deleted file mode 100644
index dea14a7..0000000
--- a/src/packlib/kernlib/kerngen/tcgenc/vaxgs/datime.F
+++ /dev/null
@@ -1,36 +0,0 @@
-*
-* $Id: datime.F,v 1.1.1.1 1996/02/15 17:50:39 mclareni Exp $
-*
-* $Log: datime.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:39 mclareni
-* Kernlib
-*
-*
- SUBROUTINE DATIME (ND,NT)
-C
-C CERN PROGLIB# Z007 DATIME .VERSION KERNVAX 2.32 890926
-C ORIG. 9/11/79 JZ
-C MOD. 27/07/89 add /SLATE/, JZ
-C
-
- COMMON /SLATE/ JY,JM,JD, JHR,JMN,JSC, ITM(4),M(30)
-
-C- 1 2 3 4 5 6 7 8
-C- H H : M M : S S
-
- CALL TIME (ITM)
- CALL UBLOW (ITM,M,8)
-
- DO 27 J=1,8
- 27 M(J) = (M(J).AND.255) - 48
- JHR = M(1)*10 + M(2)
- JMN = M(4)*10 + M(5)
- JSC = M(7)*10 + M(8)
- NT = 100*JHR + JMN
-
- CALL IDATE (JM,JD,JY)
- ND = (JY*100+JM)*100+JD
-
- JY = JY + 1900
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgenc/vaxgs/datimh.F b/src/packlib/kernlib/kerngen/tcgenc/vaxgs/datimh.F
deleted file mode 100644
index fe3f422..0000000
--- a/src/packlib/kernlib/kerngen/tcgenc/vaxgs/datimh.F
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: datimh.F,v 1.1.1.1 1996/02/15 17:50:40 mclareni Exp $
-*
-* $Log: datimh.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:40 mclareni
-* Kernlib
-*
-*
- SUBROUTINE DATIMH (JDATE,JTIME)
-C
-C CERN PROGLIB# Z007 DATIMH .VERSION KERNVAX 1.15 820721
-C ORIG. 20/07/82 JZ
-C
- DIMENSION JDATE(2), JTIME(2)
-
- COMMON /SLATE/ RES(10), JTM, JY,JM,JD, M(26)
-
- DATA IDOT /4H. /
-
- CALL IDATE (JM,JD,JY)
- CALL UBLOW (8H00/00/00,M,8)
- CALL USET (JD,M,1,2)
- CALL USET (JM,M,4,5)
- CALL USET (JY,M,7,8)
- CALL UBUNCH (M,JDATE,8)
-
- CALL TIME (JTM)
- CALL UBLOW (JTM,M,8)
- M(3) = IDOT
- M(6) = IDOT
- CALL UBUNCH (M,JTIME,8)
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgenc/vaxgs/locb.F b/src/packlib/kernlib/kerngen/tcgenc/vaxgs/locb.F
deleted file mode 100644
index e39492b..0000000
--- a/src/packlib/kernlib/kerngen/tcgenc/vaxgs/locb.F
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: locb.F,v 1.1.1.1 1996/02/15 17:50:39 mclareni Exp $
-*
-* $Log: locb.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:39 mclareni
-* Kernlib
-*
-*
- FUNCTION LOCB (IVAR)
-C
-C CERN PROGLIB# N100 LOCB .VERSION KERNVAX 2.40 930204
-C ORIG. 92/07/13 Miguel Marquina
-C
- DIMENSION IVAR(9)
-
- LOCB = %LOC(IVAR)
- END
diff --git a/src/packlib/kernlib/kerngen/tcgenc/vaxgs/locf.F b/src/packlib/kernlib/kerngen/tcgenc/vaxgs/locf.F
deleted file mode 100644
index 9e87c9d..0000000
--- a/src/packlib/kernlib/kerngen/tcgenc/vaxgs/locf.F
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: locf.F,v 1.1.1.1 1996/02/15 17:50:39 mclareni Exp $
-*
-* $Log: locf.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:39 mclareni
-* Kernlib
-*
-*
- FUNCTION LOCF (IVAR)
-C
-C CERN PROGLIB# N100 LOCF .VERSION KERNVAX 2.39 930112
-C ORIG. 92/07/13 Miguel Marquina
-C
- DIMENSION IVAR(9)
-
- J = %LOC(IVAR)
- LOCF = ISHFT (J, -2)
- END
diff --git a/src/packlib/kernlib/kerngen/tcgenc/vaxsys/intrac.F b/src/packlib/kernlib/kerngen/tcgenc/vaxsys/intrac.F
deleted file mode 100644
index f61084b..0000000
--- a/src/packlib/kernlib/kerngen/tcgenc/vaxsys/intrac.F
+++ /dev/null
@@ -1,43 +0,0 @@
-*
-* $Id: intrac.F,v 1.1.1.1 1996/02/15 17:50:40 mclareni Exp $
-*
-* $Log: intrac.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:40 mclareni
-* Kernlib
-*
-*
- LOGICAL FUNCTION INTRAC(DUMMY)
-C
-C CERN PROGLIB# Z044 INTRAC .VERSION KERNVAX 2.42 930609
-C ORIG. 08/06/93 FCA + JZ
-C
- COMMON /SLATE/ NDSLAT,NESLAT,SLDUMMY(38)
-
- INTEGER DVI$_DEVCHAR, DEV$V_TRM
- PARAMETER (DVI$_DEVCHAR = '002'X)
- PARAMETER (DEV$V_TRM = '002'X)
-
- INTEGER*4 MVALUE
- INTEGER*4 LISTF(4)
- INTEGER*2 LISTH(8)
- EQUIVALENCE (LISTH(1),LISTF(1))
- EQUIVALENCE (MVALUE, NDSLAT)
- INTEGER SYS$GETDVIW
-
-C-- System service item list
-
- DATA LISTH(1),LISTH(2) / 4 , DVI$_DEVCHAR /
- DATA LISTF(3),LISTF(4) / 0 , 0 /
-
-
- LISTF(2) = %LOC(MVALUE)
- ISTAT = SYS$GETDVIW(,,'SYS$INPUT',LISTF,,,,)
-
- MASK = MVALUE .AND. DEV$V_TRM
- IF (MASK.NE.0) GO TO 91
- INTRAC = .FALSE.
- RETURN
-
- 91 INTRAC = .TRUE.
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgenc/vaxsys/jumpx2.F b/src/packlib/kernlib/kerngen/tcgenc/vaxsys/jumpx2.F
deleted file mode 100644
index c8a7ac5..0000000
--- a/src/packlib/kernlib/kerngen/tcgenc/vaxsys/jumpx2.F
+++ /dev/null
@@ -1,59 +0,0 @@
-*
-* $Id: jumpx2.F,v 1.1.1.1 1996/02/15 17:50:41 mclareni Exp $
-*
-* $Log: jumpx2.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:41 mclareni
-* Kernlib
-*
-*
- SUBROUTINE JUMPX2 (IPARA,IPARB)
-C
-C CERN PROGLIB# Z042 JUMPX2 .VERSION KERNVAX 2.32 890926
-C ORIG. 21/04/88 JZ
-C MOD. 12/09/89 JZ, add entries JUMPX1, JUMPX0
-C
-C- To transfer to the user routine TARGET (say) with 2 parameters
-C- three steps are needed :
-
-C- 1) EXTERNAL TARGET to get the address of TARGET
-C- IADR = JUMPAD (TARGET)
-
-C- 2) CALL JUMPST (IADR) to set the tranfer address
-
-C- 3) CALL JUMPX2 (par1,par2) to transfer
-
- DIMENSION IPARA(9), IPARB(9)
- SAVE JPOINT
-
- CALL JUMPY2 (%VAL(JPOINT),IPARA,IPARB)
- RETURN
-
- ENTRY JUMPX1 (IPARA)
- CALL JUMPY1 (%VAL(JPOINT),IPARA)
- RETURN
-
- ENTRY JUMPX0
- CALL JUMPY0 (%VAL(JPOINT))
- RETURN
-
-C- to set the tranfer address
- ENTRY JUMPST (JADR)
- JPOINT = JADR
- RETURN
- END
-C-----------------------------------------------------
- SUBROUTINE JUMPY2 (TARSUB,IPARA,IPARB)
- DIMENSION IPARA(9), IPARB(9)
- EXTERNAL TARSUB
-
- CALL TARSUB (IPARA,IPARB)
- RETURN
-
- ENTRY JUMPY1 (TARSUB,IPARA)
- CALL TARSUB (IPARA)
- RETURN
-
- ENTRY JUMPY0 (TARSUB)
- CALL TARSUB
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgenc/vaxsys/timed.F b/src/packlib/kernlib/kerngen/tcgenc/vaxsys/timed.F
deleted file mode 100644
index 9ff128c..0000000
--- a/src/packlib/kernlib/kerngen/tcgenc/vaxsys/timed.F
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: timed.F,v 1.1.1.1 1996/02/15 17:50:41 mclareni Exp $
-*
-* $Log: timed.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:41 mclareni
-* Kernlib
-*
-*
- SUBROUTINE TIMED (T)
-C CERN PROGLIB# Z007 TIMED .VERSION KERNVAX 2.45 940228
-C ORIG. J. Shiers, 15/02/94
-C
- INCLUDE '($JPIDEF)'
-
- DATA ITOLD / 0 /
- SAVE ITOLD
-
-
- ISTAT = LIB$GETJPI(JPI$_CPUTIM,,,ITIME)
- T = FLOAT(ITIME-ITOLD)/100.
- ITOLD = ITIME
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgenc/vaxsys/timel.F b/src/packlib/kernlib/kerngen/tcgenc/vaxsys/timel.F
deleted file mode 100644
index 5ce1e2f..0000000
--- a/src/packlib/kernlib/kerngen/tcgenc/vaxsys/timel.F
+++ /dev/null
@@ -1,54 +0,0 @@
-*
-* $Id: timel.F,v 1.1.1.1 1996/02/15 17:50:41 mclareni Exp $
-*
-* $Log: timel.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:41 mclareni
-* Kernlib
-*
-*
- SUBROUTINE TIMEL (TRES)
-C
-C CERN PROGLIB# Z007 TIMEL .VERSION KERNVAX 2.44 931108
-C ORIG. 27/07/82, corr. oct 92, TIMEST added, FCA
-C
- INTEGER*2 LENG,IREQ
- COMMON /SLATE/ ITIME,XX(6), LENG,IREQ,IADR,NORET,ISLATE(30)
-
- LOGICAL IFBATCH
- PARAMETER (JPI$_CPULIM = '040D'X)
- PARAMETER (JPI$_CPUTIM = '0407'X)
- PARAMETER (TSTMAX = 2.**31*.01)
-
- DATA ITIMST /'7FFF FFFF'X/
- DATA ITIMDF /99900/
-
- ITIME= 0
- LENG = 4
- IREQ = JPI$_CPULIM
- IADR = %LOC(ITIME)
- NORET= 0
- ISLATE(1) = 0
- CALL SYS$GETJPI (,,,LENG,,,)
- IF (ITIME.EQ.0) ITIME=ITIMST
- IF (IFBATCH()) ITIMDF=ITIMST
-
- ITIME = MIN(ITIME,ITIMST,ITIMDF)
-
- ITL = ITIME
- IREQ = JPI$_CPUTIM
- CALL SYS$GETJPI (,,,LENG,,,)
-
- TRES = FLOAT(ITL-ITIME) / 100.
-C--- Block TIMEST if called after TIMEL
- ITIMST=ITIMDF
- RETURN
-
- ENTRY TIMEST(TIMLIM)
-
- IF (ITIMST.EQ.ITIMDF) GO TO 999
- IF (TIMLIM.GT.TSTMAX) GO TO 81
- ITIMST = TIMLIM*100.
- 81 ITIMDF = ITIMST
-
- 999 RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgenc/vaxsys/timex.F b/src/packlib/kernlib/kerngen/tcgenc/vaxsys/timex.F
deleted file mode 100644
index a018fb5..0000000
--- a/src/packlib/kernlib/kerngen/tcgenc/vaxsys/timex.F
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: timex.F,v 1.1.1.1 1996/02/15 17:50:41 mclareni Exp $
-*
-* $Log: timex.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:41 mclareni
-* Kernlib
-*
-*
- SUBROUTINE TIMEX (T)
-C CERN PROGLIB# Z007 TIMEX .VERSION KERNVAX 2.45 940228
-C ORIG. J. Shiers, 15/02/94
-C
- INCLUDE '($JPIDEF)'
-
-
- ISTAT = LIB$GETJPI(JPI$_CPUTIM,,,ITIME)
- T = FLOAT(ITIME)/100.
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgenc/vaxsys/unlinkf.F b/src/packlib/kernlib/kerngen/tcgenc/vaxsys/unlinkf.F
deleted file mode 100644
index 0c90f4c..0000000
--- a/src/packlib/kernlib/kerngen/tcgenc/vaxsys/unlinkf.F
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: unlinkf.F,v 1.1.1.1 1996/02/15 17:50:41 mclareni Exp $
-*
-* $Log: unlinkf.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:41 mclareni
-* Kernlib
-*
-*
- SUBROUTINE UNLINKF (CHNAME)
-C
-C CERN PROGLIB# Z265 UNLINKF .VERSION KERNVAX 2.45 940228
-C ORIG. 20/10/92, JZ, mod. J. Shiers, 15/02/94
-C
- CHARACTER CHNAME*(*)
-
-
- ISTAT = LIB$DELETE_FILE(CHNAME)
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgens/Imakefile b/src/packlib/kernlib/kerngen/tcgens/Imakefile
deleted file mode 100644
index 457f6ca..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/Imakefile
+++ /dev/null
@@ -1,46 +0,0 @@
-SRCS_F= ie3fos.F ie3tos.F iucomp.F \ @@\
- iufind.F iuhunt.F iusame.F jobnam.F jrsbyt.F \ @@\
- lvmax.F lvmaxa.F lvmin.F lvmina.F \ @@\
- msbit.F msbit0.F msbit1.F mbytet.F noarg.F \ @@\
- pkchar.F rndm.F \ @@\
- sbit.F sbit0.F sbit1.F sbytor.F sbytpk.F \ @@\
- ublank.F ublow.F ubunch.F \ @@\
- ucopiv.F ucopy.F ucopyn.F uctoh.F uctoh1.F \ @@\
- ufill.F uh1toc.F uhtoc.F upkbyt.F uswop.F uzero.F \ @@\
- vadd.F vasum.F vbias.F vblank.F vcopyn.F \ @@\
- vdot.F vdotn.F vdotn2.F vexcum.F vfill.F vfix.F vfloat.F \ @@\
- vline.F vmatl.F vmatr.F vmax.F vmaxa.F vmin.F vmina.F \ @@\
- vmod.F vmul.F vscale.F vsub.F vsum.F vunit.F vzero.F
-
-#ifndef CERNLIB_DOS
-SRCS_F := $(SRCS_F) cbyt.F jbit.F jbyt.F jbytet.F jbytor.F jbytpk.F \ @@\
- mbytor.F mcbyt.F msbyt.F pkbyt.F sbyt.F upkch.F
-#endif
-#if defined(CERNLIB_VAX) || defined(CERNLIB_DECS) || defined(CERNLIB_QMVAOS) \
- || defined(CERNLIB_DOS) || defined(CERNLIB_LNX) || defined(CERNLIB_WINNT)
-SRCS_F := $(SRCS_F) iucomh.F
-#endif
-
-/*
- * ucopy2 has 2 implementations, one in f77, and calling the C memmove ( POSIX )
- * memmove was faster on DEC-OSF, AIX, Linux; on solaris about equal, but avoids
- * deoptimisation
- * G.F. Dec-96
- */
-#if defined(CERNLIB_QMVAOS) || defined(CERNLIB_IBMRT) || defined(CERNLIB_SOLARIS) \
- || defined(CERNLIB_LINUX) || defined(CERNLIB_SGI)
-
-SRCS_C = ucopy2c.c
-
-#else
-
-SRCS_F := $(SRCS_F) ucopy2.F
-
-#endif
-
-#if defined(CERNLIB_QMVAOS)
-SpecialFortranLibObjectRule(uhtoc,uhtoc,-O1,NullParameter)
-SpecialFortranLibObjectRule(uh1toc,uh1toc,-O1,NullParameter)
-#endif
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kerngen/tcgens/allgs/iucomh.F b/src/packlib/kernlib/kerngen/tcgens/allgs/iucomh.F
deleted file mode 100644
index dcfcff2..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/allgs/iucomh.F
+++ /dev/null
@@ -1,47 +0,0 @@
-*
-* $Id: iucomh.F,v 1.1.1.1 1996/02/15 17:50:22 mclareni Exp $
-*
-* $Log: iucomh.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:22 mclareni
-* Kernlib
-*
-*
- FUNCTION IUCOMH (ISTR1, ISTR2, NCH)
-C
-C CERN PROGLIB# IUCOMH .VERSION KERNVMI 1.02 900221
-C ORIG. FCA+JZ, 20/02/90
-C
-C Compare the two Hollerith strings of NCH bytes length and return
-C -1 if STRING1 < STRING2
-C 0 =
-C +1 >
-C which is determined by the first non-identical character.
-C
- DIMENSION ISTR1(9), ISTR2(9)
- PARAMETER (NCHAPW=4,NBITPC=8)
-C
- NDO = NCH
- IF (NDO.LE.0) GO TO 30
- NWD = (NDO-1)/NCHAPW + 1
-
- DO 29 JW=1,NWD
- IWD1 = ISTR1(JW)
- IWD2 = ISTR2(JW)
- NL = MIN(NDO,4)
-
- DO 28 J=1,NL
- ICHAR1 = IAND (IWD1,255)
- ICHAR2 = IAND (IWD2,255)
- IF (ICHAR1-ICHAR2) 32, 26, 31
- 26 IWD1 = ISHFT (IWD1,-8)
- 28 IWD2 = ISHFT (IWD2,-8)
- 29 NDO = NDO - 4
-
- 30 IUCOMH = 0
- RETURN
-
- 31 IUCOMH = 1
- RETURN
- 32 IUCOMH = -1
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgens/allgs/rndm.F b/src/packlib/kernlib/kerngen/tcgens/allgs/rndm.F
deleted file mode 100644
index 5dfe097..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/allgs/rndm.F
+++ /dev/null
@@ -1,55 +0,0 @@
-*
-* $Id: rndm.F,v 1.1.1.1 1996/02/15 17:50:23 mclareni Exp $
-*
-* $Log: rndm.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:23 mclareni
-* Kernlib
-*
-*
- FUNCTION RNDM (ISEED)
-C
-C CERN PROGLIB# V104 RNDM .VERSION KERNVMI 1.08 930527
-C ORIG. 2/02/89 M.K.Storr from IBM version
-C
-C- Uniform Random Number Generator,
-C- giving the same sequence as the IBM and VAX version
-
- REAL IRNDM
- EQUIVALENCE (AMAN,MANT)
- SAVE MCGN
- DATA MCGN /12345/
- DATA MASK1 /x'0C000000'/, MASK2/x'33000000'/
-
- MCGN = MCGN * 69069
- MANT = ishft (MCGN,-8)
- IF (MANT.EQ.0) GO TO 14
- AMAN = MANT
-C- AMAN in the range 1 to 2**24-1
- MANT = MANT - MASK1
-C- multiply by 2.**(-24)
- RNDM = AMAN
- RETURN
-
-C-- for zero set RNDM = 2.**(-25)
- 14 MANT = MASK2
- RNDM = AMAN
- RETURN
-
-C-- Integer random number
- ENTRY IRNDM (ISEED)
- MCGN = MCGN * 69069
- MANT = ISHFT (MCGN,-1)
- IRNDM = AMAN
- RETURN
-
-C-- Set the seed
- ENTRY RDMIN (ISEED)
- MCGN = ISEED
- RNDM = 0.
- RETURN
-
-C-- Get the seed
- ENTRY RDMOUT (ISEED)
- ISEED = MCGN
- RNDM = 0.
- END
diff --git a/src/packlib/kernlib/kerngen/tcgens/allgs/ublow.F b/src/packlib/kernlib/kerngen/tcgens/allgs/ublow.F
deleted file mode 100644
index 8795a4f..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/allgs/ublow.F
+++ /dev/null
@@ -1,49 +0,0 @@
-*
-* $Id: ublow.F,v 1.1.1.1 1996/02/15 17:50:23 mclareni Exp $
-*
-* $Log: ublow.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:23 mclareni
-* Kernlib
-*
-*
- SUBROUTINE UBLOW (MS,MT,NCHP)
-C
-C CERN PROGLIB# M409 UBLOW .VERSION KERNVMI 1.01 891208
-C ORIG. 03/02/89 K.M.STORR
-C
-
- DIMENSION MS(99), MT(99), NCHP(9)
- DATA IBLAN1 /x'20202000'/
- DATA MASK1 /x'000000ff'/
-
- NCH = NCHP(1)
- IF (NCH) 91, 29, 11
- 11 NWS = ishft (NCH,-2)
- NTRAIL = IAND (NCH,3)
- JT = 0
- IF (NWS.EQ.0) GO TO 26
-
-C-- Unpack the initial complete words
-
- DO 24 JS=1,NWS
- MWD = MS(JS)
- MT(JT+1) = IOR (IBLAN1,IAND(MASK1,MWD))
- MT(JT+2) = IOR (IBLAN1,IAND(MASK1,ISHFT(MWD, -8)))
- MT(JT+3) = IOR (IBLAN1,IAND(MASK1,ISHFT(MWD,-16)))
- MT(JT+4) = IOR (IBLAN1, ISHFT(MWD,-24) )
- 24 JT = JT + 4
-
- IF (NTRAIL.EQ.0) RETURN
-
-C-- Unpack the trailing word
-
- 26 MWD = MS(NWS+1)
-
- DO 28 JS=1,NTRAIL
- MT(JT+1) = IOR (IBLAN1,IAND(MASK1,MWD))
- MWD = ISHFT (MWD,-8)
- 28 JT = JT + 1
- 29 RETURN
-
- 91 CALL ABEND
- END
diff --git a/src/packlib/kernlib/kerngen/tcgens/allgs/ubunch.F b/src/packlib/kernlib/kerngen/tcgens/allgs/ubunch.F
deleted file mode 100644
index 7dee904..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/allgs/ubunch.F
+++ /dev/null
@@ -1,50 +0,0 @@
-*
-* $Id: ubunch.F,v 1.1.1.1 1996/02/15 17:50:23 mclareni Exp $
-*
-* $Log: ubunch.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:23 mclareni
-* Kernlib
-*
-*
- SUBROUTINE UBUNCH (MS,MT,NCHP)
-C
-C CERN PROGLIB# M409 UBUNCH .VERSION KERNVMI 1.01 891208
-C ORIG. 03/02/89 K.M.STORR
-C
-
- DIMENSION MS(99), MT(99), NCHP(9)
- DATA IBLAN1 /x'20202020'/
- DATA MASK1 /x'000000ff'/
-
- NCH = NCHP(1)
- IF (NCH) 91,39,11
- 11 NWT = ishft (NCH,-2)
- NTRAIL = IAND (NCH,3)
- JS = 0
- IF (NWT.EQ.0) GO TO 31
-
-C-- Pack the initial complete words
-
- DO 24 JT=1,NWT
- MT(JT) = IOR (IOR (IOR (
- + IAND(MS(JS+1),MASK1),
- + ishft (IAND(MS(JS+2),MASK1), 8)),
- + ishft (IAND(MS(JS+3),MASK1),16)),
- + ishft (MS(JS+4), 24) )
- 24 JS = JS + 4
-
- IF (NTRAIL.EQ.0) RETURN
-
-C-- Pack the trailing word
-
- 31 MWD = IBLAN1
- JS = NCH
-
- DO 34 JT=1,NTRAIL
- MWD = IOR (ishft(MWD,8), IAND(MS(JS),MASK1))
- 34 JS = JS - 1
- MT(NWT+1) = MWD
- 39 RETURN
-
- 91 CALL ABEND
- END
diff --git a/src/packlib/kernlib/kerngen/tcgens/cbyt.F b/src/packlib/kernlib/kerngen/tcgens/cbyt.F
deleted file mode 100644
index 8a0f16c..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/cbyt.F
+++ /dev/null
@@ -1,40 +0,0 @@
-*
-* $Id: cbyt.F,v 1.2 2006/09/15 09:35:21 mclareni Exp $
-*
-* $Log: cbyt.F,v $
-* Revision 1.2 2006/09/15 09:35:21 mclareni
-* Submitted mods for gcc4/gfortran and MacOSX, corrected to work also on slc4 with gcc3.4 and 4.1
-*
-* Revision 1.1.1.1 1996/02/15 17:50:10 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QMSUN)
-#include "sungs/cbyt.F"
-#elif defined(CERNLIB_QMLNX) && !defined(CERNLIB_GFORTRAN)
-#include "lnxgs/cbyt.F"
-#else
- SUBROUTINE CBYT (M,LM,IX,LX,NB)
-C
-C CERN PROGLIB# M421 CBYT .VERSION KERNFOR 4.23 891215
-C ORIG. 14/08/70 CL
-C
-#include "kerngen/wordsize.inc"
-#include "kerngen/iall1s.inc"
-#if !defined(CERNLIB_QISASTD)
-#include "kerngen/q_jbit.inc"
-* Ignoring t=pass
-#endif
-C
-#if !defined(CERNLIB_QISASTD)
- CALL SBYT (JBYT(M,LM,NB),IX,LX,NB)
-#endif
-#if defined(CERNLIB_QISASTD)
- IX = IOR ( IAND (IX,
- + NOT(ISHFT (ISHFT(IALL11,-NBITPW+NB), LX-1)))
- +, ISHFT (ISHFT(ISHFT(M,-LM+1),NBITPW-NB), -NBITPW-1+LX+NB))
-#endif
- RETURN
- END
-#endif
diff --git a/src/packlib/kernlib/kerngen/tcgens/dosgs/iucomh.F b/src/packlib/kernlib/kerngen/tcgens/dosgs/iucomh.F
deleted file mode 100644
index 1de1fcc..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/dosgs/iucomh.F
+++ /dev/null
@@ -1,61 +0,0 @@
-*
-* $Id: iucomh.F,v 1.2 1997/09/02 14:27:02 mclareni Exp $
-*
-* $Log: iucomh.F,v $
-* Revision 1.2 1997/09/02 14:27:02 mclareni
-* WINNT correction
-*
-* Revision 1.1.1.1 1996/02/15 17:50:24 mclareni
-* Kernlib
-*
-*
- FUNCTION IUCOMH (ISTR1, ISTR2, NCH)
-C
-C CERN PROGLIB# IUCOMH .VERSION KERNDOS 1.00 920624
-C ORIG. FCA+JZ, 20/02/90
-C
-C Compare the two Hollerith strings of NCH bytes length and return
-C -1 if STRING1 < STRING2
-C 0 =
-C +1 >
-C which is determined by the first non-identical character.
-C
- DIMENSION ISTR1(9), ISTR2(9)
-C
- NDO = NCH
- IF (NDO.LE.0) GO TO 30
- NWD = (NDO-1)/4 + 1
-
- DO 29 JW=1,NWD
- IWD1 = ISTR1(JW)
- IWD2 = ISTR2(JW)
- NL = MIN(NDO,4)
- IF (IWD1. NE. IWD2) THEN
-
- DO 28 J=1,NL
-#ifndef CERNLIB_QF2C
- ICHAR1 = IAND (IWD1,255)
- ICHAR2 = IAND (IWD2,255)
-#else
- ICHAR1 = AND (IWD1,255)
- ICHAR2 = AND (IWD2,255)
-#endif
- IF (ICHAR1-ICHAR2) 32, 26, 31
-#ifndef CERNLIB_QF2C
- 26 IWD1 = ISHFT (IWD1,-8)
- 28 IWD2 = ISHFT (IWD2,-8)
-#else
- 26 IWD1 = rshift (IWD1,8)
- 28 IWD2 = rshift (IWD2,8)
-#endif
- END IF
- 29 NDO = NDO - 4
-
- 30 IUCOMH = 0
- RETURN
-
- 31 IUCOMH = 1
- RETURN
- 32 IUCOMH = -1
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgens/dosgs/rndm.F b/src/packlib/kernlib/kerngen/tcgens/dosgs/rndm.F
deleted file mode 100644
index 4587596..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/dosgs/rndm.F
+++ /dev/null
@@ -1,63 +0,0 @@
-*
-* $Id: rndm.F,v 1.1.1.1 1996/02/15 17:50:24 mclareni Exp $
-*
-* $Log: rndm.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:24 mclareni
-* Kernlib
-*
-*
- FUNCTION RNDM (ISEED)
-C
-C CERN PROGLIB# V104 RNDM .VERSION KERNDOS 1.00 920624
-C ORIG. 22-MAR-88 from IBM version of G.Marsaglia et al., Montreal
-C MODIF 24/06/92, adapted N.Karpenko, Dubna
-C
-C !!! Version valid only for 32 bit machines !!!
-C !!! with IEEE floating point representation !!!
-C
-C- Uniform Random Number Generator,
-C- giving the same sequence as the IBM and VAX version
-
- EQUIVALENCE (AMAN,MANT)
- PARAMETER (MSK1 = 201326592)
- PARAMETER (MSK2 = 855638016)
-C PARAMETER (MSK1 = '0C000000'X)
-C PARAMETER (MSK2 = '33000000'X)
- COMMON /MCGN/ MCGN
- DATA MCGN /12345/
-
-
- MCGN = MCGN * 69069
- MANT = ISHFT (MCGN,-8)
- IF (MANT.EQ.0) GO TO 14
- AMAN = MANT
-C- AMAN in the range 1 to 2**24-1
- MANT = MANT - MSK1
-C- multiply by 2.**(-24)
- RNDM = AMAN
- RETURN
-
-C-- for zero set RNDM = 2.**(-25)
- 14 MANT = MSK2
- RNDM = AMAN
- RETURN
- END
- FUNCTION IRNDM(ISEEK)
- COMMON /MCGN/ MCGN
-
-C-- Integer random number
- MCGN = MCGN * 69069
- IRNDM = ISHFT (MCGN,-1)
- RETURN
- END
- SUBROUTINE RDMIN(ISEED)
- COMMON /MCGN/ MCGN
-
-C-- Set the seed
- MCGN = ISEED
- RETURN
-
-C-- Get the seed
- ENTRY RDMOUT (ISEED)
- ISEED = MCGN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgens/dosgs/ublow.F b/src/packlib/kernlib/kerngen/tcgens/dosgs/ublow.F
deleted file mode 100644
index 23a5f92..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/dosgs/ublow.F
+++ /dev/null
@@ -1,58 +0,0 @@
-*
-* $Id: ublow.F,v 1.2 1997/09/02 14:27:03 mclareni Exp $
-*
-* $Log: ublow.F,v $
-* Revision 1.2 1997/09/02 14:27:03 mclareni
-* WINNT correction
-*
-* Revision 1.1.1.1 1996/02/15 17:50:24 mclareni
-* Kernlib
-*
-*
-#ifndef CERNLIB_QF2C
-
- SUBROUTINE UBLOW (MS,MT,NCHP)
-C
-C CERN PROGLIB# M409 UBLOW .VERSION KERNDOS 1.00 920624
-C ORIG. 03/02/89 K.M.STORR
-C
-
- DIMENSION MS(99), MT(99), NCHP(9)
- PARAMETER (IBLAN1 = X'20202000')
- PARAMETER (MASK1 = X'000000FF')
-
-#include "kerngen/q_andor.inc"
-#include "kerngen/q_shift.inc"
-
- NCH = NCHP(1)
- IF (NCH) 91, 29, 11
- 11 NWS = ishft (NCH,-2)
- NTRAIL = IAND (NCH,3)
- JT = 0
- IF (NWS.EQ.0) GO TO 26
-
-C-- Unpack the initial complete words
-
- DO 24 JS=1,NWS
- MWD = MS(JS)
- MT(JT+1) = IOR (IBLAN1,IAND(MASK1,MWD))
- MT(JT+2) = IOR (IBLAN1,IAND(MASK1,ISHFT(MWD, -8)))
- MT(JT+3) = IOR (IBLAN1,IAND(MASK1,ISHFT(MWD,-16)))
- MT(JT+4) = IOR (IBLAN1, ISHFT(MWD,-24) )
- 24 JT = JT + 4
-
- IF (NTRAIL.EQ.0) RETURN
-
-C-- Unpack the trailing word
-
- 26 MWD = MS(NWS+1)
-
- DO 28 JS=1,NTRAIL
- MT(JT+1) = IOR (IBLAN1,IAND(MASK1,MWD))
- MWD = ISHFT (MWD,-8)
- 28 JT = JT + 1
- 29 RETURN
-
- 91 CALL ABEND
- END
-#endif
diff --git a/src/packlib/kernlib/kerngen/tcgens/dosgs/ubunch.F b/src/packlib/kernlib/kerngen/tcgens/dosgs/ubunch.F
deleted file mode 100644
index d68e3c0..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/dosgs/ubunch.F
+++ /dev/null
@@ -1,70 +0,0 @@
-*
-* $Id: ubunch.F,v 1.2 1997/09/02 14:27:03 mclareni Exp $
-*
-* $Log: ubunch.F,v $
-* Revision 1.2 1997/09/02 14:27:03 mclareni
-* WINNT correction
-*
-* Revision 1.1.1.1 1996/02/15 17:50:24 mclareni
-* Kernlib
-*
-*
-#ifndef CERNLIB_QF2C
- SUBROUTINE UBUNCH (MS,MT,NCHP)
-C
-C CERN PROGLIB# M409 UBUNCH .VERSION KERNDOS 1.00 920624
-C ORIG. 03/02/89 K.M.STORR
-C
-
- DIMENSION MS(99), MT(99), NCHP(9)
- PARAMETER (IBLANK = X'20202020')
- PARAMETER (MASK1 = X'000000FF')
-
-#include "kerngen/q_andor.inc"
-#include "kerngen/q_shift.inc"
-
- NCH = NCHP(1)
- IF (NCH) 91,39,11
- 11 NWT = ishft (NCH,-2)
- NTRAIL = IAND (NCH,3)
- JS = 0
- IF (NWT.EQ.0) GO TO 31
-
-C-- Pack the initial complete words
-
- DO 24 JT=1,NWT
-#ifndef CERNLIB_QF2C
- MT(JT) = IOR (IOR (IOR (
- + IAND(MS(JS+1),MASK1),
- + ishft (IAND(MS(JS+2),MASK1), 8)),
- + ishft (IAND(MS(JS+3),MASK1),16)),
- + ishft (MS(JS+4), 24) )
-#else
- MT(JT) = OR (OR (OR (
- + AND(MS(JS+1),MASK1),
- + LshIft (AND(MS(JS+2),MASK1), 8)),
- + LshIft (AND(MS(JS+3),MASK1),16)),
- + LshIft (MS(JS+4), 24) )
-#endif
- 24 JS = JS + 4
-
- IF (NTRAIL.EQ.0) RETURN
-
-C-- Pack the trailing word
-
- 31 MWD = IBLANK
- JS = NCH
-
- DO 34 JT=1,NTRAIL
-#ifndef CERNLIB_QF2C
- MWD = IOR (ishft(MWD,8), IAND(MS(JS),MASK1))
-#else
- MWD = OR (LshIft(MWD,8), AND(MS(JS),MASK1))
-#endif
- 34 JS = JS - 1
- MT(NWT+1) = MWD
- 39 RETURN
-
- 91 CALL ABEND
- END
-#endif
diff --git a/src/packlib/kernlib/kerngen/tcgens/ie3fos.F b/src/packlib/kernlib/kerngen/tcgens/ie3fos.F
deleted file mode 100644
index 77e5471..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/ie3fos.F
+++ /dev/null
@@ -1,30 +0,0 @@
-*
-* $Id: ie3fos.F,v 1.1.1.1 1996/02/15 17:50:10 mclareni Exp $
-*
-* $Log: ie3fos.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:10 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QMIRTD)
-#include "irtdgs/ie3fos.F"
-#elif defined(CERNLIB_QMVAX)
-#include "vaxgs/ie3fos.F"
-#else
- SUBROUTINE IE3FOS (MS,MT,NWDO,JBAD)
-C
-C CERN PROGLIB# M220 IE3FOS .VERSION KERNFOR 4.15 861204
-
-C- Convert single precision for output with copy
-C- from source in native to target in IEEE data format
-C- Dummy routine valid for machines with IEEE internal repr.
-
- DIMENSION MS(99), MT(99)
-
- CALL UCOPY (MS,MT,NWDO)
-
- JBAD = 0
- RETURN
- END
-#endif
diff --git a/src/packlib/kernlib/kerngen/tcgens/ie3tos.F b/src/packlib/kernlib/kerngen/tcgens/ie3tos.F
deleted file mode 100644
index 7390aa5..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/ie3tos.F
+++ /dev/null
@@ -1,30 +0,0 @@
-*
-* $Id: ie3tos.F,v 1.1.1.1 1996/02/15 17:50:10 mclareni Exp $
-*
-* $Log: ie3tos.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:10 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QMIRTD)
-#include "irtdgs/ie3tos.F"
-#elif defined(CERNLIB_QMVAX)
-#include "vaxgs/ie3tos.F"
-#else
- SUBROUTINE IE3TOS (MS,MT,NWDO,JBAD)
-C
-C CERN PROGLIB# M220 IE3TOS .VERSION KERNFOR 4.15 861204
-
-C- Convert single precision for input with copy
-C- from source in IEEE to target in native data format
-C- Dummy routine valid for machines with IEEE internal repr.
-
- DIMENSION MS(99), MT(99)
-
- CALL UCOPY (MS,MT,NWDO)
-
- JBAD = 0
- RETURN
- END
-#endif
diff --git a/src/packlib/kernlib/kerngen/tcgens/irtdgs/ie3fos.F b/src/packlib/kernlib/kerngen/tcgens/irtdgs/ie3fos.F
deleted file mode 100644
index 814cdb3..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/irtdgs/ie3fos.F
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: ie3fos.F,v 1.1.1.1 1996/02/15 17:50:22 mclareni Exp $
-*
-* $Log: ie3fos.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:22 mclareni
-* Kernlib
-*
-*
- at PROCESS AUTODBL(NONE)
- SUBROUTINE IE3FOS(VINT,VIEEE,NV,JCODE)
- DOUBLE PRECISION VINT(NV)
- REAL VIEEE(2*NV)
- DO I=1,NV
- I2 = 2*I - 1
- VIEEE(I2) = SNGL(VINT(I))
- ENDDO
- END
diff --git a/src/packlib/kernlib/kerngen/tcgens/irtdgs/ie3tos.F b/src/packlib/kernlib/kerngen/tcgens/irtdgs/ie3tos.F
deleted file mode 100644
index 58c48be..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/irtdgs/ie3tos.F
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: ie3tos.F,v 1.1.1.1 1996/02/15 17:50:22 mclareni Exp $
-*
-* $Log: ie3tos.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:22 mclareni
-* Kernlib
-*
-*
- at PROCESS AUTODBL(NONE)
- SUBROUTINE IE3TOS(VIEEE,VINT,NV,JCODE)
- DOUBLE PRECISION VINT(NV)
- REAL VIEEE(2*NV)
- DO I=1,NV
- VINT(I) = DBLE(VIEEE((I-1)*2+1))
- ENDDO
- END
diff --git a/src/packlib/kernlib/kerngen/tcgens/irtdgs/rndm.F b/src/packlib/kernlib/kerngen/tcgens/irtdgs/rndm.F
deleted file mode 100644
index ef822e0..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/irtdgs/rndm.F
+++ /dev/null
@@ -1,73 +0,0 @@
-*
-* $Id: rndm.F,v 1.1.1.1 1996/02/15 17:50:22 mclareni Exp $
-*
-* $Log: rndm.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:22 mclareni
-* Kernlib
-*
-*
- FUNCTION RNDM (ISEED)
-C
-C CERN PROGLIB# V104 RNDM .VERSION KERNIRT 1.06 930811
-C ORIG. 22-MAR-88 from IBM version of G.Marsaglia et al., Montreal
-C
-C !!! Version valid only for 32 bit machines !!!
-C !!! with IEEE floating point representation !!!
-C
-C- Uniform Random Number Generator,
-C- giving the same sequence as the IBM and VAX version
-
- EQUIVALENCE (AMAN,MANT)
- PARAMETER (MSK1 = 25165824)
- PARAMETER (MSK2 = 855638016)
-C PARAMETER (MSK1 = '0C000000'X)
-C PARAMETER (MSK2 = '33000000'X)
- SAVE MCGN
- DATA MCGN /12345/
-
-#if !defined(CERNLIB_QISASTD)
-#include "kerngen/q_andor.inc"
-#include "kerngen/q_shift.inc"
-* Ignoring t=pass
-#endif
-
- MCGN = MCGN * 69069
-#if defined(CERNLIB_QISASTD)
- MANT = ISHFT (MCGN,-8)
-#endif
-#if !defined(CERNLIB_QISASTD)
- MANT = ISHFTR(MCGN, 8)
-#endif
- IF (MANT.EQ.0) GO TO 14
- AMAN = MANT
-C- AMAN in the range 1 to 2**24-1
- MANT = MANT - MSK1
-C- multiply by 2.**(-24)
- RNDM = AMAN
- RETURN
-
-C-- for zero set RNDM = 2.**(-25)
- 14 RNDM = 0.29802322387695312E-07
-
- RETURN
-
-C-- Integer random number
- ENTRY IRNDM (ISEED)
- MCGN = MCGN * 69069
-#if defined(CERNLIB_QISASTD)
- IRNDM = ISHFT (MCGN,-1)
-#endif
-#if !defined(CERNLIB_QISASTD)
- IRNDM = ISHFTR(MCGN, 1)
-#endif
- RETURN
-
-C-- Set the seed
- ENTRY RDMIN (ISEED)
- MCGN = ISEED
- RETURN
-
-C-- Get the seed
- ENTRY RDMOUT (ISEED)
- ISEED = MCGN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgens/iucomh.F b/src/packlib/kernlib/kerngen/tcgens/iucomh.F
deleted file mode 100644
index 83a9038..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/iucomh.F
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: iucomh.F,v 1.3 2006/09/15 09:35:21 mclareni Exp $
-*
-* $Log: iucomh.F,v $
-* Revision 1.3 2006/09/15 09:35:21 mclareni
-* Submitted mods for gcc4/gfortran and MacOSX, corrected to work also on slc4 with gcc3.4 and 4.1
-*
-* Revision 1.2 1997/02/04 17:36:24 mclareni
-* Merge Winnt and 97a versions
-*
-* Revision 1.1.1.1.2.1 1997/01/21 11:31:39 mclareni
-* All mods for Winnt 96a on winnt branch
-*
-* Revision 1.1.1.1 1996/02/15 17:50:19 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_WINNT)
-#include "wntgs/iucomh.F"
-#elif defined(CERNLIB_QMDOS)
-#include "dosgs/iucomh.F"
-#elif defined(CERNLIB_QMVAOS)||defined(CERNLIB_QMVMI)
-#include "allgs/iucomh.F"
-#elif defined(CERNLIB_QMLNX) && !defined(CERNLIB_GFORTRAN)
-#include "lnxgs/iucomh.F"
-#elif defined(CERNLIB_QMVAX)
-#include "vaxgs/iucomh.F"
-#elif defined(CERNLIB_GFORTRAN)
-#include "allgs/iucomh.F"
-#endif
diff --git a/src/packlib/kernlib/kerngen/tcgens/iucomp.F b/src/packlib/kernlib/kerngen/tcgens/iucomp.F
deleted file mode 100644
index 9f65ea5..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/iucomp.F
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: iucomp.F,v 1.1.1.1 1996/02/15 17:50:11 mclareni Exp $
-*
-* $Log: iucomp.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:11 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- FUNCTION IUCOMP (ITEXT,IVECT,N)
-C
-C CERN PROGLIB# V304 IUCOMP .VERSION KERNFOR 1.0 710701
-C ORIG. 01/01/66 JZ
-C
- DIMENSION IVECT(9)
-C
- IF (N.EQ.0) GO TO 18
- DO 12 J=1,N
- IF (ITEXT.EQ.IVECT(J)) GO TO 24
- 12 CONTINUE
- 18 J=0
-C
- 24 IUCOMP= J
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgens/iufind.F b/src/packlib/kernlib/kerngen/tcgens/iufind.F
deleted file mode 100644
index 2dd8a9d..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/iufind.F
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: iufind.F,v 1.1.1.1 1996/02/15 17:50:11 mclareni Exp $
-*
-* $Log: iufind.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:11 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- FUNCTION IUFIND (IT,ICH,JL,JR)
-C
-C CERN PROGLIB# V304 IUFIND .VERSION KERNFOR 1.0 710701
-C ORIG. 01/07/71
-C
- DIMENSION ICH(9)
-C
- DO 12 J= JL,JR
- IF (ICH(J).EQ.IT) GO TO 24
- 12 CONTINUE
- J= JR+1
-C
- 24 IUFIND= J
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgens/iuhunt.F b/src/packlib/kernlib/kerngen/tcgens/iuhunt.F
deleted file mode 100644
index d5eb026..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/iuhunt.F
+++ /dev/null
@@ -1,30 +0,0 @@
-*
-* $Id: iuhunt.F,v 1.1.1.1 1996/02/15 17:50:11 mclareni Exp $
-*
-* $Log: iuhunt.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:11 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- FUNCTION IUHUNT (IT,IA,N,NW)
-C
-C CERN PROGLIB# V304 IUHUNT .VERSION KERNFOR 2.09 751101
-C ORIG. 01/09/72
-C
- DIMENSION IA(9)
-C
- IF (N.EQ.0) GO TO 19
- IF (NW.EQ.0) GO TO 20
- DO 18 J=1,N,NW
- IF (IA(J).EQ.IT) GO TO 21
- 18 CONTINUE
- 19 IUHUNT= 0
- RETURN
- 20 IF (IT.NE.IA(1)) GO TO 19
- IUHUNT= 1
- RETURN
-C
- 21 IUHUNT= J
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgens/iusame.F b/src/packlib/kernlib/kerngen/tcgens/iusame.F
deleted file mode 100644
index 714cefb..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/iusame.F
+++ /dev/null
@@ -1,36 +0,0 @@
-*
-* $Id: iusame.F,v 1.1.1.1 1996/02/15 17:50:11 mclareni Exp $
-*
-* $Log: iusame.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:11 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- FUNCTION IUSAME (IA,JST,N,MIN,JSAME)
-C
-C CERN PROGLIB# M501 IUSAME .VERSION KERNFOR 1.0 710701
-C ORIG. 01/07/71 CL
-C
- DIMENSION IA(*)
-C
-C
- J = JST
- 21 NSM= 0
- JSM= J
-C
- 24 NSM= NSM + 1
- IF (J.EQ.N) GO TO 31
- J = J + 1
- IF (IA(J).EQ.IA(J-1)) GO TO 24
-C
- IF (NSM.LT.MIN) GO TO 21
- GO TO 32
-C
- 31 IF (NSM.GE.MIN) GO TO 32
- NSM= 0
- JSM= N + 1
- 32 IUSAME=NSM
- JSAME= JSM
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgens/jbit.F b/src/packlib/kernlib/kerngen/tcgens/jbit.F
deleted file mode 100644
index 9466540..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/jbit.F
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: jbit.F,v 1.2 2006/09/15 09:35:21 mclareni Exp $
-*
-* $Log: jbit.F,v $
-* Revision 1.2 2006/09/15 09:35:21 mclareni
-* Submitted mods for gcc4/gfortran and MacOSX, corrected to work also on slc4 with gcc3.4 and 4.1
-*
-* Revision 1.1.1.1 1996/02/15 17:50:11 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QMSUN)
-#include "sungs/jbit.F"
-#else
- FUNCTION JBIT (IZW,IZP)
-C
-C CERN PROGLIB# M421 JBIT .VERSION KERNFOR 4.23 891215
-C ORIG. 13/03/89 JZ
-C
-C This non-ANSI code is a default which may be slow, if so
-C it should be replaced by a machine-specific fast routine
-
-#if !defined(CERNLIB_QISASTD) && !defined(CERNLIB_GFORTRAN)
-#include "kerngen/q_andor.inc"
-#include "kerngen/q_shift.inc"
-* Ignoring t=pass
-#endif
-
-#if !defined(CERNLIB_QISASTD) && !defined(CERNLIB_GFORTRAN)
- JBIT = IAND (ISHFTR(IZW, IZP-1), 1)
-#endif
-#if ((defined(CERNLIB_QISASTD))&&(!defined(CERNLIB_QMILSTD))) || defined(CERNLIB_GFORTRAN)
- JBIT = IAND (ISHFT (IZW,-IZP+1), 1)
-#endif
-#if defined(CERNLIB_QMILSTD)
- JBIT = IBITS (IZW,IZP-1,1)
-#endif
- RETURN
- END
-#endif
diff --git a/src/packlib/kernlib/kerngen/tcgens/jbyt.F b/src/packlib/kernlib/kerngen/tcgens/jbyt.F
deleted file mode 100644
index 7216652..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/jbyt.F
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: jbyt.F,v 1.2 2006/09/15 09:35:21 mclareni Exp $
-*
-* $Log: jbyt.F,v $
-* Revision 1.2 2006/09/15 09:35:21 mclareni
-* Submitted mods for gcc4/gfortran and MacOSX, corrected to work also on slc4 with gcc3.4 and 4.1
-*
-* Revision 1.1.1.1 1996/02/15 17:50:11 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QMSUN)
-#include "sungs/jbyt.F"
-#else
- FUNCTION JBYT (IZW,IZP,NZB)
-C
-C CERN PROGLIB# M421 JBYT .VERSION KERNFOR 4.23 891215
-C ORIG. 13/03/89 JZ
-C
-C This non-ANSI code is a default which may be slow, if so
-C it should be replaced by a machine-specific fast routine
-#include "kerngen/wordsize.inc"
-#if !defined(CERNLIB_QISASTD) && !defined(CERNLIB_GFORTRAN)
-#include "kerngen/q_andor.inc"
-#include "kerngen/q_shift.inc"
-* Ignoring t=pass
-#endif
-
-#if !defined(CERNLIB_QISASTD) && !defined(CERNLIB_GFORTRAN)
- JBYT = ISHFTR(ISHFTL(IZW,NBITPW+1-IZP-NZB), NBITPW-NZB)
-#endif
-#if ((defined(CERNLIB_QISASTD))&&(!defined(CERNLIB_QMILSTD))) || defined(CERNLIB_GFORTRAN)
- JBYT = ISHFT (ISHFT (IZW,NBITPW+1-IZP-NZB),-NBITPW+NZB)
-#endif
-#if defined(CERNLIB_QMILSTD)
- JBYT = IBITS (IZW,IZP-1,NZB)
-#endif
- RETURN
- END
-#endif
diff --git a/src/packlib/kernlib/kerngen/tcgens/jbytet.F b/src/packlib/kernlib/kerngen/tcgens/jbytet.F
deleted file mode 100644
index 0670373..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/jbytet.F
+++ /dev/null
@@ -1,43 +0,0 @@
-*
-* $Id: jbytet.F,v 1.2 2006/09/15 09:35:21 mclareni Exp $
-*
-* $Log: jbytet.F,v $
-* Revision 1.2 2006/09/15 09:35:21 mclareni
-* Submitted mods for gcc4/gfortran and MacOSX, corrected to work also on slc4 with gcc3.4 and 4.1
-*
-* Revision 1.1.1.1 1996/02/15 17:50:11 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QMSUN)
-#include "sungs/jbytet.F"
-#else
- FUNCTION JBYTET (MZ,IZW,IZP,NZB)
-C
-C CERN PROGLIB# M421 JBYTET .VERSION KERNFOR 4.23 891215
-C ORIG. 13/03/89 JZ
-C
-C This non-ANSI code is a default which may be slow, if so
-C it should be replaced by a machine-specific fast routine
-#include "kerngen/wordsize.inc"
-#if !defined(CERNLIB_QISASTD) && !defined(CERNLIB_GFORTRAN)
-#include "kerngen/q_andor.inc"
-#include "kerngen/q_shift.inc"
-* Ignoring t=pass
-#endif
-
-#if !defined(CERNLIB_QISASTD) && !defined(CERNLIB_GFORTRAN)
- JBYTET = IAND (MZ, ISHFTR(ISHFTL(IZW,NBITPW+1-IZP-NZB),
- + NBITPW-NZB) )
-#endif
-#if ((defined(CERNLIB_QISASTD))&&(!defined(CERNLIB_QMILSTD))) || defined(CERNLIB_GFORTRAN)
- JBYTET = IAND (MZ, ISHFT (ISHFT (IZW,NBITPW+1-IZP-NZB),
- + -NBITPW+NZB) )
-#endif
-#if defined(CERNLIB_QMILSTD)
- JBYTET = IAND (MZ, IBITS(IZW,IZP-1,NZB))
-#endif
- RETURN
- END
-#endif
diff --git a/src/packlib/kernlib/kerngen/tcgens/jbytor.F b/src/packlib/kernlib/kerngen/tcgens/jbytor.F
deleted file mode 100644
index 130a330..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/jbytor.F
+++ /dev/null
@@ -1,43 +0,0 @@
-*
-* $Id: jbytor.F,v 1.2 2006/09/15 09:35:21 mclareni Exp $
-*
-* $Log: jbytor.F,v $
-* Revision 1.2 2006/09/15 09:35:21 mclareni
-* Submitted mods for gcc4/gfortran and MacOSX, corrected to work also on slc4 with gcc3.4 and 4.1
-*
-* Revision 1.1.1.1 1996/02/15 17:50:12 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QMSUN)
-#include "sungs/jbytor.F"
-#else
- FUNCTION JBYTOR (MZ,IZW,IZP,NZB)
-C
-C CERN PROGLIB# M421 JBYTOR .VERSION KERNFOR 4.23 891215
-C ORIG. 13/03/89 JZ
-C
-C This non-ANSI code is a default which may be slow, if so
-C it should be replaced by a machine-specific fast routine
-#include "kerngen/wordsize.inc"
-#if !defined(CERNLIB_QISASTD) && !defined(CERNLIB_GFORTRAN)
-#include "kerngen/q_andor.inc"
-#include "kerngen/q_shift.inc"
-* Ignoring t=pass
-#endif
-
-#if !defined(CERNLIB_QISASTD) && !defined(CERNLIB_GFORTRAN)
- JBYTOR = IOR (MZ, ISHFTR(ISHFTL(IZW,NBITPW+1-IZP-NZB),
- + NBITPW-NZB) )
-#endif
-#if ((defined(CERNLIB_QISASTD))&&(!defined(CERNLIB_QMILSTD))) || defined(CERNLIB_GFORTRAN)
- JBYTOR = IOR (MZ, ISHFT (ISHFT (IZW,NBITPW+1-IZP-NZB),
- + -NBITPW+NZB) )
-#endif
-#if defined(CERNLIB_QMILSTD)
- JBYTOR = IOR (MZ, IBITS(IZW,IZP-1,NZB))
-#endif
- RETURN
- END
-#endif
diff --git a/src/packlib/kernlib/kerngen/tcgens/jbytpk.F b/src/packlib/kernlib/kerngen/tcgens/jbytpk.F
deleted file mode 100644
index 4a3adf5..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/jbytpk.F
+++ /dev/null
@@ -1,48 +0,0 @@
-*
-* $Id: jbytpk.F,v 1.1.1.1 1996/02/15 17:50:12 mclareni Exp $
-*
-* $Log: jbytpk.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:12 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- FUNCTION JBYTPK (A,JTH,NBITS)
-C
-C CERN PROGLIB# M422 JBYTPK .VERSION KERNFOR 4.07 830624
-C ORIG. 10/02/71 CL
-C
- DIMENSION A(99), NBITS(3)
- INTEGER A
-C
-#include "kerngen/q_jbit.inc"
-* Ignoring t=pass
-C
-C
- NBIT = NBITS(1)
- IF (NBIT.GT.0) GO TO 7
- NBIT = 1
-#if defined(CERNLIB_B32)
- INWORD = 32
-#endif
-#if defined(CERNLIB_B36)
- INWORD = 36
-#endif
-#if defined(CERNLIB_B48)
- INWORD = 48
-#endif
-#if defined(CERNLIB_B60)
- INWORD = 60
-#endif
-#if defined(CERNLIB_B64)
- INWORD = 64
-#endif
- GO TO 11
-C
- 7 INWORD= NBITS(2)
- 11 JWORD= (JTH-1)/INWORD + 1
- JPOS = JTH - (JWORD-1)*INWORD
- LOC = (JPOS-1)*NBIT + 1
- JBYTPK= JBYT (A(JWORD),LOC,NBIT)
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgens/jobnam.F b/src/packlib/kernlib/kerngen/tcgens/jobnam.F
deleted file mode 100644
index c2c0bf7..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/jobnam.F
+++ /dev/null
@@ -1,45 +0,0 @@
-*
-* $Id: jobnam.F,v 1.3 1997/11/05 16:00:44 mclareni Exp $
-*
-* $Log: jobnam.F,v $
-* Revision 1.3 1997/11/05 16:00:44 mclareni
-* Correct typo
-*
-* Revision 1.2 1997/11/05 10:13:26 mclareni
-* Include in WNT
-*
-* Revision 1.1.1.1 1996/02/15 17:50:12 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
-#if (defined(CERNLIB_QMSUN))&&(!defined(CERNLIB_SOLARIS))
-#include "sungs/jobnam.F"
-#else
- SUBROUTINE JOBNAM (ID)
-C
-C CERN PROGLIB# Z100 JOBNAM .VERSION KERNFOR 4.23 891215
-C ORIG. 06/12/89, JZ+FCA
-C
- DIMENSION ID(2)
- CHARACTER JOBNN*8
-#if defined(CERNLIB_QMHPX)
- PARAMETER (JOBNN='HPUnix')
-#elif defined(CERNLIB_QMSGI)
- PARAMETER (JOBNN='SILGRAPH')
-#elif defined(CERNLIB_QMOS9)
- PARAMETER (JOBNN='MWos9')
-#elif defined(CERNLIB_QMMPW)
- PARAMETER (JOBNN='MAC II ')
-#elif defined(CERNLIB_QMMPW)
- PARAMETER (JOBNN='MAC II ')
-#elif defined(CERNLIB_WINNT)
- PARAMETER (JOBNN='Windows ')
-#else
- PARAMETER (JOBNN = 'NotBatch')
-#endif
-
- CALL UCTOH (JOBNN,ID,8,8)
- RETURN
- END
-#endif
diff --git a/src/packlib/kernlib/kerngen/tcgens/jrsbyt.F b/src/packlib/kernlib/kerngen/tcgens/jrsbyt.F
deleted file mode 100644
index 67a9c38..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/jrsbyt.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: jrsbyt.F,v 1.1.1.1 1996/02/15 17:50:12 mclareni Exp $
-*
-* $Log: jrsbyt.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:12 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QMSUN)
-#include "sungs/jrsbyt.F"
-#else
- FUNCTION JRSBYT (VAL,X,JTH,NBITS)
-C
-C CERN PROGLIB# M421 JRSBYT .VERSION KERNFOR 4.07 830624
-C ORIG. 03/05/72 JZ
-C
- INTEGER VAL, X
-C
-#include "kerngen/q_jbit.inc"
-C
- JRSBYT= JBYT (X,JTH,NBITS)
- CALL SBYT (VAL,X,JTH,NBITS)
- RETURN
- END
-#endif
diff --git a/src/packlib/kernlib/kerngen/tcgens/lnxgs/cbyt.F b/src/packlib/kernlib/kerngen/tcgens/lnxgs/cbyt.F
deleted file mode 100644
index b9d5b47..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/lnxgs/cbyt.F
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: cbyt.F,v 1.1.1.1 1996/02/15 17:50:19 mclareni Exp $
-*
-* $Log: cbyt.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:19 mclareni
-* Kernlib
-*
-*
- SUBROUTINE CBYT (M,LM,IX,LX,NB)
-C
-C CERN PROGLIB# M421 CBYT .VERSION KERNLNX 1.00 930507
-C ORIG. 14/08/70 CL
-C
- IX = OR ( AND (IX,
- + NOT(LSHIFT (ISHFTR(NOT(0),32-NB), LX-1))),
- + ISHFTR(LSHIFT(ISHFTR(M,LM-1),32-NB),33-LX-NB))
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgens/lnxgs/iucomh.F b/src/packlib/kernlib/kerngen/tcgens/lnxgs/iucomh.F
deleted file mode 100644
index 2b56147..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/lnxgs/iucomh.F
+++ /dev/null
@@ -1,48 +0,0 @@
-*
-* $Id: iucomh.F,v 1.1.1.1 1996/02/15 17:50:19 mclareni Exp $
-*
-* $Log: iucomh.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:19 mclareni
-* Kernlib
-*
-*
- FUNCTION IUCOMH (ISTR1, ISTR2, NCH)
-C
-C CERN PROGLIB# IUCOMH .VERSION KERNLNX 1.00 930829
-C ORIG. FCA+JZ, 20/02/90
-C
-C Compare the two Hollerith strings of NCH bytes length and return
-C -1 if STRING1 < STRING2
-C 0 =
-C +1 >
-C which is determined by the first non-identical character.
-C
- DIMENSION ISTR1(9), ISTR2(9)
-C
- NDO = NCH
- IF (NDO.LE.0) GO TO 30
- NWD = (NDO-1)/4 + 1
-
- DO 29 JW=1,NWD
- IWD1 = ISTR1(JW)
- IWD2 = ISTR2(JW)
- NL = MIN(NDO,4)
- IF (IWD1. NE. IWD2) THEN
-
- DO 28 J=1,NL
- ICHAR1 = AND (IWD1,255)
- ICHAR2 = AND (IWD2,255)
- IF (ICHAR1-ICHAR2) 32, 26, 31
- 26 IWD1 = ISHFTR (IWD1,8)
- 28 IWD2 = ISHFTR (IWD2,8)
- END IF
- 29 NDO = NDO - 4
-
- 30 IUCOMH = 0
- RETURN
-
- 31 IUCOMH = 1
- RETURN
- 32 IUCOMH = -1
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgens/lnxgs/rndm.F b/src/packlib/kernlib/kerngen/tcgens/lnxgs/rndm.F
deleted file mode 100644
index d7dc46d..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/lnxgs/rndm.F
+++ /dev/null
@@ -1,44 +0,0 @@
-*
-* $Id: rndm.F,v 1.1.1.1 1996/02/15 17:50:19 mclareni Exp $
-*
-* $Log: rndm.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:19 mclareni
-* Kernlib
-*
-*
- FUNCTION RNDM (ISEED)
-C
-C CERN PROGLIB# V104 RNDM .VERSION KERNLNX 1.00 930507
-C ORIG. 22-MAR-88 from IBM version of G.Marsaglia et al., Montreal
-C MODIF 24/06/92, adapted N.Karpenko, Dubna
-C
-C !!! Version valid only for 32 bit machines !!!
-C !!! with IEEE floating point representation !!!
-C
-C- Uniform Random Number Generator,
-C- giving the same sequence as the IBM and VAX version
-
- EQUIVALENCE (AMAN,MANT)
- PARAMETER (MSK1 = 201326592)
- PARAMETER (MSK2 = 855638016)
-C PARAMETER (MSK1 = '0C000000'X)
-C PARAMETER (MSK2 = '33000000'X)
- COMMON /MCGN/ MCGN
- DATA MCGN /12345/
-
-
- MCGN = MCGN * 69069
- MANT = ISHFT (MCGN,-8)
- IF (MANT.EQ.0) GO TO 14
- AMAN = MANT
-C- AMAN in the range 1 to 2**24-1
- MANT = MANT - MSK1
-C- multiply by 2.**(-24)
- RNDM = AMAN
- RETURN
-
-C-- for zero set RNDM = 2.**(-25)
- 14 MANT = MSK2
- RNDM = AMAN
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgens/lnxgs/ublow.F b/src/packlib/kernlib/kerngen/tcgens/lnxgs/ublow.F
deleted file mode 100644
index cc0ac83..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/lnxgs/ublow.F
+++ /dev/null
@@ -1,69 +0,0 @@
-*
-* $Id: ublow.F,v 1.2 2006/09/15 09:35:24 mclareni Exp $
-*
-* $Log: ublow.F,v $
-* Revision 1.2 2006/09/15 09:35:24 mclareni
-* Submitted mods for gcc4/gfortran and MacOSX, corrected to work also on slc4 with gcc3.4 and 4.1
-*
-* Revision 1.1.1.1 1996/02/15 17:50:19 mclareni
-* Kernlib
-*
-*
- SUBROUTINE UBLOW (MS,MT,NCHP)
-C
-C CERN PROGLIB# M409 UBLOW .VERSION KERNLNX 1.02 940511
-C ORIG. 03/02/89 K.M.STORR
-C
-
- DIMENSION MS(99), MT(99), NCHP(9)
- data iblan1/x'20202000'/
- data mask1/x'000000ff'/
-
- NCH = NCHP(1)
- IF (NCH) 91, 29, 11
-#if !defined(CERNLIB_GFORTRAN)
- 11 NWS = ishftr (NCH,2)
- NTRAIL = AND (NCH,3)
-#else
- 11 NWS = ishft (NCH,-2)
- NTRAIL = iAND (NCH,3)
-#endif
- JT = 0
- IF (NWS.EQ.0) GO TO 26
-
-C-- Unpack the initial complete words
-
- DO 24 JS=1,NWS
- MWD = MS(JS)
-#if !defined(CERNLIB_GFORTRAN)
- MT(JT+1) = OR (IBLAN1,AND(MASK1,MWD))
- MT(JT+2) = OR (IBLAN1,AND(MASK1,ishftr(MWD,8)))
- MT(JT+3) = OR (IBLAN1,AND(MASK1,ishftr(MWD,16)))
- MT(JT+4) = OR (IBLAN1, ishftr(MWD,24) )
-#else
- MT(JT+1) = iOR (IBLAN1,iAND(MASK1,MWD))
- MT(JT+2) = iOR (IBLAN1,iAND(MASK1,ishft(MWD,-8)))
- MT(JT+3) = iOR (IBLAN1,iAND(MASK1,ishft(MWD,-16)))
- MT(JT+4) = iOR (IBLAN1, ishft(MWD,-24) )
-#endif
- 24 JT = JT + 4
-
- IF (NTRAIL.EQ.0) RETURN
-
-C-- Unpack the trailing word
-
- 26 MWD = MS(NWS+1)
-
- DO 28 JS=1,NTRAIL
-#if !defined(CERNLIB_GFORTRAN)
- MT(JT+1) = OR (IBLAN1,AND(MASK1,MWD))
- MWD = ishftr (MWD,8)
-#else
- MT(JT+1) = iOR (IBLAN1,iAND(MASK1,MWD))
- MWD = ishft (MWD,-8)
-#endif
- 28 JT = JT + 1
- 29 RETURN
-
- 91 CALL ABEND
- END
diff --git a/src/packlib/kernlib/kerngen/tcgens/lnxgs/ubunch.F b/src/packlib/kernlib/kerngen/tcgens/lnxgs/ubunch.F
deleted file mode 100644
index 70848d7..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/lnxgs/ubunch.F
+++ /dev/null
@@ -1,70 +0,0 @@
-*
-* $Id: ubunch.F,v 1.2 2006/09/15 09:35:24 mclareni Exp $
-*
-* $Log: ubunch.F,v $
-* Revision 1.2 2006/09/15 09:35:24 mclareni
-* Submitted mods for gcc4/gfortran and MacOSX, corrected to work also on slc4 with gcc3.4 and 4.1
-*
-* Revision 1.1.1.1 1996/02/15 17:50:20 mclareni
-* Kernlib
-*
-*
- SUBROUTINE UBUNCH (MS,MT,NCHP)
-C
-C CERN PROGLIB# M409 UBUNCH .VERSION KERNLNX 1.02 940511
-C ORIG. 03/02/89 K.M.STORR
-C
-
- DIMENSION MS(99), MT(99), NCHP(9)
- data iblan1/x'20202020'/
- data mask1/x'000000ff'/
-
- NCH = NCHP(1)
- IF (NCH) 91,39,11
-#if !defined(CERNLIB_GFORTRAN)
- 11 NWT = ishftr (NCH,2)
- NTRAIL = AND (NCH,3)
-#else
- 11 NWT = ishft (NCH,-2)
- NTRAIL = iAND (NCH,3)
-#endif
- JS = 0
- IF (NWT.EQ.0) GO TO 31
-
-C-- Pack the initial complete words
-
- DO 24 JT=1,NWT
-#if !defined(CERNLIB_GFORTRAN)
- MT(JT) = OR (OR (OR (
- + AND(MS(JS+1),MASK1),
- + LSHIFT (AND(MS(JS+2),MASK1), 8)),
- + LSHIFT (IAND(MS(JS+3),MASK1),16)),
- + LSHIFT (MS(JS+4), 24) )
-#else
- MT(JT) = iOR (iOR (iOR (
- + iAND(MS(JS+1),MASK1),
- + iSHFT (iAND(MS(JS+2),MASK1), 8)),
- + iSHFT (IAND(MS(JS+3),MASK1),16)),
- + iSHFT (MS(JS+4), 24) )
-#endif
- 24 JS = JS + 4
-
- IF (NTRAIL.EQ.0) RETURN
-
-C-- Pack the trailing word
-
- 31 MWD = IBLAN1
- JS = NCH
-
- DO 34 JT=1,NTRAIL
-#if !defined(CERNLIB_GFORTRAN)
- MWD = OR (LSHIFT(MWD,8), AND(MS(JS),MASK1))
-#else
- MWD = iOR (iSHFT(MWD,8), iAND(MS(JS),MASK1))
-#endif
- 34 JS = JS - 1
- MT(NWT+1) = MWD
- 39 RETURN
-
- 91 CALL ABEND
- END
diff --git a/src/packlib/kernlib/kerngen/tcgens/lnxppcgs/ublow.F b/src/packlib/kernlib/kerngen/tcgens/lnxppcgs/ublow.F
deleted file mode 100644
index 7a4f9d5..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/lnxppcgs/ublow.F
+++ /dev/null
@@ -1,72 +0,0 @@
-*
-* $Id: ublow.F,v 1.2 2006/09/15 09:35:24 mclareni Exp $
-*
-* $Log: ublow.F,v $
-* Revision 1.2 2006/09/15 09:35:24 mclareni
-* Submitted mods for gcc4/gfortran and MacOSX, corrected to work also on slc4 with gcc3.4 and 4.1
-*
-* Revision 1.1 1998/09/25 09:32:12 mclareni
-* Modifications for the Mklinux port flagged by CERNLIB_PPC
-*
-* Revision 1.1.1.1 1996/02/15 17:50:19 mclareni
-* Kernlib
-*
-*
- SUBROUTINE UBLOW (MS,MT,NCHP)
-C
-C CERN PROGLIB# M409 UBLOW .VERSION KERNLNX 1.02 940511
-C ORIG. 03/02/89 K.M.STORR
-C
-
- DIMENSION MS(99), MT(99), NCHP(9)
- data iblan1/x'00202020'/
- data mask1/x'ff000000'/
-
- NCH = NCHP(1)
- IF (NCH) 91, 29, 11
-#if !defined(CERNLIB_GFORTRAN)
- 11 NWS = ishftr (NCH,2)
- NTRAIL = AND (NCH,3)
-#else
- 11 NWS = ishft (NCH,-2)
- NTRAIL = iAND (NCH,3)
-#endif
- JT = 0
- IF (NWS.EQ.0) GO TO 26
-
-C-- Unpack the initial complete words
-
- DO 24 JS=1,NWS
- MWD = MS(JS)
-#if !defined(CERNLIB_GFORTRAN)
- MT(JT+1) = OR (IBLAN1,AND(MASK1,MWD))
- MT(JT+2) = OR (IBLAN1,AND(MASK1,LSHIFT(MWD,8)))
- MT(JT+3) = OR (IBLAN1,AND(MASK1,LSHIFT(MWD,16)))
- MT(JT+4) = OR (IBLAN1, LSHIFT(MWD,24) )
-#else
- MT(JT+1) = iOR (IBLAN1,iAND(MASK1,MWD))
- MT(JT+2) = iOR (IBLAN1,iAND(MASK1,iSHFT(MWD,8)))
- MT(JT+3) = iOR (IBLAN1,iAND(MASK1,iSHFT(MWD,16)))
- MT(JT+4) = iOR (IBLAN1, iSHFT(MWD,24) )
-#endif
- 24 JT = JT + 4
-
- IF (NTRAIL.EQ.0) RETURN
-
-C-- Unpack the trailing word
-
- 26 MWD = MS(NWS+1)
-
- DO 28 JS=1,NTRAIL
-#if !defined(CERNLIB_GFORTRAN)
- MT(JT+1) = OR (IBLAN1,AND(MASK1,MWD))
- MWD = LSHIFT (MWD,8)
-#else
- MT(JT+1) = iOR (IBLAN1,iAND(MASK1,MWD))
- MWD = iSHFT (MWD,8)
-#endif
- 28 JT = JT + 1
- 29 RETURN
-
- 91 CALL ABEND
- END
diff --git a/src/packlib/kernlib/kerngen/tcgens/lnxppcgs/ubunch.F b/src/packlib/kernlib/kerngen/tcgens/lnxppcgs/ubunch.F
deleted file mode 100644
index 9e291ba..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/lnxppcgs/ubunch.F
+++ /dev/null
@@ -1,73 +0,0 @@
-*
-* $Id: ubunch.F,v 1.2 2006/09/15 09:35:24 mclareni Exp $
-*
-* $Log: ubunch.F,v $
-* Revision 1.2 2006/09/15 09:35:24 mclareni
-* Submitted mods for gcc4/gfortran and MacOSX, corrected to work also on slc4 with gcc3.4 and 4.1
-*
-* Revision 1.1 1998/09/25 09:32:14 mclareni
-* Modifications for the Mklinux port flagged by CERNLIB_PPC
-*
-* Revision 1.1.1.1 1996/02/15 17:50:20 mclareni
-* Kernlib
-*
-*
- SUBROUTINE UBUNCH (MS,MT,NCHP)
-C
-C CERN PROGLIB# M409 UBUNCH .VERSION KERNLNX 1.02 940511
-C ORIG. 03/02/89 K.M.STORR
-C
-
- DIMENSION MS(99), MT(99), NCHP(9)
- data iblan1/x'20202020'/
- data mask1/x'ff000000'/
-
- NCH = NCHP(1)
- IF (NCH) 91,39,11
-#if !defined(CERNLIB_GFORTRAN)
- 11 NWT = ishftr (NCH,2)
- NTRAIL = AND (NCH,3)
-#else
- 11 NWT = ishft (NCH,-2)
- NTRAIL = iAND (NCH,3)
-#endif
- JS = 0
- IF (NWT.EQ.0) GO TO 31
-
-C-- Pack the initial complete words
-
- DO 24 JT=1,NWT
-#if !defined(CERNLIB_GFORTRAN)
- MT(JT) = OR (OR (OR (
- + AND(MS(JS+1),MASK1),
- + ISHFTR (AND(MS(JS+2),MASK1), 8)),
- + ISHFTR (IAND(MS(JS+3),MASK1),16)),
- + ISHFTR (MS(JS+4), 24) )
-#else
- MT(JT) = iOR (iOR (iOR (
- + iAND(MS(JS+1),MASK1),
- + ISHFT (iAND(MS(JS+2),MASK1), -8)),
- + ISHFT (IAND(MS(JS+3),MASK1),-16)),
- + ISHFT (MS(JS+4), -24) )
-#endif
- 24 JS = JS + 4
-
- IF (NTRAIL.EQ.0) RETURN
-
-C-- Pack the trailing word
-
- 31 MWD = IBLAN1
- JS = NCH
-
- DO 34 JT=1,NTRAIL
-#if !defined(CERNLIB_GFORTRAN)
- MWD = OR (ISHFTR(MWD,8), AND(MS(JS),MASK1))
-#else
- MWD = iOR (ISHFT(MWD,-8), iAND(MS(JS),MASK1))
-#endif
- 34 JS = JS - 1
- MT(NWT+1) = MWD
- 39 RETURN
-
- 91 CALL ABEND
- END
diff --git a/src/packlib/kernlib/kerngen/tcgens/lvmax.F b/src/packlib/kernlib/kerngen/tcgens/lvmax.F
deleted file mode 100644
index f949ac7..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/lvmax.F
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: lvmax.F,v 1.1.1.1 1996/02/15 17:50:12 mclareni Exp $
-*
-* $Log: lvmax.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:12 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- FUNCTION LVMAX (A,N)
-C
-C CERN PROGLIB# F121 LVMAX .VERSION KERNFOR 1.0 720321
-C ORIG. 01/07/71
-C
- DIMENSION A(*)
-C
- IF (N.LE.0) GO TO 100
- J= 1
- AMAX = A(1)
- DO 9 I= 1,N
- IF (A(I).LE.AMAX) GO TO 9
- AMAX= A(I)
- J= I
- 9 CONTINUE
- LVMAX = J
- RETURN
- 100 LVMAX=0
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgens/lvmaxa.F b/src/packlib/kernlib/kerngen/tcgens/lvmaxa.F
deleted file mode 100644
index a175280..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/lvmaxa.F
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: lvmaxa.F,v 1.1.1.1 1996/02/15 17:50:12 mclareni Exp $
-*
-* $Log: lvmaxa.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:12 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- FUNCTION LVMAXA (A,N)
-C
-C CERN PROGLIB# F121 LVMAXA .VERSION KERNFOR 1.0 710701
-C ORIG. 01/07/71
-C
- DIMENSION A(*)
-C
-C
- IF (N.LE.0) GO TO 100
- J= 1
- AMAX = 0.
- DO 9 I= 1,N
- CA= ABS (A(I))
- IF (CA.LE.AMAX) GO TO 9
- AMAX= CA
- J= I
- 9 CONTINUE
- LVMAXA = J
- RETURN
- 100 LVMAXA = 0
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgens/lvmin.F b/src/packlib/kernlib/kerngen/tcgens/lvmin.F
deleted file mode 100644
index e66533c..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/lvmin.F
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: lvmin.F,v 1.1.1.1 1996/02/15 17:50:12 mclareni Exp $
-*
-* $Log: lvmin.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:12 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- FUNCTION LVMIN (A,N)
-C
-C CERN PROGLIB# F121 LVMIN .VERSION KERNFOR 1.0 710701
-C ORIG. 01/07/71
-C
- DIMENSION A(*)
-C
- IF (N.LE.0) GO TO 100
- J= 1
- AMIN= A(1)
- DO 9 I= 1,N
- IF (AMIN.LE.A(I)) GO TO 9
- AMIN= A(I)
- J= I
- 9 CONTINUE
- LVMIN = J
- RETURN
- 100 LVMIN = 0
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgens/lvmina.F b/src/packlib/kernlib/kerngen/tcgens/lvmina.F
deleted file mode 100644
index 2446830..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/lvmina.F
+++ /dev/null
@@ -1,30 +0,0 @@
-*
-* $Id: lvmina.F,v 1.1.1.1 1996/02/15 17:50:13 mclareni Exp $
-*
-* $Log: lvmina.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:13 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- FUNCTION LVMINA (A,N)
-C
-C CERN PROGLIB# F121 LVMINA .VERSION KERNFOR 1.0 710701
-C ORIG. 01/07/71
-C
- DIMENSION A(*)
-C
- IF (N.LE.0) GO TO 100
- J= 1
- AMIN= ABS (A(1))
- DO 9 I= 1,N
- CA= ABS (A(I))
- IF (AMIN.LE.CA) GO TO 9
- AMIN= CA
- J= I
- 9 CONTINUE
- LVMINA = J
- RETURN
- 100 LVMINA = 0
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgens/mbytet.F b/src/packlib/kernlib/kerngen/tcgens/mbytet.F
deleted file mode 100644
index 99b29fc..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/mbytet.F
+++ /dev/null
@@ -1,40 +0,0 @@
-*
-* $Id: mbytet.F,v 1.2 2006/09/15 09:35:21 mclareni Exp $
-*
-* $Log: mbytet.F,v $
-* Revision 1.2 2006/09/15 09:35:21 mclareni
-* Submitted mods for gcc4/gfortran and MacOSX, corrected to work also on slc4 with gcc3.4 and 4.1
-*
-* Revision 1.1.1.1 1996/02/15 17:50:13 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QMSUN)
-#include "sungs/mbytet.F"
-#else
- FUNCTION MBYTET (MZ,IZW,IZP,NZB)
-C
-C CERN PROGLIB# M421 MBYTET .VERSION KERNFOR 4.23 891215
-C ORIG. 13/03/89 JZ
-C
-C This non-ANSI code is a default which may be slow, if so
-C it should be replaced by a machine-specific fast routine
-#include "kerngen/wordsize.inc"
-#if !defined(CERNLIB_QISASTD) && !defined(CERNLIB_GFORTRAN)
-#include "kerngen/q_andor.inc"
-#include "kerngen/q_shift.inc"
-* Ignoring t=pass
-#endif
-
-#if !defined(CERNLIB_QISASTD) && !defined(CERNLIB_GFORTRAN)
- MBYTET = IAND (IZW, NOT(ISHFTR(ISHFTL(NOT(MZ),NBITPW-NZB),
- + NBITPW+1-IZP-NZB)) )
-#endif
-#if defined(CERNLIB_QISASTD) || defined(CERNLIB_GFORTRAN)
- MBYTET = IAND (IZW, NOT(ISHFT (ISHFT (NOT(MZ),NBITPW-NZB),
- + -NBITPW-1+IZP+NZB)) )
-#endif
- RETURN
- END
-#endif
diff --git a/src/packlib/kernlib/kerngen/tcgens/mbytor.F b/src/packlib/kernlib/kerngen/tcgens/mbytor.F
deleted file mode 100644
index 1e8ea46..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/mbytor.F
+++ /dev/null
@@ -1,40 +0,0 @@
-*
-* $Id: mbytor.F,v 1.2 2006/09/15 09:35:22 mclareni Exp $
-*
-* $Log: mbytor.F,v $
-* Revision 1.2 2006/09/15 09:35:22 mclareni
-* Submitted mods for gcc4/gfortran and MacOSX, corrected to work also on slc4 with gcc3.4 and 4.1
-*
-* Revision 1.1.1.1 1996/02/15 17:50:13 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QMSUN)
-#include "sungs/mbytor.F"
-#else
- FUNCTION MBYTOR (MZ,IZW,IZP,NZB)
-C
-C CERN PROGLIB# M421 MBYTOR .VERSION KERNFOR 4.23 891215
-C ORIG. 13/03/89 JZ
-C
-C This non-ANSI code is a default which may be slow, if so
-C it should be replaced by a machine-specific fast routine
-#include "kerngen/wordsize.inc"
-#if !defined(CERNLIB_QISASTD) && !defined(CERNLIB_GFORTRAN)
-#include "kerngen/q_andor.inc"
-#include "kerngen/q_shift.inc"
-* Ignoring t=pass
-#endif
-
-#if !defined(CERNLIB_QISASTD) && !defined(CERNLIB_GFORTRAN)
- MBYTOR = IOR (IZW, ISHFTR(ISHFTL(MZ,NBITPW-NZB),
- + NBITPW+1-IZP-NZB) )
-#endif
-#if defined(CERNLIB_QISASTD) || defined(CERNLIB_GFORTRAN)
- MBYTOR = IOR (IZW, ISHFT (ISHFT (MZ,NBITPW-NZB),
- + -NBITPW-1+IZP+NZB) )
-#endif
- RETURN
- END
-#endif
diff --git a/src/packlib/kernlib/kerngen/tcgens/mcbyt.F b/src/packlib/kernlib/kerngen/tcgens/mcbyt.F
deleted file mode 100644
index 0c98e3b..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/mcbyt.F
+++ /dev/null
@@ -1,43 +0,0 @@
-*
-* $Id: mcbyt.F,v 1.2 2006/09/15 09:35:22 mclareni Exp $
-*
-* $Log: mcbyt.F,v $
-* Revision 1.2 2006/09/15 09:35:22 mclareni
-* Submitted mods for gcc4/gfortran and MacOSX, corrected to work also on slc4 with gcc3.4 and 4.1
-*
-* Revision 1.1.1.1 1996/02/15 17:50:13 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QMSUN)
-#include "sungs/mcbyt.F"
-#else
- FUNCTION MCBYT (MZ,IZQ,IZW,IZP,NZB)
-C
-C CERN PROGLIB# M421 MCBYT .VERSION KERNFOR 4.23 891215
-C ORIG. 13/03/89 JZ
-C
-C This non-ANSI code is a default which may be slow, if so
-C it should be replaced by a machine-specific fast routine
-#include "kerngen/wordsize.inc"
-#include "kerngen/iall1s.inc"
-#if !defined(CERNLIB_QISASTD) && !defined(CERNLIB_GFORTRAN)
-#include "kerngen/q_andor.inc"
-#include "kerngen/q_shift.inc"
-* Ignoring t=pass
-#endif
-
-#if !defined(CERNLIB_QISASTD) && !defined(CERNLIB_GFORTRAN)
- MCBYT = IOR (
- + IAND(IZW, NOT(ISHFTL(ISHFTR(IALL11, NBITPW-NZB), IZP-1)))
- +, ISHFTR(ISHFTL(ISHFTR(MZ, IZQ-1),NBITPW-NZB), NBITPW+1-IZP-NZB))
-#endif
-#if defined(CERNLIB_QISASTD) || defined(CERNLIB_GFORTRAN)
- MCBYT = IOR (
- + IAND(IZW, NOT(ISHFT (ISHFT (IALL11,-NBITPW+NZB), IZP-1)))
- +, ISHFT (ISHFT (ISHFT (MZ,-IZQ+1),NBITPW-NZB),-NBITPW-1+IZP+NZB))
-#endif
- RETURN
- END
-#endif
diff --git a/src/packlib/kernlib/kerngen/tcgens/mpwgs/rndm.F b/src/packlib/kernlib/kerngen/tcgens/mpwgs/rndm.F
deleted file mode 100644
index fe3fcc0..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/mpwgs/rndm.F
+++ /dev/null
@@ -1,56 +0,0 @@
-*
-* $Id: rndm.F,v 1.1.1.1 1996/02/15 17:50:24 mclareni Exp $
-*
-* $Log: rndm.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:24 mclareni
-* Kernlib
-*
-*
- FUNCTION RNDM (ISEED)
-C
-C CERN PROGLIB# V104 RNDM .VERSION KERNMPW 1.00 891208
-C ORIG. 22-MAR-88 from IBM version of G.Marsaglia et al., Montreal
-C
-C- Uniform Random Number Generator,
-C- giving the same sequence as the IBM and VAX version
-
- EQUIVALENCE (AMAN,MANT)
- PARAMETER (MSK1 = 201326592)
- PARAMETER (MSK2 = 855638016)
-C PARAMETER (MSK1 = '0C000000'X)
-C PARAMETER (MSK2 = '33000000'X)
- COMMON / V104RN / MCGN
- DATA MCGN /12345/
-
-
- MCGN = MCGN * 69069
- MANT = ISHFT (MCGN,-8)
- IF (MANT.EQ.0) GO TO 14
- AMAN = MANT
-C- AMAN in the range 1 to 2**24-1
- MANT = MANT - MSK1
-C- multiply by 2.**(-24)
- RNDM = AMAN
- RETURN
-
-C-- for zero set RNDM = 2.**(-25)
- 14 MANT = MSK2
- RNDM = AMAN
- RETURN
-
-C-- Integer random number
- ENTRY IRNDM (ISEED)
- MCGN = MCGN * 69069
- IRNDM = ISHFT (MCGN,-1)
- END
-
- SUBROUTINE RDMIN (ISEED)
-C-- Set the seed
- COMMON / V104RN / MCGN
- MCGN = ISEED
- RETURN
-
-C-- Get the seed
- ENTRY RDMOUT (ISEED)
- ISEED = MCGN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgens/mpwgs/ublow.F b/src/packlib/kernlib/kerngen/tcgens/mpwgs/ublow.F
deleted file mode 100644
index f0724ad..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/mpwgs/ublow.F
+++ /dev/null
@@ -1,57 +0,0 @@
-*
-* $Id: ublow.F,v 1.1.1.1 1996/02/15 17:50:24 mclareni Exp $
-*
-* $Log: ublow.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:24 mclareni
-* Kernlib
-*
-*
- SUBROUTINE UBLOW (MS,MT,NCHP)
-C
-C CERN PROGLIB# M409 UBLOW .VERSION KERNMPW 1.00 891208
-C ORIG. 12/12/83 JZ & FCA
-C
-
- DIMENSION MS(99), MT(99), NCHP(9)
- PARAMETER (IBLAN1 = 2105376)
- PARAMETER (MASK1 = -16777216)
-
- IF(IAND(MS(2),65535).EQ.18) THEN
-
-C-- Rare but nasty case, input as nH...
-C-- MPW FORTRAN makes a character out of it
-
- CALL UCTOH1(MS,MT,NCHP)
- GO TO 29
- END IF
- NCH = NCHP(1)
- IF (NCH) 91, 29, 11
- 11 NWS = ISHFT (NCH,-2)
- NTRAIL = IAND (NCH,3)
- JT = 0
- IF (NWS.EQ.0) GO TO 26
-
-C-- Unpack the initial complete words
-
- DO 24 JS=1,NWS
- MWD = MS(JS)
- MT(JT+1) = IOR (IBLAN1,IAND(MASK1,MWD))
- MT(JT+2) = IOR (IBLAN1,IAND(MASK1,ISHFT(MWD, 8)))
- MT(JT+3) = IOR (IBLAN1,IAND(MASK1,ISHFT(MWD,16)))
- MT(JT+4) = IOR (IBLAN1, ISHFT(MWD,24) )
- 24 JT = JT + 4
-
- IF (NTRAIL.EQ.0) RETURN
-
-C-- Unpack the trailing word
-
- 26 MWD = MS(NWS+1)
-
- DO 28 JS=1,NTRAIL
- MT(JT+1) = IOR (IBLAN1,IAND(MASK1,MWD))
- MWD = ISHFT (MWD,8)
- 28 JT = JT + 1
- 29 RETURN
-
- 91 CALL ABEND
- END
diff --git a/src/packlib/kernlib/kerngen/tcgens/msbit.F b/src/packlib/kernlib/kerngen/tcgens/msbit.F
deleted file mode 100644
index a091696..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/msbit.F
+++ /dev/null
@@ -1,40 +0,0 @@
-*
-* $Id: msbit.F,v 1.2 2006/09/15 09:35:22 mclareni Exp $
-*
-* $Log: msbit.F,v $
-* Revision 1.2 2006/09/15 09:35:22 mclareni
-* Submitted mods for gcc4/gfortran and MacOSX, corrected to work also on slc4 with gcc3.4 and 4.1
-*
-* Revision 1.1.1.1 1996/02/15 17:50:13 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QMSUN)
-#include "sungs/msbit.F"
-#else
- FUNCTION MSBIT (MZ,IZW,IZP)
-C
-C CERN PROGLIB# M421 MSBIT .VERSION KERNFOR 4.23 891215
-C ORIG. 13/03/89 JZ
-C
-C This non-ANSI code is a default which may be slow, if so
-C it should be replaced by a machine-specific fast routine
-
-#if !defined(CERNLIB_QISASTD) && !defined(CERNLIB_GFORTRAN)
-#include "kerngen/q_andor.inc"
-#include "kerngen/q_shift.inc"
-* Ignoring t=pass
-#endif
-
-#if !defined(CERNLIB_QISASTD) && !defined(CERNLIB_GFORTRAN)
- MSBIT = IOR (IAND (IZW, NOT(ISHFTL(1,IZP-1)) )
- +, ISHFTL(IAND(MZ,1),IZP-1) )
-#endif
-#if defined(CERNLIB_QISASTD) || defined(CERNLIB_GFORTRAN)
- MSBIT = IOR (IAND (IZW, NOT(ISHFT (1,IZP-1)) )
- +, ISHFT (IAND(MZ,1),IZP-1) )
-#endif
- RETURN
- END
-#endif
diff --git a/src/packlib/kernlib/kerngen/tcgens/msbit0.F b/src/packlib/kernlib/kerngen/tcgens/msbit0.F
deleted file mode 100644
index d632bb2..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/msbit0.F
+++ /dev/null
@@ -1,38 +0,0 @@
-*
-* $Id: msbit0.F,v 1.2 2006/09/15 09:35:22 mclareni Exp $
-*
-* $Log: msbit0.F,v $
-* Revision 1.2 2006/09/15 09:35:22 mclareni
-* Submitted mods for gcc4/gfortran and MacOSX, corrected to work also on slc4 with gcc3.4 and 4.1
-*
-* Revision 1.1.1.1 1996/02/15 17:50:19 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QMSUN)
-#include "sungs/msbit0.F"
-#else
- FUNCTION MSBIT0 (IZW,IZP)
-C
-C CERN PROGLIB# M421 MSBIT0 .VERSION KERNFOR 4.23 891215
-C ORIG. 13/03/89 JZ
-C
-C This non-ANSI code is a default which may be slow, if so
-C it should be replaced by a machine-specific fast routine
-
-#if !defined(CERNLIB_QISASTD) && !defined(CERNLIB_GFORTRAN)
-#include "kerngen/q_andor.inc"
-#include "kerngen/q_shift.inc"
-* Ignoring t=pass
-#endif
-
-#if !defined(CERNLIB_QISASTD) && !defined(CERNLIB_GFORTRAN)
- MSBIT0 = IAND (IZW, NOT(ISHFTL(1,IZP-1)))
-#endif
-#if defined(CERNLIB_QISASTD) || defined(CERNLIB_GFORTRAN)
- MSBIT0 = IAND (IZW, NOT(ISHFT (1,IZP-1)))
-#endif
- RETURN
- END
-#endif
diff --git a/src/packlib/kernlib/kerngen/tcgens/msbit1.F b/src/packlib/kernlib/kerngen/tcgens/msbit1.F
deleted file mode 100644
index 1f6971c..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/msbit1.F
+++ /dev/null
@@ -1,38 +0,0 @@
-*
-* $Id: msbit1.F,v 1.2 2006/09/15 09:35:22 mclareni Exp $
-*
-* $Log: msbit1.F,v $
-* Revision 1.2 2006/09/15 09:35:22 mclareni
-* Submitted mods for gcc4/gfortran and MacOSX, corrected to work also on slc4 with gcc3.4 and 4.1
-*
-* Revision 1.1.1.1 1996/02/15 17:50:19 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QMSUN)
-#include "sungs/msbit1.F"
-#else
- FUNCTION MSBIT1 (IZW,IZP)
-C
-C CERN PROGLIB# M421 MSBIT1 .VERSION KERNFOR 4.23 891215
-C ORIG. 13/03/89 JZ
-C
-C This non-ANSI code is a default which may be slow, if so
-C it should be replaced by a machine-specific fast routine
-
-#if !defined(CERNLIB_QISASTD) && !defined(CERNLIB_GFORTRAN)
-#include "kerngen/q_andor.inc"
-#include "kerngen/q_shift.inc"
-* Ignoring t=pass
-#endif
-
-#if !defined(CERNLIB_QISASTD) && !defined(CERNLIB_GFORTRAN)
- MSBIT1 = IOR (IZW, ISHFTL(1,IZP-1))
-#endif
-#if defined(CERNLIB_QISASTD) || defined(CERNLIB_GFORTRAN)
- MSBIT1 = IOR (IZW, ISHFT (1,IZP-1))
-#endif
- RETURN
- END
-#endif
diff --git a/src/packlib/kernlib/kerngen/tcgens/msbyt.F b/src/packlib/kernlib/kerngen/tcgens/msbyt.F
deleted file mode 100644
index 57d21e3..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/msbyt.F
+++ /dev/null
@@ -1,43 +0,0 @@
-*
-* $Id: msbyt.F,v 1.2 2006/09/15 09:35:22 mclareni Exp $
-*
-* $Log: msbyt.F,v $
-* Revision 1.2 2006/09/15 09:35:22 mclareni
-* Submitted mods for gcc4/gfortran and MacOSX, corrected to work also on slc4 with gcc3.4 and 4.1
-*
-* Revision 1.1.1.1 1996/02/15 17:50:13 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QMSUN)
-#include "sungs/msbyt.F"
-#else
- FUNCTION MSBYT (MZ,IZW,IZP,NZB)
-C
-C CERN PROGLIB# M421 MSBYT .VERSION KERNFOR 4.23 891215
-C ORIG. 13/03/89 JZ
-C
-C This non-ANSI code is a default which may be slow, if so
-C it should be replaced by a machine-specific fast routine
-#include "kerngen/wordsize.inc"
-#include "kerngen/iall1s.inc"
-#if !defined(CERNLIB_QISASTD) && !defined(CERNLIB_GFORTRAN)
-#include "kerngen/q_andor.inc"
-#include "kerngen/q_shift.inc"
-* Ignoring t=pass
-#endif
-
-#if !defined(CERNLIB_QISASTD) && !defined(CERNLIB_GFORTRAN)
- MSBYT = IOR (
- + IAND(IZW, NOT(ISHFTL(ISHFTR(IALL11, NBITPW-NZB),IZP-1)))
- +, ISHFTR(ISHFTL(MZ,NBITPW-NZB), NBITPW+1-IZP-NZB) )
-#endif
-#if defined(CERNLIB_QISASTD) || defined(CERNLIB_GFORTRAN)
- MSBYT = IOR (
- + IAND(IZW, NOT(ISHFT (ISHFT (IALL11,-NBITPW+NZB),IZP-1)))
- +, ISHFT (ISHFT (MZ,NBITPW-NZB),-NBITPW-1+IZP+NZB) )
-#endif
- RETURN
- END
-#endif
diff --git a/src/packlib/kernlib/kerngen/tcgens/noarg.F b/src/packlib/kernlib/kerngen/tcgens/noarg.F
deleted file mode 100644
index 132f656..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/noarg.F
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: noarg.F,v 1.1.1.1 1996/02/15 17:50:13 mclareni Exp $
-*
-* $Log: noarg.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:13 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE NOARG (NARGS)
-C
-C CERN PROGLIB# Z029 NOARG .VERSION KERNFOR 4.19 880728
-C ORIG. 01/12/86 HRR, DUMMY VERSION
-C
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgens/pkbyt.F b/src/packlib/kernlib/kerngen/tcgens/pkbyt.F
deleted file mode 100644
index 6f582d9..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/pkbyt.F
+++ /dev/null
@@ -1,100 +0,0 @@
-*
-* $Id: pkbyt.F,v 1.2 2006/09/15 09:35:22 mclareni Exp $
-*
-* $Log: pkbyt.F,v $
-* Revision 1.2 2006/09/15 09:35:22 mclareni
-* Submitted mods for gcc4/gfortran and MacOSX, corrected to work also on slc4 with gcc3.4 and 4.1
-*
-* Revision 1.1.1.1 1996/02/15 17:50:13 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QMSUN)
-#include "sungs/pkbyt.F"
-#elif !defined(CERNLIB_NOSHIFT)
- SUBROUTINE PKBYT (MIV,MBV,JTHP,NINTP,NBITS)
-C
-C CERN PROGLIB# M422 PKBYT .VERSION KERNFOR 4.23 891215
-C ORIG. 13/03/89 JZ
-C
-C This non-ANSI code is a default which may be slow, if so
-C it should be replaced by a machine-specific fast routine
-C
- DIMENSION MIV(99), MBV(99), JTHP(9), NINTP(9), NBITS(2)
-
-#include "kerngen/wordsize.inc"
-#include "kerngen/iall1s.inc"
-#if !defined(CERNLIB_QISASTD) && !defined(CERNLIB_GFORTRAN)
-#include "kerngen/q_andor.inc"
-#include "kerngen/q_shift.inc"
-* Ignoring t=pass
-#endif
-
- JTH = JTHP(1)
- NINT = NINTP(1)
- IF (NINT.LE.0) RETURN
-
- NZB = NBITS(1)
- IF (NZB.GT.0) GO TO 11
- NZB = 1
- NPWD = NBITPW
- MSKA = 1
- GO TO 12
-
- 11 NPWD = NBITS(2)
-#if !defined(CERNLIB_QISASTD) && !defined(CERNLIB_GFORTRAN)
- MSKA = ISHFTR (IALL11, NBITPW-NZB)
-#endif
-#if defined(CERNLIB_QISASTD) || defined(CERNLIB_GFORTRAN)
- MSKA = ISHFT (IALL11,-NBITPW+NZB)
-#endif
-
- 12 JBV = 1
- JIV = 0
- IF (JTH.LT.2) GO TO 21
- JBV = (JTH-1)/NPWD + 1
- JPOS = JTH - (JBV-1)*NPWD - 1
- IF (JPOS.EQ.0) GO TO 21
- NL = JPOS*NZB
-#if !defined(CERNLIB_QISASTD) && !defined(CERNLIB_GFORTRAN)
- MSKU = ISHFTL (MSKA,NL)
-#endif
-#if defined(CERNLIB_QISASTD) || defined(CERNLIB_GFORTRAN)
- MSKU = ISHFT (MSKA,NL)
-#endif
- JIVE = NPWD - JPOS
- GO TO 22
-
-C-- PACK EACH WORD
-
- 21 NL = 0
- MSKU = MSKA
- JIVE = JIV + NPWD
- 22 JIVE = MIN (NINT,JIVE)
- IZW = MBV(JBV)
-
- 24 JIV = JIV + 1
- IZW = IOR (IAND(NOT(MSKU),IZW),
-#if !defined(CERNLIB_QISASTD) && !defined(CERNLIB_GFORTRAN)
- + IAND(MSKU,ISHFTL(MIV(JIV),NL)))
-#endif
-#if defined(CERNLIB_QISASTD) || defined(CERNLIB_GFORTRAN)
- + IAND(MSKU,ISHFT (MIV(JIV),NL)))
-#endif
- IF (JIV.EQ.JIVE) GO TO 27
- NL = NL + NZB
-#if !defined(CERNLIB_QISASTD) && !defined(CERNLIB_GFORTRAN)
- MSKU = ISHFTL (MSKU,NZB)
-#endif
-#if defined(CERNLIB_QISASTD) || defined(CERNLIB_GFORTRAN)
- MSKU = ISHFT (MSKU,NZB)
-#endif
- GO TO 24
-
- 27 MBV(JBV) = IZW
- IF (JIV.EQ.NINT) RETURN
- JBV = JBV + 1
- GO TO 21
- END
-#endif
diff --git a/src/packlib/kernlib/kerngen/tcgens/pkchar.F b/src/packlib/kernlib/kerngen/tcgens/pkchar.F
deleted file mode 100644
index 9cc7be8..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/pkchar.F
+++ /dev/null
@@ -1,89 +0,0 @@
-*
-* $Id: pkchar.F,v 1.1.1.1 1996/02/15 17:50:13 mclareni Exp $
-*
-* $Log: pkchar.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:13 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE PKCHAR (IGV,ICHV,NN,IPAR)
-C
-C CERN PROGLIB# M427 PKCHAR .VERSION KERNFOR 4.20 881028
-C ORIG. 07/07/72 JZ
-C
- COMMON /SLATE/ JCH,N,NBITS,NCHAR,NZONE,IGNOR,JIN,NBDONE,NBEND
- +, JGO,JBT,NLEFT,NRIGH,DUMMY(27)
- DIMENSION ICHV(*),IGV(*),IPAR(9)
-C .
-C
-#include "kerngen/wordsize.inc"
-C
-C
- N = NN
- IF (N.EQ.0) RETURN
- NBITS = IPAR(1)
- NCHAR = IPAR(2)
- NZONE = IPAR(3)
- IGNOR = IPAR(4)
- NFILL = IPAR(5)
- JIN = 1
- JCH = 1
- ICHV(1)= NFILL
- IF (NZONE.NE.0) GO TO 41
-C
-C---- ZONE = WORD
-C
- 21 JGO = NBITPW+1 - IGNOR
- NBEND= NBITS + 1
- IF (NCHAR.EQ.0) GO TO 22
- NBEND = MAX (NBEND,JGO-NBITS*(NCHAR-1))
-C
- 22 JBT = JGO
-C
- 24 JBT = JBT - NBITS
- CALL SBYT (IGV(JIN),ICHV(JCH),JBT,NBITS)
- IF (JIN.EQ.N) RETURN
- JIN = JIN + 1
- IF (JBT.GE.NBEND) GO TO 24
- JCH = JCH + 1
- ICHV(JCH)= NFILL
- GO TO 22
-C
-C---- ZONE NOT EQUALS A WORD
-C
- 41 IF (NZONE.EQ.NBITPW) GO TO 21
- JBT = NBITPW - IGNOR
- NBEND = NZONE+1 - NBITS
- IF (NCHAR.EQ.0) GO TO 42
- NBEND = MIN (NBEND, IGNOR+NCHAR*NBITS)
-C
- 42 NBDONE= IGNOR
- 43 IF (JBT.GE.0) GO TO 44
- JBT= JBT + NBITPW
- JCH= JCH + 1
- ICHV(JCH)= NFILL
- GO TO 43
-C
- 44 JBT = JBT - NBITS
- IF (JBT.LT.0) GO TO 51
- CALL SBYT (IGV(JIN),ICHV(JCH),JBT+1,NBITS)
- GO TO 58
-C
-C-- CHARACTER ACROSS WORD BOUNDARY
- 51 NLEFT= NBITS + JBT
- NRIGH= -JBT
- JBT = JBT + NBITPW
- IF (NLEFT.EQ.0) GO TO 54
- CALL CBYT (IGV(JIN),NRIGH+1,ICHV(JCH),1,NLEFT)
- 54 JCH= JCH + 1
- ICHV(JCH)= NFILL
- CALL SBYT (IGV(JIN),ICHV(JCH),JBT+1,NRIGH)
-C
- 58 IF (JIN.EQ.N) RETURN
- JIN= JIN + 1
- NBDONE= NBDONE + NBITS
- IF (NBDONE.LT.NBEND) GO TO 44
- JBT = JBT - (NZONE-NBDONE) - IGNOR
- GO TO 42
- END
diff --git a/src/packlib/kernlib/kerngen/tcgens/rndm.F b/src/packlib/kernlib/kerngen/tcgens/rndm.F
deleted file mode 100644
index cfe4df2..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/rndm.F
+++ /dev/null
@@ -1,104 +0,0 @@
-*
-* $Id: rndm.F,v 1.4 2006/09/15 09:35:22 mclareni Exp $
-*
-* $Log: rndm.F,v $
-* Revision 1.4 2006/09/15 09:35:22 mclareni
-* Submitted mods for gcc4/gfortran and MacOSX, corrected to work also on slc4 with gcc3.4 and 4.1
-*
-* Revision 1.3 1997/10/23 16:37:04 mclareni
-* NT mods
-*
-* Revision 1.2 1997/02/04 17:36:24 mclareni
-* Merge Winnt and 97a versions
-*
-* Revision 1.1.1.1.2.1 1997/01/21 11:31:40 mclareni
-* All mods for Winnt 96a on winnt branch
-*
-* Revision 1.1.1.1 1996/02/15 17:50:13 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_MSSTDCALL)&&defined(CERNLIB_WINNT)
-#include "wntgs/rndm.F"
-#elif defined(CERNLIB_QMDOS)
-#include "dosgs/rndm.F"
-#elif defined(CERNLIB_QMMPW)
-#include "mpwgs/rndm.F"
-#elif defined(CERNLIB_QMVAOS)||defined(CERNLIB_QMVMI)
-#include "allgs/rndm.F"
-#elif defined(CERNLIB_QMLNX)
-#include "lnxgs/rndm.F"
-#elif defined(CERNLIB_QMIRTD)
-#include "irtdgs/rndm.F"
-#elif defined(CERNLIB_QMSUN)
-#include "sungs/rndm.F"
-#elif defined(CERNLIB_QMVAX)
-#include "vaxgs/rndm.F"
-#elif (defined(CERNLIB_B32))&&(defined(CERNLIB_QIEEE))
- FUNCTION RNDM (ISEED)
-C
-C CERN PROGLIB# V104 RNDM .VERSION KERNFOR 4.23 891215
-C ORIG. 22-MAR-88 from IBM version of G.Marsaglia et al., Montreal
-C
-C !!! Version valid only for 32 bit machines !!!
-C !!! with IEEE floating point representation !!!
-C
-C- Uniform Random Number Generator,
-C- giving the same sequence as the IBM and VAX version
-
- EQUIVALENCE (AMAN,MANT)
- PARAMETER (MSK1 = 201326592)
- PARAMETER (MSK2 = 855638016)
-C PARAMETER (MSK1 = '0C000000'X)
-C PARAMETER (MSK2 = '33000000'X)
- SAVE MCGN
- DATA MCGN /12345/
-
-#if !defined(CERNLIB_QISASTD) && !defined(CERNLIB_GFORTRAN)
-#include "kerngen/q_andor.inc"
-#include "kerngen/q_shift.inc"
-* Ignoring t=pass
-#endif
-
- MCGN = MCGN * 69069
-#if defined(CERNLIB_QISASTD) || defined(CERNLIB_GFORTRAN)
- MANT = ISHFT (MCGN,-8)
-#endif
-#if !defined(CERNLIB_QISASTD) && !defined(CERNLIB_GFORTRAN)
- MANT = ISHFTR(MCGN, 8)
-#endif
- IF (MANT.EQ.0) GO TO 14
- AMAN = MANT
-C- AMAN in the range 1 to 2**24-1
- MANT = MANT - MSK1
-C- multiply by 2.**(-24)
- RNDM = AMAN
- RETURN
-
-C-- for zero set RNDM = 2.**(-25)
- 14 MANT = MSK2
- RNDM = AMAN
- RETURN
-
-C-- Integer random number
- ENTRY IRNDM (ISEED)
- MCGN = MCGN * 69069
-#if defined(CERNLIB_QISASTD) || defined(CERNLIB_GFORTRAN)
- IRNDM = ISHFT (MCGN,-1)
-#endif
-#if !defined(CERNLIB_QISASTD) && !defined(CERNLIB_GFORTRAN)
- IRNDM = ISHFTR(MCGN, 1)
-#endif
- RETURN
-
-C-- Set the seed
- ENTRY RDMIN (ISEED)
- MCGN = ISEED
- RETURN
-
-C-- Get the seed
- ENTRY RDMOUT (ISEED)
- ISEED = MCGN
- END
-#endif
diff --git a/src/packlib/kernlib/kerngen/tcgens/sbit.F b/src/packlib/kernlib/kerngen/tcgens/sbit.F
deleted file mode 100644
index d312e7e..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/sbit.F
+++ /dev/null
@@ -1,40 +0,0 @@
-*
-* $Id: sbit.F,v 1.2 2006/09/15 09:35:22 mclareni Exp $
-*
-* $Log: sbit.F,v $
-* Revision 1.2 2006/09/15 09:35:22 mclareni
-* Submitted mods for gcc4/gfortran and MacOSX, corrected to work also on slc4 with gcc3.4 and 4.1
-*
-* Revision 1.1.1.1 1996/02/15 17:50:13 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QMSUN)
-#include "sungs/sbit.F"
-#else
- SUBROUTINE SBIT (IT,IZW,IZP)
-C
-C CERN PROGLIB# M421 SBIT .VERSION KERNFOR 4.23 891215
-C MOD. true default 24/2/89, JZ
-C
-C This non-ANSI code is a default which may be slow, if so
-C it should be replaced by a machine-specific fast routine
-
-#if !defined(CERNLIB_QISASTD) && !defined(CERNLIB_GFORTRAN)
-#include "kerngen/q_andor.inc"
-#include "kerngen/q_shift.inc"
-* Ignoring t=pass
-#endif
-
-#if !defined(CERNLIB_QISASTD) && !defined(CERNLIB_GFORTRAN)
- IZW = IOR ( IAND (IZW, NOT(ISHFTL(1,IZP-1)))
- +, ISHFTL(IAND(IT,1), IZP-1) )
-#endif
-#if defined(CERNLIB_QISASTD) || defined(CERNLIB_GFORTRAN)
- IZW = IOR ( IAND (IZW, NOT(ISHFT (1,IZP-1)))
- +, ISHFT (IAND(IT,1), IZP-1) )
-#endif
- RETURN
- END
-#endif
diff --git a/src/packlib/kernlib/kerngen/tcgens/sbit0.F b/src/packlib/kernlib/kerngen/tcgens/sbit0.F
deleted file mode 100644
index 0aa0d42..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/sbit0.F
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: sbit0.F,v 1.2 2006/09/15 09:35:22 mclareni Exp $
-*
-* $Log: sbit0.F,v $
-* Revision 1.2 2006/09/15 09:35:22 mclareni
-* Submitted mods for gcc4/gfortran and MacOSX, corrected to work also on slc4 with gcc3.4 and 4.1
-*
-* Revision 1.1.1.1 1996/02/15 17:50:19 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QMSUN)
-#include "sungs/sbit0.F"
-#else
- SUBROUTINE SBIT0 (IZW,IZP)
-C
-C CERN PROGLIB# M421 SBIT0 .VERSION KERNFOR 4.23 891215
-C MOD. true default 24/2/89, JZ
-C
-C This non-ANSI code is a default which may be slow, if so
-C it should be replaced by a machine-specific fast routine
-
-#if !defined(CERNLIB_QISASTD) && !defined(CERNLIB_GFORTRAN)
-#include "kerngen/q_andor.inc"
-#include "kerngen/q_shift.inc"
-* Ignoring t=pass
-#endif
-
-#if !defined(CERNLIB_QISASTD) && !defined(CERNLIB_GFORTRAN)
- IZW = IAND (IZW, NOT(ISHFTL(1,IZP-1)) )
-#endif
-#if ((defined(CERNLIB_QISASTD))&&(!defined(CERNLIB_QMILSTD))) || defined(CERNLIB_GFORTRAN)
- IZW = IAND (IZW, NOT(ISHFT (1,IZP-1)) )
-#endif
-#if defined(CERNLIB_QMILSTD)
- IZW = IBCLR (IZW, IZP-1)
-#endif
- RETURN
- END
-#endif
diff --git a/src/packlib/kernlib/kerngen/tcgens/sbit1.F b/src/packlib/kernlib/kerngen/tcgens/sbit1.F
deleted file mode 100644
index 7577a94..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/sbit1.F
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: sbit1.F,v 1.2 2006/09/15 09:35:22 mclareni Exp $
-*
-* $Log: sbit1.F,v $
-* Revision 1.2 2006/09/15 09:35:22 mclareni
-* Submitted mods for gcc4/gfortran and MacOSX, corrected to work also on slc4 with gcc3.4 and 4.1
-*
-* Revision 1.1.1.1 1996/02/15 17:50:19 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QMSUN)
-#include "sungs/sbit1.F"
-#else
- SUBROUTINE SBIT1 (IZW,IZP)
-C
-C CERN PROGLIB# M421 SBIT1 .VERSION KERNFOR 4.23 891215
-C MOD. true default 24/2/89, JZ
-C
-C This non-ANSI code is a default which may be slow, if so
-C it should be replaced by a machine-specific fast routine
-
-#if !defined(CERNLIB_QISASTD) && !defined(CERNLIB_GFORTRAN)
-#include "kerngen/q_andor.inc"
-#include "kerngen/q_shift.inc"
-* Ignoring t=pass
-#endif
-
-#if !defined(CERNLIB_QISASTD) && !defined(CERNLIB_GFORTRAN)
- IZW = IOR (IZW, ISHFTL(1,IZP-1))
-#endif
-#if ((defined(CERNLIB_QISASTD))&&(!defined(CERNLIB_QMILSTD))) || defined(CERNLIB_GFORTRAN)
- IZW = IOR (IZW, ISHFT (1,IZP-1))
-#endif
-#if defined(CERNLIB_QMILSTD)
- IZW = IBSET (IZW, IZP-1)
-#endif
- RETURN
- END
-#endif
diff --git a/src/packlib/kernlib/kerngen/tcgens/sbyt.F b/src/packlib/kernlib/kerngen/tcgens/sbyt.F
deleted file mode 100644
index 8dd443a..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/sbyt.F
+++ /dev/null
@@ -1,44 +0,0 @@
-*
-* $Id: sbyt.F,v 1.2 2006/09/15 09:35:23 mclareni Exp $
-*
-* $Log: sbyt.F,v $
-* Revision 1.2 2006/09/15 09:35:23 mclareni
-* Submitted mods for gcc4/gfortran and MacOSX, corrected to work also on slc4 with gcc3.4 and 4.1
-*
-* Revision 1.1.1.1 1996/02/15 17:50:14 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QMSUN)
-#include "sungs/sbyt.F"
-#else
- SUBROUTINE SBYT (IT,IZW,IZP,NZB)
-C
-C CERN PROGLIB# M421 SBYT .VERSION KERNFOR 4.23 891215
-C MOD. true default 24/2/89, JZ
-C
-C This non-ANSI code is a default which may be slow, if so
-C it should be replaced by a machine-specific fast routine
-C
-#include "kerngen/wordsize.inc"
-#include "kerngen/iall1s.inc"
-#if (!defined(CERNLIB_QISASTD)) && (!defined(CERNLIB_GFORTRAN))
-#include "kerngen/q_andor.inc"
-#include "kerngen/q_shift.inc"
-* Ignoring t=pass
-#endif
-
-#if (!defined(CERNLIB_QISASTD)) && (!defined(CERNLIB_GFORTRAN))
- MSK = ISHFTR (IALL11, NBITPW-NZB)
- IZW = IOR ( IAND (IZW, NOT(ISHFTL(MSK,IZP-1)))
- +, ISHFTL(IAND(IT,MSK),IZP-1))
-#endif
-#if defined(CERNLIB_QISASTD) || defined(CERNLIB_GFORTRAN)
- MSK = ISHFT (IALL11,-NBITPW+NZB)
- IZW = IOR ( IAND (IZW, NOT(ISHFT (MSK,IZP-1)))
- +, ISHFT (IAND(IT,MSK),IZP-1))
-#endif
- RETURN
- END
-#endif
diff --git a/src/packlib/kernlib/kerngen/tcgens/sbytor.F b/src/packlib/kernlib/kerngen/tcgens/sbytor.F
deleted file mode 100644
index 904c9aa..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/sbytor.F
+++ /dev/null
@@ -1,42 +0,0 @@
-*
-* $Id: sbytor.F,v 1.2 2006/09/15 09:35:23 mclareni Exp $
-*
-* $Log: sbytor.F,v $
-* Revision 1.2 2006/09/15 09:35:23 mclareni
-* Submitted mods for gcc4/gfortran and MacOSX, corrected to work also on slc4 with gcc3.4 and 4.1
-*
-* Revision 1.1.1.1 1996/02/15 17:50:14 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QMSUN)
-#include "sungs/sbytor.F"
-#else
- SUBROUTINE SBYTOR (IT,IZW,IZP,NZB)
-C
-C CERN PROGLIB# M421 SBYTOR .VERSION KERNFOR 4.23 891215
-C ORIG. 13/03/89 JZ
-C
-C This non-ANSI code is a default which may be slow, if so
-C it should be replaced by a machine-specific fast routine
-C
-#include "kerngen/wordsize.inc"
-#include "kerngen/iall1s.inc"
-#if !defined(CERNLIB_QISASTD) && !defined(CERNLIB_GFORTRAN)
-#include "kerngen/q_andor.inc"
-#include "kerngen/q_shift.inc"
-* Ignoring t=pass
-#endif
-
-#if !defined(CERNLIB_QISASTD) && !defined(CERNLIB_GFORTRAN)
- IZW = IOR (IZW,
- + ISHFTL (IAND(IT,ISHFTR(IALL11, NBITPW-NZB)), IZP-1))
-#endif
-#if defined(CERNLIB_QISASTD) || defined(CERNLIB_GFORTRAN)
- IZW = IOR (IZW,
- + ISHFT (IAND(IT,ISHFT (IALL11,-NBITPW+NZB)), IZP-1))
-#endif
- RETURN
- END
-#endif
diff --git a/src/packlib/kernlib/kerngen/tcgens/sbytpk.F b/src/packlib/kernlib/kerngen/tcgens/sbytpk.F
deleted file mode 100644
index 9172105..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/sbytpk.F
+++ /dev/null
@@ -1,44 +0,0 @@
-*
-* $Id: sbytpk.F,v 1.1.1.1 1996/02/15 17:50:14 mclareni Exp $
-*
-* $Log: sbytpk.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:14 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE SBYTPK (I,X,JTH,NBITS)
-C
-C CERN PROGLIB# M422 SBYTPK .VERSION KERNFOR 4.06 830526
-C ORIG. 10/02/71
-C
- DIMENSION X(99), NBITS(3)
-C
-C
- NBIT = NBITS(1)
- IF (NBIT.GT.0) GO TO 7
- NBIT = 1
-#if defined(CERNLIB_B32)
- INWORD = 32
-#endif
-#if defined(CERNLIB_B36)
- INWORD = 36
-#endif
-#if defined(CERNLIB_B48)
- INWORD = 48
-#endif
-#if defined(CERNLIB_B60)
- INWORD = 60
-#endif
-#if defined(CERNLIB_B64)
- INWORD = 64
-#endif
- GO TO 11
-C
- 7 INWORD= NBITS(2)
- 11 JWORD= (JTH-1)/INWORD + 1
- JPOS = JTH - (JWORD-1)*INWORD
- LOC = (JPOS-1)*NBIT + 1
- CALL SBYT (I,X(JWORD),LOC,NBIT)
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgens/sungs/cbyt.F b/src/packlib/kernlib/kerngen/tcgens/sungs/cbyt.F
deleted file mode 100644
index 9e68c6a..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/sungs/cbyt.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: cbyt.F,v 1.1.1.1 1996/02/15 17:50:20 mclareni Exp $
-*
-* $Log: cbyt.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:20 mclareni
-* Kernlib
-*
-*
- SUBROUTINE CBYT (MZ,IZQ,IZW,IZP,NZB)
-C
-C CERN PROGLIB# M421 CBYT .VERSION KERNSUN 1.06 920511
-C ORIG. 22/09/88, JZ
-C
-C
-#if defined(CERNLIB_BUGLRSHFT)
- IZW = OR ( AND (IZW,
- + NOT(LSHIFT (ishft(NOT(0),NZB-32), IZP-1)))
- +, ishft (LSHIFT(ishft(MZ,1-IZQ),32-NZB),-33+IZP+NZB) )
-#endif
-#if !defined(CERNLIB_BUGLRSHFT)
- IZW = OR ( AND (IZW,
- + NOT(LSHIFT (lrshft(NOT(0),32-NZB), IZP-1)))
- +, lrshft (LSHIFT(lrshft(MZ,IZQ-1),32-NZB), 33-IZP-NZB) )
-#endif
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgens/sungs/jbit.F b/src/packlib/kernlib/kerngen/tcgens/sungs/jbit.F
deleted file mode 100644
index 3b09b43..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/sungs/jbit.F
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: jbit.F,v 1.1.1.1 1996/02/15 17:50:20 mclareni Exp $
-*
-* $Log: jbit.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:20 mclareni
-* Kernlib
-*
-*
- FUNCTION JBIT (IZW,IZP)
-C
-C CERN PROGLIB# M421 JBIT .VERSION KERNSUN 1.00 880922
-C ORIG. 22/09/88, JZ
-C
- JBIT = AND (RSHIFT(IZW,IZP-1), 1)
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgens/sungs/jbyt.F b/src/packlib/kernlib/kerngen/tcgens/sungs/jbyt.F
deleted file mode 100644
index f2f1832..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/sungs/jbyt.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: jbyt.F,v 1.1.1.1 1996/02/15 17:50:20 mclareni Exp $
-*
-* $Log: jbyt.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:20 mclareni
-* Kernlib
-*
-*
- FUNCTION JBYT (IZW,IZP,NZB)
-C
-C CERN PROGLIB# M421 JBYT .VERSION KERNSUN 1.06 920511
-C ORIG. 22/09/88, JZ
-C
-#if defined(CERNLIB_BUGLRSHFT)
- JBYT = ishft (LSHIFT(IZW,33-IZP-NZB),-32+NZB)
-#endif
-#if !defined(CERNLIB_BUGLRSHFT)
- JBYT = lrshft (LSHIFT(IZW,33-IZP-NZB), 32-NZB)
-#endif
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgens/sungs/jbytet.F b/src/packlib/kernlib/kerngen/tcgens/sungs/jbytet.F
deleted file mode 100644
index 6cd5423..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/sungs/jbytet.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: jbytet.F,v 1.1.1.1 1996/02/15 17:50:20 mclareni Exp $
-*
-* $Log: jbytet.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:20 mclareni
-* Kernlib
-*
-*
- FUNCTION JBYTET (MZ,IZW,IZP,NZB)
-C
-C CERN PROGLIB# M421 JBYTET .VERSION KERNSUN 1.06 920511
-C ORIG. 22/09/88, JZ
-C
-#if defined(CERNLIB_BUGLRSHFT)
- JBYTET = AND (MZ, ishft (LSHIFT(IZW,33-IZP-NZB), -32+NZB))
-#endif
-#if !defined(CERNLIB_BUGLRSHFT)
- JBYTET = AND (MZ, lrshft (LSHIFT(IZW,33-IZP-NZB), 32-NZB) )
-#endif
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgens/sungs/jbytor.F b/src/packlib/kernlib/kerngen/tcgens/sungs/jbytor.F
deleted file mode 100644
index 1e16756..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/sungs/jbytor.F
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: jbytor.F,v 1.1.1.1 1996/02/15 17:50:20 mclareni Exp $
-*
-* $Log: jbytor.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:20 mclareni
-* Kernlib
-*
-*
- FUNCTION JBYTOR (MZ,IZW,IZP,NZB)
-C
-C CERN PROGLIB# M421 JBYTOR .VERSION KERNSUN 1.00 880922
-C ORIG. 22/09/88, JZ
-C
- JBYTOR = OR (MZ, IBITS(IZW,IZP-1,NZB))
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgens/sungs/jobnam.F b/src/packlib/kernlib/kerngen/tcgens/sungs/jobnam.F
deleted file mode 100644
index 7322af6..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/sungs/jobnam.F
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: jobnam.F,v 1.1.1.1 1996/02/15 17:50:22 mclareni Exp $
-*
-* $Log: jobnam.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:22 mclareni
-* Kernlib
-*
-*
- SUBROUTINE JOBNAM (ID)
-C
-C CERN PROGLIB# Z100 JOBNAM .VERSION KERNSUN 1.00 880922
-C ORIG. 22/09/88, JZ
-C
- DIMENSION ID(2)
-
- ID(1) = 4H SUN
- ID(2) = 4H m
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgens/sungs/jrsbyt.F b/src/packlib/kernlib/kerngen/tcgens/sungs/jrsbyt.F
deleted file mode 100644
index a0d48fd..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/sungs/jrsbyt.F
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: jrsbyt.F,v 1.1.1.1 1996/02/15 17:50:20 mclareni Exp $
-*
-* $Log: jrsbyt.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:20 mclareni
-* Kernlib
-*
-*
- FUNCTION JRSBYT (IT,IZW,IZP,NZB)
-C
-C CERN PROGLIB# M421 JRSBYT .VERSION KERNSUN 1.06 920511
-C ORIG. 22/09/88, JZ
-C
-
-#if defined(CERNLIB_BUGLRSHFT)
- MASK = LSHIFT (ishft(-1,-32+NZB), IZP-1)
- JRSBYT = ishft (AND(MASK,IZW), 1-IZP)
-#endif
-#if !defined(CERNLIB_BUGLRSHFT)
- MASK = LSHIFT (lrshft(-1,32-NZB), IZP-1)
- JRSBYT = lrshft (AND(MASK,IZW), IZP-1)
-#endif
- IZW = OR (AND(NOT(MASK),IZW), AND(MASK,LSHIFT(IT,IZP-1)))
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgens/sungs/mbytet.F b/src/packlib/kernlib/kerngen/tcgens/sungs/mbytet.F
deleted file mode 100644
index dc51edd..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/sungs/mbytet.F
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: mbytet.F,v 1.1.1.1 1996/02/15 17:50:20 mclareni Exp $
-*
-* $Log: mbytet.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:20 mclareni
-* Kernlib
-*
-*
- FUNCTION MBYTET (MZ,IZW,IZP,NZB)
-C
-C CERN PROGLIB# M421 MBYTET .VERSION KERNSUN 1.06 920511
-C ORIG. 22/09/88, JZ
-C
-
-#if defined(CERNLIB_BUGLRSHFT)
- MBYTET = AND (IZW,
- + NOT(ishft (LSHIFT(NOT(MZ),32-NZB), -33+IZP+NZB)))
-#endif
-#if !defined(CERNLIB_BUGLRSHFT)
- MBYTET = AND (IZW,
- + NOT(lrshft (LSHIFT(NOT(MZ),32-NZB), 33-IZP-NZB)))
-#endif
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgens/sungs/mbytor.F b/src/packlib/kernlib/kerngen/tcgens/sungs/mbytor.F
deleted file mode 100644
index a2c7726..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/sungs/mbytor.F
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: mbytor.F,v 1.1.1.1 1996/02/15 17:50:20 mclareni Exp $
-*
-* $Log: mbytor.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:20 mclareni
-* Kernlib
-*
-*
- FUNCTION MBYTOR (MZ,IZW,IZP,NZB)
-C
-C CERN PROGLIB# M421 MBYTOR .VERSION KERNSUN 1.06 920511
-C ORIG. 22/09/88, JZ
-C
-
-#if defined(CERNLIB_BUGLRSHFT)
- MBYTOR = OR (IZW, ishft (LSHIFT(MZ,32-NZB), -33+IZP+NZB) )
-#endif
-#if !defined(CERNLIB_BUGLRSHFT)
- MBYTOR = OR (IZW, lrshft (LSHIFT(MZ,32-NZB), 33-IZP-NZB) )
-#endif
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgens/sungs/mcbyt.F b/src/packlib/kernlib/kerngen/tcgens/sungs/mcbyt.F
deleted file mode 100644
index 7d7eb63..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/sungs/mcbyt.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: mcbyt.F,v 1.1.1.1 1996/02/15 17:50:20 mclareni Exp $
-*
-* $Log: mcbyt.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:20 mclareni
-* Kernlib
-*
-*
- FUNCTION MCBYT (MZ,IZQ,IZW,IZP,NZB)
-C
-C CERN PROGLIB# M421 MCBYT .VERSION KERNSUN 1.06 920511
-C ORIG. 22/09/88, JZ
-C
-
-#if defined(CERNLIB_BUGLRSHFT)
- MASK = LSHIFT (ishft(-1,NZB-32), IZP-1)
- MCBYT = OR ( AND (IZW, NOT(MASK))
- +, AND (MASK, LSHIFT(ishft(MZ,1-IZQ), IZP-1)))
-#endif
-#if !defined(CERNLIB_BUGLRSHFT)
- MASK = LSHIFT (lrshft(-1,32-NZB), IZP-1)
- MCBYT = OR ( AND (IZW, NOT(MASK))
- +, AND (MASK, LSHIFT(lrshft(MZ,IZQ-1), IZP-1)))
-#endif
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgens/sungs/msbit.F b/src/packlib/kernlib/kerngen/tcgens/sungs/msbit.F
deleted file mode 100644
index bd08cb7..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/sungs/msbit.F
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: msbit.F,v 1.1.1.1 1996/02/15 17:50:21 mclareni Exp $
-*
-* $Log: msbit.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:21 mclareni
-* Kernlib
-*
-*
- FUNCTION MSBIT (MZ,IZW,IZP)
-C
-C CERN PROGLIB# M421 MSBIT .VERSION KERNSUN 1.00 880922
-C ORIG. 22/09/88, JZ
-C
-
- MSBIT = OR (AND (IZW, NOT(LSHIFT(1,IZP-1)) )
- + , LSHIFT(AND(MZ,1),IZP-1) )
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgens/sungs/msbit0.F b/src/packlib/kernlib/kerngen/tcgens/sungs/msbit0.F
deleted file mode 100644
index 9fa8f5e..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/sungs/msbit0.F
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: msbit0.F,v 1.1.1.1 1996/02/15 17:50:21 mclareni Exp $
-*
-* $Log: msbit0.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:21 mclareni
-* Kernlib
-*
-*
- FUNCTION MSBIT0 (IZW,IZP)
-C
-C CERN PROGLIB# M421 MSBIT0 .VERSION KERNSUN 1.00 880922
-C ORIG. 22/09/88, JZ
-C
- MSBIT0 = AND (IZW, NOT(LSHIFT(1,IZP-1)))
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgens/sungs/msbit1.F b/src/packlib/kernlib/kerngen/tcgens/sungs/msbit1.F
deleted file mode 100644
index 7daf29a..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/sungs/msbit1.F
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: msbit1.F,v 1.1.1.1 1996/02/15 17:50:21 mclareni Exp $
-*
-* $Log: msbit1.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:21 mclareni
-* Kernlib
-*
-*
- FUNCTION MSBIT1 (IZW,IZP)
-C
-C CERN PROGLIB# M421 MSBIT1 .VERSION KERNSUN 1.00 880922
-C ORIG. 22/09/88, JZ
-C
- MSBIT1 = OR (IZW, LSHIFT(1,IZP-1))
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgens/sungs/msbyt.F b/src/packlib/kernlib/kerngen/tcgens/sungs/msbyt.F
deleted file mode 100644
index 0400a06..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/sungs/msbyt.F
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: msbyt.F,v 1.1.1.1 1996/02/15 17:50:21 mclareni Exp $
-*
-* $Log: msbyt.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:21 mclareni
-* Kernlib
-*
-*
- FUNCTION MSBYT (MZ,IZW,IZP,NZB)
-C
-C CERN PROGLIB# M421 MSBYT .VERSION KERNSUN 1.06 920511
-C ORIG. 22/09/88, JZ
-C
-
-#if defined(CERNLIB_BUGLRSHFT)
- MASK = LSHIFT (ishft(-1,NZB-32), IZP-1)
-#endif
-#if !defined(CERNLIB_BUGLRSHFT)
- MASK = LSHIFT (lrshft(-1,32-NZB), IZP-1)
-#endif
- MSBYT = OR (AND(NOT(MASK),IZW), AND(MASK,LSHIFT(MZ,IZP-1)))
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgens/sungs/pkbyt.F b/src/packlib/kernlib/kerngen/tcgens/sungs/pkbyt.F
deleted file mode 100644
index c9391e7..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/sungs/pkbyt.F
+++ /dev/null
@@ -1,67 +0,0 @@
-*
-* $Id: pkbyt.F,v 1.1.1.1 1996/02/15 17:50:21 mclareni Exp $
-*
-* $Log: pkbyt.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:21 mclareni
-* Kernlib
-*
-*
- SUBROUTINE PKBYT (MIV,MBV,JTHP,NINTP,NBITS)
-C
-C CERN PROGLIB# M422 PKBYT .VERSION KERNSUN 1.06 920511
-C ORIG. 22/09/88, JZ
-C
- DIMENSION MIV(99), MBV(99), JTHP(9), NINTP(9), NBITS(2)
-
-
- JTH = JTHP(1)
- NINT = NINTP(1)
- IF (NINT.LE.0) RETURN
-
- NZB = NBITS(1)
- IF (NZB.GT.0) GO TO 11
- NZB = 1
- NPWD = 32
- MASK = 1
- GO TO 12
-
- 11 NPWD = NBITS(2)
-#if defined(CERNLIB_BUGLRSHFT)
- MASK = ishft (-1, NZB-32)
-#endif
-#if !defined(CERNLIB_BUGLRSHFT)
- MASK = lrshft (-1, 32-NZB)
-#endif
-
- 12 JBV = 1
- JIV = 0
- IF (JTH.LT.2) GO TO 21
- JBV = (JTH-1)/NPWD + 1
- JPOS = JTH - (JBV-1)*NPWD - 1
- IF (JPOS.EQ.0) GO TO 21
- NL = JPOS*NZB
- MSKU = LSHIFT (MASK,NL)
- JIVE = NPWD - JPOS
- GO TO 22
-
-C-- PACK EACH WORD
-
- 21 NL = 0
- MSKU = MASK
- JIVE = JIV + NPWD
- 22 JIVE = MIN0 (NINT,JIVE)
- IZW = MBV(JBV)
-
- 24 JIV = JIV + 1
- IZW = OR (AND(NOT(MSKU),IZW),
- + AND(MSKU,LSHIFT(MIV(JIV),NL)))
- IF (JIV.EQ.JIVE) GO TO 27
- NL = NL + NZB
- MSKU = LSHIFT (MSKU,NZB)
- GO TO 24
-
- 27 MBV(JBV) = IZW
- IF (JIV.EQ.NINT) RETURN
- JBV = JBV + 1
- GO TO 21
- END
diff --git a/src/packlib/kernlib/kerngen/tcgens/sungs/rndm.F b/src/packlib/kernlib/kerngen/tcgens/sungs/rndm.F
deleted file mode 100644
index dc22de7..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/sungs/rndm.F
+++ /dev/null
@@ -1,58 +0,0 @@
-*
-* $Id: rndm.F,v 1.1.1.1 1996/02/15 17:50:21 mclareni Exp $
-*
-* $Log: rndm.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:21 mclareni
-* Kernlib
-*
-*
- FUNCTION RNDM (ISEED)
-C
-C CERN PROGLIB# V104 RNDM .VERSION KERNSUN 1.06 920511
-C ORIG. 13-JULY-88 JZ from IBM version of G.Marsaglia et al., Montreal
-C
-C- Uniform Random Number Generator,
-C- giving the same sequence as the IBM and VAX version
-
- EQUIVALENCE (AMAN,MANT)
- SAVE MCGN
- DATA MCGN /12345/
-
- MCGN = MCGN * 69069
-#if defined(CERNLIB_BUGLRSHFT)
- MANT = ishft (MCGN, -8)
-#endif
-#if !defined(CERNLIB_BUGLRSHFT)
- MANT = lrshft (MCGN, 8)
-#endif
- IF (MANT.EQ.0) GO TO 14
- AMAN = MANT
-C- AMAN in the range 1 to 2**24-1
-C- - MANT = MANT - X'0C000000'
- MANT = MANT - 201326592
-C- multiply by 2.**(-24)
- RNDM = AMAN
- RETURN
-
-C-- for zero set RNDM = 2.**(-25)
-C- 14 MANT = X'33000000'
- 14 MANT = 855638016
- RNDM = AMAN
- RETURN
-
-C-- Integer random number
- ENTRY IRNDM (ISEED)
- MCGN = MCGN * 69069
-C- - IRNDM = IAND (MCGN,X'7FFFFFFF')
- IRNDM = AND (MCGN, 2147483647)
- RETURN
-
-C-- Set the seed
- ENTRY RDMIN (ISEED)
- MCGN = ISEED
- RETURN
-
-C-- Get the seed
- ENTRY RDMOUT (ISEED)
- ISEED = MCGN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgens/sungs/sbit.F b/src/packlib/kernlib/kerngen/tcgens/sungs/sbit.F
deleted file mode 100644
index 02a4b3a..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/sungs/sbit.F
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: sbit.F,v 1.1.1.1 1996/02/15 17:50:21 mclareni Exp $
-*
-* $Log: sbit.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:21 mclareni
-* Kernlib
-*
-*
- SUBROUTINE SBIT (IT,IZW,IZP)
-C
-C CERN PROGLIB# M421 SBIT .VERSION KERNSUN 1.00 880922
-C ORIG. 22/09/88, JZ
-C
-
- IZW = OR (AND(NOT(LSHIFT(1,IZP-1)),IZW),
- + LSHIFT(AND(IT,1),IZP-1))
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgens/sungs/sbit0.F b/src/packlib/kernlib/kerngen/tcgens/sungs/sbit0.F
deleted file mode 100644
index 8a61925..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/sungs/sbit0.F
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: sbit0.F,v 1.1.1.1 1996/02/15 17:50:21 mclareni Exp $
-*
-* $Log: sbit0.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:21 mclareni
-* Kernlib
-*
-*
- SUBROUTINE SBIT0 (IZW,IZP)
-C
-C CERN PROGLIB# M421 SBIT0 .VERSION KERNSUN 1.00 880922
-C ORIG. 22/09/88, JZ
-C
- IZW = AND (IZW, NOT(LSHIFT(1,IZP-1)))
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgens/sungs/sbit1.F b/src/packlib/kernlib/kerngen/tcgens/sungs/sbit1.F
deleted file mode 100644
index f459ed4..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/sungs/sbit1.F
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: sbit1.F,v 1.1.1.1 1996/02/15 17:50:21 mclareni Exp $
-*
-* $Log: sbit1.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:21 mclareni
-* Kernlib
-*
-*
- SUBROUTINE SBIT1 (IZW,IZP)
-C
-C CERN PROGLIB# M421 SBIT1 .VERSION KERNSUN 1.00 880922
-C ORIG. 22/09/88, JZ
-C
- IZW = OR (IZW, LSHIFT(1,IZP-1))
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgens/sungs/sbyt.F b/src/packlib/kernlib/kerngen/tcgens/sungs/sbyt.F
deleted file mode 100644
index a728ecd..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/sungs/sbyt.F
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: sbyt.F,v 1.1.1.1 1996/02/15 17:50:21 mclareni Exp $
-*
-* $Log: sbyt.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:21 mclareni
-* Kernlib
-*
-*
- SUBROUTINE SBYT (MZ,IZW,IZP,NZB)
-C
-C CERN PROGLIB# M421 SBYT .VERSION KERNSUN 1.06 920511
-C ORIG. 22/09/88, JZ
-C
-
-#if defined(CERNLIB_BUGLRSHFT)
- MASK = LSHIFT (ishft(-1,NZB-32), IZP-1)
-#endif
-#if !defined(CERNLIB_BUGLRSHFT)
- MASK = LSHIFT (lrshft(-1,32-NZB), IZP-1)
-#endif
- IZW = OR (AND(NOT(MASK),IZW), AND(MASK,LSHIFT(MZ,IZP-1)))
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgens/sungs/sbytor.F b/src/packlib/kernlib/kerngen/tcgens/sungs/sbytor.F
deleted file mode 100644
index 76075f9..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/sungs/sbytor.F
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: sbytor.F,v 1.1.1.1 1996/02/15 17:50:21 mclareni Exp $
-*
-* $Log: sbytor.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:21 mclareni
-* Kernlib
-*
-*
- SUBROUTINE SBYTOR (MZ,IZW,IZP,NZB)
-C
-C CERN PROGLIB# M421 SBYTOR .VERSION KERNSUN 1.06 920511
-C ORIG. 22/09/88, JZ
-C
-
-#if defined(CERNLIB_BUGLRSHFT)
- IZW = OR (IZW, LSHIFT (AND(ishft(-1,NZB-32),MZ), IZP-1))
-#endif
-#if !defined(CERNLIB_BUGLRSHFT)
- IZW = OR (IZW, LSHIFT (AND(lrshft(-1,32-NZB),MZ), IZP-1))
-#endif
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgens/sungs/ublow.F b/src/packlib/kernlib/kerngen/tcgens/sungs/ublow.F
deleted file mode 100644
index d490aa9..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/sungs/ublow.F
+++ /dev/null
@@ -1,52 +0,0 @@
-*
-* $Id: ublow.F,v 1.1.1.1 1996/02/15 17:50:22 mclareni Exp $
-*
-* $Log: ublow.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:22 mclareni
-* Kernlib
-*
-*
- SUBROUTINE UBLOW (MS,MT,NCHP)
-C
-C CERN PROGLIB# M409 UBLOW .VERSION KERNSUN 1.00 880922
-C ORIG. 22/09/88, JZ
-C
-
- DIMENSION MS(99), MT(99), NCHP(9)
-C- - PARAMETER (IBLAN1 = X'00202020')
- PARAMETER (IBLAN1 = 2105376 )
-C- - PARAMETER (MASK1 = X'FF000000')
- PARAMETER (MASK1 = -16777216 )
-
-
- NCH = NCHP(1)
- IF (NCH) 91, 29, 11
- 11 NWS = RSHIFT (NCH,2)
- NTRAIL = AND (NCH,3)
- JT = 0
- IF (NWS.EQ.0) GO TO 26
-
-C-- Unpack the initial complete words
-
- DO 24 JS=1,NWS
- MWD = MS(JS)
- MT(JT+1) = OR (IBLAN1,AND(MASK1,MWD))
- MT(JT+2) = OR (IBLAN1,AND(MASK1,LSHIFT(MWD, 8)))
- MT(JT+3) = OR (IBLAN1,AND(MASK1,LSHIFT(MWD,16)))
- MT(JT+4) = OR (IBLAN1, LSHIFT(MWD,24) )
- 24 JT = JT + 4
-
- IF (NTRAIL.EQ.0) RETURN
-
-C-- Unpack the trailing word
-
- 26 MWD = MS(NWS+1)
-
- DO 28 JS=1,NTRAIL
- MT(JT+1) = OR (IBLAN1,AND(MASK1,MWD))
- MWD = LSHIFT (MWD,8)
- 28 JT = JT + 1
- 29 RETURN
-
- 91 CALL ABEND
- END
diff --git a/src/packlib/kernlib/kerngen/tcgens/sungs/ubunch.F b/src/packlib/kernlib/kerngen/tcgens/sungs/ubunch.F
deleted file mode 100644
index df57ed0..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/sungs/ubunch.F
+++ /dev/null
@@ -1,65 +0,0 @@
-*
-* $Id: ubunch.F,v 1.1.1.1 1996/02/15 17:50:22 mclareni Exp $
-*
-* $Log: ubunch.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:22 mclareni
-* Kernlib
-*
-*
- SUBROUTINE UBUNCH (MS,MT,NCHP)
-C
-C CERN PROGLIB# M409 UBUNCH .VERSION KERNSUN 1.06 920511
-C ORIG. 22/09/88, JZ
-C
-
- DIMENSION MS(99), MT(99), NCHP(9)
-C- - PARAMETER (IBLAN1 = X'20202020')
- PARAMETER (IBLAN1 = 538976288 )
-C- - PARAMETER (MASK1 = X'FF000000')
- PARAMETER (MASK1 = -16777216 )
-
-
- NCH = NCHP(1)
- IF (NCH) 91,39,11
- 11 NWT = RSHIFT (NCH,2)
- NTRAIL = AND (NCH,3)
- JS = 0
- IF (NWT.EQ.0) GO TO 31
-
-C-- Pack the initial complete words
-
- DO 24 JT=1,NWT
- MT(JT) = OR (OR (OR (
- + AND(MS(JS+1),MASK1),
-#if defined(CERNLIB_BUGLRSHFT)
- + ishft (AND(MS(JS+2),MASK1), -8)),
- + ishft (AND(MS(JS+3),MASK1),-16)),
- + ishft (MS(JS+4), -24) )
-#endif
-#if !defined(CERNLIB_BUGLRSHFT)
- + lrshft (AND(MS(JS+2),MASK1), 8)),
- + lrshft (AND(MS(JS+3),MASK1),16)),
- + lrshft (MS(JS+4), 24) )
-#endif
- 24 JS = JS + 4
-
- IF (NTRAIL.EQ.0) RETURN
-
-C-- Pack the trailing word
-
- 31 MWD = IBLAN1
- JS = NCH
-
- DO 34 JT=1,NTRAIL
-#if defined(CERNLIB_BUGLRSHFT)
- MWD = OR (ishft(MWD,-8), AND(MS(JS),MASK1))
-#endif
-#if !defined(CERNLIB_BUGLRSHFT)
- MWD = OR (lrshft(MWD,8), AND(MS(JS),MASK1))
-#endif
- 34 JS = JS - 1
- MT(NWT+1) = MWD
- 39 RETURN
-
- 91 CALL ABEND
- END
diff --git a/src/packlib/kernlib/kerngen/tcgens/sungs/upkbyt.F b/src/packlib/kernlib/kerngen/tcgens/sungs/upkbyt.F
deleted file mode 100644
index f18ea9b..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/sungs/upkbyt.F
+++ /dev/null
@@ -1,71 +0,0 @@
-*
-* $Id: upkbyt.F,v 1.1.1.1 1996/02/15 17:50:22 mclareni Exp $
-*
-* $Log: upkbyt.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:22 mclareni
-* Kernlib
-*
-*
- SUBROUTINE UPKBYT (MBV,JTHP,MIV,NINTP,NBITS)
-C
-C CERN PROGLIB# M422 UPKBYT .VERSION KERNSUN 1.06 920511
-C ORIG. 22/09/88, JZ
-C
- DIMENSION MIV(99), MBV(99), JTHP(9), NINTP(9), NBITS(2)
-
- JTH = JTHP(1)
- NINT = NINTP(1)
- IF (NINT.LE.0) RETURN
-
- NZB = NBITS(1)
- IF (NZB.GT.0) GO TO 11
- NZB = 1
- NPWD = 32
- MASK = 1
- GO TO 12
-
- 11 NPWD = NBITS(2)
-#if defined(CERNLIB_BUGLRSHFT)
- MASK = ishft (-1,NZB-32)
-#endif
-#if !defined(CERNLIB_BUGLRSHFT)
- MASK = lrshft (-1,32-NZB)
-#endif
-
- 12 JBV = 1
- JIV = 0
- IF (JTH.LT.2) GO TO 21
- JBV = (JTH-1)/NPWD + 1
- JPOS = JTH - (JBV-1)*NPWD - 1
- IF (JPOS.EQ.0) GO TO 21
- NR = JPOS*NZB
- JIVE = NPWD - JPOS
-#if defined(CERNLIB_BUGLRSHFT)
- IZW = ishft (MBV(JBV), -NR)
-#endif
-#if !defined(CERNLIB_BUGLRSHFT)
- IZW = lrshft (MBV(JBV), NR)
-#endif
- GO TO 22
-
-C-- UNPACK EACH WORD
-
- 21 JIVE = JIV + NPWD
- IZW = MBV(JBV)
- 22 JIVE = MIN0 (NINT,JIVE)
-
- 24 JIV = JIV + 1
- MIV(JIV) = AND (MASK,IZW)
- IF (JIV.EQ.JIVE) GO TO 27
-#if defined(CERNLIB_BUGLRSHFT)
- IZW = ishft (IZW,-NZB)
-#endif
-#if !defined(CERNLIB_BUGLRSHFT)
- IZW = lrshft (IZW, NZB)
-#endif
- GO TO 24
-
- 27 IF (JIV.EQ.NINT) RETURN
- JBV = JBV + 1
- GO TO 21
- END
diff --git a/src/packlib/kernlib/kerngen/tcgens/ublank.F b/src/packlib/kernlib/kerngen/tcgens/ublank.F
deleted file mode 100644
index e6d25ce..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/ublank.F
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: ublank.F,v 1.1.1.1 1996/02/15 17:50:14 mclareni Exp $
-*
-* $Log: ublank.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:14 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE UBLANK (IV,JL,JR)
-C
-C CERN PROGLIB# V300 UBLANK .VERSION KERNFOR 4.08 840613
-C ORIG. 01/01/65 JZ
-C
- DIMENSION IV(80)
- DATA IBL /4H /
-C
-C
- DO 29 J=JL,JR
- 29 IV(J)= IBL
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgens/ublow.F b/src/packlib/kernlib/kerngen/tcgens/ublow.F
deleted file mode 100644
index 3db85b5..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/ublow.F
+++ /dev/null
@@ -1,96 +0,0 @@
-*
-* $Id: ublow.F,v 1.4 1998/09/25 09:32:02 mclareni Exp $
-*
-* $Log: ublow.F,v $
-* Revision 1.4 1998/09/25 09:32:02 mclareni
-* Modifications for the Mklinux port flagged by CERNLIB_PPC
-*
-* Revision 1.3 1997/09/02 14:27:00 mclareni
-* WINNT correction
-*
-* Revision 1.2 1997/02/04 17:36:25 mclareni
-* Merge Winnt and 97a versions
-*
-* Revision 1.1.1.1.2.1 1997/01/21 11:31:40 mclareni
-* All mods for Winnt 96a on winnt branch
-*
-* Revision 1.1.1.1 1996/02/15 17:50:15 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QFMSOFT)
-#include "wntgs/ublow.F"
-#elif defined(CERNLIB_QMDOS) || defined(CERNLIB_WINNT)
-#include "dosgs/ublow.F"
-#elif defined(CERNLIB_QMMPW)
-#include "mpwgs/ublow.F"
-#elif defined(CERNLIB_QMVAOS)||defined(CERNLIB_QMVMI)
-#include "allgs/ublow.F"
-#elif (defined(CERNLIB_QMLNX) && !defined(CERNLIB_PPC))
-#include "lnxgs/ublow.F"
-#elif (defined(CERNLIB_QMLNX) && defined(CERNLIB_PPC))
-#include "lnxppcgs/ublow.F"
-#elif defined(CERNLIB_QMSUN)
-#include "sungs/ublow.F"
-#elif defined(CERNLIB_QMVAX)
-#include "vaxgs/ublow.F"
-#elif defined(CERNLIB_B32)||defined(CERNLIB_B64)
- SUBROUTINE UBLOW (MS,MT,NCHP)
-C
-C CERN PROGLIB# M409 UBLOW .VERSION KERNFOR 4.30 910819
-C ORIG. 05/12/89, FCA+JZ
-C
-
- DIMENSION MS(99), MT(99), NCHP(9)
-#include "kerngen/iallbl.inc"
-#include "kerngen/ublowx1.inc"
-
- NCH = NCHP(1)
- IF (NCH) 91, 29, 11
-#if defined(CERNLIB_B64)
- 11 NWS = ISHFT (NCH,-3)
- NTRAIL = IAND (NCH,7)
-#endif
-#if defined(CERNLIB_B32)
- 11 NWS = ISHFT (NCH,-2)
- NTRAIL = IAND (NCH,3)
-#endif
- JT = 0
- IF (NWS.EQ.0) GO TO 26
-
-C-- Unpack the initial complete words
-
- DO 24 JS=1,NWS
- MWD = MS(JS)
- MT(JT+1) = IOR (IBLAN1,IAND(MASK1,MWD))
- MT(JT+2) = IOR (IBLAN1,IAND(MASK1,ISHFT(MWD, 8)))
- MT(JT+3) = IOR (IBLAN1,IAND(MASK1,ISHFT(MWD,16)))
-#if defined(CERNLIB_B64)
- MT(JT+4) = IOR (IBLAN1,IAND(MASK1,ISHFT(MWD,24)))
- MT(JT+5) = IOR (IBLAN1,IAND(MASK1,ISHFT(MWD,32)))
- MT(JT+6) = IOR (IBLAN1,IAND(MASK1,ISHFT(MWD,40)))
- MT(JT+7) = IOR (IBLAN1,IAND(MASK1,ISHFT(MWD,48)))
- MT(JT+8) = IOR (IBLAN1, ISHFT(MWD,56) )
- 24 JT = JT + 8
-#endif
-#if defined(CERNLIB_B32)
- MT(JT+4) = IOR (IBLAN1, ISHFT(MWD,24) )
- 24 JT = JT + 4
-#endif
-
- IF (NTRAIL.EQ.0) RETURN
-
-C-- Unpack the trailing word
-
- 26 MWD = MS(NWS+1)
-
- DO 28 JS=1,NTRAIL
- MT(JT+1) = IOR (IBLAN1,IAND(MASK1,MWD))
- MWD = ISHFT (MWD,8)
- 28 JT = JT + 1
- 29 RETURN
-
- 91 CALL ABEND
- END
-#endif
diff --git a/src/packlib/kernlib/kerngen/tcgens/ubunch.F b/src/packlib/kernlib/kerngen/tcgens/ubunch.F
deleted file mode 100644
index b795282..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/ubunch.F
+++ /dev/null
@@ -1,100 +0,0 @@
-*
-* $Id: ubunch.F,v 1.4 1998/09/25 09:32:06 mclareni Exp $
-*
-* $Log: ubunch.F,v $
-* Revision 1.4 1998/09/25 09:32:06 mclareni
-* Modifications for the Mklinux port flagged by CERNLIB_PPC
-*
-* Revision 1.3 1997/09/02 14:27:00 mclareni
-* WINNT correction
-*
-* Revision 1.2 1997/02/04 17:36:25 mclareni
-* Merge Winnt and 97a versions
-*
-* Revision 1.1.1.1.2.1 1997/01/21 11:31:41 mclareni
-* All mods for Winnt 96a on winnt branch
-*
-* Revision 1.1.1.1 1996/02/15 17:50:15 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QFMSOFT) && defined(CERNLIB_WINNT)
-#include "wntgs/ubunch.F"
-#elif defined(CERNLIB_QMDOS) || defined(CERNLIB_WINNT)
-#include "dosgs/ubunch.F"
-#elif defined(CERNLIB_QMVAOS)||defined(CERNLIB_QMVMI)
-#include "allgs/ubunch.F"
-#elif (defined(CERNLIB_QMLNX) && !defined(CERNLIB_PPC))
-#include "lnxgs/ubunch.F"
-#elif (defined(CERNLIB_QMLNX) && defined(CERNLIB_PPC))
-#include "lnxppcgs/ubunch.F"
-#elif defined(CERNLIB_QMSUN)
-#include "sungs/ubunch.F"
-#elif defined(CERNLIB_QMVAX)
-#include "vaxgs/ubunch.F"
-#elif defined(CERNLIB_B32)||defined(CERNLIB_B64)
- SUBROUTINE UBUNCH (MS,MT,NCHP)
-C
-C CERN PROGLIB# M409 UBUNCH .VERSION KERNFOR 4.30 910819
-C ORIG. 05/12/89, FCA+JZ
-C
-
- DIMENSION MS(99), MT(99), NCHP(9)
-#include "kerngen/iallbl.inc"
-#include "kerngen/ubnchx1.inc"
-
- NCH = NCHP(1)
- IF (NCH) 91,39,11
-#if defined(CERNLIB_B64)
- 11 NWT = ISHFT (NCH,-3)
- NTRAIL = IAND (NCH,7)
-#endif
-#if defined(CERNLIB_B32)
- 11 NWT = ISHFT (NCH,-2)
- NTRAIL = IAND (NCH,3)
-#endif
- JS = 0
- IF (NWT.EQ.0) GO TO 31
-
-C-- Pack the initial complete words
-
-#if defined(CERNLIB_B64)
- DO 24 JT=1,NWT
- MT(JT) = IOR (IOR (IOR (IOR (IOR (IOR (IOR (
- + IAND(MS(JS+1),MASK1),
- + ISHFT (IAND(MS(JS+2),MASK1), -8)),
- + ISHFT (IAND(MS(JS+3),MASK1),-16)),
- + ISHFT (IAND(MS(JS+4),MASK1),-24)),
- + ISHFT (IAND(MS(JS+5),MASK1),-32)),
- + ISHFT (IAND(MS(JS+6),MASK1),-40)),
- + ISHFT (IAND(MS(JS+7),MASK1),-48)),
- + ISHFT (MS(JS+8), -56) )
- 24 JS = JS + 8
-#endif
-#if defined(CERNLIB_B32)
- DO 24 JT=1,NWT
- MT(JT) = IOR (IOR (IOR (
- + IAND(MS(JS+1),MASK1),
- + ISHFT (IAND(MS(JS+2),MASK1), -8)),
- + ISHFT (IAND(MS(JS+3),MASK1),-16)),
- + ISHFT (MS(JS+4), -24) )
- 24 JS = JS + 4
-#endif
-
- IF (NTRAIL.EQ.0) RETURN
-
-C-- Pack the trailing word
-
- 31 MWD = IALLBL
- JS = NCH
-
- DO 34 JT=1,NTRAIL
- MWD = IOR (ISHFT(MWD,-8), IAND(MS(JS),MASK1))
- 34 JS = JS - 1
- MT(NWT+1) = MWD
- 39 RETURN
-
- 91 CALL ABEND
- END
-#endif
diff --git a/src/packlib/kernlib/kerngen/tcgens/ucopiv.F b/src/packlib/kernlib/kerngen/tcgens/ucopiv.F
deleted file mode 100644
index 8a56a1b..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/ucopiv.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: ucopiv.F,v 1.1.1.1 1996/02/15 17:50:15 mclareni Exp $
-*
-* $Log: ucopiv.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:15 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE UCOPIV (A,B,N)
-C
-C CERN PROGLIB# V301 UCOPIV .VERSION KERNFOR 4.40 940929
-C ORIG. 01/07/71
-C
-#if defined(CERNLIB_QINTCOPY)
- INTEGER A(*), B(*)
-#endif
-#if !defined(CERNLIB_QINTCOPY)
- DIMENSION A(*), B(*)
-#endif
-C
- IF (N.EQ.0) RETURN
- I = N
- DO 12 J=1,N
- B(I)= A(J)
- 12 I = I - 1
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgens/ucopy.F b/src/packlib/kernlib/kerngen/tcgens/ucopy.F
deleted file mode 100644
index 799b223..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/ucopy.F
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: ucopy.F,v 1.1.1.1 1996/02/15 17:50:19 mclareni Exp $
-*
-* $Log: ucopy.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:19 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE UCOPY (A,B,N)
-C
-C CERN PROGLIB# V301 UCOPY .VERSION KERNFOR 4.40 940929
-C ORIG. 01/01/65 JZ
-C
-#if defined(CERNLIB_QINTCOPY)
- INTEGER A(*),B(*)
-#endif
-#if !defined(CERNLIB_QINTCOPY)
- DIMENSION A(*),B(*)
-#endif
-C
-C-- NO OVERLAP OR BEGINNING OF A ON END OF B
- IF (N.EQ.0) RETURN
- DO 21 I=1,N
- 21 B(I)=A(I)
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgens/ucopy2.F b/src/packlib/kernlib/kerngen/tcgens/ucopy2.F
deleted file mode 100644
index 14312fc..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/ucopy2.F
+++ /dev/null
@@ -1,44 +0,0 @@
-*
-* $Id: ucopy2.F,v 1.1.1.1 1996/02/15 17:50:15 mclareni Exp $
-*
-* $Log: ucopy2.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:15 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE UCOPY2 (A,B,N)
-C
-C CERN PROGLIB# V301 UCOPY2 .VERSION KERNFOR 4.40 940929
-C ORIG. 01/01/68
-C MODIF. 26/02/91 JZ correct for bug in SGI
-C
-#if defined(CERNLIB_QINTCOPY)
- INTEGER A(*),B(*)
-#endif
-#if !defined(CERNLIB_QINTCOPY)
- DIMENSION A(*),B(*)
-#endif
-C
-C
- IF (N.LT.2) GO TO 41
- IA = LOCF (A)
- IB = LOCF (B)
- IF (IA-IB) 20,99,10
-C
-C-- End of B may overlap beginning of A
- 10 DO 15 I=1,N
- 15 B(I) = A(I)
- RETURN
-C
-C-- End of A may overlap with beginning of B
- 20 DO 25 I=N,1,-1
- 25 B(I) = A(I)
- RETURN
-
-C-- Case N=1, gives trouble on SGI
-
- 41 IF (N.LE.0) RETURN
- B(1) = A(1)
- 99 RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgens/ucopy2c.c b/src/packlib/kernlib/kerngen/tcgens/ucopy2c.c
deleted file mode 100644
index 0da0649..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/ucopy2c.c
+++ /dev/null
@@ -1,32 +0,0 @@
-/*
- * $Id: ucopy2c.c,v 1.1 1996/12/06 08:49:18 gunter Exp $
- *
- * $Log: ucopy2c.c,v $
- * Revision 1.1 1996/12/06 08:49:18 gunter
- * Correct problem with ucopy2 on OSF (f77 - version 4) by replcing ucopy2
- * with a c routine ucopy2c.c calling memmove. This is also used on some
- * other unix - where it was faster.
- *
- * Kernlib
- *
- * C version of ucopy2 using memmove; memmove is POSIX
- */
-#include "kerngen/pilot.h"
-
-#include <string.h>
-
-#if defined(CERNLIB_QXNO_SC)
-#define ucopy2_ ucopy
-#endif
-
-void ucopy2_(int *from, int *to, int *nwords)
-{
- if ( *nwords > 1 ) {
- memmove( (void *)to, (void *)from,(size_t) 4*(*nwords));
- } else {
- if ( *nwords == 1 ) {
- *to = *from;
- }
- /* else nothing to do */
- }
-}
diff --git a/src/packlib/kernlib/kerngen/tcgens/ucopyn.F b/src/packlib/kernlib/kerngen/tcgens/ucopyn.F
deleted file mode 100644
index 9e701d8..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/ucopyn.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: ucopyn.F,v 1.1.1.1 1996/02/15 17:50:15 mclareni Exp $
-*
-* $Log: ucopyn.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:15 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE UCOPYN (IA,IX,N)
-C
-C CERN PROGLIB# V301 UCOPYN .VERSION KERNFOR 2.04 730725
-C ORIG. 01/01/68
-C
- DIMENSION IA(*),IX(*)
-C
- IF (N.EQ.0) RETURN
- DO 10 J=1,N
- 10 IX(J)= -IA(J)
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgens/uctoh.F b/src/packlib/kernlib/kerngen/tcgens/uctoh.F
deleted file mode 100644
index ce94ad7..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/uctoh.F
+++ /dev/null
@@ -1,104 +0,0 @@
-*
-* $Id: uctoh.F,v 1.2 1996/04/02 23:17:45 thakulin Exp $
-*
-* $Log: uctoh.F,v $
-* Revision 1.2 1996/04/02 23:17:45 thakulin
-* Add support for EPC Fortran: remove char-int equivalences and use
-* F90 transfer facility instead.
-*
-* Revision 1.1.1.1 1996/02/15 17:50:15 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE UCTOH (MS,MT,NPW,NCH)
-C
-C CERN PROGLIB# M409 UCTOH .VERSION KERNFOR 4.21 890323
-C ORIG. 10/02/89 JZ
-C
- CHARACTER MS*99
- DIMENSION MT(99)
-
-#include "kerngen/wordsize.inc"
- CHARACTER CHWORD*(NCHAPW)
- CHARACTER BLANK *(NCHAPW)
- PARAMETER (BLANK = ' ')
- INTEGER IWORD
-#if !defined(CERNLIB_F90) && !defined(CERNLIB_QFEPC)
- EQUIVALENCE (IWORD,CHWORD)
-#endif
-
- IF (NCH) 91, 29, 11
- 11 IF (NPW.LE.0) GO TO 91
- IF (NPW.EQ.1) GO TO 21
- IF (NPW.LT.NCHAPW) GO TO 31
-
-C-------- NPW = maximum
-
- JS = 0
- NWT = NCH / NCHAPW
- NTRAIL = NCH - NWT*NCHAPW
-
- DO 14 JT=1,NWT
- CHWORD = MS(JS+1:JS+NCHAPW)
-#if defined(CERNLIB_F90) || defined(CERNLIB_QFEPC)
- MT(JT) = transfer(CHWORD,IWORD)
-#else
- MT(JT) = IWORD
-#endif
- 14 JS = JS + NCHAPW
-
- IF (NTRAIL.EQ.0) RETURN
-
- CHWORD = MS(JS+1:JS+NTRAIL)
-#if defined(CERNLIB_F90) || defined(CERNLIB_QFEPC)
- MT(NWT+1) = transfer(CHWORD,IWORD)
-#else
- MT(NWT+1) = IWORD
-#endif
- RETURN
-
-C-------- NPW = 1
-C-- equivalent to 'CALL UCTOH1(MS,MT,NCH)'
-
- 21 CHWORD = BLANK
-
- DO 24 JS=1,NCH
- CHWORD(1:1) = MS(JS:JS)
-#if defined(CERNLIB_F90) || defined(CERNLIB_QFEPC)
- MT(JS) = transfer(CHWORD,IWORD)
-#else
- MT(JS) = IWORD
-#endif
- 24 CONTINUE
- 29 RETURN
-
-C-------- NPW = 2 ...
-
- 31 CHWORD = BLANK
-
- JS = 0
- NWT = NCH / NPW
- NTRAIL = NCH - NWT*NPW
-
- DO 34 JT=1,NWT
- CHWORD(1:NPW) = MS(JS+1:JS+NPW)
-#if defined(CERNLIB_F90) || defined(CERNLIB_QFEPC)
- MT(JT) = transfer(CHWORD,IWORD)
-#else
- MT(JT) = IWORD
-#endif
- 34 JS = JS + NPW
-
- IF (NTRAIL.EQ.0) RETURN
-
- CHWORD = MS(JS+1:JS+NTRAIL)
-#if defined(CERNLIB_F90) || defined(CERNLIB_QFEPC)
- MT(NWT+1) = transfer(CHWORD,IWORD)
-#else
- MT(NWT+1) = IWORD
-#endif
- RETURN
-
- 91 CALL ABEND
- END
diff --git a/src/packlib/kernlib/kerngen/tcgens/uctoh1.F b/src/packlib/kernlib/kerngen/tcgens/uctoh1.F
deleted file mode 100644
index 78f34c5..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/uctoh1.F
+++ /dev/null
@@ -1,46 +0,0 @@
-*
-* $Id: uctoh1.F,v 1.2 1996/04/02 23:17:46 thakulin Exp $
-*
-* $Log: uctoh1.F,v $
-* Revision 1.2 1996/04/02 23:17:46 thakulin
-* Add support for EPC Fortran: remove char-int equivalences and use
-* F90 transfer facility instead.
-*
-* Revision 1.1.1.1 1996/02/15 17:50:15 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE UCTOH1 (MS,MT,NCH)
-C
-C CERN PROGLIB# M409 UCTOH1 .VERSION KERNFOR 4.21 890323
-C ORIG. 10/02/89 JZ
-C
- CHARACTER MS*99
- DIMENSION MT(99)
-
-#include "kerngen/wordsize.inc"
- CHARACTER CHWORD*(NCHAPW)
- CHARACTER BLANK *(NCHAPW)
- PARAMETER (BLANK = ' ')
- INTEGER IWORD
-#if !defined(CERNLIB_F90) && !defined(CERNLIB_QFEPC)
- EQUIVALENCE (IWORD,CHWORD)
-#endif
-
- IF (NCH) 91, 29, 11
-
- 11 CHWORD = BLANK
-
- DO 24 JS=1,NCH
- CHWORD(1:1) = MS(JS:JS)
-#if defined(CERNLIB_F90) || defined(CERNLIB_QFEPC)
- MT(JS) = transfer(CHWORD,IWORD)
-#else
- MT(JS) = IWORD
-#endif
- 24 CONTINUE
- 29 RETURN
-
- 91 CALL ABEND
- END
diff --git a/src/packlib/kernlib/kerngen/tcgens/ufill.F b/src/packlib/kernlib/kerngen/tcgens/ufill.F
deleted file mode 100644
index f2b469d..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/ufill.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: ufill.F,v 1.1.1.1 1996/02/15 17:50:15 mclareni Exp $
-*
-* $Log: ufill.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:15 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE UFILL (IV,JL,JR,ISTUFF)
-C
-C CERN PROGLIB# V300 UFILL .VERSION KERNFOR 1.0 710701
-C ORIG. 01/07/71 JZ
-C
- DIMENSION IV(*)
-C
- ITEXT=ISTUFF
- DO 29 J=JL,JR
- 29 IV(J)=ITEXT
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgens/uh1toc.F b/src/packlib/kernlib/kerngen/tcgens/uh1toc.F
deleted file mode 100644
index ff1773a..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/uh1toc.F
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: uh1toc.F,v 1.2 1996/04/02 23:17:48 thakulin Exp $
-*
-* $Log: uh1toc.F,v $
-* Revision 1.2 1996/04/02 23:17:48 thakulin
-* Add support for EPC Fortran: remove char-int equivalences and use
-* F90 transfer facility instead.
-*
-* Revision 1.1.1.1 1996/02/15 17:50:15 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE UH1TOC (MS,MT,NCH)
-C
-C CERN PROGLIB# M409 UH1TOC .VERSION KERNFOR 4.21 890323
-C ORIG. 10/02/89 JZ
-C
- DIMENSION MS(99)
- CHARACTER MT*99
-
-#include "kerngen/wordsize.inc"
- CHARACTER CHWORD*(NCHAPW)
- INTEGER IWORD
-#if !defined(CERNLIB_F90) && !defined(CERNLIB_QFEPC)
- EQUIVALENCE (IWORD,CHWORD)
-#endif
-
- IF (NCH) 91, 29, 11
-
- 11 DO 24 JS=1,NCH
- IWORD = MS(JS)
-#if defined(CERNLIB_F90) || defined(CERNLIB_QFEPC)
- CHWORD = transfer(IWORD,CHWORD)
-#endif
- MT(JS:JS) = CHWORD(1:1)
- 24 CONTINUE
- 29 RETURN
-
- 91 CALL ABEND
- END
diff --git a/src/packlib/kernlib/kerngen/tcgens/uhtoc.F b/src/packlib/kernlib/kerngen/tcgens/uhtoc.F
deleted file mode 100644
index 77f6c8e..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/uhtoc.F
+++ /dev/null
@@ -1,94 +0,0 @@
-*
-* $Id: uhtoc.F,v 1.2 1996/04/02 23:17:49 thakulin Exp $
-*
-* $Log: uhtoc.F,v $
-* Revision 1.2 1996/04/02 23:17:49 thakulin
-* Add support for EPC Fortran: remove char-int equivalences and use
-* F90 transfer facility instead.
-*
-* Revision 1.1.1.1 1996/02/15 17:50:15 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE UHTOC (MS,NPW,MT,NCH)
-C
-C CERN PROGLIB# M409 UHTOC .VERSION KERNFOR 4.21 890323
-C ORIG. 10/02/89 JZ
-C
- DIMENSION MS(99)
- CHARACTER MT*99
-
-#include "kerngen/wordsize.inc"
- CHARACTER CHWORD*(NCHAPW)
- INTEGER IWORD
-#if !defined(CERNLIB_F90) && !defined(CERNLIB_QFEPC)
- EQUIVALENCE (IWORD,CHWORD)
-#endif
-
- IF (NCH) 91, 29, 11
- 11 IF (NPW.LE.0) GO TO 91
- IF (NPW.EQ.1) GO TO 21
- IF (NPW.LT.NCHAPW) GO TO 31
-
-C-------- NPW = maximum
-
- JT = 0
- NWS = NCH / NCHAPW
- NTRAIL = NCH - NWS*NCHAPW
-
- DO 14 JS=1,NWS
- IWORD = MS(JS)
-#if defined(CERNLIB_F90) || defined(CERNLIB_QFEPC)
- MT(JT+1:JT+NCHAPW) = transfer(IWORD,CHWORD)
-#else
- MT(JT+1:JT+NCHAPW) = CHWORD
-#endif
- 14 JT = JT + NCHAPW
-
- IF (NTRAIL.EQ.0) RETURN
-
- IWORD = MS(NWS+1)
-#if defined(CERNLIB_F90) || defined(CERNLIB_QFEPC)
- CHWORD = transfer(IWORD,CHWORD)
-#endif
- MT(JT+1:JT+NTRAIL) = CHWORD(1:NTRAIL)
- RETURN
-
-C-------- NPW = 1
-C-- equivalent to 'CALL UH1TOC(MS,MT,NCH)'
-
- 21 DO 24 JS=1,NCH
- IWORD = MS(JS)
-#if defined(CERNLIB_F90) || defined(CERNLIB_QFEPC)
- CHWORD = transfer(IWORD,CHWORD)
-#endif
- MT(JS:JS) = CHWORD(1:1)
- 24 CONTINUE
- 29 RETURN
-
-C-------- NPW = 2 ...
-
- 31 JT = 0
- NWS = NCH / NPW
- NTRAIL = NCH - NWS*NPW
-
- DO 34 JS=1,NWS
- IWORD = MS(JS)
-#if defined(CERNLIB_F90) || defined(CERNLIB_QFEPC)
- CHWORD = transfer(IWORD,CHWORD)
-#endif
- MT(JT+1:JT+NPW) = CHWORD(1:NPW)
- 34 JT = JT + NPW
-
- IF (NTRAIL.EQ.0) RETURN
-
- IWORD = MS(NWS+1)
-#if defined(CERNLIB_F90) || defined(CERNLIB_QFEPC)
- CHWORD = transfer(IWORD,CHWORD)
-#endif
- MT(JT+1:JT+NTRAIL) = CHWORD(1:NTRAIL)
- RETURN
-
- 91 CALL ABEND
- END
diff --git a/src/packlib/kernlib/kerngen/tcgens/upkbyt.F b/src/packlib/kernlib/kerngen/tcgens/upkbyt.F
deleted file mode 100644
index b51503c..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/upkbyt.F
+++ /dev/null
@@ -1,89 +0,0 @@
-*
-* $Id: upkbyt.F,v 1.2 2006/09/15 09:35:23 mclareni Exp $
-*
-* $Log: upkbyt.F,v $
-* Revision 1.2 2006/09/15 09:35:23 mclareni
-* Submitted mods for gcc4/gfortran and MacOSX, corrected to work also on slc4 with gcc3.4 and 4.1
-*
-* Revision 1.1.1.1 1996/02/15 17:50:15 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QMSUN)
-#include "sungs/upkbyt.F"
-#elif !defined(CERNLIB_NOSHIFT)
- SUBROUTINE UPKBYT (MBV,JTHP,MIV,NINTP,NBITS)
-C
-C CERN PROGLIB# M422 UPKBYT .VERSION KERNFOR 4.23 891215
-C ORIG. 13/03/89 JZ
-C
-C This non-ANSI code is a default which may be slow, if so
-C it should be replaced by a machine-specific fast routine
-C
- DIMENSION MIV(99), MBV(99), JTHP(9), NINTP(9), NBITS(2)
-
-#include "kerngen/wordsize.inc"
-#include "kerngen/iall1s.inc"
-#if !defined(CERNLIB_QISASTD) && !defined(CERNLIB_GFORTRAN)
-#include "kerngen/q_andor.inc"
-#include "kerngen/q_shift.inc"
-#endif
-
- JTH = JTHP(1)
- NINT = NINTP(1)
- IF (NINT.LE.0) RETURN
-
- NZB = NBITS(1)
- IF (NZB.GT.0) GO TO 11
- NZB = 1
- NPWD = NBITPW
- MSKA = 1
- GO TO 12
-
- 11 NPWD = NBITS(2)
-#if !defined(CERNLIB_QISASTD) && !defined(CERNLIB_GFORTRAN)
- MSKA = ISHFTR (IALL11, NBITPW-NZB)
-#endif
-#if defined(CERNLIB_QISASTD) || defined(CERNLIB_GFORTRAN)
- MSKA = ISHFT (IALL11,-NBITPW+NZB)
-#endif
-
- 12 JBV = 1
- JIV = 0
- IF (JTH.LT.2) GO TO 21
- JBV = (JTH-1)/NPWD + 1
- JPOS = JTH - (JBV-1)*NPWD - 1
- IF (JPOS.EQ.0) GO TO 21
- NR = JPOS*NZB
- JIVE = NPWD - JPOS
-#if !defined(CERNLIB_QISASTD) && !defined(CERNLIB_GFORTRAN)
- IZW = ISHFTR (MBV(JBV), NR)
-#endif
-#if defined(CERNLIB_QISASTD) || defined(CERNLIB_GFORTRAN)
- IZW = ISHFT (MBV(JBV),-NR)
-#endif
- GO TO 22
-
-C-- UNPACK EACH WORD
-
- 21 JIVE = JIV + NPWD
- IZW = MBV(JBV)
- 22 JIVE = MIN (NINT,JIVE)
-
- 24 JIV = JIV + 1
- MIV(JIV) = IAND (MSKA,IZW)
- IF (JIV.EQ.JIVE) GO TO 27
-#if !defined(CERNLIB_QISASTD) && !defined(CERNLIB_GFORTRAN)
- IZW = ISHFTR (IZW, NZB)
-#endif
-#if defined(CERNLIB_QISASTD) || defined(CERNLIB_GFORTRAN)
- IZW = ISHFT (IZW,-NZB)
-#endif
- GO TO 24
-
- 27 IF (JIV.EQ.NINT) RETURN
- JBV = JBV + 1
- GO TO 21
- END
-#endif
diff --git a/src/packlib/kernlib/kerngen/tcgens/upkch.F b/src/packlib/kernlib/kerngen/tcgens/upkch.F
deleted file mode 100644
index 54d1412..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/upkch.F
+++ /dev/null
@@ -1,87 +0,0 @@
-*
-* $Id: upkch.F,v 1.1.1.1 1996/02/15 17:50:16 mclareni Exp $
-*
-* $Log: upkch.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:16 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE UPKCH (ICHV,IGV,NN,IPAR)
-C
-C CERN PROGLIB# M427 UPKCH .VERSION KERNFOR 4.20 881028
-C ORIG. 07/07/72 JZ
-C
- COMMON /SLATE/ JCH,N,NBITS,NCHAR,NZONE,IGNOR,JIN,NBDONE,NBEND
- +, JGO,JBT,NLEFT,NRIGH,DUMMY(27)
- DIMENSION ICHV(*),IGV(*),IPAR(9)
-C .
-C
-#include "kerngen/wordsize.inc"
-C
-#include "kerngen/q_jbit.inc"
-* Ignoring t=pass
-C
-C
- N = NN
- IF (N.EQ.0) RETURN
- NBITS = IPAR(1)
- NCHAR = IPAR(2)
- NZONE = IPAR(3)
- IGNOR = IPAR(4)
- JIN = 1
- JCH = 1
- IF (NZONE.NE.0) GO TO 41
-C
-C---- ZONE = WORD
-C
- 21 JGO = NBITPW+1 - IGNOR
- NBEND= NBITS + 1
- IF (NCHAR.EQ.0) GO TO 22
- NBEND= MAX (NBEND, JGO-NBITS*(NCHAR-1))
-C
- 22 JBT = JGO
-C
- 24 JBT = JBT - NBITS
- IGV(JIN)= JBYT (ICHV(JCH),JBT,NBITS)
- IF (JIN.EQ.N) RETURN
- JIN = JIN + 1
- IF (JBT.GE.NBEND) GO TO 24
- JCH = JCH + 1
- GO TO 22
-C
-C---- ZONE NOT EQUALS A WORD
-C
- 41 IF (NZONE.EQ.NBITPW) GO TO 21
- JBT = NBITPW - IGNOR
- NBEND = NZONE+1 - NBITS
- IF (NCHAR.EQ.0) GO TO 42
- NBEND = MIN (NBEND, IGNOR+NCHAR*NBITS)
-C
- 42 NBDONE= IGNOR
- 43 IF (JBT.GE.0) GO TO 44
- JBT= JBT + NBITPW
- JCH= JCH + 1
- GO TO 43
-C
- 44 JBT = JBT - NBITS
- IF (JBT.LT.0) GO TO 51
- IGV(JIN)= JBYT (ICHV(JCH),JBT+1,NBITS)
- GO TO 58
-C
-C-- CHARACTER ACROSS WORD BOUNDARY
- 51 NLEFT= NBITS + JBT
- NRIGH= -JBT
- JBT = JBT + NBITPW
- IGV(JIN)= JBYT (ICHV(JCH+1),JBT+1,NRIGH)
- IF (NLEFT.EQ.0) GO TO 54
- CALL CBYT (ICHV(JCH),1,IGV(JIN),NRIGH+1,NLEFT)
- 54 JCH= JCH + 1
-C
- 58 IF (JIN.EQ.N) RETURN
- JIN= JIN + 1
- NBDONE= NBDONE + NBITS
- IF (NBDONE.LT.NBEND) GO TO 44
- JBT = JBT - (NZONE-NBDONE) - IGNOR
- GO TO 42
- END
diff --git a/src/packlib/kernlib/kerngen/tcgens/uswop.F b/src/packlib/kernlib/kerngen/tcgens/uswop.F
deleted file mode 100644
index 0ff5640..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/uswop.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: uswop.F,v 1.1.1.1 1996/02/15 17:50:16 mclareni Exp $
-*
-* $Log: uswop.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:16 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE USWOP (A,B,N)
-C
-C CERN PROGLIB# V303 USWOP .VERSION KERNFOR 4.40 940929
-C ORIG. 01/07/71 RKB
-C
-#if defined(CERNLIB_QINTCOPY)
- INTEGER A(*),B(*), X
-#endif
-#if !defined(CERNLIB_QINTCOPY)
- DIMENSION A(*),B(*)
-#endif
-C
- IF (N.EQ.0) RETURN
- DO 10 I=1,N
- X=A(I)
- A(I)=B(I)
- 10 B(I)=X
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgens/uzero.F b/src/packlib/kernlib/kerngen/tcgens/uzero.F
deleted file mode 100644
index ff1f7d1..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/uzero.F
+++ /dev/null
@@ -1,30 +0,0 @@
-*
-* $Id: uzero.F,v 1.1.1.1 1996/02/15 17:50:16 mclareni Exp $
-*
-* $Log: uzero.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:16 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE UZERO (A,JL,JR)
-C
-C CERN PROGLIB# V300 UZERO .VERSION KERNFOR 4.40 940929
-C ORIG. 01/01/65 JZ
-C
-#if defined(CERNLIB_QINTZERO)
- INTEGER A(*)
-#endif
-#if !defined(CERNLIB_QINTZERO)
- DIMENSION A(*)
-#endif
-C
- DO 29 J=JL,JR
-#if defined(CERNLIB_QINTZERO)
- 29 A(J)=0
-#endif
-#if !defined(CERNLIB_QINTZERO)
- 29 A(J)=0.
-#endif
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgens/vadd.F b/src/packlib/kernlib/kerngen/tcgens/vadd.F
deleted file mode 100644
index 9bebc35..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/vadd.F
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: vadd.F,v 1.1.1.1 1996/02/15 17:50:16 mclareni Exp $
-*
-* $Log: vadd.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:16 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE VADD (B,C,A,N)
-C
-C CERN PROGLIB# F121 VADD .VERSION KERNFOR 1.0 710701
-C ORIG. 01/07/71
-C
- DIMENSION A(*),B(*),C(*)
-C
- IF (N.LE.0) RETURN
- DO 9 I= 1,N
- 9 A(I)= B(I) + C(I)
-C
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgens/vasum.F b/src/packlib/kernlib/kerngen/tcgens/vasum.F
deleted file mode 100644
index 214f62a..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/vasum.F
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: vasum.F,v 1.1.1.1 1996/02/15 17:50:16 mclareni Exp $
-*
-* $Log: vasum.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:16 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- FUNCTION VASUM (A,N)
-C
-C CERN PROGLIB# F121 VASUM .VERSION KERNFOR 1.0 710701
-C ORIG. 01/07/71
-C
- DIMENSION A(*)
-C
- XX= 0.
- IF (N.LE.0) GO TO 100
- DO 9 I= 1,N
- 9 XX= XX + ABS (A(I))
-C
- 100 VASUM= XX
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgens/vaxgs/ie3fos.F b/src/packlib/kernlib/kerngen/tcgens/vaxgs/ie3fos.F
deleted file mode 100644
index 93df2d8..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/vaxgs/ie3fos.F
+++ /dev/null
@@ -1,69 +0,0 @@
-*
-* $Id: ie3fos.F,v 1.1.1.1 1996/02/15 17:50:23 mclareni Exp $
-*
-* $Log: ie3fos.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:23 mclareni
-* Kernlib
-*
-*
- SUBROUTINE IE3FOS (MS,MT,NWDO,JBAD)
-C
-C CERN PROGLIB# M220 IE3FOS .VERSION KERNVAX 2.20 861204
-
-C- Convert single precision for output with copy
-C- from source in native to target in IEEE data format
-
- DIMENSION MS(99), MT(99)
-
- DOUBLE PRECISION THDB
- DIMENSION THIS(2)
- EQUIVALENCE (THDB,THIS)
- EQUIVALENCE (ITHA,THA,THIS(1)), (ITHB,THB,THIS(2))
-
- PARAMETER (MSKB16 = '00008000'X)
- PARAMETER (IBADCS = '7F80FE00'X)
- PARAMETER (IBADCD = '7FF01FC0'X)
- PARAMETER (IOVPCS = '7F800000'X)
- PARAMETER (IOVPCD = '7FF00000'X)
- PARAMETER (IOVNCS = 'FF800000'X)
- PARAMETER (IOVNCD = 'FFF00000'X)
-
-
- JBAD = 0
- JMS = 0
- JMT = 0
-
- 301 DO 349 JL=1,NWDO
- ITHA = MS(JMS+1)
- IF (ITHA.EQ.0) GO TO 347
- JSIGN = ITHA .AND. MSKB16
- JEXP = JIBITS (ITHA,7,8)
- IF (JEXP.LE.2) GO TO 331
- IF (JEXP.EQ.255) GO TO 333
- JMANT = JISHFT(JIBITS(ITHA,0,7), 16) .OR. JIBITS(ITHA,16,16)
- ITHA = JISHFT(JSIGN,16) .OR. JISHFT(JEXP-2,23) .OR. JMANT
- GO TO 347
-
-C-- zero / NaN
- 331 IF (JSIGN.EQ.0) GO TO 341
- IF (JEXP.NE.0) GO TO 341
- ITHB = IBADCS
- GO TO 336
-
-C-- overflow
- 333 IF (JSIGN.EQ.0) THEN
- ITHB = IOVPCS
- ELSE
- ITHB = IOVNCS
- ENDIF
- 336 JBAD = JL
- ITHA = ITHB
- GO TO 347
-
- 341 ITHA = 0
- 347 MT(JMT+1) = ITHA
- JMT = JMT + 1
- 349 JMS = JMS + 1
-
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgens/vaxgs/ie3tos.F b/src/packlib/kernlib/kerngen/tcgens/vaxgs/ie3tos.F
deleted file mode 100644
index b6dd9c1..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/vaxgs/ie3tos.F
+++ /dev/null
@@ -1,83 +0,0 @@
-*
-* $Id: ie3tos.F,v 1.1.1.1 1996/02/15 17:50:23 mclareni Exp $
-*
-* $Log: ie3tos.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:23 mclareni
-* Kernlib
-*
-*
- SUBROUTINE IE3TOS (MS,MT,NWDO,JBAD)
-C
-C CERN PROGLIB# M220 IE3TOS .VERSION KERNVAX 2.25 880302
-
-C- Convert single precision for input with copy
-C- from source in IEEE to target in native data format
-
- DIMENSION MS(99), MT(99)
-
- DOUBLE PRECISION THDB
- DIMENSION THIS(2)
- EQUIVALENCE (THDB,THIS)
- EQUIVALENCE (ITHA,THA,THIS(1)), (ITHB,THB,THIS(2))
-
- PARAMETER (JEXMIN = -127, JEXMAX=125)
- PARAMETER (IOVPMS = '00007F81'X)
- PARAMETER (IOVNMS = '0000FF81'X)
- PARAMETER (IBADMS = '00008001'X)
- PARAMETER (IBADMD = IBADMS, IBADME = 0)
- PARAMETER (IOVPMD = IOVPMS, IOVNMD = IOVNMS)
-
-#include "kerngen/q_jbit.inc"
-
- JBAD = 0
- JMS = 0
- JMT = 0
-
- 301 DO 349 JL=1,NWDO
- ITHA = MS(JMS+1)
- IF (ITHA.EQ.0) GO TO 347
- JSIGN = JBIT (ITHA,32)
- JEXP = JBYT (ITHA,24,8)
- JMANT = JBYT (ITHA,1,23)
- IF (JEXP.EQ.0) GO TO 331
- IF (JEXP.EQ.255) GO TO 333
- JEXP = JEXP - 127
- IF (JEXP.LT.JEXMIN) GO TO 341
- IF (JEXP.GT.JEXMAX) GO TO 332
- JPRE = ISIGN (23,JEXP)
- JMANT = JMANT + 8 388 608
- THA = FLOAT(JMANT) * 2.**(JPRE-23)
- THA = THA * 2.**(JEXP-JPRE)
- IF (JSIGN.EQ.0) GO TO 347
- THA = -THA
- GO TO 347
-
- 331 IF (JMANT.EQ.0) GO TO 341
- THA = FLOAT(JMANT) * 2.**(-63)
- THA = THA * 2.**(-86)
- IF (ITHA .EQ.0) GO TO 347
- IF (JSIGN.EQ.0) GO TO 347
- THA = -THA
- GO TO 347
-
- 332 JMANT = 0
- 333 IF (JMANT.EQ.0) THEN
- IF (JSIGN.EQ.0) THEN
- ITHB = IOVPMS
- ELSE
- ITHB = IOVNMS
- ENDIF
- ELSE
- ITHB = IBADMS
- ENDIF
- JBAD = JL
- ITHA = ITHB
- GO TO 347
-
- 341 ITHA = 0
- 347 MT(JMT+1) = ITHA
- JMT = JMT + 1
- 349 JMS = JMS + 1
-
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgens/vaxgs/iucomh.F b/src/packlib/kernlib/kerngen/tcgens/vaxgs/iucomh.F
deleted file mode 100644
index 255058a..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/vaxgs/iucomh.F
+++ /dev/null
@@ -1,47 +0,0 @@
-*
-* $Id: iucomh.F,v 1.1.1.1 1996/02/15 17:50:23 mclareni Exp $
-*
-* $Log: iucomh.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:23 mclareni
-* Kernlib
-*
-*
- FUNCTION IUCOMH (ISTR1, ISTR2, NCH)
-C
-C CERN PROGLIB# IUCOMH .VERSION KERNVAX 2.39 930112
-C ORIG. FCA+JZ, 20/02/90
-C
-C Compare the two Hollerith strings of NCH bytes length and return
-C -1 if STRING1 < STRING2
-C 0 =
-C +1 >
-C which is determined by the first non-identical character.
-C
- DIMENSION ISTR1(9), ISTR2(9)
- PARAMETER (NCHAPW=4,NBITPC=8)
-C
- NDO = NCH
- IF (NDO.LE.0) GO TO 30
- NWD = (NDO-1)/NCHAPW + 1
-
- DO 29 JW=1,NWD
- IWD1 = ISTR1(JW)
- IWD2 = ISTR2(JW)
- NL = MIN(NDO,4)
-
- DO 28 J=1,NL
- ICHAR1 = IAND (IWD1,255)
- ICHAR2 = IAND (IWD2,255)
- IF (ICHAR1-ICHAR2) 32, 26, 31
- 26 IWD1 = ISHFT (IWD1,-8)
- 28 IWD2 = ISHFT (IWD2,-8)
- 29 NDO = NDO - 4
-
- 30 IUCOMH = 0
- RETURN
-
- 31 IUCOMH = 1
- RETURN
- 32 IUCOMH = -1
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgens/vaxgs/rndm.F b/src/packlib/kernlib/kerngen/tcgens/vaxgs/rndm.F
deleted file mode 100644
index e31d358..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/vaxgs/rndm.F
+++ /dev/null
@@ -1,58 +0,0 @@
-*
-* $Id: rndm.F,v 1.1.1.1 1996/02/15 17:50:23 mclareni Exp $
-*
-* $Log: rndm.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:23 mclareni
-* Kernlib
-*
-*
- FUNCTION RNDM (ISEED)
-C
-C CERN PROGLIB# V104 RNDM .VERSION KERNVAX 2.39 930112
-C ORIG. 22-MAR-88 from IBM version of G.Marsaglia et al., Montreal
-C
-C !!! Version valid only for VAX floating point format !!!
-C Careful: compile with /CHECK=NOOVERFLOW
-C
-C- Uniform Random Number Generator,
-C- giving the same sequence as the IBM and VAX m-language version
-
- EQUIVALENCE (AMAN,MANT)
- PARAMETER (MSK1 = 3072)
-C PARAMETER (MSK1 = '00000C00'X)
- PARAMETER (MSK2 = 13312)
-C PARAMETER (MSK2 = '00003400'X)
- SAVE MCGN
- DATA MCGN /12345/
-
-
- MCGN = MCGN * 69069
- MANT = ISHFT (MCGN,-8)
- IF (MANT.EQ.0) GO TO 14
- AMAN = MANT
-C- AMAN in the range 1 to 2**24-1
- MANT = MANT - MSK1
-C- multiply by 2.**(-24)
- RNDM = AMAN
- RETURN
-
-C-- for zero set RNDM = 2.**(-25)
- 14 MANT = MSK2
- RNDM = AMAN
- RETURN
-
-C-- Integer random number
- ENTRY IRNDM (ISEED)
- MCGN = MCGN * 69069
- IRNDM = ISHFT (MCGN,-1)
- RETURN
-
-C-- Set the seed
- ENTRY RDMIN (ISEED)
- MCGN = ISEED
- RETURN
-
-C-- Get the seed
- ENTRY RDMOUT (ISEED)
- ISEED = MCGN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgens/vaxgs/ublow.F b/src/packlib/kernlib/kerngen/tcgens/vaxgs/ublow.F
deleted file mode 100644
index 6f77c12..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/vaxgs/ublow.F
+++ /dev/null
@@ -1,49 +0,0 @@
-*
-* $Id: ublow.F,v 1.1.1.1 1996/02/15 17:50:24 mclareni Exp $
-*
-* $Log: ublow.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:24 mclareni
-* Kernlib
-*
-*
- SUBROUTINE UBLOW (MS,MT,NCHP)
-C
-C CERN PROGLIB# M409 UBLOW .VERSION KERNVAX 2.39 930112
-C ORIG. 03/02/89 K.M.STORR
-C
-
- DIMENSION MS(99), MT(99), NCHP(9)
- data iblan1/x'20202000'/
- data mask1/x'000000ff'/
-
- NCH = NCHP(1)
- IF (NCH) 91, 29, 11
- 11 NWS = ishft (NCH,-2)
- NTRAIL = IAND (NCH,3)
- JT = 0
- IF (NWS.EQ.0) GO TO 26
-
-C-- Unpack the initial complete words
-
- DO 24 JS=1,NWS
- MWD = MS(JS)
- MT(JT+1) = IOR (IBLAN1,IAND(MASK1,MWD))
- MT(JT+2) = IOR (IBLAN1,IAND(MASK1,ISHFT(MWD, -8)))
- MT(JT+3) = IOR (IBLAN1,IAND(MASK1,ISHFT(MWD,-16)))
- MT(JT+4) = IOR (IBLAN1, ISHFT(MWD,-24) )
- 24 JT = JT + 4
-
- IF (NTRAIL.EQ.0) RETURN
-
-C-- Unpack the trailing word
-
- 26 MWD = MS(NWS+1)
-
- DO 28 JS=1,NTRAIL
- MT(JT+1) = IOR (IBLAN1,IAND(MASK1,MWD))
- MWD = ISHFT (MWD,-8)
- 28 JT = JT + 1
- 29 RETURN
-
- 91 CALL ABEND
- END
diff --git a/src/packlib/kernlib/kerngen/tcgens/vaxgs/ubunch.F b/src/packlib/kernlib/kerngen/tcgens/vaxgs/ubunch.F
deleted file mode 100644
index 3bc0cda..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/vaxgs/ubunch.F
+++ /dev/null
@@ -1,50 +0,0 @@
-*
-* $Id: ubunch.F,v 1.1.1.1 1996/02/15 17:50:24 mclareni Exp $
-*
-* $Log: ubunch.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:24 mclareni
-* Kernlib
-*
-*
- SUBROUTINE UBUNCH (MS,MT,NCHP)
-C
-C CERN PROGLIB# M409 UBUNCH .VERSION KERNVAX 2.39 930112
-C ORIG. 03/02/89 K.M.STORR
-C
-
- DIMENSION MS(99), MT(99), NCHP(9)
- data iblan1/x'20202020'/
- data mask1/x'000000ff'/
-
- NCH = NCHP(1)
- IF (NCH) 91,39,11
- 11 NWT = ishft (NCH,-2)
- NTRAIL = IAND (NCH,3)
- JS = 0
- IF (NWT.EQ.0) GO TO 31
-
-C-- Pack the initial complete words
-
- DO 24 JT=1,NWT
- MT(JT) = IOR (IOR (IOR (
- + IAND(MS(JS+1),MASK1),
- + ishft (IAND(MS(JS+2),MASK1), 8)),
- + ishft (IAND(MS(JS+3),MASK1),16)),
- + ishft (MS(JS+4), 24) )
- 24 JS = JS + 4
-
- IF (NTRAIL.EQ.0) RETURN
-
-C-- Pack the trailing word
-
- 31 MWD = IBLAN1
- JS = NCH
-
- DO 34 JT=1,NTRAIL
- MWD = IOR (ishft(MWD,8), IAND(MS(JS),MASK1))
- 34 JS = JS - 1
- MT(NWT+1) = MWD
- 39 RETURN
-
- 91 CALL ABEND
- END
diff --git a/src/packlib/kernlib/kerngen/tcgens/vbias.F b/src/packlib/kernlib/kerngen/tcgens/vbias.F
deleted file mode 100644
index c0a7d78..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/vbias.F
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: vbias.F,v 1.1.1.1 1996/02/15 17:50:16 mclareni Exp $
-*
-* $Log: vbias.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:16 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE VBIAS (B,ALPHA,A,N)
-C
-C CERN PROGLIB# F121 VBIAS .VERSION KERNFOR 1.0 710701
-C ORIG. 01/07/71
-C
- DIMENSION A(*),B(*)
-C
- IF (N.LE.0) RETURN
- DO 9 I= 1,N
- 9 A(I)= B(I) + ALPHA
-C
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgens/vblank.F b/src/packlib/kernlib/kerngen/tcgens/vblank.F
deleted file mode 100644
index 9b6ae2b..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/vblank.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: vblank.F,v 1.2 2006/09/15 09:35:23 mclareni Exp $
-*
-* $Log: vblank.F,v $
-* Revision 1.2 2006/09/15 09:35:23 mclareni
-* Submitted mods for gcc4/gfortran and MacOSX, corrected to work also on slc4 with gcc3.4 and 4.1
-*
-* Revision 1.1.1.1 1996/02/15 17:50:16 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE VBLANK (A,N)
-C
-C CERN PROGLIB# F121 VBLANK .VERSION KERNFOR 4.08 840613
-C ORIG. 01/07/71
-C
- INTEGER A(*), BLANK
- DATA BLANK / 4H /
-#if defined(CERNLIB_GFORTRAN)
- save
-#endif
-C
- IF (N.LE.0) RETURN
- DO 9 I= 1,N
- 9 A(I)= BLANK
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgens/vcopyn.F b/src/packlib/kernlib/kerngen/tcgens/vcopyn.F
deleted file mode 100644
index 299ba4e..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/vcopyn.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: vcopyn.F,v 1.1.1.1 1996/02/15 17:50:16 mclareni Exp $
-*
-* $Log: vcopyn.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:16 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE VCOPYN (A,X,N)
-C
-C CERN PROGLIB# F121 VCOPYN .VERSION KERNFOR 3.15 820113
-C ORIG. 01/04/73
-C
- DIMENSION A(*), X(*)
-C
- IF(N.LE.0) RETURN
- DO 10 I=1,N
- 10 X(I)= -A(I)
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgens/vdot.F b/src/packlib/kernlib/kerngen/tcgens/vdot.F
deleted file mode 100644
index 56c6a01..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/vdot.F
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: vdot.F,v 1.1.1.1 1996/02/15 17:50:16 mclareni Exp $
-*
-* $Log: vdot.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:16 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- FUNCTION VDOT (X,Y,N)
-C
-C CERN PROGLIB# F121 VDOT .VERSION KERNFOR 1.0 710701
-C ORIG. 01/07/71
-C
- DIMENSION X(*),Y(*)
-C
- XX= 0.
- IF (N.LE.0) GO TO 100
- DO 9 I= 1,N
- 9 XX= XX + X(I)*Y(I)
-C
- 100 VDOT= XX
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgens/vdotn.F b/src/packlib/kernlib/kerngen/tcgens/vdotn.F
deleted file mode 100644
index 1fa6e7e..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/vdotn.F
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: vdotn.F,v 1.1.1.1 1996/02/15 17:50:16 mclareni Exp $
-*
-* $Log: vdotn.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:16 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- FUNCTION VDOTN (X,Y,N)
-C
-C CERN PROGLIB# F121 VDOTN .VERSION KERNFOR 2.09 751101
-C ORIG. 01/07/71
-C
- DIMENSION X(*), Y(*)
-C
- IF (N.LE.0) GO TO 100
- XX= 0.
- XY= 0.
- YY= 0.
-C
- DO 9 J=1,N
- XX = XX + X(J)*X(J)
- XY = XY + X(J)*Y(J)
- 9 YY = YY + Y(J)*Y(J)
-C
- VDOTN= XY / SQRT(XX*YY)
- IF (ABS (VDOTN).LT.1.) RETURN
- VDOTN= SIGN (1.,VDOTN)
- RETURN
- 100 VDOTN = 0.
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgens/vdotn2.F b/src/packlib/kernlib/kerngen/tcgens/vdotn2.F
deleted file mode 100644
index fe677a0..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/vdotn2.F
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: vdotn2.F,v 1.1.1.1 1996/02/15 17:50:17 mclareni Exp $
-*
-* $Log: vdotn2.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:17 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- FUNCTION VDOTN2 (X,Y,N)
-C
-C CERN PROGLIB# F121 VDOTN2 .VERSION KERNFOR 1.0 720620
-C ORIG. 20/06/72
-C
- DIMENSION X(*),Y(*)
-C
- IF (N.LE.0) GO TO 100
- XX = 0.
- XY = 0.
- YY = 0.
-C
- DO 9 J=1,N
- XX = XX + X(J)*X(J)
- XY = XY + X(J)*Y(J)
- 9 YY = YY + Y(J)*Y(J)
-C
- VDOTN2= XY**2/(XX*YY)
- RETURN
- 100 VDOTN2= 0.
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgens/vexcum.F b/src/packlib/kernlib/kerngen/tcgens/vexcum.F
deleted file mode 100644
index 7b7f084..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/vexcum.F
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: vexcum.F,v 1.1.1.1 1996/02/15 17:50:17 mclareni Exp $
-*
-* $Log: vexcum.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:17 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE VEXCUM (A,EX,N)
-C
-C CERN PROGLIB# F121 VEXCUM .VERSION KERNFOR 1.0 710701
-C ORIG. 01/07/71
-C
- DIMENSION A(*), EX(3)
-C
- IF (N.LE.0) RETURN
-C
- DO 19 J=1,N
- EX(1)= MIN(EX(1),A(J))
- EX(2)= MAX(EX(2),A(J))
- 19 EX(3)= EX(3) + A(J)
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgens/vfill.F b/src/packlib/kernlib/kerngen/tcgens/vfill.F
deleted file mode 100644
index 44ab28b..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/vfill.F
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: vfill.F,v 1.1.1.1 1996/02/15 17:50:17 mclareni Exp $
-*
-* $Log: vfill.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:17 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE VFILL (A,N,STUFF)
-C
-C CERN PROGLIB# F121 VFILL .VERSION KERNFOR 4.40 940929
-C ORIG. 01/07/71
-C
-#if defined(CERNLIB_QINTCOPY)
- INTEGER A(*), STUFF
-#endif
-#if !defined(CERNLIB_QINTCOPY)
- DIMENSION A(*)
-#endif
-C
- IF (N.LE.0) RETURN
- DO 9 I= 1,N
- 9 A(I)= STUFF
-C
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgens/vfix.F b/src/packlib/kernlib/kerngen/tcgens/vfix.F
deleted file mode 100644
index 0de4356..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/vfix.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: vfix.F,v 1.1.1.1 1996/02/15 17:50:17 mclareni Exp $
-*
-* $Log: vfix.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:17 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE VFIX (A,IA,N)
-C
-C CERN PROGLIB# F121 VFIX .VERSION KERNFOR 3.15 820113
-C ORIG. 03/05/72
-C
- DIMENSION A(*), IA(*)
-C
- IF (N.LE.0) RETURN
- DO 9 J=1,N
- 9 IA(J)= A(J)
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgens/vfloat.F b/src/packlib/kernlib/kerngen/tcgens/vfloat.F
deleted file mode 100644
index 1dfbaff..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/vfloat.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: vfloat.F,v 1.1.1.1 1996/02/15 17:50:17 mclareni Exp $
-*
-* $Log: vfloat.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:17 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE VFLOAT (IA,A,N)
-C
-C CERN PROGLIB# F121 VFLOAT .VERSION KERNFOR 3.15 820113
-C ORIG. 03/05/72
-C
- DIMENSION A(*), IA(*)
-C
- IF (N.LE.0) RETURN
- DO 9 J=1,N
- 9 A(J)= IA(J)
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgens/vline.F b/src/packlib/kernlib/kerngen/tcgens/vline.F
deleted file mode 100644
index 0c4ef2d..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/vline.F
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: vline.F,v 1.1.1.1 1996/02/15 17:50:17 mclareni Exp $
-*
-* $Log: vline.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:17 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE VLINE (B,ALPHA,C,BETA,A,N)
-C
-C CERN PROGLIB# F121 VLINE .VERSION KERNFOR 1.0 710701
-C ORIG. 01/07/71
-C
- DIMENSION A(*),B(*),C(*)
-C
- IF (N.LE.0) RETURN
- DO 9 I= 1,N
- 9 A(I)= B(I)*ALPHA + C(I)*BETA
-C
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgens/vmatl.F b/src/packlib/kernlib/kerngen/tcgens/vmatl.F
deleted file mode 100644
index 0ddd366..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/vmatl.F
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: vmatl.F,v 1.1.1.1 1996/02/15 17:50:17 mclareni Exp $
-*
-* $Log: vmatl.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:17 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE VMATL (H,A,X,K,N)
-C
-C CERN PROGLIB# F121 VMATL .VERSION KERNFOR 1.0 710701
-C ORIG. 01/07/71
-C
- DIMENSION A(*),X(*),H(N,K)
-C
- IF (N.LE.0) RETURN
- DO 9 I= 1,K
- X(I)= 0.
- DO 9 J= 1,N
- X(I)= X(I) + A(J)*H(J,I)
- 9 CONTINUE
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgens/vmatr.F b/src/packlib/kernlib/kerngen/tcgens/vmatr.F
deleted file mode 100644
index 38ddf7c..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/vmatr.F
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: vmatr.F,v 1.1.1.1 1996/02/15 17:50:17 mclareni Exp $
-*
-* $Log: vmatr.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:17 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE VMATR (A,G,X,N,K)
-C
-C CERN PROGLIB# F121 VMATR .VERSION KERNFOR 1.0 710701
-C ORIG. 01/07/71
-C
- DIMENSION A(*),X(*),G(K,N)
-C
- IF (N.LE.0) RETURN
- DO 9 I= 1,K
- X(I)= 0.
- DO 9 J= 1,N
- 9 X(I)= X(I) + G(I,J)*A(J)
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgens/vmax.F b/src/packlib/kernlib/kerngen/tcgens/vmax.F
deleted file mode 100644
index 09ae79d..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/vmax.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: vmax.F,v 1.1.1.1 1996/02/15 17:50:17 mclareni Exp $
-*
-* $Log: vmax.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:17 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- FUNCTION VMAX (A,N)
-C
-C CERN PROGLIB# F121 VMAX .VERSION KERNFOR 1.0 710701
-C ORIG. 01/07/71
-C
- DIMENSION A(*)
-C
- IF (N.LE.0) GO TO 100
- FMAX = A(1)
- DO 9 I= 1,N
- FMAX = MAX (A(I),FMAX)
- 9 CONTINUE
- VMAX = FMAX
- RETURN
- 100 VMAX = 0.
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgens/vmaxa.F b/src/packlib/kernlib/kerngen/tcgens/vmaxa.F
deleted file mode 100644
index 07fc162..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/vmaxa.F
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: vmaxa.F,v 1.1.1.1 1996/02/15 17:50:18 mclareni Exp $
-*
-* $Log: vmaxa.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:18 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- FUNCTION VMAXA (A,N)
-C
-C CERN PROGLIB# F121 VMAXA .VERSION KERNFOR 1.0 710701
-C ORIG. 01/07/71
-C
- DIMENSION A(*)
-C
- FMAX= 0.
- IF (N.LE.0) GO TO 100
- DO 9 I= 1,N
- FMAX = MAX (ABS (A(I)), FMAX)
- 9 CONTINUE
-C
- 100 VMAXA= FMAX
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgens/vmin.F b/src/packlib/kernlib/kerngen/tcgens/vmin.F
deleted file mode 100644
index 818963f..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/vmin.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: vmin.F,v 1.1.1.1 1996/02/15 17:50:18 mclareni Exp $
-*
-* $Log: vmin.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:18 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- FUNCTION VMIN (A,N)
-C
-C CERN PROGLIB# F121 VMIN .VERSION KERNFOR 1.0 710701
-C ORIG. 01/07/71
-C
- DIMENSION A(*)
-C
- IF (N.LE.0) GO TO 100
- FMIN= A(1)
- DO 9 I= 1,N
- FMIN = MIN (A(I),FMIN)
- 9 CONTINUE
- VMIN= FMIN
- RETURN
- 100 VMIN = 0.
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgens/vmina.F b/src/packlib/kernlib/kerngen/tcgens/vmina.F
deleted file mode 100644
index 553138d..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/vmina.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: vmina.F,v 1.1.1.1 1996/02/15 17:50:18 mclareni Exp $
-*
-* $Log: vmina.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:18 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- FUNCTION VMINA (A,N)
-C
-C CERN PROGLIB# F121 VMINA .VERSION KERNFOR 1.0 710701
-C ORIG. 01/07/71
-C
- DIMENSION A(*)
-C
- IF (N.LE.0) GO TO 100
- FMIN= ABS (A(1))
- DO 9 I= 1,N
- FMIN = MIN (ABS (A(I)), FMIN)
- 9 CONTINUE
- VMINA= FMIN
- RETURN
- 100 VMINA = 0.
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgens/vmod.F b/src/packlib/kernlib/kerngen/tcgens/vmod.F
deleted file mode 100644
index 877e3c0..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/vmod.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: vmod.F,v 1.1.1.1 1996/02/15 17:50:18 mclareni Exp $
-*
-* $Log: vmod.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:18 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- FUNCTION VMOD (A,N)
-C
-C CERN PROGLIB# F121 VMOD .VERSION KERNFOR 1.0 710701
-C ORIG. 01/07/71
-C
- DIMENSION A(*)
-C
- XX= 0.
- IF (N.LE.0) GO TO 100
- DO 9 I= 1,N
- 9 XX= XX + A(I)*A(I)
- IF (XX.LE.0.) GO TO 100
- VMOD= SQRT (XX)
- RETURN
- 100 VMOD = 0.
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgens/vmul.F b/src/packlib/kernlib/kerngen/tcgens/vmul.F
deleted file mode 100644
index 4c839d3..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/vmul.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: vmul.F,v 1.1.1.1 1996/02/15 17:50:18 mclareni Exp $
-*
-* $Log: vmul.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:18 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE VMUL (A,B,X,N)
-C
-C CERN PROGLIB# F121 VMUL .VERSION KERNFOR 1.0 710701
-C ORIG. 01/07/71
-C
- DIMENSION A(*),B(*),X(*)
-C
- IF (N.LE.0) RETURN
- DO 9 I= 1,N
- 9 X(I)= A(I) * B(I)
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgens/vscale.F b/src/packlib/kernlib/kerngen/tcgens/vscale.F
deleted file mode 100644
index e670192..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/vscale.F
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: vscale.F,v 1.1.1.1 1996/02/15 17:50:18 mclareni Exp $
-*
-* $Log: vscale.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:18 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE VSCALE (B,ALPHA,A,N)
-C
-C CERN PROGLIB# F121 VSCALE .VERSION KERNFOR 1.0 710701
-C ORIG. 01/07/71
-C
- DIMENSION A(*),B(*)
-C
- IF (N.LE.0) RETURN
- DO 9 I= 1,N
- 9 A(I)= B(I) * ALPHA
-C
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgens/vsub.F b/src/packlib/kernlib/kerngen/tcgens/vsub.F
deleted file mode 100644
index dfce6f8..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/vsub.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: vsub.F,v 1.1.1.1 1996/02/15 17:50:18 mclareni Exp $
-*
-* $Log: vsub.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:18 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE VSUB (A,B,X,N)
-C
-C CERN PROGLIB# F121 VSUB .VERSION KERNFOR 1.0 710701
-C ORIG. 01/07/71
-C
- DIMENSION A(*),B(*),X(*)
-C
- IF (N.LE.0) RETURN
- DO 9 I= 1,N
- 9 X(I)= A(I) - B(I)
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgens/vsum.F b/src/packlib/kernlib/kerngen/tcgens/vsum.F
deleted file mode 100644
index bf77faf..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/vsum.F
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: vsum.F,v 1.1.1.1 1996/02/15 17:50:18 mclareni Exp $
-*
-* $Log: vsum.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:18 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- FUNCTION VSUM (A,N)
-C
-C CERN PROGLIB# F121 VSUM .VERSION KERNFOR 1.0 710701
-C ORIG. 01/07/71
-C
- DIMENSION A(*)
-C
- XX= 0.
- IF (N.LE.0) GO TO 100
- DO 9 I= 1,N
- 9 XX= XX + A(I)
-C
- 100 VSUM= XX
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgens/vunit.F b/src/packlib/kernlib/kerngen/tcgens/vunit.F
deleted file mode 100644
index 7e75481..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/vunit.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: vunit.F,v 1.1.1.1 1996/02/15 17:50:18 mclareni Exp $
-*
-* $Log: vunit.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:18 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE VUNIT (A,B,N)
-C
-C CERN PROGLIB# F121 VUNIT .VERSION KERNFOR 1.0 710701
-C ORIG. 01/07/71
-C
- DIMENSION A(*),B(*)
-C
- IF (N.LE.0) RETURN
- XX= 0.
- DO 9 I=1,N
- 9 XX= XX + A(I)*A(I)
- IF (XX.LE.0.) RETURN
- YY=1./ SQRT (XX)
- DO 19 I= 1,N
- 19 B(I)=A(I) * YY
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgens/vzero.F b/src/packlib/kernlib/kerngen/tcgens/vzero.F
deleted file mode 100644
index b1a6fab..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/vzero.F
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: vzero.F,v 1.1.1.1 1996/02/15 17:50:18 mclareni Exp $
-*
-* $Log: vzero.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:18 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE VZERO (A,N)
-C
-C CERN PROGLIB# F121 VZERO .VERSION KERNFOR 4.40 940929
-C ORIG. 01/07/71, modif. 24/05/87 to set integer zero
-C modif. 25/05/94 to depend on QINTZERO
-C
-#if defined(CERNLIB_QINTZERO)
- INTEGER A(*)
-#endif
-#if !defined(CERNLIB_QINTZERO)
- DIMENSION A(*)
-#endif
-C
- IF (N.LE.0) RETURN
- DO 9 I= 1,N
-#if defined(CERNLIB_QINTZERO)
- 9 A(I)= 0
-#endif
-#if !defined(CERNLIB_QINTZERO)
- 9 A(I)= 0.
-#endif
-C
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgens/wntgs/iucomh.F b/src/packlib/kernlib/kerngen/tcgens/wntgs/iucomh.F
deleted file mode 100644
index fb3f7a4..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/wntgs/iucomh.F
+++ /dev/null
@@ -1,64 +0,0 @@
-*
-* $Id: iucomh.F,v 1.2 1997/09/02 14:27:05 mclareni Exp $
-*
-* $Log: iucomh.F,v $
-* Revision 1.2 1997/09/02 14:27:05 mclareni
-* WINNT correction
-*
-* Revision 1.1 1997/02/04 17:36:29 mclareni
-* Merge Winnt and 97a versions
-*
-* Revision 1.1.1.1 1996/02/15 17:50:24 mclareni
-* Kernlib
-*
-*
- FUNCTION IUCOMH (ISTR1, ISTR2, NCH)
-C
-C CERN PROGLIB# IUCOMH .VERSION KERNDOS 1.00 920624
-C ORIG. FCA+JZ, 20/02/90
-C
-C Compare the two Hollerith strings of NCH bytes length and return
-C -1 if STRING1 < STRING2
-C 0 =
-C +1 >
-C which is determined by the first non-identical character.
-C
- DIMENSION ISTR1(9), ISTR2(9)
-C
- NDO = NCH
- IF (NDO.LE.0) GO TO 30
- NWD = (NDO-1)/4 + 1
-
- DO 29 JW=1,NWD
- IWD1 = ISTR1(JW)
- IWD2 = ISTR2(JW)
- NL = MIN(NDO,4)
- IF (IWD1. NE. IWD2) THEN
-
- DO 28 J=1,NL
-#ifndef CERNLIB_QF2C
- ICHAR1 = IAND (IWD1,255)
- ICHAR2 = IAND (IWD2,255)
-#else
- ICHAR1 = AND (IWD1,255)
- ICHAR2 = AND (IWD2,255)
-#endif
- IF (ICHAR1-ICHAR2) 32, 26, 31
-#ifndef CERNLIB_QF2C
- 26 IWD1 = ISHFT (IWD1,-8)
- 28 IWD2 = ISHFT (IWD2,-8)
-#else
- 26 IWD1 = rshift (IWD1,8)
- 28 IWD2 = rshift (IWD2,8)
-#endif
- END IF
- 29 NDO = NDO - 4
-
- 30 IUCOMH = 0
- RETURN
-
- 31 IUCOMH = 1
- RETURN
- 32 IUCOMH = -1
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgens/wntgs/rndm.F b/src/packlib/kernlib/kerngen/tcgens/wntgs/rndm.F
deleted file mode 100644
index 900e335..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/wntgs/rndm.F
+++ /dev/null
@@ -1,66 +0,0 @@
-*
-* $Id: rndm.F,v 1.1 1997/02/04 17:36:29 mclareni Exp $
-*
-* $Log: rndm.F,v $
-* Revision 1.1 1997/02/04 17:36:29 mclareni
-* Merge Winnt and 97a versions
-*
-* Revision 1.1.1.1 1996/02/15 17:50:24 mclareni
-* Kernlib
-*
-*
- FUNCTION RNDM (ISEED)
-C
-C CERN PROGLIB# V104 RNDM .VERSION KERNDOS 1.00 920624
-C ORIG. 22-MAR-88 from IBM version of G.Marsaglia et al., Montreal
-C MODIF 24/06/92, adapted N.Karpenko, Dubna
-C
-C !!! Version valid only for 32 bit machines !!!
-C !!! with IEEE floating point representation !!!
-C
-C- Uniform Random Number Generator,
-C- giving the same sequence as the IBM and VAX version
-
- EQUIVALENCE (AMAN,MANT)
- PARAMETER (MSK1 = 201326592)
- PARAMETER (MSK2 = 855638016)
-C PARAMETER (MSK1 = '0C000000'X)
-C PARAMETER (MSK2 = '33000000'X)
- COMMON /MCGN/ MCGN
- DATA MCGN /12345/
-
-
- MCGN = MCGN * 69069
- MANT = ISHFT (MCGN,-8)
- IF (MANT.EQ.0) GO TO 14
- AMAN = MANT
-C- AMAN in the range 1 to 2**24-1
- MANT = MANT - MSK1
-C- multiply by 2.**(-24)
- RNDM = AMAN
- RETURN
-
-C-- for zero set RNDM = 2.**(-25)
- 14 MANT = MSK2
- RNDM = AMAN
- RETURN
- END
- FUNCTION IRNDM(ISEEK)
- COMMON /MCGN/ MCGN
-
-C-- Integer random number
- MCGN = MCGN * 69069
- IRNDM = ISHFT (MCGN,-1)
- RETURN
- END
- SUBROUTINE RDMIN(ISEED)
- COMMON /MCGN/ MCGN
-
-C-- Set the seed
- MCGN = ISEED
- RETURN
-
-C-- Get the seed
- ENTRY RDMOUT (ISEED)
- ISEED = MCGN
- END
diff --git a/src/packlib/kernlib/kerngen/tcgens/wntgs/ublow.F b/src/packlib/kernlib/kerngen/tcgens/wntgs/ublow.F
deleted file mode 100644
index 47b3424..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/wntgs/ublow.F
+++ /dev/null
@@ -1,64 +0,0 @@
-*
-* $Id: ublow.F,v 1.2 1997/09/02 14:27:06 mclareni Exp $
-*
-* $Log: ublow.F,v $
-* Revision 1.2 1997/09/02 14:27:06 mclareni
-* WINNT correction
-*
-* Revision 1.1 1997/02/04 17:36:30 mclareni
-* Merge Winnt and 97a versions
-*
-* Revision 1.1.1.1 1996/02/15 17:50:24 mclareni
-* Kernlib
-*
-*
-#if !defined(CERNLIB_QF2C)
- SUBROUTINE UBLOW (MS,MT,NCHP)
-C
-C CERN PROGLIB# M409 UBLOW .VERSION KERNDOS 1.00 920624
-C ORIG. 03/02/89 K.M.STORR
-C
-
- DIMENSION MS(99), MT(99), NCHP(9)
-#ifndef CERNLIB_QFMSOFT
- PARAMETER (IBLAN1 = X'20202000')
- PARAMETER (MASK1 = X'000000FF')
-#else
- PARAMETER (IBLAN1 = 16#20202000)
- PARAMETER (MASK1 = 16#000000FF)
-#endif
-
-#include "kerngen/q_andor.inc"
-#include "kerngen/q_shift.inc"
- NCH = NCHP(1)
- IF (NCH) 91, 29, 11
- 11 NWS = ishft (NCH,-2)
- NTRAIL = IAND (NCH,3)
- JT = 0
- IF (NWS.EQ.0) GO TO 26
-
-C-- Unpack the initial complete words
-
- DO 24 JS=1,NWS
- MWD = MS(JS)
- MT(JT+1) = IOR (IBLAN1,IAND(MASK1,MWD))
- MT(JT+2) = IOR (IBLAN1,IAND(MASK1,ISHFT(MWD, -8)))
- MT(JT+3) = IOR (IBLAN1,IAND(MASK1,ISHFT(MWD,-16)))
- MT(JT+4) = IOR (IBLAN1, ISHFT(MWD,-24) )
- 24 JT = JT + 4
-
- IF (NTRAIL.EQ.0) RETURN
-
-C-- Unpack the trailing word
-
- 26 MWD = MS(NWS+1)
-
- DO 28 JS=1,NTRAIL
- MT(JT+1) = IOR (IBLAN1,IAND(MASK1,MWD))
- MWD = ISHFT (MWD,-8)
- 28 JT = JT + 1
- 29 RETURN
-
- 91 CALL ABEND
- END
-#endif
diff --git a/src/packlib/kernlib/kerngen/tcgens/wntgs/ubunch.F b/src/packlib/kernlib/kerngen/tcgens/wntgs/ubunch.F
deleted file mode 100644
index 33f8367..0000000
--- a/src/packlib/kernlib/kerngen/tcgens/wntgs/ubunch.F
+++ /dev/null
@@ -1,78 +0,0 @@
-*
-* $Id: ubunch.F,v 1.2 1997/09/02 14:27:07 mclareni Exp $
-*
-* $Log: ubunch.F,v $
-* Revision 1.2 1997/09/02 14:27:07 mclareni
-* WINNT correction
-*
-* Revision 1.1 1997/02/04 17:36:30 mclareni
-* Merge Winnt and 97a versions
-*
-* Revision 1.1.1.1 1996/02/15 17:50:24 mclareni
-* Kernlib
-*
-*
-#if !defined(CERNLIB_QF2C)
- SUBROUTINE UBUNCH (MS,MT,NCHP)
-C
-C CERN PROGLIB# M409 UBUNCH .VERSION KERNDOS 1.00 920624
-C ORIG. 03/02/89 K.M.STORR
-C
-
- DIMENSION MS(99), MT(99), NCHP(9)
-#ifndef CERNLIB_QFMSOFT
- PARAMETER (IBLANK = X'20202020')
- PARAMETER (MASK1 = X'000000FF')
-#else
- PARAMETER (IBLANK = 16#20202020)
- PARAMETER (MASK1 = 16#000000FF)
-#endif
-
-#include "kerngen/q_andor.inc"
-#include "kerngen/q_shift.inc"
-
- NCH = NCHP(1)
- IF (NCH) 91,39,11
- 11 NWT = ishft (NCH,-2)
- NTRAIL = IAND (NCH,3)
- JS = 0
- IF (NWT.EQ.0) GO TO 31
-
-C-- Pack the initial complete words
-
- DO 24 JT=1,NWT
-#ifndef CERNLIB_QF2C
- MT(JT) = IOR (IOR (IOR (
- + IAND(MS(JS+1),MASK1),
- + ishft (IAND(MS(JS+2),MASK1), 8)),
- + ishft (IAND(MS(JS+3),MASK1),16)),
- + ishft (MS(JS+4), 24) )
-#else
- MT(JT) = OR (OR (OR (
- + AND(MS(JS+1),MASK1),
- + LshIft (AND(MS(JS+2),MASK1), 8)),
- + LshIft (AND(MS(JS+3),MASK1),16)),
- + LshIft (MS(JS+4), 24) )
-#endif
- 24 JS = JS + 4
-
- IF (NTRAIL.EQ.0) RETURN
-
-C-- Pack the trailing word
-
- 31 MWD = IBLANK
- JS = NCH
-
- DO 34 JT=1,NTRAIL
-#ifndef CERNLIB_QF_F2C
- MWD = IOR (ishft(MWD,8), IAND(MS(JS),MASK1))
-#else
- MWD = OR (LshIft(MWD,8), AND(MS(JS),MASK1))
-#endif
- 34 JS = JS - 1
- MT(NWT+1) = MWD
- 39 RETURN
-
- 91 CALL ABEND
- END
-#endif
diff --git a/src/packlib/kernlib/kerngen/test/Imakefile b/src/packlib/kernlib/kerngen/test/Imakefile
deleted file mode 100644
index cbd774c..0000000
--- a/src/packlib/kernlib/kerngen/test/Imakefile
+++ /dev/null
@@ -1,35 +0,0 @@
-
-#define IHaveSubdirs
-#define PassCDebugFlags
-
-LIBDIRS= micky npbyt pchar pdiv pm432 pm434 pmatrix ptlpac ptrpac \ @@\
- putil pvect pvpack
-
-SUBDIRS= $(LIBDIRS)
-
-#ifndef CERNLIB_VAX
-
-EXTRA_INCLUDES=-I$(TOP)$(CURRENT_DIR) -I$(VPATH)
-export EXTRA_INCLUDES
-
-#else
-
-/*export EXTRA_INCLUDES would easier, but VMS gmake does not understand this yet
- Also += is not understood by gmake
- Do not remove any of the \, unless you want to create trouble
- GF (12-Jan-96)
- */
-EXTRA_INCLUDES=-i$(TOP)$(CURRENT_DIR)]
-MAKEFLAGS:=EXTRA_INCLUDES\=\-i$(TOP)$(CURRENT_DIR)]
-#endif
-
-
-MakeSubdirs($(SUBDIRS))
-
-SubdirLibraryTarget(kerngent,$(LIBDIRS))
-
-DefinePackageLibrary(kerngent)
-
-NormalFortranProgramTarget(kerngen,test.o,$(PACKAGE_LIB),$(PACKAGE_LIB),NullParameter)
-
-TestTarget(kerngen,NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kerngen/test/history/checkwhat.dat b/src/packlib/kernlib/kerngen/test/history/checkwhat.dat
deleted file mode 100644
index 864bad7..0000000
--- a/src/packlib/kernlib/kerngen/test/history/checkwhat.dat
+++ /dev/null
@@ -1,117 +0,0 @@
-
-C- THE FOLLOWING GIVES A LIST OF WHICH PATCH AND DECK
-C- OF MICKY PAM CHECKS WHICH GENERAL SECTION ROUTINE(S).
-C- VARIOUS GENERAL SECTION ROUTINES ARE NEEDED FOR THE EXECUTION
-C- OF MICKY ITSELF. FOR EXAMPLE THE GENRAL SECTION ROUTINES
-C- UCOPY - UZERO - UFILL - UBLANK
-C- ARE HEAVILY USED. APPARENT MALFUNCTIONING OF A GIVEN ROUTINE
-C- MAY IN FACT BE DUE TO SUCH AN AUXILIARY.
-C-
-C-
-C- LIST OF CHECKED ROUTINES
-C-
-C-
-C- P=PCHAR D=TBABY checks IULAST - IULOOK - IUNEXT - IUEND -
-C- IUBACK - IUFORW - ULEFT - URIGHT -
-C- USET
-C- uses UCOPY UBLANK UBLOW UFILL
-
-C- P=PCHAR D=TPKCH checks PKCHAR - UPKCH
-C- uses VZERO UCOPY
-
-C- P=PCHAR D=TUBLOW checks UBLOW - UBUNCH - UTRANS
-C- uses UCOPY UZERO
-
-C- P=PCHAR D=TUCTOH checks UH1TOC - UCTOH1 - UCTOH - UHTOC
-C- uses UTRANS UZERO
-
-C- P=PM432 D=TLENOC checks LNBLNK - LENOCC
-
-C- P=PM432 D=TICNTH checks ICNTH - ICNTHL - ICNTHU
-
-C- p=PM434 D=TVXINV checks VXINVB - VXINVC
-C- uses VZERO
-
-C- P=PDIV D=TMAXMU checks AMAXMU
-
-C- P=PDIV D=TSCALE checks PSCALE
-
-C- P=PDIV D=TSORTN checks SORTI - SORTR
-C- uses UCOPY
-
-C! P=PDIV D=TSORTX checks SORTX
-C- uses UCOPY
-
-C- P=PDIV D=TTRIGO checks ASIN - ACOS - PROXIM
-C- uses UZERO UCOPY
-
-C! P=PMATRIX D=TMXEQU checks MXEQU - MXEQU1
-C- uses UCOPY
-
-C- P=PMATRIX D=TMXM checks MXMPY - MXMPY1 - MXMPY2 - MXMPY3 - MXMAD -
-C- MXMAD1 - MXMAD2 - MXMAD3 - MXMUB - MXMUB1 -
-C- MXMUB2 - MXMUB3 - MXMLRT - MXMLTR
-C- uses UZERO UCOPY VADD VSUB VCOPYN
-C- MXTRP
-
-C- P=PMATRIX D=TMXTRP checks MXTRP
-C- uses UCOPY
-
-C- P=PMATRIX D=TMXUTY checks MXUTY
-
-C- P=PUTIL D=TCOCOP checks UCOCOP - UDICOP
-C- uses UCOPY
-
-C- P=PUTIL D=TIUCHA checks IUCHAN - IUBIN - IUHIST
-C- uses UCOPY UFILL
-
-C- P=PUTIL D=TIUCOM checks IUCOMP - IUFIND - IUHUNT - LOCBYT
-C- uses UCOPY UZERO
-
-C- P=PUTIL D=TIUSAM checks IUSAME
-C- uses UFILL UCOPY
-
-C- P=PUTIL D=TUCOPY checks UCOPY - UCOPY2 - UCOPYN - UCOPIV
-C- uses UZERO
-
-C- P=PUTIL D=TUOPT checks UOPT
-C- uses UZERO UBUNCH
-
-C- P=PUTIL D=TUSWOP checks USWOP
-C- uses UZERO UCOPY
-
-C- P=PUTIL D=TUZERO checks UZERO - UBLANK - UFILL - VZERO - VBLANK -
-C- VFILL
-C- uses UCOPY
-
-C- P=PVECT D=TCROSS checks CROSS
-
-C- P=PVECT D=TLOR checks LOREN4 - LORENF - LORENB
-C- uses VCOPYN DOTI
-
-C- P=PVECT D=TROT checks ROT
-
-C- P=PVPACK D=TVEC checks VADD - VSUB - VMUL - VBIAS - VSCALE -
-C- VLINE - VUNIT - VSUM - VASUM - VMAX -
-C- VMAXA - VMIN - VMINA - VEXCUM - LVMAX -
-C- LVMAXA - LVMIN - LVMINA - VMOD -
-C- DOTI - VDOT - VDOTN - VDOTN2 - VMATR -
-C- VMATL
-C- uses VZERO VFILL
-
-C- P=NPBYT D=TBYT checks JBIT - SBIT - SBIT0 - SBIT1
-C- JBYT - SBYT - CBYT - JBYTET
- SBYTOR - JRSBYT
-
-C- P=NPBYT D=TMBYT checks MSBIT0 - MSBIT1 - MSBIT - MSBYT
-C- MCBYT - MBYTOR - MBYTET
-C- uses SBIT0 SBIT1 SBIT SBYT
- CBYT SBYTOR JBYTET
-
-C- P=NPBYT D=TVCBYT checks JBYTPK - SBYTPK - PKBYT - UPKBYT - INCBYT
-C- uses UZERO UCOPY
-
-C- P=PTLPAC D=TTLPAC checks TLS - TLSC - TLRES - TLERR
-C- uses UCOPY
-
-C- P=PTRPAC D=... checks ROUTINES TR...
diff --git a/src/packlib/kernlib/kerngen/test/history/checkwhere.dat b/src/packlib/kernlib/kerngen/test/history/checkwhere.dat
deleted file mode 100644
index b7e7c5e..0000000
--- a/src/packlib/kernlib/kerngen/test/history/checkwhere.dat
+++ /dev/null
@@ -1,143 +0,0 @@
-
-C- CHECKWHERE GIVES A ALPHABETIC LIST OF THE GENERAL
-C- SECTION ROUTINES WHICH ARE CHECKED BY MICKY.
-C- THE LIST ALSO GIVES THE PATCH AND DECK OF THE MICKYPAM
-C- WHERE THE ROUTINE IS CHECKED (AND TIMED, IF timing option).
-C-
-C-
-C- LIST OF CHECKED ROUTINES
-C-
-C- ROUTINE PATCH DECK Comment
-C-
-C- ACOS PDIV TTRIGO
-C- AMAXMU PDIV TMAXMU timing option
-C- ASIN PDIV TTRIGO
-C- CBYT NPBYT TBYT timing option
-C- CROSS PVECT TCROSS timing option
-C- DOTI PVPACK TVEC
-C- ICNTH PM432 TICNTH
-C- ICNTHL PM432 TICNTH
-C- ICNTHU PM432 TICNTH
-C- INCBYT NPBYT TVCBYT
-C- IUBACK PCHAR TBABY
-C- IUBIN PUTIL TIUCHA timing option
-C- IUCHAN PUTIL TIUCHA timing option
-C- IUCOMP PUTIL TIUCOM timing option
-C- IUEND PCHAR TBABY
-C- IUFIND PUTIL TIUCOM
-C- IUFORW PCHAR TBABY
-C- IUHIST PUTIL TIUCHA timing option
-C- IUHUNT PUTIL TIUCOM
-C- IULAST PCHAR TBABY
-C- IULOOK PCHAR TBABY
-C- IUNEXT PCHAR TBABY
-C- IUSAME PUTIL TIUSAM timing option
-C- JBIT NPBYT TBYT timing option
-C- JBYT NPBYT TBYT timing option
-C- JBYTET NPBYT TBYT timing option
-C- JBYTPK NPBYT TVCBYT
-C- JRSBYT NPBYT TBYT
-C- LENOCC PM432 TLENOC timing option
-C- LNBLNK PM432 TLENOC timing option
-C- LOCBYT PUTIL TIUCOM
-C- LORENB PVECT TLOR timing option
-C- LORENF PVECT TLOR timing option
-C- LOREN4 PVECT TLOR timing option
-C- LVMAX PVPACK TVEC
-C- LVMAXA PVPACK TVEC
-C- LVMIN PVPACK TVEC
-C- LVMINA PVPACK TVEC
-C- MBYTOR NPBYT TMBYT timing option
-C- MBYTET NPBYT TMBYT timing option
-C- MCBYT NPBYT TMBYT timing option
-C- MSBIT NPBYT TMBYT timing option
-C- MSBIT0 NPBYT TMBYT timing option
-C- MSBIT1 NPBYT TMBYT timing option
-C- MSBYT NPBYT TMBYT timing option
-C! MXEQU PMATRIX TMXEQU timing option
-C! MXEQU1 PMATRIX TMXEQU timing option
-C- MXMAD PMATRIX TMXM timing option
-C- MXMAD1 PMATRIX TMXM timing option
-C- MXMAD2 PMATRIX TMXM timing option
-C- MXMAD3 PMATRIX TMXM timing option
-C- MXMLRT PMATRIX TMXM
-C- MXMLTR PMATRIX TMXM
-C- MXMPY PMATRIX TMXM timing option
-C- MXMPY1 PMATRIX TMXM timing option
-C- MXMPY2 PMATRIX TMXM timing option
-C- MXMPY3 PMATRIX TMXM timing option
-C- MXMUB PMATRIX TMXM timing option
-C- MXMUB1 PMATRIX TMXM timing option
-C- MXMUB2 PMATRIX TMXM timing option
-C- MXMUB3 PMATRIX TMXM timing option
-C- MXTRP PMATRIX TMXTRP timing option
-C- MXUTY PMATRIX TMXUTY timing option
-C- PKBYT NPBYT TVCBYT
-C- PKCHAR PCHAR TPKCH timing option
-C- PROXIM PDIV TTRIGO
-C- PSCALE PDIV TSCALE
-C- ROT PVECT TROT timing option
-C- SBIT NPBYT TBYT timing option
-C- SBIT0 NPBYT TBYT timing option
-C- SBIT1 NPBYT TBYT timing option
-C- SBYT NPBYT TBYT timing option
-C- SBYTOR NPBYT TBYT timing option
-C- SBYTPK NPBYT TVCBYT
-C- SORTI PDIV TSORTN timing option
-C- SORTR PDIV TSORTN timing option
-C! SORTX PDIV TSORTX timing option
-C- TLERR PTLPAC TTLPAC timing option
-C- TLRES PTLPAC TTLPAC timing option
-C- TLS PTLPAC TTLPAC timing option
-C- TLSC PTLPAC TTLPAC timing option
-C- TR... PTRPAC ...
-C- UBLANK PUTIL TUZERO
-C- UBLOW PCHAR TUBLOW timing option
-C- UBUNCH PCHAR TUBLOW timing option
-C- UCOCOP PUTIL TCOCOP timing option
-C- UCOPIV PUTIL TUCOPY
-C- UCOPY PUTIL TUCOPY timing option
-C- UCOPYN PUTIL TUCOPY
-C- UCOPY2 PUTIL TUCOPY
-C- UCTOH PCHAR TUCTOH
-C- UCTOH1 PCHAR TUCTOH
-C- UDICOP PUTIL TCOCOP
-C- UFILL PUTIL TUZERO
-C- ULEFT PCHAR TBABY
-C- UHTOC PCHAR TUCTOH
-C- UH1TOC PCHAR TUCTOH
-C- UOPT PUTIL TUOPT
-C- UPKBYT NPBYT TVCBYT
-C- UPKCH PCHAR TPKCH timing option
-C- URIGHT PCHAR TBABY
-C- USET PCHAR TBABY
-C- USWOP PUTIL TUSWOP timing option
-C- UTRANS PCHAR TUBLOW
-C- UZERO PUTIL TUZERO timing option
-C- VADD PVPACK TVEC
-C- VASUM PVPACK TVEC
-C- VBIAS PVPACK TVEC
-C- VBLANK PUTIL TUZERO
-C- VDOT PVPACK TVEC
-C- VDOTN PVPACK TVEC
-C- VDOTN2 PVPACK TVEC
-C- VEXCUM PVPACK TVEC
-C- VFILL PUTIL TUZERO
-C- VLINE PVPACK TVEC
-C- VMATL PVPACK TVEC
-C- VMATR PVPACK TVEC
-C- VMAX PVPACK TVEC
-C- VMAXA PVPACK TVEC
-C- VMIN PVPACK TVEC
-C- VMINA PVPACK TVEC
-C- VMOD PVPACK TVEC
-C- VMUL PVPACK TVEC
-C- VSCALE PVPACK TVEC
-C- VSUB PVPACK TVEC
-C- VSUM PVPACK TVEC
-C- VUNIT PVPACK TVEC
-C- VXINVB PM434 TVXINV timing option
-C- VXINVC PM434 TVXINV timing option
-C- VZERO PUTIL TUZERO
-C-
-C- ROUTINE PATCH DECK Comment
diff --git a/src/packlib/kernlib/kerngen/test/history/history.dat b/src/packlib/kernlib/kerngen/test/history/history.dat
deleted file mode 100644
index cf4cff3..0000000
--- a/src/packlib/kernlib/kerngen/test/history/history.dat
+++ /dev/null
@@ -1,20 +0,0 @@
-C-
-C-
-C- --------------------------------------------------
-C- I I
-C- I CERN TC PROGRAM LIBRARY I
-C- I I
-C- I MICKY I
-C- I I
-C- --------------------------------------------------
-C-
-C-
-C-
-C-
-C-
-C- VERSION 1.00 PRELIMINARY VERSION
-C- VERSION 2.01 ORIGINAL RELEASE
-
-C- UP-DATE HISTORY SEE D=VS... OF THIS PATCH
-C-
-C-
diff --git a/src/packlib/kernlib/kerngen/test/history/previous.dat b/src/packlib/kernlib/kerngen/test/history/previous.dat
deleted file mode 100644
index b7f5c3e..0000000
--- a/src/packlib/kernlib/kerngen/test/history/previous.dat
+++ /dev/null
@@ -1,133 +0,0 @@
-
-Update 2.70 : 5-Sep-1994
-----------------------------
-
-Replacing File MICKY 2.69 940310 12.32
-
-Correct: bring back tests of MX... routines except MXEQU
- move D=TSORTX and TMXEQU to obsolete
-
----------------------------------------------------------------------
-
-Update 2.69 : 28-Feb-1994
-----------------------------
-
-Replacing File MICKY 2.68 940120 10.37
-
-Correct: pilot selection for Convex
- remove test and usage of SORTX
- remove test of all MX... routines
- remove test of UTRANS for Ai <-> Aj
-
----------------------------------------------------------------------
-
-Update 2.68 : 20-Jan-1994
-----------------------------
-
-Replacing File MICKY 2.67 931215 16.05
-
-New Patches: *MDOS, *MWIN pilots for MSDOS and Windows/NT
-
-Correct: P=PM432, D=TLENOC Correct bug in timing
-
----------------------------------------------------------------------
-
-Update 2.67 : 16-Dec-1993
-----------------------------
-
-Replacing File MICKY 2.66 930617 11.34
-
-New Patch: *MLNX pilot for LINUX
-
----------------------------------------------------------------------
-
-Update 2.66 : 16-June-1993
-----------------------------
-
-Replacing File MICKY 2.65 930602 16.05
-
-New Patch: *MVAO pilot for VAX Alpha OSF
-
-Correct: P=PM432, D=TICNTH add test of ICINQ, ICINQL, ICINQU
- P=PM432, D=TLENOC add timing for LNBLNK & LENOCC
-
----------------------------------------------------------------------
-
-Update 2.65 : 2-June-1993
-----------------------------
-
-Replacing File MICKY 2.64 930517 23.08
-
-Rename: rename old D=MAIN to new D=MIMAIN
-
-Correct: P=MICKY, D=. gets the little material from P=CDE
- P=*MVAX output unit for VAX is now also 6
-
-Delete: P=CDE
-
----------------------------------------------------------------------
-
-Update 2.64 : 7-May-1993
-----------------------------
-
-Replacing File MICKY 2.63 920610 17.43
-
-Rename: rename old P=MICKY to new P=*MICKY
- rename old P=SYSMICKY to new P=MICKY
- rename old P=CHF77 to new P=PM432
- rename old D=MICKY to new D=MAIN
-
-New Patches: *MNXT for the Next
- GENMUST option to generate the MUST data
-
-New Decks: P=PM432, D=TICNTH to test ICNTH, ICNTHL, ICNTHU
- P=MICKY, D=TCHDIR to test some UNIX system calls
- P=MICKY, D=CHKVER to test the verify routines
-
-Correct: D=MVERII, MVERIF for new option GENMUST
- Common /SLATE/ now of the correct length 40, not 42
- relax limits slightly in TSCALE and TTLPAC
- print number of tests failed at end of execution
-
-Delete: P=*MCDC, *MNORD3
-
----------------------------------------------------------------------
-
-Update 2.63 : 10-June-1992
-----------------------------
-
-Replacing File MICKY 2.62 920521 16.23
-
-Delete : D=TPROB remove the test on PROB
-
----------------------------------------------------------------------
-
-Update 2.62 : 21-May-1992
----------------------------
-
-Replacing File MICKY 2.61 920512 17.05
-
-Correct : enhance test of LENOCC / LNBLNK
-
----------------------------------------------------------------------
-
-Update 2.61 : 12-May-1992
----------------------------
-
-Replacing File MICKY 2.60 920512 9.59
-
-New Patch : *KERNGENT for Miguel
-
-Reorganize the pilots
-
----------------------------------------------------------------------
-
-Update 2.60 : 11-May-1992
----------------------------
-
-Replacing File MICKY 2.59 910226 18.59
-
-New Deck : TLENOC to test LENOCC and LNBLNK
-
----------------------------------------------------------------------
-
diff --git a/src/packlib/kernlib/kerngen/test/history/story.dat b/src/packlib/kernlib/kerngen/test/history/story.dat
deleted file mode 100644
index 106d6fe..0000000
--- a/src/packlib/kernlib/kerngen/test/history/story.dat
+++ /dev/null
@@ -1,44 +0,0 @@
-C.
-C. CERN TC LIBRARY MICKY PAM.
-C--------------------------------------------------------------------
-C.
-C. A PROGRAM FOR TESTING OF ROUTINES CONTAINED IN THE CERN TC
-C. LIBRARY GENERAL SECTION PAM WITH AN OPTION TO MEASURE THEIR
-C. EXECUTION TIME.
-C.
-C. THE PAM-FILE CONTAINS PILOT PATCHES FOR A NUMBER OF DIFFERENT
-C. COMPUTERS LIKE
-C.
-C. P=*MAPO APOLLO
-C. P=*MIBM IBM 360 SERIES
-C. P=*MVAX DIGITAL VAX
-C.
-C. A RUN OF MICKY TO TEST ALL ROUTINES CATERED FOR IS OBTAINED BY
-C. REQUESTING THE APPROPRIATE PILOT PATCH.
-C. NO TIMING IS DEFAULT (ITIMES=0).
-C.
-C. EXAMPLE
-C. +EXE.
-C. +USE, *MVAX.
-C. +PAM.
-C.
-C. TIMING IS OBTAINED BY GIVING
-C.
-C. +KEEP, TIMING.
-C. ITIMES = 1
-C.
-C.
-C. HOW TO TEST AN INDIVIDUAL ROUTINE UCOPY WITH TIMING,
-C. ALL TIMING-LOOPS MADE 10 TIMES LONGER, IS SHOWN
-C. BY THE FOLLOWING EXAMPLE:
-C.
-C. +USE, *MVAX.
-C. +EXE, MICKY.
-C. +EXE, PUTIL, D=TUCOPY.
-C. +KEEP, EXECUTION.
-C. ITIMES = 10
-C. CALL TUCOPY
-C. +PAM.
-C.
-C.
-C********************************************************************
diff --git a/src/packlib/kernlib/kerngen/test/history/update.dat b/src/packlib/kernlib/kerngen/test/history/update.dat
deleted file mode 100644
index 4f6146f..0000000
--- a/src/packlib/kernlib/kerngen/test/history/update.dat
+++ /dev/null
@@ -1,24 +0,0 @@
-
- Update record for file MICKY
-
-
-Update 2.71 : 12-June-1995
-----------------------------
-
-Replacing File MICKY 2.70 940905 19.50
-
-Correct: TTRIGO: function ATG has been moved from Kernlib
- to Mathlib, Micky no longer tests this library function
- (but has a statement-function version in-line for testing
- the other trig. functions); re-write the tests a bit
-
- Micky will now exit with a warning status if there
- have been comparison failures:
- status = 1 on Unix and IBM, 9 on VAX
-
-New Deck : EXITRC for the warning exit
-
-New Patch: PM434 to test VXINVB, VXINVC
-
----------------------------------------------------------------------
-
diff --git a/src/packlib/kernlib/kerngen/test/history/upold.dat b/src/packlib/kernlib/kerngen/test/history/upold.dat
deleted file mode 100644
index 4feadf6..0000000
--- a/src/packlib/kernlib/kerngen/test/history/upold.dat
+++ /dev/null
@@ -1,493 +0,0 @@
-
- CHANGES FROM VERSION 2.01 TO VERSION 2.02
- -----------------------------------------
-
- 1. PATCH COMMENT IS REPLACED BY PATCH **HEADER
-
- 2. ALL PILOT PATCHES HAVE BEEN TOUCHED.
-
- 3. SMALL BUG IN TUBLOW
-
- 4. DEFAULT VALUE FOR OPTION FOR TIMING IS NO TIMING.
- DEFAULT VALUE FOR TESTING OF ROUTINES IN TCGENR IS NO TESTING.
- FOR ACTIVATING THESE OPTIONS SEE P=**HEADER, D=STORY.
-
- 5. P=PCHAR, D=TIFORM. THE SUBROUTINE TIFORM HAS BEEN
- REWRITTEN TO BE MORE GENERAL.
-
- 6. P=PCHAR, D=TPKCH. THE SUBROUTINE TPKCH HAS BEEN REWRITTEN.
-
- 7. P=PUTIL, D=TWEED. OUTPUT MESSAGE ADDED.
-
- 8. A TIMEZB ROUTINE FOR PDP10 IS ADDED TO PILOT *PDP10.
-
- 9. SMALL BUG IN TDIRCO
-
-=====================================================================
-
- CHANGES FROM VERSION 2.02 TO VERSION 2.03
- -----------------------------------------
-
- 1. BUGS IN PILOTS *MIBM AND *MUNIVAC CORRECTED.
-
- 2. TIMEZB IN PILOT *MPDP10 DELETED.
-
- 3. AUTODELETE OF ROUTINES NOT USED.
-
- 4. MALFUNCTIONING OF TTRIGO CORRECTED.
-
- 5. DIMENSIONS OF IA AND IB IN SEQ WORK INCREASED
-
- 6. PRECISION REQUIRMENT REDUCED IN TTRIGO, TLOR, TROT
-
-=====================================================================
-
- CHANGES FROM VERSION 2.03 TO VERSION 2.04 25-JULY-1973
- -----------------------------------------
-
- 1. P=PVPACK, D=TVEC. TESTS OF DOT4-DOT-DOTNOR-DIST DELETED.
-
- 2. PILOTS FOR IBM-PDP-UNIVAC DELETES D=TWEED (FOR CDC ONLY)
-
- 3. P=PDIV, D=TTRIGO. BUGS IN TEST 2 AND 3 CORRECTED.
-
- 4. P=*MIBM360. SEQUENCE TIUCHA1 MODIFIED.
-
-=====================================================================
-
- CHANGES FROM VERSION 2.04 TO 2.10 3-NOV-75
- ---------------------------------
-
- 1. TEST FOR
- IFORMT P=PCHAR, D=TIFORM ( WHOLE DECK).
- IOFPAR-PAROFI P=PCHAR, D=TPAROF ( WHOLE DECK).
- ERPRIP-PRIPAR P=PDIV, D=TPRIP ( WHOLE DECK).
- IOFMAS-VOMAS P=PDIV, TVOMAS ( WHOLE DECK).
- MOVE P=PUTIL, D=TUCOPY.
- DIRCOS-ERDIIRC P=PVECT, D=TDIRCO ( WHOLE DECK).
- DELETED.
-
- 2. PILOT FOR TIUSAME IN ALL PILOT PATCHES HAS BEEN DELETED.
-
- 3. SEQ OTHERSMACHINE DELETED.
-
- 4. P=CDC60/70 SEQ Z=VERIFY1 DELETED.
-
- 5. P=OTHERS AND P=PUTIL, D=TWEED DELETED.
-
- 6. P=SYSMICKY, D=VERIFY SPLIT INTO D=VERIFY AND D=VERIFF.
- P=SYSMICKY, D=TIMEGO SPLITTED INTO D=TIMEGO AND D=TIMING.
-
- 7. SMALL BUG IN P=*MIBM360.
-
- 8. CDE SEQUENCES BASIC,KEEP AND WORK REPLACED BY ONE SEQUENCE MKCDE.
-
- 9. TIMING PARAMETERIZED WITH USE OF +SEQ, Z=TIMING.
-
- 10. P=SYSMICKY, D=MINIT REWRITTEN TO CONTAIN ALL INITIALIZATION
- ( D=BLKDATA AND D=TVERY DELETED).
-
- 11. ZERO DEFINED IN 5 LEVELS, WHEREFOR PRECISION REQUIRMENTS
- ARE CHANGED FOR SOME TESTS.
-
- 12. CHECK OF LIMIT FOR SIZE OF CHECKVECTOR ADDED TO VERIFY AND VERIFF.
-
- 13. BETTER ANSIFITTING AND PREPERATION FOR PATCHY4.
-
- 14. TEST FOR
- IUHUNT P=PUTIL, D=TIUCOM.
- JRSBYT P=NPBYT, D=TBYT.
- LORENB-LORENF P=PVECT D=TLOR.
- TLERR-TLRES P=PTLPAC,D=TTLPAC ( NEW PATCH).
- TLS-TLSC P=PTLPAC,D=TTLPAC ( NEW PATCH).
- VDOTN2 P=PVPACK, D=TVEC.
- ADDED.
-
- 15. P=**HEADER, D=CHECKWHERE ADDED.
-
- 16. D=STORY AND D=CHECKWHAT UPDATED.
-
-=====================================================================
-
-
- CHANGES FROM VERSION 2.10 TO 2.11 29-SEPT-76
- ------------------------------------
-
- 1) INTRODUCE CHECKING OF TR-ROUTINES (P=PTRPAC)
-
- 2) REMOVE USAGE OF VMODUL, DOT, DOT4
-
- 3) FLOATING POINT PRECISION IN COMPARISONS HAS BEEN LOOKED AT,
- WITH CONSEQUENT CHANGES. SETTING THE LEVEL-VECTOR 'ZEROV' IN MINIT
- HAS BEEN TAKEN OUT INTO MACHINE-DEPENDENT SEQUENCES.
-
- 4) NEW PATCH P=GENUSE FOR MORE EXACT CHECKING OF NEWLY-WRITTEN FLOAT.
- MACHINE-LANGUAGE ROUTINES. THIS ALLOWS FOR A 2-PASS RUNNING:
- FIRST: IN THE 'GEN'-PASS THE HAVE-DATA ARE WRITTEN TO A BINARY
- FORTRAN FILE BY MICKY WITH THE FORTRAN GENSEC ROUTINES
- CONNECTED.
- SECOND: THE 'USE'-PASS IS THE IDENTICAL MICKY RUN, BUT WITH
- THE MACHINE-LANGUAGE ROUTINES CONNECTED. COMPARISON IS
- AGAINST THE HAVE-DATA OF THE FIRST PASS, WITH THE
- PRECISION DEFINED IN 'ZERGU'. (CF D=VERIFF)
-
-=====================================================================
-
- CHANGES FROM VERSION 2.11 TO 2.12 3-DEC-76
- ------------------------------------
-
- INTRODUCE USAGE OF GENSEC ROUTINE TIMED FOR MICKY TIMING
-
-=====================================================================
-
- CHANGES FROM VERSION 2.12 TO 2.13 11-FEB-78
- ------------------------------------
-
- RE-WRITE P=PUTIL, D=IUCHA FOR MORE SERIOUS TESTS OF
- IUBIN, IUCHAN, IUHIST
-
-=====================================================================
-
- CHANGES FROM VERSION 2.13 TO 2.14 1-MAR-78
- ------------------------------------
-
- 1) BUG CORRECTED IN P=NPBYT, D=TBYT
-
- 2) CORRECT TROUBLE WITH TIMING IN P=PTLPAC, D=TTLPAC
-
-=====================================================================
-
- CHANGES FOR VERSION 2.15 23-SEP-78
- ------------------------
-
- 1) COMMON /SLATE/ WITH 2 WORDS EXTRA INTO P=SYSMICKY, D=MICKY
- THE MAIN PROGRAM MUST LOAD BEFORE ANY ROUTINE
- USING /SLATE/
-
- 2) CHECKING OF 'UTRANS' CODED INTO P=PCHAR, D=TUBLOW
-
-=====================================================================
-
- CHANGES FOR VERSION 2.16 19-NOV-78
- ------------------------
-
- 1) BRING NEW SEQU Z=MINIT2 FOR INIT OF GENUSE MODE
- 2) SET UNITS FOR IBM IN P=*IBM360
- 3) CHANGE NAMES 'TTRCHOL' TO 'TTRCHO'
- 4) REMOVE TESTING OF OBSOLETE AFROMI - IFROMA
-
-=====================================================================
-
- CHANGES FOR VERSION 2.17 24-JUN-80
- ------------------------
-
- ENTIRELY FORMAL CLEAN-UP FOR PATCHY 4
-
-=====================================================================
-
- CHANGES FOR VERSION 2.18 25-JUN-80
- ------------------------
-
- 1) NEW PATCHES P=*MNORD2, *MVAX11
-
- 2) REMOVE TEST AND USAGE OF MXADD, MXSUB, MXMTR, MXNTR, MXTRA
- AND OF ALL ROUTINES MXD...
- ALL THESE ROUTINES HAVE BEEN OBSOLETE FOR A LONG TIME
-
- 3) INCLUDE P=CDC60/70 INTO P=*MFTN
-
- 4) NEW VALUES FOR ZEROV(1) AND (2) IN P=SYSMICKY,D=.
- SET MORE TOLERANT ZERO FOR TLOR AND TTRCHO
-
-
-=====================================================================
-
- CHANGES FOR VERSION 2.19 14-NOV-80
- ------------------------
-
- D=TLOR, P=PVECT : MODIFY EQUIVALENCES FOR SOME COMPILER
- REMOVE TEST OF LOTRAN & LORENC
-
-=====================================================================
-
- CHANGES FOR VERSION 2.20 17-NOV-80
- ------------------------
-
- D=TLOR, P=PVECT : CORRECT NEW BUG
-
-=====================================================================
-
- CHANGES FOR VERSION 2.21 19-NOV-80
- ------------------------
-
- D=VERIFF, P=SYSMICKY : MODIFY FOR CURIOUS VAX COMPILER
-
-=====================================================================
-
- CHANGES FOR VERSION 2.22 25-FEB-81
- ------------------------
-
- P=*MUNO : NEW PATCH FOR UNIVAC FTN COMPILER
-
-=====================================================================
-
- CHANGES FOR VERSION 2.23 21-MAR-81
- ------------------------
-
- P=*MCDC : NEW PATCH FOR CDC FORTRAN 5 COMPILER
-
- CHANGE ALL 1H,2H,3H TO 4H IN HOLLERITH CONSTANTS
- CHANGE DIMENSION IN D=TIUCOM TO AVOID REFERENCE OUT OF BOUNDS
-
-=====================================================================
-
- CHANGES FOR VERSION 2.24 17-JUN-82
- ------------------------
-
- D=TBYT, P=NPBYT : CORRECT BUG FOR UNIVAC A4 VERSION
-
-=====================================================================
-
- CHANGES FOR VERSION 2.25 20-JUL-82
- ------------------------
-
- D=TUCOPY, P=PUTIL : MORE ELABORATE TESTS
-
-=====================================================================
-
- CHANGES FOR VERSION 2.26 1-FEB-83
- ------------------------
-
- D=TVCBYT, P=NPBYT : MORE ELABORATE TESTS
-
-=====================================================================
-
- CHANGES FOR VERSION 2.27 25-MAY-83
- ------------------------
-
- NEW CALLING OF NEWGUY
-
-=====================================================================
-
- CHANGES FOR VERSION 2.28 23-JUN-83
- ------------------------
-
- PILOT *MCRAY ADDED
-
-=====================================================================
-
- CHANGES FOR VERSION 2.29 16-NOV-83
- ------------------------
-
- TIDY UP EQUIVALENCE STATEMENTS IN
- D=TPROB,TSCALE,TTRIGO,TMXEQU,TMXM,TIUCOM,TLOR,TIUSAM
-
-=====================================================================
-
- CHANGES FOR VERSION 2.32 21-NOV-83
- ------------------------
-
- RE-ORGANISE PRINTING OF 'TEST OK'
-
-=====================================================================
-
- CHANGES FOR VERSION 2.33 21-NOV-83
- ------------------------
-
- SUPPRESS LINE-COUNTING, HENCE NEW CALL TO NEWGUY
-
-=====================================================================
-
- CHANGES FOR VERSION 2.34 22-NOV-83
- ------------------------
-
- ADD D=TUCTOH, BUT NOT YET CONNECTED IN Z=EXECUTION
-
-=====================================================================
-
- CHANGES FOR VERSION 2.35 13-DEC-83
- ------------------------
-
- ADD P=*MAPO FOR APOLLO
- CORRECT D=NEWGUY RE-SET NFAIL=0
- CORRECT Z=EXECUTION RE-ORDER A BIT, CONNECT TUCTOH
-
-=====================================================================
-
- CHANGES FOR VERSION 2.36 14-DEC-83
- ------------------------
-
- CORRECT D=MICKY ADD CALLS TO DATIME, DATIMEH
- CORRECT D=TIUCHA ALLOW FOR APOLLO REP. OF .TRUE.
-
-=====================================================================
-
- CHANGES FOR VERSION 2.37 16-DEC-83
- ------------------------
-
- CORRECT D=TIUCHA ANOTHER FIX FOR THE APOLLO
-
-=====================================================================
-
- CHANGES FOR VERSION 2.38 8-AUG-85
- ------------------------
-
- ADD D=TMBYT TO TEST MSBIT, MSBYT, ETC.
-
-=====================================================================
-
- CHANGES FOR VERSION 2.39 14-AUG-85
- ------------------------
-
- REPLACE D=TBIT AND TBYT BY A NEW ROUTINE TBYT
- ADD CALLING ROUTINE NAME INTO CALLS TO NEWGUY
-
-=====================================================================
-
- CHANGES FOR VERSION 2.40 11-FEB-86
- ------------------------
-
- ADD P=*MDGE FOR DATA GENERAL ECLIPSE
- CHANGE CALLING OF NEWGUY FOR FORTRAN 77, AVOID CALL TO UCTOH
-
-=====================================================================
-
- CHANGES FOR VERSION 2.41 21-JAN-87
- ------------------------
-
- CHANGE ROUTINE NAMES : VERIFY -> MVERII
- VERIFF -> MVERIF
-
-=====================================================================
-
- CHANGES FOR VERSION 2.42 3-JUN-87
- ------------------------
-
- ADD P=*MHYWGC FOR HONEYWELL GCOS
- CONNECT CALL TO TMBYT
-
-=====================================================================
-
- CHANGES FOR VERSION 2.43 21-SEP-87
- ------------------------
-
- TIMING ADDED FOR UCTOH ET AL.
-
-=====================================================================
-
- CHANGES FOR VERSION 2.44 2-NOV-87
- ------------------------
-
- CORRECT ERROR IN TIMING FOR UCTOH ET AL.
-
-=====================================================================
-
- CHANGES FOR VERSION 2.45 10-FEB-88
- ------------------------
-
- ADD PILOT P=*MALT FOR ALLIANT
- ADD PILOT P=*MNORD3 FOR NORD 500, FOR CONSISTENCY
-
-=====================================================================
-
- CHANGES FOR VERSION 2.46 15-FEB-88
- ------------------------
-
- Extend timing in TUCTOH to 40 characters
- Change print formats to print blank lines rather than 0
-
-=====================================================================
-
- CHANGES FOR VERSION 2.47 22-FEB-88
- ------------------------
-
- TUCTOH : test on trailing characters
- Change Common variable names IBITS ->IQBITW, ICHAR -> IQCHAW
- Pilots tidied up
-
-=====================================================================
-
- CHANGES FOR VERSION 2.48 11-APR-88
- ------------------------
-
- Add pilot P=*MCRU for Cray Unicos
-
-=====================================================================
-
- CHANGES FOR VERSION 2.49 7-JUL-88
- ------------------------
-
- Change name of Pam from MICKYPAM to Micky
-
-=====================================================================
-
- CHANGES FOR VERSION 2.50 3-AUG-88
- ------------------------
-
- Add P=*MIRT for IBM RT PC
- Re-order the pilot patches
- Change TSCALE
-
-=====================================================================
-
- CHANGES FOR VERSION 2.51 24-AUG-88
- ------------------------
-
- Fix problem IN TPKCH
- Correct bug intoduced to TSCALE
-
-=====================================================================
-
- CHANGES FOR VERSION 2.52 21-SEP-88
- ------------------------
-
- Change Hollerith to type Integer in TBABY, TUBLOW
-
-=====================================================================
-
- CHANGES FOR VERSION 2.53 26-SEP-88
- ------------------------
-
- Add pilot P=*MSUN for SUN
-
-=====================================================================
-
- CHANGES FOR VERSION 2.54 16-Feb-89
- ------------------------
-
- Add pilots P=*MTMO and *MVMI for Transputer and VAX/MIPS
-
-=====================================================================
-
- CHANGES FOR VERSION 2.55 24-Feb-89
- ------------------------
-
- Add pilot P=*MCVX for Convex
- Change CALL UBLOW to CALL UCTOH1 in initialisation calls
-
-=====================================================================
-
- CHANGES FOR VERSION 2.56 7-Mar-89
- ------------------------
-
- Avoid Hollerith literal in call to UOPT
- Remove F77 flag
-
-=====================================================================
-
- CHANGES FOR VERSION 2.57 22-Mar-89
- ------------------------
-
- new system routines MVERIC + MVEUNS
- new test routine TSORTN to test SORTI, SORTR
- new test routine TRANDM preparing for the test of RANMAR et al
-
-=====================================================================
-
- CHANGES FOR VERSION 2.59 26-Feb-91
- ------------------------
-
- new patch P=*MHPX for Hewlett Packard
-
-=====================================================================
-
diff --git a/src/packlib/kernlib/kerngen/test/kerngent/mkcde.inc b/src/packlib/kernlib/kerngen/test/kerngent/mkcde.inc
deleted file mode 100644
index 28d215c..0000000
--- a/src/packlib/kernlib/kerngen/test/kerngent/mkcde.inc
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: mkcde.inc,v 1.1.1.1 1996/02/15 17:55:06 mclareni Exp $
-*
-* $Log: mkcde.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:55:06 mclareni
-* Kernlib
-*
-*
-#ifndef CERNLIB_KERNGENT_MKCDE_INC
-#define CERNLIB_KERNGENT_MKCDE_INC
-*
-*
-* mkcde.inc
-*
- COMMON /PARAM/ IQBITW, IQCHAW, ITB, NLINES, ITIMES, TIMERD
- +, IFLGU, LUNGU, ZERGU, ZEROV(5), ZERLEV, LOGLEV
- +, NFAIPR,NEACHP, NFAILT,NFAIL, NTEST,MTESTV(20)
- COMMON // A(1000), B(1010), IBCD(47),INTG(100)
- DIMENSION IA(1000), IB(1000)
- EQUIVALENCE (IA(1),A(1)), (IB(1),B(1))
-C-----------------------------------------------------------------------
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/test/kerngent/mkch.inc b/src/packlib/kernlib/kerngen/test/kerngent/mkch.inc
deleted file mode 100644
index d0838b8..0000000
--- a/src/packlib/kernlib/kerngen/test/kerngent/mkch.inc
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: mkch.inc,v 1.1.1.1 1996/02/15 17:55:06 mclareni Exp $
-*
-* $Log: mkch.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:55:06 mclareni
-* Kernlib
-*
-*
-#ifndef CERNLIB_KERNGENT_MKCH_INC
-#define CERNLIB_KERNGENT_MKCH_INC
-*
-*
-* mkch.inc
-*
- CHARACTER MKLINE*512, MKCOL(512)*1
- COMMON /MKCH/ MKLINE
- EQUIVALENCE (MKCOL,MKLINE)
-
-#endif
diff --git a/src/packlib/kernlib/kerngen/test/kerngent/pilot.h b/src/packlib/kernlib/kerngen/test/kerngent/pilot.h
deleted file mode 100644
index 541dd7f..0000000
--- a/src/packlib/kernlib/kerngen/test/kerngent/pilot.h
+++ /dev/null
@@ -1,189 +0,0 @@
-#if 0
-* This pilot patch was created from kerngent.car patch _kerngent
-* Interface pilot to Micky
-#endif
-#if defined(CERNLIB_IBMVM)||defined(CERNLIB_IBMMVS)
-#ifndef CERNLIB_IBM
-#define CERNLIB_IBM
-#endif
-#endif
-#if defined(CERNLIB_VAXVMS)||defined(CERNLIB_VAXULX)
-#ifndef CERNLIB_VAX
-#define CERNLIB_VAX
-#endif
-#endif
-#if 0
-* for DECstation (VAX/MIPS)
-#endif
-#if defined(CERNLIB_DECS)
-#ifndef CERNLIB_QMVMI
-#define CERNLIB_QMVMI
-#endif
-#ifndef CERNLIB_QUNIX
-#define CERNLIB_QUNIX
-#endif
-#endif
-#if 0
-* for VAX Alpha OSF
-#endif
-#if (defined(CERNLIB_ALPHA))&&(defined(CERNLIB_OSF))
-#ifndef CERNLIB_QMVAO
-#define CERNLIB_QMVAO
-#endif
-#ifndef CERNLIB_QUNIX
-#define CERNLIB_QUNIX
-#endif
-#endif
-#if 0
-* for HP Unix work station
-#endif
-#if defined(CERNLIB_HPUX)
-#ifndef CERNLIB_QMHPX
-#define CERNLIB_QMHPX
-#endif
-#ifndef CERNLIB_QUNIX
-#define CERNLIB_QUNIX
-#endif
-#endif
-
-#if 0
-* for IBM Risc 6000
-#endif
-#if defined(CERNLIB_IBMRT)
-#ifndef CERNLIB_QMIRT
-#define CERNLIB_QMIRT
-#endif
-#ifndef CERNLIB_QUNIX
-#define CERNLIB_QUNIX
-#endif
-#endif
-#if 0
-* for PC with Linux
-#endif
-#if defined(CERNLIB_LINUX)
-#ifndef CERNLIB_QMLNX
-#define CERNLIB_QMLNX
-#endif
-#ifndef CERNLIB_QUNIX
-#define CERNLIB_QUNIX
-#endif
-#endif
-#if 0
-* for PC with MSDOS
-#endif
-#if defined(CERNLIB_MSDOS)
-#ifndef CERNLIB_QMDOS
-#define CERNLIB_QMDOS
-#endif
-#ifndef CERNLIB_QUNIX
-#define CERNLIB_QUNIX
-#endif
-#endif
-#if 0
-* for Microware OS-9
-#endif
-#if defined(CERNLIB_OS9)
-#ifndef CERNLIB_QMOS9
-#define CERNLIB_QMOS9
-#endif
-#ifndef CERNLIB_QUNIX
-#define CERNLIB_QUNIX
-#endif
-#endif
-#if 0
-* for PC with WINDOWS/NT
-#endif
-#if defined(CERNLIB_WINNT)
-#ifndef CERNLIB_QMDOS
-#define CERNLIB_QMDOS
-#endif
-#ifndef CERNLIB_QUNIX
-#define CERNLIB_QUNIX
-#endif
-#endif
-#if defined(CERNLIB_MACMPW)
-#ifndef CERNLIB_QMMPW
-#define CERNLIB_QMMPW
-#endif
-#ifndef CERNLIB_QUNIX
-#define CERNLIB_QUNIX
-#endif
-#endif
-#if 0
-* for Silicon Graphics
-#endif
-#if defined(CERNLIB_SGI)
-#ifndef CERNLIB_QMSGI
-#define CERNLIB_QMSGI
-#endif
-#ifndef CERNLIB_QUNIX
-#define CERNLIB_QUNIX
-#endif
-#endif
-#if 0
-* for SUN work station
-#endif
-#if defined(CERNLIB_SUN)
-#ifndef CERNLIB_QMSUN
-#define CERNLIB_QMSUN
-#endif
-#ifndef CERNLIB_QUNIX
-#define CERNLIB_QUNIX
-#endif
-#endif
-#if 0
-* for DEC VAX
-#endif
-#if defined(CERNLIB_VAX)
-#if 0
-* This pilot patch was created from kerngent.car patch _mvax
-* For DEC VAX
-#endif
-#ifndef CERNLIB_QMVAX
-#define CERNLIB_QMVAX
-#endif
-#endif
-#if 0
-* This pilot patch was created from kerngent.car patch _mnorm
-* for most machines
-#endif
-#ifndef CERNLIB_A4
-#define CERNLIB_A4
-#endif
-#ifndef CERNLIB_B32
-#define CERNLIB_B32
-#endif
-#if 0
-* This pilot patch was created from kerngent.car patch _micky
-#endif
-#ifndef CERNLIB_CDE
-#define CERNLIB_CDE
-#endif
-#if 0
-* Character set is ASCII
-#endif
-#if !defined(CERNLIB_QEBCDIC)
-#ifndef CERNLIB_QASCII
-#define CERNLIB_QASCII
-#endif
-#endif
-#if 0
-* Hollerith exists
-#endif
-#ifndef CERNLIB_QHOLL
-#define CERNLIB_QHOLL
-#endif
-#if 0
-* EQUIVALENCE Hollerith/Character ok
-#endif
-#if defined(CERNLIB_QHOLL)
-#ifndef CERNLIB_EQUHOLCH
-#define CERNLIB_EQUHOLCH
-#endif
-#endif
-#if 0
-* do test VXINVB/C
-#endif
-#ifndef CERNLIB_TVXINV
-#define CERNLIB_TVXINV
-#endif
diff --git a/src/packlib/kernlib/kerngen/test/micky/Imakefile b/src/packlib/kernlib/kerngen/test/micky/Imakefile
deleted file mode 100644
index 03f9e4d..0000000
--- a/src/packlib/kernlib/kerngen/test/micky/Imakefile
+++ /dev/null
@@ -1,4 +0,0 @@
-SRCS_F= chkver.F exitrc.F minit.F mveric.F mverif.F mverii.F \ @@\
- mveuns.F newguy.F prtest.F tchdir.F time77.F timing.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kerngen/test/micky/chkver.F b/src/packlib/kernlib/kerngen/test/micky/chkver.F
deleted file mode 100644
index 7bbc2df..0000000
--- a/src/packlib/kernlib/kerngen/test/micky/chkver.F
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: chkver.F,v 1.1.1.1 1996/02/15 17:54:54 mclareni Exp $
-*
-* $Log: chkver.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:54 mclareni
-* Kernlib
-*
-*
-#include "kerngent/pilot.h"
- SUBROUTINE CHKVER
-
-C- Check of the checking routines
-
-#include "kerngent/mkcde.inc"
-
- DIMENSION CHECK(10)
-
- DATA CHECK/0.,1.,2.,3.,4.,5.,6.,7.,8.,9./
-
-
- WRITE (ITB,9071)
- CALL MVERII (1,INTG,INTG,10)
- CALL MVERII (2,INTG(2),INTG,10)
- CALL MVERIF (1,CHECK,CHECK,10)
- CALL MVERIF (2,CHECK(2),CHECK,9)
- CALL PRTEST
- NFAILT = 0
- NFAIL = 0
- RETURN
-
- 9071 FORMAT (/' First of all, check the checking routine:'/
- F' The first test should be ok, the second should fail.'/)
- END
diff --git a/src/packlib/kernlib/kerngen/test/micky/exitrc.F b/src/packlib/kernlib/kerngen/test/micky/exitrc.F
deleted file mode 100644
index 5ec37dd..0000000
--- a/src/packlib/kernlib/kerngen/test/micky/exitrc.F
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: exitrc.F,v 1.1.1.1 1996/02/15 17:54:54 mclareni Exp $
-*
-* $Log: exitrc.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:54 mclareni
-* Kernlib
-*
-*
-#include "kerngent/pilot.h"
- SUBROUTINE EXITRC (INRC)
-
- JRC = INRC
-
-#if defined(CERNLIB_IBM)
- IF (JRC.GE.2) JRC = 4
-#endif
-#if defined(CERNLIB_VAX)
- IF (JRC.EQ.1) THEN
- JRC = 9
- ELSEIF (JRC.GE.2) THEN
- JRC = 4
- ENDIF
-#endif
- CALL EXITF (JRC)
- END
diff --git a/src/packlib/kernlib/kerngen/test/micky/mimain.F b/src/packlib/kernlib/kerngen/test/micky/mimain.F
deleted file mode 100644
index 3696e40..0000000
--- a/src/packlib/kernlib/kerngen/test/micky/mimain.F
+++ /dev/null
@@ -1,134 +0,0 @@
-*
-* $Id: mimain.F,v 1.2 1996/04/02 23:19:34 thakulin Exp $
-*
-* $Log: mimain.F,v $
-* Revision 1.2 1996/04/02 23:19:34 thakulin
-* Support for EPC Fortran: remove char-int equivalences and use F90
-* transfer facility.
-*
-* Revision 1.1.1.1 1996/02/15 17:54:54 mclareni
-* Kernlib
-*
-*
-#include "kerngent/pilot.h"
- PROGRAM MICKY
-
-#include "kerngent/mkch.inc"
-#include "kerngent/mkcde.inc"
- COMMON /SLATY/ ISLY(4)
- COMMON /SLATE/ ISLATE(40)
- COMMON /SLATX/ ISLX(4)
- DIMENSION IDATEV(2), ITIMEV(2)
-#if !defined(CERNLIB_F90) && !defined(CERNLIB_QFEPC)
- CHARACTER CHDAT*8, CHTIM*8
- EQUIVALENCE (CHDAT,IDATEV), (CHTIM,ITIMEV)
-#endif
-
- IFLGU = 0
- LUNGU = 0
-
-C- Intialize
- CALL MINIT
-
-C- Timing
-
-C- Execution
-
-C- Check of the checking routines
- CALL CHKVER
-
-C- Very basic things first
- CALL TUZERO
- CALL TBYT
- CALL TMBYT
- CALL TUCOPY
- CALL TUBLOW
- CALL TUCTOH
-
-C- Patch PM432
- CALL TLENOC
- CALL TICNTH
-
-C- Patch PUTIL
- CALL TCOCOP
- CALL TIUCHA
- CALL TIUCOM
- CALL TIUSAM
- CALL TUOPT
- CALL TUSWOP
-
-C- Patch PCHAR
- CALL TBABY
- CALL TPKCH
-
-C- Patch NPBYT
- CALL TVCBYT
-
-C- Patch PDIV
- CALL TMAXMU
- CALL TSCALE
- CALL TSORTN
-C! CALL TSORTX
- CALL TTRIGO
-
-C- Patch PMATRIX
-C! CALL TMXEQU
- CALL TMXM
- CALL TMXTRP
- CALL TMXUTY
-
-C- Patch PVECT
- CALL TCROSS
- CALL TLOR
- CALL TROT
-
-C- Patch PVPACK
- CALL TVEC
-
-C- Patch PTLPAC
- CALL TTLPAC
-
-C- Patch PTRPAC
- CALL TTRCHO
- CALL TTRINV
- CALL TTRLA
-
-C- Patch PM434
- CALL TVXINV
-
- CALL PRTEST
- NFAIL = 0
-
-C---- Exercise some Unix system calls
-
-#if !defined(CERNLIB_QMIBM)
- CALL TCHDIR
-#endif
-
-C---- Exercise the date/time routines
-
- 81 CALL DATIME (IDATEV(1),IDATEV(2))
-
- WRITE (ITB,9081) IDATEV, (ISLATE(J),J=1,6)
- 9081 FORMAT (1X/' DATIME ',I8,2X,I4,' SLATE: ',6I4)
-
- CALL DATIMH (IDATEV,ITIMEV)
-
-#if defined(CERNLIB_F90) || defined(CERNLIB_QFEPC)
- WRITE (ITB,9084) transfer(IDATEV,'abcdefgh')
- transfer(ITIMEV,'abcdefgh')
-#else
- WRITE (ITB,9084) CHDAT, CHTIM
-#endif
- 9084 FORMAT (' DATIMH ',A,1X,A)
-
- IF (NFAILT.EQ.0) THEN
- WRITE (ITB,9088)
- ELSE
- WRITE (ITB,9089) NFAILT
- CALL EXITRC (1)
- ENDIF
-
- 9088 FORMAT (/' All tests passed.')
- 9089 FORMAT (/' !!! ',I6,' tests failed in all !!!')
- END
diff --git a/src/packlib/kernlib/kerngen/test/micky/minit.F b/src/packlib/kernlib/kerngen/test/micky/minit.F
deleted file mode 100644
index 9cd327d..0000000
--- a/src/packlib/kernlib/kerngen/test/micky/minit.F
+++ /dev/null
@@ -1,76 +0,0 @@
-*
-* $Id: minit.F,v 1.1.1.1 1996/02/15 17:54:53 mclareni Exp $
-*
-* $Log: minit.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:53 mclareni
-* Kernlib
-*
-*
-#include "kerngent/pilot.h"
- SUBROUTINE MINIT
-
-#include "kerngent/mkcde.inc"
-
- DIMENSION MBCD(47)
-
- DATA MBCD / 4H ,4H0 ,4H1 ,4H2 ,4H3 ,
- + 4H4 ,4H5 ,4H6 ,4H7 ,4H8 ,
- + 4H9 ,4HA ,4HB ,4HC ,4HD ,
- + 4HE ,4HF ,4HG ,4HH ,4HI ,
- + 4HJ ,4HK ,4HL ,4HM ,4HN ,
- + 4HO ,4HP ,4HQ ,4HR ,4HS ,
- + 4HT ,4HU ,4HV ,4HW ,4HX ,
- + 4HY ,4HZ ,4H+ ,4H- ,4H= ,
- + 4H* ,4H/ ,4H( ,4H) ,4H. ,
- + 4H, ,4H' /
-
-
- IQBITW = 32
- IQCHAW = 4
- ITB = 6
-
- ITIMES = 0
-
- DO 14 J=1,47
- 14 IBCD(J)=MBCD(J)
-
- DO 24 J=1,100
- 24 INTG(J)=J
-
-C---- ZEROV(1-5) CONTAIN THE LEVELS OF PRECISION EXPECTED AFTER
-C- (1) NO, (2) LITTLE, (3) SOME, (4) FAIR, (5) MUCH FLOATING CALC
-
-#if defined(CERNLIB_B60)||defined(CERNLIB_B64)
- ZEROV(1) = 1.0 E-20
- ZEROV(2) = 1.0 E-12
- ZEROV(3) = 1.0 E-8
- ZEROV(4) = 1.0 E-6
- ZEROV(5) = 1.0 E-4
-#else
- ZEROV(1) = 1.0 E-10
- ZEROV(2) = 1.0 E-6
- ZEROV(3) = 1.0 E-5
- ZEROV(4) = 1.0 E-4
- ZEROV(5) = 1.0 E-3
-#endif
-
- ZERGU = ZEROV(1)
- ZERLEV= ZEROV(1)
-
- NFAIPR = 4
- NEACHP = 0
- NFAILT = 0
- NFAIL = 0
- NTEST = 0
-
- WRITE (ITB,9000)
- WRITE (ITB,9001)
- CALL KERNGT (ITB)
- IF (IFLGU.EQ.0) RETURN
-
- RETURN
-
- 9000 FORMAT ('1'/' MICKY executing.')
- 9001 FORMAT (1X/1X,
- + 40H MICKY 2.71 950712 9.30 )
- END
diff --git a/src/packlib/kernlib/kerngen/test/micky/mveric.F b/src/packlib/kernlib/kerngen/test/micky/mveric.F
deleted file mode 100644
index 62eb36a..0000000
--- a/src/packlib/kernlib/kerngen/test/micky/mveric.F
+++ /dev/null
@@ -1,150 +0,0 @@
-*
-* $Id: mveric.F,v 1.1.1.1 1996/02/15 17:54:54 mclareni Exp $
-*
-* $Log: mveric.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:54 mclareni
-* Kernlib
-*
-*
-#include "kerngent/pilot.h"
- SUBROUTINE MVERIC (NTT,IHAVE,IMUST,NN,NCHH,NCHM,CHH,CHM)
-
-C- Compare the integer vectors IHAVE and IMUST of NN words,
-C- unless NN is zero;
-C- and compare the CHARACTER strings CHH and CHM
-C- of NCHH, NCHM characters if NCHH = NCHM only
-
-#include "kerngent/mkcde.inc"
-
- DIMENSION IHAVE(99), IMUST(99)
- CHARACTER CHH*99, CHM*99
- CHARACTER CHPR*50
-
- NTX = NTT
- NIDO = NN
- IF (NIDO.GE.201) GO TO 91
- IF (NTEST.GE.10) CALL PRTEST
-
- JIF = 0
- IF (NIDO.LE.0) GO TO 26
-
- DO 24 JI=1,NIDO
- IF (IHAVE(JI).NE.IMUST(JI)) THEN
- IF (JIF.EQ.0) JIF = JI
- ENDIF
- 24 CONTINUE
-
- 26 IF (NCHH.EQ.NCHM) THEN
- IF (CHH(1:NCHH).NE.CHM(1:NCHH)) GO TO 41
- ENDIF
-
- JCF = 0
- IF (JIF.NE.0) GO TO 46
-
-C---- VERIFY OK.
-
- IF (NFAIL.EQ.0) GO TO 39
- CALL PRTEST
- NFAIL = 0
-
- 39 NTEST = NTEST + 1
- MTESTV(NTEST) = NTX
- IF (NEACHP.EQ.0) RETURN
- CALL PRTEST
- RETURN
-
-C---- VERIFY FAILURE
-
- 41 DO 42 JCF=1,NCHH
- IF (CHH(JCF:JCF).NE.CHM(JCF:JCF)) GO TO 43
- 42 CONTINUE
- 43 CONTINUE
-
- 46 NFAILT = NFAILT + 1
- IF (NFAIL.EQ.0) GO TO 47
- IF (NFAIL.LT.NFAIPR) GO TO 48
- NFAIL = NFAIL + 1
- GO TO 39
-
- 47 CALL PRTEST
- 48 WRITE (ITB,9001) NTX
- NFAIL = NFAIL + 1
-
-C-- Dump integer vectors
-
- IF (JIF.EQ.0) GO TO 61
- WRITE (ITB,9051) JIF
- J1 = JIF
-
- DO 52 J=JIF,NIDO
- IF (IABS(IHAVE(J)).GE.10000) GO TO 58
- IF (IABS(IMUST(J)).GE.10000) GO TO 58
- 52 CONTINUE
-
- 54 J2 = MIN (J1+9,NIDO)
- WRITE (ITB,9054) J1,(IMUST(J),J=J1,J2)
- WRITE (ITB,9055) (IHAVE(J),J=J1,J2)
- J1 = J1 + 10
- IF (J1.LE.NIDO) GO TO 58
- IF (J1.NE.NIDO+1) WRITE (ITB,9013)
- GO TO 61
-
- 58 J2 = MIN (J1+4,NIDO)
- WRITE (ITB,9011) J1,(IMUST(J),J=J1,J2)
- WRITE (ITB,9012) (IHAVE(J),J=J1,J2)
- J1 = J1 + 5
- IF (J1.LE.NIDO) GO TO 58
- IF (J1.NE.NIDO+1) WRITE (ITB,9013)
-
-C-- Dump character strings
-
- 61 IF (JCF.EQ.0) THEN
- WRITE (ITB,9061)
- ELSE
- WRITE (ITB,9062) JCF
- ENDIF
- ND = 0
-
- IF (ND.GE.NCHM) GO TO 66
-
- 62 NU = MIN (NCHM-ND, 50)
- CHPR(1:NU) = CHM(ND+1:ND+NU)
- WRITE (ITB,9013)
-
- CALL MVEUNS (CHPR(1:NU),ND)
- WRITE (ITB,9064) ND+1,CHPR(1:NU)
-
- 66 IF (ND.GE.NCHH) GO TO 69
- 67 NU = MIN (NCHH-ND, 50)
- CHPR(1:NU) = CHH(ND+1:ND+NU)
-
- CALL MVEUNS (CHPR(1:NU),ND)
- WRITE (ITB,9065) CHPR(1:NU)
- 69 ND = ND + 50
- IF (ND.LT.NCHM) GO TO 62
- IF (ND.LT.NCHH) GO TO 67
- WRITE (ITB,9013)
- RETURN
-
-C---- Trouble
-
- 91 CALL PRTEST
- WRITE (ITB,9091) NTX, NIDO
- RETURN
-
- 9001 FORMAT (5H TEST,I5,' FAILED, Dump follows'/)
- 9013 FORMAT (1X)
- 9051 FORMAT (10X,'Dump integer vectors starting at',I4/1X)
- 9054 FORMAT (I10,5H MUST,10I5)
- 9055 FORMAT (10X,5H HAVE,10I5/1X)
- 9061 FORMAT (10X,'Dump characters strings'/1X)
- 9062 FORMAT (10X,'String mismatch at character',I5/1X)
- 9064 FORMAT (I9,6H MUST ,A)
- 9065 FORMAT (9X,6H HAVE ,A)
- 9091 FORMAT (1X/' VERIFY VECTOR FOR TEST',I6,' MORE THAN 200 WORDS,',
- F' NAMELY',I5)
-
-* FROM MACHINE PATCH
-#include "verifmt.inc"
-
- END
diff --git a/src/packlib/kernlib/kerngen/test/micky/mverif.F b/src/packlib/kernlib/kerngen/test/micky/mverif.F
deleted file mode 100644
index 0d2b12c..0000000
--- a/src/packlib/kernlib/kerngen/test/micky/mverif.F
+++ /dev/null
@@ -1,153 +0,0 @@
-*
-* $Id: mverif.F,v 1.1.1.1 1996/02/15 17:54:54 mclareni Exp $
-*
-* $Log: mverif.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:54 mclareni
-* Kernlib
-*
-*
-#include "kerngent/pilot.h"
- SUBROUTINE MVERIF (NTT,HAVE,AMUST,NN)
-
-#include "kerngent/mkcde.inc"
-
- DIMENSION HAVE(9),AMUST(9), NTT(9), NN(9)
- DIMENSION TEST(200)
-
-#if defined(CERNLIB_QMVAX)
- DIMENSION IHAVE(200), IMUST(200)
-#endif
-
-
- NTUSE = NTT(1)
- NHAVE = NN(1)
- IF (NHAVE.GE.201) GO TO 91
- ZERU = ZERLEV
- IF (NTEST.GE.10) CALL PRTEST
-
-#if defined(CERNLIB_GENUSE)
-C---- Read/write the MUST data on binary file
-
- IF (IFLGU) 11, 31, 14
- 11 IF (LUNGU.EQ.0) LUNGU= 11
- WRITE (LUNGU) NTUSE,(HAVE(J),J=1,NHAVE)
- GO TO 31
-
- 14 IF (LUNGU.EQ.0) LUNGU= 11
- ZERU = ZERGU
- CALL UCOPY (AMUST,SAVE,NHAVE)
- READ (LUNGU) NTN,(AMUST(J),J=1,NHAVE)
- IF (NTN.EQ.NTUSE) GO TO 31
- WRITE (ITB,9017) NTUSE,NTN
- 9017 FORMAT (1X/26H FAULTY READ-BACK FOR TEST,I4,10H, FINDING,I4)
- STOP
-#endif
-#if (defined(CERNLIB_GENMUST))&&(!defined(CERNLIB_GENUSE))
-C---- Generate the MUST data on "cards"
-
- IF (IFLGU.EQ.0) GO TO 31
- IF (LUNGU.EQ.0) LUNGU= ITB
-
- WRITE (LUNGU,9024) NTUSE
- WRITE (LUNGU,9025) (HAVE(J),J=1,NHAVE)
- RETURN
-
- 9024 FORMAT (' DATA for test',I6)
- 9025 FORMAT (6X,G20.9)
-#endif
-
-C---- Verify
-
- 31 DO 36 JJ=1,NHAVE
- J = JJ
- DIFF = ABS (HAVE(J) - AMUST(J))
- IF (DIFF .LT. ZERU) GO TO 36
- SUM = ABS (HAVE(J) + AMUST(J))
- IF (SUM .LT. 2.) GO TO 41
- IF (2.*DIFF/SUM.GT.ZERU) GO TO 41
- 36 CONTINUE
-
-C---- VERIFY OK.
-
-
- IF (NFAIL.EQ.0) GO TO 39
- CALL PRTEST
- NFAIL = 0
-
- 39 NTEST = NTEST + 1
- MTESTV(NTEST) = NTUSE
- IF (NEACHP.EQ.0) RETURN
- CALL PRTEST
- RETURN
-
-C---- VERIFY FAILURE
-
- 41 JJ = J
- NFAILT = NFAILT + 1
- IF (NFAIL.EQ.0) GO TO 47
- IF (NFAIL.LT.NFAIPR) GO TO 48
- NFAIL = NFAIL + 1
- GO TO 39
-
- 47 CALL PRTEST
- 48 WRITE (ITB,9001) NTUSE
- NFAIL = NFAIL + 1
-
- N1 = JJ
-#if defined(CERNLIB_QMVAX)
- CALL UCOPY (HAVE,IHAVE,N)
- CALL UCOPY (AMUST,IMUST,N)
-#endif
-
- 51 N2 = MIN (N1+4,NHAVE)
-#if defined(CERNLIB_QMVAX)
- WRITE (ITB,9011) N1,(IMUST(J),J=N1,N2)
- WRITE (ITB,9012) (IHAVE(J),J=N1,N2)
-#else
- WRITE (ITB,9011) N1,(AMUST(J),J=N1,N2)
- WRITE (ITB,9012) (HAVE(J),J=N1,N2)
-#endif
- N1= N1+5
- IF (N1.LE.NHAVE) GO TO 51
- IF (N1-1.NE.NHAVE) WRITE (ITB,9013)
-
-C-- PRINT VECTORS IN FLOATING FORMAT
-
- WRITE (ITB,9054) ZERU
- DO 56 J=JJ,NHAVE
- DIFF = ABS (HAVE(J) - AMUST(J))
- SUM = ABS (HAVE(J) + AMUST(J))
- TEST(J) = 0.
- IF (DIFF .LT. ZERU) GO TO 56
- TEST(J) = DIFF
- IF (SUM .LT. 2.) GO TO 56
- TEST(J) = 2.*TEST(J) / SUM
- 56 CONTINUE
-
- N1 = JJ
- 60 N2= MIN (N1+4,NHAVE)
- WRITE (ITB,9061) N1,(AMUST(J),J=N1,N2)
- WRITE (ITB,9062) (HAVE(J),J=N1,N2)
- WRITE (ITB,9063) (TEST(J),J=N1,N2)
- N1=N1+5
- IF (N1.LE.NHAVE) GO TO 60
- WRITE(ITB,9013)
- RETURN
-
- 91 CALL PRTEST
- WRITE (ITB,9091) NTUSE, NHAVE
- RETURN
-
- 9001 FORMAT (5H TEST,I5,' FAILED, Dump follows'/)
- 9091 FORMAT (1X/' VERIFF VECTOR FOR TEST',I6,' MORE THAN 200 WORDS,',
- F' NAMELY',I5)
-
-* FROM MACHINE PATCH
-#include "verifmt.inc"
-
- 9013 FORMAT (1X)
- 9054 FORMAT (11X,32HFloating point values, ZERLEV= ,E10.2)
- 9061 FORMAT (I10,5H MUST,5E21.13)
- 9062 FORMAT (10X,5H HAVE,5E21.13)
- 9063 FORMAT (10X,5H TEST,5(E13.5,8X)/1X)
- END
diff --git a/src/packlib/kernlib/kerngen/test/micky/mverii.F b/src/packlib/kernlib/kerngen/test/micky/mverii.F
deleted file mode 100644
index 9c20a90..0000000
--- a/src/packlib/kernlib/kerngen/test/micky/mverii.F
+++ /dev/null
@@ -1,122 +0,0 @@
-*
-* $Id: mverii.F,v 1.1.1.1 1996/02/15 17:54:54 mclareni Exp $
-*
-* $Log: mverii.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:54 mclareni
-* Kernlib
-*
-*
-#include "kerngent/pilot.h"
- SUBROUTINE MVERII (NTT,IHAVE,IMUST,NN)
-
-#include "kerngent/mkch.inc"
-#include "kerngent/mkcde.inc"
-
- DIMENSION IHAVE(99),IMUST(99), NTT(9), NN(9)
-
- NTUSE = NTT(1)
- NHAVE = NN(1)
- IF (NHAVE.GE.201) GO TO 91
- IF (NTEST.GE.10) CALL PRTEST
-
-#if (defined(CERNLIB_GENMUST))&&(!defined(CERNLIB_GENUSE))
-C---- Generate the MUST data on "cards"
-
- IF (IFLGU.EQ.0) GO TO 31
- IF (LUNGU.EQ.0) LUNGU= ITB
-
- MINEL = 0
- MAXEL = 0
- DO 22 J=1,NHAVE
- MINEL = MIN (MINEL, IHAVE(J))
- 22 MAXEL = MAX (MAXEL, IHAVE(J))
- IF (MINEL.LT.0) MINEL= -10*MINEL
- MAXEL = MAX (MINEL,MAXEL)
-
- NCHEL = 1
- DO 23 J=1,11
- IF (MAXEL.LT.10) GO TO 24
- NCHEL = NCHEL + 1
- 23 MAXEL = MAXEL/10
- 24 NCHEL = NCHEL + 2
- JEL = 0
-
- WRITE (LUNGU,9024) NTUSE
- 9024 FORMAT (' DATA for test',I6)
-
- 25 MKLINE(1:80) = ' +'
- JCOLE = 8
- 26 JEL = JEL + 1
- JCOLF = JCOLE + 1
- JCOLE = JCOLE + NCHEL
- CALL CSETDI (IHAVE(JEL), MKLINE,JCOLF,JCOLE-1)
- IF (JEL.LT.NHAVE) THEN
- JCOLPR = JCOLE
- MKCOL(JCOLPR) = ','
- ELSE
- JCOLPR = JCOLE + 1
- MKCOL(JCOLPR) = '/'
- JCOLE = 80
- ENDIF
- IF (JCOLE+NCHEL.LT.73) GO TO 26
-
- WRITE (LUNGU,9025) MKLINE(1:JCOLPR)
- 9025 FORMAT(A)
-
- IF (JEL.LT.NHAVE) GO TO 25
- RETURN
-#endif
-
-C---- Verify
-
- 31 DO 34 JJ=1,NHAVE
- J= JJ
- IF (IHAVE(J).NE.IMUST(J)) GO TO 41
- 34 CONTINUE
-
-C-- verify ok.
-
- IF (NFAIL.EQ.0) GO TO 39
- CALL PRTEST
- NFAIL = 0
-
- 39 NTEST = NTEST + 1
- MTESTV(NTEST) = NTUSE
- IF (NEACHP.EQ.0) RETURN
- CALL PRTEST
- RETURN
-
-C-- verify failure
-
- 41 N1 = J
- NFAILT = NFAILT + 1
- IF (NFAIL.EQ.0) GO TO 47
- IF (NFAIL.LT.NFAIPR) GO TO 48
- NFAIL = NFAIL + 1
- GO TO 39
-
- 47 CALL PRTEST
- 48 WRITE (ITB,9001) NTUSE
- NFAIL = NFAIL + 1
-
- 51 N2= MIN (N1+4,NHAVE)
- WRITE (ITB,9011) N1,(IMUST(J),J=N1,N2)
- WRITE (ITB,9012) (IHAVE(J),J=N1,N2)
- N1= N1+5
- IF (N1.LE.NHAVE) GO TO 51
- IF (N1-1.NE.NHAVE) WRITE (ITB,9013)
- RETURN
-
- 91 CALL PRTEST
- WRITE (ITB,9091) NTUSE, NHAVE
- RETURN
-
- 9001 FORMAT (5H TEST,I5,' FAILED, Hex dump follows'/)
- 9091 FORMAT (1X/' Verify vector for test',I6,' more than 200 words,',
- F' NAMELY',I5)
-
-* from machine patch
-#include "verifmt.inc"
-
- 9013 FORMAT (1X)
- END
diff --git a/src/packlib/kernlib/kerngen/test/micky/mveuns.F b/src/packlib/kernlib/kerngen/test/micky/mveuns.F
deleted file mode 100644
index 985be45..0000000
--- a/src/packlib/kernlib/kerngen/test/micky/mveuns.F
+++ /dev/null
@@ -1,30 +0,0 @@
-*
-* $Id: mveuns.F,v 1.1.1.1 1996/02/15 17:54:54 mclareni Exp $
-*
-* $Log: mveuns.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:54 mclareni
-* Kernlib
-*
-*
-#include "kerngent/pilot.h"
- SUBROUTINE MVEUNS (CHPR,ND)
-
-C- Scan CHPR for unseen character, print message
-C- and replace by !
-
-#include "kerngent/mkcde.inc"
-
- CHARACTER CHPR*(*)
-
-
- NU = LEN (CHPR)
- 24 JUNS = ICLUNS (CHPR,1,NU)
- IF (JUNS.EQ.0) RETURN
-
- JCH = ICHAR(CHPR(JUNS:JUNS))
- CHPR(JUNS:JUNS) = '!'
- WRITE (ITB,9024) JUNS+ND,JCH
- GO TO 24
-
- 9024 FORMAT (10X,'Character',I4,' is unseen of value',I4)
- END
diff --git a/src/packlib/kernlib/kerngen/test/micky/newguy.F b/src/packlib/kernlib/kerngen/test/micky/newguy.F
deleted file mode 100644
index ea4319e..0000000
--- a/src/packlib/kernlib/kerngen/test/micky/newguy.F
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: newguy.F,v 1.1.1.1 1996/02/15 17:54:54 mclareni Exp $
-*
-* $Log: newguy.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:54 mclareni
-* Kernlib
-*
-*
-#include "kerngent/pilot.h"
- SUBROUTINE NEWGUY (TEXT,ROUT)
-
-#include "kerngent/mkcde.inc"
-
- CHARACTER TEXT*(*), ROUT*(*)
-
-
- CALL PRTEST
- NFAIL = 0
-
- WRITE (ITB,9000)
- 9000 FORMAT (1X/1X,69(1H-))
-
- WRITE (ITB,9020) ROUT, TEXT
- 9020 FORMAT (/' Routine ',A, 'testing ',A)
-
- WRITE (ITB,9021)
- 9021 FORMAT (1X)
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/test/micky/prtest.F b/src/packlib/kernlib/kerngen/test/micky/prtest.F
deleted file mode 100644
index 24e8726..0000000
--- a/src/packlib/kernlib/kerngen/test/micky/prtest.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: prtest.F,v 1.1.1.1 1996/02/15 17:54:54 mclareni Exp $
-*
-* $Log: prtest.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:54 mclareni
-* Kernlib
-*
-*
-#include "kerngent/pilot.h"
- SUBROUTINE PRTEST
-
-#include "kerngent/mkcde.inc"
-
-
- IF (NTEST.LE.0) RETURN
- IF (NFAIL.NE.0) GO TO 21
-
- WRITE (ITB,9007) (MTESTV(J),J=1,NTEST)
- NTEST = 0
- RETURN
-
- 21 WRITE (ITB,9027) (MTESTV(J),J=1,NTEST)
- NTEST = 0
- RETURN
-
- 9007 FORMAT (' Tests pass',10I6)
- 9027 FORMAT (' TESTS FAIL',10I6)
- END
diff --git a/src/packlib/kernlib/kerngen/test/micky/tchdir.F b/src/packlib/kernlib/kerngen/test/micky/tchdir.F
deleted file mode 100644
index 5cdde30..0000000
--- a/src/packlib/kernlib/kerngen/test/micky/tchdir.F
+++ /dev/null
@@ -1,82 +0,0 @@
-*
-* $Id: tchdir.F,v 1.1.1.1 1996/02/15 17:54:54 mclareni Exp $
-*
-* $Log: tchdir.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:54 mclareni
-* Kernlib
-*
-*
-#include "kerngent/pilot.h"
-#if !defined(CERNLIB_QMIBM)
- SUBROUTINE TCHDIR
-
-C- Exercise some Unix system calls
-
-#include "kerngent/mkch.inc"
-#include "kerngent/mkcde.inc"
- COMMON /SLATE/ ISLATE(40)
-
- CHARACTER*128 CHCWD, CHHOME, CHNCW
- EQUIVALENCE (CHCWD,MKCOL(1)), (CHHOME,MKCOL(129)),
- + (CHNCW,MKCOL(257))
-
- INTEGER CHDIRF
-
-
- WRITE (ITB,9020)
- MKLINE = ' '
-
- CALL GETWDF (CHCWD)
- NCWD = ISLATE(1)
- IF (NCWD.LE.0) GO TO 61
- WRITE (ITB,9021) CHCWD(1:NCWD+2)
-
- CALL GETENVF ('HOME',CHHOME)
- NHOME = ISLATE(1)
- IF (NHOME.LE.0) GO TO 62
- WRITE (ITB,9022) CHHOME(1:NHOME+2)
-
- WRITE (ITB,9023) CHHOME(1:NHOME+2)
- ISTAT = CHDIRF (CHHOME(1:NHOME))
- IF (ISTAT.NE.0) GO TO 63
-
- CALL GETWDF (CHNCW)
- NNCW = ISLATE(1)
- IF (NNCW.LE.0) GO TO 61
- WRITE (ITB,9021) CHNCW(1:NNCW+2)
-
- WRITE (ITB,9023) CHCWD(1:NCWD+2)
- ISTAT = CHDIRF (CHCWD(1:NCWD))
- IF (ISTAT.NE.0) GO TO 63
-
- CALL GETWDF (CHNCW)
- NNCW = ISLATE(1)
- IF (NNCW.LE.0) GO TO 61
- WRITE (ITB,9021) CHNCW(1:NNCW+2)
- RETURN
-
- 9020 FORMAT (/' Try some Unix system calls'/)
- 9021 FORMAT (' get c.w.d.: ',A)
- 9022 FORMAT (' get HOME: ',A)
- 9023 FORMAT (' set c.w.d.: ',A)
-
-C-- Failures
-
- 61 WRITE (ITB,9061)
- GO TO 68
-
- 62 WRITE (ITB,9062)
- GO TO 68
-
- 63 WRITE (ITB,9063)
- 68 CONTINUE
-#if defined(CERNLIB_QUNIX)
- CALL PERRORF ('*** trouble')
-#endif
- RETURN
-
- 9061 FORMAT (/' !!! calling GETWDF fails !!!')
- 9062 FORMAT (/' !!! calling GETENVF fails !!!')
- 9063 FORMAT (/' !!! calling CHDIRF fails !!!')
- END
-#endif
diff --git a/src/packlib/kernlib/kerngen/test/micky/time77.F b/src/packlib/kernlib/kerngen/test/micky/time77.F
deleted file mode 100644
index 885d515..0000000
--- a/src/packlib/kernlib/kerngen/test/micky/time77.F
+++ /dev/null
@@ -1,36 +0,0 @@
-*
-* $Id: time77.F,v 1.1.1.1 1996/02/15 17:54:54 mclareni Exp $
-*
-* $Log: time77.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:54 mclareni
-* Kernlib
-*
-*
-#include "kerngent/pilot.h"
- SUBROUTINE TIME77 (NCALLS,CHNAME,NITEMS,CHITEM)
-
-#include "kerngent/mkcde.inc"
-
- CHARACTER CHNAME*(*), CHITEM*(*)
- CHARACTER SRNAME*6, ITEM*8
-
-
- CALL TIMED (TIMERD)
- MILLIS = 1000. * TIMERD
-
- SRNAME = CHNAME
- ITEM = CHITEM
-
- IF (NTEST.NE.0) CALL PRTEST
-
- IF (NITEMS.GT.0) THEN
- WRITE (ITB,9001) NCALLS,SRNAME,NITEMS,ITEM,MILLIS
- ELSE
- WRITE (ITB,9002) NCALLS,SRNAME,MILLIS
- ENDIF
- RETURN
-
- 9001 FORMAT (1X,I12,' calls to ',A,' for',I6,1X,A,' took',I6,
- F' milli-seconds.')
- 9002 FORMAT (1X,I12,' calls to ',A,' took',I6,' milli-seconds.')
- END
diff --git a/src/packlib/kernlib/kerngen/test/micky/timing.F b/src/packlib/kernlib/kerngen/test/micky/timing.F
deleted file mode 100644
index b2fd886..0000000
--- a/src/packlib/kernlib/kerngen/test/micky/timing.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: timing.F,v 1.1.1.1 1996/02/15 17:54:54 mclareni Exp $
-*
-* $Log: timing.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:54 mclareni
-* Kernlib
-*
-*
-#include "kerngent/pilot.h"
- SUBROUTINE TIMING(TINF)
-
-#include "kerngent/mkcde.inc"
-
- DIMENSION TINF(4),INF(5)
-
-
- CALL TIMED (TIMERD)
- INF(5) = 1000. * TIMERD
-
- IF (NTEST.NE.0) CALL PRTEST
-
- CALL UCOPY (TINF,INF,4)
- WRITE (ITB,9000) INF
- RETURN
-
- 9000 FORMAT (1X,I12,' CALLS TO ',A6,' FOR',I6,1X,A6,' TOOK',I6,
- F' MILLI-SECONDS.')
- END
diff --git a/src/packlib/kernlib/kerngen/test/micky/verifmt.inc b/src/packlib/kernlib/kerngen/test/micky/verifmt.inc
deleted file mode 100644
index 475c399..0000000
--- a/src/packlib/kernlib/kerngen/test/micky/verifmt.inc
+++ /dev/null
@@ -1,14 +0,0 @@
-*
-* $Id: verifmt.inc,v 1.1.1.1 1996/02/15 17:54:54 mclareni Exp $
-*
-* $Log: verifmt.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:54:54 mclareni
-* Kernlib
-*
-*
-* FOR P=MICKY, D=MVERII/MVERIF
-*
-* verifmt.inc
-*
- 9011 FORMAT (I10,5H MUST,5(Z10,11X))
- 9012 FORMAT (10X,5H HAVE,5(Z10,11X)/1X)
diff --git a/src/packlib/kernlib/kerngen/test/npbyt/Imakefile b/src/packlib/kernlib/kerngen/test/npbyt/Imakefile
deleted file mode 100644
index 838f813..0000000
--- a/src/packlib/kernlib/kerngen/test/npbyt/Imakefile
+++ /dev/null
@@ -1,4 +0,0 @@
-SRCS_F= \ @@\
- tbyt.F tmbyt.F tvcbyt.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kerngen/test/npbyt/tbyt.F b/src/packlib/kernlib/kerngen/test/npbyt/tbyt.F
deleted file mode 100644
index 41f2365..0000000
--- a/src/packlib/kernlib/kerngen/test/npbyt/tbyt.F
+++ /dev/null
@@ -1,432 +0,0 @@
-*
-* $Id: tbyt.F,v 1.1.1.1 1996/02/15 17:54:59 mclareni Exp $
-*
-* $Log: tbyt.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:59 mclareni
-* Kernlib
-*
-*
-#include "kerngent/pilot.h"
- SUBROUTINE TBYT
-
-#include "kerngent/mkcde.inc"
-
- DATA IALL1 / 16777215 /
-
- JINIT (JZ) = 7*JZ + 5
-
-C------- TEST JBIT - JBYT
-
- CALL NEWGUY ('JBIT - JBYT.','TBYT ')
-
- MCUM = 0
- DO 12 JL=1,22,4
-C- JB = 0 4 8 12 16 20
- JB = JL -1
- MCUM = MCUM*16 + 5
- MUSE = MCUM
-
- IA(JB+101) = JBIT (MUSE,JB+1)
- IA(JB+102) = JBIT (MUSE,JB+2)
- IA(JB+103) = JBIT (MUSE,JB+3)
- IA(JB+104) = JBIT (MUSE,JB+4)
-
- IB(JB+101) = 1
- IB(JB+102) = 0
- IB(JB+103) = 1
- IB(JB+104) = 0
-
- IA(JB+201) = JBYT (MUSE,JB+1,1)
- IA(JB+202) = JBYT (MUSE,JB+2,1)
- IA(JB+203) = JBYT (MUSE,JB+3,1)
- IA(JB+204) = JBYT (MUSE,JB+4,1)
-
- IB(JB+201) = 1
- IB(JB+202) = 0
- IB(JB+203) = 1
- IB(JB+204) = 0
-
- IA(JB+301) = JBYT (MUSE,JB+1,2)
- IA(JB+302) = JBYT (MUSE,JB+2,2)
- IA(JB+303) = JBYT (MUSE,JB+3,2)
- IA(JB+304) = JBYT (MUSE,JB+4,2)
-
- IB(JB+301) = 1
- IB(JB+302) = 2
- IB(JB+303) = 1
- IB(JB+304) = 0
-
- IA(JB+401) = JBYT (MUSE,JB+1,3)
- IA(JB+402) = JBYT (MUSE,JB+2,3)
- IA(JB+403) = JBYT (MUSE,JB+3,3)
- IA(JB+404) = JBYT (MUSE,JB+4,3)
-
- IB(JB+401) = 5
- IB(JB+402) = 2
- IB(JB+403) = 1
- IB(JB+404) = 0
-
- IA(JB+501) = JBYT (MUSE,JB+1,4)
- IA(JB+502) = JBYT (MUSE,JB+2,4)
- IA(JB+503) = JBYT (MUSE,JB+3,4)
- IA(JB+504) = JBYT (MUSE,JB+4,4)
-
- IB(JB+501) = 5
- IB(JB+502) = 2
- IB(JB+503) = 1
- IB(JB+504) = 0
- 12 CONTINUE
-
- CALL MVERII (1,IA(101),IB(101),24)
- CALL MVERII (2,IA(201),IB(201),24)
- CALL MVERII (3,IA(301),IB(301),24)
- CALL MVERII (4,IA(401),IB(401),24)
- CALL MVERII (5,IA(501),IB(501),24)
-
-C------- TEST SBIT0 - SBIT1 - SBIT
-
- CALL NEWGUY ('SBIT0 - SBIT1 - SBIT.','TBYT ')
-
- IONE = 1
- DO 14 JB=1,23
- IA(JB+100) = 0
- IA(JB+200) = 0
- IA(JB+300) = IALL1
- IA(JB+400) = IALL1
- CALL SBIT1 (IA(JB+100),JB)
- CALL SBIT (1,IA(JB+200),JB)
- CALL SBIT0 (IA(JB+300),JB)
- CALL SBIT (0,IA(JB+400),JB)
-
- IB(JB+100) = IONE
- IB(JB+300) = IALL1 - IONE
- 14 IONE = 2*IONE
-
- CALL MVERII (1,IA(101),IB(101),23)
- CALL MVERII (2,IA(201),IB(101),23)
- CALL MVERII (3,IA(301),IB(301),23)
- CALL MVERII (4,IA(401),IB(301),23)
-
-C------- TEST SBYT
-
- CALL NEWGUY ('SBYT.','TBYT ')
-
- MSHIF = 1
- DO 18 JB=1,21
-
- MCUM = MSHIF
- MTMP = MSHIF
- DO 17 NBITS=1,4
- JV = 100*NBITS
-
- IA(JB+JV) = 0
- CALL SBYT (JB,IA(JB+JV),JB,NBITS)
-
- IA(JB+JV+400) = IALL1
- CALL SBYT (JB,IA(JB+JV+400),JB,NBITS)
-
- IB(JB+JV) = MSHIF * JBYT(JB,1,NBITS)
- IB(JB+JV+400) = IALL1 - MCUM + IB(JB+JV)
- MTMP = 2*MTMP
- 17 MCUM = MCUM + MTMP
- 18 MSHIF = 2*MSHIF
-
- CALL MVERII (1,IA(101),IB(101),21)
- CALL MVERII (2,IA(201),IB(201),21)
- CALL MVERII (3,IA(301),IB(301),21)
- CALL MVERII (4,IA(401),IB(401),21)
- CALL MVERII (5,IA(501),IB(501),21)
- CALL MVERII (6,IA(601),IB(601),21)
- CALL MVERII (7,IA(701),IB(701),21)
- CALL MVERII (8,IA(801),IB(801),21)
- CALL PRTEST
-
-C---- CROSS-USE SBYT - JBYT
-
- DO 24 NBITS=1,IQBITW
- NDO = IQBITW + 1 - NBITS
-
- DO 23 JB=1,NDO
- JPREA = JINIT(JB)
- JPREN = -JPREA
- JVALA = JB - 1
- JVALN = -JVALA
-
- IA(1) = JPREA
- IA(2) = JPREN
- IA(3) = JPREA
- IA(4) = JPREN
-
- CALL SBYT (JVALA,IA(1), JB,NBITS)
- CALL SBYT (JVALA,IA(2), JB,NBITS)
- CALL SBYT (JVALN,IA(3), JB,NBITS)
- CALL SBYT (JVALN,IA(4), JB,NBITS)
-
- IA(JB+100) = JBYT (IA(1),JB,NBITS)
- IA(JB+200) = JBYT (IA(2),JB,NBITS)
- IA(JB+300) = JBYT (IA(3),JB,NBITS)
- IA(JB+400) = JBYT (IA(4),JB,NBITS)
-
- IB(JB+100) = JBYT (JVALA, 1,NBITS)
- IB(JB+300) = JBYT (JVALN, 1,NBITS)
- 23 CONTINUE
-
- CALL MVERII (10*NBITS+1,IA(101),IB(101),NDO)
- CALL MVERII (10*NBITS+2,IA(201),IB(101),NDO)
- CALL MVERII (10*NBITS+3,IA(301),IB(301),NDO)
- CALL MVERII (10*NBITS+4,IA(401),IB(301),NDO)
- IF (JBIT(NBITS,1).EQ.0) CALL PRTEST
- 24 CONTINUE
-
-C------- TEST CBYT
-
- CALL NEWGUY ('CBYT.','TBYT ')
-
- DO 28 NBITS=1,IQBITW
- NDO = IQBITW + 1 - NBITS
-
- DO 27 JB=1,NDO
- JPREA = JINIT(JB)
- JPREN = -JPREA
- JVALA = JB - 1
- JVALN = -JVALA
-
- IB(JB+100) = JPREA
- IB(JB+200) = JPREN
- IB(JB+300) = JPREA
- IB(JB+400) = JPREN
-
- CALL SBYT (JVALA,IB(JB+100), JB,NBITS)
- CALL SBYT (JVALA,IB(JB+200), JB,NBITS)
- CALL SBYT (JVALN,IB(JB+300), JB,NBITS)
- CALL SBYT (JVALN,IB(JB+400), JB,NBITS)
-
- IA(JB+100) = JPREA
- IA(JB+200) = JPREN
- IA(JB+300) = JPREA
- IA(JB+400) = JPREN
-
- CALL CBYT (IB(JB+100),JB, IA(JB+100),JB,NBITS)
- CALL CBYT (IB(JB+200),JB, IA(JB+200),JB,NBITS)
- CALL CBYT (IB(JB+300),JB, IA(JB+300),JB,NBITS)
- CALL CBYT (IB(JB+400),JB, IA(JB+400),JB,NBITS)
-
- 27 CONTINUE
-
- CALL MVERII (10*NBITS+1,IA(101),IB(101),NDO)
- CALL MVERII (10*NBITS+2,IA(201),IB(201),NDO)
- CALL MVERII (10*NBITS+3,IA(301),IB(301),NDO)
- CALL MVERII (10*NBITS+4,IA(401),IB(401),NDO)
- IF (JBIT(NBITS,1).EQ.0) CALL PRTEST
- 28 CONTINUE
-
-C------- TEST SBYTOR - JBYTET
-
- CALL NEWGUY ('SBYTOR - JBYTET.','TBYT ')
-
- DO 38 NBITS=1,21,3
- NDO = IQBITW + 1 - NBITS
-
- DO 37 JB=1,NDO
- JPREA = JINIT(JB)
- JPREN = -JPREA
- JVALA = JB - 1
- JVALN = -JVALA
-
- IB(100) = JVALA
- IB(200) = JVALA
- IB(300) = JVALN
- IB(400) = JVALN
-
- IA(JB+100) = JPREA
- IA(JB+200) = JPREN
- IA(JB+300) = JPREA
- IA(JB+400) = JPREN
-
- IA(JB+500) = JPREA
- IA(JB+600) = JPREN
- IA(JB+700) = JPREA
- IA(JB+800) = JPREN
-
- CALL SBYTOR (JVALA,IA(JB+100), JB,NBITS)
- CALL SBYTOR (0,IA(JB+100), JB,NBITS)
- CALL SBYTOR (JVALA,IA(JB+200), JB,NBITS)
- CALL SBYTOR (0,IA(JB+200), JB,NBITS)
- CALL SBYTOR (JVALN,IA(JB+300), JB,NBITS)
- CALL SBYTOR (0,IA(JB+300), JB,NBITS)
- CALL SBYTOR (JVALN,IA(JB+400), JB,NBITS)
- CALL SBYTOR (0,IA(JB+400), JB,NBITS)
-
- IA(JB+500) = JBYTET (JVALA,IA(JB+500), JB,NBITS)
- IA(JB+600) = JBYTET (JVALA,IA(JB+600), JB,NBITS)
- IA(JB+700) = JBYTET (JVALN,IA(JB+700), JB,NBITS)
- IA(JB+800) = JBYTET (JVALN,IA(JB+800), JB,NBITS)
-
- IB(JB+100) = JPREA
- IB(JB+200) = JPREN
- IB(JB+300) = JPREA
- IB(JB+400) = JPREN
-
- IB(JB+500) = JPREA
- IB(JB+600) = JPREN
- IB(JB+700) = JPREA
- IB(JB+800) = JPREN
-
- DO 36 JV=100,400,100
- MMET = 0
- MMOR = 0
- MBIT = 1
-
- DO 35 J=1,NBITS
- IP = JBIT (IB(JB+JV),JB+J-1)
- IV = JBIT (IB(JV),J)
-
- IF ((IP.EQ.1) .OR. (IV.EQ.1)) MMOR=MMOR+MBIT
- IF ((IP.EQ.1) .AND. (IV.EQ.1)) MMET=MMET+MBIT
- 35 MBIT = 2*MBIT
-
- CALL SBYT (MMOR,IB(JB+JV),JB,NBITS)
- IB(JB+JV+400) = MMET
- 36 CONTINUE
- 37 CONTINUE
-
- CALL MVERII (10*NBITS+1,IA(101),IB(101),NDO)
- CALL MVERII (10*NBITS+2,IA(201),IB(201),NDO)
- CALL MVERII (10*NBITS+3,IA(301),IB(301),NDO)
- CALL MVERII (10*NBITS+4,IA(401),IB(401),NDO)
- CALL MVERII (10*NBITS+5,IA(501),IB(501),NDO)
- CALL MVERII (10*NBITS+6,IA(601),IB(601),NDO)
- CALL MVERII (10*NBITS+7,IA(701),IB(701),NDO)
- CALL MVERII (10*NBITS+8,IA(801),IB(801),NDO)
- CALL PRTEST
- 38 CONTINUE
-
-C------- TEST JRSBYT
-
- CALL NEWGUY ('JRSBYT.','TBYT ')
-
- DO 48 NBITS=1,IQBITW,3
- NDO = IQBITW + 1 - NBITS
-
- DO 47 JB=1,NDO
- JPREA = JINIT(JB)
- JPREN = -JPREA
- JVALA = JB - 1
- JVALN = -JVALA
-
- IA(JB+100) = JPREA
- IA(JB+200) = JPREN
- IA(JB+300) = JPREA
- IA(JB+400) = JPREN
-
- IA(JB+500) = JRSBYT (JVALA, IA(JB+100),JB,NBITS)
- IA(JB+600) = JRSBYT (JVALA, IA(JB+200),JB,NBITS)
- IA(JB+700) = JRSBYT (JVALN, IA(JB+300),JB,NBITS)
- IA(JB+800) = JRSBYT (JVALN, IA(JB+400),JB,NBITS)
-
- IB(JB+100) = JPREA
- IB(JB+200) = JPREN
- IB(JB+300) = JPREA
- IB(JB+400) = JPREN
-
- IB(JB+500) = JBYT (IB(JB+100),JB,NBITS)
- IB(JB+600) = JBYT (IB(JB+200),JB,NBITS)
- IB(JB+700) = JBYT (IB(JB+300),JB,NBITS)
- IB(JB+800) = JBYT (IB(JB+400),JB,NBITS)
-
- CALL SBYT (JVALA, IB(JB+100),JB,NBITS)
- CALL SBYT (JVALA, IB(JB+200),JB,NBITS)
- CALL SBYT (JVALN, IB(JB+300),JB,NBITS)
- CALL SBYT (JVALN, IB(JB+400),JB,NBITS)
-
- 47 CONTINUE
-
- CALL MVERII (10*NBITS+1,IA(101),IB(101),NDO)
- CALL MVERII (10*NBITS+2,IA(501),IB(501),NDO)
- CALL MVERII (10*NBITS+3,IA(201),IB(201),NDO)
- CALL MVERII (10*NBITS+4,IA(601),IB(601),NDO)
- CALL MVERII (10*NBITS+5,IA(301),IB(301),NDO)
- CALL MVERII (10*NBITS+6,IA(701),IB(701),NDO)
- CALL MVERII (10*NBITS+7,IA(401),IB(401),NDO)
- CALL MVERII (10*NBITS+8,IA(801),IB(801),NDO)
- CALL PRTEST
- 48 CONTINUE
-
-C-- TIMING
-
- IF (ITIMES.EQ.0) RETURN
- NTIMES = ITIMES * 10000
-
- CALL TIMED (TIMERD)
- DO 61 JN=1,ITIMES
- DO 61 JM=1,400
- DO 61 JL=1,25
- IA(JL+JM) = JBIT (JL,JL+4)
- 61 CONTINUE
- CALL TIME77 (NTIMES,'JBIT ',0,' ')
-
- CALL TIMED (TIMERD)
- DO 62 JN=1,ITIMES
- DO 62 JM=1,400
- DO 62 JL=1,25
- IA(JL+JM) = JBYT (JL,JL+2,26-JL)
- 62 CONTINUE
- CALL TIME77 (NTIMES,'JBYT ',0,' ')
-
- CALL TIMED (TIMERD)
- DO 63 JN=1,ITIMES
- DO 63 JM=1,400
- DO 63 JL=1,25
- CALL SBIT0 (IA(JL+JM),JL+4)
- 63 CONTINUE
- CALL TIME77 (NTIMES,'SBIT0 ',0,' ')
-
- CALL TIMED (TIMERD)
- DO 64 JN=1,ITIMES
- DO 64 JM=1,400
- DO 64 JL=1,25
- CALL SBIT1 (IA(JL+JM),JL+4)
- 64 CONTINUE
- CALL TIME77 (NTIMES,'SBIT1 ',0,' ')
-
- CALL TIMED (TIMERD)
- DO 65 JN=1,ITIMES
- DO 65 JM=1,400
- DO 65 JL=1,25
- CALL SBIT (JL+7,IA(JL+JM),JL+4)
- 65 CONTINUE
- CALL TIME77 (NTIMES,'SBIT ',0,' ')
-
- CALL TIMED (TIMERD)
- DO 66 JN=1,ITIMES
- DO 66 JM=1,400
- DO 66 JL=1,25
- CALL SBYT (JL,IA(JL+JM+1),JL+2,26-JL)
- 66 CONTINUE
- CALL TIME77 (NTIMES,'SBYT ',0,' ')
-
- CALL TIMED (TIMERD)
- DO 67 JN=1,ITIMES
- DO 67 JM=1,400
- DO 67 JL=1,25
- CALL CBYT (JL,JL+4,IA(JL+JM+1),JL+2,26-JL)
- 67 CONTINUE
- CALL TIME77 (NTIMES,'CBYT ',0,' ')
-
- CALL TIMED (TIMERD)
- DO 68 JN=1,ITIMES
- DO 68 JM=1,400
- DO 68 JL=1,25
- CALL SBYTOR (JL,IA(JL+JM+1),JL+2,26-JL)
- 68 CONTINUE
- CALL TIME77 (NTIMES,'SBYTOR',0,' ')
-
- CALL TIMED (TIMERD)
- DO 69 JN=1,ITIMES
- DO 69 JM=1,400
- DO 69 JL=1,25
- IA(JL+JM) = JBYTET (JL,IA(JL+JM+1),JL+2,26-JL)
- 69 CONTINUE
- CALL TIME77 (NTIMES,'JBYTET',0,' ')
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/test/npbyt/tmbyt.F b/src/packlib/kernlib/kerngen/test/npbyt/tmbyt.F
deleted file mode 100644
index c576676..0000000
--- a/src/packlib/kernlib/kerngen/test/npbyt/tmbyt.F
+++ /dev/null
@@ -1,227 +0,0 @@
-*
-* $Id: tmbyt.F,v 1.1.1.1 1996/02/15 17:54:59 mclareni Exp $
-*
-* $Log: tmbyt.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:59 mclareni
-* Kernlib
-*
-*
-#include "kerngent/pilot.h"
- SUBROUTINE TMBYT
-
-#include "kerngent/mkcde.inc"
-
-
- JINIT (JZ) = 7*JZ + 5
- NBITM2 = IQBITW - 2
-
-C------- TEST MSBIT0 - MSBIT1 - MSBIT
-
- CALL NEWGUY ('MSBIT0 - MSBIT1 - MSBIT.','TMBYT ')
-
- DO 14 J=1,IQBITW
-
- JPREA = JINIT(J)
- JPREN = -JPREA
-
- IA(J+100) = MSBIT0 (JPREA,J)
- IA(J+200) = MSBIT0 (JPREN,J)
- IA(J+300) = MSBIT1 (JPREA,J)
- IA(J+400) = MSBIT1 (JPREN,J)
- IA(J+500) = MSBIT (J+1,JPREA,J)
- IA(J+600) = MSBIT (J+2,JPREN,J)
-
- IB(J+100) = JPREA
- IB(J+200) = JPREN
- IB(J+300) = JPREA
- IB(J+400) = JPREN
- IB(J+500) = JPREA
- IB(J+600) = JPREN
-
- CALL SBIT0 (IB(J+100),J)
- CALL SBIT0 (IB(J+200),J)
-
- CALL SBIT1 (IB(J+300),J)
- CALL SBIT1 (IB(J+400),J)
-
- CALL SBIT (J+1,IB(J+500),J)
- CALL SBIT (J+2,IB(J+600),J)
- 14 CONTINUE
-
- CALL MVERII (1,IA(101),IB(101),IQBITW)
- CALL MVERII (2,IA(201),IB(201),IQBITW)
- CALL MVERII (3,IA(301),IB(301),IQBITW)
- CALL MVERII (4,IA(401),IB(401),IQBITW)
- CALL MVERII (5,IA(501),IB(501),IQBITW)
- CALL MVERII (6,IA(601),IB(601),IQBITW)
-
-C------- TEST MSBYT - MCBYT
-
- CALL NEWGUY ('MSBYT - MCBYT.','TMBYT ')
-
- DO 24 NBITS=1,NBITM2
- NDO = IQBITW + 1 - NBITS
-
- DO 23 J=1,NDO
- JPREA = JINIT(J)
- JPREN = -JPREA
- JVALA = J - 1
- JVALN = -JVALA
-
- IB(J+100) = JPREA
- IB(J+200) = JPREN
- IB(J+300) = JPREA
- IB(J+400) = JPREN
- IB(J+500) = JPREA
- IB(J+600) = JPREN
- IB(J+700) = JPREA
- IB(J+800) = JPREN
-
- CALL SBYT (JVALA,IB(J+100), J,NBITS)
- CALL SBYT (JVALA,IB(J+200), J,NBITS)
- CALL SBYT (JVALN,IB(J+300), J,NBITS)
- CALL SBYT (JVALN,IB(J+400), J,NBITS)
-
- CALL CBYT (IB(J+200),J, IB(J+500), J,NBITS)
- CALL CBYT (IB(J+100),J, IB(J+600), J,NBITS)
- CALL CBYT (IB(J+400),J, IB(J+700), J,NBITS)
- CALL CBYT (IB(J+300),J, IB(J+800), J,NBITS)
-
- IA(J+100) = MSBYT (JVALA,JPREA, J,NBITS)
- IA(J+200) = MSBYT (JVALA,JPREN, J,NBITS)
- IA(J+300) = MSBYT (JVALN,JPREA, J,NBITS)
- IA(J+400) = MSBYT (JVALN,JPREN, J,NBITS)
-
- IA(J+500) = MCBYT (IB(J+200),J, JPREA, J,NBITS)
- IA(J+600) = MCBYT (IB(J+100),J, JPREN, J,NBITS)
- IA(J+700) = MCBYT (IB(J+400),J, JPREA, J,NBITS)
- IA(J+800) = MCBYT (IB(J+300),J, JPREN, J,NBITS)
- 23 CONTINUE
-
- CALL MVERII (10*NBITS+1,IA(101),IB(101),NDO)
- CALL MVERII (10*NBITS+2,IA(201),IB(201),NDO)
- CALL MVERII (10*NBITS+3,IA(301),IB(301),NDO)
- CALL MVERII (10*NBITS+4,IA(401),IB(401),NDO)
- CALL MVERII (10*NBITS+5,IA(501),IB(501),NDO)
- CALL MVERII (10*NBITS+6,IA(601),IB(601),NDO)
- CALL MVERII (10*NBITS+7,IA(701),IB(701),NDO)
- CALL MVERII (10*NBITS+8,IA(801),IB(801),NDO)
- CALL PRTEST
- 24 CONTINUE
-
-C------- TEST MBYTOR - MBYTET
-
- CALL NEWGUY ('MBYTOR - MBYTET.','TMBYT ')
-
- DO 34 NBITS=1,NBITM2,3
- NDO = IQBITW + 1 - NBITS
-
- DO 33 J=1,NDO
- JPREA = JINIT(J)
- JPREN = -JPREA
- JVALA = J - 1
- JVALN = -JVALA
-
- IA(J+100) = MBYTOR (JVALA,JPREA, J,NBITS)
- IA(J+200) = MBYTOR (JVALA,JPREN, J,NBITS)
- IA(J+300) = MBYTOR (JVALN,JPREA, J,NBITS)
- IA(J+400) = MBYTOR (JVALN,JPREN, J,NBITS)
-
- IA(J+500) = MBYTET (JVALA,JPREA, J,NBITS)
- IA(J+600) = MBYTET (JVALA,JPREN, J,NBITS)
- IA(J+700) = MBYTET (JVALN,JPREA, J,NBITS)
- IA(J+800) = MBYTET (JVALN,JPREN, J,NBITS)
-
- IB(J+100) = JPREA
- IB(J+200) = JPREN
- IB(J+300) = JPREA
- IB(J+400) = JPREN
- IB(J+500) = JPREA
- IB(J+600) = JPREN
- IB(J+700) = JPREA
- IB(J+800) = JPREN
-
- CALL SBYTOR (JVALA,IB(J+100), J,NBITS)
- CALL SBYTOR (JVALA,IB(J+200), J,NBITS)
- CALL SBYTOR (JVALN,IB(J+300), J,NBITS)
- CALL SBYTOR (JVALN,IB(J+400), J,NBITS)
-
- CALL SBYT (JBYTET (JVALA,IB(J+500),J,NBITS), IB(J+500),J,NBITS)
- CALL SBYT (JBYTET (JVALA,IB(J+600),J,NBITS), IB(J+600),J,NBITS)
- CALL SBYT (JBYTET(JVALN,IB(J+700),J,NBITS), IB(J+700),J,NBITS)
- CALL SBYT (JBYTET(JVALN,IB(J+800),J,NBITS), IB(J+800),J,NBITS)
- 33 CONTINUE
-
- CALL MVERII (10*NBITS+1,IA(101),IB(101),NDO)
- CALL MVERII (10*NBITS+2,IA(201),IB(201),NDO)
- CALL MVERII (10*NBITS+3,IA(301),IB(301),NDO)
- CALL MVERII (10*NBITS+4,IA(401),IB(401),NDO)
- CALL MVERII (10*NBITS+5,IA(501),IB(501),NDO)
- CALL MVERII (10*NBITS+6,IA(601),IB(601),NDO)
- CALL MVERII (10*NBITS+7,IA(701),IB(701),NDO)
- CALL MVERII (10*NBITS+8,IA(801),IB(801),NDO)
- CALL PRTEST
- 34 CONTINUE
-
-C-- TIMING
-
- IF (ITIMES.EQ.0) RETURN
- NTIMES = ITIMES * 10000
-
- CALL TIMED (TIMERD)
- DO 61 JN=1,ITIMES
- DO 61 JM=1,400
- DO 61 JL=1,25
- IA(JL+JM) = MSBIT0 (JL,JL+4)
- 61 CONTINUE
- CALL TIME77 (NTIMES,'MSBIT0',0,' ')
-
- CALL TIMED (TIMERD)
- DO 62 JN=1,ITIMES
- DO 62 JM=1,400
- DO 62 JL=1,25
- IA(JL+JM) = MSBIT1 (JL,JL+4)
- 62 CONTINUE
- CALL TIME77 (NTIMES,'MSBIT1',0,' ')
-
- CALL TIMED (TIMERD)
- DO 63 JN=1,ITIMES
- DO 63 JM=1,400
- DO 63 JL=1,25
- IA(JL+JM) = MSBIT (JL+7,JL,JL+4)
- 63 CONTINUE
- CALL TIME77 (NTIMES,'MSBIT ',0,' ')
-
- CALL TIMED (TIMERD)
- DO 64 JN=1,ITIMES
- DO 64 JM=1,400
- DO 64 JL=1,25
- IA(JL+JM) = MSBYT (JL,IA(JL+JM+1),JL+2,26-JL)
- 64 CONTINUE
- CALL TIME77 (NTIMES,'MSBYT ',0,' ')
-
- CALL TIMED (TIMERD)
- DO 65 JN=1,ITIMES
- DO 65 JM=1,400
- DO 65 JL=1,25
- IA(JL+JM) = MCBYT (JL,JL+4,IA(JL+JM+1),JL+2,26-JL)
- 65 CONTINUE
- CALL TIME77 (NTIMES,'MCBYT ',0,' ')
-
- CALL TIMED (TIMERD)
- DO 66 JN=1,ITIMES
- DO 66 JM=1,400
- DO 66 JL=1,25
- IA(JL+JM) = MBYTOR (JL,IA(JL+JM+1),JL+2,26-JL)
- 66 CONTINUE
- CALL TIME77 (NTIMES,'MBYTOR',0,' ')
-
- CALL TIMED (TIMERD)
- DO 67 JN=1,ITIMES
- DO 67 JM=1,400
- DO 67 JL=1,25
- IA(JL+JM) = MBYTET (JL,IA(JL+JM+1),JL+2,26-JL)
- 67 CONTINUE
- CALL TIME77 (NTIMES,'MBYTET',0,' ')
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/test/npbyt/tvcbyt.F b/src/packlib/kernlib/kerngen/test/npbyt/tvcbyt.F
deleted file mode 100644
index cacc2c7..0000000
--- a/src/packlib/kernlib/kerngen/test/npbyt/tvcbyt.F
+++ /dev/null
@@ -1,163 +0,0 @@
-*
-* $Id: tvcbyt.F,v 1.1.1.1 1996/02/15 17:54:59 mclareni Exp $
-*
-* $Log: tvcbyt.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:59 mclareni
-* Kernlib
-*
-*
-#include "kerngent/pilot.h"
- SUBROUTINE TVCBYT
-
-#include "kerngent/mkcde.inc"
-
- INTEGER XA
- DIMENSION MPACK1(3),MPACK2(3)
-
- CALL NEWGUY ('JBYTPK - SBYTPK - PKBYT - UPKBYT - INCBYT.'
- +, 'TVCBYT ')
-
-C-- PREPARE USEFUL CONSTANTS
- NBITCH=IQBITW/IQCHAW
- KMAX=2**NBITCH-1
- IBIT2=IQBITW+IQBITW
-
- MPACK1(1)=NBITCH
- MPACK1(2)=IQCHAW
- MPACK1(3)=KMAX
-
- NBIT2=NBITCH+1
- MPACK2(1)=NBIT2
- MPACK2(2)=IQBITW/NBIT2
- MPACK2(3)=KMAX+KMAX+1
- KMAX1=KMAX/2
-
-C-- PREPARE THE TEST VECTOR (IB)
- XA=0
- DO 5 I=1,50
- IB(I)=XA
- IB(I+150)=0
- IB(I+100)=XA+XA
- IF (IB(I+100).LE.KMAX1) GO TO 4
- IB(I+150)=IB(I+100)-KMAX1
- IB(I+100)=KMAX1
- 4 XA=XA+I
- IF (XA.GT.KMAX) XA=0
- 5 CONTINUE
-
- XA=0
- DO 8 I=1,IBIT2
- IB(I+202)=XA
- XA=XA+1
- IF (XA.EQ.2) XA=0
- 8 CONTINUE
-
-C-- FIRST CHECKS OF ROUTINES
- CALL UZERO (IA,1,200)
- XA=0
- DO 10 I=1,50
- IF (XA.GT.KMAX) XA=0
- CALL SBYTPK (XA,IA,I,MPACK1)
- CALL SBYTPK (XA,IA(51),I,MPACK2)
- 10 XA=XA+I
-
- XA=0
- DO 12 I=1,IBIT2
- CALL SBYTPK (XA,IA(201),I,0)
- XA=XA+1
- IF (XA.EQ.2) XA=0
- 12 CONTINUE
-
- DO 15 I=1,50
- IA(I+100)=JBYTPK (IA,I,MPACK1)
- IA(I+150)=JBYTPK (IA(51),I,MPACK2)
- 15 CONTINUE
-
- DO 18 I=1,IBIT2
- IA(I+202)=JBYTPK (IA(201),I,0)
- 18 CONTINUE
- CALL MVERII (1,IA(101),IB,50)
- CALL MVERII (2,IA(151),IB,50)
- CALL MVERII (3,IA(203),IB(203),IBIT2)
-
-C-- SECOND CHECKS OF ROUTINES
- NW1=49/IQCHAW+1
- NW2=49/MPACK2(2) +1
- CALL UCOPY (IA,IB(51),NW1)
- CALL UCOPY (IA(51),IB(NW1+51),NW2)
- CALL UZERO (IA,1,100)
-
- CALL UPKBYT (IB(51),1,IA,25,MPACK1)
- CALL UPKBYT (IB(51),26,IA(26),25,MPACK1)
- CALL PKBYT (IB,IA(51),1,25,MPACK1)
- CALL PKBYT (IB(26),IA(51),26,25,MPACK1)
- CALL MVERII (4,IA,IB,50+NW1)
-
- CALL UCOPY (IB(NW1+51),IB(51),NW2)
- CALL UZERO (IA,1,100)
- CALL UPKBYT (IB(51),1,IA,50,MPACK2)
- CALL PKBYT (IB,IA(51),1,50,MPACK2)
- CALL MVERII (5,IA,IB,50+NW2)
-
- IB(201)=IA(201)
- IB(202)=IA(202)
- CALL UZERO (IA,1,300)
- CALL UPKBYT (IB(201),1,IA(203),IBIT2,0)
- CALL PKBYT (IB(203),IA(201),1,IBIT2,0)
- CALL MVERII (6,IA(201),IB(201),IBIT2+2)
-
-C-- THIRD CHECK OF ROUTINE
- MPACK1(3)=KMAX1
- CALL PKBYT (IB,IA(101),1,50,MPACK1)
- XA=0
- DO 30 I=1,50
- IA(I+50)=INCBYT (XA,IA(101),I,MPACK1)
- XA=XA+I
- IF (XA.GT.KMAX) XA=0
- 30 CONTINUE
- CALL UPKBYT (IA(101),1,IA,50,MPACK1)
- CALL MVERII (7,IA,IB(101),100)
-
-C-- CHECK PKBYT NON-DESTRUCTIVE
-
- MPACK1(1) = 4 HEX
-C MPACK1(1) = 3 -HEX
- MPACK1(2) = 7
- CALL VFILL (IA,30,-7)
-
- JTH = 0
- JVAL = 0
-
- DO 43 JW=1,6
- JPOS = 1
-
- DO 42 JB=1,7
- CALL SBYT (JVAL,IA(JW+10),JPOS,MPACK1(1))
- JTH = JTH + 1
- IA(JTH+100) = JVAL
- JPOS = JPOS + MPACK1(1)
- 42 JVAL = JVAL + 1
- CALL SBIT0 (IA(JW),30)
- CALL SBIT0 (IA(JW+10),30)
- 43 CONTINUE
-
- CALL PKBYT (IA(101),IA,1,42,MPACK1)
- CALL MVERII (11,IA,IA(11),6)
-
- CALL PKBYT (IA(103),IA,3, 2,MPACK1)
- CALL MVERII (12,IA,IA(11),6)
-
- CALL PKBYT (IA(103),IA,3, 5,MPACK1)
- CALL MVERII (13,IA,IA(11),6)
-
- CALL PKBYT (IA(103),IA,3, 6,MPACK1)
- CALL MVERII (14,IA,IA(11),6)
-
- CALL PKBYT (IA(109),IA,9, 2,MPACK1)
- CALL MVERII (15,IA,IA(11),6)
-
- CALL PKBYT (IA(109),IA,9,12,MPACK1)
- CALL MVERII (16,IA,IA(11),6)
- RETURN
-
- END
diff --git a/src/packlib/kernlib/kerngen/test/obsolete/_mcray/mainprog.inc b/src/packlib/kernlib/kerngen/test/obsolete/_mcray/mainprog.inc
deleted file mode 100644
index b49fe1f..0000000
--- a/src/packlib/kernlib/kerngen/test/obsolete/_mcray/mainprog.inc
+++ /dev/null
@@ -1,14 +0,0 @@
-*
-* $Id: mainprog.inc,v 1.1.1.1 1996/02/15 17:55:04 mclareni Exp $
-*
-* $Log: mainprog.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:55:04 mclareni
-* Kernlib
-*
-*
-*
-* mainprog.inc
-*
-#if 0
- PROGRAM MICKY (OUTTPUT)
-#endif
diff --git a/src/packlib/kernlib/kerngen/test/obsolete/_mcray/minit1.inc b/src/packlib/kernlib/kerngen/test/obsolete/_mcray/minit1.inc
deleted file mode 100644
index 6a61874..0000000
--- a/src/packlib/kernlib/kerngen/test/obsolete/_mcray/minit1.inc
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: minit1.inc,v 1.1.1.1 1996/02/15 17:55:04 mclareni Exp $
-*
-* $Log: minit1.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:55:04 mclareni
-* Kernlib
-*
-*
-*
-* minit1.inc
-*
-#if 0
- IQBITW = 64
-#endif
-#if 0
- IQCHAW = 8
-#endif
-#if 0
- ITB = 4L$OUT
-#endif
diff --git a/src/packlib/kernlib/kerngen/test/obsolete/_mcray/pilot.h b/src/packlib/kernlib/kerngen/test/obsolete/_mcray/pilot.h
deleted file mode 100644
index 5a8947c..0000000
--- a/src/packlib/kernlib/kerngen/test/obsolete/_mcray/pilot.h
+++ /dev/null
@@ -1,21 +0,0 @@
-#if 0
-* This pilot patch was created from kerngent.car patch _mcray
-#endif
-#if 0
-* For CRAY, system COS
-#endif
-#ifndef CERNLIB__MICKY
-#define CERNLIB__MICKY
-#endif
-#ifndef CERNLIB_A8
-#define CERNLIB_A8
-#endif
-#ifndef CERNLIB_B64
-#define CERNLIB_B64
-#endif
-#if 0
-* do not test VXINVB/C
-#endif
-#ifdef CERNLIB_TVXINV
-#undef CERNLIB_TVXINV
-#endif
diff --git a/src/packlib/kernlib/kerngen/test/obsolete/_mcray/tiuchad.inc b/src/packlib/kernlib/kerngen/test/obsolete/_mcray/tiuchad.inc
deleted file mode 100644
index dfbfaf0..0000000
--- a/src/packlib/kernlib/kerngen/test/obsolete/_mcray/tiuchad.inc
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: tiuchad.inc,v 1.1.1.1 1996/02/15 17:55:04 mclareni Exp $
-*
-* $Log: tiuchad.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:55:04 mclareni
-* Kernlib
-*
-*
-*
-* tiuchad.inc
-*
-#if 0
- DATA NEXP / 8 /
-#endif
-#if 0
- DATA BIAS / .00001 /
-#endif
diff --git a/src/packlib/kernlib/kerngen/test/obsolete/_mcray/tublow1.inc b/src/packlib/kernlib/kerngen/test/obsolete/_mcray/tublow1.inc
deleted file mode 100644
index a875bbf..0000000
--- a/src/packlib/kernlib/kerngen/test/obsolete/_mcray/tublow1.inc
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: tublow1.inc,v 1.1.1.1 1996/02/15 17:55:04 mclareni Exp $
-*
-* $Log: tublow1.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:55:04 mclareni
-* Kernlib
-*
-*
-*
-* tublow1.inc
-*
-#if 0
- DIMENSION MCHECK(5)
-#endif
-#if 0
- EQUIVALENCE (MCHECK,CHECK)
-#endif
-#if 0
- DATA MCHECK /40H 0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ /
-#endif
-#if 0
- DATA NCH /37/
-#endif
diff --git a/src/packlib/kernlib/kerngen/test/obsolete/_mcray/verifmt.inc b/src/packlib/kernlib/kerngen/test/obsolete/_mcray/verifmt.inc
deleted file mode 100644
index 2f14782..0000000
--- a/src/packlib/kernlib/kerngen/test/obsolete/_mcray/verifmt.inc
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: verifmt.inc,v 1.1.1.1 1996/02/15 17:55:04 mclareni Exp $
-*
-* $Log: verifmt.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:55:04 mclareni
-* Kernlib
-*
-*
-* FOR P=MICKY, D=MVERII/MVERIF
-*
-* verifmt.inc
-*
-#if 0
- 9011 FORMAT (I10,5H MUST,5Z21)
-#endif
-#if 0
- 9012 FORMAT (10X,5H HAVE,5Z21/1X)
-#endif
diff --git a/src/packlib/kernlib/kerngen/test/obsolete/_mcru/minit1.inc b/src/packlib/kernlib/kerngen/test/obsolete/_mcru/minit1.inc
deleted file mode 100644
index 75d9fa9..0000000
--- a/src/packlib/kernlib/kerngen/test/obsolete/_mcru/minit1.inc
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: minit1.inc,v 1.1.1.1 1996/02/15 17:55:03 mclareni Exp $
-*
-* $Log: minit1.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:55:03 mclareni
-* Kernlib
-*
-*
-*
-* minit1.inc
-*
-#if 0
- IQBITW = 64
-#endif
-#if 0
- IQCHAW = 8
-#endif
-#if 0
- ITB = 6
-#endif
diff --git a/src/packlib/kernlib/kerngen/test/obsolete/_mcru/pilot.h b/src/packlib/kernlib/kerngen/test/obsolete/_mcru/pilot.h
deleted file mode 100644
index b4837ad..0000000
--- a/src/packlib/kernlib/kerngen/test/obsolete/_mcru/pilot.h
+++ /dev/null
@@ -1,27 +0,0 @@
-#if 0
-* This pilot patch was created from kerngent.car patch _mcru
-#endif
-#if 0
-* For CRAY with system UNICOS
-#endif
-#ifndef CERNLIB__MICKY
-#define CERNLIB__MICKY
-#endif
-#ifndef CERNLIB_QMCRU
-#define CERNLIB_QMCRU
-#endif
-#ifndef CERNLIB_QUNIX
-#define CERNLIB_QUNIX
-#endif
-#ifndef CERNLIB_A8
-#define CERNLIB_A8
-#endif
-#ifndef CERNLIB_B64
-#define CERNLIB_B64
-#endif
-#if 0
-* do not test VXINVB/C
-#endif
-#ifdef CERNLIB_TVXINV
-#undef CERNLIB_TVXINV
-#endif
diff --git a/src/packlib/kernlib/kerngen/test/obsolete/_mcru/tiuchad.inc b/src/packlib/kernlib/kerngen/test/obsolete/_mcru/tiuchad.inc
deleted file mode 100644
index 8f02380..0000000
--- a/src/packlib/kernlib/kerngen/test/obsolete/_mcru/tiuchad.inc
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: tiuchad.inc,v 1.1.1.1 1996/02/15 17:55:03 mclareni Exp $
-*
-* $Log: tiuchad.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:55:03 mclareni
-* Kernlib
-*
-*
-*
-* tiuchad.inc
-*
-#if 0
- DATA NEXP / 8 /
-#endif
-#if 0
- DATA BIAS / .00001 /
-#endif
diff --git a/src/packlib/kernlib/kerngen/test/obsolete/_mcru/tublow1.inc b/src/packlib/kernlib/kerngen/test/obsolete/_mcru/tublow1.inc
deleted file mode 100644
index a5e71e2..0000000
--- a/src/packlib/kernlib/kerngen/test/obsolete/_mcru/tublow1.inc
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: tublow1.inc,v 1.1.1.1 1996/02/15 17:55:03 mclareni Exp $
-*
-* $Log: tublow1.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:55:03 mclareni
-* Kernlib
-*
-*
-*
-* tublow1.inc
-*
-#if 0
- DIMENSION MCHECK(5)
-#endif
-#if 0
- EQUIVALENCE (MCHECK,CHECK)
-#endif
-#if 0
- DATA MCHECK /40H 0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ /
-#endif
-#if 0
- DATA NCH /37/
-#endif
diff --git a/src/packlib/kernlib/kerngen/test/obsolete/_mcru/verifmt.inc b/src/packlib/kernlib/kerngen/test/obsolete/_mcru/verifmt.inc
deleted file mode 100644
index 67f91a4..0000000
--- a/src/packlib/kernlib/kerngen/test/obsolete/_mcru/verifmt.inc
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: verifmt.inc,v 1.1.1.1 1996/02/15 17:55:03 mclareni Exp $
-*
-* $Log: verifmt.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:55:03 mclareni
-* Kernlib
-*
-*
-* FOR P=MICKY, D=MVERII/MVERIF
-*
-* verifmt.inc
-*
-#if 0
- 9011 FORMAT (I10,5H MUST,5Z21)
-#endif
-#if 0
- 9012 FORMAT (10X,5H HAVE,5Z21/1X)
-#endif
diff --git a/src/packlib/kernlib/kerngen/test/obsolete/_mcvx/minit1.inc b/src/packlib/kernlib/kerngen/test/obsolete/_mcvx/minit1.inc
deleted file mode 100644
index 75d9fa9..0000000
--- a/src/packlib/kernlib/kerngen/test/obsolete/_mcvx/minit1.inc
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: minit1.inc,v 1.1.1.1 1996/02/15 17:55:03 mclareni Exp $
-*
-* $Log: minit1.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:55:03 mclareni
-* Kernlib
-*
-*
-*
-* minit1.inc
-*
-#if 0
- IQBITW = 64
-#endif
-#if 0
- IQCHAW = 8
-#endif
-#if 0
- ITB = 6
-#endif
diff --git a/src/packlib/kernlib/kerngen/test/obsolete/_mcvx/pilot.h b/src/packlib/kernlib/kerngen/test/obsolete/_mcvx/pilot.h
deleted file mode 100644
index 9aa8138..0000000
--- a/src/packlib/kernlib/kerngen/test/obsolete/_mcvx/pilot.h
+++ /dev/null
@@ -1,30 +0,0 @@
-#if 0
-* This pilot patch was created from kerngent.car patch _mcvx
-#endif
-#if 0
-* For Convex 64 bit
-#endif
-#ifndef CERNLIB__MICKY
-#define CERNLIB__MICKY
-#endif
-#ifndef CERNLIB_QMCVX
-#define CERNLIB_QMCVX
-#endif
-#ifndef CERNLIB_QMCV64
-#define CERNLIB_QMCV64
-#endif
-#ifndef CERNLIB_QUNIX
-#define CERNLIB_QUNIX
-#endif
-#ifndef CERNLIB_A8
-#define CERNLIB_A8
-#endif
-#ifndef CERNLIB_B64
-#define CERNLIB_B64
-#endif
-#if 0
-* do not test VXINVB/C
-#endif
-#ifdef CERNLIB_TVXINV
-#undef CERNLIB_TVXINV
-#endif
diff --git a/src/packlib/kernlib/kerngen/test/obsolete/_mcvx/tiuchad.inc b/src/packlib/kernlib/kerngen/test/obsolete/_mcvx/tiuchad.inc
deleted file mode 100644
index 8f02380..0000000
--- a/src/packlib/kernlib/kerngen/test/obsolete/_mcvx/tiuchad.inc
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: tiuchad.inc,v 1.1.1.1 1996/02/15 17:55:03 mclareni Exp $
-*
-* $Log: tiuchad.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:55:03 mclareni
-* Kernlib
-*
-*
-*
-* tiuchad.inc
-*
-#if 0
- DATA NEXP / 8 /
-#endif
-#if 0
- DATA BIAS / .00001 /
-#endif
diff --git a/src/packlib/kernlib/kerngen/test/obsolete/_mcvx/tublow1.inc b/src/packlib/kernlib/kerngen/test/obsolete/_mcvx/tublow1.inc
deleted file mode 100644
index 19082b5..0000000
--- a/src/packlib/kernlib/kerngen/test/obsolete/_mcvx/tublow1.inc
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: tublow1.inc,v 1.1.1.1 1996/02/15 17:55:03 mclareni Exp $
-*
-* $Log: tublow1.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:55:03 mclareni
-* Kernlib
-*
-*
-*
-* tublow1.inc
-*
-#if 0
- DIMENSION MCHECK(5)
-#endif
-#if 0
- EQUIVALENCE (MCHECK,CHECK)
-#endif
-#if 0
- DATA MCHECK /8H 0123456, 8H789ABCDE, 8HFGHIJKLM
-#endif
-#if 0
- +, 8HNOPQRSTU, 8HVWXYZ /
-#endif
-#if 0
- DATA NCH /37/
-#endif
diff --git a/src/packlib/kernlib/kerngen/test/obsolete/_mcvx/verifmt.inc b/src/packlib/kernlib/kerngen/test/obsolete/_mcvx/verifmt.inc
deleted file mode 100644
index 67f91a4..0000000
--- a/src/packlib/kernlib/kerngen/test/obsolete/_mcvx/verifmt.inc
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: verifmt.inc,v 1.1.1.1 1996/02/15 17:55:03 mclareni Exp $
-*
-* $Log: verifmt.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:55:03 mclareni
-* Kernlib
-*
-*
-* FOR P=MICKY, D=MVERII/MVERIF
-*
-* verifmt.inc
-*
-#if 0
- 9011 FORMAT (I10,5H MUST,5Z21)
-#endif
-#if 0
- 9012 FORMAT (10X,5H HAVE,5Z21/1X)
-#endif
diff --git a/src/packlib/kernlib/kerngen/test/obsolete/_mcvy/pilot.h b/src/packlib/kernlib/kerngen/test/obsolete/_mcvy/pilot.h
deleted file mode 100644
index 4540c7b..0000000
--- a/src/packlib/kernlib/kerngen/test/obsolete/_mcvy/pilot.h
+++ /dev/null
@@ -1,18 +0,0 @@
-#if 0
-* This pilot patch was created from kerngent.car patch _mcvy
-#endif
-#if 0
-* For Convex 32 bit
-#endif
-#ifndef CERNLIB__MNORM
-#define CERNLIB__MNORM
-#endif
-#ifndef CERNLIB_QUNIX
-#define CERNLIB_QUNIX
-#endif
-#ifndef CERNLIB_QMCVX
-#define CERNLIB_QMCVX
-#endif
-#ifndef CERNLIB_QMCV32
-#define CERNLIB_QMCV32
-#endif
diff --git a/src/packlib/kernlib/kerngen/test/obsolete/_mdge/pilot.h b/src/packlib/kernlib/kerngen/test/obsolete/_mdge/pilot.h
deleted file mode 100644
index 6322e2b..0000000
--- a/src/packlib/kernlib/kerngen/test/obsolete/_mdge/pilot.h
+++ /dev/null
@@ -1,15 +0,0 @@
-#if 0
-* This pilot patch was created from kerngent.car patch _mdge
-#endif
-#if 0
-* For DATA GENERAL ECLIPSE
-#endif
-#ifndef CERNLIB__MICKY
-#define CERNLIB__MICKY
-#endif
-#ifndef CERNLIB_A4
-#define CERNLIB_A4
-#endif
-#ifndef CERNLIB_B32
-#define CERNLIB_B32
-#endif
diff --git a/src/packlib/kernlib/kerngen/test/obsolete/_mdge/tiucha39.inc b/src/packlib/kernlib/kerngen/test/obsolete/_mdge/tiucha39.inc
deleted file mode 100644
index 66de6ec..0000000
--- a/src/packlib/kernlib/kerngen/test/obsolete/_mdge/tiucha39.inc
+++ /dev/null
@@ -1,14 +0,0 @@
-*
-* $Id: tiucha39.inc,v 1.1.1.1 1996/02/15 17:55:05 mclareni Exp $
-*
-* $Log: tiucha39.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:55:05 mclareni
-* Kernlib
-*
-*
-*
-* tiucha39.inc
-*
-#if 0
- CALL VFILL (IB(101),20,Z'FF000000')
-#endif
diff --git a/src/packlib/kernlib/kerngen/test/obsolete/_mdge/veriff1.inc b/src/packlib/kernlib/kerngen/test/obsolete/_mdge/veriff1.inc
deleted file mode 100644
index 73893cc..0000000
--- a/src/packlib/kernlib/kerngen/test/obsolete/_mdge/veriff1.inc
+++ /dev/null
@@ -1,14 +0,0 @@
-*
-* $Id: veriff1.inc,v 1.1.1.1 1996/02/15 17:55:05 mclareni Exp $
-*
-* $Log: veriff1.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:55:05 mclareni
-* Kernlib
-*
-*
-*
-* veriff1.inc
-*
-#if 0
- DIMENSION IHAVE(200), IMUST(200)
-#endif
diff --git a/src/packlib/kernlib/kerngen/test/obsolete/_mdge/veriff6.inc b/src/packlib/kernlib/kerngen/test/obsolete/_mdge/veriff6.inc
deleted file mode 100644
index ca2d565..0000000
--- a/src/packlib/kernlib/kerngen/test/obsolete/_mdge/veriff6.inc
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: veriff6.inc,v 1.1.1.1 1996/02/15 17:55:05 mclareni Exp $
-*
-* $Log: veriff6.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:55:05 mclareni
-* Kernlib
-*
-*
-*
-* veriff6.inc
-*
-#if 0
- CALL UCOPY (HAVE,IHAVE,N)
-#endif
-#if 0
- CALL UCOPY (AMUST,IMUST,N)
-#endif
diff --git a/src/packlib/kernlib/kerngen/test/obsolete/_mdge/veriff7.inc b/src/packlib/kernlib/kerngen/test/obsolete/_mdge/veriff7.inc
deleted file mode 100644
index d58ade2..0000000
--- a/src/packlib/kernlib/kerngen/test/obsolete/_mdge/veriff7.inc
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: veriff7.inc,v 1.1.1.1 1996/02/15 17:55:05 mclareni Exp $
-*
-* $Log: veriff7.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:55:05 mclareni
-* Kernlib
-*
-*
-*
-* veriff7.inc
-*
-#if 0
- WRITE (ITB,9011) N1,(IMUST(J),J=N1,N2)
-#endif
-#if 0
- WRITE (ITB,9012) (IHAVE(J),J=N1,N2)
-#endif
diff --git a/src/packlib/kernlib/kerngen/test/obsolete/_mibm/pilot.h b/src/packlib/kernlib/kerngen/test/obsolete/_mibm/pilot.h
deleted file mode 100644
index 488d05a..0000000
--- a/src/packlib/kernlib/kerngen/test/obsolete/_mibm/pilot.h
+++ /dev/null
@@ -1,21 +0,0 @@
-#if 0
-* This pilot patch was created from kerngent.car patch _mibm
-#endif
-#if 0
-* For IBM 360
-#endif
-#ifndef CERNLIB__MNORM
-#define CERNLIB__MNORM
-#endif
-#ifndef CERNLIB_QMIBM
-#define CERNLIB_QMIBM
-#endif
-#ifndef CERNLIB_QEBCDIC
-#define CERNLIB_QEBCDIC
-#endif
-#if 0
-* do not test VXINVB/C
-#endif
-#ifdef CERNLIB_TVXINV
-#undef CERNLIB_TVXINV
-#endif
diff --git a/src/packlib/kernlib/kerngen/test/obsolete/_mwin/pilot.h b/src/packlib/kernlib/kerngen/test/obsolete/_mwin/pilot.h
deleted file mode 100644
index abfc479..0000000
--- a/src/packlib/kernlib/kerngen/test/obsolete/_mwin/pilot.h
+++ /dev/null
@@ -1,15 +0,0 @@
-#if 0
-* This pilot patch was created from kerngent.car patch _mwin
-#endif
-#if 0
-* For PC with Windows/NT
-#endif
-#ifndef CERNLIB__MNORM
-#define CERNLIB__MNORM
-#endif
-#ifndef CERNLIB_QMDOS
-#define CERNLIB_QMDOS
-#endif
-#ifndef CERNLIB_QUNIX
-#define CERNLIB_QUNIX
-#endif
diff --git a/src/packlib/kernlib/kerngen/test/obsolete/code/tmxequ.F b/src/packlib/kernlib/kerngen/test/obsolete/code/tmxequ.F
deleted file mode 100644
index 71dcc66..0000000
--- a/src/packlib/kernlib/kerngen/test/obsolete/code/tmxequ.F
+++ /dev/null
@@ -1,55 +0,0 @@
-*
-* $Id: tmxequ.F,v 1.1.1.1 1996/02/15 17:55:02 mclareni Exp $
-*
-* $Log: tmxequ.F,v $
-* Revision 1.1.1.1 1996/02/15 17:55:02 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_kerngent/pilot.h"
- SUBROUTINE TMXEQU
-
-#include "mkcde.inc"
-
- DIMENSION AC(9),BC(6),CHECK(6)
- INTEGER TINF(4),TINF2
- DATA AC/ 52.,-36., 28., 35., 72., 41., 27., 14.,-16./
- +, BC/ 49.,-98.,-62.,124.,-76.,152./
- DATA CHECK/ -1.009187509E+00, 2.018375018E+00, -1.405379155E+00
- +, 2.810758311E+00, 1.817289317E+00, -3.634578635E+00/
- DATA TINF /1000, 4HMXEQ, 0, 4H332 /, TINF2 /4HXEQ1/
-
- CALL NEWGUY ('MXEQU-MXEQU1.','TMXEQU ')
- ZERLEV=ZEROV(3)
- CALL UCOPY (AC,A,9)
- CALL UCOPY (BC,B,9)
- CALL MXEQU (A,B,3,2)
- CALL MVERIF (1,B,CHECK,6)
-
- CALL UCOPY (BC,B,6)
- CALL MXEQU1 (A,B,3,2)
- CALL MVERIF (2,B,CHECK,6)
-
-C-- TIMING
- IF (ITIMES.EQ.0) RETURN
- NTIMES = ITIMES*TINF(1)
- TINF(1) = NTIMES
- CALL TIMED (TIMERD)
-
- DO 80 J=1,NTIMES
- CALL UCOPY (AC,A,9)
- CALL UCOPY (BC,B,6)
- 80 CALL MXEQU (A,B,3,2)
-
- CALL TIMING (TINF)
- TINF(2)=TINF2
- CALL TIMED (TIMERD)
-
- DO 81 J=1,NTIMES
- CALL UCOPY (BC,B,6)
- 81 CALL MXEQU1 (A,B,3,2)
-
- CALL TIMING (TINF)
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/test/obsolete/code/tprob.F b/src/packlib/kernlib/kerngen/test/obsolete/code/tprob.F
deleted file mode 100644
index 405aa16..0000000
--- a/src/packlib/kernlib/kerngen/test/obsolete/code/tprob.F
+++ /dev/null
@@ -1,65 +0,0 @@
-*
-* $Id: tprob.F,v 1.1.1.1 1996/02/15 17:55:02 mclareni Exp $
-*
-* $Log: tprob.F,v $
-* Revision 1.1.1.1 1996/02/15 17:55:02 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_kerngent/pilot.h"
- SUBROUTINE TPROB
-
-#include "mkcde.inc"
-
- DIMENSION APROB(16),NU(10),CHI2(16,10),CHI2A(16,5),CHI2B(16,5)
- EQUIVALENCE (CHI2(1,1),CHI2A(1,1)), (CHI2(1,6),CHI2B(1,1))
-
- DATA APROB/ .995, .990, .975, .950, .900, .750, .500, .250,
- 1 .100, .050, .025, .010, .005, .001, .0005, .0001/
-
- DATA NU / 1, 2, 5, 10, 25, 30, 40, 60, 80, 100/
-
- DATA CHI2A /
- A 3.92704E-5, 1.57088E-4, 9.82069E-4, 3.93214E-3, .0157908, 1A
- B .101531, .454937, 1.32330, 2.70554, 3.84146, 5.02389, 6.63490,
- C 7.87944, 10.8280, 12.1160, 15.1370,
- A 1.00251E-2, 2.01007E-2, 5.06356E-2, .102587, .210720, .575364, 2A
- B 1.38629, 2.77259, 4.60517, 5.99147, 7.37776, 9.21034, 10.5966,
- C 13.8160, 15.2020, 18.4210,
- A .41174, .55430, .831211, 1.145476, 1.61031, 2.67460, 4.35146, 5A
- B 6.62568, 9.23635, 11.0705, 12.8325, 15.0863, 16.7496, 20.5150,
- C 22.1050, 25.7450,
- A 2.15585, 2.55821, 3.24697, 3.94030, 4.86518, 6.73720, 9.34182, 10A
- B 12.5489, 15.9871, 18.3070, 20.4831, 23.2093, 25.1882, 29.5880,
- C 31.4200, 35.5640,
- A 10.5197, 11.5240, 13.1197, 14.6114, 16.4734, 19.9393, 24.3366, 25A
- B 29.3389, 34.3816, 37.6525, 40.6465, 44.3141, 46.9278, 52.6200,
- C 54.9470, 60.1400/
-
- DATA CHI2B /
- A 13.7867, 14.9535, 16.7908, 18.4926, 20.5992, 24.4776, 29.3360, 30A
- B 34.7998, 40.2560, 43.7729, 46.9792, 50.8922, 53.6720, 59.7030,
- C 62.1620, 67.6330,
- A 20.7065, 22.1643, 24.4331, 26.5093, 29.0505, 33.6603, 39.3354, 40A
- B 45.6160, 51.8050, 55.7585, 59.3417, 63.6907, 66.7659, 73.4020,
- C 76.0950, 82.0620,
- A 35.5346, 37.4848, 40.4817, 43.1879, 46.4589, 52.2938, 59.3347, 60A
- B 66.9814, 74.3970, 79.0819, 83.2976, 88.3794, 91.9517, 99.6070,
- C 102.695, 109.503,
- A 51.1720, 53.5400, 57.1532, 60.3915, 64.2778, 71.1445, 79.3343, 80A
- B 88.1303, 96.5782, 101.879, 106.629, 112.329, 116.321, 124.839,
- C 128.261, 135.783,
- A 67.3276, 70.0648, 74.2219, 77.9295, 82.3581, 90.1332, 99.3341, 100A
- B 109.141, 118.498, 124.342, 129.561, 135.807, 140.169, 149.449,
- C 153.167, 161.319/
-
- CALL NEWGUY ('PROB.','TPROB ')
- ZERLEV = ZEROV(5)
-
- DO 50 ILOT=1,10
- DO 40 IC=1,16
- 40 A(IC)=PROB (CHI2(IC,ILOT),NU(ILOT))
- 50 CALL MVERIF (NU(ILOT),A,APROB,16)
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/test/obsolete/code/tsortx.F b/src/packlib/kernlib/kerngen/test/obsolete/code/tsortx.F
deleted file mode 100644
index 62feda3..0000000
--- a/src/packlib/kernlib/kerngen/test/obsolete/code/tsortx.F
+++ /dev/null
@@ -1,64 +0,0 @@
-*
-* $Id: tsortx.F,v 1.1.1.1 1996/02/15 17:55:02 mclareni Exp $
-*
-* $Log: tsortx.F,v $
-* Revision 1.1.1.1 1996/02/15 17:55:02 mclareni
-* Kernlib
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_kerngent/pilot.h"
- SUBROUTINE TSORTX
-
-#include "mkcde.inc"
-
- EQUIVALENCE (IMAT,IB(101))
- INTEGER TINF(4)
- DATA TINF/1000, 4HSORT, 20, 4HWORD/
-
- CALL UCOPY (INTG,IA,20)
- CALL UCOPY (INTG(2),IA(21),10)
- IA(31)= 12
- CALL UCOPY (INTG(12),IA(32),9)
-
- DO 10 I= 1,20
- J=21-I
- 10 IA(I+40)=IA(J)
-
- CALL NEWGUY ('SORTX.','TSORTX ')
- CALL UCOPY (INTG,IB(101),20)
-
-C---- TEST NORMAL
- CALL SORTX (IMAT, 4, 5,-1,IB)
- CALL SORTX (IMAT, 4, 5, 1,IB)
- CALL MVERII (1,IMAT,IA,20)
-
- IB(101)=12
- CALL SORTX (IMAT,10, 2, 1,IB)
- CALL SORTX (IMAT, 1,20, 1,IB)
- CALL MVERII (2,IMAT,IA(21),20)
-
- CALL UCOPY(IA,IMAT,20)
- CALL SORTX (IMAT, 1,20,-1,IB)
- CALL MVERII (3,IMAT,IA(41),20)
-
-C---- TEST FAULTY CALLS
- CALL UCOPY (IA,IMAT,20)
- CALL SORTX (IMAT, 4, 5, 0,IB)
- CALL SORTX (IMAT, 4, 5,100,IB)
- CALL SORTX (IMAT, 4, 0,1,IB)
- CALL MVERII (4,IMAT,IA ,20)
-
-C-- TIMING
- IF (ITIMES.EQ.0) RETURN
- NTIMES = ITIMES*TINF(1)
- TINF(1) = NTIMES
- CALL TIMED (TIMERD)
-
- DO 80 J= 1,NTIMES
- CALL SORTX (IMAT,4,5,1,IB)
- 80 CONTINUE
-
- CALL TIMING (TINF)
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/test/obsolete/genuse/genuse.h b/src/packlib/kernlib/kerngen/test/obsolete/genuse/genuse.h
deleted file mode 100644
index fa55adb..0000000
--- a/src/packlib/kernlib/kerngen/test/obsolete/genuse/genuse.h
+++ /dev/null
@@ -1,11 +0,0 @@
-*
-* $Id: genuse.h,v 1.1.1.1 1996/02/15 17:55:05 mclareni Exp $
-*
-* $Log: genuse.h,v $
-* Revision 1.1.1.1 1996/02/15 17:55:05 mclareni
-* Kernlib
-*
-*
-* Generation and usage of Must-Data (for ML check)
-* This directory was created from kerngent.car patch genuse
-+EXE,MICKY,D=MINIT,MVERIF,MVERII
diff --git a/src/packlib/kernlib/kerngen/test/obsolete/genuse/minit9.inc b/src/packlib/kernlib/kerngen/test/obsolete/genuse/minit9.inc
deleted file mode 100644
index ac3a9c0..0000000
--- a/src/packlib/kernlib/kerngen/test/obsolete/genuse/minit9.inc
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: minit9.inc,v 1.1.1.1 1996/02/15 17:55:05 mclareni Exp $
-*
-* $Log: minit9.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:55:05 mclareni
-* Kernlib
-*
-*
-*
-* minit9.inc
-*
- IF (LUNGU.EQ.0) LUNGU= 11
- MODEGU= MODEG
- IF (IFLGU.GE.0) MODEGU=MODEU
- WRITE (ITB,9007) IFLGU,MODEGU
- 9007 FORMAT (1X/8H IFLGU = ,I3,2X,A3,5H-RUN.)
- REWIND LUNGU
diff --git a/src/packlib/kernlib/kerngen/test/obsolete/genuse/veriff2.inc b/src/packlib/kernlib/kerngen/test/obsolete/genuse/veriff2.inc
deleted file mode 100644
index 74a267d..0000000
--- a/src/packlib/kernlib/kerngen/test/obsolete/genuse/veriff2.inc
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: veriff2.inc,v 1.1.1.1 1996/02/15 17:55:06 mclareni Exp $
-*
-* $Log: veriff2.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:55:06 mclareni
-* Kernlib
-*
-*
-*
-* veriff2.inc
-*
- DIMENSION SAVE(200)
diff --git a/src/packlib/kernlib/kerngen/test/obsolete/genuse/veriff9.inc b/src/packlib/kernlib/kerngen/test/obsolete/genuse/veriff9.inc
deleted file mode 100644
index f4887e8..0000000
--- a/src/packlib/kernlib/kerngen/test/obsolete/genuse/veriff9.inc
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: veriff9.inc,v 1.1.1.1 1996/02/15 17:55:06 mclareni Exp $
-*
-* $Log: veriff9.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:55:06 mclareni
-* Kernlib
-*
-*
-*
-* veriff9.inc
-*
- IF (IFLGU.GE.1) CALL UCOPY (SAVE,AMUST,NHAVE)
diff --git a/src/packlib/kernlib/kerngen/test/obsolete/withq_sq/sqtbyt.inc b/src/packlib/kernlib/kerngen/test/obsolete/withq_sq/sqtbyt.inc
deleted file mode 100644
index df689d4..0000000
--- a/src/packlib/kernlib/kerngen/test/obsolete/withq_sq/sqtbyt.inc
+++ /dev/null
@@ -1,13 +0,0 @@
-*
-* $Id: sqtbyt.inc,v 1.1.1.1 1996/02/15 17:55:06 mclareni Exp $
-*
-* $Log: sqtbyt.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:55:06 mclareni
-* Kernlib
-*
-*
-*
-* sqtbyt.inc
-*
-#include "q_jbit.inc"
-#include "q_jbytet.inc"
diff --git a/src/packlib/kernlib/kerngen/test/obsolete/withq_sq/sqtmbyt.inc b/src/packlib/kernlib/kerngen/test/obsolete/withq_sq/sqtmbyt.inc
deleted file mode 100644
index ac07664..0000000
--- a/src/packlib/kernlib/kerngen/test/obsolete/withq_sq/sqtmbyt.inc
+++ /dev/null
@@ -1,15 +0,0 @@
-*
-* $Id: sqtmbyt.inc,v 1.1.1.1 1996/02/15 17:55:06 mclareni Exp $
-*
-* $Log: sqtmbyt.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:55:06 mclareni
-* Kernlib
-*
-*
-*
-* sqtmbyt.inc
-*
-#include "q_sbit.inc"
-#include "q_sbyt.inc"
-#include "q_cbyt.inc"
-#include "q_jbytet.inc"
diff --git a/src/packlib/kernlib/kerngen/test/pchar/Imakefile b/src/packlib/kernlib/kerngen/test/pchar/Imakefile
deleted file mode 100644
index 894f2a8..0000000
--- a/src/packlib/kernlib/kerngen/test/pchar/Imakefile
+++ /dev/null
@@ -1,4 +0,0 @@
-SRCS_F= \ @@\
- tbaby.F tpkch.F tublow.F tuctoh.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kerngen/test/pchar/tbaby.F b/src/packlib/kernlib/kerngen/test/pchar/tbaby.F
deleted file mode 100644
index 9b14a1a..0000000
--- a/src/packlib/kernlib/kerngen/test/pchar/tbaby.F
+++ /dev/null
@@ -1,116 +0,0 @@
-*
-* $Id: tbaby.F,v 1.1.1.1 1996/02/15 17:54:55 mclareni Exp $
-*
-* $Log: tbaby.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:55 mclareni
-* Kernlib
-*
-*
-#include "kerngent/pilot.h"
- SUBROUTINE TBABY
-
-#include "kerngent/mkcde.inc"
-
- DIMENSION IC(40)
- DIMENSION ICHEK1(9),ICHEK2(12),ICHEK3(12),ICHEK4(6),ICHEK5(6)
- DIMENSION ICHEK6(4)
- DATA ISEVEN / 4H7 /
- DATA ICHEK1 / 40,30,0, 4HZ ,4H7777,4H , 1,31,41/
- DATA ICHEK2 / 0,6420,864201,3, 11,16,15,22, 0,4,6,1/
- DATA ICHEK3 / 90123,0,577,3, 11,12,32,24, 5,0,3,1/
- DATA ICHEK4 / 10,26,37, 5,6,1/
- DATA ICHEK5 / 26,1,39, 4,9,1/
- DATA ICHEK6 / 21,17, 4,3/
-
-C-- PREPARE THE IC-VECTOR
-
- CALL UCTOH1 ('56789 0123ABCDE86420 1357 77777 Z ',IC(1),40)
-C- ....+....1....+....2....+....3....+....4
-
- CALL NEWGUY ('IULAST-IULOOK-IUNEXT.','TBABY ')
-
-C-- TEST FOR IULAST
- IA(1)=IULAST (ISEVEN,IC,40)
- IA(2)=IULAST (ISEVEN,IC,35)
- IA(3)=IULAST (ISEVEN,IC(31),5) + IULAST (ISEVEN,IC,0)
-
-C-- TEST FOR IULOOK
- IA(4)=IULOOK (1,IC,36,40)
- IA(5)=IULOOK (4,IC,25,40)
- IA(6)=IULOOK (2,IC,26,30)
-
-C-- TEST FOR IUNEXT
- IA(7)=IUNEXT (IC,1)
- IA(8)=IUNEXT (IC,26)
- IA(9)=IUNEXT (IC,39)
-
- CALL MVERII (1,IA,ICHEK1,9)
-
-C-- TEST FOR IUBACK - IUEND
- CALL NEWGUY ('IUBACK-IUEND.','TBABY ')
- IA(1)=IUBACK (IC,6,11)
- IA(5)=IUEND (IA(9))
- IA(2)=IUBACK (IC,17,20)
- IA(6)=IUEND (IA(10))
- IA(3)=IUBACK (IC,15,22)
- IA(7)=IUEND (IA(11))
- IA(4)=IUBACK (IC,23,23)
- IA(8)=IUEND (IA(12))
- CALL MVERII (2,IA,ICHEK2,12)
-
-C-- TEST FOR IUFORW - IUEND
- CALL NEWGUY ('IUFORW-IUEND.','TBABY ')
- IA(1)=IUFORW (IC,5,11)
- IA(5)=IUEND (IA(9))
- IA(2)=IUFORW (IC,12,14)
- IA(6)=IUEND (IA(10))
- IA(3)=IUFORW (IC,24,31)
- IA(7)=IUEND (IA(11))
- IA(4)=IUFORW (IC,23,23)
- IA(8)=IUEND (IA(12))
- CALL MVERII (3,IA,ICHEK3,12)
-
-C-- TEST FOR ULEFT - IUEND
- CALL NEWGUY ('ULEFT-IUEND.','TBABY ')
- CALL UCOPY (IC,IA,40)
- CALL ULEFT (IA,5,10)
- IB(1)=IUEND (IB(4))
- CALL ULEFT (IA,20,31)
- IB(2)=IUEND (IB(5))
- CALL ULEFT (IA,36,40)
- IB(3)=IUEND (IB(6))
- CALL MVERII (14,IB,ICHEK4,6)
-
-C- IC = 40H56789 0123ABCDE86420 1357 77777 Z
-C- ....+....1....+....2....+....3....+....4
- CALL UCTOH1 ('567890123 ABCDE8642013577 7777Z ',IB(1),40)
- CALL MVERII (4,IA,IB,40)
-
-C-- TEST FOR URIGHT - IUEND
- CALL NEWGUY ('URIGHT-IUEND.','TBABY ')
- CALL UCOPY (IC,IA,40)
- CALL URIGHT (IA,21,30)
- IB(1)=IUEND (IB(4))
- CALL URIGHT (IA,1,10)
- IB(2)=IUEND (IB(5))
- CALL URIGHT (IA,36,40)
- IB(3)=IUEND (IB(6))
- CALL MVERII (15,IB,ICHEK5,6)
-
-C- IC = 40H56789 0123ABCDE86420 1357 77777 Z
-C- ....+....1....+....2....+....3....+....4
- CALL UCTOH1 (' 567890123ABCDE86420 135777777 Z',IB(1),40)
- CALL MVERII (5,IA,IB,40)
-
-C-- TEST FOR USET - IUEND
- CALL NEWGUY ('USET-IUEND.','TBABY ')
- CALL UBLANK (IA,1,40)
- CALL USET (1357,IA,21,25)
- IB(1)=IUEND (IB(3))
- CALL USET (86420,IA,18,20)
- IB(2)=IUEND (IB(4))
- CALL MVERII (6,IA(18),IC(18),8)
- CALL MVERII (16,IB,ICHEK6,4)
-
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/test/pchar/tpkch.F b/src/packlib/kernlib/kerngen/test/pchar/tpkch.F
deleted file mode 100644
index be725f3..0000000
--- a/src/packlib/kernlib/kerngen/test/pchar/tpkch.F
+++ /dev/null
@@ -1,101 +0,0 @@
-*
-* $Id: tpkch.F,v 1.1.1.1 1996/02/15 17:54:55 mclareni Exp $
-*
-* $Log: tpkch.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:55 mclareni
-* Kernlib
-*
-*
-#include "kerngent/pilot.h"
- SUBROUTINE TPKCH
-
-#include "kerngent/mkcde.inc"
-
- COMMON /SLATE/NWCHAR,DUMMY(39)
-
- DIMENSION IPACK(96)
- DIMENSION JGOTIM(2)
- DIMENSION IPARAM(5)
- EQUIVALENCE (NFILL,IPARAM(5))
- INTEGER TINF(4), TINF2(8)
-
- DATA NPACK/96/
- DATA IPACK/
- + 6,5,0,0, 6,4,0,3, 6,0,0,0, 6,0,0,3
- +, 6,10,60,0, 6,6,60,21, 6,20,120,0, 9,12,120,6
- +, 6,0,120,0, 6,30,120,21, 8,0,120,0, 8,0,120,4
- +, 6,0,54,0, 6,0,54,3, 6,0,63,0, 6,0,63,3
- +, 6,8,48,0, 6,6,48,9, 6,6,36,0, 6,4,36,9
- +, 8,4,32,0, 8,3,32,4, 8,8,64,0, 8,6,64,12 /
-
- DATA JGOTIM /9, 33/
- DATA TINF /1000, 4HPKCH, 80, 4HCHAR/
- DATA TINF2 /4HPK 1, 4HUPK , 4HPK 2, 4HUPK , 4HPK 3, 4HUPK ,
- + 4HPK 4, 4HUPK /
-
-
- CALL NEWGUY ('PKCHAR-UPKCH.','TPKCH ')
-
-C- JGO = 1 + 4*( (TN-1)/2 )
-C- TN = 1 + 2*( (JGO-1)/4 ) FOR NFILL ZERO
-C- TN = 2 + ... FOR NFILL NON ZERO
-
- JTEST= 1
-
- DO 29 JPK=1,NPACK,4
- CALL UCOPY (IPACK(JPK),IPARAM,4)
- IPARAM(5)= 0
- 22 CALL VZERO (A,20)
- CALL PKCHAR (INTG,A(2),40,IPARAM)
- IA(1)= NWCHAR
-C CALL TCDUMP (4HPACK,A,15,0)
- CALL VZERO (B(2),40)
- IB(42)= 41
- CALL UPKCH (A(2),B(2),40,IPARAM)
- IB(1)= NWCHAR
- CALL UCOPY (INTG,IA(2),41)
- CALL MVERII (JTEST,B,A,42)
- JTEST= JTEST + 1
- IF (IPARAM(5).NE.0) GO TO 29
- IPARAM(5)= IBCD(1)
- GO TO 22
- 29 CONTINUE
-
-C-- TIMING
- IF (ITIMES.EQ.0) RETURN
- NTIMES = ITIMES*TINF(1)
- TINF(1) = NTIMES
- JEX= 0
-
- DO 94 JLOOP=1,2
- JGO = JGOTIM(JLOOP)
- CALL UCOPY (IPACK(JGO),IPARAM,4)
- IPARAM(5)= 0
- GO TO 82
-
- 81 IPARAM(4)= 3
- IPARAM(5)= IBCD(1)
- 82 JOPER= 0
- GO TO 86
- 83 JOPER= 1
-
- 86 JEX= JEX + 1
- TINF(2)= TINF2(JEX)
- CALL TIMED (TIMERD)
- IF (JOPER.NE.0) GO TO 88
-
- DO 87 J=1,NTIMES
- 87 CALL PKCHAR (INTG,A,80,IPARAM)
-
- GO TO 91
-
- 88 DO 89 J=1,NTIMES
- 89 CALL UPKCH (A,B,80,IPARAM)
-
- 91 CALL TIMING (TINF)
- IF (JOPER.EQ.0) GO TO 83
- IF (NFILL.EQ.0) GO TO 81
- 94 CONTINUE
- RETURN
-
- END
diff --git a/src/packlib/kernlib/kerngen/test/pchar/tublow.F b/src/packlib/kernlib/kerngen/test/pchar/tublow.F
deleted file mode 100644
index f44e071..0000000
--- a/src/packlib/kernlib/kerngen/test/pchar/tublow.F
+++ /dev/null
@@ -1,176 +0,0 @@
-*
-* $Id: tublow.F,v 1.1.1.1 1996/02/15 17:54:55 mclareni Exp $
-*
-* $Log: tublow.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:55 mclareni
-* Kernlib
-*
-*
-#include "kerngent/pilot.h"
- SUBROUTINE TUBLOW
-
-#include "kerngent/mkcde.inc"
-
- COMMON /SLATE/ ISLAT(40)
-
- INTEGER CHECK(10), CHECK4(6), CHKA1(4)
- INTEGER TINF(4), TINF2
-
- DATA CHECK/4H 012,4H3456,4H789A,4HBCDE,4HFGHI,4HJKLM,4HNOPQ,
- +4HRSTU,4HVWXY,4HZ /
- DATA NCH/37/
-
- DATA CHECK4 /4H 012, 4H3456, 4H789A, 4HBCDE, 4HFGHI, 4HJ /
- DATA CHKA1 /4HA , 4HB , 4HC , 4HD /
- DATA IABCD /4HABCD /
-
- DATA TINF /1000, 4HUBLW, 40, 4HCHAR/, TINF2 /4HUBCH/
-
- CALL UZERO(A,1,NCH)
- CALL NEWGUY ('UBLOW-UBUNCH.','TUBLOW ')
-
- CALL UBUNCH (IBCD,A,NCH)
- CALL UBUNCH (IBCD(12),A,0)
- NW= (NCH-1)/IQCHAW +1
- CALL MVERII (1,A,CHECK,NW)
-
- NC2=(NW-1)*IQCHAW
- NCH2=NCH-NC2
- CALL UBUNCH (IBCD(NC2+1),A(NW+1),NCH2)
- CALL MVERII (2,A(NW+1),CHECK(NW),1)
-
- CALL UCOPY (IBCD,IB(101),NCH-1)
- IB(NCH+100)=NCH
- IA(NCH+100)=NCH
- CALL UBLOW (CHECK,IA(101),NCH-1)
- CALL UBLOW (CHECK,IA(121),0)
- CALL MVERII (3,IA(101),IB(101),NCH)
-
- CALL UCOPY (IBCD(NC2+1),IB(101),NCH2)
- CALL UBLOW (CHECK(NW),IA(101),NCH2)
- CALL MVERII (4,IA(101),IB(101),NCH)
-
- CALL UBLOW (IABCD,IA(101),4)
- CALL MVERII (5,IA(101),CHKA1,4)
-
- CALL UCOPY (IBCD,B,27)
-
- DO 27 J=1,27
- NCH = 28 - J
- NW = (NCH-1)/IQCHAW + 1
- CALL VZERO (A,NCH+1)
- IA(NCH+2) = IBCD(3)
- IB(NCH+2) = IBCD(3)
- IB(NCH+1) = IBCD(1)
- IA(NW+101) = IBCD(1)
- CALL UBUNCH (IBCD,A(101),NCH)
- CALL UBLOW (A(101),A(1),NCH+1)
- CALL MVERII (J+10,A,B,NCH+2)
- 27 CONTINUE
-
-C---- UTRANS FOR A1 <---> A4
-
- CALL NEWGUY ('UTRANS FOR A1.','TUBLOW ')
- CALL UCOPY (IBCD, B, 32)
- CALL UCOPY (CHECK4,B(51), 6)
-
- DO 34 JJ=1,5
- JH = 6 - JJ
- NCH = 4*JH
- CALL VZERO (A,JH+50)
-
- IA(JH+51) = IBCD(3)
- IB(JH+51) = IBCD(3)
- CALL UTRANS (IBCD,A(51),NCH, 1,4)
- IA(57) = ISLAT(1)
- IA(58) = ISLAT(2)
- IB(57) = NCH
- IB(58) = JH
- CALL MVERII (JJ,A(51),B(51),8)
-
- IB(JH+51) = IBCD(NCH+1)
- CALL UTRANS (IBCD,A(51),NCH+1, 1,4)
- IA(57) = ISLAT(1)
- IA(58) = ISLAT(2)
- IB(57) = NCH+ 1
- IB(58) = JH + 1
- CALL MVERII (JJ+10,A(51),B(51),8)
-
- IA(NCH+3) = IB(NCH+3)
- IB(NCH+2) = IBCD(1)
- CALL UTRANS (B(51),A,NCH+2, 4,1)
- IA(NCH+4) = ISLAT(1)
- IA(NCH+5) = ISLAT(2)
- IB(NCH+4) = JH + 1
- IB(NCH+5) = NCH+ 2
- CALL MVERII (JJ+20,A,B,NCH+5)
-
- IA(NCH+1) = IBCD(3)
- IB(NCH+1) = IBCD(3)
- CALL UTRANS (B(51),A,NCH, 4,1)
- IA(NCH+2) = ISLAT(1)
- IA(NCH+3) = ISLAT(2)
- IB(NCH+2) = JH
- IB(NCH+3) = NCH
- CALL MVERII (JJ+30,A,B,NCH+3)
- 34 CONTINUE
-
-C---- UTRANS FOR A4 <---> AX
-
- CALL NEWGUY ('UTRANS FOR A4.','TUBLOW ')
- CALL UCOPY (IBCD,B(201),27)
-
- DO 44 JJ=1,22
- NCH = 23 - JJ
- NW4 = (NCH-1)/4 + 1
- NW = (NCH-1)/IQCHAW + 1
-
- IB(NCH+201) = IBCD(1)
- CALL UTRANS (B(201), B, NCH+1, 1,4)
- CALL UBUNCH (B(201), B(21), NCH+1)
-
- IB(NCH+201) = IBCD(3)
- CALL UTRANS (B(201), B(101), NCH+1, 1,4)
- CALL UBUNCH (B(201), B(121), NCH+1)
- CALL VZERO (A,NW+20)
-
- IA(NW+21) = NCH
- IB(NW+21) = NCH
- IB(NW+22) = NW4
- IB(NW+23) = NW
- CALL UTRANS (B(101),A(21),NCH, 4,99)
- IA(NW+22) = ISLAT(1)
- IA(NW+23) = ISLAT(2)
- CALL MVERII (JJ,A(21),B(21),NW+3)
-
- IA(NW4+1) = NCH
- IB(NW4+1) = NCH
- IB(NW4+2) = NW4
- IB(NW4+3) = NW
- CALL UTRANS (B(121),A,NCH, 99,4)
- IA(NW4+2) = ISLAT(2)
- IA(NW4+3) = ISLAT(1)
- CALL MVERII (JJ+50,A,B,NW4+3)
- 44 CONTINUE
-
-C-- TIMING
- IF (ITIMES.EQ.0) RETURN
- NTIMES = ITIMES*TINF(1)
- TINF(1) = NTIMES
- CALL UBUNCH(IBCD,A,40)
- CALL TIMED (TIMERD)
-
- DO 80 J=1,NTIMES
- 80 CALL UBLOW(A,B,40)
-
- CALL TIMING (TINF)
- TINF(2)= TINF2
- CALL TIMED (TIMERD)
-
- DO 81 J=1,NTIMES
- 81 CALL UBUNCH (B,A,40)
-
- CALL TIMING (TINF)
- RETURN
-
- END
diff --git a/src/packlib/kernlib/kerngen/test/pchar/tuctoh.F b/src/packlib/kernlib/kerngen/test/pchar/tuctoh.F
deleted file mode 100644
index a0809db..0000000
--- a/src/packlib/kernlib/kerngen/test/pchar/tuctoh.F
+++ /dev/null
@@ -1,123 +0,0 @@
-*
-* $Id: tuctoh.F,v 1.1.1.1 1996/02/15 17:54:55 mclareni Exp $
-*
-* $Log: tuctoh.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:55 mclareni
-* Kernlib
-*
-*
-#include "kerngent/pilot.h"
- SUBROUTINE TUCTOH
-
-#include "kerngent/mkcde.inc"
-
- DIMENSION IQLETT(26)
- EQUIVALENCE (IQLETT(1),IBCD(12)), (IQBLAN,IBCD(1))
-
- CHARACTER CH1*40
-
-C----------- UH1TOC - UCTOH1
-
- CALL NEWGUY ('UH1TOC-UCTOH1.','TUCTOH ')
- CALL UCOPY (IBCD,IB,40)
-
- CALL UH1TOC (IB,CH1,40)
-
- DO 24 NCHT=1,24
- CALL UH1TOC (IQLETT,CH1,NCHT)
- CALL UCTOH1 (CH1,IA,40)
- IB(NCHT) = IQLETT(NCHT)
- CALL MVERII (NCHT,IA,IB,40)
- 24 CONTINUE
-
-C----------- UHTOC
-
- CALL NEWGUY ('UHTOC.','TUCTOH ')
-
-C WRITE (ITB,9934) (IBCD(J),J,J=1,47)
-C 9934 FORMAT (' IBCD: ',5(Z9,I3)/(10X,5(Z9,I3)))
-
-C WRITE (ITB,9935) (IQLETT(J),J,J=1,27)
-C 9935 FORMAT (1X/' IQLETT: ',5(Z9,I3)/(10X,5(Z9,I3)))
-
- DO 35 NCHPW=1,IQCHAW
- ID = 100*NCHPW
- CALL UCOPY (IBCD,IB,40)
- CALL UTRANS (IQLETT,IB(101),28,1,NCHPW)
-
- CALL UH1TOC (IB,CH1,40)
-
- DO 34 NCHT=1,24
- CALL UHTOC (IB(101),NCHPW,CH1,NCHT)
- CALL UCTOH1 (CH1,IA,40)
- IB(NCHT) = IQLETT(NCHT)
- CALL MVERII (ID+NCHT,IA,IB,40)
- 34 CONTINUE
- CALL PRTEST
- 35 CONTINUE
-
-C----------- UCTOH
-
- CALL NEWGUY ('UCTOH.','TUCTOH ')
- CALL UH1TOC (IQLETT,CH1,26)
- IA(1) = 99
- IB(1) = 99
-
- DO 45 NCHPW=1,IQCHAW
- ID = 100*NCHPW
-
- DO 44 NCHT=1,24
- CALL UTRANS (IQLETT,IB(2),NCHT,1,NCHPW)
-
- NW = (NCHT-1)/NCHPW + 3
- IA(NW) = -99
- IB(NW) = -99
- CALL UCTOH (CH1,IA(2),NCHPW,NCHT)
- CALL MVERII (ID+NCHT,IA,IB,NW)
- 44 CONTINUE
- CALL PRTEST
- 45 CONTINUE
-
-C-- TIMING
- IF (ITIMES.EQ.0) RETURN
- NTIMES = ITIMES * 1000
-
-C-- UHTOC / UH1TOC
-
- DO 66 NCHT=4,40,6
- DO 63 NCHPW=4,1,-1
-
- CALL TIMED (TIMERD)
- DO 62 JN=1,NTIMES
- CALL UHTOC (IB,NCHPW,CH1,NCHT)
- 62 CONTINUE
- CALL TIME77 (NTIMES,'UHTOC ',NCHT*100+NCHPW,' ')
- 63 CONTINUE
-
- CALL TIMED (TIMERD)
- DO 65 JN=1,NTIMES
- CALL UH1TOC (IB,CH1,NCHT)
- 65 CONTINUE
- CALL TIME77 (NTIMES,'UH1TOC',NCHT*100,' ')
- 66 CONTINUE
-
-C-- UCTOH / UCTOH1
-
- DO 76 NCHT=4,40,6
- DO 73 NCHPW=4,1,-1
-
- CALL TIMED (TIMERD)
- DO 72 JN=1,NTIMES
- CALL UCTOH (CH1,IB,NCHPW,NCHT)
- 72 CONTINUE
- CALL TIME77 (NTIMES,'UCTOH ',NCHT*100+NCHPW,' ')
- 73 CONTINUE
-
- CALL TIMED (TIMERD)
- DO 75 JN=1,NTIMES
- CALL UCTOH1 (CH1,IB,NCHT)
- 75 CONTINUE
- CALL TIME77 (NTIMES,'UCTOH1',NCHT*100,' ')
- 76 CONTINUE
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/test/pdiv/Imakefile b/src/packlib/kernlib/kerngen/test/pdiv/Imakefile
deleted file mode 100644
index 830da6f..0000000
--- a/src/packlib/kernlib/kerngen/test/pdiv/Imakefile
+++ /dev/null
@@ -1,4 +0,0 @@
-SRCS_F= \ @@\
- tmaxmu.F trandm.F tscale.F tsortn.F ttrigo.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kerngen/test/pdiv/tmaxmu.F b/src/packlib/kernlib/kerngen/test/pdiv/tmaxmu.F
deleted file mode 100644
index 9d88437..0000000
--- a/src/packlib/kernlib/kerngen/test/pdiv/tmaxmu.F
+++ /dev/null
@@ -1,46 +0,0 @@
-*
-* $Id: tmaxmu.F,v 1.1.1.1 1996/02/15 17:54:56 mclareni Exp $
-*
-* $Log: tmaxmu.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:56 mclareni
-* Kernlib
-*
-*
-#include "kerngent/pilot.h"
- SUBROUTINE TMAXMU
-
-#include "kerngent/mkcde.inc"
-
- DIMENSION CHECK(3)
- INTEGER TINF(4)
- DATA CHECK / 100., 10., 50./
- DATA TINF /1000, 4HAMAX, 50, 4H10*5/
-
- CALL NEWGUY ('AMAXMU.','TMAXMU ')
- ZERLEV = ZEROV(1)
- I1=0
-
- DO 5 I=1,10
- II=I
- DO 5 J=1,10
- I1=I1+1
- A(I1)=INTG(II)
- 5 II=II+10
-
- B(1)=AMAXMU (A,1,100,0) 100.
- B(2)=AMAXMU (A,10,1,10) 10.
- B(3)=AMAXMU (A,10,5,10) 50.
- CALL MVERIF (1,B,CHECK,3)
-
-C-- TIMING
- IF (ITIMES.EQ.0) RETURN
- NTIMES = ITIMES*TINF(1)
- TINF(1) = NTIMES
- CALL TIMED (TIMERD)
-
- DO 80 J=1,NTIMES
- 80 B(1)=AMAXMU (A,10,5,10)
-
- CALL TIMING (TINF)
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/test/pdiv/trandm.F b/src/packlib/kernlib/kerngen/test/pdiv/trandm.F
deleted file mode 100644
index fb77f01..0000000
--- a/src/packlib/kernlib/kerngen/test/pdiv/trandm.F
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: trandm.F,v 1.1.1.1 1996/02/15 17:54:56 mclareni Exp $
-*
-* $Log: trandm.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:56 mclareni
-* Kernlib
-*
-*
-#include "kerngent/pilot.h"
- SUBROUTINE TRANDM
-
-#include "kerngent/mkcde.inc"
-
-
-
-
-
-
-
-
-
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/test/pdiv/tscale.F b/src/packlib/kernlib/kerngen/test/pdiv/tscale.F
deleted file mode 100644
index 22ab9e1..0000000
--- a/src/packlib/kernlib/kerngen/test/pdiv/tscale.F
+++ /dev/null
@@ -1,48 +0,0 @@
-*
-* $Id: tscale.F,v 1.1.1.1 1996/02/15 17:54:56 mclareni Exp $
-*
-* $Log: tscale.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:56 mclareni
-* Kernlib
-*
-*
-#include "kerngent/pilot.h"
- SUBROUTINE TSCALE
-
-#include "kerngent/mkcde.inc"
-
- DIMENSION CB(10),IC(10),IN(10)
- EQUIVALENCE (CB(1),A(11)),(IC(1),A(21)),(IN(1),B(11))
-
- CALL NEWGUY ('PSCALE.','TSCALE ')
- ZERLEV = 2*ZEROV(2)
-
- A(1)=1234567800.
- DO 5 I=2,8
- 5 A(I)=A(I-1)*.001
-
- A(9)=0.
-
-C-- PREPARE CHECK-VECTOR
-
- IC(1) = -6
- CB(1) = 10.**(-6)
-
- DO 10 I=2,6
- IC(I) = IC(I-1) + 3
- 10 CB(I) = CB(I-1) * 1000.
-
- IC(7)=IC(6)
- IC(8)=IC(6)
- IC(9)=IC(6)
- CB(7)=CB(6)
- CB(8)=CB(6)
- CB(9)=CB(6)
-
- DO 20 I=1,9
- 20 B(I)=PSCALE (IN(I),9,A(I),4)
-
- CALL MVERIF (1,B,CB,9)
- CALL MVERII (2,IN,IC,9)
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/test/pdiv/tsortn.F b/src/packlib/kernlib/kerngen/test/pdiv/tsortn.F
deleted file mode 100644
index f70650a..0000000
--- a/src/packlib/kernlib/kerngen/test/pdiv/tsortn.F
+++ /dev/null
@@ -1,230 +0,0 @@
-*
-* $Id: tsortn.F,v 1.1.1.1 1996/02/15 17:54:56 mclareni Exp $
-*
-* $Log: tsortn.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:56 mclareni
-* Kernlib
-*
-*
-#include "kerngent/pilot.h"
- SUBROUTINE TSORTN
-
-#include "kerngent/mkcde.inc"
-
- DIMENSION IMAT(100), AMAT(100)
- EQUIVALENCE (IMAT(1),IB(1)), (AMAT(1),B(101))
-
-C DOUBLE PRECISION DMAT(100)
-C EQUIVALENCE (DMAT(1),IB(201))
-
-
- CALL VZERO (IA,1000)
- CALL UCOPY (INTG,IA,100)
-
- DO 14 J=1,99,4
- 14 IA(J) = J/16 - 2
-
- CALL UCOPY (INTG(2),IA(101),10)
- IA(111)= 12
- CALL UCOPY (INTG(12),IA(112),9)
-
- DO 18 I= 1,20
- J=21-I
- 18 IA(I+120) = J
-
- CALL NEWGUY ('SORTI/R/D.','TSORTN ')
-
-#if defined(CERNLIB_DEVMIK)
- IF (LOGLEV.NE.0) WRITE (ITB,9801) (IA(J),J=1,100)
- IF (LOGLEV.NE.0) WRITE (ITB,9802) (IA(J),J=101,120)
- IF (LOGLEV.NE.0) WRITE (ITB,9803) (IA(J),J=121,140)
- 9801 FORMAT (' IA(1:100) is :'/1X/25(4X,4I4/))
- 9802 FORMAT (' IA(101:120) is :'/1X/2(4X,10I4/))
- 9803 FORMAT (' IA(121:140) is :'/1X/2(4X,10I4/))
-#endif
-
-C---- Test SORTI normal
-
- CALL UCOPY (IA(65), IMAT(1), 36)
- CALL UCOPY (IA(49), IMAT(37), 16)
- CALL UCOPY (IA(1), IMAT(53), 48)
-#if defined(CERNLIB_DEVMIK)
- IF (LOGLEV.NE.0) WRITE (ITB,9810) (IMAT(J),J=1,100)
- 9810 FORMAT (' 11/1 bef > IMAT(1:100) is :'/1X/25(4X,4I4/))
-#endif
-
- CALL SORTI (IMAT, 4, 25, 1)
-#if defined(CERNLIB_DEVMIK)
- IF (LOGLEV.NE.0) WRITE (ITB,9811) (IMAT(J),J=1,100)
- 9811 FORMAT (' 11/1 aft > IMAT(1:100) is :'/1X/25(4X,4I4/))
-#endif
-
- CALL MVERII (11,IMAT,IA,100)
-
- CALL UCOPY (IA(65), IMAT(1), 36)
- CALL UCOPY (IA(49), IMAT(37), 16)
- CALL UCOPY (IA(1), IMAT(53), 48)
- CALL SORTI (IMAT, 4, 25, -1)
-#if defined(CERNLIB_DEVMIK)
- CALL PRTEST
- IF (LOGLEV.NE.0) WRITE (ITB,9812) (IMAT(J),J=1,100)
- 9812 FORMAT (' 12/1 aft > IMAT(1:100) is :'/1X/25(4X,4I4/))
-#endif
-
- CALL SORTI (IMAT, 4, 25, 1)
-#if defined(CERNLIB_DEVMIK)
- IF (LOGLEV.NE.0) WRITE (ITB,9813) (IMAT(J),J=1,100)
- 9813 FORMAT (' 12/2 aft > IMAT(1:100) is :'/1X/25(4X,4I4/))
-#endif
-
- CALL MVERII (12,IMAT,IA,100)
-
- CALL UCOPY (INTG, IMAT, 20)
- IMAT(1) = 12
-#if defined(CERNLIB_DEVMIK)
- CALL PRTEST
- IF (LOGLEV.NE.0) WRITE (ITB,9814) (IMAT(J),J=1,20)
- 9814 FORMAT (' 13/1 bef > IMAT(1:20) is :'/1X/2(4X,10I4/))
-#endif
-
- CALL SORTI (IMAT,10, 2, 1)
-#if defined(CERNLIB_DEVMIK)
- IF (LOGLEV.NE.0) WRITE (ITB,9815) (IMAT(J),J=1,20)
- 9815 FORMAT (' 13/2 aft > IMAT(1:20) is :'/1X/2(4X,10I4/))
-#endif
-
- CALL SORTI (IMAT, 1,20, 1)
-#if defined(CERNLIB_DEVMIK)
- IF (LOGLEV.NE.0) WRITE (ITB,9816) (IMAT(J),J=1,20)
- 9816 FORMAT (' 13/3 aft > IMAT(1:20) is :'/1X/2(4X,10I4/))
-#endif
-
- CALL MVERII (13,IMAT,IA(101),20)
-
- CALL UCOPY (INTG,IMAT,20)
-#if defined(CERNLIB_DEVMIK)
- CALL PRTEST
- IF (LOGLEV.NE.0) WRITE (ITB,9817) (IMAT(J),J=1,20)
- 9817 FORMAT (' 14/1 bef > IMAT(1:20) is :'/1X/2(4X,10I4/))
-#endif
-
- CALL SORTI (IMAT, 1,20,-1)
-#if defined(CERNLIB_DEVMIK)
- IF (LOGLEV.NE.0) WRITE (ITB,9818) (IMAT(J),J=1,20)
- 9818 FORMAT (' 14/1 aft > IMAT(1:20) is :'/1X/2(4X,10I4/))
-#endif
-
- CALL MVERII (14,IMAT,IA(121),20)
-
-C---- TEST FAULTY CALLS
-C CALL UCOPY (IA,IMAT,20)
-C CALL SORTI (IMAT, 4, 5, 0)
-C CALL SORTI (IMAT, 4, 5,100)
-C CALL SORTI (IMAT, 4, 0,1)
-C CALL MVERII (15,IMAT,INTG ,20)
-
-C---- Test SORTR normal
-
- DO 32 J=1,140
- 32 A(J+200) = IA(J)
-
- CALL UCOPY (A(265), AMAT(1), 36)
- CALL UCOPY (A(249), AMAT(37), 16)
- CALL UCOPY (A(201), AMAT(53), 48)
-#if defined(CERNLIB_DEVMIK)
- IF (LOGLEV.NE.0) WRITE (ITB,9820) (AMAT(J),J=1,100)
- 9820 FORMAT (' 21/1 bef > AMAT(1:100) is :'/1X/25(4X,4F5.0/))
-#endif
-
- CALL SORTR (AMAT, 4, 25, 1)
-#if defined(CERNLIB_DEVMIK)
- IF (LOGLEV.NE.0) WRITE (ITB,9821) (AMAT(J),J=1,100)
- 9821 FORMAT (' 21/1 aft > AMAT(1:100) is :'/1X/25(4X,4F5.0/))
-#endif
-
- CALL MVERIF (21,AMAT,A(201),100)
-
- CALL UCOPY (A(265), AMAT(1), 36)
- CALL UCOPY (A(249), AMAT(37), 16)
- CALL UCOPY (A(201), AMAT(53), 48)
- CALL SORTR (AMAT, 4, 25, -1)
-#if defined(CERNLIB_DEVMIK)
- CALL PRTEST
- IF (LOGLEV.NE.0) WRITE (ITB,9822) (AMAT(J),J=1,100)
- 9822 FORMAT (' 22/1 aft > AMAT(1:100) is :'/1X/25(4X,4F5.0/))
-#endif
-
- CALL SORTR (AMAT, 4, 25, 1)
-#if defined(CERNLIB_DEVMIK)
- IF (LOGLEV.NE.0) WRITE (ITB,9823) (AMAT(J),J=1,100)
- 9823 FORMAT (' 22/2 aft > AMAT(1:100) is :'/1X/25(4X,4F5.0/))
-#endif
-
- CALL MVERIF (22,AMAT,A(201),100)
-
- CALL VFLOAT (INTG, AMAT, 20)
- AMAT(1) = 12.
-#if defined(CERNLIB_DEVMIK)
- CALL PRTEST
- IF (LOGLEV.NE.0) WRITE (ITB,9824) (AMAT(J),J=1,20)
- 9824 FORMAT (' 23/1 bef > AMAT(1:20) is :'/1X/2(4X,10F5.0/))
-#endif
-
- CALL SORTR (AMAT,10, 2, 1)
-#if defined(CERNLIB_DEVMIK)
- IF (LOGLEV.NE.0) WRITE (ITB,9825) (AMAT(J),J=1,20)
- 9825 FORMAT (' 23/2 aft > AMAT(1:20) is :'/1X/2(4X,10F5.0/))
-#endif
-
- CALL SORTR (AMAT, 1,20, 1)
-#if defined(CERNLIB_DEVMIK)
- IF (LOGLEV.NE.0) WRITE (ITB,9826) (AMAT(J),J=1,20)
- 9826 FORMAT (' 23/3 aft > AMAT(1:20) is :'/1X/2(4X,10F5.0/))
-#endif
-
- CALL MVERIF (23,AMAT,A(301),20)
-
- CALL VFLOAT (INTG,AMAT,20)
-#if defined(CERNLIB_DEVMIK)
- CALL PRTEST
- IF (LOGLEV.NE.0) WRITE (ITB,9827) (AMAT(J),J=1,20)
- 9827 FORMAT (' 24/1 bef > AMAT(1:20) is :'/1X/2(4X,10F5.0/))
-#endif
-
- CALL SORTR (AMAT, 1,20,-1)
-#if defined(CERNLIB_DEVMIK)
- IF (LOGLEV.NE.0) WRITE (ITB,9828) (AMAT(J),J=1,20)
- 9828 FORMAT (' 24/1 aft > AMAT(1:20) is :'/1X/2(4X,10F5.0/))
-#endif
-
- CALL MVERIF (24,AMAT,A(321),20)
-
-C---- TEST FAULTY CALLS
-C CALL UCOPY (IA,AMAT,20)
-C CALL SORTR (AMAT, 4, 5, 0)
-C CALL SORTR (AMAT, 4, 5,100)
-C CALL SORTR (AMAT, 4, 0,1)
-C CALL MVERIF (25,AMAT,INTG ,20)
-
-C-- TIMING
- IF (ITIMES.EQ.0) RETURN
- NTIMES = ITIMES*200
- CALL UCOPY (INTG,IMAT,100)
- CALL TIMED (TIMERD)
-
- DO 72 J= 1,NTIMES
- CALL SORTI (IMAT,4,25,-1)
- CALL SORTI (IMAT,4,25, 1)
- 72 CONTINUE
- CALL TIME77 (NTIMES,'SORTI ',200,'words')
-
- CALL VFLOAT (INTG,AMAT,100)
- CALL TIMED (TIMERD)
-
- DO 74 J= 1,NTIMES
- CALL SORTR (AMAT,4,25,-1)
- CALL SORTR (AMAT,4,25, 1)
- 74 CONTINUE
- CALL TIME77 (NTIMES,'SORTR ',200,'words')
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/test/pdiv/ttrigo.F b/src/packlib/kernlib/kerngen/test/pdiv/ttrigo.F
deleted file mode 100644
index 178eb98..0000000
--- a/src/packlib/kernlib/kerngen/test/pdiv/ttrigo.F
+++ /dev/null
@@ -1,96 +0,0 @@
-*
-* $Id: ttrigo.F,v 1.1.1.1 1996/02/15 17:54:56 mclareni Exp $
-*
-* $Log: ttrigo.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:56 mclareni
-* Kernlib
-*
-*
-#include "kerngent/pilot.h"
- SUBROUTINE TTRIGO
-
-#include "kerngent/mkcde.inc"
-
- DIMENSION TABLE(9),TABLE2(9)
- +, AS(9),AC(9),AT(9)
- +, VASIN(9),VACOS(9),VATG(9)
- +, PROX(8),PROXMN(8),PROXCK(8),PROXPL(8)
-
- EQUIVALENCE (B(1),TABLE(1)),(B(11),TABLE2(1))
- +, (B(21),AS(1)),(B(31),AC(1)),(B(41),AT(1))
- +, (B(51),VASIN(1)),(B(61),VACOS(1)),(B(71),VATG(1))
- +, (B(81),PROX(1)),(B(91),PROXMN(1))
- +, (B(101),PROXPL(1)),(B(111),PROXCK(1))
-
- PARAMETER (PI = 3.14159 26535 89793)
-
-C- function ATG from Mathlib here as a statement function
- ATG(RSINA,RCOSA) = ATAN2(RSINA,RCOSA) + (PI-SIGN(PI,RSINA))
-
- CALL NEWGUY ('ATG-ASIN-ACOS-PROXIM.','TTRIGO ')
-
- ZERLEV=ZEROV(3)
- PIBY2= PI/2.
- PIBY4= PI/4.
- CALL UZERO (AT,1,9)
-
- AK= .1
-
- DO 10 J=1,9
- TABLE(J)= AK
- AS(J)= SIN(AK)
- AC(J)= COS(AK)
- IF (J.NE.3.AND.J.NE.7) AT(J)= TAN(AK)
- VASIN(J)= ASIN(AS(J))
- VACOS(J)= ACOS(AC(J))
- VATG(J)= ATG (AS(J),AC(J))
-
- IF(J.LE.2) GO TO 9
-
- IF (J.LE.6) THEN
- VASIN(J)= PI - VASIN(J)
- ELSE
- VASIN(J)= 2.*PI + VASIN(J)
- ENDIF
-
- IF (J.GE.9) THEN
- VACOS(J)= 2.*PI + VACOS(J)
- ELSEIF (J.GE.5) THEN
- VACOS(J)= 2.*PI - VACOS(J)
- ENDIF
-
- 9 VATG(J)= PROXIM(VATG(J),AK)
- 10 AK= AK + PIBY4
-
- CALL MVERIF (1,VATG,TABLE,9)
- CALL MVERIF (2,VASIN,TABLE ,9)
- CALL MVERIF (3,VACOS,TABLE ,9)
-
- CALL UZERO (TABLE2,1,9)
-
- DO 20 J=1,9
- IF (J.NE.3.AND.J.NE.7) TABLE2(J)= AS(J)/AC(J)
- 20 CONTINUE
-
- CALL MVERIF (4,AT,TABLE2,9)
-
- PROX(1)=ZERLEV
-
- DO 25 I=2,8
- 25 PROX(I)=PROX(I-1)+PIBY2
-
- CALL UCOPY (PROX,PROXCK,3)
- PROXCK(4)=PROX(1)-PIBY2
- CALL UCOPY (PROXCK,PROXCK(5),4)
-
- DO 30 I=1,8
- PROXMN(I)=PROXIM (PROX(I),-PIBY4)
- 30 PROXPL(I)=PROXIM (PROX(I),PIBY4)
-
- CALL MVERIF (6,PROXPL,PROXCK,8)
-
- PROXCK(3)=PROXCK(4)-PIBY2
- CALL UCOPY (PROXCK,PROXCK(5),4)
- CALL MVERIF (5,PROXMN,PROXCK,8)
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/test/pm432/Imakefile b/src/packlib/kernlib/kerngen/test/pm432/Imakefile
deleted file mode 100644
index 6a9d2c7..0000000
--- a/src/packlib/kernlib/kerngen/test/pm432/Imakefile
+++ /dev/null
@@ -1,4 +0,0 @@
-SRCS_F= \ @@\
- ticnth.F tlenoc.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kerngen/test/pm432/ticnth.F b/src/packlib/kernlib/kerngen/test/pm432/ticnth.F
deleted file mode 100644
index de239c2..0000000
--- a/src/packlib/kernlib/kerngen/test/pm432/ticnth.F
+++ /dev/null
@@ -1,134 +0,0 @@
-*
-* $Id: ticnth.F,v 1.1.1.1 1996/02/15 17:54:55 mclareni Exp $
-*
-* $Log: ticnth.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:55 mclareni
-* Kernlib
-*
-*
-#include "kerngent/pilot.h"
- SUBROUTINE TICNTH
-
-#include "kerngent/mkch.inc"
-#include "kerngent/mkcde.inc"
-
- PARAMETER (NPMOR=6, NAMOR=12)
- CHARACTER CHPMOR(NPMOR)*8, CHAMOR(NAMOR)*8
- DIMENSION MUMORG(NAMOR)
-
- PARAMETER (NHAVE=7, NLOOK=14)
- CHARACTER CHHAVE(NHAVE)*8, CHLOOK(NLOOK)*8
- DIMENSION MUSTNE(NLOOK)
-
- PARAMETER (NPXOR=4, NAXOR=20)
- CHARACTER CHPXOR(NPXOR)*6, CHAXOR(NAXOR)*8
- DIMENSION MUST14(NAXOR), MUST15(NAXOR)
-
- DATA CHPMOR / 'del*ete ', 'add ', 'adb*efor',
- + 'rep*lace', 'ch*ange ', 'c*ol* '/
- DATA CHAMOR / 'add! ', 'delete! ', 'del! ', 'del ! ',
- + 'delphi! ', 'deleted!', 'replaced', 'chan! ',
- + 'channel!', 'c! ', 'columns!', 'cols! ' /
- DATA MUMORG / 2, 1, 1, 1, 0, 0, 4, 5, 0, 6, 6, 6 /
-
- DATA CHHAVE / 'apo ', 'apol ', 'apollo ', 'irs6000 ',
- + 'decra1 ', 'decra2 ', 'decra3 '/
- DATA CHLOOK / 'apo ', 'apo* ', 'ap*ollo ', 'ap* ',
- + 'ap ', 'apol ', 'apoll ', 'apoll* ',
- + 'ir*s60 ', 'ir*s70 ',
- + 'dec* ', 'dec*ra ', 'dec*ra* ', 'dec*ra3 ' /
- DATA MUSTNE / 1, 1, 1, 1, 0, 2, 0, 3, 4, 0, 5, 5, 5, 7 /
-
- DATA CHPXOR / 'change', 'cle*ar', 'mov*e ', 'c*ol* ' /
- DATA CHAXOR /
- + 'changed ', 'change ', 'cleared ', 'clear ', 'clea ',
- + 'cle ', 'move ', 'mov ', 'collect ', 'column ',
- + 'col ', 'co ', 'c ', 'chang ', 'cl ',
- + 'moved ', 'movi ', 'com ', 'cilan ', 'MOVE ' /
-
- DATA MUST14 / 1, 1, 2, 2, 2, 2, 3, 3, 4, 4, 4, 4, 4, 7*0 /
- DATA MUST15 / 0, 0, 2, 2, 2, 2, 3, 3, 4, 4, 4, 4, 4, 7*0 /
-
-C----------- ICNTH
-
- CALL NEWGUY ('ICNTH - ICINQ.', 'TICNTH ')
-
- DO 24 JA=1,NAMOR
- N = ICFIND ('!', CHAMOR(JA),1,8) - 1
- 24 IA(JA) = ICNTH (CHAMOR(JA)(1:N), CHPMOR, NPMOR)
- CALL MVERII (11,IA,MUMORG,NAMOR)
-
- DO 26 JA=1,NLOOK
- N = ICFIND ('!', CHLOOK(JA),1,8) - 1
- 26 IA(JA) = ICINQ (CHLOOK(JA)(1:N), CHHAVE, NHAVE)
- CALL MVERII (12,IA,MUSTNE,NLOOK)
-
-
- DO 34 JA=1,NAXOR
- 34 IA(JA) = ICNTH (CHAXOR(JA), CHPXOR, NPXOR)
- CALL MVERII (14,IA,MUST14,NAXOR)
-
- DO 35 JA=1,NAXOR
- 35 IA(JA) = ICNTH (CHAXOR(JA)(1:5), CHPXOR, NPXOR)
- CALL MVERII (15,IA,MUST15,NAXOR)
-
-C----------- ICNTHL
-
- CALL NEWGUY ('ICNTHL - ICINQL.', 'TICNTH ')
-
- DO 41 J=1,NAMOR,2
- 41 CALL CLTOU (CHAMOR(J))
-
- DO 42 J=1,NLOOK,2
- 42 CALL CLTOU (CHLOOK(J))
-
- DO 44 JA=1,NAMOR
- N = ICFIND ('!', CHAMOR(JA),1,8) - 1
- 44 IA(JA) = ICNTHL (CHAMOR(JA)(1:N), CHPMOR, NPMOR)
- CALL MVERII (41,IA,MUMORG,NAMOR)
-
- DO 46 JA=1,NLOOK
- N = ICFIND ('!', CHLOOK(JA),1,8) - 1
- 46 IA(JA) = ICINQL (CHLOOK(JA)(1:N), CHHAVE, NHAVE)
- CALL MVERII (43,IA,MUSTNE,NLOOK)
-
-C----------- ICNTHU
-
- CALL NEWGUY ('ICNTHU - ICINQU.', 'TICNTH ')
-
- DO 51 J=1,NPMOR
- 51 CALL CLTOU (CHPMOR(J))
-
- DO 52 J=1,NHAVE
- 52 CALL CLTOU (CHHAVE(J))
-
- DO 54 JA=1,NAMOR
- N = ICFIND ('!', CHAMOR(JA),1,8) - 1
- 54 IA(JA) = ICNTHU (CHAMOR(JA)(1:N), CHPMOR, NPMOR)
- CALL MVERII (51,IA,MUMORG,NAMOR)
-
- DO 56 JA=1,NLOOK
- N = ICFIND ('!', CHLOOK(JA),1,8) - 1
- 56 IA(JA) = ICINQU (CHLOOK(JA)(1:N), CHHAVE, NHAVE)
- CALL MVERII (53,IA,MUSTNE,NLOOK)
-
-C-- TIMING
- IF (ITIMES.EQ.0) RETURN
-
- DO 72 JA=1,NAMOR
- CALL CTRANS ('!', ' ', CHAMOR(JA), 1,8)
- 72 CALL CUTOL (CHAMOR(J))
-
- DO 73 J=1,NPMOR
- 73 CALL CUTOL (CHPMOR(J))
-
- NTIMES = ITIMES*4000
- CALL TIMED (TIMERD)
-
- DO 76 J= 1,NTIMES
- DO 75 JA=1,NAMOR
- 75 IA(JA) = ICNTH (CHAMOR(JA), CHPMOR, NPMOR)
- 76 CONTINUE
- CALL TIME77 (NTIMES*NAMOR,'ICNTHU',NPMOR,'entries')
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/test/pm432/tlenoc.F b/src/packlib/kernlib/kerngen/test/pm432/tlenoc.F
deleted file mode 100644
index 10fd599..0000000
--- a/src/packlib/kernlib/kerngen/test/pm432/tlenoc.F
+++ /dev/null
@@ -1,115 +0,0 @@
-*
-* $Id: tlenoc.F,v 1.1.1.1 1996/02/15 17:54:55 mclareni Exp $
-*
-* $Log: tlenoc.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:55 mclareni
-* Kernlib
-*
-*
-#include "kerngent/pilot.h"
- SUBROUTINE TLENOC
-
-#include "kerngent/mkch.inc"
-#include "kerngent/mkcde.inc"
-
- CHARACTER LINE*80, COL(80)*1
- EQUIVALENCE (LINE,COL,MKLINE)
-
-C----------- LNBLNK
-
- CALL NEWGUY ('LNBLNK - LENOCC.','TLENOC ')
-
- IA(1) = 0
- LINE = 'alphabeta'
- NTN = 1
-
- DO 24 JA=1,11
- DO 24 JE=JA,80
- MUST = MAX (MIN(JE,9)-JA+1,0)
- NOCC = LNBLNK(LINE(JA:JE))
- IF (NOCC.NE.MUST) GO TO 29
- 24 CONTINUE
- CALL MVERII (NTN,IA,IA,1)
-
- NTN = 2
- DO 26 JA=1,11
- LINE = 'alphabeta'
- DO 26 JE=40,79
- COL(JE-JA) = 'x'
- COL(JE+1) = 'y'
- MUST = JE+1 - 2*JA
- NOCC = LNBLNK(LINE(JA:JE))
- IF (NOCC.NE.MUST) GO TO 29
- COL(JE+1) = ' '
- 26 CONTINUE
- CALL MVERII (NTN,IA,IA,1)
- GO TO 31
-
- 29 CALL MVERII (NTN,NOCC,MUST,1)
- WRITE (ITB,9029) JA,JE,MUST,NOCC
- 9029 FORMAT (' Test of LNBLNK failed : JA,JE,MUST,HAVE =',4I6/)
-
-C----------- LENOCC
-
- 31 IA(1) = 0
- LINE = 'alphabeta'
- NTN = 3
-
- DO 34 JA=1,11
- DO 34 JE=JA,80
- MUST = MAX (MIN(JE,9)-JA+1,0)
- NOCC = LENOCC(LINE(JA:JE))
- IF (NOCC.NE.MUST) GO TO 39
- 34 CONTINUE
- CALL MVERII (NTN,IA,IA,1)
-
- NTN = 4
- DO 36 JA=1,11
- LINE = 'alphabeta'
- DO 36 JE=40,79
- COL(JE-JA) = 'x'
- COL(JE+1) = 'y'
- MUST = JE+1 - 2*JA
- NOCC = LENOCC(LINE(JA:JE))
- IF (NOCC.NE.MUST) GO TO 39
- COL(JE+1) = ' '
- 36 CONTINUE
- CALL MVERII (NTN,IA,IA,1)
- GO TO 69
-
- 39 CALL MVERII (NTN,NOCC,MUST,1)
- WRITE (ITB,9039) JA,JE,MUST,NOCC
- 9039 FORMAT (' Test of LENOCC failed : JA,JE,MUST,HAVE =',4I6/)
-
- 69 IF (ITIMES.EQ.0) RETURN
-
-C-- TIMING
-
- NLOOP = 4*ITIMES
- NTIMES = NLOOP*1000
- LINE = 'rho'
-
- DO 76 JE= 80,3,-9
-
- CALL TIMED (TIMERD)
- NLOOPX = NLOOP
- 72 JT = 0
- 73 JT = JT + 1
- IA(JT) = LNBLNK (LINE(1:JE))
- IF (JT.NE.1000) GO TO 73
- NLOOPX = NLOOPX - 1
- IF (NLOOPX.NE.0) GO TO 72
- CALL TIME77 (NTIMES,'LNBLNK',JE,'chars')
-
- CALL TIMED (TIMERD)
- NLOOPX = NLOOP
- 74 JT = 0
- 75 JT = JT + 1
- IA(JT) = LENOCC (LINE(1:JE))
- IF (JT.NE.1000) GO TO 75
- NLOOPX = NLOOPX - 1
- IF (NLOOPX.NE.0) GO TO 74
- CALL TIME77 (NTIMES,'LENOCC',JE,'chars')
- 76 CONTINUE
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/test/pm434/Imakefile b/src/packlib/kernlib/kerngen/test/pm434/Imakefile
deleted file mode 100644
index ace9470..0000000
--- a/src/packlib/kernlib/kerngen/test/pm434/Imakefile
+++ /dev/null
@@ -1,4 +0,0 @@
-SRCS_F= \ @@\
- tvxinv.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kerngen/test/pm434/tvxinv.F b/src/packlib/kernlib/kerngen/test/pm434/tvxinv.F
deleted file mode 100644
index 9605480..0000000
--- a/src/packlib/kernlib/kerngen/test/pm434/tvxinv.F
+++ /dev/null
@@ -1,71 +0,0 @@
-*
-* $Id: tvxinv.F,v 1.1.1.1 1996/02/15 17:54:56 mclareni Exp $
-*
-* $Log: tvxinv.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:56 mclareni
-* Kernlib
-*
-*
-#include "kerngent/pilot.h"
- SUBROUTINE TVXINV
-
-#if defined(CERNLIB_TVXINV)
-#include "kerngent/mkcde.inc"
-
-C----------- VXINVB
-
- CALL NEWGUY ('VXINVB - VXINVC.','TVXINV ')
- CALL VZERO (A,2000)
-
- NTN = 200
- NTX = NTN - 2
- JS = 0
-
- DO 24 J=1,NTN
- CALL SBYT (JS+3, IB(J), 25,8)
- CALL SBYT (JS+2, IB(J), 17,8)
- CALL SBYT (JS+1, IB(J), 9,8)
- CALL SBYT (JS, IB(J), 1,8)
-
- CALL SBYT (JS+3, IA(J), 1,8)
- CALL SBYT (JS+2, IA(J), 9,8)
- CALL SBYT (JS+1, IA(J), 17,8)
- CALL SBYT (JS, IA(J), 25,8)
-
- JS = JS + 1
- IF (JS.EQ.254) JS= 0
- 24 CONTINUE
-
- DO 25 J=NTX+1,NTN
- 25 IA(J) = IB(J)
- CALL UCOPY (IA, IA(501), NTN)
-
- CALL VXINVB (IA,NTX)
- CALL MVERII (1,IA,IB,NTN)
-
-C----------- VXINVC
-
- CALL VZERO (IA,NTX)
- CALL VXINVC (IA(501),IA,NTX)
- CALL MVERII (2,IA,IB,NTN)
-
-C-- TIMING
-
- IF (ITIMES.EQ.0) RETURN
- NTIMES = ITIMES*1000
- CALL TIMED (TIMERD)
-
- DO 72 J= 1,NTIMES
- CALL VXINVB (IA,1000)
- 72 CONTINUE
- CALL TIME77 (NTIMES,'VXINVB ',1000,'words')
-
- CALL TIMED (TIMERD)
-
- DO 74 J= 1,NTIMES
- CALL VXINVC (IA,IB,1000)
- 74 CONTINUE
- CALL TIME77 (NTIMES,'VXINVC ',1000,'words')
-#endif
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/test/pmatrix/Imakefile b/src/packlib/kernlib/kerngen/test/pmatrix/Imakefile
deleted file mode 100644
index 5026056..0000000
--- a/src/packlib/kernlib/kerngen/test/pmatrix/Imakefile
+++ /dev/null
@@ -1,4 +0,0 @@
-SRCS_F= \ @@\
- tmxm.F tmxtrp.F tmxuty.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kerngen/test/pmatrix/tmxm.F b/src/packlib/kernlib/kerngen/test/pmatrix/tmxm.F
deleted file mode 100644
index 3a8d502..0000000
--- a/src/packlib/kernlib/kerngen/test/pmatrix/tmxm.F
+++ /dev/null
@@ -1,282 +0,0 @@
-*
-* $Id: tmxm.F,v 1.1.1.1 1996/02/15 17:54:57 mclareni Exp $
-*
-* $Log: tmxm.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:57 mclareni
-* Kernlib
-*
-*
-#include "kerngent/pilot.h"
- SUBROUTINE TMXM
-
-#include "kerngent/mkcde.inc"
-
- DIMENSION ZER(12),ACT(6), BCT(8),DMIN(12)
- +, APLUS(12),AMIN(12),APLUS1(9),AMIN2(9)
- EQUIVALENCE (ZER(1),B(1)), (ACT(1),B(100))
- +, (BCT(1),B(200)), (DMIN(1),B(700))
- +, (APLUS(1),B(300)), (AMIN(1),B(400))
- +, (APLUS1(1),B(500)),(AMIN2(1),B(600))
- DIMENSION AC(6),BC(8),C1C(12),C2C(9),D(12)
- INTEGER TINF(4), TINFY1, TINFY2, TINFY3
- +, TINFA , TINFA1, TINFA2, TINFA3
- +, TINFU , TINFU1, TINFU2, TINFU3
-
- DATA AC/ 0., 1., 2., 3., 4., 5./
- DATA BC/ 10., 20., 30., 40., 50., 60., 70., 80./
- DATA C1C/50.,60.,70.,80.,170.,220.,270.,320.,290.,380.,470.,560./
- DATA C2C/ 3., 4., 5., 9., 14., 19., 15., 24., 33./
- DATA D/2.,4.,6.,8.,102.,104.,106.,108.,202.,204.,206.,208./
- DATA TINF/1000,4HXMPY,0,4H324 /
- DATA TINFA /4HXMAD/, TINFU /4HXMUB/, TINFY1 /4HMPY1/
- +, TINFA1 /4HMAD1/, TINFU1 /4HMUB1/, TINFY2 /4HMPY2/
- +, TINFA2 /4HMAD2/, TINFU2 /4HMUB2/, TINFY3 /4HMPY3/
- +, TINFA3 /4HMAD3/, TINFU3 /4HMUB3/
-
- ZERLEV = ZEROV(2)
- CALL UZERO (ZER,1,12)
- CALL MXTRP (BC,BCT,2,4)
- CALL MXTRP (AC,ACT,3,2)
-
-C TEST FOR MXMPY-1-2-3
- CALL NEWGUY ('MXMPY-1-2-3.','TMXM ')
-
- CALL MXMPY (AC,BC,A,3,2,4)
- CALL MVERIF ( 1,A,C1C,12)
-
- CALL MXMPY1 (AC,BCT,A,3,2,4)
- CALL MVERIF (11,A,C1C,12)
-
- CALL MXMPY2 (ACT,BC,A,3,2,4)
- CALL MVERIF (21,A,C1C,12)
-
- CALL MXMPY3 (ACT,BCT,A,3,2,4)
- CALL MVERIF (31,A,C1C,12)
-
- CALL MXMPY (AC,BC,A,3,0,4)
- CALL MVERIF ( 10,A,ZER,12)
-
- CALL MXMPY1 (AC,BCT,A,3,0,4)
- CALL MVERIF (110,A,ZER,12)
-
- CALL MXMPY2 (ACT,BC,A,3,0,4)
- CALL MVERIF (210,A,ZER,12)
-
- CALL MXMPY3 (ACT,BCT,A,3,0,4)
- CALL MVERIF (310,A,ZER,12)
-
- CALL MXMPY (AC,AC,A,3,2,3)
- CALL MVERIF ( 12,A,C2C,9)
-
-C-- TIMING
- IF (ITIMES.EQ.0) GO TO 100
- NTIMES = ITIMES*TINF(1)
- TINF(1) = NTIMES
- CALL TIMED (TIMERD)
-
- DO 80 J=1,NTIMES
- 80 CALL MXMPY (AC,BC,A,3,2,4)
-
- CALL TIMING (TINF)
- TINF(2)=TINFY1
- CALL TIMED (TIMERD)
-
- DO 81 J=1,NTIMES
- 81 CALL MXMPY1 (AC,BCT,A,3,2,4)
-
- CALL TIMING (TINF)
- TINF(2)=TINFY2
- CALL TIMED (TIMERD)
-
- DO 82 J=1,NTIMES
- 82 CALL MXMPY2 (ACT,BC,A,3,2,4)
-
- CALL TIMING (TINF)
- TINF(2)=TINFY3
- CALL TIMED (TIMERD)
-
- DO 83 J=1,NTIMES
- 83 CALL MXMPY3 (ACT,BCT,A,3,2,4)
-
- CALL TIMING (TINF)
-
-C TEST FOR MXMAD-12-3-
-
- 100 CALL NEWGUY ('MXMAD-1-2-3.','TMXM ')
-
- CALL UCOPY (C1C,A,12)
- CALL VADD (A,D,APLUS,12)
- CALL VSUB (A,D,AMIN,12)
- CALL MXMPY (AC,AC,A,3,2,3)
- CALL VADD (A,D,APLUS1,9)
- CALL VSUB (A,D,AMIN2,9)
-
- CALL UCOPY (D,A,12)
- CALL MXMAD (AC,BC,A,3,2,4)
- CALL MVERIF ( 1,A,APLUS,12)
-
- CALL UCOPY (D,A,12)
- CALL MXMAD1 (AC,BCT,A,3,2,4)
- CALL MVERIF (11,A,APLUS,12)
-
- CALL UCOPY (D,A,12)
- CALL MXMAD2 (ACT,BC,A,3,2,4)
- CALL MVERIF (21,A,APLUS,12)
-
- CALL UCOPY (D,A,12)
- CALL MXMAD3 (ACT,BCT,A,3,2,4)
- CALL MVERIF (31,A,APLUS,12)
-
- CALL UCOPY (D,A,12)
- CALL MXMAD (AC,BC,A,3,0,4)
- CALL MVERIF ( 10,A,D,12)
-
- CALL MXMAD1 (AC,BCT,A,3,0,4)
- CALL MVERIF (110,A,D,12)
-
- CALL MXMAD2 (ACT,BC,A,3,0,4)
- CALL MVERIF (210,A,D,12)
-
- CALL MXMAD3 (ACT,BCT,A,3,0,4)
- CALL MVERIF (310,A,D,12)
-
- CALL UCOPY (D,A,9)
- CALL MXMAD (AC,AC,A,3,2,3)
- CALL MVERIF ( 12,A,APLUS1,9)
-
- CALL UCOPY (D,A,9)
-
-C-- TIMING
- IF (ITIMES.EQ.0) GO TO 200
- TINF(2)=TINFA
- CALL TIMED (TIMERD)
-
- DO 180 J=1,NTIMES
- CALL UCOPY (D,A,12)
- 180 CALL MXMAD (AC,BC,A,3,2,4)
-
- CALL TIMING (TINF)
- TINF(2)=TINFA1
- CALL TIMED (TIMERD)
-
- DO 181 J=1,NTIMES
- CALL UCOPY (D,A,12)
- 181 CALL MXMAD1 (AC,BCT,A,3,2,4)
-
- CALL TIMING (TINF)
- TINF(2)=TINFA2
- CALL TIMED (TIMERD)
-
- DO 182 J=1,NTIMES
- CALL UCOPY (D,A,12)
- 182 CALL MXMAD2 (ACT,BC,A,3,2,4)
-
- CALL TIMING (TINF)
- TINF(2)=TINFA3
- CALL TIMED (TIMERD)
-
- DO 183 J=1,NTIMES
- CALL UCOPY (D,A,12)
- 183 CALL MXMAD3 (ACT,BCT,A,3,2,4)
-
- CALL TIMING (TINF)
-
-C TEST FOR MXMUB-1-2-3
- 200 CALL NEWGUY ('MXMUB-1-2-3.','TMXM ')
-
- CALL VCOPYN(D,DMIN,12)
- CALL UCOPY (D,A,12)
- CALL MXMUB (AC,BC,A,3,2,4)
- CALL MVERIF ( 1,A,AMIN,12)
-
- CALL UCOPY (D,A,12)
- CALL MXMUB1 (AC,BCT,A,3,2,4)
- CALL MVERIF (11,A,AMIN,12)
-
- CALL UCOPY (D,A,12)
- CALL MXMUB2 (ACT,BC,A,3,2,4)
- CALL MVERIF (21,A,AMIN,12)
-
- CALL UCOPY (D,A,12)
- CALL MXMUB3 (ACT,BCT,A,3,2,4)
- CALL MVERIF (31,A,AMIN,12)
-
- CALL UCOPY (D,A,12)
- CALL MXMUB (AC,BC,A,3,0,4)
- CALL MVERIF ( 10,A,DMIN,12)
-
- CALL UCOPY (D,A,12)
- CALL MXMUB1 (AC,BCT,A,3,0,4)
- CALL MVERIF (110,A,DMIN,12)
-
- CALL UCOPY (D,A,12)
- CALL MXMUB2 (ACT,BC,A,3,0,4)
- CALL MVERIF (210,A,DMIN,12)
-
- CALL UCOPY (D,A,12)
- CALL MXMUB3 (ACT,BCT,A,3,0,4)
- CALL MVERIF (310,A,DMIN,12)
-
- CALL UCOPY (D,A,9)
- CALL MXMUB (AC,AC,A,3,2,3)
- CALL MVERIF ( 12,A,AMIN2,9)
-
- IF (ITIMES.EQ.0) GO TO 300
-
- TINF(2)=TINFU
- CALL TIMED (TIMERD)
-
- DO 280 J=1,NTIMES
- CALL UCOPY (D,A,12)
- 280 CALL MXMUB (AC,BC,A,3,2,4)
-
- CALL TIMING (TINF)
- TINF(2)=TINFU1
- CALL TIMED (TIMERD)
-
- DO 281 J=1,NTIMES
- CALL UCOPY (D,A,12)
- 281 CALL MXMUB1 (AC,BCT,A,3,2,4)
-
- CALL TIMING (TINF)
- TINF(2)=TINFU2
- CALL TIMED (TIMERD)
-
- DO 282 J=1,NTIMES
- CALL UCOPY (D,A,12)
- 282 CALL MXMUB2 (ACT,BC,A,3,2,4)
-
- CALL TIMING (TINF)
- TINF(2)=TINFU3
- CALL TIMED (TIMERD)
-
- DO 283 J=1,NTIMES
- CALL UCOPY (D,A,12)
- 283 CALL MXMUB3 (ACT,BCT,A,3,2,4)
-
- CALL TIMING (TINF)
-
-C-- TEST FOR MXMLRT - MXMLTR
- 300 CALL NEWGUY ('MXMLRT - MXMLTR.','TMXM ')
- CALL MXMPY (AC,C2C,A,2,3,3)
- CALL MXMPY1 (A,AC,B,2,3,2)
-
- CALL MXMPY1 (C2C,AC,A(101),3,3,2)
- CALL MXMPY (AC,A(101),B(101),2,3,2)
- CALL MVERIF (0,B,B(101),4)
-
- CALL MXMLRT (AC,C2C,A,2,3)
- CALL MVERIF (1,A,B,4)
-
- CALL MXMPY2 (C1C,C2C,A,4,3,3)
- CALL MXMPY (A,C1C,B,4,3,4)
-
- CALL MXMPY (C2C,C1C,A(101),3,3,4)
- CALL MXMPY2 (C1C,A(101),B(101),4,3,4)
- CALL MVERIF (10,B,B(101),16)
-
- CALL MXMLTR (C1C,C2C,A,4,3)
- CALL MVERIF (11,A,B,16)
- RETURN
-
- END
diff --git a/src/packlib/kernlib/kerngen/test/pmatrix/tmxtrp.F b/src/packlib/kernlib/kerngen/test/pmatrix/tmxtrp.F
deleted file mode 100644
index 08c8d83..0000000
--- a/src/packlib/kernlib/kerngen/test/pmatrix/tmxtrp.F
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: tmxtrp.F,v 1.1.1.1 1996/02/15 17:54:57 mclareni Exp $
-*
-* $Log: tmxtrp.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:57 mclareni
-* Kernlib
-*
-*
-#include "kerngent/pilot.h"
- SUBROUTINE TMXTRP
-
-#include "kerngent/mkcde.inc"
-
- DIMENSION ICHECK(6)
- INTEGER TINF(4)
-
- DATA ICHECK/ 0, 2, 4, 1, 3, 5/
- DATA TINF/1000,4HXTRP,0,4H3X2 /
-
- CALL NEWGUY ('MXTRP.','TMXTRP ')
- ZERLEV = ZEROV(1)
-
- CALL UCOPY (INTG,IA(2),5)
- IA(1)=0
-
- CALL MXTRP (IA,IB,3,2)
- CALL MVERII (1,IB,ICHECK,6)
-
-C-- TIMING
- IF (ITIMES.EQ.0) RETURN
- NTIMES = ITIMES*TINF(1)
- TINF(1) = NTIMES
- CALL TIMED (TIMERD)
-
- DO 80 J=1,NTIMES
- 80 CALL MXTRP (IA,IB,3,2)
-
- CALL TIMING (TINF)
- RETURN
-
- END
diff --git a/src/packlib/kernlib/kerngen/test/pmatrix/tmxuty.F b/src/packlib/kernlib/kerngen/test/pmatrix/tmxuty.F
deleted file mode 100644
index ee2d710..0000000
--- a/src/packlib/kernlib/kerngen/test/pmatrix/tmxuty.F
+++ /dev/null
@@ -1,38 +0,0 @@
-*
-* $Id: tmxuty.F,v 1.1.1.1 1996/02/15 17:54:57 mclareni Exp $
-*
-* $Log: tmxuty.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:57 mclareni
-* Kernlib
-*
-*
-#include "kerngent/pilot.h"
- SUBROUTINE TMXUTY
-
-#include "kerngent/mkcde.inc"
-
- DIMENSION CHECK(9)
- INTEGER TINF(4)
-
- DATA CHECK/ 1., 0., 0., 0., 1., 0., 0., 0., 1./
- DATA TINF/1000,4HXUTY,0,4H3X3 /
-
- ZERLEV=ZEROV(1)
- CALL NEWGUY ('MXUTY.','TMXUTY ')
-
- CALL MXUTY (A,3)
- CALL MVERIF (1,A,CHECK,9)
-
-C-- TIMING
- IF (ITIMES.EQ.0) RETURN
- NTIMES = ITIMES*TINF(1)
- TINF(1) = NTIMES
- CALL TIMED (TIMERD)
-
- DO 80 J=1,NTIMES
- 80 CALL MXUTY (A,3)
-
- CALL TIMING (TINF)
- RETURN
-
- END
diff --git a/src/packlib/kernlib/kerngen/test/ptlpac/Imakefile b/src/packlib/kernlib/kerngen/test/ptlpac/Imakefile
deleted file mode 100644
index ebc53e9..0000000
--- a/src/packlib/kernlib/kerngen/test/ptlpac/Imakefile
+++ /dev/null
@@ -1,4 +0,0 @@
-SRCS_F= \ @@\
- ttlpac.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kerngen/test/ptlpac/ttlpac.F b/src/packlib/kernlib/kerngen/test/ptlpac/ttlpac.F
deleted file mode 100644
index 0652d69..0000000
--- a/src/packlib/kernlib/kerngen/test/ptlpac/ttlpac.F
+++ /dev/null
@@ -1,140 +0,0 @@
-*
-* $Id: ttlpac.F,v 1.1.1.1 1996/02/15 17:55:01 mclareni Exp $
-*
-* $Log: ttlpac.F,v $
-* Revision 1.1.1.1 1996/02/15 17:55:01 mclareni
-* Kernlib
-*
-*
-#include "kerngent/pilot.h"
- SUBROUTINE TTLPAC
-
-#include "kerngent/mkcde.inc"
-
- COMMON /TLSDIM/ M1,M,N,L,IER
- DIMENSION A1(32),AA(24),B1(8),B2(8),B3(6),BB(6),X(16),X1(16)
- + ,X2(16),X3(16),X4(16),AUX(8),AUX1(1),AUX2(1),IPIV(8)
- INTEGER TINF(4),TINFL2,TINFM2,TINFN2,TINFN4
-
- DATA IV/4/, AUX1/0.000039507/, AUX2/0.00000104397/
- 1 ,X1/0.997853373,1.,0.501073313,0.216701283, 12*0./
- 2 ,X2/0.304564727,0.,-0.152282363,-0.253309074,0.,0.,0.,0.,
- 3 -0.152282363,0.,0.0761411817,0.126654537,-0.253309074,0.,
- 3 0.126654537,0.972317137/ 3+
- 4 ,X3/0.99981032,1.01480489,0.42385913,0.27962963, 12*0./
- 5 ,X4/0.960317,-6.11772,10.9127,-5.78704,-6.11772,90.5809,
- 6 -214.947,132.13735,10.9127,-214.947,559.276,-361.690,
- 7 -5.78704,132.13735,-361.690,241.12654/
- 8 ,A1/0.,1.,0.,0.,1.,0.,2.,0.,
- 9 1.,0.,0.,0.,1.,0.2,0.04,0.008,1.,0.4,0.16,0.064,1.,0.6,
- A 0.36,0.216,1.,0.8,0.64,0.512,1.,1.,1.,1./
- B ,AA/1.,0.,0.,0.,1.,0.2,0.04,0.008,1.,0.4,0.16,0.064,1.,0.6,
- C 0.36,0.216,1.,0.8,0.64,0.512,1.,1.,1.,1./
- D ,B1/1.,2.,1.,1.2214,1.4918,1.8221,2.2255,2.7183/
- E ,B2/0.,0.,0.00214663,0.00177008,-0.000093985,-0.00294724,
- F -0.00399135,0.00267203/
- G ,B3/0.000189683,-0.000562698,0.000353968,0.000417460,
- H -0.000594444,0.000196032/
- I ,BB/1.,1.2214,1.4918,1.8221,2.2255,2.7183/
-
- DATA TINF/100,4HTLSC,0,4H8*4 /
- DATA TINFL2/4HLRES/,TINFM2/4HLERR/,TINFN2/4HTLS /,TINFN4/4H6*4 /
-
- CALL NEWGUY ('TLSC-TLRES-TLERR.','TTLPAC ')
- ZERLEV = 2*ZEROV(3)
-
- M1 = 2
- M = 8
- N = 4
- L = 1
- CALL UCOPY(A1,A,32)
- CALL UCOPY(B1,B,8)
-
- CALL TLSC(A,B,AUX,IPIV,1.,X)
- CALL MVERII(11,IER,IV,1)
- CALL MVERIF(12,X,X1,4)
- CALL MVERIF(13,AUX,AUX1,1)
-
- CALL TLRES(A,B,AUX)
- CALL MVERIF(14,B,B2,8)
-
- CALL TLERR(A,X,AUX,IPIV)
- CALL MVERIF(15,X,X2,16)
-
-C-- TIMING
- IF (ITIMES.EQ.0) GO TO 200
- NTIMES = ITIMES*TINF(1)
- TINF(1) = NTIMES
-
- CALL UCOPY (A1,A,32)
- CALL UCOPY (B1,B,8)
-
- CALL TIMED (TIMERD)
- DO 50 J=1,NTIMES
- CALL UCOPY (A,A1,32)
- CALL UCOPY (B,B1,8)
- 50 CALL TLSC(A1,B1,AUX,IPIV,1.,X)
- CALL TIMING(TINF)
-
- TINF(2) = TINFL2
- CALL TIMED (TIMERD)
- DO 100 J=1,NTIMES
- 100 CALL TLRES(A1,B1,AUX)
- CALL TIMING(TINF)
-
- TINF(2) = TINFM2
- CALL TIMED (TIMERD)
- DO 150 J=1,NTIMES
- 150 CALL TLERR(A1,X,AUX,IPIV)
- CALL TIMING(TINF)
-
-
- 200 CALL NEWGUY ('TLS-TLRES-TLERR.','TTLPAC ')
-
- M1 = 0
- M = 6
- CALL UCOPY(AA,A,24)
- CALL UCOPY(BB,B,6)
-
- CALL TLS(A,B,AUX,IPIV,0.01,X)
- CALL MVERII(21,IER,IV,1)
- CALL MVERIF(22,X,X3,4)
- ZERLEV=ZEROV(3)
- CALL MVERIF(23,AUX,AUX2,1)
-
- CALL TLRES(A,B,AUX)
- CALL MVERIF(24,B,B3,6)
-
- CALL TLERR(A,A,AUX,IPIV)
- ZERLEV = ZEROV(4)
- CALL MVERIF(25,A,X4,16)
-
-C-- TIMING
- IF (ITIMES.EQ.0) RETURN
- TINF(2) = TINFN2
- TINF(4) = TINFN4
-
- CALL UCOPY (AA,A,24)
- CALL UCOPY (BB,B,6)
-
- CALL TIMED (TIMERD)
- DO 250 J=1,NTIMES
- CALL UCOPY (A,AA,24)
- CALL UCOPY (B,BB,6)
- 250 CALL TLS(AA,BB,AUX,IPIV,0.01,X)
- CALL TIMING(TINF)
-
- TINF(2) = TINFL2
- CALL TIMED (TIMERD)
- DO 300 J=1,NTIMES
- 300 CALL TLRES(AA,BB,AUX)
- CALL TIMING(TINF)
-
- TINF(2) = TINFM2
- CALL TIMED (TIMERD)
- DO 350 J=1,NTIMES
- 350 CALL TLERR(AA,X,AUX,IPIV)
- CALL TIMING(TINF)
- RETURN
-
- END
diff --git a/src/packlib/kernlib/kerngen/test/ptrpac/Imakefile b/src/packlib/kernlib/kerngen/test/ptrpac/Imakefile
deleted file mode 100644
index d4066f8..0000000
--- a/src/packlib/kernlib/kerngen/test/ptrpac/Imakefile
+++ /dev/null
@@ -1,4 +0,0 @@
-SRCS_F= \ @@\
- ttrcho.F ttrinv.F ttrla.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kerngen/test/ptrpac/ttrcho.F b/src/packlib/kernlib/kerngen/test/ptrpac/ttrcho.F
deleted file mode 100644
index 7f92650..0000000
--- a/src/packlib/kernlib/kerngen/test/ptrpac/ttrcho.F
+++ /dev/null
@@ -1,89 +0,0 @@
-*
-* $Id: ttrcho.F,v 1.1.1.1 1996/02/15 17:55:02 mclareni Exp $
-*
-* $Log: ttrcho.F,v $
-* Revision 1.1.1.1 1996/02/15 17:55:02 mclareni
-* Kernlib
-*
-*
-#include "kerngent/pilot.h"
- SUBROUTINE TTRCHO
-#include "kerngent/mkcde.inc"
- DIMENSION AC(10), BC(10), DC(10), PC(10), EC(10)
- INTEGER TINF(4), TINFT2, TINFM2, TINFM4
- DATA AC/1.,0.,0.,2.,0.,13.,4.,0.,23.,77./,
- 1 BC/21.,26.,34.,0.,0.,0.,24.,30.,0.,36./,
- 2 DC/1.,2.,3.,0.,0.,0.,4.,5.,0.,6./,
- 3 PC/1.,0.,0.,2.,0.,3.,4.,0.,5.,6./,
- 4 EC/1.,2.,13.,0.,0.,0.,4.,23.,0.,77./
- DATA TINF/1000,4HCHLU,1,4H4*4 /
- DATA TINFT2/4HCHUL/,
- + TINFM2/4HSMUL/, TINFM4/4H4*4 /,
- + TINFL2/4HSMLU/
-C-----------------------------------------------------------------------
-
- CALL NEWGUY ('TRCHLU-TRCHUL.','TTRCHO ')
- ZERLEV = ZEROV(3)
-
- CALL TRCHLU (AC,A,4)
- CALL MVERIF (11,A,PC,10)
-
- CALL UCOPY (AC,A,10)
- CALL TRCHLU (A ,A,4)
- CALL MVERIF (12,A,PC,10)
-
- CALL TRCHUL (BC,A,4)
- CALL MVERIF (21,A,DC,10)
-
- CALL UCOPY (BC,A,10)
- CALL TRCHUL (A ,A,4)
- CALL MVERIF (22,A,DC,10)
-C - - - - - - - - - - - - - - - - - - - -- - - -- - - - - - - - - - - -
-
- IF (ITIMES .EQ. 0) GO TO 120
- CALL TIMED (TIMERD)
- DO 50 J=1,1000
- 50 CALL TRCHLU (AC,A,4)
- CALL TIMING (TINF)
-
- TINF(2) = TINFT2
- CALL TIMED (TIMERD)
- DO 100 J=1,1000
- 100 CALL TRCHUL (BC,A,4)
- CALL TIMING (TINF)
-
-C-----------------------------------------------------------------------
- 120 CALL NEWGUY ('TRSMUL-TRSMLU.','TTRCHO ')
- ZERLEV = ZEROV(2)
-
- CALL TRSMUL(DC,A,4)
- CALL MVERIF (11,A,BC,10)
-
- CALL UCOPY (DC,A,10)
- CALL TRSMUL (A ,A,4)
- CALL MVERIF (12,A,BC,10)
-
- CALL TRSMLU(DC,A,4)
- CALL MVERIF(22,A,EC,10)
-
- CALL UCOPY (DC,A,10)
- CALL TRSMLU(A,A,4)
- CALL MVERIF(21,A,EC,10)
-C - - - - - - - - - - - - - - - - - - - -- - - -- - - - - - - - - - - -
-
- IF (ITIMES .EQ. 0) RETURN
- TINF(2) = TINFM2
- TINF(4) = TINFM4
- CALL TIMED (TIMERD)
- DO 150 J=1,1000
- 150 CALL TRSMUL (DC,A,4)
- CALL TIMING (TINF)
-
- TINF(2)=TINFL2
- CALL TIMED (TIMERD)
- DO 160 J=1,1000
- 160 CALL TRSMLU(DC,A,4)
- CALL TIMING (TINF)
-
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/test/ptrpac/ttrinv.F b/src/packlib/kernlib/kerngen/test/ptrpac/ttrinv.F
deleted file mode 100644
index d14d773..0000000
--- a/src/packlib/kernlib/kerngen/test/ptrpac/ttrinv.F
+++ /dev/null
@@ -1,57 +0,0 @@
-*
-* $Id: ttrinv.F,v 1.1.1.1 1996/02/15 17:55:02 mclareni Exp $
-*
-* $Log: ttrinv.F,v $
-* Revision 1.1.1.1 1996/02/15 17:55:02 mclareni
-* Kernlib
-*
-*
-#include "kerngent/pilot.h"
- SUBROUTINE TTRINV
-
-#include "kerngent/mkcde.inc"
- DIMENSION AC(10), CC(10), QC(10), RC(10)
- INTEGER TINF(4), TINFS2, TINFS4
- DATA AC/1.,0.,0.,2.,0.,13.,4.,0.,23.,77./,
- 1 CC/0.2,-8.,4.,0.,0.,0.,4.2,-2.,0.,1./,
- 2 QC/5.,10.,0.25,0.,0.,0.,-1.,0.5,0.,1./,
- 3 RC/1.45679,0.,0.,-0.191358,0.,0.1882716,-0.0185185,
- 4 0., -0.0462963, 0.02777778 /
- DATA TINF/1000,4HINV ,1,4H4*4 /
- DATA TINFS2/4HSINV/, TINFS4/4H4*4 /
-C-----------------------------------------------------------------------
-
- CALL NEWGUY ('TRINV -TRSINV.','TTRINV ')
- ZERLEV = ZEROV(2)
-
- CALL TRINV (CC,A,4)
- CALL MVERIF (11,A,QC,10)
-
- CALL UCOPY (CC,A,10)
- CALL TRINV (A ,A,4)
- CALL MVERIF (12,A,QC,10)
-
- ZERLEV = ZEROV(4)
- CALL TRSINV (AC,A,4)
- CALL MVERIF (21,A,RC,10)
-
- CALL UCOPY (AC,A,10)
- CALL TRSINV (A ,A,4)
- CALL MVERIF (22,A,RC,10)
-C - - - - - - - - - - - - - - - - - - - -- - - -- - - - - - - - - - - -
-
- IF (ITIMES .EQ. 0) RETURN
- CALL TIMED (TIMERD)
- DO 50 J=1,1000
- 50 CALL TRINV (CC,A,4)
- CALL TIMING (TINF)
-
- TINF(2) = TINFS2
- TINF(4) = TINFS4
- CALL TIMED (TIMERD)
- DO 100 J=1,1000
- 100 CALL TRSINV (AC,A,4)
- CALL TIMING (TINF)
-
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/test/ptrpac/ttrla.F b/src/packlib/kernlib/kerngen/test/ptrpac/ttrla.F
deleted file mode 100644
index 885b757..0000000
--- a/src/packlib/kernlib/kerngen/test/ptrpac/ttrla.F
+++ /dev/null
@@ -1,244 +0,0 @@
-*
-* $Id: ttrla.F,v 1.1.1.1 1996/02/15 17:55:02 mclareni Exp $
-*
-* $Log: ttrla.F,v $
-* Revision 1.1.1.1 1996/02/15 17:55:02 mclareni
-* Kernlib
-*
-*
-#include "kerngent/pilot.h"
- SUBROUTINE TTRLA
-
-#include "kerngent/mkcde.inc"
- DIMENSION DC(10), EC(12), SC(6), TC(12), UC(12), VC(12), WC(10),
- 1 XC(10), AC(10), YC(12)
- DIMENSION SAC(12),ASC(12),SATC(12),ATSC(12) ,
- 1 ATSAC(6), QSQC(10)
- 2 ,PCKC(10),UPCKC(16)
- INTEGER TINF(4), TINF2(15), TINF4 (15)
- DATA DC/1.,2.,3.,0.,0.,0.,4.,5.,0.,6./,
- 1 EC/4.,7.,3.,3.,6.,4.,0.,5.,5.,2.,1.,2./,
- 2 SC/1384.,1712.,2201.,858.,1075.,538./,
- 3 TC/18.,23.,19.,19.,23.,22.,0.,0.,0.,12.,6.,12./,
- 4 UC/30.,36.,0.,18.,34.,37.,0.,30.,17.,16.,0.,12./,
- 5 VC/4.0,7.0,3.0,17.,32.,18.,0.,0.,0.,43.,64.,44./,
- 6 WC/74.,66.,61.,50.,50.,50.,21.,20.,15.,9./,
- 7 XC/77.,62.,69.,17.,23.,10.,52.,45.,11.,38./,
- 8 YC/4.,29.,0.,69.,6.,24.,0.,74.,5.,16.,0.,42./,
- 9 AC/1.,0.,0.,2.,0.,13.,4.,0.,23.,77./
-
- DATA ASC/30.,44.,0.,69.,34.,49.,0.,74.,17.,26.,0.,42./
- DATA SAC/18.,23.,19.,27.,37.,28.,0.,0.,0.,43.,64.,44./
- DATA SATC/30.,34.,17.,44.,49.,26.,0.,0.,0.,69.,74.,42./
- DATA ATSC/18.,27.,0.,43.,23.,37.,0.,64.,19.,28.,0.,44./
- DATA ATSAC/239.,331.,447.,248.,345.,257./
- DATA QSQC/1265.,1594.,2009.,0.,0.,0.,1940.,2446.,0.,2980./
- DATA UPCKC/1.,2.,4.,7.,2.,3.,5.,8.,4.,5.,6.,9.,7.,8.,9.,10./
- DATA PCKC/1.,2.,3.,4.,5.,6.,7.,8.,9.,10./
- DATA TINF/1000,4H ,1,4H /
- DATA TINF2/4HLA ,4HLTA ,4HAL ,4HALT ,4HAAT ,4HATA ,4HASAT,
- + 4HATSA,4HQSQ ,4HSA ,4HAS ,4HSAT ,4HATS ,4HPCK ,4HUPCK/
- DATA TINF4/4H443 ,4H443 ,4H344 ,4H344 ,4H4*3 ,4H4*3 ,4H3443,
- + 4H3443,4H4444,4H443 ,4H344 ,4H443 ,4H344 ,4H4*4 ,4H4*4 /
-C----------------------------------------------------------------------
-
- CALL NEWGUY ('TRLA-TRLTA-TRAL-TRALT.','TTRLA ')
- ZERLEV = ZEROV(2)
-
- CALL TRLA (DC,EC,A,4,3)
- CALL MVERIF (111,A,VC,12)
-
- CALL UCOPY(EC,A,12)
- CALL TRLA (DC,A,A,4,3)
- CALL MVERIF(112,A,VC,12)
-
- CALL TRLTA (DC,EC,A,4,3)
- CALL MVERIF (121,A,TC,12)
-
- CALL UCOPY(EC,A,12)
- CALL TRLTA(DC,A,A,4,3)
- CALL MVERIF(122,A,TC,12)
-
- CALL TRAL (EC,DC,A,3,4)
- CALL MVERIF (131,A,UC,12)
-
- CALL UCOPY(EC,A,12)
- CALL TRAL (A,DC,A,3,4)
- CALL MVERIF(132,A,UC,12)
-
- CALL TRALT (EC,DC,A,3,4)
- CALL MVERIF (141,A,YC,12)
-
- CALL UCOPY(EC,A,12)
- CALL TRALT(A,DC,A,3,4)
- CALL MVERIF(142,A,YC,12)
-C- - - - - - - - - - - - - - - - - - - - - - - -
-
- IF (ITIMES .EQ. 0) GO TO 180
-
- TINF(2)=TINF2(1)
- TINF(4)=TINF4(1)
- CALL TIMED (TIMERD)
- DO 150 J=1,1000
- 150 CALL TRLA (DC,EC,A,4,3)
- CALL TIMING (TINF)
-
- TINF(2)=TINF2(2)
- TINF(4)=TINF4(2)
- CALL TIMED (TIMERD)
- DO 50 J=1,1000
- 50 CALL TRLTA (DC,EC,A,4,3)
- CALL TIMING (TINF)
-
- TINF(2)=TINF2(3)
- TINF(4)=TINF4(3)
- CALL TIMED (TIMERD)
- DO 110 J=1,1000
- 110 CALL TRAL(EC,DC,A,3,4)
- CALL TIMING (TINF)
-
- TINF(2)=TINF2(4)
- TINF(4)=TINF4(4)
- CALL TIMED (TIMERD)
- DO 100 J=1,1000
- 100 CALL TRALT (EC,DC,A,3,4)
- CALL TIMING (TINF)
-C----------------------------------------------------------------------
-
- 180 CALL NEWGUY ('TRAAT-TRATA.','TTRLA ')
- CALL TRAAT (EC,A,4,3)
- CALL MVERIF (211,A,WC,10)
-
- CALL TRATA (EC,A,4,3)
- CALL MVERIF (221,A,XC,10)
-C- - - - - - - - - - - - - - - - - - - - - - - -
-
- IF (ITIMES .EQ. 0) GO TO 280
- TINF(2)=TINF2(5)
- TINF(4)=TINF4(5)
- CALL TIMED (TIMERD)
- DO 200 J=1,1000
- 200 CALL TRAAT (EC,A,4,3)
- CALL TIMING (TINF)
-
- TINF(2)=TINF2(6)
- TINF(4)=TINF4(6)
- CALL TIMED (TIMERD)
- DO 250 J=1,1000
- 250 CALL TRATA (EC,A,4,3)
- CALL TIMING (TINF)
-C----------------------------------------------------------------------
-
- 280 CALL NEWGUY ('TRASAT-TRATSA-TRQSQ.','TTRLA ')
- CALL TRASAT (EC,AC,A,3,4)
- CALL MVERIF (311,A,SC,6 )
-
- CALL TRATSA(EC,DC,A,3,4)
- CALL MVERIF(321,A,ATSAC,6)
-
- CALL TRQSQ(DC,AC,A,4)
- CALL MVERIF(331,A,QSQC,10)
-C- - - - - - - - - - - - - - - - - - - - - - - -
-
- IF (ITIMES .EQ. 0) GOTO 380
- TINF(2)=TINF2(7)
- TINF(4)=TINF4(7)
- CALL TIMED (TIMERD)
- DO 300 J=1,1000
- 300 CALL TRASAT (AC,EC,A,4,3)
- CALL TIMING (TINF)
-
- TINF(2)=TINF2(8)
- TINF(4)=TINF4(8)
- CALL TIMED (TIMERD)
- DO 310 J=1,1000
- 310 CALL TRATSA(EC,AC,A,3,4)
- CALL TIMING(TINF)
-
- TINF(2)=TINF2(9)
- TINF(4)=TINF4(9)
- CALL TIMED (TIMERD)
- DO 320 J=1,1000
- 320 CALL TRQSQ(DC,AC,A,4)
- CALL TIMING(TINF)
-C----------------------------------------------------------------------
-
- 380 CALL NEWGUY ('TRSA-TRAS-TRSAT-TRATS.','TTRLA ')
-
- CALL TRSA(DC,EC,A,4,3)
- CALL MVERIF(411,A,SAC,12)
-
- CALL TRAS(EC,DC,A,3,4)
- CALL MVERIF(421,A,ASC,12)
-
- CALL TRSAT(DC,EC,A,4,3)
- CALL MVERIF(431 ,A,SATC,12)
-
- CALL TRATS(EC,DC,A,3,4)
- CALL MVERIF(441,A,ATSC,12)
-C- - - - - - - - - - - - - - - - - - - - - - - -
-
- IF (ITIMES .EQ. 0) GOTO 480
- TINF(2)=TINF2(10)
- TINF(4)=TINF4(10)
- CALL TIMED (TIMERD)
- DO 400 J=1,1000
- 400 CALL TRSA(DC,EC,A,4,3)
- CALL TIMING(TINF)
-
- TINF(2)=TINF2(11)
- TINF(4)=TINF4(11)
- CALL TIMED (TIMERD)
- DO 410 J=1,1000
- 410 CALL TRAS(EC,DC,A,3,4)
- CALL TIMING(TINF)
-
- TINF(2)=TINF2(12)
- TINF(4)=TINF4(12)
- CALL TIMED (TIMERD)
- DO 420 J=1,1000
- 420 CALL TRSAT(DC,EC,A,4,3)
- CALL TIMING(TINF)
-
- TINF(2)=TINF2(13)
- TINF(4)=TINF4(13)
- CALL TIMED (TIMERD)
- DO 430 J=1,1000
- 430 CALL TRATS(EC,DC,A,3,4)
- CALL TIMING(TINF)
-C----------------------------------------------------------------------
-
- 480 CALL NEWGUY ('TRPCK-TRUPCK.','TTRLA ')
-
- CALL TRPCK(UPCKC,A,4)
- CALL MVERIF(511,A,PCKC,10)
-
- CALL TRUPCK(PCKC,B,4)
- CALL MVERIF(521,B,UPCKC,16)
-
- CALL TRPCK(B,B,4)
- CALL MVERIF(512,B,PCKC,10)
-
- CALL TRUPCK(A,A,4)
- CALL MVERIF(522,A,UPCKC,16)
-
-C- - - - - - - - - - - - - - - - - - - - - - - -
-
- IF(ITIMES.EQ.0) GOTO 580
- TINF(2)=TINF2(14)
- TINF(4)=TINF4(14)
- CALL TIMED (TIMERD)
- DO 500 J=1,1000
- 500 CALL TRPCK(A,B,4)
- CALL TIMING(TINF)
-
- TINF(4)=TINF4(15)
- TINF(2)=TINF2(15)
- CALL TIMED (TIMERD)
- DO 510 J=1,1000
- 510 CALL TRUPCK(A,B,4)
- CALL TIMING(TINF)
-
- 580 CONTINUE
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/test/putil/Imakefile b/src/packlib/kernlib/kerngen/test/putil/Imakefile
deleted file mode 100644
index 53d33b0..0000000
--- a/src/packlib/kernlib/kerngen/test/putil/Imakefile
+++ /dev/null
@@ -1,5 +0,0 @@
-SRCS_F= \ @@\
- tcocop.F tiucha.F tiucom.F tiusam.F tucopy.F tuopt.F tuswop.F \ @@\
- tuzero.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kerngen/test/putil/tcocop.F b/src/packlib/kernlib/kerngen/test/putil/tcocop.F
deleted file mode 100644
index 74c0d2e..0000000
--- a/src/packlib/kernlib/kerngen/test/putil/tcocop.F
+++ /dev/null
@@ -1,65 +0,0 @@
-*
-* $Id: tcocop.F,v 1.1.1.1 1996/02/15 17:54:57 mclareni Exp $
-*
-* $Log: tcocop.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:57 mclareni
-* Kernlib
-*
-*
-#include "kerngent/pilot.h"
- SUBROUTINE TCOCOP
-
-#include "kerngent/mkcde.inc"
-
- INTEGER TINF(4)
- DATA TINF /1000, 4HUCOP, 100, 4H5X20/
-
- CALL NEWGUY ('UCOCOP-UDICOP.','TCOCOP ')
- IDO=5
- IW=10
- NG=20
- NA=15
- IG=1
- I1=1
- CALL UCOPY (INTG,A,100)
- CALL UCOPY (INTG,B,100)
-
- DO 10 I=1,IDO
- CALL UCOPY (INTG(IG),A(I1),IW)
- IG=IG+NG
- 10 I1=I1+NA
-
- CALL UCOCOP (INTG,B,IDO,IW,NG,NA)
- CALL UCOCOP (IBCD,B,0,IW,NG,NA)
- CALL UCOCOP (IBCD,B,IDO,0,NG,NA)
- CALL MVERII (1,B,A,100)
-
- CALL UCOPY (INTG,B,100)
- CALL UDICOP (INTG,B,IDO,IW,NG,NA)
- CALL UDICOP (IBCD,B,0,IW,NG,NA)
- CALL UDICOP (IBCD,B,IDO,0,NG,NA)
- CALL MVERII (10,B,A,100)
-
- NB=25
- CALL UCOPY (INTG,B,100)
- CALL UCOCOP (INTG,B,IDO,NG,NG,NB)
- CALL UCOCOP (B,A,IDO,NG,NB,NG)
- CALL MVERII (2,A,INTG,100)
-
- CALL UCOPY (INTG,A,100)
- CALL UDICOP (A,A,IDO,NG,NG,NB)
- CALL MVERII (20,A,B,100)
-
-C-- TIMING
- IF (ITIMES.EQ.0) RETURN
- NTIMES = ITIMES*TINF(1)
- TINF(1) = NTIMES
- CALL TIMED (TIMERD)
-
- DO 80 J=1,NTIMES
- 80 CALL UCOCOP (B,A,IDO,NG,NB,NA)
-
- CALL TIMING (TINF)
- RETURN
-
- END
diff --git a/src/packlib/kernlib/kerngen/test/putil/tiucha.F b/src/packlib/kernlib/kerngen/test/putil/tiucha.F
deleted file mode 100644
index 9bbf444..0000000
--- a/src/packlib/kernlib/kerngen/test/putil/tiucha.F
+++ /dev/null
@@ -1,128 +0,0 @@
-*
-* $Id: tiucha.F,v 1.1.1.1 1996/02/15 17:54:57 mclareni Exp $
-*
-* $Log: tiucha.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:57 mclareni
-* Kernlib
-*
-*
-#include "kerngent/pilot.h"
- SUBROUTINE TIUCHA
-
-#include "kerngent/mkcde.inc"
-
- INTEGER TINF(4),TINF2,TINF22
-
- DIMENSION MCHA(600), MBIN(400), MHIS(200)
- EQUIVALENCE (IA(401), MCHA(401), MBIN(201), MHIS(1))
-
- DIMENSION PBIN(3), PHIS(3)
- EQUIVALENCE (NX ,PBIN(1)), (DX ,PBIN(2)), (XL ,PBIN(3))
- EQUIVALENCE (NXHIS,PHIS(1)), (DXHIS,PHIS(2)), (XLHIS,PHIS(3))
-
- DATA NX /20/, DX /2./, XL /11./
- DATA NXHIS/20/, DXHIS/.5/, XLHIS/11./
-
- DATA NEXP / 3 /
- DATA BIAS / .001 /
-
- DATA TINF /10000,4HIUCH,0,4H /, TINF2/4HIUBI/, TINF22/4HIUHI/
-
-C- DATA GROUPS 1 - 20 INSIDE, LOWER BIN EDGE EXACT
-C- 21 - 40 INSIDE, JUST BELOW UPPER BIN EDGE
-C- 41 - 50 UNDERFLOWS
-C- 51 - 60 OVERFLOWS
-
- CALL NEWGUY ('IUCHAN - IUBIN - IUHIST.','TIUCHA ')
- CALL VZERO (A,2000)
-
-C---- RUN INSIDE LIMITS
-
- DO 29 J=1,20
- X = XL + DX*FLOAT(J-1)
- MCHA(J) = IUCHAN (X,XL,DX,NX)
- MBIN(J) = IUBIN (X,PBIN(1),MBIN(J+60))
- MHIS(J) = IUHIST (X,PHIS(1),MHIS(J+60))
- IB (J) = J
-
- X = X + DX - BIAS
- MCHA(J+20) = IUCHAN (X,XL,DX,NX)
- MBIN(J+20) = IUBIN (X,PBIN(1),MBIN(J+80))
- MHIS(J+20) = IUHIST (X,PHIS(1),MHIS(J+80))
- 29 IB (J+20) = J
- CALL VFILL (IB(61),40,.FALSE.)
-
-C---- RUN UNDERFLOW
-
- FACT = 2 ** NEXP
- FACT = FACT * 1.007
-
- X = XL - BIAS
- MCHA(41) = IUCHAN (X,XL,DX,NX)
- MBIN(41) = IUBIN (X,PBIN(1),MBIN(101))
- MHIS(41) = IUHIST (X,PHIS(1),MHIS(101))
-
- X = -1.
- DO 39 J=1,9
- X = X * FACT
- MCHA(J+41) = IUCHAN (X,XL,DX,NX)
- MBIN(J+41) = IUBIN (X,PBIN(1),MBIN(J+101))
- MHIS(J+41) = IUHIST (X,PHIS(1),MHIS(J+101))
- 39 CONTINUE
-
- CALL VZERO (IB(41),10)
- CALL VFILL (IB(101),20,.TRUE.)
-
-C---- RUN OVERFLOW
-
- XH = XL + DX*FLOAT(NX)
- X = XH + BIAS
- MCHA(51) = IUCHAN (X,XL,DX,NX)
- MBIN(51) = IUBIN (X,PBIN(1),MBIN(111))
- MHIS(51) = IUHIST (X,PHIS(1),MHIS(111))
-
- Y = 1.
- DO 49 J=1,9
- Y = Y * FACT
- X = XH + Y
- MCHA(J+51) = IUCHAN (X,XL,DX,NX)
- MBIN(J+51) = IUBIN (X,PBIN(1),MBIN(J+111))
- MHIS(J+51) = IUHIST (X,PHIS(1),MHIS(J+111))
- 49 CONTINUE
- CALL VFILL (IB(51),10,NX+1)
-
-C---- CHECK
-
- CALL MVERII (1,MCHA,IB,60)
- CALL MVERII (2,MBIN,IB,120)
- CALL MVERII (3,MHIS,IB,120)
-
-C---- TIMING
-
- IF (ITIMES.EQ.0) RETURN
- NTIMES = ITIMES*TINF(1)
- TINF(1) = NTIMES
- CALL TIMED (TIMERD)
- AX=15.
-
- DO 80 J=1,NTIMES
- 80 IA(1)=IUCHAN (AX,XL,DX,NX)
-
- CALL TIMING (TINF)
- TINF(2)=TINF2
- CALL TIMED (TIMERD)
-
- DO 82 J=1,NTIMES
- 82 IA(1) = IUBIN (AX,PBIN,SPILL)
-
- CALL TIMING (TINF)
- TINF(2)=TINF22
- CALL TIMED (TIMERD)
-
- DO 84 J=1,NTIMES
- 84 IA(1) = IUHIST (AX,PHIS,SPILL)
-
- CALL TIMING (TINF)
- RETURN
-
- END
diff --git a/src/packlib/kernlib/kerngen/test/putil/tiucom.F b/src/packlib/kernlib/kerngen/test/putil/tiucom.F
deleted file mode 100644
index 2f786b0..0000000
--- a/src/packlib/kernlib/kerngen/test/putil/tiucom.F
+++ /dev/null
@@ -1,94 +0,0 @@
-*
-* $Id: tiucom.F,v 1.1.1.1 1996/02/15 17:54:57 mclareni Exp $
-*
-* $Log: tiucom.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:57 mclareni
-* Kernlib
-*
-*
-#include "kerngent/pilot.h"
- SUBROUTINE TIUCOM
-
-#include "kerngent/mkcde.inc"
-
- DIMENSION ICHEK1(200)
- EQUIVALENCE (ICHEK1(1),B(1))
- INTEGER TINF(4)
- DATA TINF /1000, 4HIUCP, 20, 4HDOWN/
-
- CALL NEWGUY ('IUCOMP-IUFIND-IUHUNT-LOCBYT.','TIUCOM ')
-
- CALL UCOPY (IBCD,A,47)
- DO 17 J=1,47
- ICHEK1(J)= IUCOMP(IBCD(J),A,47)
- ICHEK1(J+50)=IUFIND (IBCD(J),A,J,47)
- 17 ICHEK1(J+100)=IUHUNT(IBCD(J),A,47,J-1)
- CALL MVERII (1,ICHEK1,INTG,47)
- CALL MVERII (2,ICHEK1(51),INTG,47)
- CALL MVERII (3,ICHEK1(101),INTG,47)
-
- DO 27 J=1,46
- ICHEK1(J)= IUCOMP(IBCD(J+1),A,J)
- ICHEK1(J+50)=IUFIND (IBCD(J+1),A,1,J)
- 27 ICHEK1(J+100)=IUHUNT(IBCD(J+1),A,J,1)
- ICHEK1(47)=IUCOMP (IBCD(47),A,0)
- ICHEK1(147)=IUHUNT(IBCD(47),A,0,1)
- CALL UZERO (A,1,50)
- CALL MVERII (4,ICHEK1,A,47)
- CALL MVERII (5,ICHEK1(51),INTG(2),46)
- CALL MVERII (6,ICHEK1(101),A,47)
-
-C---- TEST LOCBYT
-
- IPRE = 0
- 41 CALL VFILL (A,100,IPRE)
- DO 44 J=1,20
- CALL SBYT (J, IA(J), 1, 7)
- CALL SBYT (J, IA(J), 11, 7)
- CALL SBYT (J, IA(J+20), 1, 7)
- CALL SBYT (J, IA(J+20), 11, 7)
- CALL SBYT (J, IA(J+40), 1, 7)
- CALL SBYT (J, IA(J+40), 11, 7)
- CALL SBYT (J, IA(J+60), 1, 7)
- CALL SBYT (J, IA(J+60), 11, 7)
- 44 CONTINUE
-
- DO 46 J=1,20
- IB(J) = LOCBYT (J,IA(1),20,1, 1,7)
- IB(J+20) = LOCBYT (J,IA(1),20,1,11,7) + 20
- 46 CONTINUE
- CALL MVERII (11-IPRE,IB,INTG,40)
-
- DO 49 J=1,20
- IB(J) = LOCBYT (J,IA(1),80,8,11,7)
-
- JP = J
- 48 IB(J+100) = JP
- IF (MOD(JP-1,8).EQ.0) GO TO 49
- JP = JP + 20
- IF (JP.LT.81) GO TO 48
- IB(J+100) = 0
- 49 CONTINUE
-
- IB(21) = LOCBYT (13,IA,73,9,1,7)
- IB(121) = 73
- CALL MVERII (13-IPRE,IB,IB(101),21)
- IPRE = IPRE - 1
- IF (IPRE.EQ.-1) GO TO 41
-
-C-- TIMING
- IF (ITIMES.EQ.0) RETURN
- NTIMES = ITIMES*TINF(1)
- TINF(1) = NTIMES
- CALL TIMED (TIMERD)
-
- JS = 1
- DO 80 J=1,NTIMES
- IA(JS) = IUCOMP(IBCD(20),IBCD,30)
- JS = JS + 1
- IF (JS.GT.1000) JS=1
- 80 CONTINUE
-
- CALL TIMING (TINF)
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/test/putil/tiusam.F b/src/packlib/kernlib/kerngen/test/putil/tiusam.F
deleted file mode 100644
index 74f038d..0000000
--- a/src/packlib/kernlib/kerngen/test/putil/tiusam.F
+++ /dev/null
@@ -1,64 +0,0 @@
-*
-* $Id: tiusam.F,v 1.1.1.1 1996/02/15 17:54:57 mclareni Exp $
-*
-* $Log: tiusam.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:57 mclareni
-* Kernlib
-*
-*
-#include "kerngent/pilot.h"
- SUBROUTINE TIUSAM
-
-#include "kerngent/mkcde.inc"
-
- DIMENSION MUST(20)
- DIMENSION KB(100)
- EQUIVALENCE (KB(1),IB(101))
-
- INTEGER TINF(4)
- DATA TINF /1000,4HIUSA,500,4HWRDS/
-
- DATA MUST / 40, 40, 0, 40,100, 0, 0, 20, 21,100
- +, 1, 11, 51, 11,101, 91,120,101,101,101 /
- DATA IWORD1 / 15/
- DATA IWORD2 / -375/
-
- CALL NEWGUY ('IUSAME.','TIUSAM ')
-
-C-- PREPARE THE TEST VECTOR (IB)
- DO 5 I=1,500
- 5 KB(I)=I
- CALL UFILL (KB,1,50,6HSAME50)
-
- DO 10 I=1,100
-
- KB(I+100)=IWORD1
- KB(I+300)=IWORD2
-
- 10 CONTINUE
-
-C-- SET THE RESULT VECTOR
-
- IA(1) = IUSAME (KB, 1, 40, 10, IA(11))
- IA(2) = IUSAME (KB, 11, 50, 40, IA(12))
- IA(3) = IUSAME (KB, 11, 50, 41, IA(13))
- IA(4) = IUSAME (KB, 11,100, 30, IA(14))
- IA(5) = IUSAME (KB, 11,500, 41, IA(15))
- IA(6) = IUSAME (KB, 41, 90, 20, IA(16))
- IA(7) = IUSAME (KB, 41,119, 20, IA(17))
- IA(8) = IUSAME (KB, 41,120, 20, IA(18))
- IA(9) = IUSAME (KB, 50,121, 20, IA(19))
- IA(10) = IUSAME (KB, 41,400, 20, IA(20))
-
- CALL MVERII (1,IA,MUST,20)
-
-C-- TIMING
- IF (ITIMES.EQ.0) RETURN
- NTIMES = ITIMES*TINF(1)
- TINF(1) = NTIMES
- CALL TIMED (TIMERD)
- DO 80 J=1,NTIMES
- 80 IA(1)=IUSAME (KB,1,500,75,JSAME)
- CALL TIMING (TINF)
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/test/putil/tucopy.F b/src/packlib/kernlib/kerngen/test/putil/tucopy.F
deleted file mode 100644
index c005877..0000000
--- a/src/packlib/kernlib/kerngen/test/putil/tucopy.F
+++ /dev/null
@@ -1,97 +0,0 @@
-*
-* $Id: tucopy.F,v 1.1.1.1 1996/02/15 17:54:57 mclareni Exp $
-*
-* $Log: tucopy.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:57 mclareni
-* Kernlib
-*
-*
-#include "kerngent/pilot.h"
- SUBROUTINE TUCOPY
-
-#include "kerngent/mkcde.inc"
-
- INTEGER CHECK(10)
- INTEGER TINF(4)
-
- DATA CHECK/3*0,4HA ,4HB ,4HC ,4HD ,3*0/
- DATA TINF /1000, 4HCOPY, 1000, 4HWORD/
-
- CALL NEWGUY ('UCOPY-UCOPY2-UCOPYN-UCOPIV.','TUCOPY ')
-
- DO 16 NW=1,18
- NR = 20 - NW
-
- DO 14 J=1,NW
- 14 IB(J) = INTG(J)
- DO 15 J=1,NR
- 15 IB(J+NW) = INTG(J)
-
- CALL VZERO (IA,20)
- CALL UCOPY (INTG,IA(NW+1),NR)
- CALL UCOPY (INTG,IA, NW)
- CALL MVERII (NW,IA,IB,20)
-
- CALL VZERO (IA,20)
- CALL UCOPY2 (IB(NW+1),IA(NW+1),NR)
- CALL UCOPY2 (IB, IA, NW)
- CALL MVERII (NW+100,IA,IB,20)
-
- CALL UCOPY2 (IA(NW+1),IA(NW+3),NR)
- CALL UCOPY2 (IA, IA(3), NW)
- CALL MVERII (NW+200,IA(3),IB,20)
- 16 CONTINUE
-
- CALL UZERO (A,1,100)
- CALL UCOPY (IBCD(12),A(4),4)
- CALL UCOPY (IBCD,A,0)
- CALL MVERII (51,A,CHECK,10)
-
- CALL UZERO (CHECK,5,10)
- CALL UZERO (A,1,100)
- CALL UCOPY (IBCD(12),A(4),1)
- CALL MVERII (53,A,CHECK,10)
-
- CALL UCOPY (INTG,IB,25)
- CALL UCOPY (INTG,IB(26),50)
- CALL UCOPY (INTG,IB(76),25)
- CALL UCOPY (INTG,IA,100)
-
- CALL UCOPY2 (IA,IA(76),25)
- CALL UCOPY2 (IA,IA,100)
- CALL UCOPY2 (IBCD,IA,0)
- CALL UCOPY2 (IA,IA(26),50)
- CALL MVERII (55,IA,IB,100)
-
- J=100
- DO 20 I=1,50
- IB(I)=-INTG(I)
- IB(I+50)=INTG(J)
- 20 J=J-1
-
- CALL UCOPYN (INTG,IA,50)
- CALL UCOPYN (INTG(50),IA,0)
- CALL UCOPIV (INTG(51),IA(51),50)
- CALL UCOPIV (IBCD,IA(51),0)
- CALL MVERII (60,IA,IB,100)
-
-C-- TIMING
- IF (ITIMES.EQ.0) RETURN
- NTIMES = ITIMES*TINF(1)
- TINF(1) = NTIMES
- CALL TIMED (TIMERD)
-
- DO 80 J=1,NTIMES
- 80 CALL UCOPY(A,B,1000)
- CALL TIMING (TINF)
-
- DO 84 NW=1,7
- TINF(3) = NW
- CALL TIMED (TIMERD)
-
- DO 83 J=1,NTIMES
- 83 CALL UCOPY (A,B,NW)
- CALL TIMING (TINF)
- 84 CONTINUE
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/test/putil/tuopt.F b/src/packlib/kernlib/kerngen/test/putil/tuopt.F
deleted file mode 100644
index 291145b..0000000
--- a/src/packlib/kernlib/kerngen/test/putil/tuopt.F
+++ /dev/null
@@ -1,35 +0,0 @@
-*
-* $Id: tuopt.F,v 1.1.1.1 1996/02/15 17:54:57 mclareni Exp $
-*
-* $Log: tuopt.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:57 mclareni
-* Kernlib
-*
-*
-#include "kerngent/pilot.h"
- SUBROUTINE TUOPT
-
-#include "kerngent/mkcde.inc"
-
- EQUIVALENCE (IOPT, IA(101))
-
-C-- THE TEST VECTOR
-C-- 0 1 2 3 4 5 6 7 8 9 A B C D E F G H I J K L M N O P Q R S T
-C-- - - - - - - -
- CALL UZERO (IB,1,100)
- IB(1)=1
- IB(2)=1
- IB(6)=1
- IB(9)=1
- IB(10)=1
- IB(11)=1
- IB(12)=1
-
- CALL NEWGUY ('UOPT.','TUOPT ')
-
- CALL UBUNCH (IBCD(2),IA,30)
- CALL UCTOH ('8910AB5XY456PQ',IA(401),99,30)
- CALL UOPT (IA(401),IA,IOPT,30)
- CALL MVERII (1,IOPT,IB,30)
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/test/putil/tuswop.F b/src/packlib/kernlib/kerngen/test/putil/tuswop.F
deleted file mode 100644
index ae6301b..0000000
--- a/src/packlib/kernlib/kerngen/test/putil/tuswop.F
+++ /dev/null
@@ -1,39 +0,0 @@
-*
-* $Id: tuswop.F,v 1.1.1.1 1996/02/15 17:54:58 mclareni Exp $
-*
-* $Log: tuswop.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:58 mclareni
-* Kernlib
-*
-*
-#include "kerngent/pilot.h"
- SUBROUTINE TUSWOP
-
-#include "kerngent/mkcde.inc"
-
- INTEGER TINF(4)
- DATA TINF/1000,4HUSWP,100,4HWORD/
-
- CALL NEWGUY ('USWOP.','TUSWOP ')
- CALL UZERO (A,1,100)
- CALL UZERO (B,1,100)
- CALL UCOPY (IBCD,A,47)
- CALL UCOPY (INTG,B,100)
- CALL USWOP (A,B,100)
- CALL USWOP (A(10),B(10),0)
- CALL MVERII (1,A,INTG,100)
- CALL MVERII (2,B,IBCD,47)
-
-C-- TIMING
- IF (ITIMES.EQ.0) RETURN
- NTIMES = ITIMES*TINF(1)
- TINF(1) = NTIMES
- CALL TIMED (TIMERD)
-
- DO 80 J=1,NTIMES
- 80 CALL USWOP (A,B,100)
-
- CALL TIMING (TINF)
- RETURN
-
- END
diff --git a/src/packlib/kernlib/kerngen/test/putil/tuzero.F b/src/packlib/kernlib/kerngen/test/putil/tuzero.F
deleted file mode 100644
index c2a59c3..0000000
--- a/src/packlib/kernlib/kerngen/test/putil/tuzero.F
+++ /dev/null
@@ -1,60 +0,0 @@
-*
-* $Id: tuzero.F,v 1.1.1.1 1996/02/15 17:54:58 mclareni Exp $
-*
-* $Log: tuzero.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:58 mclareni
-* Kernlib
-*
-*
-#include "kerngent/pilot.h"
- SUBROUTINE TUZERO
-
-#include "kerngent/mkcde.inc"
-
- INTEGER CHECK(100)
- INTEGER TINF(4)
-
- DATA CHECK/6*0,3*4H ,3*0,3*4H ,0,3*4H ,4*0,4H ,0,-1
- +, 3*0,6*-1,5*0,5*-1,55*0/
- DATA TINF /1000, 4HZERO, 1000, 4HWORD/
-
-C ZERO 5 6 10 11 12 16 20 21 22 23 25 -----
-C BLANK 7 8 9 13 14 15 17 18 19 24
-
-C (-1) 26 30 31 32 33 34 35 41 42 43 44 45
-C ZERO 27 28 29 36 37 38 39 40 46
-
- CALL NEWGUY ('UZERO-UBLANK-UFILL-VZERO-VBLANK-VFILL.','TUZERO ')
- CALL UZERO (A,1,100)
- CALL UBLANK (A,7,19)
- CALL UZERO (A,10,12)
- CALL UZERO (A,16,16)
- CALL UBLANK (A,24,24)
- CALL MVERII (1,A,CHECK,25)
-
- CALL UCOPY (INTG,A,9)
- CALL VZERO (A,6)
- CALL VBLANK (A(7),3)
- CALL VZERO (A(8),0)
- CALL VBLANK (A(6),0)
- CALL MVERII (2,A,CHECK,20)
-
- CALL UFILL (A,30,35,-1)
- CALL UFILL (A,26,26,-1)
- CALL VFILL (A(28),0,-1)
- CALL VFILL (A(41),5,-1)
- CALL MVERII (3,A,CHECK,100)
-
-C-- TIMING
- IF (ITIMES.EQ.0) RETURN
- NTIMES = ITIMES*TINF(1)
- TINF(1) = NTIMES
- CALL TIMED (TIMERD)
-
- DO 80 J=1,NTIMES
- 80 CALL UZERO(A,1,1000)
-
- CALL TIMING (TINF)
- RETURN
-
- END
diff --git a/src/packlib/kernlib/kerngen/test/pvect/Imakefile b/src/packlib/kernlib/kerngen/test/pvect/Imakefile
deleted file mode 100644
index 3d4e89b..0000000
--- a/src/packlib/kernlib/kerngen/test/pvect/Imakefile
+++ /dev/null
@@ -1,4 +0,0 @@
-SRCS_F= \ @@\
- tcross.F tlor.F trot.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kerngen/test/pvect/tcross.F b/src/packlib/kernlib/kerngen/test/pvect/tcross.F
deleted file mode 100644
index 5c6c6df..0000000
--- a/src/packlib/kernlib/kerngen/test/pvect/tcross.F
+++ /dev/null
@@ -1,39 +0,0 @@
-*
-* $Id: tcross.F,v 1.1.1.1 1996/02/15 17:54:58 mclareni Exp $
-*
-* $Log: tcross.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:58 mclareni
-* Kernlib
-*
-*
-#include "kerngent/pilot.h"
- SUBROUTINE TCROSS
-
-#include "kerngent/mkcde.inc"
-
- DIMENSION X(3),Y(3),CHECK(9)
- INTEGER TINF(4)
-
- DATA X/5., 2., 9./, Y/7., 4., 3./
- DATA CHECK/-30., 48., 6., 30., -48., -6., 3*0./
- DATA TINF/10000,4HCROS,0,4H /
-
- CALL NEWGUY ('CROSS.','TCROSS ')
- ZERLEV = ZEROV(2)
-
- CALL CROSS (X,Y,B)
- CALL CROSS (Y,X,B(4))
- CALL CROSS (X,X,B(7))
- CALL MVERIF (1,B,CHECK,9)
-
-C-- TIMING
- IF (ITIMES.EQ.0) RETURN
- NTIMES = ITIMES*TINF(1)
- TINF(1) = NTIMES
- CALL TIMED (TIMERD)
- DO 80 J=1,NTIMES
- 80 CALL CROSS (X,Y,B)
- CALL TIMING (TINF)
- RETURN
-
- END
diff --git a/src/packlib/kernlib/kerngen/test/pvect/tlor.F b/src/packlib/kernlib/kerngen/test/pvect/tlor.F
deleted file mode 100644
index a6daecc..0000000
--- a/src/packlib/kernlib/kerngen/test/pvect/tlor.F
+++ /dev/null
@@ -1,115 +0,0 @@
-*
-* $Id: tlor.F,v 1.1.1.1 1996/02/15 17:54:58 mclareni Exp $
-*
-* $Log: tlor.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:58 mclareni
-* Kernlib
-*
-*
-#include "kerngent/pilot.h"
- SUBROUTINE TLOR
-
-#include "kerngent/mkcde.inc"
-
- DIMENSION P(4),PNEG(4),PLAB1(4),PLAB2(4),PNCM1(4),PNCM2(4)
- EQUIVALENCE (A(1),PNEG(1)), (A(11),PLAB1(1)), (A(15),PLAB2(1))
- +, (A(21),PNCM1(1)), (A(25),PNCM2(1))
- DIMENSION PCMVV(8),PCM1(4),PCM2(4)
- EQUIVALENCE (PCM1(1),PCMVV(1)),(PCM2(1),PCMVV(5))
- DIMENSION PCHKVV(8),PCHK1(4),PCHK2(4)
- EQUIVALENCE (PCHK1(1),PCHKVV(1)),(PCHK2(1),PCHKVV(5))
- INTEGER TINF(4),TINFF,TINFB
- REAL M,M1,M2
-
- DATA P / 3000.,1000.,500.,0./
- DATA PCM1 / 400.,300.,0.,100./
- DATA PCM2 / -400.,-300.,0.,200./
- DATA PCHK1 / 2830.74124, 1110.24708, 405.123540, 100./
- DATA PCHK2 / 169.25876, -110.24708, 94.876460, 200./
- DATA TINF / 1000, 4HLOR4, 0, 4H /
- +, TINFF /4HLORF/, TINFB /4HLORB/
-
-C- CONSERVE P 3000.0, 1000.0, 500.0 ----------
-
- CALL NEWGUY ('LOREN4-LORENF-LORENB.','TLOR ')
- ZERLEV = ZEROV(5)
-
- ECM1 = VMOD (PCM1,4)
- ECM2 = VMOD (PCM2,4)
- M = ECM1+ECM2
- P(4) = SQRT ( VDOT(P,P,3) + M*M)
- CALL VCOPYN (P,PNEG,3)
- PNEG(4)= P(4)
-
-C-- CHECK OF ROUTINE LOREN4
- M1=PCM1(4)
- M2=PCM2(4)
- PCM1(4)=ECM1
- PCM2(4)=ECM2
- CALL LOREN4 (PNEG,PCM1,PLAB1)
- CALL LOREN4 (PNEG,PCM2,PLAB2)
- CALL LOREN4 (P,PLAB1,PNCM1)
- CALL LOREN4 (P,PLAB2,PNCM2)
- PLAB1(4)=SQRT (-DOTI (PLAB1,PLAB1))
- PLAB2(4)=SQRT (-DOTI (PLAB2,PLAB2))
- PNCM1(4)=SQRT (-DOTI (PNCM1,PNCM1))
- PNCM2(4)=SQRT (-DOTI (PNCM2,PNCM2))
- PCM1(4)=M1
- PCM2(4)=M2
- CALL MVERIF (3,PLAB1,PCHK1,8)
- CALL MVERIF (4,PNCM1,PCM1,8)
-
-C-- CHECK OF ROUTINE LORENF
- PCM1(4)= ECM1
- PCM2(4)= ECM2
- CALL LORENF (M,PNEG,PCM1,PLAB1)
- CALL LORENF (M,PNEG,PCM2,PLAB2)
- CALL LORENF (M,P,PLAB1,PNCM1)
- CALL LORENF (M,P,PLAB2,PNCM2)
- PLAB1(4)= SQRT (-DOTI (PLAB1,PLAB1))
- PLAB2(4)= SQRT (-DOTI (PLAB2,PLAB2))
- PNCM1(4)= SQRT (-DOTI (PNCM1,PNCM1))
- PNCM2(4)= SQRT (-DOTI (PNCM2,PNCM2))
- PCM1(4)= M1
- PCM2(4)= M2
- CALL MVERIF (7,PLAB1,PCHK1,8)
- CALL MVERIF (8,PNCM1,PCM1 ,8)
-
-C-- CHECK OF ROUTINE LORENB
- PCM1(4)= ECM1
- PCM2(4)= ECM2
- CALL LORENB (M,P,PCM1,PLAB1)
- CALL LORENB (M,P,PCM2,PLAB2)
- CALL LORENB (M,PNEG,PLAB1,PNCM1)
- CALL LORENB (M,PNEG,PLAB2,PNCM2)
- PLAB1(4)= SQRT (-DOTI (PLAB1,PLAB1))
- PLAB2(4)= SQRT (-DOTI (PLAB2,PLAB2))
- PNCM1(4)= SQRT (-DOTI (PNCM1,PNCM1))
- PNCM2(4)= SQRT (-DOTI (PNCM2,PNCM2))
- PCM1(4)= M1
- PCM2(4)= M2
- CALL MVERIF (9 ,PLAB1,PCHK1,8)
- CALL MVERIF (10,PNCM1,PCM1 ,8)
-
-
-C-- TIMING
- IF (ITIMES.EQ.0) RETURN
- NTIMES = ITIMES*TINF(1)
- TINF(1) = NTIMES
- CALL TIMED (TIMERD)
- DO 180 J=1,NTIMES
- 180 CALL LOREN4 (P,PCM1,PLAB1)
- CALL TIMING (TINF)
-
- TINF(2)= TINFF
- CALL TIMED (TIMERD)
- DO 380 J=1,NTIMES
- 380 CALL LORENF (M,P,PCM1,PLAB1)
-
- CALL TIMING (TINF)
- TINF(2)= TINFB
- DO 480 J= 1,NTIMES
- 480 CALL LORENB (M,PNEG,PCM1,PLAB1)
- CALL TIMING (TINF)
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/test/pvect/trot.F b/src/packlib/kernlib/kerngen/test/pvect/trot.F
deleted file mode 100644
index c743d1b..0000000
--- a/src/packlib/kernlib/kerngen/test/pvect/trot.F
+++ /dev/null
@@ -1,37 +0,0 @@
-*
-* $Id: trot.F,v 1.1.1.1 1996/02/15 17:54:58 mclareni Exp $
-*
-* $Log: trot.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:58 mclareni
-* Kernlib
-*
-*
-#include "kerngent/pilot.h"
- SUBROUTINE TROT
-
-#include "kerngent/mkcde.inc"
-
- DIMENSION X(3),CHECK(3)
- INTEGER TINF(4)
-
- DATA X/100.,20.,10./
- DATA CHECK/ 89.6232448, 48.6587504, 10./
- DATA TINF/10000,4HROT ,0,4H /
-
- CALL NEWGUY ('ROT.','TROT ')
- ZERLEV = ZEROV(3)
-
- CALL ROT (X,.3,B)
- CALL MVERIF (1,B,CHECK,3)
-
-C-- TIMING
- IF (ITIMES.EQ.0) RETURN
- NTIMES = ITIMES*TINF(1)
- TINF(1) = NTIMES
- CALL TIMED (TIMERD)
- DO 80 J=1,NTIMES
- 80 CALL ROT (X,.3,B)
- CALL TIMING (TINF)
- RETURN
-
- END
diff --git a/src/packlib/kernlib/kerngen/test/pvpack/Imakefile b/src/packlib/kernlib/kerngen/test/pvpack/Imakefile
deleted file mode 100644
index cec52ac..0000000
--- a/src/packlib/kernlib/kerngen/test/pvpack/Imakefile
+++ /dev/null
@@ -1,4 +0,0 @@
-SRCS_F= \ @@\
- tvec.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kerngen/test/pvpack/tvec.F b/src/packlib/kernlib/kerngen/test/pvpack/tvec.F
deleted file mode 100644
index 44fc4df..0000000
--- a/src/packlib/kernlib/kerngen/test/pvpack/tvec.F
+++ /dev/null
@@ -1,265 +0,0 @@
-*
-* $Id: tvec.F,v 1.1.1.1 1996/02/15 17:54:59 mclareni Exp $
-*
-* $Log: tvec.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:59 mclareni
-* Kernlib
-*
-*
-#include "kerngent/pilot.h"
- SUBROUTINE TVEC
-
-#include "kerngent/mkcde.inc"
-
-
-C*A* 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 24 25
-C*B* 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 0 -1 -2 -3 -4 -5 -6 -8 -9
-
- CALL NEWGUY ('VADD-VSUB-VMUL-VBIAS-VSCALE-VLINE-VUNIT.',
- + 'TVEC ')
- ZERLEV = ZEROV(2)
-
- ALPHA=5.
- BETA=2.
- V=0.
-
- J=15
- DO 10 I=1,25
- A(I)=I
- B(I)=J
- B(I+100)=I+J
- B(I+150)=J-I
- B(I+200)=I*J
- B(I+250)=ALPHA+B(I)
- B(I+300)=BETA*B(I)
- B(I+350)=ALPHA*A(I) + B(I+300)
- V=V+B(I)*B(I)
- 10 J=J-1
-
- V1=1./SQRT (V)
- CALL VZERO (B(26),25)
- DO 15 I=1,25
- 15 B(I+400)=B(I)*V1
-
- CALL VADD (A,B,A(101),25)
- CALL VADD (A(5),B,A(101),0)
-
- CALL VSUB (B,A,A(151),25)
- CALL VSUB (A,B,A(151),0)
-
- CALL VMUL (A,B,A(201),25)
- CALL VMUL (A(5),B,A(201),0)
-
- CALL VBIAS (B,ALPHA,A(251),25)
- CALL VBIAS (A,BETA,A(251),0)
-
- CALL VSCALE (B,BETA,A(301),25)
- CALL VSCALE (A,ALPHA,A(301),0)
-
- CALL VLINE (A,ALPHA,B,BETA,A(351),25)
- CALL VLINE (A,BETA,B,ALPHA,A(351),0)
-
- CALL VUNIT (B,A(401),25)
- CALL VUNIT (A,A(401),0)
-
- LOC=101
- DO 20 IT=1,6
- CALL MVERII (IT,A(LOC),B(LOC),25)
- 20 LOC=LOC+50
-
- CALL MVERIF (7,A(LOC),B(LOC),25)
-
- CALL NEWGUY ('VSUM-VASUM-VMAX-VMAXA-VMIN-VMINA-+++.','TVEC ')
- CALL NEWGUY ('VEXCUM-LVMAX-LVMAXA-LVMIN-LVMINA.','TVEC ')
- CALL VZERO (B(26),25)
-
- DO 25 I=1,25
- B(26)=B(26)+A(I)
- B(27)=B(27)+B(I)
- 25 B(29)=B(29)+ABS (B(I))
- B(28)=B(26)
- B(30)=B(28)
- B(31)=9.
- B(32)=B(28)
- B(33)=9.
- B(34)=1.
- B(35)=-9.
- B(36)=1.
- B(37)=1.
- B(38)=B(35)
- B(39)=25.
- B(40)=10.+B(26)+B(27)
- IB(41)=26
- IB(42)=1
- IB(43)=26
- IB(44)=18
- IB(45)=1
- IB(46)=25
- IB(47)=1
- IB(48)=1
-
- A(26)=VSUM (A,25) + VSUM (A,0) 325.
- A(27)=VSUM (B,25) + VSUM (B,0) 75.
-
- A(28)=VASUM (A,25) + VASUM (A,0) 325.
- A(29)=VASUM (B,25) + VASUM (B,0) 165.
-
- A(30)=VMAX (A,29) + VMAX (A,0) 325.
- A(31)=VMAX (B(7),19) + VMAX(B,0) 9.
-
- A(32)=VMAXA (A,31) + VMAXA (A,0) 325.
- A(33)=VMAXA (B(8),18) + VMAXA(B,0) 9.
-
- A(34)=VMIN (A,33) + VMIN(A,0) 1.
- A(35)=VMIN (B,34) + VMIN (B,0)
-
- A(36)=VMINA (A,35) + VMINA (A,0) 1.
- A(37)=VMINA (B(17),10) + VMINA (B,0) 1.
-
- CALL VFILL (A(38),3,10.) 3*10.
- CALL VEXCUM (A,A(38),25)
- CALL VEXCUM (B,A(38),25)
- CALL VEXCUM (A,A(38),0)
-
- IA(41)=LVMAX (A,29) + LVMAX(A,0) 26
- IA(42)=LVMAX (B(7),19) + LVMAX (B,0) 1
-
- IA(43)=LVMAXA (A,31) + LVMAXA (A,0) 26
- IA(44)=LVMAXA (B(8),18) + LVMAXA (B,0) 18
-
- IA(45)=LVMIN (A,33) + LVMIN (A,0) 1
- IA(46)=LVMIN (B,34) + LVMIN (B,0) 25
-
- IA(47)=LVMINA (A,35) + LVMINA (A,0) 1
- IA(48)=LVMINA (B(17),10) + LVMINA (B,0) 1
-
- CALL MVERII (10,A(26),B(26),23)
-
- CALL NEWGUY ('VMOD-DOTI-VDOT-VDOTN-VDOTN2-VDIST-VDIST2.',
- + 'TVEC ')
-
- CALL VZERO (B(51),50)
-
- DO 30 I=1,3
- B(51)=B(51) + A(I)*A(I)
- B(52)=B(52) + B(I)*B(I)
- B(54)=B(54) + A(I+3)*A(I+3)
- B(55)=B(55) + B(I+3)*B(I+3)
- B(57)=B(57) + B(I+150)*B(I+150)
- B(58)=B(58) + B(I+166)*B(I+166)
- B(59)=B(59) + B(I+200)
- B(60)=B(60) + B(I+216)
- B(67)=B(67) + B(I+204)
- B(68)=B(68) + B(I+220)
- B(81)=B(81) + A(I+16)*A(I+16)
- B(82)=B(82) + A(I+19)*A(I+19)
- 30 CONTINUE
-
- B(91)=SQRT (B(51)+B(54)+A(7)*A(7))
- B(92)=SQRT (B(52)+B(55)+B(7)*B(7))
- B(93)=SQRT (B(81)+B(82)+A(23)*A(23))
- B(81)=SQRT (B(81))
-
- B(54)=SQRT (B(54)+B(51))
- B(55)=SQRT (B(55)+B(52))
- B(56)=B(54)
-
- B(51)=SQRT (B(51))
- B(52)=SQRT (B(52))
- B(53)=B(51)
-
- B(57)=SQRT (B(57))
- B(58)=SQRT (B(58))
-
- B(61)=B(59) + B(204)
- B(62)=B(60) + B(220)
-
- B(63)=B(59) - B(204)
- B(64)=B(60) - B(220)
-
- B(65)=B(59)/(B(51)*B(52))
- B(66)=B(60)/(B(81)*B(51))
-
- B(67)=B(67)+B(61)
- B(68)=B(68)+B(62)
-
- B(69)=B(67)/(B(91)*B(92))
- B(70)=B(68)/(B(91)*B(93))
- B(71)=B(69)**2
- B(72)=B(70)**2
-
- A(51)= VMOD(A,3)
- A(52)= VMOD(B,3)
- A(53)= VMOD(B(17),3)
-
- A(54)=VMOD (A,6) + VMOD (A,0)
- A(55)=VMOD (B,6) + VMOD (A,0)
- A(56)=VMOD (B(17),6) + VMOD (B,0)
-
- A(57)= VDIST (A,B,3) + VDIST (A,B,0)
- A(58)= SQRT (VDIST2(A(17),B(17),3)) + VDIST2 (A,B,0)
-
- A(63)=DOTI (A,B)
- A(64)=DOTI (A(17),B(17))
-
-C- ELEMENTS 59 - 60 - 61 - 62 - 65 - 66 ARE DUMMY FROM VS 2.04 ON.
-C- PREVIOUS VALUES ---------------------
-C A(57)=DIST (A,$)
-C A(58)=DIST (A(17),B(17))
-C A(59)=DOT (A,B)
-C A(60)=DOT (A(17),B(17))
-C A(61)=DOT4 (A,B)
-C A(62)=DOT4 (A(17),B(17))
-C A(65)=DOTNOR (A,B)
-C A(66)=DOTNOR (A(17),B(17))
-
-C- DUMMY VALUES ---------------------
- A(59)=B(59)
- A(60)=B(60)
- A(61)=B(61)
- A(62)=B(62)
- A(65)=B(65)
- A(66)=B(66)
-
- A(67)=VDOT (A,B,7) + VDOT (A,B,0)
- A(68)=VDOT (A(17),B(17),7) + VDOT (A(17),B(17),0)
-
- A(69)=VDOTN (A,B,7) + VDOTN (A,B,0)
- A(70)=VDOTN (A(17),B(17),7) + VDOTN (A(17),B(17),0)
-
- A(71)=VDOTN2 (A,B,7) + VDOTN2 (A,B,0)
- A(72)=VDOTN2 (A(17),B(17),7) + VDOTN2 (A(17),B(17),0)
-
- CALL MVERIF (15,A(51),B(51),22)
-
- CALL NEWGUY ('VMATR-VMATL.','TVEC ')
- K=5
- N=4
-
- DO 40 I=1,K
- B(I+500)=0.
- IA1=I
-
- DO 35 J=1,N
- B(I+500)=B(I+500) + B(J)*A(IA1)
- 35 IA1=IA1+K
- 40 CONTINUE
-
-C-- A IS THE MATRIX, B IS THE VECTOR
- CALL VMATR (B,A,A(501),N,K)
- CALL MVERII (21,A(501),B(501),K)
-
- IA1=1
- DO 50 I=1,K
- B(I+600)=0.
-
- DO 45 J=1,N
- B(I+600)=B(I+600) + B(J)*A(IA1)
- 45 IA1=IA1+1
- 50 CONTINUE
-
- CALL VMATL (A,B,A(601),K,N)
- CALL MVERII (22,A(601),B(601),K)
-
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/test/test.F b/src/packlib/kernlib/kerngen/test/test.F
deleted file mode 100644
index 35ed0cb..0000000
--- a/src/packlib/kernlib/kerngen/test/test.F
+++ /dev/null
@@ -1,9 +0,0 @@
-*
-* $Id: test.F,v 1.1.1.1 1996/02/15 17:54:52 mclareni Exp $
-*
-* $Log: test.F,v $
-* Revision 1.1.1.1 1996/02/15 17:54:52 mclareni
-* Kernlib
-*
-*
-#include "micky/mimain.F"
diff --git a/src/packlib/kernlib/kerngen/unix/Imakefile b/src/packlib/kernlib/kerngen/unix/Imakefile
deleted file mode 100644
index 5eef19c..0000000
--- a/src/packlib/kernlib/kerngen/unix/Imakefile
+++ /dev/null
@@ -1,39 +0,0 @@
-#define IHaveSubdirs
-#define PassCDebugFlags
-
-#if defined(CERNLIB_HPUX)
-LIBDIRS=hpxgs
-#else
-#if defined(CERNLIB_SUN) || defined(CERNLIB_SOLARIS)
-LIBDIRS=sungs
-#else
-#if defined(CERNLIB_LNX) && !defined(CERNLIB_GFORTRAN)
-LIBDIRS=lnxgs
-#else
-#if defined(CERNLIB_IRTD)
-LIBDIRS=irtdgs
-#else
-#if defined(CERNLIB_GFORTRAN)
-LIBDIRS=gfortgs
-#else
-#undef IHaveSubdirs
-all::
-
-SubdirLibraryTarget(NullParameter,NullParameter)
-
-#endif
-#endif
-#endif
-#endif
-#endif
-
-#ifdef IHaveSubdirs
-
-SUBDIRS= $(LIBDIRS)
-
-MakeSubdirs($(SUBDIRS))
-
-SubdirLibraryTarget(kerngen,$(LIBDIRS))
-
-#endif
-
diff --git a/src/packlib/kernlib/kerngen/unix/gfortgs/Imakefile b/src/packlib/kernlib/kerngen/unix/gfortgs/Imakefile
deleted file mode 100644
index d457877..0000000
--- a/src/packlib/kernlib/kerngen/unix/gfortgs/Imakefile
+++ /dev/null
@@ -1,6 +0,0 @@
-
-SRCS_F= irndm.F qnext.F rdmin.F
-
-SRCS_C= lshift.c ishftr.c getarg.c
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kerngen/unix/gfortgs/getarg.c b/src/packlib/kernlib/kerngen/unix/gfortgs/getarg.c
deleted file mode 100644
index 009daf9..0000000
--- a/src/packlib/kernlib/kerngen/unix/gfortgs/getarg.c
+++ /dev/null
@@ -1,4 +0,0 @@
-void getarg_(int *pos, char *val, int len)
-{
- _gfortran_getarg_i4(pos, val, len);
-}
diff --git a/src/packlib/kernlib/kerngen/unix/gfortgs/irndm.F b/src/packlib/kernlib/kerngen/unix/gfortgs/irndm.F
deleted file mode 100644
index 1b3c9d7..0000000
--- a/src/packlib/kernlib/kerngen/unix/gfortgs/irndm.F
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: irndm.F,v 1.1 2006/09/15 09:35:25 mclareni Exp $
-*
-* $Log: irndm.F,v $
-* Revision 1.1 2006/09/15 09:35:25 mclareni
-* Submitted mods for gcc4/gfortran and MacOSX, corrected to work also on slc4 with gcc3.4 and 4.1
-*
-* Revision 1.1.1.1 1996/02/15 17:50:07 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- FUNCTION IRNDM(ISEEK)
- COMMON /MCGN/ MCGN
-
-C-- Integer random number
- MCGN = MCGN * 69069
- IRNDM = ISHFT (MCGN,-1)
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/unix/gfortgs/ishftr.c b/src/packlib/kernlib/kerngen/unix/gfortgs/ishftr.c
deleted file mode 100644
index 4abcc8a..0000000
--- a/src/packlib/kernlib/kerngen/unix/gfortgs/ishftr.c
+++ /dev/null
@@ -1,24 +0,0 @@
-/*
- * $Id: ishftr.c,v 1.1 2006/09/15 09:35:25 mclareni Exp $
- *
- * $Log: ishftr.c,v $
- * Revision 1.1 2006/09/15 09:35:25 mclareni
- * Submitted mods for gcc4/gfortran and MacOSX, corrected to work also on slc4 with gcc3.4 and 4.1
- *
- * Revision 1.1.1.1 1996/02/15 17:50:07 mclareni
- * Kernlib
- *
- */
-#include "kerngen/pilot.h"
-/*> ROUTINE ISHFT
- CERN PROGLIB# ISHFTR .VERSION KERNLNX 1.02 940511
-
- Logical right shift by *len (+ve) places
-*/
-unsigned int ishftr_(arg,len)
-unsigned int *arg;
-int *len;
-{
- return(*arg >> *len);
-}
-/*> END <----------------------------------------------------------*/
diff --git a/src/packlib/kernlib/kerngen/unix/gfortgs/lshift.c b/src/packlib/kernlib/kerngen/unix/gfortgs/lshift.c
deleted file mode 100644
index 2fa7643..0000000
--- a/src/packlib/kernlib/kerngen/unix/gfortgs/lshift.c
+++ /dev/null
@@ -1,26 +0,0 @@
-/*
- * $Id: lshift.c,v 1.1 2006/09/15 09:35:25 mclareni Exp $
- *
- * $Log: lshift.c,v $
- * Revision 1.1 2006/09/15 09:35:25 mclareni
- * Submitted mods for gcc4/gfortran and MacOSX, corrected to work also on slc4 with gcc3.4 and 4.1
- *
- * Revision 1.1.1.1 1996/02/15 17:50:07 mclareni
- * Kernlib
- *
- */
-#include "kerngen/pilot.h"
-/*> ROUTINE ISHFT
- CERN PROGLIB# ISHFT .VERSION KERNLNX 1.00 930507
-
- Provides the value of the argument ARG with the bits shifted.
- Bits shifted out to the left or right are lost, and zeros are shifted
- in from the opposite end. CNL 210
-*/
-unsigned int lshift_(arg,len)
-unsigned int *arg;
-int *len;
-{
- return((*len > 0)? *arg << *len: *arg >> (-*len));
-}
-/*> END <----------------------------------------------------------*/
diff --git a/src/packlib/kernlib/kerngen/unix/gfortgs/qnext.F b/src/packlib/kernlib/kerngen/unix/gfortgs/qnext.F
deleted file mode 100644
index ac58ddc..0000000
--- a/src/packlib/kernlib/kerngen/unix/gfortgs/qnext.F
+++ /dev/null
@@ -1,15 +0,0 @@
-*
-* $Id: qnext.F,v 1.1 2006/09/15 09:35:26 mclareni Exp $
-*
-* $Log: qnext.F,v $
-* Revision 1.1 2006/09/15 09:35:26 mclareni
-* Submitted mods for gcc4/gfortran and MacOSX, corrected to work also on slc4 with gcc3.4 and 4.1
-*
-* Revision 1.1.1.1 1996/02/15 17:50:08 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE QNEXT
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/unix/gfortgs/rdmin.F b/src/packlib/kernlib/kerngen/unix/gfortgs/rdmin.F
deleted file mode 100644
index c8dbbfc..0000000
--- a/src/packlib/kernlib/kerngen/unix/gfortgs/rdmin.F
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: rdmin.F,v 1.1 2006/09/15 09:35:26 mclareni Exp $
-*
-* $Log: rdmin.F,v $
-* Revision 1.1 2006/09/15 09:35:26 mclareni
-* Submitted mods for gcc4/gfortran and MacOSX, corrected to work also on slc4 with gcc3.4 and 4.1
-*
-* Revision 1.1.1.1 1996/02/15 17:50:07 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE RDMIN(ISEED)
- COMMON /MCGN/ MCGN
-
-C-- Set the seed
- MCGN = ISEED
- RETURN
-
-C-- Get the seed
- ENTRY RDMOUT (ISEED)
- ISEED = MCGN
- END
diff --git a/src/packlib/kernlib/kerngen/unix/hpxgs/Imakefile b/src/packlib/kernlib/kerngen/unix/hpxgs/Imakefile
deleted file mode 100644
index 4ee972f..0000000
--- a/src/packlib/kernlib/kerngen/unix/hpxgs/Imakefile
+++ /dev/null
@@ -1,4 +0,0 @@
-SRCS_C= \ @@\
- traceqc.c
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kerngen/unix/hpxgs/traceqc.c b/src/packlib/kernlib/kerngen/unix/hpxgs/traceqc.c
deleted file mode 100644
index 71a0050..0000000
--- a/src/packlib/kernlib/kerngen/unix/hpxgs/traceqc.c
+++ /dev/null
@@ -1,26 +0,0 @@
-/*
- * $Id: traceqc.c,v 1.1.1.1 1996/02/15 17:50:06 mclareni Exp $
- *
- * $Log: traceqc.c,v $
- * Revision 1.1.1.1 1996/02/15 17:50:06 mclareni
- * Kernlib
- *
- */
-#include "kerngen/pilot.h"
-/*> ROUTINE TRACEQC
- CERN PROGLIB# N105 TRACEQC .VERSION KERNHPX 1.04 950928
- ORIG. 3/05/95 FR, JZ
- subsidiary to TRACEQ
-*/
-#if defined(CERNLIB_QX_SC)
- void traceqc_()
-#endif
-#if defined(CERNLIB_QXNO_SC)
- void traceqc()
-#endif
-{
- void U_STACK_TRACE(); /* somewhere in Fortran RTL */
- U_STACK_TRACE();
- return;
-}
-/*> END <----------------------------------------------------------*/
diff --git a/src/packlib/kernlib/kerngen/unix/irtdgs/Imakefile b/src/packlib/kernlib/kerngen/unix/irtdgs/Imakefile
deleted file mode 100644
index 17b733e..0000000
--- a/src/packlib/kernlib/kerngen/unix/irtdgs/Imakefile
+++ /dev/null
@@ -1,5 +0,0 @@
-SRCS_F= \ @@\
- adredkd.F adwrtk.F adwrtkd.F \ @@\
- pack.F upack.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kerngen/unix/irtdgs/adredkd.F b/src/packlib/kernlib/kerngen/unix/irtdgs/adredkd.F
deleted file mode 100644
index c698cb5..0000000
--- a/src/packlib/kernlib/kerngen/unix/irtdgs/adredkd.F
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: adredkd.F,v 1.1.1.1 1996/02/15 17:50:06 mclareni Exp $
-*
-* $Log: adredkd.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:06 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- at PROCESS AUTODBL(NONE)
- SUBROUTINE ADREDKD(LUN,IA,ND,IREC,ISW)
- INTEGER IA(2*ND)
- INTEGER IREC,ISW
-*
- READ(LUN,REC=IREC,IOSTAT=ISW) (IA(J),J=1,2*ND)
- END
diff --git a/src/packlib/kernlib/kerngen/unix/irtdgs/adwrtk.F b/src/packlib/kernlib/kerngen/unix/irtdgs/adwrtk.F
deleted file mode 100644
index 85ea84e..0000000
--- a/src/packlib/kernlib/kerngen/unix/irtdgs/adwrtk.F
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: adwrtk.F,v 1.1.1.1 1996/02/15 17:50:06 mclareni Exp $
-*
-* $Log: adwrtk.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:06 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- at PROCESS AUTODBL(NONE)
- SUBROUTINE ADWRTK(LUN,IA,ND,ISW)
- INTEGER IA(2*ND)
- INTEGER ISW
-*
- WRITE(LUN,IOSTAT=ISW) (IA(J),J=1,2*ND)
- END
diff --git a/src/packlib/kernlib/kerngen/unix/irtdgs/adwrtkd.F b/src/packlib/kernlib/kerngen/unix/irtdgs/adwrtkd.F
deleted file mode 100644
index 1092462..0000000
--- a/src/packlib/kernlib/kerngen/unix/irtdgs/adwrtkd.F
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: adwrtkd.F,v 1.1.1.1 1996/02/15 17:50:06 mclareni Exp $
-*
-* $Log: adwrtkd.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:06 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- at PROCESS AUTODBL(NONE)
- SUBROUTINE ADWRTKD(LUN,IA,ND,IREC,ISW)
- INTEGER IA(2*ND)
- INTEGER ISW
-*
- WRITE(LUN,REC=IREC,IOSTAT=ISW) (IA(J),J=1,2*ND)
- END
diff --git a/src/packlib/kernlib/kerngen/unix/irtdgs/pack.F b/src/packlib/kernlib/kerngen/unix/irtdgs/pack.F
deleted file mode 100644
index ceb2a56..0000000
--- a/src/packlib/kernlib/kerngen/unix/irtdgs/pack.F
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: pack.F,v 1.1.1.1 1996/02/15 17:50:07 mclareni Exp $
-*
-* $Log: pack.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:07 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- at PROCESS AUTODBL(NONE)
- SUBROUTINE PACK(A,B,NDIM)
- INTEGER A(2*NDIM),B(2*NDIM)
- B(1) = A(1)
- DO I=3,2*NDIM,2
- IX2 = I
- IX1 = (I+1)/2
- B(IX1) = A(IX2)
- B(IX2) = 0
- ENDDO
- END
diff --git a/src/packlib/kernlib/kerngen/unix/irtdgs/upack.F b/src/packlib/kernlib/kerngen/unix/irtdgs/upack.F
deleted file mode 100644
index 8bdd7fe..0000000
--- a/src/packlib/kernlib/kerngen/unix/irtdgs/upack.F
+++ /dev/null
@@ -1,39 +0,0 @@
-*
-* $Id: upack.F,v 1.1.1.1 1996/02/15 17:50:07 mclareni Exp $
-*
-* $Log: upack.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:07 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- at PROCESS AUTODBL(NONE)
- SUBROUTINE UPACK(A,B,NDIM)
-*
-* Unpack 32 bit words to 64 bit words padding rightmost significant
-* bit with 0. Should work whatever A and B adresses provided.
-* MR/IBM, 8-9-1993
-*
- INTEGER A(2*NDIM),B(2*NDIM)
-*
- IADA = LOCB(A)
- IADB = LOCB(B)
- NS = ISHFT (LOCB(A)-LOCB(B),-2)
-
- DO I=1,NS
- IX2 = I
- IX1 = 2*I -1
- B(IX1) = A(IX2)
- ENDDO
-
- DO I=NDIM,NS+1,-1
- IX1 = I
- IX2 = 2*I -1
- B(IX2) = A(IX1)
- ENDDO
-
- DO I=2,2*NDIM,2
- B(I) = 0
- ENDDO
-
- END
diff --git a/src/packlib/kernlib/kerngen/unix/lnxgs/Imakefile b/src/packlib/kernlib/kerngen/unix/lnxgs/Imakefile
deleted file mode 100644
index 94c07db..0000000
--- a/src/packlib/kernlib/kerngen/unix/lnxgs/Imakefile
+++ /dev/null
@@ -1,8 +0,0 @@
-SRCS_F= \ @@\
- btest.F iand.F ibclr.F ibset.F ieor.F ior.F irndm.F \ @@\
- qnext.F rdmin.F
-
-SRCS_C= \ @@\
- ishft.c ishftr.c
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kerngen/unix/lnxgs/btest.F b/src/packlib/kernlib/kerngen/unix/lnxgs/btest.F
deleted file mode 100644
index d1bf62d..0000000
--- a/src/packlib/kernlib/kerngen/unix/lnxgs/btest.F
+++ /dev/null
@@ -1,13 +0,0 @@
-*
-* $Id: btest.F,v 1.1.1.1 1996/02/15 17:50:07 mclareni Exp $
-*
-* $Log: btest.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:07 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- LOGICAL FUNCTION BTEST(IZW,IZP)
- BTEST = AND (IZW,LSHIFT(1,IZP)) .NE. 0
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/unix/lnxgs/iand.F b/src/packlib/kernlib/kerngen/unix/lnxgs/iand.F
deleted file mode 100644
index edb5954..0000000
--- a/src/packlib/kernlib/kerngen/unix/lnxgs/iand.F
+++ /dev/null
@@ -1,15 +0,0 @@
-*
-* $Id: iand.F,v 1.1.1.1 1996/02/15 17:50:07 mclareni Exp $
-*
-* $Log: iand.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:07 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- FUNCTION IAND(IZV,IZW)
-*
- IAND = AND(IZV,IZW)
-*
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/unix/lnxgs/ibclr.F b/src/packlib/kernlib/kerngen/unix/lnxgs/ibclr.F
deleted file mode 100644
index cd7fb4b..0000000
--- a/src/packlib/kernlib/kerngen/unix/lnxgs/ibclr.F
+++ /dev/null
@@ -1,13 +0,0 @@
-*
-* $Id: ibclr.F,v 1.1.1.1 1996/02/15 17:50:07 mclareni Exp $
-*
-* $Log: ibclr.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:07 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- FUNCTION IBCLR(IZW,IZP)
- IBCLR = AND (IZW,NOT(LSHIFT(1,IZP)))
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/unix/lnxgs/ibset.F b/src/packlib/kernlib/kerngen/unix/lnxgs/ibset.F
deleted file mode 100644
index aae382f..0000000
--- a/src/packlib/kernlib/kerngen/unix/lnxgs/ibset.F
+++ /dev/null
@@ -1,13 +0,0 @@
-*
-* $Id: ibset.F,v 1.1.1.1 1996/02/15 17:50:07 mclareni Exp $
-*
-* $Log: ibset.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:07 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- FUNCTION IBSET(IZW,IZP)
- IBSET = OR (IZW,LSHIFT(1,IZP))
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/unix/lnxgs/ieor.F b/src/packlib/kernlib/kerngen/unix/lnxgs/ieor.F
deleted file mode 100644
index 1342c7f..0000000
--- a/src/packlib/kernlib/kerngen/unix/lnxgs/ieor.F
+++ /dev/null
@@ -1,15 +0,0 @@
-*
-* $Id: ieor.F,v 1.1.1.1 1996/02/15 17:50:07 mclareni Exp $
-*
-* $Log: ieor.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:07 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- FUNCTION IEOR(IZV,IZW)
-*
- IEOR = XOR(IZV,IZW)
-*
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/unix/lnxgs/ior.F b/src/packlib/kernlib/kerngen/unix/lnxgs/ior.F
deleted file mode 100644
index 4bf7cfb..0000000
--- a/src/packlib/kernlib/kerngen/unix/lnxgs/ior.F
+++ /dev/null
@@ -1,15 +0,0 @@
-*
-* $Id: ior.F,v 1.1.1.1 1996/02/15 17:50:07 mclareni Exp $
-*
-* $Log: ior.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:07 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- FUNCTION IOR(IZV,IZW)
-*
- IOR = OR(IZV,IZW)
-*
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/unix/lnxgs/irndm.F b/src/packlib/kernlib/kerngen/unix/lnxgs/irndm.F
deleted file mode 100644
index f0f59ab..0000000
--- a/src/packlib/kernlib/kerngen/unix/lnxgs/irndm.F
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: irndm.F,v 1.1.1.1 1996/02/15 17:50:07 mclareni Exp $
-*
-* $Log: irndm.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:07 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- FUNCTION IRNDM(ISEEK)
- COMMON /MCGN/ MCGN
-
-C-- Integer random number
- MCGN = MCGN * 69069
- IRNDM = ISHFT (MCGN,-1)
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/unix/lnxgs/ishft.c b/src/packlib/kernlib/kerngen/unix/lnxgs/ishft.c
deleted file mode 100644
index e803989..0000000
--- a/src/packlib/kernlib/kerngen/unix/lnxgs/ishft.c
+++ /dev/null
@@ -1,23 +0,0 @@
-/*
- * $Id: ishft.c,v 1.1.1.1 1996/02/15 17:50:07 mclareni Exp $
- *
- * $Log: ishft.c,v $
- * Revision 1.1.1.1 1996/02/15 17:50:07 mclareni
- * Kernlib
- *
- */
-#include "kerngen/pilot.h"
-/*> ROUTINE ISHFT
- CERN PROGLIB# ISHFT .VERSION KERNLNX 1.00 930507
-
- Provides the value of the argument ARG with the bits shifted.
- Bits shifted out to the left or right are lost, and zeros are shifted
- in from the opposite end. CNL 210
-*/
-unsigned int ishft_(arg,len)
-unsigned int *arg;
-int *len;
-{
- return((*len > 0)? *arg << *len: *arg >> (-*len));
-}
-/*> END <----------------------------------------------------------*/
diff --git a/src/packlib/kernlib/kerngen/unix/lnxgs/ishftr.c b/src/packlib/kernlib/kerngen/unix/lnxgs/ishftr.c
deleted file mode 100644
index f8bc0ce..0000000
--- a/src/packlib/kernlib/kerngen/unix/lnxgs/ishftr.c
+++ /dev/null
@@ -1,21 +0,0 @@
-/*
- * $Id: ishftr.c,v 1.1.1.1 1996/02/15 17:50:07 mclareni Exp $
- *
- * $Log: ishftr.c,v $
- * Revision 1.1.1.1 1996/02/15 17:50:07 mclareni
- * Kernlib
- *
- */
-#include "kerngen/pilot.h"
-/*> ROUTINE ISHFT
- CERN PROGLIB# ISHFTR .VERSION KERNLNX 1.02 940511
-
- Logical right shift by *len (+ve) places
-*/
-unsigned int ishftr_(arg,len)
-unsigned int *arg;
-int *len;
-{
- return(*arg >> *len);
-}
-/*> END <----------------------------------------------------------*/
diff --git a/src/packlib/kernlib/kerngen/unix/lnxgs/qnext.F b/src/packlib/kernlib/kerngen/unix/lnxgs/qnext.F
deleted file mode 100644
index a4c0440..0000000
--- a/src/packlib/kernlib/kerngen/unix/lnxgs/qnext.F
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: qnext.F,v 1.1.1.1 1996/02/15 17:50:08 mclareni Exp $
-*
-* $Log: qnext.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:08 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE QNEXT
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/unix/lnxgs/rdmin.F b/src/packlib/kernlib/kerngen/unix/lnxgs/rdmin.F
deleted file mode 100644
index bbc286d..0000000
--- a/src/packlib/kernlib/kerngen/unix/lnxgs/rdmin.F
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: rdmin.F,v 1.1.1.1 1996/02/15 17:50:07 mclareni Exp $
-*
-* $Log: rdmin.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:07 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE RDMIN(ISEED)
- COMMON /MCGN/ MCGN
-
-C-- Set the seed
- MCGN = ISEED
- RETURN
-
-C-- Get the seed
- ENTRY RDMOUT (ISEED)
- ISEED = MCGN
- END
diff --git a/src/packlib/kernlib/kerngen/unix/sungs/Imakefile b/src/packlib/kernlib/kerngen/unix/sungs/Imakefile
deleted file mode 100644
index 89792ac..0000000
--- a/src/packlib/kernlib/kerngen/unix/sungs/Imakefile
+++ /dev/null
@@ -1,4 +0,0 @@
-SRCS_F= \ @@\
- iandetc.F uflint.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kerngen/unix/sungs/iandetc.F b/src/packlib/kernlib/kerngen/unix/sungs/iandetc.F
deleted file mode 100644
index 91bd6db..0000000
--- a/src/packlib/kernlib/kerngen/unix/sungs/iandetc.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: iandetc.F,v 1.1.1.1 1996/02/15 17:50:08 mclareni Exp $
-*
-* $Log: iandetc.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:08 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- FUNCTION IAND (I,J)
-C
-C CERN PROGLIB# M441 IANDETC .VERSION KERNSUN 1.00 880922
-C ORIG. 22/09/88, JZ
-C
-C SUN versions of functions IAND, IOR, IEOR
-
- IAND = AND(I,J)
- END
- FUNCTION IOR (I,J)
-
- IOR = OR(I,J)
- END
- FUNCTION IEOR (I,J)
-
- IEOR = XOR(I,J)
- END
diff --git a/src/packlib/kernlib/kerngen/unix/sungs/uflint.F b/src/packlib/kernlib/kerngen/unix/sungs/uflint.F
deleted file mode 100644
index 519cc40..0000000
--- a/src/packlib/kernlib/kerngen/unix/sungs/uflint.F
+++ /dev/null
@@ -1,54 +0,0 @@
-*
-* $Id: uflint.F,v 1.1.1.1 1996/02/15 17:50:08 mclareni Exp $
-*
-* $Log: uflint.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:08 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE UFLINT (VECT,NWP,MODEP)
-C
-C CERN PROGLIB# M251 UFLINT .VERSION KERNSUN 1.00 880922
-C ORIG. 22/09/88, JZ
-C
-C- CONVERT VECT(1->NWP) IN SITU TO FLOATING OR INTEGERS ACCORDING
-C- TO MODEP
-C
- DIMENSION VECT(99), NWP(9), MODEP(9)
- EQUIVALENCE (A,IA), (B,IB)
- LOGICAL VARY
-C
-C
- NW = -NWP(1)
- MODE = MODEP(1)
- N = 0
- VARY = .TRUE.
- IF (NW.GE.0) GO TO 31
- NW = -NW
- VARY = .FALSE.
- JUSE = AND (MODE,1)
- GO TO 31
-C
- 30 VECT(N) = B
- 31 IF (N.EQ.NW) RETURN
- N = N + 1
- IF (.NOT.VARY) GO TO 34
- JUSE = AND (MODE,1)
- MODE = RSHIFT (MODE,1)
- 34 A = VECT(N)
- JCH = RSHIFT (IA,23)
- IF (JCH.EQ.0) GO TO 36
- IF (JCH.EQ.-1) GO TO 36
-C
-C-- CONVERT TO INTEGER
-C
- IF (JUSE.EQ.0) GO TO 31
- IB = A
- GO TO 30
-C
-C-- CONVERT TO FLOATING
- 36 IF (JUSE.NE.0) GO TO 31
- B = IA
- GO TO 30
- END
diff --git a/src/packlib/kernlib/kerngen/vmscode/Imakefile b/src/packlib/kernlib/kerngen/vmscode/Imakefile
deleted file mode 100644
index a04e536..0000000
--- a/src/packlib/kernlib/kerngen/vmscode/Imakefile
+++ /dev/null
@@ -1,27 +0,0 @@
-#define IHaveSubdirs
-#define PassCDebugFlags
-
-#if defined(CERNLIB_VAXVMS)
-LIBDIRS=vaxgs vaxsys
-#if !defined(CERNLIB_QMALPH)
-LIBDIRS:=$(LIBDIRS) vaxmlan
-#endif
-#else
-#undef IHaveSubdirs
-all::
-
-#endif
-
-#ifdef IHaveSubdirs
-
-SUBDIRS= $(LIBDIRS)
-
-MakeSubdirs($(SUBDIRS))
-
-SubdirLibraryTarget(kerngen,$(LIBDIRS))
-
-#endif
-/*ccgen ccgencf ccgenci ccgenu kerngen
- *other tcgen tcgenc tcgens unix vms xvect
- */
-
diff --git a/src/packlib/kernlib/kerngen/vmscode/vaxgs/Imakefile b/src/packlib/kernlib/kerngen/vmscode/vaxgs/Imakefile
deleted file mode 100644
index 7652925..0000000
--- a/src/packlib/kernlib/kerngen/vmscode/vaxgs/Imakefile
+++ /dev/null
@@ -1,7 +0,0 @@
-SRCS_F= ffrvax.F ftovax.F qnextd.F uflint.F uhollr.F
-
-#ifdef CERNLIB_QMALPH
-SRCS_F := $(SRCS_F) qnext.F
-#endif
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kerngen/vmscode/vaxgs/ffrvax.F b/src/packlib/kernlib/kerngen/vmscode/vaxgs/ffrvax.F
deleted file mode 100644
index 6f6cbc7..0000000
--- a/src/packlib/kernlib/kerngen/vmscode/vaxgs/ffrvax.F
+++ /dev/null
@@ -1,183 +0,0 @@
-*
-* $Id: ffrvax.F,v 1.1.1.1 1996/02/15 17:50:25 mclareni Exp $
-*
-* $Log: ffrvax.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:25 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE FFRVAX (CHFILE,NN)
-C
-C CERN PROGLIB# Z267 FFRVAX .VERSION KERNVAX 2.46 940913
-C ORIG. 20/08/90 JZ, modif. 4/5/94 JZ change of specs:
-C disk:[dir... gives now /disk/dir/.. and no longer /=disk/dir/..
-C- [dir... gives now /(dir/.. and not /dir/..
-C
-C- Convert file-name syntax VAX -> UNIX :
-C- VAX: node::disk:[dir.a.b.c]file.ext;cy
-C- gives: //node/disk/dir/a/b/c/file.ext;cy
-
-C- return NDSLAT = 1 converted
-C- 0 no conversion
-C- -1 unknown syntax
-
- CHARACTER CHFILE*(*)
- CHARACTER CHNAME*512, CHWK*512
- COMMON /CHSLAT/ CHNAME, CHWK
- CHARACTER COLNA(512)*1, COLWK(512)*1
- EQUIVALENCE (COLNA,CHNAME), (COLWK,CHWK)
- COMMON /SLATE/ NDSLAT, ISLATE(39)
-
- NU = NN
- IF (NU.LE.0) GO TO 91
- IF (NU.GE.500) GO TO 91
- CHNAME(1:NU) = CHFILE(1:NU)
-
- J = ICFIND ('/', CHNAME,1,NU)
- IF (J.LE.NU) GO TO 90
-
-C-- replace .][ or ][
-
- 16 J = INDEX (CHNAME(1:NU), '.][')
- IF (J.NE.0) THEN
- CHNAME(J+1:J+2)= ' '
- GO TO 16
- ENDIF
-
- 17 J = INDEX (CHNAME(1:NU), '][')
- IF (J.NE.0) THEN
- CHNAME(J:J+1)= '. '
- GO TO 17
- ENDIF
-
- CALL CLEFT (CHNAME,1,NU)
- NU = NDSLAT
-
-C-- find [ and ], they must both be absent or present
-
- JCOLN = ICFIND (':', CHNAME,1,NU)
- JOPEN = ICFIND ('[', CHNAME,1,NU)
- IF (JOPEN.LE.NU) THEN
- JCLOS = ICFIND (']', CHNAME,JOPEN,NU)
- ELSE
- JOPEN = ICFIND ('<', CHNAME,1,NU)
- JCLOS = ICFIND ('>', CHNAME,JOPEN,NU)
- ENDIF
-
- IF (JOPEN.GT.NU) THEN
- IF (JCLOS.LE.NU) GO TO 91
- ELSE
- IF (JCLOS.GT.NU) GO TO 91
- ENDIF
-
- NP = 0
- JT = 1
- IF (JCOLN.GE.JOPEN) GO TO 41
-
-C-- Handle node:: -> //node
-
- IF (COLNA(JCOLN+1).NE.':') GO TO 24
- NP = JCOLN + 1
- IF (NP.LE.2) GO TO 91
- CHWK(1:NP) = '//' // CHNAME(1:NP-2)
-
- JT = JCOLN + 2
- IF (JT.GT.NU) GO TO 28
- JCOLN = ICFIND (':', CHNAME,JT,NU)
- IF (JCOLN.GE.JOPEN) GO TO 91
-
-C-- Handle logical: -> /logical
-
- 24 NP = NP + 1
- COLWK(NP) = '/'
-
- N = JCOLN - JT
- IF (N.LE.0) GO TO 91
- CHWK(NP+1:NP+N) = CHNAME(JT:JT+N-1)
- NP = NP + N
- JT = JCOLN + 1
- IF (JT.GT.NU) GO TO 28
-
- IF (JOPEN.GT.NU) GO TO 28
- IF (JOPEN.NE.JT) GO TO 91
- JT = JT + 1
- NP = NP + 1
- COLWK(NP) = '/'
- GO TO 63
-
-C-- copy the trailing text without [ and ]
-
- 28 N = NU+1 - JT
- IF (N.GT.0) THEN
- NP = NP + 1
- COLWK(NP) = '/'
- CHWK(NP+1:NP+N) = CHNAME(JT:JT+N-1)
- ENDIF
- NU = NP + N
- CHNAME(1:NU) = CHWK(1:NU)
- GO TO 69
-
-C---- Neither node nor disk
-
- 41 IF (JOPEN.GT.NU) GO TO 90
- IF (JOPEN.NE.1) GO TO 91
- IF (COLNA(2).EQ.']') GO TO 91
- IF (COLNA(2).EQ.'-') GO TO 51
- IF (COLNA(2).EQ.'.') GO TO 61
-
-C-- Handle [a.b.c]f.e -> /(a/b/c/f.e
-
- CHWK(1:2) = '/('
- NP = 2
- JT = 2
- GO TO 63
-
-C-- Handle [---] or [--.a.b]f.e -> ../../a/b/f.e
-
- 51 CHWK(1:2) = '..'
- NP = 2
- JT = 3
-
- 54 IF (COLNA(JT).EQ.']') GO TO 63
- IF (COLNA(JT).EQ.'.') GO TO 63
- IF (COLNA(JT).NE.'-') GO TO 91
- CHWK(NP+1:NP+3) = '/..'
- NP = NP + 3
- JT = JT + 1
- IF (JT.GT.NU) GO TO 91
- GO TO 54
-
-C-- Handle [.a.b]f.e -> a/b/f.e
-
- 61 JT = 3
-
-C-- copy the trailing text
-
- 63 N = NU+1 - JT
- IF (N.GT.0) CHWK(NP+1:NP+N) = CHNAME(JT:JT+N-1)
- NU = NP + N
- CHNAME(1:NU) = CHWK(1:NU)
- JR = NP
-
-C-- translate . or ] to /
-
- 66 JR = JR + 1
- IF (COLNA(JR).EQ.'.') COLNA(JR) = '/'
- IF (COLNA(JR).NE.']') GO TO 66
- COLNA(JR) = '/'
-
- 69 IF (NU.GT.LEN(CHFILE)) GO TO 91
-C PRINT 9869, CHNAME(1:NU)
-C9869 FORMAT (' FR_VAX delivers >',A,'<')
- NN = NU
- CHFILE(1:NU) = CHNAME(1:NU)
- NDSLAT = 1
- RETURN
-
- 90 NDSLAT = 0
- RETURN
-
- 91 NDSLAT = -1
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/vmscode/vaxgs/ftovax.F b/src/packlib/kernlib/kerngen/vmscode/vaxgs/ftovax.F
deleted file mode 100644
index 30cc45c..0000000
--- a/src/packlib/kernlib/kerngen/vmscode/vaxgs/ftovax.F
+++ /dev/null
@@ -1,203 +0,0 @@
-*
-* $Id: ftovax.F,v 1.1.1.1 1996/02/15 17:50:25 mclareni Exp $
-*
-* $Log: ftovax.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:25 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE FTOVAX (CHFILE,NN)
-C
-C CERN PROGLIB# Z267 FTOVAX .VERSION KERNVAX 2.46 940913
-C ORIG. 20/08/90 JZ, modif. 4/5/94 JZ change of specs:
-C
-C- Convert file-name syntax UNIX -> VAX :
-C- UNIX: //node/=log/dir/a/b/c/file.ext;cy
-C- or //node/log/dir/a/b/c/file.ext;cy
-C- gives: node::log:[dir.a.b.c]file.ext;cy
-
-C- UNIX: /=log/dir/a/b/c/file.ext;cy
-C- or /log/dir/a/b/c/file.ext;cy
-C- gives: log:[dir.a.b.c]file.ext;cy
-
-C- UNIX: /(dir/a/b/c/file.ext;cy
-C- gives: [dir.a.b.c]file.ext;cy
-
-C- UNIX: a/b/c/file.ext;cy
-C- gives: [.a.b.c]file.ext;cy
-
-C- UNIX: ../a/b/c/file.ext;cy
-C- gives: [-.a.b.c]file.ext;cy
-
-C- UNIX: ~/a/b/c/f.e or ~/f.e
-C- gives log:[name.a.b.c]f.e log:[name]f.e
-
-C- return NDSLAT = 1 converted
-C- 0 no conversion
-C- -1 error
-
- CHARACTER CHFILE*(*)
- CHARACTER CHNAME*512, CHWK*512
- COMMON /CHSLAT/ CHNAME, CHWK
- CHARACTER COLNA(512)*1, COLWK(512)*1
- EQUIVALENCE (COLNA,CHNAME), (COLWK,CHWK)
- COMMON /SLATE/ NDSLAT, ISLATE(39)
-
- NU = NN
- IF (NU.LE.0) GO TO 91
- IF (NU.GE.500) GO TO 91
- CHNAME(1:NU) = CHFILE(1:NU)
- CALL CLEFT (CHNAME,1,NU)
- NU = NDSLAT
-
- JSLA = ICFIND ('/', CHNAME,1,NU)
-
- IF (COLNA(1).NE.'~') THEN
- IF (JSLA.GT.NU) GO TO 90
- ENDIF
-
- NP = 0
- JT = 1
- IF (COLNA(1).EQ.'~') GO TO 31
- IF (COLNA(1).EQ.'.') GO TO 51
- IF (COLNA(1).NE.'/') GO TO 61
- IF (COLNA(2).EQ.'/') GO TO 24
- IF (COLNA(2).EQ.'(') GO TO 41
- GO TO 26
-
-C---- Handle //node
-
- 24 JSLA = ICFIND ('/', CHNAME,3,NU)
- N = JSLA - 1
- IF (N.LE.2) GO TO 91
-
- CHWK(1:N) = CHNAME(3:N) // '::'
- NP = N
- JT = JSLA
- IF (JT.GE.NU) GO TO 29
-
-C---- Handle /=logical or /logical
-
- 26 JT = JT + 1
- IF (COLNA(JT).EQ.'=') JT= JT + 1
- JSLA = ICFIND ('/', CHNAME,JT,NU)
- N = JSLA - JT
- IF (N.LE.0) GO TO 91
-
- CHWK(NP+1:NP+N) = CHNAME(JT:JT+N-1)
- NP = NP + N + 1
- COLWK(NP) = ':'
-
- JT = JSLA
- IF (JT.GE.NU) GO TO 29
-
- JSLN = ICFIND ('/', CHNAME,JT+1,NU)
- IF (JSLN.GT.NU) JT= JT + 1
-
- N = NU+1 - JT
- IF (N.GT.0) THEN
- CHWK(NP+1:NP+N) = CHNAME(JT:JT+N-1)
- NP = NP + N
- ENDIF
-
- 29 CHNAME(1:NP) = CHWK(1:NP)
- NU = NP
- JSLA = ICFIND ('/', CHNAME,1,NU)
- IF (JSLA.GT.NU) GO TO 69
- GO TO 67
-
-C---- Handle ~/something
-
- 31 IF (COLNA(2).EQ.'/') THEN
- JT = 2
- ELSE
- COLNA(1) = '/'
- JT = 1
- ENDIF
-
- CALL GETENVF ('HOME',CHWK(1:64))
- NP = NDSLAT
-
- JSLA = ICFIND ('[', CHWK,1,NP)
- IF (JSLA.GE.NP) GO TO 91
- NP = LNBLNK (CHWK(1:NP))
- IF (COLWK(NP-1).EQ.'.') NP= NP - 1
- N = NU+1 - JT
- CHWK(NP:NP+N) = CHNAME(JT:JT+N-1)
- NU = NP + N
- CHNAME(1:NU) = CHWK(1:NU)
- GO TO 67
-
-C---- Handle /(dir/a/b/f.e
-
- 41 JSLA = JT
- COLNA(JT+1) = ' '
- GO TO 67
-
-C---- Handle .something
-
- 51 COLWK(1) = '/'
- CALL CFILL ('-', CHWK,2,NU)
-
- NP = 1
- JT = 1
- 53 JSLN = ICFIND ('/', CHNAME,JT,NU)
- N = JSLN - JT - 1
- IF (N.EQ.0) GO TO 56
-
- DO 54 J=JT+1,JT+N
- IF (COLNA(J).NE.'.') GO TO 91
- 54 CONTINUE
-
- NP = NP + N
- 56 JT = JT + N + 2
- IF (JT.LT.NU) THEN
- IF (COLNA(JT).EQ.'.') GO TO 53
- ENDIF
-
- JT = JT - 1
- N = NU+1 - JT
- IF (N.GT.0) THEN
- CHWK(NP+1:NP+N) = CHNAME(JT:JT+N-1)
- NP = NP + N
- ENDIF
- IF (NP.LT.3) GO TO 91
-
- CHNAME(1:NP) = CHWK(1:NP)
- NU = NP
- JSLA = 1
- GO TO 67
-
-C---- Handle a/b/c/f.e
-
- 61 CHWK(1:NU+2) = '[.' // CHNAME(1:NU)
- NU = NU + 2
- CHNAME(1:NU) = CHWK(1:NU)
- JSLA = 1
-
-C-- translate / to .
-
- 67 JSLE = ICFILA ('/', CHNAME,JSLA+1,NU)
- IF (JSLE.GT.NU) GO TO 91
- CALL CTRANS ('/', '.', CHNAME,JSLA+1,JSLE-1)
- COLNA(JSLA) = '['
- COLNA(JSLE) = ']'
- IF (CHNAME(1:2).EQ.'[]') CHNAME(1:2)= ' '
- 69 CALL CLEFT (CHNAME,1,NU)
- NU = NDSLAT
- IF (NU.EQ.0) GO TO 91
- IF (NU.GT.LEN(CHFILE)) GO TO 91
-C PRINT 9869, CHNAME(1:NU)
-C9869 FORMAT (' TO_VAX delivers >',A,'<')
- NN = NU
- CHFILE(1:NU) = CHNAME(1:NU)
- NDSLAT = 1
- RETURN
-
- 90 NDSLAT = 0
- RETURN
-
- 91 NDSLAT = -1
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/vmscode/vaxgs/qnext.F b/src/packlib/kernlib/kerngen/vmscode/vaxgs/qnext.F
deleted file mode 100644
index 79f6982..0000000
--- a/src/packlib/kernlib/kerngen/vmscode/vaxgs/qnext.F
+++ /dev/null
@@ -1,3 +0,0 @@
-#include "kerngen/pilot.h"
- SUBROUTINE QNEXT
- END
diff --git a/src/packlib/kernlib/kerngen/vmscode/vaxgs/qnextd.F b/src/packlib/kernlib/kerngen/vmscode/vaxgs/qnextd.F
deleted file mode 100644
index e4b4c8b..0000000
--- a/src/packlib/kernlib/kerngen/vmscode/vaxgs/qnextd.F
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: qnextd.F,v 1.1.1.1 1996/02/15 17:50:25 mclareni Exp $
-*
-* $Log: qnextd.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:25 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE QNEXTD
-C
-C CERN PROGLIB# Z041 QNEXT .VERSION KERNVAX 2.25 880302
-C ORIG. 2/03/88 JZ
-
- PRINT *, ' ***** crash for missing external QNEXT *****'
- END
diff --git a/src/packlib/kernlib/kerngen/vmscode/vaxgs/uflint.F b/src/packlib/kernlib/kerngen/vmscode/vaxgs/uflint.F
deleted file mode 100644
index 685a581..0000000
--- a/src/packlib/kernlib/kerngen/vmscode/vaxgs/uflint.F
+++ /dev/null
@@ -1,56 +0,0 @@
-*
-* $Id: uflint.F,v 1.1.1.1 1996/02/15 17:50:25 mclareni Exp $
-*
-* $Log: uflint.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:25 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE UFLINT (VECT,NWP,MODEP)
-C
-C CERN PROGLIB# M251 UFLINT .VERSION KERNVAX 2.09 840215
-C ORIG. 22/07/82 JZ
-C
-C- CONVERT VECT(1->NWP) IN SITU TO FLOATING OR INTEGERS ACCORDING
-C- TO MODEP
-C
- DIMENSION VECT(99), NWP(9), MODEP(9)
- EQUIVALENCE (A,IA), (B,IB)
- LOGICAL VARY
-
-#include "kerngen/q_jbit.inc"
-
- NW = NWP(1)
- MODE= MODEP(1)
- N = 1 - NW
- VARY= .TRUE.
- IF (NW.LT.0) GO TO 31
- N = NW + 1
- VARY= .FALSE.
- JUSE= JBIT (MODE,1)
- GO TO 31
-
- 30 VECT(N) = B
- 31 N = N - 1
- IF (N.EQ.0) RETURN
- IF (VARY) JUSE=JBIT(MODE,N)
- A = VECT(N)
- IF (JUSE.NE.0) GO TO 36
-
-C-- FLOATING WANTED
-
- JCH = JBYT (IA,8,8)
- IF (JCH.EQ.0) GO TO 34
- IF (JCH.NE.255) GO TO 31
- 34 B = IA
- GO TO 30
-
-C-- INTEGER WANTED
-
- 36 JCH = JBYT (IA,25,8)
- IF (JCH.EQ.0) GO TO 31
- IF (JCH.EQ.255) GO TO 31
- IB = A
- GO TO 30
- END
diff --git a/src/packlib/kernlib/kerngen/vmscode/vaxgs/uhollr.F b/src/packlib/kernlib/kerngen/vmscode/vaxgs/uhollr.F
deleted file mode 100644
index 5b0c0d0..0000000
--- a/src/packlib/kernlib/kerngen/vmscode/vaxgs/uhollr.F
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: uhollr.F,v 1.1.1.1 1996/02/15 17:50:25 mclareni Exp $
-*
-* $Log: uhollr.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:25 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE UHOLLR (VECT,NC,WORD)
-C
-C CERN PROGLIB# M415 UHOLLR .VERSION KERNVAX 2.04 830531
-C ORIG. 01/01/65 JZ, MODIFIED FOR VAX 31/05/83 BY BODINI+CECCHET
-C
-C- LOAD THE NC-LONG HOLLERITH STRING IN WORD INTO THE VECTOR VECT
-C- PAD VECT WITH BLANKS TO ITS FULL WORD BOUNDARY
-C
- BYTE VECT(9), WORD(9)
-C
- NW = (NC-1)/4 + 1
- NT = 4*NW
-C
- CALL UCOPY (WORD,VECT,NW)
-C
- IF (NC.EQ.NT) RETURN
-C
- DO 17 K=NC+1,NT
- 17 VECT(K)= ' '
-C
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/Imakefile b/src/packlib/kernlib/kerngen/vmscode/vaxmlan/Imakefile
deleted file mode 100644
index 55c6637..0000000
--- a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/Imakefile
+++ /dev/null
@@ -1,14 +0,0 @@
-SRCS_S= \ @@\
- cbyt.s ie3fos.s ie3tos.s iucomh.s iucomp.s iufind.s iuhunt.s \ @@\
- iusame.s jbit.s jbyt.s jbytet.s jbytor.s jbytpk.s jobnam.s jrsbyt.s \ @@\
- locb.s locf.s lvmax.s lvmaxa.s lvmin.s lvmina.s mbytet.s mbytor.s \ @@\
- mcbyt.s msbit.s msbyt.s noarg.s pkbyt.s pkchar.s qnexte.s rndm.s \ @@\
- sbit.s sbyt.s sbytor.s sbytpk.s swbl16.s swbu16.s ublank.s ublow.s \ @@\
- ubunch.s ucopiv.s ucopy2.s ucopyn.s uctoh.s uctoh1.s ufill.s \ @@\
- uh1toc.s uhtoc.s upkbyt.s upkch.s uswop.s uzero.s vadd.s vasum.s \ @@\
- vbias.s vblank.s vcopyn.s vdot.s vdotn.s vdotn2.s vexcum.s vfill.s \ @@\
- vfix.s vfloat.s vline.s vmatl.s vmatr.s vmax.s vmaxa.s vmin.s \ @@\
- vmina.s vmod.s vmul.s vscale.s vsub.s vsum.s vunit.s vxinvb.s \ @@\
- vxinvc.s vzero.s
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/cbyt.s b/src/packlib/kernlib/kerngen/vmscode/vaxmlan/cbyt.s
deleted file mode 100644
index b653cab..0000000
--- a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/cbyt.s
+++ /dev/null
@@ -1,29 +0,0 @@
-;
-; $Id: cbyt.s,v 1.1.1.1 1996/02/15 17:50:27 mclareni Exp $
-;
-; $Log: cbyt.s,v $
-; Revision 1.1.1.1 1996/02/15 17:50:27 mclareni
-; Kernlib
-;
-;
- .TITLE CBYT
-;++
-; CERN PROGLIB# M421 CBYT .VERSION KERNVAX 2.05 830901
-; ORIG. J. VORBRUEGGEN 16/5/83
-;
-; SUBROUTINE CBYT(A, LA, X, LX, NBITS)
-; Copy the byte of size NBITS in A at position LA
-; to the byte in X at postion LX; the LSB is LA = LX = 1
-;--
- .IDENT /01/
- .PSECT $CODE,PIC,CON,REL,LCL,SHR,EXE,RD,NOWRT,LONG
- .ENTRY CBYT,^M<>
-
- SUBL3 #1, at 8(AP),R1 ; get correct byte position
- BLSS 99$ ; return if not valid
- EXTZV R1, at 20(AP), at 4(AP),R0 ; extract the byte
- SUBL3 #1, at 16(AP),R1 ; get new position
- BLSS 99$ ; return if not valid
- INSV R0,R1, at 20(AP), at 12(AP) ; copy the byte
-99$: RET
- .END
diff --git a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/ie3fos.s b/src/packlib/kernlib/kerngen/vmscode/vaxmlan/ie3fos.s
deleted file mode 100644
index 093fe7e..0000000
--- a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/ie3fos.s
+++ /dev/null
@@ -1,73 +0,0 @@
-;
-; $Id: ie3fos.s,v 1.1.1.1 1996/02/15 17:50:27 mclareni Exp $
-;
-; $Log: ie3fos.s,v $
-; Revision 1.1.1.1 1996/02/15 17:50:27 mclareni
-; Kernlib
-;
-;
- .TITLE IE3FOS
-;++
-; CERN PROGLIB# M220 IE3FOS .VERSION KERNVAX 2.34 900301
-; ORIG. February 89, M. Jonker/CERN
-; CORR. D. Coffman 12/02/1990
-;
-; SUBROUTINE IE3FOS (MS,MT,NWDO,JBAD)
-; Convert single precision for output with copy
-; from source in native to target in IEEE data format
-;--
- .IDENT /900212MJJ/ ;M.Jonker CERN/EP
- .PSECT $CODE,PIC,CON,REL,LCL,SHR,EXE,RD,NOWRT,LONG
-
- .ENTRY IE3FOS,^M<R2,R3,R4>
- MOVQ 4(AP),R0 ;R0/R1 = source/destination
- MOVL @12(AP),R2 ;AP = count
- MOVL #0, at 16(AP) ;JBAD=0 initially
-
- BRB 29$
-
- .ALIGN LONG
-
-20$: ROTL #16,(R0)+,R3
-; extract and test the characteristics
- BICL3 #^X807FFFFF,R3,R4
- CMPL R4,#^X01000000
- BLEQ 21$
- CMPL R4,#^X7F800000
- BEQL 31$
- SUBL3 #^X01000000,R3,(R1)+
- SOBGEQ R2,20$ ;loop
- RET
-
-21$: ; Handle exceptions
- BICL3 #^X007FFFFF,R3,R4
- BNEQ 22$
-; - Floating zero:
- CLRL (R1)+
-29$: SOBGEQ R2,20$ ;loop
- RET
-
-22$: CMPL #^X80000000,R4
- BNEQ 23$
-; Reserved: translate into not-a-number
- MOVL #^X7F80FE00,(R1)+
- SUBL3 R2, at 12(AP), at 16(AP)
- BRB 29$
-
-; The characteristics is 1 or 2, we can translate this into a
-; de-normalized number only.
-; - The word is first shift to the left to make room to store
-; the bit that cannot be implied anymore.
-23$: ASHL #-1,R3,R4 ;First shift to the left
-; - Set this bit on and test if the charteristics is 2
- BBCS #22,R4,24$
-; - The characteristics is 1, we need an extra shift
- ASHL #-1,R4,R4
-24$: BICL3 #^X7F800000,R4,(R1)+
- BRB 29$
-
-; exponent 7F8 : signed overflow
-31$: BICL3 #^X007FFFFF,R3,(R1)+
- SUBL3 R2, at 12(AP), at 16(AP)
- BRB 29$
- .END
diff --git a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/ie3tos.s b/src/packlib/kernlib/kerngen/vmscode/vaxmlan/ie3tos.s
deleted file mode 100644
index 91ec93a..0000000
--- a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/ie3tos.s
+++ /dev/null
@@ -1,89 +0,0 @@
-;
-; $Id: ie3tos.s,v 1.1.1.1 1996/02/15 17:50:27 mclareni Exp $
-;
-; $Log: ie3tos.s,v $
-; Revision 1.1.1.1 1996/02/15 17:50:27 mclareni
-; Kernlib
-;
-;
- .TITLE IE3TOS
-;++
-; CERN PROGLIB# M220 IE3TOS .VERSION KERNVAX 2.34 900301
-; ORIG. February 89, M. Jonker/CERN
-; CORR. D. Coffman 12/02/1990
-;
-; SUBROUTINE IE3TOS (MS,MT,NWDO,JBAD)
-; Convert single precision for input with copy
-; from source in IEEE to target in native data format
-;--
- .IDENT /900212MJJ/
- .PSECT $CODE,PIC,CON,REL,LCL,SHR,EXE,RD,NOWRT,LONG
-
- .ENTRY IE3TOS,^M<R2,R3,R4>
- MOVQ 4(AP),R0 ;R0/R1 = source/destination
- MOVL @12(AP),R2 ;AP = count
- MOVL #0, at 16(AP) ;JBAD=0 initially
-
- BRB 29$
-
- .ALIGN LONG
-
-20$: ROTL #16,(R0)+,R3
-; extract and test the characteristics
- BICW3 #^X807F,R3,R4
- BEQL 31$
- CMPW R4,#^X7E80
- BGEQ 41$
- ADDL3 #^X00000100,R3,(R1)+
-29$: SOBGEQ R2,20$ ;loop
- RET
-
- ; Handle exceptions
-
-; - Zero characteristics, test for floating zero
-31$: BITL #^XFFFF7FFF,R3
- BNEQ 51$ ;De-normalized number
- CLRL (R1)+ ;Floating zero
-39$: SOBGEQ R2,20$ ;Loop
- RET
-
-; - Characteristics .gt. 253, not a number or overflow
-41$: CMPW #^X7F80,R4
- BNEQ 42$
- BITL #^XFFFF007F,R3
- BEQL 42$
-; Not a number
- MOVL #^X00008001,(R1)+
- SUBL3 R2, at 12(AP), at 16(AP)
- BRB 39$
-
-; Signed overflow
-42$: BICL2 #^XFFFF7FFF,R3
- BISL3 #^X00007F81,R3,(R1)+
- SUBL3 R2, at 12(AP), at 16(AP)
- BRB 39$
-
-; - Denormalized number
-51$: BBCC #6,R3,53$
-; Exponent = 2
- ROTL #1,R3,R3
- BBCC #16,R3,52$ ;Test sign bit
- BBSS #15,R3,52$ ;Restore sign bit
-52$: BISL3 #^X00000100,R3,(R1)+
- BRB 39$
-53$: BBC #5,R3,55$
-; Exponent = 1
- BBCC #15,R3,54$ ;Test sign bit
- BBSS #13,R3,54$ ;Restore sign bit
-54$: ROTL #2,R3,(R1)+
- BRB 39$
-; Underflow
-55$: CLRL (R1)+
- BRB 39$
-
-;! exceptions:
-;! c=0, m=0 floating zero
-;! c=0, m#0 de-normalized number +/- 0.m 2**(-126 or -1022)
-;! c=1...1 m=0 signed infinity
-;! c=1...1 m#0 not a number
- .END
diff --git a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/iucomh.s b/src/packlib/kernlib/kerngen/vmscode/vaxmlan/iucomh.s
deleted file mode 100644
index 05063ae..0000000
--- a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/iucomh.s
+++ /dev/null
@@ -1,40 +0,0 @@
-;
-; $Id: iucomh.s,v 1.1.1.1 1996/02/15 17:50:27 mclareni Exp $
-;
-; $Log: iucomh.s,v $
-; Revision 1.1.1.1 1996/02/15 17:50:27 mclareni
-; Kernlib
-;
-;
- .TITLE IUCOMH
-;++
-; CERN PROGLIB# IUCOMH .VERSION KERNVAX 1.07 801117
-; ORIG. J. BETTELS 17/11/80
-; MOD. J. VORBRUEGGEN 18/5/83
-;
-; INTEGER FUNCTION IUCOMH(STRING1, STRING2, NCH)
-; Compare the two strings of NCH bytes length and return a value of
-;
-; -1 if STRING1 < STRING2
-; 0 =
-; +1 >
-;
-; which is determined by the first non-identical character.
-; N. B.: The strings are NOT of type CHARACTER !
-;--
- .IDENT /01/
- .PSECT $CODE,PIC,CON,REL,LCL,SHR,EXE,RD,NOWRT,LONG
- .ENTRY IUCOMH,^M<R2,R3>
-
- CMPC3 @12(AP), at 4(AP), at 8(AP) ;do the compare
- BEQL 10$ ;equal ?
- BLSS 20$ ;STRING1<STRING2 ?
- MOVL #1,R0 ;STRING1>STRING2
- RET
-
-10$: CLRL R0
- RET
-
-20$: MOVL #-1,R0
- RET
- .END
diff --git a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/iucomp.s b/src/packlib/kernlib/kerngen/vmscode/vaxmlan/iucomp.s
deleted file mode 100644
index c7fb5df..0000000
--- a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/iucomp.s
+++ /dev/null
@@ -1,44 +0,0 @@
-;
-; $Id: iucomp.s,v 1.1.1.1 1996/02/15 17:50:27 mclareni Exp $
-;
-; $Log: iucomp.s,v $
-; Revision 1.1.1.1 1996/02/15 17:50:27 mclareni
-; Kernlib
-;
-;
- .TITLE IUCOMP
-;++
-; CERN PROGLIB# V304 IUCOMP .VERSION KERNVAX 2.05 830901
-; ORIG. J. VORBRUEGGEN 12/6/83
-;
-; INTEGER FUNCTION IUCOMP(IT, IVEC, N)
-; Return index of first word in array IVEC of length N
-; which is equal to IT; if none found or N = 0,
-; a value of 0 is returned.
-;
-; Register usage:
-; R0 = IT
-; R1 address of IVEC(I)
-; R2 counter from N to 1
-;--
- .IDENT /01/
- .PSECT $CODE,PIC,CON,REL,LCL,SHR,EXE,RD,NOWRT,LONG
- .ENTRY IUCOMP,^M<R2>
-
- MOVL @12(AP),R2 ; get N
- BLEQ 20$ ; return if <= 0
- MOVL @4(AP),R0 ; get IT
- MOVAL @8(AP),R1 ; get base address of IVEC
-
-10$: CMPL R0,(R1)+ ; compare one longword
- BEQL 30$ ; is it equal to IT ?
- SOBGTR R2,10$ ; no, try again
- ; fall through if no match found
-20$: CLRL R0 ; return a value of zero
- RET
-
-30$: SUBL3 R2, at 12(AP),R0 ; compute index
- INCL R0 ; first element is IUCOMP = 1
- RET
-
- .END
diff --git a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/iufind.s b/src/packlib/kernlib/kerngen/vmscode/vaxmlan/iufind.s
deleted file mode 100644
index 1ceb9e8..0000000
--- a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/iufind.s
+++ /dev/null
@@ -1,45 +0,0 @@
-;
-; $Id: iufind.s,v 1.1.1.1 1996/02/15 17:50:27 mclareni Exp $
-;
-; $Log: iufind.s,v $
-; Revision 1.1.1.1 1996/02/15 17:50:27 mclareni
-; Kernlib
-;
-;
- .TITLE IUFIND
-;++
-; CERN PROGLIB# V304 IUFIND .VERSION KERNVAX 2.05 830901
-; ORIG. J. VORBRUEGGEN 13/6/83
-;
-; INTEGER FUNCTION IUFIND(IT, IVEC, JL, JR)
-; Return index of first word in array IVEC in the
-; range JL to JR which is equal to IT; if none found
-; a value of 0 is returned.
-;
-; Register usage:
-; R0 = IT
-; R1 address of IVEC(I), I = JR, JL
-; R2 counter from JR-JL to 0
-;--
- .IDENT /01/
- .PSECT $CODE,PIC,CON,REL,LCL,SHR,EXE,RD,NOWRT,LONG
- .ENTRY IUFIND,^M<R2>
-
- MOVL @4(AP),R0 ; get IT
- MOVAL @8(AP),R1 ; get base address of IVEC
- MOVL @12(AP),R2 ; get JL
- MOVAL -4(R1)[R2],R1 ; compute address of IVEC(JL)
- SUBL3 R2, at 16(AP),R2 ; compute counter
-
-10$: CMPL R0,(R1)+ ; compare one longword
- BEQL 20$ ; are they equal ?
- SOBGEQ R2,10$ ; no, try again
- ; fall through if no match found
- MOVL @16(AP),R0 ; return a value of JL+1
- INCL R0
- RET
-
-20$: SUBL3 R2, at 16(AP),R0 ; compute correct index
- RET
-
- .END
diff --git a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/iuhunt.s b/src/packlib/kernlib/kerngen/vmscode/vaxmlan/iuhunt.s
deleted file mode 100644
index 3e795a4..0000000
--- a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/iuhunt.s
+++ /dev/null
@@ -1,51 +0,0 @@
-;
-; $Id: iuhunt.s,v 1.1.1.1 1996/02/15 17:50:27 mclareni Exp $
-;
-; $Log: iuhunt.s,v $
-; Revision 1.1.1.1 1996/02/15 17:50:27 mclareni
-; Kernlib
-;
-;
- .TITLE IUHUNT
-;++
-; CERN PROGLIB# V304 IUHUNT .VERSION KERNVAX 2.14 850612
-; ORIG. J. VORBRUEGGEN 13/6/83
-; CORRECTION FROM M.DERMOTT, RAL 12/6/85
-;
-; FUNCTION IUHUNT(IT, IVEC, N, INC)
-; Examine the contents of IVEC at index 1, 1+INC, 1+2*INC,
-; etc., up to N, for equality with IT. If a match is found,
-; return the index; otherwise, return a value of 0.
-;
-; Register usage:
-; R0 loop index
-; R1 = IT
-; R2 base address of IVEC
-; R3 = N
-; R4 = INC
-;--
- .IDENT /01/
- .PSECT $CODE,PIC,CON,REL,LCL,SHR,EXE,RD,NOWRT,LONG
- .ENTRY IUHUNT,^M<R2,R3,R4>
-
- MOVL @12(AP),R3 ; get N
- BLEQ 20$ ; return if <= 0
- MOVL #1,R0 ; preset index
- MOVL @16(AP),R4 ; get INC
- BEQL 40$ ; if INC = 0, check IVEC(1) only
- MOVL @4(AP),R1 ; get IT
- MOVAL @8(AP),R2 ; get base address of IVEC
- SUBL2 #4,R2 ; correct for index starting with 1
-
-10$: CMPL (R2)[R0],R1 ; compare a longword
- BEQL 30$ ; if equal, R0 already contains index
- ACBL R3,R4,R0,10$ ; no, try again
- ; fall through if no match found
-20$: CLRL R0 ; return a value of zero
-30$: RET
-
-40$: CMPL @4(AP), at 8(AP) ; check IVEC(1)
- BNEQ 20$ ; if equal, R0 already equals 1
- RET
-
- .END
diff --git a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/iusame.s b/src/packlib/kernlib/kerngen/vmscode/vaxmlan/iusame.s
deleted file mode 100644
index 7f97e66..0000000
--- a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/iusame.s
+++ /dev/null
@@ -1,61 +0,0 @@
-;
-; $Id: iusame.s,v 1.1.1.1 1996/02/15 17:50:27 mclareni Exp $
-;
-; $Log: iusame.s,v $
-; Revision 1.1.1.1 1996/02/15 17:50:27 mclareni
-; Kernlib
-;
-;
- .TITLE IUSAME
-;++
-; CERN PROGLIB# M501 IUSAME .VERSION KERNVAX 2.05 830901
-; ORIG. J. VORBRUEGGEN 18/5/83
-;
-; INTEGER FUNCTION IUSAME(VECT, JL, JR, MIN, JSAME)
-; The function searches for at least MIN consecutive
-; occurences of the same longword in VECT(JL) to VECT(JR).
-; If such a sequence is found, JSAME contains the index of the
-; first longword of the sequence and the function value is the
-; number of occurences. Otherwise, IUSAME=0 and JSAME=JR+1.
-;
-; Register usage:
-; R0 address of VECT(I), I = JL, JR
-; R1 = MIN
-; R2 counter of occurences
-; R3 index (R5) when current item first occured
-; R4 = JR
-; R5 counter from JL to JR
-;--
- .IDENT /01/
- .PSECT $CODE,PIC,CON,REL,LCL,SHR,EXE,RD,NOWRT,LONG
- .ENTRY IUSAME,^M<R2,R3,R4,R5>
-
- MOVAL @4(AP),R0 ; get base address of VECT
- MOVL @8(AP),R5 ; get JL
- MOVAL -4(R0)[R5],R0 ; compute address of VECT(JL)
- MOVL @12(AP),R4 ; get JR
- MOVL R5,R3 ; preset index to JL
- CLRL R2 ; preset occurence counter
- MOVL @16(AP),R1 ; get MIN
- BRB 20$ ; start main loop
-
-10$: CMPL (R0)+,(R0) ; compare VECT(I) and VECT(I+1)
- BEQL 20$ ; if equal, go on looking
- CMPL R1,R2 ; not equal - have we reached MIN ?
- BLEQU 30$
- CLRL R2 ; no - reset occurence counter
- MOVL R5,R3 ; and index
-20$: INCL R2 ; increment occurence counter
- AOBLEQ R4,R5,10$ ; and loop
-
- CMPL R1,R2 ; finished with examining VECT
- BGTRU 40$ ; have we reached MIN equalities ?
-30$: MOVL R2,R0 ; yes, return index as function value
- MOVL R3, at 20(AP) ; and first occurence index in JSAME
- RET
- ; we didn't get MIN equal longwords
-40$: CLRL R0 ; so return a zero as function value
- MOVL R5, at 20(AP) ; and JR+1 in JSAME
- RET
-
- .END
diff --git a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/jbit.s b/src/packlib/kernlib/kerngen/vmscode/vaxmlan/jbit.s
deleted file mode 100644
index 1a078c5..0000000
--- a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/jbit.s
+++ /dev/null
@@ -1,26 +0,0 @@
-;
-; $Id: jbit.s,v 1.1.1.1 1996/02/15 17:50:27 mclareni Exp $
-;
-; $Log: jbit.s,v $
-; Revision 1.1.1.1 1996/02/15 17:50:27 mclareni
-; Kernlib
-;
-;
- .TITLE JBIT
-;++
-; CERN PROGLIB# M421 JBIT .VERSION KERNVAX 2.05 830901
-; ORIG. A.G.MICHETTE & M.WATERS, RUTHERFORD, APRIL 79
-; MOD. J. VORBRUEGGEN 16/5/83
-;
-; INTEGER FUNCTION JBIT(A, LA)
-; Return the bit LA of A, the LSB is LA = 1
-;--
- .IDENT /01/
- .PSECT $CODE,PIC,CON,REL,LCL,SHR,EXE,RD,NOWRT,LONG
- .ENTRY JBIT,^M<>
-
- SUBL3 #1, at 8(AP),R1 ; get correct bit position
- BLSS 99$ ; return if not valid
- EXTZV R1,#1, at 4(AP),R0 ; get the byte
-99$: RET
- .END
diff --git a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/jbyt.s b/src/packlib/kernlib/kerngen/vmscode/vaxmlan/jbyt.s
deleted file mode 100644
index 912be9f..0000000
--- a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/jbyt.s
+++ /dev/null
@@ -1,26 +0,0 @@
-;
-; $Id: jbyt.s,v 1.1.1.1 1996/02/15 17:50:27 mclareni Exp $
-;
-; $Log: jbyt.s,v $
-; Revision 1.1.1.1 1996/02/15 17:50:27 mclareni
-; Kernlib
-;
-;
- .TITLE JBYT
-;++
-; CERN PROGLIB# M421 JBYT .VERSION KERNVAX 2.05 830901
-; ORIG. A.G.MICHETTE & M.WATERS, RUTHERFORD, APRIL 79
-; MOD. J. VORBRUEGGEN 16/5/83
-;
-; INTEGER FUNCTION JBYT(A, LA, NBITS)
-; Return the byte of size NBITS in A at position LA; the LSB is LA = 1
-;--
- .IDENT /01/
- .PSECT $CODE,PIC,CON,REL,LCL,SHR,EXE,RD,NOWRT,LONG
- .ENTRY JBYT,^M<>
-
- SUBL3 #1, at 8(AP),R1 ; get correct byte position
- BLSS 99$ ; return if not valid
- EXTZV R1, at 12(AP), at 4(AP),R0 ; extract the byte
-99$: RET
- .END
diff --git a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/jbytet.s b/src/packlib/kernlib/kerngen/vmscode/vaxmlan/jbytet.s
deleted file mode 100644
index dcbbc85..0000000
--- a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/jbytet.s
+++ /dev/null
@@ -1,30 +0,0 @@
-;
-; $Id: jbytet.s,v 1.1.1.1 1996/02/15 17:50:27 mclareni Exp $
-;
-; $Log: jbytet.s,v $
-; Revision 1.1.1.1 1996/02/15 17:50:27 mclareni
-; Kernlib
-;
-;
- .TITLE JBYTET
-;++
-; CERN PROGLIB# M421 JBYTET .VERSION KERNVAX 2.05 830901
-; ORIG. J. VORBRUEGGEN 16/5/83
-;
-; INTEGER FUNCTION JBYTET(A, B, LB, NBITS)
-; Return the logical AND of the byte of size NBITS at A
-; and the byte in B at position LB; the LSB is LB = 1
-;--
- .IDENT /01/
- .PSECT $CODE,PIC,CON,REL,LCL,SHR,EXE,RD,NOWRT,LONG
- .ENTRY JBYTET,^M<>
-
- SUBL3 #1, at 12(AP),R1 ; get correct byte position
- BLSS 99$ ; return if not valid
- EXTZV R1, at 16(AP), at 8(AP),R0 ; extract byte in B
- EXTZV #0, at 16(AP), at 4(AP),R1 ; and the one in A
- MCOML R1,R1 ; this is necessary ...
- BICL2 R1,R0 ; to make BIC work as an AND
-99$: RET
-
- .END
diff --git a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/jbytor.s b/src/packlib/kernlib/kerngen/vmscode/vaxmlan/jbytor.s
deleted file mode 100644
index c673a78..0000000
--- a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/jbytor.s
+++ /dev/null
@@ -1,29 +0,0 @@
-;
-; $Id: jbytor.s,v 1.1.1.1 1996/02/15 17:50:27 mclareni Exp $
-;
-; $Log: jbytor.s,v $
-; Revision 1.1.1.1 1996/02/15 17:50:27 mclareni
-; Kernlib
-;
-;
- .TITLE JBYTOR
-;++
-; CERN PROGLIB# M421 JBYTOR .VERSION KERNVAX 2.22 870524
-; ORIG. JZ 20/5/87, DERIVED FROM CODE BY J. VORBRUEGGEN
-;
-; INTEGER FUNCTION JBYTOR(A, B, LB, NBITS)
-; Return the logical OR of A and the byte of size NBITS
-; in B at position LB; the LSB is LB = 1
-;--
- .IDENT /01/
- .PSECT $CODE,PIC,CON,REL,LCL,SHR,EXE,RD,NOWRT,LONG
- .ENTRY JBYTOR,^M<>
-
- SUBL3 #1, at 12(AP),R1 ; get correct byte position
- BLSS 99$ ; return if not valid
- EXTZV R1, at 16(AP), at 8(AP),R0 ; extract byte in B into R0
- MOVL @4(AP),R1 ; R1 = A
- BISL2 R1,R0 ; OR R1 into R0
-99$: RET
-
- .END
diff --git a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/jbytpk.s b/src/packlib/kernlib/kerngen/vmscode/vaxmlan/jbytpk.s
deleted file mode 100644
index 9a9dd44..0000000
--- a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/jbytpk.s
+++ /dev/null
@@ -1,51 +0,0 @@
-;
-; $Id: jbytpk.s,v 1.1.1.1 1996/02/15 17:50:27 mclareni Exp $
-;
-; $Log: jbytpk.s,v $
-; Revision 1.1.1.1 1996/02/15 17:50:27 mclareni
-; Kernlib
-;
-;
- .TITLE JBYTPK
-;++
-; CERN PROGLIB# M422 JBYTPK .VERSION KERNVAX 2.05 830901
-; ORIG. J. VORBRUEGGEN 10/5/83
-;
-; INTEGER FUNCTION JBYTPK(A, JA, MPACK)
-; Return the JA'th byte in A
-;
-; Bytes are described by their length (in bits) NBITS (MPACK(1))
-; and their number per longword INWORD (MPACK(2)).
-; NBITS = 0 is interpreted as a default value of NBITS = 1 and INWORD = 32.
-; Callers of JBYTPK assume the first byte in A to be JA = 1;
-; internally, however, all counters concerning bytes start at 0.
-;
-; Register usage:
-; R0 first used as scratch register, then contains result
-; R1 first contains INWORD, then position of bit field (=byte)
-; R2 = NBITS
-; R3 longword offset from A to longword containing desired byte
-;--
- .IDENT /01/
- .PSECT $CODE,PIC,CON,REL,LCL,SHR,EXE,RD,NOWRT,LONG
- .ENTRY JBYTPK,^M<R2,R3>
-
- MOVAL @12(AP),R1 ; get base address of MPACK
- MOVL (R1),R2 ; get NBITS
- BEQL 10$ ; default values required ?
- MOVL 4(R1),R1 ; no, get INWORD
- BRB 20$ ; and skip
-10$: MOVL #1,R2 ; yes, NBITS = 1
- MOVL #32,R1 ; and INWORD = 32
-
-20$: MOVL @8(AP),R0 ; get byte number
- DECL R0 ; change it to internal counting
- DIVL3 R1,R0,R3 ; compute longword offset
- MULL2 R3,R1 ; number of bytes up to offset
- SUBL2 R1,R0 ; byte number
- ASHL #2,R3,R3 ; compute byte offset
- MULL3 R0,R2,R1 ; finally, position of first bit
- EXTZV R1,R2, at 4(AP)[R3],R0 ; extract the byte
- RET
-
- .END
diff --git a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/jobnam.s b/src/packlib/kernlib/kerngen/vmscode/vaxmlan/jobnam.s
deleted file mode 100644
index a85915f..0000000
--- a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/jobnam.s
+++ /dev/null
@@ -1,63 +0,0 @@
-;
-; $Id: jobnam.s,v 1.1.1.1 1996/02/15 17:50:28 mclareni Exp $
-;
-; $Log: jobnam.s,v $
-; Revision 1.1.1.1 1996/02/15 17:50:28 mclareni
-; Kernlib
-;
-;
- .TITLE JOBNAM
-;++
-; CERN PROGLIB# Z100 JOBNAM .VERSION KERNVAX 2.05 830901
-; ORIG. J. VORBRUEGGEN 6/6/83
-;
-; SUBROUTINE JOBNAM(NAME)
-; Return the current process' name in NAME.
-;
-; If NAME is passed by descriptor and is a string,
-; its descriptor is used as an argument to SYS$GETJPI;
-; otherwise, it is assumed to be a REAL*8 variable, and
-; the process' name is truncated to eight bytes length.
-; Normally, NAME should be a CHARACTER*15 variable.
-;
-; If used as an integer function, function value will
-; be the return status of GETJPI.
-;--
- .IDENT /01/
-
- $JPIDEF ; get JPI symbol definitions
-
- .PSECT $CODE,PIC,CON,REL,LCL,SHR,EXE,RD,NOWRT,LONG
- .ENTRY JOBNAM,^M<>
-
- MOVAL @4(AP),R0 ; get address of argument/descriptor
- CMPB #14,2(R0) ; is it of string type ?
- BNEQ 10$
- CMPB #8,3(R0) ; is it of correct class ?
- BLEQ 10$
- MOVW (R0),BUFLEN ; it's a descriptor, set up length
- MOVAL @4(R0),BUFADR ; and address
- BRB 20$
-
-10$: MOVW #8,BUFLEN ; force length to be eight bytes
- MOVAL (R0),BUFADR ; set up address of argument
-20$: $GETJPI_G - ; get the process' name
- ARGLST
- RET
-
- .PSECT $PDATA,PIC,CON,REL,SHR,RD,NOWRT,NOEXE,LONG
-
-ARGLST: .LONG 7 ; argument list for SYS$GETJPI
- .LONG 0[3]
- .ADDRESS -
- ITEMS
- .LONG 0[3]
-
- .PSECT $LOCAL,PIC,CON,REL,NOSHR,RD,WRT,NOEXE,LONG
-ITEMS:
-BUFLEN: .BLKW 1 ; we put in the length here
- .WORD JPI$_PRCNAM ; we want to have the process' name
-BUFADR: .BLKL 1 ; we put in the buffer address here
- .LONG 0[2]
-
- .END
diff --git a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/jrsbyt.s b/src/packlib/kernlib/kerngen/vmscode/vaxmlan/jrsbyt.s
deleted file mode 100644
index bf44d55..0000000
--- a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/jrsbyt.s
+++ /dev/null
@@ -1,28 +0,0 @@
-;
-; $Id: jrsbyt.s,v 1.1.1.1 1996/02/15 17:50:28 mclareni Exp $
-;
-; $Log: jrsbyt.s,v $
-; Revision 1.1.1.1 1996/02/15 17:50:28 mclareni
-; Kernlib
-;
-;
- .TITLE JRSBYT
-;++
-; CERN PROGLIB# M421 JRSBYT .VERSION KERNVAX 2.05 830901
-; ORIG. J. VORBRUEGGEN 16/5/83
-;
-; INTEGER FUNCTION JRSBYT(A, X, LX, NBITS)
-; Return the byte of size NBITS in X at position LX
-; and set it to the byte at A; the LSB is LX = 1
-;--
- .IDENT /01/
- .PSECT $CODE,PIC,CON,REL,LCL,SHR,EXE,RD,NOWRT,LONG
- .ENTRY JRSBYT,^M<>
-
- SUBL3 #1, at 12(AP),R1 ; get correct byte position
- BLSS 99$ ; return if not valid
- EXTZV R1, at 16(AP), at 8(AP),R0 ; extract ol byte
- INSV @4(AP),R1, at 16(AP), at 8(AP); and insert new one
-99$: RET
-
- .END
diff --git a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/locb.s b/src/packlib/kernlib/kerngen/vmscode/vaxmlan/locb.s
deleted file mode 100644
index 3390b5a..0000000
--- a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/locb.s
+++ /dev/null
@@ -1,23 +0,0 @@
-;
-; $Id: locb.s,v 1.1.1.1 1996/02/15 17:50:28 mclareni Exp $
-;
-; $Log: locb.s,v $
-; Revision 1.1.1.1 1996/02/15 17:50:28 mclareni
-; Kernlib
-;
-;
- .TITLE LOCB
-;++
-; CERN PROGLIB# N100 LOCB .VERSION KERNVAX 2.33 891120
-; ORIG. 17/11/89 JZ
-;
-; INTEGER FUNCTION LOCB(AM)
-; Return the virtual address of AM in longwords
-;--
- .IDENT /01/
- .PSECT $CODE,PIC,CON,REL,LCL,SHR,EXE,RD,NOWRT,LONG
- .ENTRY LOCB,^M<>
-
- MOVL 4(AP),R0
- RET
- .END
diff --git a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/locf.s b/src/packlib/kernlib/kerngen/vmscode/vaxmlan/locf.s
deleted file mode 100644
index 5b4bf5f..0000000
--- a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/locf.s
+++ /dev/null
@@ -1,23 +0,0 @@
-;
-; $Id: locf.s,v 1.1.1.1 1996/02/15 17:50:28 mclareni Exp $
-;
-; $Log: locf.s,v $
-; Revision 1.1.1.1 1996/02/15 17:50:28 mclareni
-; Kernlib
-;
-;
- .TITLE LOCF
-;++
-; CERN PROGLIB# N100 LOCF .VERSION KERNVAX 2.05 830901
-; ORIG. J. VORBRUEGGEN 19/5/83
-;
-; INTEGER FUNCTION LOCF(AM)
-; Return the virtual address of AM in longwords
-;--
- .IDENT /01/
- .PSECT $CODE,PIC,CON,REL,LCL,SHR,EXE,RD,NOWRT,LONG
- .ENTRY LOCF,^M<>
-
- ASHL #-2,4(AP),R0
- RET
- .END
diff --git a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/lvmax.s b/src/packlib/kernlib/kerngen/vmscode/vaxmlan/lvmax.s
deleted file mode 100644
index bc3a54c..0000000
--- a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/lvmax.s
+++ /dev/null
@@ -1,47 +0,0 @@
-;
-; $Id: lvmax.s,v 1.1.1.1 1996/02/15 17:50:32 mclareni Exp $
-;
-; $Log: lvmax.s,v $
-; Revision 1.1.1.1 1996/02/15 17:50:32 mclareni
-; Kernlib
-;
-;
- .TITLE LVMAX
-;++
-; CERN PROGLIB# F121 LVMAX .VERSION KERNVAX 2.05 830901
-; ORIG. J. VORBRUEGGEN 11/5/83
-;
-; INTEGER FUNCTION LVMAX(A, N)
-; Give location (index) of maximum of A(I), I=1,...,N
-;
-; Register usage:
-; R0 index of maximum
-; R1 maximum (initialized with A(1))
-; R2 address of A(I)
-; R3 loop index
-; R4 = N
-;--
- .IDENT /01/
- .PSECT $CODE,PIC,CON,REL,LCL,SHR,EXE,RD,NOWRT,LONG
- .ENTRY LVMAX,^M<R2,R3,R4>
-
- MOVL @8(AP),R4 ; get N
- BLEQ 40$ ; return if <= 0
- MOVL #1,R0 ; initialize index
- DECL R4 ; update N
- BEQL 30$ ; return if N = 1
- MOVAL @4(AP),R2 ; get base address of A
- MOVF (R2)+,R1 ; initialize maximum
- MOVL R0,R3 ; set up loop index
-
-10$: CMPF R1,(R2)+ ; new maximum ?
- BGEQ 20$
- MOVF -4(R2),R1 ; yes, save it
- ADDL3 #1,R3,R0 ; and set up correct index
-20$: AOBLEQ R4,R3,10$ ; loop
-30$: RET
-
-40$: CLRL R0 ; return a function value of zero
- RET
-
- .END
diff --git a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/lvmaxa.s b/src/packlib/kernlib/kerngen/vmscode/vaxmlan/lvmaxa.s
deleted file mode 100644
index 708b8bb..0000000
--- a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/lvmaxa.s
+++ /dev/null
@@ -1,49 +0,0 @@
-;
-; $Id: lvmaxa.s,v 1.1.1.1 1996/02/15 17:50:32 mclareni Exp $
-;
-; $Log: lvmaxa.s,v $
-; Revision 1.1.1.1 1996/02/15 17:50:32 mclareni
-; Kernlib
-;
-;
- .TITLE LVMAXA
-;++
-; CERN PROGLIB# F121 LVMAXA .VERSION KERNVAX 2.05 830901
-; ORIG. J. VORBRUEGGEN 11/5/83
-;
-; INTEGER FUNCTION LVMAXA(A, N)
-; Give location (index) of maximum of absolute values of A(I), I=1,...,N
-;
-; Register usage:
-; R0 index of maximum
-; R1 maximum (initialized with ABS(A(1)))
-; R2 absolute value of A(I)
-; R3 address of A(I)
-; R4 loop index
-; R5 = N
-;--
- .IDENT /01/
- .PSECT $CODE,PIC,CON,REL,LCL,SHR,EXE,RD,NOWRT,LONG
- .ENTRY LVMAXA,^M<R2,R3,R4,R5>
-
- MOVL @8(AP),R5 ; get N
- BLEQ 40$ ; return if <= 0
- MOVL #1,R0 ; initialize index
- DECL R5 ; update N
- BEQL 30$ ; return if N = 1
- MOVAL @4(AP),R3 ; get base address of A
- BICL3 #^X8000,(R3)+,R1 ; initialize maximum
- MOVL R0,R4 ; set up loop index
-
-10$: BICL3 #^X8000,(R3)+,R2 ; get absolute value of A(I)
- CMPF R1,R2 ; new maximum ?
- BGEQ 20$
- MOVF R2,R1 ; yes, save it
- ADDL3 #1,R4,R0 ; and set up correct index
-20$: AOBLEQ R5,R4,10$ ; loop
-30$: RET
-
-40$: CLRL R0 ; return a function value of zero
- RET
-
- .END
diff --git a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/lvmin.s b/src/packlib/kernlib/kerngen/vmscode/vaxmlan/lvmin.s
deleted file mode 100644
index 6d549a0..0000000
--- a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/lvmin.s
+++ /dev/null
@@ -1,47 +0,0 @@
-;
-; $Id: lvmin.s,v 1.1.1.1 1996/02/15 17:50:32 mclareni Exp $
-;
-; $Log: lvmin.s,v $
-; Revision 1.1.1.1 1996/02/15 17:50:32 mclareni
-; Kernlib
-;
-;
- .TITLE LVMIN
-;++
-; CERN PROGLIB# F121 LVMIN .VERSION KERNVAX 2.05 830901
-; ORIG. J. VORBRUEGGEN 11/5/83
-;
-; INTEGER FUNCTION LVMIN(A, N)
-; Give location (index) of minimum of A(I), I=1,...,N
-;
-; Register usage:
-; R0 index of minimum
-; R1 minimum (initialized with A(1))
-; R2 address of A(I)
-; R3 loop index
-; R4 = N
-;--
- .IDENT /01/
- .PSECT $CODE,PIC,CON,REL,LCL,SHR,EXE,RD,NOWRT,LONG
- .ENTRY LVMIN,^M<R2,R3,R4>
-
- MOVL @8(AP),R4 ; get N
- BLEQ 40$ ; return if <= 0
- MOVL #1,R0 ; initialize index
- DECL R4 ; update N
- BEQL 30$ ; return if N = 1
- MOVAL @4(AP),R2 ; get base address of A
- MOVF (R2)+,R1 ; initialize minimum
- MOVL R0,R3 ; set up loop index
-
-10$: CMPF (R2)+,R1 ; new minimum ?
- BGEQ 20$
- MOVF -4(R2),R1 ; yes, save it
- ADDL3 #1,R3,R0 ; and set up correct index
-20$: AOBLEQ R4,R3,10$ ; loop
-30$: RET
-
-40$: CLRL R0 ; return a function value of zero
- RET
-
- .END
diff --git a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/lvmina.s b/src/packlib/kernlib/kerngen/vmscode/vaxmlan/lvmina.s
deleted file mode 100644
index b83a12b..0000000
--- a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/lvmina.s
+++ /dev/null
@@ -1,49 +0,0 @@
-;
-; $Id: lvmina.s,v 1.1.1.1 1996/02/15 17:50:32 mclareni Exp $
-;
-; $Log: lvmina.s,v $
-; Revision 1.1.1.1 1996/02/15 17:50:32 mclareni
-; Kernlib
-;
-;
- .TITLE LVMINA
-;++
-; CERN PROGLIB# F121 LVMINA .VERSION KERNVAX 2.05 830901
-; ORIG. J. VORBRUEGGEN 11/5/83
-;
-; INTEGER FUNCTION LVMINA(A, N)
-; Give location (index) of minimum of absolute values of A(I), I=1,...,N
-;
-; Register usage:
-; R0 index of minimum
-; R1 minimum (initialized with ABS(A(1)))
-; R2 absolute value of A(I)
-; R3 address of A(I)
-; R4 loop index
-; R5 = N
-;--
- .IDENT /01/
- .PSECT $CODE,PIC,CON,REL,LCL,SHR,EXE,RD,NOWRT,LONG
- .ENTRY LVMINA,^M<R2,R3,R4,R5>
-
- MOVL @8(AP),R5 ; get N
- BLEQ 40$ ; return if <= 0
- MOVL #1,R0 ; initialize index
- DECL R5 ; update N
- BEQL 30$ ; return if N = 1
- MOVAL @4(AP),R3 ; get base address of A
- BICL3 #^X8000,(R3)+,R1 ; initialize minimum
- MOVL R0,R4 ; set up loop index
-
-10$: BICL3 #^X8000,(R3)+,R2 ; get absolute value of A(I)
- CMPF R2,R1 ; new minimum ?
- BGEQ 20$
- MOVF R2,R1 ; yes, save it
- ADDL3 #1,R4,R0 ; and set up correct index
-20$: AOBLEQ R5,R4,10$ ; loop
-30$: RET
-
-40$: CLRL R0 ; return a function value of zero
- RET
-
- .END
diff --git a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/mbytet.s b/src/packlib/kernlib/kerngen/vmscode/vaxmlan/mbytet.s
deleted file mode 100644
index 5d17b4d..0000000
--- a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/mbytet.s
+++ /dev/null
@@ -1,32 +0,0 @@
-;
-; $Id: mbytet.s,v 1.1.1.1 1996/02/15 17:50:28 mclareni Exp $
-;
-; $Log: mbytet.s,v $
-; Revision 1.1.1.1 1996/02/15 17:50:28 mclareni
-; Kernlib
-;
-;
- .TITLE MBYTET
-;++
-; CERN PROGLIB# M421 MBYTET .VERSION KERNVAX 2.15 850809
-; ORIG. JZ 9/8/85, DERIVED FROM CODE BY J. VORBRUEGGEN
-;
-; FUNCTION MBYTET (A, X, LX, NBITS)
-; Store in the byte of size NBITS in X at position LX
-; the logical AND of this byte and the byte in A; the LSB is LX = 1
-;--
- .IDENT /01/
- .PSECT $CODE,PIC,CON,REL,LCL,SHR,EXE,RD,NOWRT,LONG
- .ENTRY MBYTET,^M<R2,R3>
-
- MOVL @8(AP),R0 ; R0 = X
- SUBL3 #1, at 12(AP),R1 ; get correct bit position
- BLSS 99$ ; return if not valid
- EXTZV R1, at 16(AP),R0,R2 ; extract the byte at X
- EXTZV #0, at 16(AP), at 4(AP),R3 ; and the one at A
- MCOML R3,R3 ; this is necessary ...
- BICL2 R3,R2 ; to make BIC work as an AND
- INSV R2,R1, at 16(AP),R0 ; and save the result in X
-99$: RET
-
- .END
diff --git a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/mbytor.s b/src/packlib/kernlib/kerngen/vmscode/vaxmlan/mbytor.s
deleted file mode 100644
index ada98d6..0000000
--- a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/mbytor.s
+++ /dev/null
@@ -1,31 +0,0 @@
-;
-; $Id: mbytor.s,v 1.1.1.1 1996/02/15 17:50:28 mclareni Exp $
-;
-; $Log: mbytor.s,v $
-; Revision 1.1.1.1 1996/02/15 17:50:28 mclareni
-; Kernlib
-;
-;
- .TITLE MBYTOR
-;++
-; CERN PROGLIB# M421 MBYTOR .VERSION KERNVAX 2.15 850809
-; ORIG. JZ 9/8/85, DERIVED FROM CODE BY J. VORBRUEGGEN
-;
-; FUNCTION MBYTOR (A, X, LX, NBITS)
-; Store in the byte of size NBITS in X at position LX
-; the logical OR of this byte and the byte in A; the LSB is LX = 1
-;--
- .IDENT /01/
- .PSECT $CODE,PIC,CON,REL,LCL,SHR,EXE,RD,NOWRT,LONG
- .ENTRY MBYTOR,^M<R2,R3>
-
- MOVL @8(AP),R0 ; R0 = X
- SUBL3 #1, at 12(AP),R1 ; get correct bit position
- BLSS 99$ ; return if not valid
- EXTZV R1, at 16(AP),R0,R2 ; extract the byte at X
- EXTZV #0, at 16(AP), at 4(AP),R3 ; and the one at A
- BISL2 R3,R2 ; OR them
- INSV R2,R1, at 16(AP),R0 ; and save the result in X
-99$: RET
-
- .END
diff --git a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/mcbyt.s b/src/packlib/kernlib/kerngen/vmscode/vaxmlan/mcbyt.s
deleted file mode 100644
index 22282f8..0000000
--- a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/mcbyt.s
+++ /dev/null
@@ -1,30 +0,0 @@
-;
-; $Id: mcbyt.s,v 1.1.1.1 1996/02/15 17:50:28 mclareni Exp $
-;
-; $Log: mcbyt.s,v $
-; Revision 1.1.1.1 1996/02/15 17:50:28 mclareni
-; Kernlib
-;
-;
- .TITLE MCBYT
-;++
-; CERN PROGLIB# M421 MCBYT .VERSION KERNVAX 2.15 850809
-; ORIG. JZ 9/8/85, DERIVED FROM CODE BY J. VORBRUEGGEN
-;
-; FUNCTION MCBYT (A, LA, X, LX, NBITS)
-; Copy the byte of size NBITS in A at position LA
-; to the byte in X at postion LX; the LSB is LA = LX = 1
-;--
- .IDENT /01/
- .PSECT $CODE,PIC,CON,REL,LCL,SHR,EXE,RD,NOWRT,LONG
- .ENTRY MCBYT,^M<R2>
-
- MOVL @12(AP),R0 ; R0 = X
- SUBL3 #1, at 8(AP),R1 ; get correct byte position
- BLSS 99$ ; return if not valid
- EXTZV R1, at 20(AP), at 4(AP),R2 ; extract the byte
- SUBL3 #1, at 16(AP),R1 ; get new position
- BLSS 99$ ; return if not valid
- INSV R2,R1, at 20(AP),R0 ; copy the byte
-99$: RET
- .END
diff --git a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/msbit.s b/src/packlib/kernlib/kerngen/vmscode/vaxmlan/msbit.s
deleted file mode 100644
index 0f20ae5..0000000
--- a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/msbit.s
+++ /dev/null
@@ -1,48 +0,0 @@
-;
-; $Id: msbit.s,v 1.1.1.1 1996/02/15 17:50:28 mclareni Exp $
-;
-; $Log: msbit.s,v $
-; Revision 1.1.1.1 1996/02/15 17:50:28 mclareni
-; Kernlib
-;
-;
- .TITLE MSBIT
-;++
-; CERN PROGLIB# M421 MSBIT .VERSION KERNVAX 2.15 850809
-; ORIG. JZ 9/8/85, DERIVED FROM CODE BY J. VORBRUEGGEN
-;
-; FUNCTION MSBIT (A, X, LX)
-; Copy bit 1 of A into bit LX of X; the LSB is LX = 1
-;--
- .IDENT /01/
- .PSECT $CODE,PIC,CON,REL,LCL,SHR,EXE,RD,NOWRT,LONG
- .ENTRY MSBIT,^M<>
-
- MOVL @8(AP),R0 ; R0 = X
- SUBL3 #1, at 12(AP),R1 ; get correct bit position
- BLSS 99$ ; return if not valid
- INSV @4(AP),R1,#1,R0 ; copy the bit
-99$: RET
-;++
-; FUNCTION MSBIT0 (X, LX)
-; Clear bit LX of X
-;--
- .ENTRY MSBIT0,^M<>
-
- MOVL @4(AP),R0 ; R0 = X
- SUBL3 #1, at 8(AP),R1 ; get correct bit position
- BLSS 99$ ; return if not valid
- BBCC R1,R0,99$ ; assuming bit set will avoid branch
-99$: RET
-;++
-; FUNCTION MSBIT1 (X, LX)
-; Set bit LX of X
-;--
- .ENTRY MSBIT1,^M<>
-
- MOVL @4(AP),R0 ; R0 = X
- SUBL3 #1, at 8(AP),R1 ; get correct bit position
- BLSS 99$ ; return if not valid
- BBSS R1,R0,99$ ; assuming bit clear will avoid branch
-99$: RET
- .END
diff --git a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/msbyt.s b/src/packlib/kernlib/kerngen/vmscode/vaxmlan/msbyt.s
deleted file mode 100644
index fe3607e..0000000
--- a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/msbyt.s
+++ /dev/null
@@ -1,27 +0,0 @@
-;
-; $Id: msbyt.s,v 1.1.1.1 1996/02/15 17:50:28 mclareni Exp $
-;
-; $Log: msbyt.s,v $
-; Revision 1.1.1.1 1996/02/15 17:50:28 mclareni
-; Kernlib
-;
-;
- .TITLE MSBYT
-;++
-; CERN PROGLIB# M421 MSBYT .VERSION KERNVAX 2.15 850809
-; ORIG. JZ 9/8/85, DERIVED FROM CODE BY J. VORBRUEGGEN
-;
-; FUNCTION MSBYT (A, X, LX, NBITS)
-; Copy the byte of size NBITS at A to the byte
-; in X at postion LX; the LSB is LX = 1
-;--
- .IDENT /01/
- .PSECT $CODE,PIC,CON,REL,LCL,SHR,EXE,RD,NOWRT,LONG
- .ENTRY MSBYT,^M<>
-
- MOVL @8(AP),R0 ; R0 = X
- SUBL3 #1, at 12(AP),R1 ; get correct bit position
- BLSS 99$ ; return if not valid
- INSV @4(AP),R1, at 16(AP),R0 ; set the byte
-99$: RET
- .END
diff --git a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/noarg.s b/src/packlib/kernlib/kerngen/vmscode/vaxmlan/noarg.s
deleted file mode 100644
index 435008f..0000000
--- a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/noarg.s
+++ /dev/null
@@ -1,32 +0,0 @@
-;
-; $Id: noarg.s,v 1.1.1.1 1996/02/15 17:50:28 mclareni Exp $
-;
-; $Log: noarg.s,v $
-; Revision 1.1.1.1 1996/02/15 17:50:28 mclareni
-; Kernlib
-;
-;
- .TITLE NOARG
-;++
-; CERN PROGLIB# Z029 NOARG .VERSION KERNVAX 2.12 850522
-; ORIG. J. VORBRUEGGEN 30/4/83
-; MODIFIED D.J.CANDLIN 29/4/85
-;
-; SUBROUTINE NOARG(NARG)
-; RETURN NUMBER OF ARGUMENTS CALLER WAS CALLED WITH
-;--
- .IDENT /01/
- .PSECT $CODE,PIC,CON,REL,LCL,SHR,EXE,RD,NOWRT,LONG
- .ENTRY NOARG,^M<>
-
- MOVL 8(FP),R0 ; UPPER THREE BYTES MAY BE USED LATER !
- MOVZBL (R0),R1 ; NUMBER OF ARGUMENTS
- CMPL R1,#1 ; FORTRAN COMPILER ALWAYS PRODUCES
- BNEQ NOPROB ; AT LEAST ONE ARGUMENT, USING %VAL(0)
- TSTL 4(R0) ; IF NO ARGUMENTS ARE GIVEN BY THE
- BNEQ NOPROB ; CALLING PROGRAM.
- CLRL R1 ; IF NARG = 1, AND ARG IS %VAL(0),
- ; THEN PUT NARG = 0
-NOPROB: MOVL R1, at 4(AP) ; RETURN NARG
- RET
- .END
diff --git a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/pkbyt.s b/src/packlib/kernlib/kerngen/vmscode/vaxmlan/pkbyt.s
deleted file mode 100644
index 0b62ee8..0000000
--- a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/pkbyt.s
+++ /dev/null
@@ -1,66 +0,0 @@
-;
-; $Id: pkbyt.s,v 1.1.1.1 1996/02/15 17:50:28 mclareni Exp $
-;
-; $Log: pkbyt.s,v $
-; Revision 1.1.1.1 1996/02/15 17:50:28 mclareni
-; Kernlib
-;
-;
- .TITLE PKBYT
-;++
-; CERN PROGLIB# M422 PKBYT .VERSION KERNVAX 2.05 830901
-; ORIG. J. VORBRUEGGEN 10/5/83
-;
-; SUBROUTINE PKBYT(IB, X, JX, N, MPACK)
-; Pack the N small integers from IB into the byte string
-; at X, starting at the JX'th byte.
-;
-; Bytes are described by their length (in bits) NBITS (MPACK(1))
-; and their number per longword INWORD (MPACK(2)).
-; NBITS = 0 is interpreted as a default value of NBITS = 1 and INWORD = 32.
-; Callers of PKBYT assume the first byte in X to be JX = 1;
-; internally, however, all counters concerning bytes start at 0.
-;
-; Register usage:
-; R0 = NBITS
-; R1 = INWORD
-; R2 base address of bit field (=byte)
-; R3 byte number in current longword (from 0 to INWORD-1)
-; R4 position of bit field (from 0 to (INWORD-1)*NBITS)
-; R5 updated address in IB
-; R6 first used as scratch register, then counter from N to 1
-;--
- .IDENT /01/
- .PSECT $CODE,PIC,CON,REL,LCL,SHR,EXE,RD,NOWRT,LONG
- .ENTRY PKBYT,^M<R2,R3,R4,R5,R6>
-
- MOVAL @20(AP),R6 ; get base address of MPACK
- MOVL (R6),R0 ; save NBITS
- BEQL 10$ ; default values required ?
- MOVL 4(R6),R1 ; no, save INWORD
- BRB 20$ ; and skip
-10$: MOVL #1,R0 ; yes, NBITS = 1
- MOVL #32,R1 ; and INWORD = 32
-
-20$: MOVL @12(AP),R6 ; get byte number
- DECL R6 ; change it to internal counting
- DIVL3 R1,R6,R2 ; compute longword offset
- MULL3 R1,R2,R4 ; number of bytes up to offset
- SUBL3 R4,R6,R3 ; byte number
- MULL3 R0,R3,R4 ; finally, position of first bit
- MOVAL @4(AP),R5 ; get base address of IB
- MOVAL @8(AP)[R2],R2 ; compute base address of bit field
- MOVL @16(AP),R6 ; get counter
-
-30$: INSV (R5)+,R4,R0,(R2) ; insert a byte
- INCL R3 ; JB = JB + 1
- CMPL R3,R1 ; JB >= INWORD ?
- BGEQ 40$
- ADDL2 R0,R4 ; no, just update position
- BRB 50$ ; and skip
-40$: ADDL2 #4,R2 ; yes, update base address
- CLRQ R3 ; reset position and byte number
-50$: SOBGTR R6,30$ ; and loop
- RET
-
- .END
diff --git a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/pkchar.s b/src/packlib/kernlib/kerngen/vmscode/vaxmlan/pkchar.s
deleted file mode 100644
index c44dde4..0000000
--- a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/pkchar.s
+++ /dev/null
@@ -1,148 +0,0 @@
-;
-; $Id: pkchar.s,v 1.1.1.1 1996/02/15 17:50:28 mclareni Exp $
-;
-; $Log: pkchar.s,v $
-; Revision 1.1.1.1 1996/02/15 17:50:28 mclareni
-; Kernlib
-;
-;
- .TITLE PKCHAR
-;++
-; CERN PROGLIB# M427 PKCHAR .VERSION KERNVAX 2.32 890926
-; ORIG. J. VORBRUEGGEN 17/5/83
-; MOD. JV 8/10/83, FCA 26/09/89
-;
-; SUBROUTINE PKCHAR(INT, CHAR, N, IPAR)
-; Pack the N small integers in array INT into CHAR
-; as bytes described by IPAR in the following way:
-;
-; IPAR(1) (= NBITS) # of bits per byte
-; IPAR(2) (= NCHAR) # of bytes per zone; if zero, maximum is used
-; IPAR(3) (= NZONE) # of bits per zone; if zero, set to 32
-; IPAR(4) (= LBITS) # of leading bits of each zone to be ignored
-; IPAR(5) (= IFILL) longword with which each word used is preset
-;
-; Bits are numbered from left to right, starting with 1;
-; bytes crossing word boundaries are discontinuous!
-; Because of this, NZONE = 32 is treated seperately.
-; If the specified number of bytes won't fit into a field
-; of length NZONE-LBITS, NCHAR is set to the maximum that will.
-; On return, the first longword of COMMON /SLATE/ contains the number
-; of longwords used in CHAR, not including trailing bits of last zone.
-;
-; Register usage:
-; R0 counter from N to 1
-; R1 counter from NCHAR to 1
-; R2 = NZONE
-; R3 = NBITS
-; R4 = LBITS
-; R5 = NCHAR
-; R6 = IFILL (temporarily used for address of IPAR)
-; R7 address of CHAR(NWORD)
-; R8 address of next integer to be packed
-; R9 position of LSB of current byte
-;
-; If NZONE = 32,
-; R10 position of LSB of first byte in longword
-; R11 not used
-;
-; If NZONE <> 32,
-; R10 if byte spans longwords, contains # of bits left for this word
-; R11 if byte spans longwords, contains part of byte to be packed
-; NSKIP # of bits to be skipped between two zones
-;
-; R10 is used as scratch register for calculations in both cases.
-;--
- .IDENT /01/
- .PSECT $CODE,PIC,CON,REL,LCL,SHR,EXE,RD,NOWRT,LONG
- .ENTRY PKCHAR,^M<R2,R3,R4,R5,R6,R7,R8,R9,R10,R11>
-
- MOVL @12(AP),R0 ; get counter
- BGTR 10$ ; continue if > 0
- RET ; else return
-10$: MOVAL @16(AP),R6 ; get base address of IPAR
- MOVAL @8(AP),R7 ; get base address of CHAR
- MOVAL @4(AP),R8 ; and INT
- MOVL 8(R6),R2 ; get NZONE
- BNEQ 20$ ; default needed ?
- MOVL #32,R2 ; yes, NZONE = 32
-20$: MOVL (R6),R3 ; get NBITS
- MOVL 12(R6),R4 ; and LBITS
- MOVL 4(R6),R5 ; and NCHAR
- BEQL 30$ ; default needed ?
- MULL3 R3,R5,R11 ; no, check for valid arguments
- ADDL2 R4,R11 ; compute NBITS*NCHAR+LBITS
- CMPL R11,R2 ; do they fit into NZONE bits ?
- BLEQ 40$ ; if not, set NCHAR to maximum
-30$: SUBL3 R4,R2,R11 ; compute # of usable bits
- DIVL3 R3,R11,R5 ; divide result by size of byte
-40$: MOVL 16(R6),R6 ; get IFILL
- MOVL R6,(R7) ; preset first longword of CHAR
- MOVL #1,NWORD ; and initialize NWORD
- SUBL3 R4,#32,R9 ; compute pointer to end of 1st byte
- CMPL #32,R2 ; zone of one longword ?
- BNEQ NOTWRD
- ; we get here if that's so
-WORD: SUBL2 R3,R9 ; compute position of 1st byte in zone
- MOVL R9,R10 ; save it for later use
- BRB 30$ ; start the loop correctly
-
-10$: DECL R1 ; any more bytes for this zone ?
- BEQL 20$
- SUBL2 R3,R9 ; yes, update pointer
- INSV (R8)+,R9,R3,(R7) ; pack one byte
- SOBGTR R0,10$ ; and loop
- RET
- ; new zone:
-20$: ADDL2 #4,R7 ; update address in CHAR
- MOVL R10,R9 ; set position pointer to 1st byte
- MOVL R6,(R7) ; preset the new longword
- INCL NWORD ; and count it
-30$: MOVL R5,R1 ; initialize byte counter
- INSV (R8)+,R9,R3,(R7) ; pack one byte | repeated
- SOBGTR R0,10$ ; and loop | for speed
- RET
- ; we get here if everything's possible
-NOTWRD: MULL3 R3,R5,R10 ; compute # of bits used by bytes
- SUBL3 R10,R2,NSKIP ; compute # of bits between zones
-
-10$: MOVL R5,R1 ; initialize byte counter
- TSTL R9 ; position negative <=> new longword ?
- BGEQ 30$
-20$: ADDL2 #4,R7 ; yes, update address in CHAR
- MOVL R6,(R7) ; fill it
- INCL NWORD ; and take account of that
- ADDL2 #32,R9 ; correct our position
- BLSS 20$ ; another longword to fill ?
-
-30$: DECL R1 ; any more bytes for this zone ?
- BLSS 40$
- SUBL2 R3,R9 ; yes, update position
- BLSS 50$ ; does byte span longwords ?
- INSV (R8)+,R9,R3,(R7) ; no, pack it
- SOBGTR R0,30$ ; and loop
- RET
-
-40$: SUBL2 NSKIP,R9 ; skip trailing and leading bits
- BRB 10$ ; and start new zone
-
-50$: ADDL3 R3,R9,R10 ; compute # of bits left
- BEQL 60$ ; none ?
- ASHL R9,(R8),R11 ; save EXTZV by shifting source
- INSV R11,#0,R10,(R7) ; pack the upper bits which fit
-60$: ADDL2 #4,R7 ; update address in CHAR
- MOVL R6,(R7) ; fill the new longword
- INCL NWORD ; and remember that we did
- MNEGL R9,R11 ; # of bytes left to pack
- ADDL2 #32,R9 ; update position
- INSV (R8)+,R9,R11,(R7) ; and pack the rest
- SOBGTR R0,30$ ; loop
- RET
-
- .PSECT SLATE,PIC,OVR,REL,GBL,SHR,NOEXE,RD,WRT,LONG
-
-NWORD: .BLKL 1
-NSKIP: .BLKL 1
-RESERV: .BLKL 38
-
- .END
diff --git a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/qnexte.s b/src/packlib/kernlib/kerngen/vmscode/vaxmlan/qnexte.s
deleted file mode 100644
index d4e6518..0000000
--- a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/qnexte.s
+++ /dev/null
@@ -1,48 +0,0 @@
-;
-; $Id: qnexte.s,v 1.1.1.1 1996/02/15 17:50:29 mclareni Exp $
-;
-; $Log: qnexte.s,v $
-; Revision 1.1.1.1 1996/02/15 17:50:29 mclareni
-; Kernlib
-;
-;
- .TITLE QNEXTE
-;++
-; CERN PROGLIB# Z041 QNEXTE .VERSION KERNVAX 2.27 880712
-; ORIG. E. PAGIOLA OCT. 81
-; MOD. 2/3/88 JZ, 14/6/88 FCA
-;
-; ON FIRST ENTRY QNEXTE SAVES THE CURRENT FRAME + STACK POINTERS
-; AND CALLS QNEXT.
-; ON RE-ENTRY IT RESETS FP + SP TO THE SAVED VALUES,
-; THUS WIPING OUT THE STACK FOR ALL INTERMEDIATE CALLS,
-; AND AGAIN CALLS QNEXT.
-;--
- .WEAK QNEXT
- .PSECT $LOCAL,PIC,REL,LCL,NOSHR,NOEXE,RD,WRT,LONG
-
-QNXFP: .LONG 0
-QNXSP: .LONG 0
-ADREX: .ADDRESS QNEXT
-
- .PSECT $CODE,PIC,CON,REL,LCL,SHR,EXE,RD,NOWRT,LONG
-
- .ENTRY QNEXTE,^M<R2,R3,R4,R5,R6,R7,R8,R9,R10,R11>
- TSTL QNXFP
- BNEQ 30$
- MOVL FP,QNXFP
- MOVL SP,QNXSP
- BRB 40$
-
-;-- NON-FIRST ENTRIES
-
-30$: MOVL QNXFP,FP
- MOVL QNXSP,SP
-
-40$: TSTL ADREX
- BNEQ 44$
- CALLS #0,QNEXTD
-
-44$: CALLS #0,QNEXT
- RET
- .END
diff --git a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/rndm.s b/src/packlib/kernlib/kerngen/vmscode/vaxmlan/rndm.s
deleted file mode 100644
index 3f2d803..0000000
--- a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/rndm.s
+++ /dev/null
@@ -1,65 +0,0 @@
-;
-; $Id: rndm.s,v 1.1.1.1 1996/02/15 17:50:29 mclareni Exp $
-;
-; $Log: rndm.s,v $
-; Revision 1.1.1.1 1996/02/15 17:50:29 mclareni
-; Kernlib
-;
-;
- .TITLE RNDM
-;++
-; CERN PROGLIB# V104 RNDM .VERSION KERNVAX 2.30 881021
-; ORIG. H.FORSBACH, WUPPERTAL, JUNE 82
-; MOD. J. VORBRUEGGEN 25/5/83, corr. 20/10/88 JZ
-;
-; REAL FUNCTION RNDM (DUMMY)
-; UNIFORM RANDOM NUMBER GENERATOR FOR VAX 11-780
-; REWRITTEN FROM CERN IBM 370 VERSION
-; WITH THE IBM RANDOM NUMBER SEQUENCE
-; ONE PARAMETER VERSION
-;
-;--
- .IDENT /01/
- .PSECT $CODE,PIC,CON,REL,LCL,SHR,EXE,RD,NOWRT,LONG
- .ENTRY RNDM,^M<> ;SAVE NOTHING
-
- MOVL MCGN,R0 ;MOVE MCGN -> R0
- MULL2 #^D69069,R0 ;MULTIPLY WITH 69069 INTO R0
- MOVL R0,MCGN ;STORE MCGN
- EXTZV #8,#24,R0,R1 ;MANTISSA INTO R1
- CVTLF R1,R0 ;MANTISSA TO VAX-FLOATING
- EXTZV #7,#5,R0,R1 ;GET NORMALIZATION SHIFT
- ADDL2 #^X68,R1 ;ADD 128-EXCESS AND AJUST
- INSV R1,#7,#8,R0 ;PACK EXPONENT INTO R2
- RET
-;
-; INTEGER*4 FUNCTION IRNDM (DUMMY)
-; UNIFORM DISTRIBUTED POSITIVE INTEGERS
-; WITH THE SAME SEQUENCE AS IBM 370
-;
- .ENTRY IRNDM,^M<> ;SAVE NOTHING
-
- MULL2 #^D69069,MCGN ;MULTIPLY WITH 69069
- EXTZV #1,#31,MCGN,R0 ;CLEAR SIGN BIT AND STORE RESULT
- RET
-;
-; SUBROUTINE RDMIN (MCGN)
-; MCGN IS THE STARTING VALUE OF RNDM
-;
- .ENTRY RDMIN,^M<>
-
- MOVL @4(AP),MCGN
- RET
-;
-; SUBROUTINE RDMOUT (MCGN)
-; MCGN IS THE LAST USED VALUE OF RNDM
-;
- .ENTRY RDMOUT,^M<>
-
- MOVL MCGN, at 4(AP)
- RET
-
- .PSECT $LOCAL,PIC,CON,REL,LCL,NOSHR,NOEXE,RD,WRT,LONG
-
-MCGN: .LONG ^D12345
- .END
diff --git a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/sbit.s b/src/packlib/kernlib/kerngen/vmscode/vaxmlan/sbit.s
deleted file mode 100644
index 5fc1eb9..0000000
--- a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/sbit.s
+++ /dev/null
@@ -1,46 +0,0 @@
-;
-; $Id: sbit.s,v 1.1.1.1 1996/02/15 17:50:29 mclareni Exp $
-;
-; $Log: sbit.s,v $
-; Revision 1.1.1.1 1996/02/15 17:50:29 mclareni
-; Kernlib
-;
-;
- .TITLE SBIT
-;++
-; CERN PROGLIB# M421 SBIT .VERSION KERNVAX 2.05 830901
-; ORIG. A.G.MICHETTE & M.WATERS, RUTHERFORD, APRIL 79
-; MOD. J. VORBRUEGGEN 16/5/83
-;
-; SUBROUTINE SBIT(A, X, LX)
-; Copy bit 1 of A into bit LX of X; the LSB is LX = 1
-;--
- .IDENT /01/
- .PSECT $CODE,PIC,CON,REL,LCL,SHR,EXE,RD,NOWRT,LONG
- .ENTRY SBIT,^M<>
-
- SUBL3 #1, at 12(AP),R0 ; get correct bit position
- BLSS 99$ ; return if not valid
- INSV @4(AP),R0,#1, at 8(AP) ; copy the bit
-99$: RET
-;++
-; SUBROUTINE SBIT0(X, LX)
-; Clear bit LX of X
-;--
- .ENTRY SBIT0,^M<>
-
- SUBL3 #1, at 8(AP),R0 ; get correct bit position
- BLSS 99$ ; return if not valid
- BBCC R0, at 4(AP),99$ ; assuming bit set will avoid branch
-99$: RET
-;++
-; SUBROUTINE SBIT1(X, LX)
-; Set bit LX of X
-;--
- .ENTRY SBIT1,^M<>
-
- SUBL3 #1, at 8(AP),R0 ; get correct bit position
- BLSS 99$ ; return if not valid
- BBSS R0, at 4(AP),99$ ; assuming bit clear will avoid branch
-99$: RET
- .END
diff --git a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/sbyt.s b/src/packlib/kernlib/kerngen/vmscode/vaxmlan/sbyt.s
deleted file mode 100644
index 74e1f98..0000000
--- a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/sbyt.s
+++ /dev/null
@@ -1,27 +0,0 @@
-;
-; $Id: sbyt.s,v 1.1.1.1 1996/02/15 17:50:29 mclareni Exp $
-;
-; $Log: sbyt.s,v $
-; Revision 1.1.1.1 1996/02/15 17:50:29 mclareni
-; Kernlib
-;
-;
- .TITLE SBYT
-;++
-; CERN PROGLIB# M421 SBYT .VERSION KERNVAX 2.05 830901
-; ORIG. A.G.MICHETTE & M.WATERS, RUTHERFORD, APRIL 79
-; MOD. J. VORBRUEGGEN 16/5/83
-;
-; SUBROUTINE SBYT(A, X, LX, NBITS)
-; Copy the byte of size NBITS at A to the byte
-; in X at postion LX; the LSB is LX = 1
-;--
- .IDENT /01/
- .PSECT $CODE,PIC,CON,REL,LCL,SHR,EXE,RD,NOWRT,LONG
- .ENTRY SBYT,^M<>
-
- SUBL3 #1, at 12(AP),R0 ; get correct bit position
- BLSS 99$ ; return if not valid
- INSV @4(AP),R0, at 16(AP), at 8(AP); set the byte
-99$: RET
- .END
diff --git a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/sbytor.s b/src/packlib/kernlib/kerngen/vmscode/vaxmlan/sbytor.s
deleted file mode 100644
index 3b1fd9d..0000000
--- a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/sbytor.s
+++ /dev/null
@@ -1,30 +0,0 @@
-;
-; $Id: sbytor.s,v 1.1.1.1 1996/02/15 17:50:29 mclareni Exp $
-;
-; $Log: sbytor.s,v $
-; Revision 1.1.1.1 1996/02/15 17:50:29 mclareni
-; Kernlib
-;
-;
- .TITLE SBYTOR
-;++
-; CERN PROGLIB# M421 SBYTOR .VERSION KERNVAX 2.05 830901
-; ORIG. J. VORBRUEGGEN 16/5/83
-;
-; SUBROUTINE SBYTOR(A, X, LX, NBITS)
-; Store in the byte of size NBITS in X at position LX
-; the logical OR of this byte and the byte in A; the LSB is LX = 1
-;--
- .IDENT /01/
- .PSECT $CODE,PIC,CON,REL,LCL,SHR,EXE,RD,NOWRT,LONG
- .ENTRY SBYTOR,^M<R2>
-
- SUBL3 #1, at 12(AP),R2 ; get correct bit position
- BLSS 99$ ; return if not valid
- EXTZV R2, at 16(AP), at 8(AP),R0 ; extract the byte at X
- EXTZV #0, at 16(AP), at 4(AP),R1 ; and the one at A
- BISL2 R1,R0 ; OR them
- INSV R0,R2, at 16(AP), at 8(AP) ; and save the result in X
-99$: RET
-
- .END
diff --git a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/sbytpk.s b/src/packlib/kernlib/kerngen/vmscode/vaxmlan/sbytpk.s
deleted file mode 100644
index 06f9eaf..0000000
--- a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/sbytpk.s
+++ /dev/null
@@ -1,51 +0,0 @@
-;
-; $Id: sbytpk.s,v 1.1.1.1 1996/02/15 17:50:30 mclareni Exp $
-;
-; $Log: sbytpk.s,v $
-; Revision 1.1.1.1 1996/02/15 17:50:30 mclareni
-; Kernlib
-;
-;
- .TITLE SBYTPK
-;++
-; CERN PROGLIB# M422 SBYTPK .VERSION KERNVAX 2.05 830901
-; ORIG. J. VORBRUEGGEN 10/5/83
-;
-; SUBROUTINE SBYTPK(D, X, JX, MPACK)
-; Set the JA'th byte in A to the small integer in D
-;
-; Bytes are described by their length (in bits) NBITS (MPACK(1))
-; and their number per longword INWORD (MPACK(2)).
-; NBITS = 0 is interpreted as a default value of NBITS = 1 and INWORD = 32.
-; Callers of SBYTPK assume the first byte in X to be JX = 1;
-; internally, however, all counters concerning bytes start at 0.
-;
-; Register usage:
-; R0 used as scratch register
-; R1 first contains INWORD, then position of bit field (=byte)
-; R2 = NBITS
-; R3 byte offset from A to longword containing desired byte
-;--
- .IDENT /01/
- .PSECT $CODE,PIC,CON,REL,LCL,SHR,EXE,RD,NOWRT,LONG
- .ENTRY SBYTPK,^M<R2,R3>
-
- MOVAL @16(AP),R1 ; get base address of MPACK
- MOVL (R1),R2 ; get NBITS
- BEQL 10$ ; default values required ?
- MOVL 4(R1),R1 ; no, get INWORD
- BRB 20$ ; and skip
-10$: MOVL #1,R2 ; yes, NBITS = 1
- MOVL #32,R1 ; and INWORD = 32
-
-20$: MOVL @12(AP),R0 ; get byte number
- DECL R0 ; change it to internal counting
- DIVL3 R1,R0,R3 ; compute longword offset
- MULL2 R3,R1 ; number of bytes up to offset
- SUBL2 R1,R0 ; byte number
- ASHL #2,R3,R3 ; compute byte offset
- MULL3 R0,R2,R1 ; finally, position of first bit
- INSV @4(AP),R1,R2, at 8(AP)[R3] ; insert the byte
- RET
-
- .END
diff --git a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/swbl16.s b/src/packlib/kernlib/kerngen/vmscode/vaxmlan/swbl16.s
deleted file mode 100644
index c21788b..0000000
--- a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/swbl16.s
+++ /dev/null
@@ -1,32 +0,0 @@
-;
-; $Id: swbl16.s,v 1.1.1.1 1996/02/15 17:50:30 mclareni Exp $
-;
-; $Log: swbl16.s,v $
-; Revision 1.1.1.1 1996/02/15 17:50:30 mclareni
-; Kernlib
-;
-;
- .TITLE SWBL16
-;++
-; CERN PROGLIB# SWBLOW16 .VERSION KERNVAX 1.08 810129
-; ORIG. E. PAGIOLA 28/1/81
-; MOD. J. VORBRUEGGEN 31/5/83
-;
-; SUBROUTINE VAX_SWBLOW16(RECORD, WORDS, N16)
-; Blow the raw data in RECORD, 4 bytes per longword,
-; into the N16 16-bit words in WORDS with bytes swopped.
-;--
- .IDENT /01/
- .PSECT $CODE,PIC,CON,REL,LCL,SHR,EXE,RD,NOWRT,LONG
- .ENTRY VAX_SWBLOW16,^M<R2,R3>
-
- MOVQ 4(AP),R0 ;INPUT AND OUTPUT BUFFER ADR
- MOVL @12(AP),R2 ;R2=COUNT
-
-10$: MOVB (R0)+,R3 ;FIRST BYTE
- ROTL #8,R3,R3 ;TO 2ND BYTE
- MOVB (R0)+,R3 ;2ND BYTE TO FIRST
- MOVZWL R3,(R1)+ ;STORE 16 BIT WORD
- SOBGTR R2,10$ ;LOOP
- RET
- .END
diff --git a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/swbu16.s b/src/packlib/kernlib/kerngen/vmscode/vaxmlan/swbu16.s
deleted file mode 100644
index 6bacf14..0000000
--- a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/swbu16.s
+++ /dev/null
@@ -1,33 +0,0 @@
-;
-; $Id: swbu16.s,v 1.1.1.1 1996/02/15 17:50:30 mclareni Exp $
-;
-; $Log: swbu16.s,v $
-; Revision 1.1.1.1 1996/02/15 17:50:30 mclareni
-; Kernlib
-;
-;
- .TITLE SWBU16
-;++
-; CERN PROGLIB# SWBUNCH16 .VERSION KERNVAX 1.08 810129
-; ORIG. E. PAGIOLA 28/1/81
-; MOD. J. VORBRUEGGEN 31/5/83
-;
-; SUBROUTINE VAX_SWBUNCH16(WORDS, RECORD, N16)
-; Bunch the N16 16-bit words at WORDS with byte swopping to
-; the raw data in RECORD, 4 bytes per longword.
-;--
- .IDENT /01/
- .PSECT $CODE,PIC,CON,REL,LCL,SHR,EXE,RD,NOWRT,LONG
- .ENTRY VAX_SWBUNCH16,^M<R2,R3>
-
- MOVQ 4(AP),R0 ;INPUT AND OUTPUT BUFFER ADR
- MOVL @12(AP),R2 ;R2=COUNT
-
-10$: MOVB (R0),R3 ;FIRST BYTE
- ROTL #8,R3,R3 ;TO 2ND
- MOVB 1(R0),R3 ;2ND TO FIRST
- MOVW R3,(R1)+ ;STORE NEXT 2 BYTES
- ADDL2 #4,R0 ;BUMP INPUT ADR
- SOBGTR R2,10$
- RET
- .END
diff --git a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/ublank.s b/src/packlib/kernlib/kerngen/vmscode/vaxmlan/ublank.s
deleted file mode 100644
index e5c6629..0000000
--- a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/ublank.s
+++ /dev/null
@@ -1,54 +0,0 @@
-;
-; $Id: ublank.s,v 1.1.1.1 1996/02/15 17:50:30 mclareni Exp $
-;
-; $Log: ublank.s,v $
-; Revision 1.1.1.1 1996/02/15 17:50:30 mclareni
-; Kernlib
-;
-;
- .TITLE UBLANK
-;++
-; CERN PROGLIB# V300 UBLANK .VERSION KERNVAX 2.18 860429
-; ORIG. J. VORBRUEGGEN 30/4/83
-;
-; SUBROUTINE UBLANK(A, JL, JN)
-; Preset to blank array from element JL to JN
-;
-; Register usage:
-; JN-JL <= 16383 JN-JL > 16383
-; R0 byte offset to A(JL) from A(1) (used by MOVC5)
-; R1 byte count dummy source address
-; R2 dummy source address (used by MOVC5)
-; R3 | destination address
-; R4 | (used by MOVC5) (used by MOVC5)
-; R5 | (used by MOVC5)
-; R6 not used = 65535
-; R7 not used updated byte count
-;
-; NOTE: R6/R7 are only saved if needed (i. e. JN-JL > 16383)
-;--
- .IDENT /01/
- .PSECT $CODE,PIC,CON,REL,LCL,SHR,EXE,RD,NOWRT,LONG
- .ENTRY UBLANK,^M<R2,R3,R4,R5>
-
- ASHL #2, at 8(AP),R0 ; Compute byte offset to A(JL)
- SUBL2 #4,R0
- ASHL #2, at 12(AP),R1 ; Compute byte offset to A(JN+1)
- SUBL2 R0,R1 ; # of bytes to preset
- CMPL #65535,R1 ; Too large for MOVC5 ?
- BLSSU 10$
- MOVC5 #0,(R2),#32,R1, at 4(AP)[R0]; Normal case.
- RET
-
-10$: MOVQ R6,-(SP) ; Fastest way of saving R6/R7
- MOVL #65535,R6 ; Max. # of bytes for MOVC5
- ADDL3 4(AP),R0,R3 ; Compute address of A(JL)
- MOVL R1,R7 ; Save count from destruction
-
-20$: MOVC5 #0,(R1),#32,R6,(R3) ; Preset one 64KB chunk
- ACBL R6,#-65535,R7,20$ ; Any more ?
- BEQL 30$ ; Already finished ?
- MOVC5 #0,(R1),#32,R7,(R3) ; No, preset the rest
-30$: MOVQ (SP)+,R6 ; Restore registers
- RET
- .END
diff --git a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/ublow.s b/src/packlib/kernlib/kerngen/vmscode/vaxmlan/ublow.s
deleted file mode 100644
index 253e95b..0000000
--- a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/ublow.s
+++ /dev/null
@@ -1,31 +0,0 @@
-;
-; $Id: ublow.s,v 1.1.1.1 1996/02/15 17:50:30 mclareni Exp $
-;
-; $Log: ublow.s,v $
-; Revision 1.1.1.1 1996/02/15 17:50:30 mclareni
-; Kernlib
-;
-;
- .TITLE UBLOW
-;++
-; CERN PROGLIB# M409 UBLOW .VERSION KERNVAX 1.04 800721
-; ORIG. DAVID MYERS, CERN, SEP 79
-; MOD. J. VORBRUEGGEN 19/5/83
-;
-; SUBROUTINE UBLOW(AVM, XVM, N)
-; Unpack the N bytes at AVM to 1H (blank padded) strings at XVM
-;--
- .IDENT /01/
- .PSECT $CODE,PIC,CON,REL,LCL,SHR,EXE,RD,NOWRT,LONG
- .ENTRY UBLOW,^M<R2>
-
- MOVL @12(AP),R0 ; GET N
- BLEQ 99$ ; IF .LE. 0 THEN RETURN
- MOVAL @4(AP),R1 ; GET ADDRESS OF AVM
- MOVAL @8(AP),R2 ; GET ADDRESS OF XVM
-
-24$: MOVL #^A/ /,(R2)+ ; FIRST CLEAR WORD
- MOVB (R1)+,-4(R2) ; AND PUT CHAR IN FIRST BYTE
- SOBGTR R0,24$ ; NEXT CHAR
-99$: RET
- .END
diff --git a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/ubunch.s b/src/packlib/kernlib/kerngen/vmscode/vaxmlan/ubunch.s
deleted file mode 100644
index a8b279a..0000000
--- a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/ubunch.s
+++ /dev/null
@@ -1,43 +0,0 @@
-;
-; $Id: ubunch.s,v 1.1.1.1 1996/02/15 17:50:30 mclareni Exp $
-;
-; $Log: ubunch.s,v $
-; Revision 1.1.1.1 1996/02/15 17:50:30 mclareni
-; Kernlib
-;
-;
- .TITLE UBUNCH
-;++
-; CERN PROGLIB# M409 UBUNCH .VERSION KERNVAX 1.04 800721
-; ORIG. DAVID MYERS, CERN, SEP 79
-; MOD. J. VORBRUEGGEN 31/5/83
-;
-; SUBROUTINE UBUNCH(AVM, XVM, N)
-; Copy the N bytes at AVM in 1H format to the XVM
-; in 4H format.
-; If XVM starts on longword boundary then remaining
-; bytes in last word are blank filled.
-;--
- .IDENT /01/
- .PSECT $CODE,PIC,CON,REL,LCL,SHR,EXE,RD,NOWRT,LONG
- .ENTRY UBUNCH,^M<R2,R3>
-
- MOVL @12(AP),R0 ;GET N
- BLEQ 99$ ;IF .LE. 0 THEN RETURN
- MOVAL @4(AP),R3 ;GET ADDR. OF AVM
- MOVAL @8(AP),R2 ;GET ADDR. OF XVM
-24$: MOVB (R3),(R2)+ ;GET CHAR AND BUNCH IT
- ADDL2 #4,R3 ;SKIP TO NEXT WORD
- SOBGTR R0,24$ ;NEXT CHAR
- MOVL R2,R1 ;SAVE ADDRESS
- BLBC R1,76$ ;SKIP IF N EVEN
- MOVB #^A/ /,(R2)+ ;OTHERWISE FILL ONE BLANK
- BBS #1,R1,99$ ;SKIP IF N WAS ODD-EVEN
- BRB 79$
-
-76$: BBC #1,R1,99$ ;SKIP IF N WAS EVEN-EVEN
-
-79$: MOVW #^A/ /,(R2) ;OTHERWISE FILL TWO BLANKS
-
-99$: RET
- .END
diff --git a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/ucopiv.s b/src/packlib/kernlib/kerngen/vmscode/vaxmlan/ucopiv.s
deleted file mode 100644
index 2bb9088..0000000
--- a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/ucopiv.s
+++ /dev/null
@@ -1,34 +0,0 @@
-;
-; $Id: ucopiv.s,v 1.1.1.1 1996/02/15 17:50:30 mclareni Exp $
-;
-; $Log: ucopiv.s,v $
-; Revision 1.1.1.1 1996/02/15 17:50:30 mclareni
-; Kernlib
-;
-;
- .TITLE UCOPIV
-;++
-; CERN PROGLIB# V301 UCOPIV .VERSION KERNVAX 2.05 830901
-; ORIG. J. VORBRUEGGEN 25/5/83
-;
-; SUBROUTINE UCOPIV(A, X, N)
-; Copy the vector A of length N into X in reverse order,
-; i. e. X(1) = A(N),...,X(N) = A(1).
-;
-; Register usage:
-; R0, R1 addresses of A(I) and X(N-I+1), resp.
-; R2 counter from N to 1
-;--
- .IDENT /01/
- .PSECT $CODE,PIC,CON,REL,LCL,SHR,EXE,RD,NOWRT,LONG
- .ENTRY UCOPIV,^M<R2>
-
- MOVL @12(AP),R2 ; get counter
- BLEQ 20$ ; return if <= 0
- MOVAL @4(AP),R0 ; get base address of A
- MOVAL @8(AP)[R2],R1 ; get address of X(N+1)
-10$: MOVL (R0)+,-(R1) ; copy the value
- SOBGTR R2,10$ ; and loop
-20$: RET
-
- .END
diff --git a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/ucopy2.s b/src/packlib/kernlib/kerngen/vmscode/vaxmlan/ucopy2.s
deleted file mode 100644
index a618cc9..0000000
--- a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/ucopy2.s
+++ /dev/null
@@ -1,73 +0,0 @@
-;
-; $Id: ucopy2.s,v 1.1.1.1 1996/02/15 17:50:31 mclareni Exp $
-;
-; $Log: ucopy2.s,v $
-; Revision 1.1.1.1 1996/02/15 17:50:31 mclareni
-; Kernlib
-;
-;
- .TITLE UCOPY2
-;++
-; CERN PROGLIB# V301 UCOPY .VERSION KERNVAX 2.21 870121
-; ORIG. J. VORBRUEGGEN 30/4/83, CORR. 5/12/85 FOR R0=65536
-;
-; SUBROUTINE UCOPY(A, B, N)
-; Copy source to destination array with count of longwords
-;
-; Register usage:
-; N <= 16383 N > 16383
-; R0 byte count (used by MOVC3)
-; R1 | source address
-; R2 | (used by MOVC3)
-; R3 | (used by MOVC3) destination address
-; R4 | (used by MOVC3)
-; R5 | (used by MOVC3)
-; R6 not used = 65535
-; R7 not used updated byte count
-;
-; NOTE: - Entries UCOPY and UCOPY2 are equivalent, as the
-; VAX hardware takes care of overlap in most cases.
-; - R6/R7 are only saved if necessary (i. e. N > 16383)
-;--
- .IDENT /01/
- .PSECT $CODE,PIC,CON,REL,LCL,SHR,EXE,RD,NOWRT,LONG
- .ENTRY UCOPY2,^M<R2,R3,R4,R5>
- BRB GOON
- .ENTRY UCOPY,^M<R2,R3,R4,R5>
-GOON: NOP
-
- ASHL #2, at 12(AP),R0 ; Make count of bytes (*4)
- BLEQ 10$ ; Return if <= 0
- CMPL #65535,R0 ; Too large for one MOVC3 ?
- BLSSU 20$
- MOVC3 R0, at 4(AP), at 8(AP) ; Normal case.
-10$: RET
-
-20$: MOVQ R6,-(SP) ; Fastest way of saving R6/R7
- MOVAL @4(AP),R1 ; Get address of source
- MOVL #65535,R6 ; Max. # of bytes for MOVC3
- MOVL R0,R7 ; Save count from destruction
- MOVAL @8(AP),R3 ; Get address of destination
- CMPL R3,R1 ; Check relative position of
- ; source and destination
- BEQL 10$ ; Nothing to do.
- BGTRU 50$ ; Special case - do move from end
-
-30$: MOVC3 R6,(R1),(R3) ; Move a 64KB bite
- ACBL R6,#-65535,R7,30$ ; Any more ?
- BEQL 40$ ; Already finished ?
- MOVC3 R7,(R1),(R3) ; Move the rest
-40$: MOVQ (SP)+,R6 ; Restore registers
- RET
-
-50$: SUBL2 R6,R7 ; Set pointer to first bite
-
-60$: ADDL3 R7,4(AP),R1 ; Adjust source address
- ADDL3 R7,8(AP),R3 ; and destination address
- MOVC3 R6,(R1),(R3) ; Move a 64KB bite
- ACBL #0,#-65535,R7,60$ ; Any more ?
- ADDL2 R6,R7 ; Correct counter
- MOVC3 R7, at 4(AP), at 8(AP) ; Move the last bite
- MOVQ (SP)+,R6 ; Restore registers
- RET ; Done.
- .END
diff --git a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/ucopyn.s b/src/packlib/kernlib/kerngen/vmscode/vaxmlan/ucopyn.s
deleted file mode 100644
index 71236c7..0000000
--- a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/ucopyn.s
+++ /dev/null
@@ -1,36 +0,0 @@
-;
-; $Id: ucopyn.s,v 1.1.1.1 1996/02/15 17:50:31 mclareni Exp $
-;
-; $Log: ucopyn.s,v $
-; Revision 1.1.1.1 1996/02/15 17:50:31 mclareni
-; Kernlib
-;
-;
- .TITLE UCOPYN
-;++
-; CERN PROGLIB# V301 UCOPYN .VERSION KERNVAX 2.05 830901
-; ORIG. J. VORBRUEGGEN 18/5/83
-;
-; SUBROUTINE UCOPYN(IA, IX, N)
-; IX(I) = - IA(I) , I=1,...,N
-;
-; Register usage:
-; R0, R1 addresses of IA(I) and IX(I), resp.
-; R2 counter from N to 1
-;
-; Note: For REAL*4 arrays use VCOPYN of F121.
-;--
- .IDENT /01/
- .PSECT $CODE,PIC,CON,REL,LCL,SHR,EXE,RD,NOWRT,LONG
- .ENTRY UCOPYN,^M<R2>
-
- MOVL @12(AP),R2 ; get counter
- BLEQ 20$ ; return if <= 0
- MOVAL @4(AP),R0 ; get base addresses of IA and IX
- MOVAL @8(AP),R1
-
-10$: MNEGL (R0)+,(R1)+ ; copy the negative value
- SOBGTR R2,10$ ; and loop
-20$: RET
-
- .END
diff --git a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/uctoh.s b/src/packlib/kernlib/kerngen/vmscode/vaxmlan/uctoh.s
deleted file mode 100644
index 89f3cbe..0000000
--- a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/uctoh.s
+++ /dev/null
@@ -1,85 +0,0 @@
-;
-; $Id: uctoh.s,v 1.1.1.1 1996/02/15 17:50:31 mclareni Exp $
-;
-; $Log: uctoh.s,v $
-; Revision 1.1.1.1 1996/02/15 17:50:31 mclareni
-; Kernlib
-;
-;
- .TITLE UCTOH
-;
-; CERN PROGLIB# M409 UCTOH .VERSION KERNVAX 2.21 870121
-; ORIG. 21/9/82, JZ, CERN
-;
-; CALL UCTOH (AVC,XVM,NPW,N) CHARACTER TO HOLLERITH AN
-;
- .ENTRY UCTOH,^M<IV,R2,R3,R4,R5>
- MOVL @16(AP),R4 ; R4 = N
- BLEQ 99$ ; --> EXIT IF N .LE. 0
- MOVAL @4(AP),R1 ; R1 = ADR(D FOR AVC) OR ADR(AVC)
- MOVAL @8(AP),R3 ; R3 = ADR(XVM)
- CMPB #14,2(R1) ; CHECK BYTE 3 IN DESCR IS =14
- BNEQ 10$
- CMPB #8,3(R1) ; CHECK BYTE 4 IN DESCR IS <8
- BLEQ 10$
- MOVAL @4(R1),R1 ; R1 = ADR(AVC) FROM DESCIPTOR
-10$: MOVL #^A/ /,R5 ; R5 = 4 BLANKS
- MOVL @12(AP),R0 ; R0 = NPW
- CMPL R0,#4 ; CHECK NPW .GE. 4
- BGEQ 41$
- CMPL R0,#2 ; CHECK NPW = 2 OR 3
- BEQL 21$
- BGEQ 31$
-;
-; NPW = 1
-11$:
- MOVL R5,R0 ; FIRST CLEAR LWORD
- MOVB (R1)+,R0 ; AND PUT CHAR IN FIRST BYTE
- MOVL R0,(R3)+ ; STORE LWORD
- SOBGTR R4,11$ ; NEXT CHAR
- JMP 99$
-;
-; NPW = 4
-41$:
- ADDL3 #3,R4,R2 ; R2 = NPW + 3
- ASHL #-2,R2,R2 ; /4
- ASHL #2,R2,R2 ; *4
- MOVC5 R4,(R1),R5,R2,(R3)
-;
-99$: RET
-;
-; NPW = 2
-21$:
- ASHL #-1,R4,R2 ; R2 = R4/2
- BEQL 11$
- ASHL #1,R2,R0
- SUBL2 R0,R4 ; R4 = 0/1 TRAILING CHAR
-24$: MOVL R5,R0 ; FIRST CLEAR LWORD
- MOVW (R1)+,R0 ; AND COPY 2 BYTES
- MOVL R0,(R3)+ ; STORE LWORD
- SOBGTR R2,24$ ; NEXT
- TSTL R4 ; CHECK IF 1 TRAILING CHAR
- BNEQ 37$
- JMP 99$
-;
-; NPW = 3
-31$:
- DIVL3 #3,R4,R2 ; R2 = R4/3
- BEQL 21$
- MULL3 #3,R2,R0
- SUBL2 R0,R4 ; R4 = 0/1/2 TRAILING CHARS
-34$: MOVL R5,R0 ; FIRST CLEAR LWORD
- MOVB (R1)+,R0 ; AND COPY 1 BYT
- ROTL #-8,R0,R0
- MOVW (R1)+,R0 ; AND COPY 2 BYTES
- ROTL #8,R0,(R3)+ ; ROTATE AND STORE LWORD
- SOBGTR R2,34$ ; NEXT
- CMPL R4,#1 ; CHECK IF 0/1/2 TRAILING CHAR
- BLSS 99$
- BEQL 37$
- MOVW (R1),R5
- JMP 39$
-37$: MOVB (R1),R5
-39$: MOVL R5,(R3) ; STORE INCOMPLETE WORD
- JMP 99$
- .END
diff --git a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/uctoh1.s b/src/packlib/kernlib/kerngen/vmscode/vaxmlan/uctoh1.s
deleted file mode 100644
index 93d1688..0000000
--- a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/uctoh1.s
+++ /dev/null
@@ -1,38 +0,0 @@
-;
-; $Id: uctoh1.s,v 1.1.1.1 1996/02/15 17:50:31 mclareni Exp $
-;
-; $Log: uctoh1.s,v $
-; Revision 1.1.1.1 1996/02/15 17:50:31 mclareni
-; Kernlib
-;
-;
- .TITLE UCTOH1
-;++
-; CERN PROGLIB# M409 UCTOH1 .VERSION KERNVAX 1.13 820606
-; ORIG. 4/6/82, JZ, CERN
-; MOD. J.VORBRUEGGEN 31/5/83
-;
-; SUBROUTINE UCTOH1(AVC, XVM, N)
-; Convert the N bytes in AVC to XVM in 1H format;
-; check first whether AVC is pssed by descriptor
-; (real CHARACTER data) or by reference (anything else).
-;--
- .IDENT /01/
- .PSECT $CODE,PIC,CON,REL,LCL,SHR,EXE,RD,NOWRT,LONG
- .ENTRY UCTOH1,^M<R2,R3>
-
- MOVL @12(AP),R0 ; R0 = N
- BLEQ 99$ ; --> EXIT IF N .LE. 0
- MOVAL @4(AP),R2 ; R2 = ADR(D FOR AVC) OR ADR(AVC)
- MOVAL @8(AP),R3 ; R3 = ADR(XVM)
- CMPB #14,2(R2) ; CHECK BYTE 3 IN DESCR IS =14
- BNEQ 24$
- CMPB #8,3(R2) ; CHECK BYTE 4 IN DESCR IS <8
- BLEQ 24$
- MOVAL @4(R2),R2 ; R2 = ADR(AVC) FROM DESCIPTOR
-
-24$: MOVL #^A/ /,(R3)+ ; FIRST CLEAR WORD
- MOVB (R2)+,-4(R3) ; AND PUT CHAR IN FIRST BYTE
- SOBGTR R0,24$ ; NEXT CHAR
-99$: RET
- .END
diff --git a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/ufill.s b/src/packlib/kernlib/kerngen/vmscode/vaxmlan/ufill.s
deleted file mode 100644
index 6e5cea4..0000000
--- a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/ufill.s
+++ /dev/null
@@ -1,36 +0,0 @@
-;
-; $Id: ufill.s,v 1.1.1.1 1996/02/15 17:50:31 mclareni Exp $
-;
-; $Log: ufill.s,v $
-; Revision 1.1.1.1 1996/02/15 17:50:31 mclareni
-; Kernlib
-;
-;
- .TITLE UFILL
-;++
-; CERN PROGLIB# V300 UFILL .VERSION KERNVAX 2.05 830901
-; ORIG. J. VORBRUEGGEN 30/4/83
-;
-; SUBROUTINE UFILL(A, JL, JN, STUFF)
-; Preset array from element JL to JN with STUFF
-;
-; Register usage:
-; R0 address of current array element
-; R1 = STUFF
-; R2 counter from JN-JL to zero
-;--
- .IDENT /01/
- .PSECT $CODE,PIC,CON,REL,LCL,SHR,EXE,RD,NOWRT,LONG
- .ENTRY UFILL,^M<R2>
-
- MOVAL @4(AP),R0 ; get base address of A
- MOVL @8(AP),R1 ; get JL
- MOVAL -4(R0)[R1],R0 ; compute address of A(JL)
- SUBL3 R1, at 12(AP),R2 ; count of longwords to be filled
- MOVL @16(AP),R1 ; get STUFF
-
-10$: MOVL R1,(R0)+ ; fill
- SOBGEQ R2,10$ ; and loop
- RET
-
- .END
diff --git a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/uh1toc.s b/src/packlib/kernlib/kerngen/vmscode/vaxmlan/uh1toc.s
deleted file mode 100644
index 3fcca7f..0000000
--- a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/uh1toc.s
+++ /dev/null
@@ -1,38 +0,0 @@
-;
-; $Id: uh1toc.s,v 1.1.1.1 1996/02/15 17:50:31 mclareni Exp $
-;
-; $Log: uh1toc.s,v $
-; Revision 1.1.1.1 1996/02/15 17:50:31 mclareni
-; Kernlib
-;
-;
- .TITLE UH1TOC
-;++
-; CERN PROGLIB# M409 UH1TOC .VERSION KERNVAX 1.13 820606
-; ORIG. 4/6/82, JZ, CERN
-; MOD. J.VORBRUEGGEN 31/5/83
-;
-; SUBROUTINE UH1TOC(AVM, XVC, N)
-; Convert the data in 1H format in AVM to XVC, checking whether
-; XVC is passed by descriptor (real CHARACTER data) or by
-; reference (anything else).
-;--
- .IDENT /01/
- .PSECT $CODE,PIC,CON,REL,LCL,SHR,EXE,RD,NOWRT,LONG
- .ENTRY UH1TOC,^M<R2,R3>
-
- MOVL @12(AP),R0 ; R0 = N
- BLEQ 99$ ; --> EXIT IF N .LE. 0
- MOVAL @4(AP),R3 ; R3 = ADR(AVM)
- MOVAL @8(AP),R2 ; R2 = ADR(D FOR XVC) OR ADR(XVC)
- CMPB #14,2(R2) ; CHECK BYTE 3 IN DESCR IS =14
- BNEQ 24$
- CMPB #8,3(R2) ; CHECK BYTE 4 IN DESCR IS <8
- BLEQ 24$
- MOVAL @4(R2),R2 ; R2 = ADR(XVC) FROM DESCIPTOR
-
-24$: MOVB (R3),(R2)+ ; GET CHAR AND BUNCH IT
- ADDL2 #4,R3 ; SKIP TO NEXT WORD
- SOBGTR R0,24$ ; NEXT CHAR
-99$: RET
- .END
diff --git a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/uhtoc.s b/src/packlib/kernlib/kerngen/vmscode/vaxmlan/uhtoc.s
deleted file mode 100644
index faa2acc..0000000
--- a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/uhtoc.s
+++ /dev/null
@@ -1,72 +0,0 @@
-;
-; $Id: uhtoc.s,v 1.1.1.1 1996/02/15 17:50:31 mclareni Exp $
-;
-; $Log: uhtoc.s,v $
-; Revision 1.1.1.1 1996/02/15 17:50:31 mclareni
-; Kernlib
-;
-;
- .TITLE UHTOC
-;
-; CERN PROGLIB# M409 UHTOC .VERSION KERNVAX 2.21 870121
-; ORIG. 22/9/82, JZ, CERN
-;
-; CALL UHTOC (AVM,NPW,XVC,N) HOLLERITH AN TO CHARACTER
-;
- .ENTRY UHTOC,^M<IV,R2,R3,R4,R5>
- MOVL @16(AP),R4 ; R4 = N
- BLEQ 99$ ; --> EXIT IF N .LE. 0
- MOVAL @12(AP),R3 ; R3 = ADR(D FOR XVC) OR ADR(XVC)
- MOVAL @4(AP),R1 ; R1 = ADR(AVM)
- CMPB #14,2(R3) ; CHECK BYTE 3 IN DESCR IS =14
- BNEQ 10$
- CMPB #8,3(R3) ; CHECK BYTE 4 IN DESCR IS <8
- BLEQ 10$
- MOVAL @4(R3),R3 ; R3 = ADR(XVC) FROM DESCIPTOR
-10$: MOVL @8(AP),R0 ; R0 = NPW
- CMPL R0,#4 ; CHECK NPW .GE. 4
- BGEQ 41$
- CMPL R0,#2 ; CHECK NPW = 2 OR 3
- BEQL 21$
- BGEQ 31$
-;
-; NPW = 1
-11$:
- MOVB (R1),(R3)+ ; COPY 1 BYTE
- ADDL2 #4,R1 ; BUMP SOURCE ADR
- SOBGTR R4,11$ ; NEXT CHAR
- BRB 99$
-;
-; NPW = 4
-41$:
- MOVC3 R4,(R1),(R3)
-;
-99$: RET
-;
-; NPW = 2
-21$:
- ASHL #-1,R4,R2 ; R2 = R4/2
- BEQL 11$
- ASHL #1,R2,R0
- SUBL2 R0,R4 ; R4 = 0/1 TRAILING CHAR
-24$: MOVW (R1),(R3)+ ; COPY 2 BYTES
- ADDL2 #4,R1 ; BUMP SOURCE ADR
- SOBGTR R2,24$ ; NEXT
- TSTL R4 ; CHECK IF 1 TRAILING CHAR
- BNEQ 11$
- JMP 99$
-;
-; NPW = 3
-31$:
- DIVL3 #3,R4,R2 ; R2 = R4/3
- BEQL 21$
- MULL3 #3,R2,R0
- SUBL2 R0,R4 ; R4 = 0/1/2 TRAILING CHARS
-34$: MOVB (R1)+,(R3)+ ; COPY 1 BYT
- MOVW (R1)+,(R3)+ ; AND COPY 2 BYTES
- INCL R1 ; BUMP SOURCE ADR
- SOBGTR R2,34$ ; NEXT
- TSTL R4 ; CHECK IF TRAILING CHARS
- BNEQ 41$
- JMP 99$
- .END
diff --git a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/upkbyt.s b/src/packlib/kernlib/kerngen/vmscode/vaxmlan/upkbyt.s
deleted file mode 100644
index 7a976a6..0000000
--- a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/upkbyt.s
+++ /dev/null
@@ -1,66 +0,0 @@
-;
-; $Id: upkbyt.s,v 1.1.1.1 1996/02/15 17:50:31 mclareni Exp $
-;
-; $Log: upkbyt.s,v $
-; Revision 1.1.1.1 1996/02/15 17:50:31 mclareni
-; Kernlib
-;
-;
- .TITLE UPKBYT
-;++
-; CERN PROGLIB# M422 UPKBYT .VERSION KERNVAX 2.05 830901
-; ORIG. J. VORBRUEGGEN 10/5/83
-;
-; SUBROUTINE UPKBYT(A, JA, IY, N, MPACK)
-; Unpack the N bytes from A, staring at the JA'th byte,
-; into the array of small integers starting at IY.
-;
-; Bytes are described by their length (in bits) NBITS (MPACK(1))
-; and their number per longword INWORD (MPACK(2)).
-; NBITS = 0 is interpreted as a default value of NBITS = 1 and INWORD = 32.
-; Callers of UPKBYT assume the first byte in A to be JA = 1;
-; internally, however, all counters concerning bytes start at 0.
-;
-; Register usage:
-; R0 = NBITS
-; R1 = INWORD
-; R2 base address of bit field (=byte)
-; R3 byte number in current longword (from 0 to INWORD-1)
-; R4 position of bit field (from 0 to (INWORD-1)*NBITS)
-; R5 updated address in IY
-; R6 first used as scratch register, then counter from N to 1
-;--
- .IDENT /01/
- .PSECT $CODE,PIC,CON,REL,LCL,SHR,EXE,RD,NOWRT,LONG
- .ENTRY UPKBYT,^M<R2,R3,R4,R5,R6>
-
- MOVAL @20(AP),R6 ; get base address of MPACK
- MOVL (R6),R0 ; save NBITS
- BEQL 10$ ; default values required ?
- MOVL 4(R6),R1 ; no, save INWORD
- BRB 20$ ; and skip
-10$: MOVL #1,R0 ; yes, NBITS = 1
- MOVL #32,R1 ; and INWORD = 32
-
-20$: MOVL @8(AP),R6 ; get byte number
- DECL R6 ; change it to internal counting
- DIVL3 R1,R6,R2 ; compute longword offset
- MULL3 R1,R2,R4 ; number of bytes up to offset
- SUBL3 R4,R6,R3 ; byte number
- MULL3 R0,R3,R4 ; finally, position of first bit
- MOVAL @12(AP),R5 ; get base address of IY
- MOVAL @4(AP)[R2],R2 ; compute base address of bit field
- MOVL @16(AP),R6 ; get counter
-
-30$: EXTZV R4,R0,(R2),(R5)+ ; extract a byte
- INCL R3 ; JB = JB + 1
- CMPL R3,R1 ; JB >= INWORD ?
- BGEQ 40$
- ADDL2 R0,R4 ; no, just update position
- BRB 50$ ; and skip
-40$: ADDL2 #4,R2 ; yes, update base address
- CLRQ R3 ; reset position and byte number
-50$: SOBGTR R6,30$ ; and loop
- RET
-
- .END
diff --git a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/upkch.s b/src/packlib/kernlib/kerngen/vmscode/vaxmlan/upkch.s
deleted file mode 100644
index b8a11be..0000000
--- a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/upkch.s
+++ /dev/null
@@ -1,145 +0,0 @@
-;
-; $Id: upkch.s,v 1.1.1.1 1996/02/15 17:50:31 mclareni Exp $
-;
-; $Log: upkch.s,v $
-; Revision 1.1.1.1 1996/02/15 17:50:31 mclareni
-; Kernlib
-;
-;
- .TITLE UPKCH
-;++
-; CERN PROGLIB# M427 UPKCH .VERSION KERNVAX 2.32 890926
-; ORIG. J. VORBRUEGGEN 18/5/83
-; MOD. JV 8/10/83, FCA 26/09/89
-;
-; SUBROUTINE UPKCH(CHAR, INT, N, IPAR)
-; Unpack the N bytes in CHAR into the array INT.
-; Bytes are described by IPAR in the following way:
-;
-; IPAR(1) (= NBITS) # of bits per byte
-; IPAR(2) (= NCHAR) # of bytes per zone; if zero, maximum is used
-; IPAR(3) (= NZONE) # of bits per zone; if zero, set to 32
-; IPAR(4) (= LBITS) # of leading bits of each zone to be ignored
-;
-; Bits are numbered from left to right, starting with 1;
-; bytes crossing word boundaries are discontinuous!
-; Because of this, NZONE = 32 is treated seperately.
-; If the specified number of bytes won't fit into a field
-; of length NZONE-LBITS, NCHAR is set to the maximum that will.
-; On return, the first longword of COMMON /SLATE/ contains the number
-; of longwords used in CHAR, not including trailing bits of last zone.
-;
-; Register usage:
-; R0 counter from N to 1
-; R1 counter from NCHAR to 1
-; R2 = NZONE
-; R3 = NBITS
-; R4 = LBITS
-; R5 = NCHAR (temporarily used for address of IPAR)
-; R6 address of CHAR(NWORD)
-; R7 address of next integer to receive a byte
-; R8 position of LSB of current byte
-;
-; If NZONE = 32,
-; R9 position of LSB of first byte in longword
-; R10 not used
-; R11 not used
-;
-; If NZONE <> 32,
-; R9 if byte spans longwords, contains # of bits left for this word
-; R10 if byte spans longwords, contains # of bits for next longword
-; R11 # of bits to be skipped between two zones
-;
-; R9 is used as scratch register for calculations in both cases.
-; R10/R11 are saved only if needed (i. e. NZONE <> 32).
-;--
- .IDENT /01/
- .PSECT $CODE,PIC,CON,REL,LCL,SHR,EXE,RD,NOWRT,LONG
- .ENTRY UPKCH,^M<R2,R3,R4,R5,R6,R7,R8,R9>
-
- MOVL @12(AP),R0 ; get counter
- BGTR 10$ ; continue if > 0
- RET ; else return
-10$: MOVAL @16(AP),R5 ; get base address of IPAR
- MOVAL @4(AP),R6 ; get base address of CHAR
- MOVAL @8(AP),R7 ; and INT
- MOVL 8(R5),R2 ; get NZONE
- BNEQ 20$ ; default needed ?
- MOVL #32,R2 ; yes, NZONE = 32
-20$: MOVL (R5),R3 ; get NBITS
- MOVL 12(R5),R4 ; and LBITS
- MOVL 4(R5),R5 ; and NCHAR
- BEQL 30$ ; default needed ?
- MULL3 R3,R5,R9 ; no, check for valid arguments
- ADDL2 R4,R9 ; compute NBITS*NCHAR+LBITS
- CMPL R9,R2 ; do they fit into NZONE bits ?
- BLEQ 40$ ; if not, set NCHAR to maximum
-30$: SUBL3 R4,R2,R9 ; compute # of usable bits
- DIVL3 R3,R9,R5 ; divide result by size of byte
-40$: MOVL #1,NWORD ; initialize NWORD
- SUBL3 R4,#32,R8 ; compute pointer to end of 1st byte
- CMPL #32,R2 ; zone of one longword ?
- BNEQ NOTWRD
- ; we get here if that's so
-WORD: SUBL2 R3,R8 ; compute position of 1st byte in zone
- MOVL R8,R9 ; save it for later use
- BRB 30$ ; start the loop correctly
-
-10$: DECL R1 ; any more byes for this zone ?
- BEQL 20$
- SUBL2 R3,R8 ; yes, update pointer
- EXTZV R8,R3,(R6),(R7)+ ; unpack one byte
- SOBGTR R0,10$ ; and loop
- RET
- ; new zone:
-20$: ADDL2 #4,R6 ; update address in CHAR
- INCL NWORD ; count the longword
- MOVL R9,R8 ; set up position of 1st byte
-30$: MOVL R5,R1 ; initialize byte counter
- EXTZV R8,R3,(R6),(R7)+ ; unpack one byte | repeated
- SOBGTR R0,10$ ; and loop | for speed
- RET
- ; we get here if everything's possible
-NOTWRD: MOVQ R10,-(SP) ; save the two registers
- MULL3 R3,R5,R9 ; compute # of bits used by bytes
- SUBL3 R9,R2,R11 ; compute # of bits between zones
-
-10$: MOVL R5,R1 ; initialize byte counter
- TSTL R8 ; position negative <=> new longword ?
- BGEQ 30$
-20$: ADDL2 #4,R6 ; yes, update address in CHAR
- INCL NWORD ; and take account of that
- ADDL2 #32,R8 ; correct our position
- BLSS 20$ ; another longword to skip ?
-
-30$: DECL R1 ; any more bytes for this zone ?
- BLSS 40$
- SUBL2 R3,R8 ; yes, update position
- BLSS 50$ ; does byte span longwords ?
- EXTZV R8,R3,(R6),(R7)+ ; no, unpack one byte
- SOBGTR R0,30$ ; and loop
- MOVQ (SP)+,R10 ; restore registers
- RET
-
-40$: SUBL2 R11,R8 ; skip trailing and leading bits
- BRB 10$ ; and start with new zone
-
-50$: MOVL R8,R9 ; save position
- MNEGL R8,R10 ; compute # of bits in next longword
- ADDL2 #32,R8 ; correct position
- ADDL2 #4,R6 ; update address in CHAR
- INCL NWORD ; update NWORD
- EXTZV R8,R10,(R6),(R7)+ ; extract lower part of byte
- ADDL2 R3,R9 ; any bits left ?
- BEQL 60$
- INSV -4(R6),R10,R9,-4(R7) ; yes, insert them
-60$: SOBGTR R0,30$ ; loop
- MOVQ (SP)+,R10 ; restore registers
- RET
-
- .PSECT SLATE,PIC,OVR,REL,GBL,SHR,NOEXE,RD,WRT,LONG
-
-NWORD: .BLKL 1
-RESERV: .BLKL 39
-
- .END
diff --git a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/uswop.s b/src/packlib/kernlib/kerngen/vmscode/vaxmlan/uswop.s
deleted file mode 100644
index 588c847..0000000
--- a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/uswop.s
+++ /dev/null
@@ -1,36 +0,0 @@
-;
-; $Id: uswop.s,v 1.1.1.1 1996/02/15 17:50:31 mclareni Exp $
-;
-; $Log: uswop.s,v $
-; Revision 1.1.1.1 1996/02/15 17:50:31 mclareni
-; Kernlib
-;
-;
- .TITLE USWOP
-;++
-; CERN PROGLIB# V303 USWOP .VERSION KERNVAX 2.05 830901
-; ORIG. J. VORBRUEGGEN 27/5/83
-;
-; SUBROUTINE USWOP(A, B, N)
-; Exchange the vectors A and B, each of length N.
-;
-; Register usage:
-; R0, R1 addresses of A(I) and B(I), resp.
-; R2 buffer for A(I)
-; R3 counter from N to 1
-;--
- .IDENT /01/
- .PSECT $CODE,PIC,CON,REL,LCL,SHR,EXE,RD,NOWRT,LONG
- .ENTRY USWOP,^M<R2,R3>
-
- MOVL @12(AP),R3 ; get counter
- BLEQ 20$ ; return if <= 0
- MOVAL @4(AP),R0 ; get base address of A
- MOVAL @8(AP),R1 ; and B
-10$: MOVL (R0),R2 ; buffer A(I)
- MOVL (R1),(R0)+ ; copy B(I) to A(I)
- MOVL R2,(R1)+ ; copy buffer to B(I)
- SOBGTR R3,10$ ; and loop
-20$: RET
-
- .END
diff --git a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/uzero.s b/src/packlib/kernlib/kerngen/vmscode/vaxmlan/uzero.s
deleted file mode 100644
index 95108c9..0000000
--- a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/uzero.s
+++ /dev/null
@@ -1,53 +0,0 @@
-;
-; $Id: uzero.s,v 1.1.1.1 1996/02/15 17:50:31 mclareni Exp $
-;
-; $Log: uzero.s,v $
-; Revision 1.1.1.1 1996/02/15 17:50:31 mclareni
-; Kernlib
-;
-;
- .TITLE UZERO
-;++
-; CERN PROGLIB# V300 UZERO .VERSION KERNVAX 2.18 860429
-; ORIG. J. VORBRUEGGEN 30/4/83
-;
-; SUBROUTINE UZERO(A, JL, JN)
-; Zero array from element JL to JN
-;
-; Register usage:
-; JN-JL <= 16383 JN-JL > 16383
-; R0 byte offset to A(JL) from A(1) (used by MOVC5)
-; R1 byte count dummy source address
-; R2 dummy source address (used by MOVC5)
-; R3 | destination address
-; R4 | (used by MOVC5) (used by MOVC5)
-; R5 | (used by MOVC5)
-; R6 not used = 65535
-; R7 not used updated byte count
-;
-; NOTE: R6/R7 are only saved if needed (i. e. JN-JL > 16383)
-;--
- .IDENT /01/
- .PSECT $CODE,PIC,CON,REL,LCL,SHR,EXE,RD,NOWRT,LONG
- .ENTRY UZERO,^M<R2,R3,R4,R5>
-
- ASHL #2, at 8(AP),R0 ; Compute byte offset to A(JL)
- SUBL2 #4,R0
- ASHL #2, at 12(AP),R1 ; Compute byte offset to A(JN+1)
- SUBL2 R0,R1 ; # of bytes to zero
- CMPL #65535,R1 ; Too large for MOVC5 ?
- BLSSU 10$
- MOVC5 #0,(R2),#0,R1, at 4(AP)[R0]; Normal case.
- RET
-
-10$: MOVQ R6,-(SP) ; Fastest way of saving R6/R7
- MOVL #65535,R6 ; Max. # of bytes for MOVC5
- ADDL3 4(AP),R0,R3 ; Compute address of A(JL)
- MOVL R1,R7 ; Save count from destruction
-20$: MOVC5 #0,(R1),#0,R6,(R3) ; Zero one 64KB chunk
- ACBL R6,#-65535,R7,20$ ; Any more ?
- BEQL 30$ ; Already finished ?
- MOVC5 #0,(R1),#0,R7,(R3) ; No, zero the rest
-30$: MOVQ (SP)+,R6 ; Restore registers
- RET
- .END
diff --git a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/vadd.s b/src/packlib/kernlib/kerngen/vmscode/vaxmlan/vadd.s
deleted file mode 100644
index d839919..0000000
--- a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/vadd.s
+++ /dev/null
@@ -1,34 +0,0 @@
-;
-; $Id: vadd.s,v 1.1.1.1 1996/02/15 17:50:32 mclareni Exp $
-;
-; $Log: vadd.s,v $
-; Revision 1.1.1.1 1996/02/15 17:50:32 mclareni
-; Kernlib
-;
-;
- .TITLE VADD
-;++
-; CERN PROGLIB# F121 VADD .VERSION KERNVAX 2.05 830901
-; ORIG. J. VORBRUEGGEN 30/4/83
-;
-; SUBROUTINE VADD(A, B, X, N)
-; X(I) = A(I) + B(I) , I=1,...,N
-;
-; Register usage:
-; R0, R1, R2 addresses of A(I), B(I), and X(I), resp.
-; R3 counter from N to 1
-;--
- .IDENT /01/
- .PSECT $CODE,PIC,CON,REL,LCL,SHR,EXE,RD,NOWRT,LONG
- .ENTRY VADD,^M<R2,R3>
-
- MOVL @16(AP),R3 ; get counter
- BLEQ 20$ ; return if <= 0
- MOVAL @4(AP),R0 ; get base addresses of A, B, and X
- MOVAL @8(AP),R1
- MOVAL @12(AP),R2
-10$: ADDF3 (R0)+,(R1)+,(R2)+ ; add
- SOBGTR R3,10$ ; and loop
-20$: RET
-
- .END
diff --git a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/vasum.s b/src/packlib/kernlib/kerngen/vmscode/vaxmlan/vasum.s
deleted file mode 100644
index 05dec33..0000000
--- a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/vasum.s
+++ /dev/null
@@ -1,36 +0,0 @@
-;
-; $Id: vasum.s,v 1.1.1.1 1996/02/15 17:50:32 mclareni Exp $
-;
-; $Log: vasum.s,v $
-; Revision 1.1.1.1 1996/02/15 17:50:32 mclareni
-; Kernlib
-;
-;
- .TITLE VASUM
-;++
-; CERN PROGLIB# F121 VASUM .VERSION KERNVAX 2.05 830901
-; ORIG. J. VORBRUEGGEN 4/5/83
-;
-; FUNCTION VASUM(A, N)
-; Give sum of absolute values of A(I), I=1,...,N
-;
-; Register usage:
-; R0 sum
-; R1 absolute value of A(I)
-; R2 address of A(I)
-; R3 counter from N to 1
-;--
- .IDENT /01/
- .PSECT $CODE,PIC,CON,REL,LCL,SHR,EXE,RD,NOWRT,LONG
- .ENTRY VASUM,^M<R2,R3>
-
- CLRF R0 ; initialize sum
- MOVL @8(AP),R3 ; get counter
- BLEQ 20$ ; return if <= 0
- MOVAL @4(AP),R2 ; get base address of A
-10$: BICL3 #^X8000,(R2)+,R1 ; get absolute value of A(I)
- ADDF2 R1,R0 ; add it
- SOBGTR R3,10$ ; and loop
-20$: RET
-
- .END
diff --git a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/vbias.s b/src/packlib/kernlib/kerngen/vmscode/vaxmlan/vbias.s
deleted file mode 100644
index 82ed0c6..0000000
--- a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/vbias.s
+++ /dev/null
@@ -1,36 +0,0 @@
-;
-; $Id: vbias.s,v 1.1.1.1 1996/02/15 17:50:32 mclareni Exp $
-;
-; $Log: vbias.s,v $
-; Revision 1.1.1.1 1996/02/15 17:50:32 mclareni
-; Kernlib
-;
-;
- .TITLE VBIAS
-;++
-; CERN PROGLIB# F121 VBIAS .VERSION KERNVAX 2.05 830901
-; ORIG. J. VORBRUEGGEN 2/5/83
-;
-; SUBROUTINE VBIAS(A, ALPHA, X, N)
-; X(I) = A(I) + ALPHA , I=1,...,N
-;
-; Register usage:
-; R0 address of A(I)
-; R1 = ALPHA
-; R2 address of X(I)
-; R3 counter from N to 1
-;--
- .IDENT /01/
- .PSECT $CODE,PIC,CON,REL,LCL,SHR,EXE,RD,NOWRT,LONG
- .ENTRY VBIAS,^M<R2,R3>
-
- MOVL @16(AP),R3 ; get counter
- BLEQ 20$ ; return if <= 0
- MOVAL @4(AP),R0 ; get base address of A
- MOVL @8(AP),R1 ; get ALPHA
- MOVAL @12(AP),R2 ; get base address of X
-10$: ADDF3 (R0)+,R1,(R2)+ ; add
- SOBGTR R3,10$ ; and loop
-20$: RET
-
- .END
diff --git a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/vblank.s b/src/packlib/kernlib/kerngen/vmscode/vaxmlan/vblank.s
deleted file mode 100644
index 32ca64c..0000000
--- a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/vblank.s
+++ /dev/null
@@ -1,51 +0,0 @@
-;
-; $Id: vblank.s,v 1.1.1.1 1996/02/15 17:50:31 mclareni Exp $
-;
-; $Log: vblank.s,v $
-; Revision 1.1.1.1 1996/02/15 17:50:31 mclareni
-; Kernlib
-;
-;
- .TITLE VBLANK
-;++
-; CERN PROGLIB# F121 VBLANK .VERSION KERNVAX 2.18 860429
-; ORIG. J. VORBRUEGGEN 30/4/83
-;
-; SUBROUTINE VBLANK(X, N)
-; Preset array to blank with count of longwords
-;
-; Register usage:
-; N <= 16383 N > 16383
-; R0 byte count (used by MOVC5)
-; R1 dummy source address dummy source address
-; R2 | (used by MOVC5)
-; R3 | (used by MOVC5) destination address
-; R4 | (used by MOVC5)
-; R5 | (used by MOVC5)
-; R6 not used = 65535
-; R7 not used updated byte count
-;
-; NOTE: R6/R7 are only saved if necessary (i. e. N > 16383)
-;--
- .IDENT /01/
- .PSECT $CODE,PIC,CON,REL,LCL,SHR,EXE,RD,NOWRT,LONG
- .ENTRY VBLANK,^M<R2,R3,R4,R5>
-
- ASHL #2, at 8(AP),R0 ; Make byte count (*4)
- BLEQ 10$ ; Return if <= 0
- CMPL #65535,R0 ; Too large for one MOVC5 ?
- BLSSU 20$
- MOVC5 #0,(R1),#32,R0, at 4(AP) ; Normal case.
-10$: RET
-
-20$: MOVQ R6,-(SP) ; Fastest way of saving R6/R7
- MOVAL @4(AP),R3 ; Get address of source
- MOVL #65535,R6 ; Max. # of bytes for MOVC5
- MOVL R0,R7 ; Save count from destruction
-30$: MOVC5 #0,(R1),#32,R6,(R3) ; Preset one 64KB chunk
- ACBL R6,#-65535,R7,30$ ; Any more ?
- BEQL 40$ ; Already finished ?
- MOVC5 #0,(R1),#32,R7,(R3) ; No, preset the rest
-40$: MOVQ (SP)+,R6 ; Restore registers
- RET
- .END
diff --git a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/vcopyn.s b/src/packlib/kernlib/kerngen/vmscode/vaxmlan/vcopyn.s
deleted file mode 100644
index 57bc0b7..0000000
--- a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/vcopyn.s
+++ /dev/null
@@ -1,34 +0,0 @@
-;
-; $Id: vcopyn.s,v 1.1.1.1 1996/02/15 17:50:32 mclareni Exp $
-;
-; $Log: vcopyn.s,v $
-; Revision 1.1.1.1 1996/02/15 17:50:32 mclareni
-; Kernlib
-;
-;
- .TITLE VCOPYN
-;++
-; CERN PROGLIB# F121 VCOPYN .VERSION KERNVAX 2.05 830901
-; ORIG. J. VORBRUEGGEN 4/5/83
-;
-; SUBROUTINE VCOPYN(A, X, N)
-; X(I) = - A(I) , I=1,...,N
-;
-; Register usage:
-; R0, R1 addresses of A(I) and X(I), resp.
-; R2 counter from N to 1
-;--
- .IDENT /01/
- .PSECT $CODE,PIC,CON,REL,LCL,SHR,EXE,RD,NOWRT,LONG
- .ENTRY VCOPYN,^M<R2>
-
- MOVL @12(AP),R2 ; get counter
- BLEQ 20$ ; return if <= 0
- MOVAL @4(AP),R0 ; get base addresses of A and X
- MOVAL @8(AP),R1
-
-10$: MNEGF (R0)+,(R1)+ ; copy the negative value
- SOBGTR R2,10$ ; and loop
-20$: RET
-
- .END
diff --git a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/vdot.s b/src/packlib/kernlib/kerngen/vmscode/vaxmlan/vdot.s
deleted file mode 100644
index 964bcf3..0000000
--- a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/vdot.s
+++ /dev/null
@@ -1,38 +0,0 @@
-;
-; $Id: vdot.s,v 1.1.1.1 1996/02/15 17:50:32 mclareni Exp $
-;
-; $Log: vdot.s,v $
-; Revision 1.1.1.1 1996/02/15 17:50:32 mclareni
-; Kernlib
-;
-;
- .TITLE VDOT
-;++
-; CERN PROGLIB# F121 VDOT .VERSION KERNVAX 2.05 830901
-; ORIG. J. VORBRUEGGEN 4/5/83
-;
-; FUNCTION VDOT(A, B, N)
-; Scalar product of N-dim. vectors A and B
-;
-; Register usage:
-; R0 product of A and B
-; R1 scratch register for multiplying
-; R2, R3 addresses of A(I) and B(I), resp.
-; R4 counter from N to 1
-;--
- .IDENT /01/
- .PSECT $CODE,PIC,CON,REL,LCL,SHR,EXE,RD,NOWRT,LONG
- .ENTRY VDOT,^M<R2,R3,R4>
-
- CLRF R0 ; initialize product
- MOVL @12(AP),R4 ; get counter
- BLEQ 20$ ; return if <= 0
- MOVAL @4(AP),R2 ; get base addresses of A and B
- MOVAL @8(AP),R3
-
-10$: MULF3 (R2)+,(R3)+,R1 ; multiply A(I) and B(I)
- ADDF2 R1,R0 ; add result to product
- SOBGTR R4,10$ ; and loop
-20$: RET
-
- .END
diff --git a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/vdotn.s b/src/packlib/kernlib/kerngen/vmscode/vaxmlan/vdotn.s
deleted file mode 100644
index a998035..0000000
--- a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/vdotn.s
+++ /dev/null
@@ -1,62 +0,0 @@
-;
-; $Id: vdotn.s,v 1.1.1.1 1996/02/15 17:50:32 mclareni Exp $
-;
-; $Log: vdotn.s,v $
-; Revision 1.1.1.1 1996/02/15 17:50:32 mclareni
-; Kernlib
-;
-;
- .TITLE VDOTN
-;++
-; CERN PROGLIB# F121 VDOTN .VERSION KERNVAX 2.05 830901
-; ORIG. J. VORBRUEGGEN 5/5/83
-;
-; FUNCTION VDOTN(A, B, N)
-; VDOTN = VDOT(A, B, N) / SQRT(VDOT(A, A, N)*VDOT(B, B, N))
-; (i. e. cosine of angle between A and B)
-;
-; A value of +/- 1 is returned if ABS(VDOTN) .GT. 1 (rounding error)
-;
-; Register usage:
-; R0, R1 sum of A(I)*A(I) and B(I)*B(I), resp.
-; R2, R3 addresses of A(I) and B(I), resp.
-; R4 sum of A(I)*B(I) (has to be saved across call to MTH$SQRT_R3)
-; R5 scratch register for multiplying
-; R6 counter from N to 1
-;--
- .IDENT /01/
- .PSECT $CODE,PIC,CON,REL,LCL,SHR,EXE,RD,NOWRT,LONG
- .ENTRY VDOTN,^M<R2,R3,R4,R5,R6>
-
- MOVL @12(AP),R6 ; get counter
- BLEQ 40$ ; return if <= 0
- MOVAL @4(AP),R2 ; get base address of A
- CLRQ R0 ; clear sum registers
- MOVAL @8(AP),R3 ; get base address of B
- CLRL R4 ; clear sum register
-
-10$: MULF3 (R2),(R3),R5 ; multiply A(I) and B(I)
- ADDF2 R5,R4 ; add result to sum
- MULF3 (R3),(R3)+,R5 ; dto. for B(I) and B(I)
- ADDF2 R5,R1
- MULF3 (R2),(R2)+,R5 ; dto. for A(I) and A(I)
- ADDF2 R5,R0
- SOBGTR R6,10$ ; and loop
-
- MULF2 R1,R0 ; multiply dividends
- JSB G^MTH$SQRT_R3 ; compute their square root
- DIVF3 R0,R4,R0 ; and divide scalar product by result
- BICL3 #^X8000,R0,R1 ; get absolute value of result
- CMPF #^F1.,R1 ; do we have a rounding error ?
- BGEQ 20$
- TSTF R0 ; yes, test sign of result
- BLSS 30$
- MOVF #^F1.,R0 ; positive, set VDOTN to +1.
-20$: RET
-30$: MOVF #^F-1.,R0 ; negative, set VDOTN to -1.
- RET
-
-40$: CLRF R0 ; return a function value of zero
- RET
-
- .END
diff --git a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/vdotn2.s b/src/packlib/kernlib/kerngen/vmscode/vaxmlan/vdotn2.s
deleted file mode 100644
index 10b6f5b..0000000
--- a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/vdotn2.s
+++ /dev/null
@@ -1,51 +0,0 @@
-;
-; $Id: vdotn2.s,v 1.1.1.1 1996/02/15 17:50:32 mclareni Exp $
-;
-; $Log: vdotn2.s,v $
-; Revision 1.1.1.1 1996/02/15 17:50:32 mclareni
-; Kernlib
-;
-;
- .TITLE VDOTN2
-;++
-; CERN PROGLIB# F121 VDOTN2 .VERSION KERNVAX 2.05 830901
-; ORIG. J. VORBRUEGGEN 5/5/83
-;
-; FUNCTION VDOTN2(A, B, N)
-; VDOTN2 = VDOT(A, B, N)**2 / (VDOT(A, A, N)*VDOT(B, B, N))
-; (i. e. square of cosine of angle between A and B)
-;
-; Register usage:
-; R0, R1, R2 sum of A(I)*B(I), A(I)*A(I), B(I)*B(I), resp.
-; R3 scratch register for multiplying
-; R4, R5 addresses of A(I) and B(I), resp.
-; R6 counter from N to 1
-;--
- .IDENT /01/
- .PSECT $CODE,PIC,CON,REL,LCL,SHR,EXE,RD,NOWRT,LONG
- .ENTRY VDOTN2,^M<R2,R3,R4,R5,R6>
-
- MOVL @12(AP),R6 ; get counter
- BLEQ 20$ ; return if <= 0
- MOVAL @4(AP),R4 ; get base address of A
- CLRQ R0 ; clear sum registers
- MOVAL @8(AP),R5 ; get base address of B
- CLRL R2 ; clear sum register
-
-10$: MULF3 (R4),(R5),R3 ; multiply A(I) and B(I)
- ADDF2 R3,R0 ; add result to sum
- MULF3 (R4),(R4)+,R3 ; dto. for A(I) and A(I)
- ADDF2 R3,R1
- MULF3 (R5),(R5)+,R3 ; dto. for B(I) and B(I)
- ADDF2 R3,R2
- SOBGTR R6,10$ ; and loop
-
- MULF2 R0,R0 ; compute square of scalar product
- MULF2 R2,R1 ; multiply dividends
- DIVF2 R1,R0 ; divide by result
- RET
-
-20$: CLRF R0 ; return a function value of zero
- RET
-
- .END
diff --git a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/vexcum.s b/src/packlib/kernlib/kerngen/vmscode/vaxmlan/vexcum.s
deleted file mode 100644
index ec09c76..0000000
--- a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/vexcum.s
+++ /dev/null
@@ -1,52 +0,0 @@
-;
-; $Id: vexcum.s,v 1.1.1.1 1996/02/15 17:50:32 mclareni Exp $
-;
-; $Log: vexcum.s,v $
-; Revision 1.1.1.1 1996/02/15 17:50:32 mclareni
-; Kernlib
-;
-;
- .TITLE VEXCUM
-;++
-; CERN PROGLIB# F121 VEXCUM .VERSION KERNVAX 2.05 830901
-; ORIG. J. VORBRUEGGEN 4/5/83
-;
-; SUBROUTINE VEXCUM(A, EX, N)
-; EX(1) = MIN(EX(1), A(I)) , I=1,...,N
-; EX(2) = MAX(EX(2), A(I)) , I=1,...,N
-; EX(3) = EX(3) + A(I) , I=1,...,N
-;
-; Register usage:
-; R0 minimum, initialized with EX(1)
-; R1 maximum, initialized with EX(2)
-; R2 cumulative sum, initialized with EX(3)
-; R3 address of A(I)
-; R4 base address of EX
-; R5 counter from N to 1
-;--
- .IDENT /01/
- .PSECT $CODE,PIC,CON,REL,LCL,SHR,EXE,RD,NOWRT,LONG
- .ENTRY VEXCUM,^M<R2,R3,R4,R5>
-
- MOVL @12(AP),R5 ; get counter
- BLEQ 40$ ; return if <= 0
- MOVAL @8(AP),R4 ; get base addresses of EX and A
- MOVAL @4(AP),R3
- MOVF (R4),R0 ; initialize minimum
- MOVF 4(R4),R1 ; maximum
- MOVF 8(R4),R2 ; sum
-
-10$: CMPF (R3),R0 ; new minimum ?
- BGEQ 20$
- MOVF (R3),R0 ; yes, save it
-20$: CMPF R1,(R3) ; new maximum ?
- BGEQ 30$
- MOVF (R3),R1 ; yes, save it
-30$: ADDF2 (R3)+,R2 ; update the sum
- SOBGTR R5,10$ ; and loop
-
- MOVQ R0,(R4) ; write back EX(1), EX(2) ...
- MOVL R2,8(R4) ; and EX(3)
-40$: RET
-
- .END
diff --git a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/vfill.s b/src/packlib/kernlib/kerngen/vmscode/vaxmlan/vfill.s
deleted file mode 100644
index 40ca2d9..0000000
--- a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/vfill.s
+++ /dev/null
@@ -1,35 +0,0 @@
-;
-; $Id: vfill.s,v 1.1.1.1 1996/02/15 17:50:31 mclareni Exp $
-;
-; $Log: vfill.s,v $
-; Revision 1.1.1.1 1996/02/15 17:50:31 mclareni
-; Kernlib
-;
-;
- .TITLE VFILL
-;++
-; CERN PROGLIB# F121 VFILL .VERSION KERNVAX 2.05 830901
-; ORIG. J. VORBRUEGGEN 30/4/83
-;
-; SUBROUTINE VFILL(X, N, ALPHA)
-; Preset with ALPHA the array X(I) , I=1,...,N
-;
-; Register usage:
-; R0 address of X(I)
-; R1 = ALPHA
-; R2 counter from N to 1
-;--
- .IDENT /01/
- .PSECT $CODE,PIC,CON,REL,LCL,SHR,EXE,RD,NOWRT,LONG
- .ENTRY VFILL,^M<R2>
-
- MOVL @8(AP),R1 ; get counter
- BLEQ 20$ ; return if <= 0
- MOVAL @4(AP),R0 ; get base address 0f X
- MOVL @12(AP),R2 ; get ALPHA
-
-10$: MOVL R2,(R0)+ ; fill
- SOBGTR R1,10$ ; and loop
-20$: RET
-
- .END
diff --git a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/vfix.s b/src/packlib/kernlib/kerngen/vmscode/vaxmlan/vfix.s
deleted file mode 100644
index 3d3f9cb..0000000
--- a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/vfix.s
+++ /dev/null
@@ -1,34 +0,0 @@
-;
-; $Id: vfix.s,v 1.1.1.1 1996/02/15 17:50:32 mclareni Exp $
-;
-; $Log: vfix.s,v $
-; Revision 1.1.1.1 1996/02/15 17:50:32 mclareni
-; Kernlib
-;
-;
- .TITLE VFIX
-;++
-; CERN PROGLIB# F121 VFIX .VERSION KERNVAX 2.05 830901
-; ORIG. J. VORBRUEGGEN 2/5/83
-;
-; SUBROUTINE VFIX(A, IX, N)
-; IX(I) = IFIX(A(I)) , I=1,...,N
-;
-; Register usage:
-; R0, R1 addresses of A(I) and IX(I), resp.
-; R2 counter from N to 1
-;--
- .IDENT /01/
- .PSECT $CODE,PIC,CON,REL,LCL,SHR,EXE,RD,NOWRT,LONG
- .ENTRY VFIX,^M<R2>
-
- MOVL @12(AP),R2 ; get counter
- BLEQ 20$ ; return if <= 0
- MOVAL @4(AP),R0 ; get base addresses of A and IX
- MOVAL @8(AP),R1
-
-10$: CVTFL (R0)+,(R1)+ ; convert to integer
- SOBGTR R2,10$ ; and loop
-20$: RET
-
- .END
diff --git a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/vfloat.s b/src/packlib/kernlib/kerngen/vmscode/vaxmlan/vfloat.s
deleted file mode 100644
index 01ab065..0000000
--- a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/vfloat.s
+++ /dev/null
@@ -1,34 +0,0 @@
-;
-; $Id: vfloat.s,v 1.1.1.1 1996/02/15 17:50:32 mclareni Exp $
-;
-; $Log: vfloat.s,v $
-; Revision 1.1.1.1 1996/02/15 17:50:32 mclareni
-; Kernlib
-;
-;
- .TITLE VFLOAT
-;++
-; CERN PROGLIB# F121 VFLOAT .VERSION KERNVAX 2.05 830901
-; ORIG. J. VORBRUEGGEN 2/5/83
-;
-; SUBROUTINE VFLOAT(IA, X, N)
-; X(I) = FLOAT(IA(I)) , I=1,...,N
-;
-; Register usage:
-; R0, R1 addresses of IA(I) and X(I), resp.
-; R2 counter from N to 1
-;--
- .IDENT /01/
- .PSECT $CODE,PIC,CON,REL,LCL,SHR,EXE,RD,NOWRT,LONG
- .ENTRY VFLOAT,^M<R2>
-
- MOVL @12(AP),R2 ; get counter
- BLEQ 20$ ; return if <= 0
- MOVAL @4(AP),R0 ; get base addresses of IA and X
- MOVAL @8(AP),R1
-
-10$: CVTLF (R0)+,(R1)+ ; convert to floating
- SOBGTR R2,10$ ; and loop
-20$: RET
-
- .END
diff --git a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/vline.s b/src/packlib/kernlib/kerngen/vmscode/vaxmlan/vline.s
deleted file mode 100644
index 856e8aa..0000000
--- a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/vline.s
+++ /dev/null
@@ -1,41 +0,0 @@
-;
-; $Id: vline.s,v 1.1.1.1 1996/02/15 17:50:32 mclareni Exp $
-;
-; $Log: vline.s,v $
-; Revision 1.1.1.1 1996/02/15 17:50:32 mclareni
-; Kernlib
-;
-;
- .TITLE VLINE
-;++
-; CERN PROGLIB# F121 VLINE .VERSION KERNVAX 2.05 830901
-; ORIG. J. VORBRUEGGEN 2/5/83
-;
-; SUBROUTINE VLINE(A, ALPHA, B, BETA, X, N)
-; X(I) = A(I) * ALPHA + B(I) * BETA , I=1,...,N
-;
-; Register usage:
-; R0, R2, R4 addresses of A(I), B(I), and X(I), resp.
-; R1, R3 = ALPHA and BETA, resp.
-; R5, R6 scratch registers for multiplying
-; R7 counter from N to 1
-;--
- .IDENT /01/
- .PSECT $CODE,PIC,CON,REL,LCL,SHR,EXE,RD,NOWRT,LONG
- .ENTRY VLINE,^M<R2,R3,R4,R5,R6,R7>
-
- MOVL @24(AP),R7 ; get counter
- BLEQ 20$ ; return if <= 0
- MOVAL @4(AP),R0 ; get argument addresses and values
- MOVL @8(AP),R1
- MOVAL @12(AP),R2
- MOVL @16(AP),R3
- MOVAL @20(AP),R4
-
-10$: MULF3 (R0)+,R1,R5 ; A(I)*ALPHA
- MULF3 (R2)+,R3,R6 ; B(I)*BETA
- ADDF3 R5,R6,(R4)+ ; return sum
- SOBGTR R7,10$ ; and loop
-20$: RET
-
- .END
diff --git a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/vmatl.s b/src/packlib/kernlib/kerngen/vmscode/vaxmlan/vmatl.s
deleted file mode 100644
index b91836e..0000000
--- a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/vmatl.s
+++ /dev/null
@@ -1,53 +0,0 @@
-;
-; $Id: vmatl.s,v 1.1.1.1 1996/02/15 17:50:32 mclareni Exp $
-;
-; $Log: vmatl.s,v $
-; Revision 1.1.1.1 1996/02/15 17:50:32 mclareni
-; Kernlib
-;
-;
- .TITLE VMATL
-;++
-; CERN PROGLIB# F121 VMATL .VERSION KERNVAX 2.05 830901
-; ORIG. J. VORBRUEGGEN 12/5/83
-;
-; SUBROUTINE VMATL(G, C, X, N, M)
-; X(J) = SUM( C(I)*G(I,J) ); I = 1,...,M; J = 1,...,N
-;
-; Array dimensions: C(M), G(M,N), X(N)
-; G is stored according to FORTRAN convention (i. e. column-wise).
-;
-; Register usage:
-; R0 sum register (contains X(J) at end of inner loop)
-; R1 scratch register for multiplying
-; R2 = M
-; R3 loop index I = 0,...,M-1 (enables use of indexing with R3)
-; R4 base address of C
-; R5 address of X(J)
-; R6 address of G(I,J)
-; R7 counter from N to 1
-;--
- .IDENT /01/
- .PSECT $CODE,PIC,CON,REL,LCL,SHR,EXE,RD,NOWRT,LONG
- .ENTRY VMATL,^M<IV,R2,R3,R4,R5,R6,R7>
-
- MOVL @20(AP),R2 ; get M
- BLEQ 30$ ; return if <= 0
- MOVAL @8(AP),R4 ; get base address of C
- MOVAL @12(AP),R5 ; get base address of X
- MOVAL @4(AP),R6 ; get base address of G
- MOVL @16(AP),R7 ; get N
-
-10$: CLRF R0 ; initialize sum
- CLRL R3 ; start loop of I
-
-20$: MULF3 (R4)[R3],(R6)+,R1 ; compute C(I)*G(I,J)
- ADDF2 R1,R0 ; add result to sum
- AOBLSS R2,R3,20$ ; and loop
-
- MOVF R0,(R5)+ ; store result
- SOBGTR R7,10$ ; and loop
-
-30$: RET
-
- .END
diff --git a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/vmatr.s b/src/packlib/kernlib/kerngen/vmscode/vaxmlan/vmatr.s
deleted file mode 100644
index 357ac7f..0000000
--- a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/vmatr.s
+++ /dev/null
@@ -1,59 +0,0 @@
-;
-; $Id: vmatr.s,v 1.1.1.1 1996/02/15 17:50:32 mclareni Exp $
-;
-; $Log: vmatr.s,v $
-; Revision 1.1.1.1 1996/02/15 17:50:32 mclareni
-; Kernlib
-;
-;
- .TITLE VMATR
-;++
-; CERN PROGLIB# F121 VMATR .VERSION KERNVAX 2.05 830901
-; ORIG. J. VORBRUEGGEN 12/5/83
-;
-; SUBROUTINE VMATR(A, G, V, N, M)
-; V(J) = SUM( G(J,I)*A(I) ); I = 1,...,N; J = 1,...,M
-;
-; Array dimensions: A(N), G(M,N), V(M)
-; G is stored according to FORTRAN convention (i. e. column-wise).
-;
-; Register usage:
-; R0 sum register (contains V(J) at end of inner loop)
-; R1 scratch register for multiplying
-; R2 = N
-; R3 loop index I = 0,...,N-1 (enables use of indexing with R3)
-; R4 base address of A
-; R5 = M
-; R6 loop index J = 1,...,M
-; R7 address of V(J)
-; R8 address of G(J,I)
-; R9 = 4*M, i. e. displacement in bytes from G(J,I) to G(J,I+1)
-;--
- .IDENT /01/
- .PSECT $CODE,PIC,CON,REL,LCL,SHR,EXE,RD,NOWRT,LONG
- .ENTRY VMATR,^M<R2,R3,R4,R5,R6,R7,R8,R9>
-
- MOVL @16(AP),R2 ; get N
- BLEQ 30$ ; return if <= 0
- MOVAL @4(AP),R4 ; get base address of A
- MOVL @20(AP),R5 ; get M
- MOVL #1,R6 ; start loop of J
- MOVAL @12(AP),R7 ; get base address of V
- ASHL #2,R5,R9 ; compute 4*M
- MOVAL @8(AP),R8 ; get base address of G
-
-10$: CLRF R0 ; initialize sum
- CLRL R3 ; start loop of I
-
-20$: MULF3 (R8),(R4)[R3],R1 ; compute G(J,I)*A(I)
- ADDF2 R1,R0 ; add result to sum
- ADDL2 R9,R8 ; compute address of G(J,I+1)
- AOBLSS R2,R3,20$ ; and loop
-
- MOVF R0,(R7)+ ; store result
- MOVAL @8(AP)[R6],R8 ; compute address of G(J+1,1)
- AOBLEQ R5,R6,10$ ; and loop
-
-30$: RET
-
- .END
diff --git a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/vmax.s b/src/packlib/kernlib/kerngen/vmscode/vaxmlan/vmax.s
deleted file mode 100644
index 045ef74..0000000
--- a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/vmax.s
+++ /dev/null
@@ -1,42 +0,0 @@
-;
-; $Id: vmax.s,v 1.1.1.1 1996/02/15 17:50:33 mclareni Exp $
-;
-; $Log: vmax.s,v $
-; Revision 1.1.1.1 1996/02/15 17:50:33 mclareni
-; Kernlib
-;
-;
- .TITLE VMAX
-;++
-; CERN PROGLIB# F121 VMAX .VERSION KERNVAX 2.05 830901
-; ORIG. J. VORBRUEGGEN 4/5/83
-;
-; FUNCTION VMAX(A, N)
-; Give maximum of A(I), I=1,...,N
-;
-; Register usage:
-; R0 maximum (initialized with A(1))
-; R1 address of A(I)
-; R2 counter from N to 1
-;--
- .IDENT /01/
- .PSECT $CODE,PIC,CON,REL,LCL,SHR,EXE,RD,NOWRT,LONG
- .ENTRY VMAX,^M<R2>
-
- MOVL @8(AP),R2 ; get counter
- BLEQ 40$ ; return if <= 0
- MOVAL @4(AP),R1 ; get base address of A
- MOVF (R1)+,R0 ; initialize maximum
- DECL R2 ; update counter
- BEQL 30$ ; return if N = 1
-
-10$: CMPF R0,(R1)+ ; new maximum ?
- BGEQ 20$
- MOVF -4(R1),R0 ; yes, save it
-20$: SOBGTR R2,10$ ; loop
-30$: RET
-
-40$: CLRF R0 ; return a function value of zero
- RET
-
- .END
diff --git a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/vmaxa.s b/src/packlib/kernlib/kerngen/vmscode/vaxmlan/vmaxa.s
deleted file mode 100644
index 0ee76ce..0000000
--- a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/vmaxa.s
+++ /dev/null
@@ -1,44 +0,0 @@
-;
-; $Id: vmaxa.s,v 1.1.1.1 1996/02/15 17:50:33 mclareni Exp $
-;
-; $Log: vmaxa.s,v $
-; Revision 1.1.1.1 1996/02/15 17:50:33 mclareni
-; Kernlib
-;
-;
- .TITLE VMAXA
-;++
-; CERN PROGLIB# F121 VMAXA .VERSION KERNVAX 2.05 830901
-; ORIG. J. VORBRUEGGEN 4/5/83
-;
-; FUNCTION VMAXA(A, N)
-; Give maximum of absolute values of A(I), I=1,...,N
-;
-; Register usage:
-; R0 maximum (initialized with ABS(A(1)))
-; R1 absolute value of A(I)
-; R2 address of A(I)
-; R3 counter from N to 1
-;--
- .IDENT /01/
- .PSECT $CODE,PIC,CON,REL,LCL,SHR,EXE,RD,NOWRT,LONG
- .ENTRY VMAXA,^M<R2,R3>
-
- MOVL @8(AP),R3 ; get counter
- BLEQ 40$ ; return if <= 0
- MOVAL @4(AP),R2 ; get base address of A
- BICL3 #^X8000,(R2)+,R0 ; initialize maximum
- DECL R3 ; update counter
- BEQL 30$ ; return if N = 1
-
-10$: BICL3 #^X8000,(R2)+,R1 ; get ABS(A(I))
- CMPF R0,R1 ; new maximum ?
- BGEQ 20$
- MOVF R1,R0 ; yes, save it
-20$: SOBGTR R3,10$ ; loop
-30$: RET
-
-40$: CLRF R0 ; return a function value of zero
- RET
-
- .END
diff --git a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/vmin.s b/src/packlib/kernlib/kerngen/vmscode/vaxmlan/vmin.s
deleted file mode 100644
index 995d71a..0000000
--- a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/vmin.s
+++ /dev/null
@@ -1,42 +0,0 @@
-;
-; $Id: vmin.s,v 1.1.1.1 1996/02/15 17:50:33 mclareni Exp $
-;
-; $Log: vmin.s,v $
-; Revision 1.1.1.1 1996/02/15 17:50:33 mclareni
-; Kernlib
-;
-;
- .TITLE VMIN
-;++
-; CERN PROGLIB# F121 VMIN .VERSION KERNVAX 2.05 830901
-; ORIG. J. VORBRUEGGEN 4/5/83
-;
-; FUNCTION VMIN(A, N)
-; Give minimum of A(I), I=1,...,N
-;
-; Register usage:
-; R0 minimum (initialized with A(1))
-; R1 address of A(I)
-; R2 counter from N to 1
-;--
- .IDENT /01/
- .PSECT $CODE,PIC,CON,REL,LCL,SHR,EXE,RD,NOWRT,LONG
- .ENTRY VMIN,^M<R2>
-
- MOVL @8(AP),R2 ; get counter
- BLEQ 40$ ; return if <= 0
- MOVAL @4(AP),R1 ; get base address of A
- MOVF (R1)+,R0 ; initialize minimum
- DECL R2 ; update counter
- BEQL 30$ ; return if N = 1
-
-10$: CMPF (R1)+,R0 ; new minimum ?
- BGEQ 20$
- MOVF -4(R1),R0 ; yes, save it
-20$: SOBGTR R2,10$ ; loop
-30$: RET
-
-40$: CLRF R0 ; return a function value of zero
- RET
-
- .END
diff --git a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/vmina.s b/src/packlib/kernlib/kerngen/vmscode/vaxmlan/vmina.s
deleted file mode 100644
index 7c7e0bc..0000000
--- a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/vmina.s
+++ /dev/null
@@ -1,44 +0,0 @@
-;
-; $Id: vmina.s,v 1.1.1.1 1996/02/15 17:50:33 mclareni Exp $
-;
-; $Log: vmina.s,v $
-; Revision 1.1.1.1 1996/02/15 17:50:33 mclareni
-; Kernlib
-;
-;
- .TITLE VMINA
-;++
-; CERN PROGLIB# F121 VMINA .VERSION KERNVAX 2.05 830901
-; ORIG. J. VORBRUEGGEN 4/5/83
-;
-; FUNCTION VMINA(A, N)
-; Give minimum of absolute values of A(I), I=1,...,N
-;
-; Register usage:
-; R0 minimum (initialized with ABS(A(1)))
-; R1 absolute value of A(I)
-; R2 address of A(I)
-; R3 counter from N to 1
-;--
- .IDENT /01/
- .PSECT $CODE,PIC,CON,REL,LCL,SHR,EXE,RD,NOWRT,LONG
- .ENTRY VMINA,^M<R2,R3>
-
- MOVL @8(AP),R3 ; get counter
- BLEQ 40$ ; return if <= 0
- MOVAL @4(AP),R2 ; get base address of A
- BICL3 #^X8000,(R2)+,R0 ; initialize minimum
- DECL R3 ; update counter
- BEQL 30$ ; return if N = 1
-
-10$: BICL3 #^X8000,(R2)+,R1 ; get ABS(A(I))
- CMPF R1,R0 ; new minimum ?
- BGEQ 20$
- MOVF R1,R0 ; save it
-20$: SOBGTR R3,10$ ; loop
-30$: RET
-
-40$: CLRF R0 ; return a function value of zero
- RET
-
- .END
diff --git a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/vmod.s b/src/packlib/kernlib/kerngen/vmscode/vaxmlan/vmod.s
deleted file mode 100644
index 66e6dc5..0000000
--- a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/vmod.s
+++ /dev/null
@@ -1,38 +0,0 @@
-;
-; $Id: vmod.s,v 1.1.1.1 1996/02/15 17:50:33 mclareni Exp $
-;
-; $Log: vmod.s,v $
-; Revision 1.1.1.1 1996/02/15 17:50:33 mclareni
-; Kernlib
-;
-;
- .TITLE VMOD
-;++
-; CERN PROGLIB# F121 VMOD .VERSION KERNVAX 2.05 830901
-; ORIG. J. VORBRUEGGEN 4/5/83
-;
-; FUNCTION VMOD(A, N)
-; Give |A|, i. e. euclidian norm of N-dim. vector A
-;
-; Register usage:
-; R0 sum of A(I)*A(I)
-; R1 scratch register for multiplying
-; R2 address of A(I)
-; R3 counter from N to 1
-;--
- .IDENT /01/
- .PSECT $CODE,PIC,CON,REL,LCL,SHR,EXE,RD,NOWRT,LONG
- .ENTRY VMOD,^M<R2,R3>
-
- CLRF R0 ; initialize sum
- MOVL @8(AP),R3 ; get counter
- BLEQ 20$ ; return if <= 0
- MOVAL @4(AP),R2 ; get base address of A
-
-10$: MULF3 (R2),(R2)+,R1 ; compute square of A(I)
- ADDF2 R1,R0 ; add result to sum
- SOBGTR R3,10$ ; and loop
- JSB G^MTH$SQRT_R3 ; compute square root
-20$: RET
-
- .END
diff --git a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/vmul.s b/src/packlib/kernlib/kerngen/vmscode/vaxmlan/vmul.s
deleted file mode 100644
index be2d867..0000000
--- a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/vmul.s
+++ /dev/null
@@ -1,35 +0,0 @@
-;
-; $Id: vmul.s,v 1.1.1.1 1996/02/15 17:50:33 mclareni Exp $
-;
-; $Log: vmul.s,v $
-; Revision 1.1.1.1 1996/02/15 17:50:33 mclareni
-; Kernlib
-;
-;
- .TITLE VMUL
-;++
-; CERN PROGLIB# F121 VMUL .VERSION KERNVAX 2.05 830901
-; ORIG. J. VORBRUEGGEN 30/4/83
-;
-; SUBROUTINE VMUL(A, B, X, N)
-; X(I) = A(I) * B(I) , I=1,...,N
-;
-; Register usage:
-; R0, R1, R2 addresses of A(I), B(I), and X(I), resp.
-; R3 counter from N to 1
-;--
- .IDENT /01/
- .PSECT $CODE,PIC,CON,REL,LCL,SHR,EXE,RD,NOWRT,LONG
- .ENTRY VMUL,^M<R2,R3>
-
- MOVL @16(AP),R3 ; get counter
- BLEQ 20$ ; return if <= 0
- MOVAL @4(AP),R0 ; get base addresses of A, B, and X
- MOVAL @8(AP),R1
- MOVAL @12(AP),R2
-
-10$: MULF3 (R0)+,(R1)+,(R2)+ ; multiply
- SOBGTR R3,10$ ; and loop
-20$: RET
-
- .END
diff --git a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/vscale.s b/src/packlib/kernlib/kerngen/vmscode/vaxmlan/vscale.s
deleted file mode 100644
index 85e6ce4..0000000
--- a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/vscale.s
+++ /dev/null
@@ -1,37 +0,0 @@
-;
-; $Id: vscale.s,v 1.1.1.1 1996/02/15 17:50:33 mclareni Exp $
-;
-; $Log: vscale.s,v $
-; Revision 1.1.1.1 1996/02/15 17:50:33 mclareni
-; Kernlib
-;
-;
- .TITLE VSCALE
-;++
-; CERN PROGLIB# F121 VSCALE .VERSION KERNVAX 2.05 830901
-; ORIG. J. VORBRUEGGEN 2/5/83
-;
-; SUBROUTINE VSCALE(A, ALPHA, X, N)
-; X(I) = A(I) * ALPHA , I=1,...,N
-;
-; Register usage:
-; R0 address of A(I)
-; R1 = ALPHA
-; R2 address of X(I)
-; R3 counter from N to 1
-;--
- .IDENT /01/
- .PSECT $CODE,PIC,CON,REL,LCL,SHR,EXE,RD,NOWRT,LONG
- .ENTRY VSCALE,^M<R2,R3>
-
- MOVL @16(AP),R3 ; get counter
- BLEQ 20$ ; return if <= 0
- MOVAL @4(AP),R0 ; get base address of A
- MOVL @8(AP),R1 ; get ALPHA
- MOVAL @12(AP),R2 ; get base address of X
-
-10$: MULF3 (R0)+,R1,(R2)+ ; multiply
- SOBGTR R3,10$ ; and loop
-20$: RET
-
- .END
diff --git a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/vsub.s b/src/packlib/kernlib/kerngen/vmscode/vaxmlan/vsub.s
deleted file mode 100644
index 66b7b62..0000000
--- a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/vsub.s
+++ /dev/null
@@ -1,35 +0,0 @@
-;
-; $Id: vsub.s,v 1.1.1.1 1996/02/15 17:50:33 mclareni Exp $
-;
-; $Log: vsub.s,v $
-; Revision 1.1.1.1 1996/02/15 17:50:33 mclareni
-; Kernlib
-;
-;
- .TITLE VSUB
-;++
-; CERN PROGLIB# F121 VSUB .VERSION KERNVAX 2.05 830901
-; ORIG. J. VORBRUEGGEN 30/4/83
-;
-; SUBROUTINE VSUB(A, B, X, N)
-; X(I) = A(I) - B(I) , I=1,...,N
-;
-; Register usage:
-; R0, R1, R2 addresses of A(I), B(I), and X(I), resp.
-; R3 counter from N to 1
-;--
- .IDENT /01/
- .PSECT $CODE,PIC,CON,REL,LCL,SHR,EXE,RD,NOWRT,LONG
- .ENTRY VSUB,^M<R2,R3>
-
- MOVL @16(AP),R3 ; get counter
- BLEQ 20$ ; return if <= 0
- MOVAL @4(AP),R0 ; get base addresses of A, B, and X
- MOVAL @8(AP),R1
- MOVAL @12(AP),R2
-
-10$: SUBF3 (R1)+,(R0)+,(R2)+ ; subtract
- SOBGTR R3,10$ ; and loop
-20$: RET
-
- .END
diff --git a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/vsum.s b/src/packlib/kernlib/kerngen/vmscode/vaxmlan/vsum.s
deleted file mode 100644
index bdedff4..0000000
--- a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/vsum.s
+++ /dev/null
@@ -1,35 +0,0 @@
-;
-; $Id: vsum.s,v 1.1.1.1 1996/02/15 17:50:33 mclareni Exp $
-;
-; $Log: vsum.s,v $
-; Revision 1.1.1.1 1996/02/15 17:50:33 mclareni
-; Kernlib
-;
-;
- .TITLE VSUM
-;++
-; CERN PROGLIB# F121 VSUM .VERSION KERNVAX 2.05 830901
-; ORIG. J. VORBRUEGGEN 4/5/83
-;
-; FUNCTION VSUM(A, N)
-; Give sum of A(I), I=1,...,N
-;
-; Register usage:
-; R0 sum
-; R1 address of A(I)
-; R2 counter from N to 1
-;--
- .IDENT /01/
- .PSECT $CODE,PIC,CON,REL,LCL,SHR,EXE,RD,NOWRT,LONG
- .ENTRY VSUM,^M<R2>
-
- CLRF R0 ; initialize sum
- MOVL @8(AP),R2 ; get counter
- BLEQ 20$ ; return if <= 0
- MOVAL @4(AP),R1 ; get base address of A
-
-10$: ADDF2 (R1)+,R0 ; sum
- SOBGTR R2,10$ ; and loop
-20$: RET
-
- .END
diff --git a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/vunit.s b/src/packlib/kernlib/kerngen/vmscode/vaxmlan/vunit.s
deleted file mode 100644
index 150f139..0000000
--- a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/vunit.s
+++ /dev/null
@@ -1,47 +0,0 @@
-;
-; $Id: vunit.s,v 1.1.1.1 1996/02/15 17:50:34 mclareni Exp $
-;
-; $Log: vunit.s,v $
-; Revision 1.1.1.1 1996/02/15 17:50:34 mclareni
-; Kernlib
-;
-;
- .TITLE VUNIT
-;++
-; CERN PROGLIB# F121 VUNIT .VERSION KERNVAX 2.05 830901
-; ORIG. J. VORBRUEGGEN 4/5/83
-;
-; SUBROUTINE VUNIT(A, X, N)
-; X(I) = A(I) / |A| , I=1,...,N
-;
-; Register usage:
-; Part I Part II
-; R0 sum of A(I)**2 value of |A|
-; R1 address of A(I) address of A(I)
-; R2 scratch for multiplying address of X(I)
-; R3 counter from N to 1 counter
-;--
- .IDENT /01/
- .PSECT $CODE,PIC,CON,REL,LCL,SHR,EXE,RD,NOWRT,LONG
- .ENTRY VUNIT,^M<R2,R3>
- ; Part I:
- MOVL @12(AP),R3 ; get counter
- BLEQ 30$ ; return if <= 0
- MOVAL @4(AP),R1 ; get base address of A
- CLRF R0 ; initialize sum
-
-10$: MULF3 (R1),(R1)+,R2 ; compute square of A(I)
- ADDF2 R2,R0 ; add result to sum
- SOBGTR R3,10$ ; and loop
- ; Part II:
- JSB G^MTH$SQRT_R3 ; compute |A|
- MOVAL @4(AP),R1 ; get base address of A
- DIVF3 R0,#^F1.,R0 ; compute 1./|A|
- MOVAL @8(AP),R2 ; get base address of X
- MOVL @12(AP),R3 ; set up counter again
-
-20$: MULF3 R0,(R1)+,(R2)+ ; scale A(I)
- SOBGTR R3,20$ ; and loop
-30$: RET
-
- .END
diff --git a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/vxinvb.s b/src/packlib/kernlib/kerngen/vmscode/vaxmlan/vxinvb.s
deleted file mode 100644
index 6d53c2e..0000000
--- a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/vxinvb.s
+++ /dev/null
@@ -1,54 +0,0 @@
-;
-; $Id: vxinvb.s,v 1.1.1.1 1996/02/15 17:50:31 mclareni Exp $
-;
-; $Log: vxinvb.s,v $
-; Revision 1.1.1.1 1996/02/15 17:50:31 mclareni
-; Kernlib
-;
-;
- .TITLE VXINVB
-;++
-; CERN PROGLIB# M434 VXINVB .VERSION KERNVAX 2.31 890323
-; ORIG. 12-June-87, J. Zoll + F. Carminati
-; CORR. August 88, M. Jonker/CERN, speed-up; Feb.89 test on zero
-;
-; SUBROUTINE VXINVB (MV,N)
-; VX invert bytes, in-place
-; Invert in-situ the 4 bytes in each long-word of MV, N words
-;--
- .IDENT /03MJJ/
- .PSECT $CODE,PIC,CON,REL,LCL,SHR,EXE,RD,NOWRT,LONG
- .ENTRY VXINVB,^M<R2,R3,R4,R5,R6>
- MOVQ 4(AP),R0 ;R0 = source pointer
- ;R1 = adr(count)
- MOVL (R1),R1 ;R1 = count
- BLEQ 99$ ; exit if zero / -ve
- ASHL #-1,R1,AP ;AP = count/2
- MOVL #^X00FF00FF,R6 ;R6 = 0 | F | 0 | F mask
- BLBC R1,20$ ;Test for odd number of swaps
-
-; - Odd number of swaps
- ADDL #1,AP
- MOVL (R0),R3
- BRB 21$
-
-; Loop optimization:
-; The loop is longword aligned and two items are swapped per cycle
- .ALIGN LONG
-20$: MOVQ (R0),R2 ;R2 = 1 | 2 | 3 | 4
-
- ROTL #24,R2,R4 ;R4 = 4 | 1 | 2 | 3
- BICL2 R6,R4 ;R4 = 4 | 0 | 2 | 0
- BICL2 R6,R2 ;R2 = 1 | 0 | 3 | 0
- ROTL #8,R2,R2 ;R2 = 0 | 3 | 0 | 1
- BISL3 R4,R2,(R0)+ ;(R0)= 4 | 3 | 2 | 1
-
-21$: ROTL #24,R3,R4 ;R4 = 4 | 1 | 2 | 3
- BICL2 R6,R4 ;R4 = 4 | 0 | 2 | 0
- BICL2 R6,R3 ;R3 = 1 | 0 | 3 | 0
- ROTL #8,R3,R3 ;R3 = 0 | 3 | 0 | 1
- BISL3 R4,R3,(R0)+ ;(R0)= 4 | 3 | 2 | 1
-
- SOBGTR AP,20$ ;loop
-99$: RET
- .END
diff --git a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/vxinvc.s b/src/packlib/kernlib/kerngen/vmscode/vaxmlan/vxinvc.s
deleted file mode 100644
index 498de61..0000000
--- a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/vxinvc.s
+++ /dev/null
@@ -1,55 +0,0 @@
-;
-; $Id: vxinvc.s,v 1.1.1.1 1996/02/15 17:50:31 mclareni Exp $
-;
-; $Log: vxinvc.s,v $
-; Revision 1.1.1.1 1996/02/15 17:50:31 mclareni
-; Kernlib
-;
-;
- .TITLE VXINVC
-;++
-; CERN PROGLIB# M434 VXINVC .VERSION KERNVAX 2.31 890323
-; ORIG. 12-June-87, J. Zoll + F. Carminati
-; CORR. August 88, M. Jonker/CERN, speed-up; Feb.89 test on zero
-;
-; SUBROUTINE VXINVC (MVIN,MVOUT,N)
-; VX invert bytes and copy
-; Invert the 4 bytes from each long-word of MVIN
-; and store to MVOUT, N words
-;--
- .IDENT /03MJJ/
- .PSECT $CODE,PIC,CON,REL,LCL,SHR,EXE,RD,NOWRT,LONG
- .ENTRY VXINVC,^M<R2,R3,R4,R5,R6>
- MOVQ 4(AP),R0 ;R0 = source pointer
- ;R1 = target pointer
- MOVL @12(AP),R2 ;R2 = count
- BLEQ 99$ ; exit if zero / -ve
- ASHL #-1,R2,AP ;AP = count/2
- MOVL #^X00FF00FF,R6 ;R6 = 0 | F | 0 | F mask
- BLBC R2,20$ ;Test for odd number of swaps
-
-; - Odd number of swaps
- ADDL #1,AP
- MOVL (R0)+,R3
- BRB 21$
-
-; Loop optimization:
-; The loop is longword aligned and two items are swapped per cycle
- .ALIGN LONG
-20$: MOVQ (R0)+,R2 ;R2 = 1 | 2 | 3 | 4
-
- ROTL #24,R2,R4 ;R4 = 4 | 1 | 2 | 3
- BICL2 R6,R4 ;R4 = 4 | 0 | 2 | 0
- BICL2 R6,R2 ;R2 = 1 | 0 | 3 | 0
- ROTL #8,R2,R2 ;R2 = 0 | 3 | 0 | 1
- BISL3 R4,R2,(R1)+ ;(R1)= 4 | 3 | 2 | 1
-
-21$: ROTL #24,R3,R4 ;R4 = 4 | 1 | 2 | 3
- BICL2 R6,R4 ;R4 = 4 | 0 | 2 | 0
- BICL2 R6,R3 ;R3 = 1 | 0 | 3 | 0
- ROTL #8,R3,R3 ;R3 = 0 | 3 | 0 | 1
- BISL3 R4,R3,(R1)+ ;(R1)= 4 | 3 | 2 | 1
-
- SOBGTR AP,20$ ;loop
-99$: RET
- .END
diff --git a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/vzero.s b/src/packlib/kernlib/kerngen/vmscode/vaxmlan/vzero.s
deleted file mode 100644
index 2cfd2ae..0000000
--- a/src/packlib/kernlib/kerngen/vmscode/vaxmlan/vzero.s
+++ /dev/null
@@ -1,52 +0,0 @@
-;
-; $Id: vzero.s,v 1.1.1.1 1996/02/15 17:50:31 mclareni Exp $
-;
-; $Log: vzero.s,v $
-; Revision 1.1.1.1 1996/02/15 17:50:31 mclareni
-; Kernlib
-;
-;
- .TITLE VZERO
-;++
-; CERN PROGLIB# F121 VZERO .VERSION KERNVAX 2.18 860429
-; ORIG. J. VORBRUEGGEN 30/4/83
-;
-; SUBROUTINE VZERO(X, N)
-; Preset array to zero with count of longwords
-;
-; Register usage:
-; N <= 16383 N > 16383
-; R0 byte count (used by MOVC5)
-; R1 dummy source address dummy source address
-; R2 | (used by MOVC5)
-; R3 | (used by MOVC5) destination address
-; R4 | (used by MOVC5)
-; R5 | (used by MOVC5)
-; R6 not used = 65535
-; R7 not used updated byte count
-;
-; NOTE: R6/R7 are only saved if necessary (i. e. N > 16383)
-;--
- .IDENT /01/
- .PSECT $CODE,PIC,CON,REL,LCL,SHR,EXE,RD,NOWRT,LONG
- .ENTRY VZERO,^M<R2,R3,R4,R5>
-
- ASHL #2, at 8(AP),R0 ; Make byte count (*4)
- BLEQ 10$ ; Return if <= 0
- CMPL #65535,R0 ; Too large for one MOVC5 ?
- BLSSU 20$
- MOVC5 #0,(R1),#0,R0, at 4(AP) ; Normal case.
-10$: RET
-
-20$: MOVQ R6,-(SP) ; Fastest way of saving R6/R7
- MOVAL @4(AP),R3 ; Get address of source
- MOVL #65535,R6 ; Max. # of bytes for MOVC5
- MOVL R0,R7 ; Save count from destruction
-
-30$: MOVC5 #0,(R1),#0,R6,(R3) ; Zero one 64KB chunk
- ACBL R6,#-65535,R7,30$ ; Any more ?
- BEQL 40$ ; Already finished ?
- MOVC5 #0,(R1),#0,R7,(R3) ; No, zero the rest
-40$: MOVQ (SP)+,R6 ; Restore registers
- RET
- .END
diff --git a/src/packlib/kernlib/kerngen/vmscode/vaxsys/Imakefile b/src/packlib/kernlib/kerngen/vmscode/vaxsys/Imakefile
deleted file mode 100644
index e7159de..0000000
--- a/src/packlib/kernlib/kerngen/vmscode/vaxsys/Imakefile
+++ /dev/null
@@ -1,5 +0,0 @@
-SRCS_F= \ @@\
- getpidf.F ifbatch.F jumpad.F sleepf.F \ @@\
- tminit.F tmread.F vaxtio.F wait2s.F whoami.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kerngen/vmscode/vaxsys/getpidf.F b/src/packlib/kernlib/kerngen/vmscode/vaxsys/getpidf.F
deleted file mode 100644
index 771106f..0000000
--- a/src/packlib/kernlib/kerngen/vmscode/vaxsys/getpidf.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: getpidf.F,v 1.1.1.1 1996/02/15 17:50:26 mclareni Exp $
-*
-* $Log: getpidf.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:26 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE GETPIDF (IPID)
-
-C CERN PROGLIB# Z265 GETPIDF .VERSION KERNVAX 2.46 940913
-C ORIG. 31/05/94, JS
-
-C- Simulate UNIX system call
-
- INCLUDE '($JPIDEF)'
-
- CALL LIB$GETJPI(JPI$_PID,,,IPID,,)
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/vmscode/vaxsys/ifbatch.F b/src/packlib/kernlib/kerngen/vmscode/vaxsys/ifbatch.F
deleted file mode 100644
index 7ee2a39..0000000
--- a/src/packlib/kernlib/kerngen/vmscode/vaxsys/ifbatch.F
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: ifbatch.F,v 1.1.1.1 1996/02/15 17:50:26 mclareni Exp $
-*
-* $Log: ifbatch.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:26 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- LOGICAL FUNCTION IFBATCH(DUMMY)
-C
-C CERN PROGLIB# Z044 IFBATCH .VERSION KERNVAX 2.44 931108
-C ORIG. 30/06/93 Jamie Shiers
-C
- INTEGER STATUS
- INCLUDE '($JPIDEF)'
-
- STATUS = LIB$GETJPI(JPI$_MODE,,,MODE,,%REF(LMODE))
- IF(.NOT.STATUS) CALL LIB$SIGNAL(%VAL(STATUS))
-
- IFBATCH=MODE.EQ.2
- END
diff --git a/src/packlib/kernlib/kerngen/vmscode/vaxsys/jumpad.F b/src/packlib/kernlib/kerngen/vmscode/vaxsys/jumpad.F
deleted file mode 100644
index b8d7253..0000000
--- a/src/packlib/kernlib/kerngen/vmscode/vaxsys/jumpad.F
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: jumpad.F,v 1.1.1.1 1996/02/15 17:50:26 mclareni Exp $
-*
-* $Log: jumpad.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:26 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- FUNCTION JUMPAD (ITARGT)
-C
-C CERN PROGLIB# Z042 JUMPAD .VERSION KERNVAX 2.26 880425
-C ORIG. 21/04/88 JZ
-C
-C- Get target address for use with JUMPXn
-
- JUMPAD = %LOC (ITARGT)
- END
diff --git a/src/packlib/kernlib/kerngen/vmscode/vaxsys/sleepf.F b/src/packlib/kernlib/kerngen/vmscode/vaxsys/sleepf.F
deleted file mode 100644
index 2f727b5..0000000
--- a/src/packlib/kernlib/kerngen/vmscode/vaxsys/sleepf.F
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: sleepf.F,v 1.1.1.1 1996/02/15 17:50:26 mclareni Exp $
-*
-* $Log: sleepf.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:26 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE SLEEPF (NSECS)
-C
-C CERN PROGLIB# Z265 SLEEPF .VERSION KERNVAX 2.36 910306
-C ORIG. 06/03/91, JZ
-C Fortran interface routine to sleep
-C
-
- ASEC = NSECS
- CALL LIB$WAIT (ASEC)
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/vmscode/vaxsys/tminit.F b/src/packlib/kernlib/kerngen/vmscode/vaxsys/tminit.F
deleted file mode 100644
index 7935768..0000000
--- a/src/packlib/kernlib/kerngen/vmscode/vaxsys/tminit.F
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: tminit.F,v 1.1.1.1 1996/02/15 17:50:26 mclareni Exp $
-*
-* $Log: tminit.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:26 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE TMINIT (IFLAG)
-C
-C CERN PROGLIB# Z313 TMINIT .VERSION KERNVAX 2.45 940228
-C ORIG. 16/02/94, JZ
-C
-C Initialize TMPRO / TMREAD
-C
-
- IFLAG = 7
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/vmscode/vaxsys/tmread.F b/src/packlib/kernlib/kerngen/vmscode/vaxsys/tmread.F
deleted file mode 100644
index cc9353f..0000000
--- a/src/packlib/kernlib/kerngen/vmscode/vaxsys/tmread.F
+++ /dev/null
@@ -1,30 +0,0 @@
-*
-* $Id: tmread.F,v 1.1.1.1 1996/02/15 17:50:26 mclareni Exp $
-*
-* $Log: tmread.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:26 mclareni
-* Kernlib
-*
-*
- SUBROUTINE TMREAD (MAXCH, LINE, NCH, ISTAT)
-C
-C CERN PROGLIB# Z313 TMREAD .VERSION KERNVAX 2.45 940228
-C ORIG. 16/02/94, JZ
-C
-C Read the next line from stdin
-C
- CHARACTER LINE*512
-
- READ (5,8000,ERR=91,END=49) LG, LINE(1:MIN(LG,MAXCH))
- 8000 FORMAT (Q,A)
-
- NCH = MIN(LG,MAXCH)
- ISTAT = 0
- RETURN
-
- 49 ISTAT = -1
- RETURN
-
- 91 ISTAT = 7
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/vmscode/vaxsys/vaxtio.F b/src/packlib/kernlib/kerngen/vmscode/vaxsys/vaxtio.F
deleted file mode 100644
index c48e6b8..0000000
--- a/src/packlib/kernlib/kerngen/vmscode/vaxsys/vaxtio.F
+++ /dev/null
@@ -1,378 +0,0 @@
-*
-* $Id: vaxtio.F,v 1.1.1.1 1996/02/15 17:50:26 mclareni Exp $
-*
-* $Log: vaxtio.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:26 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE VAXTIO (LUNP,MODOPP,IBUF,NDOP,NDONEP,NCODEP,LUNMSGP)
-C
-C CERN PROGLIB# Z301 VAXTIO .VERSION KERNVAX 2.04 830531
-C ORIG. 11/05/83 G.CIAPETTI + J.ZOLL
-C
-C- HANDLE TAPES MOUNTED 'FOREIGN' WITH DIRECT QIO SYSTEM REQUESTS
-C
-
-C---- PARAMETERS ON INPUT
-
-C LUN : LOGICAL UNIT NUMBER POINTING TO THE FILE
-C SPECIFIED BY THE LOGICAL NAME 'QIOUNIT<LUN>'
-C LUN MUST BE 0 < LUN < 61
-C MODOP : OPERATION MODE REQUEST
-C = -2 WRITE EOF
-C -1 WRITE NDO BYTES FROM IBUF TO TAPE
-C 0 READ AT MOST NDO BYTES FROM TAPE TO IBUF
-C 1 ASSIGN CHANNEL
-C 2 SKIP NDO RECORDS, BACKWARDS IF NDO -VE
-C 3 SKIP NDO FILES, BACKWARDS IF NDO -VE
-C 4 REWIND
-C 5 REWIND/UNLOAD
-C 6 DE-ASSIGN CHANNEL
-C
-C IBUF : DATA AREA FOR THE RECORD OF NDO BYTES
-C NDO : NUMBER OF UNITS TO BE DONE
-C LUNMSG : LOGICAL UNIT TO RECEIVE MESSAGES
-C = 0 : MESSAGES SUPPRESSED
-
-C---- PARAMETERS ON OUTPUT
-
-C NDONE : NUMBER OF UNITS DONE
-C READ : +VE NDONE BYTES READ INTO IBUF
-C 0 END OF FILE,TAPE,VOLUME
-C -VE ERROR
-C
-C WRITE: +VE NDONE BYTES WRITTEN
-C 0 END OF TAPE/VOLUME, RECORD WRITTEN + EOF
-C -VE ERROR
-C
-C WEOF : 1 THREE EOF WRITTEN, 2 BACKSPACED
-C 0 DITTO, BUT END-OF-TAPE
-C -VE ERROR
-C
-C SKIP : +VE NDONE RECORDS/FILES SKIPPED
-C -VE ERROR
-C
-C ERRORS :
-C -1 READ ERROR
-C -7 CATASTROPHIC ERROR,
-C DO NOT ATTEMPT FURTHER READS
-C
-C NCODE : OPERATION STATUS CODE RETURNED FROM QIO
-C = 1 IF ALL OK
-
-C THIS ROUTINE USES EVENT FLAGS 1 AND 2, ALSO 0 WITH WAIT_2SEC
-C----
-
- DIMENSION LUNP(9),MODOPP(1),IBUF(999),NDOP(9)
- +, NDONEP(9),NCODEP(9),LUNMSGP(9)
- DIMENSION MM(68)
-
- INTEGER*2 JCHANV,LUNFLV,IOSB2V(240), JCHAN,LUNFL
-
- COMMON /VAXTIOC/ JCHANV(60), LUNFLV(60), IOSB4V(120)
-
- EQUIVALENCE (IOSB4V,IOSB2V)
- DATA JCHANV /60*0/, LUNFLV /60*-1/, IOSB2V / 240*1 /
-
- INTEGER SYS$QIO, SYS$QIOW
- +, SYS$TRNLOG, SYS$ASSIGN, SYS$DASSGN
-
- EXTERNAL IO$_READLBLK,IO$_WRITELBLK,IO$_WRITEOF
- +, IO$_SKIPRECORD,IO$_SKIPFILE
- +, IO$_REWIND,IO$_REWINDOFF
-
- EXTERNAL SS$_ENDOFFILE, SS$_ENDOFTAPE, SS$_ENDOFVOLUME
- +, SS$_DATAOVERUN,SS$_PARITY
-
- CHARACTER MESSAGE*256
- CHARACTER IONAME*64
- CHARACTER*8 RECFIL(2)
- DATA RECFIL/'RECORDS ','FILES '/
-
- DATA LIMIT / 64 /
-
-
-C-- COPY PARAMETERS TO LOCAL
-
- LUN = LUNP(1)
- MODOP = MODOPP(1)
- LUNMSG = LUNMSGP(1)
-
- IF (LUN.LE.0) GO TO 93
- IF (LUN.GE.61) GO TO 93
- JSB4 = 2*LUN - 1
- JSB2 = 2*JSB4 - 1
-
- 10 NDO = NDOP(1)
- NDONE = NDO
- ISTAT = 0
- LUNFL = LUNFLV(LUN)
- JCHAN = JCHANV(LUN)
- IF (LUNFL) 31,61,11
- 11 IF (MODOP) 21,12,40
-
-C---- READ REQUEST
-
- 12 MODE = %LOC(IO$_READLBLK)
- ISTAT = SYS$QIOW (%VAL(1),%VAL(JCHAN),%VAL(MODE)
- +, IOSB4V(JSB4),,, IBUF,%VAL(NDO),,,,)
-
- IF (.NOT.ISTAT) GO TO 71
- 16 ISTAT = IOSB2V(JSB2)
- IF (ISTAT.EQ.0) GO TO 16
-
- IF (ISTAT.EQ.%LOC(SS$_DATAOVERUN)) GO TO 18
- IF (.NOT.ISTAT) GO TO 71
- NDONE = JBYT (IOSB4V(JSB4),17,16)
-
- 18 LUNFLV(LUN) = 11
- 19 NDONEP(1) = NDONE
- NCODEP(1) = ISTAT
- RETURN
-
-C---- WRITE REQUEST
-
- 21 NSTATW = 0
- IF (MODOP+2) 93,25,22
- 22 MODE = %LOC(IO$_WRITELBLK)
- ISTAT = SYS$QIOW (%VAL(1),%VAL(JCHAN),%VAL(MODE)
- +, IOSB4V(JSB4),,, IBUF,%VAL(NDO),,,,)
-
- IF (.NOT.ISTAT) GO TO 71
- 24 ISTAT = IOSB2V(JSB2)
- IF (ISTAT.EQ.0) GO TO 24
-
- IF (ISTAT.EQ.%LOC(SS$_ENDOFTAPE)) GO TO 70
- IF (ISTAT.EQ.%LOC(SS$_ENDOFVOLUME)) GO TO 70
- IF (.NOT.ISTAT) GO TO 71
- NDONE = JBYT (IOSB4V(JSB4),17,16)
- GO TO 18
-
-C-- WRITE 3 EOF
-
- 25 MODE = %LOC(IO$_WRITEOF)
- NLOOP = 5
- NDONE = 0
-
- DO 26 J=1,3
- ISTAT = SYS$QIOW (%VAL(1),%VAL(JCHAN),%VAL(MODE)
- +, IOSB4V(JSB4),,, ,,,,,)
-
- IF (ISTAT) ISTAT = IOSB2V(JSB2)
-
- IF (NSTATW.NE.0) GO TO 26
- IF (ISTAT.EQ.%LOC(SS$_ENDOFTAPE)) GO TO 70
- IF (ISTAT.EQ.%LOC(SS$_ENDOFVOLUME)) GO TO 70
- IF (.NOT.ISTAT) GO TO 71
- NLOOP = 6
- NDONE = 1
- 26 CONTINUE
-
-C-- BACKSPACE OVER 2 OR 3 EOF
-
- IF (NSTATW.NE.0) ISTAT=NSTATW
- JFORW = 5
- GO TO 82
-
-C---- GET CHANNEL ON FIRST CONTACT
-
- 31 IF (MODOP.EQ.6) GO TO 37
- CALL UCTOH1 ('QIOUNIT00',MM,9)
- CALL USET (LUN,MM,8,9)
- LGMSG = 9
- N = 0
-
-C-- CLEAR MULTI-LEVEL LOGICAL NAME
-
- 32 LGNAM = LGMSG
- CALL UH1TOC (MM,IONAME,LGNAM)
- IF (N.GE.12) GO TO 33
- ISTAT = SYS$TRNLOG (IONAME(1:LGNAM),LGMSG,MESSAGE,,,)
- IF (ISTAT.NE.1) GO TO 33
- IF (LGMSG.EQ.0) GO TO 33
- IF (LGMSG.GE.64) GO TO 33
- CALL UCTOH1 (MESSAGE,MM,LGMSG)
- N = N + 1
- GO TO 32
-
- 33 IF (LUNMSG.EQ.0) GO TO 34
- N = MIN0 (LGNAM,50)
- WRITE (LUNMSG,9033) LUN, IONAME(1:N)
- 9033 FORMAT ('0VAXTIO.',12X,'LUN=',I2,' ASSIGN ',A)
-
- 34 ISTAT = SYS$ASSIGN (IONAME(1:LGNAM),JCHAN,,)
- IF (.NOT.ISTAT) GO TO 71
- JCHANV(LUN) = JCHAN
- LUNFLV(LUN) = 11
- IF (MODOP.NE.1) GO TO 10
- 37 NDONE = 1
- GO TO 19
-
-C--------- SPECIAL OPERATIONS
-
- 40 IF (MODOP.GE.7) GO TO 93
- GO TO (41,42,43,51,52,57), MODOP
-
-C-- ASSIGN CHANNEL (WAS ALREADY ASSIGNED!)
-
- 41 NDONE = 0
- GO TO 19
-
-C-- SKIP NDO RECORDS
-
- 42 MODE = %LOC(IO$_SKIPRECORD)
- GO TO 44
-
-C-- SKIP NDO FILES
-
- 43 MODE = %LOC(IO$_SKIPFILE)
- 44 IF (LUNMSG.EQ.0) GO TO 45
- WRITE (LUNMSG,9044) LUN,NDO,RECFIL(MODOP-1)
- 9044 FORMAT (' VAXTIO.',12X,'LUN=',I2,' GO TO SKIP',I6,1X,A)
-
- 45 ISTAT = SYS$QIOW (%VAL(1),%VAL(JCHAN),%VAL(MODE)
- +, IOSB4V(JSB4),,, %VAL(NDO),,,,,)
-
- IF (.NOT.ISTAT) GO TO 71
- 46 ISTAT = IOSB2V(JSB2)
- IF (ISTAT.NE.0) GO TO 47
- CALL WAIT_2SEC
- GO TO 46
-
- 47 IF (.NOT.ISTAT) GO TO 71
- 48 NDONE = JBYT (IOSB4V(JSB4),17,16)
- IF (LUNMSG.EQ.0) GO TO 18
-
- WRITE (LUNMSG,9045) NDONE
- 9045 FORMAT (37X,I6,' DONE.')
- GO TO 18
-
-C-- REWIND
-
- 51 MODE = %LOC(IO$_REWIND)
- GO TO 53
-
-C-- REWIND/UNLOAD
-
- 52 MODE = %LOC(IO$_REWINDOFF)
- 53 CONTINUE
-
- ISTAT = SYS$QIO (%VAL(2),%VAL(JCHAN),%VAL(MODE)
- +, IOSB4V(JSB4),,, ,,,,,)
-
- IF (.NOT.ISTAT) GO TO 71
- LUNFLV(LUN) = 0
- NDONE = 1
- GO TO 19
-
-C-- DE-ASSIGN CHANNEL
-
- 57 ISTAT = SYS$DASSGN (%VAL(JCHAN))
- IF (.NOT.ISTAT) GO TO 71
- LUNFLV(LUN) = -1
- NDONE = 1
- GO TO 19
-
-C---- WAIT FOR REWIND COMPLETE
-
- 60 CALL WAIT_2SEC
- 61 IF (IOSB4V(JSB4).EQ.0) GO TO 60
- LUNFLV(LUN) = 11
- GO TO 10
-
-C-------- ERROR HANDLING
-
- 70 NSTATW = ISTAT
-
- 71 IF (LUNMSG.EQ.0) GO TO 74
- WRITE (LUNMSG,9071) LUN,JCHAN,ISTAT
- 9071 FORMAT ('0VAXTIO.',12X,'LUN=',I3,' CHANNEL = ',Z4
- +,' ERROR NO.= ',Z4,' HEX')
-
- CALL SYS$GETMSG (%VAL(ISTAT),LGMSG,MESSAGE,%VAL(15),)
- LGMSG = MIN0 (LGMSG,60)
- WRITE (LUNMSG,9073) MESSAGE(1:LGMSG)
- 9073 FORMAT (20X,A)
-
-C---- ASSIGNMENT ERRORS
-
- 74 IF (LUNFL.GE.0) GO TO 75
- IF (LUNFL+LIMIT.LT.0) GO TO 88
- LUNFLV(LUN) = LUNFL - 1
- NDONE = -7
- GO TO 19
-
-C---- NON-ASSIGNMENT ERRORS
-
- 75 NDONE = -1
- IF (LUNFL.GE.LIMIT) GO TO 88
- LUNFLV(LUN) = LUNFL + 1
-
-C-- READ ERRORS
-
- IF (MODOP.LT.0) GO TO 81
- IF (MODOP.GE.4) GO TO 86
- IF (ISTAT.EQ.%LOC(SS$_ENDOFFILE)) GO TO 78
- IF (ISTAT.EQ.%LOC(SS$_ENDOFTAPE)) GO TO 76
- IF (ISTAT.NE.%LOC(SS$_ENDOFVOLUME)) GO TO 79
-
- 76 IF (MODOP.NE.0) GO TO 77
- IF (LUNFL.GE.11) LUNFL=1
- IF (LUNFL.GE.8) GO TO 77
- LUNFLV(LUN) = LUNFL
- NDONE = JBYT (IOSB4V(JSB4),17,16)
- GO TO 19
-
- 77 MODE = %LOC(IO$_SKIPRECORD)
- CALL SYS$QIOW (%VAL(1),%VAL(JCHAN),%VAL(MODE)
- +, ,,, %VAL(-1),,,,,)
- 78 IF (MODOP.NE.0) GO TO 48
- NDONE = 0
- GO TO 19
-
- 79 IF (ISTAT.EQ.%LOC(SS$_PARITY)) GO TO 19
- GO TO 87
-
-C-- WRITE ERRORS
-
- 81 IF (NSTATW.EQ.0) GO TO 87
- IF (MODOP.NE.-2) GO TO 25
- NLOOP = 3
- JFORW = 3
-
-C-- E-O-T ON WRITE, BACKSPACE
-
- 82 MODE = %LOC(IO$_SKIPRECORD)
- N = -1
- DO 83 J=1,NLOOP
- IF (J.EQ.JFORW) N=1
- CALL SYS$QIOW (%VAL(1),%VAL(JCHAN),%VAL(MODE)
- +, ,,, %VAL(N),,,,,)
- 83 CONTINUE
- IF (NLOOP.EQ.3) GO TO 25
- GO TO 19
-
-C---- CATASTROPHIC ERRORS
-
- 86 CONTINUE
-
- 87 NDONE = -7
- GO TO 19
-
-C---- TOO MANY CONSECUTIVE ERRORS
-
- 88 IF (LUNMSG.EQ.0) GO TO 99
- WRITE (LUNMSG,9088) LUN
- 9088 FORMAT ('0VAXTIO.',12X,'LUN=',I3,' ABEND FOR TOO MANY ERRORS.')
- GO TO 99
-
-C-- FAULTY REQUEST CODE
-
- 93 WRITE (LUNMSG,9093) LUN,MODOP
- 9093 FORMAT ('0VAXTIO.',12X,' ABEND FOR FAULTY LUN/MODOP = ',2I6)
- 99 CALL ABEND
-C 99 NDONEP(1) = -7
-C RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/vmscode/vaxsys/wait2s.F b/src/packlib/kernlib/kerngen/vmscode/vaxsys/wait2s.F
deleted file mode 100644
index c640176..0000000
--- a/src/packlib/kernlib/kerngen/vmscode/vaxsys/wait2s.F
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: wait2s.F,v 1.1.1.1 1996/02/15 17:50:27 mclareni Exp $
-*
-* $Log: wait2s.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:27 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE WAIT_2SEC
-C
-C CERN PROGLIB# Z301 WAIT2S .VERSION KERNVAX 2.04 830531
-C ORIG. 11/05/83 JZ
-C
-C- PAUSE FOR 2 SECONDS
-C- THIS ROUTINE USES EVENT FLAG 0
-
- INTEGER DELTAT(2)
- INTEGER SYS$SETIMR
-
-
-C TYPE 100
-C 100 FORMAT ('0WAIT 2 SECS')
- CALL SYS$BINTIM ('0 ::02',DELTAT)
- ISTAT = SYS$SETIMR (%VAL(0),DELTAT,,)
- IF (.NOT.ISTAT) RETURN
- CALL SYS$WAITFR (%VAL(0))
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/vmscode/vaxsys/whoami.F b/src/packlib/kernlib/kerngen/vmscode/vaxsys/whoami.F
deleted file mode 100644
index 6f74eca..0000000
--- a/src/packlib/kernlib/kerngen/vmscode/vaxsys/whoami.F
+++ /dev/null
@@ -1,52 +0,0 @@
-*
-* $Id: whoami.F,v 1.1.1.1 1996/02/15 17:50:27 mclareni Exp $
-*
-* $Log: whoami.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:27 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE WHOAMI (NAME)
-C
-C CERN PROGLIB# Z266 WHOAMI .VERSION KERNVAX 2.42 930609
-C ORIG. 08/06/93 FCA + JZ
-C
- COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,SLDUMMY(37)
-
- CHARACTER NAME*(*)
-
- PARAMETER (JPI$_IMAGNAME = '207'X)
- INTEGER*4 NCHALL
- INTEGER*4 LISTF(4)
- INTEGER*2 LISTH(8)
- EQUIVALENCE (LISTH(1),LISTF(1))
- INTEGER SYS$GETJPIW
-
-C-- System service item list
-
- DATA LISTH(1),LISTH(2) / 99, JPI$_IMAGNAME /
- DATA LISTF(3),LISTF(4) / 0 , 0 /
-
-
- LISTH(1) = LEN(NAME)
- LISTF(2) = %LOC(NAME)
- LISTF(3) = %LOC(NCHALL)
- ISTAT = SYS$GETJPIW(,,,LISTF,,,)
- IF (JBIT(ISTAT,1).EQ.0) THEN
- NDSLAT = 0
- RETURN
- ENDIF
-
- NCHSEM = ICFIND (';', NAME,1,NCHALL) - 1
-
- IF (NAME(NCHSEM-3:NCHSEM).EQ.'.EXE') THEN
- NDSLAT = NCHSEM - 4
- ELSE
- NDSLAT = NCHSEM
- ENDIF
-
- NESLAT = NCHSEM
- NFSLAT = NCHALL
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/xvect/Imakefile b/src/packlib/kernlib/kerngen/xvect/Imakefile
deleted file mode 100644
index 13c69e7..0000000
--- a/src/packlib/kernlib/kerngen/xvect/Imakefile
+++ /dev/null
@@ -1,3 +0,0 @@
-SRCS_F= xinb.F xinbf.F xinbs.F xincf.F xoutb.F xoutbf.F xoutbs.F xoutcf.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kerngen/xvect/irtdgs/xinb.F b/src/packlib/kernlib/kerngen/xvect/irtdgs/xinb.F
deleted file mode 100644
index 12d6b48..0000000
--- a/src/packlib/kernlib/kerngen/xvect/irtdgs/xinb.F
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: xinb.F,v 1.1.1.1 1996/02/15 17:50:36 mclareni Exp $
-*
-* $Log: xinb.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:36 mclareni
-* Kernlib
-*
-*
- SUBROUTINE XINB (LUN,XBV,NXB)
-C
-C CERN PROGLIB# Z203 XINB .VERSION KERNIRT 1.06 930811
-C
- COMMON /SLATE/ NXR, DUMMY(39)
- DIMENSION XBV(NXB)
-C
- REAL XNR
- INTEGER NR
- EQUIVALENCE (XNR,NR)
- READ (LUN,IOSTAT=JSTAT,NUM=NBYTES) XNR,XBV
- IF (JSTAT) 61, 24, 64
- 24 NXR = NR
- NR = MIN (NR,NXB)
- NXB = MAX (NR,1)
- RETURN
-C
- 61 NXB = 0
- RETURN
-C
- 64 NXB = -JSTAT
- READ (LUN) NR
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/xvect/irtdgs/xinbf.F b/src/packlib/kernlib/kerngen/xvect/irtdgs/xinbf.F
deleted file mode 100644
index 7957b74..0000000
--- a/src/packlib/kernlib/kerngen/xvect/irtdgs/xinbf.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: xinbf.F,v 1.1.1.1 1996/02/15 17:50:36 mclareni Exp $
-*
-* $Log: xinbf.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:36 mclareni
-* Kernlib
-*
-*
- SUBROUTINE XINBF (LUN,XBV,NXB)
-C
-C CERN PROGLIB# Z203 XINBF .VERSION KERNIRT 1.06 930811
-C
- DIMENSION XBV(NXB)
-C
- READ (LUN,IOSTAT=JSTAT,NUM=NBYTES) XBV
- IF (JSTAT) 61, 24, 64
- 24 NXB = MAX (1, NBYTES/8)
- RETURN
-C
- 61 NXB = 0
- RETURN
-C
- 64 NXB = -JSTAT
- READ (LUN) N
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/xvect/irtdgs/xinbs.F b/src/packlib/kernlib/kerngen/xvect/irtdgs/xinbs.F
deleted file mode 100644
index 6dc7412..0000000
--- a/src/packlib/kernlib/kerngen/xvect/irtdgs/xinbs.F
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: xinbs.F,v 1.1.1.1 1996/02/15 17:50:36 mclareni Exp $
-*
-* $Log: xinbs.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:36 mclareni
-* Kernlib
-*
-*
- SUBROUTINE XINBS (LUN,XAV,NA,XBV,NXB)
-C
-C CERN PROGLIB# Z203 XINBS .VERSION KERNIRT 1.06 930811
-C
- COMMON /SLATE/ NXR, DUMMY(39)
- DIMENSION XBV(NXB), XAV(NA)
-C
- REAL XNR
- INTEGER NR
- EQUIVALENCE (XNR,NR)
- READ (LUN,IOSTAT=JSTAT,NUM=NBYTES) XNR,XAV,XBV
- IF (JSTAT) 61, 24, 64
- 24 NXR = NR
- NR = MIN (NR,NXB)
- NXB = MAX (NR,1)
- RETURN
-C
- 61 NXB = 0
- RETURN
-C
- 64 NXB = -JSTAT
- READ (LUN) N
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/xvect/irtdgs/xoutb.F b/src/packlib/kernlib/kerngen/xvect/irtdgs/xoutb.F
deleted file mode 100644
index b170dd1..0000000
--- a/src/packlib/kernlib/kerngen/xvect/irtdgs/xoutb.F
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: xoutb.F,v 1.1.1.1 1996/02/15 17:50:37 mclareni Exp $
-*
-* $Log: xoutb.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:37 mclareni
-* Kernlib
-*
-*
- SUBROUTINE XOUTB (LUN,BV,NB)
-C
-C CERN PROGLIB# Z203 XOUTB .VERSION KERNIRT 1.06 930811
-C ORIG. 15/07/78 JZ
-C
- DIMENSION BV(NB)
-C
- REAL XNB
- INTEGER INB
- EQUIVALENCE (XNB,INB)
- INB = NB
- WRITE (LUN) XNB,BV
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/xvect/irtdgs/xoutbs.F b/src/packlib/kernlib/kerngen/xvect/irtdgs/xoutbs.F
deleted file mode 100644
index e9ba8af..0000000
--- a/src/packlib/kernlib/kerngen/xvect/irtdgs/xoutbs.F
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: xoutbs.F,v 1.1.1.1 1996/02/15 17:50:37 mclareni Exp $
-*
-* $Log: xoutbs.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:37 mclareni
-* Kernlib
-*
-*
- SUBROUTINE XOUTBS (LUN,AV,NA,BV,NB)
-C
-C CERN PROGLIB# Z203 XOUTBS .VERSION KERNIRT 1.06 930811
-C ORIG. 15/07/78 JZ
-C
- DIMENSION BV(NB), AV(NA)
-C
- REAL XNB
- INTEGER INB
- EQUIVALENCE (XNB,INB)
- INB = NB
- WRITE (LUN) XNB,AV,BV
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/xvect/irtngs/xinb.F b/src/packlib/kernlib/kerngen/xvect/irtngs/xinb.F
deleted file mode 100644
index 9576140..0000000
--- a/src/packlib/kernlib/kerngen/xvect/irtngs/xinb.F
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: xinb.F,v 1.1.1.1 1996/02/15 17:50:36 mclareni Exp $
-*
-* $Log: xinb.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:36 mclareni
-* Kernlib
-*
-*
- SUBROUTINE XINB (LUN,XBV,NXB)
-C
-C CERN PROGLIB# Z203 XINB .VERSION KERNIRT 1.01 900319
-C
- COMMON /SLATE/ NXR, DUMMY(39)
- DIMENSION XBV(NXB)
-C
- READ (LUN,IOSTAT=JSTAT,NUM=NBYTES) NR,XBV
- IF (JSTAT) 61, 24, 64
- 24 NXR = NR
- NR = MIN (NR,NXB)
- NXB = MAX (NR,1)
- RETURN
-C
- 61 NXB = 0
- RETURN
-C
- 64 NXB = -JSTAT
- READ (LUN) NR
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/xvect/irtngs/xinbf.F b/src/packlib/kernlib/kerngen/xvect/irtngs/xinbf.F
deleted file mode 100644
index 6c01bfb..0000000
--- a/src/packlib/kernlib/kerngen/xvect/irtngs/xinbf.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: xinbf.F,v 1.1.1.1 1996/02/15 17:50:36 mclareni Exp $
-*
-* $Log: xinbf.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:36 mclareni
-* Kernlib
-*
-*
- SUBROUTINE XINBF (LUN,XBV,NXB)
-C
-C CERN PROGLIB# Z203 XINBF .VERSION KERNIRT 1.01 900319
-C
- DIMENSION XBV(NXB)
-C
- READ (LUN,IOSTAT=JSTAT,NUM=NBYTES) XBV
- IF (JSTAT) 61, 24, 64
- 24 NXB = MAX (1, NBYTES/4)
- RETURN
-C
- 61 NXB = 0
- RETURN
-C
- 64 NXB = -JSTAT
- READ (LUN) N
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/xvect/irtngs/xinbs.F b/src/packlib/kernlib/kerngen/xvect/irtngs/xinbs.F
deleted file mode 100644
index b0100b6..0000000
--- a/src/packlib/kernlib/kerngen/xvect/irtngs/xinbs.F
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: xinbs.F,v 1.1.1.1 1996/02/15 17:50:36 mclareni Exp $
-*
-* $Log: xinbs.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:36 mclareni
-* Kernlib
-*
-*
- SUBROUTINE XINBS (LUN,XAV,NA,XBV,NXB)
-C
-C CERN PROGLIB# Z203 XINBS .VERSION KERNIRT 1.01 900319
-C
- COMMON /SLATE/ NXR, DUMMY(39)
- DIMENSION XBV(NXB), XAV(NA)
-C
- READ (LUN,IOSTAT=JSTAT,NUM=NBYTES) NR,XAV,XBV
- IF (JSTAT) 61, 24, 64
- 24 NXR = NR
- NR = MIN (NR,NXB)
- NXB = MAX (NR,1)
- RETURN
-C
- 61 NXB = 0
- RETURN
-C
- 64 NXB = -JSTAT
- READ (LUN) N
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/xvect/mpwgs/xinb.F b/src/packlib/kernlib/kerngen/xvect/mpwgs/xinb.F
deleted file mode 100644
index 5832bf3..0000000
--- a/src/packlib/kernlib/kerngen/xvect/mpwgs/xinb.F
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: xinb.F,v 1.1.1.1 1996/02/15 17:50:36 mclareni Exp $
-*
-* $Log: xinb.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:36 mclareni
-* Kernlib
-*
-*
- SUBROUTINE XINB (LUN,XBV,NXB)
-C
-C CERN PROGLIB# Z203 XINB .VERSION KERNMPW 1.00 891208
-C ORIG. 06/02/89 JZ
-C
- COMMON /SLATE/ NXR, DUMMY(39)
- INTEGER XBV(999), MBUF(512)
-
- READ (LUN,END=61,ERR=64) NR,(XBV(J),J=1,MIN(NR,NXB))
- NXR = NR
- NR = MIN(NR,NXB)
- NSK = NXR - NR
- NXB = MAX(1,NR)
-
- 24 IF (NSK.LE.0) RETURN
- NR = MIN (NSK,512)
- READ (LUN,END=61,ERR=64) (MBUF(J),J=1,NR)
- NSK = NSK - NR
- GO TO 24
-
- 61 NXB = 0
- RETURN
-
- 64 NXB = -7
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/xvect/mpwgs/xinbs.F b/src/packlib/kernlib/kerngen/xvect/mpwgs/xinbs.F
deleted file mode 100644
index a75a659..0000000
--- a/src/packlib/kernlib/kerngen/xvect/mpwgs/xinbs.F
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: xinbs.F,v 1.1.1.1 1996/02/15 17:50:36 mclareni Exp $
-*
-* $Log: xinbs.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:36 mclareni
-* Kernlib
-*
-*
- SUBROUTINE XINBS (LUN,XAV,NA,XBV,NXB)
-C
-C CERN PROGLIB# Z203 XINBS .VERSION KERNMPW 1.00 891208
-C ORIG. 06/02/89 JZ
-C
- COMMON /SLATE/ NXR, DUMMY(39)
- INTEGER XBV(999), XAV(NA), MBUF(512)
-C
- READ (LUN,END=61,ERR=64) NR,XAV,(XBV(J),J=1,MIN(NR,NXB))
- NXR = NR
- NR = MIN(NR,NXB)
- NSK = NXR - NR
- NXB = MAX(1,NR)
-
- 24 IF (NSK.LE.0) RETURN
- NR = MIN (NSK,512)
- READ (LUN,END=61,ERR=64) (MBUF(J),J=1,NR)
- NSK = NSK - NR
- GO TO 24
-C
- 61 NXB = 0
- RETURN
-C
- 64 NXB = -7
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/xvect/vaxgs/xinb.F b/src/packlib/kernlib/kerngen/xvect/vaxgs/xinb.F
deleted file mode 100644
index 2ace085..0000000
--- a/src/packlib/kernlib/kerngen/xvect/vaxgs/xinb.F
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: xinb.F,v 1.1.1.1 1996/02/15 17:50:36 mclareni Exp $
-*
-* $Log: xinb.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:36 mclareni
-* Kernlib
-*
-*
- SUBROUTINE XINB (LUN,XBV,NXB)
-C
-C CERN PROGLIB# Z203 XINB .VERSION KERNVAX 2.29 880809
-C ORIG. 8/02/88 JZ
-C
- COMMON /SLATE/ NXR, DUMMY(39)
- DIMENSION XBV(99)
-
- READ (LUN,IOSTAT=JSTAT) NR, (XBV(J),J=1,MIN(NR,NXB))
- IF (JSTAT) 61, 24, 64
- 24 NXR = NR
- NR = MIN (NR,NXB)
- NXB = MAX (NR,1)
- RETURN
-
- 61 NXB = 0
- RETURN
-
- 64 NXB = -JSTAT
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/xvect/vaxgs/xinbs.F b/src/packlib/kernlib/kerngen/xvect/vaxgs/xinbs.F
deleted file mode 100644
index 9630626..0000000
--- a/src/packlib/kernlib/kerngen/xvect/vaxgs/xinbs.F
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: xinbs.F,v 1.1.1.1 1996/02/15 17:50:36 mclareni Exp $
-*
-* $Log: xinbs.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:36 mclareni
-* Kernlib
-*
-*
- SUBROUTINE XINBS (LUN,XAV,NA,XBV,NXB)
-C
-C CERN PROGLIB# Z203 XINBS .VERSION KERNVAX 2.29 880809
-C ORIG. 8/02/88 JZ
-C
- COMMON /SLATE/ NXR, DUMMY(39)
- DIMENSION XBV(99), XAV(NA)
-
- READ (LUN,IOSTAT=JSTAT) NR,XAV,(XBV(J),J=1,MIN(NR,NXB))
- IF (JSTAT) 61, 24, 64
- 24 NXR = NR
- NR = MIN (NR,NXB)
- NXB = MAX (NR,1)
- RETURN
-
- 61 NXB = 0
- RETURN
-
- 64 NXB = -JSTAT
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/xvect/xinb.F b/src/packlib/kernlib/kerngen/xvect/xinb.F
deleted file mode 100644
index 0e52caa..0000000
--- a/src/packlib/kernlib/kerngen/xvect/xinb.F
+++ /dev/null
@@ -1,40 +0,0 @@
-*
-* $Id: xinb.F,v 1.1.1.1 1996/02/15 17:50:34 mclareni Exp $
-*
-* $Log: xinb.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:34 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QMMPW)
-#include "mpwgs/xinb.F"
-#elif defined(CERNLIB_QMVAX)
-#include "vaxgs/xinb.F"
-#elif defined(CERNLIB_QMIRT)
-#include "irtngs/xinb.F"
-#elif defined(CERNLIB_QMIRTD)
-#include "irtdgs/xinb.F"
-#else
- SUBROUTINE XINB (LUN,XBV,NXB)
-C
-C CERN PROGLIB# Z203 XINB .VERSION KERNFOR 4.31 911111
-C ORIG. 15/07/78 JZ
-C
- COMMON /SLATE/ NXR, DUMMY(39)
- DIMENSION XBV(*)
-C
- READ (LUN,IOSTAT=JSTAT) NR,(XBV(J),J=1,MIN(NR,NXB))
- IF (JSTAT) 61, 24, 64
- 24 NXR = NR
- NR = MIN(NR,NXB)
- NXB = MAX(1,NR)
- RETURN
-C
- 61 NXB = 0
- RETURN
-C
- 64 NXB = -JSTAT
- RETURN
- END
-#endif
diff --git a/src/packlib/kernlib/kerngen/xvect/xinbf.F b/src/packlib/kernlib/kerngen/xvect/xinbf.F
deleted file mode 100644
index ce9a287..0000000
--- a/src/packlib/kernlib/kerngen/xvect/xinbf.F
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: xinbf.F,v 1.1.1.1 1996/02/15 17:50:34 mclareni Exp $
-*
-* $Log: xinbf.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:34 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QMIRT)
-#include "irtngs/xinbf.F"
-#elif defined(CERNLIB_QMIRTD)
-#include "irtdgs/xinbf.F"
-#else
- SUBROUTINE XINBF (LUN,XBV,NXB)
-C
-C CERN PROGLIB# Z203 XINBF .VERSION KERNFOR 4.31 911111
-C ORIG. 15/07/78 JZ
-C
- DIMENSION XBV(NXB)
-C
- READ (LUN,IOSTAT=JSTAT) XBV
- IF (JSTAT) 61, 24, 64
-C
- 61 NXB = 0
- RETURN
-C
- 64 NXB = -JSTAT
- 24 RETURN
- END
-#endif
diff --git a/src/packlib/kernlib/kerngen/xvect/xinbs.F b/src/packlib/kernlib/kerngen/xvect/xinbs.F
deleted file mode 100644
index cc60865..0000000
--- a/src/packlib/kernlib/kerngen/xvect/xinbs.F
+++ /dev/null
@@ -1,40 +0,0 @@
-*
-* $Id: xinbs.F,v 1.1.1.1 1996/02/15 17:50:34 mclareni Exp $
-*
-* $Log: xinbs.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:34 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QMMPW)
-#include "mpwgs/xinbs.F"
-#elif defined(CERNLIB_QMVAX)
-#include "vaxgs/xinbs.F"
-#elif defined(CERNLIB_QMIRT)
-#include "irtngs/xinbs.F"
-#elif defined(CERNLIB_QMIRTD)
-#include "irtdgs/xinbs.F"
-#else
- SUBROUTINE XINBS (LUN,XAV,NA,XBV,NXB)
-C
-C CERN PROGLIB# Z203 XINBS .VERSION KERNFOR 4.31 911111
-C ORIG. 15/07/78 JZ
-C
- COMMON /SLATE/ NXR, DUMMY(39)
- DIMENSION XBV(*), XAV(NA)
-C
- READ (LUN,IOSTAT=JSTAT) NR,XAV,(XBV(J),J=1,MIN(NR,NXB))
- IF (JSTAT) 61, 24, 64
- 24 NXR = NR
- NR = MIN(NR,NXB)
- NXB = MAX(1,NR)
- RETURN
-C
- 61 NXB = 0
- RETURN
-C
- 64 NXB = -JSTAT
- RETURN
- END
-#endif
diff --git a/src/packlib/kernlib/kerngen/xvect/xincf.F b/src/packlib/kernlib/kerngen/xvect/xincf.F
deleted file mode 100644
index be45741..0000000
--- a/src/packlib/kernlib/kerngen/xvect/xincf.F
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: xincf.F,v 1.1.1.1 1996/02/15 17:50:34 mclareni Exp $
-*
-* $Log: xincf.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:34 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE XINCF (LUN,XBV,NXB)
-C
-C CERN PROGLIB# Z203 XINCF .VERSION KERNFOR 3.15 820113
-C ORIG. 15/07/78 JZ
-C
- DIMENSION XBV(NXB)
-C
- READ (LUN,8000,END=61,ERR=64) XBV
- RETURN
-C
- 61 NXB = 0
- RETURN
-C
- 64 NXB = -7
- RETURN
-C
-#if defined(CERNLIB_A4)
- 8000 FORMAT (35A4)
-#endif
-#if defined(CERNLIB_A5)
- 8000 FORMAT (28A5)
-#endif
-#if defined(CERNLIB_A6)
- 8000 FORMAT (23A6)
-#endif
-#if defined(CERNLIB_A8)
- 8000 FORMAT (16A8)
-#endif
-#if defined(CERNLIB_A10)
- 8000 FORMAT (14A10)
-#endif
- END
diff --git a/src/packlib/kernlib/kerngen/xvect/xoutb.F b/src/packlib/kernlib/kerngen/xvect/xoutb.F
deleted file mode 100644
index e50c04a..0000000
--- a/src/packlib/kernlib/kerngen/xvect/xoutb.F
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: xoutb.F,v 1.1.1.1 1996/02/15 17:50:34 mclareni Exp $
-*
-* $Log: xoutb.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:34 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QMIRTD)
-#include "irtdgs/xoutb.F"
-#else
- SUBROUTINE XOUTB (LUN,BV,NB)
-C
-C CERN PROGLIB# Z203 XOUTB .VERSION KERNFOR 3.05 780715
-C ORIG. 15/07/78 JZ
-C
- DIMENSION BV(NB)
-C
- WRITE (LUN) NB,BV
- RETURN
- END
-#endif
diff --git a/src/packlib/kernlib/kerngen/xvect/xoutbf.F b/src/packlib/kernlib/kerngen/xvect/xoutbf.F
deleted file mode 100644
index 32c795c..0000000
--- a/src/packlib/kernlib/kerngen/xvect/xoutbf.F
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: xoutbf.F,v 1.1.1.1 1996/02/15 17:50:35 mclareni Exp $
-*
-* $Log: xoutbf.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:35 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE XOUTBF (LUN,BV,NB)
-C
-C CERN PROGLIB# Z203 XOUTBF .VERSION KERNFOR 3.05 780715
-C ORIG. 15/07/78 JZ
-C
- DIMENSION BV(NB)
-C
- WRITE (LUN) BV
- RETURN
- END
diff --git a/src/packlib/kernlib/kerngen/xvect/xoutbs.F b/src/packlib/kernlib/kerngen/xvect/xoutbs.F
deleted file mode 100644
index 12e9807..0000000
--- a/src/packlib/kernlib/kerngen/xvect/xoutbs.F
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: xoutbs.F,v 1.1.1.1 1996/02/15 17:50:35 mclareni Exp $
-*
-* $Log: xoutbs.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:35 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
-#if defined(CERNLIB_QMIRTD)
-#include "irtdgs/xoutbs.F"
-#else
- SUBROUTINE XOUTBS (LUN,AV,NA,BV,NB)
-C
-C CERN PROGLIB# Z203 XOUTBS .VERSION KERNFOR 3.05 780715
-C ORIG. 15/07/78 JZ
-C
- DIMENSION BV(NB), AV(NA)
-C
- WRITE (LUN) NB,AV,BV
- RETURN
- END
-#endif
diff --git a/src/packlib/kernlib/kerngen/xvect/xoutcf.F b/src/packlib/kernlib/kerngen/xvect/xoutcf.F
deleted file mode 100644
index a5c5b16..0000000
--- a/src/packlib/kernlib/kerngen/xvect/xoutcf.F
+++ /dev/null
@@ -1,35 +0,0 @@
-*
-* $Id: xoutcf.F,v 1.1.1.1 1996/02/15 17:50:35 mclareni Exp $
-*
-* $Log: xoutcf.F,v $
-* Revision 1.1.1.1 1996/02/15 17:50:35 mclareni
-* Kernlib
-*
-*
-#include "kerngen/pilot.h"
- SUBROUTINE XOUTCF (LUN,BV,NB)
-C
-C CERN PROGLIB# Z203 XOUTCF .VERSION KERNFOR 3.15 820113
-C ORIG. 15/07/78 JZ
-C
- DIMENSION BV(NB)
-C
- WRITE (LUN,8000) BV
- RETURN
-C
-#if defined(CERNLIB_A4)
- 8000 FORMAT (35A4)
-#endif
-#if defined(CERNLIB_A5)
- 8000 FORMAT (28A5)
-#endif
-#if defined(CERNLIB_A6)
- 8000 FORMAT (23A6)
-#endif
-#if defined(CERNLIB_A8)
- 8000 FORMAT (16A8)
-#endif
-#if defined(CERNLIB_A10)
- 8000 FORMAT (14A10)
-#endif
- END
diff --git a/src/packlib/kernlib/kernnum/Imakefile b/src/packlib/kernlib/kernnum/Imakefile
deleted file mode 100644
index 534c713..0000000
--- a/src/packlib/kernlib/kernnum/Imakefile
+++ /dev/null
@@ -1,21 +0,0 @@
-
-#define IHaveSubdirs
-#define PassCDebugFlags
-
-
-LIBDIRS= c204fort c205fort \ @@\
- d106fort d509fort d703fort d704fort \ @@\
- e100fort e104fort e105fort e106fort e208fort \ @@\
- f002fort f003fort f004fort f010fort f011fort f012fort f406fort \ @@\
- g900fort g901fort \ @@\
- n001fort
-
-SUBDIRS= $(LIBDIRS) kernnum test
-
-TopOfPackage(kernnum)
-
-SubdirLibraryTarget(kernnum,$(LIBDIRS))
-
-TestSubdirs(test)
-
-InstallIncludeSubdirs(kernnum)
diff --git a/src/packlib/kernlib/kernnum/c204fort/Imakefile b/src/packlib/kernlib/kernnum/c204fort/Imakefile
deleted file mode 100644
index 0fd9fc8..0000000
--- a/src/packlib/kernlib/kernnum/c204fort/Imakefile
+++ /dev/null
@@ -1,19 +0,0 @@
-SRCS_F= muller.F
-
-#if defined(CERNLIB_IBMRT)
-SRCS_F+= cabs.F
-#endif
-
-#if defined(CERNLIB_DECS) && ! defined(CERNLIB_QMVAOS)
-FDEBUGFLAGS=NoOpFortranDebugFlags
-#endif
-#ifdef CERNLIB_HPUX
-/* Otherwise compiler error :
-Compiler error line 207 of /afs/.cern.ch/asis/share/cern/97a/src/packlib/kernlib/kernnum/c204fort/muller.F: Malloc: overflow detected in free(). (7816)
- GF, 10-Jun 96 */
-FDEBUGFLAGS=+O1
-#endif
-
-FORTRANSAVEOPTION = FortranSaveFlags
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kernnum/c204fort/cabs.F b/src/packlib/kernlib/kernnum/c204fort/cabs.F
deleted file mode 100644
index b85642d..0000000
--- a/src/packlib/kernlib/kernnum/c204fort/cabs.F
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: cabs.F,v 1.1.1.1 1996/02/15 17:48:46 mclareni Exp $
-*
-* $Log: cabs.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:46 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
-#if defined(CERNLIB_IBMRT)
- FUNCTION CABS(Z)
-C 20 APRIL 90
-C IBM CABS FAILS FOR CABS((0.,0.))
- COMPLEX Z
- REAL CABS,X,Y
-
- X=REAL(Z)
- Y=AIMAG(Z)
- CABS=SQRT(X**2 + Y**2)
- IF(X.EQ.0.AND.Y.EQ.0) CABS=0
- RETURN
- END
-#endif
diff --git a/src/packlib/kernlib/kernnum/c204fort/muller.F b/src/packlib/kernlib/kernnum/c204fort/muller.F
deleted file mode 100644
index 956d2aa..0000000
--- a/src/packlib/kernlib/kernnum/c204fort/muller.F
+++ /dev/null
@@ -1,207 +0,0 @@
-*
-* $Id: muller.F,v 1.1.1.1 1996/02/15 17:48:47 mclareni Exp $
-*
-* $Log: muller.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:47 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE MULLER (A,N,C)
-C
-C MODIFIED TO ELIMINATE STOP AND AVOID COMPILER DIAGNOSTICS
-C DUE TO ASSIGNED GOTO INTO DO 17. H.LIPPS, 30.6.1982.
-C
-C-----COMPUTES ROOTS OF POLYNOMIAL A(1)*X**N+...A(N)*X+A(N+1) = 0.
-C BY METHOD OF D.E.MULLER,M.T.A.C.,VOL 10, P208-215 (1956).
-C DURING EXECUTION THE ARRAY C CONTAINS SCALED,COMPLEX POLYNOMIAL
-C COEFFICIENTS.AFTER EXECUTION IT CONTAINS COMPLEX ROOTS.
-C THE FOLLOWING ARE DUMMY ARRAY DIMENSIONS
- DIMENSION A(9),C(9)
- COMPLEX C,DX,X,X3,Y1,Y2,Y,TE1,TE2,TE3,TE4,TE5,TE6,TE7
-#if defined(CERNLIB_IBMRT)
- EXTERNAL CABS
-#endif
- LOGICAL MFLAG, RFLAG
-#if defined(CERNLIB_NUMHIPRE)
- DATA ETA1/1.E-14/ ,ETA2/.6E-7/
-#endif
-#if defined(CERNLIB_NUMLOPRE)
- DATA ETA1/1.E-6/,ETA2/1.E-3/
-#endif
- SUMABS(X)=ABS(REAL(X))+ABS(AIMAG(X))
- IF(N .LT. 1) THEN
- CALL KERMTR('C204.1',LGFILE,MFLAG,RFLAG)
- IF(MFLAG) THEN
- IF(LGFILE .EQ. 0) THEN
- WRITE(*,1000) N
- ELSE
- WRITE(LGFILE,1000) N
- ENDIF
- ENDIF
- IF(.NOT. RFLAG) CALL ABEND
- RETURN
- ENDIF
- IF(A(1).EQ.0.) GO TO 105
-C
-C-----EXTRACT ALL ZERO ROOTS
- N1=N
- 2 IF(N1.EQ.1) GO TO 3
- IF(A(N1+1).NE.0.) GO TO 5
- C(N1)=0.
- N1=N1-1
- GO TO 2
- 3 C(1)=-A(2)/A(1)
- RETURN
-C
-C-----NORMALIZE AND SCALE DOWN POLYNOMIAL TO MAKE COEFF.C(0)=C(N1)= 1.
- 5 B=1./FLOAT(N1)
- SCALE=ABS(A(N1+1))**B/ABS(A(1))**B
- B=A(1)
- DO 6 I=1,N1
- B=B*SCALE
- 6 C(I)=A(I+1)/B
- IF(N1.EQ.2) GO TO 104
-C
-C-----STARTING VALUES AT X1=+1, X2=-1, X=0.
- 10 ASSIGN 20 TO L
- Y1=C(1)+1.
- Y2=C(1)-1.
- DO 11 I=2,N1
- Y1=C(I)+Y1
- 11 Y2=C(I)-Y2
- Y=C(N1)
- X=0.
- DX=1.
-C
-C-----MULLER"S ITERATION
- TE1=-2.
- 12 TE2=Y2/Y
- TE3=(Y1-Y2)/(Y*TE1)
- DO 17 ITER=1,2000
- TE4=TE2-1.
- TE5=(TE4-TE3)/(TE1+1.)
- TE6=(TE5+TE4)*.5
- TE7=SQRT(TE6*TE6+TE5)
- TE1=TE6+TE7
- TE7=TE6-TE7
- B=REAL(TE7)**2+AIMAG(TE7)**2
- IF(REAL(TE1)**2+AIMAG(TE1)**2.GT.B) GO TO 13
- IF(B.EQ.0.) TE7=.9
- TE1=TE7
- 13 DX=DX/TE1
- X=DX+X
- EPSI=SUMABS(X)*ETA1
- IF(SUMABS(DX).GE.EPSI) GO TO 14
- IF(SUMABS(Y).LT.2.E-3) GO TO 18
- 14 Y2=Y
- GO TO 199
-C
- 15 IF(YA.LT.100.*SUMABS(Y2)) GO TO 16
- IF(SUMABS(DX).LT.EPSI) GO TO 16
-C
-C-----REDUCE EXCESSIVE STEP SIZE DX,PREVENT OVERFLOW IN POLYN.EVALUATION
- TE1=TE1+TE1
- DX=.5*DX
- X=X-DX
-C
-C-----EVALUATE POLYNOMIAL AND TEST ZERO.
- 199 Y=X+C(1)
- DO 200 I=2,N1
- 200 Y=Y*X+C(I)
- YA=SUMABS(Y)
- IF(YA.EQ.0.) GO TO 18
- GOTO 15
-C
- 16 TE2=Y2/Y
- 17 TE3=TE2/TE1*TE4
-C-----SCALE DEFLATED POLYNOMIAL
- CN=CABS(C(N1))
- IF (ABS(CN-1.).LT.0.1) GO TO 35
- S=CN**(1./FLOAT(N1))
- SCALE=SCALE*S
- B=1.
- DO 30 I=1,N1
- B=B/S
- 30 C(I)=C(I)*B
- GO TO 10
-C-----IF ROOT CANNOT BE FOUND IN 2000 ITERATIONS PRINT ERROR MESSAGE
- 35 IMIN=N1+1
- DO 40 I=1,N1
- 40 C(I)=1.E20
- IMAX=N+1
- CALL KERMTR('C204.3',LGFILE,MFLAG,RFLAG)
- IF(MFLAG) THEN
- IF(LGFILE .EQ. 0) THEN
- WRITE(*,1003) (A(I),I=1,IMAX)
- IF(N1 .LT. N) WRITE(*,1004) (C(I),I=IMIN,N)
- ELSE
- WRITE(LGFILE,1003) (A(I),I=1,IMAX)
- IF(N1 .LT. N) WRITE(LGFILE,1004) (C(I),I=IMIN,N)
- ENDIF
- ENDIF
- IF(.NOT. RFLAG) CALL ABEND
- RETURN
-C
-C-----IF ROOT IS COMPLEX,START ITERATION NEAR CONJUGATE ROOT(HIGH PREC.)
- 20 IF(ABS(AIMAG(X)).LT.ABS(REAL(X))*ETA2) GO TO 10
- ASSIGN 10 TO L
- X3=CONJG(X)
- DX=CONJG(DX)
- TE1=CONJG(TE1)
- X=X3-DX
- ASSIGN 21 TO M
- GO TO 99
- 21 Y2=Y
- X=X-DX*TE1
- ASSIGN 22 TO M
- GO TO 99
- 22 Y1=Y
- X=X3
- ASSIGN 12 TO M
- GO TO 99
-C
-C-----EVALUATE POLYNOMIAL AND TEST ZERO.
- 99 Y=X+C(1)
- DO 100 I=2,N1
- 100 Y=Y*X+C(I)
- YA=SUMABS(Y)
- IF(YA.NE.0.) GO TO M,(12,21,22)
-C
-C-----IF A ROOT IS FOUND REDUCE DEGREE OF POLYNOMIAL(DEFLATION)
- 18 C(N1)=X*SCALE
- N1=N1-1
- C(1)=X+C(1)
- DO 19 I=2,N1
- 19 C(I)=C(I-1)*X+C(I)
- IF(N1.GT.2) GO TO L,(10,20)
-C
-C-----SOLVE QUADRATIC EQUATION AND RETURN
- 104 TE6=.5*C(1)
- C(2)=(CSQRT(TE6*TE6-C(2))-TE6)*SCALE
- C(1)=-C(1)*SCALE-C(2)
- RETURN
- 105 IMAX=N+1
- CALL KERMTR('C204.2',LGFILE,MFLAG,RFLAG)
- IF(MFLAG) THEN
- IF(LGFILE .EQ. 0) THEN
- WRITE(*,1001) (A(I),I=1,IMAX)
- ELSE
- WRITE(LGFILE,1001) (A(I),I=1,IMAX)
- ENDIF
- ENDIF
- IF(.NOT. RFLAG) CALL ABEND
- RETURN
-C
- 1000 FORMAT( 7X, 'SUBROUTINE MULLER ... THE DEGREE N OF THE ',
- + 'POLYNOMIAL =', I6, ' IS LESS THAN 1.')
- 1001 FORMAT( 7X, 'SUBROUTINE MULLER ...'/' THE POLYNOMIAL ',
- 1'CANNOT HAVE N ROOTS BECAUSE THE COEFFICIENT OF Z**N (FIRST ',
- 2'COEFFICIENT ) IS ZERO. THE COEFFICIENTS ARE'/(1H0,8G14.6))
- 1003 FORMAT( 7X, 'SUBROUTINE MULLER ... ',' ROOT CANNOT BE FOUND ',
- 1'WITH 2000 ITERATIONS'/' REVERSE THE SEQUENCE OF COEFFICIENTS ',
- 2' A(N+1)...A(1) AND CALL MULLER AGAIN TO COMPUTE 1/ROOT.' /
- 3 ' THE COEFFICIENTS ARE' //(1H0,8G14.6))
- 1004 FORMAT(41H0ONLY THE FOLLOWING ROOTS HAVE BEEN FOUND//(2H (,E20.13,
- 11H, ,3X,E20.13,1H) ))
- END
diff --git a/src/packlib/kernlib/kernnum/c205fort/Imakefile b/src/packlib/kernlib/kernnum/c205fort/Imakefile
deleted file mode 100644
index 7cc965c..0000000
--- a/src/packlib/kernlib/kernnum/c205fort/Imakefile
+++ /dev/null
@@ -1,11 +0,0 @@
-SRCS_F= \ @@\
- dzero.F rzero.F
-
-#if defined(CERNLIB_DECS) && ! defined(CERNLIB_QMVAOS)
-FDEBUGFLAGS=NoOpFortranDebugFlags
-#endif
-
-FORTRANSAVEOPTION = FortranSaveFlags
-
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kernnum/c205fort/c205body.inc b/src/packlib/kernlib/kernnum/c205fort/c205body.inc
deleted file mode 100644
index df7de26..0000000
--- a/src/packlib/kernlib/kernnum/c205fort/c205body.inc
+++ /dev/null
@@ -1,129 +0,0 @@
-*
-* $Id: c205body.inc,v 1.1.1.1 1996/02/15 17:49:07 mclareni Exp $
-*
-* $Log: c205body.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:49:07 mclareni
-* Kernlib
-*
-*
-#ifndef CERNLIB_KERNNUM_C205BODY_INC
-#define CERNLIB_KERNNUM_C205BODY_INC
-*
-*
-* c205body.inc
-*
- LOGICAL MFLAG,RFLAG
- EXTERNAL F
-
- PARAMETER (ONE = 1, HALF = ONE/2)
-
- XA=MIN(A,B)
- XB=MAX(A,B)
- FA=F(XA,1)
- FB=F(XB,2)
- IF(FA*FB .GT. 0) GO TO 5
- MC=0
-
- 1 X0=HALF*(XA+XB)
- R=X0-XA
- EE=EPS*(ABS(X0)+1)
- IF(R .LE. EE) GO TO 4
- F1=FA
- X1=XA
- F2=FB
- X2=XB
-
- 2 FX=F(X0,2)
- MC=MC+1
- IF(MC .GT. MXF) GO TO 6
- IF(FX*FA .GT. 0) THEN
- XA=X0
- FA=FX
- ELSE
- XB=X0
- FB=FX
- END IF
-
- 3 U1=F1-F2
- U2=X1-X2
- U3=F2-FX
- U4=X2-X0
- IF(U2 .EQ. 0 .OR. U4 .EQ. 0) GO TO 1
- F3=FX
- X3=X0
- U1=U1/U2
- U2=U3/U4
- CA=U1-U2
- CB=(X1+X2)*U2-(X2+X0)*U1
- CC=(X1-X0)*F1-X1*(CA*X1+CB)
- IF(CA .EQ. 0) THEN
- IF(CB .EQ. 0) GO TO 1
- X0=-CC/CB
- ELSE
- U3=CB/(2*CA)
- U4=U3*U3-CC/CA
- IF(U4 .LT. 0) GO TO 1
- X0=-U3+SIGN(SQRT(U4),X0+U3)
- END IF
- IF(X0 .LT. XA .OR. X0 .GT. XB) GO TO 1
-
- R=MIN(ABS(X0-X3),ABS(X0-X2))
- EE=EPS*(ABS(X0)+1)
- IF(R .GT. EE) THEN
- F1=F2
- X1=X2
- F2=F3
- X2=X3
- GO TO 2
- END IF
-
- FX=F(X0,2)
- IF(FX .EQ. 0) GO TO 4
- IF(FX*FA .LT. 0) THEN
- XX=X0-EE
- IF(XX .LE. XA) GO TO 4
- FF=F(XX,2)
- FB=FF
- XB=XX
- ELSE
- XX=X0+EE
- IF(XX .GE. XB) GO TO 4
- FF=F(XX,2)
- FA=FF
- XA=XX
- END IF
- IF(FX*FF .GT. 0) THEN
- MC=MC+2
- IF(MC .GT. MXF) GO TO 6
- F1=F3
- X1=X3
- F2=FX
- X2=X0
- X0=XX
- FX=FF
- GO TO 3
- END IF
-
- 4 R=EE
- FF=F(X0,3)
- RETURN
- 5 CALL KERMTR('C205.1',LGFILE,MFLAG,RFLAG)
- IF(MFLAG) THEN
- IF(LGFILE .EQ. 0) WRITE(*,100)
- IF(LGFILE .NE. 0) WRITE(LGFILE,100)
- END IF
- IF(.NOT.RFLAG) CALL ABEND
- R=-2*(XB-XA)
- X0=0
- RETURN
- 6 CALL KERMTR('C205.2',LGFILE,MFLAG,RFLAG)
- IF(MFLAG) THEN
- IF(LGFILE .EQ. 0) WRITE(*,101)
- IF(LGFILE .NE. 0) WRITE(LGFILE,101)
- END IF
- IF(.NOT.RFLAG) CALL ABEND
- R=-HALF*ABS(XB-XA)
- X0=0
- RETURN
-
-#endif
diff --git a/src/packlib/kernlib/kernnum/c205fort/dzero.F b/src/packlib/kernlib/kernnum/c205fort/dzero.F
deleted file mode 100644
index 78d2f61..0000000
--- a/src/packlib/kernlib/kernnum/c205fort/dzero.F
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: dzero.F,v 1.1.1.1 1996/02/15 17:49:07 mclareni Exp $
-*
-* $Log: dzero.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:07 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
-#if defined(CERNLIB_NUMLOPRE)
- SUBROUTINE DZERO(A,B,X0,R,EPS,MXF,F)
- IMPLICIT DOUBLE PRECISION (A-H,O-Z)
-#include "c205body.inc"
- 100 FORMAT(1X,'***** CERN C205 DZERO ... F(A) AND F(B)',
- 1 ' HAVE THE SAME SIGN')
- 101 FORMAT(1X,'***** CERN C205 DZERO ... TOO MANY FUNCTION CALLS')
- END
-#endif
diff --git a/src/packlib/kernlib/kernnum/c205fort/rzero.F b/src/packlib/kernlib/kernnum/c205fort/rzero.F
deleted file mode 100644
index c0fb515..0000000
--- a/src/packlib/kernlib/kernnum/c205fort/rzero.F
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: rzero.F,v 1.1.1.1 1996/02/15 17:49:07 mclareni Exp $
-*
-* $Log: rzero.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:07 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE RZERO(A,B,X0,R,EPS,MXF,F)
- IMPLICIT REAL (A-H,O-Z)
-#include "c205body.inc"
- 100 FORMAT(1X,'***** CERN C205 RZERO ... F(A) AND F(B)',
- 1 ' HAVE THE SAME SIGN')
- 101 FORMAT(1X,'***** CERN C205 RZERO ... TOO MANY FUNCTION CALLS')
- END
diff --git a/src/packlib/kernlib/kernnum/c308fort/Imakefile b/src/packlib/kernlib/kernnum/c308fort/Imakefile
deleted file mode 100644
index f6a91de..0000000
--- a/src/packlib/kernlib/kernnum/c308fort/Imakefile
+++ /dev/null
@@ -1,9 +0,0 @@
-SRCS_F= ellice.F ellick.F
-
-#if defined(CERNLIB_DECS) && ! defined(CERNLIB_QMVAOS)
-FDEBUGFLAGS=NoOpFortranDebugFlags
-#endif
-
-FORTRANSAVEOPTION = FortranSaveFlags
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kernnum/c308fort/ellice.F b/src/packlib/kernlib/kernnum/c308fort/ellice.F
deleted file mode 100644
index 8f8ce4d..0000000
--- a/src/packlib/kernlib/kernnum/c308fort/ellice.F
+++ /dev/null
@@ -1,90 +0,0 @@
-*
-* $Id: ellice.F,v 1.1.1.1 1996/02/15 17:49:07 mclareni Exp $
-*
-* $Log: ellice.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:07 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- REAL FUNCTION ELLICE(RX)
- REAL RX,SX
- CHARACTER*6 ENAME
- LOGICAL MFLAG,RFLAG
-#if defined(CERNLIB_NUMHIPRE)
- REAL DELLIE,X,ETA,ZERO,ONE,A(8),B(8),PA,PB,D
-#endif
-#if defined(CERNLIB_NUMLOPRE)
- DOUBLE PRECISION DELLIE,X,ETA,ZERO,ONE,A(8),B(8),PA,PB,D
- DOUBLE PRECISION DX
-#endif
-
- DATA ZERO /0.0D0/, ONE /1.0D0/
- DATA A
- 1/7.09809 64089 987D-4, 7.33561 64974 290D-3,
- 2 1.53771 02528 552D-2, 1.30341 46073 731D-2,
- 3 1.25105 92410 845D-2, 2.18762 20647 186D-2,
- 4 5.68056 57874 695D-2, 4.43147 18112 156D-1/
- DATA B
- 1/1.64272 10797 048D-4, 3.48386 79435 896D-3,
- 2 1.55251 29948 041D-2, 3.03027 47728 413D-2,
- 3 4.23828 07456 948D-2, 5.85828 39536 559D-2,
- 4 9.37499 20249 680D-2, 2.49999 99993 618D-1/
-#if defined(CERNLIB_NUMHIPRE)
- ROUND(D) = D
-#endif
-#if defined(CERNLIB_NUMLOPRE)
- ROUND(D) = SNGL(D+(D-DBLE(SNGL(D))))
-#endif
-
- ENAME='ELLICE'
- X=RX
-#if defined(CERNLIB_NUMLOPRE)
- GOTO 9
- ENTRY DELLIE(DX)
- ENAME='DELLIE'
- X=DX
-#endif
-
- 9 U=ABS(X)
- IF(U .LT. ONE) THEN
- ETA=ONE-X**2
- PA=A(1)
- PB=B(1)
- DO 1 I = 2,8
- PA=PA*ETA+A(I)
- 1 PB=PB*ETA+B(I)
- PB=ONE+(PA-LOG(ETA)*PB)*ETA
- IF(ENAME .EQ. 'ELLICE') THEN
- ELLICE = ROUND(PB)
- ELSE
- DELLIE = PB
- ENDIF
- ELSE IF(U .EQ. ONE) THEN
- IF(ENAME .EQ. 'ELLICE') THEN
- ELLICE = ONE
- ELSE
- DELLIE = ONE
- ENDIF
- ELSE
- CALL KERMTR('C308.1',LGFILE,MFLAG,RFLAG)
- IF(MFLAG) THEN
- SX=X
- IF(LGFILE .EQ. 0) THEN
- WRITE(*,100) ENAME,SX
- ELSE
- WRITE(LGFILE,100) ENAME,SX
- ENDIF
- ENDIF
- IF(.NOT.RFLAG) CALL ABEND
- IF(ENAME .EQ. 'ELLICE') THEN
- ELLICE = ZERO
- ELSE
- DELLIE = ZERO
- ENDIF
- ENDIF
- RETURN
-
-
- 100 FORMAT(7X,A6,' ... ILLEGAL ARGUMENT = ',E16.6)
- END
diff --git a/src/packlib/kernlib/kernnum/c308fort/ellick.F b/src/packlib/kernlib/kernnum/c308fort/ellick.F
deleted file mode 100644
index 7ba087f..0000000
--- a/src/packlib/kernlib/kernnum/c308fort/ellick.F
+++ /dev/null
@@ -1,83 +0,0 @@
-*
-* $Id: ellick.F,v 1.1.1.1 1996/02/15 17:49:07 mclareni Exp $
-*
-* $Log: ellick.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:07 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- REAL FUNCTION ELLICK(RX)
- REAL RX,SX
- CHARACTER*6 ENAME
- LOGICAL MFLAG,RFLAG
-#if defined(CERNLIB_NUMHIPRE)
- REAL DELLIK,X,ETA,ZERO,ONE,HALF,C,A(8),B(8),PA,PB,D
-#endif
-#if defined(CERNLIB_NUMLOPRE)
- DOUBLE PRECISION DELLIK,X,ETA,ZERO,ONE,HALF,C,A(8),B(8),PA,PB,D
- DOUBLE PRECISION DX
-#endif
-
- DATA ZERO /0.0D0/, ONE /1.0D0/, HALF /0.5D0/
- DATA C /1.38629 43611 199D0/
- DATA A
- 1/6.49984 43329 390D-4, 6.69055 09906 898D-3,
- 2 1.38556 01247 157D-2, 1.12089 18554 644D-2,
- 3 9.65875 79861 753D-3, 1.49789 88178 705D-2,
- 4 3.08855 73486 753D-2, 9.65735 90797 589D-2/
- DATA B
- 1/1.50491 81783 602D-4, 3.18313 09927 863D-3,
- 2 1.41053 80776 158D-2, 2.71898 61116 788D-2,
- 3 3.70683 98934 155D-2, 4.88180 58565 404D-2,
- 4 7.03124 26464 627D-2, 1.24999 99994 118D-1/
-#if defined(CERNLIB_NUMHIPRE)
- ROUND(D) = D
-#endif
-#if defined(CERNLIB_NUMLOPRE)
- ROUND(D) = SNGL(D+(D-DBLE(SNGL(D))))
-#endif
-
- ENAME='ELLICK'
- X=RX
-#if defined(CERNLIB_NUMLOPRE)
- GOTO 9
- ENTRY DELLIK(DX)
- ENAME='DELLIK'
- X=DX
-#endif
-
- 9 IF(ABS(X) .LT. ONE) THEN
- ETA=ONE-X**2
- PA=A(1)
- PB=B(1)
- DO 1 I = 2,8
- PA=PA*ETA+A(I)
- 1 PB=PB*ETA+B(I)
- PB=C+PA*ETA-LOG(ETA)*(HALF+PB*ETA)
- IF(ENAME .EQ. 'ELLICK') THEN
- ELLICK = ROUND(PB)
- ELSE
- DELLIK = PB
- ENDIF
- ELSE
- CALL KERMTR('C308.1',LGFILE,MFLAG,RFLAG)
- IF(MFLAG) THEN
- SX=X
- IF(LGFILE .EQ. 0) THEN
- WRITE(*,100) ENAME,SX
- ELSE
- WRITE(LGFILE,100) ENAME,SX
- ENDIF
- ENDIF
- IF(.NOT.RFLAG) CALL ABEND
- IF(ENAME .EQ. 'ELLICK') THEN
- ELLICK = ZERO
- ELSE
- DELLIK = ZERO
- ENDIF
- ENDIF
- RETURN
-
- 100 FORMAT(7X,A6,' ... ILLEGAL ARGUMENT = ',E16.6)
- END
diff --git a/src/packlib/kernlib/kernnum/c312fort/Imakefile b/src/packlib/kernlib/kernnum/c312fort/Imakefile
deleted file mode 100644
index 87c4613..0000000
--- a/src/packlib/kernlib/kernnum/c312fort/Imakefile
+++ /dev/null
@@ -1,9 +0,0 @@
-SRCS_F= besj0.F besj1.F besy0.F besy1.F
-
-#if defined(CERNLIB_DECS) && ! defined(CERNLIB_QMVAOS)
-FDEBUGFLAGS=NoOpFortranDebugFlags
-#endif
-
-FORTRANSAVEOPTION = FortranSaveFlags
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kernnum/c312fort/besj0.F b/src/packlib/kernlib/kernnum/c312fort/besj0.F
deleted file mode 100644
index 4a96226..0000000
--- a/src/packlib/kernlib/kernnum/c312fort/besj0.F
+++ /dev/null
@@ -1,120 +0,0 @@
-*
-* $Id: besj0.F,v 1.1.1.1 1996/02/15 17:49:07 mclareni Exp $
-*
-* $Log: besj0.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:07 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- REAL FUNCTION BESJ0(RX)
- REAL RX
- CHARACTER*6 ENAME
-#if defined(CERNLIB_NUMHIPRE)
- REAL DBESJ0,X,Y,V,H,ALFA,ZERO,ONE,TWO,EIGHT,D
- REAL PI1,PI2,C1(0:14),C2(0:9),C3(0:10),B0,B1,B2,P,Q,R
-#endif
-#if defined(CERNLIB_NUMLOPRE)
- DOUBLE PRECISION X,Y,V,H,ALFA,ZERO,ONE,TWO,EIGHT,D
- DOUBLE PRECISION PI1,PI2,C1(0:14),C2(0:9),C3(0:10),B0,B1,B2,P,Q,R
- DOUBLE PRECISION DBESJ0,DX
-#endif
-
- DATA ZERO /0.0D0/, ONE /1.0D0/, TWO /2.0D0/, EIGHT /8.0D0/
- DATA PI1 /0.79788 45608 0287D0/, PI2 /0.78539 81633 9745D0/
-
- DATA C1( 0) /+0.15772 79714 7489D0/
- DATA C1( 1) /-0.00872 34423 5285D0/
- DATA C1( 2) /+0.26517 86132 0334D0/
- DATA C1( 3) /-0.37009 49938 7265D0/
- DATA C1( 4) /+0.15806 71023 3210D0/
- DATA C1( 5) /-0.03489 37694 1141D0/
- DATA C1( 6) /+0.00481 91800 6947D0/
- DATA C1( 7) /-0.00046 06261 6621D0/
- DATA C1( 8) /+0.00003 24603 2882D0/
- DATA C1( 9) /-0.00000 17619 4691D0/
- DATA C1(10) /+0.00000 00760 8164D0/
- DATA C1(11) /-0.00000 00026 7925D0/
- DATA C1(12) /+0.00000 00000 7849D0/
- DATA C1(13) /-0.00000 00000 0194D0/
- DATA C1(14) /+0.00000 00000 0004D0/
-
- DATA C2( 0) /+0.99946 03493 4752D0/
- DATA C2( 1) /-0.00053 65220 4681D0/
- DATA C2( 2) /+0.00000 30751 8479D0/
- DATA C2( 3) /-0.00000 00517 0595D0/
- DATA C2( 4) /+0.00000 00016 3065D0/
- DATA C2( 5) /-0.00000 00000 7864D0/
- DATA C2( 6) /+0.00000 00000 0517D0/
- DATA C2( 7) /-0.00000 00000 0043D0/
- DATA C2( 8) /+0.00000 00000 0004D0/
- DATA C2( 9) /-0.00000 00000 0001D0/
-
- DATA C3( 0) /-0.01555 58546 05337D0/
- DATA C3( 1) /+0.00006 83851 99426D0/
- DATA C3( 2) /-0.00000 07414 49841D0/
- DATA C3( 3) /+0.00000 00179 72457D0/
- DATA C3( 4) /-0.00000 00007 27192D0/
- DATA C3( 5) /+0.00000 00000 42201D0/
- DATA C3( 6) /-0.00000 00000 03207D0/
- DATA C3( 7) /+0.00000 00000 00301D0/
- DATA C3( 8) /-0.00000 00000 00033D0/
- DATA C3( 9) /+0.00000 00000 00004D0/
- DATA C3(10) /-0.00000 00000 00001D0/
-#if defined(CERNLIB_NUMHIPRE)
- ROUND(D) = D
-#endif
-#if defined(CERNLIB_NUMLOPRE)
- ROUND(D) = SNGL(D+(D-DBLE(SNGL(D))))
-#endif
-
- X=RX
- ENAME=' BESJ0'
-#if defined(CERNLIB_NUMLOPRE)
- GOTO 9
- ENTRY DBESJ0(DX)
- ENAME='DBESJ0'
- X=DX
-#endif
-
- 9 V=ABS(X)
- IF(V .LT. EIGHT) THEN
- Y=V/EIGHT
- H=TWO*Y**2-ONE
- ALFA=-TWO*H
- B1=ZERO
- B2=ZERO
- DO 1 I = 14,0,-1
- B0=C1(I)-ALFA*B1-B2
- B2=B1
- 1 B1=B0
- B1=B0-H*B2
- ELSE
- R=ONE/V
- Y=EIGHT*R
- H=TWO*Y**2-ONE
- ALFA=-TWO*H
- B1=ZERO
- B2=ZERO
- DO 2 I = 9,0,-1
- B0=C2(I)-ALFA*B1-B2
- B2=B1
- 2 B1=B0
- P=B0-H*B2
- B1=ZERO
- B2=ZERO
- DO 3 I = 10,0,-1
- B0=C3(I)-ALFA*B1-B2
- B2=B1
- 3 B1=B0
- Q=Y*(B0-H*B2)
- B0=V-PI2
- B1=PI1*SQRT(R)*(P*COS(B0)-Q*SIN(B0))
- ENDIF
- IF(ENAME .EQ. ' BESJ0') THEN
- BESJ0=ROUND(B1)
- ELSE
- DBESJ0=B1
- ENDIF
- RETURN
- END
diff --git a/src/packlib/kernlib/kernnum/c312fort/besj1.F b/src/packlib/kernlib/kernnum/c312fort/besj1.F
deleted file mode 100644
index dfb6320..0000000
--- a/src/packlib/kernlib/kernnum/c312fort/besj1.F
+++ /dev/null
@@ -1,119 +0,0 @@
-*
-* $Id: besj1.F,v 1.1.1.1 1996/02/15 17:49:08 mclareni Exp $
-*
-* $Log: besj1.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:08 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- REAL FUNCTION BESJ1(RX)
- REAL RX
- CHARACTER*6 ENAME
-#if defined(CERNLIB_NUMHIPRE)
- REAL DBESJ1,X,Y,V,H,ALFA,ZERO,ONE,TWO,EIGHT,D
- REAL PI1,PI2,C1(0:14),C2(0:9),C3(0:10),B0,B1,B2,P,Q,R
-#endif
-#if defined(CERNLIB_NUMLOPRE)
- DOUBLE PRECISION X,Y,V,H,ALFA,ZERO,ONE,TWO,EIGHT,D
- DOUBLE PRECISION PI1,PI2,C1(0:14),C2(0:7),C3(0:10),B0,B1,B2,P,Q,R
- DOUBLE PRECISION DBESJ1,DX
-#endif
-
- DATA ZERO /0.0D0/, ONE /1.0D0/, TWO /2.0D0/, EIGHT /8.0D0/
- DATA PI1 /0.79788 45608 0287D0/, PI2 /2.35619 44901 923D0/
-
- DATA C1( 0) /+0.05245 81903 3466D0/
- DATA C1( 1) /+0.04809 64691 5823D0/
- DATA C1( 2) /+0.31327 50823 6157D0/
- DATA C1( 3) /-0.24186 74084 4741D0/
- DATA C1( 4) /+0.07426 67962 1679D0/
- DATA C1( 5) /-0.01296 76273 1174D0/
- DATA C1( 6) /+0.00148 99128 9667D0/
- DATA C1( 7) /-0.00012 22786 8504D0/
- DATA C1( 8) /+0.00000 75626 3023D0/
- DATA C1( 9) /-0.00000 03661 3086D0/
- DATA C1(10) /+0.00000 00142 7732D0/
- DATA C1(11) /-0.00000 00004 5857D0/
- DATA C1(12) /+0.00000 00000 1235D0/
- DATA C1(13) /-0.00000 00000 0028D0/
- DATA C1(14) /+0.00000 00000 0001D0/
-
- DATA C2( 0) /+1.00090 30408 600D0/
- DATA C2( 1) /+0.00089 89898 331D0/
- DATA C2( 2) /-0.00000 39872 843D0/
- DATA C2( 3) /+0.00000 00617 763D0/
- DATA C2( 4) /-0.00000 00018 719D0/
- DATA C2( 5) /+0.00000 00000 882D0/
- DATA C2( 6) /-0.00000 00000 057D0/
- DATA C2( 7) /+0.00000 00000 005D0/
-
- DATA C3( 0) /+0.04677 77870 69525D0/
- DATA C3( 1) /-0.00009 62772 35492D0/
- DATA C3( 2) /+0.00000 09138 61526D0/
- DATA C3( 3) /-0.00000 00209 59781D0/
- DATA C3( 4) /+0.00000 00008 22919D0/
- DATA C3( 5) /-0.00000 00000 46864D0/
- DATA C3( 6) /+0.00000 00000 03515D0/
- DATA C3( 7) /-0.00000 00000 00326D0/
- DATA C3( 8) /+0.00000 00000 00036D0/
- DATA C3( 9) /-0.00000 00000 00005D0/
- DATA C3(10) /+0.00000 00000 00001D0/
-#if defined(CERNLIB_NUMHIPRE)
- ROUND(D) = D
-#endif
-#if defined(CERNLIB_NUMLOPRE)
- ROUND(D) = SNGL(D+(D-DBLE(SNGL(D))))
-#endif
-
- X=RX
- ENAME=' BESJ1'
-#if defined(CERNLIB_NUMLOPRE)
- GOTO 9
- ENTRY DBESJ1(DX)
- ENAME='DBESJ1'
- X=DX
-#endif
-
- 9 V=ABS(X)
- IF(V .LT. EIGHT) THEN
- Y=X/EIGHT
- H=TWO*Y**2-ONE
- ALFA=-TWO*H
- B1=ZERO
- B2=ZERO
- DO 1 I = 14,0,-1
- B0=C1(I)-ALFA*B1-B2
- B2=B1
- 1 B1=B0
- B1=Y*(B0-B2)
- ELSE
- R=ONE/V
- Y=EIGHT*R
- H=TWO*Y**2-ONE
- ALFA=-TWO*H
- B1=ZERO
- B2=ZERO
- DO 2 I = 7,0,-1
- B0=C2(I)-ALFA*B1-B2
- B2=B1
- 2 B1=B0
- P=B0-H*B2
- B1=ZERO
- B2=ZERO
- DO 3 I = 10,0,-1
- B0=C3(I)-ALFA*B1-B2
- B2=B1
- 3 B1=B0
- Q=Y*(B0-H*B2)
- B0=V-PI2
- B1=PI1*SQRT(R)*(P*COS(B0)-Q*SIN(B0))
- IF(X .LT. ZERO) B1=-B1
- ENDIF
- IF(ENAME .EQ. ' BESJ1') THEN
- BESJ1=ROUND(B1)
- ELSE
- DBESJ1=B1
- ENDIF
- RETURN
- END
diff --git a/src/packlib/kernlib/kernnum/c312fort/besy0.F b/src/packlib/kernlib/kernnum/c312fort/besy0.F
deleted file mode 100644
index c8c1b38..0000000
--- a/src/packlib/kernlib/kernnum/c312fort/besy0.F
+++ /dev/null
@@ -1,164 +0,0 @@
-*
-* $Id: besy0.F,v 1.1.1.1 1996/02/15 17:49:08 mclareni Exp $
-*
-* $Log: besy0.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:08 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- REAL FUNCTION BESY0(RX)
- REAL RX,SX
- CHARACTER*6 ENAME
- LOGICAL MFLAG,RFLAG
-#if defined(CERNLIB_NUMHIPRE)
- REAL DBESY0,X,Y,H,ALFA,ZERO,ONE,TWO,EIGHT,B0,B1,B2,P,Q,R,D
- REAL PI1,PI2,PI3,CE,C1(0:14),C2(0:14),C3(0:9),C4(0:10)
-#endif
-#if defined(CERNLIB_NUMLOPRE)
- DOUBLE PRECISION X,Y,H,ALFA,ZERO,ONE,TWO,EIGHT,B0,B1,B2,P,Q,R,D
- DOUBLE PRECISION PI1,PI2,PI3,CE,C1(0:14),C2(0:14),C3(0:9),C4(0:10)
- DOUBLE PRECISION DBESY0,DX
-#endif
-
- DATA ZERO /0.0D0/, ONE /1.0D0/, TWO /2.0D0/, EIGHT /8.0D0/
-
- DATA PI1 /0.79788 45608 0287D0/, PI2 /0.63661 97723 6758D0/
- DATA PI3 /0.78539 81633 9745D0/, CE /0.57721 56649 0153D0/
-
- DATA C1( 0) /+0.15772 79714 7489D0/
- DATA C1( 1) /-0.00872 34423 5285D0/
- DATA C1( 2) /+0.26517 86132 0334D0/
- DATA C1( 3) /-0.37009 49938 7265D0/
- DATA C1( 4) /+0.15806 71023 3210D0/
- DATA C1( 5) /-0.03489 37694 1141D0/
- DATA C1( 6) /+0.00481 91800 6947D0/
- DATA C1( 7) /-0.00046 06261 6621D0/
- DATA C1( 8) /+0.00003 24603 2882D0/
- DATA C1( 9) /-0.00000 17619 4691D0/
- DATA C1(10) /+0.00000 00760 8164D0/
- DATA C1(11) /-0.00000 00026 7925D0/
- DATA C1(12) /+0.00000 00000 7849D0/
- DATA C1(13) /-0.00000 00000 0194D0/
- DATA C1(14) /+0.00000 00000 0004D0/
-
- DATA C2( 0) /-0.02150 51114 4966D0/
- DATA C2( 1) /-0.27511 81330 4352D0/
- DATA C2( 2) /+0.19860 56347 0255D0/
- DATA C2( 3) /+0.23425 27461 0902D0/
- DATA C2( 4) /-0.16563 59817 1365D0/
- DATA C2( 5) /+0.04462 13795 4067D0/
- DATA C2( 6) /-0.00693 22862 9152D0/
- DATA C2( 7) /+0.00071 91174 0375D0/
- DATA C2( 8) /-0.00005 39250 7972D0/
- DATA C2( 9) /+0.00000 30764 9329D0/
- DATA C2(10) /-0.00000 01384 5718D0/
- DATA C2(11) /+0.00000 00050 5105D0/
- DATA C2(12) /-0.00000 00001 5258D0/
- DATA C2(13) /+0.00000 00000 0388D0/
- DATA C2(14) /-0.00000 00000 0008D0/
-
- DATA C3( 0) /+0.99946 03493 4752D0/
- DATA C3( 1) /-0.00053 65220 4681D0/
- DATA C3( 2) /+0.00000 30751 8479D0/
- DATA C3( 3) /-0.00000 00517 0595D0/
- DATA C3( 4) /+0.00000 00016 3065D0/
- DATA C3( 5) /-0.00000 00000 7864D0/
- DATA C3( 6) /+0.00000 00000 0517D0/
- DATA C3( 7) /-0.00000 00000 0043D0/
- DATA C3( 8) /+0.00000 00000 0004D0/
- DATA C3( 9) /-0.00000 00000 0001D0/
-
- DATA C4( 0) /-0.01555 58546 05337D0/
- DATA C4( 1) /+0.00006 83851 99426D0/
- DATA C4( 2) /-0.00000 07414 49841D0/
- DATA C4( 3) /+0.00000 00179 72457D0/
- DATA C4( 4) /-0.00000 00007 27192D0/
- DATA C4( 5) /+0.00000 00000 42201D0/
- DATA C4( 6) /-0.00000 00000 03207D0/
- DATA C4( 7) /+0.00000 00000 00301D0/
- DATA C4( 8) /-0.00000 00000 00033D0/
- DATA C4( 9) /+0.00000 00000 00004D0/
- DATA C4(10) /-0.00000 00000 00001D0/
-#if defined(CERNLIB_NUMHIPRE)
- ROUND(D) = D
-#endif
-#if defined(CERNLIB_NUMLOPRE)
- ROUND(D) = SNGL(D+(D-DBLE(SNGL(D))))
-#endif
-
- ENAME=' BESY0'
- X=RX
-#if defined(CERNLIB_NUMLOPRE)
- GOTO 9
- ENTRY DBESY0(DX)
- ENAME='DBESY0'
- X=DX
-#endif
-
- 9 IF(X .LE. ZERO) THEN
- CALL KERMTR('C312.1',LGFILE,MFLAG,RFLAG)
- IF(MFLAG) THEN
- SX=X
- IF(LGFILE .EQ. 0) THEN
- WRITE(*,100) ENAME,SX
- ELSE
- WRITE(LGFILE,100) ENAME,SX
- ENDIF
- ENDIF
- IF(.NOT.RFLAG) CALL ABEND
- IF(ENAME .EQ. ' BESY0') THEN
- BESY0=ZERO
- ELSE
- DBESY0=ZERO
- ENDIF
- RETURN
- ENDIF
- IF(X .LT. EIGHT) THEN
- Y=X/EIGHT
- H=TWO*Y**2-ONE
- ALFA=-TWO*H
- B1=ZERO
- B2=ZERO
- DO 1 I = 14,0,-1
- B0=C1(I)-ALFA*B1-B2
- B2=B1
- 1 B1=B0
- P=B0-H*B2
- B1=ZERO
- B2=ZERO
- DO 2 I = 14,0,-1
- B0=C2(I)-ALFA*B1-B2
- B2=B1
- 2 B1=B0
- B1=PI2*(CE+LOG(X/TWO))*P+B0-H*B2
- ELSE
- R=ONE/X
- Y=EIGHT*R
- H=TWO*Y**2-ONE
- ALFA=-TWO*H
- B1=ZERO
- B2=ZERO
- DO 3 I = 9,0,-1
- B0=C3(I)-ALFA*B1-B2
- B2=B1
- 3 B1=B0
- P=B0-H*B2
- B1=ZERO
- B2=ZERO
- DO 4 I = 10,0,-1
- B0=C4(I)-ALFA*B1-B2
- B2=B1
- 4 B1=B0
- Q=Y*(B0-H*B2)
- B0=X-PI3
- B1=PI1*SQRT(R)*(Q*COS(B0)+P*SIN(B0))
- ENDIF
- IF(ENAME .EQ. ' BESY0') THEN
- BESY0=ROUND(B1)
- ELSE
- DBESY0=B1
- ENDIF
- RETURN
- 100 FORMAT(7X,A6,' ... NON-POSITIVE ARGUMENT X = ',E16.6)
- END
diff --git a/src/packlib/kernlib/kernnum/c312fort/besy1.F b/src/packlib/kernlib/kernnum/c312fort/besy1.F
deleted file mode 100644
index 428b279..0000000
--- a/src/packlib/kernlib/kernnum/c312fort/besy1.F
+++ /dev/null
@@ -1,162 +0,0 @@
-*
-* $Id: besy1.F,v 1.1.1.1 1996/02/15 17:49:08 mclareni Exp $
-*
-* $Log: besy1.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:08 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- REAL FUNCTION BESY1(RX)
- REAL RX,SX
- CHARACTER*6 ENAME
- LOGICAL MFLAG,RFLAG
-#if defined(CERNLIB_NUMHIPRE)
- REAL DBESY1,X,Y,H,ALFA,ZERO,ONE,TWO,EIGHT,B0,B1,B2,P,Q,R,D
- REAL PI1,PI2,PI3,CE,C1(0:14),C2(0:14),C3(0:7),C4(0:10)
-#endif
-#if defined(CERNLIB_NUMLOPRE)
- DOUBLE PRECISION X,Y,H,ALFA,ZERO,ONE,TWO,EIGHT,B0,B1,B2,P,Q,R,D
- DOUBLE PRECISION PI1,PI2,PI3,CE,C1(0:14),C2(0:14),C3(0:7),C4(0:10)
- DOUBLE PRECISION DBESY1,DX
-#endif
-
- DATA ZERO /0.0D0/, ONE /1.0D0/, TWO /2.0D0/, EIGHT /8.0D0/
-
- DATA PI1 /0.79788 45608 0287D0/, PI2 /0.63661 97723 6758D0/
- DATA PI3 /2.35619 44901 923 D0/, CE /0.57721 56649 0153D0/
-
- DATA C1( 0) /+0.05245 81903 3466D0/
- DATA C1( 1) /+0.04809 64691 5823D0/
- DATA C1( 2) /+0.31327 50823 6157D0/
- DATA C1( 3) /-0.24186 74084 4741D0/
- DATA C1( 4) /+0.07426 67962 1679D0/
- DATA C1( 5) /-0.01296 76273 1174D0/
- DATA C1( 6) /+0.00148 99128 9667D0/
- DATA C1( 7) /-0.00012 22786 8504D0/
- DATA C1( 8) /+0.00000 75626 3023D0/
- DATA C1( 9) /-0.00000 03661 3086D0/
- DATA C1(10) /+0.00000 00142 7732D0/
- DATA C1(11) /-0.00000 00004 5857D0/
- DATA C1(12) /+0.00000 00000 1235D0/
- DATA C1(13) /-0.00000 00000 0028D0/
- DATA C1(14) /+0.00000 00000 0001D0/
-
- DATA C2( 0) /-0.04017 29465 4441D0/
- DATA C2( 1) /-0.44444 71476 3056D0/
- DATA C2( 2) /-0.02271 92444 2842D0/
- DATA C2( 3) /+0.20664 45410 1749D0/
- DATA C2( 4) /-0.08667 16970 5695D0/
- DATA C2( 5) /+0.01763 67030 0316D0/
- DATA C2( 6) /-0.00223 56192 9449D0/
- DATA C2( 7) /+0.00019 70623 0270D0/
- DATA C2( 8) /-0.00001 28858 5330D0/
- DATA C2( 9) /+0.00000 06528 4795D0/
- DATA C2(10) /-0.00000 00264 5074D0/
- DATA C2(11) /+0.00000 00008 7803D0/
- DATA C2(12) /-0.00000 00000 2434D0/
- DATA C2(13) /+0.00000 00000 0057D0/
- DATA C2(14) /-0.00000 00000 0001D0/
-
- DATA C3( 0) /+1.00090 30408 600D0/
- DATA C3( 1) /+0.00089 89898 331D0/
- DATA C3( 2) /-0.00000 39872 843D0/
- DATA C3( 3) /+0.00000 00617 763D0/
- DATA C3( 4) /-0.00000 00018 719D0/
- DATA C3( 5) /+0.00000 00000 882D0/
- DATA C3( 6) /-0.00000 00000 057D0/
- DATA C3( 7) /+0.00000 00000 005D0/
-
- DATA C4( 0) /+0.04677 77870 69525D0/
- DATA C4( 1) /-0.00009 62772 35492D0/
- DATA C4( 2) /+0.00000 09138 61526D0/
- DATA C4( 3) /-0.00000 00209 59781D0/
- DATA C4( 4) /+0.00000 00008 22919D0/
- DATA C4( 5) /-0.00000 00000 46864D0/
- DATA C4( 6) /+0.00000 00000 03515D0/
- DATA C4( 7) /-0.00000 00000 00326D0/
- DATA C4( 8) /+0.00000 00000 00036D0/
- DATA C4( 9) /-0.00000 00000 00005D0/
- DATA C4(10) /+0.00000 00000 00001D0/
-#if defined(CERNLIB_NUMHIPRE)
- ROUND(D) = D
-#endif
-#if defined(CERNLIB_NUMLOPRE)
- ROUND(D) = SNGL(D+(D-DBLE(SNGL(D))))
-#endif
-
- ENAME=' BESY1'
- X=RX
-#if defined(CERNLIB_NUMLOPRE)
- GOTO 9
- ENTRY DBESY1(DX)
- ENAME='DBESY1'
- X=DX
-#endif
-
- 9 IF(X .LE. ZERO) THEN
- CALL KERMTR('C312.1',LGFILE,MFLAG,RFLAG)
- IF(MFLAG) THEN
- SX=X
- IF(LGFILE .EQ. 0) THEN
- WRITE(*,100) ENAME,SX
- ELSE
- WRITE(LGFILE,100) ENAME,SX
- ENDIF
- ENDIF
- IF(.NOT.RFLAG) CALL ABEND
- IF(ENAME .EQ. ' BESY1') THEN
- BESY1=ZERO
- ELSE
- DBESY1=ZERO
- ENDIF
- RETURN
- ENDIF
- IF(X .LT. EIGHT) THEN
- Y=X/EIGHT
- H=TWO*Y**2-ONE
- ALFA=-TWO*H
- B1=ZERO
- B2=ZERO
- DO 1 I = 14,0,-1
- B0=C1(I)-ALFA*B1-B2
- B2=B1
- 1 B1=B0
- P=Y*(B0-B2)
- B1=ZERO
- B2=ZERO
- DO 2 I = 14,0,-1
- B0=C2(I)-ALFA*B1-B2
- B2=B1
- 2 B1=B0
- B1=PI2*(CE+LOG(X/TWO))*P-PI2/X+Y*(B0-B2)
- ELSE
- R=ONE/X
- Y=EIGHT*R
- H=TWO*Y**2-ONE
- ALFA=-TWO*H
- B1=ZERO
- B2=ZERO
- DO 3 I = 7,0,-1
- B0=C3(I)-ALFA*B1-B2
- B2=B1
- 3 B1=B0
- P=B0-H*B2
- B1=ZERO
- B2=ZERO
- DO 4 I = 10,0,-1
- B0=C4(I)-ALFA*B1-B2
- B2=B1
- 4 B1=B0
- Q=Y*(B0-H*B2)
- B0=X-PI3
- B1=PI1*SQRT(R)*(Q*COS(B0)+P*SIN(B0))
- ENDIF
- IF(ENAME .EQ. ' BESY1') THEN
- BESY1=ROUND(B1)
- ELSE
- DBESY1=B1
- ENDIF
- RETURN
- 100 FORMAT(7X,A6,' ... NON-POSITIVE ARGUMENT X = ',E16.6)
- END
diff --git a/src/packlib/kernlib/kernnum/c313fort/Imakefile b/src/packlib/kernlib/kernnum/c313fort/Imakefile
deleted file mode 100644
index 5a8a1f0..0000000
--- a/src/packlib/kernlib/kernnum/c313fort/Imakefile
+++ /dev/null
@@ -1,9 +0,0 @@
-SRCS_F= besi0.F besi1.F besk0.F besk1.F
-
-#if defined(CERNLIB_DECS) && ! defined(CERNLIB_QMVAOS)
-FDEBUGFLAGS=NoOpFortranDebugFlags
-#endif
-
-FORTRANSAVEOPTION = FortranSaveFlags
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kernnum/c313fort/besi0.F b/src/packlib/kernlib/kernnum/c313fort/besi0.F
deleted file mode 100644
index 0a35b6f..0000000
--- a/src/packlib/kernlib/kernnum/c313fort/besi0.F
+++ /dev/null
@@ -1,156 +0,0 @@
-*
-* $Id: besi0.F,v 1.1.1.1 1996/02/15 17:49:09 mclareni Exp $
-*
-* $Log: besi0.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:09 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- REAL FUNCTION BESI0(RX)
- REAL RX
- CHARACTER*6 ENAME
- LOGICAL LEX
-#if defined(CERNLIB_NUMHIPRE)
- REAL X,Y,R,V,V1,V4,V5,A0,A,A1,A2,B,B0,B1,B2,T(6)
- REAL W,W0,W1,W2,W3,W4,W5,W6
- REAL F,F1,F2,F3,C,C0,C1(0:15),PI1,EPS,H,ALFA,D
- REAL ZERO,ONE,TWO,FIVE,EIGHT
-#endif
-#if defined(CERNLIB_NUMLOPRE)
- DOUBLE PRECISION X,Y,R,V,V1,V4,V5,A0,A,A1,A2,B,B0,B1,B2,T(6)
- DOUBLE PRECISION W,W0,W1,W2,W3,W4,W5,W6
- DOUBLE PRECISION F,F1,F2,F3,C,C0,C1(0:15),PI1,EPS,H,ALFA,D
- DOUBLE PRECISION ZERO,ONE,TWO,FIVE,EIGHT
- DOUBLE PRECISION DBESI0,DEBSI0,DX
-#endif
-
- DATA ZERO /0.0D0/, ONE /1.0D0/, TWO /2.0D0/, FIVE /5.0D0/
- DATA EIGHT /8.0D0/
- DATA PI1 /0.39894 22804 0143D0/, EPS /1.0D-14/
-
- DATA T(1) /0.66666 66666 6667D0/
- DATA T(2) /0.80000 00000 0000D0/
- DATA T(3) /0.07500 00000 0000D0/
- DATA T(4) /0.33333 33333 3333D0/
- DATA T(5) /0.20000 00000 0000D0/
- DATA T(6) /0.02500 00000 0000D0/
-
- DATA C1( 0) /+1.00827 92054 587D0/
- DATA C1( 1) /+0.00844 51226 249D0/
- DATA C1( 2) /+0.00017 27006 308D0/
- DATA C1( 3) /+0.00000 72475 911D0/
- DATA C1( 4) /+0.00000 05135 877D0/
- DATA C1( 5) /+0.00000 00568 170D0/
- DATA C1( 6) /+0.00000 00085 131D0/
- DATA C1( 7) /+0.00000 00012 384D0/
- DATA C1( 8) /+0.00000 00000 298D0/
- DATA C1( 9) /-0.00000 00000 790D0/
- DATA C1(10) /-0.00000 00000 331D0/
- DATA C1(11) /-0.00000 00000 045D0/
- DATA C1(12) /+0.00000 00000 018D0/
- DATA C1(13) /+0.00000 00000 010D0/
- DATA C1(14) /+0.00000 00000 000D0/
- DATA C1(15) /-0.00000 00000 001D0/
-#if defined(CERNLIB_NUMHIPRE)
- ROUND(D) = D
-#endif
-#if defined(CERNLIB_NUMLOPRE)
- ROUND(D) = SNGL(D+(D-DBLE(SNGL(D))))
-#endif
-
- X=RX
- ENAME=' BESI0'
- LEX=.FALSE.
- GOTO 9
-
- ENTRY EBESI0(RX)
- X=RX
- ENAME='EBESI0'
- LEX=.TRUE.
-#if defined(CERNLIB_NUMLOPRE)
- GOTO 9
- ENTRY DBESI0(DX)
- X=DX
- ENAME='DBESI0'
- LEX=.FALSE.
- GO TO 9
- ENTRY DEBSI0(DX)
- X=DX
- ENAME='DEBSI0'
- LEX=.TRUE.
-#endif
-
- 9 V=ABS(X)
- IF(V .LT. EIGHT) THEN
- Y=(V/TWO)**2
- W=Y**2
- A0=ONE
- A1=ONE+T(1)*Y
- A2=ONE+T(2)*Y+T(3)*W
- B0=ONE
- B1=ONE-T(4)*Y
- B2=ONE-T(5)*Y+T(6)*W
- W1=FIVE
- V1=ONE
- C=ZERO
- F=TWO
- 3 C0=C
- F=F+ONE
- W1=W1+TWO
- W2=W1-ONE
- W3=W2-ONE
- W4=W3-ONE
- W5=W4-ONE
- W6=W5-ONE
- V1=V1+ONE
- V4=F*W4
- V5=Y/W5
- W=Y*V1/(V4*W3)
- W0=W*V5
- F1=ONE+Y*V1/(V4*W1)
- F2=W+F*W0/(V1*W2)
- F3=-W0*V5/(W4*W6)
- A=F1*A2+F2*A1+F3*A0
- B=F1*B2+F2*B1+F3*B0
- C=A/B
- IF(ABS((C0-C)/C) .GE. EPS) THEN
- A0=A1
- A1=A2
- A2=A
- B0=B1
- B1=B2
- B2=B
- GO TO 3
- ENDIF
- B1=C
- IF(LEX) B1=EXP(-V)*B1
- ELSE
- R=ONE/V
- Y=EIGHT*R
- H=TWO*Y-ONE
- ALFA=-TWO*H
- B1=ZERO
- B2=ZERO
- DO 1 I = 15,0,-1
- B0=C1(I)-ALFA*B1-B2
- B2=B1
- 1 B1=B0
- B1=PI1*SQRT(R)*(B0-H*B2)
- IF(.NOT.LEX) B1=EXP(V)*B1
- ENDIF
- IF(LEX) THEN
- IF(ENAME .EQ. 'EBESI0') THEN
- EBESI0=ROUND(B1)
- ELSE
- DEBSI0=B1
- ENDIF
- ELSE
- IF(ENAME .EQ. ' BESI0') THEN
- BESI0=ROUND(B1)
- ELSE
- DBESI0=B1
- ENDIF
- ENDIF
- RETURN
- END
diff --git a/src/packlib/kernlib/kernnum/c313fort/besi1.F b/src/packlib/kernlib/kernnum/c313fort/besi1.F
deleted file mode 100644
index 2aa0dac..0000000
--- a/src/packlib/kernlib/kernnum/c313fort/besi1.F
+++ /dev/null
@@ -1,155 +0,0 @@
-*
-* $Id: besi1.F,v 1.1.1.1 1996/02/15 17:49:09 mclareni Exp $
-*
-* $Log: besi1.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:09 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- REAL FUNCTION BESI1(RX)
- REAL RX
- CHARACTER*6 ENAME
- LOGICAL LEX
-#if defined(CERNLIB_NUMHIPRE)
- REAL X,Y,R,V,V1,V2,V4,V5,A,A0,A1,A2,B,B0,B1,B2,T(2)
- REAL W,W0,W1,W2,W3,W4,W5,W6
- REAL F1,F2,F3,C,C0,F,C1(0:17),PI1,EPS,H,ALFA,D
- REAL ZERO,ONE,TWO,THREE,FOUR,SIX,EIGHT
-#endif
-#if defined(CERNLIB_NUMLOPRE)
- DOUBLE PRECISION X,Y,R,V,V1,V2,V4,V5,A,A0,A1,A2,B,B0,B1,B2,T(2)
- DOUBLE PRECISION W,W0,W1,W2,W3,W4,W5,W6
- DOUBLE PRECISION F1,F2,F3,C,C0,F,C1(0:17),PI1,EPS,H,ALFA,D
- DOUBLE PRECISION ZERO,ONE,TWO,THREE,FOUR,SIX,EIGHT
- DOUBLE PRECISION DBESI1,DEBSI1,DX
-#endif
-
- DATA ZERO /0.0D0/, ONE /1.0D0/, TWO /2.0D0/, THREE /3.0D0/
- DATA FOUR /4.0D0/, SIX /6.0D0/, EIGHT /8.0D0/
- DATA T /0.05D0,0.1D0/
- DATA PI1 /0.39894 22804 0143D0/, EPS /1.0D-14/
-
- DATA C1( 0) /+0.97580 06023 2629D0/
- DATA C1( 1) /-0.02446 74429 6328D0/
- DATA C1( 2) /-0.00027 72053 6076D0/
- DATA C1( 3) /-0.00000 97321 4673D0/
- DATA C1( 4) /-0.00000 06297 2424D0/
- DATA C1( 5) /-0.00000 00659 6114D0/
- DATA C1( 6) /-0.00000 00096 1387D0/
- DATA C1( 7) /-0.00000 00014 0114D0/
- DATA C1( 8) /-0.00000 00000 4756D0/
- DATA C1( 9) /+0.00000 00000 8153D0/
- DATA C1(10) /+0.00000 00000 3541D0/
- DATA C1(11) /+0.00000 00000 0510D0/
- DATA C1(12) /-0.00000 00000 0180D0/
- DATA C1(13) /-0.00000 00000 0102D0/
- DATA C1(14) /-0.00000 00000 0005D0/
- DATA C1(15) /+0.00000 00000 0011D0/
- DATA C1(16) /+0.00000 00000 0003D0/
- DATA C1(17) /-0.00000 00000 0001D0/
-#if defined(CERNLIB_NUMHIPRE)
- ROUND(D) = D
-#endif
-#if defined(CERNLIB_NUMLOPRE)
- ROUND(D) = SNGL(D+(D-DBLE(SNGL(D))))
-#endif
-
- X=RX
- ENAME=' BESI1'
- LEX=.FALSE.
- GOTO 9
-
- ENTRY EBESI1(RX)
- X=RX
- ENAME='EBESI1'
- LEX=.TRUE.
-#if defined(CERNLIB_NUMLOPRE)
- GOTO 9
- ENTRY DBESI1(DX)
- X=DX
- ENAME='DBESI1'
- LEX=.FALSE.
- GO TO 9
- ENTRY DEBSI1(DX)
- X=DX
- ENAME='DEBSI1'
- LEX=.TRUE.
-#endif
-
- 9 V=ABS(X)
- IF(V .LT. EIGHT) THEN
- Y=(V/TWO)**2
- W=Y**2
- A0=ONE
- A1=ONE+Y/FOUR
- A2=ONE+(Y+T(1)*W)/THREE
- B0=ONE
- B1=ONE-Y/FOUR
- B2=ONE-(Y-T(2)*W)/SIX
- W1=SIX
- V1=ZERO
- V2=FOUR
- C=ZERO
- F=TWO
- 3 C0=C
- F=F+ONE
- W1=W1+TWO
- W2=W1-ONE
- W3=W2-ONE
- W4=W3-ONE
- W5=W4-ONE
- W6=W5-ONE
- V1=V1+ONE
- V2=V2+ONE
- V4=F*W4
- V5=Y/W5
- W=F*Y/(V4*W3)
- W0=W*V5
- F1=ONE+Y*V1/(V4*W1)
- F2=W+V2*W0/(F*W2)
- F3=-W0*V5/(W4*W6)
- A=F1*A2+F2*A1+F3*A0
- B=F1*B2+F2*B1+F3*B0
- C=A/B
- IF(ABS((C0-C)/C) .GE. EPS) THEN
- A0=A1
- A1=A2
- A2=A
- B0=B1
- B1=B2
- B2=B
- GO TO 3
- ENDIF
- B1=X*C/TWO
- IF(LEX) B1=EXP(-V)*B1
- ELSE
- R=ONE/V
- Y=EIGHT*R
- H=TWO*Y-ONE
- ALFA=-TWO*H
- B1=ZERO
- B2=ZERO
- DO 1 I = 17,0,-1
- B0=C1(I)-ALFA*B1-B2
- B2=B1
- 1 B1=B0
- B1=PI1*SQRT(R)*(B0-H*B2)
- IF(.NOT.LEX) B1=EXP(V)*B1
- IF(X .LT. ZERO) B1=-B1
- ENDIF
- IF(LEX) THEN
- IF(ENAME .EQ. 'EBESI1') THEN
- EBESI1=ROUND(B1)
- ELSE
- DEBSI1=B1
- ENDIF
- ELSE
- IF(ENAME .EQ. ' BESI1') THEN
- BESI1=ROUND(B1)
- ELSE
- DBESI1=B1
- ENDIF
- ENDIF
- RETURN
- END
diff --git a/src/packlib/kernlib/kernnum/c313fort/besk0.F b/src/packlib/kernlib/kernnum/c313fort/besk0.F
deleted file mode 100644
index 8e6d3e9..0000000
--- a/src/packlib/kernlib/kernnum/c313fort/besk0.F
+++ /dev/null
@@ -1,233 +0,0 @@
-*
-* $Id: besk0.F,v 1.1.1.1 1996/02/15 17:49:09 mclareni Exp $
-*
-* $Log: besk0.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:09 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- REAL FUNCTION BESK0(RX)
- REAL RX,SX
- LOGICAL LEX
- CHARACTER*6 ENAME
- LOGICAL MFLAG,RFLAG
-#if defined(CERNLIB_NUMHIPRE)
- REAL X,Y,R,A,A0,A1,A2,B,B0,B1,B2,T(10)
- REAL U0,U1,U2,U3,U4,U5,U6,U7,U8,U9
- REAL F,F1,F2,F3,C,C0,PI1,CE,EPS,H,ALFA,D
- REAL ZERO,ONE,TWO,FOUR,FIVE,SIX,SEVEN,EIGHT,NINE,HALF
- REAL C1(0:14),C2(0:15),C3(0:12)
-#endif
-#if defined(CERNLIB_NUMLOPRE)
- DOUBLE PRECISION X,Y,R,A,A0,A1,A2,B,B0,B1,B2,T(10)
- DOUBLE PRECISION U0,U1,U2,U3,U4,U5,U6,U7,U8,U9
- DOUBLE PRECISION F,F1,F2,F3,C,C0,PI1,CE,EPS,H,ALFA,D
- DOUBLE PRECISION ZERO,ONE,TWO,FOUR,FIVE,SIX,SEVEN,EIGHT,NINE,HALF
- DOUBLE PRECISION C1(0:14),C2(0:15),C3(0:12)
- DOUBLE PRECISION DBESK0,DEBSK0,DX
-#endif
-
- DATA ZERO /0.0D0/, ONE /1.0D0/, TWO /2.0D0/
- DATA FOUR /4.0D0/, FIVE /5.0D0/, SIX /6.0D0/, SEVEN /7.0D0/
- DATA EIGHT /8.0D0/, NINE /9.0D0/, HALF /0.5D0/
-
- DATA T /16.0D0,368.0D0,43.0D0,75.0D0,400.0D0,40.0D0,
- 1 48.0D0,12.0D0,20.0D0,28.0D0/
-
- DATA PI1 /1.25331 41373 155D0/, CE /0.57721 56649 0153D0/
- DATA EPS /1.0D-14/
-
- DATA C1( 0) /0.12773 34398 1218D3/
- DATA C1( 1) /0.19049 43201 7274D3/
- DATA C1( 2) /0.82489 03274 4024D2/
- DATA C1( 3) /0.22274 81924 2462D2/
- DATA C1( 4) /0.40116 73760 1793D1/
- DATA C1( 5) /0.50949 33654 3998D0/
- DATA C1( 6) /0.04771 87487 9817D0/
- DATA C1( 7) /0.00341 63317 6601D0/
- DATA C1( 8) /0.00019 24693 5969D0/
- DATA C1( 9) /0.00000 87383 1550D0/
- DATA C1(10) /0.00000 03260 9105D0/
- DATA C1(11) /0.00000 00101 6973D0/
- DATA C1(12) /0.00000 00002 6883D0/
- DATA C1(13) /0.00000 00000 0610D0/
- DATA C1(14) /0.00000 00000 0012D0/
-
- DATA C2( 0) /0.24027 70596 4072D3/
- DATA C2( 1) /0.36947 40739 7287D3/
- DATA C2( 2) /0.16997 34116 9840D3/
- DATA C2( 3) /0.49020 46377 7263D2/
- DATA C2( 4) /0.93884 97325 2684D1/
- DATA C2( 5) /0.12594 79763 6677D1/
- DATA C2( 6) /0.12377 69641 1492D0/
- DATA C2( 7) /0.00924 43098 6287D0/
- DATA C2( 8) /0.00054 06238 9649D0/
- DATA C2( 9) /0.00002 53737 9603D0/
- DATA C2(10) /0.00000 09754 7830D0/
- DATA C2(11) /0.00000 00312 4957D0/
- DATA C2(12) /0.00000 00008 4643D0/
- DATA C2(13) /0.00000 00000 1963D0/
- DATA C2(14) /0.00000 00000 0039D0/
- DATA C2(15) /0.00000 00000 0001D0/
-
- DATA C3( 0) /+0.98840 81742 3083D0/
- DATA C3( 1) /-0.01131 05046 4693D0/
- DATA C3( 2) /+0.00026 95326 1276D0/
- DATA C3( 3) /-0.00001 11066 8520D0/
- DATA C3( 4) /+0.00000 06325 7511D0/
- DATA C3( 5) /-0.00000 00450 4734D0/
- DATA C3( 6) /+0.00000 00037 9300D0/
- DATA C3( 7) /-0.00000 00003 6455D0/
- DATA C3( 8) /+0.00000 00000 3904D0/
- DATA C3( 9) /-0.00000 00000 0458D0/
- DATA C3(10) /+0.00000 00000 0058D0/
- DATA C3(11) /-0.00000 00000 0008D0/
- DATA C3(12) /+0.00000 00000 0001D0/
-#if defined(CERNLIB_NUMHIPRE)
- ROUND(D) = D
-#endif
-#if defined(CERNLIB_NUMLOPRE)
- ROUND(D) = SNGL(D+(D-DBLE(SNGL(D))))
-#endif
-
- ENAME=' BESK0'
- X=RX
- LEX=.FALSE.
- GOTO 9
-
- ENTRY EBESK0(RX)
- ENAME='EBESK0'
- X=RX
- LEX=.TRUE.
-#if defined(CERNLIB_NUMLOPRE)
- GOTO 9
- ENTRY DBESK0(DX)
- ENAME='DBESK0'
- X=DX
- LEX=.FALSE.
- GO TO 9
- ENTRY DEBSK0(DX)
- ENAME='DEBSK0'
- X=DX
- LEX=.TRUE.
-#endif
-
- 9 IF(X .LE. ZERO) THEN
- CALL KERMTR('C313.1',LGFILE,MFLAG,RFLAG)
- IF(MFLAG) THEN
- SX=X
- IF(LGFILE .EQ. 0) THEN
- WRITE(*,100) ENAME,SX
- ELSE
- WRITE(LGFILE,100) ENAME,SX
- ENDIF
- ENDIF
- IF(.NOT.RFLAG) CALL ABEND
- IF(LEX) THEN
- IF(ENAME .EQ. 'EBESK0') THEN
- EBESK0=ZERO
- ELSE
- DEBSK0=ZERO
- ENDIF
- ELSE
- IF(ENAME .EQ. ' BESK0') THEN
- BESK0=ZERO
- ELSE
- DBESK0=ZERO
- ENDIF
- ENDIF
- RETURN
- ENDIF
- IF(X .LT. HALF) THEN
- Y=X/EIGHT
- H=TWO*Y**2-ONE
- ALFA=-TWO*H
- B1=ZERO
- B2=ZERO
- DO 1 I = 14,0,-1
- B0=C1(I)-ALFA*B1-B2
- B2=B1
- 1 B1=B0
- R=B0-H*B2
- B1=ZERO
- B2=ZERO
- DO 2 I = 15,0,-1
- B0=C2(I)-ALFA*B1-B2
- B2=B1
- 2 B1=B0
- B1=-(CE+LOG(HALF*X))*R+B0-H*B2
- IF(LEX) B1=EXP(X)*B1
- ELSE IF(X .GT. FIVE) THEN
- R=ONE/X
- Y=FIVE*R
- H=TWO*Y-ONE
- ALFA=-TWO*H
- B1=ZERO
- B2=ZERO
- DO 3 I = 12,0,-1
- B0=C3(I)-ALFA*B1-B2
- B2=B1
- 3 B1=B0
- B1=PI1*SQRT(R)*(B0-H*B2)
- IF(.NOT.LEX) B1=EXP(-X)*B1
- ELSE
- Y=(T(1)*X)**2
- A0=ONE
- A1=(T(1)*X+SEVEN)/NINE
- A2=(Y+T(2)*X+T(3))/T(4)
- B0=ONE
- B1=(T(1)*X+NINE)/NINE
- B2=(Y+T(5)*X+T(4))/T(4)
- U1=ONE
- U4=T(6)
- U5=T(7)
- C=ZERO
- F=TWO
- 4 C0=C
- F=F+ONE
- U0=T(8)*F**2-ONE
- U1=U1+TWO
- U2=U1+TWO
- U3=U1+FOUR
- U4=U4+T(9)
- U5=U5+T(10)
- U6=ONE/U3**2
- U7=U2*U6
- U8=-U7/U1
- U9=T(1)*U7*X
- F1=U9-(U0-U4)*U8
- F2=U9-(U0-U5)*U6
- F3=-U8*(U3-SIX)**2
- A=F1*A2+F2*A1+F3*A0
- B=F1*B2+F2*B1+F3*B0
- C=A/B
- IF(ABS((C0-C)/C) .GE. EPS) THEN
- A0=A1
- A1=A2
- A2=A
- B0=B1
- B1=B2
- B2=B
- GO TO 4
- ENDIF
- B1=PI1*C/SQRT(X)
- IF(.NOT.LEX) B1=EXP(-X)*B1
- ENDIF
- IF(LEX) THEN
- IF(ENAME .EQ. 'EBESK0') THEN
- EBESK0=ROUND(B1)
- ELSE
- DEBSK0=B1
- ENDIF
- ELSE
- IF(ENAME .EQ. ' BESK0') THEN
- BESK0=ROUND(B1)
- ELSE
- DBESK0=B1
- ENDIF
- ENDIF
- RETURN
-
- 100 FORMAT(7X,A6,' ... NON-POSITIVE ARGUMENT X = ',E16.6)
- END
diff --git a/src/packlib/kernlib/kernnum/c313fort/besk1.F b/src/packlib/kernlib/kernnum/c313fort/besk1.F
deleted file mode 100644
index d7cdef9..0000000
--- a/src/packlib/kernlib/kernnum/c313fort/besk1.F
+++ /dev/null
@@ -1,231 +0,0 @@
-*
-* $Id: besk1.F,v 1.1.1.1 1996/02/15 17:49:09 mclareni Exp $
-*
-* $Log: besk1.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:09 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- REAL FUNCTION BESK1(RX)
- REAL RX,SX
- LOGICAL LEX
- CHARACTER*6 ENAME
- LOGICAL MFLAG,RFLAG
-#if defined(CERNLIB_NUMHIPRE)
- REAL X,Y,R,A,A0,A1,A2,B,B0,B1,B2,T(12)
- REAL U0,U1,U2,U3,U4,U5,U6,U7,U8,U9
- REAL F,F1,F2,F3,C,C0,PI1,CE,EPS,H,ALFA,D
- REAL ZERO,ONE,TWO,THREE,FOUR,FIVE,SIX,EIGHT,HALF
- REAL C1(0:14),C2(0:14),C3(0:11)
-#endif
-#if defined(CERNLIB_NUMLOPRE)
- DOUBLE PRECISION X,Y,R,A,A0,A1,A2,B,B0,B1,B2,T(12)
- DOUBLE PRECISION U0,U1,U2,U3,U4,U5,U6,U7,U8,U9
- DOUBLE PRECISION F,F1,F2,F3,C,C0,PI1,CE,EPS,H,ALFA,D
- DOUBLE PRECISION ZERO,ONE,TWO,THREE,FOUR,FIVE,SIX,EIGHT,HALF
- DOUBLE PRECISION C1(0:14),C2(0:14),C3(0:11)
- DOUBLE PRECISION DBESK1,DEBSK1,DX
-#endif
-
- DATA ZERO /0.0D0/, ONE /1.0D0/, TWO /2.0D0/, THREE /3.0D0/
- DATA FOUR /4.0D0/, FIVE /5.0D0/, SIX /6.0D0/, EIGHT /8.0D0/
- DATA HALF /0.5D0/
-
- DATA T /16.0D0,3.2D0,2.2D0,432.0D0,131.0D0,35.0D0,336.0D0,
- 1 40.0D0,48.0D0,12.0D0,20.0D0,28.0D0/
-
- DATA PI1 /1.25331 41373 155D0/, CE /0.57721 56649 0153D0/
- DATA EPS /1.0D-14/
-
- DATA C1( 0) /0.22060 14269 2352D3/
- DATA C1( 1) /0.12535 42668 3715D3/
- DATA C1( 2) /0.42865 23409 3128D2/
- DATA C1( 3) /0.94530 05229 4349D1/
- DATA C1( 4) /0.14296 57709 0762D1/
- DATA C1( 5) /0.15592 42954 7626D0/
- DATA C1( 6) /0.01276 80490 8173D0/
- DATA C1( 7) /0.00081 08879 0069D0/
- DATA C1( 8) /0.00004 10104 6194D0/
- DATA C1( 9) /0.00000 16880 4220D0/
- DATA C1(10) /0.00000 00575 8695D0/
- DATA C1(11) /0.00000 00016 5345D0/
- DATA C1(12) /0.00000 00000 4048D0/
- DATA C1(13) /0.00000 00000 0085D0/
- DATA C1(14) /0.00000 00000 0002D0/
-
- DATA C2( 0) /0.41888 94461 6640D3/
- DATA C2( 1) /0.24989 55490 4287D3/
- DATA C2( 2) /0.91180 31933 8742D2/
- DATA C2( 3) /0.21444 99505 3962D2/
- DATA C2( 4) /0.34384 15392 8805D1/
- DATA C2( 5) /0.39484 60929 4094D0/
- DATA C2( 6) /0.03382 87455 2688D0/
- DATA C2( 7) /0.00223 57203 3417D0/
- DATA C2( 8) /0.00011 71310 2246D0/
- DATA C2( 9) /0.00000 49754 2712D0/
- DATA C2(10) /0.00000 01746 0493D0/
- DATA C2(11) /0.00000 00051 4329D0/
- DATA C2(12) /0.00000 00001 2890D0/
- DATA C2(13) /0.00000 00000 0278D0/
- DATA C2(14) /0.00000 00000 0005D0/
-
- DATA C3( 0) /+1.03595 08587 724D0/
- DATA C3( 1) /+0.03546 52912 433D0/
- DATA C3( 2) /-0.00046 84750 282D0/
- DATA C3( 3) /+0.00001 61850 638D0/
- DATA C3( 4) /-0.00000 08451 720D0/
- DATA C3( 5) /+0.00000 00571 322D0/
- DATA C3( 6) /-0.00000 00046 456D0/
- DATA C3( 7) /+0.00000 00004 354D0/
- DATA C3( 8) /-0.00000 00000 458D0/
- DATA C3( 9) /+0.00000 00000 053D0/
- DATA C3(10) /-0.00000 00000 007D0/
- DATA C3(11) /+0.00000 00000 001D0/
-#if defined(CERNLIB_NUMHIPRE)
- ROUND(D) = D
-#endif
-#if defined(CERNLIB_NUMLOPRE)
- ROUND(D) = SNGL(D+(D-DBLE(SNGL(D))))
-#endif
-
- ENAME=' BESK1'
- X=RX
- LEX=.FALSE.
- GOTO 9
-
- ENTRY EBESK1(RX)
- ENAME='EBESK1'
- X=RX
- LEX=.TRUE.
-#if defined(CERNLIB_NUMLOPRE)
- GO TO 9
- ENTRY DBESK1(DX)
- ENAME='DBESK1'
- X=DX
- LEX=.FALSE.
- GO TO 9
- ENTRY DEBSK1(DX)
- ENAME='DEBSK1'
- X=DX
- LEX=.TRUE.
-#endif
-
- 9 IF(X .LE. ZERO) THEN
- CALL KERMTR('C313.1',LGFILE,MFLAG,RFLAG)
- IF(MFLAG) THEN
- SX=X
- IF(LGFILE .EQ. 0) THEN
- WRITE(*,100) ENAME,SX
- ELSE
- WRITE(LGFILE,100) ENAME,SX
- ENDIF
- ENDIF
- IF(.NOT.RFLAG) CALL ABEND
- IF(LEX) THEN
- IF(ENAME .EQ. 'EBESK1') THEN
- EBESK1=ZERO
- ELSE
- DEBSK1=ZERO
- ENDIF
- ELSE
- IF(ENAME .EQ. ' BESK1') THEN
- BESK1=ZERO
- ELSE
- DBESK1=ZERO
- ENDIF
- ENDIF
- RETURN
- ENDIF
- IF(X .LT. HALF) THEN
- Y=X/EIGHT
- H=TWO*Y**2-ONE
- ALFA=-TWO*H
- B1=ZERO
- B2=ZERO
- DO 1 I = 14,0,-1
- B0=C1(I)-ALFA*B1-B2
- B2=B1
- 1 B1=B0
- R=Y*(B0-B2)
- B1=ZERO
- B2=ZERO
- DO 2 I = 14,0,-1
- B0=C2(I)-ALFA*B1-B2
- B2=B1
- 2 B1=B0
- B1=(CE+LOG(HALF*X))*R+ONE/X-Y*(B0-B2)
- IF(LEX) B1=EXP(X)*B1
- ELSE IF(X .GT. FIVE) THEN
- R=ONE/X
- Y=FIVE*R
- H=TWO*Y-ONE
- ALFA=-TWO*H
- B1=ZERO
- B2=ZERO
- DO 3 I = 11,0,-1
- B0=C3(I)-ALFA*B1-B2
- B2=B1
- 3 B1=B0
- B1=PI1*SQRT(R)*(B0-H*B2)
- IF(.NOT.LEX) B1=EXP(-X)*B1
- ELSE
- Y=(T(1)*X)**2
- A0=ONE
- A1=T(2)*X+T(3)
- A2=(Y+T(4)*X+T(5))/T(6)
- B0=ONE
- B1=T(2)*X+ONE
- B2=(Y+T(7)*X+T(6))/T(6)
- U1=ONE
- U4=T(8)
- U5=T(9)
- C=ZERO
- F=TWO
- 4 C0=C
- F=F+ONE
- U0=T(10)*F**2+THREE
- U1=U1+TWO
- U2=U1+TWO
- U3=U1+FOUR
- U4=U4+T(11)
- U5=U5+T(12)
- U6=ONE/(U3**2-FOUR)
- U7=U2*U6
- U8=-U7/U1
- U9=T(1)*U7*X
- F1=U9-(U0-U4)*U8
- F2=U9-(U0-U5)*U6
- F3=U8*(FOUR-(U3-SIX)**2)
- A=F1*A2+F2*A1+F3*A0
- B=F1*B2+F2*B1+F3*B0
- C=A/B
- IF(ABS((C0-C)/C) .GE. EPS) THEN
- A0=A1
- A1=A2
- A2=A
- B0=B1
- B1=B2
- B2=B
- GO TO 4
- ENDIF
- B1=PI1*C/SQRT(X)
- IF(.NOT.LEX) B1=EXP(-X)*B1
- ENDIF
- IF(LEX) THEN
- IF(ENAME .EQ. 'EBESK1') THEN
- EBESK1=ROUND(B1)
- ELSE
- DEBSK1=B1
- ENDIF
- ELSE
- IF(ENAME .EQ. ' BESK1') THEN
- BESK1=ROUND(B1)
- ELSE
- DBESK1=B1
- ENDIF
- ENDIF
- RETURN
-
- 100 FORMAT(7X,A6,' ... NON-POSITIVE ARGUMENT X = ',E16.6)
- END
diff --git a/src/packlib/kernlib/kernnum/c336fort/Imakefile b/src/packlib/kernlib/kernnum/c336fort/Imakefile
deleted file mode 100644
index dfb4c00..0000000
--- a/src/packlib/kernlib/kernnum/c336fort/Imakefile
+++ /dev/null
@@ -1,9 +0,0 @@
-SRCS_F= cosint.F sinint.F
-
-#if defined(CERNLIB_DECS) && ! defined(CERNLIB_QMVAOS)
-FDEBUGFLAGS=NoOpFortranDebugFlags
-#endif
-
-FORTRANSAVEOPTION=FortranSaveFlags
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kernnum/c336fort/cosint.F b/src/packlib/kernlib/kernnum/c336fort/cosint.F
deleted file mode 100644
index ef52e6b..0000000
--- a/src/packlib/kernlib/kernnum/c336fort/cosint.F
+++ /dev/null
@@ -1,159 +0,0 @@
-*
-* $Id: cosint.F,v 1.1.1.1 1996/02/15 17:49:09 mclareni Exp $
-*
-* $Log: cosint.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:09 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- REAL FUNCTION COSINT(RX)
- REAL RX
- CHARACTER*6 ENAME
- LOGICAL MFLAG,RFLAG
-#if defined(CERNLIB_NUMHIPRE)
- REAL ZERO,ONE,TWO,EIGHT,CE,X,Y,R,H,ALFA,D
- REAL DCOSIN,B0,B1,B2,PP,QQ,C(0:13),P(0:22),Q(0:19)
-#endif
-#if defined(CERNLIB_NUMLOPRE)
- DOUBLE PRECISION ZERO,ONE,TWO,EIGHT,CE,X,Y,R,H,ALFA,D
- DOUBLE PRECISION DCOSIN,B0,B1,B2,PP,QQ,C(0:13),P(0:22),Q(0:19)
- DOUBLE PRECISION DX
-#endif
-
- DATA ZERO /0.0D0/, ONE /1.0D0/, TWO /2.0D0/
- DATA EIGHT /8.0D0/, CE /0.57721 56649 0153D0/
-
- DATA C( 0) /+1.94054 91464 836D0/
- DATA C( 1) /+0.94134 09132 865D0/
- DATA C( 2) /-0.57984 50342 930D0/
- DATA C( 3) /+0.30915 72011 159D0/
- DATA C( 4) /-0.09161 01792 208D0/
- DATA C( 5) /+0.01644 37407 515D0/
- DATA C( 6) /-0.00197 13091 952D0/
- DATA C( 7) /+0.00016 92538 851D0/
- DATA C( 8) /-0.00001 09393 296D0/
- DATA C( 9) /+0.00000 05522 386D0/
- DATA C(10) /-0.00000 00223 995D0/
- DATA C(11) /+0.00000 00007 465D0/
- DATA C(12) /-0.00000 00000 208D0/
- DATA C(13) /+0.00000 00000 005D0/
-
- DATA P( 0) /+0.96074 78397 5204D0/
- DATA P( 1) /-0.03711 38962 1240D0/
- DATA P( 2) /+0.00194 14398 8899D0/
- DATA P( 3) /-0.00017 16598 8425D0/
- DATA P( 4) /+0.00002 11263 7753D0/
- DATA P( 5) /-0.00000 32716 3257D0/
- DATA P( 6) /+0.00000 06006 9212D0/
- DATA P( 7) /-0.00000 01258 6794D0/
- DATA P( 8) /+0.00000 00293 2563D0/
- DATA P( 9) /-0.00000 00074 5696D0/
- DATA P(10) /+0.00000 00020 4105D0/
- DATA P(11) /-0.00000 00005 9502D0/
- DATA P(12) /+0.00000 00001 8323D0/
- DATA P(13) /-0.00000 00000 5921D0/
- DATA P(14) /+0.00000 00000 1997D0/
- DATA P(15) /-0.00000 00000 0700D0/
- DATA P(16) /+0.00000 00000 0254D0/
- DATA P(17) /-0.00000 00000 0095D0/
- DATA P(18) /+0.00000 00000 0037D0/
- DATA P(19) /-0.00000 00000 0014D0/
- DATA P(20) /+0.00000 00000 0006D0/
- DATA P(21) /-0.00000 00000 0002D0/
- DATA P(22) /+0.00000 00000 0001D0/
-
- DATA Q( 0) /+0.98604 06569 6238D0/
- DATA Q( 1) /-0.01347 17382 0830D0/
- DATA Q( 2) /+0.00045 32928 4117D0/
- DATA Q( 3) /-0.00003 06728 8652D0/
- DATA Q( 4) /+0.00000 31319 9198D0/
- DATA Q( 5) /-0.00000 04211 0196D0/
- DATA Q( 6) /+0.00000 00690 7245D0/
- DATA Q( 7) /-0.00000 00131 8321D0/
- DATA Q( 8) /+0.00000 00028 3697D0/
- DATA Q( 9) /-0.00000 00006 7329D0/
- DATA Q(10) /+0.00000 00001 7340D0/
- DATA Q(11) /-0.00000 00000 4787D0/
- DATA Q(12) /+0.00000 00000 1403D0/
- DATA Q(13) /-0.00000 00000 0433D0/
- DATA Q(14) /+0.00000 00000 0140D0/
- DATA Q(15) /-0.00000 00000 0047D0/
- DATA Q(16) /+0.00000 00000 0017D0/
- DATA Q(17) /-0.00000 00000 0006D0/
- DATA Q(18) /+0.00000 00000 0002D0/
- DATA Q(19) /-0.00000 00000 0001D0/
-#if defined(CERNLIB_NUMHIPRE)
- ROUND(D) = D
-#endif
-#if defined(CERNLIB_NUMLOPRE)
- ROUND(D) = SNGL(D+(D-DBLE(SNGL(D))))
-#endif
-
- ENAME='COSINT'
- X=RX
-#if defined(CERNLIB_NUMLOPRE)
- GOTO 9
- ENTRY DCOSIN(DX)
- ENAME='DCOSIN'
- X=DX
-#endif
-
- 9 IF(X .EQ. ZERO) THEN
- CALL KERMTR('C336.1',LGFILE,MFLAG,RFLAG)
- IF(MFLAG) THEN
- IF(LGFILE .EQ. 0) THEN
- WRITE(*,100) ENAME
- ELSE
- WRITE(LGFILE,100) ENAME
- ENDIF
- ENDIF
- IF(.NOT.RFLAG) CALL ABEND
- IF(ENAME .EQ. 'COSINT') THEN
- COSINT=ZERO
- ELSE
- DCOSIN=ZERO
- ENDIF
- RETURN
- ENDIF
- IF(ABS(X) .LE. EIGHT) THEN
- Y=X/EIGHT
- H=TWO*Y**2-ONE
- ALFA=-TWO*H
- B1=ZERO
- B2=ZERO
- DO 1 I = 13,0,-1
- B0=C(I)-ALFA*B1-B2
- B2=B1
- 1 B1=B0
- B1=CE+LOG(ABS(X))-B0+H*B2
- ELSE
- R=ONE/X
- Y=EIGHT*R
- H=TWO*Y**2-ONE
- ALFA=-TWO*H
- B1=ZERO
- B2=ZERO
- DO 2 I = 22,0,-1
- B0=P(I)-ALFA*B1-B2
- B2=B1
- 2 B1=B0
- PP=B0-H*B2
- B1=ZERO
- B2=ZERO
- DO 3 I = 19,0,-1
- B0=Q(I)-ALFA*B1-B2
- B2=B1
- 3 B1=B0
- QQ=B0-H*B2
- B1=R*(QQ*SIN(X)-R*PP*COS(X))
- ENDIF
- IF(ENAME .EQ. 'COSINT') THEN
- COSINT=ROUND(B1)
- ELSE
- DCOSIN=B1
- ENDIF
- RETURN
-
- 100 FORMAT(7X,A6,' ... ARGUMENT ZERO')
- END
diff --git a/src/packlib/kernlib/kernnum/c336fort/sinint.F b/src/packlib/kernlib/kernnum/c336fort/sinint.F
deleted file mode 100644
index b1af549..0000000
--- a/src/packlib/kernlib/kernnum/c336fort/sinint.F
+++ /dev/null
@@ -1,139 +0,0 @@
-*
-* $Id: sinint.F,v 1.1.1.1 1996/02/15 17:49:09 mclareni Exp $
-*
-* $Log: sinint.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:09 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- REAL FUNCTION SININT(RX)
- REAL RX
- CHARACTER*6 ENAME
-#if defined(CERNLIB_NUMHIPRE)
- REAL ZERO,ONE,TWO,EIGHT,PIH,X,Y,R,H,ALFA,D
- REAL DSININ,B0,B1,B2,PP,QQ,S(0:13),P(0:22),Q(0:19)
-#endif
-#if defined(CERNLIB_NUMLOPRE)
- DOUBLE PRECISION ZERO,ONE,TWO,EIGHT,PIH,X,Y,R,H,ALFA,D
- DOUBLE PRECISION DSININ,B0,B1,B2,PP,QQ,S(0:13),P(0:22),Q(0:19)
- DOUBLE PRECISION DX
-#endif
-
- DATA ZERO /0.0D0/, ONE /1.0D0/, TWO /2.0D0/
- DATA EIGHT /8.0D0/, PIH /1.57079 63267 949D0/
-
- DATA S( 0) /+1.95222 09759 531D0/
- DATA S( 1) /-0.68840 42321 257D0/
- DATA S( 2) /+0.45518 55132 256D0/
- DATA S( 3) /-0.18045 71236 838D0/
- DATA S( 4) /+0.04104 22133 759D0/
- DATA S( 5) /-0.00595 86169 556D0/
- DATA S( 6) /+0.00060 01427 414D0/
- DATA S( 7) /-0.00004 44708 329D0/
- DATA S( 8) /+0.00000 25300 782D0/
- DATA S( 9) /-0.00000 01141 308D0/
- DATA S(10) /+0.00000 00041 858D0/
- DATA S(11) /-0.00000 00001 273D0/
- DATA S(12) /+0.00000 00000 033D0/
- DATA S(13) /-0.00000 00000 001D0/
-
- DATA P( 0) /+0.96074 78397 5204D0/
- DATA P( 1) /-0.03711 38962 1240D0/
- DATA P( 2) /+0.00194 14398 8899D0/
- DATA P( 3) /-0.00017 16598 8425D0/
- DATA P( 4) /+0.00002 11263 7753D0/
- DATA P( 5) /-0.00000 32716 3257D0/
- DATA P( 6) /+0.00000 06006 9212D0/
- DATA P( 7) /-0.00000 01258 6794D0/
- DATA P( 8) /+0.00000 00293 2563D0/
- DATA P( 9) /-0.00000 00074 5696D0/
- DATA P(10) /+0.00000 00020 4105D0/
- DATA P(11) /-0.00000 00005 9502D0/
- DATA P(12) /+0.00000 00001 8323D0/
- DATA P(13) /-0.00000 00000 5921D0/
- DATA P(14) /+0.00000 00000 1997D0/
- DATA P(15) /-0.00000 00000 0700D0/
- DATA P(16) /+0.00000 00000 0254D0/
- DATA P(17) /-0.00000 00000 0095D0/
- DATA P(18) /+0.00000 00000 0037D0/
- DATA P(19) /-0.00000 00000 0014D0/
- DATA P(20) /+0.00000 00000 0006D0/
- DATA P(21) /-0.00000 00000 0002D0/
- DATA P(22) /+0.00000 00000 0001D0/
-
- DATA Q( 0) /+0.98604 06569 6238D0/
- DATA Q( 1) /-0.01347 17382 0830D0/
- DATA Q( 2) /+0.00045 32928 4117D0/
- DATA Q( 3) /-0.00003 06728 8652D0/
- DATA Q( 4) /+0.00000 31319 9198D0/
- DATA Q( 5) /-0.00000 04211 0196D0/
- DATA Q( 6) /+0.00000 00690 7245D0/
- DATA Q( 7) /-0.00000 00131 8321D0/
- DATA Q( 8) /+0.00000 00028 3697D0/
- DATA Q( 9) /-0.00000 00006 7329D0/
- DATA Q(10) /+0.00000 00001 7340D0/
- DATA Q(11) /-0.00000 00000 4787D0/
- DATA Q(12) /+0.00000 00000 1403D0/
- DATA Q(13) /-0.00000 00000 0433D0/
- DATA Q(14) /+0.00000 00000 0140D0/
- DATA Q(15) /-0.00000 00000 0047D0/
- DATA Q(16) /+0.00000 00000 0017D0/
- DATA Q(17) /-0.00000 00000 0006D0/
- DATA Q(18) /+0.00000 00000 0002D0/
- DATA Q(19) /-0.00000 00000 0001D0/
-#if defined(CERNLIB_NUMHIPRE)
- ROUND(D) = D
-#endif
-#if defined(CERNLIB_NUMLOPRE)
- ROUND(D) = SNGL(D+(D-DBLE(SNGL(D))))
-#endif
-
- X=RX
- ENAME='SININT'
-#if defined(CERNLIB_NUMLOPRE)
- GOTO 9
- ENTRY DSININ(DX)
- X=DX
- ENAME='DSININ'
-#endif
-
- 9 IF(ABS(X) .LE. EIGHT) THEN
- Y=X/EIGHT
- H=TWO*Y**2-ONE
- ALFA=-TWO*H
- B1=ZERO
- B2=ZERO
- DO 1 I = 13,0,-1
- B0=S(I)-ALFA*B1-B2
- B2=B1
- 1 B1=B0
- B1=Y*(B0-B2)
- ELSE
- R=ONE/X
- Y=EIGHT*R
- H=TWO*Y**2-ONE
- ALFA=-TWO*H
- B1=ZERO
- B2=ZERO
- DO 2 I = 22,0,-1
- B0=P(I)-ALFA*B1-B2
- B2=B1
- 2 B1=B0
- PP=B0-H*B2
- B1=ZERO
- B2=ZERO
- DO 3 I = 19,0,-1
- B0=Q(I)-ALFA*B1-B2
- B2=B1
- 3 B1=B0
- QQ=B0-H*B2
- B1=SIGN(PIH,X)-R*(R*PP*SIN(X)+QQ*COS(X))
- ENDIF
- IF(ENAME .EQ. 'SININT') THEN
- SININT=ROUND(B1)
- ELSE
- DSININ=B1
- ENDIF
- RETURN
- END
diff --git a/src/packlib/kernlib/kernnum/c337fort/Imakefile b/src/packlib/kernlib/kernnum/c337fort/Imakefile
deleted file mode 100644
index 832fcce..0000000
--- a/src/packlib/kernlib/kernnum/c337fort/Imakefile
+++ /dev/null
@@ -1,9 +0,0 @@
-SRCS_F= expint.F
-
-#if defined(CERNLIB_DECS) && ! defined(CERNLIB_QMVAOS)
-FDEBUGFLAGS=NoOpFortranDebugFlags
-#endif
-
-FORTRANSAVEOPTION=FortranSaveFlags
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kernnum/c337fort/expint.F b/src/packlib/kernlib/kernnum/c337fort/expint.F
deleted file mode 100644
index 8a5bd82..0000000
--- a/src/packlib/kernlib/kernnum/c337fort/expint.F
+++ /dev/null
@@ -1,187 +0,0 @@
-*
-* $Id: expint.F,v 1.1.1.1 1996/02/15 17:49:10 mclareni Exp $
-*
-* $Log: expint.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:10 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- REAL FUNCTION EXPINT(RX)
- REAL RX
- CHARACTER*6 ENAME
- LOGICAL MFLAG,RFLAG
-#if defined(CERNLIB_NUMHIPRE)
- REAL P1(5),Q1(5),P2(7),Q2(7),P3(6),Q3(6),P4(8),Q4(8)
- REAL A1(8),B1(8),A2(8),B2(8),A3(6),B3(6),XL(6)
- REAL DEXPIN,X,Y,ZERO,ONE,TWO,THREE,AP,BP,DP,AQ,BQ,DQ,X0,V,D
-#endif
-#if defined(CERNLIB_NUMLOPRE)
- DOUBLE PRECISION P1(5),Q1(5),P2(7),Q2(7),P3(6),Q3(6),P4(8),Q4(8)
- DOUBLE PRECISION A1(8),B1(8),A2(8),B2(8),A3(6),B3(6),XL(6)
- DOUBLE PRECISION X,Y,ZERO,ONE,TWO,THREE,AP,BP,DP,AQ,BQ,DQ,X0,V,D
- DOUBLE PRECISION DEXPIN,DX
-#endif
-
- DATA ZERO /0.0D0/, ONE /1.0D0/, TWO /2.0D0/, THREE /3.0D0/
- DATA X0 /0.37250 74107 8137D0/
- DATA XL /-24.0D0,-12.0D0,-6.0D0,0.0D0,1.0D0,4.0D0/
- DATA P1
- 1/+4.29312 52343 210D+0, +3.98941 53870 321D+1,
- 2 +2.92525 18866 921D+2, +4.25696 82638 592D+2,
- 3 -4.34981 43832 952D+2/
- DATA Q1
- 1/+1.00000 00000 000D+0, +1.88992 88395 003D+1,
- 2 +1.50950 38744 251D+2, +5.68052 52718 987D+2,
- 3 +7.53585 64359 843D+2/
- DATA P2
- 1/+4.30967 83946 939D-1, +6.90522 52278 444D+0,
- 2 +2.30192 55939 133D+1, +2.43784 08879 132D+1,
- 3 +9.04161 55694 633D+0, +9.99979 57705 159D-1,
- 4 +4.65627 10797 510D-7/
- DATA Q2
- 1/+1.03400 13040 487D-1, +3.31909 21359 330D+0,
- 2 +2.04494 78501 379D+1, +4.12807 84189 142D+1,
- 3 +3.24264 21069 514D+1, +1.00411 64382 905D+1,
- 4 +1.00000 00000 000D+0/
- DATA P3
- 1/-2.39099 64453 136D+0, -1.47982 19500 504D+2,
- 2 -2.54376 33976 890D+2, -1.19557 61038 372D+2,
- 3 -1.96304 08535 939D+1, -9.99999 99990 360D-1/
- DATA Q3
- 1/+1.77600 70940 351D+2, +5.30685 09610 812D+2,
- 2 +4.62230 27156 148D+2, +1.56818 43364 539D+2,
- 3 +2.16304 08494 238D+1, +1.00000 00000 000D+0/
- DATA P4
- 1/-8.66937 33995 107D+0, -5.49142 26552 109D+2,
- 2 -4.21001 61535 707D+3, -2.49301 39345 865D+5,
- 3 -1.19623 66934 925D+5, -2.21744 62775 885D+7,
- 4 +3.89280 42131 120D+6, -3.91546 07380 910D+8/
- DATA Q4
- 1/+3.41718 75000 000D+1, -1.60708 92658 722D+3,
- 2 +3.57300 29805 851D+4, -4.83547 43616 216D+5,
- 3 +4.28559 62461 175D+6, -2.49033 37574 054D+7,
- 4 +8.91925 76757 561D+7, -1.65254 29972 521D+8/
- DATA A1
- 1/-2.18086 38152 072D+0, -2.19010 23385 488D+1,
- 2 +9.30816 38566 217D+0, +2.50762 81129 356D+1,
- 3 -3.31842 53199 722D+1, +6.01217 99083 008D+1,
- 4 -4.32531 13287 813D+1, +1.00443 10922 808D+0/
- DATA B1
- 1/+0.00000 00000 000D+0, +3.93707 70185 272D+0,
- 2 +3.00892 64837 292D+2, -6.25041 16167 188D+0,
- 3 +1.00367 43951 673D+3, +1.43256 73812 194D+1,
- 4 +2.73624 11988 933D+3, +5.27468 85196 291D-1/
- DATA A2
- 1/-3.48334 65360 285D+0, -1.86545 45488 340D+1,
- 2 -8.28561 99414 064D+0, -3.23467 33030 540D+1,
- 3 +1.79601 68876 925D+1, +1.75656 31546 961D+0,
- 4 -1.95022 32128 966D+0, +9.99994 29607 471D-1/
- DATA B2
- 1/+0.00000 00000 000D+0, +6.95000 65588 743D+1,
- 2 +5.72837 19383 732D+1, +2.57776 38423 844D+1,
- 3 +7.60761 14800 773D+2, +2.89516 72792 514D+1,
- 4 -3.43942 26689 987D+0, +1.00083 86740 264D+0/
- DATA A3
- 1/-2.77809 28934 438D+1, -1.01047 90815 760D+1,
- 2 -9.14830 08216 736D+0, -5.02233 17461 851D+0,
- 3 -3.00000 77799 358D+0, +1.00000 00000 704D+0/
- DATA B3
- 1/+0.00000 00000 000D+0, +1.22399 93926 823D+2,
- 2 +2.72761 00778 779D+0, -7.18975 18395 045D+0,
- 3 -2.99901 18065 262D+0, +1.99999 99428 260D+0/
-#if defined(CERNLIB_NUMHIPRE)
- ROUND(D) = D
-#endif
-#if defined(CERNLIB_NUMLOPRE)
- ROUND(D) = SNGL(D+(D-DBLE(SNGL(D))))
-#endif
-
- ENAME='EXPINT'
- X=RX
-#if defined(CERNLIB_NUMLOPRE)
- GOTO 9
- ENTRY DEXPIN(DX)
- ENAME='DEXPIN'
- X=DX
-#endif
-
- 9 IF(X .LE. XL(1)) THEN
- AP=A3(1)-X
- DO 1 I = 2,5
- 1 AP=A3(I)-X+B3(I)/AP
- Y=(EXP(-X)/X)*(ONE-(A3(6)+B3(6)/AP)/X)
- ELSEIF(X .LE. XL(2)) THEN
- AP=A2(1)-X
- DO 2 I = 2,7
- 2 AP=A2(I)-X+B2(I)/AP
- Y=(EXP(-X)/X)*(A2(8)+B2(8)/AP)
- ELSEIF(X .LE. XL(3)) THEN
- AP=A1(1)-X
- DO 3 I = 2,7
- 3 AP=A1(I)-X+B1(I)/AP
- Y=(EXP(-X)/X)*(A1(8)+B1(8)/AP)
- ELSEIF(X .LT. XL(4)) THEN
- V=-TWO*(X/THREE+ONE)
- BP=ZERO
- DP=P4(1)
- DO 4 I = 2,8
- AP=BP
- BP=DP
- 4 DP=P4(I)-AP+V*BP
- BQ=ZERO
- DQ=Q4(1)
- DO 14 I = 2,8
- AQ=BQ
- BQ=DQ
- 14 DQ=Q4(I)-AQ+V*BQ
- Y=-LOG(-X/X0)+(X+X0)*(DP-AP)/(DQ-AQ)
- ELSEIF(X .EQ. XL(4)) THEN
- CALL KERMTR('C337.1',LGFILE,MFLAG,RFLAG)
- IF(MFLAG) THEN
- IF(LGFILE .EQ. 0) THEN
- WRITE(*,100) ENAME
- ELSE
- WRITE(LGFILE,100) ENAME
- ENDIF
- ENDIF
- IF(.NOT.RFLAG) CALL ABEND
- IF(ENAME .EQ. 'EXPINT') THEN
- EXPINT=ZERO
- ELSE
- DEXPIN=ZERO
- ENDIF
- RETURN
- ELSEIF(X .LT. XL(5)) THEN
- AP=P1(1)
- AQ=Q1(1)
- DO 5 I = 2,5
- AP=P1(I)+X*AP
- 5 AQ=Q1(I)+X*AQ
- Y=-LOG(X)+AP/AQ
- ELSEIF(X .LE. XL(6)) THEN
- Y=ONE/X
- AP=P2(1)
- AQ=Q2(1)
- DO 6 I = 2,7
- AP=P2(I)+Y*AP
- 6 AQ=Q2(I)+Y*AQ
- Y=EXP(-X)*AP/AQ
- ELSE
- Y=ONE/X
- AP=P3(1)
- AQ=Q3(1)
- DO 7 I = 2,6
- AP=P3(I)+Y*AP
- 7 AQ=Q3(I)+Y*AQ
- Y=EXP(-X)*Y*(ONE+Y*AP/AQ)
- ENDIF
- IF(ENAME .EQ. 'EXPINT') THEN
- EXPINT=ROUND(Y)
- ELSE
- DEXPIN=Y
- ENDIF
- RETURN
-
- 100 FORMAT(7X,A6,' ... ARGUMENT ZERO')
- END
diff --git a/src/packlib/kernlib/kernnum/c341fort/Imakefile b/src/packlib/kernlib/kernnum/c341fort/Imakefile
deleted file mode 100644
index d0efed1..0000000
--- a/src/packlib/kernlib/kernnum/c341fort/Imakefile
+++ /dev/null
@@ -1,9 +0,0 @@
-SRCS_F= alogam.F
-
-#if defined(CERNLIB_DECS) && ! defined(CERNLIB_QMVAOS)
-FDEBUGFLAGS=NoOpFortranDebugFlags
-#endif
-
-FORTRANSAVEOPTION=FortranSaveFlags
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kernnum/c341fort/alogam.F b/src/packlib/kernlib/kernnum/c341fort/alogam.F
deleted file mode 100644
index 4c47b34..0000000
--- a/src/packlib/kernlib/kernnum/c341fort/alogam.F
+++ /dev/null
@@ -1,136 +0,0 @@
-*
-* $Id: alogam.F,v 1.1.1.1 1996/02/15 17:49:10 mclareni Exp $
-*
-* $Log: alogam.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:10 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- REAL FUNCTION ALOGAM(RX)
- REAL RX,SX
- CHARACTER*6 ENAME
- LOGICAL MFLAG,RFLAG
-#if defined(CERNLIB_NUMHIPRE)
- REAL P1(7),Q1(7),P2(7),Q2(7),P3(7),Q3(7),C(5),XL(5)
- REAL DLOGAM,X,Y,ZERO,ONE,TWO,HALF,AP,AQ,D
-#endif
-#if defined(CERNLIB_NUMLOPRE)
- DOUBLE PRECISION P1(7),Q1(7),P2(7),Q2(7),P3(7),Q3(7),C(5),XL(5)
- DOUBLE PRECISION DLOGAM,X,Y,ZERO,ONE,TWO,HALF,AP,AQ,D
- DOUBLE PRECISION DX
-#endif
-
- DATA ZERO /0.0D0/, ONE /1.0D0/, TWO /2.0D0/, HALF /0.5D0/
- DATA XL /0.0D0,0.5D0,1.5D0,4.0D0,12.0D0/
- DATA P1
- 1/+3.84287 36567 460D+0, +5.27068 93753 010D+1,
- 2 +5.55840 45723 515D+1, -2.15135 13573 726D+2,
- 3 -2.45872 61722 292D+2, -5.75008 93603 041D+1,
- 4 -2.33590 98949 513D+0/
- DATA Q1
- 1/+1.00000 00000 000D+0, +3.37330 47907 071D+1,
- 2 +1.93877 84034 377D+2, +3.08829 54973 424D+2,
- 3 +1.50068 39064 891D+2, +2.01068 51344 334D+1,
- 4 +4.57174 20282 503D-1/
- DATA P2
- 1/+4.87402 01396 839D+0, +2.48845 25168 574D+2,
- 2 +2.17973 66058 896D+3, +3.79751 24011 525D+3,
- 3 -1.97780 70769 842D+3, -3.69298 34005 591D+3,
- 4 -5.60177 73537 804D+2/
- DATA Q2
- 1/+1.00000 00000 000D+0, +9.50999 17418 209D+1,
- 2 +1.56120 45277 929D+3, +7.23400 87928 948D+3,
- 3 +1.04595 76594 059D+4, +4.16994 15153 200D+3,
- 4 +2.76785 83623 804D+2/
- DATA P3
- 1/-6.88062 40094 594D+3, -4.30699 69819 571D+5,
- 2 -4.75045 94653 440D+6, -2.94234 45930 322D+6,
- 3 +3.63218 04931 543D+7, -3.35677 82814 546D+6,
- 4 -2.48043 69488 286D+7/
- DATA Q3
- 1/+1.00000 00000 000D+0, -1.42168 29839 651D+3,
- 2 -1.55528 90280 854D+5, -3.41525 17108 011D+6,
- 3 -2.09696 23255 804D+7, -3.45441 75093 344D+7,
- 4 -9.16055 82863 713D+6/
- DATA C
- 1/ 1.12249 21356 561D-1, 7.95916 92961 204D-2,
- 1 -1.70877 94611 020D-3, 9.18938 53320 467D-1,
- 2 1.34699 05627 879D+0/
-#if defined(CERNLIB_NUMHIPRE)
- ROUND(D) = D
-#endif
-#if defined(CERNLIB_NUMLOPRE)
- ROUND(D) = SNGL(D+(D-DBLE(SNGL(D))))
-#endif
-
- ENAME='ALOGAM'
- X=RX
-#if defined(CERNLIB_NUMLOPRE)
- GOTO 9
- ENTRY DLOGAM(DX)
- ENAME='DLOGAM'
- X=DX
-#endif
-
- 9 IF(X .LE. XL(1)) THEN
- CALL KERMTR('C341.1',LGFILE,MFLAG,RFLAG)
- IF(MFLAG) THEN
- SX=X
- IF(LGFILE .EQ. 0) THEN
- WRITE(*,100) ENAME,SX
- ELSE
- WRITE(LGFILE,100) ENAME,SX
- ENDIF
- ENDIF
- IF(.NOT.RFLAG) CALL ABEND
- IF(ENAME .EQ. 'ALOGAM') THEN
- ALOGAM=ZERO
- ELSE
- DLOGAM=ZERO
- ENDIF
- RETURN
- ENDIF
- IF(X .LE. XL(2)) THEN
- Y=X+ONE
- AP=P1(1)
- AQ=Q1(1)
- DO 2 I = 2,7
- AP=P1(I)+Y*AP
- 2 AQ=Q1(I)+Y*AQ
- Y=-LOG(X)+X*AP/AQ
- ELSEIF(X .LE. XL(3)) THEN
- AP=P1(1)
- AQ=Q1(1)
- DO 3 I = 2,7
- AP=P1(I)+X*AP
- 3 AQ=Q1(I)+X*AQ
- Y=(X-ONE)*AP/AQ
- ELSEIF(X .LE. XL(4)) THEN
- AP=P2(1)
- AQ=Q2(1)
- DO 4 I = 2,7
- AP=P2(I)+X*AP
- 4 AQ=Q2(I)+X*AQ
- Y=(X-TWO)*AP/AQ
- ELSEIF(X .LE. XL(5)) THEN
- AP=P3(1)
- AQ=Q3(1)
- DO 5 I = 2,7
- AP=P3(I)+X*AP
- 5 AQ=Q3(I)+X*AQ
- Y=AP/AQ
- ELSE
- Y=ONE/X**2
- Y=(X-HALF)*LOG(X)-X+C(4)+(C(1)+Y*(C(2)+Y*C(3)))/
- 1 ((C(5)+Y)*X)
- ENDIF
- IF(ENAME .EQ. 'ALOGAM') THEN
- ALOGAM=ROUND(Y)
- ELSE
- DLOGAM=Y
- ENDIF
- RETURN
-
- 100 FORMAT(7X,A6,' ... NON-POSITIVE ARGUMENT X = ',E16.6)
- END
diff --git a/src/packlib/kernlib/kernnum/d106fort/Imakefile b/src/packlib/kernlib/kernnum/d106fort/Imakefile
deleted file mode 100644
index 614fb37..0000000
--- a/src/packlib/kernlib/kernnum/d106fort/Imakefile
+++ /dev/null
@@ -1,9 +0,0 @@
-SRCS_F= d106xx.F gquad.F gset.F
-
-#if defined(CERNLIB_DECS) && ! defined(CERNLIB_QMVAOS)
-FDEBUGFLAGS=NoOpFortranDebugFlags
-#endif
-
-FORTRANSAVEOPTION=FortranSaveFlags
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kernnum/d106fort/d106xx.F b/src/packlib/kernlib/kernnum/d106fort/d106xx.F
deleted file mode 100644
index 4c29662..0000000
--- a/src/packlib/kernlib/kernnum/d106fort/d106xx.F
+++ /dev/null
@@ -1,737 +0,0 @@
-*
-* $Id: d106xx.F,v 1.1.1.1 1996/02/15 17:48:47 mclareni Exp $
-*
-* $Log: d106xx.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:47 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE D106XX(MODE,F,A,B,N,X,W)
- EXTERNAL F
- LOGICAL MFLAG,RFLAG
- SAVE NW
- DIMENSION X(N),W(N)
-C
-C ******************************************************************
-C
-C MODE=1 ... SETS X(1) EQUAL TO THE INTEGRAL OF THE FUNCTION F OVER
-C THE INTERVAL (A,B) AS APPROXIMATED BY THE GAUSS-LEGENDRE QUADRAT-
-C URE FORMULA OF ORDER N.
-C
-C MODE=2 ... STORES IN ARRAYS X AND W, RESPECTIVELY, THE ABSCISSAE
-C AND WEIGHTS FOR N-POINT GAUSS-LEGENDRE QUADRATURE OVER THE INTER-
-C VAL (A,B).
-C
-C ******************************************************************
-C
- DIMENSION KTAB(36),XT(273),WT(273)
-C
-C TABLE OF INITIAL SUBSCRIPTS.
- DATA KTAB(2) / 1/
- DATA KTAB(3) / 2/
- DATA KTAB(4) / 4/
- DATA KTAB(5) / 6/
- DATA KTAB(6) / 9/
- DATA KTAB(7) / 12/
- DATA KTAB(8) / 16/
- DATA KTAB(9) / 20/
- DATA KTAB(10)/ 25/
- DATA KTAB(11)/ 30/
- DATA KTAB(12)/ 36/
- DATA KTAB(13)/ 42/
- DATA KTAB(14)/ 49/
- DATA KTAB(15)/ 56/
- DATA KTAB(16)/ 64/
- DATA KTAB(17)/ 72/
- DATA KTAB(18)/ 82/
- DATA KTAB(20)/ 94/
- DATA KTAB(22)/110/
- DATA KTAB(24)/130/
- DATA KTAB(28)/154/
- DATA KTAB(32)/186/
- DATA KTAB(36)/226/
-C
-C TABLE OF ABSCISSAE X AND WEIGHTS W FOR INTERVAL (-1,+1).
-C
-#if defined(CERNLIB_NUMHIPRE)
-C (EACH DECIMAL CONSTANT HAS MAXIMUM CDC NO-DIAGNOSTIC PRECISION.)
-C
-C N=2.
- DATA XT(1) /5.7735026918963 E-01/, WT(1) /1.00000000000000E+00/
-C N=3.
- DATA XT(2) /7.7459666924148 E-01/, WT(2) /5.5555555555556 E-01/
- DATA XT(3) /0. /, WT(3) /8.8888888888889 E-01/
-C N=4.
- DATA XT(4) /8.6113631159405 E-01/, WT(4) /3.4785484513745 E-01/
- DATA XT(5) /3.3998104358486 E-01/, WT(5) /6.5214515486255 E-01/
-C N=5.
- DATA XT(6) /9.0617984593866 E-01/, WT(6) /2.36926885056189E-01/
- DATA XT(7) /5.3846931010568 E-01/, WT(7) /4.7862867049937 E-01/
- DATA XT(8) /0. /, WT(8) /5.6888888888889 E-01/
-C N=6.
- DATA XT(9) /9.3246951420315 E-01/, WT(9) /1.71324492379170E-01/
- DATA XT(10) /6.6120938646626 E-01/, WT(10) /3.6076157304814 E-01/
- DATA XT(11) /2.38619186083197E-01/, WT(11) /4.6791393457269 E-01/
-C N=7.
- DATA XT(12) /9.4910791234276 E-01/, WT(12) /1.29484966168870E-01/
- DATA XT(13) /7.4153118559939 E-01/, WT(13) /2.79705391489277E-01/
- DATA XT(14) /4.0584515137740 E-01/, WT(14) /3.8183005050512 E-01/
- DATA XT(15) /0. /, WT(15) /4.1795918367347 E-01/
-C N=8.
- DATA XT(16) /9.6028985649754 E-01/, WT(16) /1.01228536290376E-01/
- DATA XT(17) /7.9666647741363 E-01/, WT(17) /2.22381034453374E-01/
- DATA XT(18) /5.2553240991633 E-01/, WT(18) /3.1370664587789 E-01/
- DATA XT(19) /1.83434642495650E-01/, WT(19) /3.6268378337836 E-01/
-C N=9.
- DATA XT(20) /9.6816023950763 E-01/, WT(20) /8.1274388361574 E-02/
- DATA XT(21) /8.3603110732664 E-01/, WT(21) /1.80648160694857E-01/
- DATA XT(22) /6.1337143270059 E-01/, WT(22) /2.60610696402935E-01/
- DATA XT(23) /3.2425342340381 E-01/, WT(23) /3.1234707704000 E-01/
- DATA XT(24) /0. /, WT(24) /3.3023935500126 E-01/
-C N=10.
- DATA XT(25) /9.7390652851717 E-01/, WT(25) /6.6671344308688 E-02/
- DATA XT(26) /8.6506336668898 E-01/, WT(26) /1.49451349150581E-01/
- DATA XT(27) /6.7940956829902 E-01/, WT(27) /2.19086362515982E-01/
- DATA XT(28) /4.3339539412925 E-01/, WT(28) /2.69266719309996E-01/
- DATA XT(29) /1.48874338981631E-01/, WT(29) /2.9552422471475 E-01/
-C N=11.
- DATA XT(30) /9.7822865814606 E-01/, WT(30) /5.5668567116174 E-02/
- DATA XT(31) /8.8706259976810 E-01/, WT(31) /1.25580369464905E-01/
- DATA XT(32) /7.3015200557405 E-01/, WT(32) /1.86290210927734E-01/
- DATA XT(33) /5.1909612920681 E-01/, WT(33) /2.33193764591990E-01/
- DATA XT(34) /2.69543155952345E-01/, WT(34) /2.62804544510247E-01/
- DATA XT(35) /0. /, WT(35) /2.72925086777901E-01/
-C N=12.
- DATA XT(36) /9.8156063424672 E-01/, WT(36) /4.7175336386512 E-02/
- DATA XT(37) /9.0411725637047 E-01/, WT(37) /1.06939325995318E-01/
- DATA XT(38) /7.6990267419430 E-01/, WT(38) /1.60078328543346E-01/
- DATA XT(39) /5.8731795428662 E-01/, WT(39) /2.03167426723066E-01/
- DATA XT(40) /3.6783149899818 E-01/, WT(40) /2.33492536538355E-01/
- DATA XT(41) /1.25233408511469E-01/, WT(41) /2.49147045813403E-01/
-C N=13.
- DATA XT(42) /9.8418305471859 E-01/, WT(42) /4.0484004765316 E-02/
- DATA XT(43) /9.1759839922298 E-01/, WT(43) /9.2121499837728 E-02/
- DATA XT(44) /8.0157809073331 E-01/, WT(44) /1.38873510219787E-01/
- DATA XT(45) /6.4234933944034 E-01/, WT(45) /1.78145980761946E-01/
- DATA XT(46) /4.4849275103645 E-01/, WT(46) /2.07816047536889E-01/
- DATA XT(47) /2.30458315955135E-01/, WT(47) /2.26283180262897E-01/
- DATA XT(48) /0. /, WT(48) /2.32551553230874E-01/
-C N=14.
- DATA XT(49) /9.8628380869681 E-01/, WT(49) /3.5119460331752 E-02/
- DATA XT(50) /9.2843488366357 E-01/, WT(50) /8.0158087159760 E-02/
- DATA XT(51) /8.2720131506976 E-01/, WT(51) /1.21518570687903E-01/
- DATA XT(52) /6.8729290481169 E-01/, WT(52) /1.57203167158194E-01/
- DATA XT(53) /5.1524863635815 E-01/, WT(53) /1.85538397477938E-01/
- DATA XT(54) /3.1911236892789 E-01/, WT(54) /2.05198463721296E-01/
- DATA XT(55) /1.08054948707344E-01/, WT(55) /2.15263853463158E-01/
-C N=15.
- DATA XT(56) /9.8799251802049 E-01/, WT(56) /3.0753241996117 E-02/
- DATA XT(57) /9.3727339240071 E-01/, WT(57) /7.0366047488108 E-02/
- DATA XT(58) /8.4820658341043 E-01/, WT(58) /1.07159220467172E-01/
- DATA XT(59) /7.2441773136017 E-01/, WT(59) /1.39570677926154E-01/
- DATA XT(60) /5.7097217260854 E-01/, WT(60) /1.66269205816994E-01/
- DATA XT(61) /3.9415134707756 E-01/, WT(61) /1.86161000015562E-01/
- DATA XT(62) /2.01194093997435E-01/, WT(62) /1.98431485327112E-01/
- DATA XT(63) /0. /, WT(63) /2.02578241925561E-01/
-C N=16.
- DATA XT(64) /9.8940093499165 E-01/, WT(64) /2.71524594117541E-02/
- DATA XT(65) /9.4457502307323 E-01/, WT(65) /6.2253523938648 E-02/
- DATA XT(66) /8.6563120238783 E-01/, WT(66) /9.5158511682493 E-02/
- DATA XT(67) /7.5540440835500 E-01/, WT(67) /1.24628971255534E-01/
- DATA XT(68) /6.1787624440264 E-01/, WT(68) /1.49595988816577E-01/
- DATA XT(69) /4.5801677765723 E-01/, WT(69) /1.69156519395003E-01/
- DATA XT(70) /2.8160355077926 E-01/, WT(70) /1.82603415044924E-01/
- DATA XT(71) /9.5012509837637 E-02/, WT(71) /1.89450610455068E-01/
-C N=20.
- DATA XT(72) /9.9312859918509 E-01/, WT(72) /1.76140071391521E-02/
- DATA XT(73) /9.6397192727791 E-01/, WT(73) /4.0601429800387 E-02/
- DATA XT(74) /9.1223442825133 E-01/, WT(74) /6.2672048334109 E-02/
- DATA XT(75) /8.3911697182222 E-01/, WT(75) /8.3276741576705 E-02/
- DATA XT(76) /7.4633190646015 E-01/, WT(76) /1.01930119817240E-01/
- DATA XT(77) /6.3605368072652 E-01/, WT(77) /1.18194531961518E-01/
- DATA XT(78) /5.1086700195083 E-01/, WT(78) /1.31688638449177E-01/
- DATA XT(79) /3.7370608871542 E-01/, WT(79) /1.42096109318382E-01/
- DATA XT(80) /2.27785851141645E-01/, WT(80) /1.49172986472604E-01/
- DATA XT(81) /7.6526521133497 E-02/, WT(81) /1.52753387130726E-01/
-C N=24.
- DATA XT(82) /9.9518721999702 E-01/, WT(82) /1.23412297999872E-02/
- DATA XT(83) /9.7472855597131 E-01/, WT(83) /2.8531388628934 E-02/
- DATA XT(84) /9.3827455200273 E-01/, WT(84) /4.4277438817420 E-02/
- DATA XT(85) /8.8641552700440 E-01/, WT(85) /5.9298584915437 E-02/
- DATA XT(86) /8.2000198597390 E-01/, WT(86) /7.3346481411080 E-02/
- DATA XT(87) /7.4012419157855 E-01/, WT(87) /8.6190161531953 E-02/
- DATA XT(88) /6.4809365193698 E-01/, WT(88) /9.7618652104114 E-02/
- DATA XT(89) /5.4542147138884 E-01/, WT(89) /1.07444270115966E-01/
- DATA XT(90) /4.3379350762605 E-01/, WT(90) /1.15505668053726E-01/
- DATA XT(91) /3.1504267969616 E-01/, WT(91) /1.21670472927803E-01/
- DATA XT(92) /1.91118867473616E-01/, WT(92) /1.25837456346828E-01/
- DATA XT(93) /6.4056892862606 E-02/, WT(93) /1.27938195346752E-01/
-C N=32.
- DATA XT(94) /9.9726386184948 E-01/, WT(94) /7.0186100094701 E-03/
- DATA XT(95) /9.8561151154527 E-01/, WT(95) /1.62743947309057E-02/
- DATA XT(96) /9.6476225558751 E-01/, WT(96) /2.53920653092621E-02/
- DATA XT(97) /9.3490607593774 E-01/, WT(97) /3.4273862913021 E-02/
- DATA XT(98) /8.9632115576605 E-01/, WT(98) /4.2835898022227 E-02/
- DATA XT(99) /8.4936761373257 E-01/, WT(99) /5.0998059262376 E-02/
- DATA XT(100)/7.9448379596794 E-01/, WT(100)/5.8684093478536 E-02/
- DATA XT(101)/7.3218211874029 E-01/, WT(101)/6.5822222776362 E-02/
- DATA XT(102)/6.6304426693022 E-01/, WT(102)/7.2345794108849 E-02/
- DATA XT(103)/5.8771575724076 E-01/, WT(103)/7.8193895787070 E-02/
- DATA XT(104)/5.0689990893223 E-01/, WT(104)/8.3311924226947 E-02/
- DATA XT(105)/4.2135127613064 E-01/, WT(105)/8.7652093004404 E-02/
- DATA XT(106)/3.3186860228213 E-01/, WT(106)/9.1173878695764 E-02/
- DATA XT(107)/2.39287362252137E-01/, WT(107)/9.3844399080805 E-02/
- DATA XT(108)/1.44471961582796E-01/, WT(108)/9.5638720079275 E-02/
- DATA XT(109)/4.8307665687738 E-02/, WT(109)/9.6540088514728 E-02/
-C N=40.
- DATA XT(110)/9.9823770971056 E-01/, WT(110)/4.5212770985332 E-03/
- DATA XT(111)/9.9072623869946 E-01/, WT(111)/1.04982845311528E-02/
- DATA XT(112)/9.7725994998377 E-01/, WT(112)/1.64210583819079E-02/
- DATA XT(113)/9.5791681921379 E-01/, WT(113)/2.22458491941670E-02/
- DATA XT(114)/9.3281280827868 E-01/, WT(114)/2.79370069800234E-02/
- DATA XT(115)/9.0209880696887 E-01/, WT(115)/3.3460195282548 E-02/
- DATA XT(116)/8.6595950321226 E-01/, WT(116)/3.8782167974472 E-02/
- DATA XT(117)/8.2461223083331 E-01/, WT(117)/4.3870908185673 E-02/
- DATA XT(118)/7.7830565142652 E-01/, WT(118)/4.8695807635072 E-02/
- DATA XT(119)/7.2731825518993 E-01/, WT(119)/5.3227846983937 E-02/
- DATA XT(120)/6.7195668461418 E-01/, WT(120)/5.7439769099392 E-02/
- DATA XT(121)/6.1255388966798 E-01/, WT(121)/6.1306242492929 E-02/
- DATA XT(122)/5.4946712509513 E-01/, WT(122)/6.4804013456601 E-02/
- DATA XT(123)/4.8307580168618 E-01/, WT(123)/6.7912045815234 E-02/
- DATA XT(124)/4.1377920437161 E-01/, WT(124)/7.0611647391287 E-02/
- DATA XT(125)/3.4199409082576 E-01/, WT(125)/7.2886582395804 E-02/
- DATA XT(126)/2.68152185007254E-01/, WT(126)/7.4723169057968 E-02/
- DATA XT(127)/1.92697580701371E-01/, WT(127)/7.6110361900626 E-02/
- DATA XT(128)/1.16084070675255E-01/, WT(128)/7.7039818164248 E-02/
- DATA XT(129)/3.8772417506051 E-02/, WT(129)/7.7505947978425 E-02/
-C N=48.
- DATA XT(130)/9.9877100725243 E-01/, WT(130)/3.1533460523058 E-03/
- DATA XT(131)/9.9353017226635 E-01/, WT(131)/7.3275539012763 E-03/
- DATA XT(132)/9.8412458372283 E-01/, WT(132)/1.14772345792345E-02/
- DATA XT(133)/9.7059159254625 E-01/, WT(133)/1.55793157229438E-02/
- DATA XT(134)/9.5298770316043 E-01/, WT(134)/1.96161604573555E-02/
- DATA XT(135)/9.3138669070655 E-01/, WT(135)/2.35707608393244E-02/
- DATA XT(136)/9.0587913671557 E-01/, WT(136)/2.74265097083569E-02/
- DATA XT(137)/8.7657202027425 E-01/, WT(137)/3.1167227832798 E-02/
- DATA XT(138)/8.4358826162439 E-01/, WT(138)/3.4777222564770 E-02/
- DATA XT(139)/8.0706620402944 E-01/, WT(139)/3.8241351065831 E-02/
- DATA XT(140)/7.6715903251574 E-01/, WT(140)/4.1545082943465 E-02/
- DATA XT(141)/7.2403413092381 E-01/, WT(141)/4.4674560856694 E-02/
- DATA XT(142)/6.7787237963266 E-01/, WT(142)/4.7616658492490 E-02/
- DATA XT(143)/6.2886739677651 E-01/, WT(143)/5.0359035553854 E-02/
- DATA XT(144)/5.7722472608397 E-01/, WT(144)/5.2890189485194 E-02/
- DATA XT(145)/5.2316097472223 E-01/, WT(145)/5.5199503699984 E-02/
- DATA XT(146)/4.6690290475096 E-01/, WT(146)/5.7277292100403 E-02/
- DATA XT(147)/4.0868648199072 E-01/, WT(147)/5.9114839698396 E-02/
- DATA XT(148)/3.4875588629216 E-01/, WT(148)/6.0704439165894 E-02/
- DATA XT(149)/2.8736248735546 E-01/, WT(149)/6.2039423159893 E-02/
- DATA XT(150)/2.24763790394689E-01/, WT(150)/6.3114192286254 E-02/
- DATA XT(151)/1.61222356068892E-01/, WT(151)/6.3924238584648 E-02/
- DATA XT(152)/9.7004699209463 E-02/, WT(152)/6.4466164435950 E-02/
- DATA XT(153)/3.2380170962869 E-02/, WT(153)/6.4737696812684 E-02/
-C N=64.
- DATA XT(154)/9.9930504173577 E-01/, WT(154)/1.78328072169643E-03/
- DATA XT(155)/9.9634011677196 E-01/, WT(155)/4.1470332605625 E-03/
- DATA XT(156)/9.9101337147674 E-01/, WT(156)/6.5044579689784 E-03/
- DATA XT(157)/9.8333625388463 E-01/, WT(157)/8.8467598263639 E-03/
- DATA XT(158)/9.7332682778991 E-01/, WT(158)/1.11681394601311E-02/
- DATA XT(159)/9.6100879965205 E-01/, WT(159)/1.34630478967186E-02/
- DATA XT(160)/9.4641137485840 E-01/, WT(160)/1.57260304760247E-02/
- DATA XT(161)/9.2956917213194 E-01/, WT(161)/1.79517157756973E-02/
- DATA XT(162)/9.1052213707850 E-01/, WT(162)/2.01348231535302E-02/
- DATA XT(163)/8.8931544599511 E-01/, WT(163)/2.22701738083833E-02/
- DATA XT(164)/8.6599939815409 E-01/, WT(164)/2.43527025687109E-02/
- DATA XT(165)/8.4062929625258 E-01/, WT(165)/2.63774697150547E-02/
- DATA XT(166)/8.1326531512280 E-01/, WT(166)/2.8339672614259 E-02/
- DATA XT(167)/7.8397235894334 E-01/, WT(167)/3.0234657072402 E-02/
- DATA XT(168)/7.5281990726053 E-01/, WT(168)/3.2057928354852 E-02/
- DATA XT(169)/7.1988185017161 E-01/, WT(169)/3.3805161837142 E-02/
- DATA XT(170)/6.8523631305423 E-01/, WT(170)/3.5472213256882 E-02/
- DATA XT(171)/6.4896547125466 E-01/, WT(171)/3.7055128540240 E-02/
- DATA XT(172)/6.1115535517239 E-01/, WT(172)/3.8550153178616 E-02/
- DATA XT(173)/5.7189564620263 E-01/, WT(173)/3.9953741132720 E-02/
- DATA XT(174)/5.3127946401989 E-01/, WT(174)/4.1262563242624 E-02/
- DATA XT(175)/4.8940314570705 E-01/, WT(175)/4.2473515123654 E-02/
- DATA XT(176)/4.4636601725346 E-01/, WT(176)/4.3583724529323 E-02/
- DATA XT(177)/4.0227015796399 E-01/, WT(177)/4.4590558163757 E-02/
- DATA XT(178)/3.5722015833767 E-01/, WT(178)/4.5491627927418 E-02/
- DATA XT(179)/3.1132287199021 E-01/, WT(179)/4.6284796581314 E-02/
- DATA XT(180)/2.64687162208767E-01/, WT(180)/4.6968182816210 E-02/
- DATA XT(181)/2.17423643740007E-01/, WT(181)/4.7540165714830 E-02/
- DATA XT(182)/1.69644420423993E-01/, WT(182)/4.7999388596458 E-02/
- DATA XT(183)/1.21462819296121E-01/, WT(183)/4.8344762234803 E-02/
- DATA XT(184)/7.2993121787799 E-02/, WT(184)/4.8575467441503 E-02/
- DATA XT(185)/2.43502926634244E-02/, WT(185)/4.8690957009140 E-02/
-C N=80.
- DATA XT(186)/9.9955382265163 E-01/, WT(186)/1.14495000318694E-03/
- DATA XT(187)/9.9764986439824 E-01/, WT(187)/2.66353358951268E-03/
- DATA XT(188)/9.9422754096569 E-01/, WT(188)/4.1803131246949 E-03/
- DATA XT(189)/9.8929130249976 E-01/, WT(189)/5.6909224514032 E-03/
- DATA XT(190)/9.8284857273863 E-01/, WT(190)/7.1929047681173 E-03/
- DATA XT(191)/9.7490914058573 E-01/, WT(191)/8.6839452692609 E-03/
- DATA XT(192)/9.6548508904380 E-01/, WT(192)/1.01617660411031E-02/
- DATA XT(193)/9.5459076634363 E-01/, WT(193)/1.16241141207978E-02/
- DATA XT(194)/9.4224276130987 E-01/, WT(194)/1.30687615924013E-02/
- DATA XT(195)/9.2845987717245 E-01/, WT(195)/1.44935080405091E-02/
- DATA XT(196)/9.1326310257176 E-01/, WT(196)/1.58961835837257E-02/
- DATA XT(197)/8.9667557943877 E-01/, WT(197)/1.72746520562693E-02/
- DATA XT(198)/8.7872256767821 E-01/, WT(198)/1.86268142082990E-02/
- DATA XT(199)/8.5943140666311 E-01/, WT(199)/1.99506108781420E-02/
- DATA XT(200)/8.3883147358026 E-01/, WT(200)/2.12440261157821E-02/
- DATA XT(201)/8.1695413868146 E-01/, WT(201)/2.25050902463325E-02/
- DATA XT(202)/7.9383271750461 E-01/, WT(202)/2.37318828659301E-02/
- DATA XT(203)/7.6950242013504 E-01/, WT(203)/2.49225357641155E-02/
- DATA XT(204)/7.4400029758360 E-01/, WT(204)/2.60752357675651E-02/
- DATA XT(205)/7.1736518536210 E-01/, WT(205)/2.71882275004864E-02/
- DATA XT(206)/6.8963764434203 E-01/, WT(206)/2.8259816057277 E-02/
- DATA XT(207)/6.6085989898612 E-01/, WT(207)/2.9288369583268 E-02/
- DATA XT(208)/6.3107577304687 E-01/, WT(208)/3.0272321759558 E-02/
- DATA XT(209)/6.0033062282975 E-01/, WT(209)/3.1210174188115 E-02/
- DATA XT(210)/5.6867126812271 E-01/, WT(210)/3.2100498673488 E-02/
- DATA XT(211)/5.3614592089713 E-01/, WT(211)/3.2941939397645 E-02/
- DATA XT(212)/5.0280411188878 E-01/, WT(212)/3.3733214984612 E-02/
- DATA XT(213)/4.6869661517054 E-01/, WT(213)/3.4473120451754 E-02/
- DATA XT(214)/4.3387537083176 E-01/, WT(214)/3.5160529044748 E-02/
- DATA XT(215)/3.9839340588197 E-01/, WT(215)/3.5794393953416 E-02/
- DATA XT(216)/3.6230475349949 E-01/, WT(216)/3.6373749905836 E-02/
- DATA XT(217)/3.2566437074770 E-01/, WT(217)/3.6897714638276 E-02/
- DATA XT(218)/2.8852805488451 E-01/, WT(218)/3.7365490238730 E-02/
- DATA XT(219)/2.50952358392272E-01/, WT(219)/3.7776364362001 E-02/
- DATA XT(220)/2.12994502857666E-01/, WT(220)/3.8129711314478 E-02/
- DATA XT(221)/1.74712291832647E-01/, WT(221)/3.8424993006959 E-02/
- DATA XT(222)/1.36164022809144E-01/, WT(222)/3.8661759774076 E-02/
- DATA XT(223)/9.7408398441585 E-02/, WT(223)/3.8839651059052 E-02/
- DATA XT(224)/5.8504437152421 E-02/, WT(224)/3.8958395962770 E-02/
- DATA XT(225)/1.95113832567940E-02/, WT(225)/3.9017813656307 E-02/
-C N=96.
- DATA XT(226)/9.9968950388323 E-01/, WT(226)/7.9679206555201 E-04/
- DATA XT(227)/9.9836437586318 E-01/, WT(227)/1.85396078894692E-03/
- DATA XT(228)/9.9598184298721 E-01/, WT(228)/2.9107318179349 E-03/
- DATA XT(229)/9.9254390032376 E-01/, WT(229)/3.9645543384447 E-03/
- DATA XT(230)/9.8805412632962 E-01/, WT(230)/5.0142027429275 E-03/
- DATA XT(231)/9.8251726356301 E-01/, WT(231)/6.0585455042360 E-03/
- DATA XT(232)/9.7593917458514 E-01/, WT(232)/7.0964707911539 E-03/
- DATA XT(233)/9.6832682846326 E-01/, WT(233)/8.1268769256988 E-03/
- DATA XT(234)/9.5968829144874 E-01/, WT(234)/9.1486712307834 E-03/
- DATA XT(235)/9.5003271778444 E-01/, WT(235)/1.01607705350084E-02/
- DATA XT(236)/9.3937033975276 E-01/, WT(236)/1.11621020998385E-02/
- DATA XT(237)/9.2771245672231 E-01/, WT(237)/1.21516046710883E-02/
- DATA XT(238)/9.1507142312090 E-01/, WT(238)/1.31282295669616E-02/
- DATA XT(239)/9.0146063531585 E-01/, WT(239)/1.40909417723149E-02/
- DATA XT(240)/8.8689451740242 E-01/, WT(240)/1.50387210269949E-02/
- DATA XT(241)/8.7138850590930 E-01/, WT(241)/1.59705629025623E-02/
- DATA XT(242)/8.5495903343460 E-01/, WT(242)/1.68854798642452E-02/
- DATA XT(243)/8.3762351122819 E-01/, WT(243)/1.77825023160453E-02/
- DATA XT(244)/8.1940031073793 E-01/, WT(244)/1.86606796274115E-02/
- DATA XT(245)/8.0030874413914 E-01/, WT(245)/1.95190811401450E-02/
- DATA XT(246)/7.8036904386743 E-01/, WT(246)/2.03567971543333E-02/
- DATA XT(247)/7.5960234117665 E-01/, WT(247)/2.11729398921913E-02/
- DATA XT(248)/7.3803064374440 E-01/, WT(248)/2.19666444387443E-02/
- DATA XT(249)/7.1567681234897 E-01/, WT(249)/2.27370696583294E-02/
- DATA XT(250)/6.9256453664217 E-01/, WT(250)/2.34833990859262E-02/
- DATA XT(251)/6.6871831004392 E-01/, WT(251)/2.42048417923647E-02/
- DATA XT(252)/6.4416340378497 E-01/, WT(252)/2.49006332224836E-02/
- DATA XT(253)/6.1892584012547 E-01/, WT(253)/2.55700360053494E-02/
- DATA XT(254)/5.9303236477757 E-01/, WT(254)/2.62123407356724E-02/
- DATA XT(255)/5.6651041856140 E-01/, WT(255)/2.68268667255918E-02/
- DATA XT(256)/5.3938810832436 E-01/, WT(256)/2.74129627260292E-02/
- DATA XT(257)/5.1169417715467 E-01/, WT(257)/2.79700076168483E-02/
- DATA XT(258)/4.8345797392060 E-01/, WT(258)/2.8497411065085 E-02/
- DATA XT(259)/4.5470942216774 E-01/, WT(259)/2.8994614150555 E-02/
- DATA XT(260)/4.2547898840730 E-01/, WT(260)/2.9461089958168 E-02/
- DATA XT(261)/3.9579764982891 E-01/, WT(261)/2.9896344136328 E-02/
- DATA XT(262)/3.6569686147231 E-01/, WT(262)/3.0299915420828 E-02/
- DATA XT(263)/3.3520852289263 E-01/, WT(263)/3.0671376123669 E-02/
- DATA XT(264)/3.0436494435450 E-01/, WT(264)/3.1010332586314 E-02/
- DATA XT(265)/2.73198812591049E-01/, WT(265)/3.1316425596861 E-02/
- DATA XT(266)/2.41743156163840E-01/, WT(266)/3.1589330770727 E-02/
- DATA XT(267)/2.10031310460567E-01/, WT(267)/3.1828758894411 E-02/
- DATA XT(268)/1.78096882367619E-01/, WT(268)/3.2034456231993 E-02/
- DATA XT(269)/1.45973714654897E-01/, WT(269)/3.2206204794030 E-02/
- DATA XT(270)/1.13695850110666E-01/, WT(270)/3.2343822568576 E-02/
- DATA XT(271)/8.1297495464426 E-02/, WT(271)/3.2447163714064 E-02/
- DATA XT(272)/4.8812985136050 E-02/, WT(272)/3.2516118713869 E-02/
- DATA XT(273)/1.62767448496030E-02/, WT(273)/3.2550614492363 E-02/
-#endif
-#if defined(CERNLIB_NUMLOPRE)
-C N=2.
- DATA XT(1) /5.77350269E-01/, WT(1) /1.00000000E+00/
-C N=3.
- DATA XT(2) /7.74596669E-01/, WT(2) /5.55555556E-01/
- DATA XT(3) /0. /, WT(3) /8.88888889E-01/
-C N=4.
- DATA XT(4) /8.61136312E-01/, WT(4) /3.47854845E-01/
- DATA XT(5) /3.39981044E-01/, WT(5) /6.52145155E-01/
-C N=5.
- DATA XT(6) /9.06179846E-01/, WT(6) /2.36926885E-01/
- DATA XT(7) /5.38469310E-01/, WT(7) /4.78628670E-01/
- DATA XT(8) /0. /, WT(8) /5.68888889E-01/
-C N=6.
- DATA XT(9) /9.32469514E-01/, WT(9) /1.71324492E-01/
- DATA XT(10) /6.61209386E-01/, WT(10) /3.60761573E-01/
- DATA XT(11) /2.38619186E-01/, WT(11) /4.67913935E-01/
-C N=7.
- DATA XT(12) /9.49107912E-01/, WT(12) /1.29484966E-01/
- DATA XT(13) /7.41531186E-01/, WT(13) /2.79705391E-01/
- DATA XT(14) /4.05845151E-01/, WT(14) /3.81830051E-01/
- DATA XT(15) /0. /, WT(15) /4.17959184E-01/
-C N=8.
- DATA XT(16) /9.60289856E-01/, WT(16) /1.01228536E-01/
- DATA XT(17) /7.96666477E-01/, WT(17) /2.22381034E-01/
- DATA XT(18) /5.25532410E-01/, WT(18) /3.13706646E-01/
- DATA XT(19) /1.83434642E-01/, WT(19) /3.62683783E-01/
-C N=9.
- DATA XT(20) /9.68160240E-01/, WT(20) /8.12743884E-02/
- DATA XT(21) /8.36031107E-01/, WT(21) /1.80648161E-01/
- DATA XT(22) /6.13371433E-01/, WT(22) /2.60610696E-01/
- DATA XT(23) /3.24253423E-01/, WT(23) /3.12347077E-01/
- DATA XT(24) /0. /, WT(24) /3.30239355E-01/
-C N=10.
- DATA XT(25) /9.73906529E-01/, WT(25) /6.66713443E-02/
- DATA XT(26) /8.65063367E-01/, WT(26) /1.49451349E-01/
- DATA XT(27) /6.79409568E-01/, WT(27) /2.19086363E-01/
- DATA XT(28) /4.33395394E-01/, WT(28) /2.69266719E-01/
- DATA XT(29) /1.48874339E-01/, WT(29) /2.95524225E-01/
-C N=11.
- DATA XT(30) /9.78228658E-01/, WT(30) /5.56685671E-02/
- DATA XT(31) /8.87062600E-01/, WT(31) /1.25580369E-01/
- DATA XT(32) /7.30152006E-01/, WT(32) /1.86290211E-01/
- DATA XT(33) /5.19096129E-01/, WT(33) /2.33193765E-01/
- DATA XT(34) /2.69543156E-01/, WT(34) /2.62804545E-01/
- DATA XT(35) /0. /, WT(35) /2.72925087E-01/
-C N=12.
- DATA XT(36) /9.81560634E-01/, WT(36) /4.71753364E-02/
- DATA XT(37) /9.04117256E-01/, WT(37) /1.06939326E-01/
- DATA XT(38) /7.69902674E-01/, WT(38) /1.60078329E-01/
- DATA XT(39) /5.87317954E-01/, WT(39) /2.03167427E-01/
- DATA XT(40) /3.67831499E-01/, WT(40) /2.33492537E-01/
- DATA XT(41) /1.25233409E-01/, WT(41) /2.49147046E-01/
-C N=13.
- DATA XT(42) /9.84183055E-01/, WT(42) /4.04840048E-02/
- DATA XT(43) /9.17598399E-01/, WT(43) /9.21214998E-02/
- DATA XT(44) /8.01578091E-01/, WT(44) /1.38873510E-01/
- DATA XT(45) /6.42349339E-01/, WT(45) /1.78145981E-01/
- DATA XT(46) /4.48492751E-01/, WT(46) /2.07816048E-01/
- DATA XT(47) /2.30458316E-01/, WT(47) /2.26283180E-01/
- DATA XT(48) /0. /, WT(48) /2.32551553E-01/
-C N=14.
- DATA XT(49) /9.86283809E-01/, WT(49) /3.51194603E-02/
- DATA XT(50) /9.28434884E-01/, WT(50) /8.01580872E-02/
- DATA XT(51) /8.27201315E-01/, WT(51) /1.21518571E-01/
- DATA XT(52) /6.87292905E-01/, WT(52) /1.57203167E-01/
- DATA XT(53) /5.15248636E-01/, WT(53) /1.85538397E-01/
- DATA XT(54) /3.19112369E-01/, WT(54) /2.05198464E-01/
- DATA XT(55) /1.08054949E-01/, WT(55) /2.15263853E-01/
-C N=15.
- DATA XT(56) /9.87992518E-01/, WT(56) /3.07532420E-02/
- DATA XT(57) /9.37273392E-01/, WT(57) /7.03660475E-02/
- DATA XT(58) /8.48206583E-01/, WT(58) /1.07159220E-01/
- DATA XT(59) /7.24417731E-01/, WT(59) /1.39570678E-01/
- DATA XT(60) /5.70972173E-01/, WT(60) /1.66269206E-01/
- DATA XT(61) /3.94151347E-01/, WT(61) /1.86161000E-01/
- DATA XT(62) /2.01194094E-01/, WT(62) /1.98431485E-01/
- DATA XT(63) /0. /, WT(63) /2.02578242E-01/
-C N=16.
- DATA XT(64) /9.89400935E-01/, WT(64) /2.71524594E-02/
- DATA XT(65) /9.44575023E-01/, WT(65) /6.22535239E-02/
- DATA XT(66) /8.65631202E-01/, WT(66) /9.51585117E-02/
- DATA XT(67) /7.55404408E-01/, WT(67) /1.24628971E-01/
- DATA XT(68) /6.17876244E-01/, WT(68) /1.49595989E-01/
- DATA XT(69) /4.58016778E-01/, WT(69) /1.69156519E-01/
- DATA XT(70) /2.81603551E-01/, WT(70) /1.82603415E-01/
- DATA XT(71) /9.50125098E-02/, WT(71) /1.89450610E-01/
-C N=20.
- DATA XT(72) /9.93128599E-01/, WT(72) /1.76140071E-02/
- DATA XT(73) /9.63971927E-01/, WT(73) /4.06014298E-02/
- DATA XT(74) /9.12234428E-01/, WT(74) /6.26720483E-02/
- DATA XT(75) /8.39116972E-01/, WT(75) /8.32767416E-02/
- DATA XT(76) /7.46331906E-01/, WT(76) /1.01930120E-01/
- DATA XT(77) /6.36053681E-01/, WT(77) /1.18194532E-01/
- DATA XT(78) /5.10867002E-01/, WT(78) /1.31688638E-01/
- DATA XT(79) /3.73706089E-01/, WT(79) /1.42096109E-01/
- DATA XT(80) /2.27785851E-01/, WT(80) /1.49172986E-01/
- DATA XT(81) /7.65265211E-02/, WT(81) /1.52753387E-01/
-C N=24.
- DATA XT(82) /9.95187220E-01/, WT(82) /1.23412298E-02/
- DATA XT(83) /9.74728556E-01/, WT(83) /2.85313886E-02/
- DATA XT(84) /9.38274552E-01/, WT(84) /4.42774388E-02/
- DATA XT(85) /8.86415527E-01/, WT(85) /5.92985849E-02/
- DATA XT(86) /8.20001986E-01/, WT(86) /7.33464814E-02/
- DATA XT(87) /7.40124192E-01/, WT(87) /8.61901615E-02/
- DATA XT(88) /6.48093652E-01/, WT(88) /9.76186521E-02/
- DATA XT(89) /5.45421471E-01/, WT(89) /1.07444270E-01/
- DATA XT(90) /4.33793508E-01/, WT(90) /1.15505668E-01/
- DATA XT(91) /3.15042680E-01/, WT(91) /1.21670473E-01/
- DATA XT(92) /1.91118867E-01/, WT(92) /1.25837456E-01/
- DATA XT(93) /6.40568929E-02/, WT(93) /1.27938195E-01/
-C N=32.
- DATA XT(94) /9.97263862E-01/, WT(94) /7.01861001E-03/
- DATA XT(95) /9.85611512E-01/, WT(95) /1.62743947E-02/
- DATA XT(96) /9.64762256E-01/, WT(96) /2.53920653E-02/
- DATA XT(97) /9.34906076E-01/, WT(97) /3.42738629E-02/
- DATA XT(98) /8.96321156E-01/, WT(98) /4.28358980E-02/
- DATA XT(99) /8.49367614E-01/, WT(99) /5.09980593E-02/
- DATA XT(100)/7.94483796E-01/, WT(100)/5.86840935E-02/
- DATA XT(101)/7.32182119E-01/, WT(101)/6.58222228E-02/
- DATA XT(102)/6.63044267E-01/, WT(102)/7.23457941E-02/
- DATA XT(103)/5.87715757E-01/, WT(103)/7.81938958E-02/
- DATA XT(104)/5.06899909E-01/, WT(104)/8.33119242E-02/
- DATA XT(105)/4.21351276E-01/, WT(105)/8.76520930E-02/
- DATA XT(106)/3.31868602E-01/, WT(106)/9.11738787E-02/
- DATA XT(107)/2.39287362E-01/, WT(107)/9.38443991E-02/
- DATA XT(108)/1.44471962E-01/, WT(108)/9.56387201E-02/
- DATA XT(109)/4.83076657E-02/, WT(109)/9.65400885E-02/
-C N=40.
- DATA XT(110)/9.98237710E-01/, WT(110)/4.52127710E-03/
- DATA XT(111)/9.90726239E-01/, WT(111)/1.04982845E-02/
- DATA XT(112)/9.77259950E-01/, WT(112)/1.64210584E-02/
- DATA XT(113)/9.57916819E-01/, WT(113)/2.22458492E-02/
- DATA XT(114)/9.32812808E-01/, WT(114)/2.79370070E-02/
- DATA XT(115)/9.02098807E-01/, WT(115)/3.34601953E-02/
- DATA XT(116)/8.65959503E-01/, WT(116)/3.87821680E-02/
- DATA XT(117)/8.24612231E-01/, WT(117)/4.38709082E-02/
- DATA XT(118)/7.78305651E-01/, WT(118)/4.86958076E-02/
- DATA XT(119)/7.27318255E-01/, WT(119)/5.32278470E-02/
- DATA XT(120)/6.71956685E-01/, WT(120)/5.74397691E-02/
- DATA XT(121)/6.12553890E-01/, WT(121)/6.13062425E-02/
- DATA XT(122)/5.49467125E-01/, WT(122)/6.48040135E-02/
- DATA XT(123)/4.83075802E-01/, WT(123)/6.79120458E-02/
- DATA XT(124)/4.13779204E-01/, WT(124)/7.06116474E-02/
- DATA XT(125)/3.41994091E-01/, WT(125)/7.28865824E-02/
- DATA XT(126)/2.68152185E-01/, WT(126)/7.47231691E-02/
- DATA XT(127)/1.92697581E-01/, WT(127)/7.61103619E-02/
- DATA XT(128)/1.16084071E-01/, WT(128)/7.70398182E-02/
- DATA XT(129)/3.87724175E-02/, WT(129)/7.75059480E-02/
-C N=48.
- DATA XT(130)/9.98771007E-01/, WT(130)/3.15334605E-03/
- DATA XT(131)/9.93530172E-01/, WT(131)/7.32755390E-03/
- DATA XT(132)/9.84124584E-01/, WT(132)/1.14772346E-02/
- DATA XT(133)/9.70591593E-01/, WT(133)/1.55793157E-02/
- DATA XT(134)/9.52987703E-01/, WT(134)/1.96161605E-02/
- DATA XT(135)/9.31386691E-01/, WT(135)/2.35707608E-02/
- DATA XT(136)/9.05879137E-01/, WT(136)/2.74265097E-02/
- DATA XT(137)/8.76572020E-01/, WT(137)/3.11672278E-02/
- DATA XT(138)/8.43588262E-01/, WT(138)/3.47772226E-02/
- DATA XT(139)/8.07066204E-01/, WT(139)/3.82413511E-02/
- DATA XT(140)/7.67159033E-01/, WT(140)/4.15450829E-02/
- DATA XT(141)/7.24034131E-01/, WT(141)/4.46745609E-02/
- DATA XT(142)/6.77872380E-01/, WT(142)/4.76166585E-02/
- DATA XT(143)/6.28867397E-01/, WT(143)/5.03590356E-02/
- DATA XT(144)/5.77224726E-01/, WT(144)/5.28901895E-02/
- DATA XT(145)/5.23160975E-01/, WT(145)/5.51995037E-02/
- DATA XT(146)/4.66902905E-01/, WT(146)/5.72772921E-02/
- DATA XT(147)/4.08686482E-01/, WT(147)/5.91148397E-02/
- DATA XT(148)/3.48755886E-01/, WT(148)/6.07044392E-02/
- DATA XT(149)/2.87362487E-01/, WT(149)/6.20394232E-02/
- DATA XT(150)/2.24763790E-01/, WT(150)/6.31141923E-02/
- DATA XT(151)/1.61222356E-01/, WT(151)/6.39242386E-02/
- DATA XT(152)/9.70046992E-02/, WT(152)/6.44661644E-02/
- DATA XT(153)/3.23801710E-02/, WT(153)/6.47376968E-02/
-C N=64.
- DATA XT(154)/9.99305042E-01/, WT(154)/1.78328072E-03/
- DATA XT(155)/9.96340117E-01/, WT(155)/4.14703326E-03/
- DATA XT(156)/9.91013371E-01/, WT(156)/6.50445797E-03/
- DATA XT(157)/9.83336254E-01/, WT(157)/8.84675983E-03/
- DATA XT(158)/9.73326828E-01/, WT(158)/1.11681395E-02/
- DATA XT(159)/9.61008800E-01/, WT(159)/1.34630479E-02/
- DATA XT(160)/9.46411375E-01/, WT(160)/1.57260305E-02/
- DATA XT(161)/9.29569172E-01/, WT(161)/1.79517158E-02/
- DATA XT(162)/9.10522137E-01/, WT(162)/2.01348232E-02/
- DATA XT(163)/8.89315446E-01/, WT(163)/2.22701738E-02/
- DATA XT(164)/8.65999398E-01/, WT(164)/2.43527026E-02/
- DATA XT(165)/8.40629296E-01/, WT(165)/2.63774697E-02/
- DATA XT(166)/8.13265315E-01/, WT(166)/2.83396726E-02/
- DATA XT(167)/7.83972359E-01/, WT(167)/3.02346571E-02/
- DATA XT(168)/7.52819907E-01/, WT(168)/3.20579284E-02/
- DATA XT(169)/7.19881850E-01/, WT(169)/3.38051618E-02/
- DATA XT(170)/6.85236313E-01/, WT(170)/3.54722133E-02/
- DATA XT(171)/6.48965471E-01/, WT(171)/3.70551285E-02/
- DATA XT(172)/6.11155355E-01/, WT(172)/3.85501532E-02/
- DATA XT(173)/5.71895646E-01/, WT(173)/3.99537411E-02/
- DATA XT(174)/5.31279464E-01/, WT(174)/4.12625632E-02/
- DATA XT(175)/4.89403146E-01/, WT(175)/4.24735151E-02/
- DATA XT(176)/4.46366017E-01/, WT(176)/4.35837245E-02/
- DATA XT(177)/4.02270158E-01/, WT(177)/4.45905582E-02/
- DATA XT(178)/3.57220158E-01/, WT(178)/4.54916279E-02/
- DATA XT(179)/3.11322872E-01/, WT(179)/4.62847966E-02/
- DATA XT(180)/2.64687162E-01/, WT(180)/4.69681828E-02/
- DATA XT(181)/2.17423644E-01/, WT(181)/4.75401657E-02/
- DATA XT(182)/1.69644420E-01/, WT(182)/4.79993886E-02/
- DATA XT(183)/1.21462819E-01/, WT(183)/4.83447622E-02/
- DATA XT(184)/7.29931218E-02/, WT(184)/4.85754674E-02/
- DATA XT(185)/2.43502927E-02/, WT(185)/4.86909570E-02/
-C N=80.
- DATA XT(186)/9.99553823E-01/, WT(186)/1.14495000E-03/
- DATA XT(187)/9.97649864E-01/, WT(187)/2.66353359E-03/
- DATA XT(188)/9.94227541E-01/, WT(188)/4.18031312E-03/
- DATA XT(189)/9.89291302E-01/, WT(189)/5.69092245E-03/
- DATA XT(190)/9.82848573E-01/, WT(190)/7.19290477E-03/
- DATA XT(191)/9.74909141E-01/, WT(191)/8.68394527E-03/
- DATA XT(192)/9.65485089E-01/, WT(192)/1.01617660E-02/
- DATA XT(193)/9.54590766E-01/, WT(193)/1.16241141E-02/
- DATA XT(194)/9.42242761E-01/, WT(194)/1.30687616E-02/
- DATA XT(195)/9.28459877E-01/, WT(195)/1.44935080E-02/
- DATA XT(196)/9.13263103E-01/, WT(196)/1.58961836E-02/
- DATA XT(197)/8.96675579E-01/, WT(197)/1.72746521E-02/
- DATA XT(198)/8.78722568E-01/, WT(198)/1.86268142E-02/
- DATA XT(199)/8.59431407E-01/, WT(199)/1.99506109E-02/
- DATA XT(200)/8.38831474E-01/, WT(200)/2.12440261E-02/
- DATA XT(201)/8.16954139E-01/, WT(201)/2.25050902E-02/
- DATA XT(202)/7.93832718E-01/, WT(202)/2.37318829E-02/
- DATA XT(203)/7.69502420E-01/, WT(203)/2.49225358E-02/
- DATA XT(204)/7.44000298E-01/, WT(204)/2.60752358E-02/
- DATA XT(205)/7.17365185E-01/, WT(205)/2.71882275E-02/
- DATA XT(206)/6.89637644E-01/, WT(206)/2.82598161E-02/
- DATA XT(207)/6.60859899E-01/, WT(207)/2.92883696E-02/
- DATA XT(208)/6.31075773E-01/, WT(208)/3.02723218E-02/
- DATA XT(209)/6.00330623E-01/, WT(209)/3.12101742E-02/
- DATA XT(210)/5.68671268E-01/, WT(210)/3.21004987E-02/
- DATA XT(211)/5.36145921E-01/, WT(211)/3.29419394E-02/
- DATA XT(212)/5.02804112E-01/, WT(212)/3.37332150E-02/
- DATA XT(213)/4.68696615E-01/, WT(213)/3.44731205E-02/
- DATA XT(214)/4.33875371E-01/, WT(214)/3.51605290E-02/
- DATA XT(215)/3.98393406E-01/, WT(215)/3.57943940E-02/
- DATA XT(216)/3.62304753E-01/, WT(216)/3.63737499E-02/
- DATA XT(217)/3.25664371E-01/, WT(217)/3.68977146E-02/
- DATA XT(218)/2.88528055E-01/, WT(218)/3.73654902E-02/
- DATA XT(219)/2.50952358E-01/, WT(219)/3.77763644E-02/
- DATA XT(220)/2.12994503E-01/, WT(220)/3.81297113E-02/
- DATA XT(221)/1.74712292E-01/, WT(221)/3.84249930E-02/
- DATA XT(222)/1.36164023E-01/, WT(222)/3.86617598E-02/
- DATA XT(223)/9.74083984E-02/, WT(223)/3.88396511E-02/
- DATA XT(224)/5.85044372E-02/, WT(224)/3.89583960E-02/
- DATA XT(225)/1.95113833E-02/, WT(225)/3.90178137E-02/
-C N=96.
- DATA XT(226)/9.99689504E-01/, WT(226)/7.96792066E-04/
- DATA XT(227)/9.98364376E-01/, WT(227)/1.85396079E-03/
- DATA XT(228)/9.95981843E-01/, WT(228)/2.91073182E-03/
- DATA XT(229)/9.92543900E-01/, WT(229)/3.96455434E-03/
- DATA XT(230)/9.88054126E-01/, WT(230)/5.01420274E-03/
- DATA XT(231)/9.82517264E-01/, WT(231)/6.05854550E-03/
- DATA XT(232)/9.75939175E-01/, WT(232)/7.09647079E-03/
- DATA XT(233)/9.68326828E-01/, WT(233)/8.12687693E-03/
- DATA XT(234)/9.59688291E-01/, WT(234)/9.14867123E-03/
- DATA XT(235)/9.50032718E-01/, WT(235)/1.01607705E-02/
- DATA XT(236)/9.39370340E-01/, WT(236)/1.11621021E-02/
- DATA XT(237)/9.27712457E-01/, WT(237)/1.21516047E-02/
- DATA XT(238)/9.15071423E-01/, WT(238)/1.31282296E-02/
- DATA XT(239)/9.01460635E-01/, WT(239)/1.40909418E-02/
- DATA XT(240)/8.86894517E-01/, WT(240)/1.50387210E-02/
- DATA XT(241)/8.71388506E-01/, WT(241)/1.59705629E-02/
- DATA XT(242)/8.54959033E-01/, WT(242)/1.68854799E-02/
- DATA XT(243)/8.37623511E-01/, WT(243)/1.77825023E-02/
- DATA XT(244)/8.19400311E-01/, WT(244)/1.86606796E-02/
- DATA XT(245)/8.00308744E-01/, WT(245)/1.95190811E-02/
- DATA XT(246)/7.80369044E-01/, WT(246)/2.03567972E-02/
- DATA XT(247)/7.59602341E-01/, WT(247)/2.11729399E-02/
- DATA XT(248)/7.38030644E-01/, WT(248)/2.19666444E-02/
- DATA XT(249)/7.15676812E-01/, WT(249)/2.27370697E-02/
- DATA XT(250)/6.92564537E-01/, WT(250)/2.34833991E-02/
- DATA XT(251)/6.68718310E-01/, WT(251)/2.42048418E-02/
- DATA XT(252)/6.44163404E-01/, WT(252)/2.49006332E-02/
- DATA XT(253)/6.18925840E-01/, WT(253)/2.55700360E-02/
- DATA XT(254)/5.93032365E-01/, WT(254)/2.62123407E-02/
- DATA XT(255)/5.66510419E-01/, WT(255)/2.68268667E-02/
- DATA XT(256)/5.39388108E-01/, WT(256)/2.74129627E-02/
- DATA XT(257)/5.11694177E-01/, WT(257)/2.79700076E-02/
- DATA XT(258)/4.83457974E-01/, WT(258)/2.84974111E-02/
- DATA XT(259)/4.54709422E-01/, WT(259)/2.89946142E-02/
- DATA XT(260)/4.25478988E-01/, WT(260)/2.94610900E-02/
- DATA XT(261)/3.95797650E-01/, WT(261)/2.98963441E-02/
- DATA XT(262)/3.65696861E-01/, WT(262)/3.02999154E-02/
- DATA XT(263)/3.35208523E-01/, WT(263)/3.06713761E-02/
- DATA XT(264)/3.04364944E-01/, WT(264)/3.10103326E-02/
- DATA XT(265)/2.73198813E-01/, WT(265)/3.13164256E-02/
- DATA XT(266)/2.41743156E-01/, WT(266)/3.15893308E-02/
- DATA XT(267)/2.10031310E-01/, WT(267)/3.18287589E-02/
- DATA XT(268)/1.78096882E-01/, WT(268)/3.20344562E-02/
- DATA XT(269)/1.45973715E-01/, WT(269)/3.22062048E-02/
- DATA XT(270)/1.13695850E-01/, WT(270)/3.23438226E-02/
- DATA XT(271)/8.12974955E-02/, WT(271)/3.24471637E-02/
- DATA XT(272)/4.88129851E-02/, WT(272)/3.25161187E-02/
- DATA XT(273)/1.62767448E-02/, WT(273)/3.25506145E-02/
-#endif
-C
- DATA NW/2/, K/1/, JMAX/1/, JMID/0/
-C
-C ******************************************************************
-C
-C START. IF N HAS CHANGED VALUE, SET K TO INITIAL SUBSCRIPT OF ARRAYS
-C XT AND WT.
-C
- IF(N.EQ.NW) GO TO 2
- NWSAVE=NW
- NW=N
- IF(NW.LT.2) GO TO 100
- L=NW
- IF(NW.LE.16) GO TO 1
- L=(NW/4)+12
- IF(NW.EQ.20) GO TO 1
- IF(NW.EQ.24) GO TO 1
- IF(NW.EQ.32) GO TO 1
- IF(NW.EQ.40) GO TO 1
- IF(NW.EQ.48) GO TO 1
- IF(NW.EQ.64) GO TO 1
- IF(NW.EQ.80) GO TO 1
- IF(NW.EQ.96) GO TO 1
- GO TO 100
-C
- 1 K=KTAB(L)
- M=NW/2
- JMAX=K+M-1
- JMID=0
- IF(NW-M-M.NE.0) JMID=K+M
-C
- 2 ALPHA=0.5*(B+A)
- BETA=0.5*(B-A)
- IF(MODE.EQ.2) GO TO 4
-C
-C (MODE=1. EVALUATE QUDRATURE SUM.)
-C
- SUM=0.
- DO 3 J=K,JMAX
- DELTA=BETA*XT(J)
- SUM=SUM+WT(J)*(F(ALPHA+DELTA)+F(ALPHA-DELTA))
- 3 CONTINUE
- IF(JMID.NE.0) SUM=SUM+WT(JMID)*F(ALPHA)
- X(1)=BETA*SUM
- RETURN
-C
-C (MODE=2. SET ARRAYS X AND W.)
-C
- 4 JLAST=(NW+1)/2
- DO 5 J=1,JLAST
- JTAB=K-1+J
- WTEMP=BETA*WT(JTAB)
- DELTA=BETA*XT(JTAB)
- X(J)=ALPHA-DELTA
- W(J)=WTEMP
- JP=NW+1-J
- X(JP)=ALPHA+DELTA
- W(JP)=WTEMP
- 5 CONTINUE
- RETURN
-C
-C ERROR MESSAGE FOR NON-PERMISSIBLE N.
-C
- 100 IF(MODE.EQ.1) X(1)=0.
- CALL KERMTR('D106.1',LGFILE,MFLAG,RFLAG)
- IF(MFLAG) THEN
- IF(LGFILE.EQ.0) THEN
- IF(MODE.EQ.1) WRITE(*,2001) N
- IF(MODE.EQ.2) WRITE(*,2002) N
- ELSE
- IF(MODE.EQ.1) WRITE(LGFILE,2001) N
- IF(MODE.EQ.2) WRITE(LGFILE,2002) N
- ENDIF
- ENDIF
- IF(.NOT. RFLAG) CALL ABEND
- NW=NWSAVE
- RETURN
-C
- 2001 FORMAT( 7X, 25HSUBROUTINE GQUAD ... N =, I4,
- * 21H IS NON-PERMISSIBLE. )
- 2002 FORMAT( 7X, 24HSUBROUTINE GSET ... N =, I4,
- * 21H IS NON-PERMISSIBLE. )
- END
diff --git a/src/packlib/kernlib/kernnum/d106fort/gquad.F b/src/packlib/kernlib/kernnum/d106fort/gquad.F
deleted file mode 100644
index e6d12ab..0000000
--- a/src/packlib/kernlib/kernnum/d106fort/gquad.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: gquad.F,v 1.1.1.1 1996/02/15 17:48:47 mclareni Exp $
-*
-* $Log: gquad.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:47 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- FUNCTION GQUAD(F,A,B,N)
- EXTERNAL F
- DIMENSION X(1),W(1)
-C
-C ******************************************************************
-C
-C GQUAD IS SET EQUAL TO THE INTEGRAL OF THE FUNCTION F OVER THE IN-
-C TERVAL (A,B), AS APPROXIMATED BY THE GAUSS-LEGENDRE QUADRATURE
-C FORMULA OF ORDER N.
-C
-C CALLS ... SUBROUTINE D106XX.
-C
-C ******************************************************************
-C
-C START.
- CALL D106XX(1,F,A,B,N,X,W)
- GQUAD=X(1)
- RETURN
- END
diff --git a/src/packlib/kernlib/kernnum/d106fort/gset.F b/src/packlib/kernlib/kernnum/d106fort/gset.F
deleted file mode 100644
index aabe449..0000000
--- a/src/packlib/kernlib/kernnum/d106fort/gset.F
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: gset.F,v 1.1.1.1 1996/02/15 17:48:47 mclareni Exp $
-*
-* $Log: gset.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:47 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE GSET(A,B,N,X,W)
- DIMENSION X(N),W(N)
- EXTERNAL GQUAD
- REAL GQUAD
-C (GQUAD IS HERE USED ONLY AS A DUMMY ARGUMENT FOR D106XX.)
-C
-C ******************************************************************
-C
-C THE ABSCISSAE AND WEIGHTS FOR THE N-POINT GAUSS-LEGENDRE QUADRAT-
-C URE FORMULA CORRESPONDING TO THE INTERVAL (A,B) ARE PLACED IN AR-
-C RAYS X AND W RESPECTIVELY.
-C
-C CALLS ... SUBROUTINE D106XX.
-C
-C ******************************************************************
-C
-C START.
- CALL D106XX(2,GQUAD,A,B,N,X,W)
- RETURN
- END
diff --git a/src/packlib/kernlib/kernnum/d209fort/Imakefile b/src/packlib/kernlib/kernnum/d209fort/Imakefile
deleted file mode 100644
index 0fb0fc1..0000000
--- a/src/packlib/kernlib/kernnum/d209fort/Imakefile
+++ /dev/null
@@ -1,9 +0,0 @@
-SRCS_F= drkstp.F rkstp.F
-
-#if defined(CERNLIB_DECS) && ! defined(CERNLIB_QMVAOS)
-FDEBUGFLAGS=NoOpFortranDebugFlags
-#endif
-
-FORTRANSAVEOPTION=FortranSaveFlags
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kernnum/d209fort/drkstp.F b/src/packlib/kernlib/kernnum/d209fort/drkstp.F
deleted file mode 100644
index b7653cb..0000000
--- a/src/packlib/kernlib/kernnum/d209fort/drkstp.F
+++ /dev/null
@@ -1,72 +0,0 @@
-*
-* $Id: drkstp.F,v 1.1.1.1 1996/02/15 17:48:47 mclareni Exp $
-*
-* $Log: drkstp.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:47 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE DRKSTP(N,H,X,Y,SUB,W)
- DOUBLE PRECISION H,X,Y,W,HLOCAL,H2,H6,XH,XH2
- DIMENSION Y(N),W(N,3)
- LOGICAL MFLAG,RFLAG
- EXTERNAL SUB
-C
-C ******************************************************************
-C
-C (DOUBLE PRECISION VERSION OF RKSTP.)
-C
-C THIS SUBROUTINE REPLACES X BY X+H AND ADVANCES THE SOLUTION OF THE
-C SYSTEM OF DIFFERENTIAL EQUATIONS DY/DX=F(X,Y) FROM Y(X) TO Y(X+H)
-C USING A FIFTH-ORDER RUNGE-KUTTA METHOD.
-C
-C SUB IS THE NAME OF A SUBROUTINE SUB(X,Y,F) WHICH SETS THE VECTOR F
-C TO THE DERIVATIVE AT X OF THE VECTOR Y.
-C
-C W IS A WORKING-SPACE ARRAY, TREATED AS CONSISTING OF THREE CONSEC-
-C UTIVE WORKING VECTORS OF LENGTH N.
-C
-C ******************************************************************
-C
-C START.
- IF (N.LT.1) GO TO 5
- NLOCAL=N
- HLOCAL=H
- H2=0.5D0*HLOCAL
- H6=HLOCAL/6D0
- XH=X+HLOCAL
- XH2=X+H2
- CALL SUB(X,Y,W(1,1))
- DO 1 J=1,NLOCAL
- W(J,2)=Y(J)+H2*W(J,1)
- 1 CONTINUE
- CALL SUB(XH2,W(1,2),W(1,3))
- DO 2 J=1,NLOCAL
- W(J,1)=W(J,1)+2D0*W(J,3)
- W(J,2)=Y(J)+H2*W(J,3)
- 2 CONTINUE
- CALL SUB(XH2,W(1,2),W(1,3))
- DO 3 J=1,NLOCAL
- W(J,1)=W(J,1)+2D0*W(J,3)
- W(J,2)=Y(J)+HLOCAL*W(J,3)
- 3 CONTINUE
- CALL SUB(XH,W(1,2),W(1,3))
- DO 4 J=1,NLOCAL
- Y(J)=Y(J)+H6*(W(J,1)+W(J,3))
- 4 CONTINUE
- X=XH
- RETURN
-C
- 5 CALL KERMTR('D209.1',LGFILE,MFLAG,RFLAG)
- IF(MFLAG) THEN
- IF( LGFILE.EQ.0 ) THEN
- WRITE(*,6) N
- ELSE
- WRITE(LGFILE,6) N
- ENDIF
- ENDIF
- IF(.NOT. RFLAG) CALL ABEND
- RETURN
- 6 FORMAT( 7X, 25HSUBROUTINE DRKSTP ... N =, I6,16H IS LESS THAN 1. )
- END
diff --git a/src/packlib/kernlib/kernnum/d209fort/rkstp.F b/src/packlib/kernlib/kernnum/d209fort/rkstp.F
deleted file mode 100644
index e587dd4..0000000
--- a/src/packlib/kernlib/kernnum/d209fort/rkstp.F
+++ /dev/null
@@ -1,69 +0,0 @@
-*
-* $Id: rkstp.F,v 1.1.1.1 1996/02/15 17:48:47 mclareni Exp $
-*
-* $Log: rkstp.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:47 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE RKSTP(N,H,X,Y,SUB,W)
- DIMENSION Y(N),W(N,3)
- LOGICAL MFLAG,RFLAG
- EXTERNAL SUB
-C
-C ******************************************************************
-C
-C THIS SUBROUTINE REPLACES X BY X+H AND ADVANCES THE SOLUTION OF THE
-C SYSTEM OF DIFFERENTIAL EQUATIONS DY/DX=F(X,Y) FROM Y(X) TO Y(X+H)
-C USING A FIFTH-ORDER RUNGE-KUTTA METHOD.
-C
-C SUB IS THE NAME OF A SUBROUTINE SUB(X,Y,F) WHICH SETS THE VECTOR F
-C TO THE DERIVATIVE AT X OF THE VECTOR Y.
-C
-C W IS A WORKING-SPACE ARRAY, TREATED AS CONSISTING OF THREE CONSEC-
-C UTIVE WORKING VECTORS OF LENGTH N.
-C
-C ******************************************************************
-C
-C START.
- IF (N.LT.1) GO TO 5
- NLOCAL=N
- HLOCAL=H
- H2=0.5*HLOCAL
- H6=HLOCAL/6.
- XH=X+HLOCAL
- XH2=X+H2
- CALL SUB(X,Y,W(1,1))
- DO 1 J=1,NLOCAL
- W(J,2)=Y(J)+H2*W(J,1)
- 1 CONTINUE
- CALL SUB(XH2,W(1,2),W(1,3))
- DO 2 J=1,NLOCAL
- W(J,1)=W(J,1)+2.*W(J,3)
- W(J,2)=Y(J)+H2*W(J,3)
- 2 CONTINUE
- CALL SUB(XH2,W(1,2),W(1,3))
- DO 3 J=1,NLOCAL
- W(J,1)=W(J,1)+2.*W(J,3)
- W(J,2)=Y(J)+HLOCAL*W(J,3)
- 3 CONTINUE
- CALL SUB(XH,W(1,2),W(1,3))
- DO 4 J=1,NLOCAL
- Y(J)=Y(J)+H6*(W(J,1)+W(J,3))
- 4 CONTINUE
- X=XH
- RETURN
-C
- 5 CALL KERMTR('D209.1',LGFILE,MFLAG,RFLAG)
- IF(MFLAG) THEN
- IF( LGFILE.EQ.0 ) THEN
- WRITE(*,6) N
- ELSE
- WRITE(LGFILE,6) N
- ENDIF
- ENDIF
- IF(.NOT. RFLAG) CALL ABEND
- RETURN
- 6 FORMAT( 7X, 24HSUBROUTINE RKSTP ... N =, I6,16H IS LESS THAN 1. )
- END
diff --git a/src/packlib/kernlib/kernnum/d509fort/Imakefile b/src/packlib/kernlib/kernnum/d509fort/Imakefile
deleted file mode 100644
index 35a4968..0000000
--- a/src/packlib/kernlib/kernnum/d509fort/Imakefile
+++ /dev/null
@@ -1,9 +0,0 @@
-SRCS_F= d509hi.F minvar.F
-
-#if defined(CERNLIB_DECS) && ! defined(CERNLIB_QMVAOS)
-FDEBUGFLAGS=NoOpFortranDebugFlags
-#endif
-
-FORTRANSAVEOPTION=FortranSaveFlags
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kernnum/d509fort/d509hi.F b/src/packlib/kernlib/kernnum/d509fort/d509hi.F
deleted file mode 100644
index 40927a0..0000000
--- a/src/packlib/kernlib/kernnum/d509fort/d509hi.F
+++ /dev/null
@@ -1,50 +0,0 @@
-*
-* $Id: d509hi.F,v 1.1.1.1 1996/02/15 17:48:47 mclareni Exp $
-*
-* $Log: d509hi.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:47 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE D509HI(X,Y,X1,Y1,XSTEP,EPSI,M,MAXFUN,F,IS,A,B,Y4,Y5)
- EXTERNAL F
-C
-C IT GIVES A POINT X SUCH THAT Y IS LESS THAN Y1
-C IS=0 NORMAL, IS=1 M.GT.MAXFUN, IS=4 MINIMUM IS FOUND
-C
- ETA=1.
- IS=0
- I=1
- 1 X=X1+XSTEP
- DO 2 J=1,2
- M=M+1
- IF(M.GT.MAXFUN) GO TO 3
-C
-C COMPUTATION OF THE FUNCTION EITHER F, OR FA OR FB
-C
- IF(X-A.GE.0.) GO TO 5
- Y4=F(A,I)
- Y=Y4+A-X
- GO TO 7
- 5 IF(X-B.LE.0.) GO TO 6
- Y5=F(B,I)
- Y=Y5-B+X
- GO TO 7
- 6 Y=F(X,I)
- 7 CONTINUE
-C
-C END OF COMPUTATION OF Y
-C
- IF(Y.LT.Y1) RETURN
- 2 X=X1-XSTEP
- IF(XSTEP.LE.(ABS(X)+ETA)*EPSI) GO TO 4
- XSTEP=0.5*XSTEP
- GO TO 1
- 4 IS=4
- X=X1
- Y=Y1
- RETURN
- 3 IS=1
- RETURN
- END
diff --git a/src/packlib/kernlib/kernnum/d509fort/minvar.F b/src/packlib/kernlib/kernnum/d509fort/minvar.F
deleted file mode 100644
index fc92d4d..0000000
--- a/src/packlib/kernlib/kernnum/d509fort/minvar.F
+++ /dev/null
@@ -1,113 +0,0 @@
-*
-* $Id: minvar.F,v 1.1.1.1 1996/02/15 17:48:47 mclareni Exp $
-*
-* $Log: minvar.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:47 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE MINVAR(X,Y,R,XEPSI,STEP,MAXFUN,A,B,F)
- EXTERNAL F
- LOGICAL MFLAG, RFLAG
-#if defined(CERNLIB_NUMHIPRE)
- DATA TETA/1.E-12/
-#endif
-#if defined(CERNLIB_NUMLOPRE)
- DATA TETA/1.E-5/
-#endif
-C TETA,MACHINE DEPENDENT,IS THE COMPUTER PRECISION TIMES 10**2
-C
-C THE TWO FUNCTIONS FA, FB REPRESENT STRAIGHT LINES WITH SLOPE
-C RESPECTIVELY -1 AND +1 WHICH CONTINUE THE CURVE AT THE LEFT
-C AND AT THE RIGHT OF A AND B
-C
- EPSI=XEPSI
- IF(EPSI.LT.TETA) EPSI=TETA
- BETA=10.
- ETA=1.
-C
-C STARTING POINTS X1, X2, X3 ARE SET SUCH THAT Y1, Y2, Y3 ARE IN STRICT
-C INCREASING ORDER
-C
- XSTEP=STEP
- I=0
- X3=X
- Y3=F(X,I)
- M=1
- CALL D509HI(X2,Y2,X3,Y3,XSTEP,EPSI,M,MAXFUN,F,IS,A,B,Y4,Y5)
- IF(IS.EQ.1) GO TO 3
- Y=Y3
- IF(IS.EQ.4) GO TO 8
- CALL D509HI(X1,Y1,X2,Y2,XSTEP,EPSI,M,MAXFUN,F,IS,A,B,Y4,Y5)
- IF(IS.EQ.1) GO TO 3
- X=X2
- Y=Y2
- IF(IS.EQ.4) GO TO 8
-C
-C IT COMPUTES THE MINIMUM OF THE PARABOLA
-C
- 5 CONTINUE
- IF(ABS((X1-X2)*(X1-X3)).EQ.0.) GO TO 4
- D=(Y1-Y2)/(X1-X2)-(Y1-Y3)/(X1-X3)
- IF(D*(X2-X3).LE.0.) GO TO 4
- X=0.5*(X2+X3-(Y2-Y3)/D)
- IF(ABS(X-X1).GT. STEP*BETA) GO TO 4
- M=M+1
- IF(M.GT.MAXFUN) GO TO 3
-C
-C COMPUTATION OF EITHER F OR FA OR FB.
-C
- IF(X-A.GE.0.) GO TO 7
- Y4=F(A,I)
- Y=Y4+A-X
- GO TO 2
- 7 IF(X-B.LE.0.) GO TO 1
- Y5=F(B,I)
- Y=Y5-B+X
- GO TO 2
- 1 Y=F(X,I)
- 2 CONTINUE
-C
-C END OF COMPUTATION OF Y
-C
- IF(Y.GE.Y1) GO TO 4
- XSTEP=ABS(X-X1)
- IF( XSTEP .LE.(ABS(X)+ETA)*EPSI) GO TO 9
- 6 X3=X2
- Y3=Y2
- X2=X1
- Y2=Y1
- X1=X
- Y1=Y
- GO TO 5
-C
-C WHEN THE MINIMUM OF THE PARABOLA EITHER DOES NOT EXIST OR IS TOO FAR
-C FROM THE LAST MINIMUM, ANOTHER X FOR WHICH F(X) IS LESS THAN F(X1) IS
-C FOUND WITH THE DOWN-D509HI
-C
- 9 X1=X
- Y1=Y
- 4 CALL D509HI(X,Y,X1,Y1,XSTEP,EPSI,M,MAXFUN,F,IS,A,B,Y4,Y5)
- IF(IS.EQ.4) GO TO 8
- IF(IS.EQ.1) GO TO 3
- GO TO 6
-C
- 3 CALL KERMTR('D509.1',LGFILE,MFLAG,RFLAG)
- IF(MFLAG) THEN
- IF(LGFILE .EQ. 0) THEN
- WRITE(*,100) EPSI, M
- ELSE
- WRITE(LGFILE,100) EPSI, M
- ENDIF
- ENDIF
- IF(.NOT. RFLAG) CALL ABEND
-C
- 8 R=ABS(XSTEP)
- RETURN
-C
- 100 FORMAT( 7X, 22HSUBROUTINE MINVAR ... ,
- + / 9X, 15H ACCURACY EPS =, E20.10,
- + 31H CANNOT BE ATTAINED WITH MAXF =, I6,
- + 16H FUNCTION CALLS.)
- END
diff --git a/src/packlib/kernlib/kernnum/d703fort/Imakefile b/src/packlib/kernlib/kernnum/d703fort/Imakefile
deleted file mode 100644
index c93b738..0000000
--- a/src/packlib/kernlib/kernnum/d703fort/Imakefile
+++ /dev/null
@@ -1,9 +0,0 @@
-SRCS_F= rfft.F
-
-#if defined(CERNLIB_DECS) && ! defined(CERNLIB_QMVAOS)
-FDEBUGFLAGS=NoOpFortranDebugFlags
-#endif
-
-FORTRANSAVEOPTION=FortranSaveFlags
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kernnum/d703fort/rfft.F b/src/packlib/kernlib/kernnum/d703fort/rfft.F
deleted file mode 100644
index da0c948..0000000
--- a/src/packlib/kernlib/kernnum/d703fort/rfft.F
+++ /dev/null
@@ -1,36 +0,0 @@
-*
-* $Id: rfft.F,v 1.1.1.1 1996/02/15 17:48:48 mclareni Exp $
-*
-* $Log: rfft.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:48 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE RFFT(A,MSIGN)
- COMPLEX A(1),T1,T2,U,W
- IF(MSIGN.EQ.0) RETURN
- M=IABS(MSIGN)-1
- N=2**M
- U=(0.,1.)
- IF(MSIGN.GT.0) GO TO 2
- CALL CFFT(A,-M)
- F=.25/N
- DO 1 I=1,N
- 1 A(I)=F*A(I)
- A(N+1)=A(1)
- U=CONJG(U)
- 2 ANGL=3.1415926535898/ISIGN(N,MSIGN)
- W=CMPLX(COS(ANGL),SIN(ANGL))
- N2=N+2
- N1=N2/2
- DO 3 J=1,N1
- K=N2-J
- T1= A(J)+CONJG(A(K))
- T2=(A(J)-CONJG(A(K)))*U
- A(J)= T1+T2
- A(K)=CONJG(T1-T2)
- 3 U=U*W
- IF(MSIGN.GT.0) CALL CFFT(A, M)
- RETURN
- END
diff --git a/src/packlib/kernlib/kernnum/d704fort/Imakefile b/src/packlib/kernlib/kernnum/d704fort/Imakefile
deleted file mode 100644
index 171e3ec..0000000
--- a/src/packlib/kernlib/kernnum/d704fort/Imakefile
+++ /dev/null
@@ -1,13 +0,0 @@
-SRCS_F= cfft.F
-
-#if defined(CERNLIB_DECS) && ! defined(CERNLIB_QMVAOS)
-FDEBUGFLAGS=NoOpFortranDebugFlags
-#endif
-
-#if defined(CERNLIB_MACOSX)
-FDEBUGFLAGS := -O0 $(FDEBUGFLAGS) -O0
-#endif
-
-FORTRANSAVEOPTION=FortranSaveFlags
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kernnum/d704fort/cfft.F b/src/packlib/kernlib/kernnum/d704fort/cfft.F
deleted file mode 100644
index 8c1aa29..0000000
--- a/src/packlib/kernlib/kernnum/d704fort/cfft.F
+++ /dev/null
@@ -1,57 +0,0 @@
-*
-* $Id: cfft.F,v 1.1.1.1 1996/02/15 17:48:48 mclareni Exp $
-*
-* $Log: cfft.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:48 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE CFFT(A,MSIGN)
- COMPLEX A(1),U,W,T
- IF(MSIGN.EQ.0) RETURN
- M=IABS(MSIGN)
- N=2**M
- NV2=N/2
- NM1=N-1
- J=1
- DO 7 I=1,NM1
- IF(I.GE.J) GO TO 5
- T=A(J)
- A(J)=A(I)
- A(I)=T
- 5 K=NV2
- 6 IF(K.GE.J) GO TO 7
- J=J-K
- K=K/2
- GO TO 6
- 7 J=J+K
- DO 8 I=1,N,2
- T=A(I+1)
- A(I+1)=A(I)-T
- 8 A(I )=A(I)+T
- IF(M.EQ.1) RETURN
- C=0.
- S=ISIGN(1,MSIGN)
- LE=2
- DO 20 L=2,M
- W=CMPLX(C,S)
- U=W
- C=SQRT(C*.5+.5)
- S=AIMAG(W)/(C+C)
- LE1=LE
- LE=LE1+LE1
- DO 9 I=1,N,LE
- IP=I+LE1
- T=A(IP)
- A(IP)=A(I)-T
- 9 A(I) =A(I)+T
- DO 20 J=2,LE1
- DO 10 I=J,N,LE
- IP=I+LE1
- T=A(IP)*U
- A(IP)=A(I)-T
- 10 A(I) =A(I)+T
- 20 U=U*W
- RETURN
- END
diff --git a/src/packlib/kernlib/kernnum/e100fort/Imakefile b/src/packlib/kernlib/kernnum/e100fort/Imakefile
deleted file mode 100644
index 0557280..0000000
--- a/src/packlib/kernlib/kernnum/e100fort/Imakefile
+++ /dev/null
@@ -1,9 +0,0 @@
-SRCS_F= polint.F
-
-#if defined(CERNLIB_DECS) && ! defined(CERNLIB_QMVAOS)
-FDEBUGFLAGS=NoOpFortranDebugFlags
-#endif
-
-FORTRANSAVEOPTION=FortranSaveFlags
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kernnum/e100fort/polint.F b/src/packlib/kernlib/kernnum/e100fort/polint.F
deleted file mode 100644
index 537a22a..0000000
--- a/src/packlib/kernlib/kernnum/e100fort/polint.F
+++ /dev/null
@@ -1,46 +0,0 @@
-*
-* $Id: polint.F,v 1.1.1.1 1996/02/15 17:48:35 mclareni Exp $
-*
-* $Log: polint.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:35 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE POLINT(F,ARG,MMMM,Z,SUM)
-C NEW VERSION OF E100 POLINT WRITTEN BY F.JAMES DEC. 1976
-C LIMITED TO ORDER 19 (20 POINTS) BY DIMENSION OF COF
-C BUT SUCH INTERPOLATION IS ALREADY UNSTABLE FOR ORDER 10
- DIMENSION F(20), ARG(20),COF(20)
- LOGICAL MFLAG, RFLAG
- IF(MMMM .LT. 2) GOTO 1900
- MM = MIN0(MMMM, 20)
- M = MM - 1
- DO 1780 I= 1, MM
- 1780 COF(I) = F(I)
- DO 1800 I= 1, M
- DO 1790 J= I, M
- JNDEX = MM - J
- INDEX = JNDEX + I
- COF(INDEX) = (COF(INDEX)-COF(INDEX-1))/(ARG(INDEX)-ARG(JNDEX))
- 1790 CONTINUE
- 1800 CONTINUE
- SUM = COF(MM)
- DO 1810 I= 1, M
- INDEX = MM - I
- SUM = (Z-ARG(INDEX))*SUM + COF(INDEX)
- 1810 CONTINUE
- RETURN
- 1900 CALL KERMTR('E100.1',LGFILE,MFLAG,RFLAG)
- IF(MFLAG) THEN
- IF(LGFILE .EQ. 0) THEN
- WRITE(*,2000) MMMM
- ELSE
- WRITE(LGFILE,2000) MMMM
- ENDIF
- ENDIF
- IF(.NOT. RFLAG) CALL ABEND
- RETURN
- 2000 FORMAT( 7X, 'SUBROUTINE POLINT ... K =', I6,
- + ' IS LESS THAN 2')
- END
diff --git a/src/packlib/kernlib/kernnum/e104fort/Imakefile b/src/packlib/kernlib/kernnum/e104fort/Imakefile
deleted file mode 100644
index dfc488e..0000000
--- a/src/packlib/kernlib/kernnum/e104fort/Imakefile
+++ /dev/null
@@ -1,9 +0,0 @@
-SRCS_F= fint.F
-
-#if defined(CERNLIB_DECS) && ! defined(CERNLIB_QMVAOS)
-FDEBUGFLAGS=NoOpFortranDebugFlags
-#endif
-
-FORTRANSAVEOPTION=FortranSaveFlags
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kernnum/e104fort/fint.F b/src/packlib/kernlib/kernnum/e104fort/fint.F
deleted file mode 100644
index 938e63d..0000000
--- a/src/packlib/kernlib/kernnum/e104fort/fint.F
+++ /dev/null
@@ -1,84 +0,0 @@
-*
-* $Id: fint.F,v 1.1.1.1 1996/02/15 17:48:36 mclareni Exp $
-*
-* $Log: fint.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:36 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- FUNCTION FINT(NARG,ARG,NENT,ENT,TABLE)
-C
-C INTERPOLATION ROUTINE. AUTHOR C. LETERTRE.
-C MODIFIED BY B. SCHORR, 1.07.1982.
-C
- INTEGER NENT(9)
- REAL ARG(9), ENT(9), TABLE(9)
- INTEGER INDEX(32)
- REAL WEIGHT(32)
- LOGICAL MFLAG, RFLAG
- FINT = 0.
- IF(NARG .LT. 1 .OR. NARG .GT. 5) GOTO 300
- LMAX = 0
- ISTEP = 1
- KNOTS = 1
- INDEX(1) = 1
- WEIGHT(1) = 1.
- DO 100 N = 1, NARG
- X = ARG(N)
- NDIM = NENT(N)
- LOCA = LMAX
- LMIN = LMAX + 1
- LMAX = LMAX + NDIM
- IF(NDIM .GT. 2) GOTO 10
- IF(NDIM .EQ. 1) GOTO 100
- H = X - ENT(LMIN)
- IF(H .EQ. 0.) GOTO 90
- ISHIFT = ISTEP
- IF(X-ENT(LMIN+1) .EQ. 0.) GOTO 21
- ISHIFT = 0
- ETA = H / (ENT(LMIN+1) - ENT(LMIN))
- GOTO 30
- 10 LOCB = LMAX + 1
- 11 LOCC = (LOCA+LOCB) / 2
- IF(X-ENT(LOCC)) 12, 20, 13
- 12 LOCB = LOCC
- GOTO 14
- 13 LOCA = LOCC
- 14 IF(LOCB-LOCA .GT. 1) GOTO 11
- LOCA = MIN0( MAX0(LOCA,LMIN), LMAX-1 )
- ISHIFT = (LOCA - LMIN) * ISTEP
- ETA = (X - ENT(LOCA)) / (ENT(LOCA+1) - ENT(LOCA))
- GOTO 30
- 20 ISHIFT = (LOCC - LMIN) * ISTEP
- 21 DO 22 K = 1, KNOTS
- INDEX(K) = INDEX(K) + ISHIFT
- 22 CONTINUE
- GOTO 90
- 30 DO 31 K = 1, KNOTS
- INDEX(K) = INDEX(K) + ISHIFT
- INDEX(K+KNOTS) = INDEX(K) + ISTEP
- WEIGHT(K+KNOTS) = WEIGHT(K) * ETA
- WEIGHT(K) = WEIGHT(K) - WEIGHT(K+KNOTS)
- 31 CONTINUE
- KNOTS = 2*KNOTS
- 90 ISTEP = ISTEP * NDIM
- 100 CONTINUE
- DO 200 K = 1, KNOTS
- I = INDEX(K)
- FINT = FINT + WEIGHT(K) * TABLE(I)
- 200 CONTINUE
- RETURN
- 300 CALL KERMTR('E104.1',LGFILE,MFLAG,RFLAG)
- IF(MFLAG) THEN
- IF(LGFILE .EQ. 0) THEN
- WRITE(*,1000) NARG
- ELSE
- WRITE(LGFILE,1000) NARG
- ENDIF
- ENDIF
- IF(.NOT. RFLAG) CALL ABEND
- RETURN
-1000 FORMAT( 7X, 24HFUNCTION FINT ... NARG =,I6,
- + 17H NOT WITHIN RANGE)
- END
diff --git a/src/packlib/kernlib/kernnum/e105fort/Imakefile b/src/packlib/kernlib/kernnum/e105fort/Imakefile
deleted file mode 100644
index d214501..0000000
--- a/src/packlib/kernlib/kernnum/e105fort/Imakefile
+++ /dev/null
@@ -1,9 +0,0 @@
-SRCS_F= divdif.F
-
-#if defined(CERNLIB_DECS) && ! defined(CERNLIB_QMVAOS)
-FDEBUGFLAGS=NoOpFortranDebugFlags
-#endif
-
-FORTRANSAVEOPTION=FortranSaveFlags
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kernnum/e105fort/divdif.F b/src/packlib/kernlib/kernnum/e105fort/divdif.F
deleted file mode 100644
index 36d3501..0000000
--- a/src/packlib/kernlib/kernnum/e105fort/divdif.F
+++ /dev/null
@@ -1,105 +0,0 @@
-*
-* $Id: divdif.F,v 1.1.1.1 1996/02/15 17:48:36 mclareni Exp $
-*
-* $Log: divdif.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:36 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- FUNCTION DIVDIF(F,A,NN,X,MM)
- DIMENSION A(NN),F(NN),T(20),D(20)
- LOGICAL EXTRA
- LOGICAL MFLAG,RFLAG
- DATA MMAX/10/
-C
-C TABULAR INTERPOLATION USING SYMMETRICALLY PLACED ARGUMENT POINTS.
-C
-C START. FIND SUBSCRIPT IX OF X IN ARRAY A.
- IF( (NN.LT.2) .OR. (MM.LT.1) ) GO TO 20
- N=NN
- M=MIN0(MM,MMAX,N-1)
- MPLUS=M+1
- IX=0
- IY=N+1
- IF(A(1).GT.A(N)) GO TO 4
-C (SEARCH INCREASING ARGUMENTS.)
- 1 MID=(IX+IY)/2
- IF(X.GE.A(MID)) GO TO 2
- IY=MID
- GO TO 3
-C (IF TRUE.)
- 2 IX=MID
- 3 IF(IY-IX.GT.1) GO TO 1
- GO TO 7
-C (SEARCH DECREASING ARGUMENTS.)
- 4 MID=(IX+IY)/2
- IF(X.LE.A(MID)) GO TO 5
- IY=MID
- GO TO 6
-C (IF TRUE.)
- 5 IX=MID
- 6 IF(IY-IX.GT.1) GO TO 4
-C
-C COPY REORDERED INTERPOLATION POINTS INTO (T(I),D(I)), SETTING
-C *EXTRA* TO TRUE IF M+2 POINTS TO BE USED.
- 7 NPTS=M+2-MOD(M,2)
- IP=0
- L=0
- GO TO 9
- 8 L=-L
- IF(L.GE.0) L=L+1
- 9 ISUB=IX+L
- IF((1.LE.ISUB).AND.(ISUB.LE.N)) GO TO 10
-C (SKIP POINT.)
- NPTS=MPLUS
- GO TO 11
-C (INSERT POINT.)
- 10 IP=IP+1
- T(IP)=A(ISUB)
- D(IP)=F(ISUB)
- 11 IF(IP.LT.NPTS) GO TO 8
- EXTRA=NPTS.NE.MPLUS
-C
-C REPLACE D BY THE LEADING DIAGONAL OF A DIVIDED-DIFFERENCE TABLE, SUP-
-C PLEMENTED BY AN EXTRA LINE IF *EXTRA* IS TRUE.
- DO 14 L=1,M
- IF(.NOT.EXTRA) GO TO 12
- ISUB=MPLUS-L
- D(M+2)=(D(M+2)-D(M))/(T(M+2)-T(ISUB))
- 12 I=MPLUS
- DO 13 J=L,M
- ISUB=I-L
- D(I)=(D(I)-D(I-1))/(T(I)-T(ISUB))
- I=I-1
- 13 CONTINUE
- 14 CONTINUE
-C
-C EVALUATE THE NEWTON INTERPOLATION FORMULA AT X, AVERAGING TWO VALUES
-C OF LAST DIFFERENCE IF *EXTRA* IS TRUE.
- SUM=D(MPLUS)
- IF(EXTRA) SUM=0.5*(SUM+D(M+2))
- J=M
- DO 15 L=1,M
- SUM=D(J)+(X-T(J))*SUM
- J=J-1
- 15 CONTINUE
- DIVDIF=SUM
- RETURN
-C
- 20 CALL KERMTR('E105.1',LGFILE,MFLAG,RFLAG)
- DIVDIF=0
- IF(MFLAG) THEN
- IF(LGFILE.EQ.0) THEN
- IF(MM.LT.1) WRITE(*,101) MM
- IF(NN.LT.2) WRITE(*,102) NN
- ELSE
- IF(MM.LT.1) WRITE(LGFILE,101) MM
- IF(NN.LT.2) WRITE(LGFILE,102) NN
- ENDIF
- ENDIF
- IF(.NOT.RFLAG) CALL ABEND
- RETURN
- 101 FORMAT( 7X, 'FUNCTION DIVDIF ... M =',I6,' IS LESS THAN 1')
- 102 FORMAT( 7X, 'FUNCTION DIVDIF ... N =',I6,' IS LESS THAN 2')
- END
diff --git a/src/packlib/kernlib/kernnum/e106fort/Imakefile b/src/packlib/kernlib/kernnum/e106fort/Imakefile
deleted file mode 100644
index 6b1b87c..0000000
--- a/src/packlib/kernlib/kernnum/e106fort/Imakefile
+++ /dev/null
@@ -1,9 +0,0 @@
-SRCS_F= locatf.F locati.F
-
-#if defined(CERNLIB_DECS) && ! defined(CERNLIB_QMVAOS)
-FDEBUGFLAGS=NoOpFortranDebugFlags
-#endif
-
-FORTRANSAVEOPTION=FortranSaveFlags
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kernnum/e106fort/locatf.F b/src/packlib/kernlib/kernnum/e106fort/locatf.F
deleted file mode 100644
index 3a4354b..0000000
--- a/src/packlib/kernlib/kernnum/e106fort/locatf.F
+++ /dev/null
@@ -1,44 +0,0 @@
-*
-* $Id: locatf.F,v 1.2 1996/05/24 10:56:52 jamie Exp $
-*
-* $Log: locatf.F,v $
-* Revision 1.2 1996/05/24 10:56:52 jamie
-* add locatr entry for consistency with wrup
-*
-* Revision 1.1.1.1 1996/02/15 17:48:49 mclareni
-* Kernlib
-*
-*
-#if !defined(CERNLIB_QMIBMVF)
-#include "kernnum/pilot.h"
-*
-* Name change (consistancy)
-*
- FUNCTION LOCATR(ARRAY,LENGTH,OBJECT)
- DIMENSION ARRAY(*)
- LOCATR=LOCATF(ARRAY,LENGTH,OBJECT)
- END
-
- FUNCTION LOCATF(ARRAY,LENGTH,OBJECT)
-C BINARY SEARCH THRU 'ARRAY' TO FIND 'OBJECT'
-C 'ARRAY' IS ASSUMED TO BE SORTED PRIOR TO CALL
-C IF MATCH IS FOUND, FUNCTION RETURNS POSITION OF ELEMENT
-C IF NO MATCH FOUND, FUNCTION GIVES NEGATIVE OF NEAREST ELEMENT
-C SMALLER THAN OBJECT
-C F. JAMES , SEPT.,1974
- DIMENSION ARRAY(2)
- NABOVE = LENGTH + 1
- NBELOW = 0
- 10 IF (NABOVE-NBELOW .LE. 1) GO TO 200
- MIDDLE = (NABOVE+NBELOW) / 2
- IF (OBJECT - ARRAY(MIDDLE)) 100, 180, 140
- 100 NABOVE = MIDDLE
- GO TO 10
- 140 NBELOW = MIDDLE
- GO TO 10
- 180 LOCATF = MIDDLE
- GO TO 300
- 200 LOCATF = -NBELOW
- 300 RETURN
- END
-#endif
diff --git a/src/packlib/kernlib/kernnum/e106fort/locati.F b/src/packlib/kernlib/kernnum/e106fort/locati.F
deleted file mode 100644
index 9777d8f..0000000
--- a/src/packlib/kernlib/kernnum/e106fort/locati.F
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: locati.F,v 1.1.1.1 1996/02/15 17:48:49 mclareni Exp $
-*
-* $Log: locati.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:49 mclareni
-* Kernlib
-*
-*
-#if !defined(CERNLIB_QMIBMVF)
-#include "kernnum/pilot.h"
- FUNCTION LOCATI(ARRAY,LENGTH,OBJECT)
-C BINARY SEARCH THRU 'ARRAY' TO FIND 'OBJECT'
-C 'ARRAY' IS ASSUMED TO BE SORTED PRIOR TO CALL
-C IF MATCH IS FOUND, FUNCTION RETURNS POSITION OF ELEMENT
-C IF NO MATCH FOUND, FUNCTION GIVES NEGATIVE OF NEAREST ELEMENT
-C SMALLER THAN OBJECT
-C F. JAMES , SEPT.,1974
- DIMENSION ARRAY(2)
- INTEGER ARRAY,OBJECT
- NABOVE = LENGTH + 1
- NBELOW = 0
- 10 IF (NABOVE-NBELOW .LE. 1) GO TO 200
- MIDDLE = (NABOVE+NBELOW) / 2
- IF (OBJECT - ARRAY(MIDDLE)) 100, 180, 140
- 100 NABOVE = MIDDLE
- GO TO 10
- 140 NBELOW = MIDDLE
- GO TO 10
- 180 LOCATI = MIDDLE
- GO TO 300
- 200 LOCATI = -NBELOW
- 300 RETURN
- END
-#endif
diff --git a/src/packlib/kernlib/kernnum/e208fort/Imakefile b/src/packlib/kernlib/kernnum/e208fort/Imakefile
deleted file mode 100644
index d4709ea..0000000
--- a/src/packlib/kernlib/kernnum/e208fort/Imakefile
+++ /dev/null
@@ -1,9 +0,0 @@
-SRCS_F= e208pr.F llsq.F lsq.F
-
-#if defined(CERNLIB_DECS) && ! defined(CERNLIB_QMVAOS)
-FDEBUGFLAGS=NoOpFortranDebugFlags
-#endif
-
-FORTRANSAVEOPTION=FortranSaveFlags
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kernnum/e208fort/e208pr.F b/src/packlib/kernlib/kernnum/e208fort/e208pr.F
deleted file mode 100644
index 1882079..0000000
--- a/src/packlib/kernlib/kernnum/e208fort/e208pr.F
+++ /dev/null
@@ -1,43 +0,0 @@
-*
-* $Id: e208pr.F,v 1.1.1.1 1996/02/15 17:48:36 mclareni Exp $
-*
-* $Log: e208pr.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:36 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE E208PR(N,M,IDIM)
- LOGICAL MFLAG, RFLAG
- K = 0
- IF(M .GT. IDIM) K = 3
- IF(M .LT. 1) K = 2
- IF(N .LT. M) K = 1
- IF(K .NE. 0) CALL KERMTR('E208.1',LGFILE,MFLAG,RFLAG)
- IF(K .EQ. 0) CALL KERMTR('E208.2',LGFILE,MFLAG,RFLAG)
- IF(MFLAG) THEN
- IF(LGFILE .EQ. 0) THEN
- IF(K .EQ. 0) WRITE(*,2000) N,M
- IF(K .EQ. 1) WRITE(*,2001) M,N
- IF(K .EQ. 2) WRITE(*,2002) M
- IF(K .EQ. 3) WRITE(*,2003) M,IDIM
- ELSE
- IF(K .EQ. 0) WRITE(LGFILE,2000) N,M
- IF(K .EQ. 1) WRITE(LGFILE,2001) M,N
- IF(K .EQ. 2) WRITE(LGFILE,2002) M
- IF(K .EQ. 3) WRITE(LGFILE,2003) M,IDIM
- ENDIF
- ENDIF
- IF(.NOT. RFLAG) CALL ABEND
- 500 M = 0
- RETURN
-2000 FORMAT( 7X, 34HSUBROUTINE LSQ ... NORMAL EQUATION,
- + 25H MATRIX IS SINGULAR. N =, I5, 5X,
- + 5H M =, I5, 1H. )
-2001 FORMAT( 7X, 22HSUBROUTINE LSQ ... M =, I5,
- + 13H EXCEEDS N =, I5, 1H. )
-2002 FORMAT( 7X, 22HSUBROUTINE LSQ ... M =, I5,
- + 17H IS LESS THAN 1. )
-2003 FORMAT( 7X, 22HSUBROUTINE LSQ ... M =, I5,
- + 9H EXCEEDS, I3, 1H. )
- END
diff --git a/src/packlib/kernlib/kernnum/e208fort/llsq.F b/src/packlib/kernlib/kernnum/e208fort/llsq.F
deleted file mode 100644
index 013f7ec..0000000
--- a/src/packlib/kernlib/kernnum/e208fort/llsq.F
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: llsq.F,v 1.1.1.1 1996/02/15 17:48:36 mclareni Exp $
-*
-* $Log: llsq.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:36 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE LLSQ(NDATA,X,Y,A0,A1,IFAIL)
-C
-C LEAST SQUARE LINEAR FIT WITHOUT WEIGHTS
-C (ADDED TO LSQ BY B. SCHORR, 15.02.1982.)
-C (MODIFIED BY H. LIPPS, 3.10.1983.)
-C
- DIMENSION X(2),Y(2)
-#if defined(CERNLIB_NUMRDBLE)
- DOUBLE PRECISION XBAR, YBAR, X2BAR, XYBAR, DET
-#endif
- N=NDATA
- IFAIL=-2
- IF(N .LT. 2) RETURN
- XBAR=0.
- YBAR=0.
- X2BAR=0.
- XYBAR=0.
- DO 10 I=1,N
- XBAR=XBAR+X(I)
- YBAR=YBAR+Y(I)
- X2BAR=X2BAR+X(I)**2
- XYBAR=XYBAR+X(I)*Y(I)
- 10 CONTINUE
- FN=FLOAT(N)
- DET=FN*X2BAR-XBAR**2
- IFAIL=-1
- IF(DET .LE. 0.) RETURN
- IFAIL=0
- A0=(X2BAR*YBAR-XBAR*XYBAR)/DET
- A1=(FN*XYBAR-XBAR*YBAR)/DET
- RETURN
- END
diff --git a/src/packlib/kernlib/kernnum/e208fort/lsq.F b/src/packlib/kernlib/kernnum/e208fort/lsq.F
deleted file mode 100644
index 6aed2be..0000000
--- a/src/packlib/kernlib/kernnum/e208fort/lsq.F
+++ /dev/null
@@ -1,94 +0,0 @@
-*
-* $Id: lsq.F,v 1.1.1.1 1996/02/15 17:48:36 mclareni Exp $
-*
-* $Log: lsq.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:36 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE LSQ(N,X,Y,M,A)
-C
-C LEAST SQUARES POLYNOMIAL FIT WITHOUT WEIGHTS.
-C (E.KEIL. REVISED BY B.SCHORR, 23.10.1981.)
-C REVISED BY H.LIPPS, 17.10.1984.)
-C
- REAL X(9), Y(9), A(9)
-#if !defined(CERNLIB_NUMRDBLE)
- REAL ZERO, ONE, POWER, XK, YK, B(20,20)
- DATA ZERO, ONE / 0., 1. /
-#endif
-#if defined(CERNLIB_NUMRDBLE)
- DOUBLE PRECISION ZERO, ONE, POWER, XK, YK, B(20,20)
- DOUBLE PRECISION DA(20)
- DATA ZERO, ONE / 0.D0, 1.D0 /
-#endif
- DATA IDIM / 20 /
- IF(M .GT. 2) GOTO 30
- IF(M .LT. 2) GOTO 10
- CALL LLSQ(N,X,Y,A(1),A(2),IFAIL)
- GOTO 100
- 10 IF(M .LT. 1 .OR. N .LT. 1) GOTO 900
- A(1) = RVSUM(N,Y(1),Y(2)) / FLOAT(N)
- RETURN
- 30 IF(M .GT. IDIM .OR. M .GT. N) GOTO 900
- B(1,1)=FLOAT(N)
-#if !defined(CERNLIB_NUMRDBLE)
- A(1)=ZERO
-#endif
-#if defined(CERNLIB_NUMRDBLE)
- DA(1)=ZERO
-#endif
- DO 1 L=2,M
- B(L,1)=ZERO
- B(M,L)=ZERO
-#if !defined(CERNLIB_NUMRDBLE)
- A(L)=ZERO
-#endif
-#if defined(CERNLIB_NUMRDBLE)
- DA(L)=ZERO
-#endif
- 1 CONTINUE
- DO 4 K=1,N
- XK=X(K)
- YK=Y(K)
- POWER=ONE
-#if !defined(CERNLIB_NUMRDBLE)
- A(1)=A(1)+YK
-#endif
-#if defined(CERNLIB_NUMRDBLE)
- DA(1)=DA(1)+YK
-#endif
- DO 2 L=2,M
- POWER=POWER*XK
- B(L,1)=B(L,1)+POWER
-#if !defined(CERNLIB_NUMRDBLE)
- A(L)=A(L)+POWER*YK
-#endif
-#if defined(CERNLIB_NUMRDBLE)
- DA(L)=DA(L)+POWER*YK
-#endif
- 2 CONTINUE
- DO 3 L=2,M
- POWER=POWER*XK
- B(M,L)=B(M,L)+POWER
- 3 CONTINUE
- 4 CONTINUE
- DO 6 I=3,M
- DO 5 K=I,M
- B(K-1,I-1)=B(K,I-2)
- 5 CONTINUE
- 6 CONTINUE
-#if !defined(CERNLIB_NUMRDBLE)
- CALL RSEQN(M,B,IDIM,IFAIL,1,A)
-#endif
-#if defined(CERNLIB_NUMRDBLE)
- CALL DSEQN(M,B,IDIM,IFAIL,1,DA)
- DO 9 I=1,M
- A(I)=DA(I)
- 9 CONTINUE
-#endif
- 100 IF(IFAIL .EQ. 0) RETURN
- 900 CALL E208PR(N,M,IDIM)
- RETURN
- END
diff --git a/src/packlib/kernlib/kernnum/f002fort/Imakefile b/src/packlib/kernlib/kernnum/f002fort/Imakefile
deleted file mode 100644
index 9e2ada2..0000000
--- a/src/packlib/kernlib/kernnum/f002fort/Imakefile
+++ /dev/null
@@ -1,19 +0,0 @@
-SRCS_F= cvadd.F cvcpy.F cvdiv.F cvmpa.F cvmpac.F cvmpy.F cvmpyc.F cvmul.F \ @@\
- cvmula.F cvmuna.F cvran.F cvsca.F cvscl.F cvscs.F cvset.F cvsub.F \ @@\
- cvsum.F cvxch.F dvadd.F dvcpy.F dvdiv.F dvmpa.F dvmpy.F dvmul.F \ @@\
- dvmula.F dvmuna.F dvran.F dvsca.F dvscl.F dvscs.F dvset.F dvsub.F \ @@\
- dvsum.F dvxch.F rvadd.F rvcpy.F rvdiv.F rvmpa.F rvmpy.F rvmul.F \ @@\
- rvmula.F rvmuna.F rvran.F rvsca.F rvscl.F rvscs.F rvset.F rvsub.F \ @@\
- rvsum.F rvxch.F
-
-#if defined(CERNLIB_DECS) && ! defined(CERNLIB_QMVAOS)
-FDEBUGFLAGS=NoOpFortranDebugFlags
-#endif
-
-#if defined(CERNLIB_MACOSX)
-FDEBUGFLAGS := -O0 $(FDEBUGFLAGS) -O0
-#endif
-
-FORTRANSAVEOPTION=FortranSaveFlags
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kernnum/f002fort/cvadd.F b/src/packlib/kernlib/kernnum/f002fort/cvadd.F
deleted file mode 100644
index e837004..0000000
--- a/src/packlib/kernlib/kernnum/f002fort/cvadd.F
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: cvadd.F,v 1.1.1.1 1996/02/15 17:48:51 mclareni Exp $
-*
-* $Log: cvadd.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:51 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE CVADD(N,X,X2,Y,Y2,Z,Z2)
- COMPLEX X(*), X2(*), Y(*), Y2(*), Z(*), Z2(*)
- COMPLEX ADD, A, B
- ADD(A,B) = A+B
- IF(N .LE. 0) RETURN
-#include "cxj.inc"
-#include "cyj.inc"
-#include "czj.inc"
-#include "vadd.inc"
diff --git a/src/packlib/kernlib/kernnum/f002fort/cvcpy.F b/src/packlib/kernlib/kernnum/f002fort/cvcpy.F
deleted file mode 100644
index 8103a0e..0000000
--- a/src/packlib/kernlib/kernnum/f002fort/cvcpy.F
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: cvcpy.F,v 1.1.1.1 1996/02/15 17:48:51 mclareni Exp $
-*
-* $Log: cvcpy.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:51 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE CVCPY(N,X,X2,Z,Z2)
- COMPLEX X(*), X2(*), Z(*), Z2(*), FUNCT, A
- FUNCT(A) = A
- IF(N .LE. 0) RETURN
-#include "cxj.inc"
-#include "czj.inc"
-#include "vcpy.inc"
diff --git a/src/packlib/kernlib/kernnum/f002fort/cvdiv.F b/src/packlib/kernlib/kernnum/f002fort/cvdiv.F
deleted file mode 100644
index dda35c9..0000000
--- a/src/packlib/kernlib/kernnum/f002fort/cvdiv.F
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: cvdiv.F,v 1.1.1.1 1996/02/15 17:48:51 mclareni Exp $
-*
-* $Log: cvdiv.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:51 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE CVDIV(N,X,X2,Y,Y2,Z,Z2,IFAIL)
- COMPLEX X(*), X2(*), Y(*), Y2(*), Z(*), Z2(*), T
- REALF(T) = AMAX1(ABS(REAL(T)),ABS(AIMAG(T)))
- IFAIL = 0
- IF(N .LE. 0) RETURN
-#include "cxj.inc"
-#include "cyj.inc"
-#include "czj.inc"
-#include "vdiv.inc"
diff --git a/src/packlib/kernlib/kernnum/f002fort/cvmpa.F b/src/packlib/kernlib/kernnum/f002fort/cvmpa.F
deleted file mode 100644
index b8fc0c4..0000000
--- a/src/packlib/kernlib/kernnum/f002fort/cvmpa.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: cvmpa.F,v 1.1.1.1 1996/02/15 17:48:51 mclareni Exp $
-*
-* $Log: cvmpa.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:51 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- COMPLEX FUNCTION CVMPA(N,X,X2,Y,Y2,S)
- COMPLEX X(*), X2(*), Y(*), Y2(*), S, A, B
-#if defined(CERNLIB_NUMCDBLE)
- COMPLEX*16 SUM, MPA, DC
- DC(A) = DCMPLX(DBLE(REAL(A)),DBLE(AIMAG(A)))
- MPA(A,B,SUM) = DC(A)*DC(B) + SUM
-#endif
-#if !defined(CERNLIB_NUMCDBLE)
- COMPLEX SUM, MPA
- MPA(A,B,SUM) = A*B + SUM
-#endif
- SUM = S
- IF(N .LE. 0) GOTO 20
-#include "dxj.inc"
-#include "dyj.inc"
-#include "vmpa.inc"
- 20 CVMPA = SUM
- RETURN
- END
diff --git a/src/packlib/kernlib/kernnum/f002fort/cvmpac.F b/src/packlib/kernlib/kernnum/f002fort/cvmpac.F
deleted file mode 100644
index 2a0a72c..0000000
--- a/src/packlib/kernlib/kernnum/f002fort/cvmpac.F
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: cvmpac.F,v 1.1.1.1 1996/02/15 17:48:51 mclareni Exp $
-*
-* $Log: cvmpac.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:51 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- COMPLEX FUNCTION CVMPAC(N,X,X2,Y,Y2,S)
- COMPLEX X(*), X2(*), Y(*), Y2(*), S, A, B
-#if (defined(CERNLIB_NUMCDBLE))&&(!defined(CERNLIB_NUMND))
- COMPLEX*16 SUM, MPA, DC
- DC(A) = DCMPLX(DBLE(REAL(A)),DBLE(AIMAG(A)))
- MPA(A,B,SUM) = DC(A)*DCONJG(DC(B)) + SUM
-#endif
-#if (defined(CERNLIB_NUMCDBLE))&&(defined(CERNLIB_NUMND))
- COMPLEX*16 SUM, MPA, DC
- DC(A) = DCMPLX(DBLE(REAL(A)),DBLE(AIMAG(A)))
- MPA(A,B,SUM) = DC(A)*CDCONJG(DC(B)) + SUM
-#endif
-#if !defined(CERNLIB_NUMCDBLE)
- COMPLEX SUM, MPA
- MPA(A,B,SUM) = A*CONJG(B) + SUM
-#endif
- SUM = S
- IF(N .LE. 0) GOTO 20
-#include "dxj.inc"
-#include "dyj.inc"
-#include "vmpa.inc"
- 20 CVMPAC = SUM
- RETURN
- END
diff --git a/src/packlib/kernlib/kernnum/f002fort/cvmpy.F b/src/packlib/kernlib/kernnum/f002fort/cvmpy.F
deleted file mode 100644
index e488063..0000000
--- a/src/packlib/kernlib/kernnum/f002fort/cvmpy.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: cvmpy.F,v 1.1.1.1 1996/02/15 17:48:52 mclareni Exp $
-*
-* $Log: cvmpy.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:52 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- COMPLEX FUNCTION CVMPY(N,X,X2,Y,Y2)
- COMPLEX X(*), X2(*), Y(*), Y2(*), A, B
-#if defined(CERNLIB_NUMCDBLE)
- COMPLEX*16 SUM, MPA, DC
- DC(A) = DCMPLX(DBLE(REAL(A)),DBLE(AIMAG(A)))
- MPA(A,B,SUM) = DC(A)*DC(B) + SUM
-#endif
-#if !defined(CERNLIB_NUMCDBLE)
- COMPLEX SUM, MPA
- MPA(A,B,SUM) = A*B + SUM
-#endif
- SUM = (0.,0.)
- IF(N .LE. 0) GOTO 20
-#include "dxj.inc"
-#include "dyj.inc"
-#include "vmpa.inc"
- 20 CVMPY = SUM
- RETURN
- END
diff --git a/src/packlib/kernlib/kernnum/f002fort/cvmpyc.F b/src/packlib/kernlib/kernnum/f002fort/cvmpyc.F
deleted file mode 100644
index ad49bc6..0000000
--- a/src/packlib/kernlib/kernnum/f002fort/cvmpyc.F
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: cvmpyc.F,v 1.1.1.1 1996/02/15 17:48:52 mclareni Exp $
-*
-* $Log: cvmpyc.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:52 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- COMPLEX FUNCTION CVMPYC(N,X,X2,Y,Y2)
- COMPLEX X(*), X2(*), Y(*), Y2(*), A, B
-#if (defined(CERNLIB_NUMCDBLE))&&(!defined(CERNLIB_NUMND))
- COMPLEX*16 SUM, MPA, DC
- DC(A) = DCMPLX(DBLE(REAL(A)),DBLE(AIMAG(A)))
- MPA(A,B,SUM) = DC(A)*DCONJG(DC(B)) + SUM
-#endif
-#if (defined(CERNLIB_NUMCDBLE))&&(defined(CERNLIB_NUMND))
- COMPLEX*16 SUM, MPA, DC
- DC(A) = DCMPLX(DBLE(REAL(A)),DBLE(AIMAG(A)))
- MPA(A,B,SUM) = DC(A)*CDCONJG(DC(B)) + SUM
-#endif
-#if !defined(CERNLIB_NUMCDBLE)
- COMPLEX SUM, MPA
- MPA(A,B,SUM) = A*CONJG(B) + SUM
-#endif
- SUM = (0.,0.)
- IF(N .LE. 0) GOTO 20
-#include "dxj.inc"
-#include "dyj.inc"
-#include "vmpa.inc"
- 20 CVMPYC = SUM
- RETURN
- END
diff --git a/src/packlib/kernlib/kernnum/f002fort/cvmul.F b/src/packlib/kernlib/kernnum/f002fort/cvmul.F
deleted file mode 100644
index ebf09fa..0000000
--- a/src/packlib/kernlib/kernnum/f002fort/cvmul.F
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: cvmul.F,v 1.1.1.1 1996/02/15 17:48:52 mclareni Exp $
-*
-* $Log: cvmul.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:52 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE CVMUL(N,X,X2,Y,Y2,Z,Z2)
- COMPLEX X(*), X2(*), Y(*), Y2(*), Z(*), Z2(*)
- COMPLEX ADD, A, B
- ADD(A,B) = A*B
- IF(N .LE. 0) RETURN
-#include "cxj.inc"
-#include "cyj.inc"
-#include "czj.inc"
-#include "vadd.inc"
diff --git a/src/packlib/kernlib/kernnum/f002fort/cvmula.F b/src/packlib/kernlib/kernnum/f002fort/cvmula.F
deleted file mode 100644
index 21d5460..0000000
--- a/src/packlib/kernlib/kernnum/f002fort/cvmula.F
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: cvmula.F,v 1.1.1.1 1996/02/15 17:48:52 mclareni Exp $
-*
-* $Log: cvmula.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:52 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE CVMULA(N,X,X2,Y,Y2,Z,Z2)
- COMPLEX X(*), X2(*), Y(*), Y2(*), Z(*), Z2(*)
- COMPLEX MULA, A, B, C
- MULA(A,B,C) = A*B + C
- IF(N .LE. 0) RETURN
-#include "cxj.inc"
-#include "cyj.inc"
-#include "czj.inc"
-#include "vmula.inc"
diff --git a/src/packlib/kernlib/kernnum/f002fort/cvmuna.F b/src/packlib/kernlib/kernnum/f002fort/cvmuna.F
deleted file mode 100644
index b23b33f..0000000
--- a/src/packlib/kernlib/kernnum/f002fort/cvmuna.F
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: cvmuna.F,v 1.1.1.1 1996/02/15 17:48:52 mclareni Exp $
-*
-* $Log: cvmuna.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:52 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE CVMUNA(N,X,X2,Y,Y2,Z,Z2)
- COMPLEX X(*), X2(*), Y(*), Y2(*), Z(*), Z2(*)
- COMPLEX MULA, A, B, C
- MULA(A,B,C) = -A*B + C
- IF(N .LE. 0) RETURN
-#include "cxj.inc"
-#include "cyj.inc"
-#include "czj.inc"
-#include "vmula.inc"
diff --git a/src/packlib/kernlib/kernnum/f002fort/cvran.F b/src/packlib/kernlib/kernnum/f002fort/cvran.F
deleted file mode 100644
index e5e5afe..0000000
--- a/src/packlib/kernlib/kernnum/f002fort/cvran.F
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: cvran.F,v 1.1.1.1 1996/02/15 17:48:52 mclareni Exp $
-*
-* $Log: cvran.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:52 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE CVRAN(N,A,B,Z,Z2)
- COMPLEX A, B, C, Z(*), Z2(*)
- IF(N .LE. 0) RETURN
- LZJ = 1
-#include "czj.inc"
- C = B - A
- DO 10 J = 1, N
- Z(LZJ) = CMPLX(REAL(C)*RANF() + REAL(A),
- + AIMAG(C)*RANF() + AIMAG(A))
- LZJ = LZJ + JZ
- 10 CONTINUE
- RETURN
- END
diff --git a/src/packlib/kernlib/kernnum/f002fort/cvsca.F b/src/packlib/kernlib/kernnum/f002fort/cvsca.F
deleted file mode 100644
index e829743..0000000
--- a/src/packlib/kernlib/kernnum/f002fort/cvsca.F
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: cvsca.F,v 1.1.1.1 1996/02/15 17:48:52 mclareni Exp $
-*
-* $Log: cvsca.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:52 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE CVSCA(N,S,X,X2,Y,Y2,Z,Z2)
- COMPLEX S, X(*), X2(*), Y(*), Y2(*), Z(*), Z2(*)
- COMPLEX ADD, A, B
- ADD(A,B) = S*A + B
- IF(N .LE. 0) RETURN
-#include "cxj.inc"
-#include "cyj.inc"
-#include "czj.inc"
-#include "vadd.inc"
diff --git a/src/packlib/kernlib/kernnum/f002fort/cvscl.F b/src/packlib/kernlib/kernnum/f002fort/cvscl.F
deleted file mode 100644
index 344f544..0000000
--- a/src/packlib/kernlib/kernnum/f002fort/cvscl.F
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: cvscl.F,v 1.1.1.1 1996/02/15 17:48:52 mclareni Exp $
-*
-* $Log: cvscl.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:52 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE CVSCL(N,S,X,X2,Z,Z2)
- COMPLEX S, X(*), X2(*), Z(*), Z2(*), FUNCT, A
- FUNCT(A) = S*A
- IF(N .LE. 0) RETURN
-#include "cxj.inc"
-#include "czj.inc"
-#include "vcpy.inc"
diff --git a/src/packlib/kernlib/kernnum/f002fort/cvscs.F b/src/packlib/kernlib/kernnum/f002fort/cvscs.F
deleted file mode 100644
index c49327f..0000000
--- a/src/packlib/kernlib/kernnum/f002fort/cvscs.F
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: cvscs.F,v 1.1.1.1 1996/02/15 17:48:53 mclareni Exp $
-*
-* $Log: cvscs.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:53 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE CVSCS(N,S,X,X2,Y,Y2,Z,Z2)
- COMPLEX S, X(*), X2(*), Y(*), Y2(*), Z(*), Z2(*)
- COMPLEX ADD, A, B
- ADD(A,B) = S*A - B
- IF(N .LE. 0) RETURN
-#include "cxj.inc"
-#include "cyj.inc"
-#include "czj.inc"
-#include "vadd.inc"
diff --git a/src/packlib/kernlib/kernnum/f002fort/cvset.F b/src/packlib/kernlib/kernnum/f002fort/cvset.F
deleted file mode 100644
index 04906d8..0000000
--- a/src/packlib/kernlib/kernnum/f002fort/cvset.F
+++ /dev/null
@@ -1,14 +0,0 @@
-*
-* $Id: cvset.F,v 1.1.1.1 1996/02/15 17:48:53 mclareni Exp $
-*
-* $Log: cvset.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:53 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE CVSET(N,S,Z,Z2)
- COMPLEX S, Z(*), Z2(*)
- IF(N .LE. 0) RETURN
-#include "czj.inc"
-#include "vset.inc"
diff --git a/src/packlib/kernlib/kernnum/f002fort/cvsub.F b/src/packlib/kernlib/kernnum/f002fort/cvsub.F
deleted file mode 100644
index 928adfb..0000000
--- a/src/packlib/kernlib/kernnum/f002fort/cvsub.F
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: cvsub.F,v 1.1.1.1 1996/02/15 17:48:53 mclareni Exp $
-*
-* $Log: cvsub.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:53 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE CVSUB(N,X,X2,Y,Y2,Z,Z2)
- COMPLEX X(*), X2(*), Y(*), Y2(*), Z(*), Z2(*)
- COMPLEX ADD, A, B
- ADD(A,B) = A-B
- IF(N .LE. 0) RETURN
-#include "cxj.inc"
-#include "cyj.inc"
-#include "czj.inc"
-#include "vadd.inc"
diff --git a/src/packlib/kernlib/kernnum/f002fort/cvsum.F b/src/packlib/kernlib/kernnum/f002fort/cvsum.F
deleted file mode 100644
index 67ae75d..0000000
--- a/src/packlib/kernlib/kernnum/f002fort/cvsum.F
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: cvsum.F,v 1.1.1.1 1996/02/15 17:48:53 mclareni Exp $
-*
-* $Log: cvsum.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:53 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- COMPLEX FUNCTION CVSUM(N,X,X2)
- COMPLEX X(*), X2(*), SUM
- SUM = (0.,0.)
- IF(N .LE. 0) GOTO 20
-#include "cxj.inc"
- LXJ = 1
- DO 10 J = 1, N
- SUM = SUM + X(LXJ)
- LXJ = LXJ + JX
- 10 CONTINUE
- 20 CVSUM = SUM
- RETURN
- END
diff --git a/src/packlib/kernlib/kernnum/f002fort/cvxch.F b/src/packlib/kernlib/kernnum/f002fort/cvxch.F
deleted file mode 100644
index 9e91a78..0000000
--- a/src/packlib/kernlib/kernnum/f002fort/cvxch.F
+++ /dev/null
@@ -1,15 +0,0 @@
-*
-* $Id: cvxch.F,v 1.1.1.1 1996/02/15 17:48:53 mclareni Exp $
-*
-* $Log: cvxch.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:53 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE CVXCH(N,X,X2,Y,Y2)
- COMPLEX X(*), X2(*), Y(*), Y2(*), T
- IF(N .LE. 0) RETURN
-#include "cxj.inc"
-#include "cyj.inc"
-#include "vxch.inc"
diff --git a/src/packlib/kernlib/kernnum/f002fort/cxj.inc b/src/packlib/kernlib/kernnum/f002fort/cxj.inc
deleted file mode 100644
index c12f826..0000000
--- a/src/packlib/kernlib/kernnum/f002fort/cxj.inc
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: cxj.inc,v 1.1.1.1 1996/02/15 17:48:50 mclareni Exp $
-*
-* $Log: cxj.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:50 mclareni
-* Kernlib
-*
-*
-*
-* cxj.inc
-*
-#if defined(CERNLIB_NUMAP)||defined(CERNLIB_NUMCD)||defined(CERNLIB_NUMCV)||defined(CERNLIB_NUMIB2)||defined(CERNLIB_NUMND)
- JX = (LOCF(X2) - LOCF(X)) / 2
-#endif
-#if defined(CERNLIB_NUMCR)||defined(CERNLIB_NUMUC)
- JX = (LOC(X2) - LOC(X)) / 2
-#endif
-#if defined(CERNLIB_NUMDE)
- JX = (%LOC(X2) - %LOC(X)) / 8
-#endif
-#if defined(CERNLIB_NUMIB1)
- JX = (IADDR(X2) - IADDR(X)) / 8
-#endif
diff --git a/src/packlib/kernlib/kernnum/f002fort/cyj.inc b/src/packlib/kernlib/kernnum/f002fort/cyj.inc
deleted file mode 100644
index c22bc9a..0000000
--- a/src/packlib/kernlib/kernnum/f002fort/cyj.inc
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: cyj.inc,v 1.1.1.1 1996/02/15 17:48:50 mclareni Exp $
-*
-* $Log: cyj.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:50 mclareni
-* Kernlib
-*
-*
-*
-* cyj.inc
-*
-#if defined(CERNLIB_NUMAP)||defined(CERNLIB_NUMCD)||defined(CERNLIB_NUMCV)||defined(CERNLIB_NUMIB2)||defined(CERNLIB_NUMND)
- JY = (LOCF(Y2) - LOCF(Y)) / 2
-#endif
-#if defined(CERNLIB_NUMCR)||defined(CERNLIB_NUMUC)
- JY = (LOC(Y2) - LOC(Y)) / 2
-#endif
-#if defined(CERNLIB_NUMDE)
- JY = (%LOC(Y2) - %LOC(Y)) / 8
-#endif
-#if defined(CERNLIB_NUMIB1)
- JY = (IADDR(Y2) - IADDR(Y)) / 8
-#endif
diff --git a/src/packlib/kernlib/kernnum/f002fort/czj.inc b/src/packlib/kernlib/kernnum/f002fort/czj.inc
deleted file mode 100644
index 1c37520..0000000
--- a/src/packlib/kernlib/kernnum/f002fort/czj.inc
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: czj.inc,v 1.1.1.1 1996/02/15 17:48:50 mclareni Exp $
-*
-* $Log: czj.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:50 mclareni
-* Kernlib
-*
-*
-*
-* czj.inc
-*
-#if defined(CERNLIB_NUMAP)||defined(CERNLIB_NUMCD)||defined(CERNLIB_NUMCV)||defined(CERNLIB_NUMIB2)||defined(CERNLIB_NUMND)
- JZ = (LOCF(Z2) - LOCF(Z)) / 2
-#endif
-#if defined(CERNLIB_NUMCR)||defined(CERNLIB_NUMUC)
- JZ = (LOC(Z2) - LOC(Z)) / 2
-#endif
-#if defined(CERNLIB_NUMDE)
- JZ = (%LOC(Z2) - %LOC(Z)) / 8
-#endif
-#if defined(CERNLIB_NUMIB1)
- JZ = (IADDR(Z2) - IADDR(Z)) / 8
-#endif
diff --git a/src/packlib/kernlib/kernnum/f002fort/dvadd.F b/src/packlib/kernlib/kernnum/f002fort/dvadd.F
deleted file mode 100644
index 7eec3bf..0000000
--- a/src/packlib/kernlib/kernnum/f002fort/dvadd.F
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: dvadd.F,v 1.1.1.1 1996/02/15 17:48:51 mclareni Exp $
-*
-* $Log: dvadd.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:51 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE DVADD(N,X,X2,Y,Y2,Z,Z2)
- DOUBLE PRECISION X(*), X2(*), Y(*), Y2(*), Z(*), Z2(*)
- DOUBLE PRECISION ADD, A, B
- ADD(A,B) = A+B
- IF(N .LE. 0) RETURN
-#include "dxj.inc"
-#include "dyj.inc"
-#include "dzj.inc"
-#include "vadd.inc"
diff --git a/src/packlib/kernlib/kernnum/f002fort/dvcpy.F b/src/packlib/kernlib/kernnum/f002fort/dvcpy.F
deleted file mode 100644
index 002be20..0000000
--- a/src/packlib/kernlib/kernnum/f002fort/dvcpy.F
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: dvcpy.F,v 1.1.1.1 1996/02/15 17:48:51 mclareni Exp $
-*
-* $Log: dvcpy.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:51 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE DVCPY(N,X,X2,Z,Z2)
- DOUBLE PRECISION X(*), X2(*), Z(*), Z2(*), FUNCT, A
- FUNCT(A) = A
- IF(N .LE. 0) RETURN
-#include "dxj.inc"
-#include "dzj.inc"
-#include "vcpy.inc"
diff --git a/src/packlib/kernlib/kernnum/f002fort/dvdiv.F b/src/packlib/kernlib/kernnum/f002fort/dvdiv.F
deleted file mode 100644
index ac9dba4..0000000
--- a/src/packlib/kernlib/kernnum/f002fort/dvdiv.F
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: dvdiv.F,v 1.1.1.1 1996/02/15 17:48:51 mclareni Exp $
-*
-* $Log: dvdiv.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:51 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE DVDIV(N,X,X2,Y,Y2,Z,Z2,IFAIL)
- DOUBLE PRECISION X(*), X2(*), Y(*), Y2(*), Z(*), Z2(*), T
- REALF(T) = SNGL(T)
- IFAIL = 0
- IF(N .LE. 0) RETURN
-#include "dxj.inc"
-#include "dyj.inc"
-#include "dzj.inc"
-#include "vdiv.inc"
diff --git a/src/packlib/kernlib/kernnum/f002fort/dvmpa.F b/src/packlib/kernlib/kernnum/f002fort/dvmpa.F
deleted file mode 100644
index 12174c3..0000000
--- a/src/packlib/kernlib/kernnum/f002fort/dvmpa.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: dvmpa.F,v 1.1.1.1 1996/02/15 17:48:51 mclareni Exp $
-*
-* $Log: dvmpa.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:51 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- DOUBLE PRECISION FUNCTION DVMPA(N,X,X2,Y,Y2,S)
- DOUBLE PRECISION X(*), X2(*), Y(*), Y2(*), S, A, B
- DOUBLE PRECISION SUM, MPA
- MPA(A,B,SUM) = A*B + SUM
- SUM = S
- IF(N .LE. 0) GOTO 20
-#include "dxj.inc"
-#include "dyj.inc"
-#include "vmpa.inc"
- 20 DVMPA = SUM
- RETURN
- END
diff --git a/src/packlib/kernlib/kernnum/f002fort/dvmpy.F b/src/packlib/kernlib/kernnum/f002fort/dvmpy.F
deleted file mode 100644
index 7cc7c5a..0000000
--- a/src/packlib/kernlib/kernnum/f002fort/dvmpy.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: dvmpy.F,v 1.1.1.1 1996/02/15 17:48:52 mclareni Exp $
-*
-* $Log: dvmpy.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:52 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- DOUBLE PRECISION FUNCTION DVMPY(N,X,X2,Y,Y2)
- DOUBLE PRECISION X(*), X2(*), Y(*), Y2(*), A, B
- DOUBLE PRECISION SUM, MPA
- MPA(A,B,SUM) = A*B + SUM
- SUM = 0.D0
- IF(N .LE. 0) GOTO 20
-#include "dxj.inc"
-#include "dyj.inc"
-#include "vmpa.inc"
- 20 DVMPY = SUM
- RETURN
- END
diff --git a/src/packlib/kernlib/kernnum/f002fort/dvmul.F b/src/packlib/kernlib/kernnum/f002fort/dvmul.F
deleted file mode 100644
index 1e114ba..0000000
--- a/src/packlib/kernlib/kernnum/f002fort/dvmul.F
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: dvmul.F,v 1.1.1.1 1996/02/15 17:48:52 mclareni Exp $
-*
-* $Log: dvmul.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:52 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE DVMUL(N,X,X2,Y,Y2,Z,Z2)
- DOUBLE PRECISION X(*), X2(*), Y(*), Y2(*), Z(*), Z2(*)
- DOUBLE PRECISION ADD, A, B
- ADD(A,B) = A*B
- IF(N .LE. 0) RETURN
-#include "dxj.inc"
-#include "dyj.inc"
-#include "dzj.inc"
-#include "vadd.inc"
diff --git a/src/packlib/kernlib/kernnum/f002fort/dvmula.F b/src/packlib/kernlib/kernnum/f002fort/dvmula.F
deleted file mode 100644
index 2570c10..0000000
--- a/src/packlib/kernlib/kernnum/f002fort/dvmula.F
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: dvmula.F,v 1.1.1.1 1996/02/15 17:48:52 mclareni Exp $
-*
-* $Log: dvmula.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:52 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE DVMULA(N,X,X2,Y,Y2,Z,Z2)
- DOUBLE PRECISION X(*), X2(*), Y(*), Y2(*), Z(*), Z2(*)
- DOUBLE PRECISION MULA, A, B, C
- MULA(A,B,C) = A*B + C
- IF(N .LE. 0) RETURN
-#include "dxj.inc"
-#include "dyj.inc"
-#include "dzj.inc"
-#include "vmula.inc"
diff --git a/src/packlib/kernlib/kernnum/f002fort/dvmuna.F b/src/packlib/kernlib/kernnum/f002fort/dvmuna.F
deleted file mode 100644
index 2cde52e..0000000
--- a/src/packlib/kernlib/kernnum/f002fort/dvmuna.F
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: dvmuna.F,v 1.1.1.1 1996/02/15 17:48:52 mclareni Exp $
-*
-* $Log: dvmuna.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:52 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE DVMUNA(N,X,X2,Y,Y2,Z,Z2)
- DOUBLE PRECISION X(*), X2(*), Y(*), Y2(*), Z(*), Z2(*)
- DOUBLE PRECISION MULA, A, B, C
- MULA(A,B,C) = -A*B + C
- IF(N .LE. 0) RETURN
-#include "dxj.inc"
-#include "dyj.inc"
-#include "dzj.inc"
-#include "vmula.inc"
diff --git a/src/packlib/kernlib/kernnum/f002fort/dvran.F b/src/packlib/kernlib/kernnum/f002fort/dvran.F
deleted file mode 100644
index 1be520d..0000000
--- a/src/packlib/kernlib/kernnum/f002fort/dvran.F
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: dvran.F,v 1.1.1.1 1996/02/15 17:48:52 mclareni Exp $
-*
-* $Log: dvran.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:52 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE DVRAN(N,A,B,Z,Z2)
- DOUBLE PRECISION A, B, C, Z(*), Z2(*)
- DOUBLE PRECISION DRANF
- IF(N .LE. 0) RETURN
- LZJ = 1
-#include "dzj.inc"
- C = B - A
- DO 10 J = 1, N
- Z(LZJ) = C*DRANF() + A
- LZJ = LZJ + JZ
- 10 CONTINUE
- RETURN
- END
diff --git a/src/packlib/kernlib/kernnum/f002fort/dvsca.F b/src/packlib/kernlib/kernnum/f002fort/dvsca.F
deleted file mode 100644
index 54b9227..0000000
--- a/src/packlib/kernlib/kernnum/f002fort/dvsca.F
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: dvsca.F,v 1.1.1.1 1996/02/15 17:48:52 mclareni Exp $
-*
-* $Log: dvsca.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:52 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE DVSCA(N,S,X,X2,Y,Y2,Z,Z2)
- DOUBLE PRECISION S, X(*), X2(*), Y(*), Y2(*), Z(*), Z2(*)
- DOUBLE PRECISION ADD, A, B
- ADD(A,B) = S*A + B
- IF(N .LE. 0) RETURN
-#include "dxj.inc"
-#include "dyj.inc"
-#include "dzj.inc"
-#include "vadd.inc"
diff --git a/src/packlib/kernlib/kernnum/f002fort/dvscl.F b/src/packlib/kernlib/kernnum/f002fort/dvscl.F
deleted file mode 100644
index b891972..0000000
--- a/src/packlib/kernlib/kernnum/f002fort/dvscl.F
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: dvscl.F,v 1.1.1.1 1996/02/15 17:48:52 mclareni Exp $
-*
-* $Log: dvscl.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:52 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE DVSCL(N,S,X,X2,Z,Z2)
- DOUBLE PRECISION S, X(*), X2(*), Z(*), Z2(*), FUNCT, A
- FUNCT(A) = S*A
- IF(N .LE. 0) RETURN
-#include "dxj.inc"
-#include "dzj.inc"
-#include "vcpy.inc"
diff --git a/src/packlib/kernlib/kernnum/f002fort/dvscs.F b/src/packlib/kernlib/kernnum/f002fort/dvscs.F
deleted file mode 100644
index 904cdc1..0000000
--- a/src/packlib/kernlib/kernnum/f002fort/dvscs.F
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: dvscs.F,v 1.1.1.1 1996/02/15 17:48:53 mclareni Exp $
-*
-* $Log: dvscs.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:53 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE DVSCS(N,S,X,X2,Y,Y2,Z,Z2)
- DOUBLE PRECISION S, X(*), X2(*), Y(*), Y2(*), Z(*), Z2(*)
- DOUBLE PRECISION ADD, A, B
- ADD(A,B) = S*A - B
- IF(N .LE. 0) RETURN
-#include "dxj.inc"
-#include "dyj.inc"
-#include "dzj.inc"
-#include "vadd.inc"
diff --git a/src/packlib/kernlib/kernnum/f002fort/dvset.F b/src/packlib/kernlib/kernnum/f002fort/dvset.F
deleted file mode 100644
index f27d5e8..0000000
--- a/src/packlib/kernlib/kernnum/f002fort/dvset.F
+++ /dev/null
@@ -1,14 +0,0 @@
-*
-* $Id: dvset.F,v 1.1.1.1 1996/02/15 17:48:53 mclareni Exp $
-*
-* $Log: dvset.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:53 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE DVSET(N,S,Z,Z2)
- DOUBLE PRECISION S, Z(*), Z2(*)
- IF(N .LE. 0) RETURN
-#include "dzj.inc"
-#include "vset.inc"
diff --git a/src/packlib/kernlib/kernnum/f002fort/dvsub.F b/src/packlib/kernlib/kernnum/f002fort/dvsub.F
deleted file mode 100644
index b13a696..0000000
--- a/src/packlib/kernlib/kernnum/f002fort/dvsub.F
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: dvsub.F,v 1.1.1.1 1996/02/15 17:48:53 mclareni Exp $
-*
-* $Log: dvsub.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:53 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE DVSUB(N,X,X2,Y,Y2,Z,Z2)
- DOUBLE PRECISION X(*), X2(*), Y(*), Y2(*), Z(*), Z2(*)
- DOUBLE PRECISION ADD, A, B
- ADD(A,B) = A-B
- IF(N .LE. 0) RETURN
-#include "dxj.inc"
-#include "dyj.inc"
-#include "dzj.inc"
-#include "vadd.inc"
diff --git a/src/packlib/kernlib/kernnum/f002fort/dvsum.F b/src/packlib/kernlib/kernnum/f002fort/dvsum.F
deleted file mode 100644
index b78edf6..0000000
--- a/src/packlib/kernlib/kernnum/f002fort/dvsum.F
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: dvsum.F,v 1.1.1.1 1996/02/15 17:48:53 mclareni Exp $
-*
-* $Log: dvsum.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:53 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- DOUBLE PRECISION FUNCTION DVSUM(N,X,X2)
- DOUBLE PRECISION X(*), X2(*), SUM
- SUM = 0.D0
- IF(N .LE. 0) GOTO 20
-#include "dxj.inc"
- LXJ = 1
- DO 10 J = 1, N
- SUM = SUM + X(LXJ)
- LXJ = LXJ + JX
- 10 CONTINUE
- 20 DVSUM = SUM
- RETURN
- END
diff --git a/src/packlib/kernlib/kernnum/f002fort/dvxch.F b/src/packlib/kernlib/kernnum/f002fort/dvxch.F
deleted file mode 100644
index 761fc93..0000000
--- a/src/packlib/kernlib/kernnum/f002fort/dvxch.F
+++ /dev/null
@@ -1,15 +0,0 @@
-*
-* $Id: dvxch.F,v 1.1.1.1 1996/02/15 17:48:53 mclareni Exp $
-*
-* $Log: dvxch.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:53 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE DVXCH(N,X,X2,Y,Y2)
- DOUBLE PRECISION X(*), X2(*), Y(*), Y2(*), T
- IF(N .LE. 0) RETURN
-#include "dxj.inc"
-#include "dyj.inc"
-#include "vxch.inc"
diff --git a/src/packlib/kernlib/kernnum/f002fort/dxj.inc b/src/packlib/kernlib/kernnum/f002fort/dxj.inc
deleted file mode 100644
index 4d84d92..0000000
--- a/src/packlib/kernlib/kernnum/f002fort/dxj.inc
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: dxj.inc,v 1.1.1.1 1996/02/15 17:48:50 mclareni Exp $
-*
-* $Log: dxj.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:50 mclareni
-* Kernlib
-*
-*
-*
-* dxj.inc
-*
-#if defined(CERNLIB_NUMAP)||defined(CERNLIB_NUMCD)||defined(CERNLIB_NUMCV)||defined(CERNLIB_NUMIB2)||defined(CERNLIB_NUMND)
- JX = (LOCF(X2) - LOCF(X)) / 2
-#endif
-#if defined(CERNLIB_NUMCR)||defined(CERNLIB_NUMUC)
- JX = (LOC(X2) - LOC(X)) / 2
-#endif
-#if defined(CERNLIB_NUMDE)
- JX = (%LOC(X2) - %LOC(X)) / 8
-#endif
-#if defined(CERNLIB_NUMIB1)
- JX = (IADDR(X2) - IADDR(X)) / 8
-#endif
diff --git a/src/packlib/kernlib/kernnum/f002fort/dyj.inc b/src/packlib/kernlib/kernnum/f002fort/dyj.inc
deleted file mode 100644
index 4404a41..0000000
--- a/src/packlib/kernlib/kernnum/f002fort/dyj.inc
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: dyj.inc,v 1.1.1.1 1996/02/15 17:48:50 mclareni Exp $
-*
-* $Log: dyj.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:50 mclareni
-* Kernlib
-*
-*
-*
-* dyj.inc
-*
-#if defined(CERNLIB_NUMAP)||defined(CERNLIB_NUMCD)||defined(CERNLIB_NUMCV)||defined(CERNLIB_NUMIB2)||defined(CERNLIB_NUMND)
- JY = (LOCF(Y2) - LOCF(Y)) / 2
-#endif
-#if defined(CERNLIB_NUMCR)||defined(CERNLIB_NUMUC)
- JY = (LOC(Y2) - LOC(Y)) / 2
-#endif
-#if defined(CERNLIB_NUMDE)
- JY = (%LOC(Y2) - %LOC(Y)) / 8
-#endif
-#if defined(CERNLIB_NUMIB1)
- JY = (IADDR(Y2) - IADDR(Y)) / 8
-#endif
diff --git a/src/packlib/kernlib/kernnum/f002fort/dzj.inc b/src/packlib/kernlib/kernnum/f002fort/dzj.inc
deleted file mode 100644
index 2dc22fe..0000000
--- a/src/packlib/kernlib/kernnum/f002fort/dzj.inc
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: dzj.inc,v 1.1.1.1 1996/02/15 17:48:50 mclareni Exp $
-*
-* $Log: dzj.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:50 mclareni
-* Kernlib
-*
-*
-*
-* dzj.inc
-*
-#if defined(CERNLIB_NUMAP)||defined(CERNLIB_NUMCD)||defined(CERNLIB_NUMCV)||defined(CERNLIB_NUMIB2)||defined(CERNLIB_NUMND)
- JZ = (LOCF(Z2) - LOCF(Z)) / 2
-#endif
-#if defined(CERNLIB_NUMCR)||defined(CERNLIB_NUMUC)
- JZ = (LOC(Z2) - LOC(Z)) / 2
-#endif
-#if defined(CERNLIB_NUMDE)
- JZ = (%LOC(Z2) - %LOC(Z)) / 8
-#endif
-#if defined(CERNLIB_NUMIB1)
- JZ = (IADDR(Z2) - IADDR(Z)) / 8
-#endif
diff --git a/src/packlib/kernlib/kernnum/f002fort/rvadd.F b/src/packlib/kernlib/kernnum/f002fort/rvadd.F
deleted file mode 100644
index 6c6cee7..0000000
--- a/src/packlib/kernlib/kernnum/f002fort/rvadd.F
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: rvadd.F,v 1.1.1.1 1996/02/15 17:48:51 mclareni Exp $
-*
-* $Log: rvadd.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:51 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE RVADD(N,X,X2,Y,Y2,Z,Z2)
- REAL X(*), X2(*), Y(*), Y2(*), Z(*), Z2(*)
- REAL ADD, A, B
- ADD(A,B) = A+B
- IF(N .LE. 0) RETURN
-#include "rxj.inc"
-#include "ryj.inc"
-#include "rzj.inc"
-#include "vadd.inc"
diff --git a/src/packlib/kernlib/kernnum/f002fort/rvcpy.F b/src/packlib/kernlib/kernnum/f002fort/rvcpy.F
deleted file mode 100644
index c188569..0000000
--- a/src/packlib/kernlib/kernnum/f002fort/rvcpy.F
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: rvcpy.F,v 1.1.1.1 1996/02/15 17:48:51 mclareni Exp $
-*
-* $Log: rvcpy.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:51 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE RVCPY(N,X,X2,Z,Z2)
- REAL X(*), X2(*), Z(*), Z2(*), FUNCT, A
- FUNCT(A) = A
- IF(N .LE. 0) RETURN
-#include "rxj.inc"
-#include "rzj.inc"
-#include "vcpy.inc"
diff --git a/src/packlib/kernlib/kernnum/f002fort/rvdiv.F b/src/packlib/kernlib/kernnum/f002fort/rvdiv.F
deleted file mode 100644
index fdec4b7..0000000
--- a/src/packlib/kernlib/kernnum/f002fort/rvdiv.F
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: rvdiv.F,v 1.1.1.1 1996/02/15 17:48:51 mclareni Exp $
-*
-* $Log: rvdiv.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:51 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE RVDIV(N,X,X2,Y,Y2,Z,Z2,IFAIL)
- REAL X(*), X2(*), Y(*), Y2(*), Z(*), Z2(*), T
- REALF(T) = T
- IFAIL = 0
- IF(N .LE. 0) RETURN
-#include "rxj.inc"
-#include "ryj.inc"
-#include "rzj.inc"
-#include "vdiv.inc"
diff --git a/src/packlib/kernlib/kernnum/f002fort/rvmpa.F b/src/packlib/kernlib/kernnum/f002fort/rvmpa.F
deleted file mode 100644
index 474ea61..0000000
--- a/src/packlib/kernlib/kernnum/f002fort/rvmpa.F
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: rvmpa.F,v 1.1.1.1 1996/02/15 17:48:51 mclareni Exp $
-*
-* $Log: rvmpa.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:51 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- REAL FUNCTION RVMPA(N,X,X2,Y,Y2,S)
- REAL X(*), X2(*), Y(*), Y2(*), S, A, B
-#if defined(CERNLIB_NUMRDBLE)
- DOUBLE PRECISION SUM, MPA
- MPA(A,B,SUM) = DBLE(A)*DBLE(B) + SUM
-#endif
-#if !defined(CERNLIB_NUMRDBLE)
- REAL SUM, MPA
- MPA(A,B,SUM) = A*B + SUM
-#endif
- SUM = S
- IF(N .LE. 0) GOTO 20
-#include "rxj.inc"
-#include "ryj.inc"
-#include "vmpa.inc"
- 20 RVMPA = SUM
- RETURN
- END
diff --git a/src/packlib/kernlib/kernnum/f002fort/rvmpy.F b/src/packlib/kernlib/kernnum/f002fort/rvmpy.F
deleted file mode 100644
index 8debec5..0000000
--- a/src/packlib/kernlib/kernnum/f002fort/rvmpy.F
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: rvmpy.F,v 1.1.1.1 1996/02/15 17:48:51 mclareni Exp $
-*
-* $Log: rvmpy.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:51 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- REAL FUNCTION RVMPY(N,X,X2,Y,Y2)
- REAL X(*), X2(*), Y(*), Y2(*), A, B
-#if defined(CERNLIB_NUMRDBLE)
- DOUBLE PRECISION SUM, MPA
- MPA(A,B,SUM) = DBLE(A)*DBLE(B) + SUM
-#endif
-#if !defined(CERNLIB_NUMRDBLE)
- REAL SUM, MPA
- MPA(A,B,SUM) = A*B + SUM
-#endif
- SUM = 0.
- IF(N .LE. 0) GOTO 20
-#include "rxj.inc"
-#include "ryj.inc"
-#include "vmpa.inc"
- 20 RVMPY = SUM
- RETURN
- END
diff --git a/src/packlib/kernlib/kernnum/f002fort/rvmul.F b/src/packlib/kernlib/kernnum/f002fort/rvmul.F
deleted file mode 100644
index 2054a11..0000000
--- a/src/packlib/kernlib/kernnum/f002fort/rvmul.F
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: rvmul.F,v 1.1.1.1 1996/02/15 17:48:52 mclareni Exp $
-*
-* $Log: rvmul.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:52 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE RVMUL(N,X,X2,Y,Y2,Z,Z2)
- REAL X(*), X2(*), Y(*), Y2(*), Z(*), Z2(*)
- REAL ADD, A, B
- ADD(A,B) = A*B
- IF(N .LE. 0) RETURN
-#include "rxj.inc"
-#include "ryj.inc"
-#include "rzj.inc"
-#include "vadd.inc"
diff --git a/src/packlib/kernlib/kernnum/f002fort/rvmula.F b/src/packlib/kernlib/kernnum/f002fort/rvmula.F
deleted file mode 100644
index 7538f2d..0000000
--- a/src/packlib/kernlib/kernnum/f002fort/rvmula.F
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: rvmula.F,v 1.1.1.1 1996/02/15 17:48:52 mclareni Exp $
-*
-* $Log: rvmula.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:52 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE RVMULA(N,X,X2,Y,Y2,Z,Z2)
- REAL X(*), X2(*), Y(*), Y2(*), Z(*), Z2(*)
- REAL MULA, A, B, C
- MULA(A,B,C) = A*B + C
- IF(N .LE. 0) RETURN
-#include "rxj.inc"
-#include "ryj.inc"
-#include "rzj.inc"
-#include "vmula.inc"
diff --git a/src/packlib/kernlib/kernnum/f002fort/rvmuna.F b/src/packlib/kernlib/kernnum/f002fort/rvmuna.F
deleted file mode 100644
index 485a416..0000000
--- a/src/packlib/kernlib/kernnum/f002fort/rvmuna.F
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: rvmuna.F,v 1.1.1.1 1996/02/15 17:48:52 mclareni Exp $
-*
-* $Log: rvmuna.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:52 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE RVMUNA(N,X,X2,Y,Y2,Z,Z2)
- REAL X(*), X2(*), Y(*), Y2(*), Z(*), Z2(*)
- REAL MULA, A, B, C
- MULA(A,B,C) = -A*B + C
- IF(N .LE. 0) RETURN
-#include "rxj.inc"
-#include "ryj.inc"
-#include "rzj.inc"
-#include "vmula.inc"
diff --git a/src/packlib/kernlib/kernnum/f002fort/rvran.F b/src/packlib/kernlib/kernnum/f002fort/rvran.F
deleted file mode 100644
index 6eec4c6..0000000
--- a/src/packlib/kernlib/kernnum/f002fort/rvran.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: rvran.F,v 1.1.1.1 1996/02/15 17:48:52 mclareni Exp $
-*
-* $Log: rvran.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:52 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE RVRAN(N,A,B,Z,Z2)
- REAL A, B, C, Z(*), Z2(*)
- IF(N .LE. 0) RETURN
- LZJ = 1
-#include "rzj.inc"
- C = B - A
- DO 10 J = 1, N
- Z(LZJ) = C*RANF() + A
- LZJ = LZJ + JZ
- 10 CONTINUE
- RETURN
- END
diff --git a/src/packlib/kernlib/kernnum/f002fort/rvsca.F b/src/packlib/kernlib/kernnum/f002fort/rvsca.F
deleted file mode 100644
index 7ef7225..0000000
--- a/src/packlib/kernlib/kernnum/f002fort/rvsca.F
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: rvsca.F,v 1.1.1.1 1996/02/15 17:48:52 mclareni Exp $
-*
-* $Log: rvsca.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:52 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE RVSCA(N,S,X,X2,Y,Y2,Z,Z2)
- REAL S, X(*), X2(*), Y(*), Y2(*), Z(*), Z2(*)
- REAL ADD, A, B
- ADD(A,B) = S*A + B
- IF(N .LE. 0) RETURN
-#include "rxj.inc"
-#include "ryj.inc"
-#include "rzj.inc"
-#include "vadd.inc"
diff --git a/src/packlib/kernlib/kernnum/f002fort/rvscl.F b/src/packlib/kernlib/kernnum/f002fort/rvscl.F
deleted file mode 100644
index d59aae4..0000000
--- a/src/packlib/kernlib/kernnum/f002fort/rvscl.F
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: rvscl.F,v 1.1.1.1 1996/02/15 17:48:52 mclareni Exp $
-*
-* $Log: rvscl.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:52 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE RVSCL(N,S,X,X2,Z,Z2)
- REAL S, X(*), X2(*), Z(*), Z2(*), FUNCT, A
- FUNCT(A) = S*A
- IF(N .LE. 0) RETURN
-#include "rxj.inc"
-#include "rzj.inc"
-#include "vcpy.inc"
diff --git a/src/packlib/kernlib/kernnum/f002fort/rvscs.F b/src/packlib/kernlib/kernnum/f002fort/rvscs.F
deleted file mode 100644
index cefd49e..0000000
--- a/src/packlib/kernlib/kernnum/f002fort/rvscs.F
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: rvscs.F,v 1.1.1.1 1996/02/15 17:48:52 mclareni Exp $
-*
-* $Log: rvscs.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:52 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE RVSCS(N,S,X,X2,Y,Y2,Z,Z2)
- REAL S, X(*), X2(*), Y(*), Y2(*), Z(*), Z2(*)
- REAL ADD, A, B
- ADD(A,B) = S*A - B
- IF(N .LE. 0) RETURN
-#include "rxj.inc"
-#include "ryj.inc"
-#include "rzj.inc"
-#include "vadd.inc"
diff --git a/src/packlib/kernlib/kernnum/f002fort/rvset.F b/src/packlib/kernlib/kernnum/f002fort/rvset.F
deleted file mode 100644
index 4b496c4..0000000
--- a/src/packlib/kernlib/kernnum/f002fort/rvset.F
+++ /dev/null
@@ -1,14 +0,0 @@
-*
-* $Id: rvset.F,v 1.1.1.1 1996/02/15 17:48:53 mclareni Exp $
-*
-* $Log: rvset.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:53 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE RVSET(N,S,Z,Z2)
- REAL S, Z(*), Z2(*)
- IF(N .LE. 0) RETURN
-#include "rzj.inc"
-#include "vset.inc"
diff --git a/src/packlib/kernlib/kernnum/f002fort/rvsub.F b/src/packlib/kernlib/kernnum/f002fort/rvsub.F
deleted file mode 100644
index 230976b..0000000
--- a/src/packlib/kernlib/kernnum/f002fort/rvsub.F
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: rvsub.F,v 1.1.1.1 1996/02/15 17:48:53 mclareni Exp $
-*
-* $Log: rvsub.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:53 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE RVSUB(N,X,X2,Y,Y2,Z,Z2)
- REAL X(*), X2(*), Y(*), Y2(*), Z(*), Z2(*)
- REAL ADD, A, B
- ADD(A,B) = A-B
- IF(N .LE. 0) RETURN
-#include "rxj.inc"
-#include "ryj.inc"
-#include "rzj.inc"
-#include "vadd.inc"
diff --git a/src/packlib/kernlib/kernnum/f002fort/rvsum.F b/src/packlib/kernlib/kernnum/f002fort/rvsum.F
deleted file mode 100644
index 1fc42be..0000000
--- a/src/packlib/kernlib/kernnum/f002fort/rvsum.F
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: rvsum.F,v 1.1.1.1 1996/02/15 17:48:53 mclareni Exp $
-*
-* $Log: rvsum.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:53 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- REAL FUNCTION RVSUM(N,X,X2)
- REAL X(*), X2(*), SUM
- SUM = 0.
- IF(N .LE. 0) GOTO 20
-#include "rxj.inc"
- LXJ = 1
- DO 10 J = 1, N
- SUM = SUM + X(LXJ)
- LXJ = LXJ + JX
- 10 CONTINUE
- 20 RVSUM = SUM
- RETURN
- END
diff --git a/src/packlib/kernlib/kernnum/f002fort/rvxch.F b/src/packlib/kernlib/kernnum/f002fort/rvxch.F
deleted file mode 100644
index 0b6972b..0000000
--- a/src/packlib/kernlib/kernnum/f002fort/rvxch.F
+++ /dev/null
@@ -1,15 +0,0 @@
-*
-* $Id: rvxch.F,v 1.1.1.1 1996/02/15 17:48:53 mclareni Exp $
-*
-* $Log: rvxch.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:53 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE RVXCH(N,X,X2,Y,Y2)
- REAL X(*), X2(*), Y(*), Y2(*), T
- IF(N .LE. 0) RETURN
-#include "rxj.inc"
-#include "ryj.inc"
-#include "vxch.inc"
diff --git a/src/packlib/kernlib/kernnum/f002fort/rxj.inc b/src/packlib/kernlib/kernnum/f002fort/rxj.inc
deleted file mode 100644
index a054a72..0000000
--- a/src/packlib/kernlib/kernnum/f002fort/rxj.inc
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: rxj.inc,v 1.1.1.1 1996/02/15 17:48:50 mclareni Exp $
-*
-* $Log: rxj.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:50 mclareni
-* Kernlib
-*
-*
-*
-* rxj.inc
-*
-#if defined(CERNLIB_NUMAP)||defined(CERNLIB_NUMCD)||defined(CERNLIB_NUMCV)||defined(CERNLIB_NUMIB2)||defined(CERNLIB_NUMND)
- JX = LOCF(X2) - LOCF(X)
-#endif
-#if defined(CERNLIB_NUMCR)||defined(CERNLIB_NUMUC)
- JX = LOC(X2) - LOC(X)
-#endif
-#if defined(CERNLIB_NUMDE)
- JX = (%LOC(X2) - %LOC(X)) / 4
-#endif
-#if defined(CERNLIB_NUMIB1)
- JX = (IADDR(X2) - IADDR(X)) / 4
-#endif
diff --git a/src/packlib/kernlib/kernnum/f002fort/ryj.inc b/src/packlib/kernlib/kernnum/f002fort/ryj.inc
deleted file mode 100644
index f21ac76..0000000
--- a/src/packlib/kernlib/kernnum/f002fort/ryj.inc
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: ryj.inc,v 1.1.1.1 1996/02/15 17:48:50 mclareni Exp $
-*
-* $Log: ryj.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:50 mclareni
-* Kernlib
-*
-*
-*
-* ryj.inc
-*
-#if defined(CERNLIB_NUMAP)||defined(CERNLIB_NUMCD)||defined(CERNLIB_NUMCV)||defined(CERNLIB_NUMIB2)||defined(CERNLIB_NUMND)
- JY = LOCF(Y2) - LOCF(Y)
-#endif
-#if defined(CERNLIB_NUMCR)||defined(CERNLIB_NUMUC)
- JY = LOC(Y2) - LOC(Y)
-#endif
-#if defined(CERNLIB_NUMDE)
- JY = (%LOC(Y2) - %LOC(Y)) / 4
-#endif
-#if defined(CERNLIB_NUMIB1)
- JY = (IADDR(Y2) - IADDR(Y)) / 4
-#endif
diff --git a/src/packlib/kernlib/kernnum/f002fort/rzj.inc b/src/packlib/kernlib/kernnum/f002fort/rzj.inc
deleted file mode 100644
index 402377e..0000000
--- a/src/packlib/kernlib/kernnum/f002fort/rzj.inc
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: rzj.inc,v 1.1.1.1 1996/02/15 17:48:50 mclareni Exp $
-*
-* $Log: rzj.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:50 mclareni
-* Kernlib
-*
-*
-*
-* rzj.inc
-*
-#if defined(CERNLIB_NUMAP)||defined(CERNLIB_NUMCD)||defined(CERNLIB_NUMCV)||defined(CERNLIB_NUMIB2)||defined(CERNLIB_NUMND)
- JZ = LOCF(Z2) - LOCF(Z)
-#endif
-#if defined(CERNLIB_NUMCR)||defined(CERNLIB_NUMUC)
- JZ = LOC(Z2) - LOC(Z)
-#endif
-#if defined(CERNLIB_NUMDE)
- JZ = (%LOC(Z2) - %LOC(Z)) / 4
-#endif
-#if defined(CERNLIB_NUMIB1)
- JZ = (IADDR(Z2) - IADDR(Z)) / 4
-#endif
diff --git a/src/packlib/kernlib/kernnum/f002fort/vadd.inc b/src/packlib/kernlib/kernnum/f002fort/vadd.inc
deleted file mode 100644
index d66a7ba..0000000
--- a/src/packlib/kernlib/kernnum/f002fort/vadd.inc
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: vadd.inc,v 1.1.1.1 1996/02/15 17:48:50 mclareni Exp $
-*
-* $Log: vadd.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:50 mclareni
-* Kernlib
-*
-*
-*
-* vadd.inc
-*
- LXJ = 1
- LYJ = 1
- LZJ = 1
- DO 10 J = 1, N
- Z(LZJ) = ADD( X(LXJ),Y(LYJ) )
- LXJ = LXJ + JX
- LYJ = LYJ + JY
- LZJ = LZJ + JZ
- 10 CONTINUE
- RETURN
- END
diff --git a/src/packlib/kernlib/kernnum/f002fort/vcpy.inc b/src/packlib/kernlib/kernnum/f002fort/vcpy.inc
deleted file mode 100644
index 3cf7463..0000000
--- a/src/packlib/kernlib/kernnum/f002fort/vcpy.inc
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: vcpy.inc,v 1.1.1.1 1996/02/15 17:48:50 mclareni Exp $
-*
-* $Log: vcpy.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:50 mclareni
-* Kernlib
-*
-*
-*
-* vcpy.inc
-*
- LXJ = 1
- LZJ = 1
- DO 10 J = 1, N
- Z(LZJ) = FUNCT( X(LXJ) )
- LXJ = LXJ + JX
- LZJ = LZJ + JZ
- 10 CONTINUE
- RETURN
- END
diff --git a/src/packlib/kernlib/kernnum/f002fort/vdiv.inc b/src/packlib/kernlib/kernnum/f002fort/vdiv.inc
deleted file mode 100644
index 66b27d8..0000000
--- a/src/packlib/kernlib/kernnum/f002fort/vdiv.inc
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: vdiv.inc,v 1.1.1.1 1996/02/15 17:48:51 mclareni Exp $
-*
-* $Log: vdiv.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:51 mclareni
-* Kernlib
-*
-*
-*
-* vdiv.inc
-*
- LXJ = 1
- LYJ = 1
- LZJ = 1
- DO 10 J = 1, N
- IF(REALF(Y(LYJ)) .EQ. 0.) GOTO 20
- Z(LZJ) = X(LXJ) / Y(LYJ)
- LXJ = LXJ + JX
- LYJ = LYJ + JY
- LZJ = LZJ + JZ
- 10 CONTINUE
- J = 0
- 20 IFAIL = J
- RETURN
- END
diff --git a/src/packlib/kernlib/kernnum/f002fort/vmpa.inc b/src/packlib/kernlib/kernnum/f002fort/vmpa.inc
deleted file mode 100644
index 7fba329..0000000
--- a/src/packlib/kernlib/kernnum/f002fort/vmpa.inc
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: vmpa.inc,v 1.1.1.1 1996/02/15 17:48:51 mclareni Exp $
-*
-* $Log: vmpa.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:51 mclareni
-* Kernlib
-*
-*
-*
-* vmpa.inc
-*
- LXJ = 1
- LYJ = 1
- DO 10 J = 1, N
- SUM = MPA( X(LXJ),Y(LYJ), SUM)
- LXJ = LXJ + JX
- LYJ = LYJ + JY
- 10 CONTINUE
diff --git a/src/packlib/kernlib/kernnum/f002fort/vmula.inc b/src/packlib/kernlib/kernnum/f002fort/vmula.inc
deleted file mode 100644
index ad21922..0000000
--- a/src/packlib/kernlib/kernnum/f002fort/vmula.inc
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: vmula.inc,v 1.1.1.1 1996/02/15 17:48:51 mclareni Exp $
-*
-* $Log: vmula.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:51 mclareni
-* Kernlib
-*
-*
-*
-* vmula.inc
-*
- LXJ = 1
- LYJ = 1
- LZJ = 1
- DO 10 J = 1, N
- Z(LZJ) = MULA( X(LXJ),Y(LYJ),Z(LZJ) )
- LXJ = LXJ + JX
- LYJ = LYJ + JY
- LZJ = LZJ + JZ
- 10 CONTINUE
- RETURN
- END
diff --git a/src/packlib/kernlib/kernnum/f002fort/vset.inc b/src/packlib/kernlib/kernnum/f002fort/vset.inc
deleted file mode 100644
index 658d434..0000000
--- a/src/packlib/kernlib/kernnum/f002fort/vset.inc
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: vset.inc,v 1.1.1.1 1996/02/15 17:48:51 mclareni Exp $
-*
-* $Log: vset.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:51 mclareni
-* Kernlib
-*
-*
-*
-* vset.inc
-*
- LZJ = 1
- DO 10 J = 1, N
- Z(LZJ) = S
- LZJ = LZJ + JZ
- 10 CONTINUE
- RETURN
- END
diff --git a/src/packlib/kernlib/kernnum/f002fort/vxch.inc b/src/packlib/kernlib/kernnum/f002fort/vxch.inc
deleted file mode 100644
index f89ea66..0000000
--- a/src/packlib/kernlib/kernnum/f002fort/vxch.inc
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: vxch.inc,v 1.1.1.1 1996/02/15 17:48:51 mclareni Exp $
-*
-* $Log: vxch.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:51 mclareni
-* Kernlib
-*
-*
-*
-* vxch.inc
-*
- LXJ = 1
- LYJ = 1
- DO 10 J = 1, N
- T = X(LXJ)
- X(LXJ) = Y(LYJ)
- Y(LYJ) = T
- LXJ = LXJ + JX
- LYJ = LYJ + JY
- 10 CONTINUE
- RETURN
- END
diff --git a/src/packlib/kernlib/kernnum/f003fort/Imakefile b/src/packlib/kernlib/kernnum/f003fort/Imakefile
deleted file mode 100644
index 5a969bc..0000000
--- a/src/packlib/kernlib/kernnum/f003fort/Imakefile
+++ /dev/null
@@ -1,20 +0,0 @@
-SRCS_F= ccmmpy.F ccumpy.F cmadd.F cmbil.F cmcpy.F cmmna.F cmmns.F cmmpa.F \ @@\
- cmmps.F cmmpy.F cmmpyc.F cmran.F cmscl.F cmset.F cmsub.F cmutl.F \ @@\
- crscl.F cumna.F cumns.F cumpa.F cumps.F cumpy.F cumpyc.F dmadd.F \ @@\
- dmbil.F dmcpy.F dmmna.F dmmns.F dmmpa.F dmmps.F dmmpy.F dmran.F \ @@\
- dmscl.F dmset.F dmsub.F dmutl.F drscl.F dumna.F dumns.F dumpa.F \ @@\
- dumps.F dumpy.F rmadd.F rmbil.F rmcpy.F rmmna.F rmmns.F rmmpa.F \ @@\
- rmmps.F rmmpy.F rmran.F rmscl.F rmset.F rmsub.F rmutl.F rrscl.F \ @@\
- rumna.F rumns.F rumpa.F rumps.F rumpy.F
-
-#if defined(CERNLIB_DECS) && ! defined(CERNLIB_QMVAOS)
-FDEBUGFLAGS=NoOpFortranDebugFlags
-#endif
-
-#if defined(CERNLIB_MACOSX)
-FDEBUGFLAGS := -O0 $(FDEBUGFLAGS) -O0
-#endif
-
-FORTRANSAVEOPTION=FortranSaveFlags
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kernnum/f003fort/ccmmpy.F b/src/packlib/kernlib/kernnum/f003fort/ccmmpy.F
deleted file mode 100644
index aca3404..0000000
--- a/src/packlib/kernlib/kernnum/f003fort/ccmmpy.F
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: ccmmpy.F,v 1.1.1.1 1996/02/15 17:48:58 mclareni Exp $
-*
-* $Log: ccmmpy.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:58 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE CCMMPY(M,N,X,X12,X21,Y,Y2,Z,Z2)
- COMPLEX X(*),X12(*),X21(*),Y(*),Y2(*),Z(*),Z2(*)
- COMPLEX A, B
-#if !defined(CERNLIB_NUMCDBLE)
- COMPLEX SUM, ZERO, F
- F(A,B,SUM) = CONJG(A)*B + SUM
- DATA ZERO / (0.,0.) /
-#endif
-#if (defined(CERNLIB_NUMCDBLE))&&(!defined(CERNLIB_NUMND))
- COMPLEX*16 SUM, ZERO, DC, F
- DC(A) = DCMPLX(DBLE(REAL(A)),DBLE(AIMAG(A)))
- F(A,B,SUM) = DCONJG(DC(A))*DC(B) + SUM
- DATA ZERO / (0.D0,0.D0) /
-#endif
-#if (defined(CERNLIB_NUMCDBLE))&&(defined(CERNLIB_NUMND))
- COMPLEX*16 SUM, ZERO, DC, F
- DC(A) = DCMPLX(DBLE(REAL(A)),DBLE(AIMAG(A)))
- F(A,B,SUM) = CDCONJG(DC(A))*DC(B) + SUM
- DATA ZERO / (0.D0,0.D0) /
-#endif
- IF(M .LE. 0 .OR. N .LE. 0) RETURN
-#include "cxij.inc"
-#include "cyj.inc"
-#include "czi.inc"
-#include "mmpy.inc"
diff --git a/src/packlib/kernlib/kernnum/f003fort/ccumpy.F b/src/packlib/kernlib/kernnum/f003fort/ccumpy.F
deleted file mode 100644
index 9da0ebc..0000000
--- a/src/packlib/kernlib/kernnum/f003fort/ccumpy.F
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: ccumpy.F,v 1.1.1.1 1996/02/15 17:49:00 mclareni Exp $
-*
-* $Log: ccumpy.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:00 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE CCUMPY(N,U,U12,U22,Y,Y2,Z,Z2)
- COMPLEX U(*),U12(*),U22(*),Y(*),Y2(*),Z(*),Z2(*)
- COMPLEX A, B
-#if !defined(CERNLIB_NUMCDBLE)
- COMPLEX SUM, ZERO, F
- F(A,B,SUM) = CONJG(A)*B + SUM
- DATA ZERO / (0.,0.) /
-#endif
-#if (defined(CERNLIB_NUMCDBLE))&&(!defined(CERNLIB_NUMND))
- COMPLEX*16 SUM, ZERO, DC, F
- DC(A) = DCMPLX(DBLE(REAL(A)),DBLE(AIMAG(A)))
- F(A,B,SUM) = DCONJG(DC(A))*DC(B) + SUM
- DATA ZERO / (0.D0,0.D0) /
-#endif
-#if (defined(CERNLIB_NUMCDBLE))&&(defined(CERNLIB_NUMND))
- COMPLEX*16 SUM, ZERO, DC, F
- DC(A) = DCMPLX(DBLE(REAL(A)),DBLE(AIMAG(A)))
- F(A,B,SUM) = CDCONJG(DC(A))*DC(B) + SUM
- DATA ZERO / (0.D0,0.D0) /
-#endif
- IF(N .LE. 0) RETURN
-#include "cujk.inc"
-#include "cyj.inc"
-#include "czi.inc"
-#include "umpy.inc"
diff --git a/src/packlib/kernlib/kernnum/f003fort/cdi.inc b/src/packlib/kernlib/kernnum/f003fort/cdi.inc
deleted file mode 100644
index b7880de..0000000
--- a/src/packlib/kernlib/kernnum/f003fort/cdi.inc
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: cdi.inc,v 1.1.1.1 1996/02/15 17:48:54 mclareni Exp $
-*
-* $Log: cdi.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:54 mclareni
-* Kernlib
-*
-*
-*
-* cdi.inc
-*
-#if defined(CERNLIB_NUMAP)||defined(CERNLIB_NUMCD)||defined(CERNLIB_NUMCV)||defined(CERNLIB_NUMIB2)||defined(CERNLIB_NUMND)
- ID = (LOCF(D2) - LOCF(D)) / 2
-#endif
-#if defined(CERNLIB_NUMCR)||defined(CERNLIB_NUMUC)
- ID = (LOC(D2) - LOC(D)) / 2
-#endif
-#if defined(CERNLIB_NUMDE)
- ID = (%LOC(D2) - %LOC(D)) / 8
-#endif
-#if defined(CERNLIB_NUMIB1)
- ID = (IADDR(D2) - IADDR(D)) / 8
-#endif
diff --git a/src/packlib/kernlib/kernnum/f003fort/cmadd.F b/src/packlib/kernlib/kernnum/f003fort/cmadd.F
deleted file mode 100644
index 4862de5..0000000
--- a/src/packlib/kernlib/kernnum/f003fort/cmadd.F
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: cmadd.F,v 1.1.1.1 1996/02/15 17:48:56 mclareni Exp $
-*
-* $Log: cmadd.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:56 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE CMADD(M,N,X,X12,X21,Y,Y12,Y21,Z,Z12,Z21)
- COMPLEX X(*), X12(*), X21(*), Y(*), Y12(*), Y21(*)
- COMPLEX Z(*), Z12(*), Z21(*), ADD, A, B
- ADD(A,B) = A+B
- IF(M .LE. 0 .OR. N .LE. 0) RETURN
-#include "cxij.inc"
-#include "cyij.inc"
-#include "czij.inc"
-#include "madd.inc"
diff --git a/src/packlib/kernlib/kernnum/f003fort/cmbil.F b/src/packlib/kernlib/kernnum/f003fort/cmbil.F
deleted file mode 100644
index e65d428..0000000
--- a/src/packlib/kernlib/kernnum/f003fort/cmbil.F
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: cmbil.F,v 1.1.1.1 1996/02/15 17:48:56 mclareni Exp $
-*
-* $Log: cmbil.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:56 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- COMPLEX FUNCTION CMBIL(N,X,X2,Y,Y12,Y21,Z,Z2)
- COMPLEX X(*),X2(*),Y(*),Y12(*),Y21(*),Z(*),Z2(*)
- COMPLEX A, B
-#if !defined(CERNLIB_NUMCDBLE)
- COMPLEX SUM, ZERO, F, G, SXYZ, SYZ
- F(A,B,SUM) = A*B + SUM
- G(SYZ,B,SUM)= SYZ*B + SUM
- DATA ZERO / (0.,0.) /
-#endif
-#if defined(CERNLIB_NUMCDBLE)
- COMPLEX*16 SUM, ZERO, DC, F, G, SXYZ, SYZ
- DC(A) = DCMPLX(DBLE(REAL(A)),DBLE(AIMAG(A)))
- F(A,B,SUM) = DC(A)*DC(B) + SUM
- G(SYZ,B,SUM)= SYZ*DC(B) + SUM
- DATA ZERO / (0.D0,0.D0) /
-#endif
- SXYZ = ZERO
- IF(N .LE. 0) GOTO 20
-#include "cxi.inc"
-#include "cyij.inc"
-#include "czj.inc"
-#include "mbil.inc"
- 20 CMBIL = SXYZ
- RETURN
- END
diff --git a/src/packlib/kernlib/kernnum/f003fort/cmcpy.F b/src/packlib/kernlib/kernnum/f003fort/cmcpy.F
deleted file mode 100644
index b09768a..0000000
--- a/src/packlib/kernlib/kernnum/f003fort/cmcpy.F
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: cmcpy.F,v 1.1.1.1 1996/02/15 17:48:57 mclareni Exp $
-*
-* $Log: cmcpy.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:57 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE CMCPY(M,N,X,X12,X21,Z,Z12,Z21)
- COMPLEX X(*),X12(*),X21(*),Z(*),Z12(*),Z21(*)
- COMPLEX FUNCT, A
- FUNCT(A) = A
- IF(M .LE. 0 .OR. N .LE. 0) RETURN
-#include "cxij.inc"
-#include "czij.inc"
-#include "mcpy.inc"
diff --git a/src/packlib/kernlib/kernnum/f003fort/cmmna.F b/src/packlib/kernlib/kernnum/f003fort/cmmna.F
deleted file mode 100644
index 2daec58..0000000
--- a/src/packlib/kernlib/kernnum/f003fort/cmmna.F
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: cmmna.F,v 1.1.1.1 1996/02/15 17:48:57 mclareni Exp $
-*
-* $Log: cmmna.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:57 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE CMMNA(M,N,X,X12,X21,Y,Y2,Z,Z2)
- COMPLEX X(*),X12(*),X21(*),Y(*),Y2(*),Z(*),Z2(*)
- COMPLEX A, B, SIGNF
-#if !defined(CERNLIB_NUMCDBLE)
- COMPLEX SUM, F
- F(A,B,SUM) = -A*B + SUM
-#endif
-#if defined(CERNLIB_NUMCDBLE)
- COMPLEX*16 SUM, DC, F
- DC(A) = DCMPLX(DBLE(REAL(A)),DBLE(AIMAG(A)))
- F(A,B,SUM) = -DC(A)*DC(B) + SUM
-#endif
-#if defined(CERNLIB_IBMAIX)
- SIGNF(A) = A*1
-#else
- SIGNF(A) = A
-#endif
- IF(M .LE. 0 .OR. N .LE. 0) RETURN
-#include "cxij.inc"
-#include "cyj.inc"
-#include "czi.inc"
-#include "mmpa.inc"
diff --git a/src/packlib/kernlib/kernnum/f003fort/cmmns.F b/src/packlib/kernlib/kernnum/f003fort/cmmns.F
deleted file mode 100644
index f9f815f..0000000
--- a/src/packlib/kernlib/kernnum/f003fort/cmmns.F
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: cmmns.F,v 1.1.1.1 1996/02/15 17:48:57 mclareni Exp $
-*
-* $Log: cmmns.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:57 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE CMMNS(M,N,X,X12,X21,Y,Y2,Z,Z2)
- COMPLEX X(*),X12(*),X21(*),Y(*),Y2(*),Z(*),Z2(*)
- COMPLEX A, B, SIGNF
-#if !defined(CERNLIB_NUMCDBLE)
- COMPLEX SUM, F
- F(A,B,SUM) = -A*B + SUM
-#endif
-#if defined(CERNLIB_NUMCDBLE)
- COMPLEX*16 SUM, DC, F
- DC(A) = DCMPLX(DBLE(REAL(A)),DBLE(AIMAG(A)))
- F(A,B,SUM) = -DC(A)*DC(B) + SUM
-#endif
- SIGNF(A) = -A
- IF(M .LE. 0 .OR. N .LE. 0) RETURN
-#include "cxij.inc"
-#include "cyj.inc"
-#include "czi.inc"
-#include "mmpa.inc"
diff --git a/src/packlib/kernlib/kernnum/f003fort/cmmpa.F b/src/packlib/kernlib/kernnum/f003fort/cmmpa.F
deleted file mode 100644
index 354671e..0000000
--- a/src/packlib/kernlib/kernnum/f003fort/cmmpa.F
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: cmmpa.F,v 1.1.1.1 1996/02/15 17:48:57 mclareni Exp $
-*
-* $Log: cmmpa.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:57 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE CMMPA(M,N,X,X12,X21,Y,Y2,Z,Z2)
- COMPLEX X(*),X12(*),X21(*),Y(*),Y2(*),Z(*),Z2(*)
- COMPLEX A, B, SIGNF
-#if !defined(CERNLIB_NUMCDBLE)
- COMPLEX SUM, F
- F(A,B,SUM) = A*B + SUM
-#endif
-#if defined(CERNLIB_NUMCDBLE)
- COMPLEX*16 SUM, DC, F
- DC(A) = DCMPLX(DBLE(REAL(A)),DBLE(AIMAG(A)))
- F(A,B,SUM) = DC(A)*DC(B) + SUM
-#endif
-#if defined(CERNLIB_IBMAIX)
- SIGNF(A) = A*1
-#else
- SIGNF(A) = A
-#endif
- IF(M .LE. 0 .OR. N .LE. 0) RETURN
-#include "cxij.inc"
-#include "cyj.inc"
-#include "czi.inc"
-#include "mmpa.inc"
diff --git a/src/packlib/kernlib/kernnum/f003fort/cmmps.F b/src/packlib/kernlib/kernnum/f003fort/cmmps.F
deleted file mode 100644
index 93ea21d..0000000
--- a/src/packlib/kernlib/kernnum/f003fort/cmmps.F
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: cmmps.F,v 1.1.1.1 1996/02/15 17:48:57 mclareni Exp $
-*
-* $Log: cmmps.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:57 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE CMMPS(M,N,X,X12,X21,Y,Y2,Z,Z2)
- COMPLEX X(*),X12(*),X21(*),Y(*),Y2(*),Z(*),Z2(*)
- COMPLEX A, B, SIGNF
-#if !defined(CERNLIB_NUMCDBLE)
- COMPLEX SUM, F
- F(A,B,SUM) = A*B + SUM
-#endif
-#if defined(CERNLIB_NUMCDBLE)
- COMPLEX*16 SUM, DC, F
- DC(A) = DCMPLX(DBLE(REAL(A)),DBLE(AIMAG(A)))
- F(A,B,SUM) = DC(A)*DC(B) + SUM
-#endif
- SIGNF(A) = -A
- IF(M .LE. 0 .OR. N .LE. 0) RETURN
-#include "cxij.inc"
-#include "cyj.inc"
-#include "czi.inc"
-#include "mmpa.inc"
diff --git a/src/packlib/kernlib/kernnum/f003fort/cmmpy.F b/src/packlib/kernlib/kernnum/f003fort/cmmpy.F
deleted file mode 100644
index 35485aa..0000000
--- a/src/packlib/kernlib/kernnum/f003fort/cmmpy.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: cmmpy.F,v 1.1.1.1 1996/02/15 17:48:58 mclareni Exp $
-*
-* $Log: cmmpy.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:58 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE CMMPY(M,N,X,X12,X21,Y,Y2,Z,Z2)
- COMPLEX X(*),X12(*),X21(*),Y(*),Y2(*),Z(*),Z2(*)
- COMPLEX A, B
-#if !defined(CERNLIB_NUMCDBLE)
- COMPLEX SUM, ZERO, F
- F(A,B,SUM) = A*B + SUM
- DATA ZERO / (0.,0.) /
-#endif
-#if defined(CERNLIB_NUMCDBLE)
- COMPLEX*16 SUM, ZERO, DC, F
- DC(A) = DCMPLX(DBLE(REAL(A)),DBLE(AIMAG(A)))
- F(A,B,SUM) = DC(A)*DC(B) + SUM
- DATA ZERO / (0.D0,0.D0) /
-#endif
- IF(M .LE. 0 .OR. N .LE. 0) RETURN
-#include "cxij.inc"
-#include "cyj.inc"
-#include "czi.inc"
-#include "mmpy.inc"
diff --git a/src/packlib/kernlib/kernnum/f003fort/cmmpyc.F b/src/packlib/kernlib/kernnum/f003fort/cmmpyc.F
deleted file mode 100644
index 36f765e..0000000
--- a/src/packlib/kernlib/kernnum/f003fort/cmmpyc.F
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: cmmpyc.F,v 1.1.1.1 1996/02/15 17:48:58 mclareni Exp $
-*
-* $Log: cmmpyc.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:58 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE CMMPYC(M,N,X,X12,X21,Y,Y2,Z,Z2)
- COMPLEX X(*),X12(*),X21(*),Y(*),Y2(*),Z(*),Z2(*)
- COMPLEX A, B
-#if !defined(CERNLIB_NUMCDBLE)
- COMPLEX SUM, ZERO, F
- F(A,B,SUM) = A*CONJG(B) + SUM
- DATA ZERO / (0.,0.) /
-#endif
-#if (defined(CERNLIB_NUMCDBLE))&&(!defined(CERNLIB_NUMND))
- COMPLEX*16 SUM, ZERO, DC, F
- DC(A) = DCMPLX(DBLE(REAL(A)),DBLE(AIMAG(A)))
- F(A,B,SUM) = DC(A)*DCONJG(DC(B)) + SUM
- DATA ZERO / (0.D0,0.D0) /
-#endif
-#if (defined(CERNLIB_NUMCDBLE))&&(defined(CERNLIB_NUMND))
- COMPLEX*16 SUM, ZERO, DC, F
- DC(A) = DCMPLX(DBLE(REAL(A)),DBLE(AIMAG(A)))
- F(A,B,SUM) = DC(A)*CDCONJG(DC(B)) + SUM
- DATA ZERO / (0.D0,0.D0) /
-#endif
- IF(M .LE. 0 .OR. N .LE. 0) RETURN
-#include "cxij.inc"
-#include "cyj.inc"
-#include "czi.inc"
-#include "mmpy.inc"
diff --git a/src/packlib/kernlib/kernnum/f003fort/cmran.F b/src/packlib/kernlib/kernnum/f003fort/cmran.F
deleted file mode 100644
index 1c94b3d..0000000
--- a/src/packlib/kernlib/kernnum/f003fort/cmran.F
+++ /dev/null
@@ -1,36 +0,0 @@
-*
-* $Id: cmran.F,v 1.1.1.1 1996/02/15 17:48:58 mclareni Exp $
-*
-* $Log: cmran.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:58 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE CMRAN(M,N,A,B,Z,Z12,Z21)
- COMPLEX A, B, Z(*), Z12(*), Z21(*), C
- IF(M .LE. 0 .OR. N .LE. 0) RETURN
-#include "czij.inc"
- MM = M
- NN = N
- IF(MM .GT. NN) THEN
- MN = NN
- NN = MM
- MM = MN
- IJ = JZ
- JZ = IZ
- IZ = IJ
- ENDIF
- C = B - A
- LZI1 = 1
- DO 12 I = 1, MM
- LZIJ = LZI1
- DO 11 J = 1, NN
- Z(LZIJ) = CMPLX(REAL(C)*RANF() + REAL(A),
- + AIMAG(C)*RANF() + AIMAG(A))
- LZIJ = LZIJ + JZ
- 11 CONTINUE
- LZI1 = LZI1 + IZ
- 12 CONTINUE
- RETURN
- END
diff --git a/src/packlib/kernlib/kernnum/f003fort/cmscl.F b/src/packlib/kernlib/kernnum/f003fort/cmscl.F
deleted file mode 100644
index 2ea8856..0000000
--- a/src/packlib/kernlib/kernnum/f003fort/cmscl.F
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: cmscl.F,v 1.1.1.1 1996/02/15 17:48:58 mclareni Exp $
-*
-* $Log: cmscl.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:58 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE CMSCL(M,N,S,X,X12,X21,Z,Z12,Z21)
- COMPLEX S, X(*),X12(*),X21(*), Z(*),Z12(*),Z21(*)
- COMPLEX FUNCT, A
- FUNCT(A) = S*A
- IF(M .LE. 0 .OR. N .LE. 0) RETURN
-#include "cxij.inc"
-#include "czij.inc"
-#include "mcpy.inc"
diff --git a/src/packlib/kernlib/kernnum/f003fort/cmset.F b/src/packlib/kernlib/kernnum/f003fort/cmset.F
deleted file mode 100644
index b2f207b..0000000
--- a/src/packlib/kernlib/kernnum/f003fort/cmset.F
+++ /dev/null
@@ -1,14 +0,0 @@
-*
-* $Id: cmset.F,v 1.1.1.1 1996/02/15 17:48:58 mclareni Exp $
-*
-* $Log: cmset.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:58 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE CMSET(M,N,S,Z,Z12,Z21)
- COMPLEX S, Z(*), Z12(*), Z21(*)
- IF(M .LE. 0 .OR. N .LE. 0) RETURN
-#include "czij.inc"
-#include "mset.inc"
diff --git a/src/packlib/kernlib/kernnum/f003fort/cmsub.F b/src/packlib/kernlib/kernnum/f003fort/cmsub.F
deleted file mode 100644
index 2ad4e93..0000000
--- a/src/packlib/kernlib/kernnum/f003fort/cmsub.F
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: cmsub.F,v 1.1.1.1 1996/02/15 17:48:59 mclareni Exp $
-*
-* $Log: cmsub.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:59 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE CMSUB(M,N,X,X12,X21,Y,Y12,Y21,Z,Z12,Z21)
- COMPLEX X(*), X12(*), X21(*), Y(*), Y12(*), Y21(*)
- COMPLEX Z(*), Z12(*), Z21(*), ADD, A, B
- ADD(A,B) = A-B
-#include "cxij.inc"
-#include "cyij.inc"
-#include "czij.inc"
-#include "madd.inc"
diff --git a/src/packlib/kernlib/kernnum/f003fort/cmutl.F b/src/packlib/kernlib/kernnum/f003fort/cmutl.F
deleted file mode 100644
index 7c50b7d..0000000
--- a/src/packlib/kernlib/kernnum/f003fort/cmutl.F
+++ /dev/null
@@ -1,14 +0,0 @@
-*
-* $Id: cmutl.F,v 1.1.1.1 1996/02/15 17:48:59 mclareni Exp $
-*
-* $Log: cmutl.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:59 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE CMUTL(N,X,X12,X21)
- COMPLEX X(*), X12(*), X21(*)
- IF(N .LE. 1) RETURN
-#include "cxij.inc"
-#include "mutl.inc"
diff --git a/src/packlib/kernlib/kernnum/f003fort/crscl.F b/src/packlib/kernlib/kernnum/f003fort/crscl.F
deleted file mode 100644
index 338679b..0000000
--- a/src/packlib/kernlib/kernnum/f003fort/crscl.F
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: crscl.F,v 1.1.1.1 1996/02/15 17:48:59 mclareni Exp $
-*
-* $Log: crscl.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:59 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE CRSCL(M,N,D,D2,X,X12,X21,Z,Z12,Z21)
- COMPLEX D(*),D2(*),X(*),X12(*),X21(*),Z(*),Z12(*),Z21(*)
- IF(M .LE. 0 .OR. N .LE. 0) RETURN
-#include "cdi.inc"
-#include "cxij.inc"
-#include "czij.inc"
-#include "rscl.inc"
diff --git a/src/packlib/kernlib/kernnum/f003fort/cujk.inc b/src/packlib/kernlib/kernnum/f003fort/cujk.inc
deleted file mode 100644
index aca84d7..0000000
--- a/src/packlib/kernlib/kernnum/f003fort/cujk.inc
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: cujk.inc,v 1.1.1.1 1996/02/15 17:48:54 mclareni Exp $
-*
-* $Log: cujk.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:54 mclareni
-* Kernlib
-*
-*
-*
-* cujk.inc
-*
-#if defined(CERNLIB_NUMAP)||defined(CERNLIB_NUMCD)||defined(CERNLIB_NUMCV)||defined(CERNLIB_NUMIB2)||defined(CERNLIB_NUMND)
- JU = (LOCF(U12) - LOCF(U)) / 2
- KU = (LOCF(U22) - LOCF(U)) / 2
-#endif
-#if defined(CERNLIB_NUMCR)||defined(CERNLIB_NUMUC)
- JU = (LOC(U12) - LOC(U)) / 2
- KU = (LOC(U22) - LOC(U)) / 2
-#endif
-#if defined(CERNLIB_NUMDE)
- JU = (%LOC(U12) - %LOC(U)) / 8
- KU = (%LOC(U22) - %LOC(U)) / 8
-#endif
-#if defined(CERNLIB_NUMIB1)
- JU = (IADDR(U12) - IADDR(U)) / 8
- KU = (IADDR(U22) - IADDR(U)) / 8
-#endif
diff --git a/src/packlib/kernlib/kernnum/f003fort/cumna.F b/src/packlib/kernlib/kernnum/f003fort/cumna.F
deleted file mode 100644
index 1fa91b6..0000000
--- a/src/packlib/kernlib/kernnum/f003fort/cumna.F
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: cumna.F,v 1.1.1.1 1996/02/15 17:48:59 mclareni Exp $
-*
-* $Log: cumna.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:59 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE CUMNA(N,U,U12,U22,Y,Y2,Z,Z2)
- COMPLEX U(*),U12(*),U22(*),Y(*),Y2(*),Z(*),Z2(*)
- COMPLEX A, B, SIGNF
-#if !defined(CERNLIB_NUMCDBLE)
- COMPLEX SUM, F
- F(A,B,SUM) = -A*B + SUM
-#endif
-#if defined(CERNLIB_NUMCDBLE)
- COMPLEX*16 SUM, DC, F
- DC(A) = DCMPLX(DBLE(REAL(A)),DBLE(AIMAG(A)))
- F(A,B,SUM) = -DC(A)*DC(B) + SUM
-#endif
-#if defined(CERNLIB_IBMAIX)
- SIGNF(A) = A*1
-#else
- SIGNF(A) = A
-#endif
- IF(N .LE. 0) RETURN
-#include "cujk.inc"
-#include "cyj.inc"
-#include "czi.inc"
-#include "umpa.inc"
diff --git a/src/packlib/kernlib/kernnum/f003fort/cumns.F b/src/packlib/kernlib/kernnum/f003fort/cumns.F
deleted file mode 100644
index 7d6623f..0000000
--- a/src/packlib/kernlib/kernnum/f003fort/cumns.F
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: cumns.F,v 1.1.1.1 1996/02/15 17:48:59 mclareni Exp $
-*
-* $Log: cumns.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:59 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE CUMNS(N,U,U12,U22,Y,Y2,Z,Z2)
- COMPLEX U(*),U12(*),U22(*),Y(*),Y2(*),Z(*),Z2(*)
- COMPLEX A, B, SIGNF
-#if !defined(CERNLIB_NUMCDBLE)
- COMPLEX SUM, F
- F(A,B,SUM) = -A*B + SUM
-#endif
-#if defined(CERNLIB_NUMCDBLE)
- COMPLEX*16 SUM, DC, F
- DC(A) = DCMPLX(DBLE(REAL(A)),DBLE(AIMAG(A)))
- F(A,B,SUM) = -DC(A)*DC(B) + SUM
-#endif
- SIGNF(A) = -A
- IF(N .LE. 0) RETURN
-#include "cujk.inc"
-#include "cyj.inc"
-#include "czi.inc"
-#include "umpa.inc"
diff --git a/src/packlib/kernlib/kernnum/f003fort/cumpa.F b/src/packlib/kernlib/kernnum/f003fort/cumpa.F
deleted file mode 100644
index ae99f3f..0000000
--- a/src/packlib/kernlib/kernnum/f003fort/cumpa.F
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: cumpa.F,v 1.1.1.1 1996/02/15 17:48:59 mclareni Exp $
-*
-* $Log: cumpa.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:59 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE CUMPA(N,U,U12,U22,Y,Y2,Z,Z2)
- COMPLEX U(*),U12(*),U22(*),Y(*),Y2(*),Z(*),Z2(*)
- COMPLEX A, B, SIGNF
-#if !defined(CERNLIB_NUMCDBLE)
- COMPLEX SUM, F
- F(A,B,SUM) = A*B + SUM
-#endif
-#if defined(CERNLIB_NUMCDBLE)
- COMPLEX*16 SUM, DC, F
- DC(A) = DCMPLX(DBLE(REAL(A)),DBLE(AIMAG(A)))
- F(A,B,SUM) = DC(A)*DC(B) + SUM
-#endif
-#if defined(CERNLIB_IBMAIX)
- SIGNF(A) = A*1
-#else
- SIGNF(A) = A
-#endif
- IF(N .LE. 0) RETURN
-#include "cujk.inc"
-#include "cyj.inc"
-#include "czi.inc"
-#include "umpa.inc"
diff --git a/src/packlib/kernlib/kernnum/f003fort/cumps.F b/src/packlib/kernlib/kernnum/f003fort/cumps.F
deleted file mode 100644
index 6777e98..0000000
--- a/src/packlib/kernlib/kernnum/f003fort/cumps.F
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: cumps.F,v 1.1.1.1 1996/02/15 17:49:00 mclareni Exp $
-*
-* $Log: cumps.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:00 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE CUMPS(N,U,U12,U22,Y,Y2,Z,Z2)
- COMPLEX U(*),U12(*),U22(*),Y(*),Y2(*),Z(*),Z2(*)
- COMPLEX A, B, SIGNF
-#if !defined(CERNLIB_NUMCDBLE)
- COMPLEX SUM, F
- F(A,B,SUM) = A*B + SUM
-#endif
-#if defined(CERNLIB_NUMCDBLE)
- COMPLEX*16 SUM, DC, F
- DC(A) = DCMPLX(DBLE(REAL(A)),DBLE(AIMAG(A)))
- F(A,B,SUM) = DC(A)*DC(B) + SUM
-#endif
- SIGNF(A) = -A
- IF(N .LE. 0) RETURN
-#include "cujk.inc"
-#include "cyj.inc"
-#include "czi.inc"
-#include "umpa.inc"
diff --git a/src/packlib/kernlib/kernnum/f003fort/cumpy.F b/src/packlib/kernlib/kernnum/f003fort/cumpy.F
deleted file mode 100644
index 96b4b3b..0000000
--- a/src/packlib/kernlib/kernnum/f003fort/cumpy.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: cumpy.F,v 1.1.1.1 1996/02/15 17:49:00 mclareni Exp $
-*
-* $Log: cumpy.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:00 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE CUMPY(N,U,U12,U22,Y,Y2,Z,Z2)
- COMPLEX U(*),U12(*),U22(*),Y(*),Y2(*),Z(*),Z2(*)
- COMPLEX A, B
-#if !defined(CERNLIB_NUMCDBLE)
- COMPLEX SUM, ZERO, F
- F(A,B,SUM) = A*B + SUM
- DATA ZERO / (0.,0.) /
-#endif
-#if defined(CERNLIB_NUMCDBLE)
- COMPLEX*16 SUM, ZERO, DC, F
- DC(A) = DCMPLX(DBLE(REAL(A)),DBLE(AIMAG(A)))
- F(A,B,SUM) = DC(A)*DC(B) + SUM
- DATA ZERO / (0.D0,0.D0) /
-#endif
- IF(N .LE. 0) RETURN
-#include "cujk.inc"
-#include "cyj.inc"
-#include "czi.inc"
-#include "umpy.inc"
diff --git a/src/packlib/kernlib/kernnum/f003fort/cumpyc.F b/src/packlib/kernlib/kernnum/f003fort/cumpyc.F
deleted file mode 100644
index 0a4a27d..0000000
--- a/src/packlib/kernlib/kernnum/f003fort/cumpyc.F
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: cumpyc.F,v 1.1.1.1 1996/02/15 17:49:00 mclareni Exp $
-*
-* $Log: cumpyc.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:00 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE CUMPYC(N,U,U12,U22,Y,Y2,Z,Z2)
- COMPLEX U(*),U12(*),U22(*),Y(*),Y2(*),Z(*),Z2(*)
- COMPLEX A, B
-#if !defined(CERNLIB_NUMCDBLE)
- COMPLEX SUM, ZERO, F
- F(A,B,SUM) = A*CONJG(B) + SUM
- DATA ZERO / (0.,0.) /
-#endif
-#if (defined(CERNLIB_NUMCDBLE))&&(!defined(CERNLIB_NUMND))
- COMPLEX*16 SUM, ZERO, DC, F
- DC(A) = DCMPLX(DBLE(REAL(A)),DBLE(AIMAG(A)))
- F(A,B,SUM) = DC(A)*DCONJG(DC(B)) + SUM
- DATA ZERO / (0.D0,0.D0) /
-#endif
-#if (defined(CERNLIB_NUMCDBLE))&&(defined(CERNLIB_NUMND))
- COMPLEX*16 SUM, ZERO, DC, F
- DC(A) = DCMPLX(DBLE(REAL(A)),DBLE(AIMAG(A)))
- F(A,B,SUM) = DC(A)*CDCONJG(DC(B)) + SUM
- DATA ZERO / (0.D0,0.D0) /
-#endif
- IF(N .LE. 0) RETURN
-#include "cujk.inc"
-#include "cyj.inc"
-#include "czi.inc"
-#include "umpy.inc"
diff --git a/src/packlib/kernlib/kernnum/f003fort/cxi.inc b/src/packlib/kernlib/kernnum/f003fort/cxi.inc
deleted file mode 100644
index 268b7f0..0000000
--- a/src/packlib/kernlib/kernnum/f003fort/cxi.inc
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: cxi.inc,v 1.1.1.1 1996/02/15 17:48:54 mclareni Exp $
-*
-* $Log: cxi.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:54 mclareni
-* Kernlib
-*
-*
-*
-* cxi.inc
-*
-#if defined(CERNLIB_NUMAP)||defined(CERNLIB_NUMCD)||defined(CERNLIB_NUMCV)||defined(CERNLIB_NUMIB2)||defined(CERNLIB_NUMND)
- IX = (LOCF(X2) - LOCF(X)) / 2
-#endif
-#if defined(CERNLIB_NUMCR)||defined(CERNLIB_NUMUC)
- IX = (LOC(X2) - LOC(X)) / 2
-#endif
-#if defined(CERNLIB_NUMDE)
- IX = (%LOC(X2) - %LOC(X)) / 8
-#endif
-#if defined(CERNLIB_NUMIB1)
- IX = (IADDR(X2) - IADDR(X)) / 8
-#endif
diff --git a/src/packlib/kernlib/kernnum/f003fort/cxij.inc b/src/packlib/kernlib/kernnum/f003fort/cxij.inc
deleted file mode 100644
index 6ac4e6f..0000000
--- a/src/packlib/kernlib/kernnum/f003fort/cxij.inc
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: cxij.inc,v 1.1.1.1 1996/02/15 17:48:55 mclareni Exp $
-*
-* $Log: cxij.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:55 mclareni
-* Kernlib
-*
-*
-*
-* cxij.inc
-*
-#if defined(CERNLIB_NUMAP)||defined(CERNLIB_NUMCD)||defined(CERNLIB_NUMCV)||defined(CERNLIB_NUMIB2)||defined(CERNLIB_NUMND)
- IX = (LOCF(X21) - LOCF(X)) / 2
- JX = (LOCF(X12) - LOCF(X)) / 2
-#endif
-#if defined(CERNLIB_NUMCR)||defined(CERNLIB_NUMUC)
- IX = (LOC(X21) - LOC(X)) / 2
- JX = (LOC(X12) - LOC(X)) / 2
-#endif
-#if defined(CERNLIB_NUMDE)
- IX = (%LOC(X21) - %LOC(X)) / 8
- JX = (%LOC(X12) - %LOC(X)) / 8
-#endif
-#if defined(CERNLIB_NUMIB1)
- IX = (IADDR(X21) - IADDR(X)) / 8
- JX = (IADDR(X12) - IADDR(X)) / 8
-#endif
diff --git a/src/packlib/kernlib/kernnum/f003fort/cyij.inc b/src/packlib/kernlib/kernnum/f003fort/cyij.inc
deleted file mode 100644
index 4a3f58e..0000000
--- a/src/packlib/kernlib/kernnum/f003fort/cyij.inc
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: cyij.inc,v 1.1.1.1 1996/02/15 17:48:55 mclareni Exp $
-*
-* $Log: cyij.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:55 mclareni
-* Kernlib
-*
-*
-*
-* cyij.inc
-*
-#if defined(CERNLIB_NUMAP)||defined(CERNLIB_NUMCD)||defined(CERNLIB_NUMCV)||defined(CERNLIB_NUMIB2)||defined(CERNLIB_NUMND)
- IY = (LOCF(Y21) - LOCF(Y)) / 2
- JY = (LOCF(Y12) - LOCF(Y)) / 2
-#endif
-#if defined(CERNLIB_NUMCR)||defined(CERNLIB_NUMUC)
- IY = (LOC(Y21) - LOC(Y)) / 2
- JY = (LOC(Y12) - LOC(Y)) / 2
-#endif
-#if defined(CERNLIB_NUMDE)
- IY = (%LOC(Y21) - %LOC(Y)) / 8
- JY = (%LOC(Y12) - %LOC(Y)) / 8
-#endif
-#if defined(CERNLIB_NUMIB1)
- IY = (IADDR(Y21) - IADDR(Y)) / 8
- JY = (IADDR(Y12) - IADDR(Y)) / 8
-#endif
diff --git a/src/packlib/kernlib/kernnum/f003fort/cyj.inc b/src/packlib/kernlib/kernnum/f003fort/cyj.inc
deleted file mode 100644
index 3e8fec8..0000000
--- a/src/packlib/kernlib/kernnum/f003fort/cyj.inc
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: cyj.inc,v 1.1.1.1 1996/02/15 17:48:56 mclareni Exp $
-*
-* $Log: cyj.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:56 mclareni
-* Kernlib
-*
-*
-*
-* cyj.inc
-*
-#if defined(CERNLIB_NUMAP)||defined(CERNLIB_NUMCD)||defined(CERNLIB_NUMCV)||defined(CERNLIB_NUMIB2)||defined(CERNLIB_NUMND)
- JY = (LOCF(Y2) - LOCF(Y)) / 2
-#endif
-#if defined(CERNLIB_NUMCR)||defined(CERNLIB_NUMUC)
- JY = (LOC(Y2) - LOC(Y)) / 2
-#endif
-#if defined(CERNLIB_NUMDE)
- JY = (%LOC(Y2) - %LOC(Y)) / 8
-#endif
-#if defined(CERNLIB_NUMIB1)
- JY = (IADDR(Y2) - IADDR(Y)) / 8
-#endif
diff --git a/src/packlib/kernlib/kernnum/f003fort/czi.inc b/src/packlib/kernlib/kernnum/f003fort/czi.inc
deleted file mode 100644
index 7e8f964..0000000
--- a/src/packlib/kernlib/kernnum/f003fort/czi.inc
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: czi.inc,v 1.1.1.1 1996/02/15 17:48:55 mclareni Exp $
-*
-* $Log: czi.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:55 mclareni
-* Kernlib
-*
-*
-*
-* czi.inc
-*
-#if defined(CERNLIB_NUMAP)||defined(CERNLIB_NUMCD)||defined(CERNLIB_NUMCV)||defined(CERNLIB_NUMIB2)||defined(CERNLIB_NUMND)
- IZ = (LOCF(Z2) - LOCF(Z)) / 2
-#endif
-#if defined(CERNLIB_NUMCR)||defined(CERNLIB_NUMUC)
- IZ = (LOC(Z2) - LOC(Z)) / 2
-#endif
-#if defined(CERNLIB_NUMDE)
- IZ = (%LOC(Z2) - %LOC(Z)) / 8
-#endif
-#if defined(CERNLIB_NUMIB1)
- IZ = (IADDR(Z2) - IADDR(Z)) / 8
-#endif
diff --git a/src/packlib/kernlib/kernnum/f003fort/czij.inc b/src/packlib/kernlib/kernnum/f003fort/czij.inc
deleted file mode 100644
index 59f6bbb..0000000
--- a/src/packlib/kernlib/kernnum/f003fort/czij.inc
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: czij.inc,v 1.1.1.1 1996/02/15 17:48:55 mclareni Exp $
-*
-* $Log: czij.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:55 mclareni
-* Kernlib
-*
-*
-*
-* czij.inc
-*
-#if defined(CERNLIB_NUMAP)||defined(CERNLIB_NUMCD)||defined(CERNLIB_NUMCV)||defined(CERNLIB_NUMIB2)||defined(CERNLIB_NUMND)
- IZ = (LOCF(Z21) - LOCF(Z)) / 2
- JZ = (LOCF(Z12) - LOCF(Z)) / 2
-#endif
-#if defined(CERNLIB_NUMCR)||defined(CERNLIB_NUMUC)
- IZ = (LOC(Z21) - LOC(Z)) / 2
- JZ = (LOC(Z12) - LOC(Z)) / 2
-#endif
-#if defined(CERNLIB_NUMDE)
- IZ = (%LOC(Z21) - %LOC(Z)) / 8
- JZ = (%LOC(Z12) - %LOC(Z)) / 8
-#endif
-#if defined(CERNLIB_NUMIB1)
- IZ = (IADDR(Z21) - IADDR(Z)) / 8
- JZ = (IADDR(Z12) - IADDR(Z)) / 8
-#endif
diff --git a/src/packlib/kernlib/kernnum/f003fort/czj.inc b/src/packlib/kernlib/kernnum/f003fort/czj.inc
deleted file mode 100644
index 0ffed47..0000000
--- a/src/packlib/kernlib/kernnum/f003fort/czj.inc
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: czj.inc,v 1.1.1.1 1996/02/15 17:48:56 mclareni Exp $
-*
-* $Log: czj.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:56 mclareni
-* Kernlib
-*
-*
-*
-* czj.inc
-*
-#if defined(CERNLIB_NUMAP)||defined(CERNLIB_NUMCD)||defined(CERNLIB_NUMCV)||defined(CERNLIB_NUMIB2)||defined(CERNLIB_NUMND)
- JZ = (LOCF(Z2) - LOCF(Z)) / 2
-#endif
-#if defined(CERNLIB_NUMCR)||defined(CERNLIB_NUMUC)
- JZ = (LOC(Z2) - LOC(Z)) / 2
-#endif
-#if defined(CERNLIB_NUMDE)
- JZ = (%LOC(Z2) - %LOC(Z)) / 8
-#endif
-#if defined(CERNLIB_NUMIB1)
- JZ = (IADDR(Z2) - IADDR(Z)) / 8
-#endif
diff --git a/src/packlib/kernlib/kernnum/f003fort/ddi.inc b/src/packlib/kernlib/kernnum/f003fort/ddi.inc
deleted file mode 100644
index a97294c..0000000
--- a/src/packlib/kernlib/kernnum/f003fort/ddi.inc
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: ddi.inc,v 1.1.1.1 1996/02/15 17:48:54 mclareni Exp $
-*
-* $Log: ddi.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:54 mclareni
-* Kernlib
-*
-*
-*
-* ddi.inc
-*
-#if defined(CERNLIB_NUMAP)||defined(CERNLIB_NUMCD)||defined(CERNLIB_NUMCV)||defined(CERNLIB_NUMIB2)||defined(CERNLIB_NUMND)
- ID = (LOCF(D2) - LOCF(D)) / 2
-#endif
-#if defined(CERNLIB_NUMCR)||defined(CERNLIB_NUMUC)
- ID = (LOC(D2) - LOC(D)) / 2
-#endif
-#if defined(CERNLIB_NUMDE)
- ID = (%LOC(D2) - %LOC(D)) / 8
-#endif
-#if defined(CERNLIB_NUMIB1)
- ID = (IADDR(D2) - IADDR(D)) / 8
-#endif
diff --git a/src/packlib/kernlib/kernnum/f003fort/dmadd.F b/src/packlib/kernlib/kernnum/f003fort/dmadd.F
deleted file mode 100644
index 6c2f07f..0000000
--- a/src/packlib/kernlib/kernnum/f003fort/dmadd.F
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: dmadd.F,v 1.1.1.1 1996/02/15 17:48:56 mclareni Exp $
-*
-* $Log: dmadd.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:56 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE DMADD(M,N,X,X12,X21,Y,Y12,Y21,Z,Z12,Z21)
- DOUBLE PRECISION X(*), X12(*), X21(*), Y(*), Y12(*), Y21(*)
- DOUBLE PRECISION Z(*), Z12(*), Z21(*), ADD, A, B
- ADD(A,B) = A+B
- IF(M .LE. 0 .OR. N .LE. 0) RETURN
-#include "dxij.inc"
-#include "dyij.inc"
-#include "dzij.inc"
-#include "madd.inc"
diff --git a/src/packlib/kernlib/kernnum/f003fort/dmbil.F b/src/packlib/kernlib/kernnum/f003fort/dmbil.F
deleted file mode 100644
index 8263ed7..0000000
--- a/src/packlib/kernlib/kernnum/f003fort/dmbil.F
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: dmbil.F,v 1.1.1.1 1996/02/15 17:48:56 mclareni Exp $
-*
-* $Log: dmbil.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:56 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- DOUBLE PRECISION FUNCTION DMBIL(N,X,X2,Y,Y12,Y21,Z,Z2)
- DOUBLE PRECISION X(*),X2(*),Y(*),Y12(*),Y21(*),Z(*),Z2(*)
- DOUBLE PRECISION A, B, SUM, ZERO, F, G, SXYZ, SYZ
- F(A,B,SUM) = A*B + SUM
- G(A,B,SUM) = A*B + SUM
- DATA ZERO / 0.D0 /
- SXYZ = ZERO
- IF(N .LE. 0) GOTO 20
-#include "dxi.inc"
-#include "dyij.inc"
-#include "dzj.inc"
-#include "mbil.inc"
- 20 DMBIL = SXYZ
- RETURN
- END
diff --git a/src/packlib/kernlib/kernnum/f003fort/dmcpy.F b/src/packlib/kernlib/kernnum/f003fort/dmcpy.F
deleted file mode 100644
index 023dc50..0000000
--- a/src/packlib/kernlib/kernnum/f003fort/dmcpy.F
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: dmcpy.F,v 1.1.1.1 1996/02/15 17:48:56 mclareni Exp $
-*
-* $Log: dmcpy.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:56 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE DMCPY(M,N,X,X12,X21,Z,Z12,Z21)
- DOUBLE PRECISION X(*),X12(*),X21(*),Z(*),Z12(*),Z21(*)
- DOUBLE PRECISION FUNCT, A
- FUNCT(A) = A
- IF(M .LE. 0 .OR. N .LE. 0) RETURN
-#include "dxij.inc"
-#include "dzij.inc"
-#include "mcpy.inc"
diff --git a/src/packlib/kernlib/kernnum/f003fort/dmmna.F b/src/packlib/kernlib/kernnum/f003fort/dmmna.F
deleted file mode 100644
index 5f0d934..0000000
--- a/src/packlib/kernlib/kernnum/f003fort/dmmna.F
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: dmmna.F,v 1.1.1.1 1996/02/15 17:48:57 mclareni Exp $
-*
-* $Log: dmmna.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:57 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE DMMNA(M,N,X,X12,X21,Y,Y2,Z,Z2)
- DOUBLE PRECISION X(*),X12(*),X21(*),Y(*),Y2(*),Z(*),Z2(*)
- DOUBLE PRECISION A, B, SUM, F, SIGNF
- F(A,B,SUM) = -A*B + SUM
- SIGNF(A) = A
- IF(M .LE. 0 .OR. N .LE. 0) RETURN
-#include "dxij.inc"
-#include "dyj.inc"
-#include "dzi.inc"
-#include "mmpa.inc"
diff --git a/src/packlib/kernlib/kernnum/f003fort/dmmns.F b/src/packlib/kernlib/kernnum/f003fort/dmmns.F
deleted file mode 100644
index 5b55f48..0000000
--- a/src/packlib/kernlib/kernnum/f003fort/dmmns.F
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: dmmns.F,v 1.1.1.1 1996/02/15 17:48:57 mclareni Exp $
-*
-* $Log: dmmns.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:57 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE DMMNS(M,N,X,X12,X21,Y,Y2,Z,Z2)
- DOUBLE PRECISION X(*),X12(*),X21(*),Y(*),Y2(*),Z(*),Z2(*)
- DOUBLE PRECISION A, B, SUM, F, SIGNF
- F(A,B,SUM) = -A*B + SUM
- SIGNF(A) = -A
- IF(M .LE. 0 .OR. N .LE. 0) RETURN
-#include "dxij.inc"
-#include "dyj.inc"
-#include "dzi.inc"
-#include "mmpa.inc"
diff --git a/src/packlib/kernlib/kernnum/f003fort/dmmpa.F b/src/packlib/kernlib/kernnum/f003fort/dmmpa.F
deleted file mode 100644
index f0ccca4..0000000
--- a/src/packlib/kernlib/kernnum/f003fort/dmmpa.F
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: dmmpa.F,v 1.1.1.1 1996/02/15 17:48:57 mclareni Exp $
-*
-* $Log: dmmpa.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:57 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE DMMPA(M,N,X,X12,X21,Y,Y2,Z,Z2)
- DOUBLE PRECISION X(*),X12(*),X21(*),Y(*),Y2(*),Z(*),Z2(*)
- DOUBLE PRECISION A, B, SUM, F, SIGNF
- F(A,B,SUM) = A*B + SUM
- SIGNF(A) = A
- IF(M .LE. 0 .OR. N .LE. 0) RETURN
-#include "dxij.inc"
-#include "dyj.inc"
-#include "dzi.inc"
-#include "mmpa.inc"
diff --git a/src/packlib/kernlib/kernnum/f003fort/dmmps.F b/src/packlib/kernlib/kernnum/f003fort/dmmps.F
deleted file mode 100644
index 86ca662..0000000
--- a/src/packlib/kernlib/kernnum/f003fort/dmmps.F
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: dmmps.F,v 1.1.1.1 1996/02/15 17:48:57 mclareni Exp $
-*
-* $Log: dmmps.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:57 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE DMMPS(M,N,X,X12,X21,Y,Y2,Z,Z2)
- DOUBLE PRECISION X(*),X12(*),X21(*),Y(*),Y2(*),Z(*),Z2(*)
- DOUBLE PRECISION A, B, SUM, F, SIGNF
- F(A,B,SUM) = A*B + SUM
- SIGNF(A) = -A
- IF(M .LE. 0 .OR. N .LE. 0) RETURN
-#include "dxij.inc"
-#include "dyj.inc"
-#include "dzi.inc"
-#include "mmpa.inc"
diff --git a/src/packlib/kernlib/kernnum/f003fort/dmmpy.F b/src/packlib/kernlib/kernnum/f003fort/dmmpy.F
deleted file mode 100644
index 5458189..0000000
--- a/src/packlib/kernlib/kernnum/f003fort/dmmpy.F
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: dmmpy.F,v 1.1.1.1 1996/02/15 17:48:58 mclareni Exp $
-*
-* $Log: dmmpy.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:58 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE DMMPY(M,N,X,X12,X21,Y,Y2,Z,Z2)
- DOUBLE PRECISION X(*),X12(*),X21(*),Y(*),Y2(*),Z(*),Z2(*)
- DOUBLE PRECISION A, B, SUM, ZERO, F
- F(A,B,SUM) = A*B + SUM
- DATA ZERO / 0.D0 /
- IF(M .LE. 0 .OR. N .LE. 0) RETURN
-#include "dxij.inc"
-#include "dyj.inc"
-#include "dzi.inc"
-#include "mmpy.inc"
diff --git a/src/packlib/kernlib/kernnum/f003fort/dmran.F b/src/packlib/kernlib/kernnum/f003fort/dmran.F
deleted file mode 100644
index 02811cd..0000000
--- a/src/packlib/kernlib/kernnum/f003fort/dmran.F
+++ /dev/null
@@ -1,36 +0,0 @@
-*
-* $Id: dmran.F,v 1.1.1.1 1996/02/15 17:48:58 mclareni Exp $
-*
-* $Log: dmran.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:58 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE DMRAN(M,N,A,B,Z,Z12,Z21)
- DOUBLE PRECISION A, B, Z(*), Z12(*), Z21(*), C
- DOUBLE PRECISION DRANF
- IF(M .LE. 0 .OR. N .LE. 0) RETURN
-#include "dzij.inc"
- MM = M
- NN = N
- IF(MM .GT. NN) THEN
- MN = NN
- NN = MM
- MM = MN
- IJ = JZ
- JZ = IZ
- IZ = IJ
- ENDIF
- C = B - A
- LZI1 = 1
- DO 12 I = 1, MM
- LZIJ = LZI1
- DO 11 J = 1, NN
- Z(LZIJ) = C * DRANF() + A
- LZIJ = LZIJ + JZ
- 11 CONTINUE
- LZI1 = LZI1 + IZ
- 12 CONTINUE
- RETURN
- END
diff --git a/src/packlib/kernlib/kernnum/f003fort/dmscl.F b/src/packlib/kernlib/kernnum/f003fort/dmscl.F
deleted file mode 100644
index 86f56d6..0000000
--- a/src/packlib/kernlib/kernnum/f003fort/dmscl.F
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: dmscl.F,v 1.1.1.1 1996/02/15 17:48:58 mclareni Exp $
-*
-* $Log: dmscl.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:58 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE DMSCL(M,N,S,X,X12,X21,Z,Z12,Z21)
- DOUBLE PRECISION S, X(*),X12(*),X21(*), Z(*),Z12(*),Z21(*)
- DOUBLE PRECISION FUNCT, A
- FUNCT(A) = S*A
- IF(M .LE. 0 .OR. N .LE. 0) RETURN
-#include "dxij.inc"
-#include "dzij.inc"
-#include "mcpy.inc"
diff --git a/src/packlib/kernlib/kernnum/f003fort/dmset.F b/src/packlib/kernlib/kernnum/f003fort/dmset.F
deleted file mode 100644
index 04cacbc..0000000
--- a/src/packlib/kernlib/kernnum/f003fort/dmset.F
+++ /dev/null
@@ -1,14 +0,0 @@
-*
-* $Id: dmset.F,v 1.1.1.1 1996/02/15 17:48:58 mclareni Exp $
-*
-* $Log: dmset.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:58 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE DMSET(M,N,S,Z,Z12,Z21)
- DOUBLE PRECISION S, Z(*), Z12(*), Z21(*)
- IF(M .LE. 0 .OR. N .LE. 0) RETURN
-#include "dzij.inc"
-#include "mset.inc"
diff --git a/src/packlib/kernlib/kernnum/f003fort/dmsub.F b/src/packlib/kernlib/kernnum/f003fort/dmsub.F
deleted file mode 100644
index c011d26..0000000
--- a/src/packlib/kernlib/kernnum/f003fort/dmsub.F
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: dmsub.F,v 1.1.1.1 1996/02/15 17:48:59 mclareni Exp $
-*
-* $Log: dmsub.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:59 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE DMSUB(M,N,X,X12,X21,Y,Y12,Y21,Z,Z12,Z21)
- DOUBLE PRECISION X(*), X12(*), X21(*), Y(*), Y12(*), Y21(*)
- DOUBLE PRECISION Z(*), Z12(*), Z21(*), ADD, A, B
- ADD(A,B) = A-B
-#include "dxij.inc"
-#include "dyij.inc"
-#include "dzij.inc"
-#include "madd.inc"
diff --git a/src/packlib/kernlib/kernnum/f003fort/dmutl.F b/src/packlib/kernlib/kernnum/f003fort/dmutl.F
deleted file mode 100644
index c857cfc..0000000
--- a/src/packlib/kernlib/kernnum/f003fort/dmutl.F
+++ /dev/null
@@ -1,14 +0,0 @@
-*
-* $Id: dmutl.F,v 1.1.1.1 1996/02/15 17:48:59 mclareni Exp $
-*
-* $Log: dmutl.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:59 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE DMUTL(N,X,X12,X21)
- DOUBLE PRECISION X(*), X12(*), X21(*)
- IF(N .LE. 1) RETURN
-#include "dxij.inc"
-#include "mutl.inc"
diff --git a/src/packlib/kernlib/kernnum/f003fort/drscl.F b/src/packlib/kernlib/kernnum/f003fort/drscl.F
deleted file mode 100644
index d8f8adf..0000000
--- a/src/packlib/kernlib/kernnum/f003fort/drscl.F
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: drscl.F,v 1.1.1.1 1996/02/15 17:48:59 mclareni Exp $
-*
-* $Log: drscl.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:59 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE DRSCL(M,N,D,D2,X,X12,X21,Z,Z12,Z21)
- DOUBLE PRECISION D(*),D2(*),X(*),X12(*),X21(*),Z(*),Z12(*),Z21(*)
- IF(M .LE. 0 .OR. N .LE. 0) RETURN
-#include "ddi.inc"
-#include "dxij.inc"
-#include "dzij.inc"
-#include "rscl.inc"
diff --git a/src/packlib/kernlib/kernnum/f003fort/dujk.inc b/src/packlib/kernlib/kernnum/f003fort/dujk.inc
deleted file mode 100644
index f0a6375..0000000
--- a/src/packlib/kernlib/kernnum/f003fort/dujk.inc
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: dujk.inc,v 1.1.1.1 1996/02/15 17:48:54 mclareni Exp $
-*
-* $Log: dujk.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:54 mclareni
-* Kernlib
-*
-*
-*
-* dujk.inc
-*
-#if defined(CERNLIB_NUMAP)||defined(CERNLIB_NUMCD)||defined(CERNLIB_NUMCV)||defined(CERNLIB_NUMIB2)||defined(CERNLIB_NUMND)
- JU = (LOCF(U12) - LOCF(U)) / 2
- KU = (LOCF(U22) - LOCF(U)) / 2
-#endif
-#if defined(CERNLIB_NUMCR)||defined(CERNLIB_NUMUC)
- JU = (LOC(U12) - LOC(U)) / 2
- KU = (LOC(U22) - LOC(U)) / 2
-#endif
-#if defined(CERNLIB_NUMDE)
- JU = (%LOC(U12) - %LOC(U)) / 8
- KU = (%LOC(U22) - %LOC(U)) / 8
-#endif
-#if defined(CERNLIB_NUMIB1)
- JU = (IADDR(U12) - IADDR(U)) / 8
- KU = (IADDR(U22) - IADDR(U)) / 8
-#endif
diff --git a/src/packlib/kernlib/kernnum/f003fort/dumna.F b/src/packlib/kernlib/kernnum/f003fort/dumna.F
deleted file mode 100644
index 878942f..0000000
--- a/src/packlib/kernlib/kernnum/f003fort/dumna.F
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: dumna.F,v 1.1.1.1 1996/02/15 17:48:59 mclareni Exp $
-*
-* $Log: dumna.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:59 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE DUMNA(N,U,U12,U22,Y,Y2,Z,Z2)
- DOUBLE PRECISION U(*),U12(*),U22(*),Y(*),Y2(*),Z(*),Z2(*)
- DOUBLE PRECISION A, B, SUM, F,SIGNF
- F(A,B,SUM) = -A*B + SUM
- SIGNF(A) = A
- IF(N .LE. 0) RETURN
-#include "dujk.inc"
-#include "dyj.inc"
-#include "dzi.inc"
-#include "umpa.inc"
diff --git a/src/packlib/kernlib/kernnum/f003fort/dumns.F b/src/packlib/kernlib/kernnum/f003fort/dumns.F
deleted file mode 100644
index c805910..0000000
--- a/src/packlib/kernlib/kernnum/f003fort/dumns.F
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: dumns.F,v 1.1.1.1 1996/02/15 17:48:59 mclareni Exp $
-*
-* $Log: dumns.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:59 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE DUMNS(N,U,U12,U22,Y,Y2,Z,Z2)
- DOUBLE PRECISION U(*),U12(*),U22(*),Y(*),Y2(*),Z(*),Z2(*)
- DOUBLE PRECISION A, B, SUM, F, SIGNF
- F(A,B,SUM) = -A*B + SUM
- SIGNF(A) = -A
- IF(N .LE. 0) RETURN
-#include "dujk.inc"
-#include "dyj.inc"
-#include "dzi.inc"
-#include "umpa.inc"
diff --git a/src/packlib/kernlib/kernnum/f003fort/dumpa.F b/src/packlib/kernlib/kernnum/f003fort/dumpa.F
deleted file mode 100644
index c868608..0000000
--- a/src/packlib/kernlib/kernnum/f003fort/dumpa.F
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: dumpa.F,v 1.1.1.1 1996/02/15 17:48:59 mclareni Exp $
-*
-* $Log: dumpa.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:59 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE DUMPA(N,U,U12,U22,Y,Y2,Z,Z2)
- DOUBLE PRECISION U(*),U12(*),U22(*),Y(*),Y2(*),Z(*),Z2(*)
- DOUBLE PRECISION A, B, SUM, F, SIGNF
- F(A,B,SUM) = A*B + SUM
- SIGNF(A) = A
- IF(N .LE. 0) RETURN
-#include "dujk.inc"
-#include "dyj.inc"
-#include "dzi.inc"
-#include "umpa.inc"
diff --git a/src/packlib/kernlib/kernnum/f003fort/dumps.F b/src/packlib/kernlib/kernnum/f003fort/dumps.F
deleted file mode 100644
index 796c8f6..0000000
--- a/src/packlib/kernlib/kernnum/f003fort/dumps.F
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: dumps.F,v 1.1.1.1 1996/02/15 17:48:59 mclareni Exp $
-*
-* $Log: dumps.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:59 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE DUMPS(N,U,U12,U22,Y,Y2,Z,Z2)
- DOUBLE PRECISION U(*),U12(*),U22(*),Y(*),Y2(*),Z(*),Z2(*)
- DOUBLE PRECISION A, B, SUM, F, SIGNF
- F(A,B,SUM) = A*B + SUM
- SIGNF(A) = -A
- IF(N .LE. 0) RETURN
-#include "dujk.inc"
-#include "dyj.inc"
-#include "dzi.inc"
-#include "umpa.inc"
diff --git a/src/packlib/kernlib/kernnum/f003fort/dumpy.F b/src/packlib/kernlib/kernnum/f003fort/dumpy.F
deleted file mode 100644
index bda3a34..0000000
--- a/src/packlib/kernlib/kernnum/f003fort/dumpy.F
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: dumpy.F,v 1.1.1.1 1996/02/15 17:49:00 mclareni Exp $
-*
-* $Log: dumpy.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:00 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE DUMPY(N,U,U12,U22,Y,Y2,Z,Z2)
- DOUBLE PRECISION U(*),U12(*),U22(*),Y(*),Y2(*),Z(*),Z2(*)
- DOUBLE PRECISION A, B, SUM, ZERO, F
- F(A,B,SUM) = A*B + SUM
- DATA ZERO / 0.D0 /
- IF(N .LE. 0) RETURN
-#include "dujk.inc"
-#include "dyj.inc"
-#include "dzi.inc"
-#include "umpy.inc"
diff --git a/src/packlib/kernlib/kernnum/f003fort/dxi.inc b/src/packlib/kernlib/kernnum/f003fort/dxi.inc
deleted file mode 100644
index 6803e0b..0000000
--- a/src/packlib/kernlib/kernnum/f003fort/dxi.inc
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: dxi.inc,v 1.1.1.1 1996/02/15 17:48:54 mclareni Exp $
-*
-* $Log: dxi.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:54 mclareni
-* Kernlib
-*
-*
-*
-* dxi.inc
-*
-#if defined(CERNLIB_NUMAP)||defined(CERNLIB_NUMCD)||defined(CERNLIB_NUMCV)||defined(CERNLIB_NUMIB2)||defined(CERNLIB_NUMND)
- IX = (LOCF(X2) - LOCF(X)) / 2
-#endif
-#if defined(CERNLIB_NUMCR)||defined(CERNLIB_NUMUC)
- IX = (LOC(X2) - LOC(X)) / 2
-#endif
-#if defined(CERNLIB_NUMDE)
- IX = (%LOC(X2) - %LOC(X)) / 8
-#endif
-#if defined(CERNLIB_NUMIB1)
- IX = (IADDR(X2) - IADDR(X)) / 8
-#endif
diff --git a/src/packlib/kernlib/kernnum/f003fort/dxij.inc b/src/packlib/kernlib/kernnum/f003fort/dxij.inc
deleted file mode 100644
index 3a4063f..0000000
--- a/src/packlib/kernlib/kernnum/f003fort/dxij.inc
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: dxij.inc,v 1.1.1.1 1996/02/15 17:48:55 mclareni Exp $
-*
-* $Log: dxij.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:55 mclareni
-* Kernlib
-*
-*
-*
-* dxij.inc
-*
-#if defined(CERNLIB_NUMAP)||defined(CERNLIB_NUMCD)||defined(CERNLIB_NUMCV)||defined(CERNLIB_NUMIB2)||defined(CERNLIB_NUMND)
- IX = (LOCF(X21) - LOCF(X)) / 2
- JX = (LOCF(X12) - LOCF(X)) / 2
-#endif
-#if defined(CERNLIB_NUMCR)||defined(CERNLIB_NUMUC)
- IX = (LOC(X21) - LOC(X)) / 2
- JX = (LOC(X12) - LOC(X)) / 2
-#endif
-#if defined(CERNLIB_NUMDE)
- IX = (%LOC(X21) - %LOC(X)) / 8
- JX = (%LOC(X12) - %LOC(X)) / 8
-#endif
-#if defined(CERNLIB_NUMIB1)
- IX = (IADDR(X21) - IADDR(X)) / 8
- JX = (IADDR(X12) - IADDR(X)) / 8
-#endif
diff --git a/src/packlib/kernlib/kernnum/f003fort/dyij.inc b/src/packlib/kernlib/kernnum/f003fort/dyij.inc
deleted file mode 100644
index 96220aa..0000000
--- a/src/packlib/kernlib/kernnum/f003fort/dyij.inc
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: dyij.inc,v 1.1.1.1 1996/02/15 17:48:55 mclareni Exp $
-*
-* $Log: dyij.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:55 mclareni
-* Kernlib
-*
-*
-*
-* dyij.inc
-*
-#if defined(CERNLIB_NUMAP)||defined(CERNLIB_NUMCD)||defined(CERNLIB_NUMCV)||defined(CERNLIB_NUMIB2)||defined(CERNLIB_NUMND)
- IY = (LOCF(Y21) - LOCF(Y)) / 2
- JY = (LOCF(Y12) - LOCF(Y)) / 2
-#endif
-#if defined(CERNLIB_NUMCR)||defined(CERNLIB_NUMUC)
- IY = (LOC(Y21) - LOC(Y)) / 2
- JY = (LOC(Y12) - LOC(Y)) / 2
-#endif
-#if defined(CERNLIB_NUMDE)
- IY = (%LOC(Y21) - %LOC(Y)) / 8
- JY = (%LOC(Y12) - %LOC(Y)) / 8
-#endif
-#if defined(CERNLIB_NUMIB1)
- IY = (IADDR(Y21) - IADDR(Y)) / 8
- JY = (IADDR(Y12) - IADDR(Y)) / 8
-#endif
diff --git a/src/packlib/kernlib/kernnum/f003fort/dyj.inc b/src/packlib/kernlib/kernnum/f003fort/dyj.inc
deleted file mode 100644
index bac7543..0000000
--- a/src/packlib/kernlib/kernnum/f003fort/dyj.inc
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: dyj.inc,v 1.1.1.1 1996/02/15 17:48:55 mclareni Exp $
-*
-* $Log: dyj.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:55 mclareni
-* Kernlib
-*
-*
-*
-* dyj.inc
-*
-#if defined(CERNLIB_NUMAP)||defined(CERNLIB_NUMCD)||defined(CERNLIB_NUMCV)||defined(CERNLIB_NUMIB2)||defined(CERNLIB_NUMND)
- JY = (LOCF(Y2) - LOCF(Y)) / 2
-#endif
-#if defined(CERNLIB_NUMCR)||defined(CERNLIB_NUMUC)
- JY = (LOC(Y2) - LOC(Y)) / 2
-#endif
-#if defined(CERNLIB_NUMDE)
- JY = (%LOC(Y2) - %LOC(Y)) / 8
-#endif
-#if defined(CERNLIB_NUMIB1)
- JY = (IADDR(Y2) - IADDR(Y)) / 8
-#endif
diff --git a/src/packlib/kernlib/kernnum/f003fort/dzi.inc b/src/packlib/kernlib/kernnum/f003fort/dzi.inc
deleted file mode 100644
index 8eb1719..0000000
--- a/src/packlib/kernlib/kernnum/f003fort/dzi.inc
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: dzi.inc,v 1.1.1.1 1996/02/15 17:48:55 mclareni Exp $
-*
-* $Log: dzi.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:55 mclareni
-* Kernlib
-*
-*
-*
-* dzi.inc
-*
-#if defined(CERNLIB_NUMAP)||defined(CERNLIB_NUMCD)||defined(CERNLIB_NUMCV)||defined(CERNLIB_NUMIB2)||defined(CERNLIB_NUMND)
- IZ = (LOCF(Z2) - LOCF(Z)) / 2
-#endif
-#if defined(CERNLIB_NUMCR)||defined(CERNLIB_NUMUC)
- IZ = (LOC(Z2) - LOC(Z)) / 2
-#endif
-#if defined(CERNLIB_NUMDE)
- IZ = (%LOC(Z2) - %LOC(Z)) / 8
-#endif
-#if defined(CERNLIB_NUMIB1)
- IZ = (IADDR(Z2) - IADDR(Z)) / 8
-#endif
diff --git a/src/packlib/kernlib/kernnum/f003fort/dzij.inc b/src/packlib/kernlib/kernnum/f003fort/dzij.inc
deleted file mode 100644
index 140a310..0000000
--- a/src/packlib/kernlib/kernnum/f003fort/dzij.inc
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: dzij.inc,v 1.1.1.1 1996/02/15 17:48:55 mclareni Exp $
-*
-* $Log: dzij.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:55 mclareni
-* Kernlib
-*
-*
-*
-* dzij.inc
-*
-#if defined(CERNLIB_NUMAP)||defined(CERNLIB_NUMCD)||defined(CERNLIB_NUMCV)||defined(CERNLIB_NUMIB2)||defined(CERNLIB_NUMND)
- IZ = (LOCF(Z21) - LOCF(Z)) / 2
- JZ = (LOCF(Z12) - LOCF(Z)) / 2
-#endif
-#if defined(CERNLIB_NUMCR)||defined(CERNLIB_NUMUC)
- IZ = (LOC(Z21) - LOC(Z)) / 2
- JZ = (LOC(Z12) - LOC(Z)) / 2
-#endif
-#if defined(CERNLIB_NUMDE)
- IZ = (%LOC(Z21) - %LOC(Z)) / 8
- JZ = (%LOC(Z12) - %LOC(Z)) / 8
-#endif
-#if defined(CERNLIB_NUMIB1)
- IZ = (IADDR(Z21) - IADDR(Z)) / 8
- JZ = (IADDR(Z12) - IADDR(Z)) / 8
-#endif
diff --git a/src/packlib/kernlib/kernnum/f003fort/dzj.inc b/src/packlib/kernlib/kernnum/f003fort/dzj.inc
deleted file mode 100644
index 8e0cc83..0000000
--- a/src/packlib/kernlib/kernnum/f003fort/dzj.inc
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: dzj.inc,v 1.1.1.1 1996/02/15 17:48:56 mclareni Exp $
-*
-* $Log: dzj.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:56 mclareni
-* Kernlib
-*
-*
-*
-* dzj.inc
-*
-#if defined(CERNLIB_NUMAP)||defined(CERNLIB_NUMCD)||defined(CERNLIB_NUMCV)||defined(CERNLIB_NUMIB2)||defined(CERNLIB_NUMND)
- JZ = (LOCF(Z2) - LOCF(Z)) / 2
-#endif
-#if defined(CERNLIB_NUMCR)||defined(CERNLIB_NUMUC)
- JZ = (LOC(Z2) - LOC(Z)) / 2
-#endif
-#if defined(CERNLIB_NUMDE)
- JZ = (%LOC(Z2) - %LOC(Z)) / 8
-#endif
-#if defined(CERNLIB_NUMIB1)
- JZ = (IADDR(Z2) - IADDR(Z)) / 8
-#endif
diff --git a/src/packlib/kernlib/kernnum/f003fort/madd.inc b/src/packlib/kernlib/kernnum/f003fort/madd.inc
deleted file mode 100644
index fe4621d..0000000
--- a/src/packlib/kernlib/kernnum/f003fort/madd.inc
+++ /dev/null
@@ -1,46 +0,0 @@
-*
-* $Id: madd.inc,v 1.1.1.1 1996/02/15 17:48:56 mclareni Exp $
-*
-* $Log: madd.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:56 mclareni
-* Kernlib
-*
-*
-*
-* madd.inc
-*
- MM = M
- NN = N
- IF(MM .GT. NN) THEN
- MN = NN
- NN = MM
- MM = MN
- IJ = JX
- JX = IX
- IX = IJ
- IJ = JY
- JY = IY
- IY = IJ
- IJ = JZ
- JZ = IZ
- IZ = IJ
- ENDIF
- LXI1 = 1
- LYI1 = 1
- LZI1 = 1
- DO 12 I = 1, MM
- LXIJ = LXI1
- LYIJ = LYI1
- LZIJ = LZI1
- DO 11 J = 1, NN
- Z(LZIJ) = ADD( X(LXIJ),Y(LYIJ) )
- LXIJ = LXIJ + JX
- LYIJ = LYIJ + JY
- LZIJ = LZIJ + JZ
- 11 CONTINUE
- LXI1 = LXI1 + IX
- LYI1 = LYI1 + IY
- LZI1 = LZI1 + IZ
- 12 CONTINUE
- RETURN
- END
diff --git a/src/packlib/kernlib/kernnum/f003fort/mbil.inc b/src/packlib/kernlib/kernnum/f003fort/mbil.inc
deleted file mode 100644
index f141055..0000000
--- a/src/packlib/kernlib/kernnum/f003fort/mbil.inc
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: mbil.inc,v 1.1.1.1 1996/02/15 17:48:56 mclareni Exp $
-*
-* $Log: mbil.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:56 mclareni
-* Kernlib
-*
-*
-*
-* mbil.inc
-*
- LXI = 1
- LYI = 1
- DO 12 I = 1, N
- SYZ = ZERO
- LYIJ = LYI
- LZJ = 1
- DO 11 J = 1, N
- SYZ = F(Y(LYIJ),Z(LZJ),SYZ)
- LYIJ = LYIJ + JY
- LZJ = LZJ + JZ
- 11 CONTINUE
- SXYZ = G(SYZ,X(LXI),SXYZ)
- LXI = LXI + IX
- LYI = LYI + IY
- 12 CONTINUE
diff --git a/src/packlib/kernlib/kernnum/f003fort/mcpy.inc b/src/packlib/kernlib/kernnum/f003fort/mcpy.inc
deleted file mode 100644
index cd63b3e..0000000
--- a/src/packlib/kernlib/kernnum/f003fort/mcpy.inc
+++ /dev/null
@@ -1,39 +0,0 @@
-*
-* $Id: mcpy.inc,v 1.1.1.1 1996/02/15 17:48:56 mclareni Exp $
-*
-* $Log: mcpy.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:56 mclareni
-* Kernlib
-*
-*
-*
-* mcpy.inc
-*
- MM = M
- NN = N
- IF(MM .GT. NN) THEN
- MN = NN
- NN = MM
- MM = MN
- IJ = JX
- JX = IX
- IX = IJ
- IJ = JZ
- JZ = IZ
- IZ = IJ
- ENDIF
- LXI1 = 1
- LZI1 = 1
- DO 12 I = 1, MM
- LXIJ = LXI1
- LZIJ = LZI1
- DO 11 J = 1, NN
- Z(LZIJ) = FUNCT( X(LXIJ) )
- LXIJ = LXIJ + JX
- LZIJ = LZIJ + JZ
- 11 CONTINUE
- LXI1 = LXI1 + IX
- LZI1 = LZI1 + IZ
- 12 CONTINUE
- RETURN
- END
diff --git a/src/packlib/kernlib/kernnum/f003fort/mmpa.inc b/src/packlib/kernlib/kernnum/f003fort/mmpa.inc
deleted file mode 100644
index 374f8d9..0000000
--- a/src/packlib/kernlib/kernnum/f003fort/mmpa.inc
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: mmpa.inc,v 1.1.1.1 1996/02/15 17:48:56 mclareni Exp $
-*
-* $Log: mmpa.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:56 mclareni
-* Kernlib
-*
-*
-*
-* mmpa.inc
-*
- LXI1 = 1
- LZI = 1
- DO 12 I = 1, M
- LXIJ = LXI1
- LYJ = 1
- SUM = SIGNF( Z(LZI) )
- DO 11 J = 1, N
- SUM = F(X(LXIJ),Y(LYJ),SUM)
- LXIJ = LXIJ + JX
- LYJ = LYJ + JY
- 11 CONTINUE
- Z(LZI) = SUM
- LXI1 = LXI1 + IX
- LZI = LZI + IZ
- 12 CONTINUE
- RETURN
- END
diff --git a/src/packlib/kernlib/kernnum/f003fort/mmpy.inc b/src/packlib/kernlib/kernnum/f003fort/mmpy.inc
deleted file mode 100644
index 2b57458..0000000
--- a/src/packlib/kernlib/kernnum/f003fort/mmpy.inc
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: mmpy.inc,v 1.1.1.1 1996/02/15 17:48:56 mclareni Exp $
-*
-* $Log: mmpy.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:56 mclareni
-* Kernlib
-*
-*
-*
-* mmpy.inc
-*
- LXI1 = 1
- LZI = 1
- DO 12 I = 1, M
- LXIJ = LXI1
- LYJ = 1
- SUM = ZERO
- DO 11 J = 1, N
- SUM = F(X(LXIJ),Y(LYJ),SUM)
- LXIJ = LXIJ + JX
- LYJ = LYJ + JY
- 11 CONTINUE
- Z(LZI) = SUM
- LXI1 = LXI1 + IX
- LZI = LZI + IZ
- 12 CONTINUE
- RETURN
- END
diff --git a/src/packlib/kernlib/kernnum/f003fort/mset.inc b/src/packlib/kernlib/kernnum/f003fort/mset.inc
deleted file mode 100644
index 23d386f..0000000
--- a/src/packlib/kernlib/kernnum/f003fort/mset.inc
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: mset.inc,v 1.1.1.1 1996/02/15 17:48:56 mclareni Exp $
-*
-* $Log: mset.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:56 mclareni
-* Kernlib
-*
-*
-*
-* mset.inc
-*
- MM = M
- NN = N
- IF(MM .GT. NN) THEN
- MN = NN
- NN = MM
- MM = MN
- IJ = JZ
- JZ = IZ
- IZ = IJ
- ENDIF
- LZI1 = 1
- DO 12 I = 1, MM
- LZIJ = LZI1
- DO 11 J = 1, NN
- Z(LZIJ) = S
- LZIJ = LZIJ + JZ
- 11 CONTINUE
- LZI1 = LZI1 + IZ
- 12 CONTINUE
- RETURN
- END
diff --git a/src/packlib/kernlib/kernnum/f003fort/mutl.inc b/src/packlib/kernlib/kernnum/f003fort/mutl.inc
deleted file mode 100644
index 15eedc4..0000000
--- a/src/packlib/kernlib/kernnum/f003fort/mutl.inc
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: mutl.inc,v 1.1.1.1 1996/02/15 17:48:56 mclareni Exp $
-*
-* $Log: mutl.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:56 mclareni
-* Kernlib
-*
-*
-*
-* mutl.inc
-*
- LXII = 1
- DO 12 IP1 = 2, N
- LXIJ = LXII
- LXJI = LXII
- DO 11 J = IP1, N
- LXIJ = LXIJ + JX
- LXJI = LXJI + IX
- X(LXJI) = X(LXIJ)
- 11 CONTINUE
- LXII = LXII + IX + JX
- 12 CONTINUE
- RETURN
- END
diff --git a/src/packlib/kernlib/kernnum/f003fort/rdi.inc b/src/packlib/kernlib/kernnum/f003fort/rdi.inc
deleted file mode 100644
index 166a60f..0000000
--- a/src/packlib/kernlib/kernnum/f003fort/rdi.inc
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: rdi.inc,v 1.1.1.1 1996/02/15 17:48:54 mclareni Exp $
-*
-* $Log: rdi.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:54 mclareni
-* Kernlib
-*
-*
-*
-* rdi.inc
-*
-#if defined(CERNLIB_NUMAP)||defined(CERNLIB_NUMCD)||defined(CERNLIB_NUMCV)||defined(CERNLIB_NUMIB2)||defined(CERNLIB_NUMND)
- ID = LOCF(D2) - LOCF(D)
-#endif
-#if defined(CERNLIB_NUMCR)||defined(CERNLIB_NUMUC)
- ID = LOC(D2) - LOC(D)
-#endif
-#if defined(CERNLIB_NUMDE)
- ID = (%LOC(D2) - %LOC(D)) / 4
-#endif
-#if defined(CERNLIB_NUMIB1)
- ID = (IADDR(D2) - IADDR(D)) / 4
-#endif
diff --git a/src/packlib/kernlib/kernnum/f003fort/rmadd.F b/src/packlib/kernlib/kernnum/f003fort/rmadd.F
deleted file mode 100644
index 53aa21f..0000000
--- a/src/packlib/kernlib/kernnum/f003fort/rmadd.F
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: rmadd.F,v 1.1.1.1 1996/02/15 17:48:56 mclareni Exp $
-*
-* $Log: rmadd.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:56 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE RMADD(M,N,X,X12,X21,Y,Y12,Y21,Z,Z12,Z21)
- REAL X(*), X12(*), X21(*), Y(*), Y12(*), Y21(*)
- REAL Z(*), Z12(*), Z21(*), ADD, A, B
- ADD(A,B) = A+B
- IF(M .LE. 0 .OR. N .LE. 0) RETURN
-#include "rxij.inc"
-#include "ryij.inc"
-#include "rzij.inc"
-#include "madd.inc"
diff --git a/src/packlib/kernlib/kernnum/f003fort/rmbil.F b/src/packlib/kernlib/kernnum/f003fort/rmbil.F
deleted file mode 100644
index f91a4cb..0000000
--- a/src/packlib/kernlib/kernnum/f003fort/rmbil.F
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: rmbil.F,v 1.1.1.1 1996/02/15 17:48:56 mclareni Exp $
-*
-* $Log: rmbil.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:56 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- REAL FUNCTION RMBIL(N,X,X2,Y,Y12,Y21,Z,Z2)
- REAL X(*),X2(*),Y(*),Y12(*),Y21(*),Z(*),Z2(*)
- REAL A, B
-#if !defined(CERNLIB_NUMRDBLE)
- REAL SUM, ZERO, F, G, SXYZ, SYZ
- F(A,B,SUM) = A*B + SUM
- G(SYZ,B,SUM) = SYZ*B + SUM
- DATA ZERO / 0. /
-#endif
-#if defined(CERNLIB_NUMRDBLE)
- DOUBLE PRECISION SUM, ZERO, F, G, SXYZ, SYZ
- F(A,B,SUM) = DBLE(A)*DBLE(B) + SUM
- G(SYZ,B,SUM) = SYZ*DBLE(B) + SUM
- DATA ZERO / 0.D0 /
-#endif
- SXYZ = ZERO
- IF(N .LE. 0) GOTO 20
-#include "rxi.inc"
-#include "ryij.inc"
-#include "rzj.inc"
-#include "mbil.inc"
- 20 RMBIL = SXYZ
- RETURN
- END
diff --git a/src/packlib/kernlib/kernnum/f003fort/rmcpy.F b/src/packlib/kernlib/kernnum/f003fort/rmcpy.F
deleted file mode 100644
index b30578f..0000000
--- a/src/packlib/kernlib/kernnum/f003fort/rmcpy.F
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: rmcpy.F,v 1.1.1.1 1996/02/15 17:48:56 mclareni Exp $
-*
-* $Log: rmcpy.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:56 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE RMCPY(M,N,X,X12,X21,Z,Z12,Z21)
- REAL X(*),X12(*),X21(*),Z(*),Z12(*),Z21(*)
- REAL FUNCT, A
- FUNCT(A) = A
- IF(M .LE. 0 .OR. N .LE. 0) RETURN
-#include "rxij.inc"
-#include "rzij.inc"
-#include "mcpy.inc"
diff --git a/src/packlib/kernlib/kernnum/f003fort/rmmna.F b/src/packlib/kernlib/kernnum/f003fort/rmmna.F
deleted file mode 100644
index 513ce23..0000000
--- a/src/packlib/kernlib/kernnum/f003fort/rmmna.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: rmmna.F,v 1.1.1.1 1996/02/15 17:48:57 mclareni Exp $
-*
-* $Log: rmmna.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:57 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE RMMNA(M,N,X,X12,X21,Y,Y2,Z,Z2)
- REAL X(*),X12(*),X21(*),Y(*),Y2(*),Z(*),Z2(*)
- REAL A, B, SIGNF
-#if defined(CERNLIB_NUMRDBLE)
- DOUBLE PRECISION SUM, F
- F(A,B,SUM) = -DBLE(A)*DBLE(B) + SUM
-#endif
-#if !defined(CERNLIB_NUMRDBLE)
- REAL SUM, F
- F(A,B,SUM) = -A*B + SUM
-#endif
- SIGNF(A) = A
- IF(M .LE. 0 .OR. N .LE. 0) RETURN
-#include "rxij.inc"
-#include "ryj.inc"
-#include "rzi.inc"
-#include "mmpa.inc"
diff --git a/src/packlib/kernlib/kernnum/f003fort/rmmns.F b/src/packlib/kernlib/kernnum/f003fort/rmmns.F
deleted file mode 100644
index e531d7e..0000000
--- a/src/packlib/kernlib/kernnum/f003fort/rmmns.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: rmmns.F,v 1.1.1.1 1996/02/15 17:48:57 mclareni Exp $
-*
-* $Log: rmmns.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:57 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE RMMNS(M,N,X,X12,X21,Y,Y2,Z,Z2)
- REAL X(*),X12(*),X21(*),Y(*),Y2(*),Z(*),Z2(*)
- REAL A, B, SIGNF
-#if defined(CERNLIB_NUMRDBLE)
- DOUBLE PRECISION SUM, F
- F(A,B,SUM) = -DBLE(A)*DBLE(B) + SUM
-#endif
-#if !defined(CERNLIB_NUMRDBLE)
- REAL SUM, F
- F(A,B,SUM) = -A*B + SUM
-#endif
- SIGNF(A) = -A
- IF(M .LE. 0 .OR. N .LE. 0) RETURN
-#include "rxij.inc"
-#include "ryj.inc"
-#include "rzi.inc"
-#include "mmpa.inc"
diff --git a/src/packlib/kernlib/kernnum/f003fort/rmmpa.F b/src/packlib/kernlib/kernnum/f003fort/rmmpa.F
deleted file mode 100644
index 1b75086..0000000
--- a/src/packlib/kernlib/kernnum/f003fort/rmmpa.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: rmmpa.F,v 1.1.1.1 1996/02/15 17:48:57 mclareni Exp $
-*
-* $Log: rmmpa.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:57 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE RMMPA(M,N,X,X12,X21,Y,Y2,Z,Z2)
- REAL X(*),X12(*),X21(*),Y(*),Y2(*),Z(*),Z2(*)
- REAL A, B, SIGNF
-#if defined(CERNLIB_NUMRDBLE)
- DOUBLE PRECISION SUM, F
- F(A,B,SUM) = DBLE(A)*DBLE(B) + SUM
-#endif
-#if !defined(CERNLIB_NUMRDBLE)
- REAL SUM, F
- F(A,B,SUM) = A*B + SUM
-#endif
- SIGNF(A) = A
- IF(M .LE. 0 .OR. N .LE. 0) RETURN
-#include "rxij.inc"
-#include "ryj.inc"
-#include "rzi.inc"
-#include "mmpa.inc"
diff --git a/src/packlib/kernlib/kernnum/f003fort/rmmps.F b/src/packlib/kernlib/kernnum/f003fort/rmmps.F
deleted file mode 100644
index bc8ecac..0000000
--- a/src/packlib/kernlib/kernnum/f003fort/rmmps.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: rmmps.F,v 1.1.1.1 1996/02/15 17:48:57 mclareni Exp $
-*
-* $Log: rmmps.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:57 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE RMMPS(M,N,X,X12,X21,Y,Y2,Z,Z2)
- REAL X(*),X12(*),X21(*),Y(*),Y2(*),Z(*),Z2(*)
- REAL A, B, SIGNF
-#if defined(CERNLIB_NUMRDBLE)
- DOUBLE PRECISION SUM, F
- F(A,B,SUM) = DBLE(A)*DBLE(B) + SUM
-#endif
-#if !defined(CERNLIB_NUMRDBLE)
- REAL SUM, F
- F(A,B,SUM) = A*B + SUM
-#endif
- SIGNF(A) = -A
- IF(M .LE. 0 .OR. N .LE. 0) RETURN
-#include "rxij.inc"
-#include "ryj.inc"
-#include "rzi.inc"
-#include "mmpa.inc"
diff --git a/src/packlib/kernlib/kernnum/f003fort/rmmpy.F b/src/packlib/kernlib/kernnum/f003fort/rmmpy.F
deleted file mode 100644
index 33ecb9c..0000000
--- a/src/packlib/kernlib/kernnum/f003fort/rmmpy.F
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: rmmpy.F,v 1.1.1.1 1996/02/15 17:48:57 mclareni Exp $
-*
-* $Log: rmmpy.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:57 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE RMMPY(M,N,X,X12,X21,Y,Y2,Z,Z2)
- REAL X(*),X12(*),X21(*),Y(*),Y2(*),Z(*),Z2(*)
-#if defined(CERNLIB_NUMRDBLE)
- REAL A, B
- DOUBLE PRECISION SUM, ZERO, F
- F(A,B,SUM) = DBLE(A)*DBLE(B) + SUM
- DATA ZERO / 0.D0 /
-#endif
-#if !defined(CERNLIB_NUMRDBLE)
- REAL A, B, SUM, ZERO, F
- F(A,B,SUM) = A*B + SUM
- DATA ZERO / 0. /
-#endif
- IF(M .LE. 0 .OR. N .LE. 0) RETURN
-#include "rxij.inc"
-#include "ryj.inc"
-#include "rzi.inc"
-#include "mmpy.inc"
diff --git a/src/packlib/kernlib/kernnum/f003fort/rmran.F b/src/packlib/kernlib/kernnum/f003fort/rmran.F
deleted file mode 100644
index a2afa9d..0000000
--- a/src/packlib/kernlib/kernnum/f003fort/rmran.F
+++ /dev/null
@@ -1,35 +0,0 @@
-*
-* $Id: rmran.F,v 1.1.1.1 1996/02/15 17:48:58 mclareni Exp $
-*
-* $Log: rmran.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:58 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE RMRAN(M,N,A,B,Z,Z12,Z21)
- REAL A, B, Z(*), Z12(*), Z21(*), C
- IF(M .LE. 0 .OR. N .LE. 0) RETURN
-#include "rzij.inc"
- MM = M
- NN = N
- IF(MM .GT. NN) THEN
- MN = NN
- NN = MM
- MM = MN
- IJ = JZ
- JZ = IZ
- IZ = IJ
- ENDIF
- C = B - A
- LZI1 = 1
- DO 12 I = 1, MM
- LZIJ = LZI1
- DO 11 J = 1, NN
- Z(LZIJ) = C * RANF() + A
- LZIJ = LZIJ + JZ
- 11 CONTINUE
- LZI1 = LZI1 + IZ
- 12 CONTINUE
- RETURN
- END
diff --git a/src/packlib/kernlib/kernnum/f003fort/rmscl.F b/src/packlib/kernlib/kernnum/f003fort/rmscl.F
deleted file mode 100644
index 649eb4e..0000000
--- a/src/packlib/kernlib/kernnum/f003fort/rmscl.F
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: rmscl.F,v 1.1.1.1 1996/02/15 17:48:58 mclareni Exp $
-*
-* $Log: rmscl.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:58 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE RMSCL(M,N,S,X,X12,X21,Z,Z12,Z21)
- REAL S, X(*),X12(*),X21(*), Z(*),Z12(*),Z21(*)
- REAL FUNCT, A
- FUNCT(A) = S*A
- IF(M .LE. 0 .OR. N .LE. 0) RETURN
-#include "rxij.inc"
-#include "rzij.inc"
-#include "mcpy.inc"
diff --git a/src/packlib/kernlib/kernnum/f003fort/rmset.F b/src/packlib/kernlib/kernnum/f003fort/rmset.F
deleted file mode 100644
index 667dac1..0000000
--- a/src/packlib/kernlib/kernnum/f003fort/rmset.F
+++ /dev/null
@@ -1,14 +0,0 @@
-*
-* $Id: rmset.F,v 1.1.1.1 1996/02/15 17:48:58 mclareni Exp $
-*
-* $Log: rmset.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:58 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE RMSET(M,N,S,Z,Z12,Z21)
- REAL S, Z(*), Z12(*), Z21(*)
- IF(M .LE. 0 .OR. N .LE. 0) RETURN
-#include "rzij.inc"
-#include "mset.inc"
diff --git a/src/packlib/kernlib/kernnum/f003fort/rmsub.F b/src/packlib/kernlib/kernnum/f003fort/rmsub.F
deleted file mode 100644
index 6a8c417..0000000
--- a/src/packlib/kernlib/kernnum/f003fort/rmsub.F
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: rmsub.F,v 1.1.1.1 1996/02/15 17:48:58 mclareni Exp $
-*
-* $Log: rmsub.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:58 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE RMSUB(M,N,X,X12,X21,Y,Y12,Y21,Z,Z12,Z21)
- REAL X(*), X12(*), X21(*), Y(*), Y12(*), Y21(*)
- REAL Z(*), Z12(*), Z21(*), ADD, A, B
- ADD(A,B) = A-B
-#include "rxij.inc"
-#include "ryij.inc"
-#include "rzij.inc"
-#include "madd.inc"
diff --git a/src/packlib/kernlib/kernnum/f003fort/rmutl.F b/src/packlib/kernlib/kernnum/f003fort/rmutl.F
deleted file mode 100644
index 8ad7a9c..0000000
--- a/src/packlib/kernlib/kernnum/f003fort/rmutl.F
+++ /dev/null
@@ -1,14 +0,0 @@
-*
-* $Id: rmutl.F,v 1.1.1.1 1996/02/15 17:48:59 mclareni Exp $
-*
-* $Log: rmutl.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:59 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE RMUTL(N,X,X12,X21)
- REAL X(*), X12(*), X21(*)
- IF(N .LE. 1) RETURN
-#include "rxij.inc"
-#include "mutl.inc"
diff --git a/src/packlib/kernlib/kernnum/f003fort/rrscl.F b/src/packlib/kernlib/kernnum/f003fort/rrscl.F
deleted file mode 100644
index b41911a..0000000
--- a/src/packlib/kernlib/kernnum/f003fort/rrscl.F
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: rrscl.F,v 1.1.1.1 1996/02/15 17:48:59 mclareni Exp $
-*
-* $Log: rrscl.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:59 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE RRSCL(M,N,D,D2,X,X12,X21,Z,Z12,Z21)
- REAL D(*),D2(*),X(*),X12(*),X21(*),Z(*),Z12(*),Z21(*)
- IF(M .LE. 0 .OR. N .LE. 0) RETURN
-#include "rdi.inc"
-#include "rxij.inc"
-#include "rzij.inc"
-#include "rscl.inc"
diff --git a/src/packlib/kernlib/kernnum/f003fort/rscl.inc b/src/packlib/kernlib/kernnum/f003fort/rscl.inc
deleted file mode 100644
index 3ef8058..0000000
--- a/src/packlib/kernlib/kernnum/f003fort/rscl.inc
+++ /dev/null
@@ -1,30 +0,0 @@
-*
-* $Id: rscl.inc,v 1.1.1.1 1996/02/15 17:48:56 mclareni Exp $
-*
-* $Log: rscl.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:56 mclareni
-* Kernlib
-*
-*
-*
-* rscl.inc
-*
- MM = M
- NN = N
- LDI = 1
- LXI1 = 1
- LZI1 = 1
- DO 12 I = 1, MM
- LXIJ = LXI1
- LZIJ = LZI1
- DO 11 J = 1, NN
- Z(LZIJ) = D(LDI)*X(LXIJ)
- LXIJ = LXIJ + JX
- LZIJ = LZIJ + JZ
- 11 CONTINUE
- LDI = LDI + ID
- LXI1 = LXI1 + IX
- LZI1 = LZI1 + IZ
- 12 CONTINUE
- RETURN
- END
diff --git a/src/packlib/kernlib/kernnum/f003fort/rujk.inc b/src/packlib/kernlib/kernnum/f003fort/rujk.inc
deleted file mode 100644
index 303988d..0000000
--- a/src/packlib/kernlib/kernnum/f003fort/rujk.inc
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: rujk.inc,v 1.1.1.1 1996/02/15 17:48:54 mclareni Exp $
-*
-* $Log: rujk.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:54 mclareni
-* Kernlib
-*
-*
-*
-* rujk.inc
-*
-#if defined(CERNLIB_NUMAP)||defined(CERNLIB_NUMCD)||defined(CERNLIB_NUMCV)||defined(CERNLIB_NUMIB2)||defined(CERNLIB_NUMND)
- JU = LOCF(U12) - LOCF(U)
- KU = LOCF(U22) - LOCF(U)
-#endif
-#if defined(CERNLIB_NUMCR)||defined(CERNLIB_NUMUC)
- JU = LOC(U12) - LOC(U)
- KU = LOC(U22) - LOC(U)
-#endif
-#if defined(CERNLIB_NUMDE)
- JU = (%LOC(U12) - %LOC(U)) / 4
- KU = (%LOC(U22) - %LOC(U)) / 4
-#endif
-#if defined(CERNLIB_NUMIB1)
- JU = (IADDR(U12) - IADDR(U)) / 4
- KU = (IADDR(U22) - IADDR(U)) / 4
-#endif
diff --git a/src/packlib/kernlib/kernnum/f003fort/rumna.F b/src/packlib/kernlib/kernnum/f003fort/rumna.F
deleted file mode 100644
index f832199..0000000
--- a/src/packlib/kernlib/kernnum/f003fort/rumna.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: rumna.F,v 1.1.1.1 1996/02/15 17:48:59 mclareni Exp $
-*
-* $Log: rumna.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:59 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE RUMNA(N,U,U12,U22,Y,Y2,Z,Z2)
- REAL U(*),U12(*),U22(*),Y(*),Y2(*),Z(*),Z2(*)
- REAL A, B, SIGNF
-#if defined(CERNLIB_NUMRDBLE)
- DOUBLE PRECISION SUM, F
- F(A,B,SUM) = -DBLE(A)*DBLE(B) + SUM
-#endif
-#if !defined(CERNLIB_NUMRDBLE)
- REAL SUM, F
- F(A,B,SUM) = -A*B + SUM
-#endif
- SIGNF(A) = A
- IF(N .LE. 0) RETURN
-#include "rujk.inc"
-#include "ryj.inc"
-#include "rzi.inc"
-#include "umpa.inc"
diff --git a/src/packlib/kernlib/kernnum/f003fort/rumns.F b/src/packlib/kernlib/kernnum/f003fort/rumns.F
deleted file mode 100644
index 28923bb..0000000
--- a/src/packlib/kernlib/kernnum/f003fort/rumns.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: rumns.F,v 1.1.1.1 1996/02/15 17:48:59 mclareni Exp $
-*
-* $Log: rumns.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:59 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE RUMNS(N,U,U12,U22,Y,Y2,Z,Z2)
- REAL U(*),U12(*),U22(*),Y(*),Y2(*),Z(*),Z2(*)
- REAL A, B, SIGNF
-#if defined(CERNLIB_NUMRDBLE)
- DOUBLE PRECISION SUM, F
- F(A,B,SUM) = -DBLE(A)*DBLE(B) + SUM
-#endif
-#if !defined(CERNLIB_NUMRDBLE)
- REAL SUM, F
- F(A,B,SUM) = -A*B + SUM
-#endif
- SIGNF(A) = -A
- IF(N .LE. 0) RETURN
-#include "rujk.inc"
-#include "ryj.inc"
-#include "rzi.inc"
-#include "umpa.inc"
diff --git a/src/packlib/kernlib/kernnum/f003fort/rumpa.F b/src/packlib/kernlib/kernnum/f003fort/rumpa.F
deleted file mode 100644
index eefa820..0000000
--- a/src/packlib/kernlib/kernnum/f003fort/rumpa.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: rumpa.F,v 1.1.1.1 1996/02/15 17:48:59 mclareni Exp $
-*
-* $Log: rumpa.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:59 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE RUMPA(N,U,U12,U22,Y,Y2,Z,Z2)
- REAL U(*),U12(*),U22(*),Y(*),Y2(*),Z(*),Z2(*)
- REAL A, B, SIGNF
-#if defined(CERNLIB_NUMRDBLE)
- DOUBLE PRECISION SUM, F
- F(A,B,SUM) = DBLE(A)*DBLE(B) + SUM
-#endif
-#if !defined(CERNLIB_NUMRDBLE)
- REAL SUM, F
- F(A,B,SUM) = A*B + SUM
-#endif
- SIGNF(A) = A
- IF(N .LE. 0) RETURN
-#include "rujk.inc"
-#include "ryj.inc"
-#include "rzi.inc"
-#include "umpa.inc"
diff --git a/src/packlib/kernlib/kernnum/f003fort/rumps.F b/src/packlib/kernlib/kernnum/f003fort/rumps.F
deleted file mode 100644
index 1da436b..0000000
--- a/src/packlib/kernlib/kernnum/f003fort/rumps.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: rumps.F,v 1.1.1.1 1996/02/15 17:48:59 mclareni Exp $
-*
-* $Log: rumps.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:59 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE RUMPS(N,U,U12,U22,Y,Y2,Z,Z2)
- REAL U(*),U12(*),U22(*),Y(*),Y2(*),Z(*),Z2(*)
- REAL A, B, SIGNF
-#if defined(CERNLIB_NUMRDBLE)
- DOUBLE PRECISION SUM, F
- F(A,B,SUM) = DBLE(A)*DBLE(B) + SUM
-#endif
-#if !defined(CERNLIB_NUMRDBLE)
- REAL SUM, F
- F(A,B,SUM) = A*B + SUM
-#endif
- SIGNF(A) = -A
- IF(N .LE. 0) RETURN
-#include "rujk.inc"
-#include "ryj.inc"
-#include "rzi.inc"
-#include "umpa.inc"
diff --git a/src/packlib/kernlib/kernnum/f003fort/rumpy.F b/src/packlib/kernlib/kernnum/f003fort/rumpy.F
deleted file mode 100644
index ac5399d..0000000
--- a/src/packlib/kernlib/kernnum/f003fort/rumpy.F
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: rumpy.F,v 1.1.1.1 1996/02/15 17:49:00 mclareni Exp $
-*
-* $Log: rumpy.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:00 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE RUMPY(N,U,U12,U22,Y,Y2,Z,Z2)
- REAL U(*),U12(*),U22(*),Y(*),Y2(*),Z(*),Z2(*)
-#if defined(CERNLIB_NUMRDBLE)
- REAL A, B
- DOUBLE PRECISION SUM, ZERO, F
- F(A,B,SUM) = DBLE(A)*DBLE(B) + SUM
- DATA ZERO / 0.D0 /
-#endif
-#if !defined(CERNLIB_NUMRDBLE)
- REAL A, B, SUM, ZERO, F
- F(A,B,SUM) = A*B + SUM
- DATA ZERO / 0. /
-#endif
- IF(N .LE. 0) RETURN
-#include "rujk.inc"
-#include "ryj.inc"
-#include "rzi.inc"
-#include "umpy.inc"
diff --git a/src/packlib/kernlib/kernnum/f003fort/rxi.inc b/src/packlib/kernlib/kernnum/f003fort/rxi.inc
deleted file mode 100644
index 3454cbf..0000000
--- a/src/packlib/kernlib/kernnum/f003fort/rxi.inc
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: rxi.inc,v 1.1.1.1 1996/02/15 17:48:54 mclareni Exp $
-*
-* $Log: rxi.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:54 mclareni
-* Kernlib
-*
-*
-*
-* rxi.inc
-*
-#if defined(CERNLIB_NUMAP)||defined(CERNLIB_NUMCD)||defined(CERNLIB_NUMCV)||defined(CERNLIB_NUMIB2)||defined(CERNLIB_NUMND)
- IX = LOCF(X2) - LOCF(X)
-#endif
-#if defined(CERNLIB_NUMCR)||defined(CERNLIB_NUMUC)
- IX = LOC(X2) - LOC(X)
-#endif
-#if defined(CERNLIB_NUMDE)
- IX = (%LOC(X2) - %LOC(X)) / 4
-#endif
-#if defined(CERNLIB_NUMIB1)
- IX = (IADDR(X2) - IADDR(X)) / 4
-#endif
diff --git a/src/packlib/kernlib/kernnum/f003fort/rxij.inc b/src/packlib/kernlib/kernnum/f003fort/rxij.inc
deleted file mode 100644
index 2737631..0000000
--- a/src/packlib/kernlib/kernnum/f003fort/rxij.inc
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: rxij.inc,v 1.1.1.1 1996/02/15 17:48:55 mclareni Exp $
-*
-* $Log: rxij.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:55 mclareni
-* Kernlib
-*
-*
-*
-* rxij.inc
-*
-#if defined(CERNLIB_NUMAP)||defined(CERNLIB_NUMCD)||defined(CERNLIB_NUMCV)||defined(CERNLIB_NUMIB2)||defined(CERNLIB_NUMND)
- IX = LOCF(X21) - LOCF(X)
- JX = LOCF(X12) - LOCF(X)
-#endif
-#if defined(CERNLIB_NUMCR)||defined(CERNLIB_NUMUC)
- IX = LOC(X21) - LOC(X)
- JX = LOC(X12) - LOC(X)
-#endif
-#if defined(CERNLIB_NUMDE)
- IX = (%LOC(X21) - %LOC(X)) / 4
- JX = (%LOC(X12) - %LOC(X)) / 4
-#endif
-#if defined(CERNLIB_NUMIB1)
- IX = (IADDR(X21) - IADDR(X)) / 4
- JX = (IADDR(X12) - IADDR(X)) / 4
-#endif
diff --git a/src/packlib/kernlib/kernnum/f003fort/ryij.inc b/src/packlib/kernlib/kernnum/f003fort/ryij.inc
deleted file mode 100644
index d7fb658..0000000
--- a/src/packlib/kernlib/kernnum/f003fort/ryij.inc
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: ryij.inc,v 1.1.1.1 1996/02/15 17:48:55 mclareni Exp $
-*
-* $Log: ryij.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:55 mclareni
-* Kernlib
-*
-*
-*
-* ryij.inc
-*
-#if defined(CERNLIB_NUMAP)||defined(CERNLIB_NUMCD)||defined(CERNLIB_NUMCV)||defined(CERNLIB_NUMIB2)||defined(CERNLIB_NUMND)
- IY = LOCF(Y21) - LOCF(Y)
- JY = LOCF(Y12) - LOCF(Y)
-#endif
-#if defined(CERNLIB_NUMCR)||defined(CERNLIB_NUMUC)
- IY = LOC(Y21) - LOC(Y)
- JY = LOC(Y12) - LOC(Y)
-#endif
-#if defined(CERNLIB_NUMDE)
- IY = (%LOC(Y21) - %LOC(Y)) / 4
- JY = (%LOC(Y12) - %LOC(Y)) / 4
-#endif
-#if defined(CERNLIB_NUMIB1)
- IY = (IADDR(Y21) - IADDR(Y)) / 4
- JY = (IADDR(Y12) - IADDR(Y)) / 4
-#endif
diff --git a/src/packlib/kernlib/kernnum/f003fort/ryj.inc b/src/packlib/kernlib/kernnum/f003fort/ryj.inc
deleted file mode 100644
index 9c4d5c5..0000000
--- a/src/packlib/kernlib/kernnum/f003fort/ryj.inc
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: ryj.inc,v 1.1.1.1 1996/02/15 17:48:55 mclareni Exp $
-*
-* $Log: ryj.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:55 mclareni
-* Kernlib
-*
-*
-*
-* ryj.inc
-*
-#if defined(CERNLIB_NUMAP)||defined(CERNLIB_NUMCD)||defined(CERNLIB_NUMCV)||defined(CERNLIB_NUMIB2)||defined(CERNLIB_NUMND)
- JY = LOCF(Y2) - LOCF(Y)
-#endif
-#if defined(CERNLIB_NUMCR)||defined(CERNLIB_NUMUC)
- JY = LOC(Y2) - LOC(Y)
-#endif
-#if defined(CERNLIB_NUMDE)
- JY = (%LOC(Y2) - %LOC(Y)) / 4
-#endif
-#if defined(CERNLIB_NUMIB1)
- JY = (IADDR(Y2) - IADDR(Y)) / 4
-#endif
diff --git a/src/packlib/kernlib/kernnum/f003fort/rzi.inc b/src/packlib/kernlib/kernnum/f003fort/rzi.inc
deleted file mode 100644
index 4fea4cb..0000000
--- a/src/packlib/kernlib/kernnum/f003fort/rzi.inc
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: rzi.inc,v 1.1.1.1 1996/02/15 17:48:54 mclareni Exp $
-*
-* $Log: rzi.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:54 mclareni
-* Kernlib
-*
-*
-*
-* rzi.inc
-*
-#if defined(CERNLIB_NUMAP)||defined(CERNLIB_NUMCD)||defined(CERNLIB_NUMCV)||defined(CERNLIB_NUMIB2)||defined(CERNLIB_NUMND)
- IZ = LOCF(Z2) - LOCF(Z)
-#endif
-#if defined(CERNLIB_NUMCR)||defined(CERNLIB_NUMUC)
- IZ = LOC(Z2) - LOC(Z)
-#endif
-#if defined(CERNLIB_NUMDE)
- IZ = (%LOC(Z2) - %LOC(Z)) / 4
-#endif
-#if defined(CERNLIB_NUMIB1)
- IZ = (IADDR(Z2) - IADDR(Z)) / 4
-#endif
diff --git a/src/packlib/kernlib/kernnum/f003fort/rzij.inc b/src/packlib/kernlib/kernnum/f003fort/rzij.inc
deleted file mode 100644
index 24ce1fa..0000000
--- a/src/packlib/kernlib/kernnum/f003fort/rzij.inc
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: rzij.inc,v 1.1.1.1 1996/02/15 17:48:55 mclareni Exp $
-*
-* $Log: rzij.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:55 mclareni
-* Kernlib
-*
-*
-*
-* rzij.inc
-*
-#if defined(CERNLIB_NUMAP)||defined(CERNLIB_NUMCD)||defined(CERNLIB_NUMCV)||defined(CERNLIB_NUMIB2)||defined(CERNLIB_NUMND)
- IZ = LOCF(Z21) - LOCF(Z)
- JZ = LOCF(Z12) - LOCF(Z)
-#endif
-#if defined(CERNLIB_NUMCR)||defined(CERNLIB_NUMUC)
- IZ = LOC(Z21) - LOC(Z)
- JZ = LOC(Z12) - LOC(Z)
-#endif
-#if defined(CERNLIB_NUMDE)
- IZ = (%LOC(Z21) - %LOC(Z)) / 4
- JZ = (%LOC(Z12) - %LOC(Z)) / 4
-#endif
-#if defined(CERNLIB_NUMIB1)
- IZ = (IADDR(Z21) - IADDR(Z)) / 4
- JZ = (IADDR(Z12) - IADDR(Z)) / 4
-#endif
diff --git a/src/packlib/kernlib/kernnum/f003fort/rzj.inc b/src/packlib/kernlib/kernnum/f003fort/rzj.inc
deleted file mode 100644
index 95f3f6e..0000000
--- a/src/packlib/kernlib/kernnum/f003fort/rzj.inc
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: rzj.inc,v 1.1.1.1 1996/02/15 17:48:55 mclareni Exp $
-*
-* $Log: rzj.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:55 mclareni
-* Kernlib
-*
-*
-*
-* rzj.inc
-*
-#if defined(CERNLIB_NUMAP)||defined(CERNLIB_NUMCD)||defined(CERNLIB_NUMCV)||defined(CERNLIB_NUMIB2)||defined(CERNLIB_NUMND)
- JZ = LOCF(Z2) - LOCF(Z)
-#endif
-#if defined(CERNLIB_NUMCR)||defined(CERNLIB_NUMUC)
- JZ = LOC(Z2) - LOC(Z)
-#endif
-#if defined(CERNLIB_NUMDE)
- JZ = (%LOC(Z2) - %LOC(Z)) / 4
-#endif
-#if defined(CERNLIB_NUMIB1)
- JZ = (IADDR(Z2) - IADDR(Z)) / 4
-#endif
diff --git a/src/packlib/kernlib/kernnum/f003fort/umpa.inc b/src/packlib/kernlib/kernnum/f003fort/umpa.inc
deleted file mode 100644
index 3bdfd59..0000000
--- a/src/packlib/kernlib/kernnum/f003fort/umpa.inc
+++ /dev/null
@@ -1,30 +0,0 @@
-*
-* $Id: umpa.inc,v 1.1.1.1 1996/02/15 17:48:56 mclareni Exp $
-*
-* $Log: umpa.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:56 mclareni
-* Kernlib
-*
-*
-*
-* umpa.inc
-*
- LUII = 1
- LYI = 1
- LZI = 1
- DO 12 I = 1, N
- LUIJ = LUII
- LYJ = LYI
- SUM = SIGNF( Z(LZI) )
- DO 11 J = I, N
- SUM = F(U(LUIJ),Y(LYJ),SUM)
- LUIJ = LUIJ + JU
- LYJ = LYJ + JY
- 11 CONTINUE
- Z(LZI) = SUM
- LUII = LUII + KU
- LYI = LYI + JY
- LZI = LZI + IZ
- 12 CONTINUE
- RETURN
- END
diff --git a/src/packlib/kernlib/kernnum/f003fort/umpy.inc b/src/packlib/kernlib/kernnum/f003fort/umpy.inc
deleted file mode 100644
index c4ca5c8..0000000
--- a/src/packlib/kernlib/kernnum/f003fort/umpy.inc
+++ /dev/null
@@ -1,30 +0,0 @@
-*
-* $Id: umpy.inc,v 1.1.1.1 1996/02/15 17:48:56 mclareni Exp $
-*
-* $Log: umpy.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:56 mclareni
-* Kernlib
-*
-*
-*
-* umpy.inc
-*
- LUII = 1
- LYI = 1
- LZI = 1
- DO 12 I = 1, N
- LUIJ = LUII
- LYJ = LYI
- SUM = ZERO
- DO 11 J = I, N
- SUM = F(U(LUIJ),Y(LYJ),SUM)
- LUIJ = LUIJ + JU
- LYJ = LYJ + JY
- 11 CONTINUE
- Z(LZI) = SUM
- LUII = LUII + KU
- LYI = LYI + JY
- LZI = LZI + IZ
- 12 CONTINUE
- RETURN
- END
diff --git a/src/packlib/kernlib/kernnum/f004fort/Imakefile b/src/packlib/kernlib/kernnum/f004fort/Imakefile
deleted file mode 100644
index 5ffd985..0000000
--- a/src/packlib/kernlib/kernnum/f004fort/Imakefile
+++ /dev/null
@@ -1,15 +0,0 @@
-SRCS_F= cmmla.F cmmls.F cmmlt.F cmmltc.F cmnma.F cmnms.F \ @@\
- dmmla.F dmmls.F dmmlt.F dmnma.F dmnms.F \ @@\
- rmmla.F rmmls.F rmmlt.F rmnma.F rmnms.F
-
-#if defined(CERNLIB_DECS) && ! defined(CERNLIB_QMVAOS)
-FDEBUGFLAGS=NoOpFortranDebugFlags
-#endif
-
-#if defined(CERNLIB_MACOSX)
-FDEBUGFLAGS := -O0 $(FDEBUGFLAGS) -O0
-#endif
-
-FORTRANSAVEOPTION=FortranSaveFlags
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kernnum/f004fort/cdotf.inc b/src/packlib/kernlib/kernnum/f004fort/cdotf.inc
deleted file mode 100644
index d0f3e97..0000000
--- a/src/packlib/kernlib/kernnum/f004fort/cdotf.inc
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: cdotf.inc,v 1.1.1.1 1996/02/15 17:49:00 mclareni Exp $
-*
-* $Log: cdotf.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:49:00 mclareni
-* Kernlib
-*
-*
-*
-* cdotf.inc
-*
-#if !defined(CERNLIB_NUMCDBLE)
- COMPLEX A, B, SUM, DOTF
- DOTF(A,B,SUM) = A*B + SUM
-#endif
-#if defined(CERNLIB_NUMCDBLE)
- COMPLEX A, B
- COMPLEX*16 SUM, DC, DOTF
- DC(A) = DCMPLX(DBLE(REAL(A)),DBLE(AIMAG(A)))
- DOTF(A,B,SUM) = DC(A)*DC(B) + SUM
-#endif
diff --git a/src/packlib/kernlib/kernnum/f004fort/cmmla.F b/src/packlib/kernlib/kernnum/f004fort/cmmla.F
deleted file mode 100644
index e46d6eb..0000000
--- a/src/packlib/kernlib/kernnum/f004fort/cmmla.F
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: cmmla.F,v 1.1.1.1 1996/02/15 17:49:02 mclareni Exp $
-*
-* $Log: cmmla.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:02 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE CMMLA(M,N,K,X,X12,X21,Y,Y12,Y21,Z,Z12,Z21)
- COMPLEX X(*), X12(*), X21(*), Y(*), Y12(*), Y21(*)
- COMPLEX Z(*), Z12(*), Z21(*)
-#include "cdotf.inc"
-#include "dlocf.inc"
-#include "mla.inc"
- END
diff --git a/src/packlib/kernlib/kernnum/f004fort/cmmls.F b/src/packlib/kernlib/kernnum/f004fort/cmmls.F
deleted file mode 100644
index f560c11..0000000
--- a/src/packlib/kernlib/kernnum/f004fort/cmmls.F
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: cmmls.F,v 1.1.1.1 1996/02/15 17:49:02 mclareni Exp $
-*
-* $Log: cmmls.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:02 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE CMMLS(M,N,K,X,X12,X21,Y,Y12,Y21,Z,Z12,Z21)
- COMPLEX X(*), X12(*), X21(*), Y(*), Y12(*), Y21(*)
- COMPLEX Z(*), Z12(*), Z21(*)
-#include "cdotf.inc"
-#include "dlocf.inc"
-#include "mls.inc"
- END
diff --git a/src/packlib/kernlib/kernnum/f004fort/cmmlt.F b/src/packlib/kernlib/kernnum/f004fort/cmmlt.F
deleted file mode 100644
index 4437a19..0000000
--- a/src/packlib/kernlib/kernnum/f004fort/cmmlt.F
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: cmmlt.F,v 1.1.1.1 1996/02/15 17:49:01 mclareni Exp $
-*
-* $Log: cmmlt.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:01 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE CMMLT(M,N,K,X,X12,X21,Y,Y12,Y21,Z,Z12,Z21,T)
- COMPLEX X(*), X12(*), X21(*), Y(*), Y12(*), Y21(*)
- COMPLEX Z(*), Z12(*), Z21(*), T(*), A, B, CNJF
-#if !defined(CERNLIB_NUMCDBLE)
- COMPLEX ZERO, SUM, DOTF, SQRF
- COMPLEX S11, S21, S22, S31, S41, S51, S52
- DATA ZERO / (0.,0.) /
- DOTF(A,B,SUM) = A*B + SUM
- SQRF(A,SUM) = A*A + SUM
- CNJF(A) = A
-#endif
-#if defined(CERNLIB_NUMCDBLE)
- COMPLEX*16 ZERO, SUM, DC, DOTF, SQRF
- COMPLEX*16 S11, S21, S22, S31, S41, S51, S52
- DATA ZERO / (0.D0,0.D0) /
- DC(A) = DCMPLX(DBLE(REAL(A)),DBLE(AIMAG(A)))
- DOTF(A,B,SUM) = DC(A)*DC(B) + SUM
- SQRF(A,SUM) = DC(A)**2 + SUM
- CNJF(A) = A
-#endif
-#include "dlocf.inc"
-#include "mmlt.inc"
- END
diff --git a/src/packlib/kernlib/kernnum/f004fort/cmmltc.F b/src/packlib/kernlib/kernnum/f004fort/cmmltc.F
deleted file mode 100644
index 57e5c28..0000000
--- a/src/packlib/kernlib/kernnum/f004fort/cmmltc.F
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: cmmltc.F,v 1.1.1.1 1996/02/15 17:49:01 mclareni Exp $
-*
-* $Log: cmmltc.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:01 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE CMMLTC(M,N,K,X,X12,X21,Y,Y12,Y21,Z,Z12,Z21,T)
- COMPLEX X(*), X12(*), X21(*), Y(*), Y12(*), Y21(*)
- COMPLEX Z(*), Z12(*), Z21(*), T(*), A, B, CNJF
-#if !defined(CERNLIB_NUMCDBLE)
- COMPLEX ZERO, SUM, DOTF, SQRF
- COMPLEX S11, S21, S22, S31, S41, S51, S52
- DATA ZERO / (0.,0.) /
- DOTF(A,B,SUM) = A*CONJG(B) + SUM
- SQRF(A,SUM) = REAL(A)**2 +AIMAG(A)**2 + SUM
- CNJF(A) = CONJG(A)
-#endif
-#if (defined(CERNLIB_NUMCDBLE))&&(!defined(CERNLIB_NUMND))
- COMPLEX*16 ZERO, SUM, DC, DOTF, SQRF
- COMPLEX*16 S11, S21, S22, S31, S41, S51, S52
- DATA ZERO / (0.D0,0.D0) /
- DC(A) = DCMPLX(DBLE(REAL(A)),DBLE(AIMAG(A)))
- DOTF(A,B,SUM) = DC(A)*DCONJG(DC(B)) + SUM
- SQRF(A,SUM) = DBLE(REAL(A))**2 + DBLE(AIMAG(A))**2 + SUM
- CNJF(A) = CONJG(A)
-#endif
-#if (defined(CERNLIB_NUMCDBLE))&&(defined(CERNLIB_NUMND))
- COMPLEX*16 ZERO, SUM, DC, DOTF, SQRF
- COMPLEX*16 S11, S21, S22, S31, S41, S51, S52
- DATA ZERO / (0.D0,0.D0) /
- DC(A) = DCMPLX(DBLE(REAL(A)),DBLE(AIMAG(A)))
- DOTF(A,B,SUM) = DC(A)*CDCONJG(DC(B)) + SUM
- SQRF(A,SUM) = DBLE(REAL(A))**2 + DBLE(AIMAG(A))**2 + SUM
- CNJF(A) = CONJG(A)
-#endif
-#include "dlocf.inc"
-#include "mmltc.inc"
- END
diff --git a/src/packlib/kernlib/kernnum/f004fort/cmnma.F b/src/packlib/kernlib/kernnum/f004fort/cmnma.F
deleted file mode 100644
index 1184eae..0000000
--- a/src/packlib/kernlib/kernnum/f004fort/cmnma.F
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: cmnma.F,v 1.1.1.1 1996/02/15 17:49:02 mclareni Exp $
-*
-* $Log: cmnma.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:02 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE CMNMA(M,N,K,X,X12,X21,Y,Y12,Y21,Z,Z12,Z21)
- COMPLEX X(*), X12(*), X21(*), Y(*), Y12(*), Y21(*)
- COMPLEX Z(*), Z12(*), Z21(*)
-#include "cdotf.inc"
-#include "dlocf.inc"
-#include "nma.inc"
- END
diff --git a/src/packlib/kernlib/kernnum/f004fort/cmnms.F b/src/packlib/kernlib/kernnum/f004fort/cmnms.F
deleted file mode 100644
index 48eb2f3..0000000
--- a/src/packlib/kernlib/kernnum/f004fort/cmnms.F
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: cmnms.F,v 1.1.1.1 1996/02/15 17:49:02 mclareni Exp $
-*
-* $Log: cmnms.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:02 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE CMNMS(M,N,K,X,X12,X21,Y,Y12,Y21,Z,Z12,Z21)
- COMPLEX X(*), X12(*), X21(*), Y(*), Y12(*), Y21(*)
- COMPLEX Z(*), Z12(*), Z21(*)
-#include "cdotf.inc"
-#include "dlocf.inc"
-#include "nms.inc"
- END
diff --git a/src/packlib/kernlib/kernnum/f004fort/ddotf.inc b/src/packlib/kernlib/kernnum/f004fort/ddotf.inc
deleted file mode 100644
index e8adc42..0000000
--- a/src/packlib/kernlib/kernnum/f004fort/ddotf.inc
+++ /dev/null
@@ -1,13 +0,0 @@
-*
-* $Id: ddotf.inc,v 1.1.1.1 1996/02/15 17:49:00 mclareni Exp $
-*
-* $Log: ddotf.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:49:00 mclareni
-* Kernlib
-*
-*
-*
-* ddotf.inc
-*
- DOUBLE PRECISION A, B, SUM, DOTF
- DOTF(A,B,SUM) = A*B + SUM
diff --git a/src/packlib/kernlib/kernnum/f004fort/dlocf.inc b/src/packlib/kernlib/kernnum/f004fort/dlocf.inc
deleted file mode 100644
index 021670e..0000000
--- a/src/packlib/kernlib/kernnum/f004fort/dlocf.inc
+++ /dev/null
@@ -1,59 +0,0 @@
-*
-* $Id: dlocf.inc,v 1.1.1.1 1996/02/15 17:49:00 mclareni Exp $
-*
-* $Log: dlocf.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:49:00 mclareni
-* Kernlib
-*
-*
-*
-* dlocf.inc
-*
-#if defined(CERNLIB_NUMAP)||defined(CERNLIB_NUMCD)||defined(CERNLIB_NUMCV)||defined(CERNLIB_NUMIB2)||defined(CERNLIB_NUMND)
- IF(MIN0(M,N,K) .LE. 0) RETURN
- LOCX = LOCF(X(1))
- LOCY = LOCF(Y(1))
- LOCZ = LOCF(Z(1))
- IX = (LOCF(X21(1)) - LOCX) / 2
- JX = (LOCF(X12(1)) - LOCX) / 2
- JY = (LOCF(Y21(1)) - LOCY) / 2
- LY = (LOCF(Y12(1)) - LOCY) / 2
- IZ = (LOCF(Z21(1)) - LOCZ) / 2
- LZ = (LOCF(Z12(1)) - LOCZ) / 2
-#endif
-#if defined(CERNLIB_NUMCR)||defined(CERNLIB_NUMUC)
- IF(MIN0(M,N,K) .LE. 0) RETURN
- LOCX = LOC(X(1))
- LOCY = LOC(Y(1))
- LOCZ = LOC(Z(1))
- IX = (LOC(X21(1)) - LOCX) / 2
- JX = (LOC(X12(1)) - LOCX) / 2
- JY = (LOC(Y21(1)) - LOCY) / 2
- LY = (LOC(Y12(1)) - LOCY) / 2
- IZ = (LOC(Z21(1)) - LOCZ) / 2
- LZ = (LOC(Z12(1)) - LOCZ) / 2
-#endif
-#if defined(CERNLIB_NUMDE)
- IF(MIN0(M,N,K) .LE. 0) RETURN
- LOCX = %LOC(X(1))
- LOCY = %LOC(Y(1))
- LOCZ = %LOC(Z(1))
- IX = (%LOC(X21(1)) - LOCX) / 8
- JX = (%LOC(X12(1)) - LOCX) / 8
- JY = (%LOC(Y21(1)) - LOCY) / 8
- LY = (%LOC(Y12(1)) - LOCY) / 8
- IZ = (%LOC(Z21(1)) - LOCZ) / 8
- LZ = (%LOC(Z12(1)) - LOCZ) / 8
-#endif
-#if defined(CERNLIB_NUMIB1)
- IF(MIN0(M,N,K) .LE. 0) RETURN
- LOCX = IADDR(X(1))
- LOCY = IADDR(Y(1))
- LOCZ = IADDR(Z(1))
- IX = (IADDR(X21(1)) - LOCX) / 8
- JX = (IADDR(X12(1)) - LOCX) / 8
- JY = (IADDR(Y21(1)) - LOCY) / 8
- LY = (IADDR(Y12(1)) - LOCY) / 8
- IZ = (IADDR(Z21(1)) - LOCZ) / 8
- LZ = (IADDR(Z12(1)) - LOCZ) / 8
-#endif
diff --git a/src/packlib/kernlib/kernnum/f004fort/dmmla.F b/src/packlib/kernlib/kernnum/f004fort/dmmla.F
deleted file mode 100644
index efa6e71..0000000
--- a/src/packlib/kernlib/kernnum/f004fort/dmmla.F
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: dmmla.F,v 1.1.1.1 1996/02/15 17:49:02 mclareni Exp $
-*
-* $Log: dmmla.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:02 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE DMMLA(M,N,K,X,X12,X21,Y,Y12,Y21,Z,Z12,Z21)
- DOUBLE PRECISION X(*), X12(*), X21(*), Y(*), Y12(*), Y21(*)
- DOUBLE PRECISION Z(*), Z12(*), Z21(*)
-#include "ddotf.inc"
-#include "dlocf.inc"
-#include "mla.inc"
- END
diff --git a/src/packlib/kernlib/kernnum/f004fort/dmmls.F b/src/packlib/kernlib/kernnum/f004fort/dmmls.F
deleted file mode 100644
index bd2abc6..0000000
--- a/src/packlib/kernlib/kernnum/f004fort/dmmls.F
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: dmmls.F,v 1.1.1.1 1996/02/15 17:49:02 mclareni Exp $
-*
-* $Log: dmmls.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:02 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE DMMLS(M,N,K,X,X12,X21,Y,Y12,Y21,Z,Z12,Z21)
- DOUBLE PRECISION X(*), X12(*), X21(*), Y(*), Y12(*), Y21(*)
- DOUBLE PRECISION Z(*), Z12(*), Z21(*)
-#include "ddotf.inc"
-#include "dlocf.inc"
-#include "mls.inc"
- END
diff --git a/src/packlib/kernlib/kernnum/f004fort/dmmlt.F b/src/packlib/kernlib/kernnum/f004fort/dmmlt.F
deleted file mode 100644
index 9ee2ac0..0000000
--- a/src/packlib/kernlib/kernnum/f004fort/dmmlt.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: dmmlt.F,v 1.1.1.1 1996/02/15 17:49:01 mclareni Exp $
-*
-* $Log: dmmlt.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:01 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE DMMLT(M,N,K,X,X12,X21,Y,Y12,Y21,Z,Z12,Z21,T)
- DOUBLE PRECISION X(*), X12(*), X21(*), Y(*), Y12(*), Y21(*)
- DOUBLE PRECISION Z(*), Z12(*), Z21(*), T(*), A, B, CNJF
- DOUBLE PRECISION ZERO, SUM, DOTF, SQRF
- DOUBLE PRECISION S11, S21, S22, S31, S41, S51, S52
- DATA ZERO / 0.D0 /
- DOTF(A,B,SUM) = A*B + SUM
- SQRF(A,SUM) = A*A + SUM
- CNJF(A) = A
-#include "dlocf.inc"
-#include "mmlt.inc"
- END
diff --git a/src/packlib/kernlib/kernnum/f004fort/dmnma.F b/src/packlib/kernlib/kernnum/f004fort/dmnma.F
deleted file mode 100644
index 0e48869..0000000
--- a/src/packlib/kernlib/kernnum/f004fort/dmnma.F
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: dmnma.F,v 1.1.1.1 1996/02/15 17:49:02 mclareni Exp $
-*
-* $Log: dmnma.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:02 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE DMNMA(M,N,K,X,X12,X21,Y,Y12,Y21,Z,Z12,Z21)
- DOUBLE PRECISION X(*), X12(*), X21(*), Y(*), Y12(*), Y21(*)
- DOUBLE PRECISION Z(*), Z12(*), Z21(*)
-#include "ddotf.inc"
-#include "dlocf.inc"
-#include "nma.inc"
- END
diff --git a/src/packlib/kernlib/kernnum/f004fort/dmnms.F b/src/packlib/kernlib/kernnum/f004fort/dmnms.F
deleted file mode 100644
index 5db337d..0000000
--- a/src/packlib/kernlib/kernnum/f004fort/dmnms.F
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: dmnms.F,v 1.1.1.1 1996/02/15 17:49:02 mclareni Exp $
-*
-* $Log: dmnms.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:02 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE DMNMS(M,N,K,X,X12,X21,Y,Y12,Y21,Z,Z12,Z21)
- DOUBLE PRECISION X(*), X12(*), X21(*), Y(*), Y12(*), Y21(*)
- DOUBLE PRECISION Z(*), Z12(*), Z21(*)
-#include "ddotf.inc"
-#include "dlocf.inc"
-#include "nms.inc"
- END
diff --git a/src/packlib/kernlib/kernnum/f004fort/dokdom1.inc b/src/packlib/kernlib/kernnum/f004fort/dokdom1.inc
deleted file mode 100644
index 3ca22c8..0000000
--- a/src/packlib/kernlib/kernnum/f004fort/dokdom1.inc
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: dokdom1.inc,v 1.1.1.1 1996/02/15 17:49:00 mclareni Exp $
-*
-* $Log: dokdom1.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:49:00 mclareni
-* Kernlib
-*
-*
-*
-* dokdom1.inc
-*
- LY1L = 1
- LZ1L = 1
- DO 13 L = 1, K
- LXI1 = 1
- LZIL = LZ1L
- DO 12 I = 1, M
- LXIJ = LXI1
- LYJL = LY1L
diff --git a/src/packlib/kernlib/kernnum/f004fort/dokdom2.inc b/src/packlib/kernlib/kernnum/f004fort/dokdom2.inc
deleted file mode 100644
index 9dac3a0..0000000
--- a/src/packlib/kernlib/kernnum/f004fort/dokdom2.inc
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: dokdom2.inc,v 1.1.1.1 1996/02/15 17:49:01 mclareni Exp $
-*
-* $Log: dokdom2.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:49:01 mclareni
-* Kernlib
-*
-*
-*
-* dokdom2.inc
-*
- LXI1 = LXI1 + IX
- LZIL = LZIL + IZ
- 12 CONTINUE
- LY1L = LY1L + LY
- LZ1L = LZ1L + LZ
- 13 CONTINUE
- RETURN
diff --git a/src/packlib/kernlib/kernnum/f004fort/dotxjyj.inc b/src/packlib/kernlib/kernnum/f004fort/dotxjyj.inc
deleted file mode 100644
index 43c4c12..0000000
--- a/src/packlib/kernlib/kernnum/f004fort/dotxjyj.inc
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: dotxjyj.inc,v 1.1.1.1 1996/02/15 17:49:00 mclareni Exp $
-*
-* $Log: dotxjyj.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:49:00 mclareni
-* Kernlib
-*
-*
-*
-* dotxjyj.inc
-*
- DO 11 J = 1, N
- SUM = DOTF(X(LXIJ),Y(LYJL),SUM)
- LXIJ = LXIJ + JX
- LYJL = LYJL + JY
- 11 CONTINUE
diff --git a/src/packlib/kernlib/kernnum/f004fort/mla.inc b/src/packlib/kernlib/kernnum/f004fort/mla.inc
deleted file mode 100644
index af39376..0000000
--- a/src/packlib/kernlib/kernnum/f004fort/mla.inc
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: mla.inc,v 1.1.1.1 1996/02/15 17:49:01 mclareni Exp $
-*
-* $Log: mla.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:49:01 mclareni
-* Kernlib
-*
-*
-*
-* mla.inc
-*
-#include "dokdom1.inc"
- SUM = Z(LZIL)
-#include "dotxjyj.inc"
- Z(LZIL) = SUM
-#include "dokdom2.inc"
diff --git a/src/packlib/kernlib/kernnum/f004fort/mls.inc b/src/packlib/kernlib/kernnum/f004fort/mls.inc
deleted file mode 100644
index fbd2a9e..0000000
--- a/src/packlib/kernlib/kernnum/f004fort/mls.inc
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: mls.inc,v 1.1.1.1 1996/02/15 17:49:01 mclareni Exp $
-*
-* $Log: mls.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:49:01 mclareni
-* Kernlib
-*
-*
-*
-* mls.inc
-*
-#include "dokdom1.inc"
- SUM = -Z(LZIL)
-#include "dotxjyj.inc"
- Z(LZIL) = SUM
-#include "dokdom2.inc"
diff --git a/src/packlib/kernlib/kernnum/f004fort/mmlt.inc b/src/packlib/kernlib/kernnum/f004fort/mmlt.inc
deleted file mode 100644
index f53305d..0000000
--- a/src/packlib/kernlib/kernnum/f004fort/mmlt.inc
+++ /dev/null
@@ -1,13 +0,0 @@
-*
-* $Id: mmlt.inc,v 1.1.1.1 1996/02/15 17:49:01 mclareni Exp $
-*
-* $Log: mmlt.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:49:01 mclareni
-* Kernlib
-*
-*
-*
-* mmlt.inc
-*
-#include "zisxy.inc"
-#include "xisxxtra.inc"
diff --git a/src/packlib/kernlib/kernnum/f004fort/mmltc.inc b/src/packlib/kernlib/kernnum/f004fort/mmltc.inc
deleted file mode 100644
index 4e386a5..0000000
--- a/src/packlib/kernlib/kernnum/f004fort/mmltc.inc
+++ /dev/null
@@ -1,14 +0,0 @@
-*
-* $Id: mmltc.inc,v 1.1.1.1 1996/02/15 17:49:01 mclareni Exp $
-*
-* $Log: mmltc.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:49:01 mclareni
-* Kernlib
-*
-*
-* P=F004FORT.
-*
-* mmltc.inc
-*
-#include "zisxy.inc"
-#include "xisxxbar.inc"
diff --git a/src/packlib/kernlib/kernnum/f004fort/nma.inc b/src/packlib/kernlib/kernnum/f004fort/nma.inc
deleted file mode 100644
index f71db18..0000000
--- a/src/packlib/kernlib/kernnum/f004fort/nma.inc
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: nma.inc,v 1.1.1.1 1996/02/15 17:49:01 mclareni Exp $
-*
-* $Log: nma.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:49:01 mclareni
-* Kernlib
-*
-*
-*
-* nma.inc
-*
-#include "dokdom1.inc"
- SUM = -Z(LZIL)
-#include "dotxjyj.inc"
- Z(LZIL) = -SUM
-#include "dokdom2.inc"
diff --git a/src/packlib/kernlib/kernnum/f004fort/nms.inc b/src/packlib/kernlib/kernnum/f004fort/nms.inc
deleted file mode 100644
index 3ebb8d6..0000000
--- a/src/packlib/kernlib/kernnum/f004fort/nms.inc
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: nms.inc,v 1.1.1.1 1996/02/15 17:49:01 mclareni Exp $
-*
-* $Log: nms.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:49:01 mclareni
-* Kernlib
-*
-*
-*
-* nms.inc
-*
-#include "dokdom1.inc"
- SUM = Z(LZIL)
-#include "dotxjyj.inc"
- Z(LZIL) = -SUM
-#include "dokdom2.inc"
diff --git a/src/packlib/kernlib/kernnum/f004fort/rdotf.inc b/src/packlib/kernlib/kernnum/f004fort/rdotf.inc
deleted file mode 100644
index 98d21b4..0000000
--- a/src/packlib/kernlib/kernnum/f004fort/rdotf.inc
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: rdotf.inc,v 1.1.1.1 1996/02/15 17:49:00 mclareni Exp $
-*
-* $Log: rdotf.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:49:00 mclareni
-* Kernlib
-*
-*
-*
-* rdotf.inc
-*
-#if !defined(CERNLIB_NUMRDBLE)
- REAL A, B, SUM, DOTF
- DOTF(A,B,SUM) = A*B + SUM
-#endif
-#if defined(CERNLIB_NUMRDBLE)
- REAL A, B
- DOUBLE PRECISION SUM, DOTF
- DOTF(A,B,SUM) = DBLE(A)*DBLE(B) + SUM
-#endif
diff --git a/src/packlib/kernlib/kernnum/f004fort/rlocf.inc b/src/packlib/kernlib/kernnum/f004fort/rlocf.inc
deleted file mode 100644
index 7785b01..0000000
--- a/src/packlib/kernlib/kernnum/f004fort/rlocf.inc
+++ /dev/null
@@ -1,59 +0,0 @@
-*
-* $Id: rlocf.inc,v 1.1.1.1 1996/02/15 17:49:00 mclareni Exp $
-*
-* $Log: rlocf.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:49:00 mclareni
-* Kernlib
-*
-*
-*
-* rlocf.inc
-*
-#if defined(CERNLIB_NUMAP)||defined(CERNLIB_NUMCD)||defined(CERNLIB_NUMCV)||defined(CERNLIB_NUMIB2)||defined(CERNLIB_NUMND)
- IF(MIN0(M,N,K) .LE. 0) RETURN
- LOCX = LOCF(X(1))
- LOCY = LOCF(Y(1))
- LOCZ = LOCF(Z(1))
- IX = LOCF(X21(1)) - LOCX
- JX = LOCF(X12(1)) - LOCX
- JY = LOCF(Y21(1)) - LOCY
- LY = LOCF(Y12(1)) - LOCY
- IZ = LOCF(Z21(1)) - LOCZ
- LZ = LOCF(Z12(1)) - LOCZ
-#endif
-#if defined(CERNLIB_NUMCR)||defined(CERNLIB_NUMUC)
- IF(MIN0(M,N,K) .LE. 0) RETURN
- LOCX = LOC(X(1))
- LOCY = LOC(Y(1))
- LOCZ = LOC(Z(1))
- IX = LOC(X21(1)) - LOCX
- JX = LOC(X12(1)) - LOCX
- JY = LOC(Y21(1)) - LOCY
- LY = LOC(Y12(1)) - LOCY
- IZ = LOC(Z21(1)) - LOCZ
- LZ = LOC(Z12(1)) - LOCZ
-#endif
-#if defined(CERNLIB_NUMDE)
- IF(MIN0(M,N,K) .LE. 0) RETURN
- LOCX = %LOC(X(1))
- LOCY = %LOC(Y(1))
- LOCZ = %LOC(Z(1))
- IX = (%LOC(X21(1)) - LOCX) / 4
- JX = (%LOC(X12(1)) - LOCX) / 4
- JY = (%LOC(Y21(1)) - LOCY) / 4
- LY = (%LOC(Y12(1)) - LOCY) / 4
- IZ = (%LOC(Z21(1)) - LOCZ) / 4
- LZ = (%LOC(Z12(1)) - LOCZ) / 4
-#endif
-#if defined(CERNLIB_NUMIB1)
- IF(MIN0(M,N,K) .LE. 0) RETURN
- LOCX = IADDR(X(1))
- LOCY = IADDR(Y(1))
- LOCZ = IADDR(Z(1))
- IX = (IADDR(X21(1)) - LOCX) / 4
- JX = (IADDR(X12(1)) - LOCX) / 4
- JY = (IADDR(Y21(1)) - LOCY) / 4
- LY = (IADDR(Y12(1)) - LOCY) / 4
- IZ = (IADDR(Z21(1)) - LOCZ) / 4
- LZ = (IADDR(Z12(1)) - LOCZ) / 4
-#endif
diff --git a/src/packlib/kernlib/kernnum/f004fort/rmmla.F b/src/packlib/kernlib/kernnum/f004fort/rmmla.F
deleted file mode 100644
index 53b5571..0000000
--- a/src/packlib/kernlib/kernnum/f004fort/rmmla.F
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: rmmla.F,v 1.1.1.1 1996/02/15 17:49:01 mclareni Exp $
-*
-* $Log: rmmla.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:01 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE RMMLA(M,N,K,X,X12,X21,Y,Y12,Y21,Z,Z12,Z21)
- REAL X(*), X12(*), X21(*), Y(*), Y12(*), Y21(*)
- REAL Z(*), Z12(*), Z21(*)
-#include "rdotf.inc"
-#include "rlocf.inc"
-#include "mla.inc"
- END
diff --git a/src/packlib/kernlib/kernnum/f004fort/rmmls.F b/src/packlib/kernlib/kernnum/f004fort/rmmls.F
deleted file mode 100644
index b695976..0000000
--- a/src/packlib/kernlib/kernnum/f004fort/rmmls.F
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: rmmls.F,v 1.1.1.1 1996/02/15 17:49:02 mclareni Exp $
-*
-* $Log: rmmls.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:02 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE RMMLS(M,N,K,X,X12,X21,Y,Y12,Y21,Z,Z12,Z21)
- REAL X(*), X12(*), X21(*), Y(*), Y12(*), Y21(*)
- REAL Z(*), Z12(*), Z21(*)
-#include "rdotf.inc"
-#include "rlocf.inc"
-#include "mls.inc"
- END
diff --git a/src/packlib/kernlib/kernnum/f004fort/rmmlt.F b/src/packlib/kernlib/kernnum/f004fort/rmmlt.F
deleted file mode 100644
index a82dbad..0000000
--- a/src/packlib/kernlib/kernnum/f004fort/rmmlt.F
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: rmmlt.F,v 1.1.1.1 1996/02/15 17:49:01 mclareni Exp $
-*
-* $Log: rmmlt.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:01 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE RMMLT(M,N,K,X,X12,X21,Y,Y12,Y21,Z,Z12,Z21,T)
- REAL X(*), X12(*), X21(*), Y(*), Y12(*), Y21(*)
- REAL Z(*), Z12(*), Z21(*), T(*), A, B, CNJF
-#if !defined(CERNLIB_NUMRDBLE)
- REAL ZERO, SUM, DOTF, SQRF
- REAL S11, S21, S22, S31, S41, S51, S52
- DATA ZERO / 0. /
- DOTF(A,B,SUM) = A*B + SUM
- SQRF(A,SUM) = A*A + SUM
- CNJF(A) = A
-#endif
-#if defined(CERNLIB_NUMRDBLE)
- DOUBLE PRECISION ZERO, SUM, DOTF, SQRF
- DOUBLE PRECISION S11, S21, S22, S31, S41, S51, S52
- DATA ZERO / 0.D0 /
- DOTF(A,B,SUM) = DBLE(A)*DBLE(B) + SUM
- SQRF(A,SUM) = DBLE(A)**2 + SUM
- CNJF(A) = A
-#endif
-#include "rlocf.inc"
-#include "mmlt.inc"
- END
diff --git a/src/packlib/kernlib/kernnum/f004fort/rmnma.F b/src/packlib/kernlib/kernnum/f004fort/rmnma.F
deleted file mode 100644
index 1261622..0000000
--- a/src/packlib/kernlib/kernnum/f004fort/rmnma.F
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: rmnma.F,v 1.1.1.1 1996/02/15 17:49:02 mclareni Exp $
-*
-* $Log: rmnma.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:02 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE RMNMA(M,N,K,X,X12,X21,Y,Y12,Y21,Z,Z12,Z21)
- REAL X(*), X12(*), X21(*), Y(*), Y12(*), Y21(*)
- REAL Z(*), Z12(*), Z21(*)
-#include "rdotf.inc"
-#include "rlocf.inc"
-#include "nma.inc"
- END
diff --git a/src/packlib/kernlib/kernnum/f004fort/rmnms.F b/src/packlib/kernlib/kernnum/f004fort/rmnms.F
deleted file mode 100644
index 9af6d4f..0000000
--- a/src/packlib/kernlib/kernnum/f004fort/rmnms.F
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: rmnms.F,v 1.1.1.1 1996/02/15 17:49:02 mclareni Exp $
-*
-* $Log: rmnms.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:02 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE RMNMS(M,N,K,X,X12,X21,Y,Y12,Y21,Z,Z12,Z21)
- REAL X(*), X12(*), X21(*), Y(*), Y12(*), Y21(*)
- REAL Z(*), Z12(*), Z21(*)
-#include "rdotf.inc"
-#include "rlocf.inc"
-#include "nms.inc"
- END
diff --git a/src/packlib/kernlib/kernnum/f004fort/xisxxbar.inc b/src/packlib/kernlib/kernnum/f004fort/xisxxbar.inc
deleted file mode 100644
index 496bbf5..0000000
--- a/src/packlib/kernlib/kernnum/f004fort/xisxxbar.inc
+++ /dev/null
@@ -1,64 +0,0 @@
-*
-* $Id: xisxxbar.inc,v 1.1.1.1 1996/02/15 17:49:01 mclareni Exp $
-*
-* $Log: xisxxbar.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:49:01 mclareni
-* Kernlib
-*
-*
-*
-* xisxxbar.inc
-*
- 50 LXI1 = 1
- LXII = 1
- DO 56 I = 1, M
- S51 = ZERO
- LXIJ = LXI1
- DO 51 J = 1, N
- S51 = SQRF(X(LXIJ),S51)
- LXIJ = LXIJ + JX
- 51 CONTINUE
- T(1) = S51
- IF(I .EQ. M) GOTO 54
- LXK1 = LXI1 + IX
- LTK = 2
- DO 53 KDASH = I+1, M
- S52 = ZERO
- LXIJ = LXI1
- LXKJ = LXK1
- DO 52 J = 1, N
- S52 = DOTF(X(LXIJ),X(LXKJ),S52)
- LXIJ = LXIJ + JX
- LXKJ = LXKJ + JX
- 52 CONTINUE
- IF(IZ .EQ. IX) THEN
- T(LTK) = S52
- ELSE
- T(LTK) = CONJG(S52)
- ENDIF
- LXK1 = LXK1 + IX
- LTK = LTK + 1
- 53 CONTINUE
- 54 LXIK = LXII
- LTK = 1
- DO 55 KDASH = I, M
- X(LXIK) = T(LTK)
- LXIK = LXIK + JX
- LTK = LTK + 1
- 55 CONTINUE
- LXI1 = LXI1 + IX
- LXII = LXII + IX + JX
- 56 CONTINUE
- IF(M .EQ. 1) RETURN
- LXII = 1
- DO 58 I = 1, M-1
- LXIK = LXII + JX
- LXKI = LXII + IX
- DO 57 KDASH = I+1, M
- X(LXKI) = CNJF( X(LXIK) )
- LXIK = LXIK + JX
- LXKI = LXKI + IX
- 57 CONTINUE
- LXII = LXII + IX + JX
- 58 CONTINUE
- RETURN
diff --git a/src/packlib/kernlib/kernnum/f004fort/xisxxtra.inc b/src/packlib/kernlib/kernnum/f004fort/xisxxtra.inc
deleted file mode 100644
index 4904a80..0000000
--- a/src/packlib/kernlib/kernnum/f004fort/xisxxtra.inc
+++ /dev/null
@@ -1,60 +0,0 @@
-*
-* $Id: xisxxtra.inc,v 1.1.1.1 1996/02/15 17:49:01 mclareni Exp $
-*
-* $Log: xisxxtra.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:49:01 mclareni
-* Kernlib
-*
-*
-*
-* xisxxtra.inc
-*
- 50 LXI1 = 1
- LXII = 1
- DO 56 I = 1, M
- S51 = ZERO
- LXIJ = LXI1
- DO 51 J = 1, N
- S51 = SQRF(X(LXIJ),S51)
- LXIJ = LXIJ + JX
- 51 CONTINUE
- T(1) = S51
- IF(I .EQ. M) GOTO 54
- LXK1 = LXI1 + IX
- LTK = 2
- DO 53 KDASH = I+1, M
- S52 = ZERO
- LXIJ = LXI1
- LXKJ = LXK1
- DO 52 J = 1, N
- S52 = DOTF(X(LXIJ),X(LXKJ),S52)
- LXIJ = LXIJ + JX
- LXKJ = LXKJ + JX
- 52 CONTINUE
- T(LTK) = S52
- LXK1 = LXK1 + IX
- LTK = LTK + 1
- 53 CONTINUE
- 54 LXIK = LXII
- LTK = 1
- DO 55 KDASH = I, M
- X(LXIK) = T(LTK)
- LXIK = LXIK + JX
- LTK = LTK + 1
- 55 CONTINUE
- LXI1 = LXI1 + IX
- LXII = LXII + IX + JX
- 56 CONTINUE
- IF(M .EQ. 1) RETURN
- LXII = 1
- DO 58 I = 1, M-1
- LXIK = LXII + JX
- LXKI = LXII + IX
- DO 57 KDASH = I+1, M
- X(LXKI) = CNJF( X(LXIK) )
- LXIK = LXIK + JX
- LXKI = LXKI + IX
- 57 CONTINUE
- LXII = LXII + IX + JX
- 58 CONTINUE
- RETURN
diff --git a/src/packlib/kernlib/kernnum/f004fort/zisxy.inc b/src/packlib/kernlib/kernnum/f004fort/zisxy.inc
deleted file mode 100644
index 451b9b2..0000000
--- a/src/packlib/kernlib/kernnum/f004fort/zisxy.inc
+++ /dev/null
@@ -1,125 +0,0 @@
-*
-* $Id: zisxy.inc,v 1.1.1.1 1996/02/15 17:49:01 mclareni Exp $
-*
-* $Log: zisxy.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:49:01 mclareni
-* Kernlib
-*
-*
-*
-* zisxy.inc
-*
- IF(LOCZ .EQ. LOCX) GOTO 30
- IF(LOCZ .EQ. LOCY) GOTO 40
- IF(LOCX .EQ. LOCY) GOTO 20
- 10 LY1L = 1
- LZ1L = 1
- DO 13 L = 1, K
- LXI1 = 1
- LZIL = LZ1L
- DO 12 I = 1, M
- S11 = ZERO
- LXIJ = LXI1
- LYJL = LY1L
- DO 11 J = 1, N
- S11 = DOTF(X(LXIJ),Y(LYJL),S11)
- LXIJ = LXIJ + JX
- LYJL = LYJL + JY
- 11 CONTINUE
- Z(LZIL) = S11
- LXI1 = LXI1 + IX
- LZIL = LZIL + IZ
- 12 CONTINUE
- LY1L = LY1L + LY
- LZ1L = LZ1L + LZ
- 13 CONTINUE
- RETURN
- 20 IF(M .NE. K .OR. IX .NE. LY .OR. JX .NE. JY) GOTO 10
- LXI1 = 1
- LZII = 1
- DO 24 I = 1, M
- S21 = ZERO
- LXIJ = LXI1
- DO 21 J = 1, N
- S21 = SQRF(X(LXIJ),S21)
- LXIJ = LXIJ + JX
- 21 CONTINUE
- Z(LZII) = S21
- IF(I .EQ. M) GOTO 24
- LXK1 = LXI1 + IX
- LZIK = LZII + LZ
- LZKI = LZII + IZ
- DO 23 KDASH = I+1, M
- S22 = ZERO
- LXIJ = LXI1
- LXKJ = LXK1
- DO 22 J = 1, N
- S22 = DOTF(X(LXIJ),X(LXKJ),S22)
- LXIJ = LXIJ + JX
- LXKJ = LXKJ + JX
- 22 CONTINUE
- Z(LZIK) = S22
- Z(LZKI) = CNJF( Z(LZIK) )
- LXK1 = LXK1 + IX
- LZIK = LZIK + LZ
- LZKI = LZKI + IZ
- 23 CONTINUE
- LXI1 = LXI1 + IX
- LZII = LZII + IZ + LZ
- 24 CONTINUE
- RETURN
- 30 IF(LOCX .EQ. LOCY) GOTO 50
- LXI1 = 1
- DO 34 I = 1, M
- LY1L = 1
- LTL = 1
- DO 32 L = 1, K
- S31 = ZERO
- LXIJ = LXI1
- LYJL = LY1L
- DO 31 J = 1, N
- S31 = DOTF(X(LXIJ),Y(LYJL),S31)
- LXIJ = LXIJ + JX
- LYJL = LYJL + JY
- 31 CONTINUE
- T(LTL) = S31
- LY1L = LY1L + LY
- LTL = LTL + 1
- 32 CONTINUE
- LXIL = LXI1
- LTL = 1
- DO 33 L = 1, K
- X(LXIL) = T(LTL)
- LXIL = LXIL + JX
- LTL = LTL + 1
- 33 CONTINUE
- LXI1 = LXI1 + IX
- 34 CONTINUE
- RETURN
- 40 LY1L = 1
- DO 44 L = 1, K
- LXI1 = 1
- LTI = 1
- DO 42 I = 1, M
- S41 = ZERO
- LXIJ = LXI1
- LYJL = LY1L
- DO 41 J = 1, N
- S41 = DOTF(X(LXIJ),Y(LYJL),S41)
- LXIJ = LXIJ + JX
- LYJL = LYJL + JY
- 41 CONTINUE
- T(LTI) = S41
- LXI1 = LXI1 + IX
- LTI = LTI + 1
- 42 CONTINUE
- LYIL = LY1L
- LTI = 1
- DO 43 I = 1, M
- Y(LYIL) = T(LTI)
- LYIL = LYIL + JY
- LTI = LTI + 1
- 43 CONTINUE
- LY1L = LY1L + LY
- 44 CONTINUE
- RETURN
diff --git a/src/packlib/kernlib/kernnum/f010fort/Imakefile b/src/packlib/kernlib/kernnum/f010fort/Imakefile
deleted file mode 100644
index 620e357..0000000
--- a/src/packlib/kernlib/kernnum/f010fort/Imakefile
+++ /dev/null
@@ -1,17 +0,0 @@
-SRCS_F= ceqinv.F ceqn.F cinv.F \@@\
- deqinv.F deqn.F dinv.F \@@\
- reqinv.F reqn.F rinv.F \@@\
- f010pr.F
-
-#if defined(CERNLIB_DECS) && ! defined(CERNLIB_QMVAOS)
-FDEBUGFLAGS=NoOpFortranDebugFlags
-#endif
-
-#if defined(CERNLIB_MACOSX)
-FDEBUGFLAGS := -O0 $(FDEBUGFLAGS) -O0
-#endif
-
-FORTRANSAVEOPTION=FortranSaveFlags
-
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kernnum/f010fort/ceqinv.F b/src/packlib/kernlib/kernnum/f010fort/ceqinv.F
deleted file mode 100644
index 867299d..0000000
--- a/src/packlib/kernlib/kernnum/f010fort/ceqinv.F
+++ /dev/null
@@ -1,154 +0,0 @@
-*
-* $Id: ceqinv.F,v 1.1.1.1 1996/02/15 17:48:49 mclareni Exp $
-*
-* $Log: ceqinv.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:49 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE CEQINV(N,A,IDIM,R,IFAIL,K,B)
- REAL R(N),T1,T2,T3
- COMPLEX A(IDIM,N),B(IDIM,K),ONE,DET,TEMP,S,
- $ B1,B2,C11,C12,C13,C21,C22,C23,C31,C32,C33
- CHARACTER*6 NAME
- DATA NAME/'CEQINV'/,KPRNT/1/
- DATA ONE/(1.0,0.0)/
-C
-C ******************************************************************
-C
-C REPLACES B BY THE SOLUTION X OF A*X=B, AND REPLACES A BY ITS IN-
-C VERSE.
-C
-C N ORDER OF THE SQUARE MATRIX IN ARRAY A.
-C
-C A (COMPLEX) TWO-DIMENSIONAL ARRAY CONTAINING AN N BY N
-C MATRIX.
-C
-C IDIM FIRST DIMENSION PARAMETER OF ARRAYS A AND B.
-C
-C R (REAL) WORKING VECTOR OF LENGTH NOT LESS THAN N.
-C
-C IFAIL OUTPUT PARAMETER. IFAIL= 0 ... NORMAL EXIT.
-C IFAIL=-1 ... SINGULAR MATRIX.
-C
-C K NUMBER OF COLUMNS OF THE MATRIX IN ARRAY B.
-C
-C B (COMPLEX) TWO-DIMENSIONAL ARRAY CONTAINING AN N BY K
-C MATRIX.
-C
-C CALLS ... CFACT, CFINV, F010PR, ABEND.
-C
-C ******************************************************************
-C
-C TEST FOR PARAMETER ERRORS.
-C
- IF((N.LT.1).OR.(N.GT.IDIM).OR.(K.LT.1)) GO TO 10
-C
-C TEST FOR N.LE.3.
-C
- IF(N.GT.3) GO TO 9
- IFAIL=0
- IF(N.LT.3) GO TO 5
-C
-C N=3 CASE.
-C
-C COMPUTE COFACTORS.
- C11=A(2,2)*A(3,3)-A(2,3)*A(3,2)
- C12=A(2,3)*A(3,1)-A(2,1)*A(3,3)
- C13=A(2,1)*A(3,2)-A(2,2)*A(3,1)
- C21=A(3,2)*A(1,3)-A(3,3)*A(1,2)
- C22=A(3,3)*A(1,1)-A(3,1)*A(1,3)
- C23=A(3,1)*A(1,2)-A(3,2)*A(1,1)
- C31=A(1,2)*A(2,3)-A(1,3)*A(2,2)
- C32=A(1,3)*A(2,1)-A(1,1)*A(2,3)
- C33=A(1,1)*A(2,2)-A(1,2)*A(2,1)
- T1=ABS(REAL(A(1,1)))+ABS(AIMAG(A(1,1)))
- T2=ABS(REAL(A(2,1)))+ABS(AIMAG(A(2,1)))
- T3=ABS(REAL(A(3,1)))+ABS(AIMAG(A(3,1)))
-C
-C (SET TEMP=PIVOT AND DET=PIVOT*DET.)
- IF(T1.GE.T2) GO TO 1
- IF(T3.GE.T2) GO TO 2
-C (PIVOT IS A21)
- TEMP=A(2,1)
- DET=C13*C32-C12*C33
- GO TO 3
- 1 IF(T3.GE.T1) GO TO 2
-C (PIVOT IS A11)
- TEMP=A(1,1)
- DET=C22*C33-C23*C32
- GO TO 3
-C (PIVOT IS A31)
- 2 TEMP=A(3,1)
- DET=C23*C12-C22*C13
-C
-C SET ELEMENTS OF INVERSE IN A.
- 3 IF( REAL(DET).EQ.0. .AND. AIMAG(DET).EQ.0. ) GO TO 11
- S=TEMP/DET
- A(1,1)=S*C11
- A(1,2)=S*C21
- A(1,3)=S*C31
- A(2,1)=S*C12
- A(2,2)=S*C22
- A(2,3)=S*C32
- A(3,1)=S*C13
- A(3,2)=S*C23
- A(3,3)=S*C33
-C
-C REPLACE B BY AINV*B.
- DO 4 J=1,K
- B1=B(1,J)
- B2=B(2,J)
- B(1,J)=A(1,1)*B1+A(1,2)*B2+A(1,3)*B(3,J)
- B(2,J)=A(2,1)*B1+A(2,2)*B2+A(2,3)*B(3,J)
- B(3,J)=A(3,1)*B1+A(3,2)*B2+A(3,3)*B(3,J)
- 4 CONTINUE
- RETURN
-C
- 5 IF(N.LT.2) GO TO 7
-C
-C N=2 CASE BY CRAMERS RULE.
-C
- DET=A(1,1)*A(2,2)-A(1,2)*A(2,1)
- IF( REAL(DET).EQ.0. .AND. AIMAG(DET).EQ.0. ) GO TO 11
- S=ONE/DET
- C11 =S*A(2,2)
- A(1,2)=-S*A(1,2)
- A(2,1)=-S*A(2,1)
- A(2,2)=S*A(1,1)
- A(1,1)=C11
- DO 6 J=1,K
- B1=B(1,J)
- B(1,J)=C11*B1+A(1,2)*B(2,J)
- B(2,J)=A(2,1)*B1+A(2,2)*B(2,J)
- 6 CONTINUE
- RETURN
-C
-C N=1 CASE.
-C
- 7 IF( REAL(A(1,1)).EQ.0. .AND. AIMAG(A(1,1)).EQ.0. ) GO TO 11
- A(1,1)=ONE/A(1,1)
- DO 8 J=1,K
- B(1,J)=A(1,1)*B(1,J)
- 8 CONTINUE
- RETURN
-C
-C N.GT.3 CASES. FACTORIZE MATRIX, INVERT AND SOLVE SYSTEM.
-C
- 9 CALL CFACT(N,A,IDIM,R,IFAIL,DET,JFAIL)
- IF(IFAIL.NE.0) RETURN
- CALL CFEQN(N,A,IDIM,R,K,B)
- CALL CFINV(N,A,IDIM,R)
- RETURN
-C
-C ERROR EXITS.
-C
- 10 IFAIL=+1
- CALL F010PR(NAME,N,IDIM,K,KPRNT)
- RETURN
-C
- 11 IFAIL=-1
- RETURN
-C
- END
diff --git a/src/packlib/kernlib/kernnum/f010fort/ceqn.F b/src/packlib/kernlib/kernnum/f010fort/ceqn.F
deleted file mode 100644
index 87bcceb..0000000
--- a/src/packlib/kernlib/kernnum/f010fort/ceqn.F
+++ /dev/null
@@ -1,137 +0,0 @@
-*
-* $Id: ceqn.F,v 1.1.1.1 1996/02/15 17:48:49 mclareni Exp $
-*
-* $Log: ceqn.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:49 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE CEQN(N,A,IDIM,R,IFAIL,K,B)
- REAL R(N),T1,T2,T3
- COMPLEX A(IDIM,N),B(IDIM,K),ONE,DET,S,TEMP,
- $ B1,Y1,Y2,L11,L21,L22,L31,L32,L33,U12,U13,U23
- CHARACTER*6 NAME
- DATA NAME/'CEQN'/,KPRNT/1/
- DATA ONE/(1.0,0.0)/
-C
-C ******************************************************************
-C
-C REPLACES B BY THE SOLUTION X OF A*X=B, AFTER WHICH A IS UNDEFINED.
-C
-C (PARAMETERS AS FOR CEQINV.)
-C
-C CALLS ... CFACT, CFEQN, F010PR, ABEND.
-C
-C ******************************************************************
-C
-C TEST FOR PARAMETER ERRORS.
-C
- IF((N.LT.1).OR.(N.GT.IDIM).OR.(K.LT.1)) GO TO 11
-C
-C TEST FOR N.LE.3.
-C
- IF(N.GT.3) GO TO 10
- IFAIL=0
- IF(N.LT.3) GO TO 6
-C
-C N=3 CASE.
-C
-C FACTORIZE MATRIX A=L*U.
-C (FIRST PIVOT SEARCH)
- T1=ABS(REAL(A(1,1)))+ABS(AIMAG(A(1,1)))
- T2=ABS(REAL(A(2,1)))+ABS(AIMAG(A(2,1)))
- T3=ABS(REAL(A(3,1)))+ABS(AIMAG(A(3,1)))
- IF(T1.GE.T2) GO TO 1
- IF(T3.GE.T2) GO TO 2
-C (PIVOT IS A21)
- M1=2
- M2=1
- M3=3
- GO TO 3
- 1 IF(T3.GE.T1) GO TO 2
-C (PIVOT IS A11)
- M1=1
- M2=2
- M3=3
- GO TO 3
-C (PIVOT IS A31)
- 2 M1=3
- M2=2
- M3=1
- 3 TEMP=A(M1,1)
- IF( REAL(TEMP).EQ.0. .AND. AIMAG(TEMP).EQ.0. ) GO TO 10
- L11=ONE/TEMP
- U12=L11*A(M1,2)
- U13=L11*A(M1,3)
- L22=A(M2,2)-A(M2,1)*U12
- L32=A(M3,2)-A(M3,1)*U12
-C (SECOND PIVOT SEARCH)
- T2=ABS(REAL(L22))+ABS(AIMAG(L22))
- T3=ABS(REAL(L32))+ABS(AIMAG(L32))
- IF(T2.GE.T3) GO TO 4
- I=M2
- M2=M3
- M3=I
- TEMP=L22
- L22=L32
- L32=TEMP
- 4 L21=A(M2,1)
- L31=A(M3,1)
- IF( REAL(L22).EQ.0. .AND. AIMAG(L22).EQ.0. ) GO TO 10
- L22=ONE/L22
- U23=L22*(A(M2,3)-L21*U13)
- TEMP=A(M3,3)-L31*U13-L32*U23
- IF( REAL(TEMP).EQ.0. .AND. AIMAG(TEMP).EQ.0. ) GO TO 10
- L33=ONE/TEMP
-C
-C SOLVE L*Y=B AND U*X=Y.
- DO 5 J=1,K
- Y1=L11*B(M1,J)
- Y2=L22*(B(M2,J)-L21*Y1)
- B(3,J)=L33*(B(M3,J)-L31*Y1-L32*Y2)
- B(2,J)=Y2-U23*B(3,J)
- B(1,J)=Y1-U12*B(2,J)-U13*B(3,J)
- 5 CONTINUE
- RETURN
-C
- 6 IF(N.LT.2) GO TO 8
-C
-C N=2 CASE BY CRAMERS RULE.
-C
- DET=A(1,1)*A(2,2)-A(1,2)*A(2,1)
- IF( REAL(DET).EQ.0. .AND. AIMAG(DET).EQ.0. ) GO TO 12
- S=ONE/DET
- DO 7 J=1,K
- B1=B(1,J)
- B(1,J)=S*(A(2,2)*B1-A(1,2)*B(2,J))
- B(2,J)=S*(-A(2,1)*B1+A(1,1)*B(2,J))
- 7 CONTINUE
- RETURN
-C
-C N=1 CASE.
-C
- 8 IF( REAL(A(1,1)).EQ.0. .AND. AIMAG(A(1,1)).EQ.0. ) GO TO 12
- S=ONE/A(1,1)
- DO 9 J=1,K
- B(1,J)=S*B(1,J)
- 9 CONTINUE
- RETURN
-C
-C N.GT.3 CASES. FACTORIZE MATRIX AND SOLVE SYSTEM.
-C
- 10 CALL CFACT(N,A,IDIM,R,IFAIL,DET,JFAIL)
- IF(IFAIL.NE.0) RETURN
- CALL CFEQN(N,A,IDIM,R,K,B)
- RETURN
-C
-C ERROR EXITS.
-C
- 11 IFAIL=+1
- CALL F010PR(NAME,N,IDIM,K,KPRNT)
- RETURN
-C
- 12 IFAIL=-1
- RETURN
-C
- END
diff --git a/src/packlib/kernlib/kernnum/f010fort/cinv.F b/src/packlib/kernlib/kernnum/f010fort/cinv.F
deleted file mode 100644
index 3b90d9b..0000000
--- a/src/packlib/kernlib/kernnum/f010fort/cinv.F
+++ /dev/null
@@ -1,120 +0,0 @@
-*
-* $Id: cinv.F,v 1.1.1.1 1996/02/15 17:48:49 mclareni Exp $
-*
-* $Log: cinv.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:49 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE CINV(N,A,IDIM,R,IFAIL)
- REAL R(N),T1,T2,T3
- COMPLEX A(IDIM,N),ONE,DET,TEMP,S,
- $ C11,C12,C13,C21,C22,C23,C31,C32,C33
- CHARACTER*6 NAME
- DATA NAME/'CINV'/,KPRNT/0/
- DATA ONE/(1.0,0.0)/
-C
-C ******************************************************************
-C
-C REPLACES A BY ITS INVERSE.
-C
-C (PARAMETERS AS FOR CEQINV.)
-C
-C CALLS ... CFACT, CFINV, F010PR, ABEND.
-C
-C ******************************************************************
-C
-C TEST FOR PARAMETER ERRORS.
-C
- IF((N.LT.1).OR.(N.GT.IDIM)) GO TO 7
-C
-C TEST FOR N.LE.3.
-C
- IF(N.GT.3) GO TO 6
- IFAIL=0
- IF(N.LT.3) GO TO 4
-C
-C N=3 CASE.
-C
-C COMPUTE COFACTORS.
- C11=A(2,2)*A(3,3)-A(2,3)*A(3,2)
- C12=A(2,3)*A(3,1)-A(2,1)*A(3,3)
- C13=A(2,1)*A(3,2)-A(2,2)*A(3,1)
- C21=A(3,2)*A(1,3)-A(3,3)*A(1,2)
- C22=A(3,3)*A(1,1)-A(3,1)*A(1,3)
- C23=A(3,1)*A(1,2)-A(3,2)*A(1,1)
- C31=A(1,2)*A(2,3)-A(1,3)*A(2,2)
- C32=A(1,3)*A(2,1)-A(1,1)*A(2,3)
- C33=A(1,1)*A(2,2)-A(1,2)*A(2,1)
- T1=ABS(REAL(A(1,1)))+ABS(AIMAG(A(1,1)))
- T2=ABS(REAL(A(2,1)))+ABS(AIMAG(A(2,1)))
- T3=ABS(REAL(A(3,1)))+ABS(AIMAG(A(3,1)))
-C
-C (SET TEMP=PIVOT AND DET=PIVOT*DET.)
- IF(T1.GE.T2) GO TO 1
- IF(T3.GE.T2) GO TO 2
-C (PIVOT IS A21)
- TEMP=A(2,1)
- DET=C13*C32-C12*C33
- GO TO 3
- 1 IF(T3.GE.T1) GO TO 2
-C (PIVOT IS A11)
- TEMP=A(1,1)
- DET=C22*C33-C23*C32
- GO TO 3
-C (PIVOT IS A31)
- 2 TEMP=A(3,1)
- DET=C23*C12-C22*C13
-C
-C SET ELEMENTS OF INVERSE IN A.
- 3 IF( REAL(DET).EQ.0. .AND. AIMAG(DET).EQ.0. ) GO TO 8
- S=TEMP/DET
- A(1,1)=S*C11
- A(1,2)=S*C21
- A(1,3)=S*C31
- A(2,1)=S*C12
- A(2,2)=S*C22
- A(2,3)=S*C32
- A(3,1)=S*C13
- A(3,2)=S*C23
- A(3,3)=S*C33
- RETURN
-C
- 4 IF(N.LT.2) GO TO 5
-C
-C N=2 CASE BY CRAMERS RULE.
-C
- DET=A(1,1)*A(2,2)-A(1,2)*A(2,1)
- IF( REAL(DET).EQ.0. .AND. AIMAG(DET).EQ.0. ) GO TO 8
- S=ONE/DET
- C11 =S*A(2,2)
- A(1,2)=-S*A(1,2)
- A(2,1)=-S*A(2,1)
- A(2,2)=S*A(1,1)
- A(1,1)=C11
- RETURN
-C
-C N=1 CASE.
-C
- 5 IF( REAL(A(1,1)).EQ.0. .AND. AIMAG(A(1,1)).EQ.0. ) GO TO 8
- A(1,1)=ONE/A(1,1)
- RETURN
-C
-C N.GT.3 CASES. FACTORIZE MATRIX AND INVERT.
-C
- 6 CALL CFACT(N,A,IDIM,R,IFAIL,DET,JFAIL)
- IF(IFAIL.NE.0) RETURN
- CALL CFINV(N,A,IDIM,R)
- RETURN
-C
-C ERROR EXITS.
-C
- 7 IFAIL=+1
- CALL F010PR(NAME,N,IDIM,K,KPRNT)
- RETURN
-C
- 8 IFAIL=-1
- RETURN
-C
- END
diff --git a/src/packlib/kernlib/kernnum/f010fort/deqinv.F b/src/packlib/kernlib/kernnum/f010fort/deqinv.F
deleted file mode 100644
index 18a0b97..0000000
--- a/src/packlib/kernlib/kernnum/f010fort/deqinv.F
+++ /dev/null
@@ -1,153 +0,0 @@
-*
-* $Id: deqinv.F,v 1.1.1.1 1996/02/15 17:48:48 mclareni Exp $
-*
-* $Log: deqinv.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:48 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE DEQINV(N,A,IDIM,R,IFAIL,K,B)
- REAL R(N),T1,T2,T3
- DOUBLE PRECISION A(IDIM,N),B(IDIM,K),DET,TEMP,S,
- $ B1,B2,C11,C12,C13,C21,C22,C23,C31,C32,C33
- CHARACTER*6 NAME
- DATA NAME/'DEQINV'/,KPRNT/1/
-C
-C ******************************************************************
-C
-C REPLACES B BY THE SOLUTION X OF A*X=B, AND REPLACES A BY ITS IN-
-C VERSE.
-C
-C N ORDER OF THE SQUARE MATRIX IN ARRAY A.
-C
-C A (DOUBLE PRECISION) TWO-DIMENSIONAL ARRAY CONTAINING
-C AN N BY N MATRIX.
-C
-C IDIM FIRST DIMENSION PARAMETER OF ARRAYS A AND B.
-C
-C R (REAL) WORKING VECTOR OF LENGTH NOT LESS THAN N.
-C
-C IFAIL OUTPUT PARAMETER. IFAIL= 0 ... NORMAL EXIT.
-C IFAIL=-1 ... SINGULAR MATRIX.
-C
-C K NUMBER OF COLUMNS OF THE MATRIX IN ARRAY B.
-C
-C B (DOUBLE PRECISION) TWO-DIMENSIONAL ARRAY CONTAINING
-C AN N BY K MATRIX.
-C
-C CALLS ... DFACT, DFINV, F010PR, ABEND.
-C
-C ******************************************************************
-C
-C TEST FOR PARAMETER ERRORS.
-C
- IF((N.LT.1).OR.(N.GT.IDIM).OR.(K.LT.1)) GO TO 10
-C
-C TEST FOR N.LE.3.
-C
- IF(N.GT.3) GO TO 9
- IFAIL=0
- IF(N.LT.3) GO TO 5
-C
-C N=3 CASE.
-C
-C COMPUTE COFACTORS.
- C11=A(2,2)*A(3,3)-A(2,3)*A(3,2)
- C12=A(2,3)*A(3,1)-A(2,1)*A(3,3)
- C13=A(2,1)*A(3,2)-A(2,2)*A(3,1)
- C21=A(3,2)*A(1,3)-A(3,3)*A(1,2)
- C22=A(3,3)*A(1,1)-A(3,1)*A(1,3)
- C23=A(3,1)*A(1,2)-A(3,2)*A(1,1)
- C31=A(1,2)*A(2,3)-A(1,3)*A(2,2)
- C32=A(1,3)*A(2,1)-A(1,1)*A(2,3)
- C33=A(1,1)*A(2,2)-A(1,2)*A(2,1)
- T1=ABS(SNGL(A(1,1)))
- T2=ABS(SNGL(A(2,1)))
- T3=ABS(SNGL(A(3,1)))
-C
-C (SET TEMP=PIVOT AND DET=PIVOT*DET.)
- IF(T1.GE.T2) GO TO 1
- IF(T3.GE.T2) GO TO 2
-C (PIVOT IS A21)
- TEMP=A(2,1)
- DET=C13*C32-C12*C33
- GO TO 3
- 1 IF(T3.GE.T1) GO TO 2
-C (PIVOT IS A11)
- TEMP=A(1,1)
- DET=C22*C33-C23*C32
- GO TO 3
-C (PIVOT IS A31)
- 2 TEMP=A(3,1)
- DET=C23*C12-C22*C13
-C
-C SET ELEMENTS OF INVERSE IN A.
- 3 IF(DET.EQ.0D0) GO TO 11
- S=TEMP/DET
- A(1,1)=S*C11
- A(1,2)=S*C21
- A(1,3)=S*C31
- A(2,1)=S*C12
- A(2,2)=S*C22
- A(2,3)=S*C32
- A(3,1)=S*C13
- A(3,2)=S*C23
- A(3,3)=S*C33
-C
-C REPLACE B BY AINV*B.
- DO 4 J=1,K
- B1=B(1,J)
- B2=B(2,J)
- B(1,J)=A(1,1)*B1+A(1,2)*B2+A(1,3)*B(3,J)
- B(2,J)=A(2,1)*B1+A(2,2)*B2+A(2,3)*B(3,J)
- B(3,J)=A(3,1)*B1+A(3,2)*B2+A(3,3)*B(3,J)
- 4 CONTINUE
- RETURN
-C
- 5 IF(N.LT.2) GO TO 7
-C
-C N=2 CASE BY CRAMERS RULE.
-C
- DET=A(1,1)*A(2,2)-A(1,2)*A(2,1)
- IF(DET.EQ.0D0) GO TO 11
- S=1D0/DET
- C11 =S*A(2,2)
- A(1,2)=-S*A(1,2)
- A(2,1)=-S*A(2,1)
- A(2,2)=S*A(1,1)
- A(1,1)=C11
- DO 6 J=1,K
- B1=B(1,J)
- B(1,J)=C11*B1+A(1,2)*B(2,J)
- B(2,J)=A(2,1)*B1+A(2,2)*B(2,J)
- 6 CONTINUE
- RETURN
-C
-C N=1 CASE.
-C
- 7 IF(A(1,1).EQ.0D0) GO TO 11
- A(1,1)=1D0/A(1,1)
- DO 8 J=1,K
- B(1,J)=A(1,1)*B(1,J)
- 8 CONTINUE
- RETURN
-C
-C N.GT.3 CASES. FACTORIZE MATRIX, INVERT AND SOLVE SYSTEM.
-C
- 9 CALL DFACT(N,A,IDIM,R,IFAIL,DET,JFAIL)
- IF(IFAIL.NE.0) RETURN
- CALL DFEQN(N,A,IDIM,R,K,B)
- CALL DFINV(N,A,IDIM,R)
- RETURN
-C
-C ERROR EXITS.
-C
- 10 IFAIL=+1
- CALL F010PR(NAME,N,IDIM,K,KPRNT)
- RETURN
-C
- 11 IFAIL=-1
- RETURN
-C
- END
diff --git a/src/packlib/kernlib/kernnum/f010fort/deqn.F b/src/packlib/kernlib/kernnum/f010fort/deqn.F
deleted file mode 100644
index 6c0671e..0000000
--- a/src/packlib/kernlib/kernnum/f010fort/deqn.F
+++ /dev/null
@@ -1,134 +0,0 @@
-*
-* $Id: deqn.F,v 1.1.1.1 1996/02/15 17:48:49 mclareni Exp $
-*
-* $Log: deqn.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:49 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE DEQN(N,A,IDIM,R,IFAIL,K,B)
- REAL R(N),T1,T2,T3
- DOUBLE PRECISION A(IDIM,N),B(IDIM,K),DET,S,TEMP,
- $ B1,Y1,Y2,L11,L21,L22,L31,L32,L33,U12,U13,U23
- CHARACTER*6 NAME
- DATA NAME/'DEQN'/,KPRNT/1/
-C
-C ******************************************************************
-C
-C REPLACES B BY THE SOLUTION X OF A*X=B, AFTER WHICH A IS UNDEFINED.
-C
-C (PARAMETERS AS FOR DEQINV.)
-C
-C CALLS ... DFACT, DFEQN, F010PR, ABEND.
-C
-C ******************************************************************
-C
-C TEST FOR PARAMETER ERRORS.
-C
- IF((N.LT.1).OR.(N.GT.IDIM).OR.(K.LT.1)) GO TO 11
-C
-C TEST FOR N.LE.3.
-C
- IF(N.GT.3) GO TO 10
- IFAIL=0
- IF(N.LT.3) GO TO 6
-C
-C N=3 CASE.
-C
-C FACTORIZE MATRIX A=L*U.
-C (FIRST PIVOT SEARCH)
- T1=ABS(SNGL(A(1,1)))
- T2=ABS(SNGL(A(2,1)))
- T3=ABS(SNGL(A(3,1)))
- IF(T1.GE.T2) GO TO 1
- IF(T3.GE.T2) GO TO 2
-C (PIVOT IS A21)
- M1=2
- M2=1
- M3=3
- GO TO 3
- 1 IF(T3.GE.T1) GO TO 2
-C (PIVOT IS A11)
- M1=1
- M2=2
- M3=3
- GO TO 3
-C (PIVOT IS A31)
- 2 M1=3
- M2=2
- M3=1
- 3 TEMP=A(M1,1)
- IF(TEMP.EQ.0D0) GO TO 10
- L11=1D0/TEMP
- U12=L11*A(M1,2)
- U13=L11*A(M1,3)
- L22=A(M2,2)-A(M2,1)*U12
- L32=A(M3,2)-A(M3,1)*U12
-C (SECOND PIVOT SEARCH)
- IF( ABS(SNGL(L22)) .GE. ABS(SNGL(L32)) ) GO TO 4
- I=M2
- M2=M3
- M3=I
- TEMP=L22
- L22=L32
- L32=TEMP
- 4 L21=A(M2,1)
- L31=A(M3,1)
- IF(L22.EQ.0D0) GO TO 10
- L22=1D0/L22
- U23=L22*(A(M2,3)-L21*U13)
- TEMP=A(M3,3)-L31*U13-L32*U23
- IF(TEMP.EQ.0D0) GO TO 10
- L33=1D0/TEMP
-C
-C SOLVE L*Y=B AND U*X=Y.
- DO 5 J=1,K
- Y1=L11*B(M1,J)
- Y2=L22*(B(M2,J)-L21*Y1)
- B(3,J)=L33*(B(M3,J)-L31*Y1-L32*Y2)
- B(2,J)=Y2-U23*B(3,J)
- B(1,J)=Y1-U12*B(2,J)-U13*B(3,J)
- 5 CONTINUE
- RETURN
-C
- 6 IF(N.LT.2) GO TO 8
-C
-C N=2 CASE BY CRAMERS RULE.
-C
- DET=A(1,1)*A(2,2)-A(1,2)*A(2,1)
- IF(DET.EQ.0D0) GO TO 12
- S=1D0/DET
- DO 7 J=1,K
- B1=B(1,J)
- B(1,J)=S*(A(2,2)*B1-A(1,2)*B(2,J))
- B(2,J)=S*(-A(2,1)*B1+A(1,1)*B(2,J))
- 7 CONTINUE
- RETURN
-C
-C N=1 CASE.
-C
- 8 IF(A(1,1).EQ.0D0) GO TO 12
- S=1D0/A(1,1)
- DO 9 J=1,K
- B(1,J)=S*B(1,J)
- 9 CONTINUE
- RETURN
-C
-C N.GT.3 CASES. FACTORIZE MATRIX AND SOLVE SYSTEM.
-C
- 10 CALL DFACT(N,A,IDIM,R,IFAIL,DET,JFAIL)
- IF(IFAIL.NE.0) RETURN
- CALL DFEQN(N,A,IDIM,R,K,B)
- RETURN
-C
-C ERROR EXITS.
-C
- 11 IFAIL=+1
- CALL F010PR(NAME,N,IDIM,K,KPRNT)
- RETURN
-C
- 12 IFAIL=-1
- RETURN
-C
- END
diff --git a/src/packlib/kernlib/kernnum/f010fort/dinv.F b/src/packlib/kernlib/kernnum/f010fort/dinv.F
deleted file mode 100644
index 6f5b08b..0000000
--- a/src/packlib/kernlib/kernnum/f010fort/dinv.F
+++ /dev/null
@@ -1,119 +0,0 @@
-*
-* $Id: dinv.F,v 1.1.1.1 1996/02/15 17:48:49 mclareni Exp $
-*
-* $Log: dinv.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:49 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE DINV(N,A,IDIM,R,IFAIL)
- REAL R(N),T1,T2,T3
- DOUBLE PRECISION A(IDIM,N),DET,TEMP,S,
- $ C11,C12,C13,C21,C22,C23,C31,C32,C33
- CHARACTER*6 NAME
- DATA NAME/'DINV'/,KPRNT/0/
-C
-C ******************************************************************
-C
-C REPLACES A BY ITS INVERSE.
-C
-C (PARAMETERS AS FOR DEQINV.)
-C
-C CALLS ... DFACT, DFINV, F010PR, ABEND.
-C
-C ******************************************************************
-C
-C TEST FOR PARAMETER ERRORS.
-C
- IF((N.LT.1).OR.(N.GT.IDIM)) GO TO 7
-C
-C TEST FOR N.LE.3.
-C
- IF(N.GT.3) GO TO 6
- IFAIL=0
- IF(N.LT.3) GO TO 4
-C
-C N=3 CASE.
-C
-C COMPUTE COFACTORS.
- C11=A(2,2)*A(3,3)-A(2,3)*A(3,2)
- C12=A(2,3)*A(3,1)-A(2,1)*A(3,3)
- C13=A(2,1)*A(3,2)-A(2,2)*A(3,1)
- C21=A(3,2)*A(1,3)-A(3,3)*A(1,2)
- C22=A(3,3)*A(1,1)-A(3,1)*A(1,3)
- C23=A(3,1)*A(1,2)-A(3,2)*A(1,1)
- C31=A(1,2)*A(2,3)-A(1,3)*A(2,2)
- C32=A(1,3)*A(2,1)-A(1,1)*A(2,3)
- C33=A(1,1)*A(2,2)-A(1,2)*A(2,1)
- T1=ABS(SNGL(A(1,1)))
- T2=ABS(SNGL(A(2,1)))
- T3=ABS(SNGL(A(3,1)))
-C
-C (SET TEMP=PIVOT AND DET=PIVOT*DET.)
- IF(T1.GE.T2) GO TO 1
- IF(T3.GE.T2) GO TO 2
-C (PIVOT IS A21)
- TEMP=A(2,1)
- DET=C13*C32-C12*C33
- GO TO 3
- 1 IF(T3.GE.T1) GO TO 2
-C (PIVOT IS A11)
- TEMP=A(1,1)
- DET=C22*C33-C23*C32
- GO TO 3
-C (PIVOT IS A31)
- 2 TEMP=A(3,1)
- DET=C23*C12-C22*C13
-C
-C SET ELEMENTS OF INVERSE IN A.
- 3 IF(DET.EQ.0D0) GO TO 8
- S=TEMP/DET
- A(1,1)=S*C11
- A(1,2)=S*C21
- A(1,3)=S*C31
- A(2,1)=S*C12
- A(2,2)=S*C22
- A(2,3)=S*C32
- A(3,1)=S*C13
- A(3,2)=S*C23
- A(3,3)=S*C33
- RETURN
-C
- 4 IF(N.LT.2) GO TO 5
-C
-C N=2 CASE BY CRAMERS RULE.
-C
- DET=A(1,1)*A(2,2)-A(1,2)*A(2,1)
- IF(DET.EQ.0D0) GO TO 8
- S=1D0/DET
- C11 =S*A(2,2)
- A(1,2)=-S*A(1,2)
- A(2,1)=-S*A(2,1)
- A(2,2)=S*A(1,1)
- A(1,1)=C11
- RETURN
-C
-C N=1 CASE.
-C
- 5 IF(A(1,1).EQ.0D0) GO TO 8
- A(1,1)=1D0/A(1,1)
- RETURN
-C
-C N.GT.3 CASES. FACTORIZE MATRIX AND INVERT.
-C
- 6 CALL DFACT(N,A,IDIM,R,IFAIL,DET,JFAIL)
- IF(IFAIL.NE.0) RETURN
- CALL DFINV(N,A,IDIM,R)
- RETURN
-C
-C ERROR EXITS.
-C
- 7 IFAIL=+1
- CALL F010PR(NAME,N,IDIM,K,KPRNT)
- RETURN
-C
- 8 IFAIL=-1
- RETURN
-C
- END
diff --git a/src/packlib/kernlib/kernnum/f010fort/f010pr.F b/src/packlib/kernlib/kernnum/f010fort/f010pr.F
deleted file mode 100644
index cc97005..0000000
--- a/src/packlib/kernlib/kernnum/f010fort/f010pr.F
+++ /dev/null
@@ -1,48 +0,0 @@
-*
-* $Id: f010pr.F,v 1.1.1.1 1996/02/15 17:48:49 mclareni Exp $
-*
-* $Log: f010pr.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:49 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE F010PR(NAME,N,IDIM,K,KPRNT)
- CHARACTER*6 NAME
- LOGICAL MFLAG,RFLAG
-C
-C ******************************************************************
-C
-C PRINT ROUTINE FOR PARAMETER ERRORS IN MATRIX SUBROUTINES $EQINV,
-C $EQN, $INV (WHERE $ IS A LETTER SPECIFYING THE ARITHMETIC TYPE).
-C
-C NAME (CHARACTER*6) NAME OF THE CALLING ROUTINE.
-C
-C N,IDIM,K PARAMETERS OF THE CALLING ROUTINE (WITH K=0 IF K IS
-C NOT TO BE PRINTED).
-C
-C KPRNT PRINT FLAG FOR K (K IS NOT PRINTED IF KPRNT=0).
-C
-C ******************************************************************
-C
-C START.
- CALL KERMTR('F010.1',LGFILE,MFLAG,RFLAG)
- IF(MFLAG) THEN
- IF(LGFILE.EQ.0) THEN
- IF(KPRNT.EQ.0) WRITE(*,2000) NAME,N,IDIM
- IF(KPRNT.NE.0) WRITE(*,2001) NAME,N,IDIM,K
- ELSE
- IF(KPRNT.EQ.0) WRITE(LGFILE,2000) NAME,N,IDIM
- IF(KPRNT.NE.0) WRITE(LGFILE,2001) NAME,N,IDIM,K
- ENDIF
- ENDIF
- IF(.NOT. RFLAG) CALL ABEND
- RETURN
-C
- 2000 FORMAT( 7X, 11HSUBROUTINE , A6, 14H ... PARAMETER,
- * 29H ERROR (N.LT.1 OR N.GT.IDIM).,
- * 6X, 3HN =, I4, 6X, 6HIDIM =, I4, 1H. )
- 2001 FORMAT( 7X, 11HSUBROUTINE , A6, 14H ... PARAMETER,
- * 39H ERROR (N.LT.1 OR N.GT.IDIM OR K.LT.1).,
- * 6X, 3HN =, I4, 6X, 6HIDIM =, I4, 6X, 3HK =, I4, 1H. )
- END
diff --git a/src/packlib/kernlib/kernnum/f010fort/reqinv.F b/src/packlib/kernlib/kernnum/f010fort/reqinv.F
deleted file mode 100644
index d04ced0..0000000
--- a/src/packlib/kernlib/kernnum/f010fort/reqinv.F
+++ /dev/null
@@ -1,153 +0,0 @@
-*
-* $Id: reqinv.F,v 1.1.1.1 1996/02/15 17:48:48 mclareni Exp $
-*
-* $Log: reqinv.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:48 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE REQINV(N,A,IDIM,R,IFAIL,K,B)
- REAL R(N),T1,T2,T3
- REAL A(IDIM,N),B(IDIM,K),DET,TEMP,S,
- $ B1,B2,C11,C12,C13,C21,C22,C23,C31,C32,C33
- CHARACTER*6 NAME
- DATA NAME/'REQINV'/,KPRNT/1/
-C
-C ******************************************************************
-C
-C REPLACES B BY THE SOLUTION X OF A*X=B, AND REPLACES A BY ITS IN-
-C VERSE.
-C
-C N ORDER OF THE SQUARE MATRIX IN ARRAY A.
-C
-C A (REAL) TWO-DIMENSIONAL ARRAY CONTAINING AN N BY N
-C MATRIX.
-C
-C IDIM FIRST DIMENSION PARAMETER OF ARRAYS A AND B.
-C
-C R (REAL) WORKING VECTOR OF LENGTH NOT LESS THAN N.
-C
-C IFAIL OUTPUT PARAMETER. IFAIL= 0 ... NORMAL EXIT.
-C IFAIL=-1 ... SINGULAR MATRIX.
-C
-C K NUMBER OF COLUMNS OF THE MATRIX IN ARRAY B.
-C
-C B (REAL) TWO-DIMENSIONAL ARRAY CONTAINING AN N BY K
-C MATRIX.
-C
-C CALLS ... RFACT, RFINV, F010PR, ABEND.
-C
-C ******************************************************************
-C
-C TEST FOR PARAMETER ERRORS.
-C
- IF((N.LT.1).OR.(N.GT.IDIM).OR.(K.LT.1)) GO TO 10
-C
-C TEST FOR N.LE.3.
-C
- IF(N.GT.3) GO TO 9
- IFAIL=0
- IF(N.LT.3) GO TO 5
-C
-C N=3 CASE.
-C
-C COMPUTE COFACTORS.
- C11=A(2,2)*A(3,3)-A(2,3)*A(3,2)
- C12=A(2,3)*A(3,1)-A(2,1)*A(3,3)
- C13=A(2,1)*A(3,2)-A(2,2)*A(3,1)
- C21=A(3,2)*A(1,3)-A(3,3)*A(1,2)
- C22=A(3,3)*A(1,1)-A(3,1)*A(1,3)
- C23=A(3,1)*A(1,2)-A(3,2)*A(1,1)
- C31=A(1,2)*A(2,3)-A(1,3)*A(2,2)
- C32=A(1,3)*A(2,1)-A(1,1)*A(2,3)
- C33=A(1,1)*A(2,2)-A(1,2)*A(2,1)
- T1=ABS(A(1,1))
- T2=ABS(A(2,1))
- T3=ABS(A(3,1))
-C
-C (SET TEMP=PIVOT AND DET=PIVOT*DET.)
- IF(T1.GE.T2) GO TO 1
- IF(T3.GE.T2) GO TO 2
-C (PIVOT IS A21)
- TEMP=A(2,1)
- DET=C13*C32-C12*C33
- GO TO 3
- 1 IF(T3.GE.T1) GO TO 2
-C (PIVOT IS A11)
- TEMP=A(1,1)
- DET=C22*C33-C23*C32
- GO TO 3
-C (PIVOT IS A31)
- 2 TEMP=A(3,1)
- DET=C23*C12-C22*C13
-C
-C SET ELEMENTS OF INVERSE IN A.
- 3 IF(DET.EQ.0.) GO TO 11
- S=TEMP/DET
- A(1,1)=S*C11
- A(1,2)=S*C21
- A(1,3)=S*C31
- A(2,1)=S*C12
- A(2,2)=S*C22
- A(2,3)=S*C32
- A(3,1)=S*C13
- A(3,2)=S*C23
- A(3,3)=S*C33
-C
-C REPLACE B BY AINV*B.
- DO 4 J=1,K
- B1=B(1,J)
- B2=B(2,J)
- B(1,J)=A(1,1)*B1+A(1,2)*B2+A(1,3)*B(3,J)
- B(2,J)=A(2,1)*B1+A(2,2)*B2+A(2,3)*B(3,J)
- B(3,J)=A(3,1)*B1+A(3,2)*B2+A(3,3)*B(3,J)
- 4 CONTINUE
- RETURN
-C
- 5 IF(N.LT.2) GO TO 7
-C
-C N=2 CASE BY CRAMERS RULE.
-C
- DET=A(1,1)*A(2,2)-A(1,2)*A(2,1)
- IF(DET.EQ.0.) GO TO 11
- S=1./DET
- C11 =S*A(2,2)
- A(1,2)=-S*A(1,2)
- A(2,1)=-S*A(2,1)
- A(2,2)=S*A(1,1)
- A(1,1)=C11
- DO 6 J=1,K
- B1=B(1,J)
- B(1,J)=C11*B1+A(1,2)*B(2,J)
- B(2,J)=A(2,1)*B1+A(2,2)*B(2,J)
- 6 CONTINUE
- RETURN
-C
-C N=1 CASE.
-C
- 7 IF(A(1,1).EQ.0.) GO TO 11
- A(1,1)=1./A(1,1)
- DO 8 J=1,K
- B(1,J)=A(1,1)*B(1,J)
- 8 CONTINUE
- RETURN
-C
-C N.GT.3 CASES. FACTORIZE MATRIX, INVERT AND SOLVE SYSTEM.
-C
- 9 CALL RFACT(N,A,IDIM,R,IFAIL,DET,JFAIL)
- IF(IFAIL.NE.0) RETURN
- CALL RFEQN(N,A,IDIM,R,K,B)
- CALL RFINV(N,A,IDIM,R)
- RETURN
-C
-C ERROR EXITS.
-C
- 10 IFAIL=+1
- CALL F010PR(NAME,N,IDIM,K,KPRNT)
- RETURN
-C
- 11 IFAIL=-1
- RETURN
-C
- END
diff --git a/src/packlib/kernlib/kernnum/f010fort/reqn.F b/src/packlib/kernlib/kernnum/f010fort/reqn.F
deleted file mode 100644
index b391ed2..0000000
--- a/src/packlib/kernlib/kernnum/f010fort/reqn.F
+++ /dev/null
@@ -1,134 +0,0 @@
-*
-* $Id: reqn.F,v 1.1.1.1 1996/02/15 17:48:48 mclareni Exp $
-*
-* $Log: reqn.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:48 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE REQN(N,A,IDIM,R,IFAIL,K,B)
- REAL R(N),T1,T2,T3
- REAL A(IDIM,N),B(IDIM,K),DET,S,TEMP,
- $ B1,Y1,Y2,L11,L21,L22,L31,L32,L33,U12,U13,U23
- CHARACTER*6 NAME
- DATA NAME/'REQN'/,KPRNT/1/
-C
-C ******************************************************************
-C
-C REPLACES B BY THE SOLUTION X OF A*X=B, AFTER WHICH A IS UNDEFINED.
-C
-C (PARAMETERS AS FOR REQINV.)
-C
-C CALLS ... RFACT, RFEQN, F010PR, ABEND.
-C
-C ******************************************************************
-C
-C TEST FOR PARAMETER ERRORS.
-C
- IF((N.LT.1).OR.(N.GT.IDIM).OR.(K.LT.1)) GO TO 11
-C
-C TEST FOR N.LE.3.
-C
- IF(N.GT.3) GO TO 10
- IFAIL=0
- IF(N.LT.3) GO TO 6
-C
-C N=3 CASE.
-C
-C FACTORIZE MATRIX A=L*U.
-C (FIRST PIVOT SEARCH)
- T1=ABS(A(1,1))
- T2=ABS(A(2,1))
- T3=ABS(A(3,1))
- IF(T1.GE.T2) GO TO 1
- IF(T3.GE.T2) GO TO 2
-C (PIVOT IS A21)
- M1=2
- M2=1
- M3=3
- GO TO 3
- 1 IF(T3.GE.T1) GO TO 2
-C (PIVOT IS A11)
- M1=1
- M2=2
- M3=3
- GO TO 3
-C (PIVOT IS A31)
- 2 M1=3
- M2=2
- M3=1
- 3 TEMP=A(M1,1)
- IF(TEMP.EQ.0.) GO TO 10
- L11=1./TEMP
- U12=L11*A(M1,2)
- U13=L11*A(M1,3)
- L22=A(M2,2)-A(M2,1)*U12
- L32=A(M3,2)-A(M3,1)*U12
-C (SECOND PIVOT SEARCH)
- IF(ABS(L22).GE.ABS(L32)) GO TO 4
- I=M2
- M2=M3
- M3=I
- TEMP=L22
- L22=L32
- L32=TEMP
- 4 L21=A(M2,1)
- L31=A(M3,1)
- IF(L22.EQ.0.) GO TO 10
- L22=1./L22
- U23=L22*(A(M2,3)-L21*U13)
- TEMP=A(M3,3)-L31*U13-L32*U23
- IF(TEMP.EQ.0.) GO TO 10
- L33=1./TEMP
-C
-C SOLVE L*Y=B AND U*X=Y.
- DO 5 J=1,K
- Y1=L11*B(M1,J)
- Y2=L22*(B(M2,J)-L21*Y1)
- B(3,J)=L33*(B(M3,J)-L31*Y1-L32*Y2)
- B(2,J)=Y2-U23*B(3,J)
- B(1,J)=Y1-U12*B(2,J)-U13*B(3,J)
- 5 CONTINUE
- RETURN
-C
- 6 IF(N.LT.2) GO TO 8
-C
-C N=2 CASE BY CRAMERS RULE.
-C
- DET=A(1,1)*A(2,2)-A(1,2)*A(2,1)
- IF(DET.EQ.0.) GO TO 12
- S=1./DET
- DO 7 J=1,K
- B1=B(1,J)
- B(1,J)=S*(A(2,2)*B1-A(1,2)*B(2,J))
- B(2,J)=S*(-A(2,1)*B1+A(1,1)*B(2,J))
- 7 CONTINUE
- RETURN
-C
-C N=1 CASE.
-C
- 8 IF(A(1,1).EQ.0.) GO TO 12
- S=1./A(1,1)
- DO 9 J=1,K
- B(1,J)=S*B(1,J)
- 9 CONTINUE
- RETURN
-C
-C N.GT.3 CASES. FACTORIZE MATRIX AND SOLVE SYSTEM.
-C
- 10 CALL RFACT(N,A,IDIM,R,IFAIL,DET,JFAIL)
- IF(IFAIL.NE.0) RETURN
- CALL RFEQN(N,A,IDIM,R,K,B)
- RETURN
-C
-C ERROR EXITS.
-C
- 11 IFAIL=+1
- CALL F010PR(NAME,N,IDIM,K,KPRNT)
- RETURN
-C
- 12 IFAIL=-1
- RETURN
-C
- END
diff --git a/src/packlib/kernlib/kernnum/f010fort/rinv.F b/src/packlib/kernlib/kernnum/f010fort/rinv.F
deleted file mode 100644
index 4e9ba85..0000000
--- a/src/packlib/kernlib/kernnum/f010fort/rinv.F
+++ /dev/null
@@ -1,119 +0,0 @@
-*
-* $Id: rinv.F,v 1.1.1.1 1996/02/15 17:48:48 mclareni Exp $
-*
-* $Log: rinv.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:48 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE RINV(N,A,IDIM,R,IFAIL)
- REAL R(N),T1,T2,T3
- REAL A(IDIM,N),DET,TEMP,S,
- $ C11,C12,C13,C21,C22,C23,C31,C32,C33
- CHARACTER*6 NAME
- DATA NAME/'RINV'/,KPRNT/0/
-C
-C ******************************************************************
-C
-C REPLACES A BY ITS INVERSE.
-C
-C (PARAMETERS AS FOR REQINV.)
-C
-C CALLS ... RFACT, RFINV, F010PR, ABEND.
-C
-C ******************************************************************
-C
-C TEST FOR PARAMETER ERRORS.
-C
- IF((N.LT.1).OR.(N.GT.IDIM)) GO TO 7
-C
-C TEST FOR N.LE.3.
-C
- IF(N.GT.3) GO TO 6
- IFAIL=0
- IF(N.LT.3) GO TO 4
-C
-C N=3 CASE.
-C
-C COMPUTE COFACTORS.
- C11=A(2,2)*A(3,3)-A(2,3)*A(3,2)
- C12=A(2,3)*A(3,1)-A(2,1)*A(3,3)
- C13=A(2,1)*A(3,2)-A(2,2)*A(3,1)
- C21=A(3,2)*A(1,3)-A(3,3)*A(1,2)
- C22=A(3,3)*A(1,1)-A(3,1)*A(1,3)
- C23=A(3,1)*A(1,2)-A(3,2)*A(1,1)
- C31=A(1,2)*A(2,3)-A(1,3)*A(2,2)
- C32=A(1,3)*A(2,1)-A(1,1)*A(2,3)
- C33=A(1,1)*A(2,2)-A(1,2)*A(2,1)
- T1=ABS(A(1,1))
- T2=ABS(A(2,1))
- T3=ABS(A(3,1))
-C
-C (SET TEMP=PIVOT AND DET=PIVOT*DET.)
- IF(T1.GE.T2) GO TO 1
- IF(T3.GE.T2) GO TO 2
-C (PIVOT IS A21)
- TEMP=A(2,1)
- DET=C13*C32-C12*C33
- GO TO 3
- 1 IF(T3.GE.T1) GO TO 2
-C (PIVOT IS A11)
- TEMP=A(1,1)
- DET=C22*C33-C23*C32
- GO TO 3
-C (PIVOT IS A31)
- 2 TEMP=A(3,1)
- DET=C23*C12-C22*C13
-C
-C SET ELEMENTS OF INVERSE IN A.
- 3 IF(DET.EQ.0.) GO TO 8
- S=TEMP/DET
- A(1,1)=S*C11
- A(1,2)=S*C21
- A(1,3)=S*C31
- A(2,1)=S*C12
- A(2,2)=S*C22
- A(2,3)=S*C32
- A(3,1)=S*C13
- A(3,2)=S*C23
- A(3,3)=S*C33
- RETURN
-C
- 4 IF(N.LT.2) GO TO 5
-C
-C N=2 CASE BY CRAMERS RULE.
-C
- DET=A(1,1)*A(2,2)-A(1,2)*A(2,1)
- IF(DET.EQ.0.) GO TO 8
- S=1./DET
- C11 =S*A(2,2)
- A(1,2)=-S*A(1,2)
- A(2,1)=-S*A(2,1)
- A(2,2)=S*A(1,1)
- A(1,1)=C11
- RETURN
-C
-C N=1 CASE.
-C
- 5 IF(A(1,1).EQ.0.) GO TO 8
- A(1,1)=1./A(1,1)
- RETURN
-C
-C N.GT.3 CASES. FACTORIZE MATRIX AND INVERT.
-C
- 6 CALL RFACT(N,A,IDIM,R,IFAIL,DET,JFAIL)
- IF(IFAIL.NE.0) RETURN
- CALL RFINV(N,A,IDIM,R)
- RETURN
-C
-C ERROR EXITS.
-C
- 7 IFAIL=+1
- CALL F010PR(NAME,N,IDIM,K,KPRNT)
- RETURN
-C
- 8 IFAIL=-1
- RETURN
-C
- END
diff --git a/src/packlib/kernlib/kernnum/f011fort/Imakefile b/src/packlib/kernlib/kernnum/f011fort/Imakefile
deleted file mode 100644
index 08c1351..0000000
--- a/src/packlib/kernlib/kernnum/f011fort/Imakefile
+++ /dev/null
@@ -1,16 +0,0 @@
-SRCS_F= cfact.F cfeqn.F cfinv.F \ @@\
- dfact.F dfeqn.F dfinv.F \ @@\
- rfact.F rfeqn.F rfinv.F \ @@\
- tmprnt.F
-
-#if defined(CERNLIB_DECS) && ! defined(CERNLIB_QMVAOS)
-FDEBUGFLAGS=NoOpFortranDebugFlags
-#endif
-
-#if defined(CERNLIB_MACOSX)
-FDEBUGFLAGS := -O0 $(FDEBUGFLAGS) -O0
-#endif
-
-FORTRANSAVEOPTION=FortranSaveFlags
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kernnum/f011fort/cfact.F b/src/packlib/kernlib/kernnum/f011fort/cfact.F
deleted file mode 100644
index ac56246..0000000
--- a/src/packlib/kernlib/kernnum/f011fort/cfact.F
+++ /dev/null
@@ -1,49 +0,0 @@
-*
-* $Id: cfact.F,v 1.1.1.1 1996/02/15 17:49:03 mclareni Exp $
-*
-* $Log: cfact.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:03 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE CFACT(N,A,IDIM,IR,IFAIL,DET,JFAIL)
- INTEGER IR(*), IPAIRF
- COMPLEX A(IDIM,*),DET, ZERO, ONE,X,Y,TF
- REAL G1, G2
- REAL PIVOTF, P, Q, SIZEF, T
- CHARACTER*6 HNAME
-#if !defined(CERNLIB_NUMCDBLE)
- COMPLEX S11, S12, DOTF
- DOTF(X,Y,S11) = X*Y + S11
-#endif
-#if defined(CERNLIB_NUMCDBLE)
- COMPLEX*16 S11, S12, DC, DOTF
- DC(X) = DCMPLX(DBLE(REAL(X)),DBLE(AIMAG(X)))
- DOTF(X,Y,S11) = DC(X)*DC(Y) + S11
-#endif
- IPAIRF(J,K) = J*2**12 + K
- PIVOTF(X) = MAX(ABS(REAL(X)),ABS(AIMAG(X)))
- SIZEF(X) = MAX(ABS(REAL(X)),ABS(AIMAG(X)))
-#if defined(CERNLIB_NUME2465)
- DATA G1, G2 / 1.E-1232, 1.E1232 /
-#endif
-#if defined(CERNLIB_NUME293)
- DATA G1, G2 / 1.E-146, 1.E146 /
-#endif
-#if defined(CERNLIB_NUME75)
- DATA G1, G2 / 1.E-37, 1.E37 /
-#endif
-#if defined(CERNLIB_NUME38)
- DATA G1, G2 / 1.E-19, 1.E19 /
-#endif
-#if defined(CERNLIB_NUME999)
- DATA ????? G1, G2 NOT DEFINED ?????
-#endif
- DATA HNAME / ' CFACT' /
- DATA ZERO, ONE / (0., 0.), (1., 0.) /
- DATA NORMAL, IMPOSS / 0, -1 /
- DATA JRANGE, JOVER, JUNDER / 0, +1, -1 /
-#include "fact.inc"
- RETURN
- END
diff --git a/src/packlib/kernlib/kernnum/f011fort/cfeqn.F b/src/packlib/kernlib/kernnum/f011fort/cfeqn.F
deleted file mode 100644
index 89162ef..0000000
--- a/src/packlib/kernlib/kernnum/f011fort/cfeqn.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: cfeqn.F,v 1.1.1.1 1996/02/15 17:49:03 mclareni Exp $
-*
-* $Log: cfeqn.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:03 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE CFEQN(N,A,IDIM,IR,K,B)
- INTEGER IR(*)
- COMPLEX A(IDIM,*),B(IDIM,*),X,Y,TE
- CHARACTER*6 HNAME
-#if !defined(CERNLIB_NUMCDBLE)
- COMPLEX S21, S22, DOTF
- DOTF(X,Y,S21) = X*Y + S21
-#endif
-#if defined(CERNLIB_NUMCDBLE)
- COMPLEX*16 S21, S22, DC, DOTF
- DC(X) = DCMPLX(DBLE(REAL(X)),DBLE(AIMAG(X)))
- DOTF(X,Y,S21) = DC(X)*DC(Y) + S21
-#endif
- DATA HNAME / ' CFEQN' /
-#include "feqn.inc"
- RETURN
- END
diff --git a/src/packlib/kernlib/kernnum/f011fort/cfinv.F b/src/packlib/kernlib/kernnum/f011fort/cfinv.F
deleted file mode 100644
index 8d69ac3..0000000
--- a/src/packlib/kernlib/kernnum/f011fort/cfinv.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: cfinv.F,v 1.1.1.1 1996/02/15 17:49:03 mclareni Exp $
-*
-* $Log: cfinv.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:03 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE CFINV(N,A,IDIM,IR)
- INTEGER IR(*)
- COMPLEX A(IDIM,*), X, Y, TI
- CHARACTER*6 HNAME
-#if !defined(CERNLIB_NUMCDBLE)
- COMPLEX ZERO, S31, S32, S33, S34, DOTF
- DOTF(X,Y,S31) = X*Y + S31
- DATA ZERO / (0.,0.) /
-#endif
-#if defined(CERNLIB_NUMCDBLE)
- COMPLEX*16 ZERO, S31, S32, S33, S34, DC, DOTF
- DC(X) = DCMPLX(DBLE(REAL(X)),DBLE(AIMAG(X)))
- DOTF(X,Y,S31) = DC(X)*DC(Y) + S31
- DATA ZERO / (0.D0,0.D0) /
-#endif
- DATA HNAME / ' CFINV' /
-#include "finv.inc"
- RETURN
- END
diff --git a/src/packlib/kernlib/kernnum/f011fort/dfact.F b/src/packlib/kernlib/kernnum/f011fort/dfact.F
deleted file mode 100644
index 1a71b16..0000000
--- a/src/packlib/kernlib/kernnum/f011fort/dfact.F
+++ /dev/null
@@ -1,42 +0,0 @@
-*
-* $Id: dfact.F,v 1.1.1.1 1996/02/15 17:49:03 mclareni Exp $
-*
-* $Log: dfact.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:03 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE DFACT(N,A,IDIM,IR,IFAIL,DET,JFAIL)
- INTEGER IR(*), IPAIRF
- DOUBLE PRECISION A(IDIM,*),DET, ZERO, ONE,X,Y,TF
- REAL G1, G2
- REAL PIVOTF, P, Q, SIZEF, T
- DOUBLE PRECISION S11, S12, DOTF
- CHARACTER*6 HNAME
- IPAIRF(J,K) = J*2**12 + K
- PIVOTF(X) = ABS(SNGL(X))
- SIZEF(X) = ABS(SNGL(X))
- DOTF(X,Y,S11) = X * Y + S11
-#if defined(CERNLIB_NUME2465)
- DATA G1, G2 / 1.E-1232, 1.E1232 /
-#endif
-#if defined(CERNLIB_NUME279)
- DATA G1, G2 / 1.E-139, 1.E139 /
-#endif
-#if defined(CERNLIB_NUME75)
- DATA G1, G2 / 1.E-37, 1.E37 /
-#endif
-#if defined(CERNLIB_NUME38)
- DATA G1, G2 / 1.E-19, 1.E19 /
-#endif
-#if defined(CERNLIB_NUME999)
- DATA ????? G1, G2 NOT DEFINED ?????
-#endif
- DATA HNAME / ' DFACT' /
- DATA ZERO, ONE / 0.D0, 1.D0 /
- DATA NORMAL, IMPOSS / 0, -1 /
- DATA JRANGE, JOVER, JUNDER / 0, +1, -1 /
-#include "fact.inc"
- RETURN
- END
diff --git a/src/packlib/kernlib/kernnum/f011fort/dfeqn.F b/src/packlib/kernlib/kernnum/f011fort/dfeqn.F
deleted file mode 100644
index 76aac59..0000000
--- a/src/packlib/kernlib/kernnum/f011fort/dfeqn.F
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: dfeqn.F,v 1.1.1.1 1996/02/15 17:49:03 mclareni Exp $
-*
-* $Log: dfeqn.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:03 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE DFEQN(N,A,IDIM,IR,K,B)
- INTEGER IR(*)
- DOUBLE PRECISION A(IDIM,*),B(IDIM,*),X,Y,TE
- DOUBLE PRECISION S21, S22, DOTF
- CHARACTER*6 HNAME
- DOTF(X,Y,S21) = X*Y + S21
- DATA HNAME / ' DFEQN' /
-#include "feqn.inc"
- RETURN
- END
diff --git a/src/packlib/kernlib/kernnum/f011fort/dfinv.F b/src/packlib/kernlib/kernnum/f011fort/dfinv.F
deleted file mode 100644
index 0f9d5b6..0000000
--- a/src/packlib/kernlib/kernnum/f011fort/dfinv.F
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: dfinv.F,v 1.1.1.1 1996/02/15 17:49:03 mclareni Exp $
-*
-* $Log: dfinv.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:03 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE DFINV(N,A,IDIM,IR)
- INTEGER IR(*)
- DOUBLE PRECISION A(IDIM,*),ZERO, X, Y, TI
- DOUBLE PRECISION S31, S32, S33, S34, DOTF
- CHARACTER*6 HNAME
- DATA HNAME / ' DFINV' /
- DOTF(X,Y,S31) = X*Y + S31
- DATA ZERO / 0.D0 /
-#include "finv.inc"
- RETURN
- END
diff --git a/src/packlib/kernlib/kernnum/f011fort/fact.inc b/src/packlib/kernlib/kernnum/f011fort/fact.inc
deleted file mode 100644
index 3b9d0f7..0000000
--- a/src/packlib/kernlib/kernnum/f011fort/fact.inc
+++ /dev/null
@@ -1,70 +0,0 @@
-*
-* $Id: fact.inc,v 1.1.1.1 1996/02/15 17:49:03 mclareni Exp $
-*
-* $Log: fact.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:49:03 mclareni
-* Kernlib
-*
-*
-*
-* fact.inc
-*
- IF(IDIM .GE. N .AND. N .GT. 0) GOTO 110
- CALL TMPRNT(HNAME,N,IDIM,0)
- RETURN
- 110 IFAIL = NORMAL
- JFAIL = JRANGE
- NXCH = 0
- DET = ONE
- DO 144 J = 1, N
- 120 K = J
- P = PIVOTF(A(J,J))
- IF(J .EQ. N) GOTO 122
- JP1 = J+1
- DO 121 I = JP1, N
- Q = PIVOTF(A(I,J))
- IF(Q .LE. P) GOTO 121
- K = I
- P = Q
- 121 CONTINUE
- IF(K .NE. J) GOTO 123
- 122 IF(P .GT. 0.) GOTO 130
- DET = ZERO
- IFAIL = IMPOSS
- JFAIL = JRANGE
- RETURN
- 123 DO 124 L = 1, N
- TF = A(J,L)
- A(J,L) = A(K,L)
- A(K,L) = TF
- 124 CONTINUE
- NXCH = NXCH + 1
- IR(NXCH) = IPAIRF(J,K)
- 130 DET = DET * A(J,J)
- A(J,J) = ONE / A(J,J)
- T = SIZEF(DET)
- IF(T .LT. G1) THEN
- DET = ZERO
- IF(JFAIL .EQ. JRANGE) JFAIL = JUNDER
- ELSEIF(T .GT. G2) THEN
- DET = ONE
- IF(JFAIL .EQ. JRANGE) JFAIL = JOVER
- ENDIF
- IF(J .EQ. N) GOTO 144
- JM1 = J-1
- JP1 = J+1
- DO 143 K = JP1, N
- S11 = -A(J,K)
- S12 = -A(K,J+1)
- IF(J .EQ. 1) GOTO 142
- DO 141 I = 1, JM1
- S11 = DOTF(A(I,K),A(J,I),S11)
- S12 = DOTF(A(I,J+1),A(K,I),S12)
- 141 CONTINUE
- 142 A(J,K) = -S11 * A(J,J)
- A(K,J+1) = -DOTF(A(J,J+1),A(K,J),S12)
- 143 CONTINUE
- 144 CONTINUE
- 150 IF(MOD(NXCH,2) .NE. 0) DET = -DET
- IF(JFAIL .NE. JRANGE) DET = ZERO
- IR(N) = NXCH
diff --git a/src/packlib/kernlib/kernnum/f011fort/feqn.inc b/src/packlib/kernlib/kernnum/f011fort/feqn.inc
deleted file mode 100644
index b931681..0000000
--- a/src/packlib/kernlib/kernnum/f011fort/feqn.inc
+++ /dev/null
@@ -1,51 +0,0 @@
-*
-* $Id: feqn.inc,v 1.1.1.1 1996/02/15 17:49:03 mclareni Exp $
-*
-* $Log: feqn.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:49:03 mclareni
-* Kernlib
-*
-*
-*
-* feqn.inc
-*
- IF(IDIM .GE. N .AND. N .GT. 0 .AND. K .GT. 0) GOTO 210
- CALL TMPRNT(HNAME,N,IDIM,K)
- RETURN
- 210 NXCH = IR(N)
- IF(NXCH .EQ. 0) GOTO 220
- DO 212 M = 1, NXCH
- IJ = IR(M)
- I = IJ / 4096
- J = MOD(IJ,4096)
- DO 211 L = 1, K
- TE = B(I,L)
- B(I,L) = B(J,L)
- B(J,L) = TE
- 211 CONTINUE
- 212 CONTINUE
- 220 DO 221 L = 1, K
- B(1,L) = A(1,1)*B(1,L)
- 221 CONTINUE
- IF(N .EQ. 1) GOTO 299
- DO 243 L = 1, K
- DO 232 I = 2, N
- IM1 = I-1
- S21 = - B(I,L)
- DO 231 J = 1, IM1
- S21 = DOTF(A(I,J),B(J,L),S21)
- 231 CONTINUE
- B(I,L) = - A(I,I)*S21
- 232 CONTINUE
- NM1 = N-1
- DO 242 I = 1, NM1
- NMI = N-I
- S22 = - B(NMI,L)
- DO 241 J = 1, I
- NMJP1 = N - J+1
- S22 = DOTF(A(NMI,NMJP1),B(NMJP1,L),S22)
- 241 CONTINUE
- B(NMI,L) = - S22
- 242 CONTINUE
- 243 CONTINUE
- 299 CONTINUE
diff --git a/src/packlib/kernlib/kernnum/f011fort/finv.inc b/src/packlib/kernlib/kernnum/f011fort/finv.inc
deleted file mode 100644
index dc9b705..0000000
--- a/src/packlib/kernlib/kernnum/f011fort/finv.inc
+++ /dev/null
@@ -1,64 +0,0 @@
-*
-* $Id: finv.inc,v 1.1.1.1 1996/02/15 17:49:03 mclareni Exp $
-*
-* $Log: finv.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:49:03 mclareni
-* Kernlib
-*
-*
-*
-* finv.inc
-*
- IF(IDIM .GE. N .AND. N .GT. 0) GOTO 310
- CALL TMPRNT(HNAME,N,IDIM,0)
- RETURN
- 310 IF(N .EQ. 1) RETURN
- A(2,1) = -A(2,2) * DOTF(A(1,1),A(2,1),ZERO)
- A(1,2) = -A(1,2)
- IF(N .EQ. 2) GOTO 330
- DO 314 I = 3, N
- IM2 = I-2
- DO 312 J = 1, IM2
- S31 = ZERO
- S32 = A(J,I)
- DO 311 K = J, IM2
- S31 = DOTF(A(K,J),A(I,K),S31)
- S32 = DOTF(A(J,K+1),A(K+1,I),S32)
- 311 CONTINUE
- A(I,J) = -A(I,I) * DOTF(A(I-1,J),A(I,I-1),S31)
- A(J,I) = -S32
- 312 CONTINUE
- A(I,I-1) = -A(I,I) * DOTF(A(I-1,I-1),A(I,I-1),ZERO)
- A(I-1,I) = -A(I-1,I)
- 314 CONTINUE
- 330 NM1 = N-1
- DO 335 I = 1, NM1
- NMI = N-I
- DO 332 J = 1, I
- S33 = A(I,J)
- DO 331 K = 1, NMI
- S33 = DOTF(A(I+K,J),A(I,I+K),S33)
- 331 CONTINUE
- A(I,J) = S33
- 332 CONTINUE
- DO 334 J = 1, NMI
- S34 = ZERO
- DO 333 K = J, NMI
- S34 = DOTF(A(I+K,I+J),A(I,I+K),S34)
- 333 CONTINUE
- A(I,I+J) = S34
- 334 CONTINUE
- 335 CONTINUE
- NXCH = IR(N)
- IF(NXCH .EQ. 0) RETURN
- DO 342 M = 1, NXCH
- K = NXCH - M+1
- IJ = IR(K)
- I = IJ / 4096
- J = MOD(IJ,4096)
- DO 341 K = 1, N
- TI = A(K,I)
- A(K,I) = A(K,J)
- A(K,J) = TI
- 341 CONTINUE
- 342 CONTINUE
diff --git a/src/packlib/kernlib/kernnum/f011fort/rfact.F b/src/packlib/kernlib/kernnum/f011fort/rfact.F
deleted file mode 100644
index bb5e908..0000000
--- a/src/packlib/kernlib/kernnum/f011fort/rfact.F
+++ /dev/null
@@ -1,48 +0,0 @@
-*
-* $Id: rfact.F,v 1.1.1.1 1996/02/15 17:49:03 mclareni Exp $
-*
-* $Log: rfact.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:03 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE RFACT(N,A,IDIM,IR,IFAIL,DET,JFAIL)
- INTEGER IR(*), IPAIRF
- REAL A(IDIM,*),DET, ZERO, ONE,X,Y,TF
- REAL G1, G2
- REAL PIVOTF, P, Q, SIZEF, T
- CHARACTER*6 HNAME
-#if !defined(CERNLIB_NUMRDBLE)
- REAL S11, S12, DOTF
- DOTF(X,Y,S11) = X*Y + S11
-#endif
-#if defined(CERNLIB_NUMRDBLE)
- DOUBLE PRECISION S11, S12, DOTF
- DOTF(X,Y,S11) = DBLE(X)*DBLE(Y) + S11
-#endif
- IPAIRF(J,K) = J*2**12 + K
- PIVOTF(X) = ABS(X)
- SIZEF(X) = ABS(X)
-#if defined(CERNLIB_NUME2465)
- DATA G1, G2 / 1.E-1232, 1.E1232 /
-#endif
-#if defined(CERNLIB_NUME293)
- DATA G1, G2 / 1.E-146, 1.E146 /
-#endif
-#if defined(CERNLIB_NUME75)
- DATA G1, G2 / 1.E-37, 1.E37 /
-#endif
-#if defined(CERNLIB_NUME38)
- DATA G1, G2 / 1.E-19, 1.E19 /
-#endif
-#if defined(CERNLIB_NUME999)
- DATA ????? G1, G2 NOT DEFINED ?????
-#endif
- DATA HNAME / ' RFACT' /
- DATA ZERO, ONE / 0., 1. /
- DATA NORMAL, IMPOSS / 0, -1 /
- DATA JRANGE, JOVER, JUNDER / 0, +1, -1 /
-#include "fact.inc"
- RETURN
- END
diff --git a/src/packlib/kernlib/kernnum/f011fort/rfeqn.F b/src/packlib/kernlib/kernnum/f011fort/rfeqn.F
deleted file mode 100644
index e06b39f..0000000
--- a/src/packlib/kernlib/kernnum/f011fort/rfeqn.F
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: rfeqn.F,v 1.1.1.1 1996/02/15 17:49:03 mclareni Exp $
-*
-* $Log: rfeqn.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:03 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE RFEQN(N,A,IDIM,IR,K,B)
- INTEGER IR(*)
- REAL A(IDIM,*),B(IDIM,*),X,Y,TE
- CHARACTER*6 HNAME
-#if !defined(CERNLIB_NUMRDBLE)
- REAL S21, S22, DOTF
- DOTF(X,Y,S21) = X*Y + S21
-#endif
-#if defined(CERNLIB_NUMRDBLE)
- DOUBLE PRECISION S21, S22, DOTF
- DOTF(X,Y,S21) = DBLE(X)*DBLE(Y) + S21
-#endif
- DATA HNAME / ' RFEQN' /
-#include "feqn.inc"
- RETURN
- END
diff --git a/src/packlib/kernlib/kernnum/f011fort/rfinv.F b/src/packlib/kernlib/kernnum/f011fort/rfinv.F
deleted file mode 100644
index bd2f6d6..0000000
--- a/src/packlib/kernlib/kernnum/f011fort/rfinv.F
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: rfinv.F,v 1.1.1.1 1996/02/15 17:49:03 mclareni Exp $
-*
-* $Log: rfinv.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:03 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE RFINV(N,A,IDIM,IR)
- INTEGER IR(*)
- REAL A(IDIM,*), X, Y, TI
- CHARACTER*6 HNAME
-#if !defined(CERNLIB_NUMRDBLE)
- REAL ZERO, S31, S32, S33, S34, DOTF
- DOTF(X,Y,S31) = X*Y + S31
- DATA ZERO / 0. /
-#endif
-#if defined(CERNLIB_NUMRDBLE)
- DOUBLE PRECISION ZERO, S31, S32, S33, S34, DOTF
- DOTF(X,Y,S31) = DBLE(X)*DBLE(Y) + S31
- DATA ZERO / 0.D0 /
-#endif
- DATA HNAME / ' RFINV' /
-#include "finv.inc"
- RETURN
- END
diff --git a/src/packlib/kernlib/kernnum/f011fort/tmprnt.F b/src/packlib/kernlib/kernnum/f011fort/tmprnt.F
deleted file mode 100644
index 8184b46..0000000
--- a/src/packlib/kernlib/kernnum/f011fort/tmprnt.F
+++ /dev/null
@@ -1,43 +0,0 @@
-*
-* $Id: tmprnt.F,v 1.1.1.1 1996/02/15 17:49:04 mclareni Exp $
-*
-* $Log: tmprnt.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:04 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE TMPRNT(NAME,N,IDIM,K)
- CHARACTER*6 NAME
- LOGICAL MFLAG, RFLAG
- IF(NAME(2:2) .EQ. 'S') THEN
- CALL KERMTR('F012.1',LGFILE,MFLAG,RFLAG)
- ELSE
- CALL KERMTR('F011.1',LGFILE,MFLAG,RFLAG)
- ENDIF
- IF(NAME(3:6) .EQ. 'FEQN') ASSIGN 1002 TO IFMT
- IF(NAME(3:6) .NE. 'FEQN') ASSIGN 1001 TO IFMT
- IF(MFLAG) THEN
- IF(LGFILE .EQ. 0) THEN
- IF(NAME(3:6) .EQ. 'FEQN') THEN
- WRITE(*,IFMT) NAME, N, IDIM, K
- ELSE
- WRITE(*,IFMT) NAME, N, IDIM
- ENDIF
- ELSE
- IF(NAME(3:6) .EQ. 'FEQN') THEN
- WRITE(LGFILE,IFMT) NAME, N, IDIM, K
- ELSE
- WRITE(LGFILE,IFMT) NAME, N, IDIM
- ENDIF
- ENDIF
- ENDIF
- IF(.NOT. RFLAG) CALL ABEND
- RETURN
-1001 FORMAT(7X, 31H PARAMETER ERROR IN SUBROUTINE , A6,
- + 27H ... (N.LT.1 OR IDIM.LT.N).,
- + 5X, 3HN =, I4, 5X, 6HIDIM =, I4, 1H. )
-1002 FORMAT(7X, 31H PARAMETER ERROR IN SUBROUTINE , A6,
- + 37H ... (N.LT.1 OR IDIM.LT.N OR K.LT.1).,
- + 5X, 3HN =, I4, 5X, 6HIDIM =, I4, 5X, 3HK =, I4,1H.)
- END
diff --git a/src/packlib/kernlib/kernnum/f012fort/Imakefile b/src/packlib/kernlib/kernnum/f012fort/Imakefile
deleted file mode 100644
index 789ebec..0000000
--- a/src/packlib/kernlib/kernnum/f012fort/Imakefile
+++ /dev/null
@@ -1,11 +0,0 @@
-SRCS_F= dseqn.F dsfact.F dsfeqn.F dsfinv.F dsinv.F \ @@\
- rseqn.F rsfact.F rsfeqn.F rsfinv.F rsinv.F
-
-#if defined(CERNLIB_DECS) && ! defined(CERNLIB_QMVAOS)
-FDEBUGFLAGS=NoOpFortranDebugFlags
-#endif
-
-FORTRANSAVEOPTION=FortranSaveFlags
-
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kernnum/f012fort/dseqn.F b/src/packlib/kernlib/kernnum/f012fort/dseqn.F
deleted file mode 100644
index e4eccdc..0000000
--- a/src/packlib/kernlib/kernnum/f012fort/dseqn.F
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: dseqn.F,v 1.2 1999/09/08 08:05:00 mclareni Exp $
-*
-* $Log: dseqn.F,v $
-* Revision 1.2 1999/09/08 08:05:00 mclareni
-* A problem was reported in DSINV which failed on very small numbers, probably
-* due to converting to single before a test. The conversion has been removed here
-* and also in DSFACT. This resulted in mods to sfact.inc and sfactd.inc which
-* meant that some other routines had to be tidied also.
-*
-* Revision 1.1.1.1 1996/02/15 17:49:05 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE DSEQN(N,A,IDIM,IFAIL,K,B)
- DOUBLE PRECISION A(IDIM,*), B(IDIM,*), ONE, X, Y
- DOUBLE PRECISION S1, S21, S22, DOTF
- CHARACTER*6 HNAME
- DATA HNAME / 'DSEQN ' /
- DOTF(X,Y,S1) = X * Y + S1
- DATA ZERO, ONE / 0.D0, 1.D0 /
- IF(IDIM .LT. N .OR. N .LE. 0 .OR. K .LT. 0) GOTO 900
-#include "sfact.inc"
-#include "sfeqn.inc"
- RETURN
- 900 CALL TMPRNT(HNAME,N,IDIM,K)
- RETURN
- END
diff --git a/src/packlib/kernlib/kernnum/f012fort/dsfact.F b/src/packlib/kernlib/kernnum/f012fort/dsfact.F
deleted file mode 100644
index 19a4a4c..0000000
--- a/src/packlib/kernlib/kernnum/f012fort/dsfact.F
+++ /dev/null
@@ -1,46 +0,0 @@
-*
-* $Id: dsfact.F,v 1.2 1999/09/08 08:05:07 mclareni Exp $
-*
-* $Log: dsfact.F,v $
-* Revision 1.2 1999/09/08 08:05:07 mclareni
-* A problem was reported in DSINV which failed on very small numbers, probably
-* due to converting to single before a test. The conversion has been removed here
-* and also in DSFACT. This resulted in mods to sfact.inc and sfactd.inc which
-* meant that some other routines had to be tidied also.
-*
-* Revision 1.1.1.1 1996/02/15 17:49:04 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE DSFACT(N,A,IDIM,IFAIL,DET,JFAIL)
- DOUBLE PRECISION A(IDIM,*),DET, ZERO, ONE,X,Y
- REAL G1, G2
- REAL SIZEF, T
- DOUBLE PRECISION S1, DOTF
- CHARACTER*6 HNAME
- SIZEF(X) = ABS(SNGL(X))
- DOTF(X,Y,S1) = X * Y + S1
-#if defined(CERNLIB_NUME2465)
- DATA G1, G2 / 1.E-1232, 1.E1232 /
-#endif
-#if defined(CERNLIB_NUME279)
- DATA G1, G2 / 1.E-139, 1.E139 /
-#endif
-#if defined(CERNLIB_NUME75)
- DATA G1, G2 / 1.E-37, 1.E37 /
-#endif
-#if defined(CERNLIB_NUME38)
- DATA G1, G2 / 1.E-19, 1.E19 /
-#endif
-#if defined(CERNLIB_NUME999)
- DATA ????? G1, G2 NOT DEFINED ?????
-#endif
- DATA HNAME / 'DSFACT' /
- DATA ZERO, ONE / 0.D0, 1.D0 /
- IF(IDIM .LT. N .OR. N .LE. 0) GOTO 900
-#include "sfactd.inc"
- RETURN
- 900 CALL TMPRNT(HNAME,N,IDIM,0)
- RETURN
- END
diff --git a/src/packlib/kernlib/kernnum/f012fort/dsfeqn.F b/src/packlib/kernlib/kernnum/f012fort/dsfeqn.F
deleted file mode 100644
index d03f904..0000000
--- a/src/packlib/kernlib/kernnum/f012fort/dsfeqn.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: dsfeqn.F,v 1.1.1.1 1996/02/15 17:49:04 mclareni Exp $
-*
-* $Log: dsfeqn.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:04 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE DSFEQN(N,A,IDIM,K,B)
- DOUBLE PRECISION A(IDIM,*),B(IDIM,*),X,Y
- DOUBLE PRECISION S21, S22, DOTF
- CHARACTER*6 HNAME
- DATA HNAME / 'DSFEQN' /
- DOTF(X,Y,S21) = X*Y + S21
- IF(IDIM .LT. N .OR. N .LE. 0 .OR. K .LE. 0) GOTO 900
-#include "sfeqn.inc"
- RETURN
- 900 CALL TMPRNT(HNAME,N,IDIM,K)
- RETURN
- END
diff --git a/src/packlib/kernlib/kernnum/f012fort/dsfinv.F b/src/packlib/kernlib/kernnum/f012fort/dsfinv.F
deleted file mode 100644
index 2d44c40..0000000
--- a/src/packlib/kernlib/kernnum/f012fort/dsfinv.F
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: dsfinv.F,v 1.1.1.1 1996/02/15 17:49:05 mclareni Exp $
-*
-* $Log: dsfinv.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:05 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE DSFINV(N,A,IDIM)
- DOUBLE PRECISION A(IDIM,*),ZERO, X, Y
- DOUBLE PRECISION S31, S32, S33, DOTF
- CHARACTER*6 HNAME
- DOTF(X,Y,S31) = X*Y + S31
- DATA HNAME / 'DSFINV' /
- DATA ZERO / 0.D0 /
- IF(IDIM .LT. N .OR. N .LE. 0) GOTO 900
-#include "sfinv.inc"
- RETURN
- 900 CALL TMPRNT(HNAME,N,IDIM,0)
- RETURN
- END
diff --git a/src/packlib/kernlib/kernnum/f012fort/dsinv.F b/src/packlib/kernlib/kernnum/f012fort/dsinv.F
deleted file mode 100644
index 6eef140..0000000
--- a/src/packlib/kernlib/kernnum/f012fort/dsinv.F
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: dsinv.F,v 1.2 1999/09/08 08:05:11 mclareni Exp $
-*
-* $Log: dsinv.F,v $
-* Revision 1.2 1999/09/08 08:05:11 mclareni
-* A problem was reported in DSINV which failed on very small numbers, probably
-* due to converting to single before a test. The conversion has been removed here
-* and also in DSFACT. This resulted in mods to sfact.inc and sfactd.inc which
-* meant that some other routines had to be tidied also.
-*
-* Revision 1.1.1.1 1996/02/15 17:49:05 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE DSINV(N,A,IDIM,IFAIL)
- DOUBLE PRECISION A(IDIM,*), ZERO, ONE, X, Y
- CHARACTER*6 HNAME
- DOUBLE PRECISION S1, S31, S32, S33, DOTF
- DOTF(X,Y,S1) = X * Y + S1
- DATA HNAME / 'DSINV ' /
- DATA ZERO, ONE / 0.D0, 1.D0 /
- IF(IDIM .LT. N .OR. N .LE. 0) GOTO 900
-#include "sfact.inc"
-#include "sfinv.inc"
- RETURN
- 900 CALL TMPRNT(HNAME,N,IDIM,0)
- RETURN
- END
diff --git a/src/packlib/kernlib/kernnum/f012fort/rseqn.F b/src/packlib/kernlib/kernnum/f012fort/rseqn.F
deleted file mode 100644
index 49905d6..0000000
--- a/src/packlib/kernlib/kernnum/f012fort/rseqn.F
+++ /dev/null
@@ -1,35 +0,0 @@
-*
-* $Id: rseqn.F,v 1.2 1999/09/08 08:05:14 mclareni Exp $
-*
-* $Log: rseqn.F,v $
-* Revision 1.2 1999/09/08 08:05:14 mclareni
-* A problem was reported in DSINV which failed on very small numbers, probably
-* due to converting to single before a test. The conversion has been removed here
-* and also in DSFACT. This resulted in mods to sfact.inc and sfactd.inc which
-* meant that some other routines had to be tidied also.
-*
-* Revision 1.1.1.1 1996/02/15 17:49:05 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE RSEQN(N,A,IDIM,IFAIL,K,B)
- REAL A(IDIM,*), B(IDIM,*), ONE, X, Y
- CHARACTER*6 HNAME
-#if !defined(CERNLIB_NUMRDBLE)
- REAL S1, S21, S22, DOTF
- DOTF(X,Y,S1) = X*Y + S1
-#endif
-#if defined(CERNLIB_NUMRDBLE)
- DOUBLE PRECISION S1, S21, S22, DOTF
- DOTF(X,Y,S1) = DBLE(X)*DBLE(Y) + S1
-#endif
- DATA HNAME / 'RSEQN ' /
- DATA ZERO, ONE / 0., 1. /
- IF(IDIM .LT. N .OR. N .LE. 0 .OR. K .LT. 0) GOTO 900
-#include "sfact.inc"
-#include "sfeqn.inc"
- RETURN
- 900 CALL TMPRNT(HNAME,N,IDIM,K)
- RETURN
- END
diff --git a/src/packlib/kernlib/kernnum/f012fort/rsfact.F b/src/packlib/kernlib/kernnum/f012fort/rsfact.F
deleted file mode 100644
index 4e40f0a..0000000
--- a/src/packlib/kernlib/kernnum/f012fort/rsfact.F
+++ /dev/null
@@ -1,52 +0,0 @@
-*
-* $Id: rsfact.F,v 1.2 1999/09/08 08:05:15 mclareni Exp $
-*
-* $Log: rsfact.F,v $
-* Revision 1.2 1999/09/08 08:05:15 mclareni
-* A problem was reported in DSINV which failed on very small numbers, probably
-* due to converting to single before a test. The conversion has been removed here
-* and also in DSFACT. This resulted in mods to sfact.inc and sfactd.inc which
-* meant that some other routines had to be tidied also.
-*
-* Revision 1.1.1.1 1996/02/15 17:49:04 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE RSFACT(N,A,IDIM,IFAIL,DET,JFAIL)
- REAL A(IDIM,*),DET, ZERO, ONE,X,Y
- REAL G1, G2
- REAL SIZEF, T
- CHARACTER*6 HNAME
-#if !defined(CERNLIB_NUMRDBLE)
- REAL S1, DOTF
- DOTF(X,Y,S1) = X*Y + S1
-#endif
-#if defined(CERNLIB_NUMRDBLE)
- DOUBLE PRECISION S1, DOTF
- DOTF(X,Y,S1) = DBLE(X)*DBLE(Y) + S1
-#endif
- SIZEF(X) = ABS(X)
-#if defined(CERNLIB_NUME2465)
- DATA G1, G2 / 1.E-1232, 1.E1232 /
-#endif
-#if defined(CERNLIB_NUME293)
- DATA G1, G2 / 1.E-146, 1.E146 /
-#endif
-#if defined(CERNLIB_NUME75)
- DATA G1, G2 / 1.E-37, 1.E37 /
-#endif
-#if defined(CERNLIB_NUME38)
- DATA G1, G2 / 1.E-19, 1.E19 /
-#endif
-#if defined(CERNLIB_NUME999)
- DATA ????? G1, G2 NOT DEFINED ?????
-#endif
- DATA HNAME / 'RSFACT' /
- DATA ZERO, ONE / 0., 1. /
- IF(IDIM .LT. N .OR. N .LE. 0) GOTO 900
-#include "sfactd.inc"
- RETURN
- 900 CALL TMPRNT(HNAME,N,IDIM,0)
- RETURN
- END
diff --git a/src/packlib/kernlib/kernnum/f012fort/rsfeqn.F b/src/packlib/kernlib/kernnum/f012fort/rsfeqn.F
deleted file mode 100644
index 8a2916c..0000000
--- a/src/packlib/kernlib/kernnum/f012fort/rsfeqn.F
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: rsfeqn.F,v 1.1.1.1 1996/02/15 17:49:04 mclareni Exp $
-*
-* $Log: rsfeqn.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:04 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE RSFEQN(N,A,IDIM,K,B)
- REAL A(IDIM,*),B(IDIM,*),X,Y
- CHARACTER*6 HNAME
-#if !defined(CERNLIB_NUMRDBLE)
- REAL S21, S22, DOTF
- DOTF(X,Y,S21) = X*Y + S21
-#endif
-#if defined(CERNLIB_NUMRDBLE)
- DOUBLE PRECISION S21, S22, DOTF
- DOTF(X,Y,S21) = DBLE(X)*DBLE(Y) + S21
-#endif
- DATA HNAME / 'RSFEQN' /
- IF(IDIM .LT. N .OR. N .LE. 0 .OR. K .LE. 0) GOTO 900
-#include "sfeqn.inc"
- RETURN
- 900 CALL TMPRNT(HNAME,N,IDIM,K)
- RETURN
- END
diff --git a/src/packlib/kernlib/kernnum/f012fort/rsfinv.F b/src/packlib/kernlib/kernnum/f012fort/rsfinv.F
deleted file mode 100644
index 1d66b55..0000000
--- a/src/packlib/kernlib/kernnum/f012fort/rsfinv.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: rsfinv.F,v 1.1.1.1 1996/02/15 17:49:05 mclareni Exp $
-*
-* $Log: rsfinv.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:05 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE RSFINV(N,A,IDIM)
- REAL A(IDIM,*),ZERO, X, Y
- CHARACTER*6 HNAME
-#if !defined(CERNLIB_NUMRDBLE)
- REAL S31, S32, S33, DOTF
- DOTF(X,Y,S31) = X*Y + S31
-#endif
-#if defined(CERNLIB_NUMRDBLE)
- DOUBLE PRECISION S31, S32, S33, DOTF
- DOTF(X,Y,S31) = DBLE(X)*DBLE(Y) + S31
-#endif
- DATA HNAME / 'RSFINV' /
- DATA ZERO / 0. /
- IF(IDIM .LT. N .OR. N .LE. 0) GOTO 900
-#include "sfinv.inc"
- RETURN
- 900 CALL TMPRNT(HNAME,N,IDIM,0)
- RETURN
- END
diff --git a/src/packlib/kernlib/kernnum/f012fort/rsinv.F b/src/packlib/kernlib/kernnum/f012fort/rsinv.F
deleted file mode 100644
index 163397b..0000000
--- a/src/packlib/kernlib/kernnum/f012fort/rsinv.F
+++ /dev/null
@@ -1,35 +0,0 @@
-*
-* $Id: rsinv.F,v 1.2 1999/09/08 08:05:18 mclareni Exp $
-*
-* $Log: rsinv.F,v $
-* Revision 1.2 1999/09/08 08:05:18 mclareni
-* A problem was reported in DSINV which failed on very small numbers, probably
-* due to converting to single before a test. The conversion has been removed here
-* and also in DSFACT. This resulted in mods to sfact.inc and sfactd.inc which
-* meant that some other routines had to be tidied also.
-*
-* Revision 1.1.1.1 1996/02/15 17:49:05 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE RSINV(N,A,IDIM,IFAIL)
- REAL A(IDIM,*), ZERO, ONE, X, Y
- CHARACTER*6 HNAME
-#if !defined(CERNLIB_NUMRDBLE)
- REAL S1, S31, S32, S33, DOTF
- DOTF(X,Y,S1) = X*Y + S1
-#endif
-#if defined(CERNLIB_NUMRDBLE)
- DOUBLE PRECISION S1, S31, S32, S33, DOTF
- DOTF(X,Y,S1) = DBLE(X)*DBLE(Y) + S1
-#endif
- DATA HNAME / 'RSINV ' /
- DATA ZERO, ONE / 0., 1. /
- IF(IDIM .LT. N .OR. N .LE. 0) GOTO 900
-#include "sfact.inc"
-#include "sfinv.inc"
- RETURN
- 900 CALL TMPRNT(HNAME,N,IDIM,0)
- RETURN
- END
diff --git a/src/packlib/kernlib/kernnum/f012fort/sfact.inc b/src/packlib/kernlib/kernnum/f012fort/sfact.inc
deleted file mode 100644
index aaaf28b..0000000
--- a/src/packlib/kernlib/kernnum/f012fort/sfact.inc
+++ /dev/null
@@ -1,35 +0,0 @@
-*
-* $Id: sfact.inc,v 1.2 1999/09/08 08:05:21 mclareni Exp $
-*
-* $Log: sfact.inc,v $
-* Revision 1.2 1999/09/08 08:05:21 mclareni
-* A problem was reported in DSINV which failed on very small numbers, probably
-* due to converting to single before a test. The conversion has been removed here
-* and also in DSFACT. This resulted in mods to sfact.inc and sfactd.inc which
-* meant that some other routines had to be tidied also.
-*
-* Revision 1.1.1.1 1996/02/15 17:49:04 mclareni
-* Kernlib
-*
-*
-*
-* sfact.inc
-*
- IFAIL = 0
- DO 144 J = 1, N
- IF((A(J,J)) .LE. ZERO) GOTO 150
- A(J,J) = ONE / A(J,J)
- IF(J .EQ. N) GOTO 199
- 140 JP1 = J+1
- DO 143 L = JP1, N
- A(J,L) = A(J,J)*A(L,J)
- S1 = -A(L,J+1)
- DO 141 I = 1, J
- S1 = DOTF(A(L,I),A(I,J+1),S1)
- 141 CONTINUE
- A(L,J+1) = -S1
- 143 CONTINUE
- 144 CONTINUE
- 150 IFAIL = -1
- RETURN
- 199 CONTINUE
diff --git a/src/packlib/kernlib/kernnum/f012fort/sfactd.inc b/src/packlib/kernlib/kernnum/f012fort/sfactd.inc
deleted file mode 100644
index c6a6fcf..0000000
--- a/src/packlib/kernlib/kernnum/f012fort/sfactd.inc
+++ /dev/null
@@ -1,48 +0,0 @@
-*
-* $Id: sfactd.inc,v 1.2 1999/09/08 08:05:24 mclareni Exp $
-*
-* $Log: sfactd.inc,v $
-* Revision 1.2 1999/09/08 08:05:24 mclareni
-* A problem was reported in DSINV which failed on very small numbers, probably
-* due to converting to single before a test. The conversion has been removed here
-* and also in DSFACT. This resulted in mods to sfact.inc and sfactd.inc which
-* meant that some other routines had to be tidied also.
-*
-* Revision 1.1.1.1 1996/02/15 17:49:04 mclareni
-* Kernlib
-*
-*
-*
-* sfactd.inc
-*
- IFAIL = 0
- JFAIL = 0
- DET = ONE
- DO 144 J = 1, N
- IF((A(J,J)) .LE. ZERO) GOTO 150
- DET = DET * A(J,J)
- A(J,J) = ONE / A(J,J)
- T = SIZEF(DET)
- IF(T .LT. G1) THEN
- DET = ONE
- IF(JFAIL .EQ. 0) JFAIL = -1
- ELSEIF(T .GT. G2) THEN
- DET = ONE
- IF(JFAIL .EQ. 0) JFAIL = +1
- ENDIF
- IF(J .EQ. N) GOTO 199
- JP1 = J+1
- DO 143 L = JP1, N
- A(J,L) = A(J,J)*A(L,J)
- S1 = -A(L,J+1)
- DO 141 I = 1, J
- S1 = DOTF(A(L,I),A(I,J+1),S1)
- 141 CONTINUE
- A(L,J+1) = -S1
- 143 CONTINUE
- 144 CONTINUE
- 150 IFAIL = -1
- JFAIL = -2
- DET = ZERO
- RETURN
- 199 IF(JFAIL .NE. 0) DET = ZERO
diff --git a/src/packlib/kernlib/kernnum/f012fort/sfeqn.inc b/src/packlib/kernlib/kernnum/f012fort/sfeqn.inc
deleted file mode 100644
index 27f27b8..0000000
--- a/src/packlib/kernlib/kernnum/f012fort/sfeqn.inc
+++ /dev/null
@@ -1,37 +0,0 @@
-*
-* $Id: sfeqn.inc,v 1.1.1.1 1996/02/15 17:49:04 mclareni Exp $
-*
-* $Log: sfeqn.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:49:04 mclareni
-* Kernlib
-*
-*
-*
-* sfeqn.inc
-*
- IF(K .LE. 0) GOTO 299
- DO 220 L = 1, K
- B(1,L) = A(1,1)*B(1,L)
- 220 CONTINUE
- IF(N .EQ. 1) GOTO 299
- DO 243 L = 1, K
- DO 232 I = 2, N
- IM1 = I-1
- S21 = - B(I,L)
- DO 231 J = 1, IM1
- S21 = DOTF(A(I,J),B(J,L),S21)
- 231 CONTINUE
- B(I,L) = - A(I,I)*S21
- 232 CONTINUE
- NM1 = N-1
- DO 242 I = 1, NM1
- NMI = N-I
- S22 = - B(NMI,L)
- DO 241 J = 1, I
- NMJP1 = N - J+1
- S22 = DOTF(A(NMI,NMJP1),B(NMJP1,L),S22)
- 241 CONTINUE
- B(NMI,L) = - S22
- 242 CONTINUE
- 243 CONTINUE
- 299 CONTINUE
diff --git a/src/packlib/kernlib/kernnum/f012fort/sfinv.inc b/src/packlib/kernlib/kernnum/f012fort/sfinv.inc
deleted file mode 100644
index 8323cf8..0000000
--- a/src/packlib/kernlib/kernnum/f012fort/sfinv.inc
+++ /dev/null
@@ -1,48 +0,0 @@
-*
-* $Id: sfinv.inc,v 1.1.1.1 1996/02/15 17:49:04 mclareni Exp $
-*
-* $Log: sfinv.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:49:04 mclareni
-* Kernlib
-*
-*
-*
-* sfinv.inc
-*
- IF(N .EQ. 1) GOTO 399
- A(1,2) = -A(1,2)
- A(2,1) = A(1,2)*A(2,2)
- IF(N .EQ. 2) GOTO 320
- DO 314 J = 3, N
- JM2 = J - 2
- DO 312 K = 1, JM2
- S31 = A(K,J)
- DO 311 I = K, JM2
- S31 = DOTF(A(K,I+1),A(I+1,J),S31)
- 311 CONTINUE
- A(K,J) = -S31
- A(J,K) = -S31*A(J,J)
- 312 CONTINUE
- A(J-1,J) = -A(J-1,J)
- A(J,J-1) = A(J-1,J)*A(J,J)
- 314 CONTINUE
- 320 J = 1
- 323 S33 = A(J,J)
- IF(J .EQ. N) GOTO 325
- JP1 = J + 1
- DO 324 I = JP1, N
- S33 = DOTF(A(J,I),A(I,J),S33)
- 324 CONTINUE
- 325 A(J,J) = S33
- JM1 = J
- J = JP1
- DO 328 K = 1, JM1
- S32 = ZERO
- DO 327 I = J, N
- S32 = DOTF(A(K,I),A(I,J),S32)
- 327 CONTINUE
- A(K,J) = S32
- A(J,K) = S32
- 328 CONTINUE
- IF(J .LT. N) GOTO 323
- 399 CONTINUE
diff --git a/src/packlib/kernlib/kernnum/f406fort/Imakefile b/src/packlib/kernlib/kernnum/f406fort/Imakefile
deleted file mode 100644
index 4f12ea3..0000000
--- a/src/packlib/kernlib/kernnum/f406fort/Imakefile
+++ /dev/null
@@ -1,9 +0,0 @@
-SRCS_F= dbeqn.F rbeqn.F
-
-#if defined(CERNLIB_DECS) && ! defined(CERNLIB_QMVAOS)
-FDEBUGFLAGS=NoOpFortranDebugFlags
-#endif
-
-FORTRANSAVEOPTION=FortranSaveFlags
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kernnum/f406fort/dbeqn.F b/src/packlib/kernlib/kernnum/f406fort/dbeqn.F
deleted file mode 100644
index 51c93b0..0000000
--- a/src/packlib/kernlib/kernnum/f406fort/dbeqn.F
+++ /dev/null
@@ -1,165 +0,0 @@
-*
-* $Id: dbeqn.F,v 1.1.1.1 1996/02/15 17:48:49 mclareni Exp $
-*
-* $Log: dbeqn.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:49 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE DBEQN(NN,MM,ABAND,IDIM,IFAIL,KK,B)
- LOGICAL MFLAG,RFLAG
- DIMENSION ABAND(IDIM,NN),B(IDIM,KK)
- DOUBLE PRECISION ABAND,B,T,TMAX,P,ZERO
- DATA ZERO/0.D0/
-C
-C ******************************************************************
-C
-C SOLVES A BANDED SYSTEM OF LINEAR EQUATIONS USING GAUSSIAN ELIMINA-
-C TION WITH ROW INTERCHANGES.
-C
-C NN ORDER OF THE BAND MATRIX.
-C
-C MM BAND PARAMETER. NON-ZERO COEFFICIENTS ARE CONFINED TO
-C IABS(I-J).LE.MM.
-C
-C ABAND (DOUBLE PRECISION) TWO-DIMENSIONAL ARRAY CONTAINING THE
-C SUCCESSIVE ROWS OF THE BAND MATRIX WITH ITS OFF-BAND
-C ELEMENTS DELETED.
-C
-C IDIM FIRST DIMENSION PARAMETER OF ARRAYS ABAND AND B.
-C
-C IFAIL OUTPUT PARAMETER. IFAIL= 0 ... NORMAL EXIT.
-C IFAIL=-1 ... SINGULAR MATRIX.
-C
-C KK NUMBER OF COLUMNS OF THE MATRIX IN ARRAY B.
-C
-C B (DOUBLE PRECISION) TWO-DIMENSIONAL ARRAY CONTAINING A
-C MATRIX OF RIGHT-HAND SIDES.
-C
-C THIS SUBROUTINE REPLACES B BY THE SOLUTION MATRIX X OF A*X=B,
-C WHERE A IS THE BAND-MATRIX STORED IN PACKED FORM IN ARRAY ABAND.
-C
-C CALLS ... ABEND.
-C
-C ******************************************************************
-C
-C START. TEST INTEGER PARAMETERS.
- 10 IFAIL=-1
- N=NN
- M=MM
- K=KK
- MBAND=2*M+1
- IF( (N.LT.1).OR.(N.GT.IDIM).OR.(M.LT.0).OR.(M.GE.N).OR.(K.LT.1) )
- * GO TO 100
-C
-C SET ZEROS IN UPPER-RIGHT TRIANGLE OF ABAND.
- IF(M.EQ.0) GO TO 40
- JMAX=MIN0(MBAND,N)
- IMAX=JMAX-M-1
- JMIN=M+1
- IF(1.GT.IMAX) GO TO 20
- DO 12 I=1,IMAX
- JMIN=JMIN+1
- DO 11 J=JMIN,JMAX
- ABAND(I,J)=ZERO
- 11 CONTINUE
- 12 CONTINUE
-C
-C GAUSSIAN ELIMINATION TO REDUCE MATRIX TO UPPER TRIANGULAR FORM.
-C (WITHIN THIS SECTION, IMAX=MIN(L+M,N), JMAX=MIN(N-L+1,MBAND).)
- 20 IMAX=M
- LCUT=N-MBAND
- NMINUS=N-1
- DO 28 L=1,NMINUS
- LPLUS=L+1
- IF(IMAX.LT.N) IMAX=IMAX+1
-C
-C PIVOT SEARCH. SET TMAX TO ABS(PIVOT).
- TMAX=DABS(ABAND(L,1))
- IPIV=L
- DO 21 I=LPLUS,IMAX
- T=DABS(ABAND(I,1))
- IF(T.LE.TMAX) GO TO 21
- TMAX=T
- IPIV=I
- 21 CONTINUE
-C
-C INTERCHANGE ROWS L AND IPIV.
- IF(IPIV.EQ.L) GO TO 24
- DO 22 J=1,JMAX
- T=ABAND(IPIV,J)
- ABAND(IPIV,J)=ABAND(L,J)
- ABAND(L,J)=T
- 22 CONTINUE
- DO 23 JRHS=1,K
- T=B(IPIV,JRHS)
- B(IPIV,JRHS)=B(L,JRHS)
- B(L,JRHS)=T
- 23 CONTINUE
-C
-C ELIMINATE.
- 24 P=ABAND(L,1)
- IF(P.EQ.ZERO) RETURN
- DO 27 I=LPLUS,IMAX
- T=ABAND(I,1)/P
- DO 25 J=2,JMAX
- ABAND(I,J-1)=ABAND(I,J)-T*ABAND(L,J)
- 25 CONTINUE
- ABAND(I,JMAX)=ZERO
- DO 26 JRHS=1,K
- B(I,JRHS)=B(I,JRHS)-T*B(L,JRHS)
- 26 CONTINUE
- 27 CONTINUE
-C
- IF(L.GT.LCUT) JMAX=JMAX-1
- 28 CONTINUE
- IF(ABAND(N,1).EQ.ZERO) RETURN
-C
-C BACK-SUBSTITUTION.
- 30 DO 34 JRHS=1,K
- JMAX=0
- I=N
- DO 33 ICOMP=1,N
- IF(JMAX.LT.MBAND) JMAX=JMAX+1
- L=I
- T=B(I,JRHS)
- IF(2.GT.JMAX) GO TO 32
- DO 31 J=2,JMAX
- L=L+1
- T=T-ABAND(I,J)*B(L,JRHS)
- 31 CONTINUE
- 32 B(I,JRHS)=T/ABAND(I,1)
- I=I-1
- 33 CONTINUE
- 34 CONTINUE
- IFAIL=0
- RETURN
-C
-C SPECIAL CASE M=0.
- 40 DO 42 JRHS=1,K
- DO 41 I=1,N
- T=ABAND(I,1)
- IF(T.EQ.ZERO) RETURN
- B(I,JRHS)=B(I,JRHS)/T
- 41 CONTINUE
- 42 CONTINUE
- IFAIL=0
- RETURN
-C
-C ERROR PRINT FOR PARAMETER ERROR.
- 100 CALL KERMTR('F406.1',LGFILE,MFLAG,RFLAG)
- IF(MFLAG) THEN
- IF(LGFILE.EQ.0) THEN
- WRITE(*,101) N,M,IDIM,K
- ELSE
- WRITE(LGFILE,101) N,M,IDIM,K
- ENDIF
- ENDIF
- IF(.NOT. RFLAG) CALL ABEND
- RETURN
-C
- 101 FORMAT( 7X, 36HSUBROUTINE DBEQN ... PARAMETER ERROR,
- * 7X, 4HN = , I6, 7X, 4HM = , I6, 7X, 7HIDIM = , I6, 7X,
- * 4HK = , I6, 1H. )
- END
diff --git a/src/packlib/kernlib/kernnum/f406fort/rbeqn.F b/src/packlib/kernlib/kernnum/f406fort/rbeqn.F
deleted file mode 100644
index fcccfa1..0000000
--- a/src/packlib/kernlib/kernnum/f406fort/rbeqn.F
+++ /dev/null
@@ -1,165 +0,0 @@
-*
-* $Id: rbeqn.F,v 1.1.1.1 1996/02/15 17:48:49 mclareni Exp $
-*
-* $Log: rbeqn.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:49 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE RBEQN(NN,MM,ABAND,IDIM,IFAIL,KK,B)
- LOGICAL MFLAG,RFLAG
- DIMENSION ABAND(IDIM,NN),B(IDIM,KK)
- REAL ABAND,B,T,TMAX,P,ZERO
- DATA ZERO/0./
-C
-C ******************************************************************
-C
-C SOLVES A BANDED SYSTEM OF LINEAR EQUATIONS USING GAUSSIAN ELIMINA-
-C TION WITH ROW INTERCHANGES.
-C
-C NN ORDER OF THE BAND MATRIX.
-C
-C MM BAND PARAMETER. NON-ZERO COEFFICIENTS ARE CONFINED TO
-C IABS(I-J).LE.MM.
-C
-C ABAND (REAL) TWO-DIMENSIONAL ARRAY CONTAINING THE SUCCESSIVE
-C ROWS OF THE BAND MATRIX WITH ITS OFF-BAND ELEMENTS DE-
-C LETED.
-C
-C IDIM FIRST DIMENSION PARAMETER OF ARRAYS ABAND AND B.
-C
-C IFAIL OUTPUT PARAMETER. IFAIL= 0 ... NORMAL EXIT.
-C IFAIL=-1 ... SINGULAR MATRIX.
-C
-C KK NUMBER OF COLUMNS OF THE MATRIX IN ARRAY B.
-C
-C B (REAL) TWO-DIMENSIONAL ARRAY CONTAINING A MATRIX OF RIGHT-
-C HAND SIDES.
-C
-C THIS SUBROUTINE REPLACES B BY THE SOLUTION MATRIX X OF A*X=B,
-C WHERE A IS THE BAND-MATRIX STORED IN PACKED FORM IN ARRAY ABAND.
-C
-C CALLS ... ABEND.
-C
-C ******************************************************************
-C
-C START. TEST INTEGER PARAMETERS.
- 10 IFAIL=-1
- N=NN
- M=MM
- K=KK
- MBAND=2*M+1
- IF( (N.LT.1).OR.(N.GT.IDIM).OR.(M.LT.0).OR.(M.GE.N).OR.(K.LT.1) )
- * GO TO 100
-C
-C SET ZEROS IN UPPER-RIGHT TRIANGLE OF ABAND.
- IF(M.EQ.0) GO TO 40
- JMAX=MIN0(MBAND,N)
- IMAX=JMAX-M-1
- JMIN=M+1
- IF(1.GT.IMAX) GO TO 20
- DO 12 I=1,IMAX
- JMIN=JMIN+1
- DO 11 J=JMIN,JMAX
- ABAND(I,J)=ZERO
- 11 CONTINUE
- 12 CONTINUE
-C
-C GAUSSIAN ELIMINATION TO REDUCE MATRIX TO UPPER TRIANGULAR FORM.
-C (WITHIN THIS SECTION, IMAX=MIN(L+M,N), JMAX=MIN(N-L+1,MBAND).)
- 20 IMAX=M
- LCUT=N-MBAND
- NMINUS=N-1
- DO 28 L=1,NMINUS
- LPLUS=L+1
- IF(IMAX.LT.N) IMAX=IMAX+1
-C
-C PIVOT SEARCH. SET TMAX TO ABS(PIVOT).
- TMAX=ABS(ABAND(L,1))
- IPIV=L
- DO 21 I=LPLUS,IMAX
- T=ABS(ABAND(I,1))
- IF(T.LE.TMAX) GO TO 21
- TMAX=T
- IPIV=I
- 21 CONTINUE
-C
-C INTERCHANGE ROWS L AND IPIV.
- IF(IPIV.EQ.L) GO TO 24
- DO 22 J=1,JMAX
- T=ABAND(IPIV,J)
- ABAND(IPIV,J)=ABAND(L,J)
- ABAND(L,J)=T
- 22 CONTINUE
- DO 23 JRHS=1,K
- T=B(IPIV,JRHS)
- B(IPIV,JRHS)=B(L,JRHS)
- B(L,JRHS)=T
- 23 CONTINUE
-C
-C ELIMINATE.
- 24 P=ABAND(L,1)
- IF(P.EQ.ZERO) RETURN
- DO 27 I=LPLUS,IMAX
- T=ABAND(I,1)/P
- DO 25 J=2,JMAX
- ABAND(I,J-1)=ABAND(I,J)-T*ABAND(L,J)
- 25 CONTINUE
- ABAND(I,JMAX)=ZERO
- DO 26 JRHS=1,K
- B(I,JRHS)=B(I,JRHS)-T*B(L,JRHS)
- 26 CONTINUE
- 27 CONTINUE
-C
- IF(L.GT.LCUT) JMAX=JMAX-1
- 28 CONTINUE
- IF(ABAND(N,1).EQ.ZERO) RETURN
-C
-C BACK-SUBSTITUTION.
- 30 DO 34 JRHS=1,K
- JMAX=0
- I=N
- DO 33 ICOMP=1,N
- IF(JMAX.LT.MBAND) JMAX=JMAX+1
- L=I
- T=B(I,JRHS)
- IF(2.GT.JMAX) GO TO 32
- DO 31 J=2,JMAX
- L=L+1
- T=T-ABAND(I,J)*B(L,JRHS)
- 31 CONTINUE
- 32 B(I,JRHS)=T/ABAND(I,1)
- I=I-1
- 33 CONTINUE
- 34 CONTINUE
- IFAIL=0
- RETURN
-C
-C SPECIAL CASE M=0.
- 40 DO 42 JRHS=1,K
- DO 41 I=1,N
- T=ABAND(I,1)
- IF(T.EQ.ZERO) RETURN
- B(I,JRHS)=B(I,JRHS)/T
- 41 CONTINUE
- 42 CONTINUE
- IFAIL=0
- RETURN
-C
-C ERROR PRINT FOR PARAMETER ERROR.
- 100 CALL KERMTR('F406.1',LGFILE,MFLAG,RFLAG)
- IF(MFLAG) THEN
- IF(LGFILE .EQ. 0) THEN
- WRITE(*,101) N,M,IDIM,K
- ELSE
- WRITE(LGFILE,101) N,M,IDIM,K
- ENDIF
- ENDIF
- IF(.NOT. RFLAG) CALL ABEND
- RETURN
-C
- 101 FORMAT( 7X, 36HSUBROUTINE RBEQN ... PARAMETER ERROR,
- * 7X, 4HN = , I6, 7X, 4HM = , I6, 7X, 7HIDIM = , I6, 7X,
- * 4HK = , I6, 1H. )
- END
diff --git a/src/packlib/kernlib/kernnum/g900fort/Imakefile b/src/packlib/kernlib/kernnum/g900fort/Imakefile
deleted file mode 100644
index fdd024d..0000000
--- a/src/packlib/kernlib/kernnum/g900fort/Imakefile
+++ /dev/null
@@ -1,9 +0,0 @@
-SRCS_F= ranf.F ranget.F
-
-#if defined(CERNLIB_DECS) && ! defined(CERNLIB_QMVAOS)
-FDEBUGFLAGS=NoOpFortranDebugFlags
-#endif
-
-FORTRANSAVEOPTION=FortranSaveFlags
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kernnum/g900fort/ranf.F b/src/packlib/kernlib/kernnum/g900fort/ranf.F
deleted file mode 100644
index fef9614..0000000
--- a/src/packlib/kernlib/kernnum/g900fort/ranf.F
+++ /dev/null
@@ -1,45 +0,0 @@
-*
-* $Id: ranf.F,v 1.1.1.1 1996/02/15 17:49:05 mclareni Exp $
-*
-* $Log: ranf.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:05 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- REAL FUNCTION RANF()
- DOUBLE PRECISION DRANF, G900GT, G900ST
- DOUBLE PRECISION DS(2), DM(2), DSEED
- DOUBLE PRECISION DX24, DX48
- DOUBLE PRECISION DL, DC, DU, DR
- LOGICAL SINGLE
- DATA DS / 1665 1885.D0, 286 8876.D0 /
- DATA DM / 1518 4245.D0, 265 1554.D0 /
- DATA DX24 / 1677 7216.D0 /
- DATA DX48 / 281 4749 7671 0656.D0 /
- SINGLE = .TRUE.
- GOTO 10
- ENTRY DRANF()
- SINGLE = .FALSE.
- 10 DL = DS(1) * DM(1)
- DC = DINT(DL/DX24)
- DL = DL - DC*DX24
- DU = DS(1)*DM(2) + DS(2)*DM(1) + DC
- DS(2) = DU - DINT(DU/DX24)*DX24
- DS(1) = DL
- DR = (DS(2)*DX24 + DS(1)) / DX48
- IF(SINGLE) THEN
- RANF = SNGL(DR)
- ELSE
- DRANF = DR
- ENDIF
- RETURN
- ENTRY G900GT()
- G900GT = DS(2)*DX24 + DS(1)
- RETURN
- ENTRY G900ST(DSEED)
- DS(2) = DINT(DSEED/DX24)
- DS(1) = DSEED - DS(2)*DX24
- G900ST = DS(1)
- RETURN
- END
diff --git a/src/packlib/kernlib/kernnum/g900fort/ranget.F b/src/packlib/kernlib/kernnum/g900fort/ranget.F
deleted file mode 100644
index 30d8566..0000000
--- a/src/packlib/kernlib/kernnum/g900fort/ranget.F
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: ranget.F,v 1.1.1.1 1996/02/15 17:49:05 mclareni Exp $
-*
-* $Log: ranget.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:05 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE RANGET(SEED)
- DOUBLE PRECISION SEED, G900GT, G900ST, DUMMY
- SEED = G900GT()
- RETURN
- ENTRY RANSET(SEED)
- DUMMY = G900ST(SEED)
- RETURN
- END
diff --git a/src/packlib/kernlib/kernnum/g901fort/Imakefile b/src/packlib/kernlib/kernnum/g901fort/Imakefile
deleted file mode 100644
index e8d2baa..0000000
--- a/src/packlib/kernlib/kernnum/g901fort/Imakefile
+++ /dev/null
@@ -1,9 +0,0 @@
-SRCS_F= ran2vs.F ran3vs.F vran2s.F vran3s.F
-
-#if defined(CERNLIB_DECS) && ! defined(CERNLIB_QMVAOS)
-FDEBUGFLAGS=NoOpFortranDebugFlags
-#endif
-
-FORTRANSAVEOPTION=FortranSaveFlags
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kernnum/g901fort/ran2vs.F b/src/packlib/kernlib/kernnum/g901fort/ran2vs.F
deleted file mode 100644
index d237bed..0000000
--- a/src/packlib/kernlib/kernnum/g901fort/ran2vs.F
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: ran2vs.F,v 1.1.1.1 1996/02/15 17:49:06 mclareni Exp $
-*
-* $Log: ran2vs.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:06 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE RAN2VS(RADIUS,X1,Y1)
- 10 X = 2.*RANF() - 1.
- Y = 2.*RANF() - 1.
- RR = X*X + Y*Y
- IF(RR .GT. 1.) GOTO 10
- SCALE = RADIUS / SQRT(RR)
- X1 = X * SCALE
- Y1 = Y * SCALE
- RETURN
- END
diff --git a/src/packlib/kernlib/kernnum/g901fort/ran3vs.F b/src/packlib/kernlib/kernnum/g901fort/ran3vs.F
deleted file mode 100644
index 25ba81f..0000000
--- a/src/packlib/kernlib/kernnum/g901fort/ran3vs.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: ran3vs.F,v 1.1.1.1 1996/02/15 17:49:06 mclareni Exp $
-*
-* $Log: ran3vs.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:06 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE RAN3VS(RADIUS,X1,Y1,Z1)
- 10 X = 2.*RANF() - 1.
- Y = 2.*RANF() - 1.
- Z = 2.*RANF() - 1.
- RR = X*X + Y*Y + Z*Z
- IF(RR .GT. 1.) GOTO 10
- SCALE = RADIUS / SQRT(RR)
- X1 = X * SCALE
- Y1 = Y * SCALE
- Z1 = Z * SCALE
- RETURN
- END
diff --git a/src/packlib/kernlib/kernnum/g901fort/vran2s.F b/src/packlib/kernlib/kernnum/g901fort/vran2s.F
deleted file mode 100644
index 44cb983..0000000
--- a/src/packlib/kernlib/kernnum/g901fort/vran2s.F
+++ /dev/null
@@ -1,45 +0,0 @@
-*
-* $Id: vran2s.F,v 1.1.1.1 1996/02/15 17:49:06 mclareni Exp $
-*
-* $Log: vran2s.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:06 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE VRAN2S(RADIUS,N,X,Y,T)
- REAL RADIUS, X(N), Y(N), T(N)
- REAL A(65), B(65), W(65)
- SAVE KAPPA , A , B , W
- DATA KAPPA / 64 /
- IF(N .LT. 1) RETURN
- DO 11 I = 1, N
- X(I) = 2.*RANF() - 1.
- Y(I) = 2.*RANF() - 1.
- T(I) = X(I)**2 + Y(I)**2
- 11 CONTINUE
- J = 0
- 20 J = J + 1
- IF(J .GT. N) GOTO 30
- IF(T(J) .LE. 1.) GOTO 20
- 21 KAPPA = KAPPA + 1
- IF(KAPPA .GT. 64) THEN
- DO 22 I = 1, 64
- A(I) = 2.*RANF() - 1.
- B(I) = 2.*RANF() - 1.
- W(I) = A(I)**2 + B(I)**2
- 22 CONTINUE
- KAPPA = 1
- ENDIF
- IF(W(KAPPA) .GT. 1.) GOTO 21
- X(J) = A(KAPPA)
- Y(J) = B(KAPPA)
- T(J) = W(KAPPA)
- GOTO 20
- 30 DO 31 I = 1, N
- T(I) = RADIUS / SQRT(T(I))
- X(I) = T(I)*X(I)
- Y(I) = T(I)*Y(I)
- 31 CONTINUE
- RETURN
- END
diff --git a/src/packlib/kernlib/kernnum/g901fort/vran3s.F b/src/packlib/kernlib/kernnum/g901fort/vran3s.F
deleted file mode 100644
index 4e1af38..0000000
--- a/src/packlib/kernlib/kernnum/g901fort/vran3s.F
+++ /dev/null
@@ -1,49 +0,0 @@
-*
-* $Id: vran3s.F,v 1.1.1.1 1996/02/15 17:49:07 mclareni Exp $
-*
-* $Log: vran3s.F,v $
-* Revision 1.1.1.1 1996/02/15 17:49:07 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE VRAN3S(RADIUS,N,X,Y,Z,T)
- REAL RADIUS, X(N), Y(N), Z(N), T(N)
- REAL A(65), B(65), C(65), W(65)
- SAVE KAPPA , A , B , C , W
- DATA KAPPA / 64 /
- IF(N .LT. 1) RETURN
- DO 11 I = 1, N
- X(I) = 2.*RANF() - 1.
- Y(I) = 2.*RANF() - 1.
- Z(I) = 2.*RANF() - 1.
- T(I) = X(I)**2 + Y(I)**2 + Z(I)**2
- 11 CONTINUE
- J = 0
- 20 J = J + 1
- IF(J .GT. N) GOTO 30
- IF(T(J) .LE. 1.) GOTO 20
- 21 KAPPA = KAPPA + 1
- IF(KAPPA .GT. 64) THEN
- DO 22 I = 1, 64
- A(I) = 2.*RANF() - 1.
- B(I) = 2.*RANF() - 1.
- C(I) = 2.*RANF() - 1.
- W(I) = A(I)**2 + B(I)**2 + C(I)**2
- 22 CONTINUE
- KAPPA = 1
- ENDIF
- IF(W(KAPPA) .GT. 1.) GOTO 21
- X(J) = A(KAPPA)
- Y(J) = B(KAPPA)
- Z(J) = C(KAPPA)
- T(J) = W(KAPPA)
- GOTO 20
- 30 DO 31 I = 1, N
- T(I) = RADIUS / SQRT(T(I))
- X(I) = T(I)*X(I)
- Y(I) = T(I)*Y(I)
- Z(I) = T(I)*Z(I)
- 31 CONTINUE
- RETURN
- END
diff --git a/src/packlib/kernlib/kernnum/history/inform.dat b/src/packlib/kernlib/kernnum/history/inform.dat
deleted file mode 100644
index c37551a..0000000
--- a/src/packlib/kernlib/kernnum/history/inform.dat
+++ /dev/null
@@ -1,39 +0,0 @@
-*
-* $Id: inform.dat,v 1.1.1.1 1996/02/15 17:48:34 mclareni Exp $
-*
-* $Log: inform.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:48:34 mclareni
-* Kernlib
-*
-*
-C This pam file contains Fortran 77, CDC Compass,
-C IBM Assembler H, and NORD 500 assembler versions of Kernlib
-C numerical routines. Use one of these steering patches:
-C
-C APOLLO for APOLLO
-C CDC CDC 875 NOS/BE WITH FTN5 AND COMPASS
-C CDC,FORTRAN CDC 875 NOS/BE WITH FTN5
-C CONVEX CONVEX
-C CRAY CRAY 1 OR XMP COS WITH CFT
-C DECS DECSTATION 3100 WITH F77
-C HPUX HP/UX 9000 Series
-C IBMAIX IBM AIX/370 with fortvs
-C IBMMVS IBM MVS WITH SIEMENS FORT.77 + ASSEMBLER H
-C IBMMVS,FORTRAN IBM MVS WITH SIEMENS FORTRAN 77
-C IBMVM IBM VM/CMS WITH VS FORTRAN AND ASSEMBLER H
-C IBMVM,FORTRAN IBM VM/CMS WITH VS FORTRAN
-C IBMRT IBM RISC 6000 with AIX and XLF
-C LINUX LINUX system
-C MSDOS MS-DOS system
-C MIPS MIPS Machine
-C NORD NORSK DATA NORD 500
-C OS9 Microware OS-9
-C SGI SILICON GRAPHICS IRIS WITH F77
-C SUN SUN SPARC WITH F77
-C UNIVAC UNIVAC 1100
-C VAX DIGITAL EQUIPMENT VAX
-C
-C Installation of KERNNUM has been validated for patches
-C APOLLO, CRAY, IBM, IBMRT and VAX,
-C but for none of the other patches mentioned above.
-C
diff --git a/src/packlib/kernlib/kernnum/history/v304.dat b/src/packlib/kernlib/kernnum/history/v304.dat
deleted file mode 100644
index f30f025..0000000
--- a/src/packlib/kernlib/kernnum/history/v304.dat
+++ /dev/null
@@ -1,9 +0,0 @@
-*
-* $Id: v304.dat,v 1.1.1.1 1996/02/15 17:48:34 mclareni Exp $
-*
-* $Log: v304.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:48:34 mclareni
-* Kernlib
-*
-*
-* Version 3.04 890617
diff --git a/src/packlib/kernlib/kernnum/history/v305.dat b/src/packlib/kernlib/kernnum/history/v305.dat
deleted file mode 100644
index 65c4212..0000000
--- a/src/packlib/kernlib/kernnum/history/v305.dat
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: v305.dat,v 1.1.1.1 1996/02/15 17:48:34 mclareni Exp $
-*
-* $Log: v305.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:48:34 mclareni
-* Kernlib
-*
-*
-* Version 3.05 900412
-C- New patches:
-C- *KERNNUM: Pilot steering patch
-C
diff --git a/src/packlib/kernlib/kernnum/history/v306.dat b/src/packlib/kernlib/kernnum/history/v306.dat
deleted file mode 100644
index 83cf2b2..0000000
--- a/src/packlib/kernlib/kernnum/history/v306.dat
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: v306.dat,v 1.1.1.1 1996/02/15 17:48:34 mclareni Exp $
-*
-* $Log: v306.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:48:34 mclareni
-* Kernlib
-*
-*
-* Version 3.06 910209 13.25
-C- Updates to current version:
-C/2 > P=FKERNNUM Add HPUX,MIPS,IBMVM,VAXVMS
-C Make FTN=FORTRAN flag in steering patches
-C/1 > P=FKERNNUM DO not +USE,NUMAP1F for CONVEX
-C
-C- New patches/flags:
-C SKERNNUM: Source patch
-C FKERNNUM: Flags patch
-C DKERNNUM: Documentation patch (originally in P=HISTORY + P=INFORM)
-C segmenting version updates in decks
-C
-C- Modifications:
-C > P=D209FORT,D=RKSTP Define EXTERNAL SUB
-C > P=D209FORT,D=DRKSTP Define EXTERNAL SUB
-C > P=D509FORT,D=D509HI Define EXTERNAL F
-C > P=C205FORT,D=RZERO Define EXTERNAL F
-C > P=E106FORT Add Vector version for IBM
-C
diff --git a/src/packlib/kernlib/kernnum/history/v307.dat b/src/packlib/kernlib/kernnum/history/v307.dat
deleted file mode 100644
index 148f001..0000000
--- a/src/packlib/kernlib/kernnum/history/v307.dat
+++ /dev/null
@@ -1,15 +0,0 @@
-*
-* $Id: v307.dat,v 1.1.1.1 1996/02/15 17:48:34 mclareni Exp $
-*
-* $Log: v307.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:48:34 mclareni
-* Kernlib
-*
-*
-* Version 3.07 911016 4.30
-C- Refresh P=FKERNNUM with new machines
-C
-C- C305 GAMMA Inhibit code on IBM RISC 6000
-C- D106 GQUAD declare REAL GQUAD in P=D106FORT,D=GSET
-C- G901 RAN2VS save internal variables A,B,C,KAPPA in VRAN2S,VRAN3S
-C
diff --git a/src/packlib/kernlib/kernnum/history/v308.dat b/src/packlib/kernlib/kernnum/history/v308.dat
deleted file mode 100644
index ee39382..0000000
--- a/src/packlib/kernlib/kernnum/history/v308.dat
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: v308.dat,v 1.1.1.1 1996/02/15 17:48:34 mclareni Exp $
-*
-* $Log: v308.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:48:34 mclareni
-* Kernlib
-*
-*
-* Version 3.08 920722 2.20
-C- Introduce IPSC,MSDOS flag
-C
-C- New patches/flags:
-C > NUMMS1F Patch for MS-DOS
-C
-C- Modifications:
-C > P=N001FORT,D=KERSET Change limit to 255, ignore it if <0
-C > P=KERNNT ,D=KERNNT Remove obsolete Hollerith FORMAT statement
-C
diff --git a/src/packlib/kernlib/kernnum/history/v309.dat b/src/packlib/kernlib/kernnum/history/v309.dat
deleted file mode 100644
index 3e3191b..0000000
--- a/src/packlib/kernlib/kernnum/history/v309.dat
+++ /dev/null
@@ -1,15 +0,0 @@
-*
-* $Id: v309.dat,v 1.1.1.1 1996/02/15 17:48:34 mclareni Exp $
-*
-* $Log: v309.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:48:34 mclareni
-* Kernlib
-*
-*
-* Version 3.09 921017 0.20
-C- Updates to current version:
-C > P=MACHINETYPE New patch replacing FKERNNUM
-C
-C- Modifications:
-C > P=E105FORT,D=DIVDIF Set DIVDIF=0 when error E105.1 occurs
-C
diff --git a/src/packlib/kernlib/kernnum/history/v310.dat b/src/packlib/kernlib/kernnum/history/v310.dat
deleted file mode 100644
index 7e37361..0000000
--- a/src/packlib/kernlib/kernnum/history/v310.dat
+++ /dev/null
@@ -1,13 +0,0 @@
-*
-* $Id: v310.dat,v 1.1.1.1 1996/02/15 17:48:34 mclareni Exp $
-*
-* $Log: v310.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:48:34 mclareni
-* Kernlib
-*
-*
-* Version 3.10 940304
-C- Remove activation of :
-C C312, C313, C336, C337, D103, G100 moved to gen/mathlib
-C C204, C308, C341, D106 all obsoleted in CNL207.
-C
diff --git a/src/packlib/kernlib/kernnum/history/v311.dat b/src/packlib/kernlib/kernnum/history/v311.dat
deleted file mode 100644
index 104e51b..0000000
--- a/src/packlib/kernlib/kernnum/history/v311.dat
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: v311.dat,v 1.1.1.1 1996/02/15 17:48:34 mclareni Exp $
-*
-* $Log: v311.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:48:34 mclareni
-* Kernlib
-*
-*
-* Version 3.11 950529
-C- Remove activation of :
-C- C300, was activated as:
-C+USE, C300FORT.
-C+USE, C300FORT, D=ERF, T=INHIBIT, IF=NUMCD, IF=-NUMOWNCODE.
-C+USE, C300FORT, D=ERF,DERF, T=INHIBIT, IF=NUMIB, IF=-NUMOWNCODE.
-C+USE, C300FORT, D=ERF,DERF, T=INHIBIT, IF=NUMUC, IF=-NUMOWNCODE.
-C+USE, C300FORT, D=DERF,DFREQ, T=INHIBIT,IF=-NUMLOPRE.
-C
-C- C305, was activated as:
-C+USE, C305FORT.
-C+USE, C305FORT, T=INHIBIT, IF=NUMIB,NUMUC,IBMRT, IF=-NUMOWNCODE.
-C
-C- D209.
-C-
diff --git a/src/packlib/kernlib/kernnum/kernnt/Imakefile b/src/packlib/kernlib/kernnum/kernnt/Imakefile
deleted file mode 100644
index fc74d89..0000000
--- a/src/packlib/kernlib/kernnum/kernnt/Imakefile
+++ /dev/null
@@ -1,9 +0,0 @@
-SRCS_F= kernnt.F
-
-#if defined(CERNLIB_DECS) && ! defined(CERNLIB_QMVAOS)
-FDEBUGFLAGS=NoOpFortranDebugFlags
-#endif
-
-FORTRANSAVEOPTION=FortranSaveFlags
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kernnum/kernnt/kernnt.F b/src/packlib/kernlib/kernnum/kernnt/kernnt.F
deleted file mode 100644
index 5eb2457..0000000
--- a/src/packlib/kernlib/kernnum/kernnt/kernnt.F
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: kernnt.F,v 1.1.1.1 1996/02/15 17:48:34 mclareni Exp $
-*
-* $Log: kernnt.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:34 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE KERNNT(LUN)
-C
-C
-C *********************************************
-C * *
-C * PRINT PAM TITLE ON LUN *
-C * *
-C *********************************************
-C
- WRITE(LUN,1000)
- RETURN
- 1000 FORMAT('0PACKAGE COMPILED FROM PAM FILE= ',
- + 'KERNNUM 3.11/01 950529 18.00 '
- +/)
- END
diff --git a/src/packlib/kernlib/kernnum/kernnum.notes b/src/packlib/kernlib/kernnum/kernnum.notes
deleted file mode 100644
index e5eceb2..0000000
--- a/src/packlib/kernlib/kernnum/kernnum.notes
+++ /dev/null
@@ -1,33 +0,0 @@
-All the kernnum include files are bits of source code and are therefore
-left in the local directory rather than the include directory. The
-f*fort subdirectories have a lot of these local includes.
-
-Some +REP lines from kernnum.car have been added to the code.
-Also, cabs.F has been put into kernnum/c204fort. This routine is for
-ibmrt only.
-
-Obsolete pilot patches:
-
- numcd1a for CDC
- numcd1f for CDC
- numcd for CDC
- numcdopt for CDC
- numcr1f for CRAY
- numcr for CRAY
- numcv1f for CONVEX
- numcv for CONVEX
- numnd1a for NORD
- numnd for NORD
- numndopt for NORD
- numuc1f for UNIVAC
- numuc for UNIVAC
-
- numib1a for IBMMVS
- numib1f for IBMMVS
- numib2a for IBMVM
- numib2f for IBMVM
- numib for IBM
- numibopt for IBM
-
-All *cd code patches are for CDC
-All *ib code patches are for IBM
diff --git a/src/packlib/kernlib/kernnum/kernnum.rm b/src/packlib/kernlib/kernnum/kernnum.rm
deleted file mode 100755
index 7d87098..0000000
--- a/src/packlib/kernlib/kernnum/kernnum.rm
+++ /dev/null
@@ -1,136 +0,0 @@
-#!/bin/csh
-
-rm INSTALL Makefile* boot TITLE* config*
-
-mkdir obsolete
-mv dkernnum history
-
-mv _kernnum kernnum
-# move pilot files from */README to kernnum/*.h
-mv machinetype/README kernnum/machinetype.h
-mv numap/README kernnum/numap.h
-mv numap1f/README kernnum/numap1f.h
-mv numde/README kernnum/numde.h
-mv numde1f/README kernnum/numde1f.h
-mv numln/README kernnum/numln.h
-mv numln1f/README kernnum/numln1f.h
-mv numms/README kernnum/numms.h
-mv numms1f/README kernnum/numms1f.h
-mv skernnum/README kernnum/skernnum.h
-
-mkdir obsolete/kernnum
-mv numcd/README obsolete/kernnum/numcd.h
-mv numcd1a/README obsolete/kernnum/numcd1a.h
-mv numcd1f/README obsolete/kernnum/numcd1f.h
-mv numcdopt/README obsolete/kernnum/numcdopt.h
-mv numcr/README obsolete/kernnum/numcr.h
-mv numcr1f/README obsolete/kernnum/numcr1f.h
-mv numcv/README obsolete/kernnum/numcv.h
-mv numcv1f/README obsolete/kernnum/numcv1f.h
-mv numnd/README obsolete/kernnum/numnd.h
-mv numnd1a/README obsolete/kernnum/numnd1a.h
-mv numndopt/README obsolete/kernnum/numndopt.h
-mv numuc/README obsolete/kernnum/numuc.h
-mv numuc1f/README obsolete/kernnum/numuc1f.h
-mv numib/README obsolete/kernnum/numib.h
-mv numib1a/README obsolete/kernnum/numib1a.h
-mv numib1f/README obsolete/kernnum/numib1f.h
-mv numib2a/README obsolete/kernnum/numib2a.h
-mv numib2f/README obsolete/kernnum/numib2f.h
-mv numibopt/README obsolete/kernnum/numibopt.h
-
-rm -r machinetype num* skernnum
-
-mv kerncd/README kerncd/kerncd.s
-
-rm */Makefile* */README
-
-mv g900nord obsolete
-mv *cd obsolete # CDC assembler
-mv *ib obsolete # IBM assembler
-mv c300fort obsolete # never used
-mv c305fort obsolete # never used
-mv d103fort obsolete # never used
-mkdir obsolete/g900fort
-mv g900fort/dranf.F obsolete/g900fort/dranf.F
-mkdir obsolete/e106fort
-mv e106fort/*.s obsolete/e106fort # IBM assembler
-mv e106fort/*.inc obsolete/e106fort # IBM assembler
-
-cd c204fort
-update kernnum
-cd ../c205fort
-update kernnum
-cd ../c308fort
-update kernnum
-cd ../c312fort
-update kernnum
-cd ../c313fort
-update kernnum
-cd ../c336fort
-update kernnum
-cd ../c337fort
-update kernnum
-cd ../c341fort
-update kernnum
-cd ../d106fort
-update kernnum
-cd ../d209fort
-update kernnum
-cd ../d509fort
-update kernnum
-cd ../d703fort
-update kernnum
-cd ../d704fort
-update kernnum
-cd ../e100fort
-update kernnum
-cd ../e104fort
-update kernnum
-cd ../e105fort
-update kernnum
-cd ../e106fort
-update kernnum
-cd ../e208fort
-update kernnum
-cd ../f002fort
-update kernnum
-cd ../f002ib
-updates kernnum
-cd ../f003fort
-update kernnum
-cd ../f003ib
-updates kernnum
-cd ../f004fort
-update kernnum
-cd ../f004ib
-updates kernnum
-cd ../f010fort
-update kernnum
-cd ../f011fort
-update kernnum
-cd ../f011ib
-updates kernnum
-cd ../f012fort
-update kernnum
-cd ../f012ib
-updates kernnum
-cd ../f406fort
-update kernnum
-cd ../g100fort
-update kernnum
-cd ../g900fort
-update kernnum
-cd ../g900ib
-updates kernnum
-cd ../g901fort
-update kernnum
-cd ../kernnt
-update kernnum
-cd ../n001fort
-update kernnum
-cd ..
-
-fixinc kernnum
-
-mv kernnumt tests
diff --git a/src/packlib/kernlib/kernnum/kernnum/Imakefile b/src/packlib/kernlib/kernnum/kernnum/Imakefile
deleted file mode 100644
index cd6f668..0000000
--- a/src/packlib/kernlib/kernnum/kernnum/Imakefile
+++ /dev/null
@@ -1,3 +0,0 @@
-INCLUDES= pilot.h
-
-InstallIncludes($(INCLUDES),$(CERN_INCLUDEDIR),kernnum)
diff --git a/src/packlib/kernlib/kernnum/kernnum/pilot.h b/src/packlib/kernlib/kernnum/kernnum/pilot.h
deleted file mode 100644
index 713a0fc..0000000
--- a/src/packlib/kernlib/kernnum/kernnum/pilot.h
+++ /dev/null
@@ -1,85 +0,0 @@
-#if defined(CERNLIB_IBMRT)
-#ifndef CERNLIB_IBMRS
-#define CERNLIB_IBMRS
-#endif
-#endif
-#if defined(CERNLIB_VAXVMS)||defined(CERNLIB_VAXULTRIX)
-#ifndef CERNLIB_VAX
-#define CERNLIB_VAX
-#endif
-#endif
-#if defined(CERNLIB_VAX)
-#ifndef CERNLIB_DOUBLE
-#define CERNLIB_DOUBLE
-#endif
-#endif
-#if (defined(CERNLIB_UNIX))&&(!defined(CERNLIB_SINGLE))
-#ifndef CERNLIB_DOUBLE
-#define CERNLIB_DOUBLE
-#endif
-#endif
-
-#if defined(CERNLIB_LINUX)||defined(CERNLIB_MSDOS) && !defined(CERNLIB_WINNT)
-#ifndef CERNLIB_NUMIB2
-#define CERNLIB_NUMIB2
-#endif
-#ifdef CERNLIB_NUMD38
-#undef CERNLIB_NUMD38
-#endif
-#ifndef CERNLIB_NUMD279
-#define CERNLIB_NUMD279
-#endif
-#endif
-
-#if defined(CERNLIB_VAXVMS)
-#ifndef CERNLIB_NUMDE
-#define CERNLIB_NUMDE
-#endif
-#ifndef CERNLIB_NUMD38
-#define CERNLIB_NUMD38
-#endif
-#ifdef CERNLIB_NUMD279
-#undef CERNLIB_NUMD279
-#endif
-#endif
-#if (defined(CERNLIB_UNIX)) || defined(CERNLIB_WINNT) && (!defined(CERNLIB_QF2C))
-#ifndef CERNLIB_NUMAP
-#define CERNLIB_NUMAP
-#endif
-#ifndef CERNLIB_NUMD38
-#define CERNLIB_NUMD38
-#endif
-#ifdef CERNLIB_NUMD279
-#undef CERNLIB_NUMD279
-#endif
-#endif
-#ifndef CERNLIB_NUMLOPRE
-#define CERNLIB_NUMLOPRE
-#endif
-#ifdef CERNLIB_NUMHIPRE
-#undef CERNLIB_NUMHIPRE
-#endif
-#ifndef CERNLIB_NUMRDBLE
-#define CERNLIB_NUMRDBLE
-#endif
-#ifndef CERNLIB_NUMCDBLE
-#define CERNLIB_NUMCDBLE
-#endif
-#ifndef CERNLIB_NUME38
-#define CERNLIB_NUME38
-#endif
-#ifdef CERNLIB_NUME75
-#undef CERNLIB_NUME75
-#endif
-#ifdef CERNLIB_NUME293
-#undef CERNLIB_NUME293
-#endif
-#ifdef CERNLIB_NUME2465
-#undef CERNLIB_NUME2465
-#endif
-#ifdef CERNLIB_NUMD75
-#undef CERNLIB_NUMD75
-#endif
-#ifdef CERNLIB_NUMD2465
-#undef CERNLIB_NUMD2465
-#endif
diff --git a/src/packlib/kernlib/kernnum/kernnumt.rm b/src/packlib/kernlib/kernnum/kernnumt.rm
deleted file mode 100755
index dc2cc35..0000000
--- a/src/packlib/kernlib/kernnum/kernnumt.rm
+++ /dev/null
@@ -1,67 +0,0 @@
-#!/bin/csh
-
-rm INSTALL Makefile* boot TITLE* config* inhibit* pilot*
-
-mv _kernchk kernnumt
-mv dkernchk history
-
-# move pilot files from */README to kernnumt/*.h
-mv machinetype/README kernnumt/machinetype.h
-mv numchk/README kernnumt/numchk.h
-mv numap/README kernnumt/numap.h
-mv numap1c/README kernnumt/numap1c.h
-mv numde/README kernnumt/numde.h
-mv numde1c/README kernnumt/numde1c.h
-mv numln/README kernnumt/numln.h
-mv numln1c/README kernnumt/numln1c.h
-mv numms/README kernnumt/numms.h
-mv numms1c/README kernnumt/numms1c.h
-mv skernchk/README kernnumt/skernchk.h
-
-mkdir obsolete
-mkdir obsolete/kernnumt
-mv numcd/README obsolete/kernnumt/numcd.h
-mv numcd1c/README obsolete/kernnumt/numcd1c.h
-mv numcr/README obsolete/kernnumt/numcr.h
-mv numcr1c/README obsolete/kernnumt/numcr1c.h
-mv numcv/README obsolete/kernnumt/numcv.h
-mv numcv1c/README obsolete/kernnumt/numcv1c.h
-mv numnd/README obsolete/kernnumt/numnd.h
-mv numnd1c/README obsolete/kernnumt/numnd1c.h
-mv numuc/README obsolete/kernnumt/numuc.h
-mv numuc1c/README obsolete/kernnumt/numuc1c.h
-mv numib/README obsolete/kernnumt/numib.h
-mv numib1c/README obsolete/kernnumt/numib1c.h
-mv numib2c/README obsolete/kernnumt/numib2c.h
-
-rm -r machinetype skernchk numchk
-rm -r numap* numcd* numcr* numcv* numde* numib* numln* numms* numnd* numuc*
-
-rm */Makefile* */README
-
-mkdir obsolete/numchk1 obsolete/numchk2 obsolete/numchk4
-mv numchk1/g100ch.F obsolete/numchk1
-mv numchk2/c204ch.F obsolete/numchk2
-mv numchk2/c300*.F obsolete/numchk2
-mv numchk2/d1*.F obsolete/numchk2
-mv numchk2/d209*.F obsolete/numchk2
-mv numchk4/c3*.F obsolete/numchk4
-
-cd numchk0
-update kernnumt
-cd ../numchk1
-update kernnumt
-cd ../numchk2
-update kernnumt
-cd ../numchk3
-update kernnumt
-cd ../numchk4
-update kernnumt
-cd ..
-
-mv numchk0/*.inc kernnumt
-#
-# merge typseed.inc in sysdat.inc
-# don't put checks on sysdat since it is used many times within one test file
-#
-# fix triads so code will compile
diff --git a/src/packlib/kernlib/kernnum/n001fort/Imakefile b/src/packlib/kernlib/kernnum/n001fort/Imakefile
deleted file mode 100644
index a4a2a34..0000000
--- a/src/packlib/kernlib/kernnum/n001fort/Imakefile
+++ /dev/null
@@ -1,9 +0,0 @@
-SRCS_F= kerset.F
-
-#if defined(CERNLIB_DECS) && ! defined(CERNLIB_QMVAOS)
-FDEBUGFLAGS=NoOpFortranDebugFlags
-#endif
-
-FORTRANSAVEOPTION=FortranSaveFlags
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kernnum/n001fort/kerset.F b/src/packlib/kernlib/kernnum/n001fort/kerset.F
deleted file mode 100644
index 2a7fa01..0000000
--- a/src/packlib/kernlib/kernnum/n001fort/kerset.F
+++ /dev/null
@@ -1,91 +0,0 @@
-*
-* $Id: kerset.F,v 1.1.1.1 1996/02/15 17:48:35 mclareni Exp $
-*
-* $Log: kerset.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:35 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- SUBROUTINE KERSET(ERCODE,LGFILE,LIMITM,LIMITR)
- PARAMETER(KOUNTE = 27)
- CHARACTER*6 ERCODE, CODE(KOUNTE)
- LOGICAL MFLAG, RFLAG
- INTEGER KNTM(KOUNTE), KNTR(KOUNTE)
- DATA LOGF / 0 /
- DATA CODE(1), KNTM(1), KNTR(1) / 'C204.1', 255, 255 /
- DATA CODE(2), KNTM(2), KNTR(2) / 'C204.2', 255, 255 /
- DATA CODE(3), KNTM(3), KNTR(3) / 'C204.3', 255, 255 /
- DATA CODE(4), KNTM(4), KNTR(4) / 'C205.1', 255, 255 /
- DATA CODE(5), KNTM(5), KNTR(5) / 'C205.2', 255, 255 /
- DATA CODE(6), KNTM(6), KNTR(6) / 'C305.1', 255, 255 /
- DATA CODE(7), KNTM(7), KNTR(7) / 'C308.1', 255, 255 /
- DATA CODE(8), KNTM(8), KNTR(8) / 'C312.1', 255, 255 /
- DATA CODE(9), KNTM(9), KNTR(9) / 'C313.1', 255, 255 /
- DATA CODE(10),KNTM(10),KNTR(10) / 'C336.1', 255, 255 /
- DATA CODE(11),KNTM(11),KNTR(11) / 'C337.1', 255, 255 /
- DATA CODE(12),KNTM(12),KNTR(12) / 'C341.1', 255, 255 /
- DATA CODE(13),KNTM(13),KNTR(13) / 'D103.1', 255, 255 /
- DATA CODE(14),KNTM(14),KNTR(14) / 'D106.1', 255, 255 /
- DATA CODE(15),KNTM(15),KNTR(15) / 'D209.1', 255, 255 /
- DATA CODE(16),KNTM(16),KNTR(16) / 'D509.1', 255, 255 /
- DATA CODE(17),KNTM(17),KNTR(17) / 'E100.1', 255, 255 /
- DATA CODE(18),KNTM(18),KNTR(18) / 'E104.1', 255, 255 /
- DATA CODE(19),KNTM(19),KNTR(19) / 'E105.1', 255, 255 /
- DATA CODE(20),KNTM(20),KNTR(20) / 'E208.1', 255, 255 /
- DATA CODE(21),KNTM(21),KNTR(21) / 'E208.2', 255, 255 /
- DATA CODE(22),KNTM(22),KNTR(22) / 'F010.1', 255, 0 /
- DATA CODE(23),KNTM(23),KNTR(23) / 'F011.1', 255, 0 /
- DATA CODE(24),KNTM(24),KNTR(24) / 'F012.1', 255, 0 /
- DATA CODE(25),KNTM(25),KNTR(25) / 'F406.1', 255, 0 /
- DATA CODE(26),KNTM(26),KNTR(26) / 'G100.1', 255, 255 /
- DATA CODE(27),KNTM(27),KNTR(27) / 'G100.2', 255, 255 /
- LOGF = LGFILE
- L = 0
- IF(ERCODE .NE. ' ') THEN
- DO 10 L = 1, 6
- IF(ERCODE(1:L) .EQ. ERCODE) GOTO 12
- 10 CONTINUE
- 12 CONTINUE
- ENDIF
- DO 14 I = 1, KOUNTE
- IF(L .EQ. 0) GOTO 13
- IF(CODE(I)(1:L) .NE. ERCODE(1:L)) GOTO 14
- 13 IF(LIMITM.GE.0) KNTM(I) = LIMITM
- IF(LIMITR.GE.0) KNTR(I) = LIMITR
- 14 CONTINUE
- RETURN
- ENTRY KERMTR(ERCODE,LOG,MFLAG,RFLAG)
- LOG = LOGF
- DO 20 I = 1, KOUNTE
- IF(ERCODE .EQ. CODE(I)) GOTO 21
- 20 CONTINUE
- WRITE(*,1000) ERCODE
- CALL ABEND
- RETURN
- 21 RFLAG = KNTR(I) .GE. 1
- IF(RFLAG .AND. (KNTR(I) .LT. 255)) KNTR(I) = KNTR(I) - 1
- MFLAG = KNTM(I) .GE. 1
- IF(MFLAG .AND. (KNTM(I) .LT. 255)) KNTM(I) = KNTM(I) - 1
- IF(.NOT. RFLAG) THEN
- IF(LOGF .LT. 1) THEN
- WRITE(*,1001) CODE(I)
- ELSE
- WRITE(LOGF,1001) CODE(I)
- ENDIF
- ENDIF
- IF(MFLAG .AND. RFLAG) THEN
- IF(LOGF .LT. 1) THEN
- WRITE(*,1002) CODE(I)
- ELSE
- WRITE(LOGF,1002) CODE(I)
- ENDIF
- ENDIF
- RETURN
-1000 FORMAT(' KERNLIB LIBRARY ERROR. ' /
- + ' ERROR CODE ',A6,' NOT RECOGNIZED BY KERMTR',
- + ' ERROR MONITOR. RUN ABORTED.')
-1001 FORMAT(/' ***** RUN TERMINATED BY CERN LIBRARY ERROR ',
- + 'CONDITION ',A6)
-1002 FORMAT(/' ***** CERN LIBRARY ERROR CONDITION ',A6)
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/c300fort/Imakefile b/src/packlib/kernlib/kernnum/obsolete/c300fort/Imakefile
deleted file mode 100644
index d38d0c1..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/c300fort/Imakefile
+++ /dev/null
@@ -1,4 +0,0 @@
-SRCS_F= \ @@\
- derf.F dfreq.F erf.F freq.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kernnum/obsolete/c300fort/derf.F b/src/packlib/kernlib/kernnum/obsolete/c300fort/derf.F
deleted file mode 100644
index a1e41ec..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/c300fort/derf.F
+++ /dev/null
@@ -1,172 +0,0 @@
-*
-* $Id: derf.F,v 1.1.1.1 1996/02/15 17:48:17 mclareni Exp $
-*
-* $Log: derf.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:17 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- DOUBLE PRECISION FUNCTION DERF(DX)
- IMPLICIT DOUBLE PRECISION (A-H,O-Z)
- LOGICAL LERF
-C
- DIMENSION P1(4),Q1(3), P2(8),Q2(7), P3(5),Q3(4)
-C
-C ******************************************************************
-C
-C ENTRY POINTS ... DERF, DERFC.
-C
-C THESE FUNCTIONS ARE COMPUTED FROM THE RATIONAL APPROXIMATIONS OF
-C W.J.CODY, MATHEMATICS OF COMPUTATION, VOLUME 22 (1969), PAGES
-C 631-637.
-C
-C FOR ABS(X) LE 0.47 THE BASIC FUNCTION IS ERF. FOR ABS(X) GT 0.47
-C THE BASIC FUNCTION IS ERFC. THE FINAL RESULT IS OBTAINED IN TERMS
-C OF THE BASIC FUNCTION AS SHOWN IN THE FOLLOWING TABLE, IN WHICH
-C A=ABS(X).
-C
-C FUNCTION A.LE.(0.47) A.GT.(0.47)
-C REQUIRED (ALL X) (NEGATIVE X) (POSITIVE X)
-C
-C ERF(X) ERF(X) ERFC(A)-1 1-ERFC(X)
-C
-C ERFC(X) 1-ERF(X) 2-ERFC(A) ERFC(X)
-C
-C ******************************************************************
-C
- DATA ZERO/ 0. D0 /, ONE/ 1. D0 /, TWO/ 2. D0 /, FOUR/ 4. D0 /
-C
- DATA ACUT/ 0.46875 D0 /
-C ( ACUT AND 4.0 ARE CHANGE-OVER POINTS FOR THE RATIONAL APPROXIM-
-C ATIONS. )
-C
- DATA CONST/ 0.56418 95835 47756 3 D0 /
-C ( CONST=SQRT(1/PI). )
-C
-#if defined(CERNLIB_NUME2465)
- DATA XMAX/ 75.3 D0 /
-#endif
-#if defined(CERNLIB_NUME293)
- DATA XMAX/ 25.8 D0 /
-#endif
-#if defined(CERNLIB_NUME75)
- DATA XMAX/ 13.0 D0 /
-#endif
-#if defined(CERNLIB_NUME38)
- DATA XMAX/ 8.9 D0 /
-#endif
-#if defined(CERNLIB_NUME999)
- DATA XMAX/ *** NOT AVAILABLE *** /
-#endif
-C ( XMAX=SQRT(-ALOG(RMIN)-10.0), WHERE RMIN IS THE SMALLEST NORMAL-
-C IZED REPRESENTABLE NUMBER. ERFC(XMAX) IS CLOSE TO THE UNDERFLOW
-C THRESHOLD. )
-C
- DATA XUNIT/ 5.9 D0 /
-C ( XUNIT=SQRT(-ALOG(RELPR)+1.0), WHERE RELPR IS THE SMALLEST NUMBER
-C FOR WHICH 1.0+RELPR DIFFERS FROM 1.0. ERF(XUNIT) IS INDISTIN-
-C GUISHABLE FROM 1.0. )
-C
- DATA P1/ 2.42667 95523 05318 D+2,
- * 2.19792 61618 29415 D+1,
- * 6.99638 34886 19136 D+0,
- * -3.56098 43701 81538 D-2 /
- DATA Q1/ 2.15058 87586 98612 D+2,
- * 9.11649 05404 51490 D+1,
- * 1.50827 97630 40779 D+1 /
- DATA P2/ 3.00459 26102 01616 D+2,
- * 4.51918 95371 18729 D+2,
- * 3.39320 81673 43437 D+2,
- * 1.52989 28504 69404 D+2,
- * 4.31622 27222 05674 D+1,
- * 7.21175 82508 83094 D+0,
- * 5.64195 51747 89740 D-1,
- * -1.36864 85738 27167 D-7 /
- DATA Q2/ 3.00459 26095 69833 D+2,
- * 7.90950 92532 78980 D+2,
- * 9.31354 09485 06096 D+2,
- * 6.38980 26446 56312 D+2,
- * 2.77585 44474 39876 D+2,
- * 7.70001 52935 22947 D+1,
- * 1.27827 27319 62942 D+1 /
- DATA P3/-2.99610 70770 35422 D-3,
- * -4.94730 91062 32507 D-2,
- * -2.26956 59353 96869 D-1,
- * -2.78661 30860 96478 D-1,
- * -2.23192 45973 41847 D-2 /
- DATA Q3/ 1.06209 23052 84679 D-2,
- * 1.91308 92610 78298 D-1,
- * 1.05167 51070 67932 D+0,
- * 1.98733 20181 71353 D+0 /
-C
-C ******************************************************************
-C
-C ENTRY DERF.
- LERF=.TRUE.
- T=DX
- A=ABS(T)
- IF (A.GT.XUNIT) THEN
- DERF=SIGN(ONE,T)
- RETURN
- ENDIF
- GO TO 1
-C
-C ENTRY DERFC.
- ENTRY DERFC(DX)
- LERF=.FALSE.
- T=DX
- A=ABS(T)
- IF (T.LT.-XUNIT) THEN
- DERFC=TWO
- RETURN
- ELSEIF (T.GT.XMAX) THEN
- DERFC=ZERO
- RETURN
- ENDIF
-C
-C COMMON CODE.
-C
- 1 S=T**2
- IF (A.LE.ACUT) THEN
-C
-C SET Y=DERF(X) AND TERMINATE.
-C
- Y=T*(P1(1)+S*(P1(2)+S*(P1(3)+S*P1(4))))
- * /(Q1(1)+S*(Q1(2)+S*(Q1(3)+S)))
- IF (LERF) THEN
- DERF=Y
- ELSE
- DERFC=ONE-Y
- ENDIF
-C
- ELSE
-C
-C SET Y=DERFC(A) AND TERMINATE.
-C
- IF (A.LE.FOUR) THEN
- Y=EXP(-S)*(P2(1)+A*(P2(2)+A*(P2(3)+A*(P2(4)+A*(P2(5)+
- * A*(P2(6)+A*(P2(7)+A*P2(8))))))))
- * /(Q2(1)+A*(Q2(2)+A*(Q2(3)+A*(Q2(4)+A*(Q2(5)+
- * A*(Q2(6)+A*(Q2(7)+A)))))))
- ELSE
- R=ONE/A
- U=R**2
- Y=R*EXP(-S)*( CONST +
- * U*(P3(1)+U*(P3(2)+U*(P3(3)+U*(P3(4)+U*P3(5)))))
- * /(Q3(1)+U*(Q3(2)+U*(Q3(3)+U*(Q3(4)+U)))) )
- ENDIF
- IF (LERF) THEN
- DERF=SIGN(ONE-Y,T)
- ELSE
- IF (T.GE.ZERO) THEN
- DERFC=Y
- ELSE
- DERFC=TWO-Y
- ENDIF
- ENDIF
-C
- ENDIF
- RETURN
-C
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/c300fort/dfreq.F b/src/packlib/kernlib/kernnum/obsolete/c300fort/dfreq.F
deleted file mode 100644
index 188a23d..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/c300fort/dfreq.F
+++ /dev/null
@@ -1,49 +0,0 @@
-*
-* $Id: dfreq.F,v 1.1.1.1 1996/02/15 17:48:17 mclareni Exp $
-*
-* $Log: dfreq.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:17 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- DOUBLE PRECISION FUNCTION DFREQ(DX)
- IMPLICIT DOUBLE PRECISION (A-H,O-Z)
-#if defined(CERNLIB_NUMOWNCODE)
- EXTERNAL DERF,DERFC
-#endif
-C
- DATA CONST/ 0.70710 67811 86548 D0 /
-C ( CONST=SQRT(1/2). )
-C
-#if defined(CERNLIB_NUME2465)
- DATA XMAX/ 75.3 D0 /
-#endif
-#if defined(CERNLIB_NUME293)
- DATA XMAX/ 25.8 D0 /
-#endif
-#if defined(CERNLIB_NUME75)
- DATA XMAX/ 13.0 D0 /
-#endif
-#if defined(CERNLIB_NUME38)
- DATA XMAX/ 8.9 D0 /
-#endif
-#if defined(CERNLIB_NUME999)
- DATA XMAX/ *** NOT AVAILABLE *** /
-#endif
-C ( XMAX=SQRT(-ALOG(RMIN)-10.0), WHERE RMIN IS THE SMALLEST NORMAL-
-C IZED REPRESENTABLE NUMBER. ERFC(XMAX) IS CLOSE TO THE UNDERFLOW
-C THRESHOLD. )
-C
-C ******************************************************************
-C
-C START.
- CX=CONST*DBLE(DX)
- IF(CX.LT.-XMAX) THEN
- DFREQ=0.D0
- ELSE
- IF(CX.GE.0.D0) DFREQ = 0.5D0 + 0.5D0*DERF(CX)
- IF(CX.LT.0.D0) DFREQ = 0.5D0*DERFC(-CX)
- ENDIF
- RETURN
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/c300fort/erf.F b/src/packlib/kernlib/kernnum/obsolete/c300fort/erf.F
deleted file mode 100644
index 6071910..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/c300fort/erf.F
+++ /dev/null
@@ -1,204 +0,0 @@
-*
-* $Id: erf.F,v 1.1.1.1 1996/02/15 17:48:17 mclareni Exp $
-*
-* $Log: erf.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:17 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- FUNCTION ERF(RX)
-#if defined(CERNLIB_NUMLOPRE)
- IMPLICIT DOUBLE PRECISION (A-H,O-Z)
- REAL ERF,ERFC,RX,ROUND
-#endif
- LOGICAL LERF
-C
- DIMENSION P1(4),Q1(3), P2(8),Q2(7), P3(5),Q3(4)
-C
-C ******************************************************************
-C
-C ENTRY POINTS ... ERF, ERFC.
-C
-C THESE FUNCTIONS ARE COMPUTED FROM THE RATIONAL APPROXIMATIONS OF
-C W.J.CODY, MATHEMATICS OF COMPUTATION, VOLUME 22 (1969), PAGES
-C 631-637.
-C
-C FOR ABS(X) LE 0.47 THE BASIC FUNCTION IS ERF. FOR ABS(X) GT 0.47
-C THE BASIC FUNCTION IS ERFC. THE FINAL RESULT IS OBTAINED IN TERMS
-C OF THE BASIC FUNCTION AS SHOWN IN THE FOLLOWING TABLE, IN WHICH
-C A=ABS(X).
-C
-C FUNCTION A.LE.(0.47) A.GT.(0.47)
-C REQUIRED (ALL X) (NEGATIVE X) (POSITIVE X)
-C
-C ERF(X) ERF(X) ERFC(A)-1 1-ERFC(X)
-C
-C ERFC(X) 1-ERF(X) 2-ERFC(A) ERFC(X)
-C
-C ******************************************************************
-C
-#if defined(CERNLIB_NUMHIPRE)
- DATA ZERO/ 0. /, ONE/ 1. /, TWO/ 2. /, FOUR/ 4. /
-C
- DATA ACUT/ 0.46875 /
-#endif
-#if defined(CERNLIB_NUMLOPRE)
- DATA ZERO/ 0. D0 /, ONE/ 1. D0 /, TWO/ 2. D0 /, FOUR/ 4. D0 /
-C
- DATA ACUT/ 0.46875 D0 /
-#endif
-C ( ACUT AND 4.0 ARE CHANGE-OVER POINTS FOR THE RATIONAL APPROXIM-
-C ATIONS. )
-C
- DATA CONST/ 0.56418 95835 47756 3 D0 /
-C ( CONST=SQRT(1/PI). )
-C
-#if defined(CERNLIB_NUME2465)
- DATA XMAX/ 75.3 D0 /
-#endif
-#if defined(CERNLIB_NUME293)
- DATA XMAX/ 25.8 D0 /
-#endif
-#if defined(CERNLIB_NUME75)
- DATA XMAX/ 13.0 D0 /
-#endif
-#if defined(CERNLIB_NUME38)
- DATA XMAX/ 8.9 D0 /
-#endif
-#if defined(CERNLIB_NUME999)
- DATA XMAX/ *** NOT AVAILABLE *** /
-#endif
-C ( XMAX=SQRT(-ALOG(RMIN)-10.0), WHERE RMIN IS THE SMALLEST NORMAL-
-C IZED REPRESENTABLE NUMBER. ERFC(XMAX) IS CLOSE TO THE UNDERFLOW
-C THRESHOLD. )
-C
- DATA XUNIT/ 5.9 D0 /
-C ( XUNIT=SQRT(-ALOG(RELPR)+1.0), WHERE RELPR IS THE SMALLEST NUMBER
-C FOR WHICH 1.0+RELPR DIFFERS FROM 1.0. ERF(XUNIT) IS INDISTIN-
-C GUISHABLE FROM 1.0. )
-C
- DATA P1/ 2.42667 95523 05318 D+2,
- * 2.19792 61618 29415 D+1,
- * 6.99638 34886 19136 D+0,
- * -3.56098 43701 81538 D-2 /
- DATA Q1/ 2.15058 87586 98612 D+2,
- * 9.11649 05404 51490 D+1,
- * 1.50827 97630 40779 D+1 /
- DATA P2/ 3.00459 26102 01616 D+2,
- * 4.51918 95371 18729 D+2,
- * 3.39320 81673 43437 D+2,
- * 1.52989 28504 69404 D+2,
- * 4.31622 27222 05674 D+1,
- * 7.21175 82508 83094 D+0,
- * 5.64195 51747 89740 D-1,
- * -1.36864 85738 27167 D-7 /
- DATA Q2/ 3.00459 26095 69833 D+2,
- * 7.90950 92532 78980 D+2,
- * 9.31354 09485 06096 D+2,
- * 6.38980 26446 56312 D+2,
- * 2.77585 44474 39876 D+2,
- * 7.70001 52935 22947 D+1,
- * 1.27827 27319 62942 D+1 /
- DATA P3/-2.99610 70770 35422 D-3,
- * -4.94730 91062 32507 D-2,
- * -2.26956 59353 96869 D-1,
- * -2.78661 30860 96478 D-1,
- * -2.23192 45973 41847 D-2 /
- DATA Q3/ 1.06209 23052 84679 D-2,
- * 1.91308 92610 78298 D-1,
- * 1.05167 51070 67932 D+0,
- * 1.98733 20181 71353 D+0 /
-C
-C ******************************************************************
-C
-#if defined(CERNLIB_NUMLOPRE)
-C STATEMENT FUNCTION.
- ROUND(D)=SNGL(D+(D-DBLE(SNGL(D))))
-C
-C ******************************************************************
-C
-#endif
-C ENTRY ERF.
- LERF=.TRUE.
- T=RX
- A=ABS(T)
- IF (A.GT.XUNIT) THEN
- ERF=SIGN(ONE,T)
- RETURN
- ENDIF
- GO TO 1
-C
-C ENTRY ERFC.
- ENTRY ERFC(RX)
- LERF=.FALSE.
- T=RX
- A=ABS(T)
- IF (T.LT.-XUNIT) THEN
- ERFC=TWO
- RETURN
- ELSEIF (T.GT.XMAX) THEN
- ERFC=ZERO
- RETURN
- ENDIF
-C
-C COMMON CODE.
-C
- 1 S=T**2
- IF (A.LE.ACUT) THEN
-C
-C SET Y=ERF(X).
-C
- Y=T*(P1(1)+S*(P1(2)+S*(P1(3)+S*P1(4))))
- * /(Q1(1)+S*(Q1(2)+S*(Q1(3)+S)))
- IF (LERF) THEN
- ERFX=Y
- ELSE
- ERFCX=ONE-Y
- ENDIF
-C
- ELSE
-C
-C SET Y=ERFC(A).
-C
- IF (A.LE.FOUR) THEN
- Y=EXP(-S)*(P2(1)+A*(P2(2)+A*(P2(3)+A*(P2(4)+A*(P2(5)+
- * A*(P2(6)+A*(P2(7)+A*P2(8))))))))
- * /(Q2(1)+A*(Q2(2)+A*(Q2(3)+A*(Q2(4)+A*(Q2(5)+
- * A*(Q2(6)+A*(Q2(7)+A)))))))
- ELSE
- R=ONE/A
- U=R**2
- Y=R*EXP(-S)*( CONST +
- * U*(P3(1)+U*(P3(2)+U*(P3(3)+U*(P3(4)+U*P3(5)))))
- * /(Q3(1)+U*(Q3(2)+U*(Q3(3)+U*(Q3(4)+U)))) )
- ENDIF
- IF (LERF) THEN
- ERFX=SIGN(ONE-Y,T)
- ELSE
- IF (T.GE.ZERO) THEN
- ERFCX=Y
- ELSE
- ERFCX=TWO-Y
- ENDIF
- ENDIF
-C
- ENDIF
-C
-C TERMINATE.
-C
- IF (LERF) THEN
-#if defined(CERNLIB_NUMHIPRE)
- ERF=ERFX
- ELSE
- ERFC=ERFCX
-#endif
-#if defined(CERNLIB_NUMLOPRE)
- ERF=ROUND(ERFX)
- ELSE
- ERFC=ROUND(ERFCX)
-#endif
- ENDIF
- RETURN
-C
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/c300fort/freq.F b/src/packlib/kernlib/kernnum/obsolete/c300fort/freq.F
deleted file mode 100644
index fc9702b..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/c300fort/freq.F
+++ /dev/null
@@ -1,71 +0,0 @@
-*
-* $Id: freq.F,v 1.1.1.1 1996/02/15 17:48:17 mclareni Exp $
-*
-* $Log: freq.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:17 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- FUNCTION FREQ(RX)
-#if defined(CERNLIB_NUMLOPRE)
- IMPLICIT DOUBLE PRECISION (A-H,O-Z)
- REAL FREQ,RX,ROUND
-#endif
-#if defined(CERNLIB_NUMOWNCODE)
- EXTERNAL ERF,ERFC,DERF,DERFC
-#endif
-C
- DATA CONST/ 0.70710 67811 86548 D0 /
-C ( CONST=SQRT(1/2). )
-C
-#if defined(CERNLIB_NUME2465)
- DATA XMAX/ 75.3 D0 /
-#endif
-#if defined(CERNLIB_NUME293)
- DATA XMAX/ 25.8 D0 /
-#endif
-#if defined(CERNLIB_NUME75)
- DATA XMAX/ 13.0 D0 /
-#endif
-#if defined(CERNLIB_NUME38)
- DATA XMAX/ 8.9 D0 /
-#endif
-#if defined(CERNLIB_NUME999)
- DATA XMAX/ *** NOT AVAILABLE *** /
-#endif
-C ( XMAX=SQRT(-ALOG(RMIN)-10.0), WHERE RMIN IS THE SMALLEST NORMAL-
-C IZED REPRESENTABLE NUMBER. ERFC(XMAX) IS CLOSE TO THE UNDERFLOW
-C THRESHOLD. )
-C
-C ******************************************************************
-C
-#if defined(CERNLIB_NUMLOPRE)
-C STATEMENT FUNCTION.
- ROUND(D)=SNGL(D+(D-DBLE(SNGL(D))))
-C
-C ******************************************************************
-C
-#endif
-#if defined(CERNLIB_NUMHIPRE)
-C START.
- CX=CONST*RX
- IF(CX.LT.-XMAX) THEN
- FREQ=0.
- ELSE
- IF(CX.GE.0.) FREQ=0.5+0.5*ERF(CX)
- IF(CX.LT.0.) FREQ=0.5*ERFC(-CX)
- ENDIF
-#endif
-#if defined(CERNLIB_NUMLOPRE)
-C START.
- CX=CONST*DBLE(RX)
- IF(CX.LT.-XMAX) THEN
- FREQ=0.D0
- ELSE
- IF(CX.GE.0.D0) FREQ = ROUND( 0.5D0 + 0.5D0*DERF(CX) )
- IF(CX.LT.0.D0) FREQ = ROUND( 0.5D0*DERFC(-CX) )
- ENDIF
-#endif
- RETURN
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/c305fort/Imakefile b/src/packlib/kernlib/kernnum/obsolete/c305fort/Imakefile
deleted file mode 100644
index 245645d..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/c305fort/Imakefile
+++ /dev/null
@@ -1,4 +0,0 @@
-SRCS_F= \ @@\
- dgamma.F gamma.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kernnum/obsolete/c305fort/dgamma.F b/src/packlib/kernlib/kernnum/obsolete/c305fort/dgamma.F
deleted file mode 100644
index 56e02ae..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/c305fort/dgamma.F
+++ /dev/null
@@ -1,108 +0,0 @@
-*
-* $Id: dgamma.F,v 1.1.1.1 1996/02/15 17:48:17 mclareni Exp $
-*
-* $Log: dgamma.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:17 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- DOUBLE PRECISION FUNCTION DGAMMA(X)
- LOGICAL MFLAG,RFLAG
- REAL SX
- DOUBLE PRECISION X,U,F,ZERO,ONE,THREE,FOUR,PI
- DOUBLE PRECISION C(0:24),H,ALFA,B0,B1,B2
- DATA ZERO /0.0D0/, ONE /1.0D0/, THREE /3.0D0/, FOUR /4.0D0/
-#if defined(CERNLIB_NUMHIPRE)
- DATA NC /24/
- DATA PI /3.14159 26535 89793 23846 26433 83D0/
- DATA C( 0) /3.65738 77250 83382 43849 88068 39D0/
- DATA C( 1) /1.95754 34566 61268 26928 33742 26D0/
- DATA C( 2) / .33829 71138 26160 38915 58510 73D0/
- DATA C( 3) / .04208 95127 65575 49198 51083 97D0/
- DATA C( 4) / .00428 76504 82129 08770 04289 08D0/
- DATA C( 5) / .00036 52121 69294 61767 02198 22D0/
- DATA C( 6) / .00002 74006 42226 42200 27170 66D0/
- DATA C( 7) / .00000 18124 02333 65124 44603 05D0/
- DATA C( 8) / .00000 01096 57758 65997 06993 06D0/
- DATA C( 9) / .00000 00059 87184 04552 00046 95D0/
- DATA C(10) / .00000 00003 07690 80535 24777 71D0/
- DATA C(11) / .00000 00000 14317 93029 61915 76D0/
- DATA C(12) / .00000 00000 00651 08773 34803 70D0/
- DATA C(13) / .00000 00000 00025 95849 89822 28D0/
- DATA C(14) / .00000 00000 00001 10789 38922 59D0/
- DATA C(15) / .00000 00000 00000 03547 43620 17D0/
- DATA C(16) / .00000 00000 00000 00168 86075 04D0/
- DATA C(17) / .00000 00000 00000 00002 73543 58D0/
- DATA C(18) / .00000 00000 00000 00000 30297 74D0/
- DATA C(19) /-.00000 00000 00000 00000 00571 22D0/
- DATA C(20) / .00000 00000 00000 00000 00090 77D0/
- DATA C(21) /-.00000 00000 00000 00000 00005 05D0/
- DATA C(22) / .00000 00000 00000 00000 00000 41D0/
- DATA C(23) /-.00000 00000 00000 00000 00000 03D0/
- DATA C(24) / .00000 00000 00000 00000 00000 01D0/
-#endif
-#if defined(CERNLIB_NUMLOPRE)
- DATA NC /15/
- DATA PI /3.14159 26535 89793 24D0/
- DATA C( 0) /3.65738 77250 83382 44D0/
- DATA C( 1) /1.95754 34566 61268 27D0/
- DATA C( 2) / .33829 71138 26160 39D0/
- DATA C( 3) / .04208 95127 65575 49D0/
- DATA C( 4) / .00428 76504 82129 09D0/
- DATA C( 5) / .00036 52121 69294 62D0/
- DATA C( 6) / .00002 74006 42226 42D0/
- DATA C( 7) / .00000 18124 02333 65D0/
- DATA C( 8) / .00000 01096 57758 66D0/
- DATA C( 9) / .00000 00059 87184 05D0/
- DATA C(10) / .00000 00003 07690 81D0/
- DATA C(11) / .00000 00000 14317 93D0/
- DATA C(12) / .00000 00000 00651 09D0/
- DATA C(13) / .00000 00000 00025 96D0/
- DATA C(14) / .00000 00000 00001 11D0/
- DATA C(15) / .00000 00000 00000 04D0/
-#endif
- U=X
- IF(X .LE. ZERO) THEN
- IF(X .EQ. INT(X)) THEN
- CALL KERMTR('C305.1',LGFILE,MFLAG,RFLAG)
- IF(MFLAG) THEN
- SX=X
- IF(LGFILE .EQ. 0) THEN
- WRITE(*,100) SX
- ELSE
- WRITE(LGFILE,100) SX
- END IF
- END IF
- IF(.NOT.RFLAG) CALL ABEND
- DGAMMA=ZERO
- RETURN
- ELSE
- U=ONE-U
- END IF
- END IF
- F=ONE
- IF(U .LT. THREE) THEN
- DO 1 I = 1,INT(FOUR-U)
- F=F/U
- 1 U=U+ONE
- ELSE
- DO 2 I = 1,INT(U-THREE)
- U=U-ONE
- 2 F=F*U
- END IF
- U=U-THREE
- H=U+U-ONE
- ALFA=H+H
- B1=ZERO
- B2=ZERO
- DO 3 I = NC,0,-1
- B0=C(I)+ALFA*B1-B2
- B2=B1
- 3 B1=B0
- U=F*(B0-H*B2)
- IF(X .LT. ZERO) U=PI/(SIN(PI*X)*U)
- DGAMMA=U
- RETURN
- 100 FORMAT(1X,'DGAMMA ... ARGUMENT IS NON-POSITIVE INTEGER = ',E15.1)
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/c305fort/gamma.F b/src/packlib/kernlib/kernnum/obsolete/c305fort/gamma.F
deleted file mode 100644
index 4c260e9..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/c305fort/gamma.F
+++ /dev/null
@@ -1,89 +0,0 @@
-*
-* $Id: gamma.F,v 1.1.1.1 1996/02/15 17:48:17 mclareni Exp $
-*
-* $Log: gamma.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:17 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- REAL FUNCTION GAMMA(X)
- LOGICAL MFLAG,RFLAG
- REAL X
-#if defined(CERNLIB_NUMHIPRE)
- REAL U,V,F,ZERO,ONE,THREE,FOUR,PI,D
- REAL C(0:15),H,ALFA,B0,B1,B2
- DATA ZERO /0.0/, ONE /1.0/, THREE /3.0/, FOUR /4.0/
-#endif
-#if defined(CERNLIB_NUMLOPRE)
- DOUBLE PRECISION U,V,F,ZERO,ONE,THREE,FOUR,PI,D
- DOUBLE PRECISION C(0:15),H,ALFA,B0,B1,B2
- DATA ZERO /0.0D0/, ONE /1.0D0/, THREE /3.0D0/, FOUR /4.0D0/
-#endif
- DATA PI /3.14159 26535 89793 24D0/
- DATA C( 0) /3.65738 77250 83382 44D0/
- DATA C( 1) /1.95754 34566 61268 27D0/
- DATA C( 2) / .33829 71138 26160 39D0/
- DATA C( 3) / .04208 95127 65575 49D0/
- DATA C( 4) / .00428 76504 82129 09D0/
- DATA C( 5) / .00036 52121 69294 62D0/
- DATA C( 6) / .00002 74006 42226 42D0/
- DATA C( 7) / .00000 18124 02333 65D0/
- DATA C( 8) / .00000 01096 57758 66D0/
- DATA C( 9) / .00000 00059 87184 05D0/
- DATA C(10) / .00000 00003 07690 81D0/
- DATA C(11) / .00000 00000 14317 93D0/
- DATA C(12) / .00000 00000 00651 09D0/
- DATA C(13) / .00000 00000 00025 96D0/
- DATA C(14) / .00000 00000 00001 11D0/
- DATA C(15) / .00000 00000 00000 04D0/
-#if defined(CERNLIB_NUMHIPRE)
- ROUND(D) = D
-#endif
-#if defined(CERNLIB_NUMLOPRE)
- ROUND(D) = SNGL(D+(D-DBLE(SNGL(D))))
-#endif
- U=X
- V=U
- IF(X .LE. ZERO) THEN
- IF(X .EQ. INT(X)) THEN
- CALL KERMTR('C305.1',LGFILE,MFLAG,RFLAG)
- IF(MFLAG) THEN
- IF(LGFILE .EQ. 0) THEN
- WRITE(*,100) X
- ELSE
- WRITE(LGFILE,100) X
- END IF
- END IF
- IF(.NOT.RFLAG) CALL ABEND
- GAMMA=ZERO
- RETURN
- ELSE
- U=ONE-U
- END IF
- END IF
- F=ONE
- IF(U .LT. THREE) THEN
- DO 1 I = 1,INT(FOUR-U)
- F=F/U
- 1 U=U+ONE
- ELSE
- DO 2 I = 1,INT(U-THREE)
- U=U-ONE
- 2 F=F*U
- END IF
- U=U-THREE
- H=U+U-ONE
- ALFA=H+H
- B1=ZERO
- B2=ZERO
- DO 3 I = 15,0,-1
- B0=C(I)+ALFA*B1-B2
- B2=B1
- 3 B1=B0
- U=F*(B0-H*B2)
- IF(V .LT. ZERO) U=PI/(SIN(PI*V)*U)
- GAMMA=ROUND(U)
- RETURN
- 100 FORMAT(1X,'GAMMA ... ARGUMENT IS NON-POSITIVE INTEGER = ',E15.1)
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/d103fort/Imakefile b/src/packlib/kernlib/kernnum/obsolete/d103fort/Imakefile
deleted file mode 100644
index 2bcb1fc..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/d103fort/Imakefile
+++ /dev/null
@@ -1,4 +0,0 @@
-SRCS_F= \ @@\
- dgauss.F gauss.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kernnum/obsolete/d103fort/dgauss.F b/src/packlib/kernlib/kernnum/obsolete/d103fort/dgauss.F
deleted file mode 100644
index f3638b2..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/d103fort/dgauss.F
+++ /dev/null
@@ -1,126 +0,0 @@
-*
-* $Id: dgauss.F,v 1.1.1.1 1996/02/15 17:48:17 mclareni Exp $
-*
-* $Log: dgauss.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:17 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- DOUBLE PRECISION FUNCTION DGAUSS(F,A,B,EPS)
- DOUBLE PRECISION F,A,B,EPS
- DOUBLE PRECISION W(12),X(12),AA,BB,C1,C2,U,S8,S16,CONST
- LOGICAL MFLAG,RFLAG
- EXTERNAL F
-C
-C ******************************************************************
-C
-C ADAPTIVE DOUBLE PRECISION GAUSSIAN QUADRATURE.
-C
-C DGAUSS IS SET EQUAL TO THE APPROXIMATE VALUE OF THE INTEGRAL OF
-C THE FUNCTION F OVER THE INTERVAL (A,B), WITH ACCURACY PARAMETER
-C EPS.
-C
-C ******************************************************************
-C
-#if defined(CERNLIB_NUMHIPRE)
-C
- DATA W / 0.10122 85362 90376 25915 25313 543D0,
- 1 0.22238 10344 53374 47054 43559 944D0,
- 2 0.31370 66458 77887 28733 79622 020D0,
- 3 0.36268 37833 78361 98296 51504 493D0,
- 4 0.27152 45941 17540 94851 78057 246D-1,
- 5 0.62253 52393 86478 92862 84383 699D-1,
- 6 0.95158 51168 24927 84809 92510 760D-1,
- 7 0.12462 89712 55533 87205 24762 822D0,
- 8 0.14959 59888 16576 73208 15017 305D0,
- 9 0.16915 65193 95002 53818 93120 790D0,
- A 0.18260 34150 44923 58886 67636 680D0,
- B 0.18945 06104 55068 49628 53967 232D0/
-C
- DATA X / 0.96028 98564 97536 23168 35608 686D0,
- 1 0.79666 64774 13626 73959 15539 365D0,
- 2 0.52553 24099 16328 98581 77390 492D0,
- 3 0.18343 46424 95649 80493 94761 424D0,
- 4 0.98940 09349 91649 93259 61541 735D0,
- 5 0.94457 50230 73232 57607 79884 155D0,
- 6 0.86563 12023 87831 74388 04678 977D0,
- 7 0.75540 44083 55003 03389 51011 948D0,
- 8 0.61787 62444 02643 74844 66717 640D0,
- 9 0.45801 67776 57227 38634 24194 430D0,
- A 0.28160 35507 79258 91323 04605 015D0,
- B 0.95012 50983 76374 40185 31933 543D-1/
-#endif
-#if defined(CERNLIB_NUMLOPRE)
- DATA W / 0.10122 85362 90376 259D0,
- 1 0.22238 10344 53374 471D0,
- 2 0.31370 66458 77887 287D0,
- 3 0.36268 37833 78361 983D0,
- 4 0.27152 45941 17540 949D-1,
- 5 0.62253 52393 86478 929D-1,
- 6 0.95158 51168 24927 848D-1,
- 7 0.12462 89712 55533 872D0,
- 8 0.14959 59888 16576 732D0,
- 9 0.16915 65193 95002 538D0,
- A 0.18260 34150 44923 589D0,
- B 0.18945 06104 55068 496D0/
-
- DATA X / 0.96028 98564 97536 232D0,
- 1 0.79666 64774 13626 740D0,
- 2 0.52553 24099 16328 986D0,
- 3 0.18343 46424 95649 805D0,
- 4 0.98940 09349 91649 933D0,
- 5 0.94457 50230 73232 576D0,
- 6 0.86563 12023 87831 744D0,
- 7 0.75540 44083 55003 034D0,
- 8 0.61787 62444 02643 748D0,
- 9 0.45801 67776 57227 386D0,
- A 0.28160 35507 79258 913D0,
- B 0.95012 50983 76374 402D-1/
-#endif
-C
-C ******************************************************************
-C
-C START.
- DGAUSS=0.0D0
- IF(B.EQ.A) RETURN
- CONST=0.005D0/(B-A)
- BB=A
-C
-C COMPUTATIONAL LOOP.
- 1 AA=BB
- BB=B
- 2 C1=0.5D0*(BB+AA)
- C2=0.5D0*(BB-AA)
- S8=0.0D0
- DO 3 I=1,4
- U=C2*X(I)
- S8=S8+W(I)*(F(C1+U)+F(C1-U))
- 3 CONTINUE
- S8=C2*S8
- S16=0.0D0
- DO 4 I=5,12
- U=C2*X(I)
- S16=S16+W(I)*(F(C1+U)+F(C1-U))
- 4 CONTINUE
- S16=C2*S16
- IF( ABS(S16-S8) .LE. EPS*(1.+ABS(S16)) ) GO TO 5
- BB=C1
- IF( 1.D0+ABS(CONST*C2) .NE. 1.D0) GO TO 2
- DGAUSS=0.0D0
- CALL KERMTR('D103.1',LGFILE,MFLAG,RFLAG)
- IF(MFLAG) THEN
- IF(LGFILE.EQ.0) THEN
- WRITE(*,6)
- ELSE
- WRITE(LGFILE,6)
- ENDIF
- ENDIF
- IF(.NOT. RFLAG) CALL ABEND
- RETURN
- 5 DGAUSS=DGAUSS+S16
- IF(BB.NE.B) GO TO 1
- RETURN
-C
- 6 FORMAT( 4X, 'FUNCTION DGAUSS ... TOO HIGH ACCURACY REQUIRED')
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/d103fort/gauss.F b/src/packlib/kernlib/kernnum/obsolete/d103fort/gauss.F
deleted file mode 100644
index 740ee0b..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/d103fort/gauss.F
+++ /dev/null
@@ -1,98 +0,0 @@
-*
-* $Id: gauss.F,v 1.1.1.1 1996/02/15 17:48:17 mclareni Exp $
-*
-* $Log: gauss.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:17 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- FUNCTION GAUSS(F,A,B,EPS)
- LOGICAL MFLAG,RFLAG
- EXTERNAL F
- DIMENSION W(12),X(12)
-C
-C ******************************************************************
-C
-C ADAPTIVE GAUSSIAN QUADRATURE.
-C
-C GAUSS IS SET EQUAL TO THE APPROXIMATE VALUE OF THE INTEGRAL OF
-C THE FUNCTION F OVER THE INTERVAL (A,B), WITH ACCURACY PARAMETER
-C EPS.
-C
-C ******************************************************************
-C
-#if defined(CERNLIB_NUMHIPRE)
-C (DECIMAL CONSTANTS HAVE MAXIMUM CDC NO-DIAGNOSTIC PRECISION.)
-C
- DATA W
- */1.01228536290376E-01, 2.22381034453374E-01, 3.1370664587789 E-01,
- * 3.6268378337836 E-01, 2.71524594117541E-02, 6.2253523938648 E-02,
- * 9.5158511682493 E-02, 1.24628971255534E-01, 1.49595988816577E-01,
- * 1.69156519395003E-01, 1.82603415044924E-01, 1.89450610455069E-01/
-C
- DATA X
- */9.6028985649754 E-01, 7.9666647741363 E-01, 5.2553240991633 E-01,
- * 1.83434642495650E-01, 9.8940093499165 E-01, 9.4457502307323 E-01,
- * 8.6563120238783 E-01, 7.5540440835500 E-01, 6.1787624440264 E-01,
- * 4.5801677765723 E-01, 2.8160355077926 E-01, 9.5012509837637 E-02/
-#endif
-#if defined(CERNLIB_NUMLOPRE)
- DATA W
- */1.01228536E-01, 2.22381034E-01, 3.13706646E-01,
- * 3.62683783E-01, 2.71524594E-02, 6.22535239E-02,
- * 9.51585117E-02, 1.24628971E-01, 1.49595989E-01,
- * 1.69156519E-01, 1.82603415E-01, 1.89450610E-01/
-
- DATA X
- */9.60289856E-01, 7.96666477E-01, 5.25532410E-01,
- * 1.83434642E-01, 9.89400935E-01, 9.44575023E-01,
- * 8.65631202E-01, 7.55404408E-01, 6.17876244E-01,
- * 4.58016778E-01, 2.81603551E-01, 9.50125098E-02/
-#endif
-C
-C ******************************************************************
-C
-C START.
- GAUSS=0.
- IF(B.EQ.A) RETURN
- CONST=0.005/(B-A)
- BB=A
-C
-C COMPUTATIONAL LOOP.
- 1 AA=BB
- BB=B
- 2 C1=0.5*(BB+AA)
- C2=0.5*(BB-AA)
- S8=0.
- DO 3 I=1,4
- U=C2*X(I)
- S8=S8+W(I)*(F(C1+U)+F(C1-U))
- 3 CONTINUE
- S8=C2*S8
- S16=0.
- DO 4 I=5,12
- U=C2*X(I)
- S16=S16+W(I)*(F(C1+U)+F(C1-U))
- 4 CONTINUE
- S16=C2*S16
- IF( ABS(S16-S8) .LE. EPS*(1.+ABS(S16)) ) GO TO 5
- BB=C1
- IF( 1.+ABS(CONST*C2) .NE. 1. ) GO TO 2
- GAUSS=0.
- CALL KERMTR('D103.1',LGFILE,MFLAG,RFLAG)
- IF(MFLAG) THEN
- IF(LGFILE.EQ.0) THEN
- WRITE(*,6)
- ELSE
- WRITE(LGFILE,6)
- ENDIF
- ENDIF
- IF(.NOT. RFLAG) CALL ABEND
- RETURN
- 5 GAUSS=GAUSS+S16
- IF(BB.NE.B) GO TO 1
- RETURN
-C
- 6 FORMAT( 4X, 'FUNCTION GAUSS ... TOO HIGH ACCURACY REQUIRED')
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/e106fort/equats.inc b/src/packlib/kernlib/kernnum/obsolete/e106fort/equats.inc
deleted file mode 100644
index 43a4849..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/e106fort/equats.inc
+++ /dev/null
@@ -1,63 +0,0 @@
-*
-* $Id: equats.inc,v 1.1.1.1 1996/02/15 17:48:33 mclareni Exp $
-*
-* $Log: equats.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:33 mclareni
-* Kernlib
-*
-*
-#ifndef CERNLIB_KERNNUM_EQUATS_INC
-#define CERNLIB_KERNNUM_EQUATS_INC
-*
-*
-* equats.inc
-*
-#if defined(CERNLIB_QMIBMVF)
-#if defined(CERNLIB_IBM)
-GT EQU 2
-LT EQU 4
-NE EQU 7
-EQ EQU 8
-GE EQU 10
-LE EQU 12
-G0 EQU 0
-G1 EQU 1
-G2 EQU 2
-G3 EQU 3
-G4 EQU 4
-G5 EQU 5
-G6 EQU 6
-G7 EQU 7
-G8 EQU 8
-G9 EQU 9
-G10 EQU 10
-G11 EQU 11
-G12 EQU 12
-G13 EQU 13
-G14 EQU 14
-G15 EQU 15
-F0 EQU 0
-F2 EQU 2
-F4 EQU 4
-F6 EQU 6
-V0 EQU 0
-V1 EQU 1
-V2 EQU 2
-V3 EQU 3
-V4 EQU 4
-V5 EQU 5
-V6 EQU 6
-V7 EQU 7
-V8 EQU 8
-V9 EQU 9
-V10 EQU 10
-V11 EQU 11
-V12 EQU 12
-V13 EQU 13
-V14 EQU 14
-V15 EQU 15
-*
-#endif
-#endif
-
-#endif
diff --git a/src/packlib/kernlib/kernnum/obsolete/e106fort/exitg.inc b/src/packlib/kernlib/kernnum/obsolete/e106fort/exitg.inc
deleted file mode 100644
index d28888f..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/e106fort/exitg.inc
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: exitg.inc,v 1.1.1.1 1996/02/15 17:48:33 mclareni Exp $
-*
-* $Log: exitg.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:33 mclareni
-* Kernlib
-*
-*
-#ifndef CERNLIB_KERNNUM_EXITG_INC
-#define CERNLIB_KERNNUM_EXITG_INC
-*
-*
-* exitg.inc
-*
-#if defined(CERNLIB_QMIBMVF)
-#if defined(CERNLIB_IBM)
- LM 2,12,28(13)
- BR 14
-#endif
-#endif
-
-#endif
diff --git a/src/packlib/kernlib/kernnum/obsolete/e106fort/locatf.s b/src/packlib/kernlib/kernnum/obsolete/e106fort/locatf.s
deleted file mode 100644
index 690638a..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/e106fort/locatf.s
+++ /dev/null
@@ -1,217 +0,0 @@
-*
-* $Id: locatf.s,v 1.1.1.1 1996/02/15 17:48:33 mclareni Exp $
-*
-* $Log: locatf.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:33 mclareni
-* Kernlib
-*
-*
-#if defined(CERNLIB_QMIBMVF)
-* ** last mod 2 Oct 1990 15:06:51
-LOCATF CSECT vector version of locatf
-* tuned for 3090E cern
-* section size 128
-#if defined(CERNLIB_QMIBMXA)
-LOCATF AMODE 31
-LOCATF RMODE ANY
-#endif
-*****************************************************************
- PRINT NOGEN vector version of locatf
- USING *,15 tuned for 3090E CERN
- STM 14,12,12(13) (section size 128)
-*--------------------------
-KSECT EQU 128
-*****************************************************************
- LM G4,G6,0(G1) get addresses
- LE F0,0(G6) get object
- L G5,0(G5) get length
- SR G0,G0 zero g0 for work
-*--------------------------
- C G5,K64 comp length with 64
- BL L64 if lt 64 go to L64
-*====================
- S G5,K4096 comp length with 4096
- BM P32 if lt 4096 go to p32
- S G5,K4096 comp length with 8192
- BM P64 if lt 8192 go to p64
- B PSCAV else go to pscav
-*====================
-P32 EQU * vector length lt 4096
- A G5,K4064 reset to length-32
- LA G8,32(G5) copy G5 in G8 (length)
- LR G11,G4 copy array address
-*====================
- LA G4,KSECT(G4) add 128 (32 words) to begin addr
- LA G7,32 set G7 to stride (32)
-*====================
- SR G6,G6 zero G6 for work
-****************** vector loop
- SRL G8,5 divide length by 32
-VLOOP EQU * vector loop on full vector
- VLVCU G8 with stride = 32
- VCES LE,F0,G4(G7) search object
- VCZVM G6 count left zero in vmr
- BC 8,NF if none go to nf
- SLL G6,5 mult sum by 32 (stride)
- B NEXTK go to seq search
-*====================
-NF EQU * not found in sect
- LTR G8,G8 test vector length
- BC 2,VLOOP if some more loop
- LR G6,G5 set g6 to length-32
-NEXTK EQU * seq search with length = 32
- LR G7,G6 copy k-1
- SLL G6,2 (k-1)*4
- AR G11,G6 array(k) address
- LR G3,G11 copy array address
-****** SR G0,G0 zero g0 for work
-****************** seq search
- VLVCA 32(0) with length=32
- VCES LE,F0,G3 search object
- VCZVM G0 count left zeros (n-1)
- LR G2,G0 copy count in G2
- SLL G2,2 mult by 4 (convert to addr)
- AR G0,G7 add displ
- CE F0,0(G11,G2) comp object for equal
- BE EQUAL if eq branch
- LCR G0,G0 set (n-1) = -(n-1)
- LM 2,12,28(13)
- BR 14
-* END SUBROUTINE *********** seq search
-EQUAL A G0,K1 set value to n
- LM 2,12,28(13)
- BR 14
-* END SUBROUTINE *********** seq search
-* no sectionning ************
-L64 EQU * no sect length le 32
- LR G3,G4 get array addr
- VLVCU G5 set vector length (le.64)
- VCES LE,F0,G3 search onject
- VCZVM G0 count left zeros (n-1)
- LR G2,G0 copy count in G2
- SLL G2,2 mult by 4 (convert to addr)
- CE F0,0(G4,G2) comp object for equal
- BE EQL64 if eq branch
- LCR G0,G0 if ne set (n-1)= -(n-1)
- LM 2,12,28(13) reset
- BR 14 return
-* END SUBROUTINE ***********
-EQL64 A G0,K1 set value to n
- LM 2,12,28(13) reset
- BR 14 return
-* END SUBROUTINE ***********
-*****************************************************************
-PSCAV EQU *
- A G5,K8192 RESET G5 VALUE (LENGTH)
-**** SR G0,G0 zero g0 for work
- SR G1,G1 nbel=0
- LA G5,1(G5) nab = length + 1
-DIX EQU *
- LR G6,G5 copy nab
- SR G6,G1 g7 = (nab-nbel)
- C G6,K128
- BNH VECT then go vector (one sect max)
- LR G12,G5 copy nab in g12
- AR G12,G1 g12 = (nab+nbel)
- SRL G12,1 g12 = (nab+nbel)/2
- LR G11,G12 copy mid in g11
- BCTR G12,0 mid-1
- SLL G12,2 (mid-1)*4 for addressing
- CE F0,0(G4,G12) if(object-array(mid)) 100,180,140
- BE EQU 180
- BL MINUS 100
-PLUS EQU * 140
- LR G1,G11 nbel=mid
- B DIX go to dix
-MINUS EQU * 100
- LR G5,G11 nab=mid
- B DIX go to dix
-EQU LR G0,G11 locata=mid 180
-#include "exitg.inc"
-VECT LR G8,G1 get nbel
- SLL G8,2 g8 = (nbel+1)*4
- AR G8,G4 g8=array(nbel+1)
- LR G9,G8 g9=g8=array(nbel+1)
- VLVCU G6 vect length= (nab-nbel)
- VCES LE,F0,G8 search object
- VCZVM G0 get loc
- BC 8,NFS
- LR G2,G0 copy in g2
- SLL G2,2 mult by 4
- CE F0,0(G9,G2) comp object array(loc)
- BE EQUV
- AR G0,G1 locata=loc+nbel
- LCR G0,G0 locata= - locata
-#include "exitg.inc"
-EQUV AR G0,G1
- A G0,K1 locata=loc+nbel
-#include "exitg.inc"
-NFS S G0,K1 LOCATA= - LOCATA
- AR G0,G1 locata=loc+nbel
- LCR G0,G0 locata= - locata
-#include "exitg.inc"
-*****************************************************************
-*====================
-P64 EQU *
- A G5,K8128 reset G5 to length-64
- LA G8,64(G5) copy length in G8
- LR G11,G4 copy array address
-*====================
- LA G4,256(G4) add 256 (64 words) to begin addr
- LA G7,64 set G7 to stride (64)
-*====================
- SR G6,G6 zero G6 for work
-****************** vector loop
- SRL G8,6 divide length by 64
-VL64 EQU * vector loop on full vector
- VLVCU G8 with stride = 64
- VCES LE,F0,G4(G7) search object
- VCZVM G6 count left zero in vmr
- BC 8,NF64
- SLL G6,6 mult sum by 64 (stride)
- B SEQ64
-*====================
-NF64 EQU * not found in sect
- LTR G8,G8 test vector count
- BC 2,VL64 if some more loop
- LR G6,G5 set g6 to length-64
-SEQ64 EQU * seq search with length = 64
- LR G7,G6 copy k-1
- SLL G6,2 (k-1)*4
- AR G11,G6 array(k) address
- LR G3,G11 copy array address
-**** SR G0,G0 zero g0 for work
-****************** seq search
- VLVCA 64(0) with length=64
- VCES LE,F0,G3 search object
- VCZVM G0 count left zeros (n-1)
- LR G2,G0 copy count in G2
- SLL G2,2 mult by 4 (convert to addr)
- AR G0,G7 add displ
- CE F0,0(G11,G2) comp object for equal
- BE EQ64 if eq branch
- LCR G0,G0 set (n-1) = -(n-1)
- LM 2,12,28(13)
- BR 14
-* END SUBROUTINE *********** seq search
-EQ64 A G0,K1 set value to n
- LM 2,12,28(13)
- BR 14
-* END SUBROUTINE *********** seq search
-*====================
- DS 0D
-K1 DC F'1'
-K32 DC F'32'
-K48 DC F'48'
-K64 DC F'64'
-K128 DC F'128'
-K2048 DC F'2048'
-K3072 DC F'3072'
-K4064 DC F'4064'
-K4096 DC F'4096'
-K6144 DC F'6144'
-K8128 DC F'8128'
-K8192 DC F'8192'
-#include "equats.inc"
- END
-#endif
diff --git a/src/packlib/kernlib/kernnum/obsolete/e106fort/locati.s b/src/packlib/kernlib/kernnum/obsolete/e106fort/locati.s
deleted file mode 100644
index 5256df7..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/e106fort/locati.s
+++ /dev/null
@@ -1,215 +0,0 @@
-*
-* $Id: locati.s,v 1.1.1.1 1996/02/15 17:48:33 mclareni Exp $
-*
-* $Log: locati.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:33 mclareni
-* Kernlib
-*
-*
-#if defined(CERNLIB_QMIBMVF)
-* ** last mod 2 Oct 1990 15:00:59
-LOCATI CSECT vector version of locati
-* tuned for 3090E CERN
-* section size 128
-#if defined(CERNLIB_QMIBMXA)
-LOCATI AMODE 31
-LOCATI RMODE ANY
-#endif
-*****************************************************************
- PRINT NOGEN vector version of locati
- USING *,15 tuned for 3090E CERN
-*--------------------------
-KSECT EQU 128 (section size 128)
-*--------------------------
- STM 14,12,12(13)
-*****************************************************************
- LM G4,G6,0(G1) get addresses
-** LE F0,0(G6) get object
- L G1,0(G6) get object
- L G5,0(G5) get length
- SR G0,G0 zero g0 for work
-*--------------------------
- C G5,K64 comp length with 64
- BL L64 if lt 64 go to L64
-*====================
- S G5,K4096 comp length with 4096
- BM P32 if lt 4096 go to p32
- S G5,K4096 comp length with 8192
- BM P64 if lt 8192 go to p64
- B PSCAV else go to pscav
-*====================
-P32 EQU * vector length lt 4096
- A G5,K4064 reset to length-32
- LA G8,32(G5) copy G5 in G8 (length)
- LR G11,G4 copy array address
-*====================
- LA G4,KSECT(G4) add 128 (32 words) to begin addr
- LA G7,32 set G7 to stride (32)
-*====================
- SR G6,G6 zero G6 for work
-****************** vector loop
- SRL G8,5 divide length by 32
-VLOOP EQU * vector loop on full vector
- VLVCU G8 with stride = 32
- VCS LE,G1,G4(G7) search object
- VCZVM G6 count left zero in vmr
- BC 8,NF if none go to nf
- SLL G6,5 mult sum by 32 (stride)
- B NEXTK go to seq search
-*====================
-NF EQU * not found in sect
- LTR G8,G8 test vector length
- BC 2,VLOOP if some more loop
- LR G6,G5 set g6 to length-32
-NEXTK EQU * seq search with length = 32
- LR G7,G6 copy k-1
- SLL G6,2 (k-1)*4
- AR G11,G6 array(k) address
- LR G3,G11 copy array address
-****************** seq search
- VLVCA 32(0) with length=32
- VCS LE,G1,G3 search object
- VCZVM G0 count left zeros (n-1)
- LR G2,G0 copy count in G2
- SLL G2,2 mult by 4 (convert to addr)
- AR G0,G7 add displ
- C G1,0(G11,G2) comp object for equal
- BE EQUAL if eq branch
- LCR G0,G0 set (n-1) = -(n-1)
- LM 2,12,28(13)
- BR 14
-* END SUBROUTINE *********** seq search
-EQUAL A G0,K1 set value to n
- LM 2,12,28(13)
- BR 14
-* END SUBROUTINE *********** seq search
-* no sectionning ************
-L64 EQU * no sect length le 32
- LR G3,G4 get array addr
- VLVCU G5 set vector length (le.64)
- VCS LE,G1,G3 search object
- VCZVM G0 count left zeros (n-1)
- LR G2,G0 copy count in G2
- SLL G2,2 mult by 4 (convert to addr)
- C G1,0(G4,G2) comp object for equal
- BE EQL64 if eq branch
- LCR G0,G0 if ne set (n-1)= -(n-1)
- LM 2,12,28(13) reset
- BR 14 return
-* END SUBROUTINE ***********
-EQL64 A G0,K1 set value to n
- LM 2,12,28(13) reset
- BR 14 return
-* END SUBROUTINE ***********
-*****************************************************************
-PSCAV EQU *
- A G5,K8192 RESET G5 VALUE (LENGTH)
- SR G3,G3 nbel=0
- LA G5,1(G5) nab = length + 1
-DIX EQU *
- LR G6,G5 copy nab
- SR G6,G3 g7 = (nab-nbel)
- C G6,K128
- BNH VECT then go vector (one sect max)
- LR G12,G5 copy nab in g12
- AR G12,G3 g12 = (nab+nbel)
- SRL G12,1 g12 = (nab+nbel)/2
- LR G11,G12 copy mid in g11
- BCTR G12,0 mid-1
- SLL G12,2 (mid-1)*4 for addressing
- C G1,0(G4,G12) if(object-array(mid)) 100,180,140
- BE EQU 180
- BL MINUS 100
-PLUS EQU * 140
- LR G3,G11 nbel=mid
- B DIX go to dix
-MINUS EQU * 100
- LR G5,G11 nab=mid
- B DIX go to dix
-EQU LR G0,G11 locata=mid 180
-#include "exitg.inc"
-VECT LR G8,G3 get nbel
- SLL G8,2 g8 = (nbel+1)*4
- AR G8,G4 g8=array(nbel+1)
- LR G9,G8 g9=g8=array(nbel+1)
- VLVCU G6 vect length= (nab-nbel)
- VCS LE,G1,G8 search object
- VCZVM G0 get loc
- BC 8,NFS
- LR G2,G0 copy in g2
- SLL G2,2 mult by 4
- C G1,0(G9,G2) comp object array(loc)
- BE EQUV
- AR G0,G3 locata=loc+nbel
- LCR G0,G0 locata= - locata
-#include "exitg.inc"
-EQUV AR G0,G3
- A G0,K1 locata=loc+nbel
-#include "exitg.inc"
-NFS S G0,K1 LOCATA= - LOCATA
- AR G0,G3 locata=loc+nbel
- LCR G0,G0 locata= - locata
-#include "exitg.inc"
-*****************************************************************
-*====================
-P64 EQU *
- A G5,K8128 reset G5 to length-64
- LA G8,64(G5) copy length in G8
- LR G11,G4 copy array address
-*====================
- LA G4,256(G4) add 256 (64 words) to begin addr
- LA G7,64 set G7 to stride (64)
-*====================
- SR G6,G6 zero G6 for work
-****************** vector loop
- SRL G8,6 divide length by 64
-VL64 EQU * vector loop on full vector
- VLVCU G8 with stride = 64
- VCS LE,G1,G4(G7) search object
- VCZVM G6 count left zero in vmr
- BC 8,NF64
- SLL G6,6 mult sum by 64 (stride)
- B SEQ64
-*====================
-NF64 EQU * not found in sect
- LTR G8,G8 test vector count
- BC 2,VL64 if some more loop
- LR G6,G5 set g6 to length-64
-SEQ64 EQU * seq search with length = 64
- LR G7,G6 copy k-1
- SLL G6,2 (k-1)*4
- AR G11,G6 array(k) address
- LR G3,G11 copy array address
-**** SR G0,G0 zero g0 for work
-****************** seq search
- VLVCA 64(0) with length=64
- VCS LE,G1,G3 search object
- VCZVM G0 count left zeros (n-1)
- LR G2,G0 copy count in G2
- SLL G2,2 mult by 4 (convert to addr)
- AR G0,G7 add displ
- C G1,0(G11,G2) comp object for equal
- BE EQ64 if eq branch
- LCR G0,G0 set (n-1) = -(n-1)
- LM 2,12,28(13)
- BR 14
-* END SUBROUTINE *********** seq search
-EQ64 A G0,K1 set value to n
- LM 2,12,28(13)
- BR 14
-* END SUBROUTINE *********** seq search
-*====================
- DS 0D
-K1 DC F'1'
-K32 DC F'32'
-K48 DC F'48'
-K64 DC F'64'
-K128 DC F'128'
-K2048 DC F'2048'
-K4064 DC F'4064'
-K4096 DC F'4096'
-K8128 DC F'8128'
-K8192 DC F'8192'
-#include "equats.inc"
- END
-#endif
diff --git a/src/packlib/kernlib/kernnum/obsolete/e208cd/llsq.inc b/src/packlib/kernlib/kernnum/obsolete/e208cd/llsq.inc
deleted file mode 100644
index 6f9b47d..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/e208cd/llsq.inc
+++ /dev/null
@@ -1,38 +0,0 @@
-*
-* $Id: llsq.inc,v 1.1.1.1 1996/02/15 17:47:59 mclareni Exp $
-*
-* $Log: llsq.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:47:59 mclareni
-* Kernlib
-*
-*
-*
-* llsq.inc
-*
-*CALL BASIC
-*CALL LSQ
- MAIN MACRO N,I,J,ONE
- HEADER LLSQ
- EXIT LLSQ (N,X,Y,C1,C2,IFAIL)
- + SA2 X1 X2=N A2=(N)
- S_ONE 1 ONE=1
- SA4 A1+ONE X4=(X) A4=((X))
- SX6 -2 X6=-2 (=IFAIL IF N<2)
- SA5 A4+ONE X5=(Y) A5=((Y))
- S_I A5+ONE I=((C1))
- S_N X2 N=N
- LE N,ONE,FAIL2 IF N<2
- RVLLSQ FAIL1,N,X4,ONE,X5,ONE,J X6=C1, X7=C2
- SA1 I X1=(C1) A1=((C1))
- SA2 I+ONE X2=(C2) A2=((C2))
- SA3 A2+ONE X3=(IFAIL) A3=((IFAIL))
- SA6 X1 C1=C1
- MX6 0 X6=0 (=IFAIL IF O.K.)
- SA7 X2 C2=C2
- SA6 X3 IFAIL=0
- EPILOG
- FAIL1 SX6 -1 X6=-1 (=IFAIL IF DET .LE. 0)
- FAIL2 SA3 I+2 X3=(IFAIL) A3=((IFAIL))
- SA6 X3 IFAIL=-1,-2
- JP EPILOG
- ENDM
diff --git a/src/packlib/kernlib/kernnum/obsolete/e208cd/llsq.s b/src/packlib/kernlib/kernnum/obsolete/e208cd/llsq.s
deleted file mode 100644
index 396a6d2..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/e208cd/llsq.s
+++ /dev/null
@@ -1,14 +0,0 @@
-*
-* $Id: llsq.s,v 1.1.1.1 1996/02/15 17:47:59 mclareni Exp $
-*
-* $Log: llsq.s,v $
-* Revision 1.1.1.1 1996/02/15 17:47:59 mclareni
-* Kernlib
-*
-*
-*ADDFILE
-*DECK E208CDC
- IDENT LLSQ
-#include "llsq.inc"
- MAIN B1,B2,B3,B4
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/e208cd/lsq.inc b/src/packlib/kernlib/kernnum/obsolete/e208cd/lsq.inc
deleted file mode 100644
index 30eabd7..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/e208cd/lsq.inc
+++ /dev/null
@@ -1,135 +0,0 @@
-*
-* $Id: lsq.inc,v 1.1.1.1 1996/02/15 17:47:59 mclareni Exp $
-*
-* $Log: lsq.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:47:59 mclareni
-* Kernlib
-*
-*
-*
-* lsq.inc
-*
-*CALL BASIC
-*CALL SET
-*CALL LSQ
- MAIN MACRO N,M,B,C,I,J,ONE
- LOCAL [10],[30],[100],[900]
- IDIMPAR EQU 20
- EXT LLSQ,RVSUM,RSEQN,E208PR
- HEADER LSQ,SAVEA0
- LLSQAL BSS 0 (N,X,Y,C(1),C(2),IFAIL)
- BSS 1 (N)
- BSS 1 (X)
- BSS 1 (Y)
- BSS 1 (C(1))
- BSS 1 (C(2))
- VFD 60/IFAIL (IFAIL)
- BSSZ 1
- RVSUMAL BSS 0 (N,Y(1),Y(2))
- BSS 1 (N)
- BSS 1 (Y(1))
- BSS 1 (Y(2))
- BSSZ 1
- RSEQNAL BSS 0 (M,B,IDIM,IFAIL,1,C)
- BSS 1 (M)
- VFD 60/ARRAYB (B)
- VFD 60/IDIM (IDIM)
- VFD 60/IFAIL (IFAIL)
- VFD 60/INT1 (1)
- BSS 1 (C)
- BSSZ 1
- E208PRAL BSS 0 (N,M,IDIM)
- BSS 1 (N)
- BSS 1 (M)
- VFD 60/IDIM (IDIM)
- BSSZ 1
- IFAIL BSS 1
- IDIM CON IDIMPAR
- INT1 CON 1
- FLOATN BSS 1 FLOAT(N)
- ARRAYB BSS IDIMPAR*IDIMPAR
- EXIT LSQ (N,X,Y,M,C)
-* X1=(N) A1=((N))
- SA4 A1+3 X4=(M) A4=((M))
- SA2 X1 X2=N A2=(N)
- SX7 A0 X7=OLD A0
- S_ONE 1 ONE=1
- SA0 A1 A0=((N))
- SA5 A4+ONE X5=(C) A5=((C))
- SA3 A4-ONE X3=(Y) A3=((Y))
- SA4 X4 X4=M A4=(M)
- SA7 SAVEA0 SAVE OLD A0
- SA1 A1+ONE X1=(X) A1=((X))
- S_B ARRAYB B=(B)
- S_N X2 N=N
- S_C X5 C=(C)
- S_J ONE+ONE J=2
- S_M X4 M=M
- GT M,J,[30] IF M>2
- LT M,J,[10] IF M<2
- SA2 A0 X2=(N) A2=((N))
- BX6 X1 X6=(X)
- BX7 X3 X7=(Y)
- SA6 LLSQAL+1 STORE (X)
- BX6 X2 X6=(N)
- SA7 A6+ONE STORE (Y)
- SA6 A6-ONE STORE (N)
- SX7 C X7=(C(1))
- SX6 C+ONE X6=(C(2))
- SA7 A7+ONE STORE (C(1))
- SA6 A7+ONE XTORE (C(2))
- SA1 LLSQAL X1=(N) A1=((N))
- + RJ LLSQ CALL LLSQ(N,X,Y,C(1),C(2),IFAIL)
- - VFD 12/0,18/TWORD
- JP [100]
- [10] BSS 0
- LT M,ONE,[900] IF M<1
- LT N,ONE,[900] IF N<1
- SA2 A0 X2=(N) A2=((N))
- SX6 N X6=N
- PX6 X6
- NX6 X6 X6=FLOAT(N)
- BX7 X2 X7=(N)
- SA6 FLOATN STORE FLOAT(N)
- SA7 RVSUMAL STORE (N)
- SX6 X3 X6=(Y(1))
- SX7 X3+ONE X7=(Y(2))
- SA6 A7+ONE STORE (Y(1))
- SA7 A6+ONE STORE (Y(2))
- SA1 RVSUMAL
- + RJ RVSUM X6=RVSUM(N,Y(1),Y(2))
- - VFD 12/0,18/TWORD
- SA1 FLOATN X1=FLOAT(N)
- SA2 A0+4 X2=(C(1))
- RX6 X6/X1 X6=RVSUM/FLOAT(N)=C(1)
- SA6 X2 STORE C(1)
- JP EPILOG
- [30] BSS 0
- S_J IDIMPAR J=IDIM
- GT M,N,[900] IF M>N
- GT M,J,[900] IF M>IDIM
- RLSQP N,M,B,C,I,J,ONE X1=(X), X3=(Y)
- SA2 A0+3 X2=(M)
- SA3 A0+4 X3=(C)
- SX6 X2 X6=(M)
- SX7 X3 X7=(C)
- SA6 RSEQNAL STORE (M)
- SA7 RSEQNAL+5 STORE (C)
- SA1 RSEQNAL
- + RJ RSEQN CALL RSEQN(M,B,IDIM,IFAIL,1,C)
- - VFD 12/0,18/TWORD
- [100] BSS 0
- SA5 IFAIL X5=IFAIL
- ZR X5,EPILOG IF(IFAIL .EQ. 0) RETURN
- [900] BSS 0
- SA2 A0 X2=(N) A2=((N))
- SA3 A0+3 X3=(M) A3=((M))
- BX6 X2 X6=(N)
- BX7 X3 X7=(M)
- SA6 E208PRAL STORE (N)
- SA7 E208PRAL+1 STORE (M)
- SA1 E208PRAL
- + RJ E208PR CALL E208PR(N,M,IDIM)
- - VFD 12/0,18/TWORD
- EPILOG
- ENDM
diff --git a/src/packlib/kernlib/kernnum/obsolete/e208cd/lsq.s b/src/packlib/kernlib/kernnum/obsolete/e208cd/lsq.s
deleted file mode 100644
index dfabb2c..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/e208cd/lsq.s
+++ /dev/null
@@ -1,13 +0,0 @@
-*
-* $Id: lsq.s,v 1.1.1.1 1996/02/15 17:47:59 mclareni Exp $
-*
-* $Log: lsq.s,v $
-* Revision 1.1.1.1 1996/02/15 17:47:59 mclareni
-* Kernlib
-*
-*
- IDENT LSQ
-#include "lsq.inc"
- DUMMY EQU 13
- MAIN B1,B2,B3,B4,B5,B6,B7
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002cd/cvcpy.s b/src/packlib/kernlib/kernnum/obsolete/f002cd/cvcpy.s
deleted file mode 100644
index 2e015d4..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002cd/cvcpy.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: cvcpy.s,v 1.1.1.1 1996/02/15 17:48:01 mclareni Exp $
-*
-* $Log: cvcpy.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:01 mclareni
-* Kernlib
-*
-*
- IDENT CVCPY
-#include "vcpy.inc"
- MAIN CTYPE,B1,B2,B3,B4
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002cd/cvmpa.s b/src/packlib/kernlib/kernnum/obsolete/f002cd/cvmpa.s
deleted file mode 100644
index 7d5f838..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002cd/cvmpa.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: cvmpa.s,v 1.1.1.1 1996/02/15 17:48:02 mclareni Exp $
-*
-* $Log: cvmpa.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:02 mclareni
-* Kernlib
-*
-*
- IDENT CVMPA
-#include "vmpa.inc"
- MAIN CTYPE,B1,B2,B3,B4
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002cd/cvmpy.s b/src/packlib/kernlib/kernnum/obsolete/f002cd/cvmpy.s
deleted file mode 100644
index 0dd0984..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002cd/cvmpy.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: cvmpy.s,v 1.1.1.1 1996/02/15 17:48:02 mclareni Exp $
-*
-* $Log: cvmpy.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:02 mclareni
-* Kernlib
-*
-*
- IDENT CVMPY
-#include "vmpy.inc"
- MAIN CTYPE,B1,B2,B3,B4
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002cd/cvmul.s b/src/packlib/kernlib/kernnum/obsolete/f002cd/cvmul.s
deleted file mode 100644
index c68700a..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002cd/cvmul.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: cvmul.s,v 1.1.1.1 1996/02/15 17:48:02 mclareni Exp $
-*
-* $Log: cvmul.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:02 mclareni
-* Kernlib
-*
-*
- IDENT CVMUL
-#include "vmul.inc"
- MAIN CTYPE,B1,B2,B3,B4,B5
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002cd/cvmula.s b/src/packlib/kernlib/kernnum/obsolete/f002cd/cvmula.s
deleted file mode 100644
index 0e26c34..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002cd/cvmula.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: cvmula.s,v 1.1.1.1 1996/02/15 17:48:02 mclareni Exp $
-*
-* $Log: cvmula.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:02 mclareni
-* Kernlib
-*
-*
- IDENT CVMULA
-#include "vmula.inc"
- MAIN CTYPE,MULA,B1,B2,B3,B4,B5,B6
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002cd/cvmuna.s b/src/packlib/kernlib/kernnum/obsolete/f002cd/cvmuna.s
deleted file mode 100644
index 5cb3f10..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002cd/cvmuna.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: cvmuna.s,v 1.1.1.1 1996/02/15 17:48:03 mclareni Exp $
-*
-* $Log: cvmuna.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:03 mclareni
-* Kernlib
-*
-*
- IDENT CVMUNA
-#include "vmula.inc"
- MAIN CTYPE,MUNA,B1,B2,B3,B4,B5,B6
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002cd/cvsca.s b/src/packlib/kernlib/kernnum/obsolete/f002cd/cvsca.s
deleted file mode 100644
index 88faee0..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002cd/cvsca.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: cvsca.s,v 1.1.1.1 1996/02/15 17:48:03 mclareni Exp $
-*
-* $Log: cvsca.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:03 mclareni
-* Kernlib
-*
-*
- IDENT CVSCA
-#include "vsca.inc"
- MAIN CTYPE,SCA,B1,B2,B3,B4,B5,B6
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002cd/cvscl.s b/src/packlib/kernlib/kernnum/obsolete/f002cd/cvscl.s
deleted file mode 100644
index 4543b9d..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002cd/cvscl.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: cvscl.s,v 1.1.1.1 1996/02/15 17:48:04 mclareni Exp $
-*
-* $Log: cvscl.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:04 mclareni
-* Kernlib
-*
-*
- IDENT CVSCL
-#include "vscl.inc"
- MAIN CTYPE,B1,B2,B3,B4,B5,B6
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002cd/cvscs.s b/src/packlib/kernlib/kernnum/obsolete/f002cd/cvscs.s
deleted file mode 100644
index bd0a5de..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002cd/cvscs.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: cvscs.s,v 1.1.1.1 1996/02/15 17:48:04 mclareni Exp $
-*
-* $Log: cvscs.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:04 mclareni
-* Kernlib
-*
-*
- IDENT CVSCS
-#include "vsca.inc"
- MAIN CTYPE,SCS,B1,B2,B3,B4,B5,B6
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002cd/cvxch.s b/src/packlib/kernlib/kernnum/obsolete/f002cd/cvxch.s
deleted file mode 100644
index 42bbc7d..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002cd/cvxch.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: cvxch.s,v 1.1.1.1 1996/02/15 17:48:04 mclareni Exp $
-*
-* $Log: cvxch.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:04 mclareni
-* Kernlib
-*
-*
- IDENT CVXCH
-#include "vxch.inc"
- MAIN CTYPE,B1,B2,B3,B4
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002cd/dvcpy.s b/src/packlib/kernlib/kernnum/obsolete/f002cd/dvcpy.s
deleted file mode 100644
index 56905e5..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002cd/dvcpy.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: dvcpy.s,v 1.1.1.1 1996/02/15 17:48:01 mclareni Exp $
-*
-* $Log: dvcpy.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:01 mclareni
-* Kernlib
-*
-*
- IDENT DVCPY
-#include "vcpy.inc"
- MAIN DTYPE,B1,B2,B3,B4
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002cd/dvmpa.s b/src/packlib/kernlib/kernnum/obsolete/f002cd/dvmpa.s
deleted file mode 100644
index 76bae3c..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002cd/dvmpa.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: dvmpa.s,v 1.1.1.1 1996/02/15 17:48:01 mclareni Exp $
-*
-* $Log: dvmpa.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:01 mclareni
-* Kernlib
-*
-*
- IDENT DVMPA
-#include "vmpa.inc"
- MAIN DTYPE,B1,B2,B3,B4
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002cd/dvmpy.s b/src/packlib/kernlib/kernnum/obsolete/f002cd/dvmpy.s
deleted file mode 100644
index 7e473aa..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002cd/dvmpy.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: dvmpy.s,v 1.1.1.1 1996/02/15 17:48:02 mclareni Exp $
-*
-* $Log: dvmpy.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:02 mclareni
-* Kernlib
-*
-*
- IDENT DVMPY
-#include "vmpy.inc"
- MAIN DTYPE,B1,B2,B3,B4
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002cd/dvsca.s b/src/packlib/kernlib/kernnum/obsolete/f002cd/dvsca.s
deleted file mode 100644
index 7cd4a34..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002cd/dvsca.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: dvsca.s,v 1.1.1.1 1996/02/15 17:48:03 mclareni Exp $
-*
-* $Log: dvsca.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:03 mclareni
-* Kernlib
-*
-*
- IDENT DVSCA
-#include "vsca.inc"
- MAIN DTYPE,SCA,B1,B2,B3,B4,B5,B6
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002cd/dvscl.s b/src/packlib/kernlib/kernnum/obsolete/f002cd/dvscl.s
deleted file mode 100644
index 6e24e89..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002cd/dvscl.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: dvscl.s,v 1.1.1.1 1996/02/15 17:48:04 mclareni Exp $
-*
-* $Log: dvscl.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:04 mclareni
-* Kernlib
-*
-*
- IDENT DVSCL
-#include "vscl.inc"
- MAIN DTYPE,B1,B2,B3,B4,B5,B6
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002cd/dvscs.s b/src/packlib/kernlib/kernnum/obsolete/f002cd/dvscs.s
deleted file mode 100644
index 0179955..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002cd/dvscs.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: dvscs.s,v 1.1.1.1 1996/02/15 17:48:04 mclareni Exp $
-*
-* $Log: dvscs.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:04 mclareni
-* Kernlib
-*
-*
- IDENT DVSCS
-#include "vsca.inc"
- MAIN DTYPE,SCS,B1,B2,B3,B4,B5,B6
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002cd/dvxch.s b/src/packlib/kernlib/kernnum/obsolete/f002cd/dvxch.s
deleted file mode 100644
index d9a524a..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002cd/dvxch.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: dvxch.s,v 1.1.1.1 1996/02/15 17:48:04 mclareni Exp $
-*
-* $Log: dvxch.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:04 mclareni
-* Kernlib
-*
-*
- IDENT DVXCH
-#include "vxch.inc"
- MAIN DTYPE,B1,B2,B3,B4
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002cd/rvadd.s b/src/packlib/kernlib/kernnum/obsolete/f002cd/rvadd.s
deleted file mode 100644
index 119b9ef..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002cd/rvadd.s
+++ /dev/null
@@ -1,14 +0,0 @@
-*
-* $Id: rvadd.s,v 1.1.1.1 1996/02/15 17:48:00 mclareni Exp $
-*
-* $Log: rvadd.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:00 mclareni
-* Kernlib
-*
-*
-*ADDFILE
-*DECK F002CDC
- IDENT RVADD
-#include "vadd.inc"
- MAIN RTYPE,ADD,B1,B2,B3,B4,B5,B6
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002cd/rvcpy.s b/src/packlib/kernlib/kernnum/obsolete/f002cd/rvcpy.s
deleted file mode 100644
index 9a4f3af..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002cd/rvcpy.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: rvcpy.s,v 1.1.1.1 1996/02/15 17:48:01 mclareni Exp $
-*
-* $Log: rvcpy.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:01 mclareni
-* Kernlib
-*
-*
- IDENT RVCPY
-#include "vcpy.inc"
- MAIN RTYPE,B1,B2,B3,B4
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002cd/rvdiv.s b/src/packlib/kernlib/kernnum/obsolete/f002cd/rvdiv.s
deleted file mode 100644
index 62204aa..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002cd/rvdiv.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: rvdiv.s,v 1.1.1.1 1996/02/15 17:48:01 mclareni Exp $
-*
-* $Log: rvdiv.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:01 mclareni
-* Kernlib
-*
-*
- IDENT RVDIV
-#include "vdiv.inc"
- MAIN RTYPE,B1,B2,B3,B4,B5,B6
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002cd/rvmpa.s b/src/packlib/kernlib/kernnum/obsolete/f002cd/rvmpa.s
deleted file mode 100644
index d3227fc..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002cd/rvmpa.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: rvmpa.s,v 1.1.1.1 1996/02/15 17:48:01 mclareni Exp $
-*
-* $Log: rvmpa.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:01 mclareni
-* Kernlib
-*
-*
- IDENT RVMPA
-#include "vmpa.inc"
- MAIN RTYPE,B1,B2,B3,B4
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002cd/rvmpy.s b/src/packlib/kernlib/kernnum/obsolete/f002cd/rvmpy.s
deleted file mode 100644
index 253534f..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002cd/rvmpy.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: rvmpy.s,v 1.1.1.1 1996/02/15 17:48:02 mclareni Exp $
-*
-* $Log: rvmpy.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:02 mclareni
-* Kernlib
-*
-*
- IDENT RVMPY
-#include "vmpy.inc"
- MAIN RTYPE,B1,B2,B3,B4
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002cd/rvmul.s b/src/packlib/kernlib/kernnum/obsolete/f002cd/rvmul.s
deleted file mode 100644
index 9fbf0bb..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002cd/rvmul.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: rvmul.s,v 1.1.1.1 1996/02/15 17:48:02 mclareni Exp $
-*
-* $Log: rvmul.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:02 mclareni
-* Kernlib
-*
-*
- IDENT RVMUL
-#include "vmul.inc"
- MAIN RTYPE,B1,B2,B3,B4,B5
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002cd/rvmula.s b/src/packlib/kernlib/kernnum/obsolete/f002cd/rvmula.s
deleted file mode 100644
index 532d74b..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002cd/rvmula.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: rvmula.s,v 1.1.1.1 1996/02/15 17:48:02 mclareni Exp $
-*
-* $Log: rvmula.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:02 mclareni
-* Kernlib
-*
-*
- IDENT RVMULA
-#include "vmula.inc"
- MAIN RTYPE,MULA,B1,B2,B3,B4,B5,B6
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002cd/rvmuna.s b/src/packlib/kernlib/kernnum/obsolete/f002cd/rvmuna.s
deleted file mode 100644
index b18ca4c..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002cd/rvmuna.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: rvmuna.s,v 1.1.1.1 1996/02/15 17:48:03 mclareni Exp $
-*
-* $Log: rvmuna.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:03 mclareni
-* Kernlib
-*
-*
- IDENT RVMUNA
-#include "vmula.inc"
- MAIN RTYPE,MUNA,B1,B2,B3,B4,B5,B6
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002cd/rvran.s b/src/packlib/kernlib/kernnum/obsolete/f002cd/rvran.s
deleted file mode 100644
index 5068265..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002cd/rvran.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: rvran.s,v 1.1.1.1 1996/02/15 17:48:03 mclareni Exp $
-*
-* $Log: rvran.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:03 mclareni
-* Kernlib
-*
-*
- IDENT RVRAN
-#include "vran.inc"
- MAIN RTYPE,B1,B2,B3,B4
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002cd/rvsca.s b/src/packlib/kernlib/kernnum/obsolete/f002cd/rvsca.s
deleted file mode 100644
index 3210c16..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002cd/rvsca.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: rvsca.s,v 1.1.1.1 1996/02/15 17:48:03 mclareni Exp $
-*
-* $Log: rvsca.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:03 mclareni
-* Kernlib
-*
-*
- IDENT RVSCA
-#include "vsca.inc"
- MAIN RTYPE,SCA,B1,B2,B3,B4,B5,B6
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002cd/rvscl.s b/src/packlib/kernlib/kernnum/obsolete/f002cd/rvscl.s
deleted file mode 100644
index 3493563..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002cd/rvscl.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: rvscl.s,v 1.1.1.1 1996/02/15 17:48:03 mclareni Exp $
-*
-* $Log: rvscl.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:03 mclareni
-* Kernlib
-*
-*
- IDENT RVSCL
-#include "vscl.inc"
- MAIN RTYPE,B1,B2,B3,B4,B5,B6
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002cd/rvscs.s b/src/packlib/kernlib/kernnum/obsolete/f002cd/rvscs.s
deleted file mode 100644
index 010879c..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002cd/rvscs.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: rvscs.s,v 1.1.1.1 1996/02/15 17:48:04 mclareni Exp $
-*
-* $Log: rvscs.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:04 mclareni
-* Kernlib
-*
-*
- IDENT RVSCS
-#include "vsca.inc"
- MAIN RTYPE,SCS,B1,B2,B3,B4,B5,B6
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002cd/rvset.s b/src/packlib/kernlib/kernnum/obsolete/f002cd/rvset.s
deleted file mode 100644
index e9b74ef..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002cd/rvset.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: rvset.s,v 1.1.1.1 1996/02/15 17:48:04 mclareni Exp $
-*
-* $Log: rvset.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:04 mclareni
-* Kernlib
-*
-*
- IDENT RVSET
-#include "vset.inc"
- MAIN RTYPE,B1,B2,B3
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002cd/rvsub.s b/src/packlib/kernlib/kernnum/obsolete/f002cd/rvsub.s
deleted file mode 100644
index dff754f..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002cd/rvsub.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: rvsub.s,v 1.1.1.1 1996/02/15 17:48:04 mclareni Exp $
-*
-* $Log: rvsub.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:04 mclareni
-* Kernlib
-*
-*
- IDENT RVSUB
-#include "vadd.inc"
- MAIN RTYPE,SUB,B1,B2,B3,B4,B5,B6
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002cd/rvsum.s b/src/packlib/kernlib/kernnum/obsolete/f002cd/rvsum.s
deleted file mode 100644
index 6aeb785..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002cd/rvsum.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: rvsum.s,v 1.1.1.1 1996/02/15 17:48:04 mclareni Exp $
-*
-* $Log: rvsum.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:04 mclareni
-* Kernlib
-*
-*
- IDENT RVSUM
-#include "vsum.inc"
- MAIN RTYPE,B1,B2,B3
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002cd/rvxch.s b/src/packlib/kernlib/kernnum/obsolete/f002cd/rvxch.s
deleted file mode 100644
index 58d5f72..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002cd/rvxch.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: rvxch.s,v 1.1.1.1 1996/02/15 17:48:04 mclareni Exp $
-*
-* $Log: rvxch.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:04 mclareni
-* Kernlib
-*
-*
- IDENT RVXCH
-#include "vxch.inc"
- MAIN RTYPE,B1,B2,B3,B4
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002cd/vadd.inc b/src/packlib/kernlib/kernnum/obsolete/f002cd/vadd.inc
deleted file mode 100644
index 18b6c9d..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002cd/vadd.inc
+++ /dev/null
@@ -1,58 +0,0 @@
-*
-* $Id: vadd.inc,v 1.1.1.1 1996/02/15 17:47:59 mclareni Exp $
-*
-* $Log: vadd.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:47:59 mclareni
-* Kernlib
-*
-*
-*
-* vadd.inc
-*
-*CALL BASIC
-*CALL ADD
- ADD SET 1
- SUB SET 2
- MAIN MACRO TYPE,FCN,N,JX,JY,Z,JZ,J
- SETYPE TYPE
- IFEQ FCN,ADD,2
- SIGN MICRO 1,,*+*
- VERB MICRO 1,,*VADD*
- IFEQ FCN,SUB,2
- SIGN MICRO 1,,*-*
- VERB MICRO 1,,*VSUB*
- NAME MICRO 1,,*"P"_"VERB"*
- HEADER "NAME" A0 IS NEITHER USED NOR SAVED
- EXIT "NAME" (N,X,X2,Y,Y2,Z,Z2)
- PROLOG EXIT,N,JX,JY,Z,JZ,J X2=(X) X4=(Y)
- "P"VADD N,JX,"SIGN",JY,Z,JZ,J
- EPILOG
- ENDM
- PROLOG MACRO EXIT,NN,JX,JY,Z,JZ,ONE
- BSS 0 X1=(N) A1=((N)
- + S_ONE 1 0 ONE=1
- SA3 X1 1 X3=N A3=(N)
- SA2 A1+ONE 2 X2=(X) A2=((X))
-* 3
- + SA1 A2+ONE 4 X1=(X2) A1=((X2))
- SA5 A2+4 5 X5=(Z) A5=((Z))
- SA4 A1+ONE 6 X4=(Y) A4=((Y))
-* 7
-* 8 X3
- + S_NN X3 9 X2 NN=N
- SA3 A4+ONE 10 X3=(Y2) A3=((Y2))
-* 11 X1
- LE NN,B0,EXIT X5 IF N.LE.0 EXIT WITH A0 PRESERVED
- + IX0 X1-X2 13 X4 X0=(X2)-(X)
- SA1 A5+ONE 14 X0 X1=(Z2) A1=((Z2))
- S_JX X0 15 JX=(X2)-(X)
- S_Z X5 16 Z=(Z)
-* 17 X3
- + IX3 X3-X4 18 X3=(Y2)-(Y)
-* 19 X3
- S_JY X3 20 JY=(Y2)-(Y)
-* 21 X1
- IX1 X1-X5 22 X1=(Z2)-(Z)
-* 23 X1
- S_JZ X1 24 JZ=(Z2)-(Z)
- PROLOG ENDM X2=(X) X4=(Y)
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002cd/vcpy.inc b/src/packlib/kernlib/kernnum/obsolete/f002cd/vcpy.inc
deleted file mode 100644
index 3593a31..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002cd/vcpy.inc
+++ /dev/null
@@ -1,49 +0,0 @@
-*
-* $Id: vcpy.inc,v 1.1.1.1 1996/02/15 17:47:59 mclareni Exp $
-*
-* $Log: vcpy.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:47:59 mclareni
-* Kernlib
-*
-*
-*
-* vcpy.inc
-*
-*CALL BASIC
-*CALL CPY
- MAIN MACRO TYPE,N,JX,JZ,J
- SETYPE TYPE
- NAME MICRO 1,,*"P"_VCPY_"S"*
- HEADER "NAME" A0 IS NEITHER USED NOR SAVED
- EXIT "NAME" (N,X,X2,Z,Z2)
- PROLOG N,JX,JZ,J
- TAU IFEQ TYPE,CTYPE
- DVCPY N,X0,JX,X1,JZ,J
- TAU ELSE
- "P"VCPY N,X0,JX,X1,JZ,J
- TAU ENDIF
- EPILOG
- ENDM
- PROLOG MACRO NN,JX,JZ,ONE
-* X0=(X)
-* X1=(Y)
-* X5=N
- BSS 0 X1=(N) A1=((N))
- + S_ONE 1 0 ONE=1
- SA5 X1 1 X5=N A5=(N)
- SA3 A1+ONE 2 X3=(X) A3=((X))
- + SA1 A1+3 3 X1=(Z) A1=((Z))
- 4 A1
- SA2 A1+ONE 5 X2=(Z2) A2=((Z2))
- SA4 A3+ONE 6 X4=(X2) A4=((X2))
- 7
- 8 X5
- + S_NN X5 9 X3 NN=N
- BX0 X3 10 X1 X0=(X)
- 11 X0
- LE NN,B0,EXIT X2 IF N.LE.0 EXIT WITH A0 PRESERVED
- + IX6 X2-X1 13 X4 X6=(Z2)-(Z)
- IX7 X4-X3 14 X6 X7=(X2)-(X)
- S_JZ X6 15 X7 JZ=(Z2)-(Z)
- S_JX X7 16 JX=(X2)-(X)
- PROLOG ENDM
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002cd/vdiv.inc b/src/packlib/kernlib/kernnum/obsolete/f002cd/vdiv.inc
deleted file mode 100644
index 6a4a9de..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002cd/vdiv.inc
+++ /dev/null
@@ -1,60 +0,0 @@
-*
-* $Id: vdiv.inc,v 1.1.1.1 1996/02/15 17:47:59 mclareni Exp $
-*
-* $Log: vdiv.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:47:59 mclareni
-* Kernlib
-*
-*
-*
-* vdiv.inc
-*
-*CALL BASIC
-*CALL DIV
- MAIN MACRO TYPE,N,JX,JY,JZ,LFAIL,J
- SETYPE TYPE
- NAME MICRO 1,,*"P"_VDIV*
- HEADER "NAME" A0 IS NEITHER USED NOR SAVED
- EXIT "NAME" (N,X,X2,Y,Y2,Z,Z2,IFAIL)
- PROLOG [2],N,JX,JY,JZ,LFAIL,J IF N=0 GOTO [2]
- "P"VDIV N,X1,JX,X2,JY,X3,JZ,J
- SX6 J X6=IFAIL
- [1] SA6 LFAIL STORE IFAIL IN LFAIL
- EPILOG
- [2] SX6 0 IFAIL=0
- JP [1]
- ENDM
- PROLOG MACRO EX,NN,JX,JY,JZ,LFAIL,ONE
-* X1=(X)
-* X2=(Y)
-* X3=(Z)
- BSS 0 X1=(N) A1=((N))
- + S_ONE 1 0 ONE=1
- SA3 X1 1 X3=N A3=(N)
- SA1 A1+ONE 2 X1=(X) A1=((X))
-* 3
- + SA2 A1+2 4 X2=(Y) A2=((Y))
- SA5 A1+ONE 5 X5=(X2) A5=((X2))
- SA4 A2+ONE 6 X4=(Y2) A4=((Y2))
-* 7
-* 8 X3
- + S_NN X3 9 X1 NN=N
- SA3 A4+ONE 10 X3=(Z) A3=((Z))
-* 11 X2
-* 12 X5
- IX7 X5-X1 13 X4 X7=(X2)-(X)
- SA5 A3+ONE 14 X7 X5=(Z2) A5=((Z2))
- + IX6 X4-X2 15 X6=(Y2)-(Y)
- SA4 A5+ONE 16 X6 X4=(IFAIL) A4=((IFAIL))
- S_JX X7 17 X3 JX=(X2)-(X)
- S_JY X6 18 JY=(Y2)-(Y)
-* 19
-* 20
-* 21 X5
-* 22
- IX7 X5-X3 23 X4 X7=(Z2)-(Z)
- S_LFAIL X4 24 X7 LFAIL=(IFAIL)
- S_JZ X7 25 JZ=(Z2)-(Z)
-* 26
- LE NN,B0,EX 27 IF N.LE.0 EXIT WITH LFAIL SET
- PROLOG ENDM
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002cd/vmaxa.inc b/src/packlib/kernlib/kernnum/obsolete/f002cd/vmaxa.inc
deleted file mode 100644
index bef9d7f..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002cd/vmaxa.inc
+++ /dev/null
@@ -1,47 +0,0 @@
-*
-* $Id: vmaxa.inc,v 1.1.1.1 1996/02/15 17:47:59 mclareni Exp $
-*
-* $Log: vmaxa.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:47:59 mclareni
-* Kernlib
-*
-*
-*
-* vmaxa.inc
-*
-*CALL BASIC
-*CALL MAXA
- MAIN MACRO TYPE,N,JX,L,LOCL,LOCE,K,J
- SETYPE TYPE
- NAME MICRO 1,,*"P"_VMAXA*
- HEADER "NAME" A0 IS NEITHER USED NOR SAVED
- EXIT "NAME" (N,X,X2,L,E)
- PROLOG [2],N,JX,LOCL,LOCE,J
- "P"VMAXA N,JX,L,K,J
- [1] STOREF TYPE,LOCE
- SX6 L
- SA6 LOCL
- EPILOG
- [2] SX6 0 E=0.
- TAU IFEQ LENGTH,2
- SX7 0
- TAU ENDIF
- S_L 0
- JP [1]
- ENDM
- PROLOG MACRO EX,N,JX,LOCL,LOCE,ONE
-* X1=(X)
- BSS 0 X1=(N) A1=((N))
- S_ONE 1 ONE=1
- SA2 A1+3 X2=(L) A2=((L))
- SA3 X1 X3=N A3=(N)
- SA1 A1+ONE X1=(X) A1=((X))
- SA4 A2+ONE X4=(E) A4=((E))
- SA5 A1+ONE X5=(X2) A5=((X2))
- S_LOCL X2 LOCL=(L)
- S_N X3 N=N
- IX6 X5-X1 X6=(X2)-(X)=JX
- S_LOCE X4 LOCE=(E)
- S_JX X6 JX=(X2)-(X)
- LT N,ONE,EX IF N<1
- PROLOG ENDM
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002cd/vmpa.inc b/src/packlib/kernlib/kernnum/obsolete/f002cd/vmpa.inc
deleted file mode 100644
index 92c2d34..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002cd/vmpa.inc
+++ /dev/null
@@ -1,51 +0,0 @@
-*
-* $Id: vmpa.inc,v 1.1.1.1 1996/02/15 17:47:59 mclareni Exp $
-*
-* $Log: vmpa.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:47:59 mclareni
-* Kernlib
-*
-*
-*
-* vmpa.inc
-*
-*CALL BASIC
-*CALL MPY
- MAIN MACRO TYPE,N,JX,JY,J
- SETYPE TYPE
- NAME MICRO 1,,*"P"_VMPA*
- HEADER "NAME" A0 IS NEITHER USED NOR SAVED
- EXIT "NAME" (N,X,X2,Y,Y2,Z)
- PROLOG [2],N,JX,JY,J X4=(X),X3=(Y),X5=(Z)
- "P"VMPY "PLUS",N,X4,JX,X3,JY,"PLUS",X5,J
- [1] EPILOG
- [2] BSS 0 CASE N<1
- SA4 X5 X4=Z'
- IFEQ LENGTH,2,1
- SA5 X5+J X5=Z''
- BX6 X4 X6=Z'
- IFEQ LENGTH,2,1
- BX7 X5 X7=Z''
- JP [1]
- ENDM
- PROLOG MACRO EXIT,NN,JX,JY,ONE X4=(X), X3=(Y), X5=(Z)
- BSS 0 X1=(N) A1=((N))
- + S_ONE 1 0 ONE=1
- SA5 X1 1 X5=N A5=(N)
- SA4 A1+ONE 2 X4=(X) A4=((X))
-* 3
- + SA3 A4+2 4 X3=(Y) A3=((Y))
- SA2 A4+ONE 5 X2=(X2) A2=((X2))
- SA1 A3+ONE 6 X1=(Y2) A1=((Y2))
-* 7
-* 8 X5
- + S_NN X5 9 X4 NN=N
- SA5 A1+ONE 10 X5=(Z) A5=((Z))
-* 11 X3
- LE NN,B0,EXIT X2 IF N .LE. 0 EXIT WITH A0 PRESERVED
- + IX7 X2-X4 13 X1 X7=(X2)-(X)
- IX6 X1-X3 14 X7 X6=(Y2)-(Y)
- S_JX X7 15 X6 JX=(X2)-(X)
- S_JY X6 16 JY=(Y2)-(Y)
- 17
- PROLOG ENDM
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002cd/vmpy.inc b/src/packlib/kernlib/kernnum/obsolete/f002cd/vmpy.inc
deleted file mode 100644
index 8f69f19..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002cd/vmpy.inc
+++ /dev/null
@@ -1,49 +0,0 @@
-*
-* $Id: vmpy.inc,v 1.1.1.1 1996/02/15 17:47:59 mclareni Exp $
-*
-* $Log: vmpy.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:47:59 mclareni
-* Kernlib
-*
-*
-*
-* vmpy.inc
-*
-*CALL BASIC
-*CALL MPY
- MAIN MACRO TYPE,N,JX,JY,J
- SETYPE TYPE
- NAME MICRO 1,,*"P"_VMPY*
- HEADER "NAME" A0 IS NEITHER USED NOR SAVED
- EXIT "NAME" (N,X,X2,Y,Y2)
- PROLOG [2],N,JX,JY,J X0=(X), X1=(Y)
- "P"_VMPY "PLUS",N,X0,JX,X1,JY,"NULL",B0,J
- [1] EPILOG
- [2] MX6 0 TVMPY=0.
- IFEQ LENGTH,2,1
- MX7 0
- JP [1]
- ENDM
- PROLOG MACRO EX,NN,JX,JZ,ONE
-* X0=(X)
-* X1=(Y)
-* X5=N
- BSS 0 X1=(N) A1=((N))
- + S_ONE 1 0 ONE=1
- SA5 X1 1 X5=N A5=(N)
- SA3 A1+ONE 2 X3=(X) A3=((X))
- + SA1 A1+3 3 X1=(Z) A1=((Z))
- 4 A1
- SA2 A1+ONE 5 X2=(Z2) A2=((Z2))
- SA4 A3+ONE 6 X4=(X2) A4=((X2))
- 7
- 8 X5
- + S_NN X5 9 X3 NN=N
- BX0 X3 10 X1 X0=(X)
- 11 X0
- LE NN,B0,EX 12 X2 IF N.LE.0 EXIT WITH A0 PRESERVED
- + IX6 X2-X1 13 X4 X6=(Z2)-(Z)
- IX7 X4-X3 14 X6 X7=(X2)-(X)
- S_JZ X6 15 X7 JZ=(Z2)-(Z)
- S_JX X7 16 JX=(X2)-(X)
- PROLOG ENDM
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002cd/vmul.inc b/src/packlib/kernlib/kernnum/obsolete/f002cd/vmul.inc
deleted file mode 100644
index 8a7538d..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002cd/vmul.inc
+++ /dev/null
@@ -1,50 +0,0 @@
-*
-* $Id: vmul.inc,v 1.1.1.1 1996/02/15 17:47:59 mclareni Exp $
-*
-* $Log: vmul.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:47:59 mclareni
-* Kernlib
-*
-*
-*
-* vmul.inc
-*
-*CALL BASIC
-*CALL MUL
- MAIN MACRO TYPE,N,JX,JY,JZ,J
- SETYPE TYPE
- NAME MICRO 1,,*"P"_VMUL*
- HEADER "NAME" A0 IS NEITHER USED NOR SAVED
- EXIT "NAME" (N,X,X2,Y,Y2,Z,Z2)
- PROLOG EXIT,N,JX,JY,X0,JZ,J X2=(X) X4=(Y)
- "P"VMUL N,JX,JY,JZ,J
- EPILOG
- ENDM
- PROLOG MACRO EXIT,NN,JX,JY,Z,JZ,ONE
- BSS 0 X1=(N) A1=((N)
- + S_ONE 1 0 ONE=1
- SA3 X1 1 X3=N A3=(N)
- SA2 A1+ONE 2 X2=(X) A2=((X))
-* 3
- + SA1 A2+ONE 4 X1=(X2) A1=((X2))
- SA5 A2+4 5 X5=(Z) A5=((Z))
- SA4 A1+ONE 6 X4=(Y) A4=((Y))
-* 7
-* 8 X3
- + S_NN X3 9 X2 NN=N
- SA3 A4+ONE 10 X3=(Y2) A3=((Y2))
-* 11 X1
- LE NN,B0,EXIT X5 IF N.LE.0 EXIT WITH A0 PRESERVED
- + IX0 X1-X2 13 X4 X0=(X2)-(X)
- SA1 A5+ONE 14 X0 X1=(Z2) A1=((Z2))
- S_JX X0 15 JX=(X2)-(X)
- S_Z X5 16 Z=(Z)
-* 17 X3
- + IX3 X3-X4 18 X3=(Y2)-(Y)
-* 19 X3
- S_JY X3 20 JY=(Y2)-(Y)
-* 21 X1
- IX1 X1-X5 22 X1=(Z2)-(Z)
-* 23 X1
- S_JZ X1 24 JZ=(Z2)-(Z)
- PROLOG ENDM X2=(X) X4=(Y)
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002cd/vmula.inc b/src/packlib/kernlib/kernnum/obsolete/f002cd/vmula.inc
deleted file mode 100644
index 53c3caa..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002cd/vmula.inc
+++ /dev/null
@@ -1,67 +0,0 @@
-*
-* $Id: vmula.inc,v 1.1.1.1 1996/02/15 17:48:00 mclareni Exp $
-*
-* $Log: vmula.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:00 mclareni
-* Kernlib
-*
-*
-*
-* vmula.inc
-*
-*CALL BASIC
-*CALL MULA
- MULA SET 1
- MUNA SET 2
- MAIN MACRO TYPE,FCN,N,JX,JY,Z,JZ,J
- SETYPE TYPE
- IFEQ FCN,MULA,2
- SIGN MICRO 1,,*+*
- VERB MICRO 1,,*VMULA*
- IFEQ FCN,MUNA,2
- SIGN MICRO 1,,*-*
- VERB MICRO 1,,*VMUNA*
- NAME MICRO 1,,*"P"_"VERB"*
- IFEQ TYPE,RTYPE,1
- HEADER "NAME" A0 IS NEITHER USED NOR SAVED
- IFEQ TYPE,CTYPE,1
- HEADER "NAME",SAVEA0 A0 IS USED TO HOLD (Z)
- EXIT "NAME" (N,X,X2,Y,Y2,Z,Z2)
- PROLOG EXIT,N,JX,JY,Z,JZ,J X2=(X) X4=(Y)
- IFEQ TYPE,RTYPE,1
- "P"VMULA N,"SIGN",JX,JY,Z,JZ,J
- IFEQ TYPE,CTYPE,4
- SX6 A0
- SA0 Z A0=(Z)
- SA6 SAVEA0 SAVE OLD A0
- "P"VMULA N,"SIGN",JX,JY,JZ,Z,J (Z FOR J, J FOR ONE)
- EPILOG
- ENDM
- PROLOG MACRO EXIT,NN,JX,JY,Z,JZ,ONE
- BSS 0 X1=(N) A1=((N)
- + S_ONE 1 0 ONE=1
- SA3 X1 1 X3=N A3=(N)
- SA2 A1+ONE 2 X2=(X) A2=((X))
-* 3
- + SA1 A2+ONE 4 X1=(X2) A1=((X2))
- SA5 A2+4 5 X5=(Z) A5=((Z))
- SA4 A1+ONE 6 X4=(Y) A4=((Y))
-* 7
-* 8 X3
- + S_NN X3 9 X2 NN=N
- SA3 A4+ONE 10 X3=(Y2) A3=((Y2))
-* 11 X1
- LE NN,B0,EXIT X5 IF N.LE.0 EXIT WITH A0 PRESERVED
- + IX0 X1-X2 13 X4 X0=(X2)-(X)
- SA1 A5+ONE 14 X0 X1=(Z2) A1=((Z2))
- S_JX X0 15 JX=(X2)-(X)
- S_Z X5 16 Z=(Z)
-* 17 X3
- + IX3 X3-X4 18 X3=(Y2)-(Y)
-* 19 X3
- S_JY X3 20 JY=(Y2)-(Y)
-* 21 X1
- IX1 X1-X5 22 X1=(Z2)-(Z)
-* 23 X1
- S_JZ X1 24 JZ=(Z2)-(Z)
- PROLOG ENDM X2=(X) X4=(Y)
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002cd/vran.inc b/src/packlib/kernlib/kernnum/obsolete/f002cd/vran.inc
deleted file mode 100644
index a323b48..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002cd/vran.inc
+++ /dev/null
@@ -1,49 +0,0 @@
-*
-* $Id: vran.inc,v 1.1.1.1 1996/02/15 17:48:00 mclareni Exp $
-*
-* $Log: vran.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:00 mclareni
-* Kernlib
-*
-*
-*
-* vran.inc
-*
-*CALL BASIC
-*CALL RAN
- MAIN MACRO TYPE,N,Z,JZ,J
- SETYPE TYPE
- NAME MICRO 1,,*"P"_VRAN*
- HEADER "NAME" A0 IS NEITHER USED NOR SAVED
- EXT RANDOM. FTN SYSTEM LOCATION OF SEED
- EXIT "NAME"
- PROLOG EXIT,N,Z,JZ,J X4=SEED, X5=MULT
- "P"_VRAN N,Z,JZ,J
- SA7 RANDOM. SAVE OLD SEED
- EPILOG
- ENDM
- PROLOG MACRO EX,NN,Z,JZ,ONE
- BSS 0 X1=(N) A1=((N))
- + SA3 A1+2 X3=(B) A3=((B))
- S_ONE 1 ONE=1
- + SA1 X1 X1=N A1=(N)
- SA4 A3+ONE X4=(Z) A4=((Z))
- SA2 A3-ONE X2=(A) A2=((A))
- SA5 A4+ONE X5=(Z2) A5=((Z2))
- SA3 X3 X3=B A3=(B)
- S_NN X1 NN=N
- S_Z X4 Z=(Z)
- SA2 X2 X2=A A2=(A)
- IX6 X5-X4 X6=(Z2)-(Z)
- SA4 RANDOM. X4=SEED A4=(SEED)
- S_JZ X6 JZ=(Z2)-(Z)
- LE NN,B0,EX IF N.LE.0 EXIT WITH A0 PRESERVED
- SA5 A4+ONE X5=MULT A5=(MULT)
- RX3 X3-X2 X3=B-A=C
- BX0 X2 X0=A
- NX3 X3
-* X0=A
-* X3=C
-* X4=SEED
-* X5=MULT
- PROLOG ENDM
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002cd/vsca.inc b/src/packlib/kernlib/kernnum/obsolete/f002cd/vsca.inc
deleted file mode 100644
index 4c0ba42..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002cd/vsca.inc
+++ /dev/null
@@ -1,62 +0,0 @@
-*
-* $Id: vsca.inc,v 1.1.1.1 1996/02/15 17:48:00 mclareni Exp $
-*
-* $Log: vsca.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:00 mclareni
-* Kernlib
-*
-*
-*
-* vsca.inc
-*
-*CALL BASIC
-*CALL SCA
- SCA SET 1
- SCS SET 2
- MAIN MACRO TYPE,FCN,N,JX,JY,Z,JZ,J
- SETYPE TYPE
- IFEQ FCN,SCA,2
- SIGN MICRO 1,,*+*
- VERB MICRO 1,,*VSCA*
- IFEQ FCN,SCS,2
- SIGN MICRO 1,,*-*
- VERB MICRO 1,,*VSCS*
- NAME MICRO 1,,*"P"_"VERB"*
- HEADER "NAME" A0 IS NEITHER USED NOR SAVED
- EXIT "NAME" (N,S,X,X2,Y,Y2,Z,Z2)
- PROLOG N,JX,JY,Z,JZ,J
- "P"VSCA N,JX,"SIGN",JY,Z,JZ,J
- EPILOG
- ENDM
- PROLOG MACRO NN,JX,JY,Z,JZ,ONE X4=(X) X2=(Y) X1=S OR
-* X0=S' X1=S''
- BSS 0 X1=(N) A1=((N))
- + S_ONE 1 0 ONE=1
- SA5 X1 1 X5=N A5=(N)
- SA1 A1+ONE 2 X1=(S) A1=((S))
-* 3
- + SA2 A1+3 4 X2=(Y) A2=((Y))
- SA4 A1+ONE 5 X4=(X) A4=((X))
- SA3 A2+ONE 6 X3=(Y2) A3=((Y2))
-* 7
-* 8 X5
- + S_NN X5 9 X1 NN=N
- SA5 A4+ONE 10 X5=(X2) A5=((X2))
-* 11 X2
- LE NN,B0,EXIT X4 IF N.LE.0 EXIT WITH A0 PRESERVED
- + SA1 X1 13 X3 X1=S' A1=(S')
- IX7 X3-X2 14 X7=(Y2)-(Y)
- SA3 A3+ONE 15 X7 X3=(Z) A3=((Z))
- S_JY X7 16 JY=(Y2)-(Y)
-* 17 X5
- + IX6 X5-X4 18 X6=(X2)-(X)
- SA5 A3+ONE 19 X6 X5=(Z2) A5=((Z2))
- S_JX X6 20 X1 JX=(X2)-(X)
- TAU IFEQ LENGTH,2 TYPE IS RTYPE OR DTYPE
- BX0 X1 X0=S'
- SA1 A1+ONE X1=S''
- TAU ENDIF
- S_Z X3 Z=(Z)
- IX7 X5-X3 X7=(Z2)-(Z)
- S_JZ X7 JZ=(Z2)-(Z)
- PROLOG ENDM
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002cd/vscl.inc b/src/packlib/kernlib/kernnum/obsolete/f002cd/vscl.inc
deleted file mode 100644
index 2baf2e8..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002cd/vscl.inc
+++ /dev/null
@@ -1,49 +0,0 @@
-*
-* $Id: vscl.inc,v 1.1.1.1 1996/02/15 17:48:00 mclareni Exp $
-*
-* $Log: vscl.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:00 mclareni
-* Kernlib
-*
-*
-*
-* vscl.inc
-*
-*CALL BASIC
-*CALL SCL
- MAIN MACRO TYPE,N,X,JX,Z,JZ,J
- SETYPE TYPE
- NAME MICRO 1,,*"P"_VSCL*
- HEADER "NAME" A0 IS NEITHER USED NOR SAVED
- EXIT "NAME" (N,S,X,X2,Z,Z2)
- PROLOG N,X,JX,Z,JZ,J
- TAU IFEQ LENGTH,2
- SA2 A1+1 X2=S''
- TAU ENDIF
- "P"VSCL N,X,JX,Z,JZ,J
- EPILOG
- ENDM
- PROLOG MACRO NN,X,JX,Y,JY,ONE X1=S, X6=N-1, A1=(S)
- BSS 0 X1=(N) A1=((N))
- + S_ONE 1 0 ONE=1
- SA5 X1 1 X5=N A5=(N)
- SA1 A1+ONE 2 X1=(S) A1=((S))
-* 3
- + SA2 A1+3 4 X2=(Y) A2=((Y))
- SA4 A1+ONE 5 X4=(X) A4=((X))
- SA3 A2+ONE 6 X3=(Y2) A3=((Y2))
-* 7
-* 8 X5
- + S_NN X5 9 X1 NN=N
- SA5 A4+ONE 10 X5=(X2) A5=((X2))
-* 11 X2
- LE NN,B0,EXIT X4 IF N.LE.0 EXIT WITH A0 PRESERVED
- + SA1 X1 13 X3 X1=S A1=(S)
- IX7 X3-X2 14 X7=(Y2)-(Y)
- SX6 NN-ONE 15 X7 X6=N-1
- S_Y X2 16 X6 Y=(Y)
- + S_JY X7 17 X5 JY=(Y2)-(Y)
- IX7 X5-X4 18 X7=(X2)-(X)
- S_X X4 19 X7 X=(X)
- S_JX X7 20 X1 JX=(X2)-(X)
- PROLOG ENDM
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002cd/vset.inc b/src/packlib/kernlib/kernnum/obsolete/f002cd/vset.inc
deleted file mode 100644
index d8d69bd..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002cd/vset.inc
+++ /dev/null
@@ -1,47 +0,0 @@
-*
-* $Id: vset.inc,v 1.1.1.1 1996/02/15 17:48:00 mclareni Exp $
-*
-* $Log: vset.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:00 mclareni
-* Kernlib
-*
-*
-*
-* vset.inc
-*
-*CALL BASIC
-*CALL SET
- MAIN MACRO TYPE,N,JZ,J
- SETYPE TYPE
- NAME MICRO 1,,*"P"_VSET*
- HEADER "NAME" A0 IS NEITHER USED NOR SAVED
- EXIT "NAME"
- PROLOG EXIT,N,JZ X4=(Z), X6=S' [X7=S'']
- "P"VSET N,X4,JZ,J
- EPILOG
- ENDM
- PROLOG MACRO EXIT,NN,JZ
- BSS 0 X1=(N) A1=((N))
- + SA2 A1+1 0 X2=(S) A2=((S))
- SA1 X1 1 X1=N A1=(N)
- NO 2
- + SA4 A2+1 3 X4=(Z) A4=((Z))
- SA5 A2+2 4 X5=(Z2) A5=((Z2))
-* 5
-* 6
-* 7 X2
- TAU IFEQ LENGTH,2
- SA3 X2+1 8 X1 X3=S'' A3=(S'')
- TAU ENDIF
- SA2 X2 9 X2=S' A2=(S')
- S_NN X1 10 X4 NN=N
-* 11 X5
- IX5 X5-X4 12 X5=(Z2)-(Z)
-* 13 X5
- LE NN,B0,EXIT IF N<1 EXIT WITH A0 PRESERVED
- S_JZ X5 15 X3 JZ=(Z2)-(Z)
- TAU IFEQ LENGTH,2
- BX7 X3 16 X2 X7=S''
- TAU ENDIF
- BX6 X2 17 X7 X6=S'
- PROLOG ENDM X4=(Z)
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002cd/vsum.inc b/src/packlib/kernlib/kernnum/obsolete/f002cd/vsum.inc
deleted file mode 100644
index 602a1a9..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002cd/vsum.inc
+++ /dev/null
@@ -1,38 +0,0 @@
-*
-* $Id: vsum.inc,v 1.1.1.1 1996/02/15 17:48:00 mclareni Exp $
-*
-* $Log: vsum.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:00 mclareni
-* Kernlib
-*
-*
-*
-* vsum.inc
-*
-*CALL BASIC
-*CALL SUM
- MAIN MACRO TYPE,N,JX,J
- SETYPE TYPE
- NAME MICRO 1,,*"P"_VSUM*
- HEADER "NAME" A0 IS NEITHER USED NOR SAVED
- EXIT "NAME" (N,X,X2)
- PROLOG EXIT,N,JX X4=X(1) [X5=X''(1)]
- "P"_VSUM N,JX,J X6 [,X7]=SUM
- EPILOG
- ENDM
- PROLOG MACRO EXIT,NN,JX
- BSS 0 X1=(N) A1=((N))
- + SA2 A1+1 X2=(X) A2=((X))
- SA3 A1+2 X3=(X2) A3=((X2))
- + SA1 X1 X1=N A1=(N)
- MX6 0 X6=0.
- SA4 X2 X4=X(1) A4=(X(1))
- IX0 X3-X2 X0=(X2)-(X)
- S_NN X1 NN=N
- TAU IFEQ LENGTH,2
- SA5 X2+1 X5=X''(1) A5=(X''(1))
- MX7 0 X7=0.
- TAU ENDIF
- LE NN,B0,EXIT IF N<1 EXIT WITH X6[,X7]=0.
- S_JX X0 JX=(X2)-(X)
- PROLOG ENDM
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002cd/vxch.inc b/src/packlib/kernlib/kernnum/obsolete/f002cd/vxch.inc
deleted file mode 100644
index 0aaa27a..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002cd/vxch.inc
+++ /dev/null
@@ -1,49 +0,0 @@
-*
-* $Id: vxch.inc,v 1.1.1.1 1996/02/15 17:48:00 mclareni Exp $
-*
-* $Log: vxch.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:00 mclareni
-* Kernlib
-*
-*
-*
-* vxch.inc
-*
-*CALL BASIC
-*CALL XCH
- MAIN MACRO TYPE,N,JX,JY,J
- SETYPE TYPE
- NAME MICRO 1,,*"P"_VXCH_"S"*
- HEADER "NAME" A0 IS NEITHER USED NOR SAVED
- EXIT "NAME" (N,X,X2,Y,Y2)
- PROLOG N,JX,JY,J
- TAU IFEQ TYPE,CTYPE
- DVXCH N,X0,JX,X1,JY,J
- TAU ELSE
- "P"VXCH N,X0,JX,X1,JY,J
- TAU ENDIF
- EPILOG
- ENDM
- PROLOG MACRO NN,JX,JY,ONE
-* X0=(X)
-* X1=(Y)
-* X5=N
- BSS 0 X1=(N) A1=((N))
- + S_ONE 1 0 ONE=1
- SA5 X1 1 X5=N A5=(N)
- SA3 A1+ONE 2 X3=(X) A3=((X))
- + SA1 A1+3 3 X1=(Y) A1=((Y))
- 4 A1
- SA2 A1+ONE 5 X2=(Y2) A2=((Y2))
- SA4 A3+ONE 6 X4=(X2) A4=((X2))
- 7
- 8 X5
- + S_NN X5 9 X3 NN=N
- BX0 X3 10 X1 X0=(X)
- 11 X0
- LE NN,B0,EXIT X2 IF N.LE.0 EXIT WITH A0 PRESERVED
- + IX6 X2-X1 13 X4 X6=(Y2)-(Y)
- IX7 X4-X3 14 X6 X7=(X2)-(X)
- S_JY X6 15 X7 JY=(Y2)-(Y)
- S_JX X7 16 JX=(X2)-(X)
- PROLOG ENDM
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002ib/Imakefile b/src/packlib/kernlib/kernnum/obsolete/f002ib/Imakefile
deleted file mode 100644
index cc069b0..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002ib/Imakefile
+++ /dev/null
@@ -1,10 +0,0 @@
-SRCS_S= \ @@\
- cvadd.s cvcpy.s cvdiv.s cvmpa.s cvmpac.s cvmpy.s cvmpyc.s cvmul.s \ @@\
- cvmula.s cvmuna.s cvran.s cvsca.s cvscl.s cvscs.s cvset.s cvsub.s \ @@\
- cvsum.s cvxch.s dvadd.s dvcpy.s dvdiv.s dvmpa.s dvmpy.s dvmul.s \ @@\
- dvmula.s dvmuna.s dvran.s dvsca.s dvscl.s dvscs.s dvset.s dvsub.s \ @@\
- dvsum.s dvxch.s rvadd.s rvcpy.s rvdiv.s rvmpa.s rvmpy.s rvmul.s \ @@\
- rvmula.s rvmuna.s rvran.s rvsca.s rvscl.s rvscs.s rvset.s rvsub.s \ @@\
- rvsum.s rvxch.s
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002ib/cvadd.s b/src/packlib/kernlib/kernnum/obsolete/f002ib/cvadd.s
deleted file mode 100644
index cd1458b..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002ib/cvadd.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: cvadd.s,v 1.1.1.1 1996/02/15 17:48:19 mclareni Exp $
-*
-* $Log: cvadd.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:19 mclareni
-* Kernlib
-*
-*
-#include "kernnum/vadd.inc"
- &TYPE SETA &CTYPE
- &NAME SETC 'VADD '
- MAIN A
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002ib/cvcpy.s b/src/packlib/kernlib/kernnum/obsolete/f002ib/cvcpy.s
deleted file mode 100644
index 78bb231..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002ib/cvcpy.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: cvcpy.s,v 1.1.1.1 1996/02/15 17:48:19 mclareni Exp $
-*
-* $Log: cvcpy.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:19 mclareni
-* Kernlib
-*
-*
-#include "kernnum/vcpy.inc"
- &TYPE SETA &CTYPE
- &NAME SETC 'VCPY '
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002ib/cvdiv.s b/src/packlib/kernlib/kernnum/obsolete/f002ib/cvdiv.s
deleted file mode 100644
index 1a1666b..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002ib/cvdiv.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: cvdiv.s,v 1.1.1.1 1996/02/15 17:48:19 mclareni Exp $
-*
-* $Log: cvdiv.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:19 mclareni
-* Kernlib
-*
-*
-#include "kernnum/vdiv.inc"
- &TYPE SETA &CTYPE
- &NAME SETC 'VDIV '
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002ib/cvmpa.s b/src/packlib/kernlib/kernnum/obsolete/f002ib/cvmpa.s
deleted file mode 100644
index 6f7af92..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002ib/cvmpa.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: cvmpa.s,v 1.1.1.1 1996/02/15 17:48:20 mclareni Exp $
-*
-* $Log: cvmpa.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:20 mclareni
-* Kernlib
-*
-*
-#include "kernnum/vmpy.inc"
- &TYPE SETA &CTYPE
- &NAME SETC 'VMPA '
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002ib/cvmpac.s b/src/packlib/kernlib/kernnum/obsolete/f002ib/cvmpac.s
deleted file mode 100644
index df84178..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002ib/cvmpac.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: cvmpac.s,v 1.1.1.1 1996/02/15 17:48:20 mclareni Exp $
-*
-* $Log: cvmpac.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:20 mclareni
-* Kernlib
-*
-*
-#include "kernnum/vmpy.inc"
- &TYPE SETA &CTYPEC
- &NAME SETC 'VMPAC'
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002ib/cvmpy.s b/src/packlib/kernlib/kernnum/obsolete/f002ib/cvmpy.s
deleted file mode 100644
index 5fd9647..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002ib/cvmpy.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: cvmpy.s,v 1.1.1.1 1996/02/15 17:48:20 mclareni Exp $
-*
-* $Log: cvmpy.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:20 mclareni
-* Kernlib
-*
-*
-#include "kernnum/vmpy.inc"
- &TYPE SETA &CTYPE
- &NAME SETC 'VMPY '
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002ib/cvmpyc.s b/src/packlib/kernlib/kernnum/obsolete/f002ib/cvmpyc.s
deleted file mode 100644
index 4ba7937..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002ib/cvmpyc.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: cvmpyc.s,v 1.1.1.1 1996/02/15 17:48:20 mclareni Exp $
-*
-* $Log: cvmpyc.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:20 mclareni
-* Kernlib
-*
-*
-#include "kernnum/vmpy.inc"
- &TYPE SETA &CTYPEC
- &NAME SETC 'VMPYC'
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002ib/cvmul.s b/src/packlib/kernlib/kernnum/obsolete/f002ib/cvmul.s
deleted file mode 100644
index ae8be2d..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002ib/cvmul.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: cvmul.s,v 1.1.1.1 1996/02/15 17:48:20 mclareni Exp $
-*
-* $Log: cvmul.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:20 mclareni
-* Kernlib
-*
-*
-#include "kernnum/vmul.inc"
- &TYPE SETA &CTYPE
- &NAME SETC 'VMUL '
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002ib/cvmula.s b/src/packlib/kernlib/kernnum/obsolete/f002ib/cvmula.s
deleted file mode 100644
index 7344f1d..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002ib/cvmula.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: cvmula.s,v 1.1.1.1 1996/02/15 17:48:20 mclareni Exp $
-*
-* $Log: cvmula.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:20 mclareni
-* Kernlib
-*
-*
-#include "kernnum/vmula.inc"
- &TYPE SETA &CTYPE
- &NAME SETC 'VMULA'
- MAIN A
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002ib/cvmuna.s b/src/packlib/kernlib/kernnum/obsolete/f002ib/cvmuna.s
deleted file mode 100644
index 31cdae1..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002ib/cvmuna.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: cvmuna.s,v 1.1.1.1 1996/02/15 17:48:20 mclareni Exp $
-*
-* $Log: cvmuna.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:20 mclareni
-* Kernlib
-*
-*
-#include "kernnum/vmula.inc"
- &TYPE SETA &CTYPE
- &NAME SETC 'VMUNA'
- MAIN S
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002ib/cvran.s b/src/packlib/kernlib/kernnum/obsolete/f002ib/cvran.s
deleted file mode 100644
index 18ce3a1..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002ib/cvran.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: cvran.s,v 1.1.1.1 1996/02/15 17:48:20 mclareni Exp $
-*
-* $Log: cvran.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:20 mclareni
-* Kernlib
-*
-*
-#include "kernnum/vran.inc"
- &TYPE SETA &CTYPE
- &NAME SETC 'VRAN '
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002ib/cvsca.s b/src/packlib/kernlib/kernnum/obsolete/f002ib/cvsca.s
deleted file mode 100644
index 4d71721..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002ib/cvsca.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: cvsca.s,v 1.1.1.1 1996/02/15 17:48:20 mclareni Exp $
-*
-* $Log: cvsca.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:20 mclareni
-* Kernlib
-*
-*
-#include "kernnum/vsca.inc"
- &TYPE SETA &CTYPE
- &NAME SETC 'VSCA '
- MAIN A
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002ib/cvscl.s b/src/packlib/kernlib/kernnum/obsolete/f002ib/cvscl.s
deleted file mode 100644
index 3b7f225..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002ib/cvscl.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: cvscl.s,v 1.1.1.1 1996/02/15 17:48:21 mclareni Exp $
-*
-* $Log: cvscl.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:21 mclareni
-* Kernlib
-*
-*
-#include "kernnum/vscl.inc"
- &TYPE SETA &CTYPE
- &NAME SETC 'VSCL '
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002ib/cvscs.s b/src/packlib/kernlib/kernnum/obsolete/f002ib/cvscs.s
deleted file mode 100644
index 53619d8..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002ib/cvscs.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: cvscs.s,v 1.1.1.1 1996/02/15 17:48:21 mclareni Exp $
-*
-* $Log: cvscs.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:21 mclareni
-* Kernlib
-*
-*
-#include "kernnum/vsca.inc"
- &TYPE SETA &CTYPE
- &NAME SETC 'VSCS '
- MAIN S
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002ib/cvset.s b/src/packlib/kernlib/kernnum/obsolete/f002ib/cvset.s
deleted file mode 100644
index 48adf27..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002ib/cvset.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: cvset.s,v 1.1.1.1 1996/02/15 17:48:21 mclareni Exp $
-*
-* $Log: cvset.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:21 mclareni
-* Kernlib
-*
-*
-#include "kernnum/vset.inc"
- &TYPE SETA &CTYPE
- &NAME SETC 'VSET '
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002ib/cvsub.s b/src/packlib/kernlib/kernnum/obsolete/f002ib/cvsub.s
deleted file mode 100644
index 146598d..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002ib/cvsub.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: cvsub.s,v 1.1.1.1 1996/02/15 17:48:21 mclareni Exp $
-*
-* $Log: cvsub.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:21 mclareni
-* Kernlib
-*
-*
-#include "kernnum/vadd.inc"
- &TYPE SETA &CTYPE
- &NAME SETC 'VSUB '
- MAIN S
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002ib/cvsum.s b/src/packlib/kernlib/kernnum/obsolete/f002ib/cvsum.s
deleted file mode 100644
index 7afbcea..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002ib/cvsum.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: cvsum.s,v 1.1.1.1 1996/02/15 17:48:21 mclareni Exp $
-*
-* $Log: cvsum.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:21 mclareni
-* Kernlib
-*
-*
-#include "kernnum/vsum.inc"
- &TYPE SETA &CTYPE
- &NAME SETC 'VSUM '
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002ib/cvxch.s b/src/packlib/kernlib/kernnum/obsolete/f002ib/cvxch.s
deleted file mode 100644
index be491f4..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002ib/cvxch.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: cvxch.s,v 1.1.1.1 1996/02/15 17:48:21 mclareni Exp $
-*
-* $Log: cvxch.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:21 mclareni
-* Kernlib
-*
-*
-#include "kernnum/vxch.inc"
- &TYPE SETA &CTYPE
- &NAME SETC 'VXCH '
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002ib/dvadd.s b/src/packlib/kernlib/kernnum/obsolete/f002ib/dvadd.s
deleted file mode 100644
index d61c8fb..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002ib/dvadd.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: dvadd.s,v 1.1.1.1 1996/02/15 17:48:19 mclareni Exp $
-*
-* $Log: dvadd.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:19 mclareni
-* Kernlib
-*
-*
-#include "kernnum/vadd.inc"
- &TYPE SETA &DTYPE
- &NAME SETC 'VADD '
- MAIN A
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002ib/dvcpy.s b/src/packlib/kernlib/kernnum/obsolete/f002ib/dvcpy.s
deleted file mode 100644
index f8b19f9..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002ib/dvcpy.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: dvcpy.s,v 1.1.1.1 1996/02/15 17:48:19 mclareni Exp $
-*
-* $Log: dvcpy.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:19 mclareni
-* Kernlib
-*
-*
-#include "kernnum/vcpy.inc"
- &TYPE SETA &DTYPE
- &NAME SETC 'VCPY '
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002ib/dvdiv.s b/src/packlib/kernlib/kernnum/obsolete/f002ib/dvdiv.s
deleted file mode 100644
index 0df4d62..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002ib/dvdiv.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: dvdiv.s,v 1.1.1.1 1996/02/15 17:48:19 mclareni Exp $
-*
-* $Log: dvdiv.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:19 mclareni
-* Kernlib
-*
-*
-#include "kernnum/vdiv.inc"
- &TYPE SETA &DTYPE
- &NAME SETC 'VDIV '
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002ib/dvmpa.s b/src/packlib/kernlib/kernnum/obsolete/f002ib/dvmpa.s
deleted file mode 100644
index ddb0164..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002ib/dvmpa.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: dvmpa.s,v 1.1.1.1 1996/02/15 17:48:20 mclareni Exp $
-*
-* $Log: dvmpa.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:20 mclareni
-* Kernlib
-*
-*
-#include "kernnum/vmpy.inc"
- &TYPE SETA &DTYPE
- &NAME SETC 'VMPA '
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002ib/dvmpy.s b/src/packlib/kernlib/kernnum/obsolete/f002ib/dvmpy.s
deleted file mode 100644
index d2433b7..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002ib/dvmpy.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: dvmpy.s,v 1.1.1.1 1996/02/15 17:48:20 mclareni Exp $
-*
-* $Log: dvmpy.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:20 mclareni
-* Kernlib
-*
-*
-#include "kernnum/vmpy.inc"
- &TYPE SETA &DTYPE
- &NAME SETC 'VMPY '
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002ib/dvmul.s b/src/packlib/kernlib/kernnum/obsolete/f002ib/dvmul.s
deleted file mode 100644
index 7833c18..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002ib/dvmul.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: dvmul.s,v 1.1.1.1 1996/02/15 17:48:20 mclareni Exp $
-*
-* $Log: dvmul.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:20 mclareni
-* Kernlib
-*
-*
-#include "kernnum/vmul.inc"
- &TYPE SETA &DTYPE
- &NAME SETC 'VMUL '
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002ib/dvmula.s b/src/packlib/kernlib/kernnum/obsolete/f002ib/dvmula.s
deleted file mode 100644
index 3725eec..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002ib/dvmula.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: dvmula.s,v 1.1.1.1 1996/02/15 17:48:20 mclareni Exp $
-*
-* $Log: dvmula.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:20 mclareni
-* Kernlib
-*
-*
-#include "kernnum/vmula.inc"
- &TYPE SETA &DTYPE
- &NAME SETC 'VMULA'
- MAIN A
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002ib/dvmuna.s b/src/packlib/kernlib/kernnum/obsolete/f002ib/dvmuna.s
deleted file mode 100644
index 25a20d3..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002ib/dvmuna.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: dvmuna.s,v 1.1.1.1 1996/02/15 17:48:20 mclareni Exp $
-*
-* $Log: dvmuna.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:20 mclareni
-* Kernlib
-*
-*
-#include "kernnum/vmula.inc"
- &TYPE SETA &DTYPE
- &NAME SETC 'VMUNA'
- MAIN S
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002ib/dvran.s b/src/packlib/kernlib/kernnum/obsolete/f002ib/dvran.s
deleted file mode 100644
index 385120e..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002ib/dvran.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: dvran.s,v 1.1.1.1 1996/02/15 17:48:20 mclareni Exp $
-*
-* $Log: dvran.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:20 mclareni
-* Kernlib
-*
-*
-#include "kernnum/vran.inc"
- &TYPE SETA &DTYPE
- &NAME SETC 'VRAN '
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002ib/dvsca.s b/src/packlib/kernlib/kernnum/obsolete/f002ib/dvsca.s
deleted file mode 100644
index 936375c..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002ib/dvsca.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: dvsca.s,v 1.1.1.1 1996/02/15 17:48:20 mclareni Exp $
-*
-* $Log: dvsca.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:20 mclareni
-* Kernlib
-*
-*
-#include "kernnum/vsca.inc"
- &TYPE SETA &DTYPE
- &NAME SETC 'VSCA '
- MAIN A
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002ib/dvscl.s b/src/packlib/kernlib/kernnum/obsolete/f002ib/dvscl.s
deleted file mode 100644
index 8d94cf5..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002ib/dvscl.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: dvscl.s,v 1.1.1.1 1996/02/15 17:48:21 mclareni Exp $
-*
-* $Log: dvscl.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:21 mclareni
-* Kernlib
-*
-*
-#include "kernnum/vscl.inc"
- &TYPE SETA &DTYPE
- &NAME SETC 'VSCL '
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002ib/dvscs.s b/src/packlib/kernlib/kernnum/obsolete/f002ib/dvscs.s
deleted file mode 100644
index d766d96..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002ib/dvscs.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: dvscs.s,v 1.1.1.1 1996/02/15 17:48:21 mclareni Exp $
-*
-* $Log: dvscs.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:21 mclareni
-* Kernlib
-*
-*
-#include "kernnum/vsca.inc"
- &TYPE SETA &DTYPE
- &NAME SETC 'VSCS '
- MAIN S
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002ib/dvset.s b/src/packlib/kernlib/kernnum/obsolete/f002ib/dvset.s
deleted file mode 100644
index de711a4..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002ib/dvset.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: dvset.s,v 1.1.1.1 1996/02/15 17:48:21 mclareni Exp $
-*
-* $Log: dvset.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:21 mclareni
-* Kernlib
-*
-*
-#include "kernnum/vset.inc"
- &TYPE SETA &DTYPE
- &NAME SETC 'VSET '
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002ib/dvsub.s b/src/packlib/kernlib/kernnum/obsolete/f002ib/dvsub.s
deleted file mode 100644
index b186987..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002ib/dvsub.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: dvsub.s,v 1.1.1.1 1996/02/15 17:48:21 mclareni Exp $
-*
-* $Log: dvsub.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:21 mclareni
-* Kernlib
-*
-*
-#include "kernnum/vadd.inc"
- &TYPE SETA &DTYPE
- &NAME SETC 'VSUB '
- MAIN S
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002ib/dvsum.s b/src/packlib/kernlib/kernnum/obsolete/f002ib/dvsum.s
deleted file mode 100644
index e111b82..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002ib/dvsum.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: dvsum.s,v 1.1.1.1 1996/02/15 17:48:21 mclareni Exp $
-*
-* $Log: dvsum.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:21 mclareni
-* Kernlib
-*
-*
-#include "kernnum/vsum.inc"
- &TYPE SETA &DTYPE
- &NAME SETC 'VSUM '
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002ib/dvxch.s b/src/packlib/kernlib/kernnum/obsolete/f002ib/dvxch.s
deleted file mode 100644
index 4c951b0..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002ib/dvxch.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: dvxch.s,v 1.1.1.1 1996/02/15 17:48:21 mclareni Exp $
-*
-* $Log: dvxch.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:21 mclareni
-* Kernlib
-*
-*
-#include "kernnum/vxch.inc"
- &TYPE SETA &DTYPE
- &NAME SETC 'VXCH '
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002ib/rvadd.s b/src/packlib/kernlib/kernnum/obsolete/f002ib/rvadd.s
deleted file mode 100644
index a70d2a0..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002ib/rvadd.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: rvadd.s,v 1.1.1.1 1996/02/15 17:48:19 mclareni Exp $
-*
-* $Log: rvadd.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:19 mclareni
-* Kernlib
-*
-*
-#include "kernnum/vadd.inc"
- &TYPE SETA &RTYPE
- &NAME SETC 'VADD '
- MAIN A
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002ib/rvcpy.s b/src/packlib/kernlib/kernnum/obsolete/f002ib/rvcpy.s
deleted file mode 100644
index e75fd3c..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002ib/rvcpy.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: rvcpy.s,v 1.1.1.1 1996/02/15 17:48:19 mclareni Exp $
-*
-* $Log: rvcpy.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:19 mclareni
-* Kernlib
-*
-*
-#include "kernnum/vcpy.inc"
- &TYPE SETA &RTYPE
- &NAME SETC 'VCPY '
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002ib/rvdiv.s b/src/packlib/kernlib/kernnum/obsolete/f002ib/rvdiv.s
deleted file mode 100644
index bd0e31a..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002ib/rvdiv.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: rvdiv.s,v 1.1.1.1 1996/02/15 17:48:19 mclareni Exp $
-*
-* $Log: rvdiv.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:19 mclareni
-* Kernlib
-*
-*
-#include "kernnum/vdiv.inc"
- &TYPE SETA &RTYPE
- &NAME SETC 'VDIV '
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002ib/rvmpa.s b/src/packlib/kernlib/kernnum/obsolete/f002ib/rvmpa.s
deleted file mode 100644
index 2ad2013..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002ib/rvmpa.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: rvmpa.s,v 1.1.1.1 1996/02/15 17:48:20 mclareni Exp $
-*
-* $Log: rvmpa.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:20 mclareni
-* Kernlib
-*
-*
-#include "kernnum/vmpy.inc"
- &TYPE SETA &RTYPE
- &NAME SETC 'VMPA '
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002ib/rvmpy.s b/src/packlib/kernlib/kernnum/obsolete/f002ib/rvmpy.s
deleted file mode 100644
index 2b6a4e8..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002ib/rvmpy.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: rvmpy.s,v 1.1.1.1 1996/02/15 17:48:20 mclareni Exp $
-*
-* $Log: rvmpy.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:20 mclareni
-* Kernlib
-*
-*
-#include "kernnum/vmpy.inc"
- &TYPE SETA &RTYPE
- &NAME SETC 'VMPY '
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002ib/rvmul.s b/src/packlib/kernlib/kernnum/obsolete/f002ib/rvmul.s
deleted file mode 100644
index e9ce1ca..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002ib/rvmul.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: rvmul.s,v 1.1.1.1 1996/02/15 17:48:20 mclareni Exp $
-*
-* $Log: rvmul.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:20 mclareni
-* Kernlib
-*
-*
-#include "kernnum/vmul.inc"
- &TYPE SETA &RTYPE
- &NAME SETC 'VMUL '
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002ib/rvmula.s b/src/packlib/kernlib/kernnum/obsolete/f002ib/rvmula.s
deleted file mode 100644
index 26ef0b4..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002ib/rvmula.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: rvmula.s,v 1.1.1.1 1996/02/15 17:48:20 mclareni Exp $
-*
-* $Log: rvmula.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:20 mclareni
-* Kernlib
-*
-*
-#include "kernnum/vmula.inc"
- &TYPE SETA &RTYPE
- &NAME SETC 'VMULA'
- MAIN A
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002ib/rvmuna.s b/src/packlib/kernlib/kernnum/obsolete/f002ib/rvmuna.s
deleted file mode 100644
index 7882f14..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002ib/rvmuna.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: rvmuna.s,v 1.1.1.1 1996/02/15 17:48:20 mclareni Exp $
-*
-* $Log: rvmuna.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:20 mclareni
-* Kernlib
-*
-*
-#include "kernnum/vmula.inc"
- &TYPE SETA &RTYPE
- &NAME SETC 'VMUNA'
- MAIN S
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002ib/rvran.s b/src/packlib/kernlib/kernnum/obsolete/f002ib/rvran.s
deleted file mode 100644
index 9bf5e46..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002ib/rvran.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: rvran.s,v 1.1.1.1 1996/02/15 17:48:20 mclareni Exp $
-*
-* $Log: rvran.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:20 mclareni
-* Kernlib
-*
-*
-#include "kernnum/vran.inc"
- &TYPE SETA &RTYPE
- &NAME SETC 'VRAN '
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002ib/rvsca.s b/src/packlib/kernlib/kernnum/obsolete/f002ib/rvsca.s
deleted file mode 100644
index 57189c4..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002ib/rvsca.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: rvsca.s,v 1.1.1.1 1996/02/15 17:48:20 mclareni Exp $
-*
-* $Log: rvsca.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:20 mclareni
-* Kernlib
-*
-*
-#include "kernnum/vsca.inc"
- &TYPE SETA &RTYPE
- &NAME SETC 'VSCA '
- MAIN A
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002ib/rvscl.s b/src/packlib/kernlib/kernnum/obsolete/f002ib/rvscl.s
deleted file mode 100644
index e8dbc4c..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002ib/rvscl.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: rvscl.s,v 1.1.1.1 1996/02/15 17:48:20 mclareni Exp $
-*
-* $Log: rvscl.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:20 mclareni
-* Kernlib
-*
-*
-#include "kernnum/vscl.inc"
- &TYPE SETA &RTYPE
- &NAME SETC 'VSCL '
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002ib/rvscs.s b/src/packlib/kernlib/kernnum/obsolete/f002ib/rvscs.s
deleted file mode 100644
index 669126c..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002ib/rvscs.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: rvscs.s,v 1.1.1.1 1996/02/15 17:48:21 mclareni Exp $
-*
-* $Log: rvscs.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:21 mclareni
-* Kernlib
-*
-*
-#include "kernnum/vsca.inc"
- &TYPE SETA &RTYPE
- &NAME SETC 'VSCS '
- MAIN S
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002ib/rvset.s b/src/packlib/kernlib/kernnum/obsolete/f002ib/rvset.s
deleted file mode 100644
index cd1e743..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002ib/rvset.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: rvset.s,v 1.1.1.1 1996/02/15 17:48:21 mclareni Exp $
-*
-* $Log: rvset.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:21 mclareni
-* Kernlib
-*
-*
-#include "kernnum/vset.inc"
- &TYPE SETA &RTYPE
- &NAME SETC 'VSET '
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002ib/rvsub.s b/src/packlib/kernlib/kernnum/obsolete/f002ib/rvsub.s
deleted file mode 100644
index ad3ee52..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002ib/rvsub.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: rvsub.s,v 1.1.1.1 1996/02/15 17:48:21 mclareni Exp $
-*
-* $Log: rvsub.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:21 mclareni
-* Kernlib
-*
-*
-#include "kernnum/vadd.inc"
- &TYPE SETA &RTYPE
- &NAME SETC 'VSUB '
- MAIN S
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002ib/rvsum.s b/src/packlib/kernlib/kernnum/obsolete/f002ib/rvsum.s
deleted file mode 100644
index 57dd683..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002ib/rvsum.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: rvsum.s,v 1.1.1.1 1996/02/15 17:48:21 mclareni Exp $
-*
-* $Log: rvsum.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:21 mclareni
-* Kernlib
-*
-*
-#include "kernnum/vsum.inc"
- &TYPE SETA &RTYPE
- &NAME SETC 'VSUM '
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002ib/rvxch.s b/src/packlib/kernlib/kernnum/obsolete/f002ib/rvxch.s
deleted file mode 100644
index a22003e..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002ib/rvxch.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: rvxch.s,v 1.1.1.1 1996/02/15 17:48:21 mclareni Exp $
-*
-* $Log: rvxch.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:21 mclareni
-* Kernlib
-*
-*
-#include "kernnum/vxch.inc"
- &TYPE SETA &RTYPE
- &NAME SETC 'VXCH '
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002ib/vadd.inc b/src/packlib/kernlib/kernnum/obsolete/f002ib/vadd.inc
deleted file mode 100644
index 6ff6d9d..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002ib/vadd.inc
+++ /dev/null
@@ -1,59 +0,0 @@
-*
-* $Id: vadd.inc,v 1.1.1.1 1996/02/15 17:48:18 mclareni Exp $
-*
-* $Log: vadd.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:18 mclareni
-* Kernlib
-*
-*
-*
-* vadd.inc
-*
-#include "basic.inc"
-#include "add.inc"
- MACRO
- MAIN &F
-#include "global.inc"
- &TWORDS SETA 0
- SETYPE
- HEADER ENTRY (N,X,X2,Y,Y2,Z,Z2)
- J EQU 1
- NSTEP EQU 2
- N EQU 3
- X EQU 4
- JX EQU 5
- Y EQU 6
- JY EQU 7
- Z EQU 8
- JZ EQU 9
- JX2 EQU 10
- JY2 EQU 11
- JZ2 EQU 12
- ®LIM SETA 12
- ENTRY PROLOG
- LM 3,9,0(1)
- * R3 = (N)
- * R4 = (X)
- * R5 = (X2)
- * R6 = (Y)
- * R7 = (Y2)
- * R8 = (Z)
- * R9 = (Z2)
- N 9,=X'7FFFFFFF'
- L N,0(3)
- LA NSTEP,2 NSTEP=2
- C N,=F'0'
- BC LE,RETURN IF(N .LE. 0) RETURN
- SR 5,4 R5 = (X2) - (X) = JX
- SR 7,6 R7 = (Y2) - (Y) = JY
- SR 9,8 R9 = (Z2) - (Z) = JZ
- LR JX2,JX
- LR JY2,JY
- LR JZ2,JZ
- AR JX2,JX JX2 = 2 * JX
- AR JY2,JY JY2 = 2 * JY
- AR JZ2,JZ JZ2 = 2 * JZ
- VADD &F,N,X,JX,Y,JY,Z,JZ,JX2,JY2,JZ2,J
- RETURN EPILOG
- MEND
-#include "tglobal.inc"
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002ib/vcpy.inc b/src/packlib/kernlib/kernnum/obsolete/f002ib/vcpy.inc
deleted file mode 100644
index 5b71e59..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002ib/vcpy.inc
+++ /dev/null
@@ -1,51 +0,0 @@
-*
-* $Id: vcpy.inc,v 1.1.1.1 1996/02/15 17:48:18 mclareni Exp $
-*
-* $Log: vcpy.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:18 mclareni
-* Kernlib
-*
-*
-*
-* vcpy.inc
-*
-#include "basic.inc"
-#include "cpy.inc"
- MACRO
- MAIN
-#include "global.inc"
- &TWORDS SETA 0
- SETYPE
- HEADER ENTRY (N,X,X2,Y,Y2)
- J EQU 1
- NSTEP EQU 2
- N EQU 3
- X EQU 4
- JX EQU 5
- Y EQU 6
- JY EQU 7
- JX2 EQU 8
- JY2 EQU 9
- ®LIM SETA 9
- ENTRY PROLOG
- LM 3,7,0(1)
- * R3 = (N)
- * R4 = (X)
- * R5 = (X2)
- * R6 = (Y)
- * R7 = (Y2)
- N 7,=X'7FFFFFFF'
- L N,0(3)
- LA NSTEP,2 NSTEP = 2
- C N,=F'0'
- BC LE,RETURN IF(N .LE. 0) RETURN
- SR 5,4 R5 = (X2) - (X) = JX
- SR 7,6 R7 = (Y2) - (Y) = JY
- LR JX2,JX
- LR JY2,JY
- AR JX2,JX JX2 = 2 * JX
- AR JY2,JY JY2 = 2 * JY
- VCPY N,X,JX,Y,JY,JX2,JY2,J
- RETURN EPILOG
- MEND
-#include "tglobal.inc"
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002ib/vdiv.inc b/src/packlib/kernlib/kernnum/obsolete/f002ib/vdiv.inc
deleted file mode 100644
index a3c7ec8..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002ib/vdiv.inc
+++ /dev/null
@@ -1,54 +0,0 @@
-*
-* $Id: vdiv.inc,v 1.1.1.1 1996/02/15 17:48:18 mclareni Exp $
-*
-* $Log: vdiv.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:18 mclareni
-* Kernlib
-*
-*
-*
-* vdiv.inc
-*
-#include "basic.inc"
-#include "div.inc"
- MACRO
- MAIN
-#include "global.inc"
- &TWORDS SETA 0
- SETYPE
- HEADER ENTRY (N,X,X2,Y,Y2,Z,Z2,IFAIL)
- J EQU 1
- NSTEP EQU 2
- N EQU 3
- X EQU 4
- JX EQU 5
- Y EQU 6
- JY EQU 7
- Z EQU 8
- JZ EQU 9
- IFAIL EQU 10
- ®LIM SETA 10
- ENTRY PROLOG
- LM 3,10,0(1)
- * R3 = (N)
- * R4 = (X)
- * R5 = (X2)
- * R6 = (Y)
- * R7 = (Y2)
- * R8 = (Z)
- * R9 = (Z2)
- * R10= (IFAIL)
- N 10,=X'7FFFFFFF'
- LA J,0 IFAIL=0
- L N,0(3)
- LA NSTEP,1 NSTEP = 1
- C N,=F'0'
- BC LE,RETURN IF(N .LE. 0) RETURN
- SR 5,4 R5 = (X2) - (X) = JX
- SR 7,6 R7 = (Y2) - (Y) = JY
- SR 9,8 R9 = (Z2) - (Z) = JZ
- VDIV N,X,JX,Y,JY,Z,JZ,J
- RETURN ST J,0(IFAIL) IFAIL = J
- EPILOG
- MEND
-#include "tglobal.inc"
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002ib/vmpy.inc b/src/packlib/kernlib/kernnum/obsolete/f002ib/vmpy.inc
deleted file mode 100644
index 76adbb5..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002ib/vmpy.inc
+++ /dev/null
@@ -1,63 +0,0 @@
-*
-* $Id: vmpy.inc,v 1.1.1.1 1996/02/15 17:48:18 mclareni Exp $
-*
-* $Log: vmpy.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:18 mclareni
-* Kernlib
-*
-*
-*
-* vmpy.inc
-*
-#include "basic.inc"
-#include "mpy.inc"
- MACRO
- MAIN
-#include "global.inc"
- &TWORDS SETA 0
- SETYPE
- HEADER ENTRY
- JY2 EQU 2
- N EQU 3
- X EQU 4
- JX EQU 5
- Y EQU 6
- JY EQU 7
- JX2 EQU 8
- ®LIM SETA 8
- ENTRY PROLOG
- AIF ('&NAME' EQ 'VMPA ').BETA
- AIF ('&NAME' EQ 'VMPAC').BETA
- LM 3,7,0(1)
- * R3 = (N)
- * R4 = (X)
- * R5 = (X2)
- * R6 = (Y)
- * R7 = (Y2)
- N 7,=X'7FFFFFFF'
- CLEAR 0
- AGO .GAMMA
- .BETA ANOP
- LM 3,8,0(1)
- * R3 = (N)
- * R4 = (X)
- * R5 = (X2)
- * R6 = (Y)
- * R7 = (Y2)
- * R8 = (Z)
- N 8,=X'7FFFFFFF'
- LOAD 0,8
- .GAMMA ANOP
- L N,0(3)
- C N,=F'0'
- BNH RETURN IF(N .LE. 0) RETURN
- SR 5,4 R5 = (X2) - (X1) = JX
- SR 7,6 R7 = (Y2) - (Y1) = JY
- LR JX2,JX
- LR JY2,JY
- AR JX2,JX JX2 = 2 * JX
- AR JY2,JY JY2 = 2 * JY
- VMPY N,X,JX,Y,JY,JX2,JY2
- RETURN EPILOG
- MEND
-#include "tglobal.inc"
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002ib/vmul.inc b/src/packlib/kernlib/kernnum/obsolete/f002ib/vmul.inc
deleted file mode 100644
index 231c312..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002ib/vmul.inc
+++ /dev/null
@@ -1,59 +0,0 @@
-*
-* $Id: vmul.inc,v 1.1.1.1 1996/02/15 17:48:18 mclareni Exp $
-*
-* $Log: vmul.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:18 mclareni
-* Kernlib
-*
-*
-*
-* vmul.inc
-*
-#include "basic.inc"
-#include "mul.inc"
- MACRO
- MAIN
-#include "global.inc"
- &TWORDS SETA 0
- SETYPE
- HEADER ENTRY
- J EQU 1
- NSTEP EQU 2
- N EQU 3
- X EQU 4
- JX EQU 5
- Y EQU 6
- JY EQU 7
- Z EQU 8
- JZ EQU 9
- JX2 EQU 10
- JY2 EQU 11
- JZ2 EQU 12
- ®LIM SETA 12
- ENTRY PROLOG
- LM 3,9,0(1)
- * R3 = (N)
- * R4 = (X)
- * R5 = (X2)
- * R6 = (Y)
- * R7 = (Y2)
- * R8 = (Z)
- * R9 = (Z2)
- N 9,=X'7FFFFFFF'
- L N,0(3)
- LA NSTEP,2 NSTEP = 2
- C N,=F'0'
- BC LE,RETURN IF(N .LE. 0) RETURN
- SR 5,4 R5 = (X2) - (X) = JX
- SR 7,6 R7 = (Y2) - (Y) = JY
- SR 9,8 R9 = (Z2) - (Z) = JZ
- LR JX2,JX
- LR JY2,JY
- LR JZ2,JZ
- AR JX2,JX JX2 = 2*JX
- AR JY2,JY JY2 = 2*JY
- AR JZ2,JZ JZ2 = 2*JZ
- VMUL N,X,JX,Y,JY,Z,JZ,JX2,JY2,JZ2,J
- RETURN EPILOG
- MEND
-#include "tglobal.inc"
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002ib/vmula.inc b/src/packlib/kernlib/kernnum/obsolete/f002ib/vmula.inc
deleted file mode 100644
index 9f4b073..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002ib/vmula.inc
+++ /dev/null
@@ -1,59 +0,0 @@
-*
-* $Id: vmula.inc,v 1.1.1.1 1996/02/15 17:48:18 mclareni Exp $
-*
-* $Log: vmula.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:18 mclareni
-* Kernlib
-*
-*
-*
-* vmula.inc
-*
-#include "basic.inc"
-#include "mula.inc"
- MACRO
- MAIN &F
-#include "global.inc"
- &TWORDS SETA 0
- SETYPE
- HEADER ENTRY
- J EQU 1
- NSTEP EQU 2
- N EQU 3
- X EQU 4
- JX EQU 5
- Y EQU 6
- JY EQU 7
- Z EQU 8
- JZ EQU 9
- JX2 EQU 10
- JY2 EQU 11
- JZ2 EQU 12
- ®LIM SETA 12
- ENTRY PROLOG
- LM 3,9,0(1)
- * R3 = (N)
- * R4 = (X)
- * R5 = (X2)
- * R6 = (Y)
- * R7 = (Y2)
- * R8 = (Z)
- * R9 = (Z2)
- N 9,=X'7FFFFFFF'
- L N,0(3)
- LA NSTEP,2 NSTEP = 2
- C N,=F'0'
- BC LE,RETURN IF(N .LE. 0) RETURN
- SR 5,4 R5 = (X2) - (X) = JX
- SR 7,6 R7 = (Y2) - (Y) = JY
- SR 9,8 R9 = (Z2) - (Z) = JZ
- LR JX2,JX
- LR JY2,JY
- LR JZ2,JZ
- AR JX2,JX JX2 = 2*JX
- AR JY2,JY JY2 = 2*JY
- AR JZ2,JZ JZ2 = 2*JZ
- VMULA &F,N,X,JX,Y,JY,Z,JZ,JX2,JY2,JZ2,J
- RETURN EPILOG
- MEND
-#include "tglobal.inc"
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002ib/vran.inc b/src/packlib/kernlib/kernnum/obsolete/f002ib/vran.inc
deleted file mode 100644
index 4d1cff5..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002ib/vran.inc
+++ /dev/null
@@ -1,73 +0,0 @@
-*
-* $Id: vran.inc,v 1.1.1.1 1996/02/15 17:48:18 mclareni Exp $
-*
-* $Log: vran.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:18 mclareni
-* Kernlib
-*
-*
-*
-* vran.inc
-*
-#include "basic.inc"
-#include "ran.inc"
- MACRO
- MAIN
-#include "global.inc"
- &TWORDS SETA 22
- SETYPE
- HEADER ENTRY (N,A,B,Z,Z2)
- AIF ('&T' EQ 'D').ALPHA
- A DS 1F
- C DS 1F
- AGO .BETA
- .ALPHA ANOP
- DS 0D
- A DS 1D
- C DS 1D
- .BETA ANOP
- GET DC V(RANGET)
- SET DC V(RANSET)
- LIST DC A(SEED)
- SEED DS 2F 002BC68C 00FE166D
- DATA RANDATA SEED IS FIRST DOUBLE WORD
- NSTEP EQU 2
- N EQU 3
- Z EQU 6
- JZ EQU 7
- J EQU 8
- ®LIM SETA 8
- ENTRY PROLOG
- LM 3,7,0(1)
- * R3 = (N)
- * R4 = (A)
- * R5 = (B)
- * R6 = (Z)
- * R7 = (Z2)
- N 7,=X'7FFFFFFF'
- L&W 0,0(4) F0 = A
- L&W 2,0(5) F2 = B
- S&W.R 2,0 F2 = B-A
- ST&W 0,A STORE A
- ST&W 2,C C = B-A
- L N,0(3)
- LA NSTEP,1 NSTEP=1
- C N,=F'0'
- BC LE,RETURN IF(N .LE. 0) RETURN
- SR 7,6 R7 = (Z2) - (Z) = JZ
- ENTER GET,LIST CALL RANGET(SEED)
- LM 0,1,SEED R0 = 002BC68C
- * R1 = 00FE166D
- A 0,=X'40000000' R0 = 402BC68C
- SLL 1,8 R1 = FE166D00
- STM 0,1,DATA DATA = 402BC68C FE166D00
- VRAN A,C,N,Z,JZ,J,DATA
- LM 0,1,DATA R0 = 402BC68C
- * R1 = FE166D00
- N 0,=X'00FFFFFF' R0 = 002BC68C
- SRL 1,8 R1 = 00FE166D
- STM 0,1,SEED SEED = 002BC68C 00FE166D
- ENTER SET,LIST CALL RANSET(SEED)
- RETURN EPILOG
- MEND
-#include "tglobal.inc"
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002ib/vsca.inc b/src/packlib/kernlib/kernnum/obsolete/f002ib/vsca.inc
deleted file mode 100644
index ef3c66b..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002ib/vsca.inc
+++ /dev/null
@@ -1,61 +0,0 @@
-*
-* $Id: vsca.inc,v 1.1.1.1 1996/02/15 17:48:19 mclareni Exp $
-*
-* $Log: vsca.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:19 mclareni
-* Kernlib
-*
-*
-*
-* vsca.inc
-*
-#include "basic.inc"
-#include "sca.inc"
- MACRO
- MAIN &F
-#include "global.inc"
- &TWORDS SETA 0
- SETYPE
- HEADER ENTRY (N,S,X,X2,Y,Y2,Z,Z2)
- J EQU 1
- NSTEP EQU 2
- N EQU 3
- JX2 EQU 4
- X EQU 5
- JX EQU 6
- Y EQU 7
- JY EQU 8
- Z EQU 9
- JZ EQU 10
- JY2 EQU 11
- JZ2 EQU 12
- ®LIM SETA 12
- ENTRY PROLOG
- LM 3,10,0(1)
- * R3 = (N)
- * R4 = (S)
- * R5 = (X)
- * R6 = (X2)
- * R7 = (Y)
- * R8 = (Y2)
- * R9 = (Z)
- * R10= (Z2)
- N 10,=X'7FFFFFFF'
- L N,0(3)
- LA NSTEP,2 NSTEP = 2
- C N,=F'0'
- BC LE,RETURN IF(N .LE. 0) RETURN
- LOAD 4,4
- SR 6,5 R6 = (X2) - (X) = JX
- SR 8,7 R8 = (Y2) - (Y) = JY
- SR 10,9 R10= (Z2) - (Z) = JZ
- LR JX2,JX
- LR JY2,JY
- LR JZ2,JZ
- AR JX2,JX JX2 = 2 * JX
- AR JY2,JY JY2 = 2 * JY
- AR JZ2,JZ JZ2 = 2 * JZ
- VSCA &F,N,X,JX,Y,JY,Z,JZ,JX2,JY2,JZ2,J
- RETURN EPILOG
- MEND
-#include "tglobal.inc"
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002ib/vscl.inc b/src/packlib/kernlib/kernnum/obsolete/f002ib/vscl.inc
deleted file mode 100644
index 47aa631..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002ib/vscl.inc
+++ /dev/null
@@ -1,53 +0,0 @@
-*
-* $Id: vscl.inc,v 1.1.1.1 1996/02/15 17:48:19 mclareni Exp $
-*
-* $Log: vscl.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:19 mclareni
-* Kernlib
-*
-*
-*
-* vscl.inc
-*
-#include "basic.inc"
-#include "scl.inc"
- MACRO
- MAIN
-#include "global.inc"
- &TWORDS SETA 0
- SETYPE
- HEADER ENTRY (N,S,X,X2,Y,Y2)
- J EQU 1
- NSTEP EQU 2
- N EQU 3
- JX2 EQU 4
- X EQU 5
- JX EQU 6
- Y EQU 7
- JY EQU 8
- JY2 EQU 9
- ®LIM SETA 9
- ENTRY PROLOG
- LM 3,8,0(1)
- * R3 = (N)
- * R4 = (S)
- * R5 = (X)
- * R6 = (X2)
- * R7 = (Y)
- * R8 = (Y2)
- N 8,=X'7FFFFFFF'
- L N,0(3)
- LA NSTEP,2 NSTEP = 2
- C N,=F'0'
- BC LE,RETURN IF(N .LE. 0) RETURN
- LOAD 4,4
- SR 6,5 R6 = (X2) - (X) = JX
- SR 8,7 R8 = (Y2) - (Y) = JY
- LR JX2,JX
- LR JY2,JY
- AR JX2,JX JX2 = 2 * JX
- AR JY2,JY JY2 = 2 * JY
- VSCL N,X,JX,Y,JY,JX2,JY2,J
- RETURN EPILOG
- MEND
-#include "tglobal.inc"
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002ib/vset.inc b/src/packlib/kernlib/kernnum/obsolete/f002ib/vset.inc
deleted file mode 100644
index 8dbc14e..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002ib/vset.inc
+++ /dev/null
@@ -1,45 +0,0 @@
-*
-* $Id: vset.inc,v 1.1.1.1 1996/02/15 17:48:19 mclareni Exp $
-*
-* $Log: vset.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:19 mclareni
-* Kernlib
-*
-*
-*
-* vset.inc
-*
-#include "basic.inc"
-#include "set.inc"
- MACRO
- MAIN
-#include "global.inc"
- &TWORDS SETA 0
- SETYPE
- HEADER ENTRY (N,S,Z,Z2)
- J EQU 1
- NSTEP EQU 2
- N EQU 3
- JZ2 EQU 4
- Z EQU 5
- JZ EQU 6
- ®LIM SETA 6
- ENTRY PROLOG
- LM 3,6,0(1)
- * R3 = (N)
- * R4 = (S)
- * R5 = (Z)
- * R6 = (Z2)
- N 6,=X'7FFFFFFF'
- L N,0(3) R3 = N
- LA NSTEP,2 NSTEP = 2
- LOAD 0,4 F0 = S
- C N,=F'0'
- BC LE,RETURN IF(N .LE. 0) RETURN
- SR 6,5 R6 = (Z2) - (Z) = JZ
- LR JZ2,JZ
- AR JZ2,JZ JZ2 = 2 * JZ
- VSET N,Z,JZ,JZ2,J
- RETURN EPILOG
- MEND
-#include "tglobal.inc"
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002ib/vsum.inc b/src/packlib/kernlib/kernnum/obsolete/f002ib/vsum.inc
deleted file mode 100644
index 9377587..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002ib/vsum.inc
+++ /dev/null
@@ -1,44 +0,0 @@
-*
-* $Id: vsum.inc,v 1.1.1.1 1996/02/15 17:48:19 mclareni Exp $
-*
-* $Log: vsum.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:19 mclareni
-* Kernlib
-*
-*
-*
-* vsum.inc
-*
-#include "basic.inc"
-#include "sum.inc"
- MACRO
- MAIN
-#include "global.inc"
- &TWORDS SETA 0
- SETYPE
- HEADER ENTRY (N,X,X2)
- J EQU 1
- NSTEP EQU 2
- N EQU 3
- X EQU 4
- JX EQU 5
- JX2 EQU 6
- ®LIM SETA 6
- ENTRY PROLOG
- LM 3,5,0(1)
- * R3 = (N)
- * R4 = (X)
- * R5 = (X2)
- N 5,=X'7FFFFFFF'
- CLEAR 0 F0 = 0.
- L N,0(3)
- LA NSTEP,2 NSTEP = 2
- C N,=F'0'
- BC LE,RETURN IF(N .LE. 0) RETURN
- SR 5,4 R5 = (X2) - (X) = JX
- LR JX2,JX
- AR JX2,JX JX2 = 2 * JX
- VSUM N,X,JX,JX2,J
- RETURN EPILOG
- MEND
-#include "tglobal.inc"
diff --git a/src/packlib/kernlib/kernnum/obsolete/f002ib/vxch.inc b/src/packlib/kernlib/kernnum/obsolete/f002ib/vxch.inc
deleted file mode 100644
index 370967c..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f002ib/vxch.inc
+++ /dev/null
@@ -1,48 +0,0 @@
-*
-* $Id: vxch.inc,v 1.1.1.1 1996/02/15 17:48:19 mclareni Exp $
-*
-* $Log: vxch.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:19 mclareni
-* Kernlib
-*
-*
-*
-* vxch.inc
-*
-#include "basic.inc"
-#include "xch.inc"
- MACRO
- MAIN
-#include "global.inc"
- &TWORDS SETA 0
- SETYPE
- HEADER ENTRY (N,X,X2,Y,Y2)
- N EQU 2
- X EQU 3
- JX EQU 4
- Y EQU 5
- JY EQU 6
- JX2 EQU 7
- JY2 EQU 8
- ®LIM SETA 8
- ENTRY PROLOG
- LM 2,6,0(1)
- * R2 = (N)
- * R3 = (X)
- * R4 = (X2)
- * R5 = (Y)
- * R6 = (Y2)
- N 7,=X'7FFFFFFF'
- L N,0(2)
- C N,=F'0'
- BC LE,RETURN IF(N .LE. 0) RETURN
- SR 4,3 R4 = (X2) - (X1) = JX
- SR 6,5 R6 = (Y2) - (Y1) = JY
- LR JX2,JX
- LR JY2,JY
- AR JX2,JX JX2 = 2 * JX
- AR JY2,JY JY2 = 2 * JY
- VXCH2 N,X,JX,Y,JY,JX2,JY2
- RETURN EPILOG
- MEND
-#include "tglobal.inc"
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003cd/cmadd.s b/src/packlib/kernlib/kernnum/obsolete/f003cd/cmadd.s
deleted file mode 100644
index 7cb981c..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003cd/cmadd.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: cmadd.s,v 1.1.1.1 1996/02/15 17:48:06 mclareni Exp $
-*
-* $Log: cmadd.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:06 mclareni
-* Kernlib
-*
-*
- IDENT CMADD
-#include "madd.inc"
- MAIN CTYPE,ADD,B1,B2,B3,B4,A0,B5,B6,B7
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003cd/cmcpy.s b/src/packlib/kernlib/kernnum/obsolete/f003cd/cmcpy.s
deleted file mode 100644
index 4757872..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003cd/cmcpy.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: cmcpy.s,v 1.1.1.1 1996/02/15 17:48:07 mclareni Exp $
-*
-* $Log: cmcpy.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:07 mclareni
-* Kernlib
-*
-*
- IDENT CMCPY
-#include "mcpy.inc"
- MAIN CTYPE,B1,B2,B3,B4,B5,B6,B7
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003cd/cmmna.s b/src/packlib/kernlib/kernnum/obsolete/f003cd/cmmna.s
deleted file mode 100644
index afe241b..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003cd/cmmna.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: cmmna.s,v 1.1.1.1 1996/02/15 17:48:08 mclareni Exp $
-*
-* $Log: cmmna.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:08 mclareni
-* Kernlib
-*
-*
- IDENT CMMNA
-#include "mmpy.inc"
- MAIN CTYPE,MMNA,B1,B2,B3,B4,B5,B6,B7
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003cd/cmmns.s b/src/packlib/kernlib/kernnum/obsolete/f003cd/cmmns.s
deleted file mode 100644
index 2556c8a..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003cd/cmmns.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: cmmns.s,v 1.1.1.1 1996/02/15 17:48:08 mclareni Exp $
-*
-* $Log: cmmns.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:08 mclareni
-* Kernlib
-*
-*
- IDENT CMMNS
-#include "mmpy.inc"
- MAIN CTYPE,MMNS,B1,B2,B3,B4,B5,B6,B7
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003cd/cmmpa.s b/src/packlib/kernlib/kernnum/obsolete/f003cd/cmmpa.s
deleted file mode 100644
index 26a8e24..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003cd/cmmpa.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: cmmpa.s,v 1.1.1.1 1996/02/15 17:48:08 mclareni Exp $
-*
-* $Log: cmmpa.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:08 mclareni
-* Kernlib
-*
-*
- IDENT CMMPA
-#include "mmpy.inc"
- MAIN CTYPE,MMPA,B1,B2,B3,B4,B5,B6,B7
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003cd/cmmps.s b/src/packlib/kernlib/kernnum/obsolete/f003cd/cmmps.s
deleted file mode 100644
index 1282673..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003cd/cmmps.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: cmmps.s,v 1.1.1.1 1996/02/15 17:48:08 mclareni Exp $
-*
-* $Log: cmmps.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:08 mclareni
-* Kernlib
-*
-*
- IDENT CMMPS
-#include "mmpy.inc"
- MAIN CTYPE,MMPS,B1,B2,B3,B4,B5,B6,B7
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003cd/cmmpy.s b/src/packlib/kernlib/kernnum/obsolete/f003cd/cmmpy.s
deleted file mode 100644
index 4e6879f..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003cd/cmmpy.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: cmmpy.s,v 1.1.1.1 1996/02/15 17:48:08 mclareni Exp $
-*
-* $Log: cmmpy.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:08 mclareni
-* Kernlib
-*
-*
- IDENT CMMPY
-#include "mmpy.inc"
- MAIN CTYPE,MMPY,B1,B2,B3,B4,B5,B6,B7
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003cd/cmsub.s b/src/packlib/kernlib/kernnum/obsolete/f003cd/cmsub.s
deleted file mode 100644
index af5b026..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003cd/cmsub.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: cmsub.s,v 1.1.1.1 1996/02/15 17:48:09 mclareni Exp $
-*
-* $Log: cmsub.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:09 mclareni
-* Kernlib
-*
-*
- IDENT CMSUB
-#include "madd.inc"
- MAIN CTYPE,SUB,B1,B2,B3,B4,A0,B5,B6,B7
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003cd/cmutl.s b/src/packlib/kernlib/kernnum/obsolete/f003cd/cmutl.s
deleted file mode 100644
index 6626d06..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003cd/cmutl.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: cmutl.s,v 1.1.1.1 1996/02/15 17:48:09 mclareni Exp $
-*
-* $Log: cmutl.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:09 mclareni
-* Kernlib
-*
-*
- IDENT CMUTL
-#include "mutl.inc"
- MAIN CTYPE,B1,B2,B3,B4
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003cd/crscl.s b/src/packlib/kernlib/kernnum/obsolete/f003cd/crscl.s
deleted file mode 100644
index 077007b..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003cd/crscl.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: crscl.s,v 1.1.1.1 1996/02/15 17:48:09 mclareni Exp $
-*
-* $Log: crscl.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:09 mclareni
-* Kernlib
-*
-*
- IDENT CRSCL
-#include "rscl.inc"
- MAIN CTYPE,B1,B2,B3,B4,B5,B6,B7
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003cd/cumna.s b/src/packlib/kernlib/kernnum/obsolete/f003cd/cumna.s
deleted file mode 100644
index 292c4ba..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003cd/cumna.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: cumna.s,v 1.1.1.1 1996/02/15 17:48:09 mclareni Exp $
-*
-* $Log: cumna.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:09 mclareni
-* Kernlib
-*
-*
- IDENT CUMNA
-#include "umpy.inc"
- MAIN CTYPE,UMNA,B1,B2,B3,B4,B5,B6
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003cd/cumns.s b/src/packlib/kernlib/kernnum/obsolete/f003cd/cumns.s
deleted file mode 100644
index d50bfe4..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003cd/cumns.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: cumns.s,v 1.1.1.1 1996/02/15 17:48:10 mclareni Exp $
-*
-* $Log: cumns.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:10 mclareni
-* Kernlib
-*
-*
- IDENT CUMNS
-#include "umpy.inc"
- MAIN CTYPE,UMNS,B1,B2,B3,B4,B5,B6
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003cd/cumpa.s b/src/packlib/kernlib/kernnum/obsolete/f003cd/cumpa.s
deleted file mode 100644
index 3909e51..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003cd/cumpa.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: cumpa.s,v 1.1.1.1 1996/02/15 17:48:10 mclareni Exp $
-*
-* $Log: cumpa.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:10 mclareni
-* Kernlib
-*
-*
- IDENT CUMPA
-#include "umpy.inc"
- MAIN CTYPE,UMPA,B1,B2,B3,B4,B5,B6
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003cd/cumps.s b/src/packlib/kernlib/kernnum/obsolete/f003cd/cumps.s
deleted file mode 100644
index 839f16d..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003cd/cumps.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: cumps.s,v 1.1.1.1 1996/02/15 17:48:10 mclareni Exp $
-*
-* $Log: cumps.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:10 mclareni
-* Kernlib
-*
-*
- IDENT CUMPS
-#include "umpy.inc"
- MAIN CTYPE,UMPS,B1,B2,B3,B4,B5,B6
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003cd/cumpy.s b/src/packlib/kernlib/kernnum/obsolete/f003cd/cumpy.s
deleted file mode 100644
index 78431aa..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003cd/cumpy.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: cumpy.s,v 1.1.1.1 1996/02/15 17:48:10 mclareni Exp $
-*
-* $Log: cumpy.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:10 mclareni
-* Kernlib
-*
-*
- IDENT CUMPY
-#include "umpy.inc"
- MAIN CTYPE,UMPY,B1,B2,B3,B4,B5,B6
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003cd/dmadd.s b/src/packlib/kernlib/kernnum/obsolete/f003cd/dmadd.s
deleted file mode 100644
index 28999e5..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003cd/dmadd.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: dmadd.s,v 1.1.1.1 1996/02/15 17:48:06 mclareni Exp $
-*
-* $Log: dmadd.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:06 mclareni
-* Kernlib
-*
-*
- IDENT DMADD
-#include "madd.inc"
- MAIN DTYPE,ADD,B1,B2,B3,B4,A0,B5,B6,B7
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003cd/dmcpy.s b/src/packlib/kernlib/kernnum/obsolete/f003cd/dmcpy.s
deleted file mode 100644
index 873aa3a..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003cd/dmcpy.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: dmcpy.s,v 1.1.1.1 1996/02/15 17:48:06 mclareni Exp $
-*
-* $Log: dmcpy.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:06 mclareni
-* Kernlib
-*
-*
- IDENT DMCPY
-#include "mcpy.inc"
- MAIN DTYPE,B1,B2,B3,B4,B5,B6,B7
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003cd/dmmna.s b/src/packlib/kernlib/kernnum/obsolete/f003cd/dmmna.s
deleted file mode 100644
index efc1d83..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003cd/dmmna.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: dmmna.s,v 1.1.1.1 1996/02/15 17:48:07 mclareni Exp $
-*
-* $Log: dmmna.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:07 mclareni
-* Kernlib
-*
-*
- IDENT DMMNA
-#include "mmpy.inc"
- MAIN DTYPE,MMNA,B1,B2,B3,B4,B5,B6,B7
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003cd/dmmns.s b/src/packlib/kernlib/kernnum/obsolete/f003cd/dmmns.s
deleted file mode 100644
index f0688b3..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003cd/dmmns.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: dmmns.s,v 1.1.1.1 1996/02/15 17:48:08 mclareni Exp $
-*
-* $Log: dmmns.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:08 mclareni
-* Kernlib
-*
-*
- IDENT DMMNS
-#include "mmpy.inc"
- MAIN DTYPE,MMNS,B1,B2,B3,B4,B5,B6,B7
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003cd/dmmpa.s b/src/packlib/kernlib/kernnum/obsolete/f003cd/dmmpa.s
deleted file mode 100644
index 98a0978..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003cd/dmmpa.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: dmmpa.s,v 1.1.1.1 1996/02/15 17:48:08 mclareni Exp $
-*
-* $Log: dmmpa.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:08 mclareni
-* Kernlib
-*
-*
- IDENT DMMPA
-#include "mmpy.inc"
- MAIN DTYPE,MMPA,B1,B2,B3,B4,B5,B6,B7
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003cd/dmmps.s b/src/packlib/kernlib/kernnum/obsolete/f003cd/dmmps.s
deleted file mode 100644
index 33cc627..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003cd/dmmps.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: dmmps.s,v 1.1.1.1 1996/02/15 17:48:08 mclareni Exp $
-*
-* $Log: dmmps.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:08 mclareni
-* Kernlib
-*
-*
- IDENT DMMPS
-#include "mmpy.inc"
- MAIN DTYPE,MMPS,B1,B2,B3,B4,B5,B6,B7
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003cd/dmmpy.s b/src/packlib/kernlib/kernnum/obsolete/f003cd/dmmpy.s
deleted file mode 100644
index be18be7..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003cd/dmmpy.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: dmmpy.s,v 1.1.1.1 1996/02/15 17:48:08 mclareni Exp $
-*
-* $Log: dmmpy.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:08 mclareni
-* Kernlib
-*
-*
- IDENT DMMPY
-#include "mmpy.inc"
- MAIN DTYPE,MMPY,B1,B2,B3,B4,B5,B6,B7
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003cd/dmsub.s b/src/packlib/kernlib/kernnum/obsolete/f003cd/dmsub.s
deleted file mode 100644
index 3670872..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003cd/dmsub.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: dmsub.s,v 1.1.1.1 1996/02/15 17:48:09 mclareni Exp $
-*
-* $Log: dmsub.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:09 mclareni
-* Kernlib
-*
-*
- IDENT DMSUB
-#include "madd.inc"
- MAIN DTYPE,SUB,B1,B2,B3,B4,A0,B5,B6,B7
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003cd/dmutl.s b/src/packlib/kernlib/kernnum/obsolete/f003cd/dmutl.s
deleted file mode 100644
index a2799d5..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003cd/dmutl.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: dmutl.s,v 1.1.1.1 1996/02/15 17:48:09 mclareni Exp $
-*
-* $Log: dmutl.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:09 mclareni
-* Kernlib
-*
-*
- IDENT DMUTL
-#include "mutl.inc"
- MAIN DTYPE,B1,B2,B3,B4
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003cd/drscl.s b/src/packlib/kernlib/kernnum/obsolete/f003cd/drscl.s
deleted file mode 100644
index bfe4d24..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003cd/drscl.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: drscl.s,v 1.1.1.1 1996/02/15 17:48:09 mclareni Exp $
-*
-* $Log: drscl.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:09 mclareni
-* Kernlib
-*
-*
- IDENT DRSCL
-#include "rscl.inc"
- MAIN DTYPE,B1,B2,B3,B4,B5,B6,B7
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003cd/dumna.s b/src/packlib/kernlib/kernnum/obsolete/f003cd/dumna.s
deleted file mode 100644
index eef5cd9..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003cd/dumna.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: dumna.s,v 1.1.1.1 1996/02/15 17:48:09 mclareni Exp $
-*
-* $Log: dumna.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:09 mclareni
-* Kernlib
-*
-*
- IDENT DUMNA
-#include "umpy.inc"
- MAIN DTYPE,UMNA,B1,B2,B3,B4,B5,B6
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003cd/dumns.s b/src/packlib/kernlib/kernnum/obsolete/f003cd/dumns.s
deleted file mode 100644
index 8ef4e32..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003cd/dumns.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: dumns.s,v 1.1.1.1 1996/02/15 17:48:10 mclareni Exp $
-*
-* $Log: dumns.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:10 mclareni
-* Kernlib
-*
-*
- IDENT DUMNS
-#include "umpy.inc"
- MAIN DTYPE,UMNS,B1,B2,B3,B4,B5,B6
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003cd/dumpa.s b/src/packlib/kernlib/kernnum/obsolete/f003cd/dumpa.s
deleted file mode 100644
index 0e554eb..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003cd/dumpa.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: dumpa.s,v 1.1.1.1 1996/02/15 17:48:10 mclareni Exp $
-*
-* $Log: dumpa.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:10 mclareni
-* Kernlib
-*
-*
- IDENT DUMPA
-#include "umpy.inc"
- MAIN DTYPE,UMPA,B1,B2,B3,B4,B5,B6
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003cd/dumps.s b/src/packlib/kernlib/kernnum/obsolete/f003cd/dumps.s
deleted file mode 100644
index 9af661e..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003cd/dumps.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: dumps.s,v 1.1.1.1 1996/02/15 17:48:10 mclareni Exp $
-*
-* $Log: dumps.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:10 mclareni
-* Kernlib
-*
-*
- IDENT DUMPS
-#include "umpy.inc"
- MAIN DTYPE,UMPS,B1,B2,B3,B4,B5,B6
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003cd/dumpy.s b/src/packlib/kernlib/kernnum/obsolete/f003cd/dumpy.s
deleted file mode 100644
index eebf650..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003cd/dumpy.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: dumpy.s,v 1.1.1.1 1996/02/15 17:48:10 mclareni Exp $
-*
-* $Log: dumpy.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:10 mclareni
-* Kernlib
-*
-*
- IDENT DUMPY
-#include "umpy.inc"
- MAIN DTYPE,UMPY,B1,B2,B3,B4,B5,B6
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003cd/madd.inc b/src/packlib/kernlib/kernnum/obsolete/f003cd/madd.inc
deleted file mode 100644
index 41e45ad..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003cd/madd.inc
+++ /dev/null
@@ -1,107 +0,0 @@
-*
-* $Id: madd.inc,v 1.1.1.1 1996/02/15 17:48:05 mclareni Exp $
-*
-* $Log: madd.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:05 mclareni
-* Kernlib
-*
-*
-*
-* madd.inc
-*
-*CALL BASIC
-*CALL ADD
- ADD SET 1
- SUB SET 2
- MAIN MACRO TYPE,FCN,M,N,JX,JY,Z,IZ,JZ,J
- SETYPE TYPE
- IFEQ FCN,ADD,2
- SIGN MICRO 1,,*+*
- VERB MICRO 1,,*MADD*
- IFEQ FCN,SUB,2
- SIGN MICRO 1,,*-*
- VERB MICRO 1,,*MSUB*
- NAME MICRO 1,,*"P"_"VERB"*
- HEADER "NAME",SAVEA0
- TEMP6 BSS 6 WORKING STORE (.MADD)
- TAU IFEQ TYPE,CTYPE
- SWITCH BSS 1
- PLIST BSS 1
- TAU ENDIF
- EXIT "NAME" (M,N,X,X12,X21,Y,Y12,Y21,Z,Z12,Z21)
- TAU IFEQ TYPE,CTYPE
- MX6 0
- SX7 A1 X7=((M))
- SA6 SWITCH SWITCH=.FALSE.
- SA7 PLIST PLIST=((M))
- PROLOG M,N,JX,JY,IZ,JZ,J
- [1] RMADD M,N,JX,"SIGN",JY,Z,IZ,JZ,J,TEMP6
- SA5 SWITCH X5=SWITCH
- SA1 PLIST X1=((M))
- SA2 SAVEA0 X2=OLD A0
- MI X5,[2] IF SWITCH=.TRUE.
- SA1 X1 X1=(M) A1=((M))
- MX6 1
- SA0 X2 RESTORE OLD A0
- SA6 SWITCH SWITCH=.TRUE.
- PROLOG M,N,JX,JY,IZ,JZ,J
- SX2 X2+1 X2=(X'')
- SX4 X4+1 X4=(Y'')
- S_Z Z+1 Z=(Z'')
- JP [1]
- [2] EPILOG
- TAU ELSE
- PROLOG M,N,JX,JY,IZ,JZ,J
- "P"MADD M,N,JX,"SIGN",JY,Z,IZ,JZ,J,TEMP6
- EPILOG
- TAU ENDIF
- ENDM
- PROLOG MACRO MM,NN,JX,JY,IZ,JZ,ONE
-* X2=(X) A0=(Z)
-* X3=IX
-* X4=(Y)
-* X5=IY
- BSS 0 X1=(M) A1=((M))
- + S_ONE 1 0 ONE=1
- SA2 X1 1 X2=M A2=(M)
- SA3 A1+ONE 2 X3=(N) A3=((N))
- + SX6 A0 3 X6=OLD A0
- SA4 A3+ONE 4 X6 X4=(X) A4=((X))
- SA6 SAVEA0 5 SAVEA0=OLD A0
-* 6
-* 7
- + SA5 A4+ONE 8 X2 X5=(X12) A5=((X12))
- S_MM X2 9 X3 MM=M
- SA3 X3 10 X3=N A3=(N)
- SA1 A5+ONE 11 X4 X1=(X21) A1=((X21))
- + BX0 X4 12 X0=(X)
- SA2 A1+ONE 13 X0 X2=(Y) A2=((Y))
-* 14
- LE MM,B0,EXIT X5 IF M .LE. 0 GO TO EXIT
- + SA4 A2+ONE 16 X4=(Y12) A4=((Y12))
-* 17 X3
- IX6 X5-X0 18 X1 X6=(X12)-(X)=JX
- SA5 A4+ONE 19 X6 X5=(Y21) A5=((Y21))
- IX7 X1-X0 20 X2 X7=(X21)-(X)=IX
- + S_NN X3 21 X7 NN=N
- SA1 A5+ONE 22 X1=(Z) A1=((Z))
-* 23 X4
- LE NN,B0,EXIT IF N .LE. 0 GO TO EXIT
- + SA3 A1+ONE 25 X3=(Z12) A3=((Z12))
- S_JX X6 26 X5 JX=(X12)-(X)
- IX6 X4-X2 27 X6=(Y12)-(Y)
- SA4 A3+ONE 28 X6 X4=(Z21) A4=((Z21))
- + IX5 X5-X2 29 X1 X5=(Y21)-(Y)=IY
- SA0 X1 30 X5 A0=(Z)
- S_JY X6 31 JY=(Y12)-(Y)
-* 32 X3
- IX6 X3-X1 33 X6=(Z12)-(Z)=JZ
-* 34 X6
- + S_JZ X6 35 X4 JZ=(Z12)-(Z)
- IX6 X4-X1 36 X6=(Z21)-(Z)=IZ
- BX4 X2 37 X6 X4=(Y)
- S_IZ X6 38 X4 IZ=(Z21)-(Z)
- + BX2 X0 39 X2=(X)
- BX3 X7 40 X2 X3=(X21)-(X)=IX
-* 41 X3
- PROLOG ENDM
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003cd/mbil.inc b/src/packlib/kernlib/kernnum/obsolete/f003cd/mbil.inc
deleted file mode 100644
index db01fa8..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003cd/mbil.inc
+++ /dev/null
@@ -1,57 +0,0 @@
-*
-* $Id: mbil.inc,v 1.1.1.1 1996/02/15 17:48:05 mclareni Exp $
-*
-* $Log: mbil.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:05 mclareni
-* Kernlib
-*
-*
-*
-* mbil.inc
-*
-*CALL BASIC
-*CALL MPY
- MAIN MACRO TYPE,N,IX,IY,JY,JZ,I,J
- SETYPE TYPE
- NAME MICRO 1,,*"P"_MBIL*
- HEADER "NAME",SAVEA0
- TEMP3 BSS 3
- EXIT "NAME" (N,X,X2,Y,Y12,Y21,Z,Z2)
- PROLOG [2],N,IX,IY,JY,JZ,I A0=(X), X1=(Y), X2=(Z)
- "P"MBIL N,IX,IY,JY,JZ,TEMP3,I,J
- [1] EPILOG
- [2] MX6 0 TMBIL = 0.
- IFEQ LENGTH,2,1
- MX7 0
- JP [1]
- ENDM
- PROLOG MACRO EX,NN,IX,IY,JY,JZ,ONE A0=(X), X1=(Y), X2=(Z)
- BSS 0 X1=(N) A1=((N))
- + SA3 A1+4 0 X3=(Y12) A3=((Y12))
- S_ONE 1 1 ONE=1
- + SA5 X1 2 X5=N A5=(N)
- SA1 A3-ONE 3 X1=(Y) A1=((Y))
- SA4 A3+ONE 4 X4=(Y21) A4=((Y21))
- SX6 A0 5 X6=OLD A0
-* 6 X6
-* 7 X3
- + SA2 A4+ONE 8 X2=(Z) A2=((Z))
- SA6 SAVEA0 9 X5 SAVEA0=OLD A0
- S_NN X5 10 X1 NN=N
- + SA5 A2+ONE 11 X4 X5=(Z2) A5=((Z2))
- IX7 X4-X1 12 X7=(Y21)-(Y)
- IX6 X3-X1 13 X7 X6=(Y12)-(Y)
- SA4 A1-ONE 14 X6 X4=(X2) A4=((X2))
- + S_IY X7 15 X2 IY=(Y21)-(Y)
- SA3 A4-ONE 16 X3=(X) A3=((X))
-* 17
- LE NN,B0,EX 18 X5 IF N.LE.0 GOTO EXIT
- + IX7 X5-X2 19 X7=(Z2)-(Z)
- S_JY X6 20 X7 JY=(Y12)-(Y)
- S_JZ X7 21 X4 JZ=(Z2)-(Z)
- NO 22
-* 23 X3
- + IX6 X4-X3 24 X6=(X2)-(X)
- SA0 X3 25 X6 A0=(X)
- S_IX X6 26 IX=(X2)-(X)
- PROLOG ENDM
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003cd/mcpy.inc b/src/packlib/kernlib/kernnum/obsolete/f003cd/mcpy.inc
deleted file mode 100644
index 5636d7a..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003cd/mcpy.inc
+++ /dev/null
@@ -1,61 +0,0 @@
-*
-* $Id: mcpy.inc,v 1.1.1.1 1996/02/15 17:48:05 mclareni Exp $
-*
-* $Log: mcpy.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:05 mclareni
-* Kernlib
-*
-*
-*
-* mcpy.inc
-*
-*CALL BASIC
-*CALL CPY
- MAIN MACRO TYPE,M,N,IX,JX,IZ,JZ,J
- SETYPE TYPE SET PREFIX, SUFFIX, LENGTH
- NAME MICRO 1,,*"P"_MCPY_"S"*
- HEADER "NAME",SAVEA0
- EXIT "NAME" (M,N,X,X12,X21,Z,Z12,Z21)
- PROLOG M,N,IX,JX,IZ,JZ,J
- TAU IFEQ TYPE,CTYPE
- DMCPY M,N,X0,IX,JX,A0,IZ,JZ,X1,J
- TAU ELSE
- "P"MCPY M,N,X0,IX,JX,A0,IZ,JZ,X1,J
- TAU ENDIF
- EPILOG
- ENDM
- PROLOG MACRO MM,NN,IX,JX,IZ,JZ,ONE
-* X0=(X) A0=(Z)
- BSS 0 X1=(M) A1=((M))
- SA4 X1 0 X4=M A4=(M)
- S_ONE 1 1 ONE=1
- 2
- SA5 A1+ONE 3 X5=(N) A5=((N))
- + SA1 A1+5 4 X1=(Z) A1=((Z))
- SA3 A5+ONE 5 X3=(X) A3=((X))
- SA2 A1+ONE 6 X2=(Z12) A2=((Z12))
- 7 X4
- + S_MM X4 8 MM=M
- SA4 A2+ONE 9 X4=(Z21) A4=((Z21))
- 10 X5
- LE MM,B0,EXIT X1 IF M.LE.0 EXIT WITH A0 PRESERVED
- + SA5 X5 12 X3 X5=N A5=(N)
- SX6 A0 13 X2 X6=OLD A0
- BX0 X3 14 X6 X0=(X)
- SA3 A3+ONE 15 X0 X3=(X12) A3=((X12))
- + IX7 X2-X1 16 X4 X7=(Z12)-(Z)
- SA2 A3+ONE 17 X7 X2=(X21) A2=((X21))
- SA6 SAVEA0 18
- 19 X5
- + IX6 X4-X1 20 X6=(Z21)-(Z)
- S_JZ X7 21 X6 JZ=(Z12)-(Z)
- S_NN X5 22 X3
- S_IZ X6 23 IZ=(Z21)-(Z)
- 24 X2
- + LE NN,B0,EXIT IF N.LE.0 EXIT WITH A0 PRESERVED
- IX7 X3-X0 26 X7=(X12)-(X)
- IX6 X2-X0 27 X7 X6=(X21)-(X)
- + S_JX X7 28 X6 JX=(X12)-(X)
- S_IX X6 29 IX=(X21)-(X)
- SA0 X1 30 A0=(Z)
- PROLOG ENDM
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003cd/mmpy.inc b/src/packlib/kernlib/kernnum/obsolete/f003cd/mmpy.inc
deleted file mode 100644
index 18b685f..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003cd/mmpy.inc
+++ /dev/null
@@ -1,88 +0,0 @@
-*
-* $Id: mmpy.inc,v 1.1.1.1 1996/02/15 17:48:05 mclareni Exp $
-*
-* $Log: mmpy.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:05 mclareni
-* Kernlib
-*
-*
-*
-* mmpy.inc
-*
-*CALL BASIC
-*CALL SCL
-*CALL SCA
-*CALL MPY
- MMNA SET 1
- MMNS SET 2
- MMPA SET 3
- MMPS SET 4
- MMPY SET 5
- MAIN MACRO TYPE,FCN,M,N,IX,JX,JY,IZ,J
- SETYPE TYPE
- IFEQ FCN,MMNA,3
- SIGNX MICRO 1,,*-*
- SIGNZ MICRO 1,,*+*
- VERB MICRO 1,,*MMNA*
- IFEQ FCN,MMNS,3
- SIGNX MICRO 1,,*-*
- SIGNZ MICRO 1,,*-*
- VERB MICRO 1,,*MMNS*
- IFEQ FCN,MMPA,3
- SIGNX MICRO 1,,*+*
- SIGNZ MICRO 1,,*+*
- VERB MICRO 1,,*MMPA*
- IFEQ FCN,MMPS,3
- SIGNX MICRO 1,,*+*
- SIGNZ MICRO 1,,*-*
- VERB MICRO 1,,*MMPS*
- IFEQ FCN,MMPY,3
- SIGNX MICRO 1,,*+*
- SIGNZ MICRO 1,,*0*
- VERB MICRO 1,,*MMPY*
- NAME MICRO 1,,*"P"_"VERB"*
- HEADER "NAME",SAVEA0
- TEMP2 BSS 2 WORKING STORE
- EXIT "NAME" (M,N,X,X12,X21,Y,Y2,Z,Z2)
- PROLOG M,N,IX,JX,JY,IZ,J
-* X1=(X), X2=(Y), A0=(Z)
- "P"MMPY "SIGNX",M,N,IX,JX,JY,"SIGNZ",A0,IZ,TEMP2,J
- EPILOG
- ENDM
- PROLOG MACRO MM,NN,IX,JX,JY,IZ,ONE X1=(X),X2=(Y),A0=(Z)
- BSS 0 X1=(M) A1=((M))
- + S_ONE 1 0 ONE=1
- SA2 X1 1 X2=M A2=(M)
- SA3 A1+ONE 2 X3=(N) A3=((N))
- + SX6 A0 3 X6=OLD A0
- SA4 A3+ONE 4 X6 X4=(X) A4=((X))
- SA6 SAVEA0 5 SAVEA0=OLD A0
-* 6
-* 7
- + SA5 A4+ONE 8 X2 X5=(X12) A5=((X12))
- S_MM X2 9 X3 MM=M
- SA1 A5+ONE 10 X1=(X21) A1=((X21))
- SA3 X3 11 X4 X3=N A3=(N)
- + SA2 A1+ONE 12 X2=(Y) A2=((Y))
- BX0 X4 13 X0=(X)
-* 14 X0
- LE MM,B0,EXIT X5 IF M.LE.0 GO TO EXIT
- + SA4 A2+ONE 16 X4=(Y2) A4=((Y2))
-* 17 X1
-* 18 X3
- IX6 X5-X0 19 X2 X6=(X12)-(X)=JX
- SA5 A4+ONE 20 X6 X5=(Z) A5=((Z))
- IX7 X1-X0 21 X7=(X21)-(X)=IX
- + SA1 A5+ONE 22 X7 X1=(Z2) A1=((Z2))
- S_JX X6 23 X4 JX=(X12)-(X)
- S_NN X3 24 NN=N
- IX6 X4-X2 25 X6=(Y2)-(Y)=JY
- + S_IX X7 26 X6 IX=(X21)-(X)
-* 27 X5
- LE NN,B0,EXIT IF N.LE.0 GO TO EXIT
- S_JY X6 29 X1 JY=(Y2)-(Y)
- + IX7 X1-X5 30 X7=(Z2)-(Z)=IZ
- BX1 X0 31 X7 X1=(X)
- S_IZ X7 32 X1 IZ=(Z2)-(Z)
- SA0 X5 33 A0=(Z)
- PROLOG ENDM
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003cd/mran.inc b/src/packlib/kernlib/kernnum/obsolete/f003cd/mran.inc
deleted file mode 100644
index 0e666c0..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003cd/mran.inc
+++ /dev/null
@@ -1,60 +0,0 @@
-*
-* $Id: mran.inc,v 1.1.1.1 1996/02/15 17:48:05 mclareni Exp $
-*
-* $Log: mran.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:05 mclareni
-* Kernlib
-*
-*
-*
-* mran.inc
-*
-*CALL BASIC
-*CALL RAN
- MAIN MACRO TYPE,M,N,Z,IZ,JZ,I,J
- SETYPE TYPE
- NAME MICRO 1,,*"P"_MRAN*
- HEADER "NAME" A0 IS NEITHER USED NOR SAVED
- EXT RANDOM. FTN SYSTEM LOCATION OF SEED
- EXIT "NAME" (M,N,A,B,Z,Z12,Z21)
- PROLOG EXIT,M,N,Z,IZ,JZ,I
- "P"MRAN M,N,Z,IZ,JZ,I,J
- BX6 X4 X6=SEED
- SA6 RANDOM.
- EPILOG
- ENDM
- PROLOG MACRO EX,MM,NN,Z,IZ,JZ,ONE X0=A, X3=C, X4=SEED, X5=MULT
- BSS 0 X1=(M) A1=((M))
- + S_ONE 1 0 ONE=1
- SA2 X1 1 X2=M M2=(A)
- SA3 A1+ONE 2 X3=(N) A3=((N))
-* 3
- + SA4 A3+ONE 4 X4=(A) A4=((A))
- SA5 A3+3 5 X5=(Z) A5=((Z))
- SA1 A4+ONE 6 X1=(B) A1=((B))
-* 7
-* 8 X2
- + S_MM X2 9 X3 MM=M
- SA3 X3 10 X3=N A3=(N)
- SA2 A5+ONE 11 X4 X2=(Z12) A2=((Z12))
- SA4 X4 12 X5 X4=A A4=(A)
- + BX6 X5 13 X1 X6=(Z)
- S_Z X5 14 Z=(Z)
- SA5 A2+ONE 15 X5=(Z21) A5=((Z21))
- SA1 X1 16 X1=B A1=(B)
-* 17 X3
- + LE MM,B0,EX 18 X2 IF M.LE.0 EXIT WITH A0 PRESERVED
- S_NN X3 19 X4 NN=N
- IX7 X2-X6 20 X7=(Z12)-(Z)
-* 21 X7
-* 22 X5
- + LE NN,B0,EX 23 X1 IF N.LE.0 EXIT WITH A0 PRESERVED
- FX3 X1-X4 24 X3=B-A=C
- BX0 X4 25 X0=A
- + SA4 RANDOM. 26 X0 X4=SEED A4=(SEED)
- S_JZ X7 27 X3 JZ=(Z12)-(Z)
- IX7 X5-X6 28 X7=(Z21)-(Z)
- + SA5 A4+ONE 29 X7 X5=MULT A5=(MULT)
- NX3 X3 30 X3=C=B-A
- S_IZ X7 31 IZ=(Z21)-(Z)
- PROLOG ENDM
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003cd/mscl.inc b/src/packlib/kernlib/kernnum/obsolete/f003cd/mscl.inc
deleted file mode 100644
index 578f5e4..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003cd/mscl.inc
+++ /dev/null
@@ -1,53 +0,0 @@
-*
-* $Id: mscl.inc,v 1.1.1.1 1996/02/15 17:48:05 mclareni Exp $
-*
-* $Log: mscl.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:05 mclareni
-* Kernlib
-*
-*
-*
-* mscl.inc
-*
-*CALL BASIC
-*CALL SCL
- MAIN MACRO TYPE,M,N,IX,JX,IZ,JZ,J
- SETYPE TYPE
- NAME MICRO 1,,*"P"_MSCL*
- HEADER "NAME",SAVEA0
- EXIT "NAME" (M,N,S,X,X12,X21,Z,Z12,Z21)
- PROLOG EXIT,M,N,IX,JX,IZ,JZ,J X0=(X), X1=S, A0=(Z)
- "P"MSCL M,N,X0,IX,JX,A0,IZ,JZ,J
- EPILOG
- ENDM
- PROLOG MACRO EX,MM,NN,IX,JX,IZ,JZ,ONE
- BSS 0 X1=(M) A1=((M))
- SA4 X1 X4=M A4=(M)
- S_ONE 1 ONE=1
- SA5 A1+ONE X5=(N) A5=((N))
- SA2 A1+6 X2=(Z) A2=((Z))
- SA1 A5+ONE X1=(S) A1=((S))
- SA3 A2+ONE X3=(Z12) A3=((Z12))
- S_MM X4 MM=M
- SA4 A3+ONE X4=(Z21) A4=((Z21))
- LE MM,B0,EX IF M.LE.0 EXIT WITH A0 PRESERVED
- SA5 X5 X5=N A5=(N)
- SX6 A0 X6=OLD A0
- IX7 X3-X2 X7=(Z12)-(Z)
- SA3 A1+ONE X3=(X) A3=((X))
- SA1 X1 X1=S A1=(S)
- SA6 SAVEA0 SAVE OLD A0
- S_JZ X7 JZ=(Z12)-(Z)
- IX6 X4-X2 X6=(Z21)-(Z)
- SA4 A3+ONE X4=(X12) A4=((X12))
- S_NN X5 NN=N
- SA5 A4+ONE X5=(X21) A5=((X21))
- LE NN,B0,EX IF N.LE.0 EXIT WITH A0 PRESERVED
- BX0 X3 X0=(X)
- S_IZ X6 IZ=(Z21)-(Z)
- SA0 X2 A0=(Z)
- IX6 X4-X3 X6=(X12)-(X)
- IX7 X5-X3 X7=(X21)-(X)
- S_JX X6 JX=(X12)-(X)
- S_IX X7 IX=(X21)-(X)
- PROLOG ENDM
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003cd/mset.inc b/src/packlib/kernlib/kernnum/obsolete/f003cd/mset.inc
deleted file mode 100644
index 687fa8b..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003cd/mset.inc
+++ /dev/null
@@ -1,44 +0,0 @@
-*
-* $Id: mset.inc,v 1.1.1.1 1996/02/15 17:48:05 mclareni Exp $
-*
-* $Log: mset.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:05 mclareni
-* Kernlib
-*
-*
-*
-* mset.inc
-*
-*CALL BASIC
-*CALL SET
- MAIN MACRO TYPE,M,N,Z,IZ,JZ,I,J
- SETYPE TYPE
- NAME MICRO 1,,*"P"_MSET*
- HEADER "NAME" A0 IS NEITHER USED NOR SAVED
- EXIT "NAME" (M,N,S,Z,Z12,Z21)
- PROLOG EXIT,M,N,Z,IZ,JZ,J X6=S
- "P"MSET M,N,Z,IZ,JZ,I,J
- EPILOG
- ENDM
- PROLOG MACRO EX,MM,NN,Z,IZ,JZ,ONE
- BSS 0 X1=(M) A1=((M))
- SA4 X1 X4=M A4=(M)
- S_ONE 1 ONE=1
- SA5 A1+ONE X5=(N) A5=((N))
- SA1 A5+ONE X1=(S) A1=((S))
- SA2 A1+ONE X2=(Z) A2=((Z))
- SA3 A2+ONE X3=(Z12) A3=((Z12))
- S_MM X4 MM=M
- SA4 A3+ONE X4=(Z21) A4=((Z21))
- LE MM,B0,EX IF M.LE.0 EXIT WITH A0 PRESERVED
- SA5 X5 X5=N A5=(N)
- SA1 X1 X1=S A1=(S)
- S_Z X2 Z=(Z)
- IX7 X3-X2 X7=(Z12)-(Z)
- IX6 X4-X2 X6=(Z21)-(Z)
- S_JZ X7 JZ=(Z12)-(Z)
- S_IZ X6 IZ=(Z21)-(Z)
- S_NN X5 NN=N
- BX6 X1 X6=S
- LE NN,B0,EX IF N.LE.0 EXIT WITH A0 PRESERVED
- PROLOG ENDM
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003cd/mutl.inc b/src/packlib/kernlib/kernnum/obsolete/f003cd/mutl.inc
deleted file mode 100644
index f613f64..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003cd/mutl.inc
+++ /dev/null
@@ -1,43 +0,0 @@
-*
-* $Id: mutl.inc,v 1.1.1.1 1996/02/15 17:48:06 mclareni Exp $
-*
-* $Log: mutl.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:06 mclareni
-* Kernlib
-*
-*
-*
-* mutl.inc
-*
-*CALL BASIC
-*CALL CPY
-*CALL UTL
- MAIN MACRO TYPE,NM1,IX,JX,J
- SETYPE TYPE SET PREFIX, SUFFIX, LENGTH
- NAME MICRO 1,,*"P"_MUTL*
- HEADER "NAME" A0 IS NEITHER USED NOR SAVED
- EXIT "NAME"
- PROLOG NM1,IX,JX
-* X1=(X(1,1))
- TMUTL TYPE,NM1,IX,JX,J
- EPILOG
- ENDM
- PROLOG MACRO NM1,IX,JX
- BSS 0 X1=(N) A1=((N))
- + SA5 X1 0 X5=N A5=(N)
- SA2 A1+2 1 X2=(X12) A2=((X12))
- NO 2
- + SA1 A2-1 3 X1=(X) A1=((X))
- SA3 A2+1 4 X3=(X21) A3=((X21))
-* 5
-* 6
-* 7 X5
- + S_NM1 X5-1 8 X2 NM1=N-1
-* 9
-* 10 X1
- LE NM1,B0,EXIT X3 IF N .LE. 1 EXIT
- + IX6 X2-X1 12 X6=(X12)-(X)=JX
- IX7 X3-X1 13 X6 X7=(X21)-(X)=IX
- S_JX X6 14 X7 JX=(X12)-(X)
- S_IX X7 15 IX=(X21)-(X)
- PROLOG ENDM
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003cd/rmadd.s b/src/packlib/kernlib/kernnum/obsolete/f003cd/rmadd.s
deleted file mode 100644
index 496e54e..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003cd/rmadd.s
+++ /dev/null
@@ -1,14 +0,0 @@
-*
-* $Id: rmadd.s,v 1.1.1.1 1996/02/15 17:48:06 mclareni Exp $
-*
-* $Log: rmadd.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:06 mclareni
-* Kernlib
-*
-*
-*ADDFILE
-*DECK F003CDC
- IDENT RMADD
-#include "madd.inc"
- MAIN RTYPE,ADD,B1,B2,B3,B4,A0,B5,B6,B7
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003cd/rmbil.s b/src/packlib/kernlib/kernnum/obsolete/f003cd/rmbil.s
deleted file mode 100644
index 2b108f8..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003cd/rmbil.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: rmbil.s,v 1.1.1.1 1996/02/15 17:48:06 mclareni Exp $
-*
-* $Log: rmbil.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:06 mclareni
-* Kernlib
-*
-*
- IDENT RMBIL
-#include "mbil.inc"
- MAIN RTYPE,B1,B2,B3,B4,B5,B6,B7
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003cd/rmcpy.s b/src/packlib/kernlib/kernnum/obsolete/f003cd/rmcpy.s
deleted file mode 100644
index 96f8235..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003cd/rmcpy.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: rmcpy.s,v 1.1.1.1 1996/02/15 17:48:06 mclareni Exp $
-*
-* $Log: rmcpy.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:06 mclareni
-* Kernlib
-*
-*
- IDENT RMCPY
-#include "mcpy.inc"
- MAIN RTYPE,B1,B2,B3,B4,B5,B6,B7
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003cd/rmmna.s b/src/packlib/kernlib/kernnum/obsolete/f003cd/rmmna.s
deleted file mode 100644
index 4e3dc9a..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003cd/rmmna.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: rmmna.s,v 1.1.1.1 1996/02/15 17:48:07 mclareni Exp $
-*
-* $Log: rmmna.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:07 mclareni
-* Kernlib
-*
-*
- IDENT RMMNA
-#include "mmpy.inc"
- MAIN RTYPE,MMNA,B1,B2,B3,B4,B5,B6,B7
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003cd/rmmns.s b/src/packlib/kernlib/kernnum/obsolete/f003cd/rmmns.s
deleted file mode 100644
index c8c91d3..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003cd/rmmns.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: rmmns.s,v 1.1.1.1 1996/02/15 17:48:08 mclareni Exp $
-*
-* $Log: rmmns.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:08 mclareni
-* Kernlib
-*
-*
- IDENT RMMNS
-#include "mmpy.inc"
- MAIN RTYPE,MMNS,B1,B2,B3,B4,B5,B6,B7
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003cd/rmmpa.s b/src/packlib/kernlib/kernnum/obsolete/f003cd/rmmpa.s
deleted file mode 100644
index c1b0c0a..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003cd/rmmpa.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: rmmpa.s,v 1.1.1.1 1996/02/15 17:48:08 mclareni Exp $
-*
-* $Log: rmmpa.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:08 mclareni
-* Kernlib
-*
-*
- IDENT RMMPA
-#include "mmpy.inc"
- MAIN RTYPE,MMPA,B1,B2,B3,B4,B5,B6,B7
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003cd/rmmps.s b/src/packlib/kernlib/kernnum/obsolete/f003cd/rmmps.s
deleted file mode 100644
index b58874c..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003cd/rmmps.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: rmmps.s,v 1.1.1.1 1996/02/15 17:48:08 mclareni Exp $
-*
-* $Log: rmmps.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:08 mclareni
-* Kernlib
-*
-*
- IDENT RMMPS
-#include "mmpy.inc"
- MAIN RTYPE,MMPS,B1,B2,B3,B4,B5,B6,B7
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003cd/rmmpy.s b/src/packlib/kernlib/kernnum/obsolete/f003cd/rmmpy.s
deleted file mode 100644
index 3351cf2..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003cd/rmmpy.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: rmmpy.s,v 1.1.1.1 1996/02/15 17:48:08 mclareni Exp $
-*
-* $Log: rmmpy.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:08 mclareni
-* Kernlib
-*
-*
- IDENT RMMPY
-#include "mmpy.inc"
- MAIN RTYPE,MMPY,B1,B2,B3,B4,B5,B6,B7
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003cd/rmran.s b/src/packlib/kernlib/kernnum/obsolete/f003cd/rmran.s
deleted file mode 100644
index 2ad5fe3..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003cd/rmran.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: rmran.s,v 1.1.1.1 1996/02/15 17:48:08 mclareni Exp $
-*
-* $Log: rmran.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:08 mclareni
-* Kernlib
-*
-*
- IDENT RMRAN
-#include "mran.inc"
- MAIN RTYPE,B1,B2,B3,B4,B5,B6,B7
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003cd/rmscl.s b/src/packlib/kernlib/kernnum/obsolete/f003cd/rmscl.s
deleted file mode 100644
index 30b538d..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003cd/rmscl.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: rmscl.s,v 1.1.1.1 1996/02/15 17:48:08 mclareni Exp $
-*
-* $Log: rmscl.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:08 mclareni
-* Kernlib
-*
-*
- IDENT RMSCL
-#include "mscl.inc"
- MAIN RTYPE,B1,B2,B3,B4,B5,B6,B7
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003cd/rmset.s b/src/packlib/kernlib/kernnum/obsolete/f003cd/rmset.s
deleted file mode 100644
index 594c302..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003cd/rmset.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: rmset.s,v 1.1.1.1 1996/02/15 17:48:08 mclareni Exp $
-*
-* $Log: rmset.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:08 mclareni
-* Kernlib
-*
-*
- IDENT RMSET
-#include "mset.inc"
- MAIN RTYPE,B1,B2,B3,B4,B5,B6,B7
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003cd/rmsub.s b/src/packlib/kernlib/kernnum/obsolete/f003cd/rmsub.s
deleted file mode 100644
index 1066fee..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003cd/rmsub.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: rmsub.s,v 1.1.1.1 1996/02/15 17:48:08 mclareni Exp $
-*
-* $Log: rmsub.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:08 mclareni
-* Kernlib
-*
-*
- IDENT RMSUB
-#include "madd.inc"
- MAIN RTYPE,SUB,B1,B2,B3,B4,A0,B5,B6,B7
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003cd/rmutl.s b/src/packlib/kernlib/kernnum/obsolete/f003cd/rmutl.s
deleted file mode 100644
index f9cd854..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003cd/rmutl.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: rmutl.s,v 1.1.1.1 1996/02/15 17:48:09 mclareni Exp $
-*
-* $Log: rmutl.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:09 mclareni
-* Kernlib
-*
-*
- IDENT RMUTL
-#include "mutl.inc"
- MAIN RTYPE,B1,B2,B3,B4
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003cd/rrscl.s b/src/packlib/kernlib/kernnum/obsolete/f003cd/rrscl.s
deleted file mode 100644
index 88b8c2d..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003cd/rrscl.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: rrscl.s,v 1.1.1.1 1996/02/15 17:48:09 mclareni Exp $
-*
-* $Log: rrscl.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:09 mclareni
-* Kernlib
-*
-*
- IDENT RRSCL
-#include "rscl.inc"
- MAIN RTYPE,B1,B2,B3,B4,B5,B6,B7
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003cd/rscl.inc b/src/packlib/kernlib/kernnum/obsolete/f003cd/rscl.inc
deleted file mode 100644
index e4973a8..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003cd/rscl.inc
+++ /dev/null
@@ -1,56 +0,0 @@
-*
-* $Id: rscl.inc,v 1.1.1.1 1996/02/15 17:48:06 mclareni Exp $
-*
-* $Log: rscl.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:06 mclareni
-* Kernlib
-*
-*
-*
-* rscl.inc
-*
-*CALL BASIC
-*CALL SCL
- MAIN MACRO TYPE,M,N,D,ID,JX,JZ,J
- SETYPE TYPE
- NAME MICRO 1,,*"P"_RSCL*
- HEADER "NAME",SAVEA0
- TEMP BSS 3
- EXIT "NAME" (M,N,D,D2,X,X12,X21,Z,Z12,Z21)
- PROLOG EXIT,M,N,D,ID,JX,JZ,J X0=(X),X6=IX,A0=(Z),X7=IZ
- TRSCL TYPE,M,N,D,ID,JX,JZ,J,TEMP
- EPILOG
- ENDM
- PROLOG MACRO EX,MM,NN,D,ID,JX,JZ,ONE
- BSS 0 X1=(M) A1=((M))
- SA4 X1 X4=M A4=(M)
- S_ONE 1 ONE=1
- SA5 A1+ONE X5=(N) A5=((N))
- SA2 A1+7 X2=(Z) A2=((Z))
- SA1 A5+ONE X1=(D) A1=((D))
- SA3 A2+ONE X3=(Z12) A3=((Z12))
- S_MM X4 MM=M
- SA4 A3+ONE X4=(Z21) A4=((Z21))
- LE MM,B0,EX IF M.LE.0 EXIT WITH A0 PRESERVED
- SA5 X5 X5=N A5=(N)
- SX6 A0 X6=OLD A0
- IX7 X3-X2 X7=(Z12)-(Z)
- SA3 A1+2 X3=(X) A3=((X))
- SA6 SAVEA0 SAVE OLD A0
- S_D X1 D=(D(1))
- BX6 X1 X6=(D)
- SA1 A1+ONE X1=(D2) A1=((D2))
- S_JZ X7 JZ=(Z12)-(Z)
- IX7 X4-X2 X7=(Z21)-(Z)
- SA4 A3+ONE X4=(X12) A4=((X12))
- S_NN X5 NN=N
- SA5 A4+ONE X5=(X21) A5=((X21))
- LE NN,B0,EX IF N.LE.0 EXIT WITH A0 PRESERVED
- BX0 X3 X0=(X)
- SA0 X2 A0=(Z)
- IX1 X1-X6 X1=(D2)-(D)
- IX4 X4-X3 X4=(X12)-(X)
- IX6 X5-X3 X6=(X21)-(X)
- S_ID X1 ID=(D2)-(D)
- S_JX X4 JX=(X12)-(X)
- PROLOG ENDM
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003cd/rumna.s b/src/packlib/kernlib/kernnum/obsolete/f003cd/rumna.s
deleted file mode 100644
index a8cdb46..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003cd/rumna.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: rumna.s,v 1.1.1.1 1996/02/15 17:48:09 mclareni Exp $
-*
-* $Log: rumna.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:09 mclareni
-* Kernlib
-*
-*
- IDENT RUMNA
-#include "umpy.inc"
- MAIN RTYPE,UMNA,B1,B2,B3,B4,B5,B6
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003cd/rumns.s b/src/packlib/kernlib/kernnum/obsolete/f003cd/rumns.s
deleted file mode 100644
index 56944bd..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003cd/rumns.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: rumns.s,v 1.1.1.1 1996/02/15 17:48:09 mclareni Exp $
-*
-* $Log: rumns.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:09 mclareni
-* Kernlib
-*
-*
- IDENT RUMNS
-#include "umpy.inc"
- MAIN RTYPE,UMNS,B1,B2,B3,B4,B5,B6
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003cd/rumpa.s b/src/packlib/kernlib/kernnum/obsolete/f003cd/rumpa.s
deleted file mode 100644
index b467a86..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003cd/rumpa.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: rumpa.s,v 1.1.1.1 1996/02/15 17:48:10 mclareni Exp $
-*
-* $Log: rumpa.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:10 mclareni
-* Kernlib
-*
-*
- IDENT RUMPA
-#include "umpy.inc"
- MAIN RTYPE,UMPA,B1,B2,B3,B4,B5,B6
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003cd/rumps.s b/src/packlib/kernlib/kernnum/obsolete/f003cd/rumps.s
deleted file mode 100644
index 4a412a4..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003cd/rumps.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: rumps.s,v 1.1.1.1 1996/02/15 17:48:10 mclareni Exp $
-*
-* $Log: rumps.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:10 mclareni
-* Kernlib
-*
-*
- IDENT RUMPS
-#include "umpy.inc"
- MAIN RTYPE,UMPS,B1,B2,B3,B4,B5,B6
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003cd/rumpy.s b/src/packlib/kernlib/kernnum/obsolete/f003cd/rumpy.s
deleted file mode 100644
index 232da7b..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003cd/rumpy.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: rumpy.s,v 1.1.1.1 1996/02/15 17:48:10 mclareni Exp $
-*
-* $Log: rumpy.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:10 mclareni
-* Kernlib
-*
-*
- IDENT RUMPY
-#include "umpy.inc"
- MAIN RTYPE,UMPY,B1,B2,B3,B4,B5,B6
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003cd/umpy.inc b/src/packlib/kernlib/kernnum/obsolete/f003cd/umpy.inc
deleted file mode 100644
index d3552a0..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003cd/umpy.inc
+++ /dev/null
@@ -1,79 +0,0 @@
-*
-* $Id: umpy.inc,v 1.1.1.1 1996/02/15 17:48:06 mclareni Exp $
-*
-* $Log: umpy.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:06 mclareni
-* Kernlib
-*
-*
-*
-* umpy.inc
-*
-*CALL BASIC
-*CALL MPY
- UMNA SET 1
- UMNS SET 2
- UMPA SET 3
- UMPS SET 4
- UMPY SET 5
- MAIN MACRO TYPE,FCN,M,IX,JX,JY,IZ,J
- SETYPE TYPE
- IFEQ FCN,UMNA,3
- SIGNX MICRO 1,,*-*
- SIGNZ MICRO 1,,*+*
- VERB MICRO 1,,*UMNA*
- IFEQ FCN,UMNS,3
- SIGNX MICRO 1,,*-*
- SIGNZ MICRO 1,,*-*
- VERB MICRO 1,,*UMNS*
- IFEQ FCN,UMPA,3
- SIGNX MICRO 1,,*+*
- SIGNZ MICRO 1,,*+*
- VERB MICRO 1,,*UMPA*
- IFEQ FCN,UMPS,3
- SIGNX MICRO 1,,*+*
- SIGNZ MICRO 1,,*-*
- VERB MICRO 1,,*UMPS*
- IFEQ FCN,UMPY,3
- SIGNX MICRO 1,,*+*
- SIGNZ MICRO 1,,*0*
- VERB MICRO 1,,*UMPY*
- NAME MICRO 1,,*"P"_"VERB"*
- HEADER "NAME",SAVEA0
- TEMP2 BSS 2 WORKING STORE
- EXIT "NAME" (M,X,X12,X21,Y,Y2,Z,Z2)
- PROLOG M,IX,JX,JY,IZ,J
-* X1=(X), X2=(Y), A0=(Z)
- "P"UMPY "SIGNX",M,IX,JX,JY,"SIGNZ",A0,IZ,TEMP2,J
- EPILOG
- ENDM
- PROLOG MACRO MM,IX,JX,JY,IZ,ONE X1=(X),X2=(Y),A0=(Z)
- BSS 0 X1=(M) A1=((M))
- + SA5 A1+6 0 X5=(Z) A5=((Z))
- S_ONE 1 1 ONE=1
- + SA2 X1 2 X2=M A2=(M)
- SA3 A5+ONE 3 X3=(Z2) A3=((Z2))
- SA4 A5-ONE 4 X4=(Y2) A4=((Y2))
- SX7 A0 5 X7=OLD A0
-* 6 X7
-* 7 X5
- + SA1 A1+ONE 8 X1=(X) A1=((X))
- SA7 SAVEA0 9 X2 SAVEA0 = OLD A0
- S_MM X2 10 X3 MM=M
- + SA2 A4-ONE 11 X4 X2=(Y) A2=((Y))
- IX6 X3-X5 12 X6=(Z2)-(Z)=IZ
- SA3 A1+ONE 13 X6 X3=(X12) A3=((X12))
- SA0 X5 14 A0=(Z)
- + SA5 A2-ONE 15 X1 X5=(X22) A5=((X22))
-* 16
- LE MM,B0,EPILOG IF M.LE.0 GOTO EPILOG
- S_IZ X6 18 X2 IZ=(Z2)-(Z)
- + NO 19
- IX7 X4-X2 20 X3 X7=(Y2)-(Y)=JY
-* 21 X7
- IX6 X3-X1 22 X5 X6=(X12)-(X)=JX
- IX0 X5-X3 23 X6 X0=(X22)-(X12)=IX
- + S_JY X7 24 X0 JY=(Y2)-(Y)
- S_JX X6 25 JX=(X12)-(X)
- S_IX X0 26 IX=(X22)-(X12)
- PROLOG ENDM
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003ib/Imakefile b/src/packlib/kernlib/kernnum/obsolete/f003ib/Imakefile
deleted file mode 100644
index 852c905..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003ib/Imakefile
+++ /dev/null
@@ -1,11 +0,0 @@
-SRCS_S= \ @@\
- ccmmpy.s ccumpy.s cmadd.s cmbil.s cmcpy.s cmmna.s cmmns.s cmmpa.s \ @@\
- cmmps.s cmmpy.s cmmpyc.s cmran.s cmscl.s cmset.s cmsub.s cmutl.s \ @@\
- crscl.s cumna.s cumns.s cumpa.s cumps.s cumpy.s cumpyc.s dmadd.s \ @@\
- dmbil.s dmcpy.s dmmna.s dmmns.s dmmpa.s dmmps.s dmmpy.s dmran.s \ @@\
- dmscl.s dmset.s dmsub.s dmutl.s drscl.s dumna.s dumns.s dumpa.s \ @@\
- dumps.s dumpy.s rmadd.s rmbil.s rmcpy.s rmmna.s rmmns.s rmmpa.s \ @@\
- rmmps.s rmmpy.s rmran.s rmscl.s rmset.s rmsub.s rmutl.s rrscl.s \ @@\
- rumna.s rumns.s rumpa.s rumps.s rumpy.s
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003ib/ccmmpy.s b/src/packlib/kernlib/kernnum/obsolete/f003ib/ccmmpy.s
deleted file mode 100644
index 0493254..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003ib/ccmmpy.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: ccmmpy.s,v 1.1.1.1 1996/02/15 17:48:25 mclareni Exp $
-*
-* $Log: ccmmpy.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:25 mclareni
-* Kernlib
-*
-*
-#include "kernnum/mmpy.inc"
- &TYPE SETA &CCTYPE
- &NAME SETC 'CMMPY'
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003ib/ccumpy.s b/src/packlib/kernlib/kernnum/obsolete/f003ib/ccumpy.s
deleted file mode 100644
index b250f18..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003ib/ccumpy.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: ccumpy.s,v 1.1.1.1 1996/02/15 17:48:28 mclareni Exp $
-*
-* $Log: ccumpy.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:28 mclareni
-* Kernlib
-*
-*
-#include "kernnum/umpy.inc"
- &TYPE SETA &CCTYPE
- &NAME SETC 'CUMPY'
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003ib/cmadd.s b/src/packlib/kernlib/kernnum/obsolete/f003ib/cmadd.s
deleted file mode 100644
index 9cb210f..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003ib/cmadd.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: cmadd.s,v 1.1.1.1 1996/02/15 17:48:22 mclareni Exp $
-*
-* $Log: cmadd.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:22 mclareni
-* Kernlib
-*
-*
-#include "kernnum/madd.inc"
- &TYPE SETA &CTYPE
- &NAME SETC 'MADD '
- MAIN A
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003ib/cmbil.s b/src/packlib/kernlib/kernnum/obsolete/f003ib/cmbil.s
deleted file mode 100644
index 192f801..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003ib/cmbil.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: cmbil.s,v 1.1.1.1 1996/02/15 17:48:23 mclareni Exp $
-*
-* $Log: cmbil.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:23 mclareni
-* Kernlib
-*
-*
-#include "kernnum/mbil.inc"
- &TYPE SETA &CTYPE
- &NAME SETC 'MBIL '
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003ib/cmcpy.s b/src/packlib/kernlib/kernnum/obsolete/f003ib/cmcpy.s
deleted file mode 100644
index a1a71e2..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003ib/cmcpy.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: cmcpy.s,v 1.1.1.1 1996/02/15 17:48:23 mclareni Exp $
-*
-* $Log: cmcpy.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:23 mclareni
-* Kernlib
-*
-*
-#include "kernnum/mcpy.inc"
- &TYPE SETA &CTYPE
- &NAME SETC 'MCPY '
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003ib/cmmna.s b/src/packlib/kernlib/kernnum/obsolete/f003ib/cmmna.s
deleted file mode 100644
index 0bbe71e..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003ib/cmmna.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: cmmna.s,v 1.1.1.1 1996/02/15 17:48:24 mclareni Exp $
-*
-* $Log: cmmna.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:24 mclareni
-* Kernlib
-*
-*
-#include "kernnum/mmpy.inc"
- &TYPE SETA &CTYPE
- &NAME SETC 'MMNA '
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003ib/cmmns.s b/src/packlib/kernlib/kernnum/obsolete/f003ib/cmmns.s
deleted file mode 100644
index f1b0abd..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003ib/cmmns.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: cmmns.s,v 1.1.1.1 1996/02/15 17:48:24 mclareni Exp $
-*
-* $Log: cmmns.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:24 mclareni
-* Kernlib
-*
-*
-#include "kernnum/mmpy.inc"
- &TYPE SETA &CTYPE
- &NAME SETC 'MMNS '
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003ib/cmmpa.s b/src/packlib/kernlib/kernnum/obsolete/f003ib/cmmpa.s
deleted file mode 100644
index db22815..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003ib/cmmpa.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: cmmpa.s,v 1.1.1.1 1996/02/15 17:48:25 mclareni Exp $
-*
-* $Log: cmmpa.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:25 mclareni
-* Kernlib
-*
-*
-#include "kernnum/mmpy.inc"
- &TYPE SETA &CTYPE
- &NAME SETC 'MMPA '
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003ib/cmmps.s b/src/packlib/kernlib/kernnum/obsolete/f003ib/cmmps.s
deleted file mode 100644
index 4bc65cf..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003ib/cmmps.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: cmmps.s,v 1.1.1.1 1996/02/15 17:48:25 mclareni Exp $
-*
-* $Log: cmmps.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:25 mclareni
-* Kernlib
-*
-*
-#include "kernnum/mmpy.inc"
- &TYPE SETA &CTYPE
- &NAME SETC 'MMPS '
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003ib/cmmpy.s b/src/packlib/kernlib/kernnum/obsolete/f003ib/cmmpy.s
deleted file mode 100644
index 1e9524d..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003ib/cmmpy.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: cmmpy.s,v 1.1.1.1 1996/02/15 17:48:25 mclareni Exp $
-*
-* $Log: cmmpy.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:25 mclareni
-* Kernlib
-*
-*
-#include "kernnum/mmpy.inc"
- &TYPE SETA &CTYPE
- &NAME SETC 'MMPY '
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003ib/cmmpyc.s b/src/packlib/kernlib/kernnum/obsolete/f003ib/cmmpyc.s
deleted file mode 100644
index 4e485f1..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003ib/cmmpyc.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: cmmpyc.s,v 1.1.1.1 1996/02/15 17:48:25 mclareni Exp $
-*
-* $Log: cmmpyc.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:25 mclareni
-* Kernlib
-*
-*
-#include "kernnum/mmpy.inc"
- &TYPE SETA &CTYPEC
- &NAME SETC 'MMPYC'
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003ib/cmran.s b/src/packlib/kernlib/kernnum/obsolete/f003ib/cmran.s
deleted file mode 100644
index 79d1f52..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003ib/cmran.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: cmran.s,v 1.1.1.1 1996/02/15 17:48:26 mclareni Exp $
-*
-* $Log: cmran.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:26 mclareni
-* Kernlib
-*
-*
-#include "kernnum/mran.inc"
- &TYPE SETA &CTYPE
- &NAME SETC 'MRAN '
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003ib/cmscl.s b/src/packlib/kernlib/kernnum/obsolete/f003ib/cmscl.s
deleted file mode 100644
index f6860c0..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003ib/cmscl.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: cmscl.s,v 1.1.1.1 1996/02/15 17:48:26 mclareni Exp $
-*
-* $Log: cmscl.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:26 mclareni
-* Kernlib
-*
-*
-#include "kernnum/mscl.inc"
- &TYPE SETA &CTYPE
- &NAME SETC 'MSCL '
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003ib/cmset.s b/src/packlib/kernlib/kernnum/obsolete/f003ib/cmset.s
deleted file mode 100644
index 9759b4f..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003ib/cmset.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: cmset.s,v 1.1.1.1 1996/02/15 17:48:26 mclareni Exp $
-*
-* $Log: cmset.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:26 mclareni
-* Kernlib
-*
-*
-#include "kernnum/mset.inc"
- &TYPE SETA &CTYPE
- &NAME SETC 'MSET '
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003ib/cmsub.s b/src/packlib/kernlib/kernnum/obsolete/f003ib/cmsub.s
deleted file mode 100644
index 62fc60b..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003ib/cmsub.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: cmsub.s,v 1.1.1.1 1996/02/15 17:48:26 mclareni Exp $
-*
-* $Log: cmsub.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:26 mclareni
-* Kernlib
-*
-*
-#include "kernnum/madd.inc"
- &TYPE SETA &CTYPE
- &NAME SETC 'MSUB '
- MAIN S
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003ib/cmutl.s b/src/packlib/kernlib/kernnum/obsolete/f003ib/cmutl.s
deleted file mode 100644
index dff6213..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003ib/cmutl.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: cmutl.s,v 1.1.1.1 1996/02/15 17:48:26 mclareni Exp $
-*
-* $Log: cmutl.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:26 mclareni
-* Kernlib
-*
-*
-#include "kernnum/mutl.inc"
- &TYPE SETA &CTYPE
- &NAME SETC 'MUTL'
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003ib/crscl.s b/src/packlib/kernlib/kernnum/obsolete/f003ib/crscl.s
deleted file mode 100644
index 6d50be0..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003ib/crscl.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: crscl.s,v 1.1.1.1 1996/02/15 17:48:27 mclareni Exp $
-*
-* $Log: crscl.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:27 mclareni
-* Kernlib
-*
-*
-#include "kernnum/rscl.inc"
- &TYPE SETA &CTYPE
- &NAME SETC 'RSCL '
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003ib/cumna.s b/src/packlib/kernlib/kernnum/obsolete/f003ib/cumna.s
deleted file mode 100644
index 0cdd3ea..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003ib/cumna.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: cumna.s,v 1.1.1.1 1996/02/15 17:48:27 mclareni Exp $
-*
-* $Log: cumna.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:27 mclareni
-* Kernlib
-*
-*
-#include "kernnum/umpy.inc"
- &TYPE SETA &CTYPE
- &NAME SETC 'UMNA '
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003ib/cumns.s b/src/packlib/kernlib/kernnum/obsolete/f003ib/cumns.s
deleted file mode 100644
index 2af9336..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003ib/cumns.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: cumns.s,v 1.1.1.1 1996/02/15 17:48:27 mclareni Exp $
-*
-* $Log: cumns.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:27 mclareni
-* Kernlib
-*
-*
-#include "kernnum/umpy.inc"
- &TYPE SETA &CTYPE
- &NAME SETC 'UMNS '
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003ib/cumpa.s b/src/packlib/kernlib/kernnum/obsolete/f003ib/cumpa.s
deleted file mode 100644
index d790f96..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003ib/cumpa.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: cumpa.s,v 1.1.1.1 1996/02/15 17:48:27 mclareni Exp $
-*
-* $Log: cumpa.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:27 mclareni
-* Kernlib
-*
-*
-#include "kernnum/umpy.inc"
- &TYPE SETA &CTYPE
- &NAME SETC 'UMPA '
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003ib/cumps.s b/src/packlib/kernlib/kernnum/obsolete/f003ib/cumps.s
deleted file mode 100644
index 35a3744..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003ib/cumps.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: cumps.s,v 1.1.1.1 1996/02/15 17:48:28 mclareni Exp $
-*
-* $Log: cumps.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:28 mclareni
-* Kernlib
-*
-*
-#include "kernnum/umpy.inc"
- &TYPE SETA &CTYPE
- &NAME SETC 'UMPS '
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003ib/cumpy.s b/src/packlib/kernlib/kernnum/obsolete/f003ib/cumpy.s
deleted file mode 100644
index b6b5704..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003ib/cumpy.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: cumpy.s,v 1.1.1.1 1996/02/15 17:48:28 mclareni Exp $
-*
-* $Log: cumpy.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:28 mclareni
-* Kernlib
-*
-*
-#include "kernnum/umpy.inc"
- &TYPE SETA &CTYPE
- &NAME SETC 'UMPY '
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003ib/cumpyc.s b/src/packlib/kernlib/kernnum/obsolete/f003ib/cumpyc.s
deleted file mode 100644
index 1cb6189..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003ib/cumpyc.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: cumpyc.s,v 1.1.1.1 1996/02/15 17:48:28 mclareni Exp $
-*
-* $Log: cumpyc.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:28 mclareni
-* Kernlib
-*
-*
-#include "kernnum/umpy.inc"
- &TYPE SETA &CTYPEC
- &NAME SETC 'UMPYC'
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003ib/dmadd.s b/src/packlib/kernlib/kernnum/obsolete/f003ib/dmadd.s
deleted file mode 100644
index cc160a9..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003ib/dmadd.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: dmadd.s,v 1.1.1.1 1996/02/15 17:48:22 mclareni Exp $
-*
-* $Log: dmadd.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:22 mclareni
-* Kernlib
-*
-*
-#include "kernnum/madd.inc"
- &TYPE SETA &DTYPE
- &NAME SETC 'MADD '
- MAIN A
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003ib/dmbil.s b/src/packlib/kernlib/kernnum/obsolete/f003ib/dmbil.s
deleted file mode 100644
index 2a411f1..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003ib/dmbil.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: dmbil.s,v 1.1.1.1 1996/02/15 17:48:23 mclareni Exp $
-*
-* $Log: dmbil.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:23 mclareni
-* Kernlib
-*
-*
-#include "kernnum/mbil.inc"
- &TYPE SETA &DTYPE
- &NAME SETC 'MBIL '
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003ib/dmcpy.s b/src/packlib/kernlib/kernnum/obsolete/f003ib/dmcpy.s
deleted file mode 100644
index c6d824a..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003ib/dmcpy.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: dmcpy.s,v 1.1.1.1 1996/02/15 17:48:23 mclareni Exp $
-*
-* $Log: dmcpy.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:23 mclareni
-* Kernlib
-*
-*
-#include "kernnum/mcpy.inc"
- &TYPE SETA &DTYPE
- &NAME SETC 'MCPY '
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003ib/dmmna.s b/src/packlib/kernlib/kernnum/obsolete/f003ib/dmmna.s
deleted file mode 100644
index 6a9f64d..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003ib/dmmna.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: dmmna.s,v 1.1.1.1 1996/02/15 17:48:24 mclareni Exp $
-*
-* $Log: dmmna.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:24 mclareni
-* Kernlib
-*
-*
-#include "kernnum/mmpy.inc"
- &TYPE SETA &DTYPE
- &NAME SETC 'MMNA '
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003ib/dmmns.s b/src/packlib/kernlib/kernnum/obsolete/f003ib/dmmns.s
deleted file mode 100644
index bf4fda7..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003ib/dmmns.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: dmmns.s,v 1.1.1.1 1996/02/15 17:48:24 mclareni Exp $
-*
-* $Log: dmmns.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:24 mclareni
-* Kernlib
-*
-*
-#include "kernnum/mmpy.inc"
- &TYPE SETA &DTYPE
- &NAME SETC 'MMNS '
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003ib/dmmpa.s b/src/packlib/kernlib/kernnum/obsolete/f003ib/dmmpa.s
deleted file mode 100644
index e6028e4..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003ib/dmmpa.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: dmmpa.s,v 1.1.1.1 1996/02/15 17:48:25 mclareni Exp $
-*
-* $Log: dmmpa.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:25 mclareni
-* Kernlib
-*
-*
-#include "kernnum/mmpy.inc"
- &TYPE SETA &DTYPE
- &NAME SETC 'MMPA '
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003ib/dmmps.s b/src/packlib/kernlib/kernnum/obsolete/f003ib/dmmps.s
deleted file mode 100644
index a02aed6..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003ib/dmmps.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: dmmps.s,v 1.1.1.1 1996/02/15 17:48:25 mclareni Exp $
-*
-* $Log: dmmps.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:25 mclareni
-* Kernlib
-*
-*
-#include "kernnum/mmpy.inc"
- &TYPE SETA &DTYPE
- &NAME SETC 'MMPS '
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003ib/dmmpy.s b/src/packlib/kernlib/kernnum/obsolete/f003ib/dmmpy.s
deleted file mode 100644
index 1ce1cb3..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003ib/dmmpy.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: dmmpy.s,v 1.1.1.1 1996/02/15 17:48:25 mclareni Exp $
-*
-* $Log: dmmpy.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:25 mclareni
-* Kernlib
-*
-*
-#include "kernnum/mmpy.inc"
- &TYPE SETA &DTYPE
- &NAME SETC 'MMPY '
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003ib/dmran.s b/src/packlib/kernlib/kernnum/obsolete/f003ib/dmran.s
deleted file mode 100644
index 1259840..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003ib/dmran.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: dmran.s,v 1.1.1.1 1996/02/15 17:48:25 mclareni Exp $
-*
-* $Log: dmran.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:25 mclareni
-* Kernlib
-*
-*
-#include "kernnum/mran.inc"
- &TYPE SETA &DTYPE
- &NAME SETC 'MRAN '
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003ib/dmscl.s b/src/packlib/kernlib/kernnum/obsolete/f003ib/dmscl.s
deleted file mode 100644
index 3cabbac..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003ib/dmscl.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: dmscl.s,v 1.1.1.1 1996/02/15 17:48:26 mclareni Exp $
-*
-* $Log: dmscl.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:26 mclareni
-* Kernlib
-*
-*
-#include "kernnum/mscl.inc"
- &TYPE SETA &DTYPE
- &NAME SETC 'MSCL '
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003ib/dmset.s b/src/packlib/kernlib/kernnum/obsolete/f003ib/dmset.s
deleted file mode 100644
index 7eae344..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003ib/dmset.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: dmset.s,v 1.1.1.1 1996/02/15 17:48:26 mclareni Exp $
-*
-* $Log: dmset.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:26 mclareni
-* Kernlib
-*
-*
-#include "kernnum/mset.inc"
- &TYPE SETA &DTYPE
- &NAME SETC 'MSET '
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003ib/dmsub.s b/src/packlib/kernlib/kernnum/obsolete/f003ib/dmsub.s
deleted file mode 100644
index 89d9fa3..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003ib/dmsub.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: dmsub.s,v 1.1.1.1 1996/02/15 17:48:26 mclareni Exp $
-*
-* $Log: dmsub.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:26 mclareni
-* Kernlib
-*
-*
-#include "kernnum/madd.inc"
- &TYPE SETA &DTYPE
- &NAME SETC 'MSUB '
- MAIN S
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003ib/dmutl.s b/src/packlib/kernlib/kernnum/obsolete/f003ib/dmutl.s
deleted file mode 100644
index 297d87f..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003ib/dmutl.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: dmutl.s,v 1.1.1.1 1996/02/15 17:48:26 mclareni Exp $
-*
-* $Log: dmutl.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:26 mclareni
-* Kernlib
-*
-*
-#include "kernnum/mutl.inc"
- &TYPE SETA &DTYPE
- &NAME SETC 'MUTL'
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003ib/drscl.s b/src/packlib/kernlib/kernnum/obsolete/f003ib/drscl.s
deleted file mode 100644
index 9e985a9..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003ib/drscl.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: drscl.s,v 1.1.1.1 1996/02/15 17:48:27 mclareni Exp $
-*
-* $Log: drscl.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:27 mclareni
-* Kernlib
-*
-*
-#include "kernnum/rscl.inc"
- &TYPE SETA &DTYPE
- &NAME SETC 'RSCL '
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003ib/dumna.s b/src/packlib/kernlib/kernnum/obsolete/f003ib/dumna.s
deleted file mode 100644
index f2ec203..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003ib/dumna.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: dumna.s,v 1.1.1.1 1996/02/15 17:48:27 mclareni Exp $
-*
-* $Log: dumna.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:27 mclareni
-* Kernlib
-*
-*
-#include "kernnum/umpy.inc"
- &TYPE SETA &DTYPE
- &NAME SETC 'UMNA '
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003ib/dumns.s b/src/packlib/kernlib/kernnum/obsolete/f003ib/dumns.s
deleted file mode 100644
index ea917da..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003ib/dumns.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: dumns.s,v 1.1.1.1 1996/02/15 17:48:27 mclareni Exp $
-*
-* $Log: dumns.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:27 mclareni
-* Kernlib
-*
-*
-#include "kernnum/umpy.inc"
- &TYPE SETA &DTYPE
- &NAME SETC 'UMNS '
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003ib/dumpa.s b/src/packlib/kernlib/kernnum/obsolete/f003ib/dumpa.s
deleted file mode 100644
index 338683b..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003ib/dumpa.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: dumpa.s,v 1.1.1.1 1996/02/15 17:48:27 mclareni Exp $
-*
-* $Log: dumpa.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:27 mclareni
-* Kernlib
-*
-*
-#include "kernnum/umpy.inc"
- &TYPE SETA &DTYPE
- &NAME SETC 'UMPA '
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003ib/dumps.s b/src/packlib/kernlib/kernnum/obsolete/f003ib/dumps.s
deleted file mode 100644
index 4cec90b..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003ib/dumps.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: dumps.s,v 1.1.1.1 1996/02/15 17:48:28 mclareni Exp $
-*
-* $Log: dumps.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:28 mclareni
-* Kernlib
-*
-*
-#include "kernnum/umpy.inc"
- &TYPE SETA &DTYPE
- &NAME SETC 'UMPS '
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003ib/dumpy.s b/src/packlib/kernlib/kernnum/obsolete/f003ib/dumpy.s
deleted file mode 100644
index 779b827..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003ib/dumpy.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: dumpy.s,v 1.1.1.1 1996/02/15 17:48:28 mclareni Exp $
-*
-* $Log: dumpy.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:28 mclareni
-* Kernlib
-*
-*
-#include "kernnum/umpy.inc"
- &TYPE SETA &DTYPE
- &NAME SETC 'UMPY '
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003ib/madd.inc b/src/packlib/kernlib/kernnum/obsolete/f003ib/madd.inc
deleted file mode 100644
index 9bddf8f..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003ib/madd.inc
+++ /dev/null
@@ -1,67 +0,0 @@
-*
-* $Id: madd.inc,v 1.1.1.1 1996/02/15 17:48:21 mclareni Exp $
-*
-* $Log: madd.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:21 mclareni
-* Kernlib
-*
-*
-*
-* madd.inc
-*
-#include "basic.inc"
-#include "add.inc"
- MACRO
- MAIN &F
-#include "global.inc"
- &TWORDS SETA 10
- SETYPE
- HEADER ENTRY (M,N,X,X12,X21,Y,Y12,Y21,Z,Z12,Z21)
- M EQU 2
- N EQU 3
- X EQU 4
- JX EQU 5
- IX EQU 6
- Y EQU 7
- JY EQU 8
- IY EQU 9
- Z EQU 10
- JZ EQU 11
- IZ EQU 12
- ®LIM SETA 12
- ENTRY PROLOG
- LM 2,12,0(1)
- * R2 = (M)
- * R3 = (N)
- * R4 = (X)
- * R5 = (X12)
- * R6 = (X21)
- * R7 = (Y)
- * R8 = (Y12)
- * R9 = (Y21)
- * R10= (Z)
- * R11= (Z12)
- * R12= (Z21) + 8000 0000
- LA 12,0(12) R12= (Z21)
- L M,0(2)
- L N,0(3)
- LTR 0,M TEST R0 = M
- BNH RETURN IF(M .LE. 0) RETURN
- LTR 0,N TEST R0 = N
- BNH RETURN IF(N .LE. 0) RETURN
- SR 5,4 R5 = (X12) - (X) = JX
- SR 6,4 R6 = (X21) - (X) = IX
- SR 8,7 R8 = (Y12) - (Y) = JY
- SR 9,7 R9 = (Y21) - (Y) = IY
- SR 11,10 R11= (Z12) - (Z) = JZ
- SR 12,10 R12= (Z21) - (Z) = IZ
- CR M,N
- BNH ALABEL IF(M .LE. N)
- SWAP M,N
- SWAP IX,JX
- SWAP IY,JY
- SWAP IZ,JZ
- ALABEL TMADD &F,M,N,X,IX,JX,Y,IY,JY,Z,IZ,JZ
- RETURN EPILOG
- MEND
-#include "tglobal.inc"
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003ib/mbil.inc b/src/packlib/kernlib/kernnum/obsolete/f003ib/mbil.inc
deleted file mode 100644
index 9d3f1e7..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003ib/mbil.inc
+++ /dev/null
@@ -1,53 +0,0 @@
-*
-* $Id: mbil.inc,v 1.1.1.1 1996/02/15 17:48:22 mclareni Exp $
-*
-* $Log: mbil.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:22 mclareni
-* Kernlib
-*
-*
-*
-* mbil.inc
-*
-#include "basic.inc"
-#include "mpy.inc"
- MACRO
- MAIN
-#include "global.inc"
- &TWORDS SETA 7
- SETYPE
- HEADER ENTRY (N,X,X2,Y,Y12,Y21,Z,Z2)
- JZ2 EQU 2
- N EQU 3
- X EQU 4
- IX EQU 5
- Y EQU 6
- JY EQU 7
- IY EQU 8
- Z EQU 9
- JZ EQU 10
- JY2 EQU 11
- ®LIM SETA 11
- ENTRY PROLOG
- LM 3,10,0(1)
- * R3 = (N)
- * R4 = (X)
- * R5 = (X2)
- * R6 = (Y)
- * R7 = (Y12)
- * R8 = (Y21)
- * R9 = (Z)
- * R10= (Z2) + 8000 0000
- LA 10,0(10) R10= (Z2)
- L N,0(3) R3 = N
- CLEAR 0 F0 [,F2] = 0.
- LTR 0,N TEST R0 = N
- BNH RETURN IF(N .LE. 0) RETURN
- SR 5,4 R5 = (X2) - (X) = IX
- SR 7,6 R7 = (Y12)- (Y) = JY
- SR 8,6 R8 = (Y21)- (Y) = IY
- SR 10,9 R10= (Z2) - (Z) = JZ
- TMBIL N,X,IX,Y,IY,JY,Z,JZ,JY2,JZ2
- RETURN EPILOG
- MEND
-#include "tglobal.inc"
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003ib/mcpy.inc b/src/packlib/kernlib/kernnum/obsolete/f003ib/mcpy.inc
deleted file mode 100644
index 7a212a8..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003ib/mcpy.inc
+++ /dev/null
@@ -1,58 +0,0 @@
-*
-* $Id: mcpy.inc,v 1.1.1.1 1996/02/15 17:48:22 mclareni Exp $
-*
-* $Log: mcpy.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:22 mclareni
-* Kernlib
-*
-*
-*
-* mcpy.inc
-*
-#include "basic.inc"
-#include "cpy.inc"
- MACRO
- MAIN
-#include "global.inc"
- &TWORDS SETA 5
- SETYPE
- HEADER ENTRY (M,N,X,X12,X21,Z,Z12,Z21)
- M EQU 2
- N EQU 3
- X EQU 4
- JX EQU 5
- IX EQU 6
- Z EQU 7
- JZ EQU 8
- IZ EQU 9
- ®LIM SETA 9
- ENTRY PROLOG
- LM 2,9,0(1)
- * R2 = (M)
- * R3 = (N)
- * R4 = (X)
- * R5 = (X12)
- * R6 = (X21)
- * R7 = (Z)
- * R8 = (Z12)
- * R9 = (Z21) + 8000 0000
- LA 9,0(9) R9 = (Z21)
- L M,0(2)
- L N,0(3)
- LTR 0,M TEST R0 = M
- BNH RETURN IF(M .LE. 0) RETURN
- LTR 0,N TEST R0 = N
- BNH RETURN IF(N .LE. 0) RETURN
- SR 5,4 R5 = (X12) - (X) = JX
- SR 6,4 R6 = (X21) - (X) = IX
- SR 8,7 R8 = (Z12) - (Z) = JZ
- SR 9,7 R9 = (Z21) - (Z) = IZ
- CR M,N
- BNH ALABEL IF(M .LE. N)
- SWAP M,N
- SWAP IX,JX
- SWAP IZ,JZ
- ALABEL TMCPY M,N,X,IX,JX,Z,IZ,JZ
- RETURN EPILOG
- MEND
-#include "tglobal.inc"
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003ib/mmpy.inc b/src/packlib/kernlib/kernnum/obsolete/f003ib/mmpy.inc
deleted file mode 100644
index a5b3a94..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003ib/mmpy.inc
+++ /dev/null
@@ -1,60 +0,0 @@
-*
-* $Id: mmpy.inc,v 1.1.1.1 1996/02/15 17:48:22 mclareni Exp $
-*
-* $Log: mmpy.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:22 mclareni
-* Kernlib
-*
-*
-*
-* mmpy.inc
-*
-#include "basic.inc"
-#include "mpy.inc"
- MACRO
- MAIN
-#include "global.inc"
- LCLC &OPC
- &OPC SETC '&NAME'(1,4)
- AIF (&TYPE NE &CCTYPE).ALPHA
- &OPC SETC '&NAME'(2,4)
- .ALPHA ANOP
- &TWORDS SETA 5
- SETYPE
- HEADER ENTRY (M,N,X,X12,X21,Y,Y2,Z,Z2)
- M EQU 2
- N EQU 3
- X EQU 4
- JX EQU 5
- IX EQU 6
- Y EQU 7
- JY EQU 8
- Z EQU 9
- IZ EQU 10
- ®LIM SETA 10
- ENTRY PROLOG
- LM 2,10,0(1)
- * R2 = (M)
- * R3 = (N)
- * R4 = (X)
- * R5 = (X12)
- * R6 = (X21)
- * R7 = (Y)
- * R8 = (Y2)
- * R9 = (Z)
- * R10= (Z2) + 8000 0000
- LA 10,0(10) R10= (Z2)
- L M,0(2)
- L N,0(3)
- LTR 0,M TEST R0 = M
- BNH RETURN IF(M .LE. 0) RETURN
- LTR 0,N TEST R0 = N
- BNH RETURN IF(N .LE. 0) RETURN
- SR 6,4 R6 = (X21)- (X) = IX
- SR 10,9 R10= (Z2) - (Z) = IZ
- SR 5,4 R5 = (X12) - (X)
- SR 8,7 R8 = (Y2) - (Y)
- TXMPY &OPC,M,N,X,IX,JX,Y,JY,Z,IZ
- RETURN EPILOG
- MEND
-#include "tglobal.inc"
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003ib/mran.inc b/src/packlib/kernlib/kernnum/obsolete/f003ib/mran.inc
deleted file mode 100644
index b1ccf13..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003ib/mran.inc
+++ /dev/null
@@ -1,83 +0,0 @@
-*
-* $Id: mran.inc,v 1.1.1.1 1996/02/15 17:48:22 mclareni Exp $
-*
-* $Log: mran.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:22 mclareni
-* Kernlib
-*
-*
-*
-* mran.inc
-*
-#include "basic.inc"
-#include "ran.inc"
- MACRO
- MAIN
-#include "global.inc"
- &TWORDS SETA 23
- SETYPE
- HEADER ENTRY (M,N,A,B,Z,Z12,Z21)
- AIF ('&T' EQ 'D').ALPHA
- A DS 1F
- C DS 1F
- AGO .BETA
- .ALPHA ANOP
- DS 0D
- A DS 1D
- C DS 1D
- .BETA ANOP
- GET DC V(RANGET)
- SET DC V(RANSET)
- LIST DC A(SEED)
- SEED DS 2F 002BC68C 00FE166D
- DATA RANDATA SEED IS FIRST DOUBLE WORD
- NSTEP EQU 2
- N EQU 3
- MSTEP EQU 4
- M EQU 5
- Z EQU 6
- JZ EQU 7
- IZ EQU 8
- JZ2 EQU 9
- I EQU 10
- J EQU 11
- ®LIM SETA 11
- ENTRY PROLOG
- LM 2,8,0(1)
- * R2 = (M)
- * R3 = (N)
- * R4 = (A)
- * R5 = (B)
- * R6 = (Z)
- * R7 = (Z12)
- * R8 = (Z21) + 8000 0000
- LA 8,0(8) R8 = (Z21)
- L&W 0,0(4) F0 = A
- L&W 2,0(5) F2 = B
- S&W.R 2,0 F2 = B-A
- ST&W 0,A STORE A
- ST&W 2,C C = B-A
- L M,0(2) R5 = M
- L N,0(3) R3 = N
- LTR 0,M TEST R0 = M
- BNH RETURN IF(M .LE. 0) RETURN
- LTR 0,N TEST R0 = N
- BNH RETURN IF(N .LE. 0) RETURN
- SR 7,6 R7 = (Z12) - (Z) = JZ
- SR 8,6 R8 = (Z21) - (Z) = IZ
- ENTER GET,LIST CALL RANGET(SEED)
- LM 0,1,SEED R0 = 002BC68C
- * R1 = 00FE166D
- A 0,=X'40000000' R0 = 402BC68C
- SLL 1,8 R1 = FE166D00
- STM 0,1,DATA DATA = 402BC68C FE166D00
- TMRAN1 A,C,M,N,Z,IZ,JZ,I,J,DATA
- LM 0,1,DATA R0 = 402BC68C
- * R1 = FE166D00
- N 0,=X'00FFFFFF' R0 = 002BC68C
- SRL 1,8 R1 = 00FE166D
- STM 0,1,SEED SEED = 002BC68C 00FE166D
- ENTER SET,LIST CALL RANSET(SEED)
- RETURN EPILOG
- MEND
-#include "tglobal.inc"
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003ib/mscl.inc b/src/packlib/kernlib/kernnum/obsolete/f003ib/mscl.inc
deleted file mode 100644
index d7af93d..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003ib/mscl.inc
+++ /dev/null
@@ -1,60 +0,0 @@
-*
-* $Id: mscl.inc,v 1.1.1.1 1996/02/15 17:48:22 mclareni Exp $
-*
-* $Log: mscl.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:22 mclareni
-* Kernlib
-*
-*
-*
-* mscl.inc
-*
-#include "basic.inc"
-#include "scl.inc"
- MACRO
- MAIN
-#include "global.inc"
- &TWORDS SETA 5
- SETYPE
- HEADER ENTRY (M,N,S,X,X12,X21,Z,Z12,Z21)
- M EQU 2
- N EQU 3
- X EQU 5
- JX EQU 6
- IX EQU 7
- Z EQU 8
- JZ EQU 9
- IZ EQU 10
- ®LIM SETA 10
- ENTRY PROLOG
- LM 2,10,0(1)
- * R2 = (M)
- * R3 = (N)
- * R4 = (S)
- * R5 = (X)
- * R6 = (X12)
- * R7 = (X21)
- * R8 = (Z)
- * R9 = (Z12)
- * R10= (Z21) + 8000 0000
- LA 10,0(10) R10= (Z21)
- L M,0(2) R2 = M
- L N,0(3) R3 = N
- LOAD 4,4 F4 = S
- LTR 0,M TEST R0 = M
- BNH RETURN IF(M .LE. 0) RETURN
- LTR 0,N TEST R0 = N
- BNH RETURN IF(N .LE. 0) RETURN
- SR 6,5 R6 = (X12) - (X) = JX
- SR 7,5 R7 = (X21) - (X) = IX
- SR 9,8 R9 = (Z12) - (Z) = JZ
- SR 10,8 R10= (Z21) - (Z) = IZ
- CR M,N
- BNH ALABEL IF(M .LE. N)
- SWAP M,N
- SWAP IX,JX
- SWAP IZ,JZ
- ALABEL TMSCL M,N,X,IX,JX,Z,IZ,JZ
- RETURN EPILOG
- MEND
-#include "tglobal.inc"
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003ib/mset.inc b/src/packlib/kernlib/kernnum/obsolete/f003ib/mset.inc
deleted file mode 100644
index bd53b36..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003ib/mset.inc
+++ /dev/null
@@ -1,52 +0,0 @@
-*
-* $Id: mset.inc,v 1.1.1.1 1996/02/15 17:48:22 mclareni Exp $
-*
-* $Log: mset.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:22 mclareni
-* Kernlib
-*
-*
-*
-* mset.inc
-*
-#include "basic.inc"
-#include "set.inc"
- MACRO
- MAIN
-#include "global.inc"
- &TWORDS SETA 2
- SETYPE
- HEADER ENTRY (M,N,S,Z,Z12,Z21)
- J EQU 1
- NSTEP EQU 2
- N EQU 3
- JZ2 EQU 4
- Z EQU 5
- JZ EQU 6
- IZ EQU 7
- MSTEP EQU 8
- M EQU 9
- I EQU 10
- ®LIM SETA 10
- ENTRY PROLOG
- LM 2,7,0(1)
- * R2 = (M)
- * R3 = (N)
- * R4 = (S)
- * R5 = (Z)
- * R6 = (Z12)
- * R7 = (Z21) + 8000 0000
- LA 7,0(7) R7 = (Z21)
- L M,0(2) R9 = M
- L N,0(3) R3 = N
- LOAD 0,4 F0 = S
- LTR 0,M TEST R0 = M
- BNH RETURN IF(M .LE. 0) RETURN
- LTR 0,N TEST R0 = N
- BNH RETURN IF(N .LE. 0) RETURN
- SR 6,5 R6 = (Z12) - (Z) = JZ
- SR 7,5 R7 = (Z21) - (Z) = IZ
- TMSET2 M,N,Z,IZ,JZ,JZ2,I,J
- RETURN EPILOG
- MEND
-#include "tglobal.inc"
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003ib/mutl.inc b/src/packlib/kernlib/kernnum/obsolete/f003ib/mutl.inc
deleted file mode 100644
index decd2c1..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003ib/mutl.inc
+++ /dev/null
@@ -1,42 +0,0 @@
-*
-* $Id: mutl.inc,v 1.1.1.1 1996/02/15 17:48:22 mclareni Exp $
-*
-* $Log: mutl.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:22 mclareni
-* Kernlib
-*
-*
-*
-* mutl.inc
-*
-#include "basic.inc"
-#include "cpy.inc"
-#include "utl.inc"
- MACRO
- MAIN
-#include "global.inc"
- &TWORDS SETA 3
- SETYPE
- HEADER ENTRY (N,X,X12,X21)
- Z EQU 2
- N EQU 3
- X EQU 4
- JX EQU 5
- IX EQU 6
- ®LIM SETA 6
- ENTRY PROLOG
- LM 3,6,0(1)
- * R3 = (N)
- * R4 = (X)
- * R5 = (X12)
- * R6 = (X21) + 8000 0000
- LA 6,0(6) R6 = (X21)
- L N,0(3)
- LTR 0,N TEST R0 = N
- BNH RETURN IF(N .LE. 0) RETURN
- SR 5,4 R5 = (X12) - (X) = JX
- SR 6,4 R6 = (X21) - (X) = IX
- TMUTL N,X,IX,JX,Z
- RETURN EPILOG
- MEND
-#include "tglobal.inc"
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003ib/rmadd.s b/src/packlib/kernlib/kernnum/obsolete/f003ib/rmadd.s
deleted file mode 100644
index 6c22a48..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003ib/rmadd.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: rmadd.s,v 1.1.1.1 1996/02/15 17:48:22 mclareni Exp $
-*
-* $Log: rmadd.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:22 mclareni
-* Kernlib
-*
-*
-#include "kernnum/madd.inc"
- &TYPE SETA &RTYPE
- &NAME SETC 'MADD '
- MAIN A
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003ib/rmbil.s b/src/packlib/kernlib/kernnum/obsolete/f003ib/rmbil.s
deleted file mode 100644
index 99078d1..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003ib/rmbil.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: rmbil.s,v 1.1.1.1 1996/02/15 17:48:22 mclareni Exp $
-*
-* $Log: rmbil.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:22 mclareni
-* Kernlib
-*
-*
-#include "kernnum/mbil.inc"
- &TYPE SETA &RTYPE
- &NAME SETC 'MBIL '
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003ib/rmcpy.s b/src/packlib/kernlib/kernnum/obsolete/f003ib/rmcpy.s
deleted file mode 100644
index 2918ebb..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003ib/rmcpy.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: rmcpy.s,v 1.1.1.1 1996/02/15 17:48:23 mclareni Exp $
-*
-* $Log: rmcpy.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:23 mclareni
-* Kernlib
-*
-*
-#include "kernnum/mcpy.inc"
- &TYPE SETA &RTYPE
- &NAME SETC 'MCPY '
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003ib/rmmna.s b/src/packlib/kernlib/kernnum/obsolete/f003ib/rmmna.s
deleted file mode 100644
index 1d1fd7a..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003ib/rmmna.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: rmmna.s,v 1.1.1.1 1996/02/15 17:48:23 mclareni Exp $
-*
-* $Log: rmmna.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:23 mclareni
-* Kernlib
-*
-*
-#include "kernnum/mmpy.inc"
- &TYPE SETA &RTYPE
- &NAME SETC 'MMNA '
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003ib/rmmns.s b/src/packlib/kernlib/kernnum/obsolete/f003ib/rmmns.s
deleted file mode 100644
index aed1961..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003ib/rmmns.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: rmmns.s,v 1.1.1.1 1996/02/15 17:48:24 mclareni Exp $
-*
-* $Log: rmmns.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:24 mclareni
-* Kernlib
-*
-*
-#include "kernnum/mmpy.inc"
- &TYPE SETA &RTYPE
- &NAME SETC 'MMNS '
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003ib/rmmpa.s b/src/packlib/kernlib/kernnum/obsolete/f003ib/rmmpa.s
deleted file mode 100644
index 19aac57..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003ib/rmmpa.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: rmmpa.s,v 1.1.1.1 1996/02/15 17:48:24 mclareni Exp $
-*
-* $Log: rmmpa.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:24 mclareni
-* Kernlib
-*
-*
-#include "kernnum/mmpy.inc"
- &TYPE SETA &RTYPE
- &NAME SETC 'MMPA '
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003ib/rmmps.s b/src/packlib/kernlib/kernnum/obsolete/f003ib/rmmps.s
deleted file mode 100644
index 3c1e46c..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003ib/rmmps.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: rmmps.s,v 1.1.1.1 1996/02/15 17:48:25 mclareni Exp $
-*
-* $Log: rmmps.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:25 mclareni
-* Kernlib
-*
-*
-#include "kernnum/mmpy.inc"
- &TYPE SETA &RTYPE
- &NAME SETC 'MMPS '
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003ib/rmmpy.s b/src/packlib/kernlib/kernnum/obsolete/f003ib/rmmpy.s
deleted file mode 100644
index 12ad90d..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003ib/rmmpy.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: rmmpy.s,v 1.1.1.1 1996/02/15 17:48:25 mclareni Exp $
-*
-* $Log: rmmpy.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:25 mclareni
-* Kernlib
-*
-*
-#include "kernnum/mmpy.inc"
- &TYPE SETA &RTYPE
- &NAME SETC 'MMPY '
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003ib/rmran.s b/src/packlib/kernlib/kernnum/obsolete/f003ib/rmran.s
deleted file mode 100644
index e35e0ab..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003ib/rmran.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: rmran.s,v 1.1.1.1 1996/02/15 17:48:25 mclareni Exp $
-*
-* $Log: rmran.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:25 mclareni
-* Kernlib
-*
-*
-#include "kernnum/mran.inc"
- &TYPE SETA &RTYPE
- &NAME SETC 'MRAN '
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003ib/rmscl.s b/src/packlib/kernlib/kernnum/obsolete/f003ib/rmscl.s
deleted file mode 100644
index 04c2faa..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003ib/rmscl.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: rmscl.s,v 1.1.1.1 1996/02/15 17:48:26 mclareni Exp $
-*
-* $Log: rmscl.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:26 mclareni
-* Kernlib
-*
-*
-#include "kernnum/mscl.inc"
- &TYPE SETA &RTYPE
- &NAME SETC 'MSCL '
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003ib/rmset.s b/src/packlib/kernlib/kernnum/obsolete/f003ib/rmset.s
deleted file mode 100644
index f8bee3f..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003ib/rmset.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: rmset.s,v 1.1.1.1 1996/02/15 17:48:26 mclareni Exp $
-*
-* $Log: rmset.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:26 mclareni
-* Kernlib
-*
-*
-#include "kernnum/mset.inc"
- &TYPE SETA &RTYPE
- &NAME SETC 'MSET '
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003ib/rmsub.s b/src/packlib/kernlib/kernnum/obsolete/f003ib/rmsub.s
deleted file mode 100644
index 43f7a5c..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003ib/rmsub.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: rmsub.s,v 1.1.1.1 1996/02/15 17:48:26 mclareni Exp $
-*
-* $Log: rmsub.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:26 mclareni
-* Kernlib
-*
-*
-#include "kernnum/madd.inc"
- &TYPE SETA &RTYPE
- &NAME SETC 'MSUB '
- MAIN S
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003ib/rmutl.s b/src/packlib/kernlib/kernnum/obsolete/f003ib/rmutl.s
deleted file mode 100644
index 7f79123..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003ib/rmutl.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: rmutl.s,v 1.1.1.1 1996/02/15 17:48:26 mclareni Exp $
-*
-* $Log: rmutl.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:26 mclareni
-* Kernlib
-*
-*
-#include "kernnum/mutl.inc"
- &TYPE SETA &RTYPE
- &NAME SETC 'MUTL '
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003ib/rrscl.s b/src/packlib/kernlib/kernnum/obsolete/f003ib/rrscl.s
deleted file mode 100644
index 5429afb..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003ib/rrscl.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: rrscl.s,v 1.1.1.1 1996/02/15 17:48:27 mclareni Exp $
-*
-* $Log: rrscl.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:27 mclareni
-* Kernlib
-*
-*
-#include "kernnum/rscl.inc"
- &TYPE SETA &RTYPE
- &NAME SETC 'RSCL '
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003ib/rscl.inc b/src/packlib/kernlib/kernnum/obsolete/f003ib/rscl.inc
deleted file mode 100644
index a13a79e..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003ib/rscl.inc
+++ /dev/null
@@ -1,60 +0,0 @@
-*
-* $Id: rscl.inc,v 1.1.1.1 1996/02/15 17:48:22 mclareni Exp $
-*
-* $Log: rscl.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:22 mclareni
-* Kernlib
-*
-*
-*
-* rscl.inc
-*
-#include "basic.inc"
-#include "scl.inc"
- MACRO
- MAIN
-#include "global.inc"
- &TWORDS SETA 5
- SETYPE
- HEADER ENTRY (M,N,D,D2,X,X12,X21,Z,Z12,Z21)
- NSTEP EQU 2 N-1 IS USED IN LOOPING
- N EQU 3 N MUST BE AN ODD REGISTER
- D EQU 4
- ID EQU 5
- X EQU 6
- JX EQU 7
- IX EQU 8
- Z EQU 9
- JZ EQU 10
- IZ EQU 11
- M EQU 12 TO CONTROL THE INNER LOOP
- ®LIM SETA 12
- ENTRY PROLOG
- LM 2,11,0(1)
- * R2 = (M)
- * R3 = (N)
- * R4 = (D)
- * R5 = (D2)
- * R6 = (X)
- * R7 = (X12)
- * R8 = (X21)
- * R9 = (Z)
- * R10= (Z12)
- * R11= (Z21) + 8000 0000
- LA 11,0(11) R11= (Z21)
- L M,0(2) R12= M
- L N,0(3) R3 = N
- LA NSTEP,2 R2 = 2 = NSTEP
- LTR 0,M TEST R0 = M
- BNH RETURN IF(M .LE. 0) RETURN
- LTR 0,N TEST R0 = N
- BNH RETURN IF(N .LE. 0) RETURN
- SR 5,4 R5 = (D2) - (D) = ID
- SR 7,6 R7 = (X12) - (X) = JX
- SR 8,6 R8 = (X21) - (X) = IX
- SR 10,9 R10= (Z12) - (Z) = JZ
- SR 11,9 R11= (Z21) - (Z) = IZ
- RSCL M,N,D,ID,X,IX,JX,Z,IZ,JZ
- RETURN EPILOG
- MEND
-#include "tglobal.inc"
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003ib/rumna.s b/src/packlib/kernlib/kernnum/obsolete/f003ib/rumna.s
deleted file mode 100644
index 4f20280..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003ib/rumna.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: rumna.s,v 1.1.1.1 1996/02/15 17:48:27 mclareni Exp $
-*
-* $Log: rumna.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:27 mclareni
-* Kernlib
-*
-*
-#include "kernnum/umpy.inc"
- &TYPE SETA &RTYPE
- &NAME SETC 'UMNA '
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003ib/rumns.s b/src/packlib/kernlib/kernnum/obsolete/f003ib/rumns.s
deleted file mode 100644
index 9a6ec77..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003ib/rumns.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: rumns.s,v 1.1.1.1 1996/02/15 17:48:27 mclareni Exp $
-*
-* $Log: rumns.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:27 mclareni
-* Kernlib
-*
-*
-#include "kernnum/umpy.inc"
- &TYPE SETA &RTYPE
- &NAME SETC 'UMNS '
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003ib/rumpa.s b/src/packlib/kernlib/kernnum/obsolete/f003ib/rumpa.s
deleted file mode 100644
index 8848ee5..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003ib/rumpa.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: rumpa.s,v 1.1.1.1 1996/02/15 17:48:27 mclareni Exp $
-*
-* $Log: rumpa.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:27 mclareni
-* Kernlib
-*
-*
-#include "kernnum/umpy.inc"
- &TYPE SETA &RTYPE
- &NAME SETC 'UMPA '
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003ib/rumps.s b/src/packlib/kernlib/kernnum/obsolete/f003ib/rumps.s
deleted file mode 100644
index 91d43cd..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003ib/rumps.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: rumps.s,v 1.1.1.1 1996/02/15 17:48:27 mclareni Exp $
-*
-* $Log: rumps.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:27 mclareni
-* Kernlib
-*
-*
-#include "kernnum/umpy.inc"
- &TYPE SETA &RTYPE
- &NAME SETC 'UMPS '
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003ib/rumpy.s b/src/packlib/kernlib/kernnum/obsolete/f003ib/rumpy.s
deleted file mode 100644
index 3491d46..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003ib/rumpy.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: rumpy.s,v 1.1.1.1 1996/02/15 17:48:28 mclareni Exp $
-*
-* $Log: rumpy.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:28 mclareni
-* Kernlib
-*
-*
-#include "kernnum/umpy.inc"
- &TYPE SETA &RTYPE
- &NAME SETC 'UMPY '
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f003ib/umpy.inc b/src/packlib/kernlib/kernnum/obsolete/f003ib/umpy.inc
deleted file mode 100644
index 1fd158a..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f003ib/umpy.inc
+++ /dev/null
@@ -1,56 +0,0 @@
-*
-* $Id: umpy.inc,v 1.1.1.1 1996/02/15 17:48:22 mclareni Exp $
-*
-* $Log: umpy.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:22 mclareni
-* Kernlib
-*
-*
-*
-* umpy.inc
-*
-#include "basic.inc"
-#include "mpy.inc"
- MACRO
- MAIN
-#include "global.inc"
- LCLC &OPC
- &OPC SETC '&NAME'(1,4)
- AIF (&TYPE NE &CCTYPE).ALPHA
- &OPC SETC '&NAME'(2,4)
- .ALPHA ANOP
- &TWORDS SETA 6
- SETYPE
- HEADER ENTRY (N,X,X12,X22,Y,Y2,Z,Z2)
- N EQU 2
- X EQU 3
- JX EQU 4
- IX EQU 5
- Y EQU 6
- JY EQU 7
- Z EQU 8
- IZ EQU 9
- ®LIM SETA 9
- ENTRY PROLOG
- LM 2,9,0(1)
- * R2 = (N)
- * R3 = (X)
- * R4 = (X12)
- * R5 = (X22)
- * R6 = (Y)
- * R7 = (Y2)
- * R8 = (Z)
- * R9 = (Z2) + 8000 0000
- LA 9,0(9) R9 = (Z2)
- L N,0(2)
- LTR 0,N TEST R0 = N
- BNH RETURN IF(N .LE. 0) RETURN
- SR 4,3 R4 = (X12) - (X) = JX
- SR 7,6 R7 = (Y2) - (Y) = JY
- SR 5,3 R5 = (X22)- (X) = IX + JX
- SR 9,8 R9 = (Z2) - (Z) = IZ
- SR 5,4 R5 = IX
- TXMPY &OPC,N,N,X,IX,JX,Y,JY,Z,IZ
- RETURN EPILOG
- MEND
-#include "tglobal.inc"
diff --git a/src/packlib/kernlib/kernnum/obsolete/f004cd/cmmla.s b/src/packlib/kernlib/kernnum/obsolete/f004cd/cmmla.s
deleted file mode 100644
index 1958b81..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f004cd/cmmla.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: cmmla.s,v 1.1.1.1 1996/02/15 17:48:11 mclareni Exp $
-*
-* $Log: cmmla.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:11 mclareni
-* Kernlib
-*
-*
- IDENT CMMLA
-#include "mxxx.inc"
- MAIN CTYPE,MMLA
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f004cd/cmmls.s b/src/packlib/kernlib/kernnum/obsolete/f004cd/cmmls.s
deleted file mode 100644
index ed7be0e..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f004cd/cmmls.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: cmmls.s,v 1.1.1.1 1996/02/15 17:48:11 mclareni Exp $
-*
-* $Log: cmmls.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:11 mclareni
-* Kernlib
-*
-*
- IDENT CMMLS
-#include "mxxx.inc"
- MAIN CTYPE,MMLS
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f004cd/cmmlt.s b/src/packlib/kernlib/kernnum/obsolete/f004cd/cmmlt.s
deleted file mode 100644
index 9bcd3fc..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f004cd/cmmlt.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: cmmlt.s,v 1.1.1.1 1996/02/15 17:48:10 mclareni Exp $
-*
-* $Log: cmmlt.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:10 mclareni
-* Kernlib
-*
-*
- IDENT CMMLT
-#include "mmlt.inc"
- MAIN CTYPE
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f004cd/cmnma.s b/src/packlib/kernlib/kernnum/obsolete/f004cd/cmnma.s
deleted file mode 100644
index 270324f..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f004cd/cmnma.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: cmnma.s,v 1.1.1.1 1996/02/15 17:48:11 mclareni Exp $
-*
-* $Log: cmnma.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:11 mclareni
-* Kernlib
-*
-*
- IDENT CMNMA
-#include "mxxx.inc"
- MAIN CTYPE,MNMA
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f004cd/cmnms.s b/src/packlib/kernlib/kernnum/obsolete/f004cd/cmnms.s
deleted file mode 100644
index f9c0a2c..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f004cd/cmnms.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: cmnms.s,v 1.1.1.1 1996/02/15 17:48:12 mclareni Exp $
-*
-* $Log: cmnms.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:12 mclareni
-* Kernlib
-*
-*
- IDENT CMNMS
-#include "mxxx.inc"
- MAIN CTYPE,MNMS
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f004cd/dmmla.s b/src/packlib/kernlib/kernnum/obsolete/f004cd/dmmla.s
deleted file mode 100644
index 97ed8a5..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f004cd/dmmla.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: dmmla.s,v 1.1.1.1 1996/02/15 17:48:11 mclareni Exp $
-*
-* $Log: dmmla.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:11 mclareni
-* Kernlib
-*
-*
- IDENT DMMLA
-#include "mxxx.inc"
- MAIN DTYPE,MMLA
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f004cd/dmmls.s b/src/packlib/kernlib/kernnum/obsolete/f004cd/dmmls.s
deleted file mode 100644
index 7207268..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f004cd/dmmls.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: dmmls.s,v 1.1.1.1 1996/02/15 17:48:11 mclareni Exp $
-*
-* $Log: dmmls.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:11 mclareni
-* Kernlib
-*
-*
- IDENT DMMLS
-#include "mxxx.inc"
- MAIN DTYPE,MMLS
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f004cd/dmmlt.s b/src/packlib/kernlib/kernnum/obsolete/f004cd/dmmlt.s
deleted file mode 100644
index f39f422..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f004cd/dmmlt.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: dmmlt.s,v 1.1.1.1 1996/02/15 17:48:10 mclareni Exp $
-*
-* $Log: dmmlt.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:10 mclareni
-* Kernlib
-*
-*
- IDENT DMMLT
-#include "mmlt.inc"
- MAIN DTYPE
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f004cd/dmnma.s b/src/packlib/kernlib/kernnum/obsolete/f004cd/dmnma.s
deleted file mode 100644
index 194c067..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f004cd/dmnma.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: dmnma.s,v 1.1.1.1 1996/02/15 17:48:11 mclareni Exp $
-*
-* $Log: dmnma.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:11 mclareni
-* Kernlib
-*
-*
- IDENT DMNMA
-#include "mxxx.inc"
- MAIN DTYPE,MNMA
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f004cd/dmnms.s b/src/packlib/kernlib/kernnum/obsolete/f004cd/dmnms.s
deleted file mode 100644
index f16f750..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f004cd/dmnms.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: dmnms.s,v 1.1.1.1 1996/02/15 17:48:12 mclareni Exp $
-*
-* $Log: dmnms.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:12 mclareni
-* Kernlib
-*
-*
- IDENT DMNMS
-#include "mxxx.inc"
- MAIN DTYPE,MNMS
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f004cd/mmlt.inc b/src/packlib/kernlib/kernnum/obsolete/f004cd/mmlt.inc
deleted file mode 100644
index 9fd3bf1..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f004cd/mmlt.inc
+++ /dev/null
@@ -1,316 +0,0 @@
-*
-* $Id: mmlt.inc,v 1.1.1.1 1996/02/15 17:48:10 mclareni Exp $
-*
-* $Log: mmlt.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:10 mclareni
-* Kernlib
-*
-*
-*
-* mmlt.inc
-*
-*CALL BASIC
-*CALL MPY
-*CALL SCL
-*CALL SQR
-*CALL CPY
-*CALL UTL
- MAIN MACRO TYPE
- SETYPE TYPE
- NAME MICRO 1,,*"P"_MMLT*
- HEADER "NAME",SAVEA0
- TEMP BSS 2 USED BY TMMPY1
- L BSS 1
- M BSS 1
- LY BSS 1
- LZ BSS 0
- IZ BSS 1
- X11 BSS 1
- XI1 BSS 1
- Y1L BSS 0
- XII BSS 0
- ZII BSS 1
- Z11 BSS 1
- Z1L BSS 0
- T1 BSS 1
- EXIT "NAME"
- SA2 A1+1 X2=(N) A2=((N))
- SB7 1 B7=1
- SA1 X1 X1=M A1=(M)
- SA3 A2+B7 X3=(K) A3=((K))
- SA4 A2+2 X4=(X) A4=((X))
- SA5 A2+5 X5=(Y) A5=((Y))
- SA2 X2 X2=N A2=(N)
- SB1 X1 B1=M
- SA1 A5+3 X1=(Z) A1=((Z))
- SA3 X3 X3=K A3=(K)
- BX0 X4 X0=(X)
- SA4 A4+B7 X4=(X12) A4=((X12))
- BX7 X5 X7=(Y)
- SA5 A5+B7 X5=(Y12) A5=((Y12))
- SB2 X2 B2=N
- SA2 A4+B7 X2=(X21) A2=((X21))
- SB3 X3 B3=K
- SA3 A5+B7 X3=(Y21) A3=((Y21))
- SX6 A0 X6=OLD A0
- LE B1,B0,EXIT IF M .LE. 0 GO TO EXIT
- LE B2,B0,EXIT IF N .LE. 0 GO TO EXIT
- LE B3,B0,EXIT IF K .LE. 0 GO TO EXIT
- SA6 SAVEA0 SAVEA0=OLD A0
- IX4 X4-X0 X4=(X12)-(X)=JX
- IX3 X3-X7 X3=(Y21)-(Y)=JY
- SB4 X4 B4=JX
- SB5 X3 B5=JY
- SA4 A1+B7 X4=(Z12) A4=((Z12))
- SA3 A4+B7 X3=(Z21) A3=((Z21))
-* X0=(X)
-* X1=(Z) B1=M
-* X2=(X21) B2=N
-* X3=(Z21) A3=((Z21)) B3=K
-* X4=(Z12) B4=JX
-* X5=(Y12) B5=JY
-* X7=(Y) B7=1
-* IF (Z) = (X) GOTO [5]
-* IF (Z) = (Y) GOTO [6]
- IX6 X1-X0 X6=(Z)-(X)
- ZR X6,[5] IF (Z)=(X) GO TO [5]
- IX6 X1-X7 X6=(Z)-(Y)
- ZR X6,[6] IF (Z)=(Y) GO TO [6]
-* IF (Y21) = (X12) GOTO [2]
- EQ B4,B5,[2] IF (X12) = (Y21) GO TO [2]
- [1] BSS 0
- SX6 B3 X6=K
- SA0 X1 A0=(Z(1,1))
- SA6 L L=K
- IX6 X2-X0 X6=(X21)-(X)=IX
- BX2 X7 X2=(Y(1,1))
- SB3 X6 B3=IX
- IX6 X5-X2 X6=(Y12)-(Y)
- IX7 X4-X1 X7=(Z12)-(Z)
- SA6 LY LY=(Y(1,2))-(Y(1,1))
- SA7 LZ LZ=(Z(1,2))-(Z(1,1))
- BX6 X5 X6=(Y12)
- BX7 X4 X7=(Z12)
- SA6 Y1L Y1L=(Y(1,2))
- SA7 Z1L Z1L=(Z(1,2))
- BX6 X0 X6=(X)
- SX7 B1 X7=M
- SA6 X11 X11=(X(1,1))
- SA7 M M=M
- IX6 X3-X1 X6=(Z21)-(Z)
- BX1 X0 X1=(X(1,1))
- SB6 X6 B6=IZ
-* DO L = 1, M
-* CALL TMMPY(M,N,X,X12,X21,Y1L,Y2L,Z1L,Z2L)
- SB7 MPY
- RJ MPYX
- SA5 L X5=L A5=L
- SA4 M X4=M
- SA3 Z1L X3=(Z(1,L)) A3=Z1L
- SA2 Y1L X2=(Y(1,L)) A2=Y1L
- SA1 X11 X1=(X(1,1)) A1=X11
- SX6 X5-1 X6=L-1
- SB1 X4 B1=M
- SA6 A5 L=L-1
- SA5 LZ X5=LZ
- SA4 LY X4=LY
- ZR X6,EPILOG IF L=0 RETURN
- SA0 X3 A0=(Z(1,L))
- IX7 X3+X5 X7=(Z(1,L+1))
- IX6 X2+X4 X6=(Y(1,L+1))
- SA7 A3 Z1L=(Z(1,L+1))
- SA6 A2 Y1L=(Y(1,L+1))
-*** JP MPY
- MPY "P"MMPY "PLUS",B1,B2,B3,B4,B5,"NULL",A0,B6,TEMP,B7
-* X1=(X), X2=(Y)
- MPYX BSS 1 EXIT LINE (SET ONCE ONLY)
- JP B7
- [2] BSS 0
-* IF (Y) .NE. (X) GOTO [1]
-* IF (Y12) .NE. (X21) GOTO [1]
-* IF K .NE. M GOTO [1]
- IX6 X7-X0 X6=(Y)-(X)
- NZ X6,[1] IF (Y) .NE. (X) GO TO [1]
- IX6 X5-X2 X6=(Y12)-(X21)
- NZ X6,[1] IF (Y12) .NE. (X21) GO TO [1]
- NE B3,B1,[1] IF K .NE. M GO TO [1]
- BX6 X1 X6=(Z)
- SA0 X1 A0=(Z(1,1))
- SA6 Z11 Z11=(Z(1,1))
- IX6 X2-X0 X6=(X21)-(X)
- IX7 X4-X1 X7=(Z12)-(Z)
- SB3 X6 B3=IX
- SB6 X7 B6=LZ
- IX6 X3-X1 X6=(Z21)-(Z)
- SX7 B1 X7=M
- SA6 IZ IZ=(Z(2,1))-(Z(1,1))
- SA7 L L=M
- SA7 M M=M
- BX1 X0 X1=(X(1,1))
- SB7 X6+B6 B7=IZ+LZ
- BX6 X0 X6=(X)
- SX7 A0+B7 X7=(Z(2,2))
- SA6 X11 X11=(X(1,1))
- SA6 XI1 XI1=(X(1,1))
- SA7 ZII ZII=(Z(2,2))
-* DO I = 1, M
-* CALL TVSQR(N,X(I,1),X(I,2),Z(I,I))
- SB7 [3]
- RJ MPYX
- SA4 ZII X4=(Z(I,I))
- SA1 XI1 X1=(X(I,1))
- SA0 X4 A0=(Z(I,I))
-* JP SQR
- SQR "P"VSQR B2,X1,B4,B7
- SA6 A0
- TAU IFEQ LENGTH,2
- SA7 A0+1
- TAU ENDIF
- SQRX BSS 1 EXIT LINE (SET ONCE ONLY)
- JP B7
-* IF (I = M) RETURN
-* CALL TMMPY(L-1,N,X(I+1,1),X(I+1,2),X(I+2,1),X(I,1),X(I,2),
-* Z(I,I+1),Z(I,I+2))
- [3] SB7 SQR
- RJ SQRX
- SA5 L X5=L A5=L
- SA4 IZ X4=IZ
- SA2 XI1 X2=(X(I,1)) A2=XI1
- SA0 A0+B6 A0=(Z(I,I+1))
- SX6 X5-1 X6=L-1
- SB7 X4 B7=IZ
- ZR X6,[4] IF L = 1
- SB1 X6 B1=L-1
- SX1 X2+B3 X1=(X(I+1,1))
- SA6 A5 L=L-1
- SX7 A0+B7 X7=(Z(I+1,I+1))
- BX6 X1 X6=(X(I+1,1))
- SA7 ZII ZII=(Z(I+1,I+1))
- SA6 A2 XI1=(X(I+1,1))
- JP MPY
-* CALL TMUTL(M,Z,Z(1,2),Z(2,1))
- [4] SA5 M X5=M
- SA1 Z11 X1=(Z(1,1))
- SB3 X4 B3=IZ
- SB4 B6 B4=LZ
- SB1 X5-1 B1=M-1
- NZ B1,UTL IF M>1 CALL TMUTL
- JP EPILOG
- [5] BSS 0
-* IF (Z) = (Y) GOTO [8]
- IX6 X1-X7 X6=(Z)-(Y)
- ZR X6,[8]
- SWAP X0,X7 SWAP (X) AND (Y)
- SWAP B4,B5 SWAP JX AND JY
- SWAP X2,X5 SWAP (X21) AND (Y12)
- SWAP B1,B3 SWAP M AND K
- [6] BSS 0
- SX6 B3 X6=K
- SA3 A3+B7 X3=(T)
- SA6 L L=K
- SA7 Y1L Y1L=(Y(1,1))
- IX6 X2-X0 X6=(X21)-(X)
- BX2 X7 X2=(Y(1,1))
- SB3 X6 B3=IX
- SX6 B1 X6=M
- IX7 X5-X7 X7=(Y12)-(Y)
- SA0 X3 A0=(T1)
- SA6 M M=M
- SA7 LY LY=(Y(1,2))-(Y(1,1))
- BX6 X0 X6=(X)
- BX7 X3 X7=(T)
- SA6 X11 X11=(X(1,1))
- SA7 T1 T1=(T(1))
- SB6 LENGTH B6=JT
- BX1 X0 X1=(X(1,1))
-* DO L = 1, K
-* CALL TMMPY(M,N,X,X(1,2),X(2,1),Y(1,L),Y(2,L),T(1),T(2))
- SB7 [7]
- RJ CPYX
- SA5 L X5=L A5=L
- SA2 Y1L X2=(Y(1,L)) A2=Y1L
- SA1 X11 X1=(X(1,1))
- SX6 X5-1 X6=L-1
- ZR X6,EPILOG IF L=0
- SA6 A5 L=L-1
- JP MPY
-* CALL TVCPY(M,T(1),T(2),Y(1,L),Y(2,L))
- [7] SB7 MPY
- RJ MPYX
- SA5 LY X5=LY
- SA1 Y1L X1=(Y(1,L)) A1=Y1L
- SA4 M X4=M
- SA3 T1 X3=(T(1))
- IX6 X1+X5 X6=(Y(1,L+1))
- SB1 X4 B1=M
- SA6 A1 Y1L=(Y(1,L+1))
- SA0 X3 A0=(T(1))
-*** JP CPY
- CPY BSS 0
- TAU IFNE TYPE,CTYPE
- "P"VCPY B1,A0,B6,X1,B5,B7
- TAU ELSE
- DVCPY B1,A0,B6,X1,B5,B7
- TAU ENDIF
- CPYX BSS 1 EXIT LINE (SET ONCE ONLY)
- JP B7
- [8] BSS 0
- [9] BSS 0
- SA3 A3+B7 X3=(T1)
- IX6 X2-X0 X6=(X21)-(X)
- SB6 LENGTH B6=JT
- SB3 X6 B3=IX
- BX6 X0 X6=(X)
- SX7 B1 X7=M
- SB1 B1+1 B1=L+1
- SA6 Z11 Z11=(X(1,1))
- SA6 XI1 XI1=(X(1,1))
- SA6 XII XII=(X(1,1))
- SA7 L L=M
- SA7 M M=M
- BX6 X3 X6=(T1)
- SA0 X3 A0=(T(1))
- SA6 T1 T1=(T(1))
-* DO I = 1, M
-* CALL TVSQR(N,X(I,1),X(I,2),T(1))
- SB7 [10]
- RJ CPYX
- SA5 L X5=L
- SA1 XI1 X1=(X(I,1))
- NZ X5,SQR IF L .NE. 0 CALL TVSQR
- JP [13]
-* IF I .LT. M
-* CALL TMMPY(L-1,N,X(I+1,1),X(I+1,2),X(I+2,1),X(I,1),X(I,2),
-* T(2),T(3))
- [10] SB7 [11]
- RJ SQRX
- SA2 XI1 X2=(X(I,1)) A2=XI1
- SB1 B1-2 B1=L-1
- SA0 A0+B6 A0=(T(2))
- ZR B1,[12] IF L=1
- SX6 X2+B3 X6=(X(I+1,1))
- SX1 X2+B3 X1=(X(I+1,1))
- SA6 A2 XI1=(X(I+1,1))
- JP MPY
-* CALL TVCPY(L,T(1),T(2),X(I,I),X(I,I+1))
- [11] SB7 SQR
- RJ MPYX
- [12] SA5 L X5=L A5=L
- SA1 XII X1=(X(I,I)) A1=XII
- SA3 T1 X3=(T(1))
- SB7 B3+B4 B7=IX+JX
- SX6 X5-1 X6=L-1
- SB1 X5 B1=L
- SA6 A5 L=L-1
- SX7 X1+B7 X7=(X(I+1,I+1))
- SA0 X3 A0=(T(1))
- SA7 A1 XII=(X(I+1,I+1))
- JP CPY
-* CALL TMUTL(M,X,X(1,2),X(2,1))
- [13] SA5 M X5=M
- SA1 Z11 X1=(X(1,1))
- SB1 X5-1 B1=M-1
- ZR B1,EPILOG IF M>1 CALL TMUTL
- UTL TMUTL TYPE,B1,B3,B4,B7 X1=(Z(1,1))
- EPILOG
- ENDM
diff --git a/src/packlib/kernlib/kernnum/obsolete/f004cd/mxxx.inc b/src/packlib/kernlib/kernnum/obsolete/f004cd/mxxx.inc
deleted file mode 100644
index 1a43382..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f004cd/mxxx.inc
+++ /dev/null
@@ -1,143 +0,0 @@
-*
-* $Id: mxxx.inc,v 1.1.1.1 1996/02/15 17:48:10 mclareni Exp $
-*
-* $Log: mxxx.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:10 mclareni
-* Kernlib
-*
-*
-*
-* mxxx.inc
-*
-*CALL BASIC
-*CALL SCA
-*CALL MPY
- MMLA SET 1 XY+ZZ
- MMLS SET 2 XY-ZZ
- MNMA SET 3 -XY+ZZ
- MNMS SET 4 -XY-ZZ
- MAIN MACRO TYPE,FCN
- SETYPE TYPE
- IFEQ FCN,MMLA,3
- SIGNX MICRO 1,,*+*
- SIGNZ MICRO 1,,*+*
- VERB MICRO 1,,*MMLA*
- IFEQ FCN,MMLS,3
- SIGNX MICRO 1,,*+*
- SIGNZ MICRO 1,,*-*
- VERB MICRO 1,,*MMLS*
- IFEQ FCN,MNMA,3
- SIGNX MICRO 1,,*-*
- SIGNZ MICRO 1,,*+*
- VERB MICRO 1,,*MNMA*
- IFEQ FCN,MNMS,3
- SIGNX MICRO 1,,*-*
- SIGNZ MICRO 1,,*-*
- VERB MICRO 1,,*MNMS*
- NAME MICRO 1,,*"P"_"VERB"*
- HEADER "NAME",SAVEA0
- TEMP BSS 2 USED BY TMMPYY
- M BSS 1
- L BSS 1
- X11 BSS 1
- Y1L BSS 1
- LY BSS 1
- Z1L BSS 1
- LZ BSS 1
- EXIT "NAME" (M,N,X,X12,X21,Y,Y12,Y21,Z,Z12,Z21)
- SA2 A1+1 X2=(N) A2=((N))
- SB7 1 B7=1
- SA1 X1 X1=M A1=(M)
- SA3 A2+B7 X3=(K) A3=((K))
- SA4 A2+2 X4=(X) A4=((X))
- SA5 A2+5 X5=(Y) A5=((Y))
- SA2 X2 X2=N A2=(N)
- SB1 X1 B1=M
- SA1 A5+3 X1=(Z) A1=((Z))
- SA3 X3 X3=K A3=(K)
- BX0 X4 X0=(X)
- SA4 A4+B7 X4=(X12) A4=((X12))
- BX7 X5 X7=(Y)
- SA5 A5+B7 X5=(Y12) A5=((Y12))
- SB2 X2 B2=N
- SA2 A4+B7 X2=(X21) A2=((X21))
- SB3 X3 B3=K
- SA3 A5+B7 X3=(Y21) A3=((Y21))
- SX6 A0 X6=OLD A0
- LE B1,B0,EXIT IF M .LE. 0 RETURN
- LE B2,B0,EXIT IF N .LE. 0 RETURN
- LE B3,B0,EXIT IF K .LE. 0 RETURN
- SA6 SAVEA0 SAVEA0=OLD A0
- IX4 X4-X0 X4=(X12)-(X)=JX
- IX3 X3-X7 X3=(Y21)-(Y)=JY
- SB4 X4 B4=JX
- SB5 X3 B5=JY
- SA4 A1+B7 X4=(Z12) A4=((Z12))
- SB6 B1-B3 B6=M-K
- SA3 A4+B7 X3=(Z21) A3=((Z21))
- GE B6,B0,MGEK IF M.LT.K EXCHANGE ....
- SB6 B1 M AND K
- SB1 B3
- SB3 B6
- BX6 X0 (X11) AND (Y11)))
- BX0 X7
- BX7 X6
- SB6 B4 JX AND JYYY
- SB4 B5
- SB5 B6
- BX6 X2 (X21) AND (Y12)))
- BX2 X5
- BX5 X6
- BX6 X4 (Z12) AND (Z21)))
- BX4 X3
- BX3 X6
- MGEK BSS 0 M .GE. KK
-* X0=(X)
-* X1=(Z) B1=M
-* X2=(X21) B2=N
-* X3=(Z21) A3=((Z21)) B3=K
-* X4=(Z12) B4=JX
-* X5=(Y12) B5=JY
-* X7=(Y) B7=1
- SX6 B3 X6=K
- SA0 X1 A0=(Z(1,1))
- SA6 L L=K
- IX6 X2-X0 X6=(X21)-(X)=IX
- BX2 X7 X2=(Y(1,1))
- SB3 X6 B3=IX
- IX6 X5-X2 X6=(Y12)-(Y)=LY
- IX7 X4-X1 X7=(Z12)-(Z)=LZ
- SA6 LY LY=(Y(1,2))-(Y(1,1))
- SA7 LZ LZ=(Z(1,2))-(Z(1,1))
- BX6 X5 X6=(Y(1,2))
- BX7 X4 X7=(Z(1,2))
- SA6 Y1L Y1L=(Y(1,2))
- SA7 Z1L Z1L=(Z(1,2))
- BX6 X0 X6=(X)
- SX7 B1 X7=M
- SA6 X11 X11=(X(1,1))
- SA7 M M=M
- IX6 X3-X1 X6=(Z21)-(Z)=IZ
- BX1 X0 X1=(X(1,1))
- SB6 X6 B6=IZ
- MXX "P"MMPY "SIGNX",B1,B2,B3,B4,B5,"SIGNZ",A0,B6,TEMP,B7
-* X1=(X(1,1)), X2=(Y(1,L))
- SA5 L X5=L A5=L
- SA4 M X4=M
- SA3 Z1L X3=(Z(1,L+1)) A3=Z1L
- SA2 Y1L X2=(Y(1,L+1)) A2=Y1L
- SA1 X11 X1=(X(1,1)) A1=X11
- SX6 X5-1 X6=L-1
- SB1 X4 B1=M
- SA6 A5 L=L-1
- SA5 LZ X5=LZ
- SA4 LY X4=LY
- ZR X6,EPILOG IF L=0 RETURN
- SA0 X3 A0=(Z(1,L+1))
- IX7 X3+X5 X7=(Z(1,L+2))
- IX6 X2+X4 X6=(Y(1,L+2))
- SA7 A3 Z1L=(Z(1,L+2))
- SA6 A2 Y1L=(Y(1,L+2))
- JP MXX
- EPILOG
- ENDM
diff --git a/src/packlib/kernlib/kernnum/obsolete/f004cd/rmmla.s b/src/packlib/kernlib/kernnum/obsolete/f004cd/rmmla.s
deleted file mode 100644
index 0a8a032..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f004cd/rmmla.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: rmmla.s,v 1.1.1.1 1996/02/15 17:48:10 mclareni Exp $
-*
-* $Log: rmmla.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:10 mclareni
-* Kernlib
-*
-*
- IDENT RMMLA
-#include "mxxx.inc"
- MAIN RTYPE,MMLA
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f004cd/rmmls.s b/src/packlib/kernlib/kernnum/obsolete/f004cd/rmmls.s
deleted file mode 100644
index ce65f3b..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f004cd/rmmls.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: rmmls.s,v 1.1.1.1 1996/02/15 17:48:11 mclareni Exp $
-*
-* $Log: rmmls.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:11 mclareni
-* Kernlib
-*
-*
- IDENT RMMLS
-#include "mxxx.inc"
- MAIN RTYPE,MMLS
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f004cd/rmmlt.s b/src/packlib/kernlib/kernnum/obsolete/f004cd/rmmlt.s
deleted file mode 100644
index bbbbdc0..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f004cd/rmmlt.s
+++ /dev/null
@@ -1,14 +0,0 @@
-*
-* $Id: rmmlt.s,v 1.1.1.1 1996/02/15 17:48:10 mclareni Exp $
-*
-* $Log: rmmlt.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:10 mclareni
-* Kernlib
-*
-*
-*ADDFILE
-*DECK F004CDC
- IDENT RMMLT
-#include "mmlt.inc"
- MAIN RTYPE
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f004cd/rmnma.s b/src/packlib/kernlib/kernnum/obsolete/f004cd/rmnma.s
deleted file mode 100644
index 2961b8f..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f004cd/rmnma.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: rmnma.s,v 1.1.1.1 1996/02/15 17:48:11 mclareni Exp $
-*
-* $Log: rmnma.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:11 mclareni
-* Kernlib
-*
-*
- IDENT RMNMA
-#include "mxxx.inc"
- MAIN RTYPE,MNMA
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f004cd/rmnms.s b/src/packlib/kernlib/kernnum/obsolete/f004cd/rmnms.s
deleted file mode 100644
index 580c2a6..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f004cd/rmnms.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: rmnms.s,v 1.1.1.1 1996/02/15 17:48:11 mclareni Exp $
-*
-* $Log: rmnms.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:11 mclareni
-* Kernlib
-*
-*
- IDENT RMNMS
-#include "mxxx.inc"
- MAIN RTYPE,MNMS
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f004ib/Imakefile b/src/packlib/kernlib/kernnum/obsolete/f004ib/Imakefile
deleted file mode 100644
index cbc98a6..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f004ib/Imakefile
+++ /dev/null
@@ -1,5 +0,0 @@
-SRCS_S= \ @@\
- cmmla.s cmmls.s cmmlt.s cmmltc.s cmnma.s cmnms.s dmmla.s dmmls.s \ @@\
- dmmlt.s dmnma.s dmnms.s rmmla.s rmmls.s rmmlt.s rmnma.s rmnms.s
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kernnum/obsolete/f004ib/cmmla.s b/src/packlib/kernlib/kernnum/obsolete/f004ib/cmmla.s
deleted file mode 100644
index e20d89b..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f004ib/cmmla.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: cmmla.s,v 1.1.1.1 1996/02/15 17:48:28 mclareni Exp $
-*
-* $Log: cmmla.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:28 mclareni
-* Kernlib
-*
-*
-#include "kernnum/mxxx.inc"
- &TYPE SETA &CTYPE
- &NAME SETC 'MMLA '
- MAIN MMPA
diff --git a/src/packlib/kernlib/kernnum/obsolete/f004ib/cmmls.s b/src/packlib/kernlib/kernnum/obsolete/f004ib/cmmls.s
deleted file mode 100644
index 85d66aa..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f004ib/cmmls.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: cmmls.s,v 1.1.1.1 1996/02/15 17:48:28 mclareni Exp $
-*
-* $Log: cmmls.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:28 mclareni
-* Kernlib
-*
-*
-#include "kernnum/mxxx.inc"
- &TYPE SETA &CTYPE
- &NAME SETC 'MMLS '
- MAIN MMPS
diff --git a/src/packlib/kernlib/kernnum/obsolete/f004ib/cmmlt.s b/src/packlib/kernlib/kernnum/obsolete/f004ib/cmmlt.s
deleted file mode 100644
index a531bdf..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f004ib/cmmlt.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: cmmlt.s,v 1.1.1.1 1996/02/15 17:48:28 mclareni Exp $
-*
-* $Log: cmmlt.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:28 mclareni
-* Kernlib
-*
-*
-#include "kernnum/mmlt.inc"
- &TYPE SETA &CTYPE
- &NAME SETC 'MMLT '
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f004ib/cmmltc.s b/src/packlib/kernlib/kernnum/obsolete/f004ib/cmmltc.s
deleted file mode 100644
index 59ca1a1..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f004ib/cmmltc.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: cmmltc.s,v 1.1.1.1 1996/02/15 17:48:28 mclareni Exp $
-*
-* $Log: cmmltc.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:28 mclareni
-* Kernlib
-*
-*
-#include "kernnum/mmlt.inc"
- &TYPE SETA &CTYPEC
- &NAME SETC 'MMLTC'
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f004ib/cmnma.s b/src/packlib/kernlib/kernnum/obsolete/f004ib/cmnma.s
deleted file mode 100644
index 5b4c02e..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f004ib/cmnma.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: cmnma.s,v 1.1.1.1 1996/02/15 17:48:29 mclareni Exp $
-*
-* $Log: cmnma.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:29 mclareni
-* Kernlib
-*
-*
-#include "kernnum/mxxx.inc"
- &TYPE SETA &CTYPE
- &NAME SETC 'MNMA '
- MAIN MMNA
diff --git a/src/packlib/kernlib/kernnum/obsolete/f004ib/cmnms.s b/src/packlib/kernlib/kernnum/obsolete/f004ib/cmnms.s
deleted file mode 100644
index a0f9272..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f004ib/cmnms.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: cmnms.s,v 1.1.1.1 1996/02/15 17:48:29 mclareni Exp $
-*
-* $Log: cmnms.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:29 mclareni
-* Kernlib
-*
-*
-#include "kernnum/mxxx.inc"
- &TYPE SETA &CTYPE
- &NAME SETC 'MNMS '
- MAIN MMNS
diff --git a/src/packlib/kernlib/kernnum/obsolete/f004ib/dmmla.s b/src/packlib/kernlib/kernnum/obsolete/f004ib/dmmla.s
deleted file mode 100644
index 1729bcc..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f004ib/dmmla.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: dmmla.s,v 1.1.1.1 1996/02/15 17:48:28 mclareni Exp $
-*
-* $Log: dmmla.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:28 mclareni
-* Kernlib
-*
-*
-#include "kernnum/mxxx.inc"
- &TYPE SETA &DTYPE
- &NAME SETC 'MMLA '
- MAIN MMPA
diff --git a/src/packlib/kernlib/kernnum/obsolete/f004ib/dmmls.s b/src/packlib/kernlib/kernnum/obsolete/f004ib/dmmls.s
deleted file mode 100644
index 5b1d256..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f004ib/dmmls.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: dmmls.s,v 1.1.1.1 1996/02/15 17:48:28 mclareni Exp $
-*
-* $Log: dmmls.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:28 mclareni
-* Kernlib
-*
-*
-#include "kernnum/mxxx.inc"
- &TYPE SETA &DTYPE
- &NAME SETC 'MMLS '
- MAIN MMPS
diff --git a/src/packlib/kernlib/kernnum/obsolete/f004ib/dmmlt.s b/src/packlib/kernlib/kernnum/obsolete/f004ib/dmmlt.s
deleted file mode 100644
index 3f53b4c..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f004ib/dmmlt.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: dmmlt.s,v 1.1.1.1 1996/02/15 17:48:28 mclareni Exp $
-*
-* $Log: dmmlt.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:28 mclareni
-* Kernlib
-*
-*
-#include "kernnum/mmlt.inc"
- &TYPE SETA &DTYPE
- &NAME SETC 'MMLT '
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f004ib/dmnma.s b/src/packlib/kernlib/kernnum/obsolete/f004ib/dmnma.s
deleted file mode 100644
index 069647e..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f004ib/dmnma.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: dmnma.s,v 1.1.1.1 1996/02/15 17:48:29 mclareni Exp $
-*
-* $Log: dmnma.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:29 mclareni
-* Kernlib
-*
-*
-#include "kernnum/mxxx.inc"
- &TYPE SETA &DTYPE
- &NAME SETC 'MNMA '
- MAIN MMNA
diff --git a/src/packlib/kernlib/kernnum/obsolete/f004ib/dmnms.s b/src/packlib/kernlib/kernnum/obsolete/f004ib/dmnms.s
deleted file mode 100644
index e98b7ac..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f004ib/dmnms.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: dmnms.s,v 1.1.1.1 1996/02/15 17:48:29 mclareni Exp $
-*
-* $Log: dmnms.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:29 mclareni
-* Kernlib
-*
-*
-#include "kernnum/mxxx.inc"
- &TYPE SETA &DTYPE
- &NAME SETC 'MNMS '
- MAIN MMNS
diff --git a/src/packlib/kernlib/kernnum/obsolete/f004ib/mmlt.inc b/src/packlib/kernlib/kernnum/obsolete/f004ib/mmlt.inc
deleted file mode 100644
index 357fb33..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f004ib/mmlt.inc
+++ /dev/null
@@ -1,68 +0,0 @@
-*
-* $Id: mmlt.inc,v 1.1.1.1 1996/02/15 17:48:28 mclareni Exp $
-*
-* $Log: mmlt.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:28 mclareni
-* Kernlib
-*
-*
-*
-* mmlt.inc
-*
-#include "basic.inc"
-#include "cpy.inc"
-#include "utl.inc"
-#include "mpy.inc"
-#include "mlt.inc"
- MACRO
- MAIN
-#include "global.inc"
- &TWORDS SETA 9
- SETYPE
- HEADER ENTRY (M,N,K,X,X12,X21,Y,Y12,Y21,Z,Z12,Z21,T)
- X EQU 2
- JX EQU 3
- IX EQU 4
- Y EQU 5
- LY EQU 6
- JY EQU 7
- Z EQU 8
- LZ EQU 9
- IZ EQU 10
- M EQU 11
- N EQU 12
- ®LIM SETA 12
- ENTRY PROLOG
- L 0,48(1) R0 = (T)
- N 0,=X'7FFFFFFF'
- L 11,0(1) R11= (M)
- L 12,4(1) R12= (N)
- LM 1,10,8(1) R1 = (K)
- * R2 = (X)
- * R3 = (X12)
- * R4 = (X21)
- * R5 = (Y)
- * R6 = (Y12)
- * R7 = (Y21)
- * R8 = (Z)
- * R9 = (Z12)
- * R10= (Z21)
- L 11,0(11) R11= M
- L 12,0(12) R12= N
- L 1,0(1) R1 = K
- C M,=F'0'
- BNH RETURN IF(M .LE. 0) RETURN
- C N,=F'0'
- BNH RETURN IF(N .LE. 0) RETURN
- C 1,=F'0'
- BNH RETURN IF(K .LE. 0) RETURN
- SR 3,2 R3 = (X12) - (X) = JX
- SR 4,2 R4 = (X21) - (X) = IX
- SR 6,5 R6 = (Y12) - (Y) = LY
- SR 7,5 R7 = (Y21) - (Y) = JY
- SR 9,8 R9 = (Z12) - (Z) = LZ
- SR 10,8 R10= (Z21) - (Z) = IZ
- TMMLT M,N,X,IX,JX,Y,JY,LY,Z,IZ,LZ R0=(T),R1=K
- RETURN EPILOG
- MEND
-#include "tglobal.inc"
diff --git a/src/packlib/kernlib/kernnum/obsolete/f004ib/mxxx.inc b/src/packlib/kernlib/kernnum/obsolete/f004ib/mxxx.inc
deleted file mode 100644
index 5c12f57..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f004ib/mxxx.inc
+++ /dev/null
@@ -1,71 +0,0 @@
-*
-* $Id: mxxx.inc,v 1.1.1.1 1996/02/15 17:48:28 mclareni Exp $
-*
-* $Log: mxxx.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:28 mclareni
-* Kernlib
-*
-*
-*
-* mxxx.inc
-*
-#include "basic.inc"
-#include "mpy.inc"
-#include "mlt.inc"
- MACRO
- MAIN &F
-#include "global.inc"
- &TWORDS SETA 6
- SETYPE
- HEADER ENTRY (M,N,K,X,X12,X21,Y,Y12,Y21,Z,Z12,Z21)
- X EQU 2
- JX EQU 3
- IX EQU 4
- Y EQU 5
- LY EQU 6
- JY EQU 7
- Z EQU 8
- LZ EQU 9
- IZ EQU 10
- M EQU 11
- N EQU 12
- ®LIM SETA 12
- ENTRY PROLOG
- L 11,0(1) R11= (M)
- L 12,4(1) R12= (N)
- LM 1,10,8(1) R1 = (K)
- * R2 = (X)
- * R3 = (X12)
- * R4 = (X21)
- * R5 = (Y)
- * R6 = (Y12)
- * R7 = (Y21)
- * R8 = (Z)
- * R9 = (Z12)
- * R10= (Z21)+8000 0000
- N 10,=X'7FFFFFFF'
- L 11,0(11) R11= M
- L 12,0(12) R12= N
- L 1,0(1) R1 = K
- C M,=F'0'
- BNH RETURN IF(M .LE. 0) RETURN
- C N,=F'0'
- BNH RETURN IF(N .LE. 0) RETURN
- C 1,=F'0'
- BNH RETURN IF(K .LE. 0) RETURN
- SR 3,2 R3 = (X12) - (X) = JX
- SR 4,2 R4 = (X21) - (X) = IX
- SR 6,5 R6 = (Y12) - (Y) = LY
- SR 7,5 R7 = (Y21) - (Y) = JY
- SR 9,8 R9 = (Z12) - (Z) = LZ
- SR 10,8 R10= (Z21) - (Z) = IZ
- A&SYSNDX PUSH 1 SAVE K-I+1
- TXMPY &F,M,N,X,IX,JX,Y,JY,Z,IZ
- AR Y,LY
- AR Z,LZ
- POP 1 R1=K-I+1
- S 1,=F'1' R1=K-I
- BNZ A&SYSNDX
- RETURN EPILOG
- MEND
-#include "tglobal.inc"
diff --git a/src/packlib/kernlib/kernnum/obsolete/f004ib/rmmla.s b/src/packlib/kernlib/kernnum/obsolete/f004ib/rmmla.s
deleted file mode 100644
index f362d04..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f004ib/rmmla.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: rmmla.s,v 1.1.1.1 1996/02/15 17:48:28 mclareni Exp $
-*
-* $Log: rmmla.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:28 mclareni
-* Kernlib
-*
-*
-#include "kernnum/mxxx.inc"
- &TYPE SETA &RTYPE
- &NAME SETC 'MMLA '
- MAIN MMPA
diff --git a/src/packlib/kernlib/kernnum/obsolete/f004ib/rmmls.s b/src/packlib/kernlib/kernnum/obsolete/f004ib/rmmls.s
deleted file mode 100644
index 901fb0a..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f004ib/rmmls.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: rmmls.s,v 1.1.1.1 1996/02/15 17:48:28 mclareni Exp $
-*
-* $Log: rmmls.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:28 mclareni
-* Kernlib
-*
-*
-#include "kernnum/mxxx.inc"
- &TYPE SETA &RTYPE
- &NAME SETC 'MMLS '
- MAIN MMPS
diff --git a/src/packlib/kernlib/kernnum/obsolete/f004ib/rmmlt.s b/src/packlib/kernlib/kernnum/obsolete/f004ib/rmmlt.s
deleted file mode 100644
index d639695..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f004ib/rmmlt.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: rmmlt.s,v 1.1.1.1 1996/02/15 17:48:28 mclareni Exp $
-*
-* $Log: rmmlt.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:28 mclareni
-* Kernlib
-*
-*
-#include "kernnum/mmlt.inc"
- &TYPE SETA &RTYPE
- &NAME SETC 'MMLT '
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f004ib/rmnma.s b/src/packlib/kernlib/kernnum/obsolete/f004ib/rmnma.s
deleted file mode 100644
index b09d23f..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f004ib/rmnma.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: rmnma.s,v 1.1.1.1 1996/02/15 17:48:29 mclareni Exp $
-*
-* $Log: rmnma.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:29 mclareni
-* Kernlib
-*
-*
-#include "kernnum/mxxx.inc"
- &TYPE SETA &RTYPE
- &NAME SETC 'MNMA '
- MAIN MMNA
diff --git a/src/packlib/kernlib/kernnum/obsolete/f004ib/rmnms.s b/src/packlib/kernlib/kernnum/obsolete/f004ib/rmnms.s
deleted file mode 100644
index 80f4002..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f004ib/rmnms.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: rmnms.s,v 1.1.1.1 1996/02/15 17:48:29 mclareni Exp $
-*
-* $Log: rmnms.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:29 mclareni
-* Kernlib
-*
-*
-#include "kernnum/mxxx.inc"
- &TYPE SETA &RTYPE
- &NAME SETC 'MNMS '
- MAIN MMNS
diff --git a/src/packlib/kernlib/kernnum/obsolete/f011cd/cfact.s b/src/packlib/kernlib/kernnum/obsolete/f011cd/cfact.s
deleted file mode 100644
index df3b485..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f011cd/cfact.s
+++ /dev/null
@@ -1,13 +0,0 @@
-*
-* $Id: cfact.s,v 1.1.1.1 1996/02/15 17:48:12 mclareni Exp $
-*
-* $Log: cfact.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:12 mclareni
-* Kernlib
-*
-*
- IDENT CFACT
-#include "fact.inc"
-#include "nair.inc"
- MAIN CTYPE,B1,B2,B3,B4,B5,B6,B7
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f011cd/cfeqn.s b/src/packlib/kernlib/kernnum/obsolete/f011cd/cfeqn.s
deleted file mode 100644
index 33dcf8e..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f011cd/cfeqn.s
+++ /dev/null
@@ -1,13 +0,0 @@
-*
-* $Id: cfeqn.s,v 1.1.1.1 1996/02/15 17:48:12 mclareni Exp $
-*
-* $Log: cfeqn.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:12 mclareni
-* Kernlib
-*
-*
- IDENT CFEQN
-#include "feqn.inc"
-#include "nairkb.inc"
- MAIN CTYPE,B1,B2,B3,B4,B5,B6,B7
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f011cd/cfinv.s b/src/packlib/kernlib/kernnum/obsolete/f011cd/cfinv.s
deleted file mode 100644
index c4a289c..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f011cd/cfinv.s
+++ /dev/null
@@ -1,13 +0,0 @@
-*
-* $Id: cfinv.s,v 1.1.1.1 1996/02/15 17:48:12 mclareni Exp $
-*
-* $Log: cfinv.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:12 mclareni
-* Kernlib
-*
-*
- IDENT CFINV
-#include "finv.inc"
-#include "nair.inc"
- MAIN CTYPE,B1,B2,B3,B4,B5,B6,B7
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f011cd/dfact.s b/src/packlib/kernlib/kernnum/obsolete/f011cd/dfact.s
deleted file mode 100644
index edc9cb5..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f011cd/dfact.s
+++ /dev/null
@@ -1,13 +0,0 @@
-*
-* $Id: dfact.s,v 1.1.1.1 1996/02/15 17:48:12 mclareni Exp $
-*
-* $Log: dfact.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:12 mclareni
-* Kernlib
-*
-*
- IDENT DFACT
-#include "fact.inc"
-#include "nair.inc"
- MAIN DTYPE,B1,B2,B3,B4,B5,B6,B7
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f011cd/dfeqn.s b/src/packlib/kernlib/kernnum/obsolete/f011cd/dfeqn.s
deleted file mode 100644
index a569045..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f011cd/dfeqn.s
+++ /dev/null
@@ -1,13 +0,0 @@
-*
-* $Id: dfeqn.s,v 1.1.1.1 1996/02/15 17:48:12 mclareni Exp $
-*
-* $Log: dfeqn.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:12 mclareni
-* Kernlib
-*
-*
- IDENT DFEQN
-#include "feqn.inc"
-#include "nairkb.inc"
- MAIN DTYPE,B1,B2,B3,B4,B5,B6,B7
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f011cd/dfinv.s b/src/packlib/kernlib/kernnum/obsolete/f011cd/dfinv.s
deleted file mode 100644
index 4ebf6cf..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f011cd/dfinv.s
+++ /dev/null
@@ -1,13 +0,0 @@
-*
-* $Id: dfinv.s,v 1.1.1.1 1996/02/15 17:48:12 mclareni Exp $
-*
-* $Log: dfinv.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:12 mclareni
-* Kernlib
-*
-*
- IDENT DFINV
-#include "finv.inc"
-#include "nair.inc"
- MAIN DTYPE,B1,B2,B3,B4,B5,B6,B7
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f011cd/fact.inc b/src/packlib/kernlib/kernnum/obsolete/f011cd/fact.inc
deleted file mode 100644
index 0310555..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f011cd/fact.inc
+++ /dev/null
@@ -1,51 +0,0 @@
-*
-* $Id: fact.inc,v 1.1.1.1 1996/02/15 17:48:12 mclareni Exp $
-*
-* $Log: fact.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:12 mclareni
-* Kernlib
-*
-*
-*
-* fact.inc
-*
-*CALL BASIC
-*CALL FACT
-*CALL DET
-*CALL MAXA
-*CALL SCL
-*CALL MPY
-*CALL SCA
-*CALL XCH
-*CALL TMPRNT
- MAIN MACRO TYPE,N,JA,A,R,I,J,K
- SETYPE TYPE
- GNAME MICRO 1,,*FACT*
- NAME MICRO 1,,*"P"_"GNAME"*
- HEADER "NAME",SAVEA0
- ARGLIST BSS 1 ((IFAIL))
- SAVEA BSS 1 (A(1,1))
- SAVER BSS 1 (R(1))
- TEMP7L BSS 7
- BSS LENGTH
- EXIT "NAME" (N,A,IDIM,R,IFAIL,DET,JFAIL)
- PROLOG ERROR,SAVEA,SAVER,N,JA,J X1=(A), X3=(R),A3=((R))
- SX6 A3+J X6=((IFAIL))
- SA6 ARGLIST ARGLIST=((IFAIL))
- TFACT TYPE,SAVEA,SAVER,N,JA,TEMP7L,A,R,I,J,K
- SA2 ARGLIST X2=((IFAIL))
- SA4 X2+1 X4=(DET) A4=((DET))
- SA1 X2 X1=(IFAIL)A1=((IFAIL))
- SA2 X2+2 X2=(JFAIL)A2=((JFAIL))
- SA6 X4 STORE DET
- TAU IFEQ LENGTH,2
- SA7 X4+1
- TAU ENDIF
- BX6 X5 X6=IFAIL
- BX7 X0 X7=JFAIL
- SA6 X1 STORE IFAIL
- SA7 X2 STORE JFAIL
- EPILOG
- HMPRNT VFD 60/10H "P"_"GNAME"
- ERROR TMPRNT HMPRNT,X4,X2,B0
- ENDM
diff --git a/src/packlib/kernlib/kernnum/obsolete/f011cd/feqn.inc b/src/packlib/kernlib/kernnum/obsolete/f011cd/feqn.inc
deleted file mode 100644
index 21042d4..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f011cd/feqn.inc
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: feqn.inc,v 1.1.1.1 1996/02/15 17:48:12 mclareni Exp $
-*
-* $Log: feqn.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:12 mclareni
-* Kernlib
-*
-*
-*
-* feqn.inc
-*
-*CALL BASIC
-*CALL FEQN
-*CALL MPY
-*CALL SUBST
-*CALL XCH
-*CALL TMPRNT
- MAIN MACRO TYPE,N,JA,K,B,I,J,L
- SETYPE TYPE
- GNAME MICRO 1,,*FEQN*
- NAME MICRO 1,,*"P"_"GNAME"*
- HEADER "NAME",SAVEA0
- SAVEA BSS 1
- TEMP1 BSS 1
- EXIT "NAME" (N,A,IDIM,R,K,B)
- PROLOG ERROR,SAVEA,N,JA,K,B,J X3=(R) X1=(A) JA=IDIM
- TFEQN TYPE,SAVEA,N,JA,K,B,TEMP1,I,J,L X1=(A), X3=(R)
- EPILOG
- HMPRNT VFD 60/10H "P"_"GNAME"
- ERROR TMPRNT HMPRNT,X0,X4,X5
- ENDM
diff --git a/src/packlib/kernlib/kernnum/obsolete/f011cd/finv.inc b/src/packlib/kernlib/kernnum/obsolete/f011cd/finv.inc
deleted file mode 100644
index 0ccc673..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f011cd/finv.inc
+++ /dev/null
@@ -1,35 +0,0 @@
-*
-* $Id: finv.inc,v 1.1.1.1 1996/02/15 17:48:12 mclareni Exp $
-*
-* $Log: finv.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:12 mclareni
-* Kernlib
-*
-*
-*
-* finv.inc
-*
-*CALL BASIC
-*CALL FINV
-*CALL MPY
-*CALL SCA
-*CALL SCL
-*CALL SUBST
-*CALL XCH
-*CALL TMPRNT
- MAIN MACRO TYPE,N,IA,JA,I,J,K,L
- SETYPE TYPE
- GNAME MICRO 1,,*FINV*
- NAME MICRO 1,,*"P"_"GNAME"*
- HEADER "NAME",SAVEA0
- SAVEA BSS 1 (A(1,1))
- SAVER BSS 1 (R(1))
- TEMP4 BSS 4
- EXIT "NAME" (N,A,IDIM,R)
- PROLOG ERROR,SAVEA,SAVER,N,JA,J X1=(A), X3=(R)
- EQ N,J,EPILOG IF N=1 RETURN
- TFINV TYPE,SAVEA,SAVER,N,JA,TEMP4,IA,I,J,K,L X1=(A),X3=(R)
- EPILOG
- HMPRNT VFD 60/10H "P"_"GNAME"
- ERROR TMPRNT HMPRNT,X4,X2,B0
- ENDM
diff --git a/src/packlib/kernlib/kernnum/obsolete/f011cd/nair.inc b/src/packlib/kernlib/kernnum/obsolete/f011cd/nair.inc
deleted file mode 100644
index 0925a36..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f011cd/nair.inc
+++ /dev/null
@@ -1,39 +0,0 @@
-*
-* $Id: nair.inc,v 1.1.1.1 1996/02/15 17:48:12 mclareni Exp $
-*
-* $Log: nair.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:12 mclareni
-* Kernlib
-*
-*
-*
-* nair.inc
-*
- PROLOG MACRO ERROR,SAVEA,SAVER,NN,JA,ONE X1=(A), X3=(R), A3=((R))
- BSS 0 X1=(N) A1=((N))
- + SA2 A1+2 0 X2=(IDIM) A2=((IDIM))
- S_ONE 1 1 ONE=1
- + SA4 X1 2 X4=N A4=(N)
- SA1 A2-ONE 3 X1=(A) A1=((A))
- SA3 A2+ONE 4 X3=(R) A3=((R))
- SX7 A0 5 X7=OLD A0
-* 6 X7
-* 7 X2
- + SA2 X2 8 X2=IDIM A2=(IDIM)
- SA7 SAVEA0 9 X4 SAVEA0=OLD A0
- S_NN X4 10 X1 NN=N
-* 11 X3
-* 12
- + LT NN,ONE,ERROR IF N<1
-* 14
- BX6 X1 15 X2 X6=(A)
- S_JA X2 16 X6 JA=IDIM
- + BX7 X3 17 X7=(R)
-* 18 X7
- LT JA,NN,ERROR IF IDIM<N
- TAU IFEQ LENGTH,2
- S_JA JA+JA JA=LENGTH*IDIM
- TAU ENDIF
- SA6 SAVEA SAVEA=(A(1,1))
- SA7 SAVER SAVER=(R(1))
- PROLOG ENDM X1=(A), X3=(R), A3=((R))
diff --git a/src/packlib/kernlib/kernnum/obsolete/f011cd/nairkb.inc b/src/packlib/kernlib/kernnum/obsolete/f011cd/nairkb.inc
deleted file mode 100644
index d97480e..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f011cd/nairkb.inc
+++ /dev/null
@@ -1,45 +0,0 @@
-*
-* $Id: nairkb.inc,v 1.1.1.1 1996/02/15 17:48:12 mclareni Exp $
-*
-* $Log: nairkb.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:12 mclareni
-* Kernlib
-*
-*
-*
-* nairkb.inc
-*
- PROLOG MACRO ERROR,SAVEA,NN,JA,KK,B,ONE X3=(R), X1=(A), X2=(B)
- BSS 0 X1=(N) A1=((N))
- SA3 A1+3 0 X3=(R) A3=((R))
- S_ONE 1 1 ONE=1
- + SA1 X1 2 X1=N A1=(N)
- SA5 A3+ONE 3 X5=(K) A5=((K))
- SA4 A3-ONE 4 X4=(IDIM) A4=((IDIM))
- SX7 A0 5 X7=OLD A0
-* 6 X7
-* 7 X3
- + SA7 SAVEA0 8 SAVEA0=OLD A0
- SA2 A5+ONE 9 X1 X2=(B) A2=((B))
- S_NN X1 10 X5 NN=N
- + SA5 X5 11 X4 X5=K A5=(K)
- SA1 A4-ONE 12 X1=(A) A1=((A))
- SA4 X4 13 X4=IDIM A4=(IDIM)
- SX0 NN 14 X0=N
- + NO 15 X0
-* 16 X2
- S_B X2 17 B=(B)
-* 18 X5
- LT NN,ONE,ERROR X1 IF N<1
- + S_KK X5 20 X4 KK=K
- S_JA X4 21 JA=IDIM
-* 22
- LT KK,ONE,ERROR IF K<1
-* 24
- + LT JA,NN,ERROR IF IDIM<N
- BX6 X1 26 X6=(A)
- TAU IFEQ LENGTH,2
- S_JA JA+JA JA=LENGTH*IDIM
- TAU ENDIF
- SA6 SAVEA SAVEA=(A)
- PROLOG ENDM X1=(A), X2=(B), X3=(R)
diff --git a/src/packlib/kernlib/kernnum/obsolete/f011cd/rfact.s b/src/packlib/kernlib/kernnum/obsolete/f011cd/rfact.s
deleted file mode 100644
index 0e59648..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f011cd/rfact.s
+++ /dev/null
@@ -1,15 +0,0 @@
-*
-* $Id: rfact.s,v 1.1.1.1 1996/02/15 17:48:12 mclareni Exp $
-*
-* $Log: rfact.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:12 mclareni
-* Kernlib
-*
-*
-*ADDFILE
-*DECK F011CDC
- IDENT RFACT
-#include "fact.inc"
-#include "nair.inc"
- MAIN RTYPE,B1,B2,B3,B4,B5,B6,B7
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f011cd/rfeqn.s b/src/packlib/kernlib/kernnum/obsolete/f011cd/rfeqn.s
deleted file mode 100644
index 00d1df9..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f011cd/rfeqn.s
+++ /dev/null
@@ -1,13 +0,0 @@
-*
-* $Id: rfeqn.s,v 1.1.1.1 1996/02/15 17:48:12 mclareni Exp $
-*
-* $Log: rfeqn.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:12 mclareni
-* Kernlib
-*
-*
- IDENT RFEQN
-#include "feqn.inc"
-#include "nairkb.inc"
- MAIN RTYPE,B1,B2,B3,B4,B5,B6,B7
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f011cd/rfinv.s b/src/packlib/kernlib/kernnum/obsolete/f011cd/rfinv.s
deleted file mode 100644
index 8a8b56a..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f011cd/rfinv.s
+++ /dev/null
@@ -1,13 +0,0 @@
-*
-* $Id: rfinv.s,v 1.1.1.1 1996/02/15 17:48:12 mclareni Exp $
-*
-* $Log: rfinv.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:12 mclareni
-* Kernlib
-*
-*
- IDENT RFINV
-#include "finv.inc"
-#include "nair.inc"
- MAIN RTYPE,B1,B2,B3,B4,B5,B6,B7
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f011ib/Imakefile b/src/packlib/kernlib/kernnum/obsolete/f011ib/Imakefile
deleted file mode 100644
index 080b159..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f011ib/Imakefile
+++ /dev/null
@@ -1,5 +0,0 @@
-SRCS_S= \ @@\
- cfact.s cfeqn.s cfinv.s dfact.s dfeqn.s dfinv.s rfact.s rfeqn.s \ @@\
- rfinv.s
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kernnum/obsolete/f011ib/cfact.s b/src/packlib/kernlib/kernnum/obsolete/f011ib/cfact.s
deleted file mode 100644
index 9034a34..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f011ib/cfact.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: cfact.s,v 1.1.1.1 1996/02/15 17:48:29 mclareni Exp $
-*
-* $Log: cfact.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:29 mclareni
-* Kernlib
-*
-*
-#include "kernnum/tfact.inc"
- &TYPE SETA &CTYPE
- &NAME SETC 'FACT '
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f011ib/cfeqn.s b/src/packlib/kernlib/kernnum/obsolete/f011ib/cfeqn.s
deleted file mode 100644
index 40339ae..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f011ib/cfeqn.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: cfeqn.s,v 1.1.1.1 1996/02/15 17:48:29 mclareni Exp $
-*
-* $Log: cfeqn.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:29 mclareni
-* Kernlib
-*
-*
-#include "kernnum/tfeqn.inc"
- &TYPE SETA &CTYPE
- &NAME SETC 'FEQN '
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f011ib/cfinv.s b/src/packlib/kernlib/kernnum/obsolete/f011ib/cfinv.s
deleted file mode 100644
index 2620f8d..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f011ib/cfinv.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: cfinv.s,v 1.1.1.1 1996/02/15 17:48:29 mclareni Exp $
-*
-* $Log: cfinv.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:29 mclareni
-* Kernlib
-*
-*
-#include "kernnum/tfinv.inc"
- &TYPE SETA &CTYPE
- &NAME SETC 'FINV '
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f011ib/dfact.s b/src/packlib/kernlib/kernnum/obsolete/f011ib/dfact.s
deleted file mode 100644
index ee320e1..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f011ib/dfact.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: dfact.s,v 1.1.1.1 1996/02/15 17:48:29 mclareni Exp $
-*
-* $Log: dfact.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:29 mclareni
-* Kernlib
-*
-*
-#include "kernnum/tfact.inc"
- &TYPE SETA &DTYPE
- &NAME SETC 'FACT '
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f011ib/dfeqn.s b/src/packlib/kernlib/kernnum/obsolete/f011ib/dfeqn.s
deleted file mode 100644
index 910d208..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f011ib/dfeqn.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: dfeqn.s,v 1.1.1.1 1996/02/15 17:48:29 mclareni Exp $
-*
-* $Log: dfeqn.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:29 mclareni
-* Kernlib
-*
-*
-#include "kernnum/tfeqn.inc"
- &TYPE SETA &DTYPE
- &NAME SETC 'FEQN '
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f011ib/dfinv.s b/src/packlib/kernlib/kernnum/obsolete/f011ib/dfinv.s
deleted file mode 100644
index 0aed957..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f011ib/dfinv.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: dfinv.s,v 1.1.1.1 1996/02/15 17:48:29 mclareni Exp $
-*
-* $Log: dfinv.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:29 mclareni
-* Kernlib
-*
-*
-#include "kernnum/tfinv.inc"
- &TYPE SETA &DTYPE
- &NAME SETC 'FINV '
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f011ib/rfact.s b/src/packlib/kernlib/kernnum/obsolete/f011ib/rfact.s
deleted file mode 100644
index 25f8fc4..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f011ib/rfact.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: rfact.s,v 1.1.1.1 1996/02/15 17:48:29 mclareni Exp $
-*
-* $Log: rfact.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:29 mclareni
-* Kernlib
-*
-*
-#include "kernnum/tfact.inc"
- &TYPE SETA &RTYPE
- &NAME SETC 'FACT '
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f011ib/rfeqn.s b/src/packlib/kernlib/kernnum/obsolete/f011ib/rfeqn.s
deleted file mode 100644
index 1b632f2..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f011ib/rfeqn.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: rfeqn.s,v 1.1.1.1 1996/02/15 17:48:29 mclareni Exp $
-*
-* $Log: rfeqn.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:29 mclareni
-* Kernlib
-*
-*
-#include "kernnum/tfeqn.inc"
- &TYPE SETA &RTYPE
- &NAME SETC 'FEQN '
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f011ib/rfinv.s b/src/packlib/kernlib/kernnum/obsolete/f011ib/rfinv.s
deleted file mode 100644
index 0bc7f73..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f011ib/rfinv.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: rfinv.s,v 1.1.1.1 1996/02/15 17:48:29 mclareni Exp $
-*
-* $Log: rfinv.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:29 mclareni
-* Kernlib
-*
-*
-#include "kernnum/tfinv.inc"
- &TYPE SETA &RTYPE
- &NAME SETC 'FINV '
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f011ib/tfact.inc b/src/packlib/kernlib/kernnum/obsolete/f011ib/tfact.inc
deleted file mode 100644
index 81faf5c..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f011ib/tfact.inc
+++ /dev/null
@@ -1,76 +0,0 @@
-*
-* $Id: tfact.inc,v 1.1.1.1 1996/02/15 17:48:29 mclareni Exp $
-*
-* $Log: tfact.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:29 mclareni
-* Kernlib
-*
-*
-*
-* tfact.inc
-*
-#include "basic.inc"
-#include "mxa.inc"
-#include "xch.inc"
-#include "mpy.inc"
-#include "scl.inc"
-#include "fact.inc"
-#include "det.inc"
-#include "tmprnt.inc"
- MACRO
- MAIN
-#include "global.inc"
- &TWORDS SETA 11
- SETYPE
- HEADER ENTRY
- ISTEP EQU 2
- I EQU 3 (DIFFERS FROM 8 - 10)
- N EQU 4
- A EQU 5
- JA EQU 6
- R EQU 7
- IA EQU 8
- X EQU 9
- Y EQU 10
- J EQU 11 (DIFFERS FROM 8 - 10)
- L EQU 12
- ®LIM SETA 12
- HFACT DS 0F
- DC C' &T.FACT '
- LOCOUT DS 3F (IFAIL), (DET), (JFAIL)
- ENTRY PROLOG
- LM 4,10,0(1)
- * R4 = (N)
- * R5 = (A)
- * R6 = (IDIM)
- * R7 = (R)
- * R8 = (IFAIL)
- * R9 = (DET)
- * R10= (JFAIL)
- N 10,=X'7FFFFFFF'
- STM 8,10,LOCOUT
- L N,0(4)
- L JA,0(6) JA = IDIM
- * IF(N.LE.0 .OR. IDIM.LT.N) GOTO 99
- C N,=F'0'
- BC LE,FACT99 IF N .LE. 0
- CR JA,N
- BC LT,FACT99 IF IDIM .LT. N
- LA IA,&LENGTH IA = WORD LENGTH
- LR 1,JA R1 = IDIM
- MR 0,IA R1 = IDIM * IA
- LR JA,1 JA = IDIM * IA
- TFACT 12,N,A,IA,JA,R,X,Y,I,J,L
- * F0,F2 = DET
- * I = IFAIL
- * J = JFAIL
- LM 8,10,LOCOUT
- ST I,0(8) STORE IFAIL
- STORE 0,9 STORE DET
- ST J,0(10) STORE JFAIL
- B RETURN
- FACT99 DS 0H
- TMPRNT HFACT,N,JA,0
- RETURN EPILOG
- MEND
-#include "tglobal.inc"
diff --git a/src/packlib/kernlib/kernnum/obsolete/f011ib/tfeqn.inc b/src/packlib/kernlib/kernnum/obsolete/f011ib/tfeqn.inc
deleted file mode 100644
index c2091ea..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f011ib/tfeqn.inc
+++ /dev/null
@@ -1,67 +0,0 @@
-*
-* $Id: tfeqn.inc,v 1.1.1.1 1996/02/15 17:48:29 mclareni Exp $
-*
-* $Log: tfeqn.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:29 mclareni
-* Kernlib
-*
-*
-*
-* tfeqn.inc
-*
-#include "basic.inc"
-#include "xch.inc"
-#include "mpy.inc"
-#include "msubst.inc"
-#include "feqn.inc"
-#include "tmprnt.inc"
- MACRO
- MAIN
-#include "global.inc"
- &TWORDS SETA 5
- SETYPE
- HEADER ENTRY
- Z EQU 2
- I EQU 3
- N EQU 4
- A EQU 5
- JA EQU 6
- R EQU 7
- K EQU 8
- B EQU 9
- IA EQU 10
- IA2 EQU 11
- JA2 EQU 12
- ®LIM SETA 12
- HFEQN DS 0F
- DC C' &T.FEQN '
- ENTRY PROLOG
- LM 4,9,0(1)
- * R4 = (N)
- * R5 = (A)
- * R6 = (IDIM)
- * R7 = (R)
- * R8 = (K)
- * R9 = (B)
- N 9,=X'7FFFFFFF'
- L N,0(4)
- L JA,0(6) JA = IDIM
- L K,0(8)
- * IF(N.LE.0 .OR. IDIM.LT.N .OR. K.LE.0) GOTO 99
- C N,=F'0'
- BC LE,FEQN99 IF N .LE. 0
- CR JA,N
- BC LT,FEQN99 IF IDIM .LT. N
- C K,=F'0'
- BC LE,FEQN99 IF K .LE. 0
- LA IA,&LENGTH IA = WORD LENGTH
- LR 1,JA R1 = IDIM
- MR 0,IA R1 = IDIM * IA
- LR JA,1 JA = IDIM * IA
- TFEQN 12,N,A,IA,JA,R,K,B,IA2,JA2,Z,I
- B RETURN
- FEQN99 DS 0H
- TMPRNT HFEQN,N,JA,K
- RETURN EPILOG
- MEND
-#include "tglobal.inc"
diff --git a/src/packlib/kernlib/kernnum/obsolete/f011ib/tfinv.inc b/src/packlib/kernlib/kernnum/obsolete/f011ib/tfinv.inc
deleted file mode 100644
index 80691ae..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f011ib/tfinv.inc
+++ /dev/null
@@ -1,63 +0,0 @@
-*
-* $Id: tfinv.inc,v 1.1.1.1 1996/02/15 17:48:29 mclareni Exp $
-*
-* $Log: tfinv.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:29 mclareni
-* Kernlib
-*
-*
-*
-* tfinv.inc
-*
-#include "basic.inc"
-#include "xch.inc"
-#include "mpy.inc"
-#include "scl.inc"
-#include "msubst.inc"
-#include "finv.inc"
-#include "tmprnt.inc"
- MACRO
- MAIN
-#include "global.inc"
- &TWORDS SETA 7
- SETYPE
- HEADER ENTRY
- JA2 EQU 2
- I EQU 3
- N EQU 4
- A EQU 5
- JA EQU 6
- R EQU 7
- X EQU 8
- Y EQU 9
- IA EQU 10
- Z EQU 11
- IA2 EQU 12
- ®LIM SETA 12
- HFINV DS 0F
- DC C' &T.FINV '
- ENTRY PROLOG
- LM 4,7,0(1)
- * R4 = (N)
- * R5 = (A)
- * R6 = (IDIM)
- * R7 = (R) AND TAG IN BIT 0
- N 7,=X'7FFFFFFF'
- L N,0(4)
- L JA,0(6) JA = IDIM
- * IF(N .LE. 0 .OR. IDIM .LT. N) GOTO 99
- C N,=F'0'
- BC LE,FINV99 IF N .LE. 0
- CR JA,N
- BC LT,FINV99 IF IDIM .LT. N
- LA IA,&LENGTH IA = WORD LENGTH
- LR 1,JA R1 = IDIM
- MR 0,IA R1 = IDIM * IA
- LR JA,1 JA = IDIM * IA
- TFINV 12,N,A,IA,JA,R,IA2,JA2,X,Y,Z,I
- B RETURN
- FINV99 DS 0H
- TMPRNT HFINV,N,JA,0
- RETURN EPILOG
- MEND
-#include "tglobal.inc"
diff --git a/src/packlib/kernlib/kernnum/obsolete/f012cd/dseqn.s b/src/packlib/kernlib/kernnum/obsolete/f012cd/dseqn.s
deleted file mode 100644
index 1828a44..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f012cd/dseqn.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: dseqn.s,v 1.1.1.1 1996/02/15 17:48:13 mclareni Exp $
-*
-* $Log: dseqn.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:13 mclareni
-* Kernlib
-*
-*
- IDENT DSEQN
-#include "seqn.inc"
- MAIN DTYPE,B1,B2,B3,B4,B5,B6,B7
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f012cd/dsfact.s b/src/packlib/kernlib/kernnum/obsolete/f012cd/dsfact.s
deleted file mode 100644
index f6388a3..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f012cd/dsfact.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: dsfact.s,v 1.1.1.1 1996/02/15 17:48:13 mclareni Exp $
-*
-* $Log: dsfact.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:13 mclareni
-* Kernlib
-*
-*
- IDENT DSFACT
-#include "sfact.inc"
- MAIN DTYPE,B1,B2,B3,B4,B5,B6,B7
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f012cd/dsfeqn.s b/src/packlib/kernlib/kernnum/obsolete/f012cd/dsfeqn.s
deleted file mode 100644
index 71ebf5c..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f012cd/dsfeqn.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: dsfeqn.s,v 1.1.1.1 1996/02/15 17:48:13 mclareni Exp $
-*
-* $Log: dsfeqn.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:13 mclareni
-* Kernlib
-*
-*
- IDENT DSFEQN
-#include "sfeqn.inc"
- MAIN DTYPE,B1,B2,B3,B4,B5,B6,B7
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f012cd/dsfinv.s b/src/packlib/kernlib/kernnum/obsolete/f012cd/dsfinv.s
deleted file mode 100644
index b7a55ec..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f012cd/dsfinv.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: dsfinv.s,v 1.1.1.1 1996/02/15 17:48:13 mclareni Exp $
-*
-* $Log: dsfinv.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:13 mclareni
-* Kernlib
-*
-*
- IDENT DSFINV
-#include "sfinv.inc"
- MAIN DTYPE,B1,B2,B3,B4,B5,B6,B7
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f012cd/dsinv.s b/src/packlib/kernlib/kernnum/obsolete/f012cd/dsinv.s
deleted file mode 100644
index 524f0e3..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f012cd/dsinv.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: dsinv.s,v 1.1.1.1 1996/02/15 17:48:13 mclareni Exp $
-*
-* $Log: dsinv.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:13 mclareni
-* Kernlib
-*
-*
- IDENT DSINV
-#include "sinv.inc"
- MAIN DTYPE,B1,B2,B3,B4,B5,B6,B7
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f012cd/rseqn.s b/src/packlib/kernlib/kernnum/obsolete/f012cd/rseqn.s
deleted file mode 100644
index 23b5a7f..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f012cd/rseqn.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: rseqn.s,v 1.1.1.1 1996/02/15 17:48:13 mclareni Exp $
-*
-* $Log: rseqn.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:13 mclareni
-* Kernlib
-*
-*
- IDENT RSEQN
-#include "seqn.inc"
- MAIN RTYPE,B1,B2,B3,B4,B5,B6,B7
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f012cd/rsfact.s b/src/packlib/kernlib/kernnum/obsolete/f012cd/rsfact.s
deleted file mode 100644
index e2e2c59..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f012cd/rsfact.s
+++ /dev/null
@@ -1,14 +0,0 @@
-*
-* $Id: rsfact.s,v 1.1.1.1 1996/02/15 17:48:13 mclareni Exp $
-*
-* $Log: rsfact.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:13 mclareni
-* Kernlib
-*
-*
-*ADDFILE
-*DECK F012CDC
- IDENT RSFACT
-#include "sfact.inc"
- MAIN RTYPE,B1,B2,B3,B4,B5,B6,B7
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f012cd/rsfeqn.s b/src/packlib/kernlib/kernnum/obsolete/f012cd/rsfeqn.s
deleted file mode 100644
index 5c8b5ac..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f012cd/rsfeqn.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: rsfeqn.s,v 1.1.1.1 1996/02/15 17:48:13 mclareni Exp $
-*
-* $Log: rsfeqn.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:13 mclareni
-* Kernlib
-*
-*
- IDENT RSFEQN
-#include "sfeqn.inc"
- MAIN RTYPE,B1,B2,B3,B4,B5,B6,B7
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f012cd/rsfinv.s b/src/packlib/kernlib/kernnum/obsolete/f012cd/rsfinv.s
deleted file mode 100644
index fea9169..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f012cd/rsfinv.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: rsfinv.s,v 1.1.1.1 1996/02/15 17:48:13 mclareni Exp $
-*
-* $Log: rsfinv.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:13 mclareni
-* Kernlib
-*
-*
- IDENT RSFINV
-#include "sfinv.inc"
- MAIN RTYPE,B1,B2,B3,B4,B5,B6,B7
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f012cd/rsinv.s b/src/packlib/kernlib/kernnum/obsolete/f012cd/rsinv.s
deleted file mode 100644
index b9a1a9a..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f012cd/rsinv.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: rsinv.s,v 1.1.1.1 1996/02/15 17:48:13 mclareni Exp $
-*
-* $Log: rsinv.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:13 mclareni
-* Kernlib
-*
-*
- IDENT RSINV
-#include "sinv.inc"
- MAIN RTYPE,B1,B2,B3,B4,B5,B6,B7
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/f012cd/seqn.inc b/src/packlib/kernlib/kernnum/obsolete/f012cd/seqn.inc
deleted file mode 100644
index 99170fc..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f012cd/seqn.inc
+++ /dev/null
@@ -1,81 +0,0 @@
-*
-* $Id: seqn.inc,v 1.1.1.1 1996/02/15 17:48:13 mclareni Exp $
-*
-* $Log: seqn.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:13 mclareni
-* Kernlib
-*
-*
-*
-* seqn.inc
-*
-*CALL BASIC
-*CALL SFACT
-*CALL SCL
-*CALL MPY
-*CALL SCA
-*CALL FEQN
-*CALL TMPRNT
- MAIN MACRO TYPE,N,IA,JA,K,B,I,J
- SETYPE TYPE
- GNAME MICRO 1,,*EQN*
- NAME MICRO 1,,*"P"S"GNAME"*
- HEADER "NAME",SAVEA0
- LOCIFAIL BSS 1 (IFAIL)
- SAVEA BSS 1 (A)
- SAVEK BSS 1 K
- SAVEB BSS 1 (B)
- TEMP5 BSS 5
- EXIT "NAME" (N,A,IDIM,IFAIL,K,B)
- PROLOG ERROR,SAVEA,LOCIFAIL,SAVEK,SAVEB,N,JA,J X1=(A)
- TSFACT SAVEA,N,JA,TEMP5,K,B,IA,I,J X5=IFAIL
- SA2 SAVEK X2=K
- SA3 SAVEB X3=(B)
- SA1 SAVEA X1=(A)
- NZ X5,[1] IF NOT POSITIVE DEFINITE
- S_IA LENGTH IA=LENGTH
- S_K X2 LOAD K
- S_B X3 LOAD B
- SA0 X1 A0=(A)
- "P"FEQN N,A0,IA,JA,K,B,I,J
- SX5 B0 X5=IFAIL=0
- [1] SA2 LOCIFAIL X2=(IFAIL)
- BX6 X5 X6=IFAIL
- SA6 X2 STORE IFAIL
- EPILOG
- HMPRNT VFD 60/10H_"P"S_"GNAME"
- ERROR TMPRNT HMPRNT,X0,X4,X3
- ENDM
- PROLOG MACRO ERROR,SAVEA,LOCIFAIL,SAVEK,SAVEB,NN,JA,ONE X1=(A)
- BSS 0 X1=(N) A1=((N))
- SA2 A1+2 X2=(IDIM) A2=((IDIM))
- S_ONE 1 ONE=1
- SA4 X1 X4=N A4=(N)
- SA1 A1+ONE X1=(A) A1=((A))
- SX7 A0 X7=OLD A0
- NO
- SA3 A2+2 X3=(K) A3=((K))
- SA7 SAVEA0 SAVEA0=OLD A0
- SA5 A3+ONE X5=(B) A5=((B))
- S_NN X4 NN=N
- SA4 X2 X4=IDIM A4=(IDIM)
- SX0 NN X0=N
- SA3 X3 X3=K A3=(K)
- SA2 A2+ONE X2=(IFAIL) A2=((IFAIL))
- LT NN,ONE,ERROR IF N<1
- S_JA X4 JA=IDIM
- NO
- LT JA,NN,ERROR IF IDIM<N
- BX6 X1 X6=(A)
- BX7 X5 X7=(B)
- SA6 SAVEA SAVEA=(A)
- SA7 SAVEB SAVEB=(B)
- MI X3,ERROR IF K<0
- BX6 X2 X6=(IFAIL)
- BX7 X3 X7=K
- SA6 LOCIFAIL LOCIFAIL=((IFAIL))
- SA7 SAVEK SAVEK=K
- TAU IFEQ LENGTH,2
- S_JA JA+JA JA=LENGTH*IDIM
- TAU ENDIF
- PROLOG ENDM
diff --git a/src/packlib/kernlib/kernnum/obsolete/f012cd/sfact.inc b/src/packlib/kernlib/kernnum/obsolete/f012cd/sfact.inc
deleted file mode 100644
index 2f126ff..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f012cd/sfact.inc
+++ /dev/null
@@ -1,72 +0,0 @@
-*
-* $Id: sfact.inc,v 1.1.1.1 1996/02/15 17:48:12 mclareni Exp $
-*
-* $Log: sfact.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:12 mclareni
-* Kernlib
-*
-*
-*
-* sfact.inc
-*
-*CALL BASIC
-*CALL SFACT
-*CALL DET
-*CALL SCL
-*CALL MPY
-*CALL SCA
-*CALL TMPRNT
- MAIN MACRO TYPE,N,JA,A1K,AKK,I,J,K
- SETYPE TYPE
- GNAME MICRO 1,,*FACT*
- NAME MICRO 1,,*"P"S"GNAME"*
- HEADER "NAME",SAVEA0
- ARGLIST BSS 1 ((IFAIL))
- SAVEA BSS 1 (A)
- TEMP6L BSS 6
- BSS LENGTH DET
- EXIT "NAME" (N,A,IDIM,IFAIL,DET,JFAIL)
- PROLOG ERROR,SAVEA,ARGLIST,N,JA,J X1=(A)
- TSFACTD SAVEA,N,JA,TEMP6L,A1K,AKK,I,J,K X5=IFAIL
-* X6,X7=DET
-* X0=JFAIL
- SA2 ARGLIST X2=((IFAIL))
- SA4 X2+1 X4=(DET) A4=((DET))
- SA1 X2 X1=(IFAIL) A1=((IFAIL))
- SA2 X2+2 X2=(JFAIL) A2=((JFAIL))
- SA6 X4 STORE DET
- TAU IFEQ LENGTH,2
- SA7 X4+1
- TAU ENDIF
- BX6 X5 X6=IFAIL
- BX7 X0 X7=JFAIL
- SA6 X1 STORE IFAIL
- SA7 X2 STORE JFAIL
- EPILOG
- HMPRNT VFD 60/10H_"P"S_"GNAME"
- ERROR TMPRNT HMPRNT,X0,X4,X3
- ENDM
- PROLOG MACRO ERROR,SAVEA,ARGLIST,NN,JA,ONE X1=(A)
- BSS 0 X1=(N) A1=((N))
- SA2 A1+2 X2=(IDIM) A2=((IDIM))
- S_ONE 1 ONE=1
- SA4 X1 X4=N A4=(N)
- SA1 A1+ONE X1=(A) A1=((A))
- SX7 A0 X7=OLD A0
- NO
- SA7 SAVEA0 SAVEA0=OLD A0
- S_NN X4 NN=N
- SA4 X2 X4=IDIM A4=(IDIM)
- SX0 NN X0=N
- LT NN,ONE,ERROR IF N<1
- S_JA X4 JA=IDIM
- NO
- LT JA,NN,ERROR IF IDIM<N
- BX6 X1 X6=(A)
- SA6 SAVEA SAVEA=(A)
- SX6 A2+ONE X6=((IFAIL))
- SA6 ARGLIST ARGLIST=((IFAIL))
- TAU IFEQ LENGTH,2
- S_JA JA+JA JA=LENGTH*IDIM
- TAU ENDIF
- PROLOG ENDM
diff --git a/src/packlib/kernlib/kernnum/obsolete/f012cd/sfeqn.inc b/src/packlib/kernlib/kernnum/obsolete/f012cd/sfeqn.inc
deleted file mode 100644
index 6e11fa5..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f012cd/sfeqn.inc
+++ /dev/null
@@ -1,57 +0,0 @@
-*
-* $Id: sfeqn.inc,v 1.1.1.1 1996/02/15 17:48:13 mclareni Exp $
-*
-* $Log: sfeqn.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:13 mclareni
-* Kernlib
-*
-*
-*
-* sfeqn.inc
-*
-*CALL BASIC
-*CALL FEQN
-*CALL MPY
-*CALL TMPRNT
- MAIN MACRO TYPE,N,IA,JA,K,B,I,J
- SETYPE TYPE
- GNAME MICRO 1,,*FEQN*
- NAME MICRO 1,,*"P"S"GNAME"*
- HEADER "NAME",SAVEA0
- SAVEA BSS 1 (A)
- EXIT "NAME" (N,A,IDIM,K,B)
- PROLOG ERROR,SAVEA,N,JA,K,B,J X1=(A)
- S_IA LENGTH IA=LENGTH
- SA0 X1 A0=(A)
- "P"FEQN N,A0,IA,JA,K,B,I,J
- EPILOG
- HMPRNT VFD 60/10H_"P"S_"GNAME"
- ERROR TMPRNT HMPRNT,X0,X4,X3
- ENDM
- PROLOG MACRO ERROR,SAVEA,NN,JA,KK,B,ONE X1=(A)
- BSS 0 X1=(N) A1=((N))
- SA2 A1+2 X2=(IDIM) A2=((IDIM))
- S_ONE 1 ONE=1
- SA4 X1 X4=N A4=(N)
- SA1 A1+ONE X1=(A) A1=((A))
- SX7 A0 X7=OLD A0
- SA3 A2+ONE X3=(K) A3=((K))
- SA7 SAVEA0 SAVEA0=OLD A0
- SA5 A3+ONE X5=(B) A5=((B))
- S_NN X4 NN=N
- SA4 X2 X4=IDIM A4=(IDIM)
- SX0 NN X0=N
- SA3 X3 X3=K A3=(K)
- LT NN,ONE,ERROR IF N<1
- S_JA X4 JA=IDIM
- NO
- LT JA,NN,ERROR IF IDIM<N
- BX6 X1 X6=(A)
- S_B X5 B=(B)
- S_KK X3 KK=K
- SA6 SAVEA SAVEA=(A)
- LT KK,ONE,ERROR IF K<1
- TAU IFEQ LENGTH,2
- S_JA JA+JA JA=LENGTH*IDIM
- TAU ENDIF
- PROLOG ENDM
diff --git a/src/packlib/kernlib/kernnum/obsolete/f012cd/sfinv.inc b/src/packlib/kernlib/kernnum/obsolete/f012cd/sfinv.inc
deleted file mode 100644
index 3451c26..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f012cd/sfinv.inc
+++ /dev/null
@@ -1,53 +0,0 @@
-*
-* $Id: sfinv.inc,v 1.1.1.1 1996/02/15 17:48:13 mclareni Exp $
-*
-* $Log: sfinv.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:13 mclareni
-* Kernlib
-*
-*
-*
-* sfinv.inc
-*
-*CALL BASIC
-*CALL SFINV
-*CALL UTL
-*CALL CPY
-*CALL MPY
-*CALL SCL
-*CALL TMPRNT
- MAIN MACRO TYPE,N,IA,JA,I,J,K,L
- SETYPE TYPE
- GNAME MICRO 1,,*FINV*
- NAME MICRO 1,,*"P"S"GNAME"*
- HEADER "NAME",SAVEA0
- SAVEA BSS 1 (A)
- TEMP4 BSS 4
- EXIT "NAME" (N,A,IDIM)
- PROLOG ERROR,SAVEA,N,JA,J X1=(A)
- TSFINV TYPE,SAVEA,N,JA,TEMP4,IA,I,J,K,L X1=(A)
- EPILOG
- HMPRNT VFD 60/10H_"P"S_"GNAME"
- ERROR TMPRNT HMPRNT,X0,X4,B0
- ENDM
- PROLOG MACRO ERROR,SAVEA,NN,JA,ONE X1=(A)
- BSS 0 X1=(N) A1=((N))
- SA2 A1+2 X2=(IDIM) A2=((IDIM))
- S_ONE 1 ONE=1
- SA4 X1 X4=N A4=(N)
- SA1 A1+ONE X1=(A) A1=((A))
- SX7 A0 X7=OLD A0
- NO
- SA7 SAVEA0 SAVEA0=OLD A0
- S_NN X4 NN=N
- SA4 X2 X4=IDIM A4=(IDIM)
- SX0 NN X0=N
- LT NN,ONE,ERROR IF N<1
- S_JA X4 JA=IDIM
- LT JA,NN,ERROR IF IDIM<N
- BX6 X1 X6=(A)
- SA6 SAVEA SAVEA=(A)
- TAU IFEQ LENGTH,2
- S_JA JA+JA JA=LENGTH*IDIM
- TAU ENDIF
- PROLOG ENDM
diff --git a/src/packlib/kernlib/kernnum/obsolete/f012cd/sinv.inc b/src/packlib/kernlib/kernnum/obsolete/f012cd/sinv.inc
deleted file mode 100644
index 6acc967..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f012cd/sinv.inc
+++ /dev/null
@@ -1,67 +0,0 @@
-*
-* $Id: sinv.inc,v 1.1.1.1 1996/02/15 17:48:13 mclareni Exp $
-*
-* $Log: sinv.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:13 mclareni
-* Kernlib
-*
-*
-*
-* sinv.inc
-*
-*CALL BASIC
-*CALL SFACT
-*CALL SCL
-*CALL MPY
-*CALL SCA
-*CALL SFINV
-*CALL UTL
-*CALL CPY
-*CALL TMPRNT
- MAIN MACRO TYPE,N,IA,JA,I,J,K,L
- SETYPE TYPE
- GNAME MICRO 1,,*INV*
- NAME MICRO 1,,*"P"S"GNAME"*
- HEADER "NAME",SAVEA0
- LOCIFAIL BSS 1 (IFAIL)
- SAVEA BSS 1 (A)
- TEMP5 BSS 5
- EXIT "NAME" (N,A,IDIM,IFAIL)
- PROLOG ERROR,SAVEA,LOCIFAIL,N,JA,J X1=(A)
- TSFACT SAVEA,N,JA,TEMP5,IA,I,J,K,L X5=IFAIL
- SA1 SAVEA X1=(A)
- NZ X5,[1] IF NOT POSITIVE DEFINITE
- TSFINV TYPE,SAVEA,N,JA,TEMP5,IA,I,J,K,L X1=(A)
- SX5 B0 X5=IFAIL=0
- [1] SA2 LOCIFAIL X2=(IFAIL)
- BX6 X5 X6=IFAIL
- SA6 X2 STORE IFAIL
- EPILOG
- HMPRNT VFD 60/10H_"P"S_"GNAME"
- ERROR TMPRNT HMPRNT,X0,X4,B0
- ENDM
- PROLOG MACRO ERROR,SAVEA,LOCIFAIL,NN,JA,ONE X1=(A)
- BSS 0 X1=(N) A1=((N))
- SA2 A1+2 X2=(IDIM) A2=((IDIM))
- S_ONE 1 ONE=1
- SA4 X1 X4=N A4=(N)
- SA1 A1+ONE X1=(A) A1=((A))
- SX7 A0 X7=OLD A0
- NO
- SA7 SAVEA0 SAVEA0=OLD A0
- S_NN X4 NN=N
- SA4 X2 X4=IDIM A4=(IDIM)
- SX0 NN X0=N
- SA2 A2+ONE X2=(IFAIL) A2=((IFAIL))
- LT NN,ONE,ERROR IF N<1
- S_JA X4 JA=IDIM
- NO
- LT JA,NN,ERROR IF IDIM<N
- BX6 X1 X6=(A)
- SA6 SAVEA SAVEA=(A)
- BX6 X2 X6=(IFAIL)
- SA6 LOCIFAIL LOCIFAIL=((IFAIL))
- TAU IFEQ LENGTH,2
- S_JA JA+JA JA=LENGTH*IDIM
- TAU ENDIF
- PROLOG ENDM
diff --git a/src/packlib/kernlib/kernnum/obsolete/f012ib/Imakefile b/src/packlib/kernlib/kernnum/obsolete/f012ib/Imakefile
deleted file mode 100644
index a5592c2..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f012ib/Imakefile
+++ /dev/null
@@ -1,5 +0,0 @@
-SRCS_S= \ @@\
- dseqn.s dsfact.s dsfeqn.s dsfinv.s dsinv.s rseqn.s rsfact.s \ @@\
- rsfeqn.s rsfinv.s rsinv.s
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kernnum/obsolete/f012ib/dseqn.s b/src/packlib/kernlib/kernnum/obsolete/f012ib/dseqn.s
deleted file mode 100644
index dacba03..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f012ib/dseqn.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: dseqn.s,v 1.1.1.1 1996/02/15 17:48:30 mclareni Exp $
-*
-* $Log: dseqn.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:30 mclareni
-* Kernlib
-*
-*
-#include "kernnum/tseqn.inc"
- &TYPE SETA &DTYPE
- &NAME SETC 'SEQN '
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f012ib/dsfact.s b/src/packlib/kernlib/kernnum/obsolete/f012ib/dsfact.s
deleted file mode 100644
index e7250ef..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f012ib/dsfact.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: dsfact.s,v 1.1.1.1 1996/02/15 17:48:30 mclareni Exp $
-*
-* $Log: dsfact.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:30 mclareni
-* Kernlib
-*
-*
-#include "kernnum/tsfact.inc"
- &TYPE SETA &DTYPE
- &NAME SETC 'SFACT'
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f012ib/dsfeqn.s b/src/packlib/kernlib/kernnum/obsolete/f012ib/dsfeqn.s
deleted file mode 100644
index 9abea73..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f012ib/dsfeqn.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: dsfeqn.s,v 1.1.1.1 1996/02/15 17:48:30 mclareni Exp $
-*
-* $Log: dsfeqn.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:30 mclareni
-* Kernlib
-*
-*
-#include "kernnum/tsfeqn.inc"
- &TYPE SETA &DTYPE
- &NAME SETC 'SFEQN'
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f012ib/dsfinv.s b/src/packlib/kernlib/kernnum/obsolete/f012ib/dsfinv.s
deleted file mode 100644
index 4624e2e..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f012ib/dsfinv.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: dsfinv.s,v 1.1.1.1 1996/02/15 17:48:30 mclareni Exp $
-*
-* $Log: dsfinv.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:30 mclareni
-* Kernlib
-*
-*
-#include "kernnum/tsfinv.inc"
- &TYPE SETA &DTYPE
- &NAME SETC 'SFINV'
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f012ib/dsinv.s b/src/packlib/kernlib/kernnum/obsolete/f012ib/dsinv.s
deleted file mode 100644
index a836c7f..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f012ib/dsinv.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: dsinv.s,v 1.1.1.1 1996/02/15 17:48:30 mclareni Exp $
-*
-* $Log: dsinv.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:30 mclareni
-* Kernlib
-*
-*
-#include "kernnum/tsinv.inc"
- &TYPE SETA &DTYPE
- &NAME SETC 'SINV '
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f012ib/rseqn.s b/src/packlib/kernlib/kernnum/obsolete/f012ib/rseqn.s
deleted file mode 100644
index eb2f768..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f012ib/rseqn.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: rseqn.s,v 1.1.1.1 1996/02/15 17:48:30 mclareni Exp $
-*
-* $Log: rseqn.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:30 mclareni
-* Kernlib
-*
-*
-#include "kernnum/tseqn.inc"
- &TYPE SETA &RTYPE
- &NAME SETC 'SEQN '
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f012ib/rsfact.s b/src/packlib/kernlib/kernnum/obsolete/f012ib/rsfact.s
deleted file mode 100644
index 8606a8f..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f012ib/rsfact.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: rsfact.s,v 1.1.1.1 1996/02/15 17:48:30 mclareni Exp $
-*
-* $Log: rsfact.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:30 mclareni
-* Kernlib
-*
-*
-#include "kernnum/tsfact.inc"
- &TYPE SETA &RTYPE
- &NAME SETC 'SFACT'
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f012ib/rsfeqn.s b/src/packlib/kernlib/kernnum/obsolete/f012ib/rsfeqn.s
deleted file mode 100644
index bc60ce5..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f012ib/rsfeqn.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: rsfeqn.s,v 1.1.1.1 1996/02/15 17:48:30 mclareni Exp $
-*
-* $Log: rsfeqn.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:30 mclareni
-* Kernlib
-*
-*
-#include "kernnum/tsfeqn.inc"
- &TYPE SETA &RTYPE
- &NAME SETC 'SFEQN'
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f012ib/rsfinv.s b/src/packlib/kernlib/kernnum/obsolete/f012ib/rsfinv.s
deleted file mode 100644
index c2f8e8a..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f012ib/rsfinv.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: rsfinv.s,v 1.1.1.1 1996/02/15 17:48:30 mclareni Exp $
-*
-* $Log: rsfinv.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:30 mclareni
-* Kernlib
-*
-*
-#include "kernnum/tsfinv.inc"
- &TYPE SETA &RTYPE
- &NAME SETC 'SFINV'
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f012ib/rsinv.s b/src/packlib/kernlib/kernnum/obsolete/f012ib/rsinv.s
deleted file mode 100644
index cea9050..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f012ib/rsinv.s
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: rsinv.s,v 1.1.1.1 1996/02/15 17:48:30 mclareni Exp $
-*
-* $Log: rsinv.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:30 mclareni
-* Kernlib
-*
-*
-#include "kernnum/tsinv.inc"
- &TYPE SETA &RTYPE
- &NAME SETC 'SINV '
- MAIN
diff --git a/src/packlib/kernlib/kernnum/obsolete/f012ib/tseqn.inc b/src/packlib/kernlib/kernnum/obsolete/f012ib/tseqn.inc
deleted file mode 100644
index a05fd09..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f012ib/tseqn.inc
+++ /dev/null
@@ -1,78 +0,0 @@
-*
-* $Id: tseqn.inc,v 1.1.1.1 1996/02/15 17:48:30 mclareni Exp $
-*
-* $Log: tseqn.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:30 mclareni
-* Kernlib
-*
-*
-*
-* tseqn.inc
-*
-#include "basic.inc"
-#include "mpy.inc"
-#include "scl.inc"
-#include "sfact.inc"
-#include "feqn.inc"
-#include "tmprnt.inc"
- MACRO
- MAIN
-#include "global.inc"
- &TWORDS SETA 9
- SETYPE
- HEADER ENTRY (N,A,IDIM,IFAIL,K,B)
- IA EQU 2
- I EQU 3
- N EQU 4
- A EQU 5
- JA EQU 6
- L EQU 7
- K EQU 8
- B EQU 9
- JA2 EQU 10
- X EQU 11
- Y EQU 12
- ®LIM SETA 12
- HSEQN DS 0F
- DC C'&T.SEQN '
- LOCOUT DS 3F (IFAIL) (K) (B)
- ENTRY PROLOG
- LM 4,9,0(1)
- * R4 = (N)
- * R5 = (A)
- * R6 = (IDIM)
- * R7 = (IFAIL)
- * R8 = (K)
- * R9 = (B)
- N 9,=X'7FFFFFFF'
- STM 7,9,LOCOUT
- L N,0(4) R4 = N
- L JA,0(6) JA = IDIM
- L K,0(8) R8 = K
- * IF(N.LE.0 .OR. IDIM.LT.N .OR. K.LE.0) GOTO 99
- C N,=F'0'
- BC LE,SEQN99 IF N .LE. 0
- CR JA,N
- BC LT,SEQN99 IF IDIM .LT. N
- C K,=F'0'
- BC LE,SEQN99 IF K .LE. 0
- LA IA,&LENGTH IA = WORD LENGTH
- LR 1,JA R1 = IDIM
- MR 0,IA R1 = IDIM * IA
- LR JA,1 JA = IDIM * IA
- TSFACT N,A,IA,JA,X,Y,I,B,L
- LM 7,9,LOCOUT
- * R7 = (IFAIL)
- * R8 = (K)
- * R9 = (B)
- ST I,0(7) STORE IFAIL
- L K,0(8) R8 = K
- C I,=F'0'
- BC NE,RETURN IF IFAIL .NE. 0
- TFEQN1 N,A,IA,JA,K,B,X,JA2,Y,I
- B RETURN
- SEQN99 DS 0H
- TMPRNT HSEQN,N,JA,K
- RETURN EPILOG
- MEND
-#include "tglobal.inc"
diff --git a/src/packlib/kernlib/kernnum/obsolete/f012ib/tsfact.inc b/src/packlib/kernlib/kernnum/obsolete/f012ib/tsfact.inc
deleted file mode 100644
index f4ce249..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f012ib/tsfact.inc
+++ /dev/null
@@ -1,74 +0,0 @@
-*
-* $Id: tsfact.inc,v 1.1.1.1 1996/02/15 17:48:30 mclareni Exp $
-*
-* $Log: tsfact.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:30 mclareni
-* Kernlib
-*
-*
-*
-* tsfact.inc
-*
-#include "basic.inc"
-#include "mpy.inc"
-#include "scl.inc"
-#include "sfact.inc"
-#include "det.inc"
-#include "tmprnt.inc"
- MACRO
- MAIN
-#include "global.inc"
- &TWORDS SETA 9
- SETYPE
- HEADER ENTRY (N,A,IDIM,IFAIL,DET,JFAIL)
- J EQU 2 (DIFFERS FROM 7 - 9)
- I EQU 3 (DIFFERS FROM 7 - 9)
- N EQU 4
- A EQU 5
- JA EQU 6
- L EQU 7
- IA EQU 8
- X EQU 9
- Y EQU 10
- ®LIM SETA 10
- HSFACT DS 0F
- DC C'&T.SFACT '
- LOCOUT DS 3F (IFAIL), (DET), (JFAIL)
- ENTRY PROLOG
- LM 4,9,0(1)
- * R4 = (N)
- * R5 = (A)
- * R6 = (IDIM)
- * R7 = (IFAIL)
- * R8 = (DET)
- * R9 = (JFAIL)
- N 9,=X'7FFFFFFF'
- STM 7,9,LOCOUT
- L N,0(4) R4 = N
- L JA,0(6) JA = IDIM
- * IF(N.LE.0 .OR. IDIM.LT.N) GOTO 99
- C N,=F'0'
- BC LE,SFACT99 IF N .LE. 0
- CR JA,N
- BC LT,SFACT99 IF IDIM .LT. N
- LA IA,&LENGTH IA = WORD LENGTH
- LR 1,JA R1 = IDIM
- MR 0,IA R1 = IDIM * IA
- LR JA,1 JA = IDIM * IA
- TSFACTD N,A,IA,JA,X,Y,I,J,L
- * F0,F2 = DET
- * I = IFAIL
- * J = JFAIL
- LM 7,9,LOCOUT
- * R7 = (IFAIL)
- * R8 = (DET)
- * R9 = (JFAIL)
- ST I,0(7) STORE IFAIL
- STORE 0,8 STORE DET
- ST J,0(9) STORE JFAIL
- B RETURN
- SFACT99 DS 0H
- TMPRNT HSFACT,N,JA,0
- RETURN EPILOG
- MEND
-#include "tglobal.inc"
diff --git a/src/packlib/kernlib/kernnum/obsolete/f012ib/tsfeqn.inc b/src/packlib/kernlib/kernnum/obsolete/f012ib/tsfeqn.inc
deleted file mode 100644
index af1c6ed..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f012ib/tsfeqn.inc
+++ /dev/null
@@ -1,63 +0,0 @@
-*
-* $Id: tsfeqn.inc,v 1.1.1.1 1996/02/15 17:48:30 mclareni Exp $
-*
-* $Log: tsfeqn.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:30 mclareni
-* Kernlib
-*
-*
-*
-* tsfeqn.inc
-*
-#include "basic.inc"
-#include "mpy.inc"
-#include "feqn.inc"
-#include "tmprnt.inc"
- MACRO
- MAIN
-#include "global.inc"
- &TWORDS SETA 5
- SETYPE
- HEADER ENTRY (N,A,IDIM,K,B)
- JA2 EQU 2
- I EQU 3
- N EQU 4
- A EQU 5
- JA EQU 6
- K EQU 7
- B EQU 8
- Z EQU 9
- IA EQU 10
- IA2 EQU 11
- ®LIM SETA 11
- HSFEQN DS 0F
- DC C'&T.SFEQN '
- ENTRY PROLOG
- LM 4,8,0(1)
- * R4 = (N)
- * R5 = (A)
- * R6 = (IDIM)
- * R7 = (K)
- * R8 = (B)
- N 8,=X'7FFFFFFF'
- L N,0(4) R4 = N
- L JA,0(6) JA = IDIM
- L K,0(7) R7 = K
- * IF(N.LE.0 .OR. IDIM.LT.N .OR. K.LE.0) GOTO 99
- C N,=F'0'
- BC LE,SFEQN99 IF N .LE. 0
- CR JA,N
- BC LT,SFEQN99 IF IDIM .LT. N
- C K,=F'0'
- BC LE,SFEQN99 IF K .LE. 0
- LA IA,&LENGTH IA = WORD LENGTH
- LR 1,JA R1 = IDIM
- MR 0,IA R1 = IDIM * IA
- LR JA,1 JA = IDIM * IA
- TFEQN1 N,A,IA,JA,K,B,IA2,JA2,Z,I
- B RETURN
- SFEQN99 DS 0H
- TMPRNT HSFEQN,N,JA,K
- RETURN EPILOG
- MEND
-#include "tglobal.inc"
diff --git a/src/packlib/kernlib/kernnum/obsolete/f012ib/tsfinv.inc b/src/packlib/kernlib/kernnum/obsolete/f012ib/tsfinv.inc
deleted file mode 100644
index dced309..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f012ib/tsfinv.inc
+++ /dev/null
@@ -1,64 +0,0 @@
-*
-* $Id: tsfinv.inc,v 1.1.1.1 1996/02/15 17:48:30 mclareni Exp $
-*
-* $Log: tsfinv.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:30 mclareni
-* Kernlib
-*
-*
-*
-* tsfinv.inc
-*
-#include "basic.inc"
-#include "mpy.inc"
-#include "scl.inc"
-#include "cpy.inc"
-#include "utl.inc"
-#include "sfinv.inc"
-#include "tmprnt.inc"
- MACRO
- MAIN
-#include "global.inc"
- &TWORDS SETA 6
- SETYPE
- HEADER ENTRY (N,A,IDIM)
- K EQU 2
- I EQU 3
- N EQU 4
- A EQU 5
- JA EQU 6
- Z EQU 7
- X EQU 8
- Y EQU 9
- IA EQU 10
- IA2 EQU 11
- JA2 EQU 12
- ®LIM SETA 12
- HSFINV DS 0F
- DC C'&T.SFINV '
- ENTRY PROLOG
- LM 4,6,0(1)
- * R4 = (N)
- * R5 = (A)
- * R6 = (IDIM)
- N 6,=X'7FFFFFFF'
- L N,0(4) R4 = N
- L JA,0(6) JA = IDIM
- * IF(N .LE. 0 .OR. IDIM .LT. N) GOTO 99
- CR JA,N
- BC LT,SFINV99 IF IDIM .LT. N
- C N,=F'1'
- BC LT,SFINV99 IF N .LT. 1
- * IF(N .EQ. 1) RETURN
- BC EQ,RETURN IF(N .EQ. 1) RETURN
- LA IA,&LENGTH IA = WORD LENGTH
- LR 1,JA R1 = IDIM
- MR 0,IA R1 = IDIM * IA
- LR JA,1 JA = IDIM * IA
- TSFINV N,A,IA,JA,IA2,JA2,X,Y,Z,I,K
- B RETURN
- SFINV99 DS 0H
- TMPRNT HSFINV,N,JA,0
- RETURN EPILOG
- MEND
-#include "tglobal.inc"
diff --git a/src/packlib/kernlib/kernnum/obsolete/f012ib/tsinv.inc b/src/packlib/kernlib/kernnum/obsolete/f012ib/tsinv.inc
deleted file mode 100644
index 0197182..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/f012ib/tsinv.inc
+++ /dev/null
@@ -1,74 +0,0 @@
-*
-* $Id: tsinv.inc,v 1.1.1.1 1996/02/15 17:48:30 mclareni Exp $
-*
-* $Log: tsinv.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:30 mclareni
-* Kernlib
-*
-*
-*
-* tsinv.inc
-*
-#include "basic.inc"
-#include "mpy.inc"
-#include "scl.inc"
-#include "cpy.inc"
-#include "utl.inc"
-#include "sfact.inc"
-#include "sfinv.inc"
-#include "tmprnt.inc"
- MACRO
- MAIN
-#include "global.inc"
- &TWORDS SETA 9
- SETYPE
- HEADER ENTRY (N,A,IDIM,IFAIL)
- K EQU 2
- I EQU 3
- N EQU 4
- A EQU 5
- JA EQU 6
- Z EQU 7
- X EQU 8
- Y EQU 9
- IA EQU 10
- IA2 EQU 11
- JA2 EQU 12
- ®LIM SETA 12
- HSINV DS 0F
- DC C'&T.SINV '
- LOCOUT DS 1F (IFAIL)
- ENTRY PROLOG
- LM 4,7,0(1)
- * R4 = (N)
- * R5 = (A)
- * R6 = (IDIM)
- * R7 = (IFAIL)
- N 7,=X'7FFFFFFF'
- ST 7,LOCOUT
- L N,0(4) R4 = N
- L JA,0(6) JA = IDIM
- * IF(N .LE. 0 .OR. IDIM .LT. N) GOTO 99
- CR JA,N
- BC LT,SINV99 IF IDIM .LT. N
- C N,=F'1'
- BC LT,SINV99 IF N .LT. 1
- LA IA,&LENGTH IA = WORD LENGTH
- LR 1,JA R1 = IDIM
- MR 0,IA R1 = IDIM * IA
- LR JA,1 JA = IDIM * IA
- TSFACT N,A,IA,JA,X,Y,I,Z,K
- L K,LOCOUT K = (IFAIL)
- ST I,0(K) STORE IFAIL
- C I,=F'0'
- BC NE,RETURN IF IFAIL .NE. 0
- * IF(N .EQ. 1) RETURN
- C N,=F'1'
- BC EQ,RETURN IF(N .EQ. 1) RETURN
- TSFINV N,A,IA,JA,IA2,JA2,X,Y,Z,I,K
- B RETURN
- SINV99 DS 0H
- TMPRNT HSINV,N,JA,0
- RETURN EPILOG
- MEND
-#include "tglobal.inc"
diff --git a/src/packlib/kernlib/kernnum/obsolete/g100fort/Imakefile b/src/packlib/kernlib/kernnum/obsolete/g100fort/Imakefile
deleted file mode 100644
index 00b775b..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/g100fort/Imakefile
+++ /dev/null
@@ -1,6 +0,0 @@
-SRCS_F= prob.F
-
-FDEBUGFLAGS=NoOpFortranDebugFlags
-FORTRANSAVEOPTION=FortranSaveFlags
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kernnum/obsolete/g100fort/prob.F b/src/packlib/kernlib/kernnum/obsolete/g100fort/prob.F
deleted file mode 100644
index abecfc0..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/g100fort/prob.F
+++ /dev/null
@@ -1,99 +0,0 @@
-*
-* $Id: prob.F,v 1.1.1.1 1996/02/15 17:48:34 mclareni Exp $
-*
-* $Log: prob.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:34 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- FUNCTION PROB (CHI2,N)
-C AUTHOR C.LETERTRE, REVISED BY B.SCHORR, 23.10.81
-C
- LOGICAL MFLAG, RFLAG
-#if defined(CERNLIB_NUMHIPRE)
- DATA SRTOPI /0.79788456080287/
-#endif
-#if defined(CERNLIB_NUMLOPRE)
- DATA SRTOPI /0.7978846/
-#endif
-#if defined(CERNLIB_NUME2465)
- DATA UPL /11300./
-#endif
-#if defined(CERNLIB_NUME293)
- DATA UPL /1300./
-#endif
-#if defined(CERNLIB_NUME75)
- DATA UPL /340./
-#endif
-#if defined(CERNLIB_NUME38)
- DATA UPL /170./
-#endif
-#if defined(CERNLIB_NUME999)
- DATA ????? UPL NOT DEFINED ?????
-#endif
- PROB=0.
- IF(N .LE. 0) GO TO 91
- IF(CHI2 .LT. 0.) GO TO 92
- IF (N .GT. 100) GO TO 30
- IF (CHI2 .GT. UPL) RETURN
- EMYO2=EXP(-0.5*CHI2)
- SUM=1.
- TERM=1.
- M=N/2
- IF (2*M .NE. N) GO TO 1
-C-- ENTRY IF N IS EVEN
- IF (M .EQ. 1) GO TO 11
- DO 10 I=2,M
- FI=I-1
- TERM=0.5*TERM*CHI2/FI
- 10 SUM=SUM+TERM
- 11 PROB=EMYO2*SUM
- RETURN
-C-- ENTRY IF N IS ODD
- 1 SRTY=SQRT (CHI2)
- VALUE=2.*(1.-FREQ (SRTY))
- IF (N .NE. 1) GO TO 2
- PROB=VALUE
- RETURN
- 2 CONST=SRTOPI*SRTY*EMYO2
- IF (N .EQ. 3) GO TO 21
- K=M-1
- DO 20 I=1,K
- FI =I
- TERM=TERM*CHI2/(2.*FI+1.)
- 20 SUM=SUM+TERM
- 21 PROB=CONST*SUM+VALUE
- RETURN
-C-- USE ASYMPTOTIC FORMULA
- 30 ANU=1./FLOAT (N)
- AN9=ANU/4.5
- XP=1./3.
- Z=((CHI2*ANU)**XP - (1.-AN9)) / SQRT (AN9)
- PROB=1. - FREQ (Z)
- RETURN
-C
- 91 CALL KERMTR('G100.1',LGFILE,MFLAG,RFLAG)
- IF(MFLAG) THEN
- IF(LGFILE .EQ. 0) THEN
- WRITE(*,101) N
- ELSE
- WRITE(LGFILE,101) N
- ENDIF
- ENDIF
- IF(.NOT. RFLAG) CALL ABEND
- RETURN
-C
- 92 CALL KERMTR('G100.2',LGFILE,MFLAG,RFLAG)
- IF(MFLAG) THEN
- IF(LGFILE .EQ. 0) THEN
- WRITE(*,102) CHI2
- ELSE
- WRITE(LGFILE,102) CHI2
- ENDIF
- ENDIF
- IF(.NOT. RFLAG) CALL ABEND
- RETURN
- 101 FORMAT( 7X, 'FUNCTION PROB ... N =',I6,' IS LESS THAN 1')
- 102 FORMAT( 7X, 'FUNCTION PROB ... X =',E20.10,' IS LESS THAN 0.')
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/g900cd/dranf.s b/src/packlib/kernlib/kernnum/obsolete/g900cd/dranf.s
deleted file mode 100644
index db8a646..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/g900cd/dranf.s
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: dranf.s,v 1.1.1.1 1996/02/15 17:48:13 mclareni Exp $
-*
-* $Log: dranf.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:13 mclareni
-* Kernlib
-*
-*
-*ADDFILE
-*DECK G900CDC
- IDENT DRANF
-*CALL BASIC
- EXT RANDOM. ADDRESS OF CURRENT SEED
- NAME MICRO 1,,*DRANF*
- HEADER "NAME" A0 IS NEITHER USED NOR SAVED
- [1] DX7 X4*X5 X7=NEW SEED
- SX3 16404B 2**(-48) = 1640 4000 ... 0000B
- NO
- LX3 45 X3=2**(-48)
- NX6 X7 X6=DRANF'
- SA7 A4 STORE NEW SEED
- FX7 X6*X3 X7=DRANF''
- EXIT "NAME" DRANF(DUMMY)
- SA4 RANDOM. X4=OLD SEED
- SA5 A4+1 X5=MULT
- JP [1]
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/g900fort/dranf.F b/src/packlib/kernlib/kernnum/obsolete/g900fort/dranf.F
deleted file mode 100644
index 3c94c14..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/g900fort/dranf.F
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: dranf.F,v 1.1.1.1 1996/02/15 17:48:18 mclareni Exp $
-*
-* $Log: dranf.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:18 mclareni
-* Kernlib
-*
-*
-#include "kernnum/pilot.h"
- DOUBLE PRECISION FUNCTION DRANF()
- DOUBLE PRECISION VALUE
- REAL CONST, TEMP(2)
- EQUIVALENCE (VALUE,TEMP(1))
-#if defined(CERNLIB_NUMCD)
- DATA CONST / O"1640 4000 0000 0000 0000" /
-#endif
-#if defined(CERNLIB_NUMCR)
- DATA CONST / 7777 7777 7777 7777B /
-#endif
- TEMP(1) = RANF()
-#if defined(CERNLIB_NUMCD)
- TEMP(2) = TEMP(1)*CONST
-#endif
-#if defined(CERNLIB_NUMCR)
- TEMP(2) = TEMP(1) .AND. CONST
-#endif
- DRANF = VALUE
- RETURN
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/g900ib/Imakefile b/src/packlib/kernlib/kernnum/obsolete/g900ib/Imakefile
deleted file mode 100644
index c21ed31..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/g900ib/Imakefile
+++ /dev/null
@@ -1,4 +0,0 @@
-SRCS_S= \ @@\
- ranf.s ranget.s ranset.s
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kernnum/obsolete/g900ib/linkg900.inc b/src/packlib/kernlib/kernnum/obsolete/g900ib/linkg900.inc
deleted file mode 100644
index 3158164..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/g900ib/linkg900.inc
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: linkg900.inc,v 1.1.1.1 1996/02/15 17:48:31 mclareni Exp $
-*
-* $Log: linkg900.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:31 mclareni
-* Kernlib
-*
-*
-#ifndef CERNLIB_KERNNUM_LINKG900_INC
-#define CERNLIB_KERNNUM_LINKG900_INC
-*
-*
-* linkg900.inc
-*
- MACRO
- PROLOG ®LIM
- GBLC &NAME E.G. 'RANF '
- USING *,15
- B A&SYSNDX
- DC XL1'7',CL7'&NAME'
-A&SYSNDX DS 0H
- STM 14,®LIM,12(13)
- MEND
- MACRO
-&LABEL EXIT ®LIM
-&LABEL LM 14,®LIM,12(13) RESTORE REGISTERS
- MVI 12(13),255
- BR 14
- MEND
-
-#endif
diff --git a/src/packlib/kernlib/kernnum/obsolete/g900ib/ranf.s b/src/packlib/kernlib/kernnum/obsolete/g900ib/ranf.s
deleted file mode 100644
index a2b3811..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/g900ib/ranf.s
+++ /dev/null
@@ -1,71 +0,0 @@
-*
-* $Id: ranf.s,v 1.1.1.1 1996/02/15 17:48:31 mclareni Exp $
-*
-* $Log: ranf.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:31 mclareni
-* Kernlib
-*
-*
-#include "kernnum/linkg900.inc"
- MACRO
-&LABEL RANDATA
- DS 0D
-&LABEL DC X'402BC68CFE166D00' SEED = 0.2BC68CFE166D00
- DC X'4C2875A2E7B17500' MULT = 2875 A2E7 B175.00
- DC X'4E10000000000000' NORM = 10 0000 0000 0000.
- MEND
- MACRO
-&LABEL RANF &DATA
-&LABEL LD 0,&DATA F0 = 0.2BC68CFE166D00
- MXD 0,&DATA+8 F0 = 123456789ABC.DE
-* F2 = .(00)123456789A0000 (EXP=-2)
- LD 4,&DATA+16 F4 = 10 0000 0000 0000. (EXP=14)
- LD 6,=D'0' F6 = 0
- AXR 0,4 F0 = 10 1234 5678 9ABC.
-* F2 = .DE 1234 5678 9A00
- STD 2,&DATA SEED = .DE 1234 5678 9A00
- LDR 0,2 F0 = NEW SEED (NOT NORMALIZED)
- ADR 0,6 F0 = .DE 1234 5678 9A00 = RANF
- MEND
- GBLC &NAME
-&NAME SETC 'RANF '
-&NAME START
-&NAME AMODE ANY
-&NAME RMODE ANY
- ENTRY DRANF,G900GT,G900ST
-REGLIM EQU 1
- PROLOG REGLIM
- RANF DATA
- EXIT REGLIM
-&NAME SETC 'DRANF '
-&NAME DS 0D DRANF(DUMMY)
- PROLOG REGLIM
- RANF DATA
- EXIT REGLIM
-&NAME SETC 'G900GT'
-&NAME DS 0D G900GT(DUMMY)
- PROLOG REGLIM
- LD 0,DATA F0 = SEED
- LM 0,1,DATA R0 = 402BC68C
-* R1 = FE166D00
- N 0,=X'00FFFFFF' R0 = 002BC68C
- SRL 1,8 R1 = 00FE166D
- STM 0,1,TEMP
- LD 0,TEMP F0 = 002BC68C 00FE166D
- EXIT REGLIM
-&NAME SETC 'G900ST'
-&NAME DS 0D G900ST(SEED)
- PROLOG REGLIM
- L 1,0(1) R1 = (SEED) + 80000000
- N 1,=X'7FFFFFFF' R1 = (SEED)
- LD 0,0(1) F0 = SEED = 002BC68C 00FE166D
- STD 0,TEMP
- LM 0,1,TEMP R0 = 002BC68C
-* R1 = 00FE166D
- A 0,=X'40000000' R0 = 402BC68C
- SLL 1,8 R1 = FE166D00
- STM 0,1,DATA SEED = 402BC68C FE166D00
- EXIT REGLIM
-DATA RANDATA
-TEMP DS 1D
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/g900ib/ranget.s b/src/packlib/kernlib/kernnum/obsolete/g900ib/ranget.s
deleted file mode 100644
index e5c5225..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/g900ib/ranget.s
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: ranget.s,v 1.1.1.1 1996/02/15 17:48:31 mclareni Exp $
-*
-* $Log: ranget.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:31 mclareni
-* Kernlib
-*
-*
-#include "kernnum/linkg900.inc"
- GBLC &NAME
-&NAME SETC 'RANGET'
-&NAME START
-&NAME AMODE ANY
-&NAME RMODE ANY
-REGLIM EQU 3
- PROLOG REGLIM
-* R1 = ((SEED))
- ST 13,R13SAVE SAVE R13
- LR 3,15 SAVE BASE REG 15 IN 3
- LA 13,SAVEAREA R13 = (SAVE AREA FOR G900GT)
- L 15,ASUB R15 = (G900GT)
- BALR 14,15 F0 = G900GT(SEED)[ARG NOT USED]
- LR 15,3 RESTORE BASE REG 15
- L 2,0(1) R2 = (SEED)
- N 2,=X'7FFFFFFF' CLEAR TOP BIT OF ADDRESS WORD
- STD 0,0(2) SEED = F0
- L 13,R13SAVE RESTORE R13 FOR EXIT
- EXIT REGLIM
-R13SAVE DS 1F HOLDS R13
-SAVEAREA DS 18F FOR G900GT
-ASUB DC V(G900GT) EXTERNAL ADDRESS
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/g900ib/ranset.s b/src/packlib/kernlib/kernnum/obsolete/g900ib/ranset.s
deleted file mode 100644
index 364bc6d..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/g900ib/ranset.s
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: ranset.s,v 1.1.1.1 1996/02/15 17:48:31 mclareni Exp $
-*
-* $Log: ranset.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:31 mclareni
-* Kernlib
-*
-*
-#include "kernnum/linkg900.inc"
- GBLC &NAME
-&NAME SETC 'RANSET'
-&NAME START
-&NAME AMODE ANY
-&NAME RMODE ANY
-REGLIM EQU 3
- PROLOG REGLIM
- ST 13,R13SAVE SAVE R13
- LR 3,15 SAVE BASE REG 15 IN 3
- LA 13,SAVEAREA
- L 15,ASUB R15 = (G900ST)
- BALR 14,15 F0 = G900ST(SEED)
- LR 15,3 RESTORE BASE REG 15
- L 13,R13SAVE RESTORE R13
- EXIT REGLIM
-R13SAVE DS 1F
-SAVEAREA DS 18F
-ASUB DC V(G900ST)
- END
diff --git a/src/packlib/kernlib/kernnum/obsolete/g900nord/g900.s b/src/packlib/kernlib/kernnum/obsolete/g900nord/g900.s
deleted file mode 100644
index 63eab92..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/g900nord/g900.s
+++ /dev/null
@@ -1,102 +0,0 @@
-*
-* $Id: g900.s,v 1.1.1.1 1996/02/15 17:47:57 mclareni Exp $
-*
-* $Log: g900.s,v $
-* Revision 1.1.1.1 1996/02/15 17:47:57 mclareni
-* Kernlib
-*
-*
-% KERNNUM PACKAGE G900
-% RANDOM NUMBER GENERATOR GIVES SAME SEQUENCE ON CDC
-% ND500 VERSION 821117 BY M.GUANZIROLI / ETH ZURICH
- MODULE M_RANF
- ROUTINE RANF
- LIB RANF
- EXPORT RANF
- EXPORT DRANF
- EXPORT G900GT
- EXPORT G900ST
- EXPORT RANGET
- EXPORT RANSET
-BBASE: STACK FIXED
-DUMMY: W BLOCK 1
-S1: W DATA 00012743214B
-S0: W DATA 00077413155B
- ENDSTACK
-M1: EQU 00012072642B
-M0: EQU 00071730565B
-RXM48: EQU 01400000000B
-DX24: EQU 00600000000B
-MASK24: EQU 00077777777B
-% X = RANF(DUMMY)
-RANF: ENTF BBASE
- W2 UMUL B.S0,M0,W1 % UNSIGNED MULT WITH OVERFL
- W3 := W1
- W3 AND MASK24
- W DCONV W3,D1
- W SHL W1,-30B
- W SHL W2, 10B
- W1 + W2 % CARRY TO UPPER 3 BYTES
- W4 UMUL B.S0,M1,W2
- W2 AND MASK24
- W1 + W2
- W4 UMUL B.S1,M0,W2
- W2 AND MASK24
- W1 + W2
- W1 AND MASK24
- W1 =: B.S1 % NEW SEED (UPPER 3 BYTES)
- W3 =: B.S0 % NEW SEED (LOWER 3 BYTES)
- W DCONV W1,D2
- A2 =: W2
- W2 + DX24 % UPPER BYTES * 2**24
- A2 := W2
- D1 + D2
- A1 =: W1
- W1 - RXM48 % NORMAL. TO [0.,1)
- A1 := W1
- RET
-% D = DRANF(DUMMY) (DOUBLE PRECISION)
-DRANF: ENTF BBASE
- W2 UMUL B.S0,M0,W1 % UNSIGNED MULT WITH OVERFL
- W3 := W1
- W3 AND MASK24
- W DCONV W3,D1
- W SHL W1,-30B
- W SHL W2, 10B
- W1 + W2 % CARRY TO UPPER 3 BYTES
- W4 UMUL B.S0,M1,W2
- W2 AND MASK24
- W1 + W2
- W4 UMUL B.S1,M0,W2
- W2 AND MASK24
- W1 + W2
- W1 AND MASK24
- W1 =: B.S1 % NEW SEED (UPPER 3 BYTES)
- W3 =: B.S0 % NEW SEED (LOWER 3 BYTES)
- W DCONV W1,D2
- A2 =: W2
- W2 + DX24 % UPPER BYTES * 2**24
- A2 := W2
- D1 + D2
- A1 =: W1
- W1 - RXM48 % NORMAL. TO [0.,1)
- A1 := W1
- RET
-% G900GT = DSEED
-G900GT: ENTF BBASE
- D1 := IND(B.DUMMY)
- RET
-% G900ST(DSEED)
-G900ST: ENTF BBASE
- D MOVE IND(B.DUMMY),B.S1
- RET
-% CALL RANGET(DSEED)
-RANGET: ENTF BBASE
- D MOVE B.S1,IND(B.DUMMY)
- RET
-% CALL RANSET(DSEED)
-RANSET: ENTF BBASE
- D MOVE IND(B.DUMMY),B.S1
- RET
- ENDROUTINE
- ENDMODULE
diff --git a/src/packlib/kernlib/kernnum/obsolete/kerncd/kerncd.s b/src/packlib/kernlib/kernnum/obsolete/kerncd/kerncd.s
deleted file mode 100644
index 19b3f5a..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/kerncd/kerncd.s
+++ /dev/null
@@ -1,6115 +0,0 @@
-*
-* $Id: kerncd.s,v 1.1.1.1 1996/02/15 17:48:14 mclareni Exp $
-*
-* $Log: kerncd.s,v $
-* Revision 1.1.1.1 1996/02/15 17:48:14 mclareni
-* Kernlib
-*
-*
-* This directory was created from kernnum.car patch kerncd
-*CD BASIC
- RTYPE SET 10
- DTYPE SET 20
- CTYPE SET 30
- PLUS MICRO 1,,*+*
- MINUS MICRO 1,,*-*
- NULL MICRO 1,,*0*
- SETYPE MACRO TYPE
- IFEQ TYPE,RTYPE,3
- P MICRO 1,,*R*
- S MICRO 0
- LENGTH SET 1
- IFEQ TYPE,DTYPE,3
- P MICRO 1,,*D*
- S MICRO 0
- LENGTH SET 2
- IFEQ TYPE,CTYPE,3
- P MICRO 1,,*C*
- S MICRO 0
- LENGTH SET 2
- SETYPE ENDM
- HEADER MACRO ID,SAVEA0
- ENTRY ID
- TWORD VFD 42/0H_ID,18/ID
- IFC NE,=SAVEA0==,7
- SAVEA0 BSS 1
- SETX1 RMT
- SA1 SAVEA0 LOAD OLD A0 INTO X1
- SETX1 RMT
- SETA0 RMT
- SA0 X1 RESTORE OLD A0 FROM X1
- SETA0 RMT
- HEADER ENDM
- EXIT MACRO ID
- RESTORE BSS 0
- SETA0 HERE
- EXIT BSS 0
- ID JP *+1S17
- EXIT ENDM
- EPILOG MACRO
- EPILOG BSS 0
- SETX1 HERE X1=OLD A0
- JP RESTORE
- EPILOG ENDM
- BRANCH MACRO LABEL,N.OP.K,J,I,M
- S_J -N 0 J = -N
- IFC NE,=I==,1 IF I .NE. NULL THEN
- S_I -M 1 I = -M
- S_J K+J 2 J = K-N
-* 3 J
-* 4
-* 5
- OP B0,J,LABEL IF N.OP.K GO TO LABEL
- BRANCH ENDM
- RESIDU MACRO A,X,IX,JX,B,Y,IY,JY,C,Z,IZ,JZ
- IFC NE,*A**,1
- S_X A+JX
- IFC NE,*B**,1
- S_Y B+JY
- IFC NE,*C**,1
- S_Z C+JZ
- IFC NE,*A**,1
- S_IX -IX
- IFC NE,*B**,1
- S_IY -IY
- IFC NE,*C**,1
- S_IZ -IZ
- RESIDU ENDM
- STOREF MACRO TYPE,Y
- IFEQ TYPE,RTYPE,1
- SA6 Y
- IFNE TYPE,RTYPE,2
- SA6 Y
- SA7 Y+1
- STOREF ENDM
- SWAP MACRO P,Q
- SX6 P
- S_P Q
- S_Q X6
- SWAP ENDM
-*CD ADD
- RADD1R MACRO JX,&,JY,Z,JZ,J
- LOCAL [1]
- [1] BSS 0 FOR K = 0, 1, 2, ...
- S_J J+1 0 X5 J=2-N+1+K
- RX1 X3_&_X5 1 X1=X(2+K) & Y(2+K)
- SA3 A3+JX 2 X3=X(3+K)
- + SA5 A5+JY 3 X5=Y(3+K)
- SA7 Z 4 X1 Z(1+K)
- NX7 X1 5 X7=Z(2+K)
- S_Z Z+JZ 6 Z=(Z(2+K))
-* 7 X7
-* 8
- + MI J,[1] 9 X3 WHILE 3+K-N<0; I.E. 4+K .LE. N
- RADD1R ENDM
- RADD4R MACRO JX,&,JY,JZ,J
- LOCAL [1]
- [1] BSS 0 FOR K= 0, 4, 8, ...
- + RX0 X2_&_X4 0 X3 X0=X(4+K) & Y(4+K)
- SA6 A7+JZ 1 X5 Z(2+K)
- SA2 A3+JX 2 X2=X(6+K)
- SA4 A5+JY 3 X0 X4=Y(6+K)
- + NX6 X0 4 X6=Z(4+K)
- RX1 X3_&_X5 5 X1=X(5+K) & Y(5+K)
- SA3 A2+JX 6 X6 X3=X(7+K)
- SA7 A6+JZ 7 Z(3+K)
- + SA5 A4+JY 8 X1 X5=Y(7+K)
- S_J J+4 9 X2 J=8-N+4+K
- NX7 X1 10 X4 X7=Z(5+K)
- + RX0 X2_&_X4 11 X0=X(6+K) & Y(6+K)
- SA6 A7+JZ 12 X7 Z(4+K)
- SA2 A3+JX 13 X3 X2=X(8+K)
- SA4 A5+JY 14 X0 X4=Y(8+K)
- + NX6 X0 15 X5 X6=Z(6+K)
- RX1 X3_&_X5 16 X1=X(7+K) & Y(7+K)
- SA3 A2+JX 17 X6 X3=X(9+K)
- SA5 A4+JY 18 X5=Y(9+K)
- + SA7 A6+JZ 19 X1 Z(5+K)
- NX7 X1 20 X2 X7=Z(7+K)
-* 21 X4
-* 22 X7
- MI J,[1] 23 WHILE 12-N+K<0; I.E. 13+K .LE. N
- RADD4R ENDM
- RVADD MACRO N,JX,&,JY,Z,JZ,J X2=(X), X4=(Y)
- LOCAL [1],[2],[3],[4],[5],[99]
- SA3 X2 X3=X(1) A3=(X(1))
- SA5 X4 X5=Y(1) A5=(Y(1))
- BRANCH [3],N,LE,8,J J=8-N
- SA2 A3+JX X2=X(2) A2=(X(2))
- SA4 A5+JY X4=Y(2) A4=(Y(2))
- RX7 X3_&_X5 X7=X(1)&Y(1)
- SA3 A2+JX X3=X(3) A3=(X(3))
- SA5 A4+JY X5=Y(3) A5=(Y(3))
- NX7 X7 X7=Z(1)
- RX6 X2_&_X4 X6=X(2)&Y(2)
- SA2 A3+JX X2=X(4) A2=(X(4))
- SA4 A5+JY X4=Y(4) A4=(Y(4))
- NX6 X6 X6=Z(2)
- RX1 X3_&_X5 X1=X(3)&Y(3)
- SA3 A2+JX X3=X(5) A3=(X(5))
- SA5 A4+JY X5=Y(5) A5=(Y(5))
- SA7 Z Z(1)=X(1)&Y(1)
- NX7 X1 X7=Z(3)
- RADD4R JX,&,JY,JZ,J J=0,1,2,3 FOR N=12,11,10,9
- RX1 X2_&_X4 X1=X(8)&Y(8)
- SA6 A7+JZ Z(6)=X(6)&Y(6)
- S_J J-3 -J FETCHES LEFT
- SA7 A6+JZ Z(7)=X(7)&Y(7)
- ZR J,[2] IF N=9,13,17,...
- [1] NX7 X1 X7=Z(8+K)
- RX1 X3_&_X5 X1=X(9+K)&Y(9+K)
- SA3 A3+JX X3=X(10+K) A3=(X(10+K))
- SA5 A5+JY X5=Y(10+K) A5=(Y(10+K))
- S_J J+1
- SA7 A7+JZ Z(8+K)=X(8+K)&Y(8+K)
- MI J,[1] WHILE J<0
- [2] NX7 X1 X7=Z(N-1)
- RX1 X3_&_X5 X1=X(N)&Y(N)
- SA7 A7+JZ Z(N-1)=X(N-1)&Y(N-1)
- NX7 X1 X7=Z(N)
- SA7 A7+JZ Z(N)=X(N)&Y(N)
- JP [99]
- [3] BSS 0 X3=X(1) X5=Y(1)
- S_J J-6 J=2-N
- RX1 X3_&_X5 X1=X(1)&Y(1)
- GT J,B0,[5] IF N=1
- SA3 A3+JX X3=X(2) A3=(X(2))
- SA5 A5+JY X5=Y(2) A5=(Y(2))
- NX7 X1 X7=Z(1)
- ZR J,[4] IF N=2
- RADD1R JX,&,JY,Z,JZ,J J=0
- [4] RX1 X3_&_X5 X1=X(N)&Y(N)
- SA7 Z Z(N-1)=X(N-1)&Y(N-1)
- S_Z Z+JZ Z=(Z(N))
- [5] NX7 X1 X7=Z(N)
- SB0 0
- SA7 Z Z(N)=X(N)&Y(N)
- [99] BSS 0
- RVADD ENDM
- RMADD MACRO M,N,JX,&,JY,Z,IZ,JZ,J,TEMP6
-* X2=(X)
-* X3=IX
-* X4=(Y)
-* X5=IY
- LOCAL [1],[2],[3],[4],[5],[6],[7],[99]
- LOCAL SAVEM,SAVEX,SAVEIX,SAVEY,SAVEIY,SAVEZ
- SAVEM EQU TEMP6
- SAVEX EQU SAVEM+1
- SAVEIX EQU SAVEX+1
- SAVEY EQU SAVEIX+1
- SAVEIY EQU SAVEY+1
- SAVEZ EQU SAVEIY+1
- LE M,N,[2] IF M .LE. N
- [1] SWAP M,N EXCHANGE M AND N
- SWAP X3,JX EXCHANGE IX AND JX
- SWAP X5,JY EXCHANGE IY AND JY
- SWAP IZ,JZ EXCHANGE IZ AND JZ
- [2] BRANCH [4],N,LE,8,J J=8-N
- BX6 X3 X6=IX
- BX7 X5 X7=IY
- SA6 SAVEIX SAVEIX=IX
- SX6 M X6=M
- SA7 SAVEIY SAVEIY=IY
- SA6 SAVEM SAVEM=M
- S_M -M M=-M
- [3] IX6 X2+X3 X6=(X(2,1))
- IX7 X4+X5 X7=(Y(2,1))
- SA3 X2 X3=X(1,1)
- SA5 X4 X5=Y(1,1)
- SA2 A3+JX X2=X(1,2)
- SA4 A5+JY X4=Y(1,2)
- SA6 SAVEX SAVEX=(X(2,1))
- SA7 SAVEY SAVEY=(Y(2,1))
- RX7 X3_&_X5 X7=X(1,1) & Y(1,1)
- SA3 A2+JX X3=X(1,3)
- SA5 A4+JY X5=Y(1,3)
- RX6 X2_&_X4 X6=X(1,2) & Y(1,2)
- SA2 A3+JX X2=X(1,4)
- SA4 A5+JY X4=Y(1,4)
- NX7 X7 X7=Z(1,1)
- RX1 X3_&_X5 X1=X(1,3) & Y(1,3)
- SA3 A2+JX X3=X(1,5)
- SA5 A4+JY X5=Y(1,5)
- NX6 X6 X6=Z(1,2)
- SA7 Z Z(1,1)
- NX7 X1 X7=Z(1,3)
- S_J -N
- S_J J+8 J=8-N
- RADD4R JX,&,JY,JZ,J J=3,2,1,0 FOR N=0,1,2,3 ELEM. LEFT
- RX0 X2_&_X4 X0=X(1,N-4+J) & Y(1,N-4+J)
- SA6 A7+JZ Z(1,N-6+J)
- SA2 SAVEX X2=(X(2,1))
- SA4 SAVEY X4=(Y(2,1))
- NX6 X0 X6=Z(1,N-4+J)
- RX1 X3_&_X5 X1=X(1,N-3+J) & Y(1,N-3+J)
- SX0 A3 X0=(LAST X)
- SA7 A6+JZ Z(1,N-5+J)
- S_Z Z+IZ Z=(Z(2,1))
- NX7 X1 X7=Z(1,N-3+J)
- S_M M+1 M=M+1
- SX1 A5 J=(LAST Y)
- SA6 A7+JZ Z(1,N-4+J)
- SA3 SAVEIX X3=IX
- SA5 SAVEIY X5=IY
- SA7 A6+JZ Z(1,N-3+J)
- MI M,[3] WHILE M<0
- BRANCH [99],J,EQ,3,N N=3-J=0,1,2,3
- SA3 SAVEIX X3=IX
- SA5 SAVEIY X5=IY
- SX2 X0+JX X2=(X(M,NEW 1))
- SX4 X1+JY X4=(Y(M,NEW 1))
- SA1 SAVEM X1=M
- S_Z A7+JZ Z =(Z(M,NEW 1))
- S_IZ -IZ TO WORK FROM LAST ROW UPWARDS
- BX3 -X3
- BX5 -X5
- S_M X1 RESTORE M
- GT M,N,[1]
- [4] BSS 0
- BX6 X3 X6=IX
- BX7 X5 X7=IY
- SA6 SAVEIX SAVEIX=IX
- SA7 SAVEIY SAVEIY=IY
- S_M -M M=-M
- [5] IX6 X2+X3 X6=(X(2,1))
- IX7 X4+X5 X7=(Y(2,1))
- SA3 X2 X3=X(1,1)
- SA5 X4 X5=Y(1,1)
- SA6 SAVEX SAVEX=(X(2,1))
- SA7 SAVEY SAVEY=(Y(2,1))
- S_J -N
- SX6 Z+IZ X6=(Z(2,1))
- S_J J+2 J=2-N=+1,0,-1,...; N=1,2,3,...
- S_M M+1 M=M+1
- RX1 X3_&_X5 X1=X(1,1) & Y(1,1)
- SA6 SAVEZ SAVEZ=(Z(2,1))
- GT J,B0,[7] IF N=1
- SA3 A3+JX X3=X(1,2)
- SA5 A5+JY X5=Y(1,2)
- NX7 X1 X7=Z(1,1)
- ZR J,[6] IF N=2
- RADD1R JX,&,JY,Z,JZ,J
- [6] RX1 X3_&_X5 X1=X(1,N) & Y(1,N)
- SA7 Z Z(1,N-1)
- S_Z Z+JZ Z=(Z(1,N))
- [7] NX7 X1 X7=Z(1,N)
- SA1 SAVEZ X1=(Z(2,1))
- SA2 SAVEX X2=(X(2,1))
- SA4 SAVEY X4=(Y(2,1))
- SA3 SAVEIX X3=IX
- SA5 SAVEIY X5=IY
- SA7 Z Z(1,N)
- S_Z X1 Z=(Z(2,1))
- MI M,[5]
- [99] BSS 0
- RMADD ENDM
- DADD1R MACRO JX,&,JY,JZ,J
- LOCAL [1]
- [1] BSS 0 FOR K = 0, 1, 2, ...
- FX5 X3_&_X5 0 X4 X5=U(X'' & Y'')=A'(3+K)
- DX1 X2_&_X4 1 X1=L(X' & Y')=B''(3+K)
- DX7 X6+X0 2 X7=L(E+F)=Z''(2+K)
- FX6 X6+X0 3 X5 X6=U(E+F)=Z'(2+K)
- + FX4 X2_&_X4 4 X1 X4=U(X' & Y')=B'(3+K)
- FX0 X5+X1 5 X7 X0=U(A'+B'')=C'(3+K)
- SA7 A7+JZ 6 X6 Z''(2+K)
- SA3 A3+JX 7 X4 X3=X''(4+K)
- + SA5 A5+JY 8 X0 X5=Y''(4+K)
- FX1 X4+X0 9 X1=U(B'+C')=D'(3+K)
- DX0 X4+X0 10 X0=L(B'+C')=D''(3+K)
- SA6 A6+JZ 11 Z'(2+K)
- + SA2 A2+JX 12 X1 X2=X'(4+K)
- SA4 A4+JY 13 X0 X4=Y'(4+K)
- S_J J+1 14 X3 J=3-N+1+K
- + NX6 X1 15 X5 X6=E(3+K)
- NX0 X0 16 X0=F(3+K)
-* 17 X6
-* 18 X0
- MI J,[1] 19 X2 WHILE 4-N+K<0; I.E. 5+K .LE. N
- DADD1R ENDM
- DMADD MACRO M,N,JX,&,JY,Z,IZ,JZ,J,TEMP4
-* X2=(X)
-* X3=IX
-* X4=(Y)
-* X5=IY
- LOCAL [1],[2],[3],[4],[99]
- LOCAL SAVEX,SAVEIX,SAVEY,SAVEIY
- SAVEX EQU TEMP4
- SAVEIX EQU SAVEX+1
- SAVEY EQU SAVEIX+1
- SAVEIY EQU SAVEY+1
- LE M,N,[1] IF M .LE. N
- SWAP M,N EXCHANGE M AND N
- SWAP X3,JX EXCHANGE IX AND JX
- SWAP X5,JY EXCHANGE IY AND JY
- SWAP IZ,JZ EXCHANGE IZ AND JZ
- [1] BX6 X3 X6=IX
- BX7 X5 X7=IY
- S_M -M M=-M
- SA6 SAVEIX SAVEIX=IX
- SA7 SAVEIY SAVEIY=IY
- [2] IX6 X2+X3 X6=(X'(2,1))
- IX7 X4+X5 X7=(Y'(2,1))
- SA3 X2+1 X3=X''(1,1)
- SA5 X4+1 X5=Y''(1,1)
- SA2 X2 X2=X'(1,1)
- SA4 X4 X4=Y'(1,1)
- SA6 SAVEX SAVEX=(X'(2,1))
- SA7 SAVEY SAVEY=(Y'(2,1))
- S_J 1 J=1
- FX5 X3_&_X5 X5=U(X'' & Y'')=A'(1)
- DX1 X2_&_X4 X1=L(X' & Y')=B''(1)
- FX4 X2_&_X4 X4=U(X' & Y')=B'(1)
- FX0 X5+X1 X0=U(A'+B'')=C'(1)
- FX1 X4+X0 X1=U(B'+C')=D'(1)
- DX0 X4+X0 X0=L(B'+D')=D''(1)
- NX6 X1 X6=E(1)
- NX0 X0 X0=F(1)
- DX7 X6+X0 X7=L(E+F)=Z''(1)
- FX6 X6+X0 X6=U(E+F)=Z'(1)
- SA7 Z+J Z''(1)
- SA6 Z Z'(1)
- EQ J,N,[99] IF N=1 THEN M=1
- SA3 A3+JX X3=X''(1,2)
- SA5 A5+JY X5=Y''(1,2)
- SA2 A2+JX X2=X'(1,2)
- SA4 A4+JY X4=Y'(1,2)
- S_J -N
- S_M M+1 M=M+1
- S_J J+3 J=3-N=+1,0,-1,...; N=2,3,4,...
- FX5 X3_&_X5 X5=U(X'' & Y'')=A'(2)
- DX1 X2_&_X4 X1=L(X' & Y')=B''(2)
- FX4 X2_&_X4 X4=U(X' & Y')=B'(2)
- FX0 X5+X1 X0=U(A'+B'')=C'(2)
- FX1 X4+X0 X1=U(B'+C')=D'(2)
- DX0 X4+X0 X0=L(B'+D')=D''(2)
- NX6 X1 X6=E(2)
- NX0 X0 X0=F(2)
- GT J,B0,[4] IF N=2
- SA3 A3+JX X3=X''(1,3)
- SA5 A5+JY X5=Y''(1,3)
- SA2 A2+JX X2=X'(1,3)
- SA4 A4+JY X4=Y'(1,3)
- ZR J,[3] IF N=3
- DADD1R JX,&,JY,JZ,J J=0
- [3] FX5 X3_&_X5 X5=U(X'' & Y'')=A'(N)
- DX1 X2_&_X4 X1=L(X' & Y')=B''(N)
- DX7 X6+X0 X7=L(E+F)=Z''(N-1)
- FX6 X6+X0 X6=U(E+F)=Z'(N-1)
- FX4 X2_&_X4 X4=U(X' & Y')=B'(N)
- FX0 X5+X1 X0=U(A'+B'')=C'(N)
- SA7 A7+JZ Z''(N-1)
- FX1 X4+X0 X1=U(B'+C')=D'(N)
- DX0 X4+X0 X0=L(B'+D')=D''(N)
- SA6 A6+JZ Z'(N-1)
- NX6 X1 X6=E(N)
- NX0 X0 X0=F(N)
- [4] SA2 SAVEX X2=(X'(2,1))
- SA4 SAVEY X4=(Y'(2,1))
- DX7 X6+X0 X7=L(E+F)=Z''(N)
- FX6 X6+X0 X6=U(E+F)=Z'(N)
- SA3 SAVEIX X3=IX
- SA5 SAVEIY X5=IY
- S_Z Z+IZ Z=(Z'(2,1))
- SA7 A7+JZ Z''(N)
- SA6 A6+JZ Z'(N)
- MI M,[2] WHILE M<0
- [99] BSS 0
- DMADD ENDM
-*CD CPY
- RCPY2R MACRO JX,JY,J
- LOCAL [1]
- [1] BSS 0 FOR K = 0, 2, 4,...
- + BX6 X4 0 X5 X6=X(2+K)
- SA4 A5+JX 1 X6 X4=X(4+K)
- BX7 X5 2 X7=X(3+K)
- SA5 A4+JX 3 X7 X5=X(5+K)
- + SA6 A7+JY 4 Y(2+K)=X(2+K)
- S_J J+2 5 J=4-N+2+K
- SA7 A6+JY 6 Y(3+K)=X(3+K)
- 7
- 8 X4
- + MI J,[1] 9 WHILE 6-N+K=J<0; I.E. 7+K .LE. N
- RCPY2R ENDM
- RCPY12R MACRO JX,JY,J
- LOCAL [1]
- [1] BSS 0 FOR K = 0, 12, 24, ...
- + BX6 X2 0 X4 X6=X(2+K)
- S_J J+12 1 X6 J=16-N+12+K
- BX7 X3 2 X5 X7=X(3+K)
- + SA2 A5+JX 3 X7 X2=X(6+K)
- SA6 A7+JY 4 Y(2+K)=X(2+K)
- SA3 A2+JX 5 X3=X(7+K)
- SA7 A6+JY 6 Y(3+K)=X(3+K)
- + BX6 X4 7 X6=X(4+K)
- BX7 X5 8 X6 X7=X(5+K)
- SA4 A3+JX 9 X7 X4=X(8+K)
- SA6 A7+JY 10 X2 Y(4+K)=X(4+K)
- + SA5 A4+JX 11 X5=X(9+K)
- SA7 A6+JY 12 X3 Y(5+K)=X(5+K)
- BX6 X2 13 X6=X(6+K)
- BX7 X3 14 X6 X7=X(7+K)
- + SA2 A5+JX 15 X7 X2=X(10+K)
- SA6 A7+JY 16 X4 Y(6+K)=X(6+K)
- SA3 A2+JX 17 X3=X(11+K)
- SA7 A6+JY 18 X5 Y(7+K)=X(7+K)
- + BX6 X4 19 X6=X(8+K)
- BX7 X5 20 X6 X7=X(9+K)
- SA4 A3+JX 21 X7 X4=X(12+K)
- SA6 A7+JY 22 X2 Y(8+K)=X(8+K)
- + SA5 A4+JX 23 X5=X(13+K)
- SA7 A6+JY 24 X3 Y(9+K)=X(9+K)
- BX6 X2 25 X6=X(10+K)
- BX7 X3 26 X6 X7=X(11+K)
- + SA2 A5+JX 27 X7 X2=X(14+K)
- SA6 A7+JY 28 X4 Y(10+K)=X(10+K)
- SA3 A2+JX 29 X3=X(15+K)
- SA7 A6+JY 30 X5 Y(11+K)=X(11+K)
- + BX6 X4 31 X6=X(12+K)
- BX7 X5 32 X6 X7=X(13+K)
- SA4 A3+JX 33 X7 X4=X(16+K)
- SA6 A7+JY 34 X2 Y(12+K)=X(12+K)
- + SA5 A4+JX 35 X5=X(17+K)
- SA7 A6+JY 36 X3 Y(13+K)=X(13+K)
- 37
- 38
- MI J,[1] 39 WHILE 28-N+K=J<0; I.E. 29+K.LE.N
- RCPY12R ENDM
- RVCPY MACRO N,X,JX,Y,JY,J
- LOCAL [1],[2],[3],[4],[5],[6],[99]
- BRANCH [2],N,LE,16,J 16-N
- [1] SA5 X 5 X5=X(1)
- SA2 X+JX 6 X2=X(2)
- 7
- SA3 A2+JX 8 X3=X(3)
- 9 A3
- SB0 A3 10 AVOIDS CONFLICT AT CP 1 OF RCPY12R
- + SA4 A3+JX 11 X4=X(4)
- 12 X5
- BX7 X5 13 X2 X7=X(1)
- SA5 A4+JX 14 X7 X5=X(5)
- SA7 Y 15 X3 A7=(Y(1))
- RCPY12R JX,JY,J
- + S_J J-10 39 J=1,0,-1,-2,...,-10
- BX6 X2 40 X4 X6=X(J+N-4)
- 41 X6
- BX7 X3 42 X5 X7=X(J+N-3)
- + SA6 A7+JY 43 X7 A6=(Y(J+N-4))
- SB0 0 44
- SA7 A6+JY 45 A7=(Y(J+N-3))
- 46
- + ZR J,[5] 47 IF 1 ELEMENT LEFT
- 48
- PL J,[6] 49 IF NO ELEMENT LEFT
- RCPY2R JX,JY,J
- 9 J=1,0
- NZ J,[6] 10 X5 IF NO ELEMENT LEFT
- + BX7 X4 11 X7=X(N-2)
- BX4 X5 12 X7 X4=X(N-1)
- SA5 A5+JX 13 X4 X5=X(N)
- SA7 A7+JY 14 A7=(Y(N-2))
-* 15
-* 16
- + JP [6] 17
- [2] BSS 0 J=16-N=15,14,13,...,2,1,0
- SA3 X 13 X3=X(1)
- SX6 N-2 14 X6=N-2
- NO 15 X6
- 16
- + MI X6,[3] 17 IF N=1 (I.E. J=15)
- NO 18
- SA4 X+JX 19 X4=X(2)
- 20 X3
- 21
- + ZR X6,[4] 22 IF N=2 (I.E.J=14)
- SA5 A4+JX 23 X5=X(3)
- BX7 X3 24 X7=X(1)
- + S_J J-12 25 X7 J=1,0,-1,-2,...,-11,-12
- SA7 Y 26 X4 A7=(Y(1))
- NO 27
- 28
- + GT J,B0,[6] 29 IF N=3 (I.E. J=1)
- 30 X5
- ZR J,[5] 31 IF N=4 (I.E. J=0)
- RCPY2R JX,JY,J
- NZ J,[6] 10 X5 IF NO ELEMENT LEFT
- + BX7 X4 11 X7=X(N-2)
- BX4 X5 12 X7 X4=X(N-1)
- SA5 A5+JX 13 X4 X5=X(N)
- SA7 A7+JY 14 A7=(Y(N-2))
- 15
- 16
- + JP [6] 17
- [3] BX7 X3 26 X7=X(1)
- SA5 A3 27 X7 A5=(X(1))
- SA7 Y 28 A7=(Y(1))
- NO 29
-* 30
-* 31
- JP [99] 32
- [4] BX6 X3 32 X6=X(1)
- BX7 X4 33 X6 X7=X(2)
- SA6 Y 34 X7 A6=(Y(1))
- SA7 Y+JY 35 A7=(Y(2))
- + SA5 A4 36 A5=(X(2))
-* 37
-* 38
- JP [99] 39
- [5] BX7 X4 0 X7=X(N-2)
- BX4 X5 1 X7 X4=X(N-1)
- SA5 A5+JX 2 X5=X(N)
- SA7 A7+JY 3 A7=(Y(N-2))
- [6] BX6 X4 0 X6=X(N-1)
- BX7 X5 1 X6 X7=X(N)
- SA6 A7+JY 2 X7 A6=(Y(N-1))
-* 3
- SA7 A6+JY 4 A7=(Y(N))
- [99] BSS 0
- RVCPY ENDM
- RMCPY MACRO M,N,X,IX,JX,Y,IY,JY,I,J
-* X0=X A0=Y
-* X1=I
- LOCAL [1],[2],[3],[4],[5],[6],[7],[8],[9],[99]
- LE M,N,[2] IF M .LE. N
- [1] SWAP M,N EXCHANGE M AND N
- SWAP IX,JX EXCHANGE IX AND JX
- SWAP IY,JY EXCHANGE IY AND JY
- [2] BRANCH [4],N,LE,16,J,I,M J=16-N, I=-M
- [3] BSS 0 FOR K = 1, 2, ..., M AND I = K-1-M
- SA5 X X5=X(K,1)
- SA2 X+JX X2=X(K,2)
- SA3 A2+JX X3=X(K,3)
- S_J -N J=-N
- + S_I I+1 I=K-M
- S_J J+16 J=16-N
- + BX7 X5 X7=X(K,1)
- SA4 A3+JX X4=X(K,4)
- SA7 Y Y(K,1)=X(K,1) A7=(Y(K,1))
- SA5 A4+JX X5=X(K,5) A5=(X(K,5))
- RCPY12R JX,JY,J
- + S_Y Y+IY 0 Y=(Y(K+1,1))
- BX6 X2 1 X6=X(K,N+J-14)
- 2
- BX7 X3 3 X7=X(K,N+J-13)
- SA6 A7+JY 4 Y(K,N+J-14)=X(K,N+J-14)
- + BX6 X4 5 X6=X(K,N+J-12)
- SA7 A6+JY 6 Y(K,N+J-13)=X(K,N+J-13)
- BX7 X5 7 X7=X(K,N+J-11)
- SA6 A7+JY 8 Y(K,N+J-12)=X(K,N+J-12)
- + S_X X+IX 9 X=(X(K+1,1))
- SA7 A6+JY 10 Y(K,N+J-11)=X(K,N+J-11)
- 11
- 12
- MI I,[3] 13 WHILE I<0
- BRANCH [99],J,EQ,11,N N=11-J
- RESIDU A5,X,IX,JX,A7,Y,IY,JY
- GT M,N,[1]
- [4] BSS 0
- BRANCH [7],N,GT,2,J,I,M J=2-N=1,0,-1,...,-16; I=-M
- NZ J,[6] IF N=1
- [5] SA4 X X4=X(K,1)
- SA5 X+JX X5=X(K,2)
- S_X X+IX X=(X(K+1,1))
- S_I I+1 I=I+1
- BX6 X4 X6=X(K,1)
- BX7 X5 X7=X(K,2)
- SA6 Y Y(K,1)=X(K,1)
- SA7 Y+JY Y(K,2)=X(K,2)
- S_Y Y+IY Y=(Y(K+1,1))
- MI I,[5] WHILE I<M
- JP [99]
- [6] SA5 X X5=X(1,1)
- BX7 X5 X7=X(1,1)
- SA7 Y Y(1,1)=X(1,1)
- JP [99]
- [7] BSS 0
- SA3 X X3=X(K,1)
- SA4 X+JX X4=X(K,2)
- SA5 A4+JX X5=X(K,3)
- S_J -N J=-N
- S_I I+1 I=K-M
- S_J J+4 J=4-N
- + BX7 X3 X7=X(K,1)
- S_X X+IX X=(X(K+1,1))
- SA7 Y Y(K,1)=X(K,1)
- S_Y Y+IY Y=(Y(K+1,1))
- ZR J,[8] IF N=4
- PL J,[9] IF N=3
- RCPY2R JX,JY,J
- NZ J,[9]
- [8] BX7 X4
- BX4 X5
- SA5 A5+JX
- SA7 A7+JY
- NO
- NO
- NO
- NO
- [9] BX6 X4
- BX7 X5
- SA6 A7+JY
- SA7 A6+JY
- MI I,[7]
- [99] BSS 0
- RMCPY ENDM
- DCPY1R MACRO JX,JZ,J
- LOCAL [1]
- [1] BSS 0 FOR K = 0, 1, 2,...
- + BX6 X4 0 X5 X6=X'(2+K)
- SA4 A4+JX 1 X6 X4=X'(3+K)
- BX7 X5 2 X7=X"(2+K)
- SA5 A5+JX 3 X7 X5=X"(3+K)
- + SA6 A6+JZ 4 Z'(2+K)=X'(2+K)
- S_J J+1 5 J=2-N+1+K
- SA7 A7+JZ 6 Z"(2+K)=X''(2+K)
- 7 X4
- 8
- + MI J,[1] 9 WHILE 3-N+K=J<0; I.E. 4+K .LE. N
- DCPY1R ENDM
- DCPY6R MACRO JX,JZ,J
- LOCAL [1]
- [1] BSS 0 FOR K = 0, 6, 12, ...
- + BX6 X2 0 X4 X6=X'(2+K)
- S_J J+6 1 X6 J=8-N+6+K
- BX7 X3 2 X5 X7=X"(2+K)
- + SA2 A4+JX 3 X7 X2=X'(4+K)
- SA6 A6+JZ 4 Z'(2+K)=X'(2+K)
- SA3 A5+JX 5 X3=X"(4+K)
- SA7 A7+JZ 6 Z"(2+K)=X''(2+K)
- + BX6 X4 7 X6=X'(3+K)
- BX7 X5 8 X6 X7=X"(3+K)
- SA4 A2+JX 9 X7 X4=X'(5+K)
- SA6 A6+JZ 10 X2 Z(4+K)=X(4+K)
- + SA5 A3+JX 11 X5=X"(5+K)
- SA7 A7+JZ 12 X3 Z(5+K)=X(5+K)
- BX6 X2 13 X6=X(6+K)
- BX7 X3 14 X6 X7=X(7+K)
- + SA2 A4+JX 15 X7 X2=X(10+K)
- SA6 A6+JZ 16 X4 Z(6+K)=X(6+K)
- SA3 A5+JX 17 X3=X(11+K)
- SA7 A7+JZ 18 X5 Z(7+K)=X(7+K)
- + BX6 X4 19 X6=X(8+K)
- BX7 X5 20 X6 X7=X(9+K)
- SA4 A2+JX 21 X7 X4=X(12+K)
- SA6 A6+JZ 22 X2 Z(8+K)=X(8+K)
- + SA5 A3+JX 23 X5=X(13+K)
- SA7 A7+JZ 24 X3 Z(9+K)=X(9+K)
- BX6 X2 25 X6=X(10+K)
- BX7 X3 26 X6 X7=X(11+K)
- + SA2 A4+JX 27 X7 X2=X(14+K)
- SA6 A6+JZ 28 X4 Z(10+K)=X(10+K)
- SA3 A5+JX 29 X3=X(15+K)
- SA7 A7+JZ 30 X5 Z(11+K)=X(11+K)
- + BX6 X4 31 X6=X(12+K)
- BX7 X5 32 X6 X7=X(13+K)
- SA4 A2+JX 33 X7 X4=X(16+K)
- SA6 A6+JZ 34 X2 Z(12+K)=X(12+K)
- + SA5 A3+JX 35 X5=X"(9+K)
- SA7 A7+JZ 36 X3 Z"(7+K)=X''(7+K)
- 37
- 38
- MI J,[1] 39 WHILE 14-N+K=J<0; I.E. 15+K.LE.N
- DCPY6R ENDM
- DVCPY MACRO N,X,JX,Y,JY,J
- LOCAL [1],[2],[3],[4],[5],[6],[99]
- BRANCH [4],N,LE,8,J J=8-N
- [1] SA4 X 5 X4=X'(1)
- SA5 X+1 6 X5=X"(1)
- 7
- SA3 A5+JX 8 X3=X"(2)
- + SA2 A4+JX 9 X2=X'(2)
- 10
- 11
- 12 X4
- BX6 X4 13 X5 X6=X'(1)
- SA4 A2+JX 14 X6 X4=X'(3)
- SA6 Y 15 X3 A6=(Y'(1))
- + BX7 X5 16 X2 X7=X"(1)
- SA5 A3+JX 17 X7 X5=X"(3)
- SA7 Y+1 18 A7=(Y"(1))
- DCPY6R JX,JY,J 0
- 1 X6
- 2 X4
- 3 X7
- 4
- 5 X5
- + S_J J-5 39 J=0,-1,-2,-3,-4,-5
- BX6 X2 40 X4 X6=X'(J+N-1)
- 41 X6
- BX7 X3 42 X5 X7=X"(J+N-1)
- + SA6 A6+JY 43 X7 A6=(Y'(J+N-1))
- SA7 A7+JY 44 A7=(Y"(J+N-1))
- 45
- MI J,[5] 46 IF -J ELEMENTS LEFT
- 47
- 48
- + JP [6] 49
- [2] BX7 X3 0 X7=X"(1)
- BX6 X2 1 X7 X6=X'(1)
- SA7 Y+1 2 X6 A7=(Y"(1))
- + SA6 Y 3 A6=(Y'(1))
- SA4 A2 4 A4=(X'(1))
- SA5 A3 5 A5=(X"(1))
- 6
- 7
- JP [99] 8
- [3] BX6 X2 0 X6=X'(1)
- BX7 X3 1 X7=X"(1)
- SA6 Y 2 A6=(Y'(1))
- BX6 X4 3 X6=X'(2)
- + SA7 Y+1 4 A7=(Y"(1))
- BX7 X5 5 X7=X"(2)
- SA6 A6+JY 6 A6=(Y'(2))
- 7
- + SA7 A7+JY 8 A7=(Y"(2))
- 9
- 10
- JP [99] 11
- [4] BSS 0 J=8-N=7,6,5,4,3,2,1,0
- SA3 X+1 0 X3=X"(1)
- SX6 N-2 1 X6=N-2
- + SA2 X 2 X6 X2=X'(1)
- 3
- MI X6,[2] 4 IF N=1 (I.E. J=7)
- SA4 A2+JX 5 X4=X'(2)
- 6
- 7 X3
- + SA5 A3+JX 8 X5=X"(2)
- 9 X2
- ZR X6,[3] 10 IF N=2 (I.E. J=6)
- 11
- BX6 X2 12 X4 X6=X'(1)
- + BX7 X3 13 X6 X7=X"(1)
- S_J J-6 14 X7 J=-1,-2,...,-6
- SA6 Y 15 X6 A6=(Y'(1))
- + SA7 Y+1 16 X5 A7=(Y"(1))
- [5] DCPY1R JX,JY,J
- SB0 0 9
- [6] BX6 X4 10 X5 X6=X'(N)
- BX7 X5 11 X6 X7=X"(N)
- SA6 A6+JY 12 X7 A6=(Y'(N))
- SA7 A7+JY 13 A7=(Y"(N))
- [99] BSS 0
- DVCPY ENDM
- DMCPY MACRO M,N,X,IX,JX,Y,IY,JY,I,J X=X0,Y=A0,I=X1
- LOCAL [1],[2],[3],[4],[5],[6],[99]
- LE M,N,[2] IF M .LE. N
- [1] SWAP M,N EXCHANGE M AND N
- SWAP IX,JX EXCHANGE IX AND JX
- SWAP IY,JY EXCHANGE IY AND JY
- [2] BRANCH [4],N,LE,8,J,I,M J=8-N, I=-M
- [3] BSS 0 FOR K = 1, 2, ..., M AND I = K-1-M
- + SA4 X 0 X4=X'(K,1)
- SA5 X+1 1 X5=X"(K,1)
- S_J -N 2 J=-N
- 3
- + S_I I+1 4 I=K-M
- SA2 A4+JX 5 X2=X'(K,2)
- SA3 A5+JX 6 X3=X"(K,2)
- 7 X4
- + BX6 X4 8 X5 X6=X'(K,1)
- BX7 X5 9 X6 X7=X"(K,1)
- SA4 A2+JX 10 X7 X4=X'(K,3)
- SA5 A3+JX 11 X5=X"(K,3)
- + SA6 Y 12 X2 Y'(K,1)=X'(K,1)
- SA7 Y+1 13 X3 Y"(K,1)=X''(K,1)
- S_J J+8 14 J=8-N
- DCPY6R JX,JY,J
- + S_Y Y+IY 39 Y=(Y(K+1,1))
- BX6 X2 40 X4 X6=X'(K,N+J-6)
- 41 X6
- BX7 X3 42 X5 X7=X"(K,N+J-6)
- SA6 A6+JY 43 X7 Y'(K,N+J-6)=X'(K,N+J-6)
- + SA7 A7+JY 44 Y"(K,N+J-6)=X''(K,N+J-6)
- BX6 X4 45 X6=X'(K,N+J-5)
- BX7 X5 46 X6 X7=X"(K,N+J-5)
- S_X X+IX 47 X7 X=(X(K+1,1))
- + SA6 A6+JY 48 X Y'(K,N+J-5)=X'(K,N+J-5)
- SA7 A7+JY 49 Y"(K,N+J-5)=X''(K,N+J-5)
- 50
- 51
- MI I,[3] 52 WHILE I<0
- BRANCH [99],J,EQ,5,N N=5-J
- RESIDU A4,X,IX,JX,A6,Y,IY,JY
- GT M,N,[1]
- [4] BSS 0
- BRANCH [5],N,GE,2,J,I,M J=2-N=1,0,-1,...,-6; I=-M
- SA4 X X4=X'(1,1)
- SA5 X+1 X5=X"(1,1)
- BX6 X4 X6=X'(1,1)
- BX7 X5 X7=X"(1,1)
- SA6 Y Y'(1,1)=X'(1,1)
- SA7 Y+1 Y"(1,1)=X''(1,1)
- JP [99]
- [5] BSS 0 FOR K = 1,2,...,M AND I = K-1-M
- SA2 X X2=X'(K,1)
- SA3 X+1 X3=X"(K,1)
- S_J -N J=-N
- + S_I I+1 I=K-M
- SA4 A2+JX X4=X'(K,2)
- SA5 A3+JX X5=X"(K,2)
- + BX6 X2 X6=X'(K,1)
- BX7 X3 X7=X"(K,1)
- S_J 2+J J=2-N
- + SA6 Y Y'(K,1)=X'(K,1)
- SA7 Y+1 Y"(K,1)=X''(K,1)
- ZR J,[6] IF N=2
- DCPY1R JX,JY,J
- [6] BX6 X4 X6=X'(K,N)
- BX7 X5 X7=X"(K,N)
- SA6 A6+JY Y'(K,N)=X'(K,N)
- SA7 A7+JY Y"(K,N)=X''(K,N)
- + S_X X+IX X=(X(K+1,1))
- S_Y Y+IY Y=(Y(K+1,1))
- MI I,[5] WHILE I<0
- [99] BSS 0
- DMCPY ENDM
-*CD UTL
- TMUTL MACRO TYPE,NM1,IX,JX,J X1=(X(1,1))
- LOCAL [1]
- SX0 X1+JX X0=(X(1,2))
- SX1 X1+IX X1=(X(2,1))
- [1] BSS 0
- TAU IFNE TYPE,CTYPE
- "P"VCPY NM1,X0,JX,X1,IX,J
- TAU ELSE
- DVCPY NM1,X0,JX,X1,IX,J
- TAU ENDIF
- S_J IX+JX J=IX+JX
- S_NM1 NM1-1 NM1=NM1-1
- SX0 X0+J X0=(X(I+1,I+2))
- SX1 X1+J X1=(X(I+2,I+1))
- NE NM1,B0,[1]
- TMUTL ENDM
-*CD DIV
- RVDIV MACRO N,X,JX,Y,JY,Z,JZ,IFAIL
- LOCAL [1],[2],[3],[99]
- SA5 Y X5=Y(1)
- SA4 X X4=X(1)
- S_X X+JX X=(X(2))
- S_Y Y+JY Y=(Y(2))
- S_IFAIL 1 IFAIL=1
- ZR X5,[99] IF Y(1)=0.
- RX7 X4/X5 X7=X(1)/Y(1)
- EQ IFAIL,N,[2] IF N=1
- [1] BSS 0 FOR K = 0, 1, 2, ...
- SA5 Y X5=Y(K+2)
- SA4 X X4=X(K+2)
- S_X X+JX X=(X(K+3))
- S_Y Y+JY Y=(Y(K+3))
- S_IFAIL IFAIL+1 IFAIL=K+2
- ZR X5,[3] IF Y(K+2)=0.
- SA7 Z Z(K+1)=X(K+1)/Y(K+1)
- RX7 X4/X5 X7=X(K+2)/Y(K+2)
- S_Z Z+JZ Z=Z(K+2)
- LT IFAIL,N,[1]
- [2] S_IFAIL 0 IFAIL=0
- [3] SA7 Z Z(K+2)=X(K+2)/Y(K+2)
- [99] BSS 0
- RVDIV ENDM
-*CD FACT
- TFACT MACRO TYPE,SAVEA,SAVER,N,JA,TEMP7L,A1K,AKK,I,J,K X1=(A)
- LOCAL [1],[2],[3],[4],[99]
- LOCAL SAVEN,IFAIL,DET,JFAIL,NXCH,FLOAT1,TEMP2
- SAVEN EQU TEMP7L N
- IFAIL EQU SAVEN+1 IFAIL
- DET EQU IFAIL+1 DET
- JFAIL EQU DET+LENGTH JFAIL
- NXCH EQU JFAIL+1 NXCH
- FLOAT1 EQU NXCH+1 1.
- TEMP2 EQU FLOAT1+1
-* DET = ONE
-* JFAIL = 0
-* IFAIL = 0
-* NXCH = 0
- SX6 N X6=N
- MX7 0 X7=0
- SA6 SAVEN SAVEN=N
- SX5 1
- SA7 IFAIL IFAIL=0
- PX6 X5
- SA7 JFAIL JFAIL=0
- NX6 X6 X6=1.
- SA7 NXCH NXCH=0
- SA6 FLOAT1 FLOAT1=1.
- SA6 DET DET=1.
- TAU IFEQ LENGTH,2
- SA7 DET+1 DET''=0.
- TAU ENDIF
- S_K B0 K=0
- S_AKK X1 AKK=(A(1,1))
- S_A1K X1 A1K=(A(1,1))
- SX4 N X4=N
- [1] BSS 0 A1K=(A(1,K)) K=K-1
-* AKK=(A(K,K))
-* X4=N
- SX1 AKK X1=(A(K,K))
- S_N X4 RESTORE N
- TFACT1 TYPE,[2],SAVEA,SAVER,N,K,JA,NXCH,AKK,I,J X1=(A(K,K))
- S_AKK X1 AKK=(A(K,K))
- "P"1DET DET,JFAIL,FLOAT1,I,J X1=(A(K,K)) NOT PRESERVED
- S_J K+1 J=K
- SA1 SAVEA X1=(A(1,1))
- EQ J,N,[3] IF K=N
-* K=K-1
- TFACT2 SAVEN,SAVEA,N,K,A1K,AKK,JA,TEMP2,I,J
- SA4 SAVEN X4=N
- S_J JA+LENGTH J=IA+JA
- S_A1K A1K+JA A1K=(A(1,K+1))
- S_AKK AKK+J AKK=(A(K+1,K+1))
- JP [1]
-* IFAIL = -1
-* DET = ZERO
-* JFAIL = 0
- [2] BSS 0
- SX5 -1 X5=IFAIL=-1
- MX6 0 DET=ZERO
- TAU IFEQ LENGTH,2
- MX7 0
- TAU ENDIF
- MX0 0 X0=JFAIL=0
- JP [99]
-* R(N)=NXCH
-* IF(MOD(NXCH,2) .EQ. 1) DET = -DET
-* DE-SCALE DET
-* SET JFAIL = -1, 0, +1
-* LOAD IFAIL INTO X5
- [3] BSS 0
- SA1 NXCH X1=NXCH
- SA2 SAVER X2=(R(1))
- S_J N-1 J=N-1
- MX0 59 X0=777...776
- SA3 DET X3=DET
- TAU IFEQ LENGTH,2
- SA4 DET+1 X4=DET''
- TAU ENDIF
- BX6 X1 X6=NXCH
- BX0 -X0*X1 X0=MOD(NXCH,2)
- SA6 X2+J R(N)=NXCH
- ZR X0,[4] IF MOD(NXCH,2)=1 THEN
- BX3 -X3 DET=-DET
- TAU IFEQ LENGTH,2
- BX4 -X4
- TAU ENDIF
- [4] BSS 0 X3,X4=DET
- "P"2DET JFAIL,I,J X0=JFAIL, X6,X7=DET
- SA5 IFAIL X5=IFAIL
- [99] BSS 0 X0=JFAIL, X5=IFAIL, X6,X7=DET
- TFACT ENDM
- TFACT1 MACRO TYPE,SING,SAVEA,SAVER,N,K,JA,NXCH,IA,J,L
- LOCAL [99]
-* X1=(A(K,K))
-* K=K-1
-* CALL VMAXA(N-K+1,A(K,K),IA,R(K),1,L,P)
-* L' = L + (K-1)
-* IF(P .EQ. 0.) GOTO SING
-* IF(L' .EQ. K) GOTO 99
-* CALL VXCH(N,A(K,1),JA,A(L,1),JA)
-* NXCH = NXCH + 1
-* R(NXCH) = K*2**12 + L'
-* 99 CONTINUE
- S_IA LENGTH IA=1 OR 2
- S_K N-K K=N-(K-1)=N-K+1
- TAU IFEQ TYPE,CTYPE
- CVMAXA K,IA,A0,L,J X1=(A(K,K)), A0=L
- TAU ELSE
- RVMAXA K,IA,A0,L,J X1=(A(K,K)), A0=L
- TAU ENDIF X1 IS PRESERVED
- S_K N-K K=N-(N-K+1)=K-1
- SA5 SAVEA X5=(A(1,1))
- S_L A0-1 L=L-1
- ZR X6,SING IF P=0. GOTO SING
- ZR L,[99] IF L'=K GOTO 99
- SX0 X5+K X0=(A(1,1))+K-1=(A(K,1))
- TAU IFEQ LENGTH,2
- SX0 X0+K
- TAU ENDIF
- SA0 X0+L A0=(A(K,1))+L-1=A(L',1))
- TAU IFEQ LENGTH,2
- SA0 A0+L
- TAU ENDIF
- TAU IFEQ TYPE,RTYPE
- RVXCH N,X0,JA,A0,JA,J
- TAU ELSE
- DVXCH N,X0,JA,A0,JA,J
- TAU ENDIF
- SA4 NXCH X4=NXCH
- SA3 SAVER X3=(R(1))
- SX0 K+1 X0=K
- SX7 X0+L X7=K+L-1=L'
- LX0 12 X0=K**12
- BX7 X7+X0 X7=(K,L)
- SX6 X4+1 X6=NXCH+1
- IX0 X3+X4 X0=(R(1))+NXCH-1=(R(NXCH))
- SA6 A4 NXCH=NXCH+1
- SA7 X0 R(NXCH)=(K,L')
- [99] BSS 0
- TFACT1 ENDM
- TFACT2 MACRO SAVEN,SAVEA,N,K,A1K,AKK,JA,TEMP2,IA,J
- LOCAL [1]
-* X1=(A(1,1))
-* K=K-1
-* IF(K .EQ. 1) GOTO 1
-* CALL MMNA(N-K,K-1,A(1,K+1),JA,IA,A(K,1),JA,A(K,K+1),JA)
-* 1 CALL VSCL(N-K,A(K,K),A(K,K+1),JA,A(K,K+1),JA)
-* CALL MMNA(N-K,K,A(K+1,1),IA,JA,A(1,K+1),IA,A(K+1,K+1),IA)
- S_IA LENGTH IA=1 OR 2
- ZR K,[1] IF K=1
- S_J K+1 J=K
- SA0 AKK+JA A0=(A(K,K+1))
- S_N N-J N=N-K
- SX2 X1+K X2=(A(1,1))+K-1=(A(K,1))
- TAU IFEQ LENGTH,2
- SX2 X2+K
- TAU ENDIF
- SX1 A1K+JA X1=(A(1,K+1))
-* X1=(A(1,K+1))
-* X2=(A(K,1))
-* A0=(A(K,K+1))
- "P"MMPY "MINUS",N,K,JA,IA,JA,"PLUS",A0,JA,TEMP2,J
- [1] BSS 0
- SA5 SAVEN X5=N
- SA1 AKK X1=A(K,K)
- TAU IFEQ LENGTH,2
- SA2 AKK+1 X2=A''(K,K)
- TAU ENDIF
- SA0 AKK+JA A0=(A(K,K+1))
- S_K K+1 K=(K-1)+1=K
- S_J -K J=-K
- S_N X5+J N=N-K
- "P"VSCL N,A0,JA,A0,JA,J X1=A(K,K) [X2=A''(K,K)]
- SA1 SAVEA X1=(A(1,1))
- SA0 AKK+IA A0=(A(K+1,K))
- SX2 A1K+JA X2=(A(1,K+1))
- SA0 A0+JA A0=(A(K+1,K+1))
- SX1 X1+K X1=(A(1,1))+K=(A(K+1,1))
- TAU IFEQ LENGTH,2
- SX1 X1+K
- TAU ENDIF
-* N=N-K
-* X1=(A(K+1,1))
-* X2=(A(1,K+1))
-* A0=(A(K+1,K+1))
- "P"MMPY "MINUS",N,K,IA,JA,IA,"PLUS",A0,IA,TEMP2,J
- TFACT2 ENDM
-*CD DET
- R1DET MACRO DET,JFAIL,FLOAT1,I,J X1=(A(K,K))
-* DET = AKK*DET
-* AKK = 1./AKK
- + SA1 X1 0 X1=AKK A1=(AKK)
- SA5 FLOAT1 1 X5=1.
- NO 2
- + SA3 DET 3 X3=DET A3=(DET)
- SA4 JFAIL 4 X4=JFAIL A4=(JFAIL)
-* 5
-* 6
-* 7 X1
-* 8 X5
- + RX6 X5/X1 9 X6=1./AKK
-* 10 X3
- RX3 X1*X3 11 X4 X3=AKK*DET=DET
-* 12
-* 13
-* 14
-* 15 X3
- UX3 X3,I 16 X3=MANT I=EXP
-* 17 X3
- PX7 X3,B0 18 X7=SCALED DET
- + SX0 -I 19 X7 X0=-EXP
- SA7 A3 20 X0 STORE SCALED DET
- IX7 X4-X0 21 X7=JFAIL+EXP=JFAIL
-* 22 X7
- SA7 A4 23 STORE NEW JFAIL
- SA6 A1 29 AKK=1./AKK
- R1DET ENDM
- R2DET MACRO JFAIL,I,J X3=DET
- LOCAL [1],[2],[99]
-* ADD JFAIL INTO EXPONENT OF DET
-* SET JFAIL = -1, 0, OR +1
- SA5 JFAIL X5=JFAIL
- UX3 X3,I X3=MANT I=EXP
- SX0 1023 X0=1023
- SX1 I X1=SCALED EXP
- IX1 X1+X5 X1=TRUE EXP
- IX6 X1-X0 X6=EXP-1023
- IX7 X1+X0 X7=EXP+1023
- PL X6,[1] IF EXP .GE. 1023 OVERFLOW
- PL X7,[2] IF EXP .GE. -1023 IN RANGE
- SX0 -1 JFAIL=-1
- MX6 0 DET=ZERO
- JP [99]
- [1] SX0 1 JFAIL=+1
- MX6 0 DET=ZERO
- JP [99]
- [2] BSS 0
- S_I X1 I=EXPONENT
- MX0 0 JFAIL=0
- PX6 X3,I X6=TRUE DET
- [99] BSS 0 X0=JFAIL, X6=DET
- R2DET ENDM
- D1DET MACRO DET,JFAIL,FLOAT1,I,J X1=(A(K,K))
- SA5 X1 X5=AKK' A5=(AKK')
- SA4 FLOAT1 X4=1.
- SA3 A5+1 X3=AKK'' A3=(AKK'')
- SA2 DET X2=DET' A2=(DET')
- SA1 DET+1 X1=DET'' A1=(DET'')
- FX0 X4/X5 X0=1./AKK'
- FX7 X2*X3 X7=DET'*AKK''
- FX1 X1*X5 X1=DET''*AKK'
- DX6 X2*X5 X6=L(DET'*AKK')=B''
- FX2 X2*X5 X2=DET'*AKK'=B'
- FX7 X1+X7 X7=DET''*AKK'+DET'*AKK''=C'
- FX1 X6+X7 X1=B''+C'
- FX6 X1+X2 X6=B''+C'+B'=DET'
- DX7 X1+X2 X7=L(B''+C'+B')=DET''
- FX2 X0*X5 X2=(1/AKK')*AKK'=R'
- DX1 X0*X5 X1=L(1/AKK')*AKK'=R''
- UX7 X7,J X7=MANT'' J=EXP''
- UX6 X6,I X6=MANT' I=EXP'
- S_J J-I REDUCE EXPONENTS BY I
- PX6 X6,B0
- PX7 X7,J
- SA6 A2 STORE SCALED DET
- SA7 A1
- FX7 X4-X2 X7=1-R'=S'
- DX4 X4-X2 X4=L(1-R')=S''
- FX2 X0*X3 X2=(1/AKK')*AKK''
- NX3 X7 X3=S'
- FX7 X3+X4 X7=S'+S''=T'
- FX4 X7-X1 X4=T'-R''
- FX7 X4-X2 X7=T'-R''-(1/AKK')*AKK''=U'
- FX3 X7/X5 X3=U'/AKK'
- SA4 JFAIL X4=JFAIL
- SX2 -I X2=-EXP'
- IX7 X4-X2 X7=JFAIL+EXP'
- SA7 A4 JFAIL=JFAIL+EXP'
- FX7 X3+X0
- DX5 X3+X0
- NX0 X7
- DX7 X0+X5
- FX6 X0+X5
- SA7 A3
- SA6 A5
- D1DET ENDM
- D2DET MACRO JFAIL,I,J X3,X4=DET
- LOCAL [1],[2],[99]
-* ADD JFAIL INTO EXPONENT OF DET
-* SET JFAIL = -1, 0, OR +1
- SA5 JFAIL X5=JFAIL
- UX3 X3,I X3=MANT I=EXP
- UX4 X4,J X4=MANT'' J=EXP''
- SX0 1023 X0=1023
- SX1 I X1=SCALED EXP
- SX2 J X2=SCALED EXP''
- IX1 X1+X5 X1=TRUE EXP
- IX2 X2+X5 X2=TRUE EXP''
- IX6 X1-X0 X6=EXP-1023
- IX7 X2+X0 X7=EXP''+1023
- PL X6,[1] IF EXP .GE. 1023 OVERFLOW
- PL X7,[2] IF EXP .GE. -1023 IN RANGE
- SX0 -1 JFAIL=-1
- MX6 0 DET=ZERO
- MX7 0
- JP [99]
- [1] SX0 1 JFAIL=+1
- MX6 0 DET=ZERO
- MX7 0
- JP [99]
- [2] S_I X1 I=EXPONENT
- S_J X2 J=EXPONENT''
- MX0 0 JFAIL=0
- PX6 X3,I X6=TRUE DET
- PX7 X4,J X7=TRUE DET''
- [99] BSS 0 X0=JFAIL, X6,X7=DET
- D2DET ENDM
- C1DET MACRO DET,JFAIL,FLOAT1,I,J X1=(A(K,K))
- LOCAL [1],[2],[3]
- SA2 X1+1 0 X2=AKK'' A2=(AKK'')
- SA3 DET 1 X3=DET' A3=(DET')
- SA1 X1 2 X1=AKK' A1=(AKK')
- SA4 DET+1 3 X4=DET'' A4=(DET'')
- NO 4
-* 5
-* 6
-* 7 X2
- + RX6 X2*X2 8 X3 X6=AKK''**2
- SA5 FLOAT1 9 X1 X5=1.
- RX0 X1*X1 10 X4 X0=AKK'**2
-* 11
-* 12 X6
- + RX7 X1*X4 13 X7=AKK'*DET''
-* 14 X0
- RX0 X0+X6 15 X0=(AKK'**2+AKK''**2)
- RX4 X2*X4 16 X5 X4=AKK''*DET''
-* 17 X7
- RX6 X1*X3 18 X0 X6=AKK'*DET'
- + NX0 X0 19
- RX3 X2*X3 20 X4 X3=AKK''*DET'
-* 21 X0
- RX0 X5/X0 22 X6 X0=1./(...)
- RX6 X6-X4 23 X6=AKK'*DET'-AKK''*DET''=DET'
- + SA5 JFAIL 24 X3 X5=JFAIL A5=(JFAIL)
- RX7 X7+X3 25 X7=AKK'*DET''+AKK''*DET'=DET''
-* 26 X6
- NX6 X6 27
-* 28 X7
-* 29 X6
- + NX7 X7 30
-* 31 X5
- UX3 X6,I 32 X7 X3=MANT' I=EXP'
- UX4 X7,J 33 X3 X4=MANT'' J=EXP''
- SX7 -I 34 X4 X7=-EXP'
- + NO 35 X7
-* 36
- GT I,J,[1] 37
- SX7 -J 38 X7=-MAX(EXP',EXP'')
-* 39 X7
-* 40
- [1] IX6 X5-X7 41 X0 X6=JFAIL+MAX(EXP',EXP'')
- RX2 X2*X0 42 X6 X2=AKK''/(...)
- SA6 A5 43 JFAIL=JFAIL+MAX(EXP',EXP'')
- RX6 X1*X0 44 X6=AKK'/(...)
- + S_I X7+I 45 I=EXP'-MAX(EXP',EXP'').LE.0
- S_J X7+J 46 X2 J=EXP''-MAX(EXP',EXP'').LE.0
- NO 47
- BX7 -X2 48 X6 X7=-AKK''/(...)=(1./AKK)''
- + SA6 A1 49 X7 AKK'=(1./AKK)'
- SA7 A2 50 AKK''=(1./AKK)''
- MX6 0 51 IF I<-1023 THEN DET'=0.
- MX7 0 52 X6 IF J<-1023 THEN DET''=0.
- + SX0 I+1023 53 X7
- MI X0,[2]
- PX6 X3,I X6=DET'
- [2] SX0 J+1023
- MI X0,[3]
- PX7 X4,J X7=DET''
- [3] SA6 A3 STORE SCALED DET'
- SA7 A4 STORE SCALED DET''
- C1DET ENDM
- C2DET MACRO JFAIL,I,J X3,X4=DET
- LOCAL [1],[2],[3],[99]
-* ADD JFAIL INTO EXPONENT OF DET
-* SET JFAIL = -1, 0, OR +1
- SA5 JFAIL X5=JFAIL
- UX3 X3,I X3=MANT I=EXP
- UX4 X4,J X4=MANT'' J=EXP''
- SX0 1023 X0=1023
- SX1 I X1=SCALED EXP
- SX2 J X2=SCALED EXP''
- IX1 X1+X5 X1=TRUE EXP
- IX2 X2+X5 X2=TRUE EXP''
- IX6 X1-X0 X6=EXP-1023
- IX7 X2-X0 X7=EXP''-1023
- PL X6,[1] IF EXP .GE. 1023 OVERFLOW
- PL X7,[1] IF EXP'' .GE. 1023 OVERFLOW
- IX6 X1+X0 X6=EXP+1023
- IX7 X2+X0 X7=EXP''+1023
- PL X6,[2] IF EXP .GE. -1023 IN RANGE
- BX1 -X0 ELSE EXP=-1023
- PL X7,[3] IF EXP'' .GE. -1023 IN RANGE
- SX0 -1 JFAIL=-1
- MX6 0 DET=ZERO
- MX7 0
- JP [99]
- [1] SX0 1 JFAIL=+1
- MX6 0 DET=ZERO
- MX7 0
- JP [99]
- [2] PL X7,[3]
- BX2 -X0 EXP''=-1023
- [3] S_I X1 I=EXPONENT
- S_J X2 J=EXPONENT''
- MX0 0 JFAIL=0
- PX6 X3,I X6=TRUE DET
- PX7 X4,J X7=TRUE DET''
- [99] BSS 0 X0=JFAIL, X6,X7=DET
- C2DET ENDM
-*CD FEQN
- TFEQN MACRO TYPE,SAVEA,N,JA,K,B,TEMP1,I,J,L X1=(A), X3=(R)
- LOCAL [1]
- S_J N-1 J=N-1
- S_I 1 I=1=JR
- SA5 X3+J X5=R(N)
- SX7 LENGTH X7=IA
- SA0 X3 A0=(R(1))
- ZR X5,[1] IF NO TRANSPOSITIONS
- S_L X5 L=R(N)= NO. OF TRANSPOS.
- SUBST TYPE,K,B,JA,L,A0,I,TEMP1,J X7=IA=LENGTH
- SA1 SAVEA X1=(A)
- [1] BSS 0 X1=(A)
- S_L LENGTH L=IA
- SA0 X1 A0=(A)
- "P"FEQN N,A0,L,JA,K,B,I,J
- TFEQN ENDM
- RFEQN MACRO N,A,IA,JA,K,B,I,J
- LOCAL [1],[2],[3],[4],[99]
- SA4 A X4=A(1,1) A4=(A(1,1))
- SA5 B X5=B(1,1) A5=(B(1,1))
- [1] BSS 0 X4=A(1,1) A4=(A(1,1))
-* X5=B(1,L) A5=(B(1,L))
- RX6 X4*X5 X6=A(1,1)*B(1,L)
- S_I 1 I=1
- SA6 A5 A6=(B(1,L))
- EQ I,N,[4] IF N=1
- [2] S_A A+IA A=(A(I+1,1))
- SX5 A6+IA X5=(B(I+1,1))
- RVMPY "MINUS",I,A,JA,B,IA,"PLUS",X5,J
-* A4=(A(I+1,I))
-* A5=(B(I,L))
- SA4 A4+JA X4=A(I+1,I+1) A4=(A(I+1,I+1))
- S_I I+1 I=I+1
- RX6 X6*X4 X6=B(I+1,L)
- SA6 A5+IA A6=(B(I+1,L))
- LT I,N,[2] IF I<N
- S_IA -IA IA=-1
- S_JA -JA JA=-IDIM
- S_B A6 B=(B(N,L))
- S_I 1 I=1
- S_A A4 A=(A(N,N))
- [3] S_A A+IA A=(A(N-I,N))
- SX5 A6+IA X5=(B(N-1,L))
- RVMPY "MINUS",I,A,JA,B,IA,"PLUS",X5,J
- S_I I+1 I=I+1
- SA6 A5+IA A6=(B(N-I,L))
- LT I,N,[3] IF I<N
-* A4=(A(1,2))
- S_A A4+JA A=(A(1,1))
- S_IA -IA IA=1
- S_JA -JA JA=IDIM
- S_B A6 B=(B(1,L))
- [4] S_K K-1 K=K-1
- S_B B+JA B=(B(1,L+1))
- ZR K,[99] IF L<K
- SA4 A X4=A(1,1) A4=(A(1,1))
- SA5 B X5=B(1,L+1) A5=(B(1,L+1))
- JP [1]
- [99] BSS 0
- RFEQN ENDM
- DFEQN MACRO N,A,IA,JA,K,B,I,J
- LOCAL [1],[2],[3],[4],[99]
- SA2 A X2=A'(1,1) A2=(A(1,1))
- SA4 B X4=B'(1,1) A4=(B(1,1))
- SA3 A2+1 X3=A''(1,1)A3=(A''(1,1))
- SA5 A4+1 X5=B''(1,1)A5=(B''(1,1))
- [1] BSS 0 A2=(A(1,1))
-* A4=(B(1,L))
- FX0 X3*X4 X0=A''*B'
- DX1 X2*X4 X1=L(A'*B')
- FX7 X2*X5 X7=A'*B''
- FX1 X1+X0 X1=L(A'*B')+A''*B'
- FX6 X2*X4 X6=A'*B'
- FX1 X1+X7 X1=L(A'*B')+A''*B'+A'*B''
- DX7 X1+X6
- FX6 X1+X6
- S_I 1 I=1
- SA7 A4+1
- SA6 A4 A6=(B(1,L))
- EQ I,N,[4] IF N=1
- [2] S_A A+IA A=(A(I+1,1))
- SX5 A6+IA X5=(B(I+1,1))
- DVMPY "MINUS",I,A,JA,B,IA,"PLUS",X5,J
-* A2=(A(I+1,I))
-* A4=(B(I,L))
- SA2 A2+JA X2=A(I+1,I+1)
- SA3 A3+JA X3=A''(I+1,I+1)
- S_I I+1 I=I+1
- FX0 X3*X6
- DX1 X2*X6
- FX7 X2*X7
- FX1 X1+X0
- FX6 X2*X6
- FX1 X1+X7
- DX7 X1+X6
- FX6 X1+X6
- SA7 A5+IA
- SA6 A4+IA A6=(B(I+1,L))
- LT I,N,[2] IF I<N
- S_IA -IA IA=-1
- S_JA -JA JA=-IDIM
- S_B A6 B=(B(N,L))
- S_I 1 I=1
- S_A A2 A=(A(N,N))
- [3] S_A A+IA A=(A(N-I,N))
- SX5 A6+IA X5=(B(N-1,L))
- DVMPY "MINUS",I,A,JA,B,IA,"PLUS",X5,J
- S_I I+1 I=I+1
- SA6 A4+IA A6=(B(N-I,L))
- SA7 A5+IA
- LT I,N,[3] IF I<N
-* A2=(A(1,2))
- S_A A2+JA A=(A(1,1))
- S_IA -IA IA=1
- S_JA -JA JA=IDIM
- S_B A6 B=(B(1,L))
- [4] S_K K-1 K=K-1
- S_B B+JA B=(B(1,L+1))
- ZR K,[99] IF L<K
- SA2 A X2=A'(1,1)
- SA4 B X4=B'(1,L+1)
- SA3 A2+1 X3=A''(1,1)
- SA5 A4+1 X5=B''(1,L+1)
- JP [1]
- [99] BSS 0
- DFEQN ENDM
-CFEQN MACRO N,A,IA,JA,K,B,I,J
- LOCAL [1],[2],[3],[4],[99]
- SA3 B X3=B'(1,1) A3=(B(1,1))
- SA1 A X1=A'(1,1) A1=(A(1,1))
- SA4 A3+1 X4=B''(1,1)A4=(B''(1,1))
- SA2 A1+1 X2=A''(1,1)A2=(A''(1,1))
- SA5 1 X5=VOID A5=1
- [1] BSS 0 A1=(A(1,1))
-* A3=(B(1,L))
- RX6 X1*X3 X6=A'*B'
- RX7 X1*X4 X7=A'*B''
- RX4 X2*X4 X4=A''*B''
- RX2 X2*X3 XX2=A''*B'
- RX6 X6-X4 X6=A'*B'-A''*B''
- RX7 X7+X2 X7=A'*B''+A''*B'
- S_I 1 I=1
- NX6 X6
- NX7 X7
- SA6 A3 A6=(B(1,L))
- SA7 A3+1
- EQ I,N,[4] IF N=1
- [2] S_A A+IA A=(A(I+1,1))
- SX5 A6+IA X5=(B(I+1,1))
- CVMPY "MINUS",I,A,JA,B,IA,"PLUS",X5,J
-* A1=(A(I+1,I))
-* A3=(B(I,L))
- SA1 A1+JA X1=A(I+1,I+1)
- SA2 A2+JA X2=A''(I+1,I+1)
- S_I I+1 I=I+1
- RX3 X6*X1 X3=S'*A'
- RX0 X7*X2 X0=S''*A''
- RX4 X7*X1 X4=S''*A'
- RX5 X6*X2 X5=S'*A''
- RX6 X3-X0 X6=S'*A'-S''*A''
- RX7 X4+X5 X7=S''*A'+S'*A''
- NX6 X6
- NX7 X7
- SA6 A3+IA A6=(B(I+1,L))
- SA7 A4+IA
- LT I,N,[2] IF I<N
- S_IA -IA IA=-1
- S_JA -JA JA=-IDIM
- S_B A6 B=(B(N,L))
- S_I 1 I=1
- S_A A1 A=(A(N,N))
- [3] S_A A+IA A=(A(N-I,N))
- SX5 A6+IA X5=(B(N-1,L))
- CVMPY "MINUS",I,A,JA,B,IA,"PLUS",X5,J
- S_I I+1 I=I+1
- SA6 A3+IA A6=(B(N-I,L))
- SA7 A4+IA
- LT I,N,[3] IF I<N
-* A1=(A(1,2))
- S_A A1+JA A=(A(1,1))
- S_IA -IA IA=1
- S_JA -JA JA=IDIM
- S_B A6 B=(B(1,L))
- [4] S_K K-1 K=K-1
- S_B B+JA B=(B(1,L+1))
- ZR K,[99] IF L<K
- SA3 B X3=B(1,L+1)
- SA1 A X1=A(1,1)
- SA4 A3+1 X4=B''(1,L+1)
- SA2 A1+1 X2=A''(1,1)
- JP [1]
- [99] BSS 0
-CFEQN ENDM
-*CD SUBST
- SUBST MACRO TYPE,N,X,JX,L,R,JR,TEMP1,J X7=IX
- LOCAL [1],FLOATIX
- FLOATIX EQU TEMP1
- PX7 X7,B0 X7=FLOAT(IX)
- SA7 FLOATIX FLOATIX=FLOAT(IX)
- BX5 X7 X5=FLOAT(IX)
- [1] SA3 R X3=(...J,K)
- MX6 48 X6=11...10000
- BX1 -X6*X3 X1=K
- LX3 48 X3=(K...J)
- SX1 X1-1 X1=K-1
- BX0 -X6*X3 X0=J
- PX1 X1,B0 X1=FLOAT(K-1)
- SX0 X0-1 X0=J-1
- DX1 X1*X5 X1=(K-1)*IX
- PX0 X0,B0 X0=FLOAT(J-1)
- DX0 X0*X5 X0=(J-1)*IX
- SX1 X1+X X1=(X(K,1))
- SX0 X0+X X0=(X(J,1))
- TAU IFEQ TYPE,CTYPE
- DVXCH N,X0,JX,X1,JX,J
- TAU ELSE
- "P"VXCH N,X0,JX,X1,JX,J
- TAU ENDIF
- SA5 FLOATIX X5=FLOAT(IX)
- S_L L-1 L=L-1
- S_R R+JR
- NZ L,[1] IF L>0
- SUBST ENDM
-*CD FINV
- TFINV MACRO TYPE,SAVEA,SAVER,N,JA,TEMP4,IA,I,J,K,L X1=(A) X3=(R)
- LOCAL [99]
- S_IA LENGTH IA=LENGTH
- TFINV1 SAVEA,N,IA,JA,TEMP4,I,J,K,L X1=(A)
- TFINV2 N,IA,JA,TEMP4,I,J,K,L X1=(A)
- TFINV3 N,IA,JA,TEMP4,I,J,K,L X1=(A)
- SA3 SAVER X3=(R(1))
- SA1 SAVEA X1=(A(1,1))
- SX5 X3+N X5=(R(N))+1
- SA5 X5-1 X5=R(N)=L
- S_I X1 I=(A)
- SX7 JA X7=JA
- S_JA -1 JA=-1=JR
- ZR X5,[99] IF NO TRANSPOSITIONS
- S_K X5-1 K=L-1
- S_L X5 L=L
- S_K X3+K K=(R(L))
- SUBST TYPE,N,I,IA,L,K,JA,TEMP4,J X7=JA
- [99] BSS 0
- TFINV ENDM
- TFINV1 MACRO SAVEA,N,IA,JA,TEMP3,AI1,AII,J,K X1=(A)
- LOCAL [1],SAVEK,TEMP2
- SAVEK EQU TEMP3
- TEMP2 EQU TEMP3+1
-* DO 10 K = 1, N-1
-* I = K + 1
-* CALL UMPY(K,A11,A21,A22,A(I,1),A(I,2),A(I,1),A(I,2))
-* CALL VSCL(K,-A(I,I),A(I,1),A(I,2),A(I,1),A(I,2))
-* 10 CONTINUE
- S_AI1 X1+IA AI1=(A21)=(A(I,1))
- S_K 1 K=1
- S_AII AI1+JA AII=(A22)=(A(I,I))
- [1] BSS 0
- SX7 K X7=K
- SX2 AI1 X2=(A(I,1))
- SA7 SAVEK SAVEK=K
- SA0 AI1 A0=(A(I,1))
- "P"UMPY "PLUS",K,JA,IA,JA,"NULL",A0,JA,TEMP2,J
- SA1 AII X1=A(I,I)
- TAU IFEQ LENGTH,2
- SA2 AII+1
- TAU ENDIF
- SA3 SAVEK X3=K
- BX1 -X1
- TAU IFEQ LENGTH,2
- BX2 -X2
- TAU ENDIF
- S_K X3
- "P"VSCL K,AI1,JA,AI1,JA,J X1=-A(I,I), [X2=-A''(I,I)]
- S_AII AII+IA AII=(A(I+1,I))
- S_AI1 AI1+IA AI1=(A(I+1,1))
- S_AII AII+JA AII=(A(I+1,I+1))
- S_K K+1 K=K+1
- SA1 SAVEA X1=(A11)
- LT K,N,[1] IF K<N
- TFINV1 ENDM
- TFINV2 MACRO N,IA,JA,TEMP4,A1I,AII,J,K X1=(A)
- LOCAL [1],[99],SAVEA12,SAVEI,TEMP2
- SAVEA12 EQU TEMP4
- SAVEI EQU TEMP4+1
- TEMP2 EQU TEMP4+2
-* A12 = -A12
-* IF(N .EQ. 2) GOTO 30
-* DO 20 I = 3,N
-* K = I - 2
-* CALL UMNS(K,A12,A13,A23,A(2,I),A(3,I),A(1,I),A(2,I))
-* A(I-1,I) = -A(I-1,I)
-* 20 CONTINUE
-* 30 CONTINUE
- SX0 N-2 X0=N-2
- SA4 X1+JA X4=A12 A4=(A(1,2))
- TAU IFEQ LENGTH,2
- SA5 A4+1
- TAU ENDIF
- BX6 -X4 X6=-A12
- TAU IFEQ LENGTH,2
- BX7 -X5
- TAU ENDIF
- SA6 A4 A12=-A12
- TAU IFEQ LENGTH,2
- SA7 A5
- TAU ENDIF
- ZR X0,[99] IF (N=2) X1=(A)
- SX1 X1+JA X1=(A12)
- S_J 3 J=I
- S_A1I X1+JA A1I=(A13)
- BX7 X1 X7=(A12)
- S_AII A1I+IA AII=(A23)
- SA7 SAVEA12 SAVEA12=(A12)
- S_AII AII+IA AII=(A33)
- [1] BSS 0 X1=(A12) J=I
- SX6 J X6=I
- SX2 A1I+IA X2=(A(2,I))
- SA6 SAVEI SAVEI=I
- S_K J-2 K=I-2
- SA0 A1I A0=(A(1,I))
- "P"UMPY "MINUS",K,IA,JA,IA,"MINUS",A0,IA,TEMP2,J
- SA4 AII-IA X4=A(I-1,I)
- SA3 SAVEI X3=I
- TAU IFEQ LENGTH,2
- SA5 A4+1
- TAU ENDIF
- S_AII AII+JA AII=(A(I,I+1))
- S_A1I A1I+JA A1I=(A(1,I+1))
- S_AII AII+IA AII=(A(I+1,I+1))
- BX6 -X4 X6=-A(I-1,I)
- TAU IFEQ LENGTH,2
- BX7 -X5
- TAU ENDIF
- SA6 A4 A(I-1,I)=-A(I-1,I)
- TAU IFEQ LENGTH,2
- SA7 A5
- TAU ENDIF
- S_J X3+1 J=I+1
- SA1 SAVEA12 X1=(A(1,2))
- LE J,N,[1] IF I .LE. N
- S_J -JA J=-JA
- SX1 X1+J X1=(A(1,1))
- [99] BSS 0 X1=(A)
- TFINV2 ENDM
- TFINV3 MACRO N,IA,JA,TEMP4,AI1,AII,I,J X1=(A)
- LOCAL [1],SAVEN,SAVEI,TEMP2
- SAVEN EQU TEMP4
- SAVEI EQU TEMP4+1
- TEMP2 EQU TEMP4+2
-* DO 40 I = 1, N-1
-* CALL MMPA(I,N-I,A(I+1,1),A(I+2,1),A(I+1,2),
-* A(I,I+1),A(I,I+2),A(I,1),A(I,2))
-* CALL UMPY(N-I,A(I+1,I+1),A(I+2,I+1),A(I+2,I+2),
-* A(I,I+1),A(I,I+2),A(I,I+1),A(I,I+2))
-* 40 CONTINUE
- SX7 N X7=N
- SX3 1 X3=1=I
- SA7 SAVEN SAVEN=N
- S_N N-1 N=N-1=N-I
- S_AI1 X1 AI1=(A11)
- S_AII X1 AII=(A11)
- [1] BSS 0
- SX7 X3+1 X7=I+1
- S_I X3 I=I
- SA7 SAVEI SAVEI=I+1
- SX1 AI1+IA X1=(A(I+1,1))
- SX2 AII+JA X2=(A(I,I+1))
- SA0 AI1 A0=(A(I,1))
- "P"MMPY "PLUS",I,N,JA,IA,JA,"PLUS",A0,JA,TEMP2,J
- S_I N I=N-I
- SX2 AII+JA X2=(A(I,I+1))
- SA0 AII+JA A0=(A(I,I+1))
- SX1 X2+IA X1=(A(I+1,I+1))
- S_AI1 AI1+IA AI1=(A(I+1,1))
- S_AII X1 AII=(A(I+1,I+1))
- "P"UMPY "PLUS",I,JA,IA,JA,"NULL",A0,JA,TEMP2,J
- S_N N-1 N=N-I-1
- SA3 SAVEI X3=I+1
- NZ N,[1] IF NEXT N-I>0
- SA5 SAVEN X5=N
- S_N X5 RESTORE N
- TFINV3 ENDM
-*CD TMPRNT
- TMPRNT MACRO HVALUE,N,IDIM,K
- LOCAL ARGLIST,NVALUE,IVALUE,KVALUE
- EXT TMPRNT
- SX6 N X6=N
- SX7 IDIM X7=IDIM
- SA6 NVALUE NVALUE=N
- SX6 K X6=K
- SA7 IVALUE IVALUE=IDIM
- SA6 KVALUE KVALUE=K
- SA1 ARGLIST
- + RJ TMPRNT CALL TMPRNT(H,N,IDIM,K)
- - VFD 12/0,18/TWORD
- JP EPILOG
- ARGLIST BSS 0 TMPRNT ARGUMENT LIST
- VFD 30/4,30/HVALUE
- VFD 60/NVALUE
- VFD 60/IVALUE
- VFD 60/KVALUE
- BSSZ 1
- NVALUE BSS 1
- IVALUE BSS 1
- KVALUE BSS 1
- TMPRNT ENDM
-*CD LSQ
- RLLSQ MACRO JX,JY,J J=2-N
- LOCAL [1]
- [1] BSS 0 FOR K = 0, 1, 2,...
- + NX6 X6 0 X5 X6=SX(1+K)
- RX2 X4*X4 1 X2=X(2+K)**2
- NX7 X7 2 X6 X7=SY(1+K)
- RX3 X4*X5 3 X3=X(2+K)*Y(2+K)
- + NX0 X0 4 X7 X0=SXX(1+K)
- RX6 X6+X4 5 X2 X6=SX(1+K)+X(2+K)
- SA4 A4+JX 6 X0 X4=X(3+K)
- NX1 X1 7 X3 X1=SXY(1+K)
- + RX7 X7+X5 8 X6 X7=SY(1+K)+Y(2+K)
- SA5 A5+JY 9 X1 X5=Y(3+K)
- S_J J+1 10 J=2-N+K+1
- + RX0 X0+X2 11 X7 X0=SXX(1+K)+X(2+K)**2
- RX1 X1+X3 12 X1=SXY(1+K)+X(2+K)*Y(2+K)
-* 13 X4
-* 14 X0
- MI J,[1] 15 X1 WHILE 3-N+K<0; I.E. 4+K .LE. N
- RLLSQ ENDM X6=SX(N-1) ETC J=0
- RVLLSQ MACRO FAIL,N,X,JX,Y,JY,J N>1
- LOCAL [1]
- SA4 X X4=X(1) A4=(X(1))
- SA5 Y X5=Y(1) A5=(Y(1))
- S_J 2
- S_J J-N J=2-N
- RX0 X4*X4 X0=X(1)**2=SXX(1)
- BX6 X4 X6=X(1)=SX(1)
- RX1 X4*X5 X1=X(1)*Y(1)=SXY(1)
- SA4 A4+JX X4=X(2) A4=(X(2))
- BX7 X5 X7=Y(1)=SY(1)
- SA5 A5+JY X5=Y(2) A5=(Y(2))
- PL J,[1] IF N=2
- RLLSQ JX,JY,J
- [1] NX6 X6 X6=SX(N-1)
- RX2 X4*X4 X2=X(N)**2
- NX7 X7 X7=SY(N-1)
- RX3 X4*X5 X3=X(N)*Y(N)
- NX0 X0 X0=SXX(N-1)
- RX6 X6+X4 X6=SX(N-1)+X(N)
- NX1 X1 X1=SXY(N-1)
- RX7 X7+X5 X7=SY(N-1)+Y(N)
- RX0 X0+X2 X0=SXX(N-1)+X(N)**2
- RX1 X1+X3 X1=SXY(N-1)+X(N)*Y(N)
- NX6 X6 X6=SX(N)
- NX7 X7 X7=SY(N)
- NX0 X0 X0=SXX(N)
- NX1 X1 X1=SXY(N)
- SX4 N X4=N
- SX5 -1 X5=-1
- PX4 X4
- PX5 X5
- NX4 X4 X4=FLOAT(N)
- RX2 X6*X6 X2=SX**2
- NX5 X5 X5=-1.
- RX3 X4*X0 X3=FLOAT(N)*SXX
- RX4 X4*X1 X4=FLOAT(N)*SXY
- RX1 X1*X6 X1=SXY*SX
- RX2 X2-X3 X2=-N*SXX+SX**2=-DET
- RX3 X7*X6 X3=SY*SX
- RX6 X7*X0 X6=SY*SXX
- NX2 X2
- PL X2,FAIL IF DET .LE. 0.
- RX5 X5/X2 X5=-1./(-DET)
- RX3 X4-X3 X3=N*SXY-SY*SX=DET2
- RX6 X6-X1 X6=SY*SXX-SXY*SX=DET1
- NX7 X3 X7=DET2
- NX6 X6 X6=DET1
- RX6 X6*X5 X6=DET1/DET=C1
- RX7 X7*X5 X7=DET2/DET=C2
- RVLLSQ ENDM X6=C1, X7=C2
- RLSQXY MACRO J,ONE X1=X J=2-M
- LOCAL [1]
- [1] BSS 0 FOR K = 0, 1, 2,...
- + NX6 X6 0 X4 X6=S(1+K)
- RX2 X2*X1 1 X2=X**(1+K)
- NX7 X7 2 X6 X7=T(1+K)
- RX3 X3*X1 3 X5 X3=Y*X**(1+K)
- + SA6 A4-ONE 4 X7 B(1+K,1)=S(1+K)
- S_J J+1 5 X2 J=2-M+K+1
- RX6 X4+X2 6 X6=S(2+K)+X**(1+K)
- + SA4 A4+ONE 7 X3 X4=S(3+K) A4=(B(3+K,1))
- SA7 A5-ONE 8 C(1+K)=T(1+K)
- RX7 X5+X3 9 X6 X7=T(2+K)+Y*X**(1+K)
- SA5 A5+ONE 10 X5=T(3+K) A5=(C(3+K))
-* 11
-* 12 X7
- + MI J,[1] 13 WHILE 3-M+K<0; I.E. 4+K .LE. M
- RLSQXY ENDM J=0
- RLSQX MACRO J,ONE
- LOCAL [1]
- [1] BSS 0 FOR K = 0, 1, 2,...
- + SA6 A6+IDIMPAR X4 B(M,2+K)=B(M,2+K)+X**(M+K)
- RX6 X4+X2 1 X6=B(M,3+K)+X**(M+1+K)
- S_J J+ONE 2 J=J+1
- SA4 A4+IDIMPAR X4=B(M,4+K)
- RX2 X2*X1 4 X6 X2=X**(M+2+K)
- NX6 X6 5
-* 6
-* 7 X6
- MI J,[1] 8 X2 WHILE J<0
-* 9
- RLSQX ENDM
- RLSQM MACRO M,B,IB,JB,I,J,K B=(B(1,1)), I=(B(M,M))
- LOCAL [1],[2]
- SX0 B+IB X0=(B(2,1))
- S_I I-JB I=(B(M,M-1))
- SA3 X0 X3=B(2,1)
- S_K JB-IB K=STEP LENGTH GOING NORTH-EAST
- S_M M-1 M=M-1
- S_J 1 J=COUNT OF PASSAGES
- [1] BSS 0 X0=(B(J+1,1)) I=(B(M,M-J))
- SX5 X0+K X5=(B(J,2))=LOC OF FIRST COPY
- BX6 X3 X6=B(J+1,1)
- SA4 I X4=B(M,M-J)
- RVSET2 J,X5,K,B NORTH-WEST PASSAGE (J STEPS)
- EQ J,M,[2] IF J=M-1 THEN B IS FILLED
- SX5 I+K X5=(B(M-1,M-J+1)) LOC FIRST CPY
- BX6 X4 X6=B(M,M-J)
- RVSET2 J,X5,K,B SOUTH-EAST PASSAGE (J STEPS)
- SX0 X0+IB X0=(B(J+2,1))
- S_I I-JB I=(B(M,M-J-1))
- SA3 X0 X3=B(J+2,1)
- S_J J+1
- JP [1] MAKE NEXT PAIR OF PASSAGES
- [2] S_M M+1 RESTORE REGISTER M TO VALUE M
- RLSQM ENDM
- RLSQP MACRO N,M,B,C,I,J,ONE X1=(X), X3=(Y)
- LOCAL [1],[2],[3],[4],[5],[6],..
- MX6 0 X6=0.
- S_J ONE-M J=1-M
- MX7 0 X7=0.
- SA6 B B(1,1)=0.
- SA7 C C(1)=0.
- [1] S_J J+1 J=2-M,3-M,...,0
- SA6 A6+ONE B(I,1)=0 FOR I=2,3,..,M
- SA7 A7+ONE C(I)=0
- MI J,[1] WHILE J<0 OR I<M
- S_J ONE-M J=1-M
- [2] S_J J+ONE J=2-M,3-M,...,0
- SA6 A6+IDIMPAR B(M,I)=0 FOR I=2,3,...,M
- MI J,[2] WHILE J<0 OR I<M
-* X1=(X), X2=(Y)
- SA1 X1 X1=X(1) A1=(X(1))
- SA3 X3 X3=Y(1) A3=(Y(1))
- [3] BSS 0 X1=X A1=(X(I))
-* X3=Y A3=(Y(I))
- SA4 B X4=S(1) A4=(B(1,1))
- SA5 C X5=T(1) A5=(C(1))
- SX2 ONE X2=1
- S_J ONE-M
- PX2 X2
- S_J J+ONE J=2-M
- NX2 X2 X2=1.
- RX6 X4+X2 X6=S(1)+1.
- SA4 A4+ONE X4=S(2) A4=(B(2,1))
- RX7 X5+X3 X7=T(1)+Y
- SA5 A5+ONE X5=T(2) A5=(C(2))
- RLSQXY J,ONE
- NX6 X6 X6=S(M-1)
- RX2 X2*X1 X2=X**(M-1)
- NX7 X7 X7=T(M-1)
- RX3 X3*X1 X3=Y*X**(M-1)
- SA6 A6+ONE B(M-1,1)=S(M-1) A6=(B(M-1,1))
- RX6 X4+X2 X6=S(M)+X**(M-1)
- S_J 3 J=3
- SA4 A4+IDIMPAR X4=B(M,2)
- SA7 A7+ONE C(M-1)=T(M-1) A7=(C(M-1))
- RX7 X5+X3 X7=T(M)+Y*X**(M-1)
- NX6 X6 X6=S(M)
- RX2 X2*X1 X2=X**M
- NX7 X7 X7=T(M)
- SA6 A6+ONE B(M,1)=S(M) A6=(B(M,1))
- S_J J-M J=3-M
- RX6 X4+X2 X6=B(M,2)+X**M
- SA4 A4+IDIMPAR X4=B(M,3)
- SA7 A7+ONE C(M)=T(M) A7=(C(M))
- RX2 X2*X1 X2=X**(M+1)
- NX6 X6
- PL J,[4] IF M=3
- RLSQX J,ONE
- [4] SA6 A6+IDIMPAR B(M,M-1)=B(M,M-1)+X**(2M-3)
- RX6 X4+X2 X6=B(M,M)+X**(2M-2)
- SA1 A1+ONE X1=X(I+1) A1=(X(I+1))
- SA3 A3+ONE X3=Y(I+1) A3=(Y(I+1))
- S_N N-1 DECREMENT N
- NX6 X6
- SA6 A6+IDIMPAR B(M,M)=B(M,M)+X**(2M-2)
- NZ N,[3] WHILE N>0
- S_N IDIMPAR N=IDIM
- S_I A6 I=(B(M,M))
- RLSQM M,B,ONE,N,I,J,C
- RLSQP ENDM
-*CD MAXA
- RMAXA2R MACRO N,JX,L,K,J
- LOCAL [1]
- [1] BSS 0 FOR K = 0, 2, 4, ...
-* (COMMENTS ASSUME THAT N IS EVEN)
- + AX2 X4,K 0 X2=SIGN BITS OF X(K+1)
- AX3 X5,K 1 X2 X3=SIGN BITS OF X(K+2)
- BX2 X2-X4 2 X3 X2=ABS(X(K+1))
- BX3 X3-X5 3 X2 X3=ABS(X(K+2))
- + SA4 A5+JX 4 X3 X4=X(K+3) A4=(X(K+3))
- IX0 X6-X2 5 X0=P(K)-ABS(X(K+1)) SEE NOTE
- S_J J+1 6 X0 J=K+1
-* 7
- + PL X0,*+1 8 IF P(K) < ABS(X(K+1))
- BX6 X2 9 X6=ABS(X(K+1))=P(K+1)
- S_L J 10 X6 L=K+1
- + IX0 X6-X3 11 X4 X0=P(K+1)-ABS(X(K+2)) SEE NOTE
- SA5 A4+JX 12 X0 X5=X(K+4) A5=(X(K+4))
- S_J J+1 13 J=K+2
-* 14
- + PL X0,*+1 15 IF P(K+1) < ABS(X(K+2))
- BX6 X3 16 X6=ABS(X(K+2))=P(K+2)
- S_L J 17 X6 L=K+2
-* 18
-* 19 X5
- + NE J,N,[1] 20 IF J .NE. N (N = N-2)
- RMAXA2R ENDM
- RVMAXA MACRO N,JX,L,K,J X1=(X), X6=P
- LOCAL [1],[2],[3],[99]
- MX5 59 X5=777...776
- SX6 N X6=N
- S_L 1 L=1
- BX6 -X5*X6 X6=MOD(N,2)
- NZ X6,[1] IF N IS ODD
- SA4 X1 X4=X(1) A4=(X(1))
- S_K 59 SHIFT COUNT K=59
- S_J B0 J=0
- JP [2]
- [1] SA5 X1 X5=X(1) A5=(X(1))
- S_K 59 SHIFT COUNT K=59
- S_J 1 J=1
- AX3 X5,K X3=SIGN BITS OF X(1)
- BX6 X3-X5 X6=ABS(X(1))=P(1)
- EQ N,J,[99] IF N=1
- SA4 A5+JX X4=X(2) A4=(X(2))
- [2] BSS 0 X4=X(J+1) J=MOD(N,2)
- SA5 A4+JX X5=X(J+2) A5=(X(J+2))
- S_N N-2 N=N-2
- EQ J,N,[3] IF N = 2 OR 3
- RMAXA2R N,JX,L,K,J J=N-2
- [3] AX2 X4,K X2=SIGN BITS OF X(N-1)
- AX3 X5,K X3=SIGN BITS OF X(N)
- BX2 X2-X4 X2=ABS(X(N-1))
- BX3 X3-X5 X3=ABS(X(N))
- IX0 X6-X2 X0=P(N-2)-ABS(X(N-1))
- S_J J+1 J=N-1
- + PL X0,*+1 IF P(N-2) < ABS(X(N-1))
- BX6 X2 X6=ABS(X(N-1))=P(N-1)
- S_L J L=N-1
- + IX0 X6-X3 X0=P(N-1)-ABS(X(N))
- S_N N+2 RESTORE N
- + PL X0,*+1 IF P(N-1) < ABS(X(N))
- BX6 X3 X6=ABS(X(N))=P(N-1)
- S_L N L=N
- [99] BSS 0
- RVMAXA ENDM
- CMAXA1R MACRO N,JX,L,K,J
- LOCAL [1]
- [1] BSS 0 FOR K = 0, 1, 2, ...
- + AX2 X4,K 0 X2=SIGN BITS OF X'(K+2)
- AX3 X5,K 1 X2 X3=SIGN BITS OF X''(K+2)
- BX2 X2-X4 2 X3 X2=ABS(X'(K+2))
- BX3 X3-X5 3 X2 X3=ABS(X''(K+2))
- + SA4 A4+JX 4 X3 X4=X'(K+3)
- IX0 X6-X2 5 X0=P(K+1)-ABS(X'(K+2)) SEE NOTE
- S_J J+1 6 X0 J=1+K+1
-* 7
- + PL X0,*+1 8 IF P(K+1) < ABS(X'(K+2))
- BX6 X2 9 X6=ABS(X'(K+2))
- S_L J 10 X6 L=K+2
- + IX0 X6-X3 11 X4 X0=P-ABS(X''(K+2)) SEE NOTE
- SA5 A5+JX 12 X0 X5=X''(K+3)
-* 13
- PL X0,*+2 14 IF P < ABS(X''(K+2))
- + BX6 X3 15 X6=ABS(X''(K+2))=P(K+2)
- S_L J 16 X6 L=K+2
- SB0 0 17
-* 18
-* 19 X5
- + NE J,N,[1] 20 IF J .NE. N (N = N-1)
- CMAXA1R ENDM
- CVMAXA MACRO N,JX,L,K,J X1=(X), X6=P
- LOCAL [1],[99]
- SA4 X1 X4=X'(1) A4=(X'(1))
- SA5 X1+1 X5=X''(1) A5=(X''(1))
- S_K 59 SHIFT COUNT K=59
- S_J 1 J=1
- AX2 X4,K X2=SIGN BITS OF X'(1)
- AX3 X5,K X3=SIGN BITS OF X''(1)
- BX6 X2-X4 X6=ABS(X'(1))
- BX3 X3-X5 X3=ABS(X''(1))
- S_L J L=1
- IX0 X6-X3 X0=ABS(X'(1))-ABS(X''(1))
- + PL X0,*+1 IF ABS(X'(1)) < ABS(X''(1))
- BX6 X3 P(1)=ABS(X''(1))
- NO
- + EQ N,J,[99] IF N=1
- SA4 A4+JX X4=X'(2) A4=(X'(2))
- SA5 A5+JX X5=X''(2) A5=(X''(2))
- S_N N-1 N=N-1
- EQ N,J,[1] IF N=2
- CMAXA1R N,JX,L,K,J J=N-1
- [1] AX2 X4,K X2=SIGN BITS OF X'(N)
- AX3 X5,K X3=SIGN BITS OF X''(N)
- BX2 X2-X4 X2=ABS(X'(N))
- BX3 X3-X5 X3=ABS(X''(N))
- IX0 X6-X2 X0=P(N-1)-ABS(X'(N))
- S_N J+1 RESTORE N
- + PL X0,*+1 IF P(N-1) < ABS(X'(N))
- BX6 X2 X6=ABS(X'(N))
- S_L N
- + IX0 X6-X3 X0=P-ABS(X''(N))
- PL X0,[99] IF P < ABS(X''(N))
- BX6 X3 X6=ABS(X''(N))=P(N)
- S_L N L=N
- [99] BSS 0
- CVMAXA ENDM
-*CD MPY
- RMPY2R MACRO &,JX,JY,J,ONE
- LOCAL [1]
- [1] BSS 0 FOR K = 0, 1, 2, ...
- + RX1 X4*X3 0 X1=X(1,2+K)*Y(2+K)
- NX6 X6 1 X5 X6=Z(1,1+K)
- RX2 X5*X3 2 X2=X(2,2+K)*Y(2+K)
- SA4 A4+JX 3 X6 X4=X(1,2+K)
- + SA3 A3+JY 4 X1 X3=Y(2+K)
- NX7 X7 5 X7=Z(2,1+K)
- RX6 X6_&_X1 6 X2 X6=Z(1,1+K) & X(1,2+K)*Y(2+K)
- SA5 A5+JX 7 X7 X5=X(2,2+K)
- + S_J J+ONE 8 J=2-N+1+K
- RX7 X7_&_X2 9 X6 X7=Z(2,1+K) & X(2,2+K)*Y(2+K)
-* 10 X4
-* 11 X3
- MI J,[1] 12 X7 WHILE 3-N+K=J<0; I.E. 4+K .LE. N
- RMPY2R ENDM
- RMPY6R MACRO &,JX,JY,J
- LOCAL [1]
- [1] BSS 0 FOR K = 0, 2, 4, ...
- + NX6 X6 0 X6=Z(1,K)
- RX1 X3*X2 1 X4 X1=X(1,1+K)*Y(1+K)
- NX7 X7 2 X6 X7=Z(2,K)
- RX4 X4*X2 3 X5 X4=X(2,1+K)*Y(1+K)
- + NX0 X0 4 X7 X0=Z(3,K)
- RX5 X5*X2 5 X1 X5=X(3,1+K)*Y(1+K)
- SA3 A3+JX 6 X0 X3=X(1,2+K)
- RX6 X6_&_X1 7 X4 X6=Z(1,K) & X(1,1+K)*Y(1+K)
- + SA2 A2+JY 8 X2=Y(2+K)
- RX7 X7_&_X4 9 X5 X7=Z(2,K) & X(2,1+K)*Y(1+K)
- SA4 A4+JX 10 X6 X4=X(2,2+K)
- RX0 X0_&_X5 11 X0=Z(3,K) & X(3,1+K)*Y(1+K)
- + SA5 A5+JX 12 X7 X5=X(3,2+K)
- S_J J+2 13 X3 J=2-N+K+2
- NX6 X6 14 X0 X6=Z(1,1+K)
-* 15 X2
- + NX7 X7 16 X6 X7=Z(2,1+K)
- RX1 X3*X2 17 X4 X1=X(1,2+K)*Y(2+K)
- NX0 X0 18 X7 X0=Z(3,1+K)
- RX4 X4*X2 19 X5 X4=X(2,2+K)*Y(2+K)
- + SA3 A3+JX 20 X0 X3=X(1,3+K)
- RX5 X5*X2 21 X1 X5=X(3,2+K)*Y(2+K)
- SA2 A2+JY 22 X2=Y(3+K)
- RX6 X6_&_X1 23 X4 X6=Z(1,1+K)&X(1,2+K)*Y(2+K)
-* 24
- + RX7 X7_&_X4 25 X5 X7=Z(2,1+K)&X(2,2+K)*Y(2+K)
- SA4 A4+JX 26 X6 X4=X(2,3+K)
- RX0 X0_&_X5 27 X3 X0=Z(3,1+K)&X(3,2+K)*Y(2+K)
- SA5 A5+JX 28 X7 X5=X(3,3+K)
-* 29 X2
-* 30 X0
- + MI J,[1] 31 WHILE 4-N+K=J<0; I.E.5+K.LE.N
- RMPY6R ENDM
- RMPY3H MACRO &,JX,JY
- RX1 X3*X2 1 X4 X1=X(1,1+K)*Y(1+K)
- NX7 X7 2 X6 X7=Z(2,K)
- RX4 X4*X2 3 X5 X4=X(2,1+K)*Y(1+K)
- NX0 X0 4 X7 X0=Z(3,K)
- RX5 X5*X2 5 X1 X5=X(3,1+K)*Y(1+K)
- SA3 A3+JX 6 X0 X3=X(1,2+K)
- RX6 X6_&_X1 7 X4 X6=Z(1,K) & X(1,1+K)*Y(1+K)
- SA2 A2+JY 8 X2=Y(2+K)
- RX7 X7_&_X4 9 X5 X7=Z(2,K) & X(2,1+K)*Y(1+K)
- SA4 A4+JX 10 X6 X4=X(2,2+K)
- RX0 X0_&_X5 11 X0=Z(3,K) & X(3,1+K)*Y(1+K)
- SA5 A5+JX 12 X7 X5=X(3,2+K)
- RMPY3H ENDM
- RMPY6T MACRO N,&,Z,IZ,SAVEX,SAVEY,J
- + NX6 X6 32 X6=Z(1,N-1)
- RX3 X3*X2 33 X4 X3=X(1,N)*Y(N)
- NX7 X7 34 X6 X7=Z(2,N-1)
- RX4 X4*X2 35 X4=X(2,N)*Y(N)
- + NX0 X0 36 X7 X0=Z(3,N-1)
- RX5 X5*X2 37 X3 X5=X(3,N)*Y(N)
-* 38 X0
- RX6 X6_&_X3 39 X4 X6=Z(1,N-1) & X(1,N)*Y(N)
- RX7 X7_&_X4 40 X7=Z(2,N-1) & X(2,N)*Y(N)
- + SA1 SAVEX 41 X5 X1=(X(4,1))
- RX0 X0_&_X5 42 X6 X0=Z(3,N-1) & X(3,N)*Y(N)
- S_J J-N 43 X7 J=J-N
- + NX7 X7 44 X7=Z(2,N)
- NX6 X6 45 X0 X6=Z(1,N)
-* 46 X7
- SA7 Z+IZ 47 X6 Z(2)=Z(2,N)
- NX7 X0 48 X1 X7=Z(3,N)
- + SA6 Z 49 Z(1)=Z(1,N)
- SA2 SAVEY 50 X7 X2=(Y(1))
- SA7 A7+IZ 51 Z(3)=Z(3,N)
-* 52
- + S_Z A7+IZ 53 Z=(Z(4))
- RMPY6T ENDM
- RVMPY MACRO &,N,X,JX,Y,JY,#,Z,J
- LOCAL [1],[2],[3],[4],[5],[6],[7],[99]
- [1] BSS 0
- LAMBDA IFC NE,*#*0*
- SA1 Z X1=Z
- LAMBDA ENDIF
- S_J 3 J=3
- SA2 X X2=X(1)
- S_J J-N J=3-N
- SA3 Y X3=Y(1)
- PL J,[3] IF N < 4
- SA4 A2+JX X4=X(2)
- SA5 A3+JY X5=Y(2)
- LAMBDA IFC EQ,*#*+*
- BX6 X1 X6=Z
- LAMBDA ENDIF
- LAMBDA IFC EQ,*#*-*
- BX6 -X1 X6=-Z
- LAMBDA ENDIF
- LAMBDA IFC EQ,*#*0*
- NO
- MX6 0 X6=0.
- LAMBDA ENDIF
- MX7 0 X7=0.
- [2] BSS 0 FOR K = 0, 2, 4, ...
- + S_J J+2 0 X3 J=3-N+K+2
- RX0 X2*X3 1 X4 X0=X(1+K)*Y(1+K)
- NX6 X6 2 X5
- + RX1 X4*X5 3 X1=X(2+K)*Y(2+K)
- NX7 X7 4 X6
- SA2 A4+JX 5 X0 X2=X(3+K)
- RX6 X6_&_X0 6 X7 X6=X6 & X(1+K)*Y(1+K)
- + SA3 A5+JY 7 X1 X3=Y(3+K)
- SA4 A2+JX 8 X4=X(4+K)
- SA5 A3+JY 9 X6 X5=Y(4+K)
- RX7 X7_&_X1 10 X7=X7 & X(2+K)*Y(2+K)
- 11
- 12 X2
- + MI J,[2] 13 X7 WHILE 5-N+K=J<0; I.E. 6+K.LE.N
- ZR J,[6] 14 X3 IF N IS ODD AND ONE TERM IS LEFT
- + RX0 X2*X3 15 X4 X0=X(N-1)*Y(N-1)
- NX6 X6 16 X5
- RX1 X4*X5 17 X1=X(N)*Y(N)
- NX7 X7 18 X6
- 19 X0
- 20 X7
- + JP [7] 21 X1
- [3] SX6 J-1 X6=2-N
- LAMBDA IFC EQ,*#*-*
- BX1 -X1 X1=-Z
- LAMBDA ENDIF
- ZR J,[5] IF N = 3
- ZR X6,[4] IF N = 2
- LAMBDA IFC NE,*#*0*
- RX0 X2*X3 X0=X(1)*Y(1)
- RX6 X1_&_X0 X6= # Z & X(1)*Y(1)
- NX6 X6
- LAMBDA ELSE
- RX6 X2*X3 X6=X(1)*Y(1)
- SIGMA IFC EQ,*&*-*
- BX6 -X6 X6= & X(1)*Y(1)
- SIGMA ENDIF
- LAMBDA ENDIF
- SA4 A2 A4=(X(N))
- SA5 A3 A5=(Y(N))
- JP [99]
- [4] SA4 A2+JX X4=X(2)
- SA5 A3+JY X5=Y(2)
- LAMBDA IFC NE,*#*0*
- RX0 X2*X3 X0=X(1)*Y(1)
- RX6 X1_&_X0 X6= # Z & X(1)*Y(1)
- RX7 X4*X5 X7=X(2)*Y(2)
- NX6 X6
- RX6 X6_&_X7 X6= # Z & (X(1)*Y(1)+X(2)*Y(2))
- LAMBDA ELSE
- RX6 X2*X3 X6=X(1)*Y(1)
- RX7 X4*X5 X7=X(2)*Y(2)
- RX6 X6+X7 X6=X(1)*Y(1)+X(2)*Y(2)
- SIGMA IFC EQ,*&*-*
- BX6 -X6 X6= & (X(1)*Y(1)+X(2)*Y(2))
- SIGMA ENDIF
- LAMBDA ENDIF
- NX6 X6 X6= #Z & (X(1)*Y(1)+X(2)*Y(2))
- JP [99]
- [5] SA4 A2+JX X4=X(2)
- SA5 A3+JY X5=Y(2)
- LAMBDA IFC NE,*#*0*
- RX7 X2*X3 X7=X(1)*Y(1)
- SA2 A4+JX X2=X(3)
- SA3 A5+JY X3=Y(3)
- SIGMA IFC EQ,*&*-*
- BX7 -X7 X7= & X(1)*Y(1)
- SIGMA ENDIF
- RX4 X4*X5 X4=X(2)*Y(2)
- RX0 X2*X3 X0=X(3)*Y(3)
- RX7 X7_&_X4 X7= & (X(1)*Y(1)+X(2)*Y(2))
- RX6 X1_&_X0 X6= #Z & X(3)*Y(3)
- NX7 X7
- NX6 X6
- RX6 X6+X7 X6= # Z & (X(1)*Y(1)+...+X(3)*Y(3))
- LAMBDA ELSE
- RX6 X2*X3 X6=X(1)*Y(1)
- SA2 A4+JX X2=X(3)
- SA3 A5+JY X3=Y(3)
- RX7 X4*X5 X7=X(2)*Y(2)
- RX0 X2*X3 X0=X(3)*Y(3)
- RX6 X6+X7 X6=X(1)*Y(1)+X(2)*Y(2)
- NX6 X6
- RX6 X6+X0 X6=X(1)*Y(1)+...+X(3)*Y(3)
- SIGMA IFC EQ,*&*-*
- BX6 -X6 X6= & (X(1)*Y(1)+...+X(3)*Y(3))
- SIGMA ENDIF
- LAMBDA ENDIF
- SA4 A2 A4=(X(N))
- SA5 A3 A5=(Y(N))
- NX6 X6 X6= # Z & (X(1)*Y(1)+...+X(3)*Y(3))
- JP [99]
- [6] RX0 X2*X3 0 X0=X(N-2)*Y(N-2)
- SA2 A4+JX 1 X2=X(N)
- SA3 A5+JY 2 X3=Y(N)
- RX1 X4*X5 3 X1=X(N-1)*Y(N-1)
- + NX6 X6 4 X0
- SA4 A2 5 A4=(X(N))
- SA5 A3 6 X6 A5=(Y(N))
- RX6 X6_&_X0 7 X1 X6=X6 & X(N-2)*Y(N-2)
- + NO 8 X2
- NX7 X7 9 X4
- RX0 X2*X3 10 X6 X0=X(N)*Y(N)
- NX6 X6 11 X7
- [7] RX7 X7_&_X1
- RX6 X6_&_X0
- NX7 X7
- NX6 X6
- RX6 X6+X7 X6= # Z & (X(1)*Y(1)+...+X(N)*Y(N))
- NO
- NO
- NX6 X6
- [99] BSS 0
- RVMPY ENDM
- RMMPY2 MACRO &,N,IX,JX,JY,#,Z,IZ,J,ONE X1=(X), X2=(Y)
- LAMBDA IFC EQ,*#*0* # IS 0
- SA4 X1 X4=X(1,1) A4=(X(1,1))
- SA3 X2 X3=Y(1) A3=(Y(1))
- SA5 A4+IX X5=X(2,1) A5=(X(2,1))
- S_J -N
- S_J J+2 J=2-N
- RX6 X4*X3 X6=X(1,1)*Y(1)
- SA4 A4+JX X4=X(1,2) A4=(X(1,2))
- RX7 X5*X3 X7=X(2,1)*Y(1)
- SA3 A3+JY X3=Y(2) A3=(Y(2))
- SA5 A5+JX X5=X(2,2) A5=(X(2,2))
- SIGMA IFC NE,*&*+* & IS -
- BX6 -X6 X6=Z(1,1)
- BX7 -X7 X7=Z(2,1)
- SIGMA ENDIF
- LAMBDA ELSE # IS + OR -
- SA4 X1 X4=X(1,1) A4=(X(1,1))
- SA3 X2 X3=Y(1) A3=(Y(1))
- SA1 Z X1=Z(1)
- SA2 Z+IZ X2=Z(2)
- S_J 1
- S_J J-N J=1-N
- SA5 A4+IX X5=X(2,1) A5=(X(2,1))
- LAMBDA2 IFC EQ,*#*+* # IS +
- BX6 X1 X6=Z(1)
- BX7 X2 X7=Z(2)
- LAMBDA2 ELSE # IS -
- BX6 -X1 X6=-Z(1)
- BX7 -X2 X7=-Z(2)
- LAMBDA2 ENDIF
- LAMBDA ENDIF
- RMPY2R &,JX,JY,J,ONE J=0
- RX1 X4*X3 X1=X(1,N)*Y(N)
- NX6 X6 X6=Z(1,N-1)
- RX2 X5*X3 X2=X(2,N)*Y(N)
- NX7 X7 X7=Z(2,N-1)
- RX6 X6_&_X1 X6=Z(1)
- RX7 X7_&_X2 X7=Z(2)
- NX6 X6
- NX7 X7
- SA6 Z Z(1)
- SA7 Z+IZ Z(2)
- RMMPY2 ENDM
- RM2MPYR MACRO IX,IZ,I
- LOCAL [1]
- [1] BSS 0 FOR K = 0, 2, 4, ...
- + RX2 X2*X0 0 X2=X(4+K,1)*Y(1)
- S_I I+2 1 I=6-M+2+K
- RX3 X3*X1 2 X4 X3=X(4+K,2)*Y(2)
- + NX6 X6 3 X5 X6=Z(2+K)
- RX4 X4*X0 4 X2 X4=X(5+K,1)*Y(1)
- NX7 X7 5 X6 X7=Z(3+K)
- RX5 X5*X1 6 X3 X5=X(5+K,2)*Y(2)
- + SA6 A7+IZ 7 X7 Z(2+K)
- RX6 X2+X3 8 X4 X6=X(4+K,1)*Y(1)+X(4+K,2)*Y(2)
- SA2 A4+IX 9 X2=X(6+K,1)
- SA3 A5+IX 10 X5 X3=X(6+K,2)
- + SA7 A6+IZ 11 X6 Z(3+K)
- RX7 X4+X5 12 X7=X(5+K,1)*Y(1)+X(5+K,2)*Y(2)
- SA4 A2+IX 13 X4=X(7+K,1)
- SA5 A3+IX 14 X5=X(7+K,2)
-* 15 X7
-* 16 X2
- + MI I,[1] 17 X3 WHILE 8-M+K<0; I.E. 9+K.LE.M
- RM2MPYR ENDM
- RM2MPY MACRO &,M,IX,JX,JY,Z,IZ,I X1=(X(1,1)) X2=(Y(1))
- LOCAL [1],[2],[3],[4],[5],[99]
- SA2 X2 X2=Y(1) A2=(Y(1))
- SA4 X1 X4=X(1,1) A4=(X(1,1))
- SA1 A2+JY X1=Y(2) A1=(Y(2))
- SA5 A4+JX X5=X(1,2) A5=(X(1,2))
- SIGMA IFC EQ,*&*+* & IS +
- BX0 X2
- SIGMA ELSE & IS -
- BX0 -X2 X0=&Y(1)
- BX1 -X1 X1=&Y(2)
- SIGMA ENDIF
- BRANCH [1],M,LE,6,I I=6-M; IF M<7 GO TO [1]
- RX4 X4*X0 X4=X(1,1)*Y(1)
- SA2 A4+IX X2=X(2,1) A2=(X(2,1))
- RX5 X5*X1 X5=X(1,2)*Y(2)
- SA3 A5+IX X3=X(2,2) A3=(X(2,2))
- RX7 X4+X5 X7=X(1,1)*Y(1)+X(1,2)*Y(2)
- SA4 A2+IX X4=X(3,1) A4=(X(3,1))
- SA5 A3+IX X5=X(3,2) A5=(X(3,2))
- RX2 X2*X0 X2=X(2,1)*Y(1)
- RX3 X3*X1 X3=X(2,2)*Y(2)
- RX4 X4*X0 X4=X(3,1)*Y(1)
- NX7 X7 X7=Z(1)
- RX5 X5*X1 X5=X(3,2)*Y(2)
- RX6 X2+X3 X6=X(2,1)*Y(1)+X(2,2)*Y(2)
- SA2 A4+IX X2=X(4,1) A2=(X(4,1))
- SA3 A5+IX X3=X(4,2) A3=(X(4,2))
- SA7 Z Z(1)
- RX7 X4+X5 X7=X(3,1)*Y(1)+X(3,2)*Y(2)
- SA4 A2+IX X4=X(5,1) A4=(X(5,1))
- SA5 A3+IX X5=X(5,2) A5=(X(5,2))
- RM2MPYR IX,IZ,I I=+1 FOR M=7,9,11,...
-* I=0 FOR M=8,10,12,...
- RX2 X2*X0 X2=X(M-2+I,1)*Y(1)
- RX3 X3*X1 X3=X(M-2+I,2)*Y(2)
- NX6 X6 X6=Z(M-4+I)
- RX4 X4*X0 X4=X(M-1+I,1)*Y(1)
- NX7 X7 X7=Z(M-3+I)
- RX5 X5*X1 X5=X(M-1+I,2)*Y(2)
- SA6 A7+IZ Z(M-4+I)
- RX6 X2+X3 X6=Z(M-2+I)
- NZ I,[5] IF M IS ODD
- SA2 A4+IX X2=X(M,1)
- SA3 A5+IX X3=X(M,2)
- SA7 A6+IZ Z(M-3)
- RX7 X4+X5 X7=Z(M-1)
- RX2 X2*X0 X2=X(M,1)*Y(1)
- RX3 X3*X1 X3=X(M,2)*Y(2)
- NX6 X6 X6=Z(M-2)
- NX7 X7 X7=Z(M-1)
- SA6 A7+IZ Z(M-2)
- RX6 X2+X3 X6=Z(M)
- SA7 A6+IZ Z(M-1)
- NX6 X6 X6=Z(M)
- SA6 A7+IZ Z(M)
- JP [99]
- [1] BSS 0 M=1,2,3,...; I=5,4,3,...
- RX2 X4*X0 X2=X(1,1)*Y(1)
- S_I I-4 M=1,2,3,...; I=+1,0,-1,...
- RX3 X5*X1 X3=X(1,2)*Y(2)
- GT I,B0,[4] IF M=1; I.E. I=+1
- SA4 A4+IX X4=X(2,1) A4=(X(2,1))
- SA5 A5+IX X5=X(2,2) A5=(X(2,2))
- RX7 X2+X3 X7=X(1,1)*Y(1)+X(1,2)*Y(2)
- ZR I,[3] IF M=2; I.E. I=0
- [2] BSS 0 FOR K = 0, 1, 2, ...
- + RX2 X4*X0 0 X5 X2=X(2+K,1)*Y(1)
- NX7 X7 1 X7=Z(1+K)
- RX3 X5*X1 2 X3=X(2+K,2)*Y(2)
- SA4 A4+IX 3 X7 X4=X(3+K,1)
- + SA7 Z 4 X2 Z(1+K)
- SA5 A5+IX 5 X5=X(3+K,2)
- S_I I+1 6 X3 I=2-M+1+K
- + S_Z Z+IZ 7 Z=(Z(2+K))
- RX7 X2+X3 8 X7=X(2+K,1)*Y(1)+X(2+K,2)*Y(2)
-* 9
-* 10 X4
- MI I,[2] 11 X7 WHILE 3-M+K<0; I.E. 4+K.LE.M
- [3] RX2 X4*X0 X2=X(M,1)*Y(1)
- NX7 X7 X7=Z(M-1)
- RX3 X5*X1 X3=X(M,2)*Y(2)
- SA7 Z Z(M-1)
- S_Z Z+IZ Z=(Z(M))
- [4] RX7 X2+X3 X7=Z(M)
- NX7 X7 X7=Z(M)
- SA7 Z Z(M)
- JP [99]
- [5] SA7 A6+IZ Z(M-2)
- RX7 X4+X5 X7=X(M,1)*Y(1)+X(M,2)*Y(2)
- NX6 X6 X6=Z(M-1)
- NX7 X7 X7=Z(M)
- SA6 A7+IZ Z(M-1)
- SB0 0
- SA7 A6+IZ Z(M)
- [99] BSS 0
- RM2MPY ENDM
- RM2MPAR MACRO &,IX,#,IZ,I X0=&Y(1) X1=&Y(2)
- LOCAL [1]
- [1] BSS 0 FOR K = 0, 2, 4, ...
- RX6 X6_&_X7 0 X4 X6=Z(1+K)
- RX4 X4*X0 1 X3 X4=X(2+K,1)*Y(1)
-* 2
- LAMBDA IFC EQ,*#*-* # IS -
- BX3 -X3 3 X6
- LAMBDA ENDIF
- RX7 X5*X1 3 X6 X7=X(2+K,2)*Y(2)
- NX6 X6 4
- SA5 A5+IX 5 X4 X5=X(3+K,2) A5=(X(3+K,2))
- RX2 X3_&_X4 6 X6 X2=#Z(2+K)&X(2+K,1)*Y(1)
- SA6 A3-IZ 7 X7 Z(1+K)=#Z(1+K)&(...
- SA4 A4+IX 8 X4=X(3+K,1) A4=(X(3+K,1))
- SA3 A3+IZ 9 X2 X3=Z(3+K) A3=(Z(3+K))
- S_I I+1 10 I=2-M+1+K
- NX6 X2 11
-* 12 X5
-* 13 X6
- MI I,[1] 14 WHILE 3-M+K<0; I.E. 4+K .LE. M
- RM2MPAR ENDM
- RM2MPA MACRO &,M,IX,JX,JY,#,Z,IZ,I
- LOCAL [1],[2].[99]
- SA2 X2 X2=Y(1) A2=(Y(1))
- SA4 X1 X4=X(1,1) A4=(X(1,1))
- SA1 A2+JY X1=Y(2) A1=(Y(2))
- SA3 Z X3=Z(1) A3=(Z(1))
- SA5 A4+JX X5=X(1,2) A5=(X(1,2))
- S_I 2
- BX0 X2 X0=Y(1)
- S_I I-M I=2-M
- RX4 X4*X0 X4=X(1,1)*Y(1)
- LAMBDA IFC EQ,*#*-* # IS -
- BX3 -X3 X3=#Z(1)
- LAMBDA ENDIF
- RX7 X5*X1 X7=X(1,2)*Y(2)
- LE I,B0,[1] IF M = 2,3,....
- RX2 X3_&_X4 X2=#Z(1)&X(1,1)*Y(1)
- NX6 X2 X6=...
- RX6 X6_&_X7 X6=#Z(1)&(X(1,1)*Y(1)+X(1,2)*Y(2))
- NX6 X6
- SA6 A3 Z(1)=#Z(1)&...
- JP [99]
- [1] SA5 A5+IX X5=X(2,2) A5=(X(2,2))
- RX2 X3_&_X4 X2=#Z(1)&X(1,1)*Y(1)
- SA4 A4+IX X4=X(2,1) A4=(X(2,1))
- SA3 A3+IZ X3=Z(2) A3=(Z(2))
- NX6 X2 X6=#Z(1)&X(1,1)*Y(1)
- ZR I,[2] IF M=2
- RM2MPAR &,IX,#,IZ,I I=0
- [2] RX6 X6_&_X7 X7=#Z(M-1)&(X(M-1,1)*Y(1)+...)
- RX4 X4*X0 X4=X(M,1)*Y(1)
- LAMBDA IFC EQ,*#*-*
- BX3 -X3 X3=#Z(M)
- LAMBDA ENDIF
- RX7 X5*X1 X7=X(M,2)*Y(2)
- NX6 X6
- RX2 X3_&_X4 X2=#Z(M)&X(M,1)*Y(1)
- SA6 A3-IZ Z(M-1)=#Z(M-1) (...)
- NX6 X2 X6=X2
- RX6 X6_&_X7 X6=#Z(M)&(X(M,1)*Y(1)+...)
- NX6 X6
- SA6 A6+IZ Z(M)=#Z(M)&(...)
- [99] BSS 0
- RM2MPA ENDM
- RMMPY6H MACRO &,IX,#,Z,IZ,SAVEX,I
- LAMBDA IFC EQ,*#*0* # IS 0
-* X1=(X(1,1))
-* X2=(Y(1))
- + SA3 X1 0 X3=X(1,1) A3=(X(1,1))
- SA4 X1+IX 1 X4=X(2,1) A4=(X(2,1))
- SA2 X2 2 X2=Y(1) A2=(Y(1))
- SA5 A4+IX 3 X5=X(3,1) A5=(X(3,1))
- + MX6 0 4 X6=0.
- SX7 A5+IX 5 X6 X7=(X(4,1))
-* 6 X7
- SA7 SAVEX 7 X3 SAVEX=(X(4,1))
- + S_I I+3 8 X4 I=I+3
-* 9 X2
- MX7 0 10 X5 X7=0.
- MX0 0 11 X7 X0=0.
-* 12 X0
- LAMBDA ELSE # IS + OR -
-* X1=(X(1,1))
-* X2=(Y(1))
- + SA3 Z 0 X3=Z(1) A3=(Z(1))
- SA4 Z+IZ 1 X4=Z(2) A4=(Z(2))
- SX6 X1+IX 2 X6=(X(2,1))
- SX7 IX+IX 3 X6 X7=2*IX
- SA5 A4+IZ 4 X7 X5=Z(3) A5=(Z(3))
- IX7 X6+X7 5 X7=(X(4,1))
-* 6 X7
- SA7 SAVEX 7 X3 SAVEX=(X(4,1))
- LAMBDA2 IFC EQ,*#*+*
- BX6 X3 8 X4
- BX7 X4 9 X6
- LAMBDA2 ELSE
- BX6 -X3 8 X4 X6=#Z(1)
- BX7 -X4 9 X6 X7=#Z(2)
- LAMBDA2 ENDIF
- SA2 X2 10 X7 X2=Y(1) A2=(Y(1))
- SA3 X1 11 X5 X3=X(1,1) A3=(X(1,1))
- LAMBDA2 IFC EQ,*#*+*
- BX0 X5
- LAMBDA2 ELSE
- BX0 -X5 X0=#Z(3)
- LAMBDA2 ENDIF
- SA4 X1+IX X4=X(2,1) A4=(X(2,1))
- S_I I+3 I=I+3
- SA5 A4+IX X5=X(3,1) A5=(X(3,1))
- LAMBDA ENDIF
- RMMPY6H ENDM
- RMMPY MACRO &,I,N,IX,JX,JY,#,Z,IZ,TEMP,J X1=(X), X2=(Y)
- LOCAL [1],[2],[3],[4],[5],[6],[99],SAVEX,SAVEY
- SAVEX EQU TEMP
- SAVEY EQU TEMP+1
- SX5 N X5=N
- S_J -N
- BX7 X2 X7=(Y)
- S_J J+2 J=2-N=+1,0,-1,...; N=1,2,3,...
- SA7 SAVEY SAVEY=(Y)
- ZR J,[5] IF N=2 GO TO [5]
- PL J,[4] IF N=1 GO TO [4]
- S_I -I
- LX5 59 SIGN(X5)=MOD(N,2)
- S_I I+2 I=2-M=+1,0,-1,...; M=1,2,3,...
- ZR I,[2] IF N>2 AND M=2 GO TO [2]
- PL I,[3] IF N>2 AND M=1 GO TO [3]
- MI X5,[6] IF M>2 AND N=3,5,7,... GO TO [6]
- [1] BSS 0 N=4,6,8,...; J=2-N=-2,-4,-6,...
- RMMPY6H &,IX,#,Z,IZ,SAVEX,I I=I+3=2,1,0,...; M=3,4,5,...
- RMPY3H &,JX,JY
- RMPY6R &,JX,JY,J J=0
- S_J 2 J=2
- RMPY6T N,&,Z,IZ,SAVEX,SAVEY,J J=J-N=2-N
- MI I,[1] WHILE I<0 PROCESS NEXT 3 ROWS
- S_I I-1 I=+1,0,-1; M=0,1,2
- ZR I,[3] IF M=1 PROCESS LAST ROW
- PL I,[99] IF M=0 ALL DONE
- [2] S_I 1 I=1
- RMMPY2 &,N,IX,JX,JY,#,Z,IZ,J,I
- JP [99]
- [3] BX0 X1 X0=(X)
- BX3 X2 X3=(Y)
- RVMPY &,N,X0,JX,X3,JY,#,Z,J
- SA6 Z Z(1)
- JP [99]
- [4] BSS 0
- LAMBDA IFC EQ,*#*0* # IS 0
- S_N X1 N=(X) SORRY
- SA1 X2 X1=Y(1)
- SIGMA IFC EQ,*&*-*
- BX1 -X1 X1=&Y(1)
- SIGMA ENDIF
- RVSCL I,N,IX,Z,IZ,J
- S_N 1 RESTORE N
- LAMBDA ELSE # IS + OR -
- BX4 X1 X4=(X)
- SA1 X2 X1=Y A1=(Y)
- SX2 Z X2=(Z)
- SIGMA IFC EQ,*&*-*
- BX1 -X1 X1=&Y
- SIGMA ENDIF
- RVSCA I,IX,#,IZ,Z,IZ,J Z(J)=&X(J,1)*Y(1) # Z(J)
- LAMBDA ENDIF
- JP [99]
- [5] BSS 0
- LAMBDA IFC EQ,*#*0* # IS 0
- RM2MPY &,I,IX,JX,JY,Z,IZ,J
- LAMBDA ELSE # IS + OR -
- RM2MPA &,I,IX,JX,JY,#,Z,IZ,J
- LAMBDA ENDIF
- JP [99]
- [6] BSS 0 N=3,5,7...; J=2-N=-1,-3,-5,...
- RMMPY6H &,IX,#,Z,IZ,SAVEX,I I=I+3=2,1,0,...; M=3,4,5,...
- RMPY6R &,JX,JY,J J=+1
- S_J 2 J=2
- RMPY6T N,&,Z,IZ,SAVEX,SAVEY,J J=J-N=2-N
- MI I,[6] WHILE I<0 PROCESS NEXT 3 ROWS
- S_I I-1 I=+1,0,-1; M=0,1,2
- ZR I,[3] IF M=1 PROCESS LAST ROW
- MI I,[2] IF M=2 PROCESS LAST 2 ROWS
- [99] BSS 0
- RMMPY ENDM
- RMBIL6T MACRO N,IX,SXYZ,SAVEY,SAVEZ,J A0=(X)
- S_J 2 J=2
- + NX6 X6 X6=SYZ(1,N-1)
- RX3 X3*X2 X3=Y(1,N)*Z(N)
- NX7 X7 X7=SYZ(2,N-1)
- RX4 X4*X2 X4=Y(2,N)*Z(N)
- + NX0 X0 X0=SYZ(3,N-1)
- RX5 X5*X2 X5=Y(3,N)*Z(N)
- SA1 SAVEY X1=(Y(4,1))
- + RX6 X6+X3 X6=SYZ(1,N-1)+Y(1,N)*Z(N)
- RX7 X7+X4 X7=SYZ(2,N-1)+Y(2,N)*Z(N)
- SA4 A0+IX X4=X(2) A4=(X(2))
- SA3 A0 X3=X(1) A3=(X(1))
- + RX0 X0+X5 X0=SYZ(3,N-1)+Y(3,N)*Z(N)
- SA5 A4+IX X5=X(3) A5=(X(3))
- NX6 X6 X6=SYZ(1,N)
- S_J J-N J=2-N
- + SA2 SXYZ X2=SXYZ(0)
- NX7 X7 X7=SYZ(2,N)
- SA0 A5+IX A0=(X(4))
- + NX0 X0 X0=SYZ(3,N)
- RX7 X4*X7 X7=X(2)*SYZ(2,N)
- RX6 X3*X6 X6=X(1)*SYZ(1,N)
- RX0 X5*X0 X0=X(3)*SYZ(3,N)
- + RX7 X7+X2 X7=X(2)*SYZ(2,N)+SXYZ(0)
- RX6 X6+X0 X6=X(1)*SYZ(1,N)+X(3)*SYZ(3,N)
- NX7 X7
- NX6 X6
- + RX6 X6+X7 X6=SXYZ(3)
- SA2 SAVEZ X2=(Z(1))
- NX6 X6
- SA6 SXYZ SXYZ=SXYZ(3)
- RMBIL6T ENDM
- RMBIL MACRO N,IX,IY,JY,JZ,TEMP3,I,J A0=(X), X1=(Y), X2=(Z)
- LOCAL [1],[2],[3],[4],[5],[6],[99]
- LOCAL SXYZ,SAVEY,SAVEZ
- SXYZ EQU TEMP3
- SAVEY EQU TEMP3+1
- SAVEZ EQU TEMP3+2
- SX5 N X5=N
- S_I -N I=-N
- BX7 X2 X7=(Z)
- MX6 0 X6=0.
- S_J I+2 J=2-N
- SA7 SAVEZ SAVEZ=(Z(1))
- SA6 SXYZ SXYZ=SXYZ(0)=0.
- ZR J,[5] IF N=2 GOTO [5]
- PL J,[4] IF N=1 GOTO [4]
- LX5 59 SIGN(X5)=MOD(N,2)
- S_I J I=2-N
- MI X5,[6] IF N=3,5,7,... GOTO [6]
- [1] BSS 0 N=4,6,8,...; J=2-N
-* X1=(Y(I,1))
-* X2=(Z(1))
- RMMPY6H "PLUS",IY,"NULL",B0,B0,SAVEY,I
- RMPY3H "PLUS",JY,JZ
- RMPY6R "PLUS",JY,JZ,J J=0
- RMBIL6T N,IX,SXYZ,SAVEY,SAVEZ,J X6=SXYZ
- MI I,[1] WHILE I<0 PROCESS NEXT 3 ROWS
- S_I I-1 I=+1,0,-1; N=0,1,2
- ZR I,[3] IF N=1 PROCESS LAST ROW
- PL I,[99] IF N=0 ALL DONE
- [2] SA4 X1 X4=Y(N-1,1) A4=(Y(N-1,1))
- SA3 X2 X3=Z(1) A3=(Z(1))
- SA5 A4+IY X5=Y(N,1) A5=(Y(N,1))
- S_J -N
- S_I 1 I=1
- S_J J+2 J=2-N
- RX6 X4*X3 X6=Y(N-1,1)*Z(1)
- SA4 A4+JY X4=Y(N-1,2) A4=(Y(N-1,2))
- RX7 X5*X3 X7=Y(N,1)*Z(1)
- SA3 A3+JZ X3=Z(2) A3=(Z(2))
- SA5 A5+JY X5=Y(N,2) A5=(Y(N,2))
- RMPY2R "PLUS",JY,JZ,J,I J=0
- RX1 X4*X3 X1=Y(N-1,N)*Z(N)
- NX6 X6 X6=SYZ(N-1,N-1)
- RX2 X5*X3 X2=Y(N,N)*Z(N)
- NX7 X7 X7=SYZ(N,N-1)
- SA4 A0 X4=X(N-1) A4=(X(N-1))
- SA5 A0+IX X5=X(N) A5=(X(N))
- RX6 X6+X1 X6=SYZ(N-1,N-1)+Y(N-1,N)*Z(N)
- RX7 X7+X2 X7=SYZ(N,N-1)+Y(N,N)*Z(N)
- SA3 SXYZ X3=SXYZ(N-2)
- NX6 X6 X6=SYZ(N-1,N)
- NX7 X7 X7=SYZ(N,N)
- RX6 X4*X6 X6=X(N-1)*SYZ(N-1,N)
- RX7 X5*X7 X7=X(N)*SYZ(N,N)
- RX6 X3+X6 X6=SXYZ(N-2)+X(N-1)*SYZ(N-1,N)
- NX6 X6 X6=SXYZ(N-1)
- RX6 X6+X7 X6=SXYZ(N-1)+X(N)*SYZ(N,N)
- NX6 X6 X6=SXYZ(N)=RMBIL
- JP [99]
- [3] BX0 X1 X0=(Y(N,1))
- BX3 X2 X3=(Z(1))
- RVMPY "PLUS",N,X0,JY,X3,JZ,"NULL",B0,J
- SA1 A0 X1=X(N) A1=(X(N))
- SA2 SXYZ X2=SXYZ(N-1)
- RX6 X1*X6 X6=X(N)*SYZ(N,N)
- RX6 X2+X6 X6=SXYZ(N-1)+X(N)*SYZ(N,N)
- NX6 X6 X6=SXYZ(N)=RMBIL
- JP [99]
- [4] SA3 A0 X3=X(1)
- SA4 X1 X4=Y(1,1)
- SA5 X2 X5=Z(1)
- RX6 X3*X4 X6=X(1)*Y(1,1)
- RX6 X6*X5 X6=SXYZ(1)=RMBIL
- JP [99]
- [5] SA4 X1 X4=Y(1,1) A4=(Y(1,1))
- SA3 X2 X3=Z(1) A3=(Z(1))
- SA5 A4+IY X5=Y(2,1) A5=(Y(2,1))
- RX6 X4*X3 X6=Y(1,1)*Z(1)
- SA4 A4+JY X4=Y(1,2) A4=(Y(1,2))
- RX7 X5*X3 X7=Y(2,1)*Z(1)
- SA3 A3+JZ X3=Z(2) A3=(Z(2))
- SA5 A5+JY X5=Y(2,2) A5=(Y(2,2))
- SA1 A0 X1=X(1) A1=(X(1))
- SA2 A0+IX X2=X(2) A2=(X(2))
- RX4 X4*X3 X4=Y(1,2)*Z(2)
- RX5 X5*X3 X5=Y(2,2)*Z(2)
- RX6 X6+X4 X6=Y(1,1)*Z(1)+Y(1,2)*Z(2)
- RX7 X7+X5 X7=Y(2,1)*Z(1)+Y(2,2)*Z(2)
- NX6 X6 X6=SYZ(1)
- NX7 X7 X7=SYZ(2)
- RX6 X1*X6 X6=X(1)*SYZ(1)
- RX7 X2*X7 X7=X(2)*SYZ(2)
- RX6 X6+X7 X6=X(1)*SYZ(1)+X(2)*SYZ(2)
- NX6 X6 X6=SXYZ(2)=RMBIL
- JP [99]
- [6] BSS 0 N=3,5,7,...; J=2-N
-* X1=(Y(I,1))
-* X2=(Z(1))
- RMMPY6H "PLUS",IY,"NULL",B0,B0,SAVEY,I
- RMPY6R "PLUS",JY,JZ,J J=+1
- RMBIL6T N,IX,SXYZ,SAVEY,SAVEZ,J X6=SXYZ
- MI I,[6] WHILE I<0 PROCESS NEXT 3 ROWS
- S_I I-1 I=+1,0,-1; N=0,1,2
- ZR I,[3] IF N=1 PROCESS LAST ROW
- MI I,[2] IF N=2 PROCESS LAST 2 ROWS
- [99] BSS 0 X6=RMBIL
- RMBIL ENDM
- RUMPY6H MACRO N,&,IX,JX,JY,#,Z,IZ,SAVEX,SAVEY,J
- LAMBDA IFC EQ,*#*0* # IS 0
-* X1=(X(1,1))
-* X2=(Y(1))
- + SA3 X1 0 X3=X(1,1) A3=(X(1,1))
- SA2 X2 1 X2=Y(1) A2=(Y(1))
- SA4 A3+JX 2 X4=X(1,2) A4=(X(1,2))
- SA5 A2+JY 3 X5=Y(2) A5=(Y(2)
- + SX0 J 4 X0=J (TO SAVE J)
- SA1 A4+IX 5 X0 X1=X(2,2) A1=(X(2,2))
- S_J IX+JX 6 J=IX+JX
-* 7 X3
- S_J J+J 8 X2 J=2IX+2JX
- + RX6 X3*X2 9 X4 X6=X(1,1)*Y(1)
- SX7 A1+J 10 X5 X7=(X(4,4))
- RX4 X4*X5 11 X7 X4=X(1,2)*Y(2)
-* 12 X1
- RX1 X1*X5 13 X6 X1=X(2,2)*Y(2)
- + SA7 SAVEX 14 SAVEX=(X(4,4))
- SIGMA IFC EQ,*&*+* 15 X4 X6=&X(1,1)*Y(1)
- BX6 X6
- SIGMA ELSE
- BX6 -X6
- SIGMA ENDIF
- SA2 A5+JY 16 X6 X2=Y(3) A2=(Y(3))
- + RX6 X6_&_X4 17 X1 X6=&X(1,1)*Y(1)&X(1,2)*Y(2)
- SX7 A2+JY 18 X7=(Y(4))
- SA3 A4+JX 19 X7 X3=X(1,3) A3=(X(1,3))
- SA4 A1+JX 20 X6 X4=X(2,3) A4=(X(2,3))
-* 21
- + SA5 A4+IX 22 X5=X(3,3) A5=(X(3,3))
- SA7 SAVEY 23 X2 SAVEY=(Y(4))
- SIGMA IFC EQ,*&*+* 24 X7=&X(2,2)*Y(2)
- BX7 X1
- SIGMA ELSE
- BX7 -X1
- SIGMA ENDIF
-* 25
- + S_J X0 26 X3 RESTORE J
- MX0 0 27 X4 X0=0.
- S_N N-3 28 X0 N=N-3
- NX6 X6 29 NORMALIZE X6
- LAMBDA ELSE # IS + OR -
-* X1=(X(1,1))
-* X2=(Y(1))
- + SA4 X1 0 X4=X(1,1) A4=(X(1,1))
- SA5 X2 1 X5=Y(1) A5=(Y(1))
- SA1 Z 2 X1=Z(1) A1=(Z(1))
- SA3 A4+JX 3 X3=X(1,2) A3=(X(1,2))
- + SX0 J 4 X0=J (TO SAVE J)
- S_J IX+JX 5 X0 J=IX+JX
- NO 6
- SA2 A5+JY 7 X4 X2=Y(2) A2=(Y(2))
- + S_J J+J 8 X5 J=2IX+2JX
- RX6 X4*X5 9 X1 X6=X(1,1)*Y(1)
- LAMBDA2 IFC EQ,*#*+* 10 X3 X1=#Z(1)
- BX1 X1
- LAMBDA2 ELSE
- BX1 -X1
- LAMBDA2 ENDIF
- SA4 A3+IX 11 X1 X4=X(2,2) A4=(X(2,2))
-* 12
- + SA5 Z+IZ 13 X6 X5=Z(2) A5=(Z(2))
- RX6 X1_&_X6 14 X2 X6=#Z(1)&X(1,1)*Y(1)
- RX3 X3*X2 15 X3=X(1,2)*Y(2)
- SA1 A5+IZ 16 X1=Z(3) A1=(Z(3))
-* 17 X6
-* 18 X4
- + NX6 X6 19 X3
- RX4 X4*X2 20 X5 X4=X(2,2)*Y(2)
- SX7 A4+J 21 X6 X7=(X(4,4))
- RX6 X6_&_X3 22 X7 X6=#Z(1)&X(1,1)*Y(1)&X(1,2)*Y(2)
- + SA7 SAVEX 23 X1 SAVEX=(X(4,4))
- SA2 A2+JY 24 X4 X2=Y(3) A2=(Y(3))
- S_J X0 25 X6 RESTORE J
- + SA3 A3+JX 26 X3=X(1,3) A3=(X(1,3))
- LAMBDA2 IFC EQ,*#*+* 27 X5=#Z(2)
- BX5 X5
- LAMBDA2 ELSE
- BX5 -X5
- LAMBDA2 ENDIF
- SX7 A2+JY 28 X5 X7=(Y(4))
- LAMBDA2 IFC EQ,*#*+* 29 X7 X0=#Z(3)
- BX0 X1
- LAMBDA2 ELSE
- BX0 -X1
- LAMBDA2 ENDIF
- + NX6 X6 30 X0
- SA7 SAVEY 31 X2 SAVEY=(Y(4))
- RX7 X5_&_X4 32 X6 X7=#Z(2)&X(2,2)*Y(2)
- + SA4 A4+JX 33 X3 X4=X(2,3) A4=(X(2,3))
-* 34
- SA5 A4+IX 35 X7 X5=X(3,3) A5=(X(3,3))
- S_N N-3 36 N=N-3
- LAMBDA ENDIF
- RUMPY6H ENDM
- RUMPY MACRO &,N,IX,JX,JY,#,Z,IZ,TEMP,J X1=(X), X2=(Y)
- LOCAL [1],[2],[3],[4],[5],[6],[7],[99]
- LOCAL SAVEX,SAVEY
- SAVEX EQU TEMP
- SAVEY EQU TEMP+1
- SX5 N X5=N
- LX5 59 SIGN(X5)=MOD(N,2)
- BRANCH [4],N,LE,4,J J=4-N; IF N<5 GO TO [4]
- MI X5,[2] IF N IS ODD GO TO [2]
- [1] BSS 0 N = 6,8,10,...; J=4-N=-2,-4,-6,...
- RUMPY6H N,&,IX,JX,JY,#,Z,IZ,SAVEX,SAVEY,J N=N-3=3,5,7,...
- RMPY3H &,JX,JY
- RMPY6R &,JX,JY,J J=0
- S_J 4
- RMPY6T N,&,Z,IZ,SAVEX,SAVEY,J J=+1,-1,-3,...
- PL J,[5] IF N=3 GO TO [5]
- [2] BSS 0 N=5,7,9,...; J=4-N=-1,-3,-5,...
- RUMPY6H N,&,IX,JX,JY,#,Z,IZ,SAVEX,SAVEY,J N=N-3=2,4,6,...
- RMPY6R &,JX,JY,J J=0
- S_J 4
- RMPY6T N,&,Z,IZ,SAVEX,SAVEY,J J=+2,0,-2,...
- MI J,[1] IF N=6,8,10,...
- ZR J,[6] IF N=4 GO TO [6]
- [3] BSS 0 N = 2
- LAMBDA IFC EQ,*#*0*
- SA1 X1 X1=X(1,1) A1=(X(1,1))
- SA2 X2 X2=Y(1) A2=(Y(1))
- SA4 A1+JX X4=X(1,2) A4=(X(1,2))
- SA3 A2+JY X3=Y(2) A3=(Y(2))
- SA5 A4+IX X5=X(2,2) A5=(X(2,2))
- RX6 X1*X2 X6=X(1,1)*Y(1)
- RX1 X4*X3 X1=X(1,2)*Y(2)
- RX7 X5*X3 X7=X(2,2)*Y(2)
- RX6 X6+X1 X6=X(1,1)*Y(1)+X(1,2)*Y(2)
- SIGMA IFC EQ,*&*-*
- BX7 -X7 X7=Z(2)
- BX6 -X6 X6=Z(1)
- SIGMA ENDIF
- NX6 X6
- SA7 Z+IZ Z(2)=&X(2,2)*Y(2)
- SA6 Z Z(1)=&(X(1,1)*Y(1)+X(1,2)*Y(2))
- LAMBDA ELSE
- SA4 X1 X4=X(1,1) A4=(X(1,1))
- SA3 X2 X3=Y(1) A3=(Y(1))
- SA1 Z X1=Z(1)
- SA2 Z+IZ X2=Z(2)
- RX0 X4*X3 X0=X(1,1)*Y(1)
- SA4 A4+JX X4=X(1,2) A4=(X(1,2))
- SA3 A3+JY X3=Y(2) A3=(Y(2))
- SA5 A4+IX X5=X(2,2) A5=(X(2,2))
- LAMBDA2 IFC EQ,*#*+*
- BX6 X1 X6=#Z(1)
- BX7 X2 X7=#Z(2)
- LAMBDA2 ELSE
- BX6 -X1
- BX7 -X2
- LAMBDA2 ENDIF
- RX1 X4*X3 X1=X(1,2)*Y(2)
- RX6 X6_&_X0 X6=&X(1,1)*Y(1) # Z(1)
- RX0 X5*X3 X0=X(2,2)*Y(2)
- NX6 X6
- RX7 X7_&_X0 X7=&X(2,2)*Y(2) # Z(2)
- RX6 X6_&_X1 X6=&(X(1,1)*Y(1)+X(1,2)*Y(2))#Z(1)
- NX7 X7
- NX6 X6
- SA7 Z+IZ
- SA6 Z
- LAMBDA ENDIF
- JP [99] GO TO [99]
- [4] BSS 0 N=1,2,3,4; J=4-N=3,2,1,0
- ZR J,[6] IF N=4 GO TO [6]
- S_J J-2 J=+1,0,-1
- ZR J,[3] IF N=2 GO TO [3]
- PL J,[7] IF N=1 GO TO [7]
- [5] BSS 0 N = 3
- RUMPY6H N,&,IX,JX,JY,#,Z,IZ,SAVEX,SAVEY,J
- RMPY6T N,&,Z,IZ,SAVEX,SAVEY,J
- JP [99] GO TO [99]
- [6] BSS 0 N = 4
- RUMPY6H N,&,IX,JX,JY,#,Z,IZ,SAVEX,SAVEY,J
- RMPY3H &,JX,JY
- RMPY6T N,&,Z,IZ,SAVEX,SAVEY,J N = 1
- [7] BSS 0 N = 1
- SA5 X1 X5=X(1,1)
- SA4 X2 X4=Y(1)
- LAMBDA IFC EQ,*#*0* # IS NULL
- RX6 X5*X4 X6=X(1,1)*Y(1)
- SIGMA IFC EQ,*&*-* & IS -
- BX6 -X6 X6=&X(1,1)*Y(1)
- SIGMA ENDIF
- SA6 Z Z(1)=&X(1,1)*Y(1)
- LAMBDA ELSE # IS + OR -
- SA3 Z X3=Z(1)
- RX6 X5*X4 X6=X(1,1)*Y(1)
- LAMBDA2 IFC EQ,*#*-* # IS -
- BX3 -X3 X3=#Z(1)
- LAMBDA2 ENDIF
- RX6 X3_&_X6 X6=&X(1,1)*Y(1) # Z(1)
- NX6 X6
- SA6 Z Z(1)=&X(1,1)*Y(1) # Z(1)
- LAMBDA ENDIF
- [99] BSS 0
- RUMPY ENDM
- DMPY1R MACRO &,JX,JY,J
- LOCAL [1]
- [1] BSS 0 FOR K = 0, 1, 2, ...
- + FX6 X0+X7 0 X4 X6=U(C'(1+K)+F'(1+K))=G'(1+K)
- DX7 X0+X7 1 X2 X7=L(C'(1+K)+F'(1+K))=G''(1+K)
- FX3 X3*X4 2 X3=U(X''(2+K)*Y'(2+K))
-* 3 X6
- FX5 X2*X5 4 X7 X5=U(X'(2+K)*Y''(2+K))
- + NX1 X6 5 X1=G'(1+K)
- FX0 X2*X4 6 X3 X0=U(X'(2+K)*Y'(2+K))=A'(2+K)
- NX7 X7 7 X1 X7=G''(1+K)
- DX2 X2*X4 8 X5 X2=L(X'(2+K)*Y'(2+K))=A''(2+K)
- + S_J J+1 9 X7 J=2-N+1+K
- FX6 X1+X7 10 X0 X6=U(G'(1+K)+G''(1+K))=S'(1+K)
- DX7 X1+X7 11 X7=L(G'(1+K)+G''(1+K))=S''(1+K)
- + FX3 X3+X5 12 X2 X3=U(X''*Y'+X'*Y'')=B'(2+K)
- SA5 A5+JY 13 X6 X5=Y''(3+K)
- DX4 X6_&_X0 14 X7 X4=L(S'(1+K)&A'(2+K))=C''(2+K)
- FX0 X6_&_X0 15 X3 X0=U(S'(1+K)&A'(2+K))=C'(2+K)
- + FX1 X2+X3 16 X1=U(A''(2+K)+B'(2+K))=D'(2+K)
- SA3 A3+JX 17 X4 X3=X''(3+K)
- FX7 X7+X4 18 X0 X7=U(S''(1+K)+C''(2+K))=E'(2+K)
- SA4 A4+JY 19 X1 X4=Y'(3+K)
- + SA2 A2+JX 20 X5 X2=X'(3+K)
-* 21 X7
- FX7 X7_&_X1 22 X7=U(E'(2+K)&D'(2+K))=F'(2+K)
-* 23
-* 24 X3
- MI J,[1] 25 X7 WHILE 3-N+K=J<0; I.E.4+K .LE. N
- DMPY1R ENDM
- DMMPY1T MACRO N,&,Z,IZ,SAVEX,SAVEY,J
- FX6 X0+X7 26 X4 X6=U(C'(N-1)+F'(N-1))=G'(N-1)
- DX7 X0+X7 27 X2 X7=L(C'(N-1)+F'(N-1))=G''(N-1)
- + FX3 X3*X4 28 X3=U(X''(N)*Y'(N))
-* 29 X6
- FX5 X2*X5 30 X7 X5=U(X'(N)*Y''(N))
- NX1 X6 31 X1=G'(N-1)
- FX0 X2*X4 32 X3 X0=U(X'(N)*Y'(N))=A'(N)
-* 33 X1
- + NX7 X7 X7=G''(N-1)
- DX2 X2*X4 X2=L(X'(N)*Y'(N))=A''(N)
- FX6 X1+X7 X6=U(G'(N-1)+G''(N-1))=S'(N-1)
- DX7 X1+X7 X7=L(G'(N-1)+G''(N-1))=S''(N-1)
- FX3 X3+X5 X3=U(X''(N)*Y'(N)+X'(N)*Y''(N))=B'(N)
- DX4 X6_&_X0 X4=L(S'(N-1)&A'(N))=C''(N)
- FX0 X6_&_X0 X0=U(S'(N-1)&A'(N))=C'(N)
- FX5 X2+X3 X5=U(A''(N)+B'(N))=D'(N)
- SA1 SAVEX
- FX7 X7+X4 X7=U(S''(N-1)+C''(N))=E'(N)
- SA2 SAVEY
- FX7 X7_&_X5 X7=U(E'(N)&D'(N))=F'(N)
- FX6 X0+X7 X6=U(C'(N)+F'(N))=G'(N)
- DX7 X0+X7 X7=L(C'(N)+F'(N))=G''(N)
- NX5 X6 X5=G'(N)
- NX7 X7 X7=G''(N)
- FX6 X5+X7 X6=U(G'(N)+G''(N))=S'(N)
- DX7 X5+X7 X7=L(G'(N)+G''(N))=S''(N)
- S_J J-N J=J-N
- SA6 Z Z'=S'(N)
- SA7 Z+1 Z''=S''(N)
- S_Z Z+IZ (Z)=(Z)+IZ
- DMMPY1T ENDM
- DVMPY MACRO &,N,X,JX,Y,JY,#,Z,J
- LOCAL [1],[2]
- S_J 1 J=1
- LAMBDA IFC NE,*#*0*
- SA1 Z X1=Z'
- SA2 Z+J X2=Z''
- LAMBDA ENDIF
- SA5 Y+J X5=Y''(1)
- SA3 X+J X3=X''(1)
- LAMBDA IFC EQ,*#*+*
- BX6 X1 X6=#Z'
- BX7 X2 X7=#Z''
- LAMBDA ENDIF
- LAMBDA IFC EQ,*#*-*
- BX6 -X1
- BX7 -X2
- LAMBDA ENDIF
- SA4 A5-J X4=Y'(1)
- SA2 A3-J X2=X'(1)
- S_J 2 J=2
- FX3 X3*X4 X3=U(X''(1)*Y'(1))
- S_J J-N J=2-N
- FX5 X2*X5 X5=U(X'(1)*Y''(1))
- FX0 X2*X4 X0=U(X'(1)*Y'(1)=A'(1)
- DX2 X2*X4 X2=L(X'(1)*Y'(1))=A''(1)
- FX3 X3+X5 X3=U(X''*Y'+X'*Y'')=B'(1)
- LAMBDA IFC NE,*#*0*
- DX4 X6_&_X0 X4=L(Z'&A'(1))=C''(1)
- FX0 X6_&_X0 X0=U(Z'&A'(1))=C'(1)
- FX1 X2+X3 X1=U(A''(1)+B'(1))=D'(1)
- FX7 X7+X4 X7=U(Z''+C''(1))=E'(1)
- LAMBDA ELSE
- MX7 0
- FX1 X2+X3 X1=U(A''(1)+B'(1))=D'(1)
- LAMBDA ENDIF
- FX7 X7_&_X1 X7=U(E'(1)&D'(1))=F'(1)
- GT J,B0,[2] IF N=1 GO TO [2]
- SA5 A5+JY X5=Y''(2)
- SA3 A3+JX X3=X''(2)
- SA4 A4+JY X4=Y'(2)
- SA2 A2+JX X2=X'(2)
- ZR J,[1] IF N=2 GO TO [1]
- DMPY1R &,JX,JY,J
- [1] FX6 X0+X7 X6=U(C'(N-1)+F'(N-1))=G'(N-1)
- DX7 X0+X7 X7=L(C'(N-1)+F'(N-1))=G''(N-1)
- FX3 X3*X4 X3=U(X''(N)*Y'(N))
- FX5 X2*X5 X5=U(X'(N)*Y''(N))
- NX1 X6 X1=G'(N-1)
- FX0 X2*X4 X0=U(X'(N)*Y'(N))=A'(N)
- NX7 X7 X7=G''(N-1)
- DX2 X2*X4 X2=L(X'(N)*Y'(N))=A''(N)
- FX6 X1+X7 X6=U(G'(N-1)+G''(N-1))=S'(N-1)
- DX7 X1+X7 X7=L(G'(N-1)+G''(N-1))=S''(N-1)
- FX3 X3+X5 X3=U(X''*Y'+X'*Y'')=B'(N)
- DX4 X6_&_X0 X4=L(S'(N-1)&A'(N))=C''(N)
- FX0 X6_&_X0 X0=U(S'(N-1)&A'(N))=C'(N)
- FX1 X2+X3 X1=U(A''(N)+B'(N))=D'(N)
- FX7 X7+X4 X7=U(S''(N-1)+C''(N))=E'(N)
- FX7 X7_&_X1 X7=U(E'(N)&D'(N))=F'(N)
- [2] FX6 X0+X7 X6=U(C'(N)+F'(N))=G'(N)
- DX7 X0+X7 X7=L(C'(N)+F'(N))=G''(N)
- NX1 X6 X1=G'(N)
- NX7 X7 X7=G''(N)
- FX6 X1+X7 X6=U(G'(N)+G''(N))=S'(N)
- DX7 X1+X7 X7=L(G'(N)+G''(N))=S''(N)
- DVMPY ENDM
- DMMPY1H MACRO &,IX,JX,JY,#,Z,SAVEX,I
- LAMBDA IFC EQ,*#*0* # IS 0
- + SA4 X2 0 X4=Y'(1) A4=(Y'(1))
- SA3 X1+1 1 X3=X''(1,1) A3=(X''(1,1))
- SA2 X1 2 X2=X'(1,1) A2=(X'(1,1))
- + SA5 A4+1 3 X5=Y''(1) A5=(Y''(1))
- S_I I+1 4 I=I+1
-* 5
-* 6
-* 7 X4
-* 8 X3
- + FX0 X3*X4 9 X2 X0=X''(1,1)*Y'(1)
- SX7 A2+IX 10 X5 X7=(X'(2,1))
- FX5 X2*X5 11 X7 X5=X'(1,1)*Y''(1)
- SA3 A3+JX 12 X3=X''(1,2) A3=(X''(1,2))
- + DX6 X2*X4 13 X0 X6=L(X'(1,1)*Y'(1))=A''(1)
- SA7 SAVEX 14 SAVEX=(X'(2,1))
-* 15 X5
-* 16
- FX1 X0+X5 17 X6 X1=U(X''*Y'+X'*Y'')=B'(1)
- + FX0 X2*X4 18 X0=U(X'(1,1)*Y'(1))=A'(1)
- SA5 A5+JY 19 X3 X5=Y''(2) A5=(Y''(2))
-* 20 X1
- FX1 X6+X1 21 X1=U(A''(1)+B'(1))=D'(1)
- SA4 A4+JY 22 X0 X4=Y'(2) A4=(Y'(2))
- SA2 A2+JX 23 X2=X'(1,2) A2=(X'(1,2))
- SIGMA IFC EQ,*&*+*
- BX7 X1
- SIGMA ELSE
- BX0 -X0 X0=&A'(1)=C'(1)
- BX7 -X1 X7=&D'(1)=F'(1)
- SIGMA ENDIF
- LAMBDA ELSE # IS + OR -
- SA5 Z+1 X5=Z''(1)
- SA3 X1+1 X3=X''(1,1) A3=(X''(1,1))
- SX6 X1+IX X6=(X'(2,1))
- SA4 X2 X4=Y'(1) A4=(Y'(1))
- SA2 X1 X2=X'(1,1) A2=(X'(1,1))
- SA1 Z X1=Z'(1)
- LAMBDA2 IFC EQ,*#*+*
- BX7 X5
- LAMBDA2 ELSE
- BX7 -X5 X7=#Z''(1)
- LAMBDA2 ENDIF
- SA5 A4+1 X5=Y''(1) A5=(Y''(1))
- FX3 X3*X4 X3=U(X''*Y')
- SA6 SAVEX SAVEX=(X'(2,1))
- LAMBDA2 IFC EQ,*#*+*
- BX6 X1
- LAMBDA2 ELSE
- BX6 -X1 X6=#Z'(1)
- LAMBDA2 ENDIF
- FX0 X2*X4 X0=U(X'*Y')=A'(1)
- FX5 X2*X5 X5=U(X'*Y'')
- S_I I+1 I=I+1
- DX2 X2*X4 X2=L(X'*Y')=A''(1)
- DX4 X6_&_X0 X4=L(#Z' & A')=C''(1)
- FX3 X3+X5 X3=U(X''*Y'+X'*Y'')=B'(1)
- SA5 A5+JY X5=Y''(2) A5=(Y''(2))
- FX0 X6_&_X0 X0=U(#Z' & A')=C'(1)
- FX1 X2+X3 X1=U(A''+B')=D'(1)
- SA3 A3+JX X3=X''(1,2) A3=(X''(1,2))
- FX7 X7+X4 X7=U(#Z''+C'')=E'(1)
- SA4 A4+JY X4=Y'(2) A4=(Y'(2))
- SA2 A2+JX X2=X'(1,2) A2=(X'(1,2))
- FX7 X7_&_X1 X7=U(E' & D')=F'(1)
- LAMBDA ENDIF
- DMMPY1H ENDM
- DMMPY MACRO &,I,N,IX,JX,JY,#,Z,IZ,TEMP,J X1=(X), X2=(Y)
- LOCAL [1],[2],[3],[99],SAVEX,SAVEY
- SAVEX EQU TEMP
- SAVEY EQU TEMP+1
- BX7 X2 X7=(Y)
- SA7 SAVEY SAVEY=(Y)
- BRANCH [3],N,GT,2,J,I,I J=2-N, I=-M
- NZ J,[2] IF N=1 GO TO [2]
- [1] DMMPY1H &,IX,JX,JY,#,Z,SAVEX,I I=I+1
- DMMPY1T N,&,Z,IZ,SAVEX,SAVEY,J
- MI I,[1] WHILE I<0
- JP [99]
- [2] BSS 0
- LAMBDA IFC EQ,*#*0* # IS 0
- S_N X1 N=(X)
- SA1 X2 X1=Y'
- SA2 X2+1 X2=Y''
- S_I -I I=M
- SIGMA IFC EQ,*&*-*
- BX1 -X1 X1=&Y'
- BX2 -X2 X2=&Y''
- SIGMA ENDIF
- DVSCL I,N,IX,Z,IZ,J
- S_N 1 RESTORE N
- LAMBDA ELSE
- SA3 X2 X3=Y'
- BX4 X1 X4=(X)
- SA1 X2+1 X1=Y''
- SX2 Z X2=(Z)
- S_I -I I=M
- SIGMA IFC EQ,*&*-*
- BX0 -X3 X0=&Y'
- BX1 -X1 X1=&Y''
- SIGMA ELSE
- BX0 X3
- SIGMA ENDIF
- DVSCA I,IX,#,IZ,Z,IZ,J
- LAMBDA ENDIF
- JP [99]
- [3] BSS 0 N=3,4,5,...; J=2-N=-1,-2,-3,...
- DMMPY1H &,IX,JX,JY,#,Z,SAVEX,I I=I+1
- DMPY1R &,JX,JY,J J=0
- S_J 2
- DMMPY1T N,&,Z,IZ,SAVEX,SAVEY,J J=2-N=-1,-2,-3,...
- MI I,[3] WHILE I<0
- [99] BSS 0
- DMMPY ENDM
- DUMPY1H MACRO N,&,IX,JX,JY,#,Z,SAVEX,SAVEY
- LAMBDA IFC EQ,*#*0* # IS 0
- + SA4 X2 0 X4=Y'(1) A4=(Y'(1))
- SA3 X1+1 1 X3=X''(1,1) A3=(X''(1,1))
- SX7 X1+JX 2 X7=(X'(1,2))
- + SA2 X1 3 X7 X2=X'(1,1) A2=(X'(1,1))
- SA5 A4+1 4 X5=Y''(1) A5=(Y''(1))
- SX6 A4+JY 5 X6=(Y'(2))
-* 6 X6
-* 7 X4
- + SX7 X7+IX 8 X3 X7=(X'(2,2))
- FX0 X3*X4 9 X7 X0=X''(1,1)*Y'(1)
- SA6 SAVEY 10 X2 SAVEY=(Y'(2))
- + SA7 SAVEX 11 X5 SAVEX=(X'(2,2))
- FX5 X2*X5 12 X5=X'(1,1)*Y''(1)
- SA3 A3+JX 13 X0 X3=X''(1,2) A3=(X''(1,2))
- + DX6 X2*X4 14 X6=L(X'(1,1)*Y'(1))=A''(1)
-* 15
-* 16 X5
-* 17
- FX1 X0+X5 18 X6 X1=U(X''*Y'+X'*Y'')=B'(1)
- FX0 X2*X4 19 X0=U(X'(1,1)*Y'(1))=A'(1)
- SA4 A4+JY 20 X3 X4=Y'(2) A4=(Y'(2))
- + SA2 A2+JX 21 X1 X2=X'(1,2) A2=(X'(1,2))
- FX1 X6+X1 22 X1=U(A''(1)+B'(1))=D'(1)
- SA5 A5+JY 23 X0 X5=Y''(2) A5=(Y''(2))
-* 24
- SIGMA IFC EQ,*&*+* 25 X1 X0=&A'(1)=C'(1)
- NO
- SIGMA ELSE
- BX0 -X0
- SIGMA ENDIF
- + S_N N-1 26 X0 N=N-1
- NO 27 X4
- SIGMA IFC EQ,*&*+* 28 X2 X7=&D'(1)=F'(1)
- BX7 X1
- SIGMA ELSE
- BX7 -X1
- SIGMA ENDIF
- LAMBDA ELSE # IS + OR -
- SA5 Z X5=Z'(1) A5=(Z'(1))
- SA3 X1+1 X3=X''(1,1) A3=(X''(1,1))
- SX7 X2+JY X7=(Y'(2))
- SA4 X2 X4=Y'(1) A4=(Y'(1))
- SA7 SAVEY SAVEY=(Y'(2))
- SA2 X1 X2=X'(1,1) A2=(X'(1,1))
- LAMBDA2 IFC EQ,*#*+*
- BX6 X5
- LAMBDA2 ELSE
- BX6 -X5 X6=#Z'(1)
- LAMBDA2 ENDIF
- SA5 A4+1 X5=Y''(1) A5=(Y''(1))
- SX7 X1+JX X7=(X'(1,2))
- SA1 Z+1 X1=Z''(1)
- SX7 X7+IX X7=(X'(2,2))
- FX3 X3*X4 X3=U(X''*Y')
- SA7 SAVEX SAVEX=(X'(2,2))
- FX0 X2*X4 X0=U(X'*Y')=A'(1)
- FX5 X2*X5 X5=U(X'*Y'')
- S_N N-1 N=N-1
- DX2 X2*X4 X2=L(X'*Y')=A''(1)
- LAMBDA2 IFC EQ,*#*+*
- BX7 X1
- LAMBDA2 ELSE
- BX7 -X1 X7=#Z''(1)
- LAMBDA2 ENDIF
- FX3 X3+X5 X3=U(X''*Y'+X'*Y'')=B'(1)
- DX4 X6_&_X0 X4=L(#Z' & A')=C''(1)
- FX0 X6_&_X0 X0=U(#Z' & A')=C'(1)
- SA5 A5+JY X5=Y''(2) A5=(Y''(2))
- FX1 X2+X3 X1=U(A''+B')=D'(1)
- SA3 A3+JX X3=X''(1,2) A3=(X''(1,2))
- FX7 X7+X4 X7=U(#Z''+C'')=E'(1)
- SA4 A4+JY X4=Y'(2) A4=(Y'(2))
- SA2 A2+JX X2=X'(1,2) A2=(X'(1,2))
- FX7 X7_&_X1 X7=U(E' & D')=F'(1)
- LAMBDA ENDIF
- DUMPY1H ENDM
- DUMPY MACRO &,N,IX,JX,JY,#,Z,IZ,TEMP,J X1=(X), X2=(Y)
- LOCAL [1],[2],[3],SAVEX,SAVEY
- SAVEX EQU TEMP
- SAVEY EQU TEMP+1
- BRANCH [2],N,LE,2,J J=2-N; IF(N.LE.2) GO TO [2]
- [1] BSS 0 N=3,4,5,...; J=-1,-2,-3,...
- DUMPY1H N,&,IX,JX,JY,#,Z,SAVEX,SAVEY N=N-1=2,3,4,...
- DMPY1R &,JX,JY,J J=0
- S_J 2
- DMMPY1T N,&,Z,IZ,SAVEX,SAVEY,J J=0,-1,-2,...
- MI J,[1] IF N=3,4,5,...
- [2] BSS 0 N=1,2 J=1,0
- NE J,B0,[3] IF(N=1) GO TO [3]
- DUMPY1H N,&,IX,JX,JY,#,Z,SAVEX,SAVEY N=N-1=1
- DMMPY1T N,&,Z,IZ,SAVEX,SAVEY,J
- [3] BSS 0 N=1
- LAMBDA IFC EQ,*#*0* # IS 0
- SA4 X2 X4=Y'
- SA3 X1+1 X3=X''
- SA2 X1 X2=X'
- SA5 A4+1 X5=Y''
- FX0 X3*X4 X0=X''Y'
- FX5 X2*X5 X5=X'Y''
- DX6 X2*X4 X6=L(X'*Y')=A''
- FX1 X0+X5 X1=U(X''*Y'+X'*Y'')=B'
- FX0 X2*X4 X0=U(X'*Y')=A'
- FX7 X6+X1 X7=U(A''+B')=D'
- SIGMA IFC EQ,*&*-*
- BX0 -X0 X0=&A'=C'
- BX7 -X7 X7=&D'=F'
- SIGMA ENDIF
- FX6 X0+X7 X6=U(C'+F')=Z'
- DX7 X0+X7 X7=L(C'+F')=Z''
- SA6 Z
- SA7 Z+1
- LAMBDA ELSE
- SA5 Z X5=Z'(1) A5=(Z'(1))
- SA3 X1+1 X3=X''(1,1) A3=(X''(1,1))
- NO DELAY
- SA4 X2 X4=Y'(1) A4=(Y'(1))
- SA2 X1 X2=X'(1,1) A2=(X'(1,1))
- NO
- LAMBDA2 IFC EQ,*#*+*
- BX6 X5
- LAMBDA2 ELSE
- BX6 -X5 X6=#Z'(1)
- LAMBDA2 ENDIF
- SA5 A4+1 X5=Y''(1) A5=(Y''(1))
- SA1 Z+1 X1=Z''(1)
- FX3 X3*X4 X3=U(X''*Y')
- FX0 X2*X4 X0=U(X'*Y')=A'(1)
- FX5 X2*X5 X5=U(X'*Y'')
- LAMBDA2 IFC EQ,*#*+*
- BX7 X1
- LAMBDA2 ELSE
- BX7 -X1 X7=#Z''(1)
- LAMBDA2 ENDIF
- DX2 X2*X4 X2=L(X'*Y')=A''(1)
- FX3 X3+X5 X3=U(X''*Y'+X'*Y'')=B'(1)
- DX4 X6_&_X0 X4=L(#Z' & A')=C''(1)
- FX0 X6_&_X0 X0=U(#Z' & A')=C'(1)
- FX1 X2+X3 X1=U(A''+B')=D'(1)
- FX7 X7+X4 X7=U(#Z''+C'')=E'(1)
- FX7 X7_&_X1 X7=U(E' & D')=F'(1)
- FX6 X0+X7 X6=U(C'+F')=G'(1)
- DX7 X0+X7 X7=L(C'+F')=G''(1)
- NX1 X6 X1=G'
- NX7 X7
- FX6 X1+X7 X6=U(G'+G'')=Z'(1)
- DX7 X1+X7 X7=L(G'+G'')=Z''(1)
- SA6 Z Z'(1)=...
- SA7 Z+1 Z''(1)=...
- LAMBDA ENDIF
- DUMPY ENDM
- CMPY1R MACRO &,JX,JY,J
- LOCAL [1]
- [1] BSS 0 FOR K = 0, 1, 2, ...
- RX7 X7_&_X5 0 X3 X7=Z''(1+K)
- RX6 X6_&_X0 1 X4 X6=Z'(1+K)
- RX0 X1*X3 2 X0=X'(2+K)*Y'(2+K)
- S_J J+A5 3 X7 J=2-N+1+K
- RX1 X1*X4 4 X6 X1=X'(2+K)*Y''(2+K)
- NX7 X7 5
- RX4 X2*X4 6 X0 X4=X''(2+K)*Y''(2+K)
- NX6 X6 7 X7
- RX5 X2*X3 8 X1 X5=X''(2+K)*Y'(2+K)
- SA2 A2+JX 9 X6 X2=X''(3+K)
- RX7 X7_&_X1 10 X4 X7=Z''(1+K) &X'(2+K)*Y''(2+K)
- SIGMA IFC EQ,*&*+* 11 X6=Z'(1+K)-&X''(2+K)*Y''(2+K)
- RX6 X6-X4
- SIGMA ELSE
- RX6 X6+X4
- SIGMA ENDIF
- SA1 A1+JX 12 X5 X1=X'(3+K)
- SA3 A3+JY 13 X7 X3=Y'(3+K)
- SA4 A4+JY 14 X6 X4=Y''(3+K)
- NX7 X7 15
- NX6 X6 16 X2
-* 17 X7
-* 18 X6
- MI J,[1] 19 X1 WHILE 3-N+K<0; I.E. 4+K.LE.N
- CMPY1R ENDM
- CCMPY1R MACRO &,JX,JY,J
- LOCAL [1]
- [1] BSS 0 FOR K = 0, 1, 2, ...
- RX7 X7_&_X5 0 X3 X7=Z''(1+K)
- RX6 X6_&_X0 1 X4 X6=Z'(1+K)
- RX0 X1*X3 2 X0=X'(2+K)*Y'(2+K)
- S_J J+A5 3 X7 J=2-N+1+K
- RX1 X1*X4 4 X6 X1=X'(2+K)*Y''(2+K)
- NX7 X7 5
- RX4 X2*X4 6 X0 X4=X''(2+K)*Y''(2+K)
- NX6 X6 7 X7
- RX5 X2*X3 8 X1 X5=X''(2+K)*Y'(2+K)
- SA2 A2+JX 9 X6 X2=X''(3+K)
- SIGMA IFC EQ,*&*+* 10 X7 X7=Z''(1+K)-&X'(2+K)*Y''(2+K)
- RX7 X7-X1
- SIGMA ELSE
- RX7 X7+X1
- SIGMA ENDIF
- RX6 X6_&_X4 11 X6=Z'(1+K) &X''(2+K)*Y''(2+K)
- SA1 A1+JX 12 X5 X1=X'(3+K)
- SA3 A3+JY 13 X7 X3=Y'(3+K)
- SA4 A4+JY 14 X6 X4=Y''(3+K)
- NX7 X7 15
- NX6 X6 16 X2
-* 17 X7
-* 18 X6
- MI J,[1] 19 X1 WHILE 3-N+K<0; I.E. 4+K.LE.N
- CCMPY1R ENDM
- CMMPY1T MACRO N,&,Z,IZ,SAVEX,SAVEY,J
- RX7 X7_&_X5 X7=Z''(N-1)
- RX6 X6_&_X0 X6=Z'(N-1)
- RX0 X1*X3 X0=X'(N)*Y''(N)
- S_J J-N J=J-N
- RX1 X1*X4 X1=X'(N)*Y''(N)
- NX7 X7
- RX4 X2*X4 X4=X''(N)*Y'(N)
- NX6 X6
- RX5 X2*X3 X5=X''(N)*Y'(N)
- RX7 X7_&_X1 X7=Z''(N-1) &X'(N)*Y''(N)
- SIGMA IFC EQ,*&*+* X6=Z'(N-1)-&X''(N)*Y''(N)
- RX6 X6-X4
- SIGMA ELSE
- RX6 X6+X4
- SIGMA ENDIF
- SA1 SAVEX
- NX7 X7
- NX6 X6
- SA2 SAVEY
- RX7 X7_&_X5 X7=Z''(N)
- RX6 X6_&_X0 X6=Z'(N)
- NX7 X7
- NX6 X6
- SA7 Z+1 Z''
- SA6 Z Z'
- S_Z Z+IZ Z=Z+IZ
- CMMPY1T ENDM
- CVMPY MACRO &,N,X,JX,Y,JY,#,Z,J
- LOCAL [1],[2]
- SA3 Y X3=Y'(1)
- SA1 X X1=X'(1)
- LAMBDA IFC EQ,*#*0*
- SA4 A3+1 X4=Y''(1)
- SA2 A1+1 X2=X''(1)
- SA5 1 X5=VOID A5=1 (SEE MACRO CMPY1R)
- S_J 2 J=2
- RX0 X1*X3 X0=X'(1)*Y'(1)
- S_J J-N J=2-N
- RX7 X1*X4 X7=X'(1)*Y''(1)
- RX6 X2*X4 X6=X''(1)*Y''(1)
- RX5 X2*X3 X5=X''(1)*Y'(1)
- SIGMA IFC EQ,*&*+*
- BX6 -X6
- SIGMA ELSE
- BX7 -X7
- SIGMA ENDIF
- LAMBDA ELSE
- SA2 Z+1 X2=Z'' A2=(Z'')
- SA4 Z X4=Z' A4=(Z')
- SA5 1 X5=VOID A5=1 (SEE MACRO CMPY1R)
- S_J 2
- S_J J-N J=2-N
- LAMBDA2 IFC EQ,*#*+*
- BX7 X2
- LAMBDA2 ENDIF
- LAMBDA2 IFC EQ,*#*-*
- BX7 -X2 X7=#Z''
- LAMBDA2 ENDIF
- SA2 A1+1 X2=X''(1) A2=(X''(1))
- LAMBDA2 IFC EQ,*#*+*
- BX6 X4
- LAMBDA2 ENDIF
- LAMBDA2 IFC EQ,*#*-*
- BX6 -X4 X6=#Z'
- LAMBDA2 ENDIF
- SA4 A3+1 X4=Y''(1) A4=(Y''(1))
- RX0 X1*X3 X0=X'(1)*Y'(1)
- RX1 X1*X4 X1=X'(1)*Y''(1)
- RX4 X2*X4 X4=X''(1)*Y''(1)
- RX5 X2*X3 X5=X''(1)*Y'(1)
- RX7 X7_&_X1 X7=Z''&X'(1)*Y''(1)
- SIGMA IFC EQ,*&*+* X6=Z'-&X''(1)*Y''(1)
- RX6 X6-X4
- SIGMA ELSE
- RX6 X6+X4
- SIGMA ENDIF
- NX7 X7
- NX6 X6
- LAMBDA ENDIF
- GT J,B0,[2] IF N=1 GO TO [2]
- SA1 A1+JX X1=X'(2)
- SA3 A3+JY X3=Y'(2)
- SA4 A4+JY X4=Y''(2)
- SA2 A2+JX X2=X''(2)
- ZR J,[1] IF N=2 GO TO [1]
- CMPY1R &,JX,JY,J
- [1] RX7 X7_&_X5 X7=Z''(N-1)
- RX6 X6_&_X0 X6=Z'(N-1)
- RX0 X1*X3 X0=X'(N)*Y'(N)
- RX1 X1*X4 X1=X'(N)*Y''(N)
- NX7 X7
- RX4 X2*X4 X4=X''(N)*Y''(N)
- NX6 X6
- RX5 X2*X3 X5=X''(N)*Y'(N)
- RX7 X7_&_X1 X7=Z''(N-1)&X'(N)*Y''(N)
- SIGMA IFC EQ,*&*+* X6=Z'(N-1)-&X''(N)*Y''(N)
- RX6 X6-X4
- SIGMA ELSE
- RX6 X6+X4
- SIGMA ENDIF
- NX7 X7
- NX6 X6
- [2] RX7 X7_&_X5 X7=Z''(N)
- RX6 X6_&_X0 X6=Z'(N)
- NX7 X7
- NX6 X6
- CVMPY ENDM
- CMMPY1H MACRO &,IX,JX,JY,#,Z,SAVEX,I
- LAMBDA IFC EQ,*#*0* # IS 0
- SA1 X1 X1=X'(1,1) A1=(X'(1,1))
- SA3 X2 X3=Y'(1) A3=(Y'(1))
- SA4 X2+1 X4=Y''(1) A4=(Y''(1))
- SA2 A1+1 X2=X''(1,1)A2=(X''(1,1))
- SX7 A1+IX X7=(X'(2,1))
- S_I I+A5 I=I+1
- SA7 SAVEX SAVEX=(X'(2,1))
- RX0 X1*X3 X0=X'(1,1)*Y'(1)
- RX7 X1*X4 X7=X'(1,1)*Y''(1)
- SA1 A1+JX X1=X'(1,2) A1=(X'(1,2))
- RX6 X2*X4 X6=X''(1,1)*Y''(1)
- SA4 A4+JY X4=Y''(2) A4=(Y''(2))
- RX5 X2*X3 X5=X''(1,1)*Y'(1)
- SA3 A3+JY X3=Y'(2) A3=(Y'(2))
- SA2 A2+JX X2=X''(1,2)A2=(X''(1,2))
- SIGMA IFC EQ,*&*+*
- BX6 -X6
- SIGMA ELSE
- BX7 -X7
- SIGMA ENDIF
- LAMBDA ELSE # IS + OR -
- SA1 X1 X1=X'(1,1) A1=(X'(1,1))
- SA3 X2 X3=Y'(1) A3=(Y'(1))
- SA2 Z+1 X2=Z''(1) A2=(Z''(1))
- SA4 Z X4=Z'(1) A4=(Z'(1))
- SX7 A1+IX X7=(X'(2,1))
- SA7 SAVEX SAVEX=(X'(2,1))
- LAMBDA2 IFC EQ,*#*+*
- BX7 X2
- LAMBDA2 ELSE
- BX7 -X2 X7=#Z''(1)
- LAMBDA2 ENDIF
- SA2 A1+1 X2=X''(1,1) A2=(X''(1,1))
- LAMBDA2 IFC EQ,*#*+*
- BX6 X4
- LAMBDA2 ELSE
- BX6 -X4 X6=#Z'(1)
- LAMBDA2 ENDIF
- SA4 A3+1 X4=Y''(1) A4=(Y''(1))
- RX0 X1*X3 X0=X'*Y'
- S_I I+A5 I=I+1
- RX5 X2*X3 X5=X''*Y'
- RX1 X1*X4 X1=X'*Y''
- RX4 X2*X4 X4=X''*Y''
- SA2 A2+JX X2=X''(1,2) A2=(X''(1,2))
- RX7 X7_&_X1 X7=#Z''(1) & X'*Y''
- SIGMA IFC EQ,*&*+*
- RX6 X6-X4
- SIGMA ELSE
- RX6 X6+X4 X6=#Z'(1) -& X''*Y''
- SIGMA ENDIF
- SA1 A1+JX X1=X'(1,2) A1=(X'(1,2))
- SA3 A3+JY X3=Y'(2) A3=(Y'(2))
- SA4 A4+JY X4=Y''(2) A4=(Y''(2))
- NX7 X7
- NX6 X6
- LAMBDA ENDIF
- CMMPY1H ENDM
- CMMPY MACRO &,I,N,IX,JX,JY,#,Z,IZ,TEMP,J X1=(X), X2=(Y)
- LOCAL [1],[2],[3],[99],SAVEX,SAVEY
- SAVEX EQU TEMP
- SAVEY EQU TEMP+1
- BX7 X2 X7=(Y)
- SA5 1 X5=VOID A5=1
- SA7 SAVEY SAVEY=(Y)
- BRANCH [3],N,GT,2,J,I,I J=2-N, I=-M
- NZ J,[2] IF N=1 GO TO [2]
- [1] CMMPY1H &,IX,JX,JY,#,Z,SAVEX,I I=I+1
- CMMPY1T N,&,Z,IZ,SAVEX,SAVEY,J
- MI I,[1] WHILE I<0
- JP [99]
- [2] BSS 0
- LAMBDA IFC EQ,*#*0* # IS 0
- S_N X1 N=(X)
- SA1 X2 X1=Y'
- SA2 X2+1 X2=Y''
- S_I -I I=M
- SIGMA IFC EQ,*&*-*
- BX1 -X1 X1=&Y'
- BX2 -X2 X2=&Y''
- SIGMA ENDIF
- CVSCL I,N,IX,Z,IZ,J
- S_N 1 RESTORE N
- LAMBDA ELSE # IS + OR -
- SA3 X2 X3=Y'
- BX4 X1 X4=(X)
- SA1 X2+1 X1=Y''
- SX2 Z X2=(Z)
- S_I -I I=M
- SIGMA IFC EQ,*&*-*
- BX0 -X3 X0=&Y'
- BX1 -X1 X1=&Y''
- SIGMA ELSE
- BX0 X3
- SIGMA ENDIF
- CVSCA I,IX,#,IZ,Z,IZ,J
- LAMBDA ENDIF
- JP [99]
- [3] BSS 0 N=3,4,5,...; J=2-N=-1,-2,-3,...
- CMMPY1H &,IX,JX,JY,#,Z,SAVEX,I I=I+1
- CMPY1R &,JX,JY,J J=0
- S_J 2
- CMMPY1T N,&,Z,IZ,SAVEX,SAVEY,J J=2-N=-1,-2,-3,...
- MI I,[3] WHILE I<0
- [99] BSS 0
- CMMPY ENDM
- CUMPY1H MACRO N,&,IX,JX,JY,#,Z,SAVEX,SAVEY
- LAMBDA IFC EQ,*#*0* # IS 0
- SA1 X1 X1=X'(1,1) A1=(X'(1,1))
- SA3 X2 X3=Y'(1) A3=(Y'(1))
- SA4 X2+1 X4=Y''(1) A4=(Y''(1))
- SA2 A1+1 X2=X''(1,1)A2=(X''(1,1))
- SX7 A1+IX X7=(X'(2,1))
- SX6 A3+JY X6=(Y'(2))
- SX7 X7+JX X7=(X'(2,2))
- SA6 SAVEY SAVEY=(Y'(2))
- RX0 X1*X3 X0=X'(1,1)*Y'(1)
- SA7 SAVEX SAVEX=(X'(2,2))
- RX7 X1*X4 X7=X'(1,1)*Y''(1)
- SA1 A1+JX X1=X'(1,2) A1=(X'(1,2))
- RX6 X2*X4 X6=X''(1,1)*Y''(1)
- SA4 A4+JY X4=Y''(2) A4=(Y''(2))
- RX5 X2*X3 X5=X''(1,1)*Y'(1)
- SA3 A3+JY X3=Y'(2) A3=(Y'(2))
- SA2 A2+JX X2=X''(1,2)A2=(X''(1,2))
- SIGMA IFC EQ,*&*+*
- BX6 -X6
- SIGMA ELSE
- BX7 -X7
- SIGMA ENDIF
- S_N N-1 N=N-1
- LAMBDA ELSE # IS + OR -
- SX6 X1+JX X6=(X'(1,2))
- SX7 X2+JY X7=(Y'(2))
- SA1 X1 X1=X'(1,1) A1=(X'(1,1))
- SX6 X6+IX X6=(X'(2,2))
- SA3 X2 X3=Y'(1) A3=(Y'(1))
- SA4 Z X4=Z'(1) A4=(Z'(1))
- SA2 Z+1 X2=Z''(1) A2=(Z''(1))
- SA6 SAVEX SAVEX=(X'(2,2))
- SA7 SAVEY SAVEY=(Y'(2))
- LAMBDA2 IFC EQ,*#*+*
- BX6 X4
- LAMBDA2 ELSE
- BX6 -X4 X6=#Z'(1)
- LAMBDA2 ENDIF
- SA4 A3+1 X4=Y''(1) A4=(Y''(1))
- LAMBDA2 IFC EQ,*#*+*
- BX7 X2
- LAMBDA2 ELSE
- BX7 -X2 X7=#Z''(1)
- LAMBDA2 ENDIF
- SA2 A1+1 X2=X''(1,1) A2=(X''(1,1))
- RX0 X1*X3 X0=X'(1,1)*Y'(1)
- RX1 X1*X4 X1=X'(1,1)*Y''(1)
- S_N N-1 N=N-1
- RX4 X2*X4 X4=X''(1,1)*Y''(1)
- RX5 X2*X3 X5=X''(1,1)*Y'(1)
- SA2 A2+JX X2=X''(1,2) A2=(X''(1,2))
- RX7 X7_&_X1 X7=#Z''(1)-&X'(1,1)*Y'(1)
- SIGMA IFC EQ,*&*+*
- RX6 X6-X4
- SIGMA ELSE
- RX6 X6+X4 X6=#Z'(1)-&X''(1,1)*Y''(1)
- SIGMA ENDIF
- SA1 A1+JX X1=X'(1,2) A1=(X'(1,2))
- SA3 A3+JY X3=Y'(2) A3=(Y'(2))
- SA4 A4+JY X4=Y''(2) A4=(Y''(2))
- NX7 X7
- NX6 X6
- LAMBDA ENDIF
- CUMPY1H ENDM
- CUMPY MACRO &,N,IX,JX,JY,#,Z,IZ,TEMP,J X1=(X), X2=(Y)
- LOCAL [1],[2],[3],SAVEX,SAVEY
- SAVEX EQU TEMP
- SAVEY EQU TEMP+1
- SA5 1 X5=VOID A5=1
- BRANCH [2],N,LE,2,J J=2-N; IF(N.LE.2) GO TO [2]
- [1] BSS 0 N=3,4,5,...; J=-1,-2,-3,...
- CUMPY1H N,&,IX,JX,JY,#,Z,SAVEX,SAVEY N=N-1=2,3,4,...
- CMPY1R &,JX,JY,J J=0
- S_J 2
- CMMPY1T N,&,Z,IZ,SAVEX,SAVEY,J J=0,-1,-2,...
- MI J,[1] IF N=3,4,5,...
- [2] BSS 0 N=1,2 J=1,0
- NE J,B0,[3] IF(N=1) GO TO [3]
- CUMPY1H N,&,IX,JX,JY,#,Z,SAVEX,SAVEY N=N-1=1
- CMMPY1T N,&,Z,IZ,SAVEX,SAVEY,J
- [3] BSS 0 N=1
- LAMBDA IFC EQ,*#*0* # IS 0
- SA1 X1 X1=X'
- SA3 X2 X3=Y'
- SA4 X2+1 X4=Y''
- SA2 A1+1 X2=X''
- RX0 X1*X3 X0=X'*Y'
- RX7 X1*X4 X7=X'*Y''
- RX6 X2*X4 X6=X''*Y''
- RX5 X2*X3 X5=X''*Y'
- SIGMA IFC EQ,*&*+*
- RX6 X0-X6
- RX7 X7+X5
- SIGMA ELSE
- RX6 X6-X0
- RX7 X7+X5
- BX7 -X7
- SIGMA ENDIF
- NX6 X6
- NX7 X7
- SA6 Z
- SA7 Z+1
- LAMBDA ELSE
- SA1 X1 X1=X'(1,1) A1=(X'(1,1))
- SA3 X2 X3=Y'(1) A3=(Y'(1))
- SA4 Z X4=Z'(1) A4=(Z'(1))
- SA2 Z+1 X2=Z''(1) A2=(Z''(1))
- LAMBDA2 IFC EQ,*#*+*
- BX6 X4
- LAMBDA2 ELSE
- BX6 -X4 X6=#Z'(1)
- LAMBDA2 ENDIF
- SA4 A3+1 X4=Y''(1) A4=(Y''(1))
- LAMBDA2 IFC EQ,*#*+*
- BX7 X2
- LAMBDA2 ELSE
- BX7 -X2 X7=#Z''(1)
- LAMBDA2 ENDIF
- SA2 A1+1 X2=X''(1,1) A2=(X''(1,1))
- RX0 X1*X3 X0=X'(1,1)*Y'(1)
- RX1 X1*X4 X1=X'(1,1)*Y''(1)
- RX4 X2*X4 X4=X''(1,1)*Y''(1)
- RX5 X2*X3 X5=X''(1,1)*Y'(1)
- RX7 X7_&_X1 X7=#Z''(1)-&X'(1,1)*Y'(1)
- SIGMA IFC EQ,*&*+*
- RX6 X6-X4
- SIGMA ELSE
- RX6 X6+X4 X6=#Z'(1)-&X''(1,1)*Y''(1)
- SIGMA ENDIF
- NX7 X7
- NX6 X6
- RX7 X7_&_X5 X7=Z''(1)
- RX6 X6_&_X0 X6=Z'(1)
- NX7 X7
- NX6 X6
- SA7 Z+1 Z''(1)=...
- SA6 Z Z'(1)=...
- LAMBDA ENDIF
- CUMPY ENDM
-*CD MUL
- RMUL1R MACRO JX,JY,JZ,J
- LOCAL [1]
- [1] BSS 0 FOR K = 0, 1, 2, ...
- + SA7 X0 0 X5 Z(1+K)=X(1+K)*Y(1+K)
- RX7 X3*X5 1 X7=X(2+K)*Y(2+K)
- SA3 A3+JX 2 X3=X(3+K) A3=(X(3+K))
- SA5 A5+JY 3 X5=Y(3+K) A5=(Y(3+K))
- + S_J J+1 4 J=2-N+K+1
- SX0 X0+JZ 5 X7 X0=(Z(2+K))
- NO 6 X0
-* 7
-* 8
- + MI J,[1] 9 X3 WHILE 3-N+K<0
- RMUL1R ENDM
- RMUL2R MACRO JX,JY,JZ,J J=6-N LEAVES 0 OR 1 TERM TO BE PROCESSED
- LOCAL [1]
- [1] BSS 0 FOR K = 0, 2, 4, ...
- + SA6 A7+JZ 0 X4 Z(K+2)=X(K+2)*Y(K+2)
- S_J J+2 1 J=6-N+K+2
- SA7 A6+JZ 2 X3 Z(K+3)=X(K+3)*Y(K+3)
- + RX6 X2*X4 3 X5 X6=X(K+4)*Y(K+4)
- SA2 A3+JX 4 X2=X(K+6)
- SA4 A5+JY 5 X4=Y(K+6)
- RX7 X3*X5 6 X7=X(K+5)*Y(K+5)
- + SA3 A2+JX 7 X6 X3=X(K+7)
- SA5 A4+JY 8 X5=Y(K+7)
-* 9
-* 10 X7
- MI J,[1] 11 X2 WHILE 6-N+K+2<0 I.E. 9+K .LE. N
- RMUL2R ENDM
- RVMUL MACRO N,JX,JY,JZ,J X2=(X), X4=(Y), X0=(Z)
- LOCAL [1],[2],[3],[99],LIMIT
- LIMIT EQU 7
- SA3 X2 X3=X(1), A3=(X(1))
- SA5 X4 X5=Y(1), A5=(Y(1))
- BRANCH [3],N,GT,LIMIT,J IF N>LIMIT J=LIMIT-N
- S_J J-LIMIT+2 J=2-N
- RX7 X3*X5 X7=X(1)*Y(1)
- GT J,B0,[2] IF N=1
- SA3 A3+JX X3=X(2), A3=(X(2))
- SA5 A5+JY X5=Y(2), A5=(Y(2))
- ZR J,[1] IF N=2
- RMUL1R JX,JY,JZ,J
- [1] SA7 X0 Z(N-1)=X(N-1)*Y(N-1)
- RX7 X3*X5 X7=X(N)*Y(N)
- SX0 X0+JZ X0=(Z(N))
- [2] SA7 X0 Z(N)=X(N)*Y(N)
- JP [99]
- [3] SA2 A3+JX X2=X(2) A2=(X(2))
- SA4 A5+JY X4=Y(2) A4=(Y(2))
- RX7 X3*X5 X7=X(1)*Y(1)
- SA3 A2+JX X3=X(3) A3=(X(3))
- SA5 A4+JY X5=Y(3) A5=(Y(3))
- S_J J-LIMIT+7 J=7-N
- SA7 X0 Z(1)=X(1)*Y(1)
- RX6 X2*X4 X6=X(2)*Y(2)
- SA2 A3+JX X2=X(4) A2=(X(4))
- SA4 A5+JY X4=Y(4) A4=(Y(4))
- RX7 X3*X5 X7=X(3)*Y(3)
- SA3 A2+JX X3=X(5) A3=(X(5))
- SA5 A4+JY X5=Y(5) A5=(Y(5))
- RMUL2R JX,JY,JZ,J J=0,1
- SA6 A7+JZ
- S_J J-2 J=-2,-1
- SA7 A6+JZ
- RX7 X2*X4
- SX0 A7+JZ
- RMUL1R JX,JY,JZ,J
- SA7 X0 Z(N-1)
- RX7 X3*X5 X7=X(N)*Y(N)
- SA7 X0+JZ Z(N)=X(N)*Y(N)
- [99] BSS 0
- RVMUL ENDM
- CMUL1R MACRO JX,JY,JZ,J
- LOCAL [1]
- [1] BSS 0 FOR K = 0, 1, 2, ...
- NX6 X6 0
- RX0 X2*X4 1 X3 X0=X'(3+K)*Y'(3+K)
- NX7 X7 2 X6
- RX1 X3*X4 3 X5 X1=X''(3+K)*Y'(3+K)
- + SA6 A6+JZ 4 X7 Z'(2+K)=X'*Y'-X''*Y''
- RX6 X3*X5 5 X0 X6=X''(3+K)*Y''(3+K)
- SA4 A4+JY 6 X4=Y'(4+K) A4=(Y'(4+K))
- SA7 A7+JZ 7 X1 Z''(2+K)=X''*Y'+X'*Y''
- + RX7 X2*X5 8 X7=X'(3+K)*Y''(3+K)
- S_J J+1 9 X6 J=3-N+K+1
- SA2 A2+JX 10 X2=X'(4+K) A2=(X'(4+K))
- + RX6 X0-X6 11 X6=X'(3+K)*Y'(3+K)-X''(3+K)*Y''
- SA3 A3+JX 12 X7 X3=X''(4+K) A3=(X''(4+K))
- RX7 X1+X7 13 X4 X7=X''(3+K)*Y'(3+K)+X'(3+K)*Y''
- SA5 A5+JY 14 X6 X5=Y''(4+K) A5=(Y''(4+K))
-* 15
-* 16 X7
- + MI J,[1] 17 X2 WHILE 4-N+K<0 I.E. K.LE.N-5
- CMUL1R ENDM
- CVMUL MACRO N,JX,JY,JZ,J X2=(X), X4=(Y), X0=(Z)
- LOCAL [1],[2],[3],[99]
- SA2 X2 X2=X'(1) A2=(X'(1))
- SA4 X4 X4=Y'(1) A4=(Y'(1))
- SA3 A2+1 X3=X''(1) A3=(X''(1))
- SA5 A4+1 X5=Y''(1) A5=(Y''(1))
- S_J 2 J=2
- SA6 X0 Z'(1)=VOID A6=(Z'(1))
- S_J J-N J=2-N
- RX0 X2*X4 X0=X'(1)*Y'(1)
- RX1 X3*X4 X1=X''(1)*Y'(1)
- RX6 X3*X5 X6=X''(1)*Y''(1)
- RX7 X2*X5 X7=X'(1)*Y''(1)
- GT J,B0,[3] IF N=1
- SA4 A4+JY X4=Y'(2) A4=(Y'(2))
- SA2 A2+JX X2=X'(2) A2=(X'(2))
- SA3 A3+JX X3=X''(2) A3=(X''(2))
- SA5 A5+JY X5=Y''(2) A5=(Y''(2))
- RX6 X0-X6 X6=X'(1)*Y'(1)-X''(1)*Y''(1)
- RX7 X1+X7 X7=X''(1)*Y'(1)+X'(1)*Y''(1)
- NX6 X6
- RX0 X2*X4 X0=X'(2)*Y'(2)
- NX7 X7
- RX1 X3*X4 X1=X''(2)*Y'(2)
- SA6 A6 Z'(1)=X'(1)*Y'(1)-X''(1)*Y''(1)
- RX6 X3*X5 X6=X''(2)*Y''(2)
- SA7 A6+1 Z''(1)=X''(1)*Y'(1)+X'(1)*Y''(1)
- RX7 X2*X5 X7=X'(2)*Y''(2)
- ZR J,[2] IF N=2
- SA4 A4+JY X4=Y'(3) A4=(Y'(3))
- SA2 A2+JX X2=X'(3) A2=(X'(3))
- RX6 X0-X6 X6=X'(2)*Y'(2)-X''(2)*Y''(2)
- RX7 X1+X7 X7=X''(2)*Y'(2)+X'(2)*Y''(2)
- SA3 A3+JX X3=X''(3) A3=(X''(3))
- SA5 A5+JY X5=Y''(3) A5=(Y''(3))
- S_J J+1 J=3-N
- ZR J,[1] IF N=3
- CMUL1R JX,JY,JZ,J
- [1] NX6 X6
- RX0 X2*X4 X0=X'(N)*Y'(N)
- NX7 X7
- RX1 X3*X4 X1=X''(N)*Y'(N)
- SA6 A6+JZ Z'(N-1)=X'(N-1)*Y'(N-1)-X''*Y''
- RX6 X3*X5 X6=X''(N)*Y''(N)
- SA7 A7+JZ Z''(N-1)=X'(N-1)*Y''(N-1)+X''*Y'
- RX7 X2*X5 X7=X'(N)*Y''(N)
- [2] RX6 X0-X6 X6=X'(N)*Y'(N)-X''(N)*Y''(N)
- RX7 X1+X7 X7=X''(N)*Y'(N)+X'(N)*Y''(N)
- NX6 X6
- NX7 X7
- SA6 A6+JZ Z'(N)=X'(N)*Y'(N)-X''(N)*Y''(N)
- SA7 A7+JZ Z''(N)=X''(N)*Y'(N)+X'(N)*Y''(N)
- JP [99]
- [3] RX7 X1+X7 X7=X''(1)*Y'(1)+X'(1)*Y''(1)
- RX6 X0-X6 X6=X'(1)*Y'(1)-X''(1)*Y''(1)
- NX7 X7
- NX6 X6
- SA7 A6+1 Z''(1)=X''(1)*Y'(1)+X'(1)*Y''(1)
- SA6 A6 Z'(1)=X'(1)*Y'(1)-X''(1)*Y''(1)
- [99] BSS 0
- CVMUL ENDM
-*CD MULA
-RMULA1 MACRO &,JX,JY,JZ,J
- LOCAL [1]
- [1] BSS 0 FOR J=2-N AND K = 0, 1, 2,...
- + RX6 X3_&_X0 0 X6=Z(1+K) & X(1+K)*Y(1+K)
- SA3 A3+JZ 1 X4 X3=Z(2+K)
- S_J J+1 2 X5 J=2-N+K+1
- + RX0 X4*X5 3 X6 X0=X(2+K)*Y(2+K)
- NX6 X6 4
- SA4 A4+JX 5 X4=X(3+K)
- SA5 A5+JY 6 X6 X5=Y(3+K)
- + SA6 A3-JZ 7 X0 Z(1+K)=Z(1+K) & X(1+K)*Y(1+K)
-* 8 X3
-* 9
- MI J,[1] 10 IF 3-N+K<0 I.E. 4+K .LE. N
- RMULA1 ENDM
- RMULA2 MACRO &,JX,JY,JZ,JZ2,J
- LOCAL [1]
- [1] BSS 0 FOR J=7-N AND K = 0,2,4,...
- + RX6 X1_&_X6 0 X0 X6=Z(4+K) & X(4+K)*(4+K)
- SA1 A1+JZ 1 X2 X1=Z(5+K)
- S_J J+2 2 X3 J=7-N+K+2
- + SA4 A2+JX 3 X6 X4=X(7+K)
- NX7 X7 4
- NX6 X6 5
- SA5 A3+JY 6 X7 X5=Y(7+K)
- + SA7 A7+JZ2 7 X6 Z(3+K)=Z(3+K) & X(3+K)*Y(3+K)
- SA6 A6+JZ2 8 X1 Z(4+K)=Z(4+K) & X(4+K)*Y(4+K)
- RX7 X1_&_X0 9 X7=Z(5+K) & X(5+K)*Y(5+K)
- SA1 A1+JZ 10 X4 X1=Z(6+K)
- + RX6 X2*X3 11 X6=X(6+K)*Y(6+K)
- SA2 A4+JX 12 X7 X2=X(8+K)
- SA3 A5+JY 13 X5 X3=Y(8+K)
- RX0 X4*X5 14 X0=X(7+K)*Y(7+K)
-* 15 X6
-* 16
- + MI J,[1] 17 X1 IF 9-N+K<0 I.E. 10+K .LE. N
- RMULA2 ENDM
- RVMULA MACRO N,&,JX,JY,Z,JZ,J X2=(X), X4=(Y)
- LOCAL [1],[2],[3],[4],[99]
- SA5 X4 X5=Y(1) A5=(Y(1))
- SA4 X2 X4=X(1) A4=(X(1))
- BRANCH [1],N,LE,7,J J=7-N
- SA2 A4+JX X2=X(2) A2=(X(2))
- SA3 A5+JY X3=Y(2) A3=(Y(2))
- RX0 X4*X5 X0=X(1)*Y(1)
- SA1 Z X1=Z(1) A1=(Z(1))
- SA4 A2+JX X4=X(3) A4=(X(3))
- SA5 A3+JY X5=Y(3) A5=(Y(3))
- RX7 X1_&_X0 X7=Z(1) & X(1)*Y(1)
- SA1 A1+JZ X1=Z(2) A1=(Z(2))
- RX6 X2*X3 X6=X(2)*Y(2)
- SA2 A4+JX X2=X(4) A2=(X(4))
- SA3 A5+JY X3=Y(4) A3=(Y(4))
- RX0 X4*X5 X0=X(3)*Y(3)
- RX6 X1_&_X6 X6=Z(2) & X(2)*Y(2)
- SA1 A1+JZ X1=Z(3) A1=(Z(3))
- SA4 A2+JX X4=X(5) A4=(X(5))
- NX7 X7
- NX6 X6
- SA5 A3+JY X5=Y(5) A5=(Y(5))
- SA7 Z Z(1)=Z(1) & X(1)*Y(1)
- SA6 Z+JZ Z(2)=Z(2) & X(2)*Y(2)
- S_Z JZ+JZ Z=2*JZ
- RX7 X1_&_X0 X7=Z(3) & X(3)*Y(3)
- SA1 A1+JZ X1=Z(4) A1=(Z(4))
- RX6 X2*X3 X6=X(4)*Y(4)
- SA2 A4+JX X2=X(6) A2=(X(6))
- SA3 A5+JY X3=Y(6) A3=(Y(6))
- RX0 X4*X5 X0=X(5)*Y(5)
- RMULA2 &,JX,JY,JZ,Z,J NOTE THAT Z=2*JZ
- RX6 X1_&_X6
- SA1 A1+JZ
- NZ J,[4] IF N IS EVEN
- SA4 A2+JX X4=X(N)
- NX7 X7
- NX6 X6
- SA5 A3+JY X5=Y(N)
- SA7 A6+JZ Z(N-4)=Z(N-4) & X(N-4)*Y(N-4)
- SA6 A7+JZ Z(N-3)=Z(N-3) & X(N-3)*Y(N-3)
- RX7 X1_&_X0 X7=Z(N-2) & X(N-2)*Y(N-2)
- SA1 A1+JZ X1=Z(N-1) A1=(Z(N-1))
- RX6 X2*X3 X6=X(N-1)*Y(N-1)
- RX0 X4*X5 X0=X(N)*Y(N)
- RX6 X1_&_X6 X6=Z(N-1) & X(N-1)*Y(N-1)
- SA1 A1+JZ X1=Z(N)
- NX7 X7
- NX6 X6
- SA7 A6+JZ Z(N-2)=Z(N-2) & X(N-2)*Y(N-2)
- SA6 A7+JZ Z(N-1)=Z(N-1) & X(N-1)*Y(N-1)
- RX7 X1_&_X0 X7=Z(N) & X(N)*Y(N)
- NX7 X7
- SA7 A6+JZ Z(N)=Z(N) & X(N)*Y(N)
- JP [99]
- [1] SA3 Z X3=Z(1) A3=(Z(1))
- S_J J-5 J=2-N
- RX0 X4*X5 X0=X(1)*Y(1)
- GT J,B0,[3] IF N=1
- SA4 A4+JX X4=X(2) A4=(X(2))
- SA5 A5+JY X5=Y(2) A5=(Y(2))
- PL J,[2] IF N=2
- RMULA1 &,JX,JY,JZ,J J=0
- [2] RX6 X3_&_X0 X6=Z(N-1) & X(N-1)*Y(N-1)
- SA3 A3+JZ X3=Z(N) A3=(Z(N))
- RX0 X4*X5 X0=X(N)*Y(N)
- NX6 X6
- SA6 A3-JZ Z(N-1)=Z(N-1) & X(N-1)*Y(N-1)
- [3] RX6 X3_&_X0 X6=Z(N) & X(N)*Y(N)
- NX6 X6
- NO
- SA6 A3 Z(N)=Z(N) & X(N)*Y(N)
- JP [99]
- [4] NX7 X7
- NX6 X6
- SA7 A6+JZ Z(N-3)=Z(N-3) & X(N-3)*Y(N-3)
- SA6 A7+JZ Z(N-2)=Z(N-2) & X(N-2)*Y(N-2)
- RX7 X1_&_X0 X7=Z(N-1) & X(N-1)*Y(N-1)
- SA1 A1+JZ X1=Z(N) A1=(Z(N))
- RX6 X2*X3 X6=X(N)*Y(N)
- RX6 X1_&_X6 X6=Z(N) & X(N)*Y(N)
- NX7 X7
- NX6 X6
- SA7 A6+JZ Z(N-1)=Z(N-1) & X(N-1)*Y(N-1)
- SA6 A1 Z(N)=Z(N) & X(N)*Y(N)
- [99] BSS 0
- RVMULA ENDM
- CMULA1 MACRO &,JX,JY,KZ,J,ONE
- LOCAL [1]
- [1] BSS 0 FOR J = 3-N AND K = 0,1,2,...
- AT IFC EQ,*&*+*
- RX6 X0-X6 0 X1 X6=Z'(2+K) & X'Y'-X''Y''
- AT ELSE
- RX6 X0+X6
- AT ENDIF
- RX7 X5_&_X7 1 X2 X7=Z''(2+K) & (X'Y''+X''Y')
- S_J J+ONE J=3-N+K+1
- SA5 A5+KZ 3 X6 X5=Z'(3+K)
- NX6 X6 4 X7
- RX0 X1*X3 5 X0=X'(3+K)Y'(3+K)
- NX7 X7 6 X6
- RX1 X1*X4 7 X1=X'(3+K)Y''(3+K)
- SA6 A7+KZ 8 X7 Z'(2+K)=Z'&(X'Y'-X''Y'')
- RX6 X2*X4 9 X0 X6=X''(3+K)Y''(3+K)
- SA4 A4+JY 10 X5 X4=Y''(4+K)
- RX2 X2*X3 11 X1 X2=X''(3+K)Y'(3+K)
- SA3 A3+JY 12 X3=Y'(4+K)
- RX0 X5_&_X0 13 X6 X0=Z'(3+K) & X'Y'
- SA5 A5+ONE 14 X5=Z''(3+K)
- SA7 A6+ONE 15 X2 Z''(2+K)=Z''&(X'Y''+X''Y')
-* 16 X0
- RX7 X1+X2 17 X4 X7=X'(3+K)Y''(3+K)+X''Y'
- SA1 A1+JX 18 X1=X'(4+K)
- SA2 A2+JX 19 X3 X2=X''(4+K)
- NX0 X0 20 X7
- NX7 X7 21 X5
-* 22 X0
-* 23 X7
- MI J,[1] 24 WHILE 4-N+K<0 I.E. 5+K .LE. N
- CMULA1 ENDM
- CVMULA MACRO N,&,JX,JY,KZ,J,ONE X2=(X), X4=(Y), A0=(Z)
- LOCAL [1],[2],[3],[99]
- CVMULSUB MACRO &
- AT IFC EQ,*&*+*
- RX6 X0-X6 X6=Z'+X'Y'-X''Y'' IF & IS +
- AT ELSE
- RX6 X0+X6 X6=Z'-X'Y'+X''Y'' IF & IS -
- AT ENDIF
- CVMULSUB ENDM
- SA1 X2 X1=X'(1)
- SA3 X4 X3=Y'(1)
- SA2 A1+ONE X2=X''(1)
- SA4 A3+ONE X4=Y''(1)
- SA5 A0 X5=Z'(1)
- S_J ONE+ONE
- S_J J-N J=2-N
- RX0 X1*X3 X0=X'(1)Y'(1)
- RX1 X1*X4 X1=X'(1)Y''(1)
- RX6 X2*X4 X6=X''(1)Y''(1)
- RX2 X2*X3 X2=X''(1)Y'(1)
- GT J,B0,[3] IF N=1
- SA4 A4+JY X4=Y''(2)
- SA3 A3+JY X3=Y'(2)
- S_KZ KZ-ONE KZ=JZ-1
- RX0 X5_&_X0 X0=Z'(1) & X'Y'
- SA5 A5+ONE X5=Z''(1)
- RX7 X1+X2 X7=X'(1)Y''(1)+X''Y'
- SA1 A1+JX X1=X'(2)
- SA2 A2+JX X2=X''(2)
- NX0 X0
- NX7 X7
- CVMULSUB & X6=Z'(1) & (X'Y'-X''Y'')
- RX7 X5_&_X7 X7=Z''(1) & (X'Y''+X''Y')
- SA5 A5+KZ X5=Z'(2)
- NX6 X6
- RX0 X1*X3 X0=X'(2)Y'(2)
- NX7 X7
- RX1 X1*X4 X1=X'(2)Y''(2)
- SA6 A0 Z'(1)=Z' & (X'Y'-X''Y'')
- RX6 X2*X4 X6=X''(2)Y''(2)
- ZR J,[2] IF N=2
- SA4 A4+JY X4=Y''(3)
- RX2 X2*X3 X2=X''(2)Y'(2)
- SA3 A3+JY X3=Y'(3)
- RX0 X5_&_X0 X0=Z'(2) & X'Y'
- SA5 A5+ONE X5=Z''(2)
- SA7 A6+ONE Z''(1)=Z''& (X'Y''+X''Y')
- RX7 X1+X2 X7=X'(2)Y''(2)+X''Y'
- SA1 A1+JX X1=X'(3)
- SA2 A2+JX X2=X''(3)
- S_J J+ONE J=3-N
- NX0 X0
- NX7 X7
- ZR J,[1] IF N=3
- CMULA1 &,JX,JY,KZ,J,ONE
- [1] CVMULSUB & X6=Z'(N-1) & (X'Y'-X''Y'')
- RX7 X5_&_X7 X7=Z''(N-2) & (X'Y''+X''Y')
- SA5 A5+KZ X5=Z'(N)
- NX6 X6
- RX0 X1*X3 X0=X'(N)Y'(N)
- NX7 X7
- RX1 X1*X4 X1=X'(N)Y''(N)
- SA6 A7+KZ Z'(N-1)=Z' & (X'Y'-X''Y'')
- RX6 X2*X4 X6=X''(N)Y''(N)
- [2] RX2 X2*X3 X2=X''(N)Y'(N)
- RX0 X5_&_X0 X0=Z'(N) & X'Y'
- SA5 A5+ONE X5=Z''(N)
- SA7 A6+ONE Z''(N-1)=Z'' & (X'Y''+X''Y')
- RX7 X1+X2 X7=X'(N)Y''(N)+X''Y'
- NX0 X0
- NX7 X7
- CVMULSUB & X6=Z'(N) & (X'Y'-X''Y'')
- RX7 X5_&_X7 X7=Z''(N) & (X'Y''+X''Y')
- NX6 X6
- NX7 X7
- SA6 A7+KZ Z'(N)=Z' & (X'Y'-X''Y'')
- S_KZ KZ+ONE KZ=JZ
- SA7 A6+ONE Z''(N)=Z'' & (X'Y''+X''Y')
- JP [99]
- [3] RX0 X5_&_X0 X0=Z'(1) & X'Y'
- SA5 A5+ONE X5=Z''(1)
- RX7 X1+X2 X7=X'(1)Y''(1)+X''Y'
- NX0 X0
- NX7 X7
- CVMULSUB & X6=Z'(1) & (X'Y'-X''Y'')
- RX7 X5_&_X7 X7=Z''(1) & (X'Y''+X''Y')
- NX6 X6
- NX7 X7
- SA6 A0 Z'(1)=Z' & (X'Y'-X''Y'')
- SA7 A6+ONE Z''(1)=Z'' & (X'Y''+X''Y')
- [99] BSS 0
- CVMULA ENDM
-*CD RAN
- RRAN1R MACRO JZ,J X0=A,X3=C,X4=SEED,X5=MULT,A6=(Z(1))
- LOCAL [1]
- [1] BSS 0 FOR K = 0, 1, 2, ...
- + SA6 A6+JZ 0 X2 Z(2+K)=C*RANF(2+K)+A
- FX2 X2+X0 1 X2=C*RANF(3+K)+A
- S_J J+1 2 J=4-N+K+1
- + NX1 X4 3 X1=RANF(4+K)
- DX4 X4*X5 4 X2 X4=SEED(4+K)*MULT=SEED(5+K)
- NX6 X2 5 X1 X6=C*RANF(3+K)+A
- FX2 X3*X1 6 X2=C*RANF(4+K)
-* 7 X6
-* 8 X4
- + MI J,[1] 9 WHILE 5-N+K<0; I.E. 6+K .LE. N
- RRAN1R ENDM
- RVRAN MACRO N,Z,JZ,J X0=A, X3=C,X4=SEED,X5=MULT
- LOCAL [1],[2],[3],[4],[5],[6],[99]
- S_J 4
- DX4 X4*X5 X4=SEED(1)
- S_J J-N J=4-N
- LE J,B0,[3] IF 4-N .LE. 0; I.E. N>3
- S_J J-2 J=2-N
- NX1 X4 X1=RANF(1)
- GT J,B0,[1] IF 2-N>0; I.E. N=1
- DX4 X4*X5 X4=SEED(2)
- FX2 X3*X1 X2=C*RANF(1)
- NX1 X4 X1=RANF(2)
- FX2 X2+X0 X2=C*RANF(1)+A
- ZR J,[2] IF 2-N=0; I.E. N=2
- DX4 X4*X5 X4=SEED(3)
- NX6 X2 X6=C*RANF(1)+A
- FX2 X3*X1 X2=C*RANF(2)
- SA6 Z Z(1)=C*RANF(1)+A
- JP [5]
- [1] FX2 X3*X1 X2=C*RANF(1)
- FX2 X2+X0 X2=C*RANF(1)+A
- BX7 X4 X7=SEED
- NX6 X2 X6=C*RANF(1)+A
- SA6 Z Z(1)=C*RANF(1)+A
- JP [99]
- [2] NX6 X2 X6=C*RANF(1)+A
- FX2 X3*X1 X2=C*RANF(2)
- SA6 Z Z(1)=C*RANF(1)+A
- JP [6]
- [3] NX1 X4 X1=RANF(1)
- DX4 X4*X5 X4=SEED(2)
- FX2 X3*X1 X2=C*RANF(1)
- NX1 X4 X1=RANF(2)
- FX2 X2+X0 X2=C*RANF(1)+A
- DX4 X4*X5 X4=SEED(3)
- NX6 X2 X6=C*RANF(1)+A
- FX2 X3*X1 X2=C*RANF(2)
- SA6 Z Z(1)=C*RANF(1)+A
- NX1 X4 X1=RANF(3)
- FX2 X2+X0 X2=C*RANF(2)+A
- DX4 X4*X5 X4=SEED(4)
- NX6 X2 X6=C*RANF(2)+A
- FX2 X3*X1 X2=C*RANF(3)
- ZR J,[4] IF N=4
- RRAN1R JZ,J J=0
- [4] SA6 A6+JZ Z(N-2)=C*RANF(N-2)+A
- [5] FX2 X2+X0 X2=C*RANF(N-1)+A
- NX1 X4 X1=RANF(N)
- NX6 X2 X6=C*RANF(N-1)+A
- FX2 X3*X1 X2=C*RANF(N)
- SA6 A6+JZ Z(N-1)=C*RANF(N-1)+A
- [6] FX2 X2+X0 X2=C*RANF(N)+A
- BX7 X4 X7=SEED
- NX6 X2 X6=C*RANF(N)+A
- SA6 A6+JZ Z(N)=C*RANF(N)+A
- [99] BSS 0 X7=OLD SEED
- RVRAN ENDM
- RMRAN MACRO M,N,Z,IZ,JZ,I,J X0=A, X3=C, X4=SEED, X5=MULT
- LOCAL [1],[2],[3],[4],[5],[99]
- LE M,N,[1] IF M .LE. N GOTO [1]
- SWAP M,N EXCHANGE M AND N
- SWAP IZ,JZ EXCHANGE IZ AND JZ
- [1] BRANCH [4],N,LE,3,J
- [2] DX4 X4*X5 0 X4=SEED(1)
- S_J 4 1
-* 2
- S_J J-N 3 J=4-N
-* 4 X4
- + NX1 X4 5 X1=RANF(1)
- DX4 X4*X5 6 X4=SEED(2)
-* 7 X1
- FX2 X3*X1 8 X2=C*RANF(1)
-* 9
-* 10 X4
- NX1 X4 11 X1=RANF(2)
-* 12 X2
- + FX2 X2+X0 13 X1 X2=C*RANF(1)+A
- DX4 X4*X5 14 X4=SEED(3)
-* 15
-* 16 X2
- NX6 X2 17 X6=X(I,1)
- FX2 X3*X1 18 X4 X2=C*RANF(2)
- + NX1 X4 19 X6 X1=RANF(3)
- SA6 Z 20 Z(I,1)=C+RANF(1)+A
- DX4 X4*X5 21 X1 X4=SEED(4)
-* 22 X2
- FX2 X2+X0 23 X2=C*RANF(2)+A
-* 24
-* 25 X4
-* 26 X2
- + NX6 X2 27 X6=Z(I,2)
- FX2 X3*X1 28 X2=C*RANF(3)
-* 29 X6
- ZR J,[3] 30 IF N=4
- RRAN1R JZ,J
- [3] SA6 A6+JZ Z(I,N-2)=C*RANF(N-2)+A
- FX2 X2+X0 X2=C*RANF(N-1)+A
- NX1 X4 X1=RANF(N)
- NX6 X2 X6=C*RANF(N-1)+A
- FX2 X3*X1 X2=C*RANF(N)
- S_M M-1 M=M-1
- SA6 A6+JZ Z(I,N-1)=C*RANF(N-1)+A
- FX2 X2+X0 X2=C*RANF(N)+A
- S_Z Z+IZ Z=(Z(I+1,1))
- NX6 X2 X6=C*RANF(N)+A
- SA6 A6+JZ Z(I,N)=C*RANF(N)+A
- NZ M,[2]
- JP [99]
- [4] S_J B0 J=0
- SX7 Z X6=(Z(I,1))
- S_M M-1
- [5] DX4 X4*X5 X4=SEED(J)
- NX1 X4 X1=RANF
- FX2 X3*X1 X2=C*RANF
- FX2 X2+X0 X2=C*RANF+A
- S_J J+1
- NX6 X2 X6=Z(I,J)
- SA6 X7 Z(I,J)=C*RANF+A
- SX7 X7+JZ X7=(Z(I,J+1))
- NE J,N,[5]
- S_Z Z+IZ Z=(Z(I+1,1))
- NZ M,[4]
- [99] BSS 0 X4=OLD SEED
- RMRAN ENDM
- DRAN1R MACRO JZ,I,J X0=A, X3=C, X4=SEED, X5=MULT
- LOCAL [1]
- [1] BSS 0 FOR K = 0, 1, 2, ...
- DX4 X4*X5 X4=S''*M=S'
- NX1 X4 X1=R'
- DX4 X4*X5 X4=S'*M=S''
- FX1 X0*X1 X1=C*R'
- FX6 X1+X3 X6=C*R'+A'
- NX6 X6 X6=Z'
- UX2 I,X6 I=E'
- BX7 X6-X4 X7=M''
- S_I I-48 I=E'-48
- SA6 A6+JZ Z'=
- PX7 X7,I X7=Z''
- SA7 A6+1
- S_J J+1
- MI J,[1]
- DRAN1R ENDM
- DMRAN MACRO M,N,X,IX,JX,I,J X0=A, X3=C, X4=SEED, X5=MULT
- LOCAL [1],[2],[3]
- LE M,N,[1] IF M .LE. N GOTO [1]
- SWAP M,N EXCHANGE M AND N
- SWAP IX,JX EXCHANGE IX AND JX
- [1] BSS 0
- [2] S_J 1
- S_J J-N J=1-N
- DX4 X4*X5 X4=S''*M=S'
- NX1 X4 X1=R'
- DX4 X4*X5 X4=S'*M=S''
- FX1 X0*X1 X1=C*R'
- FX6 X1+X3 X6=C*R'+A'
- NX6 X6 X6=X'
- UX2 I,X6 I=E'
- BX7 X6-X4 X7=M''
- S_I I-48 I=E'-48
- SA6 X X'=
- PX7 X7,I X7=X''
- SA7 A6+1
- ZR J,[3]
- DRAN1R JX,I,J
- [3] S_M M-1
- S_X X+IX
- NZ M,[2]
- DMRAN ENDM
- CRAN1R MACRO JX,I,J X0=A, X3=C, X4=SEED, X5=MULT
- LOCAL [1]
- [1] BSS 0 FOR K = 0, 1, 2,...
- + NX2 X4 0 X1 X2=RANF''(2+K)
- FX6 X1+X0 1 X6=C*RANF'(2+K)+A
- SA7 A6+1 2 X2 X''(I,1+K)=C*RANF''(1+K)+A
- + FX2 X3*X2 3 X2=C*RANF''(2+K)
- S_J J+1 4 X6 J=2-N+K+1
- DX4 X4*X5 5 X4=SEED'(3+K)
- + NX6 X6 6 X6=X'(I,2+K)
- NO 7 X2
- FX7 X2+X0 8 X6 X7=C*RANF''(2+K)+A
- SA6 A6+JX 9 X4 X'(I,2+K)=C*RANF'(2+K)+A
- + NX1 X4 10 X1=RANF'(3+K)
- DX4 X4*X5 11 X7 X4=SEED''(3+K)
- NX7 X7 12 X1 X7=X''(I,2+K)
- FX1 X3*X1 13 X1=C*RANF'(3+K)
-* 14 X7
-* 15 X4
- + MI J,[1] 16 WHILE 3-N+K<0; I.E. 4+K.LE.N
- CRAN1R ENDM
- CMRAN MACRO M,N,X,IX,JX,I,J X0=A, X3=C, X4=SEED, X5=MULT
- LOCAL [1],[2],[3],[4],[99]
- LE M,N,[1] IF M .LE. N GOTO [1]
- SWAP M,N EXCHANGE M AND N
- SWAP IX,JX EXCHANGE IX AND JX
- [1] BSS 0
- [2] BSS 0
- + DX4 X4*X5 X4=SEED'(1)
- S_J 1
- S_J J-N J=1-N
- + NX1 X4 X1=RANF'(1)
- DX4 X4*X5 X4=SEED''(1)
- FX1 X3*X1 X1=C*RANF'(1)
- NX2 X4 X2=RANF''(1)
- + FX6 X1+X0 X6=C*RANF'(1)+A
- FX2 X3*X2 X2=C*RANF''(1)
- ZR J,[4] IF N=1
- + DX4 X4*X5 X4=SEED'(2)
- NX6 X6 X6=X'(I,1)
- S_J J+1 J=2-N
- + FX7 X2+X0 X7=C*RANF''(1)+A
- SA6 X X'(I,1)=C*RANF'(1)+A
- NX1 X4 X1=RANF'(2)
- DX4 X4*X5 X4=SEED''(2)
- + NX7 X7 X7=X''(I,1)
- FX1 X3*X1 X1=C*RANF'(2)
- ZR J,[3] IF N=2
- CRAN1R JX,I,J
- [3] NX2 X4 X2=RANF''(N)
- FX6 X1+X0 X6=C*RANF'(N)+A
- SA7 A6+1 X''(N-1)=C*RANF''(N-1)+A
- + FX2 X3*X2 X2=C*RANF''(N)
- S_M M-1 M=M-1
- NX6 X6 X6=X'(I,N)
- + S_X X+IX X=(X(I+1,1))
- FX7 X2+X0 X7=C*RANF''(N)+A
- SA6 A6+JX X'(I,N)=C*RANF'(N)+A
- NX7 X7 X7=X''(I,N)
- SA7 A6+1 X''(I,N)=C*RANF''(N)+A
- NZ M,[2]
- JP [99]
- [4] NX6 X6 X6=X'(1,1)
- FX7 X2+X0 X7=C*RANF''(1)+A
- SA6 X X'(1,1)=C*RANF'(1)+A
- NX7 X7 X7=X''(1,1)
- SA7 A6+1 X''(1,1)=C*RANF''(1)+A
- [99] BSS 0
- CMRAN ENDM
-*CD ROT
- RROT1 MACRO JX,JY,J
- LOCAL [1]
-[1] BSS 0 FOR J=2-N AND K=0, 1, 2,...
- NX6 X6 0 X4
- RX2 X0*X4 1 X5 X2=CX(2+K)
- NX7 X7 2 X6
- RX3 X0*X5 3 X3=CY(2+K)
- SA6 A4-JX 4 X7 X(1+K)=CX(1+K)+SY(1+K)
- RX6 X1*X5 5 X2 X6=SY(2+K)
- SA7 A5-JY 6 Y(1+K)=CY(1+K)-SX(1+K)
- RX7 X1*X4 7 X3 X7=SX(2+K)
- S_J J+1 8 J=2-N+K+1
- SA4 A4+JX 9 X6 X4=X(3+K) A4=(X(3+K))
- SA5 A5+JY 10 X5=Y(3+K) A5=(Y(3+K))
- RX6 X2+X6 11 X7 X6=CX(2+K)+SY(2+K)
- RX7 X3-X7 12 X7=CY(2+K)-SX(2+K)
-* 13
-* 14 X6
- MI J,[1] 15 X7 IF 3-N+K<0, I.E. 4+K .LE. N
- RROT1 ENDM
- RVROT MACRO N,X,JX,Y,JY,J
-* X0=C
-* X1=S
- LOCAL [1],[2]
- SA4 X X4=X(1) A4=(X(1))
- SA5 Y X5=Y(1) A5=(Y(1))
- S_J 2
- S_J J-N J=2-N
- RX2 X0*X4 X2=CX(1)
- RX3 X0*X5 X3=CY(1)
- RX6 X1*X5 X6=SY(1)
- RX7 X1*X4 X7=SX(1)
- GT J,B0,[2] IF N=1
- SA4 A4+JX X4=X(2) A4=(X(2))
- SA5 A5+JY X5=Y(2) A5=(Y(2))
- RX6 X2+X6 X6=CX(1)+SY(1)
- RX7 X3-X7 X7=CY(1)-SX(1)
- ZR J,[1] IF N=2
- RROT1 JX,JY,J
- [1] NX6 X6 X6=CX(N-1)+SY(N-1)
- RX2 X0*X4 X2=CX(N)
- NX7 X7 X7=CY(N-1)-SX(N-1)
- RX3 X0*X5 X3=CY(N)
- SA6 A4-JX X(N-1)=CX(N-1)+SY(N-1)
- RX6 X1*X5 X6=SY(N)
- SA7 A5-JY Y(N-1)=CY(N-1)-SX(N-1)
- RX7 X1*X4 X7=SX(N)
- [2] RX6 X2+X6 X6=CX(N)+SY(N)
- RX7 X3-X7 X7=CY(N)-SX(N)
- NX6 X6
- NX7 X7
- SA6 A4 X(N)=CX(N)+SY(N)
- SA7 A5 Y(N)=CY(N)-SX(N)
- RVROT ENDM
-*CD SCA
- RSCA1R MACRO JX,#,JY,JZ,J X1=S
- LOCAL [1]
- [1] BSS 0 FOR K = 0, 1, 2, ...
- + NX7 X6 0 X7=S*X(2+K)#Y(2+K)
- RX3 X1*X4 1 X3=S*X(3+K)
- S_J J+1 2 X7 J=3-N+1+K
- + SA4 A4+JX 3 X5 X4=X(4+K)
- SA7 A7+JZ 4 Z(2+K)=S*X(2+K)#Y(2+K)
-* 5 X3
- RX6 X3_#_X5 6 X6=S*X(3+K)#Y(3+K)
- SA5 A5+JY 7 X5=Y(4+K)
-* 8
-* 9 X6
- + MI J,[1] 10 X4 WHILE 4-N+K=J<0; I.E. 5+K.LE.N
- RSCA1R ENDM
- RSCA4R MACRO JX,#,JY,JZ,J X1=S
- LOCAL [1]
- [1] BSS 0 K = 0, 4, 8, ...
- + NX7 X7 0 X4 X7=S*X(3+K)#Y(3+K)
- RX4 X1*X4 1 X5 X4=S*X(5+K)
- SA6 A7+JZ 2 X7 Z(2+K)=S*X(2+K)#Y(2+K)
- SA2 A4+JX 3 X2=X(6+K)
- + RX6 X0_#_X3 4 X6=S*X(4+K)#Y(4+K)
- SA7 A6+JZ 5 X4 Z(3+K)=S*X(3+K)#Y(3+K)
- RX7 X4_#_X5 6 X7=S*X(5+K)#Y(5+K)
- SA4 A2+JX 7 X6 X4=X(7+K)
- + SA3 A5+JY 8 X3=Y(6+K)
- NX6 X6 9 X7 X6=S*X(4+K)#Y(4+K)
- NX7 X7 10 X2 X7=S*X(5+K)#Y(5+K)
- SA5 A3+JY 11 X6 X5=Y(7+K)
- + RX0 X1*X2 12 X7 X0=S*X(6+K)
- SA6 A7+JZ 13 Z(4+K)=S*X(4+K)#Y(4+K)
- SA2 A4+JX 14 X4 X2=X(8+K)
- RX4 X1*X4 15 X3 X4=S*X(7+K)
- + S_J J+4 16 X0 J=8-N+4+K
- RX6 X0_#_X3 17 X6=S*X(6+K)#Y(6+K)
- SA3 A5+JY 18 X5 X3=Y(8+K)
- + SA7 A6+JZ 19 X4 Z(5+K)=S*X(5+K)#Y(5+K)
- RX7 X4_#_X5 20 X6 X7=S*X(7+K)#Y(7+K)
- SA4 A2+JX 21 X2 X4=X(9+K)
- SA5 A3+JY 22 X5=Y(9+K)
- + RX0 X1*X2 23 X7 X0=S*X(8+K)
- NX6 X6 24 X6=S*X(6+K)#Y(6+K)
-* 25 X3
-* 26 X6
- MI J,[1] 27 X0 WHILE 12-N+K=J<0; I.E. 13+K.LE.N
- RSCA4R ENDM
- RVSCA MACRO N,JX,#,JY,Z,JZ,J X4=(X) X2=(Y) X1=S
- LOCAL [1],[2],[3],[4],[5],[6],[99]
- [1] SA4 X4 0 X4=X(1)
- S_J 8 1 J=8
- SA5 X2 2 X5=Y(1)
- + S_J J-N 3 J=8-N
-* 4
-* 5
- PL J,[4] 6 IF N<9
- SA2 A4+JX 7 X4 X2=X(2)
- + RX7 X1*X4 8 X7=S*X(1)
- NO 9 X5
- SA4 A2+JX 10 X4=X(3)
- SA3 A5+JY 11 X3=Y(2)
-* 12 X7
- + RX7 X7_#_X5 13 X7=S*X(1)#Y(1)
- SA5 A3+JY 14 X2 X5=Y(3)
- NO 15
- RX6 X1*X2 16 X7 X6=S*X(2)
- + NX7 X7 17 X4 X7=S*X(1)#Y(1)
- SA2 A4+JX 18 X3 X2=X(4)
- RX4 X1*X4 19 X7 X4=S*X(3)
- SA7 Z 20 X6 Z(1)=S*X(1)#Y(1)
- + RX6 X6_#_X3 21 X5 X6=S*X(2)#Y(2)
- SA3 A5+JY 22 X3=Y(4)
- NO 23 X4
- RX7 X4_#_X5 24 X6 X7=S*X(3)#Y(3)
- + SA4 A2+JX 25 X2 X4=X(5)
- NX6 X6 26 X6=S*X(2)#Y(2)
- RX0 X1*X2 27 X7 X0=S*X(4)
- SA5 A3+JY 28 X6 X5=Y(5)
-* 29 X3
-* 30
-* 31 X0
-* 32 X4
- RSCA4R JX,#,JY,JZ,J X6
- SA6 A7+JZ 27 X0 Z(J+N-6)=S*X(J+N-6)#Y(J+N-6)
- NX7 X7 28 X4 X7=S*X(J+N-5)#Y(J+N-5)
- RX6 X0_#_X3 29 X5 X6=S*X(J+N-4)#Y(J+N-4)
- S_J J-3 J=0,-1,-2,-3
- SA7 A6+JZ Z(J+N-5)=S*X(J+N-5)#Y(J+N-5)
- MI J,[5] IF 1, 2, OR 3 TERMS LEFT
- JP [6] NO TERMS LEFT
- [2] RX7 X1*X4 X7=S*X(1)
- RX7 X7_#_X5 X7=S*X(1)#Y(1)
- NX7 X7
- SA7 Z Z(1)=S*X(1)#Y(1)
- JP [99]
- [3] RX7 X1*X2 X7=S*X(2)
- RX6 X6_#_X5 X6=S*X(1)#Y(1)
- RX7 X7_#_X3 X7=S*X(2)#Y(2)
- SA4 A2 A4=(X(2))
- NX6 X6
- SA5 A3 A5=(Y(2))
- NX7 X7
- SA6 Z Z(1)=S*X(1)#Y(1)
- SA7 Z+JZ Z(2)=S*X(2)#Y(2)
- JP [99]
- [4] S_J J-7 0 J=1-N
-* 1
-* 2
- ZR J,[2] 3 IF N=1
- + SA2 A4+JX 4 X2=X(2)
- S_J J+1 5 X4 J=2-N
- RX6 X1*X4 6 X5 X6=S*X(1)
-* 7
-* 8
- + SA3 A5+JY 9 X3=Y(2)
-* 10 X6
- ZR J,[3] 11 X2 IF N=2
- RX6 X6_#_X5 12 X6=S*X(1)#Y(1)
- + RX2 X1*X2 13 X2=S*X(2)
- S_J J+1 14 J=3-N
-* 15 X6
- NX7 X6 16 X3 X7=S*X(1)#Y(1)
- + SA4 A2+JX 17 X2 X4=X(3)
- RX6 X2_#_X3 18 X7 X6=S*X(2)#Y(2)
- SA7 Z 19 Z(1)=S*X(1)#Y(1)
- SA5 A3+JY 20 X5=Y(3)
-* 21
- + PL J,[6] 22 IF N=3
- [5] RSCA1R JX,#,JY,JZ,J
- [6] NX7 X6 X7=S*X(N-1)#Y(N-1)
- RX6 X1*X4 X6=S*X(N)
- SA7 A7+JZ Z(N-1)=S*X(N-1)#Y(N-1)
- RX7 X6_#_X5 X7=S*X(N)#Y(N)
- + SB0 0
- NX7 X7
- SA7 A7+JZ Z(N)=S*X(N)#Y(N)
- [99] BSS 0
- RVSCA ENDM
- DSCA1R MACRO JX,#,JY,JZ,J X0=S' X1=S''
- LOCAL [1]
- [1] BSS 0 FOR K = 0, 1, 2, ...
- + FX5 X3+X7 0 X5=U(D'+E')=F'
-* 1
-* 2
-* 3 X5
- FX6 X4+X5 4 X6=U(C'+F')=G'
- DX7 X4+X5 5 X7=L(C'+F')=G''
- SA3 A3+JX 6 X3=X''(3+K)
-* 7 X6
- + NX5 X6 8 X7 X5=G'
- NX7 X7 9
- SA2 A2+JX 10 X5 X2=X'(3+K)
- SA4 A4+JY 11 X7 X4=Y'(3+K)
- + FX6 X5+X7 12 X6=U(G'+G'')=Z'
- DX7 X5+X7 13 X3 X7=L(G'+G'')=Z''
- SA5 A5+JY 14 X5=Y''(3+K)
- FX3 X3*X0 15 X6 X3=U(X''*S')
- + SA6 A6+JZ 16 X7 Z'(2+K)=...
- SA7 A7+JZ 17 X2 Z''(2+K)=...
- FX6 X2*X1 18 X4 X6=U(X'*S'')
-* 19 X3
- FX7 X2*X0 20 X7=U(X'*S')=A'
-* 21 X5
- + DX2 X2*X0 22 X6 X2=L(X'*S')=A''
-* 23
- FX3 X3+X6 24 X7 X3=U(X''*S'+X'*S'')=B'
- DX6 X7_#_X4 25 X6=L(A'#Y')=C''
- FX4 X7_#_X4 26 X2 X4=U(A'#Y')=C'
- + S_J J+1 27 X3 J=2-N+1+K
- FX3 X2+X3 28 X6 X3=U(A''+B')=D'
- FX7 X6_#_X5 29 X4 X7=U(C''#Y'')=E'
-* 30
-* 31 X3
- + MI J,[1] 32 X7 WHILE 3-N+K<0; I.E. 4+K .LE. N
- DSCA1R ENDM
- DVSCA MACRO N,JX,#,JY,Z,JZ,J X4=(X) X2=(Y) X1=S
- LOCAL [1],[2],[99]
- SA3 X4+1 X3=X''(1)
- SA5 X2+1 X5=Y''(1)
- SA2 X4 X2=X'(1)
- SA4 A5-1 X4=Y'(1)
- S_J -N
- FX3 X3*X0 X3=U(X''(1)*S')
- S_J J+2 J=2-N
- FX6 X2*X1 X6=U(X'(1)*S'')
- FX7 X2*X0 X7=U(X'(1)*S')=A'(1)
- DX2 X2*X0 X2=L(X'(1)*S')=A''(1)
- FX3 X3+X6 X3=U(X''*S'+X'*S'')=B'
- DX6 X7_#_X4 X6=L(A'(1)#Y'(1))=C''
- FX4 X7_#_X4 X4=U(A'(1)#Y'(1))=C'
- FX3 X2+X3 X3=U(A''+B')=D'(1)
- FX7 X6_#_X5 X7=U(C''(1)#Y''(1))=E'(1)
- FX5 X3+X7 X5=U(D'(1)+E'(1))=F'(1)
- FX6 X4+X5 X6=U(C'(1)+F'(1))=G'(1)
- DX7 X4+X5 X7=L(C'(1)+F'(1))=G''(1)
- LE J,B0,[1] IF N = 2,3,...
- NX5 X6 X5=G'(1)
- NX7 X7
- FX6 X5+X7 X6=U(G'(1)+G''(1))
- DX7 X5+X7 X7=L(G'(1)+G''(1))
- SA6 Z Z'(1)=U(G'+G'')
- SA7 Z+1 Z''(1)=L(G'+G'')
- JP [99]
- [1] SA3 A3+JX X3=X''(2)
- NX5 X6 X5=G'(1)
- NX7 X7
- SA2 A2+JX X2=X'(2)
- SA4 A4+JY X4=Y'(2)
- FX6 X5+X7 X6=U(G'(1)+G''(1))
- DX7 X5+X7 X7=L(G'(1)+G''(1))
- SA5 A5+JY X5=Y''(2)
- FX3 X3*X0 X3=U(X''(2)*S')
- SA6 Z Z'(1)=U(G'+G'')
- SA7 Z+1 Z''(1)=L(G'+G'')
- FX6 X2*X1 X6=U(X'(2)*S'')
- FX7 X2*X0 X7=U(X'(2)*S')=A'(2)
- DX2 X2*X0 X2=L(X'(2)*S')=A''(2)
- FX3 X3+X6 X3=U(X''*S'+X'*S'')=B'
- DX6 X7_#_X4 X6=L(A'(2)#Y'(2))=C''
- FX4 X7_#_X4 X4=U(A'(2)#Y'(2))=C'
- FX3 X2+X3 X3=U(A''+B')=D'(2)
- FX7 X6_#_X5 X7=U(C''(2)#Y''(2))=E'(2)
- PL J,[2] IF N=2
- DSCA1R JX,#,JY,JZ,J J=0
- [2] FX5 X3+X7 X5=U(D'(N)+E'(N))=F'(N)
- FX6 X4+X5 X6=U(C'(N)+F'(N))=G'(N)
- DX7 X4+X5 X7=L(C'(N)+F'(N))=G''(N)
- NX5 X6 X5=G'(N)
- NX7 X7
- FX6 X5+X7 X6=U(G'(N)+G''(N))
- DX7 X5+X7 X7=L(G'(N)+G''(N))
- SA6 A6+JZ Z'(N)=U(G'+G'')
- SA7 A7+JZ Z''(N)=L(G'+G'')
- [99] BSS 0
- DVSCA ENDM
- CSCA1R MACRO JX,#,JY,JZ,J X0=S' X1=S''
- LOCAL [1]
- [1] BSS 0 FOR K = 0, 1, 2, ...
- + RX4 X2*X0 0 X4=X'(3+K)*S'
- NX6 X6 1
- RX5 X3*X1 2 X5=X''(3+K)*S''
- NX7 X7 3 X6
- + RX2 X2*X1 4 X4 X2=X'(3+K)*S''
- SA6 A6+JZ 5 X7 Z'(2+K)=X'*S'-X''*S''#Y'
- RX3 X3*X0 6 X5 X3=X''(3+K)*S'
- SA7 A7+JZ 7 Z''(2+K)=X'*S''+X''*S'#Y''
- + RX6 X4-X5 8 X2 X6=X'*S'-X''*S''
- SA4 A4+JY 9 X4=Y'(3+K)
- SA5 A5+JY 10 X3 X5=Y''(3+K)
- RX7 X2+X3 11 X6 X7=X'*S''+X''*S'
- + SA2 A2+JX 12 X2=X'(4+K)
- NX6 X6 13
- SA3 A3+JX 14 X7 X3=X''(4+K)
-* 15 X6
- NX7 X7 16 X4
- + RX6 X6_#_X4 17 X5 X6=X'*S'-X''*S''#Y'(3+K)
- S_J J+1 18 X7 J=3-N+1+K
- RX7 X7_#_X5 19 X2 X7=X'*S''+X''*S'#Y''(3+K)
-* 20 X6
-* 21 X3
- + MI J,[1] 22 X7 WHILE 4-N+K<0; I.E. 5+K .LE. N
- CSCA1R ENDM
- CVSCA MACRO N,JX,#,JY,Z,JZ,J X4=(X) X2=(Y) X1=S
- LOCAL [1],[2],[3],[99]
- SA3 X4+1 X3=X''(1) A3=(X)+1
- SA4 X2 X4=Y'(1) A4=(Y)
- S_J -N
- SA2 A3-1 X2=X'(1) A2=(X)
- S_J J+2 J=2-N
- RX6 X2*X0 X6=X'(1)*S'
- RX5 X3*X1 X5=X''(1)*S''
- RX2 X2*X1 X2=X'(1)*S''
- RX3 X3*X0 X3=X''(1)*S'
- RX6 X6-X5 X6=X'(1)*S'-X''(1)*S''
- SA5 A4+1 X5=Y''(1) A5=(Y'')
- RX7 X2+X3 X7=X'(1)*S''+X''(1)*S'
- LE J,B0,[1] IF N = 2,3,...
- NX6 X6
- NX7 X7
- RX6 X6_#_X4 X6=X'*S'-X''*S'' # Y'
- RX7 X7_#_X5 X7=X'*S''+X''*S' # Y''
- NX6 X6
- NX7 X7
- SA6 Z Z'(1)=...
- SA7 Z+1 Z''(1)=...
- JP [99]
- [1] SA2 A2+JX X2=X'(2) A2=(X'(2))
- NX6 X6
- SA3 A3+JX X3=X''(2) A3=(X''(2))
- NX7 X7
- RX6 X6_#_X4 X6=X'(1)*S'-X''(1)*S'' # Y'(1)
- RX7 X7_#_X5 X7=X'(1)*S''+X''(1)*S' # Y''(1)
- RX4 X2*X0 X4=X'(2)*S'
- NX6 X6
- RX5 X3*X1 X5=X''(2)*S''
- NX7 X7
- RX2 X2*X1 X2=X'(2)*S''
- SA6 Z Z'(1)=...
- RX3 X3*X0 X3=X''(2)*S'
- SA7 Z+1 Z''(1)=...
- RX6 X4-X5 X6=X'(2)*S'-X''(2)*S''
- SA4 A4+JY X4=Y'(2) A4=(Y'(2))
- SA5 A5+JY X5=Y''(2) A5=(Y''(2))
- RX7 X2+X3 X7=X'(2)*S''+X''(2)*S'
- ZR J,[3] IF N=2
- SA2 A2+JX X2=X'(3) A2=(X'(3))
- NX6 X6
- SA3 A3+JX X3=X''(3) A3=(X''(3))
- NX7 X7
- RX6 X6_#_X4 X6=X'(2)*S'-X''(2)*S'' # Y'(2)
- S_J J+1 J=3-N
- RX7 X7_#_X5 X7=X'(2)*S''+X''(2)*S' # Y''(2)
- PL J,[2] IF N=3
- CSCA1R JX,#,JY,JZ,J J=0
- [2] RX4 X2*X0 X4=X'(N)*S'
- NX6 X6
- RX5 X3*X1 X5=X''(N)*S''
- NX7 X7
- RX2 X2*X1 X2=X'(N)*S''
- SA6 A6+JZ Z'(N-1)=...
- RX3 X3*X0 X3=X''(N)*S'
- SA7 A7+JZ Z''(N-1)=...
- RX6 X4-X5 X6=X'(N)*S'-X''(N)*S''
- SA4 A4+JY X4=Y'(N) A4=(Y'(N))
- SA5 A5+JY X5=Y''(N) A5=(Y''(N))
- RX7 X2+X3 X7=X'(N)*S''+X''(N)*S'
- [3] NX6 X6
- NX7 X7
- RX6 X6_#_X4 X6=X'*S'-X''*S'' # Y'
- RX7 X7_#_X5 X7=X'*S''+X''*S' # Y''
- NX6 X6
- NX7 X7
- SA6 A6+JZ Z'(N)=...
- SA7 A7+JZ Z''(N)=...
- [99] BSS 0
- CVSCA ENDM
-*CD SCL
- RSCL2R MACRO JX,JY,J
- LOCAL [1]
- [1] BSS 0 FOR K = 0, 2, 4,...
- + S_J J+2 0 J=5-N+2+K
- RX6 X1*X4 1 X6=S*X(3+K)
- SA4 A5+JX 2 X5 X4=X(5+K)
- + SA7 A6+JY 3 Y(2+K)=S*X(2+K)
- RX7 X1*X5 4 X7=S*X(4+K)
- SA5 A4+JX 5 X6 X5=X(6+K)
- SA6 A7+JY 6 Y(3+K)=S*X(3+K)
- 7
- 8 X7
- + MI J,[1] 9 X4 WHILE 7-N+K=J<0; I.E. 8+K.LE.N
- RSCL2R ENDM
- RSCL4T MACRO JX,JY FOR K = 0, 4, 8, ...
- RX6 X1*X2 1 X6=S*X(3+K)
- SA2 A5+JX 2 X7 X2=X(7+K)
- SA7 A6+JY 3 X4 Y(2+K)=S*X(2+K)
- RX7 X1*X3 4 X7=S*X(4+K)
- SA3 A2+JX 5 X6 X3=X(8+K)
- SA6 A7+JY 6 X5 Y(3+K)=S*X(3+K)
- RX6 X1*X4 7 X6=S*X(5+K)
- SA4 A3+JX 8 X7 X4=X(9+K)
- SA7 A6+JY 9 X2 Y(4+K)=S*X(4+K)
- RX7 X1*X5 10 X7=S*X(6+K)
- SA5 A4+JX 11 X6 X5=X(10+K)
- SA6 A7+JY 12 X3 Y(5+K)=S*X(5+K)
- RSCL4T ENDM
- RSCL12R MACRO JX,JY,J
- LOCAL [1]
- [1] BSS 0 FOR K = 0, 12, 24, ...
- S_J J+12 J=17-N+12+K
- DUP 3
- RSCL4T JX,JY
- ENDD
- MI J,[1] WHILE 29-N+K=J<0; I.E. 30+K.LE.N
- RSCL12R ENDM
- RVSCL MACRO N,X,JX,Y,JY,J X1=S
- LOCAL [2],[3],[4],[5],[6],[7],[8],[99]
- BRANCH [4],N,LE,17,J J=17-N
- SA4 X 0 X4=X(1)
- SA5 X+JX 1 X5=X(2)
- 2
- SA2 A5+JX 3 X2=X(3)
- 4
- SA3 A2+JX 5 X3=X(4)
- 6
- 7 X4
- 8 X5
- RX6 X1*X4 9 X6=S*X(1)
- SA4 A3+JX 10 X2 X4=X(5)
- RX7 X1*X5 11 X7=S*X(2)
- SA5 A4+JX 12 X3 X5=X(6)
- SA6 Y Y(1)=S*X(1)
- RSCL12R JX,JY,J J=11,10,9,...,1,0
- S_J J-10 J=1,0,-1,...-9,-10
- RX6 X1*X2 X6=S*X(J+N-4)
- SA7 A6+JY
- RX7 X1*X3 X7=S*X(J+N-3)
- SA6 A7+JY
- ZR J,[3] IF ONE TERM LEFT
- PL J,[8] IF NO TERM LEFT
- [2] RSCL2R JX,JY,J 8 X7 J=1,0
- 9 X4
- NZ J,[8] 10 IF NO TERM LEFT
- [3] SA3 A5+JX 11 X3=X(N)
- SA7 A6+JY 12 X5 Y(N-3)=X(N-3)
- RX7 X1*X4 13 X7=S*X(N-2)
- 14
- RX6 X1*X5 15 X6=S*X(N-1)
- 16
- 17 X7
- SA7 A7+JY 18 X3 Y(N-2)=S*X(N-2)
- RX7 X1*X3 19 X6 X7=S*X(N)
- SA6 A7+JY 20 Y(N-1)=S*X(N-1)
- SA5 A3 21 A5=(X(N))
- 22
- 23 X7
- SA7 A6+JY 24 Y(N)=S*X(N)
- 25
- 26
- JP [99] 27
- [4] BSS 0 J=16,15,14,13,...1,0
- SX6 N-1 X6=N-1
- SA2 X X2=X(1)
- ZR X6,[5] IF N=1
- SA3 X+JX X3=X(2)
- S_J J-14 J=1,0,-1,...,-13,-14
- ZR J,[7] IF N=3
- RX6 X1*X2 X6=S*X(1)
- PL J,[6] IF N=2
- SA4 A3+JX X4=X(3)
- RX7 X1*X3 X7=S*X(2)
- SA5 A4+JX X5=X(4)
- S_J J+2 J=1,0,-1,...,-11,-12
- SA6 Y Y(1)=S*X(1)
- MI J,[2] IF N=6,7,...16,17
- ZR J,[3] IF N=5
- JP [8] IF N=4
- [5] BSS 0
- RX7 X1*X2 X7=S*X(1)
- SA5 A2 A5=(X(1))
- NO
- SA7 Y Y(1)=S*X(1)
- + JP [99]
- [6] BSS 0 X6=S*X(1)
- X3=X(2)
- RX7 X1*X3 X7=S*X(2)
- SA6 Y Y(1)=S*X(1)
- SA5 A3 A5=(X(2))
- SA7 A6+JY Y(2)=S*X(2)
- JP [99]
- [7] BSS 0 X2=X(1)
- X3=X(2)
- SA5 A3+JX 0 X5=X(3)
- RX7 X1*X2 1 X7=S*X(1)
- 2
- 3
- RX6 X1*X3 4 X6=S*X(2)
- 5 X7
- SA7 Y 6 Y(1)=S*X(1)
- 7 X5
- RX7 X1*X5 8 X6 X7=S*X(3)
- SA6 A7+JY 9 Y(2)=S*X(2)
- NO 10
- 11
- 12 X7
- SA7 A6+JY 13 Y(3)=S*X(3)
- 14
- 15
- JP [99] 16
- [8] BSS 0
- RX6 X1*X4 0 X6=S*X(N-1)
- SA7 A6+JY 1 Y(N-2)=S*X(N-2)
- RX7 X1*X5 2 X7=S*X(N)
- NO 3
- + SB0 0 4 X6
- SA6 A7+JY 5 Y(N-1)=S*X(N-1)
- 6 X7
- SA7 A6+JY 7 Y(N)=S*X(N)
- [99] BSS 0
- RVSCL ENDM
- RMSCL MACRO M,N,X,IX,JX,Z,IZ,JZ,J (X=X0, Z=A0) X1=S
- LOCAL [1],[2],[3],[4],[5],[5A],[6],[6A],[7],[8],[9],[99]
- LOCAL SAVEM
- LE M,N,[2] IF M .LE. N
- [1] SWAP M,N EXCHANGE M AND N
- SWAP IX,JX EXCHANGE IX AND JX
- SWAP IZ,JZ EXCHANGE IZ AND JZ
- [2] BRANCH [4],N,LE,17,J J=17-N
- SX7 M X7=M
- SA7 SAVEM SAVEM = M
- [3] BSS 0 FOR I = 1,2,...,M
- SA4 X X4=X(I,1) A4=(X(I,1))
- SA5 X+JX X5=X(I,2) A5=(X(I,2))
- S_J -N J=-N
- SA2 A5+JX X2=X(I,3) A2=(X(I,3))
- S_J J+17 J=17-N
- SA3 A2+JX X3=X(I,4) A3=(X(I,4))
- RX6 X1*X4 X6=S*X(I,1)
- SA4 A3+JX X4=X(I,5) A4=(X(I,5))
- RX7 X1*X5 X7=S*X(I,2)
- SA5 A4+JX X5=X(I,6) A5=(X(I,6))
- SA6 Z Z(I,1)=S*X(I,1)
- RSCL12R JX,JZ,J J=11,10,9,...,1,0
- RX6 X1*X2 X6=S*X(I,N+J-14)
- SA7 A6+JZ Z(I,N+J-15)=S*X(I,N+J-15)
- RX7 X1*X3 X7=S*X(I,N+J-13)
- S_Z Z+IZ Z=(Z(I+1,1))
- SA6 A7+JZ Z(I,N+J-14)=S*X(I,N+J-14)
- RX6 X1*X4 X6=S*X(I,N+J-12)
- SA7 A6+JZ Z(I,N+J-13)=S*X(I,N+J-13)
- RX7 X1*X5 X7=S*X(I,N+J-11)
- S_M M-1 M=M-1
- SA6 A7+JZ Z(I,N+J-12)=S*X(I,N+J-12)
- S_X X+IX X=(X(I+1,1))
- SA7 A6+JZ Z(I,N+J-11)=S*X(I,N+J-11)
- NZ M,[3] WHILE I<M
- BRANCH [99],J,EQ,11,N N=11-J
- SA4 SAVEM X4=M
- RESIDU A5,X,IX,JX,A7,Z,IZ,JZ
- S_M X4 M=M
- GT M,N,[1] IF M>N
- [4] BSS 0 1 .LE. M .LE. N .LE. 17
- BRANCH [8],N,GT,3,J J=3-N
- SA3 X X3=X(1,1) A3=(X(1,1))
- ZR J,[6] IF N=3
- S_J J-1 J=2-N
- ZR J,[5] IF N=2
- RX7 X1*X3 X7=S*X(1,1)
- SA7 Z Z(1,1)=S*X(1,1)
- JP [99]
- SAVEM BSS 1 SAVE OF M
- [5] SA4 X+JX X4=X(1,2)
- [5A] RX6 X1*X3 X6=S*X(I,1)
- S_M M-1 M=M-1
- RX7 X1*X4 X7=S*X(I,2)
- S_X X+IX X=(X(I+1,1))
- SA6 Z Z(I,1)=S*X(I,1)
- S_Z Z+IZ Z=(Z(I+1,1))
- SA7 A6+JZ Z(I,2)=S*X(I,2)
- ZR M,[99] IF I=M
- SA3 X X3=X(I+1,1)
- SA4 X+JX X4=X(I+1,2)
- JP [5A]
- [6] SA4 X+JX X4=X(1,2)
- SA5 A4+JX X5=X(1,3)
- [6A] RX6 X1*X3 X6=S*X(I,1)
- S_M M-1 M=M-1
- RX7 X1*X4 X7=S*X(I,2)
- SA6 Z Z(I,1)=S*X(I,1)
- RX6 X1*X5 X6=S*X(I,3)
- SA7 A6+JZ Z(I,2)=S*X(I,2)
- S_X X+IX X=(X(I+1,1))
- S_Z Z+IZ Z=(Z(I+1,1))
- SA6 A7+JZ Z(I,3)=S*X(I,3)
- ZR M,[99] IF I=M
- SA3 X X3=X(I+1,1)
- SA4 X+JX X4=X(I+1,2)
- NO
- SA5 A4+JX X5=X(I+1,3)
- JP [6A]
- [7] RX6 X1*X4 X6=S*X(I,N-2)
- SA4 A5+JX X4=X(I,N)
- SA7 A6+JZ Z(I,N-3)=S*X(I,N-3)
- RX7 X1*X5 X7=S*X(I,N-1)
- SA6 A7+JZ Z(I,N-2)=S*X(I,N-2)
- RX6 X1*X4 X6=S*X(I,N)
- SA7 A6+JZ Z(I,N-1)=S*X(I,N-1)
- SA6 A7+JZ Z(I,N)=S*X(I,N)
- ZR M,[99] IF I=M
- [8] SA3 X X3=X(I,1) A3=(X(I,1))
- SA5 X+JX X5=X(I,2) A5=(X(I,2))
- S_J -N J=-N
- SA4 A5+JX X4=X(I,3) A4=(X(I,3))
- S_J J+5 J=5-N
- S_M M-1 M=M-1
- RX6 X1*X3 X6=S*X(I,1)
- S_X X+IX X=(X(I+1,1))
- RX7 X1*X5 X7=S*X(I,2)
- SA5 A4+JX X5=X(I,4) A5=(X(I,4))
- SA6 Z Z(I,1)=S*X(I,1)
- S_Z Z+IZ Z=(Z(I+1,1))
- ZR J,[7] IF N=5
- PL J,[9] IF N=4
- RSCL2R JX,JZ,J J=1 OR 0
- ZR J,[7] IF N IS ODD
- [9] RX6 X1*X4 X6=S*X(I,N-1)
- SA7 A6+JZ Z(I,N-2)=S*X(I,N-2)
- RX7 X1*X5 X7=S*X(I,N)
- SA6 A7+JZ Z(I,N-1)=S*X(I,N-1)
- SA7 A6+JZ Z(I,N)=S*X(I,N)
- NZ M,[8] WHILE I<M
- [99] BSS 0
- RMSCL ENDM
- DSCL1R MACRO JX,JY,J
- LOCAL [1]
- [1] BSS 0 FOR K = 0, 1, 2, ...
- + DX7 X5+X6 0 X7=Y''(2+K)
- FX6 X5+X6 1 X3 X6=Y'(2+K)
- FX0 X2*X3 2 X4 X0=S''*X'(3+K)
-* 3 X7
- DX5 X1*X3 4 X6 X5=L(S'*X'(3+K))=A''(3+K)
- + SA7 A7+JY 5 Y''(2+K)
- FX7 X1*X4 6 X0 X7=S'*X''(3+K)
- S_J J+1 7 J=3-N+1+K
- + SA6 A6+JY 8 X5 Y'(2+K)
- FX5 X5+X0 9 X5=A''(3+K)+S''*X'(3+K)
- FX6 X1*X3 10 X7 X6=U(S'*X'(3+K))=A'(3+K)
- SA3 A3+JX 11 X3=X'(4+K)
- + SA4 A4+JX 12 X5 X4=X''(4+K)
- FX5 X5+X7 13 X5=A''(3+K)+S''*X'+S'*X''
-* 14 X6
-* 15
- MI J,[1] 16 X5 WHILE 4-N+K=J<0; I.E. 5+K.LE.N
- DSCL1R ENDM
- DVSCL MACRO N,X,JX,Y,JY,J X1=S', X2=S''
-* X=X0, X4, X5, X6, X7
- LOCAL [1],[2],[3],[99]
- S_J 1 J=1
- SA3 X X3=X'(1) A3=(X'(1))
- SA4 X+J X4=X''(1) A4=(X''(1))
- S_J J-N J=1-N
- NZ J,[1] IF N>1 GO TO [1]
- FX0 X2*X3 X0=S''*X'
- DX5 X1*X3 X5=L(S'*X')
- FX7 X1*X4 X7=S'*X''
- FX5 X5+X0 X5=L(S'*X')+S''*X'
- FX6 X1*X3 X6=U(S'*X')
- FX5 X5+X7 X5=L(S'*X')+S''*X'+S'*X''
- DX7 X5+X6 X7=Y''
- FX6 X5+X6 X6=Y'
- SA7 Y+1
- SA6 Y
- JP [99]
- [1] FX0 X2*X3 X0=S''*X'(1)
- S_J J+2 J=3-N
- DX5 X1*X3 X5=L(S'*X'(1))
- FX7 X1*X4 X7=S'*X''(1)
- FX5 X5+X0 X5=L(S'*X'(1))+S''*X'(1)
- FX6 X1*X3 X6=U(S'*X'(1))
- SA3 A3+JX X3=X'(2) A3=(X'(2))
- SA4 A4+JX X4=X''(2) A4=(X''(2))
- FX5 X5+X7 X5=L(S'*X'(1))+S''*X'(1)+S'*X''(1)
- DX7 X5+X6 X7=Y''(1)
- FX6 X5+X6 X6=Y'(1)
- FX0 X2*X3 X0=S''*X'(2)
- DX5 X1*X3 X5=L(S'*X'(2))
- SA7 Y+1 Y''(1) A7=(Y''(1))
- FX7 X1*X4 X7=S'*X''(2)
- SA6 Y Y'(1) A6=(Y'(1))
- FX5 X5+X0 X5=L(S'*X'(2))+S''*X'(2)
- FX6 X1*X3 X6=U(S'*X'(2))
- GT J,B0,[3] IF N=2 GO TO [3]
- SA3 A3+JX X3=X'(3) A3=(X'(3))
- SA4 A4+JX X4=X''(3) A4=(X''(3))
- FX5 X5+X7 X5=L(S'*X'(2))+S''*X'(2)+S'*X''(2)
- ZR J,[2] IF N=3 GO TO [2]
- DSCL1R JX,JY,J J=0
- [2] DX7 X5+X6 X7=Y''(N-1)
- FX6 X5+X6 X6=Y'(N-1)
- FX0 X2*X3 X0=S''*X'(N)
- DX5 X1*X3 X5=L(S'*X'(N))
- SA7 A7+JY Y''(N-1) A7=(Y''(N-1))
- FX7 X1*X4 X7=S'*X''(N)
- SA6 A6+JY Y'(N-1) A6=(Y'(N-1))
- FX5 X5+X0 X5=L(S'*X'(N))+S''*X'(N)
- FX6 X1*X3 X6=U(S'*X'(N))
- [3] FX5 X5+X7 X5=L(S'*X'(N))+S''*X'(N)+S'*X''(N)
- SB0 0
- DX7 X5+X6 X7=Y''(N)
- FX6 X5+X6 X6=Y'(N)
- SA7 A7+JY Y''(N) A7=(Y''(N))
- SA6 A6+JY Y'(N) A6=(Y'(N))
- [99] BSS 0
- DVSCL ENDM
- CSCL1R MACRO JX,JY,J
- LOCAL [1]
- [1] BSS 0 FOR K = 0, 1, 2, ...
- + RX7 X7+X0 0 X7=S''*X'(2+K)+S'*X''(2+K)
- S_J J+1 1 X5 J=3-N+1+K
- NX6 X6 2 X4 X6=Y'(2+K)
- + RX3 X2*X5 3 X7 X3=S''*X''(3+K)
- NX7 X7 4 X6 X7=Y''(2+K)
- RX0 X1*X5 5 X0=S'*X''(3+K)
- SA6 A6+JY 6 X7 Y'(2+K)
- + RX6 X1*X4 7 X3 X6=S'*X'(3+K)
- SA7 A7+JY 8 Y''(2+K)
- RX7 X2*X4 9 X0 X7=S''*X'(3+K)
- SA5 A5+JX 10 X5=X''(4+K)
- + SA4 A4+JX 11 X6 X4=X'(4+K)
- RX6 X6-X3 12 X6=S'*X'(3+K)-S''*X''(3+K)
-* 13 X7
-* 14
- MI J,[1] 15 X6 WHILE 4-N+K<0; I.E. 5+K.LE.N
- CSCL1R ENDM
- CVSCL MACRO N,X,JX,Y,JY,J X1=S' X2=S''
-* X = X0, X3, X4, X6, X7
- LOCAL [1],[2],[3],[99]
- S_J 1 J=1
- SA5 X+1 X5=X''(1) A5=(X''(1))
- S_J J-N J=1-N
- SA4 X X4=X'(1) A4=(X'(1))
- NZ J,[1] IF N>1 GO TO [1]
- RX3 X2*X5 X3=S''*X''(1)
- RX0 X1*X5 X0=S'*X''(1)
- RX6 X1*X4 X6=S'*X'(1)
- RX7 X2*X4 X7=S''*X'(1)
- RX6 X6-X3 X6=S'*X'(1)-S''*X''(1)
- RX7 X7+X0 X7=S''*X'(1)+S'*X''(1)
- NX6 X6 X6=Y'(1)
- NX7 X7 X7=Y''(1)
- SA6 Y Y'(1)
- SA7 Y+1 Y''(1)
- JP [99]
- [1] RX3 X2*X5 X3=S''*X''(1)
- S_J J+2 J=3-N
- RX0 X1*X5 X0=S'*X''(1)
- SA5 A5+JX X5=X''(2) A5=(X''(2))
- RX6 X1*X4 X6=S'*X'(1)
- RX7 X2*X4 X7=S''*X'(1)
- SA4 A4+JX X4=X'(2) A4=(X'(2))
- RX6 X6-X3 X6=S'*X'(1)-S''*X''(1)
- RX7 X7+X0 X7=S''*X'(1)+S'*X''(1)
- NX6 X6 X6=Y'(1)
- RX3 X2*X5 X3=S''*X''(2)
- NX7 X7 X7=Y''(1)
- RX0 X1*X5 X0=S'*X''(2)
- SA6 Y Y'(1)
- RX6 X1*X4 X6=S'*X'(2)
- SA7 Y+1 Y''(1)
- RX7 X2*X4 X7=S''*X'(2)
- GT J,B0,[3] IF N=2 GO TO [3]
- SA5 A5+JX X5=X''(3) A5=(X''(3))
- SA4 A4+JX X4=X'(3) A4=(X'(3))
- RX6 X6-X3 X6=S'*X'(2)-S''*X''(2)
- ZR J,[2] IF N=3 GO TO [2]
- CSCL1R JX,JY,J
- [2] RX7 X7+X0 X7=S''*X'(N-1)+S'*X''(N-1)
- NX6 X6 X6=Y'(N-1)
- RX3 X2*X5 X3=S''*X''(N)
- NX7 X7 X7=Y''(N-1)
- RX0 X1*X5 X0=S'*X''(N)
- SA6 A6+JY Y'(N-1)
- RX6 X1*X4 X6=S'*X'(N)
- SA7 A7+JY Y''(N-1)
- RX7 X2*X4 X7=S''*X'(N)
- [3] RX6 X6-X3 X6=S'*X'(N)-S''*X''(N)
- RX7 X7+X0 X7=S''*X'(N)+S'*X''(N)
- SB0 0
- NO
- NX6 X6 X6=Y'(N)
- NX7 X7 X7=Y''(N)
- SA6 A6+JY Y'(N)
- SA7 A7+JY Y''(N)
- [99] BSS 0
- CVSCL ENDM
- TRSCL MACRO TYPE,M,N,D,ID,JX,JZ,J,TEMP X0=(X),X6=IX,A0=(Z),X7=IZ
- LOCAL [1],SAVEXI1,SAVEIX,SAVEIZ
- SAVEXI1 EQU TEMP
- SAVEIX EQU TEMP+1
- SAVEIZ EQU TEMP+2
- SA6 SAVEIX SAVE IX
- SA7 SAVEIZ SAVE IZ
- [1] SA1 D X1=D(I) A1=(D(I))
- TAU IFNE TYPE,RTYPE
- SA2 D+1 X2=D(I)'' A2=(D(I)'')
- BX6 X0 X6=(X(I,1))
- SA6 SAVEXI1
- TAU ENDIF
- "P"_VSCL N,X0,JX,A0,JZ,J X0 IS SAVED ONLY BY RVSCL
- SA3 SAVEIX X3=IX
- SA4 SAVEIZ X4=IZ
- TAU IFNE TYPE,RTYPE
- SA5 SAVEXI1 X5=(X(I,1))
- TAU ENDIF
- S_M M-1 M=M-1
- S_J A0 J=(Z(I,1))
- S_D D+ID D=(D(I+1))
- RHO IFEQ TYPE,RTYPE X0=(X(I+1,1))
- IX0 X0+X3
- RHO ELSE
- IX0 X5+X3
- RHO ENDIF
- SA0 X4+J A0=(Z(I+1,1))
- NZ M,[1] IF(M.NE.0) REPEAT
- TRSCL ENDM
-*CD SET
- RSET2 MACRO JZ,J X6=S, J=2-N
- LOCAL [1]
- [1] BSS 0 FOR K = 0, 2, 4,...
- SA6 A6+JZ 0 Z(2+K)=S
- S_J J+2 1 J=2-N+K+2
- SA6 A6+JZ 2 Z(3+K)=S
-* 3
-* 4
- + MI J,[1] 5 WHILE 4-N+K<0; I.E. 5+K .LE. N
- RSET2 ENDM J=0 OR 1
- RSET8 MACRO JZ,J X6=X7=S, J=8-N
- LOCAL [1]
- [1] BSS 0 FOR K = 0, 8, 16,...
- S_J J+8 J=8-N+K+8
- SA6 A6+JZ Z(2+K)=S
- SA7 A7+JZ Z(3+K)=S
- SA6 A6+JZ Z(4+K)=S
- SA7 A7+JZ Z(5+K)=S
- SA6 A6+JZ Z(6+K)=S
- SA7 A7+JZ Z(7+K)=S
- SA6 A6+JZ Z(8+K)=S
- SA7 A7+JZ Z(9+K)=S
-* 9
-* 10
- MI J,[1] 11 WHILE 16-N+K<0; I.E. 17+K.LE.N
- RSET8 ENDM J = 7,6,...,0 FOR N=9,10,...,16
- RVSET2 MACRO N,Z,JZ,J X6=S, N>0
- LOCAL [1],[99]
- S_J 2
- SA6 Z Z(1)=S
- S_J J-N J=2-N=+1,0,-1,-2,...
- PL J,[1] IF N=1 (J=1) OR N=2 (J=0)
- RSET2 JZ,J J=1 OR 0 (FOR N ODD OR EVEN)
- [1] NZ J,[99] IF N IS ODD
- SA6 A6+JZ Z(N)=S IF N IS EVEN
- NO
- [99] BSS 0 N,Z,JZ,X6 UNALTERED
- RVSET2 ENDM
- RVSET MACRO N,Z,JZ,J X6=S, N>0
- LOCAL [1],[2],[3],[99]
- S_J 9
- SA6 Z Z(1)=S
- S_J J-N J=8,7,6,... FOR N=1,2,3,...
- BX7 X6 X7=S
- MI J,[1] IF N=10,11,...
- S_J J-8 J=1-N=0,-1,-2,... FOR N=1,2,3,
- MI J,[2] IF 1<N<10
- JP [99] IF N=1
- [1] SA7 Z+JZ Z(2)=S
- S_JZ JZ+JZ JZ=(Z(3))-(Z(1))
- RSET8 JZ,J J=-1,-2,-3,... FOR N=10,11,12,
- SX7 JZ X7=2*JZ
- S_J J-6 J=+1,0,-1,-2,...,-6
- AX7 1
- S_JZ X7 RESTORE JZ
- GT J,B0,[99] IF N=10,18,...
- SA6 A7+JZ Z(11+K)=S
- ZR J,[99] IF N=11,19,27,...
- [2] S_J J+1
- ZR J,[3] IF N=12,20,28,...
- RSET2 JZ,J J=+1 OR 0
- [3] NZ J,[99]
- SA6 A6+JZ
- [99] BSS 0
- RVSET ENDM
- RMSET MACRO M,N,Z,IZ,JZ,I,J X6=S, Z=BI
- LOCAL [1],[2],[3],[4],[5],[6],[99]
- LE M,N,[2] IF M .LE. N
- [1] SX7 M EXCHANGE M AND N
- S_M N
- S_N X7
- SX7 IZ EXCHANGE IZ AND JZ
- S_IZ JZ
- S_JZ X7
- [2] BRANCH [4],N,LE,9,J,I,M J=9-N I=-M
- BX7 X6 X7=S
- SX5 JZ X5=JZ
- S_JZ JZ+JZ JZ=2*JZ
- [3] BSS 0 FOR I = 1,2,...,M
- S_J -N
- SA6 Z Z(I,1)=S
- S_J J+9 J=9-N
- SA7 Z+X5 Z(I,2)=S A7=(Z(I,2))
- S_I I+1 I=I+1
- S_Z Z+IZ Z=(Z(I+1,1))
- RSET8 JZ,J J=7,6,...,1,0
- MI I,[3] WHILE I<M
- S_JZ X5 RESTORE JZ
- BRANCH [99],J,EQ,7,N N=7-J
- RESIDU A7,Z,IZ,JZ
- GT M,N,[1] IF M>N
- [4] BSS 0 1 .LE. M .LE. N .LE. 9
- BRANCH [5],N,GT,2,J,I,M J=2-N I=-M
- SA6 Z Z(1,1)=S
- NZ J,[99] IF M=N=1
- S_I I+1 I=0 FOR M=1
- SA6 A6+JZ Z(1,2)=S
- ZR I,[99] IF M=1
- SA6 Z+IZ Z(2,1)=S
- SA6 A6+JZ Z(2,2)=S
- JP [99]
- [5] S_J -N
- SA6 Z Z(I,1)=S A6=(Z(I,1))
- S_J J+2 J=2-N
- RSET2 JZ,J J=1,0
- S_I I+1 I=1+1
- + S_Z Z+IZ Z=(Z(I+1,1))
- NZ J,[6] IF N IS ODD
- SA6 A6+JZ
- [6] MI I,[5] WHILE I<M
- [99] BSS 0
- RMSET ENDM
-*CD SFACT
- TSFACT MACRO SAVEA,N,JA,TEMP5,A1K,AKK,IA,J,K X1=(A)
- LOCAL [1],[2],[99]
- LOCAL SAVEN,IFAIL,FLOAT1,TEMP2
- SAVEN EQU TEMP5 N
- IFAIL EQU SAVEN+1 IFAIL
- FLOAT1 EQU IFAIL+1 1.
- TEMP2 EQU FLOAT1+1
-* IFAIL = 0
- SX5 1
- SX6 N X6=N
- PX5 X5
- SA6 SAVEN SAVEN=N
- NX6 X5 X6=1.
- MX7 0 X7=0
- SA6 FLOAT1 FLOAT1=1.
- SA7 IFAIL IFAIL=0
- S_IA LENGTH IA=LENGTH
- S_K B0 K=0
- S_AKK X1 AKK=(A(1,1))
- S_A1K X1 A1K=(A(1,1))
- SX4 N X4=N
- [1] BSS 0 A1K=(A(1,K)) K=K-1
-* AKK=(A(K,K))
-* X4=N
- SA5 FLOAT1 X5=1.
- SA1 AKK X1=A(K,K)
- TAU IFEQ LENGTH,2
- SA2 AKK+1 X2=AKK''
- TAU ENDIF
- S_N X4 RESTORE N
- S_J K+1 J=K
- ZR X1,[2] IF A(K,K) IS ZERO
- NG X1,[2] OR NEGATIVE
- "P"RCPRCL AKK = X5/AKK
- SX5 B0 X5=IFAIL=0
- EQ J,N,[99] IF K=N
-* K=K-1
-* X1=(A(1,1))
- TSFACT2 SAVEA,N,K,A1K,AKK,IA,JA,TEMP2,J
- SA4 SAVEN X4=N
- S_J IA+JA J=IA+JA
- S_A1K A1K+JA A1K=(A(1,K+1))
- S_AKK AKK+J AKK=(A(K+1,K+1))
- JP [1]
-* IFAIL = -1
- [2] BSS 0
- SX5 -1 X5=IFAIL=-1
- [99] BSS 0 X5=IFAIL
- TSFACT ENDM
- TSFACTD MACRO SAVEA,N,JA,TEMP6L,A1K,AKK,I,J,K X1=(A)
- LOCAL [1],[2],[3],[99]
- LOCAL SAVEN,IFAIL,DET,JFAIL,FLOAT1,TEMP2
- SAVEN EQU TEMP6L N
- IFAIL EQU SAVEN+1 IFAIL
- DET EQU IFAIL+1 DET
- JFAIL EQU DET+LENGTH JFAIL
- FLOAT1 EQU JFAIL+1 1.
- TEMP2 EQU FLOAT1+1
-* DET = ONE
-* JFAIL = 0
-* IFAIL = 0
- SX6 N X6=N
- MX7 0 X7=0
- SA6 SAVEN SAVEN=N
- SX5 1
- SA7 IFAIL IFAIL=0
- PX6 X5
- SA7 JFAIL JFAIL=0
- NX6 X6 X6=1.
- SA6 FLOAT1 FLOAT1=1.
- SA6 DET DET=1.
- TAU IFEQ LENGTH,2
- SA7 DET+1 DET''=0.
- TAU ENDIF
- S_K B0 K=0
- S_AKK X1 AKK=(A(1,1))
- S_A1K X1 A1K=(A(1,1))
- SX4 N X4=N
- [1] BSS 0 A1K=(A(1,K)) K=K-1
-* AKK=(A(K,K))
-* X4=N
- SA2 AKK X2=A(K,K) (UPPER FOR D.P.)
- SX1 AKK X1=(A(K,K))
- S_N X4 RESTORE N
- ZR X2,[2] IF A(K,K) IS ZERO
- NG X2,[2] OR NEGATIVE
- "P"1DET DET,JFAIL,FLOAT1,I,J X1=(A(K,K)) NOT PRESERVED
- S_J K+1 J=K
- S_I LENGTH I=IA
- EQ J,N,[3] IF K=N
-* K=K-1
-* X1=(A(1,1))
- TSFACT2 SAVEA,N,K,A1K,AKK,I,JA,TEMP2,J
- SA4 SAVEN X4=N
- S_J JA+LENGTH J=IA+JA
- S_A1K A1K+JA A1K=(A(1,K+1))
- S_AKK AKK+J AKK=(A(K+1,K+1))
- JP [1]
-* IFAIL = -1
-* DET = ZERO
-* JFAIL = -2
- [2] BSS 0
- SX5 -1 X5=IFAIL=-1
- MX6 0 DET=ZERO
- TAU IFEQ LENGTH,2
- MX7 0
- TAU ENDIF
- SX0 -2 X0=JFAIL=-2
- JP [99]
-* DE-SCALE DET
-* SET JFAIL = -1, 0, +1
-* LOAD IFAIL INTO X5
- [3] BSS 0
- SA3 DET X3=DET
- TAU IFEQ LENGTH,2
- SA4 DET+1
- TAU ENDIF
- "P"2DET JFAIL,I,J X0=JFAIL, X6,X7=DET
- SA5 IFAIL X5=IFAIL
- [99] BSS 0 X0=JFAIL, X5=IFAIL, X6,X7=DET
- TSFACTD ENDM
- TSFACT2 MACRO SAVEA,N,K,A1K,AKK,IA,JA,TEMP2,J X1=(A)
-* K=K-1
-* CALL VSCL(N-K,A(K,K),A(K+1,K),IA,A(K,K+1),JA)
-* CALL MMNA(N-K,K,A(K+1,1),IA,JA,A(1,K+1),IA,A(K+1,K+1),IA)
- SA1 AKK X1=A(K,K)
- TAU IFEQ LENGTH,2
- SA2 AKK+1 X2=A''(K,K)
- TAU ENDIF
- S_K K+1 K=(K-1)+1=K
- SA0 AKK+JA A0=(A(K,K+1))
- SX0 AKK+IA X0=(A(K+1,1))
- S_N N-K N=N-K
- "P"VSCL N,X0,IA,A0,JA,J X1=A(K,K) [X2=A''(K,K)]
- SA1 SAVEA X1=(A(1,1))
- SA0 AKK+IA A0=(A(K+1,K))
- SX2 A1K+JA X2=(A(1,K+1))
- SA0 A0+JA A0=(A(K+1,K+1))
- SX1 X1+K X1=(A(1,1))+K=(A(K+1,1))
- TAU IFEQ LENGTH,2
- SX1 X1+K
- TAU ENDIF
-* N=N-K
-* X1=(A(K+1,1))
-* X2=(A(1,K+1))
-* A0=(A(K+1,K+1))
- "P"MMPY "MINUS",N,K,IA,JA,IA,"PLUS",A0,IA,TEMP2,J
- TSFACT2 ENDM
- RRCPRCL MACRO X1=AKK A1=(AKK)
-* X5=1.
-* AKK = 1./AKK
- RX6 X5/X1 X6=1./AKK
- SA6 A1 AKK=1./AKK
- RRCPRCL ENDM
- DRCPRCL MACRO X1=AKK' A1=(AKK')
-* X2=AKK'' A2=(AKK'')
-* X5=1.
- FX0 X5/X1 X0=1./AKK'
- FX4 X0*X1 X4=(1/AKK')*AKK'=R'
- DX3 X0*X1 X3=L(1/AKK')*AKK'=R''
- FX7 X5-X4 X7=1-R'=S'
- DX5 X5-X4 X5=L(1-R')=S''
- FX4 X0*X2 X4=(1/AKK')*AKK''
- NX7 X7 X7=S'
- FX7 X7+X5 X7=S'+S''=T'
- FX5 X7-X3 X5=T'-R''
- FX7 X5-X4 X7=T'-R''-(1/AKK')*AKK''=U'
- FX3 X7/X1 X3=U'/AKK'
- FX7 X3+X0
- DX5 X3+X0
- NX0 X7
- DX7 X0+X5
- FX6 X0+X5
- SA7 A2
- SA6 A1
- DRCPRCL ENDM
-*CD SFINV
- TSFINV MACRO TYPE,SAVEA,N,JA,TEMP4,IA,I,J,K,L X1=(A)
- LOCAL [99]
- SX6 N-1 X6=N-1
- S_IA LENGTH IA=LENGTH
- ZR X6,[99] IF N=1
- TSFINV1 SAVEA,N,IA,JA,TEMP4,I,J,K,L X1=(A)
- TSFINV2 SAVEA,N,IA,JA,TEMP4,I,J,K,L X1=(A)
- S_N N-1 N=N-1
- TMUTL TYPE,N,IA,JA,J X1=(A)
- [99] BSS 0
- TSFINV ENDM
- TSFINV1 MACRO SAVEA,N,IA,JA,TEMP3,A1I,AII,J,K X1=(A)
- LOCAL [1],[2],SAVEI,TEMP2
- SAVEI EQU TEMP3
- TEMP2 EQU TEMP3+1
-* DO 20 I = 2, N
-* IF(I .EQ. 2) GOTO 10
-* CALL UMNS(I-2,A12,A13,A23,A(2,I),A(3,I),A(1,I),A(2,I))
-* 10 A(I-1,I) = -A(I-1,I)
-* CALL VSCL(I-1,A(I,I),A(1,I),A(2,I),A(I,1),A(I,2))
-* 20 CONTINUE
- SX2 X1+JA X2=(A12)
- S_J 2 J=I=2
- S_A1I X2 A1I=(A12)
- SX6 J X6=I=2
- S_AII A1I+IA AII=(A22)
- SA6 SAVEI SAVEI=I=2
- JP [2]
- [1] BSS 0 X1=(A) J=I
- SX1 X1+JA X1=(A12)
- SX6 J X6=I
- SX2 A1I+IA X2=(A(2,I))
- SA6 SAVEI SAVEI=I
- S_K J-2 K=I-2
- SA0 A1I A0=(A(1,I))
- "P"UMPY "MINUS",K,IA,JA,IA,"MINUS",A0,IA,TEMP2,J
- [2] SA4 AII-IA X4=A(I-1,I)
- SA1 AII X1=A(I,I)
- TAU IFEQ LENGTH,2
- SA5 A4+1
- SA2 A1+1
- TAU ENDIF
- SA3 SAVEI X3=I
- BX6 -X4 X6=-A(I-1,I)
- TAU IFEQ LENGTH,2
- BX7 -X5
- TAU ENDIF
- SA5 SAVEA X5=(A(1,1))
- SA6 A4 A(I-1,I)=-A(I-1,I)
- TAU IFEQ LENGTH,2
- SA7 A4+1
- TAU ENDIF
- S_K X3-1 K=I-1
- SA0 X5+K A0=(A(I,1))
- TAU IFEQ LENGTH,2
- SA0 A0+K
- TAU ENDIF
- "P"VSCL K,A1I,IA,A0,JA,J X1=A(I,I) [X2=A''(I,I)]
- SA3 SAVEI X3=I
- SA1 SAVEA X1=(A)
- S_AII AII+JA AII=(A(I,I+1))
- S_A1I A1I+JA A1I=(A(1,I+1))
- S_AII AII+IA AII=(A(I+1,I+1))
- S_J X3+1 J=I+1
- LE J,N,[1] IF I .LT. N
- TSFINV1 ENDM X1=(A(1,1))
- TSFINV2 MACRO SAVEA,N,IA,JA,TEMP4,A1K,AKK,K,J X1=(A)
- LOCAL [1],SAVEN,SAVEK,TEMP2
- SAVEN EQU TEMP4
- SAVEK EQU TEMP4+1
- TEMP2 EQU TEMP4+2
-* K = 1
-* 1 A(K,K) = VMPA(N-K,A(K,K+1),A(K,K+2),
-* A(K+1,K),A(K+2,K),A(K,K))
-* K = K + 1
-* CALL MMPY(K-1,N-K+1,A(1,K),A(1,K+1),A(2,K),
-* A(K,K),A(K+1,K),
-* A(1,K),A(2,K))
-* IF(K .LT. N) GOTO 1
- SX7 N X7=N
- SX6 1 X6=1=K
- SA7 SAVEN SAVEN=N
- S_N N-1 N=N-1
- SA6 SAVEK SAVEK=K=1
- S_A1K X1 A1K=(A11)
- S_AKK X1 AKK=(A11)
- [1] BSS 0 N=N-K
- SX6 AKK+JA X6=(A(K,K+1))
- SX7 AKK+IA X7=(A(K+1,K))
- "P"VMPY "PLUS",N,X6,JA,X7,IA,"PLUS",AKK,J
- SA5 SAVEK X5=K
- SA6 AKK A(K,K)=VMPA
- TAU IFEQ LENGTH,2
- SA7 AKK+1
- TAU ENDIF
- S_AKK AKK+IA AKK=(A(K+1,K))
- S_A1K A1K+JA A1K=(A(1,K+1))
- S_AKK AKK+JA AKK=(A(K+1,K+1))
-* K=K+1
-* N=N-(K+1)=N-K+1
- SX1 A1K X1=(A(1,K))
- SX2 AKK X2=(A(K,K))
- SA0 A1K A0=(A(1,K))
- SX6 X5+1 X6=K
- S_K X5 K=K-1
- SA6 A5 SAVEK=K
- "P"MMPY "PLUS",K,N,IA,JA,IA,"NULL",A0,IA,TEMP2,J
- S_N N-1 N=N-K
- NZ N,[1] IF K .LT. N
- SA5 SAVEN X5=N
- SA1 SAVEA X1=(A(1,1))
- S_N X5 RESTORE N
- TSFINV2 ENDM
-*CD SQR
- RSQR1R MACRO JX,J
- LOCAL [1]
- [1] BSS 0 FOR K = 0, 1, 2, ...
- + NX6 X6 0 X6=Z(K)
- S_J J+1 1 J=2-N+1+K
-* 2 X6
- RX6 X6+X1 3 X5 X6=Z(K)+X(1+K)**2
- + RX1 X5*X5 4 X1=X(2+K)**2
- SA5 A5+JX 5 X5=X(3+K) A5=(X(3+K))
-* 6 X6
-* 7
- MI J,[1] 8 X1 WHILE 3-N+K<0; I.E. 4+K .LE. N
- RSQR1R ENDM
- RSQR4R MACRO JX,J
- LOCAL [1]
- [1] BSS 0 FOR K = 0, 4, 8, ...
- + NX7 X7 0 X0 X7=SUM1(1+K)
- SA2 A5+JX 1 X5 X2=X(7+K) A2=(X(7+K))
- RX1 X3*X3 2 X7 X1=X(4+K)**2
- NX6 X6 3 X6=SUM2(2+K)
- + RX7 X7+X0 4 X7=SUM1(1+K)+X(3+K)**2
- RX0 X4*X4 5 X6 X0=X(5+K)**2
- S_J J+4 6 X1 J=9-N+4+K
- + RX6 X6+X1 7 X7 X6=SUM2(2+K)+X(4+K)**2
- SA3 A2+JX 8 X2 A3=X(8+K) A3=(X(8+K))
- NX7 X7 9 X0 X7=SUM1(3+K)
- RX1 X5*X5 10 X6 X1=X(6+K)**2
- + NX6 X6 11 X7 X6=SUM2(4+K)
- SA4 A3+JX 12 X4=X(9+K) A4=(X(9+K))
- RX7 X7+X0 13 X6 X7=SUM1(3+K)+X(5+K)**2
- SA5 A4+JX 14 X1 X5=X(10+K)A5=(X(10+K))
- + RX6 X6+X1 15 X3 X6=SUM2(4+K)+X(6+K)**2
- RX0 X2*X2 16 X7 X0=X(7+K)**2
-* 17
-* 18 X6
- MI J,[1] 19 X4 WHILE 13-N+K<0; I.E. 14+K .LE. N
- RSQR4R ENDM
- RVSQR MACRO N,X,JX,J
- LOCAL [1],[2],[3],[4],[5],[99]
- SA4 X X4=X(1) A4=(X(1))
- BRANCH [2],N,LE,9,J J=9-N=8,7,6,...;N=1,2,3,...
- SA5 A4+JX X5=X(2) A5=(X(2))
- SA2 A5+JX X2=X(3) A2=(X(3))
- SA3 A2+JX X3=X(4) A3=(X(4))
- RX7 X4*X4 X7=SUM1(1)=X(1)**2
- SA4 A3+JX X4=X(5) A4=(X(5))
- RX6 X5*X5 X6=SUM2(2)=X(2)**2
- SA5 A4+JX X5=X(6) A5=(X(6))
- RX0 X2*X2 X0=X(3)**2
- RSQR4R JX,J J=3,2,1,0 FOR 0,1,2,3 TERMS LEFT
- NX7 X7 X7=SUM1(N-8+J)
- RX1 X3*X3 X1=X(N-5+J)**2
- NX6 X6 X6=SUM2(N-7+J)
- RX7 X7+X0 X7=SUM1(N-8+J)+X(N-6+J)**2
- RX0 X4*X4 X0=X(N-4+J)**2
- RX6 X6+X1 X6=SUM2(N-7+J)+X(N-5+J)**2
- NX7 X7 X7=SUM1(N-6+J)
- RX1 X5*X5 X1=X(N-3+J)**2
- NX6 X6 X6=SUM2(N-5+J)
- RX7 X7+X0 X7=SUM1(N-6+J)+X(N-4+J)**2
- RX6 X6+X1 X6=SUM2(N-5+J)+X(N-3+J)**2
- S_J J-2 J=+1,0,-1,-2
- NX1 X7 X1=SUM1(N-4+ OLD J)
- GT J,B0,[5] IF NEW J=+1; I.E. 0 TERMS LEFT
- SA5 A5+JX X5=X(N-3+ OLD J)
- MI J,[3] IF NEW J=-1,-2; I.E.2,3 TERMS LEFT
- JP [4] IF NEW J=0; I.E. 1 TERM LEFT
- [1] RX6 X4*X4 X6=X(1)**2
- JP [99]
- [2] BSS 0 J=9-N=8,7,6,...,0; N=1,2,3,...,9
- S_J J-7 J=2-N=+1,0,-1,...,-7
- GT J,B0,[1] IF J>0; I.E. N=1
- RX1 X4*X4 X1=X(1)**2
- SA5 A4+JX X5=X(2) A5=(X(2))
- MX6 0 X6=SUM(0)=0.
- ZR J,[4] IF J=0; I.E. N=2
- [3] BSS 0 J=2-N=-1,-2,...,-7; N=3,4,...,9
- RSQR1R JX,J J=0
- [4] NX6 X6
- RX6 X6+X1
- RX1 X5*X5
- [5] NX6 X6
- RX6 X6+X1
- NX6 X6 X6=SUM(N)
- [99] BSS 0
- RVSQR ENDM
- DSQR1R MACRO JX,J
- LOCAL [1]
- [1] BSS 0 FOR K = 0, 1, 2, ...
- + FX6 X0+X7 0 X2 X6=U(C'(1+K)+F'(1+K))=G'(1+K)
- DX7 X0+X7 1 X7=L(C'(1+K)+F'(1+K))=G''(1+K)
- FX3 X3*X2 2 X3=U(X''(2+K)*X'(2+K))
-* 3 X6
- NO 4 X7
- + NX1 X6 5 X1=G'(1+K)
- FX0 X2*X2 6 X3 X0=U(X'(2+K)**2)=A'(2+K)
- NX7 X7 7 X1 X7=G''(1+K)
- DX2 X2*X2 8 X2=L(X'(2+K)**2)=A''(2+K)
- + S_J J+1 9 X7 J=2-N+1+K
- FX6 X1+X7 10 X0 X6=U(G'(1+K)+G''(1+K))=S'(1+K)
- DX7 X1+X7 11 X7=L(G'(1+K)+G''(1+K))=S''(1+K)
- + FX3 X3+X3 12 X2 X3=U(2*X''*X')=B'(2+K)
-* 13 X6
- DX4 X6+X0 14 X7 X4=L(S'(1+K)+A'(2+K))=C''(2+K)
- FX0 X6+X0 15 X3 X0=U(S'(1+K)+A'(2+K))=C'(2+K)
- FX1 X2+X3 16 X1=U(A''(2+K)+B'(2+K))=D'(2+K)
- + SA3 A3+JX 17 X4 X3=X''(3+K)
- FX7 X7+X4 18 X0 X7=U(S''(1+K)+C''(2+K))=E'(2+K)
- SA2 A2+JX 19 X1 X2=X'(3+K)
-* 20
-* 21 X7
- FX7 X7+X1 22 X7=U(E'(2+K)+D'(2+K))=F'(2+K)
-* 23
-* 24 X3
- + MI J,[1] 25 X7 WHILE 3-N+K=J<0; I.E. 4+K .LE. N
- DSQR1R ENDM
- DVSQR MACRO N,X,JX,J
- LOCAL [1],[2]
- SA3 X+1 X3=X''(1) A3=(X''(1))
- SA2 X X2=X'(1) A2=(X'(1))
- S_J -N
- S_J J+2 J=2-N
- FX0 X3*X2 X0=U(X''(1)*X'(1))
- DX6 X2*X2 X6=L(X'(1)**2)
- FX1 X0+X0 X1=U(2*X''(1)*X'(1))
- FX0 X2*X2 X0=U(X'(1)**2)
- FX7 X6+X1 X7=U(A''(1)+B'(1))
- GT J,B0,[2] IF N=1
- SA3 A3+JX X3=X''(2)
- SA2 A2+JX X2=X'(2)
- ZR J,[1] IF N=2
- DSQR1R JX,J J=0
- [1] FX6 X0+X7
- DX7 X0+X7
- FX3 X3*X2
- NX1 X6
- FX0 X2*X2
- NX7 X7
- DX2 X2*X2
- FX6 X1+X7
- DX7 X1+X7
- FX3 X3+X3
- DX4 X6+X0
- FX0 X6+X0
- FX1 X2+X3
- FX7 X7+X4
- FX7 X7+X1
- [2] FX6 X0+X7
- DX7 X0+X7
- NX1 X6
- NX7 X7
- FX6 X7+X1
- DX7 X7+X1
- DVSQR ENDM
- CSQR1R MACRO JX,J
- LOCAL [1]
- [1] BSS 0 FOR K = 0, 1, 2, ...
- + S_J J+1 0 X4 J=2-N+1+K
- RX0 X0+X3 1 X5 X0=SUM3(K)+X''(1+K)**2
- RX1 X4*X4 2 X1=X'(2+K)**2
- + NX6 X6 3 X6=SUM1(1+K)
- RX2 X4*X5 4 X0 X2=X'(2+K)*X''(2+K)
- NX7 X7 5 X6 X7=SUM2(1+K)
- RX3 X5*X5 6 X1 X3=X''(2+K)**2
- + NX0 X0 7 X7 X0=SUM3(1+K)
- SA4 A4+JX 8 X2 X4=X'(3+K)
- SA5 A5+JX 9 X0 X5=X''(3+K)
- RX6 X6+X1 10 X3 X6=SUM1(1+K)+X'(2+K)**2
- + RX7 X7+X2 11 X7=SUM2(1+K)+X'(2+K)*X''(2+K)
-* 12
-* 13 X6
- MI J,[1] 14 X7 WHILE 3-N+K<0; I.E. 4+K .LE. N
- CSQR1R ENDM
- CVSQR MACRO N,X,JX,J
- LOCAL [1],[2]
- SA4 X X4=X'(1) A4=(X'(1))
- SA5 X+1 X5=X''(1) A5=(X''(1))
- S_J -N
- S_J J+2 J=2-N
- RX6 X4*X4 X6=X'(1)**2
- MX3 0 X3=0.
- RX7 X4*X5 X7=X'(1)*X''(1)
- RX0 X5*X5 X0=X''(1)**2
- GT J,B0,[2] IF N=1
- SA4 A4+JX X4=X'(2) A4=(X'(2))
- SA5 A5+JX X5=X''(2) A5=(X''(2))
- ZR J,[1] IF N=2
- CSQR1R JX,J J=0
- [1] RX0 X0+X3 X0=SUM3(N-2)+X''(N-1)**2
- RX1 X4*X4 X1=X'(N)**2
- NX6 X6 X6=SUM1(N-1)
- RX2 X4*X5 X2=X'(N)*X''(N)
- NX7 X7 X7=SUM2(N-1)
- RX3 X5*X5 X3=X''(N)**2
- NX0 X0 X0=SUM3(N-1)
- RX6 X6+X1 X6=SUM1(N-1)+X'(N)**2
- RX7 X7+X2 X7=SUM2(N-1)+X'(N)*X''(N)
- RX0 X0+X3 X0=SUM3(N-1)+X''(N)**2
- NX6 X6 X6=SUM1(N)
- NX7 X7 X7=SUM2(N)
- NX0 X0 X0=SUM3(N)
- [2] RX6 X6-X0 X6=SUM1(N)-SUM3(N)
- RX7 X7+X7 X7=2*SUM2(N) IS NORMALIZED
- NX6 X6
- CVSQR ENDM
-*CD SUM
- RSUM1 MACRO JX,J X4=X(1) A4=(X(1))
- LOCAL [1]
- [1] BSS 0 FOR K = 0, 1, 2,...
-* 0 X4
- + RX6 X6+X4 1 X6=SUM(K)+X(1+K)
- SA4 A4+JX 2 X4=X(2+K) A4=(X(2+K))
- S_J J+1 3 J=-R+K+1
-* 4 X6
- + NX6 X6 5
-* 6
-* 7 X6
- MI J,[1] 8 WHILE 1-R+K<0; I.E. 2+K .LE. R
- RSUM1 ENDM X6=SUM(R) A4=(X(R)) J=0
- RSUM2 MACRO JX,J J=1-R
- LOCAL [1]
- [1] BSS 0 FOR K = 0,2,4,...
- + S_J J+2 0 X3 J=1-R+K+2
- NX6 X6 1
- RX5 X5+X3 2 X4 X5=S1(K)+X(1+K)
- + SA3 A4+JX 3 X6 X3=X(4+K)
- RX6 X6+X4 4 X6=S2(1+K)+X(3+K)
- SA4 A3+JX 5 X5 X4=X(5+K)
- NX5 X5 6
-* 7 X6
-* 8 X5
- + MI J,[1] 9 WHILE 3-R+K<0; I.E. 4+K .LE. R
- RSUM2 ENDM J=0,1 FOR R=2Q+J
- RSUM4 MACRO JX,J,FOUR J=3-R
- LOCAL [1]
- [1] BSS 0 FOR K = 0,4,8,...
- + NX7 X7 0 X7=S2(2)
- NX0 X0 1 X4 X0=S3(3)
- NX6 X6 2 X7 X6=S4(4)
- RX1 X1+X3 3 X0 X1=S1(1)+X(5+K)
- + SA3 A4+JX 4 X6 X3=X(9+K)
- RX7 X7+X5 5 X7=S2(2)+X(6+K)
- SA5 A3+JX 6 X1 X5=X(10+K)
- RX0 X0+X2 7 X0=S3(3)+X(7+K)
- + SA2 A5+JX 8 X7 X2=X(11+K)
- RX6 X6+X4 9 X6=S4(4)+X(8+K)
- SA4 A2+JX 10 X0 X4=X(12+K)
- S_J J+FOUR 11 X3 J=3-R+K+4
- + NX1 X1 12 X6 X1=S1(5+K)
-* 13 X5
-* 14 X1
- MI J,[1] 15 X2 WHILE 7-R+K<0; I.E. 8+K .LE. R
- RSUM4 ENDM J=0,1,2,3 FOR R=2Q+3-J
- RVSUM1 MACRO JX,J X4=X(1) A4=(X(1)) J=-N
- LOCAL [1],[99]
- S_J J+2 J=2-N
- BX6 X4 X6=X(1)=SUM(1)
- GT J,B0,[99] IF N=1 ALL DONE
- SA4 A4+JX X4=X(2) A4=(X(2))
- ZR J,[1] IF N=2
- RSUM1 JX,J X6=SUM(N-1)
- [1] RX6 X6+X4 X6=SUM(N-1)+X(N)
- SB0 0
- NX6 X6 X6=SUM(N)
- [99] BSS 0
- RVSUM1 ENDM X6=SUM(N)
- RVSUM2 MACRO JX,J X4=X(1) A4=(X(1)) J=-N
- LOCAL [1],[2],[99],LIMIT
- LIMIT EQU 5 UP TO N=LIMIT, RVSUM1 IS USED
- SX7 J+LIMIT X7=LIMIT-N
- PL X7,[2]
- SA5 A4+JX X5=X(2)
- S_J J+5 J=5-N
- SA3 A5+JX X3=X(3)
- BX6 X4 X6=X(1)
- SA4 A3+JX X4=X(4) A4=(X(4))
- RSUM2 JX,J
- NZ J,[1] IF ALL TERMS FETCHED
- + NX6 X6
- RX6 X6+X4
- SA4 A4+JX
- [1] NX6 X6
- RX5 X5+X3
- RX6 X4+X6
- NX5 X5
- NX6 X6
- RX6 X6+X5
- NX6 X6
- JP [99]
- [2] RVSUM1 JX,J
- [99] BSS 0 X6=RVSUM(N,X(1),X(2))
- RVSUM2 ENDM
- RVSUM MACRO N,JX,J X4=X(1) A4=(X(1))
- S_J -N J=-N
- RVSUM2 JX,J
- RVSUM ENDM X6=SUM
-*CD XCH
- RXCH1R MACRO JX,JY,J
- LOCAL [1]
- [1] BSS 0 FOR K = 0, 1, 2,...
- + S_J J+1 0 X4 J=2-N+1+K
- BX7 X4 1 X5 X7=X(2+K)
- BX6 X5 2 X7 X6=Y(2+K)
- + SA4 A4+JX 3 X6 X4=X(3+K)
- SA5 A5+JY 4 X5=Y(3+K)
- SA7 A7+JY 5 Y(2+K)=X(2+K)
- SA6 A6+JX 6 X(2+K)=Y(2+K)
- 7
- 8
- + MI J,[1] 9 WHILE 3-N+K = J < 0; I.E. 4+K .LE. N
- RXCH1R ENDM
- RXCH6R MACRO JX,JY,J
- LOCAL [1]
- [1] BSS 0 FOR K = 0, 6, 12, ...
- S_J J+6 0 X4 J=8-N+6+K
- DUP 3
- BX7 X2 1 X5 X7=X(2+K)
- BX6 X3 2 X7 X6=Y(2+K)
- SA2 A4+JX 3 X6 X2=X(4+K)
- SA3 A5+JY 4 X3=Y(4+K)
- SA7 A7+JY 5 Y(2+K)=X(2+K)
- SA6 A6+JX 6 X(2+K)=Y(2+K)
- BX7 X4 7 X7=X(3+K)
- BX6 X5 8 X7 X6=Y(3+K)
- SA4 A2+JX 9 X6 X4=X(5+K)
- SA5 A3+JY 10 X2 X5=Y(5+K)
- SA7 A7+JY 11 X3 Y(3+K)=X(3+K)
- SA6 A6+JX 12 X(3+K)=Y(3+K)
- ENDD
- MI J,[1] 39 WHILE 14-N+K=J<0; I.E. 15+K .LE. N
- RXCH6R ENDM
- RVXCH MACRO N,X,JX,Y,JY,J
- LOCAL [1],[2],[3],[4],[99]
- BRANCH [2],N,GT,8,J J = 8-N
- + SA2 X 0 X2=X(1)
- SA3 Y 1 X3=Y(1)
- SX6 N-1 2 X6=N-1
- 3
- 4
- + ZR X6,[1] 5 IF N=1
- SA4 A2+JX 6 X4=X(2)
- SA5 A3+JY 7 X2 X5=Y(2)
- + BX7 X2 8 X3 X7=X(1)
- BX6 X3 9 X7 X6=Y(1)
- S_J J-6 10 X6 J=2-N
- + SA7 Y 11 Y(1)=X(1)
- SA6 X 12 X(1)=Y(1)
- 13
- ZR J,[4] 14 IF N=2
- 15
- 16
- + JP [3] 17 FOR N=3,4,5,6,7,8
- [1] BX7 X2 X7=X(1)
- BX6 X3 X6=Y(1)
- SA7 Y Y(1)=X(1)
- SA6 X X(1)=Y(1)
- SA4 A2 A4=(X(1))
- SA5 A3 A5=(Y(1))
- JP [99]
- [2] BSS 0 J=8-N
- + SA4 X 0 X4=X(1)
- SA5 Y 1 X5=Y(1)
- NO 2
- NO 3
- + SA2 A4+JX 4 X2=X(2)
- SA3 A5+JY 5 X3=Y(2)
- 6
- 7 X4
- BX7 X4 8 X5 X7=X(1)
- BX6 X5 9 X7 X6=Y(1)
- + SA4 A2+JX 10 X6 X4=X(3)
- SA5 A3+JY 11 X2 X5=Y(3)
- SA7 Y 12 X3 Y(1)=X(1)
- SA6 X 13 X(1)=Y(1)
- RXCH6R JX,JY,J
- + S_J J-5 39 J=0,-1,-2,-3,-4,-5
- 40 X4
- BX7 X2 41 X5 X7=X(J+N-1)
- BX6 X3 42 X7 X6=Y(J+N-1)
- + SA7 A7+JY 43 X6 Y(J+N-1)=X(J+N-1)
- SA6 A6+JX 44 X(J+N-1)=Y(J+N-1)
- 45
- ZR J,[4] 46 IF LAST TERM FETCHED
- [3] RXCH1R JX,JY,J
- [4] BX7 X4 X7=X(N)
- BX6 X5 X6=Y(N)
- SA7 A7+JY Y(N)=X(N)
- SA6 A6+JX X(N)=Y(N)
- [99] BSS 0
- RVXCH ENDM
- DXCHPR MACRO P,JX,JY,J
- LOCAL [1]
- [1] BSS 0 FOR K = 0, P, 2P, ...
- + S_J J+P
- TERM DUP P
- BX7 X2 1 X5 X7=X'(K)
- BX6 X3 2 X7 X6=Y'(K)
- SA2 A2+JX 3 X6 X2=X'(K+1)
- SA3 A3+JY 4 X3=Y'(K+1)
- SA6 A2-JX 5 X'(K)=Y'(K)
- SA7 A3-JY 6 Y'(K)=X'(K)
- BX7 X4 7 X7=X''(K)
- BX6 X5 8 X7 X6=Y''(K)
- SA4 A4+JX 9 X6 X4=X''(K+1)
- SA5 A5+JY 10 X2 X5=Y''(K+1)
- SA6 A4-JX 11 X3 X''(K)=Y''(K)
- SA7 A5-JY 12 Y''(K)=X''(K)
- TERM ENDD
- MI J,[1] WHILE J<0
- DXCHPR ENDM
- DVXCH MACRO N,X,JX,Y,JY,J
- LOCAL [1],[2]
- SA2 X X2=X'(1)
- SA3 Y X3=Y'(1)
- SA4 X+1 X4=X"(1)
- SA5 Y+1 X5=Y"(1)
- BRANCH [1],N,LE,3,J J=3-N
- DXCHPR 3,JX,JY,J J=2,1,0
- [1] S_J J-2 J=0,-1,-2
- ZR J,[2]
- DXCHPR 1,JX,JY,J J=0
- [2] BX7 X2 X7=X'(N)
- BX6 X3 X6=Y'(N)
- SA7 A3 Y'(N)=X'(N)
- SA6 A2 X'(N)=Y'(N)
- BX7 X4 X7=X"(N)
- BX6 X5 X6=Y"(N)
- SA7 A5 Y"(N)=X''(N)
- SA6 A4 X"(N)=Y''(N)
- DVXCH ENDM
diff --git a/src/packlib/kernlib/kernnum/obsolete/kernib/add.inc b/src/packlib/kernlib/kernnum/obsolete/kernib/add.inc
deleted file mode 100644
index a2e5eee..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/kernib/add.inc
+++ /dev/null
@@ -1,132 +0,0 @@
-*
-* $Id: add.inc,v 1.1.1.1 1996/02/15 17:48:31 mclareni Exp $
-*
-* $Log: add.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:31 mclareni
-* Kernlib
-*
-*
-#ifndef CERNLIB_KERNNUM_ADD_INC
-#define CERNLIB_KERNNUM_ADD_INC
-*
-*
-* add.inc
-*
- MACRO
- &LABEL ADD &F,&X,&Y,&Z,&JX=0,&JY=0,&JZ=0
-#include "kernnum/global.inc"
- &LABEL LOAD 0,&X,JX=&JX
- AIF ('&T' EQ 'R').RADD
- AIF ('&T' EQ 'D').DADD
- AIF ('&T' EQ 'C').CADD
- MEXIT
- .CADD ANOP
- &F&W 2,&D.(&Y,&JY)
- ST&W 2,&D.(&Z,&JZ)
- .RADD ANOP
- .DADD ANOP
- &F&W 0,0(&Y,&JY)
- ST&W 0,0(&Z,&JZ)
- MEND
- MACRO
- &LABEL TVADD &F,&N,&X,&JX,&Y,&JY,&Z,&JZ
-#include "kernnum/global.inc"
- PUSH &X STACK (X(1))
- PUSH &Y STACK (Y(1))
- PUSH &Z STACK (Z(1))
- L&SYSNDX LOOPONE &N FOR J = 1, N
- ADD &F,&X,&Y,&Z
- AR &X,&JX &X = (X(J+1))
- AR &Y,&JY &Y = (Y(J+1))
- AR &Z,&JZ &Z = (Z(J+1))
- LEND &N,L&SYSNDX
- POP &Z RESTORE &Z = (Z(1))
- POP &Y &Y = (Y(1))
- POP &X &X = (X(1))
- MEND
- MACRO
- &LABEL VADD &F,&N,&X,&JX,&Y,&JY,&Z,&JZ,&JX2,&JY2,&JZ2,&J
- &LABEL FIRST &J,&N,LOOP=L&SYSNDX
- ADD &F,&X,&Y,&Z
- AR &X,&JX (X) = (X) + JX
- AR &Y,&JY (Y) = (Y) + JY
- AR &Z,&JZ (Z) = (Z) + JZ
- L&SYSNDX FORTWO &J,&N,EXIT=X&SYSNDX
- ADD &F,&X,&Y,&Z
- ADD &F,&X,&Y,&Z,JX=&JX,JY=&JY,JZ=&JZ
- AR &X,&JX2 (X) = (X) + 2*JX
- AR &Y,&JY2 (Y) = (Y) + 2*JY
- AR &Z,&JZ2 (Z) = (Z) + 2*JZ
- X&SYSNDX ENDFOR &J,&N,LOOP=L&SYSNDX
- MEND
- MACRO
- &LABEL TVADD2 &F,&N,&X,&JX,&Y,&JY,&Z,&JZ,&JX2,&JY2,&JZ2,&J
-#include "kernnum/global.inc"
- LCLA &OLD,&X1,&Y1,&Z1
- &LABEL DS 0H
- &OLD SETA &STACK
- &X1 SETA &OLD
- &Y1 SETA &X1+1*4
- &Z1 SETA &Y1+1*4
- &STACK SETA &Z1+1*4
- AIF (&STACK LE &STKLIM).ALPHA
- MNOTE 12,'NO SPACE FOR MACRO TVADD2'
- MEXIT
- .ALPHA ANOP
- ST &X,&X1.(15) X1 = (X)
- ST &Y,&Y1.(15) Y1 = (Y)
- ST &Z,&Z1.(15) Z1 = (Z)
- VADD &F,&N,&X,&JX,&Y,&JY,&Z,&JZ,&JX2,&JY2,&JZ2,&J
- L &X,&X1.(15) &X = (X)
- L &Y,&Y1.(15) &Y = (Y)
- L &Z,&Z1.(15) &Z = (Z)
- &STACK SETA &OLD
- MEND
- MACRO
- &LABEL TMADD &F,&M,&N,&X,&IX,&JX,&Y,&IY,&JY,&Z,&IZ,&JZ
-#include "kernnum/global.inc"
- &LABEL DS 0H
- A&SYSNDX PUSH &M
- PUSH &X
- PUSH &Y
- PUSH &Z
- LA 0,1
- NR 0,&M R0 = MOD(M,2)
- BZ B&SYSNDX IF M IS EVEN
- TVADD &F,&N,&X,&JX,&Y,&JY,&Z,&JZ
- S &M,=F'1' M = M-1
- BZ E&SYSNDX IF M = 1
- AR &X,&IX &X = (X(2,1))
- AR &Y,&IY &Y = (Y(2,1))
- AR &Z,&IZ &Z = (Z(2,1))
- B&SYSNDX LA 0,1 R0 = NSTEP = 1
- LR 1,&N R1 = N
- C&SYSNDX PUSH &X &X = (X(I,1))
- PUSH &Y &Y = (Y(I,1))
- PUSH &Z &Z = (Z(I,1))
- LA &N,1 &N = J = 1
- D&SYSNDX ADD &F,&X,&Y,&Z
- ADD &F,&X,&Y,&Z,JX=&IX,JY=&IY,JZ=&IZ
- AR &X,&JX &X = (X(I,J+1))
- AR &Y,&JY &Y = (Y(I,J+1))
- AR &Z,&JZ &Z = (Z(I,J+1))
- BXLE &N,0,D&SYSNDX
- POP &Z &Z = (Z(I,1))
- POP &Y &Y = (Y(I,1))
- POP &X &X = (X(I,1))
- AR &Z,&IZ
- AR &Y,&IY
- AR &X,&IX
- AR &Z,&IZ &Z = (Z(I+2,1))
- AR &Y,&IY &Y = (Y(I+2,1))
- AR &X,&IX &X = (X(I+2,1))
- S &M,=F'2' M = M-2
- BNZ C&SYSNDX
- E&SYSNDX LR &N,1 &N = N
- POP &Z &Z = (Z(1,1))
- POP &Y &Y = (Y(1,1))
- POP &X &X = (X(1,1))
- POP &M &M = M
- MEND
-
-#endif
diff --git a/src/packlib/kernlib/kernnum/obsolete/kernib/basic.inc b/src/packlib/kernlib/kernnum/obsolete/kernib/basic.inc
deleted file mode 100644
index cb1d653..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/kernib/basic.inc
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: basic.inc,v 1.1.1.1 1996/02/15 17:48:31 mclareni Exp $
-*
-* $Log: basic.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:31 mclareni
-* Kernlib
-*
-*
-#ifndef CERNLIB_KERNNUM_BASIC_INC
-#define CERNLIB_KERNNUM_BASIC_INC
-*
-*
-* basic.inc
-*
- ICTL 2,79
-#include "kernnum/setype.inc"
-#include "kernnum/link.inc"
-#include "kernnum/stack.inc"
-#include "kernnum/loop1.inc"
-#include "kernnum/loop2.inc"
-#include "kernnum/register.inc"
-
-#endif
diff --git a/src/packlib/kernlib/kernnum/obsolete/kernib/cpy.inc b/src/packlib/kernlib/kernnum/obsolete/kernib/cpy.inc
deleted file mode 100644
index b22c5f9..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/kernib/cpy.inc
+++ /dev/null
@@ -1,123 +0,0 @@
-*
-* $Id: cpy.inc,v 1.1.1.1 1996/02/15 17:48:32 mclareni Exp $
-*
-* $Log: cpy.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:32 mclareni
-* Kernlib
-*
-*
-#ifndef CERNLIB_KERNNUM_CPY_INC
-#define CERNLIB_KERNNUM_CPY_INC
-*
-*
-* cpy.inc
-*
- MACRO
- &LABEL CPY &X,&Z,&JX=0,&JZ=0
-#include "kernnum/global.inc"
- &LABEL DS 0H
- AIF ('&T' EQ 'R').RCPY
- AIF ('&T' EQ 'D').DCPY
- AIF ('&T' EQ 'C').CCPY
- MEXIT
- .CCPY AIF (&CC NE 0).CCPYC
- LD 0,0(&X,&JX)
- STD 0,0(&Z,&JZ)
- MEXIT
- .CCPYC L&W 0,0(&X,&JX)
- ST&W 0,0(&Z,&JZ)
- L&W 0,&D.(&X,&JX)
- LC&W.R 0,0 INVERT SIGN OF IMAGINARY PART
- ST&W 0,&D.(&Z,&JZ)
- MEXIT
- .RCPY ANOP
- .DCPY ANOP
- L&W 0,0(&X,&JX)
- ST&W 0,0(&Z,&JZ)
- MEND
- MACRO
- &LABEL TVCPY &N,&X,&JX,&Z,&JZ
-#include "kernnum/global.inc"
- PUSH &X STACK (X(1))
- PUSH &Z STACK (Z(1))
- L&SYSNDX LOOPONE &N FOR J = 1, N
- CPY &X,&Z
- AR &X,&JX &X = (X(J+1))
- AR &Z,&JZ &Z = (Z(J+1))
- LEND &N,L&SYSNDX
- POP &Z RESTORE &Z = (Z(1))
- POP &X &X = (X(1))
- MEND
- MACRO
- &LABEL VCPY &N,&X,&JX,&Z,&JZ,&JX2,&JZ2,&J
- &LABEL FIRST &J,&N,LOOP=L&SYSNDX
- CPY &X,&Z
- AR &X,&JX (X) = (X) + JX
- AR &Z,&JZ (Z) = (Z) + JZ
- L&SYSNDX FORTWO &J,&N,EXIT=X&SYSNDX
- CPY &X,&Z
- CPY &X,&Z,JX=&JX,JZ=&JZ
- AR &X,&JX2 (X) = (X) + 2*JX
- AR &Z,&JZ2 (Z) = (Z) + 2*JZ
- X&SYSNDX ENDFOR &J,&N,LOOP=L&SYSNDX
- MEND
- MACRO
- &LABEL TVCPY2 &N,&X,&JX,&Z,&JZ,&JX2,&JZ2,&J
-#include "kernnum/global.inc"
- LCLA &OLD,&X1,&Z1
- &LABEL DS 0H
- &OLD SETA &STACK
- &X1 SETA &OLD
- &Z1 SETA &X1+1*4
- &STACK SETA &Z1+1*4
- AIF (&STACK LE &STKLIM).ALPHA
- MNOTE 12,'INSUFFICIENT WORK SPACE'
- MEXIT
- .ALPHA ANOP
- ST &X,&X1.(15) X1 = (X)
- ST &Z,&Z1.(15) Z1 = (Z)
- VCPY &N,&X,&JX,&Z,&JZ,&JX2,&JZ2,&J
- L &X,&X1.(15) &X = (X)
- L &Z,&Z1.(15) &Z = (Z)
- &STACK SETA &OLD
- MEND
- MACRO
- &LABEL TMCPY &M,&N,&X,&IX,&JX,&Z,&IZ,&JZ
-#include "kernnum/global.inc"
- &LABEL DS 0H
- A&SYSNDX PUSH &M
- PUSH &X
- PUSH &Z
- LA 0,1
- NR 0,&M R0 = MOD(M,2)
- BZ C&SYSNDX IF M IS EVEN
- TVCPY &N,&X,&JX,&Z,&JZ
- S &M,=F'1' M = M-1
- BZ F&SYSNDX IF M = 1
- AR &X,&IX &X = (X(2,1))
- AR &Z,&IZ &Z = (Z(2,1))
- C&SYSNDX LA 0,1 R0 = NSTEP = 1
- LR 1,&N R1 = N
- D&SYSNDX PUSH &X &X = (X(I,1))
- PUSH &Z &Z = (Z(I,1))
- LA &N,1 &N = J = 1
- E&SYSNDX CPY &X,&Z
- CPY &X,&Z,JX=&IX,JZ=&IZ
- AR &X,&JX &X = (X(I,J+1))
- AR &Z,&JZ &Z = (Z(I,J+1))
- BXLE &N,0,E&SYSNDX
- POP &Z &Z = (Z(I,1))
- POP &X &X = (X(I,1))
- AR &Z,&IZ
- AR &X,&IX
- AR &Z,&IZ &Z = (Z(I+2,1))
- AR &X,&IX &X = (X(I+2,1))
- S &M,=F'2' M = M-2
- BNZ D&SYSNDX
- F&SYSNDX LR &N,1 &N = N
- POP &Z &Z = (Z(1,1))
- POP &X &X = (X(1,1))
- POP &M &M = M
- MEND
-
-#endif
diff --git a/src/packlib/kernlib/kernnum/obsolete/kernib/det.inc b/src/packlib/kernlib/kernnum/obsolete/kernib/det.inc
deleted file mode 100644
index 1572fc9..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/kernib/det.inc
+++ /dev/null
@@ -1,143 +0,0 @@
-*
-* $Id: det.inc,v 1.1.1.1 1996/02/15 17:48:32 mclareni Exp $
-*
-* $Log: det.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:32 mclareni
-* Kernlib
-*
-*
-#ifndef CERNLIB_KERNNUM_DET_INC
-#define CERNLIB_KERNNUM_DET_INC
-*
-*
-* det.inc
-*
- MACRO
- &LABEL DET1 &X,&I,&J
-#include "kernnum/global.inc"
- &LABEL DS 0H
- AIF ('&T' EQ 'R').REAL
- AIF ('&T' EQ 'D').REAL
- AIF ('&T' EQ 'C').COMPLEX
- MEXIT
- .REAL LA 0,0 R0 = 0
- L 1,0(&X) R1 = UPPER X
- SLDL 0,1 R0 = SIGN(X)
- SLL 0,7 R0 = SIGN(X) & ZERO CHAR
- A 0,=F'64'
- STC 0,0(&X) STORE SCALED EXPONENT OF X
- SRL 1,1+24 R1 = CHAR(X)
- S 1,=F'64' R1 = EXP(X)
- AR &I,1 &I = &I+EXP(X)
- MEXIT
- .COMPLEX L 1,0(&X) R1 = UPPER X'
- SLL 1,1
- SRL 1,1+24 R1 = CHAR(X')
- LR &J,1 &J = CHAR(X')
- L 1,&D.(&X) R1 = UPPER X''
- SLL 1,1
- SRL 1,1+24 R1 = CHAR(X'')
- CR &J,1
- BC GE,A&SYSNDX IF &J = MAX CHAR
- LR &J,1
- A&SYSNDX DS 0H &J = MAX CHAR
- S &J,=F'64' &J = MAX EXP
- AR &I,&J &I = &I + MAX EXP
- LA 0,0 R0 = 0
- L 1,0(&X) R1 = UPPER X'
- SLDL 0,1
- SLL 0,7 R0 = SIGN(X') * 2**7
- SRL 1,1+24 R1 = CHAR(X')
- SR 1,&J R1 = SCALED CHAR(X')
- BC LT,C&SYSNDX IF EXPONENT UNDERFLOW
- OR 1,0 R1 = SIGN & SCALED CHAR
- STC 1,0(&X) STORE EXPONENT BYTE
- B&SYSNDX LA 0,0 R0 = 0
- L 1,&D.(&X) R1 = UPPER X''
- SLDL 0,1
- SLL 0,7 R0 = SIGN(X'') * 2**7
- SRL 1,1+24 R1 = CHAR(X'')
- SR 1,&J R1 = SCALED CHAR(X'')
- BC LT,D&SYSNDX IF EXPONENT UNDERFLOW
- OR 1,0 R1 = SIGN & SCALED CHAR
- STC 1,&D.(&X) STORE EXPONENT BYTE
- B E&SYSNDX
- C&SYSNDX SDR 0,0 F0 = 0.
- ST&W 0,0(&X) X' = 0.
- B B&SYSNDX
- D&SYSNDX SDR 0,0 F0 = 0.
- ST&W 0,&D.(&X) X'' = 0.
- E&SYSNDX DS 0H
- MEND
- MACRO
- &LABEL DET2 &X,&I,&J
-#include "kernnum/global.inc"
- &LABEL DS 0H
- AIF ('&T' EQ 'R').REAL
- AIF ('&T' EQ 'D').REAL
- AIF ('&T' EQ 'C').COMPLEX
- MEXIT
- .REAL IC 1,0(&X) R1 = SIGN & CHAR (REAL PART)
- SLDL 0,24+1 R0 = SIGN
- SRL 1,24+1 R1 = CHAR
- AR 1,&I R1 = CHAR + EXP(SCALE)
- BC LT,A&SYSNDX IF UNDERFLOW
- C 1,=F'127'
- BC GT,B&SYSNDX IF OVERFLOW
- SLL 1,24+1
- SRDL 0,24+1 R1 = SIGN & NEW CHAR
- STC 1,0(&X)
- LA &I,0 JFAIL = 0
- B C&SYSNDX
- A&SYSNDX CLEAR 0 F0 = 0.
- STORE 0,&X DET = 0.
- L &I,=F'-1' JFAIL = -1
- B C&SYSNDX
- B&SYSNDX L 1,=X'7F800000'
- ST 1,0(&X) DET = LARGE
- LA &I,1 JFAIL = +1
- C&SYSNDX DS 0H
- MEXIT
- .COMPLEX LA &J,0 &J = 0
- IC 1,&D.(&X) R1 = SIGN & CHAR (IMAG PART)
- SLDL 0,24+1 R0 = SIGN
- SRL 1,24+1 R1 = CHAR
- AR 1,&I R1 = CHAR + EXP(SCALE)
- BC LT,A&SYSNDX IF UNDERFLOW OF IMAG PART
- C 1,=F'127'
- BC GT,D&SYSNDX IF OVERFLOW OF IMAG PART
- SLL 1,24+1
- SRDL 0,24+1 R1 = SIGN & NEW CHAR
- STC 1,&D.(&X)
- B B&SYSNDX
- A&SYSNDX SDR 0,0 F0 = 0.
- ST&W 0,&D.(&X) AIMAG(DET) = 0.
- LA &J,1 &J = 1
- B&SYSNDX DS 0H
- IC 1,0(&X) R1 = SIGN & CHAR (REAL PART)
- SLDL 0,24+1 R0 = SIGN
- SRL 1,24+1 R1 = CHAR
- AR 1,&I R1 = CHAR + EXP(SCALE)
- BC LT,C&SYSNDX IF UNDERFLOW OF REAL PART
- C 1,=F'127'
- BC GT,D&SYSNDX IF OVERFLOW OF REAL PART
- SLL 1,24+1
- SRDL 0,24+1 R1 = SIGN & NEW CHAR
- STC 1,0(&X)
- LA &I,0 JFAIL = 0
- B E&SYSNDX
- C&SYSNDX SDR 0,0 F0 = 0.
- ST&W 0,0(&X) REAL(DET) = 0.
- LA &I,0 JFAIL = 0
- C &J,=F'0'
- BC EQ,E&SYSNDX
- L &I,=F'-1' JFAIL = -1
- B E&SYSNDX
- D&SYSNDX L 1,=X'7E800000'
- ST 1,0(&X) DET = LARGE
- ST 1,&D.(&X)
- LA &I,1 JFAIL = +1
- E&SYSNDX DS 0H
- MEND
-
-#endif
diff --git a/src/packlib/kernlib/kernnum/obsolete/kernib/div.inc b/src/packlib/kernlib/kernnum/obsolete/kernib/div.inc
deleted file mode 100644
index b113ed8..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/kernib/div.inc
+++ /dev/null
@@ -1,91 +0,0 @@
-*
-* $Id: div.inc,v 1.1.1.1 1996/02/15 17:48:32 mclareni Exp $
-*
-* $Log: div.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:32 mclareni
-* Kernlib
-*
-*
-#ifndef CERNLIB_KERNNUM_DIV_INC
-#define CERNLIB_KERNNUM_DIV_INC
-*
-*
-* div.inc
-*
- MACRO
- &LABEL DIV &X,&Y,&Z,&JX=0,&JY=0,&JZ=0,&EXIT=
-#include "kernnum/global.inc"
- &LABEL DS 0H
- AIF ('&T' EQ 'R').RDIV
- AIF ('&T' EQ 'D').DDIV
- AIF ('&T' EQ 'C').CDIV
- MNOTE 13,'NO TYPE DEFINED FOR MACRO DIV'
- MEXIT
- .RDIV LE 0,0(&X,&JX) F0 = X
- LE 2,0(&Y,&JY) F2 = Y
- CE 2,=F'0'
- BE &EXIT IF(Y .EQ. 0.)
- DER 0,2 F0 = X/Y
- STE 0,0(&Z,&JZ) Z = X/Y
- MEXIT
- .DDIV LD 0,0(&X,&JX) F0 = X
- LD 2,0(&Y,&JY) F2 = Y
- CD 2,=D'0'
- BE &EXIT IF(Y .EQ. 0.)
- DDR 0,2 F0 = X/Y
- STD 0,0(&Z,&JZ) Z = X/Y
- MEXIT
- .CDIV DS 0H
- LE 0,0(&Y,&JY) F0 = Y'
- LE 2,&D.(&Y,&JY) F2 = Y''
- LPER 4,0 F4 = ABS(Y')
- LPER 6,2 F6 = ABS(Y'')
- CER 4,6 IF(ABS(Y') .GT. ABS(Y''))
- BH A&SYSNDX
- CE 2,=F'0' IF(Y'' .EQ. 0)
- BE &EXIT
- LER 6,0 F6 = Y'
- DER 6,2 F6 = Y'/Y'' = R
- MER 0,6 F0 = Y'*R
- AER 2,0 F2 = Y'*R+Y''
- LE 0,0(&X,&JX) F0 = X'
- LE 4,&D.(&X,&JX) F4 = X''
- MER 0,6 F0 = X'*R
- MER 6,4 F6 = X''*R
- AER 0,4 F0 = X'*R+X''
- SE 6,0(&X,&JX) F6 = X''*R-X'
- DER 0,2 F0 = (X'*R+X'') / (Y'*R+Y'')
- DER 6,2 F6 = (X''*R-X') / (Y'*R+Y'')
- STE 0,0(&Z,&JZ) Z' = (X'*R+X'') / (Y'*R+Y'')
- STE 6,&D.(&Z,&JZ) Z''= (X''*R-X') / (Y'*R+Y'')
- B B&SYSNDX
- A&SYSNDX LER 6,2 F6 = Y''
- DER 6,0 F6 = Y''/Y' = S
- MER 2,6 F2 = Y''*S
- AER 0,2 F0 = Y''*S+Y'
- LE 2,0(&X,&JX) F2 = X'
- LE 4,&D.(&X,&JX) F4 = X''
- MER 2,6 F2 = X'*S
- MER 6,4 F6 = X''*S
- SER 4,2 F4 = X''-X'*S
- AE 6,0(&X,&JX) F6 = X''*S+X'
- DER 4,0 F4 = (X''-X'*S) / (Y''*S+Y')
- DER 6,0 F6 = (X''*S+X') / (Y''*S+Y')
- STE 4,&D.(&Z,&JZ) Z''= (X''-X'*S) / (Y''*S+Y')
- STE 6,0(&Z,&JZ) Z' = (X''*S+X') / (Y''*S+Y')
- B&SYSNDX DS 0H
- MEND
- MACRO
- &LABEL VDIV &N,&X,&JX,&Y,&JY,&Z,&JZ,&J
- &LABEL DS 0H
- L&SYSNDX FORONE &J J = 1
- DIV &X,&Y,&Z,EXIT=X&SYSNDX
- AR &X,&JX (X) = (X) + JX
- AR &Y,&JY (Y) = (Y) + JY
- AR &Z,&JZ (Z) = (Z) + JZ
- ENDFOR &J,&N,LOOP=L&SYSNDX J = J+1
- LA &J,0 J = 0
- X&SYSNDX DS 0H
- MEND
-
-#endif
diff --git a/src/packlib/kernlib/kernnum/obsolete/kernib/fact.inc b/src/packlib/kernlib/kernnum/obsolete/kernib/fact.inc
deleted file mode 100644
index b11eefd..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/kernib/fact.inc
+++ /dev/null
@@ -1,214 +0,0 @@
-*
-* $Id: fact.inc,v 1.1.1.1 1996/02/15 17:48:32 mclareni Exp $
-*
-* $Log: fact.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:32 mclareni
-* Kernlib
-*
-*
-#ifndef CERNLIB_KERNNUM_FACT_INC
-#define CERNLIB_KERNNUM_FACT_INC
-*
-*
-* fact.inc
-*
- MACRO
- &LABEL TFACT &SIZE,&N,&A,&IA,&JA,&R,&X,&Y,&I,&J,&L
-#include "kernnum/global.inc"
- LCLA &OLD,&A1,&R1,&A1K1,&AK1,&M1
- &LABEL DS 0H
- &OLD SETA &STACK
- &A1 SETA &OLD
- &R1 SETA &A1+1*4
- &A1K1 SETA &R1+1*4
- &AK1 SETA &A1K1+1*4
- &M1 SETA &AK1+1*4
- &STACK SETA &M1+1*4
- AIF (&STACK LE &STKLIM).ALPHA
- MNOTE 12,'TFACT HAS INSUFFICIENT WORK SPACE'
- MEXIT
- .ALPHA ANOP
- ST &A,&A1.(15) &A1 = (A(1,1))
- ST &R,&R1.(15) &R1 = (R(1))
- ST &A,&AK1.(15) &AK1 = (A(K,1))
- LR &J,&A
- AR &J,&JA &J = (A(1,K+1))
- ST &J,&A1K1.(15) &A1K1 = (A(1,K+1))
- * DET = ONE
- * JFAIL = 0
- * IFAIL = 0
- LA &J,ONE&SYSNDX &J = (ONE)
- LOAD 0,&J F0 = ONE
- LA &J,DET&SYSNDX &J = (DET)
- STORE 0,&J DET = ONE
- LA &J,0 &J = 0
- ST &J,JFL&SYSNDX JFAIL = 0
- ST &J,IFL&SYSNDX IFAIL = 0
- * M = 0
- LA &J,0 &J = 0
- ST &J,&M1.(15) &M1 = 0
- * DO 20 K = 1, N
- LA &I,0 &I = 0 = K-1
- A&SYSNDX DS 0H
- * &I = K-1
- * &A = (A(K,K))
- * &R = (R(K))
- * &A1K1 = (A(1,K+1))
- * &AK1 = (A(K,1))
- * CALL VMXA(N-K+1,A(K,K),A(K+1,K),L,P)
- LR &Y,&I &Y = K-1
- LR &I,&N &I = N
- SR &I,&Y &I = N-(K-1) = N-K+1
- LA &I-1,1 ISTEP = 1
- LA &X,4 &X = 4 = JR
- TVMXA1 &I,&A,&IA,&L,&J F4 = P
- * L = L + K - 1
- LR &I,&Y &I = K-1 AGAIN
- AR &L,&Y &L = L+(K-1)
- S &L,=F'1' &L = L-1
- * IF(P .LE. 0.) GOTO 90
- LDR 0,4 F0 = P
- CE 4,=E'0.'
- BC LE,E&SYSNDX IF(P .LE. 0.) GOTO 90
- * IF(L .EQ. K) GOTO 12
- CR &L,&Y
- BC EQ,C&SYSNDX IF(L-1 .EQ. K-1)
- * CALL VXCH(N,A(K,1),A(K,2),A(L,1),A(L,2))
- L &X,&AK1.(15) &X = (A(K,1))
- LR 1,&L R1 = L-1
- MR 0,&IA R1 = (L-1)*IA
- L &J,&A1.(15) &J = (A(1,1))
- AR &J,1 &J = (A(L,1))
- LR &I,&JA
- AR &I,&JA &I = 2*JA
- VXCH2 &N,&X,&JA,&J,&JA,&I,&I
- LR &I,&Y &I = K-1 AGAIN
- * M = M + 1
- * R(M) = K*2**12 + L
- L &J,&M1.(15) &J = OLD M = M-1
- LA 1,4 R1 = 4 = JR
- MR 0,&J R1 = JR*(M-1)
- A 1,&R1.(15) R1 = (R(M))
- A &J,=F'1' &J = OLD M + 1
- ST &J,&M1.(15) M = M+1
- LR &J,1 &J = (R(M))
- LR 0,&I R0 = K-1
- A 0,=F'1' R0 = K
- LR 1,&L R1 = L-1
- A 1,=F'1' R1 = L
- SLL 1,32-&SIZE
- SLDL 0,&SIZE R0 = K*2**12 + L
- ST 0,0(&J) R(M) = K*2**12 + L
- * 12 DET = DET * A(K,K)
- * A(K,K) = ONE / A(K,K)
- * SCALE DETERMINANT, ADD EXPONENT TO JFAIL
- C&SYSNDX DS 0H
- LOAD 0,&A F0 = A(K,K)
- LA &X,DET&SYSNDX &X = (DET)
- MUL &X F0 = A(K,K)*DET
- STORE 0,&X DET = A(K,K)*DET
- RCPRCL &A A(K,K) = 1 / A(K,K)
- L &L,JFL&SYSNDX &L = JFAIL
- DET1 &X,&L,&J INCREMENT JFAIL
- ST &L,JFL&SYSNDX
- * 14 IF(K .EQ. N) GOTO 21
- * IF(K .EQ. 1) GOTO 16
- LR &J,&I &J = K-1
- A &J,=F'1' &J = K
- CR &J,&N
- BC EQ,F&SYSNDX IF(K .EQ. N)
- C &I,=F'0'
- BC EQ,D&SYSNDX IF(K-1 .EQ. 0)
- * CALL MMNA(N-K,K-1,A(1,K+1),JA,IA,A(K,1),JA,A(K,K+1),JA)
- LR &L,&N &L = N
- SR &L,&I &L = N-(K-1) = N-K+1
- S &L,=F'1' &L = N-K
- L &X,&A1K1.(15) &X = (A(1,K+1))
- L &Y,&AK1.(15) &Y = (A(K,1))
- AR &A,&JA &A = (A(K,K+1))
- TXMPY MMNA,&L,&I,&X,&JA,&IA,&Y,&JA,&A,&JA
- SR &A,&JA &A = (A(K,K))
- * 16 CALL VSCL(N-K,A(K,K),A(K,K+1),JA,A(K,K+1),JA)
- * CALL MMNA(N-K,K,A(K+1,1),IA,JA,A(1,K+1),IA,A(K+1,K+1),IA)
- D&SYSNDX DS 0H
- LOAD 4,&A F4 = A(K,K)
- LR &L,&I &L = K-1
- A &L,=F'1' &L = K
- LR &I,&N
- SR &I,&L &I = N-K
- LA &I-1,2 ISTEP = 2
- LR &X,&A &X = (A(K,K))
- AR &X,&JA &X = (A(K,K+1))
- LR &Y,&X &Y = (A(K,K+1))
- TVSCL &I,&X,&JA,&Y,&JA
- SWAP &I,&L &I = K
- * &L = N-K
- L &X,&AK1.(15) &X = (A(K,1))
- AR &X,&IA &X = (A(K+1,1))
- ST &X,&AK1.(15) &AK1 = (A(K+1,1))
- L &Y,&A1K1.(15) &Y = (A(1,K+1))
- AR &A,&IA
- AR &A,&JA &A = (A(K+1,K+1))
- TXMPY MMNA,&L,&I,&X,&IA,&JA,&Y,&IA,&A,&IA
- AR &Y,&JA &Y = (A(1,K+2))
- ST &Y,&A1K1.(15) &A1K1 = (A(1,K+2))
- A &R,=F'4' &R = (R(K+1))
- B A&SYSNDX REPEAT MAIN LOOP
- IFL&SYSNDX DS 1F IFAIL
- JFL&SYSNDX DS 1F JFAIL
- AIF ('&T' EQ 'R').RCON
- AIF ('&T' EQ 'D').DCON
- AIF ('&T' EQ 'C').CCON
- MEXIT
- .RCON DS 0F
- ZERO&SYSNDX DC E'0.' ZERO
- ONE&SYSNDX DC E'1.' ONE
- DET&SYSNDX DS 1F DET
- AGO .ZCON
- .DCON DS 0D
- ZERO&SYSNDX DC D'0.' ZERO
- ONE&SYSNDX DC D'1.' ONE
- DET&SYSNDX DS 1D DET
- AGO .ZCON
- .CCON DS 0F
- ZERO&SYSNDX DC E'0.',E'0.' ZERO
- ONE&SYSNDX DC E'1.',E'0.' ONE
- DET&SYSNDX DS 2F DET
- .ZCON ANOP
- * 21 R(N) = M
- * 90 DET = 0.
- * IFAIL = -1
- * JFAIL = 0
- E&SYSNDX DS 0H
- CLEAR 0 F0 = 0.
- L &I,=F'-1' &I = -1
- LA &J,0 &J = 0
- B Z&SYSNDX EXIT
- * 21 R(N) = M
- * IF(MOD(M,2) .EQ. 1) DET = -DET
- * DE-SCALE DET
- * RETURN
- F&SYSNDX L &A,&A1.(15) &A = (A)
- L &R,&R1.(15) &R = (R)
- LR 1,&N
- S 1,=F'1' R1 = N-1
- LA 0,4 R0 = 4 = JR
- MR 0,0 R1 = (N-1)*JR
- L &J,&M1.(15) &J = M
- ST &J,0(&R,1) R(N) = M
- LA &L,DET&SYSNDX &L = (DET)
- LOAD 0,&L F0 = DET
- SLL &J,31 CLEAR ALL BUT BIT 31
- C &J,=F'0'
- BC EQ,G&SYSNDX
- MINUS 0 IF(MOD(M,2) .NE. 0) DET = -DET
- G&SYSNDX STORE 0,&L
- L &J,JFL&SYSNDX &J = JFAIL
- DET2 &L,&J,&I SCALE DET, SET JFAIL
- L &I,IFL&SYSNDX &I = IFAIL
- LOAD 0,&L F0 = DET
- Z&SYSNDX DS 0H
- &STACK SETA &OLD
- MEND
-
-#endif
diff --git a/src/packlib/kernlib/kernnum/obsolete/kernib/feqn.inc b/src/packlib/kernlib/kernnum/obsolete/kernib/feqn.inc
deleted file mode 100644
index d780262..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/kernib/feqn.inc
+++ /dev/null
@@ -1,148 +0,0 @@
-*
-* $Id: feqn.inc,v 1.1.1.1 1996/02/15 17:48:32 mclareni Exp $
-*
-* $Log: feqn.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:32 mclareni
-* Kernlib
-*
-*
-#ifndef CERNLIB_KERNNUM_FEQN_INC
-#define CERNLIB_KERNNUM_FEQN_INC
-*
-*
-* feqn.inc
-*
- MACRO
- &LABEL TFEQN1 &N,&A,&IA,&JA,&K,&B,&IA2,&JA2,&Z,&I
-#include "kernnum/global.inc"
- LCLA &OLD,&A1,&B1,&Z1,&K1
- &LABEL DS 0H
- &OLD SETA &STACK
- &A1 SETA &OLD
- &B1 SETA &A1+1*4
- &K1 SETA &B1+1*4
- &STACK SETA &K1+1*4
- AIF (&STACK LE &STKLIM).ALPHA
- MNOTE 12,'TFEQN1 HAS INSUFFICIENT WORK SPACE'
- MEXIT
- .ALPHA ANOP
- * DO 3 L = 1, K
- * B(1,L) = A(1,1) * B(1,L)
- * IF(N .EQ. 1) GOTO 3
- * DO 1 I = 1, N-1
- * B(I+1,L) = -VMPY(I,A(I+1,1),"JA",B(1,L),"IA",
- * -B(I+1,L)) * A(I+1,I+1)
- * 1 CONTINUE
- * IA = -IA
- * JA = -JA
- * DO 2 I = 1, N-1
- * B(N-I,L) = -VMPY(I,A(N-I,N),"JA",B(N,L)"IA",-B(N-I,L))
- * 2 CONTINUE
- * IA = -IA
- * JA = -JA
- * 3 CONTINUE
- ST &K,&K1.(15) SAVE K
- LR &IA2,&IA
- LR &JA2,&JA
- AR &IA2,&IA &IA2 = 2*IA
- AR &JA2,&JA &JA2 = 2*JA
- A&SYSNDX DS 0H
- * &A = (A(1,1))
- * &B = (B(1,L))
- LOAD 0,&A F0 = A(1,1)
- MUL &B F0 = A(1,1)*B(1,L)
- STORE 0,&B B(1,L) = A(1,1)*B(1,L)
- LA &I,1 &I = 1
- CR &N,&I
- BC EQ,D&SYSNDX IF N = 1
- LR &Z,&B &Z = (B(1,L))
- ST &B,&B1.(15) &B1= (B(1,L))
- * &A = (A(I,1))
- * &B = (B(1,L))
- * &Z = (B(I,L))
- B&SYSNDX DS 0H
- AR &A,&IA &A = (A(I+1,1))
- AR &Z,&IA &Z = (B(I+1,L))
- ST &A,&A1.(15) &A1= (A(I+1,1))
- LOAD 0,&Z
- MINUS 0 F0 = -(B(I+1,L)
- VMPY &I,&A,&JA,&B,&IA,&JA2,&IA2
- * &A = (A(I+1,I+1))
- * &B = (B(I+1,L))
- MINUS 0
- MUL &A
- STORE 0,&B B(I+1,L)=-VMPY(...)*A(I+1,I+1)
- LR 1,&A SAVE (A(I+1,I+1)) IN R1
- L &A,&A1.(15) &A = (A(I+1,1))
- L &B,&B1.(15) &B = (B(1,L))
- A &I,=F'1' &I = I+1
- CR &I,&N
- BC LT,B&SYSNDX IF &I .LT. N
- * R1 = (A(N,N))
- * &Z = (B(N,L))
- LCR &IA,&IA IA = -IA
- LCR &IA2,&IA2
- LCR &JA,&JA JA = -JA
- LCR &JA2,&JA2
- LR &A,1 &A = (A(N,N))
- LR &B,&Z &B = (B(N,L))
- LA &I,1 &I = 1
- ST &B,&B1.(15) &B1= (B(N,L))
- C&SYSNDX DS 0H
- * &A = (A(N-I+1,N))
- * &B = (B(N,L))
- * &Z = (B(N-I+1,L))
- AR &A,&IA &A = (A(N-I,N))
- ST &A,&A1.(15) &A1= (A(N-I,N))
- AR &Z,&IA &Z = (B(N-I,L))
- LOAD 0,&Z
- MINUS 0 F0 = -B(N-I,L)
- VMPY &I,&A,&JA,&B,&IA,&JA2,&IA2
- * &A = (A(N-I,N-I))
- * &B = (B(N-I,L))
- MINUS 0
- STORE 0,&B B(N-I,L) = -VMPA(...)
- LR 0,&A SAVE (A(N-I,N-I)) IN R0
- L &A,&A1.(15) &A = (A(N-I,N))
- L &B,&B1.(15) &B = (B(N,L))
- A &I,=F'1' &I = I+1
- CR &I,&N
- BC LT,C&SYSNDX IF(I .LT. N)
- * R0 = (A(1,1))
- * &Z = (B(1,L))
- LCR &IA,&IA IA = -IA
- LCR &IA2,&IA2
- LCR &JA,&JA JA = -JA
- LCR &JA2,&JA2
- LR &A,0 &A = (A(1,1))
- LR &B,&Z &B = (B(1,L))
- D&SYSNDX DS 0H
- AR &B,&JA &B = (B(1,L+1))
- S &K,=F'1'
- BC NE,A&SYSNDX IF(L .LT. K)
- &STACK SETA &OLD
- L &K,&K1.(15) RESTORE &K = K
- MEND
- MACRO
- &LABEL TFEQN &SIZE,&N,&A,&IA,&JA,&R,&K,&B,&IA2,&JA2,&Z,&I,&J
-#include "kernnum/global.inc"
- &LABEL PUSH &A
- LR &JA2,&JA
- AR &JA2,&JA &JA2 = 2 * JA
- LR &I,&K &I = K
- LR 1,&N
- S 1,=F'1' R1 = N-1
- LA &A,4 &A = 4 = JR
- MR 0,&A R1 = (N-1) * JR
- L &K,0(&R,1) &K = R(N) = L
- C &K,=F'0'
- BC LE,A&SYSNDX IF(L .LE. 0)
- PUSH &R SAVE (R(1))
- MSUBST &SIZE,&I,&B,&IA,&JA,&K,&R,&A,&JA2,&Z,&IA2
- POP &R &R = (R(1))
- A&SYSNDX POP &A &A = (A(1,1))
- LR &K,&I &K = K
- TFEQN1 &N,&A,&IA,&JA,&K,&B,&IA2,&JA2,&Z,&I
- MEND
-
-#endif
diff --git a/src/packlib/kernlib/kernnum/obsolete/kernib/finv.inc b/src/packlib/kernlib/kernnum/obsolete/kernib/finv.inc
deleted file mode 100644
index 03429b9..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/kernib/finv.inc
+++ /dev/null
@@ -1,121 +0,0 @@
-*
-* $Id: finv.inc,v 1.1.1.1 1996/02/15 17:48:32 mclareni Exp $
-*
-* $Log: finv.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:32 mclareni
-* Kernlib
-*
-*
-#ifndef CERNLIB_KERNNUM_FINV_INC
-#define CERNLIB_KERNNUM_FINV_INC
-*
-*
-* finv.inc
-*
- MACRO
- &LABEL TFINV1 &N,&A,&IA,&JA,&X,&Y,&Z,&I,&K
- &LABEL DS 0H
- LR &X,&A &X = (A(1,1))
- LR &Y,&A &Y = (A(I-1,1))
- LR &Z,&A &Z = (A(I-1,1))
- LR &K,&A &K = (A(I-1,I-1))
- LA &I,1 &I = 1 = I-1
- A&SYSNDX DS 0H
- AR &Y,&IA &Y = (A(I,1))
- AR &Z,&IA &Z = (A(I,1))
- AR &K,&IA
- AR &K,&JA &K = (A(I,I))
- TXMPY UMPY,&I,&I,&X,&JA,&IA,&Y,&JA,&Z,&JA
- LOAD 4,&K F4 = A(I,I)
- MINUS 4 F4 = -A(I,I)
- TVSCL &I,&Y,&JA,&Z,&JA
- A &I,=F'1' &I = I+1
- CR &I,&N
- BC LT,A&SYSNDX IF &I .LT. N REPEAT
- LR &X,&A &X = (A(1,1))
- AR &X,&JA &X = (A(1,2))
- LOAD 0,&X F0 = A(1,2)
- MINUS 0 F0 = -A(1,2)
- STORE 0,&X A(1,2) = -A(1,2)
- C &N,=F'2'
- BC EQ,C&SYSNDX IF N .EQ. 2
- LR &Y,&X
- AR &Y,&IA &Y = (A(2,I-1))
- LR &Z,&X &Z = (A(1,I-1))
- LR &K,&Z &K = (A(I-2,I-1))
- S &N,=F'2' &N = N-2
- LA &I,1 &I = 1 = I-2
- B&SYSNDX DS 0H
- AR &Y,&JA &Y = (A(2,I))
- AR &Z,&JA &Z = (A(1,I))
- AR &K,&IA
- AR &K,&JA &K = (A(I-1,I))
- TXMPY UMNS,&I,&I,&X,&IA,&JA,&Y,&IA,&Z,&IA
- LOAD 0,&K F0 = A(I-1,I)
- MINUS 0 F0 = -A(I-1,I)
- STORE 0,&K A(I-1,I) = -A(I-1,I)
- A &I,=F'1' &I = I+1
- CR &I,&N
- BC LE,B&SYSNDX IF(I .LE. N-2) REPEAT
- A &N,=F'2' &N = N
- C&SYSNDX DS 0H
- LR &X,&A
- AR &X,&IA &X = (A(I+1,1))
- LR &Y,&A
- AR &Y,&JA &Y = (A(I,I+1))
- LR &Z,&A &Z = (A(I,1))
- LR &I,&N
- S &I,=F'1' &I = N-I
- D&SYSNDX DS 0H
- LR &K,&N &K = N
- SR &K,&I &K = N-(N-I) = I
- TXMPY MMPA,&K,&I,&X,&JA,&IA,&Y,&JA,&Z,&JA
- LR &K,&X SAVE (A(I+1,1)) IN &K
- LR &Z,&Y &Z = (A(I,I+1))
- LR &X,&Y
- AR &X,&IA &X = (A(I+1,I+1))
- TXMPY UMPY,&I,&I,&X,&JA,&IA,&Y,&JA,&Z,&JA
- LR &X,&K
- AR &X,&IA &X = (A(I+2,1))
- AR &Y,&IA
- AR &Y,&JA &Y = (A(I+1,I+2))
- LR &Z,&K &Z = (A(I+1,1))
- S &I,=F'1' &I = &I-1
- BC GT,D&SYSNDX IF(N-I .GT. 0) REPEAT
- MEND
- MACRO
- &LABEL TFINV &SIZE,&N,&A,&IA,&JA,&R,&IA2,&JA2,&X,&Y,&Z,&I
-#include "kernnum/global.inc"
- LCLA &OLD,&R1
- &LABEL DS 0H
- &OLD SETA &STACK
- &R1 SETA &OLD
- &STACK SETA &R1+1*4
- AIF (&STACK LE &STKLIM).ALPHA
- MNOTE 12,'TFINV HAS INSUFFICIENT WORK SPACE'
- MEXIT
- .ALPHA ANOP
- C &N,=F'1'
- BC LE,A&SYSNDX IF(N .LE. 1) ALL DONE
- ST &R,&R1.(15) &R1 = (R)
- TFINV1 &N,&A,&IA,&JA,&X,&Y,&Z,&I,&R
- L &R,&R1.(15) &R = (R)
- LA 1,4 R1 = JR = 4
- MR 0,&N R1 = JR*N
- S 1,=F'4' R1 = JR*(N-1)
- L &Z,0(&R,1) &Z = R(N) = L
- C &Z,=F'0'
- BC LE,A&SYSNDX IF(L .LE. 0) NO COLUMN SUBST.
- L &JA2,=F'-4' &JA2 = -JR
- LA 1,4 R1 = JR
- MR 0,&Z R1 = JR*L
- S 1,=F'4' R1 = JR*(L-1)
- AR &R,1 &R = (R(L))
- LR &IA2,&IA
- AR &IA2,&IA &IA2 = 2*IA
- MSUBST &SIZE,&N,&A,&JA,&IA,&Z,&R,&JA2,&IA2,&X,&Y
- A&SYSNDX DS 0H
- &STACK SETA &OLD
- MEND
-
-#endif
diff --git a/src/packlib/kernlib/kernnum/obsolete/kernib/global.inc b/src/packlib/kernlib/kernnum/obsolete/kernib/global.inc
deleted file mode 100644
index 1b0c5af..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/kernib/global.inc
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: global.inc,v 1.1.1.1 1996/02/15 17:48:31 mclareni Exp $
-*
-* $Log: global.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:31 mclareni
-* Kernlib
-*
-*
-#ifndef CERNLIB_KERNNUM_GLOBAL_INC
-#define CERNLIB_KERNNUM_GLOBAL_INC
-*
-*
-* global.inc
-*
- GBLA &TYPE,&RTYPE,&DTYPE,&CTYPE,&CCTYPE,&CTYPEC,&CC
- GBLA &LENGTH,&LOGLEN,&D
- GBLA ®LIM,&TWORDS,&STKORG,&STACK,&STKLIM,&BASEREG
- GBLC &T,&W,&NAME
-
-#endif
diff --git a/src/packlib/kernlib/kernnum/obsolete/kernib/link.inc b/src/packlib/kernlib/kernnum/obsolete/kernib/link.inc
deleted file mode 100644
index 16b3aff..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/kernib/link.inc
+++ /dev/null
@@ -1,98 +0,0 @@
-*
-* $Id: link.inc,v 1.1.1.1 1996/02/15 17:48:31 mclareni Exp $
-*
-* $Log: link.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:31 mclareni
-* Kernlib
-*
-*
-#ifndef CERNLIB_KERNNUM_LINK_INC
-#define CERNLIB_KERNNUM_LINK_INC
-*
-*
-* link.inc
-*
- MACRO
- HEADER &ENTRY
-#include "kernnum/global.inc"
- &T&NAME START
- &T&NAME AMODE ANY
- &T&NAME RMODE ANY
- BASE EQU *
- USING BASE,&BASEREG
- EQ EQU 8
- NE EQU 7
- NZ EQU 6
- LT EQU 4
- LE EQU 12
- GT EQU 2
- GE EQU 10
- REG14 EQU 3*4
- REG0 EQU 5*4
- B &ENTRY
- DC XL1'6',C'&T&NAME'
- &STKORG SETA 12 FIRST FULL WORD AFTER TRACE WORD
- &STACK SETA 12
- &STKLIM SETA 12
- .ALPHA AIF (&TWORDS EQ 0).BETA
- DS 0F TO FORCE ALIGNMENT
- DS 1F WORK SPACE FOR ALL MACROS
- &STKLIM SETA &STKLIM+4 LIMIT ADDRESS OF WORK SPACE
- &TWORDS SETA &TWORDS-1
- AGO .ALPHA
- .BETA ANOP
- MEND
- MACRO
- &ENTRY PROLOG
-#include "kernnum/global.inc"
- AIF (®LIM LT 13).ALPHA
- MNOTE 12,'USE OF REGISTER 13 IS ILLEGAL'
- MEXIT
- .ALPHA ANOP
- &ENTRY STM 14,®LIM,REG14(13)
- MEND
- MACRO
- &EXIT EPILOG
-#include "kernnum/global.inc"
- &EXIT DS 0H TO FORCE ALIGNMENT
- AIF (®LIM LT 13).BETA
- MNOTE 12,'USE OF REGISTER 13 IS ILLEGAL'
- MEXIT
- .BETA ANOP
- MVI REG14(13),EXITAG
- LM 0,®LIM,REG0(13)
- BR 14
- .GAMMA ANOP
- EXITAG EQU 255
- AIF (&STACK EQ &STKORG).OMEGA
- MNOTE 12,'WORK SPACE ALLOCATION ERROR'
- .OMEGA ANOP
- END
- MEND
- MACRO
- &LABEL ENTER &SUB,&LIST
-#include "kernnum/global.inc"
- LCLA &OLD,&SAVE,&R1,&R12
- &OLD SETA &STACK
- &SAVE SETA &OLD 18-WORD SAVE AREA
- &R1 SETA &SAVE+18*4 SAVE OF R1
- &R12 SETA &R1+1*4 SAVE OF R12-14
- &STACK SETA &R12+3*4
- AIF (&STACK LE &STKLIM).ALPHA
- MNOTE 12,'ENTER MACRO LACKS WORK SPACE'
- MEXIT
- .ALPHA ANOP
- ST 1,&R1.(&BASEREG) SAVE R1
- STM 12,14,&R12.(&BASEREG) SAVE R12-14
- LR 12,&BASEREG SAVE BASEREG IN R12
- LA 1,&LIST R1=(ARGUMENT LIST)
- LA 13,&SAVE.(&BASEREG) R13=(18-WORD SAVE AREA)
- L 15,&SUB R15=(ENTRY POINT)
- BALR 14,15 ENTER SUBPROGRAM
- LR &BASEREG,12 RESTORE BASE REGISTER
- L 1,&R1.(&BASEREG) RESTORE OLD R1
- LM 12,14,&R12.(&BASEREG) RESTORE OLD R12-14
- &STACK SETA &OLD RELEASE SAVE AREA
- MEND
-
-#endif
diff --git a/src/packlib/kernlib/kernnum/obsolete/kernib/loop1.inc b/src/packlib/kernlib/kernnum/obsolete/kernib/loop1.inc
deleted file mode 100644
index e88af29..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/kernib/loop1.inc
+++ /dev/null
@@ -1,48 +0,0 @@
-*
-* $Id: loop1.inc,v 1.1.1.1 1996/02/15 17:48:31 mclareni Exp $
-*
-* $Log: loop1.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:31 mclareni
-* Kernlib
-*
-*
-#ifndef CERNLIB_KERNNUM_LOOP1_INC
-#define CERNLIB_KERNNUM_LOOP1_INC
-*
-*
-* loop1.inc
-*
- MACRO
- &LOOP FORONE &J
- * J = 1
- * 1 CONTINUE
- LA &J,1
- &LOOP DS 0H
- MEND
- MACRO
- &EXIT ENDFOR &J,&N,&LOOP=
- * J = J + NSTEP
- * IF(J .LE. N) GO TO 1
- * 2 CONTINUE
- BXLE &J,&N-1,&LOOP
- &EXIT DS 0H
- MEND
- MACRO
- &LABEL FIRST &J,&N,&LOOP=
- * J = 2
- * IF(MOD(N,2) .EQ. 0) GO TO 1
- &LABEL LA &J,2
- LA 0,1
- NR 0,&N
- BE &LOOP
- MEND
- MACRO
- &LOOP FORTWO &J,&N,&EXIT=
- * IF(J .GT. N) GO TO 2
- * 1 CONTINUE
- CR &J,&N
- BH &EXIT
- &LOOP DS 0H
- MEND
-
-#endif
diff --git a/src/packlib/kernlib/kernnum/obsolete/kernib/loop2.inc b/src/packlib/kernlib/kernnum/obsolete/kernib/loop2.inc
deleted file mode 100644
index 5164415..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/kernib/loop2.inc
+++ /dev/null
@@ -1,43 +0,0 @@
-*
-* $Id: loop2.inc,v 1.1.1.1 1996/02/15 17:48:31 mclareni Exp $
-*
-* $Log: loop2.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:31 mclareni
-* Kernlib
-*
-*
-#ifndef CERNLIB_KERNNUM_LOOP2_INC
-#define CERNLIB_KERNNUM_LOOP2_INC
-*
-*
-* loop2.inc
-*
- MACRO
- &LOOP LOOPONE &N
- LA 0,1 R0 = NSTEP = 1
- LR 1,&N R1 = N
- LA &N,1 &N = J = 1
- &LOOP DS 0H
- MEND
- MACRO
- &EXIT LEND &N,&LOOP
- BXLE &N,0,&LOOP J=J+1; IF(J .LE. N) GOTO LOOP
- &EXIT LR &N,1 &N = N
- MEND
- MACRO
- &LABEL ONCE &N,&LOOP
- &LABEL LA 0,1 R0 = 1
- LR 1,&N R1 = N
- LA &N,2 &N = J = 2
- NR 0,1 R0 = MOD(N,2)
- BZ &LOOP-4 IF(MOD(N,2) .EQ. 0) GOTO LOOP
- MEND
- MACRO
- &LOOP LOOPTWO &N,&EXIT
- CR &N,1
- BH &EXIT IF(J .GT. N) GOTO EXIT
- LA 0,2 R0 = NSTEP = 2
- &LOOP DS 0H
- MEND
-
-#endif
diff --git a/src/packlib/kernlib/kernnum/obsolete/kernib/max.inc b/src/packlib/kernlib/kernnum/obsolete/kernib/max.inc
deleted file mode 100644
index 9b25d40..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/kernib/max.inc
+++ /dev/null
@@ -1,59 +0,0 @@
-*
-* $Id: max.inc,v 1.1.1.1 1996/02/15 17:48:32 mclareni Exp $
-*
-* $Log: max.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:32 mclareni
-* Kernlib
-*
-*
-#ifndef CERNLIB_KERNNUM_MAX_INC
-#define CERNLIB_KERNNUM_MAX_INC
-*
-*
-* max.inc
-*
- MACRO
- &LABEL MAX &F,&X,&L,&J &F = GE (MAX) OR LE (MIN)
-#include "kernnum/global.inc"
- &LABEL DS 0H
- AIF ('&T' EQ 'R').ALPHA
- AIF ('&T' EQ 'D').ALPHA
- MNOTE 13,'NO TYPE DEFINED FOR MACRO MAX'
- MEXIT
- .ALPHA C&W 0,0(&X)
- BC &F,A&SYSNDX IF(F0 .GE/LE. X)
- AIF ('&T EQ 'D').BETA
- LD 0,=D'0'
- .BETA L&W 0,0(&X) F0 = X
- LR &L,&J &L = &J
- A&SYSNDX DS 0H
- MEND
- MACRO
- &LABEL VMAX &N,&X,&JX,&L,&J
- &LABEL DS 0H
- LD 0,=D'0' F0 = 0.
- LA &L,1 &L = 1
- L&SYSNDX FORONE &J
- MAX &X,&L,&J
- AR &X,&JX (X) = (X) + JX
- ENDFOR &J,&N,LOOP=L&SYSNDX
- MEND
- MACRO
- &LABEL TVMAX1 &N,&X,&JX,&L,&J
-#include "kernnum/global.inc"
- LCLA &OLD,&X1
- &LABEL DS 0H
- &OLD SETA &STACK
- &X1 SETA &OLD
- &STACK SETA &X1+1*4
- AIF (&STACK LE &STKLIM).ALPHA
- MNOTE 14,'NO SPACE FOR MACRO TVMAX1'
- MEXIT
- .ALPHA ANOP
- ST &X,&X1 X1 = (X)
- VMAX &N,&X,&JX,&L,&J
- L &X,&X1 &X = (X)
- &STACK SETA &OLD
- MEND
-
-#endif
diff --git a/src/packlib/kernlib/kernnum/obsolete/kernib/mlt.inc b/src/packlib/kernlib/kernnum/obsolete/kernib/mlt.inc
deleted file mode 100644
index 981bdd6..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/kernib/mlt.inc
+++ /dev/null
@@ -1,171 +0,0 @@
-*
-* $Id: mlt.inc,v 1.1.1.1 1996/02/15 17:48:32 mclareni Exp $
-*
-* $Log: mlt.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:32 mclareni
-* Kernlib
-*
-*
-#ifndef CERNLIB_KERNNUM_MLT_INC
-#define CERNLIB_KERNNUM_MLT_INC
-*
-*
-* mlt.inc
-*
- MACRO
- &LABEL TMMLT &M,&N,&X,&IX,&JX,&Y,&JY,&LY,&Z,&IZ,&LZ R0=(T),R1=K
-#include "kernnum/global.inc"
- &LABEL CR &Z,&X
- BE C&SYSNDX IF (Z) = (X)
- CR &Z,&Y
- BE D&SYSNDX IF (Z) = (Y)
- CR &JX,&JY
- BE B&SYSNDX IF JX = JY GOTO B
- A&SYSNDX ZISXY &M,&N,&X,&IX,&JX,&Y,&JY,&LY,&Z,&IZ,&LZ R1=K
- B Z&SYSNDX
- * IF (Y) .NE. (X) GOTO A
- * IF LY .NE. IX GOTO A
- * IF K .NE. M GOTO A
- B&SYSNDX CR &Y,&X
- BNE A&SYSNDX IF (Y) .NE. (X) GOTO A
- CR &LY,&IX
- BNE A&SYSNDX IF LY .NE. IX GOTO A
- CR 1,&M
- BNE A&SYSNDX IF K .NE. M GOTO A
- ZISXXT &M,&N,&X,&IX,&JX,&Z,&IZ,&LZ,&Y
- B Z&SYSNDX
- C&SYSNDX LR &Z,0 &Z = (T)
- CR &X,&Y
- BE E&SYSNDX IF (X) = (Y) GOTO E
- LR &IZ,1 &IZ = K
- LA &LZ,&LENGTH &LZ = STEP SIZE OF ARRAY T
- XISXY &M,&N,&IZ,&X,&IX,&JX,&Y,&JY,&LY,&Z,&LZ
- B Z&SYSNDX
- D&SYSNDX LR &Z,0 &Z = (T)
- LR &IZ,1 &IZ = K
- LA &LZ,&LENGTH &LZ = STEP SIZE OF ARRAY T
- YISXY &M,&N,&IZ,&X,&IX,&JX,&Y,&JY,&LY,&Z,&LZ
- B Z&SYSNDX
- E&SYSNDX LA &LZ,&LENGTH &LZ = STEP SIZE FOR ARRAY T
- CR &IZ,&JX
- BE F&SYSNDX IF Z=X' GOTO F
- XISXXT &M,&N,&X,&IX,&JX,&Z,&LZ,&JY,&LY
- B Z&SYSNDX
- F&SYSNDX XTISXXT &M,&N,&X,&IX,&JX,&Z,&LZ,&JY,&LY
- Z&SYSNDX DS 0H
- MEND
- MACRO
- &LABEL ZISXY &M,&N,&X,&IX,&JX,&Y,&JY,&LY,&Z,&IZ,&LZ R1=K
-#include "kernnum/global.inc"
- &LABEL PUSH 1 STACK K
- PUSH &Y STACK (Y(1,1))
- PUSH &Z STACK (Z(1,1))
- A&SYSNDX PUSH 1 SAVE K-I+1
- TXMPY MMPY,&M,&N,&X,&IX,&JX,&Y,&JY,&Z,&IZ
- AR &Y,&LY &Y = (Y(1,I+1))
- AR &Z,&LZ &Z = (Z(1,I+1))
- POP 1 R1 = K-I+1
- S 1,=F'1' R1 = K-I
- BNZ A&SYSNDX
- POP &Z &Z = (Z(1,1))
- POP &Y &Y = (Y(1,1))
- POP 1 R1 = K
- MEND
- MACRO
- &LABEL ZISXXT &M,&N,&X,&IX,&JX,&Z,&IZ,&LZ,&Y (&Y IS TEMP)
-#include "kernnum/global.inc"
- &LABEL PUSH &X STACK (X(1,1))
- PUSH &M STACK M
- PUSH &Z STACK (Z(1,1))
- A&SYSNDX LR &Y,&X &Y = (X(I,1))
- TXMPY MMPY,&M,&N,&X,&IX,&JX,&Y,&JX,&Z,&IZ
- AR &Z,&IZ &Z = (Z(I+1,I))
- AR &X,&IX &X = (X(I+1,1))
- AR &Z,&LZ &Z = (Z(I+1,I+1))
- S &M,=F'1' M = M-I
- BNZ A&SYSNDX
- POP &Z &Z = (Z(1,1))
- POP &M &M = M
- TMUTL &M,&Z,&LZ,&IZ,&X (&X IS TEMP)
- POP &X &X = (X(1,1))
- MEND
- MACRO
- &LABEL XISXY &M,&N,&K,&X,&IX,&JX,&Y,&JY,&LY,&TT,&JT
-#include "kernnum/global.inc"
- LCLA &OLDCC SAVE OF CURRENT &CC
- &LABEL PUSH &M STACK M
- PUSH &X STACK (X(1,1))
- &OLDCC SETA &CC
- AIF (&CC EQ 0).ALPHA
- &CC SETA 3-&CC 1 FOR 2 AND VICE VERSA
- .ALPHA ANOP
- A&SYSNDX TXMPY MMPY,&K,&N,&Y,&LY,&JY,&X,&JX,&TT,&JT
- &CC SETA 0 COPY WITHOUT CONJUGATION
- TVCPY &K,&TT,&JT,&X,&JX
- &CC SETA &OLDCC RESTORE &CC
- AR &X,&IX &X = (X(I+1,1))
- S &M,=F'1' &M = M-I
- BNZ A&SYSNDX
- POP &X &X = (X(1,1))
- POP &M &M = M
- MEND
- MACRO
- &LABEL YISXY &M,&N,&K,&X,&IX,&JX,&Y,&JY,&LY,&TT,&JT
-#include "kernnum/global.inc"
- LCLA &OLDCC SAVE OF CURRENT &CC
- &LABEL PUSH &K STACK K
- PUSH &Y STACK (Y(1,1))
- A&SYSNDX TXMPY MMPY,&M,&N,&X,&IX,&JX,&Y,&JY,&TT,&JT
- &OLDCC SETA &CC
- &CC SETA 0 COPY WITHOUT CONJUGATION
- TVCPY &M,&TT,&JT,&Y,&JY
- &CC SETA &OLDCC RESTORE &CC
- AR &Y,&LY &Y = (Y(1,I+1))
- S &K,=F'1' &K = K-I
- BNZ A&SYSNDX
- POP &Y &Y = (Y(1,1))
- POP &K &K = K
- MEND
- MACRO
- &LABEL XISXXT &M,&N,&X,&IX,&JX,&TT,&JT,&Y,&Z (&Y, &Z ARE TEMP)
-#include "kernnum/global.inc"
- &LABEL PUSH &M STACK M
- PUSH &X STACK (X(1,1))
- LR &Z,&X &Z = (X(1,1))
- A&SYSNDX LR &Y,&X &Y = (X(I,1))
- TXMPY MMPY,&M,&N,&X,&IX,&JX,&Y,&JX,&TT,&JT
- * COPY WITH CONJUGATION
- TVCPY &M,&TT,&JT,&Z,&JX
- AR &Z,&IX &Z = (X(I+1,I))
- AR &X,&IX &X = (X(I+1,1))
- AR &Z,&JX &Z = (X(I+1,I+1))
- S &M,=F'1' &M = M-I
- BNZ A&SYSNDX
- POP &X &X = (X(1,1))
- POP &M &M = M
- TMUTL &M,&X,&IX,&JX,&Y
- MEND
- MACRO
- &LABEL XTISXXT &M,&N,&X,&IX,&JX,&TT,&JT,&Y,&Z (&Y, &Z ARE TEMP)
-#include "kernnum/global.inc"
- LCLA &OLDCC SAVE OF CURRENT &CC
- &LABEL PUSH &M STACK M
- PUSH &X STACK (X(1,1))
- LR &Z,&X &Z = (X(1,1))
- A&SYSNDX LR &Y,&X &Y = (X(I,1))
- TXMPY MMPY,&M,&N,&X,&IX,&JX,&Y,&JX,&TT,&JT
- &OLDCC SETA &CC
- &CC SETA 0 COPY WITHOUT CONJUGATION
- TVCPY &M,&TT,&JT,&Z,&JX
- &CC SETA &OLDCC RESTORE &CC
- AR &Z,&IX &Z = (X(I+1,I))
- AR &X,&IX &X = (X(I+1,1))
- AR &Z,&JX &Z = (X(I+1,I+1))
- S &M,=F'1' &M = M-I
- BNZ A&SYSNDX
- POP &X &X = (X(1,1))
- POP &M &M = M
- TMUTL &M,&X,&IX,&JX,&Y
- MEND
-
-#endif
diff --git a/src/packlib/kernlib/kernnum/obsolete/kernib/mpy.inc b/src/packlib/kernlib/kernnum/obsolete/kernib/mpy.inc
deleted file mode 100644
index 5383aae..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/kernib/mpy.inc
+++ /dev/null
@@ -1,372 +0,0 @@
-*
-* $Id: mpy.inc,v 1.1.1.1 1996/02/15 17:48:32 mclareni Exp $
-*
-* $Log: mpy.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:32 mclareni
-* Kernlib
-*
-*
-#ifndef CERNLIB_KERNNUM_MPY_INC
-#define CERNLIB_KERNNUM_MPY_INC
-*
-*
-* mpy.inc
-*
- MACRO
- &LABEL MPY &F,&X,&Y,&JX=0,&JY=0
-#include "kernnum/global.inc"
- * F6 = 0. FOR TYPES R AND C
- &LABEL DS 0H
- AIF ('&TYPE' EQ '&RTYPE').RMPY
- AIF ('&TYPE' EQ '&DTYPE').DMPY
- AIF ('&TYPE' EQ '&CTYPE').CMPY
- AIF ('&TYPE' EQ '&CTYPEC').CC
- AIF ('&TYPE' EQ '&CCTYPE').CC
- MNOTE 12,'ILLEGAL TYPE FOR MPY MACRO'
- MEXIT
- .RMPY ANOP
- LDR 4,2 F4=0.
- .DMPY L&W 4,0(&X,&JX) F4=X
- M&W 4,0(&Y,&JY) F4=XY
- &F.DR 0,4 F0=S+-XY
- MEXIT
- .CMPY LDR 4,6 F4=0.
- LE 6,0(&X,&JX) F6=X'
- LE 4,0(&X,&JX) F4=X'
- ME 6,&D.(&Y,&JY) F6=X'Y''
- ME 4,0(&Y,&JY) F4=X'Y'
- &F.DR 2,6 F2=F2+-X'Y''
- LD 6,=D'0' F6=0.
- &F.DR 0,4 F0=F0+-X'Y'
- LDR 4,6 F4=0.
- LE 6,&D.(&X,&JX) F6=X''
- LE 4,&D.(&X,&JX) F4=X''
- ME 6,0(&Y,&JY) F6=X''Y'
- ME 4,&D.(&Y,&JY) F4=X''Y''
- AIF ('&F' NE 'A').ALPHA
- ADR 2,6 F2=F2+X'Y''+X''Y'
- LD 6,=D'0' F6=0.
- SDR 0,4 F0=F0+X'Y'-X''Y''
- AGO .BETA
- .ALPHA SDR 2,6 F2=F2-X'Y''-X''Y'
- LD 6,=D'0' F6=0.
- ADR 0,4 F0=F0-X'Y'+X''Y''
- .BETA ANOP
- MEXIT
- .CC AIF (&CC EQ 0).CMPY
- AIF (&CC EQ 1).CMPY1
- AIF (&CC EQ 2).CMPY2
- MNOTE 12,'ILLEGAL CC FOR MPY MACRO'
- MEXIT
- .CMPY1 LDR 4,6 F4=0.
- LE 6,0(&X,&JX) F6=X'
- LE 4,0(&X,&JX) F4=X'
- ME 6,&D.(&Y,&JY) F6=X'Y''
- ME 4,0(&Y,&JY) F4=X'Y'
- &F.DR 2,6 F2=F2+-X'Y''
- LD 6,=D'0' F6=0.
- &F.DR 0,4 F0=F0+-X'Y'
- LDR 4,6 F4=0.
- LE 6,&D.(&X,&JX) F6=X''
- LE 4,&D.(&X,&JX) F4=X''
- ME 6,0(&Y,&JY) F6=X''Y'
- ME 4,&D.(&Y,&JY) F4=X''Y''
- AIF ('&F' NE 'A').GAMMA
- SDR 2,6 F2=F2+X'Y''-X''Y'
- LD 6,=D'0' F6=0.
- ADR 0,4 F0=F0+X'Y'+X''Y''
- AGO .DELTA
- .GAMMA ADR 2,6 F2=F2-X'Y''+X''Y'
- LD 6,=D'0' F6=0.
- SDR 0,4 F0=F0-X'Y'-X''Y''
- .DELTA ANOP
- MEXIT
- .CMPY2 LDR 4,6 F4=0.
- LE 6,0(&X,&JX) F6=X'
- LE 4,0(&X,&JX) F4=X'
- ME 6,&D.(&Y,&JY) F6=X'Y''
- ME 4,0(&Y,&JY) F4=X'Y'
- AIF ('&F' NE 'A').ZETA
- SDR 2,6 F2=F2-X'Y''
- LD 6,=D'0' F6=0.
- ADR 0,4 F0=F0+X'Y'
- AGO .ETA
- .ZETA ADR 2,6 F2=F2+X'Y''
- LD 6,=D'0' F6=0.
- SDR 0,4 F0=F0-X'Y'
- .ETA ANOP
- LDR 4,6 F4=0.
- LE 6,&D.(&X,&JX) F6=X''
- LE 4,&D.(&X,&JX) F4=X''
- ME 6,0(&Y,&JY) F6=X''Y'
- ME 4,&D.(&Y,&JY) F4=X''Y''
- &F.DR 2,6 F2=F2-+X'Y''+-X''Y'
- LD 6,=D'0' F6=0.
- &F.DR 0,4 F0=F0+-X'Y'+-X''Y''
- MEND
- MACRO
- &LABEL VMPY &N,&X,&JX,&Y,&JY,&JX2,&JY2
-#include "kernnum/global.inc"
- &LABEL DS 0H
- AIF ('&T' EQ 'D').ALPHA
- LD 6,=D'0' F6 = 0. (SEE MPY MACRO)
- .ALPHA ANOP
- ONCE &N,L&SYSNDX
- MPY A,&X,&Y
- AR &X,&JX (X) = (X) + JX
- AR &Y,&JY (Y) = (Y) + JY
- L&SYSNDX LOOPTWO &N,X&SYSNDX
- MPY A,&X,&Y
- MPY A,&X,&Y,JX=&JX,JY=&JY
- AR &X,&JX2 (X) = (X) + 2*JX
- AR &Y,&JY2 (Y) = (Y) + 2*JY
- X&SYSNDX LEND &N,L&SYSNDX
- AIF ('&T' EQ 'R').RROUND
- AIF ('&T' EQ 'C').CROUND
- MEXIT
- .CROUND LRER 2,2
- .RROUND LRER 0,0
- MEND
- MACRO
- &LABEL TVMPY2 &N,&X,&JX,&Y,&JY,&JX2,&JY2
-#include "kernnum/global.inc"
- &LABEL PUSH &X SAVE (X(1))
- PUSH &Y (Y(1))
- VMPY &N,&X,&JX,&Y,&JY,&JX2,&JY2
- POP &Y &Y = (Y(1))
- POP &X &X = (X(1))
- MEND
- MACRO
- &LABEL TXMPY &OPC,&M,&N,&X,&IX,&JX,&Y,&JY,&Z,&IZ
-#include "kernnum/global.inc"
- LCLA &OLD,&Y1
- &LABEL DS 0H
- LCLC &F
- &F SETC 'A' FOR &OPC = XMPY, XMPA, XMPS
- AIF ('&OPC'(3,1) EQ 'P').ALPHA
- &F SETC 'S' FOR &OPC = XMNY, XMNA, XMNS
- .ALPHA ANOP WHERE X = M OR U
- AIF ('&OPC'(1,1) NE 'U').BETA
- PUSH &Y
- AGO .DELTA
- .BETA ANOP
- &OLD SETA &STACK
- &Y1 SETA &OLD
- &STACK SETA &Y1+1*4
- AIF (&STACK LE &STKLIM).GAMMA
- MNOTE 12,'NO WORK SPACE FOR TXMPY'
- MEXIT
- .GAMMA ST &Y,&Y1.(&BASEREG) Y1 = (Y(1))
- .DELTA ANOP
- AIF ('&T' EQ 'D').EPSILON
- LD 6,=D'0' F6 = 0.
- .EPSILON ANOP
- PUSH &M
- PUSH &X
- PUSH &Z
- LR 1,&N R1 = N
- LA 0,1 R0 = 1
- AIF ('&T' NE 'C').ZETA
- CXMPY &OPC,&F,&M,&N,&X,&IX,&JX,&Y1,&Y,&JY,&Z,&IZ
- AGO .ETA
- .ZETA RXMPY &OPC,&F,&M,&N,&X,&IX,&JX,&Y1,&Y,&JY,&Z,&IZ
- .ETA ANOP
- POP &Z &Z = (Z(1))
- POP &X &X = (X(1,1))
- POP &M &M = M
- AIF ('&OPC'(1,1) NE 'U').THETA
- POP &Y &Y = (Y(1))
- AGO .IOTA
- .THETA LR &N,1 &N = N
- L &Y,&Y1.(&BASEREG) &Y = (Y(1))
- &STACK SETA &OLD
- .IOTA ANOP
- MEND
- MACRO
- &LABEL CXMPY &OPC,&F,&M,&N,&X,&IX,&JX,&Y1,&Y,&JY,&Z,&IZ
- * R0=1, R1=N
- * F6=0.
-#include "kernnum/global.inc"
- &LABEL DS 0H
- A&SYSNDX PUSH &X STACK (X(I,...))
- AIF ('&OPC'(1,1) NE 'U').ALPHA
- PUSH &Y STACK (Y(I))
- .ALPHA ANOP
- LDR 0,6 F0 = 0.
- LDR 2,6 F2 = 0.
- AIF ('&OPC'(4,1) EQ 'Y').BETA
- LE 0,0(&Z) F0 = Z(I)'
- LE 2,4(&Z) F2 = Z(I)''
- AIF ('&OPC'(4,1) EQ 'A').BETA
- LCDR 0,0 F0 = -Z(I)'
- LCDR 2,2 F2 = -Z(I)''
- .BETA ANOP
- LA &N,1 &N = J = 1
- B&SYSNDX MPY &F,&X,&Y
- AR &X,&JX &X = (X(I,J+1))
- AR &Y,&JY &Y = (Y(J+1))
- BXLE &N,0,B&SYSNDX
- LRER 0,0
- LRER 2,2
- STE 0,0(&Z)
- STE 2,4(&Z)
- AIF ('&OPC'(1,1) NE 'U').GAMMA
- POP &Y &Y = (Y(I))
- AGO .DELTA
- .GAMMA L &Y,&Y1.(&BASEREG) &Y = (Y(1))
- .DELTA POP &X &X = (X(I,...))
- AR &Z,&IZ
- AR &X,&IX
- AIF ('&OPC'(1,1) NE 'U').EPSILON
- AR &Y,&JY &Y = (Y(I+1))
- AR &X,&JX &X = (X(I+1,I+1))
- SR 1,0 N = N-1
- AGO .ZETA
- .EPSILON SR &M,0 M = M-1
- .ZETA BNZ A&SYSNDX
- MEND
- MACRO
- &LABEL RXMPY &OPC,&F,&M,&N,&X,&IX,&JX,&Y1,&Y,&JY,&Z,&IZ
- * R0=1, R1=N
- * F6=0. FOR TYPE R
-#include "kernnum/global.inc"
- &LABEL DS 0H
- A&SYSNDX DS 0H BEGIN MAIN LOOP
- AIF ('&OPC'(1,1) NE 'U').ALPHA
- SR 1,0 N = N-1
- AGO .BETA
- .ALPHA SR &M,0 M = M-1
- .BETA BZ C&SYSNDX IF ONE ROW IS LEFT OVER
- AIF ('&T' EQ 'R').DELTA
- AIF ('&OPC'(4,1) NE 'Y').EPSILON
- LD 0,=D'0' F0 = 0.
- LDR 2,0 F2 = 0.
- AGO .ZETA
- .DELTA LDR 0,6 F0 = 0.
- LDR 2,6 F2 = 0.
- AIF ('&OPC'(4,1) EQ 'Y').ZETA
- .EPSILON L&W 0,0(&Z) F0 = Z(1)
- L&W 2,0(&Z,&IZ) F2 = Z(2)
- AIF ('&OPC'(4,1) EQ 'A').ZETA
- LCDR 0,0 F0 = -Z(1)
- LCDR 2,2 F2 = -Z(2)
- .ZETA ANOP
- AIF ('&OPC'(1,1) NE 'U').ETA
- MPY &F,&X,&Y F0 = F0+X(1,1)*Y(1)
- AR &X,&JX &X = (X(1,2))
- AR &Y,&JY &Y = (Y(2))
- PUSH &Y STACK (Y(2))
- .ETA PUSH &X STACK (X)
- LA &N,1 &N = J = 1
- B&SYSNDX DS 0H
- AIF ('&T' NE 'R').THETA
- LDR 4,6 F4 = 0.
- .THETA L&W 6,0(&Y) F6 = Y(J)
- L&W 4,0(&X) F4 = X(1,J)
- M&W.R 4,6 F4 = X(1,J)*Y(J)
- M&W 6,0(&X,&IX) F6 = X(2,J)*Y(J)
- &F.DR 0,4 F0 = F0+-X(1,J)*Y(J)
- &F.DR 2,6 F2 = F2+-X(2,J)*Y(J)
- AIF ('&T' NE 'R').IOTA
- LD 6,=D'0' F6 = 0.
- .IOTA AR &X,&JX &X = (X(1,J+1))
- AR &Y,&JY &Y = (Y(J+1))
- BXLE &N,0,B&SYSNDX
- AIF ('&T' NE 'R').KAPPA
- LRER 0,0
- LRER 2,2
- .KAPPA ST&W 0,0(&Z) Z(1) = F0
- ST&W 2,0(&Z,&IZ) Z(2) = F2
- POP &X &X = (X(I,...))
- AIF ('&OPC'(1,1) NE 'U').LAMBDA
- POP &Y &Y = (Y(2))
- AGO .MU
- .LAMBDA L &Y,&Y1.(&BASEREG) &Y = (Y(1))
- .MU ANOP
- AR &Z,&IZ
- AR &X,&IX
- AR &Z,&IZ &Z = (Z(I+2))
- AR &X,&IX &X = (X(I+2,...))
- AIF ('&OPC'(1,1) NE 'U').NU
- AR &Y,&JY &Y = (Y(I+2))
- AR &X,&JX &X = (X(I+2,I+2))
- SR 1,0 N = N-2
- AGO .XI
- .NU SR &M,0 M = M-2
- .XI BNZ A&SYSNDX
- B E&SYSNDX IF ALL DONE
- C&SYSNDX DS 0H LAST ROW
- AIF ('&T' EQ 'R').OMICRON
- AIF ('&OPC'(4,1) NE 'Y').PI
- LD 0,=D'0' F0 = 0.
- AGO .RHO
- .OMICRON LDR 0,6 F0 = 0.
- AIF ('&OPC'(4,1) EQ 'Y').RHO
- .PI L&W 0,0(&Z)
- AIF ('&OPC'(4,1) EQ 'A').RHO
- LCDR 0,0 F0 = -Z(1)
- .RHO ANOP
- AIF ('&OPC'(1,1) NE 'U').SIGMA
- MPY &F,&X,&Y
- AGO .TAU
- .SIGMA LA &N,1 &N = J = 1
- D&SYSNDX MPY &F,&X,&Y
- AR &X,&JX &X = (X(M,J+1))
- AR &Y,&JY &Y = (Y(J+1))
- BXLE &N,0,D&SYSNDX
- .TAU AIF ('&T' NE 'R').YPSILON
- LRER 0,0
- .YPSILON ST&W 0,0(&Z) Z(1) = X(1,1)*Y(1)+...
- E&SYSNDX DS 0H
- MEND
- MACRO
- &LABEL TMBIL &N,&X,&IX,&Y,&IY,&JY,&Z,&JZ,&JY2,&JZ2
-#include "kernnum/global.inc"
- LCLA &OLD,&I1,&FCN1,&FCN2,&X1,&Y11
- &OLD SETA &STACK
- &I1 SETA &OLD
- &FCN1 SETA &I1+1*4
- &FCN2 SETA &FCN1+1*4
- &X1 SETA &FCN2+1*4
- &Y11 SETA &X1+1*4
- &STACK SETA &Y11+1*4
- AIF (&STACK LE &STKLIM).ALPHA
- MNOTE 13,'NO SPACE FOR MACRO TMBIL'
- MEXIT
- .ALPHA ANOP
- &LABEL LR &JY2,&JY
- LR &JZ2,&JZ
- AR &JY2,&JY &JY2 = 2*JY
- AR &JZ2,&JZ &JZ2 = 2*JZ
- ST &X,&X1.(15) X1 = (X)
- ST &Y,&Y11.(15) Y1 = (Y)
- ST&W 0,&FCN1.(15) FCN= 0.
- AIF ('&T' NE 'C').BETA
- STE 2,&FCN2.(15)
- .BETA ANOP
- LR 0,&N R0 = N
- A&SYSNDX ST 0,&I1.(15) I1 = N-I
- CLEAR 0 F0 [,F2] = 0.
- TVMPY2 &N,&Y,&JY,&Z,&JZ,&JY2,&JZ2
- MUL &X F0 = X(I)*(Y(I,1)*Z(1)+...
- AIF ('&T' EQ 'R').RBIL
- AIF ('&T' EQ 'D').DBIL
- AIF ('&T' EQ 'C').CBIL
- MNOTE 13,'INCORRECT TYPE FOR TMBIL'
- MEXIT
- .CBIL AE 2,&FCN2.(15) F2 = SUM + X(I)*(...)
- STE 2,&FCN2.(15) SUM= SUM + X(I)*(...)
- .RBIL ANOP
- .DBIL A&W 0,&FCN1.(15)
- ST&W 0,&FCN1.(15)
- AR &Y,&IY &Y = (Y(I+1,1))
- AR &X,&IX &X = (X(I+1))
- L 0,&I1.(15) R0 = N-I
- S 0,=F'1'
- BNZ A&SYSNDX WHILE I<N
- L &X,&X1.(15) &X = (X(1))
- L &Y,&Y11.(15) &Y = (Y(1,1))
- &STACK SETA &OLD
- MEND
-
-#endif
diff --git a/src/packlib/kernlib/kernnum/obsolete/kernib/msubst.inc b/src/packlib/kernlib/kernnum/obsolete/kernib/msubst.inc
deleted file mode 100644
index 18493bc..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/kernib/msubst.inc
+++ /dev/null
@@ -1,38 +0,0 @@
-*
-* $Id: msubst.inc,v 1.1.1.1 1996/02/15 17:48:32 mclareni Exp $
-*
-* $Log: msubst.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:32 mclareni
-* Kernlib
-*
-*
-#ifndef CERNLIB_KERNNUM_MSUBST_INC
-#define CERNLIB_KERNNUM_MSUBST_INC
-*
-*
-* msubst.inc
-*
- MACRO
- &LABEL MSUBST &SIZE,&N,&X,&IX,&JX,&L,&R,&JR,&JX2,&XJ,&XK
- &LABEL DS 0H
- A&SYSNDX L 0,0(&R) R0 = (R) = J * 2**12 + K
- LA 1,0 R1 = 0
- L &XJ,=F'-1' &XJ= -1
- AR &R,&JR &R = (R(I+1))
- SRDL 0,&SIZE R0 = J
- SRL 1,32-&SIZE R1 = K
- AR 1,&XJ R1 = K-1
- AR &XJ,0 &XJ= J-1
- LR &XK,&X &XK= (X(1,1))
- MR 0,&IX R1 = (K-1)*IX
- AR &XK,1 &XK= (X(K,1))
- LR 1,&XJ R1 = J-1
- LR &XJ,&X &XJ= (X(1,1))
- MR 0,&IX R1 = (J-1)*IX
- AR &XJ,1 &XJ= (X(J,1))
- VXCH2 &N,&XJ,&JX,&XK,&JX,&JX2,&JX2
- S &L,=F'1' &L = L-1
- BC NE,A&SYSNDX
- MEND
-
-#endif
diff --git a/src/packlib/kernlib/kernnum/obsolete/kernib/mul.inc b/src/packlib/kernlib/kernnum/obsolete/kernib/mul.inc
deleted file mode 100644
index ebd2c4d..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/kernib/mul.inc
+++ /dev/null
@@ -1,60 +0,0 @@
-*
-* $Id: mul.inc,v 1.1.1.1 1996/02/15 17:48:32 mclareni Exp $
-*
-* $Log: mul.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:32 mclareni
-* Kernlib
-*
-*
-#ifndef CERNLIB_KERNNUM_MUL_INC
-#define CERNLIB_KERNNUM_MUL_INC
-*
-*
-* mul.inc
-*
- MACRO
- &LABEL MUL &X,&Y,&Z,&JX=0,&JY=0,&JZ=0
-#include "kernnum/global.inc"
- &LABEL DS 0H
- AIF ('&T' EQ 'R').RMUL
- AIF ('&T' EQ 'D').DMUL
- AIF ('&T' EQ 'C').CMUL
- MNOTE 13,'NO TYPE DEFINED FOR MACRO MUL'
- MEXIT
- .RMUL ANOP
- .DMUL ANOP
- L&W 0,0(&X,&JX) F0 = X
- M&W 0,0(&Y,&JY) F0 = XY
- ST&W 0,0(&Z,&JZ) Z = XY
- MEXIT
- .CMUL ANOP
- LE 0,0(&X,&JX)
- LE 2,&D.(&X,&JX)
- ME 0,&D.(&Y,&JY) F0 = X'Y''
- ME 2,0(&Y,&JY) F2 = X''Y'
- AER 0,2 F0 = X'Y''+X''Y'
- STE 0,&D.(&Z,&JZ)
- LE 0,0(&X,&JX)
- LE 2,&D.(&X,&JX)
- ME 0,0(&Y,&JY) F0 = X'Y'
- ME 2,&D.(&Y,&JY) F2 = X''Y''
- SER 0,2 F0 = X'Y'-X''Y''
- STE 0,0(&Z,&JZ)
- MEND
- MACRO
- &LABEL VMUL &N,&X,&JX,&Y,&JY,&Z,&JZ,&JX2,&JY2,&JZ2,&J
- &LABEL FIRST &J,&N,LOOP=L&SYSNDX
- MUL &X,&Y,&Z
- AR &X,&JX (X) = (X) + JX
- AR &Y,&JY (Y) = (Y) + JY
- AR &Z,&JZ (Z) = (Z) + JZ
- L&SYSNDX FORTWO &J,&N,EXIT=X&SYSNDX
- MUL &X,&Y,&Z
- MUL &X,&Y,&Z,JX=&JX,JY=&JY,JZ=&JZ
- AR &X,&JX2 (X) = (X) + 2*JX
- AR &Y,&JY2 (Y) = (Y) + 2*JY
- AR &Z,&JZ2 (Z) = (Z) + 2*JZ
- X&SYSNDX ENDFOR &J,&N,LOOP=L&SYSNDX
- MEND
-
-#endif
diff --git a/src/packlib/kernlib/kernnum/obsolete/kernib/mula.inc b/src/packlib/kernlib/kernnum/obsolete/kernib/mula.inc
deleted file mode 100644
index c947241..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/kernib/mula.inc
+++ /dev/null
@@ -1,66 +0,0 @@
-*
-* $Id: mula.inc,v 1.1.1.1 1996/02/15 17:48:32 mclareni Exp $
-*
-* $Log: mula.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:32 mclareni
-* Kernlib
-*
-*
-#ifndef CERNLIB_KERNNUM_MULA_INC
-#define CERNLIB_KERNNUM_MULA_INC
-*
-*
-* mula.inc
-*
- MACRO
- &LABEL MULA &F,&X,&Y,&Z,&JX=0,&JY=0,&JZ=0
-#include "kernnum/global.inc"
- &LABEL DS 0H
- AIF ('&T' EQ 'R').RMULA
- AIF ('&T' EQ 'D').DMULA
- AIF ('&T' EQ 'C').CMULA
- MNOTE 13,'NO TYPE DEFINED FOR MACRO MULA'
- MEXIT
- .RMULA ANOP
- .DMULA ANOP
- L&W 0,0(&X,&JX) F0 = X
- L&W 2,0(&Z,&JZ) F2 = Z
- M&W 0,0(&Y,&JY) F0 = XY
- &F&W.R 2,0 F2 = Z+/-XY
- ST&W 2,0(&Z,&JZ) Z = Z+/-XY
- MEXIT
- .CMULA ANOP
- LE 0,0(&X,&JX) F0=X'
- LE 2,&D.(&X,&JX) F2=X''
- ME 0,&D.(&Y,&JY) F0 = X'Y''
- ME 2,0(&Y,&JY) F2=X''Y'
- AER 0,2 F0=X'Y''+X''Y'
- LE 2,&D.(&Z,&JZ) F2=Z''
- &F.ER 2,0 F2 = Z''+\-(X'Y''+X''Y')
- STE 2,&D.(&Z,&JZ)
- LE 0,0(&X,&JX) F0 = X'
- LE 2,&D.(&X,&JX) F2 = X''
- ME 0,0(&Y,&JY) F0 = X'Y'
- ME 2,&D.(&Y,&JY) F2 - X''Y''
- SER 0,2 F0 = X'Y'-X''Y''
- LE 2,0(&Z,&JZ) F2 = Z'
- &F.ER 2,0 F2= Z'+/-(X'Y'-X''Y'')
- STE 2,0(&Z,&JZ)
- MEND
- MACRO
- &LABEL VMULA &F,&N,&X,&JX,&Y,&JY,&Z,&JZ,&JX2,&JY2,&JZ2,&J
- &LABEL FIRST &J,&N,LOOP=L&SYSNDX
- MULA &F,&X,&Y,&Z
- AR &X,&JX (X) = (X) + JX
- AR &Y,&JY (Y) = (Y) + JY
- AR &Z,&JZ (Z) = (Z) + JZ
- L&SYSNDX FORTWO &J,&N,EXIT=X&SYSNDX
- MULA &F,&X,&Y,&Z
- MULA &F,&X,&Y,&Z,JX=&JX,JY=&JY,JZ=&JZ
- AR &X,&JX2 (X) = (X) + 2*JX
- AR &Y,&JY2 (Y) = (Y) + 2*JY
- AR &Z,&JZ2 (Z) = (Z) + 2*JZ
- X&SYSNDX ENDFOR &J,&N,LOOP=L&SYSNDX
- MEND
-
-#endif
diff --git a/src/packlib/kernlib/kernnum/obsolete/kernib/mxa.inc b/src/packlib/kernlib/kernnum/obsolete/kernib/mxa.inc
deleted file mode 100644
index da19230..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/kernib/mxa.inc
+++ /dev/null
@@ -1,121 +0,0 @@
-*
-* $Id: mxa.inc,v 1.1.1.1 1996/02/15 17:48:32 mclareni Exp $
-*
-* $Log: mxa.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:32 mclareni
-* Kernlib
-*
-*
-#ifndef CERNLIB_KERNNUM_MXA_INC
-#define CERNLIB_KERNNUM_MXA_INC
-*
-*
-* mxa.inc
-*
- * F4 = S
- * &L = location(S)
- * &J = location(X)
- *
- MACRO
- &LABEL MXA &X,&L,&J
-#include "kernnum/global.inc"
- &LABEL DS 0H
- AIF ('&T' EQ 'R').RMXA
- AIF ('&T' EQ 'D').DMXA
- AIF ('&T' EQ 'C').CMXA
- MNOTE 13,'NO TYPE DEFINED FOR MACRO MXA'
- MEXIT
- .CMXA LD 0,=D'0' F0 = 0.
- L&W 0,&D.(&X) F0 = X''
- LPDR 0,0 F0 = ABS(X'')
- CDR 0,4
- BC LE,C&SYSNDX IF F0 .LE. F4
- LDR 4,0 F4 = F0
- LR &L,&J &L = &J
- C&SYSNDX DS 0H
- .RMXA LD 0,=D'0' F0 = 0.
- .DMXA L&W 0,0(&X) F0 = X' = X
- LPDR 0,0 F0 = ABS(X)
- CDR 0,4
- BC LE,A&SYSNDX IF F0 .LE. F4
- LDR 4,0 F4 = F0
- LR &L,&J &L = &J
- A&SYSNDX DS 0H
- MEND
- MACRO
- &LABEL VMXA &N,&X,&JX,&L,&J
- &LABEL DS 0H
- LD 4,=D'0' F4 = 0.
- LA &L,1 &L = 1
- L&SYSNDX FORONE &J
- MXA &X,&L,&J
- AR &X,&JX (X) = (X) + JX
- ENDFOR &J,&N,LOOP=L&SYSNDX
- MEND
- MACRO
- &LABEL TVMXA1 &N,&X,&JX,&L,&J
-#include "kernnum/global.inc"
- LCLA &OLD,&X1
- &LABEL DS 0H
- &OLD SETA &STACK
- &X1 SETA &OLD
- &STACK SETA &X1+1*4
- AIF (&STACK LE &STKLIM).ALPHA
- MNOTE 14,'NO SPACE FOR MACRO TVMXA1'
- MEXIT
- .ALPHA ANOP
- ST &X,&X1.(15) X1 = (X)
- VMXA &N,&X,&JX,&L,&J
- L &X,&X1.(15) &X = (X)
- &STACK SETA &OLD
- MEND
- MACRO
- &LABEL MMXA &M,&N,&X,&IX,&JX,&L,&I,&J
-#include "kernnum/global.inc"
- LCLA &OLD,&AMAX
- &LABEL DS 0H
- &OLD SETA &STACK
- &AMAX SETA &OLD CUMULATIVE MAXIMUM VALUE
- &STACK SETA &AMAX+2*4
- AIF (&STACK LE &STKLIM).ALPHA
- MNOTE 14,'NO SPACE FOR MACRO MMXA'
- MEXIT
- .ALPHA ANOP
- LD 4,=D'0'
- STD 4,&AMAX &AMAX = 0.
- L&SYSNDX FORONE &I
- TVMXA1 &N,&X,&JX,&L,&J
- AR &X,&IX &X = (X(I+1,1))
- CD 4,&AMAX
- BC LE,A&SYSNDX
- STD 4,&AMAX &AMAX = AMAX1(F4,&AMAX)
- A&SYSNDX ENDFOR &I,&M,LOOP=L&SYSNDX
- LD 0,&AMAX F0 = &AMAX
- &STACK SETA &OLD
- MEND
- MACRO
- &LABEL TMMXA1 &M,&N,&X,&IX,&JX,&L,&I,&J
-#include "kernnum/global.inc"
- LCLA &OLD,&X11
- &OLD SETA &STACK
- &X11 SETA &OLD
- &STACK SETA &X11+1*4
- AIF (&STACK LE &STKLIM).ALPHA
- MNOTE 14,'NO SPACE FOR MACRO TMMXA1'
- MEXIT
- .ALPHA ANOP
- &LABEL ST &X,&X11.(15) X11 = (X)
- CR &M,&N
- BC GT,A&SYSNDX
- LA &M-1,1 PROCESS 1 ROW AT A TIME
- LA &N-1,1 PROCESS 1 ELEMENT AT A TIME
- MMAX &M,&N,&X,&IX,&JX,&L,&I,&J
- B B&SYSNDX
- A&SYSNDX LA &N-1,1 PROCESS 1 COLUMN AT A TIME
- LA &M-1,1 PROCESS 1 ELEMENT AT A TIME
- MMAX &N,&M,&X,&JX,&IX,&L,&J,&I
- B&SYSNDX L &X,&X11.(15) &X = (X)
- &STACK SETA &OLD
- MEND
-
-#endif
diff --git a/src/packlib/kernlib/kernnum/obsolete/kernib/ran.inc b/src/packlib/kernlib/kernnum/obsolete/kernib/ran.inc
deleted file mode 100644
index 7740939..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/kernib/ran.inc
+++ /dev/null
@@ -1,111 +0,0 @@
-*
-* $Id: ran.inc,v 1.1.1.1 1996/02/15 17:48:33 mclareni Exp $
-*
-* $Log: ran.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:33 mclareni
-* Kernlib
-*
-*
-#ifndef CERNLIB_KERNNUM_RAN_INC
-#define CERNLIB_KERNNUM_RAN_INC
-*
-*
-* ran.inc
-*
- MACRO
- &LABEL RANDATA
- DS 0D
- &LABEL DC X'402BC68CFE166D00' SEED = 0.2BC68CFE166D00
- DC X'4C2875A2E7B17500' MULT = 2875 A2E7 B175.00
- DC X'4E10000000000000' NORM = 10 0000 0000 0000.
- MEND
- MACRO
- &LABEL RANF &DATA
- &LABEL LD 0,&DATA F0 = 0.2BC68CFE166D00
- MXD 0,&DATA+8 F0 = 123456789ABC.DE
- * F2 = .(00)123456789A0000 (EXP=-2)
- LD 4,&DATA+16 F4 = 10 0000 0000 0000. (EXP=14)
- LD 6,=D'0' F6 = 0
- AXR 0,4 F0 = 10 1234 5678 9ABC.
- * F2 = .DE 1234 5678 9A00
- STD 2,&DATA SEED = .DE 1234 5678 9A00
- LDR 0,2 F0 = NEW SEED (NOT NORMALIZED)
- ADR 0,6 F0 = .DE 1234 5678 9A00 = RANF
- MEND
- MACRO
- &LABEL RAN &A,&C,&Z,&DATA
-#include "kernnum/global.inc"
- &LABEL DS 0H
- AIF ('&T' EQ 'R').RRAN
- AIF ('&T' EQ 'D').DRAN
- AIF ('&T' EQ 'C').CRAN
- MNOTE 13,'NO TYPE DECLARED FOR RAN MACRO'
- MEXIT
- .CRAN ANOP
- RANF &DATA F0 = RANF
- M&W 0,&C F0 = C*RANF
- A&W 0,&A F0 = C*RANF+A
- ST&W 0,&D.(&Z) STORE IMAGINARY PART
- .RRAN ANOP
- .DRAN ANOP
- RANF &DATA F0 = RANF
- M&W 0,&C F0 = C*RANF
- A&W 0,&A F0 = C*RANF+A
- ST&W 0,0(&Z) STORE REAL PART
- MEND
- MACRO
- &LABEL VRAN &A,&C,&N,&Z,&JZ,&J,&DATA
- &LABEL DS 0H
- L&SYSNDX FORONE &J
- RAN &A,&C,&Z,&DATA
- AR &Z,&JZ
- ENDFOR &J,&N,LOOP=L&SYSNDX
- MEND
- MACRO
- &LABEL TVRAN1 &A,&C,&N,&Z,&JZ,&J,&DATA
-#include "kernnum/global.inc"
- LCLA &OLD,&Z1
- &OLD SETA &STACK
- &Z1 SETA &OLD
- &STACK SETA &Z1+1*4
- AIF (&STACK LE &STKLIM).ALPHA
- MNOTE 14,'NO WORK SPACE FOR TVRAN1'
- MEXIT
- .ALPHA ANOP
- &LABEL ST &Z,&Z1.(15) Z1 = (Z)
- VRAN &A,&C,&N,&Z,&JZ,&J,&DATA
- L &Z,&Z1.(15) &Z = (Z)
- &STACK SETA &OLD
- MEND
- MACRO
- &LABEL MRAN &A,&C,&M,&N,&Z,&IZ,&JZ,&I,&J,&DATA
- &LABEL DS 0H
- L&SYSNDX FORONE &I
- TVRAN1 &A,&C,&N,&Z,&JZ,&J,&DATA
- AR &Z,&IZ &Z = (Z(I+1,1))
- ENDFOR &I,&M,LOOP=L&SYSNDX
- MEND
- MACRO
- &LABEL TMRAN1 &A,&C,&M,&N,&Z,&IZ,&JZ,&I,&J,&DATA
-#include "kernnum/global.inc"
- LCLA &OLD,&Z11
- &OLD SETA &STACK
- &Z11 SETA &OLD
- &STACK SETA &Z11+1*4
- AIF (&STACK LE &STKLIM).ALPHA
- MNOTE 14,'NO WORK SPACE FOR TMRAN1'
- MEXIT
- .ALPHA ANOP
- &LABEL LA &M-1,1 MSTEP = 1
- LA &N-1,1 NSTEP = 1
- ST &Z,&Z11.(15) Z11 = (Z)
- CR &M,&N
- BC GT,A&SYSNDX
- MRAN &A,&C,&M,&N,&Z,&IZ,&JZ,&I,&J,&DATA
- B B&SYSNDX
- A&SYSNDX MRAN &A,&C,&N,&M,&Z,&JZ,&IZ,&J,&I,&DATA
- B&SYSNDX L &Z,&Z11.(15) &Z = (Z)
- &STACK SETA &OLD
- MEND
-
-#endif
diff --git a/src/packlib/kernlib/kernnum/obsolete/kernib/register.inc b/src/packlib/kernlib/kernnum/obsolete/kernib/register.inc
deleted file mode 100644
index 42495f7..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/kernib/register.inc
+++ /dev/null
@@ -1,131 +0,0 @@
-*
-* $Id: register.inc,v 1.1.1.1 1996/02/15 17:48:31 mclareni Exp $
-*
-* $Log: register.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:31 mclareni
-* Kernlib
-*
-*
-#ifndef CERNLIB_KERNNUM_REGISTER_INC
-#define CERNLIB_KERNNUM_REGISTER_INC
-*
-*
-* register.inc
-*
- MACRO
- &LABEL CLEAR &F
-#include "kernnum/global.inc"
- &LABEL DS 0H
- AIF ('&T' EQ 'R').RCLEAR
- AIF ('&T' EQ 'D').DCLEAR
- AIF ('&T' EQ 'C').CCLEAR
- MEXIT
- .CCLEAR ANOP
- LD &F+2,=D'0' &F+2 = 0.
- .RCLEAR ANOP
- .DCLEAR ANOP
- LD &F,=D'0' &F = 0.
- MEND
- MACRO
- &LABEL LOAD &F,&X,&JX=0
-#include "kernnum/global.inc"
- &LABEL DS 0H
- AIF ('&T' EQ 'R').RLOAD
- AIF ('&T' EQ 'D').DLOAD
- AIF ('&T' EQ 'C').CLOAD
- MEXIT
- .CLOAD LD &F+2,=D'0'
- LE &F+2,4(&X,&JX)
- .RLOAD LD &F,=D'0'
- LE &F,0(&X,&JX)
- MEXIT
- .DLOAD LD &F,0(&X,&JX)
- MEND
- MACRO
- &LABEL MINUS &F
-#include "kernnum/global.inc"
- &LABEL DS 0H
- AIF ('&T' EQ 'R').RMINUS
- AIF ('&T' EQ 'D').DMINUS
- AIF ('&T' EQ 'C').CMINUS
- MEXIT
- .CMINUS ANOP
- LCDR &F+2,&F+2
- .RMINUS ANOP
- .DMINUS ANOP
- LCDR &F,&F
- MEND
- MACRO
- &LABEL MUL &X
-#include "kernnum/global.inc"
- &LABEL DS 0H
- AIF ('&T' EQ 'R').RMUL
- AIF ('&T' EQ 'D').DMUL
- AIF ('&T' EQ 'C').CMUL
- .RMUL ANOP
- .DMUL ANOP
- M&W 0,0(&X)
- MEXIT
- .CMUL ANOP
- L&W 4,&D.(&X) F4 = X"
- L&W 6,0(&X) F6 = X'
- M&W.R 4,2 F4 = R"*X"
- M&W.R 6,2 F6 = R"*X'
- LDR 2,0 F2 = R'
- M&W 0,0(&X) F0 = R'*X'
- M&W 2,&D.(&X) F2 = R'*X"
- S&W.R 0,4 F0 = R'*X' - R"*X"
- A&W.R 2,6 F2 = R'*X" + R"*X'
- MEND
- MACRO
- &LABEL RCPRCL &X
-#include "kernnum/global.inc"
- &LABEL DS 0H
- AIF ('&T' EQ 'R').RRCPRCL
- AIF ('&T' EQ 'D').DRCPRCL
- AIF ('&T' EQ 'C').CRCPRCL
- MEXIT
- .RRCPRCL ANOP
- .DRCPRCL ANOP
- LD 0,=D'1.0' F0 = 1.
- D&W 0,0(&X) F0 = 1./X
- ST&W 0,0(&X) X = 1./X
- MEXIT
- .CRCPRCL ANOP
- SDR 0,0 F0 = 0
- SDR 2,2 F2 = 0
- L&W 0,0(&X) F0 = X'
- L&W 2,&D.(&X) F2 = X''
- LDR 4,0 F4 = X'
- LDR 6,2 F6 = X''
- M&W.R 4,4
- M&W.R 6,6
- ADR 4,6 F4 = X'**2 + X''**2 = D
- D&W.R 0,4 F0 = X' / D
- D&W.R 2,4 F2 = X''/ D
- LC&W.R 2,2 F2 = -X''/ D
- ST&W 0,0(&X)
- ST&W 2,&D.(&X)
- MEND
- MACRO
- &LABEL STORE &F,&X,&JX=0
-#include "kernnum/global.inc"
- &LABEL DS 0H
- AIF ('&T' EQ 'R').RSTORE
- AIF ('&T' EQ 'D').DSTORE
- AIF ('&T' EQ 'C').CSTORE
- MEXIT
- .CSTORE ANOP
- ST&W &F+2,&D.(&X,&JX)
- .RSTORE ANOP
- .DSTORE ANOP
- ST&W &F,0(&X,&JX)
- MEND
- MACRO
- &LABEL SWAP &R1,&R2
- &LABEL LR 0,&R1
- LR &R1,&R2 &R1 = TWO
- LR &R2,0 &R2 = ONE
- MEND
-
-#endif
diff --git a/src/packlib/kernlib/kernnum/obsolete/kernib/sca.inc b/src/packlib/kernlib/kernnum/obsolete/kernib/sca.inc
deleted file mode 100644
index 68543cf..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/kernib/sca.inc
+++ /dev/null
@@ -1,89 +0,0 @@
-*
-* $Id: sca.inc,v 1.1.1.1 1996/02/15 17:48:33 mclareni Exp $
-*
-* $Log: sca.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:33 mclareni
-* Kernlib
-*
-*
-#ifndef CERNLIB_KERNNUM_SCA_INC
-#define CERNLIB_KERNNUM_SCA_INC
-*
-*
-* sca.inc
-*
- MACRO
- &LABEL SCA &F,&X,&Y,&Z,&JX=0,&JY=0,&JZ=0
-#include "kernnum/global.inc"
- &LABEL DS 0H
- AIF ('&T' EQ 'R').RSCA
- AIF ('&T' EQ 'D').DSCA
- AIF ('&T' EQ 'C').CSCA
- MEXIT
- .RSCA ANOP
- .DSCA ANOP
- LDR 0,4 F0=S
- M&W 0,0(&X,&JX)
- &F&W 0,0(&Y,&JY) F0=SX+Y
- ST&W 0,0(&Z,&JZ)
- MEXIT
- .CSCA ANOP
- SDR 0,0
- SDR 2,2
- L&W 0,0(&X,&JX) F0 = X'
- L&W 2,&D.(&X,&JX) F2 = X''
- M&W.R 0,4 F0 = S'*X'
- M&W.R 2,6 F2 = S''*X''
- S&W.R 0,2 F0 = S'*X' - S''*X''
- &F&W 0,0(&Y,&JY) F0=S'X'-S''X''+Y'
- SDR 2,2
- L&W 2,0(&X,&JX) F2=X'
- ST&W 0,0(&Z,&JZ) Z' = S'*X' - S''*X'' + Y'
- SDR 0,0
- L&W 0,&D.(&X,&JX) F0=X''
- M&W.R 0,4 F0 = S'*X''
- M&W.R 2,6 F2 = S''*X'
- A&W.R 0,2 F0 = S'*X'' + S''*X'
- &F&W 0,&D.(&Y,&JY) F0 = S'*X'' + S''*X' + Y''
- ST&W 0,&D.(&Z,&JZ) Z''= S'*X'' + S''*X' + Y''
- MEND
- MACRO
- &LABEL VSCA &F,&N,&X,&JX,&Y,&JY,&Z,&JZ,&JX2,&JY2,&JZ2,&J
- &LABEL FIRST &J,&N,LOOP=L&SYSNDX
- SCA &F,&X,&Y,&Z
- AR &X,&JX (X) = (X) + JX
- AR &Y,&JY (Y) = (Y) + JY
- AR &Z,&JZ (Z) = (Z) + JZ
- L&SYSNDX FORTWO &J,&N,EXIT=X&SYSNDX
- SCA &F,&X,&Y,&Z
- SCA &F,&X,&Y,&Z,JX=&JX,JY=&JY,JZ=&JZ
- AR &X,&JX2 (X) = (X) + 2*JX
- AR &Y,&JY2 (Y) = (Y) + 2*JY
- AR &Z,&JZ2 (Z) = (Z) + 2*JZ
- X&SYSNDX ENDFOR &J,&N,LOOP=L&SYSNDX
- MEND
- MACRO
- &LABEL TVSCA2 &N,&X,&JX,&Y,&JY,&Z,&JZ,&JX2,&JY2,&JZ2,&J
-#include "kernnum/global.inc"
- LCLA &OLD,&X1,&Y1,&Z1
- &LABEL DS 0H
- &OLD SETA &STACK
- &X1 SETA &OLD
- &Y1 SETA &X1+1*4
- &Z1 SETA &Y1+1*4
- &STACK SETA &Z1+1*4
- AIF (&STACK LE &STKLIM).ALPHA
- MNOTE 255,'INSUFFICIENT WORK SPACE'
- MEXIT
- .ALPHA ANOP
- ST &X,&X1.(15) X1 = (X)
- ST &Y,&Y1.(15) Y1 = (Y)
- ST &Z,&Z1.(15) Z1 = (Z)
- VSCA &F,&N,&X,&JX,&Y,&JY,&Z,&JZ,&JX2,&JY2,&JZ2,&J
- L &X,&X1.(15) &X = (X)
- L &Y,&Y1.(15) &Y = (Y)
- L &Z,&Z1.(15) &Z = (Z)
- &STACK SETA &OLD
- MEND
-
-#endif
diff --git a/src/packlib/kernlib/kernnum/obsolete/kernib/scl.inc b/src/packlib/kernlib/kernnum/obsolete/kernib/scl.inc
deleted file mode 100644
index fb502f2..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/kernib/scl.inc
+++ /dev/null
@@ -1,169 +0,0 @@
-*
-* $Id: scl.inc,v 1.1.1.1 1996/02/15 17:48:33 mclareni Exp $
-*
-* $Log: scl.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:33 mclareni
-* Kernlib
-*
-*
-#ifndef CERNLIB_KERNNUM_SCL_INC
-#define CERNLIB_KERNNUM_SCL_INC
-*
-*
-* scl.inc
-*
- MACRO
- &LABEL SCL &X,&Z,&JX=0,&JZ=0
-#include "kernnum/global.inc"
- &LABEL DS 0H
- AIF ('&T' EQ 'R').RSCL
- AIF ('&T' EQ 'D').DSCL
- AIF ('&T' EQ 'C').CSCL
- MEXIT
- .RSCL ANOP
- .DSCL ANOP
- LDR 0,4 F0=S
- M&W 0,0(&X,&JX)
- ST&W 0,0(&Z,&JZ)
- MEXIT
- .CSCL ANOP
- SDR 0,0
- SDR 2,2
- L&W 0,0(&X,&JX) F0=X'
- L&W 2,&D.(&X,&JX) F2=X''
- M&W.R 0,4 F0 = S'*X'
- M&W.R 2,6 F2 = S''*X''
- S&W.R 0,2 F0 = S'*X' - S''*X''
- AIF ('T' EQ 'W').ALPHA
- SDR 2,2
- .ALPHA L&W 2,0(&X,&JX) F2=X'
- ST&W 0,0(&Z,&JZ) Z' = S'*X' - S''*X''
- AIF ('T' EQ 'W').BETA
- SDR 0,0
- .BETA L&W 0,&D.(&X,&JX) F0=X''
- M&W.R 0,4 F0 = S'*X''
- M&W.R 2,6 F2 = S''*X'
- A&W.R 0,2 F0 = S'*X'' + S''*X'
- ST&W 0,&D.(&Z,&JZ) Z''= S'*X'' + S''*X'
- MEND
- MACRO
- &LABEL TVSCL &N,&X,&JX,&Z,&JZ
-#include "kernnum/global.inc"
- &LABEL PUSH &X
- PUSH &Z
- L&SYSNDX LOOPONE &N
- SCL &X,&Z
- AR &X,&JX &X = (X(J+1))
- AR &Z,&JZ &Z = (Z(J+1))
- LEND &N,L&SYSNDX
- POP &Z &Z = (Z(1))
- POP &X &X = (X(1))
- MEND
- MACRO
- &LABEL VSCL &N,&X,&JX,&Z,&JZ,&JX2,&JZ2,&J
- &LABEL FIRST &J,&N,LOOP=L&SYSNDX
- SCL &X,&Z
- AR &X,&JX (X) = (X) + JX
- AR &Z,&JZ (Z) = (Z) + JZ
- L&SYSNDX FORTWO &J,&N,EXIT=X&SYSNDX
- SCL &X,&Z
- SCL &X,&Z,JX=&JX,JZ=&JZ
- AR &X,&JX2 (X) = (X) + 2*JX
- AR &Z,&JZ2 (Z) = (Z) + 2*JZ
- X&SYSNDX ENDFOR &J,&N,LOOP=L&SYSNDX
- MEND
- MACRO
- &LABEL TVSCL2 &N,&X,&JX,&Z,&JZ,&JX2,&JZ2,&J
-#include "kernnum/global.inc"
- LCLA &OLD,&X1,&Z1
- &LABEL DS 0H
- &OLD SETA &STACK
- &X1 SETA &OLD
- &Z1 SETA &X1+1*4
- &STACK SETA &Z1+1*4
- AIF (&STACK LE &STKLIM).ALPHA
- MNOTE 255,'INSUFFICIENT WORK SPACE'
- MEXIT
- .ALPHA ANOP
- ST &X,&X1.(15) X1 = (X)
- ST &Z,&Z1.(15) Z1 = (Z)
- VSCL &N,&X,&JX,&Z,&JZ,&JX2,&JZ2,&J
- L &X,&X1.(15) &X = (X)
- L &Z,&Z1.(15) &Z = (Z)
- &STACK SETA &OLD
- MEND
- MACRO
- &LABEL TMSCL &M,&N,&X,&IX,&JX,&Z,&IZ,&JZ
-#include "kernnum/global.inc"
- &LABEL DS 0H
- A&SYSNDX PUSH &M
- PUSH &X
- PUSH &Z
- LR 1,&N R1 = N
- LA 0,1
- NR 0,&M R0 = MOD(M,2)
- BZ C&SYSNDX IF M IS EVEN
- TVSCL &N,&X,&JX,&Z,&JZ
- SR &M,0 M = M-1
- BZ F&SYSNDX IF M = 1
- AR &X,&IX &X = (X(2,1))
- AR &Z,&IZ &Z = (Z(2,1))
- C&SYSNDX LA 0,1 R0 = NSTEP = 1
- D&SYSNDX PUSH &X &X = (X(I,1))
- PUSH &Z &Z = (Z(I,1))
- LA &N,1 &N = J = 1
- E&SYSNDX SCL &X,&Z
- SCL &X,&Z,JX=&IX,JZ=&IZ
- AR &X,&JX &X = (X(I,J+1))
- AR &Z,&JZ &Z = (Z(I,J+1))
- BXLE &N,0,E&SYSNDX
- POP &Z &Z = (Z(I,1))
- POP &X &X = (X(I,1))
- AR &Z,&IZ
- AR &X,&IX
- AR &Z,&IZ &Z = (Z(I+2,1))
- AR &X,&IX &X = (X(I+2,1))
- S &M,=F'2' M = M-2
- BNZ D&SYSNDX
- F&SYSNDX LR &N,1 &N = N
- POP &Z &Z = (Z(1,1))
- POP &X &X = (X(1,1))
- POP &M &M = M
- MEND
- MACRO
- &LABEL RSCL &M,&N,&DD,&ID,&X,&IX,&JX,&Z,&IZ,&JZ
-#include "kernnum/global.inc"
- &LABEL DS 0H
- &OLD SETA &STACK
- &IX1 SETA &OLD SAVE OF &IX
- &IZ1 SETA &IX1+1*4 SAVE OF &IZ
- &STACK SETA &IZ1+1*4
- AIF (&STACK LE &STKLIM).ALPHA
- MNOTE 12,'INSUFFICIENT WORK SPACE FOR RSCL'
- MEXIT
- .ALPHA ANOP
- ST &IX,&IX1.(15) SAVE &IX
- ST &IZ,&IZ1.(15) SAVE &IZ
- LR &IX,&JX &IX= JX
- LR &IZ,&JZ &IZ= JZ
- AR &IX,&JX &IX= 2*JX
- AR &IZ,&JZ &IZ= 2*JZ
- A&SYSNDX LOAD 4,&DD F4 = D(I)
- PUSH &DD SAVE (D(I))
- PUSH &X SAVE (X(I,1))
- PUSH &Z SAVE (Z(I,1))
- VSCL &N,&X,&JX,&Z,&JZ,&IX,&IZ,&DD
- POP &Z &Z = (Z(I,1))
- POP &X &X = (X(I,1))
- POP &DD &DD= (D(I))
- A &Z,&IZ1.(15) &Z = (Z(I+1,1))
- A &X,&IX1.(15) &X = (X(I+1,1))
- AR &DD,&ID &DD= (D(I+1))
- S &M,=F'1' &M = M-I
- BNZ A&SYSNDX IF(I .LT. M) REPEAT
- L &IX,&IX1.(15) RESTORE &IX
- L &IZ,&IZ1.(15) RESTORE &IZ
- &STACK SETA &OLD
- MEND
-
-#endif
diff --git a/src/packlib/kernlib/kernnum/obsolete/kernib/set.inc b/src/packlib/kernlib/kernnum/obsolete/kernib/set.inc
deleted file mode 100644
index 2d603f5..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/kernib/set.inc
+++ /dev/null
@@ -1,80 +0,0 @@
-*
-* $Id: set.inc,v 1.1.1.1 1996/02/15 17:48:33 mclareni Exp $
-*
-* $Log: set.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:33 mclareni
-* Kernlib
-*
-*
-#ifndef CERNLIB_KERNNUM_SET_INC
-#define CERNLIB_KERNNUM_SET_INC
-*
-*
-* set.inc
-*
- MACRO
- &LABEL VSET &N,&Z,&JZ,&JZ2,&J
- &LABEL FIRST &J,&N,LOOP=L&SYSNDX
- STORE 0,&Z
- AR &Z,&JZ (Z) = (Z) + JZ
- L&SYSNDX FORTWO &J,&N,EXIT=X&SYSNDX
- STORE 0,&Z
- STORE 0,&Z,JX=&JZ
- AR &Z,&JZ2 (Z) = (Z) + 2*JZ
- X&SYSNDX ENDFOR &J,&N,LOOP=L&SYSNDX
- MEND
- MACRO
- &LABEL TVSET2 &N,&Z,&JZ,&JZ2,&J
-#include "kernnum/global.inc"
- LCLA &OLD,&Z1
- &LABEL DS 0H
- &OLD SETA &STACK
- &Z1 SETA &OLD
- &STACK SETA &Z1+1*4
- AIF (&STACK LE &STKLIM).ALPHA
- MNOTE 14,'NO WORK SPACE FOR MACRO TVSET2'
- MEXIT
- .ALPHA ANOP
- ST &Z,&Z1.(15) Z1 = (Z)
- VSET &N,&Z,&JZ,&JZ2,&J
- L &Z,&Z1.(15) &Z = (Z)
- &STACK SETA &OLD
- MEND
- MACRO
- &LABEL MSET &M,&N,&Z,&IZ,&JZ,&JZ2,&I,&J
- &LABEL DS 0H
- L&SYSNDX FORONE &I
- TVSET2 &N,&Z,&JZ,&JZ2,&J
- AR &Z,&IZ &Z = (Z(I+1,1))
- ENDFOR &I,&M,LOOP=L&SYSNDX
- MEND
- MACRO
- &LABEL TMSET2 &M,&N,&Z,&IZ,&JZ,&JZ2,&I,&J
-#include "kernnum/global.inc"
- LCLA &OLD,&Z11
- &OLD SETA &STACK
- &Z11 SETA &OLD
- &STACK SETA &Z11+1*4
- AIF (&STACK LE &STKLIM).ALPHA
- MNOTE 14,'NO WORK SPACE FOR MACRO TMSET2'
- MEXIT
- .ALPHA ANOP
- &LABEL ST &Z,&Z11.(15) Z11 = (Z(1,1))
- CR &M,&N
- BC GT,A&SYSNDX
- LA &M-1,1 PROCESS 1 ROW AT A TIME
- LA &N-1,2 PROCESS 2 ELEMENTS AT A TIME
- LR &JZ2,&JZ
- AR &JZ2,&JZ &JZ2 = 2*JZ
- MSET &M,&N,&Z,&IZ,&JZ,&JZ2,&I,&J
- B B&SYSNDX
- A&SYSNDX LA &N-1,1 PROCESS 1 COLUMN AT A TIME
- LA &M-1,2 PROCESS 2 ELEMENTS AT A TIME
- LR &JZ2,&IZ
- AR &JZ2,&IZ &JZ2 = 2*IZ
- MSET &N,&M,&Z,&JZ,&IZ,&JZ2,&J,&I
- B&SYSNDX L &Z,&Z11.(15) &Z = (Z(1,1))
- &STACK SETA &OLD
- MEND
-
-#endif
diff --git a/src/packlib/kernlib/kernnum/obsolete/kernib/setype.inc b/src/packlib/kernlib/kernnum/obsolete/kernib/setype.inc
deleted file mode 100644
index 2aac1c3..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/kernib/setype.inc
+++ /dev/null
@@ -1,46 +0,0 @@
-*
-* $Id: setype.inc,v 1.1.1.1 1996/02/15 17:48:31 mclareni Exp $
-*
-* $Log: setype.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:31 mclareni
-* Kernlib
-*
-*
-#ifndef CERNLIB_KERNNUM_SETYPE_INC
-#define CERNLIB_KERNNUM_SETYPE_INC
-*
-*
-* setype.inc
-*
- MACRO
- SETYPE
-#include "kernnum/global.inc"
- AIF (&TYPE EQ &RTYPE).RSET
- AIF (&TYPE EQ &DTYPE).DSET
- AIF (&TYPE EQ &CTYPE).CSET
- AIF (&TYPE EQ &CCTYPE).CSET
- AIF (&TYPE EQ &CTYPEC).CSET
- MNOTE 12,'ILLEGAL ARRAY TYPE'
- MEXIT
- .RSET ANOP
- &T SETC 'R'
- &W SETC 'E' L&W GIVES OPERATION CODE LE
- &LENGTH SETA 4 WORD LENGTH OF VARIABLE
- &LOGLEN SETA 2 SHIFT COUNT FOR &LENGTH
- MEXIT
- .DSET ANOP
- &T SETC 'D'
- &W SETC 'D' L&W GIVES OPERATION CODE LD
- &LENGTH SETA 8 WORD LENGTH OF VARIABLE
- &LOGLEN SETA 3 SHIFT COUNT FOR &LENGTH
- MEXIT
- .CSET ANOP
- &T SETC 'C'
- &W SETC 'E' L&W GIVES OPERATION CODE LE
- &LENGTH SETA 8 WORD LENGTH OF VARIABLE
- &LOGLEN SETA 3 SHIFT COUNT FOR &LENGTH
- &D SETA 4 DISPLACEMENT FOR IMAGINARY PART
- &CC SETA &TYPE-&CTYPE INITIAL SETTING IS 0, 1, OR 2
- MEND
-
-#endif
diff --git a/src/packlib/kernlib/kernnum/obsolete/kernib/sfact.inc b/src/packlib/kernlib/kernnum/obsolete/kernib/sfact.inc
deleted file mode 100644
index 7094091..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/kernib/sfact.inc
+++ /dev/null
@@ -1,212 +0,0 @@
-*
-* $Id: sfact.inc,v 1.1.1.1 1996/02/15 17:48:33 mclareni Exp $
-*
-* $Log: sfact.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:33 mclareni
-* Kernlib
-*
-*
-#ifndef CERNLIB_KERNNUM_SFACT_INC
-#define CERNLIB_KERNNUM_SFACT_INC
-*
-*
-* sfact.inc
-*
- MACRO
- &LABEL TSFACTD &N,&A,&IA,&JA,&X,&Y,&I,&J,&L
-#include "kernnum/global.inc"
- LCLA &OLD,&A1,&A1K1,&AK1
- &LABEL DS 0H
- &OLD SETA &STACK
- &A1 SETA &OLD
- &A1K1 SETA &A1+1*4
- &AK1 SETA &A1K1+1*4
- &STACK SETA &AK1+1*4
- AIF (&STACK LE &STKLIM).ALPHA
- MNOTE 12,'TSFACTD HAS INSUFFICIENT WORK SPACE'
- MEXIT
- .ALPHA ANOP
- ST &A,&A1.(15) &A1 = (A(1,1))
- ST &A,&AK1.(15) &AK1 = (A(K,1))
- LR &J,&A
- AR &J,&JA &J = (A(1,K+1))
- ST &J,&A1K1.(15) &A1K1 = (A(1,K+1))
- * DET = ONE
- * JFAIL = 0
- * IFAIL = 0
- LA &J,ONE&SYSNDX &J = (ONE)
- LOAD 0,&J F0 = ONE
- LA &J,DET&SYSNDX &J = (DET)
- STORE 0,&J DET = ONE
- LA &J,0 &J = 0
- ST &J,JFL&SYSNDX JFAIL = 0
- ST &J,IFL&SYSNDX IFAIL = 0
- * DO 20 K = 1, N
- LA &I,0 &I = 0 = K-1
- A&SYSNDX DS 0H
- * &I = K-1
- * &A = (A(K,K))
- * &A1K1 = (A(1,K+1))
- * &AK1 = (A(K,1))
- * IF(A(K,K) .LE. 0.) GOTO 90
- * DET = DET * A(K,K)
- * A(K,K) = ONE / A(K,K)
- * SCALE DETERMINANT, ADD EXPONENT TO JFAIL
- LOAD 0,&A F0 = A(K,K)
- CE 0,=E'0.'
- BC LE,E&SYSNDX IF(A(K,K) .LE. 0.) GOTO 90
- LA &X,DET&SYSNDX &X = (DET)
- MUL &X F0 = A(K,K)*DET
- STORE 0,&X DET = A(K,K)*DET
- RCPRCL &A A(K,K) = 1 / A(K,K)
- L &L,JFL&SYSNDX &L = JFAIL
- DET1 &X,&L,&J INCREMENT JFAIL
- ST &L,JFL&SYSNDX
- * 14 IF(K .EQ. N) GOTO 21
- LR &J,&I &J = K-1
- A &J,=F'1' &J = K
- CR &J,&N
- BC EQ,F&SYSNDX IF(K .EQ. N)
- * CALL VSCL(N-K,A(K,K),A(K+1,K),IA,A(K,K+1),JA)
- * CALL MMNA(N-K,K,A(K+1,1),IA,JA,A(1,K+1),IA,A(K+1,K+1),IA)
- D&SYSNDX DS 0H
- LOAD 4,&A F4 = A(K,K)
- LR &L,&I &L = K-1
- A &L,=F'1' &L = K
- LR &I,&N
- SR &I,&L &I = N-K
- LR &X,&A &X = (A(K,K))
- LR &Y,&X &Y = (A(K,K))
- AR &Y,&JA &Y = (A(K,K+1))
- AR &X,&IA &X = (A(K+1,K))
- TVSCL &I,&X,&IA,&Y,&JA
- SWAP &I,&L &I = K
- * &L = N-K
- L &X,&AK1.(15) &X = (A(K,1))
- AR &X,&IA &X = (A(K+1,1))
- ST &X,&AK1.(15) &AK1 = (A(K+1,1))
- L &Y,&A1K1.(15) &Y = (A(1,K+1))
- AR &A,&IA
- AR &A,&JA &A = (A(K+1,K+1))
- TXMPY MMNA,&L,&I,&X,&IA,&JA,&Y,&IA,&A,&IA
- AR &Y,&JA &Y = (A(1,K+2))
- ST &Y,&A1K1.(15) &A1K1 = (A(1,K+2))
- B A&SYSNDX REPEAT MAIN LOOP
- IFL&SYSNDX DS 1F IFAIL
- JFL&SYSNDX DS 1F JFAIL
- AIF ('&T' EQ 'R').RCON
- AIF ('&T' EQ 'D').DCON
- AIF ('&T' EQ 'C').CCON
- MEXIT
- .RCON DS 0F
- ZERO&SYSNDX DC E'0.' ZERO
- ONE&SYSNDX DC E'1.' ONE
- DET&SYSNDX DS 1F DET
- AGO .ZCON
- .DCON DS 0D
- ZERO&SYSNDX DC D'0.' ZERO
- ONE&SYSNDX DC D'1.' ONE
- DET&SYSNDX DS 1D DET
- AGO .ZCON
- .CCON DS 0F
- ZERO&SYSNDX DC E'0.',E'0.' ZERO
- ONE&SYSNDX DC E'1.',E'0.' ONE
- DET&SYSNDX DS 2F DET
- .ZCON ANOP
- * 90 DET = 0.
- * IFAIL = -1
- * JFAIL = -2
- E&SYSNDX DS 0H
- CLEAR 0 F0 = 0.
- L &I,=F'-1' &I = -1
- L &J,=F'-2' &J = -2
- B Z&SYSNDX EXIT
- * 21 DE-SCALE DET
- * RETURN
- F&SYSNDX L &A,&A1.(15) &A = (A)
- LA &L,DET&SYSNDX &L = (DET)
- L &J,JFL&SYSNDX &J = JFAIL
- DET2 &L,&J,&I SCALE DET, SET JFAIL
- L &I,IFL&SYSNDX &I = IFAIL
- LOAD 0,&L F0 = DET
- Z&SYSNDX DS 0H
- &STACK SETA &OLD
- MEND
- MACRO
- &LABEL TSFACT &N,&A,&IA,&JA,&X,&Y,&I,&J,&L
-#include "kernnum/global.inc"
- LCLA &OLD,&A1,&A1K1,&AK1
- &LABEL DS 0H
- &OLD SETA &STACK
- &A1 SETA &OLD
- &A1K1 SETA &A1+1*4
- &AK1 SETA &A1K1+1*4
- &STACK SETA &AK1+1*4
- AIF (&STACK LE &STKLIM).ALPHA
- MNOTE 13,'NO SPACE FOR MACRO TSFACT'
- MEXIT
- .ALPHA ANOP
- ST &A,&A1.(15) &A1 = (A(1,1))
- ST &A,&AK1.(15) &AK1 = (A(K,1))
- LR &J,&A
- AR &J,&JA &J = (A(1,K+1))
- ST &J,&A1K1.(15) &A1K1 = (A(1,K+1))
- * IFAIL = 0
- LA &J,0 &J = 0
- ST &J,IFL&SYSNDX IFAIL = 0
- * DO 20 K = 1, N
- LA &I,0 &I = 0 = K-1
- A&SYSNDX DS 0H
- * &I = K-1
- * &A = (A(K,K))
- * &A1K1 = (A(1,K+1))
- * &AK1 = (A(K,1))
- * IF(A(K,K) .LE. 0.) GOTO 90
- * A(K,K) = ONE / A(K,K)
- LOAD 0,&A F0 = A(K,K)
- CE 0,=E'0.'
- BC LE,E&SYSNDX IF(A(K,K) .LE. 0.) GOTO 90
- RCPRCL &A A(K,K) = 1 / A(K,K)
- * 14 IF(K .EQ. N) GOTO 21
- LR &J,&I &J = K-1
- A &J,=F'1' &J = K
- CR &J,&N
- BC EQ,F&SYSNDX IF(K .EQ. N)
- * CALL VSCL(N-K,A(K,K),A(K+1,K),IA,A(K,K+1),JA)
- * CALL MMNA(N-K,K,A(K+1,1),IA,JA,A(1,K+1),IA,A(K+1,K+1),IA)
- D&SYSNDX DS 0H
- LOAD 4,&A F4 = A(K,K)
- LR &L,&I &L = K-1
- A &L,=F'1' &L = K
- LR &I,&N
- SR &I,&L &I = N-K
- LR &X,&A &X = (A(K,K))
- LR &Y,&X &Y = (A(K,K))
- AR &Y,&JA &Y = (A(K,K+1))
- AR &X,&IA &X = (A(K+1,K))
- TVSCL &I,&X,&IA,&Y,&JA
- SWAP &I,&L &I = K
- * &L = N-K
- L &X,&AK1.(15) &X = (A(K,1))
- AR &X,&IA &X = (A(K+1,1))
- ST &X,&AK1.(15) &AK1 = (A(K+1,1))
- L &Y,&A1K1.(15) &Y = (A(1,K+1))
- AR &A,&IA
- AR &A,&JA &A = (A(K+1,K+1))
- TXMPY MMNA,&L,&I,&X,&IA,&JA,&Y,&IA,&A,&IA
- AR &Y,&JA &Y = (A(1,K+2))
- ST &Y,&A1K1.(15) &A1K1 = (A(1,K+2))
- B A&SYSNDX REPEAT MAIN LOOP
- IFL&SYSNDX DS 1F IFAIL
- * 90 IFAIL = -1
- E&SYSNDX DS 0H
- L &I,=F'-1' &I = -1
- B Z&SYSNDX EXIT
- * 21 RETURN
- F&SYSNDX L &A,&A1.(15) &A = (A)
- L &I,IFL&SYSNDX &I = IFAIL
- Z&SYSNDX DS 0H
- &STACK SETA &OLD
- MEND
-
-#endif
diff --git a/src/packlib/kernlib/kernnum/obsolete/kernib/sfinv.inc b/src/packlib/kernlib/kernnum/obsolete/kernib/sfinv.inc
deleted file mode 100644
index 6d9ba39..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/kernib/sfinv.inc
+++ /dev/null
@@ -1,89 +0,0 @@
-*
-* $Id: sfinv.inc,v 1.1.1.1 1996/02/15 17:48:33 mclareni Exp $
-*
-* $Log: sfinv.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:33 mclareni
-* Kernlib
-*
-*
-#ifndef CERNLIB_KERNNUM_SFINV_INC
-#define CERNLIB_KERNNUM_SFINV_INC
-*
-*
-* sfinv.inc
-*
- MACRO
- &LABEL TSFINV &N,&A,&IA,&JA,&IA2,&JA2,&X,&Y,&Z,&I,&K
- &LABEL DS 0H
- LR &IA2,&IA
- LR &JA2,&JA
- AR &IA2,&IA &IA2 = 2*IA
- AR &JA2,&JA &JA2 = 2*JA
- * DO 20 I = 2, N
- * IF(I .EQ. 2) GOTO 10
- * CALL UMNS(I-2,A(1,2),A(1,3),A(2,3),A(2,I),A(3,I),
- * A(1,I),A(2,I))
- * 10 A(I-1,I) = -A(I-1,I)
- * CALL VSCL(I-1,A(I,I),A(1,I),A(2,I),A(I,1),A(I,2))
- * 20 CONTINUE
- LA &I,0 &I = 0 = I-2
- LR &X,&A &X = (A(1,1)) = (A(I-1,1))
- LR &Y,&A &Y = (A(1,1))
- AR &Y,&IA &Y = (A(2,1)) = (A(2,I-1))
- LR &Z,&A &Z = (A(1,1)) = (A(1,I-1))
- AR &A,&JA &A = (A(1,2))
- LR &K,&A &K = (A(1,2)) = (A(I-1,I))
- A&SYSNDX DS 0H I = 2,3,...,N = &I+2
- AR &Y,&JA &Y = (A(2,I))
- AR &Z,&JA &Z = (A(1,I))
- C &I,=F'0'
- BC EQ,B&SYSNDX IF I .EQ. 2
- TXMPY UMNS,&I,&I,&A,&IA,&JA,&Y,&IA,&Z,&IA
- B&SYSNDX DS 0H
- LOAD 0,&K F0 = A(I-1,I)
- MINUS 0 F0 = -A(I-1,I)
- STORE 0,&K A(I-1,I) = -A(I-1,I)
- A &I,=F'1' &I = I-1
- AR &X,&IA &X = (A(I,1))
- AR &K,&IA &K = (A(I,I))
- LOAD 4,&K F4 = A(I,I)
- TVSCL &I,&Z,&IA,&X,&JA
- AR &K,&JA &K = (A(I,I+1))
- LR 0,&I R0 = I-1
- A 0,=F'1' R0 = I
- CR 0,&N
- BC LT,A&SYSNDX IF(I .LT. N) REPEAT
- SR &A,&JA &A = (A(1,1))
- * DO 30 K = 1, N-1
- * A(K,K) = VMPA(N-K,A(K,K+1),A(K,K+2),
- * A(K+1,K),A(K+2,K),A(K,K))
- * CALL MMPY(K,N-K,A(1,K+1),A(1,K+2),A(2,K+1),
- * A(K+1,K+1),A(K+2,K+1),
- * A(1,K+1),A(2,K+1))
- * 30 CONTINUE
- * CALL MUTL(N,A,A(1,2),A(2,1))
- LA &K,1 &K = 1 = K
- LR &X,&A &X = (A(1,1)) = (A(1,K))
- LR &Y,&A &Y = (A(1,1)) = (A(K,K))
- C&SYSNDX DS 0H
- LR &Z,&Y &Z = (A(K,K))
- LOAD 0,&Z F0 = A(K,K)
- LR &I,&N &I = N
- SR &I,&K &I = N-K
- AR &Y,&JA &Y = (A(K,K+1))
- AR &Z,&IA &Z = (A(K+1,K))
- TVMPY2 &I,&Y,&JA,&Z,&IA,&JA2,&IA2
- SR &Z,&IA &Z = (A(K,K))
- STORE 0,&Z A(K,K) = VMPA(N-K,...
- AR &X,&JA &X = (A(1,K+1))
- AR &Y,&IA &Y = (A(K+1,K+1))
- LR &Z,&X &Z = (A(1,K+1))
- TXMPY MMPY,&K,&I,&X,&IA,&JA,&Y,&IA,&Z,&IA
- A &K,=F'1' &K = K+1
- CR &K,&N
- BC LT,C&SYSNDX IF(K+1 .LT. N) REPEAT
- LR &I,&N &I = N
- TMUTL &I,&A,&IA,&JA,&X
- MEND
-
-#endif
diff --git a/src/packlib/kernlib/kernnum/obsolete/kernib/sqr.inc b/src/packlib/kernlib/kernnum/obsolete/kernib/sqr.inc
deleted file mode 100644
index b6c8a20..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/kernib/sqr.inc
+++ /dev/null
@@ -1,79 +0,0 @@
-*
-* $Id: sqr.inc,v 1.1.1.1 1996/02/15 17:48:33 mclareni Exp $
-*
-* $Log: sqr.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:33 mclareni
-* Kernlib
-*
-*
-#ifndef CERNLIB_KERNNUM_SQR_INC
-#define CERNLIB_KERNNUM_SQR_INC
-*
-*
-* sqr.inc
-*
- MACRO
- &LABEL SQR &X,&JX=0
-#include "kernnum/global.inc"
- &LABEL DS 0H
- AIF ('&T' EQ 'R').RSQR
- AIF ('&T' EQ 'D').DSQR
- AIF ('&T' EQ 'C').CSQR
- MEXIT
- .CSQR ANOP
- SDR 4,4 F4 = 0
- L&W 4,&D.(&X,&JX) F4 = X''
- M&W.R 4,4 F4 = X''**2
- SDR 0,4 F0 = S'-X''**2
- L&W 4,0(&X,&JX) F4 = X'
- M&W 4,&D.(&X,&JX) F4 = X'X''
- ADR 2,4 F2 = 0.5S''+X'X''
- .RSQR ANOP
- SDR 4,4 F4 = 0
- .DSQR ANOP
- L&W 4,0(&X,&JX) F4 = X'
- M&W.R 4,4 F4 = X'**2
- ADR 0,4 F0 = S'+X'**2
- MEND
- MACRO
- &LABEL VSQR &N,&X,&JX,&JX2,&J
-#include "kernnum/global.inc"
- &LABEL CLEAR 0 F0 = 0
- FIRST &J,&N,LOOP=L&SYSNDX
- SQR &X
- AR &X,&JX (X) = (X) + JX
- L&SYSNDX FORTWO &J,&N,EXIT=X&SYSNDX
- SQR &X
- SQR &X,JX=&JX
- AR &X,&JX2 (X) = (X) + 2*JX
- X&SYSNDX ENDFOR &J,&N,LOOP=L&SYSNDX
- AIF ('&T' EQ 'C').ALPHA
- AIF ('&T' EQ 'W').ALPHA
- AGO .BETA
- .ALPHA ADR 2,2 S' = 2*S'
- .BETA ANOP
- AIF ('&T' EQ 'R').RROUND
- AIF ('&T' EQ 'C').CROUND
- MEXIT
- .CROUND LRER 2,2
- .RROUND LRER 0,0
- MEND
- MACRO
- &LABEL TVSQR2 &N,&X,&JX,&JX2,&J
-#include "kernnum/global.inc"
- LCLA &OLD,&X1
- &LABEL DS 0H
- &OLD SETA &STACK
- &X1 SETA &OLD
- &STACK SETA &X1+1*4
- AIF (&STACK LE &STKLIM).ALPHA
- MNOTE 255,'INSUFFICIENT WORK SPACE'
- MEXIT
- .ALPHA ANOP
- ST &X,&X1.(15) X1 = (X)
- VSQR &N,&X,&JX,&JX2,&J
- L &X,&X1.(15) &X = (X)
- &STACK SETA &OLD
- MEND
-
-#endif
diff --git a/src/packlib/kernlib/kernnum/obsolete/kernib/stack.inc b/src/packlib/kernlib/kernnum/obsolete/kernib/stack.inc
deleted file mode 100644
index accab1b..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/kernib/stack.inc
+++ /dev/null
@@ -1,36 +0,0 @@
-*
-* $Id: stack.inc,v 1.1.1.1 1996/02/15 17:48:31 mclareni Exp $
-*
-* $Log: stack.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:31 mclareni
-* Kernlib
-*
-*
-#ifndef CERNLIB_KERNNUM_STACK_INC
-#define CERNLIB_KERNNUM_STACK_INC
-*
-*
-* stack.inc
-*
- MACRO
- &LABEL PUSH &R
-#include "kernnum/global.inc"
- AIF (&STACK LT &STKLIM).ALPHA
- MNOTE 12,'STACK OVERFLOW'
- MEXIT
- .ALPHA ANOP
- &LABEL ST &R,&STACK.(&BASEREG)
- &STACK SETA &STACK+1*4
- MEND
- MACRO
- &LABEL POP &R
-#include "kernnum/global.inc"
- &STACK SETA &STACK-1*4
- AIF (&STACK GE &STKORG).ALPHA
- MNOTE 12,'STACK UNDERFLOW'
- MEXIT
- .ALPHA ANOP
- &LABEL L &R,&STACK.(&BASEREG)
- MEND
-
-#endif
diff --git a/src/packlib/kernlib/kernnum/obsolete/kernib/sum.inc b/src/packlib/kernlib/kernnum/obsolete/kernib/sum.inc
deleted file mode 100644
index 4ed88b0..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/kernib/sum.inc
+++ /dev/null
@@ -1,42 +0,0 @@
-*
-* $Id: sum.inc,v 1.1.1.1 1996/02/15 17:48:33 mclareni Exp $
-*
-* $Log: sum.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:33 mclareni
-* Kernlib
-*
-*
-#ifndef CERNLIB_KERNNUM_SUM_INC
-#define CERNLIB_KERNNUM_SUM_INC
-*
-*
-* sum.inc
-*
- MACRO
- &LABEL SUM &X,&JX=0
-#include "kernnum/global.inc"
- &LABEL DS 0H
- AIF ('&T' EQ 'R').RSUM
- AIF ('&T' EQ 'D').DSUM
- AIF ('&T' EQ 'C').CSUM
- MNOTE 13,'NO TYPE DECLARED FOR SUM MACRO'
- MEXIT
- .CSUM A&W 2,&D.(&X,&JX) F2 = F2+X''
- .RSUM ANOP
- .DSUM ANOP
- A&W 0,0(&X,&JX) F0 = F0+X'
- MEND
- MACRO
- &LABEL VSUM &N,&X,&JX,&JX2,&J
- &LABEL CLEAR 0
- FIRST &J,&N,LOOP=L&SYSNDX
- SUM &X
- AR &X,&JX (X) = (X) + JX
- L&SYSNDX FORTWO &J,&N,EXIT=X&SYSNDX
- SUM &X
- SUM &X,JX=&JX
- AR &X,&JX2 (X) = (X) + 2*JX
- X&SYSNDX ENDFOR &J,&N,LOOP=L&SYSNDX
- MEND
-
-#endif
diff --git a/src/packlib/kernlib/kernnum/obsolete/kernib/tglobal.inc b/src/packlib/kernlib/kernnum/obsolete/kernib/tglobal.inc
deleted file mode 100644
index ae4c12c..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/kernib/tglobal.inc
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: tglobal.inc,v 1.1.1.1 1996/02/15 17:48:31 mclareni Exp $
-*
-* $Log: tglobal.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:31 mclareni
-* Kernlib
-*
-*
-#ifndef CERNLIB_KERNNUM_TGLOBAL_INC
-#define CERNLIB_KERNNUM_TGLOBAL_INC
-*
-*
-* tglobal.inc
-*
-#include "kernnum/global.inc"
- &RTYPE SETA 10
- &DTYPE SETA 20
- &CTYPE SETA 30
- &CCTYPE SETA 31
- &CTYPEC SETA 32
- &BASEREG SETA 15
-
-#endif
diff --git a/src/packlib/kernlib/kernnum/obsolete/kernib/tmprnt.inc b/src/packlib/kernlib/kernnum/obsolete/kernib/tmprnt.inc
deleted file mode 100644
index 5e6d4db..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/kernib/tmprnt.inc
+++ /dev/null
@@ -1,59 +0,0 @@
-*
-* $Id: tmprnt.inc,v 1.1.1.1 1996/02/15 17:48:33 mclareni Exp $
-*
-* $Log: tmprnt.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:33 mclareni
-* Kernlib
-*
-*
-#ifndef CERNLIB_KERNNUM_TMPRNT_INC
-#define CERNLIB_KERNNUM_TMPRNT_INC
-*
-*
-* tmprnt.inc
-*
- MACRO
- &LABEL TMPRNT &HVALUE,&N,&I,&K
- &LABEL DS 0H
- ST &N,N&SYSNDX SAVE N
- ST &I,I&SYSNDX SAVE IDIM
- ST &K,K&SYSNDX SAVE K
- ST 12,R12&SYSNDX SAVE R12
- ST 13,R13&SYSNDX SAVE R13
- ST 14,R14&SYSNDX SAVE R14
- LR 12,15 SAVE BASE REGISTER 15 IN 12
- LA 13,S&SYSNDX R13= (SAVE AREA)
- LA 1,L&SYSNDX R1 = (ARGUMENT LIST)
- L 15,P&SYSNDX R15= (TMPRNT)
- BALR 14,15 CALL TMPRNT
- LR 15,12 RESTORE BASE REGISTER 15
- L 12,R12&SYSNDX RESTORE R12
- L 13,R13&SYSNDX RESTORE R13
- L 14,R14&SYSNDX RESTORE R14
- B Z&SYSNDX RETURN
- DS 0F
- P&SYSNDX DC V(TMPRNT)
- DS 0F
- DC C'BZ00'
- DC A(LL&SYSNDX-L&SYSNDX)
- L&SYSNDX DC A(&HVALUE)
- DC A(N&SYSNDX)
- DC A(I&SYSNDX)
- DC AL4(K&SYSNDX+X'80000000')
- LL&SYSNDX DC A(E&SYSNDX)
- DC A(F&SYSNDX)
- DC A(F&SYSNDX)
- DC AL4(F&SYSNDX+X'80000000')
- E&SYSNDX DS F'8'
- F&SYSNDX DS F'4'
- N&SYSNDX DS 1F N
- I&SYSNDX DS 1F IDIM
- K&SYSNDX DS 1F K
- S&SYSNDX DS 18F SAVE AREA
- R12&SYSNDX DS 1F
- R13&SYSNDX DS 1F
- R14&SYSNDX DS 1F
- Z&SYSNDX DS 0H
- MEND
-
-#endif
diff --git a/src/packlib/kernlib/kernnum/obsolete/kernib/utl.inc b/src/packlib/kernlib/kernnum/obsolete/kernib/utl.inc
deleted file mode 100644
index 09c8eee..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/kernib/utl.inc
+++ /dev/null
@@ -1,49 +0,0 @@
-*
-* $Id: utl.inc,v 1.1.1.1 1996/02/15 17:48:33 mclareni Exp $
-*
-* $Log: utl.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:33 mclareni
-* Kernlib
-*
-*
-#ifndef CERNLIB_KERNNUM_UTL_INC
-#define CERNLIB_KERNNUM_UTL_INC
-*
-*
-* utl.inc
-*
- MACRO
- &LABEL TMUTL &N,&X,&IX,&JX,&Z (&Z IS TEMPORARY)
-#include "kernnum/global.inc"
- &LABEL LR 1,&N R1 = N
- LA 0,1 R0 = 1
- SR 1,0 R1 = N-1
- BZ D&SYSNDX IF(N .EQ. 1) EXIT
- PUSH &N STACK N
- PUSH &X STACK (X(1,1))
- A&SYSNDX LR &Z,&X &Z = (X(I,I))
- AR &X,&JX &X = (X(I,I+1))
- AR &Z,&IX &Z = (X(I+1,I))
- CPY &X,&Z
- SR 1,0 R1 = N-2
- BZ C&SYSNDX IF(I+1 .EQ. N)
- AR &X,&JX &X = (X(I,I+2))
- AR &Z,&IX &Z = (X(I+2,I))
- PUSH &X STACK (X(I,I+2))
- LA &N,1 &N = J = 1
- B&SYSNDX CPY &X,&Z
- CPY &X,&Z,JX=&IX,JZ=&JX
- AR &X,&JX
- AR &Z,&IX
- BXLE &N,0,B&SYSNDX
- POP &X &X = (X(I,I+2))
- AR &X,&IX
- AR &X,&IX &X = (X(I+2,I+2))
- SR 1,0 R1 = N-3 ETC
- BNZ A&SYSNDX
- C&SYSNDX POP &X &X = (X(1,1))
- POP &N &N = N
- D&SYSNDX DS 0H
- MEND
-
-#endif
diff --git a/src/packlib/kernlib/kernnum/obsolete/kernib/xch.inc b/src/packlib/kernlib/kernnum/obsolete/kernib/xch.inc
deleted file mode 100644
index 4263960..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/kernib/xch.inc
+++ /dev/null
@@ -1,85 +0,0 @@
-*
-* $Id: xch.inc,v 1.1.1.1 1996/02/15 17:48:33 mclareni Exp $
-*
-* $Log: xch.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:33 mclareni
-* Kernlib
-*
-*
-#ifndef CERNLIB_KERNNUM_XCH_INC
-#define CERNLIB_KERNNUM_XCH_INC
-*
-*
-* xch.inc
-*
- MACRO
- &LABEL XCH &X,&Y,&JX=0,&JY=0
-#include "kernnum/global.inc"
- &LABEL DS 0H
- AIF ('&T' EQ 'R').RXCH
- AIF ('&T' EQ 'D').DXCH
- AIF ('&T' EQ 'C').CXCH
- MNOTE 13,'NO TYPE DEFINED FOR XCH MACRO'
- MEXIT
- .CXCH ANOP
- LD 0,0(&X,&JX)
- LD 2,0(&Y,&JY)
- STD 0,0(&Y,&JY)
- STD 2,0(&X,&JX)
- MEXIT
- .RXCH ANOP
- .DXCH ANOP
- L&W 0,0(&X,&JX)
- L&W 2,0(&Y,&JY)
- ST&W 0,0(&Y,&JY)
- ST&W 2,0(&X,&JX)
- MEND
- MACRO
- &LABEL VXCH2 &N,&X,&JX,&Y,&JY,&JX2,&JY2
-#include "kernnum/global.inc"
- &LABEL ONCE &N,L&SYSNDX
- XCH &X,&Y
- AR &X,&JX
- AR &Y,&JY
- L&SYSNDX LOOPTWO &N,X&SYSNDX
- XCH &X,&Y
- XCH &X,&Y,JX=&JX,JY=&JY
- AR &X,&JX2
- AR &Y,&JY2
- X&SYSNDX LEND &N,L&SYSNDX
- MEND
- MACRO
- &LABEL VXCH &N,&X,&JX,&Y,&JY,&JX2,&JY2,&J
- &LABEL FIRST &J,&N,LOOP=L&SYSNDX
- XCH &X,&Y
- AR &X,&JX (X) = (X) + JX
- AR &Y,&JY (Y) = (Y) + JY
- L&SYSNDX FORTWO &J,&N,EXIT=X&SYSNDX
- XCH &X,&Y
- XCH &X,&Y,JX=&JX,JY=&JY
- AR &X,&JX2 (X) = (X) + 2*JX
- AR &Y,&JY2 (Y) = (Y) + 2*JY
- X&SYSNDX ENDFOR &J,&N,LOOP=L&SYSNDX
- MEND
- MACRO
- &LABEL TVXCH2 &N,&X,&JX,&Y,&JY,&JX2,&JY2,&J
-#include "kernnum/global.inc"
- LCLA &OLD,&X1,&Y1
- &LABEL DS 0H
- &OLD SETA &STACK
- &X1 SETA &OLD
- &Y1 SETA &X1+1*4
- &STACK SETA &Y1+1*4
- AIF (&STACK LE &STKLIM).ALPHA
- MNOTE 255,'INSUFFICIENT WORK SPACE'
- MEXIT
- .ALPHA ANOP
- ST &X,&X1.(15) X1 = (X)
- ST &Y,&Y1.(15) Y1 = (Y)
- VXCH &N,&X,&JX,&Y,&JY,&JX2,&JY2,&J
- L &X,&X1.(15) &X = (X)
- L &Y,&Y1.(15) &Y = (Y)
- &STACK SETA &OLD
- MEND
-
-#endif
diff --git a/src/packlib/kernlib/kernnum/obsolete/kernnum/numcd.h b/src/packlib/kernlib/kernnum/obsolete/kernnum/numcd.h
deleted file mode 100644
index 25bec4d..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/kernnum/numcd.h
+++ /dev/null
@@ -1,45 +0,0 @@
-*
-* $Id: numcd.h,v 1.1.1.1 1996/02/15 17:47:58 mclareni Exp $
-*
-* $Log: numcd.h,v $
-* Revision 1.1.1.1 1996/02/15 17:47:58 mclareni
-* Kernlib
-*
-*
-* This directory was created from kernnum.car patch numcd
-#ifdef CERNLIB_NUMLOPRE
-#undef CERNLIB_NUMLOPRE
-#endif
-#ifndef CERNLIB_NUMHIPRE
-#define CERNLIB_NUMHIPRE
-#endif
-#ifdef CERNLIB_NUMRDBLE
-#undef CERNLIB_NUMRDBLE
-#endif
-#ifdef CERNLIB_NUMCDBLE
-#undef CERNLIB_NUMCDBLE
-#endif
-#ifdef CERNLIB_NUME38
-#undef CERNLIB_NUME38
-#endif
-#ifdef CERNLIB_NUME75
-#undef CERNLIB_NUME75
-#endif
-#ifndef CERNLIB_NUME293
-#define CERNLIB_NUME293
-#endif
-#ifdef CERNLIB_NUME2465
-#undef CERNLIB_NUME2465
-#endif
-#ifdef CERNLIB_NUMD38
-#undef CERNLIB_NUMD38
-#endif
-#ifdef CERNLIB_NUMD75
-#undef CERNLIB_NUMD75
-#endif
-#ifndef CERNLIB_NUMD279
-#define CERNLIB_NUMD279
-#endif
-#ifdef CERNLIB_NUMD2465
-#undef CERNLIB_NUMD2465
-#endif
diff --git a/src/packlib/kernlib/kernnum/obsolete/kernnum/numcd1a.h b/src/packlib/kernlib/kernnum/obsolete/kernnum/numcd1a.h
deleted file mode 100644
index ca54d9b..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/kernnum/numcd1a.h
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: numcd1a.h,v 1.1.1.1 1996/02/15 17:47:58 mclareni Exp $
-*
-* $Log: numcd1a.h,v $
-* Revision 1.1.1.1 1996/02/15 17:47:58 mclareni
-* Kernlib
-*
-*
-* This directory was created from kernnum.car patch numcd1a
-#ifndef CERNLIB_NUMCD
-#define CERNLIB_NUMCD
-#endif
-#ifndef CERNLIB_NUMFORT
-#define CERNLIB_NUMFORT
-#endif
-#ifndef CERNLIB_NUMCDOPT
-#define CERNLIB_NUMCDOPT
-#endif
diff --git a/src/packlib/kernlib/kernnum/obsolete/kernnum/numcd1f.h b/src/packlib/kernlib/kernnum/obsolete/kernnum/numcd1f.h
deleted file mode 100644
index 1642223..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/kernnum/numcd1f.h
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: numcd1f.h,v 1.1.1.1 1996/02/15 17:47:58 mclareni Exp $
-*
-* $Log: numcd1f.h,v $
-* Revision 1.1.1.1 1996/02/15 17:47:58 mclareni
-* Kernlib
-*
-*
-* This directory was created from kernnum.car patch numcd1f
-#ifndef CERNLIB_NUMCD
-#define CERNLIB_NUMCD
-#endif
-#ifndef CERNLIB_NUMFORT
-#define CERNLIB_NUMFORT
-#endif
-#ifndef CERNLIB_NUMFTOPT
-#define CERNLIB_NUMFTOPT
-#endif
diff --git a/src/packlib/kernlib/kernnum/obsolete/kernnum/numcdopt.h b/src/packlib/kernlib/kernnum/obsolete/kernnum/numcdopt.h
deleted file mode 100644
index df1960d..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/kernnum/numcdopt.h
+++ /dev/null
@@ -1,129 +0,0 @@
-*
-* $Id: numcdopt.h,v 1.1.1.1 1996/02/15 17:47:58 mclareni Exp $
-*
-* $Log: numcdopt.h,v $
-* Revision 1.1.1.1 1996/02/15 17:47:58 mclareni
-* Kernlib
-*
-*
-* This directory was created from kernnum.car patch numcdopt
-#ifndef CERNLIB_KERNCD
-#define CERNLIB_KERNCD
-#endif
-#ifndef CERNLIB_E208CD
-#define CERNLIB_E208CD
-#endif
-#ifndef CERNLIB_F002CD
-#define CERNLIB_F002CD
-#endif
-#ifndef CERNLIB_F003CD
-#define CERNLIB_F003CD
-#endif
-#ifndef CERNLIB_F004CD
-#define CERNLIB_F004CD
-#endif
-#ifndef CERNLIB_F011CD
-#define CERNLIB_F011CD
-#endif
-#ifndef CERNLIB_F012CD
-#define CERNLIB_F012CD
-#endif
-#ifndef CERNLIB_G900CD
-#define CERNLIB_G900CD
-#endif
-#ifndef CERNLIB_E208FORT_E208PR
-#define CERNLIB_E208FORT_E208PR
-#endif
-#ifndef CERNLIB_F002FORT_DVADD
-#define CERNLIB_F002FORT_DVADD
-#endif
-#ifndef CERNLIB_F002FORT_CVADD
-#define CERNLIB_F002FORT_CVADD
-#endif
-#ifndef CERNLIB_F002FORT_DVDIV
-#define CERNLIB_F002FORT_DVDIV
-#endif
-#ifndef CERNLIB_F002FORT_CVDIV
-#define CERNLIB_F002FORT_CVDIV
-#endif
-#ifndef CERNLIB_F002FORT_CVMPAC
-#define CERNLIB_F002FORT_CVMPAC
-#endif
-#ifndef CERNLIB_F002FORT_CVMPYC
-#define CERNLIB_F002FORT_CVMPYC
-#endif
-#ifndef CERNLIB_F002FORT_DVMUL
-#define CERNLIB_F002FORT_DVMUL
-#endif
-#ifndef CERNLIB_F002FORT_DVMULA
-#define CERNLIB_F002FORT_DVMULA
-#endif
-#ifndef CERNLIB_F002FORT_DVMUNA
-#define CERNLIB_F002FORT_DVMUNA
-#endif
-#ifndef CERNLIB_F002FORT_DVRAN
-#define CERNLIB_F002FORT_DVRAN
-#endif
-#ifndef CERNLIB_F002FORT_CVRAN
-#define CERNLIB_F002FORT_CVRAN
-#endif
-#ifndef CERNLIB_F002FORT_DVSET
-#define CERNLIB_F002FORT_DVSET
-#endif
-#ifndef CERNLIB_F002FORT_CVSET
-#define CERNLIB_F002FORT_CVSET
-#endif
-#ifndef CERNLIB_F002FORT_DVSUB
-#define CERNLIB_F002FORT_DVSUB
-#endif
-#ifndef CERNLIB_F002FORT_CVSUB
-#define CERNLIB_F002FORT_CVSUB
-#endif
-#ifndef CERNLIB_F002FORT_DVSUM
-#define CERNLIB_F002FORT_DVSUM
-#endif
-#ifndef CERNLIB_F002FORT_CVSUM
-#define CERNLIB_F002FORT_CVSUM
-#endif
-#ifndef CERNLIB_F003FORT_CMMPYC
-#define CERNLIB_F003FORT_CMMPYC
-#endif
-#ifndef CERNLIB_F003FORT_CCMMPY
-#define CERNLIB_F003FORT_CCMMPY
-#endif
-#ifndef CERNLIB_F003FORT_CUMPYC
-#define CERNLIB_F003FORT_CUMPYC
-#endif
-#ifndef CERNLIB_F003FORT_CCUMPY
-#define CERNLIB_F003FORT_CCUMPY
-#endif
-#ifndef CERNLIB_F003FORT_DMBIL
-#define CERNLIB_F003FORT_DMBIL
-#endif
-#ifndef CERNLIB_F003FORT_CMBIL
-#define CERNLIB_F003FORT_CMBIL
-#endif
-#ifndef CERNLIB_F003FORT_DMRAN
-#define CERNLIB_F003FORT_DMRAN
-#endif
-#ifndef CERNLIB_F003FORT_CMRAN
-#define CERNLIB_F003FORT_CMRAN
-#endif
-#ifndef CERNLIB_F003FORT_DMSCL
-#define CERNLIB_F003FORT_DMSCL
-#endif
-#ifndef CERNLIB_F003FORT_CMSCL
-#define CERNLIB_F003FORT_CMSCL
-#endif
-#ifndef CERNLIB_F003FORT_DMSET
-#define CERNLIB_F003FORT_DMSET
-#endif
-#ifndef CERNLIB_F003FORT_CMSET
-#define CERNLIB_F003FORT_CMSET
-#endif
-#ifndef CERNLIB_F004FORT_CMMLTC
-#define CERNLIB_F004FORT_CMMLTC
-#endif
-#ifndef CERNLIB_F011FORT_TMPRNT
-#define CERNLIB_F011FORT_TMPRNT
-#endif
diff --git a/src/packlib/kernlib/kernnum/obsolete/kernnum/numcr.h b/src/packlib/kernlib/kernnum/obsolete/kernnum/numcr.h
deleted file mode 100644
index 410a979..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/kernnum/numcr.h
+++ /dev/null
@@ -1,45 +0,0 @@
-*
-* $Id: numcr.h,v 1.1.1.1 1996/02/15 17:47:58 mclareni Exp $
-*
-* $Log: numcr.h,v $
-* Revision 1.1.1.1 1996/02/15 17:47:58 mclareni
-* Kernlib
-*
-*
-* This directory was created from kernnum.car patch numcr
-#ifdef CERNLIB_NUMLOPRE
-#undef CERNLIB_NUMLOPRE
-#endif
-#ifndef CERNLIB_NUMHIPRE
-#define CERNLIB_NUMHIPRE
-#endif
-#ifdef CERNLIB_NUMRDBLE
-#undef CERNLIB_NUMRDBLE
-#endif
-#ifdef CERNLIB_NUMCDBLE
-#undef CERNLIB_NUMCDBLE
-#endif
-#ifdef CERNLIB_NUME38
-#undef CERNLIB_NUME38
-#endif
-#ifdef CERNLIB_NUME75
-#undef CERNLIB_NUME75
-#endif
-#ifdef CERNLIB_NUME293
-#undef CERNLIB_NUME293
-#endif
-#ifndef CERNLIB_NUME2465
-#define CERNLIB_NUME2465
-#endif
-#ifdef CERNLIB_NUMD38
-#undef CERNLIB_NUMD38
-#endif
-#ifdef CERNLIB_NUMD75
-#undef CERNLIB_NUMD75
-#endif
-#ifdef CERNLIB_NUMD279
-#undef CERNLIB_NUMD279
-#endif
-#ifndef CERNLIB_NUMD2465
-#define CERNLIB_NUMD2465
-#endif
diff --git a/src/packlib/kernlib/kernnum/obsolete/kernnum/numcr1f.h b/src/packlib/kernlib/kernnum/obsolete/kernnum/numcr1f.h
deleted file mode 100644
index 1de980c..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/kernnum/numcr1f.h
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: numcr1f.h,v 1.1.1.1 1996/02/15 17:47:58 mclareni Exp $
-*
-* $Log: numcr1f.h,v $
-* Revision 1.1.1.1 1996/02/15 17:47:58 mclareni
-* Kernlib
-*
-*
-* This directory was created from kernnum.car patch numcr1f
-#ifndef CERNLIB_NUMCR
-#define CERNLIB_NUMCR
-#endif
-#ifndef CERNLIB_NUMFORT
-#define CERNLIB_NUMFORT
-#endif
-#ifndef CERNLIB_NUMFTOPT
-#define CERNLIB_NUMFTOPT
-#endif
diff --git a/src/packlib/kernlib/kernnum/obsolete/kernnum/numcv.h b/src/packlib/kernlib/kernnum/obsolete/kernnum/numcv.h
deleted file mode 100644
index 63cbd2e..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/kernnum/numcv.h
+++ /dev/null
@@ -1,45 +0,0 @@
-*
-* $Id: numcv.h,v 1.1.1.1 1996/02/15 17:47:58 mclareni Exp $
-*
-* $Log: numcv.h,v $
-* Revision 1.1.1.1 1996/02/15 17:47:58 mclareni
-* Kernlib
-*
-*
-* This directory was created from kernnum.car patch numcv
-#ifdef CERNLIB_NUMLOPRE
-#undef CERNLIB_NUMLOPRE
-#endif
-#ifndef CERNLIB_NUMHIPRE
-#define CERNLIB_NUMHIPRE
-#endif
-#ifdef CERNLIB_NUMRDBLE
-#undef CERNLIB_NUMRDBLE
-#endif
-#ifdef CERNLIB_NUMCDBLE
-#undef CERNLIB_NUMCDBLE
-#endif
-#ifdef CERNLIB_NUME38
-#undef CERNLIB_NUME38
-#endif
-#ifdef CERNLIB_NUME75
-#undef CERNLIB_NUME75
-#endif
-#ifdef CERNLIB_NUME293
-#undef CERNLIB_NUME293
-#endif
-#ifndef CERNLIB_NUME2465
-#define CERNLIB_NUME2465
-#endif
-#ifdef CERNLIB_NUMD38
-#undef CERNLIB_NUMD38
-#endif
-#ifdef CERNLIB_NUMD75
-#undef CERNLIB_NUMD75
-#endif
-#ifdef CERNLIB_NUMD279
-#undef CERNLIB_NUMD279
-#endif
-#ifndef CERNLIB_NUMD2465
-#define CERNLIB_NUMD2465
-#endif
diff --git a/src/packlib/kernlib/kernnum/obsolete/kernnum/numcv1f.h b/src/packlib/kernlib/kernnum/obsolete/kernnum/numcv1f.h
deleted file mode 100644
index e68d9e1..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/kernnum/numcv1f.h
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: numcv1f.h,v 1.1.1.1 1996/02/15 17:47:58 mclareni Exp $
-*
-* $Log: numcv1f.h,v $
-* Revision 1.1.1.1 1996/02/15 17:47:58 mclareni
-* Kernlib
-*
-*
-* This directory was created from kernnum.car patch numcv1f
-#ifndef CERNLIB_NUMCV
-#define CERNLIB_NUMCV
-#endif
-#ifndef CERNLIB_NUMFORT
-#define CERNLIB_NUMFORT
-#endif
-#ifndef CERNLIB_NUMFTOPT
-#define CERNLIB_NUMFTOPT
-#endif
diff --git a/src/packlib/kernlib/kernnum/obsolete/kernnum/numib.h b/src/packlib/kernlib/kernnum/obsolete/kernnum/numib.h
deleted file mode 100644
index d1bf0a4..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/kernnum/numib.h
+++ /dev/null
@@ -1,45 +0,0 @@
-*
-* $Id: numib.h,v 1.1.1.1 1996/02/15 17:47:58 mclareni Exp $
-*
-* $Log: numib.h,v $
-* Revision 1.1.1.1 1996/02/15 17:47:58 mclareni
-* Kernlib
-*
-*
-* This directory was created from kernnum.car patch numib
-#ifndef CERNLIB_NUMLOPRE
-#define CERNLIB_NUMLOPRE
-#endif
-#ifdef CERNLIB_NUMHIPRE
-#undef CERNLIB_NUMHIPRE
-#endif
-#ifndef CERNLIB_NUMRDBLE
-#define CERNLIB_NUMRDBLE
-#endif
-#ifndef CERNLIB_NUMCDBLE
-#define CERNLIB_NUMCDBLE
-#endif
-#ifdef CERNLIB_NUME38
-#undef CERNLIB_NUME38
-#endif
-#ifndef CERNLIB_NUME75
-#define CERNLIB_NUME75
-#endif
-#ifdef CERNLIB_NUME293
-#undef CERNLIB_NUME293
-#endif
-#ifdef CERNLIB_NUME2465
-#undef CERNLIB_NUME2465
-#endif
-#ifdef CERNLIB_NUMD38
-#undef CERNLIB_NUMD38
-#endif
-#ifndef CERNLIB_NUMD75
-#define CERNLIB_NUMD75
-#endif
-#ifdef CERNLIB_NUMD279
-#undef CERNLIB_NUMD279
-#endif
-#ifdef CERNLIB_NUMD2465
-#undef CERNLIB_NUMD2465
-#endif
diff --git a/src/packlib/kernlib/kernnum/obsolete/kernnum/numib1a.h b/src/packlib/kernlib/kernnum/obsolete/kernnum/numib1a.h
deleted file mode 100644
index 6c47d3c..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/kernnum/numib1a.h
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: numib1a.h,v 1.1.1.1 1996/02/15 17:47:58 mclareni Exp $
-*
-* $Log: numib1a.h,v $
-* Revision 1.1.1.1 1996/02/15 17:47:58 mclareni
-* Kernlib
-*
-*
-* This directory was created from kernnum.car patch numib1a
-#ifndef CERNLIB_NUMIB1
-#define CERNLIB_NUMIB1
-#endif
-#ifndef CERNLIB_NUMIB
-#define CERNLIB_NUMIB
-#endif
-#ifndef CERNLIB_NUMFORT
-#define CERNLIB_NUMFORT
-#endif
-#ifndef CERNLIB_NUMIBOPT
-#define CERNLIB_NUMIBOPT
-#endif
diff --git a/src/packlib/kernlib/kernnum/obsolete/kernnum/numib1f.h b/src/packlib/kernlib/kernnum/obsolete/kernnum/numib1f.h
deleted file mode 100644
index fa0a0cb..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/kernnum/numib1f.h
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: numib1f.h,v 1.1.1.1 1996/02/15 17:47:58 mclareni Exp $
-*
-* $Log: numib1f.h,v $
-* Revision 1.1.1.1 1996/02/15 17:47:58 mclareni
-* Kernlib
-*
-*
-* This directory was created from kernnum.car patch numib1f
-#ifndef CERNLIB_NUMIB1
-#define CERNLIB_NUMIB1
-#endif
-#ifndef CERNLIB_NUMIB
-#define CERNLIB_NUMIB
-#endif
-#ifndef CERNLIB_NUMFORT
-#define CERNLIB_NUMFORT
-#endif
-#ifndef CERNLIB_NUMFTOPT
-#define CERNLIB_NUMFTOPT
-#endif
diff --git a/src/packlib/kernlib/kernnum/obsolete/kernnum/numib2a.h b/src/packlib/kernlib/kernnum/obsolete/kernnum/numib2a.h
deleted file mode 100644
index 1cd857e..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/kernnum/numib2a.h
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: numib2a.h,v 1.1.1.1 1996/02/15 17:47:58 mclareni Exp $
-*
-* $Log: numib2a.h,v $
-* Revision 1.1.1.1 1996/02/15 17:47:58 mclareni
-* Kernlib
-*
-*
-* This directory was created from kernnum.car patch numib2a
-#ifndef CERNLIB_NUMIB2
-#define CERNLIB_NUMIB2
-#endif
-#ifndef CERNLIB_NUMIB
-#define CERNLIB_NUMIB
-#endif
-#ifndef CERNLIB_NUMFORT
-#define CERNLIB_NUMFORT
-#endif
-#ifndef CERNLIB_NUMIBOPT
-#define CERNLIB_NUMIBOPT
-#endif
diff --git a/src/packlib/kernlib/kernnum/obsolete/kernnum/numib2f.h b/src/packlib/kernlib/kernnum/obsolete/kernnum/numib2f.h
deleted file mode 100644
index 4d2d7cb..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/kernnum/numib2f.h
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: numib2f.h,v 1.1.1.1 1996/02/15 17:47:58 mclareni Exp $
-*
-* $Log: numib2f.h,v $
-* Revision 1.1.1.1 1996/02/15 17:47:58 mclareni
-* Kernlib
-*
-*
-* This directory was created from kernnum.car patch numib2f
-#ifndef CERNLIB_NUMIB2
-#define CERNLIB_NUMIB2
-#endif
-#ifndef CERNLIB_NUMIB
-#define CERNLIB_NUMIB
-#endif
-#ifndef CERNLIB_NUMFORT
-#define CERNLIB_NUMFORT
-#endif
-#ifndef CERNLIB_NUMFTOPT
-#define CERNLIB_NUMFTOPT
-#endif
diff --git a/src/packlib/kernlib/kernnum/obsolete/kernnum/numibopt.h b/src/packlib/kernlib/kernnum/obsolete/kernnum/numibopt.h
deleted file mode 100644
index f253199..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/kernnum/numibopt.h
+++ /dev/null
@@ -1,36 +0,0 @@
-*
-* $Id: numibopt.h,v 1.1.1.1 1996/02/15 17:47:59 mclareni Exp $
-*
-* $Log: numibopt.h,v $
-* Revision 1.1.1.1 1996/02/15 17:47:59 mclareni
-* Kernlib
-*
-*
-* This directory was created from kernnum.car patch numibopt
-#ifndef CERNLIB_KERNIB
-#define CERNLIB_KERNIB
-#endif
-#ifndef CERNLIB_F002IB
-#define CERNLIB_F002IB
-#endif
-#ifndef CERNLIB_F003IB
-#define CERNLIB_F003IB
-#endif
-#ifndef CERNLIB_F004IB
-#define CERNLIB_F004IB
-#endif
-#ifndef CERNLIB_F011IB
-#define CERNLIB_F011IB
-#endif
-#ifndef CERNLIB_F012IB
-#define CERNLIB_F012IB
-#endif
-#ifndef CERNLIB_G900IB
-#define CERNLIB_G900IB
-#endif
-#ifndef CERNLIB_E208FORT
-#define CERNLIB_E208FORT
-#endif
-#ifndef CERNLIB_F011FORT_TMPRNT
-#define CERNLIB_F011FORT_TMPRNT
-#endif
diff --git a/src/packlib/kernlib/kernnum/obsolete/kernnum/numnd.h b/src/packlib/kernlib/kernnum/obsolete/kernnum/numnd.h
deleted file mode 100644
index 4076f9d..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/kernnum/numnd.h
+++ /dev/null
@@ -1,45 +0,0 @@
-*
-* $Id: numnd.h,v 1.1.1.1 1996/02/15 17:47:58 mclareni Exp $
-*
-* $Log: numnd.h,v $
-* Revision 1.1.1.1 1996/02/15 17:47:58 mclareni
-* Kernlib
-*
-*
-* This directory was created from kernnum.car patch numnd
-#ifndef CERNLIB_NUMLOPRE
-#define CERNLIB_NUMLOPRE
-#endif
-#ifdef CERNLIB_NUMHIPRE
-#undef CERNLIB_NUMHIPRE
-#endif
-#ifndef CERNLIB_NUMRDBLE
-#define CERNLIB_NUMRDBLE
-#endif
-#ifndef CERNLIB_NUMCDBLE
-#define CERNLIB_NUMCDBLE
-#endif
-#ifdef CERNLIB_NUME38
-#undef CERNLIB_NUME38
-#endif
-#ifndef CERNLIB_NUME75
-#define CERNLIB_NUME75
-#endif
-#ifdef CERNLIB_NUME293
-#undef CERNLIB_NUME293
-#endif
-#ifdef CERNLIB_NUME2465
-#undef CERNLIB_NUME2465
-#endif
-#ifdef CERNLIB_NUMD38
-#undef CERNLIB_NUMD38
-#endif
-#ifndef CERNLIB_NUMD75
-#define CERNLIB_NUMD75
-#endif
-#ifdef CERNLIB_NUMD279
-#undef CERNLIB_NUMD279
-#endif
-#ifdef CERNLIB_NUMD2465
-#undef CERNLIB_NUMD2465
-#endif
diff --git a/src/packlib/kernlib/kernnum/obsolete/kernnum/numnd1a.h b/src/packlib/kernlib/kernnum/obsolete/kernnum/numnd1a.h
deleted file mode 100644
index 8b41aea..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/kernnum/numnd1a.h
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: numnd1a.h,v 1.1.1.1 1996/02/15 17:47:58 mclareni Exp $
-*
-* $Log: numnd1a.h,v $
-* Revision 1.1.1.1 1996/02/15 17:47:58 mclareni
-* Kernlib
-*
-*
-* This directory was created from kernnum.car patch numnd1a
-#ifndef CERNLIB_NUMND
-#define CERNLIB_NUMND
-#endif
-#ifndef CERNLIB_NUMFORT
-#define CERNLIB_NUMFORT
-#endif
-#ifndef CERNLIB_NUMNDOPT
-#define CERNLIB_NUMNDOPT
-#endif
diff --git a/src/packlib/kernlib/kernnum/obsolete/kernnum/numndopt.h b/src/packlib/kernlib/kernnum/obsolete/kernnum/numndopt.h
deleted file mode 100644
index 6d3d73d..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/kernnum/numndopt.h
+++ /dev/null
@@ -1,30 +0,0 @@
-*
-* $Id: numndopt.h,v 1.1.1.1 1996/02/15 17:47:58 mclareni Exp $
-*
-* $Log: numndopt.h,v $
-* Revision 1.1.1.1 1996/02/15 17:47:58 mclareni
-* Kernlib
-*
-*
-* This directory was created from kernnum.car patch numndopt
-#ifndef CERNLIB_G900ND
-#define CERNLIB_G900ND
-#endif
-#ifndef CERNLIB_E208FORT
-#define CERNLIB_E208FORT
-#endif
-#ifndef CERNLIB_F002FORT
-#define CERNLIB_F002FORT
-#endif
-#ifndef CERNLIB_F003FORT
-#define CERNLIB_F003FORT
-#endif
-#ifndef CERNLIB_F004FORT
-#define CERNLIB_F004FORT
-#endif
-#ifndef CERNLIB_F011FORT
-#define CERNLIB_F011FORT
-#endif
-#ifndef CERNLIB_F012FORT
-#define CERNLIB_F012FORT
-#endif
diff --git a/src/packlib/kernlib/kernnum/obsolete/kernnum/numuc.h b/src/packlib/kernlib/kernnum/obsolete/kernnum/numuc.h
deleted file mode 100644
index ac6ddef..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/kernnum/numuc.h
+++ /dev/null
@@ -1,45 +0,0 @@
-*
-* $Id: numuc.h,v 1.1.1.1 1996/02/15 17:47:58 mclareni Exp $
-*
-* $Log: numuc.h,v $
-* Revision 1.1.1.1 1996/02/15 17:47:58 mclareni
-* Kernlib
-*
-*
-* This directory was created from kernnum.car patch numuc
-#ifndef CERNLIB_NUMLOPRE
-#define CERNLIB_NUMLOPRE
-#endif
-#ifdef CERNLIB_NUMHIPRE
-#undef CERNLIB_NUMHIPRE
-#endif
-#ifndef CERNLIB_NUMRDBLE
-#define CERNLIB_NUMRDBLE
-#endif
-#ifndef CERNLIB_NUMCDBLE
-#define CERNLIB_NUMCDBLE
-#endif
-#ifndef CERNLIB_NUME38
-#define CERNLIB_NUME38
-#endif
-#ifdef CERNLIB_NUME75
-#undef CERNLIB_NUME75
-#endif
-#ifdef CERNLIB_NUME293
-#undef CERNLIB_NUME293
-#endif
-#ifdef CERNLIB_NUME2465
-#undef CERNLIB_NUME2465
-#endif
-#ifdef CERNLIB_NUMD38
-#undef CERNLIB_NUMD38
-#endif
-#ifdef CERNLIB_NUMD75
-#undef CERNLIB_NUMD75
-#endif
-#ifndef CERNLIB_NUMD279
-#define CERNLIB_NUMD279
-#endif
-#ifdef CERNLIB_NUMD2465
-#undef CERNLIB_NUMD2465
-#endif
diff --git a/src/packlib/kernlib/kernnum/obsolete/kernnum/numuc1f.h b/src/packlib/kernlib/kernnum/obsolete/kernnum/numuc1f.h
deleted file mode 100644
index d6b8872..0000000
--- a/src/packlib/kernlib/kernnum/obsolete/kernnum/numuc1f.h
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: numuc1f.h,v 1.1.1.1 1996/02/15 17:47:58 mclareni Exp $
-*
-* $Log: numuc1f.h,v $
-* Revision 1.1.1.1 1996/02/15 17:47:58 mclareni
-* Kernlib
-*
-*
-* This directory was created from kernnum.car patch numuc1f
-#ifndef CERNLIB_NUMUC
-#define CERNLIB_NUMUC
-#endif
-#ifndef CERNLIB_NUMFORT
-#define CERNLIB_NUMFORT
-#endif
-#ifndef CERNLIB_NUMFTOPT
-#define CERNLIB_NUMFTOPT
-#endif
diff --git a/src/packlib/kernlib/kernnum/test/Imakefile b/src/packlib/kernlib/kernnum/test/Imakefile
deleted file mode 100644
index a42b9d8..0000000
--- a/src/packlib/kernlib/kernnum/test/Imakefile
+++ /dev/null
@@ -1,42 +0,0 @@
-
-#define IHaveSubdirs
-#define PassCDebugFlags
-
-LIBDIRS= numchk0 numchk1 numchk2 numchk3 numchk4
-
-SUBDIRS= $(LIBDIRS)
-
-#ifndef CERNLIB_VAX
-
-EXTRA_INCLUDES=-I$(TOP)$(CURRENT_DIR) -I$(VPATH)
-export EXTRA_INCLUDES
-
-#else
-
-/*export EXTRA_INCLUDES would easier, but VMS gmake does not understand this yet
- Also += is not understood by gmake
- Do not remove any of the \, unless you want to create trouble
- GF (12-Jan-96)
- */
-EXTRA_INCLUDES=-I$(TOP)$(CURRENT_DIR)]
-MAKEFLAGS:=EXTRA_INCLUDES\=\-I$(TOP)$(CURRENT_DIR)]
-#endif
-
-SubdirLibraryTarget(kernnumt,$(LIBDIRS))
-
-DefinePackageLibrary(kernnumt)
-
-#ifdef CERNLIB_HPUX
-EXTRA_LOAD_FLAGS += -lhppa
-#endif
-
-#ifdef CERNLIB_LINUX
-/* With optimisation, the limit for relative precision in single precision is
- wrong, namely ends up to be the one for double precision */
-SpecialFortranObjectRule(test,test,NullParameter,NullParameter)
-#endif
-
-NormalFortranProgramTarget(kernnum,test.o abend.o,$(PACKAGE_LIB),$(PACKAGE_LIB),NullParameter)
-
-TestTarget(kernnum,NullParameter,NullParameter)
-
diff --git a/src/packlib/kernlib/kernnum/test/abend.F b/src/packlib/kernlib/kernnum/test/abend.F
deleted file mode 100644
index 06e8be9..0000000
--- a/src/packlib/kernlib/kernnum/test/abend.F
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: abend.F,v 1.1.1.1 1996/02/15 17:48:36 mclareni Exp $
-*
-* $Log: abend.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:36 mclareni
-* Kernlib
-*
-*
-#include "kernnumt/pilot.h"
- SUBROUTINE ABEND
-#include "kernnumt/sysdat.inc"
- IF(LGFILE .EQ. 0) WRITE(*,1000)
- IF(LGFILE .NE. 0) WRITE(LGFILE,1000)
- RETURN
-1000 FORMAT(31H ABEND ROUTINE HAS BEEN CALLED.)
- END
diff --git a/src/packlib/kernlib/kernnum/test/history/inform.dat b/src/packlib/kernlib/kernnum/test/history/inform.dat
deleted file mode 100644
index f75a940..0000000
--- a/src/packlib/kernlib/kernnum/test/history/inform.dat
+++ /dev/null
@@ -1,39 +0,0 @@
-*
-* $Id: inform.dat,v 1.1.1.1 1996/02/15 17:48:37 mclareni Exp $
-*
-* $Log: inform.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:48:37 mclareni
-* Kernlib
-*
-*
-C This Pam file contains test programs of CERN KERNNUM
-C library routines. Use one of these steering patches:
-C
-C APOLLO for APOLLO
-C CDC CDC 875 NOS/BE with FTN5
-C CONVEX CONVEX
-C CRAY CRAY XMP UNICOS with CFT77
-C DECS DECSTATION 3100 WITH F77
-C HPUX HP/UX 9000 Series
-C IBMVM IBM VM/CMS with VS FORTRAN
-C IBMMVS IBM MVS with SIEMENS FORTRAN 77
-C IBMRT IBM RISC 6000 with AIX and XLF
-C LINUX LINUX system on IBM PC
-C NORD NORSK DATA NORD 500
-C SGI SILICON GRAPHICS IRIS WITH F77
-C SUN SUN SPARC WITH F77
-C UNIVAC UNIVAC 1100
-C VAX DIGITAL EQUIPMENT VAX
-C
-C Installation of KERNCHK has been validated for patches
-C APOLLO, CRAY, IBM, IBMRT and VAX,
-C but for none of the other patches mentioned above.
-C
-C Use steering patch
-C
-C NUMDPRNT to generate diagnostics,
-C NUMEPRNT to test error messages,
-C NUMESTOP to test error stops,
-C NUMOWNCOde to test KERNNUM's system functions,
-C NUMTIME to obtain timing information.
-C
diff --git a/src/packlib/kernlib/kernnum/test/history/v304.dat b/src/packlib/kernlib/kernnum/test/history/v304.dat
deleted file mode 100644
index 62192ab..0000000
--- a/src/packlib/kernlib/kernnum/test/history/v304.dat
+++ /dev/null
@@ -1,9 +0,0 @@
-*
-* $Id: v304.dat,v 1.1.1.1 1996/02/15 17:48:37 mclareni Exp $
-*
-* $Log: v304.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:48:37 mclareni
-* Kernlib
-*
-*
-* Version 3.04 890617
diff --git a/src/packlib/kernlib/kernnum/test/history/v305.dat b/src/packlib/kernlib/kernnum/test/history/v305.dat
deleted file mode 100644
index 7ef4dae..0000000
--- a/src/packlib/kernlib/kernnum/test/history/v305.dat
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: v305.dat,v 1.1.1.1 1996/02/15 17:48:37 mclareni Exp $
-*
-* $Log: v305.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:48:37 mclareni
-* Kernlib
-*
-*
-* Version 3.05 900421 04.00
-C- New patches/flags
-C *KERNCHK: Pilot steering patch
-C NUMDPRNT: Flag to generate diagnostics
-C
-C- Modifications
-C > Editorial changes to testing of error messages
-C > P=NUMCHK0 ,D=STAMP. Use DATIME,DATIMH on available machines
-C > P=NUMCHK3 ,D=CHECK3. Rename FLUSH to KFLUSH to avoid clash in UNIX
-C
diff --git a/src/packlib/kernlib/kernnum/test/history/v306.dat b/src/packlib/kernlib/kernnum/test/history/v306.dat
deleted file mode 100644
index 5ad0893..0000000
--- a/src/packlib/kernlib/kernnum/test/history/v306.dat
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: v306.dat,v 1.1.1.1 1996/02/15 17:48:37 mclareni Exp $
-*
-* $Log: v306.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:48:37 mclareni
-* Kernlib
-*
-*
-* Version 3.06 910320 13.35
-C- Updates to current version:
-C/2 > P=NUMCHK2 ,D=CHECK2 : make 800-section conditional to NUMTIME
-C/1 > P=FKERNCHK : Add HPUX,MIPS,IBMVM,VAXVMS
-C
-C- New patches/flags:
-C SKERNCHK: Source patch
-C FKERNCHK: Flags patch
-C DKERNCHK: Documentation patch segmenting version updates in decks
-C
diff --git a/src/packlib/kernlib/kernnum/test/history/v307.dat b/src/packlib/kernlib/kernnum/test/history/v307.dat
deleted file mode 100644
index d65c6e2..0000000
--- a/src/packlib/kernlib/kernnum/test/history/v307.dat
+++ /dev/null
@@ -1,13 +0,0 @@
-*
-* $Id: v307.dat,v 1.1.1.1 1996/02/15 17:48:37 mclareni Exp $
-*
-* $Log: v307.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:48:37 mclareni
-* Kernlib
-*
-*
-* Version 3.07 910815 16.00
-C- Refresh P=FKERNNUM with new machines
-C
-C- Declare GAMMA,DGAMMA intrinsic functions on IBM RISC 6000
-C
diff --git a/src/packlib/kernlib/kernnum/test/history/v308.dat b/src/packlib/kernlib/kernnum/test/history/v308.dat
deleted file mode 100644
index aededad..0000000
--- a/src/packlib/kernlib/kernnum/test/history/v308.dat
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: v308.dat,v 1.1.1.1 1996/02/15 17:48:37 mclareni Exp $
-*
-* $Log: v308.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:48:37 mclareni
-* Kernlib
-*
-*
-* Version 3.08 920722 2.20
-C- Introduce MSDOS,IPSC flags
-C
-C- New patches/flags:
-C > NUMMS1C
-C
-C- Corrections:
-C > P=NUMCHK0 ,D=CHECK : CRAY floating point numbers were too big
-C
diff --git a/src/packlib/kernlib/kernnum/test/history/v309.dat b/src/packlib/kernlib/kernnum/test/history/v309.dat
deleted file mode 100644
index d452f59..0000000
--- a/src/packlib/kernlib/kernnum/test/history/v309.dat
+++ /dev/null
@@ -1,15 +0,0 @@
-*
-* $Id: v309.dat,v 1.1.1.1 1996/02/15 17:48:37 mclareni Exp $
-*
-* $Log: v309.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:48:37 mclareni
-* Kernlib
-*
-*
-* Version 3.09 921017 0.20
-C
-C GF P=NUMCHK3, D=F003CH SUBROUTINE TMBIL, mod limit for M0 from 200 to 300
-C
-C- Updates to current version:
-C/1 > P=MACHINETYPE New patch replacing FKERNCHK
-C
diff --git a/src/packlib/kernlib/kernnum/test/history/v310.dat b/src/packlib/kernlib/kernnum/test/history/v310.dat
deleted file mode 100644
index fa6ef61..0000000
--- a/src/packlib/kernlib/kernnum/test/history/v310.dat
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: v310.dat,v 1.1.1.1 1996/02/15 17:48:37 mclareni Exp $
-*
-* $Log: v310.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:48:37 mclareni
-* Kernlib
-*
-*
-* Version 3.10 940304 15.00
-C
-C select UNIX for WINNT.
-C
-C Remove test for:
-C C312, C313, C336, C337, D103, G100
-C the routines have been moved to gen/gent/mathlib
-C C204, C308, C341, D106
-C these were deleted from kernlib
-C ( actually only calls to test removed, test code still there)
-C
-C 940819:
-C remove activation of actual test decks.
-C 940831:
-C On DATA NREPPK lines change last value to 0
-C
-C
diff --git a/src/packlib/kernlib/kernnum/test/history/v311.dat b/src/packlib/kernlib/kernnum/test/history/v311.dat
deleted file mode 100644
index 6e33b00..0000000
--- a/src/packlib/kernlib/kernnum/test/history/v311.dat
+++ /dev/null
@@ -1,13 +0,0 @@
-*
-* $Id: v311.dat,v 1.1.1.1 1996/02/15 17:48:37 mclareni Exp $
-*
-* $Log: v311.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:48:37 mclareni
-* Kernlib
-*
-*
-* Version 3.11 950530 14.45
-C
-C Remove test for:
-C C300, C305, D209 GF.
-C
diff --git a/src/packlib/kernlib/kernnum/test/kernnumt/pilot.h b/src/packlib/kernlib/kernnum/test/kernnumt/pilot.h
deleted file mode 100644
index dbb98dc..0000000
--- a/src/packlib/kernlib/kernnum/test/kernnumt/pilot.h
+++ /dev/null
@@ -1,125 +0,0 @@
-#if defined(CERNLIB_IBMRT)
-#ifndef CERNLIB_IBMRS
-#define CERNLIB_IBMRS
-#endif
-#endif
-
-#if defined(CERNLIB_VAXVMS)||defined(CERNLIB_VAXULTRIX)
-#ifndef CERNLIB_VAX
-#define CERNLIB_VAX
-#endif
-#endif
-
-#if defined(CERNLIB_VAX)
-#ifndef CERNLIB_DOUBLE
-#define CERNLIB_DOUBLE
-#endif
-#endif
-
-#if (defined(CERNLIB_UNIX))&&(!defined(CERNLIB_SINGLE))
-#ifndef CERNLIB_DOUBLE
-#define CERNLIB_DOUBLE
-#endif
-#endif
-
-#if defined(CERNLIB_VAXVMS)
-#ifndef CERNLIB_NUMDE
-#define CERNLIB_NUMDE
-#endif
-
-#ifndef CERNLIB_NUMCDBLE
-#define CERNLIB_NUMCDBLE
-#endif
-
-#ifndef CERNLIB_NUMD38
-#define CERNLIB_NUMD38
-#endif
-
-#ifdef CERNLIB_NUMD279
-#undef CERNLIB_NUMD279
-#endif
-#endif
-
-#if defined(CERNLIB_LINUX)
-#ifndef CERNLIB_NUMLN
-#define CERNLIB_NUMLN
-#endif
-#endif
-
-#if defined(CERNLIB_MSDOS)
-#ifndef CERNLIB_NUMMS
-#define CERNLIB_NUMMS
-#endif
-#endif
-
-#if defined(CERNLIB_WINNT)
-#ifndef CERNLIB_NUMNT
-#define CERNLIB_NUMNT
-#endif
-#endif
-
-#if defined(CERNLIB_LINUX)||defined(CERNLIB_MSDOS)
-#ifndef CERNLIB_NUMCDBLE
-#define CERNLIB_NUMCDBLE
-#endif
-#ifdef CERNLIB_NUMD38
-#undef CERNLIB_NUMD38
-#endif
-#ifndef CERNLIB_NUMD279
-#define CERNLIB_NUMD279
-#endif
-#endif
-
-#if (defined(CERNLIB_UNIX))&&(!defined(CERNLIB_MSDOS))&&(!defined(CERNLIB_LINUX))
-#ifndef CERNLIB_NUMAP
-#define CERNLIB_NUMAP
-#endif
-#ifdef CERNLIB_NUMCDBLE
-#undef CERNLIB_NUMCDBLE
-#endif
-#ifndef CERNLIB_NUMD38
-#define CERNLIB_NUMD38
-#endif
-#ifdef CERNLIB_NUMD279
-#undef CERNLIB_NUMD279
-#endif
-#endif
-#ifndef CERNLIB_NUMLOPRE
-#define CERNLIB_NUMLOPRE
-#endif
-#ifdef CERNLIB_NUMHIPRE
-#undef CERNLIB_NUMHIPRE
-#endif
-#ifndef CERNLIB_NUMRDBLE
-#define CERNLIB_NUMRDBLE
-#endif
-#ifndef CERNLIB_NUME38
-#define CERNLIB_NUME38
-#endif
-#ifdef CERNLIB_NUME75
-#undef CERNLIB_NUME75
-#endif
-#ifdef CERNLIB_NUME293
-#undef CERNLIB_NUME293
-#endif
-#ifdef CERNLIB_NUME2465
-#undef CERNLIB_NUME2465
-#endif
-#ifdef CERNLIB_NUMD75
-#undef CERNLIB_NUMD75
-#endif
-#ifdef CERNLIB_NUMD2465
-#undef CERNLIB_NUMD2465
-#endif
-#ifndef CERNLIB_NUMCHK1
-#define CERNLIB_NUMCHK1
-#endif
-#ifndef CERNLIB_NUMCHK2
-#define CERNLIB_NUMCHK2
-#endif
-#ifndef CERNLIB_NUMCHK3
-#define CERNLIB_NUMCHK3
-#endif
-#ifndef CERNLIB_NUMCHK4
-#define CERNLIB_NUMCHK4
-#endif
diff --git a/src/packlib/kernlib/kernnum/test/kernnumt/sysdat.inc b/src/packlib/kernlib/kernnum/test/kernnumt/sysdat.inc
deleted file mode 100644
index 9fa6b66..0000000
--- a/src/packlib/kernlib/kernnum/test/kernnumt/sysdat.inc
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: sysdat.inc,v 1.1.1.1 1996/02/15 17:48:37 mclareni Exp $
-*
-* $Log: sysdat.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:37 mclareni
-* Kernlib
-*
-*
-*
-* sysdat.inc
-*
- PARAMETER(LIMPK = 100)
- PARAMETER(LMTIME = 20)
-#if defined(CERNLIB_NUMHIPRE)
- REAL SEEDIN
-#endif
-#if defined(CERNLIB_NUMLOPRE)
- DOUBLE PRECISION SEEDIN
-#endif
- COMMON /SYSNUM/ SEEDIN
- COMMON /SYSNUM/ LGFILE, IOUNIT
- COMMON /SYSNUM/ RELPRT(2)
- EQUIVALENCE (RELPRT(1),RELPR)
- DOUBLE PRECISION DRANGE
- COMMON /SYSNUM/ DRANGE, ERANGE, MXBINE, MXBIND
- COMMON /SYSNUM/ CHKTIM(0:4), PKTIME(LIMPK)
- COMMON /SYSNUM/ KNTIME
- LOGICAL ERPRNT, ERSTOP
- COMMON /SYSNUM/ ERPRNT, ERSTOP
- CHARACTER*4 NAMEPK, PKNAME
- COMMON /SYSCHR/ NAMEPK, PKNAME(LIMPK)
- CHARACTER*30 SPTIME
- COMMON /SYSCHR/ SPTIME(LMTIME)
-
diff --git a/src/packlib/kernlib/kernnum/test/numchk0/Imakefile b/src/packlib/kernlib/kernnum/test/numchk0/Imakefile
deleted file mode 100644
index 6b3ad90..0000000
--- a/src/packlib/kernlib/kernnum/test/numchk0/Imakefile
+++ /dev/null
@@ -1,3 +0,0 @@
-SRCS_F= c205d3.F c205r3.F cvdist.F dvdist.F rvdist.F stamp.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kernnum/test/numchk0/c205d3.F b/src/packlib/kernlib/kernnum/test/numchk0/c205d3.F
deleted file mode 100644
index a9bdc3a..0000000
--- a/src/packlib/kernlib/kernnum/test/numchk0/c205d3.F
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: c205d3.F,v 1.1.1.1 1996/02/15 17:48:41 mclareni Exp $
-*
-* $Log: c205d3.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:41 mclareni
-* Kernlib
-*
-*
-#include "kernnumt/pilot.h"
-#if defined(CERNLIB_NUMLOPRE)
- FUNCTION C205D3(DX,I)
- IMPLICIT DOUBLE PRECISION (A-H,O-Z)
- C205D3=1
- RETURN
- ENTRY C205D4(DX,I)
- C205D4 = SIN(1/DX)
- RETURN
- END
-#endif
diff --git a/src/packlib/kernlib/kernnum/test/numchk0/c205r3.F b/src/packlib/kernlib/kernnum/test/numchk0/c205r3.F
deleted file mode 100644
index 1d6eddb..0000000
--- a/src/packlib/kernlib/kernnum/test/numchk0/c205r3.F
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: c205r3.F,v 1.1.1.1 1996/02/15 17:48:41 mclareni Exp $
-*
-* $Log: c205r3.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:41 mclareni
-* Kernlib
-*
-*
-#include "kernnumt/pilot.h"
- FUNCTION C205R3(RX,I)
- IMPLICIT REAL (A-H,O-Z)
- C205R3=1
- RETURN
- ENTRY C205R4(RX,I)
- C205R4 = SIN(1/RX)
- RETURN
- END
diff --git a/src/packlib/kernlib/kernnum/test/numchk0/cvdist.F b/src/packlib/kernlib/kernnum/test/numchk0/cvdist.F
deleted file mode 100644
index a175325..0000000
--- a/src/packlib/kernlib/kernnum/test/numchk0/cvdist.F
+++ /dev/null
@@ -1,36 +0,0 @@
-*
-* $Id: cvdist.F,v 1.1.1.1 1996/02/15 17:48:41 mclareni Exp $
-*
-* $Log: cvdist.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:41 mclareni
-* Kernlib
-*
-*
-#include "kernnumt/pilot.h"
- REAL FUNCTION CVDIST(N,X,X2,Y,Y2)
- COMPLEX X(*), X2(*), Y(*), Y2(*), A, B
- DISTF(A,B) = AMAX1(ABS(REAL(A-B)),ABS(AIMAG(A-B)))
- CVDIST = 0.
- IF(N .LE. 0) RETURN
- CVDIST = DISTF(X(1),Y(1))
- IF(N .LE. 1) RETURN
-#if (!defined(CERNLIB_NUMUC))&&(!defined(CERNLIB_NUMCR))&&(!defined(CERNLIB_NUMDE))
- JX = (LOCF(X2) - LOCF(X)) / 2
- JY = (LOCF(Y2) - LOCF(Y)) / 2
-#endif
-#if defined(CERNLIB_NUMUC)||defined(CERNLIB_NUMCR)
- JX = (LOC(X2) - LOC(X)) / 2
- JY = (LOC(Y2) - LOC(Y)) / 2
-#endif
-#if defined(CERNLIB_NUMDE)
- JX = (%LOC(X2) - %LOC(X)) / 8
- JY = (%LOC(Y2) - %LOC(Y)) / 8
-#endif
- LX = 1
- LY = 1
- DO 10 J = 2, N
- LX = LX + JX
- LY = LY + JY
- CVDIST = AMAX1(CVDIST,DISTF(X(LX),Y(LY)))
- 10 CONTINUE
- END
diff --git a/src/packlib/kernlib/kernnum/test/numchk0/dvdist.F b/src/packlib/kernlib/kernnum/test/numchk0/dvdist.F
deleted file mode 100644
index 5fc4b63..0000000
--- a/src/packlib/kernlib/kernnum/test/numchk0/dvdist.F
+++ /dev/null
@@ -1,36 +0,0 @@
-*
-* $Id: dvdist.F,v 1.1.1.1 1996/02/15 17:48:41 mclareni Exp $
-*
-* $Log: dvdist.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:41 mclareni
-* Kernlib
-*
-*
-#include "kernnumt/pilot.h"
- REAL FUNCTION DVDIST(N,X,X2,Y,Y2)
- DOUBLE PRECISION X(*), X2(*), Y(*), Y2(*), A, B
- DISTF(A,B) = ABS(SNGL(A - B))
- DVDIST = 0.
- IF(N .LE. 0) RETURN
- DVDIST = DISTF(X(1),Y(1))
- IF(N .LE. 1) RETURN
-#if (!defined(CERNLIB_NUMUC))&&(!defined(CERNLIB_NUMCR))&&(!defined(CERNLIB_NUMDE))
- JX = (LOCF(X2) - LOCF(X)) / 2
- JY = (LOCF(Y2) - LOCF(Y)) / 2
-#endif
-#if defined(CERNLIB_NUMUC)||defined(CERNLIB_NUMCR)
- JX = (LOC(X2) - LOC(X)) / 2
- JY = (LOC(Y2) - LOC(Y)) / 2
-#endif
-#if defined(CERNLIB_NUMDE)
- JX = (%LOC(X2) - %LOC(X)) / 8
- JY = (%LOC(Y2) - %LOC(Y)) / 8
-#endif
- LX = 1
- LY = 1
- DO 10 J = 2, N
- LX = LX + JX
- LY = LY + JY
- DVDIST = AMAX1(DVDIST,DISTF(X(LX),Y(LY)))
- 10 CONTINUE
- END
diff --git a/src/packlib/kernlib/kernnum/test/numchk0/rvdist.F b/src/packlib/kernlib/kernnum/test/numchk0/rvdist.F
deleted file mode 100644
index 4aec0b9..0000000
--- a/src/packlib/kernlib/kernnum/test/numchk0/rvdist.F
+++ /dev/null
@@ -1,36 +0,0 @@
-*
-* $Id: rvdist.F,v 1.1.1.1 1996/02/15 17:48:41 mclareni Exp $
-*
-* $Log: rvdist.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:41 mclareni
-* Kernlib
-*
-*
-#include "kernnumt/pilot.h"
- REAL FUNCTION RVDIST(N,X,X2,Y,Y2)
- REAL X(*), X2(*), Y(*), Y2(*), A, B
- DISTF(A,B) = ABS(A - B)
- RVDIST = 0.
- IF(N .LE. 0) RETURN
- RVDIST = DISTF(X(1),Y(1))
- IF(N .LE. 1) RETURN
-#if (!defined(CERNLIB_NUMUC))&&(!defined(CERNLIB_NUMCR))&&(!defined(CERNLIB_NUMDE))
- JX = LOCF(X2) - LOCF(X)
- JY = LOCF(Y2) - LOCF(Y)
-#endif
-#if defined(CERNLIB_NUMUC)||defined(CERNLIB_NUMCR)
- JX = LOC(X2) - LOC(X)
- JY = LOC(Y2) - LOC(Y)
-#endif
-#if defined(CERNLIB_NUMDE)
- JX = (%LOC(X2) - %LOC(X)) / 4
- JY = (%LOC(Y2) - %LOC(Y)) / 4
-#endif
- LX = 1
- LY = 1
- DO 10 J = 2, N
- LX = LX + JX
- LY = LY + JY
- RVDIST = AMAX1(RVDIST,DISTF(X(LX),Y(LY)))
- 10 CONTINUE
- END
diff --git a/src/packlib/kernlib/kernnum/test/numchk0/stamp.F b/src/packlib/kernlib/kernnum/test/numchk0/stamp.F
deleted file mode 100644
index a2d4ee0..0000000
--- a/src/packlib/kernlib/kernnum/test/numchk0/stamp.F
+++ /dev/null
@@ -1,79 +0,0 @@
-*
-* $Id: stamp.F,v 1.2 1997/02/04 17:36:55 mclareni Exp $
-*
-* $Log: stamp.F,v $
-* Revision 1.2 1997/02/04 17:36:55 mclareni
-* Merge Winnt and 97a versions
-*
-* Revision 1.1.1.1.2.1 1997/01/21 11:32:18 mclareni
-* All mods for Winnt 96a on winnt branch
-*
-* Revision 1.1.1.1 1996/02/15 17:48:41 mclareni
-* Kernlib
-*
-*
-#include "kernnumt/pilot.h"
- SUBROUTINE STAMP(CDATE,CTIME,CSYST)
- CHARACTER*8 CDATE, CTIME, CSYST, CD, CT, CS
- REAL HD(2), HT(2)
-#if defined(CERNLIB_APOLLO)
- DATA CS / 'APOLLO ' /
-#endif
-#if defined(CERNLIB_NUMCD)
- DATA CS / 'CDC FTN5' /
-#endif
-#if defined(CERNLIB_NUMCR)
- DATA CS / 'CRAY XMP' /
-#endif
-#if defined(CERNLIB_NUMCV)
- DATA CS / 'CONVEX ' /
-#endif
-#if defined(CERNLIB_NUMDE)
- DATA CS / 'DEC VAX ' /
-#endif
-#if defined(CERNLIB_DECS)
- DATA CS / 'DEC 3100' /
-#endif
-#if defined(CERNLIB_NUMIB1)
- DATA CS / 'MVS/F77 ' /
-#endif
-#if defined(CERNLIB_NUMIB2)
- DATA CS / 'VM/CMS ' /
-#endif
-#if defined(CERNLIB_IBMRT)
- DATA CS / 'IBM RIOS' /
-#endif
-#if defined(CERNLIB_NUMND)
- DATA CS / 'NORD 500' /
-#endif
-#if defined(CERNLIB_SGI)
- DATA CS / 'SG Iris ' /
-#endif
-#if defined(CERNLIB_SUN)
- DATA CS / 'SunSparc' /
-#endif
-#if defined(CERNLIB_NUMUC)
- DATA CS / 'UNIVAC ' /
-#endif
-#if defined(CERNLIB_NUMMS)
- DATA CS / 'MS DOS ' /
-#endif
-#if defined(CERNLIB_NUMNT)
- DATA CS / 'Windows ' /
-#endif
-#if defined(CERNLIB_NUMLN)
- DATA CS / 'Linux ' /
-#endif
- CALL DATIMH(HD,HT)
-#if defined(CERNLIB_NUMHIPRE)
- WRITE(CD,'(A8)') HD(1)
- WRITE(CT,'(A8)') HT(1)
-#endif
-#if defined(CERNLIB_NUMLOPRE)
- WRITE(CD,'(2A4)') HD
- WRITE(CT,'(2A4)') HT
-#endif
- CDATE = CD(1:2)//'.'//CD(4:5)//'.'//CD(7:8)
- CTIME = CT(1:2)//':'//CT(4:5)//':'//CT(7:8)
- CSYST = CS
- END
diff --git a/src/packlib/kernlib/kernnum/test/numchk1/Imakefile b/src/packlib/kernlib/kernnum/test/numchk1/Imakefile
deleted file mode 100644
index 0fc416b..0000000
--- a/src/packlib/kernlib/kernnum/test/numchk1/Imakefile
+++ /dev/null
@@ -1,4 +0,0 @@
-SRCS_F= \ @@\
- check1.F e100ch.F e104ch.F e105ch.F e208ch.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kernnum/test/numchk1/check1.F b/src/packlib/kernlib/kernnum/test/numchk1/check1.F
deleted file mode 100644
index acf300d..0000000
--- a/src/packlib/kernlib/kernnum/test/numchk1/check1.F
+++ /dev/null
@@ -1,81 +0,0 @@
-*
-* $Id: check1.F,v 1.1.1.1 1996/02/15 17:48:41 mclareni Exp $
-*
-* $Log: check1.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:41 mclareni
-* Kernlib
-*
-*
-#include "kernnumt/pilot.h"
- SUBROUTINE CHECK1(LWORK,W,NPK,OK,PKN,PKT)
- REAL W(LWORK), PKT(*)
- CHARACTER*4 PKN(*)
- LOGICAL OK, OKPK
-#include "kernnumt/sysdat.inc"
- CHARACTER*4 LISTPK(5), NULL
- INTEGER NREPPK(5)
- DATA LISTPK
- + / 'E100', 'E104', 'E105', 'E208', 'NULL' /
- DATA NULL / 'NULL' /
- DATA NREPPK / 21, 100, 100, 20, 0 /
-* DATA NREPPK / 21, 100, 100, 20, 8, 0 /
- DO 100 NPK = 1, 100
- IF(LISTPK(NPK) .EQ. NULL) GOTO 101
- 100 CONTINUE
- NPK = 0
- RETURN
- 101 NPK = NPK - 1
- OK = .TRUE.
- DO 200 IPK = 1, NPK
- NAMEPK = LISTPK(IPK)
- PKN(IPK)= LISTPK(IPK)
- NREP = NREPPK(IPK)
- OKPK = .FALSE.
- WRITE(*,1000) NAMEPK
- GOTO(01,02,03,04), IPK
- 01 NP=21
- NQ=21
- LP=1
- LQ=LP+NP
- IF(LQ+NP-1 .GT. LWORK) GO TO 900
- CALL E100CH(NP,W(LP),NQ,W(LQ),NREP,OKPK)
- GOTO 90
- 02 NA=15
- NT=125
- LX=1
- LY=LX+NA
- IF(LY+NT-1 .GT. LWORK) GO TO 900
- CALL E104CH(NA,W(LX),NT,W(LY),OKPK)
- GOTO 90
- 03 NA=25
- LA=1
- LB=LA+NA
- LF=LB+NA
- IF(LF+NA-1 .GT. LWORK) GO TO 900
- CALL E105CH(NREP,NA,W(LA),W(LB),W(LF),OKPK)
- GOTO 90
- 04 NDIM = 30
- MDIM = 5
- LX = 1
- LY = LX+NDIM
- LA = LY+NDIM
- LC = LA+MDIM
- IF(LC+MDIM-1 .GT. LWORK) GOTO 900
- CALL E208CH(NDIM,W(LX),W(LY),MDIM,W(LA),W(LC),NREP,OKPK)
- GO TO 90
- 90 IF(.NOT. OKPK) WRITE(*,1012) NAMEPK
- IF( OKPK) WRITE(*,1013) NAMEPK
- OK = OK .AND. OKPK
- CALL TIMEX( PKT(IPK) )
- 200 CONTINUE
- IF(NPK .LT. 1) OK = .FALSE.
- RETURN
- 900 OK = .FALSE.
- WRITE(*,1020)
- RETURN
-1000 FORMAT(// 10H CHECK OF , A4,1H.)
-1012 FORMAT(/ 5X, 24H ????? CHECK OF PACKAGE ,A4,
- + 18H HAS FAILED. ????? )
-1013 FORMAT( 15X, 18H CHECK OF PACKAGE ,A4,12H SUCCESSFUL. )
-1020 FORMAT(// 42H ????? CHECK 3 HAS INSUFFICIENT WORK SPACE )
- END
diff --git a/src/packlib/kernlib/kernnum/test/numchk1/e100ch.F b/src/packlib/kernlib/kernnum/test/numchk1/e100ch.F
deleted file mode 100644
index 63d2263..0000000
--- a/src/packlib/kernlib/kernnum/test/numchk1/e100ch.F
+++ /dev/null
@@ -1,54 +0,0 @@
-*
-* $Id: e100ch.F,v 1.1.1.1 1996/02/15 17:48:41 mclareni Exp $
-*
-* $Log: e100ch.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:41 mclareni
-* Kernlib
-*
-*
-#include "kernnumt/pilot.h"
- SUBROUTINE E100CH(NP,P,NQ,Q,NREP,OK)
- DIMENSION P(NP),Q(NQ)
-#include "kernnumt/sysdat.inc"
- LOGICAL OK,OKT
- OK=.TRUE.
-C
-C COMPUTE INTERPOLATED VALUE OF SIN(PI/6)
-C
- X=4.*ATAN(1.)/6.
- R=SIN(X)
- C
-C CHOOSE NREP X-VALUES AND COMPUTE FUNCTION VALUES
-C
- DO 1 I=1,NREP
- Q(I)=FLOAT(I)/7.
- P(I)=SIN(Q(I))
- 1 CONTINUE
-C
-C COMPUTE INTERPOLATION VALUE FOR DIFFERENT DEGREES N
-C
- DO 2 N=2,NREP
- CALL POLINT(P,Q,N,X,S)
- D=2.*ABS(S-R)
-#if defined(CERNLIB_NUMHIPRE)
- NEXP=MIN0(13,N-1)
-#endif
-#if defined(CERNLIB_NUMLOPRE)
- NEXP=MIN0(5,N-1)
-#endif
- REL=5.*10.**(-NEXP)
- OKT=D .LE.REL
- IF(.NOT. OKT) WRITE(*,100) N,D,REL
- OK=OK .AND. OKT
- 2 CONTINUE
- IF( ERPRNT .AND. ERSTOP) WRITE(*,101)
- IF( ERPRNT .AND. .NOT. ERSTOP) WRITE(*,102)
- IF(.NOT. ERPRNT .AND. ERSTOP) WRITE(*,103)
- N = 1
- CALL POLINT(P,Q,N,X,S)
- RETURN
- 100 FORMAT(/ 25H *** ARITHMETIC ERROR ***, I8,1P,E12.3,1P,E12.3)
- 101 FORMAT(/' ONE ERROR AND ABEND MESSAGE SHOULD NOW FOLLOW ...')
- 102 FORMAT(/' ONE ERROR MESSAGE SHOULD NOW FOLLOW ...')
- 103 FORMAT(/' ONE ABEND MESSAGE SHOULD NOW FOLLOW ...')
- END
diff --git a/src/packlib/kernlib/kernnum/test/numchk1/e104ch.F b/src/packlib/kernlib/kernnum/test/numchk1/e104ch.F
deleted file mode 100644
index e3a0cd5..0000000
--- a/src/packlib/kernlib/kernnum/test/numchk1/e104ch.F
+++ /dev/null
@@ -1,201 +0,0 @@
-*
-* $Id: e104ch.F,v 1.1.1.1 1996/02/15 17:48:41 mclareni Exp $
-*
-* $Log: e104ch.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:41 mclareni
-* Kernlib
-*
-*
-#include "kernnumt/pilot.h"
- SUBROUTINE E104CH(NA,ENT,NT,TABLE,OK)
- DIMENSION FX(2),FXY(2,2),FXYZ(2,2,2)
- DIMENSION ARG(3),NENT(3),ENT(NA),TABLE(NT)
- DIMENSION EX(5),EY(5),EZ(5),X(11),Y(11),Z(11),LXYZ(5,11)
- DIMENSION LX(2),LY(2),LZ(2)
- LOGICAL OK, OKT
-#include "kernnumt/sysdat.inc"
- DATA EX /-0.3, 0.6, 1.1, 1.7, 2.1/
- DATA EY / 0.4, 0.7, 1.2, 1.6, 1.9/
- DATA EZ / 0.1, 0.8, 1.3, 1.5, 2.2/
- DATA X /-0.5,-0.3, 0.1, 0.6, 0.9, 1.1, 1.3, 1.7, 1.9, 2.1,
- + 2.5/
- DATA Y / 0.1, 0.4, 0.6, 0.7, 1.1, 1.2, 1.5, 1.6, 1.7, 1.9,
- + 2.1/
- DATA Z /-0.2, 0.1, 0.5, 0.8, 0.9, 1.3, 1.4, 1.5, 2.1, 2.2,
- + 2.5/
-C
- FCT(A,B,C)=(A**2+B**3+C**4 + 10.) * 0.1
-C
- OK=.TRUE.
- NENT(1)=5
- NENT(2)=5
- DO 10 I=1,5
- DO 10 J=1,3
- 10 LXYZ(I,J)=1
- LXYZ(2,4)=1
- LXYZ(2,5)=1
- DO 15 I=3,5
- DO 15 J=4,5
- 15 LXYZ(I,J)=2
- LXYZ(3,6)=2
- LXYZ(3,7)=2
- DO 20 J=6,9
- 20 LXYZ(4,J)=3
- LXYZ(5,6)=3
- LXYZ(5,7)=3
- DO 25 J=8,11
- 25 LXYZ(5,J)=4
- DO 30 K=1,5
- DO 30 J=1,5
- DO 30 I=1,5
- IJK=I+NENT(1)*(J-1+NENT(2)*(K-1))
- 30 TABLE(IJK)=FCT(EX(I),EY(J),EZ(K))
- DO 700 IEX=1,5
- NENT(1)=IEX
- DO 50 I=1,IEX
- 50 ENT(I)=EX(I)
- NX=2*IEX+1
- NX2=NX-2
- DO 600 IEY=1,5
- NENT(2)=IEY
- DO 60 I=1,IEY
- IIEY=I+IEX
- 60 ENT(IIEY)=EY(I)
- NY=2*IEY+1
- NY2=NY-2
- DO 500 IEZ=1,5
- NENT(3)=IEZ
- DO 70 I=1,IEZ
- IIEZ=IEX+IEY+I
- 70 ENT(IIEZ)=EZ(I)
- NZ=2*IEZ+1
- NZ2=NZ-2
- DO 400 KX=1,NX
- NARG=1
- ARG(NARG)=X(KX)
- LX(1)=LXYZ(IEX,KX)
- LX(2)=LX(1)+1
- DO 110 I=1,2
- FX(I)=TABLE(LX(I))
- 110 CONTINUE
- TREF=E104T1(NX2,ARG(1),EX(LX(1)),FX)
- CALL E104P(NARG,ARG,NENT,ENT,TABLE,TREF,OKT)
- OK = OK .AND. OKT
- DO 300 KY=1,NY
- NARG=2
- ARG(NARG)=Y(KY)
- LY(1)=LXYZ(IEY,KY)
- LY(2)=LY(1)+1
- DO 120 I=1,2
- DO 120 J=1,2
- IJ=LX(I)+NENT(1)*(LY(J)-1)
- FXY(I,J)=TABLE(IJ)
- 120 CONTINUE
- TREF=E104T2(NX2,NY2,ARG(1),ARG(2),EX(LX(1)),
- + EY(LY(1)),FXY)
- CALL E104P(NARG,ARG,NENT,ENT,TABLE,TREF,OKT)
- OK = OK .AND. OKT
- DO 200 KZ=1,NZ
- NARG=3
- ARG(NARG)=Z(KZ)
- LZ(1)=LXYZ(IEZ,KZ)
- LZ(2)=LZ(1)+1
- DO 130 I=1,2
- DO 130 J=1,2
- DO 130 K=1,2
- IJK=LX(I)+NENT(1)*(LY(J)-1+
- + NENT(2)*(LZ(K)-1))
- FXYZ(I,J,K)=TABLE(IJK)
- 130 CONTINUE
- TREF=E104T3(NX2,NY2,NZ2,ARG(1),ARG(2),ARG(3)
- + ,EX(LX(1)),EY(LY(1)),EZ(LZ(1)),FXYZ)
- CALL E104P(NARG,ARG,NENT,ENT,TABLE,TREF,OKT)
- OK = OK .AND. OKT
- 200 CONTINUE
- 300 CONTINUE
- 400 CONTINUE
- 500 CONTINUE
- 600 CONTINUE
- 700 CONTINUE
- IF( ERPRNT .AND. ERSTOP) WRITE(*,801)
- IF( ERPRNT .AND. .NOT. ERSTOP) WRITE(*,802)
- IF(.NOT. ERPRNT .AND. ERSTOP) WRITE(*,803)
- NARG = 0
- T = FINT(NARG,ARG,NENT,ENT,TABLE)
- IF(T .NE. 0.) THEN
- OK = .FALSE.
- WRITE(*,804) NARG, T, 'E104.1'
- ENDIF
- NARG = 6
- T = FINT(NARG,ARG,NENT,ENT,TABLE)
- IF(T .NE. 0.) THEN
- OK = .FALSE.
- WRITE(*,804) NARG, T, 'E104.1'
- ENDIF
- RETURN
- 801 FORMAT(/' TWO ERROR AND ABEND MESSAGES SHOULD NOW FOLLOW ...')
- 802 FORMAT(/' TWO ERROR MESSAGES SHOULD NOW FOLLOW ...')
- 803 FORMAT(/' TWO ABEND MESSAGES SHOULD NOW FOLLOW ...')
- 804 FORMAT(/' ????? TEST OF FINT ... NARG =', I6, ' FINT =', E20.10,
- + ' ERROR CONDITION ', A6, ' NOT DETECTED.')
- END
- SUBROUTINE E104P(NARG,ARG,NENT,ENT,TABLE,TREF,OK)
- DIMENSION ARG(NARG),NENT(NARG),ENT(2),TABLE(2)
-#include "kernnumt/sysdat.inc"
- LOGICAL OK
- DATA MARGIN /100/
- IRESF(RES)=NINT(RES/RELPR)
- TEST=FINT(NARG,ARG,NENT,ENT,TABLE)
- RES=ABS(TREF-TEST)
- IREL=IRESF(RES)
- OK=IREL .LE. MARGIN
- IF(.NOT. OK) WRITE(*,10)NARG,IREL,RES,(ARG(I),I=1,NARG)
- RETURN
- 10 FORMAT(/ 25H *** ARITHMETIC ERROR *** , 2I8,1X,E12.3,3X,
- + 5E12.3)
- END
- FUNCTION E104T1(NX,X,AX,FX)
- DIMENSION AX(2),FX(2)
- E104T1=FX(1)
- IF(NX .EQ. 1) RETURN
- XI=(AX(2)-X)/(AX(2)-AX(1))
- E104T1=XI*FX(1)+(1.-XI)*FX(2)
- RETURN
- END
- FUNCTION E104T2(NX,NY,X,Y,AX,AY,FXY)
- DIMENSION AX(2),AY(2),FXY(2,2),FA(2),FX(2)
- IF(NY .EQ. 1) GO TO 10
- FX(1)=FXY(1,1)
- FX(2)=FXY(2,1)
- FA(1)=E104T1(NX,X,AX,FX)
- FX(1)=FXY(1,2)
- FX(2)=FXY(2,2)
- FA(2)=E104T1(NX,X,AX,FX)
- E104T2=E104T1(NY,Y,AY,FA)
- RETURN
- 10 CONTINUE
- FX(1)=FXY(1,1)
- FX(2)=FXY(2,1)
- E104T2=E104T1(NX,X,AX,FX)
- RETURN
- END
- FUNCTION E104T3(NX,NY,NZ,X,Y,Z,AX,AY,AZ,FXYZ)
- DIMENSION AX(2),AY(2),AZ(2),FXYZ(2,2,2),FXY(2,2),FZ(2)
- IF(NZ .EQ. 1) GO TO 30
- DO 10 I=1,2
- DO 10 J=1,2
- 10 FXY(I,J)=FXYZ(I,J,1)
- FZ(1)=E104T2(NX,NY,X,Y,AX,AY,FXY)
- DO 20 I=1,2
- DO 20 J=1,2
- 20 FXY(I,J)=FXYZ(I,J,2)
- FZ(2)=E104T2(NX,NY,X,Y,AX,AY,FXY)
- E104T3=E104T1(NZ,Z,AZ,FZ)
- RETURN
- 30 CONTINUE
- DO 40 I=1,2
- DO 40 J=1,2
- 40 FXY(I,J)=FXYZ(I,J,1)
- E104T3=E104T2(NX,NY,X,Y,AX,AY,FXY)
- RETURN
- END
diff --git a/src/packlib/kernlib/kernnum/test/numchk1/e105ch.F b/src/packlib/kernlib/kernnum/test/numchk1/e105ch.F
deleted file mode 100644
index 027c5be..0000000
--- a/src/packlib/kernlib/kernnum/test/numchk1/e105ch.F
+++ /dev/null
@@ -1,143 +0,0 @@
-*
-* $Id: e105ch.F,v 1.1.1.1 1996/02/15 17:48:41 mclareni Exp $
-*
-* $Log: e105ch.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:41 mclareni
-* Kernlib
-*
-*
-#include "kernnumt/pilot.h"
- SUBROUTINE E105CH(NREP,NTAB,A,B,F,OKPK)
- LOGICAL OKPK
- DIMENSION A(NTAB),B(NTAB),F(NTAB)
-#include "kernnumt/sysdat.inc"
- DATA MRATIO/50/, MMAX/12/
-C
-C TEST-ROUTINE FOR E105 (DIVDIF).
-C CALLS ... SUBROUTINE DIVDIF.
-C ... CERN ROUTINE POLINT (E100).
-C ... TEST-ROUTINE E105TR.
-C
-C START. SET INCREASING ARGUMENTS IN A, DECREASING ARGUMENTS IN B.
- FBIG=ERANGE/100.
- OKPK=.FALSE.
- IF(NREP.LE.0) RETURN
- EPS=RELPR*FLOAT(MRATIO)
- ITEST=0
- IFAIL=0
- RELMXA=0.
- RELMXB=0.
- JB=NTAB
- DO 1 JA=1,NTAB
- T=ALOG(FLOAT(JA+5))
- A(JA)=T
- B(JB)=T
- JB=JB-1
- 1 CONTINUE
-C
-C TEST DIVDIF BY COMPARING RESULTS WITH TRANSPARENT VERSION E105TR.
- DO 7 M=1,MMAX
- NMAX=M+5
- DO 6 N=2,NMAX
- NPLUS=N+1
-C
-C (SET F ARRAY.)
- RA=RANF()
- RB=RANF()
- DO 2 I=1,NPLUS
- F(I)=SQRT(RA*A(I)+RB*B(I))
- 2 CONTINUE
-C
-C (CHOOSE ARGUMENTS X FROM ALL INTERVALS IN TURN.)
- DO 5 J=1,NPLUS
- DO 4 L=1,2
- IF((J.EQ.1).AND.(L.EQ.1)) GO TO 4
- XA=A(J)
- XB=B(J)
- IF(L.EQ.1) GO TO 3
- T=RANF()
- XA=T*A(J)+(1.-T)*A(J+1)
- XB=T*B(J)+(1.-T)*B(J+1)
- 3 F(1)=-FBIG
- F(N+2)=-FBIG
- YA=DIVDIF(F(2),A(2),N,XA,M)
- YB=DIVDIF(F(2),B(2),N,XB,M)
- F(1)=+FBIG
- F(N+2)=+FBIG
- YAREF=E105TR(F(2),A(2),N,XA,M)
- YBREF=E105TR(F(2),B(2),N,XB,M)
- RELA=ABS((YA-YAREF)/YAREF)
- RELB=ABS((YB-YBREF)/YBREF)
- IF(RELA.GT.EPS) IFAIL=IFAIL+1
- IF(RELB.GT.EPS) IFAIL=IFAIL+1
- ITEST=ITEST+2
- RELMXA=AMAX1(RELA,RELMXA)
- RELMXB=AMAX1(RELB,RELMXB)
- 4 CONTINUE
- 5 CONTINUE
- 6 CONTINUE
- 7 CONTINUE
- OKPK=IFAIL.EQ.0
- IF(OKPK) GOTO 9
- ARATIO=RELMXA/RELPR
- BRATIO=RELMXB/RELPR
- WRITE(*,2000) IFAIL,ITEST,ARATIO,BRATIO
- 9 CONTINUE
- IF( ERPRNT .AND. ERSTOP) WRITE(*,101)
- IF( ERPRNT .AND. .NOT. ERSTOP) WRITE(*,102)
- IF(.NOT. ERPRNT .AND. ERSTOP) WRITE(*,103)
- N = 1000
- M = 0
- Y = DIVDIF(F,A,N,X,M)
- N = 1
- M = 1
- Y = DIVDIF(F,A,N,X,M)
- RETURN
- 101 FORMAT(/' TWO ERROR AND ABEND MESSAGES SHOULD NOW FOLLOW ...')
- 102 FORMAT(/' TWO ERROR MESSAGES SHOULD NOW FOLLOW ...')
- 103 FORMAT(/' TWO ABEND MESSAGES SHOULD NOW FOLLOW ...')
- 2000 FORMAT( // 18H ***** E105CH ... , I5, 13H FAILURES IN , 1P,
- * I5, 8H TESTS.
- * / 5X, 14HRELMXA/RELPR =, E9.1, 5X, 14HRELMXB/RELPR =,
- * E9.1, 1H. )
- END
- FUNCTION E105TR(F,A,N,X,MM)
- DIMENSION A(N),F(N)
- LOGICAL EXTRA
- DATA MMAX/10/
-C
-C TRANSPARENT VERSION OF DIVDIF (E105).
-C
-C START. FIND SUBSCRIPT IX OF X IN ARRAY A.
- IX=0
- EPREV=SIGN(1.0,A(2)-A(1))
- 1 E=X-A(IX+1)
- IF((EPREV.EQ.0).OR.(E*EPREV.LT.0)) GO TO 2
- EPREV=E
- IX=IX+1
- IF(IX.LT.N) GO TO 1
-C
-C CHOOSE INTERPOLATION POINTS.
- 2 M=MIN0(MM,MMAX,N-1)
- NPTS=M+1
- EXTRA=MOD(M,2).EQ.0
- IF(EXTRA) NPTS=NPTS+1
- IFIRST=IX-(NPTS/2)+1
- ILAST=IX+(NPTS/2)
- IF(IFIRST.GE.1) GO TO 3
- IFIRST=1
- EXTRA=.FALSE.
- GO TO 4
- 3 IF(ILAST.LE.N) GO TO 4
- NPTS=M+1
- IFIRST=N-NPTS+1
- EXTRA=.FALSE.
-C
-C PERFORM THE INTERPOLATION, AVERAGING IF EXTRA IS TRUE.
- 4 CALL POLINT(F(IFIRST),A(IFIRST),M+1,X,Y1)
- IF(.NOT.EXTRA) GO TO 5
- CALL POLINT(F(IFIRST+1),A(IFIRST+1),M+1,X,Y2)
- Y1=0.5*(Y1+Y2)
- 5 E105TR=Y1
- RETURN
- END
diff --git a/src/packlib/kernlib/kernnum/test/numchk1/e208ch.F b/src/packlib/kernlib/kernnum/test/numchk1/e208ch.F
deleted file mode 100644
index 1be9456..0000000
--- a/src/packlib/kernlib/kernnum/test/numchk1/e208ch.F
+++ /dev/null
@@ -1,114 +0,0 @@
-*
-* $Id: e208ch.F,v 1.1.1.1 1996/02/15 17:48:41 mclareni Exp $
-*
-* $Log: e208ch.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:41 mclareni
-* Kernlib
-*
-*
-#include "kernnumt/pilot.h"
- SUBROUTINE E208CH(NDIM,X,Y,MDIM,A,C,NREP,OK)
- REAL X(NDIM), Y(NDIM), A(MDIM), C(MDIM)
- LOGICAL OK, OKT
-#include "kernnumt/sysdat.inc"
- DATA IDIM / 20 /
- DATA MARG / 400 /
- IRESF(RES) = NINT(RES/RELPR)
- OK = .TRUE.
- DO 100 IREP = 1, NREP
- DO 50 M = 1, MDIM
- DO 10 I = 1, M
- C(I) = 2.*RANF() - 1.
- 10 CONTINUE
- N = M + INT(FLOAT(NDIM-M+1)*RANF())
- IF(N .GE. 2*M) GOTO 15
- 11 X(1) = 4.*RANF() - 2.
- IF(ABS(X(1)) .LT. 1.) GOTO 11
- Y(1) = C(M)
- IF(N .EQ. 1) GOTO 21
- H = -2.05*X(1) / FLOAT(N-1)
- DO 12 J = 2, N
- X(J) = X(J-1) + H
- Y(J) = C(M)
- 12 CONTINUE
- GOTO 21
- 15 DO 20 J = 1, N
- X(J) = 2.*RANF() - 1.
- Y(J) = C(M)
- 20 CONTINUE
- 21 IF(M .EQ. 1) GOTO 30
- DO 25 I = 2, M
- K = M - I + 1
- DO 24 J = 1, N
- Y(J) = Y(J)*X(J) + C(K)
- 24 CONTINUE
- 25 CONTINUE
- 30 CALL LSQ(N,X,Y,M,A)
- DO 40 I = 1, M
- RES = ABS(C(I)-A(I))
- IREL = IRESF(RES)
- IF(IREL .LE. MARG) GOTO 40
- WRITE(*,1000) IREP, M, N,RES,IREL,MARG
- OK = .FALSE.
- 40 CONTINUE
- IF(M .NE. 2) GOTO 50
- X(1) = 0.
- X(2) = X(1)
- CALL LLSQ(2,X,Y,A(1),A(2),IFAIL)
- OKT = IFAIL .EQ. -1
- IF(.NOT. OKT) WRITE(*,1001) IREP, IFAIL
- OK = OK .AND. OKT
- N = 1 - INT(3.*RANF())
- CALL LLSQ(N,X,Y,A(1),A(2),IFAIL)
- OKT = IFAIL .EQ. -2
- IF(.NOT. OKT) WRITE(*,1002) IREP, N, IFAIL
- OK = OK .AND. OKT
- 50 CONTINUE
- 100 CONTINUE
- IF(ERPRNT .AND. ERSTOP) WRITE(*,1110)
- IF(ERPRNT .AND..NOT. ERSTOP) WRITE(*,1111)
- IF(.NOT. ERPRNT .AND. ERSTOP)WRITE(*,1112)
- M = 1
- N = 0
- CALL LSQ(N,X,Y,M,A)
- IF(M .NE. 0) THEN
- OK = .FALSE.
- WRITE(*,1100) M, 'E208.1', '(N.LT.M)'
- ENDIF
- M = -1
- N = 30
- CALL LSQ(N,X,Y,M,A)
- IF(M .NE. 0) THEN
- OK = .FALSE.
- WRITE(*,1100) M, 'E208.1', '(M.LT.1)'
- ENDIF
- M = IDIM+1
- N = M
- CALL LSQ(N,X,Y,M,A)
- IF(M .NE. 0) THEN
- OK = .FALSE.
- WRITE(*,1100) M, 'E208.1', '(M.LT.IDIM)'
- ENDIF
- M = 5
- N = M
- DO 110 I = 1, M
- X(I) = 3.
- Y(I) = 0.
- 110 CONTINUE
- CALL LSQ(N,X,Y,M,A)
- IF(M .NE. 0) THEN
- OK = .FALSE.
- WRITE(*,1100) M, 'E208.2'
- ENDIF
- RETURN
-1000 FORMAT(10H E208CH ,5HIREP=,I3,4H M=,I2,4H N=,I3,
- + 6H RES=,1P,E10.2,7H IREL=,I6,15H EXCEEDS MARG=,I4)
-1001 FORMAT(10H E208CH ,5HIREP=,I3,8H IFAIL=,I3,8H .NE. -1)
-1002 FORMAT(10H E208CH ,5HIREP=,I3,4H N=,I3,8H IFAIL=,I3,
- + 8H .NE. -2)
-1100 FORMAT( / ' ????? TEST OF LSQ ... M =', I6,
- + ' ERROR CONDITION ', A6, ' NOT DETECTED. ', A11)
-1110 FORMAT(/' FOUR ERROR AND ABEND MESSAGES SHOULD NOW FOLLOW ...')
-1111 FORMAT(/' FOUR ERROR MESSAGES SHOULD NOW FOLLOW ...')
-1112 FORMAT(/' FOUR ABEND MESSAGES SHOULD NOW FOLLOW ...')
- END
diff --git a/src/packlib/kernlib/kernnum/test/numchk2/Imakefile b/src/packlib/kernlib/kernnum/test/numchk2/Imakefile
deleted file mode 100644
index 56a6f6e..0000000
--- a/src/packlib/kernlib/kernnum/test/numchk2/Imakefile
+++ /dev/null
@@ -1,7 +0,0 @@
-SRCS_F= \ @@\
- check2.F d509ch.F d509f.F d703ch.F d704ch.F \ @@\
- d704tm.F f010c.F f010ch.F f010d.F f010mc.F f010md.F f010mr.F \ @@\
- f010r.F f406ch.F f406rd.F f406rr.F f406sd.F f406sr.F f406zd.F \ @@\
- f406zr.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kernnum/test/numchk2/check2.F b/src/packlib/kernlib/kernnum/test/numchk2/check2.F
deleted file mode 100644
index b7cd727..0000000
--- a/src/packlib/kernlib/kernnum/test/numchk2/check2.F
+++ /dev/null
@@ -1,110 +0,0 @@
-*
-* $Id: check2.F,v 1.1.1.1 1996/02/15 17:48:41 mclareni Exp $
-*
-* $Log: check2.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:41 mclareni
-* Kernlib
-*
-*
-#include "kernnumt/pilot.h"
- SUBROUTINE CHECK2(LWORK,W,NPK,OK,PKN,PKT)
- REAL W(LWORK), PKT(*)
- LOGICAL OK, OKPK
- CHARACTER*4 PKN(*)
-#include "kernnumt/sysdat.inc"
- CHARACTER*4 LISTPK(6), NULL
- INTEGER NREPPK(6)
- DATA LISTPK
- + / 'D509', 'D703', 'D704', 'F010', 'F406',
- + 'NULL'/
-* + / 'C204', 'C300', 'D103', 'D106', 'D209',
-* + 'D509', 'D703', 'D704', 'F010', 'F406',
-* + 'NULL' /
- DATA NULL / 'NULL' /
- DATA NREPPK / 5*1, 0 /
-* DATA NREPPK / 10*1, 0 /
- DO 100 NPK = 1, 100
- IF(LISTPK(NPK) .EQ. NULL) GOTO 101
- 100 CONTINUE
- NPK = 0
- RETURN
- 101 NPK = NPK - 1
- OK = .TRUE.
- DO 200 IPK = 1, NPK
- NAMEPK = LISTPK(IPK)
- PKN(IPK)= LISTPK(IPK)
- NREP = NREPPK(IPK)
- OKPK = .FALSE.
- WRITE(*,1000) NAMEPK
- GOTO(01,02,03,04,05), IPK
- 01 CALL D509CH(NREP,OKPK)
- GOTO 90
- 02 NY = 1026
- IF(NY .GT. LWORK) GOTO 900
- CALL D703CH(NY,W,NREP,OKPK)
- GOTO 90
- 03 NDIM = 256
- LIMT = 4*NDIM
- IF(LIMT .GT. LWORK) GOTO 900
- CALL D704CH(NDIM,W(1),W(2*NDIM+1),NREP,OKPK)
-#if defined(CERNLIB_NUMTIME)
- KNT = 4
- NDIM = 4096
- LIMT = 2*NDIM
- IF(LIMT .GT. LWORK) GOTO 800
- CALL D704TM(KNT,NDIM,W(1))
-#endif
- GOTO 90
- 04 NMAX=10
- KMAX=3
- NA=2*(NMAX**2)
- NB=2*NMAX*KMAX
- NW=2*NMAX
- NR=NMAX
- LA=1
- LAR=LA+NA
- LB=LAR+NA
- LBR=LB+NB
- LW=LBR+NB
- LR=LW+NW
- LAST=LR+NR
- IF(LAST-1.GT.LWORK) GOTO 900
- CALL F010CH(NREP,NMAX,KMAX,W(LA),W(LAR),W(LB),W(LBR),W(LW),
- + W(LR),OKPK)
- GOTO 90
- 05 NMAX=10
- KMAX=3
- NA=2*NMAX**2
- NABAND=2*NMAX*(NMAX+1)
- NB=2*NMAX*KMAX
- LA=1
- LABAND=LA+NA
- LB=LABAND+NABAND
- LBR=LB+NB
- LAST=LBR+NB
- IF(LAST-1.GT.LWORK) GO TO 900
- CALL F406CH(NREP,NMAX,KMAX,W(LA),W(LABAND),W(LB),W(LBR),
- + OKPK)
- GOTO 90
- 90 IF(.NOT. OKPK) WRITE(*,1012) NAMEPK
- IF( OKPK) WRITE(*,1013) NAMEPK
- OK = OK .AND. OKPK
- CALL TIMEX( PKT(IPK) )
- 200 CONTINUE
- IF(NPK .LT. 1) OK = .FALSE.
- RETURN
-#if defined(CERNLIB_NUMTIME)
- 800 OK = .FALSE.
- WRITE(*,1020)
- RETURN
-#endif
- 900 OK = .FALSE.
- WRITE(*,1021)
- RETURN
-1000 FORMAT(// 10H CHECK OF , A4,1H.)
-1012 FORMAT(/ 5X, 24H ????? CHECK OF PACKAGE ,A4,
- + 18H HAS FAILED. ????? )
-1013 FORMAT( 15X, 18H CHECK OF PACKAGE ,A4,12H SUCCESSFUL. )
-1020 FORMAT(// 41H ????? TIMING HAS INSUFFICIENT WORK SPACE )
-1021 FORMAT(// 42H ????? CHECK 2 HAS INSUFFICIENT WORK SPACE )
- END
diff --git a/src/packlib/kernlib/kernnum/test/numchk2/d509ch.F b/src/packlib/kernlib/kernnum/test/numchk2/d509ch.F
deleted file mode 100644
index 6004bbd..0000000
--- a/src/packlib/kernlib/kernnum/test/numchk2/d509ch.F
+++ /dev/null
@@ -1,37 +0,0 @@
-*
-* $Id: d509ch.F,v 1.1.1.1 1996/02/15 17:48:41 mclareni Exp $
-*
-* $Log: d509ch.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:41 mclareni
-* Kernlib
-*
-*
-#include "kernnumt/pilot.h"
- SUBROUTINE D509CH(NREP,OK)
- EXTERNAL D509F
-#include "kernnumt/sysdat.inc"
- LOGICAL OK
- OK=.TRUE.
- DO 10 KREP = 1, NREP
- MAXFUN=100
- X=2.
- EPSI=0.01
- STEP=0.1
- A=0.
- B=2.
- CALL MINVAR(X,Y,R,EPSI,STEP,MAXFUN,A,B,D509F)
- D=ABS(X-1.)+ABS(Y-1.)
- OK=D.LE.0.1 .AND. OK
- IF(.NOT.OK) WRITE(*,100)
- 10 CONTINUE
- IF( ERPRNT .AND. ERSTOP) WRITE(*,101)
- IF( ERPRNT .AND. .NOT. ERSTOP) WRITE(*,102)
- IF(.NOT. ERPRNT .AND. ERSTOP) WRITE(*,103)
- MAXFUN = 2
- CALL MINVAR(X,Y,R,EPSI,STEP,MAXFUN,A,B,D509F)
- RETURN
- 100 FORMAT(24H D509CH ARITHMETIC ERROR,4H X= ,G30.15,4H Y= ,G30.15)
- 101 FORMAT(/' ONE ERROR AND ABEND MESSAGE SHOULD NOW FOLLOW ...')
- 102 FORMAT(/' ONE ERROR MESSAGE SHOULD NOW FOLLOW ...')
- 103 FORMAT(/' ONE ABEND MESSAGE SHOULD NOW FOLLOW ...')
- END
diff --git a/src/packlib/kernlib/kernnum/test/numchk2/d509f.F b/src/packlib/kernlib/kernnum/test/numchk2/d509f.F
deleted file mode 100644
index b03fbb4..0000000
--- a/src/packlib/kernlib/kernnum/test/numchk2/d509f.F
+++ /dev/null
@@ -1,13 +0,0 @@
-*
-* $Id: d509f.F,v 1.1.1.1 1996/02/15 17:48:42 mclareni Exp $
-*
-* $Log: d509f.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:42 mclareni
-* Kernlib
-*
-*
-#include "kernnumt/pilot.h"
- FUNCTION D509F(X,I)
- D509F=(X*X-1.)**2+1.
- RETURN
- END
diff --git a/src/packlib/kernlib/kernnum/test/numchk2/d703ch.F b/src/packlib/kernlib/kernnum/test/numchk2/d703ch.F
deleted file mode 100644
index b3d0bd1..0000000
--- a/src/packlib/kernlib/kernnum/test/numchk2/d703ch.F
+++ /dev/null
@@ -1,42 +0,0 @@
-*
-* $Id: d703ch.F,v 1.1.1.1 1996/02/15 17:48:42 mclareni Exp $
-*
-* $Log: d703ch.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:42 mclareni
-* Kernlib
-*
-*
-#include "kernnumt/pilot.h"
- SUBROUTINE D703CH(NDIM,Y,NREP,OK)
- REAL Y(NDIM)
- LOGICAL OK
-#include "kernnumt/sysdat.inc"
- DATA MARG / 500 /
- IRESF(RES) = NINT(RES/RELPR)
- OK = .TRUE.
- DO 50 IREP = 1, NREP
- DO 40 M = 1, 9
- N = 2**M
- IF(N .GT. NDIM-2) GOTO 900
- DO 10 I = 1, N
- Y(I) = FLOAT(I+100)
- 10 CONTINUE
- CALL RFFT(Y,-M)
- CALL RFFT(Y,M)
- DO 20 I = 1, N
- IREL = IRESF(ABS(Y(I)-FLOAT(I+100)) / FLOAT(I+100))
- IF(IREL .LE. MARG) GOTO 20
- WRITE(*,1000) I, IREL, MARG
- OK = .FALSE.
- 20 CONTINUE
- 40 CONTINUE
- 50 CONTINUE
- RETURN
- 900 WRITE(*,9000) NDIM
- OK = .FALSE.
- RETURN
-1000 FORMAT(37H ***** SUBROUTINE RFFT (D703) ... I =,I5,3X,
- + 7HIREL =,I8,18H EXCEEDS MARGIN =,I6)
-9000 FORMAT( / 33H ***** SUBROUTINE RFFT (D703) ...,5X,
- + 26HSPACE AVAILABLE ... NDIM =,I6,16H IS INSUFFICIENT)
- END
diff --git a/src/packlib/kernlib/kernnum/test/numchk2/d704ch.F b/src/packlib/kernlib/kernnum/test/numchk2/d704ch.F
deleted file mode 100644
index 81b3edd..0000000
--- a/src/packlib/kernlib/kernnum/test/numchk2/d704ch.F
+++ /dev/null
@@ -1,47 +0,0 @@
-*
-* $Id: d704ch.F,v 1.1.1.1 1996/02/15 17:48:42 mclareni Exp $
-*
-* $Log: d704ch.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:42 mclareni
-* Kernlib
-*
-*
-#include "kernnumt/pilot.h"
- SUBROUTINE D704CH(NDIM,Y,Z,NREP,OK)
- COMPLEX Y(NDIM), Z(NDIM), CS, C1, C2
- LOGICAL OK
-#include "kernnumt/sysdat.inc"
- DATA C1, C2 / (-10.,-10.), (+10.,+10.) /
- DATA MARG / 2000 /
- IRESF(RES) = NINT(RES/RELPR)
- OK = .TRUE.
- DO 50 IREP = 1, NREP
- DO 40 M = 1, 8
- N = 2**M
- IF(N .GT. NDIM) GOTO 900
- CALL CVRAN(N,C1,C2,Z(1),Z(2))
- CALL CVCPY(N,Z(1),Z(2),Y(1),Y(2))
- CALL CFFT(Y,-M)
- CALL CFFT(Y,M)
- CS = 1./FLOAT(N)
- CALL CVSCL(N,CS,Y(1),Y(2),Y(1),Y(2))
- DO 20 I = 1, N
- IREL = IRESF(CABS((Y(I)-Z(I))/Z(I)))
- IF(IREL .LE. MARG) GOTO 20
- WRITE(*,1000) I, IREL, MARG
- OK = .FALSE.
- 20 CONTINUE
- 40 CONTINUE
- 50 CONTINUE
- RETURN
-
- 900 WRITE(*,9000) NDIM
- OK = .FALSE.
- RETURN
-1000 FORMAT(37H ***** SUBROUTINE CFFT (D704) ... I =,I5,3X,
- + 7HIREL =,I8,18H EXCEEDS MARGIN =,I6)
-9000 FORMAT( / 33H ***** SUBROUTINE CFFT (D704) ...,5X,
- + 26HSPACE AVAILABLE ... NDIM =,I6,16H IS INSUFFICIENT)
- END
-#if defined(CERNLIB_NUMTIME)
-#endif
diff --git a/src/packlib/kernlib/kernnum/test/numchk2/d704tm.F b/src/packlib/kernlib/kernnum/test/numchk2/d704tm.F
deleted file mode 100644
index e4a0ece..0000000
--- a/src/packlib/kernlib/kernnum/test/numchk2/d704tm.F
+++ /dev/null
@@ -1,48 +0,0 @@
-*
-* $Id: d704tm.F,v 1.1.1.1 1996/02/15 17:48:42 mclareni Exp $
-*
-* $Log: d704tm.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:42 mclareni
-* Kernlib
-*
-*
-#include "kernnumt/pilot.h"
- SUBROUTINE D704TM(KNT,NDIM,Y)
- COMPLEX Y(NDIM), C1, C2
-#include "kernnumt/sysdat.inc"
- DATA C1, C2 / (-10.,-10.), (+10.,+10.) /
-
- KOUNT = MAX(KNT,1)
- IF( 2**6 .GT. NDIM ) THEN
- WRITE(*,8001)
- ELSE
- DO 20 M = 16, 6, -2
- N = 2**M
- IF(N .GT. NDIM) GOTO 20
- IF(KNTIME .GE. LMTIME) GOTO 80
- CALL TIMEX(T0)
- DO 10 I = 1, KOUNT
- CALL CVRAN(N,C1,C2,Y(1),Y(2))
- 10 CONTINUE
- CALL TIMEX(T1)
- T = (T1-T0) / FLOAT(KOUNT)
- CALL TIMEX(T0)
- DO 11 I = 1, KOUNT
- CALL CVRAN(N,C1,C2,Y(1),Y(2))
- CALL CFFT(Y,M)
- 11 CONTINUE
- CALL TIMEX(T1)
- T = (T1-T0) / FLOAT(KOUNT) - T
- KNTIME = KNTIME + 1
- WRITE( SPTIME(KNTIME), 8000 ) N, T
- KOUNT = 4*KOUNT
- 20 CONTINUE
- ENDIF
- RETURN
-
- 80 WRITE(*,8001)
- RETURN
-
-8000 FORMAT(15HD704 CFFT N =,I5,1PE10.3)
-8001 FORMAT( / 30H SPACE FOR TIMING INSUFFICIENT)
- END
diff --git a/src/packlib/kernlib/kernnum/test/numchk2/f010c.F b/src/packlib/kernlib/kernnum/test/numchk2/f010c.F
deleted file mode 100644
index 0e6bbd9..0000000
--- a/src/packlib/kernlib/kernnum/test/numchk2/f010c.F
+++ /dev/null
@@ -1,87 +0,0 @@
-*
-* $Id: f010c.F,v 1.1.1.1 1996/02/15 17:48:42 mclareni Exp $
-*
-* $Log: f010c.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:42 mclareni
-* Kernlib
-*
-*
-#include "kernnumt/pilot.h"
- SUBROUTINE F010C(N,K,KMAX,IDIM,A,AREF,B,BREF,W,R,RESID)
- REAL R(N)
- COMPLEX U,S,A,AREF,B,BREF,W
- DIMENSION A(IDIM,N),AREF(IDIM,N),B(IDIM,2),BREF(IDIM,2),W(N)
-C
-C COMPLEX VERSION OF TEST FOR F010.
-C SETS RESID EQUAL TO THE LARGEST RESIDUAL FOUND WHEN INVERTING A
-C MATRIX OR SOLVING A LINEAR SYSTEM.
-C
-C N ORDER OF COEFFICIENT MATRIX.
-C K CURRENT NUMBER OF RIGHT-HAND SIDES.
-C KMAX MAXIMUM NUMBER OF RIGHT-HAND SIDES.
-C IDIM FIRST DIMENSION OF THE 2D ARRAYS.
-C A,AREF (COMPLEX) 2D ARRAYS WITH AT LEAST N COLUMNS.
-C B,BREF (COMPLEX) 2D ARRAYS WITH AT LEAST KMAX COLUMNS.
-C W (COMPLEX) 1D ARRAY WITH AT LEAST N COLUMNS.
-C R (REAL) 1D ARRAY WITH AT LEAST N COLUMNS.
-C RESID (REAL) OUTPUT PARAMETER.
-C
-C CALLS ... ALL COMPLEX ENTRIES IN F010.
-C ... CERN PACKAGES F002 AND F003.
-C ... TEST-ROUTINE F010MC.
-C
-C START.
- IF(K.EQ.0) GO TO 4
-C
-C SET COPIES OF A RANDOM DIAGONALLY-DOMINANT SQUARE MATRIX IN A AND
-C AREF.
- U=1.
- S=FLOAT(N)
- CALL CMRAN(N,N,-U,U,A,A(1,2),A(2,1))
- CALL CVSET(N,S,W(1),W(2))
- CALL CVADD(N,A(1,1),A(2,2),W(1),W(2),A(1,1),A(2,2))
- CALL CMCPY(N,N,A,A(1,2),A(2,1),AREF,AREF(1,2),AREF(2,1))
-C
-C SET COPIES OF A RANDOM RIGHT-HAND SIDE MATRIX IN B AND BREF.
- CALL CMRAN(N,KMAX,-U,U,B,B(1,2),B(2,1))
- CALL CMCPY(N,KMAX,B,B(1,2),B(2,1),BREF,BREF(1,2),BREF(2,1))
-C
-C CALL F010 TO REPLACE A BY AINV AND B BY AINV*B. COMPUTE RESIDUALS.
- RESID=0.
- DO 3 ISUB=1,3
- CALL CMCPY(N,N,AREF,AREF(1,2),AREF(2,1),A,A(1,2),A(2,1))
- CALL CMCPY(N,KMAX,BREF,BREF(1,2),BREF(2,1),B,B(1,2),B(2,1))
- IF(ISUB.EQ.1) CALL CEQINV(N,A,IDIM,R,IFAIL,K,B)
- IF(ISUB.EQ.2) CALL CINV(N,A,IDIM,R,IFAIL)
- IF(ISUB.EQ.3) CALL CEQN(N,A,IDIM,R,IFAIL,K,B)
- RESINV=0.
- RESEQN=0.
- IF(ISUB.EQ.3) GO TO 1
-C (MAXIMUM RESIDUAL FOR INVERSION.)
- CALL CMMLT(N,N,N,AREF,AREF(1,2),AREF(2,1),
- * A,A(1,2),A(2,1),A,A(1,2),A(2,1),W)
- S=1.
- CALL CVSET(N,S,W(1),W(2))
- CALL CVSUB(N,A(1,1),A(2,2),W(1),W(2),A(1,1),A(2,2))
- RESINV=F010MC(N,N,IDIM,A)
- 1 IF(ISUB.EQ.2) GO TO 2
-C (MAXIMUM RESIDUAL FOR LINEAR SYSTEM.)
- IF(K.NE.0) CALL CMMLT(N,N,K,AREF,AREF(1,2),AREF(2,1),
- * B,B(1,2),B(2,1),B,B(1,2),B(2,1),W)
- CALL CMSUB(N,KMAX,B,B(1,2),B(2,1),
- * BREF,BREF(1,2),BREF(2,1),B,B(1,2),B(2,1))
- RESEQN=F010MC(N,K,IDIM,B)
-C (FINAL RESIDUAL.)
- 2 RESID=AMAX1(RESID,RESINV,RESEQN)
- IF(IFAIL.NE.0) RESID=99999.
- 3 CONTINUE
- RETURN
-C
-C TEST IFAIL FLAG.
- 4 S=1.
- CALL CMSET(2,2,S,A,A(1,2),A(2,1))
- CALL CINV(2,A,IDIM,R,IFAIL)
- RESID=0.
- IF(IFAIL.NE.-1) RESID=99999.
- RETURN
- END
diff --git a/src/packlib/kernlib/kernnum/test/numchk2/f010ch.F b/src/packlib/kernlib/kernnum/test/numchk2/f010ch.F
deleted file mode 100644
index 2995f2b..0000000
--- a/src/packlib/kernlib/kernnum/test/numchk2/f010ch.F
+++ /dev/null
@@ -1,93 +0,0 @@
-*
-* $Id: f010ch.F,v 1.1.1.1 1996/02/15 17:48:42 mclareni Exp $
-*
-* $Log: f010ch.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:42 mclareni
-* Kernlib
-*
-*
-#include "kernnumt/pilot.h"
- SUBROUTINE F010CH(NREP,NMAX,KMAX,A,AREF,B,BREF,W,R,OKPK)
- LOGICAL OKPK,OK
- DIMENSION A(2),AREF(2),B(2),BREF(2),W(2),R(2)
- DIMENSION EPS(3),RATMAX(3),MRATIO(3)
- EXTERNAL REQN,RINV,REQINV,DEQN,DINV,DEQINV,CEQN,CINV,CEQINV
- EXTERNAL RVCPY,RVDIST,DVCPY,DVDIST,CVCPY,CVDIST
-#include "kernnumt/sysdat.inc"
- REAL RR(6), RD(6), RC(6)
- DOUBLE PRECISION DR(3)
- COMPLEX CR(3)
- EQUIVALENCE (RD(1),DR(1)), (RC(1),CR(1))
- DATA RR / 3.333E20, 0, 4.444E20, 0, 5.555E20, 0 /
- DATA DR / 3.333D20, 4.444D20, 5.555D20 /
- DATA CR / (3.333E20,3.33),(4.444E20,4.44),(5.555E20,5.55)/
- DATA MRATIO/20,50,20/
-C
-C TEST-ROUTINE FOR F010 ($EQN, $INV, $EQINV, WHERE $=R,D,C.)
-C
-C THE NUMBER OF ELEMENTS IN THE ARRAYS SHOULD NOT BE LESS THAN
-C A,AREF ... 2*(NMAX**2)
-C B,BREF ... 2*NMAX*KMAX
-C W ... 2*NMAX
-C R ... NMAX
-C
-C CALLS ... ALL SUBROUTINES IN LIBRARY PACKAGE F010.
-C ... CERN PACKAGES F002 AND F003.
-C ... TEST-ROUTINES F010MG, F010$, F010M$ ($=R,D,C).
-C ... RVDIST, DVDIST, CVDIST (CHECK3)
-C
-C START.
- OKPK=.FALSE.
- IF(NREP.LE.0) RETURN
- IDIM=NMAX
- KMIN=0
- EPS(1)=RELPRT(1)
- EPS(2)=RELPRT(2)
- EPS(3)=RELPRT(1)
- ITEST=0
- IFAIL=0
- RATMAX(1)=0.
- RATMAX(2)=0.
- RATMAX(3)=0.
- DO 4 JREP=1,NREP
- DO 3 N=1,NMAX
- DO 2 K=KMIN,KMAX
- DO 1 ITYPE=1,3
- IF(ITYPE.EQ.1)
- * CALL F010R(N,K,KMAX,IDIM,A,AREF,B,BREF,W,R,RESID)
- IF(ITYPE.EQ.2)
- * CALL F010D(N,K,KMAX,IDIM,A,AREF,B,BREF,W,R,RESID)
- IF(ITYPE.EQ.3)
- * CALL F010C(N,K,KMAX,IDIM,A,AREF,B,BREF,W,R,RESID)
- RATIO=RESID/EPS(ITYPE)
- IF(RATIO.GE.FLOAT(MRATIO(ITYPE))) IFAIL=IFAIL+1
- ITEST=ITEST+1
- RATMAX(ITYPE)=AMAX1(RATMAX(ITYPE),RATIO)
- 1 CONTINUE
- 2 CONTINUE
- 3 CONTINUE
- 4 CONTINUE
- OKPK=IFAIL.EQ.0
- IF(.NOT.OKPK) WRITE(*,2000) IFAIL,ITEST,(RATMAX(I),I=1,3)
-#if !defined(CERNLIB_NUMDE)
- IF( ERPRNT .AND. ERSTOP) WRITE(*,1001)
- IF( ERPRNT .AND. .NOT. ERSTOP) WRITE(*,1002)
- IF(.NOT. ERPRNT .AND. ERSTOP) WRITE(*,1003)
- CALL F010MG(A,R,B,OK,REQN,RINV,REQINV,RVCPY,RVDIST,RR)
- OKPK = OKPK.AND.OK
- CALL F010MG(A,R,B,OK,DEQN,DINV,DEQINV,DVCPY,DVDIST,RD)
- OKPK = OKPK.AND.OK
- CALL F010MG(A,R,B,OK,CEQN,CINV,CEQINV,CVCPY,CVDIST,RC)
- OKPK = OKPK.AND.OK
-#endif
- RETURN
-#if !defined(CERNLIB_NUMDE)
- 1001 FORMAT(/' 39 ERROR AND ABEND MESSAGES SHOULD NOW FOLLOW ...')
- 1002 FORMAT(/' 39 ERROR MESSAGES SHOULD NOW FOLLOW ...')
- 1003 FORMAT(/' 39 ABEND MESSAGES SHOULD NOW FOLLOW ...')
-#endif
- 2000 FORMAT( // 18H ***** F010CH ... , I4, 13H FAILURES IN , 1P,
- * I4, 8H TESTS.
- * / 5X, 14HRESMAX/RELPR =, E9.1, 5H (R),, E9.1, 5H (D),,
- * E9.1, 5H (C). )
- END
diff --git a/src/packlib/kernlib/kernnum/test/numchk2/f010d.F b/src/packlib/kernlib/kernnum/test/numchk2/f010d.F
deleted file mode 100644
index e40319e..0000000
--- a/src/packlib/kernlib/kernnum/test/numchk2/f010d.F
+++ /dev/null
@@ -1,87 +0,0 @@
-*
-* $Id: f010d.F,v 1.1.1.1 1996/02/15 17:48:42 mclareni Exp $
-*
-* $Log: f010d.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:42 mclareni
-* Kernlib
-*
-*
-#include "kernnumt/pilot.h"
- SUBROUTINE F010D(N,K,KMAX,IDIM,A,AREF,B,BREF,W,R,RESID)
- REAL R(N)
- DOUBLE PRECISION U,S,A,AREF,B,BREF,W
- DIMENSION A(IDIM,N),AREF(IDIM,N),B(IDIM,2),BREF(IDIM,2),W(N)
-C
-C DOUBLE PRECISION VERSION OF TEST FOR F010.
-C SETS RESID EQUAL TO THE LARGEST RESIDUAL FOUND WHEN INVERTING A
-C MATRIX OR SOLVING A LINEAR SYSTEM.
-C
-C N ORDER OF COEFFICIENT MATRIX.
-C K CURRENT NUMBER OF RIGHT-HAND SIDES.
-C KMAX MAXIMUM NUMBER OF RIGHT-HAND SIDES.
-C IDIM FIRST DIMENSION OF THE 2D ARRAYS.
-C A,AREF (DOUBLE PRECISION) 2D ARRAYS WITH AT LEAST N COLUMNS.
-C B,BREF (DOUBLE PRECISION) 2D ARRAYS WITH AT LEAST KMAX COLUMNS.
-C W (DOUBLE PRECISION) 1D ARRAY WITH AT LEAST N COLUMNS.
-C R (REAL) 1D ARRAY WITH AT LEAST N COLUMNS.
-C RESID (REAL) OUTPUT PARAMETER.
-C
-C CALLS ... ALL DOUBLE PRECISION ENTRIES IN F010.
-C ... CERN PACKAGES F002 AND F003.
-C ... TEST-ROUTINE F010MD.
-C
-C START.
- IF(K.EQ.0) GO TO 4
-C
-C SET COPIES OF A RANDOM DIAGONALLY-DOMINANT SQUARE MATRIX IN A AND
-C AREF.
- U=1.
- S=FLOAT(N)
- CALL DMRAN(N,N,-U,U,A,A(1,2),A(2,1))
- CALL DVSET(N,S,W(1),W(2))
- CALL DVADD(N,A(1,1),A(2,2),W(1),W(2),A(1,1),A(2,2))
- CALL DMCPY(N,N,A,A(1,2),A(2,1),AREF,AREF(1,2),AREF(2,1))
-C
-C SET COPIES OF A RANDOM RIGHT-HAND SIDE MATRIX IN B AND BREF.
- CALL DMRAN(N,KMAX,-U,U,B,B(1,2),B(2,1))
- CALL DMCPY(N,KMAX,B,B(1,2),B(2,1),BREF,BREF(1,2),BREF(2,1))
-C
-C CALL F010 TO REPLACE A BY AINV AND B BY AINV*B. COMPUTE RESIDUALS.
- RESID=0.
- DO 3 ISUB=1,3
- CALL DMCPY(N,N,AREF,AREF(1,2),AREF(2,1),A,A(1,2),A(2,1))
- CALL DMCPY(N,KMAX,BREF,BREF(1,2),BREF(2,1),B,B(1,2),B(2,1))
- IF(ISUB.EQ.1) CALL DEQINV(N,A,IDIM,R,IFAIL,K,B)
- IF(ISUB.EQ.2) CALL DINV(N,A,IDIM,R,IFAIL)
- IF(ISUB.EQ.3) CALL DEQN(N,A,IDIM,R,IFAIL,K,B)
- RESINV=0.
- RESEQN=0.
- IF(ISUB.EQ.3) GO TO 1
-C (MAXIMUM RESIDUAL FOR INVERSION.)
- CALL DMMLT(N,N,N,AREF,AREF(1,2),AREF(2,1),
- * A,A(1,2),A(2,1),A,A(1,2),A(2,1),W)
- S=1.
- CALL DVSET(N,S,W(1),W(2))
- CALL DVSUB(N,A(1,1),A(2,2),W(1),W(2),A(1,1),A(2,2))
- RESINV=F010MD(N,N,IDIM,A)
- 1 IF(ISUB.EQ.2) GO TO 2
-C (MAXIMUM RESIDUAL FOR LINEAR SYSTEM.)
- IF(K.NE.0) CALL DMMLT(N,N,K,AREF,AREF(1,2),AREF(2,1),
- * B,B(1,2),B(2,1),B,B(1,2),B(2,1),W)
- CALL DMSUB(N,KMAX,B,B(1,2),B(2,1),
- * BREF,BREF(1,2),BREF(2,1),B,B(1,2),B(2,1))
- RESEQN=F010MD(N,K,IDIM,B)
-C (FINAL RESIDUAL.)
- 2 RESID=AMAX1(RESID,RESINV,RESEQN)
- IF(IFAIL.NE.0) RESID=99999.
- 3 CONTINUE
- RETURN
-C
-C TEST IFAIL FLAG.
- 4 S=1.
- CALL DMSET(2,2,S,A,A(1,2),A(2,1))
- CALL DINV(2,A,IDIM,R,IFAIL)
- RESID=0.
- IF(IFAIL.NE.-1) RESID=99999.
- RETURN
- END
diff --git a/src/packlib/kernlib/kernnum/test/numchk2/f010mc.F b/src/packlib/kernlib/kernnum/test/numchk2/f010mc.F
deleted file mode 100644
index 5807ea6..0000000
--- a/src/packlib/kernlib/kernnum/test/numchk2/f010mc.F
+++ /dev/null
@@ -1,67 +0,0 @@
-*
-* $Id: f010mc.F,v 1.1.1.1 1996/02/15 17:48:42 mclareni Exp $
-*
-* $Log: f010mc.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:42 mclareni
-* Kernlib
-*
-*
-#include "kernnumt/pilot.h"
- REAL FUNCTION F010MC(M,N,IDIM,Q)
- COMPLEX Q(IDIM,N)
-C
-C F010MC IS SET EQUAL TO THE LARGEST ABSOLUTE VALUE OF ANY ELEMENT IN
-C THE MATRIX Q.
-C M FIRST MATHEMATICAL DIMENSION OF Q.
-C N SECOND MATHEMATICAL DIMENSION OF Q.
-C IDIM FIRST DIMENSION OF ARRAY Q.
-C Q (COMPLEX) TWO-DIMENSIONAL ARRAY.
-C
-C START.
- R=0.
- DO 2 I=1,M
- DO 1 J=1,N
- A=CABS(Q(I,J))
- R=AMAX1(R,A)
- 1 CONTINUE
- 2 CONTINUE
- F010MC=R
- RETURN
- END
- SUBROUTINE F010MG(A,R,B,OK,EQN,INV,EQINV,VCPY,VDIST,T)
- REAL A(99), R(99), B(99)
- LOGICAL OK, OKT
-#include "kernnumt/sysdat.inc"
- REAL T(6), E(3)
- INTEGER NERR(5), KERR(5)
- DATA NERR / 0, -1, +2, +1, +1 /
- DATA KERR / +1, +1, +1, 0, -1 /
- IDIM = 1
- OK = .TRUE.
- DO 30 JSUB = 1, 3
- L = 5
- IF(JSUB .EQ. 2) L = 3
- DO 20 JERR = 1, L
- N = NERR(JERR)
- K = KERR(JERR)
- CALL VCPY(1,T(1),DUMMY,A,DUMMY)
- CALL VCPY(1,T(3),DUMMY,R,DUMMY)
- CALL VCPY(1,T(5),DUMMY,B,DUMMY)
- GOTO(11, 12, 13), JSUB
- 11 CALL EQN(N,A,IDIM,R,IFAIL,K,B)
- GOTO 19
- 12 CALL INV(N,A,IDIM,R,IFAIL)
- GOTO 19
- 13 CALL EQINV(N,A,IDIM,R,IFAIL,K,B)
- 19 E(1) = VDIST(1,A,DUMMY,T(1),DUMMY)
- E(2) = VDIST(1,R,DUMMY,T(3),DUMMY)
- E(3) = VDIST(1,B,DUMMY,T(5),DUMMY)
- OKT = (E(1) .EQ. 0.) .AND. (E(2). EQ. 0.) .AND.
- + (E(3) .EQ. 0.)
- IF(.NOT. OKT) WRITE(*,1001) JSUB, JERR, E
- OK = OK .AND. OKT
- 20 CONTINUE
- 30 CONTINUE
- RETURN
-1001 FORMAT( / 33H ??? ERROR DETECTED BY F010MG ..., 2I6,1P,4E12.3)
- END
diff --git a/src/packlib/kernlib/kernnum/test/numchk2/f010md.F b/src/packlib/kernlib/kernnum/test/numchk2/f010md.F
deleted file mode 100644
index b28ffc8..0000000
--- a/src/packlib/kernlib/kernnum/test/numchk2/f010md.F
+++ /dev/null
@@ -1,30 +0,0 @@
-*
-* $Id: f010md.F,v 1.1.1.1 1996/02/15 17:48:42 mclareni Exp $
-*
-* $Log: f010md.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:42 mclareni
-* Kernlib
-*
-*
-#include "kernnumt/pilot.h"
- REAL FUNCTION F010MD(M,N,IDIM,Q)
- DOUBLE PRECISION Q(IDIM,N)
-C
-C F010MD IS SET EQUAL TO THE LARGEST ABSOLUTE VALUE OF ANY ELEMENT IN
-C THE MATRIX Q.
-C M FIRST MATHEMATICAL DIMENSION OF Q.
-C N SECOND MATHEMATICAL DIMENSION OF Q.
-C IDIM FIRST DIMENSION OF ARRAY Q.
-C Q (DOUBLE PRECISION) TWO-DIMENSIONAL ARRAY.
-C
-C START.
- R=0.
- DO 2 I=1,M
- DO 1 J=1,N
- A=DABS(Q(I,J))
- R=AMAX1(R,A)
- 1 CONTINUE
- 2 CONTINUE
- F010MD=R
- RETURN
- END
diff --git a/src/packlib/kernlib/kernnum/test/numchk2/f010mr.F b/src/packlib/kernlib/kernnum/test/numchk2/f010mr.F
deleted file mode 100644
index 2a9114d..0000000
--- a/src/packlib/kernlib/kernnum/test/numchk2/f010mr.F
+++ /dev/null
@@ -1,30 +0,0 @@
-*
-* $Id: f010mr.F,v 1.1.1.1 1996/02/15 17:48:42 mclareni Exp $
-*
-* $Log: f010mr.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:42 mclareni
-* Kernlib
-*
-*
-#include "kernnumt/pilot.h"
- REAL FUNCTION F010MR(M,N,IDIM,Q)
- REAL Q(IDIM,N)
-C
-C F010MR IS SET EQUAL TO THE LARGEST ABSOLUTE VALUE OF ANY ELEMENT IN
-C THE MATRIX Q.
-C M FIRST MATHEMATICAL DIMENSION OF Q.
-C N SECOND MATHEMATICAL DIMENSION OF Q.
-C IDIM FIRST DIMENSION OF ARRAY Q.
-C Q (REAL) TWO-DIMENSIONAL ARRAY.
-C
-C START.
- R=0.
- DO 2 I=1,M
- DO 1 J=1,N
- A= ABS(Q(I,J))
- R=AMAX1(R,A)
- 1 CONTINUE
- 2 CONTINUE
- F010MR=R
- RETURN
- END
diff --git a/src/packlib/kernlib/kernnum/test/numchk2/f010r.F b/src/packlib/kernlib/kernnum/test/numchk2/f010r.F
deleted file mode 100644
index 35ef2f9..0000000
--- a/src/packlib/kernlib/kernnum/test/numchk2/f010r.F
+++ /dev/null
@@ -1,87 +0,0 @@
-*
-* $Id: f010r.F,v 1.1.1.1 1996/02/15 17:48:42 mclareni Exp $
-*
-* $Log: f010r.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:42 mclareni
-* Kernlib
-*
-*
-#include "kernnumt/pilot.h"
- SUBROUTINE F010R(N,K,KMAX,IDIM,A,AREF,B,BREF,W,R,RESID)
- REAL R(N)
- REAL U,S,A,AREF,B,BREF,W
- DIMENSION A(IDIM,N),AREF(IDIM,N),B(IDIM,2),BREF(IDIM,2),W(N)
-C
-C REAL VERSION OF TEST FOR F010.
-C SETS RESID EQUAL TO THE LARGEST RESIDUAL FOUND WHEN INVERTING A
-C MATRIX OR SOLVING A LINEAR SYSTEM.
-C
-C N ORDER OF COEFFICIENT MATRIX.
-C K CURRENT NUMBER OF RIGHT-HAND SIDES.
-C KMAX MAXIMUM NUMBER OF RIGHT-HAND SIDES.
-C IDIM FIRST DIMENSION OF THE 2D ARRAYS.
-C A,AREF (REAL) 2D ARRAYS WITH AT LEAST N COLUMNS.
-C B,BREF (REAL) 2D ARRAYS WITH AT LEAST KMAX COLUMNS.
-C W (REAL) 1D ARRAY WITH AT LEAST N COLUMNS.
-C R (REAL) 1D ARRAY WITH AT LEAST N COLUMNS.
-C RESID (REAL) OUTPUT PARAMETER.
-C
-C CALLS ... ALL REAL ENTRIES IN F010.
-C ... CERN PACKAGES F002 AND F003.
-C ... TEST-ROUTINE F010MR.
-C
-C START.
- IF(K.EQ.0) GO TO 4
-C
-C SET COPIES OF A RANDOM DIAGONALLY-DOMINANT SQUARE MATRIX IN A AND
-C AREF.
- U=1.
- S=FLOAT(N)
- CALL RMRAN(N,N,-U,U,A,A(1,2),A(2,1))
- CALL RVSET(N,S,W(1),W(2))
- CALL RVADD(N,A(1,1),A(2,2),W(1),W(2),A(1,1),A(2,2))
- CALL RMCPY(N,N,A,A(1,2),A(2,1),AREF,AREF(1,2),AREF(2,1))
-C
-C SET COPIES OF A RANDOM RIGHT-HAND SIDE MATRIX IN B AND BREF.
- CALL RMRAN(N,KMAX,-U,U,B,B(1,2),B(2,1))
- CALL RMCPY(N,KMAX,B,B(1,2),B(2,1),BREF,BREF(1,2),BREF(2,1))
-C
-C CALL F010 TO REPLACE A BY AINV AND B BY AINV*B. COMPUTE RESIDUALS.
- RESID=0.
- DO 3 ISUB=1,3
- CALL RMCPY(N,N,AREF,AREF(1,2),AREF(2,1),A,A(1,2),A(2,1))
- CALL RMCPY(N,KMAX,BREF,BREF(1,2),BREF(2,1),B,B(1,2),B(2,1))
- IF(ISUB.EQ.1) CALL REQINV(N,A,IDIM,R,IFAIL,K,B)
- IF(ISUB.EQ.2) CALL RINV(N,A,IDIM,R,IFAIL)
- IF(ISUB.EQ.3) CALL REQN(N,A,IDIM,R,IFAIL,K,B)
- RESINV=0.
- RESEQN=0.
- IF(ISUB.EQ.3) GO TO 1
-C (MAXIMUM RESIDUAL FOR INVERSION.)
- CALL RMMLT(N,N,N,AREF,AREF(1,2),AREF(2,1),
- * A,A(1,2),A(2,1),A,A(1,2),A(2,1),W)
- S=1.
- CALL RVSET(N,S,W(1),W(2))
- CALL RVSUB(N,A(1,1),A(2,2),W(1),W(2),A(1,1),A(2,2))
- RESINV=F010MR(N,N,IDIM,A)
- 1 IF(ISUB.EQ.2) GO TO 2
-C (MAXIMUM RESIDUAL FOR LINEAR SYSTEM.)
- IF(K.NE.0) CALL RMMLT(N,N,K,AREF,AREF(1,2),AREF(2,1),
- * B,B(1,2),B(2,1),B,B(1,2),B(2,1),W)
- CALL RMSUB(N,KMAX,B,B(1,2),B(2,1),
- * BREF,BREF(1,2),BREF(2,1),B,B(1,2),B(2,1))
- RESEQN=F010MR(N,K,IDIM,B)
-C (FINAL RESIDUAL.)
- 2 RESID=AMAX1(RESID,RESINV,RESEQN)
- IF(IFAIL.NE.0) RESID=99999.
- 3 CONTINUE
- RETURN
-C
-C TEST IFAIL FLAG.
- 4 S=1.
- CALL RMSET(2,2,S,A,A(1,2),A(2,1))
- CALL RINV(2,A,IDIM,R,IFAIL)
- RESID=0.
- IF(IFAIL.NE.-1) RESID=99999.
- RETURN
- END
diff --git a/src/packlib/kernlib/kernnum/test/numchk2/f406ch.F b/src/packlib/kernlib/kernnum/test/numchk2/f406ch.F
deleted file mode 100644
index 958b86c..0000000
--- a/src/packlib/kernlib/kernnum/test/numchk2/f406ch.F
+++ /dev/null
@@ -1,101 +0,0 @@
-*
-* $Id: f406ch.F,v 1.1.1.1 1996/02/15 17:48:42 mclareni Exp $
-*
-* $Log: f406ch.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:42 mclareni
-* Kernlib
-*
-*
-#include "kernnumt/pilot.h"
- SUBROUTINE F406CH(NREP,NMAX,KMAX,A,ABAND,B,BREF,OKPK)
- LOGICAL OKPK
- DIMENSION FRATIO(2)
- DIMENSION A(2),ABAND(2),B(2),BREF(2)
- INTEGER NERR(5),MERR(5),IERR(5),KERR(5)
-#include "kernnumt/sysdat.inc"
- CHARACTER*1 CH(2)
- DATA CH/'R','D'/
- DATA NERR/1,1,1,0,1/
- DATA MERR/0,0,-1,0,1/
- DATA IERR/0,1,1,1,1/
- DATA KERR/1,0,1,1,1/
- DATA FRATIO/10.,20./
-C
-C TEST-ROUTINE FOR F406 (RBEQN, DBEQN).
-C
-C THE NUMBER OF ELEMENTS IN THE ARRAYS SHOULD NOT BE LESS THAN
-C A ... 2*NMAX**2
-C ABAND ... 2*NMAX*(NMAX+1)
-C B,BREF ... 2*N*KMAX
-C
-C CALLS ... SUBROUTINES RBEQN AND DBEQN (BOTH IN F406).
-C ... CERN PACKAGES F002 AND F003.
-C ... TEST-ROUTINES F406RR, F406RD, F406SR, F406SD,
-C F406ZR, F406ZD.
-C
-C START.
- OKPK=.FALSE.
- IF(NREP.LE.0) RETURN
- IDIM=NMAX
- OKPK=.TRUE.
- DO 5 ITYPE=1,2
- ITEST=0
- IFAIL=0
- RATMAX=0.
- RSIGN=1.
- DO 4 JREP=1,NREP
- DO 3 N=1,NMAX
- NZERO=0
- NMINUS=N-1
- DO 2 M=NZERO,NMINUS
-C
-C (RESIDUAL TEST).
- DO 1 K=1,KMAX
- IF(ITYPE.EQ.1)
- $ CALL F406RR(N,M,K,KMAX,IDIM,A,ABAND,B,BREF,RESID)
- IF(ITYPE.EQ.2)
- $ CALL F406RD(N,M,K,KMAX,IDIM,A,ABAND,B,BREF,RESID)
- ITEST=ITEST+1
- IF(RESID.LT.0.) RSIGN=-1.
- RATIO=ABS(RESID)/RELPRT(ITYPE)
- IF(RATIO.GT.FRATIO(ITYPE)) IFAIL=IFAIL+1
- RATMAX=AMAX1(RATMAX,RATIO)
- 1 CONTINUE
-C
-C (SINGULARITY TEST).
- IF(ITYPE.EQ.1) CALL F406ZR(N,M,IDIM,ABAND,B,ISING)
- IF(ITYPE.EQ.2) CALL F406ZD(N,M,IDIM,ABAND,B,ISING)
- ITEST=ITEST+1
- IF(ISING.NE.-1) IFAIL=IFAIL+1
-C
- 2 CONTINUE
- 3 CONTINUE
- 4 CONTINUE
- IF(IFAIL.EQ.0) GO TO 5
- OKPK=.FALSE.
- RATMAX=RSIGN*RATMAX
- WRITE(*,2000) CH(ITYPE),IFAIL,ITEST,RATMAX
- 5 CONTINUE
-#if !defined(CERNLIB_NUMDE)
- IF( ERPRNT .AND. ERSTOP) WRITE(*,1001)
- IF( ERPRNT .AND. .NOT. ERSTOP) WRITE(*,1002)
- IF(.NOT. ERPRNT .AND. ERSTOP) WRITE(*,1003)
- DO 9 JERR=1,5
- N=NERR(JERR)
- M=MERR(JERR)
- I=IERR(JERR)
- K=KERR(JERR)
- CALL RBEQN(N,M,ABAND,I,IFAIL,K,B)
- CALL DBEQN(N,M,ABAND,I,IFAIL,K,B)
- 9 CONTINUE
-#endif
- RETURN
-#if !defined(CERNLIB_NUMDE)
- 1001 FORMAT(/' TEN ERROR AND ABEND MESSAGES SHOULD NOW FOLLOW ...')
- 1002 FORMAT(/' TEN ERROR MESSAGES SHOULD NOW FOLLOW ...')
- 1003 FORMAT(/' TEN ABEND MESSAGES SHOULD NOW FOLLOW ...')
-#endif
- 2000 FORMAT( // 16H ***** F406CH. , A1, 14HBEQN TEST ... , I4,
- $ 14H FAILURES IN , I4, 25H TESTS. RESMAX/RELPR =,
- $ 1P, E9.1, 1H. )
- END
diff --git a/src/packlib/kernlib/kernnum/test/numchk2/f406rd.F b/src/packlib/kernlib/kernnum/test/numchk2/f406rd.F
deleted file mode 100644
index 0aa0b62..0000000
--- a/src/packlib/kernlib/kernnum/test/numchk2/f406rd.F
+++ /dev/null
@@ -1,93 +0,0 @@
-*
-* $Id: f406rd.F,v 1.1.1.1 1996/02/15 17:48:42 mclareni Exp $
-*
-* $Log: f406rd.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:42 mclareni
-* Kernlib
-*
-*
-#include "kernnumt/pilot.h"
- SUBROUTINE F406RD(N,M,K,KMAX,IDIM,A,ABAND,B,BREF,RESID)
- REAL RESID,RB
- DOUBLE PRECISION A,ABAND,B,BREF,ONE
- DIMENSION A(IDIM,N),ABAND(IDIM,2),B(IDIM,KMAX),BREF(IDIM,KMAX)
- DATA ONE/1.D0/
-C
-C SETS RESID EQUAL TO THE LARGEST RESIDUAL FOUND WHEN SOLVING A BANDED
-C LINEAR SYSTEM BY MEANS OF SUBROUTINE DBEQN (F406).
-C
-C N ORDER OF COEFFICIENT MATRIX.
-C M BAND-WIDTH PARAMETER.
-C K CURRENT NUMBER OF RIGHT-HAND SIDES.
-C KMAX MAXIMUM NUMBER OF RIGHT-HAND SIDES.
-C A (DOUBLE PRECISION) TWO-DIMENSIONAL ARRAY WITH AT LEAST
-C N COLUMNS.
-C ABAND (DOUBLE PRECISION) TWO-DIMENSIONAL ARRAY WITH AT LEAST
-C MIN(2*M+1,N)+1 COLUMNS.
-C B,BREF (DOUBLE PRECISION) TWO-DIMENSIONAL ARRAYS WITH AT LEAST
-C KMAX COLUMNS.
-C RESID (REAL) OUTPUT VARIABLE.
-C
-C CALLS ... SUBROUTINE DBEQN (F406).
-C ... CERN PACKAGES F002 AND F003.
-C ... TEST-ROUTINE F406SD.
-C
-C START.
-C
- IF(K.LT.1) RETURN
- MBAND=2*M+1
-C
-C SET ARRAY A TO A BAND MATRIX WHICH IS WELL-CONDITIONED ONLY IF PIV-
-C OTING OCCURS, AND SET A PACKED COPY IN ARRAY ABAND.
-C
- CALL F406SD(N,M,IDIM,A)
- DO 2 I=1,N
- JMIN=MAX0(I-M,1)
- JMAX=MIN0(I+M,N)
- DO 1 J=JMIN,JMAX
- L=J-I+M+1
- IF(I.LE.M) ABAND(I,J)=A(I,J)
- IF(I.GT.M) ABAND(I,L)=A(I,J)
- 1 CONTINUE
- 2 CONTINUE
-C
-C SET MINUS ONES AS A MARKER IN THE FIRST NON-SET COLUMN OF B.
-C THESE SHOULD NOT BE OVERWRITTEN BY CALLING DBEQN.
-C
- LSTCOL=MIN0(MBAND,N)
- CALL DVSET(N,-ONE,ABAND(1,LSTCOL+1),ABAND(2,LSTCOL+1))
-C
-C SET A RIGHT-HAND SIDE MATRIX IN B, WITH A COPY IN BREF.
-C
- CALL DMRAN(N,KMAX,-ONE,ONE,B,B(1,2),B(2,1))
- CALL DMCPY(N,KMAX,B,B(1,2),B(2,1),BREF,BREF(1,2),BREF(2,1))
-C
-C CALL DBEQN TO REPLACE B BY THE SOLUTION MATRIX AINV*B.
-C
- CALL DBEQN(N,M,ABAND,IDIM,IFAIL,K,B)
-C
-C REPLACE B BY THE MATRIX OF RESIDUALS (USING FIRST COLUMN OF ABAND AS
-C A WORKING VECTOR FOR SUBROUTINE DMMLT).
-C
- CALL DMMLT(N,N,K,A,A(1,2),A(2,1),B,B(1,2),B(2,1),
- * B,B(1,2),B(2,1),ABAND)
- CALL DMSUB(N,KMAX,B,B(1,2),B(2,1),BREF,BREF(1,2),BREF(2,1),
- * B,B(1,2),B(2,1))
-C
-C SET RESID TO THE LARGEST RESIDUAL.
-C
- RESID=0.
- DO 4 I=1,N
- DO 3 J=1,KMAX
- RB=B(I,J)
- RESID=AMAX1(RESID,ABS(RB))
- 3 CONTINUE
- 4 CONTINUE
-C
-C IF MARKED COLUMN OF ABAND HAS CHANGED, SET RESID NEGATIVE.
-C
- DO 5 I=1,N
- IF(ABAND(I,LSTCOL+1).NE.-ONE) RESID=-ABS(RESID)
- 5 CONTINUE
- RETURN
- END
diff --git a/src/packlib/kernlib/kernnum/test/numchk2/f406rr.F b/src/packlib/kernlib/kernnum/test/numchk2/f406rr.F
deleted file mode 100644
index bc8b80e..0000000
--- a/src/packlib/kernlib/kernnum/test/numchk2/f406rr.F
+++ /dev/null
@@ -1,91 +0,0 @@
-*
-* $Id: f406rr.F,v 1.1.1.1 1996/02/15 17:48:42 mclareni Exp $
-*
-* $Log: f406rr.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:42 mclareni
-* Kernlib
-*
-*
-#include "kernnumt/pilot.h"
- SUBROUTINE F406RR(N,M,K,KMAX,IDIM,A,ABAND,B,BREF,RESID)
- REAL RESID,RB
- REAL A,ABAND,B,BREF,ONE
- DIMENSION A(IDIM,N),ABAND(IDIM,2),B(IDIM,KMAX),BREF(IDIM,KMAX)
- DATA ONE/1./
-C
-C SETS RESID EQUAL TO THE LARGEST RESIDUAL FOUND WHEN SOLVING A BANDED
-C LINEAR SYSTEM BY MEANS OF SUBROUTINE RBEQN (F406).
-C
-C N ORDER OF COEFFICIENT MATRIX.
-C M BAND-WIDTH PARAMETER.
-C K CURRENT NUMBER OF RIGHT-HAND SIDES.
-C KMAX MAXIMUM NUMBER OF RIGHT-HAND SIDES.
-C A (REAL) TWO-DIMENSIONAL ARRAY WITH AT LEAST N COLUMNS.
-C ABAND (REAL) TWO-DIMENSIONAL ARRAY WITH AT LEAST MIN(2*M+1,N)+1
-C COLUMNS.
-C B,BREF (REAL) TWO-DIMENSIONAL ARRAYS WITH AT LEAST KMAX COLUMNS.
-C RESID (REAL) OUTPUT VARIABLE.
-C
-C CALLS ... SUBROUTINE RBEQN (F406).
-C ... CERN PACKAGES F002 AND F003.
-C ... TEST-ROUTINE F406SR.
-C
-C START.
-C
- IF(K.LT.1) RETURN
- MBAND=2*M+1
-C
-C SET ARRAY A TO A BAND MATRIX WHICH IS WELL-CONDITIONED ONLY IF PIV-
-C OTING OCCURS, AND SET A PACKED COPY IN ARRAY ABAND.
-C
- CALL F406SR(N,M,IDIM,A)
- DO 2 I=1,N
- JMIN=MAX0(I-M,1)
- JMAX=MIN0(I+M,N)
- DO 1 J=JMIN,JMAX
- L=J-I+M+1
- IF(I.LE.M) ABAND(I,J)=A(I,J)
- IF(I.GT.M) ABAND(I,L)=A(I,J)
- 1 CONTINUE
- 2 CONTINUE
-C
-C SET MINUS ONES AS A MARKER IN THE FIRST NON-SET COLUMN OF B.
-C THESE SHOULD NOT BE OVERWRITTEN BY CALLING RBEQN.
-C
- LSTCOL=MIN0(MBAND,N)
- CALL RVSET(N,-ONE,ABAND(1,LSTCOL+1),ABAND(2,LSTCOL+1))
-C
-C SET A RIGHT-HAND SIDE MATRIX IN B, WITH A COPY IN BREF.
-C
- CALL RMRAN(N,KMAX,-ONE,ONE,B,B(1,2),B(2,1))
- CALL RMCPY(N,KMAX,B,B(1,2),B(2,1),BREF,BREF(1,2),BREF(2,1))
-C
-C CALL RBEQN TO REPLACE B BY THE SOLUTION MATRIX AINV*B.
-C
- CALL RBEQN(N,M,ABAND,IDIM,IFAIL,K,B)
-C
-C REPLACE B BY THE MATRIX OF RESIDUALS (USING FIRST COLUMN OF ABAND AS
-C A WORKING VECTOR FOR SUBROUTINE RMMLT).
-C
- CALL RMMLT(N,N,K,A,A(1,2),A(2,1),B,B(1,2),B(2,1),
- * B,B(1,2),B(2,1),ABAND)
- CALL RMSUB(N,KMAX,B,B(1,2),B(2,1),BREF,BREF(1,2),BREF(2,1),
- * B,B(1,2),B(2,1))
-C
-C SET RESID TO THE LARGEST RESIDUAL.
-C
- RESID=0.
- DO 4 I=1,N
- DO 3 J=1,KMAX
- RB=B(I,J)
- RESID=AMAX1(RESID,ABS(RB))
- 3 CONTINUE
- 4 CONTINUE
-C
-C IF MARKED COLUMN OF ABAND HAS CHANGED, SET RESID NEGATIVE.
-C
- DO 5 I=1,N
- IF(ABAND(I,LSTCOL+1).NE.-ONE) RESID=-ABS(RESID)
- 5 CONTINUE
- RETURN
- END
diff --git a/src/packlib/kernlib/kernnum/test/numchk2/f406sd.F b/src/packlib/kernlib/kernnum/test/numchk2/f406sd.F
deleted file mode 100644
index f0ab2f0..0000000
--- a/src/packlib/kernlib/kernnum/test/numchk2/f406sd.F
+++ /dev/null
@@ -1,62 +0,0 @@
-*
-* $Id: f406sd.F,v 1.1.1.1 1996/02/15 17:48:42 mclareni Exp $
-*
-* $Log: f406sd.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:42 mclareni
-* Kernlib
-*
-*
-#include "kernnumt/pilot.h"
- SUBROUTINE F406SD(N,M,IDIM,A)
- DOUBLE PRECISION A,ZERO,ONE,TEMP
- DIMENSION A(IDIM,N)
- DATA ZERO/0.D0/,ONE/1.D0/
-C
-C SET A WELL-CONDITIONED BAND MATRIX IN A.
-C
-C N ORDER OF MATRIX.
-C M BAND-WIDTH PARAMTER.
-C IDIM FIRST DIMENSION OF ARRAY A.
-C A (DOUBLE PRECISION) TWO-DIMENSIONAL ARRAY.
-C
-C THE DOMINANT ELEMENTS ARE ON THE COUNTER-DIAGONALS OF THE PRINCIPAL
-C SUB-MATRICES OF ORDER M+1.
-C
-C EXAMPLE .. N=8, M=2.
-C
-C . . X
-C . X . .
-C X . . . .
-C . . . . X
-C . . X . .
-C X . . . .
-C . . . X
-C . X .
-C
-C CALLS ... CERN PACKAGES F002 AND F003.
-C
-C START. SET A RANDOM BAND MATRIX IN A.
- MBAND=2*M+1
- MPLUS=M+1
- CALL DMRAN(N,N,-ONE,ONE,A,A(1,2),A(2,1))
- DO 2 I=1,N
- DO 1 J=1,N
- IF(IABS(I-J).GT.M) A(I,J)=ZERO
- 1 CONTINUE
- 2 CONTINUE
-C
-C ADD MBAND TO THE COUNTER-DIAGONALS OF THE SUB-MATRICES.
- TEMP=MBAND
- NZERO=0
- DO 4 K=NZERO,N
- NU=K*MPLUS+1
- MU=MIN0(N-NU+1,MPLUS)
- IF(NU.GT.N) RETURN
- DO 3 L=1,MU
- I=NU+L-1
- J=MU+NU-L
- A(I,J)=A(I,J)+TEMP
- 3 CONTINUE
- 4 CONTINUE
- RETURN
- END
diff --git a/src/packlib/kernlib/kernnum/test/numchk2/f406sr.F b/src/packlib/kernlib/kernnum/test/numchk2/f406sr.F
deleted file mode 100644
index 4f0285b..0000000
--- a/src/packlib/kernlib/kernnum/test/numchk2/f406sr.F
+++ /dev/null
@@ -1,62 +0,0 @@
-*
-* $Id: f406sr.F,v 1.1.1.1 1996/02/15 17:48:42 mclareni Exp $
-*
-* $Log: f406sr.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:42 mclareni
-* Kernlib
-*
-*
-#include "kernnumt/pilot.h"
- SUBROUTINE F406SR(N,M,IDIM,A)
- REAL A,ZERO,ONE,TEMP
- DIMENSION A(IDIM,N)
- DATA ZERO/0./,ONE/1./
-C
-C SET A WELL-CONDITIONED BAND MATRIX IN A.
-C
-C N ORDER OF MATRIX.
-C M BAND-WIDTH PARAMTER.
-C IDIM FIRST DIMENSION OF ARRAY A.
-C A (REAL) TWO-DIMENSIONAL ARRAY.
-C
-C THE DOMINANT ELEMENTS ARE ON THE COUNTER-DIAGONALS OF THE PRINCIPAL
-C SUB-MATRICES OF ORDER M+1.
-C
-C EXAMPLE .. N=8, M=2.
-C
-C . . X
-C . X . .
-C X . . . .
-C . . . . X
-C . . X . .
-C X . . . .
-C . . . X
-C . X .
-C
-C CALLS ... CERN PACKAGES F002 AND F003.
-C
-C START. SET A RANDOM BAND MATRIX IN A.
- MBAND=2*M+1
- MPLUS=M+1
- CALL RMRAN(N,N,-ONE,ONE,A,A(1,2),A(2,1))
- DO 2 I=1,N
- DO 1 J=1,N
- IF(IABS(I-J).GT.M) A(I,J)=ZERO
- 1 CONTINUE
- 2 CONTINUE
-C
-C ADD MBAND TO THE COUNTER-DIAGONALS OF THE SUB-MATRICES.
- TEMP=MBAND
- NZERO=0
- DO 4 K=NZERO,N
- NU=K*MPLUS+1
- MU=MIN0(N-NU+1,MPLUS)
- IF(NU.GT.N) RETURN
- DO 3 L=1,MU
- I=NU+L-1
- J=MU+NU-L
- A(I,J)=A(I,J)+TEMP
- 3 CONTINUE
- 4 CONTINUE
- RETURN
- END
diff --git a/src/packlib/kernlib/kernnum/test/numchk2/f406zd.F b/src/packlib/kernlib/kernnum/test/numchk2/f406zd.F
deleted file mode 100644
index 4cd0bb3..0000000
--- a/src/packlib/kernlib/kernnum/test/numchk2/f406zd.F
+++ /dev/null
@@ -1,43 +0,0 @@
-*
-* $Id: f406zd.F,v 1.1.1.1 1996/02/15 17:48:42 mclareni Exp $
-*
-* $Log: f406zd.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:42 mclareni
-* Kernlib
-*
-*
-#include "kernnumt/pilot.h"
- SUBROUTINE F406ZD(N,M,IDIM,ABAND,B,IFAIL)
- DOUBLE PRECISION ABAND,B,ZERO,ONE
- DIMENSION ABAND(IDIM,2),B(N)
- DATA ZERO/0.D0/,ONE/1.D0/
-C
-C SINGULAR MATRIX TEST FOR BANDED EQUATION SOLVER DBEQN (F406).
-C
-C N ORDER OF COEFFICIENT MATRIX.
-C M BAND-WIDTH PARAMETER.
-C IDIM FIRST DIMENSION PARAMETER OF ARRAYS ABAND AND B.
-C ABAND (DOUBLE PRECISION) TWO-DIMENSIONAL ARRAY WITH AT LEAST
-C 2*M+1 COLUMNS.
-C B (DOUBLE PRECISION) ONE-DIMENSIONAL ARRAY WITH AT LEAST
-C N ELEMENTS.
-C IFAIL (INTEGER) IS SET BY DBEQN TO -1 IF MATRIX IS SINGULAR.
-C
-C CALLS ... SUBROUTINE DBEQN (F406).
-C ... CERN PACKAGES F002 AND F003.
-C
-C START. SET ARRAY ABAND TO A PACKED BAND MATRIX WITH ZERO LAST
-C COLUMN.
- MBAND=2*M+1
- MWIDTH=MIN0(MBAND,N)
- CALL DMRAN(N,MWIDTH,-ONE,ONE,ABAND,ABAND(1,2),ABAND(2,1))
- IMIN=N-M
- DO 1 I=IMIN,N
- L=N+M-I+1
- IF(I.LE.M) ABAND(I,N)=ZERO
- IF(I.GT.M) ABAND(I,L)=ZERO
- B(I)=ONE
- 1 CONTINUE
- CALL DBEQN(N,M,ABAND,IDIM,IFAIL,1,B)
- RETURN
- END
diff --git a/src/packlib/kernlib/kernnum/test/numchk2/f406zr.F b/src/packlib/kernlib/kernnum/test/numchk2/f406zr.F
deleted file mode 100644
index 1b86cdf..0000000
--- a/src/packlib/kernlib/kernnum/test/numchk2/f406zr.F
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: f406zr.F,v 1.1.1.1 1996/02/15 17:48:42 mclareni Exp $
-*
-* $Log: f406zr.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:42 mclareni
-* Kernlib
-*
-*
-#include "kernnumt/pilot.h"
- SUBROUTINE F406ZR(N,M,IDIM,ABAND,B,IFAIL)
- REAL ABAND,B,ZERO,ONE
- DIMENSION ABAND(IDIM,2),B(N)
- DATA ZERO/0./,ONE/1./
-C
-C SINGULAR MATRIX TEST FOR BANDED EQUATION SOLVER RBEQN (F406).
-C
-C N ORDER OF COEFFICIENT MATRIX.
-C M BAND-WIDTH PARAMETER.
-C IDIM FIRST DIMENSION PARAMETER OF ARRAYS ABAND AND B.
-C ABAND (REAL) TWO-DIMENSIONAL ARRAY WITH AT LEAST 2*M+1 COLUMNS.
-C B (REAL) ONE-DIMENSIONAL ARRAY WITH AT LEAST N ELEMENTS.
-C IFAIL (INTEGER) IS SET BY RBEQN TO -1 IF MATRIX IS SINGULAR.
-C
-C CALLS ... SUBROUTINE RBEQN (F406).
-C ... CERN PACKAGES F002 AND F003.
-C
-C START. SET ARRAY ABAND TO A PACKED BAND MATRIX WITH ZERO LAST
-C COLUMN.
- MBAND=2*M+1
- MWIDTH=MIN0(MBAND,N)
- CALL RMRAN(N,MWIDTH,-ONE,ONE,ABAND,ABAND(1,2),ABAND(2,1))
- IMIN=N-M
- DO 1 I=IMIN,N
- L=N+M-I+1
- IF(I.LE.M) ABAND(I,N)=ZERO
- IF(I.GT.M) ABAND(I,L)=ZERO
- B(I)=ONE
- 1 CONTINUE
- CALL RBEQN(N,M,ABAND,IDIM,IFAIL,1,B)
- RETURN
- END
diff --git a/src/packlib/kernlib/kernnum/test/numchk3/Imakefile b/src/packlib/kernlib/kernnum/test/numchk3/Imakefile
deleted file mode 100644
index e5f84a3..0000000
--- a/src/packlib/kernlib/kernnum/test/numchk3/Imakefile
+++ /dev/null
@@ -1,6 +0,0 @@
-SRCS_F= \ @@\
- check3.F e106ch.F f002ch.F f003ch.F f004ch.F f011ch.F f012ch.F \ @@\
- g900ch.F g901ch.F n001ch.F nrdist.F taadd.F tadiv.F tamul.F \ @@\
- tamula.F tamuna.F tasca.F tascl.F tascs.F tasub.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kernnum/test/numchk3/aadd.inc b/src/packlib/kernlib/kernnum/test/numchk3/aadd.inc
deleted file mode 100644
index e97a07e..0000000
--- a/src/packlib/kernlib/kernnum/test/numchk3/aadd.inc
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: aadd.inc,v 1.1.1.1 1996/02/15 17:48:43 mclareni Exp $
-*
-* $Log: aadd.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:43 mclareni
-* Kernlib
-*
-*
-*
-* aadd.inc
-*
- IF(IDIM .LE. 0) RETURN
- DO 10 J = 1,IDIM
- Z(J) = X(J) + Y(J)
- 10 CONTINUE
- RETURN
- END
diff --git a/src/packlib/kernlib/kernnum/test/numchk3/adiv.inc b/src/packlib/kernlib/kernnum/test/numchk3/adiv.inc
deleted file mode 100644
index 66cf4d8..0000000
--- a/src/packlib/kernlib/kernnum/test/numchk3/adiv.inc
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: adiv.inc,v 1.1.1.1 1996/02/15 17:48:43 mclareni Exp $
-*
-* $Log: adiv.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:43 mclareni
-* Kernlib
-*
-*
-*
-* adiv.inc
-*
- IF(IDIM .LE. 0) RETURN
- DO 10 J = 1, IDIM
- Z(J) = X(J) / Y(J)
- 10 CONTINUE
- RETURN
- END
diff --git a/src/packlib/kernlib/kernnum/test/numchk3/amul.inc b/src/packlib/kernlib/kernnum/test/numchk3/amul.inc
deleted file mode 100644
index 4b17895..0000000
--- a/src/packlib/kernlib/kernnum/test/numchk3/amul.inc
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: amul.inc,v 1.1.1.1 1996/02/15 17:48:44 mclareni Exp $
-*
-* $Log: amul.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:44 mclareni
-* Kernlib
-*
-*
-*
-* amul.inc
-*
- IF(IDIM .LE. 0) RETURN
- DO 10 J = 1, IDIM
- Z(J) = X(J) * Y(J)
- 10 CONTINUE
- RETURN
- END
diff --git a/src/packlib/kernlib/kernnum/test/numchk3/amula.inc b/src/packlib/kernlib/kernnum/test/numchk3/amula.inc
deleted file mode 100644
index dc93402..0000000
--- a/src/packlib/kernlib/kernnum/test/numchk3/amula.inc
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: amula.inc,v 1.1.1.1 1996/02/15 17:48:44 mclareni Exp $
-*
-* $Log: amula.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:44 mclareni
-* Kernlib
-*
-*
-*
-* amula.inc
-*
- IF(IDIM .LE. 0) RETURN
- DO 10 J = 1, IDIM
- Z(J) = Z(J) + X(J) * Y(J)
- 10 CONTINUE
- RETURN
- END
diff --git a/src/packlib/kernlib/kernnum/test/numchk3/amuna.inc b/src/packlib/kernlib/kernnum/test/numchk3/amuna.inc
deleted file mode 100644
index 1861dd8..0000000
--- a/src/packlib/kernlib/kernnum/test/numchk3/amuna.inc
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: amuna.inc,v 1.1.1.1 1996/02/15 17:48:44 mclareni Exp $
-*
-* $Log: amuna.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:44 mclareni
-* Kernlib
-*
-*
-*
-* amuna.inc
-*
- IF(IDIM .LE. 0) RETURN
- DO 10 J = 1, IDIM
- Z(J) = Z(J) - X(J) * Y(J)
- 10 CONTINUE
- RETURN
- END
diff --git a/src/packlib/kernlib/kernnum/test/numchk3/asca.inc b/src/packlib/kernlib/kernnum/test/numchk3/asca.inc
deleted file mode 100644
index 8d230dd..0000000
--- a/src/packlib/kernlib/kernnum/test/numchk3/asca.inc
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: asca.inc,v 1.1.1.1 1996/02/15 17:48:44 mclareni Exp $
-*
-* $Log: asca.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:44 mclareni
-* Kernlib
-*
-*
-*
-* asca.inc
-*
- IF(IDIM .LE. 0) RETURN
- DO 10 J =1, IDIM
- Z(J) = S*X(J) + Y(J)
- 10 CONTINUE
- RETURN
- END
diff --git a/src/packlib/kernlib/kernnum/test/numchk3/ascl.inc b/src/packlib/kernlib/kernnum/test/numchk3/ascl.inc
deleted file mode 100644
index c783159..0000000
--- a/src/packlib/kernlib/kernnum/test/numchk3/ascl.inc
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: ascl.inc,v 1.1.1.1 1996/02/15 17:48:44 mclareni Exp $
-*
-* $Log: ascl.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:44 mclareni
-* Kernlib
-*
-*
-*
-* ascl.inc
-*
- IF(IDIM .LE. 0) RETURN
- DO 10 J =1, IDIM
- Z(J) = S*X(J)
- 10 CONTINUE
- RETURN
- END
diff --git a/src/packlib/kernlib/kernnum/test/numchk3/ascs.inc b/src/packlib/kernlib/kernnum/test/numchk3/ascs.inc
deleted file mode 100644
index 27ba989..0000000
--- a/src/packlib/kernlib/kernnum/test/numchk3/ascs.inc
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: ascs.inc,v 1.1.1.1 1996/02/15 17:48:44 mclareni Exp $
-*
-* $Log: ascs.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:44 mclareni
-* Kernlib
-*
-*
-*
-* ascs.inc
-*
- IF(IDIM .LE. 0) RETURN
- DO 10 J =1, IDIM
- Z(J) = S*X(J) - Y(J)
- 10 CONTINUE
- RETURN
- END
diff --git a/src/packlib/kernlib/kernnum/test/numchk3/asub.inc b/src/packlib/kernlib/kernnum/test/numchk3/asub.inc
deleted file mode 100644
index c2c6515..0000000
--- a/src/packlib/kernlib/kernnum/test/numchk3/asub.inc
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: asub.inc,v 1.1.1.1 1996/02/15 17:48:44 mclareni Exp $
-*
-* $Log: asub.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:44 mclareni
-* Kernlib
-*
-*
-*
-* asub.inc
-*
- IF(IDIM .LE. 0) RETURN
- DO 10 J = 1, IDIM
- Z(J) = X(J) - Y(J)
- 10 CONTINUE
- RETURN
- END
diff --git a/src/packlib/kernlib/kernnum/test/numchk3/ch3dat.inc b/src/packlib/kernlib/kernnum/test/numchk3/ch3dat.inc
deleted file mode 100644
index 71e51ec..0000000
--- a/src/packlib/kernlib/kernnum/test/numchk3/ch3dat.inc
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: ch3dat.inc,v 1.1.1.1 1996/02/15 17:48:43 mclareni Exp $
-*
-* $Log: ch3dat.inc,v $
-* Revision 1.1.1.1 1996/02/15 17:48:43 mclareni
-* Kernlib
-*
-*
-*
-* ch3dat.inc
-*
- LOGICAL OKFLAG, CCFLAG
- COMMON /CH3NUM/ OKFLAG, CCFLAG
- COMMON /CH3NUM/ TRELPR
- COMMON /CH3NUM/ MINHEX, MAXHEX, MINHXT(3),MAXHXT(3)
- COMMON /CH3NUM/ LTAB, LTABT(3)
- COMMON /CH3NUM/ KTAB(34), MTAB(34), NTAB(34)
- COMMON /CH3NUM/ VOID(2), NCNFG, LENGTH, IDIM
- COMMON /CH3NUM/ L2, L12, L21, L22
- CHARACTER*4 HTYPE
- COMMON /CH3CHR/ HTYPE
diff --git a/src/packlib/kernlib/kernnum/test/numchk3/check3.F b/src/packlib/kernlib/kernnum/test/numchk3/check3.F
deleted file mode 100644
index 7caa119..0000000
--- a/src/packlib/kernlib/kernnum/test/numchk3/check3.F
+++ /dev/null
@@ -1,790 +0,0 @@
-*
-* $Id: check3.F,v 1.2 1996/03/21 17:16:07 mclareni Exp $
-*
-* $Log: check3.F,v $
-* Revision 1.2 1996/03/21 17:16:07 mclareni
-* Kernnumt corrections for unaligned access on OSF1 by John Marafino, Fermilab
-*
-* Revision 1.1.1.1 1996/02/15 17:48:43 mclareni
-* Kernlib
-*
-*
-#include "kernnumt/pilot.h"
- SUBROUTINE CHECK3(LWORK,W,NPK,OK,PKN,PKT)
- REAL W(LWORK), PKT(*)
- LOGICAL OK, OKPK
- CHARACTER*4 PKN(*)
-#include "kernnumt/sysdat.inc"
-#include "ch3dat.inc"
- CHARACTER*4 LISTPK(10), NULL
- INTEGER NREPPK(10)
- INTEGER NT(34), MT(34), KT(34), MN(3), MX(3)
- DATA LISTPK
- + / 'E106', 'F002', 'F003', 'F004', 'F011',
- + 'F012', 'G900', 'G901', 'N001', 'NULL' /
- DATA NULL / 'NULL' /
- DATA NREPPK / 50, 1, 1, 1, 1, 1, 5, 3, 1, 0 /
- DATA NT / -5,-2,-1,0,1,2,3,4,5,6,7,8,9,10,
- + 11,12,13,14,15,16,17,18,19,20,
- + 21,22,23,24,25,26,27,28,29,30 /
- DATA MT / -3,1,0,3,4,6,2,10,7,12,8,9,27,
- + -2,-1,20,19,18,17,16,30,29,28,
- + 15,14,13,11,26,25,24,23,22,21,5 /
- DATA KT / 0,3,6,9,12,15,18,21,24,-1,-5,
- + 27,-6,1,4,7,10,13,16,19,22,25,
- + 28,2,5,8,11,14,17,20,23,26,29,30 /
-#if defined(CERNLIB_NUMAP)
- DATA MN / -32, -32, -32 /
- DATA MX / +31, +31, +31 /
- DATA NC / 1 /
-#endif
-#if defined(CERNLIB_NUMCD)
- DATA MN / -242, -242, -242 /
- DATA MX / +266, +266, +266 /
- DATA NC / 6 /
-#endif
-#if defined(CERNLIB_NUMCR)
- DATA MN / -2048, -2048, -2048 /
- DATA MX / +2047, +2047, +2047 /
- DATA NC / 6 /
-#endif
-#if defined(CERNLIB_NUMCV)
- DATA MN / -2048, -2048, -2048 /
- DATA MX / +2047, +2047, +2047 /
- DATA NC / 6 /
-#endif
-#if defined(CERNLIB_NUMDE)
- DATA MN / -32, -32, -32 /
- DATA MX / +31, +31, +31 /
- DATA NC / 3 /
-#endif
-#if defined(CERNLIB_NUMIB)
- DATA MN / -64, -64, -64 /
- DATA MX / +63, +63, +63 /
- DATA NC / 6 /
-#endif
-#if defined(CERNLIB_NUMND)
- DATA MN / -64, -64, -64 /
- DATA MX / +63, +63, +63 /
- DATA NC / 3 /
-#endif
-#if defined(CERNLIB_NUMUC)
- DATA MN / -32, -32, -32 /
- DATA MX / +31, +31, +31 /
- DATA NC / 6 /
-#endif
-#if defined(CERNLIB_NUMMS)
- DATA MN / -32, -32, -32 /
- DATA MX / +31, +31, +31 /
- DATA NC / 1 /
-#endif
-#if defined(CERNLIB_NUMLN)
- DATA MN / -32, -32, -32 /
- DATA MX / +31, +31, +31 /
- DATA NC / 1 /
-#endif
- DO 100 NPK = 1, 100
- IF(LISTPK(NPK) .EQ. NULL) GOTO 101
- 100 CONTINUE
- NPK = 0
- RETURN
- 101 NPK = NPK - 1
- OK = .TRUE.
- VOID(1) = 022.83 28 36
- VOID(2) = 022.83 28 36
- DO 102 JTAB = 1, 34
- NTAB(JTAB) = NT(JTAB)
- MTAB(JTAB) = MT(JTAB)
- KTAB(JTAB) = KT(JTAB)
- 102 CONTINUE
- DO 103 JHXT = 1, 3
- MINHXT(JHXT) = MN(JHXT)
- MAXHXT(JHXT) = MX(JHXT)
- 103 CONTINUE
- DO 200 IPK = 1, NPK
- NAMEPK = LISTPK(IPK)
- PKN(IPK)= LISTPK(IPK)
- NREP = NREPPK(IPK)
- OKPK = .FALSE.
- WRITE(*,1000) NAMEPK
- GOTO(01,02,03,04,05,06,07,08,09), IPK
- 01 K = 500
- LR = 1
- LI = LR + K
- LIM = LI + K
- IF(LIM .GT. LWORK) GOTO 900
- CALL E106CH(NREP,K,W(LR),W(LI),OKPK)
- GOTO 90
- 02 LTABT(1) = 34
- LTABT(2) = 24
- LTABT(3) = 24
- NCNFG = NC
- CALL F002CH(NREP,LWORK,W(1),OKPK)
- GOTO 90
- 03 LTABT(1) = 34
- LTABT(2) = 24
- LTABT(3) = 24
- NCNFG = NC
- CALL F003CH(NREP,LWORK,W(1),OKPK)
- GOTO 90
- 04 LTABT(1) = 34
- LTABT(2) = 24
- LTABT(3) = 24
- NCNFG = NC
- CALL F004CH(NREP,LWORK,W(1),OKPK)
- GOTO 90
- 05 LTABT(1) = 24
- LTABT(2) = 14
- LTABT(3) = 14
- NCNFG = 6
- CALL F011CH(NREP,LWORK,W(1),OKPK)
- GOTO 90
- 06 LTABT(1) = 24
- LTABT(2) = 14
- LTABT(3) = 14
- NCNFG = 6
- CALL F012CH(NREP,LWORK,W(1),OKPK)
- GOTO 90
- 07 CALL G900CH(NREP,OKPK)
- GOTO 90
- 08 K = LWORK/4
- LX = 1
- LY = LX + K
- LZ = LY + K
- LT = LZ + K
- CALL G901CH(NREP,K,W(LX),W(LY),W(LZ),W(LT),OKPK)
- GOTO 90
- 09 CALL N001CH(OKPK)
- GOTO 91
- 90 IF( OKPK) WRITE(*,1013) NAMEPK
- 91 IF(.NOT. OKPK) WRITE(*,1012) NAMEPK
- OK = OK .AND. OKPK
- CALL TIMEX( PKT(IPK) )
- 200 CONTINUE
- IF(NPK .LT. 1) OK = .FALSE.
- RETURN
- 900 OK = .FALSE.
- WRITE(*,1020)
- RETURN
-1000 FORMAT(// 10H CHECK OF , A4,1H.)
-1012 FORMAT(/ 5X, 24H ????? CHECK OF PACKAGE ,A4,
- + 18H HAS FAILED. ????? )
-1013 FORMAT( 15X, 18H CHECK OF PACKAGE ,A4,12H SUCCESSFUL. )
-1020 FORMAT(// 42H ????? CHECK 3 HAS INSUFFICIENT WORK SPACE )
- END
- SUBROUTINE CNFGMX(M,N,IRDIM,LA11,LA12,LA21)
-#include "ch3dat.inc"
- IRANF(I,K) = INT( RANF()*FLOAT(K-I+1) ) + I
- LA11 = 1
- LA12 = 1
- LA21 = 1
- IF(M .LE. 0 .OR. N .LE. 0) RETURN
- ITDIM = IRDIM / LENGTH
- IF(ITDIM/(M*N) .GE. 5) THEN
- DO 20 K = 1, 5
- IX = IRANF(1,ITDIM/M)
- JX = 1
- IF(N .LE. 1) GOTO 40
- JX = IRANF(1,(ITDIM-1-IX*(M-1))/(N-1))
- IF((M-1)*(N-1) .EQ. 0) GOTO 40
- DO 12 I = 2, M
- LCOL = (I-1)*IX
- DO 11 J = 2, N
- LROW = (J-1)*JX
- IF(LROW .GT. LCOL) GOTO 12
- IF(LROW .EQ. LCOL) GOTO 20
- 11 CONTINUE
- 12 CONTINUE
- GOTO 40
- 20 CONTINUE
- ENDIF
- IF(RANF() .LE. 0.5) THEN
- JX = IRANF(M,ITDIM/N)
- IX = IRANF(1,JX/M)
- ELSE
- IX = IRANF(N,ITDIM/M)
- JX = IRANF(1,IX/N)
- ENDIF
- 40 MDIM = 1 + (M-1)*IX + (N-1)*JX
- IF(RANF() .GT. 0.5) IX = -IX
- IF(RANF() .GT. 0.5) JX = -JX
- LC = (ITDIM - MDIM) / 2
- LA11 = LC
- IF(IX .LT. 0) LA11 = LA11 - IX*(M-1)
- IF(JX .LT. 0) LA11 = LA11 - JX*(N-1)
- LA12 = LA11 + JX
- LA21 = LA11 + IX
- LA11 = LA11*LENGTH + 1
- LA12 = LA12*LENGTH + 1
- LA21 = LA21*LENGTH + 1
- RETURN
- END
- SUBROUTINE CHECKL(M,N,F,IRDIM,G,LG,LG12,LG21,OK,VDIST,VSET)
- REAL F(*), G(IRDIM)
- LOGICAL OK
-*JMM
- EXTERNAL VDIST, VSET
- DOUBLE PRECISION DVOID
- REAL RVOID(2)
- COMMON/CH3ALIGN/ DVOID
- EQUIVALENCE (DVOID,RVOID(1))
-#include "kernnumt/sysdat.inc"
-#include "ch3dat.inc"
- NDX2F(I,J) = ((J-1)*IDIM + I-1)*LENGTH + 1
- NDX2G(I,J) = (I-1)*IG + (J-1)*JG + LG
- IG = 0
- JG = 0
- IF(M .GT. 1) IG = LG21 - LG
- IF(N .GT. 1) JG = LG12 - LG
- OK = .TRUE.
- DO 10 I = 1, M
- I1F = NDX2F(I,1)
- I2F = NDX2F(I,2)
- I1G = NDX2G(I,1)
- I2G = NDX2G(I,2)
- E = VDIST(N,F(I1F),F(I2F),G(I1G),G(I2G))
- IF(E .NE. 0.) GOTO 91
-* CALL VSET(N,VOID(1),G(I1G),G(I2G))
-*JMM
- IF(HTYPE.EQ.'D') THEN
- RVOID(1) = VOID(1)
- RVOID(2) = VOID(2)
- CALL VSET(N,DVOID, G(I1G),G(I2G))
- ELSE
- CALL VSET(N,VOID(1),G(I1G),G(I2G))
- ENDIF
- 10 CONTINUE
- DO 20 J = 1, IRDIM
- IF(G(J) .NE. VOID(1)) GOTO 92
- 20 CONTINUE
- RETURN
- 91 OK = .FALSE.
- WRITE(IOUNIT,1001) I, E
- RETURN
- 92 OK = .FALSE.
- WRITE(IOUNIT,1002) J
- RETURN
-1001 FORMAT(/ 30H ??? LOGIC ERROR OF FIRST KIND,I5, 1P, E12.3)
-1002 FORMAT(/ 31H ??? LOGIC ERROR OF SECOND KIND,I7)
- END
-#if defined(CERNLIB_NUMCD)
- IDENT KFLUSH
- ENTRY KFLUSH
- KFLUSH JP *+1S17 ENTRY/EXIT LINE
- + SA1 N1TON5
- MX0 48
- BX2 -X0*X1 X2=N5
- LX1 12 X1=N2 N3 N4 N5 N1
- SB5 X2 B5=N5
- BX2 -X0*X1 X2=N1
- LX1 12 X1=N3 N4 N5 N1 N2
- SB1 X2 B1=N1
- BX2 -X0*X1 X2=N2
- LX1 12 X1=N4 N5 N1 N2 N3
- SB2 X2 B2=N2
- BX2 -X0*X1 X2=N3
- LX1 12 X1=N5 N1 N2 N3 N4
- SB3 X2 B3=N3
- BX2 -X0*X1 X2=N4
- BX6 X1 X6=N5 N1 N2 N3 N4
- SB4 X2 B4=N4
- SA6 A1 N1TON5 = N5 N1 N2 N3 N4
- SA1 A6+B1
- SA2 A6+B2
- SA3 A6+B3
- SA4 A6+B4
- SA5 A6+B5
- SB6 X1
- SB7 X2
- LX1 23
- LX2 23
- LX3 23
- LX4 23
- LX5 23
- SB1 X1
- SB2 X2
- SB3 X3
- SB4 X4
- SB5 X5
- BX6 X1
- BX7 X2
- SA6 A2
- SA7 A3
- BX6 X3
- BX7 X4
- SA6 A4
- SA7 A5
- BX6 X5
- LX0 X1,B1 KFLUSHX0
- SA6 A1
- JP KFLUSH
- N1TON5 DATA B00010004000200050003
- DATA B67517144676213571322
- DATA B25561154663002140654
- DATA B53347352345101361316
- DATA B73106476445465300106
- DATA B26523571121415474312
- END
-#endif
-#if !defined(CERNLIB_NUMCD)
- SUBROUTINE KFLUSH
- RETURN
- END
-#endif
- SUBROUTINE RVMAXA(N,X,X2,I,E)
- REAL X(*), X2(*), A
- REAL E, T, ZERO, ABSF
- DATA ZERO / 0. /
- ABSF(A) = ABS(A)
- E = ZERO
- I = 0
- IF(N .LE. 0) RETURN
- E = ABSF(X(1))
- I = 1
- IF(N .EQ. 1) RETURN
- LXJ = 1
-#if (!defined(CERNLIB_NUMUC))&&(!defined(CERNLIB_NUMCR))&&(!defined(CERNLIB_NUMDE))
- JX = LOCF(X2) - LOCF(X)
-#endif
-#if defined(CERNLIB_NUMUC)||defined(CERNLIB_NUMCR)
- JX = LOC(X2) - LOC(X)
-#endif
-#if defined(CERNLIB_NUMDE)
- JX = (%LOC(X2) - %LOC(X)) / 4
-#endif
- DO 10 J = 2, N
- LXJ = LXJ + JX
- T = ABSF(X(LXJ))
- IF(T .LE. E) GOTO 10
- E = T
- I = J
- 10 CONTINUE
- RETURN
- END
- SUBROUTINE DVMAXA(N,X,X2,I,E)
- DOUBLE PRECISION X(*), X2(*), A
- REAL E, T, ZERO, ABSF
- DATA ZERO / 0. /
- ABSF(A) = ABS(SNGL(A))
- E = ZERO
- I = 0
- IF(N .LE. 0) RETURN
- E = ABSF(X(1))
- I = 1
- IF(N .EQ. 1) RETURN
- LXJ = 1
-#if (!defined(CERNLIB_NUMUC))&&(!defined(CERNLIB_NUMCR))&&(!defined(CERNLIB_NUMDE))
- JX = (LOCF(X2) - LOCF(X)) / 2
-#endif
-#if defined(CERNLIB_NUMUC)||defined(CERNLIB_NUMCR)
- JX = (LOC(X2) - LOC(X)) / 2
-#endif
-#if defined(CERNLIB_NUMDE)
- JX = (%LOC(X2) - %LOC(X)) / 8
-#endif
- DO 10 J = 2, N
- LXJ = LXJ + JX
- T = ABSF(X(LXJ))
- IF(T .LE. E) GOTO 10
- E = T
- I = J
- 10 CONTINUE
- RETURN
- END
- SUBROUTINE CVMAXA(N,X,X2,I,E)
- COMPLEX X(*), X2(*), A
- REAL E, T, ZERO, ABSF
- DATA ZERO / 0. /
- ABSF(A) = AMAX1(ABS(REAL(A)),ABS(AIMAG(A)))
- E = ZERO
- I = 0
- IF(N .LE. 0) RETURN
- E = ABSF(X(1))
- I = 1
- IF(N .EQ. 1) RETURN
- LXJ = 1
-#if (!defined(CERNLIB_NUMUC))&&(!defined(CERNLIB_NUMCR))&&(!defined(CERNLIB_NUMDE))
- JX = (LOCF(X2) - LOCF(X)) / 2
-#endif
-#if defined(CERNLIB_NUMUC)||defined(CERNLIB_NUMCR)
- JX = (LOC(X2) - LOC(X)) / 2
-#endif
-#if defined(CERNLIB_NUMDE)
- JX = (%LOC(X2) - %LOC(X)) / 8
-#endif
- DO 10 J = 2, N
- LXJ = LXJ + JX
- T = ABSF(X(LXJ))
- IF(T .LE. E) GOTO 10
- E = T
- I = J
- 10 CONTINUE
- RETURN
- END
- REAL FUNCTION RABSR(X)
- REAL X
- RABSR = ABS(X)
- RETURN
- END
- REAL FUNCTION RABSD(X)
- DOUBLE PRECISION X
- RABSD = ABS(SNGL(X))
- RETURN
- END
- REAL FUNCTION RABSC(X)
- COMPLEX X
- RABSC = AMAX1(ABS(REAL(X)),ABS(AIMAG(X)))
- RETURN
- END
- REAL FUNCTION RVSUMA(N,X,X2)
- REAL X(*), X2(*)
- RVSUMA = 0.
- IF(N .LE. 0) RETURN
- LXJ = 1
-#if (!defined(CERNLIB_NUMUC))&&(!defined(CERNLIB_NUMCR))&&(!defined(CERNLIB_NUMDE))
- JX = LOCF(X2) - LOCF(X)
-#endif
-#if defined(CERNLIB_NUMUC)||defined(CERNLIB_NUMCR)
- JX = LOC(X2) - LOC(X)
-#endif
-#if defined(CERNLIB_NUMDE)
- JX = (%LOC(X2) - %LOC(X)) / 4
-#endif
- DO 10 J = 1, N
- RVSUMA = RVSUMA + ABS(X(LXJ))
- LXJ = LXJ + JX
- 10 CONTINUE
- RETURN
- END
- REAL FUNCTION DVSUMA(N,X,X2)
- DOUBLE PRECISION X(*), X2(*)
- DVSUMA = 0.
- IF(N .LE. 0) RETURN
- LXJ = 1
-#if (!defined(CERNLIB_NUMUC))&&(!defined(CERNLIB_NUMCR))&&(!defined(CERNLIB_NUMDE))
- JX = (LOCF(X2) - LOCF(X)) / 2
-#endif
-#if defined(CERNLIB_NUMUC)||defined(CERNLIB_NUMCR)
- JX = (LOC(X2) - LOC(X)) / 2
-#endif
-#if defined(CERNLIB_NUMDE)
- JX = (%LOC(X2) - %LOC(X)) / 8
-#endif
- DO 10 J = 1, N
- DVSUMA = DVSUMA + ABS(SNGL(X(LXJ)))
- LXJ = LXJ + JX
- 10 CONTINUE
- RETURN
- END
- REAL FUNCTION CVSUMA(N,X,X2)
- COMPLEX X(*), X2(*)
- CVSUMA = 0.
- IF(N .LE. 0) RETURN
- LXJ = 1
-#if (!defined(CERNLIB_NUMUC))&&(!defined(CERNLIB_NUMCR))&&(!defined(CERNLIB_NUMDE))
- JX = (LOCF(X2) - LOCF(X)) / 2
-#endif
-#if defined(CERNLIB_NUMUC)||defined(CERNLIB_NUMCR)
- JX = (LOC(X2) - LOC(X)) / 2
-#endif
-#if defined(CERNLIB_NUMDE)
- JX = (%LOC(X2) - %LOC(X)) / 8
-#endif
- DO 10 J = 1, N
- CVSUMA = CVSUMA + AMAX1(ABS(REAL(X(LXJ))),ABS(AIMAG(X(LXJ))))
- LXJ = LXJ + JX
- 10 CONTINUE
- RETURN
- END
- SUBROUTINE RSCALE(N,A,IDIM,KHEX)
- REAL A(IDIM,N)
- COEFF = 16.**KHEX
- DO 20 I = 1, N
- DO 10 J = 1, N
- A(I,J) = COEFF * A(I,J)
- 10 CONTINUE
- 20 CONTINUE
- RETURN
- END
- SUBROUTINE DSCALE(N,A,IDIM,KHEX)
- DOUBLE PRECISION A(IDIM,N)
- COEFF = 16.**KHEX
- DO 20 I = 1, N
- DO 10 J = 1, N
- A(I,J) = COEFF * A(I,J)
- 10 CONTINUE
- 20 CONTINUE
- RETURN
- END
- SUBROUTINE CSCALE(N,A,IDIM,KHEX)
- COMPLEX A(IDIM,N)
- COEFF = 16.**KHEX
- DO 20 I = 1, N
- DO 10 J = 1, N
- A(I,J) = COEFF * A(I,J)
- 10 CONTINUE
- 20 CONTINUE
- RETURN
- END
- SUBROUTINE RSETEX(N,A,IDIM,RELPR,KFAIL,MODE,K1,K2)
- REAL A(IDIM,N), ZERO, ONE, UNIT, PERT, S
- DATA ZERO / 0. /
- DATA ONE / 1. /
- DATA UNIT / 1. /
- DATA IHEX / 65 536 /
- DO 30 J = 1, N
- S = ZERO
- JMINUS = J-1
- DO 10 I = 1, JMINUS
- S = S + AINT(FLOAT(IHEX*16/N)*RANF()) / FLOAT(IHEX)
- A(I,J) = UNIT*S
- 10 CONTINUE
- S = S + ONE
- DO 20 I = J, N
- A(I,J) = UNIT*S
- 20 CONTINUE
- 30 CONTINUE
- IF(N .EQ. 1) GOTO 40
- IF(MODE .EQ. 1) CALL RVCPY(N,A(1,K1),A(2,K1),A(1,K2),A(2,K2))
- IF(MODE .EQ. 2) CALL RVCPY(N,A(K1,1),A(K1,2),A(K2,1),A(K2,2))
- IF(KFAIL .EQ. -1) GOTO 40
- IF(KFAIL .EQ. 0) ETA = 4.*RELPR
- IF(MODE .EQ. 1) KOL = K2
- IF(MODE .EQ. 2) KOL = MIN0(K2+1,N)
- CALL RVMAXA(N,A(K2,1),A(K2,2),IDUMMY,ROW)
- PERT = ETA * SQRT(FLOAT(N)) * ROW * UNIT
- A(K2,KOL) = A(K2,KOL) + PERT
- 40 IF(N .EQ. 1) A(1,1) = ZERO
- RETURN
- END
- SUBROUTINE DSETEX(N,A,IDIM,RELPR,KFAIL,MODE,K1,K2)
- DOUBLE PRECISION A(IDIM,N), ZERO, ONE, UNIT, PERT, S
- DATA ZERO / 0.D0 /
- DATA ONE / 1.D0 /
- DATA UNIT / 1.D0 /
- DATA IHEX / 65 536 /
- DO 30 J = 1, N
- S = ZERO
- JMINUS = J-1
- DO 10 I = 1, JMINUS
- S = S +
- + DBLE( AINT(FLOAT(IHEX*16/N)*RANF()) / FLOAT(IHEX) )
- A(I,J) = UNIT*S
- 10 CONTINUE
- S = S + ONE
- DO 20 I = J, N
- A(I,J) = UNIT*S
- 20 CONTINUE
- 30 CONTINUE
- IF(N .EQ. 1) GOTO 40
- IF(MODE .EQ. 1) CALL DVCPY(N,A(1,K1),A(2,K1),A(1,K2),A(2,K2))
- IF(MODE .EQ. 2) CALL DVCPY(N,A(K1,1),A(K1,2),A(K2,1),A(K2,2))
- IF(KFAIL .EQ. -1) GOTO 40
- IF(KFAIL .EQ. 0) ETA = 4.*RELPR
- IF(MODE .EQ. 1) KOL = K2
- IF(MODE .EQ. 2) KOL = MIN0(K2+1,N)
- CALL DVMAXA(N,A(K2,1),A(K2,2),IDUMMY,ROW)
- PERT = ETA * SQRT(FLOAT(N)) * ROW * UNIT
- A(K2,KOL) = A(K2,KOL) + PERT
- 40 IF(N .EQ. 1) A(1,1) = ZERO
- RETURN
- END
- SUBROUTINE CSETEX(N,A,IDIM,RELPR,KFAIL,MODE,K1,K2)
- COMPLEX A(IDIM,N), ZERO, ONE, UNIT, PERT, S
- DATA ZERO / (0.,0.) /
- DATA ONE / (1.,0.) /
- DATA UNIT / (1.,1.) /
- DATA IHEX / 65 536 /
- DO 30 J = 1, N
- S = ZERO
- JMINUS = J-1
- DO 10 I = 1, JMINUS
- S = S + CMPLX(
- + AINT(FLOAT(IHEX*16/N)*RANF()) / FLOAT(IHEX),
- + AINT(FLOAT(IHEX*16/N)*RANF()) / FLOAT(IHEX) )
- A(I,J) = UNIT*S
- 10 CONTINUE
- S = S + ONE
- DO 20 I = J, N
- A(I,J) = UNIT*S
- 20 CONTINUE
- 30 CONTINUE
- IF(N .EQ. 1) GOTO 40
- IF(MODE .EQ. 1) CALL CVCPY(N,A(1,K1),A(2,K1),A(1,K2),A(2,K2))
- IF(MODE.EQ.2)CALL CVCPY(N,A(K1,1),A(K1,2),A(K2,1),A(K2,2))
- IF(KFAIL .EQ. -1) GOTO 40
- IF(KFAIL .EQ. 0) ETA = 4.*RELPR
- IF(MODE .EQ. 1) KOL = K2
- IF(MODE .EQ. 2) KOL = MIN0(K2+1,N)
- CALL CVMAXA(N,A(K2,1),A(K2,2),IDUMMY,ROW)
- PERT = ETA * SQRT(FLOAT(N)) * ROW * UNIT
- A(K2,KOL) = A(K2,KOL) + PERT
- 40 IF(N .EQ. 1) A(1,1) = ZERO
- RETURN
- END
- SUBROUTINE RSSETX(N,A,IDIM,MODE,K1,K2)
- REAL A(IDIM,N), ZERO, ONE, UNIT, S
- IRANF(I,K) = INT( RANF()*FLOAT(K-I+1) ) + I
- DATA ZERO / 0. /
- DATA ONE / 1. /
- DATA UNIT / 1. /
- DATA IEXP / 50 /
- IF(N .EQ. 1) THEN
- A(1,1) = ZERO
- ELSE
- M = IEXP/N
- S = ZERO
- DO 30 J = 1, N
- K = IRANF(1,M)
- S = S + 2**K
- DO 10 I = J, N
- A(I,J) = UNIT*S
- A(J,I) = A(I,J)
- 10 CONTINUE
- 30 CONTINUE
- CALL RVCPY(N,A(1,K1),A(2,K1),A(1,K2),A(2,K2))
- CALL RVCPY(N,A(K1,1),A(K1,2),A(K2,1),A(K2,2))
- ENDIF
- IF(MODE .EQ. 2) THEN
- DO 40 J = 1, N
- A(J,J) = - UNIT
- 40 CONTINUE
- ENDIF
- END
- SUBROUTINE DSSETX(N,A,IDIM,MODE,K1,K2)
- DOUBLE PRECISION A(IDIM,N), ZERO, ONE, UNIT, S
- IRANF(I,K) = INT( RANF()*FLOAT(K-I+1) ) + I
- DATA ZERO / 0.D0 /
- DATA ONE / 1.D0 /
- DATA UNIT / 1.D0 /
- DATA IEXP / 50 /
- IF(N .EQ. 1) THEN
- A(1,1) = ZERO
- ELSE
- M = IEXP/N
- S = ZERO
- DO 30 J = 1, N
- K = IRANF(1,M)
- S = S + 2**K
- DO 10 I = J, N
- A(I,J) = UNIT*S
- A(J,I) = A(I,J)
- 10 CONTINUE
- 30 CONTINUE
- CALL DVCPY(N,A(1,K1),A(2,K1),A(1,K2),A(2,K2))
- CALL DVCPY(N,A(K1,1),A(K1,2),A(K2,1),A(K2,2))
- ENDIF
- IF(MODE .EQ. 2) THEN
- DO 40 J = 1, N
- A(J,J) = - UNIT
- 40 CONTINUE
- ENDIF
- END
- SUBROUTINE CSETCR(N,A,IDIM,DET)
- COMPLEX A(IDIM,N),DET, RANGE, CVSUM
- COMPLEX C
- REAL PIBY4N, PHI
- DATA RANGE / (+1.,+1.) /
- CALL CVRAN(N,-RANGE,+RANGE,A,A(1,2))
- DET = CVSUM(N,A,A(1,2))
- IF(N .EQ. 1) RETURN
- PIBY4N = ATAN(1.) / FLOAT(N)
- DO 11 J = 1, N
- PHI = FLOAT(8*(J-1)) * PIBY4N
- A(2,J) = CMPLX(COS(PHI),SIN(PHI))
- 11 CONTINUE
- DO 22 I = 2, N
- C = (0.,0.)
- L = 1
- DO 21 J = 1, N
- C = C + A(1,J)*A(2,L)
- L = L + I-1
- IF(L .GT. N) L = L-N
- 21 CONTINUE
- DET = DET*C
- 22 CONTINUE
- DO 31 I = 2, N
- A(I,1) = A(I-1,N)
- CALL CVCPY(N-1,A(I-1,1),A(I-1,2),A(I,2),A(I,3))
- 31 CONTINUE
- RETURN
- END
- SUBROUTINE RSETCR(N,A,IDIM,DET)
- REAL A(IDIM,N),DET, RANGE, RVSUM
- COMPLEX C, D
-#include "kernnumt/sysdat.inc"
- REAL PIBY4N, PHI
- DATA RANGE / 1. /
- CALL RVRAN(N,-RANGE,+RANGE,A,A(1,2))
- DET = RVSUM(N,A,A(1,2))
- IF(N .EQ. 1) GOTO 90
- IF(N .GT. 2) GOTO 10
- DET = DET*(A(1,1) - A(1,2))
- A(2,1) = A(1,2)
- A(2,2) = A(1,1)
- GOTO 90
- 10 PIBY4N = ATAN(1.) / FLOAT(N)
- DO 11 J = 1, N
- PHI = FLOAT(8*(J-1)) * PIBY4N
- A(2,J) = COS(PHI)
- A(3,J) = SIN(PHI)
- 11 CONTINUE
- D = CMPLX(DET,0.)
- DO 22 I = 2, N
- C = (0.,0.)
- L = 1
- DO 21 J = 1, N
- C = C + A(1,J) * CMPLX(A(2,L),A(3,L))
- L = L + I-1
- IF(L .GT. N) L = L-N
- 21 CONTINUE
- D = D * C
- 22 CONTINUE
- DET = REAL(D)
- DO 31 I =2, N
- A(I,1) = A(I-1,N)
- CALL RVCPY(N-1,A(I-1,1),A(I-1,2),A(I,2),A(I,3))
- 31 CONTINUE
- 90 RETURN
- END
- SUBROUTINE DSETCR(N,A,IDIM,DET)
- DOUBLE PRECISION A(IDIM,N),DET, RANGE, DVSUM
- DOUBLE PRECISION CR, CI, DR, DI
- DOUBLE PRECISION PIBY4N, PHI
- DATA RANGE / 1.D0 /
- CALL DVRAN(N,-RANGE,+RANGE,A,A(1,2))
- DET = DVSUM(N,A,A(1,2))
- IF(N .EQ. 1) RETURN
- IF(N .GT. 2) GOTO 10
- DET = DET * (A(1,1) - A(1,2))
- A(2,1) = A(1,2)
- A(2,2) = A(1,1)
- RETURN
- 10 PIBY4N = DATAN(1.D0) / FLOAT(N)
- DO 11 J = 1, N
- PHI = FLOAT(8*(J-1)) * PIBY4N
- A(2,J) = DCOS(PHI)
- A(3,J) = DSIN(PHI)
- 11 CONTINUE
- DR = DET
- DI = 0.D0
- DO 22 I = 2, N
- CR = 0.D0
- CI = 0.D0
- L = 1
- DO 21 J = 1, N
- CR = CR + A(1,J) * A(2,L)
- CI = CI + A(1,J) * A(3,L)
- L = L + I-1
- IF(L .GT. N) L = L - N
- 21 CONTINUE
- DET = DR*CR - DI*CI
- DI = DR*CI + DI*CR
- DR = DET
- 22 CONTINUE
- DO 31 I = 2, N
- A(I,1) = A(I-1,N)
- CALL DVCPY(N-1,A(I-1,1),A(I-1,2),A(I,2),A(I,3))
- 31 CONTINUE
- RETURN
- END
diff --git a/src/packlib/kernlib/kernnum/test/numchk3/e106ch.F b/src/packlib/kernlib/kernnum/test/numchk3/e106ch.F
deleted file mode 100644
index 80ca804..0000000
--- a/src/packlib/kernlib/kernnum/test/numchk3/e106ch.F
+++ /dev/null
@@ -1,67 +0,0 @@
-*
-* $Id: e106ch.F,v 1.1.1.1 1996/02/15 17:48:43 mclareni Exp $
-*
-* $Log: e106ch.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:43 mclareni
-* Kernlib
-*
-*
-#include "kernnumt/pilot.h"
- SUBROUTINE E106CH(NREP,IDIM,FD,ID,OK)
- INTEGER ID(IDIM)
- REAL FD(IDIM)
- LOGICAL OK
-#include "kernnumt/sysdat.inc"
- DATA EPS / 0.001 /
- IF(IDIM .LT. 20) GOTO 900
- OK = .TRUE.
- N = 0
- DO 100 JREP = 1, NREP
- 10 N = N+1
- IF(N .GT. 18) N = N+9
- IF(N .GT. 100) N = N+90
- IF(N .GT. IDIM) N = 1
- 11 STEP = 10. * RANF()
- IF(STEP .LE. EPS) GOTO 11
- FORG = -0.5 * STEP * FLOAT(N)
- DO 20 J = 1, N
- FD(J) = FORG + FLOAT(J-1)*STEP
- ID(J) = INT(FD(J))
- 20 CONTINUE
- DO 30 J = 1, N
- FEL = FD(J)
- FEP = FEL + EPS
- FEM = FEL - EPS
- LFE = LOCATF(FD(1),N,FEL)
- LFP = LOCATF(FD(1),N,FEP)
- LFM = LOCATF(FD(1),N,FEM)
- IF(LFE-J .NE. 0 .OR.
- + LFP+J .NE. 0 .OR.
- + LFM+J-1 .NE. 0) GOTO 60
- IEL = ID(J)
- IEP = IEL + 1
- IEM = IEL - 1
- LIE = LOCATI(ID(1),N,IEL)
- LIP = LOCATI(ID(1),N,IEP)
- LIM = LOCATI(ID(1),N,IEM)
- IF(LIE .NE. J .AND. ID(LIE) .EQ. IEL) LIE = J
- IF(J .NE. N .AND. IEP .GE. ID(J+1)) LIP = -J
- IF(J .NE. 1 .AND. IEM .LE. ID(J-1)) LIM = 1-J
- IF(LIE-J .NE. 0 .OR.
- + LIP+J .NE. 0 .OR.
- + LIM+J-1 .NE. 0) GOTO 70
- 30 CONTINUE
- 100 CONTINUE
- RETURN
- 60 WRITE(*,1001) NREP,N,J,FD(J),FEM,FEL,FEP,LFM,LFE,LFP
- OK = .FALSE.
- RETURN
- 70 WRITE(*,1002) NREP,N,J,ID(J),IEM,IEL,IEP,LIM,LIE,LIP
- OK = .FALSE.
- RETURN
- 900 WRITE(*,1000) IDIM
- RETURN
-1000 FORMAT(34H ??? MORE SPACE NEEDED THAN IDIM =,I3)
-1001 FORMAT(20H ??? ERROR IN LOCATF, / 3I10,4F15.6,3I10)
-1002 FORMAT(20H ??? ERROR IN LOCATI, / 10I8)
- END
diff --git a/src/packlib/kernlib/kernnum/test/numchk3/f002ch.F b/src/packlib/kernlib/kernnum/test/numchk3/f002ch.F
deleted file mode 100644
index c8ca6f4..0000000
--- a/src/packlib/kernlib/kernnum/test/numchk3/f002ch.F
+++ /dev/null
@@ -1,1173 +0,0 @@
-*
-* $Id: f002ch.F,v 1.2 1996/03/21 17:16:08 mclareni Exp $
-*
-* $Log: f002ch.F,v $
-* Revision 1.2 1996/03/21 17:16:08 mclareni
-* Kernnumt corrections for unaligned access on OSF1 by John Marafino, Fermilab
-*
-* Revision 1.1.1.1 1996/02/15 17:48:43 mclareni
-* Kernlib
-*
-*
-#include "kernnumt/pilot.h"
- SUBROUTINE F002CH(NREP,LWORK,W,OK)
- REAL W(LWORK)
- LOGICAL OK, OKT
-#include "kernnumt/sysdat.inc"
- OK = .TRUE.
- DO 100 JREP = 1, NREP
- CALL TF002(LWORK,W,OKT)
- OK = OK .AND. OKT
- 100 CONTINUE
- RETURN
- END
- SUBROUTINE TF002(LWORK,W,OK)
- DIMENSION W(LWORK), HT(3)
-#include "kernnumt/sysdat.inc"
-#include "ch3dat.inc"
-#include "f002dat1.inc"
- LOGICAL OK, ROK, DOK, COK
-* REAL RALPHA(1),RBETA(1)
-* DOUBLE PRECISION DALPHA(1),DBETA(1)
-* COMPLEX CALPHA(1),CBETA(1)
- EXTERNAL RVADD, RVCPY
- EXTERNAL RVMUL, RVMULA, RVMUNA, RVRAN
- EXTERNAL RVSCA, RVSCL, RVSCS, RVSET, RVSUB
- EXTERNAL RVXCH
- EXTERNAL DVADD, DVCPY
- EXTERNAL DVMUL, DVMULA, DVMUNA, DVRAN
- EXTERNAL DVSCA, DVSCL, DVSCS, DVSET, DVSUB
- EXTERNAL DVXCH
- EXTERNAL CVADD, CVCPY
- EXTERNAL CVMUL, CVMULA, CVMUNA, CVRAN
- EXTERNAL CVSCA, CVSCL, CVSCS, CVSET, CVSUB
- EXTERNAL CVXCH
- EXTERNAL RAADD, RADIV, RAMUL, RASUB, RVMAXA
- EXTERNAL RAMULA, RAMUNA, RVRANT, RVDIST, RVDIVT
- EXTERNAL RASCA, RASCL, RASCS, RVSUMT, RASUMT
- EXTERNAL RVMPAT, RAMPAT, RVMPYT, RAMPYT
- EXTERNAL DAADD, DADIV, DAMUL, DASUB, DVMAXA
- EXTERNAL DAMULA, DAMUNA, DVRANT, DVDIST, DVDIVT
- EXTERNAL DASCA, DASCL, DASCS, DVSUMT, DASUMT
- EXTERNAL DVMPAT, DAMPAT, DVMPYT, DAMPYT
- EXTERNAL CAADD, CADIV, CAMUL, CASUB, CVMAXA
- EXTERNAL CAMULA, CAMUNA, CVRANT, CVDIST, CVDIVT
- EXTERNAL CASCA, CASCL, CASCS, CVSUMT, CASUMT
- EXTERNAL CVMPAT, CAMPAT, CVMPYT, CAMPYT
- CHARACTER*4 HT
- DATA HT / 'R ', 'D ', 'C ' /
-#include "f002dat2.inc"
-* DATA RALPHA, RBETA / -100., +100. /
-* DATA DALPHA, DBETA / -100.D0, +100.D0 /
-* DATA CALPHA, CBETA / (-100.,-100.),(+100.,+100.)/
- WRITE(IOUNIT,1001)
- HTYPE = HT(1)
- LENGTH = 1
- TRELPR = RELPRT(1)
- LTAB = LTABT(1)
- CALL XF002(LWORK,W,RALPHA,RBETA,ROK,RVADD,RVCPY,RVDIVT,
- + RVMUL,RVMULA,RVMUNA,RVRAN,RVSCA,RVSCL,RVSCS,
- + RVSET,RVSUB,RVXCH,RVMPYT,RAMPYT,RVRANT,RVMAXA,
- + RASCA,RASCL,RASCS,RVMPAT,RAMPAT,RVSUMT,RASUMT,
- + RAADD,RADIV,RAMUL,RAMULA,RAMUNA,RASUB,RVDIST)
- WRITE(IOUNIT,1002)
- HTYPE = HT(2)
- LENGTH = 2
- TRELPR = RELPRT(2)
- LTAB = LTABT(2)
- CALL XF002(LWORK,W,DALPHA,DBETA,DOK,DVADD,DVCPY,DVDIVT,
- + DVMUL,DVMULA,DVMUNA,DVRAN,DVSCA,DVSCL,DVSCS,
- + DVSET,DVSUB,DVXCH,DVMPYT,DAMPYT,DVRANT,DVMAXA,
- + DASCA,DASCL,DASCS,DVMPAT,DAMPAT,DVSUMT,DASUMT,
- + DAADD,DADIV,DAMUL,DAMULA,DAMUNA,DASUB,DVDIST)
- WRITE(IOUNIT,1003)
- HTYPE = HT(3)
- LENGTH = 2
- TRELPR = RELPRT(1)
- LTAB = LTABT(3)
- CALL XF002(LWORK,W,CALPHA,CBETA,COK,CVADD,CVCPY,CVDIVT,
- + CVMUL,CVMULA,CVMUNA,CVRAN,CVSCA,CVSCL,CVSCS,
- + CVSET,CVSUB,CVXCH,CVMPYT,CAMPYT,CVRANT,CVMAXA,
- + CASCA,CASCL,CASCS,CVMPAT,CAMPAT,CVSUMT,CASUMT,
- + CAADD,CADIV,CAMUL,CAMULA,CAMUNA,CASUB,CVDIST)
- OK = ROK .AND. DOK .AND. COK
- 90 IF(.NOT. OK) WRITE(IOUNIT,1004)
- IF( OK) WRITE(IOUNIT,1005)
- RETURN
-1001 FORMAT(17H1F002. TYPE = R. )
-1002 FORMAT(17H1F002. TYPE = D. )
-1003 FORMAT(17H1F002. TYPE = C. )
-1004 FORMAT(/ 5X, 37H ????? TEST OF F002 HAS FAILED. ????? )
-1005 FORMAT(/35X, 44HACCEPTANCE TEST OF F002 HAS BEEN SUCCESSFUL. )
- END
- SUBROUTINE XF002(LWORK,W,ALPHA,BETA,OK,VADD,VCPY,VDIVT,
- + VMUL,VMULA,VMUNA,VRAN,VSCA,VSCL,VSCS,
- + VSET,VSUB,VXCH,VMPYT,AMPYT,VRANT,VMAXA,
- + ASCA,ASCL,ASCS,VMPAT,AMPAT,VSUMT,ASUMT,
- + AADD,ADIV,AMUL,AMULA,AMUNA,ASUB,VDIST)
- REAL W(LWORK), ALPHA(2), BETA(2)
- EXTERNAL CVMCAT, CAMCAT, CVMPCT, CAMPCT
- LOGICAL OK, OKN, OKT
- DIMENSION HN(2,18), HNAME(2)
- CHARACTER*4 HN, HNAME
-#include "kernnumt/sysdat.inc"
-#include "ch3dat.inc"
-#include "f002dat1.inc"
- DATA HN / 'V ', 'ADD ',
- + 'V ', 'CPY ',
- + 'V ', 'DIV ',
- + 'V ', 'MPA ',
- + 'V ', 'MPY ',
- + 'V ', 'MUL ',
- + 'V ', 'MULA',
- + 'V ', 'MUNA',
- + 'V ', 'RAN ',
- + 'V ', 'SCA ',
- + 'V ', 'SCL ',
- + 'V ', 'SCS ',
- + 'V ', 'SET ',
- + 'V ', 'SUB ',
- + 'V ', 'SUM ',
- + 'V ', 'XCH ',
- + 'V ', 'MPAC',
- + 'V ', 'MPYC' /
-#include "f002dat2.inc"
- NDX1F(J) = (J-1)*LENGTH + 1
- OK = .TRUE.
- LF = LWORK / 11
- LG = (LWORK - 5*LF) / 3
- LA = 1
- LB = LA + LF
- LC = LB + LF
- LR = LC + LF
- LT = LR + LF
- LGA = LT + LF
- LGB = LGA + LG
- LGC = LGB + LG
- IRDIM = LG
- CALL RVSET(IRDIM,VOID(1),W(LGC),W(LGC+1))
- IF(HTYPE .EQ. 'C ') NTEST = 18
- IF(HTYPE .NE. 'C ') NTEST = 16
- CCFLAG = .FALSE.
- DO 300 JTEST = 1, NTEST
- OKT = .TRUE.
- HNAME(1) = HN(1,JTEST)
- HNAME(2) = HN(2,JTEST)
- WRITE(IOUNIT,1001) HTYPE, HNAME
- KNTSKP = LTAB
- 20 DO 200 JTAB = 1, LTAB
- N = NTAB(JTAB)
- IDIM = MAX0(N,1)
- IF(IDIM .GE. 3 .AND. IDIM .LE. 7) IDIM = IDIM + 3
- IF(LF .LT. LENGTH*IDIM**2) GOTO 200
- KNTSKP = KNTSKP - 1
- L2 = NDX1F(2)
- GOTO(01, 02, 04, 08, 09, 10, 11, 12, 13,
- + 14, 15, 16, 17, 18, 19, 21, 22, 23), JTEST
- 01 CALL TVADD(N,W(LA),W(LB),W(LC),W(LR),W(LT),IRDIM,W(LGA),
- + W(LGB),W(LGC),ALPHA,BETA,OKN,
- + VADD,VCPY,VDIST,VMAXA,VSET,VRAN,AADD)
- GOTO 99
- 02 CALL TVCPY(N,W(LC),IRDIM,W(LGA),
- + W(LGC),ALPHA,BETA,OKN,
- + VCPY,VDIST,VSET,VRAN)
- GOTO 99
- 04 CALL TVADD(N,W(LA),W(LB),W(LC),W(LR),W(LT),IRDIM,W(LGA),
- + W(LGB),W(LGC),ALPHA,BETA,OKN,
- + VDIVT,VCPY,VDIST,VMAXA,VSET,VRAN,ADIV)
- GOTO 99
- 08 CALL TVMPA(N,W(LA),W(LB),W(LC),W(LT),ALPHA,BETA,OKN,
- + VMPAT,AMPAT,VDIST,VMAXA,VRAN)
- GOTO 99
- 09 CALL TVMPY(N,W(LA),W(LB),W(LC),W(LT),ALPHA,BETA,OKN,
- + VMPYT,AMPYT,VDIST,VMAXA,VRAN)
- GOTO 99
- 10 CALL TVADD(N,W(LA),W(LB),W(LC),W(LR),W(LT),IRDIM,W(LGA),
- + W(LGB),W(LGC),ALPHA,BETA,OKN,
- + VMUL,VCPY,VDIST,VMAXA,VSET,VRAN,AMUL)
- GOTO 99
- 11 CALL TVADD(N,W(LA),W(LB),W(LC),W(LR),W(LT),IRDIM,W(LGA),
- + W(LGB),W(LGC),ALPHA,BETA,OKN,
- + VMULA,VCPY,VDIST,VMAXA,VSET,VRAN,AMULA)
- GOTO 99
- 12 CALL TVADD(N,W(LA),W(LB),W(LC),W(LR),W(LT),IRDIM,W(LGA),
- + W(LGB),W(LGC),ALPHA,BETA,OKN,
- + VMUNA,VCPY,VDIST,VMAXA,VSET,VRAN,AMUNA)
- GOTO 99
- 13 CALL TVRAN(N,W(LC),IRDIM,W(LGC),ALPHA,BETA,OKN,
- + VRAN,VRANT,VCPY,VDIST,VSET)
- GOTO 99
- 14 CALL TVSCA(N,W(LA),W(LB),W(LC),W(LT),IRDIM,W(LGA),
- + W(LGB),W(LGC),ALPHA,BETA,OKN,
- + VSCA,VCPY,VDIST,VMAXA,VSET,VRAN,ASCA)
- GOTO 99
- 15 CALL TVSCL(N,W(LA),W(LC),W(LT),IRDIM,W(LGA),
- + W(LGC),ALPHA,BETA,OKN,
- + VSCL,VCPY,VDIST,VMAXA,VSET,VRAN,ASCL)
- GOTO 99
- 16 CALL TVSCA(N,W(LA),W(LB),W(LC),W(LT),IRDIM,W(LGA),
- + W(LGB),W(LGC),ALPHA,BETA,OKN,
- + VSCS,VCPY,VDIST,VMAXA,VSET,VRAN,ASCS)
- GOTO 99
- 17 CALL TVSET(N,W(LA),W(LC),IRDIM,W(LGC),ALPHA,BETA,OKN,
- + VSET,VDIST,VRAN)
- GOTO 99
- 18 CALL TVADD(N,W(LA),W(LB),W(LC),W(LR),W(LT),IRDIM,W(LGA),
- + W(LGB),W(LGC),ALPHA,BETA,OKN,
- + VSUB,VCPY,VDIST,VMAXA,VSET,VRAN,ASUB)
- GOTO 99
- 19 CALL TVSUM(N,W(LA),W(LC),W(LT),ALPHA,BETA,OKN,
- + VSUMT,ASUMT,VDIST,VMAXA,VRAN)
- GOTO 99
- 21 CALL TVXCH(N,W(LA),W(LB),IRDIM,W(LGA),
- + W(LGB),ALPHA,BETA,OKN,
- + VXCH,VCPY,VDIST,VSET,VRAN)
- GOTO 99
- 22 CCFLAG = .TRUE.
- CALL TVMPA(N,W(LA),W(LB),W(LC),W(LT),ALPHA,BETA,OKN,
- + CVMCAT,CAMCAT,VDIST,VMAXA,VRAN)
- GOTO 99
- 23 CALL TVMPY(N,W(LA),W(LB),W(LC),W(LT),ALPHA,BETA,OKN,
- + CVMPCT,CAMPCT,VDIST,VMAXA,VRAN)
- GOTO 99
- 99 OKT = OKT .AND. OKN
- 200 CONTINUE
- IF(.NOT. OKT) WRITE(IOUNIT,1010)
- IF( OKT) WRITE(IOUNIT,1011)
- OK = OK .AND. OKT
- 300 CONTINUE
- CCFLAG = .FALSE.
- IF(KNTSKP .NE. 0) WRITE(*,1014) KNTSKP
- IF(.NOT. OK) WRITE(IOUNIT,1012) HTYPE
- IF( OK) WRITE(IOUNIT,1013) HTYPE
- RETURN
-1001 FORMAT(/ 9H TEST OF , 2A1,A4 )
-1010 FORMAT(/ 5X, 37H ????? FEATURE TEST HAS FAILED. ????? )
-1011 FORMAT( 15X, 25H FEATURE TEST SUCCESSFUL. )
-1012 FORMAT(/ 5X, 21H ????? TEST FOR TYPE , A1,
- + 18H HAS FAILED. ????? )
-1013 FORMAT(/25X, 15H TEST FOR TYPE , A1,12H SUCCESSFUL. )
-1014 FORMAT( 20X, 11HWARNING ..., I3,
- + 52H CONFIGURATIONS HAVE BEEN SKIPPED FOR WANT OF SPACE.)
- END
- SUBROUTINE TVADD(N,A,B,C,R,T,IRDIM,GA,GB,GC,ALPHA,BETA,OK,
- + VFCN,VCPY,VDIST,VMAXA,VSET,VRAN,AFCN)
- REAL A(*), B(*), C(*), R(*), T(*), GA(*), GB(*), GC(*)
- REAL ALPHA(2), BETA(2)
- LOGICAL OK, OKL
- REAL R0, RES
- EXTERNAL VDIST, VSET
-#include "kernnumt/sysdat.inc"
-#include "ch3dat.inc"
-#include "f002dat1.inc"
-#include "f002dat2.inc"
- NDX1F(J) = (J-1)*LENGTH + 1
- IRESF(RES) = NINT(RES/TRELPR)
- OKFLAG = .TRUE.
-*
-* CALL VRAN(N,ALPHA,BETA,A,A(L2))
-* CALL VRAN(N,ALPHA,BETA,B,B(L2))
-* CALL VRAN(N,ALPHA,BETA,R,R(L2))
-*JMM
- IF(HTYPE.EQ.'R') THEN
- CALL VRAN(N,RALPHA,RBETA,A,A(L2))
- CALL VRAN(N,RALPHA,RBETA,B,B(L2))
- CALL VRAN(N,RALPHA,RBETA,R,R(L2))
- ELSEIF(HTYPE.EQ.'D') THEN
- CALL VRAN(N,DALPHA,DBETA,A,A(L2))
- CALL VRAN(N,DALPHA,DBETA,B,B(L2))
- CALL VRAN(N,DALPHA,DBETA,R,R(L2))
- ELSEIF(HTYPE.EQ.'C') THEN
- CALL VRAN(N,CALPHA,CBETA,A,A(L2))
- CALL VRAN(N,CALPHA,CBETA,B,B(L2))
- CALL VRAN(N,CALPHA,CBETA,R,R(L2))
- ENDIF
-*
- CALL VCPY(N,R,R(L2),C,C(L2))
- CALL KFLUSH
- CALL VFCN(N,A,A(L2),B,B(L2),C,C(L2))
- CALL VCPY(N,R,R(L2),T,T(L2))
- CALL AFCN(N,A,B,T)
- R0 = VDIST(N,C,C(L2),T,T(L2))
- IF(R0 .EQ. 0.) GOTO 11
- CALL VMAXA(N,T,T(L2),IDUMMY,ABSREF)
- R0 = R0 / ABSREF
- 11 N0 = IRESF(R0)
- M0 = 20
- OK = N0 .LE. M0
- IF(.NOT. OK) WRITE(IOUNIT,1000) N, IDIM, N0, R0
- DO 13 JCNFG = 1, NCNFG
- CALL CNFGMX(N,1,IRDIM,LA,LDMY,LA2)
- CALL CNFGMX(N,1,IRDIM,LB,LDMY,LB2)
- CALL CNFGMX(N,1,IRDIM,LC,LDMY,LC2)
- CALL VCPY(N,A,A(L2),GA(LA),GA(LA2))
- CALL VCPY(N,B,B(L2),GB(LB),GB(LB2))
- CALL VCPY(N,R,R(L2),GC(LC),GC(LC2))
- CALL KFLUSH
- CALL VFCN(N,GA(LA),GA(LA2),GB(LB),GB(LB2),GC(LC),GC(LC2))
- CALL CHECKL(N,1,C,IRDIM,GC,LC,LDMY,LC2,OKL,VDIST,VSET)
- IF(.NOT. OKL) WRITE(IOUNIT,1001) N, JCNFG, LC, LC2
- OK = OK .AND. OKL
- 13 CONTINUE
- OK = OK .AND. OKFLAG
- RETURN
-1000 FORMAT(/ 25H ??? ARITHMETIC ERROR ???, 3I8, 1P, E12.3 )
-1001 FORMAT(/ 20H ??? LOGIC ERROR ???, 4I8 )
- END
- SUBROUTINE RVDIVT(N,X,X2,Y,Y2,Z,Z2)
- REAL X(*), X2(*), Y(*), Y2(*), Z(*), Z2(*)
- REAL S, ZERO
-#include "kernnumt/sysdat.inc"
-#include "ch3dat.inc"
- LOGICAL OK
- IRANF(I,K) = INT( RANF()*FLOAT(K-I+1) ) + I
- DATA ZERO / 0. /
- CALL KFLUSH
- CALL RVDIV(N,X,X2,Y,Y2,Z,Z2,IFAIL)
- OK = IFAIL .EQ. 0
- OKFLAG = OKFLAG .AND. OK
- IF(.NOT. OK) WRITE(IOUNIT,1000) N, IFAIL
- IF(N .LE. 0) RETURN
- KFAIL = IRANF(1,N)
-#if (!defined(CERNLIB_NUMUC))&&(!defined(CERNLIB_NUMCR))&&(!defined(CERNLIB_NUMDE))
- JY = LOCF(Y2) - LOCF(Y)
-#endif
-#if defined(CERNLIB_NUMUC)||defined(CERNLIB_NUMCR)
- JY = LOC(Y2) - LOC(Y)
-#endif
-#if defined(CERNLIB_NUMDE)
- JY = (%LOC(Y2) - %LOC(Y)) / 4
-#endif
- LY = (KFAIL - 1)*JY + 1
- S = Y(LY)
- Y(LY) = ZERO
- CALL KFLUSH
- CALL RVDIV(N,X,X2,Y,Y2,Z,Z2,IFAIL)
- OK = IFAIL .EQ. KFAIL
- OKFLAG = OKFLAG .AND. OK
- IF(.NOT. OK) WRITE(IOUNIT,1001) N, KFAIL, IFAIL
- Y(LY) = S
- RETURN
-1000 FORMAT(/ 31H ??? RVDIV DOES NOT CLEAR IFAIL, 2I8)
-1001 FORMAT(/ 34H ??? RVDIV SETS IFAIL INCORRECTLY ,3I8)
- END
- SUBROUTINE DVDIVT(N,X,X2,Y,Y2,Z,Z2)
- DOUBLE PRECISION X(*), X2(*), Y(*), Y2(*), Z(*), Z2(*)
- DOUBLE PRECISION S, ZERO
-#include "kernnumt/sysdat.inc"
-#include "ch3dat.inc"
- LOGICAL OK
- IRANF(I,K) = INT( RANF()*FLOAT(K-I+1) ) + I
- DATA ZERO / 0.D0 /
- CALL KFLUSH
- CALL DVDIV(N,X,X2,Y,Y2,Z,Z2,IFAIL)
- OK = IFAIL .EQ. 0
- OKFLAG = OKFLAG .AND. OK
- IF(.NOT. OK) WRITE(IOUNIT,1000) N, IFAIL
- IF(N .LE. 0) RETURN
- KFAIL = IRANF(1,N)
-#if (!defined(CERNLIB_NUMUC))&&(!defined(CERNLIB_NUMCR))&&(!defined(CERNLIB_NUMDE))
- JY = (LOCF(Y2) - LOCF(Y)) / 2
-#endif
-#if defined(CERNLIB_NUMUC)||defined(CERNLIB_NUMCR)
- JY = (LOC(Y2) - LOC(Y)) / 2
-#endif
-#if defined(CERNLIB_NUMDE)
- JY = (%LOC(Y2) - %LOC(Y)) / 8
-#endif
- LY = (KFAIL - 1)*JY + 1
- S = Y(LY)
- Y(LY) = ZERO
- CALL KFLUSH
- CALL DVDIV(N,X,X2,Y,Y2,Z,Z2,IFAIL)
- OK = IFAIL .EQ. KFAIL
- OKFLAG = OKFLAG .AND. OK
- IF(.NOT. OK) WRITE(IOUNIT,1001) N, KFAIL, IFAIL
- Y(LY) = S
- RETURN
-1000 FORMAT(/ 31H ??? DVDIV DOES NOT CLEAR IFAIL, 2I8)
-1001 FORMAT(/ 34H ??? DVDIV SETS IFAIL INCORRECTLY ,3I8)
- END
- SUBROUTINE CVDIVT(N,X,X2,Y,Y2,Z,Z2)
- COMPLEX X(*), X2(*), Y(*), Y2(*), Z(*), Z2(*)
- COMPLEX S, ZERO
-#include "kernnumt/sysdat.inc"
-#include "ch3dat.inc"
- LOGICAL OK
- IRANF(I,K) = INT( RANF()*FLOAT(K-I+1) ) + I
- DATA ZERO / (0.,0.) /
- CALL KFLUSH
- CALL CVDIV(N,X,X2,Y,Y2,Z,Z2,IFAIL)
- OK = IFAIL .EQ. 0
- OKFLAG = OKFLAG .AND. OK
- IF(.NOT. OK) WRITE(IOUNIT,1000) N, IFAIL
- IF(N .LE. 0) RETURN
- KFAIL = IRANF(1,N)
-#if (!defined(CERNLIB_NUMUC))&&(!defined(CERNLIB_NUMCR))&&(!defined(CERNLIB_NUMDE))
- JY = (LOCF(Y2) - LOCF(Y)) / 2
-#endif
-#if defined(CERNLIB_NUMUC)||defined(CERNLIB_NUMCR)
- JY = (LOC(Y2) - LOC(Y)) / 2
-#endif
-#if defined(CERNLIB_NUMDE)
- JY = (%LOC(Y2) - %LOC(Y)) / 8
-#endif
- LY = (KFAIL - 1)*JY + 1
- S = Y(LY)
- Y(LY) = ZERO
- CALL KFLUSH
- CALL CVDIV(N,X,X2,Y,Y2,Z,Z2,IFAIL)
- OK = IFAIL .EQ. KFAIL
- OKFLAG = OKFLAG .AND. OK
- IF(.NOT. OK) WRITE(IOUNIT,1001) N, KFAIL, IFAIL
- Y(LY) = S
- RETURN
-1000 FORMAT(/ 31H ??? CVDIV DOES NOT CLEAR IFAIL, 2I8)
-1001 FORMAT(/ 34H ??? CVDIV SETS IFAIL INCORRECTLY ,3I8)
- END
- SUBROUTINE TVCPY(N,C,IRDIM,GA,GC,ALPHA,BETA,OK,
- + VCPY,VDIST,VSET,VRAN)
- REAL C(*), GA(*), GC(*)
- REAL ALPHA(2), BETA(2)
- LOGICAL OK, OKL
- EXTERNAL VDIST, VSET
-#include "kernnumt/sysdat.inc"
-#include "ch3dat.inc"
-#include "f002dat1.inc"
-#include "f002dat2.inc"
- OK = .TRUE.
-*JMM
-* CALL VRAN(N,ALPHA,BETA,C,C(L2))
- IF(HTYPE.EQ.'R') CALL VRAN(N,RALPHA,RBETA,C,C(L2))
- IF(HTYPE.EQ.'D') CALL VRAN(N,DALPHA,DBETA,C,C(L2))
- IF(HTYPE.EQ.'C') CALL VRAN(N,CALPHA,CBETA,C,C(L2))
-*
- DO 13 JCNFG = 1, NCNFG
- CALL CNFGMX(N,1,IRDIM,LA,LDMY,LA2)
- CALL CNFGMX(N,1,IRDIM,LC,LDMY,LC2)
- CALL VCPY(N,C,C(L2),GA(LA),GA(LA2))
- CALL KFLUSH
- CALL VCPY(N,GA(LA),GA(LA2),GC(LC),GC(LC2))
- CALL CHECKL(N,1,C,IRDIM,GC,LC,LDMY,LC2,OKL,VDIST,VSET)
- IF(.NOT. OKL) WRITE(IOUNIT,1001) N,JCNFG,LC,LC2
- OK = OK .AND. OKL
- 13 CONTINUE
- RETURN
-1001 FORMAT(/ 20H ??? LOGIC ERROR ???, 4I8 )
- END
- SUBROUTINE TVSCA(N,A,B,C,T,IRDIM,GA,GB,GC,ALPHA,BETA,OK,
- + VFCN,VCPY,VDIST,VMAXA,VSET,VRAN,AFCN)
- REAL A(*), B(*), C(*), T(*), GA(*), GB(*), GC(*)
- REAL ALPHA(2), BETA(2)
- LOGICAL OK, OKL
- REAL R0, RES
- EXTERNAL VDIST, VSET
-#include "kernnumt/sysdat.inc"
-#include "ch3dat.inc"
-#include "f002dat1.inc"
-#include "f002dat2.inc"
- NDX1F(J) = (J-1)*LENGTH + 1
- IRESF(RES) = NINT(RES/TRELPR)
-*
-* CALL VRAN(N,ALPHA,BETA,A,A(L2))
-* CALL VRAN(N,ALPHA,BETA,B,B(L2))
-*JMM
- IF(HTYPE.EQ.'R') THEN
- CALL VRAN(N,RALPHA,RBETA,A,A(L2))
- CALL VRAN(N,RALPHA,RBETA,B,B(L2))
- ELSEIF(HTYPE.EQ.'D') THEN
- CALL VRAN(N,DALPHA,DBETA,A,A(L2))
- CALL VRAN(N,DALPHA,DBETA,B,B(L2))
- ELSE
- CALL VRAN(N,CALPHA,CBETA,A,A(L2))
- CALL VRAN(N,CALPHA,CBETA,B,B(L2))
- ENDIF
-*
- CALL KFLUSH
- CALL VFCN(N,A,A,A(L2),B,B(L2),C,C(L2))
- CALL AFCN(N,A,A,B,T)
- R0 = VDIST(N,C,C(L2),T,T(L2))
- IF(R0 .EQ. 0.) GOTO 11
- CALL VMAXA(N,T,T(L2),IDUMMY,ABSREF)
- R0 = R0 / ABSREF
- 11 N0 = IRESF(R0)
- M0 = 20
- OK = N0 .LE. M0
- IF(.NOT. OK) WRITE(IOUNIT,1000) N, IDIM, N0, R0
- DO 13 JCNFG = 1, NCNFG
- CALL CNFGMX(N,1,IRDIM,LA,LDMY,LA2)
- CALL CNFGMX(N,1,IRDIM,LB,LDMY,LB2)
- CALL CNFGMX(N,1,IRDIM,LC,LDMY,LC2)
- CALL VCPY(N,A,A(L2),GA(LA),GA(LA2))
- CALL VCPY(N,B,B(L2),GB(LB),GB(LB2))
- CALL KFLUSH
- CALL VFCN(N,GA(LA),GA(LA),GA(LA2),GB(LB),GB(LB2),
- + GC(LC),GC(LC2))
- CALL CHECKL(N,1,C,IRDIM,GC,LC,LDMY,LC2,OKL,VDIST,VSET)
- IF(.NOT. OKL) WRITE(IOUNIT,1001) N, JCNFG, LC, LC2
- OK = OK .AND. OKL
- 13 CONTINUE
- RETURN
-1000 FORMAT(/ 25H ??? ARITHMETIC ERROR ???, 3I8, 1P, E12.3 )
-1001 FORMAT(/ 20H ??? LOGIC ERROR ???, 4I8 )
- END
- SUBROUTINE TVSCL(N,A,C,T,IRDIM,GA,GC,ALPHA,BETA,OK,
- + VSCL,VCPY,VDIST,VMAXA,VSET,VRAN,ASCL)
- REAL A(*), C(*), T(*), GA(*), GC(*)
- REAL ALPHA(2), BETA(2)
- LOGICAL OK, OKL
- REAL R0, RES
- EXTERNAL VDIST, VSET
-#include "kernnumt/sysdat.inc"
-#include "ch3dat.inc"
-#include "f002dat1.inc"
-#include "f002dat2.inc"
- NDX1F(J) = (J-1)*LENGTH + 1
- IRESF(RES) = NINT(RES/TRELPR)
-*
-* CALL VRAN(N,ALPHA,BETA,A,A(L2))
-*JMM
- IF(HTYPE.EQ.'R') CALL VRAN(N,RALPHA,RBETA,A,A(L2))
- IF(HTYPE.EQ.'D') CALL VRAN(N,DALPHA,DBETA,A,A(L2))
- IF(HTYPE.EQ.'C') CALL VRAN(N,CALPHA,CBETA,A,A(L2))
-*
- CALL KFLUSH
- CALL VSCL(N,A,A,A(L2),C,C(L2))
- CALL ASCL(N,A,A,T)
- R0 = VDIST(N,C,C(L2),T,T(L2))
- IF(R0 .EQ. 0.) GOTO 11
- CALL VMAXA(N,T,T(L2),IDUMMY,ABSREF)
- R0 = R0 / ABSREF
- 11 N0 = IRESF(R0)
- M0 = 20
- OK = N0 .LE. M0
- IF(.NOT. OK) WRITE(IOUNIT,1000) N, IDIM, N0, R0
- DO 13 JCNFG = 1, NCNFG
- CALL CNFGMX(N,1,IRDIM,LA,LDMY,LA2)
- CALL CNFGMX(N,1,IRDIM,LC,LDMY,LC2)
- CALL VCPY(N,A,A(L2),GA(LA),GA(LA2))
- CALL KFLUSH
- CALL VSCL(N,GA(LA),GA(LA),GA(LA2),GC(LC),GC(LC2))
- CALL CHECKL(N,1,C,IRDIM,GC,LC,LDMY,LC2,OKL,VDIST,VSET)
- IF(.NOT. OKL) WRITE(IOUNIT,1001) N, JCNFG, LC, LC2
- OK = OK .AND. OKL
- 13 CONTINUE
- RETURN
-1000 FORMAT(/ 25H ??? ARITHMETIC ERROR ???, 3I8, 1P, E12.3 )
-1001 FORMAT(/ 20H ??? LOGIC ERROR ???, 4I8 )
- END
- SUBROUTINE TVRAN(N,C,IRDIM,GC,ALPHA,BETA,OK,
- + VRAN,VRANT,VCPY,VDIST,VSET)
- REAL C(*), GC(*)
- REAL ALPHA(2), BETA(2)
- LOGICAL OK, OKL, OKC
- REAL R0, R1, R2, P, Q
- EXTERNAL VDIST, VSET
-#include "kernnumt/sysdat.inc"
-#include "ch3dat.inc"
-#include "f002dat1.inc"
-#include "f002dat2.inc"
-*
-* R0 = VDIST(1,ALPHA,DMY,BETA,DMY)
-* CALL VSET(N,ALPHA,C,C(L2))
-* CALL KFLUSH
-* CALL VRAN(N,ALPHA,BETA,C,C(L2))
-* R1 = VDIST(N,C,C(L2),ALPHA,ALPHA)
-* R2 = VDIST(N,C,C(L2),BETA,BETA)
-*JMM
- IF(HTYPE.EQ.'R') THEN
- R0 = VDIST(1,RALPHA,DMY,RBETA,DMY)
- CALL VSET(N,RALPHA,C,C(L2))
- CALL KFLUSH
- CALL VRAN(N,RALPHA,RBETA,C,C(L2))
- R1 = VDIST(N,C,C(L2),RALPHA,RALPHA)
- R2 = VDIST(N,C,C(L2),RBETA,RBETA)
- ELSEIF(HTYPE.EQ.'D') THEN
- R0 = VDIST(1,DALPHA,DMY,DBETA,DMY)
- CALL VSET(N,DALPHA,C,C(L2))
- CALL KFLUSH
- CALL VRAN(N,DALPHA,DBETA,C,C(L2))
- R1 = VDIST(N,C,C(L2),DALPHA,DALPHA)
- R2 = VDIST(N,C,C(L2),DBETA,DBETA)
- ELSE
- R0 = VDIST(1,CALPHA,DMY,CBETA,DMY)
- CALL VSET(N,CALPHA,C,C(L2))
- CALL KFLUSH
- CALL VRAN(N,CALPHA,CBETA,C,C(L2))
- R1 = VDIST(N,C,C(L2),CALPHA,CALPHA)
- R2 = VDIST(N,C,C(L2),CBETA,CBETA)
- ENDIF
-*
- OK = AMAX1(R1,R2) .LT. R0
- IF(.NOT. OK) WRITE(IOUNIT,1000) N, IDIM, R0, R1, R2
- DO 13 JCNFG = 1, NCNFG
- CALL CNFGMX(N,1,IRDIM,LC,LDMY,LC2)
- CALL KFLUSH
-*
-* CALL VRAN(N,ALPHA,BETA,GC(LC),GC(LC2))
-*JMM
- IF(HTYPE.EQ.'R') CALL VRAN(N,RALPHA,RBETA,GC(LC),GC(LC2))
- IF(HTYPE.EQ.'D') CALL VRAN(N,DALPHA,DBETA,GC(LC),GC(LC2))
- IF(HTYPE.EQ.'C') CALL VRAN(N,CALPHA,CBETA,GC(LC),GC(LC2))
-*
- CALL VCPY(N,GC(LC),GC(LC2),C,C(L2))
- CALL CHECKL(N,1,C,IRDIM,GC,LC,LDMY,LC2,OKL,VDIST,VSET)
- IF(.NOT. OKL) WRITE(IOUNIT,1001) N, JCNFG, LC, LC2
- OK = OK .AND. OKL
- 13 CONTINUE
- P = -1.
- Q = +3.
- AMEAN = (P+Q) / 2.
- SIGMA2 = (Q-P)**2 / 12.
- K = 1000
- CALL VRANT(P,Q,C(1),C(1),K)
- CALL RVVAR(K,AMEAN,C(1),C(2),CM,CM2,DUMMY)
- DM = ABS(CM - AMEAN)
- DM2 = ABS(CM2-SIGMA2)
- CL = 2.*ABS(Q - P) / SQRT(3.*FLOAT(K))
- CL2 = 8.*SIGMA2 / SQRT(5.*FLOAT(K))
- OKC = DM .LE. CL .AND. DM2 .LE. CL2
- IF(.NOT. OKC) WRITE(IOUNIT,1002) N,K,P,Q, AMEAN,CM,DM,CL,
- + SIGMA2,CM2,DM2,CL2
- OK = OK .AND .OKC
- RETURN
-1000 FORMAT(/ 25H ??? ARITHMETIC ERROR ???, 2I8, 1P, 3E12.3)
-1001 FORMAT(/ 20H ??? LOGIC ERROR ???, 4I8)
-1002 FORMAT(/ 27H ??? DISTRIBUTION ERROR ???, 2I8,
- + / 1X, 2F8.2, 5X, 4F12.3,
- + / 22X, 4F12.3 )
- END
- SUBROUTINE RVRANT(P,Q,T,R,K)
- REAL T(K), R(K)
- CALL RVRAN(K,P,Q,R(1),R(2))
- RETURN
- END
- SUBROUTINE DVRANT(P,Q,T,R,K)
- DOUBLE PRECISION T(K), PHI, PSI
- REAL R(K)
- PHI = DBLE(P)
- PSI = DBLE(Q)
- CALL DVRAN(K,PHI,PSI,T(1),T(2))
- DO 10 J = 1, K
- R(J) = SNGL(T(J))
- 10 CONTINUE
- RETURN
- END
- SUBROUTINE CVRANT(P,Q,T,R,K)
- COMPLEX T(K), PHI, PSI
- REAL R(K)
- PHI = CMPLX(P,P)
- PSI = CMPLX(Q,Q)
- CALL CVRAN(K,PHI,PSI,T(1),T(2))
- DO 10 J = 1, K
- R(2*J-1) = REAL(T(J))
- R(2*J) = AIMAG(T(J))
- 10 CONTINUE
- K = 2 * K
- RETURN
- END
- SUBROUTINE TVMPY(N,A,B,C,T,ALPHA,BETA,OK,
- + VMPYT,AMPYT,VDIST,VMAXA,VRAN)
- REAL A(*), B(*), C(*), T(*)
- REAL ALPHA(2), BETA(2)
- LOGICAL OK
- REAL R0, RES
-#include "kernnumt/sysdat.inc"
-#include "ch3dat.inc"
-#include "f002dat1.inc"
-#include "f002dat2.inc"
- IRESF(RES) = NINT(RES/TRELPR)
- OKFLAG = .TRUE.
-*
-* CALL VRAN(N,ALPHA,BETA,A,A(L2))
-* CALL VRAN(N,ALPHA,BETA,B,B(L2))
-*JMM
- IF(HTYPE.EQ.'R') THEN
- CALL VRAN(N,RALPHA,RBETA,A,A(L2))
- CALL VRAN(N,RALPHA,RBETA,B,B(L2))
- ELSEIF(HTYPE.EQ.'D') THEN
- CALL VRAN(N,DALPHA,DBETA,A,A(L2))
- CALL VRAN(N,DALPHA,DBETA,B,B(L2))
- ELSE
- CALL VRAN(N,CALPHA,CBETA,A,A(L2))
- CALL VRAN(N,CALPHA,CBETA,B,B(L2))
- ENDIF
-*
- CALL VMPYT(N,A,A(L2),B,B(L2),C)
- CALL AMPYT(N,A,B,T)
- R0 = VDIST(1,C,C(L2),T,T(L2))
- IF(R0 .EQ. 0.) GOTO 11
- CALL VMAXA(1,T,DMY,IDUMMY,ABSREF)
- R0 = R0 / ABSREF
- 11 N0 = IRESF(R0)
- M0 = 400
- OK = N0 .LE. M0
- IF(.NOT. OK) WRITE(IOUNIT,1000) N, IDIM, M0, N0, R0, ABSREF
- OK = OK .AND. OKFLAG
- RETURN
-1000 FORMAT(/ 25H ??? ARITHMETIC ERROR ???, 4I8, 1P, 2E12.3 )
- END
- SUBROUTINE RVMPYT(N,X,X2,Y,Y2,Z)
- REAL X(*), X2(*), Y(*), Y2(*), Z, RVMPY
-#include "kernnumt/sysdat.inc"
-#include "ch3dat.inc"
- CALL KFLUSH
- Z = RVMPY(N,X,X2,Y,Y2)
- IF(N .GT. 0 .OR. Z .EQ. 0.) RETURN
- OKFLAG = .FALSE.
- WRITE(IOUNIT,1000) N
- RETURN
-1000 FORMAT(/ 37H ??? VECTOR FUNCTION NOT ZERO FOR N =, I3)
- END
- SUBROUTINE DVMPYT(N,X,X2,Y,Y2,Z)
- DOUBLE PRECISION X(*), X2(*), Y(*), Y2(*), Z, DVMPY
-#include "kernnumt/sysdat.inc"
-#include "ch3dat.inc"
- CALL KFLUSH
- Z = DVMPY(N,X,X2,Y,Y2)
- IF(N .GT. 0 .OR. Z .EQ. 0.D0) RETURN
- OKFLAG = .FALSE.
- WRITE(IOUNIT,1000) N
- RETURN
-1000 FORMAT(/ 37H ??? VECTOR FUNCTION NOT ZERO FOR N =, I3)
- END
- SUBROUTINE CVMPYT(N,X,X2,Y,Y2,Z)
- COMPLEX X(*), X2(*), Y(*), Y2(*), Z, CVMPY
-#include "kernnumt/sysdat.inc"
-#include "ch3dat.inc"
- CALL KFLUSH
- Z = CVMPY(N,X,X2,Y,Y2)
- IF(N .GT. 0 .OR. AMAX1(REAL(Z),AIMAG(Z)) .EQ. 0.) RETURN
- OKFLAG = .FALSE.
- WRITE(IOUNIT,1000) N
- RETURN
-1000 FORMAT(/ 37H ??? VECTOR FUNCTION NOT ZERO FOR N =, I3)
- END
- SUBROUTINE CVMPCT(N,X,X2,Y,Y2,Z)
- COMPLEX X(*), X2(*), Y(*), Y2(*), Z, CVMPYC
-#include "kernnumt/sysdat.inc"
-#include "ch3dat.inc"
- CALL KFLUSH
- Z = CVMPYC(N,X,X2,Y,Y2)
- IF(N .GT. 0 .OR. AMAX1(REAL(Z),AIMAG(Z)) .EQ. 0.) RETURN
- OKFLAG = .FALSE.
- WRITE(IOUNIT,1000) N
- RETURN
-1000 FORMAT(/ 37H ??? VECTOR FUNCTION NOT ZERO FOR N =, I3)
- END
- SUBROUTINE RAMPYT(N,X,Y,Z)
- REAL X(*), Y(*), Z, RAMPY
-#include "kernnumt/sysdat.inc"
-#include "ch3dat.inc"
- Z = RAMPY(N,X,Y)
- IF(N .GT. 0 .OR. Z .EQ. 0.) RETURN
- OKFLAG = .FALSE.
- WRITE(IOUNIT,1000) N
- RETURN
-1000 FORMAT(/ 36H ??? ARRAY FUNCTION NOT ZERO FOR N =, I3)
- END
- SUBROUTINE DAMPYT(N,X,Y,Z)
- DOUBLE PRECISION X(*), Y(*), Z, DAMPY
-#include "kernnumt/sysdat.inc"
-#include "ch3dat.inc"
- Z = DAMPY(N,X,Y)
- IF(N .GT. 0 .OR. Z .EQ. 0.D0) RETURN
- OKFLAG = .FALSE.
- WRITE(IOUNIT,1000) N
- RETURN
-1000 FORMAT(/ 36H ??? ARRAY FUNCTION NOT ZERO FOR N =, I3)
- END
- SUBROUTINE CAMPYT(N,X,Y,Z)
- COMPLEX X(*), Y(*), Z, CAMPY
-#include "kernnumt/sysdat.inc"
-#include "ch3dat.inc"
- Z = CAMPY(N,X,Y)
- IF(N .GT. 0 .OR. AMAX1(REAL(Z),AIMAG(Z)) .EQ. 0.) RETURN
- OKFLAG = .FALSE.
- WRITE(IOUNIT,1000) N
- RETURN
-1000 FORMAT(/ 36H ??? ARRAY FUNCTION NOT ZERO FOR N =, I3)
- END
- SUBROUTINE CAMPCT(N,X,Y,Z)
- COMPLEX X(*), Y(*), Z, CAMPYC
-#include "kernnumt/sysdat.inc"
-#include "ch3dat.inc"
- Z = CAMPYC(N,X,Y)
- IF(N .GT. 0 .OR. AMAX1(REAL(Z),AIMAG(Z)) .EQ. 0.) RETURN
- OKFLAG = .FALSE.
- WRITE(IOUNIT,1000) N
- RETURN
-1000 FORMAT(/ 36H ??? ARRAY FUNCTION NOT ZERO FOR N =, I3)
- END
- SUBROUTINE TVMPA(N,A,B,C,T,ALPHA,BETA,OK,
- + VMPAT,AMPAT,VDIST,VMAXA,VRAN)
- REAL A(*), B(*), C(*), T(*)
- REAL ALPHA(2), BETA(2)
- LOGICAL OK
- REAL R0, RES
-#include "kernnumt/sysdat.inc"
-#include "ch3dat.inc"
-#include "f002dat1.inc"
-#include "f002dat2.inc"
- IRESF(RES) = NINT(RES/TRELPR)
- OKFLAG = .TRUE.
-*
-* IF(N .LE. 0) CALL VRAN(1,ALPHA,BETA,A,DMY)
-* CALL VRAN(N,ALPHA,BETA,A,A(L2))
-* CALL VRAN(N,ALPHA,BETA,B,B(L2))
-*JMM
- IF(HTYPE.EQ.'R') THEN
- IF(N .LE. 0) CALL VRAN(1,RALPHA,RBETA,A,DMY)
- CALL VRAN(N,RALPHA,RBETA,A,A(L2))
- CALL VRAN(N,RALPHA,RBETA,B,B(L2))
- ELSEIF(HTYPE.EQ.'D') THEN
- IF(N .LE. 0) CALL VRAN(1,DALPHA,DBETA,A,DMY)
- CALL VRAN(N,DALPHA,DBETA,A,A(L2))
- CALL VRAN(N,DALPHA,DBETA,B,B(L2))
- ELSE
- IF(N .LE. 0) CALL VRAN(1,CALPHA,CBETA,A,DMY)
- CALL VRAN(N,CALPHA,CBETA,A,A(L2))
- CALL VRAN(N,CALPHA,CBETA,B,B(L2))
- ENDIF
-*
- CALL VMPAT(N,A,A(L2),B,B(L2),A,C)
- CALL AMPAT(N,A,B,A,T)
- R0 = VDIST(1,C,DMY,T,DMY)
- IF(R0 .EQ. 0.) GOTO 11
- CALL VMAXA(1,T,DMY,IDUMMY,ABSREF)
- R0 = R0 / ABSREF
- 11 N0 = IRESF(R0)
- M0 = 400
- OK = N0 .LE. M0
- IF(.NOT. OK) WRITE(IOUNIT,1000) N, IDIM, M0, N0, R0, ABSREF
- OK = OK .AND. OKFLAG
- RETURN
-1000 FORMAT(/ 25H ??? ARITHMETIC ERROR ???, 4I8, 1P, 2E12.3 )
- END
- SUBROUTINE RVMPAT(N,X,X2,Y,Y2,S,Z)
- REAL X(*), X2(*), Y(*), Y2(*), S, Z, RVMPA
-#include "kernnumt/sysdat.inc"
-#include "ch3dat.inc"
- CALL KFLUSH
- Z = RVMPA(N,X,X2,Y,Y2,S)
- IF(N .GT. 0 .OR. Z .EQ. S) RETURN
- OKFLAG = .FALSE.
- WRITE(IOUNIT,1000) N
- RETURN
-1000 FORMAT(/ 34H ??? VECTOR FUNCTION FAILS FOR N =, I3)
- END
- SUBROUTINE DVMPAT(N,X,X2,Y,Y2,S,Z)
- DOUBLE PRECISION X(*), X2(*), Y(*), Y2(*), S, Z, DVMPA
-#include "kernnumt/sysdat.inc"
-#include "ch3dat.inc"
- CALL KFLUSH
- Z = DVMPA(N,X,X2,Y,Y2,S)
- IF(N .GT. 0 .OR. Z .EQ. S) RETURN
- OKFLAG = .FALSE.
- WRITE(IOUNIT,1000) N
- RETURN
-1000 FORMAT(/ 34H ??? VECTOR FUNCTION FAILS FOR N =, I3)
- END
- SUBROUTINE CVMPAT(N,X,X2,Y,Y2,S,Z)
- COMPLEX X(*), X2(*), Y(*), Y2(*), S, Z, CVMPA
-#include "kernnumt/sysdat.inc"
-#include "ch3dat.inc"
- CALL KFLUSH
- Z = CVMPA(N,X,X2,Y,Y2,S)
- IF(N .GT. 0 .OR.
- + (REAL(Z) .EQ. REAL(S) .AND. AIMAG(Z) .EQ. AIMAG(S)))
- + RETURN
- OKFLAG = .FALSE.
- WRITE(IOUNIT,1000) N
- RETURN
-1000 FORMAT(/ 34H ??? VECTOR FUNCTION FAILS FOR N =, I3)
- END
- SUBROUTINE CVMCAT(N,X,X2,Y,Y2,S,Z)
- COMPLEX X(*), X2(*), Y(*), Y2(*), S, Z, CVMPAC
-#include "kernnumt/sysdat.inc"
-#include "ch3dat.inc"
- CALL KFLUSH
- Z = CVMPAC(N,X,X2,Y,Y2,S)
- IF(N .GT. 0 .OR.
- + (REAL(Z) .EQ. REAL(S) .AND. AIMAG(Z) .EQ. AIMAG(S)))
- + RETURN
- OKFLAG = .FALSE.
- WRITE(IOUNIT,1000) N
- RETURN
-1000 FORMAT(/ 34H ??? VECTOR FUNCTION FAILS FOR N =, I3)
- END
- SUBROUTINE RAMPAT(N,X,Y,S,Z)
- REAL X(*), Y(*), S, Z, RAMPA
-#include "kernnumt/sysdat.inc"
-#include "ch3dat.inc"
- Z = RAMPA(N,X,Y,S)
- IF(N .GT. 0 .OR. Z .EQ. S) RETURN
- OKFLAG = .FALSE.
- WRITE(IOUNIT,1000) N
- RETURN
-1000 FORMAT(/ 33H ??? ARRAY FUNCTION FAILS FOR N =, I3)
- END
- SUBROUTINE DAMPAT(N,X,Y,S,Z)
- DOUBLE PRECISION X(*), Y(*), S, Z, DAMPA
-#include "kernnumt/sysdat.inc"
-#include "ch3dat.inc"
- Z = DAMPA(N,X,Y,S)
- IF(N .GT. 0 .OR. Z .EQ. S) RETURN
- OKFLAG = .FALSE.
- WRITE(IOUNIT,1000) N
- RETURN
-1000 FORMAT(/ 33H ??? ARRAY FUNCTION FAILS FOR N =, I3)
- END
- SUBROUTINE CAMPAT(N,X,Y,S,Z)
- COMPLEX X(*), Y(*), S, Z, CAMPA
-#include "kernnumt/sysdat.inc"
-#include "ch3dat.inc"
- Z = CAMPA(N,X,Y,S)
- IF(N .GT. 0 .OR.
- + (REAL(Z) .EQ. REAL(S) .AND. AIMAG(Z) .EQ. AIMAG(S)))
- + RETURN
- OKFLAG = .FALSE.
- WRITE(IOUNIT,1000) N
- RETURN
-1000 FORMAT(/ 33H ??? ARRAY FUNCTION FAILS FOR N =, I3)
- END
- SUBROUTINE CAMCAT(N,X,Y,S,Z)
- COMPLEX X(*), Y(*), S, Z, CAMPAC
-#include "kernnumt/sysdat.inc"
-#include "ch3dat.inc"
- Z = CAMPAC(N,X,Y,S)
- IF(N .GT. 0 .OR.
- + (REAL(Z) .EQ. REAL(S) .AND. AIMAG(Z) .EQ. AIMAG(S)))
- + RETURN
- OKFLAG = .FALSE.
- WRITE(IOUNIT,1000) N
- RETURN
-1000 FORMAT(/ 33H ??? ARRAY FUNCTION FAILS FOR N =, I3)
- END
- SUBROUTINE TVSET(N,A,C,IRDIM,GC,ALPHA,BETA,OK,
- + VSET,VDIST,VRAN)
- REAL A(*), C(*), GC(*)
- REAL ALPHA(2), BETA(2)
- LOGICAL OK, OKL
- REAL R0, RES
- EXTERNAL VDIST, VSET
-#include "kernnumt/sysdat.inc"
-#include "ch3dat.inc"
-#include "f002dat1.inc"
-#include "f002dat2.inc"
- IRESF(RES) = NINT(RES/TRELPR)
- OK = .TRUE.
- IF(N .LE. 0) GOTO 12
-*
-* CALL VRAN(1,ALPHA,BETA,A,DMY)
-*JMM
- IF(HTYPE.EQ.'R') CALL VRAN(1,RALPHA,RBETA,A,DMY)
- IF(HTYPE.EQ.'D') CALL VRAN(1,DALPHA,DBETA,A,DMY)
- IF(HTYPE.EQ.'C') CALL VRAN(1,CALPHA,CBETA,A,DMY)
-*
- CALL KFLUSH
- CALL VSET(N,A,C,C(L2))
- R0 = VDIST(N,C,C(L2),A,A)
- N0 = IRESF(R0)
- M0 = 0
- OK = N0 .LE. M0
- IF(.NOT. OK) WRITE(IOUNIT,1000) N, IDIM, M0, N0, R0
- 12 DO 13 JCNFG = 1, NCNFG
- CALL CNFGMX(N,1,IRDIM,LC,LDMY,LC2)
- CALL KFLUSH
- CALL VSET(N,A,GC(LC),GC(LC2))
- CALL CHECKL(N,1,C,IRDIM,GC,LC,LDMY,LC2,OKL,VDIST,VSET)
- IF(.NOT. OKL) WRITE(IOUNIT,1001) N, JCNFG, LC, LC2
- OK = OK .AND. OKL
- 13 CONTINUE
- RETURN
-1000 FORMAT(/ 25H ??? ARITHMETIC ERROR ???, 4I8,1P,E12.3 )
-1001 FORMAT(/ 20H ??? LOGIC ERROR ???, 4I8 )
- END
- SUBROUTINE TVSUM(N,A,C,T,ALPHA,BETA,OK,
- + VSUMT,ASUMT,VDIST,VMAXA,VRAN)
- REAL A(*), C(*), T(*)
- REAL ALPHA(2), BETA(2)
- LOGICAL OK
- REAL R0, RES
-#include "kernnumt/sysdat.inc"
-#include "ch3dat.inc"
-#include "f002dat1.inc"
-#include "f002dat2.inc"
- IRESF(RES) = NINT(RES/TRELPR)
- OKFLAG = .TRUE.
-*
-* CALL VRAN(N,ALPHA,BETA,A,A(L2))
-*JMM
- IF(HTYPE.EQ.'R') CALL VRAN(N,RALPHA,RBETA,A,A(L2))
- IF(HTYPE.EQ.'D') CALL VRAN(N,DALPHA,DBETA,A,A(L2))
- IF(HTYPE.EQ.'C') CALL VRAN(N,CALPHA,CBETA,A,A(L2))
-*
- CALL VSUMT(N,A,A(L2),C)
- CALL ASUMT(N,A,T)
- R0 = VDIST(1,C,DMY,T,DMY)
- IF(R0 .EQ. 0.) GOTO 11
- CALL VMAXA(1,T,DMY,IDUMMY,ABSREF)
- R0 = R0 / ABSREF
- 11 N0 = IRESF(R0)
- M0 = 200
- OK = N0 .LE. M0
- IF(.NOT. OK) WRITE(IOUNIT,1000) N, IDIM, M0, N0, R0
- OK = OK .AND. OKFLAG
- RETURN
-1000 FORMAT(/ 25H ??? ARITHMETIC ERROR ???, 4I8, 1P, E12.3 )
- END
- SUBROUTINE RVSUMT(N,X,X2,Z)
- REAL X(*), X2(*), Z, RVSUM
-#include "kernnumt/sysdat.inc"
-#include "ch3dat.inc"
- CALL KFLUSH
- Z = RVSUM(N,X,X2)
- IF(N .GT. 0 .OR. Z .EQ. 0.) RETURN
- OKFLAG = .FALSE.
- WRITE(IOUNIT,1000) N
- RETURN
-1000 FORMAT(/ 37H ??? VECTOR FUNCTION NOT ZERO FOR N =, I3)
- END
- SUBROUTINE DVSUMT(N,X,X2,Z)
- DOUBLE PRECISION X(*), X2(*), Z, DVSUM
-#include "kernnumt/sysdat.inc"
-#include "ch3dat.inc"
- CALL KFLUSH
- Z = DVSUM(N,X,X2)
- IF(N .GT. 0 .OR. Z .EQ. 0.D0) RETURN
- OKFLAG = .FALSE.
- WRITE(IOUNIT,1000) N
- RETURN
-1000 FORMAT(/ 37H ??? VECTOR FUNCTION NOT ZERO FOR N =, I3)
- END
- SUBROUTINE CVSUMT(N,X,X2,Z)
- COMPLEX X(*), X2(*), Z, CVSUM
-#include "kernnumt/sysdat.inc"
-#include "ch3dat.inc"
- CALL KFLUSH
- Z = CVSUM(N,X,X2)
- IF(N .GT. 0 .OR. AMAX1(REAL(Z),AIMAG(Z)) .EQ. 0.) RETURN
- OKFLAG = .FALSE.
- WRITE(IOUNIT,1000) N
- RETURN
-1000 FORMAT(/ 37H ??? VECTOR FUNCTION NOT ZERO FOR N =, I3)
- END
- SUBROUTINE RASUMT(N,X,Z)
- REAL X(*), Z, RASUM
-#include "kernnumt/sysdat.inc"
-#include "ch3dat.inc"
- Z = RASUM(N,X)
- IF(N .GT. 0 .OR. Z .EQ. 0.) RETURN
- OKFLAG = .FALSE.
- WRITE(IOUNIT,1000) N
- RETURN
-1000 FORMAT(/ 36H ??? ARRAY FUNCTION NOT ZERO FOR N =, I3)
- END
- SUBROUTINE DASUMT(N,X,Z)
- DOUBLE PRECISION X(*), Z, DASUM
- EXTERNAL DASUM
-#include "kernnumt/sysdat.inc"
-#include "ch3dat.inc"
- Z = DASUM(N,X)
- IF(N .GT. 0 .OR. Z .EQ. 0.D0) RETURN
- OKFLAG = .FALSE.
- WRITE(IOUNIT,1000) N
- RETURN
-1000 FORMAT(/ 36H ??? ARRAY FUNCTION NOT ZERO FOR N =, I3)
- END
- SUBROUTINE CASUMT(N,X,Z)
- COMPLEX X(*), Z, CASUM
-#include "kernnumt/sysdat.inc"
-#include "ch3dat.inc"
- Z = CASUM(N,X)
- IF(N .GT. 0 .OR. AMAX1(REAL(Z),AIMAG(Z)) .EQ. 0.) RETURN
- OKFLAG = .FALSE.
- WRITE(IOUNIT,1000) N
- RETURN
-1000 FORMAT(/ 36H ??? ARRAY FUNCTION NOT ZERO FOR N =, I3)
- END
- SUBROUTINE TVXCH(N,A,B,IRDIM,GA,GB,ALPHA,BETA,OK,
- + VXCH,VCPY,VDIST,VSET,VRAN)
- REAL A(*), B(*), GA(*), GB(*)
- REAL ALPHA(2), BETA(2)
- LOGICAL OK, OK1, OK2
- EXTERNAL VDIST, VSET
-#include "kernnumt/sysdat.inc"
-#include "ch3dat.inc"
-#include "f002dat1.inc"
-#include "f002dat2.inc"
- OK = .TRUE.
-*
-* CALL VRAN(N,ALPHA,BETA,A,A(L2))
-* CALL VRAN(N,ALPHA,BETA,B,B(L2))
-*JMM
- IF(HTYPE.EQ.'R') THEN
- CALL VRAN(N,RALPHA,RBETA,A,A(L2))
- CALL VRAN(N,RALPHA,RBETA,B,B(L2))
- ELSEIF(HTYPE.EQ.'D') THEN
- CALL VRAN(N,DALPHA,DBETA,A,A(L2))
- CALL VRAN(N,DALPHA,DBETA,B,B(L2))
- ELSE
- CALL VRAN(N,CALPHA,CBETA,A,A(L2))
- CALL VRAN(N,CALPHA,CBETA,B,B(L2))
- ENDIF
-*
- CALL RVSET(IRDIM,VOID(1),GA(1),GA(2))
- CALL RVSET(IRDIM,VOID(1),GB(1),GB(2))
- DO 13 JCNFG = 1, NCNFG
- CALL CNFGMX(N,1,IRDIM,LA,LDMY,LA2)
- CALL CNFGMX(N,1,IRDIM,LB,LDMY,LB2)
- CALL VCPY(N,A,A(L2),GB(LB),GB(LB2))
- CALL VCPY(N,B,B(L2),GA(LA),GA(LA2))
- CALL KFLUSH
- CALL VXCH(N,GA(LA),GA(LA2),GB(LB),GB(LB2))
- CALL CHECKL(N,1,A,IRDIM,GA,LA,LDMY,LA2,OK1,VDIST,VSET)
- CALL CHECKL(N,1,B,IRDIM,GB,LB,LDMY,LB2,OK2,VDIST,VSET)
- IF(.NOT.(OK1 .AND. OK2))
- + WRITE(IOUNIT,1001) N,JCNFG,LA,LA2,LB,LB2
- OK = OK .AND. OK1 .AND. OK2
- 13 CONTINUE
- RETURN
-1001 FORMAT(/ 20H ??? LOGIC ERROR ???, 6I8 )
- END
- SUBROUTINE RVVAR(N,EX,X,X2,XM,XS2,XM2)
- REAL EX, X(*), X2(*), XM, XS2, XM2
- REAL S1, S2, ZERO
- DATA ZERO / 0. /
- XM = ZERO
- XS2 = ZERO
- XM2 = ZERO
- IF(N .LE. 0) RETURN
-#if (!defined(CERNLIB_NUMUC))&&(!defined(CERNLIB_NUMCR))&&(!defined(CERNLIB_NUMDE))
- JX = LOCF(X2) - LOCF(X)
-#endif
-#if defined(CERNLIB_NUMUC)||defined(CERNLIB_NUMCR)
- JX = LOC(X2) - LOC(X)
-#endif
-#if defined(CERNLIB_NUMDE)
- JX = (%LOC(X2) - %LOC(X)) / 4
-#endif
- LX = 1
- S1 = ZERO
- S2 = ZERO
- IF(EX .EQ. ZERO) GOTO 11
- DO 10 J = 1, N
- S1 = S1 + (X(LX) - EX)
- S2 = S2 + (X(LX) - EX)**2
- LX = LX + JX
- 10 CONTINUE
- XM = S1 / FLOAT(N) + EX
- XS2 = S2 / FLOAT(N)
- XM2 = XS2 - (XM-EX)**2
- RETURN
- 11 DO 12 J = 1, N
- S1 = S1 + X(LX)
- S2 = S2 + X(LX)**2
- LX = LX + JX
- 12 CONTINUE
- XM = S1 / FLOAT(N)
- XS2 = S2 / FLOAT(N)
- XM2 = XS2 - XM**2
- RETURN
- END
diff --git a/src/packlib/kernlib/kernnum/test/numchk3/f002dat1.inc b/src/packlib/kernlib/kernnum/test/numchk3/f002dat1.inc
deleted file mode 100644
index e07dcf8..0000000
--- a/src/packlib/kernlib/kernnum/test/numchk3/f002dat1.inc
+++ /dev/null
@@ -1,3 +0,0 @@
- REAL RALPHA(1),RBETA(1)
- DOUBLE PRECISION DALPHA(1),DBETA(1)
- COMPLEX CALPHA(1),CBETA(1)
diff --git a/src/packlib/kernlib/kernnum/test/numchk3/f002dat2.inc b/src/packlib/kernlib/kernnum/test/numchk3/f002dat2.inc
deleted file mode 100644
index 0b9fed1..0000000
--- a/src/packlib/kernlib/kernnum/test/numchk3/f002dat2.inc
+++ /dev/null
@@ -1,3 +0,0 @@
- DATA RALPHA, RBETA / -100., +100. /
- DATA DALPHA, DBETA / -100.D0, +100.D0 /
- DATA CALPHA, CBETA / (-100.,-100.),(+100.,+100.)/
diff --git a/src/packlib/kernlib/kernnum/test/numchk3/f003ch.F b/src/packlib/kernlib/kernnum/test/numchk3/f003ch.F
deleted file mode 100644
index 2fcc08b..0000000
--- a/src/packlib/kernlib/kernnum/test/numchk3/f003ch.F
+++ /dev/null
@@ -1,1077 +0,0 @@
-*
-* $Id: f003ch.F,v 1.2 1997/02/04 17:36:57 mclareni Exp $
-*
-* $Log: f003ch.F,v $
-* Revision 1.2 1997/02/04 17:36:57 mclareni
-* Merge Winnt and 97a versions
-*
-* Revision 1.1.1.1.2.1 1997/01/21 11:32:21 mclareni
-* All mods for Winnt 96a on winnt branch
-*
-* Revision 1.1.1.1 1996/02/15 17:48:44 mclareni
-* Kernlib
-*
-*
-#include "kernnumt/pilot.h"
- SUBROUTINE F003CH(NREP,LWORK,W,OK)
- REAL W(LWORK)
- LOGICAL OK, OKT
-#include "kernnumt/sysdat.inc"
- OK = .TRUE.
- DO 100 JREP = 1, NREP
- CALL TF003(LWORK,W,OKT)
- OK = OK .AND. OKT
- 100 CONTINUE
- RETURN
- END
- SUBROUTINE TF003(LWORK,W,OK)
- DIMENSION W(LWORK), HT(3)
-#include "kernnumt/sysdat.inc"
-#include "ch3dat.inc"
- LOGICAL OK, ROK, DOK, COK
- REAL RZERO(1), RALPHA(1),RBETA(1)
- DOUBLE PRECISION DZERO(1), DALPHA(1),DBETA(1)
- COMPLEX CZERO(1), CALPHA(1),CBETA(1)
- DOUBLE PRECISION DMBIL
- COMPLEX CMBIL
- EXTERNAL RMADD, RMBIL, RMCPY, RMUTL, RRSCL
- EXTERNAL RMMNA, RMMNS, RMMPA, RMMPS, RMMPY
- EXTERNAL RMRAN, RMRANT, RMSCL, RMSET, RMSUB
- EXTERNAL RUMNA, RUMNS, RUMPA, RUMPS, RUMPY
- EXTERNAL DMADD, DMBIL, DMCPY, DMUTL, DRSCL
- EXTERNAL DMMNA, DMMNS, DMMPA, DMMPS, DMMPY
- EXTERNAL DMRAN, DMRANT, DMSCL, DMSET, DMSUB
- EXTERNAL DUMNA, DUMNS, DUMPA, DUMPS, DUMPY
- EXTERNAL CMADD, CMBIL, CMCPY, CMUTL, CRSCL
- EXTERNAL CMMNA, CMMNS, CMMPA, CMMPS, CMMPY
- EXTERNAL CMRAN, CMRANT, CMSCL, CMSET, CMSUB
- EXTERNAL CUMNA, CUMNS, CUMPA, CUMPS, CUMPY
- EXTERNAL RMBILT, RVADD, RVDIST, RVSET, RVSUB
- EXTERNAL RVCPY, RVSCA, RVSCL, RVSCS, RVMAXA
- EXTERNAL DMBILT, DVADD, DVDIST, DVSET, DVSUB
- EXTERNAL DVCPY, DVSCA, DVSCL, DVSCS, DVMAXA
- EXTERNAL CMBILT, CVADD, CVDIST, CVSET, CVSUB
- EXTERNAL CVCPY, CVSCA, CVSCL, CVSCS, CVMAXA
- CHARACTER*4 HT
- DATA HT / 'R ', 'D ', 'C ' /
- DATA RZERO / 0. /
- DATA DZERO / 0.D0 /
- DATA CZERO / (0.,0.) /
- DATA RALPHA, RBETA / -100., +100. /
- DATA DALPHA, DBETA / -100.D0, +100.D0 /
- DATA CALPHA, CBETA / (-100.,-100.),(+100.,+100.)/
- WRITE(IOUNIT,1001)
- HTYPE = HT(1)
- LENGTH = 1
- TRELPR = RELPRT(1)
- LTAB = LTABT(1)
- CALL XF003(LWORK,W,RZERO,RALPHA,RBETA,ROK,
- + RMADD,RMBILT,RMCPY,RMMNA,RMMNS,RMMPA,RMMPS,RMMPY,
- + RMRAN,RMRANT,RMSCL,RMSET,RMSUB,RMUTL,RRSCL,
- + RUMNA,RUMNS,RUMPA,RUMPS,RUMPY,RVMAXA,
- + RVADD,RVCPY,RVDIST,RVSCA,RVSCL,RVSCS,RVSET,RVSUB)
- WRITE(IOUNIT,1002)
- HTYPE = HT(2)
- LENGTH = 2
- TRELPR = RELPRT(2)
- LTAB = LTABT(2)
- CALL XF003(LWORK,W,DZERO,DALPHA,DBETA,DOK,
- + DMADD,DMBILT,DMCPY,DMMNA,DMMNS,DMMPA,DMMPS,DMMPY,
- + DMRAN,DMRANT,DMSCL,DMSET,DMSUB,DMUTL,DRSCL,
- + DUMNA,DUMNS,DUMPA,DUMPS,DUMPY,DVMAXA,
- + DVADD,DVCPY,DVDIST,DVSCA,DVSCL,DVSCS,DVSET,DVSUB)
- WRITE(IOUNIT,1003)
- HTYPE = HT(3)
- LENGTH = 2
- TRELPR = RELPRT(1)
- LTAB = LTABT(3)
- CALL XF003(LWORK,W,CZERO,CALPHA,CBETA,COK,
- + CMADD,CMBILT,CMCPY,CMMNA,CMMNS,CMMPA,CMMPS,CMMPY,
- + CMRAN,CMRANT,CMSCL,CMSET,CMSUB,CMUTL,CRSCL,
- + CUMNA,CUMNS,CUMPA,CUMPS,CUMPY,CVMAXA,
- + CVADD,CVCPY,CVDIST,CVSCA,CVSCL,CVSCS,CVSET,CVSUB)
- OK = ROK .AND. DOK .AND. COK
- 90 IF(.NOT. OK) WRITE(IOUNIT,1004)
- IF( OK) WRITE(IOUNIT,1005)
- RETURN
-1001 FORMAT(17H1F003. TYPE = R. )
-1002 FORMAT(17H1F003. TYPE = D. )
-1003 FORMAT(17H1F003. TYPE = C. )
-1004 FORMAT(/ 5X, 37H ????? TEST OF F003 HAS FAILED. ????? )
-1005 FORMAT(/35X, 44HACCEPTANCE TEST OF F003 HAS BEEN SUCCESSFUL. )
- END
- SUBROUTINE XF003(LWORK,W,ZERO,ALPHA,BETA,OK,
- + MADD,MBILT,MCPY,MMNA,MMNS,MMPA,MMPS,MMPY,
- + MRAN,MRANT,MSCL,MSET,MSUB,MUTL,RSCL,
- + UMNA,UMNS,UMPA,UMPS,UMPY,VMAXA,
- + VADD,VCPY,VDIST,VSCA,VSCL,VSCS,VSET,VSUB)
- REAL W(LWORK), ZERO(2), ALPHA(2), BETA(2)
- EXTERNAL CMMPYC, CCMMPY
- EXTERNAL CUMPYC, CCUMPY
- LOGICAL OK, OKN, OKT
- DIMENSION HN(2,15), HNAME(2)
- CHARACTER*4 HN, HNAME
-#include "kernnumt/sysdat.inc"
-#include "ch3dat.inc"
- DATA HN / 'M ', 'ADD ',
- + 'M ', 'BIL ',
- + 'M ', 'CPY ',
- + 'M ', 'MPY ',
- + 'M ', 'RAN ',
- + 'M ', 'SCL ',
- + 'M ', 'SET ',
- + 'M ', 'SUB ',
- + 'M ', 'UTL ',
- + 'R ', 'SCL ',
- + 'U ', 'MPY ',
- + 'C ', 'MMPY',
- + 'M ', 'MPYC',
- + 'C ', 'UMPY',
- + 'U ', 'MPYC' /
- NDX2F(I,J) = ((J-1)*IDIM + I-1)*LENGTH + 1
- OK = .TRUE.
- LF = LWORK / 15
- LG = (LWORK - 6*LF) / 3
- LA = 1
- LB = LA + LF
- LC = LB + LF
- LX = LC + LF
- LR = LX + LF
- LT = LR + LF
- LGA = LT + LF
- LGB = LGA + LG
- LGC = LGB + LG
- IRDIM = LG
- CALL RVSET(IRDIM,VOID(1),W(LGC),W(LGC+1))
- IF(HTYPE .EQ. 'C ') NTEST = 15
- IF(HTYPE .NE. 'C ') NTEST = 11
- CCFLAG = .FALSE.
- DO 300 JTEST = 1, NTEST
- OKT = .TRUE.
- IF(JTEST .EQ. 3) CALL RVSET(IRDIM,VOID(1),W(LGC),W(LGC+1))
- HNAME(1) = HN(1,JTEST)
- HNAME(2) = HN(2,JTEST)
- WRITE(IOUNIT,1001) HTYPE, HNAME
- KNTSKP = LTAB
- 20 DO 200 JTAB = 1, LTAB
- M = MTAB(JTAB)
- N = NTAB(JTAB)
- IDIM = MAX0(M,N,1)
- IF(IDIM .GE. 3 .AND. IDIM .LE. 7) IDIM = IDIM + 3
- IF(LF .LT. LENGTH*IDIM**2) GOTO 200
- KNTSKP = KNTSKP - 1
- L12 = NDX2F(1,2)
- L21 = NDX2F(2,1)
- L22 = NDX2F(2,2)
- L2 = L21
- GOTO(01, 02, 03, 04, 05, 06, 07, 08, 09, 10,
- + 11, 12, 13, 14, 15), JTEST
- 01 CALL TMADD(M,N,W(LA),W(LB),W(LC),W(LT),IRDIM,W(LGA),
- + W(LGB),W(LGC),ALPHA,BETA,OKN,
- + MCPY,MADD,MRAN,VDIST,VADD,VSET)
- GOTO 99
- 02 CALL TMBIL(N,W(LA),W(LB),W(LC),W(LR),W(LT),IRDIM,
- + W(LGA),W(LGB),W(LGC),ALPHA,BETA,OKN,
- + MBILT,MCPY,MMPY,MRAN,VCPY,VDIST,VMAXA)
- GOTO 99
- 03 CALL TMCPY(M,N,W(LA),W(LC),IRDIM,W(LGA),W(LGC),
- + ALPHA,BETA,OKN,
- + MCPY,MRAN,VDIST,VSET)
- GOTO 99
- 04 CALL TMMPY(M,N,W(LA),W(LB),W(LC),W(LR),W(LT),IRDIM,
- + W(LGA),W(LGB),W(LGC),ZERO,ALPHA,BETA,OKN,
- + MMNA,MMNS,MMPA,MMPS,MMPY,MCPY,MRAN,
- + VADD,VDIST,VMAXA,VSCA,VSCS,VSET,VSUB)
- GOTO 99
- 05 CALL TMRAN(M,N,W(LC),IRDIM,W(LGC),ALPHA,BETA,OKN,
- + MRAN,MRANT,MCPY,MSET,VDIST,VSET)
- GOTO 99
- 06 CALL TMSCL(M,N,W(LA),W(LC),W(LT),IRDIM,W(LGA),
- + W(LGC),ALPHA,BETA,OKN,
- + MCPY,MSCL,MRAN,VDIST,VMAXA,VSCL,VSET)
- GOTO 99
- 07 CALL TMSET(M,N,W(LA),W(LC),IRDIM,
- + W(LGC),ALPHA,BETA,OKN,
- + MSET,MRAN,VDIST,VSET)
- GOTO 99
- 08 CALL TMADD(M,N,W(LA),W(LB),W(LC),W(LT),IRDIM,W(LGA),
- + W(LGB),W(LGC),ALPHA,BETA,OKN,
- + MCPY,MSUB,MRAN,VDIST,VSUB,VSET)
- GOTO 99
- 09 CALL TMUTL(N,W(LA),W(LC),IRDIM,W(LGC),ALPHA,BETA,OKN,
- + MUTL,MCPY,MRAN,VCPY,VDIST,VSET)
- GOTO 99
- 10 CALL TRSCL(M,N,W(LA),W(LB),W(LC),W(LT),IRDIM,W(LGA),
- + W(LGB),W(LGC),ALPHA,BETA,OKN,
- + MCPY,RSCL,MRAN,VDIST,VMAXA,VSCL,VSET)
- GOTO 99
- 11 CALL TUMPY(N,W(LA),W(LB),W(LC),W(LR),W(LT),IRDIM,
- + W(LGA),W(LGB),W(LGC),ZERO,ALPHA,BETA,OKN,
- + UMNA,UMNS,UMPA,UMPS,UMPY,MCPY,MRAN,
- + VADD,VDIST,VMAXA,VSCA,VSCS,VSET,VSUB)
- GOTO 99
- 12 CCFLAG = .TRUE.
- CALL TCMMPY(M,N,W(LA),W(LB),W(LC),W(LR),W(LT),IRDIM,
- + W(LGA),W(LGB),W(LGC),ZERO,ALPHA,BETA,OKN,
- + CCMMPY,MCPY,MRAN,VDIST,VMAXA,VSET)
- GOTO 99
- 13 CALL TMMPY(M,N,W(LA),W(LB),W(LC),W(LR),W(LT),IRDIM,
- + W(LGA),W(LGB),W(LGC),ZERO,ALPHA,BETA,OKN,
- + DUMMY,DUMMY,DUMMY,DUMMY,CMMPYC,MCPY,MRAN,
- + VADD,VDIST,VMAXA,VSCA,VSCS,VSET,VSUB)
- GOTO 99
- 14 CALL TCUMPY(N,W(LA),W(LB),W(LC),W(LR),W(LT),IRDIM,
- + W(LGA),W(LGB),W(LGC),ZERO,ALPHA,BETA,OKN,
- + CCUMPY,MCPY,MRAN,VDIST,VMAXA,VSET)
- GOTO 99
- 15 CALL TUMPY(N,W(LA),W(LB),W(LC),W(LR),W(LT),IRDIM,
- + W(LGA),W(LGB),W(LGC),ZERO,ALPHA,BETA,OKN,
- + DUMMY,DUMMY,DUMMY,DUMMY,CUMPYC,MCPY,MRAN,
- + VADD,VDIST,VMAXA,VSCA,VSCS,VSET,VSUB)
- 99 OKT = OKT .AND. OKN
- 200 CONTINUE
- IF(.NOT. OKT) WRITE(IOUNIT,1010)
- IF( OKT) WRITE(IOUNIT,1011)
- OK = OK .AND. OKT
- 300 CONTINUE
- CCFLAG = .FALSE.
- IF(KNTSKP .NE. 0) WRITE(*,1014) KNTSKP
- IF(.NOT. OK) WRITE(IOUNIT,1012) HTYPE
- IF( OK) WRITE(IOUNIT,1013) HTYPE
- RETURN
-1001 FORMAT(/ 9H TEST OF , 2A1,A4 )
-1010 FORMAT(/ 5X, 37H ????? FEATURE TEST HAS FAILED. ????? )
-1011 FORMAT( 15X, 25H FEATURE TEST SUCCESSFUL. )
-1012 FORMAT(/ 5X, 21H ????? TEST FOR TYPE , A1,
- + 18H HAS FAILED. ????? )
-1013 FORMAT(/25X, 15H TEST FOR TYPE , A1,12H SUCCESSFUL. )
-1014 FORMAT( 20X, 11HWARNING ..., I3,
- + 52H CONFIGURATIONS HAVE BEEN SKIPPED FOR WANT OF SPACE.)
- END
- SUBROUTINE TMADD(M,N,A,B,C,T,IRDIM,GA,GB,GC,ALPHA,BETA,OK,
- + MCPY,MFCN,MRAN,VDIST,VFCN,VSET)
- REAL A(*), B(*), C(*), T(*), GA(*), GB(*), GC(*)
- REAL ALPHA(2), BETA(2)
- LOGICAL OK, OKL
- REAL E, R0, RES
- EXTERNAL VDIST, VSET
-#include "kernnumt/sysdat.inc"
-#include "ch3dat.inc"
- NDX2F(I,J) = ((J-1)*IDIM + I-1)*LENGTH + 1
- IRESF(RES) = NINT(RES/TRELPR)
- OK = .TRUE.
- IF(M .LE. 0 .OR. N .LE. 0) GOTO 12
- CALL MRAN(M,N,ALPHA,BETA,A,A(L12),A(L21))
- CALL MRAN(M,N,ALPHA,BETA,B,B(L12),B(L21))
- CALL KFLUSH
- CALL MFCN(M,N,A,A(L12),A(L21),B,B(L12),B(L21),C,C(L12),C(L21))
- R0 = 0.
- DO 10 I = 1, M
- I1 = NDX2F(I,1)
- I2 = NDX2F(I,2)
- CALL VFCN(N,A(I1),A(I2),B(I1),B(I2),T,T(L2))
- E = VDIST(N,C(I1),C(I2),T,T(L2))
- R0 = AMAX1(R0,E)
- 10 CONTINUE
- N0 = IRESF(R0)
- M0 = 5
- OK = N0 .LE. M0
- IF(.NOT. OK) WRITE(IOUNIT,1000) M, N, IDIM, M0, N0, R0
- 12 DO 13 JCNFG = 1, NCNFG
- CALL CNFGMX(M,N,IRDIM,LA,LA12,LA21)
- CALL CNFGMX(M,N,IRDIM,LB,LB12,LB21)
- CALL CNFGMX(M,N,IRDIM,LC,LC12,LC21)
- CALL MCPY(M,N,A,A(L12),A(L21),GA(LA),GA(LA12),GA(LA21))
- CALL MCPY(M,N,B,B(L12),B(L21),GB(LB),GB(LB12),GB(LB21))
- CALL KFLUSH
- CALL MFCN(M,N,GA(LA),GA(LA12),GA(LA21),
- + GB(LB),GB(LB12),GB(LB21),
- + GC(LC),GC(LC12),GC(LC21))
- CALL CHECKL(M,N,C,IRDIM,GC,LC,LC12,LC21,OKL,VDIST,VSET)
- IF(.NOT. OKL) WRITE(IOUNIT,1001) M,N,JCNFG,LC,LC12,LC21
- OK = OK .AND. OKL
- 13 CONTINUE
- RETURN
-1000 FORMAT(/ 25H ??? ARITHMETIC ERROR ???, 5I8,1P,E12.3 )
-1001 FORMAT(/ 20H ??? LOGIC ERROR ???, 6I8 )
- END
- SUBROUTINE TMBIL(N,A,B,C,R,T,IRDIM,GA,GB,GC,
- + ALPHA,BETA,OK,
- + MBILT,MCPY,MMPY,MRAN,VCPY,VDIST,VMAXA)
- REAL A(*), B(*), C(*), R(*), T(*)
- REAL GA(*), GB(*), GC(*)
- REAL ALPHA(2), BETA(2)
- LOGICAL OK, OKL, OKZERO
- EXTERNAL VDIST
- COMMON /DATBIL/ OKZERO
- REAL R0, RES
-#include "kernnumt/sysdat.inc"
-#include "ch3dat.inc"
- IRESF(RES) = NINT(RES/TRELPR)
- OK = .TRUE.
- OKZERO = .TRUE.
- CALL MRAN(1,N,ALPHA,BETA,A,A(L2),DMY)
- CALL MRAN(1,N,ALPHA,BETA,C,C(L2),DMY)
- CALL MRAN(N,N,ALPHA,BETA,B,B(L12),B(L21))
- CALL KFLUSH
- CALL MBILT(N,A,A(L2),B,B(L12),B(L21),C,C(L2),R)
- IF(N .LE. 0) GOTO 12
- CALL MMPY(N,N,B,B(L12),B(L21),C,C(L2),T,T(L2))
- CALL MMPY(1,N,A,A(L2),DMY,T,T(L2),T,DMY)
- R0 = VDIST(1,R,DMY,T,DMY)
- IF(R0 .EQ. 0.) GOTO 11
- CALL VMAXA(1,T,DUMMY,IDUMMY,ABSREF)
- R0 = R0 / ABSREF
- 11 N0 = IRESF(R0)
- M0 = 300
- OK = N0 .LE. M0
- IF(.NOT. OK) WRITE(IOUNIT,1000) N, M0, N0, R0
- 12 OK = OK .AND. OKZERO
- IF(.NOT. OK) RETURN
- DO 13 JCNFG = 1, NCNFG
- CALL CNFGMX(N,1,IRDIM,LA,LDMY,LA2)
- CALL CNFGMX(N,1,IRDIM,LC,LDMY,LC2)
- CALL CNFGMX(N,N,IRDIM,LB,LB12,LB21)
- CALL VCPY(N,A,A(L2),GA(LA),GA(LA2))
- CALL VCPY(N,C,C(L2),GC(LC),GC(LC2))
- CALL MCPY(N,N,B,B(L12),B(L21),GB(LB),GB(LB12),GB(LB21))
- CALL KFLUSH
- CALL MBILT(N,GA(LA),GA(LA2),GB(LB),GB(LB12),GB(LB21),
- + GC(LC),GC(LC2),T)
- R0 = VDIST(1,R,DMY,T,DMY)
- N0 = IRESF(R0)
- OKL = N0 .EQ. 0
- IF(.NOT. OKL) WRITE(IOUNIT,1001) N,JCNFG,N0,R0
- OK = OK .AND. OKL
- 13 CONTINUE
- RETURN
-1000 FORMAT(/ 25H ??? ARITHMETIC ERROR ???, 3I8,1P,E12.3)
-1001 FORMAT(/ 20H ??? LOGIC ERROR ???,3I8,1P,E12.3)
- END
- SUBROUTINE RMBILT(N,X,X2,Y,Y12,Y21,Z,Z2,R)
- REAL X(*), X2(*), Y(*), Y12(*), Y21(*), Z(*), Z2(*)
- REAL R, RMBIL
-#include "kernnumt/sysdat.inc"
-#include "ch3dat.inc"
- COMMON /DATBIL/ OKZERO
- LOGICAL OKZERO
- R = RMBIL(N,X,X2,Y,Y12,Y21,Z,Z2)
- OKZERO = N .GT. 0 .OR. R .EQ. 0.
- IF(.NOT. OKZERO) WRITE(IOUNIT,1000) N, R
- RETURN
-1000 FORMAT(/ 25H ??? RMBIL(N=0,... NOT 0 ,I5,E12.3)
- END
- SUBROUTINE DMBILT(N,X,X2,Y,Y12,Y21,Z,Z2,R)
- DOUBLE PRECISION X(*),X2(*),Y(*),Y12(*),Y21(*),Z(*),Z2(*)
- DOUBLE PRECISION R, DMBIL
-#include "kernnumt/sysdat.inc"
-#include "ch3dat.inc"
- COMMON /DATBIL/ OKZERO
- LOGICAL OKZERO
- R = DMBIL(N,X,X2,Y,Y12,Y21,Z,Z2)
- OKZERO = N .GT. 0 .OR. SNGL(R) .EQ. 0.
- IF(.NOT. OKZERO) WRITE(IOUNIT,1000) N
- RETURN
-1000 FORMAT(/ 25H ??? DMBIL(N=0,... NOT 0 ,I5)
- END
- SUBROUTINE CMBILT(N,X,X2,Y,Y12,Y21,Z,Z2,R)
- COMPLEX X(*), X2(*), Y(*), Y12(*), Y21(*), Z(*), Z2(*)
- COMPLEX R, CMBIL
-#include "kernnumt/sysdat.inc"
-#include "ch3dat.inc"
- COMMON /DATBIL/ OKZERO
- LOGICAL OKZERO
- R = CMBIL(N,X,X2,Y,Y12,Y21,Z,Z2)
- OKZERO = N .GT. 0 .OR. CABS(R) .EQ. 0.
- IF(.NOT. OKZERO) WRITE(IOUNIT,1000) N, R
- RETURN
-1000 FORMAT(/ 25H ??? CMBIL(N=0,... NOT 0 ,I5,2E12.3)
- END
- SUBROUTINE TMCPY(M,N,A,C,IRDIM,GA,GC,ALPHA,BETA,OK,
- + MFCN,MRAN,VDIST,VSET)
- REAL A(*), C(*), GA(*), GC(*)
- REAL ALPHA(2), BETA(2)
- LOGICAL OK, OKL, OKM
- EXTERNAL VDIST
-#include "kernnumt/sysdat.inc"
-#include "ch3dat.inc"
- NDX2F(I,J) = ((J-1)*IDIM + I-1)*LENGTH + 1
- OK = .TRUE.
- CALL MRAN(M,N,ALPHA,BETA,A,A(L12),A(L21))
- CALL MFCN(M,N,A,A(L12),A(L21),C,C(L12),C(L21))
- IF(M .LE. 0) GOTO 12
- DO 10 I = 1, M
- I1 = NDX2F(I,1)
- I2 = NDX2F(I,2)
- E = VDIST(N,A(I1),A(I2),C(I1),C(I2))
- OKM = E .EQ. 0
- OK = OK .AND. OKM
- IF(.NOT. OKM) WRITE(IOUNIT,1000) M,N,E
- 10 CONTINUE
- IF(.NOT. OK) RETURN
- 12 DO 13 JCNFG = 1, NCNFG
- CALL CNFGMX(M,N,IRDIM,LA,LA12,LA21)
- CALL CNFGMX(M,N,IRDIM,LC,LC12,LC21)
- CALL MFCN(M,N,A,A(L12),A(L21),GA(LA),GA(LA12),GA(LA21))
- CALL KFLUSH
- CALL MFCN(M,N,GA(LA),GA(LA12),GA(LA21),
- + GC(LC),GC(LC12),GC(LC21))
- CALL CHECKL(M,N,C,IRDIM,GC,LC,LC12,LC21,OKL,VDIST,VSET)
- IF(.NOT. OKL) WRITE(IOUNIT,1001) M,N
- OK = OK .AND. OKL
- 13 CONTINUE
- RETURN
-1000 FORMAT(/ 31H ??? ARITHMETIC ERROR ??? M =,I3,2X,3HN =,
- + I3,1P,E12.3)
-1001 FORMAT(/ 26H ??? LOGIC ERROR ??? M =,I3,2X,3HN =,I3)
- END
- SUBROUTINE TMMPY(M,N,A,B,C,R,T,IRDIM,GA,GB,GC,ZERO,ALPHA,BETA,
- + OK,MMNA,MMNS,MMPA,MMPS,MMPY,MCPY,MRAN,
- + VADD,VDIST,VMAXA,VSCA,VSCS,VSET,VSUB)
- REAL A(*), B(*), C(*), R(*), T(*), GA(*), GB(*), GC(*)
- REAL ZERO(2), ALPHA(2), BETA(2), R0, RES
- COMPLEX BCONJG
- LOGICAL OK, OKA, OKL
- EXTERNAL VDIST, VSET
-#include "kernnumt/sysdat.inc"
-#include "ch3dat.inc"
- NDX1F(J) = (J-1)*LENGTH + 1
- NDX2F(I,J) = ((J-1)*IDIM + I-1)*LENGTH + 1
- IRESF(RES) = NINT(RES/TRELPR)
- OK = .TRUE.
- IF(CCFLAG) THEN
- MFUNCT = 5
- ELSE
- MFUNCT = 1
- ENDIF
- DO 40 JFUNCT = MFUNCT, 5
- IF(M .LE. 0 .OR. N .LE. 0) GOTO 30
- CALL MRAN(M,N,ALPHA,BETA,A,A(L12),A(L21))
- CALL MRAN(N,1,ALPHA,BETA,B,DUMMY,B(L2))
- CALL MRAN(M,1,ALPHA,BETA,C,DUMMY,C(L2))
- CALL MCPY(M,1,C,DUMMY,C(L2),R,DUMMY,R(L2))
- CALL VSET(M,ZERO,T(1),T(L2))
- DO 10 J = 1, N
- LJ = NDX1F(J)
- L1J = NDX2F(1,J)
- L2J = NDX2F(2,J)
- IF(CCFLAG) THEN
- BCONJG = CMPLX(B(LJ),-B(LJ+1))
- CALL VSCA(M,BCONJG,A(L1J),A(L2J),T,T(L2),T,T(L2))
- ELSE
- CALL VSCA(M,B(LJ),A(L1J),A(L2J),T,T(L2),T,T(L2))
- ENDIF
- 10 CONTINUE
- GOTO(11,12,13,14,15), JFUNCT
- 11 CALL VSUB(M,C(1),C(L2),T(1),T(L2),T(1),T(L2))
- CALL KFLUSH
- CALL MMNA(M,N,A,A(L12),A(L21),B,B(L2),C,C(L2))
- GOTO 20
- 12 CALL VADD(M,T(1),T(L2),C(1),C(L2),T(1),T(L2))
- CALL VSCS(M,ZERO,T(1),T(L2),T(1),T(L2),T(1),T(L2))
- CALL KFLUSH
- CALL MMNS(M,N,A,A(L12),A(L21),B,B(L2),C,C(L2))
- GOTO 20
- 13 CALL VADD(M,T(1),T(L2),C(1),C(L2),T(1),T(L2))
- CALL KFLUSH
- CALL MMPA(M,N,A,A(L12),A(L21),B,B(L2),C,C(L2))
- GOTO 20
- 14 CALL VSUB(M,T(1),T(L2),C(1),C(L2),T(1),T(L2))
- CALL KFLUSH
- CALL MMPS(M,N,A,A(L12),A(L21),B,B(L2),C,C(L2))
- GOTO 20
- 15 CALL KFLUSH
- CALL MMPY(M,N,A,A(L12),A(L21),B,B(L2),C,C(L2))
- 20 R0 = VDIST(M,C,C(L2),T,T(L2))
- IF(R0 .NE. 0.) THEN
- CALL VMAXA(M,T,T(L2),IDUMMY,ABSREF)
- R0 = R0 / ABSREF
- ENDIF
- N0 = IRESF(R0)
- M0 = 40
- OKA = N0 .LE. M0
- IF(.NOT. OKA) WRITE(IOUNIT,1000) JFUNCT,M,N,IDIM,M0,N0,R0
- OK = OK .AND. OKA
- IF(.NOT. OK) RETURN
- 30 DO 39 JCNFG = 1, NCNFG
- CALL CNFGMX(M,N,IRDIM,LA,LA12,LA21)
- CALL CNFGMX(N,1,IRDIM,LB,LB12,LB21)
- CALL CNFGMX(M,1,IRDIM,LC,LC12,LC21)
- CALL MCPY(M,N,A,A(L12),A(L21),GA(LA),GA(LA12),GA(LA21))
- CALL MCPY(N,1,B,DMY,B(L2),GB(LB),DMY,GB(LB21))
- IF(N .GT. 0)
- + CALL MCPY(M,1,R,DMY,R(L2),GC(LC),DMY,GC(LC21))
- GOTO(31,32,33,34,35), JFUNCT
- 31 CALL KFLUSH
- CALL MMNA(M,N,GA(LA),GA(LA12),GA(LA21),GB(LB),GB(LB21),
- + GC(LC),GC(LC21))
- GOTO 38
- 32 CALL KFLUSH
- CALL MMNS(M,N,GA(LA),GA(LA12),GA(LA21),GB(LB),GB(LB21),
- + GC(LC),GC(LC21))
- GOTO 38
- 33 CALL KFLUSH
- CALL MMPA(M,N,GA(LA),GA(LA12),GA(LA21),GB(LB),GB(LB21),
- + GC(LC),GC(LC21))
- GOTO 38
- 34 CALL KFLUSH
- CALL MMPS(M,N,GA(LA),GA(LA12),GA(LA21),GB(LB),GB(LB21),
- + GC(LC),GC(LC21))
- GOTO 38
- 35 CALL KFLUSH
- CALL MMPY(M,N,GA(LA),GA(LA12),GA(LA21),GB(LB),GB(LB21),
- + GC(LC),GC(LC21))
- GOTO 38
- 38 IF(N .GT. 0)
- + CALL CHECKL(M,1,C,IRDIM,GC,LC,LC12,LC21,OKL,VDIST,VSET)
- IF(N .LE. 0)
- + CALL CHECKL(0,0,C,IRDIM,GC,LC,LC12,LC21,OKL,VDIST,VSET)
- IF(.NOT.OKL) WRITE(IOUNIT,1001) JFUNCT,M,N,JCNFG,LC,
- + LC12,LC21
- OK = OK .AND. OKL
- 39 CONTINUE
- 40 CONTINUE
- RETURN
-1000 FORMAT(/ 26H ??? ARITHMETIC ERROR ??? ,6I8,1P,E12.3)
-1001 FORMAT(/ 21H ??? LOGIC ERROR ??? ,7I8)
- END
- SUBROUTINE TCMMPY(M,N,A,B,C,R,T,IRDIM,GA,GB,GC,ZERO,
- + ALPHA,BETA,OK,MMPY,MCPY,MRAN,VDIST,VMAXA,VSET)
- REAL A(*), B(*), C(*), R(*), T(*), GA(*), GB(*), GC(*)
- REAL ZERO(2), ALPHA(2), BETA(2), R0, RES
- LOGICAL OK, OKA, OKL
- EXTERNAL VDIST, VSET
-#include "kernnumt/sysdat.inc"
-#include "ch3dat.inc"
- NDX1F(J) = (J-1)*LENGTH + 1
- NDX2F(I,J) = ((J-1)*IDIM + I-1)*LENGTH + 1
- IRESF(RES) = NINT(RES/TRELPR)
- OK = .TRUE.
- IF(M .LE. 0 .OR. N .LE. 0) GOTO 30
- CALL MRAN(M,N,ALPHA,BETA,A,A(L12),A(L21))
- CALL MRAN(N,1,ALPHA,BETA,B,DUMMY,B(L2))
- CALL MRAN(M,1,ALPHA,BETA,C,DUMMY,C(L2))
- CALL MCPY(M,1,C,DUMMY,C(L2),R,DUMMY,R(L2))
- DO 10 I = 1, M
- LI = NDX1F(I)
- LI1 = NDX2F(I,1)
- LI2 = NDX2F(I,2)
- CALL CCVDOT(N,A(LI1),A(LI2),B,B(L2),T(LI))
- 10 CONTINUE
- CALL KFLUSH
- CALL MMPY(M,N,A,A(L12),A(L21),B,B(L2),C,C(L2))
- R0 = VDIST(M,C,C(L2),T,T(L2))
- IF(R0 .NE. 0.) THEN
- CALL VMAXA(M,T,T(L2),IDUMMY,ABSREF)
- R0 = R0 / ABSREF
- ENDIF
- N0 = IRESF(R0)
- M0 = 40
- OKA = N0 .LE. M0
- IF(.NOT. OKA) WRITE(IOUNIT,1000) M,N,IDIM,M0,N0,R0
- OK = OK .AND. OKA
- IF(.NOT. OK) RETURN
- 30 DO 39 JCNFG = 1, NCNFG
- CALL CNFGMX(M,N,IRDIM,LA,LA12,LA21)
- CALL CNFGMX(N,1,IRDIM,LB,LB12,LB21)
- CALL CNFGMX(M,1,IRDIM,LC,LC12,LC21)
- CALL MCPY(M,N,A,A(L12),A(L21),GA(LA),GA(LA12),GA(LA21))
- CALL MCPY(N,1,B,DMY,B(L2),GB(LB),DMY,GB(LB21))
- IF(N .GT. 0)
- + CALL MCPY(M,1,R,DMY,R(L2),GC(LC),DMY,GC(LC21))
- CALL KFLUSH
- CALL MMPY(M,N,GA(LA),GA(LA12),GA(LA21),GB(LB),GB(LB21),
- + GC(LC),GC(LC21))
- IF(N .GT. 0)
- + CALL CHECKL(M,1,C,IRDIM,GC,LC,LC12,LC21,OKL,VDIST,VSET)
- IF(N .LE. 0)
- + CALL CHECKL(0,0,C,IRDIM,GC,LC,LC12,LC21,OKL,VDIST,VSET)
- IF(.NOT.OKL) WRITE(IOUNIT,1001) M,N,JCNFG,LC,LC12,LC21
- OK = OK .AND. OKL
- 39 CONTINUE
- RETURN
-1000 FORMAT(/ 26H ??? ARITHMETIC ERROR ??? ,5I8,1P,E12.3)
-1001 FORMAT(/ 21H ??? LOGIC ERROR ??? ,6I8)
- END
- SUBROUTINE CCVDOT(N,X,X2,Y,Y2,DOT)
- COMPLEX X(*), X2(*), Y(*), Y2(*), DOT, CVMPYC
- DOT = CVMPYC(N,Y,Y2,X,X2)
- RETURN
- END
- SUBROUTINE TMRAN(M,N,C,IRDIM,GC,ALPHA,BETA,OK,
- + MRAN,MRANT,MCPY,MSET,VDIST,VSET)
- REAL C(*), GC(*), ALPHA(2), BETA(2)
- LOGICAL OK, OKL, OKC
- REAL E1, E2, R0, R1, R2, P, Q
- EXTERNAL VDIST, VSET
-#include "kernnumt/sysdat.inc"
-#include "ch3dat.inc"
- NDX2F(I,J) = ((J-1)*IDIM + I-1)*LENGTH + 1
- OK = .TRUE.
- R0 = VDIST(1,ALPHA,DMY,BETA,DMY)
- R1 = 0.
- R2 = 0.
- CALL MSET(M,N,ALPHA,C,C(L12),C(L21))
- CALL KFLUSH
- CALL MRAN(M,N,ALPHA,BETA,C,C(L12),C(L21))
- IF(M .LE. 0) GOTO 12
- DO 10 I = 1, M
- I1 = NDX2F(I,1)
- I2 = NDX2F(I,2)
- E1 = VDIST(N,C(I1),C(I2),ALPHA,ALPHA)
- E2 = VDIST(N,C(I1),C(I2),BETA,BETA)
- R1 = AMAX1(R1,E1)
- R2 = AMAX1(R2,E2)
- 10 CONTINUE
- OK = AMAX1(R1,R2) .LT. R0
- IF(.NOT. OK) WRITE(IOUNIT,1000) M, N, IDIM, R0, R1, R2
- 12 DO 13 JCNFG = 1, NCNFG
- CALL CNFGMX(M,N,IRDIM,LC,LC12,LC21)
- CALL KFLUSH
- CALL MRAN(M,N,ALPHA,BETA,GC(LC),GC(LC12),GC(LC21))
- CALL MCPY(M,N,GC(LC),GC(LC12),GC(LC21),C,C(L12),C(L21))
- CALL CHECKL(M,N,C,IRDIM,GC,LC,LC12,LC21,OKL,VDIST,VSET)
- IF(.NOT. OKL) WRITE(IOUNIT,1001) M,N,JCNFG,LC,LC12,LC21
- OK = OK .AND. OKL
- 13 CONTINUE
- P = -1.
- Q = +3.
- AMEAN = (P+Q) / 2.
- SIGMA2 = (Q-P)**2 / 12.
- K = 1000
- CALL MRANT(P,Q,C(1),C(1),K)
- CALL RVVAR(K,AMEAN,C(1),C(2),CM,CM2,DUMMY)
- DM = ABS(CM - AMEAN)
- DM2 = ABS(CM2-SIGMA2)
- CL = 2.*ABS(Q - P) / SQRT(3.*FLOAT(K))
- CL2 = 8.*SIGMA2 / SQRT(5.*FLOAT(K))
- OKC = DM .LE. CL .AND. DM2 .LE. CL2
- IF(.NOT. OKC) WRITE(IOUNIT,1002) M,N,K,P,Q, AMEAN,CM,DM,CL,
- + SIGMA2,CM2,DM2,CL2
- OK = OK .AND .OKC
- RETURN
-1000 FORMAT(/ 25H ??? ARITHMETIC ERROR ???, 3I8, 1P, 3E12.3)
-1001 FORMAT(/ 20H ??? LOGIC ERROR ???, 6I8)
-1002 FORMAT(/ 27H ??? DISTRIBUTION ERROR ???, 3I8,
- + / 1X, 2F8.2, 5X, 4F12.3,
- + / 22X, 4F12.3 )
- END
- SUBROUTINE RMRANT(P,Q,T,R,K)
- REAL T(K), R(K)
- CALL RMRAN(K,1,P,Q,R(1),DMY,R(2))
- RETURN
- END
- SUBROUTINE DMRANT(P,Q,T,R,K)
- DOUBLE PRECISION T(K), PHI, PSI
- REAL R(K)
- PHI = DBLE(P)
- PSI = DBLE(Q)
- CALL DMRAN(K,1,PHI,PSI,T(1),DMY,T(2))
- DO 10 J = 1, K
- R(J) = SNGL(T(J))
- 10 CONTINUE
- RETURN
- END
- SUBROUTINE CMRANT(P,Q,T,R,K)
- COMPLEX T(K), PHI, PSI
- REAL R(K)
- PHI = CMPLX(P,P)
- PSI = CMPLX(Q,Q)
- CALL CMRAN(K,1,PHI,PSI,T(1),DMY,T(2))
- DO 10 J = 1, K
- R(2*J-1) = REAL(T(J))
- R(2*J) = AIMAG(T(J))
- 10 CONTINUE
- K = 2 * K
- RETURN
- END
- SUBROUTINE TMSCL(M,N,A,C,T,IRDIM,GA,GC,ALPHA,BETA,OK,
- + MCPY,MSCL,MRAN,VDIST,VMAXA,VSCL,VSET)
- REAL A(*), C(*), T(*), GA(*), GC(*)
- REAL ALPHA(2), BETA(2)
- LOGICAL OK, OKL
- REAL E, R0, RES
- EXTERNAL VDIST, VSET
-#include "kernnumt/sysdat.inc"
-#include "ch3dat.inc"
- NDX2F(I,J) = ((J-1)*IDIM + I-1)*LENGTH + 1
- IRESF(RES) = NINT(RES/TRELPR)
- OK = .TRUE.
- IF(M .LE. 0 .OR. N .LE. 0) GOTO 12
- CALL MRAN(M,N,ALPHA,BETA,A,A(L12),A(L21))
- CALL KFLUSH
- CALL MSCL(M,N,A,A,A(L12),A(L21),C,C(L12),C(L21))
- R0 = 0.
- DO 10 I = 1, M
- I1 = NDX2F(I,1)
- I2 = NDX2F(I,2)
- CALL VSCL(N,A,A(I1),A(I2),T,T(L2))
- E = VDIST(N,C(I1),C(I2),T,T(L2))
- CALL VMAXA(N,T,T(L2),IDUMMY,ABSREF)
- R0 = AMAX1(R0,E/ABSREF)
- 10 CONTINUE
- N0 = IRESF(R0)
- M0 = 20
- OK = N0 .LE. M0
- IF(.NOT. OK) WRITE(IOUNIT,1000) M, N, IDIM, M0, N0, R0
- 12 DO 13 JCNFG = 1, NCNFG
- CALL CNFGMX(M,N,IRDIM,LA,LA12,LA21)
- CALL CNFGMX(M,N,IRDIM,LC,LC12,LC21)
- CALL MCPY(M,N,A,A(L12),A(L21),GA(LA),GA(LA12),GA(LA21))
- CALL KFLUSH
- CALL MSCL(M,N,A,GA(LA),GA(LA12),GA(LA21),
- + GC(LC),GC(LC12),GC(LC21))
- CALL CHECKL(M,N,C,IRDIM,GC,LC,LC12,LC21,OKL,VDIST,VSET)
- IF(.NOT. OKL) WRITE(IOUNIT,1001) M,N,JCNFG,LC,LC12,LC21
- OK = OK .AND. OKL
- 13 CONTINUE
- RETURN
-1000 FORMAT(/ 25H ??? ARITHMETIC ERROR ???, 5I8,1P,E12.3 )
-1001 FORMAT(/ 20H ??? LOGIC ERROR ???, 6I8 )
- END
- SUBROUTINE TMSET(M,N,A,C,IRDIM,GC,ALPHA,BETA,OK,
- + MSET,MRAN,VDIST,VSET)
- REAL A(*), C(*), GC(*)
- REAL ALPHA(2), BETA(2)
- LOGICAL OK, OKL
- REAL E, R0, RES
- EXTERNAL VDIST, VSET
-#include "kernnumt/sysdat.inc"
-#include "ch3dat.inc"
- NDX2F(I,J) = ((J-1)*IDIM + I-1)*LENGTH + 1
- IRESF(RES) = NINT(RES/TRELPR)
- OK = .TRUE.
- IF(M .LE. 0 .OR. N .LE. 0) GOTO 12
- CALL MRAN(1,1,ALPHA,BETA,A,DMY,DMY)
- CALL KFLUSH
- CALL MSET(M,N,A,C,C(L12),C(L21))
- R0 = 0.
- DO 10 I = 1, M
- I1 = NDX2F(I,1)
- I2 = NDX2F(I,2)
- E = VDIST(N,C(I1),C(I2),A,A)
- R0 = AMAX1(R0,E)
- 10 CONTINUE
- N0 = IRESF(R0)
- M0 = 0
- OK = N0 .LE. M0
- IF(.NOT. OK) WRITE(IOUNIT,1000) M, N, IDIM, M0, N0, R0
- 12 DO 13 JCNFG = 1, NCNFG
- CALL CNFGMX(M,N,IRDIM,LC,LC12,LC21)
- CALL KFLUSH
- CALL MSET(M,N,A,GC(LC),GC(LC12),GC(LC21))
- CALL CHECKL(M,N,C,IRDIM,GC,LC,LC12,LC21,OKL,VDIST,VSET)
- IF(.NOT. OKL) WRITE(IOUNIT,1001) M,N,JCNFG,LC,LC12,LC21
- OK = OK .AND. OKL
- 13 CONTINUE
- RETURN
-1000 FORMAT(/ 25H ??? ARITHMETIC ERROR ???, 5I8,1P,E12.3 )
-1001 FORMAT(/ 20H ??? LOGIC ERROR ???, 6I8 )
- END
- SUBROUTINE TMUTL(N,A,C,IRDIM,GC,ALPHA,BETA,OK,
- + MUTL,MCPY,MRAN,VCPY,VDIST,VSET)
- REAL A(*), C(*), GC(*)
- REAL ALPHA(2), BETA(2)
- LOGICAL OK, OKL
- EXTERNAL VDIST
-#include "kernnumt/sysdat.inc"
-#include "ch3dat.inc"
- NDX2F(I,J) = ((J-1)*IDIM + I-1)*LENGTH + 1
- OK = .TRUE.
- CALL MRAN(N,N,ALPHA,BETA,A,A(L12),A(L21))
- IF(N .LE. 0) GOTO 12
- DO 11 I = 1, N
- II = NDX2F(I,I)
- II1 = NDX2F(I,I+1)
- I1I = NDX2F(I+1,I)
- CALL VCPY(N-I+1,A(II),A(II1),C(II),C(II1))
- CALL VCPY(N-I+1,A(II),A(II1),C(II),C(I1I))
- 11 CONTINUE
- 12 DO 13 JCNFG = 1, NCNFG
- CALL CNFGMX(N,N,IRDIM,LC,LC12,LC21)
- CALL MCPY(N,N,A,A(L12),A(L21),GC(LC),GC(LC12),GC(LC21))
- CALL KFLUSH
- CALL MUTL(N,GC(LC),GC(LC12),GC(LC21))
- CALL CHECKL(N,N,C,IRDIM,GC,LC,LC12,LC21,OKL,VDIST,VSET)
- IF(.NOT. OKL) WRITE(IOUNIT,1001) N
- OK = OK .AND. OKL
- 13 CONTINUE
- RETURN
-1001 FORMAT(/ 26H ??? LOGIC ERROR ??? N =, I3)
- END
- SUBROUTINE TRSCL(M,N,A,B,C,T,IRDIM,GA,GB,GC,ALPHA,BETA,OK,
- + MCPY,RSCL,MRAN,VDIST,VMAXA,VSCL,VSET)
- REAL A(*), B(*), C(*), T(*), GA(*), GB(*), GC(*)
- REAL ALPHA(2), BETA(2)
- LOGICAL OK, OKL
- REAL E, R0, RES
- EXTERNAL VDIST, VSET
-#include "kernnumt/sysdat.inc"
-#include "ch3dat.inc"
- NDX1F(J) = (J-1)*LENGTH + 1
- NDX2F(I,J) = ((J-1)*IDIM + I-1)*LENGTH + 1
- IRESF(RES) = NINT(RES/TRELPR)
- OK = .TRUE.
- IF(M .LE. 0 .OR. N .LE. 0) GOTO 12
- CALL MRAN(1,M,ALPHA,BETA,A,A(L2),DMY)
- CALL MRAN(M,N,ALPHA,BETA,B,B(L12),B(L21))
- CALL KFLUSH
- CALL RSCL(M,N,A,A(L2),B,B(L12),B(L21),C,C(L12),C(L21))
- R0 = 0.
- DO 10 I = 1, M
- ID = NDX1F(I)
- I1 = NDX2F(I,1)
- I2 = NDX2F(I,2)
- CALL VSCL(N,A(ID),B(I1),B(I2),T,T(L2))
- E = VDIST(N,C(I1),C(I2),T,T(L2))
- CALL VMAXA(N,T,T(L2),IDUMMY,ABSREF)
- R0 = AMAX1(R0,E/ABSREF)
- 10 CONTINUE
- N0 = IRESF(R0)
- M0 = 20
- OK = N0 .LE. M0
- IF(.NOT. OK) WRITE(IOUNIT,1000) M, N, IDIM, M0, N0, R0
- 12 DO 13 JCNFG = 1, NCNFG
- CALL CNFGMX(M,1,IRDIM,LA,LDMY,LA2)
- CALL CNFGMX(M,N,IRDIM,LB,LB12,LB21)
- CALL CNFGMX(M,N,IRDIM,LC,LC12,LC21)
- CALL MCPY(1,M,A,A(L2),DMY,GA(LA),GA(LA2),DMY)
- CALL MCPY(M,N,B,B(L12),B(L21),GB(LB),GB(LB12),GB(LB21))
- CALL KFLUSH
- CALL RSCL(M,N,GA(LA),GA(LA2),GB(LB),GB(LB12),GB(LB21),
- + GC(LC),GC(LC12),GC(LC21))
- CALL CHECKL(M,N,C,IRDIM,GC,LC,LC12,LC21,OKL,VDIST,VSET)
- IF(.NOT. OKL) WRITE(IOUNIT,1001) M,N,JCNFG,LC,LC12,LC21
- OK = OK .AND. OKL
- 13 CONTINUE
- RETURN
-1000 FORMAT(/ 25H ??? ARITHMETIC ERROR ???, 5I8,1P,E12.3 )
-1001 FORMAT(/ 20H ??? LOGIC ERROR ???, 6I8 )
- END
- SUBROUTINE TUMPY(N,A,B,C,R,T,IRDIM,GA,GB,GC,ZERO,ALPHA,BETA,
- + OK,UMNA,UMNS,UMPA,UMPS,UMPY,MCPY,MRAN,
- + VADD,VDIST,VMAXA,VSCA,VSCS,VSET,VSUB)
- REAL A(*), B(*), C(*), R(*), T(*), GA(*), GB(*), GC(*)
- REAL ZERO(2), ALPHA(2), BETA(2)
- COMPLEX BCONJG, RCONJG
- LOGICAL OK, OKA, OKL
- REAL R0, RES
- EXTERNAL VDIST, VSET
-#include "kernnumt/sysdat.inc"
-#include "ch3dat.inc"
- NDX1F(J) = (J-1)*LENGTH + 1
- NDX2F(I,J) = ((J-1)*IDIM + I-1)*LENGTH + 1
- IRESF(RES) = NINT(RES/TRELPR)
- OK = .TRUE.
- IF(CCFLAG) THEN
- MFUNCT = 5
- ELSE
- MFUNCT = 1
- ENDIF
- DO 40 JFUNCT = MFUNCT, 5
- IF(N .LE. 0) GOTO 30
- CALL MRAN(N,N,ALPHA,BETA,A,A(L12),A(L22))
- CALL MRAN(N,1,ALPHA,BETA,B,DUMMY,B(L2))
- CALL MRAN(N,1,ALPHA,BETA,C,DUMMY,C(L2))
- CALL MCPY(N,1,C,DUMMY,C(L2),R,DUMMY,R(L2))
- CALL VSET(N,ZERO,T(1),T(L2))
- DO 10 J = 1, N
- LJ = NDX1F(J)
- L1J = NDX2F(1,J)
- L2J = NDX2F(2,J)
- IF(CCFLAG) THEN
- RCONJG = CMPLX(R(LJ),-R(LJ+1))
- CALL VSCA(J,RCONJG,A(L1J),A(L2J),T,T(L2),T,T(L2))
- ELSE
- CALL VSCA(J,R(LJ),A(L1J),A(L2J),T,T(L2),T,T(L2))
- ENDIF
- 10 CONTINUE
- GOTO(11,12,13,14,15), JFUNCT
- 11 CALL VSUB(N,C(1),C(L2),T(1),T(L2),T(1),T(L2))
- CALL KFLUSH
- CALL UMNA(N,A,A(L12),A(L22),C,C(L2),C,C(L2))
- GOTO 18
- 12 CALL VADD(N,T(1),T(L2),C(1),C(L2),T(1),T(L2))
- CALL VSCS(N,ZERO,T(1),T(L2),T(1),T(L2),T(1),T(L2))
- CALL KFLUSH
- CALL UMNS(N,A,A(L12),A(L22),C,C(L2),C,C(L2))
- GOTO 18
- 13 CALL VADD(N,T(1),T(L2),C(1),C(L2),T(1),T(L2))
- CALL KFLUSH
- CALL UMPA(N,A,A(L12),A(L22),C,C(L2),C,C(L2))
- GOTO 18
- 14 CALL VSUB(N,T(1),T(L2),C(1),C(L2),T(1),T(L2))
- CALL KFLUSH
- CALL UMPS(N,A,A(L12),A(L22),C,C(L2),C,C(L2))
- GOTO 18
- 15 CALL KFLUSH
- CALL UMPY(N,A,A(L12),A(L22),C,C(L2),C,C(L2))
- 18 R0 = VDIST(N,C,C(L2),T,T(L2))
- IF(R0 .EQ. 0.) GOTO 19
- CALL VMAXA(N,T,T(L2),IDUMMY,ABSREF)
- R0 = R0 / ABSREF
- 19 N0 = IRESF(R0)
- M0 = 40
- OKA = N0 .LE. M0
- IF(.NOT. OKA) WRITE(IOUNIT,1002) JFUNCT,N,IDIM,M0,N0,R0
- OK = OK .AND. OKA
- CALL MCPY(N,1,R,DUMMY,R(L2),C,DUMMY,C(L2))
- CALL VSET(N,ZERO,T(1),T(L2))
- DO 20 J = 1, N
- LJ = NDX1F(J)
- L1J = NDX2F(1,J)
- L2J = NDX2F(2,J)
- IF(CCFLAG) THEN
- BCONJG = CMPLX(B(LJ),-B(LJ+1))
- CALL VSCA(J,BCONJG,A(L1J),A(L2J),T,T(L2),T,T(L2))
- ELSE
- CALL VSCA(J,B(LJ),A(L1J),A(L2J),T,T(L2),T,T(L2))
- ENDIF
- 20 CONTINUE
- GOTO(21,22,23,24,25), JFUNCT
- 21 CALL VSUB(N,C(1),C(L2),T(1),T(L2),T(1),T(L2))
- CALL KFLUSH
- CALL UMNA(N,A,A(L12),A(L22),B,B(L2),C,C(L2))
- GOTO 28
- 22 CALL VADD(N,T(1),T(L2),C(1),C(L2),T(1),T(L2))
- CALL VSCS(N,ZERO,T(1),T(L2),T(1),T(L2),T(1),T(L2))
- CALL KFLUSH
- CALL UMNS(N,A,A(L12),A(L22),B,B(L2),C,C(L2))
- GOTO 28
- 23 CALL VADD(N,T(1),T(L2),C(1),C(L2),T(1),T(L2))
- CALL KFLUSH
- CALL UMPA(N,A,A(L12),A(L22),B,B(L2),C,C(L2))
- GOTO 28
- 24 CALL VSUB(N,T(1),T(L2),C(1),C(L2),T(1),T(L2))
- CALL KFLUSH
- CALL UMPS(N,A,A(L12),A(L22),B,B(L2),C,C(L2))
- GOTO 28
- 25 CALL KFLUSH
- CALL UMPY(N,A,A(L12),A(L22),B,B(L2),C,C(L2))
- 28 R0 = VDIST(N,C,C(L2),T,T(L2))
- IF(R0 .EQ. 0.) GOTO 29
- CALL VMAXA(N,T,T(L2),IDUMMY,ABSREF)
- R0 = R0 / ABSREF
- 29 N0 = IRESF(R0)
- M0 = 10
- OKA = N0 .LE. M0
- IF(.NOT. OKA) WRITE(IOUNIT,1000) JFUNCT,N,IDIM,M0,N0,R0
- OK = OK .AND. OKA
- IF(.NOT. OK) RETURN
- 30 DO 39 JCNFG = 1, NCNFG
- CALL CNFGMX(N,N,IRDIM,LA,LA12,LA21)
- LA22 = LA12 + LA21 - LA
- CALL CNFGMX(N,1,IRDIM,LB,LB12,LB21)
- CALL CNFGMX(N,1,IRDIM,LC,LC12,LC21)
- CALL MCPY(N,N,A,A(L12),A(L21),GA(LA),GA(LA12),GA(LA21))
- CALL MCPY(N,1,B,DMY,B(L2),GB(LB),DMY,GB(LB21))
- CALL MCPY(N,1,R,DMY,R(L2),GC(LC),DMY,GC(LC21))
- GOTO(31,32,33,34,35), JFUNCT
- 31 CALL KFLUSH
- CALL UMNA(N,GA(LA),GA(LA12),GA(LA22),GB(LB),GB(LB21),
- + GC(LC),GC(LC21))
- GOTO 38
- 32 CALL KFLUSH
- CALL UMNS(N,GA(LA),GA(LA12),GA(LA22),GB(LB),GB(LB21),
- + GC(LC),GC(LC21))
- GOTO 38
- 33 CALL KFLUSH
- CALL UMPA(N,GA(LA),GA(LA12),GA(LA22),GB(LB),GB(LB21),
- + GC(LC),GC(LC21))
- GOTO 38
- 34 CALL KFLUSH
- CALL UMPS(N,GA(LA),GA(LA12),GA(LA22),GB(LB),GB(LB21),
- + GC(LC),GC(LC21))
- GOTO 38
- 35 CALL KFLUSH
- CALL UMPY(N,GA(LA),GA(LA12),GA(LA22),GB(LB),GB(LB21),
- + GC(LC),GC(LC21))
- GOTO 38
- 38 CALL CHECKL(N,1,C,IRDIM,GC,LC,LC12,LC21,OKL,VDIST,VSET)
- IF(.NOT. OKL) WRITE(IOUNIT,1001) JFUNCT,N,JCNFG,
- + LC,LC12,LC21
- OK = OK .AND. OKL
- 39 CONTINUE
- 40 CONTINUE
- RETURN
-1000 FORMAT(/ 26H ??? ARITHMETIC ERROR ??? , 5I8,1P,E12.3)
-1001 FORMAT(/ 20H ??? LOGIC ERROR ???,6I8)
-1002 FORMAT(/ 26H ??? ERROR FOR Z = Y ??? , 5I8,1P,E12.3)
- END
- SUBROUTINE TCUMPY(N,A,B,C,R,T,IRDIM,GA,GB,GC,ZERO,ALPHA,BETA,
- + OK,UMPY,MCPY,MRAN,VDIST,VMAXA,VSET)
- REAL A(*), B(*), C(*), R(*), T(*), GA(*), GB(*), GC(*)
- REAL ZERO(2), ALPHA(2), BETA(2), R0, RES
- LOGICAL OK, OKA, OKL
- EXTERNAL VDIST, VSET
-#include "kernnumt/sysdat.inc"
-#include "ch3dat.inc"
- NDX1F(J) = (J-1)*LENGTH + 1
- NDX2F(I,J) = ((J-1)*IDIM + I-1)*LENGTH + 1
- IRESF(RES) = NINT(RES/TRELPR)
- OK = .TRUE.
- IF(N .LE. 0) GOTO 30
- CALL MRAN(N,N,ALPHA,BETA,A,A(L12),A(L22))
- CALL MRAN(N,1,ALPHA,BETA,B,DUMMY,B(L2))
- CALL MRAN(N,1,ALPHA,BETA,C,DUMMY,C(L2))
- CALL MCPY(N,1,C,DUMMY,C(L2),R,DUMMY,R(L2))
- CALL VSET(N,ZERO,T(1),T(L2))
- DO 10 I = 1, N
- LI = NDX1F(I)
- LIP = NDX1F(I+1)
- LII = NDX2F(I,I)
- LIIP = NDX2F(I,I+1)
- CALL CCVDOT(N-I+1,A(LII),A(LIIP),C(LI),C(LIP),T(LI))
- 10 CONTINUE
- CALL KFLUSH
- CALL UMPY(N,A,A(L12),A(L22),C,C(L2),C,C(L2))
- R0 = VDIST(N,C,C(L2),T,T(L2))
- IF(R0 .EQ. 0.) GOTO 19
- CALL VMAXA(N,T,T(L2),IDUMMY,ABSREF)
- R0 = R0 / ABSREF
- 19 N0 = IRESF(R0)
- M0 = 40
- OKA = N0 .LE. M0
- IF(.NOT. OKA) WRITE(IOUNIT,1002) N,IDIM,M0,N0,R0
- OK = OK .AND. OKA
- CALL MCPY(N,1,R,DUMMY,R(L2),C,DUMMY,C(L2))
- CALL VSET(N,ZERO,T(1),T(L2))
- DO 20 I = 1, N
- LI = NDX1F(I)
- LIP = NDX1F(I+1)
- LII = NDX2F(I,I)
- LIIP = NDX2F(I,I+1)
- CALL CCVDOT(N-I+1,A(LII),A(LIIP),B(LI),B(LIP),T(LI))
- 20 CONTINUE
- CALL KFLUSH
- CALL UMPY(N,A,A(L12),A(L22),B,B(L2),C,C(L2))
- R0 = VDIST(N,C,C(L2),T,T(L2))
- IF(R0 .EQ. 0.) GOTO 29
- CALL VMAXA(N,T,T(L2),IDUMMY,ABSREF)
- R0 = R0 / ABSREF
- 29 N0 = IRESF(R0)
- M0 = 10
- OKA = N0 .LE. M0
- IF(.NOT. OKA) WRITE(IOUNIT,1000) N,IDIM,M0,N0,R0
- OK = OK .AND. OKA
- IF(.NOT. OK) RETURN
- 30 DO 39 JCNFG = 1, NCNFG
- CALL CNFGMX(N,N,IRDIM,LA,LA12,LA21)
- LA22 = LA12 + LA21 - LA
- CALL CNFGMX(N,1,IRDIM,LB,LB12,LB21)
- CALL CNFGMX(N,1,IRDIM,LC,LC12,LC21)
- CALL MCPY(N,N,A,A(L12),A(L21),GA(LA),GA(LA12),GA(LA21))
- CALL MCPY(N,1,B,DMY,B(L2),GB(LB),DMY,GB(LB21))
- CALL MCPY(N,1,R,DMY,R(L2),GC(LC),DMY,GC(LC21))
- CALL KFLUSH
- CALL UMPY(N,GA(LA),GA(LA12),GA(LA22),GB(LB),GB(LB21),
- + GC(LC),GC(LC21))
- CALL CHECKL(N,1,C,IRDIM,GC,LC,LC12,LC21,OKL,VDIST,VSET)
- IF(.NOT. OKL) WRITE(IOUNIT,1001) N,JCNFG,LC,LC12,LC21
- OK = OK .AND. OKL
- 39 CONTINUE
- RETURN
-1000 FORMAT(/ 26H ??? ARITHMETIC ERROR ??? , 4I8,1P,E12.3)
-1001 FORMAT(/ 20H ??? LOGIC ERROR ???,5I8)
-1002 FORMAT(/ 26H ??? ERROR FOR Z = Y ??? , 4I8,1P,E12.3)
- END
diff --git a/src/packlib/kernlib/kernnum/test/numchk3/f004ch.F b/src/packlib/kernlib/kernnum/test/numchk3/f004ch.F
deleted file mode 100644
index 69644bd..0000000
--- a/src/packlib/kernlib/kernnum/test/numchk3/f004ch.F
+++ /dev/null
@@ -1,534 +0,0 @@
-*
-* $Id: f004ch.F,v 1.1.1.1 1996/02/15 17:48:45 mclareni Exp $
-*
-* $Log: f004ch.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:45 mclareni
-* Kernlib
-*
-*
-#include "kernnumt/pilot.h"
- SUBROUTINE F004CH(NREP,LWORK,W,OK)
- REAL W(LWORK)
- LOGICAL OK, OKT
-#include "kernnumt/sysdat.inc"
- OK = .TRUE.
- DO 100 JREP = 1, NREP
- CALL TF004(LWORK,W,OKT)
- OK = OK .AND. OKT
- 100 CONTINUE
- RETURN
- END
- SUBROUTINE TF004(LWORK,W,OK)
- DIMENSION W(LWORK), HT(3)
-#include "kernnumt/sysdat.inc"
-#include "ch3dat.inc"
- LOGICAL OK, ROK, DOK, COK
- REAL RALPHA(1),RBETA(1), RFMONE(1)
- DOUBLE PRECISION DALPHA(1),DBETA(1), DFMONE(1)
- COMPLEX CALPHA(1),CBETA(1), CFMONE(1)
- EXTERNAL RMMLT, DMMLT, CMMLT
- EXTERNAL RMMLA, DMMLA, CMMLA
- EXTERNAL RMMLS, DMMLS, CMMLS
- EXTERNAL RMNMA, DMNMA, CMNMA
- EXTERNAL RMNMS, DMNMS, CMNMS
- EXTERNAL RMADD, DMADD, CMADD
- EXTERNAL RMCPY, DMCPY, CMCPY
- EXTERNAL RMMPY, DMMPY, CMMPY
- EXTERNAL RMRAN, DMRAN, CMRAN
- EXTERNAL RMSCL, DMSCL, CMSCL
- EXTERNAL RMSUB, DMSUB, CMSUB
- EXTERNAL RVDIST, DVDIST, CVDIST
- EXTERNAL RVMAXA, DVMAXA, CVMAXA
- EXTERNAL RVSET, DVSET, CVSET
- CHARACTER*4 HT
- DATA HT / 'R ', 'D ', 'C ' /
- DATA RFMONE / -1. /
- DATA DFMONE / -1.D0 /
- DATA CFMONE / (-1.,0.) /
- DATA RALPHA, RBETA / -100., +100. /
- DATA DALPHA, DBETA / -100.D0, +100.D0 /
- DATA CALPHA, CBETA / (-100.,-100.),(+100.,+100.)/
- WRITE(IOUNIT,1001)
- HTYPE = HT(1)
- LENGTH = 1
- TRELPR = RELPRT(1)
- LTAB = LTABT(1)
- CALL XF004(LWORK,W,RFMONE(1),RALPHA(1),RBETA(1),ROK,
- + RMMLT,RMMLA,RMMLS,RMNMA,RMNMS,RMADD,RMCPY,
- + RMMPY,RMRAN,RMSCL,RMSUB,RVDIST,RVMAXA,RVSET)
- WRITE(IOUNIT,1002)
- HTYPE = HT(2)
- LENGTH = 2
- TRELPR = RELPRT(2)
- LTAB = LTABT(2)
- CALL XF004(LWORK,W,DFMONE(1),DALPHA(1),DBETA(1),DOK,
- + DMMLT,DMMLA,DMMLS,DMNMA,DMNMS,DMADD,DMCPY,
- + DMMPY,DMRAN,DMSCL,DMSUB,DVDIST,DVMAXA,DVSET)
- WRITE(IOUNIT,1003)
- HTYPE = HT(3)
- LENGTH = 2
- TRELPR = RELPRT(1)
- LTAB = LTABT(3)
- CALL XF004(LWORK,W,CFMONE(1),CALPHA(1),CBETA(1),COK,
- + CMMLT,CMMLA,CMMLS,CMNMA,CMNMS,CMADD,CMCPY,
- + CMMPY,CMRAN,CMSCL,CMSUB,CVDIST,CVMAXA,CVSET)
- OK = ROK .AND. DOK .AND. COK
- 90 IF(.NOT. OK) WRITE(IOUNIT,1004)
- IF( OK) WRITE(IOUNIT,1005)
- RETURN
-1001 FORMAT(17H1F004. TYPE = R. )
-1002 FORMAT( // 17H0F004. TYPE = D. )
-1003 FORMAT( // 17H0F004. TYPE = C. )
-1004 FORMAT(/35X, 37H ????? TEST OF F004 HAS FAILED. ????? )
-1005 FORMAT(/35X, 44HACCEPTANCE TEST OF F004 HAS BEEN SUCCESSFUL.)
- END
- SUBROUTINE XF004(LWORK,W,FMONE,ALPHA,BETA,OK,
- + MMLT,MMLA,MMLS,MNMA,MNMS,MADD,MCPY,
- + MMPY,MRAN,MSCL,MSUB,VDIST,VMAXA,VSET)
- REAL W(LWORK)
- REAL FMONE(2), ALPHA(2), BETA(2)
- LOGICAL OK, OKN, OKT
- DIMENSION HN(2,3), HNAME(2)
- CHARACTER*4 HN, HNAME
- EXTERNAL CMMLTC, CMMPYC
-#include "kernnumt/sysdat.inc"
-#include "ch3dat.inc"
- DATA HN / 'M ', 'MLT ',
- + 'M ', 'MXX ',
- + 'M ', 'MLTC' /
- NDX2F(I,J) = ((J-1)*IDIM + I-1)*LENGTH + 1
- OK = .TRUE.
- LF = LWORK / 12
- LG = (LWORK - 4*LF) / 3
- LFA = 1
- LFB = LFA + LF
- LFC = LFB + LF
- LFT = LFC + LF
- LGA = LFT + LF
- LGB = LGA + LG
- LGC = LGB + LG
- CALL RVSET(LG,VOID(1),W(LGC),W(LGC+1))
- IF(HTYPE .EQ. 'C ') NTEST = 3
- IF(HTYPE .NE. 'C ') NTEST = 2
- CCFLAG = .FALSE.
- DO 300 JTEST = 1, NTEST
- OKT = .TRUE.
- HNAME(1) = HN(1,JTEST)
- HNAME(2) = HN(2,JTEST)
- WRITE(IOUNIT,1001) HTYPE, HNAME
- KNTSKP = LTAB
- 20 DO 200 JTAB = 1, LTAB
- M = MTAB(JTAB)
- N = NTAB(JTAB)
- K = KTAB(JTAB)
- IDIM = MAX0(M,N,K,1)
- IF(IDIM .GE. 3 .AND. IDIM .LE. 7) IDIM = IDIM + 3
- IF(LF .LT. LENGTH*IDIM**2) GOTO 200
- KNTSKP = KNTSKP - 1
- L12 = NDX2F(1,2)
- L21 = NDX2F(2,1)
- L2 = L21
- GOTO(01, 02, 03), JTEST
- 01 CALL TMMLT(M,N,K,W(LFA),W(LFB),W(LFC),W(LFT),
- + LG,W(LGA),W(LGB),W(LGC),ALPHA(1),BETA(1),OKN,
- + MCPY,MMLT,MMPY,MRAN,VDIST,VMAXA,VSET)
- GOTO 99
- 02 CALL TMXXX(M,N,K,W(LFA),W(LFB),W(LFC),W(LFT),
- + LG,W(LGA),W(LGB),W(LGC),FMONE(1),ALPHA(1),BETA(1),OKN,
- + MMLA,MMLS,MNMA,MNMS,MADD,MCPY,
- + MMPY,MRAN,MSCL,MSUB,VDIST,VMAXA,VSET)
- GOTO 99
- 03 CCFLAG = .TRUE.
- CALL TMMLT(M,N,K,W(LFA),W(LFB),W(LFC),W(LFT),
- + LG,W(LGA),W(LGB),W(LGC),ALPHA(1),BETA(1),OKN,
- + MCPY,CMMLTC,CMMPYC,MRAN,VDIST,VMAXA,VSET)
- 99 OKT = OKT .AND. OKN
- 200 CONTINUE
- CCFLAG = .FALSE.
- IF(.NOT. OKT) WRITE(IOUNIT,1010)
- IF( OKT) WRITE(IOUNIT,1011)
- OK = OK .AND. OKT
- 300 CONTINUE
- IF(KNTSKP .NE. 0) WRITE(*,1014) KNTSKP
- IF(.NOT. OK) WRITE(IOUNIT,1012) HTYPE
- IF( OK) WRITE(IOUNIT,1013) HTYPE
- RETURN
-1001 FORMAT(/// 9H TEST OF ,2A1,A4,1H. )
-1010 FORMAT(/ 5X, 37H ????? FEATURE TEST HAS FAILED. ????? )
-1011 FORMAT( 15X, 25H FEATURE TEST SUCCESSFUL. )
-1012 FORMAT(/25X, 21H ????? TEST FOR TYPE ,A1,
- + 18H HAS FAILED. ????? )
-1013 FORMAT(/25X, 15H TEST FOR TYPE ,A1,13H SUCCESSFUL. )
-1014 FORMAT( 20X, 11HWARNING ..., I3,
- + 52H CONFIGURATIONS HAVE BEEN SKIPPED FOR WANT OF SPACE.)
- END
- SUBROUTINE TMMLT(M,N,K,A,B,C,T,LG,GA,GB,GC,
- + ALPHA,BETA,OK,MCPY,MMLT,MMPY,MRAN,VDIST,VMAXA,VSET)
- REAL A(*), B(*), C(*), T(*), GA(*), GB(*), GC(*)
- REAL ALPHA(2), BETA(2)
- LOGICAL OK, OKA, OKL, OKT
- REAL E, R0, RES
- EXTERNAL VDIST, VSET
-#include "kernnumt/sysdat.inc"
-#include "ch3dat.inc"
- NDX2F(I,J) = ((J-1)*IDIM + I-1)*LENGTH + 1
- IRESF(RES) = NINT(RES/TRELPR)
- OK = .TRUE.
- OKA = .TRUE.
- IF(MIN0(M,N,K) .LE. 0) GOTO 12
- CALL MRAN(M,N,ALPHA,BETA,A,A(L12),A(L21))
- CALL MRAN(N,K,ALPHA,BETA,B,B(L12),B(L21))
- CALL KFLUSH
- CALL MMLT(M,N,K,A,A(L12),A(L21),B,B(L12),B(L21),
- + C,C(L12),C(L21),T)
- R0 = 0.
- DO 11 I = 1, M
- I1 = NDX2F(I,1)
- I2 = NDX2F(I,2)
- IF(CCFLAG) THEN
- CALL CCMMPY(K,N,B,B(L21),B(L12),A(I1),A(I2),T,T(L2))
- ELSE
- CALL MMPY(K,N,B,B(L21),B(L12),A(I1),A(I2),T,T(L2))
- ENDIF
- E = VDIST(K,C(I1),C(I2),T,T(L2))
- IF(E .EQ. 0.) GOTO 11
- CALL VMAXA(K,T,T(L2),IDUMMY,ABSREF)
- R0 = AMAX1(R0,E/ABSREF)
- 11 CONTINUE
- N0 = IRESF(R0)
- M0 = 20
- OKA = N0 .LE. M0
- IF(.NOT. OKA)
- + WRITE(IOUNIT,1001) M,N,K,IDIM,M0,N0,R0
- 12 OKL = .TRUE.
- DO 13 JCNFG = 1, NCNFG
- CALL CNFGMX(M,N,LG,LA,LA12,LA21)
- CALL CNFGMX(N,K,LG,LB,LB12,LB21)
- CALL CNFGMX(M,K,LG,LC,LC12,LC21)
- CALL MCPY(M,N,A,A(L12),A(L21),GA(LA),GA(LA12),GA(LA21))
- CALL MCPY(N,K,B,B(L12),B(L21),GB(LB),GB(LB12),GB(LB21))
- CALL MMLT(M,N,K,GA(LA),GA(LA12),GA(LA21),
- + GB(LB),GB(LB12),GB(LB21),
- + GC(LC),GC(LC12),GC(LC21), T)
- IF(N .GT. 0)
- + CALL CHECKL(M,K,C,LG,GC,LC,LC12,LC21,OKT,VDIST,VSET)
- IF(N .LE. 0)
- + CALL CHECKL(0,0,C,LG,GC,LC,LC12,LC21,OKT,VDIST,VSET)
- IF(.NOT. OKT)
- + WRITE(IOUNIT,1011)M,N,K,JCNFG,LC,LC12,LC21
- OKL = OKL .AND. OKT
- 13 CONTINUE
- OK = OK .AND. OKA .AND. OKL
- CALL MRAN(M,N,ALPHA,BETA,A,A(L12),A(L21))
- CALL MRAN(N,K,ALPHA,BETA,B,B(L12),B(L21))
- CALL MCPY(N,K,B,B(L12),B(L21),C,C(L12),C(L21))
- CALL KFLUSH
- CALL MMLT(M,N,K,A,A(L12),A(L21),C,C(L12),C(L21),
- + C,C(L12),C(L21),T)
- CALL MMLT(M,N,K,A,A(L12),A(L21),B,B(L12),B(L21),
- + T,T(L12),T(L21),T)
- R0 = 0.
- IF(M .LE. 0 .OR. N .LE. 0) GOTO 22
- DO 21 I = 1, M
- I1 = NDX2F(I,1)
- I2 = NDX2F(I,2)
- E = VDIST(K,C(I1),C(I2),T(I1),T(I2))
- IF(E .EQ. 0.) GOTO 21
- CALL VMAXA(K,T(I1),T(I2),IDUMMY,ABSREF)
- R0 = AMAX1(R0,E/ABSREF)
- 21 CONTINUE
- 22 N0 = IRESF(R0)
- M0 = 20
- OKA = N0 .LE. M0
- IF(.NOT. OKA)
- + WRITE(IOUNIT,1002) M,N,K,IDIM,M0,N0,R0
- OKL = .TRUE.
- IF(N .GT. M) GOTO 24
- DO 23 JCNFG = 1, NCNFG
- CALL CNFGMX(M,N,LG,LA,LA12,LA21)
- CALL CNFGMX(M,K,LG,LC,LC12,LC21)
- CALL MCPY(M,N,A,A(L12),A(L21),GA(LA),GA(LA12),GA(LA21))
- CALL MCPY(N,K,B,B(L12),B(L21),GC(LC),GC(LC12),GC(LC21))
- CALL MMLT(M,N,K,GA(LA),GA(LA12),GA(LA21),
- + GC(LC),GC(LC12),GC(LC21),
- + GC(LC),GC(LC12),GC(LC21), T)
- IF(N .GT. 0)
- + CALL CHECKL(M,K,C,LG,GC,LC,LC12,LC21,OKT,VDIST,VSET)
- IF(N .LE. 0)
- + CALL CHECKL(0,0,C,LG,GC,LC,LC12,LC21,OKT,VDIST,VSET)
- IF(.NOT. OKT)
- + WRITE(IOUNIT,1012)M,N,K,JCNFG,LC,LC12,LC21
- OKL = OKL .AND. OKT
- 23 CONTINUE
- 24 OK = OK .AND. OKA .AND. OKL
- CALL MRAN(M,N,ALPHA,BETA,A,A(L12),A(L21))
- CALL MRAN(N,K,ALPHA,BETA,B,B(L12),B(L21))
- CALL MCPY(M,N,A,A(L12),A(L21),C,C(L12),C(L21))
- CALL KFLUSH
- CALL MMLT(M,N,K,C,C(L12),C(L21),B,B(L12),B(L21),
- + C,C(L12),C(L21),T)
- CALL MMLT(M,N,K,A,A(L12),A(L21),B,B(L12),B(L21),
- + T,T(L12),T(L21),T)
- R0 = 0.
- IF(M .LE. 0 .OR. N .LE. 0) GOTO 32
- DO 31 I = 1, M
- I1 = NDX2F(I,1)
- I2 = NDX2F(I,2)
- E = VDIST(K,C(I1),C(I2),T(I1),T(I2))
- IF(E .EQ. 0.) GOTO 31
- CALL VMAXA(K,T(I1),T(I2),IDUMMY,ABSREF)
- R0 = AMAX1(R0,E/ABSREF)
- 31 CONTINUE
- 32 N0 = IRESF(R0)
- M0 = 20
- OKA = N0 .LE. M0
- IF(.NOT. OKA)
- + WRITE(IOUNIT,1003) M,N,K,IDIM,M0,N0,R0
- OKL = .TRUE.
- IF(N .GT. K) GOTO 34
- DO 33 JCNFG = 1, NCNFG
- CALL CNFGMX(N,K,LG,LB,LB12,LB21)
- CALL CNFGMX(M,K,LG,LC,LC12,LC21)
- CALL MCPY(M,N,A,A(L12),A(L21),GC(LC),GC(LC12),GC(LC21))
- CALL MCPY(N,K,B,B(L12),B(L21),GB(LB),GB(LB12),GB(LB21))
- CALL MMLT(M,N,K,GC(LC),GC(LC12),GC(LC21),
- + GB(LB),GB(LB12),GB(LB21),
- + GC(LC),GC(LC12),GC(LC21), T)
- IF(N .GT. 0)
- + CALL CHECKL(M,K,C,LG,GC,LC,LC12,LC21,OKT,VDIST,VSET)
- IF(N .LE. 0)
- + CALL CHECKL(0,0,C,LG,GC,LC,LC12,LC21,OKT,VDIST,VSET)
- IF(.NOT. OKT) WRITE(IOUNIT,1013) M,N,K,JCNFG,LC,LC12,LC21
- OKL = OKL .AND. OKT
- 33 CONTINUE
- 34 OK = OK .AND. OKA .AND. OKL
- OKA = .TRUE.
- IF(MIN0(M,N) .LE. 0) GOTO 42
- CALL MRAN(M,N,ALPHA,BETA,A,A(L12),A(L21))
- CALL KFLUSH
- CALL MMLT(M,N,M,A,A(L12),A(L21),A,A(L21),A(L12),
- + C,C(L12),C(L21),T)
- R0 = 0.
- DO 41 I = 1, M
- I1 = NDX2F(I,1)
- I2 = NDX2F(I,2)
- J1 = NDX2F(1,I)
- J2 = NDX2F(2,I)
- CALL MMPY(M,N,A,A(L12),A(L21),A(I1),A(I2),T,T(L2))
- E = VDIST(M,C(J1),C(J2),T,T(L2))
- IF(E .EQ. 0.) GOTO 41
- CALL VMAXA(M,T,T(L2),IDUMMY,ABSREF)
- R0 = AMAX1(R0,E/ABSREF)
- 41 CONTINUE
- N0 = IRESF(R0)
- M0 = 20
- OKA = N0 .LE. M0
- IF(.NOT. OKA) WRITE(IOUNIT,1004) M,N,IDIM,M0,N0,R0
- 42 OKL = .TRUE.
- DO 43 JCNFG = 1, NCNFG
- CALL CNFGMX(M,N,LG,LA,LA12,LA21)
- CALL CNFGMX(M,M,LG,LC,LC12,LC21)
- CALL MCPY(M,N,A,A(L12),A(L21),GA(LA),GA(LA12),GA(LA21))
- CALL MMLT(M,N,M,GA(LA),GA(LA12),GA(LA21),
- + GA(LA),GA(LA21),GA(LA12),
- + GC(LC),GC(LC12),GC(LC21),T)
- IF(N .GT. 0)
- + CALL CHECKL(M,M,C,LG,GC,LC,LC12,LC21,OKT,VDIST,VSET)
- IF(N .LE. 0)
- + CALL CHECKL(0,0,C,LG,GC,LC,LC12,LC21,OKT,VDIST,VSET)
- IF(.NOT. OKT) WRITE(IOUNIT,1014) M,N,JCNFG,LC,LC12,LC21
- OKL = OKL .AND. OKT
- 43 CONTINUE
- OK = OK .AND. OKA .AND. OKL
- OKA = .TRUE.
- IF(MIN0(M,N) .LE. 0) GOTO 52
- CALL MRAN(M,N,ALPHA,BETA,A,A(L12),A(L21))
- CALL MCPY(M,N,A,A(L12),A(L21),C,C(L12),C(L21))
- CALL KFLUSH
- CALL MMLT(M,N,M,C,C(L12),C(L21),C,C(L21),C(L12),
- + C,C(L12),C(L21),T)
- CALL MMLT(M,N,M,A,A(L12),A(L21),A,A(L21),A(L12),
- + T,T(L12),T(L21),T)
- R0 = 0.
- DO 51 I = 1, M
- I1 = NDX2F(I,1)
- I2 = NDX2F(I,2)
- E = VDIST(M,C(I1),C(I2),T(I1),T(I2))
- IF(E .EQ. 0.) GOTO 51
- CALL VMAXA(M,T(I1),T(I2),IDUMMY,ABSREF)
- R0 = AMAX1(R0,E/ABSREF)
- 51 CONTINUE
- N0 = IRESF(R0)
- M0 = 20
- OKA = N0 .LE. M0
- IF(.NOT. OKA) WRITE(IOUNIT,1005)M,N,IDIM,M0,N0,R0
- 52 OKL = .TRUE.
- IF(N .GT. M) GOTO 54
- DO 53 JCNFG = 1, NCNFG
- CALL CNFGMX(M,M,LG,LC,LC12,LC21)
- CALL MCPY(M,N,A,A(L12),A(L21),GC(LC),GC(LC12),GC(LC21))
- CALL MMLT(M,N,M,GC(LC),GC(LC12),GC(LC21),
- + GC(LC),GC(LC21),GC(LC12),
- + GC(LC),GC(LC12),GC(LC21), T)
- IF(N .GT. 0)
- + CALL CHECKL(M,M,C,LG,GC,LC,LC12,LC21,OKT,VDIST,VSET)
- IF(N .LE. 0)
- + CALL CHECKL(0,0,C,LG,GC,LC,LC12,LC21,OKT,VDIST,VSET)
- IF(.NOT. OKT)
- + WRITE(IOUNIT,1015)M,N,JCNFG,LC,LC12,LC21
- OKL = OKL .AND. OKT
- 53 CONTINUE
- 54 OK = OK .AND. OKA .AND. OKL
- IF(.NOT. CCFLAG) RETURN
- OKA = .TRUE.
- IF(MIN0(M,N) .LE. 0) GOTO 62
- CALL MRAN(M,N,ALPHA,BETA,A,A(L12),A(L21))
- CALL MCPY(M,N,A,A(L12),A(L21),C,C(L12),C(L21))
- CALL KFLUSH
- CALL MMLT(M,N,M,C,C(L12),C(L21),C,C(L21),C(L12),
- + C,C(L21),C(L12),T)
- CALL MMLT(M,N,M,A,A(L12),A(L21),A,A(L21),A(L12),
- + T,T(L21),T(L12),T)
- R0 = 0.
- DO 61 I = 1, M
- I1 = NDX2F(I,1)
- I2 = NDX2F(I,2)
- E = VDIST(M,C(I1),C(I2),T(I1),T(I2))
- IF(E .EQ. 0.) GOTO 61
- CALL VMAXA(M,T(I1),T(I2),IDUMMY,ABSREF)
- R0 = AMAX1(R0,E/ABSREF)
- 61 CONTINUE
- N0 = IRESF(R0)
- M0 = 20
- OKA = N0 .LE. M0
- IF(.NOT. OKA) WRITE(IOUNIT,1006)M,N,IDIM,M0,N0,R0
- 62 OKL = .TRUE.
- IF(N .GT. M) GOTO 64
- DO 63 JCNFG = 1, NCNFG
- CALL CNFGMX(M,M,LG,LC,LC12,LC21)
- CALL MCPY(M,N,A,A(L12),A(L21),GC(LC),GC(LC12),GC(LC21))
- CALL MMLT(M,N,M,GC(LC),GC(LC12),GC(LC21),
- + GC(LC),GC(LC21),GC(LC12),
- + GC(LC),GC(LC21),GC(LC12), T)
- IF(N .GT. 0)
- + CALL CHECKL(M,M,C,LG,GC,LC,LC12,LC21,OKT,VDIST,VSET)
- IF(N .LE. 0)
- + CALL CHECKL(0,0,C,LG,GC,LC,LC12,LC21,OKT,VDIST,VSET)
- IF(.NOT. OKT)
- + WRITE(IOUNIT,1016)M,N,JCNFG,LC,LC12,LC21
- OKL = OKL .AND. OKT
- 63 CONTINUE
- 64 OK = OK .AND. OKA .AND. OKL
- RETURN
-1001 FORMAT(/ 25H ??? ARITHMETIC ERROR ???,6I8,1P,E12.3)
-1002 FORMAT(/ 32H ??? ARITHMETIC ERROR (Y=XY) ???,6I8,1P,E12.3)
-1003 FORMAT(/ 32H ??? ARITHMETIC ERROR (X=XY) ???,6I8,1P,E12.3)
-1004 FORMAT(/ 33H ??? ARITHMETIC ERROR (Z=XX') ???,5I8,1P,E12.3)
-1005 FORMAT(/ 33H ??? ARITHMETIC ERROR (X=XX') ???,5I8,1P,E12.3)
-1006 FORMAT(/ 33H ??? ARITHMETIC ERROR (X'=XX')???,5I8,1P,E12.3)
-1011 FORMAT(/ 20H ??? LOGIC ERROR ???,7I8)
-1012 FORMAT(/ 27H ??? LOGIC ERROR (Y=XY) ???,7I8)
-1013 FORMAT(/ 27H ??? LOGIC ERROR (X=XY) ???,7I8)
-1014 FORMAT(/ 28H ??? LOGIC ERROR (Z=XX') ???,6I8)
-1015 FORMAT(/ 28H ??? LOGIC ERROR (X=XX') ???,6I8)
-1016 FORMAT(/ 28H ??? LOGIC ERROR (X'=XX')???,6I8)
- END
- SUBROUTINE TMXXX(M,N,K,A,B,C,T,LG,GA,GB,GC,FMONE,ALPHA,BETA,OK,
- + MMLA,MMLS,MNMA,MNMS,MADD,MCPY,
- + MMPY,MRAN,MSCL,MSUB,VDIST,VMAXA,VSET)
- REAL A(*), B(*), C(*), T(*), GA(*), GB(*), GC(*)
- REAL FMONE(2), ALPHA(2), BETA(2)
- LOGICAL OK, OKA, OKL, OKT
- REAL E, R0, RES
- EXTERNAL VDIST, VSET
-#include "kernnumt/sysdat.inc"
-#include "ch3dat.inc"
- NDX2F(I,J) = ((J-1)*IDIM + I-1)*LENGTH + 1
- IRESF(RES) = NINT(RES/TRELPR)
- OK = .TRUE.
- DO 20 ISUB = 1, 4
- OKA = .TRUE.
- IF(MIN0(M,N,K) .LE. 0) GOTO 10
- CALL MRAN(M,N,ALPHA,BETA,A,A(L12),A(L21))
- CALL MRAN(N,K,ALPHA,BETA,B,B(L12),B(L21))
- CALL MRAN(M,K,ALPHA,BETA,C,C(L12),C(L21))
- CALL MCPY(M,K,C,C(L12),C(L21),T,T(L12),T(L21))
- GOTO(1,2,3,4), ISUB
- 1 CALL KFLUSH
- CALL MMLA(M,N,K,A,A(L12),A(L21),B,B(L12),B(L21),
- + C,C(L12),C(L21))
- CALL MSUB(M,K,C,C(L12),C(L21),T,T(L12),T(L21),
- + GB,GB(L12),GB(L21))
- GOTO 6
- 2 CALL KFLUSH
- CALL MMLS(M,N,K,A,A(L12),A(L21),B,B(L12),B(L21),
- + C,C(L12),C(L21))
- CALL MADD(M,K,C,C(L12),C(L21),T,T(L12),T(L21),
- + GB,GB(L12),GB(L21))
- GOTO 6
- 3 CALL KFLUSH
- CALL MNMA(M,N,K,A,A(L12),A(L21),B,B(L12),B(L21),
- + C,C(L12),C(L21))
- CALL MSUB(M,K,T,T(L12),T(L21),C,C(L12),C(L21),
- + GB,GB(L12),GB(L21))
- GOTO 6
- 4 CALL KFLUSH
- CALL MNMS(M,N,K,A,A(L12),A(L21),B,B(L12),B(L21),
- + C,C(L12),C(L21))
- CALL MSCL(M,K,FMONE,C,C(L12),C(L21),GB,GB(L12),GB(L21))
- CALL MSUB(M,K,GB,GB(L12),GB(L21),T,T(L12),T(L21),
- + GB,GB(L12),GB(L21))
- 6 R0 = 0.
- DO 7 I = 1, M
- I1 = NDX2F(I,1)
- I2 = NDX2F(I,2)
- CALL MMPY(K,N,B,B(L21),B(L12),A(I1),A(I2),GA,GA(L2))
- E = VDIST(K,GB(I1),GB(I2),GA,GA(L2))
- IF(E .EQ. 0.) GOTO 7
- CALL VMAXA(K,GA,GA(L2),IDUMMY,ABSREF)
- R0 = AMAX1(R0,E/ABSREF)
- 7 CONTINUE
- N0 = IRESF(R0)
- M0 = 40
- OKA = N0 .LE. M0
- IF(.NOT. OKA) WRITE(IOUNIT,1001) ISUB,M,N,K,IDIM,M0,N0,R0
- 10 OKL = .TRUE.
- DO 19 JCNFG = 1, NCNFG
- CALL CNFGMX(M,N,LG,LA,LA12,LA21)
- CALL CNFGMX(N,K,LG,LB,LB12,LB21)
- CALL CNFGMX(M,K,LG,LC,LC12,LC21)
- CALL MCPY(M,N,A,A(L12),A(L21),GA(LA),GA(LA12),GA(LA21))
- CALL MCPY(N,K,B,B(L12),B(L21),GB(LB),GB(LB12),GB(LB21))
- IF(MIN0(M,N,K) .GT. 0)
- + CALL MCPY(M,K,T,T(L12),T(L21),GC(LC),GC(LC12),GC(LC21))
- GOTO(11, 12, 13, 14), ISUB
- 11 CALL MMLA(M,N,K,GA(LA),GA(LA12),GA(LA21),
- + GB(LB),GB(LB12),GB(LB21),
- + GC(LC),GC(LC12),GC(LC21))
- GOTO 16
- 12 CALL MMLS(M,N,K,GA(LA),GA(LA12),GA(LA21),
- + GB(LB),GB(LB12),GB(LB21),
- + GC(LC),GC(LC12),GC(LC21))
- GOTO 16
- 13 CALL MNMA(M,N,K,GA(LA),GA(LA12),GA(LA21),
- + GB(LB),GB(LB12),GB(LB21),
- + GC(LC),GC(LC12),GC(LC21))
- GOTO 16
- 14 CALL MNMS(M,N,K,GA(LA),GA(LA12),GA(LA21),
- + GB(LB),GB(LB12),GB(LB21),
- + GC(LC),GC(LC12),GC(LC21))
- 16 IF(N .GT. 0)
- + CALL CHECKL(M,K,C,LG,GC,LC,LC12,LC21,OKT,VDIST,VSET)
- IF(N .LE. 0)
- + CALL CHECKL(0,0,C,LG,GC,LC,LC12,LC21,OKT,VDIST,VSET)
- IF(.NOT. OKT)
- + WRITE(IOUNIT,1011) ISUB,M,N,K,JCNFG,LC,LC12,LC21
- OKL = OKL .AND. OKT
- 19 CONTINUE
- OK = OK .AND. OKA .AND. OKL
- 20 CONTINUE
- 60 OK = OK .AND. OKA .AND. OKL
- RETURN
-1001 FORMAT(/ 25H ??? ARITHMETIC ERROR ???,7I8,1P,E12.3)
-1011 FORMAT(/ 20H ??? LOGIC ERROR ???,8I8)
- END
diff --git a/src/packlib/kernlib/kernnum/test/numchk3/f011ch.F b/src/packlib/kernlib/kernnum/test/numchk3/f011ch.F
deleted file mode 100644
index f4fe290..0000000
--- a/src/packlib/kernlib/kernnum/test/numchk3/f011ch.F
+++ /dev/null
@@ -1,516 +0,0 @@
-*
-* $Id: f011ch.F,v 1.2 1996/03/21 17:16:10 mclareni Exp $
-*
-* $Log: f011ch.F,v $
-* Revision 1.2 1996/03/21 17:16:10 mclareni
-* Kernnumt corrections for unaligned access on OSF1 by John Marafino, Fermilab
-*
-* Revision 1.1.1.1 1996/02/15 17:48:45 mclareni
-* Kernlib
-*
-*
-#include "kernnumt/pilot.h"
- SUBROUTINE F011CH(NREP,LWORK,W,OK)
- REAL W(LWORK)
- LOGICAL OK, OKT
-#include "kernnumt/sysdat.inc"
- OK = .TRUE.
- DO 100 JREP = 1, NREP
- CALL TF011(LWORK,W,OKT)
- OK = OK .AND. OKT
- 100 CONTINUE
- RETURN
- END
- SUBROUTINE TF011(LWORK,W,OK)
- DIMENSION W(LWORK), HT(3)
-#include "kernnumt/sysdat.inc"
-#include "ch3dat.inc"
- LOGICAL OK, ROK, DOK, COK
- REAL RZERO(1), RONE(1), RALPHA(1),RBETA(1)
- REAL RA1(1), RR1(1), RB1(1), RD1(1)
- DOUBLE PRECISION DZERO(1), DONE(1), DALPHA(1),DBETA(1)
- DOUBLE PRECISION DA1(1), DR1(1), DB1(1), DD1(1)
- COMPLEX CZERO(1), CONE(1), CALPHA(1),CBETA(1)
- COMPLEX CA1(1), CR1(1), CB1(1), CD1(1)
- EXTERNAL RFACT, RFEQN, RFINV
- EXTERNAL RMCPY, RMMNA, RMRAN
- EXTERNAL RVCPY, RVDIST
- EXTERNAL RVMAXA, RVSET, RVSUMA, RVXCH
- EXTERNAL RABSR, RSCALE, RSETCR, RSETEX
- EXTERNAL DFACT, DFEQN, DFINV
- EXTERNAL DMCPY, DMMNA, DMRAN
- EXTERNAL DVCPY, DVDIST
- EXTERNAL DVMAXA, DVSET, DVSUMA, DVXCH
- EXTERNAL RABSD, DSCALE, DSETCR, DSETEX
- EXTERNAL CFACT, CFEQN, CFINV
- EXTERNAL CMCPY, CMMNA, CMRAN
- EXTERNAL CVCPY, CVDIST
- EXTERNAL CVMAXA, CVSET, CVSUMA, CVXCH
- EXTERNAL RABSC, CSCALE, CSETCR, CSETEX
- CHARACTER*4 HT
- DATA HT / 'R ', 'D ', 'C ' /
- DATA RZERO, DZERO, CZERO / 0., 0.D0, (0.,0.) /
- DATA RONE, DONE, CONE / 1., 1.D0, (1.,0.) /
- DATA RALPHA, DALPHA, CALPHA / -1., -1.D0, (-1.,-1.) /
- DATA RBETA, DBETA, CBETA / +1., +1.D0, (+1.,+1.) /
- DATA RA1, DA1, CA1 / 3.333E20, 3.333D20, (3.333E20,3.33)/
- DATA RR1, DR1, CR1 / 4.444E20, 4.444D20, (4.444E20,4.44)/
- DATA RB1, DB1, CB1 / 5.555E20, 5.555D20, (5.555E20,5.55)/
- DATA RD1, DD1, CD1 / 6.666E20, 6.666D20, (6.666E20,6.66)/
- WRITE(IOUNIT,1001)
- HTYPE = HT(1)
- LENGTH = 1
- TRELPR = RELPRT(1)
- LTAB = LTABT(1)
- MINHEX = MINHXT(1)
- MAXHEX = MAXHXT(1)
- CALL XF011(LWORK,W,RZERO,RONE,RALPHA,RBETA,RA1,RR1,RB1,RD1,
- + ROK,RFACT,RFEQN,RFINV,RMCPY,RMMNA,RMRAN,RSCALE,RSETCR,
- + RSETEX,RABSR,RVCPY,RVDIST,RVMAXA,RVSET,RVSUMA,RVXCH)
- WRITE(IOUNIT,1002)
- HTYPE = HT(2)
- LENGTH = 2
- TRELPR = RELPRT(2)
- LTAB = LTABT(2)
- MINHEX = MINHXT(2)
- MAXHEX = MAXHXT(2)
- CALL XF011(LWORK,W,DZERO,DONE,DALPHA,DBETA,DA1,DR1,DB1,DD1,
- + DOK,DFACT,DFEQN,DFINV,DMCPY,DMMNA,DMRAN,DSCALE,DSETCR,
- + DSETEX,RABSD,DVCPY,DVDIST,DVMAXA,DVSET,DVSUMA,DVXCH)
- WRITE(IOUNIT,1003)
- HTYPE = HT(3)
- LENGTH = 2
- TRELPR = RELPRT(1)
- LTAB = LTABT(3)
- MINHEX = MINHXT(3)
- MAXHEX = MAXHXT(3)
- CALL XF011(LWORK,W,CZERO,CONE,CALPHA,CBETA,CA1,CR1,CB1,CD1,
- + COK,CFACT,CFEQN,CFINV,CMCPY,CMMNA,CMRAN,CSCALE,CSETCR,
- + CSETEX,RABSC,CVCPY,CVDIST,CVMAXA,CVSET,CVSUMA,CVXCH)
- OK = ROK .AND. DOK .AND. COK
- 90 IF(.NOT. OK) WRITE(IOUNIT,1004)
- IF( OK) WRITE(IOUNIT,1005)
- RETURN
-1001 FORMAT(17H1F011. TYPE = R. )
-1002 FORMAT(17H1F011. TYPE = D. )
-1003 FORMAT(17H1F011. TYPE = C. )
-1004 FORMAT(/ 5X, 37H ????? TEST OF F011 HAS FAILED. ????? )
-1005 FORMAT(/ 9X, 44HACCEPTANCE TEST OF F011 HAS BEEN SUCCESSFUL ,
- + 38HIF ERROR MESSAGE TESTS ARE SUCCESSFUL. )
- END
- SUBROUTINE XF011(LWORK,W,ZERO,ONE,ALPHA,BETA,A1,R1,B1,D1,
- + OK,FACT,FEQN,FINV,MCPY,MMNA,MRAN,SCALE,SETCR,
- + SETEX,RABS,VCPY,VDIST,VMAXA,VSET,VSUMA,VXCH)
- REAL W(LWORK), ZERO(2), ONE(2), ALPHA(2),BETA(2)
- REAL A1(2), R1(2), B1(2), D1(2)
- LOGICAL OK, OKN, OKT
-#include "kernnumt/sysdat.inc"
-#include "ch3dat.inc"
- NDX1F(J) = (J -1)*LENGTH + 1
- NDX2F(I,J) = ((J-1)*IDIM + I-1)*LENGTH + 1
- OK = .TRUE.
- LF = LWORK / 6
- LA = 1
- LB = LA + LF
- LC = LB + LF
- LX = LC + LF
- LR = LX + LF
- LT = LR + LF
-#if defined(CERNLIB_NUMDE)
- DO 100 JTEST = 1, 4
-#endif
-#if !defined(CERNLIB_NUMDE)
- DO 100 JTEST = 1, 5
-#endif
- OKT = .TRUE.
- KNTSKP = LTAB
- GOTO(12,13,14,15,16), JTEST
- 12 WRITE(IOUNIT,1002)
- GOTO 20
- 13 WRITE(IOUNIT,1003)
- GOTO 20
- 14 WRITE(IOUNIT,1004)
- GOTO 20
- 15 WRITE(IOUNIT,1005) TRELPR
- GOTO 20
- 16 WRITE(IOUNIT,1006)
- IDIM = 2
- OKT = .FALSE.
- IF(LF .GE. 8) CALL TMSG(W(LA),W(LR),W(LB),A1,R1,B1,D1,
- + OKT,FACT,FEQN,FINV,VCPY,VDIST)
- IF(LF .LT. 8) WRITE(*,1015) LF
- GOTO 40
- 20 DO 30 JTAB = 1, LTAB
- N = NTAB(JTAB)
- IDIM = N
- IF(N .GE. 3 .AND. N .LE. 7) IDIM = N + 3
- IF(LF .LT. LENGTH*IDIM**2) GOTO 30
- KNTSKP = KNTSKP - 1
- L2 = NDX1F(2)
- L12 = NDX2F(1,2)
- L21 = NDX2F(2,1)
- GOTO(22, 23, 24, 25), JTEST
- 22 CALL TPIVOT(N,W(LA),W(LC),W(LR),W(LT),ALPHA,BETA,OKN,
- + FACT,MCPY,MRAN,VCPY,VDIST,VMAXA,VXCH)
- GOTO 29
- 23 CALL TSING(N,W(LA),W(LR),OKN,FACT,SETEX,RABS,VXCH)
- GOTO 29
- 24 CALL TDET(N,W(LA),W(LC),W(LR),ALPHA,BETA,OKN,
- + FACT,MCPY,MRAN,SCALE,RABS)
- GOTO 29
- 25 CALL TRESID(N,W(LA),W(LB),W(LC),W(LX),W(LR),W(LT),
- + ZERO,ONE,ALPHA,BETA,OKN,FACT,FEQN,FINV,
- + MCPY,MMNA,MRAN,RABS,SETCR,VCPY,VDIST,VMAXA,VSET,VSUMA)
- 29 OKT = OKT .AND. OKN
- 30 CONTINUE
- IF(KNTSKP .NE. 0) WRITE(*,1014) KNTSKP
- IF( OKT) WRITE(IOUNIT,1011)
- 40 IF(.NOT. OKT) WRITE(IOUNIT,1010)
- OK = OK .AND. OKT
- 100 CONTINUE
- IF(.NOT. OK) WRITE(IOUNIT,1012) HTYPE
- IF( OK) WRITE(IOUNIT,1013) HTYPE
- RETURN
-1002 FORMAT(/// 15H PIVOTING TEST. )
-1003 FORMAT(/// 18H SINGULARITY TEST. )
-1004 FORMAT(/// 24H DETERMINANT RANGE TEST. )
-1005 FORMAT(/// 15H RESIDUAL TEST.,
- + // 8H RELPR =, 1PE8.1,1H,, 5X,
- + // 52H TABLE OF NORMALIZED RESIDUALS (AND OF RESID/RELPR).,
- + // 20X, 9HEQUATIONS,26X, 9HINVERSION,25X, 11HDETERMINANT,
- + / 4X, 1HN,3(9X,4HMEAN,15X,3HMAX,4X)/)
-1006 FORMAT(/// 20H ERROR MESSAGE TEST. )
-1010 FORMAT(/ 5X, 37H ????? FEATURE TEST HAS FAILED. ????? )
-1011 FORMAT(/ 5X, 25H FEATURE TEST SUCCESSFUL. )
-1012 FORMAT(/ 5X, 21H ????? TEST FOR TYPE ,A1,
- + 18H HAS FAILED. ????? )
-1013 FORMAT(/ 5X, 15H TEST FOR TYPE ,A1,15H SUCCESSFUL IF ,
- + 28HMESSAGE TEST WAS SUCCESSFUL. )
-1014 FORMAT( 20X, 11HWARNING ..., I3,
- + 52H CONFIGURATIONS HAVE BEEN SKIPPED FOR WANT OF SPACE.)
-1015 FORMAT(/ 11H ***** LF =, I10,
- + 38H INSUFFICIENT TO PERFORM MESSAGE TEST.)
- END
- SUBROUTINE TPIVOT(N,A,C,R,T,ALPHA,BETA,OK,
- + FACT,MCPY,MRAN,VCPY,VDIST,VMAXA,VXCH)
- REAL A(*), C(*), R(*), T(*), ALPHA(2), BETA(2)
- LOGICAL OK
- INTEGER MIX(50)
-#include "kernnumt/sysdat.inc"
-#include "ch3dat.inc"
- REAL DET(2), E
-*JMM
- DOUBLE PRECISION DDET
- EQUIVALENCE (DET(1),DDET)
- IRANF(I,K) = INT( RANF()*FLOAT(K-I+1) ) + I
- NDX2F(I,J) = ((J-1)*IDIM + I-1)*LENGTH + 1
- IF(N .GT. 50) THEN
- OK = .FALSE.
- WRITE(IOUNIT,1000) N
- RETURN
- ENDIF
- OK = .TRUE.
- IF(N .LE. 1) RETURN
- 10 CALL MRAN(N,N,ALPHA,BETA,A,A(L12),A(L21))
- L = 0
- DO 11 I = 1, N
- LI1 = NDX2F(I,1)
- LI2 = NDX2F(I,2)
- CALL VMAXA(N,A(LI1),A(LI2),J,E)
- IF(J .EQ. 1) L = L + 1
- 11 CONTINUE
- IF(L .GT. 1) GOTO 10
- CALL MCPY(N,N,A,A(L12),A(L21),C,C(L12),C(L21))
- CALL FACT(N,C,IDIM,R,IFAIL,DET,JFAIL)
- CALL VCPY(N,C,C(L21),T,T(L2))
- CALL MCPY(N,N,A,A(L12),A(L21),C,C(L12),C(L21))
- DO 20 J = 1, N
- MIX(J) = J
- 20 CONTINUE
- DO 21 L = 1, N-1
- K = IRANF(L,N)
- I = MIX(K)
- IF(K .EQ. L) GOTO 21
- MIX(K) = MIX(L)
- MIX(L) = I
- LK1 = NDX2F(K,1)
- LK2 = NDX2F(K,2)
- LL1 = NDX2F(L,1)
- LL2 = NDX2F(L,2)
- CALL VXCH(N,C(LK1),C(LK2),C(LL1),C(LL2))
- 21 CONTINUE
- CALL FACT(N,C,IDIM,R,IFAIL,DET,JFAIL)
- E = VDIST(N,C,C(L21),T,T(L2))
- IF(E .EQ. 0) GOTO 30
- OK = .FALSE.
- WRITE(IOUNIT,1001) N, IDIM, E
- 30 RETURN
-1000 FORMAT(/ ' ??? ERROR DETECTED BY TPIVOT. N =',I5,
- + ' EXCEEDS INTERNAL LIMIT OF 50')
-1001 FORMAT(/ 35H ??? ERROR DETECTED BY TPIVOT. N =,I5,
- + 3X,7H IDIM =,I5, 3X, 4H E =,1PE12.3)
- END
- SUBROUTINE TSING(N,A,R,OK,FACT,SETEX,RABS,VXCH)
- REAL A(*), R(*), DET(2)
- LOGICAL OK, OKDET
-#include "kernnumt/sysdat.inc"
-#include "ch3dat.inc"
- IRANF(I,K) = INT( RANF()*FLOAT(K-I+1) ) + I
- NDX2F(I,J) = ((J-1)*IDIM + I-1)*LENGTH + 1
- OK = .TRUE.
- IF(N .LE. 0) RETURN
- IF(N .EQ. 1) KINDS = 1
- IF(N .NE. 1) KINDS = 2
- DO 90 KIND = 1, KINDS
- KFAIL = KIND - 2
- 20 DO 80 MODE = 1, 2
- DO 70 JREP = 1, NCNFG
- IF(N .EQ. 1) GOTO 30
- IF(JREP .NE. 1) GOTO 21
- K1 = 1
- K2 = N
- GOTO 30
- 21 K1 = IRANF(1,N-1)
- K2 = IRANF(K1+1,N)
- 30 CALL SETEX(N,A,IDIM,TRELPR,KFAIL,MODE,K1,K2)
- 50 IF(N .EQ. 2) GOTO 60
- DO 51 I = 2, N
- K = IRANF(1,N)
- L = IRANF(1,N)
- IF(K .EQ. L) GOTO 51
- LK1 = NDX2F(K,1)
- LK2 = NDX2F(K,2)
- LL1 = NDX2F(L,1)
- LL2 = NDX2F(L,2)
- CALL VXCH(N,A(LK1),A(LK2),A(LL1),A(LL2))
- 51 CONTINUE
- 60 IFAIL = -99
- JFAIL = -99
- CALL FACT(N,A,IDIM,R,IFAIL,DET,JFAIL)
- E = RABS(DET)
- OKDET = (KFAIL .NE. -1) .OR.
- + (E .EQ. 0. .AND. JFAIL .EQ. 0)
- IF(OKDET .AND. (IFAIL .EQ. KFAIL)) GOTO 70
- OK = .FALSE.
- WRITE(IOUNIT,1001) N, IDIM, KIND, MODE, K1, K2,
- + KFAIL, IFAIL, JFAIL, E
- 70 CONTINUE
- 80 CONTINUE
- 90 CONTINUE
- RETURN
-1001 FORMAT(/ 32H ??? ERROR DETECTED BY TSING ...,9I5,1P,E12.3)
- END
- SUBROUTINE TDET(N,A,C,R,ALPHA,BETA,OK,
- + FACT,MCPY,MRAN,SCALE,RABS)
- REAL A(*), C(*), R(*), DET(2)
-*JMM
- DOUBLE PRECISION DDET
- EQUIVALENCE (DET(1),DDET)
- REAL ALPHA(2), BETA(2)
- LOGICAL OK, OKR
-#include "kernnumt/sysdat.inc"
-#include "ch3dat.inc"
- OK = .TRUE.
- IF(N .LE. 0) RETURN
- DO 30 JREP = 1, NCNFG
- CALL MRAN(N,N,ALPHA,BETA,A,A(L12),A(L21))
- CALL MCPY(N,N,A,A(L12),A(L21),C,C(L12),C(L21))
- CALL FACT(N,A,IDIM,R,IFAIL,DET,JFAIL)
- KFAIL = 0
- ABSDET = RABS(DET)
- OKR = JFAIL .EQ. KFAIL
- OK = OK .AND. OKR
- IF(.NOT. OKR) WRITE(IOUNIT,1000) N,IDIM,JFAIL,KFAIL,ABSDET
- IF(N .LE. 2) GOTO 30
- DO 20 MODE = 1, 2
- KFAIL = 2*MODE - 3
- IF(MODE .EQ. 1) MHEX = INT(1.1*FLOAT(MINHEX))
- IF(MODE. EQ. 2) MHEX = INT(1.1*FLOAT(MAXHEX))
- P1 = ALOG(16**(FLOAT(MHEX)/FLOAT(N)))
- P2 = ALOG(ABSDET) / FLOAT(N)
- HEX = (P1 - P2) / ALOG(16.)
- IF(MODE .EQ. 1) KHEX = INT(HEX) - 1
- IF(MODE .EQ. 2) KHEX = INT(HEX) + 1
- CALL MCPY(N,N,A,A(L12),A(L21),C,C(L12),C(L21))
- CALL SCALE(N,C,IDIM,KHEX)
- CALL FACT(N,C,IDIM,R,IFAIL,DET,JFAIL)
- RD = RABS(DET)
- OKR = (JFAIL .EQ. KFAIL) .AND.
- + ((MODE .EQ. 2) .OR. (RD .EQ. 0.))
- OK = OK .AND. OKR
- IF(.NOT. OKR) WRITE(IOUNIT,1000)N,IDIM,JFAIL,KFAIL,RD
- 20 CONTINUE
- 30 CONTINUE
- RETURN
-1000 FORMAT(/31H ??? ERROR DETECTED BY TDET ..., 4I10,1P,E12.3)
- END
- SUBROUTINE TRESID(N,A,B,C,X,R,T,ZERO,ONE,
- + ALPHA,BETA,OK,FACT,FEQN,FINV,MCPY,MMNA,MRAN,RABS,SETCR,
- + VCPY,VDIST,VMAXA,VSET,VSUMA)
- REAL A(*), B(*), C(*), X(*), R(*), T(*)
- REAL ZERO(2), ONE(2), ALPHA(2), BETA(2)
- LOGICAL OK
- EXTERNAL VMAXA
-#include "kernnumt/sysdat.inc"
-#include "ch3dat.inc"
- REAL DET(2), DETREF(2)
-*JMM
- DOUBLE PRECISION DDET, DDETREF
- EQUIVALENCE (DET(1), DDET)
- EQUIVALENCE (DETREF(1),DDETREF)
- DATA KLIM / 3 /
- IRESF(RES) = NINT(RES/TRELPR)
- OK = .TRUE.
- IF(N .LE. 0) RETURN
- RQ0 = 0.
- RQ1 = 0.
- RI0 = 0.
- RI1 = 0.
- RD0 = 0.
- RD1 = 0.
- DO 20 JREP = 1, NCNFG
- CALL MRAN(N,N,ALPHA,BETA,A,A(L12),A(L21))
- CALL MCPY(N,N,A,A(L12),A(L21),C,C(L12),C(L21))
- CALL KFLUSH
- CALL FACT(N,C,IDIM,R,IFAIL,DET,JFAIL)
- IF(IFAIL .NE. 0) WRITE(IOUNIT,1000) N, JREP, IDIM, IFAIL
- DO 10 K = 1, KLIM
- CALL MRAN(N,K,ALPHA,BETA,B,B(L12),B(L21))
- CALL MCPY(N,K,B,B(L12),B(L21),X,X(L12),X(L21))
- CALL KFLUSH
- CALL FEQN(N,C,IDIM,R,K,X)
- CALL RESIDU(N,K,A,B,X,T,R0,R1,ZERO,ONE,
- + MMNA,VCPY,VMAXA,VSET,VSUMA)
- RQ0 = AMAX1(RQ0,R0)
- RQ1 = RQ1 + R1
- 10 CONTINUE
- CALL KFLUSH
- CALL FINV(N,C,IDIM,R)
- CALL RESIDU(N,0,A,B,C,T,R0,R1,ZERO,ONE,
- + MMNA,VCPY,VMAXA,VSET,VSUMA)
- RI0 = AMAX1(RI0,R0)
- RI1 = RI1 + R1
- CALL SETCR(N,C,IDIM,DETREF)
- CALL KFLUSH
- CALL FACT(N,C,IDIM,R,IFAIL,DET,JFAIL)
- RELERR = VDIST(1,DET,DUMMY,DETREF,DUMMY) / RABS(DETREF)
- RD0 = AMAX1(RD0,RELERR)
- RD1 = RD1 + RELERR
- 20 CONTINUE
- RQ1 = RQ1 / FLOAT(KLIM*NCNFG)
- RI1 = RI1 / FLOAT(NCNFG)
- RD1 = RD1 / FLOAT(NCNFG)
- NQ0 = IRESF(RQ0)
- NQ1 = IRESF(RQ1)
- NI0 = IRESF(RI0)
- NI1 = IRESF(RI1)
- ND0 = IRESF(RD0)
- ND1 = IRESF(RD1)
- MX0 = 200*N
- MX1 = 40*N
- OK = (MAX0(NQ0,NI0,ND0) .LE. MX0) .AND.
- + (MAX0(NQ1,NI1,ND1) .LE. MX1)
- IF(.NOT. OK) WRITE(IOUNIT,1001) N, IDIM, NQ1, NI1, ND1, MX1,
- + NQ0, NI0, ND0, MX0
- WRITE(IOUNIT,1002) N, RQ1, NQ1, RQ0, NQ0, RI1, NI1, RI0, NI0,
- + RD1, ND1, RD0, ND0
- RETURN
-1000 FORMAT(/33H ??? ERROR DETECTED BY TRESID ..., 4I5)
-1001 FORMAT(/33H ??? ERROR DETECTED BY TRESID ...,/10(1X,I10))
-1002 FORMAT(I5,1P,3(E12.1,2H (,I4,1H),E9.1,2H (,I4,1H) ))
- END
- SUBROUTINE RESIDU (N,K,A,B,X,T,R0,R1,ZERO,ONE,
- + MMNA,VCPY,VMAXA,VSET,VSUMA)
- REAL A(*), B(*), X(*), T(*)
- REAL ZERO(2), ONE(2), R0, R1, SJ
-#include "kernnumt/sysdat.inc"
-#include "ch3dat.inc"
- NDX1F(J) = (J - 1)*LENGTH + 1
- NDX2F(I,J) = ((J - 1)*IDIM + I-1)*LENGTH + 1
-
- R0 = 0.
- R1 = 0.
- L = K
- IF(K .EQ. 0) L = N
- DO 20 J = 1, L
- LJ = NDX1F(J)
- L1J = NDX2F(1,J)
- L2J = NDX2F(2,J)
- IF(K .EQ. 0) GOTO 11
- CALL VCPY(N,B(L1J),B(L2J),T,T(L2))
- GO TO 12
- 11 CALL VSET(N,ZERO,T,T(L2))
- CALL VSET(1,ONE,T(LJ),T(LJ))
- 12 CALL MMNA(N,N,A,A(L12),A(L21),X(L1J),X(L2J),T,T(L2))
- CALL VMAXA(N,X(L1J),X(L2J),IDUMMY,SJ)
- CALL VMAXA(N,T,T(L2),IDUMMY,ABSRES)
- R0 = AMAX1(R0, ABSRES/SJ)
- SUMRES = VSUMA(N,T,T(L2))
- R1 = R1 + SUMRES / SJ
- 20 CONTINUE
- R1 = R1 / FLOAT(N*L)
- RETURN
- END
- SUBROUTINE TMSG(A,R,B,A1,R1,B1,D1,
- + OK,FACT,FEQN,FINV,VCPY,VDIST)
- REAL A(*),R(*),B(*),A1(2),R1(2),B1(2),D1(2)
- REAL D(2), E(4)
-*JMM
- DOUBLE PRECISION DD
- EQUIVALENCE (D(1),DD)
- LOGICAL OK, OKT
-#include "kernnumt/sysdat.inc"
-#include "ch3dat.inc"
- CHARACTER*4 HSUB(3), HCNT(3)
- INTEGER NERR(5), KERR(5)
- DATA HSUB / 'FACT', 'FEQN', 'FINV' /
- DATA HCNT / 'THRE', ' FIV', 'THRE' /
- DATA NERR / 0, -1, +2, +1, +1 /
- DATA KERR / +1, +1, +1, 0, -1 /
- IDIM = 1
- OK = .TRUE.
- DO 30 JSUB = 1, 3
- IF(ERPRNT .AND. ERSTOP) WRITE(*,1001) HCNT(JSUB),
- + HTYPE, HSUB(JSUB)
- IF(ERPRNT .AND. .NOT. ERSTOP) WRITE(*,1002) HCNT(JSUB),
- + HTYPE, HSUB(JSUB)
- IF(.NOT. ERPRNT .AND. ERSTOP) WRITE(*,1003) HCNT(JSUB)
- L = 3
- IF(JSUB .EQ. 2) L = 5
- DO 20 JERR = 1, L
- N = NERR(JERR)
- K = KERR(JERR)
- CALL VCPY(1,A1,DUMMY,A,DUMMY)
- CALL VCPY(1,R1,DUMMY,R,DUMMY)
- CALL VCPY(1,B1,DUMMY,B,DUMMY)
- CALL VCPY(1,D1,DUMMY,D,DUMMY)
- GOTO(11, 12, 13), JSUB
- 11 CALL FACT(N,A,IDIM,R,IFAIL,D,JFAIL)
- GOTO 19
- 12 CALL FEQN(N,A,IDIM,R,K,B)
- GOTO 19
- 13 CALL FINV(N,A,IDIM,R)
- 19 E(1) = VDIST(1,A,DUMMY,A1,DUMMY)
- E(2) = VDIST(1,R,DUMMY,R1,DUMMY)
- E(3) = VDIST(1,B,DUMMY,B1,DUMMY)
- E(4) = VDIST(1,D,DUMMY,D1,DUMMY)
- OKT = (E(1) .EQ. 0.) .AND. (E(2). EQ. 0.) .AND.
- + (E(3) .EQ. 0.) .AND. (E(4) .EQ. 0.)
- IF(.NOT. OKT) WRITE(*,1011) JSUB, JERR, E
- OK = OK .AND. OKT
- 20 CONTINUE
- 30 CONTINUE
- IF( ERPRNT .OR. ERSTOP ) WRITE(*,1012)
- RETURN
-1001 FORMAT( / 1X, A4, 32HE ERROR AND ABEND MESSAGES FROM , A1, A4,
- + 19H SHOULD NOW FOLLOW. )
-1002 FORMAT( / 1X, A4, 22HE ERROR MESSAGES FROM , A1, A4,
- + 19H SHOULD NOW FOLLOW. )
-1003 FORMAT( / 1X, A4, 35HE ABEND MESSAGES SHOULD NOW FOLLOW. )
-1011 FORMAT( / 31H ??? ERROR DETECTED BY TMSG ..., 2I6, 1P, 4E12.3)
-1012 FORMAT( // 47H RESULT ... ERROR MESSAGE TEST IS SUCCESSFUL IF,
- 1 //12X,52H(1) THERE ARE NO MESSAGES CONTAINING QUESTION MARKS.,
- 2 /12X, 49H(2) THE NUMBER OF MESSAGES IS AS SPECIFIED ABOVE.,
- 3 /12X, 46H(3) NO TWO ERROR MESSAGES ARE IDENTICAL IN ALL,
- 4 32H CHARACTERS, INCLUDING NUMERALS. )
- END
diff --git a/src/packlib/kernlib/kernnum/test/numchk3/f012ch.F b/src/packlib/kernlib/kernnum/test/numchk3/f012ch.F
deleted file mode 100644
index dc6b3c8..0000000
--- a/src/packlib/kernlib/kernnum/test/numchk3/f012ch.F
+++ /dev/null
@@ -1,450 +0,0 @@
-*
-* $Id: f012ch.F,v 1.2 1996/03/21 17:16:10 mclareni Exp $
-*
-* $Log: f012ch.F,v $
-* Revision 1.2 1996/03/21 17:16:10 mclareni
-* Kernnumt corrections for unaligned access on OSF1 by John Marafino, Fermilab
-*
-* Revision 1.1.1.1 1996/02/15 17:48:45 mclareni
-* Kernlib
-*
-*
-#include "kernnumt/pilot.h"
- SUBROUTINE F012CH(NREP,LWORK,W,OK)
- REAL W(LWORK)
- LOGICAL OK, OKT
-#include "kernnumt/sysdat.inc"
- OK = .TRUE.
- DO 100 JREP = 1, NREP
- CALL TF012(LWORK,W,OKT)
- OK = OK .AND. OKT
- 100 CONTINUE
- RETURN
- END
- SUBROUTINE TF012(LWORK,W,OK)
- DIMENSION W(LWORK), HT(3)
-#include "kernnumt/sysdat.inc"
-#include "ch3dat.inc"
-C LOGICAL OK, ROK, DOK, COK
- LOGICAL OK, ROK, DOK
- REAL RZERO(1), RONE(1), RALPHA(1),RBETA(1)
- REAL RA1(1), RR1(1), RB1(1), RD1(1)
- DOUBLE PRECISION DZERO(1), DONE(1), DALPHA(1),DBETA(1)
- DOUBLE PRECISION DA1(1), DR1(1), DB1(1), DD1(1)
- EXTERNAL RSFACT, RSFEQN, RSFINV, RSEQN, RSINV
- EXTERNAL RFACT, RMMLT, RMCPY, RMMNA, RMRAN
- EXTERNAL RVCPY, RVDIST, RABSR, RSCALE, RSSETX
- EXTERNAL RVMAXA, RVSET, RVSUMA, RVXCH
- EXTERNAL DSFACT, DSFEQN, DSFINV, DSEQN, DSINV
- EXTERNAL DFACT, DMMLT, DMCPY, DMMNA, DMRAN
- EXTERNAL DVCPY, DVDIST, RABSD, DSCALE, DSSETX
- EXTERNAL DVMAXA, DVSET, DVSUMA, DVXCH
- CHARACTER*4 HT
- DATA HT / 'R ', 'D ', 'C ' /
- DATA RZERO, DZERO / 0., 0.D0 /
- DATA RONE, DONE / 1., 1.D0 /
- DATA RALPHA, DALPHA / -1., -1.D0 /
- DATA RBETA, DBETA / +1., +1.D0 /
- DATA RA1, DA1 / 3.333E20, 3.333D20 /
- DATA RR1, DR1 / 4.444E20, 4.444D20 /
- DATA RB1, DB1 / 5.555E20, 5.555D20 /
- DATA RD1, DD1 / 6.666E20, 6.666D20 /
- WRITE(IOUNIT,1001)
- HTYPE = HT(1)
- LENGTH = 1
- TRELPR = RELPRT(1)
- MINHEX = MINHXT(1)
- MAXHEX = MAXHXT(1)
- LTAB = LTABT(1)
- CALL XF012(LWORK,W,RZERO,RONE,RALPHA,RBETA,RA1,RR1,RB1,RD1,
- + ROK,RSFACT,RSFEQN,RSFINV,RSEQN,RSINV,RFACT,RMMLT,RMCPY,RMMNA,
- + RMRAN,RSCALE,RSSETX,RABSR,RVCPY,RVDIST,RVMAXA,RVSET,
- + RVSUMA,RVXCH)
- WRITE(IOUNIT,1002)
- HTYPE = HT(2)
- LENGTH = 2
- TRELPR = RELPRT(2)
- MINHEX = MINHXT(2)
- MAXHEX = MAXHXT(2)
- LTAB = LTABT(2)
- CALL XF012(LWORK,W,DZERO,DONE,DALPHA,DBETA,DA1,DR1,DB1,DD1,
- + DOK,DSFACT,DSFEQN,DSFINV,DSEQN,DSINV,DFACT,DMMLT,DMCPY,DMMNA,
- + DMRAN,DSCALE,DSSETX,RABSD,DVCPY,DVDIST,DVMAXA,DVSET,
- + DVSUMA,DVXCH)
- OK = ROK .AND. DOK
- IF(.NOT. OK) WRITE(IOUNIT,1004)
- IF( OK) WRITE(IOUNIT,1005)
- RETURN
-1001 FORMAT(17H1F012. TYPE = R. )
-1002 FORMAT(17H1F012. TYPE = D. )
-1003 FORMAT(17H1F012. TYPE = C. )
-1004 FORMAT(/ 5X, 37H ????? TEST OF F012 HAS FAILED. ????? )
-1005 FORMAT(/ 9X, 44HACCEPTANCE TEST OF F012 HAS BEEN SUCCESSFUL ,
- + 38HIF ERROR MESSAGE TESTS ARE SUCCESSFUL. )
- END
- SUBROUTINE XF012(LWORK,W,ZERO,ONE,ALPHA,BETA,A1,R1,B1,D1,
- + OK,SFACT,SFEQN,SFINV,SEQN,SINV,FACT,MMLT,MCPY,MMNA,
- + MRAN,SCALE,SSETX,RABS,VCPY,VDIST,VMAXA,VSET,
- + VSUMA,VXCH)
- REAL W(LWORK), ZERO(2), ONE(2), ALPHA(2),BETA(2)
- REAL A1(2), R1(2), B1(2), D1(2)
- LOGICAL OK, OKN, OKT
-#include "kernnumt/sysdat.inc"
-#include "ch3dat.inc"
- NDX1F(J) = (J -1)*LENGTH + 1
- NDX2F(I,J) = ((J-1)*IDIM + I-1)*LENGTH + 1
- OK = .TRUE.
- LF = LWORK / 6
- LA = 1
- LB = LA + LF
- LC = LB + LF
- LX = LC + LF
- LR = LX + LF
- LT = LR + LF
-#if defined(CERNLIB_NUMDE)
- DO 100 JTEST = 1, 3
-#endif
-#if !defined(CERNLIB_NUMDE)
- DO 100 JTEST = 1, 4
-#endif
- OKT = .TRUE.
- KNTSKP = LTAB
- GOTO(13,14,15,16), JTEST
- 13 WRITE(IOUNIT,1003)
- GOTO 20
- 14 WRITE(IOUNIT,1004)
- GOTO 20
- 15 WRITE(IOUNIT,1005) TRELPR
- GOTO 20
- 16 WRITE(IOUNIT,1006)
- IDIM = 2
- OKT = .FALSE.
- IF(LF .GE. 8) CALL TSMSG(W(LA),W(LR),W(LB),A1,R1,B1,D1,OKT,
- + SFACT,SFEQN,SFINV,SEQN,SINV,VCPY,VDIST)
- IF(LF .LT. 8) WRITE(*,1015) LF
- GOTO 40
- 20 DO 30 JTAB = 1, LTAB
- N = NTAB(JTAB)
- IDIM = N
- IF(N .GE. 3 .AND. N .LE. 7) IDIM = N + 3
- IF(LF .LT. LENGTH*IDIM**2) GOTO 30
- KNTSKP = KNTSKP - 1
- L2 = NDX1F(2)
- L12 = NDX2F(1,2)
- L21 = NDX2F(2,1)
- GOTO(23, 24, 25), JTEST
- 23 CALL TSSING(N,W(LA),OKN,SFACT,SSETX,RABS,VXCH)
- GOTO 29
- 24 CALL TSDET(N,W(LA),W(LC),W(LR),ALPHA,BETA,OKN,
- + FACT,MCPY,MRAN,SCALE,VMAXA)
- GOTO 29
- 25 CALL TSRESD(N,W(LA),W(LB),W(LC),W(LX),W(LR),W(LT),
- + ZERO,ONE,ALPHA,BETA,OKN,SFACT,SFEQN,SFINV,SEQN,SINV,
- + FACT,MMLT,MCPY,MMNA,MRAN,VCPY,VDIST,VMAXA,VSET,VSUMA)
- 29 OKT = OKT .AND. OKN
- 30 CONTINUE
- IF(KNTSKP .NE. 0) WRITE(*,1014) KNTSKP
- IF( OKT) WRITE(IOUNIT,1011)
- 40 IF(.NOT. OKT) WRITE(IOUNIT,1010)
- OK = OK .AND. OKT
- 100 CONTINUE
- RETURN
-1003 FORMAT(/// 18H SINGULARITY TEST. )
-1004 FORMAT(/// 24H DETERMINANT RANGE TEST. )
-1005 FORMAT(/// 15H RESIDUAL TEST.,
- + // 8H RELPR =,1PE8.1,1H,, 5X,
- + // 52H TABLE OF NORMALIZED RESIDUALS (AND OF RESID/RELPR).,
- + // 20X, 9HEQUATIONS,26X, 9HINVERSION,25X, 11HDETERMINANT,
- + / 4X, 1HN, 3(9X,4HMEAN,15X,3HMAX,4X)/)
-1006 FORMAT(/// 20H ERROR MESSAGE TEST. )
-1010 FORMAT(/ 5X, 37H ????? FEATURE TEST HAS FAILED. ????? )
-1011 FORMAT(/ 5X, 25H FEATURE TEST SUCCESSFUL. )
-1014 FORMAT( 20X, 11HWARNING ..., I3,
- + 52H CONFIGURATIONS HAVE BEEN SKIPPED FOR WANT OF SPACE.)
-1015 FORMAT( / 11H ***** LF =, I10,
- + 38H INSUFFICIENT TO PERFORM MESSAGE TEST.)
- END
- SUBROUTINE TSSING(N,A,OK,SFACT,SSETX,RABS,VXCH)
- REAL A(*), DET(2)
-*JMM
- DOUBLE PRECISION DDET
- EQUIVALENCE (DET(1),DDET)
- LOGICAL OK, OKT
-#include "kernnumt/sysdat.inc"
-#include "ch3dat.inc"
- IRANF(I,K) = INT( RANF()*FLOAT(K-I+1) ) + I
- NDX2F(I,J) = ((J-1)*IDIM + I-1)*LENGTH + 1
- OK = .TRUE.
- IF(N .LE. 0) RETURN
- K1 = -1
- K2 = -1
- DO 80 MODE = 1, 2
- DO 70 JREP = 1, NCNFG
- IF(N .NE. 1) THEN
- IF(JREP .EQ. 1) THEN
- K1 = 1
- K2 = N
- ELSE
- K1 = IRANF(1,N-1)
- K2 = IRANF(K1+1,N)
- ENDIF
- ENDIF
- CALL SSETX(N,A,IDIM,MODE,K1,K2)
- IFAIL = -99
- JFAIL = -99
- CALL SFACT(N,A,IDIM,IFAIL,DET,JFAIL)
- E = RABS(DET)
- OKT = JFAIL .EQ. -2 .AND. IFAIL .EQ. -1
- IF(.NOT. OKT) WRITE(IOUNIT,1001) N, IDIM, MODE, K1, K2,
- + IFAIL, JFAIL, E
- OK = OK .AND. OKT
- 70 CONTINUE
- 80 CONTINUE
- RETURN
-1001 FORMAT(/ 33H ??? ERROR DETECTED BY TSSING ...,7I5,1P,E12.3)
- END
- SUBROUTINE TSDET(N,A,C,R,ALPHA,BETA,OK,
- + FACT,MCPY,MRAN,SCALE,VMAXA)
- REAL A(*), C(*), R(*), DET(2)
-*JMM
- DOUBLE PRECISION DDET
- EQUIVALENCE (DET(1),DDET)
- LOGICAL OK, OKR
-#include "kernnumt/sysdat.inc"
-#include "ch3dat.inc"
- OK = .TRUE.
- IF(N .LE. 0) RETURN
- DO 30 JREP = 1, NCNFG
- CALL MRAN(N,N,ALPHA,BETA,A,A(L12),A(L21))
- CALL MCPY(N,N,A,A(L12),A(L21),C,C(L12),C(L21))
- CALL FACT(N,A,IDIM,R,IFAIL,DET,JFAIL)
- KFAIL = 0
- CALL VMAXA(1,DET,DUMMY,IDUMMY,RD)
- OKR = JFAIL .EQ. KFAIL
- OK = OK .AND. OKR
- IF(.NOT. OKR) WRITE(IOUNIT,1000) N, IDIM, JFAIL, KFAIL, RD
- IF(N .LE. 2) GOTO 30
- CALL VMAXA(1,DET,DUMMY,IDUMMY,RABSD)
- DO 20 MODE = 1, 2
- KFAIL = 2*MODE - 3
- IF(MODE .EQ. 1) MHEX = INT(1.1*FLOAT(MINHEX))
- IF(MODE. EQ. 2) MHEX = INT(1.1*FLOAT(MAXHEX))
- P1 = ALOG(16**(FLOAT(MHEX)/FLOAT(N)))
- P2 = ALOG(RABSD) / FLOAT(N)
- HEX = (P1 - P2) / ALOG(16.)
- IF(MODE .EQ. 1) KHEX = INT(HEX) - 1
- IF(MODE .EQ. 2) KHEX = INT(HEX) + 1
- CALL MCPY(N,N,A,A(L12),A(L21),C,C(L12),C(L21))
- CALL SCALE(N,C,IDIM,KHEX)
- CALL FACT(N,C,IDIM,R,IFAIL,DET,JFAIL)
- CALL VMAXA(1,DET,DUMMY,IDUMMY,RD)
- OKR = (JFAIL .EQ. KFAIL) .AND.
- + ((MODE .EQ. 2) .OR. (RD .EQ. 0.))
- OK = OK .AND. OKR
- IF(.NOT. OKR) WRITE(IOUNIT,1000) N,IDIM,JFAIL,KFAIL,RD
- 20 CONTINUE
- 30 CONTINUE
- RETURN
-1000 FORMAT(/32H ??? ERROR DETECTED BY TSDET ...,4I10,1P,E12.3)
- END
- SUBROUTINE TSRESD(N,A,B,C,X,R,T,ZERO,ONE,ALPHA,BETA,OK,
- + SFACT,SFEQN,SFINV,SEQN,SINV,FACT,MMLT,MCPY,MMNA,MRAN,
- + VCPY,VDIST,VMAXA,VSET,VSUMA)
- REAL A(*), B(*), C(*), X(*), R(*), T(*)
- REAL ZERO(2), ONE(2), ALPHA(2), BETA(2)
- LOGICAL OK, OKF, OKM
- EXTERNAL VCPY, VMAXA
-#include "kernnumt/sysdat.inc"
-#include "ch3dat.inc"
- REAL DET(2), DETREF(2)
-*JMM
- DOUBLE PRECISION DDET, DDETREF
- EQUIVALENCE (DET(1) ,DDET)
- EQUIVALENCE (DETREF(1),DDETREF)
- DATA KLIM / 3 /
- IRESF(RES) = NINT(RES/TRELPR)
- OK = .TRUE.
- IF(N .LE. 0) RETURN
- RQ0 = 0.
- RQ1 = 0.
- RI0 = 0.
- RI1 = 0.
- RD0 = 0.
- RD1 = 0.
- DO 20 JREP = 1, NCNFG
- CALL MRAN(N,2*N,ALPHA,BETA,A,A(L12),A(L21))
- CALL MMLT(N,2*N,N,A,A(L12),A(L21),A,A(L21),A(L12),
- + A,A(L12),A(L21),C)
- I1 = 1
- DO 2 I = 1, N
- I2 = I1 + L12 - 1
- CALL VCPY(I,A(I1),A(I2),C(I1),C(I2))
- I1 = I1 + L21 - 1
- 2 CONTINUE
- CALL KFLUSH
- CALL SFACT(N,C,IDIM,IFAIL,DET,JFAIL)
- OKF = IFAIL .EQ. 0
- OK = OK .AND. OKF
- IF(.NOT. OKF) WRITE(IOUNIT,1000) N, IDIM, JREP, IFAIL
- DO 10 K = 1, KLIM
- CALL MRAN(N,K,ALPHA,BETA,B,B(L12),B(L21))
- CALL MCPY(N,K,B,B(L12),B(L21),X,X(L12),X(L21))
- CALL KFLUSH
- CALL SFEQN(N,C,IDIM,K,X)
- CALL RESIDU(N,K,A,B,X,T,R0,R1,ZERO,ONE,
- + MMNA,VCPY,VMAXA,VSET,VSUMA)
- RQ0 = AMAX1(RQ0,R0)
- RQ1 = RQ1 + R1
- I1 = 1
- DO 3 I = 1, N
- I2 = I1 + L12 - 1
- CALL VCPY(I,A(I1),A(I2),C(I1),C(I2))
- I1 = I1 + L21 - 1
- 3 CONTINUE
- CALL MCPY(N,K,B,B(L12),B(L21),X,X(L12),X(L21))
- CALL KFLUSH
- CALL SEQN(N,C,IDIM,IFAIL,K,X)
- OKF = IFAIL .EQ. 0
- OK = OK .AND. OKF
- IF(.NOT. OKF) WRITE(IOUNIT,1001) N,IDIM,JREP,K,IFAIL
- CALL RESIDU(N,K,A,B,X,T,R0,R1,ZERO,ONE,
- + MMNA,VCPY,VMAXA,VSET,VSUMA)
- RQ0 = AMAX1(RQ0,R0)
- RQ1 = RQ1 + R1
- 10 CONTINUE
- CALL KFLUSH
- CALL SFINV(N,C,IDIM)
- CALL RESIDU(N,0,A,B,C,T,R0,R1,ZERO,ONE,
- + MMNA,VCPY,VMAXA,VSET,VSUMA)
- RI0 = AMAX1(RI0,R0)
- RI1 = RI1 + R1
- I1 = 1
- DO 11 I = 1, N
- I2 = I1 + L12 - 1
- CALL VCPY(I,A(I1),A(I2),C(I1),C(I2))
- I1 = I1 + L21 - 1
- 11 CONTINUE
- CALL KFLUSH
- CALL SINV(N,C,IDIM,IFAIL)
- OKF = IFAIL .EQ. 0
- OK = OK .AND. OKF
- IF(.NOT. OKF) WRITE(IOUNIT,1002) N,IDIM,JREP,IFAIL
- CALL RESIDU(N,0,A,B,C,T,R0,R1,ZERO,ONE,
- + MMNA,VCPY,VMAXA,VSET,VSUMA)
- RI0 = AMAX1(RI0,R0)
- RI1 = RI1 + R1
- I1 = 1
- DO 12 I = 1, N
- I2 = I1 + L12 - 1
- CALL VCPY(I,A(I1),A(I2),C(I1),C(I2))
- I1 = I1 + L21 - 1
- 12 CONTINUE
- CALL FACT(N,A,IDIM,R,IFAIL1,DETREF,JFAIL1)
- CALL KFLUSH
- CALL SFACT(N,C,IDIM,IFAIL2,DET,JFAIL2)
- OKF = IFAIL1 .EQ. IFAIL2 .AND. JFAIL1 .EQ. JFAIL2
- OK = OK .AND. OKF
- IF(.NOT. OKF) WRITE(IOUNIT,1003)
- + N,IDIM,JREP,IFAIL1,IFAIL2,JFAIL1,JFAIL2
- IF(JFAIL1 .EQ. 0) THEN
- CALL VMAXA(1,DETREF,DUMMY,IDUMMY,ABSRES)
- RELERR = VDIST(1,DET,DUMMY,DETREF,DUMMY) / ABSRES
- RD0 = AMAX1(RD0,RELERR)
- RD1 = RD1 + RELERR
- ENDIF
- 20 CONTINUE
- RQ1 = RQ1 / (2.* FLOAT(KLIM*NCNFG))
- RI1 = RI1 / (2.* FLOAT(NCNFG))
- RD1 = RD1 / FLOAT(NCNFG)
- NQ0 = IRESF(RQ0)
- NQ1 = IRESF(RQ1)
- NI0 = IRESF(RI0)
- NI1 = IRESF(RI1)
- ND0 = IRESF(RD0)
- ND1 = IRESF(RD1)
- MX0 = 200*N
- MX1 = 40*N
- OKM = (MAX0(NQ0,NI0,ND0) .LE. MX0) .AND.
- + (MAX0(NQ1,NI1,ND1) .LE. MX1)
- OK = OK .AND. OKM
- IF(.NOT. OKM) WRITE(IOUNIT,1011) N, IDIM, NQ1, NI1, ND1, MX1,
- + NQ0, NI0, ND0, MX0
- WRITE(IOUNIT,1012) N, RQ1, NQ1, RQ0, NQ0, RI1, NI1, RI0, NI0,
- + RD1, ND1, RD0, ND0
- RETURN
-1000 FORMAT(/35H ??? ERROR 0 DETECTED BY TSRESD ...,4I5)
-1001 FORMAT(/35H ??? ERROR 1 DETECTED BY TSRESD ...,5I5)
-1002 FORMAT(/35H ??? ERROR 2 DETECTED BY TSRESD ...,4I5)
-1003 FORMAT(/35H ??? ERROR 3 DETECTED BY TSRESD ...,7I5)
-1011 FORMAT(/36H ??? ERROR 11 DETECTED BY TSRESD ...,10(1X,I8))
-1012 FORMAT(I5,1P,3(E12.1,2H (, I4,1H), E9.1,2H (, I4,1H) ))
- END
- SUBROUTINE TSMSG(A,R,B,A1,R1,B1,D1,OK,
- + SFACT,SFEQN,SFINV,SEQN,SINV,VCPY,VDIST)
- REAL A(*),R(*),B(*),A1(2),R1(2),B1(2),D1(2)
- REAL D(2), E(4)
-*JMM
- DOUBLE PRECISION DD
- EQUIVALENCE (D(1),DD)
- LOGICAL OK, OKT
-#include "kernnumt/sysdat.inc"
-#include "ch3dat.inc"
- DIMENSION HSUB(5), HCNT(5)
- DIMENSION NERR(5), KERR(5), LCNT(5)
- CHARACTER*4 HSUB, HCNT
- DATA HSUB / 'FACT', 'EQN ', 'FEQN', 'INV ', 'FINV' /
- DATA HCNT / 'THRE', ' FIV', ' FIV', 'THRE', 'THRE' /
- DATA LCNT / 3, 5, 5, 3, 3 /
- DATA NERR / 0, -1, +2, +1, +1 /
- DATA KERR / +1, +1, +1, 0, -1 /
- IDIM = 1
- OK = .TRUE.
- DO 30 JSUB = 1, 5
- IF(ERPRNT .AND. ERSTOP) WRITE(*,1001) HCNT(JSUB),
- + HTYPE, HSUB(JSUB)
- IF(ERPRNT .AND. .NOT. ERSTOP) WRITE(*,1002) HCNT(JSUB),
- + HTYPE, HSUB(JSUB)
- IF(.NOT. ERPRNT .AND. ERSTOP) WRITE(*,1003) HCNT(JSUB)
- L = LCNT(JSUB)
- DO 20 JERR = 1, L
- N = NERR(JERR)
- K = KERR(JERR)
- IF(JSUB .EQ. 2 .AND. K .EQ. 0) K = -2
- CALL VCPY(1,A1,DUMMY,A,DUMMY)
- CALL VCPY(1,R1,DUMMY,R,DUMMY)
- CALL VCPY(1,B1,DUMMY,B,DUMMY)
- CALL VCPY(1,D1,DUMMY,D,DUMMY)
- GOTO(11, 12, 13, 14, 15), JSUB
- 11 CALL SFACT(N,A,IDIM,IFAIL,D,JFAIL)
- GOTO 19
- 12 CALL SEQN(N,A,IDIM,IFAIL,K,B)
- GOTO 19
- 13 CALL SFEQN(N,A,IDIM,K,B)
- GOTO 19
- 14 CALL SINV(N,A,IDIM,IFAIL)
- GOTO 19
- 15 CALL SFINV(N,A,IDIM)
- 19 E(1) = VDIST(1,A,DUMMY,A1,DUMMY)
- E(2) = VDIST(1,R,DUMMY,R1,DUMMY)
- E(3) = VDIST(1,B,DUMMY,B1,DUMMY)
- E(4) = VDIST(1,D,DUMMY,D1,DUMMY)
- OKT = (E(1) .EQ. 0.) .AND. (E(2). EQ. 0.) .AND.
- + (E(3) .EQ. 0.) .AND. (E(4) .EQ. 0.)
- IF(.NOT. OKT) WRITE(*,1011) JSUB, JERR, E
- OK = OK .AND. OKT
- 20 CONTINUE
- 30 CONTINUE
- IF( ERPRNT .OR. ERSTOP ) WRITE(*,1012)
- RETURN
-1001 FORMAT( / 1X,A4,32HE ERROR AND ABEND MESSAGES FROM ,A1,1HS,A4,
- + 19H SHOULD NOW FOLLOW. )
-1002 FORMAT( / 1X, A4, 22HE ERROR MESSAGES FROM , A1, 1HS, A4,
- + 19H SHOULD NOW FOLLOW. )
-1003 FORMAT( / 1X, A4, 35HE ABEND MESSAGES SHOULD NOW FOLLOW. )
-1011 FORMAT( / 32H ??? ERROR DETECTED BY TSMSG ...,2I6, 1P, 4E12.3)
-1012 FORMAT( // 47H RESULT ... ERROR MESSAGE TEST IS SUCCESSFUL IF,
- + //12X,52H(1) THERE ARE NO MESSAGES CONTAINING QUESTION MARKS.,
- + /12X, 49H(2) THE NUMBER OF MESSAGES IS AS SPECIFIED ABOVE.,
- + /12X, 46H(3) NO TWO ERROR MESSAGES ARE IDENTICAL IN ALL,
- + 32H CHARACTERS, INCLUDING NUMERALS. )
- END
diff --git a/src/packlib/kernlib/kernnum/test/numchk3/g900ch.F b/src/packlib/kernlib/kernnum/test/numchk3/g900ch.F
deleted file mode 100644
index ec3670b..0000000
--- a/src/packlib/kernlib/kernnum/test/numchk3/g900ch.F
+++ /dev/null
@@ -1,68 +0,0 @@
-*
-* $Id: g900ch.F,v 1.1.1.1 1996/02/15 17:48:46 mclareni Exp $
-*
-* $Log: g900ch.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:46 mclareni
-* Kernlib
-*
-*
-#include "kernnumt/pilot.h"
- SUBROUTINE G900CH(NREP,OK)
- LOGICAL OK, OKT
-#include "kernnumt/sysdat.inc"
- DOUBLE PRECISION FIRST, SEED, DRANF, DR(20), Y
- DATA DR / 0.562 042 328 605 79D0,
- + 0.747 430 623 326 45D0,
- + 0.441 347 714 323 67D0,
- + 0.797 502 695 040 91D0,
- + 0.269 636 741 168 25D0,
- + 0.645 535 662 993 14D0,
- + 0.246 207 703 284 19D0,
- + 0.183 452 250 568 67D0,
- + 0.595 366 548 797 63D0,
- + 0.949 946 004 899 90D0,
- + 0.278 860 575 609 30D0,
- + 0.471 266 204 207 20D0,
- + 0.853 167 626 455 26D0,
- + 0.970 918 323 001 16D0,
- + 0.994 956 212 922 71D0,
- + 0.106 361 109 833 80D0,
- + 0.706 313 248 108 35D0,
- + 0.816 562 582 286 04D0,
- + 0.574 617 317 606 90D0,
- + 0.665 058 493 879 02D0 /
- OK = .TRUE.
- CALL RANGET(FIRST)
- CALL RANSET(SEEDIN)
- DO 300 IREP = 1, NREP
- CALL RANGET(SEED)
- DO 130 K = 1, 2
- DO 120 I = 1, 20
- DO 110 J = 1, 100
- Y = DRANF()
- 110 CONTINUE
- OKT = DABS(Y-DR(I)) .LE. 1.D-13
- IF(OKT) GOTO 120
- WRITE(*,1001) I, Y, DR(I)
- OK = .FALSE.
- 120 CONTINUE
- CALL RANSET(SEED)
- 130 CONTINUE
- DO 230 K = 1, 2
- DO 220 I = 1, 20
- DO 210 J = 1, 100
- Z = RANF()
- 210 CONTINUE
- OKT = ABS(Z-SNGL(DR(I))) .LE. 1.E-5
- IF(OKT) GOTO 220
- WRITE(*,1002) I, Z, DR(I)
- OK = .FALSE.
- 220 CONTINUE
- CALL RANSET(SEED)
- 230 CONTINUE
- 300 CONTINUE
- 90 CALL RANSET(FIRST)
- RETURN
-1001 FORMAT(24H ??? ERROR IN DRANF ??? , I5, 1P, 2D25.14)
-1002 FORMAT(24H ??? ERROR IN RANF ??? , I5, 1P, E25.8, D25.8)
- END
diff --git a/src/packlib/kernlib/kernnum/test/numchk3/g901ch.F b/src/packlib/kernlib/kernnum/test/numchk3/g901ch.F
deleted file mode 100644
index 879cba4..0000000
--- a/src/packlib/kernlib/kernnum/test/numchk3/g901ch.F
+++ /dev/null
@@ -1,58 +0,0 @@
-*
-* $Id: g901ch.F,v 1.1.1.1 1996/02/15 17:48:46 mclareni Exp $
-*
-* $Log: g901ch.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:46 mclareni
-* Kernlib
-*
-*
-#include "kernnumt/pilot.h"
- SUBROUTINE G901CH(NREP,IDIM,X,Y,Z,T,OK)
- PARAMETER(KASES = 30)
- REAL X(IDIM), Y(IDIM), Z(IDIM), T(IDIM)
- LOGICAL OK
-#include "kernnumt/sysdat.inc"
- IF(IDIM .LT. 3*KASES-2) THEN
- WRITE(*,1009) IDIM, KASES
- RETURN
- ENDIF
- OK = .TRUE.
- NTIMES = NREP
- 10 R = 10.**(-KASES/2)
- DO 29 I = 1, KASES
- R = 9.9*R
- CALL RAN2VS(R,U,V)
- S = SQRT(U*U+V*V)
- IF(NRDIST(R,S) .LE. 5) GOTO 21
- OK = .FALSE.
- WRITE(*,1000) NTIMES, I, R, S, U, V
- 21 CALL RAN3VS(R,U,V,W)
- S = SQRT(U*U+V*V+W*W)
- IF(NRDIST(R,S) .LE. 10) GOTO 24
- OK = .FALSE.
- WRITE(*,1000) NTIMES, I, R, S, U, V, W
- 24 N = 3*I - 2
- CALL VRAN2S(R,N,X,Y,T)
- DO 25 J = 1, N
- S = SQRT(X(J)**2 + Y(J)**2)
- IF(NRDIST(R,S) .LE. 5) GOTO 25
- OK = .FALSE.
- WRITE(*,1001) NTIMES,I,J,R,S,X(J),Y(J)
- GOTO 26
- 25 CONTINUE
- 26 CALL VRAN3S(R,N,X,Y,Z,T)
- DO 27 J = 1, N
- S = SQRT(X(J)**2 + Y(J)**2 + Z(J)**2)
- IF(NRDIST(R,S) .LE. 10) GOTO 27
- OK = .FALSE.
- WRITE(*,1001) NTIMES,I,J,R,S,X(J),Y(J),Z(J)
- GOTO 29
- 27 CONTINUE
- 29 CONTINUE
- NTIMES = NTIMES - 1
- IF(NTIMES .GT. 0) GOTO 10
- RETURN
-1000 FORMAT(2I10, 1P, 5E20.8)
-1001 FORMAT(3I8,1P,5E20.8)
-1009 FORMAT(' IDIM =',I6,' INSUFFICIENT FOR',I4,' CASES')
- END
diff --git a/src/packlib/kernlib/kernnum/test/numchk3/n001ch.F b/src/packlib/kernlib/kernnum/test/numchk3/n001ch.F
deleted file mode 100644
index 8716577..0000000
--- a/src/packlib/kernlib/kernnum/test/numchk3/n001ch.F
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: n001ch.F,v 1.1.1.1 1996/02/15 17:48:46 mclareni Exp $
-*
-* $Log: n001ch.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:46 mclareni
-* Kernlib
-*
-*
-#include "kernnumt/pilot.h"
- SUBROUTINE N001CH(OK)
- LOGICAL OK
- EXTERNAL C205R3, C205R4
- CHARACTER ERCODE*6
-#include "kernnumt/sysdat.inc"
- OK = .TRUE.
- ERCODE = 'C205'
- CALL KERSET(ERCODE, NULL, 1, 2)
- CALL KERSET('C205.2',IOUNIT,100,0)
- ISAVE = LGFILE
- LGFILE = IOUNIT
- WRITE(*,1000) IOUNIT
- WRITE(IOUNIT,1001)
- EPSI = RELPR * 1000.
- DO 10 MESS = 1, 3
- CALL RZERO(1.,2.,X,R,EPSI,30,C205R3)
- CALL RZERO(-1./ASIN(.1),+1./ASIN(.5),X,R,EPSI,5,C205R4)
- 10 CONTINUE
- LGFILE = ISAVE
- RETURN
-1000 FORMAT(5X,'THIS CHECK IS SUCCESSFUL IF FIVE MESSAGES ',
- + 'ARE WRITTEN TO UNIT',I2,' AS SPECIFIED THERE')
-1001 FORMAT(/ '1N001.' //
- + ' FIVE MESSAGES FROM PACKAGE C205, NAMELY ...' //
- + 10X, ' (I) A WARNING FROM C205.1 (2 LINES)' /
- + 10X, ' (II) A FATAL ERROR FROM C205.2 (3 LINES)' /
- + 10X, ' (III) A FATAL ERROR FROM C205.2 (3 LINES)' /
- + 10X, ' (IV) A FATAL ERROR FROM C205.1 (2 LINES)' /
- + 10X, ' (V) A FATAL ERROR FROM C205.2 (3 LINES)' /
- + ' SHOULD NOW FOLLOW. THE LAST LINE FOR EACH FATAL ERROR ',
- + 'MUST SAY ...' // ' ABEND ROUTINE HAS BEEN CALLED.' ///)
- END
diff --git a/src/packlib/kernlib/kernnum/test/numchk3/nrdist.F b/src/packlib/kernlib/kernnum/test/numchk3/nrdist.F
deleted file mode 100644
index df410fa..0000000
--- a/src/packlib/kernlib/kernnum/test/numchk3/nrdist.F
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: nrdist.F,v 1.1.1.1 1996/02/15 17:48:46 mclareni Exp $
-*
-* $Log: nrdist.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:46 mclareni
-* Kernlib
-*
-*
-#include "kernnumt/pilot.h"
- FUNCTION NRDIST(X,Y)
- REAL X, Y
-#include "kernnumt/sysdat.inc"
- RELERR = ABS(X-Y) / AMAX1(ABS(X),ABS(Y))
- NRDIST = NINT(RELERR/RELPR)
- RETURN
- END
diff --git a/src/packlib/kernlib/kernnum/test/numchk3/taadd.F b/src/packlib/kernlib/kernnum/test/numchk3/taadd.F
deleted file mode 100644
index 697b615..0000000
--- a/src/packlib/kernlib/kernnum/test/numchk3/taadd.F
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: taadd.F,v 1.1.1.1 1996/02/15 17:48:43 mclareni Exp $
-*
-* $Log: taadd.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:43 mclareni
-* Kernlib
-*
-*
-#include "kernnumt/pilot.h"
- SUBROUTINE RAADD(IDIM,X,Y,Z)
- REAL X(*), Y(*), Z(*)
-#include "aadd.inc"
- SUBROUTINE DAADD(IDIM,X,Y,Z)
- DOUBLE PRECISION X(*), Y(*), Z(*)
-#include "aadd.inc"
- SUBROUTINE CAADD(IDIM,X,Y,Z)
- COMPLEX X(*), Y(*), Z(*)
-#include "aadd.inc"
diff --git a/src/packlib/kernlib/kernnum/test/numchk3/tadiv.F b/src/packlib/kernlib/kernnum/test/numchk3/tadiv.F
deleted file mode 100644
index 8685bc9..0000000
--- a/src/packlib/kernlib/kernnum/test/numchk3/tadiv.F
+++ /dev/null
@@ -1,170 +0,0 @@
-*
-* $Id: tadiv.F,v 1.1.1.1 1996/02/15 17:48:43 mclareni Exp $
-*
-* $Log: tadiv.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:43 mclareni
-* Kernlib
-*
-*
-#include "kernnumt/pilot.h"
- SUBROUTINE RADIV(IDIM,X,Y,Z)
- REAL X(*), Y(*), Z(*)
-#include "adiv.inc"
- SUBROUTINE DADIV(IDIM,X,Y,Z)
- DOUBLE PRECISION X(*), Y(*), Z(*)
-#include "adiv.inc"
- SUBROUTINE CADIV(IDIM,X,Y,Z)
- COMPLEX X(*), Y(*), Z(*)
-#include "adiv.inc"
- REAL FUNCTION RAMPA(IDIM,X,Y,S)
- REAL X(*), Y(*), S
-#if defined(CERNLIB_NUMRDBLE)
- DOUBLE PRECISION SUM
-#endif
- RAMPA = S
- IF(IDIM .LE. 0) RETURN
-#if !defined(CERNLIB_NUMRDBLE)
- DO 10 J = 1, IDIM
- RAMPA = RAMPA + X(J)*Y(J)
- 10 CONTINUE
-#endif
-#if defined(CERNLIB_NUMRDBLE)
- SUM = DBLE(S)
- DO 10 J = 1, IDIM
- SUM = SUM + DBLE(X(J))*DBLE(Y(J))
- 10 CONTINUE
- RAMPA = SNGL(SUM)
-#endif
- RETURN
- END
- DOUBLE PRECISION FUNCTION DAMPA(IDIM,X,Y,S)
- DOUBLE PRECISION X(*), Y(*), S
- DAMPA = S
- IF(IDIM .LE. 0) RETURN
- DO 10 J = 1, IDIM
- DAMPA = DAMPA + X(J)*Y(J)
- 10 CONTINUE
- RETURN
- END
- COMPLEX FUNCTION CAMPA(IDIM,X,Y,S)
- COMPLEX X(*), Y(*), S
-#if defined(CERNLIB_NUMCDBLE)
- COMPLEX A
- COMPLEX*16 SUM, DC
- DC(A) = DCMPLX(DBLE(REAL(A)),DBLE(AIMAG(A)))
-#endif
- CAMPA = S
- IF(IDIM .LE. 0) RETURN
-#if !defined(CERNLIB_NUMCDBLE)
- DO 10 J = 1, IDIM
- CAMPA = CAMPA + X(J)*Y(J)
- 10 CONTINUE
-#endif
-#if defined(CERNLIB_NUMCDBLE)
- SUM = S
- DO 10 J = 1, IDIM
- SUM = SUM + DC(X(J))*DC(Y(J))
- 10 CONTINUE
- CAMPA = SUM
-#endif
- RETURN
- END
- COMPLEX FUNCTION CAMPAC(IDIM,X,Y,S)
- COMPLEX X(*), Y(*), S
-#if defined(CERNLIB_NUMCDBLE)
- COMPLEX A
- COMPLEX*16 SUM, DC
- DC(A) = DCMPLX(DBLE(REAL(A)),DBLE(AIMAG(A)))
-#endif
- CAMPAC = S
- IF(IDIM .LE. 0) RETURN
-#if !defined(CERNLIB_NUMCDBLE)
- DO 10 J = 1, IDIM
- CAMPAC = CAMPAC + X(J)*CONJG(Y(J))
- 10 CONTINUE
-#endif
-#if defined(CERNLIB_NUMCDBLE)
- SUM = S
- DO 10 J = 1, IDIM
- SUM = SUM + DC(X(J))*DCONJG(DC(Y(J)))
- 10 CONTINUE
- CAMPAC = SUM
-#endif
- RETURN
- END
- REAL FUNCTION RAMPY(IDIM,X,Y)
- REAL X(*), Y(*)
-#if defined(CERNLIB_NUMRDBLE)
- DOUBLE PRECISION SUM
-#endif
- RAMPY = 0.
- IF(IDIM .LE. 0) RETURN
-#if !defined(CERNLIB_NUMRDBLE)
- DO 10 J = 1, IDIM
- RAMPY = RAMPY + X(J)*Y(J)
- 10 CONTINUE
-#endif
-#if defined(CERNLIB_NUMRDBLE)
- SUM = 0.D0
- DO 10 J = 1, IDIM
- SUM = SUM + DBLE(X(J))*DBLE(Y(J))
- 10 CONTINUE
- RAMPY = SNGL(SUM)
-#endif
- RETURN
- END
- DOUBLE PRECISION FUNCTION DAMPY(IDIM,X,Y)
- DOUBLE PRECISION X(*), Y(*)
- DAMPY = 0.D0
- IF(IDIM .LE. 0) RETURN
- DO 10 J = 1, IDIM
- DAMPY = DAMPY + X(J)*Y(J)
- 10 CONTINUE
- RETURN
- END
- COMPLEX FUNCTION CAMPY(IDIM,X,Y)
- COMPLEX X(*), Y(*)
-#if defined(CERNLIB_NUMCDBLE)
- COMPLEX A
- COMPLEX*16 SUM, DC
- DC(A) = DCMPLX(DBLE(REAL(A)),DBLE(AIMAG(A)))
-#endif
- CAMPY = (0.,0.)
- IF(IDIM .LE. 0) RETURN
-#if !defined(CERNLIB_NUMCDBLE)
- DO 10 J = 1, IDIM
- CAMPY = CAMPY + X(J)*Y(J)
- 10 CONTINUE
-#endif
-#if defined(CERNLIB_NUMCDBLE)
- SUM = (0.D0,0.D0)
- DO 10 J = 1, IDIM
- SUM = SUM + DC(X(J))*DC(Y(J))
- 10 CONTINUE
- CAMPY = SUM
-#endif
- RETURN
- END
- COMPLEX FUNCTION CAMPYC(IDIM,X,Y)
- COMPLEX X(*), Y(*)
-#if defined(CERNLIB_NUMCDBLE)
- COMPLEX A
- COMPLEX*16 SUM, DC
- DC(A) = DCMPLX(DBLE(REAL(A)),DBLE(AIMAG(A)))
-#endif
- CAMPYC = (0.,0.)
- IF(IDIM .LE. 0) RETURN
-#if !defined(CERNLIB_NUMCDBLE)
- DO 10 J = 1, IDIM
- CAMPYC = CAMPYC + X(J)*CONJG(Y(J))
- 10 CONTINUE
-#endif
-#if defined(CERNLIB_NUMCDBLE)
- SUM = (0.D0,0.D0)
- DO 10 J = 1, IDIM
- SUM = SUM + DC(X(J))*DCONJG(DC(Y(J)))
- 10 CONTINUE
- CAMPYC = SUM
-#endif
- RETURN
- END
diff --git a/src/packlib/kernlib/kernnum/test/numchk3/tamul.F b/src/packlib/kernlib/kernnum/test/numchk3/tamul.F
deleted file mode 100644
index 4de0be2..0000000
--- a/src/packlib/kernlib/kernnum/test/numchk3/tamul.F
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: tamul.F,v 1.1.1.1 1996/02/15 17:48:44 mclareni Exp $
-*
-* $Log: tamul.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:44 mclareni
-* Kernlib
-*
-*
-#include "kernnumt/pilot.h"
- SUBROUTINE RAMUL(IDIM,X,Y,Z)
- REAL X(*), Y(*), Z(*)
-#include "amul.inc"
- SUBROUTINE DAMUL(IDIM,X,Y,Z)
- DOUBLE PRECISION X(*), Y(*), Z(*)
-#include "amul.inc"
- SUBROUTINE CAMUL(IDIM,X,Y,Z)
- COMPLEX X(*), Y(*), Z(*)
-#include "amul.inc"
diff --git a/src/packlib/kernlib/kernnum/test/numchk3/tamula.F b/src/packlib/kernlib/kernnum/test/numchk3/tamula.F
deleted file mode 100644
index 3648026..0000000
--- a/src/packlib/kernlib/kernnum/test/numchk3/tamula.F
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: tamula.F,v 1.1.1.1 1996/02/15 17:48:44 mclareni Exp $
-*
-* $Log: tamula.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:44 mclareni
-* Kernlib
-*
-*
-#include "kernnumt/pilot.h"
- SUBROUTINE RAMULA(IDIM,X,Y,Z)
- REAL X(*), Y(*), Z(*)
-#include "amula.inc"
- SUBROUTINE DAMULA(IDIM,X,Y,Z)
- DOUBLE PRECISION X(*), Y(*), Z(*)
-#include "amula.inc"
- SUBROUTINE CAMULA(IDIM,X,Y,Z)
- COMPLEX X(*), Y(*), Z(*)
-#include "amula.inc"
diff --git a/src/packlib/kernlib/kernnum/test/numchk3/tamuna.F b/src/packlib/kernlib/kernnum/test/numchk3/tamuna.F
deleted file mode 100644
index 717cbcd..0000000
--- a/src/packlib/kernlib/kernnum/test/numchk3/tamuna.F
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: tamuna.F,v 1.1.1.1 1996/02/15 17:48:44 mclareni Exp $
-*
-* $Log: tamuna.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:44 mclareni
-* Kernlib
-*
-*
-#include "kernnumt/pilot.h"
- SUBROUTINE RAMUNA(IDIM,X,Y,Z)
- REAL X(*), Y(*), Z(*)
-#include "amuna.inc"
- SUBROUTINE DAMUNA(IDIM,X,Y,Z)
- DOUBLE PRECISION X(*), Y(*), Z(*)
-#include "amuna.inc"
- SUBROUTINE CAMUNA(IDIM,X,Y,Z)
- COMPLEX X(*), Y(*), Z(*)
-#include "amuna.inc"
diff --git a/src/packlib/kernlib/kernnum/test/numchk3/tasca.F b/src/packlib/kernlib/kernnum/test/numchk3/tasca.F
deleted file mode 100644
index 0aa93e7..0000000
--- a/src/packlib/kernlib/kernnum/test/numchk3/tasca.F
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: tasca.F,v 1.1.1.1 1996/02/15 17:48:44 mclareni Exp $
-*
-* $Log: tasca.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:44 mclareni
-* Kernlib
-*
-*
-#include "kernnumt/pilot.h"
- SUBROUTINE RASCA(IDIM,S,X,Y,Z)
- REAL S, X(*), Y(*), Z(*)
-#include "asca.inc"
- SUBROUTINE DASCA(IDIM,S,X,Y,Z)
- DOUBLE PRECISION S, X(*), Y(*), Z(*)
-#include "asca.inc"
- SUBROUTINE CASCA(IDIM,S,X,Y,Z)
- COMPLEX S, X(*), Y(*), Z(*)
-#include "asca.inc"
diff --git a/src/packlib/kernlib/kernnum/test/numchk3/tascl.F b/src/packlib/kernlib/kernnum/test/numchk3/tascl.F
deleted file mode 100644
index c260de2..0000000
--- a/src/packlib/kernlib/kernnum/test/numchk3/tascl.F
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: tascl.F,v 1.1.1.1 1996/02/15 17:48:44 mclareni Exp $
-*
-* $Log: tascl.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:44 mclareni
-* Kernlib
-*
-*
-#include "kernnumt/pilot.h"
- SUBROUTINE RASCL(IDIM,S,X,Z)
- REAL S, X(*), Z(*)
-#include "ascl.inc"
- SUBROUTINE DASCL(IDIM,S,X,Z)
- DOUBLE PRECISION S, X(*), Z(*)
-#include "ascl.inc"
- SUBROUTINE CASCL(IDIM,S,X,Z)
- COMPLEX S, X(*), Z(*)
-#include "ascl.inc"
diff --git a/src/packlib/kernlib/kernnum/test/numchk3/tascs.F b/src/packlib/kernlib/kernnum/test/numchk3/tascs.F
deleted file mode 100644
index 37a83e0..0000000
--- a/src/packlib/kernlib/kernnum/test/numchk3/tascs.F
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: tascs.F,v 1.1.1.1 1996/02/15 17:48:44 mclareni Exp $
-*
-* $Log: tascs.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:44 mclareni
-* Kernlib
-*
-*
-#include "kernnumt/pilot.h"
- SUBROUTINE RASCS(IDIM,S,X,Y,Z)
- REAL S, X(*), Y(*), Z(*)
-#include "ascs.inc"
- SUBROUTINE DASCS(IDIM,S,X,Y,Z)
- DOUBLE PRECISION S, X(*), Y(*), Z(*)
-#include "ascs.inc"
- SUBROUTINE CASCS(IDIM,S,X,Y,Z)
- COMPLEX S, X(*), Y(*), Z(*)
-#include "ascs.inc"
diff --git a/src/packlib/kernlib/kernnum/test/numchk3/tasub.F b/src/packlib/kernlib/kernnum/test/numchk3/tasub.F
deleted file mode 100644
index 674e0e0..0000000
--- a/src/packlib/kernlib/kernnum/test/numchk3/tasub.F
+++ /dev/null
@@ -1,45 +0,0 @@
-*
-* $Id: tasub.F,v 1.1.1.1 1996/02/15 17:48:44 mclareni Exp $
-*
-* $Log: tasub.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:44 mclareni
-* Kernlib
-*
-*
-#include "kernnumt/pilot.h"
- SUBROUTINE RASUB(IDIM,X,Y,Z)
- REAL X(*), Y(*), Z(*)
-#include "asub.inc"
- SUBROUTINE DASUB(IDIM,X,Y,Z)
- DOUBLE PRECISION X(*), Y(*), Z(*)
-#include "asub.inc"
- SUBROUTINE CASUB(IDIM,X,Y,Z)
- COMPLEX X(*), Y(*), Z(*)
-#include "asub.inc"
- REAL FUNCTION RASUM(IDIM,X)
- REAL X(*)
- RASUM = 0.
- IF(IDIM .LE. 0) RETURN
- DO 10 J = 1, IDIM
- RASUM = RASUM + X(J)
- 10 CONTINUE
- RETURN
- END
- DOUBLE PRECISION FUNCTION DASUM(IDIM,X)
- DOUBLE PRECISION X(*)
- DASUM = 0.D0
- IF(IDIM .LE. 0) RETURN
- DO 10 J = 1, IDIM
- DASUM = DASUM + X(J)
- 10 CONTINUE
- RETURN
- END
- COMPLEX FUNCTION CASUM(IDIM,X)
- COMPLEX X(*)
- CASUM = (0.,0.)
- IF(IDIM .LE. 0) RETURN
- DO 10 J = 1, IDIM
- CASUM = CASUM + X(J)
- 10 CONTINUE
- RETURN
- END
diff --git a/src/packlib/kernlib/kernnum/test/numchk4/Imakefile b/src/packlib/kernlib/kernnum/test/numchk4/Imakefile
deleted file mode 100644
index 115132c..0000000
--- a/src/packlib/kernlib/kernnum/test/numchk4/Imakefile
+++ /dev/null
@@ -1,4 +0,0 @@
-SRCS_F= \ @@\
- c205ch.F c205d1.F c205r1.F check4.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/kernnum/test/numchk4/c205ch.F b/src/packlib/kernlib/kernnum/test/numchk4/c205ch.F
deleted file mode 100644
index 5ca54d8..0000000
--- a/src/packlib/kernlib/kernnum/test/numchk4/c205ch.F
+++ /dev/null
@@ -1,88 +0,0 @@
-*
-* $Id: c205ch.F,v 1.2 1996/03/21 17:16:12 mclareni Exp $
-*
-* $Log: c205ch.F,v $
-* Revision 1.2 1996/03/21 17:16:12 mclareni
-* Kernnumt corrections for unaligned access on OSF1 by John Marafino, Fermilab
-*
-* Revision 1.1.1.1 1996/02/15 17:48:46 mclareni
-* Kernlib
-*
-*
-#include "kernnumt/pilot.h"
- SUBROUTINE C205CH(NREP,OK)
-#include "kernnumt/sysdat.inc"
- EXTERNAL C205R1,C205R2,C205R3,C205R4
-*JMM
-* REAL RX,RR,REPS,C205R1,C205R2,C205R3,C205R4
- REAL RX,RR,REPS,C205R1,C205R2,C205R3,C205R4,RTHIRD
-#if defined(CERNLIB_NUMLOPRE)
- EXTERNAL C205D1,C205D2,C205D3,C205D4
-*JMM
-* DOUBLE PRECISION DX,DR,DEPS,C205D1,C205D2,C205D3,C205D4
- DOUBLE PRECISION DX,DR,DEPS,C205D1,C205D2,C205D3,C205D4,DTHIRD
-#endif
- LOGICAL OK,OKT
- OK=.TRUE.
-*JMM
- RTHIRD = 1.0/3.0
- REPS=RELPRT(1)*1000
- CALL RZERO(-1E0,4E0,RX,RR,REPS,100,C205R1)
-*JMM
-* OKT=ABS(RX-1E0/3) .LE. REPS
- OKT=ABS(RX-RTHIRD) .LE. REPS
- IF(.NOT.OKT) WRITE(*,100) 'RX =',RX
- OK=OK .AND. OKT
- CALL RZERO(-0.5E0,0.7E0,RX,RR,REPS,100,C205R2)
- OKT=ABS(RX) .LE. 2*REPS
- IF(.NOT.OKT) WRITE(*,100) 'RX =',RX
- OK=OK .AND. OKT
- IF( ERPRNT .AND. ERSTOP) WRITE(*,101)
- IF( ERPRNT .AND. .NOT.ERSTOP) WRITE(*,102)
- IF(.NOT.ERPRNT .AND. ERSTOP) WRITE(*,103)
- CALL RZERO(1E0,2E0,RX,RR,REPS,30,C205R3)
- IF(RR .GE. 0) THEN
- OK=.FALSE.
- WRITE(*,104) 'RZERO','RR =',RR,'C205.1'
- END IF
- CALL RZERO(-10E0,1.9E0,RX,RR,REPS,5,C205R4)
- IF(RR .GE. 0) THEN
- OK=.FALSE.
- WRITE(*,104) 'RZERO','RR =',RR,'C205.2'
- END IF
-#if defined(CERNLIB_NUMLOPRE)
-*JMM
- DTHIRD = 1.0D0/3.0D0
- DEPS=RELPRT(2)*1000
- CALL DZERO(-1D0,4D0,DX,DR,DEPS,100,C205D1)
-*JMM
-* OKT=ABS(DX-1D0/3) .LE. DEPS
- OKT=ABS(DX-DTHIRD) .LE. DEPS
- IF(.NOT.OKT) WRITE(*,100) 'DX =',DX
- OK=OK .AND. OKT
- CALL DZERO(-0.5D0,0.7D0,DX,DR,DEPS,100,C205D2)
- OKT=ABS(DX) .LE. 2*DEPS
- IF(.NOT.OKT) WRITE(*,100) 'DX =',DX
- OK=OK .AND. OKT
- IF( ERPRNT .AND. ERSTOP) WRITE(*,101)
- IF( ERPRNT .AND. .NOT.ERSTOP) WRITE(*,102)
- IF(.NOT.ERPRNT .AND. ERSTOP) WRITE(*,103)
- CALL DZERO(1D0,2D0,DX,DR,DEPS,30,C205D3)
- IF(DR .GE. 0) THEN
- OK=.FALSE.
- WRITE(*,104) 'DZERO','DR =',DR,'C205.1'
- END IF
- CALL DZERO(-10D0,1.9D0,DX,DR,DEPS,5,C205D4)
- IF(DR .GE. 0) THEN
- OK=.FALSE.
- WRITE(*,104) 'DZERO','DR =',DR,'C205.2'
- END IF
-#endif
- RETURN
- 100 FORMAT(1X,'C205CH ARITHMETIC ERROR ',A4,E25.12)
- 101 FORMAT(/' TWO ERROR AND ABEND MESSAGES SHOULD NOW FOLLOW ...')
- 102 FORMAT(/' TWO ERROR MESSAGES SHOULD NOW FOLLOW ...')
- 103 FORMAT(/' TWO ABEND MESSAGES SHOULD NOW FOLLOW ...')
- 104 FORMAT(/' ????? TEST OF ',A5,' ... ',A4,E20.10,
- 1 ' ERROR CONDITION ',A6,' NOT DEDECTED.')
- END
diff --git a/src/packlib/kernlib/kernnum/test/numchk4/c205d1.F b/src/packlib/kernlib/kernnum/test/numchk4/c205d1.F
deleted file mode 100644
index b70d73d..0000000
--- a/src/packlib/kernlib/kernnum/test/numchk4/c205d1.F
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: c205d1.F,v 1.1.1.1 1996/02/15 17:48:46 mclareni Exp $
-*
-* $Log: c205d1.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:46 mclareni
-* Kernlib
-*
-*
-#include "kernnumt/pilot.h"
- FUNCTION C205D1(DX,I)
- IMPLICIT DOUBLE PRECISION (A-H,O-Z)
- C205D1=(3*DX-1)*(1.5D0*DX-1)**4*EXP(-5*DX)
- RETURN
-
- ENTRY C205D2(DX,I)
- C205D2=SIN(DX)
- RETURN
- END
diff --git a/src/packlib/kernlib/kernnum/test/numchk4/c205r1.F b/src/packlib/kernlib/kernnum/test/numchk4/c205r1.F
deleted file mode 100644
index de62ca4..0000000
--- a/src/packlib/kernlib/kernnum/test/numchk4/c205r1.F
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: c205r1.F,v 1.1.1.1 1996/02/15 17:48:46 mclareni Exp $
-*
-* $Log: c205r1.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:46 mclareni
-* Kernlib
-*
-*
-#include "kernnumt/pilot.h"
- FUNCTION C205R1(RX,I)
- IMPLICIT REAL (A-H,O-Z)
- C205R1=(3*RX-1)*(1.5E0*RX-1)**4*EXP(-5*RX)
- RETURN
-
- ENTRY C205R2(RX,I)
- C205R2=SIN(RX)
- RETURN
- END
diff --git a/src/packlib/kernlib/kernnum/test/numchk4/check4.F b/src/packlib/kernlib/kernnum/test/numchk4/check4.F
deleted file mode 100644
index 3e51330..0000000
--- a/src/packlib/kernlib/kernnum/test/numchk4/check4.F
+++ /dev/null
@@ -1,102 +0,0 @@
-*
-* $Id: check4.F,v 1.1.1.1 1996/02/15 17:48:46 mclareni Exp $
-*
-* $Log: check4.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:46 mclareni
-* Kernlib
-*
-*
-#include "kernnumt/pilot.h"
- SUBROUTINE CHECK4(LWORK,W,NPK,OK,PKN,PKT)
- REAL W(LWORK), PKT(*)
- LOGICAL OK, OKPK
- CHARACTER*4 PKN(*)
-#include "kernnumt/sysdat.inc"
- CHARACTER*4 LISTPK(2), NULL
- INTEGER NREPPK(2)
- DATA LISTPK
- + / 'C205', 'NULL'/
-* + / 'C205', 'C305', 'C308', 'C312', 'C313',
-* + 'C336', 'C337', 'C341', 'NULL' /
- DATA NULL / 'NULL' /
- DATA NREPPK / 2, 0 /
-* DATA NREPPK / 2, 4, 2, 8,12, 4, 7, 5, 0 /
- DO 100 NPK = 1, 100
- IF(LISTPK(NPK) .EQ. NULL) GOTO 101
- 100 CONTINUE
- NPK = 0
- RETURN
- 101 NPK = NPK - 1
- OK = .TRUE.
- DO 200 IPK = 1, NPK
- NAMEPK = LISTPK(IPK)
- PKN(IPK)= LISTPK(IPK)
- NREP = NREPPK(IPK)
- OKPK = .FALSE.
- WRITE(*,1000) NAMEPK
-* GOTO(01), IPK
-* GOTO(01,02,03,04), IPK
- 01 CALL C205CH(NREP,OKPK)
- GOTO 90
- 90 IF(.NOT. OKPK) WRITE(*,1012) NAMEPK
- IF( OKPK) WRITE(*,1013) NAMEPK
- OK = OK .AND. OKPK
- CALL TIMEX( PKT(IPK) )
- 200 CONTINUE
- IF(NPK .LT. 1) OK = .FALSE.
- RETURN
-1000 FORMAT(// 10H CHECK OF , A4,1H.)
-1012 FORMAT(/ 5X, 24H ????? CHECK OF PACKAGE ,A4,
- + 18H HAS FAILED. ????? )
-1013 FORMAT( 15X, 18H CHECK OF PACKAGE ,A4,12H SUCCESSFUL. )
- END
- SUBROUTINE FCTNCH
-#include "kernnumt/sysdat.inc"
- REAL RFUNC, TRUNC, ROUND
- REAL RX, RY, RF, RE, DELTA, RFROMD
- DOUBLE PRECISION DFUNC, X(*), Y(*), DX, DF
- LOGICAL SAME, OK
- RFROMD(DX) = SNGL(DX+(DX-DBLE(SNGL(DX))))
- ENTRY DFEQDY(N,X,DFUNC,Y,TRUNC,ROUND,SAME)
- SAME = .TRUE.
- DELTA = AMAX1(TRUNC,ROUND)
- DO 10 J = 1, N
- DF = DFUNC(X(J))
- RE = SNGL(DABS( (DF-Y(J))/Y(J) ))
- OK = RE .LT. DELTA
- SAME = SAME .AND. OK
- IF(.NOT. OK) WRITE(*,1000) J,X(J),Y(J),DF,RE,DELTA
- 10 CONTINUE
- RETURN
- ENTRY RFEQDF(N,X,RFUNC,DFUNC,TRUNC,ROUND,SAME)
- SAME = .TRUE.
- DELTA = AMAX1(TRUNC,ROUND)
- DO 20 J = 1, N
- RX = RFROMD(X(J))
- DX = DBLE(RX)
- RY = RFROMD(DFUNC(DX))
- RF = RFUNC(RX)
- RE = ABS( (RF-RY)/RY )
- OK = RE .LT. DELTA
- SAME = SAME .AND. OK
- IF(.NOT. OK) WRITE(*,1000) J,RX,RY,RF,RE,DELTA
- 20 CONTINUE
- RETURN
- ENTRY RFEQDY(N,X,RFUNC,Y,TRUNC,ROUND,SAME)
- SAME = .TRUE.
- DELTA = AMAX1(TRUNC,ROUND)
- DO 30 J = 1, N
- RX = RFROMD(X(J))
- RY = RFROMD(Y(J))
- RF = RFUNC(RX)
- RE = ABS( (RF-RY)/RY )
- OK = RE .LT. DELTA
- SAME = SAME .AND. OK
- IF(.NOT. OK) WRITE(*,1000) J,RX,RY,RF,RE,DELTA
- 30 CONTINUE
- RETURN
-1000 FORMAT(1P,/' ERROR FOR X(',I2,') =',E23.15,' ??? '/
- + ' REF. VALUE =',E23.15,' DIFFERS FROM'/
- + ' TEST VALUE =',E23.15,' BY THE REL. ERROR =',E10.2,/
- + ' WHICH IS LARGER THAN THE MARGIN',17X,'DELTA =',E10.2)
- END
diff --git a/src/packlib/kernlib/kernnum/test/obsolete/kernnumt/numcd.h b/src/packlib/kernlib/kernnum/test/obsolete/kernnumt/numcd.h
deleted file mode 100644
index 8ec000b..0000000
--- a/src/packlib/kernlib/kernnum/test/obsolete/kernnumt/numcd.h
+++ /dev/null
@@ -1,45 +0,0 @@
-*
-* $Id: numcd.h,v 1.1.1.1 1996/02/15 17:48:38 mclareni Exp $
-*
-* $Log: numcd.h,v $
-* Revision 1.1.1.1 1996/02/15 17:48:38 mclareni
-* Kernlib
-*
-*
-* This directory was created from kernnumt.car patch numcd
-#ifdef CERNLIB_NUMLOPRE
-#undef CERNLIB_NUMLOPRE
-#endif
-#ifndef CERNLIB_NUMHIPRE
-#define CERNLIB_NUMHIPRE
-#endif
-#ifdef CERNLIB_NUMRDBLE
-#undef CERNLIB_NUMRDBLE
-#endif
-#ifdef CERNLIB_NUMCDBLE
-#undef CERNLIB_NUMCDBLE
-#endif
-#ifdef CERNLIB_NUME38
-#undef CERNLIB_NUME38
-#endif
-#ifdef CERNLIB_NUME75
-#undef CERNLIB_NUME75
-#endif
-#ifndef CERNLIB_NUME293
-#define CERNLIB_NUME293
-#endif
-#ifdef CERNLIB_NUME2465
-#undef CERNLIB_NUME2465
-#endif
-#ifdef CERNLIB_NUMD38
-#undef CERNLIB_NUMD38
-#endif
-#ifdef CERNLIB_NUMD75
-#undef CERNLIB_NUMD75
-#endif
-#ifndef CERNLIB_NUMD279
-#define CERNLIB_NUMD279
-#endif
-#ifdef CERNLIB_NUMD2465
-#undef CERNLIB_NUMD2465
-#endif
diff --git a/src/packlib/kernlib/kernnum/test/obsolete/kernnumt/numcd1c.h b/src/packlib/kernlib/kernnum/test/obsolete/kernnumt/numcd1c.h
deleted file mode 100644
index 7578df6..0000000
--- a/src/packlib/kernlib/kernnum/test/obsolete/kernnumt/numcd1c.h
+++ /dev/null
@@ -1,15 +0,0 @@
-*
-* $Id: numcd1c.h,v 1.1.1.1 1996/02/15 17:48:38 mclareni Exp $
-*
-* $Log: numcd1c.h,v $
-* Revision 1.1.1.1 1996/02/15 17:48:38 mclareni
-* Kernlib
-*
-*
-* This directory was created from kernnumt.car patch numcd1c
-#ifndef CERNLIB_NUMCD
-#define CERNLIB_NUMCD
-#endif
-#ifndef CERNLIB_NUMCHK
-#define CERNLIB_NUMCHK
-#endif
diff --git a/src/packlib/kernlib/kernnum/test/obsolete/kernnumt/numcr.h b/src/packlib/kernlib/kernnum/test/obsolete/kernnumt/numcr.h
deleted file mode 100644
index 2e25aa7..0000000
--- a/src/packlib/kernlib/kernnum/test/obsolete/kernnumt/numcr.h
+++ /dev/null
@@ -1,45 +0,0 @@
-*
-* $Id: numcr.h,v 1.1.1.1 1996/02/15 17:48:38 mclareni Exp $
-*
-* $Log: numcr.h,v $
-* Revision 1.1.1.1 1996/02/15 17:48:38 mclareni
-* Kernlib
-*
-*
-* This directory was created from kernnumt.car patch numcr
-#ifdef CERNLIB_NUMLOPRE
-#undef CERNLIB_NUMLOPRE
-#endif
-#ifndef CERNLIB_NUMHIPRE
-#define CERNLIB_NUMHIPRE
-#endif
-#ifdef CERNLIB_NUMRDBLE
-#undef CERNLIB_NUMRDBLE
-#endif
-#ifdef CERNLIB_NUMCDBLE
-#undef CERNLIB_NUMCDBLE
-#endif
-#ifdef CERNLIB_NUME38
-#undef CERNLIB_NUME38
-#endif
-#ifdef CERNLIB_NUME75
-#undef CERNLIB_NUME75
-#endif
-#ifdef CERNLIB_NUME293
-#undef CERNLIB_NUME293
-#endif
-#ifndef CERNLIB_NUME2465
-#define CERNLIB_NUME2465
-#endif
-#ifdef CERNLIB_NUMD38
-#undef CERNLIB_NUMD38
-#endif
-#ifdef CERNLIB_NUMD75
-#undef CERNLIB_NUMD75
-#endif
-#ifdef CERNLIB_NUMD279
-#undef CERNLIB_NUMD279
-#endif
-#ifndef CERNLIB_NUMD2465
-#define CERNLIB_NUMD2465
-#endif
diff --git a/src/packlib/kernlib/kernnum/test/obsolete/kernnumt/numcr1c.h b/src/packlib/kernlib/kernnum/test/obsolete/kernnumt/numcr1c.h
deleted file mode 100644
index 8e0fa1e..0000000
--- a/src/packlib/kernlib/kernnum/test/obsolete/kernnumt/numcr1c.h
+++ /dev/null
@@ -1,15 +0,0 @@
-*
-* $Id: numcr1c.h,v 1.1.1.1 1996/02/15 17:48:38 mclareni Exp $
-*
-* $Log: numcr1c.h,v $
-* Revision 1.1.1.1 1996/02/15 17:48:38 mclareni
-* Kernlib
-*
-*
-* This directory was created from kernnumt.car patch numcr1c
-#ifndef CERNLIB_NUMCR
-#define CERNLIB_NUMCR
-#endif
-#ifndef CERNLIB_NUMCHK
-#define CERNLIB_NUMCHK
-#endif
diff --git a/src/packlib/kernlib/kernnum/test/obsolete/kernnumt/numcv.h b/src/packlib/kernlib/kernnum/test/obsolete/kernnumt/numcv.h
deleted file mode 100644
index f703562..0000000
--- a/src/packlib/kernlib/kernnum/test/obsolete/kernnumt/numcv.h
+++ /dev/null
@@ -1,45 +0,0 @@
-*
-* $Id: numcv.h,v 1.1.1.1 1996/02/15 17:48:38 mclareni Exp $
-*
-* $Log: numcv.h,v $
-* Revision 1.1.1.1 1996/02/15 17:48:38 mclareni
-* Kernlib
-*
-*
-* This directory was created from kernnumt.car patch numcv
-#ifdef CERNLIB_NUMLOPRE
-#undef CERNLIB_NUMLOPRE
-#endif
-#ifndef CERNLIB_NUMHIPRE
-#define CERNLIB_NUMHIPRE
-#endif
-#ifdef CERNLIB_NUMRDBLE
-#undef CERNLIB_NUMRDBLE
-#endif
-#ifdef CERNLIB_NUMCDBLE
-#undef CERNLIB_NUMCDBLE
-#endif
-#ifdef CERNLIB_NUME38
-#undef CERNLIB_NUME38
-#endif
-#ifdef CERNLIB_NUME75
-#undef CERNLIB_NUME75
-#endif
-#ifdef CERNLIB_NUME293
-#undef CERNLIB_NUME293
-#endif
-#ifndef CERNLIB_NUME2465
-#define CERNLIB_NUME2465
-#endif
-#ifdef CERNLIB_NUMD38
-#undef CERNLIB_NUMD38
-#endif
-#ifdef CERNLIB_NUMD75
-#undef CERNLIB_NUMD75
-#endif
-#ifdef CERNLIB_NUMD279
-#undef CERNLIB_NUMD279
-#endif
-#ifndef CERNLIB_NUMD2465
-#define CERNLIB_NUMD2465
-#endif
diff --git a/src/packlib/kernlib/kernnum/test/obsolete/kernnumt/numcv1c.h b/src/packlib/kernlib/kernnum/test/obsolete/kernnumt/numcv1c.h
deleted file mode 100644
index 2299d25..0000000
--- a/src/packlib/kernlib/kernnum/test/obsolete/kernnumt/numcv1c.h
+++ /dev/null
@@ -1,15 +0,0 @@
-*
-* $Id: numcv1c.h,v 1.1.1.1 1996/02/15 17:48:38 mclareni Exp $
-*
-* $Log: numcv1c.h,v $
-* Revision 1.1.1.1 1996/02/15 17:48:38 mclareni
-* Kernlib
-*
-*
-* This directory was created from kernnumt.car patch numcv1c
-#ifndef CERNLIB_NUMCV
-#define CERNLIB_NUMCV
-#endif
-#ifndef CERNLIB_NUMCHK
-#define CERNLIB_NUMCHK
-#endif
diff --git a/src/packlib/kernlib/kernnum/test/obsolete/kernnumt/numib.h b/src/packlib/kernlib/kernnum/test/obsolete/kernnumt/numib.h
deleted file mode 100644
index 3e57b8a..0000000
--- a/src/packlib/kernlib/kernnum/test/obsolete/kernnumt/numib.h
+++ /dev/null
@@ -1,45 +0,0 @@
-*
-* $Id: numib.h,v 1.1.1.1 1996/02/15 17:48:38 mclareni Exp $
-*
-* $Log: numib.h,v $
-* Revision 1.1.1.1 1996/02/15 17:48:38 mclareni
-* Kernlib
-*
-*
-* This directory was created from kernnumt.car patch numib
-#ifndef CERNLIB_NUMLOPRE
-#define CERNLIB_NUMLOPRE
-#endif
-#ifdef CERNLIB_NUMHIPRE
-#undef CERNLIB_NUMHIPRE
-#endif
-#ifndef CERNLIB_NUMRDBLE
-#define CERNLIB_NUMRDBLE
-#endif
-#ifndef CERNLIB_NUMCDBLE
-#define CERNLIB_NUMCDBLE
-#endif
-#ifdef CERNLIB_NUME38
-#undef CERNLIB_NUME38
-#endif
-#ifndef CERNLIB_NUME75
-#define CERNLIB_NUME75
-#endif
-#ifdef CERNLIB_NUME293
-#undef CERNLIB_NUME293
-#endif
-#ifdef CERNLIB_NUME2465
-#undef CERNLIB_NUME2465
-#endif
-#ifdef CERNLIB_NUMD38
-#undef CERNLIB_NUMD38
-#endif
-#ifndef CERNLIB_NUMD75
-#define CERNLIB_NUMD75
-#endif
-#ifdef CERNLIB_NUMD279
-#undef CERNLIB_NUMD279
-#endif
-#ifdef CERNLIB_NUMD2465
-#undef CERNLIB_NUMD2465
-#endif
diff --git a/src/packlib/kernlib/kernnum/test/obsolete/kernnumt/numib1c.h b/src/packlib/kernlib/kernnum/test/obsolete/kernnumt/numib1c.h
deleted file mode 100644
index 3d13ebc..0000000
--- a/src/packlib/kernlib/kernnum/test/obsolete/kernnumt/numib1c.h
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: numib1c.h,v 1.1.1.1 1996/02/15 17:48:38 mclareni Exp $
-*
-* $Log: numib1c.h,v $
-* Revision 1.1.1.1 1996/02/15 17:48:38 mclareni
-* Kernlib
-*
-*
-* This directory was created from kernnumt.car patch numib1c
-#ifndef CERNLIB_NUMIB1
-#define CERNLIB_NUMIB1
-#endif
-#ifndef CERNLIB_NUMIB
-#define CERNLIB_NUMIB
-#endif
-#ifndef CERNLIB_NUMCHK
-#define CERNLIB_NUMCHK
-#endif
diff --git a/src/packlib/kernlib/kernnum/test/obsolete/kernnumt/numib2c.h b/src/packlib/kernlib/kernnum/test/obsolete/kernnumt/numib2c.h
deleted file mode 100644
index ddb009e..0000000
--- a/src/packlib/kernlib/kernnum/test/obsolete/kernnumt/numib2c.h
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: numib2c.h,v 1.1.1.1 1996/02/15 17:48:38 mclareni Exp $
-*
-* $Log: numib2c.h,v $
-* Revision 1.1.1.1 1996/02/15 17:48:38 mclareni
-* Kernlib
-*
-*
-* This directory was created from kernnumt.car patch numib2c
-#ifndef CERNLIB_NUMIB2
-#define CERNLIB_NUMIB2
-#endif
-#ifndef CERNLIB_NUMIB
-#define CERNLIB_NUMIB
-#endif
-#ifndef CERNLIB_NUMCHK
-#define CERNLIB_NUMCHK
-#endif
diff --git a/src/packlib/kernlib/kernnum/test/obsolete/kernnumt/numnd.h b/src/packlib/kernlib/kernnum/test/obsolete/kernnumt/numnd.h
deleted file mode 100644
index fe9f277..0000000
--- a/src/packlib/kernlib/kernnum/test/obsolete/kernnumt/numnd.h
+++ /dev/null
@@ -1,45 +0,0 @@
-*
-* $Id: numnd.h,v 1.1.1.1 1996/02/15 17:48:38 mclareni Exp $
-*
-* $Log: numnd.h,v $
-* Revision 1.1.1.1 1996/02/15 17:48:38 mclareni
-* Kernlib
-*
-*
-* This directory was created from kernnumt.car patch numnd
-#ifndef CERNLIB_NUMLOPRE
-#define CERNLIB_NUMLOPRE
-#endif
-#ifdef CERNLIB_NUMHIPRE
-#undef CERNLIB_NUMHIPRE
-#endif
-#ifndef CERNLIB_NUMRDBLE
-#define CERNLIB_NUMRDBLE
-#endif
-#ifndef CERNLIB_NUMCDBLE
-#define CERNLIB_NUMCDBLE
-#endif
-#ifdef CERNLIB_NUME38
-#undef CERNLIB_NUME38
-#endif
-#ifndef CERNLIB_NUME75
-#define CERNLIB_NUME75
-#endif
-#ifdef CERNLIB_NUME293
-#undef CERNLIB_NUME293
-#endif
-#ifdef CERNLIB_NUME2465
-#undef CERNLIB_NUME2465
-#endif
-#ifdef CERNLIB_NUMD38
-#undef CERNLIB_NUMD38
-#endif
-#ifndef CERNLIB_NUMD75
-#define CERNLIB_NUMD75
-#endif
-#ifdef CERNLIB_NUMD279
-#undef CERNLIB_NUMD279
-#endif
-#ifdef CERNLIB_NUMD2465
-#undef CERNLIB_NUMD2465
-#endif
diff --git a/src/packlib/kernlib/kernnum/test/obsolete/kernnumt/numnd1c.h b/src/packlib/kernlib/kernnum/test/obsolete/kernnumt/numnd1c.h
deleted file mode 100644
index e0ed382..0000000
--- a/src/packlib/kernlib/kernnum/test/obsolete/kernnumt/numnd1c.h
+++ /dev/null
@@ -1,15 +0,0 @@
-*
-* $Id: numnd1c.h,v 1.1.1.1 1996/02/15 17:48:38 mclareni Exp $
-*
-* $Log: numnd1c.h,v $
-* Revision 1.1.1.1 1996/02/15 17:48:38 mclareni
-* Kernlib
-*
-*
-* This directory was created from kernnumt.car patch numnd1c
-#ifndef CERNLIB_NUMND
-#define CERNLIB_NUMND
-#endif
-#ifndef CERNLIB_NUMCHK
-#define CERNLIB_NUMCHK
-#endif
diff --git a/src/packlib/kernlib/kernnum/test/obsolete/kernnumt/numuc.h b/src/packlib/kernlib/kernnum/test/obsolete/kernnumt/numuc.h
deleted file mode 100644
index 2e16603..0000000
--- a/src/packlib/kernlib/kernnum/test/obsolete/kernnumt/numuc.h
+++ /dev/null
@@ -1,45 +0,0 @@
-*
-* $Id: numuc.h,v 1.1.1.1 1996/02/15 17:48:38 mclareni Exp $
-*
-* $Log: numuc.h,v $
-* Revision 1.1.1.1 1996/02/15 17:48:38 mclareni
-* Kernlib
-*
-*
-* This directory was created from kernnumt.car patch numuc
-#ifndef CERNLIB_NUMLOPRE
-#define CERNLIB_NUMLOPRE
-#endif
-#ifdef CERNLIB_NUMHIPRE
-#undef CERNLIB_NUMHIPRE
-#endif
-#ifndef CERNLIB_NUMRDBLE
-#define CERNLIB_NUMRDBLE
-#endif
-#ifndef CERNLIB_NUMCDBLE
-#define CERNLIB_NUMCDBLE
-#endif
-#ifndef CERNLIB_NUME38
-#define CERNLIB_NUME38
-#endif
-#ifdef CERNLIB_NUME75
-#undef CERNLIB_NUME75
-#endif
-#ifdef CERNLIB_NUME293
-#undef CERNLIB_NUME293
-#endif
-#ifdef CERNLIB_NUME2465
-#undef CERNLIB_NUME2465
-#endif
-#ifdef CERNLIB_NUMD38
-#undef CERNLIB_NUMD38
-#endif
-#ifdef CERNLIB_NUMD75
-#undef CERNLIB_NUMD75
-#endif
-#ifndef CERNLIB_NUMD279
-#define CERNLIB_NUMD279
-#endif
-#ifdef CERNLIB_NUMD2465
-#undef CERNLIB_NUMD2465
-#endif
diff --git a/src/packlib/kernlib/kernnum/test/obsolete/kernnumt/numuc1c.h b/src/packlib/kernlib/kernnum/test/obsolete/kernnumt/numuc1c.h
deleted file mode 100644
index 5938878..0000000
--- a/src/packlib/kernlib/kernnum/test/obsolete/kernnumt/numuc1c.h
+++ /dev/null
@@ -1,15 +0,0 @@
-*
-* $Id: numuc1c.h,v 1.1.1.1 1996/02/15 17:48:38 mclareni Exp $
-*
-* $Log: numuc1c.h,v $
-* Revision 1.1.1.1 1996/02/15 17:48:38 mclareni
-* Kernlib
-*
-*
-* This directory was created from kernnumt.car patch numuc1c
-#ifndef CERNLIB_NUMUC
-#define CERNLIB_NUMUC
-#endif
-#ifndef CERNLIB_NUMCHK
-#define CERNLIB_NUMCHK
-#endif
diff --git a/src/packlib/kernlib/kernnum/test/obsolete/numchk1/g100ch.F b/src/packlib/kernlib/kernnum/test/obsolete/numchk1/g100ch.F
deleted file mode 100644
index 0ea48ff..0000000
--- a/src/packlib/kernlib/kernnum/test/obsolete/numchk1/g100ch.F
+++ /dev/null
@@ -1,96 +0,0 @@
-*
-* $Id: g100ch.F,v 1.1.1.1 1996/02/15 17:48:38 mclareni Exp $
-*
-* $Log: g100ch.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:38 mclareni
-* Kernlib
-*
-*
-#include "kernnumt/pilot.h"
-#if defined(CERNLIB_NEVER)
- SUBROUTINE G100CH(NREP,OK)
- DOUBLE PRECISION DPI,SUM,DX,DEXPO,DROOT
- DIMENSION MARGIN(8),NN(8)
-#include "kernnumt/sysdat.inc"
- LOGICAL OK,OKT
-#if defined(CERNLIB_NUMHIPRE)
- DATA MARGIN /2*5,4*100,2*5 000 000 000 /
-#endif
-#if defined(CERNLIB_NUMLOPRE)
- DATA MARGIN /2*5,4*100,2*500 000 /
-#endif
- IRESF(RES)=NINT(RES/RELPR)
- OK=.TRUE.
- REL=1.
- DPI=4.*DATAN(1.D0)
-C
-C
- I=0
- DO 25 J=1,3,2
- I=I+1
- NN(I)=J
- 25 CONTINUE
- DO 26 J=2,127,25
- I=I+1
- NN(I)=J
- 26 CONTINUE
- DO 90 JREP=1,NREP
- N=NN(JREP)
- IF(JREP .GT. 2) GO TO 30
- X=FLOAT(N)
- PP=PROB(X,N)-2.*(1.-FREQ(SQRT(X)))
- SUM=0.5D0*DBLE(FLOAT(N)-1.)*DSQRT(2.D0*X/DPI)*
- 1 DEXP(-0.5D0*X)
- RES=PP-SUM
- RES=ABS(RES)
- GO TO 85
- 30 CONTINUE
- X=FLOAT(N)
- DX=DBLE(X)
- DEXPO=DEXP(-0.5D0*DX)
- IF(N .EQ. 2) GO TO 60
- M=N/2
- IF(2.*M .EQ. N) GO TO 50
- DROOT=DSQRT(2.D0*DX/DPI)
- SUM=DEXPO*DROOT
- DO 40 J=2,M
- DROOT=DROOT*DX/DBLE(2.*FLOAT(J)-1.)
- 40 SUM=SUM+DEXPO*DROOT
- PP=PROB(X,N)-2.*(1.-FREQ(SQRT(X)))
- RES=PP-SUM
- RES=ABS(RES)
- GO TO 85
- 50 CONTINUE
- MM1=M-1
- 60 SUM=DEXPO
- IF(N .EQ. 2) GO TO 80
- DROOT=1.D0
- DO 70 J=1,MM1
- DROOT=0.5D0*DX*DROOT/DBLE(FLOAT(J))
- SUM=SUM+DEXPO*DROOT
- 70 CONTINUE
- 80 PP=PROB(X,N)
- RES=PP-SUM
- RES=ABS(RES)
- 85 CONTINUE
- IREL=IRESF(RES)
- OKT=IREL .LE. MARGIN(JREP)
- IF(.NOT.OKT) WRITE(*,600) JREP,REL,IREL
- OK=OK .AND. OKT
- 90 CONTINUE
- IF( ERPRNT .AND. ERSTOP) WRITE(*,101)
- IF( ERPRNT .AND. .NOT. ERSTOP) WRITE(*,102)
- IF(.NOT. ERPRNT .AND. ERSTOP) WRITE(*,103)
- N = 0
- CHI2 = -1.
- PP = PROB(CHI2,N)
- N = 1
- CHI2 = -1.
- PP = PROB(CHI2,N)
- RETURN
- 101 FORMAT(/' TWO ERROR AND ABEND MESSAGES SHOULD NOW FOLLOW ...')
- 102 FORMAT(/' TWO ERROR MESSAGES SHOULD NOW FOLLOW ...')
- 103 FORMAT(/' TWO ABEND MESSAGES SHOULD NOW FOLLOW ...')
-#endif
- 600 FORMAT(/ 25H *** ARITHMETIC ERROR ***, I8,1P,E12.3,I12)
- END
diff --git a/src/packlib/kernlib/kernnum/test/obsolete/numchk2/c204ch.F b/src/packlib/kernlib/kernnum/test/obsolete/numchk2/c204ch.F
deleted file mode 100644
index b4cff01..0000000
--- a/src/packlib/kernlib/kernnum/test/obsolete/numchk2/c204ch.F
+++ /dev/null
@@ -1,57 +0,0 @@
-*
-* $Id: c204ch.F,v 1.1.1.1 1996/02/15 17:48:39 mclareni Exp $
-*
-* $Log: c204ch.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:39 mclareni
-* Kernlib
-*
-*
-#include "kernnumt/pilot.h"
-#if defined(CERNLIB_NEVER)
- SUBROUTINE C204CH(NA,A,ROOT,NREP,OK)
- DIMENSION A(NA),ROOT(NA)
- COMPLEX ROOT,SUM,VSUM
-#include "kernnumt/sysdat.inc"
- LOGICAL OK,OKT
-#if defined(CERNLIB_IBMRT)
- EXTERNAL CABS
-#endif
- OK=.TRUE.
-C
-C ROOTS OF TRUNCATED EXPONENTIAL SERIES WITH DEGREE 1,...,NA
-C
- REL=RELPR*1.E3
- DO 20 JREP = 1, NREP
- DO 10 N = 1, NA
- A(N+1)=1.
- J=N+1
- DO 2 I=1,N
- J=J-1
- 2 A(J)=A(J+1)/FLOAT(I)
- FL=FLOAT(N)
- VSUM=CMPLX(FL,0.)
- CALL MULLER(A,N,ROOT)
- SUM=0.
- DO 3 K=1,N
- 3 SUM=ROOT(K)+SUM
- D=CABS(SUM+VSUM)
- OKT=D.LE.REL*FL
- IF(.NOT.OKT) WRITE(*,100) N
- OK=OK.AND.OKT
- 10 CONTINUE
- 20 CONTINUE
- IF( ERPRNT .AND. ERSTOP) WRITE(*,101)
- IF( ERPRNT .AND. .NOT. ERSTOP) WRITE(*,102)
- IF(.NOT. ERPRNT .AND. ERSTOP) WRITE(*,103)
- N = 0
- CALL MULLER(A,N,ROOT)
- N = NA
- A(1) = 0.
- CALL MULLER(A,N,ROOT)
- RETURN
- 100 FORMAT(36HC204CH ARITHMETIC ERROR AT DEGREE N=, I5)
- 101 FORMAT(/' TWO ERROR AND ABEND MESSAGES SHOULD NOW FOLLOW ...')
- 102 FORMAT(/' TWO ERROR MESSAGES SHOULD NOW FOLLOW ...')
- 103 FORMAT(/' TWO ABEND MESSAGES SHOULD NOW FOLLOW ...')
- END
-#endif
diff --git a/src/packlib/kernlib/kernnum/test/obsolete/numchk2/c300ch.F b/src/packlib/kernlib/kernnum/test/obsolete/numchk2/c300ch.F
deleted file mode 100644
index 3a05137..0000000
--- a/src/packlib/kernlib/kernnum/test/obsolete/numchk2/c300ch.F
+++ /dev/null
@@ -1,61 +0,0 @@
-*
-* $Id: c300ch.F,v 1.1.1.1 1996/02/15 17:48:39 mclareni Exp $
-*
-* $Log: c300ch.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:39 mclareni
-* Kernlib
-*
-*
-#include "kernnumt/pilot.h"
-#if defined(CERNLIB_NEVER)
- SUBROUTINE C300CH(NREP,OKPK)
- LOGICAL OKPK
-#include "kernnumt/sysdat.inc"
-C
- DATA RELPR2/ 1.E-15 /
-C (RELPR2 IS THE PRECISION THRESHOLD FOR THE DOUBLE PRECISION ENTRIES)
- DATA MRATIO/ 10 /
-#if defined(CERNLIB_NUME38)
- DATA NTAB/91/
-#endif
-#if !defined(CERNLIB_NUME38)
- DATA NTAB/99/
-#endif
-C
-C TEST-ROUTINE FOR C300 (ERF,ERFC,FREQ,DERF,DERFC,DFREQ).
-C CALLS ... FUNCTIONS ERF, ERFC, FREQ, DERF, DERFC, DFREQ.
-C ... TEST-ROUTINES C300ER, C300GT.
-C START.
- OKPK=.FALSE.
- IF(NREP.LE.0) RETURN
- RATREF=MRATIO
- ITEST=0
- IFAIL=0
- RATMAX=0.
- DO 2 I=1,NTAB
- DO 1 ISIGN=1,2
- CALL C300ER('R',I,ISIGN,EREL,ECREL,F2REL)
- REL=MAX(EREL,ECREL,F2REL)
- RATIO=ABS(REL)/RELPR
- RATMAX=MAX(RATMAX,RATIO)
- IF(RATIO.GT.RATREF) IFAIL=IFAIL+1
- ITEST=ITEST+1
-#if defined(CERNLIB_NUMLOPRE)
- CALL C300ER('D',I,ISIGN,EREL,ECREL,F2REL)
- REL=MAX(EREL,ECREL,F2REL)
- RATIO=ABS(REL)/RELPR2
- RATMAX=MAX(RATMAX,RATIO)
- IF(RATIO.GT.RATREF) IFAIL=IFAIL+1
- ITEST=ITEST+1
-#endif
- 1 CONTINUE
- 2 CONTINUE
- OKPK=IFAIL.EQ.0
- IF(OKPK) RETURN
- WRITE(*,2000) IFAIL,ITEST,RATMAX
- RETURN
-C
- 2000 FORMAT( // 18H ***** C300CH ... , I4, 15H FAILURES IN ,
- * I4, 25H TESTS. RATMAX/RELPR = , 1P, E8.1 )
- END
-#endif
diff --git a/src/packlib/kernlib/kernnum/test/obsolete/numchk2/c300er.F b/src/packlib/kernlib/kernnum/test/obsolete/numchk2/c300er.F
deleted file mode 100644
index f24f6be..0000000
--- a/src/packlib/kernlib/kernnum/test/obsolete/numchk2/c300er.F
+++ /dev/null
@@ -1,57 +0,0 @@
-*
-* $Id: c300er.F,v 1.1.1.1 1996/02/15 17:48:39 mclareni Exp $
-*
-* $Log: c300er.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:39 mclareni
-* Kernlib
-*
-*
-#include "kernnumt/pilot.h"
-#if defined(CERNLIB_NEVER)
- SUBROUTINE C300ER(H,I,ISIGN,EREL,ECREL,F2REL)
- CHARACTER*1 H
- LOGICAL FIRST
- DOUBLE PRECISION CONST,X,CX,E,EC,F2,EREF,ECREF,F2REF
- DOUBLE PRECISION DERF,DERFC,DFREQ
-#if (defined(CERNLIB_NUMCD)||defined(CERNLIB_NUMIB1)||defined(CERNLIB_NUMIB2)||defined(CERNLIB_NUMUC))&&(defined(CERNLIB_NUMOWNCODE))
- EXTERNAL ERF,ERFC,DERF,DERFC
-#endif
- DATA FIRST/.TRUE./
-C
-C USING X=X(I) TAKEN FROM THE TABLE IN SUBROUTINE C300GT (WITH NEG-
-C ATIVE SIGN IF ISIGN=2), SETS EREL, ECREL, F2REL TO THE APPROPRI-
-C ATELY WEIGHTED RELATIVE ERRORS IN THE FUNCTION VALUES ERF(X),
-C ERFC(X), FREQ(SQRT(2)*X), RESPECTIVELY.
-C
-C CALLS ... FUNCTIONS ERF, ERFC, FREQ, DERF, DERFC, DFREQ.
-C ... TEST-ROUTINE C300GT.
-C
-C START.
- IF(FIRST) CONST=DSQRT(2D0)
- FIRST=.FALSE.
- CALL C300GT(I,ISIGN,X,EREF,ECREF,F2REF)
- RX=X
- CX=CONST*X
- RCX=CX
- IF(H.EQ.'R') THEN
- E=ERF(RX)
- EC=ERFC(RX)
- F2=FREQ(RCX)
-#if defined(CERNLIB_NUMLOPRE)
- ELSE
- E=DERF(X)
- EC=DERFC(X)
- F2=DFREQ(CX)
-#endif
- ENDIF
- EREL=E-EREF
- ECREL=EC-ECREF
- F2REL=F2-F2REF
- IF(EREF.NE.0D0) EREL=EREL/DABS(EREF)
- IF(ECREF.NE.0D0) ECREL=ECREL/DABS(ECREF)
- IF(F2REF.NE.0D0) F2REL=F2REL/DABS(F2REF)
- IF(RX.GE.0.) ECREL=ECREL/(1.+RX**2)
- IF(RX.LT.0.) F2REL=F2REL/(1.+RX**2)
- RETURN
- END
-#endif
diff --git a/src/packlib/kernlib/kernnum/test/obsolete/numchk2/c300gt.F b/src/packlib/kernlib/kernnum/test/obsolete/numchk2/c300gt.F
deleted file mode 100644
index eb4ad5c..0000000
--- a/src/packlib/kernlib/kernnum/test/obsolete/numchk2/c300gt.F
+++ /dev/null
@@ -1,162 +0,0 @@
-*
-* $Id: c300gt.F,v 1.1.1.1 1996/02/15 17:48:39 mclareni Exp $
-*
-* $Log: c300gt.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:39 mclareni
-* Kernlib
-*
-*
-#include "kernnumt/pilot.h"
-#if defined(CERNLIB_NEVER)
- SUBROUTINE C300GT(I,ISIGN,X,EREF,ECREF,F2REF)
- IMPLICIT DOUBLE PRECISION (A-H,O-Z)
- DIMENSION XTAB(100),YTAB(100)
- DATA NTAB/100/
-C
-C IF ISIGN.EQ.1 SETS X=XTAB(I).
-C IF ISIGN.EQ.2 SETS X=-XTAB(I).
-C SETS EREF=ERF(X), ECREF=ERFC(X), F2REF=FREQ(SQRT(2)*X), WHERE THE
-C XTAB(I) AND THE FUNCTION VALUES ARE TAKEN FROM THE TABLE OF DATA
-C STATEMENTS (PREVIOUSLY CONSTRUCTED BY PROGRAM ECWRITE).
-C
-C TABLE.
- DATA XTAB( 1)/.917534D+01/, YTAB( 1)/ .1676371373263653D-37/
- DATA XTAB( 2)/.443708D+00/, YTAB( 2)/ .4696670689209019D+00/
- DATA XTAB( 3)/.325435D+00/, YTAB( 3)/ .3546521550410488D+00/
- DATA XTAB( 4)/.953785D+00/, YTAB( 4)/ .1773833253302947D+00/
- DATA XTAB( 5)/.241720D-01/, YTAB( 5)/ .2726986999298563D-01/
- DATA XTAB( 6)/.170710D+00/, YTAB( 6)/ .1907706944951034D+00/
- DATA XTAB( 7)/.496750D+00/, YTAB( 7)/ .5176391984092610D+00/
- DATA XTAB( 8)/.113611D+00/, YTAB( 8)/ .1276468520075838D+00/
- DATA XTAB( 9)/.170011D+00/, YTAB( 9)/ .1900045197721693D+00/
- DATA XTAB( 10)/.118468D+01/, YTAB( 10)/ .9385763479811183D-01/
- DATA XTAB( 11)/.400029D+00/, YTAB( 11)/ .4284202394208670D+00/
- DATA XTAB( 12)/.463354D+00/, YTAB( 12)/ .4877134774720710D+00/
- DATA XTAB( 13)/.784774D+01/, YTAB( 13)/ .1277377188008478D-27/
- DATA XTAB( 14)/.409844D+00/, YTAB( 14)/ .4378202902930709D+00/
- DATA XTAB( 15)/.257202D+00/, YTAB( 15)/ .2839467513613266D+00/
- DATA XTAB( 16)/.584129D+01/, YTAB( 16)/ .1446611273515512D-15/
- DATA XTAB( 17)/.165450D+00/, YTAB( 17)/ .1850007630301463D+00/
- DATA XTAB( 18)/.405904D+00/, YTAB( 18)/ .4340558435695968D+00/
- DATA XTAB( 19)/.678301D+01/, YTAB( 19)/ .8587216485742127D-21/
- DATA XTAB( 20)/.131452D+00/, YTAB( 20)/ .1474777597992756D+00/
- DATA XTAB( 21)/.399609D+00/, YTAB( 21)/ .4280163336112963D+00/
- DATA XTAB( 22)/.719236D-01/, YTAB( 22)/ .8101736677809329D-01/
- DATA XTAB( 23)/.801624D-01/, YTAB( 23)/ .9026020320336464D-01/
- DATA XTAB( 24)/.316115D+00/, YTAB( 24)/ .3451640158076886D+00/
- DATA XTAB( 25)/.110325D+01/, YTAB( 25)/ .1187052757341097D+00/
- DATA XTAB( 26)/.183969D+00/, YTAB( 26)/ .2052684780282969D+00/
- DATA XTAB( 27)/.200078D+00/, YTAB( 27)/ .2227871504045401D+00/
- DATA XTAB( 28)/.597662D+01/, YTAB( 28)/ .2858225799027289D-16/
- DATA XTAB( 29)/.228525D+00/, YTAB( 29)/ .2534434621564421D+00/
- DATA XTAB( 30)/.231465D+00/, YTAB( 30)/ .2565899708120994D+00/
- DATA XTAB( 31)/.168515D+01/, YTAB( 31)/ .1716463961002001D-01/
- DATA XTAB( 32)/.256622D+00/, YTAB( 32)/ .2833340935618121D+00/
- DATA XTAB( 33)/.471115D+00/, YTAB( 33)/ .4947532969229083D+00/
- DATA XTAB( 34)/.164010D+01/, YTAB( 34)/ .2037055912411078D-01/
- DATA XTAB( 35)/.276759D+00/, YTAB( 35)/ .3044956963291484D+00/
- DATA XTAB( 36)/.233049D+00/, YTAB( 36)/ .2582834617301759D+00/
- DATA XTAB( 37)/.482360D+01/, YTAB( 37)/ .9003172523514829D-11/
- DATA XTAB( 38)/.298440D+00/, YTAB( 38)/ .3270172406081429D+00/
- DATA XTAB( 39)/.135617D+00/, YTAB( 39)/ .1520943928223444D+00/
- DATA XTAB( 40)/.133854D+01/, YTAB( 40)/ .5836034014253724D-01/
- DATA XTAB( 41)/.334745D+00/, YTAB( 41)/ .3640728256113021D+00/
- DATA XTAB( 42)/.438535D+00/, YTAB( 42)/ .4648621244359200D+00/
- DATA XTAB( 43)/.880946D+01/, YTAB( 43)/ .1257794187408745D-34/
- DATA XTAB( 44)/.189212D+00/, YTAB( 44)/ .2109821274364948D+00/
- DATA XTAB( 45)/.937724D-01/, YTAB( 45)/ .1055014982462454D+00/
- DATA XTAB( 46)/.123848D+00/, YTAB( 46)/ .1390362812367687D+00/
- DATA XTAB( 47)/.250532D+00/, YTAB( 47)/ .2768902426361637D+00/
- DATA XTAB( 48)/.435657D+00/, YTAB( 48)/ .4621794224069148D+00/
- DATA XTAB( 49)/.211924D+00/, YTAB( 49)/ .2355984220670371D+00/
- DATA XTAB( 50)/.257939D+00/, YTAB( 50)/ .2847249855776238D+00/
- DATA XTAB( 51)/.468113D+00/, YTAB( 51)/ .4920363107479127D+00/
- DATA XTAB( 52)/.684849D+01/, YTAB( 52)/ .3484321315524656D-21/
- DATA XTAB( 53)/.428405D-01/, YTAB( 53)/ .4831077084644222D-01/
- DATA XTAB( 54)/.349104D-02/, YTAB( 54)/ .3939200804670809D-02/
- DATA XTAB( 55)/.529556D+01/, YTAB( 55)/ .6937244552912752D-13/
- DATA XTAB( 56)/.242891D+00/, YTAB( 56)/ .2687774684053429D+00/
- DATA XTAB( 57)/.361056D+00/, YTAB( 57)/ .3903760322920853D+00/
- DATA XTAB( 58)/.341639D+01/, YTAB( 58)/ .1355047657224369D-05/
- DATA XTAB( 59)/.193337D+00/, YTAB( 59)/ .2154694715212153D+00/
- DATA XTAB( 60)/.490651D+00/, YTAB( 60)/ .5122458560929465D+00/
- DATA XTAB( 61)/.781475D+01/, YTAB( 61)/ .2150415374192762D-27/
- DATA XTAB( 62)/.418332D+00/, YTAB( 62)/ .4458887518137371D+00/
- DATA XTAB( 63)/.365366D-02/, YTAB( 63)/ .4122695482703374D-02/
- DATA XTAB( 64)/.816031D+00/, YTAB( 64)/ .2484829061485597D+00/
- DATA XTAB( 65)/.308077D+00/, YTAB( 65)/ .3369359227204185D+00/
- DATA XTAB( 66)/.295853D+00/, YTAB( 66)/ .3243448200464001D+00/
- DATA XTAB( 67)/.196144D+00/, YTAB( 67)/ .2185189606135350D+00/
- DATA XTAB( 68)/.214419D+00/, YTAB( 68)/ .2382886566807954D+00/
- DATA XTAB( 69)/.206053D+00/, YTAB( 69)/ .2292568392047439D+00/
- DATA XTAB( 70)/.487353D+01/, YTAB( 70)/ .5493133987860958D-11/
- DATA XTAB( 71)/.577190D-01/, YTAB( 71)/ .6505666408085011D-01/
- DATA XTAB( 72)/.124564D+00/, YTAB( 72)/ .1398318324566679D+00/
- DATA XTAB( 73)/.835124D+01/, YTAB( 73)/ .3447652187669018D-31/
- DATA XTAB( 74)/.270668D+00/, YTAB( 74)/ .2981188555376397D+00/
- DATA XTAB( 75)/.149457D+00/, YTAB( 75)/ .1673968448379378D+00/
- DATA XTAB( 76)/.465863D+01/, YTAB( 76)/ .4448978249281597D-10/
- DATA XTAB( 77)/.338135D+00/, YTAB( 77)/ .3674886523173324D+00/
- DATA XTAB( 78)/.352951D+00/, YTAB( 78)/ .3823249396434660D+00/
- DATA XTAB( 79)/.161540D+01/, YTAB( 79)/ .2234095399787408D-01/
- DATA XTAB( 80)/.202682D+00/, YTAB( 80)/ .2256086726378163D+00/
- DATA XTAB( 81)/.457367D+00/, YTAB( 81)/ .4822480672698303D+00/
- DATA XTAB( 82)/.101656D+01/, YTAB( 82)/ .1505382298224469D+00/
- DATA XTAB( 83)/.406001D+00/, YTAB( 83)/ .4341486666930002D+00/
- DATA XTAB( 84)/.862220D-01/, YTAB( 84)/ .9705055036924218D-01/
- DATA XTAB( 85)/.146177D+01/, YTAB( 85)/ .3871013595458409D-01/
- DATA XTAB( 86)/.354186D+00/, YTAB( 86)/ .3835547284199477D+00/
- DATA XTAB( 87)/.451218D+00/, YTAB( 87)/ .4766035302472280D+00/
- DATA XTAB( 88)/.344042D+00/, YTAB( 88)/ .3734219296483067D+00/
- DATA XTAB( 89)/.315927D+00/, YTAB( 89)/ .3449720427714967D+00/
- DATA XTAB( 90)/.100722D+00/, YTAB( 90)/ .1132694411057261D+00/
- DATA XTAB( 91)/.550044D+00/, YTAB( 91)/ .4366399457502890D+00/
-#if !defined(CERNLIB_NUMD38)
- DATA XTAB( 92)/.113232D+02/, YTAB( 92)/ .1029847777887544D-56/
- DATA XTAB( 93)/.108756D+02/, YTAB( 93)/ .2215026448145411D-52/
- DATA XTAB( 94)/.100892D+02/, YTAB( 94)/ .3449654485465253D-45/
- DATA XTAB( 95)/.113914D+02/, YTAB( 95)/ .2174722536864140D-57/
- DATA XTAB( 96)/.104325D+02/, YTAB( 96)/ .2908914569100026D-48/
- DATA XTAB( 97)/.102246D+02/, YTAB( 97)/ .2175298337170668D-46/
- DATA XTAB( 98)/.104371D+02/, YTAB( 98)/ .2641489538998184D-48/
- DATA XTAB( 99)/.107497D+02/, YTAB( 99)/ .3410472643765532D-51/
-#endif
- DATA XTAB( 100)/.400000D+02/, YTAB( 100)/0. /
-C
-C START.
- IF(I.GT.NTAB) GO TO 100
- X=XTAB(I)
- Y=YTAB(I)
- IF(ISIGN.EQ.2) X=-X
- IF(ABS(X).GT.0.5D0) GO TO 1
-C
-C (ABS(X).LE.0.5).
- IF(ISIGN.EQ.2) Y=-Y
- EREF=Y
- ECREF=1D0-Y
- F2REF=0.5D0+0.5D0*Y
- RETURN
-C
-C (ABS(X).GT.0.5).
- 1 IF(ISIGN.EQ.2) GO TO 2
-C (X.GE.0).
- EREF=1D0-Y
- ECREF=Y
- F2REF=1D0-0.5D0*Y
- RETURN
-C (X.LT.0).
- 2 EREF=Y-1D0
- ECREF=2D0-Y
- F2REF=0.5D0*Y
- RETURN
-C
-C ERROR MESSAGE.
- 100 WRITE(*,2000) I,NTAB
- RETURN
-C
- 2000 FORMAT( // 21H ***** C300GT ... I =, I6,
- * 17H EXCEEDS NTAB =, I6 / )
- END
-#if defined(CERNLIB_NUMTIME)
-#endif
-#endif
diff --git a/src/packlib/kernlib/kernnum/test/obsolete/numchk2/c300tm.F b/src/packlib/kernlib/kernnum/test/obsolete/numchk2/c300tm.F
deleted file mode 100644
index ad16b83..0000000
--- a/src/packlib/kernlib/kernnum/test/obsolete/numchk2/c300tm.F
+++ /dev/null
@@ -1,38 +0,0 @@
-*
-* $Id: c300tm.F,v 1.1.1.1 1996/02/15 17:48:39 mclareni Exp $
-*
-* $Log: c300tm.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:39 mclareni
-* Kernlib
-*
-*
-#include "kernnumt/pilot.h"
-#if defined(CERNLIB_NEVER)
- SUBROUTINE C300TM(KNT,A,R)
- REAL A(KNT), R(KNT)
-#include "kernnumt/sysdat.inc"
- DATA RANGE / 2. /
- IF(KNTIME .GE. LMTIME) GOTO 80
- X = -RANGE/2.
- XINC = RANGE / FLOAT(KNT-1)
- DO 10 I = 1, KNT
- A(I) = X
- X = X + XINC
- 10 CONTINUE
- CALL TIMEX(T0)
- DO 20 I = 1, KNT
- R(I) = ERF(A(I))
- 20 CONTINUE
- CALL TIMEX(T1)
- T = (T1-T0) / FLOAT(KNT)
- KNTIME = KNTIME + 1
- WRITE( SPTIME(KNTIME), 8000 ) T
- RETURN
-
- 80 WRITE(*,8001)
- RETURN
-
-8000 FORMAT(12HC300 ERF ,8X,1PE10.3)
-8001 FORMAT( / 30H SPACE FOR TIMING INSUFFICIENT)
- END
-#endif
diff --git a/src/packlib/kernlib/kernnum/test/obsolete/numchk2/d103ch.F b/src/packlib/kernlib/kernnum/test/obsolete/numchk2/d103ch.F
deleted file mode 100644
index 769667d..0000000
--- a/src/packlib/kernlib/kernnum/test/obsolete/numchk2/d103ch.F
+++ /dev/null
@@ -1,138 +0,0 @@
-*
-* $Id: d103ch.F,v 1.1.1.1 1996/02/15 17:48:39 mclareni Exp $
-*
-* $Log: d103ch.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:39 mclareni
-* Kernlib
-*
-*
-#include "kernnumt/pilot.h"
-#if defined(CERNLIB_NEVER)
- SUBROUTINE D103CH(NREP,OKPK)
- EXTERNAL D103F1,D103F2
- LOGICAL OKPK,OKFN1(10),OKFN2(10)
- DOUBLE PRECISION DGAUSS,D103F2
- DOUBLE PRECISION PI,A,B,P,Q,EPS2,ERR2,EXACT,APPRX2
- DIMENSION MRATIO(2),ERR1(10),ERR2(10)
-#include "kernnumt/sysdat.inc"
- COMMON /D103CM/DMY,NFN,A,B,P,Q
- DATA MRATIO/ 20, 200 /
-C
-C TEST-ROUTINE FOR D103 (GAUSS, DGAUSS).
-C CALLS ... FUNCTIONS GAUSS, DGAUSS.
-C ... TEST-FUNCTIONS D103F1, D103F2.
-C
-C START.
- OKPK=.FALSE.
- IF(NREP.LE.0) RETURN
- EPS1=MRATIO(1)*RELPRT(1)
- EPS2=MRATIO(2)*RELPRT(2)
- PI=4.D0*DATAN(1.D0)
- NFN=0
-C
-C 1. SHARP PEAK.
- NFN=NFN+1
- A=0.5D0
- B=0.1D0
- P=100.D0
- Q=0.2D0
- EXACT=-SQRT(PI)
- A1=A
- B1=B
- P1=P
- Q1=Q
- EXACT1=EXACT
- APPRX1=GAUSS(D103F1,A1,B1,EPS1)
- ERR1(NFN)=ABS(APPRX1-EXACT1)
- OKFN1(NFN)=ERR1(NFN).LT.EPS1
- APPRX2=DGAUSS(D103F2,A,B,EPS2)
- ERR2(NFN)=ABS(APPRX2-EXACT)
- OKFN2(NFN)=ERR2(NFN).LT.EPS2
-C
-C 2. NON-POLYNOMIAL END-POINTS.
- NFN=NFN+1
- A=0.5D0
- B=-1.5D0
- P=1.D0
- EXACT=SIGN(0.125D0,B-A)*P*PI*(B-A)**2
- A1=A
- B1=B
- P1=P
- EXACT1=EXACT
- APPRX1=GAUSS(D103F1,A1,B1,EPS1)
- ERR1(NFN)=ABS(APPRX1-EXACT1)
- OKFN1(NFN)=ERR1(NFN).LT.EPS1
- APPRX2=DGAUSS(D103F2,A,B,EPS2)
- ERR2(NFN)=ABS(APPRX2-EXACT)
- OKFN2(NFN)=ERR2(NFN).LT.EPS2
-C
-C 3. OSCILLATORY FUNCTION (ABSOLUTE ERROR CRITERION).
- NFN=NFN+1
- A=0.D0
- B=1.5D0*PI
- P=1.D0
- Q=10.D0
- EXACT=0.D0
- A1=A
- B1=B
- P1=P
- Q1=Q
- EXACT1=EXACT
- APPRX1=GAUSS(D103F1,A1,B1,EPS1)
- ERR1(NFN)=ABS(APPRX1-EXACT1)
- OKFN1(NFN)=ERR1(NFN).LT.EPS1
- APPRX2=DGAUSS(D103F2,A,B,EPS2)
- ERR2(NFN)=ABS(APPRX2-EXACT)
- OKFN2(NFN)=ERR2(NFN).LT.EPS2
-C
-C 4. OSCILLATORY FUNCTION (RELATIVE ERROR CRITERION).
- NFN=NFN+1
- A=0.D0
- B=-1.5D0*PI
- P=1.D20
- Q=12.D0
- EXACT=P*(B-A)
- A1=A
- B1=B
- P1=P
- Q1=Q
- EXACT1=EXACT
- APPRX1=GAUSS(D103F1,A1,B1,EPS1)
- ERR1(NFN)=ABS((APPRX1-EXACT1)/EXACT1)
- OKFN1(NFN)=ERR1(NFN).LT.EPS1
- APPRX2=DGAUSS(D103F2,A,B,EPS2)
- ERR2(NFN)=ABS((APPRX2-EXACT)/EXACT)
- OKFN2(NFN)=ERR2(NFN).LT.EPS2
-C
-C CHECK FOR ERRORS.
- OKPK=.TRUE.
- DO 1 I=1,NFN
- OKPK=OKPK.AND.OKFN1(I).AND.OKFN2(I)
- 1 CONTINUE
- IF(.NOT.OKPK) THEN
- WRITE(*,2000)
- DO 2 I=1,NFN
- IF(.NOT.OKFN1(I)) WRITE(*,2001) I,ERR1(I),EPS1
- IF(.NOT.OKFN2(I)) WRITE(*,2002) I,ERR2(I),EPS2
- 2 CONTINUE
- ENDIF
-C
-C PRINT ERROR MESSAGES.
- IF( ERPRNT .AND. ERSTOP) WRITE(*,2003)
- IF( ERPRNT .AND. .NOT. ERSTOP) WRITE(*,2004)
- IF( .NOT. ERPRNT .AND. ERSTOP) WRITE(*,2005)
- NFN=NFN+1
- A=1.D0
- B=0.D0
- APPRX1=GAUSS(D103F1,A1,B1,EPS1)
- APPRX2=DGAUSS(D103F2,A,B,EPS2)
- RETURN
-C
- 2000 FORMAT( // ' ***** D103CH ... TEST FAILURE.' )
- 2001 FORMAT( 4X, 'NFN =', I2, 4X, 'ERR1 =', 1PE9.1, 4X, 'EPS1 =', E9.1)
- 2002 FORMAT( 4X, 'NFN =', I2, 4X, 'ERR2 =', 1PD9.1, 4X, 'EPS2 =', D9.1)
- 2003 FORMAT( / ' TWO ERROR AND ABEND MESSAGES SHOULD NOW FOLLOW ...' )
- 2004 FORMAT( / ' TWO ERROR MESSAGES SHOULD NOW FOLLOW ...' )
- 2005 FORMAT( / ' TWO ABEND MESSAGES SHOULD NOW FOLLOW ...' )
- END
-#endif
diff --git a/src/packlib/kernlib/kernnum/test/obsolete/numchk2/d103f1.F b/src/packlib/kernlib/kernnum/test/obsolete/numchk2/d103f1.F
deleted file mode 100644
index 75e9572..0000000
--- a/src/packlib/kernlib/kernnum/test/obsolete/numchk2/d103f1.F
+++ /dev/null
@@ -1,39 +0,0 @@
-*
-* $Id: d103f1.F,v 1.1.1.1 1996/02/15 17:48:39 mclareni Exp $
-*
-* $Log: d103f1.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:39 mclareni
-* Kernlib
-*
-*
-#include "kernnumt/pilot.h"
-#if defined(CERNLIB_NEVER)
- FUNCTION D103F1(X)
- DOUBLE PRECISION A2,B2,P2,Q2
- COMMON /D103CM/DMY,NFN,A2,B2,P2,Q2
-C
-C INTEGRAND FOR SUBPROGRAM GAUSS.
-C
-C START.
-C
- A=A2
- B=B2
- P=P2
- Q=Q2
-C
-C SHARP PEAK.
- IF( NFN.EQ.1 ) D103F1 = P*EXP( MAX( -(P*(X-Q))**2, -100. ) )
-C
-C NON-POLYONOMIAL END-POINTS.
- IF( NFN.EQ.2 ) D103F1= 0.5*P*SQRT( (B-A)**2 - (2.*X-B-A)**2 )
-C
-C OSCILLATORY FUNCTION.
- IF( NFN.EQ.3 .OR. NFN.EQ.4 ) D103F1 = P*(SIN(X)**2)*COS(Q*X)
- IF( NFN.EQ.4 ) D103F1 = D103F1 + P
-C
-C ERROR CONDITION (SINGULARITY).
- IF ( NFN.EQ.5) D103F1 = 1./X**2
-C
- RETURN
- END
-#endif
diff --git a/src/packlib/kernlib/kernnum/test/obsolete/numchk2/d103f2.F b/src/packlib/kernlib/kernnum/test/obsolete/numchk2/d103f2.F
deleted file mode 100644
index 17ac9bc..0000000
--- a/src/packlib/kernlib/kernnum/test/obsolete/numchk2/d103f2.F
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: d103f2.F,v 1.1.1.1 1996/02/15 17:48:40 mclareni Exp $
-*
-* $Log: d103f2.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:40 mclareni
-* Kernlib
-*
-*
-#include "kernnumt/pilot.h"
-#if defined(CERNLIB_NEVER)
- DOUBLE PRECISION FUNCTION D103F2(X)
- DOUBLE PRECISION X,A,B,P,Q
- COMMON /D103CM/DMY,NFN,A,B,P,Q
-C
-C INTEGRAND FOR SUBPROGRAM DGAUSS.
-C
-C START.
-C
-C SHARP PEAK.
- IF( NFN.EQ.1 ) D103F2 = P*EXP( MAX( -(P*(X-Q))**2, -100.D0 ) )
-C
-C NON-POLYONOMIAL END-POINTS.
- IF( NFN.EQ.2 ) D103F2= 0.5D0*P*SQRT( (B-A)**2 - (2.D0*X-B-A)**2 )
-C
-C OSCILLATORY FUNCTION.
- IF( NFN.EQ.3 .OR. NFN.EQ.4 ) D103F2 = P*(SIN(X)**2)*COS(Q*X)
- IF( NFN.EQ.4 ) D103F2 = D103F2 + P
-C
-C ERROR CONDITION (SINGULARITY).
- IF ( NFN.EQ.5) D103F2 = 1.D0/X**2
-C
- RETURN
- END
-#endif
diff --git a/src/packlib/kernlib/kernnum/test/obsolete/numchk2/d106ch.F b/src/packlib/kernlib/kernnum/test/obsolete/numchk2/d106ch.F
deleted file mode 100644
index d568196..0000000
--- a/src/packlib/kernlib/kernnum/test/obsolete/numchk2/d106ch.F
+++ /dev/null
@@ -1,88 +0,0 @@
-*
-* $Id: d106ch.F,v 1.1.1.1 1996/02/15 17:48:40 mclareni Exp $
-*
-* $Log: d106ch.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:40 mclareni
-* Kernlib
-*
-*
-#include "kernnumt/pilot.h"
-#if defined(CERNLIB_NEVER)
- SUBROUTINE D106CH(NREP,X,W,OKPK)
- LOGICAL OKPK
- EXTERNAL D106FN
- DIMENSION X(2),W(2),NTAB(24),ATAB(5),BTAB(5)
-#include "kernnumt/sysdat.inc"
- COMMON /D106CM/IFN,A,B
- DATA NTAB/2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,20,24,32,40,48,64,
- + 80,96,-999/
- DATA ATAB/-1.0,-1.0,-1.0,0.1,-0.2/
- DATA BTAB/+1.0,+1.0,+1.0,1.8,-1.7/
-#if defined(CERNLIB_NUMCR1)||defined(CERNLIB_NUMCV1)
- DATA MRATIO/100/
-#endif
-#if (!defined(CERNLIB_NUMCR1))&&(!defined(CERNLIB_NUMCV1))
- DATA MRATIO/50/
-#endif
-C
-C TEST-ROUTINE FOR D106 (GQUAD,GSET).
-C CALLS ... FUNCTION GQUAD, SUBROUTINE GSET.
-C ... FUNCTION D106FN.
-C
-C START.
- OKPK=.FALSE.
- IF(NREP.LE.0) RETURN
- EPS=RELPR*FLOAT(MRATIO)
- ITEST=0
- IFAIL=0
- RELMAX=0.
- DO 3 JN=1,50
- N=NTAB(JN)
- IF(N.LT.0) GO TO 4
- IMAX=3
- IF(N.EQ.16) IMAX=5
- DO 2 IFN=1,IMAX
- A=ATAB(IFN)
- B=BTAB(IFN)
- CALL GSET(A,B,N,X,W)
-C (BEGIN EXPLICIT GAUSS SUM).
- QSUM=0.
- M=N/2
- DO 1 K=1,M
- WK=W(K)
- L=N-K+1
- IF(W(L).NE.WK) REL=1.
- QSUM = QSUM + WK*( D106FN(X(K)) + D106FN(X(L)) )
- 1 CONTINUE
- IF(N.NE.2*M) QSUM = QSUM + D106FN(X(M+1))
-C (END EXPLICIT GAUSS SUM).
- QGAUSS=GQUAD(D106FN,A,B,N)
- IF(QSUM.NE.QGAUSS) REL=1.
- IF(IFN.EQ.1) QREF=2D0
- IF(IFN.EQ.2) QREF=2D0/3D0
- IF(IFN.EQ.3) QREF=4D0/3D0
- IF(IFN.GE.4) QREF=DCOS(DBLE(A))-DCOS(DBLE(B))
- REL=(QGAUSS-QREF)/ABS(QREF)
- IF(ABS(REL).GE.EPS) IFAIL=IFAIL+1
- RELMAX=AMAX1(RELMAX,ABS(REL))
- ITEST=ITEST+1
- 2 CONTINUE
- 3 CONTINUE
- 4 OKPK=IFAIL.EQ.0
- RATIO=RELMAX/RELPR
- IF(.NOT.OKPK) WRITE(*,2000) IFAIL,ITEST,RATIO
- IF( ERPRNT .AND. ERSTOP) WRITE(*,1001)
- IF( ERPRNT .AND. .NOT. ERSTOP) WRITE(*,1002)
- IF(.NOT. ERPRNT .AND. ERSTOP) WRITE(*,1003)
- N = 1
- CALL GSET(A,B,N,X,W)
- N = 17
- QGAUSS = GQUAD(D106FN,A,B,N)
- RETURN
- 1001 FORMAT(/' TWO ERROR AND ABEND MESSAGES SHOULD NOW FOLLOW ...')
- 1002 FORMAT(/' TWO ERROR MESSAGES SHOULD NOW FOLLOW ...')
- 1003 FORMAT(/' TWO ABEND MESSAGES SHOULD NOW FOLLOW ...')
- 2000 FORMAT( // 18H ***** D106CH ... , I4, 15H FAILURES IN ,
- * I4, 25H TESTS. RELMAX/RELPR = , 1P, E8.1 )
- END
-#endif
diff --git a/src/packlib/kernlib/kernnum/test/obsolete/numchk2/d106fn.F b/src/packlib/kernlib/kernnum/test/obsolete/numchk2/d106fn.F
deleted file mode 100644
index 7cfa5a5..0000000
--- a/src/packlib/kernlib/kernnum/test/obsolete/numchk2/d106fn.F
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: d106fn.F,v 1.1.1.1 1996/02/15 17:48:40 mclareni Exp $
-*
-* $Log: d106fn.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:40 mclareni
-* Kernlib
-*
-*
-#include "kernnumt/pilot.h"
-#if defined(CERNLIB_NEVER)
- REAL FUNCTION D106FN(X)
- DOUBLE PRECISION XD,D
- COMMON /D106CM/IFN,A,B
-C
-C SINGLE-PRECISION INTEGRAND FOR D106 TESTS.
-C
-C STATEMENT FUNCTION.
- RND(D)=SNGL(D+(D-DBLE(SNGL(D))))
-C
-C START.
- XD=X
- IF(IFN.EQ.1) D=1D0
- IF(IFN.EQ.2) D=XD**2
- IF(IFN.EQ.3) D=1D0-XD**2
- IF(IFN.GE.4) D=DSIN(XD)
- D106FN=RND(D)
- RETURN
- END
-#endif
diff --git a/src/packlib/kernlib/kernnum/test/obsolete/numchk2/d209ch.F b/src/packlib/kernlib/kernnum/test/obsolete/numchk2/d209ch.F
deleted file mode 100644
index 426bd2c..0000000
--- a/src/packlib/kernlib/kernnum/test/obsolete/numchk2/d209ch.F
+++ /dev/null
@@ -1,104 +0,0 @@
-*
-* $Id: d209ch.F,v 1.1.1.1 1996/02/15 17:48:40 mclareni Exp $
-*
-* $Log: d209ch.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:40 mclareni
-* Kernlib
-*
-*
-#include "kernnumt/pilot.h"
-#if defined(CERNLIB_NEVER)
- SUBROUTINE D209CH(NREP,OKPK)
- LOGICAL OKPK
- EXTERNAL D209RR,D209RD
-#include "kernnumt/sysdat.inc"
- DOUBLE PRECISION DEPS,DXBGN,DH,DEMAX,DX,DXREF,DT
- DIMENSION Y1(4),YREF(4),W(4,3)
- DOUBLE PRECISION DY(4),DYREF(4),DW(4,3)
- DOUBLE PRECISION DA,DQ
- COMMON /D209CM/N,ITRANS,A(4),Q(4,4),DA(4),DQ(4,4)
- DATA EPS/1E-5/, DEPS/1D-15/
- DATA H/0.2/, DH/0.002D0/, DXBGN/0.1D0/
- DATA MSTPS/5/, MDSTPS/5/
-C
-C TEST-ROUTINE FOR D209 (RKSTP, DRKSTP).
-C CALLS ... SUBROUTINES RKSTP, DRKSTP.
-C ... CERN PACKAGES F002 AND F003.
-C ... TEST-ROUTINES D209SC, D209RR, D209RD, D209TR, D209TD.
-C
-C INTEGRATES A SYSTEM OF 1, 2, OR 4 DIFFERENTIAL EQUATIONS OVER MSTPS
-C INTERVALS OF LENGTH H. THE EQUATIONS MAY BE EITHER UNCOUPLED (ITRANS
-C =1) OR COUPLED BY THE APPLICATION OF AN ORTHOGONAL MATRIX TRANSFORMA-
-C TION (ITRANS=2). THE UNCOUPLED SYSTEM HAS BEEN ADJUSTED SO AS TO
-C GIVE APPROXIMATE ERROR EPS.
-C
-C START.
- OKPK=.FALSE.
- IF(NREP.LE.0) RETURN
- ITEST=0
- IFAIL=0
- EMAX=0.
- DEMAX=0D0
- DO 8 N=1,4
- IF(N.EQ.3) GO TO 8
- CALL D209SC
- DO 7 ITRANS=1,2
-C
-C (TEST RKSTP FOR ACCURACY).
- X=DXBGN
- XREF=DXBGN
- CALL D209TR(X,Y1)
- DO 1 M=1,MSTPS
- CALL RKSTP(N,H,X,Y1,D209RR,W)
- XREF=XREF+H
- 1 CONTINUE
- CALL D209TR(XREF,YREF)
- T=0.
- DO 2 J=1,N
- T=AMAX1( T, ABS(Y1(J)-YREF(J)) )
- 2 CONTINUE
- ITEST=ITEST+1
- IF( (T.GT.EPS).OR.(X.NE.XREF) ) IFAIL=IFAIL+1
- EMAX=AMAX1(EMAX,T)
-C
-C (TEST DRKSTP FOR ACCURACY).
- DX=DXBGN
- DXREF=DXBGN
- CALL D209TD(DX,DY)
- DO 5 M=1,MDSTPS
- CALL DRKSTP(N,DH,DX,DY,D209RD,DW)
- DXREF=DXREF+DH
- 5 CONTINUE
- CALL D209TD(DXREF,DYREF)
- DT=0D0
- DO 6 J=1,N
- DT=DMAX1( DT, DABS(DY(J)-DYREF(J)) )
- 6 CONTINUE
- ITEST=ITEST+1
- IF( (DT.GT.DEPS).OR.(DX.NE.DXREF) ) IFAIL=IFAIL+1
- DEMAX=DMAX1(DEMAX,DT)
-C
- 7 CONTINUE
- 8 CONTINUE
- OKPK=IFAIL.EQ.0
- IF(.NOT.OKPK) WRITE(*,2000) IFAIL,ITEST,EMAX,DEMAX
-#if !defined(CERNLIB_NUMDE)
- IF( ERPRNT .AND. ERSTOP) WRITE(*,1001)
- IF( ERPRNT .AND. .NOT. ERSTOP) WRITE(*,1002)
- IF(.NOT. ERPRNT .AND. ERSTOP) WRITE(*,1003)
- N = 0
- CALL RKSTP(N,H,X,Y1,D209RR,W)
- N = -1
- CALL DRKSTP(N,DH,DX,DY,D209RD,DW)
-#endif
- RETURN
-#if !defined(CERNLIB_NUMDE)
- 1001 FORMAT(/' TWO ERROR AND ABEND MESSAGES SHOULD NOW FOLLOW ...')
- 1002 FORMAT(/' TWO ERROR MESSAGES SHOULD NOW FOLLOW ...')
- 1003 FORMAT(/' TWO ABEND MESSAGES SHOULD NOW FOLLOW ...')
-#endif
- 2000 FORMAT( // 18H ***** D209CH ... , I4, 13H FAILURES IN,
- * I4, 8H TESTS., 5X, 6HEMAX =, 1P, E8.1, 5X,
- * 7HDEMAX =, D8.1 )
- END
-#endif
diff --git a/src/packlib/kernlib/kernnum/test/obsolete/numchk2/d209rd.F b/src/packlib/kernlib/kernnum/test/obsolete/numchk2/d209rd.F
deleted file mode 100644
index 1782c35..0000000
--- a/src/packlib/kernlib/kernnum/test/obsolete/numchk2/d209rd.F
+++ /dev/null
@@ -1,35 +0,0 @@
-*
-* $Id: d209rd.F,v 1.1.1.1 1996/02/15 17:48:40 mclareni Exp $
-*
-* $Log: d209rd.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:40 mclareni
-* Kernlib
-*
-*
-#include "kernnumt/pilot.h"
-#if defined(CERNLIB_NEVER)
- SUBROUTINE D209RD(DX,DY,DF)
- DOUBLE PRECISION DX,DY(4),DF(4),DU(4),DAJ
- DOUBLE PRECISION DA,DQ
- COMMON /D209CM/N,ITRANS,A(4),Q(4,4),DA(4),DQ(4,4)
-C
-C SUBROUTINE WHICH SETS RIGHT-HAND SIDES (DERIVATIVES) FOR DRKSTP.
-C CALLS ... CERN PACKAGES F002 AND F003.
-C
-C START.
- IF(ITRANS.EQ.1) CALL DVCPY(N,DY,DY(2),DU,DU(2))
- IF(ITRANS.EQ.2) CALL DMMPY(N,N,DQ,DQ(1,2),DQ(2,1),DY,DY(2),
- * DU,DU(2))
- DO 1 J=1,N
- DAJ=DA(J)
- IF(J.EQ.1) DU(J)=DAJ*DEXP(DAJ*DX)*DSQRT( DABS(1D0-DU(J)**2) )
- IF(J.EQ.2) DU(J)=DAJ/DCOS(DAJ*DX)**2
- IF(J.EQ.3) DU(J)=2D0*DAJ*DSQRT(DU(J))/(1D0+DAJ*DX)
- IF(J.EQ.4) DU(J)=DAJ*DU(J)*DCOS(DAJ*DX)
- 1 CONTINUE
- IF(ITRANS.EQ.1) CALL DVCPY(N,DU,DU(2),DF,DF(2))
- IF(ITRANS.EQ.2) CALL DMMPY(N,N,DQ,DQ(1,2),DQ(2,1),DU,DU(2),
- * DF,DF(2))
- RETURN
- END
-#endif
diff --git a/src/packlib/kernlib/kernnum/test/obsolete/numchk2/d209rr.F b/src/packlib/kernlib/kernnum/test/obsolete/numchk2/d209rr.F
deleted file mode 100644
index c6d2be3..0000000
--- a/src/packlib/kernlib/kernnum/test/obsolete/numchk2/d209rr.F
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: d209rr.F,v 1.1.1.1 1996/02/15 17:48:40 mclareni Exp $
-*
-* $Log: d209rr.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:40 mclareni
-* Kernlib
-*
-*
-#include "kernnumt/pilot.h"
-#if defined(CERNLIB_NEVER)
- SUBROUTINE D209RR(X,Y,F)
- DIMENSION Y(4),F(4),U(4)
- DOUBLE PRECISION DA,DQ
- COMMON /D209CM/N,ITRANS,A(4),Q(4,4),DA(4),DQ(4,4)
-C
-C SUBROUTINE WHICH SETS RIGHT-HAND SIDES (DERIVATIVES) FOR RKSTP AND
-C DRKSTP.
-C CALLS ... CERN PACKAGES F002 AND F003.
-C
-C START.
- IF(ITRANS.EQ.1) CALL RVCPY(N,Y,Y(2),U,U(2))
- IF(ITRANS.EQ.2) CALL RMMPY(N,N,Q,Q(1,2),Q(2,1),Y,Y(2),U,U(2))
- DO 1 J=1,N
- AJ=A(J)
- IF(J.EQ.1) U(J)=AJ*EXP(AJ*X)*SQRT( ABS(1.-U(J)**2) )
- IF(J.EQ.2) U(J)=AJ/COS(AJ*X)**2
- IF(J.EQ.3) U(J)=2.*AJ*SQRT(U(J))/(1.+AJ*X)
- IF(J.EQ.4) U(J)=AJ*U(J)*COS(AJ*X)
- 1 CONTINUE
- IF(ITRANS.EQ.1) CALL RVCPY(N,U,U(2),F,F(2))
- IF(ITRANS.EQ.2) CALL RMMPY(N,N,Q,Q(1,2),Q(2,1),U,U(2),F,F(2))
- RETURN
- END
-#endif
diff --git a/src/packlib/kernlib/kernnum/test/obsolete/numchk2/d209sc.F b/src/packlib/kernlib/kernnum/test/obsolete/numchk2/d209sc.F
deleted file mode 100644
index 83a873b..0000000
--- a/src/packlib/kernlib/kernnum/test/obsolete/numchk2/d209sc.F
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: d209sc.F,v 1.1.1.1 1996/02/15 17:48:40 mclareni Exp $
-*
-* $Log: d209sc.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:40 mclareni
-* Kernlib
-*
-*
-#include "kernnumt/pilot.h"
-#if defined(CERNLIB_NEVER)
- SUBROUTINE D209SC
- DIMENSION ADAT(4)
- DOUBLE PRECISION DADAT(4),DQDAT(4,4),DN,DS
- DOUBLE PRECISION DA,DQ
- COMMON /D209CM/N,ITRANS,A(4),Q(4,4),DA(4),DQ(4,4)
- DATA DQDAT/+1D0,+1D0,+1D0,+1D0,
- * +1D0,-1D0,+1D0,-1D0,
- * +1D0,+1D0,-1D0,-1D0,
- * +1D0,-1D0,-1D0,+1D0/
- DATA ADAT/ 0.25, 0.6, 0.03, 0.8 /
- DATA DADAT/ 0.25D0, 0.6D0, 0.002D0, 0.5D0 /
-C
-C SETS SCALING CONSTANTS IN ARRAY A (REAL) AND DA (DOUBLE PRECISION).
-C SETS AN ORTHOGONAL MATRIX IN ARRAY Q (REAL) AND DQ (DOUBLE PRE-
-C CISION).
-C CALLS ... CERN PACKAGES F002 AND F003.
-C
-C START.
- CALL RVCPY(4,ADAT,ADAT(2),A,A(2))
- CALL DVCPY(4,DADAT,DADAT(2),DA,DA(2))
- DN=N
- DS=1D0/DSQRT(DN)
- CALL DMSCL(4,4,DS,DQDAT,DQDAT(1,2),DQDAT(2,1),DQ,DQ(1,2),DQ(2,1))
- DO 2 I=1,N
- DO 1 J=1,N
- Q(I,J)=DQ(I,J)
- 1 CONTINUE
- 2 CONTINUE
- RETURN
- END
-#endif
diff --git a/src/packlib/kernlib/kernnum/test/obsolete/numchk2/d209td.F b/src/packlib/kernlib/kernnum/test/obsolete/numchk2/d209td.F
deleted file mode 100644
index 4bb9a9f..0000000
--- a/src/packlib/kernlib/kernnum/test/obsolete/numchk2/d209td.F
+++ /dev/null
@@ -1,37 +0,0 @@
-*
-* $Id: d209td.F,v 1.1.1.1 1996/02/15 17:48:40 mclareni Exp $
-*
-* $Log: d209td.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:40 mclareni
-* Kernlib
-*
-*
-#include "kernnumt/pilot.h"
-#if defined(CERNLIB_NEVER)
- SUBROUTINE D209TD(DX,DYR)
- DOUBLE PRECISION DX,DYR(4),DU(4),DTAN,DAJ
- DOUBLE PRECISION DA,DQ
- COMMON /D209CM/N,ITRANS,A(4),Q(4,4),DA(4),DQ(4,4)
-C
-C FOR J=1(1)N, SETS DYR(J) TO THE SOLUTION OF THE SYSTEM OF FIRST OR-
-C DER DIFFERENTIAL EQUATIONS WHOSE RIGHT-HAND SIDES ARE COMPUTED BY
-C SUBROUTINE D209RD.
-C CALLS ... CERN PACKAGES F002 AND F003.
-C
-C STATEMENT FUNCTION.
- DTAN(DX)=DSIN(DX)/DCOS(DX)
-C
-C START.
- DO 1 J=1,N
- DAJ=DA(J)
- IF(J.EQ.1) DU(J)=DSIN(DEXP(DAJ*DX))
- IF(J.EQ.2) DU(J)=DTAN(DAJ*DX)
- IF(J.EQ.3) DU(J)=DLOG(1D0+DAJ*DX)**2
- IF(J.EQ.4) DU(J)=DEXP(DSIN(DAJ*DX))
- 1 CONTINUE
- IF(ITRANS.EQ.1) CALL DVCPY(N,DU,DU(2),DYR,DYR(2))
- IF(ITRANS.EQ.2) CALL DMMPY(N,N,DQ,DQ(1,2),DQ(2,1),DU,DU(2),
- * DYR,DYR(2))
- RETURN
- END
-#endif
diff --git a/src/packlib/kernlib/kernnum/test/obsolete/numchk2/d209tr.F b/src/packlib/kernlib/kernnum/test/obsolete/numchk2/d209tr.F
deleted file mode 100644
index cde0f19..0000000
--- a/src/packlib/kernlib/kernnum/test/obsolete/numchk2/d209tr.F
+++ /dev/null
@@ -1,36 +0,0 @@
-*
-* $Id: d209tr.F,v 1.1.1.1 1996/02/15 17:48:40 mclareni Exp $
-*
-* $Log: d209tr.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:40 mclareni
-* Kernlib
-*
-*
-#include "kernnumt/pilot.h"
-#if defined(CERNLIB_NEVER)
- SUBROUTINE D209TR(X,YR)
- DIMENSION YR(4),U(4)
- DOUBLE PRECISION DA,DQ
- COMMON /D209CM/N,ITRANS,A(4),Q(4,4),DA(4),DQ(4,4)
-C
-C FOR J=1(1)N, SETS YR(J) TO THE SOLUTION OF THE SYSTEM OF FIRST OR-
-C DER DIFFERENTIAL EQUATIONS WHOSE RIGHT-HAND SIDES ARE COMPUTED BY
-C SUBROUTINE D209RH.
-C CALLS ... CERN PACKAGES F002 AND F003.
-C
-C STATEMENT FUNCTION.
- TAN(X)=SIN(X)/COS(X)
-C
-C START.
- DO 1 J=1,N
- AJ=A(J)
- IF(J.EQ.1) U(J)=SIN(EXP(AJ*X))
- IF(J.EQ.2) U(J)=TAN(AJ*X)
- IF(J.EQ.3) U(J)=ALOG(1.+AJ*X)**2
- IF(J.EQ.4) U(J)=EXP(SIN(AJ*X))
- 1 CONTINUE
- IF(ITRANS.EQ.1) CALL RVCPY(N,U,U(2),YR,YR(2))
- IF(ITRANS.EQ.2) CALL RMMPY(N,N,Q,Q(1,2),Q(2,1),U,U(2),YR,YR(2))
- RETURN
- END
-#endif
diff --git a/src/packlib/kernlib/kernnum/test/obsolete/numchk4/c305ch.F b/src/packlib/kernlib/kernnum/test/obsolete/numchk4/c305ch.F
deleted file mode 100644
index 39371c1..0000000
--- a/src/packlib/kernlib/kernnum/test/obsolete/numchk4/c305ch.F
+++ /dev/null
@@ -1,84 +0,0 @@
-*
-* $Id: c305ch.F,v 1.1.1.1 1996/02/15 17:48:40 mclareni Exp $
-*
-* $Log: c305ch.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:40 mclareni
-* Kernlib
-*
-*
-#include "kernnumt/pilot.h"
-#if defined(CERNLIB_NEVER)
- SUBROUTINE C305CH(OK)
- LOGICAL OK, OKR, OKD
- CHARACTER*3 ERRCNT
-#include "kernnumt/sysdat.inc"
-#if (!defined(CERNLIB_NUMIB)||defined(CERNLIB_NUMOWNCODE))&&(!defined(CERNLIB_NUMUC)||defined(CERNLIB_NUMOWNCODE))&&(!defined(CERNLIB_IBMRT)||defined(CERNLIB_NUMOWNCODE))
- REAL GAMMA, RF
- DOUBLE PRECISION DGAMMA, DF
- EXTERNAL GAMMA, DGAMMA
-#endif
-#if (defined(CERNLIB_NUMIB)||defined(CERNLIB_NUMUC)||defined(CERNLIB_IBMRT))&&(!defined(CERNLIB_NUMOWNCODE))
- INTRINSIC GAMMA, DGAMMA
-#endif
-#if (defined(CERNLIB_NUMIB)||defined(CERNLIB_IBMRT))&&(!defined(CERNLIB_NUMOWNCODE))
- PARAMETER(KNTSKP = 2)
-#endif
-#if (!defined(CERNLIB_NUMIB)||defined(CERNLIB_NUMOWNCODE))&&(!defined(CERNLIB_IBMRT)||defined(CERNLIB_NUMOWNCODE))
- PARAMETER(KNTSKP = 0)
-#endif
- PARAMETER(KOUNTX = 4)
- DOUBLE PRECISION X(KOUNTX), Y(KOUNTX)
- DATA
- + X(1)/-3.5D0/, Y(1)/+0.27008 82058 52269 10892 16255 213D+00/,
- + X(2)/-0.5D0/, Y(2)/-0.35449 07701 81103 20545 96334 967D+01/,
- + X(3)/+1.5D0/, Y(3)/+0.88622 69254 52758 01364 90837 417D+00/,
- + X(4)/+5.5D0/, Y(4)/+0.52342 77778 45535 20181 14900 849D+02/
-#if defined(CERNLIB_NUMHIPRE)
- RROUND = RELPRT(1)*10.
- DTRUNC = 1E-26
-#endif
-#if (defined(CERNLIB_NUMLOPRE))&&(defined(CERNLIB_NUMOWNCODE))
- RROUND = RELPRT(1)
- DTRUNC = 5E-17
-#endif
-#if (defined(CERNLIB_NUMLOPRE))&&(!defined(CERNLIB_NUMOWNCODE))&&(!defined(CERNLIB_NUMIB))&&(!defined(CERNLIB_NUMUC))&&(!defined(CERNLIB_IBMRT))
- RROUND = RELPRT(1)
- DTRUNC = 5E-17
-#endif
-#if (defined(CERNLIB_NUMLOPRE))&&(!defined(CERNLIB_NUMOWNCODE))&&(defined(CERNLIB_NUMIB)||defined(CERNLIB_NUMUC)||defined(CERNLIB_IBMRT))
- RROUND = RELPRT(1)*10.
- DTRUNC = 5E-17
-#endif
- DROUND = RELPRT(2)*10.
- RTRUNC = 5E-17
- M = 1 + KNTSKP
- N = KOUNTX - KNTSKP
- CALL DFEQDY(N,X(M),DGAMMA,Y(M),DTRUNC,DROUND,OKD)
- CALL RFEQDY(N,X(M), GAMMA,Y(M),RTRUNC,RROUND,OKR)
- OK = OKD .AND. OKR
-#if (!defined(CERNLIB_NUMIB)||defined(CERNLIB_NUMOWNCODE))&&(!defined(CERNLIB_NUMUC)||defined(CERNLIB_NUMOWNCODE))&&(!defined(CERNLIB_IBMRT)||defined(CERNLIB_NUMOWNCODE))
- ERRCNT = 'TWO'
- IF( ERPRNT .AND. ERSTOP) WRITE(*,101) ERRCNT
- IF( ERPRNT .AND. .NOT. ERSTOP) WRITE(*,102) ERRCNT
- IF(.NOT. ERPRNT .AND. ERSTOP) WRITE(*,103) ERRCNT
- RF = GAMMA(0.)
- IF(RF .NE. 0.) THEN
- OK = .FALSE.
- WRITE(*,104) 'GAMMA ', 'GAMMA ', RF, 'C305.1'
- ENDIF
- DF = DGAMMA(0.D0)
- IF(DF .NE. 0.D0) THEN
- OK = .FALSE.
- WRITE(*,104) 'DGAMMA', 'DGAMMA', DF, 'C305.2'
- ENDIF
-#endif
- RETURN
- 101 FORMAT(/2X,A3,' ERROR AND ABEND MESSAGE SHOULD NOW FOLLOW ...')
- 102 FORMAT(/2X,A3,' ERROR MESSAGE SHOULD NOW FOLLOW ...')
- 103 FORMAT(/2X,A3,' ABEND MESSAGE SHOULD NOW FOLLOW ...')
- 104 FORMAT(/' ????? TEST OF ',A6,' ... ',A6,' = ', E20.10,
- + ' ERROR CONDITION ', A6, ' NOT DETECTED.')
- 105 FORMAT(1P,' TEST VALUE =', D35.27,' DIFFERS FROM'/
- + ' REF. VALUE =', D35.27)
- END
-#endif
diff --git a/src/packlib/kernlib/kernnum/test/obsolete/numchk4/c308ch.F b/src/packlib/kernlib/kernnum/test/obsolete/numchk4/c308ch.F
deleted file mode 100644
index 487bb94..0000000
--- a/src/packlib/kernlib/kernnum/test/obsolete/numchk4/c308ch.F
+++ /dev/null
@@ -1,81 +0,0 @@
-*
-* $Id: c308ch.F,v 1.1.1.1 1996/02/15 17:48:40 mclareni Exp $
-*
-* $Log: c308ch.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:40 mclareni
-* Kernlib
-*
-*
-#include "kernnumt/pilot.h"
-#if defined(CERNLIB_NEVER)
- SUBROUTINE C308CH(OK)
- LOGICAL OK, OKK, OKE
- CHARACTER*4 ERRCNT
-#include "kernnumt/sysdat.inc"
- EXTERNAL ELLICK, ELLICE
- REAL ELLICK, ELLICE, RF
-#if defined(CERNLIB_NUMLOPRE)
- EXTERNAL DELLIK, DELLIE
- DOUBLE PRECISION DELLIK, DELLIE, DF
-#endif
- PARAMETER(KOUNTX = 1)
- DOUBLE PRECISION X(KOUNTX), EK(KOUNTX), EE(KOUNTX)
- DATA X / 0.75D0 /
- DATA EK / 0.19109 89780 7518D1 /
- DATA EE / 0.13184 72107 9946D1 /
- TRUNC = 5E-13
-#if defined(CERNLIB_NUMHIPRE)
- RROUND = RELPRT(1)*10.
- CALL RFEQDY(KOUNTX,X,ELLICK,EK,TRUNC,RROUND,OKK)
- CALL RFEQDY(KOUNTX,X,ELLICE,EE,TRUNC,RROUND,OKE)
- OK = OKK .AND. OKE
-#endif
-#if defined(CERNLIB_NUMLOPRE)
- RROUND = RELPRT(1)
- DROUND = RELPRT(2)*10.
- CALL RFEQDF(KOUNTX,X,ELLICK,DELLIK,TRUNC,RROUND,OKK)
- CALL RFEQDF(KOUNTX,X,ELLICE,DELLIE,TRUNC,RROUND,OKE)
- OK = OKK .AND. OKE
- CALL DFEQDY(KOUNTX,X,DELLIK,EK,TRUNC,DROUND,OKK)
- CALL DFEQDY(KOUNTX,X,DELLIE,EE,TRUNC,DROUND,OKE)
- OK = OK .AND. OKK .AND. OKE
-#endif
-#if defined(CERNLIB_NUMHIPRE)
- ERRCNT = ' TWO'
-#endif
-#if defined(CERNLIB_NUMLOPRE)
- ERRCNT = 'FOUR'
-#endif
- IF( ERPRNT .AND. ERSTOP) WRITE(*,101) ERRCNT
- IF( ERPRNT .AND. .NOT. ERSTOP) WRITE(*,102) ERRCNT
- IF(.NOT. ERPRNT .AND. ERSTOP) WRITE(*,103) ERRCNT
- RF = ELLICK(1.)
- IF(RF .NE. 0.) THEN
- OK = .FALSE.
- WRITE(*,104) 'ELLICK','ELLICK',RF, 'C308.1'
- ENDIF
- RF = ELLICE(-1.001)
- IF(RF .NE. 0.) THEN
- OK = .FALSE.
- WRITE(*,104) 'ELLICE','ELLICE',RF, 'C308.1'
- ENDIF
-#if defined(CERNLIB_NUMLOPRE)
- DF = DELLIK(1.D0)
- IF(DF .NE. 0.D0) THEN
- OK = .FALSE.
- WRITE(*,104) 'DELLIK','DELLIK',DF, 'C308.1'
- ENDIF
- DF = DELLIE(-1.001D0)
- IF(DF .NE. 0.D0) THEN
- OK = .FALSE.
- WRITE(*,104) 'DELLIE','DELLIE',DF, 'C308.1'
- ENDIF
-#endif
- RETURN
- 101 FORMAT(/2X,A4,' ERROR AND ABEND MESSAGES SHOULD NOW FOLLOW ...')
- 102 FORMAT(/2X,A4,' ERROR MESSAGES SHOULD NOW FOLLOW ...')
- 103 FORMAT(/2X,A4,' ABEND MESSAGES SHOULD NOW FOLLOW ...')
- 104 FORMAT(/' ????? TEST OF ',A6,' ... ',A6,' =', E20.10,
- + ' ERROR CONDITION ', A6, ' NOT DETECTED.')
- END
-#endif
diff --git a/src/packlib/kernlib/kernnum/test/obsolete/numchk4/c312ch.F b/src/packlib/kernlib/kernnum/test/obsolete/numchk4/c312ch.F
deleted file mode 100644
index aaefdd9..0000000
--- a/src/packlib/kernlib/kernnum/test/obsolete/numchk4/c312ch.F
+++ /dev/null
@@ -1,91 +0,0 @@
-*
-* $Id: c312ch.F,v 1.1.1.1 1996/02/15 17:48:40 mclareni Exp $
-*
-* $Log: c312ch.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:40 mclareni
-* Kernlib
-*
-*
-#include "kernnumt/pilot.h"
-#if defined(CERNLIB_NEVER)
- SUBROUTINE C312CH(OK)
- LOGICAL OK, OKJ0, OKJ1, OKY0, OKY1
- CHARACTER*4 ERRCNT
-#include "kernnumt/sysdat.inc"
- EXTERNAL BESJ0, BESJ1, BESY0, BESY1
- REAL BESJ0, BESJ1, BESY0, BESY1, RF
-#if defined(CERNLIB_NUMLOPRE)
- EXTERNAL DBESJ0,DBESJ1,DBESY0,DBESY1
- DOUBLE PRECISION DBESJ0,DBESJ1,DBESY0,DBESY1,DF
-#endif
- PARAMETER(KOUNTX = 2)
- DOUBLE PRECISION X(KOUNTX)
- DOUBLE PRECISION BJ0(KOUNTX),BJ1(KOUNTX)
- DOUBLE PRECISION BY0(KOUNTX),BY1(KOUNTX)
- DATA X / 2.D0, 10.D0 /
- DATA BJ0 / 0.22389 07791 4124D0, -0.24593 57644 5135D0 /
- DATA BJ1 / 0.57672 48077 5687D0, 0.43472 74616 8861D-1 /
- DATA BY0 / 0.51037 56726 4974D0, 0.55671 16728 3600D-1 /
- DATA BY1 /-0.10703 24315 4094D0, 0.24901 54242 0695D0 /
- TRUNC = 1E-12
-#if defined(CERNLIB_NUMHIPRE)
- RROUND = RELPRT(1)*10.
- CALL RFEQDY(KOUNTX,X,BESJ0, BJ0,TRUNC,RROUND,OKJ0)
- CALL RFEQDY(KOUNTX,X,BESJ1, BJ1,TRUNC,RROUND,OKJ1)
- CALL RFEQDY(KOUNTX,X,BESY0, BY0,TRUNC,RROUND,OKY0)
- CALL RFEQDY(KOUNTX,X,BESY1, BY1,TRUNC,RROUND,OKY1)
- OK = OKJ0 .AND. OKJ1 .AND. OKY0 .AND. OKY1
-#endif
-#if defined(CERNLIB_NUMLOPRE)
- RROUND = RELPRT(1)
- DROUND = RELPRT(2)*10.
- CALL DFEQDY(KOUNTX,X,DBESJ0,BJ0,TRUNC,DROUND,OKJ0)
- CALL DFEQDY(KOUNTX,X,DBESJ1,BJ1,TRUNC,DROUND,OKJ1)
- CALL DFEQDY(KOUNTX,X,DBESY0,BY0,TRUNC,DROUND,OKY0)
- CALL DFEQDY(KOUNTX,X,DBESY1,BY1,TRUNC,DROUND,OKY1)
- OK = OKJ0 .AND. OKJ1 .AND. OKY0 .AND. OKY1
- CALL RFEQDF(KOUNTX,X,BESJ0, DBESJ0,TRUNC,RROUND,OKJ0)
- CALL RFEQDF(KOUNTX,X,BESJ1, DBESJ1,TRUNC,RROUND,OKJ1)
- CALL RFEQDF(KOUNTX,X,BESY0, DBESY0,TRUNC,RROUND,OKY0)
- CALL RFEQDF(KOUNTX,X,BESY1, DBESY1,TRUNC,RROUND,OKY1)
- OK = OK .AND. OKJ0 .AND. OKJ1 .AND. OKY0 .AND. OKY1
-#endif
-#if defined(CERNLIB_NUMHIPRE)
- ERRCNT = ' TWO'
-#endif
-#if defined(CERNLIB_NUMLOPRE)
- ERRCNT = 'FOUR'
-#endif
- IF( ERPRNT .AND. ERSTOP) WRITE(*,101) ERRCNT
- IF( ERPRNT .AND. .NOT. ERSTOP) WRITE(*,102) ERRCNT
- IF(.NOT. ERPRNT .AND. ERSTOP) WRITE(*,103) ERRCNT
- RF = BESY0(0.)
- IF(RF .NE. 0.) THEN
- OK = .FALSE.
- WRITE(*,104) 'BESY0 ', 'BESY0 ', RF, 'C312.1'
- ENDIF
- RF = BESY1(-1.001)
- IF(RF .NE. 0.) THEN
- OK = .FALSE.
- WRITE(*,104) 'BESY1 ', 'BESY1 ', RF, 'C312.1'
- ENDIF
-#if defined(CERNLIB_NUMLOPRE)
- DF = DBESY0(0.D0)
- IF(DF .NE. 0.D0) THEN
- OK = .FALSE.
- WRITE(*,104) 'DBESY0', 'DBESY0', DF, 'C312.1'
- ENDIF
- DF = DBESY1(-1.001D0)
- IF(DF .NE. 0.D0) THEN
- OK = .FALSE.
- WRITE(*,104) 'DBESY1', 'DBESY1', DF, 'C312.1'
- ENDIF
-#endif
- RETURN
- 101 FORMAT(/2X,A4,' ERROR AND ABEND MESSAGES SHOULD NOW FOLLOW ...')
- 102 FORMAT(/2X,A4,' ERROR MESSAGES SHOULD NOW FOLLOW ...')
- 103 FORMAT(/2X,A4,' ABEND MESSAGES SHOULD NOW FOLLOW ...')
- 104 FORMAT(/' ????? TEST OF ',A6,' ... ',A6,' =', E20.10,
- + ' ERROR CONDITION ', A6, ' NOT DETECTED.')
- END
-#endif
diff --git a/src/packlib/kernlib/kernnum/test/obsolete/numchk4/c313ch.F b/src/packlib/kernlib/kernnum/test/obsolete/numchk4/c313ch.F
deleted file mode 100644
index 6a8ba23..0000000
--- a/src/packlib/kernlib/kernnum/test/obsolete/numchk4/c313ch.F
+++ /dev/null
@@ -1,153 +0,0 @@
-*
-* $Id: c313ch.F,v 1.1.1.1 1996/02/15 17:48:40 mclareni Exp $
-*
-* $Log: c313ch.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:40 mclareni
-* Kernlib
-*
-*
-#include "kernnumt/pilot.h"
-#if defined(CERNLIB_NEVER)
- SUBROUTINE C313CH(OK)
- LOGICAL OK, OKI0, OKI1, OKK0, OKK1
- CHARACTER*5 ERRCNT
-#include "kernnumt/sysdat.inc"
- EXTERNAL BESI0, BESI1, BESK0, BESK1
- EXTERNAL EBESI0,EBESI1,EBESK0,EBESK1
- REAL BESI0, BESI1, BESK0, BESK1, RF
- REAL EBESI0,EBESI1,EBESK0,EBESK1
-#if defined(CERNLIB_NUMLOPRE)
- EXTERNAL DBESI0,DBESI1,DBESK0,DBESK1
- EXTERNAL DEBSI0,DEBSI1,DEBSK0,DEBSK1
- DOUBLE PRECISION DBESI0,DBESI1,DBESK0,DBESK1,DF
- DOUBLE PRECISION DEBSI0,DEBSI1,DEBSK0,DEBSK1
-#endif
- PARAMETER(KOUNTX = 3)
- DOUBLE PRECISION X(KOUNTX)
- DOUBLE PRECISION BI0(KOUNTX),BI1(KOUNTX)
- DOUBLE PRECISION BK0(KOUNTX),BK1(KOUNTX)
- DOUBLE PRECISION EI0(KOUNTX),EI1(KOUNTX)
- DOUBLE PRECISION EK0(KOUNTX),EK1(KOUNTX)
- DATA X / 0.125D0, 1.D0, 10.D0 /
- DATA BI0 / 0.10039 10066 3533D1,
- + 0.12660 65877 7520D1,
- + 0.28157 16628 4663D4 /
- DATA BI1 / 0.62622 14981 1235D-1,
- + 0.56515 91039 9248D0,
- + 0.26709 88303 7012D4 /
- DATA BK0 / 0.22078 69086 7449D1,
- + 0.42102 44382 4071D0,
- + 0.17780 06231 6167D-4 /
- DATA BK1 / 0.78311 18299 1157D1,
- + 0.60190 72301 9723D0,
- + 0.18648 77345 3825D-4 /
- DATA EI0 / 0.88594 75240 3032D0,
- + 0.46575 96075 9364D0,
- + 0.12783 33371 6343D0 /
- DATA EI1 / 0.55263 85324 1603D-1,
- + 0.20791 04153 4971D0,
- + 0.12126 26813 8446D0 /
- DATA EK0 / 0.25018 43440 2191D1,
- + 0.11444 63079 8069D1,
- + 0.39163 19344 3660D0 /
- DATA EK1 / 0.88738 19586 4264D1,
- + 0.16361 53486 2633D1,
- + 0.41076 65705 9580D0 /
- TRUNCI = 5E-13
- TRUNCK = 5E-12
-#if defined(CERNLIB_NUMHIPRE)
- RROUND = RELPRT(1)*10.
- CALL RFEQDY(KOUNTX,X,BESI0, BI0,TRUNCI,RROUND,OKI0)
- CALL RFEQDY(KOUNTX,X,BESI1, BI1,TRUNCI,RROUND,OKI1)
- CALL RFEQDY(KOUNTX,X,BESK0, BK0,TRUNCK,RROUND,OKK0)
- CALL RFEQDY(KOUNTX,X,BESK1, BK1,TRUNCK,RROUND,OKK1)
- OK = OKI0 .AND. OKI1 .AND. OKK0 .AND. OKK1
- CALL RFEQDY(KOUNTX,X,EBESI0,EI0,TRUNCI,RROUND,OKI0)
- CALL RFEQDY(KOUNTX,X,EBESI1,EI1,TRUNCI,RROUND,OKI1)
- CALL RFEQDY(KOUNTX,X,EBESK0,EK0,TRUNCK,RROUND,OKK0)
- CALL RFEQDY(KOUNTX,X,EBESK1,EK1,TRUNCK,RROUND,OKK1)
- OK = OK .AND. OKI0 .AND. OKI1 .AND. OKK0 .AND. OKK1
-#endif
-#if defined(CERNLIB_NUMLOPRE)
- RROUND = RELPRT(1)
- DROUND = RELPRT(2)*10.
- CALL DFEQDY(KOUNTX,X,DBESI0,BI0,TRUNCI,DROUND,OKI0)
- CALL DFEQDY(KOUNTX,X,DBESI1,BI1,TRUNCI,DROUND,OKI1)
- CALL DFEQDY(KOUNTX,X,DBESK0,BK0,TRUNCK,DROUND,OKK0)
- CALL DFEQDY(KOUNTX,X,DBESK1,BK1,TRUNCK,DROUND,OKK1)
- OK = OKI0 .AND. OKI1 .AND. OKK0 .AND. OKK1
- CALL DFEQDY(KOUNTX,X,DEBSI0,EI0,TRUNCI,DROUND,OKI0)
- CALL DFEQDY(KOUNTX,X,DEBSI1,EI1,TRUNCI,DROUND,OKI1)
- CALL DFEQDY(KOUNTX,X,DEBSK0,EK0,TRUNCK,DROUND,OKK0)
- CALL DFEQDY(KOUNTX,X,DEBSK1,EK1,TRUNCK,DROUND,OKK1)
- OK = OK .AND. OKI0 .AND. OKI1 .AND. OKK0 .AND. OKK1
- CALL RFEQDF(KOUNTX,X,BESI0, DBESI0,TRUNCI,RROUND,OKI0)
- CALL RFEQDF(KOUNTX,X,BESI1, DBESI1,TRUNCI,RROUND,OKI1)
- CALL RFEQDF(KOUNTX,X,BESK0, DBESK0,TRUNCK,RROUND,OKK0)
- CALL RFEQDF(KOUNTX,X,BESK1, DBESK1,TRUNCK,RROUND,OKK1)
- OK = OK .AND. OKI0 .AND. OKI1 .AND. OKK0 .AND. OKK1
- CALL RFEQDF(KOUNTX,X,EBESI0,DEBSI0,TRUNCI,RROUND,OKI0)
- CALL RFEQDF(KOUNTX,X,EBESI1,DEBSI1,TRUNCI,RROUND,OKI1)
- CALL RFEQDF(KOUNTX,X,EBESK0,DEBSK0,TRUNCK,RROUND,OKK0)
- CALL RFEQDF(KOUNTX,X,EBESK1,DEBSK1,TRUNCK,RROUND,OKK1)
- OK = OK .AND. OKI0 .AND. OKI1 .AND. OKK0 .AND. OKK1
-#endif
-#if defined(CERNLIB_NUMHIPRE)
- ERRCNT = ' FOUR'
-#endif
-#if defined(CERNLIB_NUMLOPRE)
- ERRCNT = 'EIGHT'
-#endif
- IF( ERPRNT .AND. ERSTOP) WRITE(*,101) ERRCNT
- IF( ERPRNT .AND. .NOT. ERSTOP) WRITE(*,102) ERRCNT
- IF(.NOT. ERPRNT .AND. ERSTOP) WRITE(*,103) ERRCNT
- RF = BESK0(0.)
- IF(RF .NE. 0.) THEN
- OK = .FALSE.
- WRITE(*,104) ' BESK0', ' BESK0', RF, 'C313.1'
- ENDIF
- RF = BESK1(-.001)
- IF(RF .NE. 0.) THEN
- OK = .FALSE.
- WRITE(*,104) ' BESK1', ' BESK1', RF, 'C313.1'
- ENDIF
- RF = EBESK0(-.001)
- IF(RF .NE. 0.) THEN
- OK = .FALSE.
- WRITE(*,104) 'EBESK0', 'EBESK0', RF, 'C313.1'
- ENDIF
- RF = EBESK1(0.)
- IF(RF .NE. 0.) THEN
- OK = .FALSE.
- WRITE(*,104) 'EBESK1', 'EBESK1', RF, 'C313.1'
- ENDIF
-#if defined(CERNLIB_NUMLOPRE)
- DF = DBESK0(0.D0)
- IF(DF .NE. 0.D0) THEN
- OK = .FALSE.
- WRITE(*,104) 'DBESK0', 'DBESK0', DF, 'C313.1'
- ENDIF
- DF = DBESK1(-.001D0)
- IF(DF .NE. 0.D0) THEN
- OK = .FALSE.
- WRITE(*,104) 'DBESK1', 'DBESK1', DF, 'C313.1'
- ENDIF
- DF = DEBSK0(-.001D0)
- IF(DF .NE. 0.D0) THEN
- OK = .FALSE.
- WRITE(*,104) 'DEBSK0', 'DEBSK0', DF, 'C313.1'
- ENDIF
- DF = DEBSK1(0.D0)
- IF(DF .NE. 0.D0) THEN
- OK = .FALSE.
- WRITE(*,104) 'DEBSK1', 'DEBSK1', DF, 'C313.1'
- ENDIF
-#endif
- RETURN
- 101 FORMAT(/2X,A5,' ERROR AND ABEND MESSAGES SHOULD NOW FOLLOW ...')
- 102 FORMAT(/2X,A5,' ERROR MESSAGES SHOULD NOW FOLLOW ...')
- 103 FORMAT(/2X,A5,' ABEND MESSAGES SHOULD NOW FOLLOW ...')
- 104 FORMAT(/' ????? TEST OF ',A6,' ... ',A6,' =', E20.10,
- + ' ERROR CONDITION ', A6, ' NOT DETECTED.')
- END
-#endif
diff --git a/src/packlib/kernlib/kernnum/test/obsolete/numchk4/c336ch.F b/src/packlib/kernlib/kernnum/test/obsolete/numchk4/c336ch.F
deleted file mode 100644
index 4231a22..0000000
--- a/src/packlib/kernlib/kernnum/test/obsolete/numchk4/c336ch.F
+++ /dev/null
@@ -1,71 +0,0 @@
-*
-* $Id: c336ch.F,v 1.1.1.1 1996/02/15 17:48:40 mclareni Exp $
-*
-* $Log: c336ch.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:40 mclareni
-* Kernlib
-*
-*
-#include "kernnumt/pilot.h"
-#if defined(CERNLIB_NEVER)
- SUBROUTINE C336CH(OK)
- LOGICAL OK, OKS, OKC
- CHARACTER*3 ERRCNT
-#include "kernnumt/sysdat.inc"
- EXTERNAL SININT, COSINT
- REAL SININT, COSINT, RF
-#if defined(CERNLIB_NUMLOPRE)
- EXTERNAL DSININ, DCOSIN
- DOUBLE PRECISION DSININ, DCOSIN, DF
-#endif
- PARAMETER(KOUNTX = 2)
- DOUBLE PRECISION X(KOUNTX), S(KOUNTX), C(KOUNTX)
- DATA X / 2.D0, 10.D0 /
- DATA S / 0.16054 12976 8027D1, 0.16583 47594 2189D1 /
- DATA C / 0.42298 08287 7486D0,-0.04545 64330 0445D0 /
- TRUNC = 5E-13
-#if defined(CERNLIB_NUMHIPRE)
- RROUND = RELPRT(1)*10.
- CALL RFEQDY(KOUNTX,X,SININT,S,TRUNC,RROUND,OKS)
- CALL RFEQDY(KOUNTX,X,COSINT,C,TRUNC,RROUND,OKC)
- OK = OKS .AND. OKC
-#endif
-#if defined(CERNLIB_NUMLOPRE)
- RROUND = RELPRT(1)
- DROUND = RELPRT(2)*10.
- CALL RFEQDF(KOUNTX,X,SININT,DSININ,TRUNC,RROUND,OKS)
- CALL RFEQDF(KOUNTX,X,COSINT,DCOSIN,TRUNC,RROUND,OKC)
- OK = OKS .AND. OKC
- CALL DFEQDY(KOUNTX,X,DSININ,S,TRUNC,DROUND,OKS)
- CALL DFEQDY(KOUNTX,X,DCOSIN,C,TRUNC,DROUND,OKC)
- OK = OK .AND. OKS .AND. OKC
-#endif
-#if defined(CERNLIB_NUMHIPRE)
- ERRCNT = 'ONE'
-#endif
-#if defined(CERNLIB_NUMLOPRE)
- ERRCNT = 'TWO'
-#endif
- IF( ERPRNT .AND. ERSTOP) WRITE(*,101) ERRCNT
- IF( ERPRNT .AND. .NOT. ERSTOP) WRITE(*,102) ERRCNT
- IF(.NOT. ERPRNT .AND. ERSTOP) WRITE(*,103) ERRCNT
- RF = COSINT(0.)
- IF(RF .NE. 0.) THEN
- OK = .FALSE.
- WRITE(*,104) 'COSINT', 'COSINT', RF, 'C336.1'
- ENDIF
-#if defined(CERNLIB_NUMLOPRE)
- DF = DCOSIN(0.D0)
- IF(DF .NE. 0.D0) THEN
- OK = .FALSE.
- WRITE(*,104) 'DCOSIN', 'DCOSIN', DF, 'C336.1'
- ENDIF
-#endif
- RETURN
- 101 FORMAT(/2X,A3,' ERROR AND ABEND MESSAGE SHOULD NOW FOLLOW ...')
- 102 FORMAT(/2X,A3,' ERROR MESSAGE SHOULD NOW FOLLOW ...')
- 103 FORMAT(/2X,A3,' ABEND MESSAGE SHOULD NOW FOLLOW ...')
- 104 FORMAT(/' ????? TEST OF ',A6,' ... ',A6,' =', E20.10,
- + ' ERROR CONDITION ', A6, ' NOT DETECTED.')
- END
-#endif
diff --git a/src/packlib/kernlib/kernnum/test/obsolete/numchk4/c337ch.F b/src/packlib/kernlib/kernnum/test/obsolete/numchk4/c337ch.F
deleted file mode 100644
index b52ca79..0000000
--- a/src/packlib/kernlib/kernnum/test/obsolete/numchk4/c337ch.F
+++ /dev/null
@@ -1,71 +0,0 @@
-*
-* $Id: c337ch.F,v 1.1.1.1 1996/02/15 17:48:40 mclareni Exp $
-*
-* $Log: c337ch.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:40 mclareni
-* Kernlib
-*
-*
-#include "kernnumt/pilot.h"
-#if defined(CERNLIB_NEVER)
- SUBROUTINE C337CH(OK)
- LOGICAL OK, OKD
- CHARACTER*3 ERRCNT
-#include "kernnumt/sysdat.inc"
- EXTERNAL EXPINT
- REAL EXPINT, RF
-#if defined(CERNLIB_NUMLOPRE)
- EXTERNAL DEXPIN
- DOUBLE PRECISION DEXPIN, DF
-#endif
- PARAMETER(KOUNTX = 7)
- DOUBLE PRECISION X(KOUNTX), Y(KOUNTX)
- DATA
- + X(1) / -25.D0 /, Y(1) / -0.30059 50906 5253D10 /,
- + X(2) / -15.D0 /, Y(2) / -0.23495 58524 9076D6 /,
- + X(3) / -10.D0 /, Y(3) / -0.24922 28976 2418D4 /,
- + X(4) / -5.D0 /, Y(4) / -0.40185 27535 5802D2 /,
- + X(5) / 0.5D0/, Y(5) / 0.55977 35947 7615D0 /,
- + X(6) / 2.D0 /, Y(6) / 0.48900 51070 8060D-1 /,
- + X(7) / 5.D0 /, Y(7) / 0.11482 95591 2753D-2 /
- TRUNC = 5E-13
-#if defined(CERNLIB_NUMHIPRE)
- RROUND = RELPRT(1)*10.
- CALL RFEQDY(KOUNTX,X,EXPINT,Y,TRUNC,RROUND,OK)
-#endif
-#if defined(CERNLIB_NUMLOPRE)
- RROUND = RELPRT(1)
- DROUND = RELPRT(2)*10.
- CALL RFEQDF(KOUNTX,X,EXPINT,DEXPIN,TRUNC,RROUND,OK)
- CALL DFEQDY(KOUNTX,X,DEXPIN,Y,TRUNC,DROUND,OKD)
- OK = OK .AND. OKD
-#endif
-#if defined(CERNLIB_NUMHIPRE)
- ERRCNT = 'ONE'
-#endif
-#if defined(CERNLIB_NUMLOPRE)
- ERRCNT = 'TWO'
-#endif
- IF( ERPRNT .AND. ERSTOP) WRITE(*,101) ERRCNT
- IF( ERPRNT .AND. .NOT. ERSTOP) WRITE(*,102) ERRCNT
- IF(.NOT. ERPRNT .AND. ERSTOP) WRITE(*,103) ERRCNT
- RF = EXPINT(0.)
- IF(RF .NE. 0.) THEN
- OK = .FALSE.
- WRITE(*,104) 'EXPINT', 'EXPINT', RF, 'C337.1'
- ENDIF
-#if defined(CERNLIB_NUMLOPRE)
- DF = DEXPIN(0.D0)
- IF(DF .NE. 0.D0) THEN
- OK = .FALSE.
- WRITE(*,104) 'DEXPIN', 'DEXPIN', DF, 'C337.1'
- ENDIF
-#endif
- RETURN
- 101 FORMAT(/2X,A3,' ERROR AND ABEND MESSAGES SHOULD NOW FOLLOW ...')
- 102 FORMAT(/2X,A3,' ERROR MESSAGES SHOULD NOW FOLLOW ...')
- 103 FORMAT(/2X,A3,' ABEND MESSAGES SHOULD NOW FOLLOW ...')
- 104 FORMAT(/' ????? TEST OF ',A6,' ... ',A6,' =', E20.10,
- + ' ERROR CONDITION ', A6, ' NOT DETECTED.')
- END
-#endif
diff --git a/src/packlib/kernlib/kernnum/test/obsolete/numchk4/c341ch.F b/src/packlib/kernlib/kernnum/test/obsolete/numchk4/c341ch.F
deleted file mode 100644
index 04e20ff..0000000
--- a/src/packlib/kernlib/kernnum/test/obsolete/numchk4/c341ch.F
+++ /dev/null
@@ -1,79 +0,0 @@
-*
-* $Id: c341ch.F,v 1.1.1.1 1996/02/15 17:48:40 mclareni Exp $
-*
-* $Log: c341ch.F,v $
-* Revision 1.1.1.1 1996/02/15 17:48:40 mclareni
-* Kernlib
-*
-*
-#include "kernnumt/pilot.h"
-#if defined(CERNLIB_NEVER)
- SUBROUTINE C341CH(OK)
- LOGICAL OK, OKD
- CHARACTER*4 ERRCNT
-#include "kernnumt/sysdat.inc"
- EXTERNAL ALOGAM
- REAL ALOGAM, RF
-#if defined(CERNLIB_NUMLOPRE)
- EXTERNAL DLOGAM
- DOUBLE PRECISION DLOGAM, DF
-#endif
- PARAMETER(KOUNTX = 5)
- DOUBLE PRECISION X(KOUNTX), Y(KOUNTX)
- DATA
- + X(1) / 0.25D0/, Y(1) / 0.12880 22524 6981D1 /,
- + X(2) / 1.25D0/, Y(2) /-0.98271 83642 1813D-1/,
- + X(3) / 3.0D0 /, Y(3) / 0.69314 71805 5994D0 /,
- + X(4) / 5.0D0 /, Y(4) / 0.31780 53830 3479D1 /,
- + X(5) /50.0D0 /, Y(5) / 0.14456 57439 4634D3 /
- TRUNC = 5E-13
-#if defined(CERNLIB_NUMHIPRE)
- RROUND = RELPRT(1)*10.
- CALL RFEQDY(KOUNTX,X,ALOGAM,Y,TRUNC,RROUND,OK)
-#endif
-#if defined(CERNLIB_NUMLOPRE)
- RROUND = RELPRT(1)
- DROUND = RELPRT(2)*10.
- CALL RFEQDF(KOUNTX,X,ALOGAM,DLOGAM,TRUNC,RROUND,OK)
- CALL DFEQDY(KOUNTX,X,DLOGAM,Y,TRUNC,DROUND,OKD)
- OK = OK .AND. OKD
-#endif
-#if defined(CERNLIB_NUMHIPRE)
- ERRCNT = ' TWO'
-#endif
-#if defined(CERNLIB_NUMLOPRE)
- ERRCNT = 'FOUR'
-#endif
- IF( ERPRNT .AND. ERSTOP) WRITE(*,101)ERRCNT
- IF( ERPRNT .AND. .NOT. ERSTOP) WRITE(*,102)ERRCNT
- IF(.NOT. ERPRNT .AND. ERSTOP) WRITE(*,103)ERRCNT
- RF = ALOGAM(0.)
- IF(RF .NE. 0.) THEN
- OK = .FALSE.
- WRITE(*,104) 'ALOGAM', 'ALOGAM', RF, 'C341.1'
- ENDIF
- RF = ALOGAM(-1.)
- IF(RF .NE. 0.) THEN
- OK = .FALSE.
- WRITE(*,104) 'ALOGAM', 'ALOGAM', RF, 'C341.1'
- ENDIF
-#if defined(CERNLIB_NUMLOPRE)
- DF = DLOGAM(0.D0)
- IF(DF .NE. 0.D0) THEN
- OK = .FALSE.
- WRITE(*,104) 'DLOGAM', 'DLOGAM', DF, 'C341.1'
- ENDIF
- DF = DLOGAM(-1.D0)
- IF(DF .NE. 0.D0) THEN
- OK = .FALSE.
- WRITE(*,104) 'DLOGAM', 'DLOGAM', DF, 'C341.1'
- ENDIF
-#endif
- RETURN
- 101 FORMAT(/2X,A4,' ERROR AND ABEND MESSAGES SHOULD NOW FOLLOW ...')
- 102 FORMAT(/2X,A4,' ERROR MESSAGES SHOULD NOW FOLLOW ...')
- 103 FORMAT(/2X,A4,' ABEND MESSAGES SHOULD NOW FOLLOW ...')
- 104 FORMAT(/' ????? TEST OF ',A6,' ... ',A6,' =', E20.10,
- + ' ERROR CONDITION ', A6, ' NOT DETECTED.')
- END
-#endif
diff --git a/src/packlib/kernlib/kernnum/test/test.F b/src/packlib/kernlib/kernnum/test/test.F
deleted file mode 100644
index f72a579..0000000
--- a/src/packlib/kernlib/kernnum/test/test.F
+++ /dev/null
@@ -1,238 +0,0 @@
-*
-* $Id: test.F,v 1.2 1997/02/04 17:36:53 mclareni Exp $
-*
-* $Log: test.F,v $
-* Revision 1.2 1997/02/04 17:36:53 mclareni
-* Merge Winnt and 97a versions
-*
-* Revision 1.1.1.1.2.1 1997/01/21 11:32:13 mclareni
-* All mods for Winnt 96a on winnt branch
-*
-* Revision 1.1.1.1 1996/02/15 17:48:36 mclareni
-* Kernlib
-*
-*
-#include "kernnumt/pilot.h"
- PROGRAM CHECK
-#include "kernnumt/sysdat.inc"
- PARAMETER(LW = 27 000)
- COMMON W(LW)
- CHARACTER*6 ERCODE
- CHARACTER*8 CDATE, CTIME, CSYST
- LOGICAL OK, OKC
- DOUBLE PRECISION D, D1, DR
- DATA ER, ME
-#if defined(CERNLIB_NUME38)
- + / 1.70E38, 126 /
-#endif
-#if defined(CERNLIB_NUME75)
- + / 7.23E75, 251 /
-#endif
-#if defined(CERNLIB_NUME293)
- + / 3.19E293, 975 /
-#endif
-#if defined(CERNLIB_NUME2465)
- + / 2.72E2465, 8190 /
-#endif
- DATA DR, MD
-#if defined(CERNLIB_NUMD38)
- + / 1.70D38, 126 /
-#endif
-#if defined(CERNLIB_NUMD75)
- + / 7.23D75, 251 /
-#endif
-#if defined(CERNLIB_NUMD279)
- + / 1.13D279, 927 /
-#endif
-#if defined(CERNLIB_NUMD2465)
- + / 2.72D2465, 8190 /
-#endif
- DATA TL
-#if defined(CERNLIB_NUMAP)||defined(CERNLIB_NUMCD)||defined(CERNLIB_NUMCR)||defined(CERNLIB_NUMCV)||defined(CERNLIB_NUMDE)||defined(CERNLIB_NUMIB)||defined(CERNLIB_NUMLN)||defined(CERNLIB_NUMMS)||defined(CERNLIB_NUMND)||defined(CERNLIB_NUMUC)||defined(CERNLIB_NUMNT)
- + / 0.005 /
-#endif
- ERANGE = ER
- DRANGE = DR
- MXBINE = ME
- MXBIND = MD
- R = 1.
- 10 R = 0.5*R
- CALL INCR1(R1,R)
- IF(R1 .NE. 1.) GOTO 10
- RELPRT(1) = 2.*R
- D = 1.
- 12 D = 0.5*D
- D1 = D + 1
- CALL INCD1(D1,D)
- IF(D1 .NE. 1.D0) GOTO 12
-#if defined(CERNLIB_HPUX)
- CALL ALLOW_UNALIGNED_DATA_ACCESS
-#endif
- RELPRT(2) = 2.*D
- CALL STAMP(CDATE,CTIME,CSYST)
-#if defined(CERNLIB_NEXT)
-C-- The Absoft compiler allows using the 96-bit precision of
-C the floating point coprocessor. Therefore the computation
-C of RELPRT with the above method is not correct. While a
-C better method to compute the relative precision of REAL
-C and DOUBLE PRECISION stored data is found, we set it by hand.
-C--
- RELPRT(1)=8.5E-8
- RELPRT(2)=2.5D-12
-#endif
-#if (defined(CERNLIB_NUMAP))&&(!defined(CERNLIB_NUMDPRNT))&&(!defined(CERNLIB_UNIX))
- OPEN(UNIT=3,FILE='-STDOUT')
-*.
-#endif
-#if (defined(CERNLIB_NUMAP))&&(!defined(CERNLIB_NUMDPRNT))&&(defined(CERNLIB_UNIX))&&(!defined(CERNLIB_MSDOS))
- OPEN(UNIT=3,FILE='kernnumt.ft03',STATUS='UNKNOWN')
-*.
-#endif
-#if (defined(CERNLIB_NUMAP))&&(!defined(CERNLIB_NUMDPRNT))&&(defined(CERNLIB_MSDOS))
- OPEN(UNIT=3,FILE='kernnumt.ft3',STATUS='UNKNOWN')
-#endif
-#if defined(CERNLIB_IBMRT)
- RELPRT(1) = 0.953674316E-6
-#endif
-#if defined(CERNLIB_NUMIB2)
- CALL ERRSET(187,999,-1,1,1)
-#endif
-#if (defined(CERNLIB_NUMND))&&(!defined(CERNLIB_NUMDPRNT))
- OPEN(UNIT=3,FILE='KERNNUMT:FT03',STATUS='UNKNOWN')
-#endif
-#if defined(CERNLIB_NUMDPRNT)
- IOUNIT = 6
-#endif
-#if !defined(CERNLIB_NUMDPRNT)
- IOUNIT = 3
-#endif
- LGFILE = 0
-#if defined(CERNLIB_NUMEPRNT)
- ERPRNT = .TRUE.
- KNTM = 100
-#endif
-#if !defined(CERNLIB_NUMEPRNT)
- ERPRNT = .FALSE.
- KNTM = 0
-#endif
-#if defined(CERNLIB_NUMESTOP)
- ERSTOP = .TRUE.
- KNTR = 0
-#endif
-#if !defined(CERNLIB_NUMESTOP)
- ERSTOP = .FALSE.
- KNTR = 100
-#endif
- ERCODE = ' '
- CALL RANGET(SEEDIN)
- NP = 0
- OK = .TRUE.
- DMY = 1000.
- CALL TIMEST( DMY )
- CALL TIMEX( CHKTIM(0) )
- KNTIME = 0
- DO 21 J = 1, 4
-#if !defined(CERNLIB_NUMCHK1)
- IF(J .EQ. 1) GOTO 20
-#endif
-#if !defined(CERNLIB_NUMCHK2)
- IF(J .EQ. 2) GOTO 20
-#endif
-#if !defined(CERNLIB_NUMCHK3)
- IF(J .EQ. 3) GOTO 20
-#endif
-#if !defined(CERNLIB_NUMCHK4)
- IF(J .EQ. 4) GOTO 20
-#endif
- WRITE(*,1000) J, CSYST, CDATE, CTIME, RELPRT
- CALL KERSET(ERCODE,LGFILE,KNTM,KNTR)
- IF(ERPRNT) THEN
- WRITE(*,1001)
- ELSE
- WRITE(*,1002)
- ENDIF
- IF(ERSTOP) THEN
- WRITE(*,1003)
- ELSE
- WRITE(*,1004)
- ENDIF
- NPC = 0
- OKC = .FALSE.
-#if defined(CERNLIB_NUMCHK1)
- IF(J .EQ. 1)
- + CALL CHECK1(LW,W,NPC,OKC,PKNAME(NP+1),PKTIME(NP+1))
-#endif
-#if defined(CERNLIB_NUMCHK2)
- IF(J .EQ. 2)
- + CALL CHECK2(LW,W,NPC,OKC,PKNAME(NP+1),PKTIME(NP+1))
-#endif
-#if defined(CERNLIB_NUMCHK3)
- IF(J .EQ. 3)
- + CALL CHECK3(LW,W,NPC,OKC,PKNAME(NP+1),PKTIME(NP+1))
-#endif
-#if defined(CERNLIB_NUMCHK4)
- IF(J .EQ. 4)
- + CALL CHECK4(LW,W,NPC,OKC,PKNAME(NP+1),PKTIME(NP+1))
-#endif
- IF(.NOT. OKC) WRITE(*,1007) J
- IF( OKC) WRITE(*,1008) J
- NP = NP + NPC
- OK = OK .AND. OKC
- 20 CALL TIMEX( CHKTIM(J) )
- 21 CONTINUE
- IF(.NOT. OK) WRITE(*,1011) NP
- IF( OK) WRITE(*,1012) NP
-#if defined(CERNLIB_NUMTIME)
- T = CHKTIM(4) - CHKTIM(0)
- WRITE(*,1021) T
- DO 30 J = 1, 4
- T = CHKTIM(J) - CHKTIM(J-1)
- WRITE(*,1022) J, T
- 30 CONTINUE
- WRITE(*,1023) TL
- DO 31 I = 1, NP
- IF(I .EQ. 1) RT = PKTIME(1) - CHKTIM(0)
- IF(I .GT. 1) RT = PKTIME(I) - PKTIME(I-1)
- IF(RT .GT. TL) WRITE(*,1024) PKNAME(I), RT
- 31 CONTINUE
- DO 32 K = 1, KNTIME
- WRITE(*,'(1X,A30)') SPTIME(K)
- 32 CONTINUE
-#endif
-
- STOP
-1000 FORMAT(6H1CHECK,I2,11H OF KERNNUM,21X,A8,20X,A8,
- + / 27H0VERSION 3.05 (17.3.1990) ,41X,A8,
- + / 26H0RELATIVE SINGLE PRECISION, 1P, E12.2,
- + / 26H0RELATIVE DOUBLE PRECISION, 1P, E12.2)
-1001 FORMAT(//20X,'LIBRARY PROGRAMS MAY PRINT ERROR MESSAGES')
-1002 FORMAT(//20X,
- + 'LIBRARY PROGRAMS SHALL NOT PRINT ERROR MESSAGES')
-1003 FORMAT(//20X,'LIBRARY PROGRAMS MAY ABEND')
-1004 FORMAT(//20X,'LIBRARY PROGRAMS SHALL NOT ABEND')
-1007 FORMAT(// 12H ????? CHECK,I2,
- + 29H OF KERNNUM HAS FAILED ????? )
-1008 FORMAT(// 6H CHECK,I2, 22H OF KERNNUM SUCCESSFUL )
-1011 FORMAT(// I10, ' PACKAGES CHECKED.'
- + // 20X, 44H ????? CHECK OF KERNNUM HAS FAILED. ????? )
-1012 FORMAT(// I10, ' PACKAGES CHECKED.',
- + //8X,'VERIFY BY INSPECTION OF THIS OUTPUT WHETHER',
- + ' ERROR AND ABEND REPORTS',
- + /8X,'FROM LIBRARY PROGRAMS AGREE WITH THE',
- + ' PREDICTIONS PRINTED BY THE'
- + /8X,'TEST PROGRAM. - OTHERWISE...'
- + // 20X, 'KERNNUM CHECK HAS BEEN SUCCESSFUL.')
-1021 FORMAT(18H1TOTAL RUNTIME ..., F17.3, 9H SECONDS)
-1022 FORMAT(9H0 CHECK,I3,13H RUNTIME ..., F10.3, 9H SECONDS)
-1023 FORMAT(34H0RUNTIMES OF PACKAGES WHICH EXCEED,F6.3,9H SECONDS)
-1024 FORMAT(8X, A4, 13H RUNTIME ..., F10.3, 9H SECONDS)
- END
- SUBROUTINE INCR1(R1,R)
- R1=R+1
- RETURN
- END
- SUBROUTINE INCD1(R1,R)
- DOUBLE PRECISION R1,R
- R1=R+1
- RETURN
- END
diff --git a/src/packlib/kernlib/umon/Imakefile b/src/packlib/kernlib/umon/Imakefile
deleted file mode 100644
index 65cd002..0000000
--- a/src/packlib/kernlib/umon/Imakefile
+++ /dev/null
@@ -1,18 +0,0 @@
-
-#define IHaveSubdirs
-#define PassCDebugFlags
-
-
-LIBDIRS= umonftn
-
-SUBDIRS = $(LIBDIRS)
-
-TopOfPackage(umon)
-
-SubdirLibraryTarget(umon,$(LIBDIRS))
-
-test::
-
-
-install.include::
-
diff --git a/src/packlib/kernlib/umon/history/content.dat b/src/packlib/kernlib/umon/history/content.dat
deleted file mode 100644
index 925a610..0000000
--- a/src/packlib/kernlib/umon/history/content.dat
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: content.dat,v 1.1.1.1 1996/02/15 17:47:33 mclareni Exp $
-*
-* $Log: content.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:47:33 mclareni
-* Kernlib
-*
-*
-C UMON 0.00 000000 00.00 CERN Program Library Z020 UMON
-C
-C Usage Monitoring Facility
-C Authors: F.Carminati, M.Marquina, B.Pollermann
-C
-C- Components:
-C > P=UMONFTN FORTRAN-callable version
-C VAX/VMS by F.Carminati (moved out of KERNVAX)
-C UNIX by G.Folger
-C IBMVM by M.Marquina
-C > P=UMUIPxxx UMON user interface procedures
-C > P=UMSRVxxx UMON Server + auxiliaries
-C IBMVM by B.Pollermann
-C
-C- Patchy flags:
-C > ON To activate monitoring code. Default is off
-C
diff --git a/src/packlib/kernlib/umon/history/history.dat b/src/packlib/kernlib/umon/history/history.dat
deleted file mode 100644
index 3a60993..0000000
--- a/src/packlib/kernlib/umon/history/history.dat
+++ /dev/null
@@ -1,14 +0,0 @@
-*
-* $Id: history.dat,v 1.1.1.1 1996/02/15 17:47:33 mclareni Exp $
-*
-* $Log: history.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:47:33 mclareni
-* Kernlib
-*
-*
-* This directory was created from umon.car patch history
-C UMON 1.03/03 950509 15:00 CERN Program Library Z020 UMON
-* 09-May-95 Disable UMLOGUX for MSDOS, use dummy UMLOG
-C UMON 1.03/02 050217 11:50 CERN Program Library Z020 UMON
-* 17-FEB-95 Massage format statement in UMCOM
-C UMON 1.03/01 930506 11:00 CERN Program Library Z020 UMON
diff --git a/src/packlib/kernlib/umon/history/iguideib.dat b/src/packlib/kernlib/umon/history/iguideib.dat
deleted file mode 100644
index 8e8c22b..0000000
--- a/src/packlib/kernlib/umon/history/iguideib.dat
+++ /dev/null
@@ -1,36 +0,0 @@
-*
-* $Id: iguideib.dat,v 1.1.1.1 1996/02/15 17:47:33 mclareni Exp $
-*
-* $Log: iguideib.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:47:33 mclareni
-* Kernlib
-*
-*
-#if defined(CERNLIB_IBMVM)
-
-Necessary steps to be taken for UMON installation on VM
-
- 0) Create a service machine named UMON
- - one minidisk 191, 1 cyl
- - privilege to execute the CP command MSGNOH
-
- 1) Copy all the UMON files onto its A-disk
-
- - make sure that the file MONITOR DEFINITIONS has the
- RECFM F and the LRECL 72
-
- 2) Modify the UMON EXEC:
- Set the variable UmonAdmin to the accounts of those users
- who should be entitled to Create monitors
-
- 3) Start UMON and make sure that it is always running in a disconnected
- state
-
- 4) Install the help files UMON_COMMANDS HELPINFO
- and UMON_INTRO HELPINFO
-
- --------------------------------------
-You now can test UMON by creating your first monitor
-(same syntax as modify, but not mentioned in the helpfiles for
- reasons of confidentiality)
-#endif
diff --git a/src/packlib/kernlib/umon/history/inform.dat b/src/packlib/kernlib/umon/history/inform.dat
deleted file mode 100644
index debae2e..0000000
--- a/src/packlib/kernlib/umon/history/inform.dat
+++ /dev/null
@@ -1,8 +0,0 @@
-*
-* $Id: inform.dat,v 1.1.1.1 1996/02/15 17:47:33 mclareni Exp $
-*
-* $Log: inform.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:47:33 mclareni
-* Kernlib
-*
-*
diff --git a/src/packlib/kernlib/umon/history/uguidevx.dat b/src/packlib/kernlib/umon/history/uguidevx.dat
deleted file mode 100644
index de14477..0000000
--- a/src/packlib/kernlib/umon/history/uguidevx.dat
+++ /dev/null
@@ -1,51 +0,0 @@
-*
-* $Id: uguidevx.dat,v 1.1.1.1 1996/02/15 17:47:33 mclareni Exp $
-*
-* $Log: uguidevx.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:47:33 mclareni
-* Kernlib
-*
-*
-#if defined(CERNLIB_VAXVMS)
-
-ÚÄÄÄÄÄÄÄÄÄÄ¿ ÚÄÄÄÄÄÄ¿
-| UMON | CERN COMPUTER CENTRE | Z020 |
-ÀÄÄÄÄÄÄÄÄÄÄÙ PROGRAM LIBRARY ÀÄÄÄÄÄÄÙ
-
-Author: F.Carminati Library: KERNLIB, VAX/VMS only
-______ _______
-Submitter: Submitted: 1989.03.01
-_________ _________
-Language: VAX FORTRAN Revised: -
-________ _______
- Usage Monitor for VAX/VMS
- ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
-UMCOM is an usage monitor package for VAX/VMS systems. Usage log requests are
-performed either via Fortran calls or via DCL commands.
-Structure: Complete program and subroutine package
-_________
- User Entry Names: UMCOM, UMLOG
-Usage: CALL UMCOM(CMD,MONITOR,TEXT)
-_____
- CMD A character variable constant or expression whose first
- two letters are interpreted as a command to UMON. See
- long write-up for possible commands.
- MONITOR A character variable containing the name of the moni-
- tor to be affected by the command. The maximum name
- length for a monitor is 8 characters.
- TEXT A character variable containing information related to
- the command given. If string is longer than 80 charac-
- ters it will be truncated.
- CALL UMLOG(MONITOR,TEXT)
- MONITOR Character containing the name of the monitor. A moni-
- tor can be eight characters long at most. If MONITOR is
- longer than eight characters, only the first eight char-
- acters will be considered.
- TEXT Character string containing the text to be logged. If
- TEXT is longer than 80 characters, only the first 80
- characters will be used.
-Method: The long write-up should be consulted.
-______
-Long Write-up: Available
-_____________
-#endif
diff --git a/src/packlib/kernlib/umon/history/v100.dat b/src/packlib/kernlib/umon/history/v100.dat
deleted file mode 100644
index 37bbd03..0000000
--- a/src/packlib/kernlib/umon/history/v100.dat
+++ /dev/null
@@ -1,11 +0,0 @@
-*
-* $Id: v100.dat,v 1.1.1.1 1996/02/15 17:47:33 mclareni Exp $
-*
-* $Log: v100.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:47:33 mclareni
-* Kernlib
-*
-*
-* Version 1.00 910408 4.40
-C- First release of UMON
-C
diff --git a/src/packlib/kernlib/umon/history/v101.dat b/src/packlib/kernlib/umon/history/v101.dat
deleted file mode 100644
index 67cf696..0000000
--- a/src/packlib/kernlib/umon/history/v101.dat
+++ /dev/null
@@ -1,14 +0,0 @@
-*
-* $Id: v101.dat,v 1.1.1.1 1996/02/15 17:47:33 mclareni Exp $
-*
-* $Log: v101.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:47:33 mclareni
-* Kernlib
-*
-*
-* Version 1.01 910419 18.00
-C- Additions/changes
-C > P=UMONEXEC renamed to UMUIPIBM
-C > P=UMONDCL renamed to UMUIPVAX
-C > P=UMSRVIBM VM service machine code
-C
diff --git a/src/packlib/kernlib/umon/history/v102.dat b/src/packlib/kernlib/umon/history/v102.dat
deleted file mode 100644
index 26d1f61..0000000
--- a/src/packlib/kernlib/umon/history/v102.dat
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: v102.dat,v 1.1.1.1 1996/02/15 17:47:33 mclareni Exp $
-*
-* $Log: v102.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:47:33 mclareni
-* Kernlib
-*
-*
-* Version 1.02 910711 6.00
-C- Additions/changes
-C > P=UMUIPIBM,D=UMLOG suppress double logging of userid
-C
diff --git a/src/packlib/kernlib/umon/history/v103.dat b/src/packlib/kernlib/umon/history/v103.dat
deleted file mode 100644
index 0007eca..0000000
--- a/src/packlib/kernlib/umon/history/v103.dat
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: v103.dat,v 1.1.1.1 1996/02/15 17:47:33 mclareni Exp $
-*
-* $Log: v103.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:47:33 mclareni
-* Kernlib
-*
-*
-* Version 1.03 930303 20.30
-C- Additions/changes
-C > P=UMONFTN ,D=UMLOGUX UNIX version, make dummy for NeXT
-C
diff --git a/src/packlib/kernlib/umon/history/v104.dat b/src/packlib/kernlib/umon/history/v104.dat
deleted file mode 100644
index aa71482..0000000
--- a/src/packlib/kernlib/umon/history/v104.dat
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: v104.dat,v 1.1.1.1 1996/02/15 17:47:33 mclareni Exp $
-*
-* $Log: v104.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:47:33 mclareni
-* Kernlib
-*
-*
-* Version 1.04 930506 11.00
-C- Additions/changes
-C > P=UMONFTN ,D=UMLOG Correct activation for MVS (H.Keller/Desy)
-C
diff --git a/src/packlib/kernlib/umon/obsolete/umsrvibm/Makefile.in b/src/packlib/kernlib/umon/obsolete/umsrvibm/Makefile.in
deleted file mode 100644
index acd1888..0000000
--- a/src/packlib/kernlib/umon/obsolete/umsrvibm/Makefile.in
+++ /dev/null
@@ -1,63 +0,0 @@
-#
-# umon/umsrvibm/Makefile.in - compiles and archives the source code in this directory.
-# It is invoked by Makefile.xxxxx in the above directory, where xxxxx is the name of the library.
-# Generated by car2cvs $Revision: 1.1.1.1 $ (nk)
-#
-# $Id: Makefile.in,v 1.1.1.1 1996/02/15 17:47:36 mclareni Exp $
-#
-# $Log: Makefile.in,v $
-# Revision 1.1.1.1 1996/02/15 17:47:36 mclareni
-# Kernlib
-#
-#
-
-MAKE = gmake
-SHELL = /bin/sh
-srcdir = @srcdir@
-VPATH = @srcdir@
-MACHINE = @MACHINE@
-
-ifeq "$(srcdir)" "."
- absrcdir = $(shell pwd)
-else
- absrcdir = $(srcdir)
-endif
-
-OBJS=
-
-LIBRARY=dummy
-ifeq "$(LIBRARY)" "dummy"
- OBJS=
-endif
-.SUFFIXES: .cdf
-
-.PHONY:dummy production vaxsrc vaxcom debug clean distclean realclean TAGS depend fort_depend c_depend cc_depend
- @
-
-dummy::
- @echo Run Makefile in the parent directory
-
-debug production:$(OBJS)
- @test "$(LIBRARY)" = "dummy" || test "`echo *.o`" = "*.o" || ($(AR) rvs $(LIBRARY) *.o;$(RM) *.o)
-
-vaxsrc:$(VAX_FORTRAN_SOURCES)
- @
-
-vaxcom:$(VAX_COMS)
- @
-
-clean:
- @rm -f *.o *.bak
-
-distclean:clean
- @rm -f Makefile Makefile.obj
-
-realclean:
- @rm -f *~ #*
-
-TAGS:$(absrcdir)/*[Fch]
- @$(ETAGS) -f $(dir $(LIBRARY))/TAGS.$(LIBRARY_NAME) $(absrcdir)/*[Fch]
-
-
-
-
diff --git a/src/packlib/kernlib/umon/obsolete/umsrvibm/README b/src/packlib/kernlib/umon/obsolete/umsrvibm/README
deleted file mode 100644
index 4cf731d..0000000
--- a/src/packlib/kernlib/umon/obsolete/umsrvibm/README
+++ /dev/null
@@ -1,9 +0,0 @@
-*
-* $Id: README,v 1.1.1.1 1996/02/15 17:47:35 mclareni Exp $
-*
-* $Log: README,v $
-* Revision 1.1.1.1 1996/02/15 17:47:35 mclareni
-* Kernlib
-*
-*
-* This directory was created from umon.car patch umsrvibm
diff --git a/src/packlib/kernlib/umon/obsolete/umsrvibm/cleandef.dat b/src/packlib/kernlib/umon/obsolete/umsrvibm/cleandef.dat
deleted file mode 100644
index d4ba40f..0000000
--- a/src/packlib/kernlib/umon/obsolete/umsrvibm/cleandef.dat
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: cleandef.dat,v 1.1.1.1 1996/02/15 17:47:35 mclareni Exp $
-*
-* $Log: cleandef.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:47:35 mclareni
-* Kernlib
-*
-*
-#if defined(CERNLIB_IBMVM)
-/*DECK ID>, :clean_d.exec */
-/**********************************************************************/
-arg system
-
-'QUERY DISK (FIFO'; pull . /* to get rid of the header line */
- Do k=1 to queued()
- pull label vaddr fm .; parse var fm 1 fm 2 .
- If find(system,fm) > 0 Then iterate
- 'RELEASE 'fm
- 'EXECIO 1 CP (SKIP STRING DETACH 'vaddr
- End k
-
-/* Now I will detach all those disks which are not attached */
-'EXECIO * CP (FIFO STRING QUERY DASD'
- DO QUEUED(); pull 6 t 10
- If ^qdisk(t,'ACCESSED') Then Do
- 'EXECIO 1 CP (SKIP STRING DETACH 't
- End
- END
-
-EXIT 0
-/*--------------------------------------------------------------------*/
-#endif
diff --git a/src/packlib/kernlib/umon/obsolete/umsrvibm/cleanmac.dat b/src/packlib/kernlib/umon/obsolete/umsrvibm/cleanmac.dat
deleted file mode 100644
index c15385c..0000000
--- a/src/packlib/kernlib/umon/obsolete/umsrvibm/cleanmac.dat
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: cleanmac.dat,v 1.1.1.1 1996/02/15 17:47:35 mclareni Exp $
-*
-* $Log: cleanmac.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:47:35 mclareni
-* Kernlib
-*
-*
-#if defined(CERNLIB_IBMVM)
-/*DECK ID>, clean_up.xedit */
-/* Subroutine of STATSERV EXEC */
-':5 # SET ZONE 1 1'
-'ALL /*/'
- If rc=0 Then 'COMMAND DELETE *'
-'ALL'
-':5 # SET ZONE 1 *'
-'SORT * A 11 35 1 10'
-'BOT'
-'INPUT *_________ Lines above existed before 'date() time()' ____________*'
-'RECFM F # LRECL 72 # FILE'
-EXIT
-#endif
diff --git a/src/packlib/kernlib/umon/obsolete/umsrvibm/helpcmds.dat b/src/packlib/kernlib/umon/obsolete/umsrvibm/helpcmds.dat
deleted file mode 100644
index aeec791..0000000
--- a/src/packlib/kernlib/umon/obsolete/umsrvibm/helpcmds.dat
+++ /dev/null
@@ -1,117 +0,0 @@
-*
-* $Id: helpcmds.dat,v 1.1.1.1 1996/02/15 17:47:35 mclareni Exp $
-*
-* $Log: helpcmds.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:47:35 mclareni
-* Kernlib
-*
-*
-#if defined(CERNLIB_IBMVM)
-/*DECK ID>, umon_cmd.helpinfo */
-.cm CAT:INFO
-.cm NAM:UMON_CMDS
-.cm EXP: commands concerning program usage monitors.
-.cm DAT: 88.11.11
-.cm A/R: Bernd Pollermann
-.cm KEY: STATISTICS LOG LOGGING FREQUENCY UMON-COMMAND
-.cm KEY: PROGRAM-USAGE USAGE MONITOR MONITORING UMON U-MON U-MONITOR
-.cm KEY: SERVICE SERVICE-MACHINE SERVER
-.cm KEY: MONITOR-EXEC EXEC-USAGE
-.cm END:
-
-UMON commands
-
-UMON commands allow you to communicate with your UMON monitor(s). You may
-modify (the status of) your monitor(s) or handle the "log-sheets" produced
-by these monitors. UMON commands can only be issued by the monitor's admini-
-strator.
-
-If you are not familiar with the concepts of UMON please read first the UMON
-introduction (accessible via 'FIND UMON INTRODUCTION').
-
-Note: All UMON commands are Special MeSsaGes to the service machine UMON.
- Therefore ALL these commands MUST BE PRECEDED BY 'CP SMSG UMON '.
- For READABILITY ONLY this "prefix" has been omitted in the text below.
-
-
- Monitor commands:
-+-----------------------------------------------------------------------------+
-| QUERY MONitor moni --> shows attributes of monitor moni (Usage note 1) |
-| |
-| MODIFY MONitor moni [admin|=] [disk|=] [vaddr|=] [passw|=] ( Usage ) |
-| --> gives (new) attributes to moni ( note 2 ) |
-| |
-| ACTIVATE MONitor moni --> monitor moni will accept to log messages |
-| BLOCK MONitor moni --> monitor moni will refuse to log messages |
-| KILL MONitor moni --> monitor moni ceases to exist |
-+-----------------------------------------------------------------------------+
-where:
-
- moni is the name of the monitor
- admin is the login-id of the person in charge of the monitor moni
- disk is the logon-id to which the minidisk belongs
- vaddr the disk's virtual address
- passw the disk WRITE password
- = used instead of a parameter means that the parameter will not change
-
- Log-sheet Commands:
-+-----------------------------------------------------------------------------+
-| WRITEOUT LOGsheet moni --> empties the buffer onto disk (Usage note 3) |
-| |
-| SENDERASE LOGsheet moni --> sends log-sheet to your reader and erases it |
-| immediately afterwards (Usage Note 4) |
-| SEND LOGsheet moni --> sends log-sheet to your reader (Usage note 5) |
-| ERASE LOGsheet moni --> erase the log-sheet |
-+-----------------------------------------------------------------------------+
-where:
-
- moni is the name of the monitor used here as the filetype of the file
- onto which the monitor writes the log. The format of this file is:
-
- col content
-
- 1- 8 logon-id of the user who used the program
- 10-15 date in the form dd mmm
- 17-21 time in the form of hh:mm
-
-
-Usage notes:
-
-1. The meaning of the monitor attributes should be clear from the header in the
- response to your QUERY. The different forms of the monitor status 'blocked'
- 'a-blocked,'s-blocked' and 'v-blocked') need some further explanations:
-
- status meaning can be changed by
-
-a-blocked administrator-blocked, i.e. the 'ACTIVATE' command
- blocked via the 'BLOCK' command
-
-s-blocked space-blocked, i.e. blocked by freeing disk space by the
- UMON because the monitors disk 'SENDERASE' command, followed
- is full by 'ACTIVATE'
-
-v-blocked verification-blocked, i.e. blocked correcting the attributes by
- by UMON because of wrong attributes the 'MODIFY' command
- of the monitor
-
-2. MODIFY MONITOR allows you to change all the attributes including the logon-
- id of the administrator. If you do this only the new administrator will be
- able to communicate with 'your' monitor.
-
-3. For performance reasons logging is done in the memory of UMON. The buffer
- for each "log-sheet" is written on disk from time to time, at least once
- a day (around midnight). Use the WRITEOUT command BEFORE you reLINK to your
- monitor's disk if you want to have a look at the LATEST logs.
-
-4. 'SENDERASE LOGSHEET' is the recommended way of dealing with the "log-sheets"
- in case
-
- - your disk is getting full and
- - you do not want to loose a single recording
-
-5. Both 'SENDERASE' and 'SEND' imply 'WRITEOUT', i.e. you will get the latest
- version of the "log-sheet" into your reader.
-
-
-
-#endif
diff --git a/src/packlib/kernlib/umon/obsolete/umsrvibm/helpintro.dat b/src/packlib/kernlib/umon/obsolete/umsrvibm/helpintro.dat
deleted file mode 100644
index 724f42c..0000000
--- a/src/packlib/kernlib/umon/obsolete/umsrvibm/helpintro.dat
+++ /dev/null
@@ -1,81 +0,0 @@
-*
-* $Id: helpintro.dat,v 1.1.1.1 1996/02/15 17:47:36 mclareni Exp $
-*
-* $Log: helpintro.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:47:36 mclareni
-* Kernlib
-*
-*
-#if defined(CERNLIB_IBMVM)
-/*DECK ID>, umon_int.helpinfo */
-.cm CAT:INFO
-.cm NAM:UMON_INTRO
-.cm EXP: Introduction to UMON, a server for monitoring program usage
-.cm DAT: 88.11.11
-.cm A/R: Bernd Pollermann
-.cm KEY: INTRODUCTION STATISTICS LOG LOGGING FREQUENCY
-.cm KEY: PROGRAM-USAGE USAGE MONITOR MONITORING UMON U-MON U-MONITOR
-.cm KEY: SERVICE SERVICE-MACHINE SERVER UMON-INTRO
-.cm KEY: MONITOR-EXEC EXEC-USAGE
-.cm END:
-If you are the author (or responsible) of programs/execs you might want
-to know whether your programs are being used and how. UMON is a service
-machine which can supply such information via "usage monitors".
-
-The following help file gives you an introduction to UMON.
-
-WHAT CAN A MONITOR DO FOR YOU?
-==============================
-
-A monitor can note down on a "log-sheet"
-
- - when a program/exec was used,
- - by whom and
- - with which parameters.
-
-By analyzing the file produced by the monitor you can determine with what
-frequency your program/exec is being used and whether it is being used the
-way it was meant to be used.
-
-WHICH PROGRAMS CAN BE MONITORED?
-================================
-
-Any program which can execute the CP-command 'SMSG' can be monitored.
-
-This means that at CERN any REXX exec, XEDIT macro, ASSEMBLER or FORTRAN
-program can be monitored. The same is true for all programs calling a program
-written in the above mentionned languages.
-
-IS MONITORING DONE CONTINUOUSLY?
-================================
-
-Almost.
-
-However, to allow implementation of new features UMON can be taken down on
-Thursdays for one hour maximum (19.00-20.00). During this time monitoring is
-not possible.
-
-HOW TO START?
-=================
-
- - Choose one of your existing minidisks or create (and FORMAT) a new one.
- - Execute the command 'DIRM MDISK' and
- . choose 'RR' as access mode (ensures read-only access on your side)
- . give it a WRITE password (enables your monitor to write on it)
- - MAIL the WRITE password and the name you want to give to YOUR monitor to
- BERND at CERNVM
-
-We will then create the monitor for you and let you know about it. Once your
-monitor exists you can ACTIVATE and BLOCK it, MODIFY and KILL it with the
-help of UMON commands. These commands also allow you to deal with the "log-
-sheets". The UMON commands are described in the (FINDable) help file
-UMON_CMDS.
-
-Attention: Programs to be monitored must contain a call to 'LOGUSAGE'. For more
- details consult the (FINDable help file) LOGUSAGE.
-
-
-
-For any further questions, Please contact me by mail (BERND at CERNVM) or
-phone (ext. 2407).
-#endif
diff --git a/src/packlib/kernlib/umon/obsolete/umsrvibm/profexec.dat b/src/packlib/kernlib/umon/obsolete/umsrvibm/profexec.dat
deleted file mode 100644
index c2cd730..0000000
--- a/src/packlib/kernlib/umon/obsolete/umsrvibm/profexec.dat
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: profexec.dat,v 1.1.1.1 1996/02/15 17:47:35 mclareni Exp $
-*
-* $Log: profexec.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:47:35 mclareni
-* Kernlib
-*
-*
-#if defined(CERNLIB_IBMVM)
-/*DECK ID>, profile.exec */
-/*********************************************************************/
-/********=====================================================********/
-arg s; if s='' Then simulate=0; else simulate = 1
-address command
-/* %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% */
-/* % */ IF "QCONSOLE"('DISCO') | simulate Then do /* % */
-/* % */ /* % */
-/* % */ 'EXEC UMON' /* % */
-/* % */ /* % */
-/* % */ END /* % */
-/* %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% */
- ELSE DO
- 'CP SET PF6 RETRIEVE'
- 'CP SET PF21 IMMED CP SPOOL CON START *'
- 'CP SET PF22 IMMED CP SPOOL CON CLOSE STOP'
- 'CP SET PF23 IMMED READLOG'
- 'SET INPUT › AD'
- 'SET INPUT \ BD'
- 'SET INPUT º BD'
- 'CP SCREEN OUTAREA PINK'
- 'CP SCREEN VMOUT WHITE '
- END
-Exit 0
-#endif
diff --git a/src/packlib/kernlib/umon/obsolete/umsrvibm/profmail.dat b/src/packlib/kernlib/umon/obsolete/umsrvibm/profmail.dat
deleted file mode 100644
index 9d604fc..0000000
--- a/src/packlib/kernlib/umon/obsolete/umsrvibm/profmail.dat
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: profmail.dat,v 1.1.1.1 1996/02/15 17:47:35 mclareni Exp $
-*
-* $Log: profmail.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:47:35 mclareni
-* Kernlib
-*
-*
-#if defined(CERNLIB_IBMVM)
-/*DECK ID>, mailuser.xedit */
-/**/
-'MACRO SETMAIL PROMPT NO'
-'MACRO SETMAIL LOG NO'
-'MACRO SETMAIL ACK NO'
-'MACRO SETMAIL MENU.NAMEFIND NO'
-#endif
diff --git a/src/packlib/kernlib/umon/obsolete/umsrvibm/profxedit.dat b/src/packlib/kernlib/umon/obsolete/umsrvibm/profxedit.dat
deleted file mode 100644
index 847b36f..0000000
--- a/src/packlib/kernlib/umon/obsolete/umsrvibm/profxedit.dat
+++ /dev/null
@@ -1,40 +0,0 @@
-*
-* $Id: profxedit.dat,v 1.1.1.1 1996/02/15 17:47:35 mclareni Exp $
-*
-* $Log: profxedit.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:47:35 mclareni
-* Kernlib
-*
-*
-#if defined(CERNLIB_IBMVM)
-/*DECK ID>, profile.xedit */
-/* */
-SET SHADOW OFF
-SET Impcmscp off
-SET CURLINe on 4
-"SET VERIFY 1 72"
-set scale off 6
-set prefix on left
-set nulls on
-set fullread on
-set cmdline top
-set case mixed ignore
-set number on
-set wrap on
-SET PF4 BEFORE SOS TABCMDF
-/* set nulls on */
-/* Sample colour setup for 3270 PC */
-'COMMAND SET COLOR ARROW WHITE NONE NOHIGH'
-'COMMAND SET COLOR CMDLINE RED NONE NOHIGH'
-'COMMAND SET COLOR CURLINE PINK NONE HIGH'
-'COMMAND SET COLOR FILEAREA TURQUOIS NONE NOHIGH'
-'COMMAND SET COLOR IDLINE GREEN NONE NOHIGH'
-'COMMAND SET COLOR MSGLINE RED NONE HIGH'
-'COMMAND SET COLOR PENDING PINK NONE HIGH'
-'COMMAND SET COLOR PREFIX YELLOW NONE NOHIGH'
-'COMMAND SET COLOR SCALE YELLOW NONE NOHIGH'
-'COMMAND SET COLOR SHADOW WHITE NONE NOHIGH'
-'COMMAND SET COLOR STATAREA BLUE NONE NOHIGH'
-'COMMAND SET COLOR TABLINE WHITE NONE NOHIGH'
-'COMMAND SET COLOR TOFEOF YELLOW NONE NOHIGH'
-#endif
diff --git a/src/packlib/kernlib/umon/obsolete/umsrvibm/umon.dat b/src/packlib/kernlib/umon/obsolete/umsrvibm/umon.dat
deleted file mode 100644
index 80b1ddf..0000000
--- a/src/packlib/kernlib/umon/obsolete/umsrvibm/umon.dat
+++ /dev/null
@@ -1,581 +0,0 @@
-*
-* $Id: umon.dat,v 1.1.1.1 1996/02/15 17:47:35 mclareni Exp $
-*
-* $Log: umon.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:47:35 mclareni
-* Kernlib
-*
-*
-#if defined(CERNLIB_IBMVM)
-/*DECK ID>, umon.exec */
-/**********************************************************************/
-/************************ U M O N *********************************/
-/* 11.Nov.88 B.Pollermann, allows to set up program-usage-monitors */
-/**********************************************************************/
-address command
-UmonAdmin='BERND MARQUINA'
-/*.Main */
-CALL GET_DATE
-CALL INITIALIZE; If result=99 Then EXIT
-DO FOREVER; 'WAKEUP (CC RDR SMSG FILE (UMON TIMES A)'
-SELECT
- When rc=1 Then Do Queued(); pull flag sr c1 c2 parms
- If flag^='*SMSG' Then iterate
- If c1 ='!LOG!' Then Do; If ^s.c2.active Then Iterate
- k=s.c2.counter; k=k+1; s.c2.counter=k
- parse value time() with tim 6
- s.c2.k=left(sr,9)||dat' 'tim' 'parms
- If k < 20 Then Iterate
- CALL WRITEOUT c2
- End
- Else Do; parse var parms moni parms
- CALL !P '0 From: 'sr c1 c2 moni parms
- If find('RUN_DOWN CP CMS EXEC CALL INT',c1) > 0 Then Do
- CALL SPECIAL sr c1 c2 moni parms
- Iterate
- End
- If ^abbrev('MONITOR',c2,3) & ^abbrev('LOGSHEET',c2,3) Then Do
- "CP MSG "sr" 2nd parameter must be 'MONITOR' or 'LOGSHEET'"
- CALL !P '1 Neither !LOG! nor MONITOR or LOGSHEET'
- Iterate
- End
- If find(UmonAdmin,sr) > 0 Then CALL COMMANDS moni sr parms
- Else Do
- if c1='CREATE' then do
- 'CP MSG 'sr' You are not allowed to use this command!'
- CALL !P '1 illegal attempt to CREATE by 'sr; iterate
- end
- If s.moni.admin^=sr Then Do
- "CP MSG "sr" MONITOR name '"moni"' is probably mispelled"
- CALL !P '1 Monitor name mispelled or try for other monitor by 'sr
- End
- Else CALL COMMANDS moni sr parms
- End
- End /*Else*/
- End /*Queued() for rc=1 */
- When rc=3 Then Do
- parse pull . . . . . c1 c2 parms; 'CONWAIT'; 'DESBUF'
- If c1='CALL' Then interpret 'CALL 'c2 ''''parms''''
- End
- When rc=4 | rc=101 Then 'CP PURGE RDR ALL'
- Otherwise NOP
-END /*SELECT*/
-END /*FOREVER*/
-/**********************************************************************/
-/************ S U B R O U T I N E S ***********************************/
-/**********************************************************************/
-/*.command */
-COMMANDS: arg moni sr parms
- If abbrev('MONITOR',c2,3) Then Select
- when c1 = 'CREATE' Then CALL CREATE 'C' moni sr parms
- when c1 = 'MODIFY' Then CALL CREATE 'M' moni sr parms
- when c1 = 'KILL' Then CALL KILL moni sr
- when c1 = 'QUERY' Then CALL QUERY moni sr
-
- when c1 = 'ACTIVATE' Then CALL ADMIN 'ACTIVATE' moni sr
- when c1 = 'BLOCK' Then CALL ADMIN 'BLOCK' moni sr
- otherwise 'CP MSG 'sr' Valid MONITOR commands are:',
- 'ACTIVATE BLOCK QUERY KILL MODIFY'
- End
- Else /* if c2='LOGSHEET' */ Select
- when c1 = 'WRITEOUT' Then CALL WRITEOUT moni sr
- when c1 = 'SENDERASE' Then CALL SENDERASE 1 1 moni sr
- when c1 = 'SEND' Then CALL SENDERASE 1 0 moni sr
- when c1 = 'ERASE' Then CALL SENDERASE 0 1 moni sr
- otherwise 'CP MSG 'sr' Valid LOGSHEET commands are: WRITEOUT SENDERASE'
- End
-Return
-/**********************************************************************/
-/*.initialize */
-INITIALIZE: Procedure Expose s. disk_ids disk_links
- arg from_times; if from_times^=1 Then from_times=0
- drop s.;s.=0; disk_ids=''; disk_links=''; fid='MONITOR DEFINITIONS A0'
-'EXEC :CLEAN_DISK A P S Y'
-
-'EXECIO * DISKR 'fid' 0 (FINIS STEM DEFS.'
- IF rc>0 THEN DO
- temp='Problems reading 'fid': rc='rc' from EXECIO'
- m.0=1; m.1=temp; CALL !MAIL 'BERND DESASTER!'
- m.0=1; m.1=temp; CALL !MN 'BERND DESASTER!'
- CALL !P '2' temp; Return 99
- END
- ELSE DO LNUM=5 to DEFS.0; mk=0
- parse var defs.lnum 1 f 2 moni r d a p s o1 o2 o3 .
- If f='*' Then iterate
- CALL CHECK moni r d a p s
- /* If anything wrong then 'v-block' the moni */
- If result=-9 Then Do
- If s='v-blocked' Then iterate /* i.e. warning given only once */
- If length(r) > 8 Then r='BERND'
- If xaccount(r)='' Then r='BERND'; mk=mk+1;m.0=mk
- m.mk='Due to errors during verification your monitor is v-blocked.'
- m.0=mk
- CALL !MAIL r "Initialization Failed for Monitor '"moni"'."
- CALL !P "1 Monitor Initialization failed for monitor '"moni"'."
- CALL W_DEF lnum moni r d a p 'v-blocked' o1 o2 o3
- End
- Else Do; lk=result; newocc=0
- If s='v-blocked' Then do;new_st=1;s='modified';end; else new_st=0
- s.moni=1
- s.moni.link=lk
- s.moni.da=d' 'a
- If s='active' Then s.moni.active=1
- If from_times Then Do
- n=find('Monday Wednesday Friday',date('W'))
- If n>0 Then Do; Interpret "o"n"=qdisk(lk,'PERCENT')";newocc=1; end
- End
- If newocc | new_st Then CALL W_DEF lnum moni r d a p s o1 o2 o3
- End
- END LNUM
- If ^from_times Then Do
- CALL WRITEOUT_ALL 'RESTART'
- End
-Return
-/**********************************************************************/
-/*.create */
-CREATE: Procedure Expose s. disk_ids disk_links
- arg action moni sr r d a p .
- mk=0; fid='MONITOR DEFINITIONS A0'; a=right(a,4,'0')
- IF p^='' THEN DO
- /* Does the specified moni already exist? */
- 'EXECIO * DISKR 'fid' 5 (FIND / 'moni' / STEM T.'
- SELECT
- When rc=0 Then Do
- If action = 'C' Then Do
- "CP MSG "sr" Monitor '"moni"' already exists, use MODIFY"; Return
- End
- parse var t.1 . ro do ao po s o1 o2 o3 .; parse var t.2 . lnum
- if r='=' then r=ro; if d='=' then d=do; if p='=' then p=po
- if a='000=' then a=right(ao,4,'0')
- If d||a = do||ao Then samedisk=1; Else samedisk=0
- End
- When rc=2 | rc=3 Then Do
- If action = 'M' Then Do
- "CP MSG "sr" There is no monitor '"moni"', use CREATE"; Return
- End
- lnum=0; samedisk=0; s=''
- End
- Otherwise Do
- mk=mk+1; m.mk='Problems in reading 'fid' rc='rc'. See Bernd!'
- m.0=mk; CALL !M sr; Return
- End
- END /*SELECT*/
- /*Check whether new parms are any good, independent of what exists */
- CALL CHECK moni r d a p s
- If result^=-9 Then Do; lk=result; a=right(a,4,'0')
- If ^samedisk Then Do
- /* Does the specified disk already exist? */
- 'EXECIO * DISKR 'fid' 5 (FIND / 'left(d,8) a' / ZONE 21 35 STEM T.'
- If rc=0 Then Do; newdisk=0
- parse var t.1 . . . . . se oe1 oe2 oe3 .
- End
- Else newdisk=1
- End
- If action='C' Then Do
- mess='created'
- if newdisk Then do; s='created'; o1='...';o2='...';o3='...'; end
- else Do
- if se='s-blocked' Then s=se; else s='created'
- o1=oe1; o2=oe2; o3=oe3
- end
- End /*action='C'*/
- Else /*action='M'*/ Do
- mess='modified'
- if samedisk then do;if s='created' then s='modified'; end
- else do
- if newdisk Then do; s='modified'; o1='...';o2='...';o3='...'; end
- else do
- o1=oe1; o2=oe2; o3=oe3
- if se='s-blocked' then s=se; else s='modified'
- end
- end
- End /*action='M'*/
- CALL W_DEF lnum moni r d a p s o1 o2 o3
- If result^=0 Then Do; mk=mk+1
- m.mk='Problems in writing on 'fid' rc='result'. See Bernd!'
- m.0=mk; CALL !M sr
- Return
- End
- s.moni=1
- s.moni.da=d' 'a
- s.moni.link=lk
- If s='active' Then s.moni.active=1; Else s.moni.active=0
- mk=mk+1; m.mk='MONITOR for moni 'moni mess' successfully.'
- Select
- When s='active' Then mess='(logging will continue)'
- When s='s_blocked' Then mess=,
- 'But its disk is blocked. Use SENDERASE to free the disk'
- Otherwise mess='It can now be activated.'
- End
- mk=mk+1; m.mk=mess
- End /*Return^=-9*/
- 'FINIS MONITOR DEFINITIONS A0'
- END /* Admin specified correct number of parameters */
- ELSE DO
- mk=mk+1;m.mk=' You must specify all parameters'
- if action='M' then do
- mk=mk+1;m.mk=" (you can use an '=' for those to be left unchanged)"
- end
- END
- m.0=mk; CALL !MN sr 'FROM YOUR UMON SERVER:'
-Return
-/**********************************************************************/
-/*.kill */
-KILL: Procedure Expose s.
- arg moni sr .
- fid='MONITOR DEFINITIONS A0'
-'EXECIO * DISKR 'fid' 5 (FINIS FIND / 'moni' / STEM T.'
- If rc=0 Then Do
- parse var t.2 . lnum
- parse var t.1 moni r d a p s o1 o2 o3 .; parse var t.2 . lnum
- CALL W_DEF lnum moni r d a p 'killed' o1 o2 o3
- s.moni.=0
- m.1="Monitor '"moni"' killed."
- m.0=1; CALL !MN sr
- End
- Else "CP MSG "sr" Monitor '"moni"' not found."
-Return
-/**********************************************************************/
-/*.query */
-QUERY: Procedure
- arg moni sr .; f='MONITOR DEFINITIONS A0'
- If moni='ALL' Then m.fid=f
- Else Do
- 'EXECIO * DISKR 'f' 5 (FINIS FIND / 'moni' / STEM T.'
- If rc=0 Then Do
- parse var t.1 moni admin .
- queue ':5 # ZONE 11 20 # ALL ^/ 'admin' / # DEL *'
- queue 'TOP # GET 'f' 1 4 # FFILE T T A'
- 'XEDIT 'f' (NOPROF'; m.fid='T T A'
- End
- Else Do; "CP MSG "sr" Monitor '"moni"' not found."; Return; End
- End
- title='From your UMON SERVER: output from the QUERY command'
- If qfile(m.fid,'RECNO') < 19 Then CALL !MN sr title
- Else CALL !MAIL sr title
-Return
-/**********************************************************************/
-/*.admin-commands */
-ADMIN: Procedure Expose s.
- arg action moni sr .
- fid='MONITOR DEFINITIONS A0'
-'EXECIO * DISKR 'fid' 5 (FINIS FIND / 'moni' / STEM T.'
- If rc=0 Then Do
- parse var t.1 moni r d a p s o1 o2 o3 .; parse var t.2 . lnum
- If action='BLOCK' Then Do; m.0=2
- If s='s-blocked' Then Do
- m.1="Monitor '"moni"' was already blocked for lack of space"
- m.2="on the disk '"d a"'."
- End
- Else do; s='a-blocked'
- m.1="Monitor '"moni"' blocked. As long as there is enough free space"
- m.2="on the disk you can activate it whenever you want."
- End
- CALL W_DEF lnum moni r d a p s o1 o2 o3
- s.moni.active=0
- End
- Else /* action='ACTIVATE' */ Do; m.0=2
- If s='s-blocked' Then Do
- m.1="Monitor '"moni"' is blocked for lack of space on the disk"
- m.2=d a"'. I propose that you use 'SENDERASE' to free space."
- End
- Else do; s='active'
- m.1="Monitor '"moni"' activated. Logging starts immediately."
- m.2=''
- End
- CALL W_DEF lnum moni r d a p s o1 o2 o3
- s.moni.active=1
- End
- CALL !MN sr
- End
- Else "CP MSG "sr" Monitor '"moni"' not found."
-Return
-/**************************************************************************/
-/*.writeout */
-WRITEOUT_ALL: Procedure Expose s.
- arg reason
-'EXECIO * DISKR MONITOR DEFINITIONS A 1 (FINIS MARGIN 1 9 STEM TEMP.'
- If rc>0 Then Do
- NOP
- End
- Else Do k=5 to temp.0
- parse var temp.k 1 f 2 moni .; If f='*' Then iterate
- CALL WRITEOUT moni ',' reason
- End k
-Return
-
-WRITEOUT: Procedure Expose s.
- arg moni sr ',' reason
- if ^s.moni.active & sr='' Then Return
- if ^s.moni Then Do
- "CP MSG "sr" There is no alive monitor called '"moni"'."
- Return
- end
- k=s.moni.counter
- If reason='CENTER' | reason ='MAINT' | reason = 'RESTART' Then reas=1
- else reas=0
- If k > 0 | reas Then Do
- 'RELEASE Z'
- 'ACCESS 's.moni.link' Z'
- If rc>0 Then Do
- CALL !P "2 Rc="rc" for ACCESS to "s.moni.da" for Monitor '"moni"'."
- If sr^='' Then 'CP MSG 'sr' Serious problem with ACCESS to 's.moni.da
- Return
- End
- bytes_left=qdisk('Z','BLKSIZE')*qdisk('Z','BLKLEFT')
- If bytes_left/ 20 < 80 Then Call BLOCK_WARNING moni
- k=s.moni.counter; s.moni.counter=0
- If k > 0 Then do
- 'EXECIO 'k' DISKW 'moni' LOGSHEET Z (FINIS STEM S.'moni'.'
- If rc>0 Then Do; CALL BLOCK moni rc; Return; End
- end /* k > 0 */
- If reas Then do; bra='<<<'
- dat=date(); If length(dat)=10 Then dat=' 'dat;parse var dat dat 7
- If reason='CENTER' Then ,
- mess='UMON taken down for scheduled RUN DOWN of VM.'
- If reason='MAINT' Then ,
- mess='UMON taken down for regular Thursday-maintenance.'
- If reason='RESTART' Then do
- 'EXECIO 1 DISKR ALIVE UNTIL A 1 (VAR WHY_DOWN'
- If why_down^='RUN DOWN ' Then Do
- mess='UMON died because of system crash!'
- 'EXECIO 1 DISKW 'moni' LOGSHEET Z (FINIS STRING',
- '<<< UMON 'why_down' 'mess
- End
- mess='UMON restarted.'; bra='>>>'
- end
- parse value time() with tim 6
- 'EXECIO 1 DISKW 'moni' LOGSHEET Z (FINIS STRING',
- bra' UMON 'dat' 'tim' 'mess
- If rc>0 Then Do; CALL BLOCK moni rc; Return; End
- end /* there was a reason */
- End /* k>0 and there was a reason */
- If sr^='' Then 'CP MSG 'sr moni' LOGSHEET written out.'
-Return
-/*********************************************************************/
-/*.senderase */
-SENDERASE: Procedure Expose s.
- arg send erase moni sr .
-'RELEASE Z'
-'ACCESS 's.moni.link' Z'
- If rc>0 Then Do
- CALL !P "2 Rc="rc" for ACCESS to "s.moni.da" for Monitor '"moni"'."
- If sr^='' Then 'CP MSG 'sr' Serious problem with ACCESS to 's.moni.da
- Return
- End
- If send Then Do; k=s.moni.counter
- 'EXECIO 'k' DISKW 'moni' LOGSHEET Z (FINIS STEM S.'moni'.'
- 'EXEC SENDFILE 'moni' LOGSHEET Z TO 'sr
- End
- If erase Then Do
- 'ERASE 'moni' LOGSHEET Z'
- 'EXECIO * DISKR MONITOR DEFINITIONS A 5 (FIND / 'moni' / STEM T.'
- If rc>0 Then Return
- parse var t.1 2 moni r d a p s o1 o2 o3 . ; parse var t.2 . lnum
- If s='s-blocked' Then Do
- CALL W_DEF lnum moni r d a p 'a-blocked' o1 o2 o3
- 'CP MSG 'sr' You can now activate monitor 'moni
- End
- End
- s.moni.counter=0
-Return
-/*.slaves */
-/**********************************************************************/
-/************ S L A V E S *********************************************/
-/**********************************************************************/
-CHECK: Procedure Expose s. m. mk disk_ids disk_links
- /* If possible at CHECK sets s.moni.admin down here */
- parse arg moni r d a p s .; accepted=1
- If symbol(moni)='BAD' | pos('.',moni) > 0 Then do; accepted=0
- mk=mk+1;m.mk=' Name of moni:' moni 'not a valid REXX symbol.'
- End
- If moni='ALL' Then do; accepted=0
- mk=mk+1;m.mk=" 'ALL' is not a valid moni name."
- End
- If length(moni) > 8 Then do; accepted=0
- mk=mk+1;m.mk=' Name of moni:' moni 'is longer than 8 characters.'
- End
- /* The check for adminstrator MUST FOLLOW the moni-validity-check */
- goodr=0; If length(r) <= 8 Then if xaccount(r) ^= '' then goodr=1
- If ^goodr Then do; accepted=0
- mk=mk+1;m.mk=' Logon-id of administrator: 'r' not a valid account.'
- End; Else if accepted then s.moni.admin=r
- goodd=0; If length(d) <= 8 Then if xaccount(d) ^= '' then goodd=1
- If ^goodd Then do; accepted=0
- mk=mk+1;m.mk=' Disk-id: 'd' not a valid account.'
- End
- If ^datatype(a,'X') Then do; accepted=0; goodd=0
- mk=mk+1;m.mk=' Disk-addr: 'a' not a valid hexadecimal number.'
- End
- If goodd Then Do
- da=d'"'strip(a,'L','0'); n=find(disk_ids,da)
- If n=0 Then Do
- l=qdisk('?','ADDRESS')
- 'CP LINK TO 'd a' AS 'l' M 'p
- If rc>0 Then Do
- mk=mk+1;m.mk=' Problem with LINKING to 'd a '(rc='rc')'
- accepted=0
- End
- Else Do
- disk_ids=disk_ids' 'da
- disk_links=disk_links' 'l
- End
- End
- Else l=word(disk_links,n)
- End /* for goodd=1 */
- If s^='' Then Do
- temp='created modified active a-blocked s-blocked v-blocked'
- If find(temp,s) = 0 Then Do
- accepted=0
- mk=mk+1;m.mk=" Status was '"s"' instead of one of the following:"
- mk=mk+1;m.mk=' 'temp; mk=mk+1; m.mk=' '
- End
- End
- If ^accepted Then Return -9
-Return l
-
-GET_DATE:
- dat=date(); If length(dat)=10 Then dat=' 'dat; parse var dat dat 7
-Return
-
-W_DEF: Procedure
- parse arg lnum moni admin disk_id disk_addr passw st o1 o2 o3 .
- tmp=left(moni,9),
- left(admin,9),
- left(disk_id,8),
- right(disk_addr,4,'0')' ',
- left(passw,9),
- left(st,11) right(o1,3) right(o2,3) right(o3,3)' %'
- if st='killed' Then tmp='*'||translate(tmp,'.',' '); else tmp=' 'tmp
-'EXECIO 1 DISKW MONITOR DEFINITIONS A0 'lnum' F 72 (FINIS VAR TMP'
-Return rc
-
-/*.messages */
-!M: Procedure Expose m.
- If ^datatype(m.0,'W') Then Return
- arg addr .
- Do k=1 to m.0; 'CP MSG 'addr m.k; End k
- DROP m.
-Return
-
-!MN: Procedure Expose m.
- parse arg addr title; addr=upper(addr)
- If title='' Then title='FROM YOUR UMON SERVER:'
- If FEXIST(m.fid) Then 'EXECIO * DISKR 'm.fid' 1 (FINIS STEM M.'
- Else if ^datatype(m.0,'W') Then Return
- If m.0=0 Then Return
-'EXEC TELL 'addr title
- Do k=1 to m.0; 'EXEC TELL 'addr' 'm.k; End k
- DROP m.
-Return
-
-!MAIL: Procedure Expose m.
- parse arg addr title; addr=upper(addr)
- If title='' Then title='FROM YOUR UMON SERVER:'
- If ^FEXIST(m.fid) Then Do
- If ^datatype(m.0,'W') Then Return; If m.0 < 1 Then Return
- m.fid='DEFAULT MAIL A1'
- If FEXIST(m.fid) Then 'ERASE 'm.fid
- 'EXECIO 'm.0' DISKW 'm.fid' (FINIS STEM M.'
- End
-'EXEC MAIL 'addr' (NOLOG NOPROMPT FILE 'm.fid' NOEDIT SUBJECT 'title
- DROP m.
-Return
-
-!P: Procedure Expose dat
- parse arg level text
- parse value time() with tim 6; t=dat' 'tim
- SELECT
- When level = 0 Then rem=' '
- When level = 1 Then rem='U-P:'
- When level = 2 Then rem='BUG:'
- Otherwise Do; level=2; rem='??'; End
- END
- If level=2 Then Do
- 'GLOBALV SELECT *ERRORS GET NUM'
- if ^datatype(num,'W') Then num=1; else num=num+1
- 'GLOBALV SELECT *ERRORS SETP NUM'
- End
-'EXECIO 1 DISKW UMON PROTOCOL A5 (FINIS STRING 'rem t text
-Return
-
-/* */
-BLOCK_WARNING: Procedure Expose s.
- arg moni .
- m.=' ';m.0=9
- m.1="Disk '"s.moni.da"' is getting full due to "moni" LOGSHEET !"
- m.2='Recording supposed to go onto this disk will soon stop.'
- m.4='Please issue the command:'
- m.6=' CP SMSG UMON SENDERASE LOGSHEET 'moni
- m.8='If you do this in time, logging will continue smoothly.'
- CALL !MAIL s.moni.admin "Disk '"s.moni.da"' is getting full"
-Return
-/* */
-BLOCK: Procedure Expose s.
- arg moni rc .
- s.moni.active=0
- CALL !P 1 "Rc="rc" for WRITEOUT EXECIO. Monitor '"moni"' s-blocked."
-'EXECIO * DISKR MONITOR DEFINITIONS A 5 (FIND / 'moni' / STEM T.'
- If rc>0 Then Return
- parse var t.1 2 moni r d a p s o1 o2 o3 . ; parse var t.2 . lnum
- CALL W_DEF lnum moni r d a p 's-blocked' o1 o2 o3
- m.=' ';m.0=13
- m.1="Disk '"s.moni.da"' is full due to "moni" LOGSHEET !"
- m.2='It cannot receive any logging any more.'
- m.4='Please issue the command:'
- m.6=' CP SMSG UMON SENDERASE LOGSHEET 'moni
- m.8='Once you have emptied the disk you must activate the monitor'
- m.10='by issuing the command:'
- m.12=' CP SMSG UMON ACTIVATE MONITOR 'moni
- CALL !MAIL s.moni.admin "Monitor '"moni"' Blocked."
-Return
-
-/*.time */
-W_T: 'EXECIO 1 DISKW ALIVE UNTIL A1 1 F 12 (FINIS STRING 'dat' 'time();Return
-MIDNIGHT: arg action
-'CP SLEEP 2 MIN'
- CALL WRITEOUT_ALL
- If action='CLEAN_UP' Then Do
- 'XEDIT MONITOR DEFINITIONS A (PROFILE CLEAN_UP'
- 'FINIS MONITOR DEFINITIONS A'
- CALL !P 0 'Clean up of MONITOR DEFINITIONS'
- End
- If qfile('UMON PROTOCOL A2','RECNO') > 1000 Then do
- 'EXEC SENDFILE UMON PROTOCOL A TO BERND'
- 'ERASE UMON PROTOCOL A'
- End
-'GLOBALV INIT'
- CALL GET_DATE
- CALL INITIALIZE 1
-Return 0
-CHECK_DISKS:
- NOP
-Return
-/**********************************************************************/
-SPECIAL: arg sr sprefix scommand sparms
- srp=sr||sprefix
- SELECT
- WHEN srp='CONSOLERUN_DOWN' Then CALL RUN_DOWN 'CENTER' sr
- WHEN srp='BERNDRUN_DOWN' Then CALL RUN_DOWN 'MAINT' sr
- WHEN srp='BERNDCP' Then 'CP 'scommand sparms
- WHEN srp='BERNDCMS' Then scommand sparms
- WHEN srp='BERNDEXEC' Then 'EXEC 'scommand sparms
- WHEN srp='BERNDCALL' Then Nop
- WHEN srp='BERNDINT' Then Nop
- OTHERWISE 'CP MSG 'sr '???'
- END
-RETURN
-
-RUN_DOWN: Procedure Expose s.
- arg reason sr
- If reason = 'MAINT' Then Do
- parse value time() with temp 3
- If date('W')^='Thursday' | temp^=19 Then Do
- 'CP MSG 'sr' Not the right time or day!'; Return
- end
- End
- CALL WRITEOUT_ALL reason
-'EXECIO 1 DISKW ALIVE UNTIL A1 1 F 12 (FINIS STRING RUN DOWN '
-'CP LOGOUT'
-RETURN
-#endif
diff --git a/src/packlib/kernlib/umon/obsolete/umsrvibm/umondef.dat b/src/packlib/kernlib/umon/obsolete/umsrvibm/umondef.dat
deleted file mode 100644
index 6ec6074..0000000
--- a/src/packlib/kernlib/umon/obsolete/umsrvibm/umondef.dat
+++ /dev/null
@@ -1,15 +0,0 @@
-*
-* $Id: umondef.dat,v 1.1.1.1 1996/02/15 17:47:35 mclareni Exp $
-*
-* $Log: umondef.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:47:35 mclareni
-* Kernlib
-*
-*
-#if defined(CERNLIB_IBMVM)
-/*DECK ID>, monitor.definitions */
-+---------+---------+--------------+--------+----------+---------------+
-|Monitor |Admini- | Disk- | Pass- | | Disk-occupancy|
-| name | strator| name vaddr | word | Status | Mon Wed Fri |
-+---------+---------+--------------+--------+----------+---------------+
-#endif
diff --git a/src/packlib/kernlib/umon/obsolete/umsrvibm/umontime.dat b/src/packlib/kernlib/umon/obsolete/umsrvibm/umontime.dat
deleted file mode 100644
index 48acfe8..0000000
--- a/src/packlib/kernlib/umon/obsolete/umsrvibm/umontime.dat
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: umontime.dat,v 1.1.1.1 1996/02/15 17:47:35 mclareni Exp $
-*
-* $Log: umontime.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:47:35 mclareni
-* Kernlib
-*
-*
-#if defined(CERNLIB_IBMVM)
-/*DECK ID>, umon.times */
-ALL +6 16:07:11 CALL W_T
-MON 23:59:00 04/15/91 CALL MIDNIGHT
-TUE 23:59:00 04/09/91 CALL MIDNIGHT
-WED 23:59:00 04/10/91 CALL MIDNIGHT
-THU 23:59:00 04/11/91 CALL MIDNIGHT
-FRI 23:59:00 04/12/91 CALL MIDNIGHT
-SAT 23:59:00 04/13/91 CALL MIDNIGHT
-SUN 23:59:00 04/14/91 CALL MIDNIGHT CLEAN_UP
-#endif
diff --git a/src/packlib/kernlib/umon/obsolete/umuipibm/Makefile.in b/src/packlib/kernlib/umon/obsolete/umuipibm/Makefile.in
deleted file mode 100644
index 31a411c..0000000
--- a/src/packlib/kernlib/umon/obsolete/umuipibm/Makefile.in
+++ /dev/null
@@ -1,63 +0,0 @@
-#
-# umon/umuipibm/Makefile.in - compiles and archives the source code in this directory.
-# It is invoked by Makefile.xxxxx in the above directory, where xxxxx is the name of the library.
-# Generated by car2cvs $Revision: 1.1.1.1 $ (nk)
-#
-# $Id: Makefile.in,v 1.1.1.1 1996/02/15 17:47:35 mclareni Exp $
-#
-# $Log: Makefile.in,v $
-# Revision 1.1.1.1 1996/02/15 17:47:35 mclareni
-# Kernlib
-#
-#
-
-MAKE = gmake
-SHELL = /bin/sh
-srcdir = @srcdir@
-VPATH = @srcdir@
-MACHINE = @MACHINE@
-
-ifeq "$(srcdir)" "."
- absrcdir = $(shell pwd)
-else
- absrcdir = $(srcdir)
-endif
-
-OBJS=
-
-LIBRARY=dummy
-ifeq "$(LIBRARY)" "dummy"
- OBJS=
-endif
-.SUFFIXES: .cdf
-
-.PHONY:dummy production vaxsrc vaxcom debug clean distclean realclean TAGS depend fort_depend c_depend cc_depend
- @
-
-dummy::
- @echo Run Makefile in the parent directory
-
-debug production:$(OBJS)
- @test "$(LIBRARY)" = "dummy" || test "`echo *.o`" = "*.o" || ($(AR) rvs $(LIBRARY) *.o;$(RM) *.o)
-
-vaxsrc:$(VAX_FORTRAN_SOURCES)
- @
-
-vaxcom:$(VAX_COMS)
- @
-
-clean:
- @rm -f *.o *.bak
-
-distclean:clean
- @rm -f Makefile Makefile.obj
-
-realclean:
- @rm -f *~ #*
-
-TAGS:$(absrcdir)/*[Fch]
- @$(ETAGS) -f $(dir $(LIBRARY))/TAGS.$(LIBRARY_NAME) $(absrcdir)/*[Fch]
-
-
-
-
diff --git a/src/packlib/kernlib/umon/obsolete/umuipibm/README b/src/packlib/kernlib/umon/obsolete/umuipibm/README
deleted file mode 100644
index 0ab91ce..0000000
--- a/src/packlib/kernlib/umon/obsolete/umuipibm/README
+++ /dev/null
@@ -1,9 +0,0 @@
-*
-* $Id: README,v 1.1.1.1 1996/02/15 17:47:35 mclareni Exp $
-*
-* $Log: README,v $
-* Revision 1.1.1.1 1996/02/15 17:47:35 mclareni
-* Kernlib
-*
-*
-* This directory was created from umon.car patch umuipibm
diff --git a/src/packlib/kernlib/umon/obsolete/umuipibm/umcom.dat b/src/packlib/kernlib/umon/obsolete/umuipibm/umcom.dat
deleted file mode 100644
index 6f9fd0b..0000000
--- a/src/packlib/kernlib/umon/obsolete/umuipibm/umcom.dat
+++ /dev/null
@@ -1,44 +0,0 @@
-*
-* $Id: umcom.dat,v 1.1.1.1 1996/02/15 17:47:35 mclareni Exp $
-*
-* $Log: umcom.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:47:35 mclareni
-* Kernlib
-*
-*
-#if defined(CERNLIB_IBMVM)
-/*DECK ID>, umcom.exec */
-/**********************************************************************
- * *
- * UMCOM EXEC V1.00 *
- * *
- * User Interface to UMON Service Machine *
- * Author: M.Marquina 91/02/27 *
- * *
- * Mods Date Comments *
- * *
- **********************************************************************/
- Address Command
- Arg cmd umlist
-
- If 'ABBREV'("CREATE",cmd,1) Then Do
- 'CP SMSG UMON CREATE MONITOR' umlist
- Exit
- End
- If 'ABBREV'("MODIFY",cmd,1) Then Do
- 'CP SMSG UMON MODIFY MONITOR' umlist
- Exit
- End
- If 'ABBREV'("ACTIVATE" ,cmd,1) Then cmd="ACTIVATE MONITOR"
- If 'ABBREV'("BLOCK" ,cmd,1) Then cmd="BLOCK MONITOR"
- If 'ABBREV'("ERASE" ,cmd,1) Then cmd="ERASE LOGSHEET"
- If 'ABBREV'("KILL" ,cmd,1) Then cmd="KILL MONITOR"
- If 'ABBREV'("QUERY" ,cmd,1) Then cmd="QUERY MONITOR"
- If 'ABBREV'("SEND" ,cmd,1) Then cmd="SEND LOGSHEET"
- If 'ABBREV'("SENDERASE",cmd,5) Then cmd="SENDERASE LOGSHEET"
- If 'ABBREV'("WRITEOUT" ,cmd,1) Then cmd="WRITEOUT LOGSHEET"
-
- Do n=1 to 'WORDS'(umlist)
- 'CP SMSG UMON' cmd 'WORD'(umlist,n)
- End
-#endif
diff --git a/src/packlib/kernlib/umon/obsolete/umuipibm/umlog.dat b/src/packlib/kernlib/umon/obsolete/umuipibm/umlog.dat
deleted file mode 100644
index e2f65a5..0000000
--- a/src/packlib/kernlib/umon/obsolete/umuipibm/umlog.dat
+++ /dev/null
@@ -1,76 +0,0 @@
-*
-* $Id: umlog.dat,v 1.1.1.1 1996/02/15 17:47:35 mclareni Exp $
-*
-* $Log: umlog.dat,v $
-* Revision 1.1.1.1 1996/02/15 17:47:35 mclareni
-* Kernlib
-*
-*
-#if defined(CERNLIB_IBMVM)
-/*DECK ID>, umlog.exec */
-/**********************************************************************
- * *
- * UMLOG EXEC V1.05 *
- * *
- * UMON logging utility *
- * Author: M.Marquina 90/08/17 *
- * *
- * Mods Date Comments *
- * MARQUINA 90/09/19 Read also the flag file to add up monitoring *
- * 90/12/13 Do not overwrite original monitor name when using*
- * the flag file *
- * 91/03/08 Cut the SMSG to the buffer length of UMON *
- * 91/04/02 Do not add extra information for normal monitors *
- * 91/07/11 Suppress double logging of userid *
- * Fix logging of nested calls to UMLOG *
- * *
- **********************************************************************/
- Address Command
- Arg monitor flag text
-
- ffile='XCALL'('FILEID')
- If ffile="" Then ffile="CRNQDISK HISTORY"
- umlist='SETENV'("UMON")
- Parse Var ffile ffn fft .
-
- If monitor="*" Then monitor=ffn
-
- sfile="STATISTI ON:" 'FMODE'(ffile)
- If 'FEXIST'(sfile) Then Do
- 'EXECIO 1 DISKR' sfile '( FINIS VAR UMLIS2'
- If 'WORD'(umlis2,1)="ON:" Then Do
- mlist='SUBWORD'(umlis2,2)
-/* If fft^="HISTORY" Then text=fft ffn text
-*/ If mlist="*" Then mlist=monitor
- umlist=umlist mlist
- End
- End
-
- If 'FIND'(umlist,monitor)=0 Then Exit
-
- wmon='EXECIO 0 CP (NOTYPE STRING SMSG UMON !LOG!'
- wlen=123 /* Buffer of SMSG for UMON-CERNVM */
-
- umlog='SETENV'("UMLOG") /* To trap aborted executions */
- If 'LENGTH'(umlog)>wlen Then umlog='LEFT'(umlog,wlen)
- 'EXEC SETENV UMLOG'
-
- user='BNAME'("USERID")
- If flag=0 Then Do
- If umlog^="" Then wmon umlog
- 'EXEC SHOWTIME ( START LIFO'
- 'EXEC SETENV UMLOG' monitor 'RIGHT'("-1",65) text
- Exit
- End
- sinfo=""
- If flag=1 Then Do
- 'EXEC SHOWTIME ( LIFO'
- Pull sinfo
- umlog=""
- text=sinfo text
- End
- If 'LENGTH'(monitor text)>wlen Then text='LEFT'(text,wlen-11)
- If umlog^="" Then wmon umlog
- wmon monitor text
- Exit
-#endif
diff --git a/src/packlib/kernlib/umon/umlog/pilot.h b/src/packlib/kernlib/umon/umlog/pilot.h
deleted file mode 100644
index 33ff52d..0000000
--- a/src/packlib/kernlib/umon/umlog/pilot.h
+++ /dev/null
@@ -1,35 +0,0 @@
-#if defined(CERNLIB_IBMMVS)||defined(CERNLIB_IBMVM)
-#ifndef CERNLIB_IBM
-#define CERNLIB_IBM
-#endif
-#endif
-#if defined(CERNLIB_IBMRT)
-#ifndef CERNLIB_IBMRS
-#define CERNLIB_IBMRS
-#endif
-#endif
-#if defined(CERNLIB_VAXVMS)||defined(CERNLIB_VAXULTRIX)
-#ifndef CERNLIB_VAX
-#define CERNLIB_VAX
-#endif
-#endif
-#if defined(CERNLIB_CDC)||defined(CERNLIB_CRAY)
-#ifndef CERNLIB_SINGLE
-#define CERNLIB_SINGLE
-#endif
-#endif
-#if defined(CERNLIB_IBM)||defined(CERNLIB_VAX)||defined(CERNLIB_NORD)
-#ifndef CERNLIB_DOUBLE
-#define CERNLIB_DOUBLE
-#endif
-#endif
-#if (defined(CERNLIB_UNIX))&&(!defined(CERNLIB_SINGLE))
-#ifndef CERNLIB_DOUBLE
-#define CERNLIB_DOUBLE
-#endif
-#endif
-#if defined(CERNLIB_UNIX)
-#ifndef CERNLIB_BSLASH
-#define CERNLIB_BSLASH
-#endif
-#endif
diff --git a/src/packlib/kernlib/umon/umon/Imakefile b/src/packlib/kernlib/umon/umon/Imakefile
deleted file mode 100644
index 2fd9800..0000000
--- a/src/packlib/kernlib/umon/umon/Imakefile
+++ /dev/null
@@ -1,3 +0,0 @@
-INCLUDES= pilot.h
-
-InstallIncludes($(INCLUDES),$(CERN_INCLUDEDIR),umon)
diff --git a/src/packlib/kernlib/umon/umonftn/Imakefile b/src/packlib/kernlib/umon/umonftn/Imakefile
deleted file mode 100644
index 71a0cbe..0000000
--- a/src/packlib/kernlib/umon/umonftn/Imakefile
+++ /dev/null
@@ -1,3 +0,0 @@
- SRCS_F= umcom.F umlog.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kernlib/umon/umonftn/umcom.F b/src/packlib/kernlib/umon/umonftn/umcom.F
deleted file mode 100644
index e676808..0000000
--- a/src/packlib/kernlib/umon/umonftn/umcom.F
+++ /dev/null
@@ -1,14 +0,0 @@
-*
-* $Id: umcom.F,v 1.2 1996/12/02 15:46:23 gunter Exp $
-*
-* $Log: umcom.F,v $
-* Revision 1.2 1996/12/02 15:46:23 gunter
-* Remove umlog monitoring by replacing it by a dummy
-*
-* Revision 1.1.1.1 1996/02/15 17:47:34 mclareni
-* Kernlib
-*
-*
- SUBROUTINE UMCOM(CMD,MONIT,TEXT)
- RETURN
- END
diff --git a/src/packlib/kernlib/umon/umonftn/umlog.F b/src/packlib/kernlib/umon/umonftn/umlog.F
deleted file mode 100644
index b2f71fb..0000000
--- a/src/packlib/kernlib/umon/umonftn/umlog.F
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: umlog.F,v 1.3 1997/09/02 14:27:35 mclareni Exp $
-*
-* $Log: umlog.F,v $
-* Revision 1.3 1997/09/02 14:27:35 mclareni
-* WINNT correction
-*
-* Revision 1.2 1996/12/02 15:46:24 gunter
-* Remove umlog monitoring by replacing it by a dummy
-*
-* Revision 1.1.1.1 1996/02/15 17:47:34 mclareni
-* Kernlib
-*
-*
- SUBROUTINE UMLOG(MONIT,TEXT)
- CHARACTER*(*) MONIT, TEXT
- RETURN
- END
diff --git a/src/packlib/kuip/Imakefile b/src/packlib/kuip/Imakefile
deleted file mode 100644
index 4476b9c..0000000
--- a/src/packlib/kuip/Imakefile
+++ /dev/null
@@ -1,29 +0,0 @@
-
-#define IHaveSubdirs
-#define PassCDebugFlags
-
-LIBDIRS= code_kuip
-
-#ifndef CERNLIB_WINNT
-LIBDIRS := $(LIBDIRS) code_motif
-#else
-LIBDIRS := $(LIBDIRS) code_windows
-#endif
-
-SUBDIRS= $(LIBDIRS) programs examples kuip
-
-TopOfPackage(kuip)
-
-SubdirLibraryTarget(kuip,$(LIBDIRS))
-
-InstallBinSubdirs(programs)
-
-TestSubdirs(examples)
-
-/*
-doc kuiph ykuip
- */
-
-InstallIncludeSubdirs(kuip)
-
-DelegateTarget(bin/kuipc,programs)
diff --git a/src/packlib/kuip/code_kuip/Imakefile b/src/packlib/kuip/code_kuip/Imakefile
deleted file mode 100644
index ac9b1f3..0000000
--- a/src/packlib/kuip/code_kuip/Imakefile
+++ /dev/null
@@ -1,41 +0,0 @@
-#define IHaveCDF
-
-SRCS_C= getline.c kalias.c kbrow.c kedit.c kexec.c khash.c kicon.c \ @@\
- kienbr.c kipiaf.c kkern.c kmacro.c kmath.c kmenu.c kmisc.c \ @@\
- kmodel.c kmterm.c kuinit.c kutrue.c kuvers.c kuwhag.c \ @@\
- kuwhat.c kvect.c
-
-#ifdef CERNLIB_WINNT
-SRCS_C :=$(SRCS_C) kmutil0.c
-CDEBUGFLAGS = NoOpCDebugFlags
-#endif
-
-SRCS_F= kiargc.F kibres.F kiclos.F kictoi.F kicton.F kidate.F \ @@\
- kierrf.F kiinit.F kilexp.F kilogn.F kilun.F kindex.F \ @@\
- kindot.F kintoc.F kisndv.F kivind.F kudpar.F kugetv.F \ @@\
- kuinqf.F kulogn.F kuopen.F kuread.F kuvcre.F kuvdel.F \ @@\
- kuvec.F kuvect.F kuwrit.F kxcopv.F kxcrv1.F kxcrv2.F \ @@\
- kxdelv.F kxlisv.F kxreav.F kxunit.F kxvope.F kxwriv.F \ @@\
- kxdsig.F
-
-
-SRCS_CDF= kuipcdf.cdf
-
-#if defined(CERNLIB_QMVAOS)
-SpecialFortranLibObjectRule(kxcopv,kxcopv,-O2,NullParameter)
-#endif
-
-#if defined(CERNLIB_IBMMVS)
-SRCS_F := $(SRCS_F) kdialo.F kprefi.F putgeti.F kmvsed.F kmvspg.F kmvssh.F
-SCRS_S = kprefb.s put.s putget.s userid.s
-#endif
-
-#if defined(CERNLIB_IBMVM) || defined(CERNLIB_IBMMVS)
-SRCS_F := $(SRCS_F) k77calls.F kuserid.F
-#endif
-
-#if defined(CERNLIB_NEWLIB)
-SRCS_F := $(SRCS_F) itoft.F
-#endif
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kuip/code_kuip/getline.c b/src/packlib/kuip/code_kuip/getline.c
deleted file mode 100644
index 8bc4d73..0000000
--- a/src/packlib/kuip/code_kuip/getline.c
+++ /dev/null
@@ -1,1523 +0,0 @@
-/*
- * $Id: getline.c,v 1.3 1998/08/25 12:47:32 mclareni Exp $
- *
- * $Log: getline.c,v $
- * Revision 1.3 1998/08/25 12:47:32 mclareni
- * QMGLIBC changes for Linux RH51
- *
- * Revision 1.2 1997/03/17 16:54:56 mclareni
- * WNT mods
- *
- * Revision 1.1.1.1.2.1 1997/01/21 11:32:44 mclareni
- * All mods for Winnt 96a on winnt branch
- *
- * Revision 1.1.1.1 1996/03/08 15:32:55 mclareni
- * Kuip
- *
- */
-#if !defined(CERNLIB_IBMALL)
-/*CMZ : 2.06/03 12/01/95 17.04.22 by Gunter Folger*/
-/*-- Author :*/
-
-#include "kuip/kuip.h"
-#include "kuip/kfor.h"
-#include "kuip/kmenu.h"
-#include "kuip/kflag.h"
-
-
-#if 0
-static char rcsid[] =
-"$Id: getline.c,v 1.3 1998/08/25 12:47:32 mclareni Exp $";
-static char *copyright = "Copyright (C) 1991, 1992, Chris Thewalt";
-#endif
-
-/*
- * Copyright (C) 1991, 1992 by Chris Thewalt (thewalt at ce.berkeley.edu)
- *
- * Permission to use, copy, modify, and distribute this software
- * for any purpose and without fee is hereby granted, provided
- * that the above copyright notices appear in all copies and that both the
- * copyright notice and this permission notice appear in supporting
- * documentation. This software is provided "as is" without express or
- * implied warranty.
- */
-
-static int gl_tab(); /* forward reference needed for gl_tab_hook */
-
-/********************* exported interface ********************************/
-
-#if defined(CERNLIB_QMGLIBC)
-extern char *getline2( const char* ); /* read a line of input */
-#else
-extern char *getline( const char* ); /* read a line of input */
-#endif
-extern void gl_setwidth( int ); /* specify width of screen */
-extern void gl_histadd( const char* ); /* adds entries to hist */
-
-extern void gl_char_init(); /* get ready for no echo input */
-extern void gl_char_cleanup(); /* undo gl_char_init */
-extern int gl_reset(); /* cleanup interrupted getline */
-extern void gl_reinit(); /* reinitialize interrupted getline */
-
-int (*gl_in_hook)() = 0;
-int (*gl_out_hook)() = 0;
-int (*gl_tab_hook)() = gl_tab;
-
-/******************** imported interface *********************************/
-
-/*
-#include <string.h>
-#include <ctype.h>
-#include <errno.h>
-#include <signal.h>
-
-extern int isatty();
-extern void *malloc();
-extern void free();
-extern int raise();
-*/
-
-/******************** internal interface *********************************/
-
-#define BUF_SIZE 1024
-
-static int gl_init_done = -1; /* terminal mode flag */
-static int gl_char_init_done = 0; /* has gl_char_init been called */
-static int gl_termw = 80; /* actual terminal width */
-static int gl_scroll = 27; /* width of EOL scrolling region */
-static int gl_width = 0; /* net size available for input */
-static int gl_extent = 0; /* how far to redraw, 0 means all */
-static int gl_overwrite = 0; /* overwrite mode */
-static int gl_def_overwrite = 0; /* default overwrite mode */
-static int gl_edit_style = 0; /* 0=ksh 1=DCL */
-static int gl_no_echo = 0; /* do not echo input characters */
-static int gl_passwd = 0; /* do not echo input characters */
-static int gl_erase_line = 0; /* erase line before returning */
-static int gl_pos, gl_cnt = 0; /* position and size of input */
-static char gl_buf[BUF_SIZE]; /* input buffer */
-static char gl_killbuf[BUF_SIZE]=""; /* killed text */
-static char gl_outbuf[BUF_SIZE]=""; /* output buffer for gl_putc() */
-static char *gl_outptr = gl_outbuf; /* ptr to next free pos. in outbuf */
-static const char *gl_prompt; /* to save the prompt string */
-static int gl_intrc = 0; /* keyboard SIGINT char */
-static int gl_quitc = 0; /* keyboard SIGQUIT char */
-static int gl_suspc = 0; /* keyboard SIGTSTP char */
-static int gl_dsuspc = 0; /* delayed SIGTSTP char */
-static int gl_search_mode = 0; /* search mode flag */
-
-
-static void gl_init(); /* prepare to edit a line */
-static void gl_cleanup(); /* to undo gl_init */
-
-static void gl_addchar(); /* install specified char */
-static void gl_del(); /* del, either left (-1) or cur (0) */
-static void gl_delword(); /* delete word */
-static void gl_error(); /* write error msg and die */
-static void gl_fixup( const char*, int, int);
- /* fixup state variables and screen */
-static int gl_getc(); /* read one char from terminal */
-static void gl_kill(); /* delete to EOL */
-static void gl_newline(); /* handle \n or \r */
-static void gl_putc(); /* write one char to terminal */
-static void gl_puts(); /* write a line to terminal */
-static void gl_flush(); /* write out gl_putc() buffer */
-static void gl_redraw(); /* issue \n and redraw all */
-static void gl_transpose(); /* transpose two chars */
-static void gl_yank(); /* yank killed text */
-
-static void hist_init(); /* initializes hist pointers */
-static char *hist_next(); /* return ptr to next item */
-static char *hist_prev(); /* return ptr to prev item */
-static char *hist_save(); /* makes copy of a string, without NL */
-
-static void search_addchar(); /* increment search string */
-static void search_term(); /* reset with current contents */
-static void search_back(); /* look back for current string */
-static void search_forw(); /* look forw for current string */
-
-/************************ nonportable part *********************************/
-
-/*
-extern int write();
-extern void exit();
-*/
-
-#ifdef TERMIO_POSIX
-#include <termios.h>
-static struct termios new_termios, old_termios;
-#endif
-
-#ifdef TERMIO_BSD
-#include <sys/ioctl.h>
-#include <sgtty.h>
-static struct sgttyb new_tty, old_tty;
-static struct tchars tch;
-static struct ltchars ltch;
-static int typeahead_count;
-static char typeahead_buffer[1024];
-#endif
-
-#ifdef TERMIO_SYSV
-#include <sys/ioctl.h>
-#include <termio.h>
-static struct termio new_termio, old_termio;
-#endif
-
-#ifdef vms
-static int setbuff[2]; /* buffer to set terminal attributes */
-static short chan = -1; /* channel to terminal */
-static int enable_ast; /* reenable ^C AST */
-static struct dsc$descriptor_s descrip; /* VMS descriptor */
-#endif
-
-void
- gl_config( const char *which, int value )
-{
- if( strcmp( which, "overwrite" ) == 0 )
- gl_def_overwrite = value;
- else if( strcmp( which, "style" ) == 0 )
- gl_edit_style = value;
- else if( strcmp( which, "noecho" ) == 0 )
- gl_no_echo = value;
- else if( strcmp( which, "erase" ) == 0 )
- gl_erase_line = value;
- else
- printf( "gl_config: %s ?\n", which );
-}
-
-
-void
- gl_char_init() /* turn off input echo */
-{
- if (isatty(0) == 0 || isatty(1) == 0)
- return;
-
-#ifdef vms
- gl_intrc = 'C' - '@'; /* ^C */
- gl_quitc = 'Y' - '@' + 128; /* ^Y quit in DCL and yank in KSH */
-#endif
-
-#if defined(MSDOS) || defined(WIN32) || defined(CERNLIB_WINNT)
- gl_intrc = 'C' - '@'; /* ^C */
- gl_quitc = 'Y' - '@'; /* ^Y quit in DCL and yank in KSH */
-#endif
-
-#ifdef TERMIO_POSIX
- tcgetattr(0, &old_termios);
- gl_intrc = old_termios.c_cc[VINTR];
- gl_quitc = old_termios.c_cc[VQUIT];
-# ifdef VSUSP
- gl_suspc = old_termios.c_cc[VSUSP];
-# endif
-# ifdef VDSUSP
- gl_dsuspc = old_termios.c_cc[VDSUSP];
-# endif
- new_termios = old_termios;
- new_termios.c_iflag &= ~(BRKINT|ISTRIP|IXON|IXOFF|INLCR|IGNCR|ICRNL);
- new_termios.c_iflag |= (IGNBRK|IGNPAR);
- new_termios.c_lflag &= ~(ICANON|ISIG|IEXTEN|ECHO);
- new_termios.c_cc[VMIN] = 1;
- new_termios.c_cc[VTIME] = 0;
-#endif
-
-#ifdef TERMIO_BSD
- ioctl(0, TIOCGETC, &tch);
- ioctl(0, TIOCGLTC, <ch);
- gl_intrc = tch.t_intrc;
- gl_quitc = tch.t_quitc;
- gl_suspc = ltch.t_suspc;
- gl_dsuspc = ltch.t_dsuspc;
- ioctl(0, TIOCGETP, &old_tty);
- new_tty = old_tty;
- new_tty.sg_flags |= RAW;
- new_tty.sg_flags &= ~ECHO;
-#endif
-
-#ifdef TERMIO_SYSV
- ioctl(0, TCGETA, &old_termio);
- gl_intrc = old_termio.c_cc[VINTR];
- gl_quitc = old_termio.c_cc[VQUIT];
- new_termio = old_termio;
- new_termio.c_iflag &= ~(BRKINT|ISTRIP|IXON|IXOFF);
- new_termio.c_iflag |= (IGNBRK|IGNPAR);
- new_termio.c_lflag &= ~(ICANON|ISIG|ECHO);
- new_termio.c_cc[VMIN] = 1;
- new_termio.c_cc[VTIME] = 0;
-#endif
-
- gl_char_init_done = 1;
-}
-
-static void
- gl_char_reinit() /* turn off input echo */
-{
-#ifdef TERMIO_POSIX
- tcsetattr(0, TCSANOW, &new_termios);
-#endif
-
-#ifdef TERMIO_BSD
- /*
- * switching the BSD driver to RAW mode discards the input queue
- * we save the type-ahead in a buffer which gl_getc() uses
- */
- typeahead_count = 0;
-
- while( 1 ) {
- fd_set readfds;
- struct timeval timeout;
-
- FD_ZERO( &readfds );
- FD_SET( 0, &readfds );
- timeout.tv_sec = 0;
- timeout.tv_usec = 0;
-
- if( select( 1, SELECT_CAST(&readfds), NULL, NULL, &timeout ) > 0 ) {
- read( 0, &typeahead_buffer[typeahead_count++], 1 );
- }
- else
- break;
- }
-
- ioctl(0, TIOCSETP, &new_tty);
-#endif
-
-#ifdef TERMIO_SYSV
- ioctl(0, TCSETA, &new_termio);
-#endif
-
-#ifdef vms
- /* cancel pending ^C AST */
- enable_ast = control_C_ast( 0 );
- var_descriptor( descrip, "TT:" );
- (void)sys$assign(&descrip,&chan,0,0);
- (void)sys$qiow(0,chan,IO$_SENSEMODE,0,0,0,setbuff,8,0,0,0,0);
- setbuff[1] |= TT$M_NOECHO;
- (void)sys$qiow(0,chan,IO$_SETMODE,0,0,0,setbuff,8,0,0,0,0);
-
- /*
- * Install exit() as ^Y AST which is called when the input terminal
- * hangs up, e.g. by closing the window before leaving the application.
- */
- sys$qiow( 0, chan, IO$_SETMODE | IO$M_CTRLYAST, 0, 0, 0,
- exit, 0, PSL$C_USER, 0, 0, 0 );
-#endif /* vms */
-}
-
-void
- gl_char_cleanup() /* undo effects of gl_char_init */
-{
- if (isatty(0) == 0 || isatty(1) == 0)
- return;
-
-#ifdef TERMIO_POSIX
- tcsetattr(0, TCSANOW, &old_termios);
-#endif
-
-#ifdef TERMIO_BSD
- ioctl(0, TIOCSETP, &old_tty);
-#endif
-
-#ifdef TERMIO_SYSV
- ioctl(0, TCSETA, &old_termio);
-#endif
-
-#ifdef vms
- setbuff[1] &= ~TT$M_NOECHO;
- (void)sys$qiow(0,chan,IO$_SETMODE,0,0,0,setbuff,8,0,0,0,0);
- sys$dassgn(chan);
- chan = -1;
- /* reenable ^C AST */
- control_C_ast( enable_ast );
-#endif
-}
-
-static void
-gl_flush()
-/* flush gl_putc() buffer */
-{
- if( gl_outptr != gl_outbuf ) {
- write( 1, gl_outbuf, gl_outptr - gl_outbuf );
- gl_outptr = gl_outbuf;
- }
-}
-
-
-/* execute the idle command */
-static
-int gl_idle()
-{
- int old_timeout = kc_value.idle_time;
- kc_value.idle_time = 0; /* in case idle command causes a prompt */
-
- gl_fixup( gl_prompt, -1, 0 );
- gl_puts( kc_value.idle_cmd );
- gl_putc( '\n' );
- gl_cleanup();
- ku_exel( kc_value.idle_cmd );
- gl_init();
- gl_fixup( gl_prompt, -2, gl_pos );
-
- kc_value.idle_time = old_timeout;
- return 0;
-}
-
-#if defined(MSDOS) && !defined(WIN32)
-// +DECK, PAUSE, T=XCC, IF=WINNT. (from KERNDOS.CAR )
-# include <conio.h>
- int pause_()
- {
- int first_char;
- first_char = _getch();
- if (first_char == 0 || first_char == 0xE0) first_char = -_getch();
- return first_char;
- }
-#elif defined(CERNLIB_WINNT)
-/*_____________________________________________________________________________*/
-int pause_(){
- static HANDLE hConsoleInput = NULL;
- static iCharCount = 0;
- static int chLastChar = 0;
-
- DWORD cRead;
-
- INPUT_RECORD pirBuffer;
- KEY_EVENT_RECORD *KeyEvent= (KEY_EVENT_RECORD *)&(pirBuffer.Event);
-
- if (!hConsoleInput) hConsoleInput = GetStdHandle(STD_INPUT_HANDLE);
-
- if (iCharCount) iCharCount--; /* Whether several symbols had been read */
- else {
- chLastChar = 0;
- while (chLastChar == 0) {
- if (!ReadConsoleInput(hConsoleInput, /* handle of a console input buffer */
- &pirBuffer, /* address of the buffer for read data */
- 1, /* number of records to read */
- &cRead /* address of number of records read */
- )) return 0;
-
- if (pirBuffer.EventType == KEY_EVENT && KeyEvent->bKeyDown == TRUE){
- iCharCount = KeyEvent->wRepeatCount - 1;
- chLastChar = ((int) (KeyEvent->uChar).AsciiChar & 0xffff);
- if (chLastChar)
- OemToCharBuff((char const *)&chLastChar,(char *)&chLastChar,1);
- else
- chLastChar = - (KeyEvent->wVirtualScanCode);
- }
- }
- }
- return chLastChar;
-
-}
-#endif
-
-static int
-gl_getc()
-/* get a character without echoing it to screen */
-{
-#if defined(MSDOS) || defined(CERNLIB_WINNT) || defined(WIN32)
-# define k_ctrl_C 3
-# define k_ctrl_Z 26
-# define k_ctrl_Q 17
-# define k_ctrl_K 11
-# define k_rt_arr -77
-# define k_lt_arr -75
-# define k_up_arr -72
-# define k_dn_arr -80
-# define k_PGUP -73
-# define k_PGDW -81
-# define k_HOME -71
-# define k_END -79
-# define k_INS -82
-# define k_DEL -83
-# define k_ENTER 13
-# define k_CR 13
-# define k_BS 8
-# define k_ESC 27
-# define k_alt_H -35
-# define k_beep 7
-# ifndef CERNLIB_WINNT
- int get_cursor__(int *,int *);
- int display_off__(int *);
- int display_on__();
- int locate_(int *,int *);
- int ixc, iyc;
-# endif
-
-#endif
-
-
-#ifdef vms
- short iosb[4];
-#endif
-
- int c;
- char ch;
-
- gl_flush();
-
-#ifdef UNIX
-
-# ifdef TERMIO_BSD
- if( typeahead_count > 0 ) {
- int i;
- c = typeahead_buffer[0];
- typeahead_count--;
- for( i = 0; i < typeahead_count; i++ )
- typeahead_buffer[i] = typeahead_buffer[i+1];
- return c;
- }
-# endif
-
-# ifndef MSDOS
- do {
-
-# ifdef HAVE_SELECT
- if( kc_value.idle_time > 0 ) {
- fd_set readfds;
- struct timeval timeout;
-
- FD_ZERO( &readfds );
- FD_SET( 0, &readfds );
- timeout.tv_sec = kc_value.idle_time;
- timeout.tv_usec = 0;
-
- if( select( 1, SELECT_CAST(&readfds), NULL, NULL, &timeout ) == 0 )
- return gl_idle();
- }
-# endif
-
- errno = 0;
- c = (read(0, &ch, 1) > 0)? ch : -1;
- } while (errno == EINTR);
-
-# else /* MSDOS */
-
- c = pause_();
- if (c < 0) {
- switch (c) {
- case k_up_arr: c = 16; /* up -> ^P */
- break;
- case k_dn_arr: c = 14; /* down -> ^N */
- break;
- case k_lt_arr: c = 2; /* left -> ^B */
- break;
- case k_rt_arr: c = 6; /* right -> ^F */
- break;
- case k_INS: c = 15; /* right -> ^F */
- break;
- case k_DEL: c = 4; /* Delete character under cursor */
- break;
- case k_END: c = 5; /* Moves cursor to end of line */
- break;
- case k_HOME: c = 1; /* Moves cursor to beginning of line */
- break;
-# ifndef CERNLIB_WINNT
- case k_PGUP: c = 0; display_on__();
- break;
- case k_PGDW: c =0; get_cursor__(&ixc, &iyc);
- display_off__(&iyc);
- locate_(&ixc,&iyc);
- break;
-# endif
- default: c = 0; /* make it garbage */
- }
- }
- else {
- switch(c) {
- case k_ESC: c = 'U' - '@'; /* Clear full line -> ^U */
- break;
- case k_ctrl_C: raise(SIGINT); /* Ctrl-C handle */
- break;
- default:
- break;
- }
- }
-# endif
-#endif
-
-#ifdef vms
- c = '\0';
- if( kc_value.idle_time > 0 ) {
- sys$qiow( 0, chan, IO$_TTYREADALL | IO$M_TIMED, iosb, 0, 0,
- &c, 1, kc_value.idle_time + 1, 0, 0, 0 );
- if( iosb[0] == SS$_TIMEOUT )
- return gl_idle();
- }
- else {
- sys$qiow( 0, chan, IO$_TTYREADALL, iosb, 0, 0,
- &c, 1, 0, 0, 0, 0 );
- }
- if( iosb[0] == SS$_NORMAL )
- c &= 0177; /* get a char */
- else
- c = -1; /* EOF */
-#endif
-
- return c;
-}
-
-static void
- gl_putc(c)
-int c;
-{
- char ch = c;
-
-#if defined(WIN32) || defined(CERNLIB_WINNT)
- CharToOemBuff((char const *)&c,&ch,1);
-#endif
-
- if( gl_passwd && isgraph( c ) )
- ch = ' ';
-
- /* buffer characters because VMS C-I/O is sooo slow */
- *gl_outptr++ = ch;
-
-#ifdef TERMIO_MAP_NL
- if (ch == '\n') { /* BSD in RAW mode, map NL to NL,CR */
- *gl_outptr++ = '\r';
- }
-#endif
-
- *gl_outptr = '\0';
-}
-
-/******************** fairly portable part *********************************/
-
-static void
- gl_puts(buf)
-char *buf;
-{
-/*
- int len = strlen(buf);
-
- write(1, buf, len);
-*/
- while( *buf != '\0' )
- gl_putc( *buf++ );
-}
-
-static void
- gl_error(buf)
-char *buf;
-{
- int len = strlen(buf);
-
- gl_cleanup();
-#if defined(WIN32) || defined(CERNLIB_WINNT)
- {
- char *OemBuf = (char *)malloc(2*len);
- CharToOemBuff(buf,OemBuf,len);
- write(2, OemBuf, len);
- free(OemBuf);
- }
-#else
- write(2, buf, len);
-#endif
- /* exit(1); */
-}
-
-static void
- gl_init() /* set up variables and terminal */
-{
- if (gl_init_done < 0) { /* -1 only on startup */
- hist_init();
- }
-
- if (!gl_char_init_done)
- gl_char_init();
-
- gl_char_reinit();
- gl_init_done = 1;
- gl_overwrite = gl_def_overwrite;
- gl_outptr = gl_outbuf; /* reset gl_putc() buffer */
-}
-
-static void
- gl_cleanup() /* undo effects of gl_init, as necessary */
-{
- gl_flush();
- if (gl_init_done > 0)
- gl_char_cleanup();
- gl_init_done = 0;
-}
-
-void
- gl_reinit() /* reinitialize terminal */
-{
-
- if (isatty(0) == 0 || isatty(1) == 0)
- return;
-
- if (gl_init_done == 0) {
- gl_char_reinit();
- gl_init_done = 1;
- }
-}
-
-int
-gl_reset() /* undo effects of gl_init, as necessary */
-{
- int set = 0;
-
- if (isatty(0) == 0 || isatty(1) == 0)
- return set;
-
- if (gl_init_done > 0) {
- gl_char_cleanup();
- gl_init_done = 0;
- set = 1;
- }
-
- return set;
-}
-
-void
- gl_setwidth(w)
-int w;
-{
- if (w > 20) {
- gl_termw = w;
- gl_scroll = w / 3;
- } else {
- gl_error("\n*** Error: minimum screen width is 21\n");
- }
-}
-
-#if defined(CERNLIB_QMGLIBC)
-char *getline2( const char *prompt )
-#else
-char *getline( const char *prompt )
-#endif
-{
- int c, loc, tmp;
- int sig;
-
- if( prompt != NULL )
- gl_prompt = prompt;
- else
- gl_prompt = "";
-
- gl_buf[0] = 0;
- gl_init();
- if (gl_in_hook)
- gl_in_hook(gl_buf);
- gl_fixup(gl_prompt, -2, BUF_SIZE);
- while ((c = gl_getc()) != -1) { /* -1 for EOF */
- gl_extent = 0; /* reset to full extent */
-#if !defined(WIN32) && !defined(CERNLIB_WINNT)
- if (isprint(c)) {
-#else
- if (c >= ' ') {
-#endif
- if (gl_search_mode)
- search_addchar(c);
- else
- gl_addchar(c);
- } else {
- int dcl_xlate = (gl_edit_style == 1);
-
- if (gl_search_mode) {
- if (c == '\033' || c == '\016' || c == '\020') {
- search_term();
- c = 0; /* ignore the character */
- } else if (c == '\010' || c == '\177') {
- search_addchar(-1); /* unwind search string */
- c = 0;
- } else if (c != '\022' && c != '\023') {
- search_term(); /* terminate and handle char */
- }
- }
-
- if( c == '\033' ) {
- c = gl_getc();
- if (c == '[' || c == 'O')
- c = gl_getc();
-
- switch( c ) {
- case 'A': /* up */
- c = 'P' - '@';
- dcl_xlate = 0;
- break;
- case 'B': /* down */
- c = 'N' - '@';
- dcl_xlate = 0;
- break;
- case 'C': /* right */
- c = 'F' - '@';
- dcl_xlate = 0;
- break;
- case 'D': /* left */
- c = 'B' - '@';
- dcl_xlate = 0;
- break;
- default: /* who knows */
- gl_putc('\007');
- c = 0;
- break;
-
- case '2':
- c = gl_getc();
- if( gl_getc() == '~' ) { /* DEC function keys */
- switch( c ) {
- case '4': /* F12 == ^H */
- c = 'H' - '@';
- break;
- case '5': /* F13 == ^J */
- c = 'J' - '@';
- break;
- case '6': /* F14 == ^A */
- c = 'A' - '@';
- break;
- default:
- gl_putc('\007');
- c = 0;
- break;
- }
- }
- }
- }
-
- if( c != 0 && dcl_xlate ) {
- /* translate DCL control characters */
-
- switch( c ) {
- case '\001': /* ^A toggles overwrite mode */
- c = 'O' - '@';
- break;
- case '\002': /* ^B recall previous line */
- c = 'P' - '@';
- break;
- case '\004': /* ^D moves cursor left */
- c = 'B' - '@';
- break;
- case '\010': /* ^H moves cursor to beginning of line */
- c = 'A' - '@';
- break;
- case '\012': /* ^J deletes previous word */
- gl_delword();
- c = 0;
- break;
- case '\022': /* ^R refreshes line */
- c = 'L' - '@';
- break;
- case '\030': /* ^X flush type-ahead then ^U */
- case '\025': /* ^U deletes from beginning of line */
- strcpy( &gl_buf[0], &gl_buf[gl_pos] );
- gl_fixup( gl_prompt, 0, 0 );
- c = 0;
- break;
- case '\031': /* ^Y aborts */
- c = gl_quitc;
- break;
- case '\032': /* ^Z is EOF */
- c = 'D' - '@';
- break;
- /* the following codes are the same in both modes */
- case '\003': /* ^C interrupts */
- case '\005': /* ^E moves cursor to end of line */
- case '\006': /* ^F moves cursor right */
- case '\011': /* ^I moves to next tab position */
- case '\015': /* ^M terminates input */
- case '\016': /* ^N recalls next command */
- case '\177': /* DEL deletes character */
- break;
- default: /* the rest rings a bell */
- c = 'G' - '@';
- }
- }
-
- switch (c) {
- case '\n': case '\r': /* newline */
- gl_newline();
- gl_cleanup();
- return gl_buf;
- /*NOTREACHED*/
- break;
- case '\001': gl_fixup(gl_prompt, -1, 0); /* ^A */
- break;
- case '\002': gl_fixup(gl_prompt, -1, gl_pos-1); /* ^B */
- break;
- case '\004': /* ^D */
- if (gl_cnt == 0) {
- /* ignore ^D for completely empty line
- gl_buf[0] = 0;
- gl_cleanup();
- gl_putc('\n');
- return gl_buf; */
- } else {
- gl_del(0);
- }
- break;
- case '\005': gl_fixup(gl_prompt, -1, gl_cnt); /* ^E */
- break;
- case '\006': gl_fixup(gl_prompt, -1, gl_pos+1); /* ^F */
- break;
- case '\010': case '\177': gl_del(-1); /* ^H and DEL */
- break;
- case '\t': /* TAB */
- if (gl_tab_hook) {
- tmp = gl_pos;
- loc = gl_tab_hook(gl_buf, strlen(gl_prompt), &tmp);
- if (loc >= 0 || tmp != gl_pos)
- gl_fixup(gl_prompt, loc, tmp);
- }
- break;
- case '\013': gl_kill(); /* ^K */
- break;
- case '\014': gl_redraw(); /* ^L */
- break;
- case '\016': /* ^N */
- strcpy(gl_buf, hist_next());
- if (gl_in_hook)
- gl_in_hook(gl_buf);
- gl_fixup(gl_prompt, 0, BUF_SIZE);
- break;
- case '\017': gl_overwrite = !gl_overwrite; /* ^O */
- break;
- case '\020': /* ^P */
- strcpy(gl_buf, hist_prev());
- if (gl_in_hook)
- gl_in_hook(gl_buf);
- gl_fixup(gl_prompt, 0, BUF_SIZE);
- break;
- case '\022': search_back(1); /* ^R */
- break;
- case '\023': search_forw(1); /* ^S */
- break;
- case '\024': gl_transpose(); /* ^T */
- break;
- case '\025': gl_fixup(gl_prompt,-1,0); gl_kill(); /* ^U */
- break;
- case '\031': gl_yank(); /* ^Y */
- break;
- default: /* check for a terminal signal */
-#if !defined(MSDOS) || defined(WIN32) || defined(CERNLIB_WINNT)
- if (c > 0) { /* ignore 0 (reset above) */
- sig = 0;
-# ifndef vms
-# ifdef SIGINT
- if (c == gl_intrc)
- sig = SIGINT;
-# endif
-# ifdef SIGQUIT
- if (c == gl_quitc)
- sig = SIGQUIT;
-# endif
-# ifdef SIGTSTP
- if (c == gl_suspc || c == gl_dsuspc)
- sig = SIGTSTP;
-# endif
-# else /* vms */
- if (c == gl_intrc)
- sig = SS$_DEBUG;
- if (c == gl_quitc)
- sig = SS$_CONTROLY;
-# endif /* vms */
-
- if (sig != 0) {
- gl_cleanup();
-# ifndef vms
-# ifdef SIGTSTP
- /*
- * Send signal to process group to propagate ^Z to the
- * interactive shell in case the program was started
- * from a shell script.
- */
-# ifdef GETPGRP_BSD
- kill( -getpgrp( 0 ), sig );
-# else
- kill( -getpgrp(), sig );
-# endif
-# else
-#ifdef WIN32
- if (sig == SIGINT) GenerateConsoleCtrlEvent(CTRL_C_EVENT,0);
- else
-#endif
- raise(sig);
-# endif
-# else
- lib$signal( sig );
-# endif
- gl_init();
- gl_redraw();
- c = 0;
- }
- }
-#endif
- if (c != 0) /* warn user for strange character typed */
- gl_putc('\007');
- break;
- }
- }
- }
- gl_cleanup();
- return NULL; /* EOF reached */
-}
-
-static void
- gl_addchar(c)
-int c;
-/* adds the character c to the input buffer at current location */
-{
- int i;
-
- if (gl_cnt >= BUF_SIZE - 1)
- gl_error("\n*** Error: getline(): input buffer overflow\n");
- if (gl_overwrite == 0 || gl_pos == gl_cnt) {
- for (i=gl_cnt; i >= gl_pos; i--)
- gl_buf[i+1] = gl_buf[i];
- gl_buf[gl_pos] = c;
- gl_fixup(gl_prompt, gl_pos, gl_pos+1);
- } else {
- gl_buf[gl_pos] = c;
- gl_extent = 1;
- gl_fixup(gl_prompt, gl_pos, gl_pos+1);
- }
-}
-
-static void
- gl_yank()
-/* adds the kill buffer to the input buffer at current location */
-{
- int i, len;
-
- len = strlen(gl_killbuf);
- if (len > 0) {
- if (gl_overwrite == 0) {
- if (gl_cnt + len >= BUF_SIZE - 1)
- gl_error("\n*** Error: getline(): input buffer overflow\n");
- for (i=gl_cnt; i >= gl_pos; i--)
- gl_buf[i+len] = gl_buf[i];
- for (i=0; i < len; i++)
- gl_buf[gl_pos+i] = gl_killbuf[i];
- gl_fixup(gl_prompt, gl_pos, gl_pos+len);
- } else {
- if (gl_pos + len > gl_cnt) {
- if (gl_pos + len >= BUF_SIZE - 1)
- gl_error("\n*** Error: getline(): input buffer overflow\n");
- gl_buf[gl_pos + len] = 0;
- }
- for (i=0; i < len; i++)
- gl_buf[gl_pos+i] = gl_killbuf[i];
- gl_extent = len;
- gl_fixup(gl_prompt, gl_pos, gl_pos+len);
- }
- } /* else
- gl_putc('\007'); */
-}
-
-static void
- gl_transpose()
-/* switch character under cursor and to left of cursor */
-{
- int c;
-
- if (gl_pos > 0 && gl_cnt > gl_pos) {
- c = gl_buf[gl_pos-1];
- gl_buf[gl_pos-1] = gl_buf[gl_pos];
- gl_buf[gl_pos] = c;
- gl_extent = 2;
- gl_fixup(gl_prompt, gl_pos-1, gl_pos);
- } /* else
- gl_putc('\007'); */
-}
-
-static void
- gl_newline()
-/*
- * Cleans up entire line before returning to caller. A \n is appended.
- * If line longer than screen, we redraw starting at beginning
- */
-{
- int change = gl_cnt;
- int len = gl_cnt;
- int loc = gl_width - 5; /* shifts line back to start position */
-
- if (gl_cnt >= BUF_SIZE - 1)
- gl_error("\n*** Error: getline(): input buffer overflow\n");
- if (gl_out_hook) {
- change = gl_out_hook(gl_buf);
- len = strlen(gl_buf);
- }
- if( gl_erase_line ) {
- char gl_buf0 = gl_buf[0];
- gl_buf[0] = '\0';
- gl_fixup("", 0, 0);
- gl_buf[0] = gl_buf0;
- }
- else {
- if (loc > len)
- loc = len;
- gl_fixup(gl_prompt, change, loc); /* must do this before appending \n */
- gl_putc('\n');
- }
- gl_buf[len] = '\n';
- gl_buf[len+1] = '\0';
-}
-
-static void
- gl_del(loc)
-int loc;
-/*
- * Delete a character. The loc variable can be:
- * -1 : delete character to left of cursor
- * 0 : delete character under cursor
- */
-{
- int i;
-
- if ((loc == -1 && gl_pos > 0) || (loc == 0 && gl_pos < gl_cnt)) {
- for (i=gl_pos+loc; i < gl_cnt; i++)
- gl_buf[i] = gl_buf[i+1];
- gl_fixup(gl_prompt, gl_pos+loc, gl_pos+loc);
- } /* else
- gl_putc('\007'); */
-}
-
-static void
- gl_delword()
-/*
- * Delete previous word (^J/LF on VMS)
- */
-{
- static char punct[] = " `!$&(-=+]}\\|;:'\",<.>?";
- int i = gl_pos;
-
- while( i > 0 && strchr( punct, gl_buf[i-1] ) != NULL )
- i--;
- while( i > 0 && strchr( punct, gl_buf[i-1] ) == NULL )
- i--;
-
- strcpy( gl_buf + i, gl_buf + gl_pos );
- gl_fixup(gl_prompt, i, i );
-}
-
-static void
- gl_kill()
-/* delete from current position to the end of line */
-{
- if (gl_pos < gl_cnt) {
- strcpy(gl_killbuf, gl_buf + gl_pos);
- gl_buf[gl_pos] = '\0';
- gl_fixup(gl_prompt, gl_pos, gl_pos);
- } /* else
- gl_putc('\007'); */
-}
-
-static void
- gl_redraw()
-/* emit a newline, reset and redraw prompt and current input line */
-{
- if (gl_init_done > 0) {
- gl_putc('\n');
- gl_fixup(gl_prompt, -2, gl_pos);
- }
-}
-
-static void
- gl_fixup( const char *prompt,
- int change,
- int cursor )
-/*
- * This function is used both for redrawing when input changes or for
- * moving within the input line. The parameters are:
- * prompt: compared to last_prompt[] for changes;
- * change : the index of the start of changes in the input buffer,
- * with -1 indicating no changes, -2 indicating we're on
- * a new line, redraw everything.
- * cursor : the desired location of the cursor after the call.
- * A value of BUF_SIZE can be used to indicate the cursor should
- * move just past the end of the input line.
- */
-{
- static int gl_shift; /* index of first on screen character */
- static int off_right; /* true if more text right of screen */
- static int off_left; /* true if more text left of screen */
- static char *last_prompt = NULL;
- int left = 0, right = -1; /* bounds for redraw */
- int pad; /* how much to erase at end of line */
- int backup; /* how far to backup before fixing */
- int new_shift; /* value of shift based on cursor */
- int extra; /* adjusts when shift (scroll) happens */
- int i;
- int new_right = -1; /* alternate right bound, using gl_extent */
- int l1, l2;
-
- if( last_prompt == NULL )
- last_prompt = strdup( "" );
-
- if (change == -2) { /* reset */
- gl_pos = gl_cnt = gl_shift = off_right = off_left = 0;
- gl_passwd = 0;
- gl_puts(prompt);
- gl_passwd = gl_no_echo;
- free( last_prompt );
- last_prompt = strdup( prompt );
- change = 0;
- gl_width = gl_termw - strlen(prompt);
- } else if (strcmp(prompt, last_prompt) != 0) {
- l1 = strlen(last_prompt);
- l2 = strlen(prompt);
- gl_cnt = gl_cnt + l1 - l2;
- free( last_prompt );
- last_prompt = strdup( prompt );
- backup = gl_pos - gl_shift + l1;
- for (i=0; i < backup; i++)
- gl_putc('\b');
- gl_passwd = 0;
- gl_puts(prompt);
- gl_passwd = gl_no_echo;
- gl_pos = gl_shift;
- gl_width = gl_termw - l2;
- change = 0;
- }
- pad = (off_right)? gl_width - 1 : gl_cnt - gl_shift; /* old length */
- backup = gl_pos - gl_shift;
- if (change >= 0) {
- gl_cnt = strlen(gl_buf);
- if (change > gl_cnt)
- change = gl_cnt;
- }
- if (cursor > gl_cnt) {
- /* BUF_SIZE means end of line */
- /* if (cursor != BUF_SIZE)
- gl_putc('\007'); */
- cursor = gl_cnt;
- }
- if (cursor < 0) {
- /* gl_putc('\007'); */
- cursor = 0;
- }
- if (off_right || (off_left && cursor < gl_shift + gl_width - gl_scroll / 2))
- extra = 2; /* shift the scrolling boundary */
- else
- extra = 0;
- new_shift = cursor + extra + gl_scroll - gl_width;
- if (new_shift > 0) {
- new_shift /= gl_scroll;
- new_shift *= gl_scroll;
- } else
- new_shift = 0;
- if (new_shift != gl_shift) { /* scroll occurs */
- gl_shift = new_shift;
- off_left = (gl_shift)? 1 : 0;
- off_right = (gl_cnt > gl_shift + gl_width - 1)? 1 : 0;
- left = gl_shift;
- new_right = right = (off_right)? gl_shift + gl_width - 2 : gl_cnt;
- } else if (change >= 0) { /* no scroll, but text changed */
- if (change < gl_shift + off_left) {
- left = gl_shift;
- } else {
- left = change;
- backup = gl_pos - change;
- }
- off_right = (gl_cnt > gl_shift + gl_width - 1)? 1 : 0;
- right = (off_right)? gl_shift + gl_width - 2 : gl_cnt;
- new_right = (gl_extent && (right > left + gl_extent))?
- left + gl_extent : right;
- }
- pad -= (off_right)? gl_width - 1 : gl_cnt - gl_shift;
- pad = (pad < 0)? 0 : pad;
- if (left <= right) { /* clean up screen */
- for (i=0; i < backup; i++)
- gl_putc('\b');
- if (left == gl_shift && off_left) {
- gl_putc('$');
- left++;
- }
- for (i=left; i < new_right; i++)
- gl_putc(gl_buf[i]);
- gl_pos = new_right;
- if (off_right && new_right == right) {
- gl_putc('$');
- gl_pos++;
- } else {
- for (i=0; i < pad; i++) /* erase remains of prev line */
- gl_putc(' ');
- gl_pos += pad;
- }
- }
- i = gl_pos - cursor; /* move to final cursor location */
- if (i > 0) {
- while (i--)
- gl_putc('\b');
- } else {
- for (i=gl_pos; i < cursor; i++)
- gl_putc(gl_buf[i]);
- }
- gl_pos = cursor;
-}
-
-static int
- gl_tab(buf, offset, loc)
-char *buf;
-int offset;
-int *loc;
-/* default tab handler, acts like tabstops every 8 cols */
-{
- int i, count, len;
-
- len = strlen(buf);
- count = 8 - (offset + *loc) % 8;
- for (i=len; i >= *loc; i--)
- buf[i+count] = buf[i];
- for (i=0; i < count; i++)
- buf[*loc+i] = ' ';
- i = *loc;
- *loc = i + count;
- return i;
-}
-
-/******************* History stuff **************************************/
-
-#ifndef HIST_SIZE
-#define HIST_SIZE 100
-#endif
-
-static int hist_pos = 0, hist_last = 0;
-static char *hist_buf[HIST_SIZE];
-
-static void
- hist_init()
-{
- int i;
-
- hist_buf[0] = "";
- for (i=1; i < HIST_SIZE; i++)
- hist_buf[i] = (char *)0;
-}
-
-void
- gl_histadd( const char *buf )
-{
- static char *prev = 0;
- const char *p = buf;
- int len;
-
- while (*p == ' ' || *p == '\t' || *p == '\n')
- p++;
- if (*p) {
- len = strlen(buf);
- if (strchr(p, '\n')) /* previously line already has NL stripped */
- len--;
- if (prev == 0 || strlen(prev) != len ||
- strncmp(prev, buf, len) != 0) {
- hist_buf[hist_last] = hist_save(buf);
- prev = hist_buf[hist_last];
- hist_last = (hist_last + 1) % HIST_SIZE;
- if (hist_buf[hist_last] && *hist_buf[hist_last]) {
- free(hist_buf[hist_last]);
- }
- hist_buf[hist_last] = "";
- }
- }
- hist_pos = hist_last;
-}
-
-static char *
- hist_prev()
-/* loads previous hist entry into input buffer, sticks on first */
-{
- char *p = 0;
- int next = (hist_pos - 1 + HIST_SIZE) % HIST_SIZE;
-
- if (hist_buf[hist_pos] != 0 && next != hist_last) {
- hist_pos = next;
- p = hist_buf[hist_pos];
- }
- if (p == 0) {
- p = "";
- /* gl_putc('\007'); */
- }
- return p;
-}
-
-static char *
- hist_next()
-/* loads next hist entry into input buffer, clears on last */
-{
- char *p = 0;
-
- if (hist_pos != hist_last) {
- hist_pos = (hist_pos+1) % HIST_SIZE;
- p = hist_buf[hist_pos];
- }
- if (p == 0) {
- p = "";
- /* gl_putc('\007'); */
- }
- return p;
-}
-
-static char *
- hist_save(p)
-char *p;
-/* makes a copy of the string */
-{
- char *s;
- int len = strlen(p);
- char *nl = strchr(p, '\n');
-
- if (nl) {
- if ((s = malloc(len)) != 0) {
- strncpy(s, p, len-1);
- s[len-1] = 0;
- }
- } else {
- if ((s = malloc(len+1)) != 0) {
- strcpy(s, p);
- }
- }
- if (s == 0)
- gl_error("\n*** Error: hist_save() failed on malloc\n");
- return s;
-}
-
-/******************* Search stuff **************************************/
-
-static char search_prompt[101]; /* prompt includes search string */
-static char search_string[100];
-static int search_pos = 0; /* current location in search_string */
-static int search_forw_flg = 0; /* search direction flag */
-static int search_last = 0; /* last match found */
-
-static void
- search_update(c)
-int c;
-{
- if (c == 0) {
- search_pos = 0;
- search_string[0] = 0;
- search_prompt[0] = '?';
- search_prompt[1] = ' ';
- search_prompt[2] = 0;
- } else if (c > 0) {
- search_string[search_pos] = c;
- search_string[search_pos+1] = 0;
- search_prompt[search_pos] = c;
- search_prompt[search_pos+1] = '?';
- search_prompt[search_pos+2] = ' ';
- search_prompt[search_pos+3] = 0;
- search_pos++;
- } else {
- if (search_pos > 0) {
- search_pos--;
- search_string[search_pos] = 0;
- search_prompt[search_pos] = '?';
- search_prompt[search_pos+1] = ' ';
- search_prompt[search_pos+2] = 0;
- } else {
- gl_putc('\007');
- hist_pos = hist_last;
- }
- }
-}
-
-static void
- search_addchar(c)
-int c;
-{
- char *loc;
-
- search_update(c);
- if (c < 0) {
- if (search_pos > 0) {
- hist_pos = search_last;
- } else {
- gl_buf[0] = 0;
- hist_pos = hist_last;
- }
- strcpy(gl_buf, hist_buf[hist_pos]);
- }
- if ((loc = strstr(gl_buf, search_string)) != 0) {
- gl_fixup(search_prompt, 0, loc - gl_buf);
- } else if (search_pos > 0) {
- if (search_forw_flg) {
- search_forw(0);
- } else {
- search_back(0);
- }
- } else {
- gl_fixup(search_prompt, 0, 0);
- }
-}
-
-static void
- search_term()
-{
- gl_search_mode = 0;
- if (gl_buf[0] == 0) /* not found, reset hist list */
- hist_pos = hist_last;
- if (gl_in_hook)
- gl_in_hook(gl_buf);
- gl_fixup(gl_prompt, 0, gl_pos);
-}
-
-static void
- search_back(new_search)
-int new_search;
-{
- int found = 0;
- char *p, *loc;
-
- search_forw_flg = 0;
- if (gl_search_mode == 0) {
- search_last = hist_pos = hist_last;
- search_update(0);
- gl_search_mode = 1;
- gl_buf[0] = 0;
- gl_fixup(search_prompt, 0, 0);
- } else if (search_pos > 0) {
- while (!found) {
- p = hist_prev();
- if (*p == 0) { /* not found, done looking */
- gl_buf[0] = 0;
- gl_fixup(search_prompt, 0, 0);
- found = 1;
- } else if ((loc = strstr(p, search_string)) != 0) {
- strcpy(gl_buf, p);
- gl_fixup(search_prompt, 0, loc - p);
- if (new_search)
- search_last = hist_pos;
- found = 1;
- }
- }
- } else {
- gl_putc('\007');
- }
-}
-
-static void
- search_forw(new_search)
-int new_search;
-{
- int found = 0;
- char *p, *loc;
-
- search_forw_flg = 1;
- if (gl_search_mode == 0) {
- search_last = hist_pos = hist_last;
- search_update(0);
- gl_search_mode = 1;
- gl_buf[0] = 0;
- gl_fixup(search_prompt, 0, 0);
- } else if (search_pos > 0) {
- while (!found) {
- p = hist_next();
- if (*p == 0) { /* not found, done looking */
- gl_buf[0] = 0;
- gl_fixup(search_prompt, 0, 0);
- found = 1;
- } else if ((loc = strstr(p, search_string)) != 0) {
- strcpy(gl_buf, p);
- gl_fixup(search_prompt, 0, loc - p);
- if (new_search)
- search_last = hist_pos;
- found = 1;
- }
- }
- } else {
- gl_putc('\007');
- }
-}
-#endif
diff --git a/src/packlib/kuip/code_kuip/itoft.F b/src/packlib/kuip/code_kuip/itoft.F
deleted file mode 100644
index 814ebc3..0000000
--- a/src/packlib/kuip/code_kuip/itoft.F
+++ /dev/null
@@ -1,58 +0,0 @@
-*
-* $Id: itoft.F,v 1.1.1.1 1996/03/08 15:32:53 mclareni Exp $
-*
-* $Log: itoft.F,v $
-* Revision 1.1.1.1 1996/03/08 15:32:53 mclareni
-* Kuip
-*
-*
-#include "kuip/pilot.h"
-#if defined(CERNLIB_NEWLIB)
-*CMZ : 1.68/00 20/02/92 15.44.54 by Fons Rademakers
-*-- Author : Harald Butenschoen 06/02/91
- SUBROUTINE ITOFT (IVAL,VALC,IERR)
-************************************************************************
-* *
-* *
-* Converts the integer IVAL to the character string VALC of length 8 *
-* for constructing a FTxxF001 number *
-* *
-* Input: IVAL integer number *
-* *
-* Output: VALC FTxxF001 string with xx=ival *
-* *
-* Errors: IERR <> 0 error during conversion *
-* *
-************************************************************************
- CHARACTER *(*) VALC
- INTEGER IVAL,IERR
-*
- CHARACTER * 32 TT
- INTEGER I,J,NCSTR,NCH,LENOCC
-*
- IERR = 0
- WRITE (TT,'(I32)',ERR=20 ) IVAL
- J = 0
- DO 10 I = 1, LENOCC(TT)
- IF (TT(I:I).EQ.' ') GO TO 10
- J = J + 1
- TT(J:J) = TT(I:I)
- 10 CONTINUE
- NCSTR = J
- TT = TT(1:NCSTR)
-*
- NCH = LEN (VALC)
- IF (NCH.LT.NCSTR) IERR = -1
- IF (NCSTR .EQ. 1) THEN
- VALC='0'//TT
- TT=VALC
- NCSTR=NCSTR+1
- ENDIF
- VALC='FT'//TT(1:NCSTR)//'F001'
- GO TO 999
-*
- 20 IERR = 1
-*
- 999 END
-
-#endif
diff --git a/src/packlib/kuip/code_kuip/k77calls.F b/src/packlib/kuip/code_kuip/k77calls.F
deleted file mode 100644
index 16947ac..0000000
--- a/src/packlib/kuip/code_kuip/k77calls.F
+++ /dev/null
@@ -1,229 +0,0 @@
-*
-* $Id: k77calls.F,v 1.1.1.1 1996/03/08 15:32:55 mclareni Exp $
-*
-* $Log: k77calls.F,v $
-* Revision 1.1.1.1 1996/03/08 15:32:55 mclareni
-* Kuip
-*
-*
-#include "kuip/pilot.h"
-#if defined(CERNLIB_IBMALL)
-*CMZ : 2.05/05 01/06/94 16.55.25 by Alfred Nathaniel
-*-- Author : Alfred Nathaniel 15/10/92
-*
-* Interface between C and F77 routines with CHARACTER variables
-*
- SUBROUTINE K77CHECK(F77,C,L,N)
- CHARACTER*(*) F77,C
- IF(L.GT.LEN(C)) THEN
- PRINT '(A,I1,3A,I4)'
- + ,' *** argument C',N,' in ',F77
- + ,' has to be increased to CHARACTER*',L
- ENDIF
- END
-*
- FUNCTION K77C(KF77,K1,L1)
- EXTERNAL KF77
- CHARACTER*1024 C1
- CALL K77CHECK('K77C',C1,L1,1)
- CALL UHTOC(K1,4,C1,L1)
- K77C = KF77(C1(:L1))
- CALL FMEMCPY(K1,C1(:L1))
- END
-*
- FUNCTION K77CC(KF77,K1,L1,K2,L2)
- EXTERNAL KF77
- CHARACTER*1024 C1,C2
- CALL K77CHECK('K77CC',C1,L1,1)
- CALL K77CHECK('K77CC',C2,L2,2)
- CALL UHTOC(K1,4,C1,L1)
- CALL UHTOC(K2,4,C2,L2)
- K77CC = KF77(C1(:L1),C2(:L2))
- CALL FMEMCPY(K1,C1(:L1))
- CALL FMEMCPY(K2,C2(:L2))
- END
-*
- FUNCTION K77C3(KF77,K1,L1,K2,L2,K3,L3)
- EXTERNAL KF77
- CHARACTER*1024 C1,C2,C3
- CALL K77CHECK('K77C3',C1,L1,1)
- CALL K77CHECK('K77C3',C2,L2,2)
- CALL K77CHECK('K77C3',C3,L3,3)
- CALL UHTOC(K1,4,C1,L1)
- CALL UHTOC(K2,4,C2,L2)
- CALL UHTOC(K3,4,C3,L3)
- K77C3 = KF77(C1(:L1),C2(:L2),C3(:L3))
- CALL FMEMCPY(K1,C1(:L1))
- CALL FMEMCPY(K2,C2(:L2))
- CALL FMEMCPY(K3,C3(:L3))
- END
-*
- FUNCTION K77C7(KF77,K1,L1,K2,L2,K3,L3,K4,L4,K5,L5,K6,L6,K7,L7)
- EXTERNAL KF77
- CHARACTER*1024 C1,C2,C3,C4,C5,C6,C7
- CALL K77CHECK('K77C7',C1,L1,1)
- CALL K77CHECK('K77C7',C2,L2,2)
- CALL K77CHECK('K77C7',C3,L3,3)
- CALL K77CHECK('K77C7',C4,L4,4)
- CALL K77CHECK('K77C7',C5,L5,5)
- CALL K77CHECK('K77C7',C6,L6,6)
- CALL K77CHECK('K77C7',C7,L7,7)
- CALL UHTOC(K1,4,C1,L1)
- CALL UHTOC(K2,4,C2,L2)
- CALL UHTOC(K3,4,C3,L3)
- CALL UHTOC(K4,4,C4,L4)
- CALL UHTOC(K5,4,C5,L5)
- CALL UHTOC(K6,4,C6,L6)
- CALL UHTOC(K7,4,C7,L7)
- K77C7 = KF77(C1(:L1),C2(:L2),C3(:L3),C4(:L4),
- + C5(:L5),C6(:L6),C7(:L7))
- CALL FMEMCPY(K1,C1(:L1))
- CALL FMEMCPY(K2,C2(:L2))
- CALL FMEMCPY(K3,C3(:L3))
- CALL FMEMCPY(K4,C4(:L4))
- CALL FMEMCPY(K5,C5(:L5))
- CALL FMEMCPY(K6,C6(:L6))
- CALL FMEMCPY(K7,C7(:L7))
- END
-*
- FUNCTION K77CCx(KF77,K1,L1,K2,L2,X3)
- EXTERNAL KF77
- CHARACTER*1024 C1,C2
- CALL K77CHECK('K77CCx',C1,L1,1)
- CALL K77CHECK('K77CCx',C2,L2,2)
- CALL UHTOC(K1,4,C1,L1)
- CALL UHTOC(K2,4,C2,L2)
- K77CCx = KF77(C1(:L1),C2(:L2),X3)
- CALL FMEMCPY(K1,C1(:L1))
- CALL FMEMCPY(K2,C2(:L2))
- END
-*
- FUNCTION K77CCxx(KF77,K1,L1,K2,L2,X3,X4)
- EXTERNAL KF77
- CHARACTER*1024 C1,C2
- CALL K77CHECK('K77CCxx',C1,L1,1)
- CALL K77CHECK('K77CCxx',C2,L2,2)
- CALL UHTOC(K1,4,C1,L1)
- CALL UHTOC(K2,4,C2,L2)
- K77CCxx = KF77(C1(:L1),C2(:L2),X3,X4)
- CALL FMEMCPY(K1,C1(:L1))
- CALL FMEMCPY(K2,C2(:L2))
- END
-*
- FUNCTION K77CCx3(KF77,K1,L1,K2,L2,X3,X4,X5)
- EXTERNAL KF77
- CHARACTER*1024 C1,C2
- CALL K77CHECK('K77CCx3',C1,L1,1)
- CALL K77CHECK('K77CCx3',C2,L2,2)
- CALL UHTOC(K1,4,C1,L1)
- CALL UHTOC(K2,4,C2,L2)
- K77CCx3 = KF77(C1(:L1),C2(:L2),X3,X4,X5)
- CALL FMEMCPY(K1,C1(:L1))
- CALL FMEMCPY(K2,C2(:L2))
- END
-*
- FUNCTION K77Cx(KF77,K1,L1,X2)
- EXTERNAL KF77
- CHARACTER*1024 C1
- CALL K77CHECK('K77Cx',C1,L1,1)
- CALL UHTOC(K1,4,C1,L1)
- K77Cx = KF77(C1(:L1),X2)
- CALL FMEMCPY(K1,C1(:L1))
- END
-*
- FUNCTION K77Cxx(KF77,K1,L1,X2,X3)
- EXTERNAL KF77
- CHARACTER*1024 C1
- CALL K77CHECK('K77Cxx',C1,L1,1)
- CALL UHTOC(K1,4,C1,L1)
- K77Cxx = KF77(C1(:L1),X2,X3)
- CALL FMEMCPY(K1,C1(:L1))
- END
-*
- FUNCTION K77xC(KF77,X1,K2,L2)
- EXTERNAL KF77
- CHARACTER*1024 C2
- CALL K77CHECK('K77xC',C2,L2,2)
- CALL UHTOC(K2,4,C2,L2)
- K77xC = KF77(X1,C2(:L2))
- CALL FMEMCPY(K2,C2(:L2))
- END
-*
- FUNCTION K77xCC(KF77,X1,K2,L2,K3,L3)
- EXTERNAL KF77
- CHARACTER*1024 C2,C3
- CALL K77CHECK('K77xCC',C2,L2,2)
- CALL K77CHECK('K77xCC',C3,L3,3)
- CALL UHTOC(K2,4,C2,L2)
- CALL UHTOC(K3,4,C3,L3)
- K77xCC = KF77(X1,C2(:L2),C3(:L3))
- CALL FMEMCPY(K2,C2(:L2))
- CALL FMEMCPY(K3,C3(:L3))
- END
-*
- FUNCTION K77xCCx(KF77,X1,K2,L2,K3,L3,X4)
- EXTERNAL KF77
- CHARACTER*1024 C2,C3
- CALL K77CHECK('K77xCCx',C2,L2,2)
- CALL K77CHECK('K77xCCx',C3,L3,3)
- CALL UHTOC(K2,4,C2,L2)
- CALL UHTOC(K3,4,C3,L3)
- K77xCCx = KF77(X1,C2(:L2),C3(:L3),X4)
- CALL FMEMCPY(K2,C2(:L2))
- CALL FMEMCPY(K3,C3(:L3))
- END
-*
- FUNCTION K77xCx(KF77,X1,K2,L2,X3)
- EXTERNAL KF77
- CHARACTER*1024 C2
- CALL K77CHECK('K77xCx',C2,L2,2)
- CALL UHTOC(K2,4,C2,L2)
- K77xCx = KF77(X1,C2(:L2),X3)
- CALL FMEMCPY(K2,C2(:L2))
- END
-*
- FUNCTION K77xCx8(KF77,X1,K2,L2,X3,X4,X5,X6,X7,X8,X9,X10)
- EXTERNAL KF77
- CHARACTER*1024 C2
- CALL K77CHECK('K77xCx8',C2,L2,2)
- CALL UHTOC(K2,4,C2,L2)
- K77xCx8 = KF77(X1,C2(:L2),X3,X4,X5,X6,X7,X8,X9,X10)
- CALL FMEMCPY(K2,C2(:L2))
- END
-*
- SUBROUTINE KIGMENU(F77,MN,HTIT,LTIT,X1,X2,Y1,Y2,
- + NBU,HUSER,LUSER,N,HITEM,LITEM,HDEF,LDEF,HVAL,LVAL,
- + ICHOIC,HOPT,LOPT)
- EXTERNAL F77
- DIMENSION HUSER(LUSER/4,*)
- DIMENSION HITEM(LITEM/4,*)
- DIMENSION HDEF(LDEF/4,*)
- DIMENSION HVAL(LVAL/4,*)
- CHARACTER*80 CHTIT
- CHARACTER*80 CHUSER(10)
- CHARACTER*80 CHITEM(100)
- CHARACTER*80 CHDEF(100)
- CHARACTER*80 CHVAL(100)
- CHARACTER*80 CHOPT
-*
- CALL UHTOC(HTIT,4,CHTIT,LTIT)
- DO 10 I=1,NBU
- CHUSER(I)=' '
- CALL UHTOC(HUSER(1,I),4,CHUSER(I),LUSER)
- 10 CONTINUE
- DO 20 I=1,N
- CHITEM(I)=' '
- CALL UHTOC(HITEM(1,I),4,CHITEM(I),LITEM)
- CHDEF(I)=' '
- CALL UHTOC(HDEF(1,I),4,CHDEF(I),LDEF)
- 20 CONTINUE
- CALL UHTOC(HOPT,4,CHOPT,LOPT)
-*
- CALL F77(MN,CHTIT(:LTIT),X1,X2,Y1,Y2,
- + NBU,CHUSER,N,CHITEM,CHDEF,CHVAL,ICHOIC,CHOPT(:LOPT))
-*
- DO 30 I=1,N
- CALL FMEMCPY(CHVAL(I),HVAL(1,I),4,LVAL)
- 30 CONTINUE
- END
-#endif
diff --git a/src/packlib/kuip/code_kuip/kalias.c b/src/packlib/kuip/code_kuip/kalias.c
deleted file mode 100644
index 1ece010..0000000
--- a/src/packlib/kuip/code_kuip/kalias.c
+++ /dev/null
@@ -1,1003 +0,0 @@
-/*
- * $Id: kalias.c,v 1.2 1998/11/10 13:14:11 couet Exp $
- *
- * $Log: kalias.c,v $
- * Revision 1.2 1998/11/10 13:14:11 couet
- * - Y2K
- *
- * Revision 1.1.1.1 1996/03/08 15:32:55 mclareni
- * Kuip
- *
- */
-/*CMZ : 2.07/05 01/06/95 16.59.02 by Gunter Folger*/
-/*-- Author : Alfred Nathaniel 18/11/92*/
-/* kalias.c: alias translations */
-
-#include "kuip/kuip.h"
-#include "kuip/kfor.h"
-#include "kuip/kcom.h"
-#include "kuip/klink.h"
-#include "kuip/kmenu.h"
-#include "kuip/kflag.h"
-#include "kuip/khash.h"
-#include "kuip/kalias.h"
-
-
-static char* repl_alias( const char* );
-static char* sys_cptime(void);
-static char* sys_date(void);
-static char* sys_rtime(void);
-static char* sys_time(void);
-
-
-/*
- * action routine for /KUIP/ALIAS/CREATE
- */
-int kxacreate()
-{
- char *name = ku_gets();
- char *value = ku_gets();
- char *option = ku_getc();
-
- if( name[0] == '\0' || len_alias( name, '\0' ) != strlen( name ) ) {
- ku_alfa();
- printf( " *** Invalid alias name '%s'\n", name );
- return -1;
- }
-
- kc_alias.translate = 1; /* translation on */
-
- if( strchr( option, 'C' ) != NULL ) {
- char *alias = hash_lookup( kc_alias.arg_table, name, NULL );
- if( alias != NULL ) {
- ku_alfa();
- printf( " *** Argument alias '%s' superseded by command alias\n", name );
- hash_remove( kc_alias.arg_table, name );
- }
- hash_insert( kc_alias.cmd_table, name, value, 0 );
- }
- else {
- char *alias = hash_lookup( kc_alias.cmd_table, name, NULL );
- if( alias != NULL ) {
- ku_alfa();
- printf( " *** Command alias '%s' superseded by argument alias\n", name );
- hash_remove( kc_alias.cmd_table, name );
- }
- /* apply alias translations in value unless inhibited by option N */
- if( strchr( option, 'N' ) == NULL ) {
- char *p;
- if( (p = subst_arg_alias( value )) != NULL ) {
- hash_insert( kc_alias.arg_table, name, p, 0 );
- free( p );
- return 0;
- }
- else if( kc_alias.substitutions <= 0 ) {
- /* recursive alias */
- hash_remove( kc_alias.arg_table, name );
- return -1;
- }
- }
- hash_insert( kc_alias.arg_table, name, value, 0 );
- }
-
- return 0;
-}
-
-
-/*
- * action routine for /KUIP/ALIAS/TRANSLATION
- */
-int kxatranslation()
-{
- char *option = ku_getc();
-
- if( strcmp( option, "ON" ) == 0 )
- kc_alias.translate = 1;
-
- else if( strcmp( option, "OFF" ) == 0 )
- kc_alias.translate = 0;
-
- else
- printf( " Current alias translation: %s\n",
- kc_alias.translate ? "ON" : "OFF" );
-
- return 0;
-}
-
-
-/*
- * action routine for /KUIP/ALIAS/DELETE
- */
-int kxadelete()
-{
- char *pattern = ku_getc();
- int n = hash_entries( kc_alias.cmd_table );
-
- if( n > 0 ) {
- HashArray *values = hash_array( kc_alias.cmd_table );
- int i;
-
- for( i = 0; i < n; i++ ) {
- char *name = values[i].name;
-
- if( ku_match( name, pattern, 1 ) ) {
- hash_remove( kc_alias.cmd_table, name );
- }
- }
- free( (char*)values );
- }
-
- if( (n = hash_entries( kc_alias.arg_table )) > 0 ) {
- HashArray *values = hash_array( kc_alias.arg_table );
- int i;
-
- for( i = 0; i < n; i++ ) {
- char *name = values[i].name;
-
- if( ku_match( name, pattern, 1 ) ) {
- hash_remove( kc_alias.arg_table, name );
- }
- }
- free( (char*)values );
- }
-
- return 0;
-}
-
-
-/*
- * action routine for /KUIP/ALIAS/LIST
- */
-int kxalist()
-{
- char *pattern = ku_getc();
- static char *header[] = { "Argument", "Command" };
- HashTable *table[2];
- int k;
-
- table[0] = kc_alias.arg_table;
- table[1] = kc_alias.cmd_table;
-
- for( k = 0; k < 2; k++ ) {
- int n = hash_entries( table[k] );
- if( n == 0 ) {
- printf( " No %s aliases defined.\n", header[k] );
- }
- else {
- HashArray *alias = hash_array( table[k] );
- int i;
-
- printf( " %s aliases:\n", header[k] );
- for( i = 0; i < n; i++ ) {
- char *name = alias[i].name;
- char *value = (char*)alias[i].value;
-
- if( ku_match( name, pattern, 1 ) ) {
- printf( " %-10s => %s\n", name, value );
- }
- }
- free( (char*)alias );
- }
- }
- return 0;
-}
-
-
-/*
- * return the number of leading characters which are valid for an alias name
- */
-int len_alias( const char *line,
- int line_1 )
-{
- char *sep = " /,<=>:;.%'()";
- int len = 0;
-
- /*
- * An alias name must be preceeded (line_1) and followed by one of the
- * separator characters or '\0'.
- */
- if( strchr( sep, line_1 ) != NULL ) {
-
- while( line[len] != '\0'
- && ( isalnum( line[len] )
- || strchr( "_ at -$", line[len] ) != NULL ) ) {
- len++;
- }
-
- if( strchr( sep, line[len] ) == NULL )
- len = 0;
- }
- return len;
-}
-
-
-/*
- * if line contains a command alias substitute it
- * and return the allocated result
- * otherwise return NULL
- */
-char *subst_cmd_alias( line )
- char *line;
-{
- if( kc_alias.translate && kc_alias.substitutions > 0 ) {
- char *cmd;
- char *args;
- char *p;
-
- while( *line == ' ' )
- line++;
-
- cmd = strdup( line );
-
- /* separate command name from argument list */
- if( (p = strchr( cmd, ' ' )) != NULL ) {
- *p = '\0';
- for( args = p + 1; *args == ' '; )
- args++;
- }
- else
- args = "";
-
- if( (p = hash_lookup( kc_alias.cmd_table, cmd, NULL )) != NULL
- || (p = hash_lookup( kc_alias.arg_table, cmd, NULL )) != NULL ) {
-
- char *new_line = strdup( p );
-
- if( *args != '\0' )
- new_line = mstr2cat( new_line, " ", args );
-
- if( --kc_alias.substitutions <= 0 ) {
- ku_alfa();
- printf( " *** Recursive command alias in %s\n", new_line );
- }
-
- free( cmd );
- return new_line;
- }
- free( cmd );
- }
- return NULL;
-}
-
-
-/*
- * if line contains argument aliases substitute them
- * and return the allocated result
- * otherwise return NULL
- */
-char *subst_arg_alias( line )
- char *line;
-{
- char *p;
- if( kc_alias.translate
- && (p = repl_alias( line )) != NULL ) {
- char *new_line = p;
-
- kc_alias.substitutions = 100;
-
- while( --kc_alias.substitutions > 0 ) {
-
- if( (p = repl_alias( new_line )) == NULL )
- return new_line;
-
- free( new_line );
- new_line = p;
- }
- ku_alfa();
- printf( " *** Recursive argument alias in %s\n", line );
- free( new_line );
- }
- return NULL;
-}
-
-
-static
-char *repl_alias( const char *line )
-{
- const char *p;
-
- for( p = line; *p != '\0'; p++ ) {
- int len = len_alias( p, (p == line) ? '\0' : p[-1] );
-
- /* isolate the possible alias name */
- if( len > 0 ) {
- char *name = strndup( p, len );
- char *value = hash_lookup( kc_alias.arg_table, name, NULL );
-
- free( name );
- if( value != NULL ) {
- /* substitute the alias name by its value */
- int lhead = p - line;
-
- /* contract ABC//DEF to ABCDEF in case that is an alias */
- if( lhead > 2 && p[-1] == '/' && p[-2] == '/'
- && p[-3] != '\'' && p[-3] != ' ' )
- lhead -= 2;
-
- return mstr2cat( strndup( line, lhead ), value, p + len );
- }
- p += len - 1;
- }
- else if( *p == '\'' ) {
- /* skip until end of quoted string */
- while( *++p != '\'' ) {
- if( *p == '\0' )
- return NULL;
- }
- }
- }
- return NULL;
-}
-
-
-/*
- * return value of a variable "[var]"
- */
-char *var_value( const char *var )
-{
- int n = strlen( var );
- char *name = strndup( var + 1, n - 2 );
- char *value;
- char *p;
-
- if( name[0] == '%' ) {
- /* replace "[%var]" by "[[var]]" */
- name[0] = '[';
- name = mstrcat( name, "]" );
- }
-
- if( (p = subst_var_alias( name )) != NULL ) {
- free( name );
- name = p;
- }
-
- value = hash_lookup( kc_alias.var_table, name, NULL );
-
- if( value == NULL ) {
- int i;
- for( i = 0; name[i] != '\0'; i++ ) {
- if( !isdigit( name[i] ) ) {
- free( name );
- return strdup( var );
- }
- }
- /* undefined "[n]" are replaced by "' '" */
- value = " ";
- }
-
- free( name );
-
- return strdup( value );
-}
-
-
-char *subst_var_alias( line )
- char *line;
-{
- static int subst_calls=0;
- char *p;
-
- subst_calls++;
- if ( subst_calls > 100 ) {
- ku_alfa();
- printf(" Recursive variable assignment stopped in line \n %s\n",line);
- return(NULL);
- }
-
- if( (p = repl_variable( line )) != NULL ) {
- char *new_line = p;
-
- while( (p = repl_variable( new_line )) != NULL ) {
- free( new_line );
- new_line = p;
- }
- subst_calls--;
- return new_line;
- }
- subst_calls--;
- return NULL;
-}
-
-
-/*
- * replace a variable inside line by its value
- */
-char *repl_variable( line )
- char *line;
-{
- char *p;
-
- for( p = line; *p != '\0'; p++ ) {
-
- if( *p == '[' ) {
- int paren = 1;
- char *name_end = p + 1;
-
- while( *name_end != '\0' ) {
-
- if( *name_end == '[' ) {
- paren++;
- }
- else if( *name_end == ']' ) {
-
- if( --paren == 0 ) {
- int len = name_end - p + 1;
- char *name = strndup( p, len );
- char *value = var_value( name );
-
- if( strcmp( name, value ) != 0 ) {
- char *new_line = strndup( line, p - line );
- value = quote_string( value, 0 );
- new_line = mstr2cat( new_line, value, p + len );
- free( name );
- free( value );
- return new_line;
- }
- free( name );
- free( value );
- break;
- }
- }
- name_end++;
- }
- }
- else if( *p == '\'' ) {
- /* skip until end of quoted string */
- while( *++p != '\'' ) {
- if( *p == '\0' )
- return NULL;
- }
- }
- }
- return NULL;
-}
-
-
-/*
- * put quotes around string and duplicate quotes inside string
- * input string is supposed to be allocated
- * if quote flag is set the string is quoted anyway
- * otherwise it is quoted only if necessary
- */
-char *quote_string( char *string,
- int quote )
-{
- if( string[0] == '\0' ) {
- free( string );
- return strdup( "''" );
- }
-
- else {
- int n;
-
- if( string[0] == '\'' && (n = strlen( string )) > 1
- && string[n-1] == '\'' )
- return string;
- }
-
- if( !quote )
- quote = (strpbrk( string, " '" ) != NULL);
-
- if( !quote )
- return string;
-
- else {
- char *line = strdup( "'" );
- char *p;
-
- for( p = string; *p != '\0'; p++ ) {
- if( *p == '\'' )
- line = mstrcat( line, "''" );
- else
- line = mstrccat( line, *p, 1 );
- }
- line = mstrcat( line, "'" );
- free( string );
- return line;
- }
-}
-
-
-enum SysFunCode {
- SysANUM,
- SysARGS,
- SysCPTIME,
- SysDATE,
- SysKEYNUM,
- SysKEYVAL,
- SysLAST,
- SysMACHINE,
- SysNUMVEC,
- SysOS,
- SysPID,
- SysRTIME,
- SysSTYLE,
- SysTIME
-};
-
-static struct sysfun {
- enum SysFunCode code;
- char *name;
-} sysfun[] = {
- { SysANUM, "ANUM" },
- { SysARGS, "ARGS" },
- { SysCPTIME, "CPTIME" },
- { SysDATE, "DATE" },
- { SysKEYNUM, "KEYNUM" },
- { SysKEYVAL, "KEYVAL" },
- { SysLAST, "LAST" },
- { SysMACHINE, "MACHINE" },
- { SysNUMVEC, "NUMVEC" },
- { SysOS, "OS" },
- { SysPID, "PID" },
- { SysRTIME, "RTIME" },
- { SysSTYLE, "STYLE" },
- { SysTIME, "TIME" }
-};
-
-/*
- * substitute system function
- * if eval flag is set functions with arguments are sent to expression parser
- */
-char *subst_sysfun( line, eval )
- char *line;
- int eval;
-{
- char *p;
- if( (p = repl_sysfun( line, eval )) != NULL ) {
- char *new_line = p;
-
- while( (p = repl_sysfun( new_line, eval )) != NULL ) {
- free( new_line );
- new_line = p;
- }
- return new_line;
- }
- return NULL;
-}
-
-
-/*
- * return the number of leading characters which are valid for a function name
- * line does not include the leading '$'
- */
-int len_sysfun( const char *line )
-{
- int len = 0;
-
- if( !isdigit( line[0] ) ) {
- while( line[len] != '\0'
- && ( isalnum( line[len] )
- || strchr( "_", line[len] ) != NULL ) ) {
- len++;
- }
- }
- return len;
-}
-
-
-char *repl_sysfun( line, eval )
- char *line;
- int eval;
-{
- char *p;
-
- for( p = line; *p != '\0'; p++ ) {
-
- if( *p == '$' ) {
- int len = len_sysfun( p + 1 );
-
- /* protect against DISK$USER:[dir] etc. */
- if( len > 0 && p[len+1] != ':' ) {
- int i;
- char *value = NULL;
-
- /* test for system functions without arguments */
- for( i = 0; i < (sizeof sysfun) / sizeof( struct sysfun ); i++ ) {
-
- if( len == strlen( sysfun[i].name )
- && strncasecmp( p + 1, sysfun[i].name, len ) == 0 ) {
-
- switch( sysfun[i].code ) {
-
- case SysANUM: /* number of aliases */
- value = malloc( 16 );
- sprintf( value, "%d", hash_entries( kc_alias.arg_table ) );
- break;
-
- case SysARGS: /* program arguments */
- value = strdup( k_getar() );
- break;
-
- case SysCPTIME: /* CPU time since last call */
- value = sys_cptime();
- break;
-
- case SysDATE: /* current date */
- value = sys_date();
- break;
-
- case SysKEYNUM:
- value = strdup( (kc_window.panel_keynum != NULL)
- ? kc_window.panel_keynum : "0.00" );
- break;
-
- case SysKEYVAL:
- value = strdup( (kc_window.panel_keyval != NULL)
- ? kc_window.panel_keyval : "' '" );
- break;
-
- case SysLAST:
- if( kc_flags.last_cmd == NULL )
- value = strdup( "" );
- else
- value = strdup( kc_flags.last_cmd );
- /* avoid infinite recursion if last command contains $LAST */
- value = quote_string( value, 1 );
- break;
-
- case SysMACHINE:
- value = strdup( MACHINE_NAME );
- break;
-
- case SysNUMVEC:
- value = malloc( 16 );
- sprintf( value, "%d", (int)Kcvect.NUMVEC - 1 );
- break;
-
- case SysOS:
- value = strdup( OS_NAME );
- break;
-
- case SysPID:
- value = malloc( 16 );
- sprintf( value, "%d", (int)getpid() );
- break;
-
- case SysRTIME: /* real time since last call */
- value = sys_rtime();
- break;
-
- case SysSTYLE:
- value = strdup( style_name( kc_flags.style ) );
- break;
-
- case SysTIME:
- value = sys_time();
- break;
- }
- }
- }
-
- /* test for system functions with arguments */
- if( value == NULL && eval && p[len+1] == '(' ) {
- int arglen = match_paren( p );
-
- if( arglen > 0 ) {
- char *expr = strndup( p, arglen );
- int is_eval = (strncasecmp( p + 1, "EVAL", len ) == 0);
- int is_unquote = (strncasecmp( p + 1, "UNQUOTE", len ) == 0);
-
- if( is_eval || is_unquote ) {
- expr[arglen-1] = '\0';
- expr = strcpy( expr, expr + len + 2 );
- }
- value = ku_eval( expr );
- free( expr );
- if( value != NULL ) {
- if( !is_unquote )
- value = quote_string( value, 0 );
- len = arglen - 1;
- }
- }
- }
-
- if( value == NULL && kc_flags.try_getenv ) {
- /* try $var as environment variable */
- char *name = strndup( p + 1, len );
- char *env = getenv( name );
- /*
- * Note that on VMS getenv searches uppercase names first in the
- * logical names tables and then in the symbol table.
- * Lowercase names are searched for only in the symbol table.
- * Ignore value starting with $ or @ which are most probable
- * command abbreviations.
- */
- free( name );
-#ifdef vms
- if( env != NULL && env[0] != '$' && env[0] != '@' )
- value = strdup( env );
-#else
- if( env != NULL )
- value = strdup( env );
-#endif
- }
- if( value != NULL ) {
- char *new_line = strndup( line, p - line );
- new_line = mstr2cat( new_line, value, p + len + 1 );
- free( value );
- return new_line;
- }
- }
- }
- else if( *p == '\'' ) {
- while( *++p != '\'' ) {
- if( *p == '\0' )
- return NULL;
- }
- }
- }
- return NULL;
-}
-
-
-/*
- * find the distance to the next balanced ')'
- */
-int match_paren( const char *line )
-{
- int len;
- int paren = 0;
-
- for( len = 0; line[len] != '\0'; len++ ) {
-
- switch( line[len] ) {
-
- case '(':
- paren++;
- break;
-
- case ')':
- paren--;
- if( paren == 0 )
- return len + 1;
- break;
-
- case '\'':
- while( line[++len] != '\'' ) {
- if( line[len] == '\0' )
- return 0;
- }
- break;
-
- }
- }
- return 0;
-}
-
-
-/*
- * return value for $CPTIME
- */
-static
-char *sys_cptime()
-{
- static int initialized = 0;
- static clock_t time0;
- clock_t time_now;
- char *value = malloc( 16 );
-
- if( !initialized ) {
- initialized = 1;
- time0 = clock();
- }
- time_now = clock();
- sprintf( value, "%.3f", (double)(time_now - time0) / CLOCKS_PER_SEC );
- time0 = time_now;
- return value;
-}
-
-
-/*
- * return value for $RTIME
- */
-static
-char *sys_rtime()
-{
- static int initialized = 0;
- static time_t time0;
- time_t time_now;
- char *value = malloc( 16 );
-
- if( !initialized ) {
- initialized = 1;
- time0 = time( NULL );
- }
- time_now = time( NULL );
- sprintf( value, "%d", (int)difftime( time_now, time0) );
- time0 = time_now;
- return value;
-}
-
-
-/*
- * return value of $DATE
- */
-static
-char *sys_date()
-{
- time_t time_now = time( NULL );
- struct tm *tms = localtime( &time_now );
- char *value = malloc( 16 );
-
- sprintf( value, "%s/%s/%s",
- strfromi( tms->tm_mday, 2 ), strfromi( tms->tm_mon + 1, 2 ),
- strfromi( tms->tm_year+1900, 4 ) );
- return value;
-}
-
-
-/*
- * return value of $TIME
- */
-static
-char *sys_time()
-{
- time_t time_now = time( NULL );
- struct tm *tms = localtime( &time_now );
- char *value = malloc( 16 );
-
- sprintf( value, "%s.%s.%s",
- strfromi( tms->tm_hour, 2), strfromi( tms->tm_min, 2 ),
- strfromi( tms->tm_sec, 2 ) );
- return value;
-}
-
-
-/*
- * return commands to restore current environment
- */
-void F77_ENTRY_C(Kuqenv,chline)
-/* { */
- static char **env = NULL;
- static int next = 0;
- char *line = fstr0dup( chline, len_chline );
-
- if( line == NULL ) {
- env = ku_qenv();
- next = 0;
- }
- else
- free( line );
-
- if( env == NULL || env[next] == NULL )
- fstrset( chline, len_chline, "" );
- else
- fstrset( chline, len_chline, env[next++] );
-}
-
-
-char **ku_qenv()
-{
- static char **env = NULL;
- char numbers[64];
- int nenv = 0;
- int k;
-
- if( env != NULL ) {
- int n;
- for( n = 0; env[n] != NULL; n++ )
- free( env[n] );
- free( (char*)env );
- }
- env = (char**)malloc( 64 * sizeof(char*) );
-
- env[nenv++] = str3dup( "/KUIP/SET_SHOW/BREAK '",
- kc_value.set_break, "'" );
-
- env[nenv++] = str2dup( "/KUIP/SET_SHOW/COLUMNS ",
- kc_value.set_columns );
-
- if( kc_value.set_command != NULL ) {
- env[nenv++] = str3dup( "/KUIP/SET_SHOW/COMMAND '",
- kc_value.set_command, "'" );
- }
-
- env[nenv++] = str3dup( "/KUIP/SET_SHOW/DOLLAR '",
- kc_value.set_dollar, "'" );
-
- env[nenv++] = str3dup( "/KUIP/SET_SHOW/FILECASE '",
- kc_value.set_filecase, "'" );
-
- env[nenv++] = str3dup( "/KUIP/SET_SHOW/HOST_EDITOR '",
- kc_value.set_host_editor, "'" );
-
- sprintf( numbers, "%d %d %d %d",
- kc_window.edit_pad.top,
- kc_window.edit_pad.left,
- kc_window.edit_pad.width,
- kc_window.edit_pad.height );
- env[nenv++] = str2dup( "/KUIP/SET_SHOW/HOST_EDITOR 'WINDOW' ", numbers );
-
- sprintf( numbers, "%d %d %d %d %d %d %d",
- kc_window.help_pad.top,
- kc_window.help_pad.left,
- kc_window.help_pad.width,
- kc_window.help_pad.height,
- kc_window.hoffset,
- kc_window.voffset,
- kc_window.shift_max );
- env[nenv++] = str2dup( "/KUIP/SET_SHOW/HOST_EDITOR 'PAD' ", numbers );
-
- env[nenv++] = str3dup( "/KUIP/SET_SHOW/HOST_PAGER '",
- kc_value.set_host_pager, "'" );
-
- if( kc_value.set_print_cmds != NULL ) {
- int i;
- for( i = 0; kc_value.set_print_cmds[i] != NULL; i++ ) {
- env[nenv++] = str4dup( "/KUIP/SET_SHOW/HOST_PRINTER '",
- kc_value.set_print_cmds[i], "' ",
- kc_value.set_print_exts[i] );
- }
- }
-
- env[nenv++] = str3dup( "/KUIP/SET_SHOW/HOST_PSVIEWER '",
- kc_value.set_host_psviewer, "'" );
-
- env[nenv++] = str3dup( "/KUIP/SET_SHOW/HOST_SHELL '",
- kc_value.set_host_shell, "'" );
-
- env[nenv++] = str3dup( "/KUIP/SET_SHOW/PROMPT '",
- kc_value.set_prompt, "'" );
-
- env[nenv++] = str3dup( "/KUIP/SET_SHOW/RECALL_STYLE '",
- kc_value.set_recall_style, "'" );
-
- env[nenv++] = str2dup( "/KUIP/SET_SHOW/RECORDING ",
- kc_value.set_recording );
-
- env[nenv++] = str2dup( "/KUIP/SET_SHOW/ROOT ",
- kc_value.set_root );
-
- env[nenv++] = str3dup( "/KUIP/SET_SHOW/STYLE '",
- kc_value.set_style, "'" );
-
- env[nenv++] = str3dup( "/KUIP/SET_SHOW/TIMING '",
- kc_value.set_timing, "'" );
-
- env[nenv++] = str2dup( "/KUIP/HELP ",
- kc_value.help_edit );
-
- env[nenv++] = str4dup( "/MACRO/DEFAULTS '",
- kc_value.defaults_path, "' ",
- kc_value.defaults_order );
-
- for( k = 0; k < 2; k++ ) {
- HashArray *alias;
- int nalias;
- char *opt;
- int i;
-
- if( k == 0 ) {
- nalias = hash_entries( kc_alias.arg_table );
- alias = hash_array( kc_alias.arg_table );
- opt = "'";
- }
- else {
- nalias = hash_entries( kc_alias.cmd_table );
- alias = hash_array( kc_alias.cmd_table );
- opt = "' 'C'";
- }
-
- if( nalias > 0 ) {
- env = (char**)realloc( (char*)env, (nenv + nalias + 1) * sizeof(char*) );
-
- for( i = 0; i < nalias; i++, nenv++ ) {
- char *value = strdup( (char*)alias[i].value );
- char *p;
-
- env[nenv] = str3dup( "/KUIP/ALIAS/CREATE '", alias[i].name, "' '" );
- while( (p = strchr( value, '\'' )) != NULL ) {
- *p = '\0';
- env[nenv] = mstr2cat( env[nenv], value, "''" );
- strcpy( value, p + 1 );
- }
- env[nenv] = mstr2cat( env[nenv], value, opt );
- free( value );
- }
- free( (char*)alias );
- }
- }
- env[nenv] = NULL;
- return env;
-}
diff --git a/src/packlib/kuip/code_kuip/kbrow.c b/src/packlib/kuip/code_kuip/kbrow.c
deleted file mode 100644
index 4fe8634..0000000
--- a/src/packlib/kuip/code_kuip/kbrow.c
+++ /dev/null
@@ -1,918 +0,0 @@
-/*
- * $Id: kbrow.c,v 1.1.1.1 1996/03/08 15:32:52 mclareni Exp $
- *
- * $Log: kbrow.c,v $
- * Revision 1.1.1.1 1996/03/08 15:32:52 mclareni
- * Kuip
- *
- */
-/*CMZ : 2.07/06 14/06/95 15.23.02 by Gunter Folger*/
-/*-- Author : Alfred Nathaniel 07/08/92*/
-/* kbrow.c */
-
-#include "kuip/kuip.h"
-#include "kuip/kfor.h"
-#include "kuip/kbrow.h"
-#include "kuip/klink.h"
-#include "kuip/kmenu.h"
-#include "kuip/kflag.h"
-#include "kuip/ksig.h"
-
-EXTERN char cdf_def[80], cdf_value[80];
-
-
-static KmClass *kmclasses; /* list of object classes */
-static BrObject *brobjects; /* list of browsable objects */
-
-
-/* internal functions */
-static void decode_setting( BrObject*, const char* );
-static BrClass* find_brclass( const char* );
-static KmObject* find_kmobject( const char* );
-static BrVariable* find_variable( BrObject*, const char* );
-static void free_variables( BrVariable* );
-
-
-/*
- * add to the list of browsable classes
- */
-void klnkbrcl( BrClass *brcls_list,
- int version )
-{
- BrClass *brcls;
-
- strcpy ( cdf_def, "Browser Class" );
- strcpy ( cdf_value, brcls_list->name );
- check_version( version, KUIP_VERSION );
-
- /* fill the reference to the class structure in the open action */
- for( brcls = brcls_list; brcls != NULL; brcls = brcls->next ) {
- BrAction *bract;
- for( bract = brcls->open; bract != NULL; bract = bract->next )
- bract->class = brcls;
- }
-
- if( brclasses == NULL )
- brclasses = brcls_list;
- else {
- for( brcls = brclasses; brcls->next != NULL; )
- brcls = brcls->next;
- brcls->next = brcls_list;
- }
-}
-
-
-/*
- * add to the list of object classes
- */
-void klnkkmcl( KmClass *kmcls_list,
- int version )
-{
- strcpy ( cdf_def, "Object Class" );
- strcpy ( cdf_value, kmcls_list->name );
- check_version( version, KUIP_VERSION );
-
- if( kmclasses == NULL )
- kmclasses = kmcls_list;
- else {
- KmClass *kmcls = kmclasses;
-
- while( kmcls != NULL ) {
-
- /* redefinition of class name ? */
- if( strcasecmp( kmcls->name, kmcls_list->name ) == 0 ) {
-
- /* copy new attributes */
- if( kmcls_list->title != NULL )
- kmcls->title = kmcls_list->title;
- if( kmcls_list->big_icon != NULL )
- kmcls->big_icon = kmcls_list->big_icon;
- if( kmcls_list->sm_icon != NULL )
- kmcls->sm_icon = kmcls_list->sm_icon;
- if( kmcls_list->user_icon_F != NULL )
- kmcls->user_icon_F = kmcls_list->user_icon_F;
- if( kmcls_list->user_icon_C != NULL )
- kmcls->user_icon_C = kmcls_list->user_icon_C;
-
- /* append actions */
- if( kmcls->cont == NULL )
- kmcls->cont = kmcls_list->cont;
- else if( kmcls_list->cont != NULL ) {
- BrAction *bract = kmcls->cont;
- while( bract->next != NULL )
- bract = bract->next;
- bract->next = kmcls_list->cont;
- }
-
- if( kmcls->graf == NULL )
- kmcls->graf = kmcls_list->graf;
- else if( kmcls_list->graf != NULL ) {
- BrAction *bract = kmcls->graf;
- while( bract->next != NULL )
- bract = bract->next;
- bract->next = kmcls_list->graf;
- }
-
- if( kmcls_list->next != NULL )
- klnkkmcl( kmcls_list->next, version );
- return;
- }
- else if( kmcls->next == NULL ) {
- /* append new class name at end of list */
- kmcls->next = kmcls_list;
- if( kmcls_list->next != NULL ) {
- KmClass *next = kmcls_list->next;
- kmcls_list->next = NULL;
- klnkkmcl( next, version );
- }
- return;
- }
- else
- kmcls = kmcls->next;
- }
- }
-}
-
-
-/*
- * add to the list of buttons
- */
-void klnkbutt( KmButton *kmbut_list,
- int version )
-{
- if (kmbut_list->menu != NULL) {
- strcpy ( cdf_def, "Menu" );
- strcpy ( cdf_value, kmbut_list->menu );
- } else {
- strcpy ( cdf_def, "Button" );
- strcpy ( cdf_value, kmbut_list->label );
- }
- check_version( version, KUIP_VERSION );
-
- if( kmbuttons == NULL )
- kmbuttons = kmbut_list;
- else {
- KmButton *kmbut = kmbuttons;
- while( kmbut->next != NULL )
- kmbut = kmbut->next;
- kmbut->next = kmbut_list;
- }
-}
-
-
-/*
- * return widget ID for a button
- */
-KmWidget find_button( const char *label,
- const char *menu )
-{
- KmButton *kmbut;
-
- if( menu == NULL ) {
- /* search for button */
- for( kmbut = kmbuttons; kmbut != NULL; kmbut = kmbut->next ) {
- if( kmbut->menu == NULL &&
- strcasecmp( kmbut->label, label ) == 0 )
- return kmbut->widget;
- }
- }
- else {
- /* search for menu item */
- for( kmbut = kmbuttons; kmbut != NULL; kmbut = kmbut->next ) {
- if( kmbut->menu != NULL && strcasecmp( kmbut->menu, menu ) == 0 &&
- strcasecmp( kmbut->label, label ) == 0 )
- return kmbut->widget;
- }
- }
- return (KmWidget)0;
-}
-
-
-/*
- * perform the action
- */
-void exec_action( BrAction *bract,
- const char *brobj_name,
- const char *kmobj_name,
- int force_panel,
- KmWidget widget,
- KmCalldata calldata )
-{
- kc_break.intr_pending = 0;
-
- if( bract == NULL ) return;
- if( bract->exec != NULL ) {
- int status;
- int want_prompt = force_panel ? -1 : 1;
- char cmd[256];
- char *s, *p;
- int n;
-
- for( s = bract->exec, n = 0; *s != '\0' && n < (sizeof cmd) - 1; ) {
- if( *s == '[' ) { /* variable substitution */
- if( (p = strchr( s, ']' )) != NULL ) {
- int len = p - s - 1;
- char *var = strndup( s + 1, len );
- const char *val = NULL;
- int lval = 0;
-
- if( bract->tag == BRACT_GRAF ) {
- /*
- * in the graf window kmobj_name contains the comma separated
- * list of the object hierarchy returned by IGOBJ
- * "this" refers to the lowest level
- * "this1", "this2", ... refer to the higher levels
- */
- if( strcasecmp( var, "this" ) == 0
- || ( len == 5 && isdigit( var[4] )
- && strncasecmp( var, "this", 4 ) == 0 ) ) {
- int k;
- for( k = (len == 4) ? 0 : atoi( &var[4] ), val = kmobj_name;
- k > 0 && val != NULL; k-- ) {
- val = strchr( val, ',' );
- if( val != NULL )
- val++;
- }
- if( val != NULL ) {
- const char *comma = strchr( val, ',' );
- if( comma != NULL )
- lval = comma - val;
- }
- }
- }
-
- else if( strcasecmp( var, "this" ) == 0 )
- val = kmobj_name;
-
- else if( bract->tag == BRACT_CONT
- && strcasecmp( var, "that" ) == 0 ) {
- /* "that" is replaced by the short text used as alias name */
- KmObject *kmobj = find_kmobject( kmobj_name );
- if( kmobj != NULL )
- val = kmobj->stext;
- }
-
- else if( brobj_name != NULL )
- val = get_variable( brobj_name, var );
-
- free( var );
-
- if( val != NULL ) {
- int quote = 0;
- if( lval == 0 ) {
- lval = strlen( val );
- quote = (strchr( val, ' ' ) != NULL);
- }
- if( quote )
- cmd[n++] = '\'';
- strncpy( &cmd[n], val, lval );
- n += lval;
- if( quote )
- cmd[n++] = '\'';
- s = p + 1;
- continue;
- }
- }
- }
- cmd[n++] = *s++;
- }
- cmd[n] = '\0';
- if( kc_flags.echo_command > 0 )
- printf( "%s> %s\n", kc_flags.echo_prompt, cmd );
-
- status = exec_cmd_string( cmd, want_prompt, kjmpaddr.disp_panel_C );
- if( status == KUMAC_UNWIND )
- return; /* do not go into callback function */
- }
- if( bract->call_F != NULL || bract->call_C != NULL ) {
- BrObject *brobj;
- BrClass *brcls;
- char *brcls_name;
- char *path;
- KmClass *kmcls;
- const char *kmcls_name;
- KmObject *kmobj;
- char *short_text;
- char *long_text;
- BrClientdata clientdata;
-
- if( bract->call_C != NULL ) {
- clientdata.tag = bract->tag;
- clientdata.brobj = NULL;
- clientdata.brcls = NULL;
- clientdata.path = NULL;
- clientdata.kmobj = NULL;
- clientdata.kmcls = NULL;
- clientdata.stext = NULL;
- clientdata.ltext = NULL;
- clientdata.mtext = bract->text;
- }
-
- switch( bract->tag ) {
-
- case BRACT_OPEN:
- brcls_name = bract->class->name;
- if( bract->call_F != NULL ) {
- int lbrcls_name = strlen( brcls_name );
- F77_CALL_C(bract->call_F,brcls_name,lbrcls_name);
- }
- else if( bract->call_C != NULL ) {
- clientdata.brcls = brcls_name;
- (*bract->call_C)(widget,&clientdata,calldata);
- }
- break;
-
- case BRACT_ROOT:
- brobj = find_brobject( brobj_name );
- brcls = brobj->class;
- brcls_name = brcls->name;
- path = get_variable( brobj_name, "path" );
- if( bract->call_F != NULL ) {
- int lbrobj_name = strlen( brobj_name );
- int lbrcls_name = strlen( brcls_name );
- int lpath = strlen( path );
- F77_CALL_C3(bract->call_F,brobj_name,lbrobj_name,
- brcls_name,lbrcls_name,path,lpath);
- }
- else if( bract->call_C != NULL ) {
- clientdata.brobj = brobj_name;
- clientdata.brcls = brcls_name;
- clientdata.path = path;
- (*bract->call_C)(widget,&clientdata,calldata);
- }
- break;
-
- case BRACT_CONT:
- brobj = find_brobject( brobj_name );
- brcls = brobj->class;
- brcls_name = brcls->name;
- path = get_variable( brobj_name, "path" );
- kmobj = find_kmobject( kmobj_name );
- kmcls = kmobj->class;
- kmcls_name = kmcls->name;
- short_text = kmobj->stext;
- long_text = kmobj->ltext;
- if( bract->call_F != NULL ) {
- int lbrobj_name = strlen( brobj_name );
- int lbrcls_name = strlen( brcls_name );
- int lpath = strlen( path );
- int lkmobj_name = strlen( kmobj_name );
- int lkmcls_name = strlen( kmcls_name );
- int lshort_text;
- int llong_text;
- if( short_text == NULL )
- short_text = " ";
- lshort_text = strlen( short_text );
- if( long_text == NULL )
- long_text = " ";
- llong_text = strlen( long_text );
- F77_CALL_C7(bract->call_F,brobj_name,lbrobj_name,
- brcls_name,lbrcls_name,path,lpath,
- kmobj_name,lkmobj_name,kmcls_name,lkmcls_name,
- short_text,lshort_text,long_text,llong_text);
- }
- else if( bract->call_C != NULL ) {
- clientdata.brobj = brobj_name;
- clientdata.brcls = brcls_name;
- clientdata.path = path;
- clientdata.kmobj = kmobj_name;
- clientdata.kmcls = kmcls_name;
- clientdata.stext = short_text;
- clientdata.ltext = long_text;
- (*bract->call_C)(widget,&clientdata,calldata);
- }
- break;
-
- case BRACT_GRAF:
- kmcls_name = brobj_name; /* special !!! */
- if( bract->call_F != NULL ) {
- int lkmobj_name = strlen( kmobj_name );
- int lkmcls_name = strlen( kmcls_name );
- F77_CALL_CC(bract->call_F,kmobj_name,lkmobj_name,
- kmcls_name,lkmcls_name);
- }
- else if( bract->call_C != NULL ) {
- clientdata.kmobj = kmobj_name;
- clientdata.kmcls = kmcls_name;
- (*bract->call_C)(widget,&clientdata,calldata);
- }
- break;
- }
- }
-}
-
-
-/*
- * find action structure with given menu text
- *
- * if user_text == NULL leave it unchanged
- * if user_text == "" revert to CDF text
- * otherwise set new user text
- *
- * if sensitive|toggle_on < 0 leave it unchanges
- * otherwise set new value
- *
- * return -1 if structure not found
- * otherwise return present sensitivity and toggle state
- */
-int set_action( const char *class_name,
- int is_browsable, /* select object or browsable class */
- int graf_or_open, /* select CONT/GRAF or ROOT/OPEN */
- const char *text,
- const char *user_text,
- int sensitive,
- int toggle_on )
-{
- BrAction *bract = NULL;
- int states = -1;
-
- if( is_browsable ) {
- BrClass *brcls = find_brclass( class_name );
- if( brcls != NULL )
- bract = graf_or_open ? brcls->open : brcls->root;
- }
- else {
- KmClass *kmcls = find_kmclass( class_name );
- if( kmcls != NULL )
- bract = graf_or_open ? kmcls->graf : kmcls->cont;
- }
-
- for( ; bract != NULL; bract = bract->next ) {
- if( strcasecmp( bract->text, text ) == 0 ) {
-
- /* prepare the return value of present states */
- states = 0;
- if( bract->flags & BrActSensitive )
- states |= 1;
- if( bract->flags & BrActToggleOn )
- states |= 2;
-
- if( sensitive >= 0 ) {
- bract->flags &= ~BrActSensitive;
- if( sensitive )
- bract->flags |= BrActSensitive;
- }
- if( toggle_on >= 0 ) {
- bract->flags &= ~BrActToggleOn;
- if( toggle_on )
- bract->flags |= BrActToggleOn;
- }
- if( user_text != NULL ) {
- if( bract->user_text != NULL )
- free( bract->user_text );
- bract->user_text = str0dup( user_text );
- }
- break;
- }
- }
- return states;
-}
-
-
-/*
- * build the list of all browsable objects to be displayed in the root window
- */
-BrObject *scan_brobjects()
-{
- BrObject *save_brobjects = brobjects;
- BrObject *brobj = NULL;
- BrClass *brcls;
-
- brobjects = NULL;
-
- /* scan through the list of browsable classes */
- for( brcls = brclasses; brcls != NULL; brcls = brcls->next ) {
- char *root;
-
- if( brcls->scan_br_F == NULL && brcls->scan_br_C == NULL ) {
- /* no scan function --> only one object with name = class name */
- if( brobjects == NULL )
- brobj = brobjects = (BrObject*)malloc( sizeof(BrObject) );
- else
- brobj = brobj->next = (BrObject*)malloc( sizeof(BrObject) );
- brobj->next = NULL;
- brobj->name = strdup( brcls->name );
- brobj->class = brcls;
- brobj->vars = NULL;
- set_variable( brobj, "name", brobj->name );
- }
- else {
- /* call the user scan function to retrieve the list of browsables */
- char *brcls_name = brcls->name;
- int lbrcls_name = strlen( brcls_name );
- char brobj_name[32];
- int lbrobj_name = (sizeof brobj_name);
- char brvar_set[256];
- int lbrvar_set = (sizeof brvar_set);
- int first_call = 1;
-
- memset( brobj_name, ' ', lbrobj_name );
- while( 1 ) {
- char *name;
- char *vars;
-
- if( brcls->scan_br_F != NULL ) {
- memset( brvar_set, ' ', lbrvar_set );
- F77_CALL_C3(brcls->scan_br_F,brcls_name,lbrcls_name,
- brobj_name,lbrobj_name,brvar_set,lbrvar_set);
-
- name = fstr0trim( brobj_name, lbrobj_name );
- if( name == NULL )
- break; /* empty object name flags end of list */
- vars = fstr0dup( brvar_set, lbrvar_set );
- }
- else {
- char **brobj_dsc = (*brcls->scan_br_C)( brcls->name, first_call );
- if( brobj_dsc == NULL )
- break;
- first_call = 0;
- name = str0dup( brobj_dsc[0] );
- if( name == NULL )
- break;
- vars = str0dup( brobj_dsc[1] );
- }
-
- if( brobjects == NULL )
- brobj = brobjects = (BrObject*)malloc( sizeof(BrObject) );
- else
- brobj = brobj->next = (BrObject*)malloc( sizeof(BrObject) );
-
- brobj->next = NULL;
- brobj->name = name;
- brobj->class = brcls;
- brobj->vars = NULL;
- set_variable( brobj, "name", brobj->name );
- root = str2dup( "//", brobj->name );
- set_variable( brobj, "root", root );
- free( root );
-
- if( vars != NULL ) {
- decode_setting( brobj, vars );
- free( vars );
- }
- }
- }
- }
-
- for( brobj = save_brobjects; brobj != NULL; ) {
- /* free allocated space in the previous list of browsable objects */
- BrObject *next = brobj->next;
- BrObject *new_brobj = find_brobject( brobj->name );
-
- if( new_brobj != NULL ) {
- /* restore previous variable settings */
- BrVariable *brvar;
- for( brvar = brobj->vars; brvar != NULL; brvar = brvar->next ) {
- BrVariable *new_brvar = find_variable( new_brobj, brvar->name );
- if( new_brvar == NULL )
- set_variable( new_brobj, brvar->name, brvar->value );
- }
- }
- free_variables( brobj->vars );
- free( brobj->name );
- free( brobj );
- brobj = next;
- }
- return brobjects;
-}
-
-
-/*
- * build the list of all objects to be displayed in the content window
- */
-KmObject *scan_kmobjects( const char *brobj_name,
- const char *path_name,
- int browser_number )
-{
- static char dummy_path[] = "//...";
- static int ldummy_path = (sizeof dummy_path) - 1;
- int lbrobj_name = strlen( brobj_name );
- const char *path = path_name;
- int lpath;
- char kmobj_name[32];
- int lkmobj_name = (sizeof kmobj_name);
- char kmcls_name[32];
- int lkmcls_name = (sizeof kmcls_name);
- char short_text[80];
- int lshort_text = (sizeof short_text);
- char long_text[80];
- int llong_text = (sizeof long_text);
- char *brcls_name;
- int lbrcls_name;
- BrObject *brobj = find_brobject( brobj_name );
- KmObject *kmobj;
- KmClass *kmcls;
- char path_n[16];
- int i;
-
- if( brobj == NULL ) {
- printf( "scan_kmobjects: browsable object %s not found\n", brobj_name );
- return NULL;
- }
-
- brcls_name = brobj->class->name;
- lbrcls_name = strlen( brcls_name );
-
- if( strncmp( path_name, dummy_path, ldummy_path ) == 0 ) {
- /* ignore the dummy path header */
- path = path_name + ldummy_path;
- }
- lpath = strlen( path );
-
- set_variable( brobj, "path", path );
- /* remember the last path setting in each browser */
- sprintf( path_n, "path_%d", browser_number );
- set_variable( brobj, path_n, path );
-
- /* reset the object counters in the class structure used for "summary" */
- for( kmcls = kmclasses; kmcls != NULL; kmcls = kmcls->next )
- kmcls->obj_count = 0;
-
- /* free allocated space in the existing list of objects */
- for( kmobj = kmobjects; kmobj != NULL; ) {
- KmObject *next = kmobj->next;
- free( kmobj->name );
- if( kmobj->stext != NULL )
- free( kmobj->stext );
- if( kmobj->ltext != NULL )
- free( kmobj->ltext );
- free( kmobj );
- kmobj = next;
- }
- kmobjects = NULL;
-
- /* call the user scan function to retrieve the list of objects */
-/*
- * SUBROUTINE scan_km(BRNAME,BRCLASS,PATH,OBJNAME,KMCLASS,STEXT,LTEXT)
- * CHARACTER*(*) BRCLASS,BRNAME,PATH,OBJNAME,KMCLASS,STEXT,LTEXT
- *
- * input BRNAME : name of the browsable object, e.g. 'LUN1'
- * input BRCLASS : class name of the browsable object, e.g. 'HBOOK'
- * input PATH : path of selected directory, e.g '//LUN1' or '//LUN1/DIR'
- * in/out OBJNAME : name of the next object
- * output KMCLASS : class name of the object
- * output STEXT : short text describing the object
- * output LTEXT : long text describing the object
- *
- * If called with OBJNAME=' ' this routine has to return the first object
- * in the current directory of the browsable object BRNAME. Otherwise it has
- * to return the next object. If there is no next object it has to return
- * OBJNAME=' '.
- *
- *
- * SUBROUTINE scan_br(BRCLASS,BRNAME,VARSET)
- * CHARACTER*(*) BRCLASS,BRNAME,VARSET
- *
- */
-
- for( i = 0; 1; i++ ) {
- char *oname = NULL;
- char *cname = NULL;
- char *stext = NULL;
- char *ltext = NULL;
-
- if( brobj->class->scan_km_F != NULL ) {
- if( i == 0 )
- memset( kmobj_name, ' ', lkmobj_name );
- memset( short_text, ' ', lshort_text );
- memset( long_text, ' ', llong_text );
- F77_CALL_C7(brobj->class->scan_km_F,
- brobj_name,lbrobj_name,brcls_name,lbrcls_name,path,lpath,
- kmobj_name,lkmobj_name,kmcls_name,lkmcls_name,
- short_text,lshort_text,long_text,llong_text);
- oname = fstr0trim( kmobj_name, lkmobj_name );
- cname = fstr0trim( kmcls_name, lkmcls_name );
- stext = fstr0trim( short_text, lshort_text );
- ltext = fstr0dup( long_text, llong_text );
- }
- else {
- char **obj_desc = (*brobj->class->scan_km_C)( brobj_name, brcls_name,
- path, i );
- if( obj_desc != NULL ) {
- oname = str0dup( obj_desc[0] );
- cname = str0dup( obj_desc[1] );
- stext = str0dup( obj_desc[2] );
- ltext = str0dup( obj_desc[3] );
- }
- }
-
- if( oname == NULL ) {
- if( ltext == NULL ) {
- /* construct summary from object count in class structure */
- int len = 0;
- ltext = malloc( 1 );
- ltext[0] = '\0';
- for( kmcls = kmclasses; kmcls != NULL; kmcls = kmcls->next ) {
- if( kmcls->obj_count != 0 ) {
- char *sp1 = len > 0 ? " " : "";
- int nsp1 = strlen( sp1 );
- char *txt = kmcls->title;
- int ntxt = strlen( txt );
- char *sp2 = " : ";
- int nsp2 = strlen( sp2 );
- char cnt[32];
- int ncnt;
- sprintf( cnt, "%d", kmcls->obj_count );
- ncnt = strlen( cnt );
- ltext = realloc( ltext, len + nsp1 + ntxt + nsp2 + ncnt + 1 );
- strcpy( <ext[len], sp1 ); len += nsp1;
- strcpy( <ext[len], txt ); len += ntxt;
- strcpy( <ext[len], sp2 ); len += nsp2;
- strcpy( <ext[len], cnt ); len += ncnt;
- }
- }
- }
- set_variable( brobj, "summary", ltext );
- free( ltext );
- break; /* empty object name flags end of list */
- }
-
- if( kmobjects == NULL )
- kmobj = kmobjects = (KmObject*)malloc( sizeof(KmObject) );
- else
- kmobj = kmobj->next = (KmObject*)malloc( sizeof(KmObject) );
-
- kmobj->next = NULL;
- kmobj->name = oname;
- kmobj->stext = stext;
- kmobj->ltext = ltext;
-
- if( (kmobj->class = find_kmclass( cname )) == NULL ) {
- printf( " *** Invalid class name %s\n", cname );
- }
- else if( strcasecmp( kmobj->class->name, "DirUpFile" ) != 0 ) {
- kmobj->class->obj_count++; /* summary count */
- }
- free( cname );
- }
- return kmobjects;
-}
-
-
-/*
- * return the value of variable or NULL if name not found
- */
-char *get_variable( const char *brobj_name,
- const char *brvar_name )
-{
- BrObject *brobj = find_brobject( brobj_name );
- BrVariable *brvar = find_variable( brobj, brvar_name );
-
- if( brvar == NULL )
- return NULL;
- return brvar->value;
-}
-
-
-/*
- * return pointer to browsable class structure or NULL if name not found
- */
-static
-BrClass *find_brclass( const char *brcls_name )
-{
- BrClass *brcls;
-
- for( brcls = brclasses; brcls != NULL; brcls = brcls->next )
- if( strcasecmp( brcls->name, brcls_name ) == 0 )
- break;
- return brcls;
-}
-
-
-/*
- * return pointer to browsable object structure or NULL if name not found
- */
-BrObject *find_brobject( const char *brobj_name )
-{
- BrObject *brobj;
-
- for( brobj = brobjects; brobj != NULL; brobj = brobj->next )
- if( strcasecmp( brobj->name, brobj_name ) == 0 )
- break;
- return brobj;
-}
-
-
-/*
- * return pointer to object class structure or NULL if name not found
- */
-KmClass *find_kmclass( const char *kmcls_name )
-{
- KmClass *kmcls;
-
- for( kmcls = kmclasses; kmcls != NULL; kmcls = kmcls->next )
- if( strcasecmp( kmcls->name, kmcls_name ) == 0 )
- break;
- return kmcls;
-}
-
-
-/*
- * return pointer to object structure or NULL if name not found
- */
-static
-KmObject *find_kmobject( const char *kmobj_name )
-{
- KmObject *kmobj;
-
- for( kmobj = kmobjects; kmobj != NULL; kmobj = kmobj->next )
- if( strcasecmp( kmobj->name, kmobj_name ) == 0 )
- break;
- return kmobj;
-}
-
-
-/*
- * return pointer to variable structure or NULL if name not found
- */
-static
-BrVariable *find_variable( BrObject *brobj,
- const char *brvar_name )
-{
- BrVariable *brvar;
-
- for( brvar = brobj->vars; brvar != NULL; brvar = brvar->next )
- if( strcasecmp( brvar->name, brvar_name ) == 0 )
- break;
- return brvar;
-}
-
-
-/*
- * free the space allocated for a variable list
- */
-static
-void free_variables( BrVariable *brvar )
-{
- while( brvar != NULL ) {
- BrVariable *next = brvar->next;
- free( brvar->name );
- free( brvar->value );
- free( brvar );
- brvar = next;
- }
-}
-
-
-/*
- * set the variable name to value
- */
-void set_variable( BrObject *brobj,
- const char *brvar_name,
- const char *brvar_value )
-{
- BrVariable *brvar = find_variable( brobj, brvar_name );
-
- if( brvar == NULL ) {
- /* allocate a new variable */
- if( brobj->vars == NULL )
- brvar = brobj->vars = (BrVariable*)malloc( sizeof(BrVariable) );
- else {
- for( brvar = brobj->vars; brvar->next != NULL; brvar = brvar->next ) ;
- brvar = brvar->next = (BrVariable*)malloc( sizeof(BrVariable) );
- }
- brvar->next = NULL;
- brvar->name = strdup( brvar_name );
- }
- else if( brvar->value != NULL ) /* change value of existing variable */
- free( brvar->value );
-
- if( brvar_value == NULL )
- brvar->value = NULL;
- else
- brvar->value = strdup( brvar_value );
-}
-
-
-/*
- * decode blank separated variable settings "name1=value1 name2=value2 ..."
- * single quotes can be used to include blanks
- */
-static
-void decode_setting( BrObject *brobj,
- const char *brvar_set )
-{
- char *line = strdup( brvar_set ); /* make a local copy for strqtok() */
- char *p;
- char *name;
-
- for( name = strqtok( line ); name != NULL; name = strqtok( NULL ) ) {
- /* name points to the next "name=value" */
- char *value;
-
- name = strdup( name );
- if( (value = strchr( name, '=' )) != NULL ) {
- *value++ = '\0';
- /* name points to "name" and value points to "value" */
-
- if( *value == '\'' ) {
- /* remove quotes */
- if( (p = strrchr( ++value, '\'' )) != NULL )
- *p = '\0';
- }
- set_variable( brobj, name, value );
- }
- free( name );
- }
- free( line );
-}
diff --git a/src/packlib/kuip/code_kuip/kdialo.F b/src/packlib/kuip/code_kuip/kdialo.F
deleted file mode 100644
index 23b155e..0000000
--- a/src/packlib/kuip/code_kuip/kdialo.F
+++ /dev/null
@@ -1,45 +0,0 @@
-*
-* $Id: kdialo.F,v 1.1.1.1 1996/03/08 15:32:53 mclareni Exp $
-*
-* $Log: kdialo.F,v $
-* Revision 1.1.1.1 1996/03/08 15:32:53 mclareni
-* Kuip
-*
-*
-#include "kuip/pilot.h"
-#if defined(CERNLIB_IBMMVS)
-*CMZ : 1.61/01 22/06/89 17.34.26 by
-*-- Author :
- SUBROUTINE KDIALO ( PROMPT, CHREAD, NCHREA )
-
-*...KDIALO PROMPT/READ ROUTINE (DIALOG) 03/02/88
-*.
-*. CALLING SEQUENCE =
-*. CALL KDIALO ( PROMPT, CHREAD, NCHREA )
-*. PROMT CHARACTER STRING TO BE PRINTED (INPUT)
-*. CHREAD CHARACTER STRING TO BE READ (OUTPUT)
-*. NCHREA NUMBER OF CHARACTERS READ (OUTPUT)
-*.
-
- CHARACTER*(*) PROMPT, CHREAD
- LOGICAL INTRAC
-
- IF ( INTRAC(DUMMY) ) THEN
-*-- INTERACTIVE MODE
- NCHWRI = LENOCC ( PROMPT )
- MAXREA = 80
- CALL PUTGET ( PROMPT, NCHWRI, CHREAD, MAXREA, NCHREA )
- IF ( NCHREA .LT. 0 ) PRINT *, ' KDIALO ERROR: ', NCHREA
- ELSE
-*-- BATCH MODE
- PRINT *, PROMPT
- READ 8000, CHREAD
- 8000 FORMAT ( A80 )
- PRINT *, CHREAD
- NCHREA = LENOCC ( CHREAD )
- ENDIF
-
- RETURN
- END
-
-#endif
diff --git a/src/packlib/kuip/code_kuip/kedit.c b/src/packlib/kuip/code_kuip/kedit.c
deleted file mode 100644
index 5286dc5..0000000
--- a/src/packlib/kuip/code_kuip/kedit.c
+++ /dev/null
@@ -1,1185 +0,0 @@
-/*
- * $Id: kedit.c,v 1.3 2005/04/18 15:23:10 mclareni Exp $
- *
- * $Log: kedit.c,v $
- * Revision 1.3 2005/04/18 15:23:10 mclareni
- * Mods submitted by Kevin B. McCarty to fix insecure Cernlib uses of /tmp.
- *
- * Revision 1.2 1997/03/17 16:54:57 mclareni
- * WNT mods
- *
- * Revision 1.1.1.1.2.1 1997/01/21 11:32:45 mclareni
- * All mods for Winnt 96a on winnt branch
- *
- * Revision 1.1.1.1 1996/03/08 15:32:55 mclareni
- * Kuip
- *
- */
-/*CMZ : 2.05/17 19/08/94 12.53.04 by Alfred Nathaniel*/
-/*-- Author : Alfred Nathaniel 06/11/92*/
-/* kedit.c: file editing */
-
-#include "kuip/kuip.h"
-#include "kuip/kfor.h"
-#include "kuip/klink.h"
-#include "kuip/kmenu.h"
-#include "kuip/kflag.h"
-
-static char *editor_cmd = NULL; /* command which envoked edit server */
-static char *editor_file = NULL; /* file which was edited */
-static char editor_tmp[22]; /* file to use as a lock file */
-
-
-/*
- * set the user routine called when edit server exits
- */
-void F77_ENTRY_E(Kueusr,fun)
-/* { */
- kjmpaddr.user_edit_F = fun;
-}
-
-
-/*
- * test if executable exists
- */
-LOGICAL F77_ENTRY_C(Kuqexe,chname)
-/* { */
- char *name = fstrdup( chname, len_chname );
- int exists = (ku_qexe( name ) != NULL);
- free( name );
- return ku_true( exists );
-}
-
-
-char *ku_qexe( const char *name )
-{
- char *path;
- char *dirpath;
-
-#ifdef IBMVM
- dirpath = NULL;
- path = fsearch( name, "MODULE", "*" );
-#define _done_
-#endif
-
-#ifdef UNIX
- dirpath = str0dup( getenv( "PATH" ) );
-# if defined(MSDOS) || defined(CERNLIB_WINNT)
- path = fsearch( name, "EXE", dirpath );
-# else
- path = fsearch( name, NULL, dirpath );
-# endif
-#define _done_
-#endif
-
-#ifdef vms
- dirpath = str0dup( getenv( "KUIPPATH" ) );
- path = fsearch( name, "EXE", dirpath );
-#define _done_
-#endif
-
-#ifdef _done_
-#undef _done_
-#else
- dirpath = NULL;
- path = NULL;
-#endif
-
- if( dirpath != NULL )
- free( dirpath );
-
- return path;
-}
-
-
-/*
- * return flag whether edit server will be used
- */
-LOGICAL F77_ENTRY(Kuqsvr)
-/* { */
- return ku_true( kc_flags.use_server );
-}
-
-
-/*
- * envoke editor on file
- */
-
-void F77_ENTRY_CI(Kuedit,chfile,status)
-/* { */
- char *file = fstrdup( chfile, len_chfile );
-
- *status = ku_edit( file, 0 );
- free( file );
-}
-
-
-/*
- * edit file using the server if possible
- */
-void F77_ENTRY_CI(Kuesvr,chfile,status)
-/* { */
- if( kc_flags.use_server ) {
- char *file = fstrdup( chfile, len_chfile );
- *status = ku_edit( file, 1 );
- if( *status == 1 )
- *status = 0;
- free( file );
- }
- else
- *status = 1;
-}
-
-
-#ifdef vms
-/*
- * call if a nowait spawned editor terminates
- */
-static
-void edit_server_ast( cmd_line )
- char *cmd_line;
-{
- if( kc_flags.editor_cbuf == NULL ) {
- kc_flags.editor_cbuf = mstrcat( cmd_line, "\n" );
- }
- else {
- kc_flags.editor_cbuf = mstr2cat( kc_flags.editor_cbuf, cmd_line, "\n" );
- free( cmd_line ); /* allocated in ku_edit */
- }
-
- kc_flags.editor_exit = 1;
-}
-#endif
-
-
-/*
- * edit a file
- * returns 0 if edit successful
- * returns 1 if file unchanged or sent to edit server
- * returns 2 on error
- */
-int ku_edit( const char *file,
- int use_server )
-{
- char *path = ku_home( file, "kumac" );
- int status = 2;
- char *line;
- char *p;
-
- if( use_server && kc_flags.use_server ) {
-#if defined(UNIX) && !defined(CERNLIB_WINNT)
- int fid;
-
- /* Try to securely create the temporary file for the edit server.
- * Has to be done in the parent process because the server has no
- * way of passing back the name of a created temp file. */
- strcpy( editor_tmp, "/usr/tmp/kuesvrXXXXXX" );
- fid = mkstemp( editor_tmp );
- if (fid == -1) {
- strcpy( editor_tmp, "/tmp/kuesvrXXXXXX" );
- fid = mkstemp( editor_tmp );
- if (fid == -1) {
- perror( "mkstemp" );
- return status;
- }
- }
- close( fid );
-
- line = strdup( "kuesvr -p " );
- line = mstricat( line, getpid() );
- line = mstr2cat( line, " -t ", editor_tmp );
- line = mstr4cat( line, " -c ", ku_path(), " -e '",
- kc_value.set_host_editor );
- if( (p = strrchr( line, '&' )) != NULL )
- *p = ' '; /* remove & from editor command */
- line = mstr3cat( line, "' ", path, " &" );
- if( shsystem( kc_value.set_host_shell, line ) == 0 )
- status = 1;
- free( line );
-#endif /* UNIX */
-
-#ifdef vms
- unsigned int flags = CLI$M_NOWAIT;
- int istat;
- char *cmd_string = str4dup( "$ ", kc_value.set_host_editor, " ", path );
- struct dsc$descriptor_s cmd_dsc;
- var_descriptor( cmd_dsc, cmd_string );
-
- line = str3dup( path, " ", ku_path() ); /* free'd in edit_server_ast */
-
- if( kc_flags.in_motif ) {
- /*
- * In Motif mode we cannot spawn the "CREATE/TERM/WAIT EDIT file" command
- * directly because SYS$INPUT will be assigned to the mailbox.
- * Instead we have to envoke a command script which, for the first
- * command has still assigned the mailbox, but then gets SYS$INPUT
- * assigned to the real terminal window ??????????????????????????
- */
- FILE *script = fopen( "sys$login:kuipedit.com", "w" );
- char fname[256];
- fgetname( script, fname );
- fprintf( script, "$ show logical sys$input\n" );
- fprintf( script, "%s\n", cmd_string );
- fprintf( script, "$ delete %s\n", fname );
- fclose( script );
- free( cmd_string );
- cmd_string = str2dup( "$ @", fname );
- var_descriptor( cmd_dsc, cmd_string );
- }
-
- istat = lib$spawn( &cmd_dsc, NULL, NULL, &flags,
- NULL, /* process name */
- NULL, /* process id */
- NULL, /* completion status */
- NULL, /* completion efn */
- edit_server_ast,
- line );
- if( istat == SS$_NORMAL )
- status = 1;
-
- free( cmd_string );
-#endif /* vms */
- }
- else {
- KmTimeStamp stamp1;
- KmTimeStamp stamp2;
-
-#ifdef APOLLO
- if( strcasecmp( kc_value.set_host_editor, "DM" ) == 0 ) {
- pad_$window_desc_t edit_pad;
- stream_$id_t stream;
- status_$t istat;
- int writable = 1;
-
- edit_pad.top = kc_window.edit_pad.top;
- edit_pad.left = kc_window.edit_pad.left;
- edit_pad.width = kc_window.edit_pad.width;
- edit_pad.height = kc_window.edit_pad.height;
-
- pad_$create_window( path, strlen( path ), pad_$edit, 1,
- edit_pad, &stream, &istat );
- if( istat.all == ios_$insufficient_rights ) {
- pad_$create_window( path, strlen( path ), pad_$read_edit, 1,
- edit_pad, &stream, &istat );
- writable = 0;
- }
- if( istat.all == status_$ok ) {
- if( writable )
- pad_$edit_wait( stream, &istat );
- if( istat.all == status_$ok ) {
- status = 0;
- }
- else if( istat.all == pad_$edit_quit ) {
- status = 1;
- }
- else {
- error_$print( istat );
- }
- stream_$close( stream, &istat );
- }
- if( istat.all != status_$ok ) {
- status = 2;
- error_$print( istat );
- }
- free( path );
- return status;
- }
-#endif /* APOLLO */
-
-#ifdef vms
- int istat;
- char *cmd_string;
- struct dsc$descriptor_s cmd_dsc;
-
- if( strncasecmp( kc_value.set_host_editor, "EDT", 3 ) == 0
- || strncasecmp( kc_value.set_host_editor, "TPU", 3 ) == 0 ) {
- /* invoke the callable EDT or TPU */
-
- /* these functions are not prototyped in any system include file ? */
- extern int EDT$EDIT( struct dsc$descriptor_s* );
- extern int TPU$TPU( struct dsc$descriptor_s* );
-
- get_stamp( path, &stamp1 );
- if( strcasecmp( kc_value.set_host_editor, "EDT" ) == 0 ) {
- var_descriptor( cmd_dsc, path );
- istat = EDT$EDIT( &cmd_dsc );
- }
- else {
- cmd_string = str3dup( kc_value.set_host_editor, " ", path );
- var_descriptor( cmd_dsc, cmd_string );
- istat = TPU$TPU( &cmd_dsc );
- free( cmd_string );
- }
- get_stamp( path, &stamp2 );
- status = same_stamp( &stamp1, &stamp2 );
- free( path );
- return status;
- }
-#endif /* vms */
-
-#ifdef IBMMVS
- INTEGER istat = 0;
- strupper( path );
- F77_CALL_Cx(Kmvsed,path,strlen(path),&istat);
- status = istat;
-#else /* IBMMVS */
-
-
- get_stamp( path, &stamp1 );
-
-# ifdef IBMVM
-
- line = str2dup( "/KUIP/SHELL '", kc_value.set_host_editor );
- if( (p = strchr( line, '(' )) != NULL )
- *p = '\0'; /* remove "( xedit-options" */
- line = mstr2cat( line, " ", path );
- while( (p = strchr( line, '.' )) != NULL )
- *p = ' '; /* change "fn.ft.fm" to "fn ft fm" */
- if( (p = strchr( kc_value.set_host_editor, '(' )) != NULL )
- line = mstr2cat( line, " ", p ); /* append "( xedit-options" */
- line = mstrcat( line, "'" );
-
-# else /* IBMVM */
-
- line = str5dup( "/KUIP/SHELL '", kc_value.set_host_editor, " ",
- path, "'" );
- if( (p = strchr( line, '&' )) != NULL )
- *p = ' '; /* remove & from Unix editor command */
-
-# endif /* IBMVM */
-
- status = ku_exel( line );
-
-# if defined(UNIX) && !defined(CERNLIB_WINNT)
- /* "emacs -nw" sometime returns a non-zero exit code ?!? */
- if( status == 130
- && strstr( kc_value.set_host_editor, "emacs" ) != NULL
- && strstr( kc_value.set_host_editor, "-nw" ) != NULL ) {
- printf( " *** Bogus non-zero exit code ignored\n" );
- status = 0;
- }
-# endif /* UNIX */
-
- if( status == 0 ) {
-
- get_stamp( path, &stamp2 );
- status = same_stamp( &stamp1, &stamp2 );
-
- }
- else {
- status = 2;
- }
- free( line );
-#endif /* IBMMVS */
- }
- free( path );
- return status;
-}
-
-
-void ku_shut()
-{
-#ifdef USE_EDIT_SERVER
- if( kc_flags.use_server )
- remove( editor_tmp );
-#endif
-}
-
-
-void F77_ENTRY_C(Kupad,chfile)
-/* { */
- char *file = fstrdup( chfile, len_chfile );
- ku_pad( file, 0 );
- free( file );
-}
-
-
-void ku_pad( const char *fname,
- int is_temp ) /* flag if file should be removed afterwards */
-{
- char *file = strdup( fname );
- char *cmd;
-#ifdef IBMVM
- char *profile = "KUHELP.XEDIT.A";
- FILE *stream = fopen( profile, "w" );
-#endif
-#ifdef IBMMVS
- INTEGER iluno = is_temp ? kc_flags.uhlp_luno : 0;
-#endif
- char *p;
-
- ku_fcase( file );
-
-#ifdef APOLLO
- if( strcasecmp( kc_value.set_host_pager, "DM" ) == 0 ) {
- pad_$window_desc_t help_pad;
- stream_$id_t stream;
- status_$t istat;
- short fontw;
- short fonth;
- short fnlen;
- FILE *input = fopen( file, "r" );
- char line[1024];
- int height = 0;
-
- if( input == NULL ) {
- printf( " *** File %s not found\n", file );
- return;
- }
-
- pad_$inq_font( stream_$stdout, &fontw, &fonth, NULL, 0, &fnlen, &istat );
- if( istat.all != status_$ok )
- fonth = 15;
-
- while( fgets( line, (sizeof line), input ) != NULL )
- height += fonth; /* count number of lines in file */
- fclose( input );
-
- if( kc_window.help_pad.top + height > 980 )
- kc_window.help_pad.height = 980 - kc_window.help_pad.top;
- else
- kc_window.help_pad.height = height;
-
- if( kc_window.help_pad.left + kc_window.help_pad.width > 1280 )
- kc_window.help_pad.width = 1280 - kc_window.help_pad.left;
-
- help_pad.top = kc_window.help_pad.top;
- help_pad.left = kc_window.help_pad.left;
- help_pad.width = kc_window.help_pad.width;
- help_pad.height = kc_window.help_pad.height;
-
- pad_$create_window( file, strlen(file), pad_$read_edit, 1,
- help_pad, &stream, &istat );
- if( istat.all != status_$ok ) {
- error_$print( istat );
- return;
- }
- if( (kc_flags.style & KmSTYLE_G) != 0 )
- pad_$edit_wait( stream, &istat );
- stream_$close( stream, &istat );
-
- if( kc_window.shift_max > 1 ) {
- kc_window.help_pad.top += kc_window.voffset * kc_window.shift_dir;
- kc_window.help_pad.left += kc_window.hoffset * kc_window.shift_dir;
- kc_window.shift_now += kc_window.shift_dir;
- if( kc_window.shift_now < 1
- || kc_window.shift_now >= kc_window.shift_max ) {
- kc_window.shift_dir = -kc_window.shift_dir;
- kc_window.shift_now += kc_window.shift_dir;
- }
- }
- return;
- }
-#endif
-
-#ifdef UNIX
-# if defined(MSDOS) || defined(CERNLIB_WINNT)
- if( strcmp( kc_value.set_host_pager, "more" ) == 0 )
- cmd = str3dup( "type ", file, " | more" );
- else
- cmd = str3dup( kc_value.set_host_pager, " ", file );
- text_mode__();
- system( cmd );
- free( cmd );
- if( is_temp )
- remove( file );
-# else
- cmd = str4dup( "(", kc_value.set_host_pager, " ", file );
- if( is_temp )
- cmd = mstr4cat( cmd, "; /bin/cp /dev/null ", file, "; /bin/rm ", file );
- cmd = mstrcat( cmd, ")" );
- if( (p = strchr( cmd, '&' )) != NULL ) {
- /* move ampersand to the end */
- *p = ' ';
- cmd = mstrcat( cmd, " &" );
- }
- shsystem( kc_value.set_host_shell, cmd );
- free( cmd );
-# endif
-#endif
-
-#ifdef vms
- cmd = str3dup( kc_value.set_host_pager, " ", file );
- system( cmd );
- free( cmd );
- if( is_temp )
- remove( file );
-#endif
-
-#ifdef IBMVM
- if( stream == NULL ) {
- printf( " *** Cannot open %s\n", profile );
- return;
- }
- fprintf( stream, "\
-SET PREFIX OFF\n\
-SET SCALE ON 2\n\
-SET VERIFY ON 1 *\n\
-SET CURLINE ON 3\n" );
- fclose( stream );
- /* NOLOCK needed for SFS */
- cmd = str3dup( "XEDIT ", file, " ( NOLOCK PROF KUHELP" );
- while( (p = strchr( cmd, '.' )) != NULL )
- *p = ' ';
- system( cmd );
- free( cmd );
- remove( profile );
-#endif
-
-#ifdef IBMMVS
- F77_CALL_Cx(Kmvspg,file,strlen(file),&iluno);
- if( is_temp )
- remove( file );
-#endif
-
- free( file );
-}
-
-
-/*
- * return file and command name to the user edit routine
- */
-void F77_ENTRY_CC(Ksvpar,file,cmd)
-/* { */
- fstrset( file, len_file, editor_file );
- fstrset( cmd, len_cmd, editor_cmd );
-}
-
-
-/*
- * scan the description file written by the edit server
- */
-void check_edit_server()
-{
-#ifdef USE_EDIT_SERVER
-
- if( kjmpaddr.user_edit_F != NULL && kc_flags.editor_exit != 0 ) {
- char *lock_file = editor_tmp;
- int fid;
- int len;
- int nbytes;
- char *s;
-
- kc_flags.editor_exit = 0;
-
-#ifdef UNIX
-
- /* /tmp cannot be locked on Sun if allocated on swap space */
- fid = open( lock_file, O_RDONLY );
- if( fid == -1 ) {
- perror( "kugsvr: open tempfile read-only" );
- return;
- }
- else {
- close( fid );
- fid = open( lock_file, O_RDWR );
- if( fid == -1 ) {
- perror( "kugsvr: open tempfile read-write" );
- return;
- }
- }
-
- /* lock the file */
- if( lockf( fid, F_LOCK, (off_t)0 ) == -1) {
- perror( "kugsvr: lock file" );
- close( fid );
- return;
- }
-
- /* read the complete file */
- kc_flags.editor_cbuf = malloc( BUFSIZ + 1 );
- kc_flags.editor_cbuf[0] = '\0';
- len = 0;
- while( (nbytes = read( fid, &kc_flags.editor_cbuf[len], BUFSIZ )) > 0 ) {
- /* null terminate the string at the end of the bytes read */
- len += nbytes;
- kc_flags.editor_cbuf[len] = '\0';
- kc_flags.editor_cbuf = realloc( kc_flags.editor_cbuf,
- strlen( kc_flags.editor_cbuf ) + BUFSIZ + 1 );
- }
-
- if( ftruncate( fid, (off_t)0 ) == -1 )
- perror( "kugsvr: ftruncate" );
-
- if( lockf( fid, F_ULOCK, (off_t)0 ) == -1)
- perror("kugsvr: un-lockf");
-
- close(fid);
-
-#endif
-
- /*
- * For VMS the buffer is filled in edit_server_ast()
- */
-
- s = kc_flags.editor_cbuf;
- while( *s != '\0' ) {
- editor_file = s;
- s = strchr( s, ' ' );
- if( s == NULL )
- break;
- *s++ = '\0';
-
- editor_cmd = s;
- s = strchr( s, '\n' );
- if( s == NULL )
- break;
- *s++ = '\0';
-
- if( strcmp( editor_cmd, "/KUIP/EDIT" ) != 0 ) {
- /* call user routine for all non-standard edit commands */
- (*kjmpaddr.user_edit_F)();
- }
- }
- free( kc_flags.editor_cbuf );
- kc_flags.editor_cbuf = NULL;
- editor_file = NULL;
- editor_cmd = NULL;
- }
-#endif /* USE_EDIT_SERVER */
-}
-
-
-/*
- * action routine for /KUIP/SET_SHOW/HOST_EDITOR
- */
-int kxhosteditor()
-{
- char *editor = ku_gets();
-
- if( strcmp( editor, "?" ) == 0 ) {
- printf( " Current host editor is '%s'\n", kc_value.set_host_editor );
- }
- else if( strcasecmp( editor, "WINDOW" ) == 0 ) {
- kc_window.edit_pad.top = ku_geti();
- kc_window.edit_pad.left = ku_geti();
- kc_window.edit_pad.width = ku_geti();
- kc_window.edit_pad.height = ku_geti();
- }
- else if( strcasecmp( editor, "PAD" ) == 0 ) {
- kc_window.help_pad.top = ku_geti();
- kc_window.help_pad.left = ku_geti();
- kc_window.help_pad.width = ku_geti();
- kc_window.help_pad.height = ku_geti();
- kc_window.hoffset = ku_geti();
- kc_window.voffset = ku_geti();
- kc_window.shift_max = ku_geti();
- kc_window.shift_now = 1;
- kc_window.shift_dir = 1;
- }
- else {
- if( kc_value.set_host_editor != NULL )
- free( kc_value.set_host_editor );
- kc_value.set_host_editor = strdup( editor );
-
- kc_flags.use_server = 0;
-#ifdef USE_EDIT_SERVER
-
-# ifdef UNIX
- if( strchr( kc_value.set_host_editor, '&' ) != NULL ) {
- /* must be a workstation and kuesvr in search path to use server */
- kc_flags.use_server =
- (getenv( "DISPLAY" ) != NULL) && (ku_qexe( "kuesvr" ) != NULL);
-
- /* vi must be wrapped into xterm */
- if( kc_flags.use_server
- && ( strncmp( kc_value.set_host_editor, "vi ", 3 ) == 0
- || strcmp( kc_value.set_host_editor, "vi&" ) == 0 ) ) {
- char *p = kc_value.set_host_editor;
- kc_value.set_host_editor = str2dup( "xterm -e ", p );
- free( p );
- }
- }
-# endif
-
-# ifdef vms
- strupper( kc_value.set_host_editor );
-
- if( kc_flags.in_motif ) {
- /*
- * We have to spawn a nowait process because otherwise we get stuck
- * when pressing the right mouse button.
- * Instead of the callable TPU we have to use the EDIT/TPU command
- * and create a terminal window if not using the TPU Motif driver.
- */
-
- if( strncmp( kc_value.set_host_editor, "EDT", 3 ) == 0
- || strncmp( kc_value.set_host_editor, "TPU", 3 ) == 0 ) {
-
- char *p = kc_value.set_host_editor;
- kc_value.set_host_editor = str2dup( "EDIT/", p );
- free( p );
-
- if( strstr( kc_value.set_host_editor, "=DECW" ) == NULL
- && strstr( kc_value.set_host_editor, "=MOTIF" ) == NULL ) {
-
- p = kc_value.set_host_editor;
- kc_value.set_host_editor = str2dup( "CREATE/TERM/WAIT ", p );
- free( p );
- }
- }
- }
-
- if( strncmp( kc_value.set_host_editor, "CRE", 3 ) == 0
- || strstr( kc_value.set_host_editor, "=DECW" ) != NULL
- || strstr( kc_value.set_host_editor, "=MOTIF" ) != NULL ) {
-
- kc_flags.use_server = 1;
- }
-# endif
-
-#endif
-
-#ifdef DBMALLOC
- malloc_mark( kc_value.set_host_editor );
-#endif
- }
- return 0;
-}
-
-
-/*
- * action routine for /KUIP/SET_SHOW/HOST_PSVIEWER
- */
-int kxhostpsviewer()
-{
- char *psviewer = ku_gets();
-
- if( strcmp( psviewer, "?" ) == 0 ) {
- printf( " Current PostScript Viewer is '%s'\n",
- kc_value.set_host_psviewer );
- }
- else {
- if( kc_value.set_host_psviewer != NULL )
- free( kc_value.set_host_psviewer );
- kc_value.set_host_psviewer = strdup( psviewer );
-
-#ifdef DBMALLOC
- malloc_mark( kc_value.set_host_psviewer );
-#endif
- }
- return 0;
-}
-
-
-/*
- * action routine for /KUIP/SET_SHOW/HOST_PAGER
- */
-int kxhostpager()
-{
- char *pager = ku_gets();
-
- if( strcmp( pager, "?" ) == 0 ) {
- printf( " Current host pager is '%s'\n", kc_value.set_host_pager );
- }
- else {
- if( kc_value.set_host_pager != NULL )
- free( kc_value.set_host_pager );
- kc_value.set_host_pager = strdup( pager );
-
-#ifdef DBMALLOC
- malloc_mark( kc_value.set_host_pager );
-#endif
- }
- return 0;
-}
-
-
-/*
- * action routine for /KUIP/SET_SHOW/HOST_PRINTER
- */
-int kxhostprinter()
-{
- char *cmd = ku_gets();
- char *ext = ku_gets();
-
- if( strcmp( cmd, "?" ) == 0 ) {
- if( kc_value.set_print_cmds == NULL ) {
- printf( " No host printer command defined.\n" );
- }
- else {
- int i;
- printf( " Filetype | Host printer command\n" );
- printf( " ---------|---------------------\n" );
- for( i = 0; kc_value.set_print_cmds[i] != NULL; i++ ) {
- printf( " %-9s| %s\n",
- kc_value.set_print_exts[i], kc_value.set_print_cmds[i] );
- }
- }
- }
- else if( cmd[0] == '\0' ) {
- /* delete command */
- if( kc_value.set_print_cmds != NULL ) {
- int i;
- for( i = 0; kc_value.set_print_cmds[i] != NULL; i++ ) {
- if( strcmp( kc_value.set_print_exts[i], ext ) == 0 ) {
- free( kc_value.set_print_cmds[i] );
- free( kc_value.set_print_exts[i] );
- do {
- kc_value.set_print_cmds[i] = kc_value.set_print_cmds[i+1];
- kc_value.set_print_exts[i] = kc_value.set_print_exts[i+1];
- } while( kc_value.set_print_cmds[++i] != NULL );
- break;
- }
- }
- }
- }
- else {
- int i;
-
- cmd = strdup( cmd );
- if( strstr( cmd, "$*" ) == NULL && strstr( cmd, "$-" ) == NULL )
- cmd = mstrcat( cmd, " $*" );
-
- if( kc_value.set_print_cmds == NULL ) {
- kc_value.set_print_cmds = (char**)malloc( 2 * sizeof(char*) );
- kc_value.set_print_cmds[0] = cmd;
- kc_value.set_print_cmds[1] = NULL;
- kc_value.set_print_exts = (char**)malloc( 2 * sizeof(char*) );
- kc_value.set_print_exts[0] = strdup( ext );
- kc_value.set_print_exts[1] = NULL;
-
-#ifdef DBMALLOC
- malloc_mark( kc_value.set_print_cmds );
- malloc_mark( kc_value.set_print_cmds[0] );
- malloc_mark( kc_value.set_print_exts );
- malloc_mark( kc_value.set_print_exts[0] );
-#endif
- return 0;
- }
-
- for( i = 0; kc_value.set_print_cmds[i] != NULL; i++ ) {
- if( strcasecmp( kc_value.set_print_exts[i], ext ) == 0 ) {
- free( kc_value.set_print_cmds[i] );
- kc_value.set_print_cmds[i] = cmd;
-
-#ifdef DBMALLOC
- malloc_mark( kc_value.set_print_cmds[i] );
-#endif
- return 0;
- }
- }
- kc_value.set_print_cmds = (char**)realloc( (char*)kc_value.set_print_cmds,
- (i+2) * sizeof(char*) );
- kc_value.set_print_exts = (char**)realloc( (char*)kc_value.set_print_exts,
- (i+2) * sizeof(char*) );
- kc_value.set_print_cmds[i+1] = NULL;
- kc_value.set_print_exts[i+1] = NULL;
-
- while( i > 0 && strlen( kc_value.set_print_exts[i-1] ) < strlen( ext ) ) {
- kc_value.set_print_cmds[i] = kc_value.set_print_cmds[i-1];
- kc_value.set_print_exts[i] = kc_value.set_print_exts[i-1];
- i--;
- }
- kc_value.set_print_cmds[i] = cmd;
- kc_value.set_print_exts[i] = strdup( ext );
-
-#ifdef DBMALLOC
- malloc_mark( kc_value.set_print_cmds );
- malloc_mark( kc_value.set_print_cmds[i] );
- malloc_mark( kc_value.set_print_exts );
- malloc_mark( kc_value.set_print_exts[i] );
-#endif
- }
- return 0;
-}
-
-
-/*
- * action routine for /KUIP/PRINT
- */
-int kxprint()
-{
- if( kc_value.set_print_cmds != NULL ) {
- char *file = ku_gets();
- char *file_end = file + strlen( file );
- FILE *stream = fopen( file, "r" );
- int i;
-
-#ifdef IBMVM
- char *p;
- if( strchr( file, '.' ) != (p = strrchr( file, '.' )) && p != NULL )
- file_end = p;
-#endif
-
-#ifdef vms
- char *p;
- if( (p = strchr( file, ';' )) != NULL )
- file_end = p;
-#endif
-
- if( stream == NULL ) {
- printf( " *** KUIP/PRINT: file %s not found\n", file );
- return -1;
- }
- else
- fclose( stream );
-
- for( i = 0; kc_value.set_print_cmds[i] != NULL; i++ ) {
- int n = strlen( kc_value.set_print_exts[i] );
- if( strncasecmp( file_end - n, kc_value.set_print_exts[i], n ) == 0 ) {
- char *cmd = str3dup( "/KUIP/SHELL '",
- kc_value.set_print_cmds[i], "'" );
- char *p;
- while( (p = strstr( cmd, "$*" )) != NULL ) {
- char *newcmd = strndup( cmd, p - cmd );
- newcmd = mstr2cat( newcmd, file, p + 2 );
- free( cmd );
- cmd = newcmd;
- }
- while( (p = strstr( cmd, "$-" )) != NULL ) {
- char *newcmd = strndup( cmd, p - cmd );
- newcmd = mstrncat( newcmd, file, file_end - file - n );
- newcmd = mstrcat( newcmd, p + 2 );
- free( cmd );
- cmd = newcmd;
- }
-#ifdef IBMVM
- while( (p = strchr( cmd, '.' )) != NULL )
- *p = ' ';
-#endif
- ku_exel( cmd );
- free( cmd );
- return 0;
- }
- }
- }
- printf( " *** KUIP/PRINT: no host printer command defined\n" );
- return -1;
-}
-
-
-/*
- * action routine for /KUIP/EDIT
- */
-int kxedit()
-{
- char *file = ku_getf();
- char *path = fsearch( file, NULL, NULL );
-
- if( path == NULL )
- path = fsearch( file, "kumac", kc_flags.macro_path );
-
- if( path == NULL ) {
- /* file not found in search path */
-
- path = ku_home( file, "kumac" );
-
- if( kc_flags.macro_path != NULL ) {
- /* if file spec does'nt contain directory use first in search path */
- char *default_dir = strdup( kc_flags.macro_path );
- char *p;
- if( (p = strchr( default_dir, ',' )) != NULL )
- *p = '\0';
-
-#ifdef IBMVM
- if( strchr( path, '.' ) == strrchr( path, '.' ) ) {
- path = mstr2cat( path, ".", default_dir );
- }
-#endif
-
-#ifdef vms
- if( strchr( path, ':' ) == NULL && strchr( path, ']' ) == NULL ) {
- p = str2dup( default_dir, path );
- free( path );
- path = p;
- }
-#endif
-
-#ifdef UNIX
- if( strpbrk( path, SLASHES ) == NULL ) {
- p = strdup( default_dir );
- if( strchr( SLASHES, p[strlen(p)-1] ) == NULL )
- p = mstrccat( p, SLASHES[0], 1 );
- p = mstrcat( p, path );
- free( path );
- path = p;
- }
-#endif
-
- free( default_dir );
- }
-
- ku_edit( path, 1 );
- free( path );
- }
- else {
- ku_edit( path, 1 );
- }
-
- return 0;
-}
-
-
-/*
- * action routine for /KUIP/SET_SHOW/COLUMNS
- */
-int kxcolumns()
-{
- int width = ku_geti();
-
- if( width < 0 ) {
- char *columns = getenv( "COLUMNS" );
- if( columns != NULL && isdigit( columns[0] ) )
- width = atoi( columns );
- else
- width = 80;
- }
-
- if( width == 0 )
- printf( " Current number of columns: %d\n", kc_window.term_width );
- else {
- if( width < 40 ) {
- printf( " *** COLUMNS: minimum screen width is 40\n" );
- width = 80;
- }
- sprintf( kc_value.set_columns, "%d", width );
- kc_window.term_width = width;
-#ifndef IBM370
- gl_setwidth( width );
-#endif
- }
- return 0;
-}
-
-
-/*
- * action routine for /KUIP/MACRO/LIST
- */
-int kxmlist()
-{
- char *mname = ku_getf();
- char *dpath = kc_flags.macro_path;
- char *dir;
-
- if( dpath == NULL ) {
- dpath = ".";
-#ifdef IBMVM
- dpath = "a";
-#endif
-#ifdef vms
- dpath = "[]";
-#endif
- }
- dpath = strdup( dpath );
-
- for( dir = strtok( dpath, "," ); dir != NULL; dir = strtok( NULL, "," ) ) {
-
-#ifdef IBMVM
- char *line = str5dup( "LFILE ", mname, "* KUMAC ", dir, " (DATE" );
- system( line );
- free( line );
-#endif
-
-#ifdef UNIX
-# ifdef MSDOS
-# ifdef WINNT
- char *kumac = "*.kumac";
-# else
- char *kumac = "*.kum";
-# endif
- char *line = str2dup( "dir ", dir );
- if( dir[0] != '\0' && dir[strlen(dir)-1] != '\\' )
- line = mstrcat( line, "\\" );
- line = mstr3cat( line, mname, kumac, " | more" );
- text_mode__();
- system( line );
-# else
- char *line = str2dup( "ls -l ", dir );
- if( dir[0] != '\0' && dir[strlen(dir)-1] != '/' )
- line = mstrcat( line, "/" );
- line = mstr2cat( line, mname, "*.kumac" );
- shsystem( kc_value.set_host_shell, line );
-# endif
- free( line );
-#endif
-
-#ifdef vms
- char *fspec_string = str3dup( dir, mname, "*.kumac" );
- struct dsc$descriptor_s fspec_dsc;
- struct dsc$descriptor_d match_dsc;
- int context = 0;
- int istat;
-
- var_descriptor( fspec_dsc, fspec_string );
-
- match_dsc.dsc$b_dtype = DSC$K_DTYPE_T;
- match_dsc.dsc$b_class = DSC$K_CLASS_D;
- match_dsc.dsc$w_length = 0;
- match_dsc.dsc$a_pointer = NULL;
-
- while( 1 ) {
- istat = lib$find_file( &fspec_dsc, &match_dsc, &context );
- if( istat != RMS$_NORMAL ) {
- break;
- }
- else {
- char *mpath = strndup( match_dsc.dsc$a_pointer,
- match_dsc.dsc$w_length );
- printf( " %s\n", mpath );
- free( mpath );
- }
- }
- lib$find_file_end( &context );
- free( fspec_string );
-#endif
-
- }
- free( dpath );
-
- return 0;
-}
-
-
-
-/*
- * action routine for /KUIP/PSVIEW
- */
-int kxpsview()
-{
- char *file = ku_getf();
- char *path = fsearch( file, NULL, NULL );
- int status = 0;
-
- if( path == NULL )
- path = fsearch( file, "ps", NULL );
-
- if( path != NULL ) {
- /* file is found */
-
-#ifdef vms
- int istat;
- unsigned int flags = CLI$M_NOWAIT;
- char *line = str4dup( "$ ",kc_value.set_host_psviewer, " ", path );
- struct dsc$descriptor_s cmd_dsc;
-
- var_descriptor( cmd_dsc, line );
- istat = lib$spawn( &cmd_dsc, NULL, NULL, &flags );
- free( line );
-
-#else
-# ifdef UNIX
-
- char *line = str4dup( kc_value.set_host_psviewer, " ", path, " &" );
- shsystem( kc_value.set_host_shell, line );
- free( line );
-
-# else
-
- printf( " *** PSVIEW not implemented\n" );
- status = -1;
-
-# endif
-
-#endif
-
- free( path );
- }
- else {
- printf( " *** PSVIEW: file %s not found\n", file );
- status = -1;
- }
- return status;
-}
-
-
diff --git a/src/packlib/kuip/code_kuip/kexec.c b/src/packlib/kuip/code_kuip/kexec.c
deleted file mode 100644
index 9ddd825..0000000
--- a/src/packlib/kuip/code_kuip/kexec.c
+++ /dev/null
@@ -1,2196 +0,0 @@
-/*
- * $Id: kexec.c,v 1.6 1998/12/17 14:20:00 couet Exp $
- *
- * $Log: kexec.c,v $
- * Revision 1.6 1998/12/17 14:20:00 couet
- * - new routine to delete the temporary vectors created
- * by $SIGMA. On NT a direct call to kuvdel didn't work
- *
- * Revision 1.5 1997/03/24 11:10:18 gunter
- * Mods for WinNT; Apply F77_ENTRY to several Ku... routines; this
- * was missing from Kutime, Kutim0, Kustat, Kugeti, Kugetr and Kunpar.
- *
- * Revision 1.4 1997/03/11 09:43:40 cremel
- * Bug correction in command WAIT (after answering "Q" to a "WAIT" statement,
- * the ability to issue several HISTOGRAM/PLOT statements on a single line,
- * separated by semicolons, disappears).
- * kexec.c : add a test on the variable "kc_flags.in_macro".
- * kuvers.c : increase version number to 2.07/13
- *
- * Revision 1.3 1996/05/01 12:08:36 gunter
- * Replace several strcpy by memmove
- *
- * Revision 1.2 1996/04/11 09:41:52 cernlib
- * Protect for an empty string in fill_arg_list
- *
- * Revision 1.1.1.1 1996/03/08 15:32:56 mclareni
- * Kuip
- *
- */
-/*-- Author : Alfred Nathaniel 14/08/92*/
-/* kexec.c: command execution */
-
-#include "kuip/kuip.h"
-#include "kuip/kfor.h"
-#include "kuip/kcom.h"
-#include "kuip/ksig.h"
-#include "kuip/kmenu.h"
-#include "kuip/kflag.h"
-#include "kuip/klink.h"
-#include "kuip/khash.h"
-#include "kuip/kalias.h"
-
-
-static KmCommand *curr_cmd;
-static int next_arg;
-static char *list_arg;
-
-
-static int call_action( KmCommand* );
-static int exec_multiple_cmds( const char*, int, int(*)() );
-static int exec_single_cmd( const char*, int, int(*)(), int );
-static int exec_template( const char*, const char*, int, int(*)() );
-static int fill_arg_list( KmCommand*, char*, int, int(*)(), int );
-static char* find_value( char*, INTEGER*, REAL* );
-static int get_chval( char*, int, char*(*)() );
-static char* next_value( const char* );
-static const char* next_word( const char* );
-static const char* prompt_argument( KmParameter* );
-static int valid_option( KmParameter*, const char*, int );
-
-
-/*
- * action routine for /MACRO/DEFAULTS
- */
-int kxmdefaults()
-{
- char *path = ku_gets();
- char *mdef = ku_getc();
-
- if( strcmp( path, "?" ) == 0 ) {
- ku_alfa();
- if( kc_flags.macro_path == NULL ) {
- printf( " *** No macro search path defined\n" );
- }
- else {
- printf( " Macro search path: %s\n", kc_flags.macro_path );
- }
- }
- else if( strcmp( path, "." ) == 0 ) {
- if( kc_flags.macro_path != NULL ) {
- free( kc_flags.macro_path );
- kc_flags.macro_path = NULL;
- }
- kc_flags.macro_search = KmMACRO_COMMAND;
- kc_value.defaults_path = ".";
- }
- else {
- if( kc_flags.macro_path != NULL )
- free( kc_flags.macro_path );
- kc_flags.macro_path = strdup( path );
- kc_value.defaults_path = kc_flags.macro_path;
- kc_value.defaults_order = "-COMMAND";
- }
-
- if( strcmp( mdef, "A" ) == 0 || strcmp( mdef, "AUTO" ) == 0 ) {
- kc_flags.macro_search = KmMACRO_AUTO;
- kc_value.defaults_order = "-AUTO";
- }
- else if( strcmp( mdef, "AR" ) == 0 || strcmp( mdef, "AUTOREVERSE" ) == 0 ) {
- kc_flags.macro_search = KmMACRO_AUTOREVERSE;
- kc_value.defaults_order = "-AUTOREVERSE";
- }
- else if( strcmp( mdef, "C" ) == 0 || strcmp( mdef, "COMMAND" ) == 0 ) {
- kc_flags.macro_search = KmMACRO_COMMAND;
- kc_value.defaults_order = "-COMMAND";
- }
- else {
- char *value;
- switch( kc_flags.macro_search ) {
- case KmMACRO_COMMAND:
- value = "Command";
- break;
- case KmMACRO_AUTO:
- value = "Auto";
- break;
- case KmMACRO_AUTOREVERSE:
- value = "AutoReverse";
- break;
- default:
- value = "Undefined";
- break;
- }
- ku_alfa();
- printf( " Macro search order is %s\n", value );
- }
-
- return 0;
-}
-
-
-/*
- * action routine for /MACRO/TRACE
- */
-int kxmtrace()
-{
- char *onoff = ku_getc();
- char *level = ku_getc();
-
- if( strcmp( onoff, "ON" ) == 0 ) {
- kc_flags.trace_on = 1;
- }
- else {
- kc_flags.trace_on = 0;
- }
-
- if( strcmp( level, "WAIT" ) == 0 ) {
- kc_flags.trace_wait = 1;
- kc_flags.trace_wait_save = 1;
- }
- else if( strcmp( level, "FULL" ) == 0 ) {
- kc_flags.trace_full = 1;
- kc_flags.trace_debug = 0;
- }
- else if( strcmp( level, "DEBUG" ) == 0 ) {
- kc_flags.trace_full = 1;
- kc_flags.trace_debug = 1;
- }
- else if( strcmp( level, "TEST" ) == 0 ) {
- kc_flags.trace_test = 1;
- }
- else {
- kc_flags.trace_wait = 0;
- kc_flags.trace_wait_save = 0;
- kc_flags.trace_full = 0;
- kc_flags.trace_debug = 0;
- kc_flags.trace_test = 0;
- }
-
- return 0;
-}
-
-
-int exec_cmd_string( const char *cmd_string,
- int interactive,
- int (*display_panel)() )
-{
- int status = 0;
-
- check_edit_server();
-
- if( !kc_flags.in_macro
- && kc_flags.in_application && !kc_flags.appl_called ) {
-
- if( strcasecmp( cmd_string, kc_flags.appl_exit ) != 0 ) {
- KmCommand *cmd = kc_flags.appl_cmd;
-
- /* call the application command with argument string */
- reset_arg_list( cmd );
- cmd->argc = 1;
- cmd->argv = (char**)malloc( sizeof(char*) );
- cmd->argoffs = (int*)malloc( sizeof(int) );
- cmd->argv[0] = strdup( cmd_string );
- cmd->argoffs[0] = 0;
- cmd->argline = strdup( cmd_string );
- status = exec_decoded_cmd( kc_flags.appl_cmd );
- }
- else {
- /* leave application */
-
- /* flag can be reset only here because it is tested in KUAPPL */
- kc_flags.in_application = 0;
- if( kc_flags.curr_prompt != NULL )
- free( kc_flags.curr_prompt );
- kc_flags.curr_prompt = strdup( kc_value.set_prompt );
- }
- }
- else if( cmd_string != NULL && cmd_string[0] != '\0' ) {
-
- kc_alias.substitutions = 100; /* protect against recursive aliases */
-
- status = exec_multiple_cmds( cmd_string, interactive, display_panel );
-
- if( kc_flags.last_cmd != NULL )
- free( kc_flags.last_cmd );
- kc_flags.last_cmd = strdup( cmd_string ); /* for $LAST function */
-#ifdef DBMALLOC
- malloc_mark( kc_flags.last_cmd );
-#endif
- }
-
- if( kjmpaddr.user_grfl_F != NULL )
- (*kjmpaddr.user_grfl_F)(); /* flush graphics output */
-
- return status;
-}
-
-
-/*
- * split the line into semicolon separated commands and execute each of them
- * substitute command aliases
- * if -AutoReverse try auto exec
- * apply COMMAND logic
- * execute command
- */
-static
-int exec_multiple_cmds( const char *cmd_string,
- int interactive,
- int (*display_panel)() )
-{
- char *cmd_line = strdup( cmd_string );
- char *line = cmd_line;
- int status = 0;
-
- while( line[0] != '\0' ) {
- int want_prompt = interactive;
- int block_panel;
- char *tail;
-
- while( *line == ' ' ) /* kill leading blanks */
- line++;
-
- if( line[0] == '*' ) { /* comment line */
- break;
- }
- else if( line[0] == '+' ) { /* suppress panel display */
- line++;
- want_prompt = 0;
- }
- else if( line[0] == '-' ) { /* force panel display */
- line++;
- want_prompt = -1;
- }
- while( *line == ' ' )
- line++;
-
- /* extract single command */
- tail = split_at_semicolon( line );
- if( line[0] == '\0' ) {
- line = tail;
- /* ignore empty lines */
- continue;
- }
- /* for multiple commands block the Motif panel until OK or Cancel */
- block_panel = (tail[0] != '\0');
-
- status = exec_single_cmd( line, want_prompt, display_panel, block_panel );
-
- if( status == KUMAC_UNWIND )
- break;
-
- if( tail[0] == '&' ) {
- /* cmd1 ;& cmd2 : execute second command only if first one succeeded */
- if( status != 0 )
- break;
- line = tail + 1;
- }
- else if( tail[0] == '!' ) {
- /* cmd1 ;! cmd2 : execute second command only if first one failed */
- if( status == 0 )
- break;
- line = tail + 1;
- }
- else {
- /* cmd1 ; cmd2 : execute second command anyway */
- line = tail;
- }
- }
- free( cmd_line );
- return status;
-}
-
-
-static
-int exec_single_cmd( const char *cmd_line,
- int interactive,
- int (*display_panel)(),
- int block_panel )
-{
- KmCommand **cmd_list;
- KmCommand *cmd;
- char *line;
- char *cmd_path;
- char *cmd_args;
- char *p;
- int status;
-
- line = strdup( cmd_line );
-
- if( kc_flags.in_macro ) {
-
- /* substitute system functions before variable arguments are replaced */
- if( (p = subst_sysfun( line, 1 )) != NULL ) {
- free( line );
- line = p;
- }
- }
-
- if( (p = subst_var_alias( line )) != NULL ) {
- free( line );
- line = p;
- }
-
- if( (p = subst_cmd_alias( line )) != NULL ) {
- free( line );
- line = p;
-
- /* start again because alias value can contain several commands */
- status = exec_multiple_cmds( line, interactive, display_panel );
- free( line );
- return status;
- }
-
- if( (p = strchr( line, '=' )) != NULL ) {
- /* variable assignment */
- char *name = strtrim( strndup( line, p - line ) );
-
- if( hash_lookup( kc_alias.global_value, name, NULL ) != NULL ) {
- char *value = ku_expr( p + 1 );
-
- hash_insert( kc_alias.global_value, name, value, 0 );
- free( value );
- free( name );
- return 0;
- }
- free( name );
- }
-
- if( kc_alias.translate ) {
- static char _KUIP_ALIAS_[] = "/KUIP/ALIAS/";
-
- /* separate command path */
- cmd_path = strdup( line );
- if( (p = strchr( cmd_path, ' ' )) != NULL )
- *p = '\0';
-
- /* substitute argument aliases except for ALIAS commands */
- cmd = search_command( cmd_path, &cmd_list );
- if( (cmd == NULL || strncmp( cmd->path, _KUIP_ALIAS_,
- (sizeof _KUIP_ALIAS_)-1 ) != 0)
- && (p = subst_arg_alias( line )) != NULL ) {
- free( line );
- line = p;
- }
- free( cmd_path );
- }
-
- /* substitute system functions */
- if( (p = subst_sysfun( line, 1 )) != NULL ) {
- free( line );
- line = p;
- }
-
- if( kc_flags.in_macro && kc_flags.trace_on ) {
-
- if( kc_flags.trace_full ) {
- ku_alfa();
- printf( " >>>>>> %s\n", line );
- }
-
- if( kc_flags.trace_wait ) {
- switch( ku_more( "Execute", line ) ) {
- case 1: /* Yes */
- break;
- case 2: /* No */
- free( line );
- return -1;
- /*break;*/
- case 3: /* Quit */
- free( line );
- kc_flags.quit_macro = 1;
- return KUMAC_UNWIND;
- /*break;*/
- case 4: /* Go */
- kc_flags.trace_wait = 0; /* no more questions */
- break;
- }
- }
- }
-
- cmd_path = strdup( line );
- if( (p = strchr( cmd_path, ' ' )) != NULL ) {
- *p = '\0';
- cmd_args = strdup( p + 1 );
- }
- else {
- cmd_args = strdup( "" );
- }
-
- if( !kc_flags.in_macro && kc_flags.macro_search == KmMACRO_AUTOREVERSE ) {
- /* look for macro before commands */
- char *fname = strdup( cmd_path );
- char *hash = strchr( fname, '#' );
- if( hash != NULL ) /* in case "mfile#mname" chop off "#mname" */
- *hash = '\0';
-
- if( fsearch( fname, "kumac", kc_flags.macro_path ) != NULL ) {
- free( cmd_path );
- free( cmd_args );
- cmd_path = strdup( "/MACRO/EXEC" );
- cmd_args = strdup( line );
- }
- free( fname );
- }
-
- if( (cmd = search_command( cmd_path, &cmd_list )) == NULL &&
- !kc_flags.in_macro && kc_flags.macro_search == KmMACRO_AUTO ) {
- /* look for macro if command not found */
- char *fname = strdup( cmd_path );
- char *hash = strchr( fname, '#' );
- if( hash != NULL ) /* in case "mfile#mname" chop off "#mname" */
- *hash = '\0';
-
- if( fsearch( fname, "kumac", kc_flags.macro_path ) != NULL ) {
- cmd = search_command( "/MACRO/EXEC", NULL );
- free( cmd_args );
- cmd_args = strdup( line );
- }
- free( fname );
- }
-
- if( cmd == NULL ) {
- if( cmd_list == NULL && kc_value.set_command != NULL ) {
- status = exec_template( line, kc_value.set_command,
- interactive, display_panel );
- }
- else {
- if( kjmpaddr.disp_cmd_list_C != NULL ) {
- (*kjmpaddr.disp_cmd_list_C)(cmd_path, cmd_list, 0);
- } else {
- print_cmd_list( cmd_list, cmd_path );
- }
- status = -1;
- }
- }
- else {
- status = fill_arg_list( cmd, cmd_args,
- interactive, display_panel, block_panel );
- }
- free( cmd_path );
- free( cmd_args );
- free( line );
-
- /* delete the temp vectors created by $SIGMA system function */
- if ( kc_flags.temp_vectors > 0 ) {
- INTEGER NB = kc_flags.temp_vectors;
- Kxdsig ( &NB );
- kc_flags.temp_vectors = 0;
- }
-
- /* delete the temp vectors created for non-contiguous subvector */
- if( Kcutil.NVADD > 0 ) {
- INTEGER IX = Pawc->IXPAWC + 1;
- Mzwipe( &IX );
- Kcutil.NVADD = 0;
- }
-
- return status;
-}
-
-
-/*
- * action routine for /KUIP/SET_SHOW/APPLICATION
- */
-int kxapplication()
-{
- char *appl_path = ku_getc();
- char *appl_exit = ku_gets();
-
- return ku_sapp( appl_path, appl_exit );
-}
-
-
-char *ku_appl( int *appl_luno,
- int *in_macro )
-{
- if( kc_flags.in_macro && kc_flags.in_application )
- *appl_luno = kc_flags.appl_luno;
- else
- *appl_luno = 5;
- *in_macro = kc_flags.in_macro;
- return kc_flags.appl_exit;
-}
-
-
-void F77_ENTRY_IIC(Kuappl,lun,macflg,chexit)
-/* { */
- int appl_luno;
- int in_macro;
- char *appl_exit = ku_appl( &appl_luno, &in_macro );
- *lun = appl_luno;
- *macflg = in_macro;
- fstrset( chexit, len_chexit, appl_exit );
-}
-
-
-int ku_sapp( const char *appl_path,
- const char *appl_exit )
-{
- if( appl_path[0] == '\0' ) {
- kc_flags.in_application = 0;
- if( kc_flags.curr_prompt != NULL )
- free( kc_flags.curr_prompt );
- kc_flags.curr_prompt = strdup( kc_value.set_prompt );
- return 0;
- }
- if( (kc_flags.appl_cmd = search_command( appl_path, NULL )) == NULL ) {
- printf( " *** Unknown application %s\n", appl_path );
- return -1;
- }
- kc_flags.in_application = 1;
- if( kc_flags.curr_prompt != NULL )
- free( kc_flags.curr_prompt );
- if( strstr( kc_value.set_prompt, "[]" ) != NULL )
- kc_flags.curr_prompt = str2dup( kc_flags.appl_cmd->name, " []" );
- else
- kc_flags.curr_prompt = str2dup( kc_flags.appl_cmd->name, " >" );
-
- if( appl_exit[0] == '\0' )
- appl_exit = "EXIT";
-
- if( kc_flags.appl_exit != NULL )
- free( kc_flags.appl_exit );
- kc_flags.appl_exit = strdup( appl_exit );
-
- if( kc_flags.in_macro ) {
- kc_flags.appl_stream = fopen( kc_flags.appl_file, "w" );
- }
- return 0;
-}
-
-
-void F77_ENTRY_CC(Kusapp,chpath,chexit)
-/* { */
- char *appl_path = fstrdup( chpath, len_chpath );
- char *appl_exit = fstrdup( chexit, len_chexit );
- ku_sapp( appl_path, appl_exit );
- free( appl_path );
- free( appl_exit );
-}
-
-
-/*
- * action routine for /MACRO/DATA
- */
-int kxmdata()
-{
- int appl_luno;
- int in_macro;
- char *appl_exit = ku_appl( &appl_luno, &in_macro );
- FILE *stream = fopen( ku_fcase( appl_exit ), "w" );
- char line[256];
-
- if( stream == NULL ) {
- printf( " *** MACRO/DATA: cannot open file %s\n", appl_exit );
- return 1;
- }
- while( ku_read( appl_luno, line, 255 ) >= 0
- && strcasecmp( appl_exit, line ) != 0 ) {
- fprintf( stream, "%s\n", line );
- }
- fclose( stream );
-
- return 0;
-}
-
-
-/*
- * action routine for /KUIP/SET_SHOW/TIMING
- */
-int kxtiming()
-{
- char *set_ON = "ON";
- char *set_OFF = "OFF";
- char *set_ALL = "ALL";
- char *value = ku_getc();
- KmTiming timing;
-
- if( strcmp( value, set_OFF ) == 0 ) {
- timing = KmTIMING_OFF;
- kc_value.set_timing = set_OFF;
- }
- else if( strcmp( value, set_ALL ) == 0 ) {
- timing = KmTIMING_ALL;
- kc_value.set_timing = set_ALL;
- }
- else {
- timing = KmTIMING_ON;
- kc_value.set_timing = set_ON;
- }
-
- if( kc_flags.timing != timing ) {
- if( timing == KmTIMING_OFF ) {
- kc_flags.real_time = time( NULL );
- kc_flags.user_time = clock();
- }
- else
- ku_time( kc_flags.real_time, kc_flags.user_time );
- kc_flags.timing = timing;
- }
-
- return 0;
-}
-
-
-/*
- * action routine for /KUIP/SET_SHOW/COMMAND
- */
-int kxcommand()
-{
- char *value = ku_gets();
-
- ku_cmdl( value );
-
- return 0;
-}
-
-
-void F77_ENTRY_C(Kucmdl,chpath)
-/* { */
- char *path = fstrdup( chpath, len_chpath );
-
- ku_cmdl( path );
- free( path );
-}
-
-
-void ku_cmdl( const char *template )
-{
- if( template[0] == '\0' ) {
- ku_alfa();
- if( kc_value.set_command == NULL )
- printf( " COMMAND line not defined\n" );
- else
- printf( " COMMAND line is : %s\n", kc_value.set_command );
- }
- else if( strcmp( template, "*" ) == 0 ) {
- if( kc_value.set_command != NULL ) {
- free( kc_value.set_command );
- kc_value.set_command = NULL;
- }
- }
- else {
- if( kc_value.set_command != NULL )
- free( kc_value.set_command );
- kc_value.set_command = strdup( template );
- }
-}
-
-
-/*
- * substitute template and execute
- */
-static
-int exec_template( const char *line,
- const char *template,
- int interactive,
- int (*display_panel)() )
-{
- char *old_template = kc_value.set_command;
- char *new_line = strdup( "" );
- int status;
- int i;
-
- for( i = 0; template[i] != '\0'; i++ ) {
-
- if( template[i] == '$' ) {
-
- if( template[i+1] == '*' ) {
- new_line = mstrcat( new_line, line );
- i++;
- continue;
- }
-
- else if( template[i+1] >= '1' && template[i+1] <= '9' ) {
- int n = template[i+1] - '1';
- char *args = strdup( line );
- char *word = strqtok( args );
- while( word != NULL && n-- > 0 )
- word = strqtok( NULL );
- if( word != NULL )
- new_line = mstrcat( new_line, word );
- free( args );
- i++;
- continue;
- }
- }
-
- new_line = mstrccat( new_line, template[i], 1 );
- }
-
- /* avoid infinite recursion of template is an invalid command */
- kc_value.set_command = NULL;
- status = exec_multiple_cmds( new_line, interactive, display_panel );
- free( new_line );
- kc_value.set_command = old_template;
- return status;
-}
-
-
-/*
- * check if string contains only valid options
- */
-static
-int valid_option( KmParameter *par,
- const char *opt_string,
- int len_opt_string )
-{
- int valid = 1;
-
- if( par->range_count > 0 ) { /* accept everything if no range defined */
- char *options = strupper( strndup( opt_string, len_opt_string ) );
- int maxlen = mstrlen( par->range_value, par->range_count );
- int n;
-
- /*
- * start with longest range values first because short ones
- * could be substrings of longer ones
- */
- for( n = maxlen; n > 0 && *options != '\0'; n-- ) {
- int j;
-
- for( j = 0; j < par->range_count; j++ ) {
- int len = strlen( par->range_value[j] );
- if( len == n ) {
- char *val = strupper( strdup( par->range_value[j] ) );
- char *p = strstr( options, val );
- free( val );
- if( p != NULL ) {
- /* remove this option */
- memmove( p, p + len , strlen(p+len) +1);
-/* overlapping strcpy( p, p + len );*/
- }
- }
- }
- }
-
- for( n = strlen( options ); n > 0 && options[n-1] == ' '; n-- )
- options[n-1] = '\0'; /* strip trailing blanks */
-
- if( *options != '\0' )
- valid = 0; /* option not in range */
-
- free( options );
- }
-
- return valid;
-}
-
-
-void reset_arg_list( KmCommand *cmd )
-{
- /* clear current values */
- if( cmd->argc > 0 ) {
- int i;
-
- for( i = 0; i < cmd->argc; i++ )
- free( cmd->argv[i] );
- cmd->argc = 0;
- free( (char*)cmd->argv );
- cmd->argv = NULL;
- free( cmd->argline );
- cmd->argline = NULL;
- free( (char*)cmd->argoffs );
- cmd->argoffs = NULL;
- }
-}
-
-
-/*
- * locate the next blank outside quotes and return pointer to it
- */
-static
-const char *next_word( const char *line )
-{
- int quoted = 0;
- while( *line != '\0' ) {
- if( *line == '\'' )
- quoted = !quoted;
- else if( *line == ' ' && !quoted )
- return line;
- line++;
- }
- return line;
-}
-
-
-/*
- * remove quotes and string concatenations
- */
-char *clean_word( char *word )
-{
- char *p;
- int quoted = 0;
- int strip_quotes;
-
- for( p = word; p[0] != '\0'; p++ ) {
-
- if( p[0] == '\'' ) {
-
- if( !quoted ) {
- quoted = 1;
- }
-
- else if( p[1] == '/' && p[2] == '/' && p[3] == '\'' ) {
- /* contract "'abc'//'def'" to "'abcdef'" */
- memmove(p, p + 4 , strlen(p+4) + 1);
-/* strcpy( p, p + 4 );*/
- p--;
- }
-
- else if( p[1] == '/' && p[2] == '/' && p[3] != '\0' ) {
- char *conc = strstr( p + 3, "//" );
- if( conc != NULL ) {
- *conc = '\0';
- if( strchr( p + 3, '\'' ) != NULL ) {
- *conc = '/';
- conc = NULL;
- }
- else {
- *conc = '/';
- }
- }
- if( conc == NULL ) {
- /* contract "'abc'//def" to "'abcdef'" */
- memmove( p, p + 3, strlen(p+3) + 1 );
-/* strcpy( p, p + 3 );*/
- strcat( p, "'" );
- }
- else {
- /* contract "'abc'//def//ghi" to "'abcdef'//ghi" */
- /* ^p ^conc */
- strncpy( p, p + 3, conc - p - 3 ); /* "'abcdefdef//ghi" */
- conc[-3] = '\''; /* "'abcdef'ef//ghi" */
- memmove( conc - 2, conc, strlen(conc) + 1);
-/* strcpy( conc - 2, conc );*/
- }
- }
-
- else {
- quoted = 0;
- }
- }
-
- else if( !quoted && p[1] == '/' && p[2] == '/' ) {
-
- if( p[3] == '\'' ) {
- /* contract "abc//'def'" to "'abcdef'" */
- char *s = str2dup( "'", word );
- int n = p - word;
- strcpy( s + n + 2, p + 4 );
- strcpy( word, s );
- free( s );
- p++;
- quoted = 1;
- }
- else if( p[3] != '\0' ) {
- /* contract "abc//def" to "abcdef"; leave "abc//" unchanged */
- memmove( p + 1, p + 3, strlen(p + 3) + 1 );
-/* strcpy( p + 1, p + 3 );*/
- }
- }
-
- }
-
- strip_quotes = ( word[0] == '\'' && word[strlen(word)-1] == '\'' );
-
- if( strip_quotes ) {
- /* test if there are transitions between quoted and not quoted */
- for( p = word + 1; p[0] != '\0'; p++ ) {
- if( p[0] == '\'' ) {
- if( p[1] == '\'' ) {
- /* "'abc''def'" is okay */
- p++;
- }
- else if( p[1] != '\0' ) {
- /* in "'abc'def'ghi'" we want to keep the quotes */
- strip_quotes = 0;
- break;
- }
- }
- }
- }
-
- for( quoted = 0, p = word; p[0] != '\0'; p++ ) {
- if( p[0] == '\'' ) {
- if( !quoted ) {
- quoted = 1;
- }
- else if( p[1] == '\'' ) {
- /* contract "'abc''def'" to "'abc'def'" */
- memmove( p, p + 1, strlen(p+1) + 1 );
-/* strcpy( p, p + 1 );*/
- }
- else {
- quoted = 0;
- }
- }
- }
-
- if( strip_quotes ) {
- /* contract "'abcdef'" to "abcdef" */
- for( p = word; p[2] != '\0'; p++ )
- p[0] = p[1];
- p[0] = '\0';
- }
-
- return word;
-}
-
-
-/*
- * parse the command string
- * find the corresponding command structure
- * fill the argument list
- * check the argument list for completeness and validity
- * return the pointer to the command structure or NULL if something is wrong
- *
- * interactive == 1 : prompt for missing mandatory parameters or wrong values
- * interactive == 0 : bail out if something is wrong
- * interactive == -1 : display panel in any case
- */
-static
-int fill_arg_list( KmCommand *cmd,
- char *arg_line,
- int want_prompt,
- int (*display_panel)(), /* routine to display Motif panel */
- int block_panel )
-{
- char *macro_args = NULL;
- int i;
-
- reset_arg_list( cmd );
- while( *arg_line == ' ' )
- arg_line++;
- if ( strlen(arg_line) > 0 ) {
- char *p=arg_line + strlen(arg_line) -1;
- while (*p == ' ' )
- *p--='\0';
- }
-
- if( strcasecmp( cmd->name, "EXEC" ) == 0 ) {
- /*
- * special treatment for "EXEC mname args":
- * chop off arg_line after mname and keep quoting in macro arguments
- */
- macro_args = arg_line;
- while( *macro_args != ' ' && *macro_args != '\0' )
- macro_args++;
- while( *macro_args == ' ' )
- macro_args++;
- if( *macro_args != '\0' )
- macro_args[-1] = '\0';
- else
- macro_args = NULL;
- }
-
- if( *arg_line != '\0' ) {
- const char *argv = arg_line;
- int argc = 0;
- int blanks = 0;
-
- while( 1 ) {
- const char *next_argv = next_word( argv );
- int len_argv = next_argv - argv;
- int next_argc = argc + 1;
- char *alloced_argv;
- const char *value;
-
- if( len_argv == 1 && argv[0] == '!' && argc < cmd->total ) {
- /* "!" == use default value */
- if( (argv = cmd->par[argc]->dfault) != NULL )
- len_argv = strlen( argv );
- }
-
- else if( len_argv == 2 && argv[0] == '!' && argv[1] == '!'
- && argc < cmd->total ) {
- /* "!?" == use last value or default */
- if( (argv = cmd->par[argc]->last) != NULL
- || (argv = cmd->par[argc]->dfault) != NULL )
- len_argv = strlen( argv );
- }
-
- else if( len_argv > 1 && argv[0] == '-' && argc < cmd->total
- && (cmd->par[argc]->flags & KmFLAG_MINUS) == 0 ) {
- /* "-value" for a parameter without explicit MINUS flag */
- int try_chopt = 0;
-
- if( cmd->par[argc]->type == KmTYPE_INT ) {
- /* make sure that it is not an integer number */
- for( i = 1; i < len_argv; i++ ) {
- if( !isdigit( argv[i] ) ) {
- try_chopt = 1;
- break;
- }
- }
- }
- else if( cmd->par[argc]->type == KmTYPE_REAL ) {
- /* make sure that it is not a real number */
- if( isdigit( argv[1] ) || argv[1] == '.' ) {
- for( i = 2; i < len_argv; i++ ) {
- if( strchr( "-12345.678eE+90", argv[i] ) == NULL ) {
- try_chopt = 1;
- break;
- }
- }
- }
- else {
- try_chopt = 1;
- }
- }
- else {
- try_chopt = 1;
- }
-
- if( try_chopt ) {
- /* try if there is a option parameter for which value is valid */
- for( i = 0; i < cmd->total; i++ ) {
- KmParameter *par = cmd->par[i];
- if( par->type == KmTYPE_OPTION ) {
- if( valid_option( par, argv + 1, len_argv - 1 ) ) {
- next_argc = argc; /* do not increment argument count */
- argc = i;
- argv++;
- len_argv--;
- break;
- }
- }
- }
- }
- }
-
- else if( (value = strchr( argv, '=' )) != NULL && value < next_argv ) {
- int len = value - argv;
- /* argument is NAME=VALUE */
- for( i = 0; i < cmd->total; i++ ) {
- KmParameter *par = cmd->par[i];
- if( len >= par->abbrev && len <= strlen( par->name )
- && strncasecmp( argv, par->name, len ) == 0 ) {
- next_argc = i + 1; /* move argument count */
- argc = i;
- argv += len + 1;
- len_argv -= len + 1;
- break;
- }
- }
- }
-
- if( argv != NULL )
- alloced_argv = clean_word( strndup( argv, len_argv ) );
- else
- alloced_argv = NULL;
-
- if( cmd->argc < argc + 1 ) {
- int k;
- /* adjust argument arrays */
- if( cmd->argc == 0 ) {
- cmd->argv = (char**)malloc( (argc+1) * sizeof(char*) );
- cmd->argoffs = (int*)malloc( (argc+1) * sizeof(int) );
- }
- else {
- cmd->argv = (char**)realloc( (char*)cmd->argv,
- (argc+1) * sizeof(char*) );
- cmd->argoffs = (int*)realloc( (char*)cmd->argoffs,
- (argc+1) * sizeof(int) );
- }
- for( k = cmd->argc; k < argc + 1; k++ ) {
- cmd->argv[k] = NULL;
- cmd->argoffs[k] = 0;
- }
- cmd->argc = argc + 1;
- }
-
- /* assign argument value */
- if( cmd->argv[argc] == NULL ) {
- if( argc < cmd->total
- && (cmd->par[argc]->flags & KmFLAG_VARARG) != 0 ) {
- /* protect commas inside the value */
- char *p;
- while( (p = strchr( alloced_argv, ',' )) != NULL )
- *p = '\n';
- }
- cmd->argv[argc] = alloced_argv;
- cmd->argoffs[argc] = blanks;
- blanks = 0;
- }
- else if( alloced_argv != NULL ) {
- /* append to existing value */
- if( argc < cmd->total && cmd->par[argc]->type == KmTYPE_OPTION ) {
- /* options are simply concatenated */
- cmd->argv[argc] = mstrcat( cmd->argv[argc], alloced_argv );
- }
- else if( argc < cmd->total
- && (cmd->par[argc]->flags & KmFLAG_VARARG) != 0 ) {
- /* separate by comma and protect commas inside the value */
- char *p;
- while( (p = strchr( alloced_argv, ',' )) != NULL )
- *p = '\n';
- cmd->argv[argc] = mstr2cat( cmd->argv[argc], ",", alloced_argv );
- }
- else {
- /* other argument are separate by blank */
- cmd->argv[argc] = mstr2cat( cmd->argv[argc], " ", alloced_argv );
- }
- free( alloced_argv ); /* malloc'ed in clean_word() */
- }
-
- if( argc < cmd->total ) {
- /* check that a constant has not been assigned a different value */
- KmParameter *par = cmd->par[argc];
-
- if( (par->flags & KmFLAG_CONST) != 0
- && strcmp( cmd->argv[argc], par->dfault ) != 0 ) {
- printf( " *** Parameter %s of %s is defined as a constant!\n",
- par->name, cmd->name );
- free( cmd->argv[argc] );
- cmd->argv[argc] = strdup( par->dfault );
- }
- }
-
- if( *next_argv != '\0' ) {
- argv = next_argv + 1;
- while( *argv == ' ' ) {
- argv++;
- blanks++;
- }
- if( argc >= cmd->total
- || (cmd->par[argc]->flags & KmFLAG_VARARG) == 0 )
- argc = next_argc;
- }
- else {
- for( i = 0; i < cmd->argc; i++ ) {
- if( i == 0 )
- cmd->argline = strdup( "" );
- else
- cmd->argline = mstrccat( cmd->argline, ' ', cmd->argoffs[i] + 1 );
-
- cmd->argoffs[i] = strlen( cmd->argline );
- if( cmd->argv[i] == NULL ) {
- char *dfault = NULL;
- if( i < cmd->total ) {
- KmParameter *par = cmd->par[i];
- if( par->dfault != NULL )
- dfault = par->dfault;
- else if( i >= cmd->mandatory )
- dfault = par->last;
- }
- cmd->argv[i] = strdup( (dfault != NULL) ? dfault : "" );
- }
- else
- cmd->argline = mstrcat( cmd->argline, cmd->argv[i] );
- }
- break; /* while(1) */
- }
- }
- }
-
- /* check that all mandatory parameters are there */
- if( cmd->argc < cmd->mandatory ) {
- if( cmd->argc == 0 ) {
- cmd->argv = (char**)malloc( cmd->mandatory * sizeof(char*) );
- cmd->argline = strdup( "" );
- cmd->argoffs = (int*)malloc( cmd->mandatory * sizeof(int) );
- cmd->argoffs[0] = 0;
- }
- else {
- cmd->argv = (char**)realloc( (char*)cmd->argv,
- cmd->mandatory * sizeof(char*) );
- cmd->argoffs = (int*)realloc( (char*)cmd->argoffs,
- cmd->mandatory * sizeof(int) );
- }
- for( i = cmd->argc; i < cmd->mandatory; i++ ) {
- cmd->argv[i] = NULL;
- }
- for( i = cmd->argc + 1; i < cmd->mandatory; i++ ) {
- cmd->argoffs[i] = cmd->argoffs[i-1];
- }
- }
-
- for( i = 0; i < cmd->mandatory; i++ ) {
- if( i >= cmd->argc || cmd->argv[i] == NULL ) {
- if( want_prompt ) {
- if( display_panel == NULL ) {
- /* prompt on command line */
- cmd->argv[i] = strdup( prompt_argument( cmd->par[i] ) );
- if( cmd->argline[0] != '\0' )
- cmd->argline = mstrcat( cmd->argline, " " );
- cmd->argoffs[i] = strlen( cmd->argline );
- cmd->argline = mstrcat( cmd->argline, cmd->argv[i] );
- cmd->argc++;
- }
- else {
- /* display panel */
- return (*display_panel)( cmd, i, block_panel );
- }
- }
- else {
- ku_alfa();
- printf( " *** Mandatory parameter %s missing\n", cmd->par[i]->name );
- return 1;
- }
- }
- }
-
- if( macro_args != NULL ) {
- /* insert macro arguments for EXEC command */
- cmd->argv = (char**)realloc( (char*)cmd->argv,
- (cmd->argc+1) * sizeof(char*) );
- cmd->argoffs = (int*)realloc( (char*)cmd->argoffs,
- (cmd->argc+1) * sizeof(int) );
- cmd->argline = mstrcat( cmd->argline, " " );
- cmd->argoffs[cmd->argc] = strlen( cmd->argline );
- cmd->argv[cmd->argc] = strdup( macro_args );
- cmd->argline = mstrcat( cmd->argline, macro_args );
- cmd->argc++;
- }
-
-#ifdef DBMALLOC
- if( cmd->argc > 0 ) {
- malloc_mark( cmd->argv );
- malloc_mark( cmd->argoffs );
- malloc_mark( cmd->argline );
- for( i = 0; i < cmd->argc; i++ ) {
- malloc_mark( cmd->argv[i] );
- }
- }
-#endif
-
- if( want_prompt < 0 && display_panel != NULL ) {
- /* force panel display */
- return (*display_panel)( cmd, i, block_panel );
- }
- return exec_decoded_cmd( cmd );
-}
-
-
-/*
- * execute the command
- */
-int exec_decoded_cmd( KmCommand *cmd )
-{
- int status;
- int do_timing = (kc_flags.timing == KmTIMING_ALL
- || ( kc_flags.timing == KmTIMING_ON
- && !kc_flags.in_macro ));
- clock_t user_time = clock();
- time_t real_time = time( NULL );
- int i;
-
- /* save current values in last */
- for( i = 0; i < cmd->total; i++ ) {
- KmParameter *par = cmd->par[i];
- if( i >= cmd->mandatory && par->dfault == NULL ) {
- /*
- * optional parameters without default:
- * overwrite last value by command line argument
- * otherwise keep value from prompt in next_argument()
- */
- if( i < cmd->argc ) {
- if( par->last != NULL )
- free( par->last );
- par->last = strdup( cmd->argv[i] );
-#ifdef DBMALLOC
- malloc_mark( par->last );
-#endif
- }
- }
- else {
- if( par->last != NULL )
- free( par->last );
- if( i < cmd->argc ) {
- par->last = strdup( cmd->argv[i] );
-#ifdef DBMALLOC
- malloc_mark( par->last );
-#endif
- }
- else {
- par->last = NULL;
- }
- }
- }
-
- curr_cmd = cmd;
- if( cmd->list_par > 0 && cmd->list_par <= cmd->argc ) {
- /* execute command for each value in a comma separated list */
- while( 1 ) {
- char *p;
- int paren = 0;
- int comma = 0;
- for( p = cmd->argv[cmd->list_par-1]; *p != '\0'; p++ ) {
- /* look for comma outside balanced parentheses */
- if( *p == '(' )
- paren++;
- else if( *p == ')' )
- paren--;
- else if( paren == 0 && *p == ',' ) {
- comma = 1;
- *p++ = '\0';
- break;
- }
- }
- status = call_action( cmd );
- /* if( kc_flags.quit_macro ) */
- if( kc_flags.in_macro && kc_flags.quit_macro )
- status = KUMAC_UNWIND; /* quit macro execution */
- if( !comma || status != 0 )
- break;
- strcpy( cmd->argv[cmd->list_par-1], p );
- }
- }
- else {
- /* command has no parameter of list type */
- status = call_action( cmd );
- }
- if( do_timing )
- ku_time( real_time, user_time );
-
- return status;
-}
-
-
-/*
- * print real and CPU time
- */
-void ku_time( time_t real_time,
- clock_t user_time )
-{
- double cptime = (double)( clock() - user_time ) / CLOCKS_PER_SEC;
- double rtime = difftime( time( NULL ), real_time ) + 0.5;
- int seconds;
- int minutes;
- int hours;
-
- hours = rtime / 3600;
- rtime -= hours * 3600;
- minutes = rtime / 60;
- rtime -= minutes * 60;
- seconds = rtime;
-
- ku_alfa();
- printf( " Real time %s:%s:%s, CP time %.3f\n",
- strfromi( hours, 2 ), strfromi( minutes, 2 ), strfromi( seconds, 2 ),
- cptime );
-}
-
-
-/*
- * return difference in real time since last call in format hh:mm:ss
- */
-void F77_ENTRY_C(Kirtim,chtime)
-/* { */
- static int initialized = 0;
- static time_t time0;
- time_t time1 = time( NULL );
- double rtime;
- int seconds;
- int minutes;
- int hours;
- char timebuf[9];
-
- if( !initialized ) {
- initialized = 1;
- time0 = time( NULL );
- }
- rtime = difftime( time1, time0 );
- time0 = time1;
- rtime += 0.5;
- hours = rtime / 3600;
- rtime -= hours * 3600;
- minutes = rtime / 60;
- rtime -= minutes * 60;
- seconds = rtime;
-
- strcpy( timebuf, "00:00:00" );
- if( hours < 100 ) {
- timebuf[0] += hours / 10;
- timebuf[1] += hours % 10;
- }
- else {
- timebuf[0] = '*';
- timebuf[1] = '*';
- }
- timebuf[3] += minutes / 10;
- timebuf[4] += minutes % 10;
- timebuf[6] += seconds / 10;
- timebuf[7] += seconds % 10;
-
- fstrset( chtime, len_chtime, timebuf );
-}
-
-
-static time_t last_real_time;
-static clock_t last_user_time;
-
-/*
- * print timing since last call to KUTIME/KUTIM0
- */
-void F77_ENTRY(Kutime)
-/* { */
- ku_time( last_real_time, last_user_time );
- last_real_time = time( NULL );
- last_user_time = clock();
-}
-
-
-/*
- * reset timing
- */
-void F77_ENTRY(Kutim0)
-/* { */
- last_real_time = time( NULL );
- last_user_time = clock();
-}
-
-
-/*
- * call the action routine
- */
-static
-int do_action( cmd )
- KmCommand *cmd;
-{
-#ifdef DBMALLOC
- unsigned long histid1, histid2, orig_size, current_size;
-
- orig_size = malloc_size( &histid1 );
-#endif
-
-#ifdef vms
- if( kc_flags.action_nesting == 0 && kc_flags.in_motif )
- VAXC$ESTABLISH( signal_handler );
-#endif
-
- ku_intr( 1 ); /* allow interrupts */
-
- kc_flags.action_nesting++;
- if( cmd->action_F != NULL ) {
- IQUEST(1) = 0;
- (*cmd->action_F)();
- }
- else if( cmd->action_C != NULL ) {
- IQUEST(1) = (*cmd->action_C)();
- }
- kc_flags.action_nesting--;
-
-#ifdef DBMALLOC
- current_size = malloc_size( &histid2 );
-
- if( current_size != orig_size ) {
- /* check for memory leaks in action routine */
- malloc_list( 2, histid1, histid2 );
- }
-#endif
-
- return 1;
-}
-
-
-static
-int call_action( KmCommand *cmd )
-{
- int status;
-
- if( kc_flags.in_macro && kc_flags.trace_test )
- return 0; /* TRACE ON TEST */
-
- if( kjmpaddr.disp_flush_C != NULL )
- (*kjmpaddr.disp_flush_C)(); /* eat up queued Motif events */
-
- if( cmd->action_F == NULL && cmd->action_C == NULL ) {
- /* no action routine -- execute HELP path */
- char *line = str3dup( "/KUIP/HELP '", cmd->path, "'" );
- status = ku_exel( line );
- free( line );
- return status;
- }
-
- next_arg = 0;
- if( do_action( cmd ) == 1 )
- status = IQUEST(1);
- else {
- /* this branch only taken for VMS */
- reset_break();
- status = KUMAC_UNWIND;
- }
-
-#ifdef vms
- /*
- * On VMS we are not allowed to break and reenter the Motif mainloop.
- * Therefore we allow ^C only to be delivered while being inside the
- * action routine.
- */
- if( kc_flags.in_motif )
- ku_intr( 0 ); /* disable interrupts */
-#endif
-
- if( kc_break.error_msg != NULL ) {
- /*
- * print the runtime message stored by the error handler
- * in order to avoid recursive I/O
- */
- ku_alfa();
- puts( kc_break.error_msg );
- free( kc_break.error_msg );
- kc_break.error_msg = NULL;
- }
-
- /* increment execution counter */
- if( kc_flags.in_macro )
- cmd->xcount += XCOUNT_OFFSET;
- else if( (cmd->xcount & XCOUNT_MASK) < XCOUNT_MASK )
- cmd->xcount += 1;
-
- if( kc_break.soft_intr ) {
- kc_break.soft_intr = 0;
- status = KUMAC_UNWIND;
- }
-
- return status;
-}
-
-
-/*
- * return statistic about command execution:
- * IWHICH == 0 : number of commands in total (macro + keyboard)
- * IWHICH == 1 : number of different commands in total
- * IWHICH == 2 : number of commands from keyboard
- * IWHICH == 3 : number of different commands from keyboard
- * IWHICH == 4 : number of commands inside macro
- * IWHICH == 5 : number of different commands inside macro
- * otherwise reset counters
- */
-INTEGER F77_ENTRY_I(Kustat,iwhich )
-/* { */
- KmMenu **menu_list = root_menu_list( "" );
- KmMenu *menu;
- int which = *iwhich;
- INTEGER count = 0;
- int n;
-
- for( n = 0; (menu = menu_list[n]) != NULL; n++ ) {
- KmCommand *cmd;
- for( cmd = menu->cmds; cmd != NULL; cmd = cmd->next ) {
- switch( which ) {
-
- case 0:
- count += (cmd->xcount & XCOUNT_MASK) + (cmd->xcount >> XCOUNT_SHIFT);
- break;
-
- case 1:
- if( cmd->xcount != 0 )
- count++;
- break;
-
- case 2:
- count += (cmd->xcount & XCOUNT_MASK);
- break;
-
- case 3:
- if( (cmd->xcount & XCOUNT_MASK) != 0 )
- count++;
- break;
-
- case 4:
- count += (cmd->xcount >> XCOUNT_SHIFT);
- break;
-
- case 5:
- if( (cmd->xcount >> XCOUNT_SHIFT) != 0 )
- count++;
- break;
-
- default: /* reset counters */
- cmd->xcount = 0;
- }
- }
- }
- free( menu_list );
- return count;
-}
-
-
-/*
- * prompt for missing argument
- */
-static
-const char *prompt_argument( KmParameter *par )
-{
- char *dfault;
-
- if( par->last != NULL )
- dfault = par->last;
- else if( par->dfault != NULL )
- dfault = par->dfault;
- else
- dfault = "";
-
- return ku_pros( par->prompt, dfault );
-}
-
-
-/*
- * chop off the line at the first unquoted semicolon
- * ignore semicolons followed by something which could be a VMS version number
- * return the remaining line or pointer to '\0'
- */
-char *split_at_semicolon( char *line )
-{
- int quoted = 0;
- char *tail = "";
- char *p = line;
-
- while( *p != '\0' ) {
-
- if( *p == '\'' ) {
- quoted = !quoted;
- }
- else if( *p == ';' && !quoted
- && ( p[1] == '\0'
- || strchr( "0123456789+-?[*", p[1] ) == NULL ) ) {
-
- tail = p + 1;
- while( *tail == ' ' ) {
- tail++;
- }
- break;
- }
- p++;
- }
-
- while( p > line && p[-1] == ' ' )
- p--;
-
- *p = '\0';
-
- return tail;
-}
-
-
-/*
- * execute command with echo
- */
-int ku_exec( const char *cmd_string )
-{
- if( kc_flags.echo_command > 0 ) {
- ku_alfa();
- printf( "%s> %s\n", kc_flags.echo_prompt, cmd_string );
- }
-
- return ku_exel( cmd_string );
-}
-
-
-int ku_exel( const char *cmd_string )
-{
- return exec_cmd_string( cmd_string, 1, kjmpaddr.disp_panel_C );
-}
-
-
-void F77_ENTRY_C(Kcexec,chline)
-/* { */
- char *cmd_string = fstr0dup( chline, len_chline );
- if( cmd_string != NULL ) {
- ku_exel( cmd_string );
- free( cmd_string );
- }
-}
-
-
-INTEGER F77_ENTRY_C(Kuexec,chline)
-/* { */
- INTEGER status = 0;
- char *cmd_string = fstr0dup( chline, len_chline );
- if( cmd_string != NULL ) {
- status = ku_exec( cmd_string );
- free( cmd_string );
- }
- return status;
-}
-
-
-INTEGER F77_ENTRY_C(Kuexel,chline)
-/* { */
- INTEGER status = 0;
- char *cmd_string = fstr0dup( chline, len_chline );
- if( cmd_string != NULL ) {
- status = ku_exel( cmd_string );
- free( cmd_string );
- }
- return status;
-}
-
-
-/*
- * return the next argument
- */
-static
-char *next_value( const char *called_by )
-{
- char *value = find_value( NULL, NULL, NULL );
-
- if( value == NULL ) {
- ku_alfa();
- printf( " *** Command %s requests undefined parameter #%d with %s\n",
- curr_cmd->path, next_arg + 1, called_by );
- value = "";
- }
- else {
- int i;
- for( i = strlen( value ); i > 0; i-- ) {
- if( value[i-1] != ' ' )
- break;
- }
- if( i == 0 ) /* return empty string if all blanks */
- value = "";
- }
-
- next_arg++;
- return value;
-}
-
-
-/*
- * find the value to return to the next KUGETx call:
- * ---- command line argument
- * or default value
- * or last value for optional parameters without default
- * if one of the input pointers is defined store it as last value
- */
-static
-char *find_value( char *cval,
- INTEGER *ival,
- REAL *rval )
-{
- char *value = NULL;
-
- if( next_arg < curr_cmd->argc )
- value = curr_cmd->argv[next_arg];
-
- if( value == NULL && next_arg < curr_cmd->total ) {
- KmParameter *par = curr_cmd->par[next_arg];
- value = par->dfault;
-
- /* set last value for optional parameters without default */
- if( value == NULL && next_arg >= curr_cmd->mandatory ) {
-
- if( cval != NULL )
- value = cval;
- else if( ival != NULL )
- value = strfromi( (int)*ival, 0 );
- else if( rval != NULL )
- value = strfromd( (double)*rval, 0 );
-
- if( value != NULL ) {
- if( par->last != NULL )
- free( par->last );
- par->last = strdup( value );
- }
-
- value = par->last;
- }
- }
- return value;
-}
-
-
-void ku_spy( const char *flag )
-{
- static int save_next_arg;
-
- if( strcasecmp( flag, "ON" ) == 0 ) {
- save_next_arg = next_arg;
- }
- else if( strcasecmp( flag, "OFF" ) == 0 ) {
- if( next_arg > save_next_arg )
- next_arg = save_next_arg;
- }
-}
-
-
-void F77_ENTRY_C(Kuspy,chopt)
-/* { */
- char *opt = fstrdup( chopt, len_chopt );
- ku_spy( opt );
- free( opt );
-}
-
-
-/*
- * generic KUGETx for character arguments
- */
-static
-int get_chval( char *chval,
- int len,
- char *(*getx)() )
-{
- char *cval = fstrdup( chval, len );
- find_value( cval, NULL, NULL );
- free( cval );
- return fstrset( chval, len, (*getx)() );
-}
-
-
-/*
- * get argument in uppercase
- */
-char *ku_getc()
-{
- char *value = next_value( "KUGETC" );
- strupper( value );
- if( list_arg != NULL )
- free( list_arg );
- list_arg = str0dup( value );
-
-#ifdef DBMALLOC
- if( list_arg != NULL )
- malloc_mark( list_arg );
-#endif
-
- return value;
-}
-
-void F77_ENTRY_CI(Kugetc,chval,length)
-/* { */
- *length = get_chval( chval, len_chval, ku_getc );
-}
-
-
-/*
- * get all arguments to end of line
- */
-char *ku_gete()
-{
- if( next_arg < curr_cmd->argc )
- return curr_cmd->argline + curr_cmd->argoffs[next_arg];
- return next_value( "KUGETE" );
-}
-
-void F77_ENTRY_CI(Kugete,chpar,length)
-/* { */
- *length = get_chval( chpar, len_chpar, ku_gete );
-}
-
-
-/*
- * get argument with FILECASE conversion
- */
-char *ku_getf()
-{
- char *value = next_value( "KUGETF" );
- ku_fcase( value );
- if( list_arg != NULL )
- free( list_arg );
- list_arg = str0dup( value );
-
-#ifdef DBMALLOC
- if( list_arg != NULL )
- malloc_mark( list_arg );
-#endif
-
- return value;
-}
-
-void F77_ENTRY_CI(Kugetf,chpar,length)
-/* { */
- *length = get_chval( chpar, len_chpar, ku_getf );
-}
-
-
-/*
- * get argument without case conversion
- */
-char *ku_gets()
-{
- char *value = next_value( "KUGETS" );
- if( list_arg != NULL )
- free( list_arg );
- list_arg = str0dup( value );
-
-#ifdef DBMALLOC
- if( list_arg != NULL )
- malloc_mark( list_arg );
-#endif
-
- return value;
-}
-
-void F77_ENTRY_CI(Kugets,chpar,length)
-/* { */
- *length = get_chval( chpar, len_chpar, ku_gets );
-}
-
-
-/*
- * retrieve the next item from the list loaded with KUGETC or KUGETS
- */
-char *ku_getl()
-{
- static char *list_this = NULL;
-
- if( list_this != NULL ) {
- free( list_this );
- list_this = NULL;
- }
-
- if( list_arg != NULL ) {
- char *p;
- int quoted = 0;
- int paren = 0;
- int comma = 0;
-
- for( p = list_arg; *p != '\0'; p++ ) {
- /* look for separator outside balanced parentheses or quotes */
- /* \n is used to protect commas in VARARG lists */
- if( *p == '\n' )
- *p = ',';
- else if( *p == '\'' )
- quoted = !quoted;
- else if( !quoted ) {
- if( *p == '(' )
- paren++;
- else if( *p == ')' )
- paren--;
- else if( paren == 0 && *p == ',' ) {
- comma = 1;
- *p++ = '\0';
- break;
- }
- }
- }
-
- if( comma ) {
- /* pass the first item as argument and remove it from the rest */
- list_this = strdup( list_arg );
- while( *p == ' ' )
- p++; /* skip leading blanks */
- memmove( list_arg, p, strlen(p) + 1 );
-/* strcpy( list_arg, p );*/
- }
- else {
- /* pass the complete thing */
- list_this = strdup( list_arg );
- free( list_arg );
- list_arg = NULL;
- }
-#ifdef DBMALLOC
- malloc_mark( list_this );
-#endif
- }
-
- return list_this;
-}
-
-void F77_ENTRY_CI(Kugetl,chpar,length)
-/* { */
- *length = get_chval( chpar, len_chpar, ku_getl );
-}
-
-
-/*
- * get integer argument
- */
-int ku_geti()
-{
- char *value = strdup( next_value( "KUGETI" ) );
- KmParameter *par = (next_arg > curr_cmd->total)
- ? NULL : curr_cmd->par[next_arg-1];
-
- while( 1 ) {
- int do_prompt = 0;
- int ival = 0;
- double dval;
-
- if( ku_math( value, &dval ) == 0 ) {
- ival = dval;
-
- if( par != NULL ) {
- /* check against parameter definition */
- if( par->type != KmTYPE_INT ) {
- printf( " *** %s: KUGETI called for non-I parameter %s\n",
- curr_cmd->path, par->name );
- }
- else {
- KmParInt *pnum = (KmParInt*)par->ptype;
-
- if( pnum->range_lower != NULL && ival < atoi( pnum->range_lower ) ) {
- printf( " *** %s: %s=%d less than lower range value %s\n",
- curr_cmd->path, par->name, ival, pnum->range_lower );
- do_prompt = 1;
- }
- if( pnum->range_upper != NULL && ival > atoi( pnum->range_upper ) ) {
- printf( " *** %s: %s=%d greater than upper range value %s\n",
- curr_cmd->path, par->name, ival, pnum->range_upper );
- do_prompt = 1;
- }
- if( par->range_count > 0 ) {
- int found = 0;
- int i;
- for( i = 0; i < par->range_count; i++ ) {
- if( ival == atoi( par->range_value[i] ) ) {
- found =1;
- break;
- }
- }
- if( !found ) {
- printf( " *** %s: %s=%d not in list of allowed values\n",
- curr_cmd->path, par->name, ival );
- do_prompt = 1;
- }
- }
- }
- }
- }
- else {
- printf( " *** %s: invalid integer number '%s'\n",
- curr_cmd->path, value );
- do_prompt = 1;
- }
-
- if( do_prompt ) {
- const char *p = prompt_argument( par );
- free( value );
- if( p == NULL )
- return 0;
- value = strdup( p );
- }
- else {
- free( value );
- return ival;
- }
- }
-}
-
-void F77_ENTRY_I(Kugeti,ipar)
-/* { */
- find_value( NULL, ipar, NULL );
- *ipar = ku_geti();
-}
-
-
-/*
- * get real argument
- */
-double ku_getr()
-{
- char *value = strdup( next_value( "KUGETR" ) );
- KmParameter *par = (next_arg > curr_cmd->total)
- ? NULL : curr_cmd->par[next_arg-1];
-
- while( 1 ) {
- int do_prompt = 0;
- double rval;
-
- if( ku_math( value, &rval ) == 0 ) {
-
- if( par != NULL ) {
- /* check against parameter definition */
- if( par->type != KmTYPE_REAL ) {
- printf( " *** %s: KUGETR called for non-R parameter %s\n",
- curr_cmd->path, par->name );
- }
- else {
- KmParReal *pnum = (KmParReal*)par->ptype;
-
- if( pnum->range_lower != NULL && rval < atof( pnum->range_lower ) ) {
- printf( " *** %s: %s=%f less than lower range value %s\n",
- curr_cmd->path, par->name, rval, pnum->range_lower );
- do_prompt = 1;
- }
- if( pnum->range_upper != NULL && rval > atof( pnum->range_upper ) ) {
- printf( " *** %s: %s=%f greater than upper range value %s\n",
- curr_cmd->path, par->name, rval, pnum->range_upper );
- do_prompt = 1;
- }
- if( par->range_count > 0 ) {
- int found = 0;
- int i;
- for( i = 0; i < par->range_count; i++ ) {
- if( rval == atof( par->range_value[i] ) ) {
- found =1;
- break;
- }
- }
- if( !found ) {
- printf( " *** %s: %s=%f not in list of allowed values\n",
- curr_cmd->path, par->name, rval );
- do_prompt = 1;
- }
- }
- }
- }
- }
- else {
- printf( " *** %s: invalid real number '%s'\n",
- curr_cmd->path, value );
- do_prompt = 1;
- }
-
- if( do_prompt ) {
- const char *p = prompt_argument( par );
- free( value );
- if( p == NULL )
- return 0;
- value = strdup( p );
- }
- else {
- free( value );
- return rval;
- }
- }
-}
-
-void F77_ENTRY_R(Kugetr,rpar)
-/* { */
- find_value( NULL, NULL, rpar );
- *rpar = ku_getr();
-}
-
-
-/*
- * return number of arguments in command line
- */
-int ku_npar()
-{
- return curr_cmd->argc;
-}
-
-INTEGER F77_ENTRY(Kunpar)
-/* { */
- return ku_npar();
-}
-
-
-/*
- * return command name and number of arguments
- */
-void F77_ENTRY_CI(Kupatl,chpath,npar)
-/* { */
- fstrset( chpath, len_chpath, curr_cmd->name );
- *npar = ku_npar();
-}
-
-
-/*
- * return command path and number of arguments
- */
-void F77_ENTRY_CII(Kupath,chpath,nlev,npar)
-/* { */
- char *path = strdup( &curr_cmd->path[1] );
- char *p;
-
- *nlev = 0;
- for( p = strtok( path, "/" ); p != NULL; p = strtok( NULL, "/" ) ) {
- fstrset( chpath, len_chpath, p );
- chpath += len_chpath;
- *nlev += 1;
- }
- free( path );
- *npar = ku_npar();
-}
-
-char *ku_path()
-{
- return curr_cmd->path;
-}
-
-
diff --git a/src/packlib/kuip/code_kuip/khash.c b/src/packlib/kuip/code_kuip/khash.c
deleted file mode 100644
index ee9cf70..0000000
--- a/src/packlib/kuip/code_kuip/khash.c
+++ /dev/null
@@ -1,325 +0,0 @@
-/*
- * $Id: khash.c,v 1.1.1.1 1996/03/08 15:32:56 mclareni Exp $
- *
- * $Log: khash.c,v $
- * Revision 1.1.1.1 1996/03/08 15:32:56 mclareni
- * Kuip
- *
- */
-/*CMZ : 2.06/00 23/09/94 15.15.31 by Alfred Nathaniel*/
-/*-- Author : Alfred Nathaniel 18/11/92*/
-/* khash.c: hash table management */
-
-#include "kuip/kuip.h"
-#include "kuip/khash.h"
-
-/*
- * compute a hash value from a character string
- *
- * algorithm by P.J. Weinberger
- *
- * reference: page 436 in A.V. Aho, R. Sethi, J.D. Ullman,
- * "Compilers - Principles, Techniques, and Tools", Addison-Wesley
- */
-static
-int hashpjw( HashTable* table,
- const char *name )
-{
- int fold_case = (table->strcmp != strcmp);
- unsigned int h = 0;
- unsigned int g;
-
- while( *name != '\0' ) {
- char c = *name++;
-
- if( fold_case && isupper( c ) )
- c = tolower( c );
-
- h = (h << 4) + c;
- if( (g = (h & 0xF0000000)) != 0 ) {
- h ^= (g >> 24);
- h ^= g;
- }
- }
- return h % table->size;
-}
-
-
-/*
- * compare two hash entry names (used by qsort)
- */
-static
-int hash_cmp( const void* p1,
- const void* p2 )
-{
- HashArray *ent1 = (HashArray*)p1;
- HashArray *ent2 = (HashArray*)p2;
- return strcmp( ent1->name, ent2->name );
-}
-
-static
-int hash_casecmp( const void* p1,
- const void* p2 )
-{
- HashArray *ent1 = (HashArray*)p1;
- HashArray *ent2 = (HashArray*)p2;
- return strcasecmp( ent1->name, ent2->name );
-}
-
-
-/*
- * create a new hash table
- */
-HashTable *hash_create( int size )
-{
- HashTable *table = (HashTable*)malloc( sizeof(HashTable) );
- table->size = size;
- table->entries = (HashEntry**)calloc( size, sizeof(HashEntry*) );
- table->nentries = 0;
- hash_config( table, "string" );
- hash_config( table, "keep" );
- hash_config( table, "ignore" );
- return table;
-}
-
-
-void hash_config( HashTable* table,
- const char* option )
-{
- if( strcmp( option, "string" ) == 0 ) {
- table->is_string = 1;
- table->tag_only = 0;
- }
- else if( strcmp( option, "struct" ) == 0 ) {
- table->is_string = 0;
- table->tag_only = 0;
- }
- else if( strcmp( option, "tag_only" ) == 0 ) {
- table->is_string = 0;
- table->tag_only = 1;
- }
- else if( strcmp( option, "keep" ) == 0 ) {
- table->case_convert = 0;
- }
- else if( strcmp( option, "upper" ) == 0 ) {
- table->case_convert = 1;
- }
- else if( strcmp( option, "lower" ) == 0 ) {
- table->case_convert = -1;
- }
- else if( strcmp( option, "respect" ) == 0 ) {
- table->strcmp = strcmp;
- table->hash_cmp = hash_cmp;
- }
- else if( strcmp( option, "ignore" ) == 0 ) {
- table->strcmp = strcasecmp;
- table->hash_cmp = hash_casecmp;
- }
- else {
- printf( " Invalid option %s for hash_config\n", option );
- }
-}
-
-
-/*
- * delete a hash table freeing all space
- */
-void hash_destroy( HashTable *table )
-{
- hash_clear( table );
- free( (char*)table->entries );
- free( (char*)table );
-}
-
-
-/*
- * insert the (name,value,tag) data into the hash table
- */
-void hash_insert( HashTable *table,
- const char *name,
- const void *value,
- int tag )
-{
- int h = hashpjw( table, name );
- HashEntry *ent = table->entries[h];
-
- if( table->tag_only )
- value = "";
- else if( value == NULL )
- return;
-
- if( ent == NULL ) {
- /* create a new link head */
- table->nentries++;
- ent = table->entries[h] = (HashEntry*)malloc( sizeof(HashEntry) );
- ent->next = NULL;
- ent->name = strdup( name );
-#ifdef DBMALLOC
- malloc_mark( ent );
- malloc_mark( ent->name );
-#endif
- }
- else {
- /* search through the list */
- HashEntry *prev = ent;
- while( ent != NULL ) {
- if( (*table->strcmp)( ent->name, name ) == 0 ) {
- /* name exists: replace value */
- strcpy( ent->name, name );
- if( table->is_string )
- free( (char*)ent->value );
- break;
- }
- prev = ent;
- ent = ent->next;
- }
- if( ent == NULL ) {
- /* create a new entry */
- table->nentries++;
- ent = prev->next = (HashEntry*)malloc( sizeof(HashEntry) );
- ent->next = NULL;
- ent->name = strdup( name );
-#ifdef DBMALLOC
- malloc_mark( ent );
- malloc_mark( ent->name );
-#endif
- }
- }
- if( table->case_convert > 0 )
- strupper( ent->name );
- else if( table->case_convert < 0 )
- strlower( ent->name );
-
- if( table->is_string ) {
- ent->value = (void*)strdup( (char*)value );
-#ifdef DBMALLOC
- malloc_mark( ent->value );
-#endif
- }
- else {
- ent->value = (void*)value;
- }
- ent->tag = tag;
-}
-
-
-/*
- * delete all hash entries from table
- */
-void hash_clear( HashTable *table )
-{
- int i;
-
- for( i = 0; i < table->size; i++ ) {
- HashEntry *ent = table->entries[i];
-
- while( ent != NULL ) {
- HashEntry *next = ent->next;
-
- free( ent->name );
- if( table->is_string )
- free( (char*)ent->value );
- free( (char*)ent );
- ent = next;
- }
- table->entries[i] = NULL;
- }
- table->nentries = 0;
-}
-
-
-/*
- * delete one entry from the hash table
- */
-void *hash_remove( HashTable *table,
- const char *name )
-{
- int h = hashpjw( table, name );
- HashEntry *ent;
- HashEntry **prev_next = &table->entries[h];
- void *value = NULL;
-
- for( ent = table->entries[h]; ent != NULL; ent = ent->next ) {
-
- if( (*table->strcmp)( ent->name, name ) == 0 ) {
- *prev_next = ent->next;
- free( ent->name );
- if( table->is_string )
- free( (char*)ent->value );
- else if( table->tag_only )
- value = "";
- else
- value = ent->value;
- free( (char*)ent );
- table->nentries--;
- break;
- }
- prev_next = &ent->next;
- }
-
- return value;
-}
-
-
-/*
- * find an entry and return its value
- */
-void *hash_lookup( HashTable *table,
- const char *name,
- int *tag_return )
-{
- int h = hashpjw( table, name );
- HashEntry *ent = table->entries[h];
- void *value = NULL;
-
- while( ent != NULL ) {
- if( (*table->strcmp)( ent->name, name ) == 0 ) {
- value = ent->value;
- if( tag_return != NULL )
- *tag_return = ent->tag;
- break;
- }
- ent = ent->next;
- }
-
- return value;
-}
-
-
-/*
- * return the number of hash entries
- */
-int hash_entries( HashTable *table )
-{
- return table == NULL ? 0 : table->nentries;
-}
-
-
-/*
- * sort all table entries in a linear array
- */
-HashArray *hash_array( HashTable *table )
-{
- HashArray *linear = NULL;
-
- if( table->nentries > 0 ) {
- int n = 0;
- int i;
-
- linear = (HashArray*)malloc( table->nentries * sizeof(HashArray) );
-
- for( i = 0; i < table->size; i++ ) {
- HashEntry *ent = table->entries[i];
-
- while( ent != NULL ) {
- linear[n].name = ent->name;
- linear[n].value = ent->value;
- linear[n].tag = ent->tag;
- n++;
- ent = ent->next;
- }
- }
- qsort( linear, n, sizeof(HashArray), table->hash_cmp );
- }
- return linear;
-}
diff --git a/src/packlib/kuip/code_kuip/kiargc.F b/src/packlib/kuip/code_kuip/kiargc.F
deleted file mode 100644
index c453159..0000000
--- a/src/packlib/kuip/code_kuip/kiargc.F
+++ /dev/null
@@ -1,15 +0,0 @@
-*
-* $Id: kiargc.F,v 1.1.1.1 1996/03/08 15:32:55 mclareni Exp $
-*
-* $Log: kiargc.F,v $
-* Revision 1.1.1.1 1996/03/08 15:32:55 mclareni
-* Kuip
-*
-*
-#include "kuip/pilot.h"
-*CMZ : 2.00/00 01/12/92 18.14.19 by Alfred Nathaniel
-*-- Author : Alfred Nathaniel 01/12/92
- FUNCTION KIARGC()
-*--- C interface to the intrinsic function IARGC
- KIARGC = IARGC()
- END
diff --git a/src/packlib/kuip/code_kuip/kibres.F b/src/packlib/kuip/code_kuip/kibres.F
deleted file mode 100644
index 7c84456..0000000
--- a/src/packlib/kuip/code_kuip/kibres.F
+++ /dev/null
@@ -1,40 +0,0 @@
-*
-* $Id: kibres.F,v 1.1.1.1 1996/03/08 15:32:53 mclareni Exp $
-*
-* $Log: kibres.F,v $
-* Revision 1.1.1.1 1996/03/08 15:32:53 mclareni
-* Kuip
-*
-*
-#include "kuip/pilot.h"
-*CMZ : 2.00/00 03/11/92 14.24.36 by Alfred Nathaniel
-*-- Author :
- SUBROUTINE KIBRES
-*
-#include "kuip/kcmcmd.inc"
-#include "kuip/kcgen2.inc"
-*
-#if defined(CERNLIB_VMS)
- LOGICAL OPENED
- INQUIRE(5,OPENED=OPENED)
- IF (.NOT.OPENED) THEN
- OPEN(5,FILE='TT:',STATUS='OLD')
- ENDIF
- INQUIRE(6,OPENED=OPENED)
- IF (.NOT.OPENED) THEN
- OPEN(6,FILE='TT:',STATUS='OLD')
- ENDIF
-
-#endif
-#if defined(CERNLIB_APOLLO)
- CALL FIO_$RESET
-#endif
-*
-* Call user terminal routine defined by the user with KUTERM
-*
- CALL KUALFA
-*
-999 END
-
-
-
diff --git a/src/packlib/kuip/code_kuip/kiclos.F b/src/packlib/kuip/code_kuip/kiclos.F
deleted file mode 100644
index e18c2cd..0000000
--- a/src/packlib/kuip/code_kuip/kiclos.F
+++ /dev/null
@@ -1,44 +0,0 @@
-*
-* $Id: kiclos.F,v 1.1.1.1 1996/03/08 15:32:53 mclareni Exp $
-*
-* $Log: kiclos.F,v $
-* Revision 1.1.1.1 1996/03/08 15:32:53 mclareni
-* Kuip
-*
-*
-#include "kuip/pilot.h"
-*CMZ : 2.05/15 01/08/94 10.35.04 by Alfred Nathaniel
-*-- Author :
- SUBROUTINE KUCLOS(LUN,STATUS,ISTAT)
- ENTRY KICLOS(LUN,STATUS,ISTAT)
-*
-********************************************************************************
-*
-* To close a file
-*
-* Input :
-*
- CHARACTER*(*) STATUS
- INTEGER LUN, ISTAT
-*
-********************************************************************************
-*
-#if defined(CERNLIB_IBMVM)
- CHARACTER CHLUN*2
-#endif
- IF (STATUS .EQ. ' ') THEN
- CLOSE(LUN,IOSTAT=ISTAT)
- ELSE
- CLOSE(LUN,STATUS=STATUS,IOSTAT=ISTAT)
- ENDIF
-
-#if defined(CERNLIB_IBMVM)
- WRITE(CHLUN,'(I2.2)') LUN
- CALL VMCMS('FILEDEF FT'//CHLUN//'F001 CLEAR',IRC)
-* CALL VMCMS('FILEDEF DF at 000'//CHLUN//' CLEAR',IRC)
-#endif
-
- END
-
-
-
diff --git a/src/packlib/kuip/code_kuip/kicon.c b/src/packlib/kuip/code_kuip/kicon.c
deleted file mode 100644
index 6a460dd..0000000
--- a/src/packlib/kuip/code_kuip/kicon.c
+++ /dev/null
@@ -1,224 +0,0 @@
-/*
- * $Id: kicon.c,v 1.1.1.1 1996/03/08 15:32:56 mclareni Exp $
- *
- * $Log: kicon.c,v $
- * Revision 1.1.1.1 1996/03/08 15:32:56 mclareni
- * Kuip
- *
- */
-/*CMZ : 2.07/06 14/06/95 15.23.01 by Gunter Folger*/
-/*-- Author : Alfred Nathaniel 06/11/92*/
-/* kicon.c: browser icons */
-
-#include "kuip/kuip.h"
-#include "kuip/kfor.h"
-#include "kuip/klink.h"
-#include "kuip/kmenu.h"
-#include "kuip/kflag.h"
-#include "kuip/kbrow.h"
-
-
-static KmIcon *kmicons; /* list of icon bitmaps */
-
-EXTERN char cdf_def[80], cdf_value[80];
-
-
-/*
- * action routine for /MOTIF/ICON
- */
-int kxicon()
-{
- char *icon_name = ku_gets();
- char *file_name = ku_getf();
-
- if( strcmp( icon_name, "*" ) == 0 )
- icon_name = NULL;
-
- if( km_icon( icon_name, file_name ) == 0 )
- return -1;
- else
- return 0;
-}
-
-
-/*
- * read bitmap data from file and store icon definition
- * if icon_name == NULL use name in file
- * return the number of bitmaps read in
- */
-int km_icon( icon_name, fname )
- const char *icon_name;
- const char *fname;
-{
- FILE *stream;
-
- if( (stream = fopen( fname, "r" )) == NULL ) {
- printf( " *** /MOTIF/ICON: cannot open file %s\n", fname );
- return -1;
- }
- else {
- KmIcon *icon;
- KmIcon *kmicn;
- char line[1024];
- char *word1;
- char *word2;
- char *word3;
- char *p;
- int nline = 0;
- int nicons = 0;
-
- again:
- icon = (KmIcon*)malloc( sizeof(KmIcon) );
-
- while( fgets( line, (sizeof line), stream ) != NULL ) {
- nline++;
- word1 = strtok( line, " " );
-
- if( word1 != NULL && strcmp( word1, "#define" ) == 0 ) {
-
- word2 = strtok( NULL, " " );
- word3 = strtok( NULL, " " );
-
- if( word3 == NULL || (p = strrchr( word2, '_' )) == NULL
- || strcmp( p, "_width" ) != 0
- || (icon->width = atoi( word3 )) <= 0 ) {
-
- printf( " *** MOTIF/ICON: invalid width in line %d of %s\n",
- nline, fname );
- free( (char*)icon );
- fclose( stream );
- return nicons;
- }
-
- if( icon_name == NULL ) {
- *p = '\0';
- icon->name = strdup( word2 );
- }
- else {
- icon->name = strdup( icon_name );
- }
-
- fgets( line, (sizeof line), stream );
- nline++;
- word1 = strtok( line, " " );
- word2 = strtok( NULL, " " );
- word3 = strtok( NULL, " " );
-
- if( word3 == NULL || (p = strrchr( word2, '_' )) == NULL
- || strcmp( p, "_height" ) != 0
- || (icon->height = atoi( word3 )) <= 0 ) {
-
- printf( " *** MOTIF/ICON: invalid height in line %d of %s\n",
- nline, fname );
- free( icon->name );
- free( (char*)icon );
- fclose( stream );
- return nicons;
- }
-
- while( fgets( line, (sizeof line), stream ) != NULL ) {
- nline++;
- word1 = strtok( line, " " );
- if( word1 != NULL && strcmp( word1, "static" ) == 0 ) {
- int nbytes = ( ( icon->width - 1 ) / 8 + 1 ) * icon->height;
- int n = 0;
-
- icon->bitmap = malloc( nbytes );
- p = NULL;
- while( n < nbytes ) {
-
- if( p != NULL ) {
- p = strtok( NULL, " ,};\n" );
- }
- if( p == NULL ) {
- nline++;
- if( fgets( line, (sizeof line), stream ) == NULL ) {
- printf( " *** MOTIF/ICON: unexpected EOF in line %d of %s\n",
- nline, fname );
- free( icon->name );
- free( icon->bitmap );
- free( (char*)icon );
- fclose( stream );
- return nicons;
- }
- p = strtok( line, " ,};\n" );
- }
- icon->bitmap[n] = strtol( p, NULL, 0 );
- n++;
- }
-
- for( kmicn = kmicons; kmicn != NULL; kmicn = kmicn->next ) {
- if( strcasecmp( kmicn->name, icon->name ) == 0 ) {
- /* redefinition of icon */
- kmicn->width = icon->width;
- kmicn->height = icon->height;
- kmicn->bitmap = icon->bitmap;
- kmicn->pix = 0;
- kmicn->hi_pix = 0;
- free( icon->name );
- free( (char*)icon );
- break;
- }
- if( kmicn->next == NULL ) {
- /* add new icon at end of list */
- icon->next = NULL;
- icon->pix = 0;
- icon->hi_pix = 0;
- kmicn->next = icon;
- break;
- }
- }
- nicons++;
- if( icon_name == NULL ) {
- goto again;
- }
- fclose( stream );
- return nicons;
- }
- }
- free( icon->name );
- }
- }
- if( nicons == 0 ) {
- printf( " *** MOTIF/ICON: invalid file content of %s\n", fname );
- }
- free( (char*)icon );
- fclose( stream );
- return nicons;
- }
-}
-
-
-/*
- * add to the list of icons
- */
-void klnkicon( KmIcon *kmicn_list,
- int version )
-{
- strcpy ( cdf_def, "Icon" );
- strcpy ( cdf_value, kmicn_list->name );
- check_version( version, KUIP_VERSION );
-
- if( kmicons == NULL )
- kmicons = kmicn_list;
- else {
- KmIcon *kmicn = kmicons;
- while( kmicn->next != NULL )
- kmicn = kmicn->next;
- kmicn->next = kmicn_list;
- }
-}
-
-
-/*
- * return pointer to bitmap data or NULL if name not found
- */
-KmIcon *find_kmicon( const char *kmicn_name )
-{
- KmIcon *kmicn;
-
- for( kmicn = kmicons; kmicn != NULL; kmicn = kmicn->next )
- if( strcasecmp( kmicn->name, kmicn_name ) == 0 )
- break;
- return kmicn;
-}
diff --git a/src/packlib/kuip/code_kuip/kictoi.F b/src/packlib/kuip/code_kuip/kictoi.F
deleted file mode 100644
index dbc790f..0000000
--- a/src/packlib/kuip/code_kuip/kictoi.F
+++ /dev/null
@@ -1,56 +0,0 @@
-*
-* $Id: kictoi.F,v 1.1.1.1 1996/03/08 15:32:53 mclareni Exp $
-*
-* $Log: kictoi.F,v $
-* Revision 1.1.1.1 1996/03/08 15:32:53 mclareni
-* Kuip
-*
-*
-#include "kuip/pilot.h"
-*CMZ : 1.61/01 22/06/89 17.34.30 by
-*-- Author :
- SUBROUTINE KICTOI(CVAL,IVAL)
-*
-********************************************************************************
-*
-* Convert character string CVAL into integer value IVAL
-*
-* Input :
-*
- CHARACTER*(*) CVAL
-*
-* Output :
-*
- INTEGER IVAL
-*
-********************************************************************************
-*
-#include "kuip/kcques.inc"
- PARAMETER (MAXDIG=15)
- CHARACTER*(MAXDIG) CHTEMP,BLANK
-*
- IQUEST(1)=0
- L=LENOCC(CVAL)
- IF (L.EQ.0) GO TO 999
- IF (L.GT.MAXDIG) THEN
- IQUEST(1)=1
- GO TO 999
- ENDIF
- DO 10 I=1,L
- IF ((CVAL(I:I).LT.'0'.OR.CVAL(I:I).GT.'9').AND.
- + CVAL(I:I).NE.'+'.AND.CVAL(I:I).NE.'-'.AND.
- + CVAL(I:I).NE.' ') GO TO 100
-10 CONTINUE
- BLANK=' '
- IF (L.EQ.MAXDIG) THEN
- CHTEMP=CVAL
- ELSE
- CHTEMP=BLANK(:MAXDIG-L)//CVAL
- ENDIF
- READ (CHTEMP,'(I15)',ERR=100) IVAL
- GO TO 999
-100 IQUEST(1)=1
-999 END
-
-
-
diff --git a/src/packlib/kuip/code_kuip/kicton.F b/src/packlib/kuip/code_kuip/kicton.F
deleted file mode 100644
index 624d3f9..0000000
--- a/src/packlib/kuip/code_kuip/kicton.F
+++ /dev/null
@@ -1,130 +0,0 @@
-*
-* $Id: kicton.F,v 1.1.1.1 1996/03/08 15:32:53 mclareni Exp $
-*
-* $Log: kicton.F,v $
-* Revision 1.1.1.1 1996/03/08 15:32:53 mclareni
-* Kuip
-*
-*
-#include "kuip/pilot.h"
-*CMZ : 1.61/06 17/07/89 17.29.18 by
-** Replaced format descriptor G15.9 by G15.7
-*-- Author :
- SUBROUTINE KICTON(CVAL,IVAL,RVAL)
-*
-********************************************************************************
-*
-* Convert character string CVAL into integer value IVAL or real value RVAL
-*
-* IQUEST(1) is returned <> 0 if a conversion error occurred
-* IQUEST(2) is returned <> 0 if the number is out of the integer range
-* (i.e. it can be read only from RVAL and not from IVAL)
-*
-* Input :
-*
- CHARACTER*(*) CVAL
-*
-* Output :
-*
- INTEGER IVAL
- REAL RVAL
-*
-********************************************************************************
-*
-#include "kuip/kcques.inc"
- PARAMETER (MAXDIG=15)
- CHARACTER*(MAXDIG) CHTEMP,BLANK
- PARAMETER (MAXINT=2147483647)
-*
- IQUEST(1)=0
- IQUEST(2)=0
- IQUEST(14)=0
-
- L=LENOCC(CVAL)
- IF (L.EQ.0) GO TO 999
-
- IF (L.GT.MAXDIG) GO TO 900
-
- BLANK=' '
- IF (L.EQ.MAXDIG) THEN
- CHTEMP=CVAL
- ELSE
- CHTEMP=BLANK(:MAXDIG-L)//CVAL
- ENDIF
-
- CALL CLTOU(CHTEMP)
-
- I1=INDEX(CHTEMP(MAXDIG-L+1:),'E')
-
- IF (I1.EQ.1) I1=0
- IF (I1.GT.0) THEN
- DO 10 I=MAXDIG-L+1,MAXDIG-L+I1-1
- IF ((CHTEMP(I:I).LT.'0'.OR.CHTEMP(I:I).GT.'9').AND.
- + CHTEMP(I:I).NE.'+'.AND.CHTEMP(I:I).NE.'-'.AND.
- + CHTEMP(I:I).NE.' '.AND.CHTEMP(I:I).NE.'.') GO TO 900
-10 CONTINUE
- ENDIF
-
- I2=INDEX(CHTEMP(MAXDIG-L+1:),'+')
- I3=INDEX(CHTEMP(MAXDIG-L+1:),'-')
- IF (I2.GT.1.AND.I1.EQ.0) GO TO 900
- IF (I3.GT.1.AND.I1.EQ.0) GO TO 900
-
- IF (L.EQ.1) THEN
- IF (CHTEMP(MAXDIG:MAXDIG).EQ.'E') GO TO 900
- IF (CHTEMP(MAXDIG:MAXDIG).EQ.'-') GO TO 900
- IF (CHTEMP(MAXDIG:MAXDIG).EQ.',') GO TO 900
- IF (CHTEMP(MAXDIG:MAXDIG).EQ.'.') GO TO 900
- IF (CHTEMP(MAXDIG:MAXDIG).EQ.'+') GO TO 900
- ENDIF
-
- L=MAXDIG
-
- I1 =INDEX(CHTEMP,'.')
- II1=0
- IF (I1.LT.L) II1=INDEX(CHTEMP(I1+1:),'.')
- I2=INDEX(CHTEMP,'E')
- II2=0
- IF (I2.LT.L) II2=INDEX(CHTEMP(I2+1:),'E')
-
- IF (II1+II2.NE.0) GO TO 900
-
- IF (I1+I2.EQ.0) THEN
- CALL KICTOI(CHTEMP,IVAL)
- IQUEST(14)=2
- RVAL=IVAL
- GO TO 999
- ENDIF
-
- IF (I1.EQ.L.AND.I2.EQ.0) THEN
- CALL KICTOI(CHTEMP(:I1-1),IVAL)
- IQUEST(14)=2
- RVAL=IVAL
- GO TO 999
- ENDIF
-
- IF (I2.GT.0.AND.I1.EQ.0) THEN
- BLANK(:I2-2)=CHTEMP(2:I2-1)
- BLANK(I2-1:I2-1)='.'
- BLANK(I2:)=CHTEMP(I2:)
- CHTEMP=BLANK
- ENDIF
-
- READ (CHTEMP,'(G15.7)',END=999,ERR=900) RVAL
- IQUEST(14)=1
- IF (ABS(RVAL).LT.MAXINT) THEN
- IVAL=RVAL
- ELSE
- IQUEST(2)=1
- ENDIF
- GO TO 999
-
-900 IQUEST(1)=1
- GO TO 999
-
-999 CONTINUE
-
- END
-
-
-
diff --git a/src/packlib/kuip/code_kuip/kidate.F b/src/packlib/kuip/code_kuip/kidate.F
deleted file mode 100644
index 1d2c969..0000000
--- a/src/packlib/kuip/code_kuip/kidate.F
+++ /dev/null
@@ -1,51 +0,0 @@
-*
-* $Id: kidate.F,v 1.2 1998/11/10 13:42:19 couet Exp $
-*
-* $Log: kidate.F,v $
-* Revision 1.2 1998/11/10 13:42:19 couet
-* - Y2K
-*
-* Revision 1.1.1.1 1996/03/08 15:32:53 mclareni
-* Kuip
-*
-*
-#include "kuip/pilot.h"
-*CMZ : 1.61/01 22/06/89 17.34.30 by
-*-- Author :
- SUBROUTINE KIDATE(CHDATE,CHTIME)
-*
-********************************************************************************
-*
-* Get the current date and time
-*
-* Output :
-*
- CHARACTER*(*) CHDATE
- CHARACTER*(*) CHTIME
-*
-********************************************************************************
-*
- COMMON /SLATE/ ISL(40)
- CALL DATIME(ID,IT)
- IYEAR = ISL(1)
- IMONTH = ISL(2)
- IDAY = ISL(3)
- IHOUR = ISL(4)
- IMIN = ISL(5)
- ISEC = ISL(6)
-*
- CHDATE = ' '
- WRITE (CHDATE(1:2),'(I2.2)') IDAY
- CHDATE(3:3) = '/'
- WRITE (CHDATE(4:5),'(I2.2)') IMONTH
- CHDATE(6:6) = '/'
- WRITE (CHDATE(7:10),'(I4.4)') IYEAR
-*
- CHTIME = ' '
- WRITE (CHTIME(1:2),'(I2.2)') IHOUR
- CHDATE(3:3) = '.'
- WRITE (CHTIME(4:5),'(I2.2)') IMIN
- CHDATE(6:6) = '.'
- WRITE (CHTIME(7:8),'(I2.2)') ISEC
-*
- END
diff --git a/src/packlib/kuip/code_kuip/kienbr.c b/src/packlib/kuip/code_kuip/kienbr.c
deleted file mode 100644
index 6e72614..0000000
--- a/src/packlib/kuip/code_kuip/kienbr.c
+++ /dev/null
@@ -1,772 +0,0 @@
-/*
- * $Id: kienbr.c,v 1.4 1997/11/28 17:26:58 mclareni Exp $
- *
- * $Log: kienbr.c,v $
- * Revision 1.4 1997/11/28 17:26:58 mclareni
- * Numerous mods and some new routines to get Control-C working reasonably on NT
- *
- * Revision 1.3 1997/10/23 16:53:56 mclareni
- * NT mods
- *
- * Revision 1.2 1997/03/17 16:54:58 mclareni
- * WNT mods
- *
- * Revision 1.1.1.1.2.1 1997/01/21 11:32:46 mclareni
- * All mods for Winnt 96a on winnt branch
- *
- * Revision 1.1.1.1 1996/03/08 15:32:57 mclareni
- * Kuip
- *
- */
-/*CMZ : 2.05/17 19/09/94 14.17.23 by Alfred Nathaniel*/
-/*-- Author : Alfred Nathaniel 19/05/92*/
-
-#include "kuip/kuip.h"
-#include "kuip/kfor.h"
-#include "kuip/kcom.h"
-#include "kuip/ksig.h"
-#include "kuip/klink.h"
-#include "kuip/kmenu.h"
-#include "kuip/kflag.h"
-
-static void keyboard_interrupt(void);
-
-#ifdef WIN32
-/* fphandler handles SIGFPE (floating-point error) interrupt. Note
- * that this prototype accepts two arguments and that the
- * prototype for signal in the run-time library expects a signal
- * handler to have only one argument.
- *
- * The second argument in this signal handler allows processing of
- * _FPE_INVALID, _FPE_OVERFLOW, _FPE_UNDERFLOW, and
- * _FPE_ZERODIVIDE, all of which are Microsoft-specific symbols
- * that augment the information provided by SIGFPE. The compiler
- * will generate a warning, which is harmless and expected.
- *
- */
-void fphandler( int sig, int num )
-{
- /* Set global for outside check since we don't want
- * to do I/O in the handler.
- */
- kc_break.fperr = num;
- /* Initialize floating-point package. */
- _fpreset();
- /* Restore calling environment and jump back to setjmp. Return
- * -1 so that setjmp will return false for conditional test.
- */
- signal_handler( sig );
-}
-#endif
-
-
-#ifndef vms
-
-/*
- * catch exceptions and longjmp back to command input loop
- */
-void signal_handler( int sig )
-{
- int do_traceback = 1;
-
-#if defined(SIGNAL_V7)
- if( sig != 0 )
-#ifdef WIN32
- if (sig == SIGFPE)
- {
-/* Unmask all float-point exception. */
- _control87(0, _MCW_EM);
-/* Set up the floating-point error handler. The compiler
- * will generate a warning because it expects
- * signal-handling functions to take only one parameter
- */
- if (signal(SIGFPE,fphandler) == SIG_ERR )
- {
- fprintf(stderr, "Couldn't set SIGFPE\n");
- abort();
- }
- }
- else if (sig != SIGINT)
-#endif
- signal( sig, signal_handler ); /* has been set to SIG_DFL */
-#endif
-
- if( sig == SIGINT && !kc_break.intr_enabled ) {
- kc_break.intr_pending = 1;
- keyboard_interrupt();
- return;
- }
-
-#if defined(USE_EDIT_SERVER)
- if( sig == SIGUSR1 ) { /* from edit server */
- kc_flags.editor_exit = 1;
- return;
- }
-#endif
-
-#ifdef SIGUSR2
- if( sig == SIGUSR2 ) { /* from kxterm for a soft interrupt */
- kc_break.soft_intr = 1;
- if( kc_break.piaf_sync != NULL ) {
- /* tell the Piaf server about the interrupt */
- (*kc_break.piaf_sync)( kc_break.sockfd, "\4" );
- }
- return;
- }
-#endif
-
- Kibres(); /* cleanup Fortran I/O */
-
- ku_alfa();
- printf( "\n *** Break *** " );
-
- switch( sig ) {
- case 0:
- puts( "Simulated break" );
- do_traceback = kc_break.traceback;
- break;
- case SIGINT:
- puts( "Keyboard interrupt" );
- keyboard_interrupt();
- do_traceback = kc_break.traceback;
- break;
- case SIGFPE:
-#ifdef WIN32
-/*
- * MS says:
- * =======
- * Do not issue low-level
- * or STDIO.H I/O routines (such as printf and fread).
- *
- */
- if( kc_break.jump_set )
- siglongjmp( kc_break.stack, -1 );
-#endif
- puts( "Floating point exception" );
- break;
- case SIGILL:
- puts( "Illegal instruction" );
- break;
- case SIGSEGV:
- puts( "Segmentation violation" );
- break;
-#ifdef SIGBUS
- case SIGBUS:
- puts( "Bus error" );
- break;
-#endif
- default:
- printf( "Unknown signal %d\n", sig );
- }
-
- if( kc_flags.use_kxterm ) {
- /*
- * Send STX (start-transmission) character to tell kxterm we are
- * ready for a next command.
- */
- printf("\2");
- }
-
-#ifdef HPUX
- if( do_traceback ) {
- extern void U_STACK_TRACE(); /* somewhere in Fortran RTL */
- U_STACK_TRACE();
- do_traceback = 0;
- }
-#endif
-
- if( do_traceback ) {
- INTEGER lun = 0;
- INTEGER level = 99;
- printf(" Traceq lun = %d, level = %d \n", lun, level);
- Traceq( &lun, &level ); /* KERNLIB traceback */
- }
-
- if( kc_break.jump_set ) {
- printf(" Longjump \n");
-#ifdef WIN32
- if (sig == SIGINT)
- return;
-#endif
- siglongjmp( kc_break.stack, 1 );
- }
- printf( "Signal %d caught without longjmp target\n", sig );
- exit( 1 );
-}
-
-#else
-
-int signal_handler( const void *sigarr, const void *mecharr )
-{
- const int *sigvec = sigarr;
- int cond = $VMS_STATUS_COND_ID( sigvec[1] );
- int do_traceback = 1;
-
- Kibres(); /* cleanup Fortran I/O */
-
- ku_alfa();
- if( !kc_break.trap_enabled ) {
- return SS$_RESIGNAL;
- }
- if( cond == $VMS_STATUS_COND_ID( SS$_UNWIND ) ) {
- return SS$_RESIGNAL;
- }
- if( cond == $VMS_STATUS_COND_ID( SS$_CONTROLC )
- || cond == $VMS_STATUS_COND_ID( SS$_DEBUG ) ) {
- if( kc_break.intr_enabled ) {
- keyboard_interrupt();
- }
- else {
- kc_break.intr_pending = 1;
- return SS$_CONTINUE;
- }
- if( cond == $VMS_STATUS_COND_ID( SS$_DEBUG ) )
- do_traceback = 0;
- else
- do_traceback = kc_break.traceback;
- }
-
- if( do_traceback ) {
- lib$signal( 0 );
- }
- else if( sigvec[1] == 0 ) {
- printf( "\n *** Break *** Simulated break\n" );
- }
- else if( cond == $VMS_STATUS_COND_ID( SS$_CONTROLC ) ) {
- printf( "\n *** Break *** Keyboard interrupt\n" );
- }
- else {
- sys$putmsg( sigarr );
- }
-
- if( kc_flags.use_kxterm ) {
- /*
- * Send STX (start-transmission) character to tell kxterm we are
- * ready for a next command.
- */
- printf("\2");
- fflush( stdout ); /* otherwise VMS wouldn't see it */
- }
- printf( "\n" );
- lib$sig_to_ret( sigarr, mecharr );
- return SS$_CONTINUE;
-}
-
-
-int control_C_ast( int which )
-{
- static int installed = 0;
- int was_installed = installed;
- int istat;
-
- if( kc_flags.use_kxterm ) {
- /*
- * We cannot simply send a signal from kxterm to the main process.
- * Instead we create a lock with a blocking AST.
- * Upon ^C kxterm requesting the same lock triggers a call to the AST
- * from where we can signal the ^C.
- */
- static int sigint_lock[2];
- static int kxterm_lock[2];
-
- if( sigint_lock[1] == 0 ) { /* create lock */
- char lock_name[32];
- struct dsc$descriptor_s lock;
-
- sprintf( lock_name, "SIGINT%d", getpid() );
- var_descriptor( lock, lock_name );
- istat = sys$enqw( 0, LCK$K_NLMODE, sigint_lock, 0,
- &lock, 0, NULL, SIGINT, control_C_ast, PSL$C_USER, 0 );
- if( istat != SS$_NORMAL )
- lib$signal( istat );
-
- sprintf( lock_name, "KXTERM%d", getpid() );
- var_descriptor( lock, lock_name );
- istat = sys$enqw( 0, LCK$K_NLMODE, kxterm_lock, 0,
- &lock, 0, NULL, 0, NULL, PSL$C_USER, 0 );
- if( istat != SS$_NORMAL )
- lib$signal( istat );
- }
-
- switch( which ) {
-
- case 0: /* release lock */
- istat = sys$enqw( 0, LCK$K_NLMODE, sigint_lock, LCK$M_CONVERT,
- NULL, 0, NULL, SIGINT, control_C_ast, PSL$C_USER, 0 );
- if( istat != SS$_NORMAL )
- lib$signal( istat );
- break;
-
- case 1: /* grab lock */
- istat = sys$enqw( 0, LCK$K_EXMODE, sigint_lock, LCK$M_CONVERT,
- NULL, 0, NULL, SIGINT, control_C_ast, PSL$C_USER, 0 );
- if( istat != SS$_NORMAL )
- lib$signal( istat );
- break;
-
- case SIGINT:
- /*
- * release lock that kxterm can get it
- * then grab it again and signal ^C
- */
- istat = sys$enqw( 0, LCK$K_NLMODE, sigint_lock, LCK$M_CONVERT,
- NULL, 0, NULL, SIGINT, control_C_ast, PSL$C_USER, 0 );
- if( istat != SS$_NORMAL )
- lib$signal( istat );
-
- /*
- * If we were to convert the SIGINT lock back to exclusive access
- * immediately the kxterm process might not get it granted first.
- * In VMS 6.0 the is a new flag LCK$M_QUECVT to queue the lock
- * conversion after any other waiting request.
- * To work on earlier VMS versions we need a second lock to synchronize
- * the access with kxterm.
- */
- istat = sys$enqw( 0, LCK$K_EXMODE, kxterm_lock, LCK$M_CONVERT,
- NULL, 0, NULL, 0, NULL, PSL$C_USER, 0 );
- if( istat != SS$_NORMAL )
- lib$signal( istat );
-
- istat = sys$enqw( 0, LCK$K_NLMODE, kxterm_lock, LCK$M_CONVERT,
- NULL, 0, NULL, 0, NULL, PSL$C_USER, 0 );
- if( istat != SS$_NORMAL )
- lib$signal( istat );
-
- istat = sys$enqw( 0, LCK$K_EXMODE, sigint_lock, LCK$M_CONVERT,
- NULL, 0, NULL, SIGINT, control_C_ast, PSL$C_USER, 0 );
- if( istat != SS$_NORMAL )
- lib$signal( istat );
-
- lib$signal( SS$_CONTROLC );
- break;
- }
-
- installed = which;
- }
-
- else if( kc_window.is_a_tty ) {
-
- static short ttchan = -1;
-
- if( ttchan == -1 ) { /* get a channel to the terminal device */
- struct dsc$descriptor_s ttname;
- var_descriptor( ttname, "TT:" );
-
- istat = sys$assign( &ttname, &ttchan, 0, 0 );
- if( istat != SS$_NORMAL )
- lib$signal( istat );
- }
-
- switch( which ) {
-
- case 0: /* deinstall ASTs */
- if( installed ) {
- istat = sys$cancel( ttchan );
- if( istat != SS$_NORMAL )
- lib$signal( istat );
- break;
- }
-
- case 1: /* install ASTs */
- if( !installed ) {
- istat = sys$qio( 0, ttchan, IO$_SETMODE | IO$M_CTRLCAST, 0, 0, 0,
- control_C_ast, SIGINT, PSL$C_USER, 0, 0, 0 );
- if( istat != SS$_NORMAL )
- lib$signal( istat );
- }
- break;
-
- case SIGINT: /* ^C typed: reinstall AST */
- istat = sys$qio( 0, ttchan, IO$_SETMODE | IO$M_CTRLCAST, 0, 0, 0,
- control_C_ast, SIGINT, PSL$C_USER, 0, 0, 0 );
- if( istat != SS$_NORMAL )
- lib$signal( istat );
-
- /* there could be a problem if we interrupted a printf() */
- freopen( "SYS$OUTPUT", "w", stdout );
-
- lib$signal( SS$_CONTROLC );
- break;
- }
-
- installed = which;
- }
-
- return was_installed;
-}
-
-#endif /* vms */
-
-
-/*
- * Handling of Control-C
- */
-static
-void keyboard_interrupt()
-{
- if( kc_break.intr_enabled && kc_break.piaf_sync != NULL ) {
- /* resynchronize the communication with the Piaf server */
- (*kc_break.piaf_sync)( kc_break.sockfd, "\3" );
- }
-
- if( ++kc_break.intr_count >= 3 ) {
- if( kjmpaddr.disp_select_C != NULL ) {
- static char *labels[] = { "Yes", "No" };
- if( (*kjmpaddr.disp_select_C)( 4,
- "You keep hitting ^C --- do you want to exit ?",
- (sizeof labels)/sizeof(char*), labels, 2 ) != 1 )
- return;
- }
- else {
- const char *answer = ku_proc(
- "You keep hitting ^C --- do you want to exit (Yes/<CR>=No)?", NULL );
- if( answer[0] != 'Y' )
- return;
- }
- printf( " *** Exiting ***\n" );
- exit( 1 );
- }
-}
-
-
-/*
- * define the synchronization routine to be called after a keyboard interrupt
- */
-void ku_piaf( int sockfd,
- void (*piaf_sync)() )
-{
- kc_break.sockfd = sockfd;
- kc_break.piaf_sync = piaf_sync;
-}
-
-
-/*
- * enable signal catching or restore default signal action
- */
-void ku_trap( int enable,
- int traceback )
-{
-#ifndef vms
-
- static int siglist[] = { SIGINT
-# ifdef SIGBUS
- ,SIGBUS /* unaligned access on many machines */
-# endif
-# ifdef FATAL_SIGFPE
- ,SIGFPE /* catch only if fatal */
-# endif
-# ifdef SIGUSR2
- ,SIGUSR2 /* soft interrupt */
-# endif
- ,SIGSEGV
- };
-
- int i;
-
-# ifdef SIGNAL_POSIX
- struct sigaction act;
-
- sigemptyset( &act.sa_mask );
- act.sa_flags = 0;
- act.sa_handler = signal_handler;
-
-# ifdef USE_EDIT_SERVER
- sigaction( SIGUSR1, &act, NULL ); /* handler for edit server always there */
-# endif
-
- if( !enable ) /* reset handler */
- act.sa_handler = SIG_DFL;
-
- for( i = 0; i < sizeof siglist / sizeof( int ); i++ )
- sigaction( siglist[i], &act, NULL );
-
-# endif /* SIGNAL_POSIX */
-
-
-# ifdef SIGNAL_BSD
- /* VMS provides BSD like signal semantics */
- struct sigvec vec;
-
- vec.sv_flags = 0;
- vec.sv_mask = 0;
- vec.sv_handler = (enable ? signal_handler : SIG_DFL);
-
- for( i = 0; i < sizeof siglist / sizeof( int ); i++ )
- sigvec( siglist[i], &vec, NULL );
-
-# endif /* SIGNAL_BSD */
-
-
-# ifdef SIGNAL_V7
-
-# ifdef IBM370
- /* C/370 provide V7 like signal semantics */
-
- INTEGER underflow = enable ? 0 : 1;
- Xuflow( &underflow ); /* set interrupts from floating underflows */
-# endif
-
- for( i = 0; i < sizeof siglist / sizeof( int ); i++ )
-#ifdef WIN32
- if (siglist[i] == SIGINT)
- SetConsoleCtrlHandler((PHANDLER_ROUTINE)ConsoleSigHandler,enable ? TRUE : FALSE);
- else
-#endif
- signal( siglist[i], enable ? signal_handler : SIG_DFL );
-
-# endif /* SIGNAL_V7 */
-
-#else /* vms */
-
- control_C_ast( enable );
-
-#endif /* vms */
-
- kc_break.trap_enabled = enable;
- kc_break.intr_enabled = enable;
- kc_break.intr_pending = 0;
- if( traceback >= 0 )
- kc_break.traceback = traceback;
-}
-
-
-#ifdef WIN32_OLD
-//______________________________________________________________________________
-BOOL ConsoleSigHandler(DWORD sig)
-{
-
- // WinNT signal handler for Console events (by V.Fine 19.12.96 JINR, Dubna)
-
- switch (sig) {
- case CTRL_C_EVENT:
- case CTRL_BREAK_EVENT:
- case CTRL_LOGOFF_EVENT:
- case CTRL_SHUTDOWN_EVENT:
- case CTRL_CLOSE_EVENT:
- signal_handler( SIGINT );
- default:
- return FALSE;
- }
-}
-#endif
-
-/*
- * allow or block trapping of keyboard interrupts
- */
-int ku_intr( int enable )
-{
- int old_enable = kc_break.intr_enabled;
-
- kc_break.intr_enabled = enable;
-
- if( enable && kc_break.intr_pending ) {
- kc_break.intr_pending = 0;
-#ifdef WIN32
- GenerateConsoleCtrlEvent(CTRL_C_EVENT,0); /* VF. 19.11.97 */
-#else
-# ifndef vms
- raise( SIGINT );
-# else
- lib$signal( SS$_CONTROLC );
-# endif
-#endif /* WIN32 */
- }
-
- return old_enable;
-}
-
-
-/*
- * allow SIGINT delivery
- */
-void F77_ENTRY(Kubron)
-/* { */
- ku_intr( 1 );
-}
-
-
-/*
- * block SIGINT delivery
- */
-INTEGER F77_ENTRY(Kubrof)
-/* { */
- return ku_intr( 0 );
-}
-
-
-/*
- * simulate a break
- */
-void ku_sibr()
-{
-#ifndef vms
- signal_handler( 0 );
-#else
- lib$signal( 0 );
-#endif
-}
-
-void F77_ENTRY(Kusibr)
-/* { */
- ku_sibr();
-}
-
-
-/*
- * test the soft interrupt flag
- */
-INTEGER F77_ENTRY(Kustop)
-/* { */
- return kc_break.soft_intr;
-}
-
-
-/*
- * set or test the soft interrupt flag
- */
-int ku_stop( int set )
-{
- if( set )
- kc_break.soft_intr = 1;
- return kc_break.soft_intr;
-}
-
-
-/*
- * action routine for /KUIP/SET_SHOW/BREAK
- */
-int kxbreak()
-{
- char *set_ON = "ON";
- char *set_OFF = "OFF";
- char *set_TB = "TB";
- char *value = ku_getc();
-
- ku_alfa();
-
- if( strcmp( value, "?" ) == 0 ) {
- printf( " Current break is %s\n", kc_value.set_break );
- }
- else {
- if( strcmp( value, set_ON ) == 0 ) {
- ku_trap( 1, 0 );
- kc_value.set_break = set_ON;
- }
- else if( strcmp( value, "TB" ) == 0 ) {
- ku_trap( 1, 1 );
- kc_value.set_break = set_TB;
- }
- else {
- ku_trap( 0, 0 );
- kc_value.set_break = set_OFF;
- }
- F77_CALL_C(Kierrf,value,strlen(value));
- }
- return 0;
-}
-
-
-#ifdef IBM370
-/*
- * Exit routine for IBM Extended Error Handling Facility
- */
-void Errrun( iretcd, ierr )
- INTEGER *iretcd;
- INTEGER *ierr;
-{
- int ierno = *ierr;
- char *msg;
-
- switch( ierno ) {
- case 180:
- msg = "File name has more than 8 characters";
- break;
- case 203:
- msg = "Invalid implied DO-loop in READ/WRITE statement";
- break;
- case 204:
- msg = "Item size exceeds buffer length";
- break;
- case 206:
- msg = "Integer number out of range";
- break;
- case 207:
- msg = "Exponent overflow";
- break;
- case 208:
- msg = "Exponent underflow";
- break;
- case 209:
- msg = "Divide by zero";
- break;
- case 210:
- msg = "Program exception";
- break;
- case 211:
- msg = "Invalid FORMAT statement";
- break;
- case 212:
- msg = "Formatted I/O, end of record (text files must be RECFM F LRECL 80)";
-#ifdef NEWLIB
- ierno = 0; /* Avoid message problems with VB card format files */
-#endif
- break;
- case 213:
- msg = "I/O list greater than logical record";
- break;
- case 215:
- msg = "Illegal decimal character";
- ierno = 0; /* ignore */
- break;
- case 217:
- msg = "End of data during READ";
-#ifdef IBMMVS
- ierno = 0; /* Avoid message problems with history */
-#endif
- break;
- case 219:
- msg = "Data set with no DD statement or DD statement with incorrect DDNAME";
- break;
- case 220:
- msg = "Logical unit number out of range";
- break;
- case 225:
- msg = "Illegal hexadecimal character";
- break;
- case 226:
- msg = "Real number out of range";
- break;
- case 227:
- msg = "Invalid repeat count";
- break;
- case 228:
- msg = "Last item in I/O list has lower address than first element";
- break;
- case 251:
- msg = "Negative argument of SQRT";
- break;
- case 252:
- msg = "Argument greater than 174.673 in EXP";
- break;
- default:
- msg = "Unknown message";
- }
- if( ierno != 0 ) {
- /* cannot call kualfa for GKS if error is Fortran I/O related */
- char *line = strdup( " *** AFB" );
- line = mstricat( line, ierno );
- line = mstr2cat( line, "I: ", msg );
- if( kc_break.error_msg == NULL )
- kc_break.error_msg = line;
- else {
- kc_break.error_msg = mstr2cat( kc_break.error_msg, "\n", line );
- free( line );
- }
- }
-
- IQUEST(1) = ierno;
- *iretcd = 0;
-}
-#endif
-
-
diff --git a/src/packlib/kuip/code_kuip/kierrf.F b/src/packlib/kuip/code_kuip/kierrf.F
deleted file mode 100644
index 163e2e8..0000000
--- a/src/packlib/kuip/code_kuip/kierrf.F
+++ /dev/null
@@ -1,39 +0,0 @@
-*
-* $Id: kierrf.F,v 1.1.1.1 1996/03/08 15:32:55 mclareni Exp $
-*
-* $Log: kierrf.F,v $
-* Revision 1.1.1.1 1996/03/08 15:32:55 mclareni
-* Kuip
-*
-*
-#include "kuip/pilot.h"
-*CMZ : 2.01/06 30/03/93 13.08.57 by Alfred Nathaniel
-*-- Author : Alfred Nathaniel 11/11/92
- SUBROUTINE KIERRF(CHOPT)
- CHARACTER CHOPT*(*)
-
-*--- catch runtime errors
-
-#if defined(CERNLIB_IBMALL)
- EXTERNAL ERRRUN
-
- IF(CHOPT.EQ.'TB') THEN
- INOAL = 999
- INOMES = 999
- ITRACE = 2
- ELSEIF(CHOPT.EQ.'ON') THEN
- INOAL = 999
- INOMES = -1
- ITRACE = 1
- ELSE
- INOAL = 1
- INOMES = 999
- ITRACE = 2
- ENDIF
- CALL ERRSET(203,INOAL,INOMES,ITRACE,ERRRUN,204)
- CALL ERRSET(206,INOAL,INOMES,ITRACE,ERRRUN,207)
- CALL ERRSET(209,INOAL,INOMES,ITRACE,ERRRUN,229)
- CALL ERRSET(231,INOAL,INOMES,ITRACE,ERRRUN,239)
- CALL ERRSET(241,INOAL,INOMES,ITRACE,ERRRUN,301)
-#endif
- END
diff --git a/src/packlib/kuip/code_kuip/kiinit.F b/src/packlib/kuip/code_kuip/kiinit.F
deleted file mode 100644
index 8a92b76..0000000
--- a/src/packlib/kuip/code_kuip/kiinit.F
+++ /dev/null
@@ -1,328 +0,0 @@
-*
-* $Id: kiinit.F,v 1.2 1997/10/23 16:53:58 mclareni Exp $
-*
-* Disable searching kuesrv under Windows NT
-*
-* $Log: kiinit.F,v $
-* Revision 1.2 1997/10/23 16:53:58 mclareni
-* NT mods
-*
-* Revision 1.1.1.1 1996/03/08 15:32:55 mclareni
-* Kuip
-*
-*
-#include "kuip/pilot.h"
-*CMZ : 2.05/02 27/04/94 12.42.30 by Alfred Nathaniel
-*-- Author : Alfred Nathaniel 25/08/92
- SUBROUTINE KIINIT(NWORDS)
-*
-********************************************************************************
-*
-* Initialize the command processor
-*
-* Input :
-*
- INTEGER NWORDS
-*
-********************************************************************************
-*
-#include "kuip/kcmcmd.inc"
-#include "kuip/kcgen.inc"
-#include "kuip/kcgen1.inc"
-#include "kuip/kcgen2.inc"
-#include "kuip/kcunit.inc"
-#include "kuip/kcsigm.inc"
-#include "kuip/kcpar.inc"
-#include "kuip/kcvect.inc"
-#include "kuip/kcmac.inc"
-#include "kuip/kcesvr.inc"
-*
- CHARACTER*8 RTIME
- INTEGER LENGTH(3)
-#if defined(CERNLIB_UNIX)||defined(CERNLIB_CRAY)
- LOGICAL KUQEXE
-#endif
-*
-#if defined(CERNLIB_APOLLO)
-%INCLUDE '/sys/ins/base.ins.ftn'
-#endif
-#if defined(CERNLIB_IBMALL)
- EXTERNAL ERRRUN
- CHARACTER*8 ENT108, ENT151, ENT218
-*
- IERNO=0
-*
- CALL ERRSET(108,999,-1)
- CALL ERRSET(151,999,-1)
- CALL ERRSET(180,999,-1)
- CALL ERRSET(203,999,-1,1,ERRRUN,204)
- CALL ERRSET(206,999,-1,1,ERRRUN,207)
- CALL ERRSET(208,999,-1)
- CALL ERRSET(209,999,-1,1,ERRRUN,217)
- CALL ERRSET(219,999,-1,1,ERRRUN,229)
- CALL ERRSET(231,999,-1,1,ERRRUN,239)
- CALL ERRSET(241,999,-1,1,ERRRUN,301)
- CALL ERRSET(218,999,-1)
-*
- CALL ERRSAV(108,ENT108)
- CALL ERRSAV(151,ENT151)
- CALL ERRSAV(218,ENT218)
-*
-#endif
-*
-* Initialize backslash character
-*
-#if !defined(CERNLIB_BSLASH)
- BSLASH='\'
-#endif
-#if defined(CERNLIB_BSLASH)
- BSLASH='\\'
-#endif
-*
-* Initialize NO user redefinable logical units :
-*
-* ILUIN = Internal input
-* ILUOUT = Internal output (command and parameter prompts)
-*
- ILUIN=5
- ILUOUT=6
-*
-* Initialize user redefinable logical units :
-*
-* LUOUT = External output (normal output)
-* LUNLOG = External log (errors + macro trace)
-*
- LUOUT=6
- LUNLOG=6
- CALL KULUN(11)
-*
-* Create division and link area
-*
- MINDIV=NWORDS
- MAXDIV=NWPAW
- CALL MZDIV(IXPAWC,IXKUIP,'KUIP Div',MINDIV,MAXDIV,'R')
- CALL MZLINK(IXPAWC,'/KCLINK/',LTOP,LCEL,LLAST)
- LLAST=0
-*
-* Clear the temporary vector bank addresses
-*
- DO 10 I=1,MAXLVA
- LVADDR(I)=0
-10 CONTINUE
- NVADD=0
- TVECFL=.TRUE.
- CALL MZLINK(IXPAWC,'/KCVADD/',LVADDR(1),LVADDR(MAXLVA),LVADDR(1))
-*
-* Define bank format
-*
- CALL MZFORM('TOP','-I',IOCEL)
- CALL MZFORM('NAME','9H *H',IONAME)
- CALL MZFORM('PAR','*H 2H *H',IOPAR)
- CALL MZFORM('PARV','-I',IOPARV)
- CALL MZFORM('VEC','-I',IOVEC)
- CALL MZFORM('VECN','9H 1I -F',IOVECN)
-*
-* Create and fill Top CEL Bank
-*
- NPAR=0
- NS=3
- NL=NS+1+NPAR
- ND=5
- CALL MZBOOK(IXKUIP,LTOP,LTOP,1,'TOP',NL,NS,ND,IOCEL,0)
- NDOWN=0
- NMAPAR=0
- IENBL=1
- IQ(LTOP+1)=NDOWN
- IQ(LTOP+2)=NPAR
- IQ(LTOP+3)=NMAPAR
- IQ(LTOP+4)=IENBL
- IQ(LTOP+5)=0
-*
-* Create and fill top LIST bank
-*
- NS = 1
- NL = 1
- ND = 1
- CALL MZBOOK(IXKUIP,LLIST,LLIST,1,'TLST',NL,NS,ND,2,0)
- IQ(LLIST+1) = 0
-*
-* Create the root address for Vectors and the '?' vector
-*
- NS=1
- NL=NS
- ND=0
- CALL MZBOOK(IXKUIP,LVEC,LVEC,1,'VEC',NL,NS,ND,IOVEC,0)
- NUMVEC=0
- LENGTH(1)=100
- LENGTH(2)=1
- LENGTH(3)=1
- CALL KUVCRE('?','R',LENGTH,LLOW,LHIGH)
-*
-* Clear the directory array
-*
- IWD=0
- DO 20 I=1,MAXLEV
- WDNAM(I)=' '
-20 CONTINUE
-*
-* Glossary initializations
-*
- LCELGF=0
- CHGLOS=' '
-*
-* Initialize name of extensions for macro files
-*
-#if (defined(CERNLIB_MSDOS))&&(!defined(CERNLIB_WINNT))
- MACEXT='kum'
- MACBAK='kuo'
-#endif
-#if !defined(CERNLIB_MSDOS)||defined(CERNLIB_WINNT)
- MACEXT='kumac'
- MACBAK='kumacold'
-#endif
-*
-* To NOT load SIGMA:
-*
- ISIADD=0
-*
-* Initialisations of the pointers to the list data structures.
-*
- LCLIST = 0
-*
-* Other initializations
-*
- DEFLAG=.FALSE.
- HISTOK=.TRUE.
- NOHIST=.FALSE.
- CHMEXE=' '
- MEXEFL=.FALSE.
- MULTFL=.FALSE.
- CHMULT=' '
- CHMULM=' '
- LENMUL=-1
- LENMUM=-1
- UNIQUE=.FALSE.
- FILCAS=.FALSE.
- IONERF=1
- COMAND=' '
- IUSADD=0
- IEXADD=0
- IQUADD=0
- IUTADD=0
- NEXADD=0
- IBRADD=0
- LICALL=.TRUE.
- LICAL2=.TRUE.
- LICAL3=.TRUE.
- NVSIGM=0
- LTOPW1=LTOP
- LTOPW2=LTOP
- CHROOT='/'
- LENTER=80
- NCMD=0
- CPRMPT='KUIP >'
- LPRMPT=LENOCC(CPRMPT)
- SPRMPT=CPRMPT
- IBRAK=0
- APPLIC=' '
- LAPPLI=0
- LUNAPP=5
- TRACE=.FALSE.
- TRAPRO=' '
- IREPET=0
- IREFAC=0
- CELLST=' '
- PNALST=' '
- IIIMAC=0
- MACTAB=.FALSE.
- MACPAT=' '
-CCCM
- MACLIS=' '
- AUTOEX='C'
- DEBTAB=.FALSE.
- NSTLEV=0
- QUITFL=.FALSE.
- SKIPFL=.FALSE.
- WAITFL=.FALSE.
- WAITFF=.FALSE.
-*
-* STYLEs initialization
-*
- HELPAT=CHAR(0)
-*
-* Used in case of calling KUPROx not together a command line
-*
- GETPAR=0
- TOTPAR=0
- PARLST=' '
- NOALIN=' '
- CHLAST=' '
- GETSPY=0
- SPYFLG=.FALSE.
- SPYING=.TRUE.
- PROFLG=.FALSE.
-*
-* Edit server initialization
-*
-#if (!defined(CERNLIB_UNIX))&&(!defined(CERNLIB_CRAY))
- SERVER = .FALSE.
-#endif
-#if defined(CERNLIB_UNIX)||defined(CERNLIB_CRAY)
- LE = LENOCC(EDITOR)
- IF (EDITOR(LE-1:LE) .EQ. 'vi') THEN
- IF (EDITOR(1:1) .EQ. '/' .OR. EDITOR(1:2) .EQ. 'vi') THEN
- SERVER = .FALSE.
- ELSEIF (KUQEXE('kuesvr')) THEN
- SERVER = .TRUE.
- ELSE
- SERVER = .FALSE.
- ENDIF
-#ifndef CERNLIB_WINNT
- ELSEIF (KUQEXE('kuesvr')) THEN
- SERVER = .TRUE.
-#endif
- ELSE
- SERVER = .FALSE.
- ENDIF
-#endif
- NSVFIL = 0
- IESADD = 0
- DO 46 I = 1, MAXSVR
- EDTFIL(I) = ' '
- EDTCMD(I) = ' '
-46 CONTINUE
-*
-* Initialize parameter pointers
-*
- CALL VZERO(PARPTR,4*MAXPAR)
-*
-* Build basic command structure from definition routine (excepted VECTOR)
-*
-*** CALL KUIDF1
-*** CALL KUIDF2
-*** CALL MACDEF
-*
-* Time initialization
-*
- CALL TIMEST(9999.)
- CALL TIMED (TIME)
- CALL KIRTIM(RTIME)
- TIMING=.FALSE.
- TIMALL=.FALSE.
-*
-* Initialize break handling
-*
- CALL KUTRUE(.TRUE.,.FALSE.)
-*
-* Pass the starting address of PAWC to C part
-*
- CALL KIPAWC(NWPAW)
-*
-* Initialize the working mode of KUIP
-*
- CALMOD=0
- INPMOD='C'
-*
-999 END
-
-
diff --git a/src/packlib/kuip/code_kuip/kilexp.F b/src/packlib/kuip/code_kuip/kilexp.F
deleted file mode 100644
index d98fd9d..0000000
--- a/src/packlib/kuip/code_kuip/kilexp.F
+++ /dev/null
@@ -1,342 +0,0 @@
-*
-* $Id: kilexp.F,v 1.1.1.1 1996/03/08 15:32:53 mclareni Exp $
-*
-* $Log: kilexp.F,v $
-* Revision 1.1.1.1 1996/03/08 15:32:53 mclareni
-* Kuip
-*
-*
-#include "kuip/pilot.h"
-*CMZ : 1.68/00 05/12/91 19.03.06 by Fons Rademakers
-*-- Author :
- SUBROUTINE KILEXP(STRING,SEPAR,QUOT1,QUOT2,MAXTOK,TOKVEC,NTOK,
- + CHOPT)
-*
-********************************************************************************
-*
-* Lexical analyser for parameter string.
-* It accepts parameters (tokens) separeted by separators.
-* If a separator is between characters QUOTE1 and QUOTE2 it is not considered
-* (the order is important, i.e. first QUOTE1 then parameter and last QUOTE2);
-* in this case a parameter can also start with an equal sign
-* (ex.: If QUOTE1=QUOTE2=' then ='abc' is a valid parameter).
-* If blank line then NTOK=0; if too many tokens or syntax error then NTOK=-1
-* If two QUOTE1 characters are found consecutively, just one occurrence is kept
-* (to be used to escape the QUOTE1 character).
-*
-* Input/Output :
-*
- CHARACTER*(*) STRING
-*
-* Input :
-*
- CHARACTER*1 SEPAR
- CHARACTER*1 QUOT1
- CHARACTER*1 QUOT2
- INTEGER MAXTOK
-*
-* Output :
-*
- INTEGER TOKVEC(2,MAXTOK)
- INTEGER NTOK
-*
-* Input :
-*
- CHARACTER*1 CHOPT
-*
-********************************************************************************
-*
-*
-* +--------------------+
-* separ | |
-* +--------------------| POST-QUOTED PAR |<-----------------+
-* | // | | |
-* | +--------------------+ |
-* | EOL | | other |
-* | | | |
-* | +-----------+ | |
-* | | | |
-* | v v |
-* | +--------+ +---------+ |
-* | | | | | |
-* | +--->| STOP | | ERROR | |
-* | | | | | | |
-* | | +--------+ +---------+ |
-* | | EOL |
-* | | +---+ |
-* | | | | separ | quote2
-* v | v | |
-* +-----------+ +--------------------+ +------------------+
-* | | quote1 | | any | |
-* | START |--------->| PRE-QUOTED PAR |--------->| QUOTED PAR |
-* | | =quote1 | | | |
-* +-----------+ +--------------------+ +------------------+
-* ^ | | ^ ^ ^ |
-* | other | // | | | | other
-* | | | | | +----+
-* | | | | |
-* | | | | |
-* | | | | |
-* | | | | +---------------+
-* | | | | |
-* | | | | |
-* | | | | quote1 +------------------+ |
-* | | | +--------------------| | |
-* | | | | CONCATENATION | |
-* | | +------------------------------------------>| | |
-* | | +------------------+ |
-* | | ^ | |
-* | | // | | other |
-* | | | | |
-* | | | | |
-* | | | | |
-* | | | | |
-* | | | | |
-* | | | | |
-* | | | | |
-* | | +--------+ | | |
-* | | | | | | |
-* | | | STOP | | | +---+
-* | | | | | | |
-* | | +--------+ | | |
-* | | ^ | | |
-* | | | | v |
-* | | | EOL +------------------+
-* | | +------------------------------------| |
-* | +-------------------------------------------->| NON-QUOTED PAR |
-* | | |
-* | +------------------+
-* | | ^ |
-* | separ | | | other
-* +-------------------------------------------------------+ +----+
-*
-*
-********************************************************************************
-*
-#include "kuip/kcmcmd.inc"
-*
- CHARACTER*(MAXCMD) CHTEMP
- INTEGER TOKFLG(100)
- CHARACTER*1 QUOTE1
- CHARACTER*1 QUOTE2
-*
- IF (QUOT1.EQ.' '.OR.QUOT2.EQ.' ') THEN
-*
-* Disable quote logic if equal to blank
-*
- QUOTE1=CHAR(2)
- QUOTE2=CHAR(2)
- ELSE
- QUOTE1=QUOT1
- QUOTE2=QUOT2
- ENDIF
-*
- NTOK=0
- L=LENOCC(STRING)
- IF (L.EQ.0) GO TO 999
- I=0
-*
-* Encode QUOTE1 as CTRL/A
-*
- III=1
-5 CONTINUE
- IF (III.GT.L-1) GO TO 10
-*
-* The character '@' is now used to escape the QUOTE1 separator
-*
- IF (STRING(III:III+1).EQ.'@'//QUOTE1) THEN
- STRING(III:)=CHAR(1)//STRING(III+2:)
- STRING(L:L)=' '
- L=L-1
- ENDIF
- III=III+1
- GO TO 5
-*
-10 CONTINUE
-*
-* Start
-*
- I=I+1
-11 IF (I.GT.L) GO TO 999
- IF (STRING(I:I).EQ.SEPAR) GO TO 10
- IF (STRING(I:I).EQ.QUOTE1.OR.(CHOPT.NE.' '.AND.
- + (STRING(I:I).EQ.CHOPT.AND.STRING(I+1:I+1).EQ.QUOTE1))) THEN
- NTOK=NTOK+1
- IF (NTOK.GT.MAXTOK) GO TO 99
- TOKVEC(1,NTOK)=I
- TOKFLG(NTOK)=0
- GO TO 30
- ENDIF
- NTOK=NTOK+1
- IF (NTOK.GT.MAXTOK) GO TO 99
- TOKVEC(1,NTOK)=I
- TOKFLG(NTOK)=0
- GO TO 20
-
-20 CONTINUE
-*
-* Non-quoted parameter
-*
- I=I+1
- IF (I.GT.L) THEN
- TOKVEC(2,NTOK)=I-1
- GO TO 999
- ENDIF
- IF (STRING(I:I).EQ.QUOTE1) GO TO 40
- IF (STRING(I:I).EQ.SEPAR.OR.STRING(I:I+1).EQ.'//') THEN
- TOKVEC(2,NTOK)=I-1
- IF (STRING(I:I+1).EQ.'//') THEN
- TOKFLG(NTOK)=-1
- I=I+1
- ENDIF
- GO TO 10
- ENDIF
- GO TO 20
-
-30 CONTINUE
-*
-* Pre-quoted parameter
-*
-
-40 CONTINUE
-*
-* Quoted parameter
-*
- I=I+1
- IF (I.GT.L) GO TO 90
- IF (STRING(I:I).EQ.QUOTE2) GO TO 50
- GO TO 40
-
-50 CONTINUE
-*
-* Post-quoted parameter
-*
-* Null string are not allowed
-*
- IF (I.EQ.TOKVEC(1,NTOK)+1) GO TO 90
- IF (I.EQ.L) THEN
- TOKVEC(2,NTOK)=I
- GO TO 999
- ENDIF
- IF (STRING(I:I).EQ.SEPAR.OR.STRING(I:I+1).EQ.'//') THEN
- TOKVEC(2,NTOK)=I-1
- IF (STRING(I:I+1).EQ.'//') THEN
- TOKFLG(NTOK)=-2
- I=I+1
- ENDIF
- GO TO 10
- ENDIF
- IF (STRING(I:I+1).EQ.'//') GO TO 11
- IF (STRING(I+1:I+1).EQ.QUOTE1) GO TO 90
- GO TO 20
-
-90 CONTINUE
- CALL KUALFA
- PRINT *,'*** Syntax error in token #',NTOK,' of line: ',
- + STRING(1:LENOCC(STRING))
- NTOK=0
- GO TO 999
-
-99 CONTINUE
- CALL KUALFA
- PRINT *,'*** Too many tokens (MAX=',MAXTOK,') in line: ',
- + STRING(1:LENOCC(STRING))
- NTOK=0
- GO TO 999
-
-999 CONTINUE
-*
-* Decode QUOTE1 from CTRL/A
-*
- DO 100 III=1,L
- IF (STRING(III:III).EQ.CHAR(1)) STRING(III:III)=QUOTE1
-100 CONTINUE
-*
-* Merge tokens to be concatenated
-*
- IF (NTOK.LE.0) GO TO 9999
-
- DO 110 I=1,NTOK
- IF (STRING(TOKVEC(1,I):TOKVEC(1,I)).EQ.QUOTE1) THEN
- TOKFLG(I)=SIGN(2.,FLOAT(TOKFLG(I)))
- ELSE
- TOKFLG(I)=SIGN(1.,FLOAT(TOKFLG(I)))
- ENDIF
-110 CONTINUE
-
-120 CONTINUE
- II=NTOK-1
- DO 200 I=1,II
- IF (TOKFLG(I).LT.0) THEN
- IF (IABS(TOKFLG(I)).EQ.1.AND.IABS(TOKFLG(I+1)).EQ.1) THEN
- CHTEMP=STRING(TOKVEC(1,I+1):)
- STRING(TOKVEC(2,I)+1:)=CHTEMP
- NCH=2
- TOKFLG(I)=TOKFLG(I+1)
- TOKVEC(2,I)=TOKVEC(2,I+1)-NCH
- ELSE IF (IABS(TOKFLG(I)).EQ.2.AND.IABS(TOKFLG(I+1)).EQ.2) THEN
- CHTEMP=STRING(TOKVEC(1,I+1)+1:)
- STRING(TOKVEC(2,I):)=CHTEMP
- NCH=4
- TOKFLG(I)=TOKFLG(I+1)
- TOKVEC(2,I)=TOKVEC(2,I+1)-NCH
- ELSE IF (IABS(TOKFLG(I)).EQ.1.AND.IABS(TOKFLG(I+1)).EQ.2) THEN
- CHTEMP=STRING(TOKVEC(1,I+1)+1:)
- STRING(TOKVEC(2,I)+1:)=CHTEMP
- NCH=3
- TOKFLG(I)=SIGN(2.,FLOAT(TOKFLG(I+1)))
- TOKVEC(2,I)=TOKVEC(2,I+1)-NCH
-*
-* Case of CHOPT equal to '='
-*
- IF (CHOPT.EQ.'=') THEN
- IEQ=INDEX(STRING(TOKVEC(1,I):TOKVEC(2,I)),CHOPT)
- IF (IEQ.GT.0) THEN
- IEQ=TOKVEC(1,I)+IEQ-1
- CHTEMP=STRING(IEQ+1:)
- STRING(IEQ+1:)=QUOTE1//CHTEMP
- GO TO 105
- ENDIF
- ENDIF
-*
- CHTEMP=STRING(TOKVEC(1,I):)
- STRING(TOKVEC(1,I):)=QUOTE1//CHTEMP
-105 CONTINUE
- TOKVEC(2,I)=TOKVEC(2,I)+1
- DO 130 J=I+1,NTOK
- TOKVEC(1,J)=TOKVEC(1,J)+1
- TOKVEC(2,J)=TOKVEC(2,J)+1
-130 CONTINUE
-
- ELSE IF (IABS(TOKFLG(I)).EQ.2.AND.IABS(TOKFLG(I+1)).EQ.1) THEN
- CHTEMP=STRING(TOKVEC(1,I+1):)
- STRING(TOKVEC(2,I):)=CHTEMP
- NCH=3
- TOKFLG(I)=SIGN(2.,FLOAT(TOKFLG(I+1)))
- TOKVEC(2,I)=TOKVEC(2,I+1)-NCH
-
- CHTEMP=STRING(TOKVEC(2,I)+1:)
- STRING(TOKVEC(2,I)+1:)=QUOTE2//CHTEMP
- TOKVEC(2,I)=TOKVEC(2,I)+1
- DO 140 J=I+2,NTOK
- TOKVEC(1,J)=TOKVEC(1,J)+1
- TOKVEC(2,J)=TOKVEC(2,J)+1
-140 CONTINUE
-
- ENDIF
- DO 150 J=I+1,NTOK-1
- TOKFLG(J)=TOKFLG(J+1)
-150 CONTINUE
- DO 160 J=I+1,NTOK-1
- TOKVEC(1,J)=TOKVEC(1,J+1)-NCH
- TOKVEC(2,J)=TOKVEC(2,J+1)-NCH
-160 CONTINUE
- NTOK=NTOK-1
- GO TO 120
- ENDIF
-200 CONTINUE
-
-9999 END
-
-
-
diff --git a/src/packlib/kuip/code_kuip/kilogn.F b/src/packlib/kuip/code_kuip/kilogn.F
deleted file mode 100644
index 22e350f..0000000
--- a/src/packlib/kuip/code_kuip/kilogn.F
+++ /dev/null
@@ -1,168 +0,0 @@
-*
-* $Id: kilogn.F,v 1.1.1.1 1996/03/08 15:32:53 mclareni Exp $
-*
-* $Log: kilogn.F,v $
-* Revision 1.1.1.1 1996/03/08 15:32:53 mclareni
-* Kuip
-*
-*
-#include "kuip/pilot.h"
-*CMZ : 1.70/00 03/07/92 09.41.34 by Alfred Nathaniel
-*-- Author : Jamie Shiers
- SUBROUTINE KILOGN(CHPATH,CHLOGN,CHOPT)
-*
-* Called by KULOGN ==> execute logon macro
-*
-
- CHARACTER*(*) CHPATH,CHLOGN,CHOPT
- COMMON/SLATE/ IS(40)
- CHARACTER*255 CHNAME
- CHARACTER*255 CHFILE
- LOGICAL IEXIST
-#if defined(CERNLIB_VMS)
- INCLUDE '($LNMDEF)'
- INCLUDE '($RMSDEF)'
- STRUCTURE /ITMLST/
- UNION
- MAP
- INTEGER*2 BUFFER_LENGTH
- INTEGER*2 ITEM_CODE
- INTEGER*4 BUFFER_ADDRESS
- INTEGER*4 RETURN_LENGTH_ADDRESS
- ENDMAP
- MAP
- INTEGER*4 END_LIST /0/
- ENDMAP
- END UNION
- END STRUCTURE
-
- RECORD /ITMLST/ LNM_LIST(3)
-
- INTEGER SYS$CRELNM
-#endif
-
- LPATH = LENOCC(CHPATH)
- LLOGN = LENOCC(CHLOGN)
- IOPTV = INDEX(CHOPT,'V')
-*
-* Search for logon file and execute if found
-*
-#if defined(CERNLIB_VMS)
-*
-* Is CHPATH a logical name?
-*
- ISTAT = LIB$SYS_TRNLOG(CHPATH(1:LPATH),LNAME,CHNAME,,,)
- IF(ISTAT.NE.1) THEN
-*
-* define logical name in job table
-*
- LNM_LIST(1).BUFFER_LENGTH = 11
- LNM_LIST(1).ITEM_CODE = LNM$_STRING
- LNM_LIST(1).BUFFER_ADDRESS = %LOC('SYS$DISK:[]')
- LNM_LIST(1).RETURN_LENGTH_ADDRESS = %LOC(LENRET)
-
- LNM_LIST(2).BUFFER_LENGTH = 9
- LNM_LIST(2).ITEM_CODE = LNM$_STRING
- LNM_LIST(2).BUFFER_ADDRESS = %LOC('SYS$LOGIN')
- LNM_LIST(2).RETURN_LENGTH_ADDRESS = %LOC(LENRET)
-
- LNM_LIST(3).END_LIST = 0
-
- ISTAT=SYS$CRELNM(,'LNM$JOB',CHPATH(1:LPATH),,LNM_LIST)
- ENDIF
-
- CHFILE = CHPATH(1:LPATH) // ':' // CHLOGN(1:LLOGN) // '.KUMAC'
-#endif
-#if defined(CERNLIB_IBMMVS)
- CHFILE = '/' // CHPATH(1:LPATH) // '.'
- + // CHLOGN(1:LLOGN) // '.KUMAC'
-#endif
-#if defined(CERNLIB_IBMVM)
- CHFILE = '/' // CHLOGN(1:LLOGN) // ' KUMAC *'
-#endif
- LFILE = LENOCC(CHFILE)
-#if defined(CERNLIB_IBMVM)
- INQUIRE(FILE=CHFILE(1:LFILE),NAME=CHNAME,EXIST=IEXIST)
-*
-* Check disk mode
-*
- IF(IEXIST) THEN
- LNAME = LENOCC(CHNAME)
- IF(INDEX(CHPATH(1:LPATH),CHNAME(LNAME-1:LNAME-1)).NE.0) THEN
- IF(IOPTV.NE.0) PRINT *,'>>> executing ',CHNAME(2:LNAME)
- CALL KUEXEC('EXEC '//CHNAME(2:LNAME))
- ELSE
- IF(IOPTV.NE.0) PRINT *,'>>> macro ',CHLOGN(1:LLOGN),
- + ' not found on any of following disks: ',CHPATH(1:LPATH)
- ENDIF
- ELSE
- IF(IOPTV.NE.0) PRINT *,'>>> macro ',CHLOGN(1:LLOGN),
- + ' not found'
- ENDIF
-#endif
-#if defined(CERNLIB_VMS)
- ISTAT = LIB$FIND_FILE(CHFILE(1:LFILE),CHNAME,ICONT,,,,)
- CALL LIB$FIND_FILE_END(ICONT)
- IF(ISTAT.EQ.RMS$_SUC) THEN
- LNAME = LENOCC(CHNAME)
- IF(IOPTV.NE.0) PRINT *,'>>> executing ',CHNAME(1:LNAME)
- CALL KUEXEC('EXEC '//CHNAME(1:LNAME))
-#endif
-#if defined(CERNLIB_IBMMVS)
- INQUIRE(FILE=CHFILE(1:LFILE),EXIST=IEXIST)
- IF(IEXIST) THEN
- IF(IOPTV.NE.0) PRINT *,'>>> executing ',CHFILE(2:LFILE)
- CALL KUEXEC('EXEC '//CHFILE(2:LFILE))
-#endif
-#if defined(CERNLIB_VMS)||defined(CERNLIB_IBMMVS)
- ELSE
- IF(IOPTV.NE.0) PRINT *,'>>> macro ',CHLOGN(1:LLOGN),
- + ' not found'
- ENDIF
-#endif
-#if defined(CERNLIB_UNIX)
-*
-* Loop over all elements in path name
-*
- ISTART = 1
-10 CONTINUE
- ICOLON = INDEX(CHPATH(ISTART:LPATH),':')
- IF(ICOLON.NE.0) THEN
- IEND = ISTART + ICOLON - 2
- ELSE
- IEND = LPATH
- ENDIF
-*
-* In case of a dot, get CWD
-*
- IF(CHPATH(ISTART:IEND).EQ.'.') THEN
- CALL GETWDF(CHNAME)
- CHFILE = CHNAME(1:IS(1)) // '/'
- + // CHLOGN(1:LLOGN) // '.KUMAC'
- ELSE
- CHFILE = CHPATH(ISTART:IEND) // '/'
- + // CHLOGN(1:LLOGN) // '.KUMAC'
- ENDIF
- LFILE = LENOCC(CHFILE)
- CALL CUTOL(CHFILE(1:LFILE))
-*
-* Does this file exist?
-*
- INQUIRE(FILE=CHFILE(1:LFILE),EXIST=IEXIST)
- IF(IEXIST) THEN
- IF(IOPTV.NE.0) PRINT *,'>>> executing ',CHFILE(1:LFILE)
- CALL KUEXEC('EXEC '//CHFILE(1:LFILE))
- RETURN
- ENDIF
-
- IF(ICOLON.NE.0) THEN
- ISTART = ISTART + ICOLON
- GOTO 10
- ENDIF
-
- IF(IOPTV.NE.0) PRINT *,'>>> macro ',CHLOGN(1:LLOGN),
- + ' not found'
-
-#endif
-
- END
diff --git a/src/packlib/kuip/code_kuip/kilun.F b/src/packlib/kuip/code_kuip/kilun.F
deleted file mode 100644
index 136814c..0000000
--- a/src/packlib/kuip/code_kuip/kilun.F
+++ /dev/null
@@ -1,38 +0,0 @@
-*
-* $Id: kilun.F,v 1.1.1.1 1996/03/08 15:32:55 mclareni Exp $
-*
-* $Log: kilun.F,v $
-* Revision 1.1.1.1 1996/03/08 15:32:55 mclareni
-* Kuip
-*
-*
-#include "kuip/pilot.h"
-*CMZ : 2.00/00 01/12/92 18.48.32 by Alfred Nathaniel
-*-- Author : Alfred Nathaniel 01/12/92
- SUBROUTINE KILUN(LUN)
-#include "kuip/kcmcmd.inc"
-#include "kuip/kcgen1.inc"
-#include "kuip/kcunit.inc"
- LUIBAS=LUN
- IF (LUIBAS.LE.0) LUIBAS=11
-
- LUIFIL=LUIBAS
- LUIVR =LUIBAS+1
- LUIVW =LUIBAS+2
- LUIHIS=LUIBAS+3
- LUIAPP=LUIBAS+4
- LUIHIW=LUIAPP
- LUIMAN=LUIAPP
-
- LUNFIL=LUIFIL
- LUNVR =LUIVR
- LUNVW =LUIVW
- LUNHIS=LUIHIS
- LUNAPP=LUIAPP
- LUNHIW=LUIHIW
- LUNMAN=LUIMAN
-
-CCCM
- LUNML=LUIBAS+5
-
- END
diff --git a/src/packlib/kuip/code_kuip/kindex.F b/src/packlib/kuip/code_kuip/kindex.F
deleted file mode 100644
index 83dd5e6..0000000
--- a/src/packlib/kuip/code_kuip/kindex.F
+++ /dev/null
@@ -1,43 +0,0 @@
-*
-* $Id: kindex.F,v 1.1.1.1 1996/03/08 15:32:53 mclareni Exp $
-*
-* $Log: kindex.F,v $
-* Revision 1.1.1.1 1996/03/08 15:32:53 mclareni
-* Kuip
-*
-*
-#include "kuip/pilot.h"
-*CMZ : 1.63/02 23/02/90 15.21.43 by
-*-- Author :
- FUNCTION KINDEX(STR,TOK)
-************************************************************************
-* *
-* KINDEX *
-* *
-* Search backward for TOKen in STRing. Opposite from INDEX. *
-* *
-* Author : Fons Rademakers 07/02/89 *
-* *
-************************************************************************
-*
- CHARACTER*(*) STR, TOK
-*
- LS = LEN(STR)
- LT = LEN(TOK)
-*
- IF (LT .GT. LS) THEN
- KINDEX = 0
- RETURN
- ENDIF
-*
- DO 10 I = LS, LT, -1
- IF (STR(I-LT+1:I) .EQ. TOK(1:LT)) THEN
- KINDEX = I-LT+1
- RETURN
- ENDIF
- 10 CONTINUE
-*
- KINDEX = 0
-*
- END
-
diff --git a/src/packlib/kuip/code_kuip/kindot.F b/src/packlib/kuip/code_kuip/kindot.F
deleted file mode 100644
index 4092728..0000000
--- a/src/packlib/kuip/code_kuip/kindot.F
+++ /dev/null
@@ -1,68 +0,0 @@
-*
-* $Id: kindot.F,v 1.1.1.1 1996/03/08 15:32:53 mclareni Exp $
-*
-* $Log: kindot.F,v $
-* Revision 1.1.1.1 1996/03/08 15:32:53 mclareni
-* Kuip
-*
-*
-#include "kuip/pilot.h"
-*CMZ : 2.00/08 15/01/93 13.02.08 by Alfred Nathaniel
-*-- Author :
- FUNCTION KINDOT(STRING)
-*
-********************************************************************************
-*
-* Like Fortran intrinsic function INDEX, with second parameter assumed '.'
-* and, in case of VMS, searching the dot only outside square brackets [ ]
-*
-* The dot search is terminated when a blank is found (that means
-* that the macro name is always the first parameter of STRING).
-*
-* Input :
-*
- CHARACTER*(*) STRING
-*
-********************************************************************************
-*
- I=INDEX(STRING,'.')
-#if defined(CERNLIB_VMS)
- L=LEN(STRING)
-10 IF (I.LT.L) THEN
- I1=INDEX(STRING(I+1:),'.')
- IF (I1.GT.0) THEN
- I=I1+I
- GO TO 10
- ENDIF
- ENDIF
- IBRA=INDEX(STRING,']')
- IF (I.LT.IBRA) I=0
- IBRA=INDEX(STRING,'}')
- IF (I.LT.IBRA) I=0
-#endif
- IBLA=INDEX(STRING,' ')
- IF (IBLA.GT.0.AND.I.GE.IBLA) THEN
- KINDOT=0
- ELSE
- IF (I.EQ.1) THEN
- II=INDEX(STRING(2:),'.')
- IF (II.GT.0) THEN
- KINDOT=II+1
- ELSE
- KINDOT=0
- ENDIF
- ELSE IF (I.GT.1.AND.STRING(I-1:I-1).EQ.'/') THEN
- II=INDEX(STRING(I+1:),'.')
- IF (II.GT.0) THEN
- KINDOT=II+I
- ELSE
- KINDOT=0
- ENDIF
- ELSE
- KINDOT=I
- ENDIF
- ENDIF
- END
-
-
-
diff --git a/src/packlib/kuip/code_kuip/kintoc.F b/src/packlib/kuip/code_kuip/kintoc.F
deleted file mode 100644
index 72bf267..0000000
--- a/src/packlib/kuip/code_kuip/kintoc.F
+++ /dev/null
@@ -1,81 +0,0 @@
-*
-* $Id: kintoc.F,v 1.1.1.1 1996/03/08 15:32:53 mclareni Exp $
-*
-* $Log: kintoc.F,v $
-* Revision 1.1.1.1 1996/03/08 15:32:53 mclareni
-* Kuip
-*
-*
-#include "kuip/pilot.h"
-*CMZ : 1.61/06 17/07/89 17.29.01 by
-** Replaced format descriptor G15.9 by G15.7
-*-- Author :
- SUBROUTINE KINTOC(IVAL,RVAL,CVAL)
-*
-********************************************************************************
-*
-* Convert integer value IVAL or real value RVAL into character string CVAL
-* In input CVAL(1:1) can be 'I' or 'R' to select the type
-*
-* WARNING: CVAL must be dimensioned at least to 15 in the calling routine
-* -----------------------------------------------------------------------
-*
-* Input :
-*
- INTEGER IVAL
- REAL RVAL
-*
-* Input/Output :
-*
- CHARACTER*(*) CVAL
-*
-********************************************************************************
-*
-#include "kuip/kcques.inc"
- PARAMETER (MAXDIG=15)
- CHARACTER*(MAXDIG) CHTEMP
-*
- IQUEST(1)=0
- CHTEMP=' '
- IF (CVAL(1:1).EQ.'I') THEN
- WRITE (CHTEMP,1000) IVAL
-1000 FORMAT (I15)
- ELSE IF (CVAL(1:1).EQ.'R') THEN
- IF (RVAL.EQ.0.) THEN
- CHTEMP='0'
- ELSE
- WRITE (CHTEMP,2000) RVAL
-2000 FORMAT (G15.7)
- ENDIF
- ELSE
- IQUEST(1)=1
- ENDIF
- IF (LEN(CVAL).LT.LENOCC(CHTEMP)) THEN
- IQUEST(1)=1
- ELSE
- DO 10 I1=1,MAXDIG
- IF (CHTEMP(I1:I1).NE.' ') GO TO 20
-10 CONTINUE
- I1=MAXDIG
-20 CONTINUE
- I0=INDEX(CHTEMP(I1:MAXDIG),'.')
- IF (I0.EQ.0) THEN
- I2=MAXDIG
- ELSE
- IE=INDEX(CHTEMP(I1:MAXDIG),'E')
- IF (IE.GT.0) THEN
- I2=MAXDIG
- GO TO 50
- ENDIF
- DO 30 I2=MAXDIG,I0,-1
- IF (CHTEMP(I2:I2).NE.'0'.AND.CHTEMP(I2:I2).NE.' ') GO TO 40
-30 CONTINUE
-40 IF (CHTEMP(I2:I2).EQ.'.') I2=I2-1
- ENDIF
-50 CVAL=' '
- CVAL=CHTEMP(I1:I2)
- ENDIF
- END
-
-
-
diff --git a/src/packlib/kuip/code_kuip/kipiaf.c b/src/packlib/kuip/code_kuip/kipiaf.c
deleted file mode 100644
index a37a7ac..0000000
--- a/src/packlib/kuip/code_kuip/kipiaf.c
+++ /dev/null
@@ -1,94 +0,0 @@
-/*
- * $Id: kipiaf.c,v 1.1.1.1 1996/03/08 15:32:57 mclareni Exp $
- *
- * $Log: kipiaf.c,v $
- * Revision 1.1.1.1 1996/03/08 15:32:57 mclareni
- * Kuip
- *
- */
-/*CMZ : 2.03/07 27/08/93 15.31.11 by Alfred Nathaniel*/
-/*-- Author : Alfred Nathaniel 15/04/93*/
-/* kipiaf.c: interface to Piaf server */
-
-#include "kuip/kuip.h"
-#include "kuip/kfor.h"
-
-
-static struct {
- SUBROUTINE *czgeta_F;
- SUBROUTINE *czputa_F;
- SUBROUTINE *fzin_F;
- SUBROUTINE *fzout_F;
-} kjmppiaf;
-
-
-/*
- * This routine has to be called by the Piaf server to define the routines
- * needed to transfer vectors.
- */
-void F77_ENTRY_E4(Kipiaf,czgeta,czputa,fzin,fzout)
-/* { */
- kjmppiaf.czgeta_F = czgeta;
- kjmppiaf.czputa_F = czputa;
- kjmppiaf.fzin_F = fzin;
- kjmppiaf.fzout_F = fzout;
-}
-
-
-/*
- * This routine is called by KUVECT if a vector is not defined.
- * If we are on the Piaf server we try to import the vector from the client
- * and return LVECN.NE.0
- */
-void F77_ENTRY_CI(Kivect,chvec,lvecn)
-/* { */
-
- *lvecn = 0;
-
-#ifdef UNIX /* Piaf server only be on Unix */
- if( kjmppiaf.czgeta_F != NULL ) {
- /* we are on the server side */
- char chmail[80];
- char *msg;
- INTEGER istat;
-
- /* ask client about this vector */
- msg = mstrncat( strdup( "KISNDV" ), chvec, len_chvec );
- F77_CALL_Cx(kjmppiaf.czputa_F,msg,strlen(msg),&istat);
- free( msg );
-
- F77_CALL_Cx(kjmppiaf.czgeta_F,chmail,(sizeof chmail),&istat);
-
- if( chmail[0] != ' ' ) {
- /* client knows this vector */
- INTEGER idim[3];
- int ntot = 1;
- int nbuf = 400;
- int dim[3];
- int i;
-
- /* client returns type and dimensions */
- sscanf( chmail + 1, " %d %d %d %d", &nbuf, &dim[0], &dim[1], &dim[2] );
- for( i = 0; i < 3; i++ ) {
- idim[i] = dim[i];
- ntot *= dim[i];
- }
-
- /* create vector: KXCRV2 also updates LVECN */
- F77_CALL_CxC(Kxcrv2,chvec,len_chvec,idim,chmail,1);
-
- for( i = 0; i < ntot; i += nbuf ) {
- INTEGER lun = 999;
- INTEGER ixdiv = Pawc->IXKUIP;
- INTEGER lsup = 0;
- INTEGER jbias = 1;
- INTEGER nuh = ntot - i;
- if( nuh > nbuf )
- nuh = nbuf;
- F77_CALL_x4Cxx((*kjmppiaf.fzin_F),
- &lun,&ixdiv,&lsup,&jbias," ",1,&nuh,&IQ(*lvecn+15+i));
- }
- }
- }
-#endif
-}
diff --git a/src/packlib/kuip/code_kuip/kisndv.F b/src/packlib/kuip/code_kuip/kisndv.F
deleted file mode 100644
index 8370a3f..0000000
--- a/src/packlib/kuip/code_kuip/kisndv.F
+++ /dev/null
@@ -1,49 +0,0 @@
-*
-* $Id: kisndv.F,v 1.1.1.1 1996/03/08 15:32:55 mclareni Exp $
-*
-* $Log: kisndv.F,v $
-* Revision 1.1.1.1 1996/03/08 15:32:55 mclareni
-* Kuip
-*
-*
-#include "kuip/pilot.h"
-*CMZ : 2.02/00 15/04/93 18.27.32 by Fons Rademakers
-*-- Author : Alfred Nathaniel 15/04/93
- SUBROUTINE KISNDV(CHVEC,ISTAT)
- CHARACTER*(*) CHVEC
-*
-* Send a vector to the Piaf server
-*
-#include "kuip/kcgen.inc"
-#include "kuip/kcques.inc"
- CHARACTER CHMAIL*80
-
- CALL KUVECT(CHVEC,LLOW,LHIGH)
- IF(LLOW.EQ.0) THEN
- CHMAIL=' UNKNOWN VECTOR '//CHVEC
- CALL CZPUTA(CHMAIL,ISTAT)
- ELSE
- ITYPE=IQUEST(14)
- IF(ITYPE.EQ.1) THEN
-*--- real vector
- CHMAIL='R'
- IOCH=3
- ELSE
- CHMAIL='I'
- IOCH=2
- ENDIF
- LENTOT=IQUEST(31)*IQUEST(32)*IQUEST(33)
- NUH=LENTOT
- IF(NUH.GT.400) NUH=400
- WRITE(CHMAIL(7:),'(4I10)') NUH,IQUEST(31),IQUEST(32),IQUEST(33)
- CALL CZPUTA(CHMAIL,ISTAT)
-*--- FZ user header is restricted to 400 words
- DO 10 I=1,LENTOT,400
- NUH=LENTOT-I+1
- IF(NUH.GT.400) NUH=400
- CALL FZOUT(998,IXKUIP,0,0,'Z',IOCH,NUH,IQ(LLOW+I-1))
- ISTAT=IQUEST(1)
- 10 CONTINUE
- ENDIF
-
- END
diff --git a/src/packlib/kuip/code_kuip/kivind.F b/src/packlib/kuip/code_kuip/kivind.F
deleted file mode 100644
index 28f7621..0000000
--- a/src/packlib/kuip/code_kuip/kivind.F
+++ /dev/null
@@ -1,100 +0,0 @@
-*
-* $Id: kivind.F,v 1.1.1.1 1996/03/08 15:32:53 mclareni Exp $
-*
-* $Log: kivind.F,v $
-* Revision 1.1.1.1 1996/03/08 15:32:53 mclareni
-* Kuip
-*
-*
-#include "kuip/pilot.h"
-*CMZ : 1.61/01 22/06/89 17.49.56 by
-*-- Author :
- SUBROUTINE KIVIND(VSUB,NCHSUB,LENFR,LENTO)
-*
-********************************************************************************
-*
-* Decode the subscript of a vector into the two arrays LENFR end LENTO
-*
-* Input :
-*
- CHARACTER*(*) VSUB
- INTEGER NCHSUB
-*
-* Output :
-*
- INTEGER LENFR(3)
- INTEGER LENTO(3)
-*
-********************************************************************************
-*
-#include "kuip/kcques.inc"
- DIMENSION NL(3),NR(3)
-*
- IQUEST(1)=0
-
- M1=INDEX(VSUB,',')
- IF (M1.EQ.0) THEN
- M2=0
- ELSE
- IF (M1.EQ.1) GO TO 910
- IF (M1.EQ.NCHSUB) GO TO 910
- M2=INDEX(VSUB(M1+1:),',')
- IF (M2.GT.0) THEN
- M2=M2+M1
- IF (M2.EQ.M1+1) GO TO 910
- IF (M2.EQ.NCHSUB) GO TO 910
- M3=INDEX(VSUB(M2+1:),',')
- IF (M3.GT.0) GO TO 920
- ENDIF
- ENDIF
-
- NL(1)=1
- IF (M1.EQ.0) THEN
- NR(1)=NCHSUB
- ELSE
- NR(1)=M1-1
- NL(2)=M1+1
- IF (M2.EQ.0) THEN
- NR(2)=NCHSUB
- ELSE
- NR(2)=M2-1
- NL(3)=M2+1
- NR(3)=NCHSUB
- ENDIF
- ENDIF
-
- DO 20 I=1,3
- LENFR(I)=1
- IF((I.EQ.1).OR.(I.EQ.2.AND.M1.GT.0).OR.(I.EQ.3.AND.M2.GT.0))THEN
- ICOLON=INDEX(VSUB(NL(I):NR(I)),':')
- IF (ICOLON.EQ.0) THEN
- CALL KICTOI(VSUB(NL(I):NR(I)),LENFR(I))
- IF (IQUEST(1).NE.0) GO TO 910
- LENTO(I)=LENFR(I)
- ENDIF
- IF (ICOLON.GT.1) THEN
- CALL KICTOI(VSUB(NL(I):NL(I)+ICOLON-2),LENFR(I))
- IF (IQUEST(1).NE.0) GO TO 910
- ENDIF
- IF (ICOLON.GT.0.AND.ICOLON.LT.NR(I)-NL(I)+1) THEN
- CALL KICTOI(VSUB(NL(I)+ICOLON:NR(I)),LENTO(I))
- IF (IQUEST(1).NE.0) GO TO 910
- ENDIF
- ENDIF
-20 CONTINUE
-
- GO TO 999
-
-910 IQUEST(1)=1
- CALL KUALFA
- PRINT *,'*** Illegal syntax in vector name'
- GO TO 999
-
-920 IQUEST(1)=1
- CALL KUALFA
- PRINT *,'*** Max 3 dimensions are supported'
- GO TO 999
-
-999 END
-
-
diff --git a/src/packlib/kuip/code_kuip/kkern.c b/src/packlib/kuip/code_kuip/kkern.c
deleted file mode 100644
index 3a5579f..0000000
--- a/src/packlib/kuip/code_kuip/kkern.c
+++ /dev/null
@@ -1,948 +0,0 @@
-/*
- * $Id: kkern.c,v 1.2 1996/05/01 12:08:38 gunter Exp $
- *
- * $Log: kkern.c,v $
- * Revision 1.2 1996/05/01 12:08:38 gunter
- * Replace several strcpy by memmove
- *
- * Revision 1.1.1.1 1996/03/08 15:32:57 mclareni
- * Kuip
- *
- */
-/*CMZ : 2.06/03 09/01/95 10.05.13 by N.Cremel*/
-/*-- Author : Alfred Nathaniel 07/08/92*/
-/* kkern.c */
-
-#include "kuip/kuip.h"
-
-/*
- * On some systems, e.g. IBM C/370, realloc() becomes very expensive if
- * there are a lot of allocated blocks and the number of bytes spills into
- * a different bucket size. We can lessen the effect by allocating for
- * string operations (strdup(), mstrcat()), a larger initial block size
- * in order to make realloc() effectively a null operation.
- */
-#ifndef ALLOC_MIN_BYTES
-# define ALLOC_MIN_BYTES 1
-#endif
-
-
-/*
- * return length of Fortran string ignoring trailing blanks
- */
-size_t fstrlen( const char *str,
- size_t len )
-{
- int *p;
- static int blanks = 0;
-
- if( len >= (sizeof blanks) * 4 ) {
-
- /* check single characters until next word boundary */
- switch( (int)&str[len] & ( (sizeof blanks) - 1 ) ) {
- case 7:
- if( str[--len] != ' ' ) return len + 1;
- case 6:
- if( str[--len] != ' ' ) return len + 1;
- case 5:
- if( str[--len] != ' ' ) return len + 1;
- case 4:
- if( str[--len] != ' ' ) return len + 1;
- case 3:
- if( str[--len] != ' ' ) return len + 1;
- case 2:
- if( str[--len] != ' ' ) return len + 1;
- case 1:
- if( str[--len] != ' ' ) return len + 1;
- }
-
- if( blanks == 0 )
- memset( (char*)&blanks, ' ', (sizeof blanks) );
-
- /* check for full words of blanks */
- for( p = (int*)&str[len]; len >= (sizeof blanks) && *--p == blanks; )
- len -= (sizeof blanks);
- }
-
- /* check single characters again */
- while( len > 0 && str[len-1] == ' ' )
- len--;
-
- return len;
-}
-
-
-/*
- * copy Fortran string to allocated memory stripping trailing blanks
- */
-char *fstrdup( const char *str,
- size_t len )
-{
- return strndup( str, fstrlen( str, len ) );
-}
-
-
-/*
- * like fstrdup() but return NULL if string is empty
- */
-char *fstr0dup( const char *str,
- size_t len )
-{
- size_t n = fstrlen( str, len );
- if( n == 0 )
- return NULL;
- return strndup( str, n );
-}
-
-
-/*
- * like fstrdup() but trim leading blanks
- */
-char *fstrtrim( const char *str,
- size_t len )
-{
- while( len > 0 && *str == ' ' ) {
- len--;
- str++;
- }
- return fstrdup( str, len );
-}
-
-
-/*
- * like fstr0dup() but trim leading blanks
- */
-char *fstr0trim( const char *str,
- size_t len )
-{
- while( len > 0 && *str == ' ' ) {
- len--;
- str++;
- }
- return fstr0dup( str, len );
-}
-
-
-/*
- * assign a Fortran string and return the logical length
- */
-size_t fstrset( char *str,
- size_t len,
- const char *cstr )
-{
- size_t n = 0;
- size_t i;
-
- memset( str, ' ', len );
- if( cstr != NULL ) {
- for( i = 0; i < len && cstr[i] != '\0'; i++ ) {
- if( (str[i] = cstr[i]) != ' ' )
- n = i + 1;
- }
-#if 0
- Unfortunately we cannot do this test for truncation because KUGETC/S
- is sometimes called with a short dummy string to load things for KUGETL
- if( cstr[i] != '\0' ) {
- while( cstr[i] == ' ' )
- i++;
- if( cstr[i] != '\0' ) {
- printf(
-" *** A character parameter has been defined with insufficient length = %d\n",
- len );
- }
- }
-#endif
- }
- return n;
-}
-
-
-/*
- * create a Fortran string array from a pointer array
- */
-char *fstrvec( char **pstr,
- size_t n,
- size_t *mlen )
-{
- char *fstr;
-
- if( n > 0 ) {
- int *plen = (int*)calloc( n, sizeof(int) );
- int len = 1;
- int nlen;
- int i;
-
- for( i = 0; i < n; i++ ) {
- if( pstr[i] != NULL ) {
- plen[i] = strlen( pstr[i] );
- if( plen[i] > len )
- len = plen[i];
- }
- }
-
- /* vector elements are padded to multiple of 8 */
- *mlen = len = ((len - 1) / 8 + 1 ) * 8;
- nlen = n * len;
- fstr = malloc( nlen + 1 );
- memset( fstr, ' ', nlen );
- fstr[nlen] = '\0';
-
- for( i = 0; i < n; i++ ) {
- if( plen[i] > 0 ) {
- memcpy( fstr + i * len, pstr[i], plen[i] );
- }
- }
- free( (char*)plen );
- }
-
- else {
- int nlen = 8;
- fstr = malloc( nlen + 1 );
- memset( fstr, ' ', nlen );
- fstr[nlen] = '\0';
- }
-
- return fstr;
-}
-
-
-/*
- * like strtod() but (*tail != '\0') can be used to test for bad numbers
- * trailing blanks are ignored
- */
-double fstrtod( const char *str,
- char **tail )
-{
- double value = strtod( str, tail );
- const char *ptail = *tail;
-
- if( *str == '\0'
- || ( ptail == str + 1 && !isdigit( str[0] ) ) ) {
- /*
- * in case str == ""
- * and stupid VMS RTL accepts "+" and "-" as valid numbers
- */
- *tail = "error";
- }
- else if( ptail != str ) {
- while( **tail == ' ' )
- (*tail)++; /* ignore trailing blanks */
- }
-
- return value;
-}
-
-
-/*
- * like strtol() but (*tail != '\0') can be used to test for bad numbers
- * trailing blanks are ignored
- */
-int fstrtoi( const char *str,
- char **tail )
-{
- int value = strtol( str, tail, 10 );
- const char *ptail = *tail;
-
- if( *str == '\0' ) {
- *tail = "error";
- }
- else if( ptail != str ) {
- while( **tail == ' ' )
- (*tail)++; /* ignore trailing blanks */
- }
-
- return value;
-}
-
-
-/*
- * convert double value into string representation with prec significant digits
- * equivalent to "%G" which behaves improperly on VAX/VMS
- */
-char *strfromd( double dval,
- size_t prec )
-{
- static char buffer[32];
- char *digit = "0123456789";
- char *p = buffer;
- double round = 5;
- double d;
- int i;
-
- if( dval == 0 )
- return "0";
-
- if( prec <= 0 )
- prec = 6;
-
- for( i = 0; i < prec; i++ )
- round *= 0.1;
-
- if( dval < 0 ) {
- *p++ = '-';
- dval = -dval;
- }
-
- d = dval;
- while( d < 1 ) {
- d *= 10;
- round *= 0.1;
- }
- while( d >= 10 ) {
- d *= 0.1;
- round *= 10;
- }
- dval += round;
-
- if( dval < 1 && dval >= 0.0001 ) {
-
- *p++ = '0';
- *p++ = '.';
- while( dval < 0.1 ) {
- *p++ = '0';
- dval *= 10;
- }
- for( i = 0; i < prec; i++ ) {
- int ival;
- dval *= 10;
- ival = dval;
- *p++ = digit[ival];
- dval -= ival;
- }
- while( p[-1] == '0' )
- p--;
- if( p[-1] == '.' )
- p--;
- }
-
- else {
- int nexp = 0;
- int ndot = 0;
-
- if( dval >= 1000000 ) {
- while( dval >= 10 ) {
- dval *= 0.1;
- nexp++;
- }
- }
-
- while( dval < 1 ) {
- dval *= 10;
- nexp--;
- }
-
- while( dval >= 10 ) {
- dval *= 0.1;
- ndot++;
- }
-
- for( i = 0; i < prec; i++ ) {
- int ival = dval;
- *p++ = digit[ival];
- if( i == ndot )
- *p++ = '.';
- dval = (dval - ival) * 10;
- }
-
- if( ndot < prec ) {
- while( p[-1] == '0' )
- p--;
- }
- if( p[-1] == '.' )
- p--;
-
- if( nexp != 0 ) {
- *p++ = 'E';
- if( nexp < 0 ) {
- *p++ = '-';
- nexp = -nexp;
- }
- else
- *p++ = '+';
-
- if( nexp >= 100 ) {
- *p++ = digit[nexp/100];
- nexp %= 100;
- }
- *p++ = digit[nexp/10];
- *p++ = digit[nexp%10];
- }
- }
-
- *p = '\0';
- return buffer;
-}
-
-
-/*
- * convert int value into string representation with prec significant digits
- * equivalent to "%.<n>d" which behaves improperly on VAX/VMS
- */
-char *strfromi( int ival,
- size_t prec )
-{
- static char buffer[3][32];
- static int nbuf = 0;
- char *p;
- int n;
- int i;
-
- if( ++nbuf >= 3 )
- nbuf = 0;
- p = buffer[nbuf];
-
- if( ival < 0 ) {
- *p++ = '-';
- ival = -ival;
- }
-
- n = ival;
- while( n >= 10 ) {
- n /= 10;
- prec--;
- }
-
- for( i = 0; i < prec - 1; i++ )
- *p++ = '0';
-
- sprintf( p, "%d", ival );
-
- return buffer[nbuf];
-}
-
-
-#ifndef HAVE_MEMMOVE
-/*
- * memory move with possible overlap
- */
-void *memmove( void *vdst,
- const void *vsrc,
- size_t n )
-{
- char *dst = (char*)vdst;
- const char *src = (char*)vsrc;
- if( dst != src && n > 0 ) {
-
- if( dst > src && src + n < dst ) {
- while( n > 0 ) {
- n--;
- dst[n] = src[n];
- }
- }
- else
- memcpy( dst, src, n );
- }
- return dst;
-}
-#endif
-
-
-#ifndef HAVE_STRCASECMP
-/*
- * case insensitive string compare
- */
-int strcasecmp( const char *str1,
- const char *str2 )
-{
- return strncasecmp( str1, str2, strlen( str2 ) + 1 );
-}
-
-
-/*
- * case insensitive string compare of n characters
- */
-int strncasecmp( const char *str1,
- const char *str2,
- size_t n )
-{
- while( n > 0 ) {
- int c1 = *str1;
- int c2 = *str2;
-
- if( isupper( c1 ) )
- c1 = tolower( c1 );
-
- if( isupper( c2 ) )
- c2 = tolower( c2 );
-
- if( c1 != c2 )
- return c1 - c2;
-
- str1++;
- str2++;
- n--;
- }
- return 0;
-}
-#endif
-
-
-/*
- * find last occurence of anyone character
- */
-char *strrpbrk( const char *str1,
- const char *str2 )
-{
- char *p = strpbrk( str1, str2 );
- if( p != NULL ) {
- char *s;
- while( (s = strpbrk( p + 1, str2 )) != NULL )
- p = s;
- }
- return p;
-}
-
-
-#ifndef HAVE_STRRSTR
-/*
- * find last occurence of substring
- */
-char *strrstr( const char *str1,
- const char *str2 )
-{
- if( str1 == NULL || str2 == NULL )
- return NULL;
-
- else if( *str2 == '\0' )
- return (char*)str1;
-
- else {
- char *p = strstr( str1, str2 );
- if( p != NULL ) {
- char *s;
- while( (s = strstr( p + 1, str2 )) != NULL )
- p = s;
- }
- return p;
- }
-}
-#endif
-
-
-/*
- * copy string to allocated memory
- */
-char *Strdup( const char *str )
-{
- size_t bytes = strlen( str ) + 1;
- if( bytes < ALLOC_MIN_BYTES )
- bytes = ALLOC_MIN_BYTES;
- return strcpy( malloc( bytes ), str );
-}
-
-
-/*
- * like strdup() but return NULL if string is NULL or ""
- */
-char *str0dup( const char *str )
-{
- if( str == NULL || str[0] == '\0' )
- return NULL;
- return Strdup( str );
-}
-
-
-/*
- * like strdup() but string is n characters long and not terminated
- */
-char *strndup( const char *str,
- size_t len )
-{
- size_t bytes = len + 1;
- char *p;
-
- if( bytes < ALLOC_MIN_BYTES )
- bytes = ALLOC_MIN_BYTES;
-
- p = strncpy( malloc( bytes ), str, len );
- p[len] = '\0';
- return p;
-}
-
-
-/*
- * strdup() of character representation of integer n
- */
-char *stridup( int n )
-{
- char buf[16];
- sprintf( buf, "%d", n );
- return Strdup( buf );
-}
-
-
-/*
- * like strdup() but concatenate two strings
- */
-char *str2dup( const char *str1,
- const char *str2 )
-{
- return mstrcat( Strdup( str1 ), str2 );
-}
-
-
-/*
- * like strdup() but concatenate three strings
- */
-char *str3dup( const char *str1,
- const char *str2,
- const char *str3 )
-{
- return mstr2cat( Strdup( str1 ), str2, str3 );
-}
-
-
-/*
- * like strdup() but concatenate four strings
- */
-char *str4dup( const char *str1,
- const char *str2,
- const char *str3,
- const char *str4 )
-{
- return mstr3cat( Strdup( str1 ), str2, str3, str4 );
-}
-
-
-/*
- * like strdup() but concatenate five strings
- */
-char *str5dup( const char *str1,
- const char *str2,
- const char *str3,
- const char *str4,
- const char *str5 )
-{
- return mstr4cat( Strdup( str1 ), str2, str3, str4, str5 );
-}
-
-
-/*
- * concatenate two strings if the first one is allocated
- */
-char *mstrcat( char *str1,
- const char *str2 )
-{
- if( str1 == NULL )
- return Strdup( str2 );
- else {
- size_t len1 = strlen( str1 );
- size_t len2 = strlen( str2 );
- size_t bytes = len1 + len2 + 1;
- if( bytes < ALLOC_MIN_BYTES )
- bytes = ALLOC_MIN_BYTES;
- str1 = realloc( str1, bytes );
- strcpy( &str1[len1], str2 );
- return str1;
- }
-}
-
-
-/*
- * like mstrcat() but concatenate three strings
- */
-char *mstr2cat( char *str1,
- const char *str2,
- const char *str3 )
-{
- return mstrcat( mstrcat( str1, str2 ), str3 );
-}
-
-
-/*
- * like mstrcat() but concatenate four strings
- */
-char *mstr3cat( char *str1,
- const char *str2,
- const char *str3,
- const char *str4 )
-{
- return mstr2cat( mstrcat( str1, str2 ), str3, str4 );
-}
-
-
-/*
- * like mstrcat() but concatenate five strings
- */
-char *mstr4cat( char *str1,
- const char *str2,
- const char *str3,
- const char *str4,
- const char *str5 )
-{
- return mstr3cat( mstrcat( str1, str2 ), str3, str4, str5 );
-}
-
-
-/*
- * like mstrcat() but the second string is not terminated
- */
-char *mstrncat( char *str1,
- const char *str2,
- size_t len2 )
-{
- if( len2 > 0 ) {
- size_t len1 = strlen( str1 );
- size_t bytes = len1 + len2 + 1;
- if( bytes < ALLOC_MIN_BYTES )
- bytes = ALLOC_MIN_BYTES;
- str1 = realloc( str1, bytes );
- strncpy( &str1[len1], str2, len2 );
- str1[len1+len2] = '\0';
- }
- return str1;
-}
-
-
-/*
- * append n times the character c to the allocated string
- */
-char *mstrccat( char *str,
- char c,
- size_t n )
-{
- if( n > 0 ) {
- size_t len = strlen( str );
- size_t bytes = len + n + 1;
- if( bytes < ALLOC_MIN_BYTES )
- bytes = ALLOC_MIN_BYTES;
- str = realloc( str, bytes );
- while( n-- > 0 )
- str[len++] = c;
- str[len] = '\0';
- }
- return str;
-}
-
-
-/*
- * append the string representation of an integer to the allocated string
- */
-char *mstricat( char *str,
- int n )
-{
- char nstr[16];
-
- sprintf( nstr, "%d", n );
- return mstrcat( str, nstr );
-}
-
-
-/*
- * find the maximum string length in an array of strings
- * if n == 0 the array is NULL terminated
- */
-size_t mstrlen( char **str,
- size_t n )
-{
- size_t nmax = (n != 0) ? n : (~0 >> 1);
- size_t mlen = 0;
- int i;
-
- for( i = 0; i < nmax; i++ ) {
- if( str[i] != NULL ) {
- size_t len = strlen( str[i] );
- if( len > mlen )
- mlen = len;
- }
- else if( n == 0 )
- break;
- }
-
- return mlen;
-}
-
-
-/*
- * protect blanks inside quoted strings and do strtok( str, " " )
- */
-char *strqtok( char *str )
-{
- char *tok;
- char *p;
-
- if( str != NULL ) {
- int quoted = 0;
- for( p = str; *p != '\0'; p++ ) {
- if( *p == '\'' )
- quoted = !quoted;
- else if( *p == ' ' && quoted )
- *p = '\n';
- }
- }
-
- tok = strtok( str, " " );
- if( tok != NULL ) {
- for( p = tok; *p != '\0'; p++ ) {
- if( *p == '\n' )
- *p = ' ';
- }
- }
- return tok;
-}
-
-
-/*
- * convert a string to lowercase in place
- */
-char *strlower( char *str )
-{
- if( str != NULL ) {
- char *p;
- for( p = str; *p != '\0'; p++ )
- if( isupper( *p ) )
- *p = tolower( *p );
- }
- return str;
-}
-
-
-/*
- * convert a string to uppercase in place
- */
-char *strupper( char *str )
-{
- if( str != NULL ) {
- char *p;
- for( p = str; *p != '\0'; p++ )
- if( islower( *p ) )
- *p = toupper( *p );
- }
- return str;
-}
-
-
-/*
- * trim leading and trailing blanks
- */
-char *strtrim( char *str )
-{
- int n = strlen( str );
- while( n > 0 && str[n-1] == ' ' )
- n--;
- str[n] = '\0';
- for( n = 0; str[n] == ' '; )
- n++;
- if( n > 0 ) memmove( str, str + n, strlen(str+n) + 1);
-/* Overlapping, use memmove strcpy( str, str + n );*/
- return str;
-}
-
-
-/*
- * replace tabs by an equivalent number of blanks and remove trailing blanks
- * argument string must be malloced
- */
-char *struntab( char *line )
-{
- char *p;
- int i;
-
- while( (p = strchr( line, '\t' )) != NULL ) {
- int n = p - line;
- char *newline = strndup( line, n );
- newline = mstrccat( newline, ' ', 8 - n % 8 );
- newline = mstrcat( newline, p + 1 );
- free( line );
- line = newline;
- }
-
- for( i = strlen( line ); i > 0; i-- ) {
- if( line[i-1] != ' ' && line[i-1] != '\n' ) {
- break;
- }
- }
- line[i] = '\0';
-
- return line;
-}
-
-/*
- * replace blanks inside a string with '0'
- */
-char *strblk0( char *str )
-{
- int i;
-
- for( i = 0; i < strlen( str ); i++) {
- if (str[i] == ' ') str[i] = '0';
- }
-
- return str;
-}
-
-
-/*
- * Calculate a 32-bit checksum for the file content.
- */
-int checksum( const char *path )
-{
- static int bogus_crc = 0x12345678;
- FILE *stream = fopen( path, "r" );
-
- if( stream != NULL ) {
- unsigned crc = 0;
- int c;
- while( (c = getc( stream )) != EOF ) {
- int carry = crc & 1;
- crc = ( ( crc >> 1 ) & 0x7FFFFFFF ) + ( c & 0xFF );
- if( carry )
- crc |= 0x80000000;
- }
- fclose( stream );
- return crc;
- }
- return ++bogus_crc;
-}
-
-
-#ifdef IBM370
-/*
- * return dummy process id
- */
-int getpid()
-{
- return 1;
-}
-#endif
-
-
-#ifdef IBMVM
-/*
- * copy file modification date into stamp buffer
- */
-int get_stamp( path, stamp )
- char *path;
- TimeStamp *stamp;
-{
- FILE *stream;
- char cmd[120];
- char *p;
-
- sprintf( cmd, "LISTFILE %s (DATE EXEC", path );
- while( (p = strchr( cmd, '.' )) != NULL )
- *p = ' ';
-
- if( system( cmd ) == 0
- && (stream = fopen( "CMS.EXEC", "r" )) != NULL
- && fgets( cmd, (sizeof cmd), stream ) != NULL ) {
- fclose( stream );
- remove( "CMS.EXEC" );
- strncpy( *stamp, cmd + 63, 17 );
- (*stamp)[17] = '\0';
- return 0;
- }
- return -1;
-}
-#endif
-
-
-#ifdef NEED_STRDUP
-# ifdef strdup
-# undef strdup
-# endif
-char *strdup( const char* str )
-{
- return Strdup( str );
-}
-#endif
diff --git a/src/packlib/kuip/code_kuip/kmacro.c b/src/packlib/kuip/code_kuip/kmacro.c
deleted file mode 100644
index aac9969..0000000
--- a/src/packlib/kuip/code_kuip/kmacro.c
+++ /dev/null
@@ -1,3078 +0,0 @@
-/*
- * $Id: kmacro.c,v 1.2 1996/04/11 09:43:26 cernlib Exp $
- *
- * $Log: kmacro.c,v $
- * Revision 1.2 1996/04/11 09:43:26 cernlib
- * Use memmove to move a string in next_statement
- *
- * Revision 1.1.1.1 1996/03/08 15:32:57 mclareni
- * Kuip
- *
- */
-/*CMZ : 2.07/06 14/06/95 15.33.23 by Gunter Folger*/
-/*-- Author : Alfred Nathaniel 13/04/94*/
-
-#include "kuip/kuip.h"
-#include "kuip/kfor.h"
-#include "kuip/kcom.h"
-#include "kuip/kmenu.h"
-#include "kuip/kflag.h"
-#include "kuip/khash.h"
-#include "kuip/kalias.h"
-#include "kuip/kmacro.h"
-
-#define MAX_KUMAC_TABLE 97
-
-static HashTable *kumac_table;
-static HashTable *orphan_table;
-static int orphan_count;
-
-#define MAX_VARIABLE_TABLE 97
-
-#define MAX_EXEC_STACK 100
-
-static ExecStack exec_stack[MAX_EXEC_STACK];
-static int exec_stack_ptr;
-
-static NestStack *nest_stack;
-static int nest_stack_max;
-static int nest_stack_ptr;
-
-static char *kumac_path;
-static int line_count;
-static int label_count;
-static char *full_line;
-static char *stmt_arg1;
-static char *stmt_arg2;
-static char *stmt_arg3;
-static char *stmt_arg4;
-
-
-/*
- * return the number of leading characters which are valid for a variable name
- */
-int len_variable( line )
- char *line;
-{
- int len = 0;
-
- if( isdigit( line[0] ) ) {
- while( isdigit( line[len] ) ) {
- len++;
- }
- }
- else {
- while( isalnum( line[len] ) || line[len] == '_' || line[len] == '$' ) {
- len++;
- }
- }
-
- return len;
-}
-
-
-static
-void internal_error( msg )
- char *msg;
-{
- ku_alfa();
- printf( " *** Internal error: %s - Call KUIP maintenance\n", msg );
-}
-
-
-static
-void print_error( msg, arg )
- char *msg;
- char *arg;
-{
- ku_alfa();
- printf( " *** %s in %s at line %d:\n ",
- msg[0] == '>' ? "Warning" : "Error",
- kumac_path, line_count );
- printf( msg[0] == '>' ? msg + 1 : msg, arg );
- printf( "\n" );
-}
-
-
-static
-void nest_error( tos, found )
- NestStack *tos;
- char *found;
-{
- char fmt[80];
- char *expect;
-
- switch( tos->stmt ) {
-
- case CASE_Statement:
- case CASE_Label:
- expect = "(label) or ENDCASE";
- break;
-
- case DO_Statement:
- expect = "ENDDO";
- break;
-
- case FOR_Statement:
- expect = "ENDFOR";
- break;
-
- case REPEAT_Statement:
- expect = "UNTIL";
- break;
-
- case WHILE_Statement:
- expect = "ENDWHILE";
- break;
-
- case IF_THEN_Statement:
- expect = "ELSEIF, ELSE, or ENDIF";
- break;
-
- case ELSE_Statement:
- expect = "ENDIF";
- break;
-
- default:
- internal_error( "Unexpected statement code on nest stack" );
- return;
- break;
- }
-
- sprintf( fmt, "%s found where %s was expected", found, expect );
- print_error( fmt, NULL );
-}
-
-
-static
-void too_much( stmt )
- char *stmt;
-{
- print_error( ">Additional text at end of %s statement ignored", stmt );
-}
-
-
-static
-int op_label( tos, user_label, aux_label )
- ExecStack *tos;
- char *user_label;
- char *aux_label;
-{
- if( kc_flags.trace_debug ) {
- ku_alfa();
- if( user_label != NULL ) {
- printf( " ###### %s:\n", user_label );
- }
- else {
- printf( " ###### $%s:\n", aux_label );
- }
- }
-
- return tos->pc + 1;
-}
-
-
-static
-int op_source( tos, line_number, source_line )
- ExecStack *tos;
- char *line_number;
- char *source_line;
-{
- if( kc_flags.trace_on ) {
- ku_alfa();
- printf( "%2d.%s: %s\n", exec_stack_ptr, line_number, source_line );
- }
-
- if( kc_flags.appl_stream != NULL ) {
- /* strip leading blanks from the APPLICATION terminator */
- char *p = source_line;
- while( p[0] == ' ' )
- p++;
- if( strcasecmp( p, kc_flags.appl_exit ) != 0 )
- p = source_line;
- fprintf( kc_flags.appl_stream, "%s\n", p );
- }
-
- tos->line_number = line_number;
- tos->source_line = source_line;
-
- return tos->pc + 1;
-}
-
-
-static
-int find_label( macro, label, which )
- KumacMacro *macro;
- char *label;
- int which;
-{
- KumacCode *code = macro->code;
- int n = which < 0 ? 0 : which;
- int pc;
-
- for( pc = 0; pc < macro->ncode; pc++ ) {
- if( code[pc].op == op_label && code[pc].arg[n] != NULL
- && strcasecmp( code[pc].arg[n], label ) == 0 ) {
- return pc;
- }
- }
-
- if( which >= 0 ) {
- ku_alfa();
- printf( " *** Label %s not found\n", label );
- }
- return -1;
-}
-
-
-static
-void swap_source( macro )
- KumacMacro *macro;
-{
- KumacCode source;
- int pc = macro->ncode;
-
- while( macro->code[pc-1].op != op_source ) {
- pc--;
- }
- source = macro->code[pc-1];
-
- while( pc < macro->ncode ) {
- macro->code[pc-1] = macro->code[pc];
- pc++;
- }
- macro->code[pc-1] = source;
-}
-
-
-static
-int op_application( tos, application_name, null2 )
- ExecStack *tos;
- char *application_name;
- char *null2;
-{
- fclose( kc_flags.appl_stream );
- kc_flags.appl_stream = NULL;
-
- /* Fortran OPEN the file and call application */
- ku_open( kc_flags.appl_luno, kc_flags.appl_file, "OLD" );
- kc_flags.appl_called = 1;
- ku_exel( application_name );
- kc_flags.appl_called = 0;
- ku_close( kc_flags.appl_luno );
- remove( kc_flags.appl_file );
-
- ku_sapp( "", "" );
-
- return tos->pc + 1;
-}
-
-
-static
-int op_bool( tos, expression, null2 )
- ExecStack *tos;
- char *expression;
- char *null2;
-{
- int value = ku_bool( expression );
-
- if( kc_flags.trace_debug ) {
- ku_alfa();
- printf( " ###### Bool %s --> %d\n",
- expression, value );
- }
-
- if( value == -1 ) {
- ku_alfa();
- printf( " *** Invalid boolean expression in file %s\n",
- tos->file->path );
- printf( "%s: %s\n", tos->line_number, tos->source_line );
- return -1;
- }
-
- if( value == 1 )
- return tos->pc + 2;
-
- return tos->pc + 1;
-}
-
-
-void store_variable( ExecStack* tos, const char* name, const char* value )
-{
- if( tos == NULL && kc_flags.in_macro )
- tos = &exec_stack[exec_stack_ptr-1];
-
- if( tos != NULL ) {
- int is_global = 0;
-
- if( hash_lookup( tos->variables, name, &is_global ) != NULL
- && is_global ) {
- hash_insert( kc_alias.global_value, name, value, 0 );
- }
- hash_insert( tos->variables, name, value, is_global );
- }
- else
- hash_insert( kc_alias.global_value, name, value, 0 );
-}
-
-
-static
-int op_command( tos, command_line, status_test )
- ExecStack *tos;
- char *command_line;
- char *status_test;
-{
- int status = ku_exel( command_line );
-
- if( status == KUMAC_UNWIND ) {
- tos->status = KUMAC_UNWIND;
- return -1;
- }
-
- if( status_test == NULL ) {
-
- if( status != 0 ) {
-
- switch( tos->on_error_stmt ) {
-
- case ON_ERROR_CONTINUE:
- break;
-
- case ON_ERROR_GOTO:
- return find_label( tos->macro, tos->on_error_arg, 0 );
- break;
-
- case ON_ERROR_EXITM:
- if( tos->on_error_arg != NULL ) {
- char *value = ku_expr( tos->on_error_arg );
- store_variable( tos, "@", value );
- free( value );
- }
- return -1;
- break;
-
- case ON_ERROR_STOPM:
- tos->status = KUMAC_UNWIND;
- return -1;
- break;
-
- default:
- internal_error( "Unexpected ON ERROR statement" );
- tos->status = KUMAC_UNWIND;
- return -1;
- break;
- }
- }
- }
- else if( ( status_test[0] == '&' && status != 0 )
- || ( status_test[0] == '!' && status == 0 ) ) {
- /*
- * skip to next source line
- */
- KumacMacro *macro = tos->macro;
- int pc;
-
- for( pc = tos->pc + 1; pc < macro->ncode; pc++ ) {
- if( macro->code[pc].op == op_source ) {
- return pc;
- }
- }
-
- return -1;
- }
-
- return tos->pc + 1;
-}
-
-
-static
-int op_expr( ExecStack *tos,
- const char *lhs,
- const char *expression )
-{
- char *name = strdup( lhs );
- char *value = ku_expr( expression );
- char *p;
-
- if( (p = subst_var_alias( name )) != NULL ) {
- /*
- * array element can then be assign as "x_[i] = ..."
- */
- free( name );
- name = p;
- }
-
- if( kc_flags.trace_debug ) {
- ku_alfa();
- printf( " ###### Expr %s = %s --> %s\n",
- name, expression, value );
- }
-
- store_variable( tos, name, value );
- free( name );
- free( value );
-
- return tos->pc + 1;
-}
-
-
-static
-int op_forlist( tos, var, list )
- ExecStack *tos;
- char *var;
- char *list;
-{
- char *dlist = strdup( list );
- char *elist = strdup( "" );
- char *p;
-
- for( p = strqtok( dlist ); p != NULL; p = strqtok( NULL ) ) {
-
- if( strcmp( p, "[*]" ) == 0 ) {
- int n = atoi( hash_lookup( tos->variables, "#", NULL ) );
- int i;
-
- for( i = 0; i < n; i++ ) {
- char buf[8];
- sprintf( buf, " [%d]", i + 1 );
- elist = mstrcat( elist, buf );
- }
- }
- else {
- elist = mstr2cat( elist, " ", p );
- }
- }
- store_variable( tos, var, elist );
- free( dlist );
- free( elist );
-
- return tos->pc + 1;
-}
-
-
-static
-int op_fornext( tos, loop_var, list_var )
- ExecStack *tos;
- char *loop_var;
- char *list_var;
-{
- char *list = strdup( hash_lookup( tos->variables, list_var, NULL ) );
- char *head = strqtok( list );
- char *tail;
- char *value;
- char *p;
-
- if( head == NULL ) {
- free( list );
- return tos->pc + 1;
- }
- else {
- value = ku_expr( head );
- store_variable( tos, loop_var, value );
- free( value );
-
- tail = strdup( "" );
- while( (p = strqtok( NULL )) != NULL ) {
- tail = mstr2cat( tail, " ", p );
- }
- store_variable( tos, list_var, tail );
- free( tail );
- }
- return tos->pc + 2;
-}
-
-
-static
-int op_goto( tos, user_label, aux_label )
- ExecStack *tos;
- char *user_label;
- char *aux_label;
-{
- if( user_label != NULL ) {
- char *label = ku_expr( user_label );
- int pc = find_label( tos->macro, label, 0 );
-
- if( kc_flags.trace_debug ) {
- ku_alfa();
- printf( " ###### Goto %s --> %s\n", user_label, label );
- }
-
- free( label );
- return pc;
- }
- else {
- if( kc_flags.trace_debug ) {
- ku_alfa();
- printf( " ###### Goto $%s\n", aux_label );
- }
-
- return find_label( tos->macro, aux_label, 1 );
- }
-}
-
-
-static
-char *arg_value( value, in_parm )
- char *value;
- int in_parm;
-{
- char *p;
- int n = strlen( value );
-
- if( value[0] == '\'' && value[n-1] == '\'' ) {
- int fixed = 0;
- int i;
-
- for( i = 1; i < n - 1; i++ ) {
-
- if( value[i] == '\'' ) {
-
- if( i < n - 2 && value[i+1] == '\'' ) {
- i++;
- }
- else {
- char *nvalue = strndup( value, i + 1 );
- nvalue = mstr2cat( nvalue, "'", value + i + 1 );
- free( value );
- value = nvalue;
- n++;
- i++;
- fixed = 1;
- }
- }
- }
-
- if( fixed ) {
- ExecStack *tos;
- if( in_parm ) {
- tos = &exec_stack[exec_stack_ptr-1];
- }
- else if( exec_stack_ptr > 1 ) {
- tos = &exec_stack[exec_stack_ptr-2];
- }
- else {
- tos = NULL;
- }
- if( tos == NULL ) {
- printf( " *** Warning in EXEC command:\n" );
- }
- else {
- printf( " *** Warning in %s at line %s:\n",
- tos->file->path, tos->line_number );
- }
- printf( " Old style use of quotes in macro argument fixed to %s\n",
- value );
- }
- }
-
- kc_alias.substitutions = 100; /* protect against recursive aliases */
-
- if( (p = subst_var_alias( value )) != NULL ) {
- free( value );
- value = p;
- }
-
- if( (p = subst_arg_alias( value )) != NULL ) {
- free( value );
- value = p;
- }
-
- if( (p = subst_sysfun( value, 1 )) != NULL ) {
- free( value );
- value = p;
- }
-
- return clean_word( value );
-}
-
-
-static
-int op_macro( tos, parameter_list, null2 )
- ExecStack *tos;
- char *parameter_list;
- char *null2;
-{
- char **equiv = (char**)malloc( sizeof(char*) );
- char *line;
- char *tok;
- char buf[8];
- int npar = 0;
- int narg = 0;
- int i;
-
- if( parameter_list != NULL ) {
- /*
- * assign the variables defined in the macro header
- */
- line = strdup( parameter_list );
-
- for( tok = strqtok( line ); tok != NULL; tok = strqtok( NULL ) ) {
- char buf[8];
- char *name = tok;
- char *value;
- char *p;
- int n;
-
- if( (p = strchr( name, '=' )) != NULL ) {
- /* "var=value" */
- *p = '\0';
- }
-
- /* allow "[1]" instead of "1" */
- n = strlen( name );
- if( name[0] == '[' && name[n-1] == ']' ) {
- name[n-1] = '\0';
- strcpy( name, name + 1 );
- }
-
- /*
- * enter named and numbered variables and keep equivalence between them
- */
- if( strlen( name ) != len_variable( name ) ) {
- ku_alfa();
- printf( " *** Invalid name for macro parameter [%d] in file %s\n",
- npar + 1, tos->file->path );
- printf( "%s: %s\n", tos->line_number, tos->source_line );
-
- for( i = 0; i < npar; i++ ) {
- free( equiv[i] );
- }
- free( (char*)equiv );
- free( line );
-
- return -1;
- }
-
- if( p != NULL ) {
- /* "var=value" */
- value = arg_value( strdup( p + 1 ), 1 );
- }
- else {
- /* variable name with empty initial value */
- value = strdup( "" );
- }
- hash_insert( tos->variables, name, value, 0 );
- sprintf( buf, "%d", ++npar );
- hash_insert( tos->variables, buf, value, 0 );
- free( value );
-
- equiv = (char**)realloc( (char*)equiv, npar * sizeof(char*) );
- equiv[npar-1] = strdup( name );
- }
-
- free( line );
- }
-
- if( tos->argline != NULL ) {
- /*
- * assign variable from EXEC argument list
- */
- int named = 0;
-
- line = strdup( tos->argline );
-
- for( tok = strqtok( line ); tok != NULL; tok = strqtok( NULL ) ) {
- char *name;
- char *value;
- int n = len_variable( tok );
-
- if( n > 0 && tok[n] == '=' ) {
- /* "name=value" */
- named = 1;
- tok[n] = '\0';
- name = tok;
-
- /*
- * for "name=!" we don't want to overwrite the MACRO default
- */
- if( strcmp( tok + n + 1, "!" ) == 0 ) {
- value = hash_lookup( tos->variables, name, NULL );
- if( value == NULL )
- value = strdup( "!" );
- else
- value = strdup( value );
- }
- else {
- value = arg_value( strdup( tok + n + 1 ), 0 );
- }
-
- hash_insert( tos->variables, name, value, 0 );
-
- /*
- * If the name is defined as macro parameter we also have to set the
- * corresponding numbered variable.
- */
- for( i = 0; i < npar; i++ ) {
- if( strcasecmp( equiv[i], name ) == 0 ) {
- sprintf( buf, "%d", i + 1 );
- hash_insert( tos->variables, buf, value, 0 );
- break;
- }
- }
- }
- else {
- /* unnamed value */
-
- value = arg_value( strdup( tok ), 0 );
-
- if( named ) {
- /*
- * If we have unnamed values following named values then we assign
- * them to numbered variables beyond those defined in the macro
- * header.
- */
- if( narg < npar ) {
- narg = npar;
- }
- }
- else if( narg < npar ) {
- /*
- * We alse have to set the named variable corresponding to the
- * numbered variable.
- */
- name = equiv[narg];
- if( strcmp( tok, "!" ) == 0 ) {
- free( value );
- value = strdup( hash_lookup( tos->variables, name, NULL ) );
- }
- else {
- hash_insert( tos->variables, name, value, 0 );
- }
- }
-
- sprintf( buf, "%d", ++narg );
- hash_insert( tos->variables, buf, value, 0 );
- }
- free( value );
- }
- free( line );
- }
-
- for( i = 0; i < npar; i++ ) {
- free( equiv[i] );
- }
- free( (char*)equiv );
-
- if( narg < npar ) {
- narg = npar;
- }
-
- sprintf( buf, "%d", narg );
- hash_insert( tos->variables, "#", buf, 0 );
-
- if( narg > 0 ) {
- line = strdup( hash_lookup( tos->variables, "1", NULL ) );
- for( i = 1; i < narg; i++ ) {
- sprintf( buf, "%d", i + 1 );
- line = mstr2cat( line, " ", hash_lookup( tos->variables, buf, NULL ) );
- }
- hash_insert( tos->variables, "*", line, 0 );
- free( line );
- }
- else {
- hash_insert( tos->variables, "*", "", 0 );
- }
-
- hash_insert( tos->variables, "@", "0", 1 );
- hash_insert( kc_alias.global_value, "@", "0", 0 );
-
- line = str3dup( tos->file->path, "#", tos->macro->name );
- hash_insert( tos->variables, "0", line, 0 );
- free( line );
-
- return tos->pc + 1;
-}
-
-
-int ku_match( const char *string,
- const char *pattern,
- int ignore_case )
-{
- if( pattern[0] == '*' ) {
-
- while( ku_match( string, pattern + 1, ignore_case ) == 0 ) {
-
- if( string[0] == '\0' )
- return 0;
- else
- string++;
- }
- return 1;
- }
- else {
- int p0 = pattern[0];
- int s0 = string[0];
-
- if( ignore_case ) {
- if( isupper( p0 ) )
- p0 = tolower( p0 );
- if( isupper( s0 ) )
- s0 = tolower( s0 );
- }
-
- if( p0 == s0 ) {
-
- if( pattern[0] == '\0' )
- return 1;
-
- return ku_match( string + 1, pattern + 1, ignore_case );
- }
- }
- return 0;
-}
-
-
-static
-int op_match( tos, variable, pattern_list )
- ExecStack *tos;
- char *variable;
- char *pattern_list;
-{
- char *value = hash_lookup( tos->variables, variable, NULL );
- char *pattern = strdup( pattern_list );
- char *p;
-
- for( p = strtok( pattern, "," ); p != NULL; p = strtok( NULL, "," ) ) {
- int match;
- int n;
-
- while( p[0] == ' ' )
- p++;
-
- n = strlen( p );
- while( n > 0 && p[n-1] == ' ' )
- p[--n] = '\0';
-
- match = ku_match( value, p, 0 );
-
- if( kc_flags.trace_debug ) {
- ku_alfa();
- printf( " ###### Match %s ~ %s --> %s\n",
- value, p, match ? "yes" : "no" );
- }
-
- if( match ) {
- free( pattern );
- return tos->pc + 2;
- }
- }
-
- free( pattern );
- return tos->pc + 1;
-}
-
-
-static
-int op_math( tos, variable_name, expression )
- ExecStack *tos;
- char *variable_name;
- char *expression;
-{
- double dval;
- int status = ku_math( expression, &dval );
-
- if( kc_flags.trace_debug ) {
- ku_alfa();
- printf( " ###### Math %s = %s --> %g%s\n",
- variable_name, expression,
- status == 0 ? dval : 0.0,
- status == 0 ? "" : " <Error>" );
- }
-
- if( status != 0 ) {
- ku_alfa();
- printf( " *** Invalid arithmetic expression in file %s\n",
- tos->file->path );
- printf( "%s: %s\n", tos->line_number, tos->source_line );
- return -1;
- }
- else {
- store_variable( tos, variable_name, strfromd( dval, 0 ) );
- return tos->pc + 1;
- }
-}
-
-
-static
-int op_on_error( tos, keyword, argument )
- ExecStack *tos;
- char *keyword;
- char *argument;
-{
- switch( keyword[0] ) {
-
- case '-': /* OFF */
- tos->off_error_stmt = tos->on_error_stmt;
- tos->off_error_arg = tos->on_error_arg;
- tos->on_error_stmt = ON_ERROR_CONTINUE;
- tos->on_error_arg = NULL;
- break;
-
- case '+': /* ON */
- tos->on_error_stmt = tos->off_error_stmt;
- tos->on_error_arg = tos->off_error_arg;
- break;
-
- case 'C':
- tos->on_error_stmt = ON_ERROR_CONTINUE;
- tos->on_error_arg = argument;
- break;
-
- case 'G':
- tos->on_error_stmt = ON_ERROR_GOTO;
- tos->on_error_arg = argument;
- break;
-
- case 'E':
- tos->on_error_stmt = ON_ERROR_EXITM;
- tos->on_error_arg = argument;
- break;
-
- case 'S':
- tos->on_error_stmt = ON_ERROR_STOPM;
- tos->on_error_arg = argument;
- break;
-
- }
-
- return tos->pc + 1;
-}
-
-
-static
-int op_read( tos, variable, prompt_expr )
- ExecStack *tos;
- char *variable;
- char *prompt_expr;
-{
- char *prompt;
- char *dfault;
- const char *value;
-
- if( prompt_expr == NULL ) {
- prompt = str5dup( "Macro ", tos->macro->name, ": ", variable, " ?" );
- }
- else {
- prompt = ku_expr( prompt_expr );
- }
-
- if( (value = hash_lookup( tos->variables, variable, NULL )) == NULL ) {
- value = "";
- }
- dfault = strdup( value );
-
- value = ku_pros( prompt, dfault );
- store_variable( tos, variable, value );
-
- free( prompt );
- free( dfault );
-
- return tos->pc + 1;
-}
-
-
-static
-int op_return( tos, expression, stopm )
- ExecStack *tos;
- char *expression;
- char *stopm;
-{
- if( expression != NULL ) {
- char *value = ku_expr( expression );
-
- if( kc_flags.trace_debug ) {
- ku_alfa();
- printf( " ###### Return %s --> %s\n",
- expression, value );
- }
- store_variable( tos, "@", value );
- free( value );
- }
- else if( kc_flags.trace_debug ) {
- ku_alfa();
- printf( " ###### Return\n" );
- }
-
- if( stopm != NULL )
- tos->status = KUMAC_UNWIND;
-
- return -1;
-}
-
-
-static
-int op_shift( tos, null1, null2 )
- ExecStack *tos;
- char *null1;
- char *null2;
-{
- char buf[8];
- int n = atoi( hash_lookup( tos->variables, "#", NULL ) );
- int i;
-
- for( i = 1; i < n; i++ ) {
- char *value;
- sprintf( buf, "%d", i + 1 );
- value = hash_lookup( tos->variables, buf, NULL );
- sprintf( buf, "%d", i );
- store_variable( tos, buf, value );
- }
-
- if( n > 0 ) {
- sprintf( buf, "%d", n );
- hash_remove( tos->variables, buf );
- sprintf( buf, "%d", n - 1 );
- store_variable( tos, "#", buf );
- }
-
- if( n > 1 ) {
- char *line = strdup( hash_lookup( tos->variables, "1", NULL ) );
- for( i = 1; i < n - 1; i++ ) {
- sprintf( buf, "%d", i + 1 );
- line = mstr2cat( line, " ", hash_lookup( tos->variables, buf, NULL ) );
- }
- store_variable( tos, "*", line );
- free( line );
- }
- else if( n == 1 ) {
- store_variable( tos, "*", "" );
- }
-
- return tos->pc + 1;
-}
-
-
-static
-int op_trace( tos, label, variable )
- ExecStack *tos;
- char *label;
- char *variable;
-{
- if( kc_flags.trace_on ) {
- char *value = hash_lookup( tos->variables, variable, NULL );
-
- ku_alfa();
- if( label[0] == '=' ) {
- printf( " >>>>>> %s%s = %s\n", label + 1, variable, value );
- }
- else {
- printf( " >>>>>> %s%s\n", label, value );
- }
- }
-
- return tos->pc + 1;
-}
-
-
-static
-void add_code( macro, op, arg1, arg2 )
- KumacMacro *macro;
- int (*op)();
- char *arg1;
- char *arg2;
-{
- KumacCode *code;
-
- macro->ncode++;
- if( macro->code == NULL ) {
- macro->code = (KumacCode*)malloc( sizeof(KumacCode) );
- }
- else {
- macro->code = (KumacCode*)realloc( (char*)macro->code,
- macro->ncode * sizeof(KumacCode) );
- }
- code = ¯o->code[macro->ncode-1];
-
- code->op = op;
- code->arg[0] = arg1 == NULL ? NULL : strdup( arg1 );
- code->arg[1] = arg2 == NULL ? NULL : strdup( arg2 );
-}
-
-
-static
-char *read_line( stream, macro )
- FILE *stream;
- KumacMacro *macro;
-{
- char buf[1024];
- char *line;
- char *p;
-
- if( fgets( buf, (sizeof buf), stream ) == NULL ) {
- return NULL;
- }
- else {
- /*
- * allow @( and @) as square brackets missing on some IBM keyboards
- */
- while( (p = strstr( buf, "@(" )) != NULL ) {
- *p = '[';
- strcpy( p + 1, p + 2 );
- }
- while( (p = strstr( buf, "@)" )) != NULL ) {
- *p = ']';
- strcpy( p + 1, p + 2 );
- }
-
- /* remove tabs and trailing blanks */
- line = struntab( strdup( buf ) );
-
- sprintf( buf, "%3d", ++line_count );
- add_code( macro, op_source, buf, line );
-
- return line;
- }
-}
-
-
-static
-KumacStatement parse_statement( line )
- char *line;
-{
- KmCommand **cmd_list;
- KmCommand *cmd;
- KumacStatement stmt = SYNTAX_ERROR;
- char *tokline = strdup( line );
- char *tok1 = strqtok( tokline );
- char *tok2 = strqtok( NULL );
- char *p;
- int len1 = strlen( tok1 );
- int n;
-
- if( stmt_arg1 != NULL ) {
- free( stmt_arg1 );
- stmt_arg1 = NULL;
- }
- if( stmt_arg2 != NULL ) {
- free( stmt_arg2 );
- stmt_arg2 = NULL;
- }
- if( stmt_arg3 != NULL ) {
- free( stmt_arg3 );
- stmt_arg3 = NULL;
- }
- if( stmt_arg4 != NULL ) {
- free( stmt_arg4 );
- stmt_arg4 = NULL;
- }
-
-
- if( strcasecmp( tok1, "GO" ) == 0 && strcasecmp( tok2, "TO" ) == 0 ) {
- tok1 = "GOTO";
- tok2 = strqtok( NULL );
- }
-
-
- if( strcasecmp( tok1, "LET" ) == 0 ) {
- tok1 = tok2;
- tok2 = strqtok( NULL );
- }
-
-
- if( strchr( tok1 + 1, '=' ) != NULL
- || ( tok2 != NULL && tok2[0] == '=' ) ) {
- /* variable assignment */
-
- p = strchr( line, '=' );
- stmt = ASSIGNMENT_Statement;
- stmt_arg1 = strtrim( strndup( line, p - line ) );
- stmt_arg2 = strtrim( strdup( p + 1 ) );
- }
-
-
- else if( strcasecmp( tok1, "IF" ) == 0 ) {
- n = strlen( line );
-
- if( strcasecmp( line + n - 5, " THEN" ) == 0 ) {
-
- stmt_arg1 = strtrim( strndup( line + len1 + 1, n - len1 - 6 ) );
-
- if( stmt_arg1[0] == '\0' ) {
- print_error( "IF-THEN statement without expression", NULL );
- stmt = SYNTAX_ERROR;
- }
- else {
- stmt = IF_THEN_Statement;
- }
- }
- else if( strcasecmp( tok1, "IF" ) == 0 ) {
- /* check for "IF expr GOTO label" */
-
- strcpy( tokline, line );
- if( (p = strrchr( tokline, ' ' )) != NULL ) {
-
- stmt_arg2 = strdup( p + 1 ); /* label */
-
- while( p > tokline && p[-1] == ' ' )
- p--;
- *p = '\0';
-
- if( (p = strrchr( tokline, ' ' )) != NULL ) {
-
- if( strcasecmp( p + 1, "TO" ) == 0 ) {
-
- while( p > tokline && p[-1] == ' ' )
- p--;
- *p = '\0';
-
- if( (p = strrchr( tokline, ' ' )) != NULL ) {
-
- if( strcasecmp( p + 1, "GO" ) == 0 ) {
-
- while( p > tokline && p[-1] == ' ' )
- p--;
- *p = '\0';
- }
- else {
- p = NULL;
- }
- }
- }
- else if( strcasecmp( p + 1, "GOTO" ) == 0 ) {
-
- while( p > tokline && p[-1] == ' ' )
- p--;
- *p = '\0';
- }
- else {
- p = NULL;
- }
- }
- }
-
- if( p == NULL ) {
- print_error( "Invalid IF statement (THEN missing?)", NULL );
- stmt = SYNTAX_ERROR;
- }
- else {
- stmt = IF_GOTO_Statement;
- stmt_arg1 = strtrim( strdup( tokline + 3 ) ); /* expr */
- }
- }
- }
-
- else if( strcasecmp( tok1, "ELSEIF" ) == 0 ) {
-
- n = strlen( line );
-
- if( strcasecmp( line + n - 5, " THEN" ) != 0 ) {
- print_error( ">Missing THEN at end of ELSEIF statement supplied", NULL );
- stmt_arg1 = strtrim( strdup( line + len1 + 1 ) );
- }
- else {
- stmt_arg1 = strtrim( strndup( line + len1 + 1, n - len1 - 6 ) );
- }
-
- if( stmt_arg1[0] == '\0' ) {
- print_error( "ELSEIF statement without expression", NULL );
- stmt = SYNTAX_ERROR;
- }
- else {
- stmt = ELSEIF_Statement;
- }
- }
-
- else if( strcasecmp( tok1, "ELSE" ) == 0 ) {
-
- if( tok2 != NULL ) {
- too_much( tok1 );
- }
- stmt = ELSE_Statement;
- }
-
- else if( strcasecmp( tok1, "ENDIF" ) == 0 ) {
-
- if( tok2 != NULL ) {
- too_much( tok1 );
- }
- stmt = ENDIF_Statement;
- }
-
-
- else if( strcasecmp( tok1, "CASE" ) == 0 ) {
-
- n = strlen( line );
-
- if( strcasecmp( line + n - 3, " IN" ) != 0 ) {
- print_error( ">Missing IN at end of CASE statement supplied", NULL );
- stmt_arg1 = strtrim( strdup( line + len1 + 1 ) );
- }
- else {
- stmt_arg1 = strtrim( strndup( line + len1 + 1, n - len1 - 4 ) );
- }
-
- if( stmt_arg1[0] == '\0' ) {
- print_error( "CASE statement without expression", NULL );
- stmt = SYNTAX_ERROR;
- }
- else {
- stmt = CASE_Statement;
- }
- }
-
- else if( tok1[0] == '(' ) {
- /* case label */
-
- stmt_arg1 = strdup( strchr( line, '(' ) + 1 );
-
- if( (p = strchr( stmt_arg1, ')' )) == NULL ) {
- print_error( "Invalid CASE label", NULL );
- stmt = SYNTAX_ERROR;
- }
- else {
- *p = '\0';
- stmt = CASE_Label;
- stmt_arg2 = strtrim( strdup( p + 1 ) );
- if( stmt_arg2[0] == '\0' ) {
- free( stmt_arg2 );
- stmt_arg2 = NULL;
- }
- }
- }
-
- else if( strcasecmp( tok1, "ENDCASE" ) == 0 ) {
-
- if( tok2 != NULL ) {
- too_much( tok1 );
- }
- stmt = ENDCASE_Statement;
- }
-
-
- else if( strcasecmp( tok1, "DO" ) == 0 ) {
-
- if( tok2 == NULL ) {
- print_error( "DO statement without loop variable", NULL );
- stmt = SYNTAX_ERROR;
- }
- else if( (p = strchr( line, '=' )) == NULL ) {
- print_error( "DO statement without init expression", NULL );
- stmt = SYNTAX_ERROR;
- }
- else {
- int quoted = 0;
- int paren = 0;
-
- stmt = DO_Statement;
- stmt_arg1 = strtrim( strndup( line + len1 + 1, p - line - len1 - 1 ) );
-
- stmt_arg2 = strdup( p + 1 );
- for( n = 0; stmt_arg2[n] != '\0'; n++ ) {
- if( stmt_arg2[n] == '\'' )
- quoted = !quoted;
- else if( !quoted ) {
- if( stmt_arg2[n] == '(' )
- paren++;
- else if( stmt_arg2[n] == ')' )
- paren--;
- else if( paren == 0 && stmt_arg2[n] == ',' )
- break;
- }
- }
-
- if( !quoted && paren == 0 ) {
-
- if( stmt_arg2[n] != ',' ) {
- print_error( "DO statement without end expression", NULL );
- stmt = SYNTAX_ERROR;
- }
- else {
- stmt_arg2[n] = '\0';
- p += n + 1;
- stmt_arg3 = strdup( p + 1 );
- for( n = 0; stmt_arg3[n] != '\0'; n++ ) {
- if( stmt_arg3[n] == '\'' )
- quoted = !quoted;
- else if( !quoted ) {
- if( stmt_arg3[n] == '(' )
- paren++;
- else if( stmt_arg3[n] == ')' )
- paren--;
- else if( paren == 0 && stmt_arg3[n] == ',' )
- break;
- }
- }
-
- if( !quoted && paren == 0 ) {
-
- if( stmt_arg3[n] != ',' ) {
- stmt_arg4 = strdup( "1" );
- }
- else {
- stmt_arg3[n] = '\0';
- stmt_arg4 = strtrim( strdup( p + n + 2 ) );
- }
- }
- }
- }
-
- if( quoted ) {
- print_error( "DO statement with unbalanced quotes", NULL );
- stmt = SYNTAX_ERROR;
- }
- else if( paren != 0 ) {
- print_error( "DO statement with unbalanced parentheses", NULL );
- stmt = SYNTAX_ERROR;
- }
- else {
- strtrim( stmt_arg2 );
- strtrim( stmt_arg3 );
- if( stmt_arg2[0] == '\0' ) {
- print_error( "DO statement with empty start expression", NULL );
- stmt = SYNTAX_ERROR;
- }
- if( stmt_arg3[0] == '\0' ) {
- print_error( "DO statement with empty end expression", NULL );
- stmt = SYNTAX_ERROR;
- }
- if( stmt_arg4[0] == '\0' ) {
- print_error( ">Missing increment 1 at end of DO statement supplied",
- NULL );
- stmt_arg4 = mstrcat( stmt_arg4, "1" );
- }
- }
- }
- }
-
- else if( strcasecmp( tok1, "ENDDO" ) == 0 ) {
-
- if( tok2 != NULL ) {
- too_much( tok1 );
- }
- stmt = ENDDO_Statement;
- }
-
-
- else if( strcasecmp( tok1, "FOR" ) == 0 ) {
-
- if( tok2 == NULL ) {
- print_error( "FOR statement without loop variable", NULL );
- stmt = SYNTAX_ERROR;
- }
- else if( (p = strqtok( NULL )) == NULL
- || strcasecmp( p, "IN" ) != 0 ) {
- print_error( "Invalid FOR statement", NULL );
- stmt = SYNTAX_ERROR;
- }
- else {
- stmt = FOR_Statement;
- stmt_arg1 = strdup( tok2 );
- stmt_arg2 = strdup( "" );
-
- while( (p = strqtok( NULL )) != NULL ) {
- if( stmt_arg2[0] != '\0' )
- stmt_arg2 = mstrcat( stmt_arg2, " " );
- stmt_arg2 = mstrcat( stmt_arg2, p );
- }
- if( stmt_arg2[0] == '\0' ) {
- print_error( ">FOR statement with empty expression list", NULL );
- }
- }
- }
-
- else if( strcasecmp( tok1, "ENDFOR" ) == 0 ) {
-
- if( tok2 != NULL ) {
- too_much( tok1 );
- }
- stmt = ENDFOR_Statement;
- }
-
-
- else if( strcasecmp( tok1, "REPEAT" ) == 0 ) {
-
- if( tok2 != NULL ) {
- too_much( tok1 );
- }
- stmt = REPEAT_Statement;
- }
-
- else if( strcasecmp( tok1, "UNTIL" ) == 0 ) {
-
- if( tok2 == NULL ) {
- print_error( "UNTIL statement without expression", NULL );
- stmt = SYNTAX_ERROR;
- }
- else {
- stmt = UNTIL_Statement;
- stmt_arg1 = strtrim( strdup( line + len1 + 1 ) );
- }
- }
-
-
- else if( strcasecmp( tok1, "WHILE" ) == 0 ) {
-
- if( tok2 == NULL ) {
- print_error( "WHILE statement without expression", NULL );
- stmt = SYNTAX_ERROR;
- }
- else {
- stmt = WHILE_Statement;
- n = strlen( line );
- if( strcasecmp( line + n - 3, " DO" ) != 0 ) {
- print_error( ">Missing DO at end of WHILE statement supplied", NULL );
- }
- else {
- n -= 3;
- }
- stmt_arg1 = strtrim( strndup( line + len1 + 1, n - len1 - 1 ) );
- if( stmt_arg1[0] == '\0' ) {
- print_error( "WHILE statement with empty expression", NULL );
- stmt = SYNTAX_ERROR;
- }
- }
- }
-
- else if( strcasecmp( tok1, "ENDWHILE" ) == 0 ) {
-
- if( tok2 != NULL ) {
- too_much( tok1 );
- }
- stmt = ENDWHILE_Statement;
- }
-
-
- else if( strcasecmp( tok1, "BREAKL" ) == 0 ) {
-
- stmt = BREAKL_Statement;
- if( tok2 == NULL ) {
- stmt_arg1 = strdup( "1" );
- }
- else {
- char *tail;
- n = fstrtoi( tok2, &tail );
- if( *tail != '\0' || n < 1 ) {
- print_error( "BREAKL level must be an integer constant >= 1", NULL );
- stmt = SYNTAX_ERROR;
- }
- else {
- stmt_arg1 = strdup( tok2 );
- if( strqtok( NULL ) != NULL ) {
- too_much( tok1 );
- }
- }
- }
- }
-
- else if( strcasecmp( tok1, "NEXTL" ) == 0 ) {
-
- stmt = NEXTL_Statement;
- if( tok2 == NULL ) {
- stmt_arg1 = strdup( "1" );
- }
- else {
- char *tail;
- n = fstrtoi( tok2, &tail );
- if( *tail != '\0' || n < 1 ) {
- print_error( "NEXTL level must be an integer constant >= 1", NULL );
- stmt = SYNTAX_ERROR;
- }
- else {
- stmt_arg1 = strdup( tok2 );
- if( strqtok( NULL ) != NULL ) {
- too_much( tok1 );
- }
- }
- }
- }
-
-
- else if( strcasecmp( tok1, "GOTO" ) == 0 ) {
-
- if( tok2 == NULL ) {
- print_error( "GOTO statement without label", NULL );
- stmt = SYNTAX_ERROR;
- }
- else {
- stmt = GOTO_Statement;
- stmt_arg1 = strdup( tok2 );
- if( strqtok( NULL ) != NULL ) {
- too_much( tok1 );
- }
- }
- }
-
- else if( tok1[len1-1] == ':' ) {
- /* target label */
-
- stmt = GOTO_Label;
- stmt_arg1 = strndup( tok1, len1 - 1 );
- if( tok2 != NULL )
- stmt_arg2 = strtrim( strdup( line + len1 ) );
- }
-
-
- else if( strcasecmp( tok1, "MACRO" ) == 0 ) {
-
- if( tok2 == NULL ) {
- print_error( "MACRO statement without macro name", NULL );
- stmt = SYNTAX_ERROR;
- }
- else {
- stmt = MACRO_Statement;
- stmt_arg1 = strdup( tok2 );
- p = strstr( line + len1 + 1, tok2 ) + strlen( tok2 );
- if( *p != '\0' )
- stmt_arg2 = strtrim( strdup( p + 1 ) );
- }
- }
-
- else if( ( strcasecmp( tok1, "ON" ) == 0
- || strcasecmp( tok1, "OF" ) == 0
- || strcasecmp( tok1, "OFF" ) == 0 )
- && strcasecmp( tok2, "ERROR" ) == 0 ) {
-
- if( strcasecmp( tok1, "ON" ) != 0 ) {
- stmt = OFF_ERROR_Statement;
- }
- else if( (p = strqtok( NULL )) == NULL ) {
- stmt = ON_ERROR_Statement;
- }
- else if( strcasecmp( p, "GOTO" ) == 0
- || ( strcasecmp( p, "GO" ) == 0 && (p = strqtok( NULL )) != NULL
- && strcasecmp( p, "TO" ) == 0 ) ) {
-
- if( (p = strqtok( NULL)) == NULL ) {
- print_error( "ON ERROR GOTO statement without label", NULL );
- stmt = SYNTAX_ERROR;
- }
- else {
- stmt = ON_ERROR_GOTO;
- stmt_arg1 = strdup( p );
- }
- }
- else if( strcasecmp( p, "CONTINUE" ) == 0 ) {
- stmt = ON_ERROR_CONTINUE;
- }
- else if( strcasecmp( p, "EXITM" ) == 0 ) {
- stmt = ON_ERROR_EXITM;
- if( (p = strqtok( NULL )) != NULL ) {
- stmt_arg1 = strdup( p );
- }
- }
- else if( strcasecmp( p, "STOPM" ) == 0 ) {
- stmt = ON_ERROR_STOPM;
- }
- else {
- print_error( "Invalid ON ERROR statement", NULL );
- stmt = SYNTAX_ERROR;
- }
-
- if( stmt != SYNTAX_ERROR && (p = strqtok( NULL )) != NULL ) {
- too_much( "ON ERROR" );
- }
- }
-
- else if( strcasecmp( tok1, "READ" ) == 0 ) {
-
- if( tok2 == NULL ) {
- print_error( "READ statement without variable name", NULL );
- stmt = SYNTAX_ERROR;
- }
- else {
- stmt = READ_Statement;
- stmt_arg1 = strdup( tok2 );
- p = strstr( line + len1 + 1, tok2 );
- n = strlen( tok2 );
- if( p[n] != '\0' ) {
- stmt_arg2 = strtrim( strdup( p + n ) );
- }
- }
- }
-
- else if( strcasecmp( tok1, "SHIFT" ) == 0 ) {
-
- if( tok2 != NULL ) {
- too_much( tok1 );
- }
- stmt = SHIFT_Statement;
- }
-
-
- else if( strcasecmp( tok1, "EXITM" ) == 0 ) {
-
- stmt = EXITM_Statement;
- if( tok2 != NULL ) {
- stmt_arg1 = strtrim( strdup( line + len1 + 1 ) );
- }
- }
-
- else if( strcasecmp( tok1, "RETURN" ) == 0 ) {
-
- stmt = RETURN_Statement;
- if( tok2 != NULL ) {
- stmt_arg1 = strtrim( strdup( line + len1 + 1 ) );
- }
- }
-
- else if( strcasecmp( tok1, "STOPM" ) == 0 ) {
-
- if( tok2 != NULL ) {
- too_much( tok1 );
- }
- stmt = STOPM_Statement;
- }
-
- else if( strcasecmp( tok1, "ENDKUMAC" ) == 0 ) {
-
- if( tok2 != NULL ) {
- too_much( tok1 );
- }
- stmt = EOF_REACHED;
- }
-
-
- else if( (cmd = search_command( tok1, &cmd_list )) != NULL
- && strcasecmp( cmd->path, "/KUIP/SET_SHOW/APPLICATION" ) == 0 ) {
-
- if( tok2 == NULL ) {
- print_error( "APPLICATION statement without application name", NULL );
- stmt = SYNTAX_ERROR;
- }
- else {
- stmt = APPLICATION_Statement;
- stmt_arg1 = strdup( tok2 );
-
- if( (p = strqtok( NULL )) == NULL ) {
- stmt_arg2 = strdup( "EXIT" );
- }
- else {
- stmt_arg2 = strdup( p );
- if( (p = strqtok( NULL )) != NULL ) {
- too_much( "APPLICATION" );
- }
- }
- }
- }
-
- else {
- /* command */
- stmt = COMMAND_Statement;
- stmt_arg1 = strdup( full_line );
- }
-
- free( tokline );
-
-#ifdef DBMALLOC
- if( stmt_arg1 != NULL ) {
- malloc_mark( stmt_arg1 );
- }
- if( stmt_arg2 != NULL ) {
- malloc_mark( stmt_arg2 );
- }
- if( stmt_arg3 != NULL ) {
- malloc_mark( stmt_arg3 );
- }
- if( stmt_arg4 != NULL ) {
- malloc_mark( stmt_arg4 );
- }
-#endif
-
- return stmt;
-}
-
-
-static
-KumacStatement next_statement( stream, macro )
- FILE *stream;
- KumacMacro *macro;
-{
- KumacStatement stmt;
- char *tail;
- char *p;
- int quoted = 0;
- int n = 0;
-
- if( full_line == NULL ) {
- if( (full_line = read_line( stream, macro )) == NULL ) {
- return EOF_REACHED;
- }
- }
-
- while( full_line[n] == ' ' )
- n++;
- if( n > 0 )
- memmove(full_line, full_line + n, strlen(full_line + n) + 1);
-/* overlapping strings, use memmove strcpy( full_line, full_line + n ); */
-
- if( full_line[0] == '\0' || full_line[0] == '*' || full_line[0] == '|' ) {
- /* empty or comment line */
- free( full_line );
- full_line = NULL;
- return next_statement( stream, macro );
- }
-
- /* remove inline comments */
- for( p = full_line; *p != '\0'; p++ ) {
-
- if( *p == '\'' ) {
- quoted = !quoted;
- }
- /* p+1 is always valid, even if its \0 */
- /* This allows || to pass through */
- else if( !quoted && *p == '|' && *(p+1) != '|' ) {
- while( p > full_line && p[-1] == ' ' )
- p--;
- *p = '\0';
- quoted = -1;
- break;
- }
- }
-
- if( quoted != -1 ) {
- /* check for continuation lines */
-
- n = strlen( full_line );
- if( full_line[n-1] == '_' ) {
- /* continuation line */
- char *line = read_line( stream, macro );
-
- full_line[--n] = '\0';
-
- if( line == NULL ) {
- print_error( ">Line concatenation before EOF ignored", NULL );
- while( n > 0 && full_line[n-1] == ' ' )
- n--;
- full_line[n] = '\0';
- }
- else {
- /* keep only one of multiple leading blanks */
- p = line;
- while( *p == ' ' )
- p++;
- if( p > line )
- p--;
- full_line = mstrcat( full_line, p );
- free( line );
- return next_statement( stream, macro );
- }
- }
- if( quoted ) {
- print_error( ">Missing quote character supplied at end of line", NULL );
- full_line = mstrcat( full_line, "'" );
- }
- }
-
- tail = split_at_semicolon( full_line );
-
- if( (stmt = parse_statement( full_line )) == COMMAND_Statement ) {
-
- if( *tail == '&' || *tail == '!' ) {
- /* flag "cmd1 ;& cmd2" or "cmd1 ;! cmd2 */
- stmt_arg2 = strndup( tail++, 1 );
- while( *tail == ' ' )
- tail++;
- }
- }
-
- else if( stmt == CASE_Label || stmt == GOTO_Label ) {
- /*
- * If a label is followed by another statement on the same line
- * we have to push back the statement returned as stmt_arg2.
- */
- if( stmt_arg2 != NULL ) {
-
- if( *tail == '\0' ) {
- free( full_line );
- full_line = stmt_arg2;
- }
- else {
- strcpy( full_line, stmt_arg2 );
- strcat( full_line, "; " );
- strcat( full_line, tail );
- free( stmt_arg2 );
- }
- stmt_arg2 = NULL;
- return stmt;
- }
- }
-
- if( *tail == '\0' ) {
- free( full_line );
- full_line = NULL;
- }
- else {
- strcpy( full_line, tail );
- }
-
- return stmt;
-}
-
-
-static
-KumacMacro *new_macro( file )
- KumacFile *file;
-{
- KumacMacro *macro;
-
- if( file->macros == NULL ) {
- macro = file->macros = (KumacMacro*)malloc( sizeof(KumacMacro) );
- }
- else {
- macro = file->macros;
- while( macro->next != NULL )
- macro = macro->next;
- macro = macro->next = (KumacMacro*)malloc( sizeof(KumacMacro) );
- }
- macro->name = NULL;
- macro->next = NULL;
- macro->ncode = 0;
- macro->code = NULL;
-
- label_count = 0;
-
- return macro;
-}
-
-
-static
-NestStack *push_stack( stmt, var )
- KumacStatement stmt;
- char *var;
-{
- NestStack *tos;
-
- if( ++nest_stack_ptr > nest_stack_max ) {
- nest_stack_max = nest_stack_ptr;
- if( nest_stack == NULL ) {
- nest_stack = (NestStack*)malloc( sizeof(NestStack) );
- }
- else {
- nest_stack = (NestStack*)realloc( (char*)nest_stack,
- nest_stack_max * sizeof(NestStack) );
- }
-#ifdef DBMALLOC
- malloc_mark( nest_stack );
-#endif
- }
-
- tos = &nest_stack[nest_stack_ptr-1];
-
- tos->stmt = stmt;
- tos->var = str0dup( var );
- sprintf( tos->tmp1, "tmp1.%d", nest_stack_ptr );
- sprintf( tos->tmp2, "tmp2.%d", nest_stack_ptr );
- sprintf( tos->label1, "%d", ++label_count );
- sprintf( tos->label2, "%d", ++label_count );
- sprintf( tos->label3, "%d", ++label_count );
-
- return tos;
-}
-
-
-static
-NestStack *pop_stack()
-{
-
- if( nest_stack_ptr > 0 && nest_stack_ptr-- > 0 ) {
- NestStack *tos = &nest_stack[nest_stack_ptr];
-
- if( tos->var != NULL ) {
- free( tos->var );
- }
- }
- if( nest_stack_ptr > 0 ) {
- return &nest_stack[nest_stack_ptr-1];
- }
- else {
- return NULL;
- }
-}
-
-
-/*
- * free macro structure;
- */
-static
-void free_macro( macro )
- KumacMacro *macro;
-{
- int i;
-
- if( macro->name != NULL )
- free( macro->name );
-
- for( i = 0; i < macro->ncode; i++ ) {
- KumacCode *code = ¯o->code[i];
-
- if( code->arg[0] != NULL )
- free( code->arg[0] );
- if( code->arg[1] != NULL )
- free( code->arg[1] );
- }
-
- if( macro->code != NULL )
- free( (char*)macro->code );
-
- free( (char*)macro );
-}
-
-
-/*
- * free kumac structure;
- */
-static
-void free_kumac( file )
- KumacFile *file;
-{
- KumacMacro *macro = file->macros;
-
- free( file->path );
-
- while( macro != NULL ) {
- KumacMacro *next = macro->next;
- free_macro( macro );
- macro = next;
- }
-
- free( file );
-}
-
-
-static
-int compile_macros( file )
- KumacFile *file;
-{
- FILE *stream = fopen( file->path, "r" );
- KumacStatement stmt;
- KumacMacro *macro = new_macro( file );
- NestStack *tos = NULL;
- char buf[16];
- char *p;
- int first = 1;
- int nerror = 0;
- int n;
- int i;
-
- while ( ( tos=pop_stack() ) != NULL ) ;
-
- kumac_path = file->path;
- line_count = 0;
- if( full_line != NULL ) {
- free( full_line );
- full_line = NULL;
- }
-
- do {
- stmt = next_statement( stream, macro );
-
- if( macro->name == NULL && stmt != MACRO_Statement ) {
- if( first ) {
- /* macro does not start with a MACRO header */
- macro->name = strdup( "" );
- add_code( macro, op_macro, NULL, NULL );
- }
- else if( stmt != EOF_REACHED ) {
- print_error( "MACRO statement missing", NULL );
- nerror++;
- }
- }
- first = 0;
-
- if( stmt != CASE_Label && tos != NULL && tos->stmt == CASE_Statement ) {
- print_error( ">Statements between CASE and first label are unreachable",
- NULL );
- tos->stmt = CASE_Label;
- }
-
-
- switch( stmt ) {
- char label0[16];
-
- case APPLICATION_Statement:
- p = str4dup( "APPLICATION ", stmt_arg1, " ", stmt_arg2 );
- add_code( macro, op_command, p, NULL );
- free( p );
-
- while( (p = read_line( stream, macro )) != NULL ) {
- while( p[0] == ' ' )
- p++;
- if( strcasecmp( p, stmt_arg2 ) == 0 ) {
- break;
- }
- }
- if( p == NULL ) {
- print_error( ">EOF reached before APPLICATION text terminator", NULL );
- add_code( macro, op_source, "EOF", stmt_arg2 );
- }
-
- add_code( macro, op_application, stmt_arg1, NULL );
- break;
-
- case ASSIGNMENT_Statement:
- add_code( macro, op_expr, stmt_arg1, stmt_arg2 );
- add_code( macro, op_trace, "=", stmt_arg1 );
- break;
-
- case BREAKL_Statement:
- case NEXTL_Statement:
- for( i = nest_stack_ptr, n = atoi( stmt_arg1 ); i > 0 && n > 0; i-- ) {
- KumacStatement loop = nest_stack[i-1].stmt;
- if( loop == DO_Statement || loop == FOR_Statement
- || loop == REPEAT_Statement || loop == WHILE_Statement ) {
- n--;
- }
- }
- if( n > 0 ) {
- print_error( ">%s statement without enough nesting levels ignored",
- stmt == BREAKL_Statement ? "BREAKL" : "NEXTL" );
- }
- else {
- add_code( macro, op_goto, NULL,
- stmt == BREAKL_Statement ? nest_stack[i].label3
- : nest_stack[i].label2 );
- }
- break;
-
-
- case COMMAND_Statement:
- add_code( macro, op_command, stmt_arg1, stmt_arg2 );
- break;
-
- case EOF_REACHED:
- if( tos != NULL ) {
- nest_error( tos, "EOF" );
- nerror++;
- }
- else if( macro->name != NULL ) {
- add_code( macro, op_return, NULL, NULL );
- macro = new_macro( file );
- }
- break;
-
- case EXITM_Statement:
- add_code( macro, op_return, stmt_arg1, NULL );
- break;
-
- case GOTO_Statement:
- add_code( macro, op_goto, stmt_arg1, NULL );
- break;
-
- case GOTO_Label:
- if( find_label( macro, stmt_arg1, -1 ) >= 0 ) {
- print_error( ">Redefinition of label ignored", NULL );
- }
- add_code( macro, op_label, stmt_arg1, NULL );
- swap_source( macro );
- break;
-
- case IF_GOTO_Statement:
- add_code( macro, op_bool, stmt_arg1, NULL );
- sprintf( buf, "%d", ++label_count );
- add_code( macro, op_goto, NULL, buf );
- add_code( macro, op_goto, stmt_arg2, NULL );
- add_code( macro, op_label, NULL, buf );
- break;
-
- case MACRO_Statement:
- if( tos != NULL ) {
- nest_error( tos, "MACRO" );
- nerror++;
- }
- else {
- if( macro->name != NULL ) {
- print_error( ">Missing RETURN before MACRO statement supplied",
- NULL );
- add_code( macro, op_return, NULL, NULL );
- macro = new_macro( file );
- }
- macro->name = strdup( stmt_arg1 );
- add_code( macro, op_macro, stmt_arg2, NULL );
- }
- break;
-
- case OFF_ERROR_Statement:
- add_code( macro, op_on_error, "-", NULL );
- break;
-
- case ON_ERROR_Statement:
- add_code( macro, op_on_error, "+", NULL );
- break;
-
- case ON_ERROR_CONTINUE:
- add_code( macro, op_on_error, "CONTINUE", NULL );
- break;
-
- case ON_ERROR_GOTO:
- add_code( macro, op_on_error, "GOTO", stmt_arg1 );
- break;
-
- case ON_ERROR_EXITM:
- add_code( macro, op_on_error, "EXITM", stmt_arg1 );
- break;
-
- case ON_ERROR_STOPM:
- add_code( macro, op_on_error, "STOPM", NULL );
- break;
-
- case READ_Statement:
- add_code( macro, op_read, stmt_arg1, stmt_arg2 );
- break;
-
- case SHIFT_Statement:
- add_code( macro, op_shift, NULL, NULL );
- break;
-
- case STOPM_Statement:
- add_code( macro, op_return, NULL, "STOPM" );
- break;
-
- case RETURN_Statement:
- if( tos != NULL ) {
- nest_error( tos, "RETURN" );
- nerror++;
- }
- else {
- add_code( macro, op_return, stmt_arg1, NULL );
- macro = new_macro( file );
- }
- break;
-
-
- case IF_THEN_Statement:
- tos = push_stack( IF_THEN_Statement, NULL );
- add_code( macro, op_bool, stmt_arg1, NULL );
- add_code( macro, op_goto, NULL, tos->label1 );
- break;
-
- case ELSEIF_Statement:
- if( tos == NULL ) {
- print_error( ">ELSEIF without matching IF statement", NULL );
- }
- else if( tos->stmt != IF_THEN_Statement ) {
- nest_error( tos, ">ELSEIF" );
- }
- else {
- add_code( macro, op_goto, NULL, tos->label3 );
- add_code( macro, op_label, NULL, tos->label1 );
- swap_source( macro );
- sprintf( tos->label1, "%d", ++label_count );
- add_code( macro, op_bool, stmt_arg1, NULL );
- add_code( macro, op_goto, NULL, tos->label1 );
- }
- break;
-
- case ELSE_Statement:
- if( tos == NULL ) {
- print_error( ">ELSE without matching IF statement", NULL );
- }
- else if( tos->stmt != IF_THEN_Statement ) {
- nest_error( tos, ">ELSE" );
- }
- else {
- tos->stmt = ELSE_Statement;
- add_code( macro, op_goto, NULL, tos->label3 );
- add_code( macro, op_label, NULL, tos->label1 );
- swap_source( macro );
- sprintf( tos->label1, "%d", ++label_count );
- }
- break;
-
- case ENDIF_Statement:
- if( tos == NULL ) {
- print_error( ">ENDIF without matching IF statement", NULL );
- }
- else if( tos->stmt != IF_THEN_Statement
- && tos->stmt != ELSE_Statement ) {
- nest_error( tos, ">ENDIF" );
- }
- else {
- add_code( macro, op_label, NULL, tos->label1 );
- add_code( macro, op_label, NULL, tos->label3 );
- swap_source( macro );
- tos = pop_stack();
- }
- break;
-
-
- case CASE_Statement:
- tos = push_stack( CASE_Statement, NULL );
- add_code( macro, op_expr, tos->tmp1, stmt_arg1 );
- add_code( macro, op_trace, "CASE: ", tos->tmp1 );
- add_code( macro, op_goto, NULL, tos->label1 );
- break;
-
- case CASE_Label:
- if( tos == NULL ) {
- print_error( ">(label) outside CASE-ENDCASE block ignored", NULL );
- }
- else if( tos->stmt != CASE_Statement && tos->stmt != CASE_Label ) {
- nest_error( tos, ">CASE label" );
- }
- else {
- tos->stmt = CASE_Label;
- add_code( macro, op_goto, NULL, tos->label3 );
- add_code( macro, op_label, NULL, tos->label1 );
- swap_source( macro );
- add_code( macro, op_match, tos->tmp1, stmt_arg1 );
- sprintf( tos->label1, "%d", ++label_count );
- add_code( macro, op_goto, NULL, tos->label1 );
- }
- break;
-
- case ENDCASE_Statement:
- if( tos == NULL ) {
- print_error( ">ENDCASE without matching CASE statement", NULL );
- }
- else if( tos->stmt != CASE_Statement && tos->stmt != CASE_Label ) {
- nest_error( tos, ">ENDCASE" );
- }
- else {
- if( tos->stmt == CASE_Statement ) {
- print_error( ">CASE construct without any labels", NULL );
- }
- add_code( macro, op_label, NULL, tos->label1 );
- add_code( macro, op_label, NULL, tos->label3 );
- swap_source( macro );
- tos = pop_stack();
- }
- break;
-
-
- case DO_Statement:
- /* DO var = start, finish, step */
- tos = push_stack( DO_Statement, stmt_arg1 );
-
- /* var = start */
- add_code( macro, op_math, tos->var, stmt_arg2 );
-
- /* tmp1 = finish */
- add_code( macro, op_math, tos->tmp1, stmt_arg3 );
-
- /* tmp2 = step */
- add_code( macro, op_math, tos->tmp2, stmt_arg4 );
-
- /* if step <> 0 then tmp1 = (finish-start)/step */
- p = str3dup( "[", tos->tmp2, "]=0" );
- add_code( macro, op_bool, p, NULL );
- free( p );
- p = str5dup( "([", tos->tmp1, "]-[", tos->var, "])/[" );
- p = mstr2cat( p, tos->tmp2, "]" );
- add_code( macro, op_math, tos->tmp1, p );
- free( p );
-
- /* label1: */
- add_code( macro, op_label, NULL, tos->label1 );
- add_code( macro, op_trace, "=DO:", tos->var );
-
- /* if step = 0 goto label0 */
- sprintf( label0, "%d", ++label_count );
- p = str3dup( "[", tos->tmp2, "]<>0" );
- add_code( macro, op_bool, p, NULL );
- free( p );
- add_code( macro, op_goto, NULL, label0 );
-
- /* if tmp1 < 0 goto label3 */
- p = str3dup( "[", tos->tmp1, "]>=0" );
- add_code( macro, op_bool, p, NULL );
- free( p );
- add_code( macro, op_goto, NULL, tos->label3 );
-
- /* tmp1 = tmp1-1 */
- p = str3dup( "[", tos->tmp1, "]-1" );
- add_code( macro, op_math, tos->tmp1, p );
- free( p );
-
- /* label0: */
- add_code( macro, op_label, NULL, label0 );
- break;
-
- case ENDDO_Statement:
- if( tos == NULL ) {
- print_error( ">ENDDO without matching DO statement", NULL );
- }
- else if( tos->stmt != DO_Statement ) {
- nest_error( tos, ">ENDDO" );
- }
- else {
- /* label2: */
- add_code( macro, op_label, NULL, tos->label2 );
-
- /* var = var+step */
- p = str5dup( "[", tos->var, "]+[", tos->tmp2, "]" );
- add_code( macro, op_math, tos->var, p );
- free( p );
-
- /* goto label1 */
- add_code( macro, op_goto, NULL, tos->label1 );
-
- /* label3: */
- add_code( macro, op_label, NULL, tos->label3 );
- swap_source( macro );
-
- tos = pop_stack();
- }
- break;
-
-
- case FOR_Statement:
- /* FOR var IN item_1 item_2 ... */
- tos = push_stack( FOR_Statement, stmt_arg1 );
-
- /* tmp1 = list */
- add_code( macro, op_forlist, tos->tmp1, stmt_arg2 );
-
- /* label1: */
- add_code( macro, op_label, NULL, tos->label1 );
-
- /* var = head(list) ; tmp1 = tail(list) */
- add_code( macro, op_fornext, tos->var, tos->tmp1 );
-
- /* if var empty goto label3 */
- add_code( macro, op_goto, NULL, tos->label3 );
- add_code( macro, op_trace, "=FOR:", tos->var );
- break;
-
- case ENDFOR_Statement:
- if( tos == NULL ) {
- print_error( ">ENDFOR without matching FOR statement", NULL );
- }
- else if( tos->stmt != FOR_Statement ) {
- nest_error( tos, ">ENDFOR" );
- }
- else {
- /* label2: */
- add_code( macro, op_label, NULL, tos->label2 );
-
- /* goto label1 */
- add_code( macro, op_goto, NULL, tos->label1 );
-
- /* label3: */
- add_code( macro, op_label, NULL, tos->label3 );
- swap_source( macro );
-
- tos = pop_stack();
- }
- break;
-
-
- case REPEAT_Statement:
- tos = push_stack( REPEAT_Statement, NULL );
-
- /* label1: */
- add_code( macro, op_label, NULL, tos->label1 );
- swap_source( macro );
- break;
-
- case UNTIL_Statement:
- if( tos == NULL ) {
- print_error( ">UNTIL without matching REPEAT statement", NULL );
- }
- else if( tos->stmt != REPEAT_Statement ) {
- nest_error( tos, ">UNTIL" );
- }
- else {
- /* label2: */
- add_code( macro, op_label, NULL, tos->label2 );
-
- /* if bool = false goto label1 */
- add_code( macro, op_bool, stmt_arg1, NULL );
- add_code( macro, op_goto, NULL, tos->label1 );
-
- /* label3: */
- add_code( macro, op_label, NULL, tos->label3 );
- swap_source( macro );
-
- tos = pop_stack();
- }
- break;
-
-
- case WHILE_Statement:
- tos = push_stack( WHILE_Statement, NULL );
-
- /* label1: */
- add_code( macro, op_label, NULL, tos->label1 );
- swap_source( macro );
-
- /* if bool = false goto label3 */
- add_code( macro, op_bool, stmt_arg1, NULL );
- add_code( macro, op_goto, NULL, tos->label3 );
- break;
-
- case ENDWHILE_Statement:
- if( tos == NULL ) {
- print_error( ">ENDWHILE without matching WHILE statement", NULL );
- }
- else if( tos->stmt != WHILE_Statement ) {
- nest_error( tos, ">ENDWHILE" );
- }
- else {
- /* label2: */
- add_code( macro, op_label, NULL, tos->label2 );
-
- /* goto label1: */
- add_code( macro, op_goto, NULL, tos->label1 );
-
- /* label3: */
- add_code( macro, op_label, NULL, tos->label3 );
- swap_source( macro );
-
- tos = pop_stack();
- }
- break;
-
- default: /* SYNTAX_ERROR */
- nerror++;
- break;
- }
-
- } while( nerror < 100 && stmt != EOF_REACHED );
-
- if( nerror ) {
- free_kumac( file );
- }
- else {
- /* remove the last macro which is always bogus */
- macro = file->macros;
- while( macro->next->next != NULL ) {
- macro = macro->next;
- }
- free_macro( macro->next );
- macro->next = NULL;
- }
-
- fclose( stream );
-
- return nerror;
-}
-
-
-/*
- * compile a kumac file
- */
-static
-KumacFile *compile_kumac( path )
- char *path;
-{
- KumacFile *file = (KumacFile*)calloc( 1, sizeof(KumacFile) );
-
- file->path = strdup( path );
- file->macros = NULL;
-
- if( compile_macros( file ) == 0 ) {
- /* successful compilation */
- hash_insert( kumac_table, path, file, 0 );
- file->stamp = checksum( path );
- return file;
- }
-
- return NULL;
-}
-
-
-static
-void free_stack( tos )
- ExecStack *tos;
-{
- hash_destroy( tos->variables );
-
- if( tos->argline != NULL )
- free( tos->argline );
-}
-
-
-static
-int exec_macro( file, macro, argline )
- KumacFile *file;
- KumacMacro *macro;
- char *argline;
-{
- if( exec_stack_ptr < MAX_EXEC_STACK ) {
- ExecStack *tos;
- int status;
-
- exec_stack_ptr++;
-
- tos = &exec_stack[exec_stack_ptr-1];
- tos->file = file;
- tos->macro = macro;
- tos->argline = str0dup( argline );
- tos->variables = hash_create( MAX_VARIABLE_TABLE );
- tos->on_error_stmt = ON_ERROR_CONTINUE;
- tos->on_error_arg = NULL;
- tos->off_error_stmt = ON_ERROR_CONTINUE;
- tos->off_error_arg = NULL;
- tos->pc = 0;
- tos->status = 0;
-
- kc_alias.var_table = tos->variables;
-
- kc_flags.quit_macro = 0;
-
- do {
- KumacCode *code = ¯o->code[tos->pc];
- tos->pc = (*code->op)( tos, code->arg[0], code->arg[1] );
- if( kc_flags.quit_macro ) {
- tos->status = KUMAC_UNWIND;
- break;
- }
- } while( tos->pc >= 0 );
-
- status = tos->status;
-
- if( --exec_stack_ptr > 0 ) {
- int n;
-
- tos = &exec_stack[exec_stack_ptr-1];
-
- if( (n = hash_entries( tos->variables )) > 0 ) {
- HashArray *values = hash_array( tos->variables );
- int i;
-
- for( i = 0; i < n; i++ ) {
- if( values[i].tag ) {
- char *name = values[i].name;
- int is_global = 0;
-
- if( hash_lookup( tos->variables, name, &is_global ) != NULL
- && is_global ) {
- char *value = (char*)hash_lookup( kc_alias.global_value,
- name, NULL );
- if( value == NULL ) {
- /* global has been deleted, delete local as well */
- hash_remove( tos->variables, name );
- }
- else {
- /* global may have been changed, update local */
- hash_insert( tos->variables, name, value, is_global );
- }
- }
- }
- }
- free( (char*)values );
- }
- kc_alias.var_table = tos->variables;
-
- if( kc_flags.trace_on ) {
- ku_alfa();
- printf( " >>>>>> back in %s#%s\n", tos->file->path, tos->macro->name );
- }
- }
- else {
- kc_alias.var_table = kc_alias.global_value;
- }
-#if defined(STUPID_MALLOC) || defined(DBMALLOC)
- /*
- * On some systems, e.g. IBM C/370, malloc() operations become more and
- * more expensive with the number of allocated block. Then, it is better
- * to clear the Kumac structure as soon as it is not needed any more.
- */
- {
- int needed = 0;
- int n;
- for( n = 0; n < exec_stack_ptr; n++ ) {
- if( exec_stack[n].file == exec_stack[exec_stack_ptr].file ) {
- needed = 1;
- break;
- }
- }
- if( !needed ) {
- hash_remove( kumac_table, exec_stack[exec_stack_ptr].file->path );
- free_kumac( exec_stack[exec_stack_ptr].file );
- }
- }
-#endif
- free_stack( &exec_stack[exec_stack_ptr] );
-
- return status;
- }
- else {
- printf( " *** MACRO/EXEC: too many nested EXECs\n" );
- return KUMAC_UNWIND;
- }
-}
-
-
-/*
- * action routine for /MACRO/EXEC
- */
-int kxmexec()
-{
- char *kumac_spec = ku_gets();
- char *arg_list = ku_gete();
- char *kumac_name = strdup( kumac_spec );
- char *macro_name = strrchr( kumac_name, '#' );
- KumacFile *file = NULL;
- KumacMacro *macro = NULL;
- int i;
-
- ku_alfa();
- if( !kc_flags.in_macro ) {
- int n;
-
- if( kumac_table == NULL ) {
- kumac_table = hash_create( MAX_KUMAC_TABLE );
- hash_config( kumac_table, "struct" );
- orphan_table = hash_create( MAX_KUMAC_TABLE );
- hash_config( orphan_table, "struct" );
-#ifdef DBMALLOC
- malloc_mark( kumac_table );
- malloc_mark( kumac_table->entries );
- malloc_mark( orphan_table );
- malloc_mark( orphan_table->entries );
-#endif
- }
- else if( (n = hash_entries( kumac_table )) > 0 ) {
- HashArray *kumacs = hash_array( kumac_table );
-
- for( i = 0; i < n; i++ ) {
- file = kumacs[i].value;
- if( checksum( file->path ) != file->stamp ) {
- /* file was modified since the last compilation */
- hash_remove( kumac_table, kumacs[i].name );
- free_kumac( file );
- }
- }
- free( (char*)kumacs );
- }
-
- if( (n = hash_entries( orphan_table )) > 0 ) {
- HashArray *kumacs = hash_array( orphan_table );
-
- for( i = 0; i < n; i++ ) {
- file = kumacs[i].value;
- hash_remove( orphan_table, kumacs[i].name );
- free_kumac( file );
- }
- free( (char*)kumacs );
- }
-
- for( i = 0; i < exec_stack_ptr; i++ ) {
- free_stack( &exec_stack[i] );
- }
- exec_stack_ptr = 0;
-
- kc_flags.trace_wait = kc_flags.trace_wait_save;
- }
-
- if( kc_flags.in_macro && macro_name == NULL ) {
- /*
- * "EXEC name" inside a macro means to look first for macro name from
- * the same kumac file before looking for file name.
- */
- file = exec_stack[exec_stack_ptr-1].file;
-
- for( macro = file->macros; macro != NULL; macro = macro->next ) {
- if( strcasecmp( macro->name, kumac_name ) == 0 ) {
- break;
- }
- }
- }
-
- if( macro == NULL ) {
- char *path;
-
- if( macro_name != NULL ) {
- *macro_name++ = '\0';
- }
-
- if ( kumac_name[0] != '-' ) {
- path = fsearch( kumac_name, "kumac", kc_flags.macro_path );
- }
- else { path = fsearch( &kumac_name[1], "kumac", NULL );
- }
-
- if( path == NULL ) {
- printf( " *** MACRO/EXEC: macro file %s not found\n", kumac_name );
- }
- else {
-#if defined(UNIX) && !defined(MSDOS)
- hash_config( kumac_table, kc_flags.keep_fcase ? "respect" : "ignore" );
-#endif
- if( (file = hash_lookup( kumac_table, path, NULL )) != NULL ) {
-
- if( checksum( file->path ) != file->stamp ) {
- /* file was modified since the last compilation */
- int needed = 0;
- int n;
- for( n = 0; n < exec_stack_ptr; n++ ) {
- if( exec_stack[n].file == file ) {
- needed = 1;
- break;
- }
- }
- hash_remove( kumac_table, path );
- if( needed ) {
- /*
- * The KumacFile structure must be kept because it is still
- * in use in the EXEC stack.
- */
- char buf[16];
- sprintf( buf, "%d", ++orphan_count );
- hash_insert( orphan_table, buf, file, 0 );
- }
- else {
- free_kumac( file );
- }
- file = NULL;
- }
- }
-
- if( file != NULL
- || (file = compile_kumac( path )) != NULL ) {
-
- if( macro_name == NULL ) {
- macro = file->macros;
- }
- else {
- for( macro = file->macros; macro != NULL; macro = macro->next ) {
- if( strcasecmp( macro->name, macro_name ) == 0 ) {
- break;
- }
- }
- }
- }
- }
- }
-
- free( kumac_name );
-
- if( macro == NULL ) {
- printf( " *** MACRO/EXEC: cannot execute %s\n", kumac_spec );
- return KUMAC_UNWIND;
- }
- else {
- int old_in_macro = kc_flags.in_macro;
- int status;
-
- kc_flags.in_macro = 1;
- status = exec_macro( file, macro, arg_list );
- kc_flags.in_macro = old_in_macro;
- return status;
- }
-}
-
-
-/*
- * check if mname is a macro in the current .kumac file:
- * return -1 if EXEC called from command line
- * return 1 if mname is macro name
- * return 0 if mname is kumac name
- *
- * (to be used by CMZ/EXEC overloading the MACRO/EXEC command in order that
- * "EXEC mname" looks first for "MACRO mname" before "mname.kumac")
- */
-int ku_qmac( const char *mname )
-{
- if( !kc_flags.in_macro ) {
- return -1;
- }
- else {
- KumacFile *file = exec_stack[exec_stack_ptr-1].file;
- KumacMacro *macro;
-
- for( macro = file->macros; macro != NULL; macro = macro->next ) {
- if( strcasecmp( macro->name, mname ) == 0 ) {
- return 1;
- }
- }
- }
- return 0;
-}
-
-
-/*
- * set a variable
- */
-void F77_ENTRY_C(Kuvar,chline)
-/* { */
- char *line = fstrdup( chline, len_chline );
- char *p;
-
- if( (p = strchr( line, '=' )) != NULL ) {
- char *value = clean_word( strdup( p + 1 ) );
- *p = '\0';
- hash_insert( kc_alias.var_table, line, value, 0 );
- free( value );
- IQUEST(1) = 0;
- }
- else {
- IQUEST(1) = 1;
- }
-
- free( line );
-}
-
-
-/*
- * return value of expression
- */
-void F77_ENTRY_CC(Kuqvar,inpline,outline)
-/* { */
- char *expr = fstrdup( inpline, len_inpline );
- char *value = ku_expr( expr );
-
- fstrset( outline, len_outline, value );
-
- free( value );
- free( expr );
-}
-
-
-/*
- * action routine for /MACRO/GLOBAL/CREATE
- */
-int kxgcreate()
-{
- char *name = ku_gets();
- char *value = ku_gets();
- char *text = ku_gete();
-
- hash_insert( kc_alias.global_value, name, value, 0 );
- hash_remove( kc_alias.global_text, name );
- if( text[0] != '\0' )
- hash_insert( kc_alias.global_text, name, text, 0 );
-
- if( kc_flags.in_macro ) {
- ExecStack *tos = &exec_stack[exec_stack_ptr-1];
- hash_insert( tos->variables, name, value, 1 );
- }
-
- return 0;
-}
-
-
-/*
- * action routine for /MACRO/GLOBAL/IMPORT
- */
-int kxgimport()
-{
- if( kc_flags.in_macro ) {
- int npar = ku_npar();
-
- while( npar-- > 0 ) {
- char *pattern = ku_gets();
- int n = hash_entries( kc_alias.global_value );
-
- if( n > 0 ) {
- ExecStack *tos = &exec_stack[exec_stack_ptr-1];
- HashArray *values = hash_array( kc_alias.global_value );
- int i;
-
- for( i = 0; i < n; i++ ) {
- char *name = values[i].name;
- char *value = (char*)values[i].value;
-
- if( ku_match( name, pattern, 1 ) ) {
- hash_insert( tos->variables, name, value, 1 );
- }
- }
- free( (char*)values );
- }
- }
- }
-
- return 0;
-}
-
-
-/*
- * action routine for /MACRO/GLOBAL/DELETE
- */
-int kxgdelete()
-{
- int npar = ku_npar();
-
- while( npar-- > 0 ) {
- char *pattern = ku_gets();
- int n = hash_entries( kc_alias.global_value );
-
- if( n > 0 ) {
- HashArray *values = hash_array( kc_alias.global_value );
- int i;
-
- for( i = 0; i < n; i++ ) {
- char *name = values[i].name;
-
- if( strcmp( name, "@" ) != 0 && ku_match( name, pattern, 1 ) ) {
- hash_remove( kc_alias.global_value, name );
- hash_remove( kc_alias.global_text, name );
- }
- }
- free( (char*)values );
- }
-
- if( kc_flags.in_macro ) {
- ExecStack *tos = &exec_stack[exec_stack_ptr-1];
-
- if( (n = hash_entries( tos->variables ) ) > 0 ) {
- HashArray *values = hash_array( tos->variables );
- int i;
-
- for( i = 0; i < n; i++ ) {
- char *name = values[i].name;
-
- if( strcmp( name, "@" ) != 0 && ku_match( name, pattern, 1 ) ) {
- hash_remove( tos->variables, name );
- }
- }
- free( (char*)values );
- }
- }
- }
- return 0;
-}
-
-
-/*
- * action routine for /MACRO/GLOBAL/LIST
- */
-int kxglist()
-{
- char *pattern = ku_gets();
- char *fname = ku_getf();
- char *path;
- FILE *stream = stdout;
-
- if( fname[0] != '\0' ) {
- char *path = ku_home( fname, "kumac" );
- if( (stream = fopen( path, "w" )) == NULL ) {
- printf( " *** Cannot write file %s\n", path );
- }
- else {
- fprintf( stream, "* GLOBAL/LIST %s %s\n", pattern, fname );
- }
- free( path );
- }
-
- if( stream != NULL ) {
- int n = hash_entries( kc_alias.global_value );
-
- if( n > 0 ) {
- HashArray *values = hash_array( kc_alias.global_value );
- int i;
-
- for( i = 0; i < n; i++ ) {
- char *name = values[i].name;
-
- if( ku_match( name, pattern, 1 ) ) {
- char *value = quote_string( strdup( values[i].value ), 0 );
- char *text = hash_lookup( kc_alias.global_text, name, NULL );
-
- if( stream == stdout ) {
-
- if( text != NULL )
- printf( " %s = %s | %s\n", name, value, text );
- else
- printf( " %s = %s\n", name, value );
- }
- else if( strcmp( name, "@" ) != 0 ) {
- text = quote_string( strdup( text == NULL ? "" : text ), 0 );
- fprintf( stream, "GLOBAL/CREATE %s %s %s\n", name, value, text );
- free( text );
- }
- free( value );
- }
- }
- free( (char*)values );
- }
-
- if( stream != stdout )
- fclose( stream );
-
- return 0;
- }
-
- return 1;
-}
diff --git a/src/packlib/kuip/code_kuip/kmath.c b/src/packlib/kuip/code_kuip/kmath.c
deleted file mode 100644
index a69a079..0000000
--- a/src/packlib/kuip/code_kuip/kmath.c
+++ /dev/null
@@ -1,2662 +0,0 @@
-
-#include "kuip/kuip.h"
-#include "kuip/kfor.h"
-#include "kuip/kcom.h"
-#include "kuip/kmenu.h"
-#include "kuip/kflag.h"
-#include "kuip/khash.h"
-#include "kuip/kalias.h"
-#include "kuip/klink.h"
-#include "kuip/kmacro.h"
-
-enum {
- IFUN_x,
- IFUN_xx,
- IFUN_Cx,
- IFUN_CC,
- IFUN_CCxx,
- IFUN_CCx3,
- IFUN_xCx,
- IFUN_xCC,
- IFUN_xCx8
-};
-
-typedef struct _user_fundef {
- char *face_name; /* function name, e.g. HEXIST */
- int face_tok;
- char face_type[16];
- int face_const[16];
- char *face_sval[16];
- double face_dval[16];
- INT_FUNCPTR func;
- char *call_name;
- int call_tok;
- char call_type[16];
- int call_index[16];
- int call_const[16];
- char *call_sval[16];
- double call_dval[16];
- char *synopsis;
- char *guidance;
-} user_fundef;
-
-static user_fundef user_functions[100]; /* should be plenty */
-
-
-static char *pline;
-static int kline;
-static char *result;
-static int iresult;
-static double dresult;
-static int rsigma;
-static int wanted;
-
-/*
- * The nonum flag is set in some mid-rule actions that kmathlex should
- * classify a numeric constant as STRING.
- */
-static int nonum;
-
-static void call_user_function( const char*, char**, double*, int*, int );
-static int count_words( const char*, const char* );
-static char* extract_word( const char*, const char*, int );
-static char* join_words( const char*, const char*, int, int );
-static char* shell_line( const char*, int, const char* );
-static char* zero_pad( char*, int );
-
-extern int kmathparse(void);
-
-#ifdef ABS
-#undef ABS
-#endif
-
-typedef union {
- double dval;
- char *sval;
-} YYSTYPE;
-#ifdef __cplusplus
-# include <stdio.h>
-# include <yacc.h>
-#endif /* __cplusplus */
-# define yyparse kmathparse
-# define yylex kmathlex
-# define yyerror kmatherror
-# define yylval kmathlval
-# define yychar kmathchar
-# define yydebug kmathdebug
-# define yymaxdepth kmathmaxdepth
-# define yynerrs kmathnerrs
-# define NUMBER 257
-# define STRING 258
-# define VNAME 259
-# define S_USER 260
-# define S_USER_S 261
-# define S_USER_X 262
-# define S_USER_X_S 263
-# define X_USER_S 264
-# define X_USER_X 265
-# define X_USER_X_S 266
-# define ABS 267
-# define INT 268
-# define MOD 269
-# define ANAM 270
-# define AVAL 271
-# define QUOTE 272
-# define UNQUOTE 273
-# define ENV 274
-# define FEXIST 275
-# define FORMAT 276
-# define INDEX 277
-# define LEN 278
-# define LOWER 279
-# define UPPER 280
-# define SUBSTRING 281
-# define WORD 282
-# define WORDS 283
-# define SHELL 284
-# define DEFINED 285
-# define INLINE 286
-# define iQUEST 287
-# define SIGMA 288
-# define RSIGMA 289
-# define VEXIST 290
-# define VDIM 291
-# define VLEN 292
-# define WANT_ANY 293
-# define WANT_BOOL 294
-# define WANT_MATH 295
-# define LT 296
-# define EQ 297
-# define GT 298
-# define PLUS 299
-# define MINUS 300
-# define STAR 301
-# define SLASH 302
-# define LPAR 303
-# define RPAR 304
-# define COMMA 305
-# define OR 306
-# define AND 307
-# define NOT 308
-# define LE 309
-# define NE 310
-# define GE 311
-# define UPLUS 312
-# define UMINUS 313
-# define CONCAT 314
-#define yyclearin yychar = -1
-#define yyerrok yyerrflag = 0
-extern int yychar;
-#ifndef YYMAXDEPTH
-#define YYMAXDEPTH 150
-#endif
-
-/* __YYSCLASS defines the scoping/storage class for global objects
- * that are NOT renamed by the -p option. By default these names
- * are going to be 'static' so that multi-definition errors
- * will not occur with multiple parsers.
- * If you want (unsupported) access to internal names you need
- * to define this to be null so it implies 'extern' scope.
- * This should not be used in conjunction with -p.
- */
-#ifndef __YYSCLASS
-# define __YYSCLASS static
-#endif
-YYSTYPE yylval;
-__YYSCLASS YYSTYPE yyval;
-typedef int yytabelem;
-# define YYERRCODE 256
-
-
-
-/*
- * execute a shell command and return the n'th line of its output
- * if n<=0 return complete output with newlines replaced by blanks
- */
-static
-char *shell_line( const char *cmd,
- int n,
- const char *sep )
-{
-#ifdef UNIX
- FILE *stream;
- char *shell_cmd;
- int status;
-
-#ifdef MSDOS
- shell_cmd = str3dup( cmd, " >", kc_flags.appl_file );
-#else
- /* protect against noclobber option */
- shell_cmd = str5dup( "cp /dev/null ", kc_flags.appl_file, " ; rm ",
- kc_flags.appl_file, " ; ( " );
- shell_cmd = mstr3cat( shell_cmd, cmd, " ) > ", kc_flags.appl_file );
-#endif
-
- status = shsystem( kc_value.set_host_shell, shell_cmd );
- free( shell_cmd );
- if( status == -1 ) {
- perror( "$SHELL" );
- }
- else if( (stream = fopen( kc_flags.appl_file, "r" )) != NULL ) {
- char line[1024];
- char *value = NULL;
-
- if( sep == NULL ) {
- while( --n > 0 ) {
- fgets( line, (sizeof line), stream );
- }
- if( fgets( line, (sizeof line), stream ) != NULL ) {
- int len = strlen( line );
- line[len-1] = '\0';
- value = strdup( line );
- }
- }
- else {
- while( fgets( line, (sizeof line), stream ) != NULL ) {
- int len = strlen( line );
- line[len-1] = '\0';
- if( value == NULL ) {
- value = strdup( line );
- }
- else {
- value = mstr2cat( value, sep, line );
- }
- }
- }
- fclose( stream );
- remove( kc_flags.appl_file );
- return value;
- }
-#endif
-
- return strdup( "" );
-}
-
-
-static
-int count_words( const char *line,
- const char *sep )
-{
- int n = 0;
- while( 1 ) {
- char *p = extract_word( line, sep, n + 1 );
- if( *p != '\0' ) {
- free( p );
- n++;
- }
- else {
- free( p );
- break;
- }
- }
- return n;
-}
-
-
-static
-char *extract_word( const char *line,
- const char *sep,
- int k )
-{
- const char *p = line;
- int n = 0;
- if( *sep != '\0' ) {
- while( k-- > 0 ) {
- p += n;
- while( *p != '\0' && strchr( sep, *p ) != NULL )
- p++;
- n = 0;
- while( strchr( sep, p[n] ) == NULL )
- n++;
- }
- }
- return strndup( p, n );
-}
-
-
-static
-char *join_words( const char *line,
- const char *sep,
- int k,
- int n )
-{
- char *words = strdup( "" );
- while( n-- > 0 ) {
- char *p = extract_word( line, sep, k++ );
- if( p[0] != '\0' ) {
- if( words[0] != '\0' )
- words = mstrcat( words, sep );
- words = mstrcat( words, p );
- free( p );
- }
- else {
- free( p );
- break;
- }
- }
- return words;
-}
-
-
-/*
- * VAX C printf() does not understand "%5.3d" to do zero padding
- * and we have to do it by hand.
- */
-static
-char* zero_pad( char *format,
- int m )
-{
- int n = strlen( format );
- int minus = 0;
-
- while( --n >= 0 && --m >= 0 ) {
- if( format[n] == '-' ) {
- minus = 1;
- format[n] = '0';
- }
- else if( format[n] == ' ' )
- format[n] = '0';
- }
-
- if( minus ) {
- if( n >= 0 )
- format[n] = '-';
- else {
- char *p = str2dup( "-", format );
- free( format );
- return p;
- }
- }
- return format;
-}
-
-
-/*
- * enter a user define system function
- * chname is of the form "<T>=<name>(<T><T>...)"
- */
-void F77_ENTRY_C4E(Kufdef,chsyn,chguid,chface,chcall,fun)
-/* { */
- char *face = fstrdup( chface, len_chface );
- char *call = fstrdup( chcall, len_chcall );
- int i;
-
- for( i = 0; i < sizeof(user_functions) / sizeof(user_fundef) - 1; i++ ) {
-
- if( user_functions[i].face_tok == 0 ) {
- char face_class[16];
- char call_class[16];
- int argc;
- char *p;
- int n;
-
- user_functions[i].face_name = face + 2;
- user_functions[i].face_type[0] = face[0];
- user_functions[i].face_sval[0] = NULL;
- p = strchr( face, ')' );
- *p = ',';
- p = strchr( face, '(' );
- *p++ = '\0';
-
- if( *p == ',' ) {
- n = 1; /* no arguments */
- }
- else {
- for( n = 1; *p != '\0'; n++ ) {
- char *argv = NULL;
-
- user_functions[i].face_type[n] = *p;
- if( p[1] == '=' ) {
- char *s = strchr( p, ',' );
- *s = '\0';
- argv = p + 2;
- p = s;
- }
- else {
- p += 2;
- }
- user_functions[i].face_sval[n] = argv;
- }
- }
- user_functions[i].face_type[n] = '\0';
- argc = n;
-
- for( n = 0; n < argc; n++ ) {
- char *argv = user_functions[i].face_sval[n];
-
- if( strchr( "stuS", user_functions[i].face_type[n] ) != NULL ) {
- face_class[n] = 'S';
- if( argv != NULL )
- user_functions[i].face_const[n] = 1;
- }
- else {
- face_class[n] = 'X';
- if( argv != NULL ) {
- user_functions[i].face_const[n] = 2;
- user_functions[i].face_dval[n] = atof( argv );
- }
- }
- }
- face_class[n] = '\0';
-
- if( strcmp( face_class, "S" ) == 0 ) {
- user_functions[i].face_tok = S_USER;
- }
- else if( strcmp( face_class, "SS" ) == 0 ) {
- user_functions[i].face_tok = S_USER_S;
- }
- else if( strcmp( face_class, "SX" ) == 0 ) {
- user_functions[i].face_tok = S_USER_X;
- }
- else if( strcmp( face_class, "SXS" ) == 0 ) {
- user_functions[i].face_tok = S_USER_X_S;
- }
- else if( strcmp( face_class, "XS" ) == 0 ) {
- user_functions[i].face_tok = X_USER_S;
- }
- else if( strcmp( face_class, "XX" ) == 0 ) {
- user_functions[i].face_tok = X_USER_X;
- }
- else if( strcmp( face_class, "XXS" ) == 0 ) {
- user_functions[i].face_tok = X_USER_X_S;
- }
- else {
- printf( " *** KUFDEF: %s face class %s not implemented\n",
- user_functions[i].face_name, face_class );
- return;
- }
-
- user_functions[i].func = (INT_FUNCPTR)fun;
- user_functions[i].call_name = call + 2;
- user_functions[i].call_type[0] = call[0];
- user_functions[i].call_sval[0] = NULL;
-
- p = strchr( call, ')' );
- *p = ',';
- p = strchr( call, '(' );
- *p++ = '\0';
- for( n = 1; *p != '\0'; n++ ) {
- char *argv = NULL;
-
- user_functions[i].call_type[n] = *p;
- if( isdigit( p[1] ) ) {
- user_functions[i].call_index[n] = p[1] - '0';
- p++;
- }
-
- if( p[1] == '=' ) {
- char *s = strchr( p, ',' );
- *s = '\0';
- argv = p + 2;
- p = s;
- }
- else {
- p += 2;
- }
- user_functions[i].call_sval[n] = argv;
- }
- user_functions[i].call_type[n] = '\0';
- argc = n;
-
- for( n = 0; n < argc; n++ ) {
- char *argv = user_functions[i].call_sval[n];
-
- if( strchr( "stuC$", user_functions[i].call_type[n] ) != NULL ) {
- call_class[n] = 'S';
- if( argv != NULL )
- user_functions[i].call_const[n] = 1;
- }
- else {
- call_class[n] = 'X';
- if( argv != NULL ) {
- user_functions[i].call_const[n] = 2;
- user_functions[i].call_dval[n] = atof( argv );
- }
- }
- }
- call_class[n] = '\0';
-
- if( strcmp( call_class, "XX" ) == 0 ) {
- user_functions[i].call_tok = IFUN_x;
- }
- else if( strcmp( call_class, "XXX" ) == 0 ) {
- user_functions[i].call_tok = IFUN_xx;
- }
- else if( strcmp( call_class, "XSX" ) == 0 ) {
- user_functions[i].call_tok = IFUN_Cx;
- }
- else if( strcmp( call_class, "XSS" ) == 0 ) {
- user_functions[i].call_tok = IFUN_CC;
- }
- else if( strcmp( call_class, "XSSXX" ) == 0 ) {
- user_functions[i].call_tok = IFUN_CCxx;
- }
- else if( strcmp( call_class, "XSSXXX" ) == 0 ) {
- user_functions[i].call_tok = IFUN_CCx3;
- }
- else if( strcmp( call_class, "XXSX" ) == 0 ) {
- user_functions[i].call_tok = IFUN_xCx;
- }
- else if( strcmp( call_class, "XXSS" ) == 0 ) {
- user_functions[i].call_tok = IFUN_xCC;
- }
- else if( strcmp( call_class, "XXSXXXXXXXX" ) == 0 ) {
- user_functions[i].call_tok = IFUN_xCx8;
- }
- else {
- printf( " *** KUFDEF: %s call class %s not implemented\n",
- user_functions[i].call_name, call_class );
- return;
- }
- user_functions[i].synopsis = fstrdup( chsyn, len_chsyn );
- user_functions[i].guidance = fstrdup( chguid, len_chguid );
- return;
- }
- }
- printf( " *** KUFDEF: too many definitions --- %s ignored\n", face );
-}
-
-
-/*
- * User help routine for /KUIP/FUNCTIONS
- */
-char **kxfunclist()
-{
- char **text = (char**)malloc( sizeof(char*) );
- int k = 0;
- int n;
-
- for( n = 0; user_functions[n].face_tok != 0; n++ ) {
-
- if( user_functions[n].synopsis[0] != '\0'
- || user_functions[n].guidance[0] != '\0' ) {
- int len = strlen( user_functions[n].synopsis );
-
- text[k] = str3dup( " ", user_functions[n].synopsis, " " );
- text[k] = mstrccat( text[k], '.', 28 - len );
- text[k] = mstr2cat( text[k], " ", user_functions[n].guidance );
- text = (char**)realloc( (char*)text, (k+2) * sizeof( char* ) );
- k++;
- }
- }
- text[k] = NULL;
-
- return text;
-}
-
-
-static
-void call_user_function( const char *name,
- char **slist,
- double *dlist,
- int *which,
- int npar )
-{
- user_fundef *ufun = NULL;
- char *sval[16];
- double dval[16];
- EQUIV_INT_REAL xval[16][10];
- char cval[16][256];
- char *p;
- char c;
- int i;
- int j;
-
- for( i = 0; user_functions[i].face_tok != 0; i++ ) {
-
- if( strcasecmp( user_functions[i].face_name, name ) == 0 ) {
-
- ufun = &user_functions[i];
- for( j = 1; j <= npar; j++ ) {
- if( ufun->face_const[j] == 1
- && strcasecmp( ufun->face_sval[j], slist[j] ) != 0 ) {
- ufun = NULL;
- break;
- }
- if( ufun->face_const[j] == 2
- && ufun->face_dval[j] != dlist[j] ) {
- ufun = NULL;
- break;
- }
- }
-
- if( ufun != NULL )
- break;
- }
- }
-
- if( ufun == NULL ) {
- char *comma = "";
- printf( " *** Invalid argument in function %s(", name );
- for( i = 1; i <= npar; i++ ) {
- if( which[i] == 1 )
- printf( "%s%s", comma, slist[i] );
- else
- printf( "%s%s", comma, strfromd( dlist[i], 0 ) );
- comma = ",";
- }
- printf( ")\n" );
-
- if( which[0] == 1 )
- slist[0] = str2dup( name, "(?)" );
- else
- dlist[0] = 1.2345e6;
- return;
- }
-
- for( i = 1; ufun->call_type[i] != '\0'; i++ ) {
- sval[i] = ufun->call_sval[i];
- dval[i] = ufun->call_dval[i];
- }
-
- for( i = 1; (c = ufun->face_type[i]) != '\0'; i++ ) {
-
- if( (p = strchr( ufun->call_type, c )) != NULL ) {
- int n = p - ufun->call_type;
-
- sval[n] = slist[i];
- dval[n] = dlist[i];
- }
- }
-
- for( i = 1; (c = ufun->call_type[i]) != '\0'; i++ ) {
-
- if( strchr( "stuC$", c ) != NULL ) {
- char *s = (sval[i] != NULL) ? sval[i] : "";
- if( c == '$' )
- s = ufun->call_name;
- else if( c == 'u' )
- strupper( s );
- fstrset( cval[i], 256, s );
- }
- else if( strchr( "ijkI", c ) != NULL ) {
- xval[i][0].i = dval[i];
- }
- else if( strchr( "lmnL", c ) != NULL ) {
- xval[i][0].l = ku_true( dval[i] != 0 );
- }
- else if( strchr( "xyzR", c ) != NULL ) {
- xval[i][0].r = dval[i];
- }
- }
-
- switch( ufun->call_tok ) {
-
- case IFUN_x:
- F77_IFUN_x(xval[0][0].i,ufun->func,xval[1]);
- break;
-
- case IFUN_xx:
- F77_IFUN_xx(xval[0][0].i,ufun->func,xval[1],xval[2]);
- break;
-
- case IFUN_Cx:
- F77_IFUN_Cx(xval[0][0].i,ufun->func,cval[1],256,xval[2]);
- break;
-
- case IFUN_CC:
- F77_IFUN_CC(xval[0][0].i,ufun->func,cval[1],256,cval[2],256);
- break;
-
- case IFUN_CCxx:
- F77_IFUN_CCxx(xval[0][0].i,ufun->func,cval[1],256,cval[2],256,
- xval[3],xval[4]);
- break;
-
- case IFUN_CCx3:
- F77_IFUN_CCx3(xval[0][0].i,ufun->func,cval[1],256,cval[2],256,
- xval[3],xval[4],xval[5]);
- break;
-
- case IFUN_xCx:
- F77_IFUN_xCx(xval[0][0].i,ufun->func,xval[1],cval[2],256,xval[3]);
- break;
-
- case IFUN_xCC:
- F77_IFUN_xCC(xval[0][0].i,ufun->func,xval[1],cval[2],256,cval[3],256);
- break;
-
- case IFUN_xCx8:
- F77_IFUN_xCx8(xval[0][0].i,ufun->func,xval[1],cval[2],256,
- xval[3],xval[4],xval[5],xval[6],
- xval[7],xval[8],xval[9],xval[10]);
- break;
- }
-
- c = ufun->face_type[0];
- p = strchr( ufun->call_type, c );
- i = p - ufun->call_type;
- j = ufun->call_index[i];
-
- if( strchr( "stu", c ) != NULL ) {
- slist[0] = fstrdup( cval[i], 256 );
- }
- else if( strchr( "ijk", c ) != NULL ) {
- dlist[0] = xval[i][j].i;
- }
- else if( strchr( "lmn", c ) != NULL ) {
- dlist[0] = (xval[i][j].l != ku_true( 0 ));
- }
- else if( strchr( "xyz", c ) != NULL ) {
- dlist[0] = xval[i][j].r;
- }
- else if( strchr( "def", c ) != NULL ) {
- DBLPREC dbl;
- memcpy( (void*)&dbl, (void*)xval[i], sizeof(DBLPREC) );
- dlist[0] = dbl;
- }
-}
-
-
-/*
- * Replace $EXEC functions which we can't leave to the non-reentrent parser.
- */
-char *repl_exec( const char *line )
-{
- int quoted = 0;
- const char *p;
-
- for( p = line; *p != '\0'; p++ ) {
- int n;
-
- if( *p == '\'' ) {
- quoted = !quoted;
- }
- else if( !quoted && strncasecmp( p, "$EXEC(", 6 ) == 0
- && (n = match_paren( p )) > 0 ) {
-
- char *args = clean_word( strndup( p + 6, n - 7 ) );
- char *cmd = str2dup( "EXEC ", args );
- char *new_line = strndup( line, p - line );
- char *old_value = strdup( hash_lookup( kc_alias.var_table, "@", NULL ) );
- char *value;
-
- ku_exel( cmd );
- free( args );
- free( cmd );
-
- value = quote_string( strdup( hash_lookup( kc_alias.var_table,
- "@", NULL ) ), 0 );
- store_variable( NULL, "@", old_value );
- free( old_value );
-
- new_line = mstr2cat( new_line, value, p + n );
- free( value );
-
- return new_line;
- }
- }
- return NULL;
-}
-
-
-char *subst_exec( const char *line )
-{
- char *ldup = strdup( line );
- char *p;
-
- while( (p = repl_exec( ldup )) != NULL ) {
- free( ldup );
- ldup = p;
- }
- return ldup;
-}
-
-
-/*
- * Evaluate an expression and return the result as an allocated string.
- * If the expression cannot be parsed a NULL string is returned.
- */
-char *ku_eval( const char *line )
-{
- char *val = NULL;
-
- /* pline must be the first of these static assignments !!! */
- pline = subst_exec( line );
- kline = 0;
- nonum = 0;
- rsigma = 0;
- wanted = WANT_ANY;
-
- if( kmathparse() == 0 )
- val = result;
-
- free( pline );
- return val;
-}
-
-
-/*
- * Evaluate numerical expressions
- */
-int ku_math( const char *line, double *dval )
-{
- int status = -1;
-
- /* pline must be the first of these static assignments !!! */
- pline = subst_exec( line );
- kline = 0;
- nonum = 0;
- rsigma = 0;
- wanted = WANT_MATH;
-
- if( kmathparse() == 0 ) {
- status = 0;
- *dval = dresult;
- }
-
- free( pline );
- return status;
-}
-
-
-/*
- * Evaluate boolean expressions
- * Return -1 if invalid expression
- */
-int ku_bool( const char *line )
-{
- int bool = -1;
-
- /* pline must be the first of these static assignments !!! */
- pline = subst_exec( line );
- kline = 0;
- nonum = 0;
- rsigma = 0;
- wanted = WANT_BOOL;
-
- if( kmathparse() == 0 )
- bool = iresult;
-
- free( pline );
- return bool;
-}
-
-
-/*
- * Evaluate expression.
- * For invalid expressions variable, alias, and system function substitution.
- */
-char *ku_expr( const char *line )
-{
- char *value = ku_eval( line );
-
- if( value == NULL ) {
- char *p;
- value = strdup( line );
-
- kc_alias.substitutions = 100; /* protect against recursive aliases */
-
- if( (p = subst_var_alias( value )) != NULL ) {
- free( value );
- value = p;
- }
-
- if( (p = subst_arg_alias( value )) != NULL ) {
- free( value );
- value = p;
- }
-
- if( (p = subst_sysfun( value, 1 )) != NULL ) {
- free( value );
- value = p;
- }
- }
- return value;
-}
-
-
-static
-int kmathlex()
-{
- static struct tokens {
- char *tok;
- int val;
- } op[] = {
- { "//", CONCAT},
- { ".NOT.", NOT },
- { ".AND.", AND },
- { ".OR.", OR },
- { ".LE.", LE }, { "<=", LE },
- { ".GE.", GE }, { ">=", GE },
- { ".NE.", NE }, { "<>", NE },
- { ".EQ.", EQ },
- { ".LT.", LT },
- { ".GT.", GT }
- }, fun[] = {
- { "ABS", ABS },
- { "INT", INT },
- { "MOD", MOD },
- { "$ANAM", ANAM },
- { "$AVAL", AVAL },
- { "$DEFINED", DEFINED },
- { "$ENV", ENV },
- { "$FEXIST", FEXIST },
- { "$FORMAT", FORMAT },
- { "$INDEX", INDEX },
- { "$INLINE", INLINE },
- { "$IQUEST", iQUEST },
- { "$LEN", LEN },
- { "$LOWER", LOWER },
- { "$QUOTE", QUOTE },
- { "$RSIGMA", RSIGMA },
- { "$SHELL", SHELL },
- { "$SIGMA", SIGMA },
- { "$SUBSTRING", SUBSTRING },
- { "$UNQUOTE", UNQUOTE },
- { "$UPPER", UPPER },
- { "$VDIM", VDIM },
- { "$VEXIST", VEXIST },
- { "$VLEN", VLEN },
- { "$WORD", WORD },
- { "$WORDS", WORDS },
- }, single[] = {
- { "<", LT },
- { "=", EQ },
- { ">", GT },
- { "+", PLUS },
- { "-", MINUS },
- { "*", STAR },
- { "/", SLASH },
- { "(", LPAR },
- { ")", RPAR },
- { ",", COMMA }
- };
- char *str;
- char *p;
- int c;
- int i;
- int n;
-
- if( wanted ) {
- int w = wanted;
- wanted = 0;
- return w;
- }
-
- while( (c = pline[kline]) == ' ' || c == '\t' )
- kline++; /* ignore spaces */
-
- if( c == '\0' )
- return 0;
-
- if( c == '\'' ) { /* quoted string */
- int quoted = 1;
- str = NULL;
-
- for( n = kline + 1; pline[n] != '\0'; n++ ) {
- if( pline[n] == '\'' ) {
- quoted = !quoted;
- if( !quoted && pline[n+1] != '\'' ) {
- str = strndup( &pline[kline+1], n - kline - 1 );
- break;
- }
- }
- }
- if( str != NULL ) { /* remove quotes */
- char *s;
- for( p = str; (s = strstr( p, "''" )) != NULL; p = s + 1 )
- strcpy( s, s + 1 );
- kmathlval.sval = str;
- kline = n + 1;
- return STRING;
- }
- }
-
- /* check for macro variable */
- if( c == '[' ) {
- /*
- * Isolate the variable name and classify the translation
- * as number or string.
- */
- int paren = 1;
-
- for( p = pline + kline + 1; *p != '\0'; p++ ) {
-
- if( *p == '[' ) {
- paren++;
- }
- else if( *p == ']' ) {
-
- if( --paren == 0 ) {
- int len = p - &pline[kline] + 1;
- char *name = strndup( &pline[kline], len );
- char *value = var_value( name );
- free( name );
-
- kline += len;
-
- /* e.g. for $UPPER([s]) do not try classify [s] as a number */
- if( !nonum ) {
- char *tail;
- kmathlval.dval = fstrtod( value, &tail );
- if( *tail == '\0' ) {
- free( value );
- return NUMBER;
- }
- /* allow "[vname]([i])" */
- if( ku_vtype( value ) != 0 ) {
- /*
- * test if name is followed by '('
- * otherwise it must be a single element vector for which we
- * return the immediate value
- */
- p = &pline[kline];
- while( *p == ' ' )
- p++;
- if( *p == '(' ) {
- kline = p - pline + 1;
- kmathlval.sval = value;
- return VNAME;
- }
- else if( ku_vvalue( value, &kmathlval.dval ) == 0 ) {
- kline = p - pline;
- free( value );
- return NUMBER;
- }
- }
- }
- kmathlval.sval = value;
- return STRING;
- }
- }
- }
- }
-
- /* numbers */
- if( !nonum && ( isdigit( c )
- || ( c == '.' && isdigit( pline[kline+1] ) ) ) ) {
- char *tail;
- str = pline + kline;
- kmathlval.dval = strtod( str, &tail );
- if( tail != str ) {
- kline += tail - str;
- return NUMBER;
- }
- }
-
- /* multiple character operators */
- for( i = 0; i < (sizeof op) / sizeof( struct tokens ); i++ ) {
- n = strlen( op[i].tok );
-
- if( strncasecmp( &pline[kline], op[i].tok, n ) == 0 ) {
- kline += n;
- return op[i].val;
- }
- }
-
- /* single character operators */
- for( i = 0; i < (sizeof single) / sizeof( struct tokens ); i++ ) {
- if( single[i].tok[0] == c ) {
- kline++;
- return single[i].val;
- }
- }
-
- /* alias names */
- n = len_alias( pline + kline, (kline > 0) ? pline[kline-1] : '\0' );
- if( n > 0 ) {
- char *name = strndup( &pline[kline], n );
- if( (p = subst_arg_alias( name )) != NULL ) {
- free( name );
- kline += n;
- if( !nonum ) {
- char *tail;
- kmathlval.dval = fstrtod( p, &tail );
- if( *tail == '\0' ) {
- free( p );
- return NUMBER;
- }
- }
- kmathlval.sval = p;
- return STRING;
- }
- free( name );
- }
-
- /* vector names */
- if( !nonum ) {
- n = len_vector( pline + kline );
- if( n > 0 ) {
- char *name = strndup( &pline[kline], n );
- if( ku_vtype( name ) != 0 ) {
- /*
- * test if name is followed by '('
- * otherwise it must be a single element vector for which we
- * return the immediate value
- */
- p = &pline[kline+n];
- while( *p == ' ' )
- p++;
- if( *p == '(' ) {
- kline = p - pline + 1;
- kmathlval.sval = name;
- return VNAME;
- }
- else if( ku_vvalue( name, &kmathlval.dval ) == 0 ) {
- kline = p - pline;
- free( name );
- return NUMBER;
- }
- }
- free( name );
- }
- }
-
- /* user defined functions */
- for( i = 0; user_functions[i].face_tok != 0; i++ ) {
- n = strlen( user_functions[i].face_name );
-
- if( strncasecmp( pline + kline, user_functions[i].face_name, n ) == 0 ) {
-
- while( pline[kline+n] == ' ' )
- n++;
-
- if( pline[kline+n] == '(' ) {
- kline += n + 1;
- kmathlval.sval = user_functions[i].face_name;
- return user_functions[i].face_tok;
- }
- }
- }
-
- /* system functions with arguments */
- for( i = 0; i < (sizeof fun) / sizeof( struct tokens ); i++ ) {
- int n = strlen( fun[i].tok );
-
- if( strncasecmp( &pline[kline], fun[i].tok, n ) == 0 ) {
- int k = kline + n;
-
- while( pline[k] == ' ' || pline[k] == '\t' )
- k++;
-
- if( pline[k] == '(' ) {
-
- if( fun[i].val == SIGMA || fun[i].val == RSIGMA
- || fun[i].val == INLINE ) {
- /*
- * SIGMA expressions do not follow our syntax rules.
- * We isolate the SIGMA expression by looking for the matching ")".
- * Before calling SIGMA we have to substitute macro variables and
- * system functions without arguments. We cannot substitute
- * system functions with arguments because this is done by the
- * expression parser which is not reentrant.
- * The result is returned as a vector name.
- *
- * INLINE allows textual substitution in an expression.
- * The argument is alias and variable expanded and replaced in the
- * expression line.
- */
- int len = match_paren( pline + k );
-
- if( len > 0 ) {
- char *expr = strndup( pline + k + 1, len - 2 );
-
- if( (p = subst_arg_alias( expr )) != NULL ) {
- free( expr );
- expr = p;
- }
- if( (p = subst_var_alias( expr )) != NULL ) {
- free( expr );
- expr = p;
- }
- if( (p = subst_sysfun( expr, 0 )) != NULL ) {
- free( expr );
- expr = p;
- }
-
- if( fun[i].val == INLINE ) {
- p = strndup( pline, kline );
- p = mstrcat( p, expr );
- free( expr );
- p = mstrcat( p, pline + k + len );
- free( pline );
- pline = p;
- return kmathlex();
- }
- else if( kjmpaddr.user_sigma_F != NULL ) {
- char vname[16]; /* temporary sigma vector */
-
- sprintf( vname, "?SIG%d", ++kc_flags.temp_vectors );
- p = str3dup( vname, "=", expr );
- free( expr );
- fstrset( Sikuip.CHSIGM, (sizeof Sikuip.CHSIGM), p );
- free( p );
-
- (*kjmpaddr.user_sigma_F)();
- if( IQUEST(1) != 0 ) {
- kc_flags.temp_vectors--;
- }
- else {
- rsigma = (fun[i].val == RSIGMA);
- kline = k + len;
- if( ku_vvalue( vname, &kmathlval.dval ) == 0 )
- return NUMBER;
- kmathlval.sval = strdup( vname );
- return STRING;
- }
- }
- }
- }
- else {
- kline = k + 1;
- return fun[i].val;
- }
- }
- }
- }
-
- /* system functions without arguments */
- if( c == '$' ) {
- if( (n = len_sysfun( pline + kline + 1 )) > 0 ) {
- char *name = strndup( pline + kline, n + 1 );
- char *value = repl_sysfun( name, 0 );
- free( name );
- if( value != NULL ) {
- kline += n + 1;
- if( !nonum ) {
- char *tail;
- kmathlval.dval = fstrtod( value, &tail );
- if( *tail == '\0' ) {
- free( value );
- return NUMBER;
- }
- }
- kmathlval.sval = value;
- return STRING;
- }
- }
- }
-
- /* classify other stuff as unquoted string */
- n = 1;
- while( strchr( " =,)[", pline[kline+n] ) == NULL )
- n++;
-
- str = strupper( strndup( pline + kline, n ) );
-
- /* check that there is no operator before the end of the string */
- for( i = 0; i < (sizeof op) / sizeof( struct tokens ); i++ ) {
- if( (p = strstr( str, op[i].tok )) != NULL ) {
- *p = '\0';
- }
- }
- n = strlen( str );
- free( str );
-
- kmathlval.sval = strndup( &pline[kline], n );
- kline += n;
- return STRING;
-}
-
-
-static
-void kmatherror()
-{
- /* ignore */
-}
-__YYSCLASS yytabelem yyexca[] ={
--1, 1,
- 0, -1,
- -2, 0,
- };
-# define YYNPROD 104
-# define YYLAST 700
-__YYSCLASS yytabelem yyact[]={
-
- 10, 28, 24, 29, 30, 31, 32, 25, 26, 27,
- 13, 14, 16, 33, 34, 38, 39, 35, 20, 37,
- 18, 17, 41, 42, 49, 48, 45, 50, 36, 228,
- 15, 72, 209, 21, 46, 47, 186, 222, 74, 74,
- 221, 74, 11, 12, 73, 74, 7, 74, 74, 55,
- 74, 8, 10, 28, 24, 29, 30, 31, 32, 25,
- 26, 27, 13, 14, 16, 33, 34, 38, 39, 35,
- 20, 37, 18, 17, 41, 42, 49, 48, 45, 50,
- 36, 219, 15, 216, 95, 21, 46, 47, 56, 55,
- 115, 74, 114, 74, 11, 12, 207, 118, 52, 61,
- 65, 62, 57, 58, 59, 60, 74, 135, 136, 116,
- 56, 55, 63, 66, 64, 111, 112, 67, 61, 65,
- 62, 57, 58, 59, 60, 57, 58, 59, 60, 205,
- 208, 63, 66, 64, 113, 10, 67, 24, 117, 74,
- 67, 109, 25, 26, 27, 13, 14, 16, 57, 58,
- 59, 60, 204, 20, 201, 18, 17, 200, 106, 107,
- 108, 45, 74, 67, 74, 15, 198, 74, 21, 46,
- 47, 226, 197, 195, 193, 189, 74, 11, 12, 188,
- 187, 52, 74, 74, 74, 74, 185, 89, 90, 74,
- 74, 105, 57, 58, 59, 60, 74, 223, 224, 57,
- 58, 59, 60, 104, 212, 213, 57, 58, 59, 60,
- 102, 202, 203, 57, 58, 59, 60, 101, 170, 171,
- 57, 58, 59, 60, 196, 152, 153, 57, 58, 59,
- 60, 87, 88, 164, 57, 58, 59, 60, 83, 84,
- 159, 57, 58, 59, 60, 59, 60, 156, 57, 58,
- 59, 60, 96, 134, 143, 57, 58, 59, 60, 139,
- 225, 57, 58, 59, 60, 138, 218, 57, 58, 59,
- 60, 137, 210, 57, 58, 59, 60, 194, 191, 57,
- 58, 59, 60, 92, 190, 57, 58, 59, 60, 86,
- 135, 57, 58, 59, 60, 85, 161, 57, 58, 59,
- 60, 82, 160, 57, 58, 59, 60, 81, 158, 57,
- 58, 59, 60, 23, 155, 57, 58, 59, 60, 22,
- 142, 57, 58, 59, 60, 19, 141, 57, 58, 59,
- 60, 40, 140, 57, 58, 59, 60, 4, 2, 3,
- 9, 5, 43, 44, 1, 54, 0, 0, 0, 69,
- 70, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 120, 121, 0,
- 0, 0, 0, 0, 0, 0, 131, 133, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 144, 146, 0, 147, 148, 149, 0, 0,
- 0, 0, 0, 154, 0, 0, 0, 157, 0, 0,
- 0, 0, 162, 163, 0, 165, 166, 0, 0, 168,
- 169, 0, 0, 172, 174, 175, 176, 177, 178, 179,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 180, 0, 0, 181, 182,
- 183, 0, 0, 0, 0, 145, 0, 0, 6, 51,
- 53, 0, 0, 68, 71, 0, 0, 75, 76, 77,
- 78, 79, 80, 0, 0, 199, 0, 0, 0, 0,
- 91, 0, 93, 94, 0, 0, 0, 97, 98, 99,
- 100, 0, 0, 103, 0, 0, 0, 211, 0, 110,
- 0, 0, 0, 0, 0, 214, 0, 215, 119, 0,
- 0, 71, 71, 122, 123, 124, 125, 126, 127, 128,
- 129, 130, 132, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 227, 0, 0,
- 0, 0, 0, 0, 150, 0, 151, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 167, 0, 0, 0, 0, 173, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 184,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 192,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 206, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 217,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 220 };
-__YYSCLASS yytabelem yypact[]={
-
- 44, -3000, -257, -122, -205, -218, -178, -257, -257, -266,
- -3000, -122, -122, -122, -122, -122, -122, -3000, -3000, -66,
- -3000, -3000, -73, -117, -122, -3000, -122, -122, -3000, -220,
- -3000, -122, -122, -122, -122, -3000, -3000, -122, -3000, -3000,
- -146, -3000, -3000, -122, -189, -3000, -3000, -3000, -3000, -3000,
- -3000, 34, -122, -151, -276, -257, -257, -122, -122, -122,
- -122, -122, -122, -122, -122, -205, -205, -3000, -197, -196,
- -3000, -178, -3000, -3000, -3000, -3000, -3000, 28, 22, 16,
- -51, -205, -205, -3000, -205, -205, -205, -3000, -122, -3000,
- -122, -79, -205, 10, -58, -3000, -205, 4, -65, -2,
- -8, -205, -205, -72, -205, -205, -3000, -122, -205, -205,
- -86, -3000, -205, -205, -205, -205, -205, -205, -205, -14,
- -3000, -258, -56, -56, -3000, -3000, 34, 34, 34, 34,
- -151, -276, -151, -276, -205, -3000, -3000, -205, -205, -205,
- -3000, -3000, -3000, -122, -118, -151, -269, -124, -125, -129,
- -20, -26, -3000, -122, -130, -3000, -3000, -131, -3000, -3000,
- -3000, -3000, -132, -138, -205, -147, -150, -93, -152, -175,
- -3000, -122, -208, -174, -276, -276, -276, -276, -273, -276,
- -3000, -276, -276, -3000, -32, -3000, -205, -3000, -3000, -3000,
- -3000, -3000, -100, -3000, -205, -3000, -205, -3000, -3000, -221,
- -3000, -3000, -3000, -122, -3000, -3000, -38, -3000, -3000, -3000,
- -3000, -223, -3000, -122, -264, -267, -3000, -107, -3000, -3000,
- -44, -3000, -3000, -3000, -3000, -3000, -205, -275, -3000 };
-__YYSCLASS yytabelem yypgo[]={
-
- 0, 344, 341, 485, 343, 340, 342, 331, 325, 319,
- 313, 307, 301, 295, 289, 283, 277, 271, 265, 259,
- 253, 252, 224, 217, 210, 203, 191, 171, 160, 141,
- 138, 134, 109, 97, 92, 90 };
-__YYSCLASS yytabelem yyr1[]={
-
- 0, 1, 1, 1, 1, 1, 3, 3, 3, 3,
- 3, 3, 3, 3, 3, 3, 3, 3, 11, 3,
- 12, 3, 3, 3, 13, 3, 14, 3, 3, 3,
- 3, 3, 3, 3, 3, 15, 3, 3, 16, 3,
- 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
- 17, 2, 2, 18, 2, 2, 5, 19, 5, 20,
- 5, 5, 21, 5, 5, 22, 5, 5, 5, 23,
- 5, 24, 5, 5, 25, 5, 26, 5, 5, 5,
- 5, 27, 5, 28, 5, 29, 5, 5, 5, 5,
- 5, 5, 30, 6, 31, 8, 32, 7, 33, 4,
- 34, 9, 35, 10 };
-__YYSCLASS yytabelem yyr2[]={
-
- 0, 5, 5, 5, 5, 5, 3, 7, 5, 5,
- 7, 7, 7, 7, 7, 7, 7, 11, 1, 9,
- 1, 13, 5, 9, 1, 9, 1, 9, 5, 9,
- 5, 9, 7, 11, 15, 1, 9, 7, 1, 13,
- 7, 5, 7, 7, 7, 7, 7, 7, 7, 7,
- 1, 9, 7, 1, 9, 7, 3, 1, 9, 1,
- 9, 5, 1, 9, 7, 1, 13, 7, 7, 1,
- 9, 1, 9, 11, 1, 9, 1, 9, 5, 9,
- 13, 1, 19, 1, 9, 1, 9, 7, 11, 5,
- 9, 9, 1, 9, 1, 7, 1, 7, 1, 7,
- 1, 7, 1, 7 };
-__YYSCLASS yytabelem yychk[]={
-
- -3000, -1, 294, 295, 293, -2, -3, 303, 308, -5,
- 257, 299, 300, 267, 268, 287, 269, 278, 277, -8,
- 275, 290, -9, -10, 259, 264, 265, 266, 258, 260,
- 261, 262, 263, 270, 271, 274, 285, 276, 272, 273,
- -7, 279, 280, -6, -4, 283, 291, 292, 282, 281,
- 284, -3, 303, -3, -5, 307, 306, 299, 300, 301,
- 302, 296, 298, 309, 311, 297, 310, 314, -3, -2,
- -2, -3, 297, 310, 314, -3, -3, -3, -3, -3,
- -3, -11, -12, 304, 305, -13, -14, 304, 305, 304,
- 305, -3, -15, -3, -3, 304, -21, -3, -3, -3,
- -3, -23, -24, -3, -25, -26, 304, 305, -28, -29,
- -3, 304, 305, -31, -34, -35, -32, -30, -33, -3,
- -2, -2, -3, -3, -3, -3, -3, -3, -3, -3,
- -3, -5, -3, -5, -20, 304, 304, -17, -18, -19,
- 304, 304, 304, 305, -5, -3, -5, -5, -5, -5,
- -3, -3, 304, 305, -5, 304, 305, -5, 304, 305,
- 304, 304, -5, -5, 305, -5, -5, -3, -5, -5,
- 304, 305, -5, -3, -5, -5, -5, -5, -5, -5,
- -5, -5, -5, -5, -3, 304, 305, 304, 304, 304,
- 304, 304, -3, 304, -16, 304, -22, 304, 304, -5,
- 304, 304, 304, 305, 304, 304, -3, 304, 304, 305,
- 304, -5, 304, 305, -5, -5, 304, -3, 304, 304,
- -3, 304, 304, 304, 305, 304, -27, -5, 304 };
-__YYSCLASS yytabelem yydef[]={
-
- 0, -2, 0, 0, 0, 1, 2, 0, 0, 0,
- 6, 0, 0, 0, 0, 0, 0, 18, 20, 0,
- 24, 26, 0, 0, 0, 35, 0, 0, 56, 0,
- 62, 0, 0, 0, 0, 69, 71, 0, 74, 76,
- 0, 83, 85, 0, 0, 94, 100, 102, 96, 92,
- 98, 3, 0, 4, 5, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 59, 0, 0,
- 41, 0, 50, 53, 57, 8, 9, 0, 0, 0,
- 0, 0, 0, 22, 0, 0, 0, 28, 0, 30,
- 0, 0, 0, 0, 0, 61, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 78, 0, 0, 0,
- 0, 89, 0, 0, 0, 0, 0, 0, 0, 0,
- 42, 43, 10, 11, 12, 16, 44, 45, 46, 47,
- 48, 52, 49, 55, 0, 7, 40, 0, 0, 0,
- 13, 14, 15, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 32, 0, 0, 37, 38, 0, 64, 65,
- 67, 68, 0, 0, 0, 0, 0, 0, 0, 0,
- 87, 0, 0, 0, 95, 101, 103, 97, 0, 99,
- 60, 51, 54, 58, 0, 19, 0, 23, 25, 27,
- 29, 31, 0, 36, 0, 63, 0, 70, 72, 0,
- 75, 77, 79, 0, 84, 86, 0, 90, 91, 93,
- 17, 0, 33, 0, 0, 0, 73, 0, 88, 21,
- 0, 39, 66, 80, 81, 34, 0, 0, 82 };
-typedef struct { char *t_name; int t_val; } yytoktype;
-#ifndef YYDEBUG
-# define YYDEBUG 0 /* don't allow debugging */
-#endif
-
-#if YYDEBUG
-
-__YYSCLASS yytoktype yytoks[] =
-{
- "NUMBER", 257,
- "STRING", 258,
- "VNAME", 259,
- "S_USER", 260,
- "S_USER_S", 261,
- "S_USER_X", 262,
- "S_USER_X_S", 263,
- "X_USER_S", 264,
- "X_USER_X", 265,
- "X_USER_X_S", 266,
- "ABS", 267,
- "INT", 268,
- "MOD", 269,
- "ANAM", 270,
- "AVAL", 271,
- "QUOTE", 272,
- "UNQUOTE", 273,
- "ENV", 274,
- "FEXIST", 275,
- "FORMAT", 276,
- "INDEX", 277,
- "LEN", 278,
- "LOWER", 279,
- "UPPER", 280,
- "SUBSTRING", 281,
- "WORD", 282,
- "WORDS", 283,
- "SHELL", 284,
- "DEFINED", 285,
- "INLINE", 286,
- "iQUEST", 287,
- "SIGMA", 288,
- "RSIGMA", 289,
- "VEXIST", 290,
- "VDIM", 291,
- "VLEN", 292,
- "WANT_ANY", 293,
- "WANT_BOOL", 294,
- "WANT_MATH", 295,
- "LT", 296,
- "<", 60,
- "EQ", 297,
- "=", 61,
- "GT", 298,
- ">", 62,
- "PLUS", 299,
- "+", 43,
- "MINUS", 300,
- "-", 45,
- "STAR", 301,
- "*", 42,
- "SLASH", 302,
- "/", 47,
- "LPAR", 303,
- "(", 40,
- "RPAR", 304,
- ")", 41,
- "COMMA", 305,
- ",", 44,
- "OR", 306,
- "AND", 307,
- "NOT", 308,
- "LE", 309,
- "NE", 310,
- "GE", 311,
- "UPLUS", 312,
- "UMINUS", 313,
- "CONCAT", 314,
- "-unknown-", -1 /* ends search */
-};
-
-__YYSCLASS char * yyreds[] =
-{
- "-no such reduction-",
- "Line : WANT_BOOL Bool",
- "Line : WANT_BOOL Expr",
- "Line : WANT_MATH Expr",
- "Line : WANT_ANY Expr",
- "Line : WANT_ANY String",
- "Expr : NUMBER",
- "Expr : LPAR Expr RPAR",
- "Expr : PLUS Expr",
- "Expr : MINUS Expr",
- "Expr : Expr PLUS Expr",
- "Expr : Expr MINUS Expr",
- "Expr : Expr STAR Expr",
- "Expr : ABS Expr RPAR",
- "Expr : INT Expr RPAR",
- "Expr : iQUEST Expr RPAR",
- "Expr : Expr SLASH Expr",
- "Expr : MOD Expr COMMA Expr RPAR",
- "Expr : LEN",
- "Expr : LEN String RPAR",
- "Expr : INDEX",
- "Expr : INDEX String COMMA String RPAR",
- "Expr : Words RPAR",
- "Expr : Words COMMA String RPAR",
- "Expr : FEXIST",
- "Expr : FEXIST String RPAR",
- "Expr : VEXIST",
- "Expr : VEXIST String RPAR",
- "Expr : Vdim RPAR",
- "Expr : Vdim COMMA Expr RPAR",
- "Expr : Vlen RPAR",
- "Expr : Vlen COMMA Expr RPAR",
- "Expr : VNAME Expr RPAR",
- "Expr : VNAME Expr COMMA Expr RPAR",
- "Expr : VNAME Expr COMMA Expr COMMA Expr RPAR",
- "Expr : X_USER_S",
- "Expr : X_USER_S String RPAR",
- "Expr : X_USER_X Expr RPAR",
- "Expr : X_USER_X_S Expr COMMA",
- "Expr : X_USER_X_S Expr COMMA String RPAR",
- "Bool : LPAR Bool RPAR",
- "Bool : NOT Bool",
- "Bool : Bool AND Bool",
- "Bool : Bool OR Bool",
- "Bool : Expr LT Expr",
- "Bool : Expr GT Expr",
- "Bool : Expr LE Expr",
- "Bool : Expr GE Expr",
- "Bool : Expr EQ Expr",
- "Bool : Expr NE Expr",
- "Bool : String EQ",
- "Bool : String EQ String",
- "Bool : Expr EQ String",
- "Bool : String NE",
- "Bool : String NE String",
- "Bool : Expr NE String",
- "String : STRING",
- "String : String CONCAT",
- "String : String CONCAT String",
- "String : Expr CONCAT",
- "String : Expr CONCAT String",
- "String : S_USER RPAR",
- "String : S_USER_S",
- "String : S_USER_S String RPAR",
- "String : S_USER_X Expr RPAR",
- "String : S_USER_X_S Expr COMMA",
- "String : S_USER_X_S Expr COMMA String RPAR",
- "String : ANAM Expr RPAR",
- "String : AVAL Expr RPAR",
- "String : ENV",
- "String : ENV String RPAR",
- "String : DEFINED",
- "String : DEFINED String RPAR",
- "String : FORMAT Expr COMMA String RPAR",
- "String : QUOTE",
- "String : QUOTE String RPAR",
- "String : UNQUOTE",
- "String : UNQUOTE String RPAR",
- "String : Word RPAR",
- "String : Word COMMA Expr RPAR",
- "String : Word COMMA Expr COMMA Expr RPAR",
- "String : Word COMMA Expr COMMA Expr COMMA",
- "String : Word COMMA Expr COMMA Expr COMMA String RPAR",
- "String : LOWER",
- "String : LOWER String RPAR",
- "String : UPPER",
- "String : UPPER String RPAR",
- "String : Substring Expr RPAR",
- "String : Substring Expr COMMA Expr RPAR",
- "String : Shell RPAR",
- "String : Shell COMMA String RPAR",
- "String : Shell COMMA Expr RPAR",
- "Substring : SUBSTRING",
- "Substring : SUBSTRING String COMMA",
- "Words : WORDS",
- "Words : WORDS String",
- "Word : WORD",
- "Word : WORD String",
- "Shell : SHELL",
- "Shell : SHELL String",
- "Vdim : VDIM",
- "Vdim : VDIM String",
- "Vlen : VLEN",
- "Vlen : VLEN String",
-};
-#endif /* YYDEBUG */
-#define YYFLAG (-3000)
-/* @(#) $Revision: 1.3 $ */
-
-/*
-** Skeleton parser driver for yacc output
-*/
-
-#if defined(NLS) && !defined(NL_SETN)
-#include <msgbuf.h>
-#endif
-
-#ifndef nl_msg
-#define nl_msg(i,s) (s)
-#endif
-
-/*
-** yacc user known macros and defines
-*/
-#define YYERROR goto yyerrlab
-
-#ifndef __RUNTIME_YYMAXDEPTH
-#define YYACCEPT return(0)
-#define YYABORT return(1)
-#else
-#define YYACCEPT {free_stacks(); return(0);}
-#define YYABORT {free_stacks(); return(1);}
-#endif
-
-#define YYBACKUP( newtoken, newvalue )\
-{\
- if ( yychar >= 0 || ( yyr2[ yytmp ] >> 1 ) != 1 )\
- {\
- yyerror( (nl_msg(30001,"syntax error - cannot backup")) );\
- goto yyerrlab;\
- }\
- yychar = newtoken;\
- yystate = *yyps;\
- yylval = newvalue;\
- goto yynewstate;\
-}
-#define YYRECOVERING() (!!yyerrflag)
-#ifndef YYDEBUG
-# define YYDEBUG 1 /* make debugging available */
-#endif
-
-/*
-** user known globals
-*/
-int yydebug; /* set to 1 to get debugging */
-
-/*
-** driver internal defines
-*/
-/* define for YYFLAG now generated by yacc program. */
-/*#define YYFLAG (FLAGVAL)*/
-
-/*
-** global variables used by the parser
-*/
-# ifndef __RUNTIME_YYMAXDEPTH
-__YYSCLASS YYSTYPE yyv[ YYMAXDEPTH ]; /* value stack */
-__YYSCLASS int yys[ YYMAXDEPTH ]; /* state stack */
-# else
-__YYSCLASS YYSTYPE *yyv; /* pointer to malloc'ed value stack */
-__YYSCLASS int *yys; /* pointer to malloc'ed stack stack */
-
-#if defined(__STDC__) || defined (__cplusplus)
-#include <stdlib.h>
-#else
- extern char *malloc();
- extern char *realloc();
- extern void free();
-#endif /* __STDC__ or __cplusplus */
-
-
-static int allocate_stacks();
-static void free_stacks();
-# ifndef YYINCREMENT
-# define YYINCREMENT (YYMAXDEPTH/2) + 10
-# endif
-# endif /* __RUNTIME_YYMAXDEPTH */
-long yymaxdepth = YYMAXDEPTH;
-
-__YYSCLASS YYSTYPE *yypv; /* top of value stack */
-__YYSCLASS int *yyps; /* top of state stack */
-
-__YYSCLASS int yystate; /* current state */
-__YYSCLASS int yytmp; /* extra var (lasts between blocks) */
-
-int yynerrs; /* number of errors */
-__YYSCLASS int yyerrflag; /* error recovery flag */
-int yychar; /* current input token number */
-
-
-
-/*
-** yyparse - return 0 if worked, 1 if syntax error not recovered from
-*/
-int
-yyparse()
-{
- register YYSTYPE *yypvt; /* top of value stack for $vars */
-
- /*
- ** Initialize externals - yyparse may be called more than once
- */
-# ifdef __RUNTIME_YYMAXDEPTH
- if (allocate_stacks()) YYABORT;
-# endif
- yypv = &yyv[-1];
- yyps = &yys[-1];
- yystate = 0;
- yytmp = 0;
- yynerrs = 0;
- yyerrflag = 0;
- yychar = -1;
-
- goto yystack;
- {
- register YYSTYPE *yy_pv; /* top of value stack */
- register int *yy_ps; /* top of state stack */
- register int yy_state; /* current state */
- register int yy_n; /* internal state number info */
-
- /*
- ** get globals into registers.
- ** branch to here only if YYBACKUP was called.
- */
- yynewstate:
- yy_pv = yypv;
- yy_ps = yyps;
- yy_state = yystate;
- goto yy_newstate;
-
- /*
- ** get globals into registers.
- ** either we just started, or we just finished a reduction
- */
- yystack:
- yy_pv = yypv;
- yy_ps = yyps;
- yy_state = yystate;
-
- /*
- ** top of for (;;) loop while no reductions done
- */
- yy_stack:
- /*
- ** put a state and value onto the stacks
- */
-#if YYDEBUG
- /*
- ** if debugging, look up token value in list of value vs.
- ** name pairs. 0 and negative (-1) are special values.
- ** Note: linear search is used since time is not a real
- ** consideration while debugging.
- */
- if ( yydebug )
- {
- register int yy_i;
-
- printf( "State %d, token ", yy_state );
- if ( yychar == 0 )
- printf( "end-of-file\n" );
- else if ( yychar < 0 )
- printf( "-none-\n" );
- else
- {
- for ( yy_i = 0; yytoks[yy_i].t_val >= 0;
- yy_i++ )
- {
- if ( yytoks[yy_i].t_val == yychar )
- break;
- }
- printf( "%s\n", yytoks[yy_i].t_name );
- }
- }
-#endif /* YYDEBUG */
- if ( ++yy_ps >= &yys[ yymaxdepth ] ) /* room on stack? */
- {
-# ifndef __RUNTIME_YYMAXDEPTH
- yyerror( (nl_msg(30002,"yacc stack overflow")) );
- YYABORT;
-# else
- /* save old stack bases to recalculate pointers */
- YYSTYPE * yyv_old = yyv;
- int * yys_old = yys;
- yymaxdepth += YYINCREMENT;
- yys = (int *) realloc(yys, yymaxdepth * sizeof(int));
- yyv = (YYSTYPE *) realloc(yyv, yymaxdepth * sizeof(YYSTYPE));
- if (yys==0 || yyv==0) {
- yyerror( (nl_msg(30002,"yacc stack overflow")) );
- YYABORT;
- }
- /* Reset pointers into stack */
- yy_ps = (yy_ps - yys_old) + yys;
- yyps = (yyps - yys_old) + yys;
- yy_pv = (yy_pv - yyv_old) + yyv;
- yypv = (yypv - yyv_old) + yyv;
-# endif
-
- }
- *yy_ps = yy_state;
- *++yy_pv = yyval;
-
- /*
- ** we have a new state - find out what to do
- */
- yy_newstate:
- if ( ( yy_n = yypact[ yy_state ] ) <= YYFLAG )
- goto yydefault; /* simple state */
-#if YYDEBUG
- /*
- ** if debugging, need to mark whether new token grabbed
- */
- yytmp = yychar < 0;
-#endif
- if ( ( yychar < 0 ) && ( ( yychar = yylex() ) < 0 ) )
- yychar = 0; /* reached EOF */
-#if YYDEBUG
- if ( yydebug && yytmp )
- {
- register int yy_i;
-
- printf( "Received token " );
- if ( yychar == 0 )
- printf( "end-of-file\n" );
- else if ( yychar < 0 )
- printf( "-none-\n" );
- else
- {
- for ( yy_i = 0; yytoks[yy_i].t_val >= 0;
- yy_i++ )
- {
- if ( yytoks[yy_i].t_val == yychar )
- break;
- }
- printf( "%s\n", yytoks[yy_i].t_name );
- }
- }
-#endif /* YYDEBUG */
- if ( ( ( yy_n += yychar ) < 0 ) || ( yy_n >= YYLAST ) )
- goto yydefault;
- if ( yychk[ yy_n = yyact[ yy_n ] ] == yychar ) /*valid shift*/
- {
- yychar = -1;
- yyval = yylval;
- yy_state = yy_n;
- if ( yyerrflag > 0 )
- yyerrflag--;
- goto yy_stack;
- }
-
- yydefault:
- if ( ( yy_n = yydef[ yy_state ] ) == -2 )
- {
-#if YYDEBUG
- yytmp = yychar < 0;
-#endif
- if ( ( yychar < 0 ) && ( ( yychar = yylex() ) < 0 ) )
- yychar = 0; /* reached EOF */
-#if YYDEBUG
- if ( yydebug && yytmp )
- {
- register int yy_i;
-
- printf( "Received token " );
- if ( yychar == 0 )
- printf( "end-of-file\n" );
- else if ( yychar < 0 )
- printf( "-none-\n" );
- else
- {
- for ( yy_i = 0;
- yytoks[yy_i].t_val >= 0;
- yy_i++ )
- {
- if ( yytoks[yy_i].t_val
- == yychar )
- {
- break;
- }
- }
- printf( "%s\n", yytoks[yy_i].t_name );
- }
- }
-#endif /* YYDEBUG */
- /*
- ** look through exception table
- */
- {
- register int *yyxi = yyexca;
-
- while ( ( *yyxi != -1 ) ||
- ( yyxi[1] != yy_state ) )
- {
- yyxi += 2;
- }
- while ( ( *(yyxi += 2) >= 0 ) &&
- ( *yyxi != yychar ) )
- ;
- if ( ( yy_n = yyxi[1] ) < 0 )
- YYACCEPT;
- }
- }
-
- /*
- ** check for syntax error
- */
- if ( yy_n == 0 ) /* have an error */
- {
- /* no worry about speed here! */
- switch ( yyerrflag )
- {
- case 0: /* new error */
- yyerror( (nl_msg(30003,"syntax error")) );
- yynerrs++;
- goto skip_init;
- yyerrlab:
- /*
- ** get globals into registers.
- ** we have a user generated syntax type error
- */
- yy_pv = yypv;
- yy_ps = yyps;
- yy_state = yystate;
- yynerrs++;
- skip_init:
- case 1:
- case 2: /* incompletely recovered error */
- /* try again... */
- yyerrflag = 3;
- /*
- ** find state where "error" is a legal
- ** shift action
- */
- while ( yy_ps >= yys )
- {
- yy_n = yypact[ *yy_ps ] + YYERRCODE;
- if ( yy_n >= 0 && yy_n < YYLAST &&
- yychk[yyact[yy_n]] == YYERRCODE) {
- /*
- ** simulate shift of "error"
- */
- yy_state = yyact[ yy_n ];
- goto yy_stack;
- }
- /*
- ** current state has no shift on
- ** "error", pop stack
- */
-#if YYDEBUG
-# define _POP_ "Error recovery pops state %d, uncovers state %d\n"
- if ( yydebug )
- printf( _POP_, *yy_ps,
- yy_ps[-1] );
-# undef _POP_
-#endif
- yy_ps--;
- yy_pv--;
- }
- /*
- ** there is no state on stack with "error" as
- ** a valid shift. give up.
- */
- YYABORT;
- case 3: /* no shift yet; eat a token */
-#if YYDEBUG
- /*
- ** if debugging, look up token in list of
- ** pairs. 0 and negative shouldn't occur,
- ** but since timing doesn't matter when
- ** debugging, it doesn't hurt to leave the
- ** tests here.
- */
- if ( yydebug )
- {
- register int yy_i;
-
- printf( "Error recovery discards " );
- if ( yychar == 0 )
- printf( "token end-of-file\n" );
- else if ( yychar < 0 )
- printf( "token -none-\n" );
- else
- {
- for ( yy_i = 0;
- yytoks[yy_i].t_val >= 0;
- yy_i++ )
- {
- if ( yytoks[yy_i].t_val
- == yychar )
- {
- break;
- }
- }
- printf( "token %s\n",
- yytoks[yy_i].t_name );
- }
- }
-#endif /* YYDEBUG */
- if ( yychar == 0 ) /* reached EOF. quit */
- YYABORT;
- yychar = -1;
- goto yy_newstate;
- }
- }/* end if ( yy_n == 0 ) */
- /*
- ** reduction by production yy_n
- ** put stack tops, etc. so things right after switch
- */
-#if YYDEBUG
- /*
- ** if debugging, print the string that is the user's
- ** specification of the reduction which is just about
- ** to be done.
- */
- if ( yydebug )
- printf( "Reduce by (%d) \"%s\"\n",
- yy_n, yyreds[ yy_n ] );
-#endif
- yytmp = yy_n; /* value to switch over */
- yypvt = yy_pv; /* $vars top of value stack */
- /*
- ** Look in goto table for next state
- ** Sorry about using yy_state here as temporary
- ** register variable, but why not, if it works...
- ** If yyr2[ yy_n ] doesn't have the low order bit
- ** set, then there is no action to be done for
- ** this reduction. So, no saving & unsaving of
- ** registers done. The only difference between the
- ** code just after the if and the body of the if is
- ** the goto yy_stack in the body. This way the test
- ** can be made before the choice of what to do is needed.
- */
- {
- /* length of production doubled with extra bit */
- register int yy_len = yyr2[ yy_n ];
-
- if ( !( yy_len & 01 ) )
- {
- yy_len >>= 1;
- yyval = ( yy_pv -= yy_len )[1]; /* $$ = $1 */
- yy_state = yypgo[ yy_n = yyr1[ yy_n ] ] +
- *( yy_ps -= yy_len ) + 1;
- if ( yy_state >= YYLAST ||
- yychk[ yy_state =
- yyact[ yy_state ] ] != -yy_n )
- {
- yy_state = yyact[ yypgo[ yy_n ] ];
- }
- goto yy_stack;
- }
- yy_len >>= 1;
- yyval = ( yy_pv -= yy_len )[1]; /* $$ = $1 */
- yy_state = yypgo[ yy_n = yyr1[ yy_n ] ] +
- *( yy_ps -= yy_len ) + 1;
- if ( yy_state >= YYLAST ||
- yychk[ yy_state = yyact[ yy_state ] ] != -yy_n )
- {
- yy_state = yyact[ yypgo[ yy_n ] ];
- }
- }
- /* save until reenter driver code */
- yystate = yy_state;
- yyps = yy_ps;
- yypv = yy_pv;
- }
- /*
- ** code supplied by user is placed in this switch
- */
- switch( yytmp )
- {
-
-case 1:{
- iresult = yypvt[-0].dval; /* 0 or 1 */
- } break;
-case 2:{
- iresult = (yypvt[-0].dval != 0);
- } break;
-case 3:{
- dresult = yypvt[-0].dval;
- } break;
-case 4:{
- int maxint = 0x7FFFFFFF;
- if( yypvt[-0].dval <= maxint && yypvt[-0].dval >= -maxint && (int)yypvt[-0].dval == yypvt[-0].dval ) {
- result = malloc( 16 );
- sprintf( result, "%d", (int)yypvt[-0].dval );
- }
- else {
- result = strdup( strfromd( yypvt[-0].dval, 0 ) );
- }
- if( rsigma && strpbrk( result, ".eE" ) == NULL ) {
- /* append a dot to make an integer look like a float */
- result = mstrcat( result, "." );
- }
- } break;
-case 5:{
- result = yypvt[-0].sval;
- } break;
-case 6:{ yyval.dval = yypvt[-0].dval; } break;
-case 7:{ yyval.dval = yypvt[-1].dval; } break;
-case 8:{ yyval.dval = yypvt[-0].dval; } break;
-case 9:{ yyval.dval = -yypvt[-0].dval; } break;
-case 10:{ yyval.dval = yypvt[-2].dval + yypvt[-0].dval; } break;
-case 11:{ yyval.dval = yypvt[-2].dval - yypvt[-0].dval; } break;
-case 12:{ yyval.dval = yypvt[-2].dval * yypvt[-0].dval; } break;
-case 13:{ yyval.dval = yypvt[-1].dval < 0 ? -yypvt[-1].dval : yypvt[-1].dval; } break;
-case 14:{ yyval.dval = (int)yypvt[-1].dval; } break;
-case 15:{ yyval.dval = IQUEST((int)yypvt[-1].dval); } break;
-case 16:{
- if( yypvt[-0].dval != 0 )
- yyval.dval = yypvt[-2].dval / yypvt[-0].dval;
- else
- YYABORT;
- } break;
-case 17:{
- if( yypvt[-1].dval != 0 )
-/* $$ = $2 / $4 - (int)($2 / $4); */
- yyval.dval = (int) yypvt[-3].dval % (int) yypvt[-1].dval;
- else
- YYABORT;
- } break;
-case 18:{nonum=1;} break;
-case 19:{
- yyval.dval = strlen( yypvt[-1].sval );
- free( yypvt[-1].sval );
- nonum = 0;
- } break;
-case 20:{nonum=1;} break;
-case 21:{
- char *p = strstr( yypvt[-3].sval, yypvt[-1].sval );
- if( p == NULL )
- yyval.dval = 0;
- else
- yyval.dval = p - yypvt[-3].sval + 1;
- free( yypvt[-3].sval );
- free( yypvt[-1].sval );
- nonum = 0;
- } break;
-case 22:{
- yyval.dval = count_words( yypvt[-1].sval, " " );
- nonum = 0;
- } break;
-case 23:{
- yyval.dval = count_words( yypvt[-3].sval, yypvt[-1].sval );
- free( yypvt[-1].sval );
- nonum = 0;
- } break;
-case 24:{nonum=1;} break;
-case 25:{
- FILE *stream;
- char* fname = fexpand(yypvt[-1].sval,NULL);
- stream = fopen( fname, "r" );
- if( stream == NULL ) {
- yyval.dval = 0;
- }
- else {
- yyval.dval = 1;
- fclose( stream );
- }
- free( yypvt[-1].sval );
- nonum = 0;
- } break;
-case 26:{nonum=1;} break;
-case 27:{
- yyval.dval = ku_vtype( yypvt[-1].sval );
- free( yypvt[-1].sval );
- nonum = 0;
- } break;
-case 28:{
- if( ku_vtype( yypvt[-1].sval ) != 0 )
- yyval.dval = IQUEST( 31 );
- else
- yyval.dval = 0;
- free( yypvt[-1].sval );
- } break;
-case 29:{
- int n = yypvt[-1].dval;
- if( n >= 1 && n <= 3 && ku_vtype( yypvt[-3].sval ) != 0 )
- yyval.dval = IQUEST(30+n);
- else
- yyval.dval = 0;
- free( yypvt[-3].sval );
- } break;
-case 30:{
- if( ku_vtype( yypvt[-1].sval ) != 0 ) {
- int k = IQUEST(31);
- if( IQUEST(32) == 1 && IQUEST(33) == 1 ) {
- int low = ku_vqaddr( yypvt[-1].sval );
- while( k > 0 && IQ(low+k-1) == 0 )
- k--;
- }
- yyval.dval = k;
- }
- else
- yyval.dval = 0;
- free( yypvt[-1].sval );
- } break;
-case 31:{
- int n = yypvt[-1].dval;
- if( n >= 1 && n <= 3 && ku_vtype( yypvt[-3].sval ) != 0 ) {
- int k = IQUEST(30+n);
- if( n == 1 && IQUEST(32) == 1 && IQUEST(33) == 1 ) {
- int low = ku_vqaddr( yypvt[-3].sval );
- while( k > 0 && IQ(low+k-1) == 0 )
- k--;
- }
- yyval.dval = k;
- }
- else
- yyval.dval = 0;
- free( yypvt[-3].sval );
- } break;
-case 32:{
- int n = strlen( yypvt[-2].sval );
- yypvt[-2].sval = realloc( yypvt[-2].sval, n + 16 );
- sprintf( &yypvt[-2].sval[n], "(%d)", (int)yypvt[-1].dval );
- n = ku_vvalue( yypvt[-2].sval, &yyval.dval );
- free( yypvt[-2].sval );
- if( n != 0 )
- YYABORT;
- } break;
-case 33:{
- int n = strlen( yypvt[-4].sval );
- yypvt[-4].sval = realloc( yypvt[-4].sval, n + 32 );
- sprintf( &yypvt[-4].sval[n], "(%d,%d)", (int)yypvt[-3].dval, (int)yypvt[-1].dval );
- n = ku_vvalue( yypvt[-4].sval, &yyval.dval );
- free( yypvt[-4].sval );
- if( n != 0 )
- YYABORT;
- } break;
-case 34:{
- int n = strlen( yypvt[-6].sval );
- yypvt[-6].sval = realloc( yypvt[-6].sval, n + 48 );
- sprintf( &yypvt[-6].sval[n], "(%d,%d,%d)", (int)yypvt[-5].dval, (int)yypvt[-3].dval, (int)yypvt[-1].dval );
- n = ku_vvalue( yypvt[-6].sval, &yyval.dval );
- free( yypvt[-6].sval );
- if( n != 0 )
- YYABORT;
- } break;
-case 35:{nonum=1;} break;
-case 36:{
- char *slist[2];
- double dlist[2];
- int which[2];
- which[0] = 2;
- slist[1] = yypvt[-1].sval;
- which[1] = 1;
- call_user_function( yypvt[-3].sval, slist, dlist, which, 1 );
- yyval.dval = dlist[0];
- nonum = 0;
- } break;
-case 37:{
- char *slist[2];
- double dlist[2];
- int which[2];
- which[0] = 2;
- dlist[1] = yypvt[-1].dval;
- which[1] = 2;
- call_user_function( yypvt[-2].sval, slist, dlist, which, 1 );
- yyval.dval = dlist[0];
- } break;
-case 38:{nonum=1;} break;
-case 39:{
- char *slist[3];
- double dlist[3];
- int which[3];
- which[0] = 2;
- dlist[1] = yypvt[-4].dval;
- which[1] = 2;
- slist[2] = yypvt[-1].sval;
- which[2] = 1;
- call_user_function( yypvt[-5].sval, slist, dlist, which, 2 );
- yyval.dval = dlist[0];
- nonum = 0;
- } break;
-case 40:{ yyval.dval = yypvt[-1].dval; } break;
-case 41:{ yyval.dval = ! yypvt[-0].dval; } break;
-case 42:{ yyval.dval = yypvt[-2].dval && yypvt[-0].dval; } break;
-case 43:{ yyval.dval = yypvt[-2].dval || yypvt[-0].dval; } break;
-case 44:{ yyval.dval = yypvt[-2].dval < yypvt[-0].dval; } break;
-case 45:{ yyval.dval = yypvt[-2].dval > yypvt[-0].dval; } break;
-case 46:{ yyval.dval = yypvt[-2].dval <= yypvt[-0].dval; } break;
-case 47:{ yyval.dval = yypvt[-2].dval >= yypvt[-0].dval; } break;
-case 48:{
- char *s1 = strdup( strfromd( yypvt[-2].dval, 0 ) );
- yyval.dval = (strcmp( s1, strfromd( yypvt[-0].dval, 0 ) ) == 0);
- free( s1 );
- } break;
-case 49:{
- char *s1 = strdup( strfromd( yypvt[-2].dval, 0 ) );
- yyval.dval = (strcmp( s1, strfromd( yypvt[-0].dval, 0 ) ) != 0);
- free( s1 );
- } break;
-case 50:{nonum=1;} break;
-case 51:{
- yyval.dval = (strcmp( yypvt[-3].sval, yypvt[-0].sval ) == 0);
- free( yypvt[-3].sval );
- free( yypvt[-0].sval );
- nonum = 0;
- } break;
-case 52:{
- yyval.dval = (strcmp( strfromd( yypvt[-2].dval,0 ), yypvt[-0].sval ) == 0);
- free( yypvt[-0].sval );
- } break;
-case 53:{nonum=1;} break;
-case 54:{
- yyval.dval = (strcmp( yypvt[-3].sval, yypvt[-0].sval ) != 0);
- free( yypvt[-3].sval );
- free( yypvt[-0].sval );
- nonum = 0;
- } break;
-case 55:{
- yyval.dval = (strcmp( strfromd( yypvt[-2].dval,0 ), yypvt[-0].sval ) != 0);
- free( yypvt[-0].sval );
- } break;
-case 56:{ yyval.sval = yypvt[-0].sval; } break;
-case 57:{nonum=1;} break;
-case 58:{
- yyval.sval = mstrcat( yypvt[-3].sval, yypvt[-0].sval );
- free( yypvt[-0].sval );
- nonum = 0;
- } break;
-case 59:{nonum=1;} break;
-case 60:{
- yyval.sval = strdup( strfromd( yypvt[-3].dval, 0 ) );
- yyval.sval = mstrcat( yyval.sval, yypvt[-0].sval);
- free( yypvt[-0].sval );
- nonum = 0;
- } break;
-case 61:{
- char *slist[1];
- double dlist[1];
- int which[1];
- which[0] = 1;
- call_user_function( yypvt[-1].sval, slist, dlist, which, 0 );
- yyval.sval = slist[0];
- } break;
-case 62:{nonum=1;} break;
-case 63:{
- char *slist[2];
- double dlist[2];
- int which[2];
- which[0] = 1;
- slist[1] = yypvt[-1].sval;
- which[1] = 1;
- call_user_function( yypvt[-3].sval, slist, dlist, which, 1 );
- yyval.sval = slist[0];
- nonum = 0;
- } break;
-case 64:{
- char *slist[2];
- double dlist[2];
- int which[2];
- which[0] = 1;
- dlist[1] = yypvt[-1].dval;
- which[1] = 2;
- call_user_function( yypvt[-2].sval, slist, dlist, which, 1 );
- yyval.sval = slist[0];
- } break;
-case 65:{nonum=1;} break;
-case 66:{
- char *slist[3];
- double dlist[3];
- int which[3];
- which[0] = 1;
- dlist[1] = yypvt[-4].dval;
- which[1] = 2;
- slist[2] = yypvt[-1].sval;
- which[2] = 1;
- call_user_function( yypvt[-5].sval, slist, dlist, which, 2 );
- yyval.sval = slist[0];
- nonum = 0;
- } break;
-case 67:{
- int n = yypvt[-1].dval;
- if( n > 0 && n <= hash_entries( kc_alias.arg_table ) ) {
- HashArray *alias = hash_array( kc_alias.arg_table );
- yyval.sval = strdup( alias[n-1].name );
- free( (char*)alias );
- }
- else
- YYABORT;
- } break;
-case 68:{
- int n = yypvt[-1].dval;
- if( n > 0 && n <= hash_entries( kc_alias.arg_table ) ) {
- HashArray *alias = hash_array( kc_alias.arg_table );
- yyval.sval = strdup( (char*)alias[n-1].value );
- free( (char*)alias );
- }
- else
- YYABORT;
- } break;
-case 69:{nonum=1;} break;
-case 70:{
- if( (yyval.sval = getenv( yypvt[-1].sval )) == NULL )
- yyval.sval = "";
- free( yypvt[-1].sval );
- yyval.sval = strdup( yyval.sval );
- nonum = 0;
- } break;
-case 71:{nonum=1;} break;
-case 72:{
- int n = hash_entries( kc_alias.var_table );
- yyval.sval = strdup( "" );
- if( n > 0 ) {
- HashArray *values = hash_array( kc_alias.var_table );
- int i;
- for( i = 0; i < n; i++ ) {
- char *name = values[i].name;
-
- if( ku_match( name, yypvt[-1].sval, 1 ) ) {
- if( yyval.sval[0] != '\0' )
- yyval.sval = mstrcat( yyval.sval, " " );
- yyval.sval = mstrcat( yyval.sval, name );
- }
- }
- free( (char*)values );
- }
- free( yypvt[-1].sval );
- nonum = 0;
- } break;
-case 73:{
- char format[16];
- char *dot;
- int n = fstrtoi( yypvt[-1].sval + 1, &dot );
- int m = 0;
-
- if( *dot == '.' ) {
- char *tail;
- m = fstrtoi( dot + 1, &tail );
- }
-
- yyval.sval = realloc( yypvt[-1].sval, 256 ); /* some safety for too small n */
-
- switch( yyval.sval[0] ) {
-
- case 'I': case 'i':
- sprintf( format, "%%%dd", n );
- sprintf( yyval.sval, format, (int)yypvt[-3].dval );
- if( m > 0 )
- yyval.sval = zero_pad( yyval.sval, m );
- break;
-
- case 'Z': case 'z': /* hexadecimal */
- sprintf( format, "%%%dX", n );
- sprintf( yyval.sval, format, (int)yypvt[-3].dval );
- if( m > 0 )
- yyval.sval = zero_pad( yyval.sval, m );
- break;
-
- case 'F': case 'f':
- sprintf( format, "%%%d.%df", n, m );
- sprintf( yyval.sval, format, yypvt[-3].dval );
- /* force a decimal point */
- if( strchr( yyval.sval, '.' ) == NULL )
- yyval.sval = mstrcat( yyval.sval, "." );
- break;
-
- case 'E': case 'e':
- sprintf( format, "%%%d.%de", n, m );
- sprintf( yyval.sval, format, yypvt[-3].dval );
- strupper( yyval.sval );
- break;
-
- case 'G': case 'g':
- sprintf( format, "%%%d.%dg", n, m );
- sprintf( yyval.sval, format, yypvt[-3].dval );
- strupper( yyval.sval );
- break;
-
- default: /* error */
- free( yyval.sval );
- YYABORT;
- break;
- }
- } break;
-case 74:{nonum=1;} break;
-case 75:{
- yyval.sval = quote_string( yypvt[-1].sval, 1 );
- nonum = 0;
- } break;
-case 76:{nonum=1;} break;
-case 77:{
- /* int n = strlen( $$ ); - NC - */
- int n = strlen( yypvt[-1].sval );
- yyval.sval = yypvt[-1].sval;
- if( n >= 2 && yyval.sval[0] == '\'' && yyval.sval[n-1] == '\'' ) {
- char *p = yyval.sval;
- yyval.sval[n-1] = '\0';
- strcpy( yyval.sval, yyval.sval + 1 );
- while( (p = strstr( p, "''" )) != NULL ) {
- strcpy( p, p + 1 );
- p++;
- }
- }
- nonum = 0;
- } break;
-case 78:{
- yyval.sval = extract_word( yypvt[-1].sval, " ", 1 );
- free( yypvt[-1].sval );
- nonum = 0;
- } break;
-case 79:{
- yyval.sval = extract_word( yypvt[-3].sval, " ", (int)yypvt[-1].dval );
- free( yypvt[-3].sval );
- } break;
-case 80:{
- char *sep = " ";
- yyval.sval = join_words( yypvt[-5].sval, sep, (int)yypvt[-3].dval, (int)yypvt[-1].dval );
- free( yypvt[-5].sval );
- } break;
-case 81:{nonum=1;} break;
-case 82:{
- yyval.sval = join_words( yypvt[-8].sval, yypvt[-1].sval, (int)yypvt[-6].dval, (int)yypvt[-4].dval );
- free( yypvt[-8].sval );
- free( yypvt[-1].sval );
- nonum = 0;
- } break;
-case 83:{nonum=1;} break;
-case 84:{
- yyval.sval = strlower( yypvt[-1].sval );
- nonum = 0;
- } break;
-case 85:{nonum=1;} break;
-case 86:{
- yyval.sval = strupper( yypvt[-1].sval );
- nonum = 0;
- } break;
-case 87:{
- int len = strlen( yypvt[-2].sval );
- int k = yypvt[-1].dval;
- yyval.sval = yypvt[-2].sval;
- if( k <= 0 )
- k += len + 1;
- if( k > len )
- yyval.sval[0] = '\0';
- else if( k < 1 )
- YYABORT;
- else
- strcpy( yyval.sval, yyval.sval + k - 1 );
- } break;
-case 88:{
- int len = strlen( yypvt[-4].sval );
- int k = yypvt[-3].dval;
- int n = yypvt[-1].dval;
- yyval.sval = yypvt[-4].sval;
- if( k <= 0 )
- k += len + 1;
- if( k > len )
- yyval.sval[0] = '\0';
- else if( k < 1 )
- YYABORT;
- else {
- strcpy( yyval.sval, yyval.sval + k - 1 );
- if( k + n <= len )
- yyval.sval[n] = '\0';
- }
- } break;
-case 89:{
- yyval.sval = shell_line( yypvt[-1].sval, 0, " " );
- free( yypvt[-1].sval );
- } break;
-case 90:{
- yyval.sval = shell_line( yypvt[-3].sval, 0, yypvt[-1].sval );
- free( yypvt[-3].sval );
- free( yypvt[-1].sval );
- } break;
-case 91:{
- int n = yypvt[-1].dval;
- yyval.sval = shell_line( yypvt[-3].sval, n, NULL );
- free( yypvt[-3].sval );
- } break;
-case 92:{nonum=1;} break;
-case 93:{
- yyval.sval = yypvt[-1].sval;
- nonum = 0;
- } break;
-case 94:{nonum=1;} break;
-case 95:{
- yyval.sval = yypvt[-0].sval;
- } break;
-case 96:{nonum=1;} break;
-case 97:{
- yyval.sval = yypvt[-0].sval;
- nonum = 0;
- } break;
-case 98:{nonum=1;} break;
-case 99:{
- yyval.sval = yypvt[-0].sval;
- nonum = 0;
- } break;
-case 100:{nonum=1;} break;
-case 101:{
- yyval.sval = yypvt[-0].sval;
- nonum = 0;
- } break;
-case 102:{nonum=1;} break;
-case 103:{
- yyval.sval = yypvt[-0].sval;
- nonum = 0;
- } break;
- }
- goto yystack; /* reset registers in driver code */
-}
-
-# ifdef __RUNTIME_YYMAXDEPTH
-
-static int allocate_stacks() {
- /* allocate the yys and yyv stacks */
- yys = (int *) malloc(yymaxdepth * sizeof(int));
- yyv = (YYSTYPE *) malloc(yymaxdepth * sizeof(YYSTYPE));
-
- if (yys==0 || yyv==0) {
- yyerror( (nl_msg(30004,"unable to allocate space for yacc stacks")) );
- return(1);
- }
- else return(0);
-
-}
-
-
-static void free_stacks() {
- if (yys!=0) free((char *) yys);
- if (yyv!=0) free((char *) yyv);
-}
-
-# endif /* defined(__RUNTIME_YYMAXDEPTH) */
-
diff --git a/src/packlib/kuip/code_kuip/kmenu.c b/src/packlib/kuip/code_kuip/kmenu.c
deleted file mode 100644
index f135b07..0000000
--- a/src/packlib/kuip/code_kuip/kmenu.c
+++ /dev/null
@@ -1,2973 +0,0 @@
-/*
- * $Id: kmenu.c,v 1.5 1999/06/04 09:42:02 couet Exp $
- *
- * $Log: kmenu.c,v $
- * Revision 1.5 1999/06/04 09:42:02 couet
- * - mod for latex
- *
- * Revision 1.4 1997/03/17 16:54:58 mclareni
- * WNT mods
- *
- * Revision 1.3 1997/01/28 14:17:49 gunter
- * In realloc_find, avoid to double free memory; this caused a bad crash
- * on Linux.
- *
- * In interactive find, fflush stdout before calling input_line(..); this
- * preserves the correct order of lines on stdout on Linux
- *
- * Revision 1.2.2.1 1997/01/21 11:32:49 mclareni
- * All mods for Winnt 96a on winnt branch
- *
- * Revision 1.2 1996/03/15 14:57:41 cremel
- * kuipcdf.c --> generated with new kuipc
- *
- * kmenu.c : re-implement the possibility to type "\" (one level back)
- * in command line for HELP.
- *
- * Revision 1.1.1.1 1996/03/08 15:32:57 mclareni
- * Kuip
- *
- */
-/*-- Author : Alfred Nathaniel 07/08/92 */
-/* kmenu.c: command menus */
-
-#include "kuip/kuip.h"
-#include "kuip/kfor.h"
-#include "kuip/klink.h"
-#include "kuip/kmenu.h"
-#include "kuip/kflag.h"
-#include "kuip/khash.h"
-#include "kuip/kalias.h"
-#include "kuip/mkutfu.h"
-
-EXTERN char cdf_def[80], cdf_value[80];
-
-enum { DOCSYS_HELP = 0, DOCSYS_USAGE, DOCSYS_LATEX };
-
-static KmMenu real_root = { (KmMenu*)0, (KmMenu*)0, "", "", 0,
- (KmCommand*)0, 0, (char**)0 };
-static KmMenu *curr_root = &real_root;
-static KmMenu *curr_menu = &real_root;
-static KmCommand *curr_cmd = NULL;
-static KmCommand *prev_cmd = NULL;
-static KmCommand **last_cmd_list = NULL;
-
-static char **flis_path = NULL;
-static char **flis_name = NULL;
-static char **flis_cmd = NULL;
-static char **flis_guidance = NULL;
-static int *flis_flag = NULL;
-static int *fprl_flag = NULL;
-
-static int see_hidden = 0; /* flag if hidden command should be seen */
-static int edit_mode = 1; /* flag for "edit" option in HELP/CHELP */
-
-static char *user_help_name; /* path name reported by KUHELP */
-
-static char *alpha_label[] = { /* Q is excluded */
- " A", " B", " C", " D", " E", " F", " G", " H",
- " I", " J", " K", " L", " M", " N", " O", " P",
- " R", " S", " T", " U", " V", " W", " X", " Y", " Z", " 0" };
-static int nalpha_label = (sizeof alpha_label) / sizeof(char*);
-
-
-static KmCommand* find_command( KmMenu*, const char* );
-static KmCommand** find_cmd_list( KmMenu*, const char* );
-static KmMenu** find_menu_list( KmMenu**, KmMenu*, const char* );
-static char* fmt_filter( const char*, int );
-static char* fmt_guidance( char**, int, int );
-static char* fmt_menu_help( KmMenu*, int );
-static char* fmt_paragraph( char*, const char*, int, int );
-static char* fmt_usage( KmCommand*, int );
-static int help_index( const char* );
-static char* help_label( int );
-static void interactive_help_motif( KmMenu* );
-static void interactive_help( KmMenu* );
-static void interactive_find( char*, int );
-static void realloc_find( int );
-static KmCommand* lookup_cmd( const char*, const char* );
-static void merge_menus( KmMenu*, KmMenu* );
-static void patch_defaults( KmMenu* );
-static char* get_guidance( char**, int );
-static void print_guidance( char**, int );
-static void print_help( char* );
-static void print_help_line ( int, char*, char*, int );
-
-
-/*
- * action routine for /KUIP/SET_SHOW/ROOT
- */
-int kxroot()
-{
- int status = 0;
- char *path = ku_getc();
-
- if( strcmp( path, "?" ) == 0 ) {
- ku_alfa();
- printf( " Current root: %s\n",
- (curr_root == &real_root) ? "/" : curr_root->path );
- }
- else if( strcmp( path, "/" ) == 0 ) {
- curr_root = &real_root;
- kc_value.set_root = "/";
- if( kc_flags.curr_prompt != NULL )
- free( kc_flags.curr_prompt );
- kc_flags.curr_prompt = strdup( kc_value.set_prompt );
- }
- else {
- KmMenu **menu_list = find_menu_list( NULL, &real_root, path );
- if( menu_list == NULL ) {
- ku_alfa();
- printf( " *** Unknown command path\n" );
- status = -1;
- }
- else {
- if( menu_list[1] != NULL ) {
- ku_alfa();
- printf( " *** Ambiguous command path\n" );
- status = -1;
- }
- else {
- curr_root = menu_list[0];
- kc_value.set_root = curr_root->path;
- if( kc_flags.curr_prompt != NULL )
- free( kc_flags.curr_prompt );
- if( strstr( kc_value.set_prompt, "[]" ) != NULL )
- kc_flags.curr_prompt = str2dup( curr_root->name, " []" );
- else
- kc_flags.curr_prompt = str2dup( curr_root->name, " >" );
- }
- free( menu_list );
- }
- }
- return status;
-}
-
-
-/*
- * action routine for /KUIP/SET_SHOW/VISIBILITY
- */
-int kxvisibility()
-{
- int status = 0;
- char *path = ku_getc();
- KmCommand *cmd;
-
- see_hidden = 1;
- cmd = search_command( path, NULL );
- see_hidden = 0;
-
- if( cmd == NULL )
- status = -1;
- else {
- char *opt = ku_getc();
- if( strcmp( opt, "ON" ) == 0 ) {
- cmd->hidden = 0;
- }
- else if( strcmp( opt, "OFF" ) == 0 ) {
- cmd->hidden = 1;
- }
- else {
- printf( " %s is %s\n", cmd->path, cmd->hidden ? "OFF" : "ON" );
- }
- }
- return status;
-}
-
-
-/*
- * find the command matching the given path using the search order
- * return NULL if no match found or ambiguous
- */
-KmCommand *search_command( const char *path,
- KmCommand ***cmd_list )
-{
- KmCommand *cmd;
- if( path[0] == '/' )
- cmd = find_command( &real_root, path );
- else {
- cmd = find_command( curr_root, path );
- if( cmd == NULL && last_cmd_list == NULL && curr_root != &real_root )
- cmd = find_command( &real_root, path );
- }
- if( cmd_list != NULL )
- *cmd_list = last_cmd_list;
- else if( cmd == NULL )
- print_cmd_list( last_cmd_list, path );
- return cmd;
-}
-
-
-/*
- * find the command matching the given path
- * return NULL if no match found or ambiguous
- * the last list is kept in last_cmd_list to allow checks for ambiguity
- */
-static
-KmCommand *find_command( KmMenu *menu,
- const char *cmd_path )
-{
- KmCommand **cmd_list = find_cmd_list( menu, cmd_path );
- KmCommand *cmd = NULL;
- const char *cmd_name;
- int ncmd = 0;
- int exact = 0;
- int min_level = 99;
- int i;
-
- if( last_cmd_list != NULL )
- free( last_cmd_list );
- last_cmd_list = cmd_list;
-
- if( cmd_list == NULL ) {
- /* no command found */
- return NULL;
- }
-#ifdef DBMALLOC
- malloc_mark( cmd_list );
-#endif
-
- /* count the number of commands */
- while( cmd_list[ncmd] != NULL )
- ncmd++;
-
- if( !see_hidden ) {
- /* remove hidden commands */
- for( i = 0; cmd_list[i] != NULL; i++ ) {
- if( cmd_list[i]->hidden ) {
- int j;
- for( j = i; j < ncmd; j++ )
- cmd_list[j] = cmd_list[j+1];
- ncmd--;
- i--;
- }
- }
- if( ncmd == 0 ) {
- /* no visible command left */
- free( last_cmd_list );
- last_cmd_list = NULL;
- return NULL;
- }
- }
-
- if( ncmd == 1 ) {
- /* unique command */
- return cmd_list[0];
- }
-
- cmd_name = strrchr( cmd_path, '/' );
- if( cmd_name != NULL )
- cmd_name++;
- else
- cmd_name = cmd_path;
-
- /* look for exact match */
- for( i = 0; i < ncmd; i++ ) {
- if( strcasecmp( cmd_list[i]->path, cmd_path ) == 0 ) {
- return cmd_list[i];
- }
- if( strcasecmp( cmd_list[i]->name, cmd_name ) == 0 ) {
- cmd_list[exact++] = cmd_list[i];
- }
- }
-
- if( exact > 0 ) {
- /* remove all inexact matches */
- ncmd = exact;
- cmd_list[ncmd] = NULL;
- if( ncmd == 1 ) {
- /* unique command */
- return cmd_list[0];
- }
- }
-
- /* check if unique on minimal depth of submenus */
- for( i = 0; i < ncmd; i++ ) {
- int level = cmd_list[i]->level;
- if( level < min_level ) {
- min_level = level;
- cmd = cmd_list[i];
- }
- else if( level == min_level ) {
- /* two commands on same level */
- cmd = NULL;
- }
- }
- return cmd;
-}
-
-
-/*
- * find all commands matching the given path
- */
-static
-KmCommand **find_cmd_list( KmMenu *top_menu,
- const char *cmd_path )
-{
- KmCommand **cmd_list = NULL;
- KmMenu **menu_list;
- char *full_path = strdup( cmd_path );
- char *menu_path = full_path;
- char *cmd_name = strrchr( full_path, '/' );
-
- if( cmd_name == NULL ) {
- /* path is only a command name ==> find all menus */
- cmd_name = full_path;
- menu_path = "";
- }
- else if( cmd_name == full_path ) {
- /* special case "/CMD" */
- cmd_name = &full_path[1];
- menu_path = "/";
- }
- else {
- /* split menu path and command name */
- *cmd_name++ = '\0';
- }
-
- if( (menu_list = find_menu_list( NULL, top_menu, menu_path )) != NULL ) {
- int cmd_len = strlen( cmd_name );
- int i;
-
- for( i = 0; menu_list[i] != NULL; i++ ) {
- KmCommand *cmd;
-
- for( cmd = menu_list[i]->cmds; cmd != NULL; cmd = cmd->next ) {
-
- if( strncasecmp( cmd->name, cmd_name, cmd_len ) == 0 ) {
- /* add command to list */
- int n = 0;
-
- if( cmd_list == NULL ) {
- /* allocate a new list */
- cmd_list = (KmCommand**)malloc( 2 * sizeof(KmCommand*) );
- }
- else {
- /* determine length of list and increase size */
- while( cmd_list[n] != NULL )
- n++;
- cmd_list = (KmCommand**)realloc( (char*)cmd_list,
- ( n + 2 ) * sizeof(KmCommand*) );
- }
- cmd_list[n] = cmd;
- cmd_list[n+1] = NULL;
- }
- }
- }
- free( menu_list );
- }
- free( full_path );
- return cmd_list;
-}
-
-
-/*
- * print command list
- */
-void print_cmd_list( KmCommand **cmd_list,
- const char *path )
-{
- ku_alfa();
-
- if( cmd_list == NULL ) {
- KmMenu **menu_list = root_menu_list( path );
- if( menu_list != NULL ) {
- int i;
- printf( " *** %s is a menu:\n", path );
- for( i = 0; menu_list[i] != NULL; i++ ) {
- printf( " %s\n", menu_list[i]->path );
- }
- free( (char*)menu_list );
- }
- else {
- printf( " *** Unknown command: %s\n", path );
- }
- }
- else {
- int i;
- printf( " *** Ambiguous command %s. Possible commands are :\n\n", path );
- for( i = 0; cmd_list[i] != NULL; i++ )
- printf( " %s\n", cmd_list[i]->path );
- putchar( '\n' );
- }
-}
-
-
-/*
- * return pointer to menu with given path
- */
-KmMenu *find_submenu( const char *path )
-{
- KmMenu *menu = NULL;
- if( path[0] == '\0' )
- menu = &real_root;
- else {
- KmMenu **menu_list = root_menu_list( path );
- if( menu_list != NULL ) {
- menu = menu_list[0];
- free( (char*)menu_list );
- }
- }
- return menu;
-}
-
-
-/*
- * return the list of all menus matching the given path
- * the pointer returned should be free'ed
- */
-KmMenu **root_menu_list( const char *path )
-{
- return find_menu_list( NULL, &real_root, path );
-}
-
-
-/*
- * find all menus matching the given path
- * the pointer returned should be free'ed
- */
-static
-KmMenu **find_menu_list( KmMenu **menu_list,
- KmMenu *top_menu,
- const char *menu_path )
-{
- const char *head = (menu_path[0] == '/') ? menu_path + 1 : menu_path;
- const char *tail = strchr( head, '/' );
- int head_len = (tail == NULL) ? strlen( head ) : tail - head;
-
- if( strncasecmp( top_menu->name, head, head_len ) == 0 ) {
-
- if( tail == NULL ) {
- /* add menu to list */
-
- if( top_menu != &real_root ) {
- int n = 0;
- if( menu_list == NULL ) {
- menu_list = (KmMenu**)malloc( 2 * sizeof(KmMenu*) );
- }
- else {
- while( menu_list[n] != NULL )
- n++;
- menu_list = (KmMenu**)realloc( (char*)menu_list,
- ( n + 2 ) * sizeof(KmMenu*) );
- }
- menu_list[n] = top_menu;
- menu_list[n+1] = NULL;
- }
- }
- else {
- /* look for submenus matching the rest of the path */
- KmMenu *menu;
- for( menu = top_menu->down; menu != NULL; menu = menu->next )
- menu_list = find_menu_list( menu_list, menu, tail );
- }
- }
-
- if( menu_path[0] != '/' || top_menu == &real_root ) {
- /* look for submenus matching a path not starting at root */
- KmMenu *menu;
- for( menu = top_menu->down; menu != NULL; menu = menu->next )
- menu_list = find_menu_list( menu_list, menu, menu_path );
- }
-
- return menu_list;
-}
-
-
-/*
- * merge menu into global tree
- */
-void klnkmenu( menu, version )
- KmMenu *menu;
- int version;
-{
- strcpy ( cdf_def, "Menu" );
- strcpy ( cdf_value, menu->path );
- check_version( version, KUIP_VERSION );
-
- patch_defaults( menu );
-
- if( real_root.down == NULL )
- real_root.down = menu;
- else
- merge_menus( real_root.down, menu );
-}
-
-
-/*
- * avoid the writable string problem when doing case conversion
- * on the default value by copying to allocated memory
- */
-static
-void patch_defaults( KmMenu *menu )
-{
- while( menu != NULL ) {
- KmCommand *cmd;
- for( cmd = menu->cmds; cmd != NULL; cmd = cmd->next ) {
- int i;
- for( i = 0; i < cmd->total; i++ ) {
- KmParameter *par = cmd->par[i];
- if( par->dfault != NULL )
- par->dfault = strdup( par->dfault );
- }
- }
- patch_defaults( menu->down );
- menu = menu->next;
- }
-}
-
-
-/*
- * check version numbers
- */
-void check_version( int cdf_version,
- int lib_version )
-{
- if( cdf_version != lib_version ) {
- printf( "\
-!!!!!!!!!!!!!! W A R N I N G !!!!!!!!!!!!!\n\n\
-The internal data structures have been changed.\n\
-Please recompile the CDF which contains the \n\
- \'%s\' definition \'%s\'\n\
-using the KUIPC compiler version %d.\n\n\
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!\n\n",
- cdf_def, cdf_value, lib_version );
- exit( 1 );
- }
-}
-
-
-/*
- * merge two menu trees
- */
-static
-void merge_menus( KmMenu *menu1,
- KmMenu *menu2 )
-{
- KmMenu *m1;
- KmMenu *last;
-
- for( m1 = menu1; m1 != NULL; last = m1, m1 = m1->next ) {
-
- if( strcmp( m1->name, menu2->name ) == 0 ) {
-
- /* merge commands of existing menus */
- if( m1->cmds == NULL )
- m1->cmds = menu2->cmds;
- else {
- KmCommand *cmd = m1->cmds;
- while( cmd->next != NULL )
- cmd = cmd->next;
- cmd->next = menu2->cmds;
- }
-
- /* merge submenus */
- if( m1->down == NULL )
- m1->down = menu2->down;
- else if( menu2->down != NULL )
- merge_menus( m1->down, menu2->down );
-
- /* handle next menu if any */
- if( menu2->next != NULL )
- merge_menus( menu1, menu2->next );
-
- return;
- }
- }
-
- /* add a new menu */
- last->next = menu2;
- if( menu2->next != NULL ) {
- KmMenu *m2 = menu2->next;
- menu2->next = NULL;
- merge_menus( menu1, m2 );
- }
-}
-
-
-/*
- * action routine for /KUIP/MANUAL
- */
-int kxmanual()
-{
- char *path = ku_getc();
- KmMenu **menu_list = NULL;
- KmMenu *menu;
- KmCommand **cmd_list;
- KmCommand *cmd = NULL;
- char *fname = ku_getf();
- FILE *stream = NULL;
- char *docsys_name = ku_getc();
- char *text;
- int docsys;
- int encapsulate = 1;
-
- if( strcmp( docsys_name, "SGML" ) == 0 ) {
- printf( " *** SGML not supported anymore. Please use LaTeX instead.\n" );
- return -1;
- }
-
- else if( strcmp( docsys_name, "TEX" ) == 0 ) {
- docsys = DOCSYS_LATEX; /* LaTeX without encapsulation */
- encapsulate = 0;
- }
-
- else if( strcmp( docsys_name, "LATEX" ) == 0 ) {
- docsys = DOCSYS_LATEX;
- }
-
- else if( strcmp( docsys_name, "USAGE" ) == 0 ) {
- docsys = DOCSYS_USAGE;
- }
-
- else {
- docsys = DOCSYS_HELP;
- }
-
- if( strcmp( path, "/" ) == 0 ) {
- menu_list = root_menu_list( "" );
- }
- else {
- cmd = search_command( path, &cmd_list );
- if( cmd == NULL ) {
- menu = find_submenu( path );
- if( menu != NULL ) {
- /* recursive descend to all submenus */
- menu_list = find_menu_list( NULL, menu, "" );
- }
- }
- if( cmd == NULL && menu_list == NULL ) {
- /* try if it is a alias like "A/CRE LS DIR C" */
- char *value = (char*)hash_lookup( kc_alias.cmd_table, path, NULL );
- if( value == NULL ) {
- print_cmd_list( cmd_list, path );
- return -1;
- }
- if( (cmd = search_command( value, NULL )) == NULL )
- return -1;
- }
- }
-
- if( fname[0] != '\0' ) {
- fname = fexpand( fname, NULL );
- remove( fname );
- stream = fopen( fname, "w" );
- free( fname );
- }
- if( stream == NULL )
- stream = stdout;
-
- switch( docsys ) {
- case DOCSYS_LATEX:
- if( encapsulate ) {
- fputs( "\
-\\documentclass[twoside]{report}\n\
-\\usepackage{a4wide}\n\
-%\\makeindex\n\
-\\parskip=\\medskipamount\n\
-\\textwidth=16cm\n\
-\\oddsidemargin=0cm\n\
-\\evensidemargin=\\oddsidemargin\n\
-\n\
-\\newif\\ifMENUtext \\MENUtexttrue\n\
-\\newcommand{\\DEFMENU}[3]{% {level}{name}{path}\n\
-\\chapter{#3}}\n\
-\n\
-\\newcommand{\\INDEX}[1]{% protect underscores\n\
-{\\def\\_{\\char'137}\\index{#1@{\\tt #1}}}}\n\
-\n\
-\\newcommand{\\DEFCMD}[5]{% {menulabel}{cmdlabel}{menupath}{cmdname}{args}\n\
-\\par\\begin{minipage}{\\textwidth}\n\
-\\subsection{#4 #5 \\label{#1:#2}\\INDEX{#3/#4}\\INDEX{#4}}}\n\
-\\newcommand{\\ENDCMD}{\\end{minipage}\\par}\n\
-\n\
-\\newcommand{\\DEFCBIG}[5]{% DEFCMD with long guidance text\n\
-\\subsection{#4 #5 \\label{#1:#2}\\INDEX{#3/#4}\\INDEX{#4}}}\n\
-\\newcommand{\\ENDCBIG}{\\par}\n\
-\n\
-\\newcommand{\\BEGARG}{\n\
-\\par\\begin{tabular}{lcp{.75\\textwidth}}}\n\
-\\newcommand{\\DEFARG}[4]{% {parname}{partype}{prompt}{default}\n\
-{\\tt #1} & #2 & ``#3'' {\\tt #4} \\\\}\n\
-\\newcommand{\\ENDARG}{\n\
-\\end{tabular}\\par}\n\
-\n\
-\\newcommand{\\BEGOPT}[1]{% {parname}\n\
-\\par\\noindent Possible {\\tt #1} values are:\n\
-\\par\\noindent \\begin{tabular}{lp{.85\\textwidth}}}\n\
-\\newcommand{\\DEFOPT}[2]{% {option}{text}\n\
-{\\tt #1} & #2 \\\\[1ex]}\n\
-\\newcommand{\\ENDOPT}{\\end{tabular}\\par}\n\
-\n\
-\\newcommand{\\BEGTEXT}{\\par}\n\
-\\newcommand{\\ENDTEXT}{}\n\
-\\newcommand{\\ENDVERB}{\\par}\n\
-\\newcommand{\\EMPTY}{{\\tt '\\char`\\ '}}% empty string\n\
-\\newcommand{\\BRA}{$\\langle$}% left angle <\n\
-\\newcommand{\\KET}{$\\rangle$}% right angle >\n\
-\\newcommand{\\PIPE}{$|$}% vertical bar |\n\
-\\newcommand{\\DQUOTE}{{\\tt \"}}% double quote \"\n\
-\n\
-\\begin{document}\n\
-", stream );
- }
- break;
- }
-
- if( menu_list != NULL ) {
- int i;
- for( i = 0; (menu = menu_list[i]) != NULL; i++ ) {
-
- if( docsys != DOCSYS_USAGE ) {
- text = fmt_menu_help( menu, docsys );
- fputs( text, stream );
- free( text );
- }
-
- for( cmd = menu->cmds; cmd != NULL; cmd = cmd->next ) {
- if( !cmd->hidden ) {
- text = fmt_cmd_help( cmd, docsys );
- fputs( text, stream );
- free( text );
- }
- }
- }
- free( menu_list );
- }
-
- else {
- text = fmt_cmd_help( cmd, docsys );
- if( kc_flags.in_motif && stream == stdout && docsys != DOCSYS_USAGE ) {
- /* display help text in Motif window */
- (*kjmpaddr.disp_text_C)( cmd->path, text, 0, 0, 1 );
- }
- else {
- fputs( text, stream );
- }
- free( text );
- }
-
- switch( docsys ) {
-
- case DOCSYS_LATEX:
- if( encapsulate ) {
- fputs( "\n\\end{document}\n", stream );
- }
- break;
- }
-
- if( stream != stdout )
- fclose( stream );
-
- return 0;
-}
-
-
-/*
- * action routine for /KUIP/CHELP (Command HELP)
- */
-int kxhelp()
-{
- char *path = ku_getc();
- int npar = ku_npar();
- KmMenu *menu = NULL;
- char *line;
- int status;
-
- if( npar >= 2 ) {
- char *view = ku_getc();
-
- if( strcmp( view, "E" ) == 0 || strcmp( view, "EDIT" ) == 0 )
- edit_mode = 1;
- else
- edit_mode = 0;
-
- kc_value.help_edit = edit_mode ? "-EDIT" : "-NOEDIT";
-
- if( path[0] == '\0' )
- return 0;
- }
-
- if( path[0] == '\0' )
- menu = &real_root;
- else if( strcmp( path, "/" ) != 0 ) {
- KmCommand **cmd_list;
- KmCommand *cmd = search_command( path, &cmd_list );
- if( cmd == NULL )
- menu = find_submenu( path );
- }
-
- if( menu != NULL ) {
- if( kc_flags.in_motif ) {
- interactive_help_motif( menu );
- }
- else {
- interactive_help( menu );
- }
- return 0;
- }
-
- line = str2dup( "/KUIP/MANUAL ", path );
- if( edit_mode )
- line = mstr3cat( line, " '", kc_flags.help_file, "'" );
-
- status = ku_exel( line );
- free( line );
-
- if( status == 0 && edit_mode ) {
- ku_pad( kc_flags.help_file, 1 );
- }
-
- return status;
-}
-
-
-/*
- * action routine for /KUIP/FIND
- */
-int kxfind()
-{
- char *keyw_expr = NULL;
- int npar = ku_npar();
- int key_mode = 0;
-
- if( npar == 1 ) {
- keyw_expr = ku_getc();
- } else if( npar > 1 ) {
- char *view;
- int i;
-
- for (i=0; i<npar-1; i++) {
- char *par = ku_getc();
- keyw_expr = mstr2cat( keyw_expr, " ", par);
- }
- /* last parameter : special case for EDIT, NOEDIT or KEYWORD (options) */
- view = ku_getc();
-
- if( strcmp( view, "E" ) == 0 || strcmp( view, "EDIT" ) == 0 ||
- strcmp( view, "-E" ) == 0 || strcmp( view, "-EDIT" ) == 0 ||
- strcmp( view, "N" ) == 0 || strcmp( view, "NOEDIT" ) == 0 ||
- strcmp( view, "-N" ) == 0 || strcmp( view, "-NOEDIT" ) == 0 ) {
- if( strcmp( view, "E" ) == 0 || strcmp( view, "EDIT" ) == 0 ||
- strcmp( view, "-E" ) == 0 || strcmp( view, "-EDIT" ) == 0 )
- edit_mode = 1;
- else
- edit_mode = 0;
- kc_value.help_edit = edit_mode ? "-EDIT" : "-NOEDIT";
- } else if( strcmp( view, "K" ) == 0 || strcmp( view, "KEYWORD" ) == 0 ||
- strcmp( view, "-K" ) == 0 || strcmp( view, "-KEYWORD" ) == 0 ) {
- key_mode = 1;
- } else {
- keyw_expr = mstr2cat( keyw_expr, " ", view);
- }
-
- if ( keyw_expr == NULL || km_strempty( keyw_expr ) )
- return 0;
-
- } /* end ... else if( npar > 1 ) */
-
- interactive_find( keyw_expr, key_mode );
-
- return 0;
-}
-
-
-/*
- * action routine for /KUIP/USAGE
- */
-int kxusage()
-{
- char *path = ku_getc();
- char *line;
- int status;
-
- line = str3dup( "/KUIP/MANUAL ", path, " ! 'USAGE'" );
- status = ku_exel( line );
- free( line );
- printf( "\n" );
-
- return status;
-}
-
-
-/*
- * print first sentence of guidance
- */
-static char *get_guidance( char **guidance,
- int nguidance )
-{
- char *buf = strdup( "" );
-
- if( guidance != NULL ) {
- char *guid = strdup( guidance[0] );
- int len = strlen( guid );
- int n = 1;
-
- /* concatenate following lines until '.' at end or next paragraph */
- while( guid[len-1] != '.' && n < nguidance
- && guidance[n][0] != '\0' && guidance[n][0] != ' ' ) {
- int lenn = strlen( guidance[n] ) + 1;
- guid = realloc( guid, len + lenn + 1 );
- guid[len] = ' ';
- strcpy( &guid[len+1], guidance[n] );
- len += lenn;
- n++;
- }
- buf = fmt_paragraph( buf, guid, 20, DOCSYS_HELP );
- free( guid );
- }
- else
- buf = mstrcat( buf, "\n" );
-
- return buf;
-}
-
-static
-void print_guidance( char **guidance,
- int nguidance )
-{
- if( guidance != NULL ) {
- char *buf = get_guidance( guidance, nguidance );
-
- fputs( buf, stdout );
- free( buf );
- }
- else
- printf( "\n" );
-}
-
-
-/*
- * called for style AL and AN
- */
-void menu_style()
-{
- interactive_help( &real_root );
- ku_exel( "/KUIP/SET_SHOW/STYLE 'C'" );
-}
-
-/*
- * interactive traversal of the help menus
- * specific code for the Motif interface
- */
-static
-void interactive_help_motif( KmMenu *top_menu )
-{
- KmMenu *menu;
- KmCommand *cmd;
- int nmenus;
- int ncmds = 0;
-
- char **list_name = (char **) malloc ( sizeof (char *) );
- char **list_guidance = (char **) malloc ( sizeof (char *) );
-
- for( cmd = top_menu->cmds; cmd != NULL; cmd = cmd->next ) {
- list_name = (char **) realloc( (char*)list_name,
- (ncmds+1) * sizeof (char *) );
- list_guidance = (char **) realloc( (char*)list_guidance,
- (ncmds+1) * sizeof (char *) );
- list_name[ncmds] = strdup( cmd->name );
- list_guidance[ncmds++] = get_guidance(
- cmd->guidance, cmd->nguidance );
- }
- nmenus = ncmds;
- for( menu = top_menu->down; menu != NULL; menu = menu->next ) {
- list_name = (char **) realloc( (char*)list_name,
- (nmenus+1) * sizeof (char *) );
- list_guidance = (char **) realloc( (char*)list_guidance,
- (nmenus+1) * sizeof (char *) );
- list_name[nmenus] = strdup( menu->name );
- list_guidance[nmenus++] = get_guidance(
- menu->guidance, menu->nguidance );
-
- }
- /* display list of possible commands */
- list_name = (char **) realloc( (char*)list_name,
- (nmenus+1) * sizeof (char *) );
- list_guidance = (char **) realloc( (char*)list_guidance,
- (nmenus+1) * sizeof (char *) );
- list_name[nmenus] = NULL;
- list_guidance[nmenus] = NULL;
- if (kjmpaddr.disp_list_C != NULL) {
- static char *listFrom;
- ListData data;
-
- listFrom = strdup ( top_menu->path);
- data.listLabel = strdup ("From ");
- data.listLabel = mstr2cat (data.listLabel, listFrom, "/...");
- data.label = strdup("Select Menu");
- data.help = strdup("You did not specify a command.\n\
-Select a menu in the List");
- data.OKcallback_data = listFrom;
- if (kjmpaddr.callb_kmenu != NULL)
- data.OKcallback = (*kjmpaddr.callb_kmenu);
-
- if (*kjmpaddr.disp_list_C != NULL)
- (*kjmpaddr.disp_list_C)( list_name, list_guidance, data);
- }
-}
-
-
-/*
- * interactive traversal of the menus and commands tree to check keyword
- * specific code for the Motif interface
- */
-static
-void interactive_find( char *expr, int keym )
-{
- KmMenu *menu;
- char *p, *kval;
- int i, j, k;
-
- KmMenu **menu_list = root_menu_list("");
- int nkey = 0, nval = 0, opt = 0;
- int ncommand = 0, ncmd = 0;
-
- char **keyw = (char **) malloc ( sizeof (char *) );
-
- flis_path = (char **) malloc ( sizeof (char *) );
- flis_name = (char **) malloc ( sizeof (char *) );
- flis_cmd = (char **) malloc ( sizeof (char *) );
- flis_guidance = (char **) malloc ( sizeof (char *) );
- flis_flag = (int *) malloc ( sizeof (int) );
- fprl_flag = (int *) malloc ( sizeof (int) );
-
- /* First case : find without any keyword */
- if ( expr == NULL || km_strempty( expr ) ) {
-
- KmMenu *top_menu = &real_root;
- for( menu = top_menu->down; menu != NULL; menu = menu->next ) {
- /* Top level menu (``HELP'') */
- realloc_find ( nval );
- flis_name[nval] = strdup( menu->name );
- flis_path[nval] = strdup( menu->path );
-/* printf ("*** Top menu : %s\n", flis_name[nval]); */
- flis_flag[nval] = 3;
- fprl_flag[nval] = 0;
- flis_guidance[nval++] = get_guidance(
- menu->guidance, menu->nguidance );
- }
-
- } else { /* list of keywords is not empty ... (nkey >= 1) */
- char *sav = strdup (expr);
-
- /* Decode expr and process each keyword independantly */
- while( (p = strstr( sav, " " )) != NULL) {
- keyw = (char **) realloc( (char*)keyw, (nkey+1) * sizeof (char *) );
- *p = '\0';
- if ( !km_strempty( sav ) ) keyw[nkey++] = strdup( sav );
- strcpy ( sav, p + 1 );
- }
- keyw = (char **) realloc( (char*)keyw, (nkey+1) * sizeof (char *) );
- if ( !km_strempty( sav ) ) keyw[nkey++] = strdup( sav );
- free (sav);
-
- /* Look first for possible menus & commands corresponding to that keyword */
- for (j = 0; j < nkey; j++) {
- KmMenu *menu0= NULL;
- KmMenu **menul;
- KmCommand **cmd_list;
- KmCommand *cmd0, *cmd;
- char *path;
- short take_it;
- int l;
-
- path = str0dup(keyw[j]);
- strupper (path);
-
- /* Look for valid commands */
- cmd0 = search_command( path, &cmd_list );
-
- if( cmd_list != NULL ) {
- /* this is a valid command: check other keywords if any in the list */
- int nc;
-
- for (nc = 0; cmd_list[nc] != NULL; nc++) {
- /* Loop on all commands from cmd_list */
-
- take_it = 0;
- cmd = cmd_list[nc];
-
- if (nkey == 1) {
- take_it = 1;
- } else { /* nkey > 1 --> check if other keywords are in that cmd */
- for (i = 0; i < cmd->nkeyword; i++) {
- char *kval = str0dup(cmd->keyword[i]);
- strupper (kval);
- for (k = 0; k < nkey; k++) {
- char *val = str0dup(keyw[k]);
- strupper (val);
- if ( strcmp(val, kval) == 0 ) {
- take_it = 1;
- free (val);
- break;
- } else
- take_it = 0;
- free (val);
- }
- free (kval);
- if (!take_it) break;
- } /* end ... for (i = 0; i < cmd->nkeyword; i++) */
- } /* end ... else (nkey > 1) */
- if (take_it) {
- /* Real command (HELP for a valid command name) */
- realloc_find ( nval );
- flis_name[nval] = strdup( cmd->path );
-/* printf ("*** Real command : %s\n", flis_name[nval]); */
- flis_cmd[nval] = strdup( cmd->name );
- flis_flag[nval] = 0;
- fprl_flag[nval] = 1;
- ncmd = nval;
- /* For "Help_item" do not increment the command counter */
- if( cmd->action_F != NULL || cmd->action_C != NULL )
- ncommand++;
- else
- flis_flag[nval] = -1;
- flis_guidance[nval++] = get_guidance(
- cmd->guidance, cmd->nguidance );
- }
-
- } /* end ... for (nc = 0; cmd_list[nc] != NULL; nc++) */
- } /* end ... if( cmd_list != NULL ) */
-
- /* Look for valid sub-menus */
-
- menul = root_menu_list( path );
- for (l = 0; menul != NULL && (menu0 = menul[l]) != NULL; l++) {
-
- if (menu0->nguidance > 0) {
- /* Help for the menu is available */
-
- take_it = 0;
- if (nkey == 1) {
- /* only one keyword : take it (do not check for others) */
- take_it = 1;
- } else { /* nkey > 1 : check if other keywords are OK */
- for (i = j+1; i < nkey; i++) {
- char *kval = str0dup(keyw[i]);
-
- strupper (kval);
- /* if keyword is part of menu path take this cmd */
- if ( strstr(menu0->path, kval) != NULL) {
- take_it = 1;
- } else {
- /* Check list of keywords for that menu */
- for (k = 0; k < menu0->nkeyword; k++) {
- char *val = str0dup(menu0->keyword[k]);
- strupper (val);
- if ( strcmp(val, kval) == 0 ) {
- take_it = 1;
- free (val);
- break;
- } else
- take_it = 0;
- free (val);
- } /* end ... for (k = 0; k < menu0->nkeyword; k++) */
- } /* end ... else ... if ( strstr(menu0->path, kval) ... */
- } /* end ... for (i = j+1; i < nkey; i++) */
- } /* end ... else ... if (nkey == 1) */
-
- if (take_it) {
- /* Menu-root (help on a menu or sub-menu) */
- realloc_find ( nval );
- flis_name[nval] = strdup( menu0->path );
-/* printf ("*** Menu0 : %s\n", flis_name[nval]); */
- flis_flag[nval] = 2;
- fprl_flag[nval] = 0;
- flis_path[nval] = strdup( menu0->name );
- flis_guidance[nval++] = get_guidance(
- menu0->guidance, menu0->nguidance );
- }
- } /* end ... if (menu0->nguidance > 0) */
-
- /* Loop on menu commands */
- for( cmd = menu0->cmds; cmd != NULL; cmd = cmd->next ) {
- /* all these are valid commands: check other keywords */
-
- take_it = 0;
- if (nkey == 1) {
- /* only one keyword : take it (do not check for others) */
- take_it = 1;
- } else { /* nkey > 1 : check if other keywords are OK */
- for (i = j+1; i < nkey; i++) {
- char *kval = str0dup(keyw[i]);
-
- strupper (kval);
- /* if keyword is part of command path take this cmd */
- if ( strstr(cmd->path, kval) != NULL) {
- take_it = 1;
- } else {
- /* Check list of keywords for that command */
- for (k = 0; k < cmd->nkeyword; k++) {
- char *val = str0dup(cmd->keyword[k]);
- strupper (val);
- if ( strcmp(val, kval) == 0 ) {
- take_it = 1;
- free (val);
- break;
- } else
- take_it = 0;
- free (val);
- } /* end ... for (k = 0; k < cmd->nkeyword; k++) */
- } /* end ... else ( strstr(cmd->path, kval) != NULL) */
- } /* end ... else (nkey > 1) */
- } /* end ... for (i = j+1; i < nkey; i++) */
-
- if (take_it) {
- /* Menu-command (help on all commands from menu-root) */
- realloc_find ( nval );
- flis_name[nval] = strdup( cmd->path );
- flis_path[nval] = strdup( menu0->path );
- flis_cmd[nval] = strdup( cmd->name );
-/* printf ("*** Menu : %s\n", flis_name[nval]); */
- flis_flag[nval] = 1;
- fprl_flag[nval] = 1;
- flis_guidance[nval++] = get_guidance(
- cmd->guidance, cmd->nguidance );
- }
-
- } /* end ... for( cmd = menu0->cmds; cmd != NULL; ... */
-
- /* Loop now an all submenus associated to that menu ... */
- for( menu = menu0->down; menu != NULL; menu = menu->next ) {
- /* all these are valid submenus: check other keywords */
-
- take_it = 0;
- if (nkey == 1) {
- /* only one keyword : take it (do not check for others) */
- take_it = 1;
- } else { /* nkey > 1 : check if other keywords are OK */
- for (i = j+1; i < nkey; i++) {
- char *kval = str0dup(keyw[i]);
-
- strupper (kval);
- /* if keyword is part of menu path take this cmd */
- if ( strstr(menu->path, kval) != NULL) {
- take_it = 1;
- } else {
- /* Check list of keywords for that menu */
- for (k = 0; k < menu->nkeyword; k++) {
- char *val = str0dup(menu->keyword[k]);
- strupper (val);
- if ( strcmp(val, kval) == 0 ) {
- take_it = 1;
- free (val);
- break;
- } else
- take_it = 0;
- free (val);
- } /* end ... for (k = 0; k < menu->nkeyword; k++) */
- } /* end ... else ( strstr(menu->path, kval) != NULL) */
- } /* end ... for (i = j+1; i < nkey; i++) */
- } /* end ... else (nkey > 1) */
-
- if (take_it) {
- /* Sub-menu (help on all sub-menus from menu-root) */
- realloc_find ( nval );
- flis_name[nval] = strdup( menu->path );
- flis_path[nval] = strdup( menu0->path );
- flis_cmd[nval] = strdup( menu->name );
-/* printf ("*** Sub-Menu : %s\n", flis_name[nval]); */
- flis_flag[nval] = 1;
- fprl_flag[nval] = 0;
- flis_guidance[nval++] = get_guidance(
- menu->guidance, menu->nguidance );
- }
-
- } /* end ... for( menu = menu0->down; menu != NULL; ... */
-
- } /* end ... for (l = 0; (menu0 = menul[l]) != NULL; l++) */
- free( menul );
-
- free (path);
- } /* end ... for (j = 0; j < nkey; j++) */
-
- /* Look now explicitely for possible list of keywords */
- for (i = 0; (menu = menu_list[i]) != NULL; i++) {
- KmCommand *cmd;
- short take_it;
- int nk;
-
- if (menu->nkeyword > 0) {
-
- take_it = 0;
- for (j = 0; j < nkey; j++) {
- kval = str0dup(keyw[j]);
- strupper (kval);
- for (nk = 0; nk < menu->nkeyword; nk++) {
- char *val = str0dup(menu->keyword[nk]);
- strupper (val);
- if ( strcmp(val, kval) == 0 ) {
- take_it = 1;
- free (val);
- break;
- } else
- take_it = 0;
- free (val);
- }
- free (kval );
- if (!take_it) break;
- }
-
- if (take_it) {
- /* Keyword attached to a complete menu tree */
- realloc_find ( nval );
- flis_name[nval] = strdup( menu->path );
-/* printf ("*** Keyword for menu : %s\n", flis_name[nval]); */
- flis_flag[nval] = 11;
- fprl_flag[nval] = 1;
- flis_path[nval] = strdup( menu->name );
- flis_guidance[nval++] = get_guidance(
- menu->guidance, menu->nguidance );
- }
-
- } /* end ... if (menu->nkeyword > 0) */
-
- for (cmd = menu->cmds; cmd != NULL; cmd = cmd->next) {
-
- if (cmd->nkeyword > 0) {
-
- take_it = 0;
- for (j = 0; j < nkey; j++) {
- kval = str0dup(keyw[j]);
- strupper (kval);
- for (nk = 0; nk < cmd->nkeyword; nk++) {
- char *val = str0dup(cmd->keyword[nk]);
- strupper (val);
- if ( strcmp(val, kval) == 0 ) {
- take_it = 1;
- free (val);
- break;
- } else
- take_it = 0;
- free (val);
- }
- free (kval );
- if (!take_it) break;
- }
-
- if (take_it) {
- /* Keyword attached to specific command */
- realloc_find ( nval );
- flis_name[nval] = strdup( cmd->path );
-/* printf ("*** Keyword for command : %s\n", flis_name[nval]); */
- flis_flag[nval] = 10;
- fprl_flag[nval] = 1;
- flis_guidance[nval++] = get_guidance(
- cmd->guidance, cmd->nguidance );
- }
-
- } /* end ... if (cmd->nkeyword > 0) */
-
- } /* end ... for (cmd = menu->cmds; cmd != NULL; cmd = cmd->next) */
-
- } /* end ... for (i = 0; (menu = menu_list[i]) != NULL; i++) */
-
- } /* end ... else (list of keywords is not empty ...) */
-
- realloc_find ( nval );
- flis_name[nval] = NULL;
- flis_path[nval] = NULL;
- flis_cmd[nval] = NULL;
- flis_guidance[nval] = NULL;
-
-
- /* display list of possible commands */
- switch (nval) {
-
- case 0: /* No command associated to that keyword(s) */
- if (!opt || nkey > 0)
- printf ("*** Cannot find any command associated to keyword(s): %s\n",
- expr);
- break;
-
- case 1: /* Only one command associated to that keyword(s) */
- /* Execute "command help" directly */
- if (flis_flag[0] == 0)
- printf ("\nCommand \"%s\" :\n", flis_name[0]);
- else if (flis_flag[0] == 10 || flis_flag[0] == 11)
- printf ("\nKeyword(s) \"%s\" found in commands: %s\n\n",
- expr, flis_name[0]);
- else if (flis_flag[0] >= 1)
- printf ("\nMenu \"%s\" :\n", flis_path[0]);
-
- print_help (flis_name[0]);
- break;
-
- default: /* There is a list of commands associated to that keyword(s) */
-
- if (!keym && ncommand == 1) {
- /* Option -KEYWORD is not explicitely set and */
- /* there is only 1 "true command" associated to that keyword */
- int i;
- print_help (flis_name[ncmd]);
- printf ("See also:\n ");
- for (i = 0; i < nval; i++) {
- if (i == ncmd) continue;
- printf (flis_name[i]);
- if (i < nval-1)
- printf (", ");
- else
- printf ("\n");
- }
- } else { /* ncommand <> 1 (0 or more than 1 ) */
-
- if( kc_flags.in_motif && kjmpaddr.disp_list_C != NULL) {
- /* Motif interface */
- ListData data;
-
- if ( expr == NULL || km_strempty( expr ) ) {
- data.listLabel = strdup ( "List of all menus ");
- data.help = strdup("This is the list of commands\n\
-associated to the keyword(s)\n\n ");
- } else {
- data.listLabel = str2dup ( "Find keyword ", expr);
- data.help = str2dup("This is the list of commands\n\
-associated to the keyword(s)\n\n ", expr);
- }
- data.label = strdup("Select Command");
- data.OKcallback_data = NULL;
- if (kjmpaddr.callb_kmenu != NULL)
- data.OKcallback = (*kjmpaddr.callb_kmenu);
-
- if (*kjmpaddr.disp_list_C != NULL)
- (*kjmpaddr.disp_list_C)( flis_name, flis_guidance, data);
-
- } else if (!kc_flags.in_motif) {
- /* Command line interface */
- char menu_prmpt[80];
- static char *listFrom;
- char *line;
- int nl;
-
- if ( expr == NULL || km_strempty( expr ) ) {
-
- printf ("\nFrom /...\n\n");
- listFrom = strdup("/...");
- for (i=0; i<nval; i++) {
- char *flag;
-
- if( fprl_flag[i] == 0)
- flag = " ";
- else if( fprl_flag[i] == 1)
- flag = " * ";
- printf( "%s:%s%-12s ", help_label( i+1 ), flag, flis_name[i]);
- if( strlen( flis_name[i] ) > 12 )
- printf( "\n%20s", "" );
- fputs( flis_guidance[i], stdout );
- }
-
- } else {
-
- for (i=0; i<nval; ) {
- if (flis_flag[i] == 2) { /* top_menu : print help */
- printf( "\nMenu %s \n\n", flis_name[i] );
- print_help_line ( i+1 , flis_name[i], flis_guidance[i],
- fprl_flag[i] );
- i++;
- } else if (flis_flag[i] == 1) {
- printf( "\nFrom %s/...\n\n", flis_path[i] );
- listFrom = strdup(flis_path[i]);
- while (flis_flag[i] == 1) {
- if (i >= nval) break;
- print_help_line ( i+1, flis_cmd[i], flis_guidance[i],
- fprl_flag[i] );
- i++;
- } /* end ... while (flis_flag[i] == 1) */
- } else if (flis_flag[i] == 10 || flis_flag[i] == 11) {
- printf ("\nKeyword \"%s\" found in commands:\n\n", expr);
- while (flis_flag[i] == 10 || flis_flag[i] == 11) {
- if (i >= nval) break;
- print_help_line ( i+1, flis_name[i], flis_guidance[i],
- fprl_flag[i] );
- i++;
- } /* end ... while (flis_flag[i] == 10) ... */
- } else {
- int fbr = 0;
- if (flis_flag[i] == 0) { /* real command */
- if ( strstr (expr, "/" ) != NULL )
- /* full branch of commands (from a sub-menu) */
- fbr = 1;
- printf ("\nList of command(s) for %s ...\n\n", expr);
- } else if (flis_flag[i] == -1) /* "help_item" */
- printf ("\nGeneral HELP information \n\n");
- while (flis_flag[i] == 0 || flis_flag[i] == -1) {
- if (i >= nval) break;
- if (fbr)
- print_help_line ( i+1,flis_cmd[i],flis_guidance[i],
- fprl_flag[i] );
- else
- print_help_line ( i+1,flis_name[i],flis_guidance[i],
- fprl_flag[i] );
- i++;
- } /* end ... while (flis_flag[i] == 0) */
- }
- } /* end ... for (i=0; i<nval; ) */
- } /* end ... else ... if ( expr == NULL || km_strempty( expr ) ) */
-
- if (nkey > 0) {
- printf( "______\n%s: %-12s ", help_label( 0 ), "");
- fputs( "Top level menu", stdout );
- fflush( stdout ); /* or the line is delayed on linux?! */
- }
-
- line = NULL;
- while (line == NULL || line[0] == '\0' ) {
- sprintf( menu_prmpt,
- "\nEnter a number ('0'=Top, '\\'=one level back, 'Q'=command mode): ");
- line = input_line( menu_prmpt, 0 );
- }
- if ( strcasecmp( line, "\\" ) == 0 ) {
- /* one level back --> cut last "/..." */
- char *p;
- char cmd[512];
- p = strrstr( listFrom, "/" );
- if (p != NULL) {
- *p = '\0';
- sprintf (cmd, "/KUIP/HELP %s", listFrom);
- realloc_find(-1);
- ku_exel (cmd);
- } else {
- realloc_find(-1);
- ku_exel ("/KUIP/HELP");
- }
-
- } else if ( strcasecmp( line, "Q" ) != 0 ) {
- nl = atoi( line );
- if (nl > 0) {
- char cmd[512];
-
- if (flis_flag[nl-1] == 2) { /* Menu */
- KmMenu *menu = find_submenu( flis_path[nl-1] );
- if( menu != NULL ) {
- char *text = fmt_menu_help( menu, DOCSYS_HELP );
- fputs( text, stdout );
- free( text );
- }
- } else {
- sprintf (cmd, "/KUIP/HELP %s", flis_name[nl-1]);
- realloc_find(-1);
- ku_exel (cmd);
- }
- } else {
- realloc_find(-1);
- ku_exel ("/KUIP/HELP");
- }
- }
-
- } /* end ... if( kc_flags.in_motif && kjmpaddr.disp_list_C != NULL) */
-
- } /* end ... else ... ncommand <> 1 (0 or more than 1 ) */
- break;
-
- } /* end ... switch (nval) */
-
- free (keyw);
- realloc_find ( -1 );
-}
-
-
-static
-void realloc_find( int nval )
-{
- if (nval < 0 ) {
- free (flis_path); flis_path = NULL;
- free (flis_name); flis_name = NULL;
- free (flis_cmd); flis_cmd = NULL;
- free (flis_guidance); flis_guidance = NULL;
- free (flis_flag); flis_flag = NULL;
- free (fprl_flag); fprl_flag = NULL;
- } else {
- flis_path = (char **) realloc( (char*)flis_path,
- (nval+1) * sizeof (char *) );
- flis_name = (char **) realloc( (char*)flis_name,
- (nval+1) * sizeof (char *) );
- flis_cmd = (char **) realloc( (char*)flis_cmd,
- (nval+1) * sizeof (char *) );
- flis_guidance = (char **) realloc( (char*)flis_guidance,
- (nval+1) * sizeof (char *) );
- flis_flag = (int *) realloc( flis_flag,
- (nval+1) * sizeof (int) );
- fprl_flag = (int *) realloc( fprl_flag,
- (nval+1) * sizeof (int) );
- }
-}
-
-static
-void print_help( char *command )
-{
- int status;
- char cmd[512];
-
- if( edit_mode )
- sprintf (cmd, "/KUIP/MANUAL %s \'%s\'", command, kc_flags.help_file);
- else
- sprintf (cmd, "/KUIP/MANUAL %s", command);
-
- status = ku_exel( cmd );
-
- if( status == 0 && edit_mode ) {
- ku_pad( kc_flags.help_file, 1 );
- }
-}
-
-static
-void print_help_line( int nl, char *command, char *message, int fl )
-{
-
- char *flag;
-
- if( fl == 0)
- flag = " ";
- else if( fl == 1)
- flag = " * ";
-
- printf( "%s:%s%-12s ", help_label( nl ), flag, command);
- if( strlen( command ) > 12 )
- printf( "\n%20s", "" );
- fputs( message, stdout );
-}
-
-/*
- * interactive traversal of the help menus
- */
-static
-void interactive_help( KmMenu *top_menu )
-{
- loop:
- while( 1 ) {
- char *text = fmt_menu_help( top_menu, DOCSYS_HELP );
-
- KmMenu *menu;
- KmCommand *cmd;
- char menu_prmpt[80];
- int nmenus;
- int ncmds = 0;
-
- fputs( text, stdout );
- free( text );
-
- printf( "\nFrom %s/...\n\n", top_menu->path );
- for( cmd = top_menu->cmds; cmd != NULL; cmd = cmd->next ) {
- char *flag;
- if( cmd->action_F == NULL && cmd->action_C == NULL )
- flag = " ";
- else if( cmd->hidden )
- flag = "(*)";
- else
- flag = " * ";
- printf( "%s:%s%-12s ", help_label( ++ncmds ), flag, cmd->name );
- if( strlen( cmd->name ) > 12 )
- printf( "\n%20s", "" );
- print_guidance( cmd->guidance, cmd->nguidance );
- }
-
- nmenus = ncmds;
- for( menu = top_menu->down; menu != NULL; menu = menu->next ) {
- printf( "%s: %-12s ", help_label( ++nmenus ), menu->name );
- if( strlen( menu->name ) > 12 )
- printf( "\n%20s", "" );
- print_guidance( menu->guidance, menu->nguidance );
- }
-
- sprintf( menu_prmpt, "\nEnter a %s (%s'Q'=command mode): ",
- (kc_flags.style & KmSTYLE_xL) ? "letter" : "number",
- (top_menu->level > 0) ? "'\\'=one level back, " : "" );
-
- while( 1 ) {
- char *line = input_line( menu_prmpt, 0 );
- if( line == NULL )
- return;
- if( strcasecmp( line, "Q" ) == 0 )
- return;
- if( strcmp( line, "\\" ) == 0 ) {
- if( top_menu->level > 0 ) {
- char *up_path = strdup( top_menu->path );
- char *last_slash = strrchr( up_path, '/' );
- *last_slash = '\0';
- if( up_path[0] == '\0' )
- top_menu = &real_root;
- else {
- KmMenu **menu_list = root_menu_list( up_path );
- top_menu = menu_list[0];
- free( menu_list );
- }
- free( up_path );
- break;
- }
- }
- else {
- int n = help_index( line );
- if( n > 0 ) {
- if( n <= ncmds ) {
- char cmd_prmpt[80];
- int hidden;
- for( cmd = top_menu->cmds; n > 1; n-- )
- cmd = cmd->next;
-
- text = fmt_cmd_help( cmd, DOCSYS_HELP );
- fputs( text, stdout );
- free( text );
-
- hidden = cmd->hidden
- || (cmd->action_F == NULL && cmd->action_C == NULL);
- sprintf( cmd_prmpt, "<CR>=continue, 'Q'=command mode%s: ",
- hidden ? "" : ", 'X'=execute" );
-
- while( 1 ) {
-
- if( (kc_flags.style & KmSTYLE_A) != 0 ) {
- if( hidden )
- goto loop;
- line = "X";
- }
- else {
- line = input_line( cmd_prmpt, 0 );
- if( line == NULL )
- return;
- if( strcasecmp( line, "Q" ) == 0 )
- return;
- if( line[0] == '\0' )
- goto loop;
- }
-
- if( !hidden && strcasecmp( line, "X" ) == 0 ) {
- char arg_prmpt[80];
- printf( "Add parameters or just <CR> to the command line\n" );
- printf( "('#'=cancel execution, '?'=help) :\n\n" );
- sprintf( arg_prmpt, "%s ", cmd->path );
- while( 1 ) {
- line = input_line( arg_prmpt, 0 );
- if( line == NULL )
- return;
- if( strcmp( line, "#" ) == 0 )
- goto loop;
- if( strcmp( line, "?" ) != 0 ) {
- char *cmd_line = str3dup( cmd->path, " ", line );
- exec_cmd_string( cmd_line, 1, NULL );
- free( cmd_line );
- goto loop;
- }
- text = fmt_cmd_help( cmd, DOCSYS_HELP );
- fputs( text, stdout );
- free( text );
- }
- }
- }
- }
- else if( n <= nmenus ) {
- n -= ncmds;
- for( menu = top_menu->down; n > 1; n-- )
- menu = menu->next;
- top_menu = menu;
- break;
- }
- }
- }
- }
- }
-}
-
-
-/*
- * convert the help label into an index
- */
-static
-int help_index( const char *label )
-{
-
- if( kc_flags.style & KmSTYLE_xL ) {
- int uplabel;
- int n;
-
- while( *label == ' ' )
- label++;
-
- uplabel = *label;
- if( islower( uplabel ) )
- uplabel = toupper( uplabel );
-
- for( n = 0; n < nalpha_label; n++ ) {
- if( uplabel == alpha_label[n][1] )
- return n + 1;
- }
- return atoi( label ) + nalpha_label;
- }
- return atoi( label );
-}
-
-
-/*
- * return the label for the items in the help menu
- */
-static
-char *help_label( int n )
-{
- static char number_label[4];
-
- if( kc_flags.style & KmSTYLE_xL ) {
- if( n <= nalpha_label )
- return alpha_label[n-1];
- n -= nalpha_label;
- }
- sprintf( number_label, "%2d", n );
- return number_label;
-}
-
-
-/*
- * format the usage line for a command
- */
-static
-char *fmt_usage( KmCommand *cmd,
- int docsys )
-{
- char *buf = strdup( "\n" );
- char *pbuf = strdup( "" );
- char *path;
- char *p;
- int i;
-
- for( i = 0; i < cmd->total; i++ ) {
- KmParameter *par = cmd->par[i];
- if( i == cmd->mandatory )
- pbuf = mstrcat( pbuf, " [" );
- if( (par->flags & KmFLAG_HIDDEN) == 0 )
- pbuf = mstr2cat( pbuf, " ", par->name );
- }
- if( cmd->total > cmd->mandatory )
- pbuf = mstrcat( pbuf, " ]" );
-
- switch( docsys ) {
-
- case DOCSYS_LATEX:
- buf = mstrcat( buf, (cmd->nguidance <= 50) ? "\\DEFCMD{" : "\\DEFCBIG{" );
- for( p = cmd->path, i = 0; i < cmd->level; i++ ) {
- p = strchr( p, '/' );
- p++;
- buf = mstrccat( buf, *p, 1 );
- }
- buf = mstrcat( buf, "}{" );
- for( p = cmd->name, i = 0; i < 6 && *p != '\0'; p++ ) {
- if( *p != '_' ) {
- i++;
- buf = mstrccat( buf, *p, 1 );
- }
- }
- path = strdup( cmd->path + 1 );
- p = strrchr( path, '/' );
- *p = '\0';
- buf = mstr2cat( buf, "}{", fmt_filter( path, docsys ) );
- free( path );
- buf = mstr2cat( buf, "}{", fmt_filter( cmd->name, docsys ) );
- buf = mstr3cat( buf, "}{", fmt_filter( strlower( pbuf ), docsys ), "}\n" );
- break;
-
- default:
- if( cmd->action_F != NULL || cmd->action_C != NULL )
- buf = mstr4cat( buf, " * ", cmd->path + 1, pbuf, "\n" );
- }
- free( pbuf );
-
- return buf;
-}
-
-
-/*
- * format the help text for a command
- */
-char *fmt_cmd_help( KmCommand *cmd,
- int docsys )
-{
- char *buf = strdup( "" );
- char *p = fmt_usage( cmd, docsys );
-
- buf = mstrcat( buf, p );
- free( p );
- if( docsys == DOCSYS_USAGE )
- return buf;
-
- buf = mstrcat( buf, "\n" );
-
- if( cmd->total > 0 ) {
- int has_option = 0;
- int i;
-
- switch( docsys ) {
-
- case DOCSYS_LATEX:
- buf = mstrcat( buf, "\\BEGARG\n" );
- break;
- }
-
- for( i = 0; i < cmd->total; i++ ) {
- KmParameter *par = cmd->par[i];
- KmParInt *pint = par->ptype;
- KmParReal *preal = par->ptype;
- int lname = strlen( par->name );
- char *pbuf;
- char *type;
- char *quote = "'";
- char *lower = NULL;
- char *upper = NULL;
-
- if( (par->flags & KmFLAG_HIDDEN) != 0 )
- continue;
-
- switch( par->type ) {
- case KmTYPE_INT:
- type = "I";
- quote = "";
- lower = pint->range_lower;
- upper = pint->range_upper;
- break;
- case KmTYPE_REAL:
- type = "R";
- quote = "";
- lower = preal->range_lower;
- upper = preal->range_upper;
- break;
- case KmTYPE_OPTION:
- if( par->range_count > 0 )
- has_option = 1;
- /* FALLTHRU */
- default:
- type = "C";
- }
-
- pbuf = strndup( par->name, par->abbrev );
- if( par->abbrev != lname ) {
- pbuf = mstr2cat( pbuf, "*", par->name + par->abbrev );
- lname++;
- }
-
- switch( docsys ) {
-
- case DOCSYS_LATEX:
- buf = mstr2cat( buf, "\\DEFARG{", fmt_filter( pbuf, docsys ) );
- buf = mstr2cat( buf, "}{", type );
- buf = mstr3cat( buf, "}{", fmt_filter( par->prompt, docsys ), "}{" );
- break;
-
- default:
- buf = mstr2cat( buf, " ", pbuf );
- buf = mstrccat( buf, ' ', 11 - lname );
- buf = mstr4cat( buf, type, " '", par->prompt, "'" );
- }
-
- free( pbuf );
-
- if( par->dfault != NULL ) {
- if( (par->flags & KmFLAG_CONST) != 0 )
- buf = mstrcat( buf, " Const=" );
- else
- buf = mstrcat( buf, " D=" );
- if( docsys == DOCSYS_LATEX && strcmp( par->dfault, " " ) == 0 )
- buf = mstrcat( buf, "\\EMPTY{}" );
- else
- buf = mstr3cat( buf,
- quote, fmt_filter( par->dfault, docsys ), quote );
- }
-
- if( par->type != KmTYPE_OPTION && par->range_count != 0 ) {
- int n;
- buf = mstr3cat( buf, " R=", quote, par->range_value[0] );
- for( n = 1; n < par->range_count; n++ )
- buf = mstr2cat( buf, ",", par->range_value[n] );
- buf = mstrcat( buf, quote );
- }
- if( lower != NULL || upper != NULL ) {
- if( lower == NULL )
- lower = "";
- if( upper == NULL )
- upper = "";
- buf = mstr4cat( buf, " R=", lower, ":", upper );
- }
-
- if( (par->flags & KmFLAG_FORGET) != 0 )
- buf = mstrcat( buf, " Forget" );
-
- if( i + 1 == cmd->list_par )
- buf = mstrcat( buf, " Loop" );
-
- if( (par->flags & KmFLAG_MINUS) != 0 )
- buf = mstrcat( buf, " Minus" );
-
- if( (par->flags & KmFLAG_QUOTE) != 0 )
- buf = mstrcat( buf, " Quote" );
-
- if( (par->flags & KmFLAG_SEPARATE) != 0 )
- buf = mstrcat( buf, " Separate" );
-
- if( (par->flags & KmFLAG_VARARG) != 0 )
- buf = mstrcat( buf, " Vararg" );
-
- if( docsys == DOCSYS_LATEX )
- buf = mstrcat( buf, "}" );
- buf = mstrcat( buf, "\n" );
- }
-
- if( docsys == DOCSYS_LATEX )
- buf = mstrcat( buf, "\\ENDARG\n" );
-
- if( has_option ) {
- for( i = 0; i < cmd->total; i++ ) {
- KmParameter *par = cmd->par[i];
- if( par->type == KmTYPE_OPTION && par->range_count > 0 ) {
- KmParOption *ptype = par->ptype;
- int maxlen = mstrlen( par->range_value, par->range_count );
- int j;
-
- switch( docsys ) {
-
- case DOCSYS_LATEX:
- buf = mstr3cat( buf, "\\BEGOPT{",
- fmt_filter( par->name, docsys ), "}\n" );
- break;
-
- default:
- buf = mstr3cat( buf, "\n Possible ", par->name,
- " values are:\n\n" );
- }
-
- for( j = 0; j < par->range_count; j++ ) {
- char *val = par->range_value[j];
- char *vbuf;
-
- switch( docsys ) {
-
- case DOCSYS_LATEX:
- buf = mstrcat( buf, "\\DEFOPT{" );
- if( val[0] == '\0' || strcmp( val, " " ) == 0 )
- buf = mstrcat( buf, "\\EMPTY" );
- else
- buf = mstrcat( buf, fmt_filter( val, docsys ) );
- buf = mstrcat( buf, "}{" );
- if( ptype->text[j] != NULL )
- buf = fmt_paragraph( buf, ptype->text[j], 0, docsys );
- buf = mstrcat( buf, "}\n" );
- break;
-
- default:
- if( val[0] == '\0' || strcmp( val, " " ) == 0 )
- vbuf = strdup( " ' '" );
- else
- vbuf = str3dup( " ", val, " " );
- buf = mstrcat( buf, vbuf );
- buf = mstrccat( buf, ' ', maxlen + 6 - strlen( vbuf ) );
- free( vbuf );
- if( ptype->text[j] != NULL )
- buf = fmt_paragraph( buf, ptype->text[j],
- maxlen + 6, DOCSYS_HELP );
- else
- buf = mstrcat( buf, "\n" );
- }
- }
-
- switch( docsys ) {
-
- case DOCSYS_LATEX:
- buf = mstrcat( buf, "\\ENDOPT\n" );
- break;
- }
- }
- }
- }
- buf = mstrcat( buf, "\n" );
- }
-
- p = fmt_guidance( cmd->guidance, cmd->nguidance, docsys );
- buf = mstrcat( buf, p );
- free( p );
-
- if( cmd->user_help_C != NULL ) {
- /* user help routine has to return an allocated buffer */
- char **user_guidance = (*cmd->user_help_C)( cmd->name );
- int n = 0;
- while( user_guidance[n] != NULL )
- n++;
- p = fmt_guidance( user_guidance, n, docsys );
- while( n > 0 )
- free( user_guidance[--n] );
- free( (char*)user_guidance );
- buf = mstrcat( buf, p );
- free( p );
- }
- else if( cmd->user_help_F != NULL ) {
- /* Fortran OPEN the file and call user help routine */
- FILE *stream;
- char *fname = ku_fcase( kc_flags.uhlp_file );
- int luno = kc_flags.uhlp_luno;
-
- ku_open( luno, fname, "VERYNEW" );
- user_help_name = cmd->name; /* for KUHELP */
- (*cmd->user_help_F)();
- ku_close( luno );
-
- if( (stream = fopen( fname, "r" )) == NULL )
- perror( fname );
- else {
- char line[1024];
-
- if( docsys == DOCSYS_LATEX )
- buf = mstrcat( buf, "\\begin{verbatim}\n" );
-
- while( fgets( line, (sizeof line), stream ) != NULL )
- buf = mstrcat( buf, line );
-
- if( docsys == DOCSYS_LATEX )
- buf = mstrcat( buf, "\\end{verbatim}\n" );
-
- if( fclose( stream ) != 0 )
- perror( fname );
- if( remove( fname ) != 0 )
- perror( fname );
- }
- }
-
- switch( docsys ) {
-
- case DOCSYS_LATEX:
- buf = mstrcat( buf,
- (cmd->nguidance <= 50) ? "\\ENDCMD\n" : "\\ENDCBIG\n" );
- break;
- }
-
- return buf;
-}
-
-
-/*
- * format the guidance text
- */
-static
-char *fmt_guidance( char **guidance,
- int nguidance,
- int docsys )
-{
- char *buf = strdup( "" );
-
- if( guidance != NULL ) {
- char *para = strdup( "" );
- int indent = 3;
- int verbatim = 0;
- int i;
-
- for( i = 0; i < nguidance; i++ ) {
-
- if( guidance[i][0] == ' ' ) {
- /* verbatim output of indented lines */
-
- if( !verbatim ) {
- /* first verbatim line */
- verbatim = 1;
- if( para[0] != '\0' ) {
- buf = mstrccat( buf, ' ', indent );
- buf = fmt_paragraph( buf, para, indent, docsys );
- para[0] = '\0';
- }
-
- switch( docsys ) {
-
- case DOCSYS_LATEX:
- buf = mstrcat( buf, "\\begin{verbatim}\n" );
- break;
-
- default:
- if( i > 0 && guidance[i-1][0] != '\0' ) {
- /* verbatim not at beginning of paragraph */
- buf = mstrcat( buf, "\n" );
- }
- }
- }
- }
-
- else if( verbatim ) {
- /* leave verbatim mode */
- verbatim = 0;
-
- switch( docsys ) {
-
- case DOCSYS_LATEX:
- buf = mstrcat( buf, "\\end{verbatim}\n" );
- if( guidance[i][0] == '\0'
- && i+1 < nguidance && guidance[i+1][0] != ' ' ) {
- /* verbatim followed by a new paragraph which is not verbatim */
- buf = mstrcat( buf, "\\ENDVERB\n" );
- }
- break;
-
- default:
- buf = mstrcat( buf, "\n" );
- }
- }
-
- if( verbatim ) {
- buf = mstrccat( buf, ' ', indent );
- buf = fmt_paragraph( buf, guidance[i], indent, DOCSYS_HELP );
- }
- else if( guidance[i][0] == '\0' ) {
- if( para[0] != '\0' ) {
- buf = mstrccat( buf, ' ', indent );
- buf = fmt_paragraph( buf, para, indent, docsys );
- buf = mstrcat( buf, "\n" );
- para[0] = '\0';
- }
- }
- else {
- int len = strlen( guidance[i] );
- para = mstrcat( para, guidance[i] );
- if( guidance[i][len-1] == '.' || guidance[i][len-1] == ':' )
- para = mstrcat( para, " " );
- else
- para = mstrcat( para, " " );
- }
- }
-
- if( verbatim ) {
- switch( docsys ) {
-
- case DOCSYS_LATEX:
- buf = mstrcat( buf, "\\end{verbatim}\n" );
- break;
-
- default:
- buf = mstrcat( buf, "\n" );
- }
- }
- else if( para[0] != '\0' ) {
- buf = mstrccat( buf, ' ', indent );
- buf = fmt_paragraph( buf, para, indent, docsys );
- }
- free( para );
- buf = mstrcat( buf, "\n" );
- }
-
- return buf;
-}
-
-
-/*
- * format the help text for a menu
- */
-static
-char *fmt_menu_help( KmMenu *menu,
- int docsys )
-{
- char *buf = strdup( "" );
-
- if( menu->path[0] != '\0' ) {
- char *guid = fmt_guidance( menu->guidance, menu->nguidance, docsys );
-
- switch( docsys ) {
-
- case DOCSYS_LATEX:
- buf = mstrcat( buf, "\\DEFMENU{" );
- buf = mstricat( buf, menu->level - 1 );
- buf = mstr2cat( buf, "}{", fmt_filter( menu->name, docsys ) );
- buf = mstr2cat( buf, "}{", fmt_filter( menu->path + 1, docsys ) );
- buf = mstr3cat( buf, "}\n\\ifMENUtext\n", guid, "\n\\fi\n" );
- break;
-
- default:
- buf = mstr4cat( buf, "\n ", menu->path, "\n\n", guid );
- }
-
- free( guid );
-
- }
-
- return buf;
-}
-
-
-/*
- * break a paragraph into lines and append it to the buffer
- */
-static
-char *fmt_paragraph( char *buf,
- const char *para,
- int indent,
- int docsys )
-{
- char *p = fmt_filter( para, docsys );
- int len = strlen( p );
- int ncol = kc_window.term_width - indent - 1;
-
- switch( docsys ) {
-
- case DOCSYS_LATEX:
- buf = mstrcat( buf, "\\par\n" );
- break;
- }
-
- while( len > 0 ) {
- int n = len;
- if( n > ncol ) {
- n = ncol;
- while( n > 1 && p[n-1] != ' ' )
- n--;
- }
- buf = mstrncat( buf, p, n );
- buf = mstrcat( buf, "\n" );
- p += n;
- len -= n;
- while( *p == ' ' ) {
- p++;
- len--;
- }
- if( len > 0 )
- buf = mstrccat( buf, ' ', indent );
- }
-
- return buf;
-}
-
-
-/*
- * protect all special characters of text formatter
- */
-static
-char *fmt_filter( const char *line,
- int docsys )
-{
- static char *buf = NULL;
- int i;
-
- if( buf == NULL )
- buf = strdup( "" );
- else
- buf[0] = '\0';
-
- for( i = 0; line[i] != '\0'; i++ ) {
- char esc[16];
- esc[0] = line[i];
- esc[1] = '\0';
-
- switch( docsys ) {
-
- case DOCSYS_LATEX:
-
- switch( line[i] ) {
- case '\\':
- case '$':
- case '&':
- case '%':
- case '#':
- case '{':
- case '}':
- case '_':
- esc[0] = '\\';
- esc[1] = line[i];
- esc[2] = '\0';
- break;
-
- case '<':
- strcpy( esc, "\\BRA{}" );
- break;
-
- case '>':
- strcpy( esc, "\\KET{}" );
- break;
-
- case '|':
- strcpy( esc, "\\PIPE{}" );
- break;
-
- case '"':
- strcpy( esc, "\\DQUOTE{}" );
- break;
- }
- }
-
- buf = mstrcat( buf, esc );
- }
-
- return buf;
-}
-
-
-void F77_ENTRY_I(Kulun,lun )
-/* { */
- int base = *lun;
- if( base <= 0 )
- base = 11;
- kc_flags.vread_luno = base + 1;
- kc_flags.vwrite_luno = base + 2;
- kc_flags.appl_luno = base + 4;
- kc_flags.uhlp_luno = base + 4;
- Kilun( lun ); /* kludge */
-}
-
-
-void F77_ENTRY_IC(Kuhelp,lun,chpath)
-/* { */
- *lun = kc_flags.uhlp_luno;
- fstrset( chpath, len_chpath, user_help_name );
-}
-
-
-char **kscncmds( brobj_name, brcls_name, path, n )
- char *brobj_name;
- char *brcls_name;
- char *path;
- int n;
-{
- static char *obj_desc[4];
- static char ltext[128];
- static KmMenu *menu;
- static KmMenu *submenu;
- static KmCommand *cmd;
-
- obj_desc[0] = NULL; /* name */
- obj_desc[1] = NULL; /* class */
- obj_desc[2] = NULL; /* alias */
- obj_desc[3] = NULL; /* text */
-
- if( n == 0 ) {
- /* initialize to return first command */
- if( path[0] != '\0' ) {
- KmMenu **menu_list = find_menu_list( NULL, &real_root, path );
- menu = menu_list[0];
- free( menu_list );
- }
- else
- menu = &real_root;
- if( menu == NULL ) return obj_desc;
- submenu = menu->down;
- cmd = menu->cmds;
- }
-
- if( submenu != NULL ) {
- /* return next submenu */
- obj_desc[0] = submenu->name;
- obj_desc[1] = "Menu";
- obj_desc[2] = submenu->path;
- submenu = submenu->next;
- }
- else if( cmd != NULL ) {
- /* return next command */
- int len = 0;
- int i;
- ltext[0] = '\0';
- for( i = 0; i < cmd->mandatory; i++ ) {
- KmParameter *par = cmd->par[i];
- sprintf( <ext[len], " %s", par->name );
- len += strlen( <ext[len] );
- }
- if( cmd->total > cmd->mandatory ) {
- sprintf( <ext[len], " [" );
- len += strlen( <ext[len] );
- for( i = cmd->mandatory; i < cmd->total; i++ ) {
- KmParameter *par = cmd->par[i];
- sprintf( <ext[len], " %s", par->name );
- len += strlen( <ext[len] );
- }
- sprintf( <ext[len], " ]" );
- }
- obj_desc[0] = cmd->name;
- obj_desc[1] = cmd->hidden ? "InvCmd" : "Cmd";
- obj_desc[2] = cmd->path;
- obj_desc[3] = ltext;
- cmd = cmd->next;
- }
- return obj_desc;
-}
-
-
-/*
- *
- */
-static
-KmCommand *lookup_cmd( const char *cmd_name,
- const char *called_by )
-{
- KmCommand *cmd = curr_cmd;
-
- if( cmd != NULL && strcasecmp( cmd->name, cmd_name ) == 0 )
- return cmd;
-
- if( curr_menu != NULL ) {
- for( cmd = curr_menu->cmds; cmd != NULL; cmd = cmd->next ) {
- if( strcasecmp( cmd->name, cmd_name ) == 0 )
- return cmd;
- }
- }
-
- cmd = search_command( cmd_name, NULL );
- if( cmd == NULL )
- printf( " *** %s: invalid command '%s'\n", called_by, cmd_name );
-
- return cmd;
-}
-
-
-/*
- * set amount of words needed to store command definition
- */
-void F77_ENTRY_I(Kunwg,nwg )
-/* { */
- /* OBSOLETE */
-}
-
-
-/*
- * create a new command
- */
-void F77_ENTRY_C3(Kucmd,refpat,item,chopt)
-/* { */
- KmMenu **menu_list;
- char *opt = fstrdup( chopt, len_chopt );
-
- if( strcasecmp( opt, "C" ) == 0 ) {
- /* create a new menu or command */
- if( curr_menu->cmds == NULL ) {
- prev_cmd = NULL;
- curr_cmd = curr_menu->cmds = (KmCommand*)calloc( 1, sizeof(KmCommand) );
- }
- else {
- for( curr_cmd = curr_menu->cmds; curr_cmd->next != NULL; )
- curr_cmd = curr_cmd->next;
- prev_cmd = curr_cmd;
- curr_cmd = curr_cmd->next = (KmCommand*)calloc( 1, sizeof(KmCommand) );
- }
- curr_cmd->name = fstrdup( item, len_item );
- curr_cmd->path = str3dup( curr_menu->path, "/", curr_cmd->name );
- curr_cmd->level = curr_menu->level;
- }
-
- else if( strcasecmp( opt, "SW" ) == 0 ) {
- /* switch to menu */
- char *menu_name = fstrdup( refpat, len_refpat );
-
- if( curr_cmd != NULL && strcasecmp( menu_name, curr_cmd->name ) == 0 ) {
- /*
- * only now we know that KUCMD(' ',name,'C') should have created
- * a menu instead of a command
- */
- if( prev_cmd == NULL ) {
- curr_menu->cmds = NULL;
- }
- else {
- prev_cmd->next = NULL;
- }
- if( curr_menu->down == NULL ) {
- curr_menu = curr_menu->down = (KmMenu*)calloc( 1, sizeof(KmMenu) );
- }
- else {
- curr_menu = curr_menu->down;
- while( 1 ) {
- if( strcasecmp( curr_menu->name, curr_cmd->name ) == 0 ) {
- break;
- }
- else if( curr_menu->next != NULL ) {
- curr_menu = curr_menu->next;
- }
- else {
- curr_menu = curr_menu->next = (KmMenu*)calloc( 1, sizeof(KmMenu) );
- break;
- }
- }
- }
- curr_menu->path = curr_cmd->path;
- curr_menu->name = curr_cmd->name;
- curr_menu->level = curr_cmd->level + 1;
- if( curr_cmd->nguidance ) {
- curr_menu->nguidance = curr_cmd->nguidance;
- curr_menu->guidance = curr_cmd->guidance;
- }
- free( curr_cmd );
- curr_cmd = NULL;
- }
- else if( strcmp( menu_name, "/" ) == 0 ) {
- curr_menu = &real_root;
- }
- else if( strcmp( menu_name, ".." ) == 0
- || strcmp( menu_name, "\\" ) == 0 ) {
- char *path = strdup( curr_menu->path );
- char *slash = strrchr( path, '/' );
- *slash = '\0';
- if( slash == path )
- curr_menu = &real_root;
- else {
- menu_list = find_menu_list( NULL, &real_root, path );
- curr_menu = menu_list[0];
- free( menu_list );
- }
- free( path );
- }
- else if( strncmp( menu_name, "../", 3 ) == 0 || menu_name[0] == '\\' ) {
- char *path = strdup( curr_menu->path );
- char *slash = strrchr( path, '/' );
- if( menu_name[0] == '\\' )
- menu_name[0] = '/';
- else
- strcpy( menu_name, menu_name + 2 );
- *slash = '\0';
- path = realloc( path, strlen( path ) + strlen( menu_name ) + 1 );
- strcat( path, menu_name );
- menu_list = find_menu_list( NULL, &real_root, path );
- curr_menu = menu_list[0];
- free( menu_list );
- free( path );
- }
- else {
- menu_list = find_menu_list( NULL, curr_menu, menu_name );
- curr_menu = menu_list[0];
- free( menu_list );
- }
- free( menu_name );
- }
-
- else if( strcasecmp( opt, "D" ) == 0 ) {
- /* delete command */
- KmMenu *menu;
- KmCommand *cmd;
- char *menu_path = fstrdup( refpat, len_refpat );
- char *cmd_name = strrchr( menu_path, '/' );
- *cmd_name++ = '\0';
- menu_list = find_menu_list( NULL, &real_root, menu_path );
- menu = menu_list[0];
- free( menu_list );
- for( cmd = menu->cmds; cmd->next != NULL; cmd = cmd->next ) {
- if( strcasecmp( cmd->next->name, cmd_name ) == 0 ) {
- cmd->next = cmd->next->next;
- break;
- }
- }
- }
- else if( strcasecmp( opt, "E" ) == 0 ) {
- /* end definition */
- }
- else {
- printf( " *** KUCMD: invalid option '%s'\n", opt );
- }
- free( opt );
-}
-
-
-/*
- * store guidance text for command
- */
-void F77_ENTRY_CCIC(Kuguid,refpat,gguid,nlines,chopt)
-/* { */
- char *path = fstrdup( refpat, len_refpat );
- KmCommand *cmd = lookup_cmd( path, "KUGUID" );
-
- if( cmd != NULL ) {
- char *opt = fstrdup( chopt, len_chopt );
- if( strcasecmp( opt, "S" ) == 0 ) {
- /* set guidance */
- int i;
- cmd->nguidance = *nlines;
- cmd->guidance = (char**)malloc( *nlines * sizeof(char*) );
- for( i = 0; i < cmd->nguidance; i++ ) {
- cmd->guidance[i] = fstrdup( &gguid[len_gguid*i], len_gguid );
- if( strcmp( cmd->guidance[i], "." ) == 0 )
- cmd->guidance[i][0] = '\0';
- }
- }
- else if( strcasecmp( opt, "Q" ) == 0 ) {
- /* return the guidance text */
- int i;
- if( *nlines > cmd->nguidance ) {
- int n = ( *nlines - cmd->nguidance ) * len_gguid;
- memset( &gguid[len_gguid*cmd->nguidance], ' ', n );
- *nlines = cmd->nguidance;
- }
- for( i = 0; i < *nlines; i++ ) {
- fstrset( &gguid[len_gguid*i], len_gguid, cmd->guidance[i] );
- }
- *nlines = cmd->nguidance;
- }
- else {
- printf( " *** KUGUID: invalid option '%s'\n", opt );
- }
- free( opt );
- }
- free( path );
-}
-
-
-/*
- * store user help routine
- */
-void F77_ENTRY_CE(Kuach,refpat,actrou)
-/* { */
- char *path = fstrdup( refpat, len_refpat );
- KmCommand *cmd = lookup_cmd( path, "KUACH" );
-
- if( cmd != NULL )
- cmd->user_help_F = actrou;
-
- free( path );
-}
-
-
-/*
- * store action routine
- */
-void F77_ENTRY_CE(Kuact,refpat,actrou)
-/* { */
- char *path = fstrdup( refpat, len_refpat );
- KmCommand *cmd = lookup_cmd( path, "KUACT" );
-
- if( cmd != NULL )
- cmd->action_F = actrou;
-
- free( path );
-}
-
-
-/*
- * set amount of words needed to store parameter definition
- */
-void Kundpv( nwdef, nwlow, nwhig, npval, nwpv)
- INTEGER *nwdef, *nwlow, *nwhig, *npval, *nwpv;
-{
- /* OBSOLETE */
-}
-
-
-/*
- * store parameter definition
- */
-void F77_ENTRY_C5(Kupar,celpat,pname,prompt,type,chopt)
-/* { */
- char *path = fstrdup( celpat, len_celpat );
- KmCommand *cmd = lookup_cmd( path, "KUPAR" );
-
- if( cmd != NULL ) {
- char *opt = fstrdup( chopt, len_chopt );
- if( strcasecmp( opt, "S" ) == 0 ) {
- /* define a new parameter */
- KmParameter *par;
- int optional = 0;
- int i;
-
- cmd->total++;
-
- if( cmd->par == NULL )
- cmd->par = (KmParameter**)malloc( sizeof(KmParameter*) );
- else
- cmd->par = (KmParameter**)realloc( (char*)cmd->par,
- cmd->total * sizeof(KmParameter*) );
- par = cmd->par[cmd->total-1] =
- (KmParameter*)calloc( 1, sizeof(KmParameter) );
- par->name = fstrdup( pname, len_pname );
- par->abbrev = strlen( par->name );
- par->prompt = fstrdup( prompt, len_prompt );
-
- switch( type[0] ) {
- case 'I':
- par->type = KmTYPE_INT;
- par->ptype = (KmParInt*)calloc( 1, sizeof(KmParInt) );
- break;
- case 'R':
- par->type = KmTYPE_REAL;
- par->ptype = (KmParReal*)calloc( 1, sizeof(KmParReal) );
- break;
- case 'O':
- par->type = KmTYPE_OPTION;
- par->ptype = (KmParOption*)calloc( 1, sizeof(KmParOption) );
- break;
- default:
- par->type = KmTYPE_CHAR;
- }
-
- par->flags = 0;
- for( i = 1; i < len_type; i++ ) {
- switch( type[i] ) {
- case 'O':
- optional = 1;
- break;
- case 'C':
- par->flags |= KmFLAG_CONST;
- break;
- case 'F':
- par->flags |= KmFLAG_FORGET;
- break;
- case 'H':
- par->flags |= KmFLAG_HIDDEN;
- break;
- case 'M':
- par->flags |= KmFLAG_MINUS;
- break;
- case 'Q':
- par->flags |= KmFLAG_QUOTE;
- break;
- case 'S':
- par->flags |= KmFLAG_SEPARATE;
- break;
- case 'V':
- par->flags |= KmFLAG_VARARG;
- break;
- case ' ':
- /* ignore */
- break;
- default:
- printf( " *** KUPAR: invalid modifier '%c'\n", type[i] );
- }
- }
-
- if( !optional )
- cmd->mandatory++;
- }
- else {
- printf( " *** KUPAR: invalid option '%s'\n", opt );
- }
- free( opt );
- }
- free( path );
-}
-
-
-/*
- * set parameter values
- */
-void F77_ENTRY_CCIRCC(Kupval,celpat,pname,ival,rval,cval,chopt)
-/* { */
- char *path = fstrdup( celpat, len_celpat );
- KmCommand *cmd = lookup_cmd( path, "KUPVAL" );
-
- if( cmd != NULL ) {
- char *par_name = fstrdup( pname, len_pname );
- KmParameter *par = NULL;
- int i;
-
- for( i = 0; i < cmd->total; i++ ) {
- if( strcasecmp( cmd->par[i]->name, par_name ) == 0 ) {
- par = cmd->par[i];
- break;
- }
- }
- if( par == NULL ) {
- printf( " *** KUPVAL: command %s has no parameter named %s\n",
- cmd->path, par_name );
- }
- else {
- char *opt = fstrdup( chopt, len_chopt );
- int wrong = 0;
-
- if( opt[0] == '-' ) {
- wrong = 1;
- if( par->type == KmTYPE_OPTION ) {
- KmParOption *popt = par->ptype;
- int n;
- for( n = 0; n < par->range_count; n++ ) {
- if( strcasecmp( par->range_value[n], &opt[1] ) == 0 ) {
- popt->text[n] = fstrdup( cval, len_cval );
- wrong = 0;
- break;
- }
- }
- }
- }
- else if( strcasecmp( opt, "ABBREV" ) == 0 ) {
- par->abbrev = *ival;
- }
- else if( strcasecmp( opt, "FLAGS" ) == 0 ) {
- par->flags |= *ival;
- }
- else if( strcasecmp( opt, "LOOP" ) == 0 ) {
- cmd->list_par = i + 1;
- }
- else if( par->type == KmTYPE_INT || par->type == KmTYPE_REAL ) {
- KmParInt *pint = par->ptype;
- KmParReal *preal = par->ptype;
- char buf[32];
-
- if( par->type == KmTYPE_INT ) {
- int lval = *ival;
- sprintf( buf, "%d", lval );
- }
- else {
- double dval = *rval;
- strcpy( buf, strfromd( dval, 0 ) );
- }
-
- if( strcasecmp( opt, "D" ) == 0 ) {
- par->dfault = strdup( buf );
- }
- else if( strcasecmp( opt, "H" ) == 0 ) {
- if( par->type == KmTYPE_INT )
- pint->range_upper = strdup( buf );
- else
- preal->range_upper = strdup( buf );
- }
- else if( strcasecmp( opt, "L" ) == 0 ) {
- if( par->type == KmTYPE_INT )
- pint->range_lower = strdup( buf );
- else
- preal->range_lower = strdup( buf );
- }
- else if( strcasecmp( opt, "V" ) == 0 ) {
- if( par->range_count++ == 0 )
- par->range_value = (char**)malloc( sizeof(char*) );
- else
- par->range_value =
- (char**)realloc( (char*)par->range_value,
- par->range_count * sizeof(char*) );
- par->range_value[par->range_count-1] = strdup( buf );
- }
- else {
- wrong = 1;
- }
- }
- else if( par->type == KmTYPE_CHAR || par->type == KmTYPE_OPTION ) {
- char *sval = fstrdup( cval, len_cval );
- if( *sval == '\0' )
- sval = mstrcat( sval, " " );
- if( strcasecmp( opt, "D" ) == 0 ) {
- par->dfault = sval;
- }
- else if( strcasecmp( opt, "V" ) == 0 ) {
- char *p;
- for( p = strtok( sval, "," ); p != NULL; p = strtok( NULL, "," ) ) {
- if( par->range_count++ == 0 )
- par->range_value = (char**)malloc( sizeof(char*) );
- else
- par->range_value =
- (char**)realloc( (char*)par->range_value,
- par->range_count * sizeof(char*) );
- if( strcmp( p, " " ) == 0 )
- p = "";
- par->range_value[par->range_count-1] = p;
- }
- if( par->range_count > 0 ) {
- KmParOption *popt;
- if( par->type != KmTYPE_OPTION ) {
- par->type = KmTYPE_OPTION;
- par->ptype = (KmParOption*)calloc( 1, sizeof(KmParOption) );
- }
- popt = par->ptype;
- popt->text = (char**)calloc( par->range_count, sizeof(char*) );
- popt->mutex = (int*)calloc( par->range_count, sizeof(int) );
- popt->radio = (int*)calloc( par->range_count, sizeof(int) );
- }
- }
- else {
- wrong = 1;
- free( sval );
- }
- }
- else {
- if( strcasecmp( opt, "D" ) == 0 ) {
- par->dfault = fstrdup( cval, len_cval );
- }
- else {
- wrong = 1;
- }
- }
-
- if( wrong )
- printf( " *** KUPVAL: invalid option '%s' for %s %s\n",
- opt, cmd->path, par->name );
- free( opt );
- }
- free( par_name );
- }
- free( path );
-}
-
-
diff --git a/src/packlib/kuip/code_kuip/kmisc.c b/src/packlib/kuip/code_kuip/kmisc.c
deleted file mode 100644
index a71d797..0000000
--- a/src/packlib/kuip/code_kuip/kmisc.c
+++ /dev/null
@@ -1,1010 +0,0 @@
-/*
- * $Id: kmisc.c,v 1.11 1997/11/19 08:56:26 mclareni Exp $
- *
- * $Log: kmisc.c,v $
- * Revision 1.11 1997/11/19 08:56:26 mclareni
- * Convert C++ comment to C
- *
- * Revision 1.10 1997/10/23 16:53:58 mclareni
- * NT mods
- *
- *
- * Revision 1.10 1997/09/22 13:49:55 Fine
- * WNT mods: fexpand, fsearch
- * slashsplit too, likely the last should be UNDO as before
- *
- * Revision 1.9 1997/04/24 13:49:55 gunter
- * Undo changes done by Valeri to slashsplit (this is HPUX only). He messed
- * this up quite a bit.
- *
- * Revision 1.8 1997/03/17 16:54:59 mclareni
- * WNT mods
- *
- * Revision 1.7 1996/10/17 16:06:03 gunter
- * If xsymlink returns error, return the file without prefixing the cwd.
- * ( This allows to open shift files with host:/path )
- *
- * Revision 1.6 1996/10/16 12:41:58 gunter
- * restructure xsymlinks.
- * Now, in case a part of the dir/file does not exist, we return an error.
- * This is needed for shift files: these typically do not exist in the filesystem, but their name then should not be changed eitehr.
- *
- * Revision 1.5 1996/10/08 15:04:09 cremel
- * Open file in mode 'a' (append; open for writing at end of file, or create
- * for writing). Add "\n".
- *
- * Revision 1.4 1996/10/08 13:19:56 cremel
- * Add new KUIP command /KUIP/FMESSAGE to write a message string into a file.
- * New corresponding action routine is kxfmessage (C code).
- *
- * Revision 1.3.2.1 1997/01/21 11:32:50 mclareni
- * All mods for Winnt 96a on winnt branch
- *
- * Revision 1.3 1996/04/15 14:48:45 cernlib
- * Remove extra , in lib$spawn
- *
- * Revision 1.2 1996/04/11 09:45:40 cernlib
- * VMS code changed in kxshell
- *
- * Revision 1.1.1.1 1996/03/08 15:32:58 mclareni
- * Kuip
- *
- */
-/*CMZ : 2.07/00 06/03/95 12.07.28 by Gunter Folger*/
-/*-- Author : Alfred Nathaniel 09/09/92*/
-/* kmisc.c: miscellaneous functions */
-
-#include "kuip/kuip.h"
-#include "kuip/kfor.h"
-#include "kuip/kcom.h"
-#include "kuip/kmenu.h"
-#include "kuip/kflag.h"
-#include "kuip/ksig.h"
-#include "kuip/mkterm.h"
-
-
-#ifdef HPUX
-
-#include <symlink.h>
-
-#define MAXPATHLEN 1024
-static char xbuf[MAXPATHLEN];
-
-
-
-/************************************************************************
- * *
- * Return a NULL terminated array of strings. Each string containing *
- * a part of the pathname. *
- * *
- ************************************************************************/
-static
-char **slashsplit(s)
- char *s;
-{
- char *t,**r,**q;
- int t0;
-
- while( strchr(SLASHES,*s) )
- s++;
-
- if (!*s) {
- q = (char **) calloc(1,sizeof(char **));
- *q = NULL;
- return q;
- }
- for (t = s, t0 = 0; *t; t++)
- if (strchr(SLASHES,*t))
- t0++;
- q = r = (char **) calloc((t0+2),sizeof(char **));
- while ((t = strpbrk( s, SLASHES )) != NULL)
- {
- *t = '\0';
- *q++ = str0dup(s);
- *t = '/';
- while (strchr(SLASHES,*t))
- t++;
- if (!*t)
- {
- *q = NULL;
- return r;
- }
- s = t;
- }
- *q++ = str0dup(s);
- *q = NULL;
- return r;
-}
-
-#include <errno.h>
-
-/************************************************************************
- * *
- * Expands symlinks and .. or . expressions, *
- * if flag = 0, only expand .. and . expressions. *
- * s is assumed to start from /, but need NOT to start with "/"! *
- * ( actually this depends on xbuf, which should be empty, otherwise *
- * this routines just add to xbuf) *
- * return codes: *
- * TRUE (1) : success, a (modified) filename is in xbuf *
- * FALSE(0) : Failed, probably a dir/file component not found *
- * *
- ************************************************************************/
-static
-int xsymlinks(s, flag) /**/
-char *s;
-int flag;
-{
- char **pp, **opp;
- char xbuf2[MAXPATHLEN], xbuf3[MAXPATHLEN];
- int t0;
-
- opp = pp = slashsplit(s);
- for (; *pp; pp++) {
- if (!strcmp(*pp, ".")) {
- free(*pp);
- /* continue; */
- } else if (!strcmp(*pp, "..")) {
- char *p;
-
- free(*pp);
- if (!strcmp(xbuf, "/"))
- continue;
- p = xbuf + strlen(xbuf);
- while (*--p != '/')
- ;
- *p = '\0';
- /* continue; */
- } else if ( flag ) {
- sprintf(xbuf2, "%s/%s", xbuf, *pp);
- t0 = readlink(xbuf2, xbuf3, MAXPATHLEN);
- if (t0 == -1 ) {
- if (errno == EINVAL ) { /* is not a symlink */
- strcat(xbuf, "/");
- strcat(xbuf, *pp);
- free(*pp);
- } else { /* real error, clean up and exit */
- goto abort;
- }
- } else {
- xbuf3[t0] = '\0'; /* STUPID */
- if (*xbuf3 == '/') { /* absolute symlink,*/
- strcpy(xbuf, ""); /* restart new xbuf */
- }
- if ( ! xsymlinks(xbuf3, flag)) {
- /* error, clean up */
- goto abort;
- }
- free(*pp);
- }
- } else {
- strcat(xbuf, "/");
- strcat(xbuf, *pp);
- free(*pp);
- }
- }
- free(opp);
- return 1;
-
-/* error, clean up and exit */
-abort:
- for (; *pp; pp++) free(*pp);
- free(*opp);
- return 0;
-}
-
-
-
-/************************************************************************
- * *
- * Expand symlinks in s, and remove other weird things (.., .). *
- * This routine allocates space for the result, free this string after *
- * usage to prevent memory leaks. *
- * *
- ************************************************************************/
-char *fsymlink( const char *s )
-{
- strcpy(xbuf,"");
- if (*s != '/') {
- char fullp[MAXPATHLEN];
- getcwd(fullp, MAXPATHLEN);
- strcat(fullp, "/");
- strcat(fullp, s);
- if ( ! xsymlinks(fullp+1,1))
- return str0dup(s);
- } else if ( ! xsymlinks(s+1,1))
- return str0dup(s);
- if (!*xbuf)
- return str0dup("/");
- return str0dup(xbuf);
-}
-
-#endif
-
-
-/*
- * expand ~ into user's home directory
- * expand $var for environment variables
- * append default filetype if missing
- * the pointer returned is allocated
- */
-char *fexpand( const char *fname,
- const char *ftype ) /* default file extension */
-{
- char *path = strdup( fname );
- char *p;
-
-#ifdef UNIX
- if( path[0] == '~'
- && strchr( SLASHES, path[1] ) != NULL ) {
- p = str2dup( "$HOME", &path[1] );
- free( path );
- path = p;
- }
-
- if( path[0] == '$' || path[0] == '~' ) {
- char *repl = NULL;
- char *slash = strpbrk( path, SLASHES );
- char Slash = '\0';
-
- if( slash != NULL ) {
- Slash = *slash;
- *slash = '\0';
- }
-
- if( path[0] == '$'
- && (repl = getenv( &path[1] )) == NULL
- && (repl = getenv( strupper( &path[1] ) )) == NULL ) {
- printf( " *** Environment variable %s not defined\n", path );
- }
-# ifndef MSDOS
- else if( path[0] == '~' ) {
- struct passwd *pwd = getpwnam( &path[1] );
- if( pwd == NULL ) {
- printf( " *** User %s not found in password file\n", &path[1] );
- }
- else {
- repl = pwd->pw_dir;
- }
- }
-# endif
-
- if( slash != NULL )
- *slash = Slash;
-
- if( repl != NULL ) {
- p = strdup( repl );
- if( slash != NULL )
- {
- /* Check whether $ had its own "end" slash V.Fine 22.09.97 */
- char *eov= &p[strlen(p)-1];
- if (strchr(SLASHES,*eov)) *eov = '\0'; /* cut one extra slash off */
-
- p = mstrcat( p, slash );
- }
- free( path );
- path = p;
- }
- }
-
-#endif
-
- if( path[0] == '-' ) {
- /* if "-file" remove "-" and leave rest untouched */
- strcpy( path, path + 1 );
- }
-
- else if( ftype != NULL ) {
-#ifdef vms
- /* watch out for VMS "disk:[dir.sub]file" */
- p = strrchr( path, ']' );
-#define _done_
-#endif
-#ifdef UNIX
- /* watch out for Unix "dir.sub/file" */
- if( (p = strrpbrk( path, SLASHES )) != NULL ) {
- /* skip over "/." in "dir/.file" */
- p += 2;
- }
-#define _done_
-#endif
-#ifdef _done_
-#undef _done_
- if( p == NULL )
- p = path;
-#else
- p = path;
-
-#endif
- if( strchr( p, '.' ) == NULL ) {
- /* append default file type missing */
- path = mstr2cat( path, ".", ftype );
- }
- }
-
- return path;
-}
-
-
-/*
- * test file existance and return file path or NULL
- * the search path can be a comma or colon separated list of directories
- */
-char *fsearch( const char *fname,
- const char *ftype,
- const char *dir_path ) /* comma(!) separated search path */
-{
-#if defined(vms) || defined(MSDOS) || defined(CERNLIB_WINNT)
- static char sep[] = ","; /* colon could be "disk:[dir]" */
-#else
- static char sep[] = ",:";
-#endif
- static char *path = NULL;
- char *fspec = fexpand( fname, ftype );
- char *dpath;
- char *dir;
- FILE *stream;
-
- if( path != NULL ) {
- free( path );
- path = NULL;
- }
-
- /* if file spec contains already a directory don't apply search path */
-#ifdef IBMVM
- if( strchr( fspec, '.' ) != strrchr( fspec, '.' ) )
- path = fspec; /* "file.type.fm" */
-#endif
-#ifdef UNIX
-# if defined(MSDOS) || defined(CERNLIB_WINNT)
- if( strchr( fspec, ':' ) != NULL )
- path = fspec; /* "drive:file" */
-# endif
- if( strpbrk( fspec, SLASHES ) != NULL )
- path = fspec; /* "dir/file" */
-#endif
-#ifdef vms
- if( strchr( fspec, ':' ) != NULL || strchr( fspec, ']' ) != NULL )
- path = fspec; /* "disk:file" or "[dir]file" */
-#endif
-
- if( path != NULL ) {
- if( (stream = fopen( path, "r" )) != NULL
- || (stream = fopen( ku_fcase( path ), "r" )) != NULL ) {
- fclose( stream );
-#ifdef DBMALLOC
- malloc_mark( path );
-#endif
- }
- else {
- free( path );
- path = NULL;
- }
- return path;
- }
-
- if( dir_path == NULL ) {
- char *cdir;
-#ifdef IBMVM
- cdir = "*"; /* search all disks */
-#define _done_
-#endif
-#ifdef UNIX
- cdir = ".";
-#define _done_
-#endif
-#ifdef vms
- cdir = " "; /* cdir = "[]"; causes trouble for VMS search lists */
-#define _done_
-#endif
-#ifdef _done_
-#undef _done_
-#else
- cdir = "";
-#endif
- dpath = strdup( cdir );
- }
- else {
- dpath = strdup( dir_path );
- }
-
-#ifndef WIN32_TEST
- for( dir = strtok( dpath, sep ); dir != NULL; dir = strtok( NULL, sep ) ) {
- char *p;
-
-#ifdef IBMVM
- path = str3dup( fspec, ".", dir );
-#else
- path = strdup( dir );
-# ifdef UNIX
- if( strchr( SLASHES, dir[strlen(dir)-1] ) == NULL )
- path = mstrccat( path, SLASHES[0], 1 );
-# endif
- path = mstrcat( path, fspec );
-#endif
-
- /* in case search path contains "~" or "$var" */
- p = fexpand( path, NULL );
- free( path );
- path = p;
-
- if( (stream = fopen( path, "r" )) != NULL
- || (stream = fopen( ku_fcase( path ), "r" )) != NULL ) {
- fclose( stream );
-#ifdef DBMALLOC
- malloc_mark( path );
-#endif
- break;
- }
- else {
- free( path );
- path = NULL;
- }
- }
-#else
- {
- char *lookup = fexpand(dpath,NULL);
- char *buffer;
- char *env = "__CERN_Search";
-
- path = str2dup(lookup,fspec);
-
-/* Create a temporary environment variable */
-
- if (!lookup)
- buffer = str3dup( env, "=","./" );
- else
- {
- buffer = str3dup(env,"=",lookup );
- free(lookup);
- }
- _putenv(buffer);
- free(buffer);
-
- _searchenv(fspec, env, path );
-
-/* Check access */
-
- if (access(path,00) == -1)
- {
- free(path);
- path = NULL;
- }
- }
-#endif /* WIN32 */
- free( fspec );
- free( dpath );
-
- return path;
-}
-
-
-/*
- * like system() but allow to give shell name
- */
-int shsystem( const char *host_shell,
- const char *line )
-{
-#ifdef SIGNAL_POSIX
- /*
- * Because we have to tweak the signal catching before spawning off the
- * shell we only bother to implement it if the system provides Posix
- * compliant signal handling.
- */
- struct sigaction act;
- struct sigaction save_intr;
- struct sigaction save_quit;
- sigset_t mask;
- sigset_t save_mask;
- int save_errno;
- int pid;
- int status;
-
- /* ignore SIGINT and SIGQUIT */
-
- sigemptyset( &act.sa_mask );
- act.sa_flags = 0;
- act.sa_handler = SIG_IGN;
-
- sigaction( SIGINT, &act, &save_intr );
- sigaction( SIGQUIT, &act, &save_quit );
-
- /* block SIGCHLD */
-
- sigemptyset( &mask );
- sigaddset( &mask, SIGCHLD );
- sigprocmask( SIG_BLOCK, &mask, &save_mask );
-
- if( (pid = vfork()) == 0 ) {
- /* child: restore signal handling before starting shell */
-
- sigaction( SIGINT, &save_intr, NULL );
- sigaction( SIGQUIT, &save_quit, NULL );
- sigprocmask( SIG_SETMASK, &save_mask, NULL );
-
- execl( host_shell, host_shell, "-c", line, NULL );
-/* if execl returns , this is an error */
- printf( " *** Cannot exec host_shell (%s) ***\n", host_shell );
- exit(1);
- }
- else if( pid > 0 ) {
- /* parent: wait for child */
- if( waitpid( pid, &status, 0 ) != pid )
- status = -1;
- }
- else {
- /* fork failed */
- status = -1;
- }
-
- /* restore original signal handling */
-
- save_errno = errno;
- sigaction( SIGINT, &save_intr, NULL );
- sigaction( SIGQUIT, &save_quit, NULL );
- sigprocmask( SIG_SETMASK, &save_mask, NULL );
- errno = save_errno;
-
- return status;
-#else
- return system( line );
-#endif
-}
-
-
-/*
- * action routine for /KUIP/SET_SHOW/HOST_SHELL
- */
-int kxhostshell()
-{
- char *shell_name = ku_gete();
-
- if( strcmp( shell_name, "?" ) == 0 ) {
- ku_alfa();
- printf( " Current host shell: %s\n", kc_value.set_host_shell );
- }
- else {
- if( kc_value.set_host_shell != NULL )
- free( kc_value.set_host_shell );
- kc_value.set_host_shell = strdup( shell_name );
-
-#ifdef DBMALLOC
- malloc_mark( kc_value.set_host_shell );
-#endif
- }
- return 0;
-}
-
-
-/*
- * action routine for /KUIP/SHELL
- */
-int kxshell()
-{
- char *shell_cmd = ku_gete();
- int status = 0;
-
-#ifdef APOLLO
- short connc = 4;
- stream_$id_t connv[4];
- pgm_$proc proc;
- status_$t istat;
-
- connv[0] = ios_$stdin;
- connv[1] = ios_$stdout;
-# ifdef _BFMT__COFF /* If sr10 or later */
- connv[2] = ios_$errout;
- connv[3] = ios_$stderr;
-# else
- connv[2] = ios_$errin;
- connv[3] = ios_$errout;
-# endif
-
- proc.p = NULL;
-#endif
-
- ku_alfa();
- if( shell_cmd[0] == '\0' ) {
- if( kc_flags.in_motif ) {
- printf( " Cannot run shell from Motif mode\n" );
- return -1;
- }
- else {
-
-#ifdef IBMVM
- printf( " Type 'return' to return to the command processor\n" );
- system( "SUBSET" );
-#define _done_
-#endif
-
-#ifdef IBMMVS
- F77_CALL_C(Kmvssh," ",1);
-#define _done_
-#endif
-
-#ifdef vms
- $DESCRIPTOR(cmd_string,"$ RETURN:==LOGOFF");
- $DESCRIPTOR(sys_command,"SYS$COMMAND");
- printf( " Type 'return' to return to the command processor\n" );
- lib$spawn( &cmd_string, &sys_command, &sys_command );
-#define _done_
-#endif
-
-#ifdef APOLLO
- if( strcmp( kc_value.set_host_shell, "/com/sh" ) == 0 ) {
- /*
- * Use pgm_$invoke() rather than system() because /com/sh uses
- * a fourth standard stream. Memory can be overwritten if that
- * stream is bogus.
- * Reported by Robert Franchisseur (robert at m23.limsi.fr).
- */
- short argc = 2;
- pgm_$arg argv[2];
- pgm_$arg_ptr argv_ptr[2];
- int i;
-
- strcpy( argv[0].chars, "/com/sh" );
- strcpy( argv[1].chars, "-start" );
- for( i = 0; i < argc; i++ ) {
- argv[i].len = strlen( argv[i].chars );
- argv_ptr[i] = &argv[i];
- }
-
- printf( " Type 'return' to return to the command processor\n" );
- pgm_$invoke( argv[0].chars, argv[0].len, argc, argv_ptr,
- connc, connv, pgm_$wait, &proc, &istat );
- if( istat.all != status_$ok ) {
- status = istat.all;
- error_$print( istat );
- }
- }
- else {
- printf( " Type 'exit' to return to the command processor\n" );
- if( system( kc_value.set_host_shell ) == -1 )
- perror( kc_value.set_host_shell );
- }
-#define _done_
-#endif
-
-#ifdef _done_
-#undef _done_
-#else
- printf( " Type 'exit' to return to the command processor\n" );
-# ifdef MSDOS
- text_mode__();
-# endif
- if( system( kc_value.set_host_shell ) == -1 )
- perror( kc_value.set_host_shell );
-#endif
- }
- }
- else {
-
-#ifdef IBMVM
- char *cmd_string = strdup( shell_cmd );
- char *exec_name = strtok( cmd_string, " " );
- char *exec_file = fsearch( exec_name, "EXEC", "*" );
-
- strcpy( cmd_string, shell_cmd );
- if( exec_file != NULL ) {
- /* if a file "cmd EXEC *" exists prepend "EXEC" to execute it */
- char *p = str2dup( "EXEC ", cmd_string );
- free( cmd_string );
- cmd_string = p;
- }
- status = system( cmd_string );
- if( status >= 0 && status <= 4 )
- status = 0; /* ignore informational messages */
- else
- printf( " Command '%s' returned status code %d\n", cmd_string, status );
- free( cmd_string );
-#define _done_
-#endif
-
-#ifdef IBMMVS
- F77_CALL_C(Kmvssh,shell_cmd,strlen(shell_cmd));
-#define _done_
-#endif
-
-#ifdef vms
- /*
- * Write command line into file because lib$spawn doesn't do
- * symbol substitution.
- */
- FILE *stream;
- char *cmd_string;
- struct dsc$descriptor_s cmd_dsc;
-
- if ( strchr(shell_cmd,'\'') == NULL ) {
- var_descriptor( cmd_dsc, shell_cmd );
- status = lib$spawn( &cmd_dsc );
- } else {
- stream = fopen( kc_flags.appl_file, "w" );
- /* in case the command calls an editor */
- /* fprintf( stream, "$ ASSIGN/USER SYS$COMMAND SYS$INPUT\n" ); */
- fprintf( stream, "$ %s\n", shell_cmd );
- fclose( stream );
-
- var_descriptor( cmd_dsc, kc_flags.appl_file );
- status = lib$spawn( &cmd_dsc );
- remove( kc_flags.appl_file );
- }
-
- if( status & 1 ) /* lowest bit flags success */
- status = 0;
- if( status != 0 )
- printf( " Command '%s' returned status code %d\n", shell_cmd, status );
-#define _done_
-#endif
-
-#ifdef APOLLO
- if( strcmp( kc_value.set_host_shell, "/com/sh" ) == 0 ) {
- short argc = 4;
- struct {
- short len;
- char chars[1024]; /* default size of pgm_$arg is only 128 */
- } argv[4];
- pgm_$arg_ptr argv_ptr[4];
- int i;
-
- strcpy( argv[0].chars, "/com/sh" );
- strcpy( argv[1].chars, "-start" );
- strcpy( argv[2].chars, "-c" );
- strcpy( argv[3].chars, shell_cmd );
- for( i = 0; i < argc; i++ ) {
- argv[i].len = strlen( argv[i].chars );
- argv_ptr[i] = (pgm_$arg*)&argv[i];
- }
-
- pgm_$invoke( argv[0].chars, argv[0].len, argc, argv_ptr,
- connc, connv, pgm_$wait, &proc, &istat );
- if( istat.all != status_$ok ) {
- status = istat.all;
- error_$print( istat );
- }
- }
- else {
- status = shsystem( kc_value.set_host_shell, shell_cmd );
- if( status == -1 )
- perror( shell_cmd );
- else if( status != 0 )
- printf( " *** %s returned exit code %d\n", shell_cmd, status );
- }
-#define _done_
-#endif
-
-#ifdef _done_
-#undef _done_
-#else
-# ifdef MSDOS
- text_mode__();
-# endif
- status = shsystem( kc_value.set_host_shell, shell_cmd );
- if( status == -1 ) {
- perror( shell_cmd );
- }
- else if( status != 0 ) {
-# ifdef WIFEXITED
- if( WIFEXITED( status ) ) {
- status = WEXITSTATUS( status );
- printf( " *** %s returned exit code %d\n", shell_cmd, status );
- }
- else
-# endif
- printf( " *** %s returned status code %d\n", shell_cmd, status );
- }
-#endif
- }
- return status;
-}
-
-
-/*
- * action routine for /KUIP/SET/LCDIR (set working directory)
- */
-int kxlcdir()
-{
- int status = 0;
-
-#if defined(UNIX) || defined(vms)
-
- char *dir = ku_gets();
- char cwd[256];
-
- ku_alfa();
-
- if( dir[0] != '\0' ) {
- char *path;
-
- if( strcmp( dir, "." ) == 0 ) {
- path = strdup( kc_flags.init_wdir );
- }
-#ifdef vms
- else if( strcmp( dir, "~" ) == 0 ) {
- path = strdup( getenv( "HOME" ) );
- }
-#endif
- else {
- path = fexpand( dir, NULL ); /* for ~ expansion */
- }
-
- if( chdir( path ) == -1 ) {
- perror( " *** LCDIR" );
- free( path );
- return -1;
- }
-
- free( path );
- }
-
- if( getcwd( cwd, (sizeof cwd) ) == NULL ) {
- perror( " *** LCDIR" );
- status = -1;
- }
- else {
- printf( " Local directory is %s\n", cwd );
-
- /* set system current working directory in kxterm */
- if (kc_flags.use_kxterm) {
- char *s = malloc(strlen(cwd) + 6);
- sprintf(s, "lcd(%s)", cwd);
- send_single_kxterm_cmd(s);
- free(s);
- }
- }
-
-#else
-
- ku_alfa();
- printf( " LCD: not implemented for this system\n" );
-
-#endif
-
- return status;
-}
-
-
-/*
- * action routine for /KUIP/MESSAGE
- */
-int kxmessage()
-{
- char *msg = ku_gete();
-
- ku_alfa();
- printf( " %s\n", msg );
- return 0;
-}
-
-/*
- * action routine for /KUIP/FMESSAGE
- */
-int kxfmessage()
-{
- char *msg = ku_gets();
- char *fname = ku_getf();
- FILE *stream = NULL;
-
- if( fname[0] != '\0' ) {
- fname = fexpand( fname, NULL );
- stream = fopen( fname, "a" );
- free( fname );
- }
-
- if( stream == NULL ) {
- ku_alfa();
- printf( " %s\n", msg );
- } else {
- fputs( msg, stream );
- fputs( "\n", stream );
- fclose( stream );
- }
-
- return 0;
-}
-
-
-/*
- * action routine for /KUIP/WAIT
- */
-int kxwait()
-{
- char *msg = ku_gets();
-#ifdef IBMMVS
- int seconds = 0;
-#else
- int seconds = ku_getr();
-
- if( seconds > 0 ) {
-
- if( msg[0] != '\0' ) {
- ku_alfa();
- printf( " %s\n", msg );
- }
-
-# ifdef IBMVM
-# pragma linkage(SLEEPF,FORTRAN)
- SLEEPF( &seconds );
-# elif !defined(CERNLIB_WINNT)
- sleep( seconds );
-# else
- Sleep( seconds*1000 );
-# endif
- }
-#endif
-
- if( seconds <= 0 ) {
- const char *answer;
- if( msg[0] == '\0' )
- msg = "Type <CR> to continue or Q to quit";
-
- answer = ku_proc( msg, NULL );
- if( answer == NULL || *answer == 'Q' ) {
- kc_flags.quit_macro = 1;
- return KUMAC_UNWIND;
- }
- }
-
- return 0;
-}
-
-
-/*
- * action routine for /KUIP/IDLE
- */
-int kxidle()
-{
- int seconds = ku_geti();
- char *cmd = ku_gete();
-
- if( cmd[0] != '\0' ) {
- if( kc_value.idle_cmd != NULL )
- free( kc_value.idle_cmd );
- kc_value.idle_cmd = strdup( cmd );
- }
- else if( kc_value.idle_cmd == NULL )
- seconds = 0;
-
- kc_value.idle_time = seconds;
- return 0;
-}
-
-
-/*
- * return the user name
- */
-char *k_userid()
-{
- char *user_name;
-
-#if defined(UNIX) && !defined(MSDOS)
- struct passwd *pwd = getpwuid( getuid() );
- user_name = pwd->pw_name;
-#define _done_
-#endif
-
-#ifdef vms
- user_name = cuserid( NULL );
-#define _done_
-#endif
-
-#ifdef _done_
-#undef _done_
-#else
- user_name = NULL;
-#endif
-
- if( user_name == NULL )
- user_name = "unknown";
-
- return user_name;
-}
-
-#ifndef IBM370 /* for IBM it's a Fortran routine */
-void F77_ENTRY_C(Kuserid,chuser)
-/* { */
- fstrset( chuser, len_chuser, k_userid() );
-}
-#endif
-
-
diff --git a/src/packlib/kuip/code_kuip/kmodel.c b/src/packlib/kuip/code_kuip/kmodel.c
deleted file mode 100644
index bd58d9c..0000000
--- a/src/packlib/kuip/code_kuip/kmodel.c
+++ /dev/null
@@ -1,42 +0,0 @@
-/*
- * $Id: kmodel.c,v 1.2 1997/03/17 16:55:00 mclareni Exp $
- *
- * $Log: kmodel.c,v $
- * Revision 1.2 1997/03/17 16:55:00 mclareni
- * WNT mods
- *
- * Revision 1.1.1.1.2.1 1997/01/21 11:32:51 mclareni
- * All mods for Winnt 96a on winnt branch
- *
- * Revision 1.1.1.1 1996/03/08 15:32:58 mclareni
- * Kuip
- *
- */
-/*CMZ : 2.00/09 18/01/93 15.07.23 by Alfred Nathaniel*/
-/*-- Author : Alfred Nathaniel 05/11/92*/
-/* kmodel.c: dummy routines for Model Human Interface */
-
-#include "kuip/kuip.h"
-#include "kuip/kfor.h"
-
-
-void F77_ENTRY(Mhi_close)
-/* { */
- /* do nothing */
-}
-
-
-void F77_ENTRY(Mhi_open)
-/* { */
- printf( " *** Cannot change style to MHI\
- - Model Human Interface not available\n" );
- ku_exel( "/KUIP/SET_SHOW/STYLE 'C'" );
-}
-
-
-void F77_ENTRY(Mdmenu)
-/* { */
- /* do nothing */
-}
-
-
diff --git a/src/packlib/kuip/code_kuip/kmterm.c b/src/packlib/kuip/code_kuip/kmterm.c
deleted file mode 100644
index 44e19d0..0000000
--- a/src/packlib/kuip/code_kuip/kmterm.c
+++ /dev/null
@@ -1,236 +0,0 @@
-/*
- * $Id: kmterm.c,v 1.1.1.1 1996/03/08 15:32:58 mclareni Exp $
- *
- * $Log: kmterm.c,v $
- * Revision 1.1.1.1 1996/03/08 15:32:58 mclareni
- * Kuip
- *
- */
-/*CMZ : 2.05/15 09/08/94 09.53.56 by Alfred Nathaniel*/
-/*-- Author : Fons Rademakers 16/01/93*/
-/***********************************************************************
- * *
- * Non X and Motif dependend routines related with kxterm. *
- * *
- * (from file init.c) *
- * *
- ***********************************************************************/
-
-#include "kuip/kuip.h"
-#include "kuip/kfor.h"
-#include "kuip/kmenu.h"
-#include "kuip/kflag.h"
-#include "kuip/mkterm.h"
-
-
-static int num_kxterm_actions;
-static KxtermActionList kxterm_actions;
-
-
-/***********************************************************************
- * *
- * Send a single kxterm command. *
- * *
- ***********************************************************************/
-void send_single_kxterm_cmd(cmd)
- char *cmd;
-{
- if (!kc_flags.use_kxterm) return;
-
- if (*(cmd+strlen(cmd)-1) != '\n')
- printf("%s%s\n", ESCAPE, cmd);
- else
- printf("%s%s", ESCAPE, cmd);
-}
-
-/***********************************************************************
- * *
- * Send a number of kxterm command. *
- * *
- ***********************************************************************/
-void send_kxterm_cmd(cmd)
- char **cmd;
-{
- int i;
-
- for (i = 0; cmd[i]; i++)
- send_single_kxterm_cmd(cmd[i]);
-}
-
-/***********************************************************************
- * *
- * Return kxterm action proc belonging to string. *
- * *
- ***********************************************************************/
-static KxtermActionProc kxterm_get_proc(string)
- char *string;
-{
- char *s, *s1;
- int i, l, n = num_kxterm_actions;
-
- s = string + strlen(ESCAPE);
- if ((s1 = strchr(s,'(')))
- l = s1 - s;
- else
- l = strlen(s);
-
- for (i = 0; i < n; i++)
- if (!strncmp(kxterm_actions[i].string, s, l))
- return kxterm_actions[i].proc;
-
- return (KxtermActionProc) NULL;
-
-}
-
-/***********************************************************************
- * *
- * Parse action arguments. *
- * *
- ***********************************************************************/
-void k_parse_args( const char *cmd,
- char **argv,
- int *argc )
-{
- char *s;
-
- *argc = 0;
- argv[0] = (char *)NULL;
-
- /* remove any trailing newline character */
- if ((s = strrchr(cmd, '\n')))
- *s = '\0';
-
- /* position at beginning of argument list */
- s = strchr(cmd, '(');
- if (!s) return;
-
- s = strtok(s, "(,)");
- while (s) {
- argv[(*argc)++] = strdup(s);
- s = strtok(NULL, ",)");
- }
-}
-
-/***********************************************************************
- * *
- * Register kxterm actions. *
- * *
- ***********************************************************************/
-void kxterm_add_actions(actions)
- KxtermActionList actions;
-{
- int i, n = num_kxterm_actions;
- int nact = 0;
-
- for (i = 0; actions[i].string; i++)
- nact++;
-
- if (!kxterm_actions)
- kxterm_actions = (KxtermActionList) malloc(
- (nact+n)*sizeof(KxtermActionsRec));
- else
- kxterm_actions = (KxtermActionList) realloc(kxterm_actions,
- (nact+n)*sizeof(KxtermActionsRec));
-
- for (i = n; i < n+nact; i++) {
- kxterm_actions[i].string = strdup(actions[i-n].string);
- kxterm_actions[i].proc = actions[i-n].proc;
- }
-
- num_kxterm_actions += nact;
-}
-
-/***********************************************************************
- * *
- * Handle kxterm actions. *
- * *
- ***********************************************************************/
-void handle_kxterm_action( cmd )
- char *cmd;
-{
- KxtermActionProc proc;
- char *argv[15];
- int argc, i;
-
- if ((proc = kxterm_get_proc(cmd))) {
- k_parse_args(cmd, argv, &argc);
-
- (proc)(argv, argc);
-
- for (i = 0; i < argc; i++)
- free(argv[i]);
- }
-}
-
-
-/*
- * prompt for a string
- * in Motif mode: change prompt string in Kxterm and read from stdin
- */
-void F77_ENTRY_CCI(Kuinps,chprmt,chline,length)
-/* { */
- char *prompt = fstrdup( chprmt, len_chprmt );
- *length = fstrset( chline, len_chline, ku_inps( prompt ) );
- free( prompt );
-}
-
-char *ku_inps( const char *prompt )
-{
-#ifndef vms
- if( kc_flags.in_motif && kc_flags.use_kxterm ) {
- static char line[1024];
- char *cmd = str3dup( "prompt(", prompt, " )\2" );
- int i;
-
- send_single_kxterm_cmd( cmd );
- free( cmd );
-
- for( i = 0; read( 0, &line[i], 1 ) == 1; i++ ) {
- if( line[i] == '\n' ) {
- break;
- }
- }
- line[i] = '\0';
- printf( "%s %s\n", prompt, line );
- return line;
- }
-#endif
-
- return ku_pros( prompt, NULL );
-}
-
-
-/*
- * if keyboard input is available return 1 otherwise 0
- */
-INTEGER Kuqkey()
-{
- return ku_qkey();
-}
-
-int ku_qkey()
-{
-#ifdef HAVE_SELECT
- while( 1 ) {
- fd_set readfds;
- struct timeval timeout;
- char ch;
-
- FD_ZERO( &readfds );
- FD_SET( 0, &readfds );
- timeout.tv_sec = 0;
- timeout.tv_usec = 0;
-
- if( select( 1, SELECT_CAST(&readfds), NULL, NULL, &timeout ) == 0 )
- return 0;
-
- read( 0, &ch, 1 );
- if( ch == '\n' )
- return 1;
- }
-#else
-
- return 0;
-
-#endif
-}
diff --git a/src/packlib/kuip/code_kuip/kmutil0.c b/src/packlib/kuip/code_kuip/kmutil0.c
deleted file mode 100644
index 4ae9c56..0000000
--- a/src/packlib/kuip/code_kuip/kmutil0.c
+++ /dev/null
@@ -1,44 +0,0 @@
-/*
- * $Id: kmutil0.c,v 1.2 1997/11/28 17:24:46 mclareni Exp $
- *
- * $Log: kmutil0.c,v $
- * Revision 1.2 1997/11/28 17:24:46 mclareni
- * Add Id and Log for CVS
- *
- */
-/******************************************************************************/
-/* */
-/* - km_strempty : Returns true (1) if string is empty */
-/* */
-/******************************************************************************/
-
-#include "kuip/kuip.h"
-#include "kuip/kfor.h"
-#include "kuip/kmenu.h"
-
-#include "kuip/mkutfu.h"
-
-/***********************************************************************
- * *
- * Returns true (1) if string is empty (only containing blanks). *
- * *
- ***********************************************************************/
-int km_strempty(str)
- char *str;
-{
- char *sav = str;
- int rtrn = 1;
-
- if (!sav) return rtrn;
- if (strlen(sav) == 0) return rtrn;
-
- while (*sav) {
- if (*sav != ' ') {
- rtrn = 0;
- break;
- }
- sav++;
- }
- return rtrn ;
-}
-
diff --git a/src/packlib/kuip/code_kuip/kmvsed.F b/src/packlib/kuip/code_kuip/kmvsed.F
deleted file mode 100644
index 78951a0..0000000
--- a/src/packlib/kuip/code_kuip/kmvsed.F
+++ /dev/null
@@ -1,181 +0,0 @@
-*
-* $Id: kmvsed.F,v 1.1.1.1 1996/03/08 15:32:55 mclareni Exp $
-*
-* $Log: kmvsed.F,v $
-* Revision 1.1.1.1 1996/03/08 15:32:55 mclareni
-* Kuip
-*
-*
-#include "kuip/pilot.h"
-#if defined(CERNLIB_IBMMVS)
-*CMZ : 2.05/15 01/08/94 10.35.04 by Alfred Nathaniel
-*-- Author : Alfred Nathaniel 06/11/92
- SUBROUTINE KMVSED(FILE,IST)
-*
-*******************************************************************************
-*
-* Called by KUEDIT to invoke the editor on MVS
-*
-* IST is set to 0 on normal exit, 1 on abort (quit), 2 on any error case
-*
-* Input :
-*
- CHARACTER*(*) FILE
-*
-* Output :
-*
- INTEGER IST
-*
-********************************************************************************
-*
-#if defined(CERNLIB_GSI)
- CHARACTER*46 CNAMEH
-#endif
-#if !defined(CERNLIB_NEWLIB)
- CHARACTER*80 TEMP
- CHARACTER*48 CNAME
- CHARACTER*20 PREFIX
-
-#endif
-#if defined(CERNLIB_NEWLIB)
- CHARACTER*44 CNAME
- CHARACTER*20 PREFIX
- CHARACTER*80 MVSCOM(20)
- INTEGER SPACE(2)
-#endif
-
- LENGTH = LENOCC(FILE)
-
-#if !defined(CERNLIB_NEWLIB)
-
-*-- CHECK THAT THE FILE EXISTS (IF NOT, CREATE IT)
-
- LDUM=99
-30 CONTINUE
- TEMP=' '
- CALL KUINQF(TEMP,LDUM)
- IF (TEMP.EQ.' ') GO TO 20
- LDUM=LDUM-1
- GO TO 30
-20 CONTINUE
-
- CALL KUOPEN ( LDUM, FILE, 'UNKNOWN', ISTAT )
- IF ( ISTAT .NE. 0 ) THEN
- IST = 2
- PRINT *, '*** KUEDIT: CANNOT OPEN FILE= ', FILE
- RETURN
- ENDIF
-
-*-- AND CLOSE IT, IT WILL BE OPEN BY ISPF EDITOR
-
- CALL KUCLOS(LDUM,'KEEP',IRC)
- 10 CONTINUE
-
-*-- IBMMVS = CALL THE ISPF EDITOR
-
-*-- WARNING = ROUTINE ISPLNK IS FOUND IN LIBRARY:
-*-- ISP.V2R2M0.ISPLOAD (STRASBOURG NAME...) WHICH MUST
-*-- BE ADDED AT THE LINK LEVEL
-
-*-- DON'T ADD PREFIX IF THE FIRST CHARACTER OF FILE NAME IS A DOT
-
- IF ( FILE(1:1) .EQ. '.' ) THEN
- CNAME = FILE(2:LENGTH)
- LENGTH = LENGTH - 1
- ELSE
- CALL KPREFI ( PREFIX, NCHPRE )
- CNAME = PREFIX(1:NCHPRE)//FILE
- LENGTH = LENGTH + NCHPRE
- ENDIF
-#endif
-#if defined(CERNLIB_GSI)
-*-- NOW ADD APOSTROPHES ALWAYS
- CNAMEH = ''''//CNAME(1:LENGTH)//''''
- CNAME = CNAMEH
- LENGTH = LENGTH + 2
-#endif
-#if !defined(CERNLIB_NEWLIB)
-
- IST = 0
-* return after occurence of error
- ISTAT = ISPLNK ( 'CONTROL' , 'ERRORS' , 'RETURN' )
- IF ( ISTAT .NE. 0 ) THEN
- PRINT *, '*** SYSTEM FAILURE IN CALLING THE ISPF/PDF'
- +, ' CONTROL ERROR RETURN, RC= ', ISTAT
- IST = 2
- RETURN
- ENDIF
-* define dataset names
- ISTAT = ISPLNK ( 'VDEFINE', '(DSN)', CNAME, 'CHAR', LENGTH )
- IF ( ISTAT .NE. 0 ) THEN
- IST = 2
- PRINT *, '*** KUEDIT: SYSTEM FAILURE IN CALLING THE EDITOR'
- +, ' STEP VDEFINE - STATUS ', ISTAT
- RETURN
- ENDIF
-* call the editor
- ISTAT = ISPLNK ( 'EDIT ', CNAME )
- IF ( ISTAT .NE. 0 .AND.
- + ISTAT .NE. 4 ) THEN
- IST = 2
- PRINT *, '*** KUEDIT: SYSTEM FAILURE IN CALLING THE EDITOR'
- +, ' STEP EDIT - STATUS ', ISTAT
- RETURN
- ENDIF
-* If not saved, ISTAT=4 (if text was not altered or edit sess. canceled)
- IF ( ISTAT .EQ. 4) THEN
- IST = 1
- PRINT *, 'KUEDIT: FILE NOT SAVED !!'
- ENDIF
-* reset into line mode
- ISTAT = ISPLNK ( 'CONTROL' , 'DISPLAY' , 'LINE' , 1)
- IF ( ISTAT .NE. 0 ) THEN
- PRINT *, '*** SYSTEM FAILURE IN CALLING THE ISPF/PDF'
- +, ' CONTROL DISPLAY LINE 1, RC= ', ISTAT
- RETURN
- ENDIF
-#endif
-#if defined(CERNLIB_NEWLIB)
-*--
-* Test for enough memory for shell
- CALL $SPACEM(SPACE(1),SPACE(2))
- IF (SPACE(2) .LT. 200 000) THEN
- PRINT *, '***ERROR*** Not enough storage available for EDIT'
- +, '. Command rejected'
- RETURN
- ENDIF
-
- IF ( FILE(1:2) .EQ. 'FT' .AND. FILE(5:8) .EQ. 'F001') THEN
-
-*-- EDIT temporary FORTRAN file
-
- MVSCOM( 1)='((CMZ_EDIT)) '//FILE(1:8)
- MVSCOM( 2)='PUT EDITFILE FILE '//FILE(1:8)//' SEQ'
- GOTO 900
- ENDIF
-
-*-- DON'T ADD PREFIX IF THE FIRST CHARACTER OF FILE NAME IS A DOT
-
- IF ( FILE(1:1) .EQ. '.' ) THEN
- CNAME = FILE(2:LENGTH)
- LENGTH = LENGTH - 1
- ELSE
- CALL KPREFI ( PREFIX, NCHPRE )
- CNAME = PREFIX(1:NCHPRE)//FILE
- LENGTH = LENGTH + NCHPRE
- ENDIF
- MVSCOM( 1)='((KU_EDIT)) '''//CNAME(1:LENGTH)//''''
- MVSCOM( 2)='PUT EDITFILE INTO '''//CNAME(1:LENGTH)//''' SEQ'
-
- 900 CALL NEWLIB(MVSCOM, 1)
- MVSCOM( 1)='V OFF OFF'
-* MVSCOM( 2)= already set above
- MVSCOM( 3)='SC EDITFILE'
- MVSCOM( 4)='V ON'
- MVSCOM( 5)='QUIT'
- CALL NEWLIB(MVSCOM,5)
-#endif
-
-999 END
-
-#endif
diff --git a/src/packlib/kuip/code_kuip/kmvspg.F b/src/packlib/kuip/code_kuip/kmvspg.F
deleted file mode 100644
index 94d8e6d..0000000
--- a/src/packlib/kuip/code_kuip/kmvspg.F
+++ /dev/null
@@ -1,60 +0,0 @@
-*
-* $Id: kmvspg.F,v 1.1.1.1 1996/03/08 15:32:55 mclareni Exp $
-*
-* $Log: kmvspg.F,v $
-* Revision 1.1.1.1 1996/03/08 15:32:55 mclareni
-* Kuip
-*
-*
-#include "kuip/pilot.h"
-#if defined(CERNLIB_IBMMVS)
-*CMZ : 2.01/00 25/02/93 10.22.36 by Alfred Nathaniel
-*-- Author :
- SUBROUTINE KMVSPG(FILNAM,LUNO)
-************************************************************************
-* *
-* Called by KUPAD to viewing a file in read-only mode on MVS *
-* *
-************************************************************************
-*
- CHARACTER*(*) FILNAM
-*
-#if !defined(CERNLIB_NEWLIB)
- CALL KMVSED(FILNAM,ISTAT)
-*
-#endif
-#if defined(CERNLIB_NEWLIB)
- CHARACTER*44 CNAME
- CHARACTER*20 PREFIX
- CHARACTER*80 MVSCOM
- INTEGER SPACE(2)
-*
-*
-* Test for enough memory for shell
- CALL $SPACEM(SPACE(1),SPACE(2))
- IF (SPACE(2) .LT. 200 000) THEN
- PRINT *, '***ERROR*** Not enough storage available for SHELL'
- +, '. Command rejected'
- RETURN
- ENDIF
-*-- don't add prefix if the first character of file name is a dot
-
- LENGTH=LENOCC(FILNAM)
- IF ( FILNAM(1:1) .EQ. '.' ) THEN
- CNAME = FILNAM(2:LENGTH)
- LENGTH = LENGTH - 1
- ELSE
- CALL KPREFI ( PREFIX, NCHPRE )
- CNAME = PREFIX(1:NCHPRE)//FILNAM
- LENGTH = LENGTH + NCHPRE
- ENDIF
-
- MVSCOM ='LIST '''//CNAME(1:LENGTH)//''''
-
- CALL NEWLIB(MVSCOM, 1)
-*
-#endif
-*
-999 END
-
-#endif
diff --git a/src/packlib/kuip/code_kuip/kmvssh.F b/src/packlib/kuip/code_kuip/kmvssh.F
deleted file mode 100644
index a8b7d22..0000000
--- a/src/packlib/kuip/code_kuip/kmvssh.F
+++ /dev/null
@@ -1,115 +0,0 @@
-*
-* $Id: kmvssh.F,v 1.1.1.1 1996/03/08 15:32:55 mclareni Exp $
-*
-* $Log: kmvssh.F,v $
-* Revision 1.1.1.1 1996/03/08 15:32:55 mclareni
-* Kuip
-*
-*
-#include "kuip/pilot.h"
-#if defined(CERNLIB_IBMMVS)
-*CMZ : 2.00/16 05/02/93 15.42.20 by Alfred Nathaniel
-*-- Author : Alfred Nathaniel 16/10/92
- SUBROUTINE KMVSSH(CMD)
- CHARACTER*(*) CMD
-*
-* execute a shell command on MVS
-* if CMD.eq.' ' envoke interactive shell
-*
-#if !defined(CERNLIB_NEWLIB)
-* this is a merging of code from KXSHEL and MVSTSO by Michael Dahlinger
- CHARACTER*261 COMMAND
- CHARACTER*16 PARA
-
- DATA PARA / 'PANEL(ISR at PRIM)' /
- DATA NCPARA / 15 /
-
- L=LENOCC(CMD)
- IF (L.GT.0) THEN
-C======================================================================|
-C execute TSO-commands via call to ISPLINK
-C can only be exectued inside ISPF environment
-C M.D. 25/4/91 |
-C======================================================================|
- CALL ISPLINK('CONTROL ','ERRORS ','RETURN ')
- COMMAND = 'CMD('//CMD//')'
- lcmd1=LENOCC(COMMAND)
-C -- get the return code also
- IRET= ISPLNK('SELECT ',lcmd1,COMMAND)
-
- ELSE
-
-*-- IBMMVS = CALL THE ISPF/PDF PRIMARY OPTION MENU
-*-- (PANEL NAME = ISR at PRIM)
-*-- NO COMMAND IS TRANSMITTED
-
-*-- WARNING = ROUTINE ISPLNK IS FOUND IN LIBRARY:
-*-- ISP.V2R2M0.ISPLOAD (STRASBOURG NAME...) WHICH MUST
-*-- BE ADDED AT THE LINK LEVEL
-* return after occurence of error
- ISTAT = ISPLNK ( 'CONTROL' , 'ERRORS' , 'RETURN' )
- IF ( ISTAT .NE. 0 ) THEN
- PRINT *, '*** SYSTEM FAILURE IN CALLING THE ISPF/PDF'
- + , ' CONTROL ERROR RETURN, RC= ', ISTAT
- RETURN
- ENDIF
-
- ISTAT = ISPLNK ( 'SELECT', NCPARA, PARA )
- IF ( ISTAT .NE. 0 .AND. ISTAT .NE. 4 ) THEN
- PRINT *, '*** SYSTEM FAILURE IN CALLING THE ISPF/PDF'
- + , ' PRIMARY OPTION MENU, RC= : ', ISTAT
- RETURN
- ENDIF
-* reset into line mode
- ISTAT = ISPLNK ( 'CONTROL' , 'DISPLAY' , 'LINE' , 1)
- IF ( ISTAT .NE. 0 ) THEN
- PRINT *, '*** SYSTEM FAILURE IN CALLING THE ISPF/PDF'
- + , ' CONTROL DISPLAY LINE 1, RC= ', ISTAT
- RETURN
- ENDIF
- ENDIF
-
-#endif
-#if defined(CERNLIB_NEWLIB)
- CHARACTER*80 MVSCMD(2)
- CHARACTER*80 VARIABLE
- CHARACTER*80 VALUE
- INTEGER NCMDL
- INTEGER IRET
- INTEGER SPACE(2)
-
-* Test for enough memory for shell
- CALL $SPACEM(SPACE(1),SPACE(2))
- IF (SPACE(2) .LT. 200 000) THEN
- PRINT *, '***ERROR*** Not enough storage available for SHELL'
- +, '. Command rejected'
- RETURN
- ENDIF
- NCMDL=1
- L=LENOCC(CMD)
- IF (L.GT.0) THEN
- I=INDEX(CMD,' ')
- IF (I.EQ.0) I=L
- IF (CMD(L:L) .EQ. '\' ) THEN
- CMD(L:L)=' '
- MVSCMD(2)='EXIT'
- NCMDL=2
- ENDIF
- PRINT *,'EXECUTING ... ',CMD(1:L)
- MVSCMD( 1)=CMD
- ELSE
- MVSCMD( 1)='?'
- VARIABLE='SAVE_MEMBER'
- CALL VARGET(VARIABLE,VALUE,IRET)
- IF (IRET.EQ.0 .AND. VALUE .NE. ' ')
- + MVSCMD(1)='CHANGE '//VALUE
- ENDIF
-*--
-*-- NEWLIB is the DESY shell
-*--
- CALL NEWLIB(MVSCMD,NCMDL)
-
-#endif
-
- END
-#endif
diff --git a/src/packlib/kuip/code_kuip/kprefb.s b/src/packlib/kuip/code_kuip/kprefb.s
deleted file mode 100644
index 53468db..0000000
--- a/src/packlib/kuip/code_kuip/kprefb.s
+++ /dev/null
@@ -1,73 +0,0 @@
-*
-* $Id: kprefb.s,v 1.1.1.1 1996/03/08 15:32:53 mclareni Exp $
-*
-* $Log: kprefb.s,v $
-* Revision 1.1.1.1 1996/03/08 15:32:53 mclareni
-* Kuip
-*
-*
-#if defined(CERNLIB_IBMMVS)
-*CMZ : 2.05/02 11/05/94 09.50.52 by Alfred Nathaniel
-*-- Author :
-*
-* KPREFB PROGRAM
-* GIVES SOME JOB CARD PARAMETERS IN BATCH MODE
-*
-* AUTHOR:
-* G. WEIL CENTRE DE CALCUL DE STRASBOURG (CNRS)
-*
-* CALLING SEQUENCE:
-* CALL KPREFB ( JOBID )
-*
-* JOBID CHARACTER*8 = JOB NAME (OUTPUT)
-*
-*
-KPREFB START 0
-R0 EQU 0
-R1 EQU 1
-R2 EQU 2
-R3 EQU 3
-R4 EQU 4
-R5 EQU 5
-R6 EQU 6
-R7 EQU 7
-R8 EQU 8
-R9 EQU 9
-R10 EQU 10
-R11 EQU 11
-R12 EQU 12
-R13 EQU 13
-R14 EQU 14
-R15 EQU 15
-*
- USING *,R12
- SAVE (14,12)
- LR R12,R15
- LR R11,R13
- LA R13,OUTSAVE
- ST R11,4(R13)
- ST R13,8(R11)
-*
- LR R11,R1 LISTE ARGUMENTS
- EXTRACT ADR,'S',FIELDS=TIOT
- L R7,ADR
- USING TIOT1,R7
- L R10,0(R11) ARG JOB ID
- MVC 0(8,R10),TIOCNJOB
-* L R10,4(R11) ARG COMPTA
-* MVC 0(4,R10),TIOCNJOB
-* L R10,8(R11) 3IEM ARGUMENT
-* MVC 0(8,R10),=CL8'DUMMY '
-*
- L R13,4(R13)
- RETURN (14,12),T,RC=0
-*
-ADR DS 2F
-OUTSAVE DS 18F
- PRINT ON,NOGEN
- IKJTCB DSECT=YES,LIST=NO
- IEZJSCB
-TIOTSECT DSECT
- IEFTIOT1
- END
-#endif
diff --git a/src/packlib/kuip/code_kuip/kprefi.F b/src/packlib/kuip/code_kuip/kprefi.F
deleted file mode 100644
index b624446..0000000
--- a/src/packlib/kuip/code_kuip/kprefi.F
+++ /dev/null
@@ -1,87 +0,0 @@
-*
-* $Id: kprefi.F,v 1.1.1.1 1996/03/08 15:32:53 mclareni Exp $
-*
-* $Log: kprefi.F,v $
-* Revision 1.1.1.1 1996/03/08 15:32:53 mclareni
-* Kuip
-*
-*
-#include "kuip/pilot.h"
-#if defined(CERNLIB_IBMMVS)
-*CMZ : 1.68/00 20/02/92 14.32.31 by Fons Rademakers
-*-- Author :
- SUBROUTINE KPREFI(PREFIX, NCHPRE)
-************************************************************************
-* *
-* KPREFI *
-* *
-* KPREFI returns the prefix to be added on each file name. *
-* *
-* PREFIX (C) character string containing prefix (output) *
-* NCHPRE (I) number of characters of prefix (output) *
-* *
-************************************************************************
-*
- LOGICAL INTRAC
-
- CHARACTER*(*) PREFIX
-#if !defined(CERNLIB_GSI)
- CHARACTER*80 USERID
-
- DATA USERID / ' ' /
-#endif
-#if defined(CERNLIB_GSI)
- CHARACTER*8 CUID
-
-#endif
-#if defined(CERNLIB_NEWLIB)
- CHARACTER*16 NAMES
-#endif
-*
-*-- extract the current user id from system information
-*
-#if defined(CERNLIB_NEWLIB)
- CALL JOBNAM(NAMES)
- USERID(1:6)=NAMES
-#endif
-#if (defined(CERNLIB_IBMMVS))&&(!defined(CERNLIB_NEWLIB))&&(defined(CERNLIB_GSI))
- CALL USERID(CUID)
- PREFIX = CUID(1:4)//'.'
- NCHPRE = 5
-#endif
-#if (defined(CERNLIB_IBMMVS))&&(!defined(CERNLIB_NEWLIB))&&(!defined(CERNLIB_GSI))
- IF ( INTRAC(DUMMY) ) THEN
-*-- interactive mode
- NCH = 8
- ISTAT = ISPLNK ( 'VCOPY', '(ZUSER)', NCH, USERID, 'MOVE' )
- IF ( ISTAT .NE. 0 ) THEN
- PRINT *, '*** KPREFI: SYSTEM FAILURE WHEN '
- +, 'EXTRACTING USERID - STATUS ', ISTAT
- IF ( USERID .EQ. ' ' )
- + CALL KDIALO ('PLEASE TYPE YOUR USERID ', USERID, N)
- ENDIF
- ELSE
-*-- batch mode
- CALL KPREFB ( USERID )
- USERID(7:8) = ' '
- ENDIF
-*
-*-- build a prefix starting from the userid
-*
-*-- the following construction is installation dependant
-*-- and function of local file name conventions
-*-- at strasbourg, from userid = 'G057AM', we build
-*-- the prefix = 'G057.KAM.'
-*
- PREFIX = USERID(1:4)//'.K'//USERID(5:6)//'.'
- NCHPRE = 9
-#endif
-#if defined(CERNLIB_NEWLIB)
- PREFIX = USERID(1:6)//'.'
- NCHPRE =7
-#endif
-
- RETURN
- END
-
-#endif
diff --git a/src/packlib/kuip/code_kuip/kudpar.F b/src/packlib/kuip/code_kuip/kudpar.F
deleted file mode 100644
index 42fb8d3..0000000
--- a/src/packlib/kuip/code_kuip/kudpar.F
+++ /dev/null
@@ -1,105 +0,0 @@
-*
-* $Id: kudpar.F,v 1.1.1.1 1996/03/08 15:32:53 mclareni Exp $
-*
-* $Log: kudpar.F,v $
-* Revision 1.1.1.1 1996/03/08 15:32:53 mclareni
-* Kuip
-*
-*
-#include "kuip/pilot.h"
-*CMZ : 1.66/07 05/06/91 17.46.17 by Fons Rademakers
-*-- Author :
- SUBROUTINE KUDPAR(STRING,IPAR,RPAR,CPAR,LENGTH,TYPE)
-*
-********************************************************************************
-*
-* Decode unknown parameter in STRING
-* TYPE returns : 'I' (Integer in IPAR), 'R' (Real in RPAR),
-* 'C' (Character in CPAR of length LENGTH),
-* ' ' (error case)
-*
-* Input :
-*
- CHARACTER*(*) STRING
-*
-* Output :
-*
- INTEGER IPAR
- REAL RPAR
- CHARACTER*(*) CPAR
- INTEGER LENGTH
- CHARACTER*(*) TYPE
-*
-********************************************************************************
-*
-#include "kuip/kcques.inc"
-* CHARACTER*80 CTEMP
- CHARACTER*15 CVALUE
-*
- IF (STRING.EQ.' ') THEN
- LENGTH=0
- CPAR=' '
- TYPE='C'
- GO TO 999
- ENDIF
-
- LENGTH=LENOCC(STRING)
- IF (LENGTH.GT.15) GO TO 200
- DO 5 I=1,LENGTH
- IF (STRING(I:I).NE.' ') GO TO 8
-5 CONTINUE
-8 CVALUE=STRING(I:)
- LENGTH=LENOCC(CVALUE)
-
- DO 10 I=1,LENGTH
- IF ((CVALUE(I:I).NE.'.').AND.
- + (CVALUE(I:I).NE.'+').AND.
- + (CVALUE(I:I).NE.'-').AND.
- + (CVALUE(I:I).NE.'E').AND.
- + (CVALUE(I:I).NE.'e').AND.
- + (CVALUE(I:I).LT.'0'.OR.CVALUE(I:I).GT.'9')) GO TO 200
-10 CONTINUE
-
- DO 20 I=1,LENGTH
- IF (I .EQ. 1) THEN
- IF ((CVALUE(I:I).LT.'0' .OR. CVALUE(I:I).GT.'9') .AND.
- + (CVALUE(I:I).NE.'+' .AND. CVALUE(I:I).NE.'-')) GO TO 100
- ELSE
- IF (CVALUE(I:I).LT.'0'.OR.CVALUE(I:I).GT.'9') GO TO 100
- ENDIF
-20 CONTINUE
-*
-* Case of Integer
-*
- CALL KICTON(CVALUE,IPAR,RPAR)
- IF (IQUEST(1).NE.0.OR.IQUEST(2).NE.0) GO TO 200
- TYPE='I'
- GO TO 999
-*
-* Case of Real
-*
-100 CONTINUE
- CALL KICTON(CVALUE,IPAR,RPAR)
- IF (IQUEST(1).NE.0) GO TO 200
- TYPE='R'
- GO TO 999
-*
-* Case of Character
-*
-200 IQUEST(1)=0
- IF (LENGTH.GT.LEN(CPAR)) THEN
- CALL KUALFA
- PRINT *,'*** KUDPAR: The output character argument CPAR has ',
- + 'been defined with insufficient length =',LEN(CPAR)
- IQUEST(1)=1
- TYPE=' '
- GO TO 999
- ENDIF
- CPAR=' '
- CPAR=STRING
- TYPE='C'
-
-999 END
-
-
-
diff --git a/src/packlib/kuip/code_kuip/kugetv.F b/src/packlib/kuip/code_kuip/kugetv.F
deleted file mode 100644
index dfa5f5b..0000000
--- a/src/packlib/kuip/code_kuip/kugetv.F
+++ /dev/null
@@ -1,57 +0,0 @@
-*
-* $Id: kugetv.F,v 1.1.1.1 1996/03/08 15:32:53 mclareni Exp $
-*
-* $Log: kugetv.F,v $
-* Revision 1.1.1.1 1996/03/08 15:32:53 mclareni
-* Kuip
-*
-*
-#include "kuip/pilot.h"
-*CMZ : 1.64/07 20/09/90 11.37.39 by
-*-- Author :
- SUBROUTINE KUGETV(VNAME,LLOW,LHIGH)
-*
-********************************************************************************
-*
-* Get existing vector from decoded command line
-* If the vector is not existing then LLOW=LHIGH=0
-*
-* The vector VNAME can be accessed by Q(LLOW:LHIGH) if ITYPE=1,
-* or IQ(LLOW:LHIGH) if ITYPE=2
-*
-* It returns also in IQUEST :
-*
-* IQUEST(10) : NCHNAM (number of chars of VNAME)
-* IQUEST(11) : LENTOT (total number of elements of vector)
-* IQUEST(12) : ILOW (low index)
-* IQUEST(13) : IHIGH (high index)
-* IQUEST(14) : ITYPE (type: 1=real, 2=integer, 3=complex)
-* IQUEST(15) : IVEC (vector index, 1<=IVEC<=NUMVEC)
-*
-* IQUEST(20) : ICOPY (if <> 0 a copy on temporary vectory was done,
-* with LENFR and LENTO addresses defined as follow)
-* IQUEST(21) : LENFR(1)
-* IQUEST(22) : LENFR(2)
-* IQUEST(23) : LENFR(3)
-* IQUEST(31) : LENTO(1)
-* IQUEST(32) : LENTO(2)
-* IQUEST(33) : LENTO(3)
-*
-* Output :
-*
- CHARACTER*(*) VNAME
- INTEGER LLOW
- INTEGER LHIGH
-*
-********************************************************************************
-*
- CALL KUGETC(VNAME,NCHNAM)
- CALL KUVECT(VNAME,LLOW,LHIGH)
- IF (LLOW.EQ.0) THEN
- CALL KUALFA
- PRINT *,'*** Unknown vector ',VNAME
- ENDIF
- END
-
-
-
diff --git a/src/packlib/kuip/code_kuip/kuinit.c b/src/packlib/kuip/code_kuip/kuinit.c
deleted file mode 100644
index 0bb51f4..0000000
--- a/src/packlib/kuip/code_kuip/kuinit.c
+++ /dev/null
@@ -1,725 +0,0 @@
-/*
- * $Id: kuinit.c,v 1.7 2003/02/13 14:25:23 couet Exp $
- *
- * $Log: kuinit.c,v $
- * Revision 1.7 2003/02/13 14:25:23 couet
- * - On UNIX platforms, if the variable HOME is not defined it is now set to
- * '/tmp'. The situation where HOME is not defined may occured if PAW was
- * run from a CGI script. In such case we got a "Memory fault" and PAW stoped.
- * This can be emulated by unseting the variable HOME and run PAW.
- *
- * Revision 1.6 1998/04/08 14:05:19 couet
- * - VIDQQ was not used, and was initialised as a wrong "what" string.
- *
- * Revision 1.5 1997/11/25 16:59:01 mclareni
- * Remove WNT EOLs
- *
- * Revision 1.4 1997/10/23 16:53:59 mclareni
- * NT mods
- *
- * Revision 1.3 1997/03/17 16:55:00 mclareni
- * WNT mods
- *
- * Revision 1.2 1996/10/14 09:01:23 cremel
- * Change place of initialization for do_exit and do_quit (from kuwhat to
- * kuinit) in order to allow "exit" in pawlogon.kumac.
- *
- * Revision 1.1.1.1.2.1 1997/01/21 11:32:51 mclareni
- * All mods for Winnt 96a on winnt branch
- *
- * Revision 1.1.1.1 1996/03/08 15:32:58 mclareni
- * Kuip
- *
- */
-/*CMZ : 2.07/06 14/06/95 15.24.50 by Gunter Folger*/
-/*-- Author : Alfred Nathaniel 25/08/92*/
-
-#define EXTERN /* allocate storage for globals */
-#include "kuip/kuip.h"
-#include "kuip/kfor.h"
-#include "kuip/kcom.h"
-#include "kuip/ksig.h"
-#include "kuip/kbrow.h"
-#include "kuip/kmenu.h"
-#include "kuip/kflag.h"
-#include "kuip/klink.h"
-#include "kuip/khash.h"
-#include "kuip/kalias.h"
-
-EXTERN char cdf_def[80], cdf_value[80];
-
-
-
-#ifdef vms
-static int vaxc_rtl_initialized;
-#endif
-
-void F77_ENTRY_I(Kuinit,nwords)
-/* { */
-#ifdef APOLLO
- status_$t istat;
-#endif
- char *host_editor;
- char *host_psviewer;
- char *host_pager;
- char *host_shell;
- char *recall_style;
- char *line;
-
-#ifdef vms
- if( !vaxc_rtl_initialized ) {
- vaxc_rtl_initialized = 1;
- VAXC$CRTL_INIT(); /* init runtime library */
- }
-#endif
-
-#ifdef BROKEN_F77_IO
- /*
- * If the Fortran I/O RTL is not based on the C stream functions
- * we have to switch stdout to line buffered mode because otherwise
- * Fortran and C output would occur out of sequence.
- */
- if( !isatty( fileno(stdin) ) )
- setlinebuf( stdin );
- if( !isatty( fileno(stdout) ) )
- setlinebuf( stdout );
-#endif
-
- /* check assumptions about type definitions */
-#ifndef APOLLO /* avoid compiler warning */
- if( sizeof(int) < 4 )
- printf( " *** KUIP won't work: sizeof(int) < 4\n" );
- if( sizeof(INTEGER) != sizeof(REAL) )
- printf( " *** KUIP won't work: sizeof(INTEGER) != sizeof(REAL)\n" );
-#endif
-
- Kiinit(nwords); /* initialize Fortran part */
-
- Kuidf1();
- Kuidf2();
- Macdef();
-
- kc_alias.arg_table = hash_create( ALIAS_TABLE_SIZE );
- kc_alias.cmd_table = hash_create( ALIAS_TABLE_SIZE );
- kc_alias.global_value = hash_create( ALIAS_TABLE_SIZE );
- kc_alias.global_text = hash_create( ALIAS_TABLE_SIZE );
- kc_alias.var_table = kc_alias.global_value;
- hash_insert( kc_alias.global_value, "@", "0", 0 );
- hash_insert( kc_alias.global_text, "@", "macro return value", 0 );
-
- strcpy( kc_flags.appl_file, "KUIPAPPL.TMP" );
- strcpy( kc_flags.help_file, "KUIPHELP.TMP" );
- strcpy( kc_flags.uhlp_file, "KUIPUHLP.TMP" );
-#ifdef IBMVM
- strcat( kc_flags.appl_file, ".A" );
- strcat( kc_flags.help_file, ".A" );
- strcat( kc_flags.uhlp_file, ".A" );
-#endif
-
-#ifdef WINNT
- if( getenv( "HOME" ) == NULL) /* We should create HOME variable */
- {
- if (getenv( "HOMEPATH" )) putenv( str3dup( "HOME=", getenv( "HOMEDRIVE" ), getenv( "HOMEPATH" ) ) );
- else {
- printf(" The HOME environment variable is not defined. Please, define it ! \n");
- if (getenv("TEMP")) putenv(str2dup("HOME=", getenv("TEMP")));
- else if (getenv("TMP")) putenv(str2dup("HOME=", getenv("TMP")));
- else putenv(str2dup("HOME=","\\"));
- }
- }
-#endif
-
-#ifdef UNIX
- if( getenv( "HOME" ) == NULL) /* We should create HOME variable */
- {
- putenv(str2dup("HOME=","/tmp"));
- }
-#endif
-
-#if defined(UNIX) && ( !defined(MSDOS) || defined(WINNT) )
- {
-
-#ifdef CERNLIB_WINNT
- char *homedir = strdup(getenv( "TEMP" )==NULL ?
- getenv( "HOME" ) : getenv( "TEMP" ));
-#else
- char *homedir = strdup(getenv( "HOME" ));
-#endif
-
- int lasthome = strlen(homedir)-1;
- if (strchr(SLASHES,homedir[lasthome])) homedir[lasthome] = '\0';
- sprintf( kc_flags.appl_file, "%s/kuipappl%d.tmp",
- homedir, (int)getpid() );
- sprintf( kc_flags.help_file, "%s/kuiphelp%d.tmp",
- homedir, (int)getpid() );
- sprintf( kc_flags.uhlp_file, "%s/kuipuhlp%d.tmp",
- homedir, (int)getpid() );
- free(homedir);
- }
-#endif
-#ifdef vms
- sprintf( kc_flags.appl_file, "%sKUIPAPPL%d.TMP;0",
- getenv( "HOME" ), getpid() );
- sprintf( kc_flags.help_file, "%sKUIPHELP%d.TMP;0",
- getenv( "HOME" ), getpid() );
- sprintf( kc_flags.uhlp_file, "%sKUIPUHLP%d.TMP;0",
- getenv( "HOME" ), getpid() );
-#endif
-
-#if defined(UNIX) || defined(vms)
- /* save initial working directory */
- getcwd( kc_flags.init_wdir, (sizeof kc_flags.init_wdir) );
-# ifdef UNIX
- if (!strchr(SLASHES, kc_flags.init_wdir[strlen(kc_flags.init_wdir)-1]))
-# ifdef MSDOS
- strcat( kc_flags.init_wdir, "\\" );
-# else
- strcat( kc_flags.init_wdir, "/" );
-# endif
-# endif
-#endif
-
- kc_flags.real_time = time( NULL );
- kc_flags.user_time = clock();
- Kutim0();
-
-#ifdef APOLLO
- pad_$isa_dm_pad( stream_$stdout, &istat );
- kc_window.is_a_pad = (istat.all == status_$ok);
-#else
- kc_window.is_a_pad = 0;
-#endif
-
-#ifdef IBM370
- kc_window.is_a_tty = 0;
-#else
- kc_window.is_a_tty = (isatty( fileno(stdin) ) && isatty( fileno(stdout) ));
-#endif
-
- ku_exel( "/KUIP/SET_SHOW/BREAK !" );
- ku_exel( "/KUIP/SET_SHOW/COLUMNS -1" );
- ku_exel( "/KUIP/SET_SHOW/DOLLAR 'ON'" );
-
- host_editor = getenv( "KUIPEDITOR" );
- if( host_editor == NULL )
- host_editor = getenv( "EDITOR" );
- if( host_editor == NULL ) {
-#ifdef UNIX
-# ifdef MSDOS
-# ifdef WINNT
- host_editor = "notepad";
-# else
- host_editor = "edit";
-# endif
-# else
- host_editor = "vi";
-# endif
-# ifdef APOLLO
- if( kc_window.is_a_pad )
- host_editor = "DM";
-# endif
-#define _done_
-#endif
-#ifdef vms
- host_editor = "EDT";
-#define _done_
-#endif
-#ifdef IBMMVS
- host_editor = "ISPF_editor";
-#define _done_
-#endif
-#ifdef IBMVM
- host_editor = "XEDIT";
-#define _done_
-#endif
-#ifdef _done_
-#undef _done_
-#else
- host_editor = "EDIT";
-#endif
- }
- line = str3dup( "/KUIP/SET_SHOW/HOST_EDITOR '", host_editor, "'" );
- ku_exel( line );
- free( line );
- ku_exel( "/KUIP/SET_SHOW/HOST_EDITOR 'WINDOW'" );
- ku_exel( "/KUIP/SET_SHOW/HOST_EDITOR 'PAD'" );
-
- host_psviewer = getenv( "KUIPPSVIEWER" );
- if( host_psviewer == NULL )
- host_psviewer = getenv( "PSVIEWER" );
- if( host_psviewer == NULL ) {
-#ifdef UNIX
- host_psviewer = "ghostview";
-#endif
-#ifdef vms
- host_psviewer = "VIEW/FORM=PS/INTERFACE=DECWINDOWS";
-#endif
- }
- line = str3dup( "/KUIP/SET_SHOW/HOST_PSVIEWER '", host_psviewer, "'" );
- ku_exel( line );
- free( line );
-
- host_pager = getenv( "KUIPPAGER" );
- if( host_pager == NULL )
- host_pager = getenv( "PAGER" );
- if( host_pager == NULL ) {
-#ifdef vms
- host_pager = "TYPE/PAGE";
-#else
- host_pager = kc_value.set_host_editor;
-#endif
- }
- line = str3dup( "/KUIP/SET_SHOW/HOST_PAGER '", host_pager, "'" );
- ku_exel( line );
- free( line );
-
-#ifdef UNIX
-# if defined(MSDOS) || defined(CERNLIB_WINNT)
- ku_exel( "/KUIP/SET_SHOW/HOST_PRINTER 'print $*'" );
-# else
- ku_exel( "/KUIP/SET_SHOW/HOST_PRINTER 'lp $*'" );
-# endif
-#else
- ku_exel( "/KUIP/SET_SHOW/HOST_PRINTER 'XPRINT $*'" );
-#endif
-
- host_shell = getenv( "SHELL" );
- if( host_shell == NULL ) {
- host_shell = "sh";
-#if defined(MSDOS) && !defined(WINNT)
- host_shell = "COMMAND.COM";
-#endif
-#ifdef WINNT
- host_shell = "start";
-#endif
-#ifdef IBMVM
- host_shell = "CMS";
-#endif
-#ifdef IBMMVS
- host_shell = "TSO";
-#endif
-#ifdef NEWLIB
- host_shell = "NEWLIB";
-#endif
-#ifdef vms
- host_shell = "DCL";
-#endif
- }
- line = str3dup( "/KUIP/SET_SHOW/HOST_SHELL '", host_shell, "'" );
- ku_exel( line );
- free( line );
-
- ku_exel( "/KUIP/SET_SHOW/PROMPT 'Kuip []'" );
-
- recall_style = "NONE";
- if( kc_window.is_a_tty && !kc_window.is_a_pad ) {
-#ifdef vms
- int setbuff[3];
- short chan;
- struct dsc$descriptor_s ttname;
- var_descriptor( ttname, "TT:" );
- sys$assign( &ttname, &chan, 0, 0 );
- sys$qiow( 0, chan, IO$_SENSEMODE, 0, 0, 0,
- setbuff, (sizeof setbuff), 0, 0, 0, 0 );
- sys$dassgn( chan );
-
- if( setbuff[2] & TT2$M_INSERT )
- recall_style = "DCL";
- else
- recall_style = "DCLO";
-#else
- recall_style = "KSH";
-#endif
- }
- line = str3dup( "/KUIP/SET_SHOW/RECALL_STYLE '", recall_style, "'" );
- ku_exel( line );
- free( line );
-
- ku_exel( "/KUIP/SET_SHOW/RECORDING !" );
- ku_exel( "/KUIP/SET_SHOW/ROOT /" );
- ku_exel( "/KUIP/SET_SHOW/STYLE 'C'" );
- ku_exel( "/KUIP/SET_SHOW/TIMING 'OFF'" );
-
-#ifdef NEWLIB
- ku_exel( "/KUIP/HELP -NOEDIT" );
-#else
- ku_exel( "/KUIP/HELP -EDIT" );
-#endif
-
- ku_exel( "/MACRO/DEFAULTS . 'COMMAND'" );
-
-#ifdef NEWLIB
- ku_exel( "/KUIP/ALIAS/CREATE NEWLIB SHELL C" );
-#endif
-
- kc_window.palette_flag = 0;
-
- kc_flags.do_exit = 0;
- kc_flags.do_quit = 0;
-}
-
-
-/*
- * receive the starting address of /PAWC/
- * the address might not be fixed at link time (dynamic commons on IBM)
- */
-void type_of_call Kipawc( pawc )
- struct COMMON_PAWC *pawc;
-{
- Pawc = pawc;
-}
-
-
-void F77_ENTRY_IC(Fmemcpy,cstr,fstr)
-/* { */
- memcpy( (char*)cstr, fstr, len_fstr );
-}
-
-
-static int main_argc = 0;
-static char **main_argv = NULL;
-
-/*
- * set the program arguments from a C main(argc,argv)
- */
-void k_setar( size_t argc,
- char **argv )
-{
- main_argc = argc;
- main_argv = argv;
-}
-
-
-/*
- * return the program arguments as a string
- */
-char *k_getar()
-{
- static char *args = NULL;
-
- if( args == NULL ) {
-
-#ifdef vms
- /* KGETAR/KUARGS can be called before KUINIT */
- if( !vaxc_rtl_initialized ) {
- vaxc_rtl_initialized = 1;
- VAXC$CRTL_INIT(); /* init runtime library */
- }
-#endif
-
- if( main_argv != NULL ) {
- int i;
- args = strdup( "" );
- for( i = 1; i < main_argc; i++ ) {
- args = mstrcat( args, main_argv[i] );
- if( i+1 < main_argc )
- args = mstrcat( args, " " );
- }
- }
- else {
-
-#ifdef UNIX
-
- INTEGER argc = Kiargc();
- char argv[256];
- INTEGER i;
-
- args = strdup( "" );
- for( i = 1; i <= argc; i++ ) {
- char *p;
-
- F77_CALL_xC(Getarg,&i,argv,(sizeof argv));
- p = fstrdup( argv, (sizeof argv) );
- args = mstrcat( args, p );
- free( p );
- if( i < argc )
- args = mstrcat( args, " " );
- }
-
-#endif
-
-#ifdef vms
- struct dsc$descriptor_s argv_dsc;
- char argv[256];
- short largv;
- int force_prompt = 0;
-
- fix_descriptor( argv_dsc, argv, (sizeof argv) );
- lib$get_foreign( &argv_dsc, NULL, &largv, &force_prompt );
- args = strupper( fstrdup( argv, largv ) );
-#endif
-
-#ifdef IBM370
- char argv[100];
- INTEGER largv = (sizeof argv);
- fstrset( argv, largv, "" );
- F77_CALL_xC(Goparm,&largv,argv,largv);
- args = strupper( fstrdup( argv, largv ) );
-#endif
-
- }
- }
- return args;
-}
-
-
-void F77_ENTRY_C(Kgetar,chline)
-/* { */
- fstrset( chline, len_chline, k_getar() );
-}
-
-
-/*
- * parse the argument string
- */
-void F77_ENTRY_C4I(Kuargs,prgnam,logonf,batchf,logfil,ierror)
-/* { */
- char *prog = fstrdup( prgnam, len_prgnam );
- char *args = str3dup( " ", k_getar(), " " );
- char *bval = NULL;
- char *lval = NULL;
- int nval = 0;
- char *bopt;
- char *lopt;
- char *nopt;
- char *p;
-
- *ierror = 0;
- fstrset( batchf, len_batchf, "" );
- fstrset( logfil, len_logfil, "" );
-
-#ifdef ARG_STYLE_UNIX
- bopt = "-b";
- lopt = "-l";
- nopt = "-n";
-
- if( (p = strstr( args, " -b " )) != NULL ) {
- p += 4;
- while( *p == ' ' )
- p++;
- bval = strdup( p );
- if( (p = strchr( bval, ' ' )) != NULL )
- *p = '\0';
- }
-
- if( (p = strstr( args, " -l " )) != NULL ) {
- p += 4;
- while( *p == ' ' )
- p++;
- lval = strdup( p );
- if( (p = strchr( lval, ' ' )) != NULL )
- *p = '\0';
- }
-
- if( strstr( args, " -n " ) != NULL )
- nval = 1;
-#endif
-
-#ifdef ARG_STYLE_VMS
- bopt = "/BATCH";
- lopt = "/LOGON";
- nopt = "/NOLOG";
- strupper( args );
-
- if( (p = strstr( args, "/BATCH" )) != NULL ) {
- p += 7;
- if( p[-1] != '=' )
- p = input_line( "Batch command file:", '\0' );
- if( p != NULL ) {
- bval = strdup( p );
- if( (p = strchr( bval, ' ' )) != NULL )
- *p = '\0';
- if( (p = strchr( bval, '/' )) != NULL )
- *p = '\0';
- }
- }
-
- if( (p = strstr( args, "/LOGON" )) != NULL ) {
- p += 7;
- if( p[-1] != '=' )
- p = input_line( "Logon command file:", '\0' );
- if( p != NULL ) {
- lval = strdup( p );
- if( (p = strchr( lval, ' ' )) != NULL )
- *p = '\0';
- if( (p = strchr( lval, '/' )) != NULL )
- *p = '\0';
- }
- }
-
- if( strstr( args, "/NOLOG" ) != NULL )
- nval = 1;
-#endif
-
-#ifdef ARG_STYLE_CMS
- bopt = "(BATch";
- lopt = "(LOGon";
- nopt = "(NOLog";
- if( (p = strchr( args, '(' )) == NULL ) {
- args[0] = '\0';
- }
- else {
- strcpy( args, p );
- strupper( args );
- args[0] = ' ';
- }
-
- if( (p = strstr( args, " BAT" )) != NULL ) {
- p += 4;
- if( p[0] == 'C' ) {
- p++;
- if( p[0] == 'H' )
- p++;
- }
- if( p[0] == '=' )
- p++;
- else
- p = "";
- bval = strdup( p );
- if( (p = strchr( bval, ' ' )) != NULL )
- *p = '\0';
- }
-
- if( (p = strstr( args, " LOG" )) != NULL ) {
- p += 4;
- if( p[0] == 'O' ) {
- p++;
- if( p[0] == 'N' )
- p++;
- }
- if( p[0] == '=' )
- p++;
- else
- p = "";
- lval = strdup( p );
- if( (p = strchr( lval, ' ' )) != NULL )
- *p = '\0';
- }
-
- if( (p = strstr( args, " NOL" )) != NULL ) {
- p += 4;
- if( p[0] == 'O' ) {
- p++;
- if( p[0] == 'G' )
- p++;
- }
- if( p[0] == ' ' || p[0] == '\0' )
- nval = 1;
- }
-#endif
-
- if( lval != NULL ) {
- if( bval != NULL ) {
- printf( " %s: Options %s and %s are mutually exclusive\n",
- prog, bopt, lopt );
- *ierror = 1;
- }
- if( nval != 0 ) {
- printf( " %s: Options %s and %s are mutually exclusive\n",
- prog, nopt, lopt );
- *ierror = 1;
- }
- }
-
- if( *ierror == 0 && bval != NULL ) {
- if( bval[0] == '\0' ) {
- printf( " %s: Batch command file expected\n", prog );
- *ierror = 1;
- }
- else {
- FILE *stream;
- p = ku_home( bval, "kumac" );
- free( bval );
- bval = p;
- if( (stream = fopen( bval, "r" )) == NULL ) {
- printf( " %s: Batch command file %s not found\n", prog, bval );
- *ierror = 1;
- }
- else {
- fclose( stream );
- fstrset( batchf, len_batchf, bval );
- p = strrchr( bval, '.' );
- *p = '\0';
- bval = mstrcat( bval, ".log" );
-#ifdef IBMVM
- bval = mstrcat( bval, ".a" );
-#endif
- fstrset( logfil, len_logfil, bval );
- }
- }
- }
-
- if( *ierror == 0 && lval != NULL ) {
- if( lval[0] == '\0' ) {
- printf( " %s: Logon command file expected\n", prog );
- *ierror = 1;
- }
- else {
- FILE *stream;
- p = ku_home( lval, "kumac" );
- free( lval );
- lval = p;
- if( (stream = fopen( lval, "r" )) == NULL ) {
- printf( " %s: Logon command file %s not found\n", prog, lval );
- *ierror = 1;
- }
- else {
- fclose( stream );
- fstrset( logonf, len_logonf, lval );
- }
- }
- }
-
- if( nval != 0 ) {
- /* no logon file wanted */
- fstrset( logonf, len_logonf, "" );
- }
-
- free( prog );
- free( args );
- if( bval != NULL )
- free( bval );
- if( lval != NULL )
- free( lval );
-}
-
-
-/*
- * expand "~" and "$var"
- * add default file extension
- * the pointer returned is allocated
- */
-char *ku_home( const char *fname,
- const char *ftype ) /* default file extension */
-{
- char *path = fexpand( fname, ftype );
-
-#ifdef HPUX
- char *p;
-/*
- * There is a serious performance penalty when accessing an NFS file
- * with a path which involves a symbolic link on the server side.
- * Therefore we resolve all links and remove them from the path.
- */
- p = fsymlink( path );
- free( path );
- path = p;
-#endif
-
- return path;
-}
-
-
-/*
- * expand home directory
- */
-void F77_ENTRY_CI(Kuhome,chpath,lpath)
-/* { */
- char *path = fstrdup( chpath, len_chpath );
- char *new_path = ku_home( path, NULL );
- free( path );
- *lpath = fstrset( chpath, len_chpath, new_path );
- free( new_path );
-}
-
-
diff --git a/src/packlib/kuip/code_kuip/kuinqf.F b/src/packlib/kuip/code_kuip/kuinqf.F
deleted file mode 100644
index a4b783c..0000000
--- a/src/packlib/kuip/code_kuip/kuinqf.F
+++ /dev/null
@@ -1,150 +0,0 @@
-*
-* $Id: kuinqf.F,v 1.1.1.1 1996/03/08 15:32:53 mclareni Exp $
-*
-* $Log: kuinqf.F,v $
-* Revision 1.1.1.1 1996/03/08 15:32:53 mclareni
-* Kuip
-*
-*
-#include "kuip/pilot.h"
-*CMZ : 1.70/00 03/07/92 09.41.39 by Alfred Nathaniel
-*-- Author :
- SUBROUTINE KUINQF(FNAME,LUN)
-*
-********************************************************************************
-*
-* If FNAME<>' ' inquire the existence and open/close status of file FNAME
-* and returns : LUN = -1 if the file does not exist,
-* LUN = 0 if the file exists but is not open,
-* LUN > 0 if the file is open on the logical unit LUN
-*
-* If FNAME=' ' inquire the open/close status of unit LUN
-* and returns : FNAME=' ' if the unit is not used,
-* FNAME<>' ' if the unit is connected to file FNAME
-*
-* IQUEST(11) return the format mode :
-* 1 => 'FORMATTED'
-* 2 => 'UNFORMATTED'
-* 0 => other
-*
-* IQUEST(12) returns the access type :
-* 1 => 'SEQUENTIAL'
-* 2 => 'DIRECT'
-* 0 => other
-*
-* IQUEST(13) return the record length of DIRECT access files.
-*
-* Input/Output :
-*
- CHARACTER*(*) FNAME
- INTEGER LUN
-*
-********************************************************************************
-*
-#include "kuip/kcques.inc"
- CHARACTER*10 ACC
- CHARACTER*11 FRM
- CHARACTER*80 CHFILE
- LOGICAL OPND,EXST
-#if defined(CERNLIB_IBMMVS)
- CHARACTER*8 PREFIX
-#endif
-*
- IQUEST(1)=1
- IQUEST(11)=0
- IQUEST(12)=0
- IQUEST(13)=0
- FRM=' '
- ACC=' '
-*
- IF (FNAME.NE.' ') THEN
-*
-* FNAME given, LUN returned
-*
- LUN=-1
-#if !defined(CERNLIB_IBMVM)
- CHFILE=FNAME
-#endif
-#if defined(CERNLIB_APOLLO)||defined(CERNLIB_UNIX)||defined(CERNLIB_CRAY)
- CALL CUTOL(CHFILE)
-#endif
-#if (defined(CERNLIB_IBMVM))&&(!defined(CERNLIB_IBMMVS))
- CHFILE(:1)='/'
- CHFILE(2:)=FNAME
- NCH=LENOCC(CHFILE)
- IF (INDEX(CHFILE,'.').EQ.0) THEN
- CHFILE(NCH+1:NCH+4)='.DAT'
- NCH=NCH+4
- ENDIF
- DO 5 I=1,NCH
- IF(CHFILE(I:I).EQ.'.')CHFILE(I:I)=' '
-5 CONTINUE
-#endif
-#if defined(CERNLIB_IBMMVS)
-*-- DON'T ADD PREFIX IF THE FIRST CHARACTER OF FILE NAME IS A DOT
- CALL KPREFI ( PREFIX, NCHPRE )
- NCH = LENOCC(FNAME) +1
- CHFILE(:1)='/'
- IF ( FNAME(1:1) .EQ. '.' ) THEN
- CHFILE(2:) = FNAME(2:NCH)
- NCH = NCH -1
- ELSE
- CHFILE(2:) = PREFIX(1:NCHPRE)//FNAME
- NCH = NCH + NCHPRE
- ENDIF
-#endif
- INQUIRE(FILE=CHFILE,IOSTAT=IOS,ERR=999,
- + EXIST=EXST,OPENED=OPND)
- IF (EXST) THEN
- LUN=0
- IF (OPND) THEN
- ACC=' '
- FRM=' '
- INQUIRE(FILE=CHFILE,IOSTAT=IOS,ERR=999,
- + NUMBER=LUN,ACCESS=ACC,FORM=FRM,RECL=LRECL)
- ENDIF
- ENDIF
-*
- ELSE
-*
-* LUN given, FNAME returned
-*
- FNAME=' '
- INQUIRE(LUN,IOSTAT=IOS,ERR=999,
- + EXIST=EXST,OPENED=OPND)
- IF (OPND) THEN
- ACC=' '
- FRM=' '
- INQUIRE(LUN,NAME=FNAME,IOSTAT=IOS,ERR=999,
- + NUMBER=LUN,ACCESS=ACC,FORM=FRM,RECL=LRECL)
-#if defined(CERNLIB_IBMVM)
- CHFILE=FNAME(2:)
- FNAME=CHFILE
-#endif
- ENDIF
-*
- ENDIF
-*
- IQUEST(1)=0
-*
- IF (FRM.EQ.'FORMATTED') THEN
- IQUEST(11)=1
- ELSE IF (FRM.EQ.'UNFORMATTED') THEN
- IQUEST(11)=2
- ELSE
- IQUEST(11)=0
- ENDIF
- IF (ACC.EQ.'SEQUENTIAL') THEN
- IQUEST(12)=1
- ELSE IF (ACC.EQ.'DIRECT') THEN
- IQUEST(12)=2
- IQUEST(13)=LRECL
- ELSE
- IQUEST(12)=0
- ENDIF
-*
-#if defined(CERNLIB_APOLLO)
- IF (LUN.GE.5.AND.LUN.LE.7) FNAME='terminal I/O'
-#endif
-*
-999 END
diff --git a/src/packlib/kuip/code_kuip/kuipcdf.cdf b/src/packlib/kuip/code_kuip/kuipcdf.cdf
deleted file mode 100644
index cd5460d..0000000
--- a/src/packlib/kuip/code_kuip/kuipcdf.cdf
+++ /dev/null
@@ -1,2070 +0,0 @@
-*
-* $Id: kuipcdf.cdf,v 1.5 1997/09/25 14:02:25 cremel Exp $
-*
-* $Log: kuipcdf.cdf,v $
-* Revision 1.5 1997/09/25 14:02:25 cremel
-* VECTOR WRITE (kxwriv.F): increase limitation of number of vectors in the
-* list VLIST from 10 to 30 (same value as in kxreav.F for VECTOR/READ).
-* Update HELP for VECTOR/WRITE and VECTOR/READ and mention explicitely this
-* limitation. Improve error message in kxwriv.F and kxreav.F by
-* adding explicitely VECTOR/WRITE and VECTOR/READ.
-* + Increase KUIP version number to 2.07/16 (25/09/97).
-*
-* Revision 1.4 1997/06/18 11:52:58 couet
-* - default format for V/WRITE changed
-*
-* Revision 1.3 1996/10/08 15:08:14 cremel
-* Modify guidance for command /KUIP/FMESSAGE
-*
-* Revision 1.2 1996/10/08 13:20:01 cremel
-* Add new KUIP command /KUIP/FMESSAGE to write a message string into a file.
-* New corresponding action routine is kxfmessage (C code).
-*
-* Revision 1.1.1.1 1996/03/08 15:32:59 mclareni
-* Kuip
-*
-*
-*CMZ : 2.07/04 12/05/95 17.08.10 by N.Cremel
-*-- Author :
->Name KUIDF1
-
->Menu KUIP
->Guidance
-Command Processor commands.
-
->Command HELP
->Parameters
-+
-ITEM 'Command or menu name or keyword(s)' C D=' '
-OPTION 'Option' C D='N' R='EDIT,NOEDIT,KEYWORD'
--EDIT The help text is written to a file and the editor is invoked,
--E Same as 'EDIT'.
--NOEDIT The help text is output on the terminal output.
--N Same as 'NOEDIT'
--KEYWORD give access to all commands associated to that keyword(s).
--K Same as 'KEYWORD'
-
->Keyword
-FIND keyword search
->Guidance
-Find help information by command name, menu name or keywords.
-.
-If ITEM is a valid command name (and there is only one such command)
-then full explanation on that command is provided: syntax (as given by
-the command USAGE), functionality, list of parameters with their attributes.
-If ITEM also corresponds to other commands associated to it with a "keyword"
-then a "See also" message, followed by the names of these commands
-is given.
-.
-If ITEM is a menu (or a submenu) a dialogue is guiding the user in traversing
-the tree command structure for getting full explanation on a specific
-command from that tree.
-.
-If HELP is entered without parameters, the search start from the top level
-menu and the user is guided in traversing the complete tree command structure.
-.
-'HELP -KEYWORD' (or 'HELP -K') followed by one or more keywords causes HELP
-to give access to all commands associated to that (list of) keyword(s).
-If the keyword corresponds to a valid command or (sub)menu name all
-corresponding commands are accessible. This option is especially useful
-when you do not know the exact name of a valid command or menu and you can
-only describe it by its functionality (e.g. 'HELP -KEYWORD POSTSCRIPT').
-.
-N.B. If ITEM does not correspond to any valid command or menu name then
-the option `-KEYWORD' is automatically invoked.
-.
-'HELP -EDIT' (or just 'CHELP -E') switches to edit mode: instead of writing
-the help text to the terminal output, it is written into a temporary file
-and the pager or editor defined by the command HOST_PAGER is invoked.
-(On Unix workstations the pager can be defined to display the help text
-asynchrously in a separated window.)
-'CHELP -NOEDIT' (or just 'CHELP -N') switches back to standard mode.
-The startup value is system dependent.
-
->Action kxfind%C
-
->Command CHELP
->Parameters
-+
-ITEM 'Command or menu path' C D=' '
-OPTION 'View mode' C D='N'
--EDIT The help text is written to a file and the editor is invoked,
--E Same as 'EDIT'.
--NOEDIT The help text is output on the terminal output.
--N Same as 'NOEDIT'
-
->Guidance
-Find help information only on valid command name or menu path.
-.
-A more general help facility, associated to keywords, is given by
-the command HELP.
-.
-If ITEM is a command its full explanation is given:
-syntax (as given by the command USAGE), functionality,
-list of parameters with their attributes (prompt, type, default, range, etc.).
-If ITEM='/' the help for all commands is given.
-.
-If CHELP is entered without parameters or ITEM is a submenu,
-the dialogue style is switched
-to 'AN', guiding the user in traversing the tree command structure.
-.
-'CHELP -EDIT' (or just 'CHELP -E') switches to edit mode:
-instead of writing the help text to the terminal output,
-it is written into a temporary file and the pager or editor defined
-by the command HOST_PAGER is invoked.
-(On Unix workstations the pager can be defined to display the help text
-asynchrously in a separated window.)
-'CHELP -NOEDIT' (or just 'CHELP -N') switches back to standard mode.
-The startup value is system dependent.
->Action kxhelp%C
-
->Command USAGE
->Parameters
-ITEM 'Command name' C
->Keyword
-help syntax command
->Guidance
-Give the syntax of a command.
-If ITEM='/' the syntax of all commands is given.
->Action kxusage%C
-
->Command MANUAL
->Parameters
-ITEM 'Command or menu path' C
-+
-OUTPUT 'Output file name' C D=' '
-OPTION 'Text formatting system' C D=' '
-- plain text : plain text format
--LATEX LaTeX format (encapsulated)
--TEX LaTeX format (without header)
->Keyword
-LATEX TEX format
-HELP command
->Guidance
-Write on a file the text formatted help of a command.
-If ITEM is a menu path the help for all commands linked to that menu
-is written.
-If ITEM='/' the help for the complete command tree is written.
-If OUTPUT=' ' the text is written to the terminal.
-.
-The output file produced with option LATEX can be processed directly by LaTeX,
-i.e. it contains a standard header defining the meta commands used for
-formatting the document body.
-With option TEX only the document body is written into the output file
-which can be included by a driver file containing customized definitions
-of the standard meta commands.
-Example:
- MANUAL / MAN.TEX LATEX
-will produce the file MAN.TEX containg the documentation of all
-available commands in LaTeX format.
->Action kxmanual%C
-
->Command EDIT
->Parameters
-FNAME 'File name' C
->Keyword
-EDITOR file
->Guidance
-Invoke the editor on the file.
-The command HOST_EDITOR can be used to define the editor.
-.
-If FNAME does not contain an extension the default filetype '.KUMAC'
-is supplied.
-The search path defined by the command DEFAULTS is used to find an
-already existing file.
-If the file does not exist it is created with the given name.
->Action kxedit%C
-
->Command PRINT
->Parameters
-FNAME 'File name' C
->Keyword
-printer
->Guidance
-Send a file to the printer.
-The command HOST_PRINT can be used to define the host command for
-printing the file depending on it file extension.
->Action kxprint%C
-
->Command PSVIEW
->Parameters
-FNAME 'File name' C
->Keyword
-PostScript
-display viewer
->Guidance
-Invoke the PostScript viewer on the file.
-The command HOST_PSVIEWER can be used to define the PostScript viewer.
-.
-If FNAME does not contain an extension the default filetype '.PS'
-is supplied.
->Action kxpsview%C
-
->Command LAST
->Parameters
-+
-N 'N last commands to be saved' I D=-99 R=-99:
-FNAME 'File name' C D=' '
->Keyword
-history file RECORDING RECORD
->Guidance
-Perform various operations with the history file.
-.
-If FNAME is not specified, the current history file is assumed by default
-(the startup history file name is LAST.KUMAC).
-To change the history file the command LAST 0 NEW-FNAME must be entered.
-.
-If N.EQ.-99 (default case) the default host editor is called
-to edit the current history file, containing all the commands of the session.
-.
-If N.LT.0 the last -N commands are printed on the screen.
-On MVS this allows to edit and resubmit commands.
-On workstations this allows to resubmit blocks of commands by mouse-driven
-cut-and-paste operations.
-.
-If N.EQ.0 the history file FNAME is rewound and set as the current one
-(the command LAST 0 FNAME itself is not recorded).
-.
-If N.GT.0 the last N commands of the session are saved in the
-current history file.
-.
-See also the command RECORDING.
->Action kxlast%C
-
->Command MESSAGE
->Parameters
-+
-STRING 'Message string' C D=' ' Separate
->Keyword
-string macro
->Guidance
-Write a message string on the terminal.
-A useful command inside a macro.
-Several message strings can be given in the same command line,
-each of them separated by one or more spaces
-(the usual parameter separator);
-therefore multiple blanks will be dropped
-and only one will be kept.
-If multiple blanks should not be dropped,
-the string must be surrounded by single quotes.
->Action kxmessage%C
-
->Command FMESSAGE
->Parameters
-+
-STRING 'Message string' C D=' ' Separate
-OUTPUT 'Output file name' C D=' '
->Keyword
-string macro file put puts
->Guidance
-Write a message string on OUTPUT file name.
-OUTPUT file is opened in "append" mode (open for writing at end of
-file, or create for writing).
-If OUTPUT=' ' the text is written to the terminal.
-If 'Message string' contains several words separated by one or more
-spaces the string must be surrounded by single quotes.
->Action kxfmessage%C
-
->Command SHELL
->Parameters
-+
-CMD 'Shell command string' C D=' '
->Keyword
-SYSTEM
->Guidance
-Execute a command of the host operating system.
-The command string is passed to the command processor defined by HOST_SHELL.
-If CMD=' ' the shell is spawned as interactive subprocess.
-To return from the shell enter 'RETURN' (the full word, not just <CR>)
-or 'exit' (depending on the operation system).
->Action kxshell%C
-
->Command WAIT
->Parameters
-+
-STRING 'Message string' C D=' '
-SEC 'Number of seconds' R D=0 R=0:
->Keyword
-pause time timing
->Guidance
-Make a pause (e.g. inside a macro).
-Wait a given number of seconds (if SEC.GT.0)
-or just until <CR> is entered (if SEC.EQ.0).
-A message string is also written on the terminal before waiting.
->Action kxwait%C
-
->Command IDLE
->Parameters
-SEC 'Number of seconds' I R=0:
-+
-STRING 'Command string' C D=' '
->Keyword
-keyboard time timing
->Guidance
-Execute a command if program is idle.
-The command string is executed if there was no keyboard activity
-during SEC seconds.
->Action kxidle%C
-
->Command UNITS
->Keyword
-file
->Guidance
-List all Input/Output logical units currently open.
-The files attached to them are also shown.
->Action KXUNIT
-
->Command EXIT
->Guidance
-End of the interactive session.
->Action kxexit%C
-
->Command QUIT
->Guidance
-End of the interactive session.
->Action kxexit%C
-
->Help_item FUNCTIONS
->User_help kxfunclist%C
->Keyword
-SYSTEM DATE TIME MACHINE SHELL
-VDIM VLEN dimension length
-VECTOR
-STRING EXIST
-UPPER LOWER INDEX FORMAT
-SIGMA
->Guidance
-List of all KUIP System Functions.
-.
- *** KUIP System Functions ***
-.
-The function name (and arguments) is literally replaced,
-at run-time, by its current value.
-At present, the following functions are available:
- $DATE ....................... Current date in format DD/MM/YY
- $TIME ....................... Current time in format HH.MM.SS
- $CPTIME ..................... CP time elapsed since last call (in sec)
- $RTIME ...................... Real time elapsed since last call (in sec)
- $VDIM(VNAME,IDIM) ........... Physical length of vector VNAME
- on dimension IDIM (1..3)
- $VLEN(VNAME,IDIM) ........... As above, but for the logical length
- (i.e. stripping trailing zeroes)
- $NUMVEC ..................... Current number of vectors
- $VEXIST(VNAME) .............. Index of vector VNAME
- (1..$NUMVEC or 0 if VNAME does not exist)
- $SUBSTRING(STRING,IX,NCH) ... STRING(IX:IX+NCH-1)
- $UPPER(STRING) .............. STRING changed to upper case
- $LOWER(STRING) .............. STRING changed to lower case
- $LEN(STRING) ................ Length of STRING
- $INDEX(STR1,STR2) ........... Position of first occurrence of STR2 in STR1
- $WORDS(STRING,SEP) .......... Number of words separated by SEP
- $WORD(STRING,K,N,SEP) ....... Extract N words starting at word K
- $QUOTE(STRING) .............. Add quotes around STRING
- $UNQUOTE(STRING) ............ Remove quotes around STRING
- $EXEC('macro args') ......... EXITM value of EXEC call
- $DEFINED('var_name') ........ List of defined macro variables
- $EVAL(Expression) ........... Result of the Expression computed by KUIP
- $SIGMA(Expression) .......... Result of the Expression computed by SIGMA
- $RSIGMA(Expression) .......... As above but a decimal point is added to
- integer results
- $FORMAT(number,format) ...... Format a number according to a Fortran
- format string, e.g.
- $FORMAT(1.5,F5.2) ==> ' 1.50'
- $FORMAT(123,I5.5) ==> '00123'
- $ARGS ....................... Command line at program invocation
- $KEYNUM ..................... Address of latest clicked key in style GP
- $KEYVAL ..................... Value of latest clicked key in style GP
- $LAST ....................... Latest command line executed
- $ANUM ....................... Number of aliases
- $ANAM(I) .................... Name of I-th alias
- $AVAL(I) .................... Value of I-th alias
- $STYLE ...................... Current style as defined by SET/STYLE
- $OS ......................... Operating system name, e.g. UNIX or VMS
- $MACHINE .................... Hardware or Unix brand, e.g. VAX or HPUX
- $PID ........................ Process ID
- $IQUEST(I) .................. Value of IQUEST(I) status vector
- $ENV(var) ................... Value of environment variable
- $FEXIST(file) ............... 1 if file exists or 0 otherwise
- $SHELL(cmd,N) ............... N'th line of shell command output (Unix only)
- $SHELL(cmd,sep) ............. Shell output with newlines replaced by sep
- $SHELL(cmd) ................. Same as $SHELL(cmd,' ')
-
->Name KUIDF2
-
->Menu /KUIP
-
->Menu ALIAS
->Guidance
-Operations with aliases.
-Aliases are defined to provide shortcut abbreviations for the input line or
-some part of it.
-When encountered on an input line an alias is replaced by its
-string value which can contain further aliases.
-(Be careful not to define recursive aliases.)
-.
-To juxtaposition aliases, a double slash can be used as concatenation sign.
-Inside quoted strings and for the ALIAS commands themselves
-the alias substitution is inhibited.
-Otherwise
- ALIAS/CREATE ALPHA BETA
- ALIAS/CREATE ALPHA BETA
-whould create an recursive alias BETA and
- ALIAS/CREATE ALPHA BETA
- ALIAS/CREATE BETA GAMMA
- ALIAS/DELETE ALPHA
-would delete the alias name BETA instead of ALPHA itself.
-
->Command CREATE
->Parameters
-NAME 'Alias name' C
-VALUE 'Alias value' C
-+
-CHOPT 'Option' C D=A
--A create an Argument alias
--C create a Command alias
--N No alias expansion of value
->Guidance
-Create an alias NAME which should be substituted by VALUE.
-An alias name is a sequence of letters and digits starting with a letter.
-The underscores ('_'), the at-sign ('@') and the dollar-sign ('$')
-count as letters.
-.
-There are two types of aliases:
-Command aliases are recognized only if they occur in the command position,
-i.e. as the first token on the line.
-Argument aliases are recognized anywhere on the command line
-(except inside quoted strings)
-if they are surrounded by one of the following separators:
- blank / , = : . % ' ( )
-.
-Also switch ON the alias translation, i.e. ALIAS/TRANSLATION ON.
-If CHOPT='C' then the alias is a command alias, i.e. an alias that
-will only be translated when it is the first token on a command line.
-Example:
- Alias/Create GG Graph/Struct/Scratch
- Alias/Create FF File1/Name1/Name2
- GG FF/ID
-is equivalent to
- Graph/Struct/Scratch File1/Name1/Name2/ID
-.
- Alias/Create LS DIR C
-is equivalent to
- DIR
-only when LS is the first token on a command line.
-In the following case LS will not be translated
- SHELL LS
-.
-Aliases occuring inside an value are expanded indepedent whether the value
-is enclosed by quotes.
-The option -N allows to suppress this implicit alias expansion.
->Action kxacreate%C
-
->Command LIST
->Parameters
-+
-NAME 'Alias name wildcard' C D='*'
->Guidance
-List all aliases matching the wildcard (names and values).
->Action kxalist%C
-
->Command DELETE
->Parameters
-NAME 'Alias name wildcard' C Loop
->Guidance
-Delete the definition of aliases matching the wildcard.
-NAME='*' deletes all aliases.
->Action kxadelete%C
-
->Command TRANSLATION
->Parameters
-+
-OPTION 'Option' C D='ON'
--? show current setting
--ON switch alias translation ON
--OFF switch alias translation OFF
->Guidance
-Switch ON/OFF the alias translation.
-If OFF, alias definitions are not used in parsing the command lines.
-It is automatically switched ON when an alias is created.
-If OPTION='?' the current value is shown.
-The startup value is OFF.
->Action kxatranslation%C
-
->Menu ../SET_SHOW
->Keyword
-SHOW
->Guidance
-Set or show various KUIP parameters and options.
-
->Command STYLE
->Parameters
-+
-OPTION 'Option' C D='?'
--? show current style
--C Command line : select Command line input
--AN Menu with Numbers :_
- select general Alpha menu (with Numbers)
--AL Menu with Letters :_
- select general Alpha menu (with Letters)
--G Graphics menu hardware :_
- select Graphics menu (with hardware character fonts)
--GW Graphics menu shadowed :_
- select Graphics menu (with shadowed Width effect)
--GS Graphics menu Software :_
- select Graphics menu (with Software character fonts)
--GP Panel keys :_
- select Graphics menu (with Panel keys only, i.e. no command tree menu)
--XM Motif/X11 :_
- select Motif/X11 interface
-SGYLEN 'max Y LENgth of each menu item box' R D=0.025 R=0.005:0.25
-SGSIZE 'space available for the application' R D=0.8 R=0:0.90
-SGYSPA 'max Y length of space between menus' R D=0.02 R=-0.5:0.50
-SGBORD 'X or Y border for menus' R D=0.015 R=0:0.25
-WKTYPE 'Graphics workstation type' I D=0
-
->Keyword
-dialog mode
->Guidance
-Select the user dialog style (or working mode).
-The startup value is 'C' (command mode).
-The current value is returned by the system function $STYLE.
-.
-The G-styles are only available
-if the application program is calling KUWHAG instead of KUWHAT.
-When one of these options is choosen
-the remaining parameters control the geometrical layout
-of the menus on the screen and
-the graphics workstation type (in case HIGZ was not initialized).
-.
-Style 'XM' is only available if the program is calling KUWHAM.
-In that case switching to other styles is not possible.
->Action kxstyle%C
-
->Command PANEL
->Parameters
-LINE 'Line number' R D=0
-+
-GKEY 'Graphics key value(s)' C D=' '
->Keyword
-interface command key pixmap graphics Motif
-STYLE
->Guidance
-Set up a (user-definable) panel of commands with graphics keys.
-These keys are associated to pre-defined commands (or list of commands),
-which are generally corresponding to actions frequently executed.
-.
-The "panel interface" is available in "STYLE GP" and in KUIP/Motif
-(but not in the basic command mode). Nevertheless the syntax of
-the PANEL command is different in these two modes of interface.
-The "panel interface" is a lot more powerful in KUIP/Motif,
-which means that the command is more complex.
-.
-N.B. in "STYLE GP" only one panel of commands can be set up,
-whereas in KUIP/Motif there is no limitation.
-.
-Syntax of the command in "STYLE GP" :
-.
- PANEL x.y command
-.
- where:
- x,y is the key position (column and row number)
- command is the complete command name (or list of commands)
- to be excuted when the button is pressed.
-.
-Examples:
- PANEL 0 | reset the panel (in memory)
- PANEL 2.04 MESSAGE | initialize 4th key of 2nd line to MESSAGE
- PANEL 2.04 | clear 4th key of 2nd line
-Note that the key number on the right of the decimal point must
-always be defined with two digits.
-.
-Keys ending with a minus sign make an additional request of keyboard input;
-the complete command line will be the key text, with a blank at the place
-of the minus, concatenated with the additional keyboard input. Example:
- PANEL 1.03 'VEC/PRI-' | entering VAB will execute VEC/PRI VAB.
-Keys ending with a double minus sign behave as above but no blank is put
-at the place of the double minus. Example:
- PANEL 1.03 'VEC/PRI V--' | entering AB will execute VEC/PRI VAB
-The dollar sign inside a key is replaced by additional keyboard input. Example:
- PANEL 1.03 'VEC/PRI V($)' | entering 11:20 will execute VEC/PRI V(11:20)
-.
-Syntax of the command in "KUIP/Motif" :
-.
-All what is described above (for "STYLE GP") is still available.
-But the (more) general syntax in "KUIP/Motif" is:
-.
- PANEL x.y command [label] [pixmap]
-.
- where:
- x,y is the key position (column and row number)
- command is the complete command name (or list of commands)
- to be excuted when the button is pressed.
- label (optional) is an alias name for this command. If specified,
- it is used for the button label (when the appropriate
- "View" option is selected) instead of the complete
- command (which is generally too long for a "user-friendly"
- button label.
- pixmap (optional) has to be specified when you want to have graphical keys
- instead of pure text labels.
-.
-In KUIP/Motif, the special value "0" for x.y (PANEL 0 ...) can be used
-for different purposes (according to the 2nd parameter value):
-.
- PANEL 0 D [title] [geometry]
-.
-can be use to display the current panel which is in memory with
-(optionals) a given title and geometry (size and position).
-.
- PANEL 0 C [title]
-.
-can be use to close the last panel, or the one corresponding to
-the given title.
-.
-Examples:
- - PANEL 0 D 'This is my first panel' 500x300+500+600
-displays the panel which has been set in memory by the key definition,
-and sets the title to ``This is my first panel'', the window size to
-``500x300'' (WxH) and the window position to ``500 600'' in x and y.
-If no title and/or no geometry is specified one is given by default.
-
- - PANEL 0 C 'This is my first panel'
-closes (destroys and erases from the screen) the panel whith title
-``This is my first panel''.
-If no title is specified the last created panel is closed by default.
-.
-As the "panel interface" is rather complex and powerful in KUIP-Motif,
-if you want to know all the possibilities, we invite you to refer to
-the KUIP User Guide (where you will also find picture illustrations).
->Action kxpanel%C
-
-
->Command NEWPANEL
->Parameters
-LINE 'Number of lines' I D=5 R=1:30
-COL 'Number of columns' I D=5 R=1:30
-TITLE 'Panel Title' C D='NewPanel'
-WIDTH 'Panel width (in pixels)' I D=300 R=10:
-HEIGHT 'Panel height (in pixels)' I D=300 R=10:
-XPOS 'X Position (in pixels)' I D=0 R=0:
-YPOS 'Y Position (in pixels)' I D=0 R=0:
->Keyword
-panel
->Guidance
-Set up a new panel with empty keys.
-This new panel must then be filled interactively.
-
->Action kxnewpan%C
-
->Command COMMAND
->Parameters
-+
-CHPATH 'Path name for command line' C D=' '
->Keyword
-filter
->Guidance
-Set a filter for the parsing of command lines.
-If it has been called, it means that whenever a command line is entered,
-if and only if it is not an existing command (not just ambiguous),
-it is inserted into the CHPATH string, with $n (n=1..9) being replaced
-by the n-th token of the command (tokens are separated by spaces),
-or $* being replaced by the whole command line. Examples:
- COMMAND 'V/CR $*(10)'
- AA => V/CR AA(10)
- BB => V/CR BB(10)
- V/LIST => V/LIST
-.
- COMMAND 'VECTOR/PLOT $1 555 $2'
- AA E => VECTOR/PLOT AA 555 E
- BB => VECTOR/PLOT BB 555
-.
- COMMAND => shows its current value
- COMMAND * => reset (equivalent to COMMAND $*)
-Note that COMMAND and subsequent command lines can be used inside macros,
-excepted when producing macro statements (like EXEC, IF, GOTO, etc.).
-For example, the above examples would work also inside macros, while
-COMMAND 'EXEC $*' or COMMAND 'GOTO $1' will not.
->Action kxcommand%C
-
->Command APPLICATION
->Parameters
-PATH 'Application name' C D=' '
-+
-CMDEX 'Exit command' C D='EXIT'
->Guidance
-Set the application name.
-This means that all input lines will be concatenated to the string PATH
-(until the command specified by the parameter CMDEX is executed,
-which resets the application to the null string). The value of CMDEX
-may be specified if the default value EXIT has to be changed
-(i.e. because already used by the application).
-APPLICATION can also be inserted in a macro: in this case at least
-4 characters must be specified (i.e. APPL).
->Action kxapplication%C
-
->Command ROOT
->Parameters
-+
-PATH 'Root directory' C D='/'
->Keyword
-command search searching
->Guidance
-Set the root for searching commands.
-If PATH='?' the current root is shown.
-This allows to access commands regardless of possible
-ambiguities with different menus.
-Commands are first searched starting from the current root:
-if a command is found it is executed.
-Only if a command is not found a second pass of search is done,
-starting now from the top root of the command tree (i.e. '/').
->Action kxroot%C
-
->Command TIMING
->Parameters
-+
-OPTION 'Option' C D='ON' R='ON,OFF,ALL'
->Keyword
-time
->Guidance
-Set ON/OFF/ALL the timing of commands.
-If ON, the real time and the CPU time for the latest
-executed command (or macro) are presented.
-If ALL, the time is shown for each command being executed within a macro.
-The startup value is OFF.
->Action kxtiming%C
-
->Command PROMPT
->Parameters
-PROMPT 'Prompt string' C D=' '
->Guidance
-Set the prompt string for the command mode dialogue.
-If PROMPT is blank the current prompt is left unchanged.
-If PROMPT contains the character sequence '[]'
-the current command number is inserted between the square brackets.
->Action kxprompt%C
-
->Command BREAK
->Parameters
-+
-OPTION 'Option' C D='ON' R='ON,OFF,TB,?'
->Keyword
-keyboard interrupt interruption macro
->Guidance
-Set ON/OFF the break handling.
-If OPTION='?' the current value is shown.
-The startup value is ON.
-.
-Hitting the keyboard interrupt (CTRL/C on VMS or CTRL/Q on the Apollo)
-under break ON condition, the current command or macro execution
-will be interrupted and the user will get again the application prompt.
-.
-BREAK TB switch ON the traceback of the routines called, with their
-line numbers, when an error occurs. This allows the detection of
-the routines which provoked the error.
->Action kxbreak%C
-
->Command COLUMNS
->Parameters
-+
-NCOL 'Number of columns for terminal output' I D=80 R=-1:
->Guidance
-Set the maximum number of columns for terminal output.
-If NCOL=0 the current number of columns is shown.
-If NCOL=-1 the current number of columns is taken from the environment
-variable COLUMNS.
-If COLUMNS is undefined the startup value is 80.
->Action kxcolumns%C
-
->Command RECORDING
->Parameters
-+
-NREC 'Rate for recording on history file' I D=25 R=0:
->Keyword
-RECORD history file LAST
->Guidance
-Set the recording rate for the history file.
-Every NREC commands of the session the current history file is updated.
-If NREC=0 the history is not kept at all (i.e. the file is not written).
-See also the command LAST.
->Action kxrecording%C
-
->Command HOST_EDITOR
->Parameters
-+
-EDITOR 'Host editor command' C D='?'
-TOP 'Top position of the edit window' I D=20 R=0:
-LEFT 'Left position of the edit window' I D=20 R=0:
-WIDTH 'Width of the edit window' I D=0 R=0:
-HEIGHT 'Height of the edit window' I D=0 R=0:
-DXPAD 'X offset for help PAD windows' I D=30 R=0:
-DYPAD 'Y offset for help PAD windows' I D=20 R=0:
-NPADS 'Maximum number of shifted pads' I D=4 R=1:
->Keyword
-EDITOR edit vi emacs TPU EDIT
->Guidance
-Set the host command to invoke the editor.
-The EDIT command will invoke this editor.
-If EDITOR='?' the current host editor command is shown.
-.
-On Apollo the special value EDITOR='DM' invoke Display Manager pads.
-The special values EDITOR='WINDOW' and 'PAD' can be used to specify
-the window positions (in pixel units).
-'WINDOW' defines the parameters for edit pads,
-while 'PAD' defines the parameters for read-only pads
-(e.g. used by 'HELP -EDIT').
-.
-On VMS the special values EDITOR='EDT' and 'TPU' invoke the callable
-editors.
-The startup time is considerably lower compared to spawning the editor
-as a subprocess.
-The callable EDT has one disadvantage though:
-after an error, e.g. trying to edit a file in a non-existing directory,
-subsequent calls will always fail.
-The TPU call can be augmented by command line options, e.g.
- HOST_EDITOR TPU/DISP=DECW | DECwindow interface to EVE
-.
-On Unix a variety of editors are available, e.g.
- HOST_EDITOR vi
- HOST_EDITOR 'emacs -geometry 80x48'
-.
-On Unix workstations it is possible to do asynchronous editing
-via the KUIP edit server,
-i.e. to start an editor in a separate window while the application
-can continue to receive commands.
-In order to do that the following conditions must be fulfilled:
- - The KUIP edit server 'kuesvr' must be found in the search path.
- - The editor command set by HOST_EDITOR must end with an ampersand ('&').
- - The environment variable 'DISPLAY' must be set.
-.
-The ampersand flags your intention to use the edit server if possible.
-If the edit server cannot be used the ampersand will be ignored,
-i.e. even with
- HOST_EDITOR 'vi &'
-the KUIP/EDIT command will block until the editor terminates
-if either the 'kuesvr' is not available or 'DISPLAY' is undefined.
-When using the edit server the editor command is expected to create
-its own window.
-'vi' being a frequent choice, the above command is automatically
-interpreted as
- HOST_EDITOR 'xterm -e vi &'
-.
-The startup value can be defined by the environment variable 'EDITOR'.
-Otherwise it is set to a system dependent default:
-'DM' (Apollo), 'EDT' (VMS), 'XEDIT' (VM/CMS), 'vi' (Unix).
->Action kxhosteditor%C
-
-
->Command HOST_PAGER
->Parameters
-+
-PAGER 'Host pager command' C D='?'
->Keyword
-PAGER view read more
->Guidance
-Set the host command to view a file in read-only mode.
-If OPTION='?' the current host pager command is shown.
-The 'HELP -EDIT' command will invoke this pager, e.g.
- HOST_PAGER more
-.
-On Unix workstations the pager can be asynchronous by creating a
-separate window, e.g.
- HOST_PAGER 'xterm -e view &'
- HOST_PAGER 'ved &'
-.
-On Apollo the special value PAGER='DM' defines the use of
-Display Manager read-only pads.
-The pad positions can be adjusted by the HOST_EDITOR command.
-.
-The startup value can be defined by the environment variables
-'KUIPPAGER' or 'PAGER'.
-If neither of them is defined the value set by the HOST_EDITOR command
-is used.
-On VAX/VMS the startup value is 'TYPE/PAGE'.
->Action kxhostpager%C
-
-
->Command HOST_PRINTER
->Parameters
-+
-COMMAND 'Host printer command' C D='?'
-FILETYPE 'File extension' C D=' '
->Keyword
-PRINTER PRINT
->Guidance
-Set the host commands for printing files with KUIP/PRINT.
-The KUIP/PRINT command will use the host command matching the file
-extension or use the default command defined for FILETYPE=' '.
-.
-If COMMAND='?' the currently set commands are shown.
-If COMMAND=' ' the currently defined command is delete.
-The command string can contain '$*' and '$-' to indicate the position
-where the file name with/without file extension should be inserted.
-For example,
-
- MANUAL / refman.tex latex
- HOST_PRINTER 'latex $* ; dvips $-' .tex
- KUIP/PRINT refman.tex
-
-invokes the shell command 'latex refman.tex ; dvips refman'.
-The predefined defaults are not guaranteed to work
-since the actual print commands are very much installation dependent.
-
->Action kxhostprinter%C
-
-
->Command HOST_PSVIEWER
->Parameters
-+
-PSVIEWER 'Host PostScript Viewer command' C D='?'
->Keyword
-PSVIEWER PostScript viewer
->Guidance
-Set the host command to invoke the PostScript Viewer.
-The PSVIEW command will invoke this PostScript Viewer.
-If PSVIEWER='?' then the current viewer command is shown.
-.
-The startup value can be defined by the environment variables
-'KUIPPSVIEWER' or 'PSVIEWER'.
-.
-On Unix workstations it is by default set to 'ghostview'.
-On VAX/VMS the default commands is 'VIEW/FORM=PS/INTERFACE=DECWINDOWS'.
-
->Action kxhostpsviewer%C
-
-
->Command HOST_SHELL
->Parameters
-+
-SHELL 'Host shell command' C D='?'
->Keyword
-SHELL
->Guidance
-Set the default host shell invoked by the KUIP/SHELL command.
-If OPTION='?' the current host shell is shown.
-The startup value is taken from the 'SHELL' environment variable.
-
->Action kxhostshell%C
-
-
->Command RECALL_STYLE
->Parameters
-+
-OPTION 'Command recall and editing style' C D=?
--? show current setting
--KSH Korn shell : Emacs like command line editing
--KSHO Korn shell + Overwrite : like 'KSH' but overwrite instead of insert mode
--DCL VAX/VMS DCL : DCL command line editing
--DCLO VAX/VMS DCL + Overwrite : like 'DCL' but overwrite instead of insert mode
--NONE disable command line editing
->Keyword
-STYLE mode
->Guidance
-Set the command recall and editing style.
-If OPTION='?' the current style is shown.
-The startup value is 'DCL' on VAX/VMS, 'NONE' on Cray and Apollo DM pads,
-and 'KSH' on other systems.
-.
-If the terminal emulator returns ANSI escape sequences (hpterm doesn't!)
-the up/down arrow keys can be used to recall items from the command history
-list and the left/right arrow keys to move the cursor.
-.
-'KSH' style provides the following control keys for editing:
- ^A/^E : Move cursor to beginning/end of the line.
- ^F/^B : Move cursor forward/backward one character.
- ^D : Delete the character under the cursor.
- ^H, DEL : Delete the character to the left of the cursor.
- ^K : Kill from the cursor to the end of line.
- ^L : Redraw current line.
- ^O : Toggle overwrite/insert mode. Text added in overwrite mode
- (including yanks) overwrites existing text, while insert mode
- does not overwrite.
- ^P/^N : Move to previous/next item on history list.
- ^R/^S : Perform incremental reverse/forward search for string on
- the history list. Typing normal characters adds to the
- current search string and searches for a match. Typing
- ^R/^S marks the start of a new search, and moves on to
- the next match. Typing ^H or DEL deletes the last
- character from the search string, and searches from the
- starting location of the last search.
- Therefore, repeated DELs appear to unwind to the match
- nearest the point at which the last ^R or ^S was typed.
- If DEL is repeated until the search string is empty the
- search location begins from the start of the history
- list. Typing ESC or any other editing character accepts
- the current match and loads it into the buffer,
- terminating the search.
- ^T : Toggle the characters under and to the left of the cursor.
- ^U : Kill from the prompt to the end of line.
- ^Y : Yank previously killed text back at current location.
- Note that this will overwrite or insert, depending on
- the current mode.
- TAB : By default adds spaces to buffer to get to next TAB stop
- (just after every 8th column).
- LF, CR : Returns current buffer to the program.
-.
-'DCL' style provides the following control keys for editing:
- BS/^E : Move cursor to beginning/end of the line.
- ^F/^D : Move cursor forward/backward one character.
- DEL : Delete the character to the left of the cursor.
- ^A : Toggle overwrite/insert mode.
- ^B : Move to previous item on history list.
- ^U : Delete from the beginning of the line to the cursor.
- TAB : Move to next TAB stop.
- LF, CR : Returns current buffer to the program.
->Action kxrecallstyle%C
-
->Command VISIBILITY
->Parameters
-CMD 'Command name' C D=' '
-+
-CHOPT '?, OFF, ON' C D='?' R='?,OFF,ON'
->Guidance
-Set or show the visibility attributes of a command.
-.
-If CHOPT='OFF':
- - the command it is not executable anymore
- - STYLE G draws a shadowed box on the command
- - HELP may be still requested on the command
-The startup value is ON.
->Action kxvisibility%C
-
->Command DOLLAR
->Parameters
-+
-OPTION 'Substitution of environment variables' C D=?
--? show current setting
--ON enable substitution
--OFF disable substitution
->Keyword
-environment variable substite substitution
->Guidance
-Set or show the status of environment variable substitution.
-.
-This command allows to enable/disable the interpretation of
-environment variables in command lines.
-The startup value is 'ON', i.e. "$var" is substituted by the variable value.
-.
-Note that the system function "$ENV(var)" allows using environment variables
-even for 'DOLLAR OFF' .
-
->Action kxdollar%C
-
-
->Command FILECASE
->Parameters
-+
-OPTION 'Case conversion for filenames' C D=?
--? show current setting
--KEEP filenames are kept as entered on the command line
--CONVERT filenames are case converted
--RESTORE restore previous FILECASE setting
->Keyword
-FILE filename name conversion Case upper lower
->Guidance
-Set or show the case conversion for filenames.
-.
-This command has only an effect on Unix systems to select whether filenames
-are kept as entered on the command line.
-The startup value is 'CONVERT', i.e. filenames are converted to lowercase.
-.
-On other systems filenames are always converted to uppercase.
-.
-The 'RESTORE' option set the conversion mode to the value effective
-before the last FILECASE KEEP/CONVERT command.
-E.g. the sequence
- FILECASE KEEP; EDIT Read.Me; FILECASE RESTORE
-forces case sensitivity for the EDIT command and restores the previous mode
-afterwards.
-
->Action kxfilecase%C
-
->Command LCDIR
->Parameters
-+
-DIR*ECTORY 'Directory name' C D=' '
->Keyword
-Directory dir
->Guidance
-Set or show the local working directory.
-.
-The current working directory is set to the given path name or the
-current directory is shown.
-.
-To show the current directory used LCDIR without argument.
-'LCDIR ~' switches to the home directory.
-'LCDIR .' switches back to the working directory at the time
-the program was started.
-
->Action kxlcdir%C
-
->Name MACDEF
-
->Menu MACRO
->Guidance
-Macro Processor commands.
-
->Command EXEC
->Parameters
-MNAME 'Macro name' C
-+
-MARGS 'Macro arguments' C D=' ' Separate
->Guidance
-Execute the command lines contained in the macro MNAME.
-As a file can contain several macros, the character '#' is
-used to select a particular macro inside a file as explained below.
-.
-If MNAME does not contain the character '#', the file MNAME.KUMAC
-is searched and the first macro is executed (it may be an unnamed
-macro if a MACRO statement is not found as first command line in the file).
-.
-If MNAME is of the form FILE#MACRO, the file named FILE.KUMAC is searched
-and the macro named MACRO is executed.
-.
-Examples:
- EXEC ABC to exec first (or unnamed) macro of file ABC.KUMAC
- EXEC ABC#M to exec macro M of file ABC.KUMAC
-.
-The command MACRO/DEFAULTS can be used to define a directory search path
-for macro files.
->Action kxmexec%C
-
->Command LIST
->Parameters
-+
-MNAME 'Macro name pattern' C D=' '
->Guidance
-List all macros in the search path defined by MACRO/DEFAULTS.
-Macros are files with the extension KUMAC.
-MNAME may be specified to restrict the list to the macros
-containing such a string in the first part of their name.
-For example,
- MACRO/LIST ABC
-will list only macros starting with ABC.
->Action kxmlist%C
-
->Command TRACE
->Parameters
-+
-OPTION 'Option' C D='ON' R='ON,OFF'
-LEVEL 'Level' C D=' ' Option
--
--TEST
--WAIT
--FULL
--DEBUG
->Keyword
-DEBUG
->Guidance
-Set ON/OFF the trace of commands during macro execution.
-If TRACE='ON' the next command is written on the terminal
-before being executed.
-If LEVEL='TEST' the command is only echoed but not executed.
-If LEVEL='WAIT' the command WAIT is automatically inserted
-after the execution of each command.
-The startup values are OPTION='OFF' and LEVEL=' '.
->Action kxmtrace%C
-
->Command DEFAULTS
->Parameters
-+
-PATH 'Search path for macro files' C D='?'
-OPTION 'Automatic EXEC' C D='?'
--? show current setting
--Command search for commands only
--C same as 'Command'
--Auto search for commands before macros
--A same as 'Auto'
--AutoReverse search for macros before commands
--AR same as 'AutoReverse'
->Guidance
-Set or show MACRO search attributes.
-.
-On Unix and VMS systems
-PATH defines a comma separated list of directories in which the commands
-KUIP/EDIT, MACRO/EXEC, and MACRO/LIST search for macro files.
-For example,
-
- MACRO/DEFAULT '.,macro,~/macro' | Unix
-
- MACRO/DEFAULT '[],[.macro],[macro]' | VMS
-
-defines to search files first in the current directory,
-then in the subdirectory 'macro' of the current directory,
-and last the subdirectory 'macro' of the home directory.
-.
-On VM/CMS system PATH defines a comma separated list of filemodes.
-E.g.
-
- MACRO/DEFAULT '*' | search all disks
- MACRO/DEFAULT 'A,C' | search only disks A and C
-.
-If PATH='?' the currently defined search path is shown.
-If PATH='.' the search path is undefined, i.e. files are search for
-in the current directory (A-disk on VM/CMS) only.
-The startup value is PATH='.'.
-.
-The search path is not applied if the file specification already
-contains an explicit directory path or if it starts with a '-'
-character (which is stripped off).
-.
-OPTION allows to define whether macros can be invoked by their name only
-without prepending the KUIP/EXEC command:
- DEFAULT -Command
- CMD | CMD must be a command
- DEFAULT -Auto
- CMD | if CMD is not a command try EXEC CMD
- DEFAULT -AutoReverse
- CMD | try EXEC CMD first; if not found try command CMD
-The startup value is 'Command' (also reset by PATH='.').
-.
-Important note:
-.
-Inside macros the DEFAULT -A (or -AR) logic is disabled, i.e.
-DEFAULT -C is always assumed.
->Action kxmdefaults%C
-
->Command DATA
->Keyword
-Application file
->Guidance
-Application command to store immediate data into a file.
-Example:
-
- Application DATA vec.dat
- 1 2 3
- 4 5 6
- 7 8 9
- vec.dat
- vec/read x,y,z vec.dat
-
->Action kxmdata%C
-
-
->Menu GLOBAL
->Guidance
-Operations on global variables.
-
->Command CREATE
->Parameters
-NAME 'Variable name' C Loop
-+
-VALUE 'Initial value' C D=' '
-TEXT 'Comment text' C D=' '
->Keyword
-variable
->Guidance
-Create a global variable.
-.
-If used inside a macro the variable [name] is declared as global.
->Action kxgcreate%C
-
->Command IMPORT
->Parameters
-NAME 'Variable name' C Loop
->Guidance
-Import global variables.
-.
-If used inside a macro the variables listed are declared as global.
-The name may contain '*' as a wildcard matching any sequence of characters.
-
->Action kxgimport%C
-
->Command DELETE
->Parameters
-NAME 'Variable name' C Loop
->Guidance
-Delete global variables.
-.
-The global variables listed are deleted.
-The name may contain '*' as a wildcard matching any sequence of characters.
-
->Action kxgdelete%C
-
->Command LIST
->Parameters
-+
-NAME 'Variable name' C D='*'
-FILE 'Output file' C D=' '
->Guidance
-List global variables.
-.
-If a file name is specified the output is the list of GLOBAL/CREATE
-commands to define the selected global variables.
-The default file extension is .kumac.
->Action kxglist%C
-
-
->Menu ../SYNTAX
->Keyword
-statement
->Guidance
-Explanation of KUIP macro language and syntax.
-.
-A macro is a set of command lines stored in a file, which can be created and
-modified with any text editor.
-.
-In addition to all available KUIP commands the special "macro statements"
-listed below are valid only inside macros. Note that the statement keywords are
-fixed. Aliasing such as "ALIAS/CREATE jump GOTO" is not allowed.
-
->Menu Expressions
->Keyword
-parser
->Guidance
-Explanation of KUIP expression syntax.
-.
-KUIP has a built-in parser for different kinds of expressions: arithmetic
-expressions, boolean expressions, string expressions, and "garbage
-expressions".
-
->Help_Item Arithmetic
->Guidance
-Explanation of arithmetic expression syntax.
-.
-The syntactic elements for building arithmetic expressions are:
-.
- expr ::= number
- | vector-name (for scalar vectors)
- | vector-name(expr)
- | vector-name(expr,expr)
- | vector-name(expr,expr,expr)
- | [variable-name] (if value is numeric or
- the name of a scalar vector)
- | [variable-name](expr...) (if value is a vector name)
- | alias-name (if value is numeric constant)
- | $system-function(...)
- | - expr
- | expr + expr
- | expr - expr
- | expr * expr
- | expr / expr
- | (expr)
- | ABS(expr)
- | INT(expr)
- | MOD(expr,expr)
-.
-They can be used in the macro statements DO, FOR, and EXITM, in macro variable
-assignments, as system function arguments where a numeric value is expected, or
-as the argument to the $EVAL function.
-.
-Note that all arithmetic operations are done in floating point, i.e., "5/2"
-becomes "2.5". If a floating point result appears in a place where an integer
-is expected, for example as an index, the value is truncated.
-
->Help_Item Boolean
->Guidance
-Explanation of Boolean expression syntax.
-.
-Boolean expressions can only be used in the macro statements IF, WHILE, and
-REPEAT. The possible syntactic elements are shown below.
-.
- bool ::= expr rel-op expr
- | string eq-op string
- | expr eq-op string
- | .NOT. bool
- | bool .AND. bool
- | bool .OR. bool
- | ( bool )
-.
- rel-op ::= .LT. | .LE. | .GT. | .GE.
- | < | <= | > | >=
- | eq-op
-.
- eq-op ::= .EQ. | .NE.
- | = | <>
-
->Help_Item String
->Keyword
-CASE FOR EXITM
->Guidance
-Explanation of string expression syntax.
-.
-String expressions can be used in the macro statements CASE, FOR, and EXITM, in
-macro variable assignments, as system function arguments where a string value
-is expected, or as the argument to the $EVAL function. They may be constructed
-from the syntactic elements shown below.
-.
- string ::= quoted-string
- | unquoted-string
- | string // string (concatenation)
- | expr // string (expr represented as string)
- | [variable-name]
- | alias-name
- | $system-function(...)
-
->Help_Item Garbage
->Guidance
-Explanation of "garbage" expression syntax.
-.
-Expressions which do not satisfy any of the other syntax rules we want to call
-"garbage" expressions. For example,
-.
- s = $OS$MACHINE
-.
-is not a proper string expression. Unless they appear in a macro statement
-where specifically only an arithmetic or a boolean expression is allowed, KUIP
-does not complain about these syntax errors. Instead the following
-transformations are applied:
-.
- o alias substitution
-.
- o macro variable replacement; values containing a
- blank character are implicitly quoted
-.
- o system function calls are replaced one by one with
- their value provided that the argument is a syntactically
- correct expression
-.
- o string concatenation
-
->Menu ../Variables
->Keyword
-assign assignment
->Guidance
-Explanation of KUIP macro variables.
-.
-Macro variables do not have to be declared. They become defined by an
-assignment statement,
-.
- name = expression
-.
-The right-hand side of the assignment can be an arithmetic expression, a string
-expression, or a garbage expression (see MACRO/SYNTAX/Expressions). The
-expression is evaluated and the result is stored as a string (even for
-arithmetic expressions).
-.
-A variable value can be used in other expressions or in command lines by
-enclosing the name in square brackets, [name]. If the name enclosed in brackets
-is not a macro variable then no substitution takes place.
-
->Help_Item Numbered
->Keyword
-SHIFT
->Guidance
-Accessing macro arguments.
-.
-The EXEC command can pass arguments to a macro. The arguments are assigned to
-the numbered variables [1], [2], etc., in the order given in the EXEC command.
-The name of the macro, including the file specification, is assigned to [0].
-.
-A numbered variable cannot be redefined, i.e., an assignment such as "1 = foo"
-is illegal. See MACRO/SYNTAX/SHIFT.
-
->Help_Item Special
->Guidance
-Predefined special macro variables.
-.
-For each macro the following special variables are always defined:
-.
- [0] Fully qualified name of the macro.
- [#] Number of macro arguments
- [*] List of all macro arguments, separated by blanks
- [@] EXITM return code of the last macro called by
- the current one. The value is "0" if the last
- macro did not supply a return code or no macro
- has been called yet.
-.
-As for numbered variables these names cannot be used on the left-hand side of
-an assignment. The values or [#] and [*] are updated by the SHIFT statement.
-
-
->Help_Item Indirection
->Keyword
-reference substitute substitution
->Guidance
-Referencing a macro variable indirectly.
-.
-Macro variables can be referenced indirectly. If the variable [name] contains
-the name of another variable the construct
-.
- [%name]
-.
-is substituted by that other variable's value. For example, this is another
-way to traverse the list of macro arguments:
-.
- DO i=1,[#]
- arg = [%i]
- ...
- ENDDO
-.
-There is only one level of indirection, i.e., the name contained in "name" may
-not start with another "%".
-
->Help_Item Global
->Keyword
-EXTERN
->Guidance
-Declaring a global variable.
-.
- EXTERN name ...
-.
-The variable names listed in the EXTERN statement are declared as
-global variables.
-If a name has not been defined with the GLOBAL/CREATE command,
-it is created implicitly and initialized to the empty string.
-The name list may contain wildcards, for example
-.
- EXTERN *
-.
-makes all defined global variables visible.
-
->Help_Item READ
->Keyword
-query
->Guidance
-Reading a variable value from the keyboard.
-.
- READ name [ prompt ]
-.
-Variable values can be queried from the user during macro execution. The READ
-statement prompts for the variable value. If name is already defined the
-present value will be proposed as default.
-
->Help_Item SHIFT
->Guidance
-Manipulation numbered variables.
-.
-The only possible manipulation of numbered variables is provided by the SHIFT
-statement which copies [2] into [1], [3] into [2], etc., and discards the value
-of the last defined numbered variable. For example, the construct
-.
- WHILE [1] <> ' ' DO
- arg = [1]
- ...
- SHIFT
- ENDDO
-.
-allows to traverse the list of macro arguments.
-
-
->Menu ../Definitions
->Guidance
-Statements for defining macros.
-
->Help_Item MACRO
->Guidance
-Defining a macro.
-.
-A .kumac file may contain several macros. An
-individual macro has the form
-.
- MACRO macro-name [ parameter-list ]
- statements
- RETURN
-.
-Each statement is either a command line or one of the macro constructs
-described in this section (MACRO/SYNTAX). For the first macro in the file the
-MACRO header can be omitted. For the last macro in the file the RETURN trailer
-may be omitted. Therefore a .kumac file containing only commands (like the
-LAST.KUMAC) already constitutes a valid macro.
-
->Help_Item RETURN
->Guidance
-Ending a macro definition
-.
- RETURN [ value ]
-The RETURN statement flags the end of the macro definition and not the end of
-macro execution, i.e., the construct
-.
- IF ... THEN
- RETURN | error!
- ENDIF
-.
-is illegal. See MACRO/SYNTAX/EXITM.
-.
-The value is stored into the variable [@] in the calling macro. If no value is
-given it defaults to zero.
-
->Help_Item EXITM
->Guidance
-Terminate macro execution and return to calling macro.
-.
- EXITM [ value ]
-.
-In order to return from a macro prematurely the EXITM statement must be used.
-The value is stored into the variable [@] in the calling macro. If no value is
-given it defaults to zero.
-
->Help_Item STOPM
->Guidance
-Terminate macro execution and return to command line prompt.
-.
- STOPM
-.
-The STOPM statement unwinds nested macro calls and returns to
-the command line prompt.
-
->Help_Item ENDKUMAC
->Guidance
-Ignore rest of KUMAC file.
-.
-A logical "end of file" marker. The KUIP parser will not read any part of a
-.kumac file which appears after the "ENDKUMAC" command.
-
-
->Menu ../Branching
->Guidance
-Macro statements for general flow control.
-
->Help_Item CASE
->Guidance
-Select one of many branches.
-.
- CASE expression IN
- (label) statement [ statements ]
- ...
- (label) statement [ statements ]
- ENDCASE
-.
-The CASE switch evaluates the string expression and compares it one by one
-against the label lists until the first match is found. If a match is found the
-statements up to the next label are executed before skipping to the statement
-following the ENDCASE. None of the statements are executed if there is no match
-with any label.
-.
-Each label is a string constant and the comparison witht the selection
-expression is case-sensitive.
-If the same statement sequence should be executed for distinct values a
-comma-separated list of values can be used.
-.
-The "*" character in a label item acts as wildcard matching any string of zero
-or more characters, i.e., "(*)" constitutes the default label.
-
->Help_Item GOTO_and_IF_GOTO
->Guidance
-Unconditional and conditional branching.
-.
- GOTO label
-.
-The simplest form of flow control is provided by the GOTO statement which
-continues execution at the statement following the target "label:". If the jump
-leads into the scope of a block statement, for example a DO-loop, the result is
-undefined.
-.
-The target may be given by a variable containing the actual label name.
-.
- IF expression GOTO label
-.
-This old-fashioned construct is equivalent to
-.
- IF expression THEN
- GOTO label
- ENDIF
-
->Help_Item IF_THEN
->Guidance
-Conditional execution of statement blocks.
-.
- IF expression THEN
- statements
- ELSEIF expression THEN
- statements
- ...
- ELSEIF expression THEN
- statements
- ELSE
- statements
- ENDIF
-.
-The general IF construct executes the statements following the first IF/ELSEIF
-clause for with the boolean expression is true and then continues at the
-statement following the ENDIF. The ELSEIF clause can be repeated any number of
-times or can be omitted altogether. If none of the expressions is true, the
-statements following the optional ELSE clause are executed.
-
->Help_item ON_ERROR
->Guidance
-Installing an error handler.
-.
-Each command returns a status code which should be zero if the
-operation was successful or non-zero if any kind of error condition
-occurred.
-The status code can be tested by $IQUEST(1) system function.
-.
- ON ERROR GOTO label
-.
-installs an error handler which tests the status code after each
-command and branches to the given label when a non-zero value is
-found.
-The error handler is local to each macro.
-.
- ON ERROR EXITM [ expression ]
-and
- ON ERROR STOPM
-.
-are short-hand notations for a corresponding EXITM or STOPM statement
-at the targat label.
-.
- ON ERROR CONTINUE
-.
-continues execution with the next command independent of the status
-code.
-This is the initial setting when entering a macro.
-.
- OFF ERROR
-.
-An error handler can be deactivated by this statement.
-.
- ON ERROR
-.
-An error handler can be reactivated by this statement.
-
-
->Menu ../Looping
->Guidance
-Macro statements for construction loops.
-
->Help_Item DO
->Guidance
-Loop incrementing a loop counter.
-.
- DO loop = start_expr, finish_expr [, step_expr ]
- statements
- ENDDO
-.
-The step size (setp_expr) defaults to "1". The arithmetic expressions involved
-can be floating point values but care must be taken of rounding errors.
-.
-Note that "DO i=1,0" results in zero iterations and that the expressions are
-evaluated only once.
-
->Help_Item FOR
->Guidance
-Loop over items in an expression list.
-.
- FOR name IN expr_1 [ expr_2 ... expr_n ]
- statements
- ENDFOR
-.
-In a FOR-loop the number of iterations is determined by the number of items in
-the blank-separated expression list. The expression list must not be empty. One
-by one each expression evaluated and assigned to the variable name before the
-statements are executed.
-.
-The expressions can be of any type: arithmetic, string, or garbage expressions,
-and they do not need to be all of the same type. In general each expression is
-a single list item even if the result contains blanks.
-.
-The variable [*] is treated as a special case being equivalent to the
-expression list "[1] [2] ... [n]" which allows yet another construct to
-traverse the macro arguments:
-.
- FOR arg IN [*]
- ...
- ENDFOR
-
->Help_Item REPEAT
->Guidance
-Loop until condition becomes true.
-.
- REPEAT
- statements
- UNTIL expression
-.
-The body of a REPEAT-loop is executed at least once and iterated until the
-boolean expression evaluates to true.
-
-
->Help_Item WHILE
->Guidance
-Loop while condition is true.
-.
- WHILE expression DO
- statements
- ENDWHILE
-.
-The WHILE-loop is iterated while the boolean expression evaluates to true. The
-loop body is not executed at all if the boolean expression is false already in
-the beginning.
-
->Help_Item BREAKL
->Guidance
-Terminate a loop.
-.
- BREAKL [ level ]
-.
-Allows to terminate a loop prematurely. The BREAKL continues executing after
-the end clause of a DO, FOR, WHILE, or REPEAT block, where "level"
-indicates how many nested constructs to terminate. The default value level=1
-terminates the innermost loop construct.
-
->Help_Item NEXTL
->Guidance
-Continue with next loop iteration.
-.
- NEXTL [ level ]
-.
-Allows to continue with the next loop iteration without executing the rest
-of the loop body.
-Execution continues just before the end clause of a DO, FOR, WHILE, or
-REPEAT block, where "level" indicates how many nested blocks to skip.
-The default value level=1 skips to the end of the innermost loop construct.
-
-
->Name VECDEF
-
->Menu VECTOR
->Guidance
-Vector Processor commands.
-Vectors are equivalent to FORTRAN 77 arrays and they use
-the same notation except when omitting indexes (see last line below).
-Up to 3 dimensions are supported. Examples:
- Vec(20) (mono-dimensional with 20 elements)
-may be addressed by:
- Vec for all elements
- Vec(13) for element 13-th
- Vec(12:) for elements 12-th to last
- Vec(:10) for elements first to 10-th
- Vec(5:8) for elements 5-th to 8-th
-.
- Vec(3,100) (2-dimensional with 3 columns by 100 rows):
-may be addressed by:
- Vec(2,5:8) for elements 5-th to 8-th in 2-nd column
- Vec(2:3,5:8) for elements 5-th to 8-th in 2-nd to 3-rd columns
- Vec(2,5) for element 5-th in 2-nd column
- Vec(:,3) for all elements in 3-rd row
- Vec(2) for all elements in 2-nd column (SPECIAL CASE)
-The latest line shows the special (and non-standard with FORTRAN 77)
-notation such that missing indexes are substituted to the right.
-.
-An 'invisible' vector called '?', mono-dimensional and of length 100,
-is always present. Is is used for communicating between user arrays
-and KUIP vectors, being equivalenced with the real array VECTOR(100)
-in the labeled common block /KCWORK/.
-
->Command CREATE
->Parameters
-VNAME 'Vector name(length)' C
-+
-TYPE 'Vector type' C D='R' R='R,I'
-VALUES 'Value list' C D=' ' Vararg Separate
->Guidance
-Create a vector named VNAME (elements are set to zero).
-The dimensions are taken from the name,
-for example VEC(20), VEC(3,100), VEC(2,2,10).
-Up to 3 dimensions are supported. Dimensions which are not specified
-are taken to 1, for example VEC(10) ---> VEC(10,1,1) and VEC ---> VEC(1,1,1).
-The vector may be of type Real or Integer.
-A vector is filled at the same time if parameters are given
-after the TYPE:
- VEC/CREATE V(10) R 1 2 3 4 5 66 77 88 99 111
- VEC/CREATE W(20) R 1 2 3
-In the last example only the first three elements are filled.
-Vector elements may be changed later with the command VECTOR/INPUT.
-.
-If many equal values have to be entered consecutively, one can specify just
-one value and precede it by a repetition factor and an asterisk. Example:
- VEC/CREATE Z(20) R 5*1 2 4*3 ---> VEC/CREATE Z(20) R 1 1 1 1 1 2 3 3 3 3
-Enter HELP VECTOR for more information on vector addressing.
->Action kxvcreate%C
-
->Command LIST
->Guidance
-List all vectors (name, dimensions, type).
->Action KXLISV
-
->Command DELETE
->Parameters
-VLIST 'Vector list' C D=' ' Loop
->Guidance
-Delete from memory all vectors in the list VLIST.
-The vectors are separated in the list by a comma and embedded blanks
-are not allowed. An asterisk at the end of VLIST acts as wild-card:
- VEC/DEL AB* ---> deletes all vectors starting by AB
- VEC/DEL * ---> deletes all vectors
->Action KXDELV
-
->Command COPY
->Parameters
-VNAM1 'Source vector name' C
-VNAM2 'Destination vector name' C
->Guidance
-Copy a vector into another one.
-Mixed vector type copy is supported (e.g. Integer ---> Real and viceversa).
-If VNAM2 does not exist it is created with the required dimensions,
-not necessarily the same as the source vector if a sub-range was specified.
-For example, if A is a 3 x 100 vector and B does not exist,
-COPY A(2,11:60) B will create B as a 50 elements mono-dimensional vector;
-a special (and non-standard with FORTRAN 77) notation is used such that,
-still using the above vectors, COPY A(2,1:100) B and COPY A(2) B have the
-same effect.
-.
-Note that VECTOR/COPY does not allow a range for the destination vector
-not specifying consecutive elements (i.e. along the first dimension):
- VEC/COPY V(5) W(3,4) | O.K.
- VEC/COPY V1(2:3,5) V2(4:5,9) | O.K.
- VEC/COPY V1(5,2:3) V2(4:5,9) | O.K.
- VEC/COPY V1(3,3:4) V2(4,4:5) | NOT allowed
- VEC/COPY V1(2:3,5) V2(2,4:5) | NOT allowed
-Enter HELP VECTOR for more information on vector addressing.
->Action KXCOPV
-
->Command INPUT
->Parameters
-VNAME 'Vector name' C
-+
-VALUES 'Value list' C D=' ' Vararg Separate
->Guidance
-Enter values into a vector from the terminal.
-Example:
- VEC/INPUT V(6:10) 1.1 2.22 3.333 4.4444 5.55555
-If many equal values have to be entered consecutively, one can specify just
-one value and precede it by a repetition factor and an asterisk. Example:
- VEC/INPUT V 5*1 2 4*3 ---> VEC/INPUT V 1 1 1 1 1 2 3 3 3 3
-Enter HELP VECTOR for more information on vector addressing.
->Action kxvinput%C
-
->Command PRINT
->Parameters
-VNAME 'Vector name' C
-+
-DENSE 'Output density' I D=1 R=0,1,2
->Guidance
-Write to the terminal the content of a vector.
-Enter HELP VECTOR for more information on vector addressing.
-.
-If DENSE.EQ.0 the output is one vector element per line.
-If DENSE.EQ.1 the output for a sequence of identical vector elements
-is compressed to two lines stating the start and end indices.
-If DENSE.EQ.2 the output for a sequence of identical vector elements
-is compressed to a single line.
->Action kxvprint%C
-
->Command READ
->Parameters
-VLIST 'Vector list' C
-FNAME 'File name' C D=' '
-+
-FORMAT 'Format' C D=' '
-OPT 'Options' C D='OC' R='OC,O, ,C'
-MATCH 'Matching pattern' C D=' '
->Guidance
-Enter values into vector(s) from a file.
-A format can be specified, e.g. FORMAT='F10.5,2X,F10.5',
-or the free format is used if FORMAT is not supplied.
-.
-If vector(s) are not existing they will be created
-of the size as read from the file.
-.
-Vectors in the list VLIST (maximum 30) are separated by a comma and
-embedded blanks are not allowed. If subscripts are present
-in vector names, the smallest one is taken.
-.
-OPT is used to select between the following options:
- 'OC' file is Opened, read and then Closed (default case)
- 'O' file is Opened and then read (left open for further reading)
- ' ' file is read (already open, left so for further reading)
- 'C' file is read and then Closed (already open)
-If the character 'Z' is present in OPT, the vector elements equal to zero
-after reading are set to the latest non-zero element value
-(for example reading 1 2 3 0 0 4 0 5 will give 1 2 3 3 3 4 4 5).
-.
-MATCH is used to specify a pattern string, restricting
-the vector filling only to the records in the file which
-verify the pattern. Example of patterns:
- /string/ match a string (starting in column 1)
- -/string/ do not match a string (starting in column 1)
- /string/(n) match a string, starting in column n
- /string/(*) match a string, starting at any column
-Enter HELP VECTOR for more information on vector addressing.
->Action KXREAV
-
->Command WRITE
->Parameters
-VLIST 'Vector list' C
-+
-FNAME 'File name' C D=' '
-FORMAT 'Format' C D='(1X,G13.7)'
-CHOPT 'Options' C D='OC' R='OC,O, ,C'
->Guidance
-Write to a file the content of vector(s).
-If FNAME=' ' the content is written to the terminal.
-A format can be specified, e.g. FORMAT='F10.5,2X,F10.5',
-or the default one is used if FORMAT is not supplied.
-.
-Vectors in the list VLIST (maximum 30) are separated by a comma and
-embedded blanks are not allowed. If subscripts are present
-in vector names, the smallest one is taken.
-.
-CHOPT is used to select between the following options:
- 'OC' file is Opened, written and then Closed (default case)
- 'O' file is Opened and then written (left open for further writing)
- ' ' file is written (already open, left so for further writing)
- 'C' file is written and then Closed (already open)
-Enter HELP VECTOR for more information on vector addressing.
->Action KXWRIV
-
->Menu OPERATIONS
->Guidance
-Simple arithmetic operations between vectors.
-In all the operations only the minimum vector length is considered,
-i.e. an operation between a vector A of dimension 10 and a vector B
-of dimension 5 will involve the first 5 elements in both vectors.
-If the destination vector does not exist,
-it is created with the same length as the source vector.
-
->Command VBIAS
->Parameters
-VNAM1 'Source vector name' C
-BIAS 'Bias value' R
-VNAM2 'Destination vector name' C
->Keyword
-BIAS
->Guidance
-VNAM2(I) = BIAS + VNAM1(I)
->Action KXVOPE
-
->Command VSCALE
->Parameters
-VNAM1 'Source vector name' C
-SCALE 'Scale factor' R
-VNAM2 'Destination vector name' C
->Keyword
-SCALE
->Guidance
-VNAM2(I) = SCALE * VNAM1(I)
->Action KXVOPE
-
->Command VADD
->Parameters
-VNAM1 'First source vector name' C
-VNAM2 'Second source vector name' C
-VNAM3 'Destination vector name' C
->Keyword
-ADD
->Guidance
-VNAM3(I) = VNAM1(I) + VNAM2(I)
->Action KXVOPE
-
->Command VMULTIPLY
->Parameters
-VNAM1 'First source vector name' C
-VNAM2 'Second source vector name' C
-VNAM3 'Destination vector name' C
->Keyword
-MULTIPLY
->Guidance
-VNAM3(I) = VNAM1(I) * VNAM2(I)
->Action KXVOPE
-
->Command VSUBTRACT
->Parameters
-VNAM1 'First source vector name' C
-VNAM2 'Second source vector name' C
-VNAM3 'Destination vector name' C
->Keyword
-SUBTRACT
->Guidance
-VNAM3(I) = VNAM1(I) - VNAM2(I)
->Action KXVOPE
-
->Command VDIVIDE
->Parameters
-VNAM1 'First source vector name' C
-VNAM2 'Second source vector name' C
-VNAM3 'Destination vector name' C
->Keyword
-DIVIDE
->Guidance
-VNAM3(I) = VNAM1(I) / VNAM2(I) ( or 0 if VNAM2(I)=0 )
->Action KXVOPE
-
diff --git a/src/packlib/kuip/code_kuip/kulogn.F b/src/packlib/kuip/code_kuip/kulogn.F
deleted file mode 100644
index 5461350..0000000
--- a/src/packlib/kuip/code_kuip/kulogn.F
+++ /dev/null
@@ -1,115 +0,0 @@
-*
-* $Id: kulogn.F,v 1.1.1.1 1996/03/08 15:32:53 mclareni Exp $
-*
-* $Log: kulogn.F,v $
-* Revision 1.1.1.1 1996/03/08 15:32:53 mclareni
-* Kuip
-*
-*
-#include "kuip/pilot.h"
-*CMZ : 2.01/06 29/03/93 16.27.32 by Alfred Nathaniel
-*-- Author : Jamie Shiers
- SUBROUTINE KULOGN(CHPACK,CHOPT)
-
- CHARACTER*(*) CHPACK,CHOPT
- CHARACTER*1 CHOPTT
- CHARACTER*8 CHVAR
- CHARACTER*255 CHPATH
- COMMON/SLATE/ IS(40)
-*
-* Execute logon kumacs for package 'CHPACK'
-* KUMACs are xxxSYS, xxxGRP, xxxUSR and xxxLOGON
-* selected in CHOPT R='S,G,U,L,V' ('V'=verbose flag)
-*
-* VAX/VMS : look in directories defined by search list xxxPATH
-* if xxxPATH not defined, use SYS$LOGIN,SYS$DISK:[]
-* (i.e. current and home directories)
-* Unix : look in path xxx PATH
-* if xxxPATH not defined, use current and home directories
-* VM/CMS : check disks in xxxPATH. if not defined, use A
-*
-* MVS : use prefix
-*
- LPACK = LENOCC(CHPACK)
- LOPT = LENOCC(CHOPT)
-
- IOPTS = INDEX(CHOPT(1:LOPT),'S')
- IOPTG = INDEX(CHOPT(1:LOPT),'G')
- IOPTU = INDEX(CHOPT(1:LOPT),'U')
- IOPTL = INDEX(CHOPT(1:LOPT),'L')
- IOPTV = INDEX(CHOPT(1:LOPT),'V')
-
- CHOPTT = ' '
- IF(IOPTV.NE.0) CHOPTT = 'V'
-
-#if defined(CERNLIB_IBMMVS)
-*
-* Get prefix
-*
- CALL KPREFI(CHPATH,LPATH)
-#endif
-#if defined(CERNLIB_IBMVM)||defined(CERNLIB_UNIX)
-*
-* Translate path variable
-*
- CHVAR = CHPACK(1:LPACK) // 'PATH'
- CALL GETENVF(CHVAR,CHPATH)
- LPATH = IS(1)
-#endif
-#if (defined(CERNLIB_UNIX))&&(!defined(CERNLIB_MSDOS))
-*
-* Restrict search to current and home directory
-* if variable not defined
-*
- IF(LPATH.EQ.0) THEN
- CHPATH(1:2) = '.:'
- CALL GETENVF('HOME',CHPATH(3:))
- LPATH = IS(1) + 2
- ENDIF
-#endif
-#if defined(CERNLIB_IBMVM)
-*
-* Restrict search to A disk if variable not defined
-*
- IF(LPATH.EQ.0) THEN
- CHPATH = 'A'
- LPATH = 1
- ENDIF
-#endif
-#if defined(CERNLIB_VMS)
-*
-* Logical name is a search list
-*
- CHPATH = CHPACK(1:LPACK) // 'PATH'
-#endif
-*
-* Execute system logon
-*
- IF(IOPTS.NE.0) THEN
- CHVAR = CHPACK(1:LPACK) // 'SYS'
- CALL KILOGN(CHPATH,CHVAR,CHOPTT)
- ENDIF
-*
-* Execute group logon
-*
- IF(IOPTG.NE.0) THEN
- CHVAR = CHPACK(1:LPACK) // 'GRP'
- CALL KILOGN(CHPATH,CHVAR,CHOPTT)
- ENDIF
-*
-* Execute user logon
-*
- IF(IOPTU.NE.0) THEN
- CHVAR = CHPACK(1:LPACK) // 'USR'
- CALL KILOGN(CHPATH,CHVAR,CHOPTT)
- ENDIF
-*
-* Execute local logon
-*
- IF(IOPTL.NE.0) THEN
- CHVAR = CHPACK(1:LPACK) // 'LOGON'
- CALL KILOGN(CHPATH,CHVAR,CHOPTT)
- ENDIF
-
- END
-
diff --git a/src/packlib/kuip/code_kuip/kuopen.F b/src/packlib/kuip/code_kuip/kuopen.F
deleted file mode 100644
index cbc5a2f..0000000
--- a/src/packlib/kuip/code_kuip/kuopen.F
+++ /dev/null
@@ -1,491 +0,0 @@
-*
-* $Id: kuopen.F,v 1.1.1.1 1996/03/08 15:32:53 mclareni Exp $
-*
-* $Log: kuopen.F,v $
-* Revision 1.1.1.1 1996/03/08 15:32:53 mclareni
-* Kuip
-*
-*
-#include "kuip/pilot.h"
-*CMZ : 2.06/03 02/12/94 12.19.07 by Gunter Folger
-*-- Author :
- SUBROUTINE KUOPEN(LUN,FILE,CHSTAT,ISTAT)
-*
-********************************************************************************
-*
-* To open a FORMATTED file
-*
-* Input :
-*
- INTEGER LUN
- CHARACTER*(*) FILE
- CHARACTER*(*) CHSTAT
-*
-* Output :
-*
- INTEGER ISTAT
-*
-* CHSTAT action
-* ===== ======
-* 'OLD' : open existing file for readonly access
-* error if file does not exist
-* KUCLOS(LUN,'DELETE',ISTAT) is not allowed
-* 'NEW' : create new file and open for write access
-* error if file already exists
-* (except on VAX/VMS where a new cycle is created)
-* 'UNKNOWN' : like 'NEW' but no error if file already exists
-* 'APPEND' : like 'UNKNOWN' but write pointer is positioned at EOF
-* if file already exists
-* 'DONTKNOW': use if it is not know whether the file will be read or
-* written; on VMS it will overwrite an existing cycle
-*
-* 'VERYOLD' : like 'OLD' but open with RECFM F on VM/CMS
-* (if reading with formats is required)
-* 'VERYNEW' : like 'UNKNOWN' but open with RECFM F on VM/CMS
-* (if writing with formats is required)
-*
-********************************************************************************
-*
-#include "kuip/kcmcmd.inc"
-#include "kuip/kcgen1.inc"
-*
-*
- CHARACTER*20 STATUS
- CHARACTER*80 CHLINE
-*
-#if defined(CERNLIB_UNIX)||defined(CERNLIB_APOLLO)||defined(CERNLIB_CRAY)
- LOGICAL KUQCAS
- CHARACTER*256 CHFILE
-#endif
-#if defined(CERNLIB_IBMVM)
- CHARACTER*1 CHDISK, DISK, CMXDSK
- CHARACTER*8 CHNAME, CHTYPE
- CHARACTER*9 ACTION
- CHARACTER*11 FORM
- CHARACTER*80 CHFILE
- LOGICAL FEXIST
- SAVE DISK
- DATA DISK /' '/
-#endif
-#if defined(CERNLIB_IBMMVS)
- CHARACTER*20 STATU
-#endif
-#if (defined(CERNLIB_IBMMVS))&&(!defined(CERNLIB_NEWLIB))
- CHARACTER*20 PREFIX
- CHARACTER*80 MVSFIL
- CHARACTER*5 IUNIT, ITRK, IRECFM
- CHARACTER*9 CACTIO
- LOGICAL*4 EXS, OPN
- INTEGER*4 IRC,LUNOLD,NCH
-
- INTEGER*4 ISPACE(3), IDCB(2)
-
- DATA ISPACE / 10, 10, 0 /
- DATA IDCB / 80, 8000 /
- DATA ITRK / 'TRK' /, IRECFM / 'FB' /
-
-*-- THE FOLLOWING DATAS ARE INSTALLATION DEPENDANT
-
-#endif
-#if (defined(CERNLIB_IBMMVS))&&(!defined(CERNLIB_NEWLIB))&&(!defined(CERNLIB_GSI))
- DATA IUNIT / 'HSM' /
-#endif
-#if (defined(CERNLIB_IBMMVS))&&(defined(CERNLIB_GSI))
- DATA IUNIT / 'SYSDA' /
-#endif
-#if defined(CERNLIB_NEWLIB)
- CHARACTER*20 PREFIX
- CHARACTER*80 MVSFIL
- CHARACTER*4 IUNIT, ITRK, IRECFM
- CHARACTER*9 CACTIO
- LOGICAL*4 EXS, OPN
- INTEGER*4 IRC
-
- INTEGER*4 ISPACE(3), IDCB(2)
-
- CHARACTER*70 RTAREA
- INTEGER CMATOI
-
- DATA ISPACE / 10, 10, 0 /
- DATA IDCB / 80, 9040 /
- DATA ITRK / 'TRK' /, IRECFM / 'FB' /
-
-*-- THE FOLLOWING DATAS ARE INSTALLATION DEPENDANT
- DATA IUNIT / 'FAST' /
-*
-#endif
- STATUS=CHSTAT
- IF (CHSTAT.EQ.'APPEND') STATUS = 'UNKNOWN'
- IF (CHSTAT.EQ.'VERYNEW') STATUS = 'UNKNOWN'
- IF (CHSTAT.EQ.'VERYOLD') STATUS = 'OLD'
- IF (CHSTAT.EQ.'DONTKNOW') STATUS = 'UNKNOWN'
-#if defined(CERNLIB_IBMMVS)
- STATU=STATUS
- IF (STATUS.EQ.'OLD') STATU = 'READ'
-
-#endif
-#if defined(CERNLIB_UNIX)||defined(CERNLIB_APOLLO)||defined(CERNLIB_CRAY)
- CHFILE = FILE
- IF (.NOT.KUQCAS()) CALL CUTOL(CHFILE)
- CALL KUHOME(CHFILE,NCH)
- OPEN(UNIT=LUN,FILE=CHFILE,STATUS=STATUS,IOSTAT=ISTAT,ERR=999)
-
-#endif
-#if defined(CERNLIB_VMS)
-*--- allow multiple cycles (i.e. change status UNKNOWN ---> NEW)
- IF (STATUS.EQ.'UNKNOWN' .AND. CHSTAT.NE.'APPEND'
- + .AND. CHSTAT.NE.'DONTKNOW') STATUS = 'NEW'
- IF (STATUS.EQ.'OLD') THEN
- OPEN(UNIT=LUN,FILE=FILE,IOSTAT=ISTAT,ERR=999,
- + CARRIAGECONTROL='LIST',STATUS='OLD',READONLY)
- ELSE
- OPEN(UNIT=LUN,FILE=FILE,IOSTAT=ISTAT,ERR=999,
- + CARRIAGECONTROL='LIST',STATUS=STATUS)
- ENDIF
-
-#endif
-#if (defined(CERNLIB_IBMVM))&&(defined(CERNLIB_SFS))
-*--- courtesy Wojciech Wojcik
- CALL DMSCSL('DMSGETWU',IRET,IREASON,IWUID)
- CALL DMSCSL('DMSPUSWU',IRET,IREASON,IWUID)
-#endif
-#if defined(CERNLIB_IBMVM)
- IF (STATUS.EQ.'OLD') THEN
- CHDISK = '*'
- ELSE
- IF (DISK.EQ.' ') DISK = CMXDSK()
- CHDISK = DISK
- ENDIF
- CHFILE=FILE
- CALL CLTOU(CHFILE)
- L = LENOCC(CHFILE)
- I = INDEX(CHFILE(:L),'.')
- IF (I.EQ.0) I = INDEX(CHFILE(:L),' ')
- IF (I.EQ.0) THEN
- CHNAME = CHFILE
- CHTYPE = 'DAT'
- ELSE
- CHNAME = CHFILE(:I-1)
- CHFILE = CHFILE(I+1:)
- L = LENOCC(CHFILE)
- I = INDEX(CHFILE(:L),'.')
- IF (I.EQ.0) I = INDEX(CHFILE(:L),' ')
- IF (I.EQ.0) THEN
- CHTYPE = CHFILE
- ELSE
- CHTYPE = CHFILE(:I-1)
- CHDISK = CHFILE(I+1:)
- ENDIF
- ENDIF
- CHFILE = '/'//CHNAME//' '//CHTYPE//' '//CHDISK
- CALL FILEINF
- INQUIRE(FILE=CHFILE,EXIST=FEXIST)
- IF (STATUS.EQ.'OLD') THEN
- IF (.NOT.FEXIST) THEN
-*
-* If STATUS='OLD' must check if file exists
-* (otherwise at the end we get an error number count > 0)
-*
- ISTAT = 1
- GOTO 999
- ENDIF
- ELSEIF (STATUS.EQ.'NEW') THEN
- IF (FEXIST) THEN
- ISTAT = 1
- GOTO 999
- ENDIF
- ELSEIF (CHSTAT.EQ.'VERYNEW') THEN
- IF (FEXIST) THEN
-*
-* delete file in case the existing version is RECFM V
-*
- CALL VMCMS('ERASE '//CHFILE(2:),ISTAT)
-*
-* continue because INQUIRE is sometimes lying
-*
-*** IF (ISTAT.NE.0) GOTO 999
- ENDIF
- ELSE
- CALL FILEINF(I,'RECFM','U','LRECL',80)
- ENDIF
- IF (STATUS.EQ.'OLD') THEN
- ACTION = 'READ'
- ELSE
- ACTION = 'READWRITE'
- ENDIF
-*--- RECFM V files must be handled unformatted
- IF (CHSTAT.EQ.'OLD' .OR. CHSTAT.EQ.'APPEND') THEN
- FORM = 'UNFORMATTED'
- ELSE
- FORM = 'FORMATTED'
- ENDIF
- OPEN(UNIT=LUN,FILE=CHFILE,IOSTAT=ISTAT,ERR=999,
- + STATUS=STATUS,ACTION=ACTION,FORM=FORM)
-
-#endif
-#if (defined(CERNLIB_IBMMVS))&&(!defined(CERNLIB_NEWLIB))
- CACTIO = 'READWRITE'
- IF ( Status .EQ. 'SCRATCH' ) GOTO 15
-
-*-- DON'T ADD PREFIX IF THE FIRST CHARACTER OF FILE NAME IS A DOT
-
- CALL KPREFI ( PREFIX, NCHPRE )
- NCH = LENOCC(FILE)
- IF ( FILE(1:1) .EQ. '.' ) THEN
- MVSFIL = FILE(2:NCH)
- NCH = NCH -1
- ELSE
- MVSFIL = PREFIX(1:NCHPRE)//FILE
- NCH = NCH + NCHPRE
- ENDIF
- PRINT 8000, MVSFIL(1:NCH), STATUS, LUN
- 8000 FORMAT ( ' KUOPEN - OPEN FILE ', A, ' WITH STATUS ', A8
- +, ' ON LUN ', I3 )
-
- INQUIRE ( FILE='/'//MVSFIL(1:NCH), ERR=110, IOSTAT=ISTAT
- +, EXIST=EXS, OPENED=opn, NUMBER=lunold )
-#endif
-#if (defined(CERNLIB_IBMMVS))&&(!defined(CERNLIB_NEWLIB))
- IF ( ISTAT .NE. 0 ) GO TO 120
-*
- IF ( EXS ) THEN
- IF ( STATU .EQ. 'READ' ) THEN
- CACTIO = 'READ'
- STATUS = 'OLD'
- ENDIF
- IF ( STATU .EQ. 'NEW' ) THEN
-* GOTO 160
- STATUS = 'OLD'
-* PRINT *,'KUOPEN: Warning, '//MVSFIL(1:nch)//'already exists'
- ENDIF
- ELSE ! not existing
-* IF ( STATUS .EQ. 'OLD' ) GOTO 180
- IF ( STATUS .EQ. 'OLD' ) STATUS = 'NEW'
-* e.g. LAST 0 LASTCMZ opens with status OLDA, but dataset may
-* not exist
- IF ( STATU .EQ. 'READ' ) GOTO 190
- IF ( STATUS .EQ. 'UNKNOWN' ) STATUS = 'NEW'
- ENDIF
-#endif
-#if (defined(CERNLIB_IBMMVS))&&(!defined(CERNLIB_NEWLIB))
- 15 IF ( OPN ) THEN
- CALL KUCLOS(LUNOLD,' ',IRC)
- IF (IRC .NE. 0) GOTO 150
- ENDIF
-*
-* --- for a new/scratch dataset, FileInf is needed
-*
- IF ( Status .EQ. 'NEW' .OR. Status .EQ. 'SCRATCH' ) THEN
- iSpace(3) = 0
- IF( INDEX(MVSFIL(1:NCH),'(') .NE. 0 ) ISPACE(3) = 28
- CALL FILEINF ( ISTAT, 'DEVICE', IUNIT, ITRK, ISPACE(1)
- +, 'SECOND', ISPACE(2), 'DIR', ISPACE(3)
- +, 'RECFM', IRECFM, 'LRECL', IDCB(1)
- +, 'BLKSIZE', IDCB(2) )
- IF ( ISTAT .NE. 0 ) GO TO 130
- ENDIF
-*
-* --- no dataset name allowed for SCRATCH dataset
-*
- IF ( Status .EQ. 'SCRATCH' ) THEN
- OPEN ( UNIT=LUN, ERR=140, STATUS=STATUS
- +, ACCESS='SEQUENTIAL'
- +, FORM='FORMATTED', IOSTAT=ISTAT
- +, ACTION=CACTIO )
- ELSE
- OPEN ( UNIT=LUN, ERR=140, STATUS=STATUS
- +, FILE='/'//MVSFIL(1:NCH), ACCESS='SEQUENTIAL'
- +, FORM='FORMATTED', IOSTAT=ISTAT
- +, ACTION=CACTIO )
- ENDIF
- IF ( ISTAT .NE. 0 ) GO TO 170
-*
- IF ( STATUS .EQ. 'NEW' .OR. STATUS .EQ. 'SCRATCH' ) THEN
-*-- INITIALIZE FILE CONTENT, TO AVOID PROBLEMS WHEN READING
-*-- IF NOT PDS MEMBER
- IF ( INDEX(MVSFIL(1:NCH),'(') .EQ. 0 ) THEN
- ENDFILE LUN
- REWIND LUN
- ENDIF
- IF ( STATUS .EQ. 'NEW' ) THEN
- PRINT *, 'KUOPEN: File ', MVSFIL(1:NCH),' created'
- ENDIF
- IF ( STATUS .EQ. 'SCRATCH' ) THEN
- PRINT *, 'KUOPEN: Scratch File created on LUN ',LUN
- ENDIF
- ENDIF
- GO TO 900
-
-*-- ERROR MESSAGES
-
- 110 PRINT *, ' KUOPEN - INQUIRE ERROR'
- ISTAT = -1
- GO TO 999
- 120 PRINT *, ' KUOPEN - INQUIRE ERROR - IOSTAT = ', ISTAT
- GO TO 999
- 130 PRINT *, ' KUOPEN - FILEINF ERROR - IOSTAT = ', ISTAT
- GO TO 999
- 140 PRINT *, ' KUOPEN - OPEN ERROR'
- ISTAT = -1
- GO TO 999
- 150 PRINT *, ' KUOPEN - CLOSE ERROR'
- ISTAT = -1
- GO TO 999
- 160 PRINT *, ' KUOPEN - ERROR: FILE DECLARED ''NEW'' PRE-EXISTS'
- ISTAT = -1
- GO TO 999
- 170 PRINT *, ' KUOPEN - OPEN ERROR - IOSTAT = ', ISTAT
- GO TO 999
- 180 PRINT *, ' KUOPEN - ERROR: FILE ', MVSFIL(1:NCH)
- +,' DOESN''T EXIST - BUT WAS TRIED TO BE OPENED WITH STATUS OLD'
- ISTAT = -1
- GO TO 999
- 190 PRINT *, ' KUOPEN - ERROR: FILE ', MVSFIL(1:NCH)
- +,' DOESN''T EXIST - BUT WAS TRIED TO BE OPENED WITH STATUS READ'
- ISTAT = -1
- GO TO 999
-
-#endif
-#if defined(CERNLIB_NEWLIB)
-
- NCH=LENOCC(FILE)
- IF (FILE(1:2) .EQ. 'FT'
- + .AND. FILE(5:8) .EQ. 'F001'
- + .AND. NCH .EQ. 8) THEN
- RTAREA=' '
- CALL DYNAM(0,'INFO',RTAREA,'DDN='//FILE(1:8)//';')
- IF (RTAREA(9:12).NE.'SYS9') THEN
- CALL DYNAM (0,
- + 'UNALLOC;','DDN='//FILE(1:8)//' UNALLOC;')
- CALL DYNAM (0,
- + 'ALLOC;','DDN='//FILE(1:8)//' BLKSIZE=9040
- + LRECL=80 RECFM=FB TRK PRIM=50 SEC=20 DSORG=PS;')
- ENDIF
- GOTO 999
- ELSE
-*-- DON'T ADD PREFIX IF THE FIRST CHARACTER OF FILE NAME IS A DOT
-
- IF ( FILE(1:1) .EQ. '.' ) THEN
- MVSFIL = FILE(2:NCH)
- ELSE
- CALL KPREFI ( PREFIX, NCHPRE )
- MVSFIL = PREFIX(1:NCHPRE)//FILE
- ENDIF
- ENDIF
-
- IF ( STATUS .EQ. 'NEW' ) THEN
-*-- CHECK FILE EXISTENCE
- INQUIRE ( FILE='/'//MVSFIL, ERR=110, IOSTAT=ISTAT
- +, EXIST=EXS)
- IF ( ISTAT .NE. 0 ) GO TO 120
- IF ( EXS ) GO TO 160
-*-- DEFINE FILE PARAMETERS IF MVSFIL IS NOT A MEMBER OF A PDS
- 10 IF ( INDEX(MVSFIL,'(') .NE. 0 ) GO TO 15
- CALL FILEINF ( ISTAT, 'DEVICE', IUNIT, ITRK, ISPACE(1)
- +, 'SECOND', ISPACE(2), 'DIR', ISPACE(3)
- +, 'RECFM', IRECFM, 'LRECL', IDCB(1)
- +, 'BLKSIZE', IDCB(2) )
- IF ( ISTAT .NE. 0 ) GO TO 130
-*-- OPEN FILE
- 15 OPEN ( UNIT=LUN, ERR=140, STATUS='NEW'
- +, FILE='/'//MVSFIL, ACCESS='SEQUENTIAL'
- +, FORM='FORMATTED', IOSTAT=ISTAT
- +, ACTION='READWRITE' )
- IF ( ISTAT .NE. 0 ) GO TO 170
-*-- INITIALIZE FILE CONTENT, TO AVOID PROBLEMS WHEN READING
-*-- IF NOT PDS MEMBER
- IF ( INDEX(MVSFIL,'(') .EQ. 0 ) THEN
- ENDFILE LUN
- REWIND LUN
- ENDIF
-
- ELSEIF ( STATUS .EQ. 'OLD' .OR.
- + STATUS .EQ. 'READ' .OR.
- + STATUS .EQ. 'UNKNOWN' ) THEN
-*-- CHECK FILE EXISTENCE
- INQUIRE ( FILE='/'//MVSFIL, ERR=110, IOSTAT=ISTAT
- +, EXIST=EXS, OPENED=OPN, NUMBER=LUNOLD )
- IF ( ISTAT .NE. 0 ) GO TO 120
- IF ( .NOT. EXS ) THEN
- IF (STATUS .EQ. 'UNKNOWN' ) GO TO 10
- PRINT *, ' KUOPEN - FILE ', MVSFIL
- +, 'DOESN''T EXIST'
- ISTAT=-1
- GOTO 999
- ENDIF
-*-- IF PREVIOUSLY OPENED, CLOSE IT
- IF ( OPN )
- + CLOSE ( UNIT=LUNOLD, ERR=150, STATUS='KEEP'
- +, IOSTAT=IRC )
-*-- OPEN FILE IN READ/WRITE MODE, READ MODE ONLY IF FILE
-*-- NAME START WITH A DOT (FILE BELONGING TO AN OTHER USERID
-*-- FROM AN OTHER GROUP - RACF PROTECTION)
- IF ((FILE(1:1) .EQ. '.' .AND.
- + FILE(2:7) .NE. PREFIX(1:6) ) .OR.
- + (STATUS .EQ. 'READ' ) ) THEN
- CACTIO = 'READ'
- ELSE
- CACTIO = 'READWRITE'
- ENDIF
- OPEN ( UNIT=LUN, ERR=140, STATUS='OLD'
- +, FILE='/'//MVSFIL, ACCESS='SEQUENTIAL'
- +, FORM='FORMATTED', IOSTAT=ISTAT
- +, ACTION=CACTIO )
- IF ( ISTAT .NE. 0 ) GO TO 170
-
- ELSEIF ( STATUS .EQ. 'SCRATCH' ) THEN
-*-- DEFINE FILE PARAMETERS
- CALL FILEINF ( ISTAT, 'DEVICE', IUNIT, ITRK, ISPACE(1)
- +, 'SECOND', ISPACE(2), 'DIR', ISPACE(3)
- +, 'RECFM', IRECFM, 'LRECL', IDCB(1)
- +, 'BLKSIZE', IDCB(2) )
- IF ( ISTAT .NE. 0 ) GO TO 130
-*-- OPEN FILE
- OPEN ( UNIT=LUN, ERR=140, STATUS='SCRATCH'
- +, ACCESS='SEQUENTIAL'
- +, FORM='FORMATTED', IOSTAT=ISTAT
- +, ACTION='READWRITE' )
- IF ( ISTAT .NE. 0 ) GO TO 170
-
- ELSE
- PRINT *, ' KUOPEN - OPEN STATUS ', STATUS, ' UNFORESEEN'
- ISTAT = -1
-
- ENDIF
- GO TO 900
-
-*-- ERROR MESSAGES
-
- 110 PRINT *, ' KUOPEN - INQUIRE ERROR'
- ISTAT = -1
- GO TO 999
- 120 PRINT *, ' KUOPEN - INQUIRE ERROR - IOSTAT = ', ISTAT
- GO TO 999
- 130 PRINT *, ' KUOPEN - FILEINF ERROR - ISTAT = ', ISTAT
- GO TO 999
- 140 PRINT *, ' KUOPEN - OPEN ERROR'
- ISTAT = -1
- GO TO 999
- 150 PRINT *, ' KUOPEN - CLOSE ERROR'
- ISTAT = -1
- GO TO 999
- 160 PRINT *, ' KUOPEN - ERROR: FILE DECLARED ''NEW'' PRE-EXISTS'
- ISTAT = -1
- GO TO 999
- 170 PRINT *, ' KUOPEN - OPEN ERROR - IOSTAT = ', ISTAT
- GO TO 999
-
-#endif
-
-900 CONTINUE
- IF (CHSTAT.EQ.'APPEND') THEN
-910 CONTINUE
-*--- skip lines until end of file
- CALL KUREAD(LUN,CHLINE,NCH)
- IF(NCH.GE.0) GOTO 910
-#if (defined(CERNLIB_IBMALL)||defined(CERNLIB_UNIX)||defined(CERNLIB_CRAY))&&(!defined(CERNLIB_APOLLO))
- BACKSPACE(LUN)
-#endif
- ENDIF
-
-999 END
diff --git a/src/packlib/kuip/code_kuip/kuread.F b/src/packlib/kuip/code_kuip/kuread.F
deleted file mode 100644
index 193c147..0000000
--- a/src/packlib/kuip/code_kuip/kuread.F
+++ /dev/null
@@ -1,52 +0,0 @@
-*
-* $Id: kuread.F,v 1.1.1.1 1996/03/08 15:32:54 mclareni Exp $
-*
-* $Log: kuread.F,v $
-* Revision 1.1.1.1 1996/03/08 15:32:54 mclareni
-* Kuip
-*
-*
-#include "kuip/pilot.h"
-*CMZ : 2.00/00 05/08/92 15.56.21 by Alfred Nathaniel
-*-- Author :
- SUBROUTINE KUREAD(LUN,LINE,NCH)
-*
-********************************************************************************
-*
-* Read next line from unit LUN
-*
-* Input :
-*
- INTEGER LUN
-*
-* Output:
- CHARACTER*(*) LINE
- INTEGER NCH
-*
-* NCH : number of characters or -1 if error/end-of-file
-*
-********************************************************************************
-#if defined(CERNLIB_IBMVM)
- CHARACTER FORM*12
- INQUIRE(LUN,FORM=FORM)
- IF(FORM.EQ.'FORMATTED') THEN
- READ(LUN,'(A)',END=1,ERR=1) LINE
- ELSE
- LINE=' '
- READ(LUN,NUM=NBYT,END=1,ERR=1) LINE
- ENDIF
-#endif
-#if (defined(CERNLIB_IBMMVS))&&(!defined(CERNLIB_NEWLIB))
- READ(LUN,'(A80)',END=1,ERR=1) LINE
-#endif
-#if (!defined(CERNLIB_IBMVM))&&(!defined(CERNLIB_IBMMVS)||defined(CERNLIB_NEWLIB))
- READ(LUN,'(A)',END=1,ERR=1) LINE
-#endif
- NCH = LENOCC(LINE)
- RETURN
-*
- 1 CONTINUE
- LINE = ' '
- NCH = -1
-*
- END
diff --git a/src/packlib/kuip/code_kuip/kuserid.F b/src/packlib/kuip/code_kuip/kuserid.F
deleted file mode 100644
index 1c6a996..0000000
--- a/src/packlib/kuip/code_kuip/kuserid.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: kuserid.F,v 1.1.1.1 1996/03/08 15:32:55 mclareni Exp $
-*
-* $Log: kuserid.F,v $
-* Revision 1.1.1.1 1996/03/08 15:32:55 mclareni
-* Kuip
-*
-*
-#include "kuip/pilot.h"
-#if defined(CERNLIB_IBMALL)
-*CMZ : 2.02/05 18/05/93 15.20.33 by Alfred Nathaniel
-*-- Author : Alfred Nathaniel 18/05/93
- SUBROUTINE KUSERID(CHUSER)
- CHARACTER*(*) CHUSER
-*
-* return the user account name
-*
-#if defined(CERNLIB_IBMVM)
- CHARACTER USERID*8
- CHUSER=USERID()
-#endif
-#if !defined(CERNLIB_IBMVM)
- CHUSER='unknown'
-#endif
- END
-#endif
diff --git a/src/packlib/kuip/code_kuip/kutrue.c b/src/packlib/kuip/code_kuip/kutrue.c
deleted file mode 100644
index 68f817d..0000000
--- a/src/packlib/kuip/code_kuip/kutrue.c
+++ /dev/null
@@ -1,36 +0,0 @@
-/*
- * $Id: kutrue.c,v 1.2 1997/03/17 16:55:02 mclareni Exp $
- *
- * $Log: kutrue.c,v $
- * Revision 1.2 1997/03/17 16:55:02 mclareni
- * WNT mods
- *
- * Revision 1.1.1.1.2.1 1997/01/21 11:32:52 mclareni
- * All mods for Winnt 96a on winnt branch
- *
- * Revision 1.1.1.1 1996/03/08 15:32:58 mclareni
- * Kuip
- *
- */
-/*CMZ : 2.05/16 17/08/94 12.26.34 by Alfred Nathaniel*/
-/*-- Author : Alfred Nathaniel 14/06/92*/
-
-#include "kuip/kuip.h"
-#include "kuip/kfor.h"
-
-static LOGICAL f77_true = ~0;
-static LOGICAL f77_false = 0;
-
-/*
- * set Fortran's notion of .TRUE. and .FALSE.
- */
-void type_of_call Kutrue( LOGICAL *ftrue, LOGICAL *ffalse )
-{
- f77_true = *ftrue;
- f77_false = *ffalse;
-}
-
-LOGICAL ku_true( int return_true )
-{
- return return_true ? f77_true : f77_false;
-}
diff --git a/src/packlib/kuip/code_kuip/kuvcre.F b/src/packlib/kuip/code_kuip/kuvcre.F
deleted file mode 100644
index 254cf56..0000000
--- a/src/packlib/kuip/code_kuip/kuvcre.F
+++ /dev/null
@@ -1,56 +0,0 @@
-*
-* $Id: kuvcre.F,v 1.1.1.1 1996/03/08 15:32:54 mclareni Exp $
-*
-* $Log: kuvcre.F,v $
-* Revision 1.1.1.1 1996/03/08 15:32:54 mclareni
-* Kuip
-*
-*
-#include "kuip/pilot.h"
-*CMZ : 2.03/05 17/08/93 15.24.33 by Alfred Nathaniel
-*-- Author :
- SUBROUTINE KUVCRE(VNAME,TYPE,LENGTH,LLOW,LHIGH)
-*
-********************************************************************************
-*
-* Create vector VNAME of type TYPE ('R' for real or 'I' for integer) and length
-* LENGTH, and returns LLOW and LHIGH address inside Q or IQ array;
-* example the vector can be accessed by Q(LLOW:LHIGH) if TYPE='R'
-* or IQ(LLOW:LHIGH) if TYPE='I'.
-* Vector length array (dimensioned to 3) with LENGTH(I) containing
-* the I-th dimension length (0 or 1 if the dimension is not used);
-* example LENGTH(1)=10 and LENGTH(2)=LENGTH(3)=0 or 1 define a mono-dimensional
-* vector of length 10
-* If LLOW=LHIGH=0 an error occurred.
-*
-* Input :
-*
- CHARACTER*(*) VNAME
- CHARACTER*(*) TYPE
- INTEGER LENGTH(3)
-*
-* Output :
-*
- INTEGER LLOW
- INTEGER LHIGH
-*
-********************************************************************************
-*
-#include "kuip/kcques.inc"
- CHARACTER*64 VECNAM
-*
- IQUEST(1)=0
- LLOW=0
- LHIGH=0
- IF (LENGTH(2).EQ.0) LENGTH(2)=1
- IF (LENGTH(3).EQ.0) LENGTH(3)=1
- L=LENOCC(VNAME)
- WRITE (VECNAM,1000) VNAME(1:L),LENGTH(1),LENGTH(2),LENGTH(3)
-1000 FORMAT (A,'(',I6,',',I6,',',I6,')')
- CALL KXCRV1(VECNAM,TYPE)
- IF (IQUEST(1).NE.0) GO TO 999
- CALL KUVECT(VNAME,LLOW,LHIGH)
-999 END
-
-
-
diff --git a/src/packlib/kuip/code_kuip/kuvdel.F b/src/packlib/kuip/code_kuip/kuvdel.F
deleted file mode 100644
index e5b7d7d..0000000
--- a/src/packlib/kuip/code_kuip/kuvdel.F
+++ /dev/null
@@ -1,76 +0,0 @@
-*
-* $Id: kuvdel.F,v 1.1.1.1 1996/03/08 15:32:54 mclareni Exp $
-*
-* $Log: kuvdel.F,v $
-* Revision 1.1.1.1 1996/03/08 15:32:54 mclareni
-* Kuip
-*
-*
-#include "kuip/pilot.h"
-*CMZ : 2.02/02 05/05/93 09.36.54 by Alfred Nathaniel
-*-- Author :
- SUBROUTINE KUVDEL(VNAME)
-*
-********************************************************************************
-*
-* Delete vector VNAME.
-* If VNAME='*' all vectors are deleted.
-*
-* Input :
-*
- CHARACTER*(*) VNAME
-*
-********************************************************************************
-*
-#include "kuip/kcgen.inc"
-#include "kuip/kcques.inc"
-#include "kuip/kcvect.inc"
- CHARACTER*32 VN
-*
- IS=INDEX(VNAME,'*')
- IF (IS.NE.0) THEN
- LVECN=LQ(LVEC-1)
- LVECN=LQ(LVECN)
- DO 5 I=2,NUMVEC
- CALL UHTOC(IQ(LVECN+1),4,VN,32)
- IF (IS.GT.1) THEN
- IF (VN(1:IS-1).NE.VNAME(1:IS-1)) GO TO 10
- ENDIF
- CALL MZDROP(IXKUIP,LVECN,' ')
- IF (IQUEST(1).NE.0) GO TO 900
-*
-* inform other applications (COMIS) that the vector has been deleted
-*
- CALL KICOMV(VN)
- NUMVEC=NUMVEC-1
-10 LVECN=LQ(LVECN)
-5 CONTINUE
- GO TO 999
- ENDIF
- IF (NUMVEC.LE.1) THEN
- CALL KUALFA
- PRINT *,'*** No vector defined'
- GO TO 999
- ENDIF
- CALL KUVECT(VNAME,LLOW,LHIGH)
- IF (LLOW.EQ.0) THEN
- CALL KUALFA
- PRINT *,'*** Unknown vector ',VNAME
- GO TO 999
- ENDIF
- IF (VNAME.EQ.'?') THEN
- CALL KUALFA
- PRINT *,'*** Cannot delete this vector'
- GO TO 999
- ENDIF
- CALL MZDROP(IXKUIP,LVECN,' ')
- CALL KICOMV(VNAME)
- NUMVEC=NUMVEC-1
- IF (IQUEST(1).NE.0) GO TO 900
- GO TO 999
-900 CALL KUALFA
- PRINT *,'*** Error in deleting vector'
-999 END
-
-
-
diff --git a/src/packlib/kuip/code_kuip/kuvec.F b/src/packlib/kuip/code_kuip/kuvec.F
deleted file mode 100644
index 6d6966c..0000000
--- a/src/packlib/kuip/code_kuip/kuvec.F
+++ /dev/null
@@ -1,346 +0,0 @@
-*
-* $Id: kuvec.F,v 1.1.1.1 1996/03/08 15:32:54 mclareni Exp $
-*
-* $Log: kuvec.F,v $
-* Revision 1.1.1.1 1996/03/08 15:32:54 mclareni
-* Kuip
-*
-*
-#include "kuip/pilot.h"
-*CMZ : 2.07/03 02/05/95 16.01.25 by Gunter Folger
-*-- Author :
- SUBROUTINE KUVEC(VECN,X,NELEMS,CHOPT)
-*
-********************************************************************************
-*
-* Routine for vector handling.
-*
-* Note: in the following description ILOW stands for ILOW(IDIM),
-* IHIGH for IHIGH(IDIM) and LENTOT for LENGTH(IDIM), where IDIM is
-* the dimension (1, 2 or 3) affected.
-*
-* Only one dimension can be handled by this routine, ex. VECN can be
-* VEC(3), VEC(2,3:5), etc. if VEC is two-dim, but cannot be VEC(2:3,3:5)
-*
-* CHOPT='R' read in the array X the content of vector VECN (eg. VECN ---> X)
-* starting by the ILOW-th vector element (ILOW=1 is the first one).
-* NELEMS elements are read, eg. VECN(ILOW:ILOW+NELEMS-1), or all
-* if NELEMS<=0 or NELEMS>=LENTOT.
-* If the vector is not existing then IQUEST(1)=1.
-*
-* CHOPT=' ' same as CHOPT='R'.
-*
-* CHOPT='W' write the array X into the vector VECN (eg. X ---> VECN)
-* starting by the ILOW-th vector element (ILOW=1 is the first one).
-* NELEMS elements are written, eg. X(1:NELEMS).
-* If the vector is not large enough, it is automatically extended.
-* If the vector is not existing it is created.
-*
-* CHOPT='-' (used together with option 'W') same as CHOPT='W' and in addition
-* the vector is shrinked to the actual size.
-*
-* CHOPT='C' just create the vector if not existing.
-*
-* CHOPT='I' (used together with option 'W' or 'C') vector is of type Integer
-* (default case is Real)
-*
-* CHOPT='X' (used together with option 'W' or 'C') vector is of type compleX
-* (default case is Real)
-*
-* It returns also in IQUEST :
-*
-* IQUEST(10) : NCHNAM (number of chars of VECN)
-* IQUEST(11) : LENTOT (total number of elements of vector)
-* IQUEST(12) : LLOW (low address)
-* IQUEST(13) : LHIGH (high address)
-* IQUEST(14) : ITYPE (type: 1=real, 2=integer, 3=hollerith)
-*
-* IQUEST(20) : ICOPY (if <> 0 a copy on temporary vectory was done,
-* with LENFR and LENTO addresses defined as follow)
-* IQUEST(21) : LENFR(1)
-* IQUEST(22) : LENFR(2)
-* IQUEST(23) : LENFR(3)
-* IQUEST(31) : LENTO(1)
-* IQUEST(32) : LENTO(2)
-* IQUEST(33) : LENTO(3)
-*
-* The vector elements can be addressed individually, if the common block /PAWC/
-* is present, by Q(LLOW+I) or IQ(LLOW+I), with I ranging from 0 to LENTOT-1.
-*
-* The array X should be defined in the calling routine of the right type,
-* INTEGER or REAL, corresponding to the vector type.
-*
-* Input :
-*
- CHARACTER*(*) VECN
-*
-* Input/Output :
-*
- INTEGER X(*)
-*
-* Input :
-*
- INTEGER NELEMS
- CHARACTER*(*) CHOPT
-*
-********************************************************************************
-*
-#include "kuip/kcgen.inc"
-#include "kuip/kcques.inc"
-#include "kuip/kcvect.inc"
- CHARACTER*1 VECTYP
- DIMENSION LENFR(3),LENTO(3),ILOW(3),LENGTH(3),IHIGH(3),ISTEPS(3)
- DIMENSION NDIM(3)
- CHARACTER*64 VNAME,VECNAM
- DIMENSION IOPT(7)
- EQUIVALENCE (IOPT(1),IOPTR),(IOPT(2),IOPTBL),(IOPT(3),IOPTW)
- EQUIVALENCE (IOPT(4),IOPTMI),(IOPT(5),IOPTC),(IOPT(6),IOPTI)
- EQUIVALENCE (IOPT(7),IOPTX)
-
-*
- IQUEST(1)=0
- NELEM=NELEMS
-
- VECNAM=VECN
- CALL CLTOU(VECNAM)
-
- CALL UOPTC(CHOPT,'R W-CIX',IOPT)
-
- IF (IOPTR.GT.0.AND.CHOPT.NE.'R') THEN
- CALL KUALFA
- PRINT *,'*** KUVEC: Option R cannot coexist with other '
- + //'options'
- IQUEST(1)=1
- GO TO 999
- ENDIF
-
- TVECFL=.FALSE.
- CALL KUVECT(VECNAM,LLOW,LHIGH)
- TVECFL=.TRUE.
-
- NCHNAM=IQUEST(10)
- IF (LLOW.GT.0) THEN
- ICOPY=IQUEST(20)
- LENFR(1)=IQUEST(21)
- LENFR(2)=IQUEST(22)
- LENFR(3)=IQUEST(23)
- LENTO(1)=IQUEST(31)
- LENTO(2)=IQUEST(32)
- LENTO(3)=IQUEST(33)
- ELSE
- ICOPY=0
- I1=INDEX(VECNAM,'(')
- I2=INDEX(VECNAM,')')
- NCHSUB=(I2-1)-(I1+1)+1
- DO 5 I=1,3
- LENFR(I)=1
- LENTO(I)=1
- 5 CONTINUE
- IF (NCHSUB.GT.0) THEN
- CALL KIVIND(VECNAM(I1+1:I2-1),NCHSUB,LENFR,LENTO)
- IF (IQUEST(1).NE.0) GO TO 999
- ENDIF
- DO 6 I=1,3
- IF (LENFR(I).GT.LENTO(I)) LENTO(I)=LENFR(I)
- 6 CONTINUE
- ENDIF
-
- DO 8 I=1,3
- ILOW(I)=LENFR(I)
- LENGTH(I)=LENTO(I)-LENFR(I)+1
- 8 CONTINUE
-*
-* Multi-dim vectors accepted only if large enough
-* (i.e. only one-dim vectors can be expanded)
-* and with non-mixed dimensions
-*
- IDIM=1
- III=0
- DO 9 I=1,3
- IF (LENGTH(I).GT.1) THEN
- III=III+1
- IDIM=I
- ENDIF
- 9 CONTINUE
- IF (III.GT.1) THEN
- PRINT *,'*** KUVEC: Cannot handle mixed dimensions for vector '
- + , VECNAM(:NCHNAM)
- IQUEST(1)=1
- GO TO 999
- ENDIF
- IF (NELEM.GT.LENGTH(IDIM)) THEN
- IF ( LLOW.GT.0) THEN
-* upper limit given is smaller/= than real length of vector
- IF ( LENTO(IDIM).LT.IQ(LVECN+10+IDIM) ) THEN
- NELEM=LENGTH(IDIM)
- ELSE
-* need to expand vector, check if 1-d
- IF ( IQ(LVECN+14).NE.1 ) THEN
- PRINT *,'*** KUVEC: Multi-dim vector ',
- + VECNAM(:NCHNAM),' is not large enough'
- IQUEST(1)=1
- GO TO 999
- ENDIF
- ENDIF
-
- ENDIF
- ENDIF
-*
- IF (IOPTC.GT.0.AND.IDIM.EQ.1) LENGTH(1)=NELEM
-*
- IF (LLOW.EQ.0) THEN
-*
-* Vector not existing
-*
- IF (IOPTBL.GT.0.OR.IOPTR.GT.0) THEN
- IQUEST(1)=1
- GO TO 999
- ELSE
-*
-* Create the vector
-*
- VNAME=' '
- WRITE (VNAME,1000) VECNAM(1:NCHNAM),(LENGTH(I),I=1,3)
- 1000 FORMAT (A,'(',I6,',',I6,',',I6,')')
- IF (IOPTI.GT.0) THEN
- VECTYP='I'
- IQUEST(14)=2
- ELSE IF (IOPTX.GT.0) THEN
- VECTYP='C'
- IQUEST(14)=3
- ELSE
- VECTYP='R'
- IQUEST(14)=1
- ENDIF
- CALL KXCRV1(VNAME,VECTYP)
- IF (IQUEST(1).NE.0) GO TO 999
-*
- ENDIF
-*
- ENDIF
-
- IF (ILOW(IDIM).LT.1) THEN
- IQUEST(1)=1
- GO TO 999
- ENDIF
-*
- IF (IOPTBL.GT.0.OR.IOPTR.GT.0) THEN
- IF (NELEM.LT.1.OR.NELEM.GT.LENGTH(IDIM)) NELEM=LENGTH(IDIM)
- ENDIF
-*
- IHIGH(IDIM)=ILOW(IDIM)+NELEM-1
- IF (IHIGH(IDIM).LT.1.OR.IHIGH(IDIM).LT.ILOW(IDIM)) THEN
- IQUEST(1)=1
- GO TO 999
- ENDIF
-* cannot read beyond limits of vector
- IF (IOPTBL.GT.0.OR.IOPTR.GT.0) THEN
- IF (IHIGH(IDIM).GT.IQ(LVECN+10+IDIM)) THEN
- IQUEST(1)=1
- GO TO 999
- ENDIF
- ENDIF
-*
- JJJ=ILOW(1)+IQ(LVECN+11)*(ILOW(2)-1)+
- + IQ(LVECN+11)*IQ(LVECN+12)*(ILOW(3)-1)
- LLOW=LVECN+14+JJJ
- LHIGH=LVECN+14+JJJ+NELEM-1
-*
-* CHOPT='R' - Copy from the vector to the array
-*
- IF (IOPTBL.GT.0.OR.IOPTR.GT.0) THEN
- DO 40 I=1,NELEM
- X(I)=IQ(LLOW+I-1)
- 40 CONTINUE
- GO TO 999
- ENDIF
-*
-* CHOPT='C' - Just create the vector
-*
- IF (IOPTC.GT.0) THEN
- IQUEST(10+IDIM)=LENGTH(IDIM)
- IQUEST(12)=LLOW
- IQUEST(13)=LHIGH
- GO TO 999
- ENDIF
-*
- IF (IOPTW.EQ.0) THEN
- CALL KUALFA
- PRINT *,'*** KUVEC: Unknown option ',CHOPT
- IQUEST(1)=1
- GO TO 999
- ENDIF
-*
-* CHOPT='W'
-*
- IF (IOPTW.GT.0) THEN
-* only shrink/expand 1-d vectors
- IF (IDIM.EQ.1 .AND. IQ(LVECN+14).EQ.1 ) THEN
-*
- ND=ILOW(IDIM)+ NELEM-1 -IQ(LVECN+10+IDIM)
-*
-* If there is a subscript in the vector name,
-* then do not shrink even if options '-' is present
-*
- IF (ND.LT.0 .AND. ILOW(IDIM).GT.1
- + .OR.LENTO(IDIM).LT.IQ(LVECN+10+IDIM) ) ND=0
-*
-* The one-dim vector must be enlarged or shrinked ?
-*
- IF ((ND.GT.0).OR.(ND.LT.0.AND.IOPTMI.GT.0)) THEN
- NL=0
- CALL MZPUSH(IXKUIP,LVECN,NL,ND,' ')
- IQUEST(1)=0
- LENGTH(IDIM)=LENGTH(IDIM) + ND
- IQ(LVECN+10)=IQ(LVECN+10) + ND
- IQ(LVECN+10+IDIM)=IQ(LVECN+10+IDIM) + ND
- LLOW=LVECN+14+ILOW(IDIM)
- LHIGH=LVECN+14+IHIGH(IDIM)
- ENDIF
-*
-* Copy from the array to the one-dim vector
-*
- DO 50 I=1,NELEM
- IQ(LLOW+I-1)=X(I)
- 50 CONTINUE
-*
- IQUEST(10+IDIM)=LENGTH(IDIM)
- IQUEST(12)=LLOW
- IQUEST(13)=LHIGH
-*
- ELSE
-*
-* Copy from the array to the multi-dim vector
-*
- IF (ICOPY.EQ.0) THEN
-*
- DO 70 I=1,NELEM
- IQ(LLOW+I-1)=X(I)
- 70 CONTINUE
-*
- ELSE
-*
- DO 80 I=1,3
- NDIM(I)=IQ(LVECN+10+I)
- IF (LENFR(I).LE.LENTO(I)) THEN
- ISTEPS(I)=1
- ELSE
- ISTEPS(I)=-1
- ENDIF
- 80 CONTINUE
- III=1
- DO 90 K=LENFR(3),LENTO(3),ISTEPS(3)
- DO 90 J=LENFR(2),LENTO(2),ISTEPS(2)
- DO 90 I=LENFR(1),LENTO(1),ISTEPS(1)
- JJJ=I+NDIM(1)*(J-1)+NDIM(1)*NDIM(2)*(K-1)
- LLL=LVECN+14+JJJ
- IQ(LLL)=X(III)
- III=III+1
- 90 CONTINUE
-*
- ENDIF
-*
- ENDIF
- ENDIF
-*
- 999 END
diff --git a/src/packlib/kuip/code_kuip/kuvect.F b/src/packlib/kuip/code_kuip/kuvect.F
deleted file mode 100644
index c48787d..0000000
--- a/src/packlib/kuip/code_kuip/kuvect.F
+++ /dev/null
@@ -1,301 +0,0 @@
-*
-* $Id: kuvect.F,v 1.1.1.1 1996/03/08 15:32:54 mclareni Exp $
-*
-* $Log: kuvect.F,v $
-* Revision 1.1.1.1 1996/03/08 15:32:54 mclareni
-* Kuip
-*
-*
-#include "kuip/pilot.h"
-*CMZ : 2.02/00 15/04/93 18.27.05 by Fons Rademakers
-*-- Author :
- SUBROUTINE KUVECT(VECNAM,LLOW,LHIGH)
-*
-********************************************************************************
-*
-* Get address of vector VECNAM
-*
-* The vector VECNAM can be accessed by Q(LLOW:LHIGH) if ITYPE=1,
-* or IQ(LLOW:LHIGH) if ITYPE=2
-*
-* If the vector is not existing then LLOW=LHIGH=0
-*
-* It returns also in IQUEST :
-*
-* IQUEST(10) : NCHNAM (number of chars of VECNAM)
-* IQUEST(11) : LENTOT (total number of elements of vector)
-* IQUEST(12) : ILOW (low index)
-* IQUEST(13) : IHIGH (high index)
-* IQUEST(14) : ITYPE (type: 1=real, 2=integer, 3=complex)
-* IQUEST(15) : IVEC (vector index, 1<=IVEC<=NUMVEC)
-*
-* IQUEST(20) : ICOPY (if <> 0 a copy on temporary vectory was done,
-* with LENFR and LENTO addresses defined as follow)
-* IQUEST(21) : LENFR(1)
-* IQUEST(22) : LENFR(2)
-* IQUEST(23) : LENFR(3)
-* IQUEST(31) : LENTO(1)
-* IQUEST(32) : LENTO(2)
-* IQUEST(33) : LENTO(3)
-*
-* Input :
-*
- CHARACTER*(*) VECNAM
-*
-* Output :
-*
- INTEGER LLOW
- INTEGER LHIGH
-*
-********************************************************************************
-*
-#include "kuip/kcmcmd.inc"
-#include "kuip/kcgen.inc"
-#include "kuip/kcgen1.inc"
-#include "kuip/kcgen2.inc"
-#include "kuip/kcques.inc"
-#include "kuip/kcvect.inc"
-#include "kuip/kcwork.inc"
- CHARACTER*32 VNAME,VNAM
- CHARACTER*1 TYPE
- DIMENSION LENFR(3),LENTO(3),NDIM(3),NLEN(3)
-*
- VNAME=VECNAM
- CALL CLTOU(VNAME)
- NCHNAM=LENOCC(VNAME)
- I1=INDEX(VNAME,'(')
- IF (I1.GT.1) NCHNAM=I1-1
- IQUEST(10)=NCHNAM
- LLOW=0
- LHIGH=0
-
- IF(NUMVEC.GT.0) THEN
- LVECN=LQ(LVEC-1)
- DO 10 I=1,NUMVEC
- CALL UHTOC(IQ(LVECN+1),4,VNAM,32)
- IF(LENOCC(VNAM).EQ.NCHNAM .AND.
- + VNAM.EQ.VNAME(1:NCHNAM)) GOTO 20
- LVECN=LQ(LVECN)
- 10 CONTINUE
- ENDIF
-*
-*--- on the Piaf server get the vector from the client
- CALL KIVECT(VNAME(1:NCHNAM),LVECN)
- IF(LVECN.EQ.0) GOTO 999
-*
-20 CONTINUE
- IVEC=I
- LENTOT=IQ(LVECN+10)
- ILOW=1
- IHIGH=LENTOT
-
- CALL UHTOC(IQ(LVECN+9),4,TYPE,1)
- IF (TYPE.EQ.'R') THEN
- ITYPE=1
- ELSE IF (TYPE.EQ.'I') THEN
- ITYPE=2
- ELSE IF (TYPE.EQ.'C') THEN
- ITYPE=3
- ELSE
- ITYPE=0
- ENDIF
-
- LENFR(1)=1
- LENFR(2)=1
- LENFR(3)=1
- LENTO(1)=IQ(LVECN+11)
- LENTO(2)=IQ(LVECN+12)
- LENTO(3)=IQ(LVECN+13)
- NLEN(1)=LENTO(1)
- NLEN(2)=LENTO(2)
- NLEN(3)=LENTO(3)
-
- ICOPY=0
-*
- IF (I1.GT.0) THEN
-*
- I3=INDEX(VNAME,')')
- IF (I3.NE.LENOCC(VNAME)) GO TO 999
- NCHSUB=I3-I1-1
- IF (NCHSUB.GT.0) THEN
- CALL KIVIND(VNAME(I1+1:I3-1),NCHSUB,LENFR,LENTO)
- IF (IQUEST(1).NE.0) GO TO 999
-*
-* Special logic for VEC(I) ---> VEC(I,:) if VEC is two-dim
-* Special logic for VEC(I) ---> VEC(I,:,:) if VEC is three-dim
-* Special logic for VEC(I,J) ---> VEC(I,J,:) if VEC is three-dim
-*
- ICOMM1=INDEX(VNAME(I1+1:I3-1),',')
- ICOMM2=0
- IF (ICOMM1.GT.0) ICOMM2=INDEX(VNAME(I1+1+ICOMM1:I3-1),',')
- IF (IQ(LVECN+12).GT.1.AND.ICOMM1.EQ.0) LENTO(2)=IQ(LVECN+12)
- IF (IQ(LVECN+13).GT.1.AND.ICOMM2.EQ.0) LENTO(3)=IQ(LVECN+13)
-*
- ENDIF
-*
-* Check for index out of dimensions
-*
- IF (ITYPE.EQ.3) THEN
- IQ(LVECN+11)=IQ(LVECN+11)*2
- IQ(LVECN+12)=IQ(LVECN+12)*2
- IQ(LVECN+13)=IQ(LVECN+13)*2
- ENDIF
-*
- DO 30 I=1,3
- IF (LENFR(I).EQ.LENTO(I)) THEN
- IF (LENFR(I).LT.1) THEN
- LENFR(I)=1
- LENTO(I)=1
- CALL KUALFA
- PRINT *,'*** Warning: Index < 1'
- ELSE IF (LENFR(I).GT.IQ(LVECN+10+I)) THEN
- CALL KUALFA
- PRINT *,'*** Warning: Index > Dimension_length'
- GO TO 999
- ENDIF
- ELSE
- IF (LENFR(I).LT.1) THEN
- LENFR(I)=1
- CALL KUALFA
- PRINT *,'*** Warning: Low_index < 1'
- ENDIF
- IF (LENFR(I).GT.IQ(LVECN+10+I)) THEN
- CALL KUALFA
- PRINT *,'*** Warning: Index > Dimension_length'
- GO TO 999
- ENDIF
- IF (LENTO(I).GT.IQ(LVECN+10+I)) THEN
- LENTO(I)=IQ(LVECN+10+I)
- CALL KUALFA
- PRINT *,'*** Warning: High_index > Dimension_length'
- ENDIF
- ENDIF
- NDIM(I)=LENTO(I)-LENFR(I)+1
-30 CONTINUE
-*
- IF (ITYPE.EQ.3) THEN
- IQ(LVECN+11)=IQ(LVECN+11)/2
- IQ(LVECN+12)=IQ(LVECN+12)/2
- IQ(LVECN+13)=IQ(LVECN+13)/2
- ENDIF
-*
-* TVECFL is set to .FALSE. by routines that has to write
-* on the vector, like KXINPV, KXREAV, etc.
-*
- IF (NDIM(3).NE.1) THEN
- IF (NLEN(2).NE.NDIM(2) .OR. NLEN(1).NE.NDIM(1)) THEN
- ICOPY=1
- ENDIF
- ELSEIF (NDIM(2).NE.1) THEN
- IF (NLEN(1).NE.NDIM(1)) THEN
- ICOPY=1
- ENDIF
- ENDIF
- IF (ICOPY.EQ.0) THEN
- ILOW = LENFR(1) + NLEN(1)*(LENFR(2)-1)
- + + NLEN(1)*NLEN(2)*(LENFR(3)-1)
- IHIGH= LENTO(1) + NLEN(1)*(LENTO(2)-1)
- + + NLEN(1)*NLEN(2)*(LENTO(3)-1)
- LLOW=LVECN+14+ILOW
- LHIGH=LVECN+14+IHIGH
- ELSE
-*
-* If vector elements are not consecutive in memory
-* create a temporary bank with all elements consecutively copied:
-* check first if there are free vector addresses
-*
- NVADD=NVADD+1
- IF (NVADD.GT.MAXLVA) THEN
- PRINT *,'*** Too many temporary vectors'
- IQUEST(1)=1
- GO TO 999
- ENDIF
-*
-* Check if there is enough space
-*
- ND=NDIM(1)*NDIM(2)*NDIM(3)
- LLL=50+ND
- IX=IXPAWC+1
- CALL MZNEED(IX,LLL,'G')
- IQUEST(1)=0
- IF (IQUEST(11).LT.0) THEN
- PRINT *,'*** Not enough memory to store temporary vector'
- IQUEST(1)=1
- GO TO 999
- ENDIF
-*
-* Book the bank in the division IXPAWC+1
-*
- NL=0
- NS=0
- IOTEMP=0
- IX=IXPAWC+1
- CALL MZBOOK(IX,LVADDR(NVADD),LVADDR(NVADD),1,'TEMP',
- + NL,NS,ND,IOTEMP,0)
-*
-* Copy from the vector in division IXKUIP to the temporary one in IXPAWC+1
-*
- III=0
- DO 40 K=LENFR(3),LENTO(3)
- DO 40 J=LENFR(2),LENTO(2)
- DO 40 I=LENFR(1),LENTO(1)
- III=III+1
- JJJ=I+IQ(LVECN+11)*(J-1)+IQ(LVECN+11)*IQ(LVECN+12)*(K-1)
- IQ(LVADDR(NVADD)+III)=IQ(LVECN+14+JJJ)
-40 CONTINUE
- ILOW=1
- IHIGH=III
- LLOW=LVADDR(NVADD)+1
- LHIGH=LLOW+III-1
- ENDIF
-*
- ELSE
-*
- IF (ILOW.GT.LENTOT) THEN
- ILOW=LENTOT
- CALL KUALFA
- PRINT *,'*** Warning: Low_index > vector_length'
- ENDIF
- IF (IHIGH.LT.1) THEN
- IHIGH=1
- CALL KUALFA
- PRINT *,'*** Warning: High_index < 1'
- ENDIF
- IF (IHIGH.GT.LENTOT) THEN
- IHIGH=LENTOT
- CALL KUALFA
- PRINT *,'*** Warning: High_index > vector_length'
- ENDIF
-
- LLOW=LVECN+14+ILOW
- LHIGH=LVECN+14+IHIGH
-
- ENDIF
-
- IQUEST(10)=NCHNAM
- IQUEST(11)=LENTOT
- IQUEST(12)=ILOW
- IQUEST(13)=IHIGH
- IQUEST(14)=ITYPE
- IQUEST(15)=IVEC
-
- IQUEST(20)=ICOPY
- IQUEST(21)=LENFR(1)
- IQUEST(22)=LENFR(2)
- IQUEST(23)=LENFR(3)
- IQUEST(31)=LENTO(1)
- IQUEST(32)=LENTO(2)
- IQUEST(33)=LENTO(3)
-
- IF (VNAME(1:NCHNAM).EQ.'?') THEN
- I1=LOCF(VECTOR(ILOW))
- I2=LOCF(Q(LLOW))
- LLOW=LLOW+I1-I2
-*** LHIGH=LLOW+LENTOT-1
- LHIGH=LLOW+IHIGH-ILOW
- ENDIF
-
-999 END
-
-
-
diff --git a/src/packlib/kuip/code_kuip/kuvers.c b/src/packlib/kuip/code_kuip/kuvers.c
deleted file mode 100644
index 050e325..0000000
--- a/src/packlib/kuip/code_kuip/kuvers.c
+++ /dev/null
@@ -1,90 +0,0 @@
-/*
- * $Id: kuvers.c,v 1.19 2003/02/13 14:27:02 couet Exp $
- *
- * $Log: kuvers.c,v $
- * Revision 1.19 2003/02/13 14:27:02 couet
- * - 2.09/00
- *
- * Revision 1.18 2001/05/23 15:22:36 couet
- * - 2.08/03
- *
- * Revision 1.17 2000/01/24 09:25:48 couet
- * - 2.08/02
- *
- * Revision 1.16 2000/01/21 13:31:01 couet
- * - 2.08/01
- *
- * Revision 1.15 2000/01/10 10:49:50 couet
- * - 2.08/00
- *
- * Revision 1.14 1999/11/24 10:07:24 couet
- * - 2.07/18
- *
- * Revision 1.13 1999/01/05 14:45:51 couet
- * - 2.07/17
- *
- * Revision 1.12 1998/11/10 09:50:31 couet
- * - Y2K
- *
- * Revision 1.11 1998/04/09 12:57:00 couet
- * - Compilation date removed from the vidqq string: it was meaningless
- *
- * Revision 1.10 1997/09/25 14:02:27 cremel
- * VECTOR WRITE (kxwriv.F): increase limitation of number of vectors in the
- * list VLIST from 10 to 30 (same value as in kxreav.F for VECTOR/READ).
- * Update HELP for VECTOR/WRITE and VECTOR/READ and mention explicitely this
- * limitation. Improve error message in kxwriv.F and kxreav.F by
- * adding explicitely VECTOR/WRITE and VECTOR/READ.
- * + Increase KUIP version number to 2.07/16 (25/09/97).
- *
- * Revision 1.9 1997/08/29 10:08:55 cremel
- * Increase version number to 2.07/15.
- *
- * Revision 1.8 1997/07/08 09:48:22 cremel
- * New version 2.07/14 :
- * bug correction in VECTOR/READ (for free FORMAT suppress the limitation of
- * 80 characters and protect the code when number of tokens > 50) -
- * see example: vec2.kumac + vec2.dat + vec2bad.dat
- *
- * Revision 1.7 1997/06/18 12:13:06 couet
- * - vers ++
- *
- * Revision 1.6 1997/03/11 09:43:44 cremel
- * Bug correction in command WAIT (after answering "Q" to a "WAIT" statement,
- * the ability to issue several HISTOGRAM/PLOT statements on a single line,
- * separated by semicolons, disappears).
- * kexec.c : add a test on the variable "kc_flags.in_macro".
- * kuvers.c : increase version number to 2.07/13
- *
- * Revision 1.5 1997/03/04 14:03:15 cremel
- * Increase KUIP version to 2.07/12 with the date of modification (commit)
- * for routine kxlisv.F (bug correction in VECTOR/LIST).
- *
- * Revision 1.4 1997/01/21 08:15:55 cremel
- * Increase version number for KUIP: 2.07/11
- *
- * Revision 1.3 1996/10/24 12:08:08 cremel
- * Version 2.07/10
- *
- * Revision 1.2 1996/10/14 09:01:34 cremel
- * Change place of initialization for do_exit and do_quit (from kuwhat to
- * kuinit) in order to allow "exit" in pawlogon.kumac.
- *
- * Revision 1.1.1.1 1996/03/08 15:32:58 mclareni
- * Kuip
- *
- */
-/*-- Author : Maarten Ballintijn 01/03/95*/
-
-static char vidqq[] =
-"@(#)KUIP 2.09/00 13/02/2003 15:25.00";
-
-/*
- * Return the static version string for KUIP
- */
-
-char * ku_vers()
-{
- /* skip the 4 char that contain the "what" string */
- return &vidqq[4];
-}
diff --git a/src/packlib/kuip/code_kuip/kuwhag.c b/src/packlib/kuip/code_kuip/kuwhag.c
deleted file mode 100644
index 50ec859..0000000
--- a/src/packlib/kuip/code_kuip/kuwhag.c
+++ /dev/null
@@ -1,679 +0,0 @@
-/*
- * $Id: kuwhag.c,v 1.2 1997/03/17 16:55:02 mclareni Exp $
- *
- * $Log: kuwhag.c,v $
- * Revision 1.2 1997/03/17 16:55:02 mclareni
- * WNT mods
- *
- * Revision 1.1.1.1.2.1 1997/01/21 11:32:53 mclareni
- * All mods for Winnt 96a on winnt branch
- *
- * Revision 1.1.1.1 1996/03/08 15:32:58 mclareni
- * Kuip
- *
- */
-/*CMZ : 2.07/03 09/05/95 11.54.42 by N.Cremel*/
-/*-- Author :*/
-
-#include "kuip/kuip.h"
-#include "kuip/kfor.h"
-#include "kuip/kcom.h"
-#include "kuip/klink.h"
-#include "kuip/kmenu.h"
-#include "kuip/kflag.h"
-
-
-#define MAX_MENU_LEVEL 16
-static int redraw_menu_level = 0;
-static int last_menu_choice[MAX_MENU_LEVEL];
-
-
-static int higz_init( int );
-static void input_styleG(void);
-static char* disp_all_lines(void);
-static char* disp_all_menus( const char* );
-static char* disp_one_line( int, double, double, double, double, const char* );
-static char* disp_one_menu( KmMenu*, float*, const char*, int* );
-static char* disp_cmd_menu( KmCommand*, double, const char* );
-static char* request_input( char*, double );
-static int disp_menu( const char*, double, double, double, double, int,
- const char*, int, int, const char*, int,
- const char*, int, const char*, int, const char*, int );
-
-
-/*
- * command loop with graphics menus
- */
-void F77_ENTRY(Kuwhag)
-/* { */
- ku_whag();
-}
-
-
-void ku_whag()
-{
- kc_window.kuwhag_called = 1;
- kjmpaddr.higz_init_C = higz_init;
-
- ku_what( input_styleG );
-}
-
-
-/*
- * initialize HIGZ if not yet done
- */
-static
-int higz_init( int wk_type )
-{
- INTEGER iwk = wk_type;
-
- if( Pawc->IXHIGZ == 0 ) {
- INTEGER nwhigz = 100;
- INTEGER lun_error = 6;
- REAL xrange = 1;
- REAL yrange = 1;
-
- Iginit( &nwhigz );
- if( iwk == 0 )
- Igwkty( &iwk );
- Igsse( &lun_error, &iwk );
- Igrng( &xrange, &yrange );
- }
- return iwk;
-}
-
-
-static
-void input_styleG()
-{
- char *path = "";
- REAL sgsize = kc_window.sgsize;
- INTEGER wkid = 1;
- INTEGER flag = 1;
- int old_style = kc_flags.style;
- int i;
-
- higz_init( 0 ); /* in case STYLE G executed before KUWHAG */
- Igsrap( &sgsize );
- Iclrwk( &wkid, &flag );
-
- redraw_menu_level = 0;
- for( i = 0; i < MAX_MENU_LEVEL; i++ )
- last_menu_choice[i] = 0;
-
- while( kc_flags.style == old_style
- && !kc_flags.do_exit && !kc_flags.do_quit ) {
- char *line;
-
- if( old_style & KmSTYLE_xP ) {
- /* style GP */
- if( kc_window.panel_rows > 0 ) {
- line = disp_all_lines();
- }
- else {
- printf( " *** No panel defined\n" );
- line = strdup( "/KUIP/SET_SHOW/STYLE C" );
- }
- ku_last( line );
- ku_exel( line );
- free( line );
- }
- else {
- /* style G */
- line = disp_all_menus( path );
-
- if( strchr( line, ' ' ) == NULL ) {
- path = line;
- }
- else {
- /* command lines contain a blank */
- ku_last( line );
- ku_exel( line );
- free( line );
- }
- }
- }
-
- sgsize = 1;
- Igsrap( &sgsize );
- Iclrwk( &wkid, &flag );
-}
-
-
-/*
- * display all panel lines
- * return the command string
- */
-static
-char *disp_all_lines()
-{
- float x1 = kc_window.sgbord;
- float x2 = 1 - kc_window.sgbord;
- float y2 = 1 - kc_window.sgyspa;
- float dy = kc_window.sgylen;
- float y;
- int n;
- char *item = NULL;
-
- for( y = y2, n = 0; n < kc_window.panel_rows; n++ ) {
- disp_one_line( n, x1, x2, y - dy, y, "D" );
- y -= dy;
- }
-
- do {
- static char opt[] = " CU";
- opt[0] = ' '; /* request locator each time around */
- for( y = y2, n = 0; n < kc_window.panel_rows && item == NULL; n++ ) {
- item = disp_one_line( n, x1, x2, y - dy, y, opt );
- y -= dy;
- opt[0] = 'N'; /* look if locator inside other menu */
- }
- } while( item == NULL );
-
- return request_input( item, x2 );
-}
-
-
-/*
- * request additional input if button label contains special characters
- */
-static
-char *request_input( char *item,
- double x2 )
-{
- float x1 = kc_window.sgbord;
- float y1 = kc_window.sgsize + kc_window.sgyspa;
- float dy = kc_window.sgylen;
- char *dollar = NULL;
- char *line;
- char *p;
- int n;
-
- /* strip comments before looking for special characters */
- if( (p = strchr( item, '|' )) != NULL ) {
- *p = '\0';
- }
-
- for( n = strlen( item ); n > 0 && item[n-1] == ' '; n-- )
- item[n-1] = '\0'; /* strip trailing blanks */
-
- if( item[n-1] == '-' || (dollar = strchr( item, '$' )) != NULL ) {
- /* request additional input */
- char chval[80];
- int lchval = (sizeof chval);
- int choice;
-
- memset( chval, ' ', lchval );
- choice = disp_menu( NULL, x1, x2, y1, y1 + dy, 0, NULL, 0,
- 1, item, n, NULL, 0, chval, lchval, "IE", 0 );
-
- if( choice == -1000 ) {
- line = strdup( "/KUIP/SET_SHOW/STYLE C" );
- }
- else {
- char *reply = fstrdup( chval, lchval );
-
- if( dollar != NULL ) {
- /* replace "ABC$DEF" by "ABCinputDEF" */
- *dollar = '\0';
- line = str3dup( item, reply, dollar + 1 );
- }
- else if( n > 1 && item[n-2] == '-' ) {
- /* replace "ABC--" by "ABCinput" */
- item[n-2] = '\0';
- line = str2dup( item, reply );
- }
- else {
- /* replace "ABC-" by "ABC input" */
- item[n-1] = ' ';
- line = str2dup( item, reply );
- }
- free( reply );
- }
- free( item );
- }
- else
- line = item;
-
- /* append a blank to make it an executable command for the main loop */
- if( strchr( line, ' ' ) == NULL )
- line = mstrcat( line, " " );
-
- return line;
-}
-
-
-static
-char *disp_one_line( int row,
- double x1,
- double x2,
- double y1,
- double y2,
- const char *mopt )
-{
- int nbutton = kc_window.panel_cols[row];
- char *button;
- size_t lbutton = 0;
- char *line = NULL;
-
- if( nbutton > 0 ) {
- char *opt = str2dup( "HT", mopt );
- int choice;
-
- button = fstrvec( kc_window.panel_keys[row], nbutton, &lbutton );
- choice = disp_menu( NULL, x1, x2, y1, y2, nbutton, button, lbutton,
- 0, NULL, 0, NULL, 0, NULL, 0, opt, 0 );
- free( button );
- free( opt );
-
- if( choice == -1000 ) {
- line = strdup( "/KUIP/SET_SHOW/STYLE C" );
- }
- else {
- int n = -choice;
- if( n > 0 && n <= nbutton ) {
- line = str0dup( kc_window.panel_keys[row][n-1] );
- if( kc_window.panel_keyval != NULL )
- free( kc_window.panel_keyval );
- kc_window.panel_keyval =
- (line != NULL) ? str3dup( "'", line, "'" ) : NULL;
- if( kc_window.panel_keynum == NULL )
- kc_window.panel_keynum = malloc( 16 );
- sprintf( kc_window.panel_keynum, "%d.%s", row + 1, strfromi( n, 2 ) );
- }
- }
- }
-
- return line;
-}
-
-
-/*
- * display all graphics menus down to the level of the submenu
- * return the path of the selected menu or command
- */
-static
-char *disp_all_menus( const char *path )
-{
- KmCommand *cmd = NULL;
- KmMenu *menu_list[MAX_MENU_LEVEL];
- char *subpath = strdup( path );
- char *item = NULL;
- float x1 = kc_window.sgbord;
- float x2 = 1 - kc_window.sgbord;
- float y2 = 1 - kc_window.sgyspa;
- float dy = kc_window.sgylen;
- float y;
- int n;
- float ymhi0 = y2;
- float ymhi;
- int lev = 0;
- char *p;
- int i;
-
- /* build the list of menu paths, e.g. "/KUIP/ALIAS", "/KUIP", "" */
- while( (p = strrchr( subpath, '/' )) != NULL ) {
- menu_list[lev++] = find_submenu( subpath );
- *p = '\0';
- }
- free( subpath );
- menu_list[lev++] = find_submenu( "" );
-
- if( menu_list[0] == NULL ) {
- /* path can be a command */
- cmd = search_command( path, NULL );
- for( i = 1; i < lev; i++ )
- menu_list[i-1] = menu_list[i];
- lev--;
- }
-
- for( i = 0; i < lev / 2; i++ ) {
- /* invert menu_list order */
- KmMenu *m = menu_list[i];
- menu_list[i] = menu_list[lev-i-1];
- menu_list[lev-i-1] = m;
- }
-
- /* display panel first if defined */
- if( kc_window.panel_rows > 0 ) {
- for( y = y2, i = 0; i < kc_window.panel_rows; i++ ) {
- disp_one_line( i, x1, x2, y - dy, y, "D" );
- y -= dy;
- }
- ymhi0 = y - kc_window.sgyspa;
- }
-
- /* display all menus top down*/
- for( ymhi = ymhi0, i = 0; i < lev; i++ ) {
- char *opt = (i < redraw_menu_level) ? "" : "D";
- disp_one_menu( menu_list[i], &ymhi, opt, NULL );
- }
- if( cmd != NULL )
- disp_cmd_menu( cmd, ymhi0, "D" );
-
- do {
- static char opt[] = "NC ";
- opt[0] = ' '; /* request locator each time around */
-
- if( kc_window.panel_rows > 0 ) {
- opt[2] = 'U'; /* update user keys */
- for( y = y2, n = 0; n < kc_window.panel_rows && item == NULL; n++ ) {
- item = disp_one_line( n, x1, x2, y - dy, y, opt );
- y -= dy;
- opt[0] = 'N'; /* look if locator inside other menu */
- }
- opt[2] = ' ';
- if( item != NULL ) {
- /* erase command menu before additional input request */
- if( cmd != NULL )
- disp_cmd_menu( cmd, ymhi0, "E" );
- return request_input( item, kc_window.sgsize - kc_window.sgbord );
- }
- }
-
- for( ymhi = ymhi0, i = 0; i < lev && item == NULL; i++ ) {
- item = disp_one_menu( menu_list[i], &ymhi, opt, &last_menu_choice[i] );
- opt[0] = 'N'; /* look if locator inside other menu */
- }
- if( item != NULL ) {
- /* number of topmenus we don't have to redraw the next time around */
- redraw_menu_level = i;
- /* erase all lower submenus */
- for( ; i < lev; i++ )
- disp_one_menu( menu_list[i], &ymhi, "E", &last_menu_choice[i] );
- if( cmd != NULL )
- disp_cmd_menu( cmd, ymhi0, "E" );
- }
- else if( cmd != NULL )
- item = disp_cmd_menu( cmd, ymhi0, opt );
- } while( item == NULL );
-
- return item;
-}
-
-
-/*
- * display graphics menu
- * return the path of the selected menu
- */
-static
-char *disp_one_menu( KmMenu *submenu,
- float *yhi,
- const char *mopt,
- int *return_choice )
-{
- float x1 = kc_window.sgsize + kc_window.sgbord;
- float x2 = 1 - kc_window.sgbord;
- float y1;
- float y2 = *yhi;
- int nitem;
- char *item;
- size_t litem = 0;
- char **items = (char**)malloc( sizeof(char*) );
- int choice;
- int last_choice = (return_choice != NULL) ? *return_choice : 0;
- char *opt = str2dup( "HT", mopt );
- int ncmds;
- int n = 0;
- KmMenu *menu;
- KmCommand *cmd;
-
- for( cmd = submenu->cmds; cmd != NULL; cmd = cmd->next ) {
- char *mark = (cmd->hidden || (cmd->action_F == NULL
- && cmd->action_C == NULL)) ? "-" : "";
- items = (char**)realloc( (char*)items, (n+1) * sizeof(char*) );
- items[n++] = str2dup( mark, cmd->name );
- }
- ncmds = n;
-
- for( menu = submenu->down; menu != NULL; menu = menu->next ) {
- items = (char**)realloc( (char*)items, (n+1) * sizeof(char*) );
- items[n++] = str2dup( "|", menu->name );
- }
- nitem = n;
-
- item = strlower( fstrvec( items, n, &litem ) );
-
- for( n = 0; n < nitem; n++ )
- free( items[n] );
- free( (char*)items );
-
- y1 = y2 - nitem * kc_window.sgylen;
- *yhi = y1 - kc_window.sgyspa;
-
- choice = disp_menu( NULL, x1, x2, y1, y2, 0, NULL, 0,
- nitem, item, litem, NULL, 0, NULL, 0, opt, last_choice );
-
- free( item );
- free( opt );
-
- if( choice == -1000 ) {
- return strdup( "/KUIP/SET_SHOW/STYLE C" );
- }
- else if( choice > 0 && choice <= nitem ) {
- if( return_choice != NULL )
- *return_choice = choice;
- if( --choice < ncmds ) {
- for( cmd = submenu->cmds, n = 0; n < choice; n++ )
- cmd = cmd->next;
- return cmd->path;
- }
- else {
- for( menu = submenu->down, n = ncmds; n < choice; n++ )
- menu = menu->next;
- return menu->path;
- }
- }
- else
- return NULL;
-}
-
-
-/*
- * display graphics panel for cmd
- * return the path of the selected menu
- */
-static
-char *disp_cmd_menu( KmCommand *cmd,
- double y2,
- const char *mopt )
-{
- char *title = cmd->path;
- float x1 = kc_window.sgbord;
- float x2 = kc_window.sgsize - kc_window.sgbord;
- float y1;
- float y0 = kc_window.sgsize + kc_window.sgyspa;
- int nbutton = (cmd->hidden || (cmd->action_F == NULL
- && cmd->action_C == NULL)) ? 1 : 2;
- static char *button = NULL;
- static size_t lbutton;
- int nitem = 0;
- char *item;
- size_t litem;
- char **items = (char**)malloc( cmd->total * sizeof(char*) );
- char *pdef;
- size_t lpdef;
- char **pdefs = (char**)malloc( cmd->total * sizeof(char*) );
- int lpval = 20 * sizeof(INTEGER);
- char *pval = (char*)memset( malloc( cmd->total * lpval ), ' ',
- cmd->total * lpval );
- int choice;
- char *opt = str2dup( "HP", mopt );
- char *line = NULL;
- int n;
-
- if( button == NULL ) {
- static char *labels[] = { "Help", "Execute" };
- button = fstrvec( labels, (sizeof labels) / sizeof(char*), &lbutton );
- }
-
- for( n = 0; n < cmd->total; n++ ) {
- KmParameter *par = cmd->par[n];
-
- if( (par->flags & KmFLAG_HIDDEN) == 0 ) {
- char *mark = (n < cmd->mandatory) ? "|" : "";
-
- items[nitem] = str2dup( mark, par->prompt );
-
- if( par->last != NULL )
- pdefs[nitem] = strdup( par->last );
- else if( par->dfault != NULL )
- pdefs[nitem] = strdup( par->dfault );
- else
- pdefs[nitem] = strdup( "" );
-
- if( strcmp( pdefs[nitem], " " ) == 0 )
- pdefs[nitem][0] = '\0';
-
- if( par->range_count > 0 ) {
- char *p = strdup( pdefs[nitem] );
- int i;
- for( i = 0; i < par->range_count; i++ ) {
- if( strcasecmp( par->range_value[i], p ) != 0 ) {
- if( pdefs[nitem][0] == '\0' )
- pdefs[nitem] = mstrcat( pdefs[nitem], " " );
- pdefs[nitem] = mstr2cat( pdefs[nitem], ",", par->range_value[i] );
- if( par->range_value[i][0] == '\0' )
- pdefs[nitem] = mstrcat( pdefs[nitem], " " );
- }
- }
- free( p );
- }
- nitem++;
- }
- }
-
- item = fstrvec( items, nitem, &litem );
- pdef = fstrvec( pdefs, nitem, &lpdef );
-
- for( n = 0; n < nitem; n++ ) {
- free( items[n] );
- free( pdefs[n] );
- }
-
- y1 = y2 - (nitem + 2) * kc_window.sgylen;
- if( y1 < y0 )
- y1 = y0;
-
- choice = disp_menu( title, x1, x2, y1, y2, nbutton, button, lbutton,
- nitem, item, litem, pdef, lpdef, pval, lpval, opt, 0 );
-
- free( item );
- free( pdef );
- free( opt );
-
- if( choice == -1000 ) {
- line = strdup( "/KUIP/SET_SHOW/STYLE C" );
- }
- else if( choice == -1 ) {
- line = str2dup( "/KUIP/HELP ", cmd->path );
- }
- else if( choice == -2 ) {
- int kitem = 0;
- line = str2dup( cmd->path, " " );
-
- for( n = 0; n < cmd->total; n++ ) {
- KmParameter *par = cmd->par[n];
-
- if( (par->flags & KmFLAG_HIDDEN) == 0 ) {
- char *arg = fstr0dup( pval + kitem * lpval, lpval );
-
- if( arg == NULL ) {
- if( n < cmd->mandatory )
- line = mstrcat( line, " ' '" );
- else
- line = mstrcat( line, " !" );
- }
- else {
- if( strchr( arg, '\'' ) == NULL && strchr( arg, ' ' ) != NULL )
- line = mstr3cat( line, " '", arg, "'" );
- else
- line = mstr2cat( line, " ", arg );
- free( arg );
- }
- kitem++;
- }
- else {
- line = mstrcat( line, " !" );
- }
- }
- }
- free( pval );
-
- return line;
-}
-
-
-static
-int disp_menu( const char *title,
- double x1,
- double x2,
- double y1,
- double y2,
- int nbutton,
- const char *button,
- int lbutton,
- int nitem,
- const char *item,
- int litem,
- const char *dfault,
- int ldfault,
- const char *value,
- int lvalue,
- const char *option,
- int last_choice )
-{
- static char *blank = NULL;
- static size_t lblank = 0;
- int ltitle;
- INTEGER MN = 0;
- REAL X1 = x1;
- REAL X2 = x2;
- REAL Y1 = y1;
- REAL Y2 = y2;
- INTEGER NBU = nbutton;
- INTEGER N = nitem;
- INTEGER ICHOIC = last_choice;
- char *opt = strdup( option );
-
- if( blank == NULL )
- blank = fstrvec( NULL, 0, &lblank );
-
- if( title == NULL )
- title = " ";
- ltitle = strlen( title );
-
- if( button == NULL ) {
- button = blank;
- lbutton = lblank;
- }
-
- if( dfault == NULL ) {
- dfault = blank;
- ldfault = lblank;
- }
-
- if( value == NULL ) {
- value = blank;
- lvalue = lblank;
- }
-
- if( kc_flags.style & KmSTYLE_xS ) /* software characters */
- opt = mstrcat( opt, "S" );
-
- if( kc_flags.style & KmSTYLE_xW ) /* shadow width */
- opt = mstrcat( opt, "W" );
-
- if( kc_flags.style & KmSTYLE_G ) {
- F77_CALL_xCx5CxC3xC(Igmenu,&MN,title,ltitle,
- &X1,&X2,&Y1,&Y2,&NBU,button,lbutton,
- &N,item,litem,dfault,ldfault,value,lvalue,
- &ICHOIC,opt,strlen(opt));
- }
-
- free( opt );
-
- return ICHOIC;
-}
-
-
diff --git a/src/packlib/kuip/code_kuip/kuwhat.c b/src/packlib/kuip/code_kuip/kuwhat.c
deleted file mode 100644
index 7a149b9..0000000
--- a/src/packlib/kuip/code_kuip/kuwhat.c
+++ /dev/null
@@ -1,2115 +0,0 @@
-/*
- * $Id: kuwhat.c,v 1.9 2005/04/18 15:23:10 mclareni Exp $
- *
- * $Log: kuwhat.c,v $
- * Revision 1.9 2005/04/18 15:23:10 mclareni
- * Mods submitted by Kevin B. McCarty to fix insecure Cernlib uses of /tmp.
- *
- * Revision 1.8 1999/03/10 17:11:52 mclareni
- * Correct lower to upper case file name conversion
- *
- * Revision 1.7 1998/08/25 12:47:40 mclareni
- * QMGLIBC changes for Linux RH51
- *
- * Revision 1.6 1997/11/28 17:27:00 mclareni
- * Numerous mods and some new routines to get Control-C working reasonably on NT
- *
- * Revision 1.5 1997/03/24 12:51:05 gunter
- * Merge changes done for WinNT:
- * - adding F77_ENTRY to Kuwhat, Kisigm, Kualfa and Kuqcas.
- * - Adding signal stuff for float exceptions, adding fpceck, and calling
- * this from what_loop
- *
- * Revision 1.4 1997/02/20 13:21:32 cremel
- * Reset global flags do_exit and do_quit to "false" before returning
- * from the "what_loop" in case kuwhat is called several times in the main
- * program (cf. mail from Mark Lakata who is using KUIP in his event display
- * program)
- *
- * Revision 1.3 1996/10/14 09:01:36 cremel
- * Change place of initialization for do_exit and do_quit (from kuwhat to
- * kuinit) in order to allow "exit" in pawlogon.kumac.
- *
- * Revision 1.2.2.1 1997/01/21 11:32:54 mclareni
- * All mods for Winnt 96a on winnt branch
- *
- * Revision 1.2 1996/04/04 09:15:20 cernlib
- * In ku_pros added a strdup before returning the default
- *
- * Revision 1.1.1.1 1996/03/08 15:32:59 mclareni
- * Kuip
- *
- */
-/*CMZ : 2.07/04 23/05/95 11.21.15 by Gunter Folger*/
-/*-- Author : N.Cremel*/
-
-#include "kuip/kuip.h"
-#include "kuip/kfor.h"
-#include "kuip/kcom.h"
-#include "kuip/ksig.h"
-#include "kuip/kmenu.h"
-#include "kuip/kflag.h"
-#include "kuip/khash.h"
-#include "kuip/kalias.h"
-#include "kuip/klink.h"
-#include "kuip/kmpanel.h"
-#include "kuip/mkterm.h"
-
-static char *mline = NULL;
-
-static struct {
- int count; /* number of lines in buffer */
- char **lines; /* buffer of recorded lines */
- char *kumac; /* file name of LAST.KUMAC */
- int frequency; /* recording frequency */
- int flush; /* count of next flush */
- time_t start; /* starting time */
-} cmd_hist;
-
-
-static void panel_setopt (int row, int col, char *option);
-static void panel_fill( int, int, const char* );
-static void panel_filp( int, int, const char*, const char* );
-static void panel_free( int );
-static void panel_push( int, int );
-static int out_last_kumac( int );
-static void set_prompt( const char* );
-static char* subst_event( const char* );
-static int what_loop( void(*)() );
-
-/*
- * C callable interface to command "panel ... "
- * (called by action routine kxpanel)
- *
- * 1) km_panel_close ("panel 0 c ...")
- * 2) km_panel_display ("panel 0 d ...")
- * 3) km_panel_reset ("panel 0 r ...")
- * 4) km_panel_key ("panel x.y command [alias_label] [pixmap]"
- * for key definitions )
- * 5) km_panel_key_opt ("panel x.y command [alias_label] [pixmap] [opt]"
- */
-
-/* 1) Close panel (km_close_kpanel) */
-void km_panel_close (title)
- char *title; /* if NULL close last created (current) panel */
-{
- if ( kc_window.palette_flag == 0 && kjmpaddr.close_kpanel_C != NULL )
- (*kjmpaddr.close_kpanel_C)( title );
-}
-
-/* 2) Display panel (km_display_kpanel) */
-void km_panel_display (title, geometry)
- char *title, *geometry; /* if NULL use default values */
-{
- /* Protect empty panels */
- if( kc_window.panel_rows == 0 ||
- kc_window.panel_cols == NULL ||
- kc_window.panel_keys == NULL ) {
- printf ("* Error: panel is emty\n");
- return; }
-
- if (title != NULL ) kc_window.panel_title = strdup (title);
- if (kc_window.palette_flag < 0) return;
- if (!kc_window.palette_flag) {
- if( kjmpaddr.disp_kpanel_C != NULL )
- (*kjmpaddr.disp_kpanel_C)( title, geometry );
- } else {
- if( kjmpaddr.disp_kmpanel_C != NULL )
- (*kjmpaddr.disp_kmpanel_C)( NULL, title, geometry );
- }
-}
-
-/* 3) km_panel_reset ("panel 0 r ...") */
-void km_panel_reset( const char* name ) /* can be NULL */
-{
- int i;
-
- for( i = 0; i < kc_window.panel_rows; i++ ) {
- panel_free( i + 1 );
- }
-
- if( kc_window.panel_rows != 0 ) {
- kc_window.panel_rows = 0;
- free( (char*)kc_window.panel_cols );
- kc_window.panel_cols = NULL;
- free( (char*)kc_window.panel_keys );
- kc_window.panel_keys = NULL;
- free( (char*)kc_window.panel_icons );
- kc_window.panel_icons = NULL;
- free( (char*)kc_window.panel_opts );
- kc_window.panel_opts = NULL;
- }
-
- if( kc_window.panel_title != NULL ) {
- free( kc_window.panel_title);
- kc_window.panel_title = NULL;
- }
- if( kc_window.panel_name != NULL ) {
- free( kc_window.panel_name);
- kc_window.panel_name = NULL;
- }
- if( name != NULL )
- kc_window.panel_name = strdup (name);
-}
-
-/* 4) km_panel_key ("panel ..." for key definitions ) */
-void km_panel_key (row, col, command, alias_label, pixmap)
- int row, col;
- char *command, *alias_label, *pixmap;
-{
- km_panel_key_opt (row, col, command, alias_label, pixmap, NULL);
-}
-
-/* 5) km_panel_key_opt ("panel ..." for key definitions ) */
-void km_panel_key_opt (row, col, command, alias_label, pixmap, opt)
- int row, col;
- char *command, *alias_label, *pixmap, *opt;
-{
- if (alias_label == NULL && pixmap == NULL) {
- /* panel x.y command */
- panel_fill( row, col, command );
-
- if (opt != NULL) { /* options defined */
- panel_setopt ( row, col, opt);
- }
- } else {
- /* panel x.y command [alias_label] [pixmap] [opt] */
- char *key;
- char *al_command = NULL;
-
- key = command;
-
- if( alias_label != NULL && strcmp( alias_label, "." ) != 0 ) {
- /* alias for button label is defined */
-
- key = alias_label;
-
- if ( command != NULL && strcmp( command, "." ) != 0 ) {
- char *cm = strdup(command);
- char *al = strdup(alias_label);
-
- cm = quote_string( cm, 1 );
- /* trim leading and trailing blanks fo valid alias name */
- if (kc_window.panel_name != NULL)
- al = mstr2cat (al, "_", kc_window.panel_name);
- al = quote_string( al, 1 );
- al = strblk0 (al);
- al_command = malloc (strlen(al) + strlen(cm) + 30);
- sprintf (al_command, "/KUIP/ALIAS/CREATE %s %s 'C'", al, cm);
- }
- }
-
- if (pixmap != NULL) { /* button pixmap is defined */
- /* panel x.y command [alias_label] pixmap */
- panel_filp( row, col, key, pixmap);
- } else { /* button pixmap is not defined */
- /* panel x.y command [alias_label] */
- panel_fill( row, col, key);
- }
-
- if (opt != NULL) { /* options defined */
- panel_setopt ( row, col, opt);
- }
-
- if (al_command != NULL) {
- ku_exel( al_command );
- free ( al_command );
- }
- } /* if (alias_label == NULL && pixmap == NULL) */
-}
-
-
-/*
- * Display panel managed by kxterm
- */
-static
-void panel_Dkxterm( title, geometry )
- char *title, *geometry;
-{
- char message[512];
- int i, j;
-
- if( !kc_flags.use_kxterm ) return;
-
- sprintf (message, "setpanelrows(%d, -1)", kc_window.panel_rows);
- send_single_kxterm_cmd(message);
- for( i = 0; i < kc_window.panel_rows; i++ ) {
- sprintf (message, "setpanelrows(%d, %d)", i, kc_window.panel_cols[i]);
- send_single_kxterm_cmd(message);
- }
-
- for( i = 0; i < kc_window.panel_rows; i++ ) {
- for( j = 0; j < kc_window.panel_cols[i]; j++ ) {
- if (strlen(kc_window.panel_keys[i][j]) == 0)
- sprintf (message, "setpanelkeys(%d,%d, )", i, j);
- else
- sprintf (message, "setpanelkeys(%d,%d,%s)",
- i, j, kc_window.panel_keys[i][j]);
- send_single_kxterm_cmd(message);
- }
- }
-
- sprintf (message, "display_panel(%s,%s)", title, geometry);
- send_single_kxterm_cmd(message);
-}
-
-
-/*
- * action routine for /KUIP/SET_SHOW/PANEL
- */
-int kxpanel()
-{
- double number = ku_getr();
- double absval = (number < 0) ? -number : number;
- int row = absval;
- int col = (absval - row) * 100 + 0.5;
-
-
- if( row == 0 ) {
- /* panel 0 ... */
-
- col = ku_npar();
- if (col == 1 || col == 2) {
- /* reset panel */
- if (col == 2) {
- char *cval1 = ku_gets();
-
- if (cval1[0] == 'C' || cval1[0] == 'c') {
- /* Close last created panel (km_close_kpanel) */
- km_panel_close ( NULL );
- }
-
- if (cval1[0] == 'D' || cval1[0] == 'd') {
- km_panel_display ( NULL, NULL );
- return 0;
- }
-
- if (cval1[0] != 'R' && cval1[0] != 'r')
- return 1;
- }
- km_panel_reset (NULL);
- } else { /* col > 2 */
- char *cval1 = ku_gets();
-
- if (cval1[0] == 'D' || cval1[0] == 'd') {
- /* Display panel (km_display_kpanel) UNLESS mode "palette" selected */
- char *title = ku_gets();
- char *geometry = ku_gets();
-
- km_panel_display (title, geometry);
- } else if (cval1[0] == 'C' || cval1[0] == 'c') {
- /* Close panel (km_close_kpanel) UNLESS mode "palette" selected */
- char *title = ku_gets();
-
- km_panel_close ( title );
- } else if (cval1[0] == 'T' || cval1[0] == 't') {
- /* Display panel managed by kxterm UNLESS mode "palette" selected */
- char *title = ku_gets();
- char *geometry = ku_gets();
-
- kc_window.panel_title = strdup (title);
- if (kc_window.palette_flag < 0)
- return 0;
- if (!kc_window.palette_flag)
- panel_Dkxterm (title, geometry);
-
- } else if (cval1[0] == 'R' || cval1[0] == 'r') {
- char *name = ku_gets();
- km_panel_reset (name);
- }
- }
- }
-
- else if( number < 0 ) {
- /* initialize a row with empty columns */
- panel_free( row );
- panel_push( row, col );
- }
-
- else if( col == 0 ) {
- /* initialize a row with variable number of columns */
- int i;
- col = ku_npar() - 1;
- panel_free( row );
- panel_push( row, col );
- for( i = 0; i < col; i++ ) {
- panel_fill( row, i + 1, ku_gets() );
- }
- }
-
- else {
- int np = ku_npar() - 1;
-
- if (np == 1) { /* -> panel x.y command */
- /* (1) */
- /* define key only (old panel style ) */
- km_panel_key ( row, col, ku_gets(), NULL, NULL);
-
- } else { /* np = 2, 3 or 4:
- * -> panel x.y command [label] [pixmap] [option]
- * (1) (2) (3) (4)
- */
-
- /* define key with alias and/or pixmap */
- char *cmd = ku_gets();
- char *alias = ku_gets();
-
- if( strcmp( alias, "." ) == 0 ) alias = NULL;
-
- if (np == 2) {
- km_panel_key ( row, col, cmd, alias, NULL);
- } else if (np >= 3) {
-/* N.B. Get all args before calling km_panel_key (in case of ALIAS/CREATE */
- char *pixm = ku_gets();
-
- if( strcmp( pixm, "." ) == 0 ) pixm = NULL;
- if (np == 4) {
- /* Options defined */
- char *opt = ku_gets();
-
- km_panel_key_opt ( row, col, cmd, alias, pixm, opt);
- } else {
- km_panel_key ( row, col, cmd, alias, pixm);
- }
- }
- } /* ... end np = 2, 3 or 4 */
- }
-
- return 0;
-}
-
-/*
- * action routine for /KUIP/SET_SHOW/NEWPANEL
- */
-int kxnewpan()
-{
- int nl = ku_geti();
- int nc = ku_geti();
- char *title = ku_gets();
- int width = ku_geti();
- int height = ku_geti();
- int xpos = ku_geti();
- int ypos = ku_geti();
- char geometry[64];
- int i;
-
- /* Reset panel */
- for( i = 0; i < kc_window.panel_rows; i++ ) {
- panel_free( i + 1 );
- }
- if( kc_window.panel_rows != 0 ) {
- kc_window.panel_rows = 0;
- free( (char*)kc_window.panel_cols );
- kc_window.panel_cols = NULL;
- free( (char*)kc_window.panel_keys );
- kc_window.panel_keys = NULL;
- free( (char*)kc_window.panel_icons );
- kc_window.panel_icons = NULL;
- free( (char*)kc_window.panel_opts );
- kc_window.panel_opts = NULL;
- }
-
- /* Fill with blanks */
- panel_fill( nl, nc, " ");
-
-
- /* Display Panel (km_display_kpanel) */
- if (width == 0 || height == 0) {
- printf( " *** Invalid value for width (%d) or height (%d) \n",
- width, height );
- return 1;
- }
- sprintf (geometry, "%dx%d+%d+%d", width, height, xpos, ypos);
- if( kjmpaddr.disp_kpanel_C != NULL )
- (*kjmpaddr.disp_kpanel_C)( title, geometry );
-
- return 0;
-}
-
-/*
- * action routine for /KUIP/SET_SHOW/KXTNEWPANEL
- */
-int kxtnewpan()
-{
- int nl = ku_geti();
- int nc = ku_geti();
- char *title = ku_gets();
- int width = ku_geti();
- int height = ku_geti();
- int xpos = ku_geti();
- int ypos = ku_geti();
- char message[512];
- int i;
-
- /* Reset panel */
- for( i = 0; i < kc_window.panel_rows; i++ ) {
- panel_free( i + 1 );
- }
- if( kc_window.panel_rows != 0 ) {
- kc_window.panel_rows = 0;
- free( (char*)kc_window.panel_cols );
- kc_window.panel_cols = NULL;
- free( (char*)kc_window.panel_keys );
- kc_window.panel_keys = NULL;
- free( (char*)kc_window.panel_icons );
- kc_window.panel_icons = NULL;
- free( (char*)kc_window.panel_opts );
- kc_window.panel_opts = NULL;
- }
-
- /* Fill with blanks */
- panel_fill( nl, nc, " ");
-
-
- /* Display Panel (km_display_kpanel) */
- if (width == 0 || height == 0) {
- printf( " *** Invalid value for width (%d) or height (%d) \n",
- width, height );
- return 1;
- }
- sprintf (message, "setnewpanel(%s,%d,%d,%d,%d,%d,%d)",
- title, nl, nc, width, height, xpos, ypos);
- send_single_kxterm_cmd(message);
-
- return 0;
-}
-
-/*
- * undefine a row
- */
-static
-void panel_free( int row )
-{
- if( row <= kc_window.panel_rows ) {
- int i;
- for( i = 0; i < kc_window.panel_cols[row-1]; i++ ) {
- if( kc_window.panel_keys[row-1][i] != NULL ) {
- free( kc_window.panel_keys[row-1][i] );
- kc_window.panel_keys[row-1][i] = NULL;
- }
- if( kc_window.panel_icons[row-1][i] != NULL ) {
- free( kc_window.panel_icons[row-1][i] );
- kc_window.panel_icons[row-1][i] = NULL;
- }
- if( kc_window.panel_opts[row-1][i] != NULL ) {
- free( kc_window.panel_opts[row-1][i] );
- kc_window.panel_opts[row-1][i] = NULL;
- }
- }
- if( kc_window.panel_keys[row-1] != NULL ) {
- free( (char*)kc_window.panel_keys[row-1] );
- kc_window.panel_keys[row-1] = NULL;
- }
- if( kc_window.panel_icons[row-1] != NULL ) {
- free( (char*)kc_window.panel_icons[row-1] );
- kc_window.panel_icons[row-1] = NULL;
- }
- if( kc_window.panel_opts[row-1] != NULL ) {
- free( (char*)kc_window.panel_opts[row-1] );
- kc_window.panel_opts[row-1] = NULL;
- }
- kc_window.panel_cols[row-1] = 0;
- }
-}
-
-
-/*
- * increase panel to at least "row" rows and "col" columns in row "row"
- */
-static
-void panel_push( int row,
- int col )
-{
- int i;
-
- if( row > kc_window.panel_rows ) {
- if( kc_window.panel_rows == 0 ) {
- kc_window.panel_cols = (int*)malloc( row * sizeof(int) );
- kc_window.panel_keys = (char***)malloc( row * sizeof(char**) );
- kc_window.panel_icons = (char***)malloc( row * sizeof(char**) );
- kc_window.panel_opts = (char***)malloc( row * sizeof(char**) );
- }
- else {
- kc_window.panel_cols = (int*)realloc( (char*)kc_window.panel_cols,
- row * sizeof(int) );
- kc_window.panel_keys = (char***)realloc( (char*)kc_window.panel_keys,
- row * sizeof(char**) );
- kc_window.panel_icons = (char***)realloc( (char*)kc_window.panel_icons,
- row * sizeof(char**) );
- kc_window.panel_opts = (char***)realloc( (char*)kc_window.panel_opts,
- row * sizeof(char**) );
- }
- for( i = kc_window.panel_rows; i < row; i++ ) {
- kc_window.panel_cols[i] = 1;
- kc_window.panel_keys[i] = (char**)malloc( sizeof(char*) );
- kc_window.panel_keys[i][0] = NULL;
- kc_window.panel_icons[i] = (char**)malloc( sizeof(char*) );
- kc_window.panel_icons[i][0] = NULL;
- kc_window.panel_opts[i] = (char**)malloc( sizeof(char*) );
- kc_window.panel_opts[i][0] = NULL;
- }
- kc_window.panel_rows = row;
- }
-
- if( col > kc_window.panel_cols[row-1] ) {
- if( kc_window.panel_keys[row-1] == NULL ) {
- kc_window.panel_keys[row-1] =
- (char**)malloc( col * sizeof(char**) );
- }
- else {
- kc_window.panel_keys[row-1] =
- (char**)realloc( (char*)kc_window.panel_keys[row-1],
- col * sizeof(char**) );
- }
- if( kc_window.panel_icons[row-1] == NULL ) {
- kc_window.panel_icons[row-1] =
- (char**)malloc( col * sizeof(char**) );
- }
- else {
- kc_window.panel_icons[row-1] =
- (char**)realloc( (char*)kc_window.panel_icons[row-1],
- col * sizeof(char**) );
- }
- if( kc_window.panel_opts[row-1] == NULL ) {
- kc_window.panel_opts[row-1] =
- (char**)malloc( col * sizeof(char**) );
- }
- else {
- kc_window.panel_opts[row-1] =
- (char**)realloc( (char*)kc_window.panel_opts[row-1],
- col * sizeof(char**) );
- }
- for( i = kc_window.panel_cols[row-1]; i < col; i++ ) {
- kc_window.panel_keys[row-1][i] = NULL;
- kc_window.panel_icons[row-1][i] = NULL;
- kc_window.panel_opts[row-1][i] = NULL;
- }
- kc_window.panel_cols[row-1] = col;
- }
-}
-
-/*
- * Set panel buttons options:
- * T (Toggle) -> button is not released after command execution
- */
-static void panel_setopt (int row, int col, char *option)
-{
- if( kc_window.panel_opts[row-1][col-1] != NULL ) {
- free( kc_window.panel_opts[row-1][col-1] );
- kc_window.panel_opts[row-1][col-1] = NULL;
- }
- if (option == NULL || option[0] == '\0')
- kc_window.panel_opts[row-1][col-1] = strdup( " " );
- else
- kc_window.panel_opts[row-1][col-1] = strdup( option );
-}
-
-/*
- * assign key to row and column
- */
-static
-void panel_fill( int row,
- int col,
- const char *key )
-{
- panel_push( row, col );
- if( kc_window.panel_keys[row-1][col-1] != NULL ) {
- free( kc_window.panel_keys[row-1][col-1] );
- kc_window.panel_keys[row-1][col-1] = NULL;
- }
- if (key == NULL || key[0] == '\0')
- kc_window.panel_keys[row-1][col-1] = strdup( " " );
- else
- kc_window.panel_keys[row-1][col-1] = strdup( key );
-}
-
-/*
- * assign key and pixmap to row and column
- */
-static
-void panel_filp( int row,
- int col,
- const char *key,
- const char *pixm )
-{
- panel_push( row, col );
- if( kc_window.panel_keys[row-1][col-1] != NULL ) {
- free( kc_window.panel_keys[row-1][col-1] );
- kc_window.panel_keys[row-1][col-1] = NULL;
- }
- if( kc_window.panel_icons[row-1][col-1] != NULL ) {
- free( kc_window.panel_icons[row-1][col-1] );
- kc_window.panel_icons[row-1][col-1] = NULL;
- }
- if (key == NULL || key[0] == '\0')
- kc_window.panel_keys[row-1][col-1] = strdup( " " );
- else
- kc_window.panel_keys[row-1][col-1] = strdup( key );
- kc_window.panel_icons[row-1][col-1] = strdup( pixm );
-}
-
-
-/*
- * command loop
- */
-void F77_ENTRY(Kuwhat)
-/* { */
- ku_what( NULL );
-}
-
-
-void ku_what( styleG )
- void (*styleG)();
-{
- ku_trap( 1, -1 ); /* install signal handler */
- if( styleG == NULL )
- ku_exel( "/KUIP/SET_SHOW/VISIBILITY '/KUIP/SET_SHOW/PANEL' 'OFF'" );
-
- while( 1 ) {
- if( what_loop( styleG ) == 1 )
- break;
- else {
- /* this branch is for VMS exceptions only */
- reset_break();
- }
- }
- kc_break.jump_set = 0;
- ku_trap( 0, -1 ); /* remove signal handler */
- ku_shut(); /* clean up the mess */
-}
-
-
-#ifdef WIN32
-void fpcheck( void )
-{
-/* Check the type of the floating-point exception under Win32 */
-/* VF. 31.01.97 */
- char fpstr[30];
- switch( kc_break.fperr )
- {
- case _FPE_INVALID:
- strcpy( fpstr, "Invalid number" );
- break;
- case _FPE_OVERFLOW:
- strcpy( fpstr, "Overflow" );
-
- break;
- case _FPE_UNDERFLOW:
- strcpy( fpstr, "Underflow" );
- break;
- case _FPE_ZERODIVIDE:
- strcpy( fpstr, "Divide by zero" );
- break;
- default:
- strcpy( fpstr, "Other floating point error" );
- break;
- }
- printf( "Floating point exception. Error %d: %s\n", kc_break.fperr, fpstr );
-}
-#endif
-
-static
-int what_loop( void (*styleG)() )
-{
- /* Do this in Kuinit instead (otherwise it is not possible to have
- * "exit" or "quit" in pawlogon.kumac
- */
- /*
- kc_flags.do_exit = 0;
- kc_flags.do_quit = 0;
- */
-
-#ifdef vms
-
- /*
- * The signal handler calls LIB$SIG_TO_RET which lets what_loop return
- * the error number ( 1 == SS$_NORMAL )
- */
- VAXC$ESTABLISH( signal_handler );
-
-#else
- { int sigret; /* It is a local variable to hold sigsetjmp result. VF.31.01.97 */
- /* sigret = -1 means the folating-point exception under
- Windows has been happened */
- /* sigret = -2 means the CTRL-C exception under Windows has been happened VF. 19.11.97 */
- /* catch exceptions saving signal mask */
- sigret = sigsetjmp( kc_break.stack, 1 );
- if( sigret != 0 ) { /* saving signal mask */
- /* longjmp happened */
-#ifdef WIN32
-/* special case for floating-point exception under Windows */
- if (sigret == -1)
- fpcheck();
- else if (sigret == -2)
- signal_handler(SIGINT);
-#endif
- reset_break();
- }
- }
-
-#endif
-
- kc_break.jump_set = 1;
-
- while( !kc_flags.do_exit && !kc_flags.do_quit ) {
- char *cmd;
-
- kc_break.soft_intr = 0;
- ku_intr( 1 );
-
- if( kc_flags.in_application ) {
- cmd = input_line( format_prompt( kc_flags.curr_prompt ), 0 );
- }
- else if( (kc_flags.style & KmSTYLE_A) != 0 ) {
- menu_style();
- continue;
- }
- else if( (kc_flags.style & (KmSTYLE_G | KmSTYLE_M)) != 0 ) {
- (*styleG)();
- continue;
- }
- else {
- cmd = input_line( format_prompt( kc_flags.curr_prompt ), '_' );
- if( cmd != NULL ) {
- char *p = cmd;
- while( *p == ' ' )
- p++;
- if( *p == '!' ) {
- /* command history logic */
- cmd = subst_event( p );
- if( cmd == NULL )
- continue;
- }
- }
- if( cmd != NULL && kjmpaddr.user_input_F != NULL ) {
- /* allow user routine set by KUSER to change command line */
-
- fstrset( Kcparc.PARLST, (sizeof Kcparc.PARLST), cmd );
- IQUEST(1) = 0;
- (*kjmpaddr.user_input_F)();
-
- if( IQUEST(1) != 0 ) {
- cmd = "";
- }
- else {
- int len = fstrlen( Kcparc.PARLST, (sizeof Kcparc.PARLST) );
- cmd = Kcparc.PARLST;
- cmd[len] = '\0';
- }
- }
- }
-
- if( cmd != NULL ) {
- /* copy cmd in case input_line() is called again */
- cmd = strdup( cmd );
- ku_last( cmd );
- exec_cmd_string( cmd, 1, NULL );
- free( cmd );
- }
- else {
- ku_exel( "/KUIP/EXIT" ); /* EOF on input */
- break;
- }
- kc_break.intr_count = 0; /* reset the ^C counter */
- }
-
- /* Reset global flags do_exit and do_quit to "false" in case kuwhat
- * is called again afterwards (cf. mail from Mark Lakata who is using
- * KUIP in his event display program)
- */
- kc_flags.do_exit = 0;
- kc_flags.do_quit = 0;
-
- return 1;
-}
-
-
-/*
- * set user routine called for locator operations in Motif mode
- */
-void F77_ENTRY_E(Kumloc,fun)
-/* { */
- kjmpaddr.user_locate_F = fun;
-}
-
-
-/*
- * set user routine called for every intercepted signal
- */
-void F77_ENTRY_E(Kubrek,fun)
-/* { */
- kjmpaddr.user_break_F = fun;
-}
-
-
-/*
- * set user routine called for EXIT
- */
-void F77_ENTRY_E(Kuexit,fun)
-/* { */
- kjmpaddr.user_exit_F = fun;
-}
-
-
-/*
- * set user routine called for QUIT
- */
-void F77_ENTRY_E(Kuquit,fun)
-/* { */
- kjmpaddr.user_quit_F = fun;
-}
-
-
-/*
- * set user routine to call SIGMA
- */
-void F77_ENTRY_E(Kusigm,fun)
-/* { */
- kjmpaddr.user_sigma_F = fun;
-}
-
-void F77_ENTRY_I(Kisigm,iflag )
-/* { */
- if( *iflag == 0 ) {
- /* return flag whether address is defined */
- *iflag = (kjmpaddr.user_sigma_F != NULL);
- }
- else if( kjmpaddr.user_sigma_F != NULL ) {
- /* call SIGMA */
- (*kjmpaddr.user_sigma_F)();
- }
-}
-
-
-/*
- * set user routine to flush graphics output
- */
-void F77_ENTRY_E(Kugrfl,fun)
-/* { */
- kjmpaddr.user_grfl_F = fun;
-}
-
-
-/*
- * set user routine to switch terminal to alpha mode
- */
-void F77_ENTRY_E(Kuterm,fun)
-/* { */
- kjmpaddr.user_term_F = fun;
-}
-
-
-/*
- * set user routine for command input
- */
-void F77_ENTRY_E(Kuser,fun)
-/* { */
- kjmpaddr.user_input_F = fun;
-}
-
-
-/*
- * switch terminal to alpha mode
- */
-void F77_ENTRY(Kualfa)
-/* { */
- ku_alfa();
-}
-
-void ku_alfa()
-{
- if( kjmpaddr.user_term_F != NULL )
- (*kjmpaddr.user_term_F)();
-}
-
-
-/*
- * action routine for /KUIP/EXIT and /KUIP/QUIT
- */
-int kxexit()
-{
- char *cmd_name = ku_path();
-
- out_last_kumac( cmd_hist.count );
-
- if( strcmp( cmd_name, "/KUIP/EXIT" ) == 0 ) {
-
- if( kjmpaddr.disp_exit_C != NULL )
- kc_flags.do_exit = (*kjmpaddr.disp_exit_C)(); /* ask for confirmation */
- else
- kc_flags.do_exit = 1;
-
- if( kc_flags.do_exit ) {
- if( kjmpaddr.user_exit_F != NULL )
- (*kjmpaddr.user_exit_F)();
- if( kc_flags.use_kxterm )
- send_single_kxterm_cmd("exit");
- }
- }
-
- if( strcmp( cmd_name, "/KUIP/QUIT" ) == 0 ) {
-
- if( kjmpaddr.disp_quit_C != NULL )
- kc_flags.do_quit = (*kjmpaddr.disp_quit_C)(); /* ask for confirmation */
- else
- kc_flags.do_quit = 1;
-
- if( kc_flags.do_quit ) {
- if( kjmpaddr.user_quit_F != NULL )
- (*kjmpaddr.user_quit_F)();
- if( kc_flags.use_kxterm )
- send_single_kxterm_cmd("quit");
- }
- }
-
- if( kc_flags.in_motif && (kc_flags.do_exit || kc_flags.do_quit) ) {
- /* break the Motif event loop */
- siglongjmp( kc_break.stack, 1 );
- }
-
- return 0;
-}
-
-
-/*
- * action routine for /KUIP/SET_SHOW/PROMPT
- */
-int kxprompt()
-{
- char *prompt = ku_gete();
-
- if( prompt[0] != '\0' )
- set_prompt( prompt );
- return 0;
-}
-
-
-void F77_ENTRY_C(Kiprmt,cprmt)
-/* { */
- char *prompt = fstr0dup( cprmt, len_cprmt );
-
- if( prompt != NULL ) {
- set_prompt( prompt );
- free( prompt );
- }
-}
-
-
-static
-void set_prompt( const char *prompt )
-{
- if( prompt != NULL ) {
- if( kc_value.set_prompt != NULL )
- free( kc_value.set_prompt );
- kc_value.set_prompt = strdup( prompt );
-
- if( kc_flags.curr_prompt != NULL )
- free( kc_flags.curr_prompt );
- kc_flags.curr_prompt = strdup( prompt );
-
-
-#ifdef DBMALLOC
- malloc_mark( kc_value.set_prompt );
- malloc_mark( kc_flags.curr_prompt );
-#endif
-
- if( kc_flags.use_kxterm ) {
- char *cmd = str3dup( "prompt(",
- format_prompt( kc_flags.curr_prompt ), ")" );
- send_single_kxterm_cmd( cmd );
- free( cmd );
- }
- }
-}
-
-
-/*
- * return prompt string; substitute [] by event number
- */
-char *format_prompt( const char *prompt )
-{
- static char *curr_prompt = NULL;
- char *p;
-
- if( curr_prompt != NULL )
- free( curr_prompt );
-
- if( prompt == NULL)
- prompt = "Kuip >";
-
- curr_prompt = strdup( prompt );
- if( (p = strstr( curr_prompt, "[]" )) != NULL ) {
- int lhead = p - curr_prompt + 1;
- p[1] = '\0'; /* chop off "]..." */
- curr_prompt = mstricat( curr_prompt, cmd_hist.count + 1 );
- curr_prompt = mstrcat( curr_prompt, prompt + lhead );
- }
-
- return curr_prompt;
-}
-
-
-static
-char *subst_event( const char *cmd_string )
-{
- int n;
-
- if( cmd_string[1] == '\0' ) {
- /* show command history */
- int n0 = cmd_hist.count - cmd_hist.frequency;
- if( n0 < 0 )
- n0 = 0;
- for( n = n0; n < cmd_hist.count; n++ ) {
- printf( "!%d %s\n", n + 1, cmd_hist.lines[n] );
- }
- return NULL;
- }
-
- if( cmd_string[1] == '!' ) {
- /* reexecute last command */
- n = cmd_hist.count;
- }
-
- else if( (n = atoi( &cmd_string[1] )) != 0 ) {
- /* reexecute numbered command */
- if( n < 0 ) /* relative from last command */
- n += cmd_hist.count + 1;
- }
-
- else {
- int len = strlen( cmd_string ) - 1;
- for( n = cmd_hist.count; n > 0; n-- ) {
- if( strncasecmp( cmd_hist.lines[n-1], &cmd_string[1], len ) == 0 )
- break;
- }
- }
-
- if( n <= 0 || n > cmd_hist.count ) {
- printf( " *** Command %s... not in history buffer\n", cmd_string );
- return NULL;
- }
- return cmd_hist.lines[n-1];
-}
-
-
-/*
- * action routine for /KUIP/SET_SHOW/STYLE
- */
-int kxstyle()
-{
- char *style = ku_getc();
- KmStyleFlag new_style;
- int i;
-
- ku_alfa();
-
- if( strcmp( style, "?" ) == 0 ) {
- printf( " Current input style is '%s'.\n", style_name( kc_flags.style ) );
- return 0;
- }
-
-#ifndef REMOVE_OLD_STUFF
- if( 1 ) {
- static char filecase_on[] = "-FILECASE ON";
- static char filecase_off[] = "-FILECASE OFF";
- static char filecase_mixed[] = "/KUIP/SET_SHOW/FILECASE 'KEEP'";
- static char filecase_lower[] = "/KUIP/SET_SHOW/FILECASE 'CONVERT'";
-
- if( strcmp( style, filecase_on ) == 0 ) {
- printf( " %s '%s' is a deprecated feature.", ku_path(), filecase_on );
- printf( " Please use %s instead.\n", filecase_mixed );
- return ku_exel( filecase_mixed );
- }
- if( strcmp( style, filecase_off ) == 0 ) {
- printf( " %s '%s' is a deprecated feature.", ku_path(), filecase_off );
- printf( " Please use %s instead.\n", filecase_lower );
- return ku_exel( filecase_lower );
- }
- }
-#endif
-
- /* set the major style flag */
- switch( style[0] ) {
-
- case 'A':
- new_style = KmSTYLE_A;
- break;
-
- case 'C':
- new_style = KmSTYLE_C;
- break;
-
- case 'G':
- new_style = KmSTYLE_G;
- break;
-
- case 'M':
- new_style = KmSTYLE_M;
- break;
-
- case 'X':
- new_style = KmSTYLE_XM;
- break;
-
- default:
- printf( " *** Invalid style option '%s'\n", style );
- return -1;
- }
-
- /* set the minor style flag */
- for( i = 1; style[i] != '\0'; i++ ) {
-
- switch( style[i] ) {
-
- case 'L':
- new_style |= KmSTYLE_xL;
- break;
-
- case 'P':
- new_style |= KmSTYLE_xP;
- break;
-
- case 'S':
- new_style |= KmSTYLE_xS;
- break;
-
- case 'W':
- new_style |= KmSTYLE_xW;
- break;
- }
- }
-
- /* consistency checks */
- if( (new_style & KmSTYLE_XM) == 0 && kc_flags.in_motif ) {
- printf( " *** Cannot change style in X/Motif\n - KUWHAT not called\n" );
- return -1;
- }
- if( (new_style & KmSTYLE_XM) != 0 && !kc_flags.in_motif ) {
- printf( " *** Cannot change style to X/Motif - KUWHAM not called\n" );
- return -1;
- }
-
- kc_flags.style = new_style;
- kc_value.set_style = style_name( new_style );
-
- /* start/stop Model Human Interface */
- if( (new_style & KmSTYLE_M) != 0 && (kc_flags.style & KmSTYLE_M) == 0 ) {
- Mhi_open();
- }
- if( (new_style & KmSTYLE_M) == 0 && (kc_flags.style & KmSTYLE_M) != 0 ) {
- Mhi_close();
- }
-
- if( (new_style & (KmSTYLE_G | KmSTYLE_M)) != 0 ) {
- int npar = ku_npar();
- int wk_type = 0;
-
- if( npar >= 2 || kc_window.sgylen == 0 )
- kc_window.sgylen = ku_getr();
-
- if( npar >= 3 || kc_window.sgsize == 0 )
- kc_window.sgsize = ku_getr();
-
- if( npar >= 4 || kc_window.sgyspa == 0 )
- kc_window.sgyspa = ku_getr();
-
- if( npar >= 5 || kc_window.sgbord == 0 )
- kc_window.sgbord = ku_getr();
-
- if( npar >= 6 )
- wk_type = ku_geti();
-
- if( (new_style & KmSTYLE_G) != 0 && kjmpaddr.higz_init_C != NULL )
- (*kjmpaddr.higz_init_C)( wk_type );
- }
-
- return 0;
-}
-
-
-/*
- * translate style flag into style name
- */
-const char *style_name( KmStyleFlag flag )
-{
- static char style[8];
-
- switch( flag & KmSTYLE_major ) {
-
- case KmSTYLE_A:
- if( flag & KmSTYLE_xL )
- strcpy( style, "AL" );
- else
- strcpy( style, "AN" );
- break;
-
- case KmSTYLE_C:
- strcpy( style, "C" );
- break;
-
- case KmSTYLE_G:
- strcpy( style, "G" );
- break;
-
- case KmSTYLE_M:
- strcpy( style, "M" );
- break;
-
- case KmSTYLE_XM:
- strcpy( style, "XM" );
- break;
- }
-
- if( flag & (KmSTYLE_G | KmSTYLE_M) ) {
-
- if( flag & KmSTYLE_xP )
- strcat( style, "P" );
-
- if( flag & KmSTYLE_xS )
- strcat( style, "S" );
-
- if( flag & KmSTYLE_xW )
- strcat( style, "W" );
- }
-
- return style;
-}
-
-
-/*
- * action routine for /KUIP/SET_SHOW/DOLLAR
- */
-int kxdollar()
-{
- char *which = ku_getc();
-
- ku_alfa();
-
- if( strcmp( which, "ON" ) == 0 ) {
- kc_flags.try_getenv = 1;
- }
- else if( strcmp( which, "OFF" ) == 0 ) {
- kc_flags.try_getenv = 0;
- }
- else if( kc_flags.try_getenv ) {
- printf( " $var is substituted if defined as environment variable.\n" );
- }
- else {
- printf( " $var is not tried as being an environment variable.\n" );
- }
-
- kc_value.set_dollar = kc_flags.try_getenv ? "ON" : "OFF";
-
- return 0;
-}
-
-
-/*
- * action routine for /KUIP/SET_SHOW/FILECASE
- */
-int kxfilecase()
-{
- static int old_fcase = 0;
- char *fcase = ku_getc();
-
- ku_alfa();
-
- if( strcmp( fcase, "KEEP" ) == 0 ) {
- old_fcase = kc_flags.keep_fcase;
- kc_flags.keep_fcase = 1;
- }
- else if( strcmp( fcase, "CONVERT" ) == 0 ) {
- old_fcase = kc_flags.keep_fcase;
- kc_flags.keep_fcase = 0;
- }
- else if( strcmp( fcase, "RESTORE" ) == 0 ) {
- kc_flags.keep_fcase = old_fcase;
- }
- else if( kc_flags.keep_fcase ) {
- printf( " Filenames are NOT case converted.\n" );
- }
- else {
- printf( " Filenames ARE case converted.\n" );
- }
-
- kc_value.set_filecase = kc_flags.keep_fcase ? "KEEP" : "CONVERT";
-
- return 0;
-}
-
-
-/*
- * return file case conversion
- */
-LOGICAL F77_ENTRY(Kuqcas)
-/* { */
- return ku_true( kc_flags.keep_fcase );
-}
-/* the same for C */
-int ku_qcas()
-{
- return ku_true( kc_flags.keep_fcase );
-}
-
-
-/*
- * case folding for file names
- */
-void F77_ENTRY_C(Kufcas,chfile)
-/* { */
- char *file = fstrdup( chfile, len_chfile );
- fstrset( chfile, len_chfile, ku_fcase( file ) );
- free( file );
-}
-
-
-char *ku_fcase( char *file )
-{
-#if defined(UNIX) && !defined(MSDOS)
- if( !kc_flags.keep_fcase )
- strlower( file );
-#else
- if( !kc_flags.keep_fcase )
- strupper( file );
-#endif
- return file;
-}
-
-
-/*
- * action routine for /KUIP/SET_SHOW/RECALL_STYLE
- */
-int kxrecallstyle()
-{
- static char *styles[] = { "KSH", "KSHO", "DCL", "DCLO" };
- static int gl_mask = 0;
- char *style = ku_getc();
-
- ku_alfa();
-
- if( strcmp( style, "NONE" ) == 0 ) {
- kc_value.set_recall_style = "NONE";
- kc_window.use_getline = 0;
- }
- else if( strcmp( style, styles[0] ) == 0 ) {
- kc_value.set_recall_style = styles[0];
- kc_window.use_getline = 1;
- gl_mask = 0;
- }
- else if( strcmp( style, styles[1] ) == 0 ) {
- kc_value.set_recall_style = styles[1];
- kc_window.use_getline = 1;
- gl_mask = 1;
- }
- else if( strcmp( style, styles[2] ) == 0 ) {
- kc_value.set_recall_style = styles[2];
- kc_window.use_getline = 1;
- gl_mask = 2;
- }
- else if( strcmp( style, styles[3] ) == 0 ) {
- kc_value.set_recall_style = styles[3];
- kc_window.use_getline = 1;
- gl_mask = 3;
- }
- else {
- if( kc_window.use_getline )
- style = styles[gl_mask];
- else
- style = "NONE";
- printf( " Current recall style is %s\n", style );
- return 0;
- }
-
-#ifndef IBM370
- if( kc_window.use_getline )
- kc_window.use_getline = (kc_window.is_a_tty && !kc_window.is_a_pad);
- if( kc_window.use_getline ) {
- gl_config( "style", (gl_mask >> 1) & 1 );
- gl_config( "overwrite", gl_mask & 1 );
- }
-#endif
- return 0;
-}
-
-
-/*
- * cleanup after break
- */
-void reset_break()
-{
-#ifndef IBM370
- gl_config( "erase", 0 );
- gl_config( "noecho", 0 );
-#endif
-
- ku_alfa();
-
- if( kc_flags.in_application ) {
- kc_flags.in_application = 0;
- if( kc_flags.curr_prompt != NULL )
- free( kc_flags.curr_prompt );
- kc_flags.curr_prompt = strdup( kc_value.set_prompt );
- kc_flags.appl_called = 0;
- printf( " *** Application %s aborted\n", kc_flags.appl_cmd->name );
- fclose( kc_flags.appl_stream );
- ku_close( kc_flags.appl_luno );
- }
-
- if( kc_flags.in_macro ) {
- kc_flags.in_macro = 0;
- printf( " *** Macro execution stopped\n" );
- }
- kc_flags.action_nesting = 0;
- kc_alias.var_table = kc_alias.global_value;
-
- if( kjmpaddr.disp_busy_C != NULL )
- (*kjmpaddr.disp_busy_C)(0);
-
- if( kjmpaddr.user_break_F != NULL )
- (*kjmpaddr.user_break_F)();
-}
-
-
-# ifdef SIGNAL_POSIX
-
-static char* idle_alarm_prompt = NULL;
-static sigjmp_buf idle_alarm_stack;
-
-static
-void idle_alarm_handler( int sig )
-{
- printf( "%s\n", kc_value.idle_cmd );
- ku_exel( kc_value.idle_cmd );
- printf( "%s", idle_alarm_prompt );
- fflush( stdout );
- alarm( kc_value.idle_time );
- siglongjmp( idle_alarm_stack, 1 );
-}
-#endif
-
-
-/*
- * read line from terminal
- * strip trailing blanks
- * concatenate if line ends with cont_char (unless '\0')
- * return NULL on EOF
- */
-char *input_line( const char *prompt_string,
- char cont_char )
-{
- static char line[1024];
- char *prompt;
- int lprompt = strlen( prompt_string );
- int len = 0;
-
- if( kjmpaddr.disp_prompt_C != NULL ) {
- /* prompt in Motif widget */
- char *answer;
-
- int enabled = ku_intr( 0 );
- if( kc_window.use_no_echo )
- answer = (*kjmpaddr.disp_passwd_C)( prompt_string );
- else
- answer = (*kjmpaddr.disp_prompt_C)( prompt_string, NULL );
- if( enabled )
- ku_intr( enabled );
-
- if (answer) {
- strcpy(line, answer);
- free(answer);
- return line;
- } else {
- return NULL;
- }
- }
-
- ku_alfa();
-
- prompt = malloc( lprompt + 3 );
- strcpy( prompt, prompt_string );
- if( prompt[lprompt-1] != ' ' ) {
- prompt[lprompt++] = ' ';
- prompt[lprompt] = '\0';
- }
-
- while( 1 ) {
- int lline = (sizeof line) - len;
- int eof = 0;
-
-#ifdef IBMMVS
- INTEGER nchar;
- F77_CALL_CCx(Kdialo,prompt,lprompt,&line[len],lline-1,&nchar);
- eof = (nchar < 0);
- if( !eof )
- line[len+nchar] = '\0';
-#endif
-
-#ifdef IBMVM
- if( kc_window.use_no_echo ) {
-#pragma linkage(LNRDPAS,OS)
- extern char *LNRDPAS(char*);
- char *value = LNRDPAS( prompt );
- eof = (value == NULL);
- if( !eof )
- strcpy( &line[len], value );
- }
- else {
- fputs( prompt, stdout );
- eof = (fgets( &line[len], lline, stdin ) == NULL);
- }
-#endif
-
-#ifndef IBM370
- if( kc_window.use_getline ) {
- char *buf;
-
- if( kc_window.use_no_echo )
- gl_config( "noecho", 1 );
-#if defined(CERNLIB_QMGLIBC)
- if( (buf = getline2( prompt )) == NULL )
-#else
- if( (buf = getline( prompt )) == NULL )
-#endif
- eof = 1;
- else
- strcpy( &line[len], buf );
- gl_config( "noecho", 0 );
- }
- else {
-# ifdef SIGNAL_POSIX
- struct sigaction act;
- struct sigaction old_act;
- int old_alarm = 0;
- sigaction( SIGALRM, NULL, &old_act );
-# endif
-
- printf( "%s", prompt );
- fflush( stdout );
-
-# ifdef SIGNAL_POSIX
- if( kc_value.idle_time > 0 ) {
-
- if( idle_alarm_prompt != NULL )
- free( idle_alarm_prompt );
- idle_alarm_prompt = strdup( prompt );
-
- sigemptyset( &act.sa_mask );
- act.sa_flags = 0;
- act.sa_handler = idle_alarm_handler;
- sigaction( SIGALRM, &act, NULL );
- old_alarm = alarm( kc_value.idle_time );
- }
- sigsetjmp( idle_alarm_stack, 1 );
-# endif
-
-# ifdef BROKEN_F77_IO
- eof = (ku_read( 5, &line[len], lline ) < 0 );
-# else
- eof = (fgets( &line[len], lline, stdin ) == NULL);
-# endif
-
-# ifdef SIGNAL_POSIX
- sigaction( SIGALRM, &old_act, NULL );
- alarm( old_alarm );
-# endif
-
- if( !eof && ! kc_window.is_a_tty ) {
- if( kc_window.use_no_echo )
- printf( "\n" );
- else
- printf( "%s", line );
- }
- }
-#endif
-
- if( eof ) {
- static int second_eof = 0;
- if( second_eof ) {
- printf( "\n *** EoF ***\n" );
- exit( 1 );
- }
- second_eof = 1;
- free( prompt );
- return NULL;
- }
-
- for( len = strlen( line ); len > 0; len-- ) {
- if( line[len-1] != '\n' && line[len-1] != ' ' )
- break;
- }
-
- if( len > 0 && line[len-1] == cont_char ) {
- len--;
- if( prompt[lprompt-2] != cont_char ) {
- prompt[lprompt-1] = cont_char;
- prompt[lprompt++] = ' ';
- prompt[lprompt] = '\0';
- }
- }
- else
- break;
- }
- line[len] = '\0';
-
-#ifndef IBM370
- if( kc_window.use_getline && cont_char != '\0' )
- gl_histadd( line );
-#endif
-
- free( prompt );
- return line;
-}
-
-
-/*
- * prompt for string
- */
-char *ku_pros( const char *prompt,
- const char *dfault )
-{
- char *value;
- if( dfault == NULL ) {
- value = input_line( prompt, 0 );
- }
- else {
- char *prmt = str4dup( prompt, " (<CR>=", dfault, ")" );
- value = input_line( prmt, 0 );
- free( prmt );
- }
- if( value == NULL ) {
- printf( "\n *** EOF ***\n" );
- exit( 1 );
- }
- if( dfault != NULL && *value == '\0' )
- value = strdup(dfault);
- return value;
-}
-
-void F77_ENTRY_CCI(Kupros,chprmt,chline,length)
-/* { */
- char *prompt = fstrdup( chprmt, len_chprmt );
- char *dfault = fstr0dup( chline, len_chline );
- *length = fstrset( chline, len_chline, ku_pros( prompt, dfault ) );
- free( prompt );
- if( dfault != NULL )
- free( dfault );
-}
-
-
-/*
- * prompt for uppercase string
- */
-char *ku_proc( const char *prompt,
- const char *dfault )
-{
- char *value = ku_pros( prompt, dfault );
- if( value != NULL )
- strupper( value );
- return value;
-}
-
-void F77_ENTRY_CCI(Kuproc,chprmt,chline,length)
-/* { */
- char *prompt = fstrdup( chprmt, len_chprmt );
- char *dfault = fstr0dup( chline, len_chline );
- *length = fstrset( chline, len_chline, ku_proc( prompt, dfault ) );
- free( prompt );
- if( dfault != NULL )
- free( dfault );
-}
-
-
-/*
- * prompt for filename
- */
-char *ku_prof( const char *prompt,
- const char *dfault )
-{
- char *value = ku_pros( prompt, dfault );
- if( value != NULL )
- ku_fcase( value );
- return value;
-}
-
-void F77_ENTRY_CCI(Kuprof,chprmt,chline,length)
-/* { */
- char *prompt = fstrdup( chprmt, len_chprmt );
- char *dfault = fstr0dup( chline, len_chline );
- *length = fstrset( chline, len_chline, ku_prof( prompt, dfault ) );
- free( prompt );
- if( dfault != NULL )
- free( dfault );
-}
-
-
-/*
- * prompt for password
- */
-char *ku_prop( const char *prompt )
-{
- char *value;
- kc_window.use_no_echo = 1;
- value = ku_pros( prompt, NULL );
- kc_window.use_no_echo = 0;
- return value;
-}
-
-void F77_ENTRY_CCI(Kuprop,chprmt,chline,length)
-/* { */
- char *prompt = fstrdup( chprmt, len_chprmt );
- *length = fstrset( chline, len_chline, ku_prop( prompt ) );
- free( prompt );
-}
-
-
-/*
- * prompt for integer
- */
-int ku_proi( const char *prompt,
- int ifault )
-{
- char dfault[32];
- sprintf( dfault, "%d", ifault );
- while( 1 ) {
- const char *line = ku_pros( prompt, dfault );
- if( line == NULL || line == dfault ) {
- return ifault;
- }
- else {
- char *tail;
- int value = fstrtoi( line, &tail );
- if( *tail == '\0' )
- return value;
-
- printf( " *** Invalid integer number ***\n" );
- }
- }
-}
-
-void F77_ENTRY_CI(Kuproi,chprmt,value)
-/* { */
- char *prompt = fstrdup( chprmt, len_chprmt );
- int dfault = *value;
- *value = ku_proi( prompt, dfault );
- free( prompt );
-}
-
-
-/*
- * prompt for real
- */
-double ku_pror( const char *prompt,
- double rfault )
-{
- char dfault[32];
- strcpy( dfault, strfromd( rfault, 0 ) );
- while( 1 ) {
- const char *line = ku_pros( prompt, dfault );
- if( line == NULL || line == dfault ) {
- return rfault;
- }
- else {
- char *tail;
- double value = fstrtod( line, &tail );
- if( *tail == '\0' )
- return value;
-
- printf( " *** Invalid real number ***\n" );
- }
- }
-}
-
-void F77_ENTRY_CR(Kupror,chprmt,value)
-/* { */
- char *prompt = fstrdup( chprmt, len_chprmt );
- double dfault = *value;
- *value = ku_pror( prompt, dfault );
- free( prompt );
-}
-
-/*
- * print a message
- */
-void F77_ENTRY_CI(Kumess,chmess,value)
-/* { */
- char *mess = fstrdup( chmess, len_chmess );
- int ipr = *value;
-
- switch( ipr ) {
-
- case 0:
- mline = strdup( mess );
- break;
-
- case 1:
- mline = mstr2cat( mline, "\n", mess );
- break;
-
- default: /* display message */
- if (mline == NULL) {
- mline = strdup( mess );
- } else {
- mline = mstr2cat( mline, "\n", mess );
- }
- if (kjmpaddr.disp_select_C != NULL ) {
- static char *label[] = {"Ok"};
- int enabled = ku_intr( 0 );
- (*kjmpaddr.disp_select_C)
- (3, mline, (sizeof label)/sizeof(char*), label, 1);
- if( enabled )
- ku_intr( enabled );
- } else {
- printf ("%s\n", mline);
- }
- free( mline );
- mline = NULL;
- break;
- } /* switch( ipr ) */
-
- free( mess );
-}
-
-
-int ku_more( const char *question,
- const char *line )
-{
- char *prompt = str2dup( question, " " );
- int n;
-
- if( line != NULL )
- prompt = mstr3cat( prompt, "\"", line, "\" " );
-
- if( kjmpaddr.disp_select_C != NULL ) {
- static char *labels[] = { "Yes", "No", "Quit", "Go" };
- int enabled = ku_intr( 0 );
- prompt = mstrcat( prompt, "?" );
- n = (*kjmpaddr.disp_select_C)( 4, prompt, (sizeof labels)/sizeof(char*),
- labels, 1 );
- if( enabled )
- ku_intr( enabled );
- }
- else {
- const char *answer;
- prompt = mstrcat( prompt, "(Yes/No/Quit/Go) ? " );
-#ifndef IBM370
- if( kc_window.use_getline )
- gl_config( "erase", 1 );
-#endif
- answer = ku_proc( prompt, NULL );
-#ifndef IBM370
- if( kc_window.use_getline )
- gl_config( "erase", 0 );
-#endif
- if( answer == NULL )
- answer = "Go";
-
- switch( answer[0] ) {
- default:
- n = 1;
- break;
- case 'N':
- n = 2;
- break;
- case 'Q':
- n = 3;
- break;
- case 'G':
- n = 4;
- break;
- }
- }
- free( prompt );
-
- return n;
-}
-
-
-/*
- * action routine for /KUIP/SET_SHOW/RECORDING
- */
-int kxrecording()
-{
- cmd_hist.frequency = ku_geti();
- sprintf( kc_value.set_recording, "%d", cmd_hist.frequency );
- cmd_hist.flush = cmd_hist.count + cmd_hist.frequency;
- return 0;
-}
-
-
-/*
- * action routine for /KUIP/LAST
- */
-int kxlast()
-{
- int nlines = ku_geti();
-
- if( cmd_hist.count > 0 ) /* do not record the LAST command itself */
- free( cmd_hist.lines[--cmd_hist.count] );
-
- if( nlines == 0 ) {
- char *file = ku_getf();
- FILE *kumac;
-
- if( cmd_hist.kumac != NULL ) {
- int i;
- out_last_kumac( cmd_hist.count );
- for( i = 0; i < cmd_hist.count; i++ )
- free( cmd_hist.lines[i] );
- free( (char*)cmd_hist.lines );
- }
- cmd_hist.lines = NULL;
- cmd_hist.count = 0;
- cmd_hist.flush = cmd_hist.frequency;
- cmd_hist.start = time( NULL );
-
- if( file[0] != '\0' ) {
- /*
- * If new file name is not an absolute path then prefix it by the
- * working directory at startup time.
- */
- char *path = strdup( "" );
-#ifdef vms
- if( strchr( file, ':' ) == NULL
- && strchr( file, ']' ) == NULL )
- path = mstrcat( path, kc_flags.init_wdir );
-#endif
-#ifdef UNIX
- if( file[0] != '/' )
- path = mstrcat( path, kc_flags.init_wdir );
-#endif
- path = mstrcat( path, file );
- if( cmd_hist.kumac != NULL )
- free( cmd_hist.kumac );
- cmd_hist.kumac = ku_home( path, "kumac" );
- free( path );
-#ifdef DBMALLOC
- malloc_mark( cmd_hist.kumac );
-#endif
- }
- else if( cmd_hist.kumac == NULL ) {
- char *path = str2dup( kc_flags.init_wdir, "last.kumac" );
- cmd_hist.kumac = ku_home( path, NULL );
- free( path );
-#ifdef DBMALLOC
- malloc_mark( cmd_hist.kumac );
-#endif
- }
-
-#ifdef vms
- /* create a new version which we can overwrite each time */
-
- if( strchr( cmd_hist.kumac, ';' ) == NULL ) {
- kumac = fopen( cmd_hist.kumac, "w" );
- fputs( "\n", kumac );
- fclose( kumac );
- cmd_hist.kumac = mstrcat( cmd_hist.kumac, ";0" );
- }
-#else
- /* make a backup copy of the existing file */
-
- if( (kumac = fopen( cmd_hist.kumac, "r" )) != NULL ) {
- char *old_last_kumac = ku_fcase( str2dup( cmd_hist.kumac, "old" ) );
-
- fclose( kumac );
- remove( old_last_kumac );
- rename( cmd_hist.kumac, old_last_kumac );
- free( old_last_kumac );
- }
-#endif
- }
-
- else if( nlines > 0 ) {
- out_last_kumac( nlines );
- }
-
- else if( nlines > -99 ) {
- int n0 = cmd_hist.count + nlines;
- int n;
- if( n0 < 0 )
- n0 = 0;
- for( n = n0; n < cmd_hist.count; n++ ) {
- printf( " %s\n", cmd_hist.lines[n] );
- }
- }
-
- else {
- if( out_last_kumac( cmd_hist.count ) == 0 )
- ku_edit( cmd_hist.kumac, 1 );
- }
-
- return 0;
-}
-
-
-/*
- * write to history buffer to LAST.KUMAC
- */
-static
-int out_last_kumac( int nlines )
-{
- if( cmd_hist.lines != NULL && cmd_hist.frequency > 0 ) {
- FILE *stream;
-
- if( cmd_hist.kumac == NULL ) {
- /* QUIT or EXIT before any LAST command */
- char *path = str2dup( kc_flags.init_wdir, "last.kumac" );
- cmd_hist.kumac = ku_home( path, NULL );
- free( path );
-#ifdef vms
- cmd_hist.kumac = mstrcat( cmd_hist.kumac, ";0" );
-#endif
- }
-#ifdef vms
- else
- remove( cmd_hist.kumac ); /* avoid creating a new cycle each time */
-#endif
-
- if( (stream = fopen( cmd_hist.kumac, "w" )) == NULL ) {
- ku_alfa();
- printf( " *** Cannot open %s\n", cmd_hist.kumac );
- return 1;
- }
- else {
- time_t now = time( NULL );
- int i;
-
- fprintf( stream, "*** Begin of history file: %s",
- asctime( localtime( &cmd_hist.start ) ) );
-
- for( i = cmd_hist.count - nlines; i < cmd_hist.count; i++ ) {
- fputs( cmd_hist.lines[i], stream );
- fputc( '\n', stream );
- }
- fprintf( stream, "*** End of history file: %s",
- asctime( localtime( &now ) ) );
-
- fclose( stream );
- }
- }
- return 0;
-}
-
-
-/*
- * append line to the history buffer and flush LAST.KUMAC if necessary
- */
-void ku_last( const char *line )
-{
- if( line[0] == '\0' )
- return;
-
- if( cmd_hist.lines == NULL )
- cmd_hist.lines = (char**)malloc( (cmd_hist.count+1) * sizeof(char*) );
- else
- cmd_hist.lines = (char**)realloc( (char*)cmd_hist.lines,
- (cmd_hist.count+1) * sizeof(char*) );
-
- cmd_hist.lines[cmd_hist.count++] = strdup( line );
-
- if( cmd_hist.frequency > 0 && cmd_hist.count >= cmd_hist.flush ) {
- out_last_kumac( cmd_hist.count );
- cmd_hist.flush += cmd_hist.frequency;
- }
-}
-
-
diff --git a/src/packlib/kuip/code_kuip/kuwrit.F b/src/packlib/kuip/code_kuip/kuwrit.F
deleted file mode 100644
index 8f3c9c0..0000000
--- a/src/packlib/kuip/code_kuip/kuwrit.F
+++ /dev/null
@@ -1,40 +0,0 @@
-*
-* $Id: kuwrit.F,v 1.1.1.1 1996/03/08 15:32:54 mclareni Exp $
-*
-* $Log: kuwrit.F,v $
-* Revision 1.1.1.1 1996/03/08 15:32:54 mclareni
-* Kuip
-*
-*
-#include "kuip/pilot.h"
-*CMZ : 2.00/00 05/08/92 16.31.24 by Alfred Nathaniel
-*-- Author : Alfred Nathaniel 04/08/92
- SUBROUTINE KUWRIT(LUN,LINE)
-*
-********************************************************************************
-*
-* Write text line to unit LUN
-*
-* Input :
-*
- INTEGER LUN
- CHARACTER*(*) LINE
-*
-********************************************************************************
-#if defined(CERNLIB_IBMVM)
- CHARACTER FORM*12,LINE80*80
- LINE80=LINE
- INQUIRE(LUN,FORM=FORM)
- IF(FORM.EQ.'FORMATTED') THEN
- WRITE(LUN,'(A80)') LINE80
- ELSE
- WRITE(LUN,NUM=NBYT) LINE80
- ENDIF
-
-#endif
-#if !defined(CERNLIB_IBMVM)
- L=MAX(1,LENOCC(LINE))
- WRITE(LUN,'(A)') LINE(:L)
-#endif
-*
- END
diff --git a/src/packlib/kuip/code_kuip/kvect.c b/src/packlib/kuip/code_kuip/kvect.c
deleted file mode 100644
index aa59857..0000000
--- a/src/packlib/kuip/code_kuip/kvect.c
+++ /dev/null
@@ -1,634 +0,0 @@
-/*
- * $Id: kvect.c,v 1.2 1997/10/23 16:53:35 mclareni Exp $
- *
- * $Log: kvect.c,v $
- * Revision 1.2 1997/10/23 16:53:35 mclareni
- * The definiton of the vector with "too many initializers"
- * corrupted the memory;
- * - Fixed "strange" bug under "Microsoft Visual C/C++" (Likely
- * compiler bug )
- * V.Fine 5.10.97
- *
- * Revision 1.1.1.1 1996/03/08 15:32:59 mclareni
- * Kuip
- *
- */
-/*CMZ : 2.06/03 12/01/95 18.15.01 by Gunter Folger*/
-/*-- Author : Alfred Nathaniel 24/08/92*/
-/* kvect.c: vector handling */
-
-#include "kuip/kuip.h"
-#include "kuip/kfor.h"
-#include "kuip/kcom.h"
-#include "kuip/kmenu.h"
-#include "kuip/klink.h"
-#include "kuip/kflag.h"
-#include "kuip/khash.h"
-
-static int repeat_value( const char*, const char*, const char*,
- INTEGER*, REAL*);
-
-
-/*
- * action routine for /VECTOR/CREATE
- */
-int kxvcreate()
-{
- char *vspec = ku_getc();
- char *vname = strdup( vspec );
- int lvname;
- char *vtype = ku_getc();
- int lvtype = strlen( vtype );
- char *value;
- int length[4];
- INTEGER LENGTH[3];
- INTEGER LLOW;
- INTEGER LHIGH;
-
-#ifdef CERNLIB_WINNT
- REAL rval; /*I move this variable to make Microsoft Bisual C/C++ compiler hally */
-#endif
-
- length[0] = 0;
- length[1] = 0;
- length[2] = 0;
- if( strchr( vspec, '(' ) == NULL ) {
- /* "V/CRE name" is treated as "V/CRE name(1)" */
- length[0] = 1;
- }
- else {
- int ntok = sscanf( vspec, "%[^(](%d,%d,%d,%d)",
- vname, &length[0], &length[1], &length[2], &length[3]);
- if( ntok < 2 || ntok > 4) {
- ku_alfa();
- printf( " *** VECTOR/CREATE %s: invalid dimensions\n", vspec );
- free( vname );
- return -1;
- }
- }
-
- lvname = strlen( vname );
- F77_CALL_Cxx(Kuvect,vname,lvname,&LLOW,&LHIGH);
- if( LLOW != 0 ) {
- int vlen = LHIGH - LLOW + 1;
- F77_CALL_C(Kuvdel,vname,lvname);
- ku_alfa();
- printf( " *** VECTOR/CREATE %s: existing vector %s(%d) replaced\n",
- vspec, vname, vlen );
- }
-
- LENGTH[0] = length[0];
- LENGTH[1] = length[1];
- LENGTH[2] = length[2];
- F77_CALL_CCx3(Kuvcre,vname,lvname,vtype,lvtype,LENGTH,&LLOW,&LHIGH);
- free( vname );
- if( LLOW == 0 ) {
- ku_alfa();
- printf( " *** VECTOR/CREATE %s: cannot create\n", vspec );
- return -1;
- }
-
- ku_getc();
- while( (value = ku_getl()) != NULL ) {
- /* fill vector with initial data */
- INTEGER ival;
-#ifndef CERNLIB_WINNT
- /* by UNKNOWN reason it generates a problem under MS Visual C/C++ v.4.2 */
- REAL rval;
-#endif
- int repeat;
- int i;
-
- if( vtype[0] == 'I' )
- repeat = repeat_value( "VECTOR/CREATE", vspec, value, &ival, NULL );
- else
- repeat = repeat_value( "VECTOR/CREATE", vspec, value, NULL, &rval );
-
- if( repeat < 1 )
- return -1;
-
- if( LLOW + repeat - 1 > LHIGH ) {
- repeat = LHIGH - LLOW + 1;
- ku_alfa();
- printf( " *** VECTOR/CREATE %s: too many initializers\n", vspec );
- break;
- }
-
- for( i = 0; i < repeat; i++ ) {
- if( vtype[0] == 'I' )
- IQ(LLOW) = ival;
- else
- Q(LLOW) = rval;
- LLOW++;
- }
- }
- return 0;
-}
-
-
-/*
- * action routine for /VECTOR/INPUT
- */
-int kxvinput()
-{
- char *vspec = ku_getc();
- int lvspec = strlen( vspec );
- char *vname;
- char *p;
- INTEGER LLOW;
- INTEGER LHIGH;
- int nval;
- int vtype;
- int ilo[3];
- int ihi[3];
- int idx[3];
- int ndim = 1;
- int status = 0;
- int i;
-
- Kcvect.TVECFL = ku_true( 0 ); /* don't make a temporary copy */
- F77_CALL_Cxx(Kuvect,vspec,lvspec,&LLOW,&LHIGH);
- Kcvect.TVECFL = ku_true( 1 );
-
- if( LLOW == 0 ) {
- ku_alfa();
- printf( " *** VECTOR/INPUT: unknown vector %s\n", vspec );
- return -1;
- }
-
- if( IQUEST(20) != 0 ) {
- ku_alfa();
- printf( " *** VECTOR/INPUT: sub-vector %s not implemented\n",
- vspec );
- return -1;
- }
-
- vtype = IQUEST(14);
- for( i = 0; i < 3; i++ ) {
- idx[i] = ilo[i] = IQUEST(21+i);
- if( (ihi[i] = IQUEST(31+i)) > 1 )
- ndim = i + 1;
- }
-
- nval = LHIGH - LLOW + 1;
-
- vname = strdup( vspec );
- if( (p = strchr( vname, '(' )) != NULL )
- *p = '\0';
-
- ku_getc();
- while( nval > 0 ) {
- const char *value;
- INTEGER ival;
- REAL rval;
- int repeat;
- char *prompt = str2dup( vname, "(" );
- prompt = mstricat( prompt, idx[0] );
- for( i = 1; i < ndim; i++ ) {
- prompt = mstrcat( prompt, "," );
- prompt = mstricat( prompt, idx[i] );
- }
- prompt = mstrcat( prompt, ") " );
-
- if( (value = ku_getl()) == NULL ) {
- /* prompt for values */
- value = ku_proc( prompt, NULL );
- if( value == NULL ) {
- free( prompt );
- status = -1;
- break;
- }
- }
-
- if( *value == '\0' ) {
- /* leave value unchanged */
- free( prompt );
- repeat = 1;
- }
- else {
- if( vtype != 1 )
- repeat = repeat_value( "VECTOR/INPUT", prompt, value, &ival, NULL );
- else
- repeat = repeat_value( "VECTOR/INPUT", prompt, value, NULL, &rval );
-
- free( prompt );
- if( repeat < 1 ) {
- status = -1;
- break;
- }
-
- if( repeat > nval ) {
- repeat = nval;
- ku_alfa();
- printf( " *** VECTOR/INPUT: too many initializers for %s\n", vspec );
- }
-
- for( i = 0; i < repeat; i++ ) {
- if( vtype != 1 )
- IQ(LLOW) = ival;
- else
- Q(LLOW) = rval;
- LLOW++;
- }
- }
-
- nval -= repeat;
- for( i = 0; i < repeat; i++ ) {
- int k;
- for( k = 0; k < ndim; k++ ) {
- if( ++idx[k] > ihi[k] )
- idx[k] = ilo[k];
- else
- break;
- }
- }
- }
-
- free( vname );
- return status;
-}
-
-
-/*
- * decode a input value [rep*]val where val can be numeric or a vector element
- */
-static
-int repeat_value( const char *cmd,
- const char *vname,
- const char *rep_value,
- INTEGER *ival,
- REAL *rval )
-{
- int repeat;
- const char *value;
- char *star;
- char *tail;
-
- while( (star = strchr( rep_value, '*')) != NULL
- && (repeat = atoi( rep_value )) < 1 ) {
-
- ku_alfa();
- printf( " *** %s: invalid repetition factor %s for %s\n",
- cmd, rep_value, vname );
- rep_value = ku_pros( "Reenter initializer or Q to quit:", NULL );
- if( rep_value == NULL || *rep_value == 'q' || *rep_value == 'Q' )
- return -1; /* EOF or QUIT */
- }
-
- if( star != NULL )
- value = star + 1;
- else {
- value = rep_value;
- repeat = 1;
- }
-
- if( ival != NULL ) {
- *ival = fstrtoi( value, &tail );
- if( *tail != '\0' )
- *ival = fstrtod( value, &tail );
- }
-
- if( rval != NULL ) {
- *rval = fstrtod( value, &tail );
- }
-
- if( *tail != '\0' ) {
- INTEGER LLOW;
- INTEGER LHIGH;
- F77_CALL_Cxx(Kuvect,value,strlen(value),&LLOW,&LHIGH);
-
- if( LLOW == 0 ) {
- ku_alfa();
- printf( " *** %s: invalid initializer %s for %s\n", cmd, value, vname );
- value = ku_pros( "Reenter initializer or Q to quit:", NULL );
- if( value == NULL || *value == 'q' || *value == 'Q' )
- return -1; /* EOF or QUIT */
- return repeat_value( cmd, vname, value, ival, rval );
- }
-
- if( LLOW != LHIGH ) {
- ku_alfa();
- printf( " *** %s: only first element of %s used as initializer for %s\n",
- cmd, value, vname );
- }
- if( IQUEST(14) != 1 ) {
- /* integer vector */
- if( ival != NULL )
- *ival = IQ(LLOW);
- if( rval != NULL )
- *rval = IQ(LLOW);
- }
- else {
- /* real vector */
- if( ival != NULL )
- *ival = Q(LLOW);
- if( rval != NULL )
- *rval = Q(LLOW);
- }
- }
-
- return repeat;
-}
-
-
-/*
- * action routine for /VECTOR/PRINT
- */
-int kxvprint()
-{
- char *vspec = ku_getc();
- int lvspec = strlen( vspec );
- int dense = ku_geti();
- char *vname;
- char *p;
- INTEGER LLOW;
- INTEGER LHIGH;
- int nval;
- int vtype;
- int ilo[3];
- int ihi[3];
- int idx[3];
- char dfm[3][8];
- int ndim = 1;
- int n;
- int i;
-
- ku_alfa();
- F77_CALL_Cxx(Kuvect,vspec,lvspec,&LLOW,&LHIGH);
-
- if( LLOW == 0 ) {
- printf( " *** VECTOR/PRINT: unknown vector %s\n", vspec );
- return -1;
- }
-
- vtype = IQUEST(14);
- for( i = 0; i < 3; i++ ) {
- idx[i] = ilo[i] = IQUEST(21+i);
- if( (ihi[i] = IQUEST(31+i)) > 1 )
- ndim = i + 1;
- }
- for( i = 0; i < ndim; i++ ) {
- int m = ihi[i];
- int k = 1;
- while( m >= 10 ) {
- m /= 10;
- k++;
- }
- sprintf( dfm[i], "%s%%%dd", (i == 0) ? "" : ",", k );
- }
-
- nval = LHIGH - LLOW + 1;
-
- vname = strupper( strdup( vspec ) );
- if( (p = strchr( vname, '(' )) != NULL )
- *p = '\0';
-
- for( n = 0; n < nval; n++ ) {
- int same = 0;
-
- if( dense > 0 ) {
- if( vtype != 1 ) {
- for( i = n + 1; i < nval && IQ(LLOW+i) == IQ(LLOW+n); i++ )
- same++;
- }
- else {
- for( i = n + 1; i < nval && Q(LLOW+i) == Q(LLOW+n); i++ )
- same++;
- }
- if( dense == 1 && same == 1 )
- same = 0;
- }
-
- printf( " %s(", vname );
- for( i = 0; i < ndim; i++ )
- printf( dfm[i], idx[i] );
- printf( ")" );
-
- if( same > 0 ) {
- int k;
- for( k = 0; k < same; k++ ) {
- for( i = 0; i < ndim; i++ ) {
- if( ++idx[i] > ihi[i] )
- idx[i] = ilo[i];
- else
- break;
- }
- }
- if( dense == 1 )
- printf( " ...\n %s", vname );
- else
- printf( ".." );
- printf( "(" );
- for( i = 0; i < ndim; i++ )
- printf( dfm[i], idx[i] );
- printf( ")" );
- n += same;
- }
- printf( " = " );
-
- if( vtype != 1 )
- printf( "%d", IQ(LLOW+n) );
- else {
- double dval = Q(LLOW+n);
- printf( "%s", strfromd( dval, 0 ) );
- }
- printf( "\n" );
-
- for( i = 0; i < ndim; i++ ) {
- if( ++idx[i] > ihi[i] )
- idx[i] = ilo[i];
- else
- break;
- }
- }
-
- free( vname );
- return 0;
-}
-
-
-/*
- * set user routine to be called when a vector is deleted
- * (COMIS needs to clear its tables in that case)
- */
-void F77_ENTRY_E(Kucomv,fun)
-/* { */
- kjmpaddr.user_comis_F = fun;
-}
-
-/*
- * Because for IBM/370 we cannot use arguments in an indirect function call
- * we have to store the vector name in a buffer and call the user routine
- * which then has to call KUVNAM to retrieve the vector name.
- */
-
-static char deleted_vname[32];
-static int deleted_len_vname;
-
-void F77_ENTRY_C(Kicomv,vname)
-/* { */
- if( kjmpaddr.user_comis_F != NULL ) {
- if( len_vname > (sizeof deleted_vname) )
- len_vname = (sizeof deleted_vname);
- strncpy( deleted_vname, vname, len_vname );
- deleted_len_vname = len_vname;
- (*kjmpaddr.user_comis_F)();
- }
-}
-
-void F77_ENTRY_C(Kuvnam,vname)
-/* { */
- memset( vname, ' ', len_vname );
- if( len_vname > deleted_len_vname )
- len_vname = deleted_len_vname;
- strncpy( vname, deleted_vname, len_vname );
-}
-
-
-/*
- * return the number of leading characters which are valid for a vector name
- */
-int len_vector( const char *line )
-{
- int len = 0;
-
- if( !isdigit( line[0] ) ) {
-
- while( line[len] != '\0'
- && ( isalnum( line[len] )
- || strchr( "_?", line[len] ) != NULL ) ) {
- len++;
- }
- }
- return len;
-}
-
-
-/*
- * return vector address as index into Q():
- */
-int ku_vqaddr( const char *vname )
-{
- INTEGER LLOW;
- INTEGER LHIGH;
-
- F77_CALL_Cxx(Kuvect,vname,strlen(vname),&LLOW,&LHIGH);
- return LLOW;
-}
-
-
-/*
- * return vector type:
- * 0 : vector name not defined
- * 1 : real vector
- * 2 : integer vector
- */
-int ku_vtype( const char *vname )
-{
- INTEGER LLOW;
- INTEGER LHIGH;
-
- F77_CALL_Cxx(Kuvect,vname,strlen(vname),&LLOW,&LHIGH);
- if( LLOW != 0 ) {
- return IQUEST(14);
- }
-
- return 0;
-}
-
-
-/*
- * test if vspec specifies a single vector element and return its value
- */
-int ku_vvalue( const char *vspec,
- double *value )
-{
- INTEGER LLOW;
- INTEGER LHIGH;
-
- F77_CALL_Cxx(Kuvect,vspec,strlen(vspec),&LLOW,&LHIGH);
- if( LLOW != 0 && LLOW == LHIGH ) {
- if( value != NULL ) {
- if( IQUEST(14) == 1 ) {
- /* real vector */
- *value = Q(LLOW);
- }
- else if( IQUEST(14) == 2 ) {
- /* integer vector */
- *value = IQ(LLOW);
- }
- }
- return 0;
- }
- return 1;
-}
-
-
-/*
- * inquire if file is Fortran opened
- */
-int ku_inqf( const char *fname )
-{
- INTEGER luno;
- F77_CALL_Cx(Kuinqf,fname,strlen(fname),&luno);
- return luno;
-}
-
-
-/*
- * Fortran open a file
- */
-int ku_open( int lun,
- const char *fname,
- const char *mode )
-{
- INTEGER luno = lun;
- INTEGER istat;
- F77_CALL_xCCx(Kuopen,&luno,fname,strlen(fname),mode,strlen(mode),&istat);
- return istat;
-}
-
-
-/*
- * Fortran close a file
- */
-int ku_close( int lun )
-{
- INTEGER luno = lun;
- INTEGER istat;
- F77_CALL_xCx(Kuclos,&luno," ",1,&istat);
- return istat;
-}
-
-
-/*
- * Read a line from Fortran unit
- */
-int ku_read( int lun,
- char *line,
- size_t len )
-{
- INTEGER luno = lun;
- INTEGER nch;
- F77_CALL_xCx(Kuread,&luno,line,len,&nch);
- if( nch >= 0 )
- line[nch] = '\0';
- return nch;
-}
-
-
-/*
- * Write a line to Fortran unit
- */
-void ku_write( int lun,
- const char *line )
-{
- INTEGER luno = lun;
- const char *p = line;
- const char *s;
- while( (s = strchr( p, '\n' )) != NULL ) {
- F77_CALL_xC(Kuwrit,&luno,p,s-p);
- p = s + 1;
- }
- F77_CALL_xC(Kuwrit,&luno,p,strlen(p));
-}
diff --git a/src/packlib/kuip/code_kuip/kxcopv.F b/src/packlib/kuip/code_kuip/kxcopv.F
deleted file mode 100644
index 8236a31..0000000
--- a/src/packlib/kuip/code_kuip/kxcopv.F
+++ /dev/null
@@ -1,139 +0,0 @@
-*
-* $Id: kxcopv.F,v 1.1.1.1 1996/03/08 15:32:54 mclareni Exp $
-*
-* $Log: kxcopv.F,v $
-* Revision 1.1.1.1 1996/03/08 15:32:54 mclareni
-* Kuip
-*
-*
-#include "kuip/pilot.h"
-*CMZ : 1.64/07 28/09/90 20.10.59 by
-** Supporting Complex-type vectors now available in SIGMA
-*-- Author :
- SUBROUTINE KXCOPV
-*
-********************************************************************************
-*
-* Execution routine for command '/VECTOR/COPY'
-*
-********************************************************************************
-*
-#include "kuip/kcgen.inc"
-#include "kuip/kcques.inc"
-#include "kuip/kcvect.inc"
- CHARACTER*32 VNAM1,VNAM2
- SAVE VNAM1,VNAM2
- CHARACTER*1 VECTYP
- DIMENSION LENGTH(3),LENFR(3),LENTO(3),NDIM(3),ISTEPS(3)
-*
- CALL KUGETV(VNAM1,LLOW1,LHIGH1)
- IF (LLOW1.EQ.0) GO TO 999
- ICOPY=IQUEST(20)
-*
-* Temporary vector used ?
-*
- IF (ICOPY.EQ.1) THEN
- LLLBEG=LVECN
- DO 10 I=1,3
- LENFR(I)=IQUEST(20+I)
- LENTO(I)=IQUEST(30+I)
- NDIM(I)=IQ(LVECN+10+I)
- IF (LENFR(I).LE.LENTO(I)) THEN
- ISTEPS(I)=1
- ELSE
- ISTEPS(I)=-1
- ENDIF
-10 CONTINUE
- ENDIF
-*
- LENTOT=MIN(LHIGH1-LLOW1+1,IQUEST(11))
- DO 20 I=1,3
- LENGTH(I)=IQ(LVECN+10+I)
-20 CONTINUE
- ITYPE1=IQUEST(14)
-*
-* KUGETV replaced by KUGETC + KUVECT to avoid warning if vector not existing
-*
- CALL KUGETC(VNAM2,NCH)
- TVECFL=.FALSE.
- CALL KUVECT(VNAM2,LLOW2,LHIGH2)
- TVECFL=.TRUE.
- IF (IQUEST(1).NE.0) GO TO 999
- IF (LLOW2.EQ.0) THEN
- IF (ITYPE1.EQ.1) THEN
- VECTYP='R'
- ELSE IF (ITYPE1.EQ.2) THEN
- VECTYP='I'
- ELSE IF (ITYPE1.EQ.3) THEN
- VECTYP='C'
- ENDIF
-*
- IF (INDEX(VNAM1,'(').GT.0) THEN
- LENGTH(1)=LENTOT
- LENGTH(2)=1
- LENGTH(3)=1
- ENDIF
- CALL KUVCRE(VNAM2,VECTYP,LENGTH,LLOW2,LHIGH2)
- TVECFL=.FALSE.
- CALL KUVECT(VNAM1,LLOW1,LHIGH1)
- IF (ICOPY.EQ.1) LLLBEG=LVECN
- CALL KUVECT(VNAM2,LLOW2,LHIGH2)
- TVECFL=.TRUE.
- IF (IQUEST(1).NE.0) THEN
- CALL KUALFA
- PRINT *,'*** KXCOPV: Error in creating destination vector'
- GO TO 999
- ENDIF
-*
- ENDIF
- ITYPE2=IQUEST(14)
-*
- IF (ICOPY.EQ.0) THEN
-*
-* Protect against overwriting when destination < source
-*
- IF((LHIGH1-LLOW1).GT.(LHIGH2-LLOW2)) LHIGH1=LLOW1+(LHIGH2-LLOW2)
-*
- J=0
-*
- DO 30 I=LLOW1,LHIGH1
- IF (ITYPE1.EQ.1.AND.ITYPE2.EQ.2) THEN
- IQ(LLOW2+J)=Q(LLOW1+J)
- ELSE IF (ITYPE1.EQ.2.AND.ITYPE2.EQ.1) THEN
- Q(LLOW2+J)=IQ(LLOW1+J)
- ELSE
- IQ(LLOW2+J)=IQ(LLOW1+J)
- ENDIF
- J=J+1
-30 CONTINUE
-*
- ELSE
-*
- III=0
-*
- DO 40 K=LENFR(3),LENTO(3),ISTEPS(3)
- DO 40 J=LENFR(2),LENTO(2),ISTEPS(2)
- DO 40 I=LENFR(1),LENTO(1),ISTEPS(1)
- JJJ=I+NDIM(1)*(J-1)+NDIM(1)*NDIM(2)*(K-1)
- LLL=LLLBEG+14+JJJ
- IF (ITYPE1.EQ.1.AND.ITYPE2.EQ.2) THEN
- IQ(LLOW2+III)=Q(LLL)
- ELSE IF (ITYPE1.EQ.2.AND.ITYPE2.EQ.1) THEN
- Q(LLOW2+III)=IQ(LLL)
- ELSE
- IQ(LLOW2+III)=IQ(LLL)
- ENDIF
- III=III+1
-*
-* Protect against overwriting when destination < source
-*
- IF (III.GT.(LHIGH2-LLOW2)) GO TO 999
-*
-40 CONTINUE
-*
- ENDIF
-*
-999 END
-
-
-
diff --git a/src/packlib/kuip/code_kuip/kxcrv1.F b/src/packlib/kuip/code_kuip/kxcrv1.F
deleted file mode 100644
index 198d350..0000000
--- a/src/packlib/kuip/code_kuip/kxcrv1.F
+++ /dev/null
@@ -1,80 +0,0 @@
-*
-* $Id: kxcrv1.F,v 1.1.1.1 1996/03/08 15:32:54 mclareni Exp $
-*
-* $Log: kxcrv1.F,v $
-* Revision 1.1.1.1 1996/03/08 15:32:54 mclareni
-* Kuip
-*
-*
-#include "kuip/pilot.h"
-*CMZ : 1.61/01 23/06/89 09.49.19 by
-*-- Author :
- SUBROUTINE KXCRV1(VNAME,TYPE)
-*
-********************************************************************************
-*
-* Called by KXCREV
-*
-* Input :
-*
- CHARACTER*(*) VNAME
- CHARACTER*(*) TYPE
-*
-********************************************************************************
-*
-#include "kuip/kcques.inc"
- CHARACTER*32 VNAM
- DIMENSION LENFR(3),LENTO(3)
-*
- IQUEST(1)=0
- NCHNAM=LENOCC(VNAME)
- I1=INDEX(VNAME,'(')
- I2=INDEX(VNAME,')')
- IF ((I1.EQ.0.AND.I2.EQ.0).OR.(I2.EQ.I1+1)) THEN
- LENFR(1)=1
- LENFR(2)=1
- LENFR(3)=1
- LENTO(1)=1
- LENTO(2)=1
- LENTO(3)=1
- I1=NCHNAM+1
- GO TO 20
- ENDIF
- IF (I1.GT.I2) GO TO 910
- IF (I1.EQ.1.OR.I2.NE.NCHNAM) GO TO 910
-
- NCHSUB=I2-I1-1
- LENTO(1)=1
- LENTO(2)=1
- LENTO(3)=1
- IF (NCHSUB.GT.0) THEN
- CALL KIVIND(VNAME(I1+1:I2-1),NCHSUB,LENFR,LENTO)
- IF (IQUEST(1).NE.0) GO TO 999
- ENDIF
-
- DO 10 I=1,3
- IF (LENFR(I).LE.0.OR.LENTO(I).LE.0) GO TO 920
- IF (LENTO(I).GT.LENFR(I)) LENFR(I)=LENTO(I)
-10 CONTINUE
-
-20 VNAM=' '
- VNAM=VNAME(1:I1-1)
- CALL KXCRV2(VNAM,LENFR,TYPE)
- GO TO 999
-
-910 IQUEST(1)=1
- CALL KUALFA
- PRINT *,'*** Illegal syntax in vector name',
- + ' - Vector not created'
- GO TO 999
-
-920 IQUEST(1)=1
- CALL KUALFA
- PRINT *,'*** Vector dimensions cannot be less than or equal to 0',
- + ' - Vector not created'
- GO TO 999
-
-999 END
-
-
-
diff --git a/src/packlib/kuip/code_kuip/kxcrv2.F b/src/packlib/kuip/code_kuip/kxcrv2.F
deleted file mode 100644
index bcf6dfd..0000000
--- a/src/packlib/kuip/code_kuip/kxcrv2.F
+++ /dev/null
@@ -1,128 +0,0 @@
-*
-* $Id: kxcrv2.F,v 1.1.1.1 1996/03/08 15:32:54 mclareni Exp $
-*
-* $Log: kxcrv2.F,v $
-* Revision 1.1.1.1 1996/03/08 15:32:54 mclareni
-* Kuip
-*
-*
-#include "kuip/pilot.h"
-*CMZ : 1.68/00 05/12/91 17.42.09 by Fons Rademakers
-*-- Author :
- SUBROUTINE KXCRV2(VNAME,LENGTH,TYPE)
-*
-********************************************************************************
-*
-* Called by KXCRV1
-*
-* Input :
-*
- CHARACTER*(*) VNAME
- INTEGER LENGTH(3)
- CHARACTER*(*) TYPE
-*
-********************************************************************************
-*
-#include "kuip/kcmcmd.inc"
-#include "kuip/kcgen.inc"
-#include "kuip/kcgen2.inc"
-#include "kuip/kcques.inc"
-#include "kuip/kcvect.inc"
-* CHARACTER*38 PAR
-* CHARACTER*15 VAL
- CHARACTER*32 VNAMB,B32
- PARAMETER (B32=' ')
- INTEGER VNAMH(8),VTYPH
-*
- IQUEST(1)=0
- NCHNAM=LENOCC(VNAME)
- I1=INDEX(VNAME,'(')
- IF (I1.GT.1) NCHNAM=I1-1
-
- IF (LENGTH(1).LE.0.OR.LENGTH(2).LE.0.OR.LENGTH(3).LE.0) THEN
- IQUEST(1)=1
- CALL KUALFA
- PRINT *,'*** Vector length less than or equal to 0 - ',
- + 'Vector not created'
- GO TO 999
- ENDIF
-
- IF (TYPE.NE.'R'.AND.TYPE.NE.'I'.AND.TYPE.NE.'C') THEN
- IQUEST(1)=1
- CALL KUALFA
- PRINT *,'*** Unknown vector type ''',TYPE(1:1),''' - ',
- + 'Vector not created'
- GO TO 999
- ENDIF
-*
-* Check that vector is not already existing
-*
- LVECN=LQ(LVEC-1)
- DO 10 I=1,NUMVEC
- CALL UHTOC(IQ(LVECN+1),4,VNAMB,32)
- IF (VNAMB.EQ.VNAME) THEN
- IQUEST(1)=1
- CALL KUALFA
- PRINT *,'*** Vector ',VNAME(1:NCHNAM),' already existing'
- GO TO 999
- ENDIF
- LVECN=LQ(LVECN)
-10 CONTINUE
-*
-* Check if there is enough space
-*
- LENTOT=LENGTH(1)*LENGTH(2)*LENGTH(3)
- IF (TYPE.EQ.'C') LENTOT=LENTOT*2
- LLL=50+LENTOT
- CALL MZNEED(IXKUIP,LLL,'G')
- IQUEST(1)=0
- IF (IQUEST(11).LT.0) THEN
- PRINT *,'*** Not enough memory - Vector not created'
- IQUEST(1)=1
- GO TO 999
- ENDIF
-*
- NL=0
- NS=0
- ND=14+LENTOT
- IF (NUMVEC.EQ.0) THEN
- CALL MZBOOK(IXKUIP,LVECN,LVEC,-1,'VECN',NL,NS,ND,IOVECN,0)
- ELSE
- LVECN=LZLAST(IXKUIP,LVEC-1)
-*----------------------------------------------------------------------v
-* PRINT *,'------------------ Before MZBOOK'
-* CALL DZVERI('Before garbage',IXKUIP,'CFLSU')
-* CALL MZGARB(IXKUIP,0)
-* CALL DZVERI('After garbage',IXKUIP,'CFLSU')
-*----------------------------------------------------------------------^
- CALL MZBOOK(IXKUIP,LVECN,LVECN,0,'VECN',NL,NS,ND,IOVECN,0)
-*----------------------------------------------------------------------v
-* PRINT *,'------------------ After MZBOOK'
-* CALL DZVERI('Before garbage',IXKUIP,'CFLSU')
-* CALL MZGARB(IXKUIP,0)
-* CALL DZVERI('After garbage',IXKUIP,'CFLSU')
-*----------------------------------------------------------------------^
- ENDIF
- NUMVEC=NUMVEC+1
- VNAMB=VNAME(1:NCHNAM)//B32
- CALL UCTOH(VNAMB,VNAMH,4,32)
- DO 20 I=1,8
- IQ(LVECN+I)=VNAMH(I)
-20 CONTINUE
- CALL UCTOH(' ',VTYPH,4,4)
- CALL UCTOH(TYPE ,VTYPH,4,1)
- IQ(LVECN+9)=VTYPH
- IQ(LVECN+10)=LENTOT
- IQ(LVECN+11)=LENGTH(1)
- IQ(LVECN+12)=LENGTH(2)
- IQ(LVECN+13)=LENGTH(3)
- DO 30 NDIMS=3,1,-1
- IF (LENGTH(NDIMS).GT.1) GO TO 40
-30 CONTINUE
- NDIMS=1
-40 IQ(LVECN+14)=NDIMS
-*
-999 END
-
-
-
diff --git a/src/packlib/kuip/code_kuip/kxdelv.F b/src/packlib/kuip/code_kuip/kxdelv.F
deleted file mode 100644
index 11f0031..0000000
--- a/src/packlib/kuip/code_kuip/kxdelv.F
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: kxdelv.F,v 1.1.1.1 1996/03/08 15:32:54 mclareni Exp $
-*
-* $Log: kxdelv.F,v $
-* Revision 1.1.1.1 1996/03/08 15:32:54 mclareni
-* Kuip
-*
-*
-#include "kuip/pilot.h"
-*CMZ : 1.61/06 19/07/89 14.18.49 by
-** Calling KUVDEL instead of KXDLV1
-*-- Author :
- SUBROUTINE KXDELV
-*
-********************************************************************************
-*
-* Execution routine for command '/VECTOR/DELETE'
-*
-********************************************************************************
-*
-#include "kuip/kcvect.inc"
- CHARACTER*32 VNAME
-*
- CALL KUGETC(VNAME,N)
- IF (VNAME.EQ.'*') THEN
- CALL KUVDEL('*')
- GO TO 999
- ENDIF
- IF (NUMVEC.LE.1) THEN
- CALL KUALFA
- PRINT *,'*** No vector defined'
- GO TO 999
- ENDIF
-10 CALL KUGETL(VNAME,N)
- IF (N.GT.0) THEN
- CALL KUVDEL(VNAME)
- GO TO 10
- ENDIF
-999 END
-
-
diff --git a/src/packlib/kuip/code_kuip/kxdsig.F b/src/packlib/kuip/code_kuip/kxdsig.F
deleted file mode 100644
index 8c085e3..0000000
--- a/src/packlib/kuip/code_kuip/kxdsig.F
+++ /dev/null
@@ -1,36 +0,0 @@
-*
-* $Id: kxdsig.F,v 1.1 1998/12/17 14:20:01 couet Exp $
-*
-* $Log: kxdsig.F,v $
-* Revision 1.1 1998/12/17 14:20:01 couet
-* - new routine to delete the temporary vectors created
-* by $SIGMA. On NT a direct call to kuvdel didn't work
-*
-*
-#include "kuip/pilot.h"
-*-- Author : O.Couet
- SUBROUTINE KXDSIG(NB)
-*
-********************************************************************************
-*
-* Delete the temporary vectors create after a $SIGMA command
-*
-********************************************************************************
-*
- CHARACTER*16 VNAME
- CHARACTER*8 CI
-*
- VNAME = '?SIG'
- CI = ' '
- DO 20 I=1,NB
- WRITE (CI,'(I5)') I
- J = 1
- 10 IF (CI(J:J).EQ.' ') THEN
- J=J+1
- GOTO 10
- ENDIF
- VNAME(5:) = CI(J:)
- CALL KUVDEL(VNAME)
- 20 CONTINUE
-*
- END
diff --git a/src/packlib/kuip/code_kuip/kxlisv.F b/src/packlib/kuip/code_kuip/kxlisv.F
deleted file mode 100644
index 8d0610c..0000000
--- a/src/packlib/kuip/code_kuip/kxlisv.F
+++ /dev/null
@@ -1,75 +0,0 @@
-*
-* $Id: kxlisv.F,v 1.4 1997/03/11 09:43:44 cremel Exp $
-*
-* $Log: kxlisv.F,v $
-* Revision 1.4 1997/03/11 09:43:44 cremel
-* Bug correction in command WAIT (after answering "Q" to a "WAIT" statement,
-* the ability to issue several HISTOGRAM/PLOT statements on a single line,
-* separated by semicolons, disappears).
-* kexec.c : add a test on the variable "kc_flags.in_macro".
-* kuvers.c : increase version number to 2.07/13
-*
-* Revision 1.3 1997/02/18 16:53:11 cremel
-* Bug correction i(can crash with Paw++) for the command "VECTOR/LIST" i
-* (UHTOC(IQ(LVECN+9),4,TYPE,1) instead of UHTOC(IQ(LVECN+9),4,VTYPE,4))
-* and reformatting of the output to make it look better.
-*
-* Revision 1.2 1996/10/01 07:31:18 gunter
-* Use correct types of variables to print; ie. vector name and type are
-* first coverted to CHARACTER using uhtoc, and then printed. Printing
-* integer with A format can crash a program on AIX with f77/f90, if env.
-* variable XLFRTEOPTS=err_recovery=no:langlvl=90std
-*
-* ----------------------------------------------------------------------
-*
-* Revision 1.1.1.1 1996/03/08 15:32:54 mclareni
-* Kuip
-*
-*
-#include "kuip/pilot.h"
-*CMZ : 2.00/11 21/01/93 11.39.08 by Alfred Nathaniel
-*-- Author :
- SUBROUTINE KXLISV
-*
-********************************************************************************
-*
-* Execution routine for command '/VECTOR/LIST'
-*
-* N.B. See KUVECT for description of IQUEST (Q or IQ)
-*
-********************************************************************************
-*
-#include "kuip/kcgen.inc"
-#include "kuip/kcvect.inc"
- CHARACTER*32 VNAME
- CHARACTER*1 TYPE
- CALL KUALFA
- IF (NUMVEC.LE.1) THEN
- PRINT *,'*** No vector defined'
- ELSE
-C PRINT *,'Vector Name Type Length'//
-C + ' Dim-1 Dim-2 Dim-3'
- WRITE (6,1010) 'Vector Name ', 'Type',
- + 'Length', ' Dim-1', ' Dim-2', ' Dim-3'
- PRINT *
- LVECN=LQ(LVEC-1)
- LVECN=LQ(LVECN)
- DO 10 I=2,NUMVEC
- NDIMS=IQ(LVECN+14)
- NNN=10+NDIMS
- IF (NDIMS.EQ.1.AND.IQ(LVECN+11).EQ.1) NNN=10
- CALL UHTOC(IQ(LVECN+1),4,VNAME,32)
- CALL UHTOC(IQ(LVECN+9),4,TYPE,1)
- WRITE (6,1000) VNAME,TYPE,(IQ(LVECN+J),J=10,NNN)
-1000 FORMAT (1X,A32,8X,A1,1X,I6,3(3X,I6))
-1010 FORMAT (1X,A32,5X,A4,1X,A6,3(3X,A6))
- LVECN=LQ(LVECN)
-10 CONTINUE
- PRINT *
- NNN=NUMVEC-1
- PRINT *,'Total of ',NNN,' Vector(s)'
- ENDIF
-999 END
-
-
-
diff --git a/src/packlib/kuip/code_kuip/kxreav.F b/src/packlib/kuip/code_kuip/kxreav.F
deleted file mode 100644
index 21f2d04..0000000
--- a/src/packlib/kuip/code_kuip/kxreav.F
+++ /dev/null
@@ -1,770 +0,0 @@
-*
-* $Id: kxreav.F,v 1.5 2000/01/10 10:35:43 couet Exp $
-*
-* $Log: kxreav.F,v $
-* Revision 1.5 2000/01/10 10:35:43 couet
-* - FNAME is now taken from the common block kcvrwf
-*
-* Revision 1.4 1997/09/25 14:02:28 cremel
-* VECTOR WRITE (kxwriv.F): increase limitation of number of vectors in the
-* list VLIST from 10 to 30 (same value as in kxreav.F for VECTOR/READ).
-* Update HELP for VECTOR/WRITE and VECTOR/READ and mention explicitely this
-* limitation. Improve error message in kxwriv.F and kxreav.F by
-* adding explicitely VECTOR/WRITE and VECTOR/READ.
-* + Increase KUIP version number to 2.07/16 (25/09/97).
-*
-* Revision 1.3 1997/07/08 09:48:24 cremel
-* New version 2.07/14 :
-* bug correction in VECTOR/READ (for free FORMAT suppress the limitation of
-* 80 characters and protect the code when number of tokens > 50) -
-* see example: vec2.kumac + vec2.dat + vec2bad.dat
-*
-* Revision 1.2 1996/10/01 07:35:17 gunter
-* Correct reading of 1-D vectors with matching pattern and creation of
-* vector. This did normally create/leave a vector too big. Now this case is
-* handled the same as n-D vectors-- this can be done as with matching there
-* can only be one number per line.
-*
-* ----------------------------------------------------------------------
-*
-* Revision 1.1.1.1 1996/03/08 15:32:54 mclareni
-* Kuip
-*
-*
-#include "kuip/pilot.h"
-*CMZ : 2.05/15 01/08/94 10.35.04 by Alfred Nathaniel
-*-- Author :
- SUBROUTINE KXREAV
-*
-********************************************************************************
-*
-* Execution routine for command '/VECTOR/READ'
-*
-********************************************************************************
-*
-#include "kuip/kcgen.inc"
-#include "kuip/kcques.inc"
-#include "kuip/kcvect.inc"
-#include "kuip/kcmac.inc"
-#include "kuip/kcunit.inc"
-#include "kuip/kcvrwf.inc"
- CHARACTER*80 LINE,MATCH
- CHARACTER*512 LLINE
- CHARACTER*64 VNAME,VNAMES
- PARAMETER (MAXNV=30)
- DIMENSION VNAMES(MAXNV),LLOWS(MAXNV),LHIGHS(MAXNV)
- DIMENSION LLOWC(MAXNV),LHIGHC(MAXNV)
- DIMENSION IEXIST(MAXNV),V(MAXNV),INTV(MAXNV)
- DIMENSION NELMAX(MAXNV),NEL(MAXNV)
- EQUIVALENCE (V(1),INTV(1))
- CHARACTER*64 FORMAT,FORTMP
- CHARACTER*4 CHOPT
- DIMENSION LENFR(3),LENTO(3),NDIM(3)
- LOGICAL AEXIST
- PARAMETER (MAXTOK=50)
- INTEGER TOK(2,MAXTOK)
- PARAMETER (MAXINT=2147483647)
- LOGICAL MATSIG,IMSTAR,IMOK
- SAVE VNAME
- SAVE NTKSAV,NVSIZS
-*
- NUMREC=0
- TVECFL=.FALSE.
- CALL KUGETC(VNAME,NCHNAM)
-*
- IF (NCHNAM.EQ.0) THEN
- CALL KUALFA
- PRINT *,'*** VECTOR/READ: Vector not specified'
- IQUEST(1)=1
- GO TO 9999
- ENDIF
-*
- NV=0
- LENMIN=1000000
- 10 CONTINUE
- IF (NV.EQ.MAXNV) THEN
- PRINT *,
- + '*** VECTOR/READ: Sive of Vector list is limited to: ',
- + MAXNV
- PRINT *,'*** VECTOR/READ: Last vector to be processed: ',
- + VNAME
- ENDIF
- CALL KUGETL(VNAME,N)
- IF (N.GT.0.AND.NV.LT.MAXNV) THEN
- NV=NV+1
- CALL KUVECT(VNAME,LLOW,LHIGH)
- IF (IQUEST(1).NE.0) GO TO 999
- NEXIST=0
-
- NCHNAM=IQUEST(10)
- NCHSUB=LENOCC(VNAME)-NCHNAM-2
- IF (NCHSUB.GT.0) THEN
- DO 15 I=1,3
- LENFR(I)=IQUEST(20+I)
- LENTO(I)=IQUEST(30+I)
- 15 CONTINUE
- CALL KIVIND(VNAME(NCHNAM+2:),NCHSUB,LENFR,LENTO)
- L=LENTO(1)
- ELSE
- L=0
- ENDIF
-
- IF (LLOW.EQ.0) THEN
- IEXIST(NV)=0
- IF (NCHSUB.GT.0) THEN
- L=LENTO(1)
- IF (L.LT.LENMIN) LENMIN=L
- ENDIF
- ELSE
- IF (IQUEST(11).LT.L) THEN
-*
- NL=0
- ND=L-IQUEST(11)
- CALL MZPUSH(IXKUIP,LVECN,NL,ND,' ')
- IQUEST(1)=0
- IQ(LVECN+10)=L
- IQ(LVECN+10+1)=L
- DO 20 J=1,NV
- CALL KUVECT(VNAMES(J),LLOWS(J),LHIGHS(J))
- IF (IQUEST(1).NE.0) GO TO 999
- 20 CONTINUE
-*
- ENDIF
- IF (IQUEST(11).LT.LENMIN) LENMIN=IQUEST(11)
- IEXIST(NV)=1
- NEXIST=NEXIST+1
- ENDIF
- VNAMES(NV)=VNAME
- LLOWS(NV)=LLOW
- LHIGHS(NV)=LHIGH
- GO TO 10
- ENDIF
- TVECFL=.TRUE.
-*
- AEXIST=.FALSE.
- DO 30 I=1,NV
- IF (IEXIST(I).EQ.0) GO TO 40
- 30 CONTINUE
- AEXIST=.TRUE.
- 40 CONTINUE
-*
- CALL KUGETF(FNAME,NCH)
- CALL KUGETC(FORMAT,NCH)
-* IF (FORMAT.EQ.' '.AND.NV.GT.1) THEN
-* CALL KUALFA
-* PRINT *,'*** Free format on multiple vectors is not allowed:'
-* PRINT *,' you should add a format in the VECTOR/READ command'
-* GO TO 999
-* ENDIF
- IF (FORMAT.NE.' ') THEN
- FORTMP=' '
- FORTMP(1:1)='('
- FORTMP(2:)=FORMAT
- FORTMP(NCH+2:NCH+2)=')'
- FORMAT=FORTMP
- ENDIF
- CALL KUGETC(CHOPT,NCH)
- CALL KUGETS(MATCH,NCH)
- IF (MATCH.NE.' '.AND.CHOPT.NE.'OC') THEN
- CALL KUALFA
- PRINT *,
- + '*** VECTOR/READ: MATCH and CHOPT options are incompatible'
- IQUEST(1)=1
- GO TO 999
- ENDIF
- IF (FNAME.EQ.' ') THEN
- LUNVR=5
- CALL KUALFA
- PRINT *,
- + '*** VECTOR/READ: A non-blank file name must be specified'
- IQUEST(1)=1
- GO TO 999
- ELSE
- LUNVR=LUIVR
- IF (INDEX(CHOPT,'O').GT.0) THEN
- CALL KUOPEN(LUNVR,FNAME,'VERYOLD',ISTAT)
- IF (ISTAT.NE.0) THEN
- CALL KUALFA
- PRINT *,'*** VECTOR/READ: Error in opening file ',
- + FNAME(1:LENOCC(FNAME))
- IQUEST(1)=1
- GO TO 999
- ENDIF
-*
-* Read the first line of the file to get the vector horizontal size
-* (but only if one single vector is given as argument)
-*
- IF (NV.EQ.1) THEN
- NTKSAV=1
- DO 50 I=1,1000000
- READ (LUNVR,'(A)',ERR=280,END=60) LLINE
- IF (LLINE.NE.' ') THEN
- CALL KILEXP(LLINE,' ','''','''',MAXTOK,TOK,NTKSAV,' ')
- GO TO 60
- ENDIF
- 50 CONTINUE
- 60 REWIND (LUNVR)
- IF (NTKSAV.EQ.0) THEN
- CALL KUALFA
- PRINT *,'*** VECTOR/READ: Change data file FORMAT: ',
- + FNAME(1:LENOCC(FNAME))
- GO TO 999
- ENDIF
- ENDIF
-*
-* Read the whole file to get the vector vertical size
-*
-*===>>> IF (MATCH.EQ.' ') THEN
- NVSIZS=0
- DO 70 I=1,1000000
- READ (LUNVR,'(A)',ERR=280,END=80) LINE
- NVSIZS=NVSIZS+1
- 70 CONTINUE
- 80 REWIND (LUNVR)
-*===>>> ENDIF
-*
- ENDIF
- ENDIF
-*
- NVSIZ=NVSIZS
-*
- IF (INDEX(CHOPT,'O').EQ.0.AND.AEXIST) THEN
-*
- NVSIZ=LENMIN
-*
- ELSE
-*
- IF (NV.EQ.1) THEN
- IF (FORMAT.EQ.' ') THEN
- NTOK=NTKSAV
- ELSE
-*
-* Count items in format:
-* search for all E,F,G,I specifiers and add up (optional) repeat counts
-* multiply by (optional) global repeat count
-* repeat count can be 0 (==> count=1), 1, or 2 digits
-* mixing of I and float specifiers does not work
-* only one level of global repeat count implemented
-* no checks for validity of format done
-* Examples:
-* 10F8.2 : 10 item per line
-* 5F4.0,5E12.6 : 10 " " "
-* 4(2F3.0,1X,G11.5) : 12 " " "
-* Won't work:
-* 100I1 : more than 2 digits in repeat count
-* F8.2,I6 : mixing of float and integer
-* 2(F2.0,3(F3.0,F4.1)) : nested repeat counts
-*
- NTOK=0
- FORTMP=FORMAT
- 82 CONTINUE
- LE=INDEX(FORTMP,'E')
- LF=INDEX(FORTMP,'F')
- LG=INDEX(FORTMP,'G')
- LI=INDEX(FORTMP,'I')
- IF(LE.EQ.0) LE=LEN(FORTMP)
- IF(LF.EQ.0) LF=LEN(FORTMP)
- IF(LG.EQ.0) LG=LEN(FORTMP)
- IF(LI.EQ.0) LI=LEN(FORTMP)
- L=MIN(LE,LF,LG,LI)
- IF(L.LT.LEN(FORTMP)) THEN
-* repeat count of specifier
- N=0
- I=ICHAR(FORTMP(L-1:L-1))-ICHAR('0')
- IF(I.GE.0 .AND. I.LE.9) THEN
- N=I
- I=ICHAR(FORTMP(L-2:L-2))-ICHAR('0')
- IF(I.GE.0 .AND. I.LE.9) THEN
- N=I*10+N
- ENDIF
- NTOK=NTOK+N
- ELSE
- NTOK=NTOK+1
- ENDIF
- FORTMP=FORTMP(L+1:)
- GOTO 82
- ENDIF
-* global repeat count
- I=ICHAR(FORMAT(2:2))-ICHAR('0')
- IF(I.GE.0 .AND. I.LE.9) THEN
- N=I
- I=ICHAR(FORMAT(3:3))-ICHAR('0')
- IF(I.GE.0 .AND. I.LE.9) THEN
- IF(FORMAT(4:4).NE.'(') THEN
- N=1
- ELSE
- N=N*10+I
- ENDIF
- ELSEIF(FORMAT(3:3).NE.'(') THEN
- N=1
- ENDIF
- NTOK=NTOK*N
- ENDIF
- ENDIF
- ELSE
- NTOK=1
- ENDIF
-*
-* Create the vector used as index for matching pattern
-*
- NNN=0
- IF (MATCH.NE.' ') THEN
-*===>>> NNN=10000
- NNN=NVSIZS
- J1=INDEX(VNAMES(1),'(')
- IF (J1.EQ.0) J1=LENOCC(VNAMES(1))+1
- CALL KUVEC(VNAMES(1)(1:J1-1)//'#',0,NNN,'CI')
- IF (IQUEST(1).NE.0) GO TO 310
- LLOWX=IQUEST(12)
- LHIGHX=IQUEST(13)
- LMATCH=LENOCC(MATCH)
- LM2=LMATCH-1
- IF (MATCH(1:1).EQ.'-') THEN
- MATSIG=.FALSE.
- LM1=3
- ELSE
- MATSIG=.TRUE.
- LM1=2
- ENDIF
- IMBEG=1
- IF(MATCH(LM1-1:LM1-1).NE.'/') GO TO 320
- IF(MATCH(LM2+1:LM2+1).EQ.')') THEN
- LM2=INDEX(MATCH(LM1:),'/')
- IF (LM2.EQ.0) GO TO 320
- LM2=LM2+LM1-1
- IF (MATCH(LM2+1:LM2+1).NE.'(') GO TO 320
- LM3=LM2+2
- LM4=LMATCH-1
- LM2=LM2-1
- IF (LM3.EQ.LM4.AND.MATCH(LM3:LM4).EQ.'*') THEN
- IMSTAR=.TRUE.
- ELSE
- IMSTAR=.FALSE.
- CALL KICTOI(MATCH(LM3:LM4),IMBEG)
- IF (IQUEST(1).NE.0) GO TO 320
- ENDIF
- ELSE IF (MATCH(LM2+1:LM2+1).NE.'/') THEN
- GO TO 320
- ENDIF
- IMEND=LM2-LM1+1
- IMEND=IMBEG+IMEND-1
- ENDIF
-*
-* Initialize the index vector
-*
- IF (NNN.GT.0) THEN
- IF (IMSTAR) THEN
- IMBEG=1
- IMEND=1
- ENDIF
- NVSIZ=0
- DO 77 I=1,1000000
- READ (LUNVR,'(A)',ERR=280,END=88) LINE
- IMOK=.FALSE.
- IF (IMSTAR) THEN
- IF (INDEX(LINE,MATCH(LM1:LM2)).GT.0) IMOK=.TRUE.
- ENDIF
- IF (IMOK.OR.LINE(IMBEG:IMEND).EQ.MATCH(LM1:LM2)) THEN
- IF (MATSIG) THEN
- IQ(LLOWX+NVSIZ)=1
- ELSE
- IQ(LLOWX+NVSIZ)=0
- ENDIF
- ELSE
- IF (MATSIG) THEN
- IQ(LLOWX+NVSIZ)=0
- ELSE
- IQ(LLOWX+NVSIZ)=1
- ENDIF
- ENDIF
- NVSIZ=NVSIZ+1
- 77 CONTINUE
- 88 REWIND (LUNVR)
- ENDIF
-*
- IF (MATCH.NE.' ') THEN
- NUMREC=NVSIZ
- NTOK=1
- ELSE
- NVSIZ=NVSIZ*NTOK
- ENDIF
-*
-* Check if there is space for automatically created vectors
-*
- LENTOT=NVSIZ*NV
- LLL=50+LENTOT
- CALL MZNEED(IXKUIP,LLL,'G')
- IQUEST(1)=0
- IF (IQUEST(11).LT.0) THEN
- CALL KUALFA
- PRINT *,
- + '*** VECTOR/READ: Not enough memory - Vector not created'
- IQUEST(1)=1
- GO TO 999
- ENDIF
-*
- ENDIF
-*
- IF (LENMIN.EQ.1000000) THEN
-*
- ELSE
- NVSIZ=MIN(LENMIN,NVSIZ)
- ENDIF
- IF (NVSIZ.LE.0) GO TO 290
-
- NVSAV=NVSIZ
-
- DO 100 IV=1,NV
- LLOWC(IV)=1000000
- LHIGHC(IV)=1000000
- IF (IEXIST(IV).EQ.1) GO TO 100
- J1=INDEX(VNAMES(IV),'(')
- IF (J1.EQ.0) J1=LENOCC(VNAMES(IV))+1
- CALL KUVEC(VNAMES(IV)(1:J1-1),0,NVSIZ,'C')
- IF (IQUEST(1).NE.0) GO TO 310
- LLOW=IQUEST(12)
- LHIGH=IQUEST(13)
- DO 90 I=LLOW,LHIGH
- IQ(I)=MAXINT
- 90 CONTINUE
- LLOWC(IV)=LLOW
- LHIGHC(IV)=LHIGH
- 100 CONTINUE
-*
-* Re-compute vector addresses
-*
- DO 660 IV=1,NV
- CALL KUVECT(VNAMES(IV),LLOWC(IV),LHIGHC(IV))
- IF (IQUEST(1).NE.0) GO TO 310
- 660 CONTINUE
-
- J1=INDEX(VNAMES(1),'(')
- IF (J1.EQ.0) J1=LENOCC(VNAMES(1))+1
- CALL KUVECT(VNAMES(1)(1:J1-1)//'#',LLOWX,LHIGHX)
- IF (IQUEST(1).NE.0) GO TO 310
-
- DO 110 IV=1,NV
- CALL KUVECT(VNAMES(IV),LLOWS(IV),LHIGHS(IV))
- IF (IQUEST(1).NE.0) GO TO 310
- IF (IEXIST(IV).EQ.1) GO TO 110
- IF (LLOWS(IV).NE.LLOWC(IV)) GO TO 300
- 110 CONTINUE
-
- LLOW=LLOWS(1)
- LHIGH=LHIGHS(1)
-
- ITYPE=IQUEST(14)
-*
-* Temporary vector used ?
-*
- IF (IQUEST(20).EQ.1) THEN
-*
- DO 120 I=1,3
- LENFR(I)=IQUEST(20+I)
- LENTO(I)=IQUEST(30+I)
- NDIM(I)=IQ(LVECN+10+I)
- 120 CONTINUE
- LLLBEG=LVECN+14
- DO 130 K=LENFR(3),LENTO(3)
- DO 130 J=LENFR(2),LENTO(2)
- DO 130 I=LENFR(1),LENTO(1)
- JJJ=I+NDIM(1)*(J-1)+NDIM(1)*NDIM(2)*(K-1)
- LLL=LLLBEG+JJJ
- IF (FORMAT.EQ.' ') THEN
- IF (ITYPE.EQ.1) THEN
- READ (LUNVR,*,END=330,ERR=280) Q(LLL)
- ELSE IF (ITYPE.EQ.2) THEN
- READ (LUNVR,*,END=330,ERR=280) IQ(LLL)
- ENDIF
- ELSE
- IF (ITYPE.EQ.1) THEN
- READ (LUNVR,FORMAT,END=330,ERR=280) Q(LLL)
- ELSE IF (ITYPE.EQ.2) THEN
- READ (LUNVR,FORMAT,END=330,ERR=280) IQ(LLL)
- ENDIF
- ENDIF
- 130 CONTINUE
-*
- ELSE
-*
- DO 140 I=1,NV
- NEL(I)=0
- NELMAX(I)=1000000
- IF (LHIGHS(I)-LLOWS(I)+1.LT.NELMAX(I))
- + NELMAX(I)=LHIGHS(I)-LLOWS(I)+1
- 140 CONTINUE
-
- NLIN=1000000
- IF (NV.GT.1) THEN
- NCOL=NV
- ELSE
- NCOL=NTOK
- ENDIF
-
- IF (INDEX(CHOPT,'O').EQ.0) THEN
- READ (LUNVR,'(A)',ERR=280,END=280) LINE
- CALL KILEXP(LINE,' ','''','''',MAXTOK,TOK,NTOK,' ')
- NCOL=MIN(NTOK,MAXNV)
- BACKSPACE (LUNVR)
- ENDIF
-
- IEOF=1
- IOKLIN=0
-
- DO 180 ILIN=1,NLIN
-
- IF (NUMREC.GT.0) THEN
- IF (IQ(LLOWX+ILIN-1).EQ.0) THEN
- READ (LUNVR,'(A)',ERR=280,END=190) LINE
- GO TO 180
- ENDIF
- ENDIF
-
- IOKLIN=IOKLIN+1
- LINSAV=IOKLIN
-
- DO 150 I=1,NCOL
- INTV(I)=MAXINT
- 150 CONTINUE
-
-*----------------------------------------------------------------------v
- IF (FORMAT.EQ.' ') THEN
- IF (ITYPE.EQ.1) THEN
- IF (NV.GT.1 .OR. MATCH.NE.' ') THEN
- READ (LUNVR,*,END=190,ERR=280) (V(I),I=1,NCOL)
- ELSE
- READ (LUNVR,*,END=190,ERR=280)
- + (Q(LLOWS(1)+I),I=0,NVSAV-1)
- GO TO 330
- ENDIF
- ELSE IF (ITYPE.EQ.2) THEN
- IF (NV.GT.1 .OR. MATCH.NE.' ') THEN
- READ (LUNVR,*,END=190,ERR=280) (INTV(I),I=1,NCOL)
- ELSE
- READ (LUNVR,*,END=190,ERR=280)
- + (IQ(LLOWS(1)+I),I=0,NVSAV-1)
- GO TO 330
- ENDIF
- ENDIF
-*----------------------------------------------------------------------^
- ELSE
- IF (ITYPE.EQ.1) THEN
- READ (LUNVR,FORMAT,END=190,ERR=280) (V(I),I=1,NCOL)
- ELSE IF (ITYPE.EQ.2) THEN
- READ (LUNVR,FORMAT,END=190,ERR=280) (INTV(I),I=1,NCOL)
- ENDIF
- ENDIF
-
- IF (NV.GT.1 .OR. MATCH.NE.' ') THEN
- DO 160 IV=1,NCOL
- NEL(IV)=NEL(IV)+1
- IF (NEL(IV).GT.NELMAX(IV)) GO TO 190
- Q(LLOWS(IV)+IOKLIN-1)=V(IV)
- 160 CONTINUE
- ELSE
- DO 170 ICOL=1,NCOL
- NEL(1)=NEL(1)+1
- IF (NEL(1).GT.NELMAX(1)) GO TO 190
- Q(LLOWS(1)+NTOK*(IOKLIN-1)+ICOL-1)=V(ICOL)
- 170 CONTINUE
- ENDIF
- IF (INDEX(CHOPT,'C').EQ.0.AND.NEL(1).GE.NELMAX(1)) GO TO 185
- 180 CONTINUE
-
- 185 CONTINUE
-
- IEOF=0
- GO TO 191
-
- 190 CONTINUE
- DO 192 I=1,NCOL
- INTV(I)=MAXINT
- 192 CONTINUE
-
- 191 CONTINUE
-
-*----------------------------------------------------------------------v
- IF (FORMAT.EQ.' ' .AND. NV.EQ.1 .AND. MATCH.EQ.' ') GO TO 330
-*----------------------------------------------------------------------^
-
- IF (INTV(NCOL).EQ.MAXINT) THEN
- DO 200 INVC=NCOL,1,-1
- IF (INTV(INVC).NE.MAXINT) GO TO 210
- 200 CONTINUE
- INVC=0
- IOKLIN=IOKLIN-1
- 210 CONTINUE
- IF (NV.GT.1 .OR. MATCH.NE.' ') THEN
- DO 220 IV=1,INVC
- Q(LLOWS(IV)+LINSAV-1)=V(IV)
- 220 CONTINUE
- ELSE
- DO 230 ICOL=1,INVC
- Q(LLOWS(1)+NTOK*(LINSAV-1)+ICOL-1)=V(ICOL)
- 230 CONTINUE
- ENDIF
- ENDIF
-
- IF (NV.EQ.1 .OR. MATCH.NE.' ') THEN
- DO 240 J=LHIGH,LLOW,-1
- IF (IQ(J).NE.MAXINT) THEN
- I=J+1
- GO TO 250
- ENDIF
- 240 CONTINUE
- I=LLOW
- 250 CONTINUE
- IF (IEXIST(1).EQ.1) THEN
- NWV=I-LLOWS(1)
- ELSE
- NWV=I-LLOWC(1)
- ENDIF
- ELSE
- NWV=IOKLIN
- ENDIF
-
- DO 270 IV=1,NV
-
- IF (IEXIST(IV).EQ.0) THEN
- IF (IOKLIN.EQ.0) THEN
- J1=INDEX(VNAMES(IV),'(')
- IF (J1.EQ.0) J1=LENOCC(VNAMES(IV))+1
- CALL KUVDEL(VNAMES(IV)(1:J1-1))
- GO TO 270
- ENDIF
- LINE=VNAMES(IV)
- CALL CLTOU(LINE)
- CALL KUALFA
- PRINT *,'*** VECTOR/READ: Unknown vector ',
- + LINE(:LENOCC(LINE)),
- + ' is created with length',NWV
-* IF (IEOF.EQ.0) THEN
-* IF (NV.EQ.1.OR.NV.EQ.NEXIST) THEN
-* PRINT *,' but whole file did not fit into vector'
-* LINE=FNAME
-* CALL CLTOU(LINE)
-* PRINT *,'*** EOF on file ',LINE(:LENOCC(LINE))
-* ENDIF
-* ENDIF
- NL=0
- ND=-(NVSIZ-NWV)
- CALL KUVECT(VNAMES(IV),LLOWS(IV),LHIGHS(IV))
- IF (IQUEST(1).NE.0) GO TO 310
- CALL MZPUSH(IXKUIP,LVECN,NL,ND,' ')
- IQUEST(1)=0
- IQ(LVECN+10)=NWV
- IQ(LVECN+10+1)=NWV
- DO 260 J=1,NV
- CALL KUVECT(VNAMES(J),LLOWS(J),LHIGHS(J))
- IF (IQUEST(1).NE.0) GO TO 310
- 260 CONTINUE
- ELSE
-* IF (IEOF.EQ.1) THEN
-* LINE=FNAME
-* CALL CLTOU(LINE)
-* PRINT *,'*** EOF on file ',LINE(:LENOCC(LINE))
-* GO TO 250
-* ENDIF
- ENDIF
-
- 270 CONTINUE
-*
- ENDIF
-*
- GO TO 330
-
- 280 CALL KUALFA
- PRINT *,'*** VECTOR/READ: Error in reading from file ',
- + FNAME(1:LENOCC(FNAME))
- IF (LUNVR.NE.5) CALL KUCLOS(LUNVR,' ',ISTAT)
- IQUEST(1)=1
- GO TO 999
-
- 290 CALL KUALFA
- IF (LUNVR.NE.5) CALL KUCLOS(LUNVR,' ',ISTAT)
- PRINT *,
- + '*** VECTOR/READ: Not enough memory - Cannot create the vector'
- IQUEST(1)=1
- GO TO 999
-
- 300 CALL KUALFA
- PRINT *,'*** VECTOR/READ: Subscripts must start at 1'
- IF (LUNVR.NE.5) CALL KUCLOS(LUNVR,' ',ISTAT)
- IQUEST(1)=1
- GO TO 999
-
- 310 IF (LUNVR.NE.5) CALL KUCLOS(LUNVR,' ',ISTAT)
- GO TO 999
-
- 320 CALL KUALFA
- IF (LUNVR.NE.5) CALL KUCLOS(LUNVR,' ',ISTAT)
- PRINT *,
- + '*** VECTOR/READ: Error in definition of matching pattern'
- IQUEST(1)=1
- GO TO 999
-
- 330 CONTINUE
-
- IF (FORMAT.EQ.' ' .AND. NV.EQ.1 .AND. MATCH.EQ.' ') THEN
- IF (IEXIST(1).EQ.0) THEN
- LINE=VNAMES(1)
- CALL CLTOU(LINE)
- CALL KUALFA
- PRINT *,'*** VECTOR/READ: Unknown vector ',
- + LINE(:LENOCC(LINE)),
- + ' is created with length',NVSAV
- ENDIF
- ENDIF
-
- IF ((LUNVR.NE.5).AND.(INDEX(CHOPT,'C').GT.0))
- + CALL KUCLOS(LUNVR,' ',ISTAT)
-
- IF (INDEX(CHOPT,'Z').NE.0) THEN
-*
-* Temporary vector used ?
-*
- IF (IQUEST(20).EQ.1) THEN
-*
- DO 340 K=LENFR(3),LENTO(3)
- DO 340 J=LENFR(2),LENTO(2)
- DO 340 I=LENFR(1),LENTO(1)
- JJJ=I+NDIM(1)*(J-1)+NDIM(1)*NDIM(2)*(K-1)
- LLL=LLLBEG+JJJ
- LLLP1=LLL+1
- IF (ITYPE.EQ.1) THEN
- IF (Q(LLLP1).EQ.0) Q(LLLP1)=Q(LLL)
- ELSE IF (ITYPE.EQ.2) THEN
- IF (IQ(LLLP1).EQ.0) IQ(LLLP1)=IQ(LLL)
- ENDIF
- 340 CONTINUE
-*
- ELSE
-*
- DO 350 I=LLOW+1,LHIGH
- IF (ITYPE.EQ.1) THEN
- IF (Q(I).EQ.0) Q(I)=Q(I-1)
- ELSE IF (ITYPE.EQ.2) THEN
- IF (IQ(I).EQ.0) IQ(I)=IQ(I-1)
- ENDIF
- 350 CONTINUE
-*
- ENDIF
-*
- ENDIF
-*
- 999 CONTINUE
-
- IF (NUMREC.GT.0) THEN
- J1=INDEX(VNAMES(1),'(')
- IF (J1.EQ.0) J1=LENOCC(VNAMES(1))+1
- CALL KUVDEL(VNAMES(1)(1:J1-1)//'#')
- CALL KUALFA
- IF (IOKLIN.EQ.0) THEN
- PRINT *,'*** VECTOR/READ: No match'
- ELSE
- IF (IEXIST(1).EQ.1) PRINT *,'*** VECTOR/READ: ',
- + IOKLIN,' record(s) matched'
- ENDIF
- ENDIF
-
- 9999 END
diff --git a/src/packlib/kuip/code_kuip/kxunit.F b/src/packlib/kuip/code_kuip/kxunit.F
deleted file mode 100644
index d55bec2..0000000
--- a/src/packlib/kuip/code_kuip/kxunit.F
+++ /dev/null
@@ -1,105 +0,0 @@
-*
-* $Id: kxunit.F,v 1.2 1998/02/11 15:17:20 couet Exp $
-*
-* $Log: kxunit.F,v $
-* Revision 1.2 1998/02/11 15:17:20 couet
-* - do not print the bottom line of the table if no files have been found.
-*
-* Revision 1.1.1.1 1996/03/08 15:32:54 mclareni
-* Kuip
-*
-*
-#include "kuip/pilot.h"
-*CMZ : 2.01/00 25/02/93 14.26.32 by Alfred Nathaniel
-*-- Author :
- SUBROUTINE KXUNIT
-*
-********************************************************************************
-*
-* Execution routine for command '/KUIP/UNITS'
-*
-* (by the courtesy of ZCEDEX)
-*
-********************************************************************************
-*
-#include "kuip/kcunit.inc"
-#include "kuip/kcques.inc"
- CHARACTER*80 FILE
- CHARACTER*11 FRM
- CHARACTER*10 ACC
- CHARACTER*5 CHRECL
-*
-#if defined(CERNLIB_NEWLIB)
- CHARACTER*70 RTAREA
- CHARACTER*8 FILENAME
-#endif
-*
- CALL KUALFA
- WRITE(LUOUT,2000)
-2000 FORMAT
- + (' +',4('-'),'+',39('-'),'+',12('-'),'+',11('-'),'+',6('-'),'+')
- WRITE(LUOUT,2100)
-2100 FORMAT
- + (' | Lu | File name',T47,'| Format | Access | Recl |')
- WRITE(LUOUT,2000)
- IFNP = 0
- DO 200 I=1,99
-#if defined(CERNLIB_NEWLIB)
- CALL ITOFT(I,FILENAME,IERR)
- RTAREA=' '
- CALL DYNAM(0,'INFO',RTAREA,'DDN='//FILENAME//';')
-#endif
- FILE=' '
- CALL KUINQF(FILE,I)
- IF (FILE.NE.' ') THEN
- IFNP = 1
- IF (IQUEST(11).EQ.1) THEN
- FRM='FORMATTED'
- ELSE IF (IQUEST(11).EQ.2) THEN
- FRM='UNFORMATTED'
- ELSE
- FRM=' '
- ENDIF
- IF (IQUEST(12).EQ.1) THEN
- ACC='SEQUENTIAL'
- ELSE IF (IQUEST(12).EQ.2) THEN
- ACC='DIRECT'
- ELSE
- ACC=' '
- ENDIF
- LRECL=IQUEST(13)
- IF (LRECL.EQ.0) THEN
- CHRECL=' '
- ELSE
- WRITE (CHRECL,'(I5)') LRECL
- ENDIF
-#if defined(CERNLIB_NEWLIB)
- IF (RTAREA(9:16).NE.'NULLFILE' .AND. RTAREA(9:12).NE.'SYS9')
- + FILE=RTAREA(9:52)
-#endif
- L=LENOCC(FILE)
- IF(L.LE.38) THEN
- WRITE(LUOUT,2200)I,FILE(1:L),FRM,ACC,CHRECL
-2200 FORMAT
- + (1X,'|',I3,' | ',A,T47,'| ',A,T60,'| ',A,T72,'|',A,' |')
- ELSE
- WRITE(LUOUT,2300)I,FILE(1:L),FRM,ACC,CHRECL
-2300 FORMAT
- + (1X,'|',I3,' | ',A/T47,'| ',A,T60,'| ',A,T72,'|',A,' |')
- ENDIF
-#if defined(CERNLIB_NEWLIB)
- ELSE
- IF (RTAREA.NE.' ') THEN
- FILE=RTAREA(9:52)
- IF (FILE(1:8).EQ.'NULLFILE') FILE='TERMINAL'
- IF (FILE(1:4).EQ.'SYS9') FILE='TEMPORARY FILE'
- FRM='FORMATTED'
- ACC='SEQUENTIAL'
- CHRECL=' '
- WRITE(LUOUT,2200)I,FILE(1:LENOCC(FILE)),FRM,ACC,CHRECL
- ENDIF
-#endif
- ENDIF
-200 CONTINUE
- IF (IFNP.NE.0) WRITE(LUOUT,2000)
- END
diff --git a/src/packlib/kuip/code_kuip/kxvope.F b/src/packlib/kuip/code_kuip/kxvope.F
deleted file mode 100644
index e6f4b59..0000000
--- a/src/packlib/kuip/code_kuip/kxvope.F
+++ /dev/null
@@ -1,154 +0,0 @@
-*
-* $Id: kxvope.F,v 1.1.1.1 1996/03/08 15:32:54 mclareni Exp $
-*
-* $Log: kxvope.F,v $
-* Revision 1.1.1.1 1996/03/08 15:32:54 mclareni
-* Kuip
-*
-*
-#include "kuip/pilot.h"
-*CMZ : 1.64/07 28/09/90 20.16.48 by
-** Supporting Complex-type vectors now available in SIGMA
-*-- Author :
- SUBROUTINE KXVOPE
-*
-********************************************************************************
-*
-* Execution routine for commands : '/VECTOR/OPERATIONS/VBIAS'
-* '/VECTOR/OPERATIONS/VSCALE'
-* '/VECTOR/OPERATIONS/VADD'
-* '/VECTOR/OPERATIONS/VMULTIPLY'
-* '/VECTOR/OPERATIONS/VSUBTRACT'
-* '/VECTOR/OPERATIONS/VDIVIDE'
-*
-********************************************************************************
-*
-#include "kuip/kcgen.inc"
-#include "kuip/kcques.inc"
- CHARACTER*32 VNAM1,VNAM2,VNAM3,CHPATH
- SAVE VNAM1,VNAM2,VNAM3,RVAL
- CHARACTER*1 CTYPE
-*
- CALL KUPATL(CHPATH,NPAR)
-*
-* Search for the (first) source vector
-*
- CALL KUGETV(VNAM1,LLOW1,LHIGH1)
- IF (LLOW1.EQ.0) GO TO 999
-*
-* Get the type and the length of the source vector(s)
-*
- IF (IQUEST(14).EQ.1) THEN
- CTYPE='R'
- ELSE IF (IQUEST(14).EQ.2) THEN
- CTYPE='I'
- ELSE IF (IQUEST(14).EQ.3) THEN
- CTYPE='C'
- ENDIF
- LENTOT=IQUEST(11)
-*
- IF (CHPATH.EQ.'VBIAS'.OR.CHPATH.EQ.'VSCALE') THEN
- CALL KUGETR(RVAL)
- ELSE
-*
-* Search for the (second) source vector
-*
- CALL KUGETV(VNAM2,LLOW2,LHIGH2)
- IF (LLOW2.EQ.0) GO TO 999
- ENDIF
-*
-* Search for the destination vector and if not found create it
-* (KUGETV replaced by KUGETC + KUVECT to avoid warning if vector not existing)
-*
- CALL KUGETC(VNAM3,NCH)
- CALL KUVECT(VNAM3,LLOW3,LHIGH3)
-*
- IF (LLOW3.EQ.0) THEN
- CALL KUVEC(VNAM3,DUMMY,LENTOT,'C')
- IF (IQUEST(1).NE.0) THEN
- CALL KUALFA
- PRINT *,'*** KXVOPE: Error in creating destination vector'
- GO TO 999
- ENDIF
- LLOW3=IQUEST(12)
- LHIGH3=IQUEST(13)
- ENDIF
-*
-* Protect against overwriting when destination < source
-*
- IF ((LHIGH1-LLOW1).GT.(LHIGH3-LLOW3)) LHIGH1=LLOW1+(LHIGH3-LLOW3)
-*
- IF (CHPATH.EQ.'VBIAS') THEN
- J=0
- DO 10 I=LLOW1,LHIGH1
- IF (IQUEST(14).EQ.1) THEN
- Q(LLOW3+J)=RVAL+Q(I)
- ELSE IF (IQUEST(14).EQ.2) THEN
- IQ(LLOW3+J)=RVAL+IQ(I)
- ENDIF
- J=J+1
-10 CONTINUE
- ELSE IF (CHPATH.EQ.'VSCALE') THEN
- J=0
- DO 20 I=LLOW1,LHIGH1
- IF (IQUEST(14).EQ.1) THEN
- Q(LLOW3+J)=RVAL*Q(I)
- ELSE IF (IQUEST(14).EQ.2) THEN
- IQ(LLOW3+J)=RVAL*IQ(I)
- ENDIF
- J=J+1
-20 CONTINUE
- ELSE IF (CHPATH.EQ.'VADD') THEN
- J=0
- DO 30 I=LLOW1,LHIGH1
- IF (IQUEST(14).EQ.1) THEN
- Q(LLOW3+J)=Q(I)+Q(LLOW2+J)
- ELSE IF (IQUEST(14).EQ.2) THEN
- IQ(LLOW3+J)=IQ(I)+IQ(LLOW2+J)
- ENDIF
- J=J+1
-30 CONTINUE
- ELSE IF (CHPATH.EQ.'VMULTIPLY') THEN
- J=0
- DO 40 I=LLOW1,LHIGH1
- IF (IQUEST(14).EQ.1) THEN
- Q(LLOW3+J)=Q(I)*Q(LLOW2+J)
- ELSE IF (IQUEST(14).EQ.2) THEN
- IQ(LLOW3+J)=IQ(I)*IQ(LLOW2+J)
- ENDIF
- J=J+1
-40 CONTINUE
- ELSE IF (CHPATH.EQ.'VSUBTRACT') THEN
- J=0
- DO 50 I=LLOW1,LHIGH1
- IF (IQUEST(14).EQ.1) THEN
- Q(LLOW3+J)=Q(I)-Q(LLOW2+J)
- ELSE IF (IQUEST(14).EQ.2) THEN
- IQ(LLOW3+J)=IQ(I)-IQ(LLOW2+J)
- ENDIF
- J=J+1
-50 CONTINUE
- ELSE IF (CHPATH.EQ.'VDIVIDE') THEN
- J=0
- DO 60 I=LLOW1,LHIGH1
- IF (IQUEST(14).EQ.1) THEN
- IF (Q(LLOW2+J).EQ.0.) THEN
- Q(LLOW3+J)=0.
- ELSE
- Q(LLOW3+J)=Q(I)/Q(LLOW2+J)
- ENDIF
- ELSE IF (IQUEST(14).EQ.2) THEN
- IF (IQ(LLOW2+J).EQ.0) THEN
- IQ(LLOW3+J)=0
- ELSE
- IQ(LLOW3+J)=IQ(I)/IQ(LLOW2+J)
- ENDIF
- ENDIF
- J=J+1
-60 CONTINUE
- ENDIF
-
-999 END
-
-
-
diff --git a/src/packlib/kuip/code_kuip/kxwriv.F b/src/packlib/kuip/code_kuip/kxwriv.F
deleted file mode 100644
index 3b4d697..0000000
--- a/src/packlib/kuip/code_kuip/kxwriv.F
+++ /dev/null
@@ -1,192 +0,0 @@
-*
-* $Id: kxwriv.F,v 1.4 2000/01/10 10:35:44 couet Exp $
-*
-* $Log: kxwriv.F,v $
-* Revision 1.4 2000/01/10 10:35:44 couet
-* - FNAME is now taken from the common block kcvrwf
-*
-* Revision 1.3 1997/09/25 14:02:28 cremel
-* VECTOR WRITE (kxwriv.F): increase limitation of number of vectors in the
-* list VLIST from 10 to 30 (same value as in kxreav.F for VECTOR/READ).
-* Update HELP for VECTOR/WRITE and VECTOR/READ and mention explicitely this
-* limitation. Improve error message in kxwriv.F and kxreav.F by
-* adding explicitely VECTOR/WRITE and VECTOR/READ.
-* + Increase KUIP version number to 2.07/16 (25/09/97).
-*
-* Revision 1.2 1996/04/11 09:44:19 cernlib
-* Do not convert to uppercase on retrieve of format
-*
-* Revision 1.1.1.1 1996/03/08 15:32:54 mclareni
-* Kuip
-*
-*
-#include "kuip/pilot.h"
-*CMZ : 2.05/15 01/08/94 10.35.04 by Alfred Nathaniel
-*-- Author :
- SUBROUTINE KXWRIV
-*
-********************************************************************************
-*
-* Execution routine for command '/VECTOR/WRITE'
-*
-********************************************************************************
-*
-#include "kuip/kcgen.inc"
-#include "kuip/kcques.inc"
-#include "kuip/kcunit.inc"
-#include "kuip/kcvrwf.inc"
- CHARACTER*64 VNAME
- PARAMETER (MAXNV=30)
- DIMENSION LLOWS(MAXNV),LHIGHS(MAXNV)
- DIMENSION V(MAXNV),INTV(MAXNV)
- EQUIVALENCE (V(1),INTV(1))
- CHARACTER*64 FORMAT,FORTMP
- CHARACTER*4 CHOPT
- SAVE VNAME
-*
- CALL KUGETC(VNAME,NCHNAM)
-*
- IF (NCHNAM.EQ.0) THEN
- CALL KUALFA
- PRINT *,'*** VECTOR/WRITE: Vector not specified'
- IQUEST(1)=1
- GO TO 999
- ENDIF
-*
- NV=0
- LENMIN=1000000
-5 CONTINUE
- IF (NV.EQ.MAXNV) THEN
- PRINT *,
- + '*** VECTOR/WRITE: Sive of Vector list is limited to: ',
- + MAXNV
- PRINT *,'*** VECTOR/WRITE: Last vector to be processed: ',
- + VNAME
- ENDIF
- CALL KUGETL(VNAME,N)
- IF (N.GT.0.AND.NV.LT.MAXNV) THEN
- NV=NV+1
- CALL KUVECT(VNAME,LLOW,LHIGH)
- IF (IQUEST(1).NE.0) GO TO 999
- IF (LLOW.EQ.0) THEN
- CALL KUALFA
- PRINT *,'*** VECTOR/WRITE: Unknown vector ',VNAME
- IQUEST(1)=1
- GO TO 999
- ELSE
- L=(IQUEST(31)-IQUEST(21)+1)*
- + (IQUEST(32)-IQUEST(22)+1)*
- + (IQUEST(33)-IQUEST(23)+1)
- IF (L.LT.LENMIN) LENMIN=L
- ENDIF
- LLOWS(NV)=LLOW
- LHIGHS(NV)=LHIGH
- GO TO 5
- ENDIF
-*
- CALL KUGETF(FNAME,NCH)
- IF (LLOW.EQ.0) GO TO 999
- LENTOT=IQUEST(11)
- ILOW =IQUEST(12)
- IHIGH =IQUEST(13)
- ITYPE =IQUEST(14)
- CALL KUGETS(FORMAT,NCH)
- IF (FORMAT.NE.' ') THEN
- FORTMP=' '
- FORTMP(1:1)='('
- FORTMP(2:)=FORMAT
- FORTMP(NCH+2:NCH+2)=')'
- FORMAT=FORTMP
- ENDIF
- CALL KUGETC(CHOPT,NCH)
- IF (FNAME.EQ.' ') THEN
- LUNVW=6
- CALL KUALFA
- ELSE
- CALL KUINQF(FNAME,LUN)
- IF (LUN.GT.0) THEN
- IF (IQUEST(11).EQ.1.AND.IQUEST(12).EQ.1) THEN
- LUNVW=LUN
- ELSE
- CALL KUALFA
- PRINT *,'*** VECTOR/WRITE: Error: ',
- + FNAME(1:LENOCC(FNAME)),
- + ' is not a FORMATTED SEQUENTIAL file'
- GO TO 999
- ENDIF
- ELSE
- LUNVW=LUIVW
- ENDIF
- IF (INDEX(CHOPT,'O').GT.0) THEN
- CALL KUOPEN(LUNVW,FNAME,'VERYNEW',ISTAT)
- IF (ISTAT.NE.0) THEN
- CALL KUALFA
- PRINT *,'*** VECTOR/WRITE: Error in opening file ',
- + FNAME(1:LENOCC(FNAME))
- GO TO 999
- ENDIF
- ENDIF
- ENDIF
-
- IF (NV.EQ.1) THEN
- NLIN=1
- ELSE
- NLIN=LENMIN
- ENDIF
-
- DO 55 ILIN=1,NLIN
-
- IF (NV.EQ.1) GO TO 66
-
- DO 90 IV=1,NV
- V(IV)=Q(LLOWS(IV)+ILIN-1)
-90 CONTINUE
-
-66 CONTINUE
-
- IF (FORMAT.EQ.' ') THEN
- IF (ITYPE.EQ.1) THEN
- IF (NV.EQ.1) THEN
- WRITE (LUNVW,*,ERR=950) (Q(I),I=LLOW,LHIGH)
- ELSE
- WRITE (LUNVW,*,ERR=950) (V(I),I=1,NV)
- ENDIF
- ELSE IF (ITYPE.EQ.2) THEN
- IF (NV.EQ.1) THEN
- WRITE (LUNVW,*,ERR=950) (IQ(I),I=LLOW,LHIGH)
- ELSE
- WRITE (LUNVW,*,ERR=950) (INTV(I),I=1,NV)
- ENDIF
- ENDIF
- ELSE
- IF (ITYPE.EQ.1) THEN
- IF (NV.EQ.1) THEN
- WRITE (LUNVW,FORMAT,ERR=950) (Q(I),I=LLOW,LHIGH)
- ELSE
- WRITE (LUNVW,FORMAT,ERR=950) (V(I),I=1,NV)
- ENDIF
- ELSE IF (ITYPE.EQ.2) THEN
- IF (NV.EQ.1) THEN
- WRITE (LUNVW,FORMAT,ERR=950) (IQ(I),I=LLOW,LHIGH)
- ELSE
- WRITE (LUNVW,FORMAT,ERR=950) (INTV(I),I=1,NV)
- ENDIF
- ENDIF
- ENDIF
-
-55 CONTINUE
-
- GO TO 990
-
-950 CALL KUALFA
- PRINT *,'*** VECTOR/WRITE: Error in writing to file ',
- + FNAME(1:LENOCC(FNAME))
- GO TO 990
-
-990 IF ((LUNVW.NE.6).AND.(INDEX(CHOPT,'C').GT.0))
- + CALL KUCLOS(LUNVW,' ',ISTAT)
-
-999 END
-
-
-
diff --git a/src/packlib/kuip/code_kuip/put.s b/src/packlib/kuip/code_kuip/put.s
deleted file mode 100644
index bade818..0000000
--- a/src/packlib/kuip/code_kuip/put.s
+++ /dev/null
@@ -1,115 +0,0 @@
-*
-* $Id: put.s,v 1.1.1.1 1996/03/08 15:32:59 mclareni Exp $
-*
-* $Log: put.s,v $
-* Revision 1.1.1.1 1996/03/08 15:32:59 mclareni
-* Kuip
-*
-*
-#if defined(CERNLIB_IBMMVS)
-*CMZ : 2.05/02 11/05/94 09.50.52 by Alfred Nathaniel
-*-- Author :
-* 27/06/90 006291027 MEMBER NAME $PUT (XCMZ.S) ASSEMBLER
-*
-***********************************************************************
-* $PUT PROGRAM *
-* PUT A MESSAGE ON A TSO TERMINAL *
-* *
-* AUTHOR: *
-* H.-P. SOMMER DESY (DHHDESY3 at R02SOM) MVS(XA),RMODE=ANY*
-* *
-* CALLING SEQUENCE: *
-* CALL $PUT ( OUT, LGOUT, IST ) *
-* *
-* OUT OUTPUT CHARACTER STRING (INPUT) *
-* LGOUT NB OF CHARACTERS OF OUT (INPUT) *
-* IST STATUS (OUTPUT) *
-* -01 BAD LGOUT *
-* -08 'ATTN' INTERRUPT RECEIVED *
-* -12 BUFFER TOO SMALL *
-* -20 TERMINAL DISCONNECTED *
-* *
-***********************************************************************
-* *
-* MACRO REGS
- MACRO
- REGS
- PUSH PRINT
- PRINT ON,NOGEN
-R0 EQU 0
-R1 EQU 1
-R2 EQU 2
-R3 EQU 3
-R4 EQU 4
-R5 EQU 5
-R6 EQU 6
-R7 EQU 7
-R8 EQU 8
-R9 EQU 9
-R10 EQU 10
-R11 EQU 11
-R12 EQU 12
-R13 EQU 13
-R14 EQU 14
-R15 EQU 15
-F0 EQU 0
-F2 EQU 2
-F4 EQU 4
-F6 EQU 6
- POP PRINT
- MEND
-*
-*
-$PUT AMODE 31
-$PUT RMODE ANY
-*
-$PUT START 0
- REGS
- USING *,R12
- SAVE (14,12)
- LR R12,R15
- LM R2,R4,0(R1)
- LR R11,R4
- GETMAIN R,LV=DYNL
- ST R13,4(R1)
- ST R1,8(R13)
- LR R13,R1
- USING WORK,R13
-*
- L R3,0(R3) LGOUT
- LA R15,1 STATUT SI LGOUT MAUVAIS
- LTR R3,R3
- BNH ERREUR
- CH R3,LGMAX
- BNL ERREUR
-*
- LR R8,R2 EXTERN TPUT STRING @31
- LR R7,R3 LENGTH OF STRING @31
- LA R6,TEXTSTR ADDRESS OF LOCAL STRING BELOW 16M
- LR R9,R7 SAME LENGTH TO SECOND OPERAND @31
- MVCL R6,R8 MOVE STRING BELOW 16MB-LINE @31
-*
- LA R6,TEXTSTR ADDRESS OF LOCAL STRING BELOW 16M
-* ADD NEWLINE CHARACTER AT THE END
- LR R8,R6
- AR R8,R3
- MVI 0(R8),X'15' NL RETURNS CURSOR
- LA R3,1(R3)
-* TPUT - WITH OPTIONS ASIS AND LINE FEED
- TPUT (6),(3),ASIS
-*
-ERREUR LCR R15,R15
- ST R15,0(R11)
- L R3,4(R13)
- FREEMAIN R,LV=DYNL,A=(R13)
- LR R13,R3
- RETURN (14,12),T,RC=0
-*
-LGMAX DC H'132'
-*
-WORK DSECT
-SAVE DS 18F 72 BYTES FOR SAVE AREA REQUIRED
-TEXTSTR DS CL(132+1) MAX TEXT PLUS NL
-DYNL EQU *-SAVE
- END
-#endif
diff --git a/src/packlib/kuip/code_kuip/putget.s b/src/packlib/kuip/code_kuip/putget.s
deleted file mode 100644
index 4512d51..0000000
--- a/src/packlib/kuip/code_kuip/putget.s
+++ /dev/null
@@ -1,145 +0,0 @@
-*
-* $Id: putget.s,v 1.1.1.1 1996/03/08 15:32:53 mclareni Exp $
-*
-* $Log: putget.s,v $
-* Revision 1.1.1.1 1996/03/08 15:32:53 mclareni
-* Kuip
-*
-*
-#if defined(CERNLIB_IBMMVS)
-*CMZ : 2.05/02 11/05/94 09.50.52 by Alfred Nathaniel
-*-- Author :
-***********************************************************************
-* $PUTGET PROGRAM *
-* PROMPT A MESSAGE ON A TSO TERMINAL AND READ TYPED ANSWER*
-* ON THE SAME LINE *
-* *
-* AUTHOR: *
-* G. WEIL CENTRE DE CALCUL DE STRASBOURG (CNRS) *
-* CHANGES 20/06/90. MVS/XA VALID UNDER: AMODE=31,RMODE=ANY *
-* H.-P. SOMMER DESY (DHHDESY3 at R02SOM) *
-* *
-* CALLING SEQUENCE: *
-* CALL $PUTGET ( OUT, LGOUT, IN, LGIN, IST ) *
-* *
-* OUT OUTPUT CHARACTER STRING (PROMPT) (INPUT) *
-* LGOUT NB OF CHARACTERS OF OUT (INPUT) *
-* IN READ CHARACTER STRING (OUTPUT) *
-* LGIN CHARACTER MAX SIZE OF IN (INPUT) *
-* IST STATUS (OUTPUT) *
-* >0 NB OF CHARACTERS READ *
-* -01 BAD LGOUT *
-* -02 BAD LGIN *
-* -08 'ATTN' INTERRUPT RECEIVED *
-* -12 BUFFER TOO SMALL *
-* -20 TERMINAL DISCONNECTED *
-* *
-***********************************************************************
-*
-* MACRO REGS
- MACRO
- REGS
- PUSH PRINT
- PRINT ON,NOGEN
-R0 EQU 0
-R1 EQU 1
-R2 EQU 2
-R3 EQU 3
-R4 EQU 4
-R5 EQU 5
-R6 EQU 6
-R7 EQU 7
-R8 EQU 8
-R9 EQU 9
-R10 EQU 10
-R11 EQU 11
-R12 EQU 12
-R13 EQU 13
-R14 EQU 14
-R15 EQU 15
-F0 EQU 0
-F2 EQU 2
-F4 EQU 4
-F6 EQU 6
- POP PRINT
- MEND
-*
-*
-$PUTGET AMODE 31
-$PUTGET RMODE ANY
-*
-$PUTGET START 0
-PUTFLG EQU B'00000001'
-GETFLG EQU B'10000000'
- REGS
- USING *,R12
- SAVE (14,12)
- LR R12,R15
- LM R2,R6,0(R1)
- LR R11,R6
- GETMAIN R,LV=72+132
- ST R13,4(R1)
- ST R1,8(R13)
- LR R13,R1
- USING WORK,R13
-*
- L R3,0(R3) LGOUT
- L R5,0(R5) LGIN
- LA R15,1 STATUT SI LGOUT MAUVAIS
- LTR R3,R3
- BNH ERREUR
- CH R3,LGMAX
- BNL ERREUR
- LA R15,2 STATUT SI LGIN MAUVAIS
- LTR R5,R5
- BNH ERREUR
- CH R5,LGMAX
- BNL ERREUR
-* TPUT
- LR R8,R2 EXTERN TPUT STRING @31
- LR R7,R3 LENGTH OF STRING @31
- LA R6,TEXTSTR ADDRESS OF LOCAL STRING BELOW 16M
- LR R9,R7 SAME LENGTH TO SECOND OPERAND @31
- MVCL R6,R8 MOVE STRING BELOW 16MB-LINE @31
-*
- LA R6,TEXTSTR ADDRESS OF LOCAL STRING BELOW 16M
- LA R7,PUTFLG FLAGS POUT TPUT
- SLL R7,24
- OR R6,R7 OUTPUT STRING
- TPUT (6),(3),R
- LTR R15,R15
- BNZ ERREUR
-* TGET
- LA R6,TEXTSTR ADDRESS OF LOCAL STRING BELOW 16M
- LA R8,GETFLG FLAGS POUR TGET
- SLL R8,24
- OR R6,R8 INPUT STRING
- TGET (6),(5),R
- LTR R15,R15
- BNZ ERREUR
- LR R2,R1 LENGTH OF STRING @31
- LA R6,TEXTSTR ADDRESS OF LOCAL STRING BELOW 16M
- OR R6,R7 OUTPUT STRING
-* DEBUG TPUT (6),(5),R
- LR R6,R4 EXTERN GET STRING @31
- LR R7,R2 LENGTH OF STRING @31
- LA R8,TEXTSTR ADDRESS OF LOCAL STRING BELOW 16M
- LR R9,R7 SAME LENGTH TO SECOND OPERAND @31
- MVCL R6,R8 MOVE STRING TO TARGET LINE @31
- LNR R15,R2
-*
-*
-ERREUR LCR R15,R15
- ST R15,0(R11)
- L R3,4(R13)
- FREEMAIN R,LV=72+132,A=(R13)
- LR R13,R3
- RETURN (14,12),T,RC=0
-LGMAX DC H'132'
-*
-WORK DSECT
-SAVE DS 18F 72 BYTES FOR SAVE AREA REQUIRED
-TEXTSTR DS CL132
-DYNL EQU *-SAVE
- END
-#endif
diff --git a/src/packlib/kuip/code_kuip/putgeti.F b/src/packlib/kuip/code_kuip/putgeti.F
deleted file mode 100644
index 95f78cb..0000000
--- a/src/packlib/kuip/code_kuip/putgeti.F
+++ /dev/null
@@ -1,105 +0,0 @@
-*
-* $Id: putgeti.F,v 1.1.1.1 1996/03/08 15:32:55 mclareni Exp $
-*
-* $Log: putgeti.F,v $
-* Revision 1.1.1.1 1996/03/08 15:32:55 mclareni
-* Kuip
-*
-*
-#include "kuip/pilot.h"
-#if defined(CERNLIB_IBMMVS)
-*CMZ : 2.01/02 01/03/93 15.19.19 by Alfred Nathaniel
-*-- Author :
- SUBROUTINE PUTGET(PSTR, LPSTR, ANSW, MAXANS, NANSW)
-*
-************************************************************************
-* *
-* PUTGET *
-* *
-* Write prompt string PSTR on standard output and wait for an answer. *
-* On return ANSW contains the answer and NANSW the length of the *
-* answer. If NANSW .LT. 0 then there has been an error. *
-* Read typed answer from the same line *
-* *
-#if defined(CERNLIB_NEWLIB)
-* *
-* Read answer from NEWLIB buffer if present rather than from terminal *
-* If the NEWLIB buffer contains an '~' , a shell command is created of *
-* the remaining part *
-* *
-* Calls Assembler routines $PUTGET and $PUT *
-* *
-#endif
-* *
-* INPUT: *
-* PSTR (C) prompt string *
-* LPSTR (I) length of prompt string *
-* MAXANS (I) max length of answer *
-* *
-* OUTPUT: *
-* ANSW (C) answer *
-* NANSW (I) length of answer, if .LT. 0 then error *
-* *
-************************************************************************
-* *
- CHARACTER*(*) PSTR, ANSW
- INTEGER LPSTR, MAXANS, NANSW
-#if defined(CERNLIB_NEWLIB)
- CHARACTER*80 VARIABLE, RESULT
- INTEGER IRET
- VARIABLE='CMZ_ATT'
- CALL VARGET(VARIABLE,RESULT,IRET)
- IF (IRET. EQ. 0) THEN
- IF (RESULT(1:1) .EQ. '1') THEN
- RESULT=' '
-*-- clear attention variable
- VARIABLE='CMZ_ATT'
- RESULT=' '
- CALL VARPUT(VARIABLE,RESULT,IRET)
-*-- stop session due to attention
- PRINT *,'Program stopped due to attention interrupt'
- ANSW='EXIT'
- GOTO 999
- ENDIF
- ENDIF
- VARIABLE='CMZ_CMD'
- CALL VARGET(VARIABLE,RESULT,IRET)
- IF (IRET. EQ. 0) THEN
- ANSW=RESULT
- IF (ANSW .NE. ' ') THEN
- RESULT=' '
- NANSW=LENOCC(ANSW)
- IL=LENOCC(PSTR(1:LPSTR)//' '//ANSW(1:NANSW))
- CALL $PUT(PSTR(1:LPSTR)//' '//ANSW(1:NANSW),IL,IRET)
-*-- position of next NEWLIB command
- I=INDEX(ANSW,'~')
- IF (I.GT.0) THEN
- RESULT='SHELL '//ANSW(I+1:)
- ANSW=ANSW(1:I-1)
- ENDIF
-*-- clear/set input variables
- VARIABLE='PAW_CMD'
- CALL VARPUT(VARIABLE,RESULT,IRET)
- VARIABLE='CMZ_CMD'
- CALL VARPUT(VARIABLE,RESULT,IRET)
- GOTO 999
- ENDIF
- ENDIF
-#endif
-#if defined(CERNLIB_IBMMVS)
- CALL $PUTGET ( PSTR, LPSTR, ANSW, MAXANS, NANSW )
-#endif
-#if defined(CERNLIB_NEWLIB)
-999 RESULT=ANSW
- CALL CLTOU(RESULT)
-*-- is it a CL command, route to NEWLIB
- IF (RESULT(1:3) .EQ. 'CL ')
- + ANSW='N '//RESULT
-*-- remove erroneous prefix
- IF (RESULT(1:4) .EQ. 'CMZ ' .OR. RESULT(1:4) .EQ. 'PAW ')
- + ANSW=RESULT(5:)
- NANSW=LENOCC(ANSW)
-#endif
- RETURN
- END
-#endif
diff --git a/src/packlib/kuip/code_kuip/userid.s b/src/packlib/kuip/code_kuip/userid.s
deleted file mode 100644
index 0eb5521..0000000
--- a/src/packlib/kuip/code_kuip/userid.s
+++ /dev/null
@@ -1,343 +0,0 @@
-*
-* $Id: userid.s,v 1.1.1.1 1996/03/08 15:32:55 mclareni Exp $
-*
-* $Log: userid.s,v $
-* Revision 1.1.1.1 1996/03/08 15:32:55 mclareni
-* Kuip
-*
-*
-#if defined(CERNLIB_IBMMVS)
-*CMZ : 2.05/02 11/05/94 09.50.52 by Alfred Nathaniel
-*-- Author :
-* IBMMVS: GET RACF Userid for Prefix.
-* To compile (GSI): Use SYS1.AMODGEN also !
-* 22/01/91 101231002 MEMBER NAME USERID (X.S) ASSEMBLER
-***********************************************************************
-* *
-* U S E R I D *
-* *
-* Written by Dietrich Moenkemeyer DESY Hamburg *
-* *
-* January 1991 *
-* *
-***********************************************************************
-* *
-* This routine returns the job's or TSO session's RACF userid.
-* If the user is not RACF defined the routine returns with RC=12 *
-* *
-***********************************************************************
-* *
-* Call: CALL USERID(userid) *
-* *
-* Output: userid 8 BYTES RACF userid *
-* *
-* LKED: reentrant, 31bit *
-* *
-* Retcodes: 12 user not RACF defined *
-* or not supplied at RACINIT *
-* 8 inconsistent control block chain *
-* 4 incorrect length of userid (<0 or >8) *
-* *
-***********************************************************************
-* Change activity: *
-***********************************************************************
-*
-*
- MACRO
-&NAME SCHL &RET=,&MODE=
-&NAME L 13,4(13) RELOAD SA-REG
- AIF ('&RET' NE '').RETCODE
- LM 14,12,12(13) RELOAD REGISTERS
- BR 14 RETURN TO CALLER
- MEXIT
-.RETCODE AIF ('&RET'(1,1) EQ '(').REGIST
- AIF (T'&RET NE 'N').ADDRESS
- LA 15,&RET LOAD REG 15 WITH RET CODE
- AGO .FURTHER
-.REGIST AIF ('&RET(1)' EQ '15').FURTHER
- LR 15,&RET(1) LOAD REG 15 WITH SPECIF. REGISTER
- AGO .FURTHER
-.ADDRESS L 15,&RET LOAD REG 15 FROM STORAGE
-.FURTHER LM 0,12,20(13) RESTORE REG 0 TO 12
- L 14,12(13) RESTORE REG 14
- BR 14 RETURN TO CALLER
- MEND
-*
- MACRO
-&NAME ANF &ID,&MODE=REUS,&WKSIZE=0,&SP=0,&BASE=12
- GBLC &DY0ID,&MD
- LCLA &A,&B,&D
- LCLC &E,&F
-&F SETC '&SYSNDX'
-&MD SETC '&MODE'
-* ANF VERSION 2.4 (SUPPORTS PRNT MACRO AND EQUATED WORKSIZE)
-.* DIE VORIGE VERSION HEISST ANF8
- AIF ((T'&WKSIZE NE 'N') AND (T'&WKSIZE NE 'U')).ERROR4
- AIF (T'&SP NE 'N').ERROR5
- AIF (&SP GT 255).ERROR6
- AIF (T'&BASE NE 'N').ERROR7
- AIF ((&BASE GT 12) OR (&BASE LT 4)).ERROR8
- AIF ('&MODE' NE 'REUS').RENT
- AIF ('&ID' EQ '').NULLID
- AIF ('&ID' EQ '*').SPECID
-&D SETA K'&ID
- AIF (&D GT 8).ERROR1
-&A SETA ((K'&ID+4)/4)*4+80
-&E SETC '&ID'
- CNOP 0,4
-&NAME B &A.(0,15) BRANCH AROUND ID AND SA
- DC AL1(&D) LENGTH OF ID
- DC CL&D'&E'
- AGO .CONTA
-.NULLID ANOP
- CNOP 0,4
-&NAME B 80(0,15) BRANCH AROUND SA
- AGO .CONTA
-.SPECID AIF ('&NAME' EQ '').CSECTN
-&E SETC '&NAME'
-&A SETA 1
-.CONTB AIF ('&E'(1,&A) EQ '&E').CONTC
-&A SETA &A+1
- AGO .CONTB
-.CONTC ANOP
- AIF ('&MODE' EQ 'RENT').CONTE
-&B SETA ((&A+4)/4)*4+80
- CNOP 0,4
-&NAME B &B.(0,15) BRANCH AROUND ID AND SA
- DC AL1(&A) LENGTH OF ID
- DC CL&A'&E'
- AGO .CONTA
-.CSECTN AIF ('&SYSECT' EQ '').ERROR2
-&E SETC '&SYSECT'
-&A SETA 1
- AGO .CONTB
-.ERROR2 MNOTE 12,'CSECT NAME NOT SPECIFIED'
- AGO .NULLID
-.CONTA ANOP
-&DY0ID SETC '&SYSNDX'
-SAVE&F DC 19F'0' SAVE AREA
- STM 14,12,12(13) SAVE CALLER'S REGISTER
- LR &BASE,15 LOAD BASE
- LA 3,SAVE&F ADDRESS OF NEW SAVE AREA
- ST 3,8(13) FORWARD CHAIN
- L 3,32(13) RESTORE REG 3
- ST 13,SAVE&F.+4 BACKWARD CHAIN
- LA 13,SAVE&F LOAD SAVE AREA REG
- MEXIT
-.ERROR1 MNOTE 12,'IDENTIFICATION FIELD TOO LONG'
- MEXIT
-.RENT ANOP
- AIF ('&MODE' NE 'RENT').ERROR3
- AIF ('&ID' EQ '').RNULL
- AIF ('&ID' EQ '*').SPECID
-&D SETA K'&ID
- AIF (&D GT 8).ERROR1
-&A SETA ((&D+2)/2)*2+4
-&E SETC '&ID'
-&NAME B &A.(0,15) BRANCH AROUND ID
- DC AL1(&D) LENGTH OF ID
- DC CL&D'&E'
- STM 14,12,12(13) SAVE CALLER'S REGISTER
- AGO .CONTD
-.RNULL ANOP
-&NAME STM 14,12,12(13) SAVE CALLER'S REGISTER
- AGO .CONTD
-.CONTE ANOP
-&B SETA ((&A+2)/2)*2+4
-&NAME B &B.(0,15) BRANCH AROUND ID
- DC AL1(&A) LENGTH OF ID
- DC CL&A'&E'
- STM 14,12,12(13) SAVE CALLER'S REGISTER
-.CONTD ANOP
- LR &BASE,15 LOAD BASE
- CNOP 0,4 ALIGN ON FULL WORD BOUNDARY
- BAL 1,*+8 BRANCH AROUND SUBPOOL AND LENGTH
- DC AL1(&SP) SUBPOOL ID
- DC AL3(&WKSIZE+88) LENGTH VALUE
- L 0,0(0,1) LOAD SP AND LENGTH
- SVC 10 ISSUE GETMAIN SVC
- XC 0(88,1),0(1) CLEAR CHAIN FIELDS AND SAVE AREA
- MVI 8(1),X'FF' INDICATE LAST ON CHAIN
- MVC 12(4,1),*-20 SAVE LENGTH AN SUBPOOL
- MVC 0(4,1),12(13)
- LA 15,FR&F
- ST 15,12(13)
- ST 13,20(1) BACKWARD CHAIN
- LR 15,13 SAVE OLD SAVE AREA POINTER
- LA 13,16(1) LOAD NEW SA REGISTER
- ST 13,8(15) FORWARD CHAIN
- LM 15,1,16(15) RESTORE ALL REGISTER
- B FO&F
-FR&F ST 15,16(13) SAVE RETURN CODE
- LA 0,16 LENGTH OF PREFIX
- L 1,8(13) SAVE OLD SA POINTER
- SR 1,0 POINT TO PREFIX
- MVC 12(4,13),0(1)
- L 14,8(1) LOAD 1-ST CHAIN POINTER
- L 0,12(1) LOAD 1-ST SUBPOOL AND LENGTH
- BALR 10,0
- B 12(10)
- L 14,0(1) LOAD CHAIN POINTER
- L 0,4(1) LOAD SUBPOOL AND LENGTH
- LA 1,0(1) CLEAR HIGH ORDER BYTE
- SVC 10 ISSUE FREEMAIN SVC
- LA 1,0(14) GET CHAIN POINTER
- C 14,36(10) LAST IN CHAIN
- BNZ 4(10) NO, BRANCH
- LM 14,12,12(13) RESTORE REGISTERS AFTER FREEMAIN
- BR 14
- DC X'FF000000'
-FO&F EQU *
- MEXIT
-.ERROR3 MNOTE 12,'MODE=&MODE INVALID'
- MEXIT
-.ERROR4 MNOTE 12,'WKSIZE=&WKSIZE SHOULD BE SELF-DEFINING TERM OR NAME *
- FIELD OF AN ''EQU'''
- MEXIT
-.ERROR5 MNOTE 12,'SP=&SP SHOULD BE A SELF DEFINING TERM'
- MEXIT
-.ERROR6 MNOTE 12,'SP=&SP GREATER 255 SPECIFIED'
- MEXIT
-.ERROR7 MNOTE 12,'BASE=&BASE SHOULD BE A SELF DEFINING TERM'
- MEXIT
-.ERROR8 MNOTE 12,'BASE CAN BE ONLY 4 TO 12'
- MEND
-*
- MACRO
-&NAME BEG &ID,&MODE=REUS,&WKSIZE=0,&SP=0,&BASE=12,&RMODE=24
- GBLC &RMD
-&RMD SETC '&RMODE'
-&NAME CSECT
- AIF ('&RMODE' EQ '24').NOT311
-&NAME RMODE ANY
-&NAME AMODE ANY
-.NOT311 ENTRY &NAME
- USING *,&BASE
- ANF &ID,MODE=&MODE,WKSIZE=&WKSIZE,SP=&SP,BASE=&BASE
- MEND
-*
- MACRO
- REGISTER
-R0 EQU 0
-R1 EQU 1
-R2 EQU 2
-R3 EQU 3
-R4 EQU 4
-R5 EQU 5
-R6 EQU 6
-R7 EQU 7
-R8 EQU 8
-R9 EQU 9
-R10 EQU 10
-R11 EQU 11
-R12 EQU 12
-R13 EQU 13
-R14 EQU 14
-R15 EQU 15
- MEND
- REGISTER
-USERID BEG *,MODE=RENT,RMODE=ANY
-*
- L R9,0(R1) SAVE ADDRESS OF ARGUMENT
-*
-**********************************************************************
-* *
-* BRANCH TO AMODE 31 CODE TO GET THE USERID AND RETURN TO CALLER *
-* *
-**********************************************************************
-*
- LA R15,ABOVE LOAD BRANCH ADDRESS
- L R1,BIT32
- OR R15,R1 SET AMODE 31 BIT
- BASSM R14,R15 BRANCH, SET AMODE AND SAVE OLD AMODE
- SCHL RET=(R15),MODE=RENT
-*
-**********************************************************************
-* *
-* GET RACF USERID IN 31 BIT MODE *
-* *
-**********************************************************************
-*
-ABOVE L R2,CVTPTR
- USING CVTMAP,R2 MAKE CVT ADDESSABLE
-*
-* RACF ACTIVE ?
-*
- SR R1,R1
- ICM R1,7,CVTRAC+1 CHECK ADDRESS OF RCVT IN CVT
- BZ RET12 IF ZERO, RACF IS NOT ACTIVE
- USING RCVT,R1 MAKE RCVT ADDRESSABLE
- TM RCVTSTAT,RCVTRNA IS RACF NOT ACTIVE ?
- BNZ RET12 YES, RACF IS NOT ACTIVE
- DROP R1
-*
-* MAKE ACCESSOR ENVIREMENT ELEMENT (ACEE) AVAILABLE
-*
- L R2,CVTTCBP ADDRESS OF TCBWORDS
- L R2,12(R2) ADDRESS OF CURRENT ASCB
- USING ASCB,R2
-*
- CLC ASCBASCB(4),=CL4'ASCB' THIS AN ASCB REALLY ?
- BNE RET8 NO, BRANCH
-*
- L R2,ASCBASXB ADDRESS OF ADDRESS SPACE EXTENS.BL.
- USING ASXB,R2
- L R2,ASXBSENV ADDRESS OF ACCESSOR ENVIREM. ELEM.
- LTR R2,R2 ADDRESS OF ACEE OK ?
- BZ RET8 NO, BRANCH
- USING ACEE,R2
-*
- CLC ACEEACEE(4),=CL4'ACEE' THIS AN ACEE REALLY ?
- BNE RET8 NO, BRANCH
-*
-* CHECK LENGTH
- XR R1,R1
- ICM R1,B'0001',ACEEUSRL GET USERID LENGHT
- LTR R1,R1 IS IT POSITIVE ?
- BNP RET4 NO, RET4
- CH R1,MAXLEN IS IT TOO LONG ?
- BH RET4 YES, RET4
-*
- CLI ACEEUSRI,C'*' USERID SUPPLIED AT RACINIT ?
- BE RET4 NO, RET4
-*
- MVC 0(8,R9),BLANK
- BCTR R1,0
- EX R1,MOVEUSR USER ID TO CALLERS ARGUMENT
-*
- XR R15,R15
-RET15 BSM R0,R14 RETURN AND RESET TO OLD AMODE
-*
-RET4 LA R15,4
- B RET15
-RET8 LA R15,8
- B RET15
-RET12 LA R15,8
- B RET15
-*
-**********************************************************************
-* *
-* FIXED DATA AREA *
-* *
-**********************************************************************
-*
- DS 0F
-BIT32 DC XL4'80000000'
-MOVEUSR MVC 0(8,R9),ACEEUSRI
-MAXLEN DC H'8'
-BLANK DC CL8' '
- LTORG
-*
-**********************************************************************
-* *
-* D S E C T S *
-* *
-**********************************************************************
-*
- CVT DSECT=YES,LIST=NO
- ICHPRCVT
- IHAACEE
- IHAASCB
- IHAASXB
- END
-#endif
diff --git a/src/packlib/kuip/code_motif/Imakefile b/src/packlib/kuip/code_motif/Imakefile
deleted file mode 100644
index 59f8128..0000000
--- a/src/packlib/kuip/code_motif/Imakefile
+++ /dev/null
@@ -1,25 +0,0 @@
-#define IHaveCDF
-
-MotifDependantMakeVar(SRCS_CDF, kuipmcdf.cdf)
-
-MOTIF_SRCS_C=iconbox.c iconwidget.c kmbfdi.c kmbfil.c kmbmac.c \ @@\
- kmbmdi.c kmbrow.c kmdial.c kmfile.c kmiout.c kmpopp.c \ @@\
- kmumen.c kmutif.c kmutim.c kuwham.c kuxbro.c kuxcmp.c \ @@\
- kuxfse.c kuxgra.c kuxlis.c kuxlishlp.c kuxolt.c kuxpab.c \ @@\
- kuxpal.c kuxpan.c kuxpap.c kuxsc1.c kuxscr.c kuxsel.c \ @@\
- kuxxt.c mkdcmp.c mkdgra.c mkdpan.c mkmpan.c mkuip.c
-
-MotifDependantMakeVar(SRCS_C,$(MOTIF_SRCS_C))
-
-SRCS_C:= $(SRCS_C) kmutil.c
-
-#if defined(CERNLIB_VAXVMS)
-
-SRCS_C := $(SRCS_C) vmsqio.c
-EXTRA_DEFINES=-DCERNLIB_VMS
-
-#endif
-
-PACKAGE_INCLUDES := $(PACKAGE_INCLUDES) MotifIncludes X11Includes
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kuip/code_motif/browbm.h b/src/packlib/kuip/code_motif/browbm.h
deleted file mode 100644
index f6ee54d..0000000
--- a/src/packlib/kuip/code_motif/browbm.h
+++ /dev/null
@@ -1,41 +0,0 @@
-/*
- * $Id: browbm.h,v 1.1.1.1 1996/03/08 15:33:11 mclareni Exp $
- *
- * $Log: browbm.h,v $
- * Revision 1.1.1.1 1996/03/08 15:33:11 mclareni
- * Kuip
- *
- */
-#define browser_width 50
-#define browser_height 50
-static unsigned char browser_bits[] = {
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x7e, 0x00, 0xf8, 0x03, 0x00,
- 0x00, 0x00, 0x7e, 0x00, 0xfc, 0x01, 0x00, 0x00, 0x00, 0x7e, 0x00, 0xfc,
- 0x01, 0x00, 0x00, 0x00, 0x7e, 0x00, 0xfe, 0x00, 0x00, 0x00, 0x00, 0x7e,
- 0x00, 0xfe, 0x00, 0x00, 0x00, 0x00, 0x7e, 0x00, 0x7f, 0x00, 0x00, 0x00,
- 0x00, 0x7e, 0x00, 0x7f, 0x00, 0x00, 0x00, 0x00, 0x7e, 0x80, 0x3f, 0x00,
- 0x00, 0x00, 0x00, 0x7e, 0x80, 0x3f, 0x00, 0x00, 0x00, 0x00, 0x7e, 0xc0,
- 0x1f, 0x00, 0x00, 0x00, 0x00, 0x7e, 0xc0, 0x9f, 0xff, 0x7f, 0x00, 0x00,
- 0x7e, 0xe0, 0x8f, 0xff, 0xff, 0x01, 0x00, 0x7e, 0xf0, 0x87, 0xff, 0xff,
- 0x03, 0x00, 0x7e, 0xf0, 0x87, 0xff, 0xff, 0x07, 0x00, 0x7e, 0xf8, 0x83,
- 0x0f, 0xe0, 0x07, 0x00, 0x7e, 0xf8, 0x83, 0x0f, 0xc0, 0x0f, 0x00, 0x7e,
- 0xfc, 0x81, 0x0f, 0x80, 0x0f, 0x00, 0x7e, 0xfc, 0x81, 0x0f, 0x80, 0x0f,
- 0x00, 0x7e, 0xfe, 0x80, 0x0f, 0x80, 0x0f, 0x00, 0x7e, 0xfe, 0x80, 0x0f,
- 0xc0, 0x0f, 0x00, 0x7e, 0x7f, 0x80, 0x0f, 0xf0, 0x07, 0x00, 0x7e, 0x7f,
- 0x80, 0xff, 0xff, 0x03, 0x00, 0xfe, 0x3f, 0x80, 0xff, 0xff, 0x01, 0x00,
- 0xfe, 0x3f, 0x80, 0xff, 0xff, 0x03, 0x00, 0x7e, 0x7f, 0x80, 0xff, 0xff,
- 0x07, 0x00, 0x7e, 0x7f, 0x80, 0x0f, 0xf0, 0x0f, 0x00, 0x7e, 0xfe, 0x80,
- 0x0f, 0xc0, 0x1f, 0x00, 0x7e, 0xfe, 0x80, 0x0f, 0x80, 0x1f, 0x00, 0x7e,
- 0xfc, 0x81, 0x0f, 0x80, 0x1f, 0x00, 0x7e, 0xfc, 0x81, 0x0f, 0x80, 0x1f,
- 0x00, 0x7e, 0xf8, 0x83, 0x0f, 0xc0, 0x1f, 0x00, 0x7e, 0xf8, 0x83, 0x0f,
- 0xf0, 0x0f, 0x00, 0x7e, 0xf0, 0x87, 0xff, 0xff, 0x07, 0x00, 0x7e, 0xf0,
- 0x87, 0xff, 0xff, 0x03, 0x00, 0x7e, 0xe0, 0x8f, 0xff, 0xff, 0xfd, 0x03,
- 0x7e, 0xe0, 0x0f, 0x00, 0x00, 0xfc, 0x03, 0x7e, 0xc0, 0x1f, 0x00, 0x00,
- 0x1c, 0x03, 0x7e, 0xc0, 0x1f, 0x00, 0x00, 0x1c, 0x03, 0x7e, 0x80, 0x3f,
- 0x00, 0x00, 0xfc, 0x03, 0x7e, 0x80, 0x3f, 0x00, 0x00, 0xfc, 0x00, 0x7e,
- 0x00, 0x7f, 0x00, 0x00, 0xdc, 0x01, 0x7e, 0x00, 0x7f, 0x00, 0x00, 0xdc,
- 0x01, 0x7e, 0x00, 0xfe, 0x00, 0x00, 0x9c, 0x03, 0x7e, 0x00, 0xfe, 0x00,
- 0x00, 0x9c, 0x03, 0x7e, 0x00, 0xfc, 0x01, 0x00, 0x1c, 0x03, 0x7e, 0x00,
- 0xfc, 0x01, 0x00, 0x00, 0x00, 0x7e, 0x00, 0xf8, 0x03, 0x00, 0x00, 0x00,
- 0x7e, 0x00, 0xf8, 0x03, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00};
diff --git a/src/packlib/kuip/code_motif/browh2.h b/src/packlib/kuip/code_motif/browh2.h
deleted file mode 100644
index 40d45f4..0000000
--- a/src/packlib/kuip/code_motif/browh2.h
+++ /dev/null
@@ -1,78 +0,0 @@
-/*
- * $Id: browh2.h,v 1.1.1.1 1996/03/08 15:33:11 mclareni Exp $
- *
- * $Log: browh2.h,v $
- * Revision 1.1.1.1 1996/03/08 15:33:11 mclareni
- * Kuip
- *
- */
-#ifndef _brow_h2
-#define _brow_h2
-
-/* Fortran routines and common blocks called from C and/or vice versa */
-#ifdef QX_SC
-#define List_addp_item F77_NAME(list_addp_item,LIST_ADDP_ITEM)
-#define List_addc_item F77_NAME(list_addc_item,LIST_ADDC_ITEM)
-#define list_delete_item list_delete_item_
-#define list_refresh list_refresh_
-#endif /* QX_SC */
-
-
-#define FILE_LIST 1
-#define DIR_LIST 2
-#define MAXITEMS 50 /* max number of items in a popup menu */
-#define MAXLEVEL 5 /* max number of levels in a popup menu */
-#define MAX_FILE_BROWSER 5
-
-
-/* type definitions */
-
-typedef struct {
- Widget widget; /* file browser widget itself */
- Widget dirlist; /* the file browser's dirlist */
- Widget file_popup; /* popup menu for file list */
- Widget dir_popup; /* popup menu for dir list */
- Widget pref_dialog; /* preferences dialog */
- MenuCbStruct *pref_menu; /* menu callback struct used by prefDialog */
- char cd[MAXSTR]; /* CWD of file browser */
- int hili_left; /* left highlight position of pathText */
- int hili_right; /* right highlight position of pathText */
- int titles; /* list titles on/off */
- int order; /* ordering (grouping) of items on/off */
- char filter[MAX_stringl]; /* filtering of items */
- Boolean focus; /* focus flag */
- Boolean reset; /* reset browser (update) flag */
- Boolean path_edit; /* true if pathText is being edited */
-} BrowserStruct;
-
-typedef struct {
- int command_num;
- int flag;
- Widget browser;
- int panel;
- char pathname[MAX_string];
- char item[MAX_string];
- char command[MAX_string];
- BrAction *bract;
- BrAction *bract_next; /* for next item (toggle case) */
- KmObject *kmobj;
- } poptag_str; /* tag structure for km_build_popup */
-
-
-/* global data */
-/* #define Extern must be in one routine (done in mkuip) to allocate space */
-#ifndef Extern
-# define Extern extern
-#endif
-Extern BrowserStruct fbrowser[MAX_FILE_BROWSER];
-Extern Widget dirList;
-Extern Widget pref_dialog;
-Extern MenuCbStruct *pref_menu;
-Extern char browser_dir[MAXSTR];
-Extern int titles;
-Extern int order;
-Extern char browser_filter[MAX_stringl];
-Extern Boolean browser_focus, browser_reset;
-
-#endif /* _brow_h2 */
-
diff --git a/src/packlib/kuip/code_motif/icbox.h b/src/packlib/kuip/code_motif/icbox.h
deleted file mode 100644
index 19ee98d..0000000
--- a/src/packlib/kuip/code_motif/icbox.h
+++ /dev/null
@@ -1,282 +0,0 @@
-/*
- * $Id: icbox.h,v 1.1.1.1 1996/03/08 15:33:11 mclareni Exp $
- *
- * $Log: icbox.h,v $
- * Revision 1.1.1.1 1996/03/08 15:33:11 mclareni
- * Kuip
- *
- */
-
-/* IconBox.h */
-/***********************************************************************
- * *
- * Header file for the IconBox (convenience) widget. *
- * *
- * The IconBox widget facilitates the building of a table of which *
- * the items consist of an icon and a text label. *
- * All user callable routines are denoted by the string: *
- * "user callable". *
- * *
- * IconBox is based on ideas by Thomas Berlage. *
- * *
- ***********************************************************************/
-/***********************************************************************
- * *
- * Copyright 1992 Alphonse A. Rademakers *
- * *
- * Permission to use, copy, modify, distribute, and sell this software *
- * and its documentation for any purpose is hereby granted without *
- * fee, provided that the above copyright notice appears in all copies *
- * and that both that copyright notice and this permission notice *
- * appear in supporting documentation, and that the name of *
- * Alphonse A. Rademakers or CERN not be used in advertising or *
- * publicity pertaining to distribution of the software without *
- * specific, written prior permission. Alphonse A. Rademakers and *
- * CERN make no representations about the suitability of this software *
- * for any purpose. It is provided "as is" without express or implied *
- * warranty. *
- * *
- * Alphonse A. Rademakers and CERN disclaim all warranties with *
- * regard to this software, including all implied warranties of *
- * merchantability and fitness, in no event shall *
- * Alphonse A. Rademakers or CERN be liable for any special, indirect *
- * or consequential damages or any damages whatsoever resulting from *
- * loss of use, data or profits, whether in an action of contract, *
- * negligence or other tortious action, arising out of or in *
- * connection with the use or performance of this software. *
- * *
- * Author: *
- * Alphonse A. Rademakers *
- * CN/AS Division *
- * CERN, European Organization for Nuclear Research *
- * 1123 Geneve, Switzerland *
- * *
- * rdm at cernvm.cern.ch *
- * *
- ***********************************************************************/
-
-#ifndef _IconBox_h
-#define _IconBox_h
-
-/* new resource fields */
-
-#define XmNiconBitmap "iconBitmap"
-#define XmNiconSmallBitmap "iconSmallBitmap"
-/* #define XmNiconMask "iconMask" */
-#define XmNiconSmallMask "iconSmallMask"
-#define XmNiconForeground "iconForeground"
-#define XmNiconBackground "iconBackground"
-#define XmNiconLabelForeground "iconLabelForeground"
-#define XmNiconLabelBackground "iconLabelBackground"
-#define XmNiconWidth "iconWidth"
-#define XmNiconHeight "iconHeight"
-#define XmNiconSmallWidth "iconSmallWidth"
-#define XmNiconSmallHeight "iconSmallHeight"
-#define XmNiconHSpacing "iconHSpacing"
-#define XmNiconVSpacing "iconVSpacing"
-#define XmNiconSmallHSpacing "iconSmallHSpacing"
-#define XmNiconSmallVSpacing "iconSmallVSpacing"
-#define XmNiconNoHSpacing "iconNoHSpacing"
-#define XmNiconNoVSpacing "iconNoVSpacing"
-#define XmNiconType "iconType"
-#define XmNshadowOffset "shadowOffset"
-#define XmNshadowColor "shadowColor"
-#define XmNzoomEffect "zoomEffect"
-#define XmNzoomSpeed "zoomSpeed"
-#ifndef XmNdoubleClickInterval
-#define XmNdoubleClickInterval "doubleClickInterval"
-#endif
-
-#define XmCIconBitmap "IconBitmap"
-#define XmCIconSmallBitmap "IconSmallBitmap"
-/* #define XmCIconMask "IconMask" */
-#define XmCIconSmallMask "IconSmallMask"
-#define XmCIconForeground "IconForeground"
-#define XmCIconBackground "IconBackground"
-#define XmCIconLabelForeground "IconLabelForeground"
-#define XmCIconLabelBackground "IconLabelBackground"
-#define XmCIconWidth "IconWidth"
-#define XmCIconHeight "IconHeight"
-#define XmCIconSmallWidth "IconSmallWidth"
-#define XmCIconSmallHeight "IconSmallHeight"
-#define XmCIconHSpacing "IconHSpacing"
-#define XmCIconVSpacing "IconVSpacing"
-#define XmCIconSmallHSpacing "IconSmallHSpacing"
-#define XmCIconSmallVSpacing "IconSmallVSpacing"
-#define XmCIconNoHSpacing "IconNoHSpacing"
-#define XmCIconNoVSpacing "IconNoVSpacing"
-#define XmCIconType "IconType"
-#define XmCShadowOffset "ShadowOffset"
-#define XmCShadowColor "ShadowColor"
-#define XmCZoomEffect "ZoomEffect"
-#define XmCZoomSpeed "ZoomSpeed"
-#ifndef XmCDoubleClickInterval
-#define XmCDoubleClickInterval "DoubleClickInterval"
-#endif
-
-#define IconBoxBIG_ICON 1
-#define IconBoxSMALL_ICON 2
-#define IconBoxNO_ICON 3
-#define IconBoxTITLES 4 /* list with small icons and full titles */
-
-/* definition of callback structure */
-typedef struct {
- int reason;
- XEvent *event;
- XmStringTable selected_items;
- int selected_item_count;
- int *selected_item_positions;
- char **selected_item_class;
- int selection_type;
-} IconBoxCallbackStruct;
-
-#if defined(__cplusplus) || defined(c_plusplus)
-extern "C" {
-#endif
-
-/* user callable routines */
-extern C_PROTO_4(Widget CreateIconBox,
- Widget parent,
- char *name,
- Arg add_args[],
- Cardinal num_add_args);
-extern C_PROTO_4(void IconBoxAddCallback,
- Widget widget,
- char *cb_type,
- XtCallbackProc cb,
- caddr_t client_data);
-extern C_PROTO_5(void IconBoxAddItem,
- Widget widget,
- XmString item,
- char *class,
- int position,
- Boolean refresh);
-extern C_PROTO_9(void IconBoxAddItemPixmap,
- Widget widget,
- XmString item,
- char *class,
- Pixmap big_pix,
- Pixmap hi_big_pix,
- Pixmap small_pix,
- Pixmap hi_small_pix,
- int position,
- Boolean refresh);
-extern C_PROTO_13(void IconBoxAddItemBitmapData,
- Widget widget,
- XmString item,
- char *class,
- char *name,
- char *bits,
- int width,
- int height,
- char *sname,
- char *sbits,
- int swidth,
- int sheight,
- int position,
- Boolean refresh);
-extern C_PROTO_3(void IconBoxDeleteItem,
- Widget widget,
- XmString item,
- Boolean refresh);
-extern C_PROTO_2(void IconBoxDeleteAllItems,
- Widget widget,
- Boolean refresh);
-extern C_PROTO_1(void IconBoxRefresh,
- Widget widget);
-extern C_PROTO_2(Boolean IconBoxItemExists,
- Widget widget,
- XmString item);
-extern C_PROTO_2(Boolean IconBoxDeckExists,
- Widget widget,
- XmString item);
-extern C_PROTO_3(void IconBoxGetItems,
- Widget widget,
- XmString **items,
- int *nitems);
-extern C_PROTO_3(void IconBoxGetSelectedItems,
- Widget widget,
- XmString **items,
- int *nitems);
-extern C_PROTO_2(int IconBoxGetLastSelectedItem,
- Widget widget,
- XmString *item);
-extern C_PROTO_8(int IconBoxGetItemAttr,
- Widget widget,
- XmString item,
- int *x,
- int *y,
- int *width,
- int *height,
- char **class,
- Boolean *selected);
-extern C_PROTO_4(void IconBoxSelectItems,
- Widget widget,
- XmString *items,
- int nitems,
- Boolean notify);
-extern C_PROTO_5(void IconBoxSelectDecks,
- Widget widget,
- XmString *decks,
- int ndecks,
- Boolean refresh,
- Boolean notify);
-extern C_PROTO_3(void IconBoxGetSelectedPos,
- Widget widget,
- int **pos,
- int *npos);
-extern C_PROTO_4(void IconBoxSelectPos,
- Widget widget,
- int *pos,
- int npos,
- Boolean notify);
-extern C_PROTO_3(void IconBoxSelectAllItems,
- Widget widget,
- Boolean refresh,
- Boolean notify);
-extern C_PROTO_2(void IconBoxDeselectAllItems,
- Widget widget,
- Boolean refresh);
-extern C_PROTO_1(int IconBoxGetPos,
- Widget widget);
-extern C_PROTO_2(void IconBoxSetPos,
- Widget widget,
- int value);
-extern C_PROTO_2(void IconBoxSetItem,
- Widget widget,
- XmString item);
-extern C_PROTO_1(int IconBoxGetIconType,
- Widget widget);
-extern C_PROTO_2(void IconBoxSetIconType,
- Widget widget,
- int type);
-extern C_PROTO_7(void IconBoxChangeItemPixmap,
- Widget widget,
- XmString item,
- Pixmap big_pix,
- Pixmap hi_big_pix,
- Pixmap small_pix,
- Pixmap hi_small_pix,
- Boolean refresh);
-extern C_PROTO_7(void IconBoxChangePosPixmap,
- Widget widget,
- int position,
- Pixmap big_pix,
- Pixmap hi_big_pix,
- Pixmap small_pix,
- Pixmap hi_small_pix,
- Boolean refresh);
-extern C_PROTO_6(void IconBoxZoom,
- Widget widget,
- int x,
- int y,
- int width,
- int height,
- Boolean expand);
-
-#if defined(__cplusplus) || defined(c_plusplus)
-} /* Close scope of 'extern "C"' declaration which encloses file. */
-#endif
-
-#endif /* _IconBox_h */
-
diff --git a/src/packlib/kuip/code_motif/icboxp.h b/src/packlib/kuip/code_motif/icboxp.h
deleted file mode 100644
index 1777fe2..0000000
--- a/src/packlib/kuip/code_motif/icboxp.h
+++ /dev/null
@@ -1,179 +0,0 @@
-/*
- * $Id: icboxp.h,v 1.1.1.1 1996/03/08 15:33:11 mclareni Exp $
- *
- * $Log: icboxp.h,v $
- * Revision 1.1.1.1 1996/03/08 15:33:11 mclareni
- * Kuip
- *
- */
-/* IconBoxP.h */
-/***********************************************************************
- * *
- * Private header file for the IconBox (convenience) widget. *
- * *
- * The IconBox widget facilitates the building of a table of which *
- * the items consist of an icon and a text label. *
- * All user callable routines are denoted by the string: *
- * "user callable". *
- * *
- * IconBox is based on ideas by Thomas Berlage. *
- * *
- ***********************************************************************/
-/***********************************************************************
- * *
- * Copyright 1992 Alphonse A. Rademakers *
- * *
- * Permission to use, copy, modify, distribute, and sell this software *
- * and its documentation for any purpose is hereby granted without *
- * fee, provided that the above copyright notice appears in all copies *
- * and that both that copyright notice and this permission notice *
- * appear in supporting documentation, and that the name of *
- * Alphonse A. Rademakers or CERN not be used in advertising or *
- * publicity pertaining to distribution of the software without *
- * specific, written prior permission. Alphonse A. Rademakers and *
- * CERN make no representations about the suitability of this software *
- * for any purpose. It is provided "as is" without express or implied *
- * warranty. *
- * *
- * Alphonse A. Rademakers and CERN disclaim all warranties with *
- * regard to this software, including all implied warranties of *
- * merchantability and fitness, in no event shall *
- * Alphonse A. Rademakers or CERN be liable for any special, indirect *
- * or consequential damages or any damages whatsoever resulting from *
- * loss of use, data or profits, whether in an action of contract, *
- * negligence or other tortious action, arising out of or in *
- * connection with the use or performance of this software. *
- * *
- * Author: *
- * Alphonse A. Rademakers *
- * CN/AS Division *
- * CERN, European Organization for Nuclear Research *
- * 1123 Geneve, Switzerland *
- * *
- * rdm at cernvm.cern.ch *
- * *
- ***********************************************************************/
-
-#ifndef _IconBoxP_h
-#define _IconBoxP_h
-
-#include <stdio.h>
-#include <string.h>
-#include <ctype.h>
-#include <time.h>
-#include <X11/StringDefs.h>
-#include <X11/Intrinsic.h>
-#include <X11/cursorfont.h>
-#include <Xm/Xm.h>
-#include <Xm/DrawingA.h>
-#include <Xm/ScrollBar.h>
-#include <Xm/ScrolledW.h>
-
-/* #include "IconBox.h" */
-#include "icbox.h"
-
-
-/************************ Record for each icon ************************/
-
-typedef struct IconRec IconRec;
-typedef struct IconRec {
- Position x, y; /* left upper edge of icon */
- Position x_off, y_off; /* offset to center of big and small */
- Position x_soff, y_soff; /* pixmaps in the respective max. bitmaps */
- Dimension pix_w, pix_h; /* width and height of the big pixmap */
- Dimension spix_w, spix_h; /* w. and h. of the small pixmap */
- int string_left; /* how much strings extends to left */
- int id; /* icon id */
- Boolean selected; /* is icon selected (high lighted)? */
- XmString label; /* label string */
- String class; /* for selection of pixmap */
- String pix_name; /* name of icon bitmap */
- String pix_sname; /* name of small icon bitmap */
- Pixmap pix; /* icon pixmap */
- Pixmap hi_pix; /* highlighted icon pixmap */
- Pixmap spix; /* small icon pixmap */
- Pixmap hi_spix; /* highlighted small icon pixmap */
- String mask_name; /* name of mask bitmap */
- String mask_sname; /* name of small mask bitmap */
- Pixmap mask; /* mask bitmap */
- Pixmap smask; /* small mask bitmap */
- Pixel foreground; /* foreground for icon pixmap */
- Pixel background; /* background for icon pixmap */
- Pixel label_fg; /* label foreground color */
- Pixel label_bg; /* label background color */
- IconRec *link; /* link to next icon */
-} *IconRecPtr;
-
-/************************ Icon box data record ************************/
-
-typedef struct {
- Dimension width, height; /* size of box */
- Dimension virt_height; /* height of box with all icons */
- Dimension icon_width; /* width of current icon type */
- Dimension icon_height; /* height of current icon type */
- Dimension icon_big_width; /* width of big icon */
- Dimension icon_big_height; /* height of big icon */
- Dimension icon_small_width; /* width of small icon */
- Dimension icon_small_height; /* height of small icon */
- Dimension min_big_width; /* min width of big icon */
- Dimension min_big_height; /* min height of big icon */
- Dimension min_small_width; /* min width of small icon */
- Dimension min_small_height; /* min height of small icon */
- int string_height; /* current height of string box */
- int string_bheight; /* height of string box with big icon */
- int icon_hspacing; /* current hor. spacing between icons */
- int icon_vspacing; /* current ver. spacing between icons */
- int icon_bhspacing; /* horz. spacing between big icons */
- int icon_bvspacing; /* vert. spacing between big icons */
- int icon_shspacing; /* horz. spacing between small icons */
- int icon_svspacing; /* vert. spacing between small icons */
- int icon_nhspacing; /* horz. spacing between no icons */
- int icon_nvspacing; /* vert. spacing between no icons */
- int ilsp; /* icon-label spacing (big icon) */
- int silsp; /* icon-label spacing (small icon) */
- int icon_type; /* either big, small or no icon */
- int shadow_off; /* offset of shadow effect */
- int columns; /* no of icon columns */
- int top; /* pixel at top of window */
- IconRec *icons; /* first icon in the list of icons */
- IconRec *last_icon; /* last icon in list of icons */
- int no_icons; /* no of icons in list */
- int last_id; /* id of last icon */
- Pixel shadow_color; /* color for shadow effect */
- Pixel background; /* pixmap background */
- Boolean exposed; /* is the window exposed */
- Boolean redraw_all; /* need to redraw the whole window */
- Boolean scrolled; /* has the window just been scrolled */
- GC draw_gc; /* to draw into backing pixmap */
- GC xor_gc; /* to draw rubberband box */
- GC normal_gc; /* to copy to screen */
- Pixmap back; /* background storage */
- Pixmap box_icon; /* big icon */
- Pixmap box_hi_icon; /* big hi-lighted icon */
- Pixmap box_sicon; /* small icon */
- Pixmap box_hi_sicon; /* small hi-lighted icon */
- XmFontList fontlist; /* for strings */
- int dc_interval; /* double-click interval */
- Boolean rubber; /* drawing the rubberband box */
- int x_off, y_off; /* mouse offset when drag-moving */
- int x_rubs, y_rubs; /* start position of rubberband box */
- int x_rub, y_rub; /* top left pos of rubberband box */
- Dimension w_rub, h_rub; /* width and height of rubberband box */
- Boolean zoom_effect; /* making zoom effect or not */
- int zoom_speed; /* speed of zoom effect */
- int hit; /* index of icon currently pointed at */
- Widget area; /* drawing area in the scrollwindow */
- Widget scrollbar; /* scrollbar of the scrollwindow */
- XtCallbackProc default_cb; /* default action callback */
- caddr_t default_cd; /* default action client data */
- XtCallbackProc single_cb; /* single selection callback */
- caddr_t single_cd; /* single selection client data */
- XtCallbackProc multiple_cb; /* multiple selection callback */
- caddr_t multiple_cd; /* multiple selection clinet data */
- XtCallbackProc extended_cb; /* extended selection callback */
- caddr_t extended_cd; /* extended selection client data */
-} BoxRec, *BoxRecPtr;
-
-
-#endif /* _IconBoxP_h */
-
diff --git a/src/packlib/kuip/code_motif/icdbm.h b/src/packlib/kuip/code_motif/icdbm.h
deleted file mode 100644
index 1788e52..0000000
--- a/src/packlib/kuip/code_motif/icdbm.h
+++ /dev/null
@@ -1,21 +0,0 @@
-/*
- * $Id: icdbm.h,v 1.1.1.1 1996/03/08 15:33:11 mclareni Exp $
- *
- * $Log: icdbm.h,v $
- * Revision 1.1.1.1 1996/03/08 15:33:11 mclareni
- * Kuip
- *
- */
-/* default_icon.bm */
-#define default_icon_width 22
-#define default_icon_height 30
-static unsigned char default_icon_bits[] = {
- 0xff, 0xff, 0x3f, 0x01, 0x00, 0x20, 0x01, 0x00, 0x20, 0x01, 0x00, 0x20,
- 0xf9, 0x79, 0x20, 0x01, 0x00, 0x20, 0x59, 0x1f, 0x20, 0x01, 0x00, 0x20,
- 0x01, 0x00, 0x20, 0x99, 0x9b, 0x20, 0x01, 0x00, 0x20, 0x79, 0xb7, 0x23,
- 0x01, 0x00, 0x20, 0x01, 0x00, 0x20, 0xb9, 0x6f, 0x20, 0x01, 0x00, 0x20,
- 0xf9, 0x3b, 0x26, 0x01, 0x00, 0x20, 0xd9, 0xcf, 0x20, 0x01, 0x00, 0x20,
- 0x01, 0x00, 0x20, 0x39, 0x6f, 0x21, 0x01, 0x00, 0x20, 0xf9, 0xfe, 0x20,
- 0x01, 0x00, 0x20, 0xf9, 0xf7, 0x22, 0x01, 0x00, 0x20, 0x01, 0x00, 0x20,
- 0x01, 0x00, 0x20, 0xff, 0xff, 0x3f};
-
diff --git a/src/packlib/kuip/code_motif/iconbox.c b/src/packlib/kuip/code_motif/iconbox.c
deleted file mode 100644
index bc53bdb..0000000
--- a/src/packlib/kuip/code_motif/iconbox.c
+++ /dev/null
@@ -1,3197 +0,0 @@
-/*
- * $Id: iconbox.c,v 1.1.1.1 1996/03/08 15:33:09 mclareni Exp $
- *
- * $Log: iconbox.c,v $
- * Revision 1.1.1.1 1996/03/08 15:33:09 mclareni
- * Kuip
- *
- */
-/*CMZ : 2.05/14 25/07/94 11.45.22 by Unknown*/
-/*-- Author : Nicole Cremel 27/05/92*/
-/*
- * IconBox.c
- */
-
-#include "kuip/kuip.h"
-
-/***********************************************************************
- * *
- * IconBox (convenience) widget. *
- * *
- * The IconBox widget facilitates the building of a table of which *
- * the items consist of an icon and a text label. *
- * All user callable routines are denoted by the string: *
- * "user callable". *
- * *
- * IconBox is based on ideas by Thomas Berlage as discussed in his *
- * book OSF/Motif Concepts and Programming, ISBN 0-201-55792-4. *
- * *
- ***********************************************************************/
-/***********************************************************************
- * *
- * Copyright 1992 Alphonse A. Rademakers *
- * *
- * Permission to use, copy, modify, distribute, and sell this software *
- * and its documentation for any purpose is hereby granted without *
- * fee, provided that the above copyright notice appears in all copies *
- * and that both that copyright notice and this permission notice *
- * appear in supporting documentation, and that the name of *
- * Alphonse A. Rademakers or CERN not be used in advertising or *
- * publicity pertaining to distribution of the software without *
- * specific, written prior permission. Alphonse A. Rademakers and *
- * CERN make no representations about the suitability of this software *
- * for any purpose. It is provided "as is" without express or implied *
- * warranty. *
- * *
- * Alphonse A. Rademakers and CERN disclaim all warranties with *
- * regard to this software, including all implied warranties of *
- * merchantability and fitness, in no event shall *
- * Alphonse A. Rademakers or CERN be liable for any special, indirect *
- * or consequential damages or any damages whatsoever resulting from *
- * loss of use, data or profits, whether in an action of contract, *
- * negligence or other tortious action, arising out of or in *
- * connection with the use or performance of this software. *
- * *
- * Author: *
- * Alphonse A. Rademakers *
- * CN/AS Division *
- * CERN, European Organization for Nuclear Research *
- * 1123 Geneve, Switzerland *
- * *
- * rdm at cernvm.cern.ch *
- * *
- ***********************************************************************/
-
-/* #include "IconBoxP.h" */
-#include "icboxp.h"
-
-/* #include "default_icon.bm" */
-#include "icdbm.h"
-/* #include "default_sicon.bm" */
-#include "icsdbm.h"
-
-#ifndef min
-#define min(a,b) (((a) < (b)) ? (a) : (b))
-#endif
-#ifndef max
-#define max(a,b) (((a) > (b)) ? (a) : (b))
-#endif
-
-#define BOX_CLASS_NAME "IconBox"
-
-/********************* Resource list for icon record ******************/
-
-static XtResource icon_resources [] = {
- { XmNiconBitmap, XmCIconBitmap, XmRString, sizeof (String),
- XtOffset (IconRecPtr, pix_name), XmRString, "default_icon"},
- { XmNiconMask, XmCIconMask, XmRString, sizeof (String),
- XtOffset (IconRecPtr, mask_name), XmRString, "default_mask"},
- { XmNiconSmallBitmap, XmCIconSmallBitmap, XmRString, sizeof (String),
- XtOffset (IconRecPtr, pix_sname), XmRString, "default_sicon"},
- { XmNiconSmallMask, XmCIconSmallMask, XmRString, sizeof (String),
- XtOffset (IconRecPtr, mask_sname), XmRString, "default_smask"},
- { XmNiconForeground, XmCIconForeground, XmRPixel, sizeof (Pixel),
- XtOffset (IconRecPtr, foreground), XmRString, "black"},
- { XmNiconBackground, XmCIconBackground, XmRPixel, sizeof (Pixel),
- XtOffset (IconRecPtr, background), XmRString, "white"},
- { XmNiconLabelForeground, XmCIconLabelForeground, XmRPixel, sizeof (Pixel),
- XtOffset (IconRecPtr, label_fg), XmRString, "black"},
- { XmNiconLabelBackground, XmCIconLabelBackground, XmRPixel, sizeof (Pixel),
- XtOffset (IconRecPtr, label_bg), XmRString, "white"},
-};
-
-/******************* Resource list for box record *********************/
-
-static XtResource box_resources[] = {
- { XmNiconWidth, XmCIconWidth, XmRDimension, sizeof (Dimension),
- XtOffset (BoxRecPtr, min_big_width), XmRImmediate, (caddr_t) 40},
- { XmNiconHeight, XmCIconHeight, XmRDimension, sizeof (Dimension),
- XtOffset (BoxRecPtr, min_big_height), XmRImmediate, (caddr_t) 40},
- { XmNiconSmallWidth, XmCIconSmallWidth, XmRDimension, sizeof (Dimension),
- XtOffset (BoxRecPtr, min_small_width), XmRImmediate, (caddr_t) 20},
- { XmNiconSmallHeight, XmCIconSmallHeight, XmRDimension, sizeof (Dimension),
- XtOffset (BoxRecPtr, min_small_height), XmRImmediate, (caddr_t) 20},
- { XmNiconHSpacing, XmCIconHSpacing, XmRInt, sizeof (int),
- XtOffset (BoxRecPtr, icon_bhspacing), XmRImmediate, (caddr_t) 40},
- { XmNiconVSpacing, XmCIconVSpacing, XmRInt, sizeof (int),
- XtOffset (BoxRecPtr, icon_bvspacing), XmRImmediate, (caddr_t) 10},
- { XmNiconSmallHSpacing, XmCIconSmallHSpacing, XmRInt, sizeof (int),
- XtOffset (BoxRecPtr, icon_shspacing), XmRImmediate, (caddr_t) 20},
- { XmNiconSmallVSpacing, XmCIconSmallVSpacing, XmRInt, sizeof (int),
- XtOffset (BoxRecPtr, icon_svspacing), XmRImmediate, (caddr_t) 10},
- { XmNiconNoHSpacing, XmCIconNoHSpacing, XmRInt, sizeof (int),
- XtOffset (BoxRecPtr, icon_nhspacing), XmRImmediate, (caddr_t) 20},
- { XmNiconNoVSpacing, XmCIconNoVSpacing, XmRInt, sizeof (int),
- XtOffset (BoxRecPtr, icon_nvspacing), XmRImmediate, (caddr_t) 10},
- { XmNiconType, XmCIconType, XmRInt, sizeof (int),
- XtOffset (BoxRecPtr, icon_type), XmRImmediate, (caddr_t) IconBoxBIG_ICON},
- { XmNshadowOffset, XmCShadowOffset, XmRInt, sizeof (int),
- XtOffset (BoxRecPtr, shadow_off), XmRImmediate, (caddr_t) 3},
- { XmNcolumns, XmCColumns, XmRInt, sizeof (int),
- XtOffset (BoxRecPtr, columns), XmRImmediate, (caddr_t) 5},
- { XmNshadowColor, XmCShadowColor, XmRPixel, sizeof (Pixel),
- XtOffset (BoxRecPtr, shadow_color), XmRString, "gray50"},
- { XmNfontList, XmCFontList, XmRFontList, sizeof (XmFontList),
- XtOffset (BoxRecPtr, fontlist), XmRString, "fixed"},
- { XmNzoomEffect, XmCZoomEffect, XmRBoolean, sizeof (Boolean),
- XtOffset (BoxRecPtr, zoom_effect), XmRImmediate, (caddr_t) True},
- { XmNzoomSpeed, XmCZoomSpeed, XmRInt, sizeof (int),
- XtOffset (BoxRecPtr, zoom_speed), XmRImmediate, (caddr_t) 10},
- { XmNdoubleClickInterval, XmCDoubleClickInterval, XmRInt, sizeof (int),
- XtOffset (BoxRecPtr, dc_interval), XmRImmediate, (caddr_t) 250},
-};
-
-
-/***********************************************************************
- * *
- * Forward declarations of local functions. *
- * *
- ***********************************************************************/
-
-static C_PROTO_3(void ExposeBox,
- Widget widget,
- BoxRec *rec,
- XmDrawingAreaCallbackStruct *call_data);
-static C_PROTO_3(void HandleButtons,
- Widget widget,
- BoxRec *rec,
- XmDrawingAreaCallbackStruct *call_data);
-static C_PROTO_3(void HandleGraphicsExposures,
- Widget widget,
- BoxRec *rec,
- XEvent *ev);
-static C_PROTO_3(void HandleMove,
- Widget widget,
- BoxRec *rec,
- XEvent *ev);
-static C_PROTO_3(void HandleResize,
- Widget widget,
- BoxRec *rec,
- XmDrawingAreaCallbackStruct *call_data);
-static C_PROTO_3(void DestroyIconBox,
- Widget widget,
- BoxRec *rec,
- caddr_t call_data);
-static C_PROTO_3(void ScrollBarMoved,
- Widget widget,
- BoxRec *rec,
- XmScrollBarCallbackStruct *call_data);
-static C_PROTO_1(void SendExpose,
- Widget widget);
-static C_PROTO_6(void RedrawRegion,
- Widget widget,
- BoxRec *rec,
- int x,
- int y,
- Dimension width,
- Dimension height);
-static C_PROTO_1(void UpdatePositions,
- BoxRec *rec);
-static C_PROTO_1(void RepositionIcons,
- BoxRec *rec);
-static C_PROTO_6(void CenterPixmap,
- BoxRec *rec,
- IconRec *icon,
- Cardinal big_width,
- Cardinal big_height,
- Cardinal small_width,
- Cardinal small_height);
-static C_PROTO_3(void RecalculateIconOffset,
- BoxRec *rec,
- Boolean recalc_offset,
- Boolean recalc_soffset);
-
-
-/***********************************************************************
- * *
- * Initialize one icon record. *
- * *
- ***********************************************************************/
-static void InitIcon (widget, rec, icon, item, class, position)
- Widget widget;
- BoxRec *rec;
- IconRec *icon;
- XmString item;
- char *class;
- int position;
-{
- int pos;
- IconRec *tmp;
- Boolean new_pixmap;
- Display *display;
-
- rec->no_icons++;
- rec->last_id++;
- icon->id = rec->last_id;
-
- /* get resources for icon record */
- XtGetSubresources (widget, icon, "name", class,
- icon_resources, XtNumber(icon_resources), NULL, 0);
-
- /*
- * make copies of the pix_name, pix_sname, pix_mask and pix_smask so
- * we can modify its values without disturbing the resource list
- */
- icon->pix_name = XtNewString(icon->pix_name);
- icon->mask_name = XtNewString(icon->mask_name);
- icon->pix_sname = XtNewString(icon->pix_sname);
- icon->mask_sname = XtNewString(icon->mask_sname);
-
- /* set label and its offset to the left of icon */
- icon->label = XmStringCopy(item);
- icon->string_left = ((int) XmStringWidth (rec->fontlist, icon->label) -
- (int) rec->icon_width + 1) / 2;
- if (icon->string_left < 0) icon->string_left = 0;
- icon->class = XtMalloc(strlen(class) + 1);
- strcpy(icon->class, class);
-
- /* calculate initial position */
- if (position == 0)
- pos = rec->no_icons;
- else
- pos = position;
-
- pos--;
- icon->x = (pos % rec->columns) *
- (rec->icon_width + rec->icon_hspacing) +
- rec->icon_hspacing/2;
- icon->y = (pos / rec->columns) *
- (rec->icon_height + rec->string_height + rec->icon_vspacing) +
- rec->icon_vspacing/2;
-
- /* icons are unselected */
- icon->selected = False;
-
- new_pixmap = False;
-
- display = XtDisplay(widget);
-
- /*
- * Get cached big and small icon pixmaps from Motif.
- * Before calling XmGetPixmap check if the icon name or the class
- * has already been used. In that case we may skip the XmGetPixmap call
- * which can be extremely expensive when the user's file system is NFS
- * mounted (the user's filesystem is in the XmGetPixmap search path).
- */
- tmp = rec->icons;
- while (tmp) {
- if ((tmp->pix_name && !strcmp(tmp->pix_name, icon->pix_name)) ||
- (tmp->class && !strcmp(tmp->class, icon->class))) {
- icon->pix = tmp->pix;
- icon->hi_pix = tmp->hi_pix;
- icon->x_off = tmp->x_off;
- icon->y_off = tmp->y_off;
- icon->pix_h = tmp->pix_h;
- icon->pix_w = tmp->pix_w;
- break;
- }
- tmp = tmp->link;
- }
- if (!tmp) {
- icon->pix = XmGetPixmap(XDefaultScreenOfDisplay(display),
- icon->pix_name,
- icon->foreground, icon->background);
-
- icon->hi_pix = XmGetPixmap(XDefaultScreenOfDisplay(display),
- icon->pix_name,
- icon->background, icon->foreground);
-
- /* big icon pixmap not found use built-in default */
- if (icon->pix == XmUNSPECIFIED_PIXMAP) {
- if (!rec->box_icon) {
- rec->box_icon = XCreatePixmapFromBitmapData(display,
- DefaultRootWindow(display),
- (char*)default_icon_bits,
- default_icon_width, default_icon_height,
- icon->foreground, icon->background,
- DefaultDepthOfScreen(XtScreen(widget)));
-
- rec->box_hi_icon = XCreatePixmapFromBitmapData(display,
- DefaultRootWindow(display),
- (char*)default_icon_bits,
- default_icon_width, default_icon_height,
- icon->background, icon->foreground,
- DefaultDepthOfScreen(XtScreen(widget)));
- }
- icon->pix = rec->box_icon;
- icon->hi_pix = rec->box_hi_icon;
- }
-
- new_pixmap = True;
- }
-
- /* idem for small icons */
- tmp = rec->icons;
- while (tmp) {
- if ((tmp->pix_sname && !strcmp(tmp->pix_sname, icon->pix_sname)) ||
- (tmp->class && !strcmp(tmp->class, icon->class))) {
- icon->spix = tmp->spix;
- icon->hi_spix = tmp->hi_spix;
- icon->x_soff = tmp->x_soff;
- icon->y_soff = tmp->y_soff;
- icon->spix_w = tmp->spix_w;
- icon->spix_h = tmp->spix_h;
- break;
- }
- tmp = tmp->link;
- }
- if (!tmp) {
- icon->spix = XmGetPixmap(XDefaultScreenOfDisplay(display),
- icon->pix_sname,
- icon->foreground, icon->background);
-
- icon->hi_spix = XmGetPixmap(XDefaultScreenOfDisplay(display),
- icon->pix_sname,
- icon->background, icon->foreground);
-
- /* small icon pixmap not found, use built in default */
- if (icon->spix == XmUNSPECIFIED_PIXMAP) {
- if (!rec->box_sicon) {
- rec->box_sicon = XCreatePixmapFromBitmapData(display,
- DefaultRootWindow(display),
- (char*)default_sicon_bits,
- default_sicon_width, default_sicon_height,
- icon->foreground, icon->background,
- DefaultDepthOfScreen(XtScreen(widget)));
-
- rec->box_hi_sicon = XCreatePixmapFromBitmapData(display,
- DefaultRootWindow(display),
- (char*)default_sicon_bits,
- default_sicon_width, default_sicon_height,
- icon->background, icon->foreground,
- DefaultDepthOfScreen(XtScreen(widget)));
- }
- icon->spix = rec->box_sicon;
- icon->hi_spix = rec->box_hi_sicon;
- }
-
- new_pixmap = True;
- }
-
- if (new_pixmap)
- CenterPixmap(rec, icon,
- rec->icon_big_width, rec->icon_big_height,
- rec->icon_small_width, rec->icon_small_height);
-
- /* big icon mask must be bitmap, so get and cache it ourself */
- /********** use no mask for the time being
- tmp = rec->icons;
- while (tmp) {
- if (tmp->mask_name != NULL &&
- strcmp(tmp->mask_name, icon->mask_name) == 0) {
- icon->mask = tmp->mask;
- break;
- }
- tmp = tmp->link;
- }
- if (!tmp)
- int dummy;
- Cardinal dum;
- if (XReadBitmapFile (XtDisplay (widget),
- XDefaultRootWindow (XtDisplay (widget)),
- icon->mask_name, &dum, &dum, &icon->mask,
- &dummy, &dummy) != BitmapSuccess)
- icon->mask = XCreateBitmapFromData(display, DefaultRootWindow(display),
- default_mask_bits,
- default_mask_width, default_mask_height);
- ***********/
-
- icon->mask = None;
-
- /* small icon mask must be bitmap, so get and cache it ourself */
- /********** use no mask for the time being
- tmp = rec->icons;
- while (tmp) {
- if (tmp->mask_sname != NULL &&
- strcmp(tmp->mask_sname, icon->mask_sname) == 0) {
- icon->smask = tmp->smask;
- break;
- }
- tmp = tmp->link;
- }
- if (!tmp)
- int dummy;
- Cardinal dum;
- if (XReadBitmapFile (XtDisplay (widget),
- XDefaultRootWindow (XtDisplay (widget)),
- icon->mask_sname, &dum, &dum, &icon->smask,
- &dummy, &dummy) != BitmapSuccess)
- icon->smask = XCreateBitmapFromData(display,DefaultRootWindow(display),
- default_smask_bits,
- default_smask_width, default_smask_height);
- ************/
-
- icon->smask = None;
-}
-
-/***********************************************************************
- * *
- * Set the scrollbar resources. *
- * *
- ***********************************************************************/
-static void SetScrollBar(widget, rec)
- Widget widget;
- BoxRec *rec;
-{
- Arg args[4];
- Widget parent;
- Dimension w, h;
- int value, size;
-
- parent = XtParent(widget);
-
- /* get the size of the parent */
- XtSetArg(args[0], XmNwidth, &w);
- XtSetArg(args[1], XmNheight, &h);
- XtGetValues(parent, args, 2);
-
- XtSetArg(args[0], XmNvalue, &value);
- XtGetValues(rec->scrollbar, args, 1);
-
- size = (int)(h*h) / (int) (rec->virt_height);
- if (size < 1) size = 1;
- if (size > (int) (rec->virt_height)) size = rec->virt_height;
- if (value > (int) (rec->virt_height-size)) {
- value = rec->virt_height-size;
- rec->top = -value;
- }
- XtSetArg(args[0], XmNmaximum, rec->virt_height);
- XtSetArg(args[1], XmNsliderSize, size);
- XtSetArg(args[2], XmNvalue, value);
- XtSetArg(args[3], XmNincrement, 5);
- XtSetValues(rec->scrollbar, args, 4);
-
- /****************
- if (size < rec->virt_height)
- XmScrolledWindowSetAreas(parent, NULL, rec->scrollbar, widget);
- else
- XmScrolledWindowSetAreas(parent, NULL, NULL, widget);
- *****************/
-}
-
-/***********************************************************************
- * *
- * Calculate the virtual height of the icon box. *
- * *
- ***********************************************************************/
-static int GetVirtHeight(rec)
- BoxRec *rec;
-{
- int h;
-
- h = (((rec->no_icons - 1)/ rec->columns) + 1) *
- (rec->icon_height + rec->string_height + rec->icon_vspacing);
- if (h < (int) (rec->height)) h = rec->height;
-
- return h;
-}
-
-/***********************************************************************
- * *
- * Get current IconBox scrollbar position (user callable). *
- * *
- ***********************************************************************/
-int IconBoxGetPos(widget)
- Widget widget;
-{
- BoxRec *rec;
- int value;
-
- XtVaGetValues(widget, XmNuserData, &rec, NULL);
- if (!rec) return 0;
-
- XtVaGetValues(rec->scrollbar, XmNvalue, &value, NULL);
-
- return value;
-}
-
-/***********************************************************************
- * *
- * Set IconBox scrollbar position (user callable). *
- * *
- ***********************************************************************/
-void IconBoxSetPos(widget, value)
- Widget widget;
- int value;
-{
- BoxRec *rec;
- int maxi, mini, val, val1, slz, inc, pinc;
-
- XtVaGetValues(widget, XmNuserData, &rec, NULL);
- if (!rec) return;
-
- XmScrollBarGetValues(rec->scrollbar, &val, &slz, &inc, &pinc);
- XtVaGetValues(rec->scrollbar, XmNminimum, &mini, XmNmaximum, &maxi, NULL);
- val1 = maxi - mini - slz;
- if (value > val1) value = val1;
-
- if (value != val)
- XmScrollBarSetValues(rec->scrollbar, value, slz, inc, pinc, True);
-}
-
-/***********************************************************************
- * *
- * Makes row containing item the first visible row (user callable). *
- * *
- ***********************************************************************/
-void IconBoxSetItem(widget, item)
- Widget widget;
- XmString item;
-{
- BoxRec *rec;
- IconRec *icon;
- int top = 0;
- int i;
-
- XtVaGetValues(widget, XmNuserData, &rec, NULL);
- if (!rec || !rec->icons) return;
-
- /*
- * if refresh has never been called before the scrollbar is not
- * yet set properly and the icon_height may also not be up-to-date
- */
- IconBoxRefresh(widget);
-
- icon = rec->icons;
-
- i = 0;
- while (icon) {
- i++;
- if (XmStringCompare(icon->label, item)) {
- top = ((i - 1)/ rec->columns) *
- (rec->icon_height + rec->string_height + rec->icon_vspacing);
- break;
- }
- icon = icon->link;
- }
-
- if (icon)
- IconBoxSetPos(widget, top);
-}
-
-/***********************************************************************
- * *
- * Set icon and string dimensions as function of the icon type. *
- * *
- ***********************************************************************/
-static void SetIconDimensions(rec)
- BoxRec *rec;
-{
- XmString xms;
- IconRec *icon;
- int maxl, strlft;
-
- /* find longest icon label, minimum length is maxl */
- xms = XmStringCreateLtoR("WWWWWWWWWWW", XmSTRING_DEFAULT_CHARSET);
- maxl = (int)XmStringWidth(rec->fontlist, xms);
- XmStringFree(xms);
- icon = rec->icons;
- while (icon) {
- maxl = max(maxl, (int)XmStringWidth(rec->fontlist, icon->label));
- icon = icon->link;
- }
-
- /*
- * set current icon height and width, vert. and horz. spacing
- * depending on the default icon type
- */
- switch (rec->icon_type) {
- case IconBoxBIG_ICON:
- rec->string_height = rec->string_bheight;
- rec->icon_width = rec->icon_big_width;
- rec->icon_height = rec->icon_big_height + rec->ilsp;
- strlft = (maxl - (int) rec->icon_width +1) / 2;
- if (strlft > rec->icon_bhspacing/2)
- rec->icon_hspacing = 2 * strlft + 10;
- else
- rec->icon_hspacing = rec->icon_bhspacing;
- rec->icon_vspacing = rec->icon_bvspacing;
- icon = rec->icons;
- while (icon) {
- icon->string_left = ((int)XmStringWidth(rec->fontlist, icon->label)-
- (int)rec->icon_width + 1) / 2;
- if (icon->string_left < 0) icon->string_left = 0;
- icon = icon->link;
- }
- break;
- case IconBoxSMALL_ICON:
- case IconBoxTITLES:
- rec->string_height = 0;
- rec->icon_width = rec->icon_small_width + rec->silsp + maxl;
- rec->icon_height = rec->icon_small_height;
- rec->icon_hspacing = rec->icon_shspacing;
- rec->icon_vspacing = rec->icon_svspacing;
- icon = rec->icons;
- while (icon) {
- icon->string_left = 0;
- icon = icon->link;
- }
- break;
- case IconBoxNO_ICON:
- rec->string_height = 0;
- rec->icon_width = maxl;
- rec->icon_height = rec->string_bheight;
- rec->icon_hspacing = rec->icon_nhspacing;
- rec->icon_vspacing = rec->icon_nvspacing;
- icon = rec->icons;
- while (icon) {
- icon->string_left = 0;
- icon = icon->link;
- }
- }
-}
-
-/***********************************************************************
- * *
- * Recalculate the offsets of the pixmaps if the size of the minimum *
- * pixmap changes. *
- * Default for the big icons is 40x40 and for the small icons *
- * 20x20. *
- * *
- ***********************************************************************/
-static C_DECL_3(void RecalculateIconOffset,
- BoxRec *, rec,
- Boolean, recalc_offset,
- Boolean, recalc_soffset)
-{
- IconRec *icon;
- int dummy;
- Cardinal dum, wp, hp;
- Display *display;
- Window root;
-
- display = XtDisplay(rec->area);
-
- icon = rec->icons;
- while (icon) {
- if (recalc_offset) {
- XGetGeometry(display, icon->pix, &root, &dummy, &dummy,
- &wp, &hp, &dum, &dum);
- icon->x_off = (rec->icon_big_width - wp) / 2;
- icon->y_off = (rec->icon_big_height - hp) / 2;
- if (icon->x_off < 0) icon->x_off = 0;
- if (icon->y_off < 0) icon->y_off = 0;
- }
- if (recalc_soffset) {
- XGetGeometry(display, icon->spix, &root, &dummy, &dummy,
- &wp, &hp, &dum, &dum);
- icon->x_soff = (rec->icon_small_width - wp) / 2;
- icon->y_soff = (rec->icon_small_height - hp) / 2;
- if (icon->x_soff < 0) icon->x_soff = 0;
- if (icon->y_soff < 0) icon->y_soff = 0;
- }
- icon = icon->link;
- }
-}
-
-/***********************************************************************
- * *
- * Center the big and small pixmaps in the minimum (by default the *
- * min. big pixmap = 40x40 and small pixmap is 20x20) pixmap. If the *
- * new pixmaps are larger then the min. pixmaps they become the new *
- * min. pixmaps. In this case all pixmaps of the existing items will *
- * be re-centered in the new min. pixmaps. *
- * *
- * If icon=NULL then scan the pixmaps of all icons to find the a *
- * new min. pixmap. The default min. pixmaps is given by the *
- * arguments big_width, ... *
- * *
- ***********************************************************************/
-static void CenterPixmap(rec, icon,
- big_width, big_height, small_width, small_height)
- BoxRec *rec;
- IconRec *icon;
- Cardinal big_width, big_height, small_width, small_height;
-{
- Display *display;
- int dummy;
- Cardinal dum, wp, hp, wt, ht;
- Window root;
- Boolean recalc_offset, recalc_soffset;
-
- recalc_offset = False;
- recalc_soffset = False;
-
- display = XtDisplay(rec->area);
-
- if (icon && big_width > 0 && big_height > 0) {
- /*
- * get size of pixmap and calculate the offsets from the full pixmap
- * (default 40x40) to center the pixmap in the full pixmap
- */
- XGetGeometry(display, icon->pix, &root, &dummy, &dummy,
- &wp, &hp, &dum, &dum);
- wt = max(big_width, wp);
- ht = max(big_height, hp);
- if (wt != big_width) {
- rec->icon_big_width = (Dimension)wt;
- recalc_offset = True;
- }
- if (ht != big_height) {
- rec->icon_big_height = (Dimension)ht;
- recalc_offset = True;
- }
- icon->x_off = (rec->icon_big_width - wp) / 2;
- icon->y_off = (rec->icon_big_height - hp) / 2;
- if (icon->x_off < 0) icon->x_off = 0;
- if (icon->y_off < 0) icon->y_off = 0;
- icon->pix_w = (Dimension)wp;
- icon->pix_h = (Dimension)hp;
- }
-
- if (icon && small_width > 0 && small_height > 0) {
- /*
- * get size of small pixmap and calculate the offsets from the full
- * pixmap (default 20x20) to center the pixmap in the full pixmap
- */
- XGetGeometry(display, icon->spix, &root, &dummy, &dummy,
- &wp, &hp, &dum, &dum);
- wt = max(small_width, wp);
- ht = max(small_height, hp);
- if (wt != small_width) {
- rec->icon_small_width = (Dimension)wt;
- recalc_soffset = True;
- }
- if (ht != small_height) {
- rec->icon_small_height = (Dimension)ht;
- recalc_soffset = True;
- }
- icon->x_soff = (rec->icon_small_width - wp) / 2;
- icon->y_soff = (rec->icon_small_height - hp) / 2;
- if (icon->x_soff < 0) icon->x_soff = 0;
- if (icon->y_soff < 0) icon->y_soff = 0;
- icon->spix_w = (Dimension)wp;
- icon->spix_h = (Dimension)hp;
- }
-
- if (!icon) {
- rec->icon_big_width = big_width;
- rec->icon_big_height = big_height;
- rec->icon_small_width = small_width;
- rec->icon_small_height = small_height;
- recalc_offset = True;
- recalc_soffset = True;
- icon = rec->icons;
- while (icon) {
- XGetGeometry(display, icon->pix, &root, &dummy, &dummy,
- &wp, &hp, &dum, &dum);
- rec->icon_big_width = max(rec->icon_big_width, wp);
- rec->icon_big_height = max(rec->icon_big_height, hp);
-
- XGetGeometry(display, icon->spix, &root, &dummy, &dummy,
- &wp, &hp, &dum, &dum);
- rec->icon_small_width = max(rec->icon_small_width, wp);
- rec->icon_small_height = max(rec->icon_small_height, hp);
-
- icon = icon->link;
- }
- }
-
- /* if size of pixmap increased recalculate offsets for all icons */
- if (recalc_offset || recalc_soffset)
- RecalculateIconOffset(rec, recalc_offset, recalc_soffset);
-}
-
-/***********************************************************************
- * *
- * Set IconBox icon type, either IconBoxBIG_ICON, IconBoxSMALL_ICON *
- * or IconBoxNO_ICON (user callable) or IconBoxTITLES. *
- * *
- ***********************************************************************/
-void IconBoxSetIconType(widget, type)
- Widget widget;
- int type;
-{
- BoxRec *rec;
-
- XtVaGetValues(widget, XmNuserData, &rec, NULL);
- if (rec == NULL) return;
-
- if (rec->icon_type == type) return;
-
- rec->icon_type = type;
-
- IconBoxRefresh(widget);
-}
-
-/***********************************************************************
- * *
- * Get IconBox icon type, either IconBoxBIG_ICON, IconBoxSMALL_ICON *
- * or IconBoxNO_ICON (user callable) or IconBoxTITLES. *
- * *
- ***********************************************************************/
-int IconBoxGetIconType(widget)
- Widget widget;
-{
- BoxRec *rec;
-
- XtVaGetValues(widget, XmNuserData, &rec, NULL);
- if (rec == NULL) return IconBoxNO_ICON;
-
- return rec->icon_type;
-}
-
-/***********************************************************************
- * *
- * Add icon to the IconBox. *
- * *
- ***********************************************************************/
-IconRec *AddItem(rec, item, class, position)
- BoxRec *rec;
- XmString item;
- char *class;
- int position;
-{
- IconRec *icon;
- IconRec *tmp;
- int i;
-
- /* allocate icon records and initialize to 0 */
- icon = (IconRec*) XtCalloc (1, sizeof (IconRec));
-
- InitIcon(rec->area, rec, icon, item, class, position);
-
- /* attach next icon at end of icon list if position = 0, or at position */
- if (!rec->icons) {
- rec->icons = icon;
- rec->last_icon = icon;
- } else {
- if (position == 0) {
- rec->last_icon->link = icon;
- rec->last_icon = icon;
- } else if (position == 1) {
- icon->link = rec->icons;
- rec->icons = icon;
- } else {
- i = 1;
- tmp = rec->icons;
- while (i < position-1) {
- i++;
- tmp = tmp->link;
- if (!tmp) {
- rec->last_icon->link = icon;
- rec->last_icon = icon;
- goto out;
- }
- }
- icon->link = tmp->link;
- tmp->link = icon;
- }
- }
-
-out:
- return(icon);
-}
-
-/***********************************************************************
- * *
- * Add icon to the IconBox (user callable). *
- * *
- ***********************************************************************/
-C_DECL_5(void IconBoxAddItem,
- Widget, widget,
- XmString, item,
- char *, class,
- int, position,
- Boolean, refresh)
-{
- Arg args[1];
- BoxRec *rec;
-
- XtSetArg (args[0], XmNuserData, &rec);
- XtGetValues (widget, args, 1);
-
- if (rec == NULL) return;
-
- AddItem(rec, item, class, position);
-
- if (refresh)
- IconBoxRefresh(widget);
-}
-
-/***********************************************************************
- * *
- * Add icon with predfined pixmaps to the IconBox (user callable). *
- * The user may define 4 Pixmaps: big_icon (40x40), highlighted *
- * big_icon, small_icon (20x20) and highlighted small_icon. *
- * *
- ***********************************************************************/
-C_DECL_9(void IconBoxAddItemPixmap,
- Widget, widget,
- XmString, item,
- char *, class,
- Pixmap, bpix,
- Pixmap, bhpix,
- Pixmap, spix,
- Pixmap, shpix,
- int, position,
- Boolean, refresh)
-{
- Arg args[1];
- BoxRec *rec;
- IconRec *icon;
-
- XtSetArg(args[0], XmNuserData, &rec);
- XtGetValues(widget, args, 1);
-
- if (rec == NULL) return;
-
- icon = AddItem(rec, item, class, position);
-
- if (bpix) icon->pix = bpix;
- if (bhpix) icon->hi_pix = bhpix;
- if (spix) icon->spix = spix;
- if (shpix) icon->hi_spix = shpix;
-
- if (bpix || bhpix || spix || shpix)
- CenterPixmap(rec, icon,
- rec->icon_big_width, rec->icon_big_height,
- rec->icon_small_width, rec->icon_small_height);
-
- if (refresh)
- IconBoxRefresh(widget);
-}
-
-/***********************************************************************
- * *
- * Add icon with predfined bitmap data to the IconBox *
- * (user callable). *
- * The user must define the name, bits, width and height of the big *
- * and small icons. *
- * *
- ***********************************************************************/
-C_DECL_13(void IconBoxAddItemBitmapData,
- Widget, widget,
- XmString, item,
- char *, class,
- char *, name,
- char *, bits,
- int, wd,
- int, ht,
- char *, sname,
- char *, sbits,
- int, swd,
- int, sht,
- int, position,
- Boolean, refresh)
-{
- BoxRec *rec;
- IconRec *icon;
- IconRec *tmp = NULL;
- Display *display;
- Boolean new_pixmap = False;
-
- XtVaGetValues(widget, XmNuserData, &rec, NULL);
-
- if (!rec) return;
-
- icon = AddItem(rec, item, class, position);
-
- display = XtDisplay(widget);
-
- if (bits && wd > 0 && ht >0) {
- if (name && strlen(name) > 0) {
- /*
- * To prevent un-necessary calls to XCreatePixmapFromBitmapData,
- * get pixmap from first icon with the same pixmap name.
- */
- tmp = rec->icons;
- while (tmp) {
- if (strcmp(tmp->pix_name, name) == 0) {
- icon->pix = tmp->pix;
- icon->hi_pix = tmp->hi_pix;
- icon->x_off = tmp->x_off;
- icon->y_off = tmp->y_off;
- icon->pix_h = tmp->pix_h;
- icon->pix_w = tmp->pix_w;
- break;
- }
- tmp = tmp->link;
- }
- XtFree(icon->pix_name);
- icon->pix_name = XtNewString(name);
- }
- if (!tmp) {
- icon->pix = XCreatePixmapFromBitmapData(display,
- DefaultRootWindow(display),
- bits, wd, ht,
- icon->foreground, icon->background,
- DefaultDepthOfScreen(XtScreen(rec->area)));
-
- icon->hi_pix = XCreatePixmapFromBitmapData(display,
- DefaultRootWindow(display),
- bits, wd, ht,
- icon->background, icon->foreground,
- DefaultDepthOfScreen(XtScreen(rec->area)));
-
- new_pixmap = True;
- }
- }
-
- if (sbits && swd > 0 && sht >0) {
- if (sname && strlen(sname) > 0) {
- /* idem for the small icons */
- tmp = rec->icons;
- while (tmp) {
- if (strcmp(tmp->pix_sname, sname) == 0) {
- icon->spix = tmp->spix;
- icon->hi_spix = tmp->hi_spix;
- icon->x_soff = tmp->x_soff;
- icon->y_soff = tmp->y_soff;
- icon->spix_w = tmp->spix_w;
- icon->spix_h = tmp->spix_h;
- break;
- }
- tmp = tmp->link;
- }
- XtFree(icon->pix_sname);
- icon->pix_sname = XtNewString(sname);
- }
- if (!tmp) {
- icon->spix = XCreatePixmapFromBitmapData(display,
- DefaultRootWindow(display),
- sbits, swd, sht,
- icon->foreground, icon->background,
- DefaultDepthOfScreen(XtScreen(rec->area)));
-
- icon->hi_spix = XCreatePixmapFromBitmapData(display,
- DefaultRootWindow(display),
- sbits, swd, sht,
- icon->background, icon->foreground,
- DefaultDepthOfScreen(XtScreen(rec->area)));
-
- new_pixmap = True;
- }
- }
-
- if (new_pixmap)
- CenterPixmap(rec, icon,
- rec->icon_big_width, rec->icon_big_height,
- rec->icon_small_width, rec->icon_small_height);
-
- if (refresh)
- IconBoxRefresh(widget);
-}
-
-/***********************************************************************
- * *
- * Change pixmaps of icon with label item (user callable). *
- * *
- ***********************************************************************/
-C_DECL_7(void IconBoxChangeItemPixmap,
- Widget, widget,
- XmString, item,
- Pixmap, bpix,
- Pixmap, bhpix,
- Pixmap, spix,
- Pixmap, shpix,
- Boolean, refresh)
-{
- Arg args[1];
- BoxRec *rec;
- IconRec *icon;
-
- XtSetArg(args[0], XmNuserData, &rec);
- XtGetValues(widget, args, 1);
-
- if (!rec || !rec->icons) return;
-
- icon = rec->icons;
-
- while (icon) {
- if (XmStringCompare(icon->label, item)) {
- if (bpix) icon->pix = bpix;
- if (bhpix) icon->hi_pix = bhpix;
- if (spix) icon->spix = spix;
- if (shpix) icon->hi_spix = shpix;
- break;
- }
- icon = icon->link;
- }
-
- if (icon) {
- CenterPixmap(rec, icon,
- rec->icon_big_width, rec->icon_big_height,
- rec->icon_small_width, rec->icon_small_height);
-
- if (refresh)
- IconBoxRefresh(widget);
- }
-}
-
-/***********************************************************************
- * *
- * Change pixmaps of icon in position pos (user callable). *
- * *
- ***********************************************************************/
-C_DECL_7(void IconBoxChangePosPixmap,
- Widget, widget,
- int, pos,
- Pixmap, bpix,
- Pixmap, bhpix,
- Pixmap, spix,
- Pixmap, shpix,
- Boolean, refresh)
-{
- Arg args[1];
- BoxRec *rec;
- IconRec *icon;
- int ipos;
-
- XtSetArg(args[0], XmNuserData, &rec);
- XtGetValues(widget, args, 1);
-
- if (!rec || !rec->icons) return;
-
- ipos = 0;
- icon = rec->icons;
-
- while (icon) {
- ipos++;
- if (pos == ipos) {
- if (bpix) icon->pix = bpix;
- if (bhpix) icon->hi_pix = bhpix;
- if (spix) icon->spix = spix;
- if (shpix) icon->hi_spix = shpix;
- break;
- }
- icon = icon->link;
- }
-
- if (icon) {
- CenterPixmap(rec, icon,
- rec->icon_big_width, rec->icon_big_height,
- rec->icon_small_width, rec->icon_small_height);
-
- if (refresh)
- IconBoxRefresh(widget);
- }
-}
-
-/***********************************************************************
- * *
- * Update icon spacing, repostion the icons, and if necessary update *
- * the scrollbar. *
- * *
- ***********************************************************************/
-static void UpdatePositions(rec)
- BoxRec *rec;
-{
- int h;
-
- /*
- * update the icon spacing depending on the label
- * lenght and icon size
- */
- SetIconDimensions(rec);
-
- /* repostion the icons */
- RepositionIcons(rec);
-
- /* if the virtual height of the box changed adjust scrollbar slider */
- h = GetVirtHeight(rec);
- if (h != rec->virt_height) {
- rec->virt_height = h;
- SetScrollBar(rec->area, rec);
- }
-}
-
-/***********************************************************************
- * *
- * Refresh the IconBox (user callable). *
- * *
- ***********************************************************************/
-void IconBoxRefresh(widget)
- Widget widget;
-{
- Arg args[1];
- BoxRec *rec;
-
- XtSetArg (args[0], XmNuserData, &rec);
- XtGetValues (widget, args, 1);
-
- if (rec == NULL) return;
-
- UpdatePositions(rec);
-
- if (rec->exposed)
- RedrawRegion(widget, rec, 0, 0, rec->width, rec->height);
-}
-
-/***********************************************************************
- * *
- * Create a scrollbar to scroll the iconbox window. *
- * *
- ***********************************************************************/
-static void CreateScrollBar(parent, rec, work_area)
- Widget parent;
- BoxRec *rec;
- Widget work_area;
-{
- Widget sb;
- Arg args[3];
-
- XtSetArg(args[0], XmNminimum, 0);
- XtSetArg(args[1], XmNincrement, 1);
- XtSetArg(args[2], XmNpageIncrement,
- rec->icon_height + rec->string_height + rec->icon_vspacing);
- sb = XtCreateManagedWidget("scrollbar", xmScrollBarWidgetClass,
- parent, args, 3);
-
- XtAddCallback(sb, XmNvalueChangedCallback,
- (XtCallbackProc)ScrollBarMoved, rec);
- XtAddCallback(sb, XmNdragCallback, (XtCallbackProc)ScrollBarMoved, rec);
-
- rec->scrollbar = sb;
- rec->scrolled = False;
-
- XmScrolledWindowSetAreas(parent, NULL, sb, work_area);
-
- SetScrollBar(work_area, rec);
-}
-
-/***********************************************************************
- * *
- * Add callbacks (user callable). *
- * *
- ***********************************************************************/
-void IconBoxAddCallback(widget, cb_type, cb, client_data)
- Widget widget;
- char *cb_type;
- XtCallbackProc cb;
- caddr_t client_data;
-{
- BoxRec *rec;
-
- XtVaGetValues(widget, XmNuserData, &rec, NULL);
- if (!rec) return;
-
- if (!strcmp(cb_type, XmNdefaultActionCallback)) {
- rec->default_cb = cb;
- rec->default_cd = client_data;
- }
- if (!strcmp(cb_type, XmNsingleSelectionCallback)) {
- rec->single_cb = cb;
- rec->single_cd = client_data;
- }
- if (!strcmp(cb_type, XmNmultipleSelectionCallback)) {
- rec->multiple_cb = cb;
- rec->multiple_cd = client_data;
- }
- if (!strcmp(cb_type, XmNextendedSelectionCallback)) {
- rec->extended_cb = cb;
- rec->extended_cd = client_data;
- }
-}
-
-/***********************************************************************
- * *
- * Call callbacks. *
- * *
- ***********************************************************************/
-static void CallCallback(rec, event, cb_type)
- BoxRec *rec;
- XEvent *event;
- char *cb_type;
-{
- IconBoxCallbackStruct cbs;
- XtCallbackProc proc = NULL;
- caddr_t cd = NULL;
- IconRec *icon;
- int cnt, ipos;
- XmStringTable tt;
- int *tp;
- char **tc;
-
- if (!strcmp(cb_type, XmNdefaultActionCallback)) {
- proc = rec->default_cb;
- cd = rec->default_cd;
- cbs.reason = XmCR_DEFAULT_ACTION;
- }
- if (!strcmp(cb_type, XmNsingleSelectionCallback)) {
- proc = rec->single_cb;
- cd = rec->single_cd;
- cbs.reason = XmCR_SINGLE_SELECT;
- }
- if (!strcmp(cb_type, XmNmultipleSelectionCallback)) {
- proc = rec->multiple_cb;
- cd = rec->multiple_cd;
- cbs.reason = XmCR_MULTIPLE_SELECT;
- }
- if (!strcmp(cb_type, XmNextendedSelectionCallback)) {
- proc = rec->extended_cb;
- cd = rec->extended_cd;
- cbs.reason = XmCR_EXTENDED_SELECT;
- }
-
- if (proc) {
- if (!rec->no_icons)
- return;
-
- tt = (XmStringTable)XtMalloc(rec->no_icons * sizeof(XmString));
- tp = (int *)XtMalloc(rec->no_icons * sizeof(int));
- tc = (char **)XtMalloc(rec->no_icons * sizeof(char *));
-
- cbs.event = event;
- cbs.selected_items = tt;
- cbs.selected_item_positions = tp;
- cbs.selected_item_class = tc;
- cbs.selection_type = 0;
-
- cnt = 0;
- ipos = 0;
- icon = rec->icons;
- while (icon) {
- ipos++;
- if (icon->selected) {
- *tt++ = icon->label;
- *tp++ = ipos;
- *tc++ = icon->class;
- cnt++;
- }
- icon = icon->link;
- }
- if (!cnt)
- goto clean;
-
- cbs.selected_item_count = cnt;
-
- /* in case one item selected always do single select callback */
- if (cbs.reason == XmCR_MULTIPLE_SELECT && cnt == 1) {
- proc = rec->single_cb;
- cd = rec->single_cd;
- cbs.reason = XmCR_SINGLE_SELECT;
- }
-
- /* flush display before calling callback routine */
- XFlush(XtDisplay(rec->area));
-
- /* call the callback */
- (*proc)(rec->area, cd, &cbs);
-
-clean:
- XtFree((char *)cbs.selected_items);
- XtFree((char *)cbs.selected_item_positions);
- XtFree((char *)cbs.selected_item_class);
- }
-}
-
-/***********************************************************************
- * *
- * Create an IconBox (user callable). *
- * *
- ***********************************************************************/
-Widget CreateIconBox(parent, name, add_args, num_add_args)
- Widget parent;
- char *name;
- Arg add_args[];
- Cardinal num_add_args;
-{
- Widget area;
- Arg args[3];
- BoxRec *rec;
- XmString xms;
-
- /* space for rec is initialized to 0 */
- rec = (BoxRec *)XtCalloc (1, sizeof (BoxRec));
-
- area = XtCreateManagedWidget(name,
- xmDrawingAreaWidgetClass,
- parent,
- add_args, num_add_args);
-
- XtGetSubresources(parent, rec, name, BOX_CLASS_NAME,
- box_resources, XtNumber (box_resources),
- add_args, num_add_args);
-
- xms = XmStringCreateLtoR("hg", XmSTRING_DEFAULT_CHARSET);
- rec->string_bheight = XmStringHeight(rec->fontlist, xms) + 2;
- XmStringFree(xms);
-
- /* set default size to the size of the parent */
- XtSetArg(args[0], XmNwidth, &rec->width);
- XtSetArg(args[1], XmNheight, &rec->height);
- XtGetValues(parent, args, 2);
-
- XtSetArg(args[0], XmNwidth, rec->width);
- XtSetArg(args[1], XmNheight, rec->height);
- XtSetArg(args[2], XmNuserData, rec);
- XtSetValues(area, args, 3);
-
- /* set minimum icon pixmap sizes */
- rec->icon_big_width = rec->min_big_width;
- rec->icon_big_height = rec->min_big_height;
- rec->icon_small_width = rec->min_small_width;
- rec->icon_small_height = rec->min_small_height;
-
- /* set spacing between icon and label (should be setable in resource) */
- rec->ilsp = 1;
- rec->silsp = 2;
-
- SetIconDimensions(rec);
-
- /* calculate the number of columns that fit in the window */
- rec->columns =
- (int) (rec->width) / (int) (rec->icon_width + rec->icon_hspacing);
- if (rec->columns <= 0) rec->columns = 1;
-
- /* set the virtual height to the actual height */
- rec->virt_height = rec->height;
-
- XtAddCallback(area, XmNexposeCallback, (XtCallbackProc)ExposeBox, rec);
- XtAddCallback(area, XmNinputCallback, (XtCallbackProc)HandleButtons, rec);
- XtAddEventHandler(area, ButtonMotionMask, False,
- (XtEventHandler)HandleMove, rec);
- XtAddEventHandler(area, 0, True,
- (XtEventHandler)HandleGraphicsExposures, rec);
- XtAddCallback(area, XmNresizeCallback, (XtCallbackProc)HandleResize, rec);
- XtAddCallback(area, XmNdestroyCallback, (XtCallbackProc)DestroyIconBox, rec);
-
- CreateScrollBar(parent, rec, area);
-
- rec->area = area;
-
- return area;
-}
-
-/******************** Handling expose through back pixmap *************/
-
-/***********************************************************************
- * *
- * Redraw one icon to back pixmap. *
- * *
- ***********************************************************************/
-static void RedrawIcon(widget, rec, icon)
- Widget widget;
- BoxRec *rec;
- IconRec *icon;
-{
- int yoff;
- Pixel bgr;
-
- XtVaGetValues(widget, XmNbackground, &bgr, NULL);
-
- switch (rec->icon_type) {
-
- case IconBoxBIG_ICON:
- /* set clip mask in gc */
- XSetClipMask(XtDisplay(widget), rec->draw_gc, icon->mask);
-
- /* fill shadow */
- /*********** no icon shadows for the time being cosmetic
- *********** problem when scrolling
- XSetClipOrigin (XtDisplay (widget), rec->draw_gc,
- icon->x + rec->shadow_off, icon->y + rec->shadow_off + rec->top);
- XSetForeground(XtDisplay(widget), rec->draw_gc, rec->shadow_color);
- XFillRectangle(XtDisplay(widget), rec->back, rec->draw_gc,
- icon->x + rec->shadow_off, icon->y + rec->shadow_off + rec->top,
- rec->icon_width, rec->icon_height);
- **************/
-
- /* draw icon */
- XSetClipOrigin(XtDisplay(widget), rec->draw_gc,
- icon->x, icon->y + rec->top);
- XSetForeground(XtDisplay(widget), rec->draw_gc, icon->foreground);
- XSetBackground(XtDisplay(widget), rec->draw_gc, icon->background);
- if (icon->pix != XmUNSPECIFIED_PIXMAP)
- if (icon->selected)
- XCopyArea(XtDisplay(widget), icon->hi_pix, rec->back,
- rec->draw_gc, 0, 0, rec->icon_width,
- rec->icon_big_height,
- icon->x + icon->x_off,
- icon->y + icon->y_off + rec->top);
- else
- XCopyArea(XtDisplay(widget), icon->pix, rec->back,
- rec->draw_gc, 0, 0, rec->icon_width,
- rec->icon_big_height,
- icon->x + icon->x_off,
- icon->y + icon->y_off + rec->top);
-
- /* draw label */
- XSetClipMask(XtDisplay(widget), rec->draw_gc, None);
- if (icon->selected) {
- XSetForeground(XtDisplay(widget), rec->draw_gc, icon->label_bg);
- XSetBackground(XtDisplay(widget), rec->draw_gc, icon->label_fg);
- XmStringDrawImage(XtDisplay (widget), rec->back,
- rec->fontlist, icon->label, rec->draw_gc,
- icon->x - icon->string_left,
- icon->y + rec->icon_height + rec->top + rec->ilsp,
- rec->icon_width + 2 * icon->string_left,
- XmALIGNMENT_CENTER, XmSTRING_DIRECTION_L_TO_R,
- NULL);
- } else {
- XSetForeground(XtDisplay(widget), rec->draw_gc, icon->label_fg);
- XSetBackground(XtDisplay(widget), rec->draw_gc, icon->label_bg);
- if (icon->label_fg == bgr) {
- XmStringDrawImage(XtDisplay (widget), rec->back,
- rec->fontlist, icon->label, rec->draw_gc,
- icon->x - icon->string_left,
- icon->y + rec->icon_height + rec->top + rec->ilsp,
- rec->icon_width + 2 * icon->string_left,
- XmALIGNMENT_CENTER, XmSTRING_DIRECTION_L_TO_R, NULL);
- } else {
- XmStringDraw(XtDisplay (widget), rec->back,
- rec->fontlist, icon->label, rec->draw_gc,
- icon->x - icon->string_left,
- icon->y + rec->icon_height + rec->top + rec->ilsp,
- rec->icon_width + 2 * icon->string_left,
- XmALIGNMENT_CENTER, XmSTRING_DIRECTION_L_TO_R, NULL);
- }
- }
- break;
-
- case IconBoxSMALL_ICON:
- case IconBoxTITLES:
- /* set clip mask in gc */
- XSetClipMask(XtDisplay(widget), rec->draw_gc, icon->smask);
-
- /* draw small icon */
- XSetClipOrigin(XtDisplay(widget), rec->draw_gc,
- icon->x, icon->y + rec->top);
- XSetForeground(XtDisplay(widget), rec->draw_gc, icon->foreground);
- XSetBackground(XtDisplay(widget), rec->draw_gc, icon->background);
- if (icon->spix != XmUNSPECIFIED_PIXMAP)
- if (icon->selected)
- XCopyArea(XtDisplay(widget), icon->hi_spix, rec->back,
- rec->draw_gc, 0, 0, rec->icon_small_width,
- rec->icon_height,
- icon->x + icon->x_soff,
- icon->y + icon->y_soff + rec->top);
- else
- XCopyArea(XtDisplay(widget), icon->spix, rec->back,
- rec->draw_gc, 0, 0, rec->icon_small_width,
- rec->icon_height,
- icon->x + icon->x_soff,
- icon->y + icon->y_soff + rec->top);
-
- /* draw label */
- XSetClipMask(XtDisplay(widget), rec->draw_gc, None);
- /* place label to the right and in the middle of the icon */
- yoff = rec->icon_small_height / 2 - rec->string_bheight / 2;
- if (icon->selected) {
- XSetForeground(XtDisplay(widget), rec->draw_gc, icon->label_bg);
- XSetBackground(XtDisplay(widget), rec->draw_gc, icon->label_fg);
- XmStringDrawImage(XtDisplay(widget), rec->back,
- rec->fontlist, icon->label, rec->draw_gc,
- icon->x + rec->icon_small_width + rec->silsp,
- icon->y + rec->top + yoff,
- rec->icon_width - rec->icon_small_width,
- XmALIGNMENT_BEGINNING, XmSTRING_DIRECTION_L_TO_R,
- NULL);
- } else {
- XSetForeground(XtDisplay(widget), rec->draw_gc, icon->label_fg);
- XSetBackground(XtDisplay(widget), rec->draw_gc, icon->label_bg);
- if (icon->label_fg == bgr) {
- XmStringDrawImage(XtDisplay(widget), rec->back,
- rec->fontlist, icon->label, rec->draw_gc,
- icon->x + rec->icon_small_width + rec->silsp,
- icon->y + rec->top + yoff,
- rec->icon_width - rec->icon_small_width,
- XmALIGNMENT_BEGINNING, XmSTRING_DIRECTION_L_TO_R,
- NULL);
- } else {
- XmStringDraw(XtDisplay(widget), rec->back,
- rec->fontlist, icon->label, rec->draw_gc,
- icon->x + rec->icon_small_width + rec->silsp,
- icon->y + rec->top + yoff,
- rec->icon_width - rec->icon_small_width,
- XmALIGNMENT_BEGINNING, XmSTRING_DIRECTION_L_TO_R,
- NULL);
- }
- }
- break;
-
- case IconBoxNO_ICON:
- /* draw label */
- XSetClipMask(XtDisplay(widget), rec->draw_gc, None);
- if (icon->selected) {
- XSetForeground(XtDisplay(widget), rec->draw_gc, icon->label_bg);
- XSetBackground(XtDisplay(widget), rec->draw_gc, icon->label_fg);
- XmStringDrawImage(XtDisplay(widget), rec->back,
- rec->fontlist, icon->label, rec->draw_gc,
- icon->x,
- icon->y + rec->top,
- rec->icon_width,
- XmALIGNMENT_BEGINNING, XmSTRING_DIRECTION_L_TO_R,
- NULL);
- } else {
- XSetForeground(XtDisplay(widget), rec->draw_gc, icon->label_fg);
- XSetBackground(XtDisplay(widget), rec->draw_gc, icon->label_bg);
- if (icon->label_fg == bgr) {
- XmStringDrawImage(XtDisplay(widget), rec->back,
- rec->fontlist, icon->label, rec->draw_gc,
- icon->x,
- icon->y + rec->top,
- rec->icon_width,
- XmALIGNMENT_BEGINNING, XmSTRING_DIRECTION_L_TO_R,
- NULL);
- } else {
- XmStringDraw(XtDisplay(widget), rec->back,
- rec->fontlist, icon->label, rec->draw_gc,
- icon->x,
- icon->y + rec->top,
- rec->icon_width,
- XmALIGNMENT_BEGINNING, XmSTRING_DIRECTION_L_TO_R,
- NULL);
- }
- }
- }
-}
-
-/***********************************************************************
- * *
- * Test whether two rectangles intersect. *
- * *
- ***********************************************************************/
-static Boolean Intersect(x1, y1, w1, h1, x2, y2, w2, h2)
- int x1, y1, x2, y2;
- Dimension w1, h1, w2, h2;
-{
- if (x1 + (int)w1 < x2 || y1 + (int)h1 < y2) return False;
- if (x1 > x2 + (int)w2 || y1 > y2 + (int)h2) return False;
- return True;
-}
-
-/***********************************************************************
- * *
- * Create back pixmap on first expose. *
- * *
- ***********************************************************************/
-static void InitializeBoxWindow(widget, rec)
- Widget widget;
- BoxRec *rec;
-{
- Arg args[3];
- Cardinal depth;
- Pixel window_foreground;
- XGCValues gc_values;
- IconRec *icon;
- Boolean got_intersection = False;
-
- /* get values from drawing area */
- XtSetArg(args[0], XmNdepth, &depth);
- XtSetArg(args[1], XmNbackground, &rec->background);
- XtSetArg(args[2], XmNforeground, &window_foreground);
- XtGetValues(widget, args, 3);
-
- /* delete backing pixmap if it already exists */
- if (rec->back) {
- XFreePixmap(XtDisplay(widget), rec->back);
- XFreeGC(XtDisplay(widget), rec->draw_gc);
- XtReleaseGC(widget, rec->normal_gc);
- XtReleaseGC(widget, rec->xor_gc);
- }
-
- /* create backing pixmap */
- rec->back = XCreatePixmap(XtDisplay(widget), XtWindow(widget),
- rec->width, rec->height, depth);
- rec->exposed = True;
-
- /* create writable GC used to draw into backing pixmap */
- gc_values.foreground = window_foreground;
- gc_values.background = rec->background;
- gc_values.graphics_exposures = False;
- gc_values.font = XLoadFont(XtDisplay(widget), "fixed");
- rec->draw_gc = XCreateGC(XtDisplay(widget), XtWindow(widget),
- GCForeground | GCBackground |
- GCFont | GCGraphicsExposures,
- &gc_values);
-
- /* get shareable GC used to draw to the screen */
- gc_values.graphics_exposures = True;
- rec->normal_gc = XtGetGC(widget,
- GCForeground | GCBackground |
- GCFont | GCGraphicsExposures,
- &gc_values);
-
- /* get shareable GC used to draw the rubberband box */
- /*
- * Set the fg to the XOR of the fg and bg, so if it is XOR'ed
- * with the bg, the result will be fg and vice-versa.
- * This effectively achieves inverse video for the box.
- */
- gc_values.foreground = window_foreground ^ rec->background;
- gc_values.background = rec->background;
- gc_values.line_style = LineSolid;
- gc_values.function = GXxor;
- rec->xor_gc = XtGetGC(widget,
- GCForeground | GCBackground |
- GCFunction | GCLineStyle,
- &gc_values);
-
- /*
- * Establish a passive grab, for any button press.
- * Force the sprite to stay within the area window.
- */
- XGrabButton(XtDisplay(widget), AnyButton, AnyModifier,
- XtWindow(widget), True,
- ButtonPressMask | ButtonMotionMask | ButtonReleaseMask,
- GrabModeAsync, GrabModeAsync, XtWindow(widget),
- XCreateFontCursor(XtDisplay(widget), XC_left_ptr));
-
- /* initialize pixmap contents */
- XSetForeground(XtDisplay (widget), rec->draw_gc, rec->background);
- XFillRectangle(XtDisplay (widget), rec->back, rec->draw_gc,
- 0, 0, rec->width, rec->height);
-
- icon = rec->icons;
- while (icon) {
- if (Intersect(0, 0, rec->width, rec->height,
- icon->x - icon->string_left,
- icon->y + rec->top,
- rec->icon_width + 2 * icon->string_left,
- rec->icon_height + rec->string_height)) {
- RedrawIcon(widget, rec, icon);
- got_intersection = True;
- } else if (got_intersection)
- break;
- icon = icon->link;
- }
-}
-
-/***********************************************************************
- * *
- * Redraw partial region of back pixmap and refresh window. *
- * *
- ***********************************************************************/
-static C_DECL_6(void RedrawRegion,
- Widget, widget,
- BoxRec *, rec,
- int, x,
- int, y,
- Dimension, width,
- Dimension, height)
-{
- IconRec *icon;
- Boolean got_intersection = False;
-
- /* erase invalid rectangle in back pixmap */
- XSetForeground(XtDisplay(widget), rec->draw_gc, rec->background);
- XSetClipMask(XtDisplay(widget), rec->draw_gc, None);
- XFillRectangle(XtDisplay(widget), rec->back, rec->draw_gc,
- x, y, width, height);
-
- /* redraw affected icons to back pixmap */
- icon = rec->icons;
- while (icon) {
- if (Intersect(x, y, width, height,
- icon->x - icon->string_left,
- icon->y + rec->top,
- rec->icon_width + 2 * icon->string_left,
- rec->icon_height + rec->string_height)) {
- RedrawIcon(widget, rec, icon);
- got_intersection = True;
- } else if (got_intersection)
- break;
- icon = icon->link;
- }
-
- /* refresh window of drawing area */
- XCopyArea(XtDisplay(widget), rec->back, XtWindow(widget),
- rec->normal_gc, x, y, width, height, x, y);
-}
-
-/***********************************************************************
- * *
- * Simple expose procedure. *
- * *
- ***********************************************************************/
-static void ExposeBox(widget, rec, call_data)
- Widget widget;
- BoxRec *rec;
- XmDrawingAreaCallbackStruct *call_data;
-{
- XEvent *ev = call_data->event;
-
- /*
- * If widget has not yet been displayed then window is not set
- * and in that case InitializeBoxWindow will not work because
- * it cannot create the backing pixmap.
- */
- if (!XtWindow(widget)) return;
-
- if (ev == NULL && !rec->redraw_all) return;
-
- /*
- * After scrolling the backing pixmap is not up-to-date,
- * RedrawRegion will update it
- */
- if (rec->scrolled && rec->exposed) {
-
- RedrawRegion(widget, rec, 0, 0, rec->width, rec->height);
-
- } else {
-
- /* create back pixmap if first time */
- if (!rec->exposed)
- InitializeBoxWindow(widget, rec);
-
- /* copy backing pixmap to screen */
- if (rec->redraw_all) {
- XCopyArea(XtDisplay(widget), rec->back, XtWindow(widget),
- rec->normal_gc, 0, 0, rec->width, rec->height, 0, 0);
- rec->redraw_all = False;
- } else
- XCopyArea(XtDisplay(widget), rec->back, XtWindow(widget),
- rec->normal_gc,
- ev->xexpose.x, ev->xexpose.y,
- ev->xexpose.width, ev->xexpose.height,
- ev->xexpose.x, ev->xexpose.y);
- }
-
- rec->scrolled = False;
-}
-
-/************************ Handle button-down **************************/
-
-/***********************************************************************
- * *
- * Test whether point in icon or label part. *
- * *
- ***********************************************************************/
-Boolean PointInIcon(x, y, icon, ww, hh, sh, top)
- int x, y;
- IconRec *icon;
- Dimension ww, hh;
- int sh, top;
-{
- int w, h;
-
- w = ww; h = hh;
-
- /* is in icon part ? */
- if (x >= icon->x && x <= icon->x + w &&
- y >= icon->y + top && y <= icon->y + top + h) {
- return True;
- }
- /* is in label part (only for big icons since sh=0 for small icons)? */
- if (x >= icon->x - icon->string_left &&
- x <= icon->x + w + icon->string_left &&
- y >= icon->y + top + h &&
- y <= icon->y + top + h + sh) {
- return True;
- }
- /* else false */
- return False;
-}
-
-/***********************************************************************
- * *
- * Which icon was hit? *
- * *
- ***********************************************************************/
-static int Hit(rec, x, y)
- BoxRec *rec;
- int x, y;
-{
- int found = 0;
- IconRec *icon;
-
- icon = rec->icons;
- while (icon) {
- if (PointInIcon (x, y, icon,
- rec->icon_width, rec->icon_height,
- rec->string_height, rec->top)) {
- found = icon->id;
- break;
- }
- icon = icon->link;
- }
- return found;
-}
-
-/***********************************************************************
- * *
- * Find IconRec belonging to id. *
- * *
- ***********************************************************************/
-static IconRec *FindIcon(rec, id)
- BoxRec *rec;
- int id;
-{
- IconRec *icon;
-
- icon = rec->icons;
- while (icon) {
- if (icon->id == id) break;
- icon = icon->link;
- }
- return icon;
-}
-
-/***********************************************************************
- * *
- * Select or deselect one or all icons. *
- * *
- ***********************************************************************/
-static C_DECL_3(void SelectIcons,
- BoxRec *, rec,
- IconRec *, icon,
- Boolean, select)
-{
- if (icon) {
- icon->selected = select;
- } else {
- icon = rec->icons;
- while (icon) {
- icon->selected = select;
- icon = icon->link;
- }
- }
-}
-
-/***********************************************************************
- * *
- * Select all items (user callable). *
- * *
- ***********************************************************************/
-C_DECL_3(void IconBoxSelectAllItems,
- Widget, widget,
- Boolean, refresh,
- Boolean, notify)
-{
- BoxRec *rec;
-
- XtVaGetValues(widget, XmNuserData, &rec, NULL);
- if (!rec || !rec->icons) return;
-
- SelectIcons(rec, NULL, True);
-
- if (refresh && rec->exposed)
- RedrawRegion(widget, rec, 0, 0, rec->width, rec->height);
-
- if (notify)
- CallCallback(rec, NULL, XmNmultipleSelectionCallback);
-}
-
-/***********************************************************************
- * *
- * Deselect all items (user callable). *
- * *
- ***********************************************************************/
-C_DECL_2(void IconBoxDeselectAllItems,
- Widget, widget,
- Boolean, refresh)
-{
- BoxRec *rec;
-
- XtVaGetValues(widget, XmNuserData, &rec, NULL);
- if (!rec || !rec->icons) return;
-
- SelectIcons(rec, NULL, False);
-
- if (refresh && rec->exposed)
- RedrawRegion(widget, rec, 0, 0, rec->width, rec->height);
-}
-
-/***********************************************************************
- * *
- * Change the characters in str into lower case. *
- * *
- ***********************************************************************/
-static void lower(str)
- char *str;
-{
- char *sav = str;
-
- while (*sav) {
- *sav = tolower(*sav);
- sav++;
- }
-}
-
-/***********************************************************************
- * *
- * This function returns a pointer to an array of XmString's *
- * containing the icon labels and the number of icons. *
- * When nitems<>0 the XmString array should be freed by the user *
- * after usage (user callable). *
- * *
- ***********************************************************************/
-void IconBoxGetItems(widget, items, nitems)
- Widget widget;
- XmString **items;
- int *nitems;
-{
- BoxRec *rec;
- IconRec *icon;
- XmString *tmp;
-
- XtVaGetValues(widget, XmNuserData, &rec, NULL);
-
- if (!rec) return;
-
- *nitems = rec->no_icons;
- if (*nitems == 0) {
- *items = (XmString *) NULL;
- return;
- }
-
- *items = (XmString *)XtMalloc(rec->no_icons * sizeof(XmString));
- tmp = *items;
-
- icon = rec->icons;
- while (icon) {
- *tmp++ = icon->label;
- icon = icon->link;
- }
-}
-
-/***********************************************************************
- * *
- * This function returns a pointer to an array of XmString's *
- * containing the icon labels and the number of selected icons. *
- * When nitems<>0 the XmString array should be freed by the user *
- * after usage (user callable). *
- * *
- ***********************************************************************/
-void IconBoxGetSelectedItems(widget, items, nitems)
- Widget widget;
- XmString **items;
- int *nitems;
-{
- BoxRec *rec;
- IconRec *icon;
- XmString *tmp;
- int cnt;
-
- XtVaGetValues(widget, XmNuserData, &rec, NULL);
-
- if (!rec) return;
-
- *nitems = rec->no_icons;
- if (*nitems == 0) {
- *items = (XmString *) NULL;
- return;
- }
-
- *items = (XmString *)XtMalloc(rec->no_icons * sizeof(XmString));
- tmp = *items;
-
- cnt = 0;
- icon = rec->icons;
- while (icon) {
- if (icon->selected) {
- *tmp++ = icon->label;
- cnt++;
- }
- icon = icon->link;
- }
- *nitems = cnt;
-
- /* get rid of reserved space when no selected icons were found */
- if (cnt == 0) {
- XtFree((char *)*items);
- *items = (XmString *) NULL;
- }
-}
-
-/***********************************************************************
- * *
- * This function returns a XmString containing the last selected *
- * item. The XmString should be freed by the user after usage *
- * (user callable). *
- * *
- ***********************************************************************/
-int IconBoxGetLastSelectedItem(widget, item)
- Widget widget;
- XmString *item;
-{
- BoxRec *rec;
- IconRec *icon;
-
- XtVaGetValues(widget, XmNuserData, &rec, NULL);
-
- if (!rec || !rec->icons || !rec->hit) goto end;
-
- icon = rec->icons;
- while (icon) {
- if (rec->hit == icon->id) {
- *item = XmStringCopy(icon->label);
- return 1;
- }
- icon = icon->link;
- }
-
-end:
- *item = XmStringCreate(" ", XmSTRING_DEFAULT_CHARSET);
- return 0;
-}
-
-/***********************************************************************
- * *
- * This function returns some of the attributes of item, like its *
- * x, y, width, height, icon class and selected attributes. *
- * The function allocates space for the class string, the caller has *
- * to free this space using XtFree to prevent a memory leak. *
- * When the item does not exist the function returns 0 *
- * (user callable). *
- * *
- ***********************************************************************/
-C_DECL_8(int IconBoxGetItemAttr,
- Widget, widget,
- XmString, item,
- int *, x,
- int *, y,
- int *, width,
- int *, height,
- char **, class,
- Boolean *, selected)
-{
- BoxRec *rec;
- IconRec *icon;
-
- XtVaGetValues(widget, XmNuserData, &rec, NULL);
-
- *class = XtCalloc(1, 1);
-
- if (!rec || !rec->icons) return 0;
- if (rec->no_icons == 0) return 0;
-
- UpdatePositions(rec);
-
- icon = rec->icons;
- while (icon) {
- if (XmStringCompare(item, icon->label)) {
- switch (rec->icon_type) {
- case IconBoxBIG_ICON:
- *x = (int) (icon->x + icon->x_off);
- *y = (int) (icon->y + icon->y_off + rec->top);
- *width = (int) icon->pix_w;
- *height = (int) icon->pix_h;
- break;
- case IconBoxSMALL_ICON:
- case IconBoxTITLES:
- *x = (int) (icon->x + icon->x_soff);
- *y = (int) (icon->y + icon->y_soff + rec->top);
- *width = (int) icon->spix_w;
- *height = (int) icon->spix_h;
- break;
- case IconBoxNO_ICON:
- *x = (int) 0;
- *y = (int) 0;
- *width = (int) 0;
- *height = (int) 0;
- break;
- }
- XtFree(*class);
- *class = XtCalloc(strlen(icon->class)+1, 1);
- strcpy(*class, icon->class);
- *selected = icon->selected;
- return 1;
- }
- icon = icon->link;
- }
- return 0;
-}
-
-/***********************************************************************
- * *
- * This function selects the icons of which the names are included *
- * in the array of XmString's (user callable). *
- * *
- ***********************************************************************/
-C_DECL_4(void IconBoxSelectItems,
- Widget, widget,
- XmString *, items,
- int, nitems,
- Boolean, notify)
-{
- BoxRec *rec;
- IconRec *icon;
- XmString *tmp;
- int i;
-
- XtVaGetValues(widget, XmNuserData, &rec, NULL);
-
- if (!rec || !rec->icons) return;
-
- if (items == NULL) return;
- if (nitems == 0) return;
-
- tmp = items;
-
- for (i = 0; i < nitems; i++) {
- icon = rec->icons;
- while (icon) {
- if (XmStringCompare(*tmp, icon->label)) {
- icon->selected = True;
- break;
- }
- icon = icon->link;
- }
- tmp++;
- }
-
- if (rec->exposed)
- RedrawRegion(widget, rec, 0, 0, rec->width, rec->height);
-
- if (notify)
- CallCallback(rec, NULL, XmNmultipleSelectionCallback);
-}
-
-/***********************************************************************
- * *
- * This function selects the icons of which the names (minus the *
- * cycle number) are included in the array of XmString's. For CMZ *
- * only (user callable). *
- * *
- ***********************************************************************/
-C_DECL_5(void IconBoxSelectDecks,
- Widget, widget,
- XmString *, decks,
- int, ndecks,
- Boolean, refresh,
- Boolean, notify)
-{
- BoxRec *rec;
- IconRec *icon;
- XmString *tmp;
- int i;
- char *deck1, *deck2, *s;
- char *label1, *label2;
-
- XtVaGetValues(widget, XmNuserData, &rec, NULL);
-
- if (!rec || !rec->icons) return;
-
- if (decks == NULL) return;
- if (ndecks == 0) return;
-
- tmp = decks;
-
- for (i = 0; i < ndecks; i++) {
- XmStringGetLtoR(*tmp, XmSTRING_DEFAULT_CHARSET, &deck1);
- deck2 = XtCalloc(strlen(deck1)+1, 1);
- s = strchr(deck1,';');
- if (s)
- strncpy(deck2, deck1, (size_t) (s - deck1));
- else
- strcpy(deck2, deck1);
- lower(deck2);
-
- icon = rec->icons;
- while (icon) {
- XmStringGetLtoR(icon->label, XmSTRING_DEFAULT_CHARSET, &label1);
- label2 = XtCalloc(strlen(label1)+1, 1);
- strncpy(label2, label1, (size_t) (strchr(label1,';') - label1));
- lower(label2);
- if (!strcmp(label2, deck2)) {
- icon->selected = True;
- XtFree(label1); XtFree(label2);
- break;
- }
- icon = icon->link;
- XtFree(label1); XtFree(label2);
- }
- tmp++;
- XtFree(deck1); XtFree(deck2);
- }
-
- if (refresh && rec->exposed)
- RedrawRegion(widget, rec, 0, 0, rec->width, rec->height);
-
- if (notify)
- CallCallback(rec, NULL, XmNmultipleSelectionCallback);
-}
-
-/***********************************************************************
- * *
- * This function returns a pointer to an array of integer's *
- * containing the position and the number of selected icons. *
- * When npos<>0 the int array should be freed by the user *
- * after usage (user callable). *
- * *
- ***********************************************************************/
-void IconBoxGetSelectedPos(widget, pos, npos)
- Widget widget;
- int **pos, *npos;
-{
- BoxRec *rec;
- IconRec *icon;
- int *tmp;
- int cnt, ipos;
-
- XtVaGetValues(widget, XmNuserData, &rec, NULL);
-
- if (rec == NULL) return;
-
- *npos = rec->no_icons;
- if (*npos == 0) {
- *pos = (int *) NULL;
- return;
- }
-
- *pos = (int *)XtMalloc(rec->no_icons * sizeof(int));
- tmp = *pos;
-
- cnt = 0;
- ipos = 0;
- icon = rec->icons;
- while (icon) {
- ipos++;
- if (icon->selected) {
- *tmp++ = ipos;
- cnt++;
- }
- icon = icon->link;
- }
- *npos = cnt;
-
- /* get rid of reserved space when no selected icons were found */
- if (cnt == 0) {
- XtFree((char *)*pos);
- *pos = (int *) NULL;
- }
-}
-
-/***********************************************************************
- * *
- * This function selects the icons of which the positions are *
- * included in the array of integers's (user callable). *
- * *
- ***********************************************************************/
-C_DECL_4(void IconBoxSelectPos,
- Widget, widget,
- int *, pos,
- int, npos,
- Boolean, notify)
-{
- BoxRec *rec;
- IconRec *icon;
- int *tmp;
- int i, ipos;
-
- XtVaGetValues(widget, XmNuserData, &rec, NULL);
-
- if (!rec || !rec->icons) return;
-
- if (pos == NULL) return;
- if (npos == 0) return;
-
- tmp = pos;
-
- for (i = 0; i < npos; i++) {
- ipos = 0;
- icon = rec->icons;
- while (icon) {
- ipos++;
- if (*tmp == ipos) {
- icon->selected = True;
- break;
- }
- icon = icon->link;
- }
- tmp++;
- }
-
- if (rec->exposed)
- RedrawRegion(widget, rec, 0, 0, rec->width, rec->height);
-
- if (notify)
- CallCallback(rec, NULL, XmNmultipleSelectionCallback);
-}
-
-/***********************************************************************
- * *
- * This function checks if a specified item is in the IconBox (user *
- * callable). *
- * *
- ***********************************************************************/
-Boolean IconBoxItemExists(widget, item)
- Widget widget;
- XmString item;
-{
- Arg args[1];
- BoxRec *rec;
- IconRec *icon;
-
- XtSetArg(args[0], XmNuserData, &rec);
- XtGetValues(widget, args, 1);
-
- if (!rec || !rec->icons) return False;
-
- icon = rec->icons;
- while (icon) {
- if (XmStringCompare(icon->label, item)) return True;
- icon = icon->link;
- }
- return False;
-}
-
-/***********************************************************************
- * *
- * This function checks if a specified deck is in the IconBox. For *
- * CMZ only (user callable). *
- * *
- ***********************************************************************/
-Boolean IconBoxDeckExists(widget, deck)
- Widget widget;
- XmString deck;
-{
- Arg args[1];
- BoxRec *rec;
- IconRec *icon;
- char *deck1, *deck2, *s;
- char *label1, *label2;
-
- XtSetArg(args[0], XmNuserData, &rec);
- XtGetValues(widget, args, 1);
-
- if (!rec || !rec->icons) return False;
-
- XmStringGetLtoR(deck, XmSTRING_DEFAULT_CHARSET, &deck1);
- deck2 = XtCalloc(strlen(deck1)+1, 1);
- s = strchr(deck1,';');
- if (s)
- strncpy(deck2, deck1, (size_t) (s - deck1));
- else
- strcpy(deck2, deck1);
- lower(deck2);
-
- icon = rec->icons;
- while (icon) {
- XmStringGetLtoR(icon->label, XmSTRING_DEFAULT_CHARSET, &label1);
- label2 = XtCalloc(strlen(label1)+1, 1);
- strncpy(label2, label1, (size_t) (strchr(label1,';') - label1));
- lower(label2);
- if (!strcmp(label2, deck2)) {
- XtFree(deck1); XtFree(deck2); XtFree(label1); XtFree(label2);
- return True;
- }
- icon = icon->link;
- XtFree(label1); XtFree(label2);
- }
- XtFree(deck1); XtFree(deck2);
-
- return False;
-}
-
-/***********************************************************************
- * *
- * ShowIcons redraws one or all icons. *
- * *
- ***********************************************************************/
-static void ShowIcons(widget, rec, icon)
- Widget widget;
- BoxRec *rec;
- IconRec *icon;
-{
- if (icon)
- RedrawRegion (widget, rec,
- icon->x - icon->string_left,
- icon->y + rec->top,
- rec->icon_width + 2 * icon->string_left,
- rec->icon_height + rec->string_height);
- else
- RedrawRegion (widget, rec, 0, 0, rec->width, rec->height);
-}
-
-/***********************************************************************
- * *
- * Update the rubberband box in the rec structure. *
- * *
- ***********************************************************************/
-static void SetRectangle(x, y, rec)
- int x, y;
- BoxRec *rec;
-{
- rec->x_rub = min(rec->x_rubs, x);
- rec->y_rub = min(rec->y_rubs, y);
- rec->w_rub = abs(rec->x_rubs - x);
- rec->h_rub = abs(rec->y_rubs - y);
-}
-
-/***********************************************************************
- * *
- * Check if icon is in rubberband box. *
- * *
- ***********************************************************************/
-static Boolean IconInRectangle(rec, icon)
- BoxRec *rec;
- IconRec *icon;
-{
- if (Intersect(icon->x - icon->string_left,
- icon->y + rec->top,
- rec->icon_width + 2 * icon->string_left,
- rec->icon_height + rec->string_height,
- rec->x_rub, rec->y_rub, rec->w_rub, rec->h_rub))
- return True;
- else
- return False;
-}
-
-/***********************************************************************
- * *
- * Check if doubleclick happened. *
- * *
- ***********************************************************************/
-static Boolean DoubleClick(ev, rec)
- XEvent *ev;
- BoxRec *rec;
-{
- static Time click1 = 0;
- Boolean rtn;
-
- rtn = False;
-
- /* in case of time wrap no double click */
- if (ev->xbutton.time < click1) return(rtn);
-
- if (ev->xbutton.time - click1 <= rec->dc_interval)
- rtn = True;
- click1 = ev->xbutton.time;
-
- return(rtn);
-}
-
-/***********************************************************************
- * *
- * Handle scrollbar changes. *
- * *
- ***********************************************************************/
-static void ScrollBarMoved(widget, rec, call_data)
- Widget widget;
- BoxRec *rec;
- XmScrollBarCallbackStruct *call_data;
-{
- int d, da;
- int old_top = rec->top;
-
- rec->top = -call_data->value;
-
- if (!rec->exposed) return;
-
- switch (call_data->reason) {
- case XmCR_DRAG:
- case XmCR_VALUE_CHANGED:
- /*
- * first copy part of area that is still visible to new place,
- * next redraw only the (small) new region
- */
- d = rec->top - old_top;
- da = abs(d);
- if (da < (int) rec->height) {
- if (d > 0) {
- XCopyArea(XtDisplay(rec->area), XtWindow(rec->area),
- XtWindow(rec->area), rec->normal_gc,
- 0, 0, rec->width, rec->height-da, 0, da);
- RedrawRegion(rec->area, rec, 0, 0, rec->width, da);
- } else if (d < 0) {
- XCopyArea(XtDisplay(rec->area), XtWindow(rec->area),
- XtWindow(rec->area), rec->normal_gc,
- 0, da, rec->width, rec->height-da, 0, 0);
- RedrawRegion(rec->area, rec, 0, rec->height-da, rec->width, da);
- }
- rec->scrolled = True;
- } else
- RedrawRegion(rec->area, rec, 0, 0, rec->width, rec->height);
- }
-}
-
-/***********************************************************************
- * *
- * Handle input callback. *
- * *
- ***********************************************************************/
-static void HandleButtons(widget, rec, call_data)
- Widget widget;
- BoxRec *rec;
- XmDrawingAreaCallbackStruct *call_data;
-{
- XEvent *ev = call_data->event;
- IconRec *icon;
- static unsigned int state;
- static Boolean db_click = False;
-
- if (ev->xany.type == ButtonPress) {
- state = ev->xbutton.state;
- /*
- * double click events
- */
- if (DoubleClick(ev, rec)) {
- if (ev->xbutton.button == 1) {
- db_click = True;
- } else if (ev->xbutton.button == 2) {
-
- } else if (ev->xbutton.button == 3) {
-
- }
- /*
- * mouse button 1 is used to select icons
- */
- } else if (ev->xbutton.button == 1) {
- /*
- * first un-highlight all selected icons except when
- * the control button has been pressed
- */
- if (ev->xbutton.state != ControlMask) {
- SelectIcons(rec, NULL, False);
- ShowIcons(widget, rec, NULL);
- }
-
- rec->hit = Hit(rec, ev->xbutton.x, ev->xbutton.y);
-
- /* start drawing rubberband box */
- rec->rubber = True;
- rec->x_rubs = rec->x_rub = ev->xbutton.x;
- rec->y_rubs = rec->y_rub = ev->xbutton.y;
- rec->w_rub = 0;
- rec->h_rub = 0;
- XDrawRectangle(XtDisplay(widget), XtWindow(widget),
- rec->xor_gc, rec->x_rub, rec->y_rub,
- rec->w_rub, rec->h_rub);
- /*
- * mouse button 2 is used to move icons
- */
- } else if (ev->xbutton.button == 2) {
-
- /*
- * mouse button 3 is not yet used
- */
- } else if (ev->xbutton.button == 3) {
-
- }
-
- /*********************************************************
- * we don't allow any moving for the time being
- *
- if (!rec->hit) return;
- icon = FindIcon(rec, rec->hit);
- rec->x_off = ev->xbutton.x - icon->x;
- rec->y_off = ev->xbutton.y - icon->y;
- *********************************************************/
- } else if (ev->xany.type == ButtonRelease) {
- if (db_click) {
- CallCallback(rec, ev, XmNdefaultActionCallback);
- db_click = False;
- } else if (ev->xbutton.button == 1) {
- if (rec->rubber) {
- /*
- * erase the current rubberband box and update the box info
- */
- XDrawRectangle(XtDisplay(widget), XtWindow(widget),
- rec->xor_gc, rec->x_rub, rec->y_rub,
- rec->w_rub, rec->h_rub);
- SetRectangle(ev->xbutton.x, ev->xbutton.y, rec);
- rec->rubber = False;
- }
- if (rec->w_rub == 0 && rec->h_rub == 0) {
- /* highlight hit icon */
- icon = FindIcon(rec, rec->hit);
- if (icon) {
- if (state != ControlMask) {
- SelectIcons(rec, icon, True);
- ShowIcons(widget, rec, icon);
- CallCallback(rec, ev, XmNsingleSelectionCallback);
- } else {
- if (icon->selected)
- SelectIcons(rec, icon, False);
- else
- SelectIcons(rec, icon, True);
- ShowIcons(widget, rec, icon);
- CallCallback(rec, ev, XmNextendedSelectionCallback);
- }
- }
- } else {
- /* find and highlight icons inside rubberband box */
- icon = rec->icons;
- while (icon) {
- if (IconInRectangle(rec, icon)) {
- if (state != ControlMask) {
- SelectIcons(rec, icon, True);
- } else {
- if (icon->selected)
- SelectIcons(rec, icon, False);
- else
- SelectIcons(rec, icon, True);
- }
- ShowIcons(widget, rec, icon);
- }
- icon = icon->link;
- }
- if (state != ControlMask)
- CallCallback(rec, ev, XmNmultipleSelectionCallback);
- else
- CallCallback(rec, ev, XmNextendedSelectionCallback);
- }
- }
- }
-}
-
-/***********************************************************************
- * *
- * Reposition icons in function of the new width of the box. *
- * *
- ***********************************************************************/
-static void RepositionIcons(rec)
- BoxRec *rec;
-{
- IconRec *icon;
- int pos;
-
- /* calculate the number of columns */
- rec->columns =
- (int) (rec->width) / (int) (rec->icon_width + rec->icon_hspacing);
- if (rec->columns <= 0) rec->columns = 1;
-
- icon = rec->icons;
- pos = 0;
- while (icon) {
- icon->x = (pos % rec->columns) *
- (rec->icon_width + rec->icon_hspacing) +
- rec->icon_hspacing/2;
- icon->y = (pos / rec->columns) *
- (rec->icon_height + rec->string_height + rec->icon_vspacing) +
- rec->icon_vspacing/2;
- icon = icon->link;
- pos++;
- }
-}
-
-/***********************************************************************
- * *
- * Handle resize callback. *
- * *
- ***********************************************************************/
-static void HandleResize (widget, rec, call_data)
- Widget widget;
- BoxRec *rec;
- XmDrawingAreaCallbackStruct *call_data;
-{
- Arg args[2];
- Dimension oldw;
- int value, ovalue;
-
- oldw = rec->width;
- rec->exposed = False;
-
- XtSetArg (args[0], XmNwidth, &rec->width);
- XtSetArg (args[1], XmNheight, &rec->height);
- XtGetValues (widget, args, 2);
-
- XtSetArg(args[0], XmNvalue, &ovalue);
- XtGetValues(rec->scrollbar, args, 1);
-
- /* only when width changes reposition the icons */
- if (rec->width != oldw) {
- RepositionIcons(rec);
- rec->virt_height = GetVirtHeight(rec);
- }
-
- SetScrollBar(widget, rec);
-
- XtSetArg(args[0], XmNvalue, &value);
- XtGetValues(rec->scrollbar, args, 1);
-
- if (ovalue != value)
- RedrawRegion(widget, rec, 0, 0, rec->width, rec->height);
- else {
- /*
- * explicitely call the expose callback because sometimes when
- * shrinking the window it is not called automatically
- */
- SendExpose(widget);
- }
-}
-
-/***********************************************************************
- * *
- * Send an expose event to a widget. *
- * *
- ***********************************************************************/
-static void SendExpose(widget)
- Widget widget;
-{
- Arg args[1];
- BoxRec *rec;
- XmDrawingAreaCallbackStruct da_struct;
-
- XtSetArg (args[0], XmNuserData, &rec);
- XtGetValues (widget, args, 1);
-
- rec->redraw_all = True;
-
- /* explicitely call the expose callback */
- da_struct.reason = XmCR_EXPOSE;
- da_struct.event = (XEvent *) NULL;
- da_struct.window = XtWindow(widget);
- XtCallCallbacks(widget, XmNexposeCallback, &da_struct);
-}
-
-/***********************************************************************
- * *
- * Wait for ms milliseconds. Used by IconBoxZoom. *
- * *
- ***********************************************************************/
-static void delay(ms)
- int ms;
-{
-#if defined(UNIX) && !defined(APOLLO)
- struct timeval t_start, t_end;
- unsigned int elapsed;
-
- gettimeofday(&t_start, NULL);
-
- do {
- gettimeofday(&t_end, NULL);
- elapsed = (t_end.tv_sec * 1000000 + t_end.tv_usec) -
- (t_start.tv_sec * 1000000 + t_start.tv_usec);
- } while (elapsed <= ms*1000);
-#endif
-}
-
-
-/***********************************************************************
- * *
- * Make a zoom effect starting from or going to rect (x, y, w, h). *
- * The zoom is always to or from the full IconBox area *
- * (user callable). *
- * *
- ***********************************************************************/
-C_DECL_6(void IconBoxZoom,
- Widget, widget,
- int, x,
- int, y,
- int, width,
- int, height,
- Boolean, expand)
-{
- BoxRec *rec;
- int i, unit;
- struct { int left, top, right, bottom; } r[17], sr, dr;
-
- XtVaGetValues(widget, XmNuserData, &rec, NULL);
-
- if (!rec) return;
- if (!rec->zoom_effect) return;
- if (!rec->exposed) return;
-
- if (expand) {
- sr.left = x;
- sr.top = y;
- sr.right = x + width;
- sr.bottom = y + height;
-
- dr.left = 0;
- dr.top = 0;
- dr.right = rec->width;
- dr.bottom = rec->height;
- } else {
- sr.left = 0;
- sr.top = 0;
- sr.right = rec->width;
- sr.bottom = rec->height;
-
- dr.left = x;
- dr.top = y;
- dr.right = x + width;
- dr.bottom = y + height;
- }
-
- for (i = 0; i <= 22; i++) {
- if (i <= 16) {
- r[i] = sr;
- unit = (expand?i+1:33-i)*i/2;
-
- r[i].top += (unit*(dr.top-sr.top))/136;
- r[i].left += (unit*(dr.left-sr.left))/136;
- r[i].bottom += (unit*(dr.bottom-sr.bottom))/136;
- r[i].right += (unit*(dr.right-sr.right))/136;
-
- XDrawRectangle(XtDisplay(widget), XtWindow(widget),
- rec->xor_gc, r[i].left, r[i].top,
- (Dimension)(r[i].right-r[i].left),
- (Dimension)(r[i].bottom-r[i].top));
-
- XSync(XtDisplay(widget), False);
- }
- if (i >= 6) {
- XDrawRectangle(XtDisplay(widget), XtWindow(widget),
- rec->xor_gc, r[i-6].left, r[i-6].top,
- (Dimension)(r[i-6].right-r[i-6].left),
- (Dimension)(r[i-6].bottom-r[i-6].top));
-
- XSync(XtDisplay(widget), False);
- }
-
- /* slow down factor */
- delay(rec->zoom_speed);
- }
-}
-
-/************************** Handle movement ****************************/
-
-/***********************************************************************
- * *
- * Find rectangle invalidated by move. *
- * *
- ***********************************************************************/
-#ifdef UNREF
-static void FindInvalidRect(rec, new_x, new_y, x, y, width, height)
- BoxRec *rec;
- int new_x, new_y;
- int *x, *y;
- Dimension *width, *height;
-{
- int xmove, ymove;
- IconRec *icon = FindIcon(rec, rec->hit);
-
- /* check movement in X direction */
- xmove = new_x - icon->x;
- if (xmove > 0) {
- *x = icon->x - icon->string_left;
- *width = rec->icon_width + xmove + 2 * icon->string_left;
- } else {
- *x = icon->x + xmove - icon->string_left;
- *width = rec->icon_width - xmove + 2 * icon->string_left;
- }
-
- /* check movement in Y direction */
- ymove = new_y - icon->y;
- if (ymove > 0) {
- *y = icon->y;
- *height = rec->icon_height + rec->string_height + ymove;
- } else {
- *y = icon->y + ymove;
- *height = rec->icon_height + rec->string_height - ymove;
- }
-}
-#endif /* UNREF */
-
-/***********************************************************************
- * *
- * Handle motion events. *
- * *
- ***********************************************************************/
-static void HandleMove (widget, rec, ev)
- Widget widget;
- BoxRec *rec;
- XEvent *ev;
-{
- if (rec->rubber) {
- /* draw once to clear the previous rubberband box */
- XDrawRectangle(XtDisplay(widget), XtWindow(widget),
- rec->xor_gc, rec->x_rub, rec->y_rub,
- rec->w_rub, rec->h_rub);
-
- /* update the rectangle */
- SetRectangle(ev->xbutton.x, ev->xbutton.y, rec);
-
- /* draw the new box */
- XDrawRectangle(XtDisplay(widget), XtWindow(widget),
- rec->xor_gc, rec->x_rub, rec->y_rub,
- rec->w_rub, rec->h_rub);
- }
-#if 0
- /**********************************************
- * No moving icons for the time being
-
- IconRec *icon;
- Dimension width, height;
- int new_x, new_y;
- int x, y;
-
- if (!rec->hit) return;
-
- * constrain motion *
- new_x = ev->xmotion.x - rec->x_off;
- if (new_x < 0)
- new_x = 0;
- if (new_x > rec->width - rec->icon_width)
- new_x = rec->width - rec->icon_width;
- new_y = ev->xmotion.y - rec->y_off;
- if (new_y < 0)
- new_y = 0;
- if (new_y > rec->height - rec->icon_height - rec->string_height)
- new_y = rec->height - rec->icon_height - rec->string_height;
-
- * find affected region *
- FindInvalidRect (rec, new_x, new_y, &x, &y, &width, &height);
-
- * set new position... *
- icon = FindIcon(rec, rec->hit);
- icon->x = new_x;
- icon->y = new_y;
-
- * ...and redraw region *
- RedrawRegion (widget, rec, x, y, width, height);
- ***********************************************************/
-#endif
-}
-
-/***********************************************************************
- * *
- * Handle GraphicsExpose events. *
- * *
- * Workaround for DrawingArea widget deficiency: *
- * If a GraphicsExpose is recieved, redraw the window by calling the *
- * DrawingArea widget's XmNexposeCallback list. *
- * *
- ***********************************************************************/
-static void HandleGraphicsExposures(widget, rec, ev)
- Widget widget;
- BoxRec *rec;
- XEvent *ev;
-{
- /*
- * This routine will be called for all non-maskable events. Make sure
- * it's the type we want.
- */
- if (ev->type == GraphicsExpose) {
-
- XmDrawingAreaCallbackStruct cb;
- /*
- * Fill out a call data struct.
- */
- cb.reason = XmCR_EXPOSE;
- cb.event = ev;
- cb.window = XtWindow(widget);
- /*
- * Invoke all handlers on the XmNexposeCallback list.
- */
- XtCallCallbacks(widget, XmNexposeCallback, &cb);
- }
-}
-
-/***********************************************************************
- * *
- * Delete icon from the IconBox (user callable). *
- * *
- ***********************************************************************/
-C_DECL_3(void IconBoxDeleteItem,
- Widget, widget,
- XmString, item,
- Boolean, refresh)
-{
- Arg args[1];
- BoxRec *rec;
- IconRec *tmp1, *tmp2;
-
- XtSetArg (args[0], XmNuserData, &rec);
- XtGetValues (widget, args, 1);
-
- if (!rec || !rec->icons) return;
-
- tmp1 = rec->icons;
- tmp2 = NULL;
-
- while (tmp1) {
- if (XmStringCompare(tmp1->label, item)) break;
- tmp2 = tmp1;
- tmp1 = tmp1->link;
- }
-
- /* item not found */
- if (!tmp1) return;
-
- if (tmp1) {
- XtFree(tmp1->mask_name);
- XtFree(tmp1->pix_name);
- XtFree(tmp1->mask_sname);
- XtFree(tmp1->pix_sname);
- XmStringFree(tmp1->label);
- if (tmp2) {
- tmp2->link = tmp1->link;
- if (rec->last_icon == tmp1) rec->last_icon = tmp2;
- } else {
- rec->icons = tmp1->link;
- if (rec->last_icon == tmp1) rec->last_icon = NULL;
- }
- XtFree((char *)tmp1);
- }
- rec->no_icons--;
-
- CenterPixmap(rec, NULL,
- rec->min_big_width, rec->min_big_height,
- rec->min_small_width, rec->min_small_height);
-
- if (refresh)
- IconBoxRefresh(widget);
-}
-
-/***********************************************************************
- * *
- * Delete all icons from the IconBox (user callable). *
- * *
- ***********************************************************************/
-C_DECL_2(void IconBoxDeleteAllItems,
- Widget, widget,
- Boolean, refresh)
-{
- Arg args[1];
- BoxRec *rec;
- IconRec *tmp1, *tmp2;
-
- XtSetArg (args[0], XmNuserData, &rec);
- XtGetValues (widget, args, 1);
-
- if (!rec || !rec->icons) return;
-
- /* free records */
- tmp1 = rec->icons;
- while (tmp1) {
- XtFree(tmp1->mask_name);
- XtFree(tmp1->pix_name);
- XtFree(tmp1->mask_sname);
- XtFree(tmp1->pix_sname);
- XmStringFree(tmp1->label);
- tmp2 = tmp1;
- tmp1 = tmp1->link;
- XtFree((char *)tmp2);
- }
- rec->icons = NULL;
- rec->last_icon = NULL;
- rec->no_icons = 0;
- rec->last_id = 0;
-
- /* reset minimum pixmap sizes */
- rec->icon_big_width = rec->min_big_width;
- rec->icon_big_height = rec->min_big_height;
- rec->icon_small_width = rec->min_small_width;
- rec->icon_small_height = rec->min_small_height;
-
- if (refresh)
- IconBoxRefresh(widget);
-}
-
-/***********************************************************************
- * *
- * Handle destroy callback. *
- * *
- ***********************************************************************/
-static void DestroyIconBox(widget, rec, call_data)
- Widget widget;
- BoxRec *rec;
- caddr_t call_data;
-{
- IconRec *tmp1, *tmp2;
-
- /* free records */
- tmp1 = rec->icons;
- while (tmp1) {
- XtFree(tmp1->pix_name);
- XtFree(tmp1->mask_name);
- XtFree(tmp1->pix_sname);
- XtFree(tmp1->mask_sname);
- XmStringFree(tmp1->label);
- tmp2 = tmp1;
- tmp1 = tmp1->link;
- XtFree((char *)tmp2);
- }
- if (rec->back) {
- XFreePixmap(XtDisplay(widget), rec->back);
- XFreeGC(XtDisplay(widget), rec->draw_gc);
- XtReleaseGC(widget, rec->normal_gc);
- XtReleaseGC(widget, rec->xor_gc);
- }
- if (rec->box_icon) {
- XFreePixmap(XtDisplay(widget), rec->box_icon);
- XFreePixmap(XtDisplay(widget), rec->box_hi_icon);
- }
- if (rec->box_sicon) {
- XFreePixmap(XtDisplay(widget), rec->box_sicon);
- XFreePixmap(XtDisplay(widget), rec->box_hi_sicon);
- }
- XtFree((char *)rec);
-}
diff --git a/src/packlib/kuip/code_motif/iconwidget.c b/src/packlib/kuip/code_motif/iconwidget.c
deleted file mode 100644
index f454574..0000000
--- a/src/packlib/kuip/code_motif/iconwidget.c
+++ /dev/null
@@ -1,585 +0,0 @@
-/*
- * $Id: iconwidget.c,v 1.2 2006/12/19 10:00:41 mclareni Exp $
- *
- * $Log: iconwidget.c,v $
- * Revision 1.2 2006/12/19 10:00:41 mclareni
- * Correction for MacOSX
- *
- * Revision 1.1.1.1 1996/03/08 15:33:10 mclareni
- * Kuip
- *
- */
-/*CMZ : 2.06/10 03/03/95 16.31.10 by N.Cremel*/
-/*-- Author : Nicole Cremel 27/05/92*/
-/*
- * IconWidget.c
- */
-
-/*
- * Copyright 1991 Addison-Wesley Publishing Company
- * (see the file "COPYRIGHTS" for details)
- */
-
-#include <X11/Intrinsic.h>
-#include <X11/IntrinsicP.h>
-#include <Xm/Xm.h>
-#include <Xm/XmP.h>
-#include <Xm/Label.h>
-#include <Xm/LabelP.h>
-/* #include "IconWidget.h" */
-#include "icwid.h"
-/* #include "IconWidgetP.h" */
-#include "icwidp.h"
-
-/* _Xm routine definitions */
-void _XmHighlightBorder ();
-void _XmUnhighlightBorder ();
-#ifndef __APPLE__
-void _XmDrawShadow ();
-#endif
-
-/* Motif1.1 ( except apollo, hpux has _XmPrimitive... with two args only
- * Gunter 30-jan-95
- */
-#if XmVERSION == 1 && XmREVISION == 1
-#if !defined(__hpux) && !defined(__apollo)
-#define _XmPrimitive_has_two_args
-#endif
-#endif
-
-/* Static routine definitions */
-
-static void Initialize ();
-static Boolean SetValues ();
-static void Redisplay ();
-static void Destroy ();
-
-static void Arm ();
-static void Activate ();
-static void Disarm ();
-static void Enter ();
-static void Leave ();
-static void Help();
-
-static void GetPixmapSize ();
-static void DrawShadow ();
-
-/* Default translation table and action list */
-
-static char defaultTranslations[] =
- "<EnterWindow>: Enter() \n\
- <LeaveWindow>: Leave()";
-
-static XtActionsRec actionsList[] =
-{
- { "Arm", (XtActionProc) Arm },
- { "Activate", (XtActionProc) Activate },
- { "Disarm", (XtActionProc) Disarm },
- { "Enter", (XtActionProc) Enter },
- { "Leave", (XtActionProc) Leave },
- { "Help", (XtActionProc) Help }
-};
-
-static XtResource resources[] =
-{
- {
- XmNshadowThickness, XmCShadowThickness, XmRShort, sizeof (short),
- XtOffset (XmPrimitiveWidget, primitive.shadow_thickness),
- XmRImmediate, (caddr_t) 2
- },
-
- {
- XmNiconOffset, XmCIconOffset, XmRShort, sizeof(short),
- XtOffset (IconWidget, icon.offset),
- XmRImmediate, (caddr_t) 0
- },
-
- {
- XmNshadowType, XmCShadowType, XmRShadowType, sizeof(unsigned char),
- XtOffset (IconWidget, icon.shadow_type),
- XmRImmediate, (caddr_t) XmSHADOW_OUT
- },
-
- {
- XmNactivateCallback, XmCCallback, XmRCallback, sizeof(XtCallbackList),
- XtOffset (IconWidget, icon.activate_callback),
- XmRPointer, (caddr_t) NULL
- },
-
- {
- XmNarmCallback, XmCCallback, XmRCallback, sizeof(XtCallbackList),
- XtOffset (IconWidget, icon.arm_callback),
- XmRPointer, (caddr_t) NULL
- },
-
- {
- XmNdisarmCallback, XmCCallback, XmRCallback, sizeof(XtCallbackList),
- XtOffset (IconWidget, icon.disarm_callback),
- XmRPointer, (caddr_t) NULL
- },
-
-};
-
-/* The IconWidget class record definition */
-
-IconWidgetClassRec iconWidgetClassRec =
-{
- {
- (WidgetClass) &xmLabelClassRec, /* superclass */
- "IconWidget", /* class_name */
- sizeof(IconWidgetRec), /* widget_size */
- NULL, /* class_initialize */
- NULL, /* class_part_initialize */
- FALSE, /* class_inited */
- (XtInitProc) Initialize, /* initialize */
- NULL, /* initialize_hook */
- XtInheritRealize, /* realize */
- actionsList, /* actions */
- XtNumber(actionsList), /* num_actions */
- resources, /* resources */
- XtNumber(resources), /* num_resources */
- NULLQUARK, /* xrm_class */
- TRUE, /* compress_motion */
- TRUE, /* compress_exposure */
- TRUE, /* compress_enterleave */
- FALSE, /* visible_interest */
- Destroy, /* destroy */
- XtInheritResize, /* resize */
- (XtExposeProc) Redisplay, /* expose */
- (XtSetValuesFunc) SetValues, /* set_values */
- NULL, /* set_values_hook */
- XtInheritSetValuesAlmost, /* set_values_almost */
- NULL, /* get_values_hook */
- NULL, /* accept_focus */
- XtVersion, /* version */
- NULL, /* callback private */
- defaultTranslations, /* tm_table */
- NULL, /* query_geometry */
- NULL, /* display_accelerator */
- NULL, /* extension */
- },
-
- {
- (XtWidgetProc) _XtInherit, /* Primitive border_highlight */
- (XtWidgetProc) _XtInherit, /* Primitive border_unhighlight */
- XtInheritTranslations, /* translations */
- NULL, /* arm_and_activate */
- NULL, /* get resources */
- 0, /* num get_resources */
- NULL, /* extension */
- },
-
- {
- (XtWidgetProc) _XtInherit, /* SetOverrideCallback */
- (XmMenuProc) _XtInherit, /* SetWhichButton */
- XtInheritTranslations, /* menu traversal xlation */
- NULL, /* extension */
- },
-
- {
- NULL, /* extension */
- }
-};
-
-WidgetClass iconWidgetClass = (WidgetClass) &iconWidgetClassRec;
-
-
-/************************************************************************
- *
- * Initialize
- * Get geometry if pixmap already there
- *
- ************************************************************************/
-
-static void Initialize (request, new)
- IconWidget request, new;
-
-{
- if (new -> icon.shadow_type != XmSHADOW_IN &&
- new -> icon.shadow_type != XmSHADOW_OUT)
- {
- new -> icon.shadow_type = XmSHADOW_OUT;
- }
-
- GetPixmapSize (new);
- new->icon.armed = False;
-}
-
-/************************************************************************
- *
- * GetPixmapSize
- * Get geometry if pixmap already there
- *
- ************************************************************************/
-
-static void GetPixmapSize (iw)
- IconWidget iw;
-{
- Window root;
- int junk;
- unsigned int w, h, junk1;
-
- if (iw->label.pixmap != XmUNSPECIFIED_PIXMAP) {
- XGetGeometry (XtDisplay (iw), (Pixmap) iw->label.pixmap,
- &root, &junk, &junk,
- &w, &h,
- &junk1, &junk1);
- iw->icon.width = (short) w;
- iw->icon.height = (short) h;
- }
-}
-
-/************************************************************************
- *
- * Redisplay
- * Handle expose events
- *
- ************************************************************************/
-
-static void Redisplay(w, event, region)
- Widget w;
- XEvent *event;
- Region region;
-{
- IconWidget iw = (IconWidget) w;
- short shad = iw->primitive.shadow_thickness +
- iw->primitive.highlight_thickness;
- short avail;
-
-
- /* use the label's expose first */
- (* iw->core.widget_class->core_class.superclass->core_class.expose)
- (w, event, region);
-
- /* copy the pixmap into the space left by margin_top */
- if (iw->label.pixmap != XmUNSPECIFIED_PIXMAP) {
- avail = iw->core.width - 2 * shad - 2 * iw->label.margin_width -
- iw->label.margin_left - iw->label.margin_right - iw->icon.width;
- XCopyArea (XtDisplay (w), iw->label.pixmap, XtWindow (w),
- iw->label.normal_GC, 0, 0,
- iw->icon.width,
- (int) iw->icon.height > (int) iw->label.margin_top ?
- iw->label.margin_top : iw->icon.height,
- avail/2 + shad +
- iw->label.margin_width - iw->label.margin_left,
- iw->label.TextRect.y - iw->icon.height -
- iw->icon.offset);
- }
-
- /* draw the shadow */
- DrawShadow (iw, True);
-
- /* for keyboard traversal */
- if (iw->primitive.highlighted)
- _XmHighlightBorder(w);
- else if (_XmDifferentBackground (w, XtParent (w)))
- _XmUnhighlightBorder(w);
-}
-
-/************************************************************************
- *
- * DrawShadow
- *
- ************************************************************************/
-
-static void DrawShadow (iw, really)
- IconWidget iw;
- Boolean really;
-{
- Boolean in = (iw->icon.armed && really) ||
- iw->icon.shadow_type == XmSHADOW_IN;
-
- if ((iw->primitive.shadow_thickness) > 0 && XtIsRealized (iw)) {
- _XmDrawShadow (XtDisplay (iw), XtWindow (iw),
- in ? iw->primitive.bottom_shadow_GC :
- iw->primitive.top_shadow_GC,
- in ? iw->primitive.top_shadow_GC :
- iw->primitive.bottom_shadow_GC,
- iw->primitive.shadow_thickness,
- iw->primitive.highlight_thickness,
- iw->primitive.highlight_thickness,
- (int)iw->core.width-2*iw->primitive.highlight_thickness,
- (int)iw->core.height-2*iw->primitive.highlight_thickness);
- }
-}
-
-
-
-/************************************************************************
- *
- * SetValues
- * Update geometry, pixmap might have changed
- *
- ************************************************************************/
-
-static Boolean SetValues(current, request, neww)
- Widget current, request, neww;
-{
- IconWidget cur = (IconWidget) current;
- IconWidget new = (IconWidget) neww;
- IconWidget req = (IconWidget) request;
-
- if (new -> icon.shadow_type != XmSHADOW_IN &&
- new -> icon.shadow_type != XmSHADOW_OUT)
- {
- new -> icon.shadow_type = XmSHADOW_OUT;
- }
-
- GetPixmapSize (new);
-
- if (new->icon.shadow_type != cur->icon.shadow_type ||
- new->primitive.highlight_thickness !=
- cur->primitive.highlight_thickness ||
- new->primitive.shadow_thickness !=
- cur->primitive.shadow_thickness)
- {
- return True;
- }else{
- return False;
- }
-}
-
-
-/************************************************************************
- *
- * Destroy
- * Clean up allocated resources when the widget is destroyed.
- *
- ************************************************************************/
-
-static void Destroy (iw)
- IconWidget iw;
-
-{
- XtRemoveAllCallbacks ((Widget) iw, XmNactivateCallback);
- XtRemoveAllCallbacks ((Widget) iw, XmNarmCallback);
- XtRemoveAllCallbacks ((Widget) iw, XmNdisarmCallback);
-}
-
-/************************************************************************
- *
- * Enter
- *
- ************************************************************************/
-
-static void Enter (iw, event)
- IconWidget iw;
- XEvent * event;
-
-{
- String *params;
- Cardinal num_params;
-
-#ifdef _XmPrimitive_has_two_args
- _XmPrimitiveEnter ((XmPrimitiveWidget) iw, event);
-#else
- _XmPrimitiveEnter ((Widget) iw, event, params, &num_params);
-#endif
-
- if (iw->icon.armed)
- DrawShadow ((Widget) iw, True);
-}
-
-/************************************************************************
- *
- * Leave
- *
- ************************************************************************/
-
-static void Leave (iw, event)
- IconWidget iw;
- XEvent * event;
-
-{
- String *params;
- Cardinal num_params;
-
-#ifdef _XmPrimitive_has_two_args
- _XmPrimitiveLeave ((XmPrimitiveWidget) iw, event);
-#else
- _XmPrimitiveLeave ((Widget) iw, event, params, &num_params);
-#endif
-
- if (iw->icon.armed)
- DrawShadow (iw, False);
-}
-
-/************************************************************************
- *
- * Arm
- *
- ************************************************************************/
-
-static void Arm (iw, event)
- IconWidget iw;
- XEvent * event;
-
-{
- XmAnyCallbackStruct call_value;
-
- iw->icon.armed = True;
- DrawShadow (iw, True);
-
- if (iw->icon.arm_callback) {
- XFlush(XtDisplay (iw));
- call_value.reason = XmCR_ARM;
- call_value.event = event;
- XtCallCallbackList ((Widget) iw, iw->icon.arm_callback, &call_value);
- }
-}
-
-/************************************************************************
- *
- * Activate
- *
- ************************************************************************/
-
-static void Activate (iw, event)
- IconWidget iw;
- XEvent * event;
-
-{
- XmAnyCallbackStruct call_value;
-
- if ((event->xany.type == ButtonPress || event->xany.type == ButtonRelease)
- && ((int) event->xbutton.x > (int) iw->core.width ||
- (int) event->xbutton.y > (int) iw->core.height))
- return;
-
- call_value.reason = XmCR_ACTIVATE;
- call_value.event = event;
- XtCallCallbackList ((Widget) iw, iw->icon.activate_callback, &call_value);
-}
-
-/************************************************************************
- *
- * Disarm
- *
- ************************************************************************/
-
-static void Disarm (iw, event)
- IconWidget iw;
- XEvent * event;
-
-{
- XmAnyCallbackStruct call_value;
-
- iw->icon.armed = False;
- DrawShadow (iw, True);
-
- if (iw->icon.disarm_callback) {
- XFlush(XtDisplay (iw));
- call_value.reason = XmCR_DISARM;
- call_value.event = event;
- XtCallCallbackList ((Widget) iw, iw->icon.disarm_callback, &call_value);
- }
-}
-
-/************************************************************************
- *
- * Help
- * This function processes Function Key 1 press
- *
- ************************************************************************/
-
-static void Help (iw, event)
- IconWidget iw;
- XEvent * event;
-
-{
- XmAnyCallbackStruct call_value;
-
- call_value.reason = XmCR_HELP;
- call_value.event = event;
- XtCallCallbackList ((Widget) iw, iw->primitive.help_callback, &call_value);
-}
-
-/************************************************************************
- *
- * CreateIconLabel
- * Create an instance of an icon as label
- *
- ************************************************************************/
-
-Widget CreateIconLabel (parent, name, arglist, argcount, pixmap)
- Widget parent;
- char *name;
- ArgList arglist;
- Cardinal argcount;
- char *pixmap;
-
-{
- Widget w;
- Pixmap pix;
- Arg args[1];
-
- w = XtCreateManagedWidget (name, iconWidgetClass,
- parent, arglist, argcount);
-
- if (pixmap != NULL && pixmap != "") {
- pix = XmGetPixmap (((IconWidget) w)->core.screen,
- pixmap,
- ((IconWidget) w)->primitive.foreground,
- ((IconWidget) w)->core.background_pixel);
- if (pix != (Pixmap) NULL) {
- XtSetArg (args[0], XmNlabelPixmap, pix);
- XtSetValues (w, args, 1);
- }
- }
-
- return w;
-}
-
-/************************************************************************
- *
- * CreateIconButton
- * Create an instance of an icon as button
- *
- ************************************************************************/
-
-#define BUT_TRANS "#override <Btn1Down>: Arm()\n<Btn1Up>: Activate() Disarm()"
-
-Widget CreateIconButton (parent, name, arglist, argcount, pixmap)
- Widget parent;
- char *name;
- ArgList arglist;
- Cardinal argcount;
- char *pixmap;
-
-{
- Widget w;
- Pixmap pix;
- Arg args[1];
- XtTranslations parsed = XtParseTranslationTable (BUT_TRANS);
-
- w = XtCreateManagedWidget (name, iconWidgetClass,
- parent, arglist, argcount);
-
- if (pixmap != NULL && pixmap != "") {
- pix = XmGetPixmap (((IconWidget) w)->core.screen,
- pixmap,
- ((IconWidget) w)->primitive.foreground,
- ((IconWidget) w)->core.background_pixel);
- if (pix != (Pixmap) NULL) {
- XtSetArg (args[0], XmNlabelPixmap, pix);
- XtSetValues (w, args, 1);
- }
- }
-
- XtAugmentTranslations (w, parsed);
-
- return w;
-}
-
-Widget CreateIconWidget (parent, name, arglist, argcount)
- Widget parent;
- char *name;
- ArgList arglist;
- Cardinal argcount;
-{
- Widget w;
-
- w = XtCreateWidget (name, iconWidgetClass, parent, arglist, argcount);
-
- return w;
-}
diff --git a/src/packlib/kuip/code_motif/icsdbm.h b/src/packlib/kuip/code_motif/icsdbm.h
deleted file mode 100644
index 301c4f1..0000000
--- a/src/packlib/kuip/code_motif/icsdbm.h
+++ /dev/null
@@ -1,16 +0,0 @@
-/*
- * $Id: icsdbm.h,v 1.1.1.1 1996/03/08 15:33:11 mclareni Exp $
- *
- * $Log: icsdbm.h,v $
- * Revision 1.1.1.1 1996/03/08 15:33:11 mclareni
- * Kuip
- *
- */
-/* default_sicon.bm */
-#define default_sicon_width 14
-#define default_sicon_height 16
-static unsigned char default_sicon_bits[] = {
- 0xff, 0x3f, 0x01, 0x20, 0x01, 0x20, 0x7d, 0x26, 0x01, 0x20, 0xbd, 0x25,
- 0x01, 0x20, 0x6d, 0x23, 0x01, 0x20, 0x9d, 0x21, 0x01, 0x20, 0xdd, 0x26,
- 0x01, 0x20, 0xdd, 0x23, 0x01, 0x20, 0xff, 0x3f};
-
diff --git a/src/packlib/kuip/code_motif/icwid.h b/src/packlib/kuip/code_motif/icwid.h
deleted file mode 100644
index 42c8ba8..0000000
--- a/src/packlib/kuip/code_motif/icwid.h
+++ /dev/null
@@ -1,64 +0,0 @@
-/*
- * $Id: icwid.h,v 1.1.1.1 1996/03/08 15:33:11 mclareni Exp $
- *
- * $Log: icwid.h,v $
- * Revision 1.1.1.1 1996/03/08 15:33:11 mclareni
- * Kuip
- *
- */
-
-/* IconWidget.h */
-
-/*
- * Copyright 1991 Addison-Wesley Publishing Company
- * (see the file "COPYRIGHTS" for details)
- */
-
-#ifndef _IconWidget_h
-#define _IconWidget_h
-
-#ifndef NeedFunctionPrototypes
-#define NeedFunctionPrototypes 0
-#endif
-
-#include <Xm/Xm.h>
-
-#define XmNiconOffset "iconOffset"
-#define XmCIconOffset "IconOffset"
-
-extern WidgetClass iconWidgetClass;
-
-typedef struct _IconWidgetClassRec * IconWidgetClass;
-typedef struct _IconWidgetRec * IconWidget;
-
-Widget CreateIconLabel (
-#if NeedFunctionPrototypes
- Widget /* parent */,
- char* /* name */,
- ArgList /* arglist */,
- Cardinal /* argcount */,
- char* /* pixmap */
-#endif
-);
-
-Widget CreateIconButton (
-#if NeedFunctionPrototypes
- Widget /* parent */,
- char* /* name */,
- ArgList /* arglist */,
- Cardinal /* argcount */,
- char* /* pixmap */
-#endif
-);
-
-Widget CreateIconWidget (
-#if NeedFunctionPrototypes
- Widget /* parent */,
- char* /* name */,
- ArgList /* arglist */,
- Cardinal /* argcount */
-#endif
-);
-
-#endif /* _IconWidget_h */
-/* DON'T ADD ANYTHING AFTER THIS #endif */
diff --git a/src/packlib/kuip/code_motif/icwidp.h b/src/packlib/kuip/code_motif/icwidp.h
deleted file mode 100644
index 8a6091a..0000000
--- a/src/packlib/kuip/code_motif/icwidp.h
+++ /dev/null
@@ -1,75 +0,0 @@
-/*
- * $Id: icwidp.h,v 1.1.1.1 1996/03/08 15:33:12 mclareni Exp $
- *
- * $Log: icwidp.h,v $
- * Revision 1.1.1.1 1996/03/08 15:33:12 mclareni
- * Kuip
- *
- */
-
-/* IconWidgetP.h */
-
-/*
- * Copyright 1991 Addison-Wesley Publishing Company
- * (see the file "COPYRIGHTS" for details)
- */
-
-#ifndef _IconWidgetP_h
-#define _IconWidgetP_h
-
-/* #include "IconWidget.h" */
-#include "icwid.h"
-#include <Xm/XmP.h>
-
-/* Icon class structure */
-
-typedef struct _IconWidgetClassPart
-{
- caddr_t extension;
-} IconWidgetClassPart;
-
-
-/* Full class record declaration for Icon class */
-
-typedef struct _IconWidgetClassRec
-{
- CoreClassPart core_class;
- XmPrimitiveClassPart primitive_class;
- XmLabelClassPart label_class;
- IconWidgetClassPart icon_class;
-} IconWidgetClassRec;
-
-extern IconWidgetClassRec iconWidgetClassRec;
-
-
-/* The icon widget instance record */
-
-typedef struct _IconWidgetPart
-{
- short offset;
- short width,
- height;
- unsigned char shadow_type;
- Boolean armed;
- XtCallbackList activate_callback;
- XtCallbackList arm_callback;
- XtCallbackList disarm_callback;
-} IconWidgetPart;
-
-
-/* Full instance record declaration */
-
-typedef struct _IconWidgetRec
-{
- CorePart core;
- XmPrimitivePart primitive;
- XmLabelPart label;
- IconWidgetPart icon;
-} IconWidgetRec;
-
-#ifndef XtSpecificationRelease
-#define XtCallCallbackList(w,cb,cd) XtWidgetCallCallbacks(cb,cd)
-#endif
-
-#endif /* _IconWidgetP_h */
-/* DON'T ADD ANYTHING AFTER THIS #endif */
diff --git a/src/packlib/kuip/code_motif/kmbfdi.c b/src/packlib/kuip/code_motif/kmbfdi.c
deleted file mode 100644
index 91632a5..0000000
--- a/src/packlib/kuip/code_motif/kmbfdi.c
+++ /dev/null
@@ -1,42 +0,0 @@
-/*
- * $Id: kmbfdi.c,v 1.1.1.1 1996/03/08 15:33:08 mclareni Exp $
- *
- * $Log: kmbfdi.c,v $
- * Revision 1.1.1.1 1996/03/08 15:33:08 mclareni
- * Kuip
- *
- */
-/*CMZ : 2.01/00 18/02/93 11.15.03 by Alfred Nathaniel*/
-/*-- Author : N.Cremel 27/10/92*/
-
-#include "kuip/kuip.h"
-#include "kuip/kfor.h"
-#include "kuip/klink.h"
-#include "kuip/kmenu.h"
-#include "mkdims.h"
-
-
-/***********************************************************************
- * *
- * Return the CWD. *
- * This routine is called by the Kuip Browser for Files. *
- * *
- ***********************************************************************/
-char **kmbfdi( class_name, first )
- char *class_name;
- int first;
-{
- static char *path_desc[2];
- static char root[MAX_stringl+31];
- char path[MAX_stringl+1];
-
- path_desc[0] = NULL;
- path_desc[1] = NULL;
-
- if (first && getcwd(path, MAX_stringl)) {
- sprintf(root, "root=%s file=\'List of all files\'", path);
- path_desc[0] = "Files";
- path_desc[1] = root;
- }
- return path_desc;
-}
diff --git a/src/packlib/kuip/code_motif/kmbfil.c b/src/packlib/kuip/code_motif/kmbfil.c
deleted file mode 100644
index 2b572b4..0000000
--- a/src/packlib/kuip/code_motif/kmbfil.c
+++ /dev/null
@@ -1,40 +0,0 @@
-/*
- * $Id: kmbfil.c,v 1.1.1.1 1996/03/08 15:33:08 mclareni Exp $
- *
- * $Log: kmbfil.c,v $
- * Revision 1.1.1.1 1996/03/08 15:33:08 mclareni
- * Kuip
- *
- */
-/*CMZ : 2.05/09 19/05/94 17.22.57 by Unknown*/
-/*-- Author : N.Cremel 27/10/92*/
-
-#include "kuip/kuip.h"
-#include "kuip/mkutfu.h"
-
-
-
-/***********************************************************************
- * *
- * This routine is called by the Kuip Browser for Files. *
- * *
- ***********************************************************************/
-char **kmbfil( brobj_name, brcls_name, bpath, n )
- char *brobj_name;
- char *brcls_name;
- char *bpath;
- int n;
-{
- char **fdesc;
- static char *expath;
-
- if (n == 0)
- expath = fexpand(bpath, NULL);
-
- if (!(fdesc = km_scan_dir( expath, "*", n, 0 )))
- free(expath);
-
- return fdesc;
-}
-
-
diff --git a/src/packlib/kuip/code_motif/kmbmac.c b/src/packlib/kuip/code_motif/kmbmac.c
deleted file mode 100644
index 06dec15..0000000
--- a/src/packlib/kuip/code_motif/kmbmac.c
+++ /dev/null
@@ -1,45 +0,0 @@
-/*
- * $Id: kmbmac.c,v 1.1.1.1 1996/03/08 15:33:08 mclareni Exp $
- *
- * $Log: kmbmac.c,v $
- * Revision 1.1.1.1 1996/03/08 15:33:08 mclareni
- * Kuip
- *
- */
-/*CMZ : 2.05/09 19/05/94 17.38.52 by N.Cremel*/
-/*-- Author : N.Cremel 27/10/92*/
-
-#include "kuip/kuip.h"
-#include "kuip/mkutfu.h"
-
-
-/***********************************************************************
- * *
- * This routine is called by the Kuip Browser for Macros. *
- * *
- ***********************************************************************/
-char **kmbmac( brobj_name, brcls_name, bpath, n )
- char *brobj_name;
- char *brcls_name;
- char *bpath;
- int n;
-{
- char **fdesc;
- static char *expath;
- static int init = 0;
-
- if (!init) {
- km_file_type( ".kumac", "MacFile", "(Kuip Macro)", 1 );
- init = 1;
- }
-
- if (n == 0)
- expath = fexpand(bpath, NULL);
-
- if (!(fdesc = km_scan_dir( expath, "*.kumac", n, 1 )))
- free(expath);
-
- return fdesc;
-}
-
-
diff --git a/src/packlib/kuip/code_motif/kmbmdi.c b/src/packlib/kuip/code_motif/kmbmdi.c
deleted file mode 100644
index b704784..0000000
--- a/src/packlib/kuip/code_motif/kmbmdi.c
+++ /dev/null
@@ -1,42 +0,0 @@
-/*
- * $Id: kmbmdi.c,v 1.1.1.1 1996/03/08 15:33:08 mclareni Exp $
- *
- * $Log: kmbmdi.c,v $
- * Revision 1.1.1.1 1996/03/08 15:33:08 mclareni
- * Kuip
- *
- */
-/*CMZ : 2.01/00 18/02/93 11.15.03 by Alfred Nathaniel*/
-/*-- Author : N.Cremel 27/10/92*/
-
-#include "kuip/kuip.h"
-#include "kuip/kfor.h"
-#include "kuip/klink.h"
-#include "kuip/kmenu.h"
-#include "mkdims.h"
-
-
-/***********************************************************************
- * *
- * Return the CWD for the *.kumac files. *
- * This routine is called by the Kuip Browser for Macro. *
- * *
- ***********************************************************************/
-char **kmbmdi( class_name, first )
- char *class_name;
- int first;
-{
- static char *path_desc[2];
- static char root[MAX_stringl+31];
- char path[MAX_stringl+1];
-
- path_desc[0] = NULL;
- path_desc[1] = NULL;
-
- if (first && getcwd(path, MAX_stringl)) {
- sprintf(root, "root=%s file=\'List of KUIP macros\'", path);
- path_desc[0] = "Macro";
- path_desc[1] = root;
- }
- return path_desc;
-}
diff --git a/src/packlib/kuip/code_motif/kmbrow.c b/src/packlib/kuip/code_motif/kmbrow.c
deleted file mode 100644
index 9c56f98..0000000
--- a/src/packlib/kuip/code_motif/kmbrow.c
+++ /dev/null
@@ -1,2618 +0,0 @@
-/*
- * $Id: kmbrow.c,v 1.1.1.1 1996/03/08 15:33:08 mclareni Exp $
- *
- * $Log: kmbrow.c,v $
- * Revision 1.1.1.1 1996/03/08 15:33:08 mclareni
- * Kuip
- *
- */
-/*CMZ : 2.06/09 20/02/95 12.14.20 by N.Cremel*/
-/*-- Author : Nicole Cremel*/
-/******************************************************************************/
-/* */
-/* MOTIF-based library for KUIP - deck KMBROW */
-/* */
-/* Basic Interface for any "KUIP Browsers" */
-/* (connected to the file //KUIP/XMCLIB/KUXBRO for building the */
-/* panels with Architect : "create_kuipBrowser"). */
-/* */
-/******************************************************************************/
-
-#include "kuip/kuip.h"
-#include "kuip/kfor.h"
-#include "kuip/klink.h"
-#include "kuip/kmenu.h"
-
-#include <stdio.h>
-#include <string.h>
-#include <X11/StringDefs.h>
-#include <X11/Intrinsic.h>
-#include <Xm/Xm.h>
-#include <Xm/Text.h>
-#include <Xm/PushBGP.h>
-
-#include "mkdims.h"
-#include "kuip/mkutfu.h"
-#include "mkutfm.h"
-#include "mkutda.h"
-#include "mkutdm.h"
-#include "kuip/mkterm.h"
-#include "icbox.h"
-#include "kuip/browh1.h"
-#include "browh2.h"
-#include "browbm.h"
-#define CONTEXT_MACRO_ACCESS 1
-#include "mkuxbr.h"
-#undef CONTEXT_MACRO_ACCESS
-
-
-/* structure definition */
-typedef struct {
- Widget browser;
- BrAction *bract;
- } otag_str; /* tag structure for FilePdMenu_o_activate */
-
-/* local data */
-static Widget last_browser;
-static Widget file_popup;
-static Widget dir_popup;
-static int n_fbrowser = 0;
-static int hili_left = 0;
-static int hili_right = 0;
-static Boolean no_recursion = False;
-static Boolean path_edit = False;
-static int current_browser;
-static Widget class_popup = NULL;
-static Widget object_popup = NULL;
-static char br_filter[MAX_stringl];
-static char *br_init = NULL;
-static char *path_init = NULL;
-static int init_br = 0;
-
-
-/* extern data */
-extern XmAnyCallbackStruct *current_callback_data;
-
-/***********************************************************************
- * *
- * Forward declarations of extern functions. *
- * *
- ***********************************************************************/
-extern C_PROTO_1(Widget create_kuipBrowser,
- void);
-extern C_PROTO_1(void create_menu_help,
- Widget parent);
-extern C_PROTO_3(void popup_activate,
- Widget widget,
- caddr_t tag,
- XmAnyCallbackStruct *call_data);
-
-
-/***********************************************************************
- * *
- * Forward declarations of global functions. *
- * *
- ***********************************************************************/
-C_PROTO_3(void km_show_Browser,
- Widget w,
- Widget clone_parent,
- XmAnyCallbackStruct *call_data);
-C_PROTO_2(void kxterm_show_browser, char **, int);
-C_PROTO_3(Widget km_create_Browser,
- Widget w,
- Widget clone_parent,
- XmAnyCallbackStruct *call_data);
-C_PROTO_1( void file_execute,
- char *lun);
-C_PROTO_3( void dir_execute,
- Widget browser,
- KmObject *kmobj,
- char *lun);
-C_PROTO_3(void update_browser,
- Widget widget,
- int list,
- Boolean refresh);
-C_PROTO_0(void km_reset_class_popup);
-C_PROTO_0(void km_reset_object_popup);
-C_PROTO_0(char *km_get_br_filter);
-
-/* C-callable entry to set browser in a given state */
-void km_browser_set ( const char *file, const char *path );
-
-/***********************************************************************
- * *
- * Forward declarations of local functions. *
- * *
- ***********************************************************************/
-static C_PROTO_1(Widget find_kuipBrowser,
- Widget child);
-static C_PROTO_6(void list_delete_item,
- int *lst,
- char *item,
- int *litem,
- int *all1,
- int *refresh,
- int *all_dir);
-static C_PROTO_2(void list_refresh,
- int *list,
- int *all_dir);
-static C_PROTO_1(void file_list_refresh,
- Widget widget);
-static C_PROTO_1(int get_fb_context,
- Widget w);
-static C_PROTO_1(void save_fb_context,
- Widget w);
-static C_PROTO_1(void focus_allbrowser,
- Boolean set);
-static C_PROTO_3(void destroy_kuipBrowser,
- Widget w,
- Widget browser,
- XmAnyCallbackStruct *call_data);
-static C_PROTO_0(char *get_path);
-static C_PROTO_1(void set_path,
- char *path);
-static C_PROTO_3(void reset_cursor,
- Widget w,
- Widget browser,
- XButtonPressedEvent *event);
-static C_PROTO_3(void change_path,
- Widget w,
- Widget browser,
- XmTextVerifyCallbackStruct *cbs);
-static C_PROTO_3(void edit_path,
- Widget w,
- Widget browser,
- XmTextVerifyCallbackStruct *cbs);
-static C_PROTO_3(void do_file_list,
- Widget w,
- Widget browser,
- XmListCallbackStruct *call_data);
-static C_PROTO_1(KmObject *get_dir_data,
- Widget browser);
-static C_PROTO_3(void do_dir_list,
- Widget w,
- Widget browser,
- IconBoxCallbackStruct *call_data);
-static C_PROTO_3(void enter_browser,
- Widget widget,
- int tag,
- XEnterWindowEvent *ev);
-static C_PROTO_3(void post_class_menu,
- Widget w,
- Widget browser,
- XButtonPressedEvent *event);
-static C_PROTO_3(void post_object_menu,
- Widget w,
- Widget browser,
- XButtonPressedEvent *event);
-static C_PROTO_5(void list_addc_item,
- KmObject *kmobj,
- int ltype,
- int pos,
- Boolean refresh,
- Boolean all_dir);
-#if UNREF
-static C_PROTO_3(void list_addp_item,
- char *item,
- int pos,
- Boolean all_dir);
-#endif
-static C_PROTO_2 (void do_list_content,
- char *path,
- Boolean refresh);
-static C_PROTO_1(void init_fb_menu,
- Widget browser);
-static C_PROTO_1(void set_icon_tb_state,
- int icon_type);
-static C_PROTO_3(void change_icon_type,
- Widget w,
- int icon_type,
- XmToggleButtonCallbackStruct *call_data);
-#ifdef ALL_CYCLE /* vms */
-static C_PROTO_3(void change_cycle,
- Widget w,
- caddr_t tag,
- XmToggleButtonCallbackStruct *call_data);
-#endif
-static C_PROTO_3(void select_all_decks,
- Widget w,
- Widget browser,
- XmAnyCallbackStruct *call_data);
-static C_PROTO_3(void show_filtDialog,
- Widget w,
- Widget browser,
- XmAnyCallbackStruct *call_data);
-static C_PROTO_3(void FilePdMenu_o_activate,
- Widget widget,
- caddr_t tag,
- XmAnyCallbackStruct *call_data);
-static C_PROTO_3(void FilePdMenu_exit,
- Widget widget,
- caddr_t tag,
- XmAnyCallbackStruct *call_data);
-static void browser_init();
-static void set_browser ( char *file );
-
-
-
-/***********************************************************************
- * *
- * Show (manage) the file browser. *
- * *
- ***********************************************************************/
-void km_show_Browser(w, clone_parent, call_data)
- Widget w, clone_parent;
- XmAnyCallbackStruct *call_data;
-{
- km_create_Browser(w, clone_parent, call_data);
-}
-
-/***********************************************************************
- * *
- * Action routine which will be called by handle_kxterm_actions to *
- * popup a new browser. *
- * *
- ***********************************************************************/
-void kxterm_show_browser( argv, argc )
- char **argv;
- int argc;
-{
- km_show_Browser((Widget)NULL, (Widget)NULL,
- (XmAnyCallbackStruct *)NULL);
-}
-
-/***********************************************************************
- * *
- * Create the file browser. *
- * *
- ***********************************************************************/
-Widget km_create_Browser(w, clone_parent, call_data)
- Widget w, clone_parent;
- XmAnyCallbackStruct *call_data;
-{
- Widget widget;
- Pixmap pixmap;
- Pixel fgc;
- XmString *xfsel, *xdsel;
- Display *display;
- char *path, *title;
- char cval[MAX_string], cval1[MAX_string];
- int i, fitem, fcnt, dcnt, icon_type;
- int browser_count = 0;
-
- BrObject *brobj;
-
- if (n_fbrowser >= MAX_FILE_BROWSER) {
- km_inform_user(w, "Cannot open more file browsers.", "");
- return(NULL);
- }
-
- widget = create_kuipBrowser();
- last_browser = widget;
-
- get_fb_context(widget);
-
-
- /* set icon for file browser popup */
- display = XtDisplay(widget);
- pixmap = XCreateBitmapFromData(display, DefaultRootWindow(display),
- (char*)browser_bits, browser_width, browser_height);
-
- for (i = 0; i < MAX_FILE_BROWSER; i++) {
- if (!fbrowser[i].widget) {
- browser_count = i;
- break; }
- }
-
- /*
- * First browser is called the so called Main browser.
- */
- if (!browser_count)
- sprintf (cval,"%s Main Browser", class_name);
- else
- sprintf (cval,"%s Browser %d", class_name,browser_count+1);
- XtVaSetValues(XtParent(widget), XmNtitle, cval,
- XmNiconName, cval,
- XmNiconPixmap, pixmap,
- NULL);
-
- /*
- * Register browser with application via application defined routine.
- */
- sprintf (cval1,"kuipBrowser%d", browser_count+1);
- if( klnkaddr.user_TopWid_C != NULL ) {
- /* pass widget ID to application */
- (*klnkaddr.user_TopWid_C)(cval1, widget);
- XtVaGetValues(XtParent(widget), XmNtitle, &title, NULL);
- km_store_appShell (widget, title);
- } else {
- km_store_appShell (widget, cval);
- }
-
- XtVaGetValues(widget, XmNbackground, &fgc, NULL);
- XtVaSetValues(pathText, XmNbackground, fgc, NULL);
-
- /*
- * install callbacks on browser buttons
- */
- if (!browser_count) {
- XtVaSetValues(XtParent(widget), XmNdeleteResponse, XmDO_NOTHING, NULL);
- XtSetSensitive(closeButton, False);
- } else {
- km_MwmCloseCallback(XtParent(widget),
- (XtCallbackProc)destroy_kuipBrowser,
- (XtPointer)widget);
- XtAddCallback(closeButton, XmNactivateCallback,
- (XtCallbackProc)destroy_kuipBrowser, widget);
- }
- XtAddCallback(cloneButton, XmNactivateCallback,
- (XtCallbackProc)km_show_Browser, widget);
-
- /*
- * install callbacks on the lists
- */
- XtAddCallback(fileList, XmNbrowseSelectionCallback,
- (XtCallbackProc)do_file_list, widget);
- XtAddCallback(fileList, XmNsingleSelectionCallback,
- (XtCallbackProc)do_file_list, widget);
- XtAddCallback(fileList, XmNdefaultActionCallback,
- (XtCallbackProc)do_file_list, widget);
-
- /*
- * install event handler on the pathText widget
- */
- XtAddEventHandler(pathText, ButtonPressMask, False,
- (XtEventHandler)reset_cursor, widget);
- XtAddCallback(pathText, XmNmotionVerifyCallback,
- (XtCallbackProc)change_path, widget);
-
- dirList = CreateIconBox(dirScWindow, "dirlist", NULL, 0);
-
- /*
- * install callbacks on the dirList
- */
- IconBoxAddCallback(dirList, XmNdefaultActionCallback,
- (XtCallbackProc)do_dir_list, (caddr_t)widget);
- IconBoxAddCallback(dirList, XmNsingleSelectionCallback,
- (XtCallbackProc)do_dir_list, (caddr_t)widget);
- IconBoxAddCallback(dirList, XmNextendedSelectionCallback,
- (XtCallbackProc)do_dir_list, (caddr_t)widget);
- IconBoxAddCallback(dirList, XmNmultipleSelectionCallback,
- (XtCallbackProc)do_dir_list, (caddr_t)widget);
-
- /*
- * install event handler on EnterNotify events
- */
- current_browser = browser_count;
- XtAddEventHandler(widget, EnterWindowMask, False,
- (XtEventHandler)enter_browser, (XtPointer)browser_count);
-
-
- /*
- * initialize the View menu
- */
- init_fb_menu(widget);
-
- /*
- * initialize the Help menu
- */
- create_menu_help(widget);
-
- /*
- * install the popup menu's and event handlers
- */
- XtAddEventHandler(fileList, ButtonPressMask, False,
- (XtEventHandler)post_class_menu, widget);
- XtAddEventHandler(dirList, ButtonPressMask, False,
- (XtEventHandler)post_object_menu, widget);
-
-
- /* display the file browser */
- UxPopupInterface(widget, XtGrabNone);
-
- /* get icon_type and titles state */
- icon_type = IconBoxGetIconType(dirList);
- if (icon_type == IconBoxBIG_ICON) titles = 0;
- else if (icon_type == IconBoxSMALL_ICON) titles = 1;
- else if (icon_type == IconBoxNO_ICON) titles = 2;
- else if (icon_type == IconBoxTITLES) titles = 3;
-
-
- n_fbrowser++;
- for (i = 0; i < MAX_FILE_BROWSER; i++) {
- if (!fbrowser[i].widget) {
- fbrowser[i].widget = widget;
- fbrowser[i].dirlist = dirList;
- fbrowser[i].file_popup = file_popup;
- fbrowser[i].dir_popup = dir_popup;
- fbrowser[i].pref_dialog = (Widget) NULL;
- fbrowser[i].pref_menu = (MenuCbStruct *) NULL;
- fbrowser[i].cd[0] = '\0';
- fbrowser[i].hili_left = 0;
- fbrowser[i].hili_right = 0;
- fbrowser[i].titles = titles;
- fbrowser[i].order = 0;
- strcpy (fbrowser[i].filter, "*");
- fbrowser[i].focus = False;
- fbrowser[i].reset = False;
- fbrowser[i].path_edit = False;
- break;
- }
- }
-
- /* Show all connected files (class window) */
- for ( brobj = scan_brobjects(); brobj != NULL; brobj = brobj->next ) {
- /* Get total number of classes and for each one get and
- * add short_name in class window
- */
- XmString xmstr = XmStringCreate( brobj->name, XmSTRING_DEFAULT_CHARSET );
- XmListAddItem( fileList, xmstr, 0 );
- XmStringFree( xmstr );
- }
-
-
- /* is it a clone ? */
- if (clone_parent) {
-
- /* set context to the parent */
- get_fb_context(clone_parent);
-
- /* get selected item in the parent's file list */
- XtVaGetValues(fileList, XmNitemCount, &fitem,
- XmNselectedItemCount, &fcnt,
- XmNselectedItems, &xfsel, NULL);
- if (!fcnt) return(widget);
-
- IconBoxGetSelectedItems(dirList, &xdsel, &dcnt);
- icon_type = IconBoxGetIconType(dirList);
-
- /* get current path in the parent's file list */
- path = get_path();
- strcpy (browser_dir, path);
-
- /*
- * save parent's context as clone context (to save titles, order and
- * filter settings)
- */
- save_fb_context(widget);
-
- /* set context back to the clone */
- get_fb_context(widget);
-
- XmListSelectItem(fileList, xfsel[0], True);
- IconBoxSetIconType(dirList, icon_type);
- set_path(path);
-
- if (titles)
- set_icon_tb_state(IconBoxTITLES);
- else
- set_icon_tb_state(icon_type);
-
- /* list content of selected_path for this new current_browser */
- do_list_content(path, True);
-
-
- /* highlight the icons that were selected */
- IconBoxSelectItems(dirList, xdsel, dcnt, False);
-
-
- if (dcnt > 0) XtFree((char *)xdsel);
- XtFree(path);
- } else {
- set_path("");
- }
-
- return (widget);
-}
-
-/***********************************************************************
- * *
- * Get the context for kuipBrowser widget. *
- * *
- ***********************************************************************/
-static int get_fb_context(w)
- Widget w;
-{
- int i;
-
- if (!w) return -2;
-
- /*
- * find and restore the context
- * (to get to the widgets belonging to this dialog)
- */
- UxKuipBrowserContext = (_UxCkuipBrowser *)UxGetContext(w);
-
-
- /* restore dirList context by hand (not in Architect context) */
- for (i = 0; i < MAX_FILE_BROWSER; i++) {
- if (fbrowser[i].widget == w) {
- dirList = fbrowser[i].dirlist;
- file_popup = fbrowser[i].file_popup;
- dir_popup = fbrowser[i].dir_popup;
- pref_dialog = fbrowser[i].pref_dialog;
- pref_menu = fbrowser[i].pref_menu;
- strcpy(browser_dir, fbrowser[i].cd);
- hili_left = fbrowser[i].hili_left;
- hili_right = fbrowser[i].hili_right;
- titles = fbrowser[i].titles;
- order = fbrowser[i].order;
- strcpy(browser_filter, fbrowser[i].filter);
- browser_focus = fbrowser[i].focus;
- browser_reset = fbrowser[i].reset;
- path_edit = fbrowser[i].path_edit;
- return i;
- }
- }
- return -1;
-}
-
-/***********************************************************************
- * *
- * Get current value of br_filter. *
- * *
- ***********************************************************************/
-char *km_get_br_filter()
-{
- return br_filter;
-}
-
-/***********************************************************************
- * *
- * Save the context for kuipBrowser widget. *
- * *
- ***********************************************************************/
-static void save_fb_context(w)
- Widget w;
-{
- int i;
-
- for (i = 0; i < MAX_FILE_BROWSER; i++) {
- if (fbrowser[i].widget == w) {
- strcpy(fbrowser[i].cd, browser_dir);
- fbrowser[i].hili_left = hili_left;
- fbrowser[i].hili_right = hili_right;
- fbrowser[i].titles = titles;
- fbrowser[i].order = order;
- strcpy(fbrowser[i].filter, browser_filter);
- fbrowser[i].focus = browser_focus;
- fbrowser[i].reset = browser_reset;
- fbrowser[i].path_edit = path_edit;
- break;
- }
- }
-}
-
-/***********************************************************************
- * *
- * Set or reset the file browser update flag. *
- * *
- ***********************************************************************/
-C_DECL_1(void km_reset_allbrowser,
- Boolean, set)
-{
- int i;
-
- for (i = 0; i < MAX_FILE_BROWSER; i++) {
- fbrowser[i].reset = set;
- }
- browser_reset = set;
-}
-
-/***********************************************************************
- * *
- * Set or reset the file browser focus flag. *
- * *
- ***********************************************************************/
-static C_DECL_1(void focus_allbrowser,
- Boolean, set)
-{
- int i;
-
- for (i = 0; i < MAX_FILE_BROWSER; i++) {
- fbrowser[i].focus = set;
- }
- browser_focus = set;
-}
-
-/***********************************************************************
- * *
- * Destroy the file browser dialog. *
- * *
- ***********************************************************************/
-static void destroy_kuipBrowser(w, browser, call_data)
- Widget w, browser;
- XmAnyCallbackStruct *call_data;
-{
- int i;
-
- n_fbrowser--;
- for (i = 0; i < MAX_FILE_BROWSER; i++) {
- if (fbrowser[i].widget == browser) {
- fbrowser[i].widget = (Widget) NULL;
- fbrowser[i].dirlist = (Widget) NULL;
- fbrowser[i].file_popup = (Widget) NULL;
- fbrowser[i].dir_popup = (Widget) NULL;
- fbrowser[i].pref_dialog = (Widget) NULL;
- XtFree((char *)fbrowser[i].pref_menu);
- fbrowser[i].pref_menu = (MenuCbStruct *) NULL;
- fbrowser[i].cd[0] = '\0';
- fbrowser[i].hili_left = 0;
- fbrowser[i].hili_right = 0;
- fbrowser[i].titles = 0;
- fbrowser[i].order = 0;
- strcpy (fbrowser[i].filter, "*");
- fbrowser[i].focus = False;
- fbrowser[i].reset = False;
- fbrowser[i].path_edit = False;
- break;
- }
- }
-
- UxDestroyInterface(browser);
- km_reset_appShell (browser);
-}
-
-/***********************************************************************
- * *
- * Find the file browser dialog. *
- * *
- ***********************************************************************/
-static Widget find_kuipBrowser(child)
- Widget child;
-{
- String name;
- Widget browser;
-
- /*
- * starting from a child widget find back the
- * parent file browser widget to set the right context.
- */
- browser = child;
- do {
- browser = XtParent(browser);
- name = XtName(browser);
- } while (browser && strcmp(name, "kuipBrowser"));
-
- return browser;
-}
-
-/***********************************************************************
- * *
- * Set the current path in kxterm. *
- * *
- ***********************************************************************/
-static void set_path_in_kxterm(path)
- char *path;
-{
- char *s = XtMalloc(strlen(path)+6);
- sprintf(s,"cwd(%s)", path);
- send_single_kxterm_cmd(s);
- XtFree(s);
-}
-
-/***********************************************************************
- * *
- * Handle the browser window enter and leave events. *
- * *
- ***********************************************************************/
-static void enter_browser(widget, tag, ev)
- Widget widget;
- int tag;
- XEnterWindowEvent *ev;
-{
- extern Boolean km_browser_refresh;
- int fcnt;
- XmString *xfsel;
- char *path, *selected_path;
-
- get_fb_context(fbrowser[tag].widget);
- if( current_browser != tag ) {
- /* When moving from one browser into another we have to refresh */
- current_browser = tag;
- browser_focus = False;
- }
-
- /* Test flag reset for command like HISTO/FILE */
- if (browser_reset) km_browser_refresh = True;
-
- if (km_browser_refresh) {
- /* after command execution : */
- /* update all browsers the 1st time one is entered */
- update_browser (NULL, 0, False);
- km_browser_refresh = False;
- km_reset_allbrowser(False);
-
- get_fb_context(fbrowser[current_browser].widget);
- browser_focus = False;
- }
-
- if (!browser_focus) {
-
- path = get_path();
-
- set_path_in_kxterm(path);
-
- /*
- * scan object for this filebrowser class
- * This code may be removed once each browser has its own kmobj
- * structure
- */
- XtVaGetValues(fileList, XmNselectedItemCount, &fcnt,
- XmNselectedItems, &xfsel, NULL);
- if (fcnt) {
- XmStringGetLtoR(xfsel[0], XmSTRING_DEFAULT_CHARSET, &selected_path);
- scan_kmobjects(selected_path, path, current_browser);
- XtFree (selected_path);
- }
-
- /* execute default action for this browser (e.g. cd ...) */
- update_browser (fbrowser[current_browser].widget, DIR_LIST, False);
-
- XtFree (path);
- focus_allbrowser(False);
- browser_focus = True;
- }
-
- /* always update a browser which shows the //PAWC */
- path = get_path();
- if (!strncasecmp(path, "//PAWC", 6)) do_list_content(path, True);
- XtFree (path);
-
- save_fb_context(fbrowser[current_browser].widget);
-}
-
-
-/***********************************************************************
- * *
- * Update browser : both class and object window. *
- * *
- * + Execute default action for the current path (change directory) *
- * *
- * list = DIR_LIST, FILE_LIST or 0 (both) *
- * if browser = NULL then update all browsers (class and/or object) *
- * if list = DIR_LIST and refresh = False then execute default *
- * command for this browser selected path (e.g. cd) *
- * if list = DIR_LIST and refresh = True then update browser content *
- * and execute default command for this browser selected path *
- * *
- ***********************************************************************/
-C_DECL_3(void update_browser,
- Widget, browser,
- int, list,
- Boolean, refresh)
-{
- XmString *xfsel;
- char *path;
- int i, fitem, fcnt, oldcur;
-
- BrObject *brobj;
- BrClass *brcls;
- BrAction *bract;
-
-
- if (browser != NULL) get_fb_context(browser);
-
-
- /* Update the "class window" with list of connected files */
- if (list == 0 || list == FILE_LIST) {
- if (browser == NULL) {
- /* update all browsers */
- int do_all = 1;
- int lt = FILE_LIST;
-
- list_refresh(<, &do_all);
- } else {
- file_list_refresh (fileList);
- save_fb_context(browser);
- }
- }
-
- if (list == FILE_LIST) return;
-
- if (browser == NULL) {
- /* Update all browser object windows */
- oldcur = current_browser;
- for (i = 0; i < MAX_FILE_BROWSER; i++) {
- if (fbrowser[i].widget) {
- current_browser = get_fb_context(fbrowser[i].widget);
- /* Update the content window */
- path = get_path();
- if (path == NULL) {
- IconBoxDeleteAllItems(dirList, True);
- continue;
- }
- do_list_content (path, True);
- XtFree (path);
- }
- }
- current_browser = oldcur;
- } else {
- /* Get selected class (lun) for this browser */
- XtVaGetValues(fileList, XmNitemCount, &fitem,
- XmNselectedItemCount, &fcnt,
- XmNselectedItems, &xfsel, NULL);
- /* Execute default action for this selected class (change directory) */
- if (fcnt) {
- char *lun;
-
- XmStringGetLtoR(xfsel[0], XmSTRING_DEFAULT_CHARSET, &lun);
- /* Get object structure for this lun */
- if ( (brobj = find_brobject( lun )) != NULL ) {
- brcls = brobj->class;
- bract = brcls->root;
- /* execute the class window default action for lun */
- current_callback_data = NULL;
- exec_action (bract, lun, NULL, False, NULL, NULL);
- }
- XtFree (lun);
- }
- if (refresh) {
- /* refresh content window */
- path = get_path();
- if (path == NULL) {
- IconBoxDeleteAllItems(dirList, True);
- return;
- }
- /* Store new value for "browser_dir" */
- strcpy(browser_dir, path);
- /* Update the content window */
- do_list_content (path, True);
- XtFree (path);
- }
- }
-}
-
-/***********************************************************************
- * *
- * Make sure that the correct file is highlighted. *
- * The user may have changed the file selection. *
- * *
- ***********************************************************************/
-static void check_file_selection()
-{
-}
-
-/***********************************************************************
- * *
- * Get the path in the pathText widget. *
- * It removes the blank appended at the end of the path by set_path. *
- * *
- ***********************************************************************/
-static char *get_path()
-{
- char *path, *s;
- int ls;
-
- s = strtrim( XmTextGetString(pathText) );
- ls = strlen(s);
-
- if (ls)
- path = XtNewString(s);
- else
- path = XtCalloc(1, 1);
-
- free(s);
-
- return path;
-}
-
-/***********************************************************************
- * *
- * Set the path in the pathText widget. *
- * *
- ***********************************************************************/
-static void set_path(path)
- char *path;
-{
- no_recursion = True;
- XmTextSetString(pathText, path);
- XmTextInsert(pathText, strlen(path), " ");
- no_recursion = False;
-
- hili_left = 0;
- hili_right = 0;
-
- set_path_in_kxterm(path);
-}
-
-/***********************************************************************
- * *
- * Event handler which resets the cursor position to 1 so *
- * change_path will always be called (because the current pos *
- * will always be different from the new pos. *
- * *
- ***********************************************************************/
-static void reset_cursor(w, browser, event)
- Widget w, browser;
- XButtonPressedEvent *event;
-{
- XmTextPosition pos;
-
- /* only handle 1st and 3rd mouse button */
- if (event->button == 2)
- return;
-
- no_recursion = True;
-
- if (event->button == 1) {
- pos = 0;
- XmTextSetInsertionPosition(w, pos);
- }
-
- if (event->button == 3) {
- /* set the context */
- get_fb_context(browser);
-
- XmTextSetHighlight(pathText, hili_left, hili_right, XmHIGHLIGHT_NORMAL);
- hili_left = 0;
- hili_right = 0;
-
- path_edit = True;
- save_fb_context(browser);
-
- XtVaSetValues(pathText,
- XmNeditable, True,
- XmNcursorPositionVisible, True,
- XmNshadowThickness, 2,
- XmNmarginHeight, 3,
- NULL);
- XtOverrideTranslations (pathText,
- XtParseTranslationTable("<Key>Return:activate()"));
- XtAddCallback(pathText, XmNactivateCallback,
- (XtCallbackProc)edit_path, browser);
- }
-
- no_recursion = False;
-}
-
-/***********************************************************************
- * *
- * Callback for manually editing the pathtext. *
- * *
- ***********************************************************************/
-static void edit_path(w, browser, cbs)
- Widget w, browser;
- XmTextVerifyCallbackStruct *cbs;
-{
- char *path, *selected_path, *lun;
- int zero, all, list;
- XmString *xfsel;
- int fitem, fcnt;
-
- no_recursion = True;
-
- get_fb_context(browser);
-
- XtRemoveCallback(pathText, XmNactivateCallback,
- (XtCallbackProc)edit_path, browser);
-
- path = get_path();
-
- /* Store new value for "browser_dir" and update path */
- strcpy(browser_dir, path);
- set_path(browser_dir);
- /* make sure the values changed in set_path are saved */
- save_fb_context(browser);
- km_set_cursor (browser, km_wait_cursor);
- zero = 0;
- all = 1;
- list = DIR_LIST;
- list_delete_item(&list, NULL, &zero, &all, &zero, &zero);
- selected_path = (char *) XtMalloc (MAX_string+1);
- strcpy (selected_path, browser_dir);
- do_list_content (selected_path, True);
-
- /* Get selected class (lun) for this browser */
- XtVaGetValues(fileList, XmNitemCount, &fitem,
- XmNselectedItemCount, &fcnt,
- XmNselectedItems, &xfsel, NULL);
- /* Execute default action for this selected class */
- if (fcnt) {
- BrObject *brobj;
-
- XmStringGetLtoR(xfsel[0], XmSTRING_DEFAULT_CHARSET, &lun);
- /* Get object structure for this lun */
- if ( (brobj = find_brobject( lun )) != NULL ) {
- BrClass *brcls;
- BrAction *bract;
-
- brcls = brobj->class;
- bract = brcls->root;
- /* execute the class window default action for lun */
- current_callback_data = NULL;
- exec_action (bract, lun, NULL, False, NULL, NULL);
-
- /* Update all browsers */
- if (bract->flags & BrActUpdate)
- update_browser(NULL, FILE_LIST, False);
- }
- XtFree (lun);
- }
-
- km_set_cursor (browser, km_main_cursor);
- XtFree (selected_path);
- check_file_selection();
-
- path_edit = False;
-
- save_fb_context(browser);
-
- XtFree(path);
-
- XtVaSetValues(pathText,
- XmNeditable, False,
- XmNcursorPositionVisible, False,
- XmNshadowThickness, 0,
- XmNmarginHeight, 5,
- NULL);
-
- no_recursion = False;
-}
-
-/***********************************************************************
- * *
- * Event handler for the pressing of the 1st mouse button in the *
- * pathText widget. *
- * *
- ***********************************************************************/
-static void change_path(w, browser, cbs)
- Widget w, browser;
- XmTextVerifyCallbackStruct *cbs;
-{
- XmTextPosition pos;
- int end_pos, zero, all, x, y, width, height, list;
- char *path, *prev, *s, *s2, *class, *lun;
- char *selected_path;
- Boolean selected;
- XmString xmstr;
- int is_vms_dir = 0;
- int slash = '/';
-
- if (no_recursion || path_edit) return;
-
- /* get the click position */
- pos = cbs->newInsert;
-
- if (pos <= 0) return;
-
- /* set the context */
- get_fb_context(browser);
-
- path = get_path();
-
- /* check if it is not a VMS directory name "disk:[dir]" */
- if( path[strlen(path)-1] == ']' ) {
- is_vms_dir = 1;
- slash = '.';
- }
-
- /* special case for path's starting with // (i.e. RZ files) */
- if (!strncmp(path, "//", 2) && pos <= 2)
- pos = 3;
-
- /* search from the click position to the first / */
- s = strchr(path+(pos-1), slash);
-
- if (s) {
- end_pos = s - path;
- if (end_pos == 0) end_pos = 1;
- } else
- end_pos = strlen(path);
-
- /* if clicked twice in the same path segment change path */
- if (end_pos == hili_right) {
-
- /* just rescan when full path selected */
- if (end_pos == strlen(path)) {
-
- XmTextSetHighlight(pathText, hili_left, hili_right,
- XmHIGHLIGHT_NORMAL);
- hili_left = 0;
- hili_right = 0;
- save_fb_context(browser); /* make sure the above values are saved */
-
- km_set_cursor (browser, km_wait_cursor);
- zero = 0;
- all = 1;
- list = DIR_LIST;
- list_delete_item(&list, NULL, &zero, &all, &zero, &zero);
- selected_path = (char *) XtMalloc (MAX_string+1);
- strcpy (selected_path, browser_dir);
- do_list_content (selected_path, False);
- list = DIR_LIST;
- list_refresh(&list, &zero);
- XtFree (selected_path);
- km_set_cursor (browser, km_main_cursor);
-
- } else {
- /* new path selected: execute action for "change directory" */
- XmString *xfsel;
- int fitem, fcnt;
- BrObject *brobj;
- BrClass *brcls;
- BrAction *bract;
-
- /* Store new value for "browser_dir" and update path */
- strncpy(browser_dir, path, end_pos);
- if( is_vms_dir ) {
- browser_dir[end_pos] = ']';
- browser_dir[end_pos+1] = '\0';
- }
- else {
- browser_dir[end_pos] = '\0';
- }
-
- set_path(browser_dir);
- /* make sure the values changed in set_path are saved */
- save_fb_context(browser);
-
- s2 = strchr(s+1, slash);
-
- if (s2) {
- prev = XtCalloc(s2-s, 1);
- strncpy(prev, s+1, s2-s-1);
- } else {
- prev = XtCalloc(strlen(path)-end_pos, 1);
- strcpy(prev, s+1);
- }
-
- km_set_cursor (browser, km_wait_cursor);
- zero = 0;
- all = 1;
- list = DIR_LIST;
- list_delete_item(&list, NULL, &zero, &all, &zero, &zero);
- selected_path = (char *) XtMalloc (MAX_string+1);
- strcpy (selected_path, browser_dir);
- do_list_content (selected_path, False);
-
- xmstr = XmStringCreate(prev, XmSTRING_DEFAULT_CHARSET);
- if (IconBoxGetItemAttr(dirList, xmstr, &x, &y, &width, &height,
- &class, &selected))
- IconBoxZoom(dirList, x, y, width, height, False);
- list = DIR_LIST;
- list_refresh(&list, &zero);
-
- /* Get selected class (lun) for this browser */
- XtVaGetValues(fileList, XmNitemCount, &fitem,
- XmNselectedItemCount, &fcnt,
- XmNselectedItems, &xfsel, NULL);
- /* Execute default action for this selected class */
- if (fcnt) {
- XmStringGetLtoR(xfsel[0], XmSTRING_DEFAULT_CHARSET, &lun);
- /* Get object structure for this lun */
- if ( (brobj = find_brobject( lun )) != NULL ) {
- brcls = brobj->class;
- bract = brcls->root;
- /* execute the class window default action for lun */
- current_callback_data = NULL;
- exec_action (bract, lun, NULL, False, NULL, NULL);
-
- /* Update all browsers */
- if (bract->flags & BrActUpdate)
- update_browser(NULL, FILE_LIST, False);
- }
- XtFree (lun);
- }
-
- km_set_cursor (browser, km_main_cursor);
- XtFree (selected_path);
- XtFree(prev);
- XtFree(class);
- XmStringFree(xmstr);
- }
- } else {
- /* if clicked in new path segment, just highlight the segment */
- XmTextSetHighlight(pathText, hili_left, hili_right, XmHIGHLIGHT_NORMAL);
- hili_right = end_pos;
- XmTextSetHighlight(pathText, hili_left, hili_right, XmHIGHLIGHT_SELECTED);
- }
-
- check_file_selection();
-
- save_fb_context(browser);
-
- XtFree(path);
-}
-
-
-/***********************************************************************
- * *
- * Event handler for the pressing of the 3rd mouse button *
- * in the class window. *
- * *
- ***********************************************************************/
-static void post_class_menu(w, browser, event)
- Widget w, browser;
- XButtonPressedEvent *event;
-{
- Widget wtmp;
- MenuItem filemenu_items[MAXITEMS];
- char *selected_path;
- XmString *xfsel;
- int fitem, fcnt;
- int i;
- BrObject *brobj;
- BrClass *brcls;
- BrAction *bract;
- char title[MAX_string];
-
- static poptag_str ptag[MAXITEMS];
- unsigned int state;
-
-
- /* only handle 3rd mouse button */
- if (event->button != 3) return;
- state = event->state;
-
-
- get_fb_context(browser);
-
- /* Get selected_path for this browser */
- XtVaGetValues(fileList, XmNitemCount, &fitem,
- XmNselectedItemCount, &fcnt,
- XmNselectedItems, &xfsel, NULL);
- if (!fcnt)
- return;
-
- XmStringGetLtoR(xfsel[0], XmSTRING_DEFAULT_CHARSET, &selected_path);
-
- /* Get Browser class according to the selection : selected_path */
- if( (brobj = find_brobject( selected_path )) == NULL ) {
- XtFree (selected_path);
- return;
- }
- brcls = brobj->class;
- bract = brcls->root;
- /* Build the "class window" popup menu : */
- for( i = 0; bract != NULL; bract = bract->next, i++ ) {
- if (i > MAXITEMS) break;
- ptag[i].command_num = i+1;
- ptag[i].flag = 1;
- ptag[i].browser = browser;
- ptag[i].panel = (state == ControlMask);
- ptag[i].bract = bract;
- ptag[i].bract_next = bract->next;
- ptag[i].kmobj = NULL;
- strcpy (ptag[i].pathname, selected_path);
- filemenu_items[i].accelerator = NULL;
- filemenu_items[i].accel_text = NULL;
- filemenu_items[i].callback = popup_activate;
- filemenu_items[i].callback_data = (caddr_t) &ptag[i];
- filemenu_items[i].default_button = False;
- filemenu_items[i].subitems = NULL;
- filemenu_items[i].set = False;
- if (bract->flags & BrActToggle) {
- filemenu_items[i].class = &xmToggleButtonGadgetClass;
- if (bract->flags & BrActToggleOn) filemenu_items[i].set = True;
- } else {
- filemenu_items[i].class = &xmPushButtonGadgetClass;
- }
- filemenu_items[i].label = bract->text;
- filemenu_items[i].mnemonic = bract->text[0];
- filemenu_items[i].separator = (bract->flags & BrActSeparator);
- }
- /* Add auromatically a "Help" item at the end of the menu */
- filemenu_items[i].accelerator = NULL;
- filemenu_items[i].accel_text = NULL;
- filemenu_items[i].callback = km_do_help;
- filemenu_items[i].callback_data = str2dup("HELP_", selected_path) ;
- filemenu_items[i].subitems = NULL;
- filemenu_items[i].set = False;
- filemenu_items[i].class = &xmPushButtonGadgetClass;
- filemenu_items[i].label = strdup("Help");
- filemenu_items[i].mnemonic = 'H';
- filemenu_items[i].separator = True;
- i++;
- filemenu_items[i].label = NULL;
- filemenu_items[0].default_button = True;
-
- /* create menu title */
- if( brcls->title != NULL )
- sprintf( title, "%s %s", brcls->title, brobj->name );
- else
- sprintf( title, "%s", brobj->name );
-
- km_reset_class_popup();
- class_popup = km_build_popup (fileList, title, filemenu_items,
- XmMENU_POPUP, &wtmp);
-
-
- /*
- * position the menu at the location of the button press! If we wanted
- * to position it elsewhere, we could change the x,y fields of the
- * event structure.
- */
- XmMenuPosition(class_popup, event);
- XtManageChild(class_popup);
- XtFree (selected_path);
-}
-
-/***********************************************************************
- * *
- * Destroy menu defined in the class window (class_popup). *
- * *
- ***********************************************************************/
-void km_reset_class_popup()
-{
- if (class_popup != NULL) XtDestroyWidget (XtParent(class_popup));
- class_popup = NULL;
-}
-
-/***********************************************************************
- * *
- * Event handler for the pressing of the 3rd mouse button *
- * in the object window. *
- * *
- ***********************************************************************/
-static void post_object_menu(w, browser, event)
- Widget w, browser;
- XButtonPressedEvent *event;
-{
- Widget wtmp;
- MenuItem filemenu_items[MAXITEMS];
- int i, npos, *pos;
- char *selected_path;
- XmString *xfsel;
- int fitem, fcnt;
-
- static poptag_str ptag[MAXITEMS];
- static KmObject tag_kmobj;
- unsigned int state;
- KmObject *kmobj;
- KmClass *kmcls;
- BrAction *bract;
- char title[MAX_string];
-
-
- /* only handle 3rd mouse button */
- if (event->button != 3) return;
- state = event->state;
-
-
- get_fb_context(browser);
-
- /* Get selected_path for this browser */
- XtVaGetValues(fileList, XmNitemCount, &fitem,
- XmNselectedItemCount, &fcnt,
- XmNselectedItems, &xfsel, NULL);
- if (!fcnt)
- return;
-
- XmStringGetLtoR(xfsel[0], XmSTRING_DEFAULT_CHARSET, &selected_path);
-
- /* Get selected_item for this browser */
- IconBoxGetSelectedPos (dirList, &pos, &npos);
- if (npos != 1) {
- XtFree((char *)pos);
- XtFree (selected_path);
- return;
- }
- kmobj = kmobjects;
- for( i = pos[npos-1] - 1; kmobj != NULL && i > 0; i-- )
- kmobj = kmobj->next;
- XtFree((char *)pos);
- if( kmobj == NULL ) return;
-
- /* save kmobj in local copy */
- tag_kmobj.next = NULL;
- if (tag_kmobj.name) free(tag_kmobj.name);
- if (kmobj->name) tag_kmobj.name = strdup(kmobj->name);
- if (tag_kmobj.stext) free(tag_kmobj.stext);
- if (kmobj->stext) tag_kmobj.stext = strdup(kmobj->stext);
- else tag_kmobj.stext = NULL;
- if (tag_kmobj.ltext) free(tag_kmobj.ltext);
- if (kmobj->ltext) tag_kmobj.ltext = strdup(kmobj->ltext);
- else tag_kmobj.ltext = NULL;
- tag_kmobj.class = kmobj->class;
-
- /* Get item class according to the selection */
- kmcls = kmobj->class;
- bract = kmcls->cont;
- /* Build object window popup menu according to this class */
- if( kmcls->title != NULL ) {
- /* create menu title */
- }
- for( i = 0; bract != NULL; bract = bract->next, i++ ) {
- if (i > MAXITEMS) break;
- ptag[i].command_num = i+1;
- ptag[i].flag = 2;
- ptag[i].browser = browser;
- ptag[i].panel = (state == ControlMask);
- ptag[i].bract = bract;
- ptag[i].bract_next = bract->next;
- ptag[i].kmobj = &tag_kmobj;
- strcpy (ptag[i].pathname, selected_path);
- filemenu_items[i].accelerator = NULL;
- filemenu_items[i].accel_text = NULL;
- filemenu_items[i].callback = popup_activate;
- filemenu_items[i].callback_data = (caddr_t) &ptag[i];
- filemenu_items[i].default_button = False;
- filemenu_items[i].subitems = NULL;
- filemenu_items[i].set = False;
- if (bract->flags & BrActToggle) {
- filemenu_items[i].class = &xmToggleButtonGadgetClass;
- if (bract->flags & BrActToggleOn) filemenu_items[i].set = True;
- } else {
- filemenu_items[i].class = &xmPushButtonGadgetClass;
- }
- filemenu_items[i].label = bract->text;
- filemenu_items[i].mnemonic = bract->text[0];
- filemenu_items[i].separator = (bract->flags & BrActSeparator);
- }
- filemenu_items[i].label = NULL;
- filemenu_items[0].default_button = True;
-
- sprintf( title, "%s %s", kmcls->title, kmobj->name );
- km_reset_object_popup();
- object_popup = km_build_popup (dirList, title, filemenu_items,
- XmMENU_POPUP, &wtmp);
-
- /*
- * position the menu at the location of the button press! If we wanted
- * to position it elsewhere, we could change the x,y fields of the
- * event structure.
- */
- XmMenuPosition(object_popup, event);
- XtManageChild(object_popup);
- XtFree (selected_path);
-}
-
-/***********************************************************************
- * *
- * Destroy menu defined in the object window (object_popup). *
- * *
- ***********************************************************************/
-void km_reset_object_popup()
-{
- if (object_popup != NULL) XtDestroyWidget (XtParent(object_popup));
- object_popup = NULL;
-}
-
-#if UNREF
-/***********************************************************************
- * *
- * Add an item to the Class Window *
- * FORTRAN callable *
- * *
- * If all_dir<>0 then add the item to all lists in all file *
- * browsers. *
- * *
- ***********************************************************************/
-static C_DECL_3(void list_addp_item,
- char *, item,
- int, pos,
- Boolean, all_dir)
-{
- XmString xmstr;
- int i;
-
- if (!km_toplevel) return;
- if (!n_fbrowser) return;
-
- xmstr = XmStringCreate(item, XmSTRING_DEFAULT_CHARSET);
-
- if (all_dir) {
- for (i = 0; i < MAX_FILE_BROWSER; i++) {
- if (fbrowser[i].widget) {
- get_fb_context(fbrowser[i].widget);
- XmListAddItem(fileList, xmstr, pos); }
- }
- } else
- XmListAddItem(fileList, xmstr, pos);
-
- XmStringFree(xmstr);
-}
-#endif
-
-/***********************************************************************
- * *
- * Add an item to the Object Window *
- * FORTRAN callable *
- * *
- * If all_dir<>0 then add the item to all lists in all file *
- * browsers. *
- * *
- ***********************************************************************/
-static C_DECL_5(void list_addc_item,
- KmObject *, kmobj,
- int, ltype,
- int, pos,
- Boolean, refresh,
- Boolean, all_dir)
-{
- XmString xmstr;
- Boolean pixmap;
- char *title;
- int i;
-
- KmIcon *kmicon_big, *kmicon_sml;
-
-
- if (!km_toplevel) return;
- if (!n_fbrowser) return;
-
- title = XtCalloc(MAX_stringl, 1);
-
- if (ltype == 0) {
- /* Big icons */
- strcpy( title, kmobj->name );
- } else if (ltype == 1) {
- /* Small icons */
- strcpy( title, kmobj->name );
- } else if (ltype == 2) {
- /* no icons */
- sprintf (title, "%s", kmobj->name );
- if( kmobj->stext != NULL ) {
- strcat( title, " " );
- strcat( title, kmobj->stext );
- }
- } else if (ltype == 3) {
- /* Titles */
- sprintf (title, "%-10s%-8s",
- kmobj->name, (kmobj->stext != NULL) ? kmobj->stext : "" );
- if ( kmobj->ltext != NULL ) {
- strcat( title, " - " );
- strcat( title, kmobj->ltext );
- }
- }
- xmstr = XmStringCreate(title, XmSTRING_DEFAULT_CHARSET);
-
- pixmap = True;
-
- /* Retrieve bitmap data (corresponding to this class) from the CDF */
- /* Create big pixmaps (first time only) */
- if ((kmicon_big = kmobj->class->bicon) == NULL)
- kmicon_big = kmobj->class->bicon = find_kmicon(
- kmobj->class->big_icon);
-
- /* Create small pixmaps (first time only) */
- if ((kmicon_sml = kmobj->class->sicon) == NULL)
- kmicon_sml = kmobj->class->sicon = find_kmicon(
- kmobj->class->sm_icon);
-
- if (kmicon_big == NULL && kmicon_sml == NULL) {
- pixmap = False;
- } else {
- if (kmicon_big == NULL) kmicon_big = kmicon_sml;
- if (kmicon_sml == NULL) kmicon_sml = kmicon_big;
- }
-
-
- if (all_dir) {
- for (i = 0; i < MAX_FILE_BROWSER; i++) {
- if (fbrowser[i].widget) {
- get_fb_context(fbrowser[i].widget);
- if (pixmap) {
- IconBoxAddItemBitmapData (dirList, xmstr,
- kmobj->class->name,
- kmicon_big->name,
- kmicon_big->bitmap,
- kmicon_big->width, kmicon_big->height,
- kmicon_sml->name,
- kmicon_sml->bitmap,
- kmicon_sml->width, kmicon_sml->height,
- pos, refresh);
- } else {
- IconBoxAddItem(dirList, xmstr, kmobj->class->name,
- pos, refresh);
- }
- }
- }
- } else {
- if (pixmap) {
- IconBoxAddItemBitmapData (dirList, xmstr,
- kmobj->class->name,
- kmicon_big->name,
- kmicon_big->bitmap,
- kmicon_big->width, kmicon_big->height,
- kmicon_sml->name,
- kmicon_sml->bitmap,
- kmicon_sml->width, kmicon_sml->height,
- pos, refresh);
- } else {
- IconBoxAddItem(dirList, xmstr, kmobj->class->name,
- pos, refresh);
- }
- }
-
- XmStringFree(xmstr);
- XtFree(title);
-}
-
-
-/***********************************************************************
- * *
- * Delete one or all items from one of the two lists (file or dir *
- * list). *
- * If a selected item is deleted from the file list then delete also *
- * all the items from the dir list. If all1 is <>0 then delete all *
- * items. If refresh=0 then one needs to call list_delete_item at *
- * least once more with refresh<>0 or call list_refresh. If *
- * all_dir<>0 then delete item from all file browsers. *
- * *
- ***********************************************************************/
-static void list_delete_item(lst, item, litem, all1, refresh, all_dir)
- int *lst;
- char *item;
- int *litem;
- int *all1;
- int *refresh;
- int *all_dir;
-{
-}
-
-
-/***********************************************************************
- * *
- * Refresh the lists *
- * *
- ***********************************************************************/
-static void list_refresh(list, all_dir)
- int *list, *all_dir;
-{
- Boolean all_brow;
- int i;
-
-
- if (!km_toplevel) return;
- if (!n_fbrowser) return;
-
- all_brow = (Boolean) *all_dir;
-
- if (*list == DIR_LIST) {
- if (all_brow) {
- for (i = 0; i < MAX_FILE_BROWSER; i++) {
- if (fbrowser[i].widget) {
- get_fb_context(fbrowser[i].widget);
- IconBoxRefresh(dirList);
- }
- }
- } else
- IconBoxRefresh(dirList);
- } else if (*list == FILE_LIST) {
- if (all_brow) {
- for (i = 0; i < MAX_FILE_BROWSER; i++) {
- if (fbrowser[i].widget) {
- get_fb_context(fbrowser[i].widget);
- file_list_refresh (fileList);
- save_fb_context(fbrowser[i].widget);
- }
- }
- } else
- file_list_refresh (fileList);
- }
-
-}
-
-/***********************************************************************
- * *
- * Refresh File_list (class window) *
- * *
- ***********************************************************************/
-static void file_list_refresh(widget)
- Widget widget;
-{
- BrObject *brobj;
- int fcnt;
- XmString *xfsel;
- char *fsel = NULL;
- Boolean found = False;
-
- XtVaGetValues(fileList, XmNselectedItemCount, &fcnt,
- XmNselectedItems, &xfsel, NULL);
- if (fcnt) fsel = km_normal_string(xfsel[0]);
-
- XmListSetPos(widget, 1);
- XmListDeselectAllItems(widget);
- XmListDeleteAllItems (widget);
-
- /* Get list of root pathname and update the list widget */
- for( brobj = scan_brobjects(); brobj != NULL; brobj = brobj->next ) {
- XmString xmstr = XmStringCreate( brobj->name, XmSTRING_DEFAULT_CHARSET );
- XmListAddItem( widget, xmstr, 0 );
- if (fsel != NULL && !strcmp(fsel, brobj->name)) {
- XmListSelectItem(widget, xmstr, False);
- found = True;
- }
- XmStringFree( xmstr );
- }
-
- /* Set pre-defined browser (user has to call km_browser_set) */
- browser_init ();
-
- if (!found && init_br != 0) {
- IconBoxDeleteAllItems(dirList, True);
- browser_dir[0] = '\0';
- set_path("");
- }
- if (fsel != NULL) XtFree(fsel);
-
- init_br = 1;
-}
-
-static void browser_init()
-{
- if( br_init != NULL && init_br == 0 ) {
- XmString xmsel;
- char path_n[MAX_string];
- char *path, *rpath;
-
- xmsel = XmStringCreate(br_init, XmSTRING_DEFAULT_CHARSET);
- XmListSelectItem(fileList, xmsel, True);
-
- /* Store new value of "browser_dir" */
- if (path_init != NULL) {
- path = path_init;
- } else {
- sprintf (path_n, "path_%d", current_browser);
- rpath = get_variable( br_init, "root");
- if ( (path = get_variable( br_init, path_n )) == NULL) {
- path = rpath; }
- if( path == NULL || path[0] == '\0' )
- path = "/";
- }
- strcpy(browser_dir, path);
- set_path(browser_dir);
-
- XmStringFree(xmsel);
- br_init = NULL;
- free (br_init);
- }
-}
-
-
-/***********************************************************************
- * *
- * Callback for the file list *
- * *
- * (Execution when clicking on one item in the class window) *
- * *
- ***********************************************************************/
-static void do_file_list(w, browser, call_data)
- Widget w, browser;
- XmListCallbackStruct *call_data;
-{
- char *lun;
-
- get_fb_context(browser);
- lun = km_normal_string(call_data->item);
-
- switch (call_data->reason) {
- case XmCR_DEFAULT_ACTION:
-
- break;
-
- case XmCR_SINGLE_SELECT:
- case XmCR_BROWSE_SELECT:
-
- km_set_cursor (browser, km_wait_cursor);
-
- set_browser (lun);
- current_callback_data = (XmAnyCallbackStruct *)call_data;
-
- km_set_cursor (browser, km_main_cursor);
-
- break;
- }
-
- XtFree(lun);
- save_fb_context(browser);
-}
-
-void km_browser_set ( const char *file, const char *path )
-{
- BrObject *brobj;
-
- /* Take right value in the list (case sensitive) */
- br_init = strdup (file);
- for( brobj = scan_brobjects(); brobj != NULL; brobj = brobj->next ) {
- if ( strcasecmp( file, brobj->name ) == 0 )
- br_init = strdup (brobj->name);
- }
-
- if (path != NULL) path_init = strdup (path);
-}
-
-void F77_ENTRY_CC(Kmbrset,chfil,chpath)
-/* { */
- char *file = fstr0dup( chfil, len_chfil);
- char *path = fstr0dup( chfil, len_chpath);
- km_browser_set( file, path );
- if (file != NULL) free( file );
- if (path != NULL) free( path );
-}
-
-static void set_browser ( file )
- char *file;
-{
- char ff[512];
- char *value, *vf;
- XmString xmfil, xmstr;
- BrObject *brobj;
-
- int ic = current_browser;
-
- /* Check if item is in the list */
- vf = strdup(file);
- for( brobj = scan_brobjects(); brobj != NULL; brobj = brobj->next ) {
- if ( strcasecmp( file, brobj->name ) == 0 )
- vf = strdup(brobj->name);
- }
-
- get_fb_context(fbrowser[ic].widget);
- xmfil = XmStringCreate(vf, XmSTRING_DEFAULT_CHARSET);
- if ( !XmListItemExists( fileList, xmfil ) ) {
- printf ("set_browser : cannot find %s in list of browsables\n", file);
- XmStringFree(xmfil);
- return; }
- XmStringFree(xmfil);
-
- /* Get filename corresponding to path selected */
- strcpy( ff, "File: " );
- if( (value = get_variable( vf, "file" )) != NULL )
- strcat( ff, value );
- xmstr = XmStringCreate(ff, XmSTRING_DEFAULT_CHARSET);
- /* Print fileNameLabel in the labelString area */
- XtVaSetValues(fileNameLabel, XmNlabelString, xmstr, NULL);
- XmStringFree(xmstr);
-
- file_execute (vf);
- free (vf);
-}
-
-/*
- * action routine for /MOTIF/BROWSER
- */
-int kxbrset()
-{
- char *file = ku_gets();
- int npar = ku_npar();
-
- char *vf = NULL;
- XmString xmsel;
- BrObject *brobj;
-
- get_fb_context(last_browser);
-
- if (file == NULL) return 0;
-
- for( brobj = scan_brobjects(); brobj != NULL; brobj = brobj->next ) {
- if ( strcasecmp( file, brobj->name ) == 0 ) vf = strdup (brobj->name);
- }
-
- if (vf == NULL) {
- printf ("kxbrset : cannot find %s in list of browsables\n", file);
- return 0;
- }
-
- xmsel = XmStringCreate(vf, XmSTRING_DEFAULT_CHARSET);
- XmListSelectItem(fileList, xmsel, True);
- XmStringFree(xmsel);
-
- if (npar > 1) {
- extern Boolean km_browser_refresh;
- char *path = ku_gets();
-
- if (path == NULL) {
- free (vf);
- return 0;
- } else {
- char *full_path = fexpand(path, NULL);
- strcpy(browser_dir, full_path);
- set_path(browser_dir);
- km_browser_refresh = True;
- browser_focus = False;
- enter_browser(NULL, current_browser, NULL);
- free (full_path);
- }
- } /* end ... if (npar > 1) */
-
- free (vf);
- return 0;
-}
-
-
-
-/***********************************************************************
- * *
- * Execute default action (for list) when clicking on one item in *
- * the class window. *
- * *
- ***********************************************************************/
-void file_execute (lun)
- char *lun;
-{
- char *path, *rpath;
- char path_n[MAX_string];
-
- BrObject *brobj;
- BrClass *brcls;
- BrAction *bract;
-
- /* Store new value of "browser_dir" */
- sprintf (path_n, "path_%d", current_browser);
- rpath = get_variable( lun, "root");
- if ( (path = get_variable( lun, path_n )) == NULL) {
- path = rpath; }
- if( path == NULL || path[0] == '\0' )
- path = "/";
-
- strcpy(browser_dir, path);
- set_path(browser_dir);
-
- /* Update object window with the list of objects for this path */
- do_list_content(browser_dir, True);
-
- /* execute default action (first command) */
- if (init_br == 0) return;
- if ( (brobj = find_brobject( lun )) == NULL )
- return;
- brcls = brobj->class;
- bract = brcls->root;
-
- exec_action (bract, lun, NULL, False, NULL, NULL);
-
- /* Update all browsers */
- if (bract->flags & BrActUpdate)
-{
- update_browser(NULL, FILE_LIST, False);
-}
-
-}
-
-/***********************************************************************
- * *
- * Get data (value, class, title) on item selected in object window *
- * *
- ***********************************************************************/
-static KmObject *get_dir_data (browser)
- Widget browser;
-{
- int i, npos, *pos;
- KmObject *kmobj;
-
- get_fb_context(browser);
-
- IconBoxGetSelectedPos (dirList, &pos, &npos);
- if (npos != 1) {
- XtFree((char *)pos);
- return(NULL);
- }
- kmobj = kmobjects;
- for( i = pos[npos-1] - 1; kmobj != NULL && i > 0; i-- )
- kmobj = kmobj->next;
- XtFree((char *)pos);
- if( kmobj == NULL ) return(NULL);
-
- /* Set value of "dirNameLabel" (bottom right) */
- if (kmobj->name != NULL) {
- XmString xmstr;
- char str[512];
-
- if (kmobj->ltext != NULL)
- sprintf(str, "%s: %s",kmobj->name, kmobj->ltext);
- else
- sprintf(str, "%s",kmobj->name);
- xmstr = XmStringCreate(str, XmSTRING_DEFAULT_CHARSET);
- XtVaSetValues(dirNameLabel, XmNlabelString, xmstr, NULL);
- XmStringFree(xmstr);
- }
-
- return (kmobj);
-}
-
-/***********************************************************************
- * *
- * Callback for the dir list *
- * *
- * (Execution when clicking on one item in the object window) *
- * *
- ***********************************************************************/
-static void do_dir_list(w, browser, call_data)
- Widget w, browser;
- IconBoxCallbackStruct *call_data;
-{
- XmString *xfsel;
- int fitem, fcnt;
- char *lun; /* name in the root window, e.g. PAWC */
-
- KmObject *kmobj;
-
- get_fb_context(browser);
-
- /* Get selected_path (lun) for this browser */
- XtVaGetValues(fileList, XmNitemCount, &fitem,
- XmNselectedItemCount, &fcnt,
- XmNselectedItems, &xfsel, NULL);
- if (!fcnt) return;
- XmStringGetLtoR(xfsel[0], XmSTRING_DEFAULT_CHARSET, &lun);
-
- switch (call_data->reason) {
- case XmCR_SINGLE_SELECT:
- case XmCR_MULTIPLE_SELECT:
- case XmCR_EXTENDED_SELECT:
-
- get_dir_data (browser);
- break;
-
-
- case XmCR_DEFAULT_ACTION:
-
- km_set_cursor (browser, km_wait_cursor);
-
- kmobj = get_dir_data (browser);
-
- current_callback_data = (XmAnyCallbackStruct *)call_data;
-
- if (kmobj->class->is_dir) {
- /* This is a directory ... */
- /* execute default action for directory */
- dir_execute (browser, kmobj, lun);
- } else {
- /* execute default action (first command) */
- km_get_curpos (call_data->event, &km_xcur_pos, &km_ycur_pos);
- exec_action (kmobj->class->cont, lun, kmobj->name, False,
- w, call_data);
- /* Update all browsers */
- if (kmobj->class->cont->flags & BrActUpdate)
- update_browser (NULL, 0, False);
- }
- km_set_cursor (browser, km_main_cursor);
- break;
- }
-
- XtFree(lun);
- save_fb_context(browser);
-}
-
-
-/***********************************************************************
- * *
- * Execute default action and make zoom effect *
- * when clicking on one directory in the object window *
- * *
- ***********************************************************************/
-void dir_execute (browser, kmobj, lun)
- Widget browser;
- KmObject *kmobj;
- char *lun;
-{
- XmString xmstr;
- char *path, *selected_path, *class, *dirname, *title;
- Boolean selected;
- int list, zero, all, x, y, width, height;
- BrAction *brasav;
-
- get_fb_context(browser);
-
- /* Store new value of "browser_dir" */
- path = get_path();
- strcpy( browser_dir, path );
- XtFree (path);
-
- if( strcmp( kmobj->name, ".." ) == 0 ) {
- /* go up one level in directory hierarchy */
- if( browser_dir[1] != '\0' ) {
- char *p = strrchr( browser_dir, '/' );
- if( p != NULL ) {
- if( p == browser_dir )
- p[1] = '\0';
- else
- p[0] = '\0';
- }
- }
- }
- else if( strcmp( kmobj->name, "[-]" ) == 0 ) {
- /* VMS */
- char *p = strrchr( browser_dir, '.' );
- if( p != NULL )
- strcpy( p, "]" );
- }
- else if( strncmp( kmobj->name, "[.", 2 ) == 0 ) {
- /* VMS */
- char *p = strrchr( browser_dir, ']' );
- if( p != NULL )
- strcpy( p, kmobj->name + 1 );
- }
- else {
- if( browser_dir[1] != '\0' || browser_dir[0] == '~')
- strcat( browser_dir, "/" );
- strcat( browser_dir, kmobj->name );
- }
-
- /* save new browser_dir value */
- save_fb_context(browser);
-
- /* Set new path with "browser_dir" */
- selected_path = str0dup (browser_dir);
- set_path(selected_path);
-
- /* delete previous contents and fill directory list again */
- zero = 0;
- all = 1;
- list = DIR_LIST;
-
- /* delete the items from the iconbox */
- list_delete_item(&list, NULL, &zero, &all, &zero, &zero);
-
- /*
- * store the items from the new directory in the iconbox,
- * but do not yet update the screen
- */
- brasav = kmobj->class->cont;
- dirname = str0dup (kmobj->name);
-
- title = XtCalloc(MAX_stringl, 1);
-
- if (titles == 0 || titles == 1) {
- /* big and small icons */
- strcpy(title, kmobj->name);
- } else if (titles == 2) {
- /* no icons */
- sprintf (title, "%s", kmobj->name );
- if ( kmobj->stext != NULL ) {
- strcat( title, " " );
- strcat( title, kmobj->stext );
- }
- } else if (titles == 3) {
- /* Titles */
- sprintf (title, "%-10s%-8s",
- kmobj->name, (kmobj->stext != NULL) ? kmobj->stext : "" );
- if ( kmobj->ltext ) {
- strcat( title, " - " );
- strcat( title, kmobj->ltext );
- }
- }
-
- /* make zoom effect and update the screen */
- xmstr = XmStringCreate(title, XmSTRING_DEFAULT_CHARSET);
- if (IconBoxGetItemAttr(dirList, xmstr,
- &x, &y, &width, &height,
- &class, &selected)) {
- do_list_content (selected_path, False);
- IconBoxZoom(dirList, x, y, width, height, True);
- IconBoxDeselectAllItems(dirList, False);
- list = DIR_LIST;
- list_refresh(&list, &zero);
- }
-
- free(selected_path);
- XtFree(class);
- XtFree(title);
- XmStringFree(xmstr);
-
- /* execute default action (first command) */
- exec_action (brasav, lun, dirname, False, NULL, NULL);
-
- /*
- * Update all browsers
- * Here we assume that the default action does not add new items
- * in the just refreshed object window, only in the class window
- * (i.e. FILE_LIST). Best would be if there would be a separate
- * flag for class and object window refreshes.
- */
- if (brasav->flags & BrActUpdate)
- update_browser (NULL, FILE_LIST, False);
-
- free(dirname);
-
- save_fb_context(browser);
-}
-
-
-/***********************************************************************
- * *
- * do_list_content (path, refresh) *
- * *
- * char *path (input) : complete directory pathname *
- * (e.g. //PAWC/LUN20/DIR1) *
- * Boolean refresh (input) : refresh the iconbox *
- * *
- * Default action for do_file_list *
- * *
- * List of objects should be obtained by calling the "next_object" *
- * routine corresponding to the class of the directory pathname *
- * (HBOOK, Picture, ZEBRA file, ...) *
- * *
- ***********************************************************************/
-static C_DECL_2(void do_list_content,
- char *, path,
- Boolean, refresh)
-{
- char *pathname;
- XmString xmstr;
-
- int ic = current_browser;
- KmObject *kmobj;
- XmString *xfsel;
- int fitem, fcnt;
- char *selected_path; /* name in the root window, e.g. PAWC */
-
-
- /* make a local copy of path (which can be overwritten by browser_dir) */
- pathname = (char *) XtMalloc(strlen(path)+1);
- strcpy (pathname, path);
-
- get_fb_context(fbrowser[ic].widget);
- /* get selected item in the parent's file list */
- XtVaGetValues(fileList, XmNitemCount, &fitem,
- XmNselectedItemCount, &fcnt,
- XmNselectedItems, &xfsel, NULL);
- if (!fcnt) {
- XtFree (pathname);
- return;
- }
- XmStringGetLtoR(xfsel[0], XmSTRING_DEFAULT_CHARSET, &selected_path);
-
- if (!get_variable(selected_path, "root") && !strcmp(pathname, "/"))
- pathname[0] = '\0';
-
- if (strlen(pathname) == 0)
- strcpy(browser_dir, "/");
- else
- strcpy(browser_dir, pathname);
-
- IconBoxDeleteAllItems(dirList, False);
-
- strcpy (br_filter, fbrowser[ic].filter);
- for( kmobj = scan_kmobjects( selected_path, pathname, ic);
- kmobj != NULL; kmobj = kmobj->next ) {
- int i1 = 0;
- int i2 = 0;
- int i3 = 0;
-
- /* Add item */
- list_addc_item(kmobj,fbrowser[ic].titles,i1,i2,i3);
- } /* end for( kmobj = scan_kmobjects ... */
-
- /* Set value of counterLabel */
- xmstr = XmStringCreate( get_variable( selected_path, "summary" ),
- XmSTRING_DEFAULT_CHARSET);
- XtVaSetValues(counterLabel, XmNlabelString, xmstr, NULL);
- XmStringFree(xmstr);
-
- if (refresh) IconBoxRefresh(dirList);
-
- save_fb_context(fbrowser[ic].widget);
- XtFree (pathname);
- XtFree (selected_path);
-}
-
-
-/***********************************************************************
- * *
- * Install callbacks file browser menu's. *
- * *
- ***********************************************************************/
-static void init_fb_menu(browser)
- Widget browser;
-{
- int narg;
- Arg arglist[15];
- XmString mgXmStrings[1];
- Widget FilePdMenu_button, FilePdMenu_sep;
- int icon_type;
-
- BrClass *brcls;
-
- Boolean open_button = False;
-
- /*
- * Set up list of buttons in OPEN menu
- * and install callbacks on OPEN men buttons
- */
- /* Get the list of "Open statements" for all "browsers" */
- for( brcls = brclasses; brcls != NULL; brcls = brcls->next ) {
- BrAction *bract;
- for( bract = brcls->open; bract != NULL; bract = bract->next ) {
- otag_str *otag = (otag_str*)malloc(sizeof(otag_str));
-
- narg = 0;
- mgXmStrings[0] =
- XmStringCreateLtoR( bract->text, XmSTRING_DEFAULT_CHARSET);
- XtSetArg(arglist[narg], XmNlabelString, mgXmStrings[0]); narg++;
- if (bract->flags & BrActSeparator) {
- FilePdMenu_sep = XmCreateSeparatorGadget
- (FilePdMenu,"FilePdMenu_sep",arglist,0);
- XtManageChild(FilePdMenu_sep); }
- FilePdMenu_button = XmCreatePushButtonGadget
- (FilePdMenu,"FilePdMenu_button",arglist,narg);
- open_button = True;
- otag->browser = browser;
- otag->bract = bract;
- XtAddCallback(FilePdMenu_button, XmNactivateCallback,
- (XtCallbackProc)FilePdMenu_o_activate,otag );
- XtManageChild(FilePdMenu_button );
- XmStringFree(mgXmStrings[0]);
- }
- }
-
- /*
- * add "Exit" button at the end of "File" menu (to exit application)
- */
- if (open_button)
- XtVaCreateManagedWidget( "FilePdMenu_sep",
- xmSeparatorGadgetClass, FilePdMenu, NULL );
- FilePdMenu_button = XtVaCreateManagedWidget( "FilePdMenu_button",
- xmPushButtonGadgetClass, FilePdMenu,
- RES_CONVERT( XmNmnemonic, "E" ),
- RES_CONVERT( XmNlabelString, "Exit" ),
- NULL );
- XtAddCallback(FilePdMenu_button, XmNactivateCallback,
- (XtCallbackProc)FilePdMenu_exit, NULL );
-
-
- /*
- * install callbacks on VIEW men buttons
- */
- XtAddCallback(ViewPdMenu_icon, XmNvalueChangedCallback,
- (XtCallbackProc)change_icon_type, (XtPointer)IconBoxBIG_ICON);
- XtAddCallback(ViewPdMenu_sicon, XmNvalueChangedCallback,
- (XtCallbackProc)change_icon_type, (XtPointer)IconBoxSMALL_ICON);
- XtAddCallback(ViewPdMenu_nicon, XmNvalueChangedCallback,
- (XtCallbackProc)change_icon_type, (XtPointer)IconBoxNO_ICON);
- XtAddCallback(ViewPdMenu_title, XmNvalueChangedCallback,
- (XtCallbackProc)change_icon_type, (XtPointer)IconBoxTITLES);
-#ifdef ALL_CYCLE /* vms */
- km_all_cycles = 0;
- XtAddCallback(ViewPdMenu_allcycle, XmNvalueChangedCallback,
- (XtCallbackProc)change_cycle, NULL);
-#endif
-
- /*
- * install callbacks on HELP men button
- */
- XtAddCallback(HelpPdMenu_help, XmNactivateCallback,
- (XtCallbackProc)km_do_help,(XtPointer)"HELP_BROWSER");
-
- /*
- * SELECT ALL command
- */
- XtAddCallback(ViewPdMenu_selall, XmNactivateCallback,
- (XtCallbackProc)select_all_decks, browser);
- /*
- * PREFERENCES command
- */
- XtAddCallback(ViewPdMenu_filt, XmNactivateCallback,
- (XtCallbackProc)show_filtDialog, browser);
-
- /* get icon_type set in the .Xdefaults file */
- icon_type = IconBoxGetIconType(dirList);
- set_icon_tb_state(icon_type);
-}
-
-/***********************************************************************
- * *
- * Set the icon toggle button state. *
- * *
- ***********************************************************************/
-static void set_icon_tb_state(icon_type)
- int icon_type;
-{
- /* turn all buttons off except the one currently active */
- XmToggleButtonGadgetSetState(ViewPdMenu_icon, False, False);
- XmToggleButtonGadgetSetState(ViewPdMenu_sicon, False, False);
- XmToggleButtonGadgetSetState(ViewPdMenu_nicon, False, False);
- XmToggleButtonGadgetSetState(ViewPdMenu_title, False, False);
-
- switch (icon_type) {
- case IconBoxBIG_ICON:
- XmToggleButtonGadgetSetState(ViewPdMenu_icon, True, False);
- break;
- case IconBoxSMALL_ICON:
- XmToggleButtonGadgetSetState(ViewPdMenu_sicon, True, False);
- break;
- case IconBoxNO_ICON:
- XmToggleButtonGadgetSetState(ViewPdMenu_nicon, True, False);
- break;
- case IconBoxTITLES:
- XmToggleButtonGadgetSetState(ViewPdMenu_title, True, False);
- }
-}
-
-/***********************************************************************
- * *
- * Get the new icon_type and change the dirList accordingly. *
- * *
- ***********************************************************************/
-static void change_icon_type(w, icon_type, call_data)
- Widget w;
- int icon_type;
- XmToggleButtonCallbackStruct *call_data;
-{
- Widget browser;
- XmString *xmlist;
- int dcnt;
-
- browser = find_kuipBrowser(w);
- get_fb_context(browser);
-
- set_icon_tb_state(icon_type);
-
- /* when a button gets unselected don't do anything */
- if (!call_data->set) return;
-
- km_set_cursor (browser, km_wait_cursor);
-
- IconBoxGetItems(dirList, &xmlist, &dcnt);
-
- /*
- * Delete all items and reset list with current path (browser_dir) and
- * icon_type.
- */
- if (icon_type == IconBoxTITLES) {
- titles = 3;
- if (dcnt) IconBoxDeleteAllItems(dirList, False);
- IconBoxSetIconType(dirList, IconBoxSMALL_ICON);
- } else {
- if (icon_type == IconBoxBIG_ICON) titles = 0;
- if (icon_type == IconBoxSMALL_ICON) titles = 1;
- if (icon_type == IconBoxNO_ICON) titles = 2;
- if (dcnt) IconBoxDeleteAllItems(dirList, False);
- IconBoxSetIconType(dirList, icon_type);
- }
- save_fb_context(browser);
-
- if (dcnt) {
- char *selected_path;
-
- selected_path = (char *) XtMalloc (MAX_string+1);
- strcpy (selected_path, browser_dir);
- do_list_content (selected_path, True);
- XtFree (selected_path);
- }
-
- km_set_cursor (browser, km_main_cursor);
-
- /* cleanup XmString list */
- if (dcnt) XtFree((char *)xmlist);
-}
-
-#ifdef ALL_CYCLE /* vms */
-/***********************************************************************
- * *
- * Get cycle flag ("All Cycles" or not) *
- * and change the dirList accordingly. *
- * *
- ***********************************************************************/
-static void change_cycle(w, tag, call_data)
- Widget w;
- caddr_t tag;
- XmToggleButtonCallbackStruct *call_data;
-{
- Widget browser;
- XmString *xmlist;
- int list, zero, all, ref, ll, dcnt, icon_type;
-
- if (call_data->set )
- km_all_cycles = 1;
- else
- km_all_cycles = 0;
-
- browser = find_kuipBrowser(w);
- get_fb_context(browser);
-
- list = DIR_LIST;
- zero = 0;
- all = 1;
- ref = 0;
- ll = strlen(browser_dir);
-
- km_set_cursor (browser, km_wait_cursor);
-
- IconBoxGetItems(dirList, &xmlist, &dcnt);
-
- /*
- * Delete all items and reset list according to km_all_cycles
- */
- if (XmToggleButtonGadgetGetState(ViewPdMenu_icon))
- icon_type = IconBoxBIG_ICON;
- else if (XmToggleButtonGadgetGetState(ViewPdMenu_sicon))
- icon_type = IconBoxSMALL_ICON;
- else if (XmToggleButtonGadgetGetState(ViewPdMenu_nicon))
- icon_type = IconBoxNO_ICON;
- else if (XmToggleButtonGadgetGetState(ViewPdMenu_title))
- icon_type = IconBoxSMALL_ICON;
- IconBoxSetIconType(dirList, icon_type);
- save_fb_context(browser);
-
- if (dcnt) {
- char *selected_path;
-
- selected_path = (char *) XtMalloc (MAX_string+1);
- strcpy (selected_path, browser_dir);
- do_list_content (selected_path, True);
- XtFree (selected_path);
- }
-
- km_set_cursor (browser, km_main_cursor);
-
- /* cleanup XmString list */
- if (dcnt) XtFree((char *)xmlist);
-}
-#endif
-
-/***********************************************************************
- * *
- * Select all decks. *
- * *
- ***********************************************************************/
-static void select_all_decks(w, browser, call_data)
- Widget w, browser;
- XmAnyCallbackStruct *call_data;
-{
- get_fb_context(browser);
-
- IconBoxSelectAllItems(dirList, True, False);
-}
-
-/***********************************************************************
- * *
- * Show (manage) PREFERENCES dialog. *
- * *
- ***********************************************************************/
-static void show_filtDialog(w, browser, call_data)
- Widget w, browser;
- XmAnyCallbackStruct *call_data;
-{
- XmString *xmlist;
- int ibr, dcnt;
- char *filter;
-
- ibr = get_fb_context(browser);
- filter = km_prompt ("Filter (on object names)",
- fbrowser[ibr].filter);
- if (filter != NULL) strcpy(fbrowser[ibr].filter, filter);
-
- km_set_cursor (browser, km_wait_cursor);
-
- IconBoxGetItems(dirList, &xmlist, &dcnt);
-
-/* Delete all items and reset list with current filter */
- if (dcnt) {
- char *selected_path;
-
- IconBoxDeleteAllItems(dirList, False);
- selected_path = (char *) XtMalloc (MAX_string+1);
- strcpy (selected_path, browser_dir);
- do_list_content (selected_path, True);
- XtFree (selected_path);
- }
-
- km_set_cursor (browser, km_main_cursor);
-
- /* cleanup XmString list */
- if (dcnt) XtFree((char *)xmlist);
- XtFree((char *)filter);
-}
-
-/***********************************************************************
- * *
- * Callbacks for "Open" menu items. *
- * *
- ***********************************************************************/
-static void FilePdMenu_o_activate (widget, tag, call_data)
- Widget widget;
- caddr_t tag;
- XmAnyCallbackStruct *call_data;
-{
- otag_str *stag = (otag_str *)tag;
-
- current_callback_data = call_data;
- km_get_curpos (call_data->event, &km_xcur_pos, &km_ycur_pos);
- exec_action( stag->bract, NULL, NULL, 1, widget, call_data);
-}
-
-/***********************************************************************
- * *
- * Callbacks for "Exit". *
- * *
- ***********************************************************************/
-static void FilePdMenu_exit (widget, tag, call_data)
- Widget widget;
- caddr_t tag;
- XmAnyCallbackStruct *call_data;
-{
- exec_cmd_string ("/KUIP/EXIT", 0, NULL);
-}
diff --git a/src/packlib/kuip/code_motif/kmdial.c b/src/packlib/kuip/code_motif/kmdial.c
deleted file mode 100644
index 7b90d06..0000000
--- a/src/packlib/kuip/code_motif/kmdial.c
+++ /dev/null
@@ -1,894 +0,0 @@
-/*
- * $Id: kmdial.c,v 1.1.1.1 1996/03/08 15:33:08 mclareni Exp $
- *
- * $Log: kmdial.c,v $
- * Revision 1.1.1.1 1996/03/08 15:33:08 mclareni
- * Kuip
- *
- */
-/*CMZ : 2.05/09 06/07/94 14.26.30 by Alfred Nathaniel*/
-/*-- Author : N.Cremel 03/04/92*/
-/******************************************************************************/
-/* */
-/* MOTIF-based library for KUIP - deck KMDIAL */
-/* */
-/* General utilitity routines for handling dialogs : */
-/* */
-/* - km_quit_confirm : Ask for confimation before quit */
-/* - km_exit_confirm : Ask for confimation before exit */
-/* - km_ask_user : Ask the user a question and wait for the answer */
-/* - km_select : Give a message with a predefined number of answers */
-/* - km_warn_user : Warn with a message and wait till acknowledge */
-/* - km_inform_user : Inform ... and wait till acknowledge */
-/* - km_prompt : Create prompt dialog and wait till OK or CANCEL */
-/* - km_prompt_answer : same as km_prompt but no CANCEL button */
-/* */
-/******************************************************************************/
-
-#include "kuip/kuip.h"
-#include "kuip/kfor.h"
-#include "kuip/kmenu.h"
-
-#include <Xm/Xm.h>
-#include <X11/Shell.h>
-#include <Xm/DialogS.h>
-#include <Xm/List.h>
-#include <Xm/MessageB.h>
-#include <Xm/SelectioB.h>
-#include <Xm/PushB.h>
-#include <Xm/Form.h>
-
-#include "mkdims.h"
-#include "kuip/mkutfu.h"
-#include "mkutfm.h"
-#include "mkutdm.h"
-
-/***********************************************************************
- * *
- * Message Box for selection with 4 buttons *
- * *
- ***********************************************************************/
-static Widget create_select4(wtop, Button)
- Widget wtop, Button[4];
-{
- Widget kuipSelect, Parent, Form;
-
- Parent = XtVaCreatePopupShell( "kuipSelect_shell",
- xmDialogShellWidgetClass, wtop,
- XmNshellUnitType, XmPIXELS,
- XmNtitle, "kuipSelect",
- NULL );
-
- Form = XtVaCreateWidget( "kuipSelect_form",
- xmFormWidgetClass,
- Parent,
- XmNunitType, XmPIXELS,
- XmNheight, 200,
- XmNwidth, 290,
- NULL );
-
- kuipSelect = XtVaCreateManagedWidget( "kuipSelect",
- xmMessageBoxWidgetClass,
- Form,
- XmNresizePolicy, XmRESIZE_NONE,
- XmNbottomAttachment, XmATTACH_FORM,
- XmNleftAttachment, XmATTACH_FORM,
- XmNrightAttachment, XmATTACH_FORM,
- XmNtopAttachment, XmATTACH_FORM,
- NULL );
-
- Button[0] = XtVaCreateManagedWidget( "okButton",
- xmPushButtonWidgetClass,
- kuipSelect,
- RES_CONVERT( XmNlabelString, " Ok " ),
- XmNx, 10,
- XmNy, 150,
- XmNrecomputeSize, FALSE,
- XmNheight, 30,
- XmNwidth, 50,
- NULL );
-
- Button[1] = XtVaCreateManagedWidget( "goButton",
- xmPushButtonWidgetClass,
- kuipSelect,
- RES_CONVERT( XmNlabelString, " Go " ),
- XmNx, 80,
- XmNy, 150,
- XmNrecomputeSize, FALSE,
- XmNheight, 30,
- XmNwidth, 50,
- NULL );
-
- Button[2] = XtVaCreateManagedWidget( "cancelButton",
- xmPushButtonWidgetClass,
- kuipSelect,
- RES_CONVERT( XmNlabelString, " Cancel " ),
- XmNx, 150,
- XmNy, 150,
- XmNrecomputeSize, FALSE,
- XmNheight, 30,
- XmNwidth, 50,
- NULL );
-
- Button[3] = XtVaCreateManagedWidget( "helpButton",
- xmPushButtonWidgetClass,
- kuipSelect,
- RES_CONVERT( XmNlabelString, " Help " ),
- XmNx, 220,
- XmNy, 150,
- XmNrecomputeSize, FALSE,
- XmNheight, 30,
- XmNwidth, 50,
- NULL );
-
- return ( kuipSelect );
-}
-
-/***********************************************************************
- * *
- * Get a response for the dialog. *
- * *
- ***********************************************************************/
-static void response(w, answer, cbs)
- Widget w;
- int *answer;
- XmAnyCallbackStruct *cbs;
-{
- if (cbs->reason == XmCR_OK)
- *answer = 1;
- else if (cbs->reason == XmCR_CANCEL)
- *answer = 2;
- else if (cbs->reason == XmCR_HELP)
- *answer = 3;
-}
-
-static void response1(w, answer, cbs)
- Widget w;
- int *answer;
- XmAnyCallbackStruct *cbs;
-{
- *answer = 1;
-}
-
-static void response2(w, answer, cbs)
- Widget w;
- int *answer;
- XmAnyCallbackStruct *cbs;
-{
- *answer = 2;
-}
-
-static void response3(w, answer, cbs)
- Widget w;
- int *answer;
- XmAnyCallbackStruct *cbs;
-{
- *answer = 3;
-}
-
-static void response4(w, answer, cbs)
- Widget w;
- int *answer;
- XmAnyCallbackStruct *cbs;
-{
- *answer = 4;
-}
-
-/***********************************************************************
- * *
- * Sets the destroyed flag for the dialog. *
- * *
- ***********************************************************************/
-static void destroy_dialog(w, destroyed, cbs)
- Widget w;
- Boolean *destroyed;
- XmAnyCallbackStruct *cbs;
-{
- *destroyed = True;
-}
-
-/***********************************************************************
- * *
- * Ask for confimation before quit (return 1 or 0) *
- * *
- ***********************************************************************/
-int km_quit_confirm()
-{
- char cmess[MAX_string];
- int answ;
-
- static char *clist[] = {"Yes", "No"};
-
- sprintf (cmess,"Do you really want to quit %s ? ",class_name);
- answ = km_select (XmDIALOG_QUESTION, cmess, 2, clist, 1);
-
- return (answ == 1 ? 1 : 0);
-}
-
-/***********************************************************************
- * *
- * Ask for confimation before exit (return 1 or 0) *
- * *
- ***********************************************************************/
-int km_exit_confirm()
-{
- char cmess[MAX_string];
- int answ;
-
- static char *clist[] = {"Yes", "No"};
-
- sprintf (cmess,"Do you really want to exit %s ? ",class_name);
-
- answ = km_select (XmDIALOG_QUESTION, cmess, 2, clist, 1);
-
- return (answ == 1 ? 1 : 0);
-}
-
-/***********************************************************************
- * *
- * Ask the user a question and wait for the answer. *
- * *
- ***********************************************************************/
-Boolean km_ask_user(parent, question, ans1, ans2, default_ans)
- Widget parent;
- char *question, *ans1, *ans2;
- int default_ans;
-{
- static Widget dialog = NULL;
- static Boolean destroyed = False;
- static int answer;
- Arg al[5];
- int ac;
- XmString xmstr, text, yes, no;
- char cval[MAX_string];
-
- answer = 0;
-
- /*
- * check if the dialog has been destroyed (because its parent
- * was destroyed)
- */
- if (destroyed) {
- destroyed = False;
- km_reset_appShell (dialog);
- dialog = NULL;
- }
-
- /*
- * the dialog should be centered around the parent, if the parent
- * changes destroy the dialog and make it for the new parent
- */
- if (dialog && parent != XtParent(XtParent(dialog))) {
- XtDestroyWidget(dialog);
- dialog = NULL;
- }
-
- if (!dialog) {
- ac = 0;
- XtSetArg(al[ac], XmNautoUnmanage, False); ac++;
- XtSetArg(al[ac], XmNdialogStyle, XmDIALOG_FULL_APPLICATION_MODAL); ac++;
- sprintf (cval, "%s Question", class_name);
- xmstr = XmStringCreateLtoR(cval, XmSTRING_DEFAULT_CHARSET);
- XtSetArg(al[ac], XmNdialogTitle, xmstr); ac++;
- XtSetArg(al[ac], XmNnoResize, True); ac++;
- XtSetArg(al[ac], XmNdeleteResponse, XmDO_NOTHING); ac++;
- dialog = XmCreateQuestionDialog(parent, "questionDialog", al, ac);
- km_store_appShell (dialog, cval);
- XtUnmanageChild(XmMessageBoxGetChild(dialog,
- XmDIALOG_CANCEL_BUTTON));
- XtAddCallback(dialog, XmNokCallback, (XtCallbackProc)response, &answer);
- XtAddCallback(dialog, XmNhelpCallback, (XtCallbackProc)response, &answer);
- XtAddCallback(dialog, XmNdestroyCallback, (XtCallbackProc)destroy_dialog,
- &destroyed);
- XmStringFree(xmstr);
- }
-
- text = XmStringCreateLtoR(question, XmSTRING_DEFAULT_CHARSET);
- yes = XmStringCreate(ans1, XmSTRING_DEFAULT_CHARSET);
- no = XmStringCreate(ans2, XmSTRING_DEFAULT_CHARSET);
- XtVaSetValues(dialog,
- XmNmessageString, text,
- XmNokLabelString, yes,
- XmNhelpLabelString, no,
- XmNdefaultButtonType, default_ans == 1 ?
- XmDIALOG_OK_BUTTON : XmDIALOG_CANCEL_BUTTON,
- NULL);
- XmStringFree(text);
- XmStringFree(yes);
- XmStringFree(no);
- XtManageChild(dialog);
-
- while (answer == 0) {
- XtAppProcessEvent(UxAppContext, XtIMAll);
- XSync(XtDisplay(dialog), 0);
- }
-
- XtUnmanageChild(dialog);
- XSync(XtDisplay(dialog), 0);
- XmUpdateDisplay(dialog);
- km_reset_appShell (dialog);
-
- return(answer == 1 ? True : False);
-}
-
-
-/***********************************************************************
- * *
- * Give the user a message with a predefined number of answers (1, 2 *
- * 3, or 4). *
- * Type of message can be : *
- * error (default) , information, question, working or warning. *
- * *
- ***********************************************************************/
-int km_select(type, message, nb_ans, answ, def_ans)
- int type, nb_ans;
- char *message;
- char **answ;
- int def_ans;
-{
- static Widget dialog = NULL;
- static Boolean destroyed = False;
- static int answer;
- Arg al[20];
- Widget mbox = 0;
- Widget pB[4];
- int i;
- XmString xmstr, text, xmlist[4];
- char cval[MAX_string];
-
- answer = 0;
- if (nb_ans > 4) nb_ans = 4;
-
- if (destroyed) {
- destroyed = False;
- km_reset_appShell (dialog);
- dialog = NULL;
- }
-
- if (dialog) {
- XtDestroyWidget(dialog);
- dialog = NULL;
- }
-
- if (nb_ans == 4) {
- km_all_cursor(KM_WAIT_CURSOR);
- mbox = create_select4(km_toplevel, pB);
- dialog = XtParent (mbox);
- } else {
- dialog = XmCreateMessageDialog(km_toplevel, "kuipSelect", al, 0);
- }
-
- if (type == XmDIALOG_ERROR) {
- sprintf (cval, "%s Error", class_name);
- } else if (type == XmDIALOG_INFORMATION) {
- sprintf (cval, "%s Information", class_name);
- } else if (type == XmDIALOG_MESSAGE) {
- sprintf (cval, "%s Message", class_name);
- } else if (type == XmDIALOG_QUESTION) {
- sprintf (cval, "%s Question", class_name);
- } else if (type == XmDIALOG_WARNING) {
- sprintf (cval, "%s Warning", class_name);
- } else if (type == XmDIALOG_WORKING) {
- sprintf (cval, "%s Working", class_name);
- } else {
- sprintf (cval, "%s Message", class_name);
- }
- xmstr = XmStringCreateLtoR(cval, XmSTRING_DEFAULT_CHARSET);
-
- XtVaSetValues(dialog,
- XmNdeleteResponse, XmDO_NOTHING,
- XmNdialogStyle, XmDIALOG_APPLICATION_MODAL,
- NULL);
-
- if (nb_ans < 4) {
- XtVaSetValues(dialog,
- XmNautoUnmanage, False,
- XmNnoResize, True,
- XmNdialogType, (unsigned char) type,
- XmNdialogTitle, xmstr,
- NULL);
- } else {
- XtVaSetValues(mbox,
- XmNautoUnmanage, False,
- XmNnoResize, True,
- XmNdialogType, (unsigned char) type,
- XmNdialogTitle, xmstr,
- NULL);
- }
-
- km_store_appShell (dialog, cval);
- XmStringFree(xmstr);
- XtAddCallback(dialog, XmNdestroyCallback, (XtCallbackProc)destroy_dialog,
- &destroyed);
-
- text = XmStringCreateLtoR(message, XmSTRING_DEFAULT_CHARSET);
- for (i = 0; i < nb_ans; i++)
- xmlist[i] = XmStringCreate(answ[i], XmSTRING_DEFAULT_CHARSET);
- if (nb_ans == 1) /* ok callback */ {
- XtUnmanageChild(XmMessageBoxGetChild(dialog, XmDIALOG_CANCEL_BUTTON));
- XtUnmanageChild(XmMessageBoxGetChild(dialog, XmDIALOG_HELP_BUTTON));
- XtAddCallback(dialog, XmNokCallback, (XtCallbackProc)response, &answer);
- XtVaSetValues(dialog,
- XmNmessageString, text,
- XmNokLabelString, xmlist[0],
- XmNdefaultButtonType, XmDIALOG_OK_BUTTON,
- NULL);
- } else if (nb_ans == 2) /* ok, cancel callbacks */ {
- XtUnmanageChild(XmMessageBoxGetChild(dialog, XmDIALOG_HELP_BUTTON));
- XtAddCallback(dialog, XmNokCallback, (XtCallbackProc)response, &answer);
- XtAddCallback(dialog, XmNcancelCallback, (XtCallbackProc)response,
- &answer);
- XtVaSetValues(dialog,
- XmNmessageString, text,
- XmNokLabelString, xmlist[0],
- XmNcancelLabelString, xmlist[1],
- XmNdefaultButtonType, def_ans == 1 ?
- XmDIALOG_OK_BUTTON :
- XmDIALOG_CANCEL_BUTTON,
- NULL);
- } else if (nb_ans == 3) /* ok, cancel and help callbacks */ {
- XtAddCallback(dialog, XmNokCallback, (XtCallbackProc)response, &answer);
- XtAddCallback(dialog, XmNcancelCallback, (XtCallbackProc)response,
- &answer);
- XtAddCallback(dialog, XmNhelpCallback, (XtCallbackProc)response, &answer);
- XtVaSetValues(dialog,
- XmNmessageString, text,
- XmNokLabelString, xmlist[0],
- XmNcancelLabelString, xmlist[1],
- XmNhelpLabelString, xmlist[2],
- NULL);
- if (def_ans == 1) {
- XtVaSetValues(dialog,
- XmNdefaultButtonType, XmDIALOG_OK_BUTTON,
- NULL);
- } else if (def_ans == 2) {
- XtVaSetValues(dialog,
- XmNdefaultButtonType, XmDIALOG_CANCEL_BUTTON,
- NULL);
- } else if (def_ans == 3) {
- XtVaSetValues(dialog,
- XmNdefaultButtonType, XmDIALOG_HELP_BUTTON,
- NULL);
- }
- } else if (nb_ans == 4) /* ok, cancel, go and help callbacks */ {
- XtUnmanageChild(XmMessageBoxGetChild(mbox, XmDIALOG_OK_BUTTON));
- XtUnmanageChild(XmMessageBoxGetChild(mbox, XmDIALOG_CANCEL_BUTTON));
- XtUnmanageChild(XmMessageBoxGetChild(mbox, XmDIALOG_HELP_BUTTON));
- XtAddCallback(pB[0], XmNactivateCallback, (XtCallbackProc)response1,
- &answer);
- XtAddCallback(pB[1], XmNactivateCallback, (XtCallbackProc)response2,
- &answer);
- XtAddCallback(pB[2], XmNactivateCallback, (XtCallbackProc)response3,
- &answer);
- XtAddCallback(pB[3], XmNactivateCallback, (XtCallbackProc)response4,
- &answer);
- XtVaSetValues(mbox,
- XmNmessageString, text,
- NULL);
- for (i = 0; i < nb_ans; i++)
- XtVaSetValues(pB[i], XmNlabelString, xmlist[i], NULL);
- }
- XmStringFree(text);
- for (i = 0; i < nb_ans; i++) XmStringFree(xmlist[i]);
-
- XtManageChild(dialog);
-
- while (answer == 0) {
- XtAppProcessEvent(UxAppContext, XtIMAll);
- XSync(XtDisplay(dialog), 0);
- }
-
- XtUnmanageChild(dialog);
- XSync(XtDisplay(dialog), 0);
- XmUpdateDisplay(dialog);
- km_reset_appShell (dialog);
- if (nb_ans == 4) km_all_cursor(KM_MAIN_CURSOR);
-
- return (answer);
-}
-
-/***********************************************************************
- * *
- * Warn the user with a message and wait till he acknowledges. *
- * *
- ***********************************************************************/
-void km_warn_user(parent, warning, command)
- Widget parent;
- char *warning, *command;
-{
- static Widget dialog = NULL;
- static Boolean destroyed = False;
- static int answer;
- Arg al[5];
- int ac;
- XmString xmstr, text;
- char cval[MAX_string];
-
- answer = 0;
-
- if (destroyed) {
- destroyed = False;
- km_reset_appShell (dialog);
- dialog = NULL;
- }
-
- if (dialog && parent != XtParent(XtParent(dialog))) {
- XtDestroyWidget(dialog);
- dialog = NULL;
- }
-
- if (!dialog) {
- ac = 0;
- XtSetArg(al[ac], XmNautoUnmanage, False); ac++;
- XtSetArg(al[ac], XmNdialogStyle, XmDIALOG_FULL_APPLICATION_MODAL); ac++;
- sprintf (cval, "%s Warning", class_name);
- xmstr = XmStringCreateLtoR(cval, XmSTRING_DEFAULT_CHARSET);
- XtSetArg(al[ac], XmNdialogTitle, xmstr); ac++;
- XtSetArg(al[ac], XmNnoResize, True); ac++;
- XtSetArg(al[ac], XmNdeleteResponse, XmDO_NOTHING); ac++;
- dialog = XmCreateWarningDialog(parent, "warningDialog", al, ac);
- km_store_appShell (dialog, cval);
- XtUnmanageChild(XmMessageBoxGetChild(dialog,
- XmDIALOG_CANCEL_BUTTON));
- XtAddCallback(dialog, XmNokCallback, (XtCallbackProc)response, &answer);
- XtAddCallback(dialog, XmNdestroyCallback, (XtCallbackProc)destroy_dialog,
- &destroyed);
- XmStringFree(xmstr);
- }
-
- XtRemoveAllCallbacks(dialog, XmNhelpCallback);
- if (strlen(command) == 0)
- XtUnmanageChild(XmMessageBoxGetChild(dialog,
- XmDIALOG_HELP_BUTTON));
- else {
- XtManageChild(XmMessageBoxGetChild(dialog,
- XmDIALOG_HELP_BUTTON));
- XtAddCallback(dialog, XmNhelpCallback,
- (XtCallbackProc)km_help_cb, command);
- }
-
- text = XmStringCreateLtoR(warning, XmSTRING_DEFAULT_CHARSET);
- XtVaSetValues(dialog,
- XmNmessageString, text,
- NULL);
- XmStringFree(text);
- XtManageChild(dialog);
-
- while (answer == 0) {
- XtAppProcessEvent(UxAppContext, XtIMAll);
- XSync(XtDisplay(dialog), 0);
- }
-
- XtUnmanageChild(dialog);
- XSync(XtDisplay(dialog), 0);
- XmUpdateDisplay(dialog);
- km_reset_appShell (dialog);
-}
-
-/***********************************************************************
- * *
- * Inform the user with a message and wait till he acknowledges. *
- * *
- ***********************************************************************/
-void km_inform_user(parent, warning, command)
- Widget parent;
- char *warning, *command;
-{
- static Widget dialog = NULL;
- static Boolean destroyed = False;
- static int answer;
- Arg al[5];
- int ac;
- XmString xmstr, text;
- char cval[MAX_string];
-
- answer = 0;
-
- if (destroyed) {
- destroyed = False;
- km_reset_appShell (dialog);
- dialog = NULL;
- }
-
- if (dialog && parent != XtParent(XtParent(dialog))) {
- XtDestroyWidget(dialog);
- dialog = NULL;
- }
-
- if (!dialog) {
- ac = 0;
- XtSetArg(al[ac], XmNautoUnmanage, False); ac++;
- XtSetArg(al[ac], XmNdialogStyle, XmDIALOG_FULL_APPLICATION_MODAL); ac++;
- sprintf (cval, "%s Information", class_name);
- xmstr = XmStringCreateLtoR(cval, XmSTRING_DEFAULT_CHARSET);
- XtSetArg(al[ac], XmNdialogTitle, xmstr); ac++;
- XtSetArg(al[ac], XmNnoResize, True); ac++;
- XtSetArg(al[ac], XmNdeleteResponse, XmDO_NOTHING); ac++;
- dialog = XmCreateInformationDialog(parent, "informationDialog", al, ac);
- km_store_appShell (dialog, cval);
- XtUnmanageChild(XmMessageBoxGetChild(dialog,
- XmDIALOG_CANCEL_BUTTON));
- XtAddCallback(dialog, XmNokCallback, (XtCallbackProc)response, &answer);
- XtAddCallback(dialog, XmNdestroyCallback, (XtCallbackProc)destroy_dialog,
- &destroyed);
- XmStringFree(xmstr);
- }
-
- XtRemoveAllCallbacks(dialog, XmNhelpCallback);
- if (strlen(command) == 0)
- XtUnmanageChild(XmMessageBoxGetChild(dialog,
- XmDIALOG_HELP_BUTTON));
- else {
- XtManageChild(XmMessageBoxGetChild(dialog,
- XmDIALOG_HELP_BUTTON));
- XtAddCallback(dialog, XmNhelpCallback,
- (XtCallbackProc)km_help_cb, command);
- }
-
- text = XmStringCreateLtoR(warning, XmSTRING_DEFAULT_CHARSET);
- XtVaSetValues(dialog,
- XmNmessageString, text,
- NULL);
- XmStringFree(text);
- XtManageChild(dialog);
-
- while (answer == 0) {
- XtAppProcessEvent(UxAppContext, XtIMAll);
- XSync(XtDisplay(dialog), 0);
- }
-
- XtUnmanageChild(dialog);
- XSync(XtDisplay(dialog), 0);
- XmUpdateDisplay(dialog);
- km_reset_appShell (dialog);
-}
-
-/***********************************************************************
- * *
- * Get user input for the prompt dialog. *
- * *
- ***********************************************************************/
-static void get_input(w, answer, cbs)
- Widget w;
- int *answer;
- XmSelectionBoxCallbackStruct *cbs;
-{
- char *text;
-
- if (cbs->reason == XmCR_OK) {
- text = km_normal_string(cbs->value);
- *answer = strlen(text);
- if (*answer == 0) *answer = 1; /* empty string */
- XtFree(text);
- } else if (cbs->reason == XmCR_CANCEL) {
- *answer = -1;
- }
-}
-
-
-/***********************************************************************
- * *
- * Create prompt dialog and wait till the user press OK or CANCEL *
- * Return the answer for OK or NULL string for CANCEL. *
- * *
- ***********************************************************************/
-
-static char *prompt_dialog (prompt, init_string, cancel_flag)
- char *prompt, *init_string;
- int cancel_flag;
-{
- static Widget dialog = NULL;
- static Boolean destroyed = False;
- static int answer;
- Arg al[20];
- int ac;
- XmString xmstr1;
- XmString xmstr2 = NULL;
- XmString xmstr3 = NULL;
- char cval[MAX_string];
-
- answer = 0;
-
- if (destroyed) {
- destroyed = False;
- km_reset_appShell (dialog);
- dialog = NULL;
- }
-
- if (dialog) {
- XtDestroyWidget(dialog);
- dialog = NULL;
- }
-
- ac = 0;
- XtSetArg(al[ac], XmNautoUnmanage, False); ac++;
- XtSetArg(al[ac], XmNdialogStyle, XmDIALOG_FULL_APPLICATION_MODAL); ac++;
- sprintf (cval, "%s Prompt", class_name);
- xmstr1 = XmStringCreateLtoR(cval, XmSTRING_DEFAULT_CHARSET);
- XtSetArg(al[ac], XmNdialogTitle, xmstr1); ac++;
- XtSetArg(al[ac], XmNdeleteResponse, XmDO_NOTHING); ac++;
- if (prompt != NULL) {
- xmstr2 = XmStringCreateLtoR(prompt, XmSTRING_DEFAULT_CHARSET);
- XtSetArg(al[ac], XmNselectionLabelString, xmstr2); ac++;
- }
- if (init_string != NULL) {
- xmstr3 = XmStringCreateLtoR(init_string, XmSTRING_DEFAULT_CHARSET);
- XtSetArg(al[ac], XmNtextString, xmstr3); ac++;
- }
- XtSetArg(al[ac], XmNtextColumns, 40); ac++;
- dialog = XmCreatePromptDialog(km_toplevel, "promptDialog", al, ac);
- km_store_appShell (dialog, cval);
- XmStringFree(xmstr1);
- if (xmstr2 != NULL)
- XmStringFree(xmstr2);
- if (xmstr3 != NULL)
- XmStringFree(xmstr3);
- XtUnmanageChild(XmSelectionBoxGetChild(dialog,
- XmDIALOG_HELP_BUTTON));
- if (cancel_flag == 0) /* False */
- XtUnmanageChild(XmSelectionBoxGetChild(dialog,
- XmDIALOG_CANCEL_BUTTON));
- XtAddCallback(dialog, XmNokCallback, (XtCallbackProc)get_input, &answer);
- if (cancel_flag != 0) /* True */
- XtAddCallback(dialog, XmNcancelCallback,
- (XtCallbackProc)get_input, &answer);
- XtAddCallback(dialog, XmNdestroyCallback, (XtCallbackProc)destroy_dialog,
- &destroyed);
-
- XtManageChild(dialog);
-
- while (answer == 0) {
- XtAppProcessEvent(UxAppContext, XtIMAll);
- XSync(XtDisplay(dialog), 0);
- }
-
- XtUnmanageChild(dialog);
- XSync(XtDisplay(dialog), 0);
- XmUpdateDisplay(dialog);
- km_reset_appShell (dialog);
-
- if (answer > 0) {
- XmString text;
- char *t;
-
- XtVaGetValues(dialog, XmNtextString, &text, NULL);
- if( XmStringGetLtoR(text, XmSTRING_DEFAULT_CHARSET, &t) ) {
- char *rep = strdup(t);
- XtFree(t);
- XmStringFree(text);
- return rep;
- }
- XmStringFree(text);
- return strdup( "" );
- }
-
- return NULL;
-}
-
-char *km_prompt (prompt, init_string)
- char *prompt, *init_string;
-{
- return prompt_dialog (prompt, init_string, 1);
-}
-
-char *km_prompt_answer (prompt, init_string)
- char *prompt, *init_string;
-{
- return prompt_dialog (prompt, init_string, 0);
-}
-
-/***********************************************************************
- * *
- * Get the passwd keystroke by keystroke and replace the typed *
- * characters by *'s. *
- * *
- ***********************************************************************/
-void check_passwd(text_w, passwd, cbs)
-Widget text_w;
-char *passwd;
-XmTextVerifyCallbackStruct *cbs;
-{
- int len;
-
- if (cbs->text->ptr == NULL) { /* backspace */
- cbs->endPos = strlen(passwd); /* delete from here to end */
- passwd[cbs->startPos] = 0; /* backspace--terminate */
- return;
- }
-
- if (cbs->text->length > 1) {
- cbs->doit = False; /* don't allow "paste" operations */
- return; /* make the user *type* the password! */
- }
-
- strncat(passwd, cbs->text->ptr, cbs->text->length);
- passwd[cbs->endPos + cbs->text->length] = 0;
-
- for (len = 0; len < cbs->text->length; len++)
- cbs->text->ptr[len] = '*';
-}
-
-/***********************************************************************
- * *
- * Create password prompt dialog and wait till the user presses OK *
- * or CANCEL. This routine is identical to km_prompt except that it *
- * replaces the typed characters by *'s. *
- * Return the answer for OK or NULL string for CANCEL. *
- * *
- ***********************************************************************/
-char *km_passwd_prompt (prompt)
- char *prompt;
-{
- static Widget dialog = NULL;
- static Boolean destroyed = False;
- static int answer;
- static char passwd[MAX_string];
- Widget text_w;
- Arg al[20];
- int ac;
- XmString xmstr1;
- XmString xmstr2 = NULL;
- char cval[MAX_string];
-
- answer = 0;
- passwd[0] = '\0';
-
- if (destroyed) {
- destroyed = False;
- km_reset_appShell (dialog);
- dialog = NULL;
- }
-
- if (dialog) {
- XtDestroyWidget(dialog);
- dialog = NULL;
- }
-
- ac = 0;
- XtSetArg(al[ac], XmNautoUnmanage, False); ac++;
- XtSetArg(al[ac], XmNdialogStyle, XmDIALOG_FULL_APPLICATION_MODAL); ac++;
- sprintf (cval, "%s Password Prompt", class_name);
- xmstr1 = XmStringCreateLtoR(cval, XmSTRING_DEFAULT_CHARSET);
- XtSetArg(al[ac], XmNdialogTitle, xmstr1); ac++;
- XtSetArg(al[ac], XmNdeleteResponse, XmDO_NOTHING); ac++;
- if (prompt != NULL) {
- xmstr2 = XmStringCreateLtoR(prompt, XmSTRING_DEFAULT_CHARSET);
- XtSetArg(al[ac], XmNselectionLabelString, xmstr2); ac++;
- }
-
- XtSetArg(al[ac], XmNtextColumns, 40); ac++;
- dialog = XmCreatePromptDialog(km_toplevel, "promptDialog", al, ac);
- km_store_appShell (dialog, cval);
- XmStringFree(xmstr1);
- if (xmstr2 != NULL)
- XmStringFree(xmstr2);
- XtUnmanageChild(XmSelectionBoxGetChild(dialog,
- XmDIALOG_HELP_BUTTON));
- XtAddCallback(dialog, XmNokCallback, (XtCallbackProc)get_input, &answer);
- XtAddCallback(dialog, XmNcancelCallback, (XtCallbackProc)get_input, &answer);
- XtAddCallback(dialog, XmNdestroyCallback, (XtCallbackProc)destroy_dialog,
- &destroyed);
-
- /* get the text widget and install modify callback */
- text_w = XmSelectionBoxGetChild(dialog, XmDIALOG_TEXT);
- XtAddCallback(text_w, XmNmodifyVerifyCallback, (XtCallbackProc)check_passwd,
- passwd);
-
- XtManageChild(dialog);
-
- while (answer == 0) {
- XtAppProcessEvent(UxAppContext, XtIMAll);
- XSync(XtDisplay(dialog), 0);
- }
-
- XtUnmanageChild(dialog);
- XSync(XtDisplay(dialog), 0);
- XmUpdateDisplay(dialog);
- km_reset_appShell (dialog);
-
- if (answer > 0) {
- return strdup(passwd);
- }
-
- return NULL;
-}
diff --git a/src/packlib/kuip/code_motif/kmfile.c b/src/packlib/kuip/code_motif/kmfile.c
deleted file mode 100644
index 401b177..0000000
--- a/src/packlib/kuip/code_motif/kmfile.c
+++ /dev/null
@@ -1,425 +0,0 @@
-/*
- * $Id: kmfile.c,v 1.2 2006/12/07 13:26:52 mclareni Exp $
- *
- * $Log: kmfile.c,v $
- * Revision 1.2 2006/12/07 13:26:52 mclareni
- * Corrections for MacOSX on Intel
- *
- * Revision 1.1.1.1 1996/03/08 15:33:08 mclareni
- * Kuip
- *
- */
-/*CMZ : 2.05/00 24/03/94 17.50.15 by N.Cremel*/
-/*-- Author : Nicole Cremel*/
-/***********************************************************************
- * *
- * Filesystem scanning routines. *
- * *
- ***********************************************************************/
-
-#include "kuip/kuip.h"
-#include "kuip/mkutfu.h"
-#include "mkutda.h"
-#ifdef CERNLIB_MACOSX
-#include <regex.h>
-#endif
-
-static char **ftype_list = NULL;
-static char **class_list = NULL;
-static char **stext_list = NULL;
-static int *strip_list = NULL;
-static int ntype_list = 0;
-
-
-static int comp_list( s1, s2 )
- void **s1;
- void **s2;
-{
- return strcmp( *s1, *s2 );
-}
-
-
-/*
- * Register the class name and short text for a file name with extension ftype
- */
-void km_file_type( ftype, class, stext, strip )
- char *ftype;
- char *class;
- char *stext;
- int strip;
-{
- if( ntype_list++ == 0 ) {
- ftype_list = (char**)malloc( sizeof(char*) );
- class_list = (char**)malloc( sizeof(char*) );
- stext_list = (char**)malloc( sizeof(char*) );
- strip_list = (int*)malloc( sizeof(int) );
- }
- else {
- ftype_list = (char**)realloc( (char*)ftype_list,
- ntype_list * sizeof(char*) );
- class_list = (char**)realloc( (char*)class_list,
- ntype_list * sizeof(char*) );
- stext_list = (char**)realloc( (char*)stext_list,
- ntype_list * sizeof(char*) );
- strip_list = (int*)realloc( (char*)strip_list,
- ntype_list * sizeof(int) );
- }
- ftype_list[ntype_list-1] = strdup( ftype );
- class_list[ntype_list-1] = strdup( class );
- stext_list[ntype_list-1] = strdup( stext );
- strip_list[ntype_list-1] = strip;
-}
-
-
-/***********************************************************************
- * *
- * Scan directory using filter *
- * *
- ***********************************************************************/
-char **km_scan_dir( bpath, def_filter, n, strip )
- char *bpath; /* directory path */
- char *def_filter;
- int n;
- int strip;
-{
- static char *obj_desc[4];
- static char **dirlist;
- static int ndlist;
- static char **filelist;
- static int nflist;
- static char *path;
- static char *filter;
- int i;
-
- if( n == 0 ) {
-#ifdef vms
- char *p;
-#else
- DIR *dirp;
- struct dirent *dp;
- char *pattern;
-#ifdef CERNLIB_MACOSX
- regex_t *re;
-#else
- char *re;
-#endif
-#endif
- struct stat filestatus;
-
- ndlist = 0;
- nflist = 0;
-
- path = bpath;
- if( path == NULL || *path == '\0' ) {
- static char cwd[256];
- path = getcwd( cwd, (sizeof cwd) );
- }
-
- filter = km_get_br_filter();
- if( filter == NULL || *filter == '\0' || strip )
- filter = def_filter;
-
- /* allocate space for the list that will contain all filtered entries */
- dirlist = (char**)malloc( sizeof(char*) );
- filelist = (char**)malloc( sizeof(char*) );
-
- obj_desc[1] = "DirUpFile";
- obj_desc[2] = NULL;
- obj_desc[3] = "(... go up)";
-
-#ifdef vms
-
- obj_desc[0] = "[-]";
-
- for( i = 0; i < 2; i++ ) {
- struct dsc$descriptor_s fspec_dsc;
- struct dsc$descriptor_d match_dsc;
- int context = 0;
- int istat;
-
- fspec_dsc.dsc$b_dtype = DSC$K_DTYPE_T;
- fspec_dsc.dsc$b_class = DSC$K_CLASS_S;
- if( i == 0 )
- fspec_dsc.dsc$a_pointer = str2dup( path, "*.DIR" );
- else {
- fspec_dsc.dsc$a_pointer = str2dup( path, filter );
- if( strchr( filter, '.' ) == NULL )
-#ifdef ALL_CYCLE /* vms */
- if (km_all_cycles == 1)
- fspec_dsc.dsc$a_pointer =
- mstrcat( fspec_dsc.dsc$a_pointer, ".*;*" );
- else
-#else
- fspec_dsc.dsc$a_pointer = mstrcat( fspec_dsc.dsc$a_pointer, ".*" );
-#endif
- }
- fspec_dsc.dsc$w_length = strlen( fspec_dsc.dsc$a_pointer );
-
- match_dsc.dsc$b_dtype = DSC$K_DTYPE_T;
- match_dsc.dsc$b_class = DSC$K_CLASS_D;
- match_dsc.dsc$w_length = 0;
- match_dsc.dsc$a_pointer = NULL;
-
- while( 1 ) {
- istat = lib$find_file( &fspec_dsc, &match_dsc, &context );
- if( istat != RMS$_NORMAL )
- break;
-
- if( i == 0 ) {
- /* directories first */
- char *dirname = strndup( match_dsc.dsc$a_pointer,
- match_dsc.dsc$w_length );
- /* transform "disk:[dir]sub.DIR" into "[.sub] */
- char *p = strrchr( dirname, ']' );
- if( p == NULL )
- p = strrchr( dirname, ':' );
- if( p != NULL )
- strcpy( dirname, p + 1 );
- if( (p = strchr( dirname, '.' )) != NULL )
- *p = '\0';
- dirlist = (char**)realloc( (char*)dirlist,
- (ndlist+1) * sizeof(char*) );
- dirlist[ndlist++] = str3dup( "[.", dirname, "]" );
- free( dirname );
- }
-
- else {
- /* regular files */
- char *filename = strndup( match_dsc.dsc$a_pointer,
- match_dsc.dsc$w_length );
- if( strstr( filename, ".DIR;" ) == NULL ) {
- /* it is not a directory again matching the wildcard */
- char *p = strrchr( filename, ';' );
- if( p != NULL ) /* remove version number */
- *p = '\0';
- p = strrchr( filename, ']' );
- if( p == NULL )
- p = strrchr( filename, ':' );
- if( p == NULL )
- p = filename;
- else
- p++;
- filelist = (char**)realloc( (char*)filelist,
- (nflist+1) * sizeof(char*) );
- filelist[nflist++] = strdup( p );
- }
- free( filename );
- }
- }
- lib$find_file_end( &context );
- free( fspec_dsc.dsc$a_pointer );
- }
-
-#else /* UNIX */
-
- /* translate file wildcard characters to regex specials */
- pattern = strdup( "^" );
- for( i = 0; filter[i] != '\0'; i++ ) {
- switch( filter[i] ) {
- case '*':
- pattern = mstrcat( pattern, ".*" );
- break;
- case '?':
- pattern = mstrcat( pattern, "." );
- break;
- case '.':
- pattern = mstrcat( pattern, "\\." );
- break;
- default:
- pattern = mstrccat( pattern, filter[i], 1 );
- break;
- }
- }
- pattern = mstrcat( pattern, "$" );
-#ifdef MATCH_RE_COMP
- re = re_comp( pattern );
-#else
-#ifdef CERNLIB_MACOSX
- regcomp(re, pattern, REG_EXTENDED);
-#else
- re = regcmp( pattern, NULL );
-#endif
-#endif
- free( pattern );
-
- /*
- * Change directory to path and open the directory.
- * Next read the whole directory and store the matching entries
- * into filelist.
- */
- if( (dirp = opendir( path )) != NULL ) {
- char dirpath[256];
- int lpath = strlen( path );
- strcpy( dirpath, path );
- strcpy( dirpath + lpath, "/" );
- lpath++;
-
- while( (dp = readdir(dirp)) != NULL ) {
-
- if( strcmp( dp->d_name, "." ) == 0
- || strcmp( dp->d_name, ".." ) == 0 )
- /* ignore pseudo directories */
- continue;
-
- strcpy( dirpath + lpath, dp->d_name );
- if( stat( dirpath, &filestatus ) != 0 )
- continue;
-
- if( (filestatus.st_mode & S_IFMT) == S_IFDIR ) {
- /* directories always go into the list */
- dirlist = (char**)realloc( (char*)dirlist,
- (ndlist+1) * sizeof(char*) );
- dirlist[ndlist] = strdup( dp->d_name );
- ndlist++;
- }
- else if( (filestatus.st_mode & S_IFMT) == S_IFREG ) {
- /* regular file: match name against regexp */
-#ifdef MATCH_RE_COMP
- int match = re_exec( dp->d_name );
-#else
-#ifdef CERNLIB_MACOSX
- int match = (regexec(re, dp->d_name,NULL,NULL,0) == 0);
-#else
- int match = (regex( re, dp->d_name ) != NULL);
-#endif
-#endif
- if( match == 1 ) {
- filelist = (char**)realloc( (char*)filelist,
- (nflist+1) * sizeof(char*) );
- filelist[nflist] = strdup( dp->d_name );
- nflist++;
- }
- }
- }
- closedir( dirp );
- }
-
-#ifndef MATCH_RE_COMP
- free( re );
-#endif
-
- obj_desc[0] = "..";
-
-#endif /* VMS or UNIX */
-
- /* alphabetically sort the entries */
- qsort( (void*)dirlist, ndlist, sizeof(char*), (int(*)())comp_list );
- qsort( (void*)filelist, nflist, sizeof(char*), (int(*)())comp_list );
-
- return obj_desc; /* .. */
- }
-
- if( --n < ndlist ) { /* return directories first */
- static char dirpath[256];
- char *dirname = dirlist[n];
- obj_desc[0] = dirname;
- obj_desc[1] = "DirFile";
- strcpy( dirpath, path );
-#ifdef vms
- strcat( dirpath, dirname + 2 );
- strcpy( dirpath + strlen( dirpath ) - 1, ".DIR;*" );
-#else
- strcat( dirpath, "/" );
- strcat( dirpath, dirname );
-#endif
- obj_desc[2] = dirpath;
- obj_desc[3] = "(Directory)";
- return obj_desc;
- }
-
- else if( n < ndlist + nflist ) { /* regular files next */
- static char filepath[256];
- char *filename = filelist[n-ndlist];
- int lfile = strlen( filename );
-
- obj_desc[0] = filename;
- strcpy( filepath, path );
-#ifdef vms
- strcat( filepath, filename );
-#else
- strcat( filepath, "/" );
- strcat( filepath, filename );
-#endif
- obj_desc[2] = filepath;
-
- /* set the default class name depending on file permission */
-#ifdef vms
- if( access( filepath, W_OK ) == 0 ) {
- obj_desc[1] = "VmsRwFile";
- obj_desc[3] = "(Read/Write)";
- }
- else if( access( filepath, R_OK ) == 0 ) {
- obj_desc[1] = "VmsRoFile";
- obj_desc[3] = "(Read Only)";
- }
- else {
- obj_desc[1] = "VmsNoFile";
- obj_desc[3] = "(No Access)";
- }
-#else
- if( access( filepath, X_OK ) == 0 ) {
- obj_desc[1] = "ExFile";
- obj_desc[3] = "(Executable)";
- }
- else if( access( filepath, W_OK ) == 0 ) {
- obj_desc[1] = "RwFile";
- obj_desc[3] = "(Read/Write)";
- }
- else if( access( filepath, R_OK ) == 0 ) {
- obj_desc[1] = "RoFile";
- obj_desc[3] = "(Read Only)";
- }
- else {
- obj_desc[1] = "NoFile";
- obj_desc[3] = "(No Access)";
- }
-#endif
-
- if( ntype_list == 0 ) {
- km_file_type( ".kumac", "MacFile", "(Kuip Macro)", 1 );
- km_file_type( ".ps", "PSFile", "(PostScript File)", 1 );
- km_file_type( ".eps", "EPSFile", "(Encapsulated PostScript File)", 1 );
-#ifdef vms
- km_file_type( ".com", "VmsComFile", "(Command Script)", 0 );
- km_file_type( ".exe", "VmsExeFile", "(Executable)", 0 );
-#endif
- }
-
- /* override default class name depending on file type */
- for( i = 0; i < ntype_list; i++ ) {
- int ltype = strlen( ftype_list[i] );
-#ifdef vms
- /* ignore version number in comparsion */
- char *p = strchr( filename, ';' );
- if( p != NULL )
- lfile = p - filename;
-#ifdef ALL_CYCLE /* vms */
- if (km_all_cycles == 0)
- filename[lfile] = '\0'; /* chop off version number */
-#endif
-#endif
- if( strncasecmp( filename + lfile - ltype,
- ftype_list[i], ltype ) == 0 ) {
- obj_desc[1] = class_list[i];
- obj_desc[3] = stext_list[i];
- if( strip_list[i] && strip )
- filename[lfile-ltype] = '\0'; /* chop off file extension */
- break;
- }
- }
- return obj_desc;
- }
-
- /* cleanup after end of list */
- for( i = 0; i < ndlist; i++ )
- free( dirlist[i] );
- free( (char*)dirlist );
-
- for( i = 0; i < nflist; i++ )
- free( filelist[i] );
- free( (char*)filelist );
-
- return NULL;
-}
-
-
diff --git a/src/packlib/kuip/code_motif/kmiout.c b/src/packlib/kuip/code_motif/kmiout.c
deleted file mode 100644
index eb6a64e..0000000
--- a/src/packlib/kuip/code_motif/kmiout.c
+++ /dev/null
@@ -1,968 +0,0 @@
-/*
- * $Id: kmiout.c,v 1.1.1.1 1996/03/08 15:33:08 mclareni Exp $
- *
- * $Log: kmiout.c,v $
- * Revision 1.1.1.1 1996/03/08 15:33:08 mclareni
- * Kuip
- *
- */
-/*CMZ : 2.06/03 06/01/95 17.10.55 by N.Cremel*/
-/*-- Author : N.Cremel 03/04/92*/
-/***********************************************************************
- * *
- * Input / Output re-direction *
- * *
- * (from file init.c) *
- * *
- ***********************************************************************/
-
-#include "kuip/kuip.h"
-#include "kuip/kfor.h"
-#include "kuip/klink.h"
-#include "kuip/kmenu.h"
-#include "kuip/kflag.h"
-#include "kuip/ksig.h"
-
-#include <X11/StringDefs.h>
-#include <X11/Intrinsic.h>
-#include <X11/cursorfont.h>
-#include <Xm/Xm.h>
-#ifdef VMS
-#include <processes.h>
-#include <unixio.h>
-#endif /* VMS */
-
-#include "mkdims.h"
-#include "mkutfm.h"
-#include "mkutdm.h"
-#include "kuip/mkutfu.h"
-#define CONTEXT_MACRO_ACCESS 1
-#include "mkuxsc.h"
-#include "mkuxs1.h"
-#undef CONTEXT_MACRO_ACCESS
-#include "kuip/mkterm.h"
-#if defined(CERNLIB_VMS)
-#include "kuip/mkqio.h"
-#endif
-
-
-#if 0
-/* Icon file for help */
-#define help_width 50
-#define help_height 50
-static char help_bits[] = {
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x0f, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0xfe, 0x3f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x7f, 0xfe, 0x00, 0x00,
- 0x00, 0x00, 0x80, 0x07, 0xe0, 0x01, 0x00, 0x00, 0x00, 0xc0, 0x03, 0xc0,
- 0x03, 0x00, 0x00, 0x00, 0xe0, 0x00, 0x00, 0x07, 0x00, 0x00, 0x00, 0xe0,
- 0x00, 0x00, 0x07, 0x00, 0x00, 0x00, 0xe0, 0x00, 0x00, 0x07, 0x00, 0x00,
- 0x00, 0xe0, 0x00, 0x00, 0x07, 0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0x03,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0xc0, 0x03, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0xe0, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x70, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x38, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x1e, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x0f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x07,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x07, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x07, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x07, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x07, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x07, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x18, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x08, 0x00, 0x00, 0xfc, 0xc3, 0x00, 0x00, 0x08,
- 0x00, 0x00, 0x06, 0xc4, 0xc1, 0x00, 0x08, 0x00, 0x00, 0x02, 0x22, 0x81,
- 0x00, 0x08, 0x00, 0x00, 0x02, 0x22, 0x01, 0x01, 0x08, 0x00, 0x00, 0x03,
- 0x22, 0x01, 0x01, 0x08, 0x00, 0x00, 0x01, 0x21, 0x02, 0x02, 0x08, 0x00,
- 0x00, 0x81, 0x21, 0x02, 0x02, 0x08, 0x00, 0x00, 0x61, 0x20, 0x02, 0x72,
- 0x08, 0x00, 0x00, 0x1d, 0x00, 0x06, 0x54, 0x08, 0x00, 0x00, 0x01, 0x10,
- 0x04, 0x94, 0x08, 0x00, 0x00, 0x01, 0x10, 0x06, 0x94, 0x04, 0x00, 0x00,
- 0x01, 0xfc, 0x0b, 0x1c, 0x07, 0x00, 0x00, 0x01, 0x10, 0x18, 0x18, 0x03,
- 0x00, 0x00, 0x01, 0x08, 0x30, 0x18, 0x00, 0x00, 0x00, 0x01, 0x08, 0x60,
- 0x18, 0x00, 0x00, 0x80, 0x01, 0x08, 0x40, 0x10, 0x00, 0x00, 0x80, 0x01,
- 0x0c, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00};
-#endif
-
-
-#define MAX_CMD_LENGTH 512
-#define INC_LENGTH 128
-
-
-/* extern data */
-extern Widget km_scrollOK;
-extern Widget km_scrollOK1;
-extern Widget km_scrollCL1;
-
-extern XmFontList help_font;
-extern XFontStruct *help_font_struct;
-
-extern void (*user_mail_C)( /* Widget */ );
-
-/***********************************************************************
- * *
- * Forward declarations of extern functions. *
- * *
- ***********************************************************************/
-extern C_PROTO_1(Widget create_kuipScroll, Widget);
-extern C_PROTO_1(Widget create_kuipScroll1, Widget);
-extern C_PROTO_2(void kxterm_show_browser, char **, int);
-extern C_PROTO_2(void kxterm_show_panel, char **, int);
-extern C_PROTO_2(void kxterm_set_panel, char **, int);
-extern C_PROTO_2(void kxterm_set_echo_mode, char **, int);
-extern C_PROTO_2(void kxterm_iconify, char **, int);
-extern C_PROTO_2(void kxterm_raise, char **, int);
-extern C_PROTO_2(void kxterm_help, char **, int);
-extern C_PROTO_2(void kxterm_geometry, char **, int);
-extern C_PROTO_2(void kxterm_about, char **, int);
-extern C_PROTO_2(void kxterm_mail, char **, int);
-
-
-/***********************************************************************
- * *
- * Forward declarations of global functions. *
- * *
- ***********************************************************************/
-C_PROTO_1(void km_WarnCB,
- String message);
-C_PROTO_1(Widget km_kuipScroll,
- int help_flag);
-C_PROTO_1(Widget km_kuipScroll1,
- int help_flag);
-
-/* local functions */
-static C_PROTO_3(void destroy_scroll,
- Widget w,
- Widget dialog,
- XmAnyCallbackStruct *call_data);
-static C_PROTO_3(void clear_scroll,
- Widget w,
- Widget dialog,
- XmAnyCallbackStruct *call_data);
-static C_PROTO_2(char *max_string,
- char *str, Dimension *dh);
-
-
-/* local data */
-static Widget last_dialog = NULL;
-
-
-/***********************************************************************
- * *
- * Kxterm menu and action definitions. *
- * *
- ***********************************************************************/
-static char *view_menu[] = {
- "M:View: Sep : : separator",
- "M:View: Command Panel : #@panel : button: C: <Key>F1: F1",
- "M:View: New Command Panel : #@newpanel : button: N: <Key>F2: F2",
- "M:View: Sep : : separator",
- "M:View: Browser : #@browser : button: B: <Key>F3: F3",
- NULL
-};
-
-static char *option_menu[] = {
- "M:Option: Sep : : separator",
- "M:Option: Echo Command : #@echo : toggle1 : E",
- "M:Option: Timing : timing : toggle : T",
- "M:Option: Sep : : separator",
- "M:Option: Iconify : #@iconify(UNMAP) : button : I",
- "M:Option: Raise Window : #@raise : button : R",
- NULL
-};
-
-static char *help_menu[] = {
- "M:Help: Sep : : separator",
- "M:Help: On Application : #@help(HELP_EXE) : button",
- "M:Help: On Application Resources : #@help(HELP_EXE_RESOURCES) : button",
- "M:Help: On Kuip Resources : #@help(HELP_RESOURCES) : button",
- "M:Help: On Browser : #@help(HELP_BROWSER) : button",
- "M:Help: On Panel : #@help(HELP_PANEL) : button",
- "M:Help: On System Functions : #@help(FUNCTIONS) : button",
- NULL
-};
-
-/*
- * Action commands that can be send by kxterm to the application
- * (the commands "geometry" and "about" are predifined in kxterm).
- */
-static KxtermActionsRec actions[] = {
- {"panel", kxterm_show_panel}, /* for Command Panel menu button */
- {"newpanel", kxterm_set_panel}, /* for New Command Panel */
- {"browser", kxterm_show_browser}, /* for Browser menu button */
- {"echo", kxterm_set_echo_mode}, /* for Echo Command menu toggle */
- {"iconify", kxterm_iconify}, /* for Iconify menu button */
- {"raise", kxterm_raise}, /* for Raise menu button */
- {"help", kxterm_help}, /* for Help menu buttons */
- {"geometry", kxterm_geometry}, /* sent when moving kxterm around */
- {"about", kxterm_about}, /* for Application about button */
- {"mail", kxterm_mail}, /* for Application mail dialog */
- {NULL, NULL},
-};
-
-
-/***********************************************************************
- * *
- * Handle warning messages. *
- * *
- ***********************************************************************/
-void km_WarnCB(message)
- String message;
-{
- /* warning coming from popup menu, ignore */
- if (strstr(message,"non-existant passive grab"))
- return;
-
- /* warning issued when tearing off an already teared off menu, ignore */
- if (strstr(message,"XtRemoveGrab asked to remove a widget not on the list"))
- return;
-
- fprintf(stderr, "Warning: %s\n", message);
-}
-
-/***********************************************************************
- * *
- * Exec program "cmd" and set up pipes between it and us. *
- * *
- ***********************************************************************/
-static void talkto( cmd, argv )
- char *cmd;
- char **argv;
-{
- int to_child[2]; /* pipe descriptors from parent->child */
- int to_parent[2]; /* pipe descriptors from child->parent */
- int pid;
-
-#ifdef VMS
- int sts, fd, fn;
- char mbxname[256];
- char mbx_to_child[256], mbx_to_parent[256];
- FILE *fp;
-
- sts = pipe(to_child);
- if (sts != 0) {
- fprintf(stderr,"pipe(to_child) error %d\n",sts);
- kc_flags.use_kxterm = 0;
- return;
- }
- getname(to_child[1],mbx_to_child,1);
-
- sts = pipe(to_parent);
- if (sts != 0) {
- fprintf(stderr,"pipe(to_parent) error %d\n",sts);
- kc_flags.use_kxterm = 0;
- close(to_child[0]);
- close(to_child[1]);
- return;
- }
- getname(to_parent[0],mbx_to_parent,1);
-
- if ((pid = vfork()) == 0) { /* in the child */
-
- fd = dup2(to_child[0],0); /* redirect stdin */
- fd = dup2(to_parent[1],1); /* redirect stdout */
- execv(cmd, argv); /* exec the new cmd */
-
- } else if (pid > 0) { /* in the parent */
-
- /* redirect stdin */
- fd = dup2(to_parent[0],0);
- fp = freopen(mbx_to_parent,"r",stdin);
- if (fp == NULL) fprintf(stderr,"freopen stdin error\n");
-
- /* redirect stdout */
- fd = dup2(to_child[1],1);
- fp = freopen(mbx_to_child,"w",stdout);
- if (fp == NULL) fprintf(stderr,"freopen stdout error\n");
- /*
- * use line buffering because mailbox uses record I/O and
- * each printf/putchar would give a separate line
- */
- setvbuf(stdout, NULL, _IOLBF, 8192);
-
- /* redirect stderr */
- fd = dup2(to_child[1],2);
- fp = freopen(mbx_to_child,"w",stderr);
- if (fp == NULL) fprintf(stderr,"freopen stderr error\n");
- setbuf(stderr, NULL);
-
- /* define logical names for FORTRAN I/O */
-
- getname(fileno(stdin),mbxname,1);
- VMScrelnm("SYS$INPUT",mbxname);
- VMScrelnm("SYS$COMMAND",mbxname);
- VMScrelnm("FOR$ACCEPT",mbxname);
-
- getname(fileno(stdout),mbxname,1);
- VMScrelnm("SYS$OUTPUT",mbxname);
- VMScrelnm("FOR$PRINT",mbxname);
- VMScrelnm("FOR$TYPE",mbxname);
-
- close(to_child[0]); /* close pipes */
- close(to_child[1]);
- close(to_parent[0]);
- close(to_parent[1]);
-
- /*
- * wait for handshake from child; otherwise part of the welcome message
- * may be lost if kxterm start-up is too slow
- */
- getchar();
-
- }
-
-#else /* VMS */
-
- if( pipe(to_child) != 0 ) {
- fprintf(stderr,"Cannot open pipe to child.\n");
- kc_flags.use_kxterm = 0;
- return;
- }
-
- if( pipe(to_parent) != 0 ) {
- fprintf(stderr,"Cannot open pipe to parent.\n");
- kc_flags.use_kxterm = 0;
- close(to_child[0]);
- close(to_child[1]);
- return;
- }
-
- if ((pid = vfork()) == 0) { /* in the child */
-
- close(0); /* redirect stdin */
- dup(to_child[0]);
- close(to_child[0]);
- close(1); /* redirect stdout */
- dup(to_parent[1]);
- close(to_parent[1]);
- close(to_child[1]); /* close pipes used by parent */
- close(to_parent[0]);
-
- execv(cmd, argv); /* exec the new cmd */
- fprintf(stderr,"Could execute %s.\n", cmd);
- _exit( 0 );
-
- } else if (pid > 0) { /* in the parent */
-
- close(0); /* redirect stdin */
- dup(to_parent[0]);
- close(to_parent[0]);
- close(1); /* redirect stdout */
- dup(to_child[1]);
- close(2); /* redirect stderr */
- dup(to_child[1]);
- close(to_child[1]);
- setbuf(stdout, NULL); /* no buffered output */
- setbuf(stderr, NULL);
- close(to_child[0]); /* close pipes used by child */
- close(to_parent[1]);
-
- /*
- * wait for handshake from child; otherwise part of the welcome message
- * may be lost if kxterm start-up is too slow
- */
- getchar();
-
- }
-
-#endif /* VMS */
-
- else { /* error! */
- fprintf(stderr,"Couldn't fork process %s.\n", cmd);
- fprintf(stderr,"Your simple xterm will now handle I/O.\n");
- kc_flags.use_kxterm = 0;
- close(to_child[0]);
- close(to_child[1]);
- close(to_parent[0]);
- close(to_parent[1]);
- }
-}
-
-/***********************************************************************
- * *
- * Returns next command from the command buffer. Commands are *
- * delimited by a \n. When no command is found the routine returns *
- * NULL. The returned command is removed from the command buffer. *
- * A line ending with an _ is concatenated with the next line. *
- * Space for the command will be allocated and must be freed by the *
- * caller. When the last line in the command buffer ends with an _ *
- * it stays in the buffer and the routine returns NULL. *
- * *
- ***********************************************************************/
-static char *get_command( cmdbuf )
- char *cmdbuf;
-{
- char *s, *s2, *cmd, *tbuf;
- int max_length = MAX_CMD_LENGTH;
-
- cmd = XtCalloc(max_length, 1);
-
- /*
- * Search for a \n.
- */
- tbuf = cmdbuf;
- s = strchr(tbuf, '\n');
- while (s) {
- /*
- * Copy command to cmd
- */
- while ((s-tbuf) + strlen(cmd) + 1 > max_length) {
- max_length += INC_LENGTH;
- cmd = XtRealloc(cmd, max_length);
- }
-
- strncat(cmd, tbuf, s-tbuf);
-
- /*
- * Handle concatenation
- */
- s2 = km_strend(cmd, '_');
- if (s2) {
- *s2 = '\0'; /* remove _ */
- s2 = strchr(s+1, '\n');
- if (s2) {
- tbuf = s+1;
- s = s2;
- } else
- s = NULL;
- } else {
- strcpy(cmdbuf, s+1);
- return cmd;
- }
- }
- XtFree(cmd);
- return NULL;
-}
-
-/***********************************************************************
- * *
- * Execute a command coming from the kxterm process. *
- * *
- ***********************************************************************/
-static void execute_command( w, fid, id )
- Widget w;
- int *fid;
- XtInputId *id;
-{
- char buf[BUFSIZ];
- char *cmd;
- int status = 0;
- int nbytes;
- static int max_length = MAX_CMD_LENGTH;
- static char *cmdbuf;
-
- if (!cmdbuf)
- cmdbuf = XtCalloc(max_length, 1);
-
- /*
- * Get all pending input from pipe.
- */
-#ifdef VMS
- while ((nbytes = MbxRead(buf, BUFSIZ-1, (Widget)0)) > 0) {
-#else /* VMS */
- while ((nbytes = read(*fid, buf, BUFSIZ-1)) > 0) {
-#endif /* VMS */
- /*
- * Null terminate the string.
- */
- buf[nbytes] = '\0';
-
- while (strlen(cmdbuf) + nbytes + 1 > max_length) {
- max_length += INC_LENGTH;
- cmdbuf = XtRealloc(cmdbuf, max_length);
- }
-
- strcat(cmdbuf, buf);
-
- /* break loop if last character was a \n */
- if (buf[nbytes-1] == '\n')
- break;
- }
-
- /*
- * Cancel interrupts which are pending because ^C was typed in Kxterm
- * before entering the command.
- */
- kc_break.intr_pending = 0;
-
- while (status != KUMAC_UNWIND && (cmd = get_command(cmdbuf)) != NULL) {
-
- if (!km_strempty(cmd)) {
-
- if (strlen(cmd) > MAX_CMD_LENGTH)
- printf("*** Command too long ***\n");
- else {
- /* execute command */
- if (!strncmp(cmd, ESCAPE, strlen(ESCAPE)))
- handle_kxterm_action(cmd); /* handle special commands */
- else {
-
- int old_echo = kc_flags.echo_command;
- char *s = format_prompt( kc_flags.curr_prompt );
- km_all_cursor(KM_WAIT_CURSOR);
- kc_flags.echo_command = 0;
- if (s[strlen(s)-1] == ' ')
- printf( "%s%s\n", s, cmd );
- else
- printf( "%s %s\n", s, cmd );
- status = ku_exec(cmd);
- ku_last(cmd);
- kc_flags.echo_command = old_echo;
- km_reset_allbrowser(True); /* overkill, change later */
- km_all_cursor(KM_MAIN_CURSOR);
- kc_break.intr_count = 0;
- }
- }
- }
- XtFree(cmd);
- }
-
- /*
- * Send STX (start-transmission) character to tell kxterm we are
- * ready for a next command.
- */
- if (kc_flags.use_kxterm) {
- char *prompt = str3dup( "prompt(",
- format_prompt( kc_flags.curr_prompt ), ")" );
- send_single_kxterm_cmd( prompt );
- free( prompt );
- printf("\2");
- fflush( stdout );
- }
-}
-
-/***********************************************************************
- * *
- * Start the kxterm KUIP terminal emulator. *
- * *
- * The following happens in this routine: *
- * - Listen for input coming from stdin. *
- * - Fork kxterm and redirect stdin, stdout and stderr, via pipes, *
- * from and to kxterm. *
- * - Send application menu's to kxterm. *
- * *
- ***********************************************************************/
-int start_kxterm( title, geometry, font, text_font, prompt )
- char *title;
- char *geometry;
- char *font;
- char *text_font;
- char *prompt;
-{
- char *argv[15];
- char pid[10];
- char *kxterm;
-
- int status = 0;
-
- /*
- * Add callback execute_command() -- invoked when input is available
- * from stdin
- */
-#ifdef VMS
- /*
- * Create a lock which we can use on the kxterm side to see if the
- * application process is still alive.
- * Kxterm is not allowed to exit before the application process because
- * otherwise it can get stuck waiting for the mailbox message to be read.
- */
- int alive_lock[2];
- char lock_name[32];
- struct dsc$descriptor_s lock_dsc;
-
- sprintf( lock_name, "ALIVE%d", getpid() );
- var_descriptor( lock_dsc, lock_name );
- sys$enqw( 0, LCK$K_EXMODE, alive_lock, 0,
- &lock_dsc, 0, NULL, 0, NULL, PSL$C_USER, 0 );
-
- XtAppAddInput(UxAppContext,
- MBX_EVENT_FLAG, /* On OpenVMS, wait on event flag */
- &MbxMessage.ioStatus, /* I/O Status Block */
- (XtInputCallbackProc)execute_command,
- NULL);
-#else /* VMS */
- XtAppAddInput(UxAppContext, fileno(stdin),
- (XtPointer)XtInputReadMask,
- (XtInputCallbackProc)execute_command,
- NULL);
-#endif /* VMS */
-
- /*
- * If kxterm can be found in PATH, start it.
- */
- if( (kxterm = getenv( "KXTERM" )) == NULL )
- kxterm = ku_qexe( "kxterm" );
-
- if ((kc_flags.use_kxterm = (kxterm != NULL))) {
-
- /*
- * Exec the program "kxterm" and set up pipes.
- *
- * argv[1] is the class name used for setting kxterm resources.
- */
- sprintf(pid, "%d", (int)getpid());
- argv[0] = strdup(kxterm);
- argv[1] = str2dup("Kx", prompt);
- argv[2] = strdup("-name");
- argv[3] = strdup(title);
- argv[4] = strdup("-geometry");
- argv[5] = strdup(geometry);
- argv[6] = strdup("-pid");
- argv[7] = strdup(pid);
- argv[8] = strdup("-prompt");
- argv[9] = str2dup(prompt, "> ");
- argv[10] = strdup("-font");
- argv[11] = strdup(font);
- argv[12] = strdup("-tfont");
- argv[13] = strdup(text_font);
- argv[14] = NULL;
- talkto(argv[0], argv);
- } else {
- fprintf(stderr,"\
-Couldn't find the KUIP terminal emulator kxterm.\n\
-Check your environment variables KXTERM and PATH.\n\
-Your present terminal window will now handle I/O.\n");
- status = -1;
- }
-
- if (kc_flags.use_kxterm) {
-
- /* fix the help menu to include the real application name */
- char s[128], s1[128];
-
- /* On VMS, set up the mailbox after talkto sets up the pipes */
-#ifdef VMS
- MbxSetup();
-#endif /* VMS */
-
- sprintf(s, "M:Help: On %s : #@help(HELP_EXE) : button", prompt);
- help_menu[1] = s;
- sprintf(s1,
- "M:Help: On %s Resources : #@help(HELP_EXE_RESOURCES) : button", prompt);
- help_menu[2] = s1;
-
- /*
- * Create View, Option and Help menus in kxterm
- */
- send_kxterm_cmd(view_menu);
- send_kxterm_cmd(option_menu);
- send_kxterm_cmd(help_menu);
-
- /*
- * In case the application has specified a mail action routine
- * add the "Mail Developers" item to the Help menu in kxterm.
- */
- if (user_mail_C) {
- sprintf(s, "M:Help: Sep : : separator");
- send_single_kxterm_cmd(s);
- sprintf(s, "M:Help: Mail %s Developers : #@mail : button", prompt);
- send_single_kxterm_cmd(s);
- }
-
- /*
- * Register kxterm actions
- */
- kxterm_add_actions(actions);
- }
-
- return status;
-}
-
-/***********************************************************************
- * *
- * Set up HELP or normal text in a scrolled window. *
- * (Widget is created by Architect : create_kuipScroll) *
- * *
- ***********************************************************************/
-Widget km_kuipScroll(help_flag)
- int help_flag; /* 0 : only scrolled text (not necessarily for a Help),
- 1 : Help scrolled window (command or Help item in CDF) */
-{
- Widget dialog;
-
-#if 0
- /* all Help appears centered in the "Main Browser" */
- dialog = create_kuipScroll(km_main_browser);
-#else
- /* all Help appears centered in the "Executive Window" (as all the popup
- dialogs) */
- dialog = create_kuipScroll(km_toplevel);
-#endif
- UxKuipScrollContext = (_UxCkuipScroll *)UxGetContext(dialog);
-
- XtVaSetValues(XtParent(dialog), XmNdeleteResponse, XmDESTROY, NULL);
-
- if (help_flag) {
-#if 0
- Pixmap pixmap;
- Display *display = XtDisplay(dialog);
-
- /* set icon for help popup */
- pixmap = XCreateBitmapFromData(display, DefaultRootWindow(display),
- help_bits, help_width, help_height);
- XtVaSetValues(XtParent(dialog), XmNiconPixmap, pixmap, NULL);
-#endif
-
- /* set help_font (proportional) if defined */
- if (help_font != NULL )
- XtVaSetValues(scrollText, XmNfontList, help_font, NULL);
- }
-
- /* pass widget ID to application */
- if (klnkaddr.user_TopWid_C != NULL)
- (*klnkaddr.user_TopWid_C)("kuipScroll",dialog);
-
- XmTextSetAddMode(scrollText, True);
-
- /*
- * install callbacks
- */
- XtAddCallback(km_scrollOK, XmNactivateCallback,
- (XtCallbackProc)destroy_scroll, dialog);
- XtAddCallback(dialog, XmNdestroyCallback,
- (XtCallbackProc)destroy_scroll, dialog);
- /* This is to avoid the window to disappear under kxterm */
- XtAddEventHandler (dialog, FocusChangeMask, False,
- (XtEventHandler)km_focus_window, NULL);
-
-
- return (dialog);
-}
-
-/***********************************************************************
- * *
- * Set up HELP or normal text in a scrolled window. *
- * (Widget is created by Architect : create_kuipScroll1) *
- * N.B. Same as km_kuipScroll but with a "Clear" button. *
- * *
- ***********************************************************************/
-Widget km_kuipScroll1(help_flag)
- int help_flag; /* 0 : only scrolled text (not necessarily for a Help),
- 1 : Help scrolled window (command or Help item in CDF) */
-{
- Widget dialog;
-
- /* all Help appears centered in the "Executive Window" (as all the popup
- dialogs) */
- dialog = create_kuipScroll1(km_toplevel);
- UxKuipScroll1Context = (_UxCkuipScroll1 *)UxGetContext(dialog);
-
- XtVaSetValues(XtParent(dialog), XmNdeleteResponse, XmDESTROY, NULL);
-
- if (help_flag) {
- /* set help_font (proportional) if defined */
- if (help_font != NULL )
- XtVaSetValues(scrollText1, XmNfontList, help_font, NULL);
- }
-
- /* pass widget ID to application */
- if (klnkaddr.user_TopWid_C != NULL)
- (*klnkaddr.user_TopWid_C)("kuipScroll1",dialog);
-
- XmTextSetAddMode(scrollText1, True);
-
- /*
- * install callbacks
- */
- XtAddCallback(km_scrollOK1, XmNactivateCallback,
- (XtCallbackProc)destroy_scroll, dialog);
- XtAddCallback(dialog, XmNdestroyCallback,
- (XtCallbackProc)destroy_scroll, dialog);
- XtAddCallback(km_scrollCL1, XmNactivateCallback,
- (XtCallbackProc)clear_scroll, dialog);
-
- return (dialog);
-}
-
-C_DECL_5 (void km_display_sctext,
- char *, title,
- char *, text,
- Position, xr,
- Position, yr,
- int, flag)
-{
- km_create_sctext (title, text, xr, yr, flag);
-}
-
-/***********************************************************************
- * *
- * Display some text in a scrollable window *
- * (use same widget as the HELP dialog built with Architect). *
- * *
- * For flag = 1 text is a HELP (use special font, pixmap and title) *
- * *
- ***********************************************************************/
-C_DECL_5 (Widget km_create_sctext,
- char *, title,
- char *, text,
- Position, xr,
- Position, yr,
- int, flag)
-{
- Widget dialog;
- char str[256];
- XmString xmstr;
- char *mtext;
- Dimension dw = 0;
- Position xp, yp;
-
- dialog = km_kuipScroll (flag);
- UxKuipScrollContext = (_UxCkuipScroll *)UxGetContext(dialog);
-
- /* Set window title, position, width and height */
- if (flag == 1) {
- strcpy(str, "Help on: ");
- strcat(str, title);
- } else {
- strcpy(str, title);
- }
- xmstr = XmStringCreateLtoR(str, XmSTRING_DEFAULT_CHARSET);
- XtVaSetValues(dialog, XmNdialogTitle, xmstr, NULL);
- XmStringFree(xmstr);
-
- /* calculate dialog width according to maximum text line length */
- if (help_font_struct != NULL && text != NULL) {
- Dimension dh;
-
- mtext = max_string (text, &dh);
- if (mtext != NULL) {
- dw = (Dimension) XTextWidth(help_font_struct, mtext, strlen(mtext));
- }
- dw += 50; dh += 150;
- XtVaSetValues(dialog, XmNwidth, dw, NULL);
- if (dh > 0 && dh < 350) XtVaSetValues(dialog, XmNheight, dh, NULL);
- }
-
- /*
- * Position dialog with on offset of 25 by 25 from the last dialog.
- */
- if (last_dialog) {
- XtVaGetValues(last_dialog, XmNx, &xp, XmNy, &yp, NULL);
- /* don't increase xp and yp, the window manager adds the border widths */
- XtVaSetValues(dialog, XmNdefaultPosition, False,
- XmNx, xp, XmNy, yp, NULL);
- }
-
- last_dialog = dialog;
-
- /* insert text */
- if (text != NULL) km_insert_string(scrollText, text, False);
-
- UxPopupInterface(dialog, XtGrabNone);
- return (dialog);
-}
-
-/***********************************************************************
- * *
- * Find and return the maximum string in buffer str. *
- * *
- ***********************************************************************/
-static char *max_string( str, dh)
- char *str;
- Dimension *dh;
-{
- int i;
-
- char *max_cval = NULL;
- char *buf = strdup (str);
- int mlen = 0;
- int p = 0;
- int nbl = 0;
-
- *dh = 0;
-
- if (str == NULL) return (NULL);
-
- for (i = 0; str[i] != '\0'; i++) {
- if (str[i] == '\n') {
- char *cval;
- int len;
-
- nbl ++;
- buf[i] = '\0';
- cval = strdup(buf+p);
- len = strlen(cval);
- if (help_font_struct != NULL) {
- int dr, far, fdr;
- XCharStruct overall;
-
- if (len != 0) {
- Dimension dh1;
-
- XTextExtents(help_font_struct, cval, len,
- &dr, &far, &fdr, &overall);
- dh1 = (Dimension) (overall.ascent + overall.descent);
- if (dh1 > *dh) *dh = dh1;
- }
- }
-
- if( len > mlen ) {
- mlen = len;
- max_cval = strdup(cval);
- }
- p = i+1;
- free (cval);
- }
- }
- *dh = *dh * nbl;
- free (buf);
-
- return (max_cval);
-}
-
-/***********************************************************************
- * *
- * Destroy the scroll window dialog (e.g. for HELP) *
- * *
- ***********************************************************************/
-static void destroy_scroll(w, dialog, call_data)
- Widget w;
- Widget dialog;
- XmAnyCallbackStruct *call_data;
-{
- UxDestroyInterface(dialog);
- km_reset_appShell (dialog);
-
- if (dialog == km_scrOutput) km_scrOutput = NULL;
- if (dialog == km_HigzOutput) km_HigzOutput = NULL;
- if (dialog == last_dialog) last_dialog = NULL;
-}
-
-/***********************************************************************
- * *
- * Clear the scroll window dialog *
- * *
- ***********************************************************************/
-static void clear_scroll(w, dialog, call_data)
- Widget w;
- Widget dialog;
- XmAnyCallbackStruct *call_data;
-{
- XmTextPosition pos;
-
- /* get top character and delete from beginning to top character */
- XtVaGetValues(scrollText1, XmNtopCharacter, &pos, NULL);
-
- XmTextReplace(scrollText1, (XmTextPosition)0, pos-1, NULL);
-}
-
-
-/***********************************************************************
- * *
- * Display some Text from FORTRAN in a scrolled text window *
- * *
- * *
- ***********************************************************************/
-void F77_ENTRY_C(Kumout,buftext)
-/* {*/
- char *text = fstr0dup( buftext, len_buftext );
- char title[MAX_string];
-
- if (km_scrOutput == NULL ) {
- sprintf (title, "%s Output", class_name);
- km_scrOutput = km_create_sctext (title, text, 0, 0, 0);
- } else {
- UxKuipScrollContext = (_UxCkuipScroll *)UxGetContext(km_scrOutput);
- km_insert_string(scrollText, text, True);
- }
-}
-
diff --git a/src/packlib/kuip/code_motif/kmpopp.c b/src/packlib/kuip/code_motif/kmpopp.c
deleted file mode 100644
index cfc6f5c..0000000
--- a/src/packlib/kuip/code_motif/kmpopp.c
+++ /dev/null
@@ -1,283 +0,0 @@
-/*
- * $Id: kmpopp.c,v 1.1.1.1 1996/03/08 15:33:08 mclareni Exp $
- *
- * $Log: kmpopp.c,v $
- * Revision 1.1.1.1 1996/03/08 15:33:08 mclareni
- * Kuip
- *
- */
-/*CMZ : 2.06/00 23/09/94 14.48.16 by N.Cremel*/
-/*-- Author :*/
-/*-- Author : N.Cremel 03/04/92*/
-/******************************************************************************/
-/* */
-/* MOTIF-based library for KUIP - deck KMPOPP */
-/* */
-/* General utilitity routines for handling popup menus : */
-/* */
-/* - km_build_popup : Build a popup menu and return its widget */
-/* - km_destroy_all_popup : destroy all KUIP?Motif popup menus */
-/* */
-/******************************************************************************/
-
-#include "kuip/kuip.h"
-#include "kuip/kfor.h"
-#include "kuip/kmenu.h"
-
-#include <string.h>
-#include <X11/StringDefs.h>
-#include <X11/Intrinsic.h>
-#include <Xm/Xm.h>
-#include <Xm/Label.h>
-#include <Xm/LabelG.h>
-#include <Xm/PushBG.h>
-#include <Xm/PushB.h>
-#include <Xm/SeparatoG.h>
-#include <Xm/RowColumn.h>
-#include <Xm/MenuShell.h>
-#include <Xm/CascadeBG.h>
-#include <Xm/ToggleBG.h>
-
-#include "mkdims.h"
-#include "mkutfm.h"
-#include "mkutdm.h"
-#include "kuip/browh1.h"
-#include "browh2.h"
-#include "mkuxxt.h"
-
-
-extern XmAnyCallbackStruct *current_callback_data;
-
-
-extern C_PROTO_1( void file_execute,
- char *lun);
-extern C_PROTO_3( void dir_execute,
- Widget browser,
- KmObject *kmobj,
- char *lun);
-extern C_PROTO_3(void update_browser,
- Widget widget,
- int list,
- Boolean refresh);
-
-
-C_PROTO_3(void popup_activate,
- Widget widget,
- caddr_t tag,
- XmAnyCallbackStruct *call_data);
-
-
-
-static void popdown_menu(w, tag, cbs)
- Widget w;
- int tag;
- XmAnyCallbackStruct *cbs;
-{
- km_destroy_all_popup();
-}
-
-/***********************************************************************
- * *
- * Build a popup menu and return its widget and the default (i.e. *
- * first) pushbutton in the menu. The default button is used for *
- * double clicking. *
- * *
- ***********************************************************************/
-Widget km_build_popup(parent, menu_title, items, menu_type, default_button)
- Widget parent;
- char *menu_title;
- MenuItem *items;
- int menu_type; /* XmMENU_POPUP, XmMENU_PULLDOWN */
- Widget *default_button; /* first pushbutton in menu */
-{
- Widget shell, Popup, widget, wtmp;
- int i;
- Arg args[2];
-
- static char *last_label = NULL;
-
- XtSetArg(args[0], XmNwidth, 1);
- XtSetArg(args[1], XmNheight, 1);
- shell = XmCreateMenuShell(parent, "_popup", args, 2);
- XtSetArg(args[0], XmNrowColumnType, menu_type);
- Popup = XmCreateRowColumn(shell, menu_title, args, 1);
- XtAddCallback(shell, XmNpopdownCallback,
- (XtCallbackProc)popdown_menu, NULL);
- XtVaCreateManagedWidget("popup_label",
- xmLabelWidgetClass, Popup,
- RES_CONVERT( XmNlabelString, menu_title),
- XmNalignment, XmALIGNMENT_CENTER,
- NULL );
- XtVaCreateManagedWidget("popup_sep",
- xmSeparatorGadgetClass, Popup,
- NULL );
-
-
- /* Now add the menu items */
- for (i = 0; items[i].label; i++) {
- Boolean toggle = False;
-
- /* Test if label is the same as previous one (toggle) */
- if (last_label != NULL && strcmp(items[i].label, last_label) == 0)
- toggle = True;
- if (last_label != NULL) free (last_label);
- last_label = strdup (items[i].label);
- if (toggle) continue;
- if (items[i].separator) {
- Widget sep = XmCreateSeparatorGadget(Popup, "sep", args, 0);
- XtManageChild(sep);
- }
- if (items[i].subitems) {
- Widget new =
- km_build_popup(Popup, items[i].label, items[i].subitems,
- XmMENU_PULLDOWN, &wtmp);
- widget = XtVaCreateManagedWidget(items[i].label,
- xmCascadeButtonGadgetClass, Popup,
- XmNsubMenuId, new,
- NULL);
- } else
- widget = XtVaCreateManagedWidget(items[i].label,
- *items[i].class, Popup, NULL);
-
- if (items[i].default_button)
- *default_button = widget;
-
- if (items[i].mnemonic)
- XtVaSetValues(widget, XmNmnemonic, items[i].mnemonic, NULL);
- if (items[i].accelerator) {
- XmString str = XmStringCreateSimple(items[i].accel_text);
- XtVaSetValues(widget,
- XmNaccelerator, items[i].accelerator,
- XmNacceleratorText, str,
- NULL);
- XmStringFree(str);
- }
- if (items[i].callback) {
- if (*items[i].class == xmPushButtonGadgetClass) {
- XtAddCallback(widget, XmNactivateCallback,
- items[i].callback, items[i].callback_data);
- } else if (*items[i].class == xmToggleButtonGadgetClass) {
- if (items[i].set)
- XtVaSetValues(widget, XmNset, TRUE, NULL);
- else
- XtVaSetValues(widget, XmNset, FALSE, NULL);
- XtAddCallback(widget, XmNvalueChangedCallback,
- items[i].callback, items[i].callback_data);
- }
- }
- }
- return Popup;
-}
-
-
-/******************************************************************************/
-/* km_destroy_all_popup : destroy all popup menus (for button 3 use) */
-/******************************************************************************/
-void km_destroy_all_popup ()
-{
-extern C_PROTO_0(void km_reset_graph_popup);
-extern C_PROTO_0(void km_reset_class_popup);
-extern C_PROTO_0(void km_reset_object_popup);
- XEvent event;
-
- km_reset_graph_popup ();
- km_reset_class_popup();
- km_reset_object_popup();
-
- while ( XEventsQueued( km_Display, QueuedAlready) > 0) {
- XNextEvent (km_Display, &event);
- XtDispatchEvent (&event); }
- XSync(km_Display, False);
-}
-
-
-/***********************************************************************
- * *
- * Callbacks for "Popup" menu items in the class window *
- * *
- ***********************************************************************/
-void popup_activate (widget, tag, call_data)
- Widget widget;
- caddr_t tag;
- XmAnyCallbackStruct *call_data;
-{
- poptag_str *s_tag = (poptag_str *)tag;
- XEvent evt;
- BrAction *bract1;
-
- evt = *(call_data->event);
- current_callback_data = call_data;
-
- km_all_cursor(KM_WAIT_CURSOR);
-
- km_destroy_all_popup();
-
- /* for toggle take either bract or bract_next */
- bract1 = s_tag->bract;
-
- if (s_tag->bract->flags & BrActToggle) {
- /* Toggle behavior */
- if (s_tag->bract->flags & BrActToggleOn) {
- XtVaSetValues(widget, XmNset, FALSE, NULL);
- s_tag->bract->flags &= ~BrActToggleOn;
- } else {
- XtVaSetValues(widget, XmNset, TRUE, NULL);
- s_tag->bract->flags |= BrActToggleOn;
- bract1 = s_tag->bract_next;
- }
- }
-
- switch (s_tag->flag) {
- case 1: /* Class window menu ... */
-
- if (s_tag->command_num == 1) {
- /* for 1st command (List) : execute default action*/
- current_callback_data = call_data;
- file_execute (s_tag->pathname);
- } else {
- km_get_curpos (call_data->event, &km_xcur_pos, &km_ycur_pos);
- exec_action(bract1, s_tag->pathname, NULL, s_tag->panel,
- widget, call_data);
-
- /* Update the class window of all browsers */
- if (s_tag->bract->flags & BrActUpdate)
- update_browser (NULL, FILE_LIST, False);
- }
-
- break;
-
- case 2: /* Object window menu ... */
-
- if (s_tag->kmobj->class->is_dir && s_tag->command_num == 1) {
- /* This is a directory ... */
- /* for 1st command (List) : execute default action for directory */
- dir_execute (s_tag->browser, s_tag->kmobj, s_tag->pathname);
- } else {
- km_get_curpos (call_data->event, &km_xcur_pos, &km_ycur_pos);
- exec_action (bract1, s_tag->pathname,
- s_tag->kmobj->name, s_tag->panel, widget, call_data);
-
- /* Update this browser's class and object windows */
- if (s_tag->bract->flags & BrActUpdate)
- update_browser (NULL, 0, False);
- }
-
- break;
-
- case 3: /* Graphics window menu ... */
- km_get_curpos (call_data->event, &km_xcur_pos, &km_ycur_pos);
-
- if ( s_tag->panel || (evt.xbutton.state == ControlMask) )
- exec_action (bract1, s_tag->pathname, s_tag->item, True,
- widget, call_data);
- else
- exec_action (bract1, s_tag->pathname, s_tag->item, False,
- widget, call_data);
-
- break;
-
- } /* end ... switch (s_tag->flag) */
-
- km_all_cursor(KM_MAIN_CURSOR);
-
-}
diff --git a/src/packlib/kuip/code_motif/kmumen.c b/src/packlib/kuip/code_motif/kmumen.c
deleted file mode 100644
index a882f2e..0000000
--- a/src/packlib/kuip/code_motif/kmumen.c
+++ /dev/null
@@ -1,287 +0,0 @@
-/*
- * $Id: kmumen.c,v 1.1.1.1 1996/03/08 15:33:09 mclareni Exp $
- *
- * $Log: kmumen.c,v $
- * Revision 1.1.1.1 1996/03/08 15:33:09 mclareni
- * Kuip
- *
- */
-/*CMZ : 2.06/03 16/12/94 16.24.22 by N.Cremel*/
-/*-- Author :*/
-#include <stdio.h>
-#include <string.h>
-#include <X11/StringDefs.h>
-#include <X11/Intrinsic.h>
-#include <Xm/Xm.h>
-#include <Xm/LabelG.h>
-#include <Xm/PushBG.h>
-#include <Xm/PushB.h>
-#include <Xm/ToggleB.h>
-#include <Xm/ToggleBG.h>
-#include <Xm/SeparatoG.h>
-#include <Xm/RowColumn.h>
-#include <Xm/MenuShell.h>
-#include <Xm/CascadeBG.h>
-
-#include "kuip/kuip.h"
-#include "kuip/kfor.h"
-#include "kuip/klink.h"
-#include "kuip/kmenu.h"
-#include "kuip/kflag.h"
-#include "kuip/mkterm.h"
-
-#include "kuip/mkutfu.h"
-#include "mkutfm.h"
-
-
-/***********************************************************************
- * *
- * Fill MenuItem array. *
- * Function returns the number of items stored in the array, 0 when *
- * an error occured. *
- * *
- ***********************************************************************/
-int km_add_item( item_string, push_cb, toggle_cb, items, max_items )
- char *item_string;
- void (*push_cb)();
- void (*toggle_cb)();
- MenuItem *items;
- int max_items;
-{
- char *str, *sav, *s1, *s2, *class;
- int item = 0;
- int l;
-
- l = strlen(item_string);
- if (*(item_string+l-1) != '\n') {
- str = XtMalloc(l+2);
- sprintf(str, "%s\n", item_string);
- } else {
- str = XtMalloc(l+1);
- strcpy(str, item_string);
- }
- sav = str;
-
- while ((s1 = strchr(str, '\n'))) {
- s1++;
- items[item].label = NULL;
- items[item].class = NULL;
- items[item].set = False;
- items[item].mnemonic = '\0';
- items[item].accelerator = NULL;
- items[item].accel_text = NULL;
- items[item].callback = NULL;
- items[item].callback_data = NULL;
- items[item].subitems = NULL;
-
- if( (s2 = strtok(str, ":\n")) != NULL ) {
-
- items[item].label = km_strip( s2 );
-
- if( (s2 = strtok(NULL, ":\n")) != NULL ) {
-
- items[item].callback_data = (caddr_t)km_strip( s2 );
-
- if( (s2 = strtok(NULL, ":\n")) != NULL ) {
-
- class = strlower( km_strip( s2 ) );
- if (class[0] == 'b') {
- items[item].class = &xmPushButtonGadgetClass;
- items[item].callback = push_cb;
- }
- else if (class[0] == 't') {
- items[item].class = &xmToggleButtonGadgetClass;
- items[item].callback = toggle_cb;
- if (strchr(class, '1'))
- items[item].set = True;
- }
- else if (class[0] == 's') {
- items[item].class = &xmSeparatorGadgetClass;
- }
- else if (class[0] == 'l') {
- items[item].class = &xmLabelGadgetClass;
- }
- free(s2);
-
- if( (s2 = strtok(NULL, ":\n")) != NULL ) {
-
- class = km_strip( s2 );
- items[item].mnemonic = class[0];
- free(s2);
-
- if( (s2 = strtok(NULL, ":\n")) != NULL ) {
-
- items[item].accelerator = km_strip( s2 );
-
- if( (s2 = strtok(NULL, ":\n")) != NULL ) {
-
- items[item].accel_text = km_strip( s2 );
-
- }
- }
- }
- }
- }
- }
-
- if (items[item].callback_data && !*((int*)(items[item].callback_data))) {
- XtFree(items[item].callback_data);
- items[item].callback_data = NULL;
- }
- if (!items[item].callback_data) {
- items[item].callback_data = XtCalloc(strlen(items[item].label)+1, 1);
- strcpy(items[item].callback_data, items[item].label);
- }
- if (!items[item].class) {
- items[item].class = &xmPushButtonGadgetClass;
- items[item].callback = push_cb;
- }
- str = s1;
- item++;
- if (item >= max_items) {
- item--;
- items[item].label = NULL;
- XtFree(sav);
- return ++item;
- }
- items[item].label = NULL;
- if (!*s1) break;
- }
- XtFree(sav);
-
- return item;
-}
-
-/***********************************************************************
- * *
- * Build popup, option and pulldown menus, depending on the menu_type. *
- * It may be XmMENU_PULLDOWN, XmMENU_OPTION or XmMENU_POPUP. Pulldowns *
- * return the CascadeButton that pops up the menu. Popups return the *
- * menu. Option menus are created, but the RowColumn that acts as the *
- * option "area" is returned unmanaged. (The user must manage it.) *
- * Pulldown menus are built from cascade buttons, so this function *
- * also builds pullright menus. The function also adds the right *
- * callback for PushButton or ToggleButton menu items. *
- * *
- ***********************************************************************/
-Widget km_build_menu( parent, menu_type, menu_title, menu_mnemonic,
- items, add_to_menu )
- Widget parent;
- int menu_type;
- char *menu_title;
- int menu_mnemonic;
- MenuItem *items;
- int add_to_menu;
-{
- Widget menu;
- Widget cascade = 0;
- Widget widget;
- char *name;
- int i;
- XmString str;
-
- if (add_to_menu) {
- menu = parent;
- } else {
- name = XtCalloc(strlen(menu_title) + 6, 1);
- if (menu_type == XmMENU_PULLDOWN || menu_type == XmMENU_OPTION) {
- sprintf(name, "%sPdMenu", menu_title);
- menu = XmCreatePulldownMenu(parent, name, NULL, 0);
- } else if (menu_type == XmMENU_POPUP) {
- sprintf(name, "%sPopup", menu_title);
- menu = XmCreatePopupMenu(parent, name, NULL, 0);
- } else {
- XtWarning("Invalid menu type passed to km_build_menu()");
- XtFree(name);
- return NULL;
- }
- XtFree(name);
-
- /* Pulldown menus require a cascade button to be made */
- if (menu_type == XmMENU_PULLDOWN) {
- str = XmStringCreateSimple(menu_title);
- cascade = XtVaCreateManagedWidget(menu_title,
- xmCascadeButtonGadgetClass, parent,
- XmNsubMenuId, menu,
- XmNlabelString, str,
- XmNmnemonic, menu_mnemonic,
- NULL);
- XmStringFree(str);
- } else if (menu_type == XmMENU_OPTION) {
- /* Option menus are a special case, but not hard to handle */
- Arg args[2];
- str = XmStringCreateSimple(menu_title);
- XtSetArg(args[0], XmNsubMenuId, menu);
- XtSetArg(args[1], XmNlabelString, str);
- /*
- * This really isn't a cascade, but this is the widget handle
- * we're going to return at the end of the function.
- */
- cascade = XmCreateOptionMenu(parent, menu_title, args, 2);
- XmStringFree(str);
- }
- }
-
- /* Now add the menu items */
- for (i = 0; items[i].label != NULL; i++) {
- /*
- * If subitems exist, create the pull-right menu by calling this
- * function recursively. Since the function returns a cascade
- * button, the widget returned is used..
- */
- if (items[i].subitems)
- if (menu_type == XmMENU_OPTION) {
- XtWarning("You can't have submenus from option menu items.");
- continue;
- } else
- widget = km_build_menu(menu, XmMENU_PULLDOWN,
- items[i].label, items[i].mnemonic,
- items[i].subitems, False);
- else
- widget = XtVaCreateManagedWidget(items[i].label,
- *items[i].class, menu,
- NULL);
-
- /*
- * If toggle button set default state, set can only be true when
- * class = xmToggleButtonWidgetClass
- */
- if (items[i].set)
- XtVaSetValues(widget, XmNset, True, NULL);
-
- /*
- * Whether the item is a real item or a cascade button with a
- * menu, it can still have a mnemonic.
- */
- if (items[i].mnemonic)
- XtVaSetValues(widget, XmNmnemonic, items[i].mnemonic, NULL);
-
- /*
- * Any item can have an accelerator, except cascade menus. But,
- * we don't worry about that; we know better in our declarations.
- */
- if (items[i].accelerator) {
- str = XmStringCreateSimple(items[i].accel_text);
- XtVaSetValues(widget,
- XmNaccelerator, items[i].accelerator,
- XmNacceleratorText, str,
- NULL);
- XmStringFree(str);
- }
-
- if (items[i].callback)
- XtAddCallback(widget,
- (items[i].class == &xmToggleButtonWidgetClass ||
- items[i].class == &xmToggleButtonGadgetClass) ?
- XmNvalueChangedCallback : /* ToggleButton class */
- XmNactivateCallback, /* PushButton class */
- items[i].callback, items[i].callback_data);
- }
-
- /*
- * For popup menus, just return the menu; pulldown menus, return
- * the cascade button; option menus, return the thing returned
- * from XmCreateOptionMenu(). This isn't a menu, or a cascade button!
- */
- return menu_type == XmMENU_POPUP ? menu : cascade;
-}
diff --git a/src/packlib/kuip/code_motif/kmutif.c b/src/packlib/kuip/code_motif/kmutif.c
deleted file mode 100644
index 67bcbfa..0000000
--- a/src/packlib/kuip/code_motif/kmutif.c
+++ /dev/null
@@ -1,157 +0,0 @@
-/*
- * $Id: kmutif.c,v 1.3 1996/10/24 12:13:39 cremel Exp $
- *
- * $Log: kmutif.c,v $
- * Revision 1.3 1996/10/24 12:13:39 cremel
- * Version 2.07/10
- * Add resource higzMessGeometry to have control on the size and position of
- * the "HigzOutput" window (e.g. for the locator). To change the size
- * and position of this window one must add in his .Xdefaults (or .Xresources)
- * file the 2 following lines:
- *
- * Paw++*kuipScroll1.defaultPosition: False
- * Paw++*higzMessGeometry: 200x250+650+650
- *
- * Revision 1.2 1996/08/27 12:08:57 cremel
- * Put the HizOutput window always on top of the others.
- *
- * Revision 1.1.1.1 1996/03/08 15:33:09 mclareni
- * Kuip
- *
- */
-/*CMZ : 2.05/00 14/03/94 13.45.14 by N.Cremel*/
-/*-- Author : N.Cremel 03/04/92*/
-/******************************************************************************/
-/* */
-/* MOTIF-based library for KUIP - deck KMUTIF */
-/* */
-/* General Motif utilitity routines which are FORTRAN callable */
-/* */
-/* - F77_ENTRY_I4CCC(Kmxmes, ...) : Motif version of HIGX/X Igxmess */
-/* */
-/******************************************************************************/
-
-#include "kuip/kuip.h"
-#include "kuip/kfor.h"
-#include "kuip/kmenu.h"
-
-#include <Xm/Xm.h>
-#if defined(__hpux) && XtSpecificationRelease == 4
-#include <X11/Protocols.h>
-#else
-#include <Xm/Protocols.h>
-#endif
-
-#include "mkincl.h"
-#include "mksres.h"
-#include "mksreg.h"
-#include "mkutdm.h"
-#include "mkutfm.h"
-#define CONTEXT_MACRO_ACCESS 1
-#include "mkuxs1.h"
-#undef CONTEXT_MACRO_ACCESS
-
-#define Kmxmes F77_NAME(kmxmes,KMXMES)
-
-/* extern data */
-extern XmFontList help_font;
-extern XFontStruct *help_font_struct;
-
-/* extern functions */
-extern C_PROTO_1(Widget km_kuipScroll1,
- int help_flag);
-
-
-/***********************************************************************
- * *
- * Motif version of HIGX/X Igxmess *
- * *
- ***********************************************************************/
-void F77_ENTRY_I4CCC(Kmxmes,ix,iy,nc,nl,chmess,chtit,chopt)
-/* { */
- int i, pos;
- Dimension dw, dh;
-
- char *mtext = NULL;
- char *tit = fstrdup( chtit, len_chtit );
- char *opt = fstrdup( chopt, len_chopt );
- int mlen = 0;
- int do_popup = 0;
- Boolean dogeom = True;
- int gh, gw, gx, gy;
-
-
- if (*nl == 0) return;
-
- sscanf (srec.higzmess_geometry, "%dx%d+%d+%d", &gw, &gh, &gx, &gy);
- if (gw == 0 && gh == 0 && gx == 0 && gy == 0) dogeom = False;
-
-
- /* Create window if not done */
- if (km_HigzOutput == NULL ) {
- XmString xmstr;
- Position xr = (Position) *ix;
- Position yr = (Position) *iy;
- int flag = 0;
-
- km_HigzOutput = km_kuipScroll1(flag);
- km_store_appShell (km_HigzOutput, tit);
- xmstr = XmStringCreateLtoR(tit, XmSTRING_DEFAULT_CHARSET);
- if (!dogeom) {
- XtVaSetValues(km_HigzOutput,
- XmNdialogTitle, xmstr, XmNx, xr, XmNy, yr, NULL);
- } else {
- XtVaSetValues(km_HigzOutput, XmNdialogTitle, xmstr,
- XmNx, (Position)gx, XmNy, (Position)gy, NULL);
- }
- XmStringFree(xmstr);
- do_popup = 1;
- }
-
-
- /* Write text */
- UxKuipScroll1Context = (_UxCkuipScroll1 *)UxGetContext(km_HigzOutput);
- /* set help_font (proportional) if defined */
- if (help_font != NULL )
- XtVaSetValues(scrollText1, XmNfontList, help_font, NULL);
- pos = XmTextGetLastPosition(scrollText1);
- for( i = 0; i < *nl; i++) {
- char *mess = fstrdup( &chmess[len_chmess*i], len_chmess );
- int len = strlen(mess);
-
- if (len > mlen) {
- mlen = len;
- mtext = strdup ( mess );
- }
- mess = mstrcat (mess, "\n");
- XmTextInsert(scrollText1, pos, mess);
- pos = XmTextGetLastPosition(scrollText1);
- free (mess);
- }
- if (!dogeom) {
- if (help_font_struct != NULL) {
- /* calculate width according to maximum text line length */
- if (mtext != NULL)
- dw = (Dimension) XTextWidth(help_font_struct, mtext, strlen(mtext));
- dw += 50;
- XtVaGetValues(km_HigzOutput, XmNheight, &dh, NULL);
- } else
- XtVaGetValues(km_HigzOutput, XmNheight, &dh, XmNwidth, &dw, NULL);
- if (dw != 0 && dh != 0)
- XtVaSetValues(km_HigzOutput, XmNwidth, dw, XmNheight, dh, NULL);
- } else { /* if dogeom */
- XtVaSetValues(km_HigzOutput, XmNwidth, (Dimension)gw, XmNheight,
- (Dimension)gh, NULL);
- }
-
- XmTextInsert(scrollText1, pos, "--->\n");
- pos = XmTextGetLastPosition(scrollText1);
- XmTextShowPosition(scrollText1, pos);
-
- /* if (do_popup) UxPopupInterface(km_HigzOutput, XtGrabNone); */
- /* otherwise window can be obscured and not visible anymore */
- UxPopupInterface(km_HigzOutput, XtGrabNone);
-
- free(tit);
- free(opt);
-}
diff --git a/src/packlib/kuip/code_motif/kmutil.c b/src/packlib/kuip/code_motif/kmutil.c
deleted file mode 100644
index 6d6292a..0000000
--- a/src/packlib/kuip/code_motif/kmutil.c
+++ /dev/null
@@ -1,91 +0,0 @@
-/*
- * $Id: kmutil.c,v 1.1.1.1 1996/03/08 15:33:09 mclareni Exp $
- *
- * $Log: kmutil.c,v $
- * Revision 1.1.1.1 1996/03/08 15:33:09 mclareni
- * Kuip
- *
- */
-/*CMZ : 2.05/09 06/07/94 15.26.00 by Alfred Nathaniel*/
-/*-- Author : N.Cremel 03/04/92*/
-/******************************************************************************/
-/* */
-/* MOTIF-based library for KUIP - deck KMDIAL */
-/* */
-/* General utilities which do NOT refer any Motif/X11 include files */
-/* */
-/* - km_strip : Strip blanks from both sides of a string */
-/* - km_strempty : Returns true (1) if string is empty */
-/* */
-/******************************************************************************/
-
-#include "kuip/kuip.h"
-#include "kuip/kfor.h"
-#include "kuip/kmenu.h"
-
-#include "mkutda.h"
-#include "kuip/mkutfu.h"
-
-
-/***********************************************************************
- * *
- * Strip blanks from both sides of a string. Space for the new *
- * string is allocated and a pointer to it is returned. *
- * *
- ***********************************************************************/
-char *km_strip(s)
- char *s;
-{
- return strtrim( strdup( s ) );
-}
-
-
-/***********************************************************************
- * *
- * Returns true (1) if string is empty (only containing blanks). *
- * *
- ***********************************************************************/
-int km_strempty(str)
- char *str;
-{
- char *sav = str;
- int rtrn = 1;
-
- if (!sav) return rtrn;
- if (strlen(sav) == 0) return rtrn;
-
- while (*sav) {
- if (*sav != ' ') {
- rtrn = 0;
- break;
- }
- sav++;
- }
- return rtrn ;
-}
-
-/***********************************************************************
- * *
- * Searches backwards for character c while ignoring ' ' and '\n'. *
- * If c not found return NULL otherwise pointer to c. *
- * *
- ***********************************************************************/
-char *km_strend(str, c)
- char *str;
- int c;
-{
- int i;
-
- if (!str || !strlen(str)) return NULL;
-
- for (i = strlen(str); i > 0; i--) {
- if (str[i-1] == ' ' || str[i-1] == '\n')
- continue;
-
- if (str[i-1] != c)
- return NULL;
-
- return str+i-1;
- }
- return NULL;
-}
diff --git a/src/packlib/kuip/code_motif/kmutim.c b/src/packlib/kuip/code_motif/kmutim.c
deleted file mode 100644
index 3890fd4..0000000
--- a/src/packlib/kuip/code_motif/kmutim.c
+++ /dev/null
@@ -1,1060 +0,0 @@
-/*
- * $Id: kmutim.c,v 1.1.1.1 1996/03/08 15:33:09 mclareni Exp $
- *
- * $Log: kmutim.c,v $
- * Revision 1.1.1.1 1996/03/08 15:33:09 mclareni
- * Kuip
- *
- */
-/*CMZ : 2.07/03 09/05/95 11.54.44 by N.Cremel*/
-/*-- Author : N.Cremel 03/04/92*/
-/******************************************************************************/
-/* */
-/* MOTIF-based library for KUIP - deck KMUTIM */
-/* */
-/* General utilitity routines (refer some Motif/X11 include files) */
-/* */
-/* - km_do_help : Display text of any "Help_item" entry in the CDF */
-/* - km_normal_string : Get char string from XmString */
-/* - km_insert_string : Insert a string at the end of a XmText */
-/* - km_double_click : Check if doubleclick happened */
-/* - km_show_cb : Show (manage) the widget passed as client_data */
-/* - km_close_cb : Close (popdown) a popup dialog (client_data) */
-/* - km_cancel_cb : Remove (unmanage) popup passed as client_data */
-/* - km_reset_sensitive_cb : Reset sensitivity (client_data) */
-/* - km_help_cb : Display HELP on command passed as client_data */
-/* - km_make_menuStruct : Assign/fill the space for a MenuCbStruct */
-/* - km_popup_MenuCbdialog : Popup dialog (in MenuCbStruct) */
-/* - km_popdown_MenuCbdialog : Popdown dialog (in MenuCbStruct) */
-/* - km_GetTrueShell : Get the true toplevel shell */
-/* - km_MwmCloseCallback : Install MwmCloseCallback */
-/* - km_IsShellIconic : Is shell in iconic state? */
-/* - km_IconifyShell : Iconify a shell */
-/* - km_DeIconifyShell : De-Iconify a shell */
-/* - km_FlushEvents : equivalent to XtAppMainLoop */
-/* - km_wait_input : Ask user for input and wait till he responds */
-/* - km_toggle_selection : Ask user for one choice between toggles */
-/* - km_set_cursor : Set the cursor shape */
-/* - km_get_curpos : Get cursor positions xc and yc */
-/* - km_view_file : print content of a file into executive window */
-/* - km_focus_window : to avoid window to disappear under kxterm */
-/* - km_list_data : set data information for a list. */
-/* - km_show_list : display list (after filling items). */
-/* - km_show_filSel : display FileSelectionBox. */
-/* */
-/******************************************************************************/
-
-#include "kuip/kuip.h"
-#include "kuip/kfor.h"
-#include "kuip/kmenu.h"
-#include "kuip/browh1.h"
-
-#include <Xm/Xm.h>
-#if defined(__hpux) && XtSpecificationRelease == 4
-#include <X11/Protocols.h>
-#else
-#include <Xm/Protocols.h>
-#endif
-#include <Xm/AtomMgr.h>
-
-/* Global SEQUENCES (defined in MKCDES) */
-#include "mkincl.h"
-#include "mkdims.h"
-#include "mksres.h"
-#include "mksreg.h"
-#include "mkutdm.h"
-#include "mkutfm.h"
-#define CONTEXT_MACRO_ACCESS 1
-#include "mkuxfs.h"
-#include "mkuxli.h"
-#undef CONTEXT_MACRO_ACCESS
-
-/***********************************************************************
- * Global data *
- ***********************************************************************/
-static Widget prompt_id = NULL;
-static Boolean prompt_not_finished = False;
-static Boolean prompt_cancel = False;
-static ListData list_data;
-
-
-/***********************************************************************
- * *
- * Forward declarations of local functions. *
- * *
- ***********************************************************************/
-static C_PROTO_3 (void return_input,
- Widget widget,
- int tag,
- XmAnyCallbackStruct *data);
-static C_PROTO_3 (void wcancel_activate,
- Widget widget,
- caddr_t tag,
- XmAnyCallbackStruct *callback_data);
-#if 0
-static C_PROTO_3 (void XtoPS_cb,
- Widget widget,
- xtops_struct *tag,
- XmAnyCallbackStruct *data);
-#endif
-static void okFCallback( Widget widget,
- int (*tag)(),
- XmFileSelectionBoxCallbackStruct *data);
-
-
-/***********************************************************************
- * *
- * Forward declarations of extern functions. *
- * *
- ***********************************************************************/
-extern C_PROTO_5(void km_print_box,
- Widget pw,
- Position x,
- Position y,
- char *message,
- int itype);
-
-/* km_view_file : Print the content of a file into the executive window */
-extern C_PROTO_3(void km_view_file,
- Widget w,
- BrClientdata *client_data,
- XmAnyCallbackStruct *cbs);
-
-extern C_PROTO_3(void km_clFCallback,
- Widget widget,
- caddr_t tag,
- XmAnyCallbackStruct *data);
-
-/***********************************************************************
- * *
- * Display help corresponding to a "Help_item" entry in the CDF. *
- * *
- ***********************************************************************/
-void km_do_help(w, client_data, call_data)
- Widget w;
- char *client_data;
- XmAnyCallbackStruct *call_data;
-{
- char cmd[MAX_string];
-
- sprintf (cmd,"/KUIP/HELP %s", client_data);
- ku_exel (cmd);
-}
-
-/******************************************************************************/
-/* void km_help_activate( widget, tag, callback_data ) */
-/* prompt dialog help button callback */
-/******************************************************************************/
-void km_help_activate( widget, tag, callback_data )
- Widget widget;
- caddr_t tag;
- XmAnyCallbackStruct *callback_data;
-{
- char *help_message = (char *) tag;
- Position xr, yr;
-
- km_get_curpos (callback_data->event,&xr,&yr);
- km_print_box (km_toplevel, xr, yr, help_message,2);
-}
-
-/***********************************************************************
- * *
- * Get char string from XmString. *
- * Returned string must be freed afterwards. *
- * *
- ***********************************************************************/
-char *km_normal_string(cs)
- XmString cs;
-{
- char *primitive_string;
-
- XmStringGetLtoR(cs, XmSTRING_DEFAULT_CHARSET, &primitive_string);
-
- return ((char *)primitive_string);
-}
-
-/***********************************************************************
- * *
- * Insert a string at the end of a XmText widget. *
- * *
- ***********************************************************************/
-C_DECL_3(void km_insert_string,
- Widget, text_widget,
- char *, buf,
- Boolean, show)
-{
- int pos = XmTextGetLastPosition(text_widget);
- XmTextInsert(text_widget, pos, buf);
-
- if (show) {
- pos = XmTextGetLastPosition(text_widget);
- XmTextShowPosition(text_widget, pos);
- }
-}
-
-/***********************************************************************
- * *
- * Check if doubleclick happened. *
- * *
- ***********************************************************************/
-Boolean km_double_click(time)
- Time time;
-{
- static Time click1 = 0;
- Boolean rtn;
-
- rtn = False;
-
- /* in case of time wrap no double click */
- if (time < click1) return(rtn);
-
- if (time - click1 <= srec.dc_interval)
- rtn = True;
- click1 = time;
-
- return(rtn);
-}
-
-/***********************************************************************
- * *
- * Show (manage) the widget passed as the client_data. *
- * *
- ***********************************************************************/
-void km_show_cb(w, dialog, call_data)
- Widget w, dialog;
- XmAnyCallbackStruct *call_data;
-{
- XtManageChild(dialog);
-}
-
-/***********************************************************************
- * *
- * Close (popdown) a popup dialog (or shell) passed as client_data. *
- * *
- ***********************************************************************/
-void km_close_cb(w, dialog, call_data)
- Widget w, dialog;
- XmAnyCallbackStruct *call_data;
-{
- UxPopdownInterface(dialog);
-}
-
-/***********************************************************************
- * *
- * Remove (unmanage) popup passed as client_data (in MenuCbStruct). *
- * *
- ***********************************************************************/
-void km_cancel_cb(w, item, call_data)
- Widget w;
- MenuCbStruct *item;
- XmAnyCallbackStruct *call_data;
-{
- km_popdown_MenuCbdialog(item);
-}
-
-/***********************************************************************
- * *
- * Reset sensitivity on the widget passed as the client_data *
- * parameter. *
- * *
- ***********************************************************************/
-void km_reset_sensitive_cb(w, reset_widget, call_data)
- Widget w, reset_widget;
- XmAnyCallbackStruct *call_data;
-{
- XtSetSensitive(reset_widget, True);
-}
-
-/***********************************************************************
- * *
- * Display (scrolled text) HELP on command passed as client_data. *
- * *
- ***********************************************************************/
-void km_help_cb(w, help_cmd, call_data)
- Widget w;
- char *help_cmd;
- XmAnyCallbackStruct *call_data;
-{
- Position xr, yr;
-
- km_get_curpos (call_data->event,&xr,&yr);
- km_display_sctext ("Help", help_cmd, xr, yr, 0);
-}
-
-/***********************************************************************
- * *
- * Assign the space for a MenuCbStruct and fill it. *
- * *
- ***********************************************************************/
-MenuCbStruct *km_make_menuStruct(button, dialog)
- Widget button, dialog;
-{
- MenuCbStruct *tmp;
-
- tmp = XtNew(MenuCbStruct);
- tmp->button = button;
- tmp->dialog = dialog;
-
- return tmp;
-}
-
-/***********************************************************************
- * *
- * Popup dialog (in MenuCbStruct) and make menu item insensitive. *
- * *
- ***********************************************************************/
-void km_popup_MenuCbdialog(menu_item)
- MenuCbStruct *menu_item;
-{
- XtSetSensitive(menu_item->button, False);
- XtManageChild(menu_item->dialog);
-}
-
-/***********************************************************************
- * *
- * Popdown dialog (in MenuCbStruct) and make menu item sensitive. *
- * *
- ***********************************************************************/
-void km_popdown_MenuCbdialog(menu_item)
- MenuCbStruct *menu_item;
-{
- XtSetSensitive(menu_item->button, True);
- XtUnmanageChild(menu_item->dialog);
-}
-
-/***********************************************************************
- * *
- * Returns the true shell widget. *
- * *
- ***********************************************************************/
-Widget km_GetTrueShell(w)
- Widget w;
-{
- Widget wgt = w;
-
- if (wgt && !XtIsShell(wgt)) {
- wgt = XtParent(wgt);
- }
- return wgt;
-}
-
-/***********************************************************************
- * *
- * Install MwmCloseCallback. *
- * *
- ***********************************************************************/
-void km_MwmCloseCallback(w, callback, client_data)
- Widget w;
- XtCallbackProc callback;
- XtPointer client_data;
-{
- static Atom a = (Atom) NULL;
- Widget shell = km_GetTrueShell(w);
-
- if (!a)
- a = XmInternAtom(XtDisplay(shell), "WM_DELETE_WINDOW", False);
-
- if (XmIsVendorShell(shell)) {
- XmAddWMProtocols(shell, &a, 1);
- XmAddWMProtocolCallback(shell, a, callback, client_data);
- }
-}
-
-/***********************************************************************
- * *
- * Is shell in IconicState? *
- * *
- ***********************************************************************/
-Boolean km_IsShellIconic(w)
- Widget w;
-{
- static Atom a = (Atom) NULL;
- Widget shell = km_GetTrueShell(w);
- Display *dpy = XtDisplay(shell);
- Window window = XtWindow(shell);
- unsigned long *property = NULL;
- unsigned long nitems;
- unsigned long leftover;
- Atom actual_type;
- int actual_format;
- int status;
- Boolean state;
-
- if (!a)
- a = XmInternAtom(dpy, "WM_STATE", False);
-
- status = XGetWindowProperty(dpy, window,
- a, 0L, 1L,
- False, a, &actual_type, &actual_format,
- &nitems, &leftover, (unsigned char **)&property);
-
- if ( !((status == Success) &&
- (actual_type == a) && (nitems == 1L))) {
- if (property) {
- XFree((char *)property);
- return(False);
- }
- }
-
- state = (*property == IconicState) ? True : False;
-
- XFree((char *)property);
- return(state);
-}
-
-/***********************************************************************
- * *
- * Iconify a shell. *
- * *
- ***********************************************************************/
-void km_IconifyShell(shell)
- Widget shell;
-{
- static Atom a = (Atom) NULL;
- Display *dpy = XtDisplay(shell);
- XClientMessageEvent ev;
-
- if (!a)
- a = XmInternAtom(dpy, "WM_CHANGE_STATE", False);
-
- ev.type = ClientMessage;
- ev.display = dpy;
- ev.message_type = a;
- ev.format = 32;
- ev.data.l[0] = IconicState;
- ev.window = XtWindow(km_GetTrueShell(shell));
-
- XSendEvent(dpy,
- RootWindow(dpy, DefaultScreen(dpy)),
- True,
- (SubstructureRedirectMask | SubstructureNotifyMask),
- (XEvent *)&ev);
- XFlush(dpy);
-}
-
-/***********************************************************************
- * *
- * De-Iconify a shell. *
- * *
- ***********************************************************************/
-void km_DeIconifyShell(w)
- Widget w;
-{
- Widget shell = km_GetTrueShell(w);
- Display *dpy = XtDisplay(shell);
-
- XMapWindow(dpy, XtWindow(shell));
- XFlush(dpy);
-}
-
-
-#if 0
-/******************************************************************************/
-/* void XtoPS_cb() */
-/* XtoPS button activate callback */
-/* produce postscript output of the widget */
-/******************************************************************************/
-static void XtoPS_cb(widget, tag, data )
- Widget widget;
- xtops_struct *tag;
- XmAnyCallbackStruct *data;
-{
- char local_string[128];
- char *file_arg;
- char *postscript_name;
-
-
- if (tag->widget_name == NULL) {
- strcpy (local_string,class_name);
- strcat (local_string,".ps");
- postscript_name = km_wait_input ("Enter postscript file name",
- local_string,"HELP_XTOPS");
- if (postscript_name == NULL) return;
- file_arg = postscript_name; }
- else
- file_arg = tag->widget_name ;
- free (postscript_name);
- sprintf (local_string,"XtoPS -id %d -frame %s",
- XtWindow(tag->widget),file_arg);
- km_set_cursor (km_toplevel,km_wait_cursor);
- XFlush(km_Display);
- system (local_string);
- km_set_cursor (km_toplevel,km_main_cursor);
- XFlush(km_Display);
-}
-#endif
-
-
-/******************************************************************************/
-/* void km_FlushEvents : equivalent to XtAppMainLoop */
-/******************************************************************************/
-void km_FlushEvents()
-{
- XEvent event;
-
- while (XtAppPending(UxAppContext)) {
- XtAppNextEvent(UxAppContext, &event);
- XtDispatchEvent(&event);
- }
-}
-
-
-/******************************************************************************/
-/* void return_input(widget, tag, data ) */
-/* prompt dialog ok button callback : end loop (see km_wait_input) */
-/******************************************************************************/
-static void return_input(widget, tag, data )
- Widget widget;
- int tag;
- XmAnyCallbackStruct *data;
-{
- prompt_not_finished = False;
-}
-
-
-/******************************************************************************/
-/* void wcancel_activate( widget, tag, callback_data ) */
-/* prompt dialog cancel button callback (see km_wait_input) */
-/******************************************************************************/
-static void wcancel_activate( widget, tag, callback_data )
- Widget widget;
- caddr_t tag;
- XmAnyCallbackStruct *callback_data;
-{
- prompt_not_finished = False;
- prompt_cancel = True;
-}
-
-
-/******************************************************************************/
-/* char *km_wait_input (prompt, default_line, help_item) */
-/* */
-/* char *prompt : prompt string */
-/* char *default_line : default value */
-/* char *help_item : item value for help */
-/* */
-/* Return : value given by the user */
-/* NULL for cancel */
-/* */
-/* Ask user for input and wait till she responds (C callable) */
-/* create a prompt dialog for a mandatory parameter input */
-/* (Next event + Dispatch event) loop until the ok button is pressed */
-/* */
-/******************************************************************************/
-char *km_wait_input (prompt, default_line, help_item)
- char *prompt, *default_line, *help_item;
-{
- Arg arglist[5];
- int narg;
- char cval[MAX_string];
- XmString xmstr, input_string;
-
- char *input_text = NULL;
-
-
- if (prompt_id != NULL) {
- XtDestroyWidget (prompt_id);
- km_reset_appShell (prompt_id);
- }
- prompt_id = NULL;
-
-
- narg = 0;
- XtSetArg (arglist[narg],XmNselectionLabelString,
- XmStringCreateLtoR(prompt,km_charset)); narg++;
- if (strlen(default_line) != 0) {
- XtSetArg (arglist[narg],XmNtextString,
- XmStringCreateLtoR(default_line, km_charset)); narg++; }
- sprintf (cval, "%s Prompt", class_name);
- xmstr = XmStringCreateLtoR(cval, XmSTRING_DEFAULT_CHARSET);
- XtSetArg(arglist[narg], XmNdialogTitle, xmstr); narg++;
- prompt_id = XmCreatePromptDialog(km_toplevel,
- "km_wait_input",arglist, narg);
- km_store_appShell (prompt_id, cval);
- XmStringFree(xmstr);
- XtAddCallback(prompt_id,XmNokCallback,(XtCallbackProc)return_input,NULL);
- XtAddCallback(prompt_id,XmNhelpCallback,
- (XtCallbackProc)km_do_help,(XtPointer)help_item);
- XtAddCallback(prompt_id,XmNcancelCallback,
- (XtCallbackProc)wcancel_activate,NULL);
- XtManageChild(prompt_id);
- prompt_not_finished = True;
- prompt_cancel = False;
- while (prompt_not_finished)
- km_FlushEvents();
- if (prompt_cancel) return (NULL);
- km_reset_appShell (prompt_id);
- narg = 0;
- XtSetArg (arglist[narg],XmNtextString,&input_string); narg++;
- XtGetValues (prompt_id,arglist,narg);
- XmStringGetLtoR(input_string,km_charset,&input_text);
- return (str0dup(input_text));
-}
-
-/***********************************************************************
- * *
- * km_toggle_selection : *
- * *
- * Gives another taste of the "SelectionBox" widget with toggles *
- * buttons instead of a list widget. *
- * *
- ***********************************************************************/
-int km_toggle_selection (prompt, list, defsel)
- char *prompt;
- char **list;
- int defsel;
-{
- Widget kts, ktsRowColumn, ktsForm1, ktsForm2,
- ktsSep, kts_OK, kts_Cancel,
- ktsToggle[10];
- char cval[MAX_string];
- int i, input;
-
- if (prompt_id != NULL) {
- XtDestroyWidget (prompt_id);
- km_reset_appShell (prompt_id);
- }
- prompt_id = NULL;
-
-
- /* Design and create widget "toggle_selection" */
- prompt_id = XtVaCreatePopupShell( "prompt_id",
- xmDialogShellWidgetClass, km_toplevel,
- NULL );
- sprintf (cval, "%s Selection", class_name);
- km_store_appShell (prompt_id, cval);
- kts = XtVaCreateWidget( "kts",
- xmFormWidgetClass, prompt_id,
- RES_CONVERT( XmNdialogTitle, cval ),
- NULL );
- kts_OK = XtVaCreateManagedWidget( "kts_OK",
- xmPushButtonGadgetClass, kts,
- XmNdefaultButtonShadowThickness, 1,
- XmNtopAttachment, XmATTACH_NONE,
- XmNleftPosition, 20,
- XmNleftOffset, -30,
- XmNleftAttachment, XmATTACH_POSITION,
- XmNbottomOffset, 10,
- XmNbottomAttachment, XmATTACH_FORM,
- XmNshowAsDefault, 1,
- RES_CONVERT( XmNlabelString, "OK" ),
- XmNheight, 30,
- XmNwidth, 60,
- NULL );
- kts_Cancel = XtVaCreateManagedWidget( "kts_Cancel",
- xmPushButtonWidgetClass, kts,
- RES_CONVERT( XmNlabelString, "Cancel" ),
- XmNleftPosition, 80,
- XmNleftOffset, -30,
- XmNleftAttachment, XmATTACH_POSITION,
- XmNbottomOffset, 10,
- XmNbottomAttachment, XmATTACH_FORM,
- XmNheight, 30,
- XmNwidth, 60,
- NULL );
- XtVaSetValues(kts,
- XmNdefaultButton, kts_OK,
- NULL );
- ktsSep = XtVaCreateManagedWidget( "ktsSep",
- xmSeparatorGadgetClass, kts,
- XmNbottomWidget, kts_OK,
- XmNrightOffset, 0,
- XmNrightAttachment, XmATTACH_FORM,
- XmNleftOffset, 0,
- XmNleftAttachment, XmATTACH_FORM,
- XmNbottomOffset, 10,
- XmNbottomAttachment, XmATTACH_WIDGET,
- NULL );
- ktsForm1 = XtVaCreateManagedWidget( "ktsForm1",
- xmFormWidgetClass, kts,
- XmNtopOffset, 10,
- XmNtopAttachment, XmATTACH_FORM,
- XmNrightOffset, 10,
- XmNrightAttachment, XmATTACH_FORM,
- XmNleftOffset, 10,
- XmNleftAttachment, XmATTACH_FORM,
- XmNheight, 30,
- XmNresizePolicy, XmRESIZE_NONE,
- NULL );
- XtVaCreateManagedWidget( "ktsLabel",
- xmLabelGadgetClass, ktsForm1,
- XmNalignment, XmALIGNMENT_BEGINNING,
- XmNleftPosition, 10,
- RES_CONVERT( XmNlabelString, prompt ),
- XmNtopOffset, 0,
- XmNtopAttachment, XmATTACH_FORM,
- XmNleftOffset, 0,
- XmNleftAttachment, XmATTACH_FORM,
- XmNbottomOffset, 0,
- XmNbottomAttachment, XmATTACH_FORM,
- NULL );
- ktsForm2 = XtVaCreateManagedWidget( "ktsForm2",
- xmFormWidgetClass, kts,
- XmNbottomWidget, ktsSep,
- XmNtopWidget, ktsForm1,
- XmNtopOffset, 0,
- XmNtopAttachment, XmATTACH_WIDGET,
- XmNrightOffset, 10,
- XmNrightAttachment, XmATTACH_FORM,
- XmNleftOffset, 10,
- XmNleftAttachment, XmATTACH_FORM,
- XmNbottomOffset, 10,
- XmNbottomAttachment, XmATTACH_WIDGET,
- XmNresizePolicy, XmRESIZE_NONE,
- NULL );
- ktsRowColumn = XtVaCreateManagedWidget( "ktsRowColumn",
- xmRowColumnWidgetClass, ktsForm2,
- XmNrightOffset, 5,
- XmNrightAttachment, XmATTACH_FORM,
- XmNleftOffset, 5,
- XmNleftAttachment, XmATTACH_FORM,
- XmNbottomOffset, 5,
- XmNbottomAttachment, XmATTACH_FORM,
- XmNradioBehavior, TRUE,
- XmNpacking, XmPACK_COLUMN,
- NULL );
- /* Separators to have a frame arround the RowColumn */
- XtVaCreateManagedWidget( "ktsSep1",
- xmSeparatorGadgetClass, ktsForm2,
- XmNtopOffset, 10,
- XmNtopAttachment, XmATTACH_FORM,
- XmNrightOffset, 0,
- XmNrightAttachment, XmATTACH_FORM,
- XmNleftOffset, 0,
- XmNleftAttachment, XmATTACH_FORM,
- NULL );
- XtVaCreateManagedWidget( "ktsSep2",
- xmSeparatorGadgetClass, ktsForm2,
- XmNtopOffset, 10,
- XmNtopAttachment, XmATTACH_FORM,
- XmNleftOffset, 0,
- XmNleftAttachment, XmATTACH_FORM,
- XmNbottomOffset, 0,
- XmNbottomAttachment, XmATTACH_FORM,
- XmNorientation, XmVERTICAL,
- NULL );
- XtVaCreateManagedWidget( "ktsSep3",
- xmSeparatorGadgetClass, ktsForm2,
- XmNrightOffset, 0,
- XmNrightAttachment, XmATTACH_FORM,
- XmNleftOffset, 0,
- XmNleftAttachment, XmATTACH_FORM,
- XmNbottomOffset, 0,
- XmNbottomAttachment, XmATTACH_FORM,
- NULL );
- XtVaCreateManagedWidget( "ktsSep4",
- xmSeparatorGadgetClass, ktsForm2,
- XmNtopOffset, 10,
- XmNtopAttachment, XmATTACH_FORM,
- XmNrightAttachment, XmATTACH_FORM,
- XmNbottomOffset, 0,
- XmNbottomAttachment, XmATTACH_FORM,
- XmNorientation, XmVERTICAL,
- NULL );
-
- /* Loop on list to create as many toggles required */
- for (i=0; list[i]; i++) {
- if (i >= 10) break;
- if (i+1 == defsel)
- ktsToggle[i] = XtVaCreateManagedWidget( "ktsToggle",
- xmToggleButtonGadgetClass, ktsRowColumn,
- RES_CONVERT( XmNlabelString, list[i] ),
- XmNset, TRUE,
- XmNheight, 30,
- NULL );
- else
- ktsToggle[i] = XtVaCreateManagedWidget( "ktsToggle",
- xmToggleButtonGadgetClass, ktsRowColumn,
- RES_CONVERT( XmNlabelString, list[i] ),
- XmNheight, 30,
- NULL );
- } /* end ... for (i=0; list[i]; i++) */
-
- UxPopupInterface(kts, XtGrabNone);
-
-
- XtAddCallback(kts_OK,XmNactivateCallback,(XtCallbackProc)return_input,NULL);
- XtAddCallback(kts_Cancel,XmNactivateCallback,
- (XtCallbackProc)wcancel_activate,NULL);
- prompt_not_finished = True;
- prompt_cancel = False;
- while (prompt_not_finished)
- km_FlushEvents();
- if (prompt_cancel) return (0);
- km_reset_appShell (prompt_id);
- for (input=0; list[input]; input++) {
- Boolean set;
-
- if (input >= 10) break;
- XtVaGetValues (ktsToggle[input], XmNset, &set, NULL);
- if (set) return (input+1);
- }
-
- return (-1);
-}
-
-/***********************************************************************
- * *
- * Set the cursor shape. *
- * *
- ***********************************************************************/
-extern void km_set_cursor (w, cursor)
- Widget w;
- Cursor cursor;
-{
- XSetWindowAttributes attrs;
- Display *dpy = XtDisplay(w);
-
- if (!XtWindow(w)) return;
-
- attrs.cursor = cursor;
-
- XChangeWindowAttributes(dpy, XtWindow(w), CWCursor, &attrs);
-
- XFlush(dpy);
-}
-
-
-/******************************************************************************/
-/* void km_get_curpos (event, *xc, *yc) */
-/******************************************************************************/
-/*
- * Get cursor positions xc and yc
-*/
-void km_get_curpos (event, xc, yc)
- XEvent *event;
- Position *xc, *yc; /* output values */
-{
- static int xmax, ymax;
- static int first = 0;
-
- if( event == NULL ) {
- *xc = 0;
- *yc = 0;
- return;
- }
-
-/* Get display size (first time only) */
- if (first == 0) {
- first = 1;
- xmax = XDisplayWidth (km_Display,DefaultScreen(km_Display));
- ymax = XDisplayHeight (km_Display,DefaultScreen(km_Display)); }
-
- *xc = event->xbutton.x_root;
- *yc = event->xbutton.y_root;
-
- if (*xc < 0 || *xc > xmax) *xc = 0;
- if (*yc < 0 || *yc > ymax) *yc = 0;
-
- return;
-}
-
-/***********************************************************************
- * *
- * Print the content of a file into the executive window. *
- * *
- ***********************************************************************/
-void km_view_file (w, client_data, cbs)
- Widget w;
- BrClientdata *client_data;
- XmAnyCallbackStruct *cbs;
-{
- FILE *tfp;
-
- /* Open and read file */
- if ((tfp = fopen(client_data->stext, "r")) != NULL) {
- char line[1024];
-
- printf ("*** File %s :\n", client_data->stext);
- while( fgets( line, (sizeof line), tfp ) != NULL )
- printf ("%s", line);
- }
-}
-
-/***********************************************************************
- * *
- * Event handler to avoid the window to disappear under kxterm *
- * *
- ***********************************************************************/
-void km_focus_window(widget, tag, ev)
- Widget widget;
- caddr_t tag;
- XEnterWindowEvent *ev;
-{
- XRaiseWindow ( UxDisplay, XtWindow(km_GetTrueShell(widget)) );
-}
-
-/***********************************************************************
- * *
- * "OK callback" for a list. It automatically calls the user defined *
- * routine for OK (from list_dat.user_callback). *
- * *
- ***********************************************************************/
-static int km_list_OK( widget, tag, callback_data )
- Widget widget;
- caddr_t tag;
- XmAnyCallbackStruct *callback_data;
-{
- Widget kuipListText;
- char *selection;
-
- /* Get selected value */
- kuipListText = XmSelectionBoxGetChild (km_listSBox, XmDIALOG_TEXT);
- selection = (char *) XmTextGetString (kuipListText);
-
- /* Call user defined callback for OK with selection as input argument */
- list_data.user_callback (selection);
-
- /* Destroy list */
- km_destroy_list();
-
- return 0;
-}
-
-/***********************************************************************
- * *
- * km_list_data (list_label, selection_label, help_text, callback) *
- * Set data information for a user defined list. *
- * *
- * char *list_label : label written at the beginning of the list *
- * char *selection_label : label written before the selection *
- * char *help_text : help message accessed throuh help button *
- * int callback() : user defined routine called for OK *
- * N.B. int callback( char* selection) where selection (input) is *
- * the value which has been selected by the user. *
- ***********************************************************************/
-void km_list_data( const char *list_label,
- const char *selection_label,
- const char *help_text,
- int (*callback)() )
-{
- /* Fill structure ListData with ... */
-
- /* ... list label (written at the beginning of the list) */
- list_data.listLabel = strdup (list_label);
-
- /* ... List selection label (written before the selection) */
- list_data.label = strdup (selection_label);
-
- /* ... help text (accessed throuh help button) */
- list_data.help = strdup (help_text);
-
- /* ... address of user defined routine called when OK button is pressed */
- list_data.user_callback = callback;
-
- /* ... OK callback (user written routine) */
- list_data.OKcallback = km_list_OK;
-}
-
-/***********************************************************************
- * *
- * Display list after char **items is filled (and km_list data called) *
- * *
- ***********************************************************************/
-void km_show_list (items)
- char **items;
-{
- km_display_list ( items, NULL, list_data);
-}
-
-/***********************************************************************
- * *
- * Display FileSelectionBox *
- * *
- ***********************************************************************/
-void km_show_filSel( const char *title,
- const char *dir,
- const char *def,
- const char *help,
- int (*okCallback)() )
-{
-extern Widget km_fil_sel;
- char *filter = NULL;
-
- if (km_fil_sel != NULL) XtDestroyWidget (XtParent(km_fil_sel));
- km_fil_sel = NULL;
-
- km_fil_sel = create_kuipFilSel(km_toplevel);
- XtVaSetValues ( XtParent(km_fil_sel), XmNtitle, title,
- NULL);
- XtVaSetValues ( km_fil_sel, XmNdefaultPosition, True, NULL);
-
- /*
- * find and restore the context
- * (to get to the widgets belonging to this dialog)
- */
- UxKuipFilSelContext = (_UxCkuipFilSel *)UxGetContext( km_fil_sel );
-
- /* set filter and directory */
- if (dir != NULL) {
- char *p;
-
- filter = strdup (dir);
- XtVaSetValues ( km_FilSel,
- RES_CONVERT( XmNpattern, filter ),
- NULL);
- p = strrchr (filter, '/');
- if (p != NULL) {
- p[1] = '\0';
- XtVaSetValues ( km_FilSel,
- RES_CONVERT( XmNdirectory, filter ),
- NULL);
- }
- }
-
- if (def != NULL) {
- Widget listw;
- XmStringTable xmstr_list;
- int nc, l;
-
- filter = mstrcat (filter, def);
- listw = XmSelectionBoxGetChild( km_FilSel, XmDIALOG_LIST);
- XtVaGetValues ( listw, XmNitems, &xmstr_list,
- XmNitemCount, &nc,
- NULL);
- for (l = 0; l< nc; l++) {
- char *item;
-
- XmStringGetLtoR(xmstr_list[l], km_charset, &item);
- if (strcmp (item, filter) == 0) {
- XmListSelectItem ( listw, xmstr_list[l], True);
- }
- XtFree (item);
- }
- }
- if (filter != NULL) free (filter);
-
- /* Display FileSelectionBox */
- UxPopupInterface( km_fil_sel, XtGrabNone );
-
- XtAddCallback( km_FilSel, XmNhelpCallback,
- (XtCallbackProc)km_help_activate, (XtPointer)help );
-
- XtAddCallback( km_FilSel, XmNokCallback,
- (XtCallbackProc)okFCallback, (XtPointer)okCallback );
- XtAddCallback( km_FilSel, XmNcancelCallback,
- (XtCallbackProc)km_clFCallback, NULL );
-}
-
-static void okFCallback( Widget widget,
- int (*okCallback)(),
- XmFileSelectionBoxCallbackStruct *data )
-{
-extern Widget km_fil_sel;
- char *file;
-
- /*
- * find and restore the context
- * (to get to the widgets belonging to this dialog)
- */
- UxKuipFilSelContext = (_UxCkuipFilSel *)UxGetContext( widget );
-
- XmStringGetLtoR(data->value, km_charset, &file);
-
- (*okCallback)(file);
-
- XtFree (file);
-
- if (km_fil_sel != NULL) XtDestroyWidget (XtParent(km_fil_sel));
- km_fil_sel = NULL;
-}
diff --git a/src/packlib/kuip/code_motif/kuipmcdf.cdf b/src/packlib/kuip/code_motif/kuipmcdf.cdf
deleted file mode 100644
index a9d948b..0000000
--- a/src/packlib/kuip/code_motif/kuipmcdf.cdf
+++ /dev/null
@@ -1,958 +0,0 @@
-*
-* $Id: kuipmcdf.cdf,v 1.2 1997/09/01 07:53:33 cremel Exp $
-*
-* $Log: kuipmcdf.cdf,v $
-* Revision 1.2 1997/09/01 07:53:33 cremel
-* Implement the possibility to "close" a palette with commands:
-* MULTI_PANEL <title> close
-* or:
-* MULTI_PANEL last close
-* Update HELP accordingly.
-*
-* Revision 1.1.1.1 1996/03/08 15:33:13 mclareni
-* Kuip
-*
-*
-*CMZ : 2.06/03 13/01/95 11.54.39 by N.Cremel
-*-- Author : Alfred Nathaniel 25/11/92
->Name KUIDFM
-
-
->Browse Commands . kscncmds%C
- List
-'Set Default' . ' Set/Root /'
-
->Class /Menu Menu big_menu sm_menu
- List
-'Set Root' . ' Set/Root [path]/[this]'
-
->Class Cmd Command big_cmd sm_cmd
- Execute . ' [path]/[this]'
-'Execute...' . '-[path]/[this]'
- Help / ' Help [path]/[this]'
- Usage . ' Usage [path]/[this]'
- Manual . ' Manual [path]/[this]'
-'Set Command' / ' Set/Command [path]/[this] $*'
- Deactivate ! ' Set/Visibility [path]/[this] off'
-
->Class InvCmd 'Deactivated Command' big_invcmd sm_invcmd
- Help . ' Set/Visibility [path]/[this] on; Help [path]/[this]; _
- Set/Visibility [path]/[this] off'
- Activate /! ' Set/Visibility [path]/[this] on'
-
->Browse Files . kmbfil%C kmbfdi%C
- List
-'Chdir to ...' . '-Set/LCDIR [path]'
-!Edit . '-KUIP/EDIT [path]'
-
->Class ExFile 'Executable File' big_fx sm_fx
- Execute . ' /KUIP/SHELL [that]'
-'Execute...' . '-/KUIP/SHELL [that]'
- Edit . ' /KUIP/EDIT [that]'
- View . . km_view_file%C
- Print . ' /KUIP/PRINT [that]'
- Delete ! ' -/KUIP/SHELL rm [that]'
-
->Class RwFile 'Read/Write File' big_frw sm_frw
- Edit . ' /KUIP/EDIT [that]'
- View . . km_view_file%C
- Print . ' /KUIP/PRINT [that]'
- Delete ! '-/KUIP/SHELL rm [that]'
-
->Class RoFile 'Read-only File' big_fro sm_fro
- View . . km_view_file%C
- Print . ' /KUIP/PRINT [that]'
- Delete ! '-/KUIP/SHELL rm [that]'
-
->Class NoFile 'No-access File' big_fno sm_fno
- Chmod . '-/KUIP/SHELL chmod 644 [that]'
-
->Class VmsComFile 'Command script' big_fx sm_fx
- Execute . ' /KUIP/SHELL @[that]'
-'Execute...' . '-/KUIP/SHELL @[that]'
- Edit . ' /KUIP/EDIT [that]'
- View . . km_view_file%C
- Print . ' /KUIP/PRINT [that]'
- Delete ! '-/KUIP/SHELL DELETE [that];0'
-
->Class VmsExeFile 'Executable File' big_fx sm_fx
- Execute ! ' /KUIP/SHELL RUN [that]'
-'Execute...' ! '-/KUIP/SHELL RUN [that]'
- Delete ! '-/KUIP/SHELL DELETE [that];0'
-
->Class VmsRwFile 'Read/Write File' big_frw sm_frw
- Edit . ' /KUIP/EDIT [that]'
- View . . km_view_file%C
- Print . ' /KUIP/PRINT [that]'
- Delete ! '-/KUIP/SHELL DELETE [that];0'
-
->Class VmsRoFile 'Read-only File' big_fro sm_fro
- View . . km_view_file%C
- Print . ' /KUIP/PRINT [that]'
- Delete ! '-/KUIP/SHELL DELETE [that];0'
-
->Class VmsNoFile 'No-access File' big_fno sm_fno
- 'Set Protection' . '-/KUIP/SHELL SET PROTECTION [that]'
-
->Browse Macro . kmbmac%C kmbmdi%C
- List
- Edit ! '-KUIP/EDIT [path]'
-
->Class MacFile 'Kuip Macro' big_fm sm_fm
- Exec ! ' /MACRO/EXEC [that]'
-'Exec...' ! '-MACRO/EXEC [that]'
- Edit . ' /KUIP/EDIT [that]'
- View . . km_view_file%C
- Print . ' /KUIP/PRINT [that]'
- Delete ! '-/KUIP/SHELL rm [that]'
-
->Class PSFile 'PostScript File' big_ps sm_ps
- View . ' /KUIP/PSVIEW [that]'
- Edit . ' /KUIP/EDIT [that]'
- Print . ' /KUIP/PRINT [that]'
- Delete ! '-/KUIP/SHELL rm [that]'
-
->Class EPSFile 'Encapsulated PostScript File' big_ps sm_ps
- View . ' /KUIP/PSVIEW [that]'
- Edit . ' /KUIP/EDIT [that]'
- Print . ' /KUIP/PRINT [that]'
- Delete ! '-/KUIP/SHELL rm [that]'
-
->Class /DirFile Directory big_menu sm_menu
- List
-
->Class /DirUpFile 'Up Directory' big_dirup sm_dirup
- List
-
->Icon_bitmaps
-
-#define pixpan_width 30
-#define pixpan_height 23
-static char pixpan_bits[] = {
- 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x01, 0x00, 0x00, 0xff, 0x07, 0x00,
- 0x80, 0xff, 0x0f, 0x00, 0xc0, 0x07, 0x1f, 0x00, 0xe0, 0x21, 0x3c, 0x00,
- 0xf0, 0x70, 0x78, 0x00, 0x70, 0x70, 0x70, 0x00, 0x78, 0x70, 0xf0, 0x00,
- 0x38, 0x70, 0xe0, 0x00, 0x38, 0x70, 0xe0, 0x00, 0x38, 0x70, 0xe0, 0x00,
- 0x38, 0x70, 0xe0, 0x00, 0x38, 0x00, 0xe0, 0x00, 0x78, 0x70, 0xf0, 0x00,
- 0x70, 0x70, 0x70, 0x00, 0xf0, 0x70, 0x78, 0x00, 0xe0, 0x01, 0x3c, 0x00,
- 0xc0, 0x07, 0x1f, 0x00, 0x80, 0xff, 0x0f, 0x00, 0x00, 0xff, 0x07, 0x00,
- 0x00, 0xfc, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00};
-
-#define big_menu_width 30
-#define big_menu_height 23
-static char big_menu_bits[] = {
- 0xff, 0xff, 0xff, 0x3f, 0x01, 0x00, 0x00, 0x20, 0x01, 0x00, 0x00, 0x30,
- 0xa9, 0xaa, 0xaa, 0x3a, 0x51, 0x55, 0x55, 0x35, 0xa9, 0xaa, 0xaa, 0x3a,
- 0x01, 0x54, 0x15, 0x30, 0x01, 0xa8, 0x0a, 0x30, 0x51, 0x01, 0x40, 0x35,
- 0xa9, 0x02, 0xa0, 0x3a, 0x51, 0x55, 0x55, 0x35, 0xa9, 0xaa, 0xaa, 0x3a,
- 0x51, 0x55, 0x55, 0x35, 0xa9, 0xaa, 0xaa, 0x3a, 0x51, 0x55, 0x55, 0x35,
- 0xa9, 0xaa, 0xaa, 0x3a, 0x51, 0x55, 0x55, 0x35, 0xa9, 0xaa, 0xaa, 0x3a,
- 0x51, 0x55, 0x55, 0x35, 0xa9, 0xaa, 0xaa, 0x3a, 0x51, 0x55, 0x55, 0x35,
- 0xfd, 0xff, 0xff, 0x3f, 0xff, 0xff, 0xff, 0x3f};
-
-#define sm_menu_width 20
-#define sm_menu_height 16
-static char sm_menu_bits[] = {
- 0xff, 0xff, 0x0f, 0x01, 0x00, 0x08, 0x01, 0x00, 0x0c, 0x51, 0x55, 0x0d,
- 0xa9, 0xaa, 0x0e, 0x01, 0x15, 0x0c, 0x29, 0x80, 0x0e, 0x51, 0x55, 0x0d,
- 0xa9, 0xaa, 0x0e, 0x51, 0x55, 0x0d, 0xa9, 0xaa, 0x0e, 0x51, 0x55, 0x0d,
- 0xa9, 0xaa, 0x0e, 0x51, 0x55, 0x0d, 0xfd, 0xff, 0x0f, 0xff, 0xff, 0x0f};
-
-#define big_cmd_width 30
-#define big_cmd_height 30
-static char big_cmd_bits[] = {
- 0xff, 0xff, 0xff, 0x3f, 0x01, 0x00, 0x00, 0x20, 0x01, 0x00, 0x00, 0x30,
- 0xa9, 0xaa, 0xaa, 0x3a, 0x51, 0x55, 0x55, 0x3d, 0xa9, 0xaa, 0xaa, 0x3a,
- 0x51, 0x55, 0x56, 0x31, 0xa9, 0x2a, 0xaa, 0x38, 0x51, 0x15, 0x56, 0x3c,
- 0xa9, 0x0a, 0x2a, 0x3e, 0x51, 0x05, 0x06, 0x3f, 0xa9, 0x02, 0x82, 0x3b,
- 0x51, 0x01, 0xc0, 0x3d, 0xa9, 0x00, 0xe0, 0x3a, 0x51, 0x00, 0x70, 0x3d,
- 0x29, 0x18, 0xb8, 0x3a, 0x11, 0x1c, 0x5c, 0x3d, 0x09, 0x1f, 0xae, 0x3a,
- 0xc5, 0x17, 0x57, 0x3d, 0xf3, 0x9a, 0xab, 0x3a, 0x7f, 0xd5, 0x55, 0x3d,
- 0xaf, 0xfa, 0xaa, 0x3a, 0x51, 0x75, 0x55, 0x3d, 0xa9, 0xba, 0xaa, 0x3a,
- 0x51, 0x55, 0x55, 0x3d, 0xa9, 0xaa, 0xaa, 0x3a, 0x51, 0x55, 0x55, 0x3d,
- 0xf9, 0xff, 0xff, 0x3f, 0xfd, 0xff, 0xff, 0x3f, 0xff, 0xff, 0xff, 0x3f};
-
-#define sm_cmd_width 16
-#define sm_cmd_height 16
-static char sm_cmd_bits[] = {
- 0xff, 0xff, 0x01, 0x80, 0x01, 0xc0, 0xa9, 0xea, 0x51, 0xc5, 0x29, 0xe2,
- 0x11, 0xf0, 0x09, 0xf8, 0x01, 0xdc, 0x31, 0xee, 0x3f, 0xd7, 0xaf, 0xeb,
- 0xd1, 0xd5, 0xa9, 0xea, 0xfd, 0xff, 0xff, 0xff};
-
-#define big_invcmd_width 35
-#define big_invcmd_height 35
-static char big_invcmd_bits[] = {
- 0xe0, 0xff, 0xff, 0xff, 0x07, 0x00, 0x00, 0x00, 0x00, 0x04, 0x00, 0x00,
- 0x00, 0x00, 0x06, 0x00, 0x55, 0x55, 0x55, 0x07, 0x00, 0xaa, 0xaa, 0xaa,
- 0x07, 0x07, 0x54, 0x55, 0x55, 0x07, 0x0d, 0xa8, 0xaa, 0xaa, 0x07, 0x09,
- 0x50, 0x65, 0x55, 0x07, 0x19, 0xa8, 0xa2, 0xaa, 0x07, 0x31, 0x50, 0x61,
- 0x15, 0x06, 0x69, 0xf0, 0xa0, 0x8a, 0x07, 0x51, 0x00, 0x61, 0xc5, 0x07,
- 0x69, 0x00, 0xa2, 0xe2, 0x07, 0xd1, 0x00, 0x60, 0x70, 0x07, 0xa9, 0x07,
- 0x2c, 0xb8, 0x07, 0x51, 0x05, 0x30, 0x5c, 0x07, 0xa9, 0x1a, 0x20, 0xae,
- 0x07, 0x51, 0x21, 0x40, 0x57, 0x07, 0xa9, 0x40, 0xc0, 0xab, 0x07, 0x51,
- 0xe0, 0xc0, 0x55, 0x07, 0x29, 0xf0, 0x81, 0xaa, 0x07, 0x11, 0xdc, 0x00,
- 0x55, 0x07, 0x09, 0xaf, 0x02, 0xaa, 0x07, 0xc5, 0xd7, 0x04, 0x54, 0x07,
- 0xf3, 0xaa, 0x0e, 0xa8, 0x07, 0x7f, 0xd5, 0x0f, 0x40, 0x07, 0xaf, 0xaa,
- 0x1b, 0x80, 0x07, 0x51, 0xd5, 0x35, 0x00, 0x07, 0xa9, 0xaa, 0xea, 0x01,
- 0x06, 0x51, 0x55, 0x55, 0x03, 0x04, 0xa9, 0xaa, 0xaa, 0x06, 0x00, 0x51,
- 0x55, 0x55, 0x0d, 0x00, 0xf9, 0xff, 0xff, 0x1f, 0x00, 0xfd, 0xff, 0xff,
- 0x3f, 0x00, 0xff, 0xff, 0xff, 0x7f, 0x00};
-
-#define sm_invcmd_width 19
-#define sm_invcmd_height 18
-static char sm_invcmd_bits[] = {
- 0x10, 0x00, 0x06, 0xa0, 0xaa, 0x06, 0x43, 0x55, 0x07, 0x81, 0x2a, 0x06,
- 0x0d, 0x11, 0x07, 0x19, 0x83, 0x07, 0x15, 0xc0, 0x07, 0x69, 0xe0, 0x06,
- 0x95, 0x60, 0x07, 0x89, 0xb0, 0x06, 0x41, 0x41, 0x07, 0x71, 0x86, 0x06,
- 0x5f, 0x07, 0x07, 0xef, 0x1b, 0x04, 0x55, 0x35, 0x00, 0xa9, 0x2a, 0x00,
- 0xfd, 0x7f, 0x00, 0xff, 0xff, 0x00};
-
-#define big_frw_width 28
-#define big_frw_height 38
-static char big_frw_bits[] = {
- 0xff, 0xff, 0xff, 0x0f, 0x01, 0x00, 0x00, 0x08, 0x01, 0x00, 0x00, 0x08,
- 0x01, 0x00, 0x00, 0x08, 0x01, 0x00, 0x00, 0x08, 0xb1, 0x7b, 0x6b, 0x08,
- 0x01, 0x00, 0x00, 0x08, 0xb9, 0x77, 0xef, 0x08, 0x01, 0x00, 0x00, 0x08,
- 0xb9, 0xf6, 0x1a, 0x08, 0x01, 0x00, 0x00, 0x08, 0x69, 0xde, 0xbc, 0x08,
- 0x01, 0x00, 0x00, 0x08, 0x59, 0x4f, 0x9e, 0x08, 0x01, 0x00, 0x00, 0x08,
- 0xd9, 0x07, 0x00, 0x08, 0x81, 0x0c, 0x00, 0x08, 0x81, 0x18, 0x00, 0x08,
- 0x81, 0x33, 0x00, 0x08, 0x01, 0x67, 0x00, 0x08, 0x01, 0xce, 0x00, 0x08,
- 0x01, 0x9c, 0x01, 0x08, 0x01, 0x38, 0x03, 0x08, 0x01, 0x70, 0x06, 0x08,
- 0x01, 0xe0, 0x0c, 0x08, 0x01, 0xc0, 0x19, 0x08, 0x01, 0x80, 0x33, 0x08,
- 0x01, 0x00, 0x67, 0x08, 0x01, 0x00, 0xce, 0x08, 0x01, 0x00, 0x9c, 0x09,
- 0x01, 0x00, 0xb8, 0x0b, 0x01, 0x00, 0x70, 0x0e, 0x01, 0x00, 0x60, 0x0b,
- 0x01, 0x00, 0xc0, 0x09, 0x01, 0x00, 0x80, 0x08, 0x01, 0x00, 0x00, 0x08,
- 0x01, 0x00, 0x00, 0x08, 0xff, 0xff, 0xff, 0x0f};
-
-#define sm_frw_width 18
-#define sm_frw_height 22
-static char sm_frw_bits[] = {
- 0xff, 0xff, 0x03, 0x01, 0x00, 0x02, 0x01, 0x00, 0x02, 0xd9, 0x76, 0x02,
- 0x01, 0x00, 0x02, 0xf9, 0x00, 0x02, 0x21, 0x01, 0x02, 0x61, 0x02, 0x02,
- 0xc1, 0x04, 0x02, 0x81, 0x09, 0x02, 0x01, 0x13, 0x02, 0x01, 0x26, 0x02,
- 0x01, 0x6c, 0x02, 0x01, 0x98, 0x02, 0x01, 0x70, 0x02, 0x01, 0x20, 0x02,
- 0x01, 0x00, 0x02, 0x01, 0x00, 0x02, 0x01, 0x00, 0x02, 0x01, 0x00, 0x02,
- 0x01, 0x00, 0x02, 0xff, 0xff, 0x03};
-
-#define big_fro_width 28
-#define big_fro_height 38
-static char big_fro_bits[] = {
- 0xff, 0xff, 0xff, 0x0f, 0x01, 0x00, 0x00, 0x08, 0x01, 0x00, 0x00, 0x08,
- 0x01, 0x00, 0x00, 0x08, 0x01, 0x00, 0x00, 0x08, 0xb1, 0x7b, 0x6b, 0x08,
- 0x01, 0x00, 0x00, 0x08, 0xb9, 0x77, 0xef, 0x08, 0x01, 0x00, 0x00, 0x08,
- 0xb9, 0xf6, 0x1a, 0x08, 0x01, 0x00, 0x00, 0x08, 0xe9, 0xf6, 0x7a, 0x08,
- 0x01, 0x00, 0x00, 0x08, 0x39, 0xf6, 0xcc, 0x08, 0x01, 0x00, 0x00, 0x08,
- 0x79, 0x9c, 0x73, 0x08, 0x01, 0x00, 0x00, 0x08, 0xe1, 0xfc, 0xcc, 0x08,
- 0x01, 0x00, 0x00, 0x08, 0x39, 0xc6, 0xe3, 0x08, 0x01, 0x00, 0x00, 0x08,
- 0xd9, 0x37, 0x6f, 0x08, 0x01, 0x00, 0x00, 0x08, 0x01, 0x00, 0x00, 0x08,
- 0x01, 0x00, 0x00, 0x08, 0x01, 0x06, 0xc0, 0x08, 0x01, 0x09, 0x20, 0x09,
- 0x81, 0x08, 0x10, 0x09, 0xe1, 0xc8, 0x09, 0x09, 0x11, 0x2d, 0x86, 0x09,
- 0x09, 0x12, 0x04, 0x08, 0x09, 0x12, 0x04, 0x08, 0x09, 0x12, 0x04, 0x08,
- 0x11, 0x21, 0x02, 0x08, 0xe1, 0xc0, 0x01, 0x08, 0x01, 0x00, 0x00, 0x08,
- 0x01, 0x00, 0x00, 0x08, 0xff, 0xff, 0xff, 0x0f};
-
-#define sm_fro_width 18
-#define sm_fro_height 22
-static char sm_fro_bits[] = {
- 0xff, 0xff, 0x03, 0x01, 0x00, 0x02, 0x01, 0x00, 0x02, 0xd9, 0x76, 0x02,
- 0x01, 0x00, 0x02, 0xb9, 0x6d, 0x02, 0x01, 0x00, 0x02, 0x69, 0x77, 0x02,
- 0x01, 0x00, 0x02, 0xd9, 0x6e, 0x02, 0x01, 0x00, 0x02, 0xb9, 0x77, 0x02,
- 0x01, 0x00, 0x02, 0x01, 0x00, 0x02, 0x81, 0x40, 0x02, 0x41, 0xa1, 0x02,
- 0xb1, 0x9d, 0x02, 0x49, 0x12, 0x02, 0x49, 0x12, 0x02, 0x31, 0x0c, 0x02,
- 0x01, 0x00, 0x02, 0xff, 0xff, 0x03};
-
-#define big_fm_width 28
-#define big_fm_height 38
-static char big_fm_bits[] = {
- 0xff, 0xff, 0xff, 0x0f, 0x01, 0x00, 0x00, 0x08, 0x01, 0x00, 0x00, 0x0c,
- 0xa9, 0xaa, 0xaa, 0x0e, 0x51, 0x55, 0x55, 0x0d, 0xa9, 0xaa, 0xaa, 0x0e,
- 0x51, 0x55, 0x55, 0x0d, 0xa9, 0xaa, 0xaa, 0x0e, 0xf1, 0x55, 0x7d, 0x0d,
- 0xf9, 0xab, 0xfe, 0x0e, 0xf1, 0x57, 0x7f, 0x0d, 0xf9, 0xaf, 0xff, 0x0e,
- 0xf1, 0xff, 0x7f, 0x0d, 0xf9, 0xff, 0xff, 0x0e, 0xf1, 0xff, 0x7f, 0x0d,
- 0xf9, 0xfb, 0xfe, 0x0e, 0xf1, 0x77, 0x7f, 0x0d, 0xf9, 0xab, 0xfe, 0x0e,
- 0xf1, 0x57, 0x7f, 0x0d, 0xf9, 0xab, 0xfe, 0x0e, 0xf1, 0x57, 0x7f, 0x0d,
- 0xf9, 0xab, 0xfe, 0x0e, 0xf1, 0x57, 0x7f, 0x0d, 0xf9, 0xab, 0xfe, 0x0e,
- 0xf1, 0x57, 0x7f, 0x0d, 0xf9, 0xab, 0xfe, 0x0e, 0xf1, 0x57, 0x7f, 0x0d,
- 0xf9, 0xab, 0xfe, 0x0e, 0xf1, 0x57, 0x7f, 0x0d, 0xf9, 0xab, 0xfe, 0x0e,
- 0xf1, 0x57, 0x7f, 0x0d, 0xa9, 0xaa, 0xaa, 0x0e, 0x51, 0x55, 0x55, 0x0d,
- 0xa9, 0xaa, 0xaa, 0x0e, 0x51, 0x55, 0x55, 0x0d, 0xa9, 0xaa, 0xaa, 0x0e,
- 0xfd, 0xff, 0xff, 0x0f, 0xff, 0xff, 0xff, 0x0f};
-
-#define sm_fm_width 18
-#define sm_fm_height 22
-static char sm_fm_bits[] = {
- 0xff, 0xff, 0x03, 0x01, 0x00, 0x02, 0x55, 0x55, 0x03, 0xb9, 0xba, 0x03,
- 0x7d, 0x7d, 0x03, 0xf9, 0xbe, 0x03, 0xfd, 0x7f, 0x03, 0xb9, 0xbb, 0x03,
- 0x7d, 0x7d, 0x03, 0xb9, 0xba, 0x03, 0x7d, 0x7d, 0x03, 0xb9, 0xba, 0x03,
- 0x7d, 0x7d, 0x03, 0xb9, 0xba, 0x03, 0x7d, 0x7d, 0x03, 0xb9, 0xba, 0x03,
- 0x7d, 0x7d, 0x03, 0xa9, 0xaa, 0x03, 0x55, 0x55, 0x03, 0xa9, 0xaa, 0x03,
- 0xff, 0xff, 0x03, 0xff, 0xff, 0x03};
-
-#define big_ps_width 28
-#define big_ps_height 38
-static big_char ps_bits[] = {
- 0xff, 0xff, 0xff, 0x0f, 0x01, 0x00, 0x00, 0x08, 0x01, 0x00, 0x00, 0x0c,
- 0xa9, 0xaa, 0xaa, 0x0e, 0x51, 0x55, 0x55, 0x0d, 0xf9, 0xff, 0xaa, 0x0e,
- 0xf1, 0xff, 0x55, 0x0d, 0xf9, 0xff, 0xab, 0x0e, 0xf1, 0xff, 0x57, 0x0d,
- 0xf9, 0xff, 0xaf, 0x0e, 0xf1, 0xd7, 0x5f, 0x0d, 0xf9, 0xab, 0xaf, 0x0e,
- 0xf1, 0xd7, 0x5f, 0x0d, 0xf9, 0xab, 0xaf, 0x0e, 0xf1, 0xd7, 0x5f, 0x0d,
- 0xf9, 0xab, 0xaf, 0x0e, 0xf1, 0xd7, 0x5f, 0x0d, 0xf9, 0xff, 0xaf, 0x0e,
- 0xf1, 0xff, 0x57, 0x0d, 0xf9, 0xff, 0xab, 0x0e, 0xf1, 0xff, 0x55, 0x0d,
- 0xf9, 0xab, 0xbe, 0x0e, 0xf1, 0x57, 0x7f, 0x0d, 0xf9, 0xab, 0xff, 0x0e,
- 0xf1, 0x57, 0x77, 0x0d, 0xf9, 0xab, 0xaf, 0x0e, 0xf1, 0x57, 0x5f, 0x0d,
- 0xf9, 0xab, 0xbe, 0x0e, 0xf1, 0x57, 0x7d, 0x0d, 0xf9, 0xab, 0xeb, 0x0e,
- 0xf1, 0x57, 0x77, 0x0d, 0xf9, 0xaf, 0xff, 0x0e, 0xf9, 0x57, 0x7f, 0x0d,
- 0xa9, 0xaa, 0xaa, 0x0e, 0x51, 0x55, 0x55, 0x0d, 0xa9, 0xaa, 0xaa, 0x0e,
- 0xfd, 0xff, 0xff, 0x0f, 0xff, 0xff, 0xff, 0x0f};
-
-#define sm_ps_width 18
-#define sm_ps_height 22
-static char sm_ps_bits[] = {
- 0xff, 0xff, 0x03, 0x01, 0x00, 0x02, 0x55, 0x55, 0x03, 0xf9, 0xab, 0x03,
- 0xfd, 0x57, 0x03, 0xb9, 0xae, 0x03, 0x7d, 0x5d, 0x03, 0xb9, 0xae, 0x03,
- 0x7d, 0x5d, 0x03, 0xb9, 0xae, 0x03, 0xfd, 0x57, 0x03, 0xf9, 0xab, 0x03,
- 0x7d, 0x55, 0x03, 0xb9, 0xbe, 0x03, 0x7d, 0x65, 0x03, 0xb9, 0x8e, 0x03,
- 0x7d, 0x7d, 0x03, 0xfd, 0xaa, 0x03, 0xfd, 0x65, 0x03, 0xa9, 0xbe, 0x03,
- 0x55, 0x55, 0x03, 0xff, 0xff, 0x03};
-
-#define big_fx_width 30
-#define big_fx_height 30
-static char big_fx_bits[] = {
- 0xff, 0xff, 0xff, 0x3f, 0x01, 0x00, 0x00, 0x20, 0x01, 0x00, 0x00, 0x30,
- 0xa9, 0xaa, 0xaa, 0x3a, 0x51, 0x55, 0x55, 0x3d, 0xa9, 0xaa, 0xaa, 0x3a,
- 0x51, 0x55, 0x56, 0x31, 0xa9, 0x2a, 0xaa, 0x38, 0x51, 0x15, 0x56, 0x3c,
- 0xa9, 0x0a, 0x2a, 0x3e, 0x51, 0x05, 0x06, 0x3f, 0xa9, 0x02, 0x82, 0x3b,
- 0x51, 0x01, 0xc0, 0x3d, 0xa9, 0x00, 0xe0, 0x3a, 0x51, 0x00, 0x70, 0x3d,
- 0x29, 0x18, 0xb8, 0x3a, 0x11, 0x1c, 0x5c, 0x3d, 0x09, 0x1f, 0xae, 0x3a,
- 0xc5, 0x17, 0x57, 0x3d, 0xf3, 0x9a, 0xab, 0x3a, 0x7f, 0xd5, 0x55, 0x3d,
- 0xaf, 0xfa, 0xaa, 0x3a, 0x51, 0x75, 0x55, 0x3d, 0xa9, 0xba, 0xaa, 0x3a,
- 0x51, 0x55, 0x55, 0x3d, 0xa9, 0xaa, 0xaa, 0x3a, 0x51, 0x55, 0x55, 0x3d,
- 0xf9, 0xff, 0xff, 0x3f, 0xfd, 0xff, 0xff, 0x3f, 0xff, 0xff, 0xff, 0x3f};
-
-#define sm_fx_width 16
-#define sm_fx_height 16
-static char sm_fx_bits[] = {
- 0xff, 0xff, 0x01, 0x80, 0x01, 0xc0, 0xa9, 0xea, 0x51, 0xc5, 0x29, 0xe2,
- 0x11, 0xf0, 0x09, 0xf8, 0x01, 0xdc, 0x31, 0xee, 0x3f, 0xd7, 0xaf, 0xeb,
- 0xd1, 0xd5, 0xa9, 0xea, 0xfd, 0xff, 0xff, 0xff};
-
-#define big_fno_width 28
-#define big_fno_height 38
-static char big_fno_bits[] = {
- 0xff, 0xff, 0xff, 0x0f, 0x01, 0x00, 0x00, 0x08, 0x01, 0x00, 0x00, 0x08,
- 0x01, 0x00, 0x00, 0x08, 0x01, 0x00, 0x00, 0x08, 0xa1, 0x88, 0xa4, 0x08,
- 0xe1, 0xcc, 0xfe, 0x08, 0x01, 0x00, 0x00, 0x08, 0x41, 0xfd, 0x27, 0x08,
- 0x61, 0xfe, 0xef, 0x08, 0x01, 0xff, 0x1f, 0x08, 0x81, 0xff, 0x3f, 0x08,
- 0xc1, 0xff, 0x7f, 0x08, 0xc1, 0xff, 0x7f, 0x08, 0xc1, 0x0f, 0x7e, 0x08,
- 0xc1, 0x0f, 0x7e, 0x08, 0xc1, 0x0f, 0x7e, 0x08, 0x01, 0x00, 0x7f, 0x08,
- 0x01, 0xe0, 0x3f, 0x08, 0x01, 0xf0, 0x1f, 0x08, 0x01, 0xf0, 0x0f, 0x08,
- 0x01, 0xf0, 0x03, 0x08, 0x01, 0xf0, 0x01, 0x08, 0x01, 0xf0, 0x01, 0x08,
- 0x01, 0xf0, 0x01, 0x08, 0x01, 0xf0, 0x01, 0x08, 0x01, 0x00, 0x00, 0x08,
- 0x21, 0xf1, 0x95, 0x08, 0xe1, 0xf1, 0xf5, 0x08, 0x01, 0xf0, 0x01, 0x08,
- 0x41, 0xf4, 0x85, 0x08, 0xe1, 0xf6, 0x9d, 0x08, 0x01, 0x00, 0x00, 0x08,
- 0x01, 0x00, 0x00, 0x08, 0x01, 0x00, 0x00, 0x08, 0x01, 0x00, 0x00, 0x08,
- 0x01, 0x00, 0x00, 0x08, 0xff, 0xff, 0xff, 0x0f};
-
-#define sm_fno_width 18
-#define sm_fno_height 22
-static char sm_fno_bits[] = {
- 0xff, 0xff, 0x03, 0x01, 0x00, 0x02, 0x01, 0x00, 0x02, 0xd9, 0x76, 0x02,
- 0xe1, 0x1f, 0x02, 0xf9, 0x7f, 0x02, 0xf1, 0x3f, 0x02, 0xf9, 0x7f, 0x02,
- 0xf1, 0x3c, 0x02, 0x59, 0x7e, 0x02, 0x01, 0x1f, 0x02, 0xb9, 0x7f, 0x02,
- 0x81, 0x07, 0x02, 0xd9, 0x77, 0x02, 0x81, 0x07, 0x02, 0x59, 0x68, 0x02,
- 0x81, 0x07, 0x02, 0xe9, 0x07, 0x02, 0x81, 0x07, 0x02, 0x01, 0x00, 0x02,
- 0x01, 0x00, 0x02, 0xff, 0xff, 0x03};
-
-#define big_dirup_width 30
-#define big_dirup_height 23
-static char big_dirup_bits[] = {
- 0xff, 0xff, 0xff, 0x3f, 0x01, 0x00, 0x00, 0x20, 0xfd, 0x01, 0x00, 0x30,
- 0xfd, 0xaa, 0xaa, 0x3a, 0x7d, 0x55, 0x55, 0x35, 0xfd, 0xaa, 0xaa, 0x3a,
- 0xfd, 0x55, 0x15, 0x30, 0xed, 0xab, 0x0a, 0x30, 0xd5, 0x17, 0x40, 0x35,
- 0xa9, 0x0f, 0xa0, 0x3a, 0x51, 0x5f, 0x55, 0x35, 0xa9, 0xbe, 0xaa, 0x3a,
- 0x51, 0x5d, 0x55, 0x35, 0xa9, 0xaa, 0xaa, 0x3a, 0x51, 0x55, 0x55, 0x35,
- 0xa9, 0xaa, 0xaa, 0x3a, 0x51, 0x5f, 0x5f, 0x35, 0xa9, 0xae, 0xae, 0x3a,
- 0x51, 0x5f, 0x5f, 0x35, 0xa9, 0xaa, 0xaa, 0x3a, 0x51, 0x55, 0x55, 0x35,
- 0xfd, 0xff, 0xff, 0x3f, 0xff, 0xff, 0xff, 0x3f};
-
-#define sm_dirup_width 20
-#define sm_dirup_height 16
-static char sm_dirup_bits[] = {
- 0xff, 0xff, 0x0f, 0x01, 0x00, 0x08, 0xfd, 0x00, 0x0c, 0x7d, 0x55, 0x0d,
- 0xbd, 0xaa, 0x0e, 0x7d, 0x15, 0x0c, 0xed, 0x80, 0x0e, 0xd5, 0x55, 0x0d,
- 0xa9, 0xab, 0x0e, 0x51, 0x55, 0x0d, 0xa9, 0xaa, 0x0e, 0xd1, 0x5d, 0x0d,
- 0xa9, 0xaa, 0x0e, 0x51, 0x55, 0x0d, 0xfd, 0xff, 0x0f, 0xff, 0xff, 0x0f};
-
->Menu MOTIF
->Guidance
-Command and Help definitions specific to the OSF/Motif interface.
-
->Command MULTI_PANEL
->Parameters
-+
-TITL 'Title' C D= 'kuipPalette'
-GEOM 'Geometry (wxh+x+y)' C D='300x700+0+0'
->Guidance
-Define a kind of "palette of panels" where several panels can be grouped
-togeter into one new KUIP/Motif container widget. All panel definitions
-can remain the same.
-.
- MULTI_PANEL 'My Palette' '200x100+0+0'
-.
-will display a "multi_panel" widget with the given title and geometry.
-After that all panel definitions and executions will go into that widget.
-This can be done simply by executing the KUIP macro containing your
-panel definitions in the command line area, or, by selecting the
-"Add button" entry in the File" menu of the "multi_panel" widget.
-Then the user is requested the name of a KUIP macro which is automatically
-executed for him.
-.
-To finish a "multi-panel" setting one just have to type:
-.
- MULTI_PANEL end
-.
-This means that the following panel definitions and executions will be
-displayed as usual individual panels and will not go into the "palette"
-anymore.
-.
-To close a "palette" you can either use the appropriate button ("Close")
-in the "File" menu of the palette, or type the command:
-.
- MULTI_PANEL <title> close
-.
-This will close the palette which has been created with that <title>.
-(N.B. Defaults title is "kuipPalette", and if several palettes
-have been created with the same title all these palettes will be closed).
-.
-or:
-.
- MULTI_PANEL last close
-.
-This will close the "last palette" which corresponds to
-the last existing palette in the list.
-.
->Action kxpalet%C
-
->Menu PANEL_HELP
-
->Command CREATE
->Parameters
-BNAME 'Button label' C
-FNAME 'File name' C
->Guidance
-Get access to help corresponding to the button label in panels.
-The help information must be provided in the KUIP macro file
-which contain the panel description. For each button you want
-to provide some help you have to write in your KUIP macro
-something like:
-.
-application data my_button.hlp
- ... help info corresponding to "my_button" ...
-my_button.hlp
-MOTIF/PANEL_HELP my_button my_button.hlp
-.
-This defines some help information which corresponds to the
-button "my_button" inside a user-defined panel.
->Action kxphlpc%C
-
->Command LIST
->Parameters
->Guidance
-List all user defined help items for panels.
->Action kxphlpl%C
-
->Command DELETE
->Parameters
-+
-BNAME 'Button label' C
->Guidance
-Delete help item with the corresponding button label,
-or all user defined help items if no label is given.
->Action kxphlpd%C
-
->Command PRINT
->Parameters
-BNAME 'Button label' C
->Guidance
-Print (display in kxterm window) the user defined help corresponding
-to a button label inside a panel.
->Action kxphlpp%C
-
->Menu /MOTIF
-
->Command ICON
->Parameters
-INAME 'Icon name' C
-FNAME 'File name' C
->Guidance
-Define icon from a bitmap file.
->Action kxicon%C
-
->Help_item HELP_BROWSER
->Guidance
- *** KUIP/Motif Browser Interface ***
-.
-.
-The KUIP/Motif Browser interface is a general tool to display and
-manipulate a tree structure of objects which are defined either
-by KUIP itself (commands, files, macros, etc.) or by the
-application.
-.
-The "Clone" button at the bottom creates a new independent browser window.
-The "Close" button destroys the browser window. The Main Browser cannot
-be destroyed (only iconized).
-.
-.
-The middle part of the browser is divided into two windows:
-.
- 1) The left hand "FileList" or "browsable" window shows the list of
- all the currently connected browsables (defined with the ">Browse"
- directive in the CDF). The browsables "Commands", "Files" and "Macros"
- are built in KUIP itself. Each application can add to this
- list its own definitions for any kind of browsables (e.g. in Paw++:
- "Zebra", "Hbook", "Chains" and "PAWC"). Browsables can also be
- attached at run time by selecting the corresonding "Open" entry in
- the menu "File".
- Selecting one item/browsable in this window (with the left mouse button)
- displays the content of the browsable in the right hand window ("DirList"
- or "object" window).
- Pressing the right mouse button in this window shows a popup menu with
- all the possible actions which have been defined for this browsable.
- Note that the first entry of this menu is always "List": it displays the
- content of the browsable in the right hand window (this is automatically
- performed when the item is selected). The last entry is always "Help" and
- should give information concerning the selected browsable.
-.
- 2) The right hand "DirList" or "object" window shows the content of
- the currently selected browsable for the selected path (e.g. when you
- select the browsable "Macro", built in KUIP, you get all the KUIP
- macro files and sub-directories which are in the selected directory).
-.
- Objects are selected by clicking on them with the left mouse button.
- Pressing the right mouse button pops up a menu of possible operations
- depending on the object type.
-.
- An item in a popup menu is selected by pointing at the corresponding line
- and releasing the right mouse button.
- Double clicking with the left mouse button is equivalent to selecting
- the first menu item.
-.
- Each menu item executes a command sequence where the name of the
- selected object is filled into the appropriate place.
- By default the command is executed immediately whenever possible
- (the commands executed can be seen by selecting "Echo Commands"
- in the "Options" menu of the Executive Window). In case some mandatory
- parameters are missing a panel is displayed where the remaining
- arguments have to be filled in. The command is executed then by
- pressing the "OK" or "Execute" button in that panel (if it is not
- the last one in the sequence of commands bound to the menu item
- the application is blocked until the "OK" or "Cancel" button is pressed).
-.
- The immediate command execution can be inhibited by holding down the
- CTRL-key BEFORE pressing the right mouse button.
- Some popup menus also contain different menu item for immediate and
- delayed execution, e.g. "Execute" and "Execute..."
- for class "Commands".
-.
-.
-The top of the browser is a menu-bar with the following menus:
- File
- Open...
- Close...
- Applications can add these menu entries which give access
- to the commands that can be used to open or close a new
- browsable (e.g. in Paw++ there are the items "Open Hbook File..."
- and "Close Hbook File..." which interface to /HISTO/FILE and
- /FORTRAN/CLOSE).
- Exit
- Exit the application.
-.
- View
- Icons
- Display the objects using icons with labels below them.
- Small Icons
- Display the object using small icons and labels on the right
- of the icon.
- No Icons
- Display only the labels.
- Titles
- Display small icons and extended labels on the right of the icons.
- Select All
- Select all objects.
- Filter...
- Show only the objects that pass the filter (not yet implemented).
-.
- Options
- Raise Window
- Bring the different toplevel windows of the application to
- the top of the window stack.
- Command Argument Panel...
- Prompt the user for a command name. If the command is valid
- then the corresponding "command argument panel" with the list
- and description of all parameters will be displayed. If the
- command is ambiguous the user will be presented a list of all
- possible commands.
-.
- Commands
- This menu gives access to the complete tree of commands defined
- by KUIP and the application in the form of a pulldown menu. When
- a terminal item (command) in this menu is selected then the
- corresponding "command argument panel" is displayed. The
- functionality of this menu is quite similar to the browsable
- "Commands" (this is just a matter of taste whether the user prefers
- to access commands through this pulldown menu or through the
- "Commands" browser). This menu is a so called "tear off" menu. By
- selecting the dashed line menu item one obtains a permanent window
- which contains all menu items. This facilitates frequent access to
- the same menu.
-.
- Help
- On <application>
- Help on the application.
- On <application> Resources
- Help on the X/Motif, application specific, customizable resources.
- On KUIP Resources
- Help on the X/Motif, application independent, customizable
- resources.
- On Browser
- The help you are currently reading.
- On Panel
- Help on the KUIP/Motif panel interface (user definable panels
- of commands).
- On System Functions
- Help on the KUIP system functions.
-.
-.
-Below the menubar the path of the currently selected directory is displayed.
-The directory tree can be traversed upward by pointing in the desired part
-of the path and clicking the left mouse button. Clicking a second time on
-the same path segment performs the directory change and updates the object
-window. To go downwards in the directory hierarchy double click on a
-subdirectory displayed in the object window. To edit the directory path
-by hand, click the right mouse button and edit the path. Hit the return
-key to go to the new path.
-
-
->Command BROWSER
->Parameters
-BNAME 'Browsable name' C
-+
-PNAME 'Path name' C
->Guidance
-Open the corresponding browsable with the corresponding path (optional)
-and displays its content.
->Action kxbrset%C
-
->Help_item HELP_PANEL
->Guidance
- *** KUIP/Motif PANEL Interface ***
-.
-.
-The PANEL Interface allows to define command sequences which are
-executed when the corresponding button is pressed (like "STYLE GP"
-in PAW/X11).
-The command sequence
- PANEL 0
- PANEL 4.06 'some string'
- PANEL 0 D 'This is my first panel' 500x300+500+600
-creates a panel with 4 rows and 6 columns of buttons.
-The text 'some string' should be long enough to fit the longest command
-Sequence which should be put onto one of the buttons.
-The 'PANEL 0 D' command defines the title and the window size and coordinates
-in the form WxH+X+Y.
-.
-.
-The panels can be edited interactively:
-.
-- Clicking with the right mouse button on an empty panel button the
-user will be asked to give a definition to this button.
-.
-- Clicking with the left mouse button on a panel button removes its
-definition.
-.
-.
-The PANEL commands needed to recreate a panel can be saved into
-a macro file by pressing the "Save Panel" button.
-Panels can be reloaded either by executing the command 'PANEL 0 D'
-or by pressing the "Command Panel" button in the "View" menu
-of the Executive window and entering the corresponding file name.
-.
-
->Help_item HELP_EDIT_PANEL
->Guidance
- *** KUIP/Motif PANEL Interface (Editing and Saving) ***
-.
-.
-It is possible to edit interactively a panel writing a new label
-if the button is empty (and consequently to define the action
-which corresponds to that button).
-.
-.
-When clicking with <mouse button 1> on an empty button
-users will be asked to give some
-text to write into that button. To change the label (and behavior)
-of an already defined button, one just
-has to erase firstly this button by clicking with <mouse button
-3> on it. It is then possible to edit again the button by clicking
-on it with <mouse button 1>.
-.
-.
-It is possible to save this new panel configuration with its
-current size and position (which can also be modified interacti-
-vely) into a new (or the same) macro file, by clicking on the
-button "Save Panel". You will be prompted for the name to be
-given to this file.
-.
-
->Help_item HELP_SAVE_PANEL
->Guidance
- *** KUIP/Motif PANEL Interface (Save Panel) ***
-.
-.
-When users are pleased with the actual configuration of a panel
-(size, position and components) it is possible to save it in a
-KUIP macro file for later (re)use. You just have to give a name
-to this macro and press <OK>. To display this panel afterwards
-you just have to select the macro class in the "class window" and
-double-click on the desired macro.
-.
-
->Help_item HELP_DOLLAR_PANEL
->Guidance
- *** KUIP/Motif PANEL Interface ***
- (dollar sign inside a key)
-.
-.
-The dollar sign inside a key is replaced by additional keyboard
-input.
-Example:
-.
-'VEC/PRI V($)' | entering 11:20 will execute VEC/PRI V(11:20)
-.
-
->Help_item HELP_MINUS_PANEL
->Guidance
- *** KUIP/Motif PANEL Interface ***
- (key ending with a minus sign)
-.
-.
-Keys ending with a minus sign make an additional request of
-keyboard input.
-Example:
-.
-'VEC/PRI-' | entering VAB will execute VEC/PRI VAB.
-.
-
->Help_item HELP_MINUS2_PANEL
->Guidance
- *** KUIP/Motif PANEL Interface ***
- (key ending with a double minus sign)
-.
-.
-Keys ending with a double minus sign make an additional request
-of keyboard input.
-Example:
-.
-VEC/PRI V--' | entering AB will execute VEC/PRI VAB
-.
-
->Help_item HELP_Commands
->Guidance
- *** Class "Commands" ***
-.
-.
-The class "Commands" allows to browse the command tree defined
-for the application and execute them.
-.
-There are three types of objects:
-.
-- Menus are directories containing other sub-menus or terminal commands.
-.
-- Executable commands
-.
-- Non-executable commands (see SET/VISIBILITY)
-
->Help_item HELP_Files
->Guidance
- *** Class "Files" ***
-.
-.
-The class "Files" allows to browse the file system and
-execute or edit files.
-
->Help_item HELP_Macro
->Guidance
- *** Class "Macro" ***
-.
-.
-The class "Macro" allows to browse the file system for KUIP macro
-files with extension ".kumac" and execute or edit them.
-
->Help_item HELP_GET_COMMAND_PANEL
->Guidance
- *** Command Argument Panel ***
-.
-.
-It is possible to retrieve a "command argument panel"
-just by giving the name of a valid command, and pressing
-<OK>, instead of browsing the whole command tree
-structure in menu "Commands" of the Main Browser.
-.
-.
-If users give a command which is ambiguous a
-list of possible commands is displayed and
-users can select the desired one with a single
-click in the list. The command panel will be
-displayed by pressing <OK>.
-
-
->Help_item HELP_RESOURCES
->Guidance
- *** X Resources for KUIP/Motif ***
-.
-.
-This is a list of the X resources available
-to any KUIP/Motif based application (e.g. Paw++).
-Resources control the appearance and behavior of
-an application.
-.
-Users can specify their own values for
-these resources in the standard X/Motif way
-(via the .Xdefaults file or a file in the
-/usr/lib/X11/app-defaults directory). One just
-has to prefix the desired resource by the class
-name of the application.
-.
-To customize Paw++, for instance, all the
-resources have to be prefixed with "Paw++" or
-they should be stored in the file
-/usr/lib/X11/app-defaults/Paw++.
-.
-Any default values specified by KUIP are given
-behind the resource name.
-.
-.
-.
- *background:
-.
-Specify the background color for all windows.
-.
- *foreground:
-.
-Specify the foreground color for all windows.
-.
- *kxtermGeometry: 650x450+0+0
-.
-Geometry of Kxterm, the kuip terminal emulator (executive window).
-.
- *kuipGraphics_shell.geometry: 600x600-0+0
-.
-Geometry of the graphics window(s) (if any).
-.
- *kuipBrowser_shell.geometry: +0+485
-.
-Geometry of the browser(s).
-.
- *fontList: *-helvetica-bold-r-normal*-120-*
-.
-Font used by all text areas.
-.
- *kxtermTextFont: *-courier-medium-r-normal*-120-*
-.
-Font used in the text areas of Kxterm.
-.
- *kxtermFont: *-helvetica-bold-r-normal*-120-*
-.
-Font used by Kxterm.
-.
- *dirlist*fontList: *-courier-bold-r-normal*-120-*
-.
-Font used for the icon labels in the browser.
-.
- *helpFont: *-courier-bold-r-normal*-120-*
-.
-Font used for help windows.
-.
- *fontList: *-helvetica-bold-r-normal*-120-*
-.
-Font for the menus, messages and boxes.
-.
- *keyboardFocusPolicy: explicit
-.
-If "explicit" (default), focus is determined by a mouse or keyboard
-command. If "pointer", focus is determined by the mouse pointer
-position.
-.
- *doubleClickInterval: 250
-.
-The time span (in milliseconds) within which two button clicks
-must occur to be considered a double click rather than two single
-clicks.
-.
- *dirlist*background:
-.
-Specify the background color for the iconbox part of the browser.
-.
- *dirlist*<object>*iconForeground: black
-.
-Specify the foreground color for the icons of type <object>.
-.
- *dirlist*<object>*iconBackground: white
-.
-Specify the background color for the icons of type <object>.
-.
- *dirlist*<object>*iconLabelForeground: white
-.
-Specify the foreground color for the labels of the icons of type <object>.
-.
- *dirlist*<object>*iconLabelBackground: black
-.
-Specify the background color for the labels of the icons of type <object>.
-.
- *zoomEffect: True
-.
-Turn zoom effect on or off when going up and down directories in
-the browser.
-.
- *zoomSpeed: 10
-.
-Specify speed of zoom effect in the browser.
-.
-Currently the following different <object>'s are defined:
-.
- Cmd -- Command
- InvCmd -- Deactivated command
- Menu -- Menu tree
- MacFile -- Macro File
- RwFile -- Read-write file
- RoFile -- Readonly file
- NoFile -- No access file
- ExFile -- Executable file
- PSFile -- PostScript file
- EPSFile -- Encapsulated PostScript file
- DirFile -- Directory
- DirUpFile -- Up directory (..)
-.
-When using a black and white X Server use the following resource
-settings to make the icons visible:
-.
- *dirlist*<object>*iconForeground: black
- *dirlist*<object>*iconBackground: white
- *dirlist*<object>*iconLabelForeground: black
- *dirlist*<object>*iconLabelBackground: white
-
-Various resource concerning the application appearance / behaviour:
-.
- *scrolledCmdPanel: auto (default)
- never
- always
-Control wether the input parameters of command panels are put in a scrolled
-window or not. "auto" (for automatic behaviour) means that it is true only
-when the number of parameters exceeds 10 (otherwise parameters are in a
-fixed-size area). "never" means that the input parameters area is always a
-fixed-size and "always" that the input parameters area is always a
-scrolled-window. The advantage of one of these possibilities depends
-essentially on the font size, and the consecutive window size for
-the automaticly generated command panels.
-
-
diff --git a/src/packlib/kuip/code_motif/kuwham.c b/src/packlib/kuip/code_motif/kuwham.c
deleted file mode 100644
index 8943284..0000000
--- a/src/packlib/kuip/code_motif/kuwham.c
+++ /dev/null
@@ -1,132 +0,0 @@
-/*
- * $Id: kuwham.c,v 1.1.1.1 1996/03/08 15:33:07 mclareni Exp $
- *
- * $Log: kuwham.c,v $
- * Revision 1.1.1.1 1996/03/08 15:33:07 mclareni
- * Kuip
- *
- */
-/*CMZ : 2.07/03 09/05/95 12.02.21 by N.Cremel*/
-/*-- Author : Alfred Nathaniel 25/08/92*/
-
-#include "kuip/kuip.h"
-#include "kuip/kfor.h"
-#include "kuip/kcom.h"
-#include "kuip/ksig.h"
-#include "kuip/kmenu.h"
-#include "kuip/kflag.h"
-#include "kuip/klink.h"
-
-#include "kuip/mkutfu.h"
-
-extern C_PROTO_1(void km_create_windows, char*);
-extern C_PROTO_0(int km_enter_loop);
-extern C_PROTO_0(void km_realize_windows);
-extern C_PROTO_3(void update_browser, void *, int, char);
-extern int km_destroy_all_popup();
-extern int km_display_cmdpan();
-extern int km_display_kpanel();
-extern int km_close_kpanel();
-extern int km_panel_add();
-extern int km_exit_confirm();
-extern int km_quit_confirm();
-extern int km_FlushEvents();
-extern int km_all_cursor();
-extern int km_display_sctext();
-extern int km_cmd_list();
-extern int km_display_list();
-extern int km_kmenu_OK();
-
-int Error; /* want by libPW.a routines */
-
-static int init = 0;
-
-
-static
-void init_motif( name )
- char *name;
-{
- kc_flags.do_exit = 0;
- kc_flags.do_quit = 0;
- kc_flags.in_motif = 1;
- kc_flags.echo_command = 0;
- kc_break.intr_count = 0;
- kc_flags.echo_prompt = str0dup( name );
- kc_flags.style = KmSTYLE_XM;
- ku_exel( "/KUIP/HELP -NOEDIT" ); /* display helptexts in Motif windows */
- ku_exel( "/KUIP/SET_SHOW/HOST_EDITOR 'xterm -e view &'" );
- ku_exel( "/KUIP/SET_SHOW/HOST_PAGER more");
-
- /* set Motif specific functions */
- kjmpaddr.disp_panel_C = km_display_cmdpan;
- kjmpaddr.disp_kpanel_C = km_display_kpanel;
- kjmpaddr.close_kpanel_C = km_close_kpanel;
- kjmpaddr.disp_kmpanel_C = km_panel_add;
- kjmpaddr.disp_text_C = km_display_sctext;
- kjmpaddr.disp_choice_C = km_display_sctext; /* !!! */
- kjmpaddr.disp_clean_C = km_destroy_all_popup;
-/* kjmpaddr.disp_flush_C = km_FlushEvents; */
- kjmpaddr.disp_busy_C = km_all_cursor;
- kjmpaddr.disp_exit_C = km_exit_confirm;
- kjmpaddr.disp_quit_C = km_quit_confirm;
- kjmpaddr.disp_prompt_C = km_prompt_answer;
- kjmpaddr.disp_passwd_C = km_passwd_prompt;
- kjmpaddr.disp_select_C = km_select;
- kjmpaddr.disp_cmd_list_C = km_cmd_list;
- kjmpaddr.disp_list_C = km_display_list;
- kjmpaddr.callb_kmenu = km_kmenu_OK;
-
- km_create_windows( name ); /* create the application windows */
- if( name != NULL )
- free( name );
- km_realize_windows();
-
- init = 1;
-}
-
-
-void F77_ENTRY_C(Kuwham,chname)
-/* { */
- if( !init ) {
- char *name = fstr0dup( chname, len_chname );
- init_motif( name );
- }
-
- /* turn echo mode on only after initialization is finished */
- kc_flags.echo_command = 1;
-
- if (kc_flags.use_kxterm) {
- printf("\2");
- fflush( stdout );
- }
-
- /* update the main browser, files may have been opened via pawlogon */
- update_browser(NULL, 0, 0);
-
- /* catch exceptions saving signal mask */
- if( sigsetjmp( kc_break.stack, 1 ) != 0 ) { /* saving signal mask */
- /* longjmp happened */
- reset_break();
- }
-
- kc_break.jump_set = 1;
- ku_trap( 1, -1 );
-
- while( !kc_flags.do_exit && !kc_flags.do_quit ) {
- if( km_enter_loop() != 1 ) /* only returns for VMS exceptions */
- reset_break();
- }
-
- kc_break.jump_set = 0;
- ku_trap( 0, -1 );
- ku_shut();
-}
-
-
-void F77_ENTRY_C(Kuinim,chname)
-/* { */
- char *name = fstr0dup( chname, len_chname );
- init_motif( name );
-}
-
-
diff --git a/src/packlib/kuip/code_motif/kuxbro.c b/src/packlib/kuip/code_motif/kuxbro.c
deleted file mode 100644
index 34fb3ef..0000000
--- a/src/packlib/kuip/code_motif/kuxbro.c
+++ /dev/null
@@ -1,657 +0,0 @@
-/*
- * $Id: kuxbro.c,v 1.1.1.1 1996/03/08 15:33:10 mclareni Exp $
- *
- * $Log: kuxbro.c,v $
- * Revision 1.1.1.1 1996/03/08 15:33:10 mclareni
- * Kuip
- *
- */
-/*CMZ : 2.05/01 05/04/94 17.59.01 by N.Cremel*/
-/*-- Author :*/
-/*
- * kuipBrowser.c
- * This file has to be slightly modified by hand to add:
- * - +SEQ,KUIP_H
- * - menu entry "All Cycles" in "View" pulldown menu for VMS
- */
-
-#include "kuip/kuip.h"
-
-/*******************************************************************************
- kuipBrowser.c
-
- Associated Header file: kuipBrowser.h
-*******************************************************************************/
-
-#include <stdio.h>
-#include <Xm/Xm.h>
-#include <Xm/MwmUtil.h>
-#include <X11/Shell.h>
-#include <Xm/MenuShell.h>
-/* #include "UxXt.h" */
-#include "mkuxxt.h"
-
-#include <Xm/CascadeB.h>
-#include <Xm/PushBG.h>
-#include <Xm/ToggleBG.h>
-#include <Xm/RowColumn.h>
-#include <Xm/Label.h>
-#include <Xm/Text.h>
-#include <Xm/LabelG.h>
-#include <Xm/PushB.h>
-#include <Xm/SeparatoG.h>
-#include <Xm/List.h>
-#include <Xm/ScrolledW.h>
-#include <Xm/Form.h>
-#include <Xm/Frame.h>
-#include <Xm/MainW.h>
-
-
-
-/*******************************************************************************
- The following header file defines the context structure.
-*******************************************************************************/
-
-#define CONTEXT_MACRO_ACCESS 1
-/* #include "kuipBrowser.h" */
-#include "mkuxbr.h"
-#undef CONTEXT_MACRO_ACCESS
-
-
-/*******************************************************************************
- The following are callback functions.
-*******************************************************************************/
-
-/*******************************************************************************
- The 'build_' function creates all the widgets
- using the resource values specified in the Property Editor.
-*******************************************************************************/
-
-static Widget _Uxbuild_kuipBrowser()
-{
- Widget _UxParent;
- Widget FilePdMenu_shell;
- Widget ViewPdMenu_shell;
- Widget HelpPdMenu_shell;
-
-
- /* Creation of kuipBrowser */
- _UxParent = XtVaCreatePopupShell( "kuipBrowser_shell",
- topLevelShellWidgetClass, UxTopLevel,
- XmNx, 540,
- XmNy, 80,
- XmNwidth, 580,
- XmNheight, 450,
- XmNtitle, "kuipBrowser",
- XmNiconName, "kuipBrowser",
- NULL );
-
- kuipBrowser = XtVaCreateManagedWidget( "kuipBrowser",
- xmMainWindowWidgetClass,
- _UxParent,
- XmNwidth, 580,
- XmNheight, 450,
- XmNmappedWhenManaged, TRUE,
- NULL );
- UxPutContext( kuipBrowser, (char *) UxKuipBrowserContext );
-
-
- /* Creation of kuipBrowserFrame */
- kuipBrowserFrame = XtVaCreateManagedWidget( "kuipBrowserFrame",
- xmFrameWidgetClass,
- kuipBrowser,
- NULL );
- UxPutContext( kuipBrowserFrame, (char *) UxKuipBrowserContext );
-
-
- /* Creation of browserForm */
- browserForm = XtVaCreateManagedWidget( "browserForm",
- xmFormWidgetClass,
- kuipBrowserFrame,
- XmNwidth, 530,
- XmNautoUnmanage, FALSE,
- NULL );
- UxPutContext( browserForm, (char *) UxKuipBrowserContext );
-
-
- /* Creation of fileScWindow */
- fileScWindow = XtVaCreateManagedWidget( "fileScWindow",
- xmScrolledWindowWidgetClass,
- browserForm,
- XmNx, 29,
- XmNy, 29,
- XmNshadowThickness, 0,
- XmNscrollBarDisplayPolicy, XmSTATIC,
- XmNscrollingPolicy, XmAPPLICATION_DEFINED,
- XmNvisualPolicy, XmVARIABLE,
- XmNbottomAttachment, XmATTACH_FORM,
- /* XmNbottomOffset, 52, */
- XmNleftAttachment, XmATTACH_FORM,
- XmNleftOffset, 5,
- XmNrightAttachment, XmATTACH_NONE,
- XmNtopAttachment, XmATTACH_FORM,
- /* XmNtopOffset, 59, */
- NULL );
- UxPutContext( fileScWindow, (char *) UxKuipBrowserContext );
-
-
- /* Creation of fileList */
- fileList = XtVaCreateManagedWidget( "fileList",
- xmListWidgetClass,
- fileScWindow,
- XmNwidth, 140,
- XmNheight, 210,
- XmNautomaticSelection, TRUE,
- XmNselectionPolicy, XmBROWSE_SELECT,
- XmNvisibleItemCount, 50,
- XmNlistSizePolicy, XmCONSTANT,
- NULL );
- UxPutContext( fileList, (char *) UxKuipBrowserContext );
-
-
- /* Creation of dirScWindow */
- dirScWindow = XtVaCreateManagedWidget( "dirScWindow",
- xmScrolledWindowWidgetClass,
- browserForm,
- XmNshadowThickness, 2,
- XmNbottomAttachment, XmATTACH_FORM,
- /* XmNbottomOffset, 52, */
- XmNleftAttachment, XmATTACH_WIDGET,
- XmNleftOffset, 5,
- XmNleftWidget, fileScWindow,
- XmNrightAttachment, XmATTACH_FORM,
- XmNrightOffset, 5,
- XmNtopAttachment, XmATTACH_FORM,
- /* XmNtopOffset, 59, */
- XmNwidth, 460,
- XmNheight, 333,
- XmNy, 30,
- NULL );
- UxPutContext( dirScWindow, (char *) UxKuipBrowserContext );
-
-
- /* Creation of topSeparator1 */
- topSeparator1 = XtVaCreateManagedWidget( "topSeparator1",
- xmSeparatorGadgetClass,
- browserForm,
- XmNbottomAttachment, XmATTACH_WIDGET,
- XmNbottomOffset, 5,
- XmNbottomWidget, fileScWindow,
- XmNleftAttachment, XmATTACH_FORM,
- XmNleftOffset, -5,
- XmNrightAttachment, XmATTACH_FORM,
- XmNrightOffset, -5,
- XmNwidth, 583,
- XmNx, 0,
- NULL );
- UxPutContext( topSeparator1, (char *) UxKuipBrowserContext );
-
-
- /* Creation of bottomSeparator1 */
- bottomSeparator1 = XtVaCreateManagedWidget( "bottomSeparator1",
- xmSeparatorGadgetClass,
- browserForm,
- XmNleftAttachment, XmATTACH_FORM,
- XmNleftOffset, -5,
- XmNrightAttachment, XmATTACH_FORM,
- XmNrightOffset, -5,
- XmNtopAttachment, XmATTACH_WIDGET,
- XmNtopOffset, 5,
- XmNtopWidget, fileScWindow,
- NULL );
- UxPutContext( bottomSeparator1, (char *) UxKuipBrowserContext );
-
-
- /* Creation of closeButton */
- closeButton = XtVaCreateManagedWidget( "closeButton",
- xmPushButtonWidgetClass,
- browserForm,
- XmNx, 529,
- XmNy, 349,
- XmNheight, 30,
- RES_CONVERT( XmNlabelString, " Close " ),
- XmNbottomAttachment, XmATTACH_FORM,
- XmNbottomOffset, 5,
- XmNrightAttachment, XmATTACH_FORM,
- XmNrightOffset, 5,
- NULL );
- UxPutContext( closeButton, (char *) UxKuipBrowserContext );
-
-
- /* Creation of cloneButton */
- cloneButton = XtVaCreateManagedWidget( "cloneButton",
- xmPushButtonWidgetClass,
- browserForm,
- XmNx, 489,
- XmNy, 349,
- XmNheight, 30,
- RES_CONVERT( XmNlabelString, " Clone " ),
- XmNbottomAttachment, XmATTACH_FORM,
- XmNbottomOffset, 5,
- XmNrightAttachment, XmATTACH_WIDGET,
- XmNrightOffset, 5,
- XmNrightWidget, closeButton,
- NULL );
- UxPutContext( cloneButton, (char *) UxKuipBrowserContext );
-
-
- /* Creation of form1 */
- form1 = XtVaCreateManagedWidget( "form1",
- xmFormWidgetClass,
- browserForm,
- XmNresizePolicy, XmRESIZE_NONE,
- XmNx, 25,
- XmNy, 0,
- XmNwidth, 60,
- XmNheight, 10,
- XmNbottomAttachment, XmATTACH_WIDGET,
- XmNbottomWidget, topSeparator1,
- XmNleftAttachment, XmATTACH_FORM,
- XmNleftOffset, 0,
- XmNrightAttachment, XmATTACH_FORM,
- XmNrightOffset, 0,
- XmNtopAttachment, XmATTACH_FORM,
- XmNtopOffset, 0,
- NULL );
- UxPutContext( form1, (char *) UxKuipBrowserContext );
-
-
- /* Creation of separatorGadget1 */
- separatorGadget1 = XtVaCreateManagedWidget( "separatorGadget1",
- xmSeparatorGadgetClass,
- form1,
- XmNleftAttachment, XmATTACH_FORM,
- XmNleftOffset, 0,
- XmNrightAttachment, XmATTACH_FORM,
- XmNrightOffset, 0,
- XmNtopAttachment, XmATTACH_POSITION,
- /* XmNtopPosition, 50, */
- NULL );
- UxPutContext( separatorGadget1, (char *) UxKuipBrowserContext );
-
-
- /* Creation of form2 */
- form2 = XtVaCreateManagedWidget( "form2",
- xmFormWidgetClass,
- form1,
- XmNresizePolicy, XmRESIZE_NONE,
- XmNleftAttachment, XmATTACH_FORM,
- XmNleftOffset, 0,
- XmNrightAttachment, XmATTACH_FORM,
- XmNrightOffset, 0,
- XmNtopAttachment, XmATTACH_FORM,
- XmNtopOffset, 0,
- XmNheight, 25,
- XmNbottomAttachment, XmATTACH_WIDGET,
- XmNbottomWidget, separatorGadget1,
- NULL );
- UxPutContext( form2, (char *) UxKuipBrowserContext );
-
-
- /* Creation of pathLabel */
- pathLabel = XtVaCreateManagedWidget( "pathLabel",
- xmLabelGadgetClass,
- form2,
- XmNalignment, XmALIGNMENT_BEGINNING,
- RES_CONVERT( XmNlabelString, "Path: " ),
- XmNbottomAttachment, XmATTACH_FORM,
- XmNbottomOffset, 0,
- XmNleftAttachment, XmATTACH_FORM,
- XmNleftOffset, 5,
- XmNtopAttachment, XmATTACH_FORM,
- XmNtopOffset, 0,
- NULL );
- UxPutContext( pathLabel, (char *) UxKuipBrowserContext );
-
-
- /* Creation of pathText */
- pathText = XtVaCreateManagedWidget( "pathText",
- xmTextWidgetClass,
- form2,
- XmNhighlightThickness, 0,
- XmNshadowThickness, 0,
- XmNeditable, FALSE,
- RES_CONVERT( XmNselectionArray, "select_position" ),
- XmNselectionArrayCount, 1,
- XmNblinkRate, 0,
- XmNcursorPositionVisible, FALSE,
- XmNbottomAttachment, XmATTACH_FORM,
- XmNbottomOffset, 0,
- XmNleftAttachment, XmATTACH_WIDGET,
- XmNleftOffset, 5,
- XmNleftWidget, pathLabel,
- XmNrightAttachment, XmATTACH_FORM,
- XmNrightOffset, 5,
- XmNtopAttachment, XmATTACH_FORM,
- XmNtopOffset, 0,
- NULL );
- UxPutContext( pathText, (char *) UxKuipBrowserContext );
-
-
- /* Creation of form3 */
- form3 = XtVaCreateManagedWidget( "form3",
- xmFormWidgetClass,
- form1,
- XmNresizePolicy, XmRESIZE_NONE,
- XmNx, 0,
- XmNy, 30,
- XmNwidth, 70,
- XmNheight, 20,
- XmNbottomAttachment, XmATTACH_FORM,
- XmNbottomOffset, 0,
- XmNleftAttachment, XmATTACH_FORM,
- XmNleftOffset, 0,
- XmNrightAttachment, XmATTACH_FORM,
- XmNrightOffset, 0,
- XmNtopAttachment, XmATTACH_WIDGET,
- XmNtopOffset, 0,
- XmNtopWidget, separatorGadget1,
- NULL );
- UxPutContext( form3, (char *) UxKuipBrowserContext );
-
-
- /* Creation of counterLabel */
- counterLabel = XtVaCreateManagedWidget( "counterLabel",
- xmLabelWidgetClass,
- form3,
- XmNalignment, XmALIGNMENT_END,
- RES_CONVERT( XmNlabelString, "" ),
- XmNbottomAttachment, XmATTACH_FORM,
- XmNbottomOffset, 0,
- XmNleftAttachment, XmATTACH_FORM,
- XmNleftOffset, 5,
- XmNrightAttachment, XmATTACH_FORM,
- XmNrightOffset, 5,
- XmNtopAttachment, XmATTACH_FORM,
- XmNtopOffset, 0,
- NULL );
- UxPutContext( counterLabel, (char *) UxKuipBrowserContext );
-
-
- /* Creation of form4 */
- form4 = XtVaCreateManagedWidget( "form4",
- xmFormWidgetClass,
- browserForm,
- XmNresizePolicy, XmRESIZE_NONE,
- XmNbottomAttachment, XmATTACH_FORM,
- XmNbottomOffset, 0,
- XmNleftAttachment, XmATTACH_FORM,
- XmNleftOffset, 0,
- XmNrightAttachment, XmATTACH_WIDGET,
- XmNrightOffset, 0,
- XmNrightWidget, cloneButton,
- XmNtopAttachment, XmATTACH_WIDGET,
- XmNtopOffset, 0,
- XmNtopWidget, bottomSeparator1,
- NULL );
- UxPutContext( form4, (char *) UxKuipBrowserContext );
-
-
- /* Creation of dirNameLabel */
- dirNameLabel = XtVaCreateManagedWidget( "dirNameLabel",
- xmLabelWidgetClass,
- form4,
- XmNalignment, XmALIGNMENT_BEGINNING,
- RES_CONVERT( XmNlabelString, "" ),
- XmNbottomAttachment, XmATTACH_FORM,
- XmNbottomOffset, 2,
- XmNleftAttachment, XmATTACH_FORM,
- XmNleftOffset, 5,
- XmNrightAttachment, XmATTACH_FORM,
- XmNrightOffset, 5,
- XmNheight, 20,
- NULL );
- UxPutContext( dirNameLabel, (char *) UxKuipBrowserContext );
-
-
- /* Creation of fileNameLabel */
- fileNameLabel = XtVaCreateManagedWidget( "fileNameLabel",
- xmLabelWidgetClass,
- form4,
- XmNheight, 20,
- XmNalignment, XmALIGNMENT_BEGINNING,
- RES_CONVERT( XmNlabelString, "" ),
- XmNleftAttachment, XmATTACH_FORM,
- XmNleftOffset, 5,
- XmNrightAttachment, XmATTACH_FORM,
- XmNrightOffset, 5,
- XmNbottomAttachment, XmATTACH_WIDGET,
- XmNbottomWidget, dirNameLabel,
- NULL );
- UxPutContext( fileNameLabel, (char *) UxKuipBrowserContext );
-
-
- /* Creation of browserMenu */
- browserMenu = XtVaCreateManagedWidget( "browserMenu",
- xmRowColumnWidgetClass,
- kuipBrowser,
- XmNrowColumnType, XmMENU_BAR,
- XmNmenuAccelerator, "<KeyUp>F10",
- NULL );
- UxPutContext( browserMenu, (char *) UxKuipBrowserContext );
-
-
- /* Creation of FilePdMenu */
- FilePdMenu_shell = XtVaCreatePopupShell ("FilePdMenu_shell",
- xmMenuShellWidgetClass, browserMenu,
- XmNwidth, 1,
- XmNheight, 1,
- XmNallowShellResize, TRUE,
- XmNoverrideRedirect, TRUE,
- NULL );
-
- FilePdMenu = XtVaCreateWidget( "FilePdMenu",
- xmRowColumnWidgetClass,
- FilePdMenu_shell,
- XmNrowColumnType, XmMENU_PULLDOWN,
- NULL );
- UxPutContext( FilePdMenu, (char *) UxKuipBrowserContext );
-
-
- /* Creation of FileMenu */
- FileMenu = XtVaCreateManagedWidget( "FileMenu",
- xmCascadeButtonWidgetClass,
- browserMenu,
- RES_CONVERT( XmNlabelString, "File" ),
- RES_CONVERT( XmNmnemonic, "F" ),
- XmNsubMenuId, FilePdMenu,
- NULL );
- UxPutContext( FileMenu, (char *) UxKuipBrowserContext );
-
-
- /* Creation of ViewPdMenu */
- ViewPdMenu_shell = XtVaCreatePopupShell ("ViewPdMenu_shell",
- xmMenuShellWidgetClass, browserMenu,
- XmNwidth, 1,
- XmNheight, 1,
- XmNallowShellResize, TRUE,
- XmNoverrideRedirect, TRUE,
- NULL );
-
- ViewPdMenu = XtVaCreateWidget( "ViewPdMenu",
- xmRowColumnWidgetClass,
- ViewPdMenu_shell,
- XmNradioBehavior, FALSE,
- XmNrowColumnType, XmMENU_PULLDOWN,
- NULL );
- UxPutContext( ViewPdMenu, (char *) UxKuipBrowserContext );
-
-
-#ifdef ALL_CYCLE /* vms */
- /* Creation of ViewPdMenu_allcycle */
- ViewPdMenu_allcycle = XtVaCreateManagedWidget( "ViewPdMenu_allcycle",
- xmToggleButtonGadgetClass,
- ViewPdMenu,
- RES_CONVERT( XmNlabelString, "All Cycle" ),
- XmNset, FALSE,
- NULL );
- UxPutContext( ViewPdMenu_allcycle, (char *) UxKuipBrowserContext );
-
-
- /* Creation of menu1_p2_b4 */
- menu1_p2_b4 = XtVaCreateManagedWidget( "menu1_p2_b4",
- xmSeparatorGadgetClass,
- ViewPdMenu,
- NULL );
- UxPutContext( menu1_p2_b4, (char *) UxKuipBrowserContext );
-#endif
-
-
- /* Creation of ViewPdMenu_icon */
- ViewPdMenu_icon = XtVaCreateManagedWidget( "ViewPdMenu_icon",
- xmToggleButtonGadgetClass,
- ViewPdMenu,
- RES_CONVERT( XmNlabelString, "Icons" ),
- XmNset, TRUE,
- NULL );
- UxPutContext( ViewPdMenu_icon, (char *) UxKuipBrowserContext );
-
-
- /* Creation of ViewPdMenu_sicon */
- ViewPdMenu_sicon = XtVaCreateManagedWidget( "ViewPdMenu_sicon",
- xmToggleButtonGadgetClass,
- ViewPdMenu,
- RES_CONVERT( XmNlabelString, "Small Icons" ),
- NULL );
- UxPutContext( ViewPdMenu_sicon, (char *) UxKuipBrowserContext );
-
-
- /* Creation of ViewPdMenu_nicon */
- ViewPdMenu_nicon = XtVaCreateManagedWidget( "ViewPdMenu_nicon",
- xmToggleButtonGadgetClass,
- ViewPdMenu,
- RES_CONVERT( XmNlabelString, "No Icons" ),
- NULL );
- UxPutContext( ViewPdMenu_nicon, (char *) UxKuipBrowserContext );
-
-
- /* Creation of ViewPdMenu_title */
- ViewPdMenu_title = XtVaCreateManagedWidget( "ViewPdMenu_title",
- xmToggleButtonGadgetClass,
- ViewPdMenu,
- RES_CONVERT( XmNlabelString, "Titles" ),
- NULL );
- UxPutContext( ViewPdMenu_title, (char *) UxKuipBrowserContext );
-
-
- /* Creation of menu1_p2_b6 */
- menu1_p2_b6 = XtVaCreateManagedWidget( "menu1_p2_b6",
- xmSeparatorGadgetClass,
- ViewPdMenu,
- NULL );
- UxPutContext( menu1_p2_b6, (char *) UxKuipBrowserContext );
-
-
- /* Creation of ViewPdMenu_selall */
- ViewPdMenu_selall = XtVaCreateManagedWidget( "ViewPdMenu_selall",
- xmPushButtonGadgetClass,
- ViewPdMenu,
- RES_CONVERT( XmNlabelString, "Select All" ),
- NULL );
- UxPutContext( ViewPdMenu_selall, (char *) UxKuipBrowserContext );
-
-
- /* Creation of menu1_p2_b8 */
- menu1_p2_b8 = XtVaCreateManagedWidget( "menu1_p2_b8",
- xmSeparatorGadgetClass,
- ViewPdMenu,
- NULL );
- UxPutContext( menu1_p2_b8, (char *) UxKuipBrowserContext );
-
-
- /* Creation of ViewPdMenu_filt */
- ViewPdMenu_filt = XtVaCreateManagedWidget( "ViewPdMenu_filt",
- xmPushButtonGadgetClass,
- ViewPdMenu,
- RES_CONVERT( XmNlabelString, "Filter..." ),
- NULL );
- UxPutContext( ViewPdMenu_filt, (char *) UxKuipBrowserContext );
-
-
- /* Creation of ViewMenu */
- ViewMenu = XtVaCreateManagedWidget( "ViewMenu",
- xmCascadeButtonWidgetClass,
- browserMenu,
- RES_CONVERT( XmNlabelString, "View" ),
- RES_CONVERT( XmNmnemonic, "V" ),
- XmNsubMenuId, ViewPdMenu,
- NULL );
- UxPutContext( ViewMenu, (char *) UxKuipBrowserContext );
-
-
- /* Creation of HelpPdMenu */
- HelpPdMenu_shell = XtVaCreatePopupShell ("HelpPdMenu_shell",
- xmMenuShellWidgetClass, browserMenu,
- XmNwidth, 1,
- XmNheight, 1,
- XmNallowShellResize, TRUE,
- XmNoverrideRedirect, TRUE,
- NULL );
-
- HelpPdMenu = XtVaCreateWidget( "HelpPdMenu",
- xmRowColumnWidgetClass,
- HelpPdMenu_shell,
- XmNrowColumnType, XmMENU_PULLDOWN,
- NULL );
- UxPutContext( HelpPdMenu, (char *) UxKuipBrowserContext );
-
-
- /* Creation of HelpPdMenu_help */
- HelpPdMenu_help = XtVaCreateManagedWidget( "HelpPdMenu_help",
- xmPushButtonGadgetClass,
- HelpPdMenu,
- RES_CONVERT( XmNlabelString, "Help..." ),
- NULL );
- UxPutContext( HelpPdMenu_help, (char *) UxKuipBrowserContext );
-
-
- /* Creation of HelpMenu */
- HelpMenu = XtVaCreateManagedWidget( "HelpMenu",
- xmCascadeButtonWidgetClass,
- browserMenu,
- RES_CONVERT( XmNlabelString, "Help" ),
- RES_CONVERT( XmNmnemonic, "H" ),
- XmNsubMenuId, HelpPdMenu,
- NULL );
- UxPutContext( HelpMenu, (char *) UxKuipBrowserContext );
-
- XtVaSetValues(browserMenu,
- XmNmenuHelpWidget, HelpMenu,
- NULL );
-
-
- XtAddCallback( kuipBrowser, XmNdestroyCallback,
- (XtCallbackProc) UxDestroyContextCB,
- (XtPointer) UxKuipBrowserContext);
-
- XmMainWindowSetAreas( kuipBrowser, browserMenu, (Widget) NULL,
- (Widget) NULL, (Widget) NULL, kuipBrowserFrame );
-
- return ( kuipBrowser );
-}
-
-/*******************************************************************************
- The following is the 'Interface function' which is the
- external entry point for creating this interface.
- This function should be called from your application or from
- a callback function.
-*******************************************************************************/
-
-Widget create_kuipBrowser()
-{
- Widget rtrn;
- _UxCkuipBrowser *UxContext;
-
- UxKuipBrowserContext = UxContext =
- (_UxCkuipBrowser *) UxNewContext( sizeof(_UxCkuipBrowser), False );
-
-
- rtrn = _Uxbuild_kuipBrowser();
-
- return(rtrn);
-}
-
-/*******************************************************************************
- END OF FILE
-*******************************************************************************/
-
diff --git a/src/packlib/kuip/code_motif/kuxcmp.c b/src/packlib/kuip/code_motif/kuxcmp.c
deleted file mode 100644
index 3c29309..0000000
--- a/src/packlib/kuip/code_motif/kuxcmp.c
+++ /dev/null
@@ -1,236 +0,0 @@
-/*
- * $Id: kuxcmp.c,v 1.1.1.1 1996/03/08 15:33:10 mclareni Exp $
- *
- * $Log: kuxcmp.c,v $
- * Revision 1.1.1.1 1996/03/08 15:33:10 mclareni
- * Kuip
- *
- */
-/*CMZ : 2.06/03 12/01/95 14.11.00 by N.Cremel*/
-/*-- Author :*/
-/*
- * kuipCommand.c
- */
-
-/*******************************************************************************
- kuipCommand.c
-
- Associated Header file: kuipCommand.h
-*******************************************************************************/
-
-#include <stdio.h>
-#include <Xm/Xm.h>
-#include <Xm/MwmUtil.h>
-#include <Xm/DialogS.h>
-#include <Xm/MenuShell.h>
-/* #include "UxXt.h" */
-#include "mkuxxt.h"
-
-#include <Xm/PushBG.h>
-#include <Xm/SeparatoG.h>
-#include <Xm/Form.h>
-
-
-
-/*******************************************************************************
- The following header file defines the context structure.
-*******************************************************************************/
-
-#define CONTEXT_MACRO_ACCESS 1
-/* #include "kuipCommand.h" */
-#include "mkuxcm.h"
-#include "mkutdm.h"
-#undef CONTEXT_MACRO_ACCESS
-
-Widget km_cmdOK;
-Widget km_cmdEX;
-Widget km_cmdRE;
-Widget km_cmdCA;
-Widget km_cmdHE;
-
-/*******************************************************************************
- The following are callback functions.
-*******************************************************************************/
-
-/*******************************************************************************
- The 'build_' function creates all the widgets
- using the resource values specified in the Property Editor.
-*******************************************************************************/
-
-static Widget _Uxbuild_kuipCommandP()
-{
- Widget _UxParent;
-
-
- /* Creation of kuipCommandP */
- _UxParent = XtVaCreatePopupShell( "kuipCommandP_shell",
- xmDialogShellWidgetClass, UxTopLevel,
- XmNallowShellResize, TRUE,
- XmNtitle, "kuipCommandP",
- NULL );
-
- kuipCommandP = XtVaCreateWidget( "kuipCommandP",
- xmFormWidgetClass,
- _UxParent,
- XmNautoUnmanage, FALSE,
- RES_CONVERT( XmNdialogTitle, "Command" ),
- XmNdefaultPosition, FALSE,
- XmNresizePolicy, XmRESIZE_ANY,
- NULL );
- UxPutContext( kuipCommandP, (char *) UxKuipCommandPContext );
-
-
- /* Creation of commandSep */
- commandSep = XtVaCreateManagedWidget( "commandSep",
- xmSeparatorGadgetClass,
- kuipCommandP,
- XmNheight, 10,
- XmNbottomAttachment, XmATTACH_FORM,
- XmNbottomOffset, 45,
- XmNleftAttachment, XmATTACH_FORM,
- XmNleftOffset, 0,
- XmNrightAttachment, XmATTACH_FORM,
- XmNrightOffset, 0,
- NULL );
- UxPutContext( commandSep, (char *) UxKuipCommandPContext );
-
-
- /* Creation of km_cmdOK */
- km_cmdOK = XtVaCreateManagedWidget( "km_cmdOK",
- xmPushButtonGadgetClass,
- kuipCommandP,
- XmNwidth, 80,
- XmNheight, 30,
- RES_CONVERT( XmNlabelString, "OK" ),
- XmNshowAsDefault, 1,
- XmNbottomAttachment, XmATTACH_FORM,
- XmNbottomOffset, 5,
- XmNleftAttachment, XmATTACH_FORM,
- XmNleftOffset, 5,
- XmNtopAttachment, XmATTACH_NONE,
- XmNrightAttachment, XmATTACH_POSITION,
- XmNrightOffset, 5,
- XmNrightPosition, 20,
- XmNmnemonicCharSet, "O",
- NULL );
- UxPutContext( km_cmdOK, (char *) UxKuipCommandPContext );
-
-
- /* Creation of km_cmdEX */
- km_cmdEX = XtVaCreateManagedWidget( "km_cmdEX",
- xmPushButtonGadgetClass,
- kuipCommandP,
- XmNwidth, 80,
- XmNheight, 30,
- RES_CONVERT( XmNlabelString, "Execute" ),
- XmNbottomAttachment, XmATTACH_FORM,
- XmNbottomOffset, 5,
- XmNleftAttachment, XmATTACH_WIDGET,
- XmNleftOffset, 5,
- XmNleftWidget, km_cmdOK,
- XmNrightAttachment, XmATTACH_POSITION,
- XmNrightOffset, 5,
- XmNrightPosition, 40,
- RES_CONVERT( XmNmnemonic, "E" ),
- NULL );
- UxPutContext( km_cmdEX, (char *) UxKuipCommandPContext );
-
-
- /* Creation of km_cmdRE */
- km_cmdRE = XtVaCreateManagedWidget( "km_cmdRE",
- xmPushButtonGadgetClass,
- kuipCommandP,
- XmNwidth, 80,
- XmNheight, 30,
- XmNbottomAttachment, XmATTACH_FORM,
- XmNbottomOffset, 5,
- XmNleftAttachment, XmATTACH_WIDGET,
- XmNleftOffset, 5,
- XmNleftWidget, km_cmdEX,
- XmNrightAttachment, XmATTACH_POSITION,
- XmNrightOffset, 5,
- XmNrightPosition, 60,
- XmNtopAttachment, XmATTACH_NONE,
- RES_CONVERT( XmNlabelString, "Reset" ),
- RES_CONVERT( XmNmnemonic, "R" ),
- NULL );
- UxPutContext( km_cmdRE, (char *) UxKuipCommandPContext );
-
-
- /* Creation of km_cmdCA */
- km_cmdCA = XtVaCreateManagedWidget( "km_cmdCA",
- xmPushButtonGadgetClass,
- kuipCommandP,
- XmNwidth, 80,
- XmNheight, 30,
- XmNbottomAttachment, XmATTACH_FORM,
- XmNbottomOffset, 5,
- XmNleftAttachment, XmATTACH_WIDGET,
- XmNleftOffset, 5,
- XmNleftWidget, km_cmdRE,
- XmNrightAttachment, XmATTACH_POSITION,
- XmNrightOffset, 5,
- XmNrightPosition, 80,
- RES_CONVERT( XmNlabelString, "Cancel" ),
- RES_CONVERT( XmNmnemonic, "C" ),
- NULL );
- UxPutContext( km_cmdCA, (char *) UxKuipCommandPContext );
-
-
- /* Creation of km_cmdHE */
- km_cmdHE = XtVaCreateManagedWidget( "km_cmdHE",
- xmPushButtonGadgetClass,
- kuipCommandP,
- XmNwidth, 80,
- XmNheight, 30,
- XmNbottomAttachment, XmATTACH_FORM,
- XmNbottomOffset, 5,
- XmNrightAttachment, XmATTACH_POSITION,
- XmNrightOffset, 5,
- XmNleftAttachment, XmATTACH_WIDGET,
- XmNleftOffset, 5,
- XmNleftWidget, km_cmdCA,
- XmNrightPosition, 100,
- RES_CONVERT( XmNlabelString, "Help" ),
- RES_CONVERT( XmNmnemonic, "H" ),
- NULL );
- UxPutContext( km_cmdHE, (char *) UxKuipCommandPContext );
-
- XtVaSetValues(kuipCommandP,
- XmNdefaultButton, km_cmdOK,
- NULL );
-
-
- XtAddCallback( kuipCommandP, XmNdestroyCallback,
- (XtCallbackProc) UxDestroyContextCB,
- (XtPointer) UxKuipCommandPContext);
-
-
- return ( kuipCommandP );
-}
-
-/*******************************************************************************
- The following is the 'Interface function' which is the
- external entry point for creating this interface.
- This function should be called from your application or from
- a callback function.
-*******************************************************************************/
-
-Widget create_kuipCommand()
-{
- Widget rtrn;
- _UxCkuipCommandP *UxContext;
-
- UxKuipCommandPContext = UxContext =
- (_UxCkuipCommandP *) UxNewContext( sizeof(_UxCkuipCommandP), False );
-
-
- rtrn = _Uxbuild_kuipCommandP();
-
- return(rtrn);
-}
-
-/*******************************************************************************
- END OF FILE
-*******************************************************************************/
-
diff --git a/src/packlib/kuip/code_motif/kuxfse.c b/src/packlib/kuip/code_motif/kuxfse.c
deleted file mode 100644
index 0bbb22f..0000000
--- a/src/packlib/kuip/code_motif/kuxfse.c
+++ /dev/null
@@ -1,129 +0,0 @@
-/*
- * $Id: kuxfse.c,v 1.1.1.1 1996/03/08 15:33:10 mclareni Exp $
- *
- * $Log: kuxfse.c,v $
- * Revision 1.1.1.1 1996/03/08 15:33:10 mclareni
- * Kuip
- *
- */
-/*CMZ : 2.05/09 15/04/94 17.04.45 by N.Cremel*/
-/*-- Author : N.Cremel 28/06/93*/
-/*
- * kuipFilSel.c
- */
-
-/*******************************************************************************
- kuipFilSel.c
-
- Associated Header file: kuipFilSel.h
-*******************************************************************************/
-
-#include <stdio.h>
-#include <Xm/Xm.h>
-#include <Xm/MwmUtil.h>
-#include <Xm/DialogS.h>
-#include <Xm/MenuShell.h>
-/* #include "UxXt.h" */
-#include "mkuxxt.h"
-
-#include <Xm/FileSB.h>
-#include <Xm/Form.h>
-
-
-
-/*******************************************************************************
- The following header file defines the context structure.
-*******************************************************************************/
-
-#define CONTEXT_MACRO_ACCESS 1
-/* #include "kuipFilSel.h" */
-#include "mkuxfs.h"
-#undef CONTEXT_MACRO_ACCESS
-
-
-/*******************************************************************************
- The following are callback functions.
-*******************************************************************************/
-
-/*******************************************************************************
- The 'build_' function creates all the widgets
- using the resource values specified in the Property Editor.
-*******************************************************************************/
-
-static Widget _Uxbuild_kuipFilSel()
-{
- Widget _UxParent;
-
-
- /* Creation of kuipFilSel */
- _UxParent = fileParent;
- if ( _UxParent == NULL )
- {
- _UxParent = UxTopLevel;
- }
-
- _UxParent = XtVaCreatePopupShell( "kuipFilSel_shell",
- xmDialogShellWidgetClass, _UxParent,
- XmNwidth, 300,
- XmNshellUnitType, XmPIXELS,
- XmNtitle, "kuipFilSel",
- NULL );
-
- kuipFilSel = XtVaCreateWidget( "kuipFilSel",
- xmFormWidgetClass,
- _UxParent,
- XmNunitType, XmPIXELS,
- XmNdefaultPosition, FALSE,
- XmNwidth, 300,
- NULL );
- UxPutContext( kuipFilSel, (char *) UxKuipFilSelContext );
-
-
- /* Creation of km_FilSel */
- km_FilSel = XtVaCreateManagedWidget( "km_FilSel",
- xmFileSelectionBoxWidgetClass,
- kuipFilSel,
- XmNresizePolicy, XmRESIZE_NONE,
- XmNbottomAttachment, XmATTACH_FORM,
- XmNleftAttachment, XmATTACH_FORM,
- XmNrightAttachment, XmATTACH_FORM,
- XmNtopAttachment, XmATTACH_FORM,
- NULL );
- UxPutContext( km_FilSel, (char *) UxKuipFilSelContext );
-
-
- XtAddCallback( kuipFilSel, XmNdestroyCallback,
- (XtCallbackProc) UxDestroyContextCB,
- (XtPointer) UxKuipFilSelContext);
-
-
- return ( kuipFilSel );
-}
-
-/*******************************************************************************
- The following is the 'Interface function' which is the
- external entry point for creating this interface.
- This function should be called from your application or from
- a callback function.
-*******************************************************************************/
-
-Widget create_kuipFilSel( _UxfileParent )
- swidget _UxfileParent;
-{
- Widget rtrn;
- _UxCkuipFilSel *UxContext;
-
- UxKuipFilSelContext = UxContext =
- (_UxCkuipFilSel *) UxNewContext( sizeof(_UxCkuipFilSel), False );
-
- fileParent = _UxfileParent;
-
- rtrn = _Uxbuild_kuipFilSel();
-
- return(rtrn);
-}
-
-/*******************************************************************************
- END OF FILE
-*******************************************************************************/
-
diff --git a/src/packlib/kuip/code_motif/kuxgra.c b/src/packlib/kuip/code_motif/kuxgra.c
deleted file mode 100644
index 78bafc4..0000000
--- a/src/packlib/kuip/code_motif/kuxgra.c
+++ /dev/null
@@ -1,162 +0,0 @@
-/*
- * $Id: kuxgra.c,v 1.1.1.1 1996/03/08 15:33:10 mclareni Exp $
- *
- * $Log: kuxgra.c,v $
- * Revision 1.1.1.1 1996/03/08 15:33:10 mclareni
- * Kuip
- *
- */
-/*CMZ : 2.03/14 03/09/93 15.19.15 by Nicole Cremel*/
-/*-- Author : N.Cremel 07/08/92*/
-/*
- * kuipGraphics.c
- */
-
-#include "kuip/kuip.h"
-
-/*******************************************************************************
- kuipGraphics.c
-
- Associated Header file: kuipGraphics.h
-*******************************************************************************/
-
-#include <stdio.h>
-#include <Xm/Xm.h>
-#include <Xm/MwmUtil.h>
-#include <X11/Shell.h>
-#include <Xm/MenuShell.h>
-/* #include "UxXt.h" */
-#include "mkuxxt.h"
-
-#include <Xm/DrawingA.h>
-#include <Xm/Form.h>
-#include <Xm/Frame.h>
-#include <Xm/MainW.h>
-
-
-
-/*******************************************************************************
- The following header file defines the context structure.
-*******************************************************************************/
-
-#define CONTEXT_MACRO_ACCESS 1
-/* #include "kuipGraphics.h" */
-#include "mkuxgr.h"
-#undef CONTEXT_MACRO_ACCESS
-
-Widget km_graphicsDraw;
-
-/*******************************************************************************
- The following are callback functions.
-*******************************************************************************/
-
-/*******************************************************************************
- The 'build_' function creates all the widgets
- using the resource values specified in the Property Editor.
-*******************************************************************************/
-
-static Widget _Uxbuild_kuipGraphics()
-{
- Widget _UxParent;
-
-
- /* Creation of kuipGraphics */
- _UxParent = XtVaCreatePopupShell( "kuipGraphics_shell",
- topLevelShellWidgetClass, UxTopLevel,
- XmNx, 570,
- XmNy, 10,
- XmNwidth, 530,
- XmNheight, 550,
- XmNtitle, "kuipGraphics",
- XmNiconName, "kuipGraphics",
- NULL );
-
- kuipGraphics = XtVaCreateManagedWidget( "kuipGraphics",
- xmMainWindowWidgetClass,
- _UxParent,
- XmNwidth, 530,
- XmNheight, 550,
- XmNmappedWhenManaged, TRUE,
- XmNborderWidth, 0,
- NULL );
- UxPutContext( kuipGraphics, (char *) UxKuipGraphicsContext );
-
-
- /* Creation of kuipGraphicsFrame */
- kuipGraphicsFrame = XtVaCreateManagedWidget( "kuipGraphicsFrame",
- xmFrameWidgetClass,
- kuipGraphics,
- NULL );
- UxPutContext( kuipGraphicsFrame, (char *) UxKuipGraphicsContext );
-
-
- /* Creation of graphicsForm */
- graphicsForm = XtVaCreateManagedWidget( "graphicsForm",
- xmFormWidgetClass,
- kuipGraphicsFrame,
- XmNautoUnmanage, FALSE,
- XmNborderWidth, 0,
- XmNmarginHeight, 0,
- XmNmarginWidth, 0,
- XmNhorizontalSpacing, 0,
- XmNverticalSpacing, 0,
- NULL );
- UxPutContext( graphicsForm, (char *) UxKuipGraphicsContext );
-
-
- /* Creation of km_graphicsDraw */
- km_graphicsDraw = XtVaCreateManagedWidget( "km_graphicsDraw",
- xmDrawingAreaWidgetClass,
- graphicsForm,
- XmNresizePolicy, XmRESIZE_NONE,
- XmNx, 0,
- XmNy, 10,
- XmNwidth, 530,
- XmNheight, 540,
- XmNbottomAttachment, XmATTACH_FORM,
- XmNrightAttachment, XmATTACH_FORM,
- XmNrightOffset, 0,
- XmNtopOffset, 0,
- XmNbottomOffset, 0,
- XmNleftAttachment, XmATTACH_FORM,
- XmNleftOffset, 0,
- XmNtopAttachment, XmATTACH_FORM,
- NULL );
- UxPutContext( km_graphicsDraw, (char *) UxKuipGraphicsContext );
-
-
- XtAddCallback( kuipGraphics, XmNdestroyCallback,
- (XtCallbackProc) UxDestroyContextCB,
- (XtPointer) UxKuipGraphicsContext);
-
- XmMainWindowSetAreas( kuipGraphics, (Widget) NULL, (Widget) NULL,
- (Widget) NULL, (Widget) NULL, kuipGraphicsFrame );
-
- return ( kuipGraphics );
-}
-
-/*******************************************************************************
- The following is the 'Interface function' which is the
- external entry point for creating this interface.
- This function should be called from your application or from
- a callback function.
-*******************************************************************************/
-
-Widget create_kuipGraphics()
-{
- Widget rtrn;
- _UxCkuipGraphics *UxContext;
-
- UxKuipGraphicsContext = UxContext =
- (_UxCkuipGraphics *) UxNewContext( sizeof(_UxCkuipGraphics), False );
-
-
- rtrn = _Uxbuild_kuipGraphics();
-
- return(rtrn);
-}
-
-/*******************************************************************************
- END OF FILE
-*******************************************************************************/
-
diff --git a/src/packlib/kuip/code_motif/kuxhlp.c b/src/packlib/kuip/code_motif/kuxhlp.c
deleted file mode 100644
index 96e1d3c..0000000
--- a/src/packlib/kuip/code_motif/kuxhlp.c
+++ /dev/null
@@ -1,197 +0,0 @@
-/*
- * $Id: kuxhlp.c,v 1.1.1.1 1996/03/08 15:33:10 mclareni Exp $
- *
- * $Log: kuxhlp.c,v $
- * Revision 1.1.1.1 1996/03/08 15:33:10 mclareni
- * Kuip
- *
- */
-#if defined(CERNLIB_OLD)
-/*CMZ : 2.03/14 03/09/93 15.21.08 by Nicole Cremel*/
-/*-- Author : N.Cremel 07/08/92*/
-/*
- * kuipHelp.c
- */
-
-/*******************************************************************************
- kuipHelp.c
-
- Associated Header file: kuipHelp.h
-*******************************************************************************/
-
-#include <stdio.h>
-#include <Xm/Xm.h>
-#include <Xm/MwmUtil.h>
-#include <Xm/DialogS.h>
-#include <Xm/MenuShell.h>
-/*#include "UxXt.h"*/
-#include "mkuxxt.h"
-
-#include <Xm/Text.h>
-#include <Xm/ScrolledW.h>
-#include <Xm/SeparatoG.h>
-#include <Xm/PushBG.h>
-#include <Xm/Form.h>
-
-
-
-/*******************************************************************************
- The following header file defines the context structure.
-*******************************************************************************/
-
-#define CONTEXT_MACRO_ACCESS 1
-/*#include "kuipHelp.h"*/
-#include "kuip/mkuxhl.h"
-#undef CONTEXT_MACRO_ACCESS
-
-Widget km_hlpOK;
-
-/*******************************************************************************
- The following are callback functions.
-*******************************************************************************/
-
-/*******************************************************************************
- The 'build_' function creates all the widgets
- using the resource values specified in the Property Editor.
-*******************************************************************************/
-
-static Widget _Uxbuild_kuipHelp()
-{
- Widget _UxParent;
-
-
- /* Creation of kuipHelp */
- _UxParent = helpParent;
- if ( _UxParent == NULL )
- {
- _UxParent = UxTopLevel;
- }
-
- _UxParent = XtVaCreatePopupShell( "kuipHelp_shell",
- xmDialogShellWidgetClass, _UxParent,
- XmNwidth, 500,
- XmNheight, 350,
- XmNtitle, "kuipHelp",
- NULL );
-
- kuipHelp = XtVaCreateWidget( "kuipHelp",
- xmFormWidgetClass,
- _UxParent,
- XmNwidth, 500,
- XmNheight, 350,
- XmNautoUnmanage, FALSE,
- RES_CONVERT( XmNdialogTitle, "Help" ),
- NULL );
- UxPutContext( kuipHelp, (char *) UxKuipHelpContext );
-
-
- /* Creation of km_hlpOK */
- km_hlpOK = XtVaCreateManagedWidget( "km_hlpOK",
- xmPushButtonGadgetClass,
- kuipHelp,
- XmNwidth, 60,
- XmNheight, 30,
- RES_CONVERT( XmNlabelString, "OK" ),
- XmNshowAsDefault, 1,
- XmNbottomAttachment, XmATTACH_FORM,
- XmNbottomOffset, 10,
- XmNleftAttachment, XmATTACH_POSITION,
- XmNleftOffset, -30,
- XmNleftPosition, 50,
- XmNtopAttachment, XmATTACH_NONE,
- XmNdefaultButtonShadowThickness, 1,
- NULL );
- UxPutContext( km_hlpOK, (char *) UxKuipHelpContext );
-
-
- /* Creation of helpSep */
- helpSep = XtVaCreateManagedWidget( "helpSep",
- xmSeparatorGadgetClass,
- kuipHelp,
- XmNwidth, 780,
- XmNbottomAttachment, XmATTACH_WIDGET,
- XmNbottomOffset, 10,
- XmNleftAttachment, XmATTACH_FORM,
- XmNleftOffset, 0,
- XmNrightAttachment, XmATTACH_FORM,
- XmNrightOffset, 0,
- XmNbottomWidget, km_hlpOK,
- NULL );
- UxPutContext( helpSep, (char *) UxKuipHelpContext );
-
-
- /* Creation of helpScWindow */
- helpScWindow = XtVaCreateManagedWidget( "helpScWindow",
- xmScrolledWindowWidgetClass,
- kuipHelp,
- XmNshadowThickness, 0,
- XmNscrollBarDisplayPolicy, XmSTATIC,
- XmNscrollingPolicy, XmAPPLICATION_DEFINED,
- XmNvisualPolicy, XmVARIABLE,
- XmNbottomAttachment, XmATTACH_WIDGET,
- XmNbottomOffset, 5,
- XmNleftAttachment, XmATTACH_FORM,
- XmNleftOffset, 5,
- XmNrightAttachment, XmATTACH_FORM,
- XmNrightOffset, 5,
- XmNtopAttachment, XmATTACH_FORM,
- XmNtopOffset, 5,
- XmNbottomWidget, helpSep,
- NULL );
- UxPutContext( helpScWindow, (char *) UxKuipHelpContext );
-
-
- /* Creation of hlpText */
- hlpText = XtVaCreateManagedWidget( "hlpText",
- xmTextWidgetClass,
- helpScWindow,
- XmNx, 68,
- XmNy, 0,
- XmNwidth, 560,
- XmNheight, 350,
- XmNeditable, FALSE,
- XmNeditMode, XmMULTI_LINE_EDIT ,
- NULL );
- UxPutContext( hlpText, (char *) UxKuipHelpContext );
-
- XtVaSetValues(kuipHelp,
- XmNdefaultButton, km_hlpOK,
- NULL );
-
-
- XtAddCallback( kuipHelp, XmNdestroyCallback,
- (XtCallbackProc) UxDestroyContextCB,
- (XtPointer) UxKuipHelpContext);
-
-
- return ( kuipHelp );
-}
-
-/*******************************************************************************
- The following is the 'Interface function' which is the
- external entry point for creating this interface.
- This function should be called from your application or from
- a callback function.
-*******************************************************************************/
-
-Widget create_kuipHelp( _UxhelpParent )
- swidget _UxhelpParent;
-{
- Widget rtrn;
- _UxCkuipHelp *UxContext;
-
- UxKuipHelpContext = UxContext =
- (_UxCkuipHelp *) UxNewContext( sizeof(_UxCkuipHelp), False );
-
- helpParent = _UxhelpParent;
-
- rtrn = _Uxbuild_kuipHelp();
-
- return(rtrn);
-}
-
-/*******************************************************************************
- END OF FILE
-*******************************************************************************/
-
-#endif
diff --git a/src/packlib/kuip/code_motif/kuxlis.c b/src/packlib/kuip/code_motif/kuxlis.c
deleted file mode 100644
index 57395cc..0000000
--- a/src/packlib/kuip/code_motif/kuxlis.c
+++ /dev/null
@@ -1,142 +0,0 @@
-/*
- * $Id: kuxlis.c,v 1.1.1.1 1996/03/08 15:33:10 mclareni Exp $
- *
- * $Log: kuxlis.c,v $
- * Revision 1.1.1.1 1996/03/08 15:33:10 mclareni
- * Kuip
- *
- */
-/*CMZ : 2.03/14 03/09/93 15.22.50 by Nicole Cremel*/
-/*-- Author :*/
-/*
- * kuipList.c
- */
-
-/*******************************************************************************
- kuipList.c
-
- Associated Header file: kuipList.h
-*******************************************************************************/
-
-#include <stdio.h>
-#include <Xm/Xm.h>
-#include <Xm/MwmUtil.h>
-#include <Xm/DialogS.h>
-#include <Xm/MenuShell.h>
-/* #include "UxXt.h" */
-#include "mkuxxt.h"
-
-#include <Xm/SelectioB.h>
-#include <Xm/Form.h>
-
-
-
-/*******************************************************************************
- The following header file defines the context structure.
-*******************************************************************************/
-
-#define CONTEXT_MACRO_ACCESS 1
-/* #include "kuipList.h" */
-#include "mkuxli.h"
-#undef CONTEXT_MACRO_ACCESS
-
-Widget km_listSBox;
-
-/*******************************************************************************
- The following are callback functions.
-*******************************************************************************/
-
-/*******************************************************************************
- The 'build_' function creates all the widgets
- using the resource values specified in the Property Editor.
-*******************************************************************************/
-
-static Widget _Uxbuild_kuipList()
-{
- Widget _UxParent;
-
-
- /* Creation of kuipList */
- _UxParent = listParent;
- if ( _UxParent == NULL )
- {
- _UxParent = UxTopLevel;
- }
-
- _UxParent = XtVaCreatePopupShell( "kuipList_shell",
- xmDialogShellWidgetClass, _UxParent,
- XmNx, 350,
- XmNy, 600,
- XmNwidth, 270,
- XmNheight, 280,
- XmNshellUnitType, XmPIXELS,
- XmNtitle, "kuipList",
- NULL );
-
- kuipList = XtVaCreateWidget( "kuipList",
- xmFormWidgetClass,
- _UxParent,
- XmNunitType, XmPIXELS,
- XmNwidth, 270,
- XmNheight, 280,
- NULL );
- UxPutContext( kuipList, (char *) UxKuipListContext );
-
-
- /* Creation of km_listSBox */
- km_listSBox = XtVaCreateManagedWidget( "km_listSBox",
- xmSelectionBoxWidgetClass,
- kuipList,
- XmNresizePolicy, XmRESIZE_NONE,
- XmNx, 0,
- XmNy, 20,
- XmNwidth, 270,
- XmNheight, 220,
- XmNbottomAttachment, XmATTACH_FORM,
- XmNbottomOffset, 0,
- XmNleftAttachment, XmATTACH_FORM,
- XmNrightAttachment, XmATTACH_FORM,
- XmNrightOffset, 0,
- XmNtopAttachment, XmATTACH_FORM,
- XmNtopOffset, 0,
- RES_CONVERT( XmNlistLabelString, "List of Commands" ),
- RES_CONVERT( XmNselectionLabelString, "Command" ),
- NULL );
- UxPutContext( km_listSBox, (char *) UxKuipListContext );
-
-
- XtAddCallback( kuipList, XmNdestroyCallback,
- (XtCallbackProc) UxDestroyContextCB,
- (XtPointer) UxKuipListContext);
-
-
- return ( kuipList );
-}
-
-/*******************************************************************************
- The following is the 'Interface function' which is the
- external entry point for creating this interface.
- This function should be called from your application or from
- a callback function.
-*******************************************************************************/
-
-Widget create_kuipList( _UxlistParent )
- swidget _UxlistParent;
-{
- Widget rtrn;
- _UxCkuipList *UxContext;
-
- UxKuipListContext = UxContext =
- (_UxCkuipList *) UxNewContext( sizeof(_UxCkuipList), False );
-
- listParent = _UxlistParent;
-
- rtrn = _Uxbuild_kuipList();
-
- return(rtrn);
-}
-
-/*******************************************************************************
- END OF FILE
-*******************************************************************************/
-
diff --git a/src/packlib/kuip/code_motif/kuxlishlp.c b/src/packlib/kuip/code_motif/kuxlishlp.c
deleted file mode 100644
index 96055b9..0000000
--- a/src/packlib/kuip/code_motif/kuxlishlp.c
+++ /dev/null
@@ -1,158 +0,0 @@
-/*
- * $Id: kuxlishlp.c,v 1.1.1.1 1996/03/08 15:33:10 mclareni Exp $
- *
- * $Log: kuxlishlp.c,v $
- * Revision 1.1.1.1 1996/03/08 15:33:10 mclareni
- * Kuip
- *
- */
-/*CMZ : 2.07/07 22/06/95 14.04.47 by N.Cremel*/
-/*-- Author : N.Cremel 23/02/95*/
-/*
- * kuipListHelp.c
- */
-
-/*******************************************************************************
- kuipListHelp.c
-
- Associated Header file: kuipListHelp.h
-*******************************************************************************/
-
-#include <stdio.h>
-#include <Xm/Xm.h>
-#include <Xm/MwmUtil.h>
-#include <Xm/DialogS.h>
-#include <Xm/MenuShell.h>
-/* #include "UxXt.h" */
-#include "mkuxxt.h"
-
-#include <Xm/Text.h>
-#include <Xm/SelectioB.h>
-#include <Xm/Form.h>
-
-
-
-/*******************************************************************************
- The following header file defines the context structure.
-*******************************************************************************/
-
-#define CONTEXT_MACRO_ACCESS 1
-/* #include "kuipListHelp.h" */
-#include "mkuxlihlp.h"
-/* for km_listSBox + add line "km_listSBox = km_listSBoxHelp;" */
-#include "mkuxli.h"
-#undef CONTEXT_MACRO_ACCESS
-
-Widget km_listSBoxHelp;
-Widget km_listText;
-
-/*******************************************************************************
- The following are callback functions.
-*******************************************************************************/
-
-/*******************************************************************************
- The 'build_' function creates all the widgets
- using the resource values specified in the Property Editor.
-*******************************************************************************/
-
-static Widget _Uxbuild_kuipListHelp()
-{
- Widget _UxParent;
-
-
- /* Creation of kuipListHelp */
- _UxParent = listHelpParent;
- if ( _UxParent == NULL )
- {
- _UxParent = UxTopLevel;
- }
-
- _UxParent = XtVaCreatePopupShell( "kuipListHelp_shell",
- xmDialogShellWidgetClass, _UxParent,
- XmNx, 350,
- XmNy, 600,
- XmNwidth, 400,
- XmNheight, 400,
- XmNshellUnitType, XmPIXELS,
- XmNtitle, "kuipListHelp",
- NULL );
-
- kuipListHelp = XtVaCreateWidget( "kuipListHelp",
- xmFormWidgetClass,
- _UxParent,
- XmNunitType, XmPIXELS,
- XmNwidth, 400,
- XmNheight, 400,
- NULL );
- UxPutContext( kuipListHelp, (char *) UxKuipListHelpContext );
-
-
- /* Creation of km_listSBoxHelp */
- km_listSBoxHelp = XtVaCreateManagedWidget( "km_listSBoxHelp",
- xmSelectionBoxWidgetClass,
- kuipListHelp,
- XmNresizePolicy, XmRESIZE_NONE,
- XmNx, 0,
- XmNy, 20,
- XmNwidth, 270,
- XmNheight, 220,
- XmNbottomAttachment, XmATTACH_FORM,
- XmNbottomOffset, 0,
- XmNleftAttachment, XmATTACH_FORM,
- XmNrightAttachment, XmATTACH_FORM,
- XmNrightOffset, 0,
- XmNtopAttachment, XmATTACH_FORM,
- XmNtopOffset, 0,
- RES_CONVERT( XmNlistLabelString, "List of Commands" ),
- RES_CONVERT( XmNselectionLabelString, "Command" ),
- RES_CONVERT( XmNhelpLabelString, "Quick Help" ),
- RES_CONVERT( XmNokLabelString, "Full Help" ),
- NULL );
- UxPutContext( km_listSBoxHelp, (char *) UxKuipListHelpContext );
- km_listSBox = km_listSBoxHelp;
-
-
- /* Creation of km_listText */
- km_listText = XtVaCreateManagedWidget( "km_listText",
- xmTextWidgetClass,
- km_listSBoxHelp,
- NULL );
- UxPutContext( km_listText, (char *) UxKuipListHelpContext );
-
-
- XtAddCallback( kuipListHelp, XmNdestroyCallback,
- (XtCallbackProc) UxDestroyContextCB,
- (XtPointer) UxKuipListHelpContext);
-
-
- return ( kuipListHelp );
-}
-
-/*******************************************************************************
- The following is the 'Interface function' which is the
- external entry point for creating this interface.
- This function should be called from your application or from
- a callback function.
-*******************************************************************************/
-
-Widget create_kuipListHelp( _UxlistHelpParent )
- swidget _UxlistHelpParent;
-{
- Widget rtrn;
- _UxCkuipListHelp *UxContext;
-
- UxKuipListHelpContext = UxContext =
- (_UxCkuipListHelp *) UxNewContext( sizeof(_UxCkuipListHelp),
-False );
-
- listHelpParent = _UxlistHelpParent;
-
- rtrn = _Uxbuild_kuipListHelp();
-
- return(rtrn);
-}
-
-/*******************************************************************************
- END OF FILE
-*******************************************************************************/
-
diff --git a/src/packlib/kuip/code_motif/kuxolt.c b/src/packlib/kuip/code_motif/kuxolt.c
deleted file mode 100644
index c53157c..0000000
--- a/src/packlib/kuip/code_motif/kuxolt.c
+++ /dev/null
@@ -1,189 +0,0 @@
-/*
- * $Id: kuxolt.c,v 1.1.1.1 1996/03/08 15:33:10 mclareni Exp $
- *
- * $Log: kuxolt.c,v $
- * Revision 1.1.1.1 1996/03/08 15:33:10 mclareni
- * Kuip
- *
- */
-/*CMZ : 2.03/14 03/09/93 15.32.44 by Nicole Cremel*/
-/*-- Author : N.Cremel 28/06/93*/
-/*
- * kuipOptList.c
- */
-
-/*******************************************************************************
- kuipOptList.c
-
- Associated Header file: kuipOptList.h
-*******************************************************************************/
-
-#include <stdio.h>
-#include <Xm/Xm.h>
-#include <Xm/MwmUtil.h>
-#include <Xm/DialogS.h>
-#include <Xm/MenuShell.h>
-/* #include "UxXt.h" */
-#include "mkuxxt.h"
-
-#include <Xm/List.h>
-#include <Xm/ScrolledW.h>
-#include <Xm/PushBG.h>
-#include <Xm/SeparatoG.h>
-#include <Xm/Form.h>
-
-
-
-/*******************************************************************************
- The following header file defines the context structure.
-*******************************************************************************/
-
-#define CONTEXT_MACRO_ACCESS 1
-/* #include "kuipOptList.h" */
-#include "mkuxol.h"
-#undef CONTEXT_MACRO_ACCESS
-
-
-/*******************************************************************************
- The following are callback functions.
-*******************************************************************************/
-
-/*******************************************************************************
- The 'build_' function creates all the widgets
- using the resource values specified in the Property Editor.
-*******************************************************************************/
-
-static Widget _Uxbuild_kuipOptList()
-{
- Widget _UxParent;
-
-
- /* Creation of kuipOptList */
- _UxParent = XtVaCreatePopupShell( "kuipOptList_shell",
- xmDialogShellWidgetClass, UxTopLevel,
- XmNwidth, 200,
- XmNheight, 250,
- XmNshellUnitType, XmPIXELS,
- XmNtitle, "kuipOptList",
- NULL );
-
- kuipOptList = XtVaCreateWidget( "kuipOptList",
- xmFormWidgetClass,
- _UxParent,
- XmNunitType, XmPIXELS,
- XmNwidth, 200,
- XmNheight, 250,
- XmNdefaultPosition, FALSE,
- NULL );
- UxPutContext( kuipOptList, (char *) UxKuipOptListContext );
-
-
- /* Creation of OptListSep */
- OptListSep = XtVaCreateManagedWidget( "OptListSep",
- xmSeparatorGadgetClass,
- kuipOptList,
- XmNheight, 10,
- XmNbottomAttachment, XmATTACH_FORM,
- XmNbottomOffset, 45,
- XmNleftAttachment, XmATTACH_FORM,
- XmNleftOffset, 0,
- XmNrightAttachment, XmATTACH_FORM,
- XmNrightOffset, 0,
- NULL );
- UxPutContext( OptListSep, (char *) UxKuipOptListContext );
-
-
- /* Creation of OKButton */
- OKButton = XtVaCreateManagedWidget( "OKButton",
- xmPushButtonGadgetClass,
- kuipOptList,
- XmNheight, 30,
- RES_CONVERT( XmNlabelString, " OK " ),
- XmNleftAttachment, XmATTACH_FORM,
- XmNleftOffset, 10,
- XmNbottomAttachment, XmATTACH_FORM,
- XmNbottomOffset, 10,
- XmNwidth, 60,
- NULL );
- UxPutContext( OKButton, (char *) UxKuipOptListContext );
-
-
- /* Creation of CCLButton */
- CCLButton = XtVaCreateManagedWidget( "CCLButton",
- xmPushButtonGadgetClass,
- kuipOptList,
- XmNheight, 30,
- XmNbottomAttachment, XmATTACH_FORM,
- XmNbottomOffset, 10,
- RES_CONVERT( XmNlabelString, " Cancel " ),
- XmNrightAttachment, XmATTACH_FORM,
- XmNrightOffset, 10,
- XmNwidth, 60,
- NULL );
- UxPutContext( CCLButton, (char *) UxKuipOptListContext );
-
-
- /* Creation of scrolledWindow1 */
- scrolledWindow1 = XtVaCreateManagedWidget( "scrolledWindow1",
- xmScrolledWindowWidgetClass,
- kuipOptList,
- XmNscrollingPolicy, XmAPPLICATION_DEFINED,
- XmNheight, 260,
- XmNbottomAttachment, XmATTACH_WIDGET,
- XmNbottomOffset, 5,
- XmNbottomWidget, OptListSep,
- XmNleftAttachment, XmATTACH_FORM,
- XmNleftOffset, 5,
- XmNrightAttachment, XmATTACH_FORM,
- XmNrightOffset, 5,
- XmNtopOffset, 5,
- XmNscrollBarDisplayPolicy, XmSTATIC,
- XmNvisualPolicy, XmVARIABLE,
- XmNtopAttachment, XmATTACH_FORM,
- NULL );
- UxPutContext( scrolledWindow1, (char *) UxKuipOptListContext );
-
-
- /* Creation of OptList */
- OptList = XtVaCreateManagedWidget( "OptList",
- xmListWidgetClass,
- scrolledWindow1,
- XmNselectionPolicy, XmEXTENDED_SELECT,
- XmNlistSizePolicy, XmCONSTANT,
- NULL );
- UxPutContext( OptList, (char *) UxKuipOptListContext );
-
-
- XtAddCallback( kuipOptList, XmNdestroyCallback,
- (XtCallbackProc) UxDestroyContextCB,
- (XtPointer) UxKuipOptListContext);
-
-
- return ( kuipOptList );
-}
-
-/*******************************************************************************
- The following is the 'Interface function' which is the
- external entry point for creating this interface.
- This function should be called from your application or from
- a callback function.
-*******************************************************************************/
-
-Widget create_kuipOptList()
-{
- Widget rtrn;
- _UxCkuipOptList *UxContext;
-
- UxKuipOptListContext = UxContext =
- (_UxCkuipOptList *) UxNewContext( sizeof(_UxCkuipOptList), False );
-
-
- rtrn = _Uxbuild_kuipOptList();
-
- return(rtrn);
-}
-
-/*******************************************************************************
- END OF FILE
-*******************************************************************************/
-
diff --git a/src/packlib/kuip/code_motif/kuxpab.c b/src/packlib/kuip/code_motif/kuxpab.c
deleted file mode 100644
index 44a7364..0000000
--- a/src/packlib/kuip/code_motif/kuxpab.c
+++ /dev/null
@@ -1,189 +0,0 @@
-/*
- * $Id: kuxpab.c,v 1.1.1.1 1996/03/08 15:33:10 mclareni Exp $
- *
- * $Log: kuxpab.c,v $
- * Revision 1.1.1.1 1996/03/08 15:33:10 mclareni
- * Kuip
- *
- */
-/*CMZ : 2.05/17 19/09/94 09.48.53 by N.Cremel*/
-/*-- Author : N.Cremel 13/08/92*/
-/*
- * PalButton.c
- */
-
-/*******************************************************************************
- PalButton.c
-
- Associated Header file: PalButton.h
-*******************************************************************************/
-
-#include <stdio.h>
-#include <Xm/Xm.h>
-#include <Xm/MwmUtil.h>
-#include <X11/Shell.h>
-#include <Xm/MenuShell.h>
-/* #include "UxXt.h" */
-#include "mkuxxt.h"
-
-#include <Xm/Label.h>
-#include <Xm/ArrowB.h>
-#include <Xm/Frame.h>
-#include <Xm/Form.h>
-
-
-
-/*******************************************************************************
- The following header file defines the context structure.
-*******************************************************************************/
-
-#define CONTEXT_MACRO_ACCESS 1
-/* #include "PalButton.h" */
-#include "mkuxpb.h"
-#undef CONTEXT_MACRO_ACCESS
-
-
-/*******************************************************************************
- The following are callback functions.
-*******************************************************************************/
-
-/*******************************************************************************
- The 'build_' function creates all the widgets
- using the resource values specified in the Property Editor.
-*******************************************************************************/
-
-static Widget _Uxbuild_PalButton()
-{
- Widget _UxParent;
-
-
- /* Creation of PalButton */
- _UxParent = PalParent;
- if ( _UxParent == NULL )
- {
- _UxParent = XtVaCreatePopupShell( "PalButton_shell",
- topLevelShellWidgetClass, UxTopLevel,
- XmNx, 10,
- XmNy, 20,
- XmNwidth, 300,
- XmNheight, 50,
- XmNshellUnitType, XmPIXELS,
- XmNtitle, "PalButton",
- XmNiconName, "PalButton",
- NULL );
-
- }
-
- /* PalButton = XtVaCreateManagedWidget( "PalButton", */
- PalButton = XtVaCreateWidget( "PalButton",
- xmFormWidgetClass,
- _UxParent,
- XmNresizePolicy, XmRESIZE_NONE,
- XmNunitType, XmPIXELS,
- XmNwidth, 300,
- XmNheight, 50,
- NULL );
- UxPutContext( PalButton, (char *) UxPalButtonContext );
-
-
- /* Creation of PNBframe1 */
- PNBframe1 = XtVaCreateManagedWidget( "PNBframe1",
- xmFrameWidgetClass,
- PalButton,
- XmNshadowThickness, 4,
- XmNheight, 30,
- XmNbottomAttachment, XmATTACH_FORM,
- XmNbottomOffset, 0,
- XmNleftAttachment, XmATTACH_FORM,
- XmNleftOffset, 0,
- XmNrightAttachment, XmATTACH_FORM,
- XmNrightOffset, 0,
- XmNtopAttachment, XmATTACH_FORM,
- XmNtopOffset, 0,
- NULL );
- UxPutContext( PNBframe1, (char *) UxPalButtonContext );
-
-
- /* Creation of PNBform1 */
- PNBform1 = XtVaCreateManagedWidget( "PNBform1",
- xmFormWidgetClass,
- PNBframe1,
- XmNresizePolicy, XmRESIZE_NONE,
- XmNheight, 30,
- XmNwidth, 390,
- NULL );
- UxPutContext( PNBform1, (char *) UxPalButtonContext );
-
-
- /* Creation of arrowButtonB */
- arrowButtonB = XtVaCreateManagedWidget( "arrowButtonB",
- xmArrowButtonWidgetClass,
- PNBform1,
- XmNwidth, 20,
- XmNbottomAttachment, XmATTACH_FORM,
- XmNbottomOffset, 2,
- XmNleftAttachment, XmATTACH_FORM,
- XmNleftOffset, 5,
- XmNtopAttachment, XmATTACH_FORM,
- XmNtopOffset, 2,
- XmNarrowDirection, XmARROW_RIGHT,
- XmNhighlightThickness, 0,
- XmNshadowThickness, 0,
- XmNheight, 20,
- NULL );
- UxPutContext( arrowButtonB, (char *) UxPalButtonContext );
-
-
- /* Creation of km_palLabelB */
- km_palLabelB = XtVaCreateManagedWidget( "km_palLabelB",
- xmLabelWidgetClass,
- PNBform1,
- XmNbottomAttachment, XmATTACH_FORM,
- XmNbottomOffset, 2,
- RES_CONVERT( XmNlabelString, "Logon PANEL" ),
- XmNleftAttachment, XmATTACH_WIDGET,
- XmNleftOffset, 20,
- XmNleftWidget, arrowButtonB,
- XmNrightAttachment, XmATTACH_FORM,
- XmNrightOffset, 5,
- XmNtopAttachment, XmATTACH_FORM,
- XmNtopOffset, 2,
- NULL );
- UxPutContext( km_palLabelB, (char *) UxPalButtonContext );
-
-
- XtAddCallback( PalButton, XmNdestroyCallback,
- (XtCallbackProc) UxDestroyContextCB,
- (XtPointer) UxPalButtonContext);
-
-
- return ( PalButton );
-}
-
-/*******************************************************************************
- The following is the 'Interface function' which is the
- external entry point for creating this interface.
- This function should be called from your application or from
- a callback function.
-*******************************************************************************/
-
-Widget create_PalButton( _UxPalParent )
- swidget _UxPalParent;
-{
- Widget rtrn;
- _UxCPalButton *UxContext;
-
- UxPalButtonContext = UxContext =
- (_UxCPalButton *) UxNewContext( sizeof(_UxCPalButton), False );
-
- PalParent = _UxPalParent;
-
- rtrn = _Uxbuild_PalButton();
-
- return(rtrn);
-}
-
-/*******************************************************************************
- END OF FILE
-*******************************************************************************/
-
diff --git a/src/packlib/kuip/code_motif/kuxpal.c b/src/packlib/kuip/code_motif/kuxpal.c
deleted file mode 100644
index 3703617..0000000
--- a/src/packlib/kuip/code_motif/kuxpal.c
+++ /dev/null
@@ -1,344 +0,0 @@
-/*
- * $Id: kuxpal.c,v 1.1.1.1 1996/03/08 15:33:10 mclareni Exp $
- *
- * $Log: kuxpal.c,v $
- * Revision 1.1.1.1 1996/03/08 15:33:10 mclareni
- * Kuip
- *
- */
-/*CMZ : 2.05/17 19/09/94 10.18.28 by N.Cremel*/
-/*-- Author : N.Cremel 13/08/92*/
-/*
- * kuipPalette.c
- */
-
-/*******************************************************************************
- kuipPalette.c
-
- Associated Header file: kuipPalette.h
-*******************************************************************************/
-
-#include <stdio.h>
-#include <Xm/Xm.h>
-#include <Xm/MwmUtil.h>
-#include <X11/Shell.h>
-#include <Xm/MenuShell.h>
-/* #include "UxXt.h" */
-#include "mkuxxt.h"
-
-#include <Xm/CascadeB.h>
-#include <Xm/ToggleBG.h>
-#include <Xm/SeparatoG.h>
-#include <Xm/PushBG.h>
-#include <Xm/RowColumn.h>
-#include <Xm/ScrolledW.h>
-#include <Xm/Form.h>
-#include <Xm/Frame.h>
-#include <Xm/MainW.h>
-
-
-
-/*******************************************************************************
- The following header file defines the context structure.
-*******************************************************************************/
-
-#define CONTEXT_MACRO_ACCESS 1
-/* #include "kuipPalette.h" */
-#include "mkuxpl.h"
-#undef CONTEXT_MACRO_ACCESS
-
-
-/*******************************************************************************
- The following are callback functions.
-*******************************************************************************/
-
-/*******************************************************************************
- The 'build_' function creates all the widgets
- using the resource values specified in the Property Editor.
-*******************************************************************************/
-
-static Widget _Uxbuild_kuipPalette()
-{
- Widget _UxParent;
- Widget FilePdMenu_shell;
- Widget ViewPdMenu_shell;
- Widget HelpPdMenu_shell;
-
-
- /* Creation of kuipPalette */
- _UxParent = XtVaCreatePopupShell( "kuipPalette_shell",
- topLevelShellWidgetClass, UxTopLevel,
- XmNtitle, "kuipPalette",
- XmNiconName, "kuipPalette",
- NULL );
-
- kuipPalette = XtVaCreateManagedWidget( "kuipPalette",
- xmMainWindowWidgetClass,
- _UxParent,
- XmNmappedWhenManaged, TRUE,
- NULL );
- UxPutContext( kuipPalette, (char *) UxKuipPaletteContext );
-
-
- /* Creation of kuipPaletteFrame */
- kuipPaletteFrame = XtVaCreateManagedWidget( "kuipPaletteFrame",
- xmFrameWidgetClass,
- kuipPalette,
- NULL );
- UxPutContext( kuipPaletteFrame, (char *) UxKuipPaletteContext );
-
-
- /* Creation of kuipPaletteForm */
- kuipPaletteForm = XtVaCreateManagedWidget( "kuipPaletteForm",
- xmFormWidgetClass,
- kuipPaletteFrame,
- XmNautoUnmanage, FALSE,
- NULL );
- UxPutContext( kuipPaletteForm, (char *) UxKuipPaletteContext );
-
-
- /* Creation of PalScWindow */
- PalScWindow = XtVaCreateManagedWidget( "PalScWindow",
- xmScrolledWindowWidgetClass,
- kuipPaletteForm,
- XmNshadowThickness, 2,
- XmNbottomAttachment, XmATTACH_FORM,
- XmNbottomOffset, 5,
- XmNleftAttachment, XmATTACH_FORM,
- XmNleftOffset, 5,
- XmNrightAttachment, XmATTACH_FORM,
- XmNrightOffset, 5,
- XmNtopAttachment, XmATTACH_FORM,
- XmNtopOffset, 5,
- XmNscrollBarDisplayPolicy, XmSTATIC,
- XmNscrollingPolicy, XmAUTOMATIC,
- NULL );
- UxPutContext( PalScWindow, (char *) UxKuipPaletteContext );
-
-
- /* Creation of km_palForm */
- km_palForm = XtVaCreateManagedWidget( "km_palForm",
- xmFormWidgetClass,
- PalScWindow,
- XmNautoUnmanage, FALSE,
- NULL );
- UxPutContext( km_palForm, (char *) UxKuipPaletteContext );
-
-
- /* Creation of PaletteMenu */
- PaletteMenu = XtVaCreateManagedWidget( "PaletteMenu",
- xmRowColumnWidgetClass,
- kuipPalette,
- XmNrowColumnType, XmMENU_BAR,
- XmNmenuAccelerator, "<KeyUp>F10",
- NULL );
- UxPutContext( PaletteMenu, (char *) UxKuipPaletteContext );
-
-
- /* Creation of FilePdMenu */
- FilePdMenu_shell = XtVaCreatePopupShell ("FilePdMenu_shell",
- xmMenuShellWidgetClass, PaletteMenu,
- XmNwidth, 1,
- XmNheight, 1,
- XmNallowShellResize, TRUE,
- XmNoverrideRedirect, TRUE,
- NULL );
-
- FilePdMenu = XtVaCreateWidget( "FilePdMenu",
- xmRowColumnWidgetClass,
- FilePdMenu_shell,
- XmNrowColumnType, XmMENU_PULLDOWN,
- NULL );
- UxPutContext( FilePdMenu, (char *) UxKuipPaletteContext );
-
-
- /* Creation of km_addPAL */
- km_addPAL = XtVaCreateManagedWidget( "km_addPAL",
- xmPushButtonGadgetClass,
- FilePdMenu,
- RES_CONVERT( XmNlabelString, "Add Panel ..." ),
- RES_CONVERT( XmNmnemonic, "A" ),
- NULL );
- UxPutContext( km_addPAL, (char *) UxKuipPaletteContext );
-
-
- /* Creation of FilePdMenu_b6 */
- FilePdMenu_b6 = XtVaCreateManagedWidget( "FilePdMenu_b6",
- xmSeparatorGadgetClass,
- FilePdMenu,
- NULL );
- UxPutContext( FilePdMenu_b6, (char *) UxKuipPaletteContext );
-
-
- /* Creation of km_closePAL */
- km_closePAL = XtVaCreateManagedWidget( "km_closePAL",
- xmPushButtonGadgetClass,
- FilePdMenu,
- RES_CONVERT( XmNlabelString, "Close" ),
- RES_CONVERT( XmNmnemonic, "C" ),
- NULL );
- UxPutContext( km_closePAL, (char *) UxKuipPaletteContext );
-
-
- /* Creation of FilePdMenu_b5 */
- FilePdMenu_b5 = XtVaCreateManagedWidget( "FilePdMenu_b5",
- xmSeparatorGadgetClass,
- FilePdMenu,
- NULL );
- UxPutContext( FilePdMenu_b5, (char *) UxKuipPaletteContext );
-
-
- /* Creation of km_exitPAL */
- km_exitPAL = XtVaCreateManagedWidget( "km_exitPAL",
- xmPushButtonGadgetClass,
- FilePdMenu,
- RES_CONVERT( XmNlabelString, "Exit" ),
- RES_CONVERT( XmNmnemonic, "E" ),
- NULL );
- UxPutContext( km_exitPAL, (char *) UxKuipPaletteContext );
-
-
- /* Creation of FileMenu */
- FileMenu = XtVaCreateManagedWidget( "FileMenu",
- xmCascadeButtonWidgetClass,
- PaletteMenu,
- RES_CONVERT( XmNlabelString, "File" ),
- RES_CONVERT( XmNmnemonic, "F" ),
- XmNsubMenuId, FilePdMenu,
- NULL );
- UxPutContext( FileMenu, (char *) UxKuipPaletteContext );
-
-
- /* Creation of ViewPdMenu */
- ViewPdMenu_shell = XtVaCreatePopupShell ("ViewPdMenu_shell",
- xmMenuShellWidgetClass, PaletteMenu,
- XmNwidth, 1,
- XmNheight, 1,
- XmNallowShellResize, TRUE,
- XmNoverrideRedirect, TRUE,
- NULL );
-
- ViewPdMenu = XtVaCreateWidget( "ViewPdMenu",
- xmRowColumnWidgetClass,
- ViewPdMenu_shell,
- XmNradioBehavior, TRUE,
- XmNrowColumnType, XmMENU_PULLDOWN,
- NULL );
- UxPutContext( ViewPdMenu, (char *) UxKuipPaletteContext );
-
-
- /* Creation of km_viewPAL_icon */
- km_viewPAL_icon = XtVaCreateManagedWidget( "km_viewPAL_icon",
- xmToggleButtonGadgetClass,
- ViewPdMenu,
- RES_CONVERT( XmNlabelString, "By Icon" ),
- XmNset, TRUE,
- NULL );
- UxPutContext( km_viewPAL_icon, (char *) UxKuipPaletteContext );
-
-
- /* Creation of km_viewPAL_name */
- km_viewPAL_name = XtVaCreateManagedWidget( "km_viewPAL_name",
- xmToggleButtonGadgetClass,
- ViewPdMenu,
- RES_CONVERT( XmNlabelString, "By Name" ),
- NULL );
- UxPutContext( km_viewPAL_name, (char *) UxKuipPaletteContext );
-
-
- /* Creation of km_viewPAL_both */
- km_viewPAL_both = XtVaCreateManagedWidget( "km_viewPAL_both",
- xmToggleButtonGadgetClass,
- ViewPdMenu,
- RES_CONVERT( XmNlabelString, "By Name and Icon" ),
- NULL );
- UxPutContext( km_viewPAL_both, (char *) UxKuipPaletteContext );
-
-
- /* Creation of ViewMenu */
- ViewMenu = XtVaCreateManagedWidget( "ViewMenu",
- xmCascadeButtonWidgetClass,
- PaletteMenu,
- RES_CONVERT( XmNlabelString, "View" ),
- RES_CONVERT( XmNmnemonic, "V" ),
- XmNsubMenuId, ViewPdMenu,
- NULL );
- UxPutContext( ViewMenu, (char *) UxKuipPaletteContext );
-
-
- /* Creation of HelpPdMenu */
- HelpPdMenu_shell = XtVaCreatePopupShell ("HelpPdMenu_shell",
- xmMenuShellWidgetClass, PaletteMenu,
- XmNwidth, 1,
- XmNheight, 1,
- XmNallowShellResize, TRUE,
- XmNoverrideRedirect, TRUE,
- NULL );
-
- HelpPdMenu = XtVaCreateWidget( "HelpPdMenu",
- xmRowColumnWidgetClass,
- HelpPdMenu_shell,
- XmNrowColumnType, XmMENU_PULLDOWN,
- NULL );
- UxPutContext( HelpPdMenu, (char *) UxKuipPaletteContext );
-
-
- /* Creation of km_helpPAL */
- km_helpPAL = XtVaCreateManagedWidget( "km_helpPAL",
- xmPushButtonGadgetClass,
- HelpPdMenu,
- RES_CONVERT( XmNlabelString, "Help..." ),
- NULL );
- UxPutContext( km_helpPAL, (char *) UxKuipPaletteContext );
-
-
- /* Creation of HelpMenu */
- HelpMenu = XtVaCreateManagedWidget( "HelpMenu",
- xmCascadeButtonWidgetClass,
- PaletteMenu,
- RES_CONVERT( XmNlabelString, "Help" ),
- RES_CONVERT( XmNmnemonic, "H" ),
- XmNsubMenuId, HelpPdMenu,
- NULL );
- UxPutContext( HelpMenu, (char *) UxKuipPaletteContext );
-
- XtVaSetValues(PaletteMenu,
- XmNmenuHelpWidget, HelpMenu,
- NULL );
-
-
- XtAddCallback( kuipPalette, XmNdestroyCallback,
- (XtCallbackProc) UxDestroyContextCB,
- (XtPointer) UxKuipPaletteContext);
-
- XmMainWindowSetAreas( kuipPalette, PaletteMenu, (Widget) NULL,
- (Widget) NULL, (Widget) NULL, kuipPaletteFrame );
-
- return ( kuipPalette );
-}
-
-/*******************************************************************************
- The following is the 'Interface function' which is the
- external entry point for creating this interface.
- This function should be called from your application or from
- a callback function.
-*******************************************************************************/
-
-Widget create_kuipPalette()
-{
- Widget rtrn;
- _UxCkuipPalette *UxContext;
-
- UxKuipPaletteContext = UxContext =
- (_UxCkuipPalette *) UxNewContext( sizeof(_UxCkuipPalette), False );
-
-
- rtrn = _Uxbuild_kuipPalette();
-
- return(rtrn);
-}
-
-/*******************************************************************************
- END OF FILE
-*******************************************************************************/
-
diff --git a/src/packlib/kuip/code_motif/kuxpan.c b/src/packlib/kuip/code_motif/kuxpan.c
deleted file mode 100644
index dd2ba04..0000000
--- a/src/packlib/kuip/code_motif/kuxpan.c
+++ /dev/null
@@ -1,529 +0,0 @@
-/*
- * $Id: kuxpan.c,v 1.1.1.1 1996/03/08 15:33:10 mclareni Exp $
- *
- * $Log: kuxpan.c,v $
- * Revision 1.1.1.1 1996/03/08 15:33:10 mclareni
- * Kuip
- *
- */
-/*CMZ : 2.06/03 29/11/94 13.55.19 by N.Cremel*/
-/*-- Author : N.Cremel 13/08/92*/
-/*
- * kuipPanel.c
- */
-
-/*******************************************************************************
- kuipPanel.c
-
- Associated Header file: kuipPanel.h
-*******************************************************************************/
-
-#include <stdio.h>
-#include <Xm/Xm.h>
-#include <Xm/MwmUtil.h>
-#include <X11/Shell.h>
-#include <Xm/MenuShell.h>
-/* #include "UxXt.h" */
-#include "mkuxxt.h"
-
-#include <Xm/CascadeB.h>
-#include <Xm/Separator.h>
-#include <Xm/ToggleBG.h>
-#include <Xm/PushB.h>
-#include <Xm/RowColumn.h>
-#include <Xm/ScrolledW.h>
-#include <Xm/Form.h>
-#include <Xm/Frame.h>
-#include <Xm/MainW.h>
-
-
-
-/*******************************************************************************
- The following header file defines the context structure.
-*******************************************************************************/
-
-#define CONTEXT_MACRO_ACCESS 1
-/* #include "kuipPanel.h" */
-#include "mkuxpa.h"
-#undef CONTEXT_MACRO_ACCESS
-
-
-/*******************************************************************************
- The following are callback functions.
-*******************************************************************************/
-
-/*******************************************************************************
- The 'build_' function creates all the widgets
- using the resource values specified in the Property Editor.
-*******************************************************************************/
-
-static Widget _Uxbuild_kuipPanel()
-{
- Widget _UxParent;
- Widget FilePdMenPN_shell;
- Widget ViewPdMenPN_shell;
- Widget HelpPdMenPN_shell;
-
-
- /* Creation of kuipPanel */
- _UxParent = XtVaCreatePopupShell( "kuipPanel_shell",
- topLevelShellWidgetClass, UxTopLevel,
- XmNtitle, "kuipPanel",
- XmNiconName, "kuipPanel",
- NULL );
-
- kuipPanel = XtVaCreateManagedWidget( "kuipPanel",
- xmMainWindowWidgetClass,
- _UxParent,
- NULL );
- UxPutContext( kuipPanel, (char *) UxKuipPanelContext );
-
-
- /* Creation of kuipPanelFrame */
- kuipPanelFrame = XtVaCreateManagedWidget( "kuipPanelFrame",
- xmFrameWidgetClass,
- kuipPanel,
- NULL );
- UxPutContext( kuipPanelFrame, (char *) UxKuipPanelContext );
-
-
- /* Creation of kuipPanelForm */
- kuipPanelForm = XtVaCreateManagedWidget( "kuipPanelForm",
- xmFormWidgetClass,
- kuipPanelFrame,
- NULL );
- UxPutContext( kuipPanelForm, (char *) UxKuipPanelContext );
-
-
- /* Creation of km_scrollPI */
- km_scrollPI = XtVaCreateManagedWidget( "km_scrollPI",
- xmScrolledWindowWidgetClass,
- kuipPanelForm,
- XmNscrollingPolicy, XmAUTOMATIC,
- XmNbottomOffset, 5,
- XmNrightAttachment, XmATTACH_FORM,
- XmNrightOffset, 5,
- XmNleftAttachment, XmATTACH_FORM,
- XmNleftOffset, 5,
- XmNtopOffset, 5,
- XmNbottomAttachment, XmATTACH_FORM,
- XmNtopAttachment, XmATTACH_FORM,
- NULL );
- UxPutContext( km_scrollPI, (char *) UxKuipPanelContext );
-
-
- /* Creation of km_rowcolPI */
- km_rowcolPI = XtVaCreateManagedWidget( "km_rowcolPI",
- xmRowColumnWidgetClass,
- km_scrollPI,
- XmNadjustLast, FALSE,
- XmNorientation, XmHORIZONTAL,
- XmNpacking, XmPACK_COLUMN,
- NULL );
- UxPutContext( km_rowcolPI, (char *) UxKuipPanelContext );
-
-
- /* Creation of km_scrollPN */
- /* km_scrollPN = XtVaCreateManagedWidget( "km_scrollPN", */
- km_scrollPN = XtVaCreateWidget( "km_scrollPN",
- xmScrolledWindowWidgetClass,
- kuipPanelForm,
- XmNscrollingPolicy, XmAUTOMATIC,
- XmNbottomOffset, 5,
- XmNrightAttachment, XmATTACH_FORM,
- XmNrightOffset, 5,
- XmNleftAttachment, XmATTACH_FORM,
- XmNleftOffset, 5,
- XmNtopOffset, 5,
- XmNbottomAttachment, XmATTACH_FORM,
- XmNtopAttachment, XmATTACH_FORM,
- NULL );
- UxPutContext( km_scrollPN, (char *) UxKuipPanelContext );
-
-
- /* Creation of km_rowcolPN */
- km_rowcolPN = XtVaCreateManagedWidget( "km_rowcolPN",
- xmRowColumnWidgetClass,
- km_scrollPN,
- XmNadjustLast, FALSE,
- XmNorientation, XmHORIZONTAL,
- XmNpacking, XmPACK_COLUMN,
- NULL );
- UxPutContext( km_rowcolPN, (char *) UxKuipPanelContext );
-
-
- /* Creation of km_scrollPB */
- /* km_scrollPB = XtVaCreateManagedWidget( "km_scrollPB", */
- km_scrollPB = XtVaCreateWidget( "km_scrollPB",
- xmScrolledWindowWidgetClass,
- kuipPanelForm,
- XmNscrollingPolicy, XmAUTOMATIC,
- XmNbottomOffset, 5,
- XmNrightAttachment, XmATTACH_FORM,
- XmNrightOffset, 5,
- XmNleftAttachment, XmATTACH_FORM,
- XmNleftOffset, 5,
- XmNtopOffset, 5,
- XmNbottomAttachment, XmATTACH_FORM,
- XmNtopAttachment, XmATTACH_FORM,
- NULL );
- UxPutContext( km_scrollPB, (char *) UxKuipPanelContext );
-
-
- /* Creation of km_rowcolPB */
- km_rowcolPB = XtVaCreateManagedWidget( "km_rowcolPB",
- xmRowColumnWidgetClass,
- km_scrollPB,
- XmNadjustLast, FALSE,
- XmNorientation, XmHORIZONTAL,
- XmNpacking, XmPACK_COLUMN,
- NULL );
- UxPutContext( km_rowcolPB, (char *) UxKuipPanelContext );
-
-
- /* Creation of km_scrollPC */
- /* km_scrollPC = XtVaCreateManagedWidget( "km_scrollPC", */
- km_scrollPC = XtVaCreateWidget( "km_scrollPC",
- xmScrolledWindowWidgetClass,
- kuipPanelForm,
- XmNscrollingPolicy, XmAUTOMATIC,
- XmNbottomOffset, 5,
- XmNrightAttachment, XmATTACH_FORM,
- XmNrightOffset, 5,
- XmNleftAttachment, XmATTACH_FORM,
- XmNleftOffset, 5,
- XmNtopOffset, 5,
- XmNbottomAttachment, XmATTACH_FORM,
- XmNtopAttachment, XmATTACH_FORM,
- NULL );
- UxPutContext( km_scrollPC, (char *) UxKuipPanelContext );
-
-
- /* Creation of km_rowcolPC */
- km_rowcolPC = XtVaCreateManagedWidget( "km_rowcolPC",
- xmRowColumnWidgetClass,
- km_scrollPC,
- XmNadjustLast, FALSE,
- XmNorientation, XmHORIZONTAL,
- XmNpacking, XmPACK_COLUMN,
- NULL );
- UxPutContext( km_rowcolPC, (char *) UxKuipPanelContext );
-
-
- /* Creation of km_scrollP1 */
- /* km_scrollP1 = XtVaCreateManagedWidget( "km_scrollP1", */
- km_scrollP1 = XtVaCreateWidget( "km_scrollP1",
- xmScrolledWindowWidgetClass,
- kuipPanelForm,
- XmNscrollingPolicy, XmAUTOMATIC,
- XmNbottomOffset, 5,
- XmNrightAttachment, XmATTACH_FORM,
- XmNrightOffset, 5,
- XmNleftAttachment, XmATTACH_FORM,
- XmNleftOffset, 5,
- XmNtopOffset, 5,
- XmNbottomAttachment, XmATTACH_FORM,
- XmNtopAttachment, XmATTACH_FORM,
- NULL );
- UxPutContext( km_scrollP1, (char *) UxKuipPanelContext );
-
-
- /* Creation of km_rowcolP1 */
- km_rowcolP1 = XtVaCreateManagedWidget( "km_rowcolP1",
- xmRowColumnWidgetClass,
- km_scrollP1,
- XmNadjustLast, FALSE,
- XmNorientation, XmHORIZONTAL,
- XmNpacking, XmPACK_COLUMN,
- NULL );
- UxPutContext( km_rowcolP1, (char *) UxKuipPanelContext );
-
-
- /* Creation of kuipPanelMenu */
- kuipPanelMenu = XtVaCreateManagedWidget( "kuipPanelMenu",
- xmRowColumnWidgetClass,
- kuipPanel,
- XmNrowColumnType, XmMENU_BAR,
- XmNmenuAccelerator, "<KeyUp>F10",
- NULL );
- UxPutContext( kuipPanelMenu, (char *) UxKuipPanelContext );
-
-
- /* Creation of FilePdMenPN */
- FilePdMenPN_shell = XtVaCreatePopupShell ("FilePdMenPN_shell",
- xmMenuShellWidgetClass, kuipPanelMenu,
- XmNwidth, 1,
- XmNheight, 1,
- XmNallowShellResize, TRUE,
- XmNoverrideRedirect, TRUE,
- NULL );
-
- FilePdMenPN = XtVaCreateWidget( "FilePdMenPN",
- xmRowColumnWidgetClass,
- FilePdMenPN_shell,
- XmNrowColumnType, XmMENU_PULLDOWN,
- NULL );
- UxPutContext( FilePdMenPN, (char *) UxKuipPanelContext );
-
-
- /* Creation of km_savePNB */
- km_savePNB = XtVaCreateManagedWidget( "km_savePNB",
- xmPushButtonWidgetClass,
- FilePdMenPN,
- RES_CONVERT( XmNlabelString, "Save" ),
- NULL );
- UxPutContext( km_savePNB, (char *) UxKuipPanelContext );
-
-
- /* Creation of km_okPNB */
- km_okPNB = XtVaCreateManagedWidget( "km_okPNB",
- xmPushButtonWidgetClass,
- FilePdMenPN,
- RES_CONVERT( XmNlabelString, "Close" ),
- NULL );
- UxPutContext( km_okPNB, (char *) UxKuipPanelContext );
-
-
- /* Creation of FileMenPN */
- FileMenPN = XtVaCreateManagedWidget( "FileMenPN",
- xmCascadeButtonWidgetClass,
- kuipPanelMenu,
- RES_CONVERT( XmNlabelString, "File" ),
- RES_CONVERT( XmNmnemonic, "F" ),
- XmNsubMenuId, FilePdMenPN,
- NULL );
- UxPutContext( FileMenPN, (char *) UxKuipPanelContext );
-
-
- /* Creation of ViewPdMenPN */
- ViewPdMenPN_shell = XtVaCreatePopupShell ("ViewPdMenPN_shell",
- xmMenuShellWidgetClass, kuipPanelMenu,
- XmNwidth, 1,
- XmNheight, 1,
- XmNallowShellResize, TRUE,
- XmNoverrideRedirect, TRUE,
- NULL );
-
- ViewPdMenPN = XtVaCreateWidget( "ViewPdMenPN",
- xmRowColumnWidgetClass,
- ViewPdMenPN_shell,
- XmNradioBehavior, TRUE,
- XmNrowColumnType, XmMENU_PULLDOWN,
- NULL );
- UxPutContext( ViewPdMenPN, (char *) UxKuipPanelContext );
-
-
- /* Creation of km_viewPNB_name */
- km_viewPNB_name = XtVaCreateManagedWidget( "km_viewPNB_name",
- xmToggleButtonGadgetClass,
- ViewPdMenPN,
- RES_CONVERT( XmNlabelString, "By Name" ),
- RES_CONVERT( XmNmnemonic, "N" ),
- NULL );
- UxPutContext( km_viewPNB_name, (char *) UxKuipPanelContext );
-
-
- /* Creation of km_viewPNB_icon */
- km_viewPNB_icon = XtVaCreateManagedWidget( "km_viewPNB_icon",
- xmToggleButtonGadgetClass,
- ViewPdMenPN,
- RES_CONVERT( XmNlabelString, "By Icon" ),
- RES_CONVERT( XmNmnemonic, "I" ),
- XmNset, TRUE,
- NULL );
- UxPutContext( km_viewPNB_icon, (char *) UxKuipPanelContext );
-
-
- /* Creation of km_viewPNB_both */
- km_viewPNB_both = XtVaCreateManagedWidget( "km_viewPNB_both",
- xmToggleButtonGadgetClass,
- ViewPdMenPN,
- RES_CONVERT( XmNlabelString, "By Name and Icon" ),
- RES_CONVERT( XmNmnemonic, "B" ),
- NULL );
- UxPutContext( km_viewPNB_both, (char *) UxKuipPanelContext );
-
-
- /* Creation of km_viewPNB_sep */
- km_viewPNB_sep = XtVaCreateManagedWidget( "km_viewPNB_sep",
- xmSeparatorWidgetClass,
- ViewPdMenPN,
- NULL );
- UxPutContext( km_viewPNB_sep, (char *) UxKuipPanelContext );
-
-
- /* Creation of km_viewPNB_command */
- km_viewPNB_command = XtVaCreateManagedWidget( "km_viewPNB_command",
- xmToggleButtonGadgetClass,
- ViewPdMenPN,
- RES_CONVERT( XmNlabelString, "By Command (normal)" ),
- RES_CONVERT( XmNmnemonic, "C" ),
- NULL );
- UxPutContext( km_viewPNB_command, (char *) UxKuipPanelContext );
-
-
- /* Creation of km_viewPNB_command1 */
- km_viewPNB_command1 = XtVaCreateManagedWidget( "km_viewPNB_command1",
- xmToggleButtonGadgetClass,
- ViewPdMenPN,
- RES_CONVERT( XmNlabelString, "By Command (1 col.)" ),
- RES_CONVERT( XmNmnemonic, "1" ),
- NULL );
- UxPutContext( km_viewPNB_command1, (char *) UxKuipPanelContext );
-
-
- /* Creation of ViewMenPN */
- ViewMenPN = XtVaCreateManagedWidget( "ViewMenPN",
- xmCascadeButtonWidgetClass,
- kuipPanelMenu,
- RES_CONVERT( XmNlabelString, "View" ),
- RES_CONVERT( XmNmnemonic, "V" ),
- XmNsubMenuId, ViewPdMenPN,
- NULL );
- UxPutContext( ViewMenPN, (char *) UxKuipPanelContext );
-
-
- /* Creation of HelpPdMenPN */
- HelpPdMenPN_shell = XtVaCreatePopupShell ("HelpPdMenPN_shell",
- xmMenuShellWidgetClass, kuipPanelMenu,
- XmNwidth, 1,
- XmNheight, 1,
- XmNallowShellResize, TRUE,
- XmNoverrideRedirect, TRUE,
- NULL );
-
- HelpPdMenPN = XtVaCreateWidget( "HelpPdMenPN",
- xmRowColumnWidgetClass,
- HelpPdMenPN_shell,
- XmNrowColumnType, XmMENU_PULLDOWN,
- NULL );
- UxPutContext( HelpPdMenPN, (char *) UxKuipPanelContext );
-
-
- /* Creation of km_helpPNB1 */
- km_helpPNB1 = XtVaCreateManagedWidget( "km_helpPNB1",
- xmPushButtonWidgetClass,
- HelpPdMenPN,
- RES_CONVERT( XmNlabelString, "On PANEL Command" ),
- RES_CONVERT( XmNmnemonic, "P" ),
- NULL );
- UxPutContext( km_helpPNB1, (char *) UxKuipPanelContext );
-
-
- /* Creation of km_helpPNB2 */
- km_helpPNB2 = XtVaCreateManagedWidget( "km_helpPNB2",
- xmPushButtonWidgetClass,
- HelpPdMenPN,
- RES_CONVERT( XmNlabelString, "On Panel Edition" ),
- RES_CONVERT( XmNmnemonic, "E" ),
- NULL );
- UxPutContext( km_helpPNB2, (char *) UxKuipPanelContext );
-
-
- /* Creation of km_helpPNB3 */
- km_helpPNB3 = XtVaCreateManagedWidget( "km_helpPNB3",
- xmPushButtonWidgetClass,
- HelpPdMenPN,
- RES_CONVERT( XmNlabelString, "On Panel Saving" ),
- RES_CONVERT( XmNmnemonic, "S" ),
- NULL );
- UxPutContext( km_helpPNB3, (char *) UxKuipPanelContext );
-
-
- /* Creation of km_helpPNB4 */
- km_helpPNB4 = XtVaCreateManagedWidget( "km_helpPNB4",
- xmPushButtonWidgetClass,
- HelpPdMenPN,
- RES_CONVERT( XmNlabelString, "On Dollar sign" ),
- RES_CONVERT( XmNmnemonic, "D" ),
- NULL );
- UxPutContext( km_helpPNB4, (char *) UxKuipPanelContext );
-
-
- /* Creation of km_helpPNB5 */
- km_helpPNB5 = XtVaCreateManagedWidget( "km_helpPNB5",
- xmPushButtonWidgetClass,
- HelpPdMenPN,
- RES_CONVERT( XmNlabelString, "On Minus sign" ),
- RES_CONVERT( XmNmnemonic, "M" ),
- NULL );
- UxPutContext( km_helpPNB5, (char *) UxKuipPanelContext );
-
-
- /* Creation of km_helpPNB6 */
- km_helpPNB6 = XtVaCreateManagedWidget( "km_helpPNB6",
- xmPushButtonWidgetClass,
- HelpPdMenPN,
- RES_CONVERT( XmNlabelString, "On Double Minus sign" ),
- RES_CONVERT( XmNmnemonic, "o" ),
- NULL );
- UxPutContext( km_helpPNB6, (char *) UxKuipPanelContext );
-
-
- /* Creation of HelpPdMenPN_b7 */
- HelpPdMenPN_b7 = XtVaCreateManagedWidget( "HelpPdMenPN_b7",
- xmSeparatorWidgetClass,
- HelpPdMenPN,
- NULL );
- UxPutContext( HelpPdMenPN_b7, (char *) UxKuipPanelContext );
-
-
- /* Creation of km_helpCONTEXT */
- km_helpCONTEXT = XtVaCreateManagedWidget( "km_helpCONTEXT",
- xmPushButtonWidgetClass,
- HelpPdMenPN,
- RES_CONVERT( XmNlabelString, "Select context help ..." ),
- NULL );
- UxPutContext( km_helpCONTEXT, (char *) UxKuipPanelContext );
-
-
- /* Creation of HelpMenPN */
- HelpMenPN = XtVaCreateManagedWidget( "HelpMenPN",
- xmCascadeButtonWidgetClass,
- kuipPanelMenu,
- RES_CONVERT( XmNlabelString, "Help" ),
- RES_CONVERT( XmNmnemonic, "H" ),
- XmNsubMenuId, HelpPdMenPN,
- NULL );
- UxPutContext( HelpMenPN, (char *) UxKuipPanelContext );
-
- XtVaSetValues(kuipPanelMenu,
- XmNmenuHelpWidget, HelpMenPN,
- NULL );
-
-
- XtAddCallback( kuipPanel, XmNdestroyCallback,
- (XtCallbackProc) UxDestroyContextCB,
- (XtPointer) UxKuipPanelContext);
-
- XmMainWindowSetAreas( kuipPanel, kuipPanelMenu, (Widget) NULL,
- (Widget) NULL, (Widget) NULL, kuipPanelFrame );
-
- return ( kuipPanel );
-}
-
-/*******************************************************************************
- The following is the 'Interface function' which is the
- external entry point for creating this interface.
- This function should be called from your application or from
- a callback function.
-*******************************************************************************/
-
-Widget create_kuipPanel()
-{
- Widget rtrn;
- _UxCkuipPanel *UxContext;
-
- UxKuipPanelContext = UxContext =
- (_UxCkuipPanel *) UxNewContext( sizeof(_UxCkuipPanel), False );
-
-
- rtrn = _Uxbuild_kuipPanel();
-
- return(rtrn);
-}
-
-/*******************************************************************************
- END OF FILE
-*******************************************************************************/
-
diff --git a/src/packlib/kuip/code_motif/kuxpap.c b/src/packlib/kuip/code_motif/kuxpap.c
deleted file mode 100644
index 500e86b..0000000
--- a/src/packlib/kuip/code_motif/kuxpap.c
+++ /dev/null
@@ -1,344 +0,0 @@
-/*
- * $Id: kuxpap.c,v 1.1.1.1 1996/03/08 15:33:11 mclareni Exp $
- *
- * $Log: kuxpap.c,v $
- * Revision 1.1.1.1 1996/03/08 15:33:11 mclareni
- * Kuip
- *
- */
-/*CMZ : 2.06/03 29/11/94 14.13.42 by N.Cremel*/
-/*-- Author : N.Cremel 13/08/92*/
-/*
- * PalPanel.c
- */
-
-/*******************************************************************************
- PalPanel.c
-
- Associated Header file: PalPanel.h
-*******************************************************************************/
-
-#include <stdio.h>
-#include <Xm/Xm.h>
-#include <Xm/MwmUtil.h>
-#include <X11/Shell.h>
-#include <Xm/MenuShell.h>
-/* #include "UxXt.h" */
-#include "mkuxxt.h"
-
-#include <Xm/Label.h>
-#include <Xm/ArrowB.h>
-#include <Xm/RowColumn.h>
-#include <Xm/ScrolledW.h>
-#include <Xm/Frame.h>
-#include <Xm/Form.h>
-
-
-
-/*******************************************************************************
- The following header file defines the context structure.
-*******************************************************************************/
-
-#define CONTEXT_MACRO_ACCESS 1
-/* #include "PalPanel.h" */
-#include "mkuxpp.h"
-#undef CONTEXT_MACRO_ACCESS
-
-
-/*******************************************************************************
- The following are callback functions.
-*******************************************************************************/
-
-/*******************************************************************************
- The 'build_' function creates all the widgets
- using the resource values specified in the Property Editor.
-*******************************************************************************/
-
-static Widget _Uxbuild_PalPanel()
-{
- Widget _UxParent;
-
-
- /* Creation of PalPanel */
- _UxParent = UxParent;
- if ( _UxParent == NULL )
- {
- _UxParent = XtVaCreatePopupShell( "PalPanel_shell",
- topLevelShellWidgetClass, UxTopLevel,
- XmNwidth, 300,
- XmNheight, 250,
- XmNshellUnitType, XmPIXELS,
- XmNtitle, "PalPanel",
- XmNiconName, "PalPanel",
- NULL );
-
- }
-
- /* PalPanel = XtVaCreateManagedWidget( "PalPanel", */
- PalPanel = XtVaCreateWidget( "PalPanel",
- xmFormWidgetClass,
- _UxParent,
- XmNresizePolicy, XmRESIZE_NONE,
- XmNunitType, XmPIXELS,
- XmNwidth, 300,
- XmNheight, 250,
- NULL );
- UxPutContext( PalPanel, (char *) UxPalPanelContext );
-
-
- /* Creation of PNPframe1 */
- PNPframe1 = XtVaCreateManagedWidget( "PNPframe1",
- xmFrameWidgetClass,
- PalPanel,
- XmNshadowThickness, 4,
- XmNbottomAttachment, XmATTACH_FORM,
- XmNbottomOffset, 0,
- XmNleftAttachment, XmATTACH_FORM,
- XmNleftOffset, 0,
- XmNrightAttachment, XmATTACH_FORM,
- XmNrightOffset, 0,
- XmNtopAttachment, XmATTACH_FORM,
- XmNtopOffset, 0,
- NULL );
- UxPutContext( PNPframe1, (char *) UxPalPanelContext );
-
-
- /* Creation of PNPform1 */
- PNPform1 = XtVaCreateManagedWidget( "PNPform1",
- xmFormWidgetClass,
- PNPframe1,
- XmNresizePolicy, XmRESIZE_NONE,
- XmNheight, 30,
- NULL );
- UxPutContext( PNPform1, (char *) UxPalPanelContext );
-
-
- /* Creation of km_scrollMI */
- km_scrollMI = XtVaCreateManagedWidget( "km_scrollMI",
- xmScrolledWindowWidgetClass,
- PNPform1,
- XmNscrollingPolicy, XmAUTOMATIC,
- XmNx, 0,
- XmNy, 40,
- XmNwidth, 390,
- XmNheight, 150,
- XmNbottomAttachment, XmATTACH_FORM,
- XmNbottomOffset, 5,
- XmNleftAttachment, XmATTACH_FORM,
- XmNleftOffset, 5,
- XmNrightAttachment, XmATTACH_FORM,
- XmNrightOffset, 5,
- XmNtopAttachment, XmATTACH_FORM,
- XmNtopOffset, 40,
- NULL );
- UxPutContext( km_scrollMI, (char *) UxPalPanelContext );
-
-
- /* Creation of km_rowcolMI */
- km_rowcolMI = XtVaCreateManagedWidget( "km_rowcolMI",
- xmRowColumnWidgetClass,
- km_scrollMI,
- XmNadjustLast, FALSE,
- XmNorientation, XmHORIZONTAL,
- XmNpacking, XmPACK_COLUMN,
- NULL );
- UxPutContext( km_rowcolMI, (char *) UxPalPanelContext );
-
-
- /* Creation of km_scrollMN */
- km_scrollMN = XtVaCreateManagedWidget( "km_scrollMN",
- xmScrolledWindowWidgetClass,
- PNPform1,
- XmNscrollingPolicy, XmAUTOMATIC,
- XmNx, 0,
- XmNy, 40,
- XmNwidth, 390,
- XmNheight, 150,
- XmNbottomAttachment, XmATTACH_FORM,
- XmNbottomOffset, 5,
- XmNleftAttachment, XmATTACH_FORM,
- XmNleftOffset, 5,
- XmNrightAttachment, XmATTACH_FORM,
- XmNrightOffset, 5,
- XmNtopAttachment, XmATTACH_FORM,
- XmNtopOffset, 40,
- NULL );
- UxPutContext( km_scrollMN, (char *) UxPalPanelContext );
-
-
- /* Creation of km_rowcolMN */
- km_rowcolMN = XtVaCreateManagedWidget( "km_rowcolMN",
- xmRowColumnWidgetClass,
- km_scrollMN,
- XmNadjustLast, FALSE,
- XmNorientation, XmHORIZONTAL,
- XmNpacking, XmPACK_COLUMN,
- NULL );
- UxPutContext( km_rowcolMN, (char *) UxPalPanelContext );
-
-
- /* Creation of km_scrollMB */
- km_scrollMB = XtVaCreateManagedWidget( "km_scrollMB",
- xmScrolledWindowWidgetClass,
- PNPform1,
- XmNscrollingPolicy, XmAUTOMATIC,
- XmNx, 0,
- XmNy, 40,
- XmNwidth, 390,
- XmNheight, 150,
- XmNbottomAttachment, XmATTACH_FORM,
- XmNbottomOffset, 5,
- XmNleftAttachment, XmATTACH_FORM,
- XmNleftOffset, 5,
- XmNrightAttachment, XmATTACH_FORM,
- XmNrightOffset, 5,
- XmNtopAttachment, XmATTACH_FORM,
- XmNtopOffset, 40,
- NULL );
- UxPutContext( km_scrollMB, (char *) UxPalPanelContext );
-
-
- /* Creation of km_rowcolMB */
- km_rowcolMB = XtVaCreateManagedWidget( "km_rowcolMB",
- xmRowColumnWidgetClass,
- km_scrollMB,
- XmNadjustLast, FALSE,
- XmNorientation, XmHORIZONTAL,
- XmNpacking, XmPACK_COLUMN,
- NULL );
- UxPutContext( km_rowcolMB, (char *) UxPalPanelContext );
-
-
- /* Creation of km_scrollMC */
- km_scrollMC = XtVaCreateManagedWidget( "km_scrollMC",
- xmScrolledWindowWidgetClass,
- PNPform1,
- XmNscrollingPolicy, XmAUTOMATIC,
- XmNx, 0,
- XmNy, 40,
- XmNwidth, 390,
- XmNheight, 150,
- XmNbottomAttachment, XmATTACH_FORM,
- XmNbottomOffset, 5,
- XmNleftAttachment, XmATTACH_FORM,
- XmNleftOffset, 5,
- XmNrightAttachment, XmATTACH_FORM,
- XmNrightOffset, 5,
- XmNtopAttachment, XmATTACH_FORM,
- XmNtopOffset, 40,
- NULL );
- UxPutContext( km_scrollMC, (char *) UxPalPanelContext );
-
-
- /* Creation of km_rowcolMC */
- km_rowcolMC = XtVaCreateManagedWidget( "km_rowcolMC",
- xmRowColumnWidgetClass,
- km_scrollMC,
- XmNadjustLast, FALSE,
- XmNorientation, XmHORIZONTAL,
- XmNpacking, XmPACK_COLUMN,
- NULL );
- UxPutContext( km_rowcolMC, (char *) UxPalPanelContext );
-
-
- /* Creation of km_scrollM1 */
- km_scrollM1 = XtVaCreateManagedWidget( "km_scrollM1",
- xmScrolledWindowWidgetClass,
- PNPform1,
- XmNscrollingPolicy, XmAUTOMATIC,
- XmNx, 0,
- XmNy, 40,
- XmNwidth, 390,
- XmNheight, 150,
- XmNbottomAttachment, XmATTACH_FORM,
- XmNbottomOffset, 5,
- XmNleftAttachment, XmATTACH_FORM,
- XmNleftOffset, 5,
- XmNrightAttachment, XmATTACH_FORM,
- XmNrightOffset, 5,
- XmNtopAttachment, XmATTACH_FORM,
- XmNtopOffset, 40,
- NULL );
- UxPutContext( km_scrollM1, (char *) UxPalPanelContext );
-
-
- /* Creation of km_rowcolM1 */
- km_rowcolM1 = XtVaCreateManagedWidget( "km_rowcolM1",
- xmRowColumnWidgetClass,
- km_scrollM1,
- XmNadjustLast, FALSE,
- XmNorientation, XmHORIZONTAL,
- XmNpacking, XmPACK_COLUMN,
- NULL );
- UxPutContext( km_rowcolM1, (char *) UxPalPanelContext );
-
-
- /* Creation of arrowButtonP */
- arrowButtonP = XtVaCreateManagedWidget( "arrowButtonP",
- xmArrowButtonWidgetClass,
- PNPform1,
- XmNwidth, 20,
- XmNarrowDirection, XmARROW_DOWN,
- XmNhighlightThickness, 0,
- XmNshadowThickness, 0,
- XmNleftAttachment, XmATTACH_FORM,
- XmNleftOffset, 5,
- XmNtopAttachment, XmATTACH_FORM,
- XmNtopOffset, 10,
- XmNheight, 20,
- NULL );
- UxPutContext( arrowButtonP, (char *) UxPalPanelContext );
-
-
- /* Creation of km_palLabelP */
- km_palLabelP = XtVaCreateManagedWidget( "km_palLabelP",
- xmLabelWidgetClass,
- PNPform1,
- RES_CONVERT( XmNlabelString, "Logon PANEL" ),
- XmNleftAttachment, XmATTACH_WIDGET,
- XmNleftOffset, 10,
- XmNleftWidget, arrowButtonP,
- XmNrightAttachment, XmATTACH_FORM,
- XmNrightOffset, 10,
- XmNtopAttachment, XmATTACH_FORM,
- XmNtopOffset, 10,
- XmNheight, 20,
- NULL );
- UxPutContext( km_palLabelP, (char *) UxPalPanelContext );
-
-
- XtAddCallback( PalPanel, XmNdestroyCallback,
- (XtCallbackProc) UxDestroyContextCB,
- (XtPointer) UxPalPanelContext);
-
-
- return ( PalPanel );
-}
-
-/*******************************************************************************
- The following is the 'Interface function' which is the
- external entry point for creating this interface.
- This function should be called from your application or from
- a callback function.
-*******************************************************************************/
-
-Widget create_PalPanel( _UxUxParent )
- swidget _UxUxParent;
-{
- Widget rtrn;
- _UxCPalPanel *UxContext;
-
- UxPalPanelContext = UxContext =
- (_UxCPalPanel *) UxNewContext( sizeof(_UxCPalPanel), False );
-
- UxParent = _UxUxParent;
-
- rtrn = _Uxbuild_PalPanel();
-
- return(rtrn);
-}
-
-/*******************************************************************************
- END OF FILE
-*******************************************************************************/
-
diff --git a/src/packlib/kuip/code_motif/kuxsc1.c b/src/packlib/kuip/code_motif/kuxsc1.c
deleted file mode 100644
index ae1f4bf..0000000
--- a/src/packlib/kuip/code_motif/kuxsc1.c
+++ /dev/null
@@ -1,209 +0,0 @@
-/*
- * $Id: kuxsc1.c,v 1.1.1.1 1996/03/08 15:33:11 mclareni Exp $
- *
- * $Log: kuxsc1.c,v $
- * Revision 1.1.1.1 1996/03/08 15:33:11 mclareni
- * Kuip
- *
- */
-/*CMZ : 2.03/14 03/09/93 15.31.22 by Nicole Cremel*/
-/*-- Author : N.Cremel 07/08/92*/
-/*
- * kuipScroll1.c
- */
-
-/*******************************************************************************
- kuipScroll1.c
-
- Associated Header file: kuipScroll1.h
-*******************************************************************************/
-
-#include <stdio.h>
-#include <Xm/Xm.h>
-#include <Xm/MwmUtil.h>
-#include <Xm/DialogS.h>
-#include <Xm/MenuShell.h>
-/*#include "UxXt.h"*/
-#include "mkuxxt.h"
-
-#include <Xm/Text.h>
-#include <Xm/ScrolledW.h>
-#include <Xm/SeparatoG.h>
-#include <Xm/PushBG.h>
-#include <Xm/Form.h>
-
-
-
-/*******************************************************************************
- The following header file defines the context structure.
-*******************************************************************************/
-
-#define CONTEXT_MACRO_ACCESS 1
-/*#include "kuipScroll1.h"*/
-#include "mkuxs1.h"
-#undef CONTEXT_MACRO_ACCESS
-
-Widget km_scrollOK1;
-Widget km_scrollCL1;
-
-/*******************************************************************************
- The following are callback functions.
-*******************************************************************************/
-
-/*******************************************************************************
- The 'build_' function creates all the widgets
- using the resource values specified in the Property Editor.
-*******************************************************************************/
-
-static Widget _Uxbuild_kuipScroll1()
-{
- Widget _UxParent;
-
-
- /* Creation of kuipScroll1 */
- _UxParent = scroll1Parent;
- if ( _UxParent == NULL )
- {
- _UxParent = UxTopLevel;
- }
-
- _UxParent = XtVaCreatePopupShell( "kuipScroll1_shell",
- xmDialogShellWidgetClass, _UxParent,
- XmNwidth, 500,
- XmNheight, 350,
- XmNtitle, "kuipScroll1",
- NULL );
-
- kuipScroll1 = XtVaCreateWidget( "kuipScroll1",
- xmFormWidgetClass,
- _UxParent,
- XmNwidth, 500,
- XmNheight, 350,
- XmNautoUnmanage, FALSE,
- NULL );
- UxPutContext( kuipScroll1, (char *) UxKuipScroll1Context );
-
-
- /* Creation of km_scrollOK1 */
- km_scrollOK1 = XtVaCreateManagedWidget( "km_scrollOK1",
- xmPushButtonGadgetClass,
- kuipScroll1,
- XmNwidth, 60,
- XmNheight, 30,
- RES_CONVERT( XmNlabelString, "OK" ),
- XmNshowAsDefault, 1,
- XmNbottomAttachment, XmATTACH_FORM,
- XmNbottomOffset, 10,
- XmNleftAttachment, XmATTACH_FORM,
- XmNleftOffset, 10,
- XmNtopAttachment, XmATTACH_NONE,
- XmNdefaultButtonShadowThickness, 1,
- NULL );
- UxPutContext( km_scrollOK1, (char *) UxKuipScroll1Context );
-
-
- /* Creation of scrollSep1 */
- scrollSep1 = XtVaCreateManagedWidget( "scrollSep1",
- xmSeparatorGadgetClass,
- kuipScroll1,
- XmNwidth, 780,
- XmNbottomAttachment, XmATTACH_WIDGET,
- XmNbottomOffset, 10,
- XmNleftAttachment, XmATTACH_FORM,
- XmNleftOffset, 0,
- XmNrightAttachment, XmATTACH_FORM,
- XmNrightOffset, 0,
- XmNbottomWidget, km_scrollOK1,
- NULL );
- UxPutContext( scrollSep1, (char *) UxKuipScroll1Context );
-
-
- /* Creation of ScWindow1 */
- ScWindow1 = XtVaCreateManagedWidget( "ScWindow1",
- xmScrolledWindowWidgetClass,
- kuipScroll1,
- XmNshadowThickness, 0,
- XmNscrollBarDisplayPolicy, XmSTATIC,
- XmNscrollingPolicy, XmAPPLICATION_DEFINED,
- XmNvisualPolicy, XmVARIABLE,
- XmNbottomAttachment, XmATTACH_WIDGET,
- XmNbottomOffset, 5,
- XmNleftAttachment, XmATTACH_FORM,
- XmNleftOffset, 5,
- XmNrightAttachment, XmATTACH_FORM,
- XmNrightOffset, 5,
- XmNtopAttachment, XmATTACH_FORM,
- XmNtopOffset, 5,
- XmNbottomWidget, scrollSep1,
- NULL );
- UxPutContext( ScWindow1, (char *) UxKuipScroll1Context );
-
-
- /* Creation of scrollText1 */
- scrollText1 = XtVaCreateManagedWidget( "scrollText1",
- xmTextWidgetClass,
- ScWindow1,
- XmNx, 68,
- XmNy, 0,
- XmNwidth, 560,
- XmNheight, 350,
- XmNeditable, FALSE,
- XmNeditMode, XmMULTI_LINE_EDIT ,
- NULL );
- UxPutContext( scrollText1, (char *) UxKuipScroll1Context );
-
-
- /* Creation of km_scrollCL1 */
- km_scrollCL1 = XtVaCreateManagedWidget( "km_scrollCL1",
- xmPushButtonGadgetClass,
- kuipScroll1,
- XmNwidth, 60,
- XmNheight, 30,
- XmNbottomAttachment, XmATTACH_FORM,
- XmNbottomOffset, 10,
- XmNrightAttachment, XmATTACH_FORM,
- XmNrightOffset, 10,
- RES_CONVERT( XmNlabelString, " Clear " ),
- NULL );
- UxPutContext( km_scrollCL1, (char *) UxKuipScroll1Context );
-
- XtVaSetValues(kuipScroll1,
- XmNdefaultButton, km_scrollOK1,
- NULL );
-
-
- XtAddCallback( kuipScroll1, XmNdestroyCallback,
- (XtCallbackProc) UxDestroyContextCB,
- (XtPointer) UxKuipScroll1Context);
-
-
- return ( kuipScroll1 );
-}
-
-/*******************************************************************************
- The following is the 'Interface function' which is the
- external entry point for creating this interface.
- This function should be called from your application or from
- a callback function.
-*******************************************************************************/
-
-Widget create_kuipScroll1( _Uxscroll1Parent )
- swidget _Uxscroll1Parent;
-{
- Widget rtrn;
- _UxCkuipScroll1 *UxContext;
-
- UxKuipScroll1Context = UxContext =
- (_UxCkuipScroll1 *) UxNewContext( sizeof(_UxCkuipScroll1), False );
-
- scroll1Parent = _Uxscroll1Parent;
-
- rtrn = _Uxbuild_kuipScroll1();
-
- return(rtrn);
-}
-
-/*******************************************************************************
- END OF FILE
-*******************************************************************************/
-
diff --git a/src/packlib/kuip/code_motif/kuxscr.c b/src/packlib/kuip/code_motif/kuxscr.c
deleted file mode 100644
index 588bcde..0000000
--- a/src/packlib/kuip/code_motif/kuxscr.c
+++ /dev/null
@@ -1,194 +0,0 @@
-/*
- * $Id: kuxscr.c,v 1.1.1.1 1996/03/08 15:33:11 mclareni Exp $
- *
- * $Log: kuxscr.c,v $
- * Revision 1.1.1.1 1996/03/08 15:33:11 mclareni
- * Kuip
- *
- */
-/*CMZ : 2.03/14 03/09/93 15.30.05 by Nicole Cremel*/
-/*-- Author : N.Cremel 07/08/92*/
-/*
- * kuipScroll.c
- */
-
-/*******************************************************************************
- kuipScroll.c
-
- Associated Header file: kuipScroll.h
-*******************************************************************************/
-
-#include <stdio.h>
-#include <Xm/Xm.h>
-#include <Xm/MwmUtil.h>
-#include <Xm/DialogS.h>
-#include <Xm/MenuShell.h>
-/*#include "UxXt.h"*/
-#include "mkuxxt.h"
-
-#include <Xm/Text.h>
-#include <Xm/ScrolledW.h>
-#include <Xm/SeparatoG.h>
-#include <Xm/PushBG.h>
-#include <Xm/Form.h>
-
-
-
-/*******************************************************************************
- The following header file defines the context structure.
-*******************************************************************************/
-
-#define CONTEXT_MACRO_ACCESS 1
-/*#include "kuipScroll.h"*/
-#include "mkuxsc.h"
-#undef CONTEXT_MACRO_ACCESS
-
-Widget km_scrollOK;
-
-/*******************************************************************************
- The following are callback functions.
-*******************************************************************************/
-
-/*******************************************************************************
- The 'build_' function creates all the widgets
- using the resource values specified in the Property Editor.
-*******************************************************************************/
-
-static Widget _Uxbuild_kuipScroll()
-{
- Widget _UxParent;
-
-
- /* Creation of kuipScroll */
- _UxParent = scrollParent;
- if ( _UxParent == NULL )
- {
- _UxParent = UxTopLevel;
- }
-
- _UxParent = XtVaCreatePopupShell( "kuipScroll_shell",
- xmDialogShellWidgetClass, _UxParent,
- XmNwidth, 500,
- XmNheight, 350,
- XmNtitle, "kuipScroll",
- NULL );
-
- kuipScroll = XtVaCreateWidget( "kuipScroll",
- xmFormWidgetClass,
- _UxParent,
- XmNwidth, 500,
- XmNheight, 350,
- XmNautoUnmanage, FALSE,
- NULL );
- UxPutContext( kuipScroll, (char *) UxKuipScrollContext );
-
-
- /* Creation of km_scrollOK */
- km_scrollOK = XtVaCreateManagedWidget( "km_scrollOK",
- xmPushButtonGadgetClass,
- kuipScroll,
- XmNwidth, 60,
- XmNheight, 30,
- RES_CONVERT( XmNlabelString, "OK" ),
- XmNshowAsDefault, 1,
- XmNbottomAttachment, XmATTACH_FORM,
- XmNbottomOffset, 10,
- XmNleftAttachment, XmATTACH_POSITION,
- XmNleftOffset, -30,
- XmNleftPosition, 50,
- XmNtopAttachment, XmATTACH_NONE,
- XmNdefaultButtonShadowThickness, 1,
- NULL );
- UxPutContext( km_scrollOK, (char *) UxKuipScrollContext );
-
-
- /* Creation of scrollSep */
- scrollSep = XtVaCreateManagedWidget( "scrollSep",
- xmSeparatorGadgetClass,
- kuipScroll,
- XmNwidth, 780,
- XmNbottomAttachment, XmATTACH_WIDGET,
- XmNbottomOffset, 10,
- XmNleftAttachment, XmATTACH_FORM,
- XmNleftOffset, 0,
- XmNrightAttachment, XmATTACH_FORM,
- XmNrightOffset, 0,
- XmNbottomWidget, km_scrollOK,
- NULL );
- UxPutContext( scrollSep, (char *) UxKuipScrollContext );
-
-
- /* Creation of ScWindow */
- ScWindow = XtVaCreateManagedWidget( "ScWindow",
- xmScrolledWindowWidgetClass,
- kuipScroll,
- XmNshadowThickness, 0,
- XmNscrollBarDisplayPolicy, XmSTATIC,
- XmNscrollingPolicy, XmAPPLICATION_DEFINED,
- XmNvisualPolicy, XmVARIABLE,
- XmNbottomAttachment, XmATTACH_WIDGET,
- XmNbottomOffset, 5,
- XmNleftAttachment, XmATTACH_FORM,
- XmNleftOffset, 5,
- XmNrightAttachment, XmATTACH_FORM,
- XmNrightOffset, 5,
- XmNtopAttachment, XmATTACH_FORM,
- XmNtopOffset, 5,
- XmNbottomWidget, scrollSep,
- NULL );
- UxPutContext( ScWindow, (char *) UxKuipScrollContext );
-
-
- /* Creation of scrollText */
- scrollText = XtVaCreateManagedWidget( "scrollText",
- xmTextWidgetClass,
- ScWindow,
- XmNx, 68,
- XmNy, 0,
- XmNwidth, 560,
- XmNheight, 350,
- XmNeditable, FALSE,
- XmNeditMode, XmMULTI_LINE_EDIT ,
- NULL );
- UxPutContext( scrollText, (char *) UxKuipScrollContext );
-
- XtVaSetValues(kuipScroll,
- XmNdefaultButton, km_scrollOK,
- NULL );
-
-
- XtAddCallback( kuipScroll, XmNdestroyCallback,
- (XtCallbackProc) UxDestroyContextCB,
- (XtPointer) UxKuipScrollContext);
-
-
- return ( kuipScroll );
-}
-
-/*******************************************************************************
- The following is the 'Interface function' which is the
- external entry point for creating this interface.
- This function should be called from your application or from
- a callback function.
-*******************************************************************************/
-
-Widget create_kuipScroll( _UxscrollParent )
- swidget _UxscrollParent;
-{
- Widget rtrn;
- _UxCkuipScroll *UxContext;
-
- UxKuipScrollContext = UxContext =
- (_UxCkuipScroll *) UxNewContext( sizeof(_UxCkuipScroll), False );
-
- scrollParent = _UxscrollParent;
-
- rtrn = _Uxbuild_kuipScroll();
-
- return(rtrn);
-}
-
-/*******************************************************************************
- END OF FILE
-*******************************************************************************/
-
diff --git a/src/packlib/kuip/code_motif/kuxsel.c b/src/packlib/kuip/code_motif/kuxsel.c
deleted file mode 100644
index d991d30..0000000
--- a/src/packlib/kuip/code_motif/kuxsel.c
+++ /dev/null
@@ -1,141 +0,0 @@
-/*
- * $Id: kuxsel.c,v 1.1.1.1 1996/03/08 15:33:11 mclareni Exp $
- *
- * $Log: kuxsel.c,v $
- * Revision 1.1.1.1 1996/03/08 15:33:11 mclareni
- * Kuip
- *
- */
-/*CMZ : 2.03/14 07/09/93 15.33.42 by Nicole Cremel*/
-/*-- Author : Nicole Cremel 02/09/93*/
-/*
- * kuipSelect.c
- */
-/*******************************************************************************
- kuipSelect.c
-
- Associated Header file: kuipSelect.h
-*******************************************************************************/
-
-#include <stdio.h>
-#include <Xm/Xm.h>
-#include <Xm/MwmUtil.h>
-#include <Xm/DialogS.h>
-#include <Xm/MenuShell.h>
-/* #include "UxXt.h" */
-#include "mkuxxt.h"
-
-#include <Xm/PushBG.h>
-#include <Xm/MessageB.h>
-#include <Xm/Form.h>
-
-
-
-/*******************************************************************************
- The following header file defines the context structure.
-*******************************************************************************/
-
-#define CONTEXT_MACRO_ACCESS 1
-/* #include "kuipSelect.h" */
-#include "mkuxse.h"
-#undef CONTEXT_MACRO_ACCESS
-
-Widget km_messageBox;
-Widget km_goButton;
-
-/*******************************************************************************
- The following are callback functions.
-*******************************************************************************/
-
-/*******************************************************************************
- The 'build_' function creates all the widgets
- using the resource values specified in the Property Editor.
-*******************************************************************************/
-
-static Widget _Uxbuild_kuipSelect()
-{
- Widget _UxParent;
-
-
- /* Creation of kuipSelect */
- _UxParent = UxParent;
- if ( _UxParent == NULL )
- {
- _UxParent = UxTopLevel;
- }
-
- _UxParent = XtVaCreatePopupShell( "kuipSelect_shell",
- xmDialogShellWidgetClass, _UxParent,
- XmNheight, 200,
- XmNshellUnitType, XmPIXELS,
- XmNtitle, "kuipSelect",
- NULL );
-
- kuipSelect = XtVaCreateWidget( "kuipSelect",
- xmFormWidgetClass,
- _UxParent,
- XmNunitType, XmPIXELS,
- XmNheight, 200,
- NULL );
- UxPutContext( kuipSelect, (char *) UxKuipSelectContext );
-
-
- /* Creation of km_messageBox */
- km_messageBox = XtVaCreateManagedWidget( "km_messageBox",
- xmMessageBoxWidgetClass,
- kuipSelect,
- XmNresizePolicy, XmRESIZE_NONE,
- XmNbottomAttachment, XmATTACH_FORM,
- XmNleftAttachment, XmATTACH_FORM,
- XmNrightAttachment, XmATTACH_FORM,
- XmNtopAttachment, XmATTACH_FORM,
- NULL );
- UxPutContext( km_messageBox, (char *) UxKuipSelectContext );
-
-
- /* Creation of km_goButton */
- km_goButton = XtVaCreateManagedWidget( "km_goButton",
- xmPushButtonGadgetClass,
- km_messageBox,
- XmNwidth, 40,
- XmNheight, 20,
- RES_CONVERT( XmNlabelString, " Go " ),
- NULL );
- UxPutContext( km_goButton, (char *) UxKuipSelectContext );
-
-
- XtAddCallback( kuipSelect, XmNdestroyCallback,
- (XtCallbackProc) UxDestroyContextCB,
- (XtPointer) UxKuipSelectContext);
-
-
- return ( kuipSelect );
-}
-
-/*******************************************************************************
- The following is the 'Interface function' which is the
- external entry point for creating this interface.
- This function should be called from your application or from
- a callback function.
-*******************************************************************************/
-
-Widget create_kuipSelect( _UxUxParent )
- swidget _UxUxParent;
-{
- Widget rtrn;
- _UxCkuipSelect *UxContext;
-
- UxKuipSelectContext = UxContext =
- (_UxCkuipSelect *) UxNewContext( sizeof(_UxCkuipSelect), False );
-
- UxParent = _UxUxParent;
-
- rtrn = _Uxbuild_kuipSelect();
-
- return(rtrn);
-}
-
-/*******************************************************************************
- END OF FILE
-*******************************************************************************/
-
diff --git a/src/packlib/kuip/code_motif/kuxxt.c b/src/packlib/kuip/code_motif/kuxxt.c
deleted file mode 100644
index 0d9389f..0000000
--- a/src/packlib/kuip/code_motif/kuxxt.c
+++ /dev/null
@@ -1,805 +0,0 @@
-/*
- * $Id: kuxxt.c,v 1.1.1.1 1996/03/08 15:33:11 mclareni Exp $
- *
- * $Log: kuxxt.c,v $
- * Revision 1.1.1.1 1996/03/08 15:33:11 mclareni
- * Kuip
- *
- */
-/*CMZ : 2.06/04 17/01/95 09.56.01 by N.Cremel*/
-/*-- Author :*/
-/*---------------------------------------------------------------------
- * $Date: 1996/03/08 15:33:11 $ $Revision: 1.1.1.1 $
- *---------------------------------------------------------------------
- *
- *
- * Copyright (c) 1991, Visual Edge Software Ltd.
- *
- * ALL RIGHTS RESERVED. Permission to use, copy, modify, and
- * distribute this software and its documentation for any purpose
- * and without fee is hereby granted, provided that the above
- * copyright notice appear in all copies and that both that
- * copyright notice and this permission notice appear in supporting
- * documentation, and that the name of Visual Edge Software not be
- * used in advertising or publicity pertaining to distribution of
- * the software without specific, written prior permission. The year
- * included in the notice is the year of the creation of the work.
- *-------------------------------------------------------------------*/
- /*------------------------------------------------------------------------
- * UxXt.c
- *-----------------------------------------------------------------------*/
-
-#include <stdio.h>
-#include <stdlib.h>
-
-#include <X11/Intrinsic.h>
-#include <X11/Shell.h>
-#include <X11/StringDefs.h>
-#include <X11/Xutil.h>
-#include <X11/X.h>
-#include <X11/Xmd.h>
-#include <X11/Xlib.h>
-#include <Xm/Xm.h>
-#include <Xm/DialogS.h>
-
-#ifdef UIL_CODE
-#include <Mrm/MrmPublic.h>
-#endif /* UIL_CODE */
-
-#include "kuip/kuip.h"
-#include "mkuxxt.h"
-
-static XContext xcontext_id = 0;
-
-/*****************************************************************************
-NAME: UxRealWidget( wgt )
-
-INPUT: Widget wgt - the top user-created widget
-
-RETURN: Widget - the shell widget
-
-DESCRIPTION: Given a widget, determines if the widget parent
- is a shell in which case the shell is returned
- otherwise, the widget itself is returned.
- This is needed for implicit shells to get the real
- shell behing the toplevel manager.
-
-CREATION: Visual Edge Software April 8 1993
-----------------------------------------------------------------------------*/
-#ifdef _NO_PROTO
-Widget UxRealWidget( wgt )
- Widget wgt;
-#else
-Widget UxRealWidget( Widget wgt )
-#endif
-{
- if (wgt) {
- if (XtIsShell(wgt)) {
- return(wgt);
- } else if (XtIsShell(XtParent(wgt))) {
- return XtParent(wgt);
- }
- }
- return wgt;
-}
-/******************************************************************************
-NAME: GetTrueToplevel( wgt )
-
-INPUT: Widget wgt - the top user-created widget
-
-RETURN: Widget - the shell widget
-
-DESCRIPTION: Returns the true toplevel of that interface.
- This is needed for implicit shells where the widget passed to
- one of the Ux functions is not always the shell.
-
-CREATION: Visual Edge Software April 6 1991
------------------------------------------------------------------------------*/
-#ifdef _NO_PROTO
-static Widget GetTrueToplevel( wgt )
- Widget wgt;
-#else
-static Widget GetTrueToplevel( Widget wgt )
-#endif
-{
- while (wgt && !XtIsShell(wgt))
- {
- wgt = XtParent(wgt);
- }
- return wgt;
-}
-
-/******************************************************************************
-NAME: handle_dialog_child( wgt, manage_func )
-
-INPUT: Widget wgt - the dialogShellWidget
- void (*manage_func)() - either XtManageChild
- or XtUnmanageChild
-
-RETURN: int - UX_NO_ERROR if successfull
- UX_ERROR otherwise
-
-DESCRIPTION: Handles the popping up or popping down of dialog shells
- by managing or unmanaging their children.
-
-CREATION: Visual Edge Software Sept 19/91
------------------------------------------------------------------------------*/
-#ifdef _NO_PROTO
-static int handle_dialog_child( wgt, manage_func )
- Widget wgt;
- void (*manage_func)();
-#else
-static int handle_dialog_child( Widget wgt, void (*manage_func)(Widget) )
-#endif
-{
- int i, num_children;
- Widget *children;
- int error_flag = UX_ERROR;
-
- XtVaGetValues( wgt,
- XmNnumChildren, &num_children,
- XmNchildren, &children,
- NULL );
-
- /*-----------------------------------------------------
- * We manage/unmanage the first rectObj child in the list.
- * Note that the check for rectObjClass is necessary since
- * some implementations of Motif add protocol children to
- * the dialogShell. Additionally, when the LANG is set to
- * Japanese, a widget of class Core is created. This widget
- * should not be managed. We'll skip it.
- *-----------------------------------------------------*/
-
- for (i = 0; i < num_children; i++)
- {
- if ( XtIsSubclass( children[i], rectObjClass ) &&
- (XtClass (children[i]) != coreWidgetClass))
- {
- (*manage_func)(children[i]);
- error_flag = UX_NO_ERROR;
- break;
- }
- }
-
- return ( error_flag );
-}
-
-/******************************************************************************
-NAME: popup_dialog( wgt, grab_flag )
-
-INPUT: Widget wgt - dialogShell to pop up
- XtGrabKind grab_flag - the grab flag
-
-RETURN: void
-
-DESCRIPTION: Pops up a dialogShell.
-
-CREATION: Visual Edge Software Sept 19/91
------------------------------------------------------------------------------*/
-#ifdef _NO_PROTO
-static void popup_dialog( wgt, grab_flag )
- Widget wgt;
- XtGrabKind grab_flag;
-#else
-static void popup_dialog( Widget wgt, XtGrabKind grab_flag )
-#endif
-{
- if ( handle_dialog_child( wgt, XtManageChild ) == UX_ERROR )
- XtPopup( wgt, grab_flag );
-}
-
-/******************************************************************************
-NAME: UxPopupInterface( wgt, grab_flag )
-
-INPUT: Widget wgt - Widget to popup
- XtGrabKind grab_flag - grab flag
-
-RETURN: int UX_ERROR or UX_NO_ERROR
-
-DESCRIPTION: Popups up an interface. The widget should be a toplevel widget.
- Note that special handling is required for dialogShells since
- those are popped up by managing their children if they have
- some.
- The grab_flag could be any of:
- no_grab (XtGrabNone)
- nonexclusive_grab (XtGrabNonexclusive)
- exclusive_grab (XtGrabExclusive)
-
-CREATION: Visual Edge Software April 6 1991
------------------------------------------------------------------------------*/
-#ifdef _NO_PROTO
-int UxPopupInterface( wgt, grab_flag )
- Widget wgt;
- XtGrabKind grab_flag;
-#else
-int UxPopupInterface( Widget wgt, XtGrabKind grab_flag )
-#endif
-{
- if (!(wgt = GetTrueToplevel(wgt)))
- return ( UX_ERROR );
-
- if ( XtIsSubclass( wgt, xmDialogShellWidgetClass ) )
- {
- popup_dialog( wgt, grab_flag );
- }
- else
- {
- XtPopup( wgt, grab_flag );
- }
-
- return ( UX_NO_ERROR );
-}
-
-/******************************************************************************
-NAME: popdown_dialog( wgt )
-
-INPUT: Widget wgt - dialogShell to popdown
-
-RETURN: void
-
-DESCRIPTION: Pops down a dialogShell.
-
-CREATION: Visual Edge Software Sept 19/91
------------------------------------------------------------------------------*/
-#ifdef _NO_PROTO
-static void popdown_dialog( wgt )
- Widget wgt;
-#else
-static void popdown_dialog( Widget wgt )
-#endif
-{
- if ( handle_dialog_child( wgt, XtUnmanageChild ) == UX_ERROR )
- XtPopdown( wgt );
-}
-
-/******************************************************************************
-NAME: UxPopdownInterface( wgt )
-
-INPUT: Widget wgt - Widget to popdown
-
-RETURN: int UX_ERROR / UX_NO_ERROR
-
-DESCRIPTION: Pops down an interface. The widget should be a toplevel widget.
- Note that special handling is required for dialogShells since
- those are popped down by unmanaging their children if they have
- some.
-
-CREATION: Visual Edge Software April 6 1991
------------------------------------------------------------------------------*/
-#ifdef _NO_PROTO
-int UxPopdownInterface( wgt )
- Widget wgt;
-#else
-int UxPopdownInterface( Widget wgt )
-#endif
-{
- if (!(wgt = GetTrueToplevel(wgt)))
- return ( UX_ERROR );
-
- if ( XtIsSubclass( wgt, xmDialogShellWidgetClass ) )
- {
- popdown_dialog( wgt );
- }
- else
- {
- XtPopdown( wgt );
- }
-
- return ( UX_NO_ERROR );
-}
-
-/******************************************************************************
-NAME: UxDestroyInterface( wgt )
-
-INPUT: Widget wgt - Widget to destroy
-
-RETURN: int UX_ERROR / UX_NO_ERROR
-
-DESCRIPTION: Destroys an interface. The widget should be a toplevel widget.
-
-CREATION: Visual Edge Software April 6 1991
------------------------------------------------------------------------------*/
-#ifdef _NO_PROTO
-int UxDestroyInterface( wgt )
- Widget wgt;
-#else
-int UxDestroyInterface( Widget wgt )
-#endif
-{
- if (!(wgt = GetTrueToplevel(wgt)))
- return ( UX_ERROR );
-
- XtDestroyWidget (wgt);
-
- return ( UX_NO_ERROR );
-}
-
-/******************************************************************************
-NAME: UxDeleteContextCB( wgt, client_data, call_data )
-
-INPUT: Widget wgt - widget causing the callback
- XtPointer client_data - not used
- XtPointer call_data - not used
-
-RETURN: void
-
-DESCRIPTION: Deletes the X context entry.
-
-EXT REFERENCES: UxTopLevel, xcontext_id
-
-CREATION: Visual Edge Software April 6 1991
------------------------------------------------------------------------------*/
-#ifdef _NO_PROTO
-void UxDeleteContextCB( wgt, client_data, _call_data )
- Widget wgt;
- XtPointer client_data, _call_data;
-#else
-void UxDeleteContextCB( Widget wgt, XtPointer client_data,
- XtPointer _call_data )
-#endif
-{
- (void) XDeleteContext( XtDisplay( UxTopLevel ),
- (Window) wgt,
- (XContext) client_data );
-}
-
-/******************************************************************************
-NAME: UxPutContext( wgt, context )
-
-INPUT: Widget wgt - Widget
- XtPointer context - context pointer
-
-RETURN: int UX_ERROR / UX_NO_ERROR
-
-DESCRIPTION: Uses the X Context manager to store the given context pointer
- in a memory location that is indexed by the given widget id.
- Also adds a destroyCallback to delete that context when the
- widget is destroyed.
-
-EXT REFERENCES: UxTopLevel, xcontext_id
-EXT EFFECTS: xcontext_id
-
-CREATION: Visual Edge Software April 6 1991
------------------------------------------------------------------------------*/
-#ifdef _NO_PROTO
-int UxPutContext( wgt, context )
- Widget wgt;
- caddr_t context;
-#else
-int UxPutContext( Widget wgt, caddr_t context )
-#endif
-{
- int status;
-
- if ( xcontext_id == 0 )
- xcontext_id = XUniqueContext();
-
- if ( wgt == NULL )
- return ( UX_ERROR );
-
- status = XSaveContext( XtDisplay( UxTopLevel ),
- (Window) wgt,
- xcontext_id,
- (char *) context );
- if ( status != 0 )
- return ( UX_ERROR );
-
- XtAddCallback (wgt, XmNdestroyCallback,
- UxDeleteContextCB, (XtPointer) xcontext_id);
-
- return ( UX_NO_ERROR );
-}
-
-/******************************************************************************
-NAME: UxGetContext( wgt )
-
-INPUT: Widget wgt - widget
-
-RETURN: caddr_t - the context pointer
-
-DESCRIPTION: Uses the X Context manager to find the context pointer
- stored in a memory location indexed by the given widget id.
-
-EXT REFERENCES: UxTopLevel, xcontext_id
-
-CREATION: Visual Edge Software April 6 1991
------------------------------------------------------------------------------*/
-#ifdef _NO_PROTO
-caddr_t UxGetContext( wgt )
- Widget wgt;
-#else
-caddr_t UxGetContext( Widget wgt )
-#endif
-{
- int status;
-#if XtSpecificationRelease <= 4 /* X11R4 */
- caddr_t context;
-#else /* X11R5 */
- XPointer context;
-#endif
-
- if ( wgt == NULL )
- return ( (caddr_t) NULL );
-
- status = XFindContext( XtDisplay( UxTopLevel ),
- (Window) wgt,
- xcontext_id,
- &context );
-
- if ( status != 0 )
- return ( (caddr_t) NULL );
-
- return ( context );
-}
-
-/******************************************************************************
-NAME: DelayedFreeData ( client_data, id )
-
-INPUT: XtPointer client_data - pointer to be freed
- XtIntervalId *id;
-
-RETURN: void
-
-DESCRIPTION: This XtTimerCallbackProc function simply frees the client data.
-
-CREATION: Visual Edge Software April 30 1993
------------------------------------------------------------------------------*/
-#ifdef _NO_PROTO
-static void DelayedFreeData( client_data, _id )
- XtPointer client_data;
- XtIntervalId *_id;
-#else
-static void DelayedFreeData( XtPointer client_data, XtIntervalId *_id)
-#endif
-{
- if (client_data != NULL) {
- XtFree((char *) client_data);
- }
-}
-/******************************************************************************
-NAME: UxDestroyContextCB ( wgt, client_data, call_data )
-
-INPUT: Widget wgt - widget
- XtPointer client_data - pointer to be freed
- XtPointer call_data - not used
-
-RETURN: void
-
-DESCRIPTION: This callback function registers a timeout to free the
- context structure. This mechanism is used to ensure that
- user's destroyCallbacks are executed before we free the
- context structure.
-
-CREATION: Visual Edge Software April 6 1991
------------------------------------------------------------------------------*/
-#ifdef _NO_PROTO
-void UxDestroyContextCB( _wgt, client_data, _call_data )
- Widget _wgt;
- XtPointer client_data, _call_data;
-#else
-void UxDestroyContextCB( Widget _wgt, XtPointer client_data,
- XtPointer _call_data )
-#endif
-{
- if (client_data != NULL) {
- XtAppAddTimeOut(UxAppContext, 0,
- DelayedFreeData, client_data);
- }
-}
-/******************************************************************************
-NAME: UxFreeClientDataCB( wgt, client_data, call_data )
-
-INPUT: Widget wgt - widget
- XtPointer client_data - pointer to be freed
- XtPointer call_data - not used
-
-RETURN: void
-
-DESCRIPTION: This callback function simply frees the client data.
-
-CREATION: Visual Edge Software April 6 1991
------------------------------------------------------------------------------*/
-#ifdef _NO_PROTO
-void UxFreeClientDataCB( _wgt, client_data, _call_data )
- Widget _wgt;
- XtPointer client_data, _call_data;
-#else
-void UxFreeClientDataCB( Widget _wgt, XtPointer client_data,
- XtPointer _call_data )
-#endif
-{
- if (client_data != NULL)
- XtFree((char *) client_data);
-}
-
-/******************************************************************************
-NAME: UxLoadResources( fname )
-
-INPUT: char *fname - name of resource file
-
-RETURN: void
-
-DESCRIPTION: This function is provided as a stub function to load the
- resource file that was generated by the C Code Generator
- into the current toolkit resource database.
- A call to this function is automatically generated with the
- appropriate resource filename when resources are set to Public.
-
-CREATION: Visual Edge Software April 6 1991
------------------------------------------------------------------------------*/
-#ifdef _NO_PROTO
-void UxLoadResources( _fname )
- char *_fname;
-#else
-void UxLoadResources( char *_fname )
-#endif
-{
-}
-
-/******************************************************************************
-NAME: UxConvertFontList( fontlist_str )
-
-INPUT: char *fontlist_str - string form of fontlist
-
-RETURN: XmFontList - fontlist
-
-DESCRIPTION: Converts a fontlist from the resource-file string format
- to the XmFontList type expected in C code.
- The conversion is done by a call to the built-in Motif convertor
- and the return value points into Xt's resource cache
- and so the return value should NOT be XmFontListFree'd.
-
-CREATION: Visual Edge Software June 17 1992
------------------------------------------------------------------------------*/
-#ifdef _NO_PROTO
-XmFontList UxConvertFontList( fontlist_str )
- char *fontlist_str;
-#else
-XmFontList UxConvertFontList( char *fontlist_str )
-#endif
-{
- XrmValue from, to;
- XmFontList fontlist = NULL;
-
- from.size = strlen( fontlist_str ) + 1;
- from.addr = fontlist_str;
-
- to.size = sizeof(XmFontList);
- to.addr = (caddr_t) &fontlist;
-
- XtConvertAndStore( UxTopLevel,
- XmRString, &from,
- XmRFontList, &to );
-
- return ( fontlist );
-}
-
-/******************************************************************************
-NAME: UxConvertValueWcs( value_str )
-
-INPUT: char *value_str - multi-byte (mbs) form of
- wide-character string (wcs)
-
-RETURN: wchar_t * - wide-character string
-
-DESCRIPTION: Convert a multibyte string to a wide character string
- The memory allocated for the return value is maintained
- until the next call to this function.
-
-CREATION: Visual Edge Software March 31, 1993
------------------------------------------------------------------------------*/
-#ifdef _NO_PROTO
-wchar_t * UxConvertValueWcs( value_str )
- char *value_str;
-#else
-wchar_t * UxConvertValueWcs( char *value_str )
-#endif
-{
- static wchar_t *wcs = NULL;
- int maxlen;
-
- if (!value_str) {
- return ((wchar_t*)0);
- }
-
- maxlen = strlen(value_str) + 1;
- wcs = (wchar_t *)UxRealloc(wcs,maxlen * sizeof(wchar_t));
- if (mbstowcs(wcs, value_str, maxlen) == (size_t)-1) {
- return ((wchar_t*)0);
- }
-
- return(wcs);
-}
-
-#if 0
-
-/******************************************************************************
-NAME: static ConvertPixmap( file_name, depth )
-
-INPUT: char *file_name - Pixmap file name
- int depth - 0 for no depth specified
-
-RETURN: Pixmap
-
-DESCRIPTION: If the depth argument is 0 , then call XmGetPixmap (no depth
- argument). Otherwise, call XmGetPixmapByDepth (with depth as
- specified by the argument).
- Since there is no way of knowing how long the Pixmaps will be
- used, they are never destroyed. This is not a serious problem
- since XmGetPixmap does not regenerate existing Pixmaps.
- It simply keeps a reference count for the number of times a
- Pixmap is returned.
-
-CREATION: Visual Edge Software March 31, 1993
------------------------------------------------------------------------------*/
-#ifdef _NO_PROTO
-static Pixmap ConvertPixmap( file_name, depth )
- char *file_name;
- int depth;
-#else
-static Pixmap ConvertPixmap( char *file_name, int depth )
-#endif
-{
- XrmValue fg_from, fg_to, bg_from, bg_to;
- Pixel fg, bg;
-
- fg_from.size = strlen(XtDefaultForeground);
- fg_from.addr = XtDefaultForeground;
- fg_to.addr = (XPointer)&fg;
- bg_from.size = strlen(XtDefaultBackground);
- bg_from.addr = XtDefaultBackground;
- bg_to.addr = (XPointer)&bg;
- if (!XtConvertAndStore
- (UxTopLevel, XtRString, &bg_from, XtRPixel, &bg_to)
- || !XtConvertAndStore
- (UxTopLevel, XtRString, &fg_from, XtRPixel, &fg_to)
- || (fg == bg)) {
- fg = WhitePixelOfScreen(XtScreen(UxTopLevel));
- bg = BlackPixelOfScreen(XtScreen(UxTopLevel));
- }
- if (depth)
- return (XmGetPixmapByDepth
- (XtScreen(UxTopLevel), file_name, fg, bg, depth));
-
- else
- return (XmGetPixmap(XtScreen(UxTopLevel), file_name, fg, bg));
-}
-
-/******************************************************************************
-NAME: UxConvert_bitmap( file_name )
-
-INPUT: char *file_name - bitmap file name
-
-RETURN: Pixmap - Pixmap of depth 1
-
-DESCRIPTION: Call ConvertPixmap with depth 1 (bitmap)
-
-CREATION: Visual Edge Software March 31, 1993
------------------------------------------------------------------------------*/
-#ifdef _NO_PROTO
-Pixmap UxConvert_bitmap( file_name )
- char *file_name;
-#else
-Pixmap UxConvert_bitmap( char *file_name )
-#endif
-{
- return (ConvertPixmap(file_name, 1));
-}
-
-/******************************************************************************
-NAME: UxConvertPixmap( file_name )
-
-INPUT: char *file_name - pixmap file name
-
-RETURN: Pixmap - Pixmap
-
-DESCRIPTION: Call ConvertPixmap with depth 0 (Pixmap)
-
-CREATION: Visual Edge Software March 31, 1993
------------------------------------------------------------------------------*/
-#ifdef _NO_PROTO
-Pixmap UxConvertPixmap( file_name )
- char *file_name;
-#else
-Pixmap UxConvertPixmap( char *file_name )
-#endif
-{
- return (ConvertPixmap(file_name, 0));
-}
-
-#endif
-
-/***************************************************************************
-NAME: UxRemoveValueFromArgList( args, ptr_num_args, res_name )
-INPUT: Arg *args : array of Arg's
- String res_name : name of resource
-INPUT & OUTPUT: Cardinal *ptr_num_args : number of Arg's
-RETURN: XtArgVal : value of resource
-DESCRIPTION: Searches for the named resource in the array of Arg's.
- If found, the corresponding element is removed from the array,
- the number of Arg's is decremented, and the resource value
- is returned.
- If the named resource is not found, the return value is zero.
-EXT REFERENCES: ---
-EXT EFFECTS: ---
-CREATION: Nov 27/92
-
----------------------------------------------------------------------------*/
-#ifdef _NO_PROTO
-XtArgVal UxRemoveValueFromArgList( args, ptr_num_args, res_name )
- Arg *args;
- Cardinal *ptr_num_args;
- String res_name;
-#else
-XtArgVal UxRemoveValueFromArgList( Arg *args, Cardinal *ptr_num_args,
- String res_name )
-#endif
-{
- Cardinal i, num_args;
-
- num_args = *ptr_num_args;
-
- for (i = 0; i < num_args; i++)
- {
- if ( ! strcmp( args[i].name, res_name ) )
- {
- Cardinal j;
- XtArgVal res_value = args[i].value;
-
- /* We remove this arg from the array by moving
- the remaining args down one in the array
- and decreasng the arg count */
-
- --num_args;
- for (j = i; j < num_args; j++)
- args[j] = args[j + 1];
-
- *ptr_num_args = num_args;
- return ( res_value );
- }
- }
-
- return ( (XtArgVal) 0 );
-}
-
-/*------------------------------------------------------------------------
- * NAME: UxNewContext
- * <Allocate a context structure>
- * INPUT: size -- of the desired structure
- * isSubclass -- nonzero if the requester is a subclass,
- * requiring that the result also be
- * returned for the base.
- * RETURNS: Pointer to a data area of (at least) the desired size.
- *------------------------------------------------------------------------*/
-#ifdef _NO_PROTO
-void* UxNewContext (size, isSubclass)
- size_t size;
- int isSubclass;
-#else
-void* UxNewContext (size_t size, int isSubclass)
-#endif /* _NO_PROTO */
-{
- static void* LastSubclassResult = 0;
- static int LastResultSize = 0;
-
- void * result;
-
- if (LastSubclassResult) {
- result = LastSubclassResult;
- } else {
- result = XtMalloc(size);
- }
-
- if (isSubclass) {
- LastSubclassResult = result;
- if (LastResultSize < size) {
- LastResultSize = size;
- }
- } else {
- LastSubclassResult = 0;
- LastResultSize = 0;
- }
-
- return (result);
-}
-/** end of file ***/
diff --git a/src/packlib/kuip/code_motif/mkdcmp.c b/src/packlib/kuip/code_motif/mkdcmp.c
deleted file mode 100644
index 185257f..0000000
--- a/src/packlib/kuip/code_motif/mkdcmp.c
+++ /dev/null
@@ -1,1947 +0,0 @@
-/*
- * $Id: mkdcmp.c,v 1.2 1996/03/15 15:54:00 cremel Exp $
- *
- * $Log: mkdcmp.c,v $
- * Revision 1.2 1996/03/15 15:54:00 cremel
- * In the command panels add quotes in text when they are missing (call to
- * "quote_string").
- *
- * Revision 1.1.1.1 1996/03/08 15:33:07 mclareni
- * Kuip
- *
- */
-/*CMZ : 2.07/03 09/05/95 11.54.43 by N.Cremel*/
-/*-- Author : N.Cremel 10/08/92*/
-/******************************************************************************/
-/* */
-/* MOTIF-based library for KUIP - deck MKDCMP */
-/* */
-/* Basic Interface for any "KUIP Command Panels " (Menu "Commands") */
-/* (connected to the file //KUIP/XMCLIB/KUXCMP for building the */
-/* panels with Architect : "create_kuipCommand"). */
-/* */
-/******************************************************************************/
-#include "kuip/kuip.h"
-#include "kuip/kfor.h"
-#include "kuip/kmenu.h"
-#include "kuip/kflag.h"
-
-#include <stdio.h>
-#include <string.h>
-
-/* Global SEQUENCES (defined in MKCDES) */
-#include "mkincl.h"
-#include "mkdims.h"
-#include "kuip/mkutfu.h"
-#include "mkutfm.h"
-#include "mkutdm.h"
-#define CONTEXT_MACRO_ACCESS 1
-#include "mkuxcm.h"
-#include "mkuxol.h"
-#include "mkuxfs.h"
-#undef CONTEXT_MACRO_ACCESS
-#include "mksres.h"
-#include "mksreg.h"
-
-/***********************************************************************
- * *
- * Local datas. *
- * *
- ***********************************************************************/
-
-static int WM_x = 0; /* width of Window Manager decoration */
-static int WM_y = 0; /* height of Window Manager decoration */
-
-int kuipFilSel_width = 300; /* from kuipFilSel.c generated by Architect */
-int kuipOptList_width = 200; /* from kuipOptList.c generated by Architect */
-
-/******************************************************************************/
-/* external definition */
-/******************************************************************************/
-extern int do_exec;
-
-/* structure definition */
-typedef struct {
- Widget command_panel;
- Widget command_panel_form;
- KmCommand *cmd;
- int error;
-/* int flag; */
- } CP_str; /* tag structure for CPCallback */
-
-typedef struct {
- Widget command_panel;
- Widget swidget;
- KmCommand *cmd;
- int index;
- } SC_str; /* tag structure for SCale (set_cmdScale...) */
-
-
-typedef struct {
- Widget command_panel;
- char *opt_val;
- int index;
- } OP_str; /* tag structure for OPtion menu (set_cmdOpt) */
-
-
-
-#define MAX_CMD_PANEL 10
-#define TEXT_PAR 0
-#define SCALI_PAR 1
-#define SCALR_PAR 2
-#define OPT_PAR 3
-#define FILE_PAR 4
-
-
-/* local data */
-typedef struct {
- int swpar; /* number of parameters */
- Widget widget; /* command panel dialog shell */
- Widget form; /* command panel form container */
- Widget scmenu; /* scale option : DRAG or VALUE CHANGED */
- Widget swtext[MAX_parm]; /* text for parameter entry */
- Widget swspecific[MAX_parm]; /* can be scale, option-menu, ... */
- Widget swtoggle[MAX_parm];
-} CmdpanelStruct; /* Retrieve values with get_cp_context */
-
-static CmdpanelStruct Str_cmdpanel[MAX_CMD_PANEL];
-static int n_cmdpanel = 0;
-static Widget CPWform, CPWscmenu;
-static Widget CPWtext[MAX_parm], CPWspecific[MAX_parm], CPWtoggle[MAX_parm];
-static int CPWpar ;
-
-static Widget opt_list = NULL;
-
-Widget km_fil_sel = NULL;
-
-/***********************************************************************
- * *
- * Forward declarations of global functions. *
- * *
- ***********************************************************************/
-
-C_PROTO_3(void km_clFCallback,
- Widget widget,
- caddr_t tag,
- XmAnyCallbackStruct *data);
-
-
-/***********************************************************************
- * *
- * Forward declarations of local functions. *
- * *
- ***********************************************************************/
-
-static C_PROTO_1(int get_cp_context,
- Widget w);
-static C_PROTO_3(void okCPCallback,
- Widget widget,
- caddr_t tag,
- XmAnyCallbackStruct *data);
-static C_PROTO_3(void executeCPCallback,
- Widget widget,
- CP_str *stag,
- XmAnyCallbackStruct *data);
-static C_PROTO_3(void resetCPCallback,
- Widget widget,
- caddr_t tag,
- XmAnyCallbackStruct *data);
-static C_PROTO_3(void cancelCPCallback,
- Widget widget,
- caddr_t tag,
- XmAnyCallbackStruct *data);
-static C_PROTO_3(void helpCPCallback,
- Widget widget,
- caddr_t tag,
- XmAnyCallbackStruct *data);
-static C_PROTO_3(void set_cmdScaleInt,
- Widget widget,
- caddr_t tag,
- XmScaleCallbackStruct *scale);
-static C_PROTO_3(void set_cmdScaleReal,
- Widget widget,
- caddr_t tag,
- XmScaleCallbackStruct *scale);
-static C_PROTO_3(void set_cmdOpt,
- Widget widget,
- caddr_t tag,
- XmAnyCallbackStruct *data);
-static C_PROTO_3(void set_filSel,
- Widget widget,
- caddr_t tag,
- XmAnyCallbackStruct *data);
-static C_PROTO_3(void set_optList,
- Widget widget,
- caddr_t tag,
- XmAnyCallbackStruct *data);
-static C_PROTO_3(void okFCallback,
- Widget widget,
- int tag,
- XmFileSelectionBoxCallbackStruct *data);
-static C_PROTO_3(void okLCallback,
- Widget widget,
- caddr_t tag,
- XmAnyCallbackStruct *data);
-static C_PROTO_3(void clLCallback,
- Widget widget,
- caddr_t tag,
- XmAnyCallbackStruct *data);
-static C_PROTO_3(void reset_grab,
- Widget widget,
- int *grab,
- XmAnyCallbackStruct *data);
-static C_PROTO_3(char *execute_command,
- Widget panel,
- Widget panel_form,
- KmCommand *cmd);
-static C_PROTO_1(void destroy_panel,
- Widget panel);
-#if 0
-static C_PROTO_3(void focus_cmdpan,
- Widget widget,
- caddr_t tag,
- XEnterWindowEvent *ev);
-#endif
-
-
-/***********************************************************************
- * *
- * Forward declarations of extern functions. *
- * *
- ***********************************************************************/
-extern C_PROTO_0(Widget create_kuipCommand);
-extern C_PROTO_0(Widget create_kuipOptList);
-
-
-/******************************************************************************/
-/* int km_display_cmdpan (cmd, msg, flag) */
-/* */
-/* input : */
-/* */
-/* int flag : 0 ---> no grab */
-/* 1 ---> grab (wait for OK or CANCEL) */
-/* 2 ---> set/reset panel to default values */
-/******************************************************************************/
-int km_display_cmdpan( cmd, msg, flag )
- KmCommand *cmd;
- char *msg;
- int flag;
-{
- Widget kuipCommandPanel;
- Widget kuipCommandForm; /* form container for ALL parameters */
- Widget parentCommandForm, BottomSep;
- Widget kuipCommand_title;
- Widget subw_form[MAX_parm+1]; /* form container for EACH parameter */
- Widget subw_id1[MAX_parm];
- Widget subw_id2[MAX_parm];
- Widget subw_id3[MAX_parm];
- Widget ScaleOpt_form;
- Widget ScaleOpt_menu_shell;
- Widget ScaleOpt_menu = 0;
- Widget ScaleOpt_menu_p;
- Widget opt_menu, opt_menu_b[MAX_opt+1], opt_menu_bhis;
-
-
- char cnam[MAX_string], cnam1[MAX_string];
- char title[MAX_string];
- char prstring[MAX_string];
- char *instring;
- char message[MAX_stringl];
-
- double rlow;
- double rhigh;
- double rval;
-
- int pcode[MAX_parm+1];
- int idef;
- int ilow;
- int ihigh;
- int decimal;
- int i;
- int j;
- int cmdpanel = 0;
- Dimension fheight, fh, fw;
-
- Boolean no_action;
- Boolean do_scale;
-
- static CP_str CP_tag[MAX_CMD_PANEL];
- static SC_str SC_tag[MAX_CMD_PANEL][MAX_parm+1];
- static OP_str OP_tag[MAX_CMD_PANEL][MAX_parm+1][MAX_opt];
- static int grab;
-
-
- no_action = False;
- if( cmd->action_F == NULL && cmd->action_C == NULL )
- no_action = True;
- if( no_action ) {
- char cval[MAX_stringl];
-
- /* No action routine for this command : execute Help */
- sprintf( cval, "/KUIP/HELP %s", cmd->name );
- exec_cmd_string( cval, 0, NULL );
- return 1;
- }
-
- if( n_cmdpanel >= MAX_CMD_PANEL ) {
- km_warn_user( km_toplevel, "Cannot Open More Command Panels !", " \n \
- Warning :\n \
- _________\n\n \
- too many command panels have been created. To continue,\n \
- first press OK in the Warning Box and then erase some \n \
- command panels (Cancel button) !" );
-
- return 1;
- }
-
-
- /* Create Command Panel widget (with Architect) */
- kuipCommandPanel = create_kuipCommand();
-
-
- /*
- * find and restore the context
- * (to get to the widgets belonging to this dialog)
- */
- UxKuipCommandPContext = (_UxCkuipCommandP *)UxGetContext( kuipCommandPanel );
-
-
- /* Loop on all parameters to set values of pcode (type) and do_scale */
- do_scale = False;
- for( i = 0; i < cmd->total; i++ ) {
- KmParameter *par = cmd->par[i];
- KmParInt *pint = par->ptype;
- KmParReal *preal = par->ptype;
-
- if( i > MAX_parm ) {
- sprintf( message, "Maximum number of parameters for command panel is %d",
- MAX_parm );
- km_print_box( km_toplevel, km_xcur_pos, km_ycur_pos, message, 4 );
- break;
- }
-
- /* for all types : if range defined then create an "option menu" */
- if( par->range_count != 0 )
- pcode[i] = OPT_PAR;
- else
- pcode[i] = TEXT_PAR;
-
- switch( par->type ) {
-
- case KmTYPE_CHAR:
- break;
-
- case KmTYPE_FILE:
- pcode[i] = FILE_PAR;
- break;
-
- case KmTYPE_OPTION:
- break;
-
- case KmTYPE_INT:
- if( pint != NULL
- && pint->slider_lower != NULL && pint->slider_upper != NULL ) {
- do_scale = True;
- pcode[i] = SCALI_PAR;
- }
- break;
-
- case KmTYPE_REAL:
- if( preal != NULL
- && preal->slider_lower != NULL && preal->slider_upper != NULL ) {
- do_scale = True;
- pcode[i] = SCALR_PAR;
- }
- break;
-
- } /* end ... switch( par->type ) */
-
- } /* end ... for( i = 0; i < cmd->total; i++ ) */
-
-
- /* Set "Scale behavior" menu if necessary */
- if( do_scale ) {
- ScaleOpt_form = XtVaCreateManagedWidget( "ScaleOpt_form",
- xmFormWidgetClass, kuipCommandPanel,
- XmNrightOffset, 15,
- XmNrightAttachment, XmATTACH_FORM,
- XmNleftOffset, 15,
- XmNleftAttachment, XmATTACH_FORM,
- XmNbottomWidget, commandSep,
- XmNbottomAttachment, XmATTACH_WIDGET,
- XmNheight, 60,
- XmNresizePolicy, XmRESIZE_NONE,
- NULL );
- ScaleOpt_menu_shell = XtVaCreatePopupShell ("ScaleOpt_menu_shell",
- xmMenuShellWidgetClass, ScaleOpt_form,
- XmNwidth, 1,
- XmNheight, 1,
- XmNallowShellResize, TRUE,
- XmNoverrideRedirect, TRUE,
- NULL );
- ScaleOpt_menu_p = XtVaCreateWidget( "ScaleOpt_menu_p",
- xmRowColumnWidgetClass, ScaleOpt_menu_shell,
- XmNrowColumnType, XmMENU_PULLDOWN,
- NULL );
- XtVaCreateManagedWidget( "ScaleOpt_menu_b1",
- xmPushButtonGadgetClass, ScaleOpt_menu_p,
- RES_CONVERT( XmNlabelString, "VALUE_CHANGED" ),
- NULL );
- XtVaCreateManagedWidget( "ScaleOpt_menu_b2",
- xmPushButtonGadgetClass, ScaleOpt_menu_p,
- RES_CONVERT( XmNlabelString, "DRAG" ),
- NULL );
- ScaleOpt_menu = XtVaCreateManagedWidget( "ScaleOpt_menu",
- xmRowColumnWidgetClass, ScaleOpt_form,
- XmNtopOffset, 0,
- XmNtopAttachment, XmATTACH_FORM,
- XmNmarginHeight, 20,
- XmNleftOffset, 0,
- XmNleftAttachment, XmATTACH_FORM,
- XmNbottomOffset, 0,
- XmNbottomAttachment, XmATTACH_FORM,
- RES_CONVERT( XmNlabelString, "Scale behavior >" ),
- XmNsubMenuId, ScaleOpt_menu_p,
- XmNnavigationType, XmEXCLUSIVE_TAB_GROUP,
- XmNrowColumnType, XmMENU_OPTION,
- NULL );
- } /* end ... if( do_scale ) */
-
- /* Create scrollwindow and form container for all parameters */
- if ( strncmp (srec.scrolled_cmdpanel, "always", 6) == 0 ||
- (cmd->total > 10 && strncmp (srec.scrolled_cmdpanel, "auto", 4) == 0) )
- {
- /* if more that 10 parms. fix the height & width and put a scroll window */
- parentCommandForm = XtVaCreateWidget( "parentCommandForm",
- xmScrolledWindowWidgetClass,
- kuipCommandPanel,
- XmNwidth, 500,
- XmNtopOffset, 20,
- XmNtopAttachment, XmATTACH_FORM,
- XmNrightOffset, 20,
- XmNrightAttachment, XmATTACH_FORM,
- XmNleftOffset, 30,
- XmNleftAttachment, XmATTACH_FORM,
- XmNbottomAttachment, XmATTACH_WIDGET,
- XmNscrollingPolicy, XmAUTOMATIC,
- NULL );
- if (cmd->total > 5) XtVaSetValues (parentCommandForm, XmNheight, 300, NULL);
- } else
- /* otherwise no scroll window */
- parentCommandForm = XtVaCreateWidget( "parentCommandForm",
- xmScrolledWindowWidgetClass,
- kuipCommandPanel,
- XmNtopOffset, 20,
- XmNtopAttachment, XmATTACH_FORM,
- XmNrightOffset, 20,
- XmNrightAttachment, XmATTACH_FORM,
- XmNleftOffset, 30,
- XmNleftAttachment, XmATTACH_FORM,
- XmNbottomAttachment, XmATTACH_WIDGET,
- XmNvisualPolicy, XmVARIABLE,
- NULL );
- kuipCommandForm = XtVaCreateWidget( "kuipCommandForm",
- xmFormWidgetClass, parentCommandForm,
- NULL );
-
-
- /* Fill CP_tag structure for callbacks */
- for( i = 0; i < MAX_CMD_PANEL; i++ ) {
- if( !CP_tag[i].command_panel ) {
- cmdpanel = i;
- break;
- }
- }
- CP_tag[cmdpanel].command_panel = kuipCommandPanel;
- CP_tag[cmdpanel].command_panel_form = kuipCommandForm;
- CP_tag[cmdpanel].cmd = cmd;
- CP_tag[cmdpanel].error = 0;
-/* CP_tag[cmdpanel].flag = flag; */
-
-
- /* Set various attributes */
- XtVaSetValues( kuipCommandPanel,
- XmNautoUnmanage, False,
- NULL );
- if( flag == 1)
- XtVaSetValues( kuipCommandPanel,
- XmNautoUnmanage, False,
- XmNdialogStyle, XmDIALOG_FULL_APPLICATION_MODAL,
- NULL );
- if (srec.center_command != 1)
- XtVaSetValues( kuipCommandPanel,
- XmNdefaultPosition, False,
- NULL );
- else /* centerCommand: True (= 1) */
- XtVaSetValues( kuipCommandPanel,
- XmNdefaultPosition, True,
- NULL );
-
-
- if( cmd->total == 0 ) {
-
- /* Special case : cmd->total = 0 (no parameters: terminal command) */
-
- sprintf( message, "No parameters. Terminal Command : %s", cmd->path );
- subw_form[0] = XtVaCreateManagedWidget( "subwForm0",
- xmFormWidgetClass, kuipCommandForm,
- XmNtopOffset, 20,
- XmNtopAttachment, XmATTACH_FORM,
- XmNrightOffset, 15,
- XmNrightAttachment, XmATTACH_FORM,
- XmNleftOffset, 15,
- XmNleftAttachment, XmATTACH_FORM,
- XmNbottomOffset, 20,
- XmNbottomAttachment, XmATTACH_FORM,
- XmNheight, 40,
- XmNresizePolicy, XmRESIZE_NONE,
- NULL );
- XtVaCreateManagedWidget("subw_lab",
- xmLabelWidgetClass, subw_form[0],
- XmNtopOffset, 0,
- XmNtopAttachment, XmATTACH_FORM,
- XmNleftOffset, 0,
- XmNleftAttachment, XmATTACH_FORM,
- XmNbottomOffset, 0,
- XmNbottomAttachment, XmATTACH_FORM,
- RES_CONVERT( XmNlabelString, message ),
- NULL );
- } else {
-
- /*
- * Loop on all parameters and create children of popup_dialog_box
- * by using specific widgets (according to pcode) for each parameter
- * (text, scale, option menu, ...)
- */
- for( i = 0; i < cmd->total; i++ ) {
- KmParameter *par = cmd->par[i];
- KmParInt *pint = par->ptype;
- KmParReal *preal = par->ptype;
-
- if( i > MAX_parm ) {
- sprintf( message, "Maximum number of parameters for command panel is %d",
- MAX_parm );
- km_print_box( km_toplevel, km_xcur_pos, km_ycur_pos, message, 4 );
- break;
- }
-
- /* Set prompt string for each parameters (with parameter names prstring) */
- if( i < cmd->mandatory ) {
- /* mandatory parameter */
- strcpy( prstring, par->prompt );
- } else {
- strcpy( prstring, "[" );
- strcat( prstring, par->prompt );
- strcat( prstring, "]" );
- }
-
- /* get initial string (to be written in text widget) */
- if (flag == 2) {
- /* Take default values if any */
- if( par->dfault != NULL )
- instring = par->dfault;
- else
- instring = "";
- } else {
- /* Take last value first (if any) to fill the corresponding field */
- if( i < cmd->argc && cmd->argv[i] != NULL )
- instring = cmd->argv[i];
- else if( par->last != NULL )
- instring = par->last;
- else if( par->dfault != NULL )
- instring = par->dfault;
- else
- instring = "";
- if (cmd->argc > cmd->total) {
- /* real number of args. in command line is greater than expected:
- take all remaining args. (rest of argline) for the last one.
- (e.g. commands SHELL ..., MESSAGE ...).
- */
- instring = cmd->argline + cmd->argoffs[i];
- }
- }
-
-
- /* Create form container for each parameter */
- switch( pcode[i] ) {
- /* Size of form depends on parameter type */
- case TEXT_PAR:
- case FILE_PAR:
- case OPT_PAR:
- fheight = 40;
- break ;
-
- case SCALI_PAR:
- case SCALR_PAR:
- default:
- fheight = 60;
- break ;
- } /* end ... switch( pcode[i] ) */
- sprintf( cnam, "subwForm%d", i + 1 );
- if (i == 0) { /* First parameter */
- subw_form[i] = XtVaCreateManagedWidget( cnam,
- xmFormWidgetClass, kuipCommandForm,
- XmNtopOffset, 20,
- XmNtopAttachment, XmATTACH_FORM,
- XmNrightOffset, 15,
- XmNrightAttachment, XmATTACH_FORM,
- XmNleftOffset, 15,
- XmNleftAttachment, XmATTACH_FORM,
- XmNheight, fheight,
- XmNresizePolicy, XmRESIZE_NONE,
- NULL );
- } else {
- subw_form[i] = XtVaCreateManagedWidget( cnam,
- xmFormWidgetClass, kuipCommandForm,
- XmNtopWidget, subw_form[i-1],
- XmNtopAttachment, XmATTACH_WIDGET,
- XmNrightOffset, 15,
- XmNrightAttachment, XmATTACH_FORM,
- XmNleftOffset, 15,
- XmNleftAttachment, XmATTACH_FORM,
- XmNheight, fheight,
- XmNresizePolicy, XmRESIZE_NONE,
- NULL );
- } /* end ... if (i == 0) */
-
- /* For last parameter : create dummy form for attachments */
- if (i == cmd->total-1) {
- sprintf( cnam, "subwForm%d", i + 2 );
- subw_form[i+1] = XtVaCreateManagedWidget( cnam,
- xmFormWidgetClass, kuipCommandForm,
- XmNtopWidget, subw_form[i],
- XmNtopAttachment, XmATTACH_WIDGET,
- XmNrightOffset, 15,
- XmNrightAttachment, XmATTACH_FORM,
- XmNleftOffset, 15,
- XmNleftAttachment, XmATTACH_FORM,
- XmNbottomOffset, 20,
- XmNbottomAttachment, XmATTACH_FORM,
- XmNresizePolicy, XmRESIZE_NONE,
- NULL );
- } /* end ... if (i == cmd->total-1) */
-
-
- switch( pcode[i] ) {
- /* Represents each parameter type with sub_widgets */
-
- case TEXT_PAR: /* label + small text window for string or integer value */
- case FILE_PAR:
-
- strcat( prstring, " > " );
- sprintf (cnam, "cmdLab%d",i+1);
- subw_id1[i] = XtVaCreateManagedWidget(cnam,
- xmLabelWidgetClass, subw_form[i],
- XmNtopOffset, 0,
- XmNtopAttachment, XmATTACH_FORM,
- XmNleftOffset, 0,
- XmNleftAttachment, XmATTACH_FORM,
- XmNbottomOffset, 0,
- XmNbottomAttachment, XmATTACH_FORM,
- RES_CONVERT( XmNlabelString, prstring ),
- XmNnavigationType, XmNONE,
- NULL );
- if ( pcode[i] == FILE_PAR) { /* provide button for file selection box */
- /* Button "Select" */
- sprintf (cnam, "cmdLabSel%d",i+1);
- subw_id3[i] = XtVaCreateManagedWidget( cnam,
- xmPushButtonGadgetClass, subw_form[i],
- XmNtopOffset, 5,
- XmNtopAttachment, XmATTACH_FORM,
- XmNleftWidget, subw_id1[i],
- XmNleftOffset, 5,
- XmNleftAttachment, XmATTACH_WIDGET,
- RES_CONVERT( XmNlabelString, " Select " ),
- XmNbottomOffset, 5,
- XmNbottomAttachment, XmATTACH_FORM,
- NULL );
- SC_tag[cmdpanel][i].command_panel = kuipCommandPanel;
- SC_tag[cmdpanel][i].cmd = cmd;
- SC_tag[cmdpanel][i].index = i;
- XtAddCallback( subw_id3[i], XmNactivateCallback,
- (XtCallbackProc)set_filSel, &SC_tag[cmdpanel][i] );
- }
- sprintf (cnam, "cmdText%d",i+1);
- subw_id2[i] = XtVaCreateManagedWidget( cnam,
- xmTextWidgetClass, subw_form[i],
- XmNtopOffset, 5,
- XmNtopAttachment, XmATTACH_FORM,
- XmNrightOffset, 0,
- XmNrightAttachment, XmATTACH_FORM,
- XmNleftAttachment, XmATTACH_WIDGET,
- XmNbottomOffset, 5,
- XmNbottomAttachment, XmATTACH_FORM,
- XmNvalue, instring,
- XmNnavigationType, XmEXCLUSIVE_TAB_GROUP,
- XmNmarginHeight, 2,
- NULL );
-
- if ( pcode[i] == FILE_PAR) {
- /* Set left attachement to "Select" button for command-text */
- XtVaSetValues( subw_id2[i], XmNleftWidget, subw_id3[i],
- XmNleftOffset, 5,
- NULL );
- } else {
- /* Set left attachement to label for command-text */
- XtVaSetValues( subw_id2[i], XmNleftWidget, subw_id1[i],
- NULL );
- }
-#if OLD_TAB
- XmAddTabGroup( subw_id2[i] );
- XtOverrideTranslations( subw_id2[i],
- XtParseTranslationTable( "<Key>Down:next-tab-group()" ) );
-#endif
-
- break ;
-
-
- case SCALI_PAR: /* Scale widget for integer value + toggle + text */
-
- /* integer scale */
- ilow = atoi( pint->slider_lower );
- ihigh = atoi( pint->slider_upper );
- if( instring[0] == '\0' )
- idef = ilow;
- else
- idef = atoi( instring );
- sprintf( cnam, "cmdScale%d", i + 1 );
- subw_id1[i] = XtVaCreateManagedWidget( cnam,
- xmScaleWidgetClass, subw_form[i],
- XmNrightPosition, 60,
- XmNrightAttachment, XmATTACH_POSITION,
- XmNtopOffset, 0,
- XmNtopAttachment, XmATTACH_FORM,
- XmNleftOffset, 0,
- XmNleftAttachment, XmATTACH_FORM,
- XmNbottomOffset, 0,
- XmNbottomAttachment, XmATTACH_FORM,
- RES_CONVERT( XmNtitleString, prstring ),
- XmNshowValue, TRUE,
- XmNorientation, XmHORIZONTAL,
- XmNvalue, idef,
- XmNminimum, ilow,
- XmNmaximum, ihigh,
- XmNnavigationType, XmEXCLUSIVE_TAB_GROUP,
- NULL );
-
- /* toggle button */
- sprintf( cnam, "cmdScaleToggle%d", i + 1 );
- subw_id3[i] = XtVaCreateManagedWidget( cnam,
- xmToggleButtonGadgetClass, subw_form[i],
- RES_CONVERT( XmNlabelString, "" ),
- XmNtopOffset, 0,
- XmNtopAttachment, XmATTACH_FORM,
- XmNleftWidget, subw_id1[i],
- XmNleftAttachment, XmATTACH_WIDGET,
- XmNbottomOffset, 0,
- XmNbottomAttachment, XmATTACH_FORM,
- XmNnavigationType, XmEXCLUSIVE_TAB_GROUP,
- NULL );
-
- /* text window */
- sprintf (cnam, "cmdText%d",i+1);
- subw_id2[i] = XtVaCreateManagedWidget( cnam,
- xmTextWidgetClass, subw_form[i],
- XmNleftWidget, subw_id3[i],
- XmNleftAttachment, XmATTACH_WIDGET,
- XmNtopOffset, 15,
- XmNtopAttachment, XmATTACH_FORM,
- XmNrightOffset, 0,
- XmNrightAttachment, XmATTACH_FORM,
- XmNbottomOffset, 15,
- XmNbottomAttachment, XmATTACH_FORM,
- XmNvalue, instring,
- XmNnavigationType, XmEXCLUSIVE_TAB_GROUP,
- NULL );
-
- /* Add callbacks on scale */
- SC_tag[cmdpanel][i].command_panel = kuipCommandPanel;
- SC_tag[cmdpanel][i].cmd = cmd;
- SC_tag[cmdpanel][i].index = i;
- XtAddCallback( subw_id1[i], XmNvalueChangedCallback,
- (XtCallbackProc)set_cmdScaleInt, &SC_tag[cmdpanel][i] );
- XtAddCallback( subw_id1[i], XmNdragCallback,
- (XtCallbackProc)set_cmdScaleInt, &SC_tag[cmdpanel][i] );
-#if OLD_TAB
- XmAddTabGroup( subw_id2[i] );
- XtOverrideTranslations( subw_id2[i],
- XtParseTranslationTable( "<Key>Down:next-tab-group()" ) );
- XmAddTabGroup( subw_id1[i] );
- XtOverrideTranslations( subw_id1[i],
- XtParseTranslationTable( "<Key>Down:ManagerGadgetNextTabGroup()" ) );
-#endif
-
- break ;
-
-
- case SCALR_PAR: /* Scale widget for real value + toggle + text */
-
- /* real scale */
- rlow = atof( preal->slider_lower );
- rhigh = atof( preal->slider_upper );
- /* get value to take for decimal attribute in scale */
- if( instring[0] == '\0' )
- rval = rlow;
- else
- rval = atof( instring );
- for( decimal = 0; decimal < preal->decimals; decimal++ ) {
- rval *= 10;
- rlow *= 10;
- rhigh *= 10;
- }
- rval += (rval > 0) ? 0.5 : -0.5;
- rlow += (rlow > 0) ? 0.5 : -0.5;
- rhigh += (rhigh > 0) ? 0.5 : -0.5;
- sprintf( cnam, "cmdScale%d", i + 1 );
- subw_id1[i] = XtVaCreateManagedWidget( cnam,
- xmScaleWidgetClass, subw_form[i],
- XmNrightPosition, 60,
- XmNrightAttachment, XmATTACH_POSITION,
- XmNtopOffset, 0,
- XmNtopAttachment, XmATTACH_FORM,
- XmNleftOffset, 0,
- XmNleftAttachment, XmATTACH_FORM,
- XmNbottomOffset, 0,
- XmNbottomAttachment, XmATTACH_FORM,
- RES_CONVERT( XmNtitleString, prstring ),
- XmNshowValue, TRUE,
- XmNorientation, XmHORIZONTAL,
- XmNvalue, (int)rval,
- XmNminimum, (int)rlow,
- XmNmaximum, (int)rhigh,
- XmNdecimalPoints, decimal,
- XmNnavigationType, XmEXCLUSIVE_TAB_GROUP,
- NULL );
-
- /* toggle button */
- sprintf( cnam, "cmdScaleToggle%d", i + 1 );
- subw_id3[i] = XtVaCreateManagedWidget( cnam,
- xmToggleButtonGadgetClass, subw_form[i],
- RES_CONVERT( XmNlabelString, "" ),
- XmNtopOffset, 0,
- XmNtopAttachment, XmATTACH_FORM,
- XmNleftWidget, subw_id1[i],
- XmNleftAttachment, XmATTACH_WIDGET,
- XmNbottomOffset, 0,
- XmNbottomAttachment, XmATTACH_FORM,
- XmNnavigationType, XmEXCLUSIVE_TAB_GROUP,
- NULL );
-
- /* text window */
- sprintf (cnam, "cmdText%d",i+1);
- subw_id2[i] = XtVaCreateManagedWidget( cnam,
- xmTextWidgetClass, subw_form[i],
- XmNleftWidget, subw_id3[i],
- XmNleftAttachment, XmATTACH_WIDGET,
- XmNtopOffset, 15,
- XmNtopAttachment, XmATTACH_FORM,
- XmNrightOffset, 0,
- XmNrightAttachment, XmATTACH_FORM,
- XmNbottomOffset, 15,
- XmNbottomAttachment, XmATTACH_FORM,
- XmNvalue, instring,
- XmNnavigationType, XmEXCLUSIVE_TAB_GROUP,
- NULL );
-
- /* Add Callbacks on scale */
- SC_tag[cmdpanel][i].command_panel = kuipCommandPanel;
- SC_tag[cmdpanel][i].cmd = cmd;
- SC_tag[cmdpanel][i].index = i;
- XtAddCallback( subw_id1[i], XmNvalueChangedCallback,
- (XtCallbackProc)set_cmdScaleReal, &SC_tag[cmdpanel][i]);
- XtAddCallback( subw_id1[i], XmNdragCallback,
- (XtCallbackProc)set_cmdScaleReal, &SC_tag[cmdpanel][i]);
-
-#if OLD_TAB
- XmAddTabGroup( subw_id2[i] );
- XtOverrideTranslations( subw_id2[i],
- XtParseTranslationTable( "<Key>Down:next-tab-group()" ) );
- XmAddTabGroup( subw_id1[i] );
- XtOverrideTranslations( subw_id1[i],
- XtParseTranslationTable( "<Key>Down:ManagerGadgetNextTabGroup()" ) );
-#endif
-
- break ;
-
-
- case OPT_PAR: /* option menu + small text window */
-
- /* text window */
- sprintf (cnam, "cmdText%d",i+1);
- subw_id2[i] = XtVaCreateManagedWidget( cnam,
- xmTextWidgetClass, subw_form[i],
- XmNtopOffset, 5,
- XmNtopAttachment, XmATTACH_FORM,
- XmNrightOffset, 0,
- XmNrightAttachment, XmATTACH_FORM,
- XmNbottomOffset, 5,
- XmNbottomAttachment, XmATTACH_FORM,
- XmNnavigationType, XmEXCLUSIVE_TAB_GROUP,
- XmNvalue, instring,
- NULL );
-
- /* option menu */
- opt_menu = XtVaCreatePopupShell ("opt_menu",
- xmMenuShellWidgetClass, subw_form[i],
- XmNwidth, 1,
- XmNheight, 1,
- XmNallowShellResize, TRUE,
- XmNoverrideRedirect, TRUE,
- NULL );
- sprintf( cnam, "cmdPMenu%d", i + 1 );
- opt_menu_b[0] = XtVaCreateWidget( cnam,
- xmRowColumnWidgetClass, opt_menu,
- XmNrowColumnType, XmMENU_PULLDOWN,
- NULL );
- /* create push-buttons of the option menu */
- opt_menu_bhis = NULL;
- for( j = 0; j < par->range_count; j++ ) {
- char stext[MAX_stringl];
-
- if (j > MAX_opt) {
- static int ifirst = 0;
-
- if (ifirst == 0) {
- char cval[MAX_string];
-
- ifirst = 1;
- sprintf (cval,
-"This is just a warning: \n \
-______________________\n\n \
-(N.B. display only once ...)\n\n \
-Maximum number of options \n \
-in an OPT parameter is : %d.\n \n \
-Try to contact the application programmer,\n\
-who should correct this problem.\n", MAX_opt);
- km_warn_user(km_toplevel, cval, "");
- } /* end ...(ifirst == 0) */
- break;
- }
- strcpy (stext, par->range_value[j]);
-
- sprintf( cnam1, "%s_b%d", cnam, j + 1 );
- opt_menu_b[j+1] = XtVaCreateManagedWidget( cnam1,
- xmPushButtonGadgetClass, opt_menu_b[0],
- RES_CONVERT( XmNlabelString, stext ),
- NULL );
-
- /* get default push button if any */
- if( instring != NULL && par->range_value[j] != NULL) {
- char *tmp1 = km_strip( par->range_value[j] );
- char *tmp2 = km_strip( instring );
-
- if( strcmp( tmp1, tmp2 ) == 0 ) {
- opt_menu_bhis = opt_menu_b[j+1];
- }
- free (tmp1);
- free (tmp2);
- } /* end ... if( instring != NULL ...) */
- /* Add Callbacks to each button */
- OP_tag[cmdpanel][i][j].command_panel = kuipCommandPanel;
- OP_tag[cmdpanel][i][j].index = i;
- OP_tag[cmdpanel][i][j].opt_val = XtMalloc( MAX_string );
- if( par->range_value[j] != NULL )
- strcpy( OP_tag[cmdpanel][i][j].opt_val, par->range_value[j]);
- else
- strcpy( OP_tag[cmdpanel][i][j].opt_val, " " );
- XtAddCallback( opt_menu_b[j+1], XmNactivateCallback,
- (XtCallbackProc)set_cmdOpt, &OP_tag[cmdpanel][i][j] );
- } /* end ... for( j = 0; j < par->range_count; j++ ) */
- /* create option menu widget */
- sprintf( cnam, "cmdOption%d", i + 1 );
- strcat( prstring, " > " );
- if( opt_menu_bhis != NULL ) {
- subw_id1[i] = XtVaCreateManagedWidget( cnam,
- xmRowColumnWidgetClass, subw_form[i],
- XmNmarginHeight, 5,
- XmNtopOffset, 0,
- XmNtopAttachment, XmATTACH_FORM,
- XmNleftOffset, 0,
- XmNleftAttachment, XmATTACH_FORM,
- XmNbottomOffset, 0,
- XmNbottomAttachment, XmATTACH_FORM,
- RES_CONVERT( XmNlabelString, prstring ),
- XmNsubMenuId, opt_menu_b[0],
- XmNrowColumnType, XmMENU_OPTION,
- XmNmenuHistory, opt_menu_bhis,
- XmNnavigationType, XmEXCLUSIVE_TAB_GROUP,
- NULL );
- } else {
- subw_id1[i] = XtVaCreateManagedWidget( cnam,
- xmRowColumnWidgetClass, subw_form[i],
- XmNmarginHeight, 5,
- XmNtopOffset, 0,
- XmNtopAttachment, XmATTACH_FORM,
- XmNleftOffset, 0,
- XmNleftAttachment, XmATTACH_FORM,
- XmNbottomOffset, 0,
- XmNbottomAttachment, XmATTACH_FORM,
- RES_CONVERT( XmNlabelString, prstring ),
- XmNsubMenuId, opt_menu_b[0],
- XmNrowColumnType, XmMENU_OPTION,
- XmNnavigationType, XmEXCLUSIVE_TAB_GROUP,
- NULL );
- } /* end ... if( idbhis != NULL ) */
-
- /* Button "List" */
- sprintf (cnam, "optList%d",i+1);
- subw_id3[i] = XtVaCreateManagedWidget( cnam,
- xmPushButtonGadgetClass, subw_form[i],
- XmNtopOffset, 5,
- XmNtopAttachment, XmATTACH_FORM,
- XmNheight, 30,
- XmNleftWidget, subw_id1[i],
- XmNleftOffset, 5,
- XmNleftAttachment, XmATTACH_WIDGET,
- RES_CONVERT( XmNlabelString, " List " ),
- XmNbottomOffset, 5,
- XmNbottomAttachment, XmATTACH_FORM,
- NULL );
- SC_tag[cmdpanel][i].command_panel = kuipCommandPanel;
- SC_tag[cmdpanel][i].cmd = cmd;
- SC_tag[cmdpanel][i].index = i;
- XtAddCallback( subw_id3[i], XmNactivateCallback,
- (XtCallbackProc)set_optList, &SC_tag[cmdpanel][i] );
-
-
- /* Set left attachement to "List" button for command-text */
- XtVaSetValues( subw_id2[i], XmNleftAttachment, XmATTACH_WIDGET,
- XmNleftOffset, 5,
- XmNleftWidget, subw_id3[i],
- NULL );
-
-#if OLD_TAB
- XmAddTabGroup( subw_id2[i] );
- XtOverrideTranslations( subw_id2[i],
- XtParseTranslationTable( "<Key>Down:next-tab-group()" ) );
- XmAddTabGroup( subw_id1[i] );
- XtOverrideTranslations( subw_id1[i],
- XtParseTranslationTable( "<Key>Down:ManagerGadgetNextTabGroup()" ) );
-#endif
-
- break ;
-
- } /* end ... switch( pcode[i] ) */
-
- } /* end ... for( i = 0; i < cmd->total; i++ ) */
-
- } /* end ... if( cmd->total == 0 ) */
-
- /* Layout with label "Command Parameters" */
- kuipCommand_title = XtVaCreateManagedWidget( "kuipCommand_title",
- xmLabelGadgetClass, kuipCommandPanel,
- XmNtopOffset, 0,
- XmNtopAttachment, XmATTACH_FORM,
- XmNmarginWidth, 0,
- XmNrecomputeSize, TRUE,
- RES_CONVERT( XmNlabelString, " Command Parameters " ),
- XmNheight, 20,
- XmNy, 0,
- XmNx, 10,
- NULL );
-
- XtVaCreateManagedWidget( "UpperLeftSep",
- xmSeparatorGadgetClass, kuipCommandPanel,
- XmNtopOffset, 10,
- XmNtopAttachment, XmATTACH_FORM,
- XmNrightWidget, kuipCommand_title,
- XmNrightOffset, 0,
- XmNrightAttachment, XmATTACH_WIDGET,
- XmNleftOffset, 10,
- XmNleftAttachment, XmATTACH_FORM,
- XmNheight, 2,
- NULL );
-
- XtVaCreateManagedWidget( "UpperRightSep",
- xmSeparatorGadgetClass, kuipCommandPanel,
- XmNtopOffset, 10,
- XmNtopAttachment, XmATTACH_FORM,
- XmNrightOffset, 10,
- XmNrightAttachment, XmATTACH_FORM,
- XmNleftWidget, kuipCommand_title,
- XmNleftOffset, 0,
- XmNleftAttachment, XmATTACH_WIDGET,
- XmNheight, 2,
- NULL );
-
- if (do_scale)
- BottomSep = XtVaCreateManagedWidget( "BottomSep",
- xmSeparatorGadgetClass, kuipCommandPanel,
- XmNrightOffset, 10,
- XmNrightAttachment, XmATTACH_FORM,
- XmNleftOffset, 10,
- XmNleftAttachment, XmATTACH_FORM,
- XmNbottomAttachment, XmATTACH_WIDGET,
- XmNbottomWidget, ScaleOpt_form,
- XmNheight, 2,
- NULL );
- else
- BottomSep = XtVaCreateManagedWidget( "BottomSep",
- xmSeparatorGadgetClass, kuipCommandPanel,
- XmNrightOffset, 10,
- XmNrightAttachment, XmATTACH_FORM,
- XmNleftOffset, 10,
- XmNleftAttachment, XmATTACH_FORM,
- XmNbottomAttachment, XmATTACH_WIDGET,
- XmNbottomWidget, commandSep,
- XmNheight, 2,
- NULL );
- XtVaSetValues ( parentCommandForm, XmNbottomWidget, BottomSep,
- XmNbottomOffset, 10, NULL );
-
- if (do_scale)
- XtVaCreateManagedWidget( "LeftSep",
- xmSeparatorGadgetClass, kuipCommandPanel,
- XmNwidth, 2,
- XmNtopOffset, 11,
- XmNtopAttachment, XmATTACH_FORM,
- XmNleftOffset, 10,
- XmNleftAttachment, XmATTACH_FORM,
- XmNbottomAttachment, XmATTACH_WIDGET,
- XmNbottomWidget, ScaleOpt_form,
- XmNorientation, XmVERTICAL,
- NULL );
- else
- XtVaCreateManagedWidget( "LeftSep",
- xmSeparatorGadgetClass, kuipCommandPanel,
- XmNwidth, 2,
- XmNtopOffset, 11,
- XmNtopAttachment, XmATTACH_FORM,
- XmNleftOffset, 10,
- XmNleftAttachment, XmATTACH_FORM,
- XmNbottomAttachment, XmATTACH_WIDGET,
- XmNbottomWidget, commandSep,
- XmNorientation, XmVERTICAL,
- NULL );
-
-
- if (do_scale)
- XtVaCreateManagedWidget( "RightSep",
- xmSeparatorGadgetClass, kuipCommandPanel,
- XmNwidth, 2,
- XmNtopOffset, 11,
- XmNtopAttachment, XmATTACH_FORM,
- XmNrightOffset, 10,
- XmNrightAttachment, XmATTACH_FORM,
- XmNbottomAttachment, XmATTACH_WIDGET,
- XmNbottomWidget, ScaleOpt_form,
- XmNorientation, XmVERTICAL,
- NULL );
- else
- XtVaCreateManagedWidget( "RightSep",
- xmSeparatorGadgetClass, kuipCommandPanel,
- XmNwidth, 2,
- XmNtopOffset, 11,
- XmNtopAttachment, XmATTACH_FORM,
- XmNrightOffset, 10,
- XmNrightAttachment, XmATTACH_FORM,
- XmNbottomAttachment, XmATTACH_WIDGET,
- XmNbottomWidget, commandSep,
- XmNorientation, XmVERTICAL,
- NULL );
-
-
- /* Set default button (for CR) */
- if( do_exec )
- XtVaSetValues( kuipCommandPanel, XmNdefaultButton, km_cmdOK, NULL );
-
-
- /* Set button sensitivity */
- if( flag == 1) {
- XtSetSensitive( km_cmdEX, False );
- XtSetSensitive( km_cmdRE, False );
- XtSetSensitive( km_cmdHE, False );
- }
-
-
- /*
- * install callbacks on command panel buttons
- */
- grab = 0;
- XtAddCallback( km_cmdOK, XmNactivateCallback,
- (XtCallbackProc)okCPCallback, &CP_tag[cmdpanel] );
- XtAddCallback( km_cmdOK, XmNactivateCallback,
- (XtCallbackProc)reset_grab, &grab );
- XtAddCallback( km_cmdEX, XmNactivateCallback,
- (XtCallbackProc)executeCPCallback, &CP_tag[cmdpanel] );
- XtAddCallback( km_cmdRE, XmNactivateCallback,
- (XtCallbackProc)resetCPCallback, &CP_tag[cmdpanel] );
- XtAddCallback( km_cmdCA, XmNactivateCallback,
- (XtCallbackProc)cancelCPCallback, &CP_tag[cmdpanel] );
- XtAddCallback( km_cmdCA, XmNactivateCallback,
- (XtCallbackProc)reset_grab, &grab );
- XtAddCallback( km_cmdHE, XmNactivateCallback,
- (XtCallbackProc)helpCPCallback, &CP_tag[cmdpanel] );
-
-#if 0
- XtAddEventHandler(kuipCommandPanel, FocusChangeMask, False,
- (XtEventHandler)focus_cmdpan, NULL);
-#endif
-
- km_MwmCloseCallback( XtParent( kuipCommandPanel ),
- (XtCallbackProc)cancelCPCallback,
- (XtPointer)&CP_tag[cmdpanel] );
-
-
- /* Set position and title */
- sprintf( title, "%s Command %s", class_name, cmd->path );
- XtVaSetValues(XtParent(kuipCommandPanel),
- XmNtitle, title,
- XmNkeyboardFocusPolicy, XmEXPLICIT,
- NULL);
- if (srec.center_command == 0)
- XtVaSetValues(XtParent(kuipCommandPanel),
- XmNx, km_xcur_pos, XmNy, km_ycur_pos,
- NULL);
- else if (srec.center_command == -1) /* position (0,0) */
- XtVaSetValues(XtParent(kuipCommandPanel), XmNx, 0, XmNy, 0, NULL);
-
-
- km_store_appShell (kuipCommandPanel, title);
-
- /* Display command panel */
- XtManageChild ( kuipCommandForm );
- XtManageChild ( parentCommandForm );
- UxPopupInterface( kuipCommandPanel, XtGrabNone );
-
- /* Reset position if it goes outside the screen */
- XtVaGetValues( XtParent( kuipCommandPanel ),
- XmNwidth, &fw, XmNheight, &fh,
- NULL);
- if( (int) (km_xcur_pos + fw + 5) > UxScreenWidth )
- km_xcur_pos = UxScreenWidth - fw -5;
- if( (int) (km_ycur_pos + fh + 30) > UxScreenHeight )
- km_ycur_pos = UxScreenHeight - fh - 30;
- if (srec.center_command == 0)
- XtVaSetValues(XtParent(kuipCommandPanel),
- XmNx, km_xcur_pos, XmNy, km_ycur_pos,
- NULL);
- else if (srec.center_command == -1) /* position (0,0) */
- XtVaSetValues(XtParent(kuipCommandPanel), XmNx, 0, XmNy, 0, NULL);
-
-
- /* Store values for get_cp_context */
- n_cmdpanel++;
- for (i = 0; i < MAX_CMD_PANEL; i++) {
- if (!Str_cmdpanel[i].widget) {
- Str_cmdpanel[i].widget = kuipCommandPanel;
- Str_cmdpanel[i].form = kuipCommandForm;
- Str_cmdpanel[i].swpar = cmd->total;
- if (do_scale) Str_cmdpanel[i].scmenu = ScaleOpt_menu;
- for (j = 0; j < cmd->total; j++) {
- Str_cmdpanel[i].swtext[j] = subw_id2[j];
- Str_cmdpanel[i].swspecific[j] = subw_id1[j];
- Str_cmdpanel[i].swtoggle[j] = subw_id3[j];
- }
- break;
- }
- }
-
-
-
- if( flag == 1 ) {
- /* Grab interface */
- while( grab == 0 ) {
- XtAppProcessEvent( UxAppContext, XtIMAll );
- XSync( XtDisplay( kuipCommandPanel ), 0 );
- }
- }
-
- /*
- * CP_tag.error can be modified by OK callback (when grabbing)
- * cancel --> return NULL
- */
- return CP_tag[cmdpanel].error;
-}
-
-/***********************************************************************
- * *
- * Get the context for kuipCommandPanel widget. *
- * *
- ***********************************************************************/
-static int get_cp_context(w)
- Widget w;
-{
- int i, j;
-
- if (!w) return -2;
-
- /*
- * find and restore the context
- * (to get to the widgets belonging to this dialog)
- */
- UxKuipCommandPContext = (_UxCkuipCommandP *)UxGetContext( w );
-
-
- /* restore the other widgets by hand (not in Architect context) */
- for (i = 0; i < MAX_CMD_PANEL; i++) {
- if (Str_cmdpanel[i].widget == w) {
- CPWpar = Str_cmdpanel[i].swpar;
- CPWform = Str_cmdpanel[i].form;
- CPWscmenu = Str_cmdpanel[i].scmenu;
- for (j = 0; j < CPWpar; j++) {
- CPWtext[j] = Str_cmdpanel[i].swtext[j];
- CPWspecific[j] = Str_cmdpanel[i].swspecific[j];
- CPWtoggle[j] = Str_cmdpanel[i].swtoggle[j];
- }
- return i;
- }
- }
- return -1;
-}
-
-
-static void okCPCallback( widget, tag, data )
- Widget widget;
- caddr_t tag;
- XmAnyCallbackStruct *data;
-{
- CP_str *stag = (CP_str *) tag;
- KmCommand *cmd = stag->cmd;
- char *cmd_string = execute_command
- ( stag->command_panel, stag->command_panel_form, cmd );
-
- destroy_panel (stag->command_panel);
- stag->command_panel = NULL;
-
- if (opt_list != NULL) XtDestroyWidget (XtParent(opt_list));
- opt_list = NULL;
-
- if (km_fil_sel != NULL) XtDestroyWidget (XtParent(km_fil_sel));
- km_fil_sel = NULL;
-
- ku_exec( cmd_string );
- free( cmd_string );
-
- /* Set flag for updating browsers */
- km_reset_allbrowser(True);
-}
-
-static void executeCPCallback( widget, stag, data )
- Widget widget;
- CP_str *stag;
- XmAnyCallbackStruct *data;
-{
- KmCommand *cmd = stag->cmd;
- char *cmd_string = execute_command
- ( stag->command_panel, stag->command_panel_form, cmd );
-
- ku_exec( cmd_string );
- free( cmd_string );
-
- /* Set flag for updating browsers */
- km_reset_allbrowser(True);
-}
-
-static void resetCPCallback( widget, tag, data )
- Widget widget;
- caddr_t tag;
- XmAnyCallbackStruct *data;
-{
- CP_str *stag = (CP_str *) tag;
- KmCommand *cmd = stag->cmd;
- Widget cpanel = stag->command_panel;
- int irep;
-
- char *select[] = {
- "... last execution values",
- "... default value",
- NULL };
-
-
- irep = km_toggle_selection ("Reset to ...", select, 1);
- if (irep <= 0) return;
-
- XtVaGetValues( XtParent(cpanel),
- XmNx, &km_xcur_pos, XmNy, &km_ycur_pos,
- NULL);
- destroy_panel (stag->command_panel);
- stag->command_panel = NULL;
- if (irep == 1) {
- reset_arg_list( cmd );
- km_display_cmdpan (cmd, NULL, 0 );
- } else if (irep == 2) {
- km_display_cmdpan (cmd, NULL, 2 );
- }
-}
-
-static void cancelCPCallback( widget, tag, data )
- Widget widget;
- caddr_t tag;
- XmAnyCallbackStruct *data;
-{
- CP_str *stag = (CP_str *) tag;
-
- destroy_panel (stag->command_panel);
- stag->command_panel = NULL;
- stag->error = 1;
-
- if (opt_list != NULL) XtDestroyWidget (XtParent(opt_list));
- opt_list = NULL;
-
- if (km_fil_sel != NULL) XtDestroyWidget (XtParent(km_fil_sel));
- km_fil_sel = NULL;
-}
-
-static void helpCPCallback( widget, tag, data )
- Widget widget;
- caddr_t tag;
- XmAnyCallbackStruct *data;
-{
- Position xr, yr;
-
- CP_str *stag = (CP_str *) tag;
-
- char *helptext = fmt_cmd_help( stag->cmd, 0 );
- km_get_curpos (data->event,&xr,&yr);
- km_display_sctext (stag->cmd->path, helptext, xr, yr, 1);
- free( helptext );
-}
-
-/*
- * Set scale value (integer) for "valueChanged"
- */
-static void set_cmdScaleInt( widget, tag, scale )
- Widget widget;
- caddr_t tag;
- XmScaleCallbackStruct *scale;
-{
- int scale_reason = scale->reason;
- int scale_value = scale->value;
- char *text_data = NULL;
- char cval[MAX_string];
- Boolean do_exec;
- Widget pbhis;
- XmString string_data;
-
- SC_str *stag = (SC_str *) tag;
- Widget cpanel = stag->command_panel;
- KmCommand *cmd = stag->cmd;
- int npar = stag->index;
-
- get_cp_context ( cpanel );
-
-
-/* Get value for scale behavior : VALUE_CHANGED or DRAG */
- XtVaGetValues( CPWscmenu, XmNmenuHistory, &pbhis, NULL);
- XtVaGetValues( pbhis, XmNlabelString, &string_data, NULL);
- XmStringGetLtoR(string_data, km_charset, &text_data);
- XmStringFree (string_data);
- if (text_data == NULL) {
- XtFree (text_data);
- return; }
- /* If callback reason is DRAG but flag set to VALUE_CHANGED do nothing */
- if (scale_reason == XmCR_DRAG)
- if (strcmp(text_data,"VALUE_CHANGED") == 0) {
- XtFree (text_data);
- return; }
-
-/* Set text in small text window associated to scale */
- sprintf (cval, "%d", scale_value);
- XmTextSetString(CPWtext[npar], cval);
-
- do_exec = XmToggleButtonGetState (CPWtoggle[npar]);
- if (do_exec) {
- char *cmd_string = execute_command ( cpanel, CPWform, cmd );
-
- ku_exec( cmd_string );
- free( cmd_string );
- km_reset_allbrowser(True);
- }
-
-}
-
-/*
- * Set scale value (real) for "valueChanged"
- */
-static void set_cmdScaleReal( widget, tag, scale )
- Widget widget;
- caddr_t tag;
- XmScaleCallbackStruct *scale;
-{
- int scale_reason = scale->reason;
- int scale_value = scale->value;
- char *text_data = NULL;
- double scale_fvalue;
- short scale_decimal;
- Boolean do_exec;
- int k;
- Widget pbhis;
- XmString string_data;
-
- SC_str *stag = (SC_str *) tag;
- Widget cpanel = stag->command_panel;
- KmCommand *cmd = stag->cmd;
- int npar = stag->index;
-
- get_cp_context ( cpanel );
-
-
-/* Get value for scale behavior : VALUE_CHANGED or DRAG */
- XtVaGetValues( CPWscmenu, XmNmenuHistory, &pbhis, NULL);
- XtVaGetValues( pbhis, XmNlabelString, &string_data, NULL);
- XmStringGetLtoR(string_data, km_charset, &text_data);
- XmStringFree (string_data);
- if (text_data == NULL) {
- XtFree (text_data);
- return; }
- /* If callback reason is DRAG but flag set to VALUE_CHANGED do nothing */
- if (scale_reason == XmCR_DRAG)
- if (strcmp(text_data,"VALUE_CHANGED") == 0) {
- XtFree (text_data);
- return; }
-
- scale_fvalue = scale_value;
-
- XtVaGetValues( widget, XmNdecimalPoints, &scale_decimal, NULL);
- for (k = 0; k < scale_decimal; k++)
- scale_fvalue *= 0.1;
-
-
-/* Set text in small text window associated to scale */
- XmTextSetString(CPWtext[npar], strfromd( scale_fvalue, 6 ) );
-
- do_exec = XmToggleButtonGetState (CPWtoggle[npar]);
- if (do_exec) {
- char *cmd_string = execute_command ( cpanel, CPWform, cmd );
-
- ku_exec( cmd_string );
- free( cmd_string );
- km_reset_allbrowser(True);
- }
-}
-
-/*
- * Set option value (char) for "activate"
- */
-static void set_cmdOpt( widget, tag, data )
- Widget widget;
- caddr_t tag;
- XmAnyCallbackStruct *data;
-{
- OP_str *stag = (OP_str *) tag;
- Widget cpanel = stag->command_panel;
- int npar = stag->index;
-
- get_cp_context ( cpanel );
-
-/* Set text in small text window associated to option menu */
- XmTextSetString(CPWtext[npar],stag->opt_val);
-}
-
-/*
- * Show file selection box
- */
-static void set_filSel( widget, tag, data )
- Widget widget;
- caddr_t tag;
- XmAnyCallbackStruct *data;
-{
- SC_str *stag = (SC_str *) tag;
-
- Widget cpanel = stag->command_panel;
- KmCommand *cmd = stag->cmd;
- int ipar = stag->index;
- KmParameter *par = cmd->par[ipar];
- KmParFile *pfil = par->ptype;
-
- char title[MAX_stringl];
- char *filter = NULL;
- Position xp, yp;
- Dimension wp;
-
- char *help = (char *) "File Selection Box : \n\
-\n\
-Select a file and press the \"OK\" button. \n\
-\n\
-You can change the \"Filter\" entry. (This \n\
-can be done either by selecting a sub-directory\n\
-in the list \"Directories\" or by entering\n\
-a new directory path in the \"Filter\" text\n\
-field. In both cases the operation is validated\n\
-by pressing the button \"Filter\"). \n\
-\n\
-Then, you can select a new file name\n\
-in that new directory (just select the \n\
-correcponding item in list \"Files\") \n\
-\n\
-To validate your selection you have to press the \n\
-\"OK\" button. By pressing \"Cancel\" you can destroy \n\
-(erase from the screen) the FileSelectionBox without\n\
-making any selection.";
-
- get_cp_context ( cpanel );
-
- if (km_fil_sel != NULL) XtDestroyWidget (XtParent(km_fil_sel));
- km_fil_sel = NULL;
-
- km_fil_sel = create_kuipFilSel (NULL);
- sprintf( title, "%s : %s >", cmd->path, par->prompt );
- XtVaSetValues ( XtParent(km_fil_sel),
- XmNtitle, title,
- XmNdefaultPosition, False,
- XmNautoUnmanage, False, NULL);
-
- /*
- * find and restore the context
- * (to get to the widgets belonging to this dialog)
- */
- UxKuipFilSelContext = (_UxCkuipFilSel *)UxGetContext( km_fil_sel );
-
- /* set filter and directory */
- if (pfil->filter_default != NULL) {
- char *p;
-
- filter = strdup (pfil->filter_default);
- XtVaSetValues ( km_FilSel,
- RES_CONVERT( XmNpattern, filter ),
- NULL);
- p = strrchr (filter, '/');
- if (p != NULL) {
- p[1] = '\0';
- XtVaSetValues ( km_FilSel,
- RES_CONVERT( XmNdirectory, filter ),
- NULL);
- }
- }
-
- if (par->dfault != NULL) {
- Widget listw;
- XmStringTable xmstr_list;
- int nc, l;
-
- filter = mstrcat (filter, par->dfault);
- listw = XmSelectionBoxGetChild( km_FilSel, XmDIALOG_LIST);
- XtVaGetValues ( listw, XmNitems, &xmstr_list,
- XmNitemCount, &nc,
- NULL);
- for (l = 0; l< nc; l++) {
- char *item;
-
- XmStringGetLtoR(xmstr_list[l], km_charset, &item);
- if (strcmp (item, filter) == 0) {
- XmListSelectItem ( listw, xmstr_list[l], True);
- }
- XtFree (item);
- }
- }
- if (filter != NULL) free (filter);
-
- /* calculate position */
- XtVaGetValues( XtParent(cpanel), XmNx, &xp, XmNy, &yp, XmNwidth, &wp, NULL);
-
- if ( (int) (xp+wp+kuipFilSel_width+10) < UxScreenWidth )
- XtVaSetValues ( XtParent(km_fil_sel),
- XmNx, xp+wp+10, XmNy, yp - WM_y, NULL);
- else
- XtVaSetValues ( XtParent(km_fil_sel),
- XmNx, xp-kuipFilSel_width-20, XmNy, yp - WM_y, NULL);
-
- /* Display FileSelectionBox */
- UxPopupInterface( km_fil_sel, XtGrabNone );
-
- XtAddCallback( km_FilSel, XmNhelpCallback,
- (XtCallbackProc)km_help_activate, (XtPointer)help );
-
- XtAddCallback( km_FilSel, XmNokCallback,
- (XtCallbackProc)okFCallback, (XtPointer)ipar );
- XtAddCallback( km_FilSel, XmNcancelCallback,
- (XtCallbackProc)km_clFCallback, NULL );
-
-}
-
-/*
- * Show list of options
- */
-static void set_optList( widget, tag, data )
- Widget widget;
- caddr_t tag;
- XmAnyCallbackStruct *data;
-{
- SC_str *stag = (SC_str *) tag;
- Widget cpanel = stag->command_panel;
- KmCommand *cmd = stag->cmd;
- int ipar = stag->index;
- KmParameter *par = cmd->par[ipar];
- KmParOption *popt = par->ptype;
-
- char title[MAX_stringl];
- Position xp, yp;
- Dimension wp;
- int j;
-
- static SC_str OL_tag;
-
- get_cp_context ( cpanel );
-
-
- if (opt_list != NULL) XtDestroyWidget (XtParent(opt_list));
- opt_list = NULL;
-
- opt_list = create_kuipOptList();
- sprintf( title, "%s : %s >", cmd->path, par->prompt );
- XtVaSetValues ( XtParent(opt_list),
- XmNtitle, title,
- XmNdefaultPosition, False,
- XmNautoUnmanage, False, NULL);
-
- /*
- * find and restore the context
- * (to get to the widgets belonging to this dialog)
- */
- UxKuipOptListContext = (_UxCkuipOptList *)UxGetContext( opt_list );
-
- for( j = 0; j < par->range_count; j++ ) {
- XmString xmstr;
- char *sopt = NULL;
- if( popt != NULL && popt->text[j] != NULL ) {
- if (par->range_value[j] != NULL ) {
- sopt = str3dup (par->range_value[j], " : ", popt->text[j]);
- xmstr = XmStringCreate(sopt, XmSTRING_DEFAULT_CHARSET);
- } else
- xmstr = XmStringCreate(popt->text[j], XmSTRING_DEFAULT_CHARSET);
- } else if (par->range_value[j] != NULL )
- xmstr = XmStringCreate(par->range_value[j], XmSTRING_DEFAULT_CHARSET);
- else
- xmstr = XmStringCreate(" ", XmSTRING_DEFAULT_CHARSET);
- XmListAddItem(OptList, xmstr, 0);
- XmStringFree(xmstr);
- if (sopt != NULL) free (sopt);
- } /* end for ... */
-
- /* calculate position */
- XtVaGetValues( XtParent(cpanel), XmNx, &xp, XmNy, &yp, XmNwidth, &wp, NULL);
-
- if ( (int) (xp+wp+kuipOptList_width+10) < UxScreenWidth )
- XtVaSetValues ( XtParent(opt_list),
- XmNx, xp+wp+10, XmNy, yp - WM_y, NULL);
- else
- XtVaSetValues ( XtParent(opt_list),
- XmNx, xp-kuipOptList_width-20, XmNy, yp - WM_y, NULL);
-
- /* Display list */
- UxPopupInterface( opt_list, XtGrabNone );
-
- OL_tag.command_panel = cpanel;
- OL_tag.swidget = OptList;
- OL_tag.cmd = cmd;
- OL_tag.index = ipar;
- XtAddCallback( OKButton, XmNactivateCallback,
- (XtCallbackProc)okLCallback, &OL_tag );
- XtAddCallback( CCLButton, XmNactivateCallback,
- (XtCallbackProc)clLCallback, NULL);
-
-}
-
-static void okFCallback( widget, tag, data )
- Widget widget;
- int tag;
- XmFileSelectionBoxCallbackStruct *data;
-{
- int ipar = tag;
- char *file;
-
- /*
- * find and restore the context
- * (to get to the widgets belonging to this dialog)
- */
- UxKuipFilSelContext = (_UxCkuipFilSel *)UxGetContext( widget );
-
- XmStringGetLtoR(data->value, km_charset, &file);
-
- /* Set text in small text window associated to parameter file */
- XmTextSetString(CPWtext[ipar], file);
-
- XtFree (file);
-
- if (km_fil_sel != NULL) XtDestroyWidget (XtParent(km_fil_sel));
- km_fil_sel = NULL;
-}
-
-static void okLCallback( widget, tag, data )
- Widget widget;
- caddr_t tag;
- XmAnyCallbackStruct *data;
-{
- SC_str *ltag = (SC_str *) tag;
- Widget cpanel = ltag->command_panel;
- Widget list = ltag->swidget;
- KmCommand *cmd = ltag->cmd;
- int ipar = ltag->index;
- KmParameter *par = cmd->par[ipar];
-
- char *cval;
- int *pos;
- int i;
-
- int npos = 0;
-
- get_cp_context ( cpanel );
-
- cval = strdup("");
- XmListGetSelectedPos (list , &pos, &npos);
- for (i = 0; i < npos; i++) {
- int j = pos[i] - 1;
- if (par->range_value[j] != NULL )
- cval = mstrcat (cval, par->range_value[j]);
- }
-
- /* Set text in small text window associated to option menu */
- XmTextSetString(CPWtext[ipar], cval);
-
- if (opt_list != NULL) XtDestroyWidget (XtParent(opt_list));
- opt_list = NULL;
-}
-
-
-void km_clFCallback( widget, tag, data )
- Widget widget;
- caddr_t tag;
- XmAnyCallbackStruct *data;
-{
- if (km_fil_sel != NULL) XtDestroyWidget (XtParent(km_fil_sel));
- km_fil_sel = NULL;
-}
-
-static void clLCallback( widget, tag, data )
- Widget widget;
- caddr_t tag;
- XmAnyCallbackStruct *data;
-{
- if (opt_list != NULL) XtDestroyWidget (XtParent(opt_list));
- opt_list = NULL;
-}
-
-/*
- * Reset grab flag
- */
-static void reset_grab( widget, grab, data )
- Widget widget;
- int *grab;
- XmAnyCallbackStruct *data;
-{
- *grab = 1;
-}
-
-static char *execute_command (panel, panel_form, cmd)
- Widget panel, panel_form;
- KmCommand *cmd;
-{
- Cardinal numc, snumc;
- WidgetList child, schild;
- Boolean last = False;
- int i, j, ilen = 0;
-
- char *cmd_string = strdup( cmd->path );
- int argc = 0;
-
-
- /*
- * find and restore the context
- * (to get to the widgets belonging to this dialog)
- */
- get_cp_context ( panel );
-
-
- /* Get all children from Form widget (container for all parameters) */
- XtVaGetValues( panel_form, XmNnumChildren, &numc,
- XmNchildren,&child,
- NULL);
-
- /* Get values of all sub-form widgets subwForm */
- for (i = 0; i < numc; i++) {
- Widget sform = child[i];
- String sform_name = XtName (sform);
-
- if (sform_name != NULL && strncmp(sform_name, "subwForm", 8) == 0) {
-
- /* Get all children from sub-form (container for 1 parameter) */
- XtVaGetValues( sform, XmNnumChildren, &snumc,
- XmNchildren,&schild,
- NULL);
- /* Get values of text widget cmdText (1 for each parameter) */
- for (j = 0; j < snumc; j++) {
- String name = XtName (schild[j]);
-
- if (name != NULL && strncmp(name, "cmdText", 7) == 0) {
- char *text_data = strtrim( XmTextGetString (schild[j]) );
-
- argc++;
- /* if( text_data[0] == '\0' && argc <= cmd->mandatory ) { */
- if( text_data[0] == '\0' ) {
- /* if empty string inside command replace it by ' ' */
- if (!last) {
- last = True;
- ilen = strlen(cmd_string);
- }
- cmd_string = mstrcat( cmd_string, " ' '" );
- } else if( cmd->par[argc-1]->flags & KmFLAG_SEPARATE ) {
- cmd_string = mstr2cat( cmd_string, " ", text_data );
- } else {
- char *p = strdup( text_data );
- char *s = quote_string( p, 1 );
- last = False;
- cmd_string = mstr2cat( cmd_string, " ", s );
- /* cmd_string = mstr2cat( cmd_string, " ", p ); */
- /* free( s ); */
- }
- XtFree (text_data);
- } /* end ... if (name != NULL && strncmp... */
-
- } /* end ... for (j = 0; j < snumc; j++) */
-
- } /* end ... if (sform_name != NULL && strncmp...) */
-
- } /* end ... for (i = 0; i < numc; i++) */
-
- if (last && ilen > 0) cmd_string[ilen] = '\0';
- return cmd_string;
-}
-
-
-static void destroy_panel (panel)
- Widget panel;
-{
- int i;
-
- UxDestroyInterface (panel);
- km_reset_appShell (panel);
-
- n_cmdpanel--;
- for (i = 0; i < MAX_CMD_PANEL; i++) {
- if (Str_cmdpanel[i].widget == panel) {
- Str_cmdpanel[i].widget = (Widget) NULL;
- Str_cmdpanel[i].form = (Widget) NULL;
- Str_cmdpanel[i].swpar = 0;
- Str_cmdpanel[i].scmenu = (Widget) NULL;
- break;
- }
- }
-}
-
-#if 0
-static void focus_cmdpan(widget, tag, ev)
- Widget widget;
- caddr_t tag;
- XEnterWindowEvent *ev;
-{
- char *new_geometry;
- Position xpos, ypos;
- Dimension dh, dw;
- int ih, iw, ix, iy;
-
- static int ifirst = 0;
-
- if (ifirst == 0) {
- /* First time only we get WM decoration size */
- ifirst = 1;
- XtVaGetValues(XtParent(widget), XmNgeometry, &new_geometry,
- XmNx, &xpos, XmNy, &ypos,
- XmNheight, &dh, XmNwidth, &dw,
- NULL);
- sscanf (new_geometry, "%dx%d+%d+%d", &iw, &ih, &ix, &iy);
- WM_x = xpos - ix;
- WM_y = ypos - iy;
- }
-}
-#endif
diff --git a/src/packlib/kuip/code_motif/mkdgra.c b/src/packlib/kuip/code_motif/mkdgra.c
deleted file mode 100644
index 112a572..0000000
--- a/src/packlib/kuip/code_motif/mkdgra.c
+++ /dev/null
@@ -1,733 +0,0 @@
-/*
- * $Id: mkdgra.c,v 1.1.1.1 1996/03/08 15:33:07 mclareni Exp $
- *
- * $Log: mkdgra.c,v $
- * Revision 1.1.1.1 1996/03/08 15:33:07 mclareni
- * Kuip
- *
- */
-/*CMZ : 2.07/02 31/03/95 14.30.02 by N.Cremel*/
-/*-- Author : N.Cremel 08/09/92*/
-/******************************************************************************/
-/* */
-/* MOTIF-based library for KUIP - deck MKDGRA */
-/* */
-/* Basic Interface for any "Graphics Windows" (based on HIGZ) */
-/* (connected to the file //KUIP/XMCLIB/KUXGRA for building the */
-/* window with Architect : "create_kuipGraphics"). */
-/* */
-/* - Set all Event Handlers and call corresponding user defined */
-/* routine. */
-/* */
-/******************************************************************************/
-
-#include "kuip/kuip.h"
-#include "kuip/kfor.h"
-#include "kuip/klink.h"
-#include "kuip/kmenu.h"
-
-#include "mkincl.h"
-#include "mkdims.h"
-#include "mkutfm.h"
-#include "mkutdm.h"
-#include "mksres.h"
-#include "mksreg.h"
-#define CONTEXT_MACRO_ACCESS 1
-#include "mkuxgr.h"
-#undef CONTEXT_MACRO_ACCESS
-#include "kuip/browh1.h"
-#include "browh2.h"
-
-
-#define MAX_GRAPHICS_AREA 5
-
-/* type definitions */
-typedef struct {
- Widget widget; /* graphics area widget itself */
-} GraphicsAreaStruct;
-
-
-/* local data */
-static Widget graph_popup = NULL;
-static GraphicsAreaStruct gr_area[MAX_GRAPHICS_AREA];
-static int n_gr_area = 0;
-
-
-/***********************************************************************
- * *
- * Forward declarations of local functions. *
- * *
- ***********************************************************************/
-
-static C_PROTO_1(int get_ga_context,
- Widget w);
-static C_PROTO_3(void destroy_graphicsArea,
- Widget w,
- Widget graphics,
- XmAnyCallbackStruct *call_data);
-static C_PROTO_3(void drawing_area_callback,
- Widget widget,
- Widget graphics,
- XmDrawingAreaCallbackStruct *call_data);
-static C_PROTO_3(void drawing_area_callback1,
- Widget widget,
- int tag,
- XmDrawingAreaCallbackStruct *call_data);
-static C_PROTO_3(void drawing_area_exr,
- int wid,
- int reason,
- int count);
-static C_PROTO_3(void drawing_area_ew,
- Widget draw_area,
- int tag,
- XEnterWindowEvent *event);
-static C_PROTO_3(void drawing_area_lw,
- Widget draw_area,
- int tag,
- XLeaveWindowEvent *event);
-static C_PROTO_3(void drawing_area_bp,
- Widget draw_area,
- int tag,
- XButtonPressedEvent *event);
-static C_PROTO_3(void drawing_area_br,
- Widget draw_area,
- int tag,
- XButtonReleasedEvent *event);
-static C_PROTO_3(void drawing_area_pm,
- Widget draw_area,
- int tag,
- XPointerMovedEvent *event);
-
-
-/***********************************************************************
- * *
- * Forward declarations of global functions. *
- * *
- ***********************************************************************/
-C_PROTO_5(Window km_graph_open,
- int wkid,
- int x_pos,
- int y_pos,
- int w_dim,
- int h_dim);
-C_PROTO_1(void km_graph_init,
- int wkid);
-C_PROTO_4(void km_graph_init_callbacks,
- Widget draw,
- Widget graph_widget,
- int wkid,
- int flag);
-C_PROTO_1(void km_graph_close,
- int wkid);
-#if 0
-C_PROTO_3(void show_kuipGraphics,
- Widget w,
- Widget clone_parent,
- XmAnyCallbackStruct *call_data);
-#endif
-C_PROTO_0(void km_reset_graph_popup);
-
-
-/***********************************************************************
- * *
- * Forward declarations of extern functions. *
- * *
- ***********************************************************************/
-extern C_PROTO_0 (Widget create_kuipGraphics);
-
-
-/***********************************************************************
- * *
- * Forward declarations of extern functions. *
- * *
- ***********************************************************************/
-extern C_PROTO_3(void popup_activate,
- Widget widget,
- caddr_t tag,
- XmAnyCallbackStruct *call_data);
-
-
-#if 0 /* Only for testing km_graph_open and km_graph_close */
-int kuipgrop( cmd_name )
- char *cmd_name;
-{
- long wkid = ku_geti();
- Window gwin;
-
-printf ("*** kuipgrop : wkid = %d\n",wkid);
- gwin = km_graph_open (wkid, 200, 200, 500, 500);
-}
-
-int kuipgrcl( cmd_name )
- char *cmd_name;
-{
- long wkid = ku_geti();
-
-printf ("*** kuipgrcl : wkid = %d\n",wkid);
- km_graph_close (wkid);
-}
-#endif
-
-
-/***********************************************************************
- * *
- * Creates a Motif (Architect) graphics window (for HIGZ) *
- * and returns the window of the DrawingArea widget. *
- * *
- * int wkid (input) = workstation identifier *
- * *
- ***********************************************************************/
-Window km_graph_open (wkid, x_pos, y_pos, w_dim, h_dim)
- int wkid;
- int x_pos, y_pos;
- int w_dim, h_dim;
-{
- Widget graph_widget;
- char *title;
- char cval[MAX_string];
-
-
- if (n_gr_area >= MAX_GRAPHICS_AREA) {
- km_inform_user
- (gr_area[0].widget, "Cannot open more graphics windows.", "");
- return 0;
- }
-
- /* Create Motif graphics window and store it */
- if (gr_area[wkid-1].widget != NULL) {
- printf ("km_graph_open : workstation %d is already opened\n",wkid);
- return 0; }
- graph_widget = (Widget) create_kuipGraphics();
- gr_area[wkid-1].widget = graph_widget;
- n_gr_area++;
-
- get_ga_context(graph_widget);
-
- /* Set window title */
- title = XtCalloc(MAX_string, 1);
- sprintf(title, "%s Graphics %d", class_name, wkid);
- XtVaSetValues(XtParent(graph_widget), XmNtitle, title,
- XmNiconName, title,
- XmNiconPixmap, km_pixmap,
- XmNdeleteResponse, XmDO_NOTHING,
- NULL);
- XtFree(title);
-
- /* Pass widget ID to application */
- sprintf (cval,"kuipGraphics%d", wkid);
- if( klnkaddr.user_TopWid_C != NULL )
- (*klnkaddr.user_TopWid_C)(cval, graph_widget);
-
- /* Store this window into the list (for raise and iconify) */
- XtVaGetValues(XtParent(graph_widget), XmNtitle, &title, NULL);
- km_store_appShell (graph_widget, title);
-
-#if 0
- km_MwmCloseCallback(XtParent(graph_widget),
- (XtCallbackProc)destroy_graphicsArea,
- (XtPointer)graph_widget);
-
- /* Add drawing area expose and resize callbacks */
- XtAddCallback(km_graphicsDraw, XmNexposeCallback,
- (XtCallbackProc)drawing_area_callback, graph_widget);
- XtAddCallback(km_graphicsDraw, XmNresizeCallback,
- (XtCallbackProc)drawing_area_callback, graph_widget);
-
- /* Add drawing area Event Handler on different kind of events */
- /* EnterWindow */
- XtAddEventHandler(XtParent(graph_widget), EnterWindowMask, False,
- (XtEventHandler)drawing_area_ew, (XtPointer)wkid);
- /* LeaveWindow */
- XtAddEventHandler(XtParent(graph_widget), LeaveWindowMask, False,
- (XtEventHandler)drawing_area_lw, (XtPointer)wkid);
- /* ButtonPress */
- XtAddEventHandler(km_graphicsDraw, ButtonPressMask, False,
- (XtEventHandler)drawing_area_bp, (XtPointer)wkid);
- /* ButtonRelease */
- XtAddEventHandler(km_graphicsDraw, ButtonReleaseMask, False,
- (XtEventHandler)drawing_area_br, (XtPointer)wkid);
- /* PointerMotion */
- XtAddEventHandler(km_graphicsDraw, PointerMotionMask, False,
- (XtEventHandler)drawing_area_pm, (XtPointer)wkid);
-#endif
-
- UxPopupInterface(graph_widget, XtGrabNone);
-
- /* Set window position and dimension */
- if (wkid > 1) {
- /* For wkid = 1 use "kuipGraphics_shell" geometry resource instead */
- XtVaSetValues(XtParent(graph_widget), XmNx, (Position) x_pos,
- XmNy, (Position) y_pos,
- XmNwidth, (Dimension) w_dim,
- XmNheight, (Dimension) h_dim,
- NULL);
- }
-
- km_set_cursor (graph_widget, km_cross_cursor);
-
- return (XtWindow(km_graphicsDraw));
-}
-
-/***********************************************************************
- * *
- * Install callbacks for the graphics window (created for HIGZ) *
- * (This has to be called after the creation of the HIGZ window) *
- * *
- * int wkid (input) = workstation identifier *
- * *
- ***********************************************************************/
-void km_graph_init (wkid)
- int wkid;
-{
- Widget graph_widget = gr_area[wkid-1].widget;
-
- get_ga_context(graph_widget);
-
- km_MwmCloseCallback(XtParent(graph_widget),
- (XtCallbackProc)destroy_graphicsArea,
- (XtPointer)graph_widget);
- km_graph_init_callbacks (km_graphicsDraw, graph_widget, wkid, 0);
-}
-
-void km_graph_init_callbacks (draw, graph_widget, wkid, flag)
- Widget draw, graph_widget;
- int wkid, flag;
-{
- /* Add drawing area expose and resize callbacks */
- if (flag == 0) {
- XtAddCallback(draw, XmNexposeCallback,
- (XtCallbackProc)drawing_area_callback, graph_widget);
- XtAddCallback(draw, XmNresizeCallback,
- (XtCallbackProc)drawing_area_callback, graph_widget);
- } else {
- XtAddCallback(draw, XmNexposeCallback,
- (XtCallbackProc)drawing_area_callback1, (XtPointer)wkid);
- XtAddCallback(draw, XmNresizeCallback,
- (XtCallbackProc)drawing_area_callback1, (XtPointer)wkid);
- }
-
- /* Add drawing area Event Handler on different kind of events */
- /* EnterWindow */
- XtAddEventHandler(XtParent(graph_widget), EnterWindowMask, False,
- (XtEventHandler)drawing_area_ew, (XtPointer)wkid);
- /* LeaveWindow */
- XtAddEventHandler(XtParent(graph_widget), LeaveWindowMask, False,
- (XtEventHandler)drawing_area_lw, (XtPointer)wkid);
-
- /* ButtonPress */
- XtAddEventHandler(draw, ButtonPressMask, False,
- (XtEventHandler)drawing_area_bp, (XtPointer)wkid);
- /* ButtonRelease */
- XtAddEventHandler(draw, ButtonReleaseMask, False,
- (XtEventHandler)drawing_area_br, (XtPointer)wkid);
- /* PointerMotion */
- XtAddEventHandler(draw, PointerMotionMask, False,
- (XtEventHandler)drawing_area_pm, (XtPointer)wkid);
-}
-
-
-/***********************************************************************
- * *
- * Destroy any Motif (Architect) graphics window (created for HIGZ) *
- * *
- * int wkid (input) = workstation identifier *
- * *
- ***********************************************************************/
-void km_graph_close (wkid)
- int wkid;
-{
- if (gr_area[wkid-1].widget == NULL) {
- printf ("km_graph_close : workstation %d is not opened\n",wkid);
- return; }
-
- UxDestroyInterface(gr_area[wkid-1].widget);
- km_reset_appShell (gr_area[wkid-1].widget);
-
- gr_area[wkid-1].widget = (Widget) NULL;
- n_gr_area--;
-}
-
-
-/***********************************************************************
- * *
- * Get the context for graphics area widget. *
- * *
- ***********************************************************************/
-static int get_ga_context(w)
- Widget w;
-{
- int i;
-
- if (!w) return -1;
-
- /*
- * find and restore the context
- * (to get to the widgets belonging to this dialog)
- */
- UxKuipGraphicsContext = (_UxCkuipGraphics *)UxGetContext(w);
-
- /* restore the context not handled by the Architect context */
- for (i = 0; i < MAX_GRAPHICS_AREA; i++) {
- if (gr_area[i].widget == w) {
- return i;
- }
- }
- return -1;
-}
-
-/***********************************************************************
- * *
- * Destroy the graphics area dialog. *
- * *
- ***********************************************************************/
-static void destroy_graphicsArea(w, graphics, call_data)
- Widget w, graphics;
- XmAnyCallbackStruct *call_data;
-{
- int i;
-
- for (i = 0; i < MAX_GRAPHICS_AREA; i++) {
- if (gr_area[i].widget == graphics) {
-
- if (i == 0) {
- km_inform_user(graphics, "Cannot close graphics window 1.", "");
- return; }
-
- /* call HIGZ routine to close the window */
- if( klnkaddr.graf_close_F != NULL ) {
- INTEGER wkid = i+1;
- (*klnkaddr.graf_close_F)(&wkid);
- }
-
- gr_area[i].widget = (Widget) NULL;
- break;
- }
- }
- n_gr_area--;
-
- UxDestroyInterface(graphics);
- km_reset_appShell (graphics);
-}
-
-
-/***********************************************************************
- * *
- * Handle the graphics window callbacks (expose and resize events). *
- * *
- ***********************************************************************/
-static void drawing_area_callback(widget, graphics, call_data)
- Widget widget, graphics;
- XmDrawingAreaCallbackStruct *call_data;
-{
- XEvent *ev = call_data->event;
- int count = 0;
-
- INTEGER wid = get_ga_context(graphics) + 1;
-
- if (call_data->reason == XmCR_EXPOSE) count = ev->xexpose.count;
- drawing_area_exr (wid, call_data->reason, count);
-}
-
-static void drawing_area_callback1(widget, tag, call_data)
- Widget widget;
- int tag;
- XmDrawingAreaCallbackStruct *call_data;
-{
- XEvent *ev = call_data->event;
- int count = 0;
-
- INTEGER wid = tag;
-
- if (call_data->reason == XmCR_EXPOSE) count = ev->xexpose.count;
- drawing_area_exr (wid, call_data->reason, count);
-}
-
-static void drawing_area_exr (wid, reason, count)
- int wid, reason, count;
-{
- if (reason == XmCR_EXPOSE) {
- if (count != 0) return;
- /* Set new size */
- if( klnkaddr.graf_size_F != NULL && wid > 0) {
- (*klnkaddr.graf_size_F)(&wid); }
-
- }
-
- if (reason == XmCR_RESIZE) {
- /* Set new size */
- if( klnkaddr.graf_size_F != NULL && wid > 0) {
- (*klnkaddr.graf_size_F)(&wid); }
- }
-}
-
-/***********************************************************************
- * *
- * Graphics window Event Handler on EnterWindowMask *
- * *
- ***********************************************************************/
-static void drawing_area_ew ( draw_area, tag, event )
- Widget draw_area;
- int tag;
- XEnterWindowEvent *event;
-{
- INTEGER ix = event->x;
- INTEGER iy = event->y;
- INTEGER iwin = tag;
- INTEGER icod;
-
-
- /* call user defined routine */
- icod = 999;
- if (kjmpaddr.user_locate_F != NULL)
- (*kjmpaddr.user_locate_F) (&ix, &iy, &icod, &iwin);
-}
-
-/***********************************************************************
- * *
- * Graphics window Event Handler on LeaveWindowMask *
- * *
- ***********************************************************************/
-static void drawing_area_lw ( draw_area, tag, event )
- Widget draw_area;
- int tag;
- XLeaveWindowEvent *event;
-{
- INTEGER ix = event->x;
- INTEGER iy = event->y;
- INTEGER iwin = tag;
- INTEGER icod;
-
- /* call user defined routine */
- icod = -999;
- if (kjmpaddr.user_locate_F != NULL)
- (*kjmpaddr.user_locate_F) (&ix, &iy, &icod, &iwin);
-}
-
-/***********************************************************************
- * *
- * Graphics window Event Handler on ButtonPressMask *
- * *
- ***********************************************************************/
-static void drawing_area_bp ( draw_area, tag, event )
- Widget draw_area;
- int tag;
- XButtonPressedEvent *event;
-{
- static poptag_str ptag[MAXLEVEL*MAXITEMS];
-
- Widget filemenu_default;
- MenuItem filemenu_items[MAXITEMS];
- MenuItem submenu_items[MAXITEMS];
- INTEGER ix = event->x;
- INTEGER iy = event->y;
- INTEGER iwin = tag;
- INTEGER icod;
- INTEGER nlev;
- INTEGER ipid[10];
- char chpid[10][8];
- char name[10][16];
- char *class;
- char title[MAX_string], stitle[MAX_string];
- KmClass *kmcls, *kmcls1;
- BrAction *bract, *bract1;
- int i, j, k;
- int nl;
-
- if( event->button != 3) {
- /* call user defined routine */
- icod = event->button;
- if (kjmpaddr.user_locate_F != NULL)
- (*kjmpaddr.user_locate_F) (&ix, &iy, &icod, &iwin);
- return; }
-
- /* event->button = 3 : graphical object retrieving (graf_pick_F) */
- if( klnkaddr.graf_pick_F == NULL) return;
-
- /* graphical object retrieving */
- nlev = tag; /* give wkid to HIGZ */
- F77_CALL_x4C((*klnkaddr.graf_pick_F), &ix, &iy, &nlev, ipid, chpid[0], 8 );
- if( nlev <= 0 )
- return;
-
- for( nl = 0; nl < nlev; nl++ ) {
- if( ipid[nl] > 0xFFFFFF ) {
- /* if ipid is a large number assume it to be a 4-character Hollerith */
- strncpy( name[nl], (char*)&ipid[nl], 4 );
- name[nl][4] = '\0';
- }
- else {
- long lpid = ipid[nl];
- sprintf( name[nl], "%ld", lpid );
- }
- }
- nlev --;
-
- class = fstr0dup( chpid[nlev], 8 );
- kmcls = find_kmclass( class );
- free( class );
- /* Look for the first level which corresponds to a valid class */
- while ( kmcls == NULL ) {
- if( nlev == 0)
- return;
- nlev --;
- class = fstr0dup( chpid[nlev], 8 );
- kmcls = find_kmclass( class );
- free( class ); }
-
- /* Now kmcls != NULL : Build graphics popup menu according to this class */
- sprintf( title, "%s %s", kmcls->title, name[nlev] );
- for( i = 0, bract = kmcls->graf; bract != NULL;
- bract = bract->next, i++ ) {
- if (i >= MAXITEMS) break;
- ptag[i].flag = 3;
- ptag[i].panel = (event->state == ControlMask);
- ptag[i].bract = bract;
- ptag[i].bract_next = bract->next;
- strcpy( ptag[i].item, name[nlev] );
- for( nl = nlev - 1; nl >= 0; nl-- ) {
- strcat( ptag[i].item, "," );
- strcat( ptag[i].item, name[nl] );
- }
- strcpy( ptag[i].pathname, kmcls->name );
- filemenu_items[i].accelerator = NULL;
- filemenu_items[i].accel_text = NULL;
- filemenu_items[i].callback = popup_activate;
- filemenu_items[i].callback_data = (caddr_t) &ptag[i];
- filemenu_items[i].default_button = False;
- filemenu_items[i].subitems = NULL;
- filemenu_items[i].set = False;
- if (bract->flags & BrActToggle) {
- filemenu_items[i].class = &xmToggleButtonGadgetClass;
- if (bract->flags & BrActToggleOn) filemenu_items[i].set = True;
- } else {
- filemenu_items[i].class = &xmPushButtonGadgetClass;
- }
- filemenu_items[i].label = bract->text;
- filemenu_items[i].mnemonic = bract->text[0];
- filemenu_items[i].separator = (bract->flags & BrActSeparator);
- } /* end for( i = 0, bract = kmcls->graf; bract != NULL; ... */
- j = 0;
- while (nlev-- > 0) {
- /* Create a pulldown menu entry for each top level in the hierarchy */
- class = fstr0dup( chpid[nlev], 8 );
- kmcls1 = find_kmclass( class );
- free( class );
- if( kmcls1 != NULL ) {
- sprintf( stitle, "%s %s", kmcls1->title, name[nlev] );
- filemenu_items[i].label = str0dup( stitle );
- filemenu_items[i].accelerator = NULL;
- filemenu_items[i].accel_text = NULL;
- filemenu_items[i].callback = NULL;
- filemenu_items[i].callback_data = NULL;
- filemenu_items[i].default_button = False;
- if (bract->flags & BrActToggle) {
- filemenu_items[i].class = &xmToggleButtonGadgetClass;
- } else {
- filemenu_items[i].class = &xmPushButtonGadgetClass;
- }
- filemenu_items[i].separator = True;
- for( k = 0, bract1 = kmcls1->graf; bract1 != NULL;
- bract1 = bract1->next, k++ ) {
- if (k >= MAXITEMS || i+j+k >= MAXLEVEL*MAXITEMS ) break;
- ptag[i+j+k].flag = 3;
- ptag[i+j+k].panel = (event->state == ControlMask);
- ptag[i+j+k].bract = bract1;
- ptag[i+j+k].bract_next = bract1->next;
- strcpy( ptag[i+j+k].item, name[nlev] );
- for( nl = nlev - 1; nl >= 0; nl-- ) {
- strcat( ptag[i+j+k].item, "," );
- strcat( ptag[i+j+k].item, name[nl] );
- }
- strcpy( ptag[i+j+k].pathname, kmcls1->name );
- submenu_items[k].accelerator = NULL;
- submenu_items[k].accel_text = NULL;
- submenu_items[k].callback = popup_activate;
- submenu_items[k].callback_data = (caddr_t) &ptag[i+j+k];
- submenu_items[k].default_button = False;
- submenu_items[k].subitems = NULL;
- if (bract->flags & BrActToggle) {
- submenu_items[k].class = &xmToggleButtonGadgetClass;
- } else {
- submenu_items[k].class = &xmPushButtonGadgetClass;
- }
- submenu_items[k].label = bract1->text;
- submenu_items[k].mnemonic = bract1->text[0];
- submenu_items[k].separator = (bract1->flags & BrActSeparator);
- }
- submenu_items[k].label = NULL;
- filemenu_items[i].subitems = submenu_items;
- i++; j = j+k-1;
- }
- } /* end while (nlev-- > 0) */
- filemenu_items[i].label = NULL;
- filemenu_items[0].default_button = True;
-
- km_reset_graph_popup();
- graph_popup = km_build_popup (draw_area, title, filemenu_items,
- XmMENU_POPUP, &filemenu_default);
-
- /*
- * position the menu at the location of the button press! If we wanted
- * to position it elsewhere, we could change the x,y fields of the
- * event structure.
- */
- XmMenuPosition(graph_popup, event);
- XtManageChild(graph_popup);
-}
-
-/***********************************************************************
- * *
- * Graphics window Event Handler on ButtonReleaseMask *
- * *
- ***********************************************************************/
-static void drawing_area_br ( draw_area, tag, event )
- Widget draw_area;
- int tag;
- XButtonReleasedEvent *event;
-{
- INTEGER ix = event->x;
- INTEGER iy = event->y;
- INTEGER iwin = tag;
- INTEGER icod;
-
-
- if( event->button == 3) return;
-
- /* call user defined routine */
- icod = - event->button;
- if (kjmpaddr.user_locate_F != NULL)
- (*kjmpaddr.user_locate_F) (&ix, &iy, &icod, &iwin);
-}
-
-/***********************************************************************
- * *
- * Graphics window Event Handler on PointerMotionMask *
- * *
- ***********************************************************************/
-static void drawing_area_pm ( draw_area, tag, event )
- Widget draw_area;
- int tag;
- XPointerMovedEvent *event;
-{
- INTEGER ix = event->x;
- INTEGER iy = event->y;
- INTEGER iwin = tag;
- INTEGER icod;
-
-
- if( event->state == Button3Mask) return;
-
- /* call user defined routine */
- icod = 0;
- if (kjmpaddr.user_locate_F != NULL)
- (*kjmpaddr.user_locate_F) (&ix, &iy, &icod, &iwin);
-}
-
-/******************************************************************************/
-/* km_reset_graph_popup : destroy popup menu defined in drawing area */
-/******************************************************************************/
-void km_reset_graph_popup ()
-{
- if (graph_popup != NULL) XtDestroyWidget (XtParent(graph_popup));
- graph_popup = NULL;
-}
diff --git a/src/packlib/kuip/code_motif/mkdims.h b/src/packlib/kuip/code_motif/mkdims.h
deleted file mode 100644
index d5c288b..0000000
--- a/src/packlib/kuip/code_motif/mkdims.h
+++ /dev/null
@@ -1,28 +0,0 @@
-/*
- * $Id: mkdims.h,v 1.1.1.1 1996/03/08 15:33:12 mclareni Exp $
- *
- * $Log: mkdims.h,v $
- * Revision 1.1.1.1 1996/03/08 15:33:12 mclareni
- * Kuip
- *
- */
-/*** String and array dimension ***/
-#ifndef _mkdims_
-#define _mkdims_
-
-/* N.B. The following values MUST be the SAME as in FORTRAN (KUCDES) !!! */
-#define MAXSTR 80 /* most string length */
-#define MAX_APP_SHELL 20 /* max. number of application shell windows */
- /* (create_kuipxxx) */
-
-/* C definitions */
-#define MAX_MENU_LEVEL 16 /* max. number of menu levels */
-#define MAX_parm 20 /* max. number of command parameters */
-#define MAX_opt 40 /* max. number of options for option menu */
-#define MAX_button 600 /* max. number of buttons in a panel */
- /* cf. KUIP : 30 lin. X 20 col. */
-#define MAX_string 80 /* max. length for string */
-#define MAX_stringl 240 /* max. length for long string */
-
-#endif /* _mkdims_ */
-
diff --git a/src/packlib/kuip/code_motif/mkdpan.c b/src/packlib/kuip/code_motif/mkdpan.c
deleted file mode 100644
index 7a24776..0000000
--- a/src/packlib/kuip/code_motif/mkdpan.c
+++ /dev/null
@@ -1,1556 +0,0 @@
-/*
- * $Id: mkdpan.c,v 1.3 2001/05/23 15:16:33 couet Exp $
- *
- * $Log: mkdpan.c,v $
- * Revision 1.3 2001/05/23 15:16:33 couet
- * - Closing KUIP panels with the command "pannel" crashed on LINUX. The
- * following macro demonstrate the problem:
- *
- * panel 0
- * panel 1.01 'hello'
- * panel 0 d 'first' 120x100+0+0
- * panel 0 c 'first'
- *
- * Revision 1.2 2000/09/28 16:13:09 couet
- * - On LINUX: Mods to allow the close of KUIP panels. Closing KUIP panels
- * crashed previously.
- *
- * Revision 1.1.1.1 1996/03/08 15:33:06 mclareni
- * Kuip
- *
- */
-/*CMZ : 2.07/08 06/11/95 16.33.31 by N.Cremel*/
-/*-- Author : N.Cremel 10/08/92*/
-/******************************************************************************/
-/* */
-/* MOTIF-based library for KUIP - deck MKDPAN */
-/* */
-/* Basic Interface for "KUIP Panels " (like in "STYLE GP" ) */
-/* (connected to the file //KUIP/XMCLIB/KUXPAN for building the */
-/* panels with Architect : "create_kuipPanel"). */
-/* */
-/******************************************************************************/
-
-#include "kuip/kuip.h"
-#include "kuip/kfor.h"
-#include "kuip/kmenu.h"
-#include "kuip/kflag.h"
-#include "kuip/klink.h"
-#include "kuip/khash.h"
-#include "kuip/kalias.h"
-
-/* Global SEQUENCES (defined in MKCDES) */
-#include "mkincl.h"
-#include "mkdims.h"
-#include "kuip/mkutfu.h"
-#include "mkutfm.h"
-#include "mkutdm.h"
-#define CONTEXT_MACRO_ACCESS 1
-#include "mkuxpa.h"
-#include "mkuxpp.h"
-#include "mkuxsc.h"
-#undef CONTEXT_MACRO_ACCESS
-#include "kuip/mkterm.h"
-#include "mksres.h"
-#include "mksreg.h"
-#include "kuip/browh1.h"
-#include "browh2.h"
-#include "icwid.h"
-#include "icwidp.h"
-
-/***********************************************************************
- * *
- * Forward declarations of local functions. *
- * *
- ***********************************************************************/
-#if 0
-static C_PROTO_3(void panelfocusCallback,
- Widget widget,
- caddr_t tag,
- XmAnyCallbackStruct *callback_data);
-#endif
-static C_PROTO_3(void focus_panel,
- Widget widget,
- char *name,
- XEnterWindowEvent *ev);
-static C_PROTO_2(void panel_save,
- Widget pwidget,
- char *name);
-static C_PROTO_3(void okPNBCallback,
- Widget widget,
- Widget parent,
- XmAnyCallbackStruct *data);
-static C_PROTO_3(void savePNBCallback,
- Widget widget,
- Widget panel,
- XmAnyCallbackStruct *callback_data);
-static C_PROTO_3(void set_context_help,
- Widget widget,
- Widget panel,
- XmAnyCallbackStruct *callback_data);
-static C_PROTO_1(void display_ContextHelp,
- char *label);
-static C_PROTO_3(void destroy_dialog,
- Widget w,
- Widget dialog,
- XmAnyCallbackStruct *call_data);
-static C_PROTO_3(void viewPNBCallback,
- Widget widget,
- Widget panel,
- XmToggleButtonCallbackStruct *callback_data);
-static C_PROTO_1(char *find_hlp,
- char *name);
-static C_PROTO_1(void strconv,
- char *str);
-static void destroy_ptag(
- Widget w, caddr_t tag, XmAnyCallbackStruct *call_data);
-#if 0
-static void button_arm(
- Widget w, caddr_t tag, XmAnyCallbackStruct *call_data);
-#endif
-static void km_panel_view (int flag);
-
-
-/***********************************************************************
- * *
- * Local datas. *
- * *
- ***********************************************************************/
-
-/* structure definition */
-typedef struct {
- Widget buttonn;
- Widget buttoni;
- Widget buttonb;
- Widget buttonc;
- Widget button1;
- int row;
- int col;
- int rep; /* ICON, NO_ICON */
- int flag; /* panel button option (T=1) */
- KmPixmap pix; /* icon pixmap */
- KmPixmap hi_pix; /* icon highlight pixmap */
- } ptag_str; /* tag structure for km_panel_execute */
-
-#define PAHLP_TABLE_SIZE 97 /* should be a prime */
-static HashTable *kmpahlp; /* panel helps (for button) table */
-
-#define PAWID_TABLE_SIZE 97
-static HashTable *kmpawid; /* list of panels with their name */
-
-static Widget panel_widget = NULL; /* Widget id of the last created panel */
-
-static int WM_x = 0; /* width of Window Manager decoration */
-static int WM_y = 0; /* height of Window Manager decoration */
-
-Widget context_panel;
-
-#define BUT_TRANS "#override <Btn1Down>: Arm()\n<Btn1Up>: Activate() Disarm()"
-
-/******************************************************************************/
-/* int km_display_kpanel */
-/* */
-/******************************************************************************/
-int km_display_kpanel (name, geometry)
- char *name, *geometry;
-{
- char title[MAX_string];
- char *panel_name, *panel_htitle;
-
- static char *focus_tag;
- static np = 0;
-
- if (name != NULL && name[0] != '\0') {
- panel_name = strdup (name);
- } else {
- char cnp[3];
- np++;
- sprintf (cnp,"%d",np);
- panel_name = str2dup ("kuipPanel", cnp);
- }
- panel_htitle = strdup (panel_name);
- strconv (panel_htitle);
-
- panel_widget = (Widget) create_kuipPanel();
-
- /* insert panel name in table kmpawid */
- if (panel_htitle != NULL) {
- if (kmpawid == NULL) {
- kmpawid = hash_create( PAWID_TABLE_SIZE );
- hash_config( kmpawid, "struct" );
- }
- hash_insert( kmpawid, panel_htitle, panel_widget, 0);
- }
-
-
- /*
- * find and restore the context
- * (to get to the widgets belonging to this dialog)
- */
- UxKuipPanelContext = (_UxCkuipPanel *)UxGetContext( panel_widget );
-
-
- /* Set title, icon name and pixmap */
- if (strstr(panel_name, class_name) == NULL)
- sprintf (title, "%s %s", class_name, panel_name);
- else
- strcpy (title, panel_name);
- if (geometry != NULL)
- XtVaSetValues(XtParent(panel_widget), XmNtitle, title,
- XmNiconName, title,
- XmNiconPixmap, km_pixmap,
- XmNdefaultPosition, False,
- XmNgeometry, geometry,
- NULL);
- else
- XtVaSetValues(XtParent(panel_widget), XmNtitle, title,
- XmNiconName, title,
- XmNiconPixmap, km_pixmap,
- NULL);
-
- if( klnkaddr.user_TopWid_C != NULL ) {
- /* pass widget ID to application */
- (*klnkaddr.user_TopWid_C)(panel_name, panel_widget);
- }
-
- km_store_appShell (panel_widget, title);
-
- /* Inhibit "Close" button" (non sensitive) when it is requested */
- if (!srec.panel_interactive) XtSetSensitive(km_okPNB, False);
-
-#if defined(CERNLIB_LINUX)
- /* Inhibit the Close from the WM */
- XtVaSetValues(XtParent(panel_widget), XmNdeleteResponse,
- XmDO_NOTHING, NULL);
-#endif
-
- /* Create and manage panel buttons inside of RowColumn widget */
- km_panel_buttons (panel_widget, panel_name, by_ICON, 0);
-
- XtAddCallback (km_okPNB,XmNactivateCallback,
- (XtCallbackProc)okPNBCallback, panel_widget);
- XtAddCallback (km_savePNB,XmNactivateCallback,
- (XtCallbackProc)savePNBCallback, panel_widget);
- XtAddCallback (km_viewPNB_name,XmNvalueChangedCallback,
- (XtCallbackProc)viewPNBCallback, panel_widget);
- XtAddCallback (km_viewPNB_icon,XmNvalueChangedCallback,
- (XtCallbackProc)viewPNBCallback, panel_widget);
- XtAddCallback (km_viewPNB_both,XmNvalueChangedCallback,
- (XtCallbackProc)viewPNBCallback, panel_widget);
- XtAddCallback (km_viewPNB_command,XmNvalueChangedCallback,
- (XtCallbackProc)viewPNBCallback, panel_widget);
- XtAddCallback (km_viewPNB_command1,XmNvalueChangedCallback,
- (XtCallbackProc)viewPNBCallback, panel_widget);
- XtAddCallback (km_helpPNB1,XmNactivateCallback,
- (XtCallbackProc)km_do_help, (XtPointer)"HELP_PANEL");
- XtAddCallback (km_helpPNB2,XmNactivateCallback,
- (XtCallbackProc)km_do_help, (XtPointer)"HELP_EDIT_PANEL");
- XtAddCallback (km_helpPNB3,XmNactivateCallback,
- (XtCallbackProc)km_do_help, (XtPointer)"HELP_SAVE_PANEL");
- XtAddCallback (km_helpPNB4,XmNactivateCallback,
- (XtCallbackProc)km_do_help, (XtPointer)"HELP_DOLLAR_PANEL");
- XtAddCallback (km_helpPNB5,XmNactivateCallback,
- (XtCallbackProc)km_do_help, (XtPointer)"HELP_MINUS_PANEL");
- XtAddCallback (km_helpPNB6,XmNactivateCallback,
- (XtCallbackProc)km_do_help, (XtPointer)"HELP_MINUS2_PANEL");
- XtAddCallback (km_helpCONTEXT,XmNactivateCallback,
- (XtCallbackProc)set_context_help, panel_widget);
-#if 0
- XtAddCallback (panel_widget,XmNfocusCallback,
- (XtCallbackProc)panelfocusCallback, NULL);
-#endif
- focus_tag = NULL;
- if (kc_window.panel_name != NULL) focus_tag = strdup (kc_window.panel_name);
- XtAddEventHandler(panel_widget, FocusChangeMask, False,
- (XtEventHandler)focus_panel, (XtPointer)focus_tag);
-
-
- UxPopupInterface(panel_widget, XtGrabNone);
-
- return 0;
-}
-
-
-/******************************************************************************/
-/* int km_close_kpanel */
-/* */
-/******************************************************************************/
-int km_close_kpanel (name)
- char *name;
-{
- Widget panel;
-
- if (name != NULL && name[0] != '\0' ) {
- char *panel_htitle = strdup (name);
- strconv (panel_htitle);
-
- panel = (Widget)hash_lookup (kmpawid, panel_htitle, NULL);
- hash_remove( kmpawid, panel_htitle );
- } else
- panel = panel_widget;
-
-#if defined(CERNLIB_LINUX)
- UxPopdownInterface(panel);
-#else
- UxDestroyInterface(panel);
-#endif
- km_reset_appShell (panel);
-
- return 0;
-}
-
-#if 0
-static void panelfocusCallback( widget, tag, callback_data )
- Widget widget;
- caddr_t tag;
- XmAnyCallbackStruct *callback_data;
-#endif
-static void focus_panel(widget, name, ev)
- Widget widget;
- char *name;
- XEnterWindowEvent *ev;
-{
- String new_geometry;
- Position xpos, ypos;
- Dimension dh, dw;
- int ih, iw, ix, iy;
-
- static int ifirst = 0;
-
- if (ifirst == 0) {
- /* First time only we get WM decoration size */
- ifirst = 1;
- XtVaGetValues(XtParent(widget), XmNgeometry, &new_geometry,
- XmNx, &xpos, XmNy, &ypos,
- XmNheight, &dh, XmNwidth, &dw,
- NULL);
- if (new_geometry != NULL) {
- int delta = 50;
-
- sscanf (new_geometry, "%dx%d+%d+%d", &iw, &ih, &ix, &iy);
- WM_x = xpos - ix;
- WM_y = ypos - iy;
- if (WM_x < 0 || WM_x > delta ) WM_x = 0;
- if (WM_y < 0 || WM_y > delta ) WM_y = 0;
- }
- }
- if (kc_window.panel_name != NULL) free (kc_window.panel_name);
- if (name != NULL) {
- kc_window.panel_name = strdup (name);
- } else {
- kc_window.panel_name = NULL;
- }
-}
-
-/*
- * Display panel buttons : in normal panels the display is done "by_ICON"
- * when panel is described with icons, otherwise it is "by_NAME".
- * Inside of a palette the display depends on view_flag
- * flag = 0 --> normal panel
- * flag = 1 --> palette
- *
- * Row Column / buttons widgets for panels:
- * View by name --> km_rowcolPN / buttonn
- * by icon --> km_rowcolPI (managed at the beginning) / buttoni
- * by icon & label --> km_rowcolPB / buttonb
- * by command --> km_rowcolPC / buttonc
- * by command (1 col.) --> km_rowcolP1 / button1
- *
- * Row Column / buttons widgets for palettes (multi_panel):
- * View by name --> km_rowcolMN / buttonn
- * by icon --> km_rowcolMI (managed at the beginning) / buttoni
- * by icon & label --> km_rowcolMB / buttonb
- * by command --> km_rowcolMC / buttonc
- * by command (1 col.) --> km_rowcolM1 / button1
- */
-void km_panel_buttons (pwidget, name, view_flag, flag)
- Widget pwidget;
- char *name;
- int view_flag, flag;
-{
- Widget RowColN, RowColI, RowColB, RowColC, RowCol1;
- Widget buttonn[MAX_button], buttoni[MAX_button], buttonb[MAX_button],
- buttonc[MAX_button], button1[MAX_button];
- Pixel arm_pixel;
- char wname[MAX_stringl];
- int i, j, ncol, nbut, nbut1;
- short nrow;
- Arg arglist[10];
- Cardinal narg;
-
- int margin = 0;
-
- /*
- * find and restore the context
- * (to get to the widgets belonging to this dialog)
- */
- if (flag == 0) {
- UxKuipPanelContext = (_UxCkuipPanel *)UxGetContext( pwidget );
- RowColN = km_rowcolPN;
- RowColI = km_rowcolPI;
- RowColB = km_rowcolPB;
- RowColC = km_rowcolPC;
- RowCol1 = km_rowcolP1;
- } else if (flag == 1) {
- UxPalPanelContext = (_UxCPalPanel *)UxGetContext( pwidget );
- RowColN = km_rowcolMN;
- RowColI = km_rowcolMI;
- RowColB = km_rowcolMB;
- RowColC = km_rowcolMC;
- RowCol1 = km_rowcolM1;
- }
-
- /* Get maximum number of colums and total nb. of buttons */
- nrow = kc_window.panel_rows;
- ncol = 0;
- nbut = 0;
- nbut1 = 0;
- for (i = 0; i < nrow; i++) {
- int nc = kc_window.panel_cols[i];
- if (kc_window.panel_cols[i] > ncol) ncol = kc_window.panel_cols[i];
- /* get "marginTop" for iconwidget (maximum icon height) */
- for (j = 0; j < nc; j++) {
- if ( kc_window.panel_icons[i][j] != NULL &&
- !km_strempty (kc_window.panel_icons[i][j]) ) {
- KmIcon *kmicon = find_kmicon(kc_window.panel_icons[i][j]);
- if (kmicon != NULL &&
- kmicon->height > margin) margin = kmicon->height;
- }
- if (kc_window.panel_keys[i][j] != NULL &&
- !km_strempty (kc_window.panel_keys[i][j]) &&
- strncmp (kc_window.panel_keys[i][j], ".", 1) != 0 )
- nbut1++;
-
- nbut++;
- } /* end ... for (j = 0 ...) */
- } /* end ... for(i = 0 ...) */
-
- /* Set RowColumn attributes */
- XtVaSetValues(RowColN, XmNnumColumns, nrow, NULL);
- XtVaSetValues(RowColI, XmNnumColumns, nrow, NULL);
- XtVaSetValues(RowColB, XmNnumColumns, nrow, NULL);
- XtVaSetValues(RowColC, XmNnumColumns, nrow, NULL);
- if (nbut1 > 0) XtVaSetValues(RowCol1, XmNnumColumns, nbut1, NULL);
-
- /* Create buttons */
- nbut = 0;
- nbut1 = 0;
- for (i = 0; i < nrow; i++) {
- int nc = kc_window.panel_cols[i];
- XtTranslations parsed = XtParseTranslationTable (BUT_TRANS);
-
- if (nbut >= MAX_button - 1) break;
- for (j = 0; j < nc; j++) {
- char *user_data;
-
- ptag_str *ptag = (ptag_str*)malloc(sizeof(ptag_str));
- ptag->row = i;
- ptag->col = j;
- ptag->pix = 0;
- ptag->hi_pix = 0;
- ptag->buttonn = NULL;
- ptag->buttoni = NULL;
- ptag->buttonb = NULL;
- ptag->buttonc = NULL;
- ptag->button1 = NULL;
-
- sprintf (wname, "NP%sB%d", name,j);
- if (kc_window.panel_keys[i][j] != NULL &&
- !km_strempty (kc_window.panel_keys[i][j]) &&
- strncmp (kc_window.panel_keys[i][j], ".", 1) != 0 ) {
- char *cmd = (char*)hash_lookup( kc_alias.cmd_table,
- kc_window.panel_keys[i][j], NULL);
-
- /*
- * XmNuserData --> label[#%pix]
- */
- user_data = strdup(kc_window.panel_keys[i][j]);
- buttoni[nbut] = XtVaCreateWidget (wname,
- xmPushButtonWidgetClass, RowColI,
- RES_CONVERT( XmNlabelString, kc_window.panel_keys[i][j]),
- XmNuserData, strdup ( user_data ),
- XmNlabelPixmap, XmUNSPECIFIED_PIXMAP,
- NULL);
- buttonn[nbut] = XtVaCreateWidget (wname,
- xmPushButtonWidgetClass, RowColN,
- RES_CONVERT( XmNlabelString, kc_window.panel_keys[i][j]),
- XmNuserData, strdup ( user_data ),
- XmNlabelPixmap, XmUNSPECIFIED_PIXMAP,
- NULL);
- narg = 0;
- XtSetArg (arglist[narg], XmNiconOffset, 1); narg++;
- XtSetArg (arglist[narg], XmNmarginTop, margin); narg++;
- XtSetArg (arglist[narg], XmNlabelString,
- XmStringCreateSimple(kc_window.panel_keys[i][j])); narg++;
- XtSetArg (arglist[narg], XmNlabelPixmap, XmUNSPECIFIED_PIXMAP);
- narg++;
- XtSetArg (arglist[narg], XmNuserData, strdup ( user_data ));
- narg++;
- buttonb[nbut] = CreateIconWidget (RowColB, wname, arglist, narg);
- if (cmd == NULL) cmd = kc_window.panel_keys[i][j];
- buttonc[nbut] = XtVaCreateWidget (wname,
- xmPushButtonWidgetClass, RowColC,
- RES_CONVERT( XmNlabelString, cmd),
- XmNuserData, strdup ( user_data ),
- XmNlabelPixmap, XmUNSPECIFIED_PIXMAP,
- NULL);
- button1[nbut1] = XtVaCreateWidget (wname,
- xmPushButtonWidgetClass, RowCol1,
- RES_CONVERT( XmNlabelString, cmd),
- XmNuserData, strdup ( user_data ),
- XmNlabelPixmap, XmUNSPECIFIED_PIXMAP,
- NULL);
- ptag->button1 = button1[nbut1];
- XtAddCallback (button1[nbut1],XmNactivateCallback,
- (XtCallbackProc)km_panel_execute,(XtPointer)ptag);
- XtAddCallback (button1[nbut1], XmNdestroyCallback,
- (XtCallbackProc)destroy_ptag, (XtPointer)ptag);
- nbut1 ++;
- } else {
- user_data = strdup("");
- buttoni[nbut] = XtVaCreateWidget (wname,
- xmPushButtonWidgetClass, RowColI,
- RES_CONVERT( XmNlabelString, ""),
- XmNuserData, strdup ( user_data ),
- XmNlabelPixmap, XmUNSPECIFIED_PIXMAP,
- NULL);
- buttonn[nbut] = XtVaCreateWidget (wname,
- xmPushButtonWidgetClass, RowColN,
- RES_CONVERT( XmNlabelString, ""),
- XmNuserData, strdup ( user_data ),
- XmNlabelPixmap, XmUNSPECIFIED_PIXMAP,
- NULL);
- narg = 0;
- XtSetArg (arglist[narg], XmNiconOffset, 1); narg++;
- XtSetArg (arglist[narg], XmNmarginTop, margin); narg++;
- XtSetArg (arglist[narg], XmNlabelString,
- XmStringCreateSimple("")); narg++;
- XtSetArg (arglist[narg], XmNlabelPixmap, XmUNSPECIFIED_PIXMAP);
- narg++;
- XtSetArg (arglist[narg], XmNuserData, strdup ( user_data ));
- narg++;
- buttonb[nbut] = CreateIconWidget (RowColB, wname, arglist, narg);
- buttonc[nbut] = XtVaCreateWidget (wname,
- xmPushButtonWidgetClass, RowColC,
- RES_CONVERT( XmNlabelString, ""),
- XmNuserData, strdup ( user_data ),
- XmNlabelPixmap, XmUNSPECIFIED_PIXMAP,
- NULL);
- }
-
- XtOverrideTranslations (buttoni[nbut],
- XtParseTranslationTable("<Btn3Down>:Arm()"));
- XtOverrideTranslations (buttoni[nbut],
- XtParseTranslationTable("<Btn3Up>:Activate()"));
-
- if ( kc_window.panel_icons[i][j] != NULL &&
- !km_strempty (kc_window.panel_icons[i][j]) ) {
- KmIcon *kmicon = find_kmicon(kc_window.panel_icons[i][j]);
- char *label = strdup(kc_window.panel_keys[i][j]);
-
- if (strncmp (label, ".", 1) == 0 ) label[0] ='\0';
-
- XtVaGetValues (buttoni[nbut],
- XmNarmColor, &arm_pixel, NULL);
- if (kmicon != NULL) {
- ptag->pix =
- kmicon->pix = XCreatePixmapFromBitmapData( km_Display,
- DefaultRootWindow(km_Display),
- kmicon->bitmap, kmicon->width, kmicon->height,
- km_foreground, km_background,
- DefaultDepthOfScreen(XtScreen(pwidget)) );
- ptag->hi_pix =
- kmicon->hi_pix = XCreatePixmapFromBitmapData( km_Display,
- DefaultRootWindow(km_Display),
- kmicon->bitmap, kmicon->width, kmicon->height,
- km_foreground, arm_pixel,
- DefaultDepthOfScreen(XtScreen(pwidget)) );
- /*
- * [pix] in XmNuserData (label[#%pix] is used for panel_save
- */
- user_data = mstr2cat (user_data,
- "#%", kc_window.panel_icons[i][j]);
- XtVaSetValues (buttoni[nbut],
- XmNlabelPixmap, kmicon->pix,
- XmNuserData, strdup ( user_data ),
- NULL);
- if (view_flag == by_ICON)
- XtVaSetValues (buttoni[nbut],
- XmNlabelType, XmPIXMAP,
- RES_CONVERT( XmNlabelString, label),
- NULL);
- } else {
- char message[MAX_stringl];
-
- sprintf (message,"cannot find bitmaps description for %s",
- kc_window.panel_icons[i][j]);
- km_warn_user(km_toplevel, message, "");
- kmicon = find_kmicon("pixpan");
- if (kmicon != NULL) {
- ptag->pix =
- kmicon->pix = XCreatePixmapFromBitmapData( km_Display,
- DefaultRootWindow(km_Display),
- kmicon->bitmap, kmicon->width, kmicon->height,
- km_foreground, km_background,
- DefaultDepthOfScreen(XtScreen(pwidget)) );
- ptag->hi_pix =
- kmicon->hi_pix = XCreatePixmapFromBitmapData( km_Display,
- DefaultRootWindow(km_Display),
- kmicon->bitmap, kmicon->width, kmicon->height,
- km_foreground, arm_pixel,
- DefaultDepthOfScreen(XtScreen(pwidget)) );
- /*
- * [pix] in userData (label[#%pix] is used for panel_save
- */
- user_data = mstrcat (user_data, "#%pixpan");
- XtVaSetValues (buttoni[nbut],
- XmNlabelPixmap, kmicon->pix,
- XmNuserData, strdup ( user_data ),
- NULL);
- if (view_flag == by_ICON)
- XtVaSetValues (buttoni[nbut],
- XmNlabelType, XmPIXMAP,
- RES_CONVERT( XmNlabelString, label),
- NULL);
- }
- }
- ptag->rep = ICON;
- narg = 0;
- XtSetArg (arglist[narg], XmNiconOffset, 1); narg++;
- /* XtSetArg (arglist[narg], XmNshadowThickness, 4); narg++; */
- XtSetArg (arglist[narg], XmNmarginTop, margin); narg++;
- XtSetArg (arglist[narg], XmNlabelString,
- XmStringCreateSimple(kc_window.panel_keys[i][j])); narg++;
- XtSetArg (arglist[narg], XmNlabelPixmap, kmicon->pix); narg++;
- XtSetArg (arglist[narg], XmNuserData, strdup ( user_data ));
- narg++;
- buttonb[nbut] = CreateIconWidget (RowColB, wname, arglist, narg);
-
- } else {
- ptag->rep = NO_ICON;
- }
- if ( kc_window.panel_opts[i][j] != NULL &&
- strstr( kc_window.panel_opts[i][j], "T" ) != NULL ) {
- /* Toggle behavior */
- ptag->flag = 1;
- } else {
- ptag->flag = 0;
- }
- XtAugmentTranslations (buttonb[nbut], parsed);
-
- ptag->buttonn = buttonn[nbut];
- ptag->buttoni = buttoni[nbut];
- ptag->buttonb = buttonb[nbut];
- ptag->buttonc = buttonc[nbut];
-
-#if 0
- XtAddCallback (buttoni[nbut],XmNarmCallback,
- (XtCallbackProc)button_arm,(XtPointer)ptag);
-#endif
- XtAddCallback (buttoni[nbut],XmNactivateCallback,
- (XtCallbackProc)km_panel_execute,(XtPointer)ptag);
- XtAddCallback (buttoni[nbut], XmNdestroyCallback,
- (XtCallbackProc)destroy_ptag, (XtPointer)ptag);
- XtAddCallback (buttonn[nbut],XmNactivateCallback,
- (XtCallbackProc)km_panel_execute,(XtPointer)ptag);
- XtAddCallback (buttonn[nbut], XmNdestroyCallback,
- (XtCallbackProc)destroy_ptag, (XtPointer)ptag);
- XtAddCallback (buttonb[nbut],XmNactivateCallback,
- (XtCallbackProc)km_panel_execute,(XtPointer)ptag);
- XtAddCallback (buttonb[nbut], XmNdestroyCallback,
- (XtCallbackProc)destroy_ptag, (XtPointer)ptag);
- XtAddCallback (buttonc[nbut],XmNactivateCallback,
- (XtCallbackProc)km_panel_execute,(XtPointer)ptag);
- XtAddCallback (buttonc[nbut], XmNdestroyCallback,
- (XtCallbackProc)destroy_ptag, (XtPointer)ptag);
-
- nbut ++;
- } /* end ... for (j = 0; j < nc; j++) */
- for (j = nc; j < ncol; j++) {
-
- ptag_str *ptag = (ptag_str*)malloc(sizeof(ptag_str));
- ptag->row = i;
- ptag->col = j;
- ptag->pix = 0;
- ptag->hi_pix = 0;
- ptag->buttonn = NULL;
- ptag->buttoni = NULL;
- ptag->buttonb = NULL;
- ptag->buttonc = NULL;
- ptag->button1 = NULL;
-
- sprintf (wname, "NP%sB%d", name,j);
- buttoni[nbut] = XtVaCreateWidget (wname,
- xmPushButtonWidgetClass, RowColI,
- RES_CONVERT( XmNlabelString, ""),
- XmNuserData, strdup ( "" ),
- NULL);
- buttonn[nbut] = XtVaCreateWidget (wname,
- xmPushButtonWidgetClass, RowColN,
- RES_CONVERT( XmNlabelString, ""),
- XmNuserData, strdup ( "" ),
- NULL);
- narg = 0;
- XtSetArg (arglist[narg], XmNiconOffset, 1); narg++;
- XtSetArg (arglist[narg], XmNmarginTop, margin); narg++;
- XtSetArg (arglist[narg], XmNlabelString, XmStringCreateSimple(""));
- narg++;
- XtSetArg (arglist[narg], XmNlabelPixmap, XmUNSPECIFIED_PIXMAP);
- narg++;
- XtSetArg (arglist[narg], XmNuserData, strdup ( "" )); narg++;
- buttonb[nbut] = CreateIconWidget (RowColB, wname, arglist, narg);
-
- buttonc[nbut] = XtVaCreateWidget (wname,
- xmPushButtonWidgetClass, RowColC,
- RES_CONVERT( XmNlabelString, ""),
- XmNuserData, strdup ( "" ),
- NULL);
- XtAugmentTranslations (buttonb[nbut], parsed);
- XtOverrideTranslations (buttoni[nbut],
- XtParseTranslationTable("<Btn3Down>:Arm()"));
- XtOverrideTranslations (buttoni[nbut],
- XtParseTranslationTable("<Btn3Up>:Activate()"));
-
- ptag->buttonn = buttonn[nbut];
- ptag->buttoni = buttoni[nbut];
- ptag->buttonb = buttonb[nbut];
- ptag->buttonc = buttonc[nbut];
- ptag->rep = NO_ICON;
- ptag->flag = 0;
- XtAddCallback (buttoni[nbut],XmNactivateCallback,
- (XtCallbackProc)km_panel_execute,(XtPointer)ptag);
- XtAddCallback (buttoni[nbut], XmNdestroyCallback,
- (XtCallbackProc)destroy_ptag, (XtPointer)ptag);
- XtAddCallback (buttonn[nbut],XmNactivateCallback,
- (XtCallbackProc)km_panel_execute,(XtPointer)ptag);
- XtAddCallback (buttonn[nbut], XmNdestroyCallback,
- (XtCallbackProc)destroy_ptag, (XtPointer)ptag);
- XtAddCallback (buttonb[nbut],XmNactivateCallback,
- (XtCallbackProc)km_panel_execute,(XtPointer)ptag);
- XtAddCallback (buttonb[nbut], XmNdestroyCallback,
- (XtCallbackProc)destroy_ptag, (XtPointer)ptag);
- XtAddCallback (buttonc[nbut],XmNactivateCallback,
- (XtCallbackProc)km_panel_execute,(XtPointer)ptag);
- XtAddCallback (buttonc[nbut], XmNdestroyCallback,
- (XtCallbackProc)destroy_ptag, (XtPointer)ptag);
- nbut ++;
- } /* end ... for (j = nc; j < ncol; j++) */
- } /* end ... for (i = 0; i < nrow; i++) */
-
- XtManageChildren (buttoni, nbut);
- XtManageChildren (buttonn, nbut);
- XtManageChildren (buttonb, nbut);
- XtManageChildren (buttonc, nbut);
- if (nbut1 > 0) XtManageChildren (button1, nbut1);
-}
-
-static void destroy_ptag(Widget w,caddr_t tag,XmAnyCallbackStruct *call_data)
-{
- ptag_str *stag = (ptag_str *)tag;
- free (stag);
-}
-
-#if 0
-static void button_arm(
- Widget pbut_widget, caddr_t tag, XmAnyCallbackStruct *callback_data )
-{
- ptag_str *stag = (ptag_str *)tag;
-
- if (stag->hi_pix != 0)
- XtVaSetValues (pbut_widget, XmNlabelPixmap, stag->hi_pix, NULL);
-}
-#endif
-
-void km_panel_execute( pbut_widget, tag, callback_data )
- Widget pbut_widget;
- caddr_t tag;
- XmAnyCallbackStruct *callback_data;
-{
- Widget button[5];
- Pixel arm_pixel, bg_pixel, bs_col, ts_col;
- char *g_string, *ex_string;
- char *value = NULL;
- char cmd_start[MAXCMD];
- int i,ilen;
- int dollar_pos = -1;
-
- ptag_str *stag = (ptag_str *)tag;
- int row = stag->row;
- int col = stag->col;
-
-
- static Widget button_pressed = NULL;
- static Widget bpressed[5];
- static KmPixmap hpix_pressed = 0;
-
- /* Push Button with labels (0,1,2) */
- button[0] = stag->buttonn;
- button[1] = stag->buttonc;
- button[2] = stag->button1;
- /* Push Button with icon */
- button[3] = stag->buttoni;
- /* IconWidget */
- button[4] = stag->buttonb;
-
-
- /* Get armColor and background attributes for push button */
- XtVaGetValues (pbut_widget,
- XmNarmColor, &arm_pixel,
- XmNbackground, &bg_pixel,
- XmNbottomShadowColor, &bs_col,
- XmNtopShadowColor, &ts_col,
- NULL);
-
- if (button_pressed != NULL) { /* Toggle behavior */
- for (i = 0; i < 4; i++) /* xmPushButtonWidgetClass */
- XtVaSetValues (bpressed[i],
- XmNbackground, bg_pixel,
- XmNbottomShadowColor, bs_col,
- XmNtopShadowColor, ts_col,
- NULL);
- if ( hpix_pressed != 0 ) { /* button with icons */
- XtVaSetValues (bpressed[3],
- XmNlabelPixmap, hpix_pressed, NULL);
- XtVaSetValues (bpressed[4],
- XmNlabelPixmap, hpix_pressed, NULL);
- }
- /* iconwidget : just change XmNshadowType value */
- XtVaSetValues (bpressed[4],
- XmNshadowType, XmSHADOW_OUT, NULL);
- }
-
- /*
- * Special case / selection with button 3
- */
- if (callback_data->event->xbutton.button == 3 && stag->rep == NO_ICON) {
- if (!srec.panel_interactive) return;
- /* erase label (new button) */
- for (i = 0; i < 5; i++ )
- if (button[i] != NULL) XtVaSetValues (button[i],
- RES_CONVERT( XmNlabelString, "" ),
- XmNuserData, strdup ( "" ),
- NULL);
- return;
- }
-
- /*
- * We have to retrieve the label from XmNuserData
- * because XmNlabelString can contain
- * - either [label]
- * - or [command]
- * according to the "view" setting
- * N.B. XmNuserData = label[#%pixlab]
- */
- XtVaGetValues (pbut_widget,
- XmNuserData, &g_string,
- NULL);
-
- if (g_string != NULL) { /* retrieve real label */
- char *tmp;
- if ( (tmp = strstr( g_string, "#%" )) != NULL ) {
- tmp[0] = '\0';
- }
- }
- ilen = strlen(g_string);
-
- if (callback_data->event->xbutton.button == 3 && stag->rep == ICON) {
- char *blab;
-
- if (!srec.panel_interactive) return;
- /* ask for new button definition */
- blab = km_wait_input ("Give (new) text to map in this button", "",
- "HELP_EDIT_PANEL");
- if (blab == NULL) return;
- for (i = 0; i < 5; i++)
- if (button[i] != NULL) XtVaSetValues (button[i],
- RES_CONVERT( XmNlabelString, blab ),
- XmNuserData, strdup ( blab ),
- NULL);
- return;
- }
-
- if (g_string != NULL) {
- char *blank_string = " ";
-
- /*
- * Special case / button selected is blank : ask for label
- */
- if ( ilen == 0 || strncmp(g_string,blank_string,ilen) == 0 ) {
- char *blab;
-
- if (!srec.panel_interactive) return;
- /* ask for new button label */
- blab = km_wait_input ("Give text to map in this button",
- "", "HELP_EDIT_PANEL");
- if (blab != NULL) {
- for (i = 0; i < 5; i++)
- if (button[i] != NULL) XtVaSetValues (button[i],
- RES_CONVERT( XmNlabelString, blab ),
- XmNuserData, strdup ( blab ),
- NULL);
- }
- return;
- }
- }
-
- /* Execute command ... */
-
- /* Get real command (ex_string) from the label (if any) */
- ex_string = strdup (g_string);
- if (kc_window.panel_name != NULL) {
- /* if cmd is an alias concatenate with panel name */
- ex_string = mstr2cat (ex_string, "_", kc_window.panel_name);
- value = (char*)hash_lookup( kc_alias.cmd_table, ex_string, NULL);
- }
- if (value == NULL) {
- char *strim = strdup (g_string);
- free (ex_string);
- strim = strblk0 (strim);
- /* check if "strim" value is an alias */
- value = (char*)hash_lookup( kc_alias.cmd_table, strim, NULL);
- if (value != NULL)
- ex_string = strdup (value);
- else
- ex_string = strdup (g_string);
- free (strim);
- }
-
- /* Parse "ex_string" (for - or $ characters) */
- ilen = strlen(ex_string);
- for (i=0; i<ilen; i++) {
- if (ex_string[i] == '$') dollar_pos = i; }
- if (dollar_pos >= 0) {
- /* character "$" inside a key */
-
- char *command;
- char cmd_string[MAX_stringl];
- int lc;
-
- command = km_wait_input ("Enter value which should replace $", "",
- "HELP_DOLLAR_PANEL");
- if (command == NULL) return;
- lc = strlen(command);
- for (i=0; i<dollar_pos; i++) {
- cmd_string[i] = ex_string[i]; }
- for (i=dollar_pos; i<dollar_pos+lc; i++) {
- cmd_string[i] = command[i-dollar_pos]; }
- for (i=dollar_pos+lc; i<ilen-1+lc; i++) {
- /* skip "$" */
- cmd_string[i] = ex_string[i+1-lc]; }
- cmd_string[i] = '\0';
- exec_cmd_string (cmd_string, 1, km_display_cmdpan);
- free (command);
-
- } else if (ex_string[ilen-1] == '-') {
- /* key ending with minus */
-
- char *command;
- char cmd_string[MAX_stringl];
-
- if (ex_string[ilen-2] == '-') {
- /* key ending with double minus */
- strcpy (cmd_start,ex_string);
- cmd_start[ilen-2] = '\0';
- command = km_wait_input ("Give Missing Value","",
- "HELP_MINUS2_PANEL");
- if (command == NULL) return;
- strcat (cmd_start, command);
- exec_cmd_string (cmd_start, 1, km_display_cmdpan);
- } else {
- /* key ending with single minus */
- strcpy (cmd_start,ex_string);
- cmd_start[ilen-1] = '\0';
- command = km_wait_input ("Give Missing Value","",
- "HELP_MINUS_PANEL");
- if (command == NULL) return;
- sprintf (cmd_string,"%s %s", cmd_start, command);
- exec_cmd_string (cmd_string, 1, km_display_cmdpan); }
-
- } else {
-
- /* set background color to arm color */
- for (i = 0; i < 4; i++) /* PushButtonWidgetClass */
- if (button[i] != NULL) XtVaSetValues (button[i],
- XmNbackground, arm_pixel,
- XmNbottomShadowColor, ts_col,
- XmNtopShadowColor, bs_col,
- NULL);
- /* button with icons */
- if (stag->hi_pix != 0) {
- XtVaSetValues (button[3], XmNlabelPixmap, stag->hi_pix, NULL);
- XtVaSetValues (button[4], XmNlabelPixmap, stag->hi_pix, NULL);
- }
- /* for iconwidget just change XmNshadowType value */
- XtVaSetValues (button[4], XmNshadowType, XmSHADOW_IN, NULL);
- /*
- * Wait and flush Motif event queue to see the button "pressed in"
- * during the command execution.
- */
- for (i= 0; i < 1000; i++) km_FlushEvents();
-
- /* Execute command */
- exec_cmd_string (ex_string, 1, km_display_cmdpan);
- free (ex_string);
-
- /* Reset background color */
- if (stag->flag != 1) {
- button_pressed = NULL;
- hpix_pressed = 0;
- for (i = 0; i < 4; i++) /* PushButtonWidgetClass */
- if (button[i] != NULL) XtVaSetValues (button[i],
- XmNbackground, bg_pixel,
- XmNbottomShadowColor, bs_col,
- XmNtopShadowColor, ts_col,
- NULL);
- if (stag->pix != 0) { /* icon */
- XtVaSetValues (button[3], XmNlabelPixmap, stag->pix, NULL);
- XtVaSetValues (button[4], XmNlabelPixmap, stag->pix, NULL);
- }
- /* for iconwidget just change XmNshadowType value */
- XtVaSetValues (button[4],
- XmNshadowType, XmSHADOW_OUT, NULL);
- } else {
- button_pressed = pbut_widget;
- for (i = 0; i < 5; i++)
- bpressed[i] = button[i];
- hpix_pressed = stag->pix;
- }
-
- } /* end if (dollar_pos >= 0) */
-
- return;
-}
-
-static void km_panel_view (view_flag)
- int view_flag;
-{
- if ( view_flag == by_NAME ) {
- if (XtIsManaged (km_scrollPB)) XtUnmanageChild (km_scrollPB);
- if (XtIsManaged (km_scrollPI)) XtUnmanageChild (km_scrollPI);
- if (XtIsManaged (km_scrollPC)) XtUnmanageChild (km_scrollPC);
- if (XtIsManaged (km_scrollP1)) XtUnmanageChild (km_scrollP1);
- XtManageChild (km_scrollPN);
- } else if (view_flag == by_ICON) {
- if (XtIsManaged (km_scrollPN)) XtUnmanageChild (km_scrollPN);
- if (XtIsManaged (km_scrollPB)) XtUnmanageChild (km_scrollPB);
- if (XtIsManaged (km_scrollPC)) XtUnmanageChild (km_scrollPC);
- if (XtIsManaged (km_scrollP1)) XtUnmanageChild (km_scrollP1);
- XtManageChild (km_scrollPI);
- } else if (view_flag == by_BOTH) {
- if (XtIsManaged (km_scrollPN)) XtUnmanageChild (km_scrollPN);
- if (XtIsManaged (km_scrollPI)) XtUnmanageChild (km_scrollPI);
- if (XtIsManaged (km_scrollPC)) XtUnmanageChild (km_scrollPC);
- if (XtIsManaged (km_scrollP1)) XtUnmanageChild (km_scrollP1);
- XtManageChild (km_scrollPB);
- } else if (view_flag == by_COMMAND) {
- if (XtIsManaged (km_scrollPN)) XtUnmanageChild (km_scrollPN);
- if (XtIsManaged (km_scrollPI)) XtUnmanageChild (km_scrollPI);
- if (XtIsManaged (km_scrollPB)) XtUnmanageChild (km_scrollPB);
- if (XtIsManaged (km_scrollP1)) XtUnmanageChild (km_scrollP1);
- XtManageChild (km_scrollPC);
- } else if (view_flag == by_COMMAND1) {
- if (XtIsManaged (km_scrollPN)) XtUnmanageChild (km_scrollPN);
- if (XtIsManaged (km_scrollPI)) XtUnmanageChild (km_scrollPI);
- if (XtIsManaged (km_scrollPB)) XtUnmanageChild (km_scrollPB);
- if (XtIsManaged (km_scrollPC)) XtUnmanageChild (km_scrollPC);
- XtManageChild (km_scrollP1);
- }
-}
-
-static void panel_save (pwidget, name)
- Widget pwidget;
- char *name;
-{
- WidgetList bchild;
- FILE *ppf;
- char *fstr;
- String title;
- char display_string[MAX_stringl];
- Cardinal nbut;
- short nrow, ncol;
- Position xpos, ypos;
- Dimension dh, dw;
- int i, k, nbutton;
-
- /*
- * find and restore the context
- * (to get to the widgets belonging to this dialog)
- */
- UxKuipPanelContext = (_UxCkuipPanel *)UxGetContext( pwidget );
-
-
- /* Get values for panel geometry */
- XtVaGetValues (XtParent(pwidget), XmNtitle, &title,
- XmNx, &xpos, XmNy, &ypos,
- XmNheight, &dh, XmNwidth, &dw,
- NULL);
- /* We have to extract WM decoration from xpos and ypos */
- xpos = xpos - WM_x;
- ypos = ypos - WM_y;
- sprintf (display_string,"\npanel 0 d \'%s\' %dx%d+%d+%d\n",
- title, dw, dh, xpos, ypos);
-
- /* Get number and list of the rowcolumn push buttons children */
- XtVaGetValues (km_rowcolPI, XmNnumChildren, &nbut,
- XmNchildren, &bchild,
- XmNnumColumns, &nrow, NULL);
-
- fstr = strdup ("*\n* MOTIF_PANEL ");
- fstr = mstrcat (fstr, name);
- fstr = mstrcat (fstr, "\n*\npanel 0");
- ncol = (short) (nbut / nrow);
- nbutton = 0;
- for (k = 0; k < nrow; k++) {
- for (i = 0; i < ncol; i++) {
- char cval[MAX_string];
- int ilen;
-
- char *label = NULL;
- char *pixlab = NULL;
- char *value = NULL;
-
- if (i < 10)
- sprintf (cval,"\npanel %d.0%d ", k+1,i+1);
- else
- sprintf (cval,"\npanel %d.%d ", k+1,i+1);
- fstr = mstrcat (fstr, cval);
- /*
- * We have to retrieve the label from XmNuserData
- * because XmNlabelString can contain
- * - either [label]
- * - or [command]
- * according to the "view" setting
- * N.B. XmNuserData = label[#%pixlab]
- */
- XtVaGetValues (bchild[nbutton], XmNuserData, &label,
- NULL);
- if (label != NULL && !km_strempty (label) ) {
- /* retrieve real label */
- char *tmp;
-
- if ( (tmp = strstr( label, "#%" )) != NULL ) {
- pixlab = strdup (tmp);
- pixlab += 2;
- tmp[0] = '\0';
- }
- }
-
- if (label != NULL && !km_strempty (label) ) {
- value = (char*)hash_lookup( kc_alias.cmd_table, label, NULL);
- if( value != NULL)
- fstr = mstr3cat (fstr, "\'", value, "\' ");
- else
- fstr = mstrcat (fstr, ". ");
-
- if ( (ilen = strlen(label)) == 0 )
- fstr = mstrcat (fstr, ". ");
- else
- fstr = mstr3cat (fstr, "\'", label, "\' ");
- if ( pixlab != NULL && strlen(pixlab) != 0 )
- fstr = mstrcat (fstr, pixlab);
- XtFree (label);
- } else {
- fstr = mstrcat (fstr, ". ");
- }
- nbutton++;
- }
- }
- fstr = mstrcat (fstr, display_string);
-
- if ((ppf = fopen(name, "w")) == NULL) {
- char message[MAX_stringl];
-
- sprintf (message,"Unable to open file %s for write ", name);
- km_print_box (km_toplevel, 0, 0, message,0);
- return; }
- fwrite(fstr, sizeof(char), strlen(fstr), ppf);
- fclose(ppf);
-
-}
-
-static void okPNBCallback( widget, parent, data )
- Widget widget;
- Widget parent;
- XmAnyCallbackStruct *data;
-{
- String name = XtName(parent);
- char *panel_htitle = strdup (name);
- strconv (panel_htitle);
-
-#if defined(CERNLIB_LINUX)
- UxPopdownInterface(parent);
-#else
- UxDestroyInterface(parent);
-#endif
- km_reset_appShell (parent);
- hash_remove( kmpawid, panel_htitle );
-}
-
-static void savePNBCallback( widget, panel, callback_data )
- Widget widget;
- Widget panel;
- XmAnyCallbackStruct *callback_data;
-{
- FILE *tfp; /* Pointer to open file */
- char *macro_name;
-
-
-/* Get kuip macro name (panel definition) */
- macro_name = km_wait_input ("Give KUIP macro file name", "",
- "HELP_SAVE_PANEL");
- if (macro_name == NULL) return;
-
-
-/* Check if file already exists and put a warning message */
- if ((tfp = fopen(macro_name, "r")) != NULL) {
- char cmess[MAX_stringl];
- int answ;
-
- static char *clist[] = {"Yes", "No"};
-
- sprintf (cmess,"File %s already exists: overwrite it ? (Y/N)",
- macro_name);
- answ = km_select (XmDIALOG_QUESTION, cmess, 2, clist, 1);
- if (answ != 1) {
- fclose(tfp);
- return;
- }
- fclose(tfp);
- }
-
- /* Save file */
- panel_save (panel, macro_name);
-
- free (macro_name);
- return;
-}
-
-static void set_context_help( widget, panel, callback_data )
- Widget widget;
- Widget panel;
- XmAnyCallbackStruct *callback_data;
-{
- context_panel = panel;
-
- km_panel_context = True;
-}
-
-void km_ContextHelp()
-{
- Widget context_widget ;
- XEvent event_return;
-
- static Cursor context_cursor;
- static int ifirst = 0;
-
- if ( ifirst == 0 ) {
- ifirst = 1;
- context_cursor = XCreateFontCursor( XtDisplay(context_panel),
- XC_question_arrow ) ;
- }
-
-#if XmVERSION > 1 || XmREVISION >= 2
- context_widget = XmTrackingEvent( context_panel, context_cursor,
- True, &event_return ) ;
-
- if (event_return.xbutton.button == 3 || event_return.xbutton.button == 2) {
- km_panel_context = False;
- return;
- }
-#else
- context_widget = XmTrackingLocate( context_panel, context_cursor, True ) ;
-#endif
-
- if ( context_widget != NULL ) {
- /* In panels context_widget are the push buttons */
- char *label, *user_data;
-
- /*
- * We have to retrieve the label from XmNuserData
- * because XmNlabelString can contain
- * - either [label]
- * - or [command]
- * according to the "view" setting
- * N.B. XmNuserData = label[#%pixlab]
- */
- XtVaGetValues (context_widget,
- XmNuserData, &user_data,
- NULL);
- label = strdup (user_data);
- if (label != NULL && !km_strempty (label) ) { /* retrieve real label */
- char *tmp;
- if ( (tmp = strstr( label, "#%" )) != NULL ) {
- tmp[0] = '\0';
- }
- }
-
- km_panel_context = False;
-
- display_ContextHelp (label);
- free (label);
- }
-}
-
-static void display_ContextHelp (label)
- char *label;
-{
-extern C_PROTO_1(Widget create_kuipScroll, Widget);
-extern XmFontList help_font;
-
- Widget dialog;
- char title[MAX_string];
-
- static char file_help[] =
-" *** Menu \"File\" *** \n\n\
-You can select \"Save\" to save your panel\n\
-configuration into a file (and be able to retrieve\n\
-it later), or \"Close\" to close the panel\n\
-(erase from screen)";
- static char view_help[] =
-" *** Menu \"View\" *** \n\n\
-This gives you access to 3 viewing options for the panel:\n\
- - By Name (with string labels),\n\
- - By Icon (with pixmap labels) \n\
- - or both (By Name and Icon).";
- static char help_help[] =
-" *** Menu \"Help\" *** \n\n\
-This menu gives access on various help items\n\
-concerning panels handling inside KUIP/Motif";
-
- dialog = create_kuipScroll(km_toplevel);
- UxKuipScrollContext = (_UxCkuipScroll *)UxGetContext(dialog);
- sprintf (title, "%s Panel Help", class_name);
- XtVaSetValues(dialog, XmNtitle, title, NULL);
- /* set help_font (proportional) if defined */
- if (help_font != NULL )
- XtVaSetValues(scrollText, XmNfontList, help_font, NULL);
- XmTextSetAddMode(scrollText, True);
-
- if (!strcasecmp (label, "File")) {
- km_insert_string(scrollText, file_help, False);
- } else if (!strcasecmp (label, "View")) {
- km_insert_string(scrollText, view_help, False);
- } else if (!strcasecmp (label, "Help")) {
- km_insert_string(scrollText, help_help, False);
- } else {
- Boolean found = False;
-
- if (kmpahlp != NULL) {
- /* Look in hash table for panel helps */
- char *hlp = (char*)hash_lookup (kmpahlp, label, NULL);
-
- if (hlp != NULL) {
- km_insert_string(scrollText, hlp, False);
- found = True;
- }
- }
- if (!found) {
- char mess[512];
-
- sprintf (mess, "Cannot find help for \"%s\"\n", label);
- km_insert_string(scrollText, mess, False);
- }
- }
-
- UxPopupInterface(dialog, XtGrabNone);
- XtAddCallback(km_scrollOK, XmNactivateCallback,
- (XtCallbackProc)destroy_dialog, dialog);
- XtAddCallback(dialog, XmNdestroyCallback,
- (XtCallbackProc)destroy_dialog, dialog);
-}
-
-static void destroy_dialog(w, dialog, call_data)
- Widget w;
- Widget dialog;
- XmAnyCallbackStruct *call_data;
-{
- UxDestroyInterface(dialog);
-}
-
-static void viewPNBCallback( widget, panel, callback_data )
- Widget widget;
- Widget panel;
- XmToggleButtonCallbackStruct *callback_data;
-{
- /* when a button gets unselected don't do anything */
- if (!callback_data->set) return;
-
- /*
- * find and restore the context
- * (to get to the widgets belonging to this dialog)
- */
- UxKuipPanelContext = (_UxCkuipPanel *)UxGetContext( panel );
-
- XtVaSetValues(widget, XmNset, True, NULL);
-
- if (widget == km_viewPNB_name) {
- km_panel_view (by_NAME);
- XtVaSetValues(km_viewPNB_icon, XmNset, False, NULL);
- XtVaSetValues(km_viewPNB_both, XmNset, False, NULL);
- XtVaSetValues(km_viewPNB_command, XmNset, False, NULL);
- XtVaSetValues(km_viewPNB_command1, XmNset, False, NULL);
- } else if (widget == km_viewPNB_icon) {
- km_panel_view (by_ICON);
- XtVaSetValues(km_viewPNB_name, XmNset, False, NULL);
- XtVaSetValues(km_viewPNB_both, XmNset, False, NULL);
- XtVaSetValues(km_viewPNB_command, XmNset, False, NULL);
- XtVaSetValues(km_viewPNB_command1, XmNset, False, NULL);
- } else if (widget == km_viewPNB_both) {
- km_panel_view (by_BOTH);
- XtVaSetValues(km_viewPNB_icon, XmNset, False, NULL);
- XtVaSetValues(km_viewPNB_name, XmNset, False, NULL);
- XtVaSetValues(km_viewPNB_command, XmNset, False, NULL);
- XtVaSetValues(km_viewPNB_command1, XmNset, False, NULL);
- } else if (widget == km_viewPNB_command) {
- km_panel_view (by_COMMAND);
- XtVaSetValues(km_viewPNB_icon, XmNset, False, NULL);
- XtVaSetValues(km_viewPNB_name, XmNset, False, NULL);
- XtVaSetValues(km_viewPNB_both, XmNset, False, NULL);
- XtVaSetValues(km_viewPNB_command1, XmNset, False, NULL);
- } else if (widget == km_viewPNB_command1) {
- km_panel_view (by_COMMAND1);
- XtVaSetValues(km_viewPNB_icon, XmNset, False, NULL);
- XtVaSetValues(km_viewPNB_name, XmNset, False, NULL);
- XtVaSetValues(km_viewPNB_both, XmNset, False, NULL);
- XtVaSetValues(km_viewPNB_command, XmNset, False, NULL);
- }
-}
-
-static char *find_hlp( name )
- char *name;
-{
- if (kmpahlp == NULL) {
- kmpahlp = hash_create( PAHLP_TABLE_SIZE );
- hash_config( kmpahlp, "struct" );
- }
-
- return (char*)hash_lookup( kmpahlp, name, NULL );
-}
-
-/*
- * action routine for /MOTIF/PANEL_HELP/CREATE
- */
-int kxphlpc()
-{
- char *label = ku_getc();
- char *file = ku_gets();
- char *hlp;
- FILE *fp;
-
- if ( (hlp = find_hlp( label )) != NULL )
- hash_remove( kmpahlp, label );
-
- if ((fp = fopen(file, "r")) != NULL) {
- char line[1024];
- char *buf = strdup( "" );
-
- while( fgets( line, (sizeof line), fp ) != NULL )
- buf = mstrcat( buf, line );
-
- if (kmpahlp == NULL) {
- kmpahlp = hash_create( PAHLP_TABLE_SIZE );
- hash_config( kmpahlp, "struct" );
- }
- hash_insert( kmpahlp, label, buf, 0);
-
- } else {
- char message[MAX_stringl];
-
- sprintf (message,"cannot find help corresponding to button %s", label);
- km_warn_user(km_toplevel, message, "");
- }
-
- free (file);
-
- return 0;
-}
-
-/*
- * action routine for /MOTIF/PANEL_HELP/LIST
- */
-int kxphlpl()
-{
- int n = hash_entries( kmpahlp );
-
- if( n == 0 ) {
- printf( " No help defined for user panels.\n");
- } else {
- HashArray *hlp = hash_array( kmpahlp );
- int i;
-
- printf( " Panel(s) help items:\n" );
- for( i = 0; i < n; i++ )
- printf( " %-10s => %s\n", hlp[i].name, (char*)hlp[i].value );
-
- free( (char*)hlp );
- }
-
- return 0;
-}
-
-/*
- * action routine for /MOTIF/PANEL_HELP/DELETE
- */
-int kxphlpd()
-{
- int npar = ku_npar();
-
- if (npar >= 1) {
- char *label = ku_getc();
-
- if (label == NULL ||
- strcmp( label, "*" ) == 0 || km_strempty (label) ) {
- /* Delete all user defined help items */
- hash_clear( kmpahlp );
- } else {
- hash_remove( kmpahlp, label );
- }
- } else {
- /* Delete all entries */
- hash_clear( kmpahlp );
- }
-
- return 0;
-}
-
-/*
- * action routine for /MOTIF/PANEL_HELP/PRINT
- */
-int kxphlpp()
-{
- char *label = ku_getc();
-
- if (label == NULL ||
- strcmp( label, "*" ) == 0 || km_strempty (label) ) {
- kxphlpl();
- } else {
- Boolean found = False;
-
- if (kmpahlp != NULL) {
- /* Look in hash table for panel helps */
- char *hlp = (char*)hash_lookup (kmpahlp, label, NULL);
-
- if (hlp != NULL) {
- printf( " %-10s => %s\n", label, (char*)hlp );
- found = True;
- }
- }
- if (!found) printf( " No help defined for user panels.\n");
- }
-
- return 0;
-}
-
-/*
- * Replace all blanks inside string by "-" (minus)
- */
-static void strconv( str )
- char *str;
-{
- if( str != NULL ) {
- char *p;
- for( p = str; *p != '\0'; p++ ) {
- if( *p == ' ') *p = '-';
- }
- }
-}
diff --git a/src/packlib/kuip/code_motif/mkfont.h b/src/packlib/kuip/code_motif/mkfont.h
deleted file mode 100644
index 72b9bb3..0000000
--- a/src/packlib/kuip/code_motif/mkfont.h
+++ /dev/null
@@ -1,25 +0,0 @@
-/*
- * $Id: mkfont.h,v 1.1.1.1 1996/03/08 15:33:12 mclareni Exp $
- *
- * $Log: mkfont.h,v $
- * Revision 1.1.1.1 1996/03/08 15:33:12 mclareni
- * Kuip
- *
- */
-#ifndef _mkfont_
-#define _mkfont_
-
-/* Some font definitions */
-#define COURIER_MR1 "*-courier-medium-r-normal*-120-*"
-#define COURIER_MR2 "*-courier-medium-r-normal*-140-*"
-#define COURIER_MR3 "*-courier-medium-r-normal*-180-*"
-#define COURIER_BR0 "*-courier-bold-r-normal*-120-*"
-#define COURIER_BR1 "*-courier-bold-r-normal*-120-*"
-#define COURIER_BR2 "*-courier-bold-r-normal*-140-*"
-#define COURIER_BO1 "*-courier-bold-o-normal*-120-*"
-#define COURIER_BO2 "*-courier-bold-o-normal*-140-*"
-#define COURIER_MO1 "*-courier-medium-o-normal*-120-*"
-#define COURIER_MO2 "*-courier-medium-o-normal*-140-*"
-
-#endif /* _mkfont_ */
-
diff --git a/src/packlib/kuip/code_motif/mkincl.h b/src/packlib/kuip/code_motif/mkincl.h
deleted file mode 100644
index 8468d8c..0000000
--- a/src/packlib/kuip/code_motif/mkincl.h
+++ /dev/null
@@ -1,57 +0,0 @@
-/*
- * $Id: mkincl.h,v 1.1.1.1 1996/03/08 15:33:12 mclareni Exp $
- *
- * $Log: mkincl.h,v $
- * Revision 1.1.1.1 1996/03/08 15:33:12 mclareni
- * Kuip
- *
- */
-
-/*** X11 and Xm Include files (most frequently used) ***/
-#ifndef _mkincl_
-#define _mkincl_
-
-#include <X11/Xproto.h>
-#include <X11/Xatom.h>
-#include <X11/Intrinsic.h>
-#include <X11/IntrinsicP.h>
-#include <X11/Shell.h>
-#include <X11/cursorfont.h>
-#include <X11/StringDefs.h>
-#include <Xm/Xm.h>
-#include <Xm/XmP.h>
-#include <Xm/Label.h>
-#include <Xm/LabelG.h>
-#include <Xm/LabelP.h>
-#include <Xm/BulletinB.h>
-#include <Xm/RowColumn.h>
-#include <Xm/ArrowB.h>
-#include <Xm/CascadeB.h>
-#include <Xm/CascadeBG.h>
-#include <Xm/SelectioB.h>
-#include <Xm/Command.h>
-#include <Xm/CutPaste.h>
-#include <Xm/DialogS.h>
-#include <Xm/DrawingA.h>
-#include <Xm/DrawnB.h>
-#include <Xm/FileSB.h>
-#include <Xm/Form.h>
-#include <Xm/Frame.h>
-#include <Xm/List.h>
-#include <Xm/MainW.h>
-#include <Xm/MenuShell.h>
-#include <Xm/MessageB.h>
-#include <Xm/PanedW.h>
-#include <Xm/PushB.h>
-#include <Xm/PushBG.h>
-#include <Xm/Scale.h>
-#include <Xm/ScrollBar.h>
-#include <Xm/ScrolledW.h>
-#include <Xm/Separator.h>
-#include <Xm/SeparatoG.h>
-#include <Xm/Text.h>
-#include <Xm/ToggleB.h>
-#include <Xm/ToggleBG.h>
-
-#endif /* _mkincl_ */
-
diff --git a/src/packlib/kuip/code_motif/mkmpan.c b/src/packlib/kuip/code_motif/mkmpan.c
deleted file mode 100644
index a18f904..0000000
--- a/src/packlib/kuip/code_motif/mkmpan.c
+++ /dev/null
@@ -1,738 +0,0 @@
-/*
- * $Id: mkmpan.c,v 1.3 1997/09/01 07:53:34 cremel Exp $
- *
- * $Log: mkmpan.c,v $
- * Revision 1.3 1997/09/01 07:53:34 cremel
- * Implement the possibility to "close" a palette with commands:
- * MULTI_PANEL <title> close
- * or:
- * MULTI_PANEL last close
- * Update HELP accordingly.
- *
- * Revision 1.2 1997/08/29 10:12:26 cremel
- * Increase version number to 2.07/15.
- * Bug correction for the "kuipPalette" widget (KUIP command "multi_panel"):
- * after opening 10 palettes one could not open anymore even after
- * closing one/some of them.
- *
- * Revision 1.1.1.1 1996/03/08 15:33:09 mclareni
- * Kuip
- *
- */
-/*CMZ : 2.06/03 04/11/94 14.54.24 by N.Cremel*/
-/*-- Author :*/
-/*-- Author : N.Cremel 10/08/92*/
-/******************************************************************************/
-/* */
-/* MOTIF-based library for KUIP - deck MKMPAN */
-/* */
-/* Basic Interface for "KUIP/Motif Palettes" (multi_panel) */
-/* (connected to the files //KUIP/XMCLIB/KUXPAL, KUXPAB, KUXPAP */
-/* for building the various palette components with Architect : */
-/* "create_kuipPalette", "create_PalButton", "create_PalPanel" */
-/* */
-/******************************************************************************/
-
-#include "kuip/kuip.h"
-#include "kuip/kfor.h"
-#include "kuip/kmenu.h"
-#include "kuip/kflag.h"
-#include "kuip/klink.h"
-
-#include "mkincl.h"
-#include "mkdims.h"
-#include "kuip/mkutfu.h"
-#include "mkutfm.h"
-#include "mkutdm.h"
-#define CONTEXT_MACRO_ACCESS 1
-#include "mkuxpl.h"
-#include "mkuxpb.h"
-#include "mkuxpp.h"
-#undef CONTEXT_MACRO_ACCESS
-#include "kuip/browh1.h"
-#include "browh2.h"
-
-
-/***********************************************************************
- * *
- * Forward declarations of local functions. *
- * *
- ***********************************************************************/
-static C_PROTO_2 (void km_display_palette,
- char *name,
- char *geometry);
-static C_PROTO_1 (int get_pal_context,
- Widget w);
-static C_PROTO_1 (int get_pnb_context,
- Widget w);
-static C_PROTO_1 (int get_pnp_context,
- Widget w);
-static C_PROTO_3 (void add_panel_button,
- Widget w,
- PaletteStruct *palw,
- XmAnyCallbackStruct *cbs);
-static C_PROTO_3 (void close_palette,
- Widget w,
- PaletteStruct *palw,
- XmAnyCallbackStruct *cbs);
-static C_PROTO_1 (void ClosePal,
- PaletteStruct *palw);
-static void exit_appl (Widget w, caddr_t tag, XmAnyCallbackStruct *cbs);
-static C_PROTO_3(void panel_set,
- Widget w,
- caddr_t tag,
- XmAnyCallbackStruct *cbs);
-static C_PROTO_3(void panel_enter,
- Widget widget,
- char *name,
- XEnterWindowEvent *ev);
-static C_PROTO_3(void viewNPALCallback,
- Widget widget,
- PaletteStruct *palst,
- XmToggleButtonCallbackStruct *callback_data);
-static C_PROTO_3(void viewIPALCallback,
- Widget widget,
- PaletteStruct *palst,
- XmToggleButtonCallbackStruct *callback_data);
-static C_PROTO_3(void viewBPALCallback,
- Widget widget,
- PaletteStruct *palst,
- XmToggleButtonCallbackStruct *callback_data);
-static void km_palette_view (int flag);
-
-
-
-/***********************************************************************
- * *
- * Local datas. *
- * *
- ***********************************************************************/
-
-#define MAX_PAL 10
-
-static PaletteStruct *cur_palette;
-static npal = 0;
-static Boolean addPan = True; /* Allow panel addition into a palette */
-static lpal[MAX_PAL] = {-1, -1, -1, -1, -1, -1, -1, -1, -1, -1};
-
-static PaletteStruct palette[MAX_PAL];
-static Pal *pal_panel[MAX_PAL] =
- /* list of "starting panels" for a given palette */
- {NULL, NULL, NULL, NULL, NULL,
- NULL, NULL, NULL, NULL, NULL};
-static int n_panel;
-
-/*
- * C callable interface to command "multi_panel ... " (for palette)
- * (called by action routine kxpalet)
- *
- */
-
-void km_palette (title, geometry)
- char *title, *geometry; /* if NULL use default values */
-{
-
- /* "multi_panel end" */
- if (title != NULL && !strcasecmp(title, "end")) {
- kc_window.palette_flag = 0;
- return;
- }
-
-
- /* "multi_panel same" */
- if (title != NULL && !strcasecmp(title, "same")) {
- kc_window.palette_flag = 1;
- return;
- }
-
- /* "multi_panel title close" */
- if (title != NULL && !strcasecmp(geometry, "close")) {
- /* Close palette */
- int np;
- if (!strcasecmp(title, "LAST")) {
- if (cur_palette != NULL) ClosePal( cur_palette );
- } else {
- for (np=0; np<MAX_PAL; np++) {
- char *ptit;
- PaletteStruct *pw = &palette[np];
- if (pw == NULL) break;
- XtVaGetValues(XtParent(pw->widget), XmNtitle, &ptit, NULL);
- if (!strcasecmp(title, ptit)) ClosePal( pw );
- }
- }
- return;
- }
-
- kc_window.palette_flag = 1;
- addPan = True;
-
- if (npal >= MAX_PAL) {
- km_warn_user(km_toplevel, "Cannot open more than 10 kuipPalette", "");
- addPan = False;
- return;
- }
-
- km_display_palette (title, geometry);
-}
-
-
-/*
- * action routine for /MOTIF/MULTI_PANEL
- */
-int kxpalet()
-{
- char *title = ku_gets();
- char *geometry = ku_gets();
-
- km_palette ( title, geometry );
-
- return 0;
-}
-
-
-/******************************************************************************/
-/* void km_display_palette */
-/* */
-/******************************************************************************/
-static void km_display_palette(name, geometry)
- char *name, *geometry;
-{
- Widget scb;
- int np;
-
- /* Look for a free palette number */
- for (np=0; np<MAX_PAL; np++) {
- if (lpal[np] == -1) break;
- }
- lpal[np] = npal;
-
- /* Interface built by Architect */
- palette[np].widget = (Widget) create_kuipPalette();
-
- palette[np].npal = np;
- palette[np].view_flag = by_ICON;
-
- palette[np].last_pan = NULL;
-
- XtVaSetValues(XtParent(palette[np].widget),
- XmNtitle, name,
- XmNgeometry, geometry,
- NULL);
-
- (void)get_pal_context(palette[np].widget);
-
- XtVaGetValues(PalScWindow,
- XmNhorizontalScrollBar, &scb,
- NULL);
- XtUnmanageChild(scb);
-
- /* File menu */
- XtAddCallback(km_addPAL, XmNactivateCallback,
- (XtCallbackProc)add_panel_button, &palette[np]);
- XtAddCallback(km_closePAL, XmNactivateCallback,
- (XtCallbackProc)close_palette, &palette[np]);
- XtAddCallback(km_exitPAL, XmNactivateCallback,
- (XtCallbackProc)exit_appl, NULL);
- /* View menu */
- XtAddCallback(km_viewPAL_name, XmNvalueChangedCallback,
- (XtCallbackProc)viewNPALCallback, &palette[np]);
- XtAddCallback(km_viewPAL_icon, XmNvalueChangedCallback,
- (XtCallbackProc)viewIPALCallback, &palette[np]);
- XtAddCallback(km_viewPAL_both, XmNvalueChangedCallback,
- (XtCallbackProc)viewBPALCallback, &palette[np]);
- /* Help menu */
- XtAddCallback(km_helpPAL, XmNactivateCallback,
- (XtCallbackProc)km_do_help, (XtPointer)"MULTI_PANEL");
-
- /* display palette */
- UxPopupInterface(palette[np].widget, XtGrabNone);
-
- /*
- * If the dialog was already open, UxPopupInterface does nothing. In
- * this case, at least make sure the window is raised to the top
- * of the window tree (or as high as it can get).
- */
- XMapRaised(XtDisplay(palette[np].widget),
- XtWindow(XtParent(palette[np].widget)));
-
- cur_palette = &palette[np];
- n_panel = 0;
- npal++;
-}
-
-static int get_pal_context(w)
- Widget w;
-{
- if (!w) return -1;
-
- /*
- * find and restore the context
- * (to get to the widgets belonging to this dialog)
- */
- UxKuipPaletteContext = (_UxCkuipPalette *)UxGetContext(w);
-
- return 1;
-}
-
-static int get_pnb_context(w)
- Widget w;
-{
- if (!w) return -1;
-
- /*
- * find and restore the context
- * (to get to the widgets belonging to this dialog)
- */
- UxPalButtonContext = (_UxCPalButton *)UxGetContext(w);
-
- return 1;
-}
-
-static int get_pnp_context(w)
- Widget w;
-{
- if (!w) return -1;
-
- /*
- * find and restore the context
- * (to get to the widgets belonging to this dialog)
- */
- UxPalPanelContext = (_UxCPalPanel *)UxGetContext(w);
-
- return 1;
-}
-
-static void add_panel_button(w, palw, cbs)
- Widget w;
- PaletteStruct *palw;
- XmAnyCallbackStruct *cbs;
-{
- char *panel_name;
- char exstr[MAX_stringl];
-
- int flag = kc_window.palette_flag;
-
- /* reset palette_flag so that panel is not added twice ... */
- kc_window.palette_flag = -1;
-
- /* ask name of Kuip macro with the panel description */
- panel_name = km_wait_input ("Give KUIP macro file name",
- "panel", "HELP_PANEL");
- if (panel_name == NULL) return;
- sprintf (exstr,"/MACRO/EXEC %s", panel_name);
- exec_cmd_string (exstr, 0, NULL);
-
- addPan = True;
- km_panel_add (palw, panel_name, NULL);
- kc_window.palette_flag = flag;
-}
-
-static void close_palette(w, palw, cbs)
- Widget w;
- PaletteStruct *palw;
- XmAnyCallbackStruct *cbs;
-{
- ClosePal(palw);
-}
-
-static void ClosePal(palw)
- PaletteStruct *palw;
-{
- int np = palw->npal;
- int i;
-
- if (palw == NULL) return;
-
- UxDestroyInterface(palw->widget);
-
- /* Reset this palette */
- lpal[np] = -1;
- npal--;
- palw->widget = NULL;
- pal_panel[np] = NULL;
- palw->last_pan = NULL;
- cur_palette = NULL;
- for (i=npal; i>=0; i--) {
- /* cur_palette is the last "valid" palette in the list */
- if (lpal[i] >=0) {
- cur_palette = &palette[i];
- break;
- }
- }
-}
-
-static void exit_appl( Widget w, caddr_t tag, XmAnyCallbackStruct *cbs)
-{
- exec_cmd_string ("/KUIP/EXIT", 0, NULL);
-}
-
-void km_panel_add (pw, name, geometry)
- PaletteStruct *pw;
- char *name, *geometry;
-{
- int np;
- Boolean close_flag = False;
-
- static char *enter_tag;
-
- static Pal *panel[MAX_PAL] = /* list of panels for a given palette */
- {NULL, NULL, NULL, NULL, NULL,
- NULL, NULL, NULL, NULL, NULL};
- static Dimension panel_width;
-
- static ifirst = 0;
-
- if (!addPan) { /* Maximum number of kuipPalette reached */
- km_warn_user(km_toplevel,
- "Close and open a new kuipPalette before panel execution!", "");
- return;
- }
-
- n_panel++;
- if (pw == NULL) pw = cur_palette;
- if (pw == NULL) return;
- np = pw->npal;
- (void)get_pal_context(pw->widget);
-
- if (pal_panel[np] == NULL) {
- panel[np] = pal_panel[np] = (Pal *) malloc (sizeof (Pal));
- panel[np]->npan = 0;
- } else {
- panel[np] = panel[np]->next = (Pal *) malloc (sizeof (Pal));
- panel[np]->npan = n_panel;
- }
- panel[np]->PALwidget = pw->widget;
- panel[np]->npal = np;
- panel[np]->next = NULL;
-
- panel[np]->Bwidget = create_PalButton(km_palForm);
- (void)get_pnb_context(panel[np]->Bwidget);
- if (kc_window.panel_title != NULL)
- XtVaSetValues(km_palLabelB,
- RES_CONVERT( XmNlabelString,kc_window.panel_title ),
- NULL);
-
- panel[np]->Pwidget = create_PalPanel(km_palForm);
- (void)get_pnp_context(panel[np]->Pwidget);
- if (kc_window.panel_title != NULL)
- XtVaSetValues(km_palLabelP,
- RES_CONVERT( XmNlabelString,kc_window.panel_title ),
- NULL);
-
- if (ifirst == 0) {
- XtVaGetValues (XtParent(km_palForm), XmNwidth, &panel_width, NULL);
- /* take off the offset on both sides */
- panel_width -= 10;
- ifirst++;
- }
-
- /* Create and manage panel buttons inside of RowColumn widget */
- km_panel_buttons (panel[np]->Pwidget, name, pw->view_flag, 1);
-
-
- XtVaSetValues (panel[np]->Bwidget, XmNwidth, panel_width, NULL);
- XtVaSetValues (panel[np]->Pwidget, XmNwidth, panel_width, NULL);
- if (geometry != NULL && !km_strempty(geometry)) {
- int ih, iw, ix, iy;
-
- iw = ih = 0;
- if (geometry[0] == 'c' || geometry[0] == 'C') { /* `Close' */
- char cf;
- close_flag = True;
- if (geometry[1] == ':')
- sscanf (geometry, "%c:%dx%d+%d+%d", &cf, &iw, &ih, &ix, &iy);
- } else {
- sscanf (geometry, "%dx%d+%d+%d", &iw, &ih, &ix, &iy);
- }
- if (iw != 0) {
- XtVaSetValues(panel[np]->Pwidget, XmNwidth, (Dimension)iw, NULL );
- XtVaSetValues (panel[np]->Bwidget, XmNwidth, (Dimension)iw, NULL);
- }
- if (ih != 0)
- XtVaSetValues(panel[np]->Pwidget, XmNheight, (Dimension)ih, NULL );
- }
-
- if (close_flag ) {
- panel[np]->Mwidget = panel[np]->Bwidget;
- } else {
- panel[np]->Mwidget = panel[np]->Pwidget;
- }
-
- /* attach next panel at end of panel list */
- if (!pw->last_pan) {
- XtVaSetValues(panel[np]->Bwidget,
- XmNtopAttachment, XmATTACH_FORM,
- XmNtopOffset, 5,
- XmNleftAttachment, XmATTACH_FORM,
- XmNleftOffset, 5,
- NULL);
- XtVaSetValues(panel[np]->Pwidget,
- XmNtopAttachment, XmATTACH_FORM,
- XmNtopOffset, 5,
- XmNleftAttachment, XmATTACH_FORM,
- XmNleftOffset, 5,
- NULL);
- } else {
- XtVaSetValues(panel[np]->Bwidget,
- XmNtopAttachment, XmATTACH_WIDGET,
- XmNtopOffset, 5,
- XmNtopWidget, pw->last_pan->Mwidget,
- XmNleftAttachment, XmATTACH_FORM,
- XmNleftOffset, 5,
- NULL);
- XtVaSetValues(panel[np]->Pwidget,
- XmNtopAttachment, XmATTACH_WIDGET,
- XmNtopOffset, 5,
- XmNtopWidget, pw->last_pan->Mwidget,
- XmNleftAttachment, XmATTACH_FORM,
- XmNleftOffset, 5,
- NULL);
- }
- pw->last_pan = panel[np];
-
- XtManageChild(panel[np]->Mwidget);
-
- XtAddCallback(arrowButtonB, XmNactivateCallback,
- (XtCallbackProc)panel_set, panel[np]);
- XtAddCallback(arrowButtonP, XmNactivateCallback,
- (XtCallbackProc)panel_set, panel[np]);
- enter_tag = NULL;
- if (kc_window.panel_name != NULL) enter_tag = strdup (kc_window.panel_name);
- XtAddEventHandler(panel[np]->Pwidget, EnterWindowMask, False,
- (XtEventHandler)panel_enter, (XtPointer)enter_tag);
-
-
- XmUpdateDisplay(pw->widget);
-}
-
-
-static void km_palette_view (view_flag)
- int view_flag;
-{
- if ( view_flag == by_NAME ) {
- if (XtIsManaged (km_scrollMB)) XtUnmanageChild (km_scrollMB);
- if (XtIsManaged (km_scrollMI)) XtUnmanageChild (km_scrollMI);
- if (XtIsManaged (km_scrollMC)) XtUnmanageChild (km_scrollMC);
- if (XtIsManaged (km_scrollM1)) XtUnmanageChild (km_scrollM1);
- XtManageChild (km_scrollMN);
- } else if (view_flag == by_ICON) {
- if (XtIsManaged (km_scrollMN)) XtUnmanageChild (km_scrollMN);
- if (XtIsManaged (km_scrollMB)) XtUnmanageChild (km_scrollMB);
- if (XtIsManaged (km_scrollMC)) XtUnmanageChild (km_scrollMC);
- if (XtIsManaged (km_scrollM1)) XtUnmanageChild (km_scrollM1);
- XtManageChild (km_scrollMI);
- } else if (view_flag == by_BOTH) {
- if (XtIsManaged (km_scrollMN)) XtUnmanageChild (km_scrollMN);
- if (XtIsManaged (km_scrollMI)) XtUnmanageChild (km_scrollMI);
- if (XtIsManaged (km_scrollMC)) XtUnmanageChild (km_scrollMC);
- if (XtIsManaged (km_scrollM1)) XtUnmanageChild (km_scrollM1);
- XtManageChild (km_scrollMB);
- } else if (view_flag == by_COMMAND) {
- if (XtIsManaged (km_scrollMN)) XtUnmanageChild (km_scrollMN);
- if (XtIsManaged (km_scrollMI)) XtUnmanageChild (km_scrollMI);
- if (XtIsManaged (km_scrollMB)) XtUnmanageChild (km_scrollMB);
- if (XtIsManaged (km_scrollM1)) XtUnmanageChild (km_scrollM1);
- XtManageChild (km_scrollMC);
- } else if (view_flag == by_COMMAND1) {
- if (XtIsManaged (km_scrollMN)) XtUnmanageChild (km_scrollMN);
- if (XtIsManaged (km_scrollMI)) XtUnmanageChild (km_scrollMI);
- if (XtIsManaged (km_scrollMB)) XtUnmanageChild (km_scrollMB);
- if (XtIsManaged (km_scrollMC)) XtUnmanageChild (km_scrollMC);
- XtManageChild (km_scrollM1);
- }
-}
-
-
-static void panel_set(w, tag, cbs)
- Widget w;
- caddr_t tag;
- XmAnyCallbackStruct *cbs;
-{
- Pal *palb = (Pal *) tag;
- Pal *panel, *last_panel;
-
- int np = palb->npal;
-
- (void)get_pnb_context(palb->Bwidget);
- (void)get_pnp_context(palb->Pwidget);
-
- if (palb->Bwidget != NULL &&
- XtIsManaged (palb->Bwidget)) {
- palb->Mwidget = palb->Pwidget;
- } else if (palb->Pwidget != NULL &&
- XtIsManaged (palb->Pwidget)) {
- palb->Mwidget = palb->Bwidget;
- }
-
- for( panel = pal_panel[np]; panel != NULL; panel = panel->next ) {
- if (XtIsManaged (palb->Bwidget))
- XtUnmanageChild(panel->Bwidget);
- if (XtIsManaged (palb->Pwidget))
- XtUnmanageChild(panel->Pwidget);
- }
-
- /* Reset attachments of all panels */
- last_panel = pal_panel[np];
- for( panel = pal_panel[np]; panel != NULL; panel = panel->next ) {
- XtUnmanageChild(panel->Mwidget);
- if (panel->npan != 0) {
- XtVaSetValues(panel->Bwidget,
- XmNtopAttachment, XmATTACH_WIDGET,
- XmNtopOffset, 5,
- XmNtopWidget, last_panel->Mwidget,
- XmNleftAttachment, XmATTACH_FORM,
- XmNleftOffset, 5,
- NULL);
- XtVaSetValues(panel->Pwidget,
- XmNtopAttachment, XmATTACH_WIDGET,
- XmNtopOffset, 5,
- XmNtopWidget, last_panel->Mwidget,
- XmNleftAttachment, XmATTACH_FORM,
- XmNleftOffset, 5,
- NULL);
-
- }
- last_panel = panel;
- }
-
- for( panel = pal_panel[np]; panel != NULL; panel = panel->next ) {
- if (panel->Mwidget == panel->Pwidget) {
- /* Set correct viewing option before managing */
- Boolean set = False;
- int view_flag;
-
- (void)get_pal_context(panel->PALwidget);
- if (!set) {
- XtVaGetValues(km_viewPAL_name, XmNset, &set, NULL);
- if (set) view_flag = by_NAME;
- }
- if (!set) {
- XtVaGetValues(km_viewPAL_icon, XmNset, &set, NULL);
- if (set) view_flag = by_ICON;
- }
- if (!set) {
- XtVaGetValues(km_viewPAL_both, XmNset, &set, NULL);
- if (set) view_flag = by_BOTH;
- }
- (void)get_pnp_context(panel->Mwidget);
- km_palette_view (view_flag);
- }
- XtManageChild(panel->Mwidget);
- }
-
-}
-
-static void panel_enter(widget, name, ev)
- Widget widget;
- char *name;
- XEnterWindowEvent *ev;
-{
- if (kc_window.panel_name != NULL) free (kc_window.panel_name);
- if (name != NULL) {
- kc_window.panel_name = strdup (name);
- } else {
- kc_window.panel_name = NULL;
- }
-}
-
-static void viewNPALCallback( widget, palst, callback_data )
- Widget widget;
- PaletteStruct *palst;
- XmToggleButtonCallbackStruct *callback_data;
-{
- Pal *pan;
-
- Widget pal = palst->widget;
- int np = palst->npal;
-
- palst->view_flag = by_NAME;
-
- /* when a button gets unselected don't do anything */
- if (callback_data->set) return;
-
- /* Loop on all panels */
- for( pan = pal_panel[np]; pan != NULL; pan = pan->next ) {
- Widget panel;
-
- if (pan->Mwidget == pan->Bwidget) continue;
- panel = pan->Pwidget;
-
- (void)get_pnp_context(panel);
-
- km_palette_view (by_NAME);
- }
-
- (void)get_pal_context(pal);
-
- XtVaSetValues(km_viewPAL_name, XmNset, True, NULL);
- XtVaSetValues(km_viewPAL_icon, XmNset, False, NULL);
- XtVaSetValues(km_viewPAL_both, XmNset, False, NULL);
-}
-
-static void viewIPALCallback( widget, palst, callback_data )
- Widget widget;
- PaletteStruct *palst;
- XmToggleButtonCallbackStruct *callback_data;
-{
- Pal *pan;
-
- Widget pal = palst->widget;
- int np = palst->npal;
-
- palst->view_flag = by_ICON;
-
- /* when a button gets unselected don't do anything */
- if (callback_data->set) return;
-
- /* Loop on all panels */
- for( pan = pal_panel[np]; pan != NULL; pan = pan->next ) {
- Widget panel;
-
- if (pan->Mwidget == pan->Bwidget) continue;
- panel = pan->Pwidget;
-
- (void)get_pnp_context(panel);
-
- km_palette_view (by_ICON);
- }
-
- (void)get_pal_context(pal);
-
- XtVaSetValues(km_viewPAL_icon, XmNset, True, NULL);
- XtVaSetValues(km_viewPAL_name, XmNset, False, NULL);
- XtVaSetValues(km_viewPAL_both, XmNset, False, NULL);
-}
-
-static void viewBPALCallback( widget, palst, callback_data )
- Widget widget;
- PaletteStruct *palst;
- XmToggleButtonCallbackStruct *callback_data;
-{
- Pal *pan;
-
- Widget pal = palst->widget;
- int np = palst->npal;
-
- palst->view_flag = by_BOTH;
-
- /* when a button gets unselected don't do anything */
- if (callback_data->set) return;
-
- /* Loop on all panels */
- for( pan = pal_panel[np]; pan != NULL; pan = pan->next ) {
- Widget panel;
-
- if (pan->Mwidget == pan->Bwidget) continue;
- panel = pan->Pwidget;
-
- (void)get_pnp_context(panel);
-
- km_palette_view (by_BOTH);
- }
-
- (void)get_pal_context(pal);
-
- XtVaSetValues(km_viewPAL_both, XmNset, True, NULL);
- XtVaSetValues(km_viewPAL_name, XmNset, False, NULL);
- XtVaSetValues(km_viewPAL_icon, XmNset, False, NULL);
-}
diff --git a/src/packlib/kuip/code_motif/mksreg.h b/src/packlib/kuip/code_motif/mksreg.h
deleted file mode 100644
index 0c9da31..0000000
--- a/src/packlib/kuip/code_motif/mksreg.h
+++ /dev/null
@@ -1,16 +0,0 @@
-/*
- * $Id: mksreg.h,v 1.1.1.1 1996/03/08 15:33:12 mclareni Exp $
- *
- * $Log: mksreg.h,v $
- * Revision 1.1.1.1 1996/03/08 15:33:12 mclareni
- * Kuip
- *
- */
-#ifndef _mksreg_
-#define _mksreg_
-
-/* global data */
-extern SresRec srec; /* application resources */
-
-#endif /* _mksreg_ */
-
diff --git a/src/packlib/kuip/code_motif/mksres.h b/src/packlib/kuip/code_motif/mksres.h
deleted file mode 100644
index 61362f8..0000000
--- a/src/packlib/kuip/code_motif/mksres.h
+++ /dev/null
@@ -1,97 +0,0 @@
-/*
- * $Id: mksres.h,v 1.2 1996/10/24 12:13:40 cremel Exp $
- *
- * $Log: mksres.h,v $
- * Revision 1.2 1996/10/24 12:13:40 cremel
- * Version 2.07/10
- * Add resource higzMessGeometry to have control on the size and position of
- * the "HigzOutput" window (e.g. for the locator). To change the size
- * and position of this window one must add in his .Xdefaults (or .Xresources)
- * file the 2 following lines:
- *
- * Paw++*kuipScroll1.defaultPosition: False
- * Paw++*higzMessGeometry: 200x250+650+650
- *
- * Revision 1.1.1.1 1996/03/08 15:33:12 mclareni
- * Kuip
- *
- */
-#ifndef _mksres_
-#define _mksres_
-
-/* General application resources */
-typedef struct {
- int dc_interval; /* double click interval */
- String Help_font; /* font for help text */
- Boolean double_buffer; /* double buffer mode */
- int bell_vol; /* bell volume */
- int center_command; /* command panel position : */
- /* 1 --> center (True) */
- /* 0 --> normal (cursor position) */
- /* -1 --> (0,0) */
- Boolean panel_interactive; /* allow panel editing and close */
- Boolean no_kxterm; /* no kxterm window (normal xterm) */
- Boolean no_mbrowser; /* no main browser window */
- String higzmess_geometry; /* geometry of HigzOutput window */
- String kxterm_geometry; /* geometry of kxterm */
- String kxterm_text_font; /* font for the text widgets in kxterm */
- String kxterm_font; /* font for kxterm */
- /* Cursor Fonts: full list can be found in /usr/include/X11/cursorfont.h */
- int main_cs; /* cursor font for main window */
- int graph_cs; /* cursor font for graphics window */
- int input_cs; /* cursor font for question/input */
- int wait_cs; /* cursor font for wait */
- int help_cs; /* cursor font for help */
- int busy_cs; /* cursor font for program busy */
- int blck_cs; /* cursor font for blocked input */
- int selc_cs; /* cursor font for file selection */
- String scrolled_cmdpanel; /* scrolled window for command panel */
- /* "auto", "always" or "never" */
-} SresRec, *SresRecPtr;
-
-/* #define XmNdoubleClickInterval "doubleClickInterval" */
-#define XmNhelpFont "helpFont"
-#define XmNdoubleBuffer "doubleBuffer"
-#define XmNgBell "gBell"
-#define XmNcenterCommand "centerCommand"
-#define XmNpanelInteractive "panelInteractive"
-#define XmNnoKxterm "noKxterm"
-#define XmNnoMBrowser "noMBrowser"
-#define XmNhigzMessGeometry "higzMessGeometry"
-#define XmNkxtermGeometry "kxtermGeometry"
-#define XmNkxtermTextFont "kxtermTextFont"
-#define XmNkxtermFont "kxtermFont"
-#define XmNmainCursor "mainCursor"
-#define XmNgraphCursor "graphCursor"
-#define XmNinputCursor "inputCursor"
-#define XmNwaitCursor "waitCursor"
-#define XmNhelpCursor "helpCursor"
-#define XmNbusyCursor "busyCursor"
-#define XmNblckCursor "blckCursor"
-#define XmNselcCursor "selcCursor"
-#define XmNscrolledCmdPanel "scrolledCmdPanel"
-
-/* #define XmCDoubleClickInterval "DoubleClickInterval" */
-#define XmCHelpFont "HelpFont"
-#define XmCDoubleBuffer "DoubleBuffer"
-#define XmCGBell "GBell"
-#define XmCCenterCommand "CenterCommand"
-#define XmCPanelInteractive "PanelInteractive"
-#define XmCNoKxterm "NoKxterm"
-#define XmCNoMBrowser "NoMBrowser"
-#define XmCHigzMessGeometry "HigzMessGeometry"
-#define XmCKxtermGeometry "KxtermGeometry"
-#define XmCKxtermTextFont "KxtermTextFont"
-#define XmCKxtermFont "KxtermFont"
-#define XmCMainCursor "MainCursor"
-#define XmCGraphCursor "GraphCursor"
-#define XmCInputCursor "InputCursor"
-#define XmCWaitCursor "WaitCursor"
-#define XmCHelpCursor "HelpCursor"
-#define XmCBusyCursor "BusyCursor"
-#define XmCBlckCursor "BlckCursor"
-#define XmCSelcCursor "SelcCursor"
-#define XmCScrolledCmdPanel "ScrolledCmdPanel"
-
-#endif /* _mksres_ */
-
diff --git a/src/packlib/kuip/code_motif/mkuip.c b/src/packlib/kuip/code_motif/mkuip.c
deleted file mode 100644
index 91b82a3..0000000
--- a/src/packlib/kuip/code_motif/mkuip.c
+++ /dev/null
@@ -1,2329 +0,0 @@
-/*
- * $Id: mkuip.c,v 1.2 1996/10/24 12:13:41 cremel Exp $
- *
- * $Log: mkuip.c,v $
- * Revision 1.2 1996/10/24 12:13:41 cremel
- * Version 2.07/10
- * Add resource higzMessGeometry to have control on the size and position of
- * the "HigzOutput" window (e.g. for the locator). To change the size
- * and position of this window one must add in his .Xdefaults (or .Xresources)
- * file the 2 following lines:
- *
- * Paw++*kuipScroll1.defaultPosition: False
- * Paw++*higzMessGeometry: 200x250+650+650
- *
- * Revision 1.1.1.1 1996/03/08 15:33:06 mclareni
- * Kuip
- *
- */
-/*CMZ : 2.07/05 01/06/95 15.55.18 by N.Cremel*/
-/*-- Author : N.Cremel 06/05/92*/
-/******************************************************************************/
-/* */
-/* MOTIF-based library for KUIP - deck MKUIP */
-/* */
-/* Basic Interface for the "Executive Window" : */
-/* (connected to the file //KUIP/XMCLIB/KUXEXE for building */
-/* the window with Architect : "create_kuipExec") */
-/* */
-/* - Motif / Xt Initialization */
-/* - Menus "Control", "Commands" (command panels) and "Help" */
-/* - Command widget manipulation */
-/* - KUIP Panels manipulation (style GP) / connected to the */
-/* file //KUIP/XMCLIB/KUXPAN for building the panels with */
-/* Architect ("create_kuipPanel") */
-/* - User defined buttons and Menus */
-/* - Application Main Loop. */
-/* */
-/* */
-/******************************************************************************/
-#define Extern /* allocate storage for globals */
-
-#include "kuip/kuip.h"
-#include "kuip/kfor.h"
-#include "kuip/klink.h"
-#include "kuip/kmenu.h"
-#include "kuip/kflag.h"
-#include "kuip/mkterm.h"
-
-#include <X11/keysym.h>
-
-/* Global SEQUENCES (defined in MKCDES) */
-#include "mkincl.h"
-#include "mkdims.h"
-#include "mkfont.h"
-#include "mksres.h"
-#include "mkutfm.h"
-#include "mkutdm.h"
-#include "kuip/mkutfu.h"
-#define CONTEXT_MACRO_ACCESS 1
-#include "mkuxbr.h"
-#include "mkuxpa.h"
-#include "mkuxli.h"
-#include "mkuxlihlp.h"
-#undef CONTEXT_MACRO_ACCESS
-#include "kuip/browh1.h"
-#include "browh2.h"
-
-/* Start hourglass bitmaps (for km_wait_cursor) */
-#define hourglass_width 32
-#define hourglass_height 32
-#define hourglass_x_hot 15
-#define hourglass_y_hot 15
-static unsigned char hourglass_bits[] = {
- 0xe0, 0xff, 0xff, 0x03, 0xe0, 0xff, 0xff, 0x03, 0x40, 0x00, 0x00, 0x01,
- 0xe0, 0xff, 0xff, 0x03, 0x60, 0x00, 0x00, 0x03, 0x60, 0x00, 0x00, 0x03,
- 0x60, 0x00, 0x00, 0x03, 0x60, 0xc0, 0x01, 0x03, 0xc0, 0xa8, 0x8e, 0x01,
- 0x80, 0x55, 0xdd, 0x00, 0x00, 0xab, 0x6f, 0x00, 0x00, 0x56, 0x37, 0x00,
- 0x00, 0xec, 0x1b, 0x00, 0x00, 0xd8, 0x0d, 0x00, 0x00, 0xb0, 0x06, 0x00,
- 0x00, 0xa0, 0x02, 0x00, 0x00, 0x20, 0x02, 0x00, 0x00, 0xb0, 0x06, 0x00,
- 0x00, 0x98, 0x0c, 0x00, 0x00, 0x8c, 0x18, 0x00, 0x00, 0x06, 0x30, 0x00,
- 0x00, 0x83, 0x60, 0x00, 0x80, 0xc1, 0xc3, 0x00, 0xc0, 0xb0, 0x86, 0x01,
- 0x60, 0x5c, 0x1d, 0x03, 0x60, 0x2a, 0x39, 0x03, 0x60, 0xdd, 0x7f, 0x03,
- 0x60, 0x00, 0x00, 0x03, 0xe0, 0xff, 0xff, 0x03, 0x40, 0x00, 0x00, 0x01,
- 0xe0, 0xff, 0xff, 0x03, 0xe0, 0xff, 0xff, 0x03};
-
-#define hourglass_mask_width 32
-#define hourglass_mask_height 32
-static unsigned char hourglass_mask_bits []= {
- 0xe0, 0xff, 0xff, 0x03, 0xe0, 0xff, 0xff, 0x03, 0xc0, 0xff, 0xff, 0x01,
- 0xe0, 0xff, 0xff, 0x03, 0xe0, 0xff, 0xff, 0x03, 0xe0, 0xff, 0xff, 0x03,
- 0xe0, 0xff, 0xff, 0x03, 0xe0, 0xff, 0xff, 0x03, 0xc0, 0xff, 0xff, 0x01,
- 0x80, 0xff, 0xff, 0x00, 0x00, 0xff, 0x7f, 0x00, 0x00, 0xfe, 0x3f, 0x00,
- 0x00, 0xfc, 0x1f, 0x00, 0x00, 0xf8, 0x0f, 0x00, 0x00, 0xf0, 0x07, 0x00,
- 0x00, 0xe0, 0x03, 0x00, 0x00, 0xe0, 0x03, 0x00, 0x00, 0xf0, 0x07, 0x00,
- 0x00, 0xf8, 0x0f, 0x00, 0x00, 0xfc, 0x1f, 0x00, 0x00, 0xfe, 0x3f, 0x00,
- 0x00, 0xff, 0x7f, 0x00, 0x80, 0xff, 0xff, 0x00, 0xc0, 0xff, 0xff, 0x01,
- 0xe0, 0xff, 0xff, 0x03, 0xe0, 0xff, 0xff, 0x03, 0xe0, 0xff, 0xff, 0x03,
- 0xe0, 0xff, 0xff, 0x03, 0xe0, 0xff, 0xff, 0x03, 0xc0, 0xff, 0xff, 0x01,
- 0xe0, 0xff, 0xff, 0x03, 0xe0, 0xff, 0xff, 0x03};
-/* ... end hourglass bitmaps */
-
-/* application resource list */
-static XtResource kuip_resources[] = {
- { XmNdoubleClickInterval, XmCDoubleClickInterval, XmRInt, sizeof(int),
- XtOffset(SresRecPtr, dc_interval), XmRImmediate, (caddr_t) 250},
- { XmNhelpFont, XmCHelpFont, XmRString, sizeof (String),
- XtOffset (SresRecPtr,Help_font), XmRString,
- "*-courier-medium-r-normal*-120-*"},
- { XmNdoubleBuffer, XmCDoubleBuffer, XmRBoolean, sizeof(Boolean),
- XtOffset (SresRecPtr,double_buffer), XmRImmediate, (caddr_t) True},
- { XmNgBell, XmCGBell, XmRInt, sizeof (int),
- XtOffset (SresRecPtr,bell_vol), XmRImmediate, (caddr_t) 0},
- { XmNcenterCommand, XmCCenterCommand, XmRInt, sizeof(int),
- XtOffset (SresRecPtr,center_command), XmRImmediate, (caddr_t) 0},
- { XmNpanelInteractive, XmCPanelInteractive, XmRBoolean, sizeof(Boolean),
- XtOffset (SresRecPtr,panel_interactive), XmRImmediate, (caddr_t) True},
- { XmNnoKxterm, XmCNoKxterm, XmRBoolean, sizeof(Boolean),
- XtOffset (SresRecPtr,no_kxterm), XmRImmediate, (caddr_t) False},
- { XmNnoMBrowser, XmCNoMBrowser, XmRBoolean, sizeof(Boolean),
- XtOffset (SresRecPtr,no_mbrowser), XmRImmediate, (caddr_t) False},
- { XmNhigzMessGeometry, XmCHigzMessGeometry, XmRString, sizeof (String),
- XtOffset (SresRecPtr,higzmess_geometry), XmRString, "0x0+0+0"},
- { XmNkxtermGeometry, XmCKxtermGeometry, XmRString, sizeof (String),
- XtOffset (SresRecPtr,kxterm_geometry), XmRString, "650x450+0+0"},
- { XmNkxtermTextFont, XmCKxtermTextFont, XmRString, sizeof (String),
- XtOffset (SresRecPtr,kxterm_text_font), XmRString,
- "*-courier-medium-r-normal*-120-*"},
- { XmNkxtermFont, XmCKxtermFont, XmRString, sizeof (String),
- XtOffset (SresRecPtr,kxterm_font), XmRString,
- "*-helvetica-bold-r-normal*-120-*"},
- { XmNmainCursor, XmCMainCursor, XmRInt, sizeof (int),
- XtOffset (SresRecPtr,main_cs), XmRImmediate, (caddr_t) -1},
- { XmNgraphCursor, XmCGraphCursor, XmRInt, sizeof (int),
- XtOffset (SresRecPtr,graph_cs), XmRImmediate, (caddr_t) -1},
- { XmNinputCursor, XmCInputCursor, XmRInt, sizeof (int),
- XtOffset (SresRecPtr,input_cs), XmRImmediate, (caddr_t) -1},
- { XmNwaitCursor, XmCWaitCursor, XmRInt, sizeof (int),
- XtOffset (SresRecPtr,wait_cs), XmRImmediate, (caddr_t) -1},
- { XmNhelpCursor, XmCHelpCursor, XmRInt, sizeof (int),
- XtOffset (SresRecPtr,help_cs), XmRImmediate, (caddr_t) -1},
- { XmNbusyCursor, XmCBusyCursor, XmRInt, sizeof (int),
- XtOffset (SresRecPtr,busy_cs), XmRImmediate, (caddr_t) -1},
- { XmNblckCursor, XmCBlckCursor, XmRInt, sizeof (int),
- XtOffset (SresRecPtr,blck_cs), XmRImmediate, (caddr_t) -1},
- { XmNselcCursor, XmCSelcCursor, XmRInt, sizeof (int),
- XtOffset (SresRecPtr,selc_cs), XmRImmediate, (caddr_t) -1},
- { XmNscrolledCmdPanel, XmCScrolledCmdPanel, XmRString, sizeof (String),
- XtOffset (SresRecPtr,scrolled_cmdpanel), XmRString, "auto"},
-};
-
-/* No graphics window */
-static String k_fallbacks[] = {
- "*dirlist*fontList: *-courier-bold-r-normal*-120-*",
- "*fontList: *-helvetica-bold-r-normal*-120-*",
- "*kuipBrowser*fileScWindow.width: 80",
- "*kuipBrowser*fileScWindow.bottomOffset: 52",
- "*kuipBrowser*fileScWindow.topOffset: 59",
- "*kuipBrowser*dirScWindow.bottomOffset: 52",
- "*kuipBrowser*dirScWindow.topOffset: 59",
- "*kuipBrowser*separatorGadget1.topPosition: 50",
- "*kuipBrowser_shell.geometry: -0+0",
- NULL};
-
-/* With graphics window */
-static String kg_fallbacks[] = {
- "*dirlist*fontList: *-courier-bold-r-normal*-120-*",
- "*fontList: *-helvetica-bold-r-normal*-120-*",
- "*kuipBrowser*fileScWindow.width: 80",
- "*kuipBrowser*fileScWindow.bottomOffset: 52",
- "*kuipBrowser*fileScWindow.topOffset: 59",
- "*kuipBrowser*dirScWindow.bottomOffset: 52",
- "*kuipBrowser*dirScWindow.topOffset: 59",
- "*kuipBrowser*separatorGadget1.topPosition: 50",
- "*kuipGraphics_shell.geometry: 600x600-0+0",
- "*kuipBrowser_shell.geometry: +0+485",
- NULL};
-
-
-/***********************************************************************
- * *
- * Local data. *
- * *
- ***********************************************************************/
-static Widget appShell[MAX_APP_SHELL];
-static char *appShell_title[MAX_APP_SHELL];
-static Widget print_box_widget;
-static int fl_decwindows; /* flag if the server is DecWindows */
-static int do_bell;
-static Widget kuipControlM;
-static Widget kuipControlShell, kuipControlShellM;
-
-static Widget km_list_id = NULL; /* Widget id. for kuipList */
-
-#define MAX_ITEMS 30
-
-/***********************************************************************
- * *
- * GLOBAL data. *
- * *
- ***********************************************************************/
-char class_name[MAX_string];
-char main_prompt[MAX_string];
-XmFontList help_font = NULL;
-XFontStruct *help_font_struct;
-Colormap km_colormap;
-SresRec srec; /* application resources */
-XmAnyCallbackStruct *current_callback_data = NULL;
-Boolean km_browser_refresh;
-int do_exec, km_all_cycles;
-
-void (*user_logo_C)( /* Widget */ ); /* should be in a kuip structure */
-void (*user_mail_C)( /* Widget */ ); /* should be in a kuip structure */
-
-/* For HPArchitect */
-XtAppContext UxAppContext;
-Widget UxTopLevel;
-Display *UxDisplay;
-int UxScreen, UxScreenWidth, UxScreenHeight;
-
-
-/***********************************************************************
- * *
- * Forward declarations of local functions. *
- * *
- ***********************************************************************/
-static C_PROTO_0(void init_data);
-static void set_HIGZ();
-static C_PROTO_1(Widget create_option_menu,
- Widget parent);
-static C_PROTO_1(void create_command_menu,
- Widget parent);
-static C_PROTO_2(void set_grab,
- Widget widget_id,
- int flgrab);
-static C_PROTO_4(void display_widget,
- KmCommand *cmd,
- Position xr,
- Position yr,
- int flag);
-static C_PROTO_4(void show_widget,
- char *command,
- Position xr,
- Position yr,
- int flag);
-
-/* List of Callbacks */
-static void C_PROTO_3(destroy_print_box,
- Widget widget,
- caddr_t tag,
- XmAnyCallbackStruct *callback_data);
-static C_PROTO_3(void get_command_panel,
- Widget widget,
- int tag,
- XmAnyCallbackStruct *callback_data);
-#if 0
-static C_PROTO_3(void help_list_items,
- Widget w,
- char **help,
- XmAnyCallbackStruct *call_data);
-#endif
-static C_PROTO_3(void destroy_list_id,
- Widget w,
- caddr_t tag,
- XmAnyCallbackStruct *call_data);
-static C_PROTO_3(void command_panel_activate,
- Widget widget,
- char *cmd,
- XmAnyCallbackStruct *data);
-static C_PROTO_3(void appShell_activate,
- Widget widget,
- int tag,
- XmAnyCallbackStruct *callback_data);
-static C_PROTO_3(void iconify_appShell,
- Widget w,
- XtPointer client_data,
- XmAnyCallbackStruct *call_data);
-static C_PROTO_3(void kuipList_OK,
- Widget widget,
- int tag,
- XmAnyCallbackStruct *callback_data);
-static C_PROTO_3(void kxterm_raise_OK,
- Widget widget,
- int tag,
- XmAnyCallbackStruct *callback_data);
-static C_PROTO_3(void km_do_mail,
- Widget w,
- XtPointer client_data,
- XmAnyCallbackStruct *call_data);
-C_PROTO_3(void km_kmenu_OK,
- Widget widget,
- caddr_t tag,
- XmAnyCallbackStruct *callback_data);
-static C_PROTO_3(void ListHelp,
- Widget w,
- char **help,
- XmAnyCallbackStruct *call_data);
-
-
-/***********************************************************************
- * *
- * Forward declarations of global functions. *
- * *
- ***********************************************************************/
-C_PROTO_3(void km_deiconify_appShell,
- Widget w,
- XtPointer client_data,
- XmAnyCallbackStruct *call_data);
-C_PROTO_1(void km_create_windows,
- char *cname);
-C_PROTO_0(void define_buttons);
-C_PROTO_2(void km_buttons_callb, char **, int);
-C_PROTO_0(int km_enter_loop);
-C_PROTO_0(void km_realize_windows);
-C_PROTO_3(void km_do_help,
- Widget w,
- char *cval,
- XmAnyCallbackStruct *call_data);
-C_PROTO_3(void km_help_activate,
- Widget widget,
- caddr_t tag,
- XmAnyCallbackStruct *callback_data);
-C_PROTO_3(void km_focus_window,
- Widget widget,
- caddr_t tag,
- XEnterWindowEvent *ev);
-C_PROTO_1(void create_menu_help,
- Widget parent);
-C_PROTO_2(void kxterm_show_panel, char **, int);
-C_PROTO_2(void kxterm_set_panel, char **, int);
-C_PROTO_2(void kxterm_set_echo_mode, char **, int);
-C_PROTO_2(void kxterm_iconify, char **, int);
-C_PROTO_2(void kxterm_raise, char **, int);
-C_PROTO_2(void kxterm_help, char **, int);
-C_PROTO_2(void kxterm_geometry, char **, int);
-C_PROTO_2(void kxterm_about, char **, int);
-C_PROTO_2(void kxterm_mail, char **, int);
-
-
-/***********************************************************************
- * *
- * Forward declarations of extern functions. *
- * *
- ***********************************************************************/
-extern C_PROTO_3(Widget km_create_Browser,
- Widget w,
- Widget clone_parent,
- XmAnyCallbackStruct *call_data);
-extern C_PROTO_1(Widget create_kuipList, Widget);
-extern C_PROTO_5(int start_kxterm,
- char *title,
- char *geometry,
- char *font,
- char *text_font,
- char *main_prompt);
-extern C_PROTO_1(void km_WarnCB,
- String message);
-
-
-/***********************************************************************
- * *
- * X Window error handler. *
- * *
- ***********************************************************************/
-int error_handler (dp, error_event)
- Display *dp;
- XErrorEvent *error_event;
-{
- char text[1000];
- int il = 1000;
- unsigned char errc = error_event->error_code; /* error code */
-
- if (errc == Success) /* everything's okay */
- return (0);
- else if (errc == BadRequest)
- printf (" *** X Protocol Error: bad request code \n");
- else if (errc == BadValue)
- printf (" *** X Protocol Error: BadValue \n");
- else if (errc == BadWindow)
- printf (" *** X Protocol Error: BadWindow \n");
- else if (errc == BadPixmap)
- printf (" *** X Protocol Error: BadPixmap \n");
- else if (errc == BadAtom)
- printf (" *** X Protocol Error: BadAtom \n");
- else if (errc == BadCursor)
- printf (" *** X Protocol Error: BadCursor \n");
- else if (errc == BadFont)
- printf (" *** X Protocol Error: BadFont \n");
- else if (errc == BadMatch)
- printf (" *** X Protocol Error: BadMatch \n");
- else if (errc == BadDrawable)
- printf (" *** X Protocol Error: BadDrawable \n");
- else if (errc == BadAccess)
- printf (" *** X Protocol Error: BadAccess \n");
- else if (errc == BadAlloc)
- printf (" *** X Protocol Error: BadAlloc \n");
- else if (errc == BadColor)
- printf (" *** X Protocol Error: BadColor \n");
- else if (errc == BadGC)
- printf (" *** X Protocol Error: BadGC \n");
- else if (errc == BadIDChoice)
- printf (" *** X Protocol Error: BadIDChoice \n");
- else if (errc == BadName)
- printf (" *** X Protocol Error: BadName \n");
- else if (errc == BadLength)
- printf (" *** X Protocol Error: BadLength \n");
- else if (errc == BadImplementation)
- printf (" *** X Protocol Error: BadImplementation \n");
-
- XGetErrorText (dp, errc, text, il);
- printf ("%s \n", text);
-
- return 0;
-}
-
-
-
-/******************************************************************************/
-/* km_create_windows (class) : MOTIF initialization (has to be called first) */
-/* class (input) : class name (if "" then "Mkuip") */
-/******************************************************************************/
-void km_create_windows(cname)
- char *cname;
-{
- IntC argc;
- int i, iterm;
- char *argv[15];
- char title[MAX_string];
-
- String *fallbacks, *kuip_fallbacks;
-
- Boolean km_kxterm = True;
- Boolean nombr = False;
-
- if (klnkaddr.graf_info_C == NULL) {
- /* no graphics window */
- kuip_fallbacks = k_fallbacks;
- } else {
- kuip_fallbacks = kg_fallbacks;
- }
-
- fallbacks = kuip_fallbacks;
-
- if( klnkaddr.user_FallBk_C != NULL ) {
- /* allow application to specify its own fallbacks */
-
- String *user_fallbacks = (*klnkaddr.user_FallBk_C)();
-
- /* concatenate Kuip and user fallbacks */
- if( user_fallbacks != NULL ) {
-
- int fbcnt = 0;
-
- for( i = 0; kuip_fallbacks[i] != NULL; i++ )
- fbcnt++;
- for( i = 0; user_fallbacks[i] != NULL; i++ )
- fbcnt++;
- fallbacks = (String*)XtMalloc( (fbcnt+1) * sizeof(String) );
-
- fbcnt = 0;
- for( i = 0; kuip_fallbacks[i] != NULL; i++ )
- fallbacks[fbcnt++] = kuip_fallbacks[i];
- for( i = 0; user_fallbacks[i] != NULL; i++ )
- fallbacks[fbcnt++] = user_fallbacks[i];
- fallbacks[fbcnt] = NULL;
- }
- }
-
- /*
- * Initialize toolkit
- */
- if (cname != NULL) {
- char *cargv[15];
- int cargc;
- k_parse_args(cname, cargv, &cargc);
- /* Parse arguments */
- for( i = 0; i < cargc; i++) {
- if (strcmp(cargv[i], "-nokxterm") == 0) km_kxterm = False;
- if (strcmp(cargv[i], "-nombrowser") == 0) nombr = True;
- free (cargv[i]);
- }
- if (cargc > 0) {
- /* Keep only the 1st word */
- char *tmp;
- if ( (tmp = strstr( cname, " " )) != NULL ) tmp[0] = '\0';
- }
- }
-
- strcpy (class_name, cname != NULL ? cname : "Mkuip");
-
- sprintf (title,"%s Executive Window", class_name);
- argc = 0;
- argv[argc] = NULL;
-
- UxTopLevel = XtAppInitialize(&UxAppContext, class_name,
- NULL, 0, &argc, argv, fallbacks, NULL, 0);
-
- UxDisplay = XtDisplay(UxTopLevel);
- UxScreen = XDefaultScreen(UxDisplay);
- UxScreenWidth = DisplayWidth(UxDisplay, UxScreen);
- UxScreenHeight = DisplayHeight(UxDisplay, UxScreen);
-
- /*
- * We set the geometry of UxTopLevel so that dialogShells
- * that are parented on it will get centered on the screen
- * (if defaultPosition is true).
- */
- XtVaSetValues(UxTopLevel,
- XmNmappedWhenManaged, False,
- XmNallowShellResize, True,
- XmNx, DisplayWidth(UxDisplay, UxScreen)/2,
- XmNy, DisplayHeight(UxDisplay, UxScreen)/2,
- XmNwidth, 1,
- XmNheight, 1,
- NULL);
-
- /* XSynchronize(UxDisplay, TRUE); */ /* for debugging only */
-
- /*
- * Set default colormap and get application resources.
- */
- km_Display = UxDisplay;
- km_colormap = DefaultColormap(km_Display,DefaultScreen(km_Display));
-
- XtGetApplicationResources(UxTopLevel, &srec,
- kuip_resources, XtNumber(kuip_resources),
- NULL, 0);
-
- if (srec.no_kxterm) km_kxterm = False;
- if (srec.no_mbrowser) nombr = True;
-
- /*
- * Create a shadow kxterm topLevelShell. This widget is not mapped
- * but is used to popup dialogs as if kxterm were the parent.
- * When kxterm is moved or resized it sends a message (#@geometry...)
- * to the application which in turn calls the routine kxterm_geometry
- * to move and resize also the shadow kxterm toplevel widget.
- */
- if (km_kxterm) {
- /* to have the same resources (colours, fonts, ...) as Main Browser : */
-#if EXEC_RES
- /* to have the same resources (colours, fonts, ...) as Executive Window : */
- km_toplevel = XtAppCreateShell(NULL, "KXterm",
- applicationShellWidgetClass,
- km_Display, NULL, 0);
-#else
- km_toplevel = XtAppCreateShell(NULL, class_name,
- applicationShellWidgetClass,
- km_Display, NULL, 0);
-#endif
- } else {
- km_toplevel = XtAppCreateShell(NULL, "kxterm_shadow",
- topLevelShellWidgetClass,
- km_Display, NULL, 0);
- /* unbuffered I/O */
- setbuf(stdin, NULL);
- setbuf(stdout, NULL);
- kc_flags.use_kxterm = 0;
-#if 0
- fprintf(stderr,"\
-You have selected the \"noKxterm\" resource.\n\
-Your present terminal window will handle I/O.\n");
-#endif
- }
-
- /* don't free geometry it is not copied?! */
- XtVaSetValues(km_toplevel,
- XmNmappedWhenManaged, False,
- XmNgeometry, srec.kxterm_geometry,
- NULL);
- XtRealizeWidget(km_toplevel);
-
- /*
- * Create Main Browser.
- */
- if (!nombr) {
-
- km_main_browser = (Widget)km_create_Browser((Widget)NULL, (Widget)NULL,
- (XmAnyCallbackStruct *)NULL);
- XmUpdateDisplay(km_main_browser);
-
- /* Initialize global data */
- init_data();
-
- /* Create menu "Option" (general entries) */
- kuipControlM = create_option_menu(km_main_browser);
-
- /* Create "Commands" menu (with all commands) */
- create_command_menu(km_main_browser);
-
- } /* ... if (!nombr) */
-
- /*
- * Start kxterm and redirect stdin, stdout and stderr.
- */
- if (km_kxterm) {
- iterm = start_kxterm(title, srec.kxterm_geometry, srec.kxterm_font,
- srec.kxterm_text_font, kc_flags.echo_prompt);
- } else { /* no_kxterm */
- iterm = -1;
- }
-
- if (klnkaddr.user_TopWid_C != NULL)
- /* tell application that kxterm can now be initialized */
- (*klnkaddr.user_TopWid_C)("kxterm", (Widget)NULL);
-
- /* user defined buttons/menus */
- if (kmbuttons != NULL) define_buttons();
-
- /* set system current working directory in kxterm */
- if (kc_flags.use_kxterm) {
- char cwd[256];
- if (getcwd(cwd, (sizeof cwd))) {
- char *s = malloc(strlen(cwd) + 6);
- sprintf(s, "lcd(%s)", cwd);
- send_single_kxterm_cmd(s);
- free(s);
- }
- }
-
- /* Store kxterm widget (if any) */
- if (iterm >= 0) km_store_appShell(NULL, title);
-
- /* Store Main Browser widget */
- if (!nombr)
- km_store_appShell(km_main_browser, NULL);
-
- /* Set up information requested by HIGZ to open the Motif graphics window */
- set_HIGZ();
-}
-
-static void set_HIGZ()
-{
-extern C_PROTO_5(Window km_graph_open,
- int wkid,
- int x_pos,
- int y_pos,
- int w_dim,
- int h_dim);
-extern C_PROTO_1(void km_graph_init,
- int wkid);
-extern C_PROTO_1(void km_graph_close,
- int wkid);
-
- /* Set up information requested by HIGZ to open the Motif graphics window */
- if (klnkaddr.graf_info_C != NULL)
- /* if NULL -> no graphics window */
- (*klnkaddr.graf_info_C)
- (km_Display, km_graph_open, km_graph_init, km_graph_close);
-}
-
-/******************************************************************************/
-/* User defined buttons and menus (in the CDF) */
-/******************************************************************************/
-void define_buttons()
-{
- KmButton *kmbut;
- char line0[512], line1[512];
- Boolean exist;
- int i, num_actions, nkm, nbm;
-
- KxtermActionList actions = (KxtermActionList) malloc(
- sizeof(KxtermActionsRec) );
- char **kxterm_menu = (char **) malloc ( sizeof (char *) );
- char **browser_menu = (char **) malloc ( sizeof (char *) );
- int na = 0;
- int nk = 0;
- int nb = 0;
-
- for (kmbut = kmbuttons; kmbut != NULL; kmbut = kmbut->next) {
- /* add buttons/menus (kxterm and browser) */
- line0[0] = line1[0] = '\0';
- if ( (kmbut->flags & KmButtSeparator) != 0) {
- sprintf (line0, "M:%s: Sep : : separator",
- kmbut->menu);
- }
- sprintf (line1, "M:%s: %s : %s%s : button : %s: %s: %s",
- kmbut->menu, kmbut->label, ESCAPE, kmbut->action,
- kmbut->mnemo, kmbut->accel, kmbut->accel_text);
- if ( (kmbut->flags & KmButtBrowser) != 0) {
- /* fill browser_menu array */
- if (line0[0] != '\0') {
- browser_menu = (char **) realloc ( (char *)browser_menu,
- (nb+1) * sizeof (char *) );
- browser_menu[nb++] = strdup (line0);
- }
- browser_menu = (char **) realloc ( (char *)browser_menu,
- (nb+1) * sizeof (char *) );
- browser_menu[nb++] = strdup (line1);
- } else {
- /* fill kxterm_menu array (default) */
- if (line0[0] != '\0') {
- kxterm_menu = (char **) realloc ( (char *)kxterm_menu,
- (nk+1) * sizeof (char *) );
- kxterm_menu[nk++] = strdup (line0);
- }
- kxterm_menu = (char **) realloc ( (char *)kxterm_menu,
- (nk+1) * sizeof (char *) );
- kxterm_menu[nk++] = strdup (line1);
- }
- /* add corresponding actions */
- exist = False;
- for (i=0; i<na; i++) {
- /* check if new actions */
- if (strcasecmp( kmbut->action, actions[i].string ) == 0 )
- exist = True;
- }
- if (!exist) {
- actions = (KxtermActionList) realloc ( actions,
- (na+1) * sizeof (KxtermActionsRec) );
- actions[na].string = strdup (kmbut->action);
- if (kmbut->call_C != NULL)
- actions[na].proc = (KxtermActionProc)kmbut->call_C;
- else
- actions[na].proc = km_buttons_callb;
- na++;
- }
- }
-
- /* terminate all arrays with NULL */
- actions = (KxtermActionList) realloc ( actions,
- (na+1) * sizeof (KxtermActionsRec) );
- actions[na].string = NULL;
- actions[na].proc = NULL;
- browser_menu = (char **) realloc ( (char *)browser_menu,
- (nb+1) * sizeof (char *) );
- browser_menu[nb++] = NULL;
- kxterm_menu = (char **) realloc ( (char *)kxterm_menu,
- (nk+1) * sizeof (char *) );
- kxterm_menu[nk++] = NULL;
- num_actions = na;
- nkm = nk;
- nbm = nb;
-
- send_kxterm_cmd (kxterm_menu);
- km_add_menu (browser_menu);
- kxterm_add_actions (actions);
-
- for (na=0; na<num_actions; na++) {
- free (actions[na].string);
- }
- free ( (KxtermActionList) actions );
- for (nk=0; nk<nkm; nk++)
- free (kxterm_menu[nk]);
- for (nb=0; nb<nbm; nb++)
- free (browser_menu[nb]);
- free ( (char*) kxterm_menu);
- free ( (char*) browser_menu);
-}
-
-
-/***********************************************************************
- * *
- * Action routine for user defined buttons when action is defined as *
- * a command. *
- * *
- ***********************************************************************/
-void km_buttons_callb( argv, argc )
- char **argv;
- int argc;
-{
- char *button_cmd;
- int i;
-
- if (argc) {
- button_cmd = strdup (argv[0]);
- for (i = 1; i < argc; i++)
- button_cmd = mstr2cat( button_cmd, " ", argv[i]);
- exec_cmd_string (button_cmd, 1, km_display_cmdpan);
- }
-}
-
-/***********************************************************************
- * *
- * Initialize global data. *
- * *
- ***********************************************************************/
-static void init_data ()
-{
- int k;
-
- km_charset = XmSTRING_DEFAULT_CHARSET;
-
- /* Get foreground and background values for main-browser */
- XtVaGetValues(km_main_browser, XmNforeground, &km_foreground,
- XmNbackground, &km_background,
- NULL);
- /*
- * Load help_font (only once) for HELP (use a mono spaced font).
- */
- if (help_font == NULL) {
- help_font_struct = XLoadQueryFont( km_Display, srec.Help_font);
- if (help_font_struct == NULL)
- printf ("%s Warning: Font loaded for HELP (%s) is NULL \n",
- main_prompt, srec.Help_font);
- else
- help_font = XmFontListCreate (help_font_struct,km_charset);
- }
-
- /*
- * Initialize the application data structures
- * and the application GLOBAL variables
- */
- for (k = 0; k < MAX_APP_SHELL; k++) {
- appShell[k] = NULL;
- appShell_title[k] = NULL;
- }
- km_xcur_pos = 0;
- km_ycur_pos = 0;
- print_box_widget = NULL;
- do_exec = True; /* do not execute command at <CR> (push EXECUTE button) */
- do_bell = True; /* ring bell when grabbing (set_grab) */
- if (ServerVendor(km_Display) != NULL &&
- strncmp(ServerVendor(km_Display),"DECWINDOWS",10) == 0) {
- fl_decwindows = 1;
- } else {
- fl_decwindows = 0;
- }
- sprintf (main_prompt, "%s > ", class_name);
- km_browser_refresh = False;
-}
-
-/***********************************************************************
- * *
- * Set up help menu's. *
- * *
- ***********************************************************************/
-void create_menu_help(parent)
- Widget parent;
-{
- Widget helpB1, helpB2, helpB3, helpB4, helpB5, helpB6;
- char hlab[128];
-
- /*
- * find and restore the context for Browser
- * (to get to the widgets belonging to this dialog)
- */
- UxKuipBrowserContext = (_UxCkuipBrowser *)UxGetContext(parent);
-
- /* delete default help button in HelpPdMenu */
- XtDestroyWidget(HelpPdMenu_help);
-
- /* add new help button's */
- sprintf(hlab,"On %s", class_name);
- helpB1 = XtVaCreateManagedWidget( "helpB1",
- xmPushButtonGadgetClass, HelpPdMenu,
- RES_CONVERT( XmNmnemonic, "O" ),
- RES_CONVERT( XmNlabelString, hlab ),
- NULL );
- XtAddCallback (helpB1,XmNactivateCallback,
- (XtCallbackProc)km_do_help,(XtPointer)"HELP_EXE");
-
- sprintf(hlab,"On %s Resources", class_name);
- helpB6 = XtVaCreateManagedWidget( "helpB6",
- xmPushButtonGadgetClass, HelpPdMenu,
- RES_CONVERT( XmNmnemonic, "R" ),
- RES_CONVERT( XmNlabelString, hlab ),
- NULL );
- XtAddCallback (helpB6,XmNactivateCallback,
- (XtCallbackProc)km_do_help,(XtPointer)"HELP_EXE_RESOURCES");
-
- helpB2 = XtVaCreateManagedWidget( "helpB2",
- xmPushButtonGadgetClass, HelpPdMenu,
- RES_CONVERT( XmNmnemonic, "K" ),
- RES_CONVERT( XmNlabelString, "On Kuip Resources"),
- NULL );
- XtAddCallback (helpB2,XmNactivateCallback,
- (XtCallbackProc)km_do_help,(XtPointer)"HELP_RESOURCES");
-
- helpB4 = XtVaCreateManagedWidget( "helpB4",
- xmPushButtonGadgetClass, HelpPdMenu,
- RES_CONVERT( XmNmnemonic, "B" ),
- RES_CONVERT( XmNlabelString, "On Browser" ),
- NULL );
- XtAddCallback (helpB4,XmNactivateCallback,
- (XtCallbackProc)km_do_help,(XtPointer)"HELP_BROWSER");
-
- helpB3 = XtVaCreateManagedWidget( "helpB3",
- xmPushButtonGadgetClass, HelpPdMenu,
- RES_CONVERT( XmNmnemonic, "P" ),
- RES_CONVERT( XmNlabelString, "On Panel" ),
- NULL );
- XtAddCallback (helpB3,XmNactivateCallback,
- (XtCallbackProc)km_do_help,(XtPointer)"HELP_PANEL");
-
- helpB5 = XtVaCreateManagedWidget( "helpB5",
- xmPushButtonGadgetClass, HelpPdMenu,
- RES_CONVERT( XmNmnemonic, "F" ),
- RES_CONVERT( XmNlabelString, "On System Functions" ),
- NULL );
- XtAddCallback (helpB5,XmNactivateCallback,
- (XtCallbackProc)km_do_help,(XtPointer)"FUNCTIONS");
-
- if (user_mail_C) {
- Widget button;
-
- button = XtVaCreateManagedWidget( "helpB6",
- xmSeparatorGadgetClass, HelpPdMenu,
- NULL );
-
- sprintf(hlab, "Mail %s Developers", class_name);
- button = XtVaCreateManagedWidget( "helpB7",
- xmPushButtonGadgetClass, HelpPdMenu,
- RES_CONVERT( XmNmnemonic, "M" ),
- RES_CONVERT( XmNlabelString, hlab ),
- NULL );
- XtAddCallback(button, XmNactivateCallback,
- (XtCallbackProc)km_do_mail, NULL);
- }
-}
-
-/******************************************************************************/
-/* kireal : MOTIF realization (has to be called last) */
-/******************************************************************************/
-void km_realize_windows()
-{
- XEvent event;
- XColor color_defs[2];
- Pixmap hourglass_pixmap, hourglass_mask_pixmap;
-
-
- /* initialize cursors */
- if (srec.main_cs == -1)
- km_main_cursor = XCreateFontCursor(km_Display, XC_left_ptr);
- else
- km_main_cursor = XCreateFontCursor(km_Display, srec.main_cs);
- if (srec.graph_cs == -1)
- km_cross_cursor = XCreateFontCursor(km_Display, XC_crosshair);
- else
- km_cross_cursor = XCreateFontCursor(km_Display, srec.graph_cs);
- if (srec.input_cs == -1)
- km_input_cursor = km_main_cursor;
- else
- km_input_cursor = XCreateFontCursor(km_Display, srec.input_cs);
- if (srec.help_cs == -1)
- km_help_cursor = XCreateFontCursor(km_Display, XC_question_arrow);
- else
- km_help_cursor = XCreateFontCursor(km_Display, srec.help_cs);
- if (srec.busy_cs == -1)
- km_busy_cursor = XCreateFontCursor(km_Display, XC_watch);
- else
- km_busy_cursor = XCreateFontCursor(km_Display, srec.busy_cs);
- if (srec.blck_cs == -1)
- km_blck_cursor = XCreateFontCursor(km_Display, XC_dot);
- else
- km_blck_cursor = XCreateFontCursor(km_Display, srec.blck_cs);
- if (srec.selc_cs == -1)
- km_selc_cursor = XCreateFontCursor(km_Display, XC_hand2);
- else
- km_selc_cursor = XCreateFontCursor(km_Display, srec.selc_cs);
-
- /* build wait cursor with hourglass pixmap */
- color_defs[0].pixel = BlackPixel(km_Display, UxScreen);
- color_defs[1].pixel = WhitePixel(km_Display, UxScreen);
- XQueryColors(km_Display, km_colormap, color_defs, 2);
-
- hourglass_pixmap = XCreatePixmapFromBitmapData(km_Display,
- DefaultRootWindow(km_Display), (char*)hourglass_bits,
- hourglass_width, hourglass_height,
- WhitePixel(km_Display, UxScreen),
- BlackPixel(km_Display, UxScreen), 1);
- hourglass_mask_pixmap = XCreatePixmapFromBitmapData(km_Display,
- DefaultRootWindow(km_Display),
- (char*)hourglass_mask_bits,
- hourglass_mask_width, hourglass_mask_height,
- WhitePixel(km_Display, UxScreen),
- BlackPixel(km_Display, UxScreen), 1);
- if (srec.wait_cs == -1)
- km_wait_cursor = XCreatePixmapCursor(km_Display, hourglass_pixmap,
- hourglass_mask_pixmap,
- &color_defs[0], &color_defs[1],
- hourglass_x_hot, hourglass_y_hot);
- else
- km_wait_cursor = XCreateFontCursor(km_Display, srec.wait_cs);
-
- /*
- * register a procedure to be called on warning messages
- * to discard the passive grab warnings generated by Motif
- */
- (void)XtAppSetWarningHandler(UxAppContext, (XtErrorHandler)km_WarnCB);
-
- /*
- * Realize the widget tree.
- */
- XtRealizeWidget(UxTopLevel);
-
- km_all_cursor(KM_WAIT_CURSOR);
-
- /* Flush events to display the browser (and not wait for XtMainLoop) */
- while ( XEventsQueued( km_Display, QueuedAlready) > 1) {
- XtAppNextEvent( UxAppContext, &event );
- XtDispatchEvent (&event); }
- XSync(km_Display, False);
-
-}
-
-
-/*
- * execute IDLE command if no other activity
- */
-static XtIntervalId idle_timer = 0;
-
-static
-void idle_callback( XtPointer client_data, XtIntervalId *id )
-{
- /*
- * If "IDLE 0" was typed in Kxterm without any X-event on the application
- * side then the timer was not removed. Therefore we better check here
- * again that there is still an idle command active.
- */
- if( kc_value.idle_time > 0 ) {
- ku_exel( kc_value.idle_cmd );
- idle_timer = XtAppAddTimeOut( UxAppContext, kc_value.idle_time * 1000,
- idle_callback, kc_value.idle_cmd );
- }
- else
- idle_timer = 0;
-}
-
-
-/******************************************************************************/
-/* kiloop : give control to MOTIF event loop (has to be called last) */
-/******************************************************************************/
-int km_enter_loop()
-{
-#ifdef vms
-
- /*
- * The signal handler calls LIB$SIG_TO_RET which lets km_enter_loop return
- * the error number ( 1 == SS$_NORMAL )
- */
- VAXC$ESTABLISH( signal_handler );
-
-#endif
-
- km_all_cursor (KM_MAIN_CURSOR);
- while( 1 ) {
- XEvent event;
-
- if( kc_value.idle_time > 0 )
- idle_timer = XtAppAddTimeOut( UxAppContext, kc_value.idle_time * 1000,
- idle_callback, kc_value.idle_cmd );
- else
- idle_timer = 0;
-
- XtAppNextEvent( UxAppContext, &event );
-
- if( idle_timer != 0 )
- XtRemoveTimeOut( idle_timer );
-
- XtDispatchEvent( &event );
- if (km_panel_context) km_ContextHelp();
- }
- return 1;
-}
-
-
-/******************************************************************************/
-/* Create "Options" menu for all optional settings. */
-/******************************************************************************/
-static Widget create_option_menu(parent)
- Widget parent;
-{
- int narg;
- Arg arglist[2];
- Widget id_pdm;
- Widget PdMenu[15];
-
- /*
- * find and restore the context for Browser
- * (to get to the widgets belonging to this dialog)
- */
- UxKuipBrowserContext = (_UxCkuipBrowser *)UxGetContext(parent);
-
- /* create pulldown_menu */
- id_pdm = XmCreatePulldownMenu (browserMenu,"OptionsPdMenu",arglist,0);
-
-
- /* create pulldown_menu_entry "Options" */
- XtVaCreateManagedWidget( "optionsMenu",
- xmCascadeButtonGadgetClass, browserMenu,
- XmNsubMenuId, id_pdm,
- XmNmnemonic, XK_O,
- RES_CONVERT( XmNlabelString, "Options" ),
- NULL );
-
-
-/* create list of push_buttons and separators for menu "Option" */
-/* create pulldown_menu for "Raise Window" (with list of appl. shells) */
- narg = 0;
-#if XmREVISION == 99 /* problem with REVISION 2 ! */
- XtSetArg(arglist[narg], XmNtearOffModel, XmTEAR_OFF_ENABLED); narg++;
-#endif
- kuipControlShellM = XmCreatePulldownMenu
- (id_pdm,"ControlShellM",arglist,narg);
-/* create pulldown_menu_entry */
- kuipControlShell = XtVaCreateManagedWidget( "ControlShell",
- xmCascadeButtonGadgetClass, id_pdm,
- XmNsubMenuId, kuipControlShellM,
- XmNmnemonic, XK_R,
- RES_CONVERT( XmNlabelString, "Raise Window" ),
- NULL );
-
- XtVaCreateManagedWidget("PdSep0",
- xmSeparatorGadgetClass, id_pdm,
- NULL);
-
- PdMenu[3] = XtVaCreateManagedWidget("PdMenu3",
- xmPushButtonGadgetClass, id_pdm,
- RES_CONVERT( XmNlabelString,
- "Command Argument Panel... " ),
- XmNmnemonic,XK_C,
- NULL );
- XtAddCallback (PdMenu[3],XmNactivateCallback,
- (XtCallbackProc)get_command_panel, (XtPointer)0);
-
- return (id_pdm);
-}
-
-/************************************************************************
- * *
- * Create "Commands" menu for all commands defined in the CDF. *
- * *
- ************************************************************************/
-static void scan_menu_list(w, pdm, call_data)
- Widget w, pdm;
- XmAnyCallbackStruct *call_data;
-{
- static Boolean init = False;
-
- if (!init) {
- Widget widget_menu[MAX_MENU_LEVEL];
- KmMenu **menu_list = root_menu_list("");
- KmMenu *menu;
- int i;
-
- init = True;
-
- widget_menu[0] = pdm;
- for (i = 0; (menu = menu_list[i]) != NULL; i++) {
- int narg;
- Arg arglist[5];
- Widget id_pdme, id_pdm;
-
- Widget pw = widget_menu[menu->level-1];
- char *name = str0dup(menu->name);
- KmCommand *cmd;
- int nbut;
-
- Widget *id_pushb = (Widget *) malloc ( sizeof (Widget));
-
-
- strlower (name+1);
-
- /* Do not display menu "Motif" (contains helps only) */
- if (name != NULL && strcmp(name, "Motif") == 0) continue;
-
- /* create pulldown_menu */
- narg = 0;
-#if XmVERSION > 1 || XmREVISION >= 2
- XtSetArg(arglist[narg], XmNtearOffModel, XmTEAR_OFF_ENABLED); narg++;
-#endif
- id_pdm = XmCreatePulldownMenu (pw,"id_pdmC",arglist,narg);
- id_pdme = XtVaCreateWidget( "id_pdmeC",
- xmCascadeButtonGadgetClass, pw,
- XmNsubMenuId, id_pdm,
- RES_CONVERT( XmNlabelString, name ),
- NULL );
- widget_menu[menu->level] = id_pdm;
-
- free (name);
-
- /* create and manage push_button(s) */
- nbut = 0;
- for (cmd = menu->cmds; cmd != NULL; cmd = cmd->next) {
- char *cmd_name = str0dup(cmd->name);
-
- strlower (cmd_name+1);
-
- id_pushb = (Widget *) realloc ( id_pushb,
- (nbut+1) * sizeof (Widget) );
-
-
- id_pushb[nbut] = XtVaCreateWidget( "id_pushb",
- xmPushButtonGadgetClass, id_pdm,
- RES_CONVERT( XmNlabelString, cmd_name ),
- NULL );
- XtAddCallback (id_pushb[nbut],XmNactivateCallback,
- (XtCallbackProc)command_panel_activate,
- (XtPointer)cmd->path);
- free (cmd_name);
- nbut++;
- }
- XtManageChild (id_pdme);
- if (nbut > 0) XtManageChildren (id_pushb, nbut);
- free ((Widget *) id_pushb);
- }
- free( menu_list );
- }
-}
-
-/***********************************************************************
- * *
- * Execute an application defined menu button. *
- * *
- ***********************************************************************/
-static void application_cmd_cb( w, cmd, cbs )
- Widget w;
- char *cmd;
- XmAnyCallbackStruct *cbs;
-{
- handle_kxterm_action(cmd);
-}
-
-/***********************************************************************
- * *
- * Execute an application defined toggle menu button. These commands *
- * must recognize the 'on' and 'off' options. *
- * *
- ***********************************************************************/
-static void application_toggle_cb( w, cmd, cbs )
- Widget w;
- char *cmd;
- XmToggleButtonCallbackStruct *cbs;
-{
- char *s;
-
- s = XtMalloc(strlen(cmd) + 10);
- if (cbs->set)
- sprintf(s, "%s(ON)", cmd);
- else
- sprintf(s, "%s(OFF)", cmd);
-
- handle_kxterm_action(s);
-
-}
-
-
-/***********************************************************************
- * *
- * Handle menu building escape commands. *
- * *
- ***********************************************************************/
-static void add_entry (entry)
- char *entry;
-{
- char *cmd, *s, *menu, *menu_name;
- Widget pulldown;
- MenuItem *menu_item;
-
- /*
- * find and restore the context for Browser
- * (to get to the widgets belonging to this dialog)
- */
- UxKuipBrowserContext = (_UxCkuipBrowser *)UxGetContext(km_main_browser);
-
- /* Get menu label */
- cmd = entry;
- if (strncasecmp(cmd, "M:", 2)) return;
- cmd += 2;
- if ((s = strchr(cmd, ':'))) {
- menu = XtCalloc(s-cmd+1, 1);
- menu_name = XtCalloc(s-cmd+7+1, 1);
- strncpy(menu, cmd, s-cmd);
- sprintf(menu_name, "*%sPdMenu", menu);
-
- menu_item = (MenuItem *)XtMalloc(MAX_ITEMS*sizeof(MenuItem));
- if (km_add_item(s+1, application_cmd_cb, application_toggle_cb,
- menu_item, MAX_ITEMS)) {
-
- /* does menu already exist? */
- pulldown = XtNameToWidget(browserMenu, menu_name);
- if (pulldown) {
- /* add to existing pulldown menu */
- km_build_menu(pulldown, XmMENU_PULLDOWN, menu, menu[0],
- menu_item, True);
- } else {
- /* create new pulldown menu */
- km_build_menu(browserMenu, XmMENU_PULLDOWN, menu, menu[0],
- menu_item, False);
- }
- }
- XtFree((char *)menu_item);
- XtFree(menu);
- XtFree(menu_name);
- }
-}
-
-
-/***********************************************************************
- * *
- * Handle application defined menu for the main browser. *
- * *
- ***********************************************************************/
-void km_add_menu (menu)
- char **menu;
-{
- int i;
-
- for (i = 0; menu[i]; i++)
- add_entry (menu[i]);
-}
-
-/************************************************************************
- * *
- * Create "Commands" menu for all commands defined in the CDF. *
- * *
- ************************************************************************/
-static void create_command_menu(parent)
- Widget parent;
-{
- Widget id_pdme, id_pdm;
- Arg arglist[2];
- int narg;
-
- /*
- * find and restore the context for Browser
- * (to get to the widgets belonging to this dialog)
- */
- UxKuipBrowserContext = (_UxCkuipBrowser *)UxGetContext(parent);
-
- /* create pulldown_menu_entry "Commands" for all commands */
- narg = 0;
-#if XmVERSION > 1 || XmREVISION >= 2
- XtSetArg(arglist[narg], XmNtearOffModel, XmTEAR_OFF_ENABLED); narg++;
-#endif
- id_pdm = XmCreatePulldownMenu
- (browserMenu, "CommandsPdMenu", arglist, narg);
-
- id_pdme = XtVaCreateManagedWidget( "id_pdme",
- xmCascadeButtonGadgetClass, browserMenu,
- RES_CONVERT( XmNmnemonic, "C" ),
- XmNsubMenuId, id_pdm,
- RES_CONVERT( XmNlabelString, "Commands" ),
- NULL );
-
- /*
- * Delay creation of the KUIP menu structure till the user selects the
- * Command menu
- */
- XtAddCallback(id_pdme, XmNcascadingCallback,
- (XtCallbackProc) scan_menu_list, id_pdm);
-}
-
-/******************************************************************************/
-/* void Function km_print_box (pw, x, y, message, itype) */
-/* MessageBox widget */
-/* pw (input) : parent widget */
-/* x, y (input) : Position */
-/* message (input) : message string */
-/* itype (input) : dialogType */
-/* 0 --> DIALOG_ERROR */
-/* 1 --> DIALOG_INFORMATION */
-/* 2 --> DIALOG_MESSAGE */
-/* 3 --> DIALOG_QUESTION */
-/* 4 --> DIALOG_WARNING */
-/* 5 --> DIALOG_WORKING */
-/* return Widget widget_id : widget identifier */
-/******************************************************************************/
-C_DECL_5(void km_print_box,
- Widget, pw,
- Position, x,
- Position, y,
- char *, message,
- int, itype)
-{
- Widget kid[6];
- int narg;
- Arg arglist[20];
- XmString xmstr;
- char cval[MAX_string];
-
-/* If parent widget is not yet realized just put a print message */
- if (!XtIsRealized (pw)) {
- printf ("%s %s\n", main_prompt, message);
- return; }
-
-/* If not yet done destroy previous print box widget */
- if ( print_box_widget != NULL ) XtDestroyWidget (print_box_widget);
- km_reset_appShell (print_box_widget);
- print_box_widget = NULL;
-
-
-/* create MessageDialog */
- narg = 0;
-/* Set position */
- if (x != 0 || y != 0) {
- XtSetArg(arglist[narg],XmNdefaultPosition,False); narg++;
- XtSetArg(arglist[narg],XmNx,x); narg++;
- XtSetArg(arglist[narg],XmNy,y); narg++; }
- XtSetArg(arglist[narg],XmNmessageString,
- XmStringCreateLtoR(message, km_charset)); narg++;
- if (itype == 0) {
- XtSetArg(arglist[narg],XmNdialogType,XmDIALOG_ERROR); narg++; }
- else if (itype == 1) {
- XtSetArg(arglist[narg],XmNdialogType,XmDIALOG_INFORMATION); narg++; }
- else if (itype == 2) {
- XtSetArg(arglist[narg],XmNdialogType,XmDIALOG_MESSAGE); narg++; }
- else if (itype == 3) {
- XtSetArg(arglist[narg],XmNdialogType,XmDIALOG_QUESTION); narg++; }
- else if (itype == 4) {
- XtSetArg(arglist[narg],XmNdialogType,XmDIALOG_WARNING); narg++; }
- else if (itype == 5) {
- XtSetArg(arglist[narg],XmNdialogType,XmDIALOG_WORKING); narg++; }
-/* Add following line if you want to change the title (can be a new argument)*/
- sprintf (cval, "%s Message", class_name);
- xmstr = XmStringCreateLtoR(cval, XmSTRING_DEFAULT_CHARSET);
- XtSetArg(arglist[narg], XmNdialogTitle, xmstr); narg++;
- print_box_widget = XmCreateMessageDialog (pw,"print_box",arglist,narg);
- XmStringFree(xmstr);
-
-
-/* Unmanage unneeded children. */
- kid[0] = XmMessageBoxGetChild (print_box_widget, XmDIALOG_CANCEL_BUTTON);
- kid[1] = XmMessageBoxGetChild (print_box_widget, XmDIALOG_HELP_BUTTON);
- XtUnmanageChildren (kid, 2);
-
-
-/* Add callback(s) and manage print_box */
- XtAddCallback (print_box_widget,XmNokCallback,
- (XtCallbackProc)destroy_print_box,NULL);
- XtManageChild (print_box_widget);
- set_grab(print_box_widget, 1);
-}
-
-
-/******************************************************************************/
-/* void set_grab (widget_id, flgrab) */
-/******************************************************************************/
-/*
- * Set grab on widget and ring the bell
-*/
-static void set_grab (widget_id, flgrab)
- Widget widget_id;
- int flgrab; /* flgrab = 0 -> change only cursor shape to input */
-{
- XKeyboardState kbstate;
- int percent;
-
- km_set_cursor (widget_id, km_input_cursor);
- if (flgrab == 0) return;
-
-/* grab widget (do not accept any event until user does acknowledge) */
-/* XtAddGrab (widget_id,True,True); */
-
-/* Set Bell if requested (default) */
- if (!do_bell) return;
-
-/* Set subresources for : gBell (bell volume when grabbing) */
- percent = srec.bell_vol;
-
- if (percent < 0) {
-/* Use some reasonnable default */
- XGetKeyboardControl( km_Display, &kbstate );
- percent = kbstate.bell_percent; }
- if (percent > 0) XBell( km_Display, percent );
-
-
- return;
-}
-
-
-/******************************************************************************/
-/* */
-/*** CALLBACKS ROUTINES ***/
-/* */
-/******************************************************************************/
-
-
-/***********************************************************************
- * *
- * Display command panel if command is valid *
- * or propose list of commands if it is ambiguous *
- * *
- * flag = 0 --> command panel *
- * 1 --> command panel help *
- * *
- ***********************************************************************/
-static C_DECL_4(void show_widget,
- char *, command,
- Position, xr,
- Position, yr,
- int, flag)
-{
- KmCommand **last_cmd_list;
- KmCommand *cmd;
-
-
-
- /* Get command path according to command string */
- if (command == NULL || command[0] == '\0') return;
- cmd = search_command (command, &last_cmd_list);
-
- if (cmd != NULL) {
- /* Command is ok */
- display_widget (cmd, xr, yr, flag);
- } else {
- km_cmd_list (command, last_cmd_list, flag);
- } /* end if (cmd != NULL) ... */
-
-}
-
-/***********************************************************************
- * *
- * Display list. *
- * *
- ***********************************************************************/
-void km_display_list (items, help_items, data)
- char **items, **help_items;
- ListData data;
-{
- char *item;
- char cval[MAX_string];
- int nitems;
-
- static char **help = NULL;
-
- if (km_list_id != NULL) {
- XtDestroyWidget (XtParent(km_list_id));
- km_reset_appShell (km_list_id);
- }
- km_list_id = NULL;
- if (help != NULL) free ((char **)help );
- help = NULL;
-
- if (items != NULL) {
- Widget kuipListSelection;
-
- /* command is ambiguous ... */
- if (help_items == NULL)
- km_list_id = (Widget) create_kuipList(km_toplevel);
- else
- km_list_id = (Widget) create_kuipListHelp(km_toplevel);
- /* Set title */
- sprintf (cval, "%s List", class_name);
- XtVaSetValues(XtParent(km_list_id), XmNtitle, cval, NULL);
- km_store_appShell (km_list_id, cval);
- XtVaSetValues(km_listSBox,
- RES_CONVERT( XmNlistLabelString, data.listLabel ),
- RES_CONVERT( XmNselectionLabelString, data.label ),
- NULL);
- /* Fill list */
- kuipListSelection = XmSelectionBoxGetChild (km_listSBox, XmDIALOG_LIST);
- for (nitems = 0; (item = items[nitems]) != NULL; nitems++) {
- XmString xmstr;
-
- xmstr = XmStringCreate(item, XmSTRING_DEFAULT_CHARSET);
- XmListAddItem(kuipListSelection, xmstr, 0);
- XmStringFree(xmstr);
- }
-
- if (help_items != NULL) {
- help = (char**)malloc( sizeof(char*) );
- for (nitems = 0; help_items[nitems] != NULL; nitems++) {
- help = (char**)realloc( (char*)help,
- (nitems+1) * sizeof(char*) );
- help[nitems] = strdup (help_items[nitems]);
- }
- help = (char**)realloc( (char*)help, (nitems+1) * sizeof(char*) );
- help[nitems] = NULL;
-#if 0
-Unfortunately the following does not seem to work ...
---> replace it with "helpCallback".
- XtAddCallback (kuipListSelection, XmNsingleSelectionCallback,
- (XtCallbackProc)help_list_items, help);
-#endif
- } /* end ... if (help_items != NULL) */
-
- if (data.OKcallback)
- XtAddCallback (km_listSBox,XmNokCallback,
- (XtCallbackProc)data.OKcallback,
- data.OKcallback_data);
- XtAddCallback (km_listSBox,XmNcancelCallback,
- (XtCallbackProc)destroy_list_id, NULL);
-/*
- XtAddCallback (km_listSBox,XmNhelpCallback,
- (XtCallbackProc)km_help_activate, data.help);
-*/
- XtAddCallback (km_listSBox,XmNhelpCallback,
- (XtCallbackProc)ListHelp, help);
- /* This is to avoid the window to disappear under kxterm */
- XtAddEventHandler (km_list_id, FocusChangeMask, False,
- (XtEventHandler)km_focus_window, NULL);
- if (nitems <= 3) XtVaSetValues(km_list_id,
- XmNheight, (Dimension)280, NULL);
- UxPopupInterface(km_list_id, XtGrabNone);
- }
-}
-
-static void ListHelp ( w, help, call_data)
- Widget w;
- char **help;
- XmAnyCallbackStruct *call_data;
-{
- Widget kuipListSelection;
- int *pos;
- int ipos;
- int i;
-
- int npos = 0;
-
- /*
- * find and restore the context for ListHelp
- * (to get to the widgets belonging to this dialog)
- */
- UxKuipListHelpContext = (_UxCkuipListHelp *)UxGetContext(w);
-
-
- kuipListSelection = XmSelectionBoxGetChild (w, XmDIALOG_LIST);
- XmListGetSelectedPos (kuipListSelection , &pos, &npos);
- ipos = pos[0] - 1;
-
- if ( help != NULL &&
- help[ipos] != NULL ) XmTextSetString (km_listText, help[ipos]);
-}
-
-/***********************************************************************
- * *
- * Display list of possible commands if it is ambiguous *
- * *
- * flag = 0 --> command panel *
- * 1 --> command panel help *
- * *
- ***********************************************************************/
-void km_cmd_list (command, cmd_list, flag)
- char *command;
- KmCommand **cmd_list;
- int flag;
-{
- Widget kuipListSelection;
- KmCommand *cmd;
- char cval[MAX_string];
- int i;
-
- if (km_list_id != NULL) {
- XtDestroyWidget (XtParent(km_list_id));
- km_reset_appShell (km_list_id);
- }
- km_list_id = NULL;
-
- if (cmd_list == NULL) {
- /* command does not exist ... */
- sprintf (cval, "Cannot find command : %s", command);
- km_warn_user(km_toplevel, cval, "");
- } else {
- char *help = (char *) "Select item in the List !";
-
- /* command is ambiguous ... */
- km_list_id = (Widget) create_kuipList(km_toplevel);
- /* Set title */
- sprintf (cval, "%s List", class_name);
- XtVaSetValues(XtParent(km_list_id), XmNtitle, cval, NULL);
- km_store_appShell (km_list_id, cval);
- /* Fill list */
- kuipListSelection = XmSelectionBoxGetChild (km_listSBox, XmDIALOG_LIST);
- for (i = 0; (cmd = cmd_list[i]) != NULL; i++) {
- XmString xmstr;
-
- xmstr = XmStringCreate(cmd->path, XmSTRING_DEFAULT_CHARSET);
- XmListAddItem(kuipListSelection, xmstr, 0);
- XmStringFree(xmstr);
- } /* end for ... */
- XtAddCallback (km_listSBox,XmNokCallback,
- (XtCallbackProc)kuipList_OK, (XtPointer)flag);
- XtAddCallback (km_listSBox,XmNcancelCallback,
- (XtCallbackProc)destroy_list_id, NULL);
- XtAddCallback (km_listSBox,XmNhelpCallback,
- (XtCallbackProc)km_help_activate, help);
- UxPopupInterface(km_list_id, XtGrabNone);
- } /* end if (cmd_list == NULL) ... */
-}
-
-static C_DECL_4(void display_widget,
- KmCommand *, cmd,
- Position, xr,
- Position, yr,
- int, flag)
-{
- if (flag == 0) {
- /* Enter Command ... (force display of panel) */
- km_xcur_pos = xr; km_ycur_pos = yr;
- exec_cmd_string (cmd->path, -1, km_display_cmdpan);
- } else if (flag == 1) {
- /* Command Panel Help ... */
- char *helptext = fmt_cmd_help( cmd, 0 );
- km_display_sctext (cmd->path, helptext, xr, yr, 1);
- free( helptext );
- }
-}
-
-
-static void destroy_print_box( widget, tag, callback_data )
- Widget widget;
- caddr_t tag;
- XmAnyCallbackStruct *callback_data;
-{
- if (print_box_widget != NULL ) XtDestroyWidget(print_box_widget);
- km_reset_appShell (print_box_widget);
- print_box_widget = NULL;
-}
-
-
-/***********************************************************************
- * *
- * Action routine which will be called by handle_kxterm_actions to *
- * popup a command panel. *
- * *
- ***********************************************************************/
-void kxterm_show_panel( argv, argc )
- char **argv;
- int argc;
-{
- FILE *ppf;
- char fname[MAX_stringl], message[MAX_stringl];
- char *panel_name;
- char exstr[MAX_stringl];
-
-
- panel_name = km_wait_input ("Give KUIP macro file name",
- "panel", "HELP_PANEL");
- if (panel_name == NULL) return;
-/* check existence of macro file */
- sprintf (fname, "%s.kumac", panel_name);
- if ((ppf = fopen (fname,"r")) == NULL) {
- sprintf (message,"Cannot find file %s", fname);
- km_print_box (km_toplevel, 0, 0, message,0);
- fclose (ppf);
- return; }
- free (panel_name);
- sprintf (exstr,"/MACRO/EXEC %s", fname);
- exec_cmd_string (exstr, 0, NULL);
-}
-
-
-/***********************************************************************
- * *
- * Action routine which will be called by handle_kxterm_actions to *
- * popup a new command panel. *
- * *
- ***********************************************************************/
-void kxterm_set_panel( argv, argc )
- char **argv;
- int argc;
-{
- ku_exel ("/KUIP/SET_SHOW/NEWPANEL");
-}
-
-
-static void get_command_panel( widget, tag, callback_data )
- Widget widget;
- int tag;
- XmAnyCallbackStruct *callback_data;
-{
- char *command;
- Position xr, yr;
- int flag = tag;
-
- command = km_wait_input ("Give Command Name", "", "HELP_GET_COMMAND_PANEL");
- if (command == NULL) return;
- km_get_curpos (callback_data->event,&xr,&yr);
- show_widget (command, xr, yr, flag);
-
- free (command);
-}
-
-/***********************************************************************
- * *
- * Action routine which will be called by handle_kxterm_actions to *
- * turn on/off command echoing. *
- * *
- ***********************************************************************/
-void kxterm_set_echo_mode( argv, argc )
- char **argv;
- int argc;
-{
- if (!strcasecmp(argv[0], "on"))
- kc_flags.echo_command = 1;
- else
- kc_flags.echo_command = 0;
-}
-
-#if 0
-/***********************************************************************
- * *
- * Add callback on each list item for "singleSelection" *
- * *
- ***********************************************************************/
-static void help_list_items(w, help, call_data)
- Widget w;
- char **help;
- XmAnyCallbackStruct *call_data;
-{
- Widget kuipListSelection;
- int *pos;
- int ipos;
- int npos = 0;
-
- /*
- * find and restore the context for ListHelp
- * (to get to the widgets belonging to this dialog)
- */
- UxKuipListHelpContext = (_UxCkuipListHelp *)UxGetContext(w);
-
-
- kuipListSelection = XmSelectionBoxGetChild (w, XmDIALOG_LIST);
- XmListGetSelectedPos (kuipListSelection , &pos, &npos);
- ipos = pos[0] - 1;
-
- if (help[ipos] != NULL XmTextSetString (km_listText, help[ipos]);
-}
-#endif
-
-/***********************************************************************
- * *
- * Destroy km_list_id (widget issued from kuipList) *
- * *
- ***********************************************************************/
-static void destroy_list_id(w, tag, call_data)
- Widget w;
- caddr_t tag;
- XmAnyCallbackStruct *call_data;
-{
- km_destroy_list();
-}
-
-void km_destroy_list()
-{
- if (km_list_id != NULL) {
- UxDestroyInterface(km_list_id);
- km_reset_appShell (km_list_id);
- km_list_id = NULL;
- }
-}
-
-
-/*
- * Display panel corresponding to command
- */
-static void command_panel_activate( widget, cmd, data )
- Widget widget;
- char *cmd;
- XmAnyCallbackStruct *data;
-{
- /* Force display of panel */
- km_get_curpos (data->event,&km_xcur_pos,&km_ycur_pos);
- exec_cmd_string (cmd, -1, km_display_cmdpan);
-}
-
-
-
-/******************************************************************************/
-/* km_store_appShell : store application shell (for Iconify) */
-/******************************************************************************/
-void km_store_appShell(w, title)
- Widget w;
- char *title;
-{
- Arg arglist[2];
- Widget PdMenu;
- char *tit;
- int i;
-
-
- if (w == NULL && (title)) { /* Executive window */
- /* Create entry in pulldown menu "Application Shell" */
- appShell_title[0] = strdup(title);
- if (!kuipControlM) return;
- PdMenu = XmCreatePushButtonGadget
- (kuipControlShellM,appShell_title[0],arglist,0);
- XtAddCallback(PdMenu,XmNactivateCallback,
- (XtCallbackProc)appShell_activate, (XtPointer)-1);
- XtManageChild(PdMenu);
- return;
- } else {
- for (i = 1; i < MAX_APP_SHELL; i++) {
- if (appShell[i] == NULL) {
- appShell[i] = w;
-
- if (title)
- appShell_title[i] = strdup(title);
- else {
- XtVaGetValues(km_GetTrueShell(w), XmNtitle, &tit, NULL);
- appShell_title[i] = strdup(tit);
- }
-
- /* Create entry in pulldown menu "Application Shell" */
- if (!kuipControlM) break;
- PdMenu = XmCreatePushButtonGadget
- (kuipControlShellM,appShell_title[i],arglist,0);
- XtAddCallback(PdMenu,XmNactivateCallback,
- (XtCallbackProc)appShell_activate, (XtPointer)i);
- XtManageChild(PdMenu);
- break;
- } /* end ... if (appShell[i] == NULL) */
- } /* end ... for (i = 1; i < MAX_APP_SHELL; i++) */
- if (i == MAX_APP_SHELL-1)
- km_print_box (km_toplevel, 0, 0, "Please erase some windows ...",4);
- }
-}
-
-/******************************************************************************/
-/* km_reset_appShell : retrieve application shell from the list (for Iconify)*/
-/******************************************************************************/
-void km_reset_appShell(w)
- Widget w;
-{
- int narg;
- Arg arglist[2];
- Widget PdMenu;
- int i;
-
-
- for (i = 1; i < MAX_APP_SHELL; i++) {
- if (w == appShell[i]) {
- appShell[i] = NULL;
- appShell_title[i] = NULL;
- break;
- }
- }
-
- if (!kuipControlM) return;
-
- /* Reset pulldown_menu "Application Shell" */
- if (kuipControlShellM != NULL) XtDestroyWidget (kuipControlShellM);
-
- narg = 0;
-#if XmREVISION == 99 /* problem with REVISION 2 ! */
- XtSetArg(arglist[narg], XmNtearOffModel, XmTEAR_OFF_ENABLED); narg++;
-#endif
- kuipControlShellM = XmCreatePulldownMenu
- (kuipControlM,"ControlShellM",arglist,narg);
- /* set XmNsubMenuId attribute for pulldown menu entry */
- XtVaSetValues(kuipControlShell, XmNsubMenuId, kuipControlShellM, NULL);
-
- if (appShell_title[0] != NULL) {
- /* Executive window */
- PdMenu = XmCreatePushButtonGadget
- (kuipControlShellM,appShell_title[0],arglist,0);
- XtAddCallback (PdMenu,XmNactivateCallback,
- (XtCallbackProc)appShell_activate, (XtPointer)-1);
- XtManageChild(PdMenu);
- }
- for( i = 1; i < MAX_APP_SHELL; i++) {
- if (appShell[i] != NULL) {
- /* reset entries in pulldown menu "Application Shell" */
- PdMenu = XmCreatePushButtonGadget
- (kuipControlShellM,appShell_title[i],arglist,0);
- XtAddCallback (PdMenu,XmNactivateCallback,
- (XtCallbackProc)appShell_activate, (XtPointer)i);
- XtManageChild(PdMenu);
- }
- }
-}
-
-/***********************************************************************
- * *
- * Iconify all TopLevelShells. *
- * *
- ***********************************************************************/
-static void iconify_appShell(w, client_data, call_data)
- Widget w;
- XtPointer client_data;
- XmAnyCallbackStruct *call_data;
-{
- int i;
-
- for( i = 0; i < MAX_APP_SHELL; i++) {
- if (appShell[i])
- km_IconifyShell(appShell[i]);
- }
-}
-
-/***********************************************************************
- * *
- * DeIconify all TopLevelShells. *
- * *
- ***********************************************************************/
-void km_deiconify_appShell(w, client_data, call_data)
- Widget w;
- XtPointer client_data;
- XmAnyCallbackStruct *call_data;
-{
- int i;
-
- for (i = 0; i < MAX_APP_SHELL; i++) {
- if (appShell[i] && km_IsShellIconic(appShell[i]))
- km_DeIconifyShell(appShell[i]);
- }
-}
-
-/***********************************************************************
- * *
- * Action routine which will be called by handle_kxterm_actions to *
- * iconify or de-iconify all top level shells. *
- * *
- ***********************************************************************/
-void kxterm_iconify( argv, argc )
- char **argv;
- int argc;
-{
- if (!strcasecmp(argv[0], "unmap"))
- iconify_appShell((Widget)NULL, (XtPointer)0,
- (XmAnyCallbackStruct *)NULL);
- else
- km_deiconify_appShell((Widget)NULL, (XtPointer)0,
- (XmAnyCallbackStruct *)NULL);
-}
-
-/***********************************************************************
- * *
- * Action routine which will be called by handle_kxterm_actions to *
- * raise any top level shells. *
- * *
- ***********************************************************************/
-void kxterm_raise( argv, argc )
- char **argv;
- int argc;
-{
- Widget kuipListSelection;
- char cval[MAX_string];
- int i;
-
- char *help = (char *) "Select the window you want to popup !";
-
-
- if (km_list_id != NULL) {
- XtDestroyWidget (XtParent(km_list_id));
- km_reset_appShell (km_list_id);
- }
- km_list_id = NULL;
-
- km_list_id = (Widget) create_kuipList(km_toplevel);
- /* Set title */
- sprintf (cval, "%s Window List", class_name);
- km_store_appShell (km_list_id, cval);
- XtVaSetValues(XtParent(km_list_id), XmNtitle, cval, NULL);
- XtVaSetValues(km_listSBox,
- RES_CONVERT( XmNlistLabelString, "List of Windows" ),
- RES_CONVERT( XmNselectionLabelString, "Window to be raised" ),
- NULL);
- /* Fill list */
- kuipListSelection = XmSelectionBoxGetChild (km_listSBox, XmDIALOG_LIST);
- for (i = 0; appShell_title[i] != NULL; i++) {
- XmString xmstr;
-
- xmstr = XmStringCreate(appShell_title[i], XmSTRING_DEFAULT_CHARSET);
- XmListAddItem(kuipListSelection, xmstr, 0);
- XmStringFree(xmstr);
- } /* end for ... */
- XtAddCallback (km_listSBox,XmNokCallback,
- (XtCallbackProc)kxterm_raise_OK, NULL);
- XtAddCallback (km_listSBox,XmNcancelCallback,
- (XtCallbackProc)destroy_list_id, NULL);
- XtAddCallback (km_listSBox,XmNhelpCallback,
- (XtCallbackProc)km_help_activate, help);
- UxPopupInterface(km_list_id, XtGrabNone);
-}
-
-/***********************************************************************
- * *
- * Action routine which will be called by handle_kxterm_actions to *
- * show help. *
- * *
- ***********************************************************************/
-void kxterm_help( argv, argc )
- char **argv;
- int argc;
-{
- if (argc == 1) {
- char *cmd = XtMalloc(strlen(argv[0]) + 12);
-
- sprintf(cmd, "/KUIP/HELP %s", argv[0]);
- ku_exel (cmd);
-
- XtFree(cmd);
- }
-}
-
-/***********************************************************************
- * *
- * Action routine which will be called by handle_kxterm_actions to *
- * change the geometry of the km_toplevel shell. This action will *
- * be called whenever kxterm is moved or resized, so that *
- * km_toplevel can follow kxterm. *
- * *
- ***********************************************************************/
-void kxterm_geometry( argv, argc )
- char **argv;
- int argc;
-{
- Position x, y;
- Dimension width, height;
-
- if (argc == 4) {
- x = (Position) atoi(argv[0]);
- y = (Position) atoi(argv[1]);
- width = (Dimension) atoi(argv[2]);
- height = (Dimension) atoi(argv[3]);
-
- XtVaSetValues(km_toplevel, XmNx, x, XmNy, y,
- XmNwidth, width, XmNheight, height, NULL);
- }
-}
-
-/***********************************************************************
- * *
- * Action routine which will be called by handle_kxterm_actions to *
- * show the about... (logo) off the application. *
- * *
- ***********************************************************************/
-void kxterm_about( argv, argc )
- char **argv;
- int argc;
-{
- if (user_logo_C) {
- (user_logo_C)(UxTopLevel);
- }
-}
-
-/***********************************************************************
- * *
- * Action routine which will be called by handle_kxterm_actions to *
- * show the "Mail Developers" dialog of the application. *
- * *
- ***********************************************************************/
-void kxterm_mail( argv, argc )
- char **argv;
- int argc;
-{
- if (user_mail_C) {
- (user_mail_C)(UxTopLevel);
- }
-}
-
-/***********************************************************************
- * *
- * Callback routine which will be called to *
- * show the "Mail Developers" dialog of the application. *
- * *
- ***********************************************************************/
-static void km_do_mail(Widget w, XtPointer cd, XmAnyCallbackStruct *cbs)
-{
- if (user_mail_C) {
- (user_mail_C)(UxTopLevel);
- }
-}
-
-/***********************************************************************
- * *
- * Set cursor shape for all TopLevelShells (except Graphics). *
- * *
- ***********************************************************************/
-void km_all_cursor (icurs)
- int icurs;
-{
- int i;
- Cursor kursor, gkursor;
-
- if (icurs == KM_MAIN_CURSOR) {
- kursor = km_main_cursor;
- gkursor = km_cross_cursor; }
- else if (icurs == KM_WAIT_CURSOR) {
- kursor = km_wait_cursor;
- gkursor = kursor; }
- else if (icurs == KM_CROSS_CURSOR) {
- kursor = km_cross_cursor;
- gkursor = kursor; }
- else if (icurs == KM_INPUT_CURSOR) {
- kursor = km_input_cursor;
- gkursor = kursor; }
- else if (icurs == KM_HELP_CURSOR) {
- kursor = km_help_cursor;
- gkursor = kursor; }
- else if (icurs == KM_BUSY_CURSOR) {
- kursor = km_busy_cursor;
- gkursor = kursor; }
- else if (icurs == KM_BLCK_CURSOR) {
- kursor = km_blck_cursor;
- gkursor = kursor; }
- else if (icurs == KM_SELC_CURSOR) {
- kursor = km_selc_cursor;
- gkursor = kursor; }
-
- for (i = 0; i < MAX_APP_SHELL; i++) {
- if (appShell[i] != NULL) {
- char *title = str0dup(appShell_title[i]);
- if( title == NULL || strstr(strupper(title), "GRAPHICS") == NULL )
- km_set_cursor (appShell[i], kursor);
- else
- km_set_cursor (appShell[i], gkursor);
- if( title != NULL )
- free (title);
- }
- }
-
- /* Kxterm */
- if (icurs == KM_MAIN_CURSOR)
- send_single_kxterm_cmd ("cursor(main)");
- else if (icurs == KM_WAIT_CURSOR)
- send_single_kxterm_cmd ("cursor(wait)");
-
-}
-
-/******************************************************************************/
-/* void appShell_activate( widget, tag, callback_data ) */
-/******************************************************************************/
-static void appShell_activate( widget, tag, callback_data )
- Widget widget;
- int tag;
- XmAnyCallbackStruct *callback_data;
-{
- int i = tag;
-
- if (tag >= 0) {
- if (appShell[i] == NULL) return;
- UxPopupInterface(appShell[i], XtGrabNone);
- XMapRaised(km_Display, XtWindow(km_GetTrueShell(appShell[i])));
- XFlush(km_Display);
- } else {
- /* Executive window managed by kxterm */
- send_single_kxterm_cmd("raise");
- }
-}
-
-/******************************************************************************/
-/* void kuipList_OK ( widget, tag, callback_data ) */
-/******************************************************************************/
-static void kuipList_OK( widget, tag, callback_data )
- Widget widget;
- int tag;
- XmAnyCallbackStruct *callback_data;
-{
- Widget kuipListText;
- char *command;
- char cval[MAX_string];
- KmCommand *cmd;
- Position xr, yr;
-
- int flag = tag;
-
-
- /* Get selected value */
- kuipListText = XmSelectionBoxGetChild
- (km_listSBox, XmDIALOG_TEXT);
- command = (char *) XmTextGetString (kuipListText);
- if (command != NULL) {
- /* Get command path according to command string */
- cmd = search_command (command, NULL);
- if (cmd != NULL) {
- /* Command is ok */
- km_get_curpos (callback_data->event,&xr,&yr);
- display_widget (cmd, xr, yr, flag);
- } else {
- /* command does not exist ... */
- sprintf (cval, "Cannot find command : %s", command);
- km_warn_user(km_toplevel, cval, "");
- XtFree (command);
- return;
- }
- XtFree (command);
- }
-
- km_destroy_list();
-}
-
-/******************************************************************************/
-/* void km_kmenu_OK ( widget, tag, callback_data ) */
-/******************************************************************************/
-void km_kmenu_OK( widget, tag, callback_data )
- Widget widget;
- caddr_t tag;
- XmAnyCallbackStruct *callback_data;
-{
- Widget kuipListText;
- char *menu;
-
- char *path = (char *) tag;
-
- /* Get selected value */
- kuipListText = XmSelectionBoxGetChild (km_listSBox, XmDIALOG_TEXT);
- menu = (char *) XmTextGetString (kuipListText);
- /* Destroy list */
- km_destroy_list();
- if (menu != NULL) {
- char cmd[MAX_stringl];
-
- if (path != NULL)
- sprintf (cmd, "/KUIP/HELP %s/%s", path, menu);
- else
- sprintf (cmd, "/KUIP/HELP %s", menu);
- ku_exel (cmd);
- XtFree (menu);
- }
-}
-
-/******************************************************************************/
-/* void kxterm_raise_OK ( widget, tag, callback_data ) */
-/******************************************************************************/
-static void kxterm_raise_OK( widget, tag, callback_data )
- Widget widget;
- int tag;
- XmAnyCallbackStruct *callback_data;
-{
- Widget kuipListText;
- char *title;
- int k, index;
-
- /* Get selected value */
- kuipListText = XmSelectionBoxGetChild
- (km_listSBox, XmDIALOG_TEXT);
- title = (char *) XmTextGetString (kuipListText);
- index = -1;
- if (title != NULL) {
- for (k = 0; k < MAX_APP_SHELL; k++) {
- if (appShell_title[k] == NULL) break;
- if (strcmp(title, appShell_title[k]) == 0) {
- index = k;
- break; }
- }
- XtFree (title);
- } /* end ... if (title != NULL) */
-
- if (index >= 0) {
- if (index == 0)
- /* Executive window */
- appShell_activate (NULL, -1, NULL);
- else
- appShell_activate (NULL, index, NULL);
- }
-}
diff --git a/src/packlib/kuip/code_motif/mkutda.h b/src/packlib/kuip/code_motif/mkutda.h
deleted file mode 100644
index 3d7eae7..0000000
--- a/src/packlib/kuip/code_motif/mkutda.h
+++ /dev/null
@@ -1,45 +0,0 @@
-/*
- * $Id: mkutda.h,v 1.1.1.1 1996/03/08 15:33:12 mclareni Exp $
- *
- * $Log: mkutda.h,v $
- * Revision 1.1.1.1 1996/03/08 15:33:12 mclareni
- * Kuip
- *
- */
-/*** Global data with NO reference to any Motif/X11 include files ***/
-#ifndef _mkutda_
-#define _mkutda_
-
-#include "mkdims.h"
-
-/* #define Extern must be in one routine to allocate space */
-#ifndef Extern
-# define Extern extern
-#endif
-
-/* Global data (general datas not connected to Motif include files) */
-extern int UxScreenWidth, UxScreenHeight;
-extern char main_prompt[MAX_string];
-extern char class_name[MAX_string];
-extern int km_all_cycles; /* flag for "View" with "all cycles" for VMS */
-
-#define KM_MAIN_CURSOR 0
-#define KM_WAIT_CURSOR 1
-#define KM_CROSS_CURSOR 2
-#define KM_INPUT_CURSOR 3
-#define KM_HELP_CURSOR 1
-#define KM_BUSY_CURSOR 1
-#define KM_BLCK_CURSOR 1
-#define KM_SELC_CURSOR 1
-
-#define NO_ICON 0
-#define ICON 1
-
-#define by_NAME 0
-#define by_ICON 1
-#define by_BOTH 2
-#define by_COMMAND 3
-#define by_COMMAND1 4
-
-#endif /* _mkutda_ */
-
diff --git a/src/packlib/kuip/code_motif/mkutdm.h b/src/packlib/kuip/code_motif/mkutdm.h
deleted file mode 100644
index bfd3769..0000000
--- a/src/packlib/kuip/code_motif/mkutdm.h
+++ /dev/null
@@ -1,42 +0,0 @@
-/*
- * $Id: mkutdm.h,v 1.1.1.1 1996/03/08 15:33:12 mclareni Exp $
- *
- * $Log: mkutdm.h,v $
- * Revision 1.1.1.1 1996/03/08 15:33:12 mclareni
- * Kuip
- *
- */
-/*** Global data which refer to some Motif/X11 include files ***/
-#ifndef _mkutdm_
-#define _mkutdm_
-
-/* #define Extern must be in one routine to allocate space */
-#ifndef Extern
-# define Extern extern
-#endif
-
-#if XtSpecificationRelease <= 4 /* X11R4 */
-typedef Cardinal IntC;
-#else /* X11R5 */
-typedef int IntC;
-#endif
-
-/* global data (general data but connected to Motif include files) */
-#include "mkutda.h"
-/* Instance Specific Variables and Context Routines */
-#include "mkuxxt.h"
-Extern Display *km_Display;
-Extern Position km_xcur_pos, km_ycur_pos; /* current cursor position */
-Extern Widget km_toplevel; /* shadow kxterm used to position popups */
-Extern Widget km_main_browser; /* KUIP Main Browser */
-Extern Widget km_scrOutput; /* scrollable text output (created by KUMOUT) */
-Extern Widget km_HigzOutput; /* scrollable text output for HIGZ (Igxmess) */
-Extern Cursor km_main_cursor, km_input_cursor, km_wait_cursor, km_cross_cursor,
- km_help_cursor, km_busy_cursor, km_blck_cursor, km_selc_cursor;
-Extern Pixmap km_pixmap; /* general pixmap for KUIP/Motif */
-Extern XmStringCharSet km_charset; /* KUIP/Motif character set used */
-Extern Pixel km_foreground, km_background;
-Extern Boolean km_panel_context; /* flag for context help inside panels */
-
-#endif /* _mkutdm_ */
-
diff --git a/src/packlib/kuip/code_motif/mkutfm.h b/src/packlib/kuip/code_motif/mkutfm.h
deleted file mode 100644
index 73ac173..0000000
--- a/src/packlib/kuip/code_motif/mkutfm.h
+++ /dev/null
@@ -1,290 +0,0 @@
-/*
- * $Id: mkutfm.h,v 1.1.1.1 1996/03/08 15:33:12 mclareni Exp $
- *
- * $Log: mkutfm.h,v $
- * Revision 1.1.1.1 1996/03/08 15:33:12 mclareni
- * Kuip
- *
- */
-/*** Utility functions which refer some Motif/X11 include files ***/
-#ifndef _mkutfm_
-#define _mkutfm_
-
-/* km_do_help : Display help corresponding to a "Help_item" entry in the CDF. */
-extern C_PROTO_3(void km_do_help,
- Widget w,
- char *cval,
- XmAnyCallbackStruct *call_data);
-/* km_help_activate : Display help text at the current cursor position */
-extern C_PROTO_3(void km_help_activate,
- Widget widget,
- caddr_t tag,
- XmAnyCallbackStruct *callback_data);
-/* km_GetTrueShell : Return the true toplevel shell of the interface */
-extern C_PROTO_1(Widget km_GetTrueShell,
- Widget);
-/* km_normal_string : Get char string from XmString */
-extern C_PROTO_1(char *km_normal_string,
- XmString);
-/* km_insert_string : Insert a string at the end of a XmText widget */
-extern C_PROTO_3(void km_insert_string,
- Widget,
- char *,
- Boolean);
-/* km_all_cursor : Set cursor shape for all widgets/windows */
-extern C_PROTO_1(void km_all_cursor,
- int);
-/* km_double_click : Check if doubleclick happened */
-extern C_PROTO_1(Boolean km_double_click,
- Time);
-/* km_quit_confirm : ask for confirmation before quit (return 1 or 0) */
-extern C_PROTO_0(int km_quit_confirm);
-/* km_exit_confirm : ask for confirmation before exit (return 1 or 0) */
-extern C_PROTO_0(int km_exit_confirm);
-/* km_cmd_list : display selection box with list of possible commands */
-extern C_PROTO_3(void km_cmd_list,
- char *command,
- KmCommand **cmd_list,
- int flag);
-/* km_display_list : display selection box with list of items */
-extern C_PROTO_3(void km_display_list,
- char **items,
- char **help_items,
- ListData data);
-/* km_ask_user : Ask the user a question and wait for the answer (2 choices) */
-extern C_PROTO_5(Boolean km_ask_user,
- Widget,
- char *,
- char *,
- char *,
- int);
-/* km_warn_user : Warn the user with a message and wait till he acknowledges */
-extern C_PROTO_3(void km_warn_user,
- Widget,
- char *,
- char *);
-/* km_inform_user : Inform the user with a message and wait till acknowledge */
-extern C_PROTO_3(void km_inform_user,
- Widget,
- char *,
- char *);
-/* km_MwmCloseCallback : Install MwmCloseCallback */
-extern C_PROTO_3(void km_MwmCloseCallback,
- Widget,
- XtCallbackProc,
- XtPointer);
-/* km_IsShellIconic : Is shell in iconic state? */
-extern C_PROTO_1(Boolean km_IsShellIconic,
- Widget);
-/* km_IconifyShell : Iconify a shell */
-extern C_PROTO_1(void km_IconifyShell,
- Widget);
-/* km_DeIconifyShell : De-Iconify a shell */
-extern C_PROTO_1(void km_DeIconifyShell,
- Widget);
-/* km_FlushEvents : equivalent to XtAppMainLoop */
-extern C_PROTO_0(void km_FlushEvents);
-/* km_wait_input : Ask user for input and wait till she responds (C callable) */
-extern C_PROTO_3 (char *km_wait_input,
- char *prompt,
- char *default_line,
- char *help_item);
-/* km_toggle_selection : another taste of the "SelectionBox" (with toggles) */
-extern C_PROTO_3 (int km_toggle_selection,
- char *prompt,
- char **list,
- int defsel);
-/* km_set_cursor : Set the cursor shape for one specific widget/window */
-extern C_PROTO_2(void km_set_cursor,
- Widget,
- Cursor);
-/* km_get_curpos : Get cursor positions xc and yc */
-extern C_PROTO_3(void km_get_curpos,
- XEvent *event,
- Position *x,
- Position *y);
-/* km_display_cmdpan : display Kuip/Motif panel corresponding to a command */
-extern C_PROTO_3(int km_display_cmdpan,
- KmCommand *,
- char *,
- int);
-/* km_create_sctext : Display text in a scrollable window and return Widget */
-extern C_PROTO_5(Widget km_create_sctext,
- char *title,
- char *text,
- Position xr,
- Position yr,
- int flag);
-/* km_display_sctext : same as km_create_sctext without returning Widget */
-extern C_PROTO_5(void km_display_sctext,
- char *title,
- char *text,
- Position xr,
- Position yr,
- int flag);
-/* km_reset_allbrowser : Set or reset the file browser update flag */
-extern C_PROTO_1(void km_reset_allbrowser,
- Boolean set);
-/* km_panel_buttons : fill panel (RowColumn) with buttons */
-extern C_PROTO_4(void km_panel_buttons,
- Widget panel_widget,
- char *name,
- int view_flag,
- int flag);
-/* km_panel_execute : panel button execution (callback) */
-extern C_PROTO_3(void km_panel_execute,
- Widget pbut_widget,
- caddr_t tag,
- XmAnyCallbackStruct *callback_data);
-
-typedef struct _Pal {
- struct _Pal *next; /* link to next panel */
- int npan; /* panel number */
- int npal; /* palette number */
- Widget PALwidget; /* palette widget */
- Widget Bwidget;
- Widget Pwidget;
- Widget Mwidget; /* widget currently managed */
-} Pal;
-
-typedef struct _PaletteStruct {
- Widget widget;
- int npal; /* palette number */
- int view_flag;
- Pal *last_pan; /* last panel in the list */
-} PaletteStruct;
-/* km_panel_add : add button/panel in multi-panel widget */
-extern C_PROTO_3 (void km_panel_add,
- PaletteStruct *pw,
- char *name,
- char *geometry);
-/* Interface for building menus */
-typedef struct _menu_item {
- char *label;
- WidgetClass *class;
- Boolean set; /* default setting in case of toggle button */
- char mnemonic;
- char *accelerator;
- char *accel_text;
- void (*callback)();
- caddr_t callback_data;
- Boolean default_button;
- Boolean separator;
- struct _menu_item *subitems;
-} MenuItem;
-/* km_build_popup : Build a popup menu and return Widget and default button */
-extern C_PROTO_5(Widget km_build_popup,
- Widget parent,
- char *menu_title,
- MenuItem *items,
- int menu_type,
- Widget *default_button);
-/* km_add_item: Fill MenuItem array and returns number of items */
-extern C_PROTO_5(int km_add_item,
- char *item_string,
- void (*push_cb)(),
- void (*toggle_cb)(),
- MenuItem *items,
- int max_items);
-/* km_build_menu: Build popup/option/pulldown menus, depending on menu_type. */
-extern C_PROTO_6(Widget km_build_menu,
- Widget parent,
- int menu_type,
- char *menu_title,
- int menu_mnemonic,
- MenuItem *items,
- int add_to_menu);
-/* km_destroy_all_popup : destroy all KUIP/Motif popup menus (button 3 use) */
-extern C_PROTO_0(void km_destroy_all_popup);
-/* km_make_menuStruct : Assign the space for a MenuCbStruct and fill it */
-typedef struct {
- Widget button; /* menu button to be set (in)sensitive */
- Widget dialog; /* associated argument popup dialog */
-} MenuCbStruct;
-extern C_PROTO_2(MenuCbStruct *km_make_menuStruct,
- Widget,
- Widget);
-/* km_help_cb : Display (scrolled text) HELP on command passed as client_data */
-extern C_PROTO_3 (void km_help_cb,
- Widget w,
- char *help_cmd,
- XmAnyCallbackStruct *call_data);
-/* km_close_cb : Close (popdown) a popup dial. (/shell) passed as client_data */
-extern C_PROTO_3(void km_close_cb,
- Widget,
- Widget,
- XmAnyCallbackStruct *);
-/* km_cancel_cb : Unmanage popup passed as client_data (in MenuCbStruct). */
-extern C_PROTO_3(void km_cancel_cb,
- Widget,
- MenuCbStruct *,
- XmAnyCallbackStruct *);
-/* km_reset_sensitive_cb : Reset sensitivity on widget passed as client_data */
-extern C_PROTO_3(void km_reset_sensitive_cb,
- Widget,
- Widget,
- XmAnyCallbackStruct *);
-/* km_show_cb : Show (manage) the widget passed as the client_data */
-extern C_PROTO_3(void km_show_cb,
- Widget w,
- Widget dialog,
- XmAnyCallbackStruct *call_data);
-/* km_popdown_MenuCbdialog : Popdown dialog (in MenuCbStruct) and make menu
-item sensitive. */
-extern C_PROTO_1(void km_popdown_MenuCbdialog,
- MenuCbStruct *);
-/* km_popup_MenuCbdialog : Popup dialog (in MenuCbStruct) and make menu
-item insensitive. */
-extern C_PROTO_1(void km_popup_MenuCbdialog,
- MenuCbStruct *);
-
-extern C_PROTO_5(void km_print_box,
- Widget pw,
- Position x,
- Position y,
- char *message,
- int itype);
-
-extern C_PROTO_2(void km_store_appShell,
- Widget w,
- char *title);
-extern C_PROTO_1(void km_reset_appShell,
- Widget w);
-
-extern C_PROTO_0(Widget create_kuipPanel);
-
-/* km_add_menu: to add a pulldown menu in main browser */
-extern C_PROTO_1(void km_add_menu,
- char **menu);
-
-/* km_ContextHelp : context help for panels */
-extern C_PROTO_0(void km_ContextHelp);
-
-/* km_focus_window : to avoid the window to disappear under kxterm */
-extern C_PROTO_3(void km_focus_window,
- Widget widget,
- caddr_t tag,
- XEnterWindowEvent *ev);
-
-/* km_destroy_list : destroy current list (km_list_id) */
-extern C_PROTO_0(void km_destroy_list);
-
-/* km_list_data : Set data information for a user defined list */
-extern void km_list_data( const char *list_label,
- const char *selection_label,
- const char *help_text,
- int (*callback)()) ;
-
-/* km_show_list : display a user defined list */
-extern C_PROTO_1(void km_show_list,
- char **items);
-
-/* km_show_filSel : display a user defined FileSelectionBox */
-extern void km_show_filSel( const char *title,
- const char *dir,
- const char *def,
- const char *help,
- int (*okCallback)());
-
-#endif /* _mkutfm_ */
-
diff --git a/src/packlib/kuip/code_motif/mkuxbr.h b/src/packlib/kuip/code_motif/mkuxbr.h
deleted file mode 100644
index b080f94..0000000
--- a/src/packlib/kuip/code_motif/mkuxbr.h
+++ /dev/null
@@ -1,147 +0,0 @@
-/*
- * $Id: mkuxbr.h,v 1.1.1.1 1996/03/08 15:33:12 mclareni Exp $
- *
- * $Log: mkuxbr.h,v $
- * Revision 1.1.1.1 1996/03/08 15:33:12 mclareni
- * Kuip
- *
- */
-/*******************************************************************************
- kuipBrowser.h
- This header file is included by kuipBrowser.c
-
-*******************************************************************************/
-
-#ifndef _KUIPBROWSER_INCLUDED
-#define _KUIPBROWSER_INCLUDED
-
-
-#include <stdio.h>
-#include <Xm/Xm.h>
-#include <Xm/MwmUtil.h>
-#include <X11/Shell.h>
-#include <Xm/MenuShell.h>
-/* #include "UxXt.h" */
-#include "mkuxxt.h"
-
-#include <Xm/CascadeB.h>
-#include <Xm/PushBG.h>
-#include <Xm/ToggleBG.h>
-#include <Xm/RowColumn.h>
-#include <Xm/Label.h>
-#include <Xm/Text.h>
-#include <Xm/LabelG.h>
-#include <Xm/PushB.h>
-#include <Xm/SeparatoG.h>
-#include <Xm/List.h>
-#include <Xm/ScrolledW.h>
-#include <Xm/Form.h>
-#include <Xm/Frame.h>
-#include <Xm/MainW.h>
-
-/*******************************************************************************
- The definition of the context structure:
- If you create multiple copies of your interface, the context
- structure ensures that your callbacks use the variables for the
- correct copy.
-
- For each swidget in the interface, each argument to the Interface
- function, and each variable in the Interface Specific section of the
- Declarations Editor, there is an entry in the context structure.
- and a #define. The #define makes the variable name refer to the
- corresponding entry in the context structure.
-*******************************************************************************/
-
-typedef struct
-{
- Widget UxkuipBrowser;
- Widget UxkuipBrowserFrame;
- Widget UxbrowserForm;
- Widget UxfileScWindow;
- Widget UxfileList;
- Widget UxdirScWindow;
- Widget UxtopSeparator1;
- Widget UxbottomSeparator1;
- Widget UxcloseButton;
- Widget UxcloneButton;
- Widget Uxform1;
- Widget UxseparatorGadget1;
- Widget Uxform2;
- Widget UxpathLabel;
- Widget UxpathText;
- Widget Uxform3;
- Widget UxcounterLabel;
- Widget Uxform4;
- Widget UxdirNameLabel;
- Widget UxfileNameLabel;
- Widget UxbrowserMenu;
- Widget UxFilePdMenu;
- Widget UxFileMenu;
- Widget UxViewPdMenu;
- Widget UxViewPdMenu_allcycle;
- Widget Uxmenu1_p2_b4;
- Widget UxViewPdMenu_icon;
- Widget UxViewPdMenu_sicon;
- Widget UxViewPdMenu_nicon;
- Widget UxViewPdMenu_title;
- Widget Uxmenu1_p2_b6;
- Widget UxViewPdMenu_selall;
- Widget Uxmenu1_p2_b8;
- Widget UxViewPdMenu_filt;
- Widget UxViewMenu;
- Widget UxHelpPdMenu;
- Widget UxHelpPdMenu_help;
- Widget UxHelpMenu;
-} _UxCkuipBrowser;
-
-#ifdef CONTEXT_MACRO_ACCESS
-static _UxCkuipBrowser *UxKuipBrowserContext;
-#define kuipBrowser UxKuipBrowserContext->UxkuipBrowser
-#define kuipBrowserFrame UxKuipBrowserContext->UxkuipBrowserFrame
-#define browserForm UxKuipBrowserContext->UxbrowserForm
-#define fileScWindow UxKuipBrowserContext->UxfileScWindow
-#define fileList UxKuipBrowserContext->UxfileList
-#define dirScWindow UxKuipBrowserContext->UxdirScWindow
-#define topSeparator1 UxKuipBrowserContext->UxtopSeparator1
-#define bottomSeparator1 UxKuipBrowserContext->UxbottomSeparator1
-#define closeButton UxKuipBrowserContext->UxcloseButton
-#define cloneButton UxKuipBrowserContext->UxcloneButton
-#define form1 UxKuipBrowserContext->Uxform1
-#define separatorGadget1 UxKuipBrowserContext->UxseparatorGadget1
-#define form2 UxKuipBrowserContext->Uxform2
-#define pathLabel UxKuipBrowserContext->UxpathLabel
-#define pathText UxKuipBrowserContext->UxpathText
-#define form3 UxKuipBrowserContext->Uxform3
-#define counterLabel UxKuipBrowserContext->UxcounterLabel
-#define form4 UxKuipBrowserContext->Uxform4
-#define dirNameLabel UxKuipBrowserContext->UxdirNameLabel
-#define fileNameLabel UxKuipBrowserContext->UxfileNameLabel
-#define browserMenu UxKuipBrowserContext->UxbrowserMenu
-#define FilePdMenu UxKuipBrowserContext->UxFilePdMenu
-#define FileMenu UxKuipBrowserContext->UxFileMenu
-#define ViewPdMenu UxKuipBrowserContext->UxViewPdMenu
-#define ViewPdMenu_allcycle UxKuipBrowserContext->UxViewPdMenu_allcycle
-#define menu1_p2_b4 UxKuipBrowserContext->Uxmenu1_p2_b4
-#define ViewPdMenu_icon UxKuipBrowserContext->UxViewPdMenu_icon
-#define ViewPdMenu_sicon UxKuipBrowserContext->UxViewPdMenu_sicon
-#define ViewPdMenu_nicon UxKuipBrowserContext->UxViewPdMenu_nicon
-#define ViewPdMenu_title UxKuipBrowserContext->UxViewPdMenu_title
-#define menu1_p2_b6 UxKuipBrowserContext->Uxmenu1_p2_b6
-#define ViewPdMenu_selall UxKuipBrowserContext->UxViewPdMenu_selall
-#define menu1_p2_b8 UxKuipBrowserContext->Uxmenu1_p2_b8
-#define ViewPdMenu_filt UxKuipBrowserContext->UxViewPdMenu_filt
-#define ViewMenu UxKuipBrowserContext->UxViewMenu
-#define HelpPdMenu UxKuipBrowserContext->UxHelpPdMenu
-#define HelpPdMenu_help UxKuipBrowserContext->UxHelpPdMenu_help
-#define HelpMenu UxKuipBrowserContext->UxHelpMenu
-
-#endif /* CONTEXT_MACRO_ACCESS */
-
-
-/*******************************************************************************
- Declarations of global functions.
-*******************************************************************************/
-
-Widget create_kuipBrowser();
-
-#endif /* _KUIPBROWSER_INCLUDED */
diff --git a/src/packlib/kuip/code_motif/mkuxcm.h b/src/packlib/kuip/code_motif/mkuxcm.h
deleted file mode 100644
index ddada47..0000000
--- a/src/packlib/kuip/code_motif/mkuxcm.h
+++ /dev/null
@@ -1,69 +0,0 @@
-/*
- * $Id: mkuxcm.h,v 1.1.1.1 1996/03/08 15:33:12 mclareni Exp $
- *
- * $Log: mkuxcm.h,v $
- * Revision 1.1.1.1 1996/03/08 15:33:12 mclareni
- * Kuip
- *
- */
-/*******************************************************************************
- kuipCommand.h
- This header file is included by kuipCommand.c
-
-*******************************************************************************/
-
-#ifndef _KUIPCOMMAND_INCLUDED
-#define _KUIPCOMMAND_INCLUDED
-
-
-#include <stdio.h>
-#include <Xm/Xm.h>
-#include <Xm/MwmUtil.h>
-#include <Xm/DialogS.h>
-#include <Xm/MenuShell.h>
-/* #include "UxXt.h" */
-#include "mkuxxt.h"
-
-#include <Xm/PushBG.h>
-#include <Xm/SeparatoG.h>
-#include <Xm/Form.h>
-
-/*******************************************************************************
- The definition of the context structure:
- If you create multiple copies of your interface, the context
- structure ensures that your callbacks use the variables for the
- correct copy.
-
- For each swidget in the interface, each argument to the Interface
- function, and each variable in the Interface Specific section of the
- Declarations Editor, there is an entry in the context structure.
- and a #define. The #define makes the variable name refer to the
- corresponding entry in the context structure.
-*******************************************************************************/
-
-typedef struct
-{
- Widget UxkuipCommandP;
- Widget UxcommandSep;
-} _UxCkuipCommandP;
-
-#ifdef CONTEXT_MACRO_ACCESS
-static _UxCkuipCommandP *UxKuipCommandPContext;
-#define kuipCommandP UxKuipCommandPContext->UxkuipCommandP
-#define commandSep UxKuipCommandPContext->UxcommandSep
-
-#endif /* CONTEXT_MACRO_ACCESS */
-
-extern Widget km_cmdOK;
-extern Widget km_cmdEX;
-extern Widget km_cmdRE;
-extern Widget km_cmdCA;
-extern Widget km_cmdHE;
-
-/*******************************************************************************
- Declarations of global functions.
-*******************************************************************************/
-
-Widget create_kuipCommand();
-
-#endif /* _KUIPCOMMAND_INCLUDED */
diff --git a/src/packlib/kuip/code_motif/mkuxfs.h b/src/packlib/kuip/code_motif/mkuxfs.h
deleted file mode 100644
index e466201..0000000
--- a/src/packlib/kuip/code_motif/mkuxfs.h
+++ /dev/null
@@ -1,65 +0,0 @@
-/*
- * $Id: mkuxfs.h,v 1.1.1.1 1996/03/08 15:33:12 mclareni Exp $
- *
- * $Log: mkuxfs.h,v $
- * Revision 1.1.1.1 1996/03/08 15:33:12 mclareni
- * Kuip
- *
- */
-/*******************************************************************************
- kuipFilSel.h
- This header file is included by kuipFilSel.c
-
-*******************************************************************************/
-
-#ifndef _KUIPFILSEL_INCLUDED
-#define _KUIPFILSEL_INCLUDED
-
-
-#include <stdio.h>
-#include <Xm/Xm.h>
-#include <Xm/MwmUtil.h>
-#include <Xm/DialogS.h>
-#include <Xm/MenuShell.h>
-/* #include "UxXt.h" */
-#include "mkuxxt.h"
-
-#include <Xm/FileSB.h>
-#include <Xm/Form.h>
-
-/*******************************************************************************
- The definition of the context structure:
- If you create multiple copies of your interface, the context
- structure ensures that your callbacks use the variables for the
- correct copy.
-
- For each swidget in the interface, each argument to the Interface
- function, and each variable in the Interface Specific section of the
- Declarations Editor, there is an entry in the context structure.
- and a #define. The #define makes the variable name refer to the
- corresponding entry in the context structure.
-*******************************************************************************/
-
-typedef struct
-{
- Widget UxkuipFilSel;
- Widget Uxkm_FilSel;
- swidget UxfileParent;
-} _UxCkuipFilSel;
-
-#ifdef CONTEXT_MACRO_ACCESS
-static _UxCkuipFilSel *UxKuipFilSelContext;
-#define kuipFilSel UxKuipFilSelContext->UxkuipFilSel
-#define km_FilSel UxKuipFilSelContext->Uxkm_FilSel
-#define fileParent UxKuipFilSelContext->UxfileParent
-
-#endif /* CONTEXT_MACRO_ACCESS */
-
-
-/*******************************************************************************
- Declarations of global functions.
-*******************************************************************************/
-
-Widget create_kuipFilSel();
-
-#endif /* _KUIPFILSEL_INCLUDED */
diff --git a/src/packlib/kuip/code_motif/mkuxgr.h b/src/packlib/kuip/code_motif/mkuxgr.h
deleted file mode 100644
index 8f8c68c..0000000
--- a/src/packlib/kuip/code_motif/mkuxgr.h
+++ /dev/null
@@ -1,68 +0,0 @@
-/*
- * $Id: mkuxgr.h,v 1.1.1.1 1996/03/08 15:33:12 mclareni Exp $
- *
- * $Log: mkuxgr.h,v $
- * Revision 1.1.1.1 1996/03/08 15:33:12 mclareni
- * Kuip
- *
- */
-/*******************************************************************************
- kuipGraphics.h
- This header file is included by kuipGraphics.c
-
-*******************************************************************************/
-
-#ifndef _KUIPGRAPHICS_INCLUDED
-#define _KUIPGRAPHICS_INCLUDED
-
-
-#include <stdio.h>
-#include <Xm/Xm.h>
-#include <Xm/MwmUtil.h>
-#include <X11/Shell.h>
-#include <Xm/MenuShell.h>
-/* #include "UxXt.h" */
-#include "mkuxxt.h"
-
-#include <Xm/DrawingA.h>
-#include <Xm/Form.h>
-#include <Xm/Frame.h>
-#include <Xm/MainW.h>
-
-/*******************************************************************************
- The definition of the context structure:
- If you create multiple copies of your interface, the context
- structure ensures that your callbacks use the variables for the
- correct copy.
-
- For each swidget in the interface, each argument to the Interface
- function, and each variable in the Interface Specific section of the
- Declarations Editor, there is an entry in the context structure.
- and a #define. The #define makes the variable name refer to the
- corresponding entry in the context structure.
-*******************************************************************************/
-
-typedef struct
-{
- Widget UxkuipGraphics;
- Widget UxkuipGraphicsFrame;
- Widget UxgraphicsForm;
-} _UxCkuipGraphics;
-
-#ifdef CONTEXT_MACRO_ACCESS
-static _UxCkuipGraphics *UxKuipGraphicsContext;
-#define kuipGraphics UxKuipGraphicsContext->UxkuipGraphics
-#define kuipGraphicsFrame UxKuipGraphicsContext->UxkuipGraphicsFrame
-#define graphicsForm UxKuipGraphicsContext->UxgraphicsForm
-
-#endif /* CONTEXT_MACRO_ACCESS */
-
-extern Widget km_graphicsDraw;
-
-/*******************************************************************************
- Declarations of global functions.
-*******************************************************************************/
-
-Widget create_kuipGraphics();
-
-#endif /* _KUIPGRAPHICS_INCLUDED */
diff --git a/src/packlib/kuip/code_motif/mkuxli.h b/src/packlib/kuip/code_motif/mkuxli.h
deleted file mode 100644
index c27621b..0000000
--- a/src/packlib/kuip/code_motif/mkuxli.h
+++ /dev/null
@@ -1,64 +0,0 @@
-/*
- * $Id: mkuxli.h,v 1.1.1.1 1996/03/08 15:33:12 mclareni Exp $
- *
- * $Log: mkuxli.h,v $
- * Revision 1.1.1.1 1996/03/08 15:33:12 mclareni
- * Kuip
- *
- */
-/*******************************************************************************
- kuipList.h
- This header file is included by kuipList.c
-
-*******************************************************************************/
-
-#ifndef _KUIPLIST_INCLUDED
-#define _KUIPLIST_INCLUDED
-
-
-#include <stdio.h>
-#include <Xm/Xm.h>
-#include <Xm/MwmUtil.h>
-#include <Xm/DialogS.h>
-#include <Xm/MenuShell.h>
-/* #include "UxXt.h" */
-#include "mkuxxt.h"
-
-#include <Xm/SelectioB.h>
-#include <Xm/Form.h>
-
-/*******************************************************************************
- The definition of the context structure:
- If you create multiple copies of your interface, the context
- structure ensures that your callbacks use the variables for the
- correct copy.
-
- For each swidget in the interface, each argument to the Interface
- function, and each variable in the Interface Specific section of the
- Declarations Editor, there is an entry in the context structure.
- and a #define. The #define makes the variable name refer to the
- corresponding entry in the context structure.
-*******************************************************************************/
-
-typedef struct
-{
- Widget UxkuipList;
- swidget UxlistParent;
-} _UxCkuipList;
-
-#ifdef CONTEXT_MACRO_ACCESS
-static _UxCkuipList *UxKuipListContext;
-#define kuipList UxKuipListContext->UxkuipList
-#define listParent UxKuipListContext->UxlistParent
-
-#endif /* CONTEXT_MACRO_ACCESS */
-
-extern Widget km_listSBox;
-
-/*******************************************************************************
- Declarations of global functions.
-*******************************************************************************/
-
-Widget create_kuipList();
-
-#endif /* _KUIPLIST_INCLUDED */
diff --git a/src/packlib/kuip/code_motif/mkuxlihlp.h b/src/packlib/kuip/code_motif/mkuxlihlp.h
deleted file mode 100644
index 0dfa9ae..0000000
--- a/src/packlib/kuip/code_motif/mkuxlihlp.h
+++ /dev/null
@@ -1,67 +0,0 @@
-/*
- * $Id: mkuxlihlp.h,v 1.1.1.1 1996/03/08 15:33:12 mclareni Exp $
- *
- * $Log: mkuxlihlp.h,v $
- * Revision 1.1.1.1 1996/03/08 15:33:12 mclareni
- * Kuip
- *
- */
-
-/*******************************************************************************
- kuipListHelp.h
- This header file is included by kuipListHelp.c
-
-*******************************************************************************/
-
-#ifndef _KUIPLISTHELP_INCLUDED
-#define _KUIPLISTHELP_INCLUDED
-
-
-#include <stdio.h>
-#include <Xm/Xm.h>
-#include <Xm/MwmUtil.h>
-#include <Xm/DialogS.h>
-#include <Xm/MenuShell.h>
-/* #include "UxXt.h" */
-#include "mkuxxt.h"
-
-#include <Xm/Text.h>
-#include <Xm/SelectioB.h>
-#include <Xm/Form.h>
-
-/*******************************************************************************
- The definition of the context structure:
- If you create multiple copies of your interface, the context
- structure ensures that your callbacks use the variables for the
- correct copy.
-
- For each swidget in the interface, each argument to the Interface
- function, and each variable in the Interface Specific section of the
- Declarations Editor, there is an entry in the context structure.
- and a #define. The #define makes the variable name refer to the
- corresponding entry in the context structure.
-*******************************************************************************/
-
-typedef struct
-{
- Widget UxkuipListHelp;
- swidget UxlistHelpParent;
-} _UxCkuipListHelp;
-
-#ifdef CONTEXT_MACRO_ACCESS
-static _UxCkuipListHelp *UxKuipListHelpContext;
-#define kuipListHelp UxKuipListHelpContext->UxkuipListHelp
-#define listHelpParent UxKuipListHelpContext->UxlistHelpParent
-
-#endif /* CONTEXT_MACRO_ACCESS */
-
-extern Widget km_listSBoxHelp;
-extern Widget km_listText;
-
-/*******************************************************************************
- Declarations of global functions.
-*******************************************************************************/
-
-Widget create_kuipListHelp();
-
-#endif /* _KUIPLISTHELP_INCLUDED */
diff --git a/src/packlib/kuip/code_motif/mkuxol.h b/src/packlib/kuip/code_motif/mkuxol.h
deleted file mode 100644
index b2200dd..0000000
--- a/src/packlib/kuip/code_motif/mkuxol.h
+++ /dev/null
@@ -1,74 +0,0 @@
-/*
- * $Id: mkuxol.h,v 1.1.1.1 1996/03/08 15:33:12 mclareni Exp $
- *
- * $Log: mkuxol.h,v $
- * Revision 1.1.1.1 1996/03/08 15:33:12 mclareni
- * Kuip
- *
- */
-/*******************************************************************************
- kuipOptList.h
- This header file is included by kuipOptList.c
-
-*******************************************************************************/
-
-#ifndef _KUIPOPTLIST_INCLUDED
-#define _KUIPOPTLIST_INCLUDED
-
-
-#include <stdio.h>
-#include <Xm/Xm.h>
-#include <Xm/MwmUtil.h>
-#include <Xm/DialogS.h>
-#include <Xm/MenuShell.h>
-/* #include "UxXt.h" */
-#include "mkuxxt.h"
-
-#include <Xm/List.h>
-#include <Xm/ScrolledW.h>
-#include <Xm/PushBG.h>
-#include <Xm/SeparatoG.h>
-#include <Xm/Form.h>
-
-/*******************************************************************************
- The definition of the context structure:
- If you create multiple copies of your interface, the context
- structure ensures that your callbacks use the variables for the
- correct copy.
-
- For each swidget in the interface, each argument to the Interface
- function, and each variable in the Interface Specific section of the
- Declarations Editor, there is an entry in the context structure.
- and a #define. The #define makes the variable name refer to the
- corresponding entry in the context structure.
-*******************************************************************************/
-
-typedef struct
-{
- Widget UxkuipOptList;
- Widget UxOptListSep;
- Widget UxOKButton;
- Widget UxCCLButton;
- Widget UxscrolledWindow1;
- Widget UxOptList;
-} _UxCkuipOptList;
-
-#ifdef CONTEXT_MACRO_ACCESS
-static _UxCkuipOptList *UxKuipOptListContext;
-#define kuipOptList UxKuipOptListContext->UxkuipOptList
-#define OptListSep UxKuipOptListContext->UxOptListSep
-#define OKButton UxKuipOptListContext->UxOKButton
-#define CCLButton UxKuipOptListContext->UxCCLButton
-#define scrolledWindow1 UxKuipOptListContext->UxscrolledWindow1
-#define OptList UxKuipOptListContext->UxOptList
-
-#endif /* CONTEXT_MACRO_ACCESS */
-
-
-/*******************************************************************************
- Declarations of global functions.
-*******************************************************************************/
-
-Widget create_kuipOptList();
-
-#endif /* _KUIPOPTLIST_INCLUDED */
diff --git a/src/packlib/kuip/code_motif/mkuxpa.h b/src/packlib/kuip/code_motif/mkuxpa.h
deleted file mode 100644
index 593bb20..0000000
--- a/src/packlib/kuip/code_motif/mkuxpa.h
+++ /dev/null
@@ -1,139 +0,0 @@
-/*
- * $Id: mkuxpa.h,v 1.1.1.1 1996/03/08 15:33:12 mclareni Exp $
- *
- * $Log: mkuxpa.h,v $
- * Revision 1.1.1.1 1996/03/08 15:33:12 mclareni
- * Kuip
- *
- */
-
-/*******************************************************************************
- kuipPanel.h
- This header file is included by kuipPanel.c
-
-*******************************************************************************/
-
-#ifndef _KUIPPANEL_INCLUDED
-#define _KUIPPANEL_INCLUDED
-
-
-#include <stdio.h>
-#include <Xm/Xm.h>
-#include <Xm/MwmUtil.h>
-#include <X11/Shell.h>
-#include <Xm/MenuShell.h>
-/* #include "UxXt.h" */
-#include "mkuxxt.h"
-
-#include <Xm/CascadeB.h>
-#include <Xm/Separator.h>
-#include <Xm/ToggleBG.h>
-#include <Xm/PushB.h>
-#include <Xm/RowColumn.h>
-#include <Xm/ScrolledW.h>
-#include <Xm/Form.h>
-#include <Xm/Frame.h>
-#include <Xm/MainW.h>
-
-/*******************************************************************************
- The definition of the context structure:
- If you create multiple copies of your interface, the context
- structure ensures that your callbacks use the variables for the
- correct copy.
-
- For each swidget in the interface, each argument to the Interface
- function, and each variable in the Interface Specific section of the
- Declarations Editor, there is an entry in the context structure.
- and a #define. The #define makes the variable name refer to the
- corresponding entry in the context structure.
-*******************************************************************************/
-
-typedef struct
-{
- Widget UxkuipPanel;
- Widget UxkuipPanelFrame;
- Widget UxkuipPanelForm;
- Widget Uxkm_scrollPI;
- Widget Uxkm_rowcolPI;
- Widget Uxkm_scrollPN;
- Widget Uxkm_rowcolPN;
- Widget Uxkm_scrollPB;
- Widget Uxkm_rowcolPB;
- Widget Uxkm_scrollPC;
- Widget Uxkm_rowcolPC;
- Widget Uxkm_scrollP1;
- Widget Uxkm_rowcolP1;
- Widget UxkuipPanelMenu;
- Widget UxFilePdMenPN;
- Widget Uxkm_savePNB;
- Widget Uxkm_okPNB;
- Widget UxFileMenPN;
- Widget UxViewPdMenPN;
- Widget Uxkm_viewPNB_name;
- Widget Uxkm_viewPNB_icon;
- Widget Uxkm_viewPNB_both;
- Widget Uxkm_viewPNB_sep;
- Widget Uxkm_viewPNB_command;
- Widget Uxkm_viewPNB_command1;
- Widget UxViewMenPN;
- Widget UxHelpPdMenPN;
- Widget Uxkm_helpPNB1;
- Widget Uxkm_helpPNB2;
- Widget Uxkm_helpPNB3;
- Widget Uxkm_helpPNB4;
- Widget Uxkm_helpPNB5;
- Widget Uxkm_helpPNB6;
- Widget UxHelpPdMenPN_b7;
- Widget Uxkm_helpCONTEXT;
- Widget UxHelpMenPN;
-} _UxCkuipPanel;
-
-#ifdef CONTEXT_MACRO_ACCESS
-static _UxCkuipPanel *UxKuipPanelContext;
-#define kuipPanel UxKuipPanelContext->UxkuipPanel
-#define kuipPanelFrame UxKuipPanelContext->UxkuipPanelFrame
-#define kuipPanelForm UxKuipPanelContext->UxkuipPanelForm
-#define km_scrollPI UxKuipPanelContext->Uxkm_scrollPI
-#define km_rowcolPI UxKuipPanelContext->Uxkm_rowcolPI
-#define km_scrollPN UxKuipPanelContext->Uxkm_scrollPN
-#define km_rowcolPN UxKuipPanelContext->Uxkm_rowcolPN
-#define km_scrollPB UxKuipPanelContext->Uxkm_scrollPB
-#define km_rowcolPB UxKuipPanelContext->Uxkm_rowcolPB
-#define km_scrollPC UxKuipPanelContext->Uxkm_scrollPC
-#define km_rowcolPC UxKuipPanelContext->Uxkm_rowcolPC
-#define km_scrollP1 UxKuipPanelContext->Uxkm_scrollP1
-#define km_rowcolP1 UxKuipPanelContext->Uxkm_rowcolP1
-#define kuipPanelMenu UxKuipPanelContext->UxkuipPanelMenu
-#define FilePdMenPN UxKuipPanelContext->UxFilePdMenPN
-#define km_savePNB UxKuipPanelContext->Uxkm_savePNB
-#define km_okPNB UxKuipPanelContext->Uxkm_okPNB
-#define FileMenPN UxKuipPanelContext->UxFileMenPN
-#define ViewPdMenPN UxKuipPanelContext->UxViewPdMenPN
-#define km_viewPNB_name UxKuipPanelContext->Uxkm_viewPNB_name
-#define km_viewPNB_icon UxKuipPanelContext->Uxkm_viewPNB_icon
-#define km_viewPNB_both UxKuipPanelContext->Uxkm_viewPNB_both
-#define km_viewPNB_sep UxKuipPanelContext->Uxkm_viewPNB_sep
-#define km_viewPNB_command UxKuipPanelContext->Uxkm_viewPNB_command
-#define km_viewPNB_command1 UxKuipPanelContext->Uxkm_viewPNB_command1
-#define ViewMenPN UxKuipPanelContext->UxViewMenPN
-#define HelpPdMenPN UxKuipPanelContext->UxHelpPdMenPN
-#define km_helpPNB1 UxKuipPanelContext->Uxkm_helpPNB1
-#define km_helpPNB2 UxKuipPanelContext->Uxkm_helpPNB2
-#define km_helpPNB3 UxKuipPanelContext->Uxkm_helpPNB3
-#define km_helpPNB4 UxKuipPanelContext->Uxkm_helpPNB4
-#define km_helpPNB5 UxKuipPanelContext->Uxkm_helpPNB5
-#define km_helpPNB6 UxKuipPanelContext->Uxkm_helpPNB6
-#define HelpPdMenPN_b7 UxKuipPanelContext->UxHelpPdMenPN_b7
-#define km_helpCONTEXT UxKuipPanelContext->Uxkm_helpCONTEXT
-#define HelpMenPN UxKuipPanelContext->UxHelpMenPN
-
-#endif /* CONTEXT_MACRO_ACCESS */
-
-
-/*******************************************************************************
- Declarations of global functions.
-*******************************************************************************/
-
-Widget create_kuipPanel();
-
-#endif /* _KUIPPANEL_INCLUDED */
diff --git a/src/packlib/kuip/code_motif/mkuxpb.h b/src/packlib/kuip/code_motif/mkuxpb.h
deleted file mode 100644
index dae461b..0000000
--- a/src/packlib/kuip/code_motif/mkuxpb.h
+++ /dev/null
@@ -1,74 +0,0 @@
-/*
- * $Id: mkuxpb.h,v 1.1.1.1 1996/03/08 15:33:12 mclareni Exp $
- *
- * $Log: mkuxpb.h,v $
- * Revision 1.1.1.1 1996/03/08 15:33:12 mclareni
- * Kuip
- *
- */
-
-/*******************************************************************************
- PalButton.h
- This header file is included by PalButton.c
-
-*******************************************************************************/
-
-#ifndef _PALBUTTON_INCLUDED
-#define _PALBUTTON_INCLUDED
-
-
-#include <stdio.h>
-#include <Xm/Xm.h>
-#include <Xm/MwmUtil.h>
-#include <X11/Shell.h>
-#include <Xm/MenuShell.h>
-/* #include "UxXt.h" */
-#include "mkuxxt.h"
-
-#include <Xm/Label.h>
-#include <Xm/ArrowB.h>
-#include <Xm/Frame.h>
-#include <Xm/Form.h>
-
-/*******************************************************************************
- The definition of the context structure:
- If you create multiple copies of your interface, the context
- structure ensures that your callbacks use the variables for the
- correct copy.
-
- For each swidget in the interface, each argument to the Interface
- function, and each variable in the Interface Specific section of the
- Declarations Editor, there is an entry in the context structure.
- and a #define. The #define makes the variable name refer to the
- corresponding entry in the context structure.
-*******************************************************************************/
-
-typedef struct
-{
- Widget UxPalButton;
- Widget UxPNBframe1;
- Widget UxPNBform1;
- Widget UxarrowButtonB;
- Widget Uxkm_palLabelB;
- swidget UxPalParent;
-} _UxCPalButton;
-
-#ifdef CONTEXT_MACRO_ACCESS
-static _UxCPalButton *UxPalButtonContext;
-#define PalButton UxPalButtonContext->UxPalButton
-#define PNBframe1 UxPalButtonContext->UxPNBframe1
-#define PNBform1 UxPalButtonContext->UxPNBform1
-#define arrowButtonB UxPalButtonContext->UxarrowButtonB
-#define km_palLabelB UxPalButtonContext->Uxkm_palLabelB
-#define PalParent UxPalButtonContext->UxPalParent
-
-#endif /* CONTEXT_MACRO_ACCESS */
-
-
-/*******************************************************************************
- Declarations of global functions.
-*******************************************************************************/
-
-Widget create_PalButton();
-
-#endif /* _PALBUTTON_INCLUDED */
diff --git a/src/packlib/kuip/code_motif/mkuxpl.h b/src/packlib/kuip/code_motif/mkuxpl.h
deleted file mode 100644
index 4df1e02..0000000
--- a/src/packlib/kuip/code_motif/mkuxpl.h
+++ /dev/null
@@ -1,109 +0,0 @@
-/*
- * $Id: mkuxpl.h,v 1.1.1.1 1996/03/08 15:33:12 mclareni Exp $
- *
- * $Log: mkuxpl.h,v $
- * Revision 1.1.1.1 1996/03/08 15:33:12 mclareni
- * Kuip
- *
- */
-
-/*******************************************************************************
- kuipPalette.h
- This header file is included by kuipPalette.c
-
-*******************************************************************************/
-
-#ifndef _KUIPPALETTE_INCLUDED
-#define _KUIPPALETTE_INCLUDED
-
-
-#include <stdio.h>
-#include <Xm/Xm.h>
-#include <Xm/MwmUtil.h>
-#include <X11/Shell.h>
-#include <Xm/MenuShell.h>
-/* #include "UxXt.h" */
-#include "mkuxxt.h"
-
-#include <Xm/CascadeB.h>
-#include <Xm/ToggleBG.h>
-#include <Xm/SeparatoG.h>
-#include <Xm/PushBG.h>
-#include <Xm/RowColumn.h>
-#include <Xm/ScrolledW.h>
-#include <Xm/Form.h>
-#include <Xm/Frame.h>
-#include <Xm/MainW.h>
-
-/*******************************************************************************
- The definition of the context structure:
- If you create multiple copies of your interface, the context
- structure ensures that your callbacks use the variables for the
- correct copy.
-
- For each swidget in the interface, each argument to the Interface
- function, and each variable in the Interface Specific section of the
- Declarations Editor, there is an entry in the context structure.
- and a #define. The #define makes the variable name refer to the
- corresponding entry in the context structure.
-*******************************************************************************/
-
-typedef struct
-{
- Widget UxkuipPalette;
- Widget UxkuipPaletteFrame;
- Widget UxkuipPaletteForm;
- Widget UxPalScWindow;
- Widget Uxkm_palForm;
- Widget UxPaletteMenu;
- Widget UxFilePdMenu;
- Widget Uxkm_addPAL;
- Widget UxFilePdMenu_b6;
- Widget Uxkm_closePAL;
- Widget UxFilePdMenu_b5;
- Widget Uxkm_exitPAL;
- Widget UxFileMenu;
- Widget UxViewPdMenu;
- Widget Uxkm_viewPAL_icon;
- Widget Uxkm_viewPAL_name;
- Widget Uxkm_viewPAL_both;
- Widget UxViewMenu;
- Widget UxHelpPdMenu;
- Widget Uxkm_helpPAL;
- Widget UxHelpMenu;
-} _UxCkuipPalette;
-
-#ifdef CONTEXT_MACRO_ACCESS
-static _UxCkuipPalette *UxKuipPaletteContext;
-#define kuipPalette UxKuipPaletteContext->UxkuipPalette
-#define kuipPaletteFrame UxKuipPaletteContext->UxkuipPaletteFrame
-#define kuipPaletteForm UxKuipPaletteContext->UxkuipPaletteForm
-#define PalScWindow UxKuipPaletteContext->UxPalScWindow
-#define km_palForm UxKuipPaletteContext->Uxkm_palForm
-#define PaletteMenu UxKuipPaletteContext->UxPaletteMenu
-#define FilePdMenu UxKuipPaletteContext->UxFilePdMenu
-#define km_addPAL UxKuipPaletteContext->Uxkm_addPAL
-#define FilePdMenu_b6 UxKuipPaletteContext->UxFilePdMenu_b6
-#define km_closePAL UxKuipPaletteContext->Uxkm_closePAL
-#define FilePdMenu_b5 UxKuipPaletteContext->UxFilePdMenu_b5
-#define km_exitPAL UxKuipPaletteContext->Uxkm_exitPAL
-#define FileMenu UxKuipPaletteContext->UxFileMenu
-#define ViewPdMenu UxKuipPaletteContext->UxViewPdMenu
-#define km_viewPAL_icon UxKuipPaletteContext->Uxkm_viewPAL_icon
-#define km_viewPAL_name UxKuipPaletteContext->Uxkm_viewPAL_name
-#define km_viewPAL_both UxKuipPaletteContext->Uxkm_viewPAL_both
-#define ViewMenu UxKuipPaletteContext->UxViewMenu
-#define HelpPdMenu UxKuipPaletteContext->UxHelpPdMenu
-#define km_helpPAL UxKuipPaletteContext->Uxkm_helpPAL
-#define HelpMenu UxKuipPaletteContext->UxHelpMenu
-
-#endif /* CONTEXT_MACRO_ACCESS */
-
-
-/*******************************************************************************
- Declarations of global functions.
-*******************************************************************************/
-
-Widget create_kuipPalette();
-
-#endif /* _KUIPPALETTE_INCLUDED */
diff --git a/src/packlib/kuip/code_motif/mkuxpp.h b/src/packlib/kuip/code_motif/mkuxpp.h
deleted file mode 100644
index a4f2470..0000000
--- a/src/packlib/kuip/code_motif/mkuxpp.h
+++ /dev/null
@@ -1,96 +0,0 @@
-/*
- * $Id: mkuxpp.h,v 1.1.1.1 1996/03/08 15:33:12 mclareni Exp $
- *
- * $Log: mkuxpp.h,v $
- * Revision 1.1.1.1 1996/03/08 15:33:12 mclareni
- * Kuip
- *
- */
-
-/*******************************************************************************
- PalPanel.h
- This header file is included by PalPanel.c
-
-*******************************************************************************/
-
-#ifndef _PALPANEL_INCLUDED
-#define _PALPANEL_INCLUDED
-
-
-#include <stdio.h>
-#include <Xm/Xm.h>
-#include <Xm/MwmUtil.h>
-#include <X11/Shell.h>
-#include <Xm/MenuShell.h>
-/* #include "UxXt.h" */
-#include "mkuxxt.h"
-
-#include <Xm/Label.h>
-#include <Xm/ArrowB.h>
-#include <Xm/RowColumn.h>
-#include <Xm/ScrolledW.h>
-#include <Xm/Frame.h>
-#include <Xm/Form.h>
-
-/*******************************************************************************
- The definition of the context structure:
- If you create multiple copies of your interface, the context
- structure ensures that your callbacks use the variables for the
- correct copy.
-
- For each swidget in the interface, each argument to the Interface
- function, and each variable in the Interface Specific section of the
- Declarations Editor, there is an entry in the context structure.
- and a #define. The #define makes the variable name refer to the
- corresponding entry in the context structure.
-*******************************************************************************/
-
-typedef struct
-{
- Widget UxPalPanel;
- Widget UxPNPframe1;
- Widget UxPNPform1;
- Widget Uxkm_rowcolMI;
- Widget Uxkm_scrollMI;
- Widget Uxkm_rowcolMN;
- Widget Uxkm_scrollMN;
- Widget Uxkm_rowcolMB;
- Widget Uxkm_scrollMB;
- Widget Uxkm_rowcolMC;
- Widget Uxkm_scrollMC;
- Widget Uxkm_rowcolM1;
- Widget Uxkm_scrollM1;
- Widget UxarrowButtonP;
- Widget Uxkm_palLabelP;
- swidget UxUxParent;
-} _UxCPalPanel;
-
-#ifdef CONTEXT_MACRO_ACCESS
-static _UxCPalPanel *UxPalPanelContext;
-#define PalPanel UxPalPanelContext->UxPalPanel
-#define PNPframe1 UxPalPanelContext->UxPNPframe1
-#define PNPform1 UxPalPanelContext->UxPNPform1
-#define km_rowcolMI UxPalPanelContext->Uxkm_rowcolMI
-#define km_scrollMI UxPalPanelContext->Uxkm_scrollMI
-#define km_rowcolMN UxPalPanelContext->Uxkm_rowcolMN
-#define km_scrollMN UxPalPanelContext->Uxkm_scrollMN
-#define km_rowcolMB UxPalPanelContext->Uxkm_rowcolMB
-#define km_scrollMB UxPalPanelContext->Uxkm_scrollMB
-#define km_rowcolMC UxPalPanelContext->Uxkm_rowcolMC
-#define km_scrollMC UxPalPanelContext->Uxkm_scrollMC
-#define km_rowcolM1 UxPalPanelContext->Uxkm_rowcolM1
-#define km_scrollM1 UxPalPanelContext->Uxkm_scrollM1
-#define arrowButtonP UxPalPanelContext->UxarrowButtonP
-#define km_palLabelP UxPalPanelContext->Uxkm_palLabelP
-#define UxParent UxPalPanelContext->UxUxParent
-
-#endif /* CONTEXT_MACRO_ACCESS */
-
-
-/*******************************************************************************
- Declarations of global functions.
-*******************************************************************************/
-
-Widget create_PalPanel();
-
-#endif /* _PALPANEL_INCLUDED */
diff --git a/src/packlib/kuip/code_motif/mkuxs1.h b/src/packlib/kuip/code_motif/mkuxs1.h
deleted file mode 100644
index 76c25c3..0000000
--- a/src/packlib/kuip/code_motif/mkuxs1.h
+++ /dev/null
@@ -1,74 +0,0 @@
-/*
- * $Id: mkuxs1.h,v 1.1.1.1 1996/03/08 15:33:12 mclareni Exp $
- *
- * $Log: mkuxs1.h,v $
- * Revision 1.1.1.1 1996/03/08 15:33:12 mclareni
- * Kuip
- *
- */
-/*******************************************************************************
- kuipScroll1.h
- This header file is included by kuipScroll1.c
-
-*******************************************************************************/
-
-#ifndef _KUIPSCROLL1_INCLUDED
-#define _KUIPSCROLL1_INCLUDED
-
-
-#include <stdio.h>
-#include <Xm/Xm.h>
-#include <Xm/MwmUtil.h>
-#include <Xm/DialogS.h>
-#include <Xm/MenuShell.h>
-/* #include "UxXt.h" */
-#include "mkuxxt.h"
-
-#include <Xm/Text.h>
-#include <Xm/ScrolledW.h>
-#include <Xm/SeparatoG.h>
-#include <Xm/PushBG.h>
-#include <Xm/Form.h>
-
-/*******************************************************************************
- The definition of the context structure:
- If you create multiple copies of your interface, the context
- structure ensures that your callbacks use the variables for the
- correct copy.
-
- For each swidget in the interface, each argument to the Interface
- function, and each variable in the Interface Specific section of the
- Declarations Editor, there is an entry in the context structure.
- and a #define. The #define makes the variable name refer to the
- corresponding entry in the context structure.
-*******************************************************************************/
-
-typedef struct
-{
- Widget UxkuipScroll1;
- Widget UxscrollSep1;
- Widget UxScWindow1;
- Widget UxscrollText1;
- swidget Uxscroll1Parent;
-} _UxCkuipScroll1;
-
-#ifdef CONTEXT_MACRO_ACCESS
-static _UxCkuipScroll1 *UxKuipScroll1Context;
-#define kuipScroll1 UxKuipScroll1Context->UxkuipScroll1
-#define scrollSep1 UxKuipScroll1Context->UxscrollSep1
-#define ScWindow1 UxKuipScroll1Context->UxScWindow1
-#define scrollText1 UxKuipScroll1Context->UxscrollText1
-#define scroll1Parent UxKuipScroll1Context->Uxscroll1Parent
-
-#endif /* CONTEXT_MACRO_ACCESS */
-
-extern Widget km_scrollOK1;
-extern Widget km_scrollCL1;
-
-/*******************************************************************************
- Declarations of global functions.
-*******************************************************************************/
-
-Widget create_kuipScroll1();
-
-#endif /* _KUIPSCROLL1_INCLUDED */
diff --git a/src/packlib/kuip/code_motif/mkuxsc.h b/src/packlib/kuip/code_motif/mkuxsc.h
deleted file mode 100644
index 0413cbc..0000000
--- a/src/packlib/kuip/code_motif/mkuxsc.h
+++ /dev/null
@@ -1,73 +0,0 @@
-/*
- * $Id: mkuxsc.h,v 1.1.1.1 1996/03/08 15:33:13 mclareni Exp $
- *
- * $Log: mkuxsc.h,v $
- * Revision 1.1.1.1 1996/03/08 15:33:13 mclareni
- * Kuip
- *
- */
-/*******************************************************************************
- kuipScroll.h
- This header file is included by kuipScroll.c
-
-*******************************************************************************/
-
-#ifndef _KUIPSCROLL_INCLUDED
-#define _KUIPSCROLL_INCLUDED
-
-
-#include <stdio.h>
-#include <Xm/Xm.h>
-#include <Xm/MwmUtil.h>
-#include <Xm/DialogS.h>
-#include <Xm/MenuShell.h>
-/* #include "UxXt.h" */
-#include "mkuxxt.h"
-
-#include <Xm/Text.h>
-#include <Xm/ScrolledW.h>
-#include <Xm/SeparatoG.h>
-#include <Xm/PushBG.h>
-#include <Xm/Form.h>
-
-/*******************************************************************************
- The definition of the context structure:
- If you create multiple copies of your interface, the context
- structure ensures that your callbacks use the variables for the
- correct copy.
-
- For each swidget in the interface, each argument to the Interface
- function, and each variable in the Interface Specific section of the
- Declarations Editor, there is an entry in the context structure.
- and a #define. The #define makes the variable name refer to the
- corresponding entry in the context structure.
-*******************************************************************************/
-
-typedef struct
-{
- Widget UxkuipScroll;
- Widget UxscrollSep;
- Widget UxScWindow;
- Widget UxscrollText;
- swidget UxscrollParent;
-} _UxCkuipScroll;
-
-#ifdef CONTEXT_MACRO_ACCESS
-static _UxCkuipScroll *UxKuipScrollContext;
-#define kuipScroll UxKuipScrollContext->UxkuipScroll
-#define scrollSep UxKuipScrollContext->UxscrollSep
-#define ScWindow UxKuipScrollContext->UxScWindow
-#define scrollText UxKuipScrollContext->UxscrollText
-#define scrollParent UxKuipScrollContext->UxscrollParent
-
-#endif /* CONTEXT_MACRO_ACCESS */
-
-extern Widget km_scrollOK;
-
-/*******************************************************************************
- Declarations of global functions.
-*******************************************************************************/
-
-Widget create_kuipScroll();
-
-#endif /* _KUIPSCROLL_INCLUDED */
diff --git a/src/packlib/kuip/code_motif/mkuxse.h b/src/packlib/kuip/code_motif/mkuxse.h
deleted file mode 100644
index bd742ac..0000000
--- a/src/packlib/kuip/code_motif/mkuxse.h
+++ /dev/null
@@ -1,66 +0,0 @@
-/*
- * $Id: mkuxse.h,v 1.1.1.1 1996/03/08 15:33:13 mclareni Exp $
- *
- * $Log: mkuxse.h,v $
- * Revision 1.1.1.1 1996/03/08 15:33:13 mclareni
- * Kuip
- *
- */
-/*******************************************************************************
- kuipSelect.h
- This header file is included by kuipSelect.c
-
-*******************************************************************************/
-
-#ifndef _KUIPSELECT_INCLUDED
-#define _KUIPSELECT_INCLUDED
-
-
-#include <stdio.h>
-#include <Xm/Xm.h>
-#include <Xm/MwmUtil.h>
-#include <Xm/DialogS.h>
-#include <Xm/MenuShell.h>
-/* #include "UxXt.h" */
-#include "mkuxxt.h"
-
-#include <Xm/PushBG.h>
-#include <Xm/MessageB.h>
-#include <Xm/Form.h>
-
-/*******************************************************************************
- The definition of the context structure:
- If you create multiple copies of your interface, the context
- structure ensures that your callbacks use the variables for the
- correct copy.
-
- For each swidget in the interface, each argument to the Interface
- function, and each variable in the Interface Specific section of the
- Declarations Editor, there is an entry in the context structure.
- and a #define. The #define makes the variable name refer to the
- corresponding entry in the context structure.
-*******************************************************************************/
-
-typedef struct
-{
- Widget UxkuipSelect;
- swidget UxUxParent;
-} _UxCkuipSelect;
-
-#ifdef CONTEXT_MACRO_ACCESS
-static _UxCkuipSelect *UxKuipSelectContext;
-#define kuipSelect UxKuipSelectContext->UxkuipSelect
-#define UxParent UxKuipSelectContext->UxUxParent
-
-#endif /* CONTEXT_MACRO_ACCESS */
-
-extern Widget km_messageBox;
-extern Widget km_goButton;
-
-/*******************************************************************************
- Declarations of global functions.
-*******************************************************************************/
-
-Widget create_kuipSelect();
-
-#endif /* _KUIPSELECT_INCLUDED */
diff --git a/src/packlib/kuip/code_motif/mkuxxt.h b/src/packlib/kuip/code_motif/mkuxxt.h
deleted file mode 100644
index b4a730e..0000000
--- a/src/packlib/kuip/code_motif/mkuxxt.h
+++ /dev/null
@@ -1,191 +0,0 @@
-/*
- * $Id: mkuxxt.h,v 1.1.1.1 1996/03/08 15:33:13 mclareni Exp $
- *
- * $Log: mkuxxt.h,v $
- * Revision 1.1.1.1 1996/03/08 15:33:13 mclareni
- * Kuip
- *
- */
-/*---------------------------------------------------------------------
- * $Date: 1996/03/08 15:33:13 $ $Revision: 1.1.1.1 $
- *---------------------------------------------------------------------
- *
- *
- * Copyright (c) 1991, Visual Edge Software Ltd.
- *
- * ALL RIGHTS RESERVED. Permission to use, copy, modify, and
- * distribute this software and its documentation for any purpose
- * and without fee is hereby granted, provided that the above
- * copyright notice appear in all copies and that both that
- * copyright notice and this permission notice appear in supporting
- * documentation, and that the name of Visual Edge Software not be
- * used in advertising or publicity pertaining to distribution of
- * the software without specific, written prior permission. The year
- * included in the notice is the year of the creation of the work.
- *-------------------------------------------------------------------*/
-
-/*****************************************************************************/
-/* UxXt.h */
-/*****************************************************************************/
-
-#ifndef _UX_XT_H_
-#define _UX_XT_H_
-
-#include <stddef.h>
-#include <Xm/Xm.h>
-
-#ifdef UIL_CODE
-#include <Mrm/MrmPublic.h>
-#endif /* UIL_CODE */
-
-#if 0
-#ifdef __STDC__
-typedef char *caddr_t;
-#endif
-#endif
-
-/* Exception definitions for CORBA method bindings */
-typedef enum {
- NO_EXCEPTION,
- USER_EXCEPTION,
- SYSTEM_EXCEPTION
-} exception_type;
-
-typedef struct Environment {
- exception_type _major;
-} Environment;
-
-/* extern Environment UxEnv; */
-
-/* The following macros are used in converting string values to the form
- required by the widgets */
-
-#define RES_CONVERT( res_name, res_value) \
- XtVaTypedArg, (res_name), XmRString, (res_value), strlen(res_value) + 1
-
-#define UxPutStrRes( wgt, res_name, res_value ) \
- XtVaSetValues( wgt, RES_CONVERT( res_name, res_value ), NULL )
-
-
-#ifndef UX_INTERPRETER /* Omit this section when interpreting the code */
-
-/* The following macros are supplied for compatibility with swidget code */
-#define swidget Widget
-#define UxWidgetToSwidget(w) (w)
-#define UxGetWidget(sw) (sw)
-#define UxIsValidSwidget(sw) ((sw) != NULL)
-#define NO_PARENT ((Widget) NULL)
-#define UxThisWidget (UxWidget)
-
-/* Macros needed for the method support code */
-#define UxMalloc(a) (malloc(a))
-#define UxRealloc(a,b) (realloc((a), (b)))
-#define UxCalloc(a,b) (calloc((a), (b)))
-#define UxStrEqual(a,b) (!strcmp((a),(b)))
-#define UxGetParent(a) (XtParent((a)))
-
-#define no_grab XtGrabNone
-#define nonexclusive_grab XtGrabNonexclusive
-#define exclusive_grab XtGrabExclusive
-
-
-/* The following global variables are defined in the main() function */
-extern XtAppContext UxAppContext;
-extern Widget UxTopLevel;
-extern Display *UxDisplay;
-extern int UxScreen;
-
-
-/* The following are error codes returned by the functions in UxXt.c */
-#define UX_ERROR -1
-#define UX_NO_ERROR 0
-
-#ifdef UIL_CODE
-#ifdef _NO_PROTO
-extern void UxMrmFetchError();
-extern MrmHierarchy UxMrmOpenHierarchy();
-extern void UxMrmRegisterClass();
-#else
-extern void UxMrmFetchError(MrmHierarchy, char *, Widget, Cardinal);
-extern MrmHierarchy UxMrmOpenHierarchy( char *);
-extern void UxMrmRegisterClass( char *,
- Widget (*)(Widget, String, Arg *, Cardinal));
-#endif /* _NO_PROTO */
-#endif /* UIL_CODE */
-
-
-
-/* The following are declarations of the functions in UxXt.c */
-
-#ifdef _NO_PROTO
-
-extern int UxPopupInterface();
-extern int UxPopdownInterface();
-extern int UxDestroyInterface();
-extern int UxPutContext();
-extern caddr_t UxGetContext();
-extern void UxFreeClientDataCB();
-extern void UxLoadResources();
-extern XmFontList UxConvertFontList();
-extern Pixmap UxConvertPixmap();
-extern Pixmap UxConvert_bitmap();
-extern wchar_t * UxConvertValueWcs();
-extern void * UxNewContext();
-extern void UxDestroyContextCB();
-extern void UxDeleteContextCB();
-extern XtArgVal UxRemoveValueFromArgList();
-extern Widget UxChildSite();
-extern Widget UxRealWidget( );
-
-#else
-
-extern int UxPopupInterface( Widget wgt, XtGrabKind grab_flag );
-extern int UxPopdownInterface( Widget wgt );
-extern int UxDestroyInterface( Widget wgt);
-extern int UxPutContext( Widget wgt, caddr_t context );
-extern caddr_t UxGetContext( Widget wgt );
-extern void UxFreeClientDataCB( Widget wgt, XtPointer client_data,
- XtPointer call_data );
-extern void UxLoadResources( char *fname );
-extern XmFontList UxConvertFontList( char *fontlist_str );
-extern Pixmap UxConvertPixmap( char *file_name );
-extern Pixmap UxConvert_bitmap( char *file_name );
-extern wchar_t * UxConvertValueWcs( char *value_str );
-extern void * UxNewContext(size_t, int);
-extern void UxDestroyContextCB(Widget, XtPointer, XtPointer);
-extern void UxDeleteContextCB( Widget, XtPointer, XtPointer);
-extern XtArgVal UxRemoveValueFromArgList( Arg *args,
- Cardinal *ptr_num_args,
- String res_name );
-extern Widget UxChildSite( Widget );
-extern Widget UxRealWidget( Widget );
-
-#endif /* _NO_PROTO */
-
-#ifdef __cplusplus
-class _UxCInterface {
-
-public:
-
- virtual swidget childSite (Environment * pEnv) {
- if (pEnv)
- pEnv->_major = NO_EXCEPTION;
- return 0;
- }
- virtual swidget UxChildSite (swidget sw);
-
-protected:
- swidget UxThis;
-};
-
-#define CPLUS_ADAPT_CONTEXT(CLASS) \
- static inline \
- CLASS* UxGetContext(CLASS*self) {return self;} \
- static inline\
- void* UxGetContext(swidget any) {return ::UxGetContext(any);}
-
-#endif /* _cplusplus */
-
-#endif /* ! UX_INTERPRETER */
-
-#endif /* ! _UX_XT_H_ */
diff --git a/src/packlib/kuip/code_motif/test_gr.c b/src/packlib/kuip/code_motif/test_gr.c
deleted file mode 100644
index 32677cb..0000000
--- a/src/packlib/kuip/code_motif/test_gr.c
+++ /dev/null
@@ -1,348 +0,0 @@
-/*
- * $Id: test_gr.c,v 1.1.1.1 1996/03/08 15:33:09 mclareni Exp $
- *
- * $Log: test_gr.c,v $
- * Revision 1.1.1.1 1996/03/08 15:33:09 mclareni
- * Kuip
- *
- */
-#if defined(CERNLIB_TEST)
-/*CMZ : 2.05/09 06/07/94 15.45.16 by Alfred Nathaniel*/
-/*-- Author :*/
-/*-- Author : N.Cremel 10/08/92*/
-/*
- * This is only to test commands with graphics area (see KUIPMCDF_TEST,
- * command DOGR).
- */
-
-#include "kuip/kuip.h"
-#include "kuip/kfor.h"
-#include "kuip/kmenu.h"
-#include "kuip/kflag.h"
-#include "kuip/klink.h"
-
-#include "mkincl.h"
-#include "mkdims.h"
-#include "kuip/mkutfu.h"
-#include "mkutfm.h"
-#include "mkutdm.h"
-#define CONTEXT_MACRO_ACCESS 1
-#include "mkuxpl.h"
-#include "mkuxpb.h"
-#include "mkuxpp.h"
-#undef CONTEXT_MACRO_ACCESS
-#include "kuip/browh1.h"
-#include "browh2.h"
-
-
-/***********************************************************************
- * *
- * Forward declarations of local functions. *
- * *
- ***********************************************************************/
-
-
-/***********************************************************************
- * *
- * Local datas. *
- * *
- ***********************************************************************/
-
-Widget draw_widget;
-int wkdraw = 999; /* give special workstation identifier to external drawable */
-
-
-/*******************************************************************************
- formGraph.c
-
- Associated Header file: formGraph.h
-*******************************************************************************/
-
-#include <stdio.h>
-#include <Xm/Xm.h>
-#include <Xm/MwmUtil.h>
-#include <Xm/DialogS.h>
-#include <Xm/MenuShell.h>
-/* #include "UxXt.h" */
-#include "mkuxxt.h"
-
-#include <Xm/PushB.h>
-#include <Xm/DrawingA.h>
-#include <Xm/Frame.h>
-#include <Xm/Form.h>
-
-
-
-/*******************************************************************************
- The following header file defines the context structure.
-*******************************************************************************/
-
-#define CONTEXT_MACRO_ACCESS 1
-/* #include "formGraph.h" */
-
-
-/*******************************************************************************
- formGraph.h
- This header file is included by formGraph.c
-
-*******************************************************************************/
-
-#ifndef _FORMGRAPH_INCLUDED
-#define _FORMGRAPH_INCLUDED
-
-
-#include <stdio.h>
-#include <Xm/Xm.h>
-#include <Xm/MwmUtil.h>
-#include <Xm/DialogS.h>
-#include <Xm/MenuShell.h>
-/* #include "UxXt.h" */
-#include "mkuxxt.h"
-
-#include <Xm/PushB.h>
-#include <Xm/DrawingA.h>
-#include <Xm/Frame.h>
-#include <Xm/Form.h>
-
-/*******************************************************************************
- The definition of the context structure:
- If you create multiple copies of your interface, the context
- structure ensures that your callbacks use the variables for the
- correct copy.
-
- For each swidget in the interface, each argument to the Interface
- function, and each variable in the Interface Specific section of the
- Declarations Editor, there is an entry in the context structure.
- and a #define. The #define makes the variable name refer to the
- corresponding entry in the context structure.
-*******************************************************************************/
-
-typedef struct
-{
- Widget UxformGraph;
- Widget UxframeGraph;
- Widget UxdrawingGraph;
- Widget UxpushButton1;
- Widget UxpushButton2;
- swidget UxUxParent;
-} _UxCformGraph;
-
-#ifdef CONTEXT_MACRO_ACCESS
-static _UxCformGraph *UxFormGraphContext;
-#define formGraph UxFormGraphContext->UxformGraph
-#define frameGraph UxFormGraphContext->UxframeGraph
-#define drawingGraph UxFormGraphContext->UxdrawingGraph
-#define pushButton1 UxFormGraphContext->UxpushButton1
-#define pushButton2 UxFormGraphContext->UxpushButton2
-#define UxParent UxFormGraphContext->UxUxParent
-
-#endif /* CONTEXT_MACRO_ACCESS */
-
-
-/*******************************************************************************
- Declarations of global functions.
-*******************************************************************************/
-
-Widget create_formGraph();
-
-#endif /* _FORMGRAPH_INCLUDED */
-#undef CONTEXT_MACRO_ACCESS
-
-
-/*******************************************************************************
- The following are callback functions.
-*******************************************************************************/
-
-/*******************************************************************************
- The 'build_' function creates all the widgets
- using the resource values specified in the Property Editor.
-*******************************************************************************/
-
-static Widget _Uxbuild_formGraph()
-{
- Widget _UxParent;
-
-
- /* Creation of formGraph */
- _UxParent = UxParent;
- if ( _UxParent == NULL )
- {
- _UxParent = UxTopLevel;
- }
-
- _UxParent = XtVaCreatePopupShell( "formGraph_shell",
- xmDialogShellWidgetClass, _UxParent,
- XmNx, 530,
- XmNy, 520,
- XmNwidth, 400,
- XmNheight, 390,
- XmNshellUnitType, XmPIXELS,
- XmNtitle, "formGraph",
- NULL );
-
- formGraph = XtVaCreateWidget( "formGraph",
- xmFormWidgetClass,
- _UxParent,
- XmNwidth, 400,
- XmNheight, 390,
- XmNunitType, XmPIXELS,
- NULL );
- UxPutContext( formGraph, (char *) UxFormGraphContext );
-
-
- /* Creation of frameGraph */
- frameGraph = XtVaCreateManagedWidget( "frameGraph",
- xmFrameWidgetClass,
- formGraph,
- XmNx, 30,
- XmNy, 100,
- XmNwidth, 350,
- XmNheight, 260,
- XmNbottomAttachment, XmATTACH_FORM,
- XmNbottomOffset, 20,
- XmNleftAttachment, XmATTACH_FORM,
- XmNleftOffset, 20,
- XmNrightAttachment, XmATTACH_FORM,
- XmNrightOffset, 20,
- XmNtopAttachment, XmATTACH_FORM,
- XmNtopOffset, 100,
- NULL );
- UxPutContext( frameGraph, (char *) UxFormGraphContext );
-
-
- /* Creation of drawingGraph */
- drawingGraph = XtVaCreateManagedWidget( "drawingGraph",
- xmDrawingAreaWidgetClass,
- frameGraph,
- XmNresizePolicy, XmRESIZE_NONE,
- XmNx, 10,
- XmNy, 0,
- XmNwidth, 330,
- XmNheight, 250,
- NULL );
- UxPutContext( drawingGraph, (char *) UxFormGraphContext );
-
-
- /* Creation of pushButton1 */
- pushButton1 = XtVaCreateManagedWidget( "pushButton1",
- xmPushButtonWidgetClass,
- formGraph,
- XmNwidth, 100,
- XmNheight, 40,
- XmNleftAttachment, XmATTACH_FORM,
- XmNleftOffset, 20,
- XmNtopAttachment, XmATTACH_FORM,
- XmNtopOffset, 20,
- NULL );
- UxPutContext( pushButton1, (char *) UxFormGraphContext );
-
-
- /* Creation of pushButton2 */
- pushButton2 = XtVaCreateManagedWidget( "pushButton2",
- xmPushButtonWidgetClass,
- formGraph,
- XmNwidth, 100,
- XmNheight, 40,
- XmNrightAttachment, XmATTACH_FORM,
- XmNrightOffset, 20,
- XmNtopAttachment, XmATTACH_FORM,
- XmNtopOffset, 20,
- NULL );
- UxPutContext( pushButton2, (char *) UxFormGraphContext );
-
-
- XtAddCallback( formGraph, XmNdestroyCallback,
- (XtCallbackProc) UxDestroyContextCB,
- (XtPointer) UxFormGraphContext);
-
-
- return ( formGraph );
-}
-
-/*******************************************************************************
- The following is the 'Interface function' which is the
- external entry point for creating this interface.
- This function should be called from your application or from
- a callback function.
-*******************************************************************************/
-
-Widget create_formGraph( _UxUxParent )
- swidget _UxUxParent;
-{
- Widget rtrn;
- _UxCformGraph *UxContext;
-
- UxFormGraphContext = UxContext =
- (_UxCformGraph *) UxNewContext( sizeof(_UxCformGraph), False );
-
- UxParent = _UxUxParent;
-
- rtrn = _Uxbuild_formGraph();
-
- return(rtrn);
-}
-
-/*******************************************************************************
- END OF FILE
-*******************************************************************************/
-
-
-
-/*
- * action routine for /MOTIF/DOGRAPH
- */
-int kxdograph()
-{
- /* Create widget with drawing area */
- draw_widget = create_formGraph (km_toplevel);
- UxFormGraphContext = (_UxCformGraph *) UxGetContext( draw_widget );
- UxPopupInterface( draw_widget, XtGrabNone );
-
-
- /* Pass drawable and display to HIGZ */
- ixsdswi( XtDisplay(draw_widget), XtWindow(drawingGraph) );
-
-
- /* Open HIGZ graphics window (special id 999) on top of this drawable */
- /* (and deactivate all other active workstations) */
- iopexw_ (&wkdraw);
-
- /* Initialize callbacks (Expose, Resize, EnterWindow, LeaveWindow, ...) */
- km_graph_init_callbacks (drawingGraph, draw_widget, wkdraw , -1);
-
- return 0;
-}
-
-/*
- * action routine for /MOTIF/ACTGRAPH
- */
-int kxactgraph()
-{
- /* Activate HIGZ graphics window (id is 999 )*/
- iacwk_ (&wkdraw);
-
- return 0;
-}
-
-/*
- * action routine for /MOTIF/DEAGRAPH
- */
-int kxdeagraph()
-{
- /* Deactivate special extern HIGZ graphics window*/
- idawk_ (&wkdraw);
-
- return 0;
-}
-
-/*
- * action routine for /MOTIF/ENDGRAPH
- */
-int kxendgraph()
-{
- /* Close special extern HIGZ graphics window */
- iclwk_ (&wkdraw);
-
- return 0;
-}
-#endif
diff --git a/src/packlib/kuip/code_motif/vmsqio.c b/src/packlib/kuip/code_motif/vmsqio.c
deleted file mode 100644
index fd28b09..0000000
--- a/src/packlib/kuip/code_motif/vmsqio.c
+++ /dev/null
@@ -1,484 +0,0 @@
-/*
- * $Id: vmsqio.c,v 1.1.1.1 1996/03/08 15:33:09 mclareni Exp $
- *
- * $Log: vmsqio.c,v $
- * Revision 1.1.1.1 1996/03/08 15:33:09 mclareni
- * Kuip
- *
- */
-#if defined(CERNLIB_VAXVMS)
-/*CMZ : 2.04/00 04/10/93 13.44.58 by Alfred Nathaniel*/
-/*-- Author : Fons Rademakers 01/09/93*/
-
-/* Special thanks to C.W. Hobbs for providing these routines */
-
-/***********************************************************************
- ***********************************************************************
- * *
- * Routines for VMS QIO to Xtoolkit Input Event Processing *
- * *
- ***********************************************************************
- ***********************************************************************/
-
-
-/* OpenVMS System Identification Macros
- *
- * Normally, both VAXC (on OpenVMS VAX only) and DEC C (on both OpenVMS VAX
- * and OpenVMS AXP) define the macros "vms" and "VMS". DEC C also defines
- * the ANSI compatible "__vms" and "__VMS".
- *
- * If we are running on an Alpha AXP system, the DEC C for OpenVMS AXP
- * compiler will define "__alpha" and "__ALPHA". Unless a check is made
- * against "__alpha", the VMS code is OK for both VAX and AXP. Note that
- * the various VAX id macros might be defined on AXP as well.
- *
- * If, however, DEC C is running in strict ANSI89 mode (/STANDARD=ANSI89),
- * only the "__vms" and "__VMS" macros are defined -- "vms" and "VMS" are
- * not defined. Since not much (including header files) is strictly
- * ANSI89 compliant, this shouldn't be an issue.
- */
-
-/* Include files */
-
-#include "kuip/kuip.h"
-#include "kuip/kfor.h"
-#include "kuip/kmenu.h"
-
-#include <Xm/Xm.h>
-#include <Xm/Text.h>
-
-#include "mkutfm.h"
-#include "kuip/mkqio.h"
-
-/* Forward declarations */
-
-static void MbxCancelQIO(void);
-static void MbxErrMsg(char *buf, int status, Widget text_widget);
-static void MbxErrTxt(char *buf, Widget text_widget);
-static void MbxReadAST(int astprm);
-static void MbxSendQIO(void);
-
-
-/* Static storage declarations */
-
-MbxMessageRec MbxMessage;
-static int MbxCancelled=0;
-
-
-/***********************************************************************
- * *
- * MbxCancelQIO - cancel a read request from the "stdin" mailbox *
- * *
- ***********************************************************************/
-static void MbxCancelQIO()
-
-{
- int sts;
-
- if (MbxCancelled != 0) return; /* already cancelled, ignore */
-
- sts = sys$cancel (MbxMessage.chan);
-
- MbxCancelled = 1;
-
- if (!(sts & SS$_NORMAL)) {
- printf("* unable to cancel read, VMS status %%x%X *\n", sts);
- }
-}
-
-
-/***********************************************************************
- * *
- * MbxErrMsg - display a VMS system mailbox error *
- * *
- ***********************************************************************/
-static void MbxErrMsg(buf, status, text_widget)
- char *buf;
- int status;
- Widget text_widget;
-{
- char msgbuf[264];
- char msgtxt[512];
- int sts;
- struct dsc$descriptor_s msgdsc =
- {sizeof(msgbuf)-1, DSC$K_DTYPE_T, DSC$K_CLASS_S, NULL};
- msgdsc.dsc$a_pointer = msgbuf;
-
- /* Print the caller's message */
-
- sprintf(msgtxt, "* %s, VMS status 0x%08X *\n", buf, status);
- MbxErrTxt(msgtxt, text_widget);
-
- /* Get the VMS system message text associated with the code */
-
- sts = sys$getmsg(status, &msgdsc.dsc$w_length, &msgdsc, 15, 0);
- if (!(sts & SS$_NORMAL)) {
- fprintf(stderr,
- "* unable to get message, VMS status %%x%X *\n", sts);
- }
-
- /* Add terminator to VMS text string, and send */
-
- msgbuf[msgdsc.dsc$w_length] = '\0';
- sprintf(msgtxt, "* VMS error text '%s' *\n", msgbuf);
- MbxErrTxt(msgtxt, text_widget);
-}
-
-
-/***********************************************************************
- * *
- * MbxErrTxt - display an message in the text widget *
- * *
- ***********************************************************************/
-static void MbxErrTxt(buf, text_widget)
- char *buf;
- Widget text_widget;
-{
- fprintf(stderr, "%s", buf);
- if (text_widget) {
- int pos = XmTextGetLastPosition(text_widget);
- XmTextInsert(text_widget, pos, buf);
-
- pos = XmTextGetLastPosition(text_widget);
- XmTextShowPosition(text_widget, pos);
- }
-}
-
-
-/***********************************************************************
- * *
- * MbxRead - replace "read" call in "get_from_application" callback *
- * *
- ***********************************************************************/
-int MbxRead(buf, bufmax, text_widget)
- char *buf;
- int bufmax;
- Widget text_widget;
-{
- int cpylen;
- char msgtxt[256];
-
- cpylen = 0; /* Assume no data read */
-
- /* ioStatus = 0 can only mean that an I/O is pending, exit now */
-
- if (MbxMessage.ioStatus == 0) return cpylen;
-
- /* Check status from read, but first turn ENDOFFILE into normal.
- * Various actions like closing the channel can cause an "EOF Record"
- * to be written to the mail box.
- */
-
- if (MbxMessage.ioStatus == SS$_ENDOFFILE) MbxMessage.ioStatus = SS$_NORMAL;
-
- /* If an error, we'll fetch the message associated with the status code
- * and write to STDERR and the output text widget, then continue. Some
- * conditions do not effect whether or not data was read -- we'll use the
- * MbxMessage.ioLength as the indicator of whether or not data arrived.
- */
-
- if (MbxMessage.ioStatus != SS$_NORMAL)
- MbxErrMsg("error on read from mailbox", MbxMessage.ioStatus, text_widget);
-
-
- if (MbxMessage.ioLength > 0) {
-
- /* Minimize data length against output buffer */
-
- cpylen = bufmax;
- if (bufmax > MbxMessage.ioLength) cpylen = MbxMessage.ioLength;
-
- /* Force a '\n' at the end (mailboxes are records, not stream) */
-
- if (MbxMessage.buffer[MbxMessage.ioLength-1] != '\n'
- && MbxMessage.buffer[MbxMessage.ioLength-1] != '\2') {
- MbxMessage.buffer[cpylen] = '\n';
- cpylen = cpylen + 1;
- }
-
- /* Check that 'strlen' matches the data length -- if not, then
- * something is confused and we should warn (data will be lost)
- */
-
- MbxMessage.buffer[cpylen] = '\0';
- memcpy(buf,&MbxMessage.buffer[0],cpylen);
- if (strlen(MbxMessage.buffer) != cpylen) {
- sprintf(msgtxt,
- "* input mismatch, read %d bytes, strlen = %d bytes *\n",
- cpylen, strlen(MbxMessage.buffer));
- MbxErrTxt(msgtxt, text_widget);
- }
- }
-
- /* Queue the next I/O. Note that this clears the event flag and the
- * entire IOSB (ioStatus/ioLength/ioSenderPID), lowering the X Input
- * event condition.
- */
-
- MbxSendQIO();
-
- return cpylen;
-}
-
-
-/***********************************************************************
- * *
- * MbxReadAST - Asynchronous System Trap for Mailbox QIO Completion *
- * *
- * Note: Note that this routine is not needed for correct *
- * processing, but can be used as "debug" checking to *
- * make sure that the X callback logic is correct. *
- * *
- * NOTE: This routine is called asynchronously, and interrupts *
- * normal program flow. Note that X Windows and all of *
- * the Motif and toolkit routines do not allow AST threads *
- * to call X routines or modify X data structures. Calling *
- * any window routine can cause (perhaps delayed) failure. *
- * *
- ***********************************************************************/
-static void MbxReadAST(astprm)
- int astprm;
-{
- fprintf(stderr,"PID %X/MbxReadAST: status %%x%X, length %d\n",
- getpid(), MbxMessage.ioStatus, MbxMessage.ioLength);
-}
-
-
-/***********************************************************************
- * *
- * MbxSendQIO - issue a read request from the "stdin" mailbox *
- * *
- ***********************************************************************/
-static void MbxSendQIO()
-
-{
- int sts;
-
- /* If we have cancelled the mailbox I/O, ignore the request */
-
- if (MbxCancelled != 0) return;
-
- /* Send the request to the I/O system (without waiting) */
-
- sts = sys$qio (
- MBX_EVENT_FLAG, /* synch flag */
- MbxMessage.chan, /* I/O channel number */
- IO$_READVBLK, /* function code (virtual read) */
- &MbxMessage.ioStatus, /* I/O Status Block */
- 0, /* MbxReadAST, /* Completion callback routine */
- &MbxMessage, /* Callback parameter */
- &MbxMessage.buffer[0], /* Buffer address */
- MbxMessage.maxread, /* Buffer length */
- 0, 0, 0, 0); /* (not used in this call) */
-
- /* Check status. If an error, we will abort the program. Note that there
- * are two status values for a SYS$QIO call (and SYS$GETDVI):
- *
- * function value returned from call to SYS$QIO:
- *
- * This status tells whether or not the read request was sent
- * off to be handled (asynchronously) by the I/O system. If
- * this reflects failure, then there is a serious problem with
- * the format of the call or the state of the I/O system.
- * Since it is unlikely that a $QIO error will clear itself
- * up, exit the entire program if we have an error.
- *
- * status written to MbxMessage.ioStatus:
- *
- * This status tells what the I/O system did with the request.
- * This field is set to 0 by the SYS$QIO call, and is written
- * asynchronously when the I/O system completes the request.
- */
-
- if (!(sts & SS$_NORMAL)) {
- fprintf(stderr,
- "* unable to queue read to mailbox, VMS status %%x%X *\n", sts);
- exit(sts);
- }
-}
-
-
-/***********************************************************************
- * *
- * MbxSetup - initialize the mailbox interface and start the first *
- * I/O operation *
- * *
- ***********************************************************************/
-void MbxSetup()
-
-{
- char mbxname[256];
- int mbxbuflen;
- int fn, sts;
- struct dsc$descriptor_s devnam = {
- (sizeof mbxname)-1, DSC$K_DTYPE_T, DSC$K_CLASS_S, NULL};
- ItemList GetdviItems[2] = {
- {sizeof(mbxbuflen), DVI$_DEVBUFSIZ, NULL, NULL},
- {0,0,NULL,NULL} };
-
- devnam.dsc$a_pointer = mbxname;
- GetdviItems[0].BufferP = &mbxbuflen;
-
- /* Get name of mailbox into descriptor, and assign an I/O channel */
-
- getname(fileno(stdin),mbxname,1);
- devnam.dsc$w_length = strlen(mbxname);
-
- sts = sys$assign (&devnam, &MbxMessage.chan, PSL$C_USER, NULL);
-
- if (!(sts & SS$_NORMAL)) {
- fprintf(stderr,
- "* unable to assign channel to mailbox, VMS status %%x%X *\n",
- sts);
- exit(sts);
- }
-
- /* Get the buffer size of the mailbox, so we know how much to read */
-
- sts = sys$getdviw (
- MBX_EVENT_FLAG, /* use for synch */
- MbxMessage.chan, /* Mailbox I/O channel */
- 0, /* device name (not used with chan) */
- &GetdviItems, /* item list */
- &MbxMessage.ioStatus, /* I/O status block */
- 0,0,0); /* not used in this call */
-
- /* Like QIO, GETDVI returns function status and IOSB status. If the
- * function status is OK copy the IOSB status and recheck.
- */
- if (sts & SS$_NORMAL) sts = MbxMessage.ioStatus;
- if (!(sts & SS$_NORMAL)) {
- fprintf(stderr,
- "* unable to get mailbox info, VMS status %%x%X *\n", sts);
- exit(sts);
- }
-
- /* Choose the smaller of the mailbox size and the buffer size for I/O,
- * leaving two extra bytes for a '\n\0'
- */
-
- MbxMessage.maxread = mbxbuflen;
- if (mbxbuflen > (MBX_MAX_MSGSIZE-2)) MbxMessage.maxread = MBX_MAX_MSGSIZE-2;
-
- /* Start the first maibox QIO */
-
- MbxCancelled = 0; /* Reset the cancelled flag */
- MbxSendQIO ();
-
-}
-
-
-/***********************************************************************
- * *
- * VMScrelnm - create logical name for device *
- * *
- ***********************************************************************/
-void VMScrelnm(lognam, devnam)
- char *lognam;
- char *devnam;
-{
- int sts;
- short iosb[4];
- char dvibuf[256];
- struct dsc$descriptor_s devdsc;
- struct dsc$descriptor_s logdsc;
- $DESCRIPTOR(dsc_prctbl,"LNM$PROCESS_TABLE");
- ItemList CrelnmItems[2] = {
- {sizeof(dvibuf), LNM$_STRING, NULL, NULL},
- {0,0,NULL,NULL} };
- ItemList GetdviItems[2] = {
- {sizeof(dvibuf), DVI$_ALLDEVNAM, NULL, NULL},
- {0,0,NULL,NULL} };
-
- CrelnmItems[0].BufferP = dvibuf;
- GetdviItems[0].BufferP = dvibuf;
- GetdviItems[0].RetLenP = &CrelnmItems[0].BufLen;
-
- /* Get canonical device name */
-
- devdsc.dsc$b_dtype = DSC$K_DTYPE_T;
- devdsc.dsc$b_class = DSC$K_CLASS_S;
- devdsc.dsc$a_pointer = devnam;
- devdsc.dsc$w_length = strlen( devdsc.dsc$a_pointer );
-
- sts = sys$getdviw (
- MISC_EVENT_FLAG, /* use for synch */
- 0, /* channel (not used with name) */
- &devdsc, /* device name */
- &GetdviItems, /* item list */
- &iosb[0], /* I/O status block */
- 0,0,0); /* not used in this call */
-
- if (sts & SS$_NORMAL) sts = iosb[0];
- if (!(sts & SS$_NORMAL)) {
- fprintf(stderr,
- "* unable to get device name, VMS status %%x%X *\n", sts);
- }
-
- /* Create user mode logical name */
-
- logdsc.dsc$b_dtype = DSC$K_DTYPE_T;
- logdsc.dsc$b_class = DSC$K_CLASS_S;
- logdsc.dsc$a_pointer = lognam;
- logdsc.dsc$w_length = strlen( logdsc.dsc$a_pointer );
-
- sts = sys$crelnm (0,&dsc_prctbl,&logdsc,0,&CrelnmItems);
-
- if (sts != SS$_NORMAL) {
- if (sts != SS$_SUPERSEDE) {
- printf("* unable to crelnm, VMS status %%x%X *\n", sts);
- }
- }
-}
-
-/***********************************************************************
- * *
- * VMSsystem - replace 'system' call with LIB$SPAWN so that we can *
- * connect stdin/stdout from subprocess *
- * *
- ***********************************************************************/
-void VMSsystem(buf)
- char *buf;
-{
- int sts;
- char outname[256];
-
- struct dsc$descriptor_s cmd_string;
- struct dsc$descriptor_s mbx_name;
-
- cmd_string.dsc$b_dtype = DSC$K_DTYPE_T;
- cmd_string.dsc$b_class = DSC$K_CLASS_S;
- cmd_string.dsc$a_pointer = buf;
- cmd_string.dsc$w_length = strlen( cmd_string.dsc$a_pointer );
-
- /* Get names of STDOUT */
-
- getname(fileno(stdout),outname,1);
-
- mbx_name.dsc$b_dtype = DSC$K_DTYPE_T;
- mbx_name.dsc$b_class = DSC$K_CLASS_S;
- mbx_name.dsc$a_pointer = outname;
- mbx_name.dsc$w_length = strlen( mbx_name.dsc$a_pointer );
-
- /* Spawn process to execute command, using our input and output */
-
- sts = lib$spawn (&cmd_string, NULL, &mbx_name);
-
- if (!(sts & SS$_NORMAL)) {
- printf("* unable to spawn command, VMS status %%x%X *\n", sts);
- }
-
-}
-
-
-#ifndef __DECC
-/*
- * VAXC/RTL does not support wchar --- but they are not used anyway
- */
-size_t mbstowcs(wchar_t *pwcs, const char *s, size_t n)
-{
- printf( " *** Dummy mbstowcs() called !!!\n" );
- return -1;
-}
-#endif
-#endif
diff --git a/src/packlib/kuip/code_windows/Imakefile b/src/packlib/kuip/code_windows/Imakefile
deleted file mode 100644
index 781ba94..0000000
--- a/src/packlib/kuip/code_windows/Imakefile
+++ /dev/null
@@ -1,5 +0,0 @@
-#define IHaveCDF
-
-SRCS_C :=$(SRCS_C) SetWindowsJmp.c
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kuip/code_windows/SetWindowsJmp.c b/src/packlib/kuip/code_windows/SetWindowsJmp.c
deleted file mode 100644
index e10fb1a..0000000
--- a/src/packlib/kuip/code_windows/SetWindowsJmp.c
+++ /dev/null
@@ -1,131 +0,0 @@
-/*
- * $Id: SetWindowsJmp.c,v 1.1 1997/11/28 17:27:03 mclareni Exp $
- *
- * $Log: SetWindowsJmp.c,v $
- * Revision 1.1 1997/11/28 17:27:03 mclareni
- * Numerous mods and some new routines to get Control-C working reasonably on NT
- *
- */
-#include "kuip/kuip.h"
-#include "kuip/ksig.h"
-
-int iFlag = 0;
-sigjmp_buf SIGbuffer;
-
-# define iStackLength 14
-DWORD retaddress[iStackLength];
-DWORD *iSp;
-
-//___________________________________________________
-// Terminate the worker thread by getting it to execute this function
-static void WINAPI SwitchMainThread (void)
-{
- sigsetjmp(&SIGbuffer, 0 );
-}
-
-//___________________________________________________
-static void swap_signal_handler(sigjmp_buf buffer, int val)
-{
- CONTEXT context;
-
- SuspendThread(kc_break.hdThread);
-
- // Get the worker thread's current CPU registers
- context.ContextFlags = CONTEXT_CONTROL;
- GetThreadContext(kc_break.hdThread, &context);
-
- // Change the instruction pointer to our function
- PROGCTR(context) = (DWORD) SwitchMainThread;
- SetThreadContext(kc_break.hdThread,&context);
-
-//*** iFlag = val;
- iFlag = -2;
- // Resuming the thread forces our function to be called
- ResumeThread(kc_break.hdThread);
-}
-
-//______________________________________________________________________________
-BOOL ConsoleSigHandler(DWORD sig)
-{
-
- // WinNT signal handler for Console events (by V.Fine 19.12.96 JINR, Dubna)
-
- switch (sig) {
- case CTRL_BREAK_EVENT:
- ++kc_break.intr_count;
- case CTRL_C_EVENT:
- case CTRL_LOGOFF_EVENT:
- case CTRL_SHUTDOWN_EVENT:
- case CTRL_CLOSE_EVENT:
-// signal_handler( SIGINT );
- if (kc_break.intr_enabled)
- swap_signal_handler(SIGbuffer,sig);
- else
- signal_handler( SIGINT );
- return TRUE;
- default:
- return FALSE;
- }
-}
-
-//___________________________________________________
-void siglongjmp (sigjmp_buf buffer, int val) {
-// int i = sigsetjmp(&SIGbuffer, 0 );
- longjmp(kc_break.stack, val );
-}
-
-//___________________________________________________
-int sigsetjmp(sigjmp_buf *buffer, int saveflag)
-{
-//*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
-//*-* return value:
-//*-* ------------
-//*-* returns 0 after saving the stack environment.
-//*-* If setjmp returns as a result of a longjmp call, it
-//*-* returns the value argument of longjmp, or if the value argument
-//*-* of longjmp is 0, setjmp returns 1. There is no error
-//*-* return.
-//*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
- static sigjmp_buf *lpBuffer = &SIGbuffer;
- static int iret;
- static int save;
- save = saveflag;
-
- if (save == 0) {
-// fpreset();
- fflush(NULL);
- longjmp(kc_break.stack, iFlag );
- }
- // Preserve the return address
- __asm {
- mov iSp, ebp
- }
- memcpy (retaddress, (iSp+1)-iStackLength+1,iStackLength*sizeof(DWORD));
-// memcpy (retaddress, iSp-iStackLength+1,iStackLength*sizeof(DWORD));
-
- kc_break.uRetAddr = retaddress;
-
- iFlag = 0;
- // Polling the current thread handle
- DuplicateHandle(
- GetCurrentProcess(), // handle to process with handle to duplicate
- GetCurrentThread(), // handle to duplicate
- GetCurrentProcess(), // handle to process to duplicate to
- &(kc_break.hdThread), // pointer to duplicate handle
- (void *)0, // access for duplicate handle
- FALSE, // handle inheritance flag
- DUPLICATE_SAME_ACCESS // optional actions
- );
-
- iret = setjmp(kc_break.stack);
-
- // Restore the return address
-
- if (iret) {
-// printf(" longjmp sigsetjmp(sigjmp_buf *buffer, int save = %d) \n", save);
- memcpy ((iSp+1)-iStackLength+1,retaddress,iStackLength*sizeof(DWORD));
-// memcpy (iSp-iStackLength+1,retaddress,iStackLength*sizeof(DWORD));
- }
-
- return iret;
-}
diff --git a/src/packlib/kuip/code_windows/test.c b/src/packlib/kuip/code_windows/test.c
deleted file mode 100644
index 2975dd3..0000000
--- a/src/packlib/kuip/code_windows/test.c
+++ /dev/null
@@ -1,49 +0,0 @@
-/*
- * $Id: test.c,v 1.1 1997/11/28 17:27:06 mclareni Exp $
- *
- * $Log: test.c,v $
- * Revision 1.1 1997/11/28 17:27:06 mclareni
- * Numerous mods and some new routines to get Control-C working reasonably on NT
- *
- */
-#include <windows.h>
-#include <stdio.h>
-#include "CtrlC.h"
-
-// Test program
-
-KUIPJmpBuf mark; /* Address for long jump to jump to */
-
-//______________________________________________________________________________
-void main()
-{
- int jmpret;
- int i=0;
-
- SetConsoleCtrlHandler((PHANDLER_ROUTINE)ConsoleSigHandler,
- TRUE);
- // sigsetjmp(&buffer,1);
- jmpret = sigsetjmp( &mark, 1 );
- if( jmpret == 0 )
- {
- printf( "Test for invalid operation - \n" );
- printf( "enter two numbers: \n" );
- }
- else
- printf(" --> Ctrl-C was caught %d \n", jmpret);
-
- printf(" go ahead %d \n",i);
- i++;
-
- while(1){
-// GenerateConsoleCtrlEvent(CTRL_C_EVENT,0);
- };
-
-}
-
-#if 0
-BOOL GenerateConsoleCtrlEvent(
-CTRL_C_EVENT | CTRL_BREAK_EVENT, // signal to generate
-0 // process group to get signal
-);
-#endif
diff --git a/src/packlib/kuip/doc/Versions/v2_00 b/src/packlib/kuip/doc/Versions/v2_00
deleted file mode 100644
index 1b8a191..0000000
--- a/src/packlib/kuip/doc/Versions/v2_00
+++ /dev/null
@@ -1,321 +0,0 @@
-*
-* $Id: v2_00,v 1.1.1.1 1996/03/08 15:33:03 mclareni Exp $
-*
-* $Log: v2_00,v $
-* Revision 1.1.1.1 1996/03/08 15:33:03 mclareni
-* Kuip
-*
-*
-*CMZ : 2.00/16 15/02/93 17.08.42 by Alfred Nathaniel
-*-- Author : Alfred Nathaniel 04/12/92
-*
-*::> VERSION 2.00/16 930215 17.08
-*
-* The location of the kxterm executable can now be defined as environment
-* variable KXTERM.
-*
-* Access from C to PAWC through a pointer to allow the use of dynamic common
-* blocks on IBM.
-*
-* Corrections for MVS (Harald Butenschoen).
-*
-* Ansi C compiler on Sun provides fixed include files <time.h> and <signal.h>.
-*
-* V/CREATE and V/INPUT allow again vector elements to be used as initializers
-* (reported by L.Pontecorvo)
-*
-* The macro READ statement did not provide the correct default value for
-* already existing variables (reported by Timothy Cox).
-*
-* The number of commands in the history list printed by "!" is now restricted
-* to the value set by SET/RECORDING.
-*
-*::> VERSION 2.00/15 930201 14.27
-*
-* SET/ROOT was looking at menus at the same level as the root menu.
-* SET/ROOT now changes the prompt to the menu name.
-* (Problems reported by Mogens Dam.)
-*
-* KUIP/EDIT creates new files in the first directory in the MACRO/DEFAULTS
-* search list. Before it has always created in the current directory.
-* (Problem reported by Nige Watson.)
-*
-* Another bug fix for string concatenation: "abc//'def'//ghi" gave the
-* wrong result. (Problem reported by Nicole Lhermitte.)
-*
-* KUGETL: blank values in a variable length argument list were ignored.
-*
-* Remove edit server lock file before exiting.
-*
-* Avoid "writable strings" problem with default values.
-*
-*::> VERSION 2.00/14 930128 18.32
-*
-* Alpha/VMS CC with /STAN=VAXC is now compiling without warnings.
-*
-* Second iteration for NeXT implementation.
-*
-* Bug fix in getline(): memory was overwritten when prompt exceeded
-* 80 characters (affected PAWGKS on VMS).
-*
-* After 3 consecutive ^C ask whether he wants to exit from application.
-*
-* Put additional calls to KUALFA in strategic places.
-*
-* "READ var" keeps the initial value of macro variable when pressing <CR>.
-* Problem reported by Tim Cox.
-*
-* For implicit LOOP arguments to commands: comma is only recognized as
-* argument separator if it is outside balanced ().
-*
-* For KUGETL: comma is only recognized as argument separator if it is
-* outside balanced () or ''.
-*
-*::> VERSION 2.00/13 930126 16.50
-*
-* Avoid compiler warnings on Apollo and SGI.
-*
-* Fix for accessing common blocks from C on Cray.
-*
-* Restored old behaviour for KUPROx routines: input value is left unchanged
-* if typing <CR>.
-*
-* Fix for SUN and DECstation: strtod() is declared in <math.h> instead
-* of <stdlib.h>
-*
-* Replace long by int: we assume that int is at least 32 bits.
-*
-* New routine KUGRFL to flush the graphics output after each command.
-* The routine passed should do the same as IGTERM for X11 but be dummy for GKS.
-*
-* KUGETE ignored default value.
-*
-* First iteration for NeXT implementation.
-*
-* KIMULT: '*' was missing from list of characters which inhibit ';' being
-* the line separator --> on VMS "shell del file.type;*" was not working
-* inside a macro.
-*
-*::> VERSION 2.00/12 930122 21.24
-*
-* Removed KUALFA after each command executed.
-*
-* On VM/CMS: replace sleep() emulation by call to SLEEPF (clash with with
-* entry in COMMTXT.TXTLIB).
-*
-* On VAX/VMS: MACRO/DEFAULT -Auto worked only if a search path was set.
-*
-* Undefined numbered variables, e.g. [1] are now replaced by "!".
-*
-* KUGETI and KUGETR now prompt in case the argument is not a valid number.
-*
-* Wrong logic in string concatenation: "abc//def//'ghi'" became "'abc//defghi'"
-* instead of "'abcdefghi'".
-*
-* "TRACE ON TEST" executed action routines.
-*
-*::> VERSION 2.00/11 930121 16.27
-*
-* "V/CREATE name" is now treated as "V/CREATE name(1)".
-*
-* Environment variable KUIPEDITOR takes precedence over EDITOR.
-*
-*::> VERSION 2.00/10 930120 18.43
-*
-* New CDF features are now available as well through Fortran mode of KUIPC.
-*
-* "-option" was only recognized if it was the last argument on the command
-* line.
-*
-* Use G-format instead of F-format to convert result of $SIGMA.
-*
-* Edit server is only used if HOST_EDITOR command contains a '&'.
-* HOST_EDITOR 'vi &' is treated as HOST_EDITOR 'xterm -e vi &'.
-*
-*::> VERSION 2.00/09 930118 16.45
-*
-* Style GP reimplemented.
-*
-* Motif terminal kxterm introduced.
-*
-*::> VERSION 2.00/08 930115 14.06
-*
-* FATMEN's "LS file -L" did not work because the second parameter is an
-* Integer which had implictly the MINUS flag set inhibiting the CHOPT trial.
-* ==> KUIPC changed that the MINUS flag for numeric parameters is not set
-* automatically any more. Instead "-value" on a numeric argument position
-* is checked whether it is a number. Otherwise the CHOPT assignment is tried.
-*
-* The filename "last.kumac" was undefined when exiting with having executed
-* a LAST command (message "Cannot open" when leaving application).
-*
-* In order to allow the new HPLOT escape sequences "@[" an undocumented
-* feature had to be removed: The construct "@[name]" forced variable
-* substitution even inside quoted strings. The same functionality is
-* achieved by using "//" for string concatenation, e.g. "vecname='vec@[n]'"
-* has to be replaced by "vecname='vec'//[n]".
-*
-* Bug fix for VMS file paths inside macros, e.g. "shell dir disk$xx:[user]".
-* Note: VMS file paths may NOT appear in EXEC statements inside a macro,
-* i.e. "EXEC DISK$xx:[user]macnam" does not work inside a macro (it does
-* though when entering it on the command line).
-* Workaround: define a logical name for the directory path and use
-* "EXEC LOG_NAME:macnam" or include the directory in the kumac search
-* path "MACRO/DEFAULT [],DISK$xx:[user]" and use "EXEC macnam".
-*
-*::> VERSION 2.00/07 930113 15.58
-*
-* Typing "Q" after WAIT prompt terminates macro execution.
-*
-* Bug fix in Motif prompt for WAIT command.
-*
-*::> VERSION 2.00/06 930112 18.45
-*
-* In concatenated system functions, e.g. "$machine$os" only the last one
-* was replaced.
-*
-* Macro variables "[%var]" were not replaced.
-*
-* TRACE ON WAIT implemented.
-*
-* All keyboard input requests are now done through Motif widgets.
-*
-* KGETAR did not work for VMS.
-*
-* New special argument value "!!" replaced by value used for previous
-* command execution, i.e. for mandatory parameters it behaves like
-* pressing <CR> at prompt.
-*
-* "-option" syntax was misbehaving if a shorted range value was a substring
-* of a longer range value.
-*
-*::> VERSION 2.00/05 930107 17.38
-*
-* The dollar sign can be used in alias names.
-*
-* LaTeX manual formatting improved.
-*
-* Command LAST excluded the last command.
-*
-* Appending the default ".KUMAC" filetype was not done for VMS path names
-* like "[dir.sub]file".
-*
-* Problems with macro variable substitition if macro file name contains a
-* VMS directory path solved. (Special thanks to Rob Kreuger for reporting
-* the VMS related problems.)
-*
-* MACRO/DEFAULT -Auto/AutoReverse reimplemented. The default path can now
-* be a comma separated list of directories.
-*
-*::> VERSION 2.00/04 921218 17.03
-*
-* Falco terminals lost arrow keys when logging into TAGIBM because the
-* escape sequences changes from "ESC-[-A" to "ESC-O-A".
-*
-* VMS signal handler installed to avoid program aborting for VMS
-* specific exceptions, e.g. invalid filenames.
-*
-* Unix only: KUHOME replaces now again environment variables in
-* filenames, e.g. $HOME/file.type
-*
-* When prompting for missing arguments the last used value is proposed
-* as default.
-*
-*::> VERSION 2.00/03 921214 19.06
-*
-* KUIPAPPL.TMP files are opened for unformatted access to allow RECFM V
-* on VM/CMS.
-*
-* Bug fix for VM/CMS crash in KUPATH: In a CALL SUB('ABC') to a C function
-* SUB(char *ptr, int*len) the pointer ptr my NOT be considered as a local
-* variable. Doing ptr++ will be disastrous in the end.
-*
-*::> VERSION 2.00/02 921211 18.13
-*
-* KUIP system functions were not substituted if used in CASE
-* e.g. CASE $OS IN ... did not work
-*
-* Bug fix for VM/CMS crash when calling help for command with
-* >User-Help twice
-*
-* KUARGS for option -n (no logon kumac) fixed
-*
-* Assignments "name = val" evaluated to "name = @macname[val]".
-* Fixed by removing the obsoleted feature of decoding unbracketed
-* variable names on the right hand side, i.e. "i = i+1" must now
-* be written as "i = [i]+1".
-*
-* KUVAR was passing a string constant to routines which could overwrite it.
-*
-* Name clash with FATMEN for routine fmatch(). Renamed to fwmatch()
-*
-* Command repetition now also recognized if ! is not in first column.
-*
-* Recognize alias names as help item, e.g. "A/CRE LS DIR C; HELP LS"
-*
-* Delete KUIPHELP.TMP file after exiting from HELP in -EDIT style
-*
-*::> VERSION 2.00/01 921209 17.54
-*
-* Delete temp vectors created for non-contiguous subarrays
-*
-* For gcc (Sun) use option -fwritable-strings
-*
-*::> VERSION 2.00/00 921204 21.36
-*
-* A large fraction of KUIP has been rewritten in C. The new version is
-* intended to be (mostly) backwards compatible to the old one but because
-* of the large amount of new code involved we cannot exclude that some
-* incompatibilities remain. We want to urge all users to test their KUMAC
-* files with the PAW version in the new area before it goes into production.
-*
-* At the moment the following features are not yet fully implemented:
-*
-* DEFAULTS -AUTO
-* MANUAL in SGML and plain TeX
-* STYLE GP
-* TRACE WAIT
-* system functions for STYLE GP ($KEYNUM, $KEYVAL)
-*
-*
-* Known incompatibilities:
-*
-* - Alias names may contain only letters, digits, @-signs and underscores.
-* (If someone can make a strong case that this is too restrictive,
-* let us know; we can still consider going back to the old scheme.)
-*
-* - The commands /KUIP/LISTHELP and /KUIP/SET_SHOW/MODE have been removed.
-*
-*
-* Improvements:
-*
-* - There is no limit on the number of aliases anymore.
-* Since KUMAC variables are treated internally as a special kind of
-* alias complex macros could hit the limit of 200 aliases before.
-*
-* - The HELP command recognizes now abbreviations for submenu names.
-* E.g. HELP H/OP works now while before HELP HISTOGRAM/OPERATIONS had
-* to be spelled out.
-*
-* - The HELP command does a simple text formatting. The line length is
-* controlled by /KUIP/SET_SHOW/COLUMNS.
-*
-* - The HELP -EDIT option is now implemented for all systems.
-* A new command /KUIP/SET_SHOW/HOST_PAGER defines the pager used to
-* display the help text. E.g. on a Unix workstation define
-* HOST_PAGER 'xterm -e view &' to display the help text in a
-* separate window.
-*
-* - A new command /KUIP/SET_SHOW/FILECASE allows now to select the case
-* sensitivity for filenames on Unix systems. Before this functionality
-* was hidden as STYLE '-FILECASE ON'.
-*
-* - A new command /KUIP/SET_SHOW/RECALL_STYLE to define the command recall
-* and editing style. There is a choice between ksh/emacs-like binding
-* and the key definitions used by DCL command line editing on VAX/VMS.
-*
-*******************************************************************************
-* - A completely new Motif interface with a browser for application *
-* specific object types and many more features. *
-*******************************************************************************
-*
diff --git a/src/packlib/kuip/doc/Versions/v2_01 b/src/packlib/kuip/doc/Versions/v2_01
deleted file mode 100644
index 00493ba..0000000
--- a/src/packlib/kuip/doc/Versions/v2_01
+++ /dev/null
@@ -1,133 +0,0 @@
-*
-* $Id: v2_01,v 1.1.1.1 1996/03/08 15:33:03 mclareni Exp $
-*
-* $Log: v2_01,v $
-* Revision 1.1.1.1 1996/03/08 15:33:03 mclareni
-* Kuip
-*
-*
-*CMZ : 2.01/07 06/04/93 11.47.34 by Alfred Nathaniel
-*-- Author : Alfred Nathaniel 25/02/93
-*
-*::> VERSION 2.01/07 930406 11.47
-*
-* Fix for KUGETx returning last value for optional parameters without default
-* in case of positional arguments.
-*
-*::> VERSION 2.01/06 930406 9.43
-*
-* "$name" will be replaced by value of environment variable if it is defined
-* and "name" is not a KUIP system function.
-*
-* Allow switching to STYLE G from logon kumac.
-*
-* STYLE G: high-light last choice in menus; if panel is defined display it
-* along with menus (reported by Robert Franchisseur).
-*
-* Increased limit for number of macro arguments from 9 to 99.
-*
-* IBM: disabled trapping of floating point underflows (CALL XUFLOW).
-* Remove call to KUALFA from error handler. This caused recursive Fortran I/O
-* in the GKS version.
-*
-* DECstation c89: make it compile without "-common" option.
-*
-* Fixes for MSDOS version using f2c and gcc (Valery Fine).
-*
-* Set IQUEST(1)=0 before calling action routine to fix problem of VECTOR/READ
-* with good filename being ignored after a VECTOR/READ with an invalid filename
-* (reported by IVERSEN at VSFYS1.FI.UIB.NO)
-*
-* KUGETx returns last value for optional parameters without default value.
-* Interactive Geant relies on this e.g. for the DRAW command.
-*
-* Version 2.01/02 introduced that all floating point numbers were printed with
-* a decimal point. This broke the usage of $SIGMA for index calculations. The
-* old behaviour that e.g. $SIGMA(2*3+1) returns "7" is restored.
-* To solve the problem which originally triggered the change a new system
-* function $RSIGMA is available now. This function has be to used in COMIS
-* calls expecting a REAL argument, e.g.
-* CALL file.f($RSIGMA(sqrt(x(1)))
-* Otherwise the value may be passed as an INTEGER if the SIGMA result turns out
-* to be a whole number.
-*
-* Filecase conversion for EXEC statements inside KUMACS.
-*
-* The invisible vector ? was not correctly treated for subranges (reported by
-* Nicole Lhermitte).
-*
-* A continuation line start in the first column is concatenated as-is, e.g.
-* VEC/READ x,y,_
-* z,t file.dat
-* is equivalent to "VEC/READ x,y,z,t file.dat". Before there was put in at
-* least one blanks between the concatenated lines.
-*
-* getline(): implemented ^J/LF (delete word), ^R (refresh) and ^X for style DCL
-* and do output buffering. Prefer Posix over BSD termio to solve problem with
-* type-ahead on Sun.
-*
-* KUIP/SHELL for Apollo: use pgm_$invoke() instead of system(). Otherwise
-* /com/sh is suspected to overwrite memory because of an unassigned I/O stream
-* (reported by Robert Franchisseur).
-*
-*::> VERSION 2.01/05 930311 12.35
-*
-* Fix problem if too many alias expansions happen during kumac compilation
-* (reported by Hanspeter Beck).
-*
-*::> VERSION 2.01/04 930308 11.31
-*
-* Fix for help menu in browser.
-*
-*::> VERSION 2.01/03 930305 15.12
-*
-* Renamed IGXMES to KMXMES.
-*
-* Motif version: enable help menus again.
-*
-*::> VERSION 2.01/02 930302 18.12
-*
-* Bug fix for $SUBSTRING.
-*
-* VECTOR/INPUT: bug fix for 2-dim vectors
-*
-* VECTOR/PRINT: print proper indizes for 2-dim vectors
-*
-* First iteration for Alpha/OSF.
-*
-* KUIP/EDIT: default .KUMAC extension missing for MVS.
-*
-* Fix recursion if $LAST is used in a command (reported by B. BUROW).
-*
-* Emulate "%G" and "%.<n>d" format which behaves improperly on VAX/VMS.
-*
-*::> VERSION 2.01/01 930226 17.22
-*
-* Small fix in KXTERM.
-*
-*::> VERSION 2.01/00 930225 17.52
-*
-* KXUNIT: protection against very long filenames.
-*
-* A few more corrections for NeXT.
-*
-* KUIPC: allow call with input file name only.
-*
-* Ignore quotes around string in $SUBSTRING expression.
-*
-* Allow compilation with non-ANSI compiler.
-*
-* Non-folkloristic functions strdup(), strcasecmp(), etc. are only redefined
-* if they do not exist in the C-library.
-*
-* New routine KUGETQ to protect arguments with multiple tokens by quotes.
-* To be used by MACRO/EXEC that "EXEC macro 'Hello World'" is passed as
-* one argument.
-*
-* More MVS/NEWLIB corrections.
-*
-* LAST command changed: the new default N=-99 behaves like the old
-* default N=-1. Values -99<N<0 print out the last -N commands.
-* This scheme originally invented for MVS support is also useful to
-* allow cut-and-paste of blocks of commands on workstation screens.
-*
diff --git a/src/packlib/kuip/doc/Versions/v2_02 b/src/packlib/kuip/doc/Versions/v2_02
deleted file mode 100644
index 90fb25f..0000000
--- a/src/packlib/kuip/doc/Versions/v2_02
+++ /dev/null
@@ -1,88 +0,0 @@
-*
-* $Id: v2_02,v 1.1.1.1 1996/03/08 15:33:03 mclareni Exp $
-*
-* $Log: v2_02,v $
-* Revision 1.1.1.1 1996/03/08 15:33:03 mclareni
-* Kuip
-*
-*
-*CMZ : 2.02/09 07/06/93 15.43.12 by Alfred Nathaniel
-*-- Author : Alfred Nathaniel 29/04/93
-*
-*::> VERSION 2.02/09 930607 15.43
-*
-* KMDIAL: fix for Piaf password prompt in Motif.
-*
-*::> VERSION 2.02/08 930604 13.55
-*
-* Deck KUPIAF removed. Piaf syncronization moved into PAW.
-*
-*::> VERSION 2.02/07 930527 13.11
-*
-* Linux version introduced.
-*
-* Restructuring of getline(): previous terminal interface recognition failed
-* for NeXT.
-*
-* Motif window for menu guidance text.
-*
-*::> VERSION 2.02/06 930526 15.19
-*
-* On Apollo the complete C part can and should be compiled under BSD now.
-*
-* SHELL command: fixed problem with VMS batch and Apollo /bin/sh.
-*
-*::> VERSION 2.02/05 930525 18.24
-*
-* New routine KUPROP(CHPRMT,CHVAL,NCH) to prompt for a password.
-*
-* STYLE GP: panel lines can be redefined with fewer numbers of fields.
-*
-* Piaf synchronization for VMS/Multinet implemented.
-*
-*::> VERSION 2.02/04 930511 15.22
-*
-* Bug fix in ICONBOX.
-*
-*::> VERSION 2.02/03 930511 15.10
-*
-* The routine registered by KUCOMV is now called without arguments. The called
-* routine has to CALL KUVNAM(VNAME) to retrieve the vector name which was
-* deleted.
-*
-*::> VERSION 2.02/02 930507 10.30
-*
-* KUCOMV routine was only called for '*' (delete all vectors).
-*
-*::> VERSION 2.02/01 930504 11.49
-*
-* New routine KUCOMV(SUB) to register a subroutine SUB(CHNAME) which is called
-* whenever a vector is deleted. This is mainly needed for COMIS which keeps a
-* table of defined vectors.
-*
-* New system function $FORMAT(number,format) to format a number according to a
-* Fortran-like FORMAT string, e.g. $FORMAT([x],F9.3). Supports F,E,G,I, and
-* Z (hexadecimal).
-*
-*::> VERSION 2.02/00 930429 17.48
-*
-* KIDTAB: replace TABs by an equivalent number of blanks (assuming tab
-* positions are every 8th column). Before TABS were replaced by a single
-* blank only.
-*
-* STYLE G could not be used in PAWLOGON.
-*
-* Add minus sign to list of valid characters for building alias names
-* (request by Per Scharff-Hansen).
-*
-* KUGETE did not work when prompting for missing mandatory argument
-* (reported by Steve Fisher).
-*
-* KIMINT: label calculation caused integer overflow when using more than
-* 26 IF-ENDIF constructs (fatal on VMS). Changing from MAXIFS=200,MAXIFN=20
-* to MAXIFS=120,MAXIFN=10 should push the limit beyond 100. Hopefully
-* nobody uses more then 10 levels of nested IFs.
-*
-* KUARGS: mismatch between code and manual. Option BATCH should NOT imply
-* NOLOG, i.e. LOGON.KUMAC should still be executed.
-*
diff --git a/src/packlib/kuip/doc/Versions/v2_03 b/src/packlib/kuip/doc/Versions/v2_03
deleted file mode 100644
index e55b1cd..0000000
--- a/src/packlib/kuip/doc/Versions/v2_03
+++ /dev/null
@@ -1,235 +0,0 @@
-*
-* $Id: v2_03,v 1.1.1.1 1996/03/08 15:33:03 mclareni Exp $
-*
-* $Log: v2_03,v $
-* Revision 1.1.1.1 1996/03/08 15:33:03 mclareni
-* Kuip
-*
-*
-*CMZ : 2.03/15 01/10/93 16.26.50 by Alfred Nathaniel
-*-- Author : Alfred Nathaniel 05/07/93
-*
-*::> VERSION 2.03/15 01/10/93 16.26.50
-*
-* Motif: provide dummy mbstowcs() for VAX/VMS.
-*
-* KXTERM: fix communication problem if output stream contains # character.
-*
-*::> VERSION 2.03/14 29/09/93 15.50.24
-*
-* KXTERM: add display of current local directory.
-* Line buffering between application process and kxterm
-* because mailboxes use record I/O.
-*
-* MANUAL command: recursive descent to all submenus.
-*
-* EXEC command in Motif mode: allow to pass more than one macro argument.
-*
-* KIMATH: fix problem for "vec(1)<vec(2)".
-* Round to 6 significat digits before testing equality/non-eq. of expressions.
-*
-* Unix and VMS: use unique names for all tempfiles.
-*
-* KUVAR: don't do alias translations etc.
-*
-*::> VERSION 2.03/13 16/09/93 17.21.03
-*
-* KUIPC: fix for long names as >Action routines
-*
-* KUEDIT: test return code from system() == -1 rather than < 0
-*
-*::> VERSION 2.03/12 13/09/93 09.34.59
-*
-* KIMINT: don't interpret [] inside application text as variable names.
-*
-* KIMATH: Change in treatment of vector names to allow:
-* a = '?'
-* IF [a]='?' THEN
-*
-*::> VERSION 2.03/11 06/09/93 08.50.52
-*
-* $var now looks for environment variable on VMS as well. Uppercase names are
-* searched first in the logical names tables and then in the symbol table.
-* Lowercase names are searched for only in the symbol table. Replacement is
-* suppressed if $var is followed by a colon to avoid DISK$USER: etc.
-*
-* New command SET/LCDIR to change current working directory (only for Unix
-* and VMS).
-*
-* Asynchronous editing for VMS implemented (not yet fully tested).
-* HOST_EDITOR must be TPU/DISPLAY=MOTIF.
-*
-* $VEXIST did not work if the vector has existing. $QUOTE did not work
-* correctly (reported by by Tim Adye).
-*
-*::> VERSION 2.03/10 03/09/93 11.13.54
-*
-* Second iteration of KUIP/Motif for VMS.
-*
-*::> VERSION 2.03/09 02/09/93 11.53.22
-*
-* Bug fix for $VLEN function.
-*
-* First iteration of kxterm for VMS (C.W. Hobbs/DEC).
-*
-*::> VERSION 2.03/08 01/09/93 09.45.31
-*
-* Allow digits as first character in an alias name.
-*
-*::> VERSION 2.03/07 31/08/93 18.14.00
-*
-* New routine KUFDEF to define application specific system functions.
-*
-* Buffer flushing for RS/6000 to keep correct sequence of C and Fortran output
-* if stdout is redirected into a file. This requires compiler version xlf 2.3.
-*
-* First iteration of Windows/NT port (Valeri Fine).
-*
-*
-*::> VERSION 2.03/06 25/08/93 13.09.50
-*
-* Problems with +KEEP with PATCHY vs. CMZ installation.
-*
-* $OS and $MACHINE were not described in HELP FUNCTIONS
-*
-*::> VERSION 2.03/05 24/08/93 17.23.28
-*
-*
-* KUIPC: part of the menu tree was forgotten in C output mode (reported by
-* Robert Franchisseur).
-*
-* getline: mysterious hangups of Falco terminals connected to through a
-* DECserver line to Ultrix (reported by Rob Kreuger).
-* Went from POSIX terminal driver back to BSD driver for Ultrix.
-* BSD driver (also used for Apollo and NeXT) now catches typeahead.
-*
-* KIMINT: bug in the handling of nested IFs:
-* IF 1=1 THEN
-* IF 1=1 THEN
-* IF 1=0 THEN
-* mess Not reached
-* ELSE
-* mess first
-* ENDIF
-* ENDIF
-* mess Okay
-* IF 1=1 THEN
-* IF 1=1 THEN
-* mess second
-* ENDIF
-* ENDIF
-* ENDIF
-* did not execute any of the commands! (Reported by Nige Watson.)
-*
-* KIMATH: Vector indizes can now contain expressions, e.g. VEC([n]+1)
-*
-* KUGETI/KUGETR: Arguments can be expressions which are evaluated.
-*
-* System functions can now be nested and the arguments can be expressions,
-* e.g. "$lower($substring($OS$MACHINE,[k]+1,2*[n]))"
-*
-* New system functions: $INDEX(str1,str2), $WORDS(string,[sep]),
-* $WORD(string,[k,[n,[sep]]]), $QUOTE(string), $UNQUOTE(string),
-* $INLINE(string).
-*
-* ALIAS/CREATE: value is alias expanded; new option "-N" to inhibit expansion.
-*
-* ALIAS/LIST: print alias names sorted alphabetically.
-*
-* KIMINT: case labels were not properly recognized if the command following
-* on the same line contained parenthethes. (Reported by Mike Kelsey).
-*
-* KIMCAL: FOR statement crashed if the loop index had a name
-* longer than 4 characters. (Reported by Mike Kelsey).
-*
-* KIMCAL: SHIFT left a quote character at the end of [*]. (Reported by
-* Mike Kelsey).
-*
-* The modifications for ;& and ;! introduced a bug: single commands always
-* returned status code 0. As a result HELP went into the editor even if
-* the command name was invalid. (Reported by David Wagner).
-*
-* Final fix for old-style behaviour for optional parameters without defaults
-* (mainly used by GEANT drawing commands). (Thanks to Shaheen Tonse and
-* Dean Chacon for pointing it out the actual problem.)
-*
-* KUVCRE actually imposed an upper limit of 10 characters for vector names.
-* STYLE G did not write commands to LAST.KUMAC.
-* TRACE ON WAIT did not allow to skip a command.
-*
-*
-*::> VERSION 2.03/04 05/08/93 12.29.35
-*
-*
-* new command "NEWPANEL" (defined in KUIPCDF) for building a new and
-* empty panel to be filled interactively at run time.
-* add possibility to raise (popup) the kxterm window.
-* add a "LIST" button to all options parameters which gives access to a
-* full explanation of the options.
-* add "Exit" in the browser window (menu "File").
-* update "helps" in KUIPMCDF.
-*
-*::> VERSION 2.03/03 12/07/93 10.17.35
-*
-* Yacc grammar did not treat the cases of more than one string concatenation
-* per expression and the comparison of a numeric value to a string.
-*
-*::> VERSION 2.03/02 07/07/93 18.35.24
-*
-* Fix for KUIPC and YKUIP.
-*
-*::> VERSION 2.03/01 06/07/93 10.02.10
-*
-* Fix for Alpha/OSF.
-*
-*::> VERSION 2.03/00 05/07/93 17.35.42
-*
-* KIMATH: the evaluation of
-* a = -2.34
-* b = 40
-* c = [a] - [b]
-* resulted in c = -0.234E-39. (Reported by Walter Brueckner).
-* Expression evaluation is now done by a Yacc-generated parser which allows
-* arbitrarily complex expressions like
-* c = [a]*[x] + [b]
-* The IF statement can now also contain a combination of logical expressions
-* like
-* if [a]<[b] .and. [c]>[d] then
-* ...
-* endif
-*
-*
-* STYLE G: clicking on the black box to select another option value could
-* hand up the system in case one of the option values was the blank string.
-* (Reported by Robert Franchisseur).
-*
-*
-* KUIPC produced garbage Fortran code if the guidance text contained lots of
-* significant blanks. (Reported by Lawrence Williams).
-*
-* KUIPC in Fortran output mode did not handle correctly >Menu directives going
-* upwards more than one level. (Reported by Steve Fisher).
-*
-*
-* KUOPEN: added CALL DMCSCL... to avoid locking of VM-SFS files.
-* (Request by Wojciech Wojcik).
-*
-* SHELL for Apollo: memory was overwritten when the shell command exceeded
-* 128 characters. Also /bin/ksh was started as a restricted shell.
-* (Reported by Nige Watson).
-*
-* GETLINE: add support for DEC function keys F12/F13/F14.
-* (Request by Jim Conboy).
-*
-* A command list separated by semicolon was not quite equivalent to the same
-* commands on consecutive lines: In
-* CMD1 ; CMD2
-* the second command was not executed if the first one returned a non-zero
-* status code. CMD2 is now executed even if CMD1 fails. The construct
-* CMD1 ;& CMD2
-* allows to execute CMD2 only if CMD1 succeeds while
-* CMD1 ;! CMD2
-* executes CMD2 only if CMD1 fails. (Request by Burkhard Burow).
-*
-*
-* Motif part: fixed some cases of NULL pointer dereferencing.
diff --git a/src/packlib/kuip/doc/Versions/v2_04 b/src/packlib/kuip/doc/Versions/v2_04
deleted file mode 100644
index 88177a9..0000000
--- a/src/packlib/kuip/doc/Versions/v2_04
+++ /dev/null
@@ -1,157 +0,0 @@
-*
-* $Id: v2_04,v 1.1.1.1 1996/03/08 15:33:03 mclareni Exp $
-*
-* $Log: v2_04,v $
-* Revision 1.1.1.1 1996/03/08 15:33:03 mclareni
-* Kuip
-*
-*
-*CMZ : 2.04/10 09/03/94 15.50.59 by Alfred Nathaniel
-*-- Author : Alfred Nathaniel 27/10/93
-*
-*::> VERSION 2.04/10 09/03/94 15.50.59
-*
-* More corrections for Convex version.
-*
-* SHELL: do not convert shell command to uppercase on VM --- NQS++ uses
-* lowercase options (reported by Dave Edsall).
-*
-* New interface class String=$fun(Number,String) for application defined
-* functions.
-*
-* KUIPC: protect against TABs in CDF input (reported by Walter F.J. Mueller).
-*
-* Change' Set/LCDIR [path]' to ' -Set/LCDIR [path]' in KUIPMCDF
-*
-*::> VERSION 2.04/09 01/03/94 11.27.08
-*
-* Changes in command PANELS (to correct a problem reported in HISTO/FIT)
-*
-* Introduction of teh command "panel 0 c title" ("panel close")
-* to close a panel with name title in a KUIP macro.
-* This was previously only possible with the mouse.
-*
-* Changes for CONVEX in $HKUIP_H, HKUIP and KEXEC
-*
-* Bug fix in KMENU when HELP without parameters
-*
-*::> VERSION 2.04/08 16/02/94 14.16.39
-*
-* Batch mode did not work on VAX/VMS due to wrong VAXC$CRTL_INIT() placement
-* (reported by John Marrafino).
-*
-* "cmd $fun([var])" did not work if [var] contained an operator like ".and."
-* (reported by Mats Cronqvist).
-*
-* CALL KUCMD('..',' ','SW') crashed when creating a menu without any commands
-* (reported by Vincenzo Innocente).
-*
-* Allow comma-separated list of names for ALIAS/DELETE and VECTOR/DELETE
-* (reported by Mike Kelsey).
-*
-* Corrections for Windows/NT port by Valeri Fine.
-*
-*::> VERSION 2.04/07 25/01/94 16.02.27
-*
-* KUFDEF: allow for functions without arguments given as "$name()".
-*
-*::> VERSION 2.04/06 25/01/94 13.33.49
-*
-* $FORMAT: fix for format descriptors like I9.5 which did not put leading
-* zeroes on VAX/VMS.
-*
-* Use Fortran READ for command input when stdin is not a terminal.
-* (RS/6000, DECstation, and Alpha-OSF/1 Fortran I/O does not use C-stream
-* functions.)
-*
-* KUCMD: missing check if a menu name already existed.
-*
-* KMFILE: remove version number from VMS file specs in browser.
-*
-* GETLINE: make it less noisy be removing some beeps.
-*
-*::> VERSION 2.04/05 22/12/93 09.43.07
-*
-* add ressource "centerCommand".
-* add command /MOTIF/ICON (panel with icons)
-* implement panel with icons.
-* suppress "Double Click" in list of browsables (browser).
-* new KUIPCC to suppress a bug for option parameter with integer values.
-*
-*::> VERSION 2.04/04 14/12/93 15.03.03
-*
-* KXTERM: corrections for transcript saving in VMS.
-*
-* HOST_PRINTER and KUIP/PRINT: new commands to send a file to the printer;
-* Print is now included in the action menus of the file system browser.
-*
-* MACRO/DATA: new command to be used as "APPL DATA file.name" to write text
-* from immediate data in a macro.
-*
-* New system function $IQUEST(I) returning the status vector element.
-* "IF $IQUEST(1)=0 THEN ..." allows to test the success of the last command.
-*
-* KUESVR: create lock file in /tmp if /usr/tmp fails, e.g. because directory
-* is NFS mounted and locking not supported (reported by Dave Edsall).
-*
-*::> VERSION 2.04/03 29/11/93 17.02.31
-*
-* Bug fix in the command pull-down menus of the main browser.
-*
-* Slight changes in the CDF.
-*
-*::> VERSION 2.04/02 23/11/93 16.47.06
-*
-* KXTERM: delay flow control to allow FFREAD from stdin.
-*
-* KUGETF: allow KUGETL mechanism to get a list of filenames.
-*
-* Command COLUMNS: add protection in case environment variable "COLUMNS" does
-* not contain a number (reported by Maurizio Loreti).
-*
-* getline: ^Z-suspend did not work if the program was called from a shell
-* script (reported by Maarten Ballintijn).
-*
-* $SUBSTRING(s,k,n) returned one character too much if k+n happened to be the
-* length of the string.
-*
-*::> VERSION 2.04/01 27/10/93 15.02.14
-*
-* KUIPC produced wrong Fortran code for a 64-character string on continuation
-* lines (reported by David Wagner).
-*
-* KUIPC: compiler-indepenent treatment of backslash in character strings.
-*
-*::> VERSION 2.04/00 27/10/93 10.29.10
-*
-* Use HOST_EDITOR setting in VMS Motif version.
-*
-* Break interception for Motif version on VMS.
-*
-* "cmd;" resulted in "unknown command cmd;" rather than executing the
-* command "cmd".
-*
-* last.kumac could not be written if application started in a directory with
-* a mixed-case name.
-*
-* Treat alias content in expressions as number if possible.
-*
-* Preserve trailing blanks in variable initialization in MACRO header.
-*
-* Preserve trailing blanks in macro variable assignment
-*
-* KUHOME: do not apply filecase conversion to allow uppercase directory names.
-*
-* Browser: corrections for editing for path window.
-*
-* KUOPEN: new status code 'DONTKNOW' which opens the highest cycle on VMS
-* ('UNKNOWN' creates a new cycle); on other systems equivalent to 'UNKNOWN'
-*
-* Disable Control-C for Motif version on VMS.
-*
-* Set Motif host editor to /DISPLAY=DECW.
-*
-* Mods for CONVEX version by Victor Balashov (Dubna).
-*
-* KIMATH: fix to recognize numbers .LT.1 without leading zero.
-*
diff --git a/src/packlib/kuip/doc/Versions/v2_05 b/src/packlib/kuip/doc/Versions/v2_05
deleted file mode 100644
index 75a2160..0000000
--- a/src/packlib/kuip/doc/Versions/v2_05
+++ /dev/null
@@ -1,396 +0,0 @@
-*
-* $Id: v2_05,v 1.1.1.1 1996/03/08 15:33:03 mclareni Exp $
-*
-* $Log: v2_05,v $
-* Revision 1.1.1.1 1996/03/08 15:33:03 mclareni
-* Kuip
-*
-*
-*CMZ : 2.05/22 09/11/94 12.26.44 by Gunter Folger
-*-- Author : Alfred Nathaniel 25/03/94
-*
-*::> VERSION 2.05/22 09/11/94 12.26.44
-*
-* Undo correction to fexpand, and move the fix into KMACRO; ie. KMACRO checks
-* if the macro name starts with a -, and then strips this - off, and ignores
-* the search path.
-*
-*::> VERSION 2.05/21 19/10/94 15.41.52
-*
-* Correct fexpand; it now also checks if the ftype needs to appended if the
-* filename starts with -.
-*
-*::> VERSION 2.05/20 17/10/94 12.19.43
-*
-* Take corrections from Fons for problem in kxterm ( after a command
-* the cursor went to column1 )
-* routines affected: /cmotif/kuwham,kmiout /kxterm/kxterm
-*
-*::> VERSION 2.05/19 11/10/94 17.25.32
-*
-* Fix kmacro to compile ok after correcting missing endcase/endif/.. in a macro
-*::> VERSION 2.05/18 07/10/94 10.33.38
-*
-* Correct mkdcmp (Nicole)
-* Fix reading from file on AIX, OSF, and Ultrix.
-
-*
-*::> VERSION 2.05/17 19/09/94 14.21.30
-*
-* getline() on VMS didn't realize when the terminal connection was dropped.
-*
-* $UNQUOTE did not work as intended.
-*
-* Fixed problems with edit server on VMS.
-*
-* Bug correction in multi_panel: panel 0 d title ' '.
-* Give possibility to open a panel "closed" (PalB) inside a palette:
-* panel 0 d title c
-* or
-* panel 0 d title c:200x200+0+0 (e.g. when specifying the button size)
-* Add "File" entries: "Close" and "Exit" in palettes.
-* --> MKMPAN, $MKUXPL, KUXPAB, KUXPAL.
-*
-* Add cursors km_help_cursor, km_busy_cursor, km_blck_cursor, km_selc_cursor
-*
-* Possibility to set "echo off" even with no kxterm (Ged)
-* (--> Kuwham, init_motif in KUWHAM).
-*
-* Multi_panels (Motif) : implement possibility to specify the panel size
-* with "panel 0 d name geometry" (or km_panel_display(name,geometry)
-* geometry = wxh+0+0 (position is ignored)
-* (km_panel_add --> $MKUTFM, KUWHAT, MKMPAN)
-*
-*::> VERSION 2.05/16 17/08/94 13.54.40
-*
-* Solve compilation problem on Apollo (true and false are cpp defines).
-*
-*::> VERSION 2.05/15 15/08/94 11.18.39
-*
-* Panels (Motif) : implement possibility to give an option
-* "panel x.y command [label] [pixmap] [opts]"
-* implement option "T" for "Toggle" behavior (button stays pressed
-* until another button is selected).
-* --> C user callable routine: km_panel_key_opt(
-* int row,int col,char *command,char *alias_label,char *pixmap,char *opt);
-* ($MKUTFM, $KFLAG_H, $KMPANEL, KUWHAT, MKDPAN)
-*
-* Bug correction for panels with icons (KICON)
-*
-* Allow APPLICATION terminator to be indented.
-*
-* In MACRO header allow default values as "[1]=0" in addition to "1=0".
-*
-* New INTEGER FUNCTION KUQKEY() returning 1 if user has hit the return key
-* or 0 otherwise.
-*
-* Provide KUCLOS entry point for KICLOS to make naming more consistent.
-*
-*::> VERSION 2.05/14 28/07/94 12.17.25
-*
-* SHELL: on VMS write command line into DCL file because LIB$SPAWN
-* does not do symbol substitution like in "LINK main,'LIB$'".
-*
-* Fortran callable entry for browser initialization (km_browser_set) :
-* KMBRSET(BRNAME, PATH)
-*
-* Browser initialization :
-* - user routine km_browser_set (char *br_name, char *path) (KMBROW)
-* --> to give initial values for opening the browser
-* - KUIP command "BROWSER br_name path" (execution at run time) (KUIPMCDF)
-*
-*::> VERSION 2.05/13 21/07/94 12.56.33
-*
-* Improve option list in command panels (MKDCMP)
-*
-* Reinstate strdup() for Ultrix.
-*
-*::> VERSION 2.05/12 15/07/94 16.19.42
-*
-* Fix in KUIPC.
-*
-*::> VERSION 2.05/11 15/07/94 14.59.04
-*
-* Correct bug when resizing the graphics windoe (MKDGRA)
-*
-*::> VERSION 2.05/10 15/07/94 09.46.11
-*
-* Fix in KUIPC.
-*
-*::> VERSION 2.05/09 14/07/94 15.10.11
-*
-* General cleanup of archaic stuff. From now on non-ANSI C compilers
-* are not supported anymore.
-*
-* Preparations for a "kuip.h" header file.
-*
-* Fix problem with same button label in different panels, for example,
-* "blue" button in two panels p1 and p2. One has to give a name to
-* the panel at the very beginning, e.g.
-* panel 0 r p1
-* panel 3.04 'blue/panel1' 'blue'
-* etc...
-* and panel 0 r p2
-* panel 3.04 'blue/panel2' 'blue'
-* etc...
-*
-* New resource "noKxterm" for suppressing kxterm creation and display.
-* Same can be achived by e.g. CALL KUINIM('Ged(-nokxterm)').
-*
-* New command "Browser browsable_name" to open a browsable (without having
-* to click with the mouse). Provided also as user callable routine:
-* km_set_browser(browsable_name).
-* E.g. "Browse Commands" opens the browsable class "Commands" defined
-* in the CDF. (N.B. the browsable_name is case sensitive).
-*
-* Restructuring of MKDGRA.
-*
-* Correction for char '~' (to be recognized as the home directory
-* in browser (decks KMBFIL, KMBMAC).
-* Correction for expanding correctly the Path with / when ~ is the first
-* character (deck KMBROW).
-* Correction for correctly execute "delete file" menu item in the
-* browser (cmmand 'KUIP/SHELL rm filename', deck MKDCMP)
-*
-* Implement parameter type KmTYPE_FILE for Motif (FileSelectionBox)
-* Add resources for cursor fonts: XmNmainCursor, XmNgraphCursor,
-* XmNinputCursor, XmNwaitCursor.
-* change disp_prompt_C from km_prompt to km_prompt_answer where the CANCEL
-* button (which was not meaningful) is suppressed.
-*
-* EXEC: on VM search all disks for .kumac files.
-*
-* KUSPY('OFF') now goes back to the argument position marked by KUSPY('ON')
-* instead of simply rewinding to the very first argument.
-*
-* KUGETH deleted. It was unsafe and could overwrite storage.
-* Hopefully nobody uses it.
-*
-* KUGETQ deleted.
-*
-*::> VERSION 2.05/08 27/06/94 15.07.11
-*
-* Fixed problem with blanks in CASE label list.
-*
-* Fixed compilation problem for VMS6.1 DECC.
-*
-*::> VERSION 2.05/07 16/06/94 14.39.41
-*
-* Added $SHELL(cmd,sep).
-*
-* New system function $EXEC.
-*
-*::> VERSION 2.05/06 06/06/94 12.40.01
-*
-* $SHELL(cmd) and $SHELL(cmd,' ') now return the complete output with
-* newlines replaced by blanks.
-*
-*::> VERSION 2.05/05 06/06/94 11.55.32
-*
-* MACRO/DEFAULTS -auto did not work because of case mismatch.
-* MACRO/DEFAULTS ~/dir did not work on some systems because default shell
-* does not understand ~ (reported by Maarten Litmaath).
-*
-* Macros: use checksum instead of file modification date to test if
-* .kumac file has changed. File system stamp have a granularity of
-* one second which could lead to problems.
-*
-* New system function $SHELL(cmd) and $SHELL(cmd,n) to return first or
-* n'th line of command output (for Unix only).
-*
-*::> VERSION 2.05/04 30/05/94 17.17.10
-*
-* Macros: variable indirection did not work.
-*
-* VAXC: go back to (much slower) standard malloc() routines.
-* The VAXC$MALLOC_OPT routines have a serious flaw:
-* for( n = 1; n < 100000; n++ ) buf = realloc( buf, n );
-* will exhaust the virtual address space?!?
-*
-* READ statement: show default value also if prompt is user supplied.
-*
-*
-*::> VERSION 2.05/03 26/05/94 09.41.07
-*
-* Fix for STOPM statement and ";&" logic in macros.
-*
-*
-*::> VERSION 2.05/02 24/05/94 16.31.33
-*
-* Rewrite of the KUMAC interpreter in C. The main difference is that
-* EXEC inside a macro is treated like any other command. This solves
-* a number of outstanding problems:
-*
-* -- "EXE", "M/EXEC", or any other abbreviation of the command path
-* "/MACRO/EXEC" is now allowed. Before this would lead to undefined
-* behaviour due to a recursive Fortran call.
-*
-* -- Defining an alias for an EXEC call or changing the MACRO/DEFAULT
-* path during macro execution has now the expected effect. Before
-* aliases and .kumac search where done at macro compilation time
-* rather than execution time.
-*
-* -- It is now possible to execute a macro containing EXEC calls to
-* non-existing .kumac files --- provided, of course, that the EXEC
-* is never reached, e.g. in a "CASE $OS IN ..." construct.
-*
-* -- It is now possible to create or to modify a .kumac file during
-* macro execution and call the macros in the new file.
-*
-* -- Mixed-case path names of .kumac files are possible now.
-*
-* The response time should be better than in the previous version:
-*
-* -- The new compiler needs only one pass rather than two passes over
-* the .kumac file.
-*
-* -- A macro calling other macros will compiler the other .kumac files
-* when needed rather than compiling everything up-front.
-*
-* -- Macros are cached --- if a .kumac file has been envoked already
-* beforehand and it hasn't been changed then it is not recompiled
-* when it is used again.
-*
-* In addition the following bugs are fixed in the new version:
-*
-* -- ON ERROR GOTO works now also for nested EXEC calls.
-*
-* -- Undefined numbered variables are now set to ' ' as documented.
-*
-* -- Depending on the length of the .kumac file name the use of several
-* variables in an expression could lead to truncation due to the
-* fixed length of a Fortran character string.
-*
-* The new version provides the following new features:
-*
-* -- The READ statement allows to specify the prompt string.
-*
-* -- The NEXTL statement allows to continue with the next loop iteration,
-* similar to the "continue" statement in C.
-*
-* -- BREAKL and NEXTL allow to specify how many levels of nested loops
-* should be skipped.
-*
-* -- The STOPM statement allows to stop macro execution, i.e. unwind
-* nested EXEC calls and return to the command line prompt immediately.
-*
-* -- The RETURN statement allows to specify the return value.
-*
-* -- The variable "[0]" contains the fully qualified macro name, i.e.
-* "/path/file.kumac#macro".
-*
-* -- ON ERROR handling allows now the following choices:
-* ON ERROR CONTINUE
-* ON ERROR GOTO label
-* ON ERROR EXITM value
-* ON ERROR STOPM
-*
-* -- The spelling "OFF ERROR" instead of "OF ERROR" is now allowed.
-*
-* -- Block constructs can now be written on a single line using ";"
-* as line separator, e.g. "cmd1 ; IF ... THEN ; cmd2 ; ENDIF".
-*
-* -- The macro constructs are now documented in the on-line help ---
-* try "HELP SYNTAX". Thanks to Mike Kelsey for editing the text.
-*
-* -- "!" as macro argument will now use the default value given in
-* the MACRO definition.
-*
-* The new version contains the following known incompatibilities:
-*
-* -- The command /MACRO/RECURSION has been deleted --- all macros are
-* recursive now.
-*
-* -- ":=" as alternative to the assignment operator "=" is not supported
-* anymore. NB: "LET var = expr" is still allowed.
-*
-* Special thanks to Robert Franchisseur, Mike Kelsey, and Andrea Parri
-* for beta-testing the new macro interpreter.
-*
-* --------------------------------------------------------------------
-*
-* Correction for char '~' (to be recognized as the home directory
-* in browser (decks KMBFIL, KMBMAC).
-*
-* Correction for expanding correctly the Path with / when ~ is the first
-* character (deck KMBROW).
-*
-* Correction for correctly execute "delete file" menu item in the
-* browser (KUIP/SHELL rm filename, deck MKDCMP)
-*
-* getline(): ^Z did not work on SunOS and other BSD based systems because
-* there getpgrp() needs pid as argument (in contrast to SysV and Posix)
-* (reported by Maarten Ballintijn).
-*
-* SHELL command: on Unix interpret command line by HOST_SHELL shell.
-* Before the command was passed to whatever shell was spawned by system().
-*
-* KUCMD would still create menus with identical names (reported by Sunanda
-* Banerjee).
-*
-* New system functions $FEXIST(filename).
-*
-* New command SET/DOLLAR to enable/disable the substitution of "$var" as
-* environment variables.
-*
-* New system function $ENV(var) to get environment variable independent of
-* DOLLAR setting.
-*
-*
-*::> VERSION 2.05/01 07/04/94 08.56.31
-*
-- Correction for compilation on VM
-- Bug correction in the browser on Sun (popup menus)
-- Give access to specific resources in the browser
- (e.g. fileScWindow.bottomOffset, etc...) for adjusting the browser
- "inside geometry" when using very big fonts (for the Geant demo
- at CHEP ...)
-*::> VERSION 2.05/00 25/03/94 16.34.38
-*
-- Complete redesign of the "Panel" interface :
- * menu-bar with "File", "View" and "Help" (instead of buttons "Save",
- "Close" and "Help" at the bottom).
- * possibility to have key with labels (aliases), commands or pixmaps.
- The general command for key definition is:
- "panel x.y command [label] [pixmap]"
- * In "View" menu, possibility to view:
- -> By Name
- -> By Icon
- -> By Name and Icon (not yet implemented).
- -> By Command (normal)
- -> By Command (1 col.)
- * Implement "context help" on all panel buttons (user defined).
- * Command "Panel 0 c" to close a panel in command mode.
-
-- Implement "Palette" interface silmilar to UIMX (command /MOTIF/MULTI_PANEL).
-
-- Provide a C callable interface for panels & palettes definition and display
-instead of using the macro language (Jamie's request for Ged).
-
-- Implement the possibility (user callable entries in C) to display a list and
-return one selection in a user-defined command (action routine) - User
-request -.
-
-- new routine "interactive_help_motif" to display a Motif selection box
-with all possible choices when typing "HELP" without any argument.
-
-- add fallback for "fileScWindow.width" (default 80) for changing ratio
-in the browser between the dir - and file - lists of objects (requested by
-Sven for Geant demo with big fonts).
-
-- Implement the possibility to have an "All Cycles" view option in the
-browser on VMS (at the moment it is commented). Change "XmNradioBehavior"
-to FALSE (to make combination of several view options possible).
-
-- Implement the possibility to specify "IconBoxTITLES" as a resource in
-.Xdefaults, e.g. "Paw++*iconType: 4" - User request -.
-
-- add resource "panelInteractive" (True by default, or False to inhibit
-"close" panel, and supress possibility for panel editing) - User request -.
-
-- Prevent the HELP window(s) to disappear under kxterm.
-
-- Store the "Paw++ Locate" window (km_HigzOutput) into the list of possible
-windows to be raised - User request -.
-
-- bug correction for empty strings inside command argument panels.
diff --git a/src/packlib/kuip/doc/Versions/v2_06 b/src/packlib/kuip/doc/Versions/v2_06
deleted file mode 100644
index 26bed9e..0000000
--- a/src/packlib/kuip/doc/Versions/v2_06
+++ /dev/null
@@ -1,132 +0,0 @@
-*
-* $Id: v2_06,v 1.1.1.1 1996/03/08 15:33:03 mclareni Exp $
-*
-* $Log: v2_06,v $
-* Revision 1.1.1.1 1996/03/08 15:33:03 mclareni
-* Kuip
-*
-*
-*CMZ : 2.06/10 03/03/95 16.31.15 by N.Cremel
-*-- Author : N.Cremel 03/03/95
-*
-*::> VERSION 2.06/10 03/03/95 16.31.15
-*
-* ICONWIDGET : change || by &&
-*
-*::> VERSION 2.06/09 03/03/95 16.27.18
-*
-*
-* Implement the new FIND mechanism (new behavior for command "HELP".
-* Behavior of "HELP" is kept in new command name "CHELP" (for
-* "Command Help").
-* This new HELP is connected to the new directive:
-* >Keyword
-* list-of-keywords
-* in the CDF.
-* e.g.
-* >Command PSVIEW
-* >Parameters
-* FNAME 'File name' C
-* >Keyword
-* PostScript
-* display viewer
-* >Guidance
-* ...
-* Notes:
-* 1- This implies to install also the new CDF compiler (kuipc) and
-* the new kxterm.
-* 2- I have (at the same time) implemented in kuipc the new CDF directive:
-* >Link
-* list-of-links
-* similar to >Keyword (same logic), for future development arround the
-* HTML links.
-*
-* Bug correction: MAX_opt (for option-menu parameters) was not
-* tested (MKDCMP). Do other check on "MAX" definition ($MKDIMS).
-*
-*-- Author : Gunter Folger 05/10/94
-*
-*::> VERSION 2.06/08 24/02/95 14.42.34
-*
-* fix trivial = to == in iconwidget in #if
-*
-*::> VERSION 2.06/07 22/02/95 17.01.33
-*
-*
-* 03/02/95 15.58.06
-*
-* fsearch modified to correct problem for VMS when current dir is
-* search list
-* Iconwidget still; the difference is not Irix4, but Motif1.1 except Hp and
-* apollo, which have in Motif1.1 the 1.2 prototype
-*
-*::> VERSION 2.06/06 18/01/95 15.32.31
-*
-* uxxt : add test for "XtSpecificationRelease"
-*
-*::> VERSION 2.06/05 17/01/95 14.40.04
-*
-* adapt iconwdget for SGI Irix4.
-*
-*::> VERSION 2.06/04 17/01/95 09.56.35
-*
-* kuxxt : add test for "XtSpecificationRelease"
-*
-*::> VERSION 2.06/03 16/01/95 11.13.30
-*
-* Do not exit on input of mulitnational characters; they are ignored now.
-*
-* Write error message on attempt to create a vector with more than 3d;
-* previously quietly a 3d vector was created.
-*
-* Command panels: give possibility to have all parameters input in a
-* scrolled window. Add new resource "scrolledCmdPanel. In .Xdefaults:
-* *scrolledCmdPanel: auto (default)
-* or *scrolledCmdPanel: always
-* or *scrolledCmdPanel: never
-* "auto" means that the scrolled window is automatically created if the
-* number of params. > 10 (otherwise fixed size area). "always" and "never"
-* means, respectively, that the scrolled window is always (or never) created.
-*
-* km_create_sctext (used for "HELP") : calculate height of the window, to
-* avoid too big windows with small amount of text.
-*
-* new routine "CreateIconWidget" to avoid extern reference to "iconWidgetClass"
-* which was causing problems on VMS (for user-defined panels, "view" option
-* "by name and icon").
-*
-* KUXXT, ICONWIDGET : small corrections for DEC-CC.
-*
-* For panel definition: accept labels with blank inside and replace blanks
-* by '0' for valid alias definition (new routine strblk0).
-*
-* Bug correction in panel: when a new button is filled (mouse button 2)
-* or a button is erased (mouse button 3) then do it in all "views"
-* and not only in the current one (km_panel_execute).
-*
-* KMUMEN : small correction for DEC-CC.
-*
-* Panels: "view" option "by name and icon" is implemented (ICONWIDGET)
-* Change the logic in panel management.
-*
-* Allow for file names up to 256 chars in KUOPEN, including path; was 80
-*
-*::> VERSION 2.06/02 21/11/94 12.13.54
-* Correct typo in pop_stack
-*
-*::> VERSION 2.06/01 17/11/94 16.15.57
-*
-* 2 bugs correction in "panel" :
-* - "panel 0 d" protect empty panels (KUWHAT)
-* - "close" panel : give all panels a different title (MKDCMP)
-*
-* carry over previous fixesto kmacro, kuwham, mkdcmp, kmiout, and kxterm
-* add protection for failed execl call in kmisc/shsystem
-*
-*::> VERSION 2.06/00 05/10/94 12.02.47
-*
-* New commands GLOBAL/CREATE, IMPORT, DELETE, LIST for handling global
-* variables.
-*
-* Support for variable indirection and arrays of variables.
-*
diff --git a/src/packlib/kuip/doc/Versions/v2_07 b/src/packlib/kuip/doc/Versions/v2_07
deleted file mode 100644
index 5515e46..0000000
--- a/src/packlib/kuip/doc/Versions/v2_07
+++ /dev/null
@@ -1,103 +0,0 @@
-*
-* $Id: v2_07,v 1.1.1.1 1996/03/08 15:33:03 mclareni Exp $
-*
-* $Log: v2_07,v $
-* Revision 1.1.1.1 1996/03/08 15:33:03 mclareni
-* Kuip
-*
-*
-*CMZ : 2.07/08 24/01/96 17.26.56 by Gunter Folger
-*-- Author : Gunter Folger 06/03/95
-*
-*::> VERSION 2.07/08 24/01/96 17.26.56
-*
-*
-* 21/11/95 17.23.46
-*
-*
-* 21/11/95 11.26.07
-*
-* NC. Change in KMENU (CKUIP) :
-* 1) in command mode, in HELP, put a "*" before real commands
-* (not sub-menus).
-* 2) bug correction for VMS ("HELP", and "HELP NULL").
-*
-* 06/11/95 16.42.31
-*
-* NC. Change in mkdpan (CMOTIF) : bug correction for panel, e.g.:
-* panel 0
-* panel 1.01 'vec/pri-' 'print vector'
-* panel 1.02 'vec/pri-' 'print -'
-* panel 1.03 'vec/pri-'
-* panel 0 d
-*
-* 22/06/95 14.53.05
-*
-* NC. Change in KUXLISHLP iand $MKUXLIHLP (code generated from Architect)
-* in order to avoid problem with "km_listSBox" (previously it was
-* defined "extern" in 2 different include files).
-*
-*::> VERSION 2.07/07 22/06/95 14.51.58
-*
-*
-* 16/06/95 16.09.58
-*
-* GF. Protect for a NULL pointer in kmenu/interactive_find
-*
-*::> VERSION 2.07/06 14/06/95 15.33.42
-*
-* GF. Change definition/declaration of cdf_text, cdf_value
-*
-*::> VERSION 2.07/05 12/06/95 17.52.08
-*
-*
-* 12/06/95 17.32.31
-* GF. fixed problem with recursive vaiable assignment in
-* kalias/*subst_var_alias
-*
-*
-*::> VERSION 2.07/04 23/05/95 15.34.19
-*
-* NC. Change logic for "new help machanism" (KMENU):
-* For "HELP xxx" : if xxx is a valid command name and command is unique,
-* then print help as before (do not look for keywords "xxx" but add
-* a "See also" message at the end for other commands with that keyword).
-* In that case to have all commands (valid command name + keyword)
-* do "HELP xxx -K(EYWORD)". if xxx is a valid command name but not
-* unique do the same as "HELP xxx -K(EYWORD)" (print all commands,
-* valid + keyword).
-*
-* GF. Fixed problem with mod(); kmath_y affected.
-* added ku_qcas() identicalto its fortran version
-*
-*::> VERSION 2.07/03 09/05/95 17.27.59
-*
-* GF. -fix several problems in kuvec
-* -add check for trailing blanks to fill_arg_list (kexec); this avoids
-* problems when an alias with trailing blanks is at the end of cmd.
-* -make kxmexec aware of filecase setting in unix ( \ msdos).
-*
-* NC. Correction in "new" HELP for option EDIT/NOEDIT.
-* Suppress all reference to /KUIP/CHELP and replace them by
-* /KUIP/HELP.
-*
-* NC. Put a more explicit message in "check_version" when the CDF
-* has to be re-compiled (indicating which CDF causes the problem).
-*
-*::> VERSION 2.07/02 03/04/95 14.28.00
-*
-* NC. bug correction for popup menus in the graphics window with sub-menus
-* (mkdgra).
-*
-*
-*::> VERSION 2.07/01 07/03/95 15.53.53
-*
-* NC. change resource "centerCommand" to an integer value (before it was
-* a boolean) : 0 (False) means "normal" (cursor position), 1 (True)
-* means "center" and -1 (new) means position (0,0).
-*
-*::> VERSION 2.07/00 06/03/95 12.08.12
-*
-* NC. New find comand. Is actually descibed in 2.06/08.
-
-
diff --git a/src/packlib/kuip/doc/kumacs/clean.F b/src/packlib/kuip/doc/kumacs/clean.F
deleted file mode 100644
index 6ad6e59..0000000
--- a/src/packlib/kuip/doc/kumacs/clean.F
+++ /dev/null
@@ -1,52 +0,0 @@
-*
-* $Id: clean.F,v 1.1.1.1 1996/03/08 15:33:01 mclareni Exp $
-*
-* $Log: clean.F,v $
-* Revision 1.1.1.1 1996/03/08 15:33:01 mclareni
-* Kuip
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_kuip/pilot.h"
-*CMZ : 1.68/00 02/03/92 13.55.43 by Fons Rademakers
-*-- Author :
-
-*****************************************************************
-* *
- macro clean os=x ftn=x
-* *
-*****************************************************************
-
-mess 'Deleting old fortran and binary files....'
-
-if [os] = unix goto unix
-if [os] = vm goto vm
-if [os] = vms goto vms
- goto error
-
-unix:
- host_shell /bin/sh
-* shell /bin/rm -fr [ftn]
- shell /bin/mkdir [ftn]
- goto end
-
-vm:
- shell gime 20 [ftn]
-* shell erase * fortran [ftn]
-* shell erase * text [ftn]
- goto end
-
-vms:
-* shell delete '[.'//[ftn]//']*.*;*'
-* shell delete [ftn].dir;*
- shell create/directory/protection=(o:dwre) '[.'//[ftn]//']'
- goto end
-
-error:
-mess *** Error in clean: os = [os], ftn = [ftn] ***
-
-end:
-mess 'Deleting old fortran and binary files....done'
-
-return
-
diff --git a/src/packlib/kuip/doc/kumacs/help.F b/src/packlib/kuip/doc/kumacs/help.F
deleted file mode 100644
index fdf769c..0000000
--- a/src/packlib/kuip/doc/kumacs/help.F
+++ /dev/null
@@ -1,86 +0,0 @@
-*
-* $Id: help.F,v 1.1.1.1 1996/03/08 15:33:02 mclareni Exp $
-*
-* $Log: help.F,v $
-* Revision 1.1.1.1 1996/03/08 15:33:02 mclareni
-* Kuip
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_kuip/pilot.h"
-*CMZ : 1.68/00 02/03/92 13.55.43 by Fons Rademakers
-*-- Author :
-
-
-*****************************************************************
-* *
- macro help name=x
-* *
-*****************************************************************
-
-if [name] = apollo goto apollo
-if [name] = sgi goto generic
-if [name] = hpux goto generic
-if [name] = sun goto generic
-if [name] = decs goto generic
-if [name] = ibmrt goto generic
-if [name] = aix370 goto generic
-if [name] = cray goto generic
-if [name] = ibm goto generic
-if [name] = newlib goto generic
-if [name] = vax goto generic
-
- mess ' '
- mess 'To install KUIP type the following:'
- mess ' '
- mess ' EXEC INSTALL <machine> [<opt>] [-dev] [-lib]'
- mess ' '
- mess 'Where <machine> may be one of the following:'
- mess ' apollo, sgi, hpux, sun, decs, ibmrt, aix370,'
- mess ' cray, ibm, newlib, vax'
- mess ' '
- mess 'To see the possible values of <opt> for a specific machine type:'
- mess ' EXEC <machine> help or EXEC <machine> ?'
- mess ' '
- mess 'The option -dev should only be specified for compiling and'
- mess 'linking in debug (development) mode.'
- mess ' '
- mess 'If option -lib is specified a stand-alone library will be created,'
- mess 'otherwise the object file(s) are kept for later usage.'
- mess ' '
- goto end
-
-apollo:
- mess ' '
- mess 'To install KUIP on the '//[name]//' type:'
- mess ' '
- mess EXEC INSTALL [name] '[<opt>] [-dev] [-lib]'
- mess ' '
- mess 'Where <opt> may be one of the following:'
- mess ' m68k (default) to install CMZ on a motorola Apollo'
- mess ' a88k to install CMZ on a DN10000 Apollo'
- mess ' '
- mess 'The option -dev should only be specified for compiling and'
- mess 'linking in debug (development) mode.'
- mess ' '
- mess 'If option -lib is specified a stand-alone library will be created,'
- mess 'otherwise the object file(s) are kept for later usage.'
- mess ' '
- goto end
-
-generic:
- mess ' '
- mess 'To install KUIP on the '//[name]//' type:'
- mess ' '
- mess EXEC INSTALL [name] '[-dev] [-lib]'
- mess ' '
- mess 'The option -dev should only be specified for compiling and'
- mess 'linking in debug (development) mode.'
- mess ' '
- mess 'If option -lib is specified a stand-alone library will be created,'
- mess 'otherwise the object file(s) are kept for later usage.'
- mess ' '
- goto end
-
-end:
-return
diff --git a/src/packlib/kuip/doc/kumacs/install.F b/src/packlib/kuip/doc/kumacs/install.F
deleted file mode 100644
index 4a3f503..0000000
--- a/src/packlib/kuip/doc/kumacs/install.F
+++ /dev/null
@@ -1,181 +0,0 @@
-*
-* $Id: install.F,v 1.1.1.1 1996/03/08 15:33:02 mclareni Exp $
-*
-* $Log: install.F,v $
-* Revision 1.1.1.1 1996/03/08 15:33:02 mclareni
-* Kuip
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_kuip/pilot.h"
-*CMZ : 1.68/00 02/03/92 13.55.43 by Fons Rademakers
-*-- Author :
-
-
-*****************************************************************
-* *
- macro install 1=x 2=x 3=x 4=x
-* *
-*****************************************************************
-*
-*-- delete any alias that may interfere with the macro
-*
-alias/delete *
-
-*
-*-- some of the variables used in this script
-*
-* NAME Kind of machine
-* CPU CPU type (for Apollo only: m68k or a88k)
-* OS Operating system type: Unix, VMS, VM, NEWLIB
-* FTN Name of subdirectory for fortran files
-* VERS Version of cernlib to link with
-* DEV If -dev then development version, compile with debug flag
-* LIB If set a stand-alone library will be created, if not
-* the object files will be kept for later use
-*
-NAME = $lower([1])
-A2 = $lower([2])
-A3 = $lower([3])
-A4 = $lower([4])
-OPT = x
-DEV = x
-LIB = x
-VERS = new
-
-if [A2] <> -dev goto endif2
- DEV = [A2]
- goto arg3
-endif2:
-if [A2] <> -lib goto endif3
- LIB = [A2]
- goto arg3
-endif3:
-OPT = [A2]
-arg3:
-if [A3] <> -dev goto endif4
- DEV = [A3]
- goto arg4
-endif4:
-if [A3] <> -lib goto endif5
- LIB = [A3]
- goto arg4
-endif5:
-if [A3] = x goto arg4
-goto help
-arg4:
-if [A4] <> -dev goto endif6
- DEV = [A4]
- goto arg5
-endif6:
-if [A4] <> -lib goto endif7
- LIB = [A4]
- goto arg5
-endif7:
-if [A4] = x goto arg5
-goto help
-arg5:
-
-*
-*-- the user wants help or needs help
-*
-if [NAME] = ? goto help
-if [NAME] = help goto help
-if [NAME] = x goto help
-
-if [OPT] = ? goto help1
-if [OPT] = help goto help1
-
-*
-*-- set the variables before the actual installation
-*
-if [NAME] = apollo goto apollo
-if [NAME] = sgi goto unix
-if [NAME] = hpux goto unix
-if [NAME] = sun goto unix
-if [NAME] = decs goto unix
-if [NAME] = ibmrt goto unix
-if [NAME] = aix370 goto unix
-if [NAME] = cray goto unix
-if [NAME] = ibm goto ibmvm
-if [NAME] = newlib goto newlib
-if [NAME] = vax goto vms
- goto help
-
-apollo:
- CPU = [OPT]
- if [CPU] = x goto m68k
- if [CPU] = m68k goto unix
- if [CPU] = a88k goto unix
- goto help1
- m68k:
- CPU = m68k
- goto unix
-
-unix:
- OS = unix
- FTN = ftn
- goto endif1
-
-ibmvm:
- OS = vm
- FTN = M
- goto endif1
-
-newlib:
- OS = newlib
- FTN = M
- goto endif1
-
-vms:
- OS = vms
- FTN = ftn
- goto endif1
-
-endif1:
-
-*
-*-- here follows the actual install stuff
-*
-mess ' '
-mess Installation of CMZ on [NAME] starting at $DATE $TIME .....
-mess ' '
-
-exec clean os=[OS] ftn=[FTN]
-exec load name=[NAME] os=[OS] ftn=[FTN] cpu=[CPU] dev=[DEV]
-if [LIB] <> x goto library
- cfor /
- set c -lan
- cfor /
- set ftn -lan
- goto endif8
-library:
- cflib /
- set c -lan
- cflib /
- set ftn -lan
-endif8:
-
-mess ' '
-mess 'If you also want to build kuipc type:'
-mess exec kuipc name=[NAME] os=[OS] vers=[VERS] dev=[DEV]
-mess ' '
-
-mess ' '
-mess Installation of CMZ on [NAME] finished at $DATE $TIME .....
-mess ' '
-
-goto end
-
-
-help:
-exec help
-goto end
-
-help1:
-exec help name=[NAME]
-goto end
-
-end:
-return
-
diff --git a/src/packlib/kuip/doc/kumacs/kuipc.F b/src/packlib/kuip/doc/kumacs/kuipc.F
deleted file mode 100644
index 1c2a69e..0000000
--- a/src/packlib/kuip/doc/kumacs/kuipc.F
+++ /dev/null
@@ -1,88 +0,0 @@
-*
-* $Id: kuipc.F,v 1.1.1.1 1996/03/08 15:33:02 mclareni Exp $
-*
-* $Log: kuipc.F,v $
-* Revision 1.1.1.1 1996/03/08 15:33:02 mclareni
-* Kuip
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_kuip/pilot.h"
-*CMZ : 1.68/00 02/03/92 13.55.43 by Fons Rademakers
-*-- Author :
-
-*****************************************************************
-* *
- macro kuipc name=x os=x vers=x dev=x
-* *
-*****************************************************************
-
-mess 'Compiling kuipc....'
-
-sel kuipcpat
-
-if [name] = apollo goto apollo
-if [os] = unix goto unix
-if [os] = vm goto vm
-if [os] = newlib goto newlib
-if [os] = vms goto vms
- goto error
-
-apollo:
- set kuipc.ftn -f
- cfor /kuipc
- if [dev] <> x goto devapo
- shell bind -sparse_vm -b kuipc kuipc.bin _
- /cern/[vers]/lib/libpacklib.a _
- /cern/[vers]/lib/libkernlib.a
- goto end
- devapo:
- shell bind -sparse_vm -b kuipc kuipc.bin _
- kuip.lib $HOME/kern/kernlib.lib
- goto end
-
-unix:
- set kuipc.f -f
- cfor /kuipc
- if [dev] <> x goto devunix
- shell f77 -o kuipc kuipc.o _
- /cern/[vers]/lib/libpacklib.a _
- /cern/[vers]/lib/libkernlib.a
- goto end
- devunix:
- shell f77 -o kuipc kuipc.o _
- kuip.a $HOME/kern/kernlib.a
- goto end
-
-vm:
- set kuipc.fortran.a -f
- cfor /kuipc
- * cannot bind from CMZ
- goto end
-
-newlib:
- mess '*** set directives for kuipc correctly ***'
-* set kuipc.fortran.a -f
-* cfor /kuipc
- goto error
-
-vms:
- set kuipc.for -f
- cfor /kuipc
- if [dev] <> x goto devvms
- shell link/exe=kuipc kuipc.obj, _
- 'cern:['//[vers]//'.lib]packlib/lib,kernlib/lib'
- goto end
- devvms:
- shell link/debug/exe=kuipc kuipc.obj,kuip.olb, _
- 'cern:['//[vers]//'.lib]kernlib/lib
- goto end
-
-error:
-mess *** Error in load: name = [name], os = [os] ***
-
-end:
-mess 'Compiling kuipc....done'
-
-return
-
diff --git a/src/packlib/kuip/doc/kumacs/load.F b/src/packlib/kuip/doc/kumacs/load.F
deleted file mode 100644
index 7a206ee..0000000
--- a/src/packlib/kuip/doc/kumacs/load.F
+++ /dev/null
@@ -1,159 +0,0 @@
-*
-* $Id: load.F,v 1.1.1.1 1996/03/08 15:33:02 mclareni Exp $
-*
-* $Log: load.F,v $
-* Revision 1.1.1.1 1996/03/08 15:33:02 mclareni
-* Kuip
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_kuip/pilot.h"
-*CMZ : 1.68/00 02/03/92 13.55.43 by Fons Rademakers
-*-- Author :
-
-*****************************************************************
-* *
- macro load name=x os=x ftn=x cpu=x dev=x
-* *
-*****************************************************************
-
-mess 'Setting compile flags and loading sequences....'
-
-if [name] = apollo goto apollo
-if [os] = unix goto unix
-if [os] = vm goto vm
-if [os] = newlib goto newlib
-if [os] = vms goto vms
- goto error
-
-apollo:
- sel . apollo abbrev double qxno_sc bsd
-
- set [ftn]/*.ftn -f
- set kuip.lib -l
-
- if [dev] <> x goto devapo
- if [cpu] <> m68k goto a88k
- set 'ftn $compfile -b $compfile.bin -zero -save -indexl -frnd _
- -cpu 3000' -c
- goto endif
- a88k:
- set 'ftn $compfile -b $compfile.bin -zero -save -indexl -natural _
- -cpu at' -c
- goto endif
- devapo:
- if [cpu] <> m68k goto deva88k
- set 'ftn $compfile -b $compfile.bin -zero -save -indexl -pic -frnd _
- -cpu 3000 -dba' -c
- goto endif
- deva88k:
- set 'ftn $compfile -b $compfile.bin -zero -save -indexl -natural _
- -cpu at -dba' -c
- goto endif
-
-unix:
- set [ftn]/*.f -f
- set c -lan
- set [ftn]/*.c -f
- set ftn -lan
- set kuip.a -l
-
- if [name] = sgi goto sgi
- if [name] = hpux goto hpux
- if [name] = sun goto sun
- if [name] = decs goto decs
- if [name] = ibmrt goto ibmrt
- if [name] = aix370 goto aix370
- if [name] = cray goto cray
- goto error
-
- sgi:
- sel . [name] [os] abbrev double bslash csetjmp qx_sc bsd
- OPTF = -static -O -nocpp
- goto endif1
-
- hpux:
- sel . [name] [os] abbrev double csetjmp qx_sc sys5
- OPTF = -K +ppu -O
- goto endif1
-
- sun:
- sel . [name] [os] abbrev double bslash csetjmp qx_sc bsd
- OPTF = -O
- goto endif1
-
- decs:
- sel . [name] [os] abbrev double bslash csetjmp qx_sc sys5
- OPTF = -static -G 3 -O
- goto endif1
-
- ibmrt:
- sel . [name] [os] abbrev double bslash csetjmp qx_sc sys5
- set 'xlf -qextname -qrndsngl -qcharlen=32767 -O -c $compfile' -c
- goto endif
-
- aix370:
- sel . [name] [os] abbrev double qx_sc
- set 'xlf -qextname -qrndsngl -qcharlen=32767 -O -c $compfile' -c
- goto endif
-
- cray:
- sel . [name] abbrev qxcapt
- set 'cft77 -ed -o off -b $compfile.o $compfile' -c
- goto endif
-
- endif1:
- if [dev] <> x goto devset
- set 'f77 @[OPTF] -c $compfile' -c
- set c -lan
- set 'cc @[OPTC] -c $compfile' -c
- set ftn -lan
- goto endif
- devset:
- * default is debug
- goto endif
-
-vm:
- sel . [name] ibmall abbrev double
-
- set kuip.fortran.[ftn] -f
- set kuip.txtlib.a -l
- set 'vfort $compfile "(" noprint charlen "("15500")"' -c
- goto endif
-
-newlib:
- sel . [name] ibmmvs ibmall abbrev double
-
- mess '*** set compiler directive correctly ***'
- goto error
-* set kuip.fortran.[ftn] -f
-* set kuip.txtlib.a -l
-* set 'vfort $compfile "(" noprint charlen "("15500")"' -c
-* goto endif
-
-vms:
- sel . [name] abbrev double
-
- set '[.'//[ftn]//']kuip.for' -f
- set kuip.olb -l
- if [dev] <> x goto devvms
- set '$ for/obj=$compfile.obj $compfile' -c
- goto endif
- devvms:
- * default is debug
- goto endif
-
-endif:
-
-seq . /kucdes
-
-goto end
-
-error:
-mess *** Error in load: name = [name], os = [os] ***
-
-end:
-mess 'Setting compile flags and loading sequences....done'
-
-return
-
diff --git a/src/packlib/kuip/examples/Imakefile b/src/packlib/kuip/examples/Imakefile
deleted file mode 100644
index bf8e837..0000000
--- a/src/packlib/kuip/examples/Imakefile
+++ /dev/null
@@ -1,12 +0,0 @@
-SRCS_F= uprog.F
-
-#define IHaveCDF
-SRCS_CDF=uprogcdf.cdf
-
-DefinePackageLibrary(NullParameter)
-
-CernlibFortranProgramTarget(ktest,$(OBJS),$(PACKAGE_LIB),$(PACKAGE_LIB),graflib packlib kernlib)
-
-TestTarget(ktest,NullParameter,ktest.inp)
-
-CopyFile(kuipct.inp,ktest.inp)
diff --git a/src/packlib/kuip/examples/install b/src/packlib/kuip/examples/install
deleted file mode 100644
index 0a3ff24..0000000
--- a/src/packlib/kuip/examples/install
+++ /dev/null
@@ -1,43 +0,0 @@
-*
-* $Id: install,v 1.1.1.1 1996/03/08 15:33:06 mclareni Exp $
-*
-* $Log: install,v $
-* Revision 1.1.1.1 1996/03/08 15:33:06 mclareni
-* Kuip
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_kuip/pilot.h"
-*CMZ : 1.68/00 02/03/92 13.55.53 by Fons Rademakers
-*-- Author :
-#if defined(CERNLIB_APOLLO)
-#
-# Get TEST.CDF and UPROG.FTN from KUIP.CAR
-#
-ypatchy <<|
-- =uprog TTY TTY - =test.cdf .GO
-&EXE.
-&ASM,23
-&USE,EXAMPAT.
-&USE,P=EXAMPLE,D=CDF,UPROG.
-&PAM,11,T=CARDS,T=ATTACH .kuip.car
-&QUIT.
-|
-#
-# Run KUIPC on TEST.CDF
-#
-kuipc <<|
-test.cdf
-testd.ftn
-|
-#
-# Compile TESTD.FTN and UPROG.FTN
-#
-ftn testd -save -indexl
-ftn uprog -save -indexl
-#
-# Bind and generate the executable module TEST
-#
-bind -looks -all -b test test.bin testd.bin
-#endif
-
diff --git a/src/packlib/kuip/examples/kuipct.inp b/src/packlib/kuip/examples/kuipct.inp
deleted file mode 100644
index c037b1e..0000000
--- a/src/packlib/kuip/examples/kuipct.inp
+++ /dev/null
@@ -1,5 +0,0 @@
-number 20
-letter 20
-number 15
-letter 15
-quit
diff --git a/src/packlib/kuip/examples/uprog.F b/src/packlib/kuip/examples/uprog.F
deleted file mode 100644
index a8849aa..0000000
--- a/src/packlib/kuip/examples/uprog.F
+++ /dev/null
@@ -1,104 +0,0 @@
-*
-* $Id: uprog.F,v 1.2 1997/11/28 17:27:09 mclareni Exp $
-*
-* $Log: uprog.F,v $
-* Revision 1.2 1997/11/28 17:27:09 mclareni
-* Numerous mods and some new routines to get Control-C working reasonably on NT
-*
-* Kuip
-* Revision 1.1.1.1 1996/03/08 15:33:06 mclareni
-* Kuip
-*
-* 1997/11/28 15:33:06 V.Fine
-*
-* To check ctrl-C handling:
-*
-* - The dimensions of the R and CHR arrays in SUBROUTINE NUMLET
-* have been increased as follows:
-* REAL R(10000)
-* CHARACTER*1 CHR(10000)
-*
-* - kubron/kubrof protections for I/O have been introduced
-*
-*
-*CMZ : 1.61/03 07/07/89 16.01.01 by
-*-- Author :
- PROGRAM TEST
-*
- COMMON/PAWC/PAW(50000)
-*
-* Initialize ZEBRA and the store /PAWC/
-*
- CALL MZEBRA(-3)
- CALL MZPAW(50000,' ')
-*
-* Initialize KUIP with NWORDS words as minimum division size
-*
- NWORDS=15000
- CALL KUINIT(NWORDS)
-*
-* Create user command structure from definition file
-* (the definition routine name TESTD is defined in the CDF with '>N TESTD').
-*
- CALL TESTD
-*
-* Set an appropriate prompt for KUIP
-*
- CALL KUEXEC('SET/PROMPT ''RANDOM >''')
-*
-* Give control to KUIP (allowing 'STYLE G')
-*
- CALL KUWHAG
-*
-* Typing 'QUIT' or 'EXIT' we return here
-*
- END
-
- SUBROUTINE TSEED
- CHARACTER*4 OPTION
- CALL KUGETC(OPTION,NCH)
- CALL KUGETI(ISEED)
- IF (OPTION.EQ.'G') THEN
- CALL RDMOUT(ISEED)
- PRINT *,'Seed = ',ISEED
- ELSE IF (OPTION.EQ.'S') THEN
- CALL RDMIN(ISEED)
- ELSE
- PRINT *,'Illegal option'
- ENDIF
- END
-
- SUBROUTINE NUMLET
- REAL R(10000)
- CHARACTER*1 CHR(10000)
- CHARACTER*32 CMD
- CHARACTER*20 FORMAT,FMT
- CALL KUGETI(N)
- CALL KUGETS(FORMAT,NCH)
- FMT(1:1)='('
- FMT(2:)=FORMAT
- FMT(NCH+2:NCH+2)=')'
- CALL KUPATL(CMD,NPAR)
- DO 10 I=1,N
- R(I)=RNDM(I)
-10 CONTINUE
- IF (CMD.EQ.'NUMBER') THEN
-* I/O operation can not be interupted
- call kubrof
- WRITE (6,FMT) (R(I),I=1,N)
-* Unlock interuption handling
- call kubron
- ELSE IF (CMD.EQ.'LETTER') THEN
- DO 20 I=1,N
- J=65+R(I)*26
- CALL ITOCH(J,CHR(I),*20)
-20 CONTINUE
-* I/O operation can not be interupted
- call kubrof
- WRITE (6,FMT) (CHR(I),I=1,N)
-* Unlock interuption handling
- call kubron
- ENDIF
-99 CONTINUE
- END
-
diff --git a/src/packlib/kuip/examples/uprogcdf.cdf b/src/packlib/kuip/examples/uprogcdf.cdf
deleted file mode 100644
index 721a47e..0000000
--- a/src/packlib/kuip/examples/uprogcdf.cdf
+++ /dev/null
@@ -1,54 +0,0 @@
-*
-* $Id: uprogcdf.cdf,v 1.2 1997/11/28 17:27:11 mclareni Exp $
-*
-* $Log: uprogcdf.cdf,v $
-* Revision 1.2 1997/11/28 17:27:11 mclareni
-* Numerous mods and some new routines to get Control-C working reasonably on NT
-*
-* Revision 1.1.1.1 1996/03/08 15:33:06 mclareni
-* Kuip
-*
-* 1997/11/28 15:33:06 V.Fine
-*
-* To check ctrl-C handling:
-*
-* The upper limit for the the max number of the random numbers
-* has been increased (up to 10000) to let user some time to press
-* Ctrl-C keys.
-*
-*
->Name TESTD
-
->Menu RANDOM
-
->Command SEED
->Parameters
-+
-OPTION 'Option' C D='G' R='G,S'
-SEED 'Seed value' I D=123
->Guidance
-Get (option='G') or Set (option='S')
-the seed for the random number generator
->Action TSEED
-
->Command NUMBER
->Parameters
-N 'How many random numbers ?' I D=1 R=1:10000
-+
-FORMAT 'FORTRAN format' C D='10F7.3'
->Guidance
-Print N random numbers generated by the routine RNDM.
-Optionally a FORMAT can be specified.
->Action NUMLET
-
->Command LETTER
->Parameters
-N 'How many random letters ?' I D=1 R=1:10000
-+
-FORMAT 'FORTRAN format' C D='40(1X,A1)'
->Guidance
-Print N random letters (from 'A' to 'Z') using the routine RNDM.
-Optionally a FORMAT can be specified.
->Action TSEED
->Action NUMLET
-
diff --git a/src/packlib/kuip/kuip/Imakefile b/src/packlib/kuip/kuip/Imakefile
deleted file mode 100644
index 260cc79..0000000
--- a/src/packlib/kuip/kuip/Imakefile
+++ /dev/null
@@ -1,10 +0,0 @@
-INCLUDES= kcesvr.inc kcgen.inc kcgen1.inc kcgen2.inc kcmac.inc \ @@\
- kcmcmd.inc kcpar.inc kcques.inc kcsigm.inc kcunit.inc kcvrwf.inc \ @@\
- kcvect.inc kcwork.inc kucdes.inc browh1.h kalias.h kbrow.h \ @@\
- kbrow1.h kbrow2.h kbrow3.h kbrow4.h kcom.h kflag.h kfor.h \ @@\
- khaix370.h khapoftn.h khash.h khibmmvs.h khibmvm.h khnewlib.h \ @@\
- klink.h klink1.h kmacro.h kmenu.h kmenu1.h kmenu2.h kmenu3.h \ @@\
- kmenu4.h kmenu5.h kmenu6.h kmpanel.h kproto.h ksig.h kstring.h \ @@\
- ksys.h kuip.h kuser.h mkqio.h mkterm.h mkutfu.h pilot.h
-
-InstallIncludes($(INCLUDES),$(CERN_INCLUDEDIR),kuip)
diff --git a/src/packlib/kuip/kuip/browh1.h b/src/packlib/kuip/kuip/browh1.h
deleted file mode 100644
index 6f37778..0000000
--- a/src/packlib/kuip/kuip/browh1.h
+++ /dev/null
@@ -1,15 +0,0 @@
-/*
- * $Id: browh1.h,v 1.1.1.1 1996/03/08 15:33:01 mclareni Exp $
- *
- * $Log: browh1.h,v $
- * Revision 1.1.1.1 1996/03/08 15:33:01 mclareni
- * Kuip
- *
- */
-#ifndef _brow_h1
-#define _brow_h1
-
-#include "kbrow.h"
-
-#endif /* _brow_h1 */
-
diff --git a/src/packlib/kuip/kuip/kalias.h b/src/packlib/kuip/kuip/kalias.h
deleted file mode 100644
index 9f5cd75..0000000
--- a/src/packlib/kuip/kuip/kalias.h
+++ /dev/null
@@ -1,30 +0,0 @@
-/*
- * $Id: kalias.h,v 1.1.1.1 1996/03/08 15:32:59 mclareni Exp $
- *
- * $Log: kalias.h,v $
- * Revision 1.1.1.1 1996/03/08 15:32:59 mclareni
- * Kuip
- *
- */
-#define ALIAS_TABLE_SIZE 97 /* should be a prime */
-
-EXTERN struct {
- int translate; /* flag if translation wanted */
- int substitutions; /* how many more before recursive alarm */
- HashTable *arg_table; /* Argument alias table */
- HashTable *cmd_table; /* Command alias table */
- HashTable *global_value; /* global variable values */
- HashTable *global_text; /* global variable explanation text */
- HashTable *var_table; /* macro variables */
-} kc_alias;
-
-extern int match_paren( const char* );
-extern char* repl_variable( char*);
-extern char* repl_sysfun( char*, int);
-extern char* subst_arg_alias( char*);
-extern char* subst_cmd_alias( char*);
-extern char* subst_var_alias( char*);
-extern char* subst_sysfun( char*, int);
-extern char* var_value( const char* );
-
-
diff --git a/src/packlib/kuip/kuip/kbrow.h b/src/packlib/kuip/kuip/kbrow.h
deleted file mode 100644
index e82b3ae..0000000
--- a/src/packlib/kuip/kuip/kbrow.h
+++ /dev/null
@@ -1,82 +0,0 @@
-/*
- * $Id: kbrow.h,v 1.2 1996/04/16 13:26:38 gunter Exp $
- *
- * $Log: kbrow.h,v $
- * Revision 1.2 1996/04/16 13:26:38 gunter
- * Mods to compile kuipc. The includes needed only for kuipc where moved
- * to kuipc, together with m4 files to create/update these header files.
- *
- * Revision 1.1.1.1 1996/03/08 15:32:59 mclareni
- * Kuip
- *
- */
-/* kbrow.h: browser definitions */
-
-#define __ /* nul */
-
-#include "kbrow1.h"
-
-#include "kbrow2.h"
-
-#include "kbrow3.h"
-
-#include "kbrow4.h"
-
-#undef __
-
-typedef struct _KmObject {
- struct _KmObject *next; /* link to next object definition */
- char *name; /* unique identifier name */
- char *stext; /* short description text */
- char *ltext; /* long description text */
- KmClass *class; /* pointer to objects's class structure */
-} KmObject;
-
-typedef struct _BrVariable {
- struct _BrVariable *next; /* link to next variable definition */
- char *name; /* variable name */
- char *value; /* replacement value */
-} BrVariable;
-
-typedef struct _BrObject {
- struct _BrObject *next; /* link to next browsable object */
- char *name; /* name of the browsable object */
- BrClass *class; /* pointer to browsable's class structure */
- BrVariable *vars; /* linked list of variable substitutions */
-} BrObject;
-
-typedef struct _BrClientdata {
- BrActTag tag;
- const char *brobj;
- const char *brcls;
- const char *path;
- const char *kmobj;
- const char *kmcls;
- const char *stext;
- const char *ltext;
- const char *mtext;
-} BrClientdata;
-
-EXTERN BrClass *brclasses;
-EXTERN KmObject *kmobjects;
-EXTERN KmButton *kmbuttons;
-
-extern void klnkbrcl( BrClass*, int );
-extern void klnkkmcl( KmClass*, int );
-extern void klnkicon( KmIcon*, int );
-extern void klnkbutt( KmButton*, int );
-
-extern void exec_action( BrAction*, const char*, const char*, int,
- KmWidget, KmCalldata );
-extern KmWidget find_button( const char*, const char* );
-extern KmIcon* find_kmicon( const char* );
-extern KmClass* find_kmclass( const char* );
-extern BrObject* find_brobject( const char* );
-extern char* get_variable( const char*, const char* );
-extern BrObject* scan_brobjects(void);
-extern KmObject* scan_kmobjects( const char*, const char*, int );
-extern int set_action( const char*, int, int, const char*, const char*,
- int, int );
-extern void set_variable( BrObject*, const char*, const char* );
-
-
diff --git a/src/packlib/kuip/kuip/kbrow1.h b/src/packlib/kuip/kuip/kbrow1.h
deleted file mode 100644
index e4fd437..0000000
--- a/src/packlib/kuip/kuip/kbrow1.h
+++ /dev/null
@@ -1,19 +0,0 @@
-typedef unsigned long KmPixmap; /* Pixmap from <X11/X.h> */ __
-typedef void *KmWidget; /* Widget from <X11/Intrinsic.h> */ __
-typedef void *KmCalldata; /* XmAnyCallbackStruct from <Motif/Xm.h> */ __
- /* */ __
-typedef enum { /* */ __
- BRACT_OPEN = 0, /* */ __
- BRACT_ROOT = 1, /* */ __
- BRACT_CONT = 2, /* */ __
- BRACT_GRAF = 3 /* */ __
-} BrActTag; /* */ __
- /* */ __
-typedef enum { /* */ __
- BrActUpdate = 0x01, /* browser window has to be updated ('!') */ __
- BrActSeparator = 0x02, /* put separator in menu ('/') */ __
- BrActToggle = 0x04, /* register as toggle button */ __
- BrActToggleOn = 0x08, /* toggle state is on */ __
- BrActSensitive = 0x10 /* button is sensitive */ __
-} BrActFlag; /* */ __
- /* */ __
diff --git a/src/packlib/kuip/kuip/kbrow2.h b/src/packlib/kuip/kuip/kbrow2.h
deleted file mode 100644
index ada4952..0000000
--- a/src/packlib/kuip/kuip/kbrow2.h
+++ /dev/null
@@ -1,25 +0,0 @@
-typedef struct _BrAction { /* */ __
- struct _BrAction *next; /* link to next action binding */ __
- BrActFlag flags; /* */ __
- char *text; /* text line in menu */ __
- char *user_text; /* user text overriding CDF text (malloced)*/ __
- char *accel; /* accelerator */ __
- char *exec; /* action commands */ __
- SUBROUTINE *call_F; /* action routine */ __
- IntFunc *call_C; /* action function */ __
- BrActTag tag; /* for which window the action is defined */ __
- struct _BrClass *class; /* pointer to BrClass in case of open menu */ __
-} BrAction; /* */ __
- /* */ __
-typedef struct _BrClass { /* */ __
- struct _BrClass *next; /* link to next browsable class */ __
- char *name; /* unique identifier name */ __
- char *title; /* title for popup menu (maybe NULL) */ __
- SUBROUTINE *scan_km_F; /* user function scanning the directory */ __
- pCharFunc *scan_km_C; /* user function scanning the directory */ __
- SUBROUTINE *scan_br_F; /* user function scanning for browsables */ __
- pCharFunc *scan_br_C; /* user function scanning for browsables */ __
- BrAction *root; /* list of actions in root window */ __
- BrAction *open; /* list of actions in open menu */ __
-} BrClass; /* */ __
- /* */ __
diff --git a/src/packlib/kuip/kuip/kbrow3.h b/src/packlib/kuip/kuip/kbrow3.h
deleted file mode 100644
index 27ef5ae..0000000
--- a/src/packlib/kuip/kuip/kbrow3.h
+++ /dev/null
@@ -1,26 +0,0 @@
-typedef struct _KmIcon { /* */ __
- struct _KmIcon *next; /* link to next icon */ __
- char *name; /* unique identifier name */ __
- int width; /* width of the pixmap */ __
- int height; /* height of the pixmap */ __
- char *bitmap; /* bitmap data */ __
- KmPixmap pix; /* filled in Motif part */ __
- KmPixmap hi_pix; /* high lighted pixmap */ __
-} KmIcon; /* */ __
- /* */ __
-typedef struct _KmClass { /* */ __
- struct _KmClass *next; /* link to next object class */ __
- int is_dir; /* flag if class has is a directory */ __
- char *name; /* unique identifier name */ __
- char *title; /* title for popup menu (maybe NULL) */ __
- char *big_icon; /* name of the big icon */ __
- KmIcon *bicon; /* pointer to the big icon structure */ __
- char *sm_icon; /* name of the small icon */ __
- KmIcon *sicon; /* pointer to the small icon structure */ __
- SUBROUTINE *user_icon_F; /* user function to return icon bitmap */ __
- IntFunc *user_icon_C; /* user function to return icon bitmap */ __
- BrAction *cont; /* list of actions in content window */ __
- BrAction *graf; /* list of actions in graphics window */ __
- int obj_count; /* number of objects in content window */ __
-} KmClass; /* */ __
- /* */ __
diff --git a/src/packlib/kuip/kuip/kbrow4.h b/src/packlib/kuip/kuip/kbrow4.h
deleted file mode 100644
index 0c1d06d..0000000
--- a/src/packlib/kuip/kuip/kbrow4.h
+++ /dev/null
@@ -1,23 +0,0 @@
-typedef enum { /* */ __
- KmButtSensitive = 0x00, /* sensitive button */ __
- KmButtNonSensitive = 0x01, /* non-sensitive button ('NS') */ __
- KmButtToggleSensitive = 0x02, /* toggle-sensitive button ('TS') */ __
- KmButtSensitivityMask = 0x03, /* mask for sensitivity type */ __
- KmButtSeparator = 0x04, /* put separator in menu ('/') */ __
- KmButtBrowser = 0x08 /* button is in main browser ('BR') */ __
-} KmButtFlag; /* */ __
- /* */ __
-typedef struct _KmButton { /* */ __
- struct _KmButton *next; /* button label or menu item */ __
- char *menu; /* menu name or NULL for buttons */ __
- char *label; /* button label or menu item */ __
- SUBROUTINE *call_F; /* callback routine (FORTRAN) */ __
- IntFunc *call_C; /* callback routine (C) */ __
- char *action; /* name of callback routine */ __
- char *mnemo; /* button mnemonic */ __
- char *accel; /* button accelerator */ __
- char *accel_text; /* button accelerator text */ __
- KmButtFlag flags; /* sensitivity type etc. */ __
- KmWidget widget; /* Motif widget ID */ __
-} KmButton; /* */ __
- /* */ __
diff --git a/src/packlib/kuip/kuip/kcesvr.inc b/src/packlib/kuip/kuip/kcesvr.inc
deleted file mode 100644
index a55d5f4..0000000
--- a/src/packlib/kuip/kuip/kcesvr.inc
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: kcesvr.inc,v 1.1.1.1 1996/03/08 15:32:59 mclareni Exp $
-*
-* $Log: kcesvr.inc,v $
-* Revision 1.1.1.1 1996/03/08 15:32:59 mclareni
-* Kuip
-*
-*
-#ifndef CERNLIB_KUIP_KCESVR_INC
-#define CERNLIB_KUIP_KCESVR_INC
-*
-*
-* kcesvr.inc
-*
-*-- when changing MAXSVR ajust also the size in /CKUIP/KUGSVR
- PARAMETER (MAXSVR =20)
- INTEGER NSVFIL, NSVCUR, IESADD
- LOGICAL SERVER
- COMMON /KCESVR/ NSVFIL, NSVCUR, IESADD, SERVER
-
- CHARACTER*32 EDTFIL(MAXSVR)
- CHARACTER*32 EDTCMD(MAXSVR)
- COMMON /KCEFIL/ EDTFIL, EDTCMD
-
-
-#endif
diff --git a/src/packlib/kuip/kuip/kcgen.inc b/src/packlib/kuip/kuip/kcgen.inc
deleted file mode 100644
index 10d2038..0000000
--- a/src/packlib/kuip/kuip/kcgen.inc
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: kcgen.inc,v 1.1.1.1 1996/03/08 15:32:59 mclareni Exp $
-*
-* $Log: kcgen.inc,v $
-* Revision 1.1.1.1 1996/03/08 15:32:59 mclareni
-* Kuip
-*
-*
-#ifndef CERNLIB_KUIP_KCGEN_INC
-#define CERNLIB_KUIP_KCGEN_INC
-*
-*
-* kcgen.inc
-*
- COMMON /PAWC/ NWPAW,IXPAWC,IHBOOK,IXHIGZ,IXKUIP,IFENCE(5),
- + LMAIN(1), WS(9989)
- DIMENSION IQ(2),Q(2),LQ(8000)
- EQUIVALENCE (LQ(1),LMAIN(1))
- EQUIVALENCE (IQ(1),LQ(9))
- EQUIVALENCE ( Q(1),LQ(9))
-
- COMMON /KCLINK/
- + LTOP,LVEC,LCMD,LACT,LMAC,LLIST,LSDUM1,
- + LCEL,LNAME,LPAR,LPARV,LTRAV,LVECN,LCELGF,
- + LROOT,LTOPW1,LTOPW2,LMACN,LCLIST,LLAST
-
-
-#endif
diff --git a/src/packlib/kuip/kuip/kcgen1.inc b/src/packlib/kuip/kuip/kcgen1.inc
deleted file mode 100644
index 9e2bd38..0000000
--- a/src/packlib/kuip/kuip/kcgen1.inc
+++ /dev/null
@@ -1,47 +0,0 @@
-*
-* $Id: kcgen1.inc,v 1.1.1.1 1996/03/08 15:32:59 mclareni Exp $
-*
-* $Log: kcgen1.inc,v $
-* Revision 1.1.1.1 1996/03/08 15:32:59 mclareni
-* Kuip
-*
-*
-#ifndef CERNLIB_KUIP_KCGEN1_INC
-#define CERNLIB_KUIP_KCGEN1_INC
-*
-*
-* kcgen1.inc
-*
- PARAMETER (MAXLEV=10)
-
- COMMON /KCBANC/ WDNAM(MAXLEV),INPMOD,CPRMPT,CHGLOS,CDFFIL,EDITOR,
- + SHELL,TRAPRO,CHMULT,CHMULM,CHMEXE,
- + MACBAK,MACEXT,BSLASH
- +
- CHARACTER*64 CPRMPT,EDITOR,TRAPRO,SHELL
- CHARACTER*32 WDNAM,CHGLOS
- CHARACTER*16 CDFFIL
- CHARACTER*8 INPMOD,MACBAK
- CHARACTER*7 MACEXT
- CHARACTER*1 BSLASH
- CHARACTER*80 CHMULM
- CHARACTER*(MAXCMD) CHMULT,CHMEXE
-
- COMMON /KCLAST/ CELLST,PNALST,PATLST(MAXLEV)
- CHARACTER*32 CELLST
- CHARACTER*40 PNALST
- CHARACTER*32 PATLST
-
- COMMON /KCUTIL/ NCMD,IWD,LUNFIL,LPRMPT,TIMING,TRACE,CALMOD,
- + NVADD,IREPET,IREFAC,IBRAK,TIMALL,LENTER,UNIQUE,
- + LENMUL,MULTFL,HISTOK,NOHIST,LENMUM,FILCAS,MEXEFL
- LOGICAL TIMING,TRACE,TIMALL,UNIQUE,MULTFL,HISTOK,NOHIST,FILCAS,
- + MEXEFL
- INTEGER CALMOD
-
- COMMON /KCHELP/ HELPAT,UHPATH
- CHARACTER*80 HELPAT
- CHARACTER*32 UHPATH
-
-
-#endif
diff --git a/src/packlib/kuip/kuip/kcgen2.inc b/src/packlib/kuip/kuip/kcgen2.inc
deleted file mode 100644
index 33c8e24..0000000
--- a/src/packlib/kuip/kuip/kcgen2.inc
+++ /dev/null
@@ -1,45 +0,0 @@
-*
-* $Id: kcgen2.inc,v 1.1.1.1 1996/03/08 15:32:59 mclareni Exp $
-*
-* $Log: kcgen2.inc,v $
-* Revision 1.1.1.1 1996/03/08 15:32:59 mclareni
-* Kuip
-*
-*
-#ifndef CERNLIB_KUIP_KCGEN2_INC
-#define CERNLIB_KUIP_KCGEN2_INC
-*
-*
-* kcgen2.inc
-*
- PARAMETER (MAXLVA=16)
- COMMON /KCVADD/
- + LVADDR(MAXLVA)
-
- COMMON /KCFORM/ IOCEL,IONAME,IOPAR,IOPARV,IOVEC,IOVECN
-
- COMMON /KCSPR/ SPRMPT
- CHARACTER*64 SPRMPT
-
- COMMON /KCAPPL/ APPLIC,APEXIT
- CHARACTER*64 APPLIC
- CHARACTER*32 APEXIT
-
- COMMON /KCAPPM/ APPMAC,APPMEX
- CHARACTER*64 APPMAC
- CHARACTER*32 APPMEX
-
- COMMON /KCROOT/ CHROOT
- CHARACTER*64 CHROOT
-
- COMMON /KCUSER/ LAPPLI,LUNAPP
-
- COMMON /KCEXEL/ EXELIN
- CHARACTER*(MAXCMD) EXELIN
-
- COMMON /KCEXIT/ IEXADD,IUSADD,NEXADD,IUTADD,IQUADD,IBRADD
- + ,LICALL,LICAL2,LICAL3
- LOGICAL LICALL,LICAL2,LICAL3
-
-
-#endif
diff --git a/src/packlib/kuip/kuip/kcmac.inc b/src/packlib/kuip/kuip/kcmac.inc
deleted file mode 100644
index d744045..0000000
--- a/src/packlib/kuip/kuip/kcmac.inc
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: kcmac.inc,v 1.1.1.1 1996/03/08 15:32:59 mclareni Exp $
-*
-* $Log: kcmac.inc,v $
-* Revision 1.1.1.1 1996/03/08 15:32:59 mclareni
-* Kuip
-*
-*
-#ifndef CERNLIB_KUIP_KCMAC_INC
-#define CERNLIB_KUIP_KCMAC_INC
-*
-*
-* kcmac.inc
-*
- COMMON /KCMAC/ MACTAB,NSTLEV,QUITFL,WAITFL,WAITFF,DEBTAB,SKIPFL,
- + HEADFL,IONERF,NOEXEC
- LOGICAL MACTAB,QUITFL,WAITFL,WAITFF,DEBTAB,SKIPFL,HEADFL,NOEXEC
-
- PARAMETER (MAXLIN=500)
- COMMON /KCMACC/ MACBUF(MAXLIN)
- CHARACTER*80 MACBUF
-
- PARAMETER (MAXMAC=100,MAXLAB=100,LENSYM=48)
- COMMON /KCMEC/ NUMMAC,NUMLAB,IIIMAC
- COMMON /KCMECI/ LABADD(MAXLAB),MACUND(MAXMAC),LABADM(MAXLAB)
-CCCM COMMON /KCMECC/ MACNAM(MAXMAC),LABNAM(MAXLAB),MACPAT,AUTOEX
- COMMON /KCMECC/ MACNAM(MAXMAC),LABNAM(MAXLAB),MACPAT,AUTOEX,MACLIS
- CHARACTER*(LENSYM) MACNAM,LABNAM
-CCCM CHARACTER*80 MACPAT
- CHARACTER*80 MACPAT,MACLIS
- CHARACTER*20 AUTOEX
-
-
-#endif
diff --git a/src/packlib/kuip/kuip/kcmcmd.inc b/src/packlib/kuip/kuip/kcmcmd.inc
deleted file mode 100644
index 5fb7a8e..0000000
--- a/src/packlib/kuip/kuip/kcmcmd.inc
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: kcmcmd.inc,v 1.1.1.1 1996/03/08 15:32:59 mclareni Exp $
-*
-* $Log: kcmcmd.inc,v $
-* Revision 1.1.1.1 1996/03/08 15:32:59 mclareni
-* Kuip
-*
-*
-#ifndef CERNLIB_KUIP_KCMCMD_INC
-#define CERNLIB_KUIP_KCMCMD_INC
-*
-*
-* kcmcmd.inc
-*
- PARAMETER (MAXCMD = 512)
-
-
-#endif
diff --git a/src/packlib/kuip/kuip/kcom.h b/src/packlib/kuip/kuip/kcom.h
deleted file mode 100644
index 0370a8b..0000000
--- a/src/packlib/kuip/kuip/kcom.h
+++ /dev/null
@@ -1,83 +0,0 @@
-/*
- * $Id: kcom.h,v 1.1.1.1 1996/03/08 15:33:00 mclareni Exp $
- *
- * $Log: kcom.h,v $
- * Revision 1.1.1.1 1996/03/08 15:33:00 mclareni
- * Kuip
- *
- */
-/* kcom.h: Fortran COMMON blocks */
-
-
-#define Kcparc F77_BLOCK(kcparc,KCPARC)
-
-EXTERN struct {
- char PARLST[512]; /* interface block for KUSER */
- char CLIST[80];
- char NOALIN[512];
- char COMAND[80];
- char CHLAST[512];
- char NONPOS[512];
-} F77_COMMON(Kcparc);
-
-
-#define Kcutil F77_BLOCK(kcutil,KCUTIL)
-
-EXTERN struct {
- INTEGER NCMD;
- INTEGER IWD;
- INTEGER LUNFIL;
- INTEGER LPRMPT;
- LOGICAL TIMING;
- LOGICAL TRACE;
- INTEGER CALMOD;
- INTEGER NVADD;
- INTEGER IREPET;
- INTEGER IREFAC;
- INTEGER IBRAK;
- LOGICAL TIMALL;
- INTEGER LENTER;
- LOGICAL UNIQUE;
- INTEGER LENMUL;
- LOGICAL MULTFL;
- LOGICAL HISTOK;
- LOGICAL NOHIST;
- INTEGER LENMUM;
- LOGICAL FILCAS;
- LOGICAL MEXEFL;
-} F77_COMMON(Kcutil);
-
-
-#define Kcvect F77_BLOCK(kcvect,KCVECT)
-
-EXTERN struct {
- INTEGER NUMVEC; /* number of vectors stored */
- INTEGER TOTPAV;
- INTEGER GETPAV;
- LOGICAL TVECFL;
-} F77_COMMON(Kcvect);
-
-
-#define Kcwork F77_BLOCK(kcwork,KCWORK)
-
-EXTERN struct {
- REAL VECTOR[100]; /* vector '?' */
-} F77_COMMON(Kcwork);
-
-
-#define Quest F77_BLOCK(quest,QUEST)
-
-EXTERN struct {
- INTEGER DATA[100];
-} F77_COMMON(Quest);
-
-#define IQUEST(n) Quest.DATA[n-1]
-
-
-#define Sikuip F77_BLOCK(sikuip,SIKUIP)
-
-EXTERN struct {
- char CHSIGM[80]; /* command string passed to SIGMA */
-} F77_COMMON(Sikuip);
-
-
diff --git a/src/packlib/kuip/kuip/kcpar.inc b/src/packlib/kuip/kuip/kcpar.inc
deleted file mode 100644
index 229bf80..0000000
--- a/src/packlib/kuip/kuip/kcpar.inc
+++ /dev/null
@@ -1,35 +0,0 @@
-*
-* $Id: kcpar.inc,v 1.1.1.1 1996/03/08 15:32:59 mclareni Exp $
-*
-* $Log: kcpar.inc,v $
-* Revision 1.1.1.1 1996/03/08 15:32:59 mclareni
-* Kuip
-*
-*
-#ifndef CERNLIB_KUIP_KCPAR_INC
-#define CERNLIB_KUIP_KCPAR_INC
-*
-*
-* kcpar.inc
-*
- PARAMETER (MAXPAR=100)
- COMMON /KCPARI/ PARPTR(4,MAXPAR),GETPAR,ICLENG,ICLIST,
- + IPFLAG(MAXPAR),NONPOL,NOPOS1
- INTEGER PARPTR,GETPAR
-
- COMMON /KCPARS/ GETSPY,SPYFLG,PROFLG,SPYING
- INTEGER GETSPY
- LOGICAL SPYFLG,PROFLG,SPYING
-
- COMMON /KCDEFL/ DEFLAG
- LOGICAL DEFLAG
-
- COMMON /KCPART/ TOTPAR
- INTEGER TOTPAR
-
- COMMON /KCPARC/ PARLST,CLIST,NOALIN,COMAND,CHLAST,NONPOS
- CHARACTER*80 CLIST,COMAND
- CHARACTER*(MAXCMD) NONPOS
- CHARACTER*(MAXCMD) PARLST,NOALIN,CHLAST
-
-#endif
diff --git a/src/packlib/kuip/kuip/kcques.inc b/src/packlib/kuip/kuip/kcques.inc
deleted file mode 100644
index 2e9f75d..0000000
--- a/src/packlib/kuip/kuip/kcques.inc
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: kcques.inc,v 1.1.1.1 1996/03/08 15:32:59 mclareni Exp $
-*
-* $Log: kcques.inc,v $
-* Revision 1.1.1.1 1996/03/08 15:32:59 mclareni
-* Kuip
-*
-*
-#ifndef CERNLIB_KUIP_KCQUES_INC
-#define CERNLIB_KUIP_KCQUES_INC
-*
-*
-* kcques.inc
-*
- COMMON /QUEST/ IQUEST(100)
-
-
-#endif
diff --git a/src/packlib/kuip/kuip/kcsigm.inc b/src/packlib/kuip/kuip/kcsigm.inc
deleted file mode 100644
index 7a28554..0000000
--- a/src/packlib/kuip/kuip/kcsigm.inc
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: kcsigm.inc,v 1.1.1.1 1996/03/08 15:32:59 mclareni Exp $
-*
-* $Log: kcsigm.inc,v $
-* Revision 1.1.1.1 1996/03/08 15:32:59 mclareni
-* Kuip
-*
-*
-#ifndef CERNLIB_KUIP_KCSIGM_INC
-#define CERNLIB_KUIP_KCSIGM_INC
-*
-*
-* kcsigm.inc
-*
- COMMON /KCSIGM/ ISIADD,NVSIGM
-
- COMMON /SIKUIP/ CHSIGM
- CHARACTER*80 CHSIGM
-
-
-#endif
diff --git a/src/packlib/kuip/kuip/kcunit.inc b/src/packlib/kuip/kuip/kcunit.inc
deleted file mode 100644
index 50528d5..0000000
--- a/src/packlib/kuip/kuip/kcunit.inc
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: kcunit.inc,v 1.1.1.1 1996/03/08 15:32:59 mclareni Exp $
-*
-* $Log: kcunit.inc,v $
-* Revision 1.1.1.1 1996/03/08 15:32:59 mclareni
-* Kuip
-*
-*
-#ifndef CERNLIB_KUIP_KCUNIT_INC
-#define CERNLIB_KUIP_KCUNIT_INC
-*
-*
-* kcunit.inc
-*
-CCCM COMMON /KCUNIT/ ILUIN,ILUOUT,LUOUT,LUNLOG,LUNHIS,LUACT,LUNMAN
- COMMON /KCUNIT/ ILUIN,ILUOUT,LUOUT,LUNLOG,LUNHIS,LUACT,LUNMAN,
- + LUNML
- COMMON /KCLUI/ LUIBAS,LUIFIL,LUIVR,LUIVW,
- + LUIHIS,LUIAPP,LUIHIW,LUIMAN
-
-
-#endif
diff --git a/src/packlib/kuip/kuip/kcvect.inc b/src/packlib/kuip/kuip/kcvect.inc
deleted file mode 100644
index 483d487..0000000
--- a/src/packlib/kuip/kuip/kcvect.inc
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: kcvect.inc,v 1.1.1.1 1996/03/08 15:32:59 mclareni Exp $
-*
-* $Log: kcvect.inc,v $
-* Revision 1.1.1.1 1996/03/08 15:32:59 mclareni
-* Kuip
-*
-*
-#ifndef CERNLIB_KUIP_KCVECT_INC
-#define CERNLIB_KUIP_KCVECT_INC
-*
-*
-* kcvect.inc
-*
- COMMON /KCVECT/ NUMVEC,TOTPAV,GETPAV,TVECFL
- INTEGER TOTPAV,GETPAV
- LOGICAL TVECFL
-
-
-#endif
diff --git a/src/packlib/kuip/kuip/kcvrwf.inc b/src/packlib/kuip/kuip/kcvrwf.inc
deleted file mode 100644
index 7f73eee..0000000
--- a/src/packlib/kuip/kuip/kcvrwf.inc
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: kcvrwf.inc,v 1.1 2000/01/10 10:30:56 couet Exp $
-*
-* $Log: kcvrwf.inc,v $
-* Revision 1.1 2000/01/10 10:30:56 couet
-* - new common block kcvrwf shared by kxvrea and kxvwri to store the file
-* name in which the vector in red or written.
-*
-* Revision 1.1.1.1 2000/10/01 11:00:00 couet
-* Kuip
-*
-*
-#ifndef CERNLIB_KUIP_KCVRWF_INC
-#define CERNLIB_KUIP_KCVRWF_INC
-*
-*
-* kcvrwf.inc
-*
- CHARACTER*160 FNAME
- COMMON /KCVRWF/ FNAME
-#endif
diff --git a/src/packlib/kuip/kuip/kcwork.inc b/src/packlib/kuip/kuip/kcwork.inc
deleted file mode 100644
index 4fc551e..0000000
--- a/src/packlib/kuip/kuip/kcwork.inc
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: kcwork.inc,v 1.1.1.1 1996/03/08 15:32:59 mclareni Exp $
-*
-* $Log: kcwork.inc,v $
-* Revision 1.1.1.1 1996/03/08 15:32:59 mclareni
-* Kuip
-*
-*
-#ifndef CERNLIB_KUIP_KCWORK_INC
-#define CERNLIB_KUIP_KCWORK_INC
-*
-*
-* kcwork.inc
-*
- COMMON /KCWORK/ VECTOR(100)
-
-
-#endif
diff --git a/src/packlib/kuip/kuip/kflag.h b/src/packlib/kuip/kuip/kflag.h
deleted file mode 100644
index e909f6b..0000000
--- a/src/packlib/kuip/kuip/kflag.h
+++ /dev/null
@@ -1,148 +0,0 @@
-/*
- * $Id: kflag.h,v 1.1.1.1 1996/03/08 15:33:00 mclareni Exp $
- *
- * $Log: kflag.h,v $
- * Revision 1.1.1.1 1996/03/08 15:33:00 mclareni
- * Kuip
- *
- */
-
-typedef enum {
- KmMACRO_COMMAND = 0, /* don't look for macros */
- KmMACRO_AUTO, /* look for macros before commands */
- KmMACRO_AUTOREVERSE /* look for macros after commands */
-} KmMacOrder;
-
-typedef enum {
- KmSTYLE_A = 0x0001, /* Alpha menus */
- KmSTYLE_C = 0x0002, /* Command line */
- KmSTYLE_G = 0x0004, /* Graphics menus */
- KmSTYLE_M = 0x0008, /* Model Human Interface */
- KmSTYLE_XM = 0x0020, /* Motif/X11 */
- KmSTYLE_major = 0x00FF, /* A..X are mutually exclusive */
- KmSTYLE_xL = 0x0100, /* Alpha Letter menus */
- KmSTYLE_xP = 0x0200, /* Panel style GP or MP */
- KmSTYLE_xS = 0x0400, /* Graphics with Software fonts */
- KmSTYLE_xW = 0x0800 /* Graphics with shadowed Width */
-} KmStyleFlag;
-
-typedef enum {
- KmTIMING_OFF, /* no timing */
- KmTIMING_ON, /* time typed commands */
- KmTIMING_ALL /* time individual commands inside macro */
-} KmTiming;
-
-
-EXTERN struct {
- int do_exit; /* set by KXEXIT */
- int do_quit; /* set by KXQUIT */
- char *curr_prompt; /* current prompt string */
- char *last_cmd; /* last command for $LAST */
- KmTiming timing; /* timing on/off/all */
- time_t real_time; /* real time at last timing off */
- clock_t user_time; /* CPU time at last timing off */
- int in_macro; /* command executed in macro */
- int in_application; /* application mode is active */
- int appl_called; /* application is executing */
- char *appl_exit; /* string which leaves application mode */
- KmCommand *appl_cmd; /* command which handles application */
- char appl_file[256]; /* temporary file to pass application text */
- FILE *appl_stream; /* C stream used for writing appl_file */
- int appl_luno; /* Fortran logical unit opened for appl_file */
- char help_file[256]; /* temporary file to view help text */
- char uhlp_file[256]; /* temporary file to get user help text */
- int uhlp_luno; /* Fortran logical unit opened for user help */
- int in_motif; /* Motif mode is active */
- int action_nesting; /* levels of nested ku_exec() calls */
- int echo_command; /* echo commands in Motif mode */
- char *echo_prompt; /* prompt string for echo commands */
- KmStyleFlag style; /* input mode */
- int try_getenv; /* flag if $name should look-up environment */
- int keep_fcase; /* flag if no case conversion for filenames */
- int use_kxterm; /* flag if kxterm should be used */
- int use_server; /* flag if edit server should be used */
- int editor_exit; /* flag set if edit server sent SIGUSR1 */
- char *editor_cbuf; /* buffer of for edit servers commands */
- char *macro_path; /* MACRO/DEFAULT search path */
- KmMacOrder macro_search; /* MACRO/DEFAULT search order */
- int temp_vectors; /* number of ?SIGMA vectors */
- char init_wdir[256]; /* initial working directory */
- int vread_luno; /* Fortran logical unit for VECTOR/READ */
- int vwrite_luno; /* Fortran logical unit for VECTOR/WRITE */
- int trace_on; /* flag set by TRACE ON */
- int trace_wait; /* flag set by TRACE ON WAIT */
- int trace_wait_save; /* flag set by TRACE ON WAIT */
- int trace_full; /* flag set by TRACE ON FULL */
- int trace_debug; /* flag set by TRACE ON DEBUG */
- int trace_test; /* flag set by TRACE ON TEST */
- int quit_macro; /* flag set by WAIT command */
-} kc_flags;
-
-
-EXTERN struct {
- char *set_break; /* SET_SHOW/BREAK */
- char set_columns[8]; /* SET_SHOW/COLUMNS */
- char *set_command; /* SET_SHOW/COMMAND */
- char *set_dollar; /* SET_SHOW/DOLLAR */
- char *set_filecase; /* SET_SHOW/FILECASE */
- char *set_host_editor; /* SET_SHOW/HOST_EDITOR */
- char *set_host_psviewer; /* SET_SHOW/HOST_PSVIEWER */
- char *set_host_pager; /* SET_SHOW/HOST_PAGER */
- char *set_host_shell; /* SET_SHOW/HOST_SHELL */
- char *set_prompt; /* SET_SHOW/PROMPT */
- char *set_recall_style; /* SET_SHOW/RECALL_STYLE */
- char set_recording[8]; /* SET_SHOW/RECORDING */
- char *set_root; /* SET_SHOW/ROOT */
- const char *set_style; /* SET_SHOW/STYLE */
- char *set_timing; /* SET_SHOW/TIMING */
- char *help_edit; /* HELP edit mode */
- char *defaults_path; /* MACRO/DEFAULTS search path */
- char *defaults_order; /* MACRO/DEFAULTS search order */
- int idle_time; /* IDLE timer in seconds */
- char *idle_cmd; /* IDLE command */
- char **set_print_cmds; /* SET_SHOW/HOST_PRINTER commands */
- char **set_print_exts; /* ... depending on file extension */
-} kc_value;
-
-
-typedef struct {
- int top;
- int left;
- int width;
- int height;
-} KmWindowDsc;
-
-EXTERN struct {
- KmWindowDsc edit_pad; /* coordinates for edit window */
- KmWindowDsc help_pad; /* coordinates for readonly window */
- int voffset; /* vertical offset */
- int hoffset; /* horizontal offset */
- int shift_max; /* maximum number of shifted pads */
- int shift_now; /* current shift count */
- int shift_dir; /* shift direction +/-1 */
- int is_a_pad; /* flag if running in an Apollo DM pad */
- int is_a_tty; /* flag if stdin and stdout at terminal */
- int use_getline; /* flag for using getline() or normal read */
- int use_no_echo; /* flag for using no echo in password prompt */
- int term_width; /* terminal width in columns */
- int kuwhag_called; /* allow style G */
- float sgylen;
- float sgsize;
- float sgyspa;
- float sgbord;
- int panel_rows; /* number of rows in style GP panel */
- int *panel_cols; /* number of columns in each row */
- char ***panel_keys; /* key labels */
- char *panel_keynum; /* value of $KEYNUM */
- char *panel_keyval; /* value of $KEYVAL */
- char ***panel_icons; /* key icons */
- char ***panel_opts; /* key options */
- char *panel_title; /* panel title (given when displaying panel) */
- char *panel_name; /* panel name (given when starting panel) */
- int palette_flag; /* flag if palette is requested */
-} kc_window;
-
-
-extern const char* style_name( KmStyleFlag );
-
-
diff --git a/src/packlib/kuip/kuip/kfor.h b/src/packlib/kuip/kuip/kfor.h
deleted file mode 100644
index 541be5d..0000000
--- a/src/packlib/kuip/kuip/kfor.h
+++ /dev/null
@@ -1,1422 +0,0 @@
-/*
- * $Id: kfor.h,v 1.5 2006/09/15 09:35:30 mclareni Exp $
- *
- * $Log: kfor.h,v $
- * Revision 1.5 2006/09/15 09:35:30 mclareni
- * Submitted mods for gcc4/gfortran and MacOSX, corrected to work also on slc4 with gcc3.4 and 4.1
- *
- * Revision 1.4 1998/12/17 14:20:22 couet
- * - new routine kxdsig to delete the temporary vectors created
- * by $SIGMA. On NT a direct call to kuvdel didn't work
- *
- * Revision 1.3 1997/09/02 14:49:59 mclareni
- * WINNT corrections
- *
- * Revision 1.2 1997/03/14 17:16:37 mclareni
- * WNT mods
- *
- * Revision 1.1.1.1.2.1 1997/01/21 11:33:02 mclareni
- * All mods for Winnt 96a on winnt branch
- *
- * Revision 1.1.1.1 1996/03/08 15:33:00 mclareni
- * Kuip
- *
- */
-/* kfor.h: Fortran-C interface */
-
-/*
- * Fortran data types
- */
-typedef int INTEGER;
-typedef int LOGICAL;
-typedef float REAL;
-typedef double DBLPREC;
-typedef struct { REAL re; REAL im; } COMPLEX;
-
-typedef INTEGER INT_FUNCTION();
-typedef INT_FUNCTION *INT_FUNCPTR;
-
-#if defined(CERNLIB_WINNT) || defined(WIN32)
-# ifdef CERNLIB_MSSTDCALL
-# ifndef F77_EXTERN_UPPERCASE
-# define F77_EXTERN_UPPERCASE
-# endif
-# define type_of_call _stdcall
-# endif
-#endif
-
-#ifndef type_of_call
-#define type_of_call
-#endif
-
-typedef void (*SUBRPTR)();
-typedef void type_of_call SUBROUTINE();
-
-#ifdef IBM370
-#pragma linkage(SUBROUTINE,FORTRAN)
-#pragma linkage(INT_FUNCTION,FORTRAN)
-
-#pragma map(__CTOF,"@@CTOF")
-extern INTEGER __CTOF( INT_FUNCPTR, ... );
-#endif
-
-typedef union _EQUIV_INT_REAL {
- INTEGER i;
- LOGICAL l;
- REAL r;
-} EQUIV_INT_REAL;
-
-
-/*
- * Mapping of C-routine name for Fortran CALL SUB
- *
- * #define F77_EXTERN_LOWERCASE ==> void sub()
- * #define F77_EXTERN_UPPERCASE ==> void SUB()
- * otherwise ==> void sub_()
- */
-#ifdef F77_EXTERN_UPPERCASE
-# define F77_NAME(name,NAME) NAME
-#else
-# ifdef F77_EXTERN_LOWERCASE
-# define F77_NAME(name,NAME) name
-# else
-# define F77_NAME(name,NAME) ConCat(name,_)
-# endif
-#endif
-
-#ifndef F77_BLOCK
-# define F77_BLOCK(name,NAME) F77_NAME(name,NAME)
-#endif
-
-#ifndef F77_COMMON
-# define F77_COMMON(name) name
-#endif
-
-
-/*
- * Routine address in CALL SUB(FUN) ; EXTERNAL FUN
- *
- * #define F77_EXTERN_INDIRECT ==> void (**fun)();
- * otherwise ==> void (*fun)();
- */
-#ifdef F77_EXTERN_INDIRECT
-# define F77_EXTERN_ARG(e) ConCat(e,_ptr)
-# define F77_EXTERN_DCL(e) SUBROUTINE **ConCat(e,_ptr);
-# define F77_EXTERN_DEF(e) SUBROUTINE *e = *ConCat(e,_ptr);
-#else
-# define F77_EXTERN_ARG(e) e
-# define F77_EXTERN_DCL(e) SUBROUTINE *e;
-# define F77_EXTERN_DEF(e)
-#endif
-
-#define F77_EXTERN2ARG(e1,e2) F77_EXTERN_ARG(e1),F77_EXTERN_ARG(e2)
-#define F77_EXTERN2DCL(e1,e2) F77_EXTERN_DCL(e1) F77_EXTERN_DCL(e2)
-#define F77_EXTERN2DEF(e1,e2) F77_EXTERN_DEF(e1) F77_EXTERN_DEF(e2)
-
-#define F77_EXTERN3ARG(e1,e2,e3) F77_EXTERN_ARG(e1),F77_EXTERN2ARG(e2,e3)
-#define F77_EXTERN3DCL(e1,e2,e3) F77_EXTERN_DCL(e1) F77_EXTERN2DCL(e2,e3)
-#define F77_EXTERN3DEF(e1,e2,e3) F77_EXTERN_DEF(e1) F77_EXTERN2DEF(e2,e3)
-
-#define F77_EXTERN4ARG(e1,e2,e3,e4) F77_EXTERN_ARG(e1),F77_EXTERN3ARG(e2,e3,e4)
-#define F77_EXTERN4DCL(e1,e2,e3,e4) F77_EXTERN_DCL(e1) F77_EXTERN3DCL(e2,e3,e4)
-#define F77_EXTERN4DEF(e1,e2,e3,e4) F77_EXTERN_DEF(e1) F77_EXTERN3DEF(e2,e3,e4)
-
-
-#ifdef F77_ARG_CONSTANT
-
-/*
- * If the Fortran compiler (e.g. VSFORTRAN and Convex fc without -sa option)
- * uses constant argument blocks we have to make a private copy in case the
- * routine uses the arguments as local variables.
- */
-
-# define F77_XXXX_ARG_PTR(t,x) ConCat(x,_ptr)
-# define F77_XXXX_ARG_DCL(t,x) t *ConCat(x,_ptr);
-# define F77_XXXX_ARG_DEF(t,x) t *x = ConCat(x,_ptr);
-
-#else
-
-# define F77_XXXX_ARG_PTR(t,x) x
-# define F77_XXXX_ARG_DCL(t,x) t *x;
-# define F77_XXXX_ARG_DEF(t,x)
-
-#endif
-
-#define F77_REAL_ARG_PTR(r) F77_XXXX_ARG_PTR(REAL,r)
-#define F77_REAL_ARG_DCL(r) F77_XXXX_ARG_DCL(REAL,r)
-#define F77_REAL_ARG_DEF(r) F77_XXXX_ARG_DEF(REAL,r)
-
-#define F77_INTG_ARG_PTR(i) F77_XXXX_ARG_PTR(INTEGER,i)
-#define F77_INTG_ARG_DCL(i) F77_XXXX_ARG_DCL(INTEGER,i)
-#define F77_INTG_ARG_DEF(i) F77_XXXX_ARG_DEF(INTEGER,i)
-
-#define F77_INTG_ARG2PTR(i1,i2) F77_INTG_ARG_PTR(i1),F77_INTG_ARG_PTR(i2)
-#define F77_INTG_ARG2DCL(i1,i2) F77_INTG_ARG_DCL(i1) F77_INTG_ARG_DCL(i2)
-#define F77_INTG_ARG2DEF(i1,i2) F77_INTG_ARG_DEF(i1) F77_INTG_ARG_DEF(i2)
-
-#define F77_INTG_ARG3PTR(i1,i2,i3) F77_INTG_ARG_PTR(i1),F77_INTG_ARG2PTR(i2,i3)
-#define F77_INTG_ARG3DCL(i1,i2,i3) F77_INTG_ARG_DCL(i1) F77_INTG_ARG2DCL(i2,i3)
-#define F77_INTG_ARG3DEF(i1,i2,i3) F77_INTG_ARG_DEF(i1) F77_INTG_ARG2DEF(i2,i3)
-
-#define F77_INTG_ARG4PTR(i1,i2,i3,i4) F77_INTG_ARG_PTR(i1), \
- F77_INTG_ARG3PTR(i2,i3,i4)
-#define F77_INTG_ARG4DCL(i1,i2,i3,i4) F77_INTG_ARG_DCL(i1) \
- F77_INTG_ARG3DCL(i2,i3,i4)
-#define F77_INTG_ARG4DEF(i1,i2,i3,i4) F77_INTG_ARG_DEF(i1) \
- F77_INTG_ARG3DEF(i2,i3,i4)
-
-
-/*
- * Access to Fortran CHARACTER arguments
- */
-
-#ifdef vms /* VMS string descriptors */
-
-
-# define F77_CHAR_ARG_PTR(s) ConCat(s,_ptr)
-# define F77_CHAR_ARG_LEN(s)
-# define F77_CHAR_ARG_DCL(s) struct dsc$descriptor_s *ConCat(s,_ptr);
-# define F77_CHAR_ARG_DEF(s) char *s = ConCat(s,_ptr)->dsc$a_pointer; \
- int ConCat(len_,s) = ConCat(s,_ptr)->dsc$w_length;
-
-# define F77_CHAR_DEF_DSC(s,p,l) struct dsc$descriptor_s ConCat(s,_dsc);
-# define F77_CHAR_ASS_DSC(s,p,l) ConCat(s,_dsc).dsc$w_length = l; \
- ConCat(s,_dsc).dsc$b_dtype = DSC$K_DTYPE_T;\
- ConCat(s,_dsc).dsc$b_class = DSC$K_CLASS_S;\
- ConCat(s,_dsc).dsc$a_pointer = (char*)p;
-# define F77_CHAR_USE_PTR(s,p,l) &ConCat(s,_dsc)
-# define F77_CHAR_USE_LEN(s,p,l)
-
-
-#else
-#ifdef CRAY /* Cray string descriptors */
-
-
-# define F77_CHAR_ARG_PTR(s) ConCat(s,_ptr)
-# define F77_CHAR_ARG_LEN(s)
-# define F77_CHAR_ARG_DCL(s) _fcd ConCat(s,_ptr);
-# define F77_CHAR_ARG_DEF(s) char *s = _fcdtocp(ConCat(s,_ptr)); \
- int ConCat(len_,s) = _fcdlen(ConCat(s,_ptr));
-
-# define F77_CHAR_DEF_DSC(s,p,l)
-# define F77_CHAR_ASS_DSC(s,p,l)
-# define F77_CHAR_USE_PTR(s,p,l) _cptofcd(p,l)
-# define F77_CHAR_USE_LEN(s,p,l)
-
-
-#else /* length passed as additional argument */
-
-
-# ifdef F77_CHAR_LEN_IND /* length passed by reference */
-# define F77_CHAR_LEN_STAR(len) *len
-# else
-# define F77_CHAR_LEN_STAR(len) len
-# endif
-
-# ifndef F77_CHAR_LEN_TYPE
-# define F77_CHAR_LEN_TYPE int
-# endif
-
-
-# ifdef F77_ARG_CONSTANT
-
-# define F77_CHAR_ARG_PTR(s) ConCat(s,_ptr)
-# define F77_CHAR_ARG_LEN(s) , ConCat(s,_len)
-# define F77_CHAR_ARG_DCL(s) char *ConCat(s,_ptr); \
- F77_CHAR_LEN_TYPE F77_CHAR_LEN_STAR(ConCat(s,_len));
-# define F77_CHAR_ARG_DEF(s) char *s = ConCat(s,_ptr); \
- int ConCat(len_,s) = F77_CHAR_LEN_STAR(ConCat(s,_len));
-
-# else
-# ifdef F77_CHAR_LEN_IND
-
-# define F77_CHAR_ARG_PTR(s) s
-# define F77_CHAR_ARG_LEN(s) , ConCat(s,_len)
-# define F77_CHAR_ARG_DCL(s) char *s; \
- F77_CHAR_LEN_TYPE F77_CHAR_LEN_STAR(ConCat(s,_len));
-# define F77_CHAR_ARG_DEF(s) \
- int ConCat(len_,s) = F77_CHAR_LEN_STAR(ConCat(s,_len));
-
-# else
-
-# ifdef CERNLIB_MSSTDCALL
-# define F77_CHAR_ARG_PTR(s) s, ConCat(len_,s)
-# define F77_CHAR_ARG_LEN(s)
-# else
-# define F77_CHAR_ARG_PTR(s) s
-# define F77_CHAR_ARG_LEN(s) , ConCat(len_,s)
-# endif
-
-# define F77_CHAR_ARG_DCL(s) char *s; int ConCat(len_,s);
-# define F77_CHAR_ARG_DEF(s)
-
-# endif
-# endif
-
-
-# if defined(F77_CHAR_LEN_IND)
-
-# define F77_CHAR_DEF_DSC(s,p,l) F77_CHAR_LEN_TYPE ConCat(s,_dsc) = l;
-# define F77_CHAR_ASS_DSC(s,p,l)
-# define F77_CHAR_USE_PTR(s,p,l) p
-# define F77_CHAR_USE_LEN(s,p,l) , &ConCat(s,_dsc)
-
-# else
-
-# define F77_CHAR_DEF_DSC(s,p,l)
-# define F77_CHAR_ASS_DSC(s,p,l)
-
-# ifndef CERNLIB_MSSTDCALL
-# define F77_CHAR_USE_PTR(s,p,l) p
-# define F77_CHAR_USE_LEN(s,p,l) , l
-# else
-# define F77_CHAR_USE_PTR(s,p,l) p, l
-# define F77_CHAR_USE_LEN(s,p,l)
-# endif
-
-
-# endif
-
-#endif
-#endif
-
-
-#ifndef F77_XXXX_ARG_LEN /* length argument of non-CHARACTER arguments */
-
-# define F77_XXXX_ARG_LEN(x) /* nil */
-# define F77_XXXX_USE_LEN(x) /* nil */
-
-#endif
-
-
-#define F77_CHAR_ARG2PTR(c1,c2) \
- F77_CHAR_ARG_PTR(c1),F77_CHAR_ARG_PTR(c2)
-#define F77_CHAR_ARG2LEN(c1,c2) \
- F77_CHAR_ARG_LEN(c1) F77_CHAR_ARG_LEN(c2)
-#define F77_XXXX_ARG2LEN(c1,c2) \
- F77_XXXX_ARG_LEN(c1) F77_XXXX_ARG_LEN(c2)
-#define F77_CHAR_ARG2DCL(c1,c2) \
- F77_CHAR_ARG_DCL(c1) F77_CHAR_ARG_DCL(c2)
-#define F77_CHAR_ARG2DEF(c1,c2) \
- F77_CHAR_ARG_DEF(c1) F77_CHAR_ARG_DEF(c2)
-
-#define F77_CHAR_ARG3PTR(c1,c2,c3) \
- F77_CHAR_ARG2PTR(c1,c2),F77_CHAR_ARG_PTR(c3)
-#define F77_CHAR_ARG3LEN(c1,c2,c3) \
- F77_CHAR_ARG2LEN(c1,c2) F77_CHAR_ARG_LEN(c3)
-#define F77_XXXX_ARG3LEN(c1,c2,c3) \
- F77_XXXX_ARG2LEN(c1,c2) F77_XXXX_ARG_LEN(c3)
-#define F77_CHAR_ARG3DCL(c1,c2,c3) \
- F77_CHAR_ARG2DCL(c1,c2) F77_CHAR_ARG_DCL(c3)
-#define F77_CHAR_ARG3DEF(c1,c2,c3) \
- F77_CHAR_ARG2DEF(c1,c2) F77_CHAR_ARG_DEF(c3)
-
-#define F77_CHAR_ARG4PTR(c1,c2,c3,c4) \
- F77_CHAR_ARG3PTR(c1,c2,c3),F77_CHAR_ARG_PTR(c4)
-#define F77_CHAR_ARG4LEN(c1,c2,c3,c4) \
- F77_CHAR_ARG3LEN(c1,c2,c3) F77_CHAR_ARG_LEN(c4)
-#define F77_XXXX_ARG4LEN(c1,c2,c3,c4) \
- F77_XXXX_ARG3LEN(c1,c2,c3) F77_XXXX_ARG_LEN(c4)
-#define F77_CHAR_ARG4DCL(c1,c2,c3,c4) \
- F77_CHAR_ARG3DCL(c1,c2,c3) F77_CHAR_ARG_DCL(c4)
-#define F77_CHAR_ARG4DEF(c1,c2,c3,c4) \
- F77_CHAR_ARG3DEF(c1,c2,c3) F77_CHAR_ARG_DEF(c4)
-
-#define F77_CHAR_ARG5PTR(c1,c2,c3,c4,c5) \
- F77_CHAR_ARG4PTR(c1,c2,c3,c4),F77_CHAR_ARG_PTR(c5)
-#define F77_CHAR_ARG5LEN(c1,c2,c3,c4,c5) \
- F77_CHAR_ARG4LEN(c1,c2,c3,c4) F77_CHAR_ARG_LEN(c5)
-#define F77_CHAR_ARG5DCL(c1,c2,c3,c4,c5) \
- F77_CHAR_ARG4DCL(c1,c2,c3,c4) F77_CHAR_ARG_DCL(c5)
-#define F77_CHAR_ARG5DEF(c1,c2,c3,c4,c5) \
- F77_CHAR_ARG4DEF(c1,c2,c3,c4) F77_CHAR_ARG_DEF(c5)
-
-
-/*
- * Fortran-calls-C interface
- *
- * To define a C function called by Fortran CALL SUB(A,B,C):
- *
- * #define Sub F77_NAME(sub,SUB)
- * #pragma linkage(SUB,FORTRAN) // for IBM C/370 compiler
- *
- * F77_ENTRY_xyz(Sub,a,b,c) // opening { contained in macro
- * // body ...
- * }
- *
- * Each character in xyz declares the type of the corresponding parameter:
- *
- * C = CHARACTER
- * E = EXTERNAL
- * I = INTEGER
- * R = REAL
- *
- * If a parameter PAR is declared as CHARACTER the macro defines:
- *
- * char *PAR; // pointer to string (not terminated by \0 !!!)
- * int len_PAR; // length of string as defined by Fortran's LEN(PAR)
- *
- * The names PAR_dsc and PAR_ptr are reserved for internal use.
- *
- * Note: The function body follows the F77_ENTRY_... macro call directly.
- * The opening { is generated by the macro.
- */
-
-#define F77_ENTRY(name) \
- type_of_call \
- name() {
-
-#define F77_ENTRY_C(name,c1) \
- type_of_call \
- name( F77_CHAR_ARG_PTR(c1) F77_CHAR_ARG_LEN(c1) ) \
- F77_CHAR_ARG_DCL(c1) \
- { F77_CHAR_ARG_DEF(c1)
-
-
-#define F77_ENTRY_CC(name,c1,c2) \
- type_of_call \
- name( F77_CHAR_ARG2PTR(c1,c2) F77_CHAR_ARG2LEN(c1,c2) ) \
- F77_CHAR_ARG2DCL(c1,c2) \
- { F77_CHAR_ARG2DEF(c1,c2)
-
-
-#define F77_ENTRY_C3(name,c1,c2,c3) \
- type_of_call \
- name( F77_CHAR_ARG3PTR(c1,c2,c3) \
- F77_CHAR_ARG3LEN(c1,c2,c3) ) \
- F77_CHAR_ARG3DCL(c1,c2,c3) \
- { F77_CHAR_ARG3DEF(c1,c2,c3)
-
-
-#define F77_ENTRY_C5(name,c1,c2,c3,c4,c5) \
- type_of_call \
- name( F77_CHAR_ARG5PTR(c1,c2,c3,c4,c5) \
- F77_CHAR_ARG5LEN(c1,c2,c3,c4,c5) ) \
- F77_CHAR_ARG5DCL(c1,c2,c3,c4,c5) \
- { F77_CHAR_ARG5DEF(c1,c2,c3,c4,c5)
-
-
-#define F77_ENTRY_C4E(name,c1,c2,c3,c4,e5) \
- type_of_call \
- name( F77_CHAR_ARG4PTR(c1,c2,c3,c4),F77_EXTERN_ARG(e5) \
- F77_CHAR_ARG4LEN(c1,c2,c3,c4) ) \
- F77_CHAR_ARG4DCL(c1,c2,c3,c4) F77_EXTERN_DCL(e5) \
- { F77_CHAR_ARG4DEF(c1,c2,c3,c4) F77_EXTERN_DEF(e5)
-
-
-#define F77_ENTRY_C4I(name,c1,c2,c3,c4,i5) \
- type_of_call \
- name( F77_CHAR_ARG4PTR(c1,c2,c3,c4),F77_INTG_ARG_PTR(i5) \
- F77_CHAR_ARG4LEN(c1,c2,c3,c4) ) \
- F77_CHAR_ARG4DCL(c1,c2,c3,c4) F77_INTG_ARG_DCL(i5) \
- { F77_CHAR_ARG4DEF(c1,c2,c3,c4) F77_INTG_ARG_DEF(i5)
-
-
-#define F77_ENTRY_C5E(name,c1,c2,c3,c4,c5,e6) \
- type_of_call \
- name( F77_CHAR_ARG5PTR(c1,c2,c3,c4,c5),F77_EXTERN_ARG(e6) \
- F77_CHAR_ARG5LEN(c1,c2,c3,c4,c5) ) \
- F77_CHAR_ARG5DCL(c1,c2,c3,c4,c5) F77_EXTERN_DCL(e6) \
- { F77_CHAR_ARG5DEF(c1,c2,c3,c4,c5) F77_EXTERN_DEF(e6)
-
-
-#define F77_ENTRY_CCE(name,c1,c2,e3) \
- type_of_call \
- name( F77_CHAR_ARG2PTR(c1,c2),F77_EXTERN_ARG(e3) \
- F77_CHAR_ARG2LEN(c1,c2) ) \
- F77_CHAR_ARG2DCL(c1,c2) F77_EXTERN_DCL(e3) \
- { F77_CHAR_ARG2DEF(c1,c2) F77_EXTERN_DEF(e3)
-
-
-#define F77_ENTRY_CCEE(name,c1,c2,e3,e4) \
- type_of_call \
- name( F77_CHAR_ARG2PTR(c1,c2),F77_EXTERN2ARG(e3,e4) \
- F77_CHAR_ARG2LEN(c1,c2) ) \
- F77_CHAR_ARG2DCL(c1,c2) F77_EXTERN2DCL(e3,e4) \
- { F77_CHAR_ARG2DEF(c1,c2) F77_EXTERN2DEF(e3,e4)
-
-
-#define F77_ENTRY_CCI(name,c1,c2,i3) \
- type_of_call \
- name( F77_CHAR_ARG2PTR(c1,c2),F77_INTG_ARG_PTR(i3) \
- F77_CHAR_ARG2LEN(c1,c2) ) \
- F77_CHAR_ARG2DCL(c1,c2) F77_INTG_ARG_DCL(i3) \
- { F77_CHAR_ARG2DEF(c1,c2) F77_INTG_ARG_DEF(i3)
-
-
-#define F77_ENTRY_CCIC(name,c1,c2,i3,c4) \
- type_of_call \
- name( F77_CHAR_ARG2PTR(c1,c2),F77_INTG_ARG_PTR(i3),F77_CHAR_ARG_PTR(c4) \
- F77_CHAR_ARG2LEN(c1,c2) F77_XXXX_ARG_LEN(i3) F77_CHAR_ARG_LEN(c4) ) \
- F77_CHAR_ARG3DCL(c1,c2,c4) F77_INTG_ARG_DCL(i3) \
- { F77_CHAR_ARG3DEF(c1,c2,c4) F77_INTG_ARG_DEF(i3)
-
-
-#define F77_ENTRY_CCI3(name,c1,c2,i3,i4,i5) \
- type_of_call \
- name( F77_CHAR_ARG2PTR(c1,c2),F77_INTG_ARG3PTR(i3,i4,i5) \
- F77_CHAR_ARG2LEN(c1,c2) ) \
- F77_CHAR_ARG2DCL(c1,c2) F77_INTG_ARG3DCL(i3,i4,i5) \
- { F77_CHAR_ARG2DEF(c1,c2) F77_INTG_ARG3DEF(i3,i4,i5)
-
-
-#define F77_ENTRY_CCIRCC(name,c1,c2,i3,r4,c5,c6) \
- type_of_call \
- name( F77_CHAR_ARG2PTR(c1,c2), \
- F77_INTG_ARG_PTR(i3),F77_REAL_ARG_PTR(r4),F77_CHAR_ARG2PTR(c5,c6) \
- F77_CHAR_ARG2LEN(c1,c2) \
- F77_XXXX_ARG2LEN(i3,r4) F77_CHAR_ARG2LEN(c5,c6) ) \
- F77_CHAR_ARG4DCL(c1,c2,c5,c6) \
- F77_INTG_ARG_DCL(i3) F77_REAL_ARG_DCL(r4) \
- { F77_CHAR_ARG4DEF(c1,c2,c5,c6) \
- F77_INTG_ARG_DEF(i3) F77_REAL_ARG_DEF(r4) \
-
-
-#define F77_ENTRY_CE(name,c1,e2) \
- type_of_call \
- name( F77_CHAR_ARG_PTR(c1),F77_EXTERN_ARG(e2) \
- F77_CHAR_ARG_LEN(c1) ) \
- F77_CHAR_ARG_DCL(c1) F77_EXTERN_DCL(e2) \
- { F77_CHAR_ARG_DEF(c1) F77_EXTERN_DEF(e2)
-
-
-#define F77_ENTRY_CI(name,c1,i2) \
- type_of_call \
- name( F77_CHAR_ARG_PTR(c1),F77_INTG_ARG_PTR(i2) \
- F77_CHAR_ARG_LEN(c1) ) \
- F77_CHAR_ARG_DCL(c1) F77_INTG_ARG_DCL(i2) \
- { F77_CHAR_ARG_DEF(c1) F77_INTG_ARG_DEF(i2)
-
-
-#define F77_ENTRY_CICI(name,c1,i2,c3,i4) \
- type_of_call \
- name( F77_CHAR_ARG_PTR(c1),F77_INTG_ARG_PTR(i2), \
- F77_CHAR_ARG_PTR(c3),F77_INTG_ARG_PTR(i4) \
- F77_CHAR_ARG_LEN(c1) F77_XXXX_ARG_LEN(i2) \
- F77_CHAR_ARG_LEN(c3) ) \
- F77_CHAR_ARG2DCL(c1,c3) F77_INTG_ARG2DCL(i2,i4) \
- { F77_CHAR_ARG2DEF(c1,c3) F77_INTG_ARG2DEF(i2,i4)
-
-
-#define F77_ENTRY_CII(name,c1,i2,i3) \
- type_of_call \
- name( F77_CHAR_ARG_PTR(c1),F77_INTG_ARG2PTR(i2,i3) \
- F77_CHAR_ARG_LEN(c1) ) \
- F77_CHAR_ARG_DCL(c1) F77_INTG_ARG2DCL(i2,i3) \
- { F77_CHAR_ARG_DEF(c1) F77_INTG_ARG2DEF(i2,i3)
-
-
-#define F77_ENTRY_CIIC(name,c1,i2,i3,c4) \
- type_of_call \
- name( F77_CHAR_ARG_PTR(c1),F77_INTG_ARG2PTR(i2,i3),F77_CHAR_ARG_PTR(c4) \
- F77_CHAR_ARG_LEN(c1) F77_XXXX_ARG2LEN(i2,i3) F77_CHAR_ARG_LEN(c4) ) \
- F77_CHAR_ARG2DCL(c1,c4) F77_INTG_ARG2DCL(i2,i3) \
- { F77_CHAR_ARG2DEF(c1,c4) F77_INTG_ARG2DEF(i2,i3)
-
-
-#define F77_ENTRY_CR(name,c1,r2) \
- type_of_call \
- name( F77_CHAR_ARG_PTR(c1),F77_REAL_ARG_PTR(r2) \
- F77_CHAR_ARG_LEN(c1) ) \
- F77_CHAR_ARG_DCL(c1) F77_REAL_ARG_DCL(r2) \
- { F77_CHAR_ARG_DEF(c1) F77_REAL_ARG_DEF(r2)
-
-#define F77_ENTRY_R(name,r1) \
- type_of_call \
- name( F77_REAL_ARG_PTR(r1) ) \
- F77_REAL_ARG_DCL(r1) \
- { F77_REAL_ARG_DEF(r1)
-
-#define F77_ENTRY_E(name,e1) \
- type_of_call \
- name( F77_EXTERN_ARG(e1) ) \
- F77_EXTERN_DCL(e1) \
- { F77_EXTERN_DEF(e1)
-
-
-#define F77_ENTRY_E4(name,e1,e2,e3,e4) \
- type_of_call \
- name( F77_EXTERN4ARG(e1,e2,e3,e4) ) \
- F77_EXTERN4DCL(e1,e2,e3,e4) \
- { F77_EXTERN4DEF(e1,e2,e3,e4)
-
-#define F77_ENTRY_I(name,i1) \
- type_of_call \
- name( F77_INTG_ARG_PTR(i1) ) \
- F77_INTG_ARG_DCL(i1) \
- { F77_INTG_ARG_DEF(i1)
-
-#define F77_ENTRY_IC(name,i1,c2) \
- type_of_call \
- name( F77_INTG_ARG_PTR(i1),F77_CHAR_ARG_PTR(c2) \
- F77_XXXX_ARG_LEN(i1) F77_CHAR_ARG_LEN(c2) ) \
- F77_INTG_ARG_DCL(i1) F77_CHAR_ARG_DCL(c2) \
- { F77_INTG_ARG_DEF(i1) F77_CHAR_ARG_DEF(c2)
-
-
-#define F77_ENTRY_ICI(name,i1,c2,i3) \
- type_of_call \
- name( F77_INTG_ARG_PTR(i1), F77_CHAR_ARG_PTR(c2),F77_INTG_ARG_PTR(i3) \
- F77_XXXX_ARG_LEN(i1) F77_CHAR_ARG_LEN(c2) ) \
- F77_INTG_ARG2DCL(i1,i3) F77_CHAR_ARG_DCL(c2) \
- { F77_INTG_ARG2DEF(i1,i3) F77_CHAR_ARG_DEF(c2)
-
-
-#define F77_ENTRY_IIC(name,i1,i2,c3) \
- type_of_call \
- name( F77_INTG_ARG2PTR(i1,i2),F77_CHAR_ARG_PTR(c3) \
- F77_XXXX_ARG2LEN(i1,i2) F77_CHAR_ARG_LEN(c3) ) \
- F77_INTG_ARG2DCL(i1,i2) F77_CHAR_ARG_DCL(c3) \
- { F77_INTG_ARG2DEF(i1,i2) F77_CHAR_ARG_DEF(c3)
-
-
-#define F77_ENTRY_I3C(name,i1,i2,i3,c4) \
- type_of_call \
- name( F77_INTG_ARG3PTR(i1,i2,i3),F77_CHAR_ARG_PTR(c4) \
- F77_XXXX_ARG3LEN(i1,i2,i3) F77_CHAR_ARG_LEN(c4) ) \
- F77_INTG_ARG3DCL(i1,i2,i3) F77_CHAR_ARG_DCL(c4) \
- { F77_INTG_ARG3DEF(i1,i2,i3) F77_CHAR_ARG_DEF(c4)
-
-
-#define F77_ENTRY_I4CCC(name,i1,i2,i3,i4,c5,c6,c7) \
- type_of_call \
- name( F77_INTG_ARG4PTR(i1,i2,i3,i4),F77_CHAR_ARG3PTR(c5,c6,c7) \
- F77_XXXX_ARG4LEN(i1,i2,i3,i4) F77_CHAR_ARG3LEN(c5,c6,c7) ) \
- F77_INTG_ARG4DCL(i1,i2,i3,i4) F77_CHAR_ARG3DCL(c5,c6,c7) \
- { F77_INTG_ARG4DEF(i1,i2,i3,i4) F77_CHAR_ARG3DEF(c5,c6,c7)
-
-
-#define F77_CHAR_DEF2DSC(s1,p1,l1,s2,p2,l2) \
- F77_CHAR_DEF_DSC(s1,p1,l1) F77_CHAR_DEF_DSC(s2,p2,l2)
-#define F77_CHAR_ASS2DSC(s1,p1,l1,s2,p2,l2) \
- F77_CHAR_ASS_DSC(s1,p1,l1) F77_CHAR_ASS_DSC(s2,p2,l2)
-#define F77_CHAR_USE2PTR(s1,p1,l1,s2,p2,l2) \
- F77_CHAR_USE_PTR(s1,p1,l1),F77_CHAR_USE_PTR(s2,p2,l2)
-#define F77_CHAR_USE2LEN(s1,p1,l1,s2,p2,l2) \
- F77_CHAR_USE_LEN(s1,p1,l1) F77_CHAR_USE_LEN(s2,p2,l2)
-#define F77_XXXX_USE2LEN(x1,x2) \
- F77_XXXX_USE_LEN(x1) F77_XXXX_USE_LEN(x2)
-
-
-#define F77_CHAR_DEF3DSC(s1,p1,l1,s2,p2,l2,s3,p3,l3) \
- F77_CHAR_DEF2DSC(s1,p1,l1,s2,p2,l2) F77_CHAR_DEF_DSC(s3,p3,l3)
-#define F77_CHAR_ASS3DSC(s1,p1,l1,s2,p2,l2,s3,p3,l3) \
- F77_CHAR_ASS2DSC(s1,p1,l1,s2,p2,l2) F77_CHAR_ASS_DSC(s3,p3,l3)
-#define F77_CHAR_USE3PTR(s1,p1,l1,s2,p2,l2,s3,p3,l3) \
- F77_CHAR_USE2PTR(s1,p1,l1,s2,p2,l2),F77_CHAR_USE_PTR(s3,p3,l3)
-#define F77_CHAR_USE3LEN(s1,p1,l1,s2,p2,l2,s3,p3,l3) \
- F77_CHAR_USE2LEN(s1,p1,l1,s2,p2,l2) F77_CHAR_USE_LEN(s3,p3,l3)
-#define F77_XXXX_USE3LEN(x1,x2,x3) \
- F77_XXXX_USE2LEN(x1,x2) F77_XXXX_USE_LEN(x3)
-
-
-#define F77_CHAR_DEF4DSC(s1,p1,l1,s2,p2,l2,s3,p3,l3,s4,p4,l4) \
- F77_CHAR_DEF3DSC(s1,p1,l1,s2,p2,l2,s3,p3,l3) F77_CHAR_DEF_DSC(s4,p4,l4)
-#define F77_CHAR_ASS4DSC(s1,p1,l1,s2,p2,l2,s3,p3,l3,s4,p4,l4) \
- F77_CHAR_ASS3DSC(s1,p1,l1,s2,p2,l2,s3,p3,l3) F77_CHAR_ASS_DSC(s4,p4,l4)
-#define F77_CHAR_USE4PTR(s1,p1,l1,s2,p2,l2,s3,p3,l3,s4,p4,l4) \
- F77_CHAR_USE3PTR(s1,p1,l1,s2,p2,l2,s3,p3,l3),F77_CHAR_USE_PTR(s4,p4,l4)
-#define F77_CHAR_USE4LEN(s1,p1,l1,s2,p2,l2,s3,p3,l3,s4,p4,l4) \
- F77_CHAR_USE3LEN(s1,p1,l1,s2,p2,l2,s3,p3,l3) F77_CHAR_USE_LEN(s4,p4,l4)
-#define F77_XXXX_USE4LEN(x1,x2,x3,x4) \
- F77_XXXX_USE3LEN(x1,x2,x3) F77_XXXX_USE_LEN(x4)
-
-
-#define F77_XXXX_USE5LEN(x1,x2,x3,x4,x5) \
- F77_XXXX_USE4LEN(x1,x2,x3,x4) F77_XXXX_USE_LEN(x5)
-
-
-#define F77_XXXX_USE6LEN(x1,x2,x3,x4,x5,x6) \
- F77_XXXX_USE5LEN(x1,x2,x3,x4,x5) F77_XXXX_USE_LEN(x6)
-
-
-#define F77_XXXX_USE7LEN(x1,x2,x3,x4,x5,x6,x7) \
- F77_XXXX_USE6LEN(x1,x2,x3,x4,x5,x6) F77_XXXX_USE_LEN(x7)
-
-
-#define F77_XXXX_USE8LEN(x1,x2,x3,x4,x5,x6,x7,x8) \
- F77_XXXX_USE7LEN(x1,x2,x3,x4,x5,x6,x7) F77_XXXX_USE_LEN(x8)
-
-
-EXTERN INTEGER F77_i0; /* dummy */
-
-#ifdef IBM370
-#pragma linkage(K77C,FORTRAN)
-#define F77_IFUN_C(i0,name,p1,l1) do { \
- i0 = K77C(&name,p1,l1); } while(0)
-#else
-#define F77_IFUN_C(i0,name,p1,l1) do { \
- F77_CHAR_DEF_DSC(s1,p1,l1) \
- F77_CHAR_ASS_DSC(s1,p1,l1) \
- i0 = (*name)( \
- F77_CHAR_USE_PTR(s1,p1,l1) \
- F77_CHAR_USE_LEN(s1,p1,l1) \
- ); } while(0)
-#endif
-#define F77_CALL_C(name,p1,l1) do { \
- INT_FUNCPTR _p0_ = (INT_FUNCPTR)name; \
- F77_IFUN_C(F77_i0,_p0_,p1,l1); \
- } while(0)
-
-
-#ifdef IBM370
-#pragma linkage(K77CC,FORTRAN)
-#define F77_IFUN_CC(i0,name,p1,l1,p2,l2) do { \
- i0 = K77CC(&name,p1,l1,p2,l2); } while(0)
-#else
-#define F77_IFUN_CC(i0,name,p1,l1,p2,l2) do { \
- F77_CHAR_DEF2DSC(s1,p1,l1,s2,p2,l2) \
- F77_CHAR_ASS2DSC(s1,p1,l1,s2,p2,l2) \
- i0 = (*name)( \
- F77_CHAR_USE2PTR(s1,p1,l1,s2,p2,l2) \
- F77_CHAR_USE2LEN(s1,p1,l1,s2,p2,l2) \
- ); } while(0)
-#endif
-#define F77_CALL_CC(name,p1,l1,p2,l2) do { \
- INT_FUNCPTR _p0_ = (INT_FUNCPTR)name; \
- F77_IFUN_CC(F77_i0,_p0_,p1,l1,p2,l2); \
- } while(0)
-
-
-#ifdef IBM370
-#pragma linkage(K77C3,FORTRAN)
-#define F77_IFUN_C3(i0,name,p1,l1,p2,l2,p3,l3) do { \
- i0 = K77C3(&name,p1,l1,p2,l2,p3,l3); } while(0)
-#else
-#define F77_IFUN_C3(i0,name,p1,l1,p2,l2,p3,l3) do { \
- F77_CHAR_DEF3DSC(s1,p1,l1,s2,p2,l2,s3,p3,l3) \
- F77_CHAR_ASS3DSC(s1,p1,l1,s2,p2,l2,s3,p3,l3) \
- i0 = (*name)( \
- F77_CHAR_USE3PTR(s1,p1,l1,s2,p2,l2,s3,p3,l3) \
- F77_CHAR_USE3LEN(s1,p1,l1,s2,p2,l2,s3,p3,l3) \
- ); } while(0)
-#endif
-#define F77_CALL_C3(name,p1,l1,p2,l2,p3,l3) do { \
- INT_FUNCPTR _p0_ = (INT_FUNCPTR)name; \
- F77_IFUN_C3(F77_i0,_p0_,p1,l1,p2,l2,p3,l3); \
- } while(0)
-
-
-#ifdef IBM370
-#pragma linkage(K77C7,FORTRAN)
-#define F77_IFUN_C7(i0,name,p1,l1,p2,l2,p3,l3,p4,l4,p5,l5,p6,l6,p7,l7) do { \
- i0 = K77C7(&name,p1,l1,p2,l2,p3,l3,p4,l4,p5,l5,p6,l6,p7,l7); } while(0)
-#else
-#define F77_IFUN_C7(i0,name,p1,l1,p2,l2,p3,l3,p4,l4,p5,l5,p6,l6,p7,l7) do { \
- F77_CHAR_DEF4DSC(s1,p1,l1,s2,p2,l2,s3,p3,l3,s4,p4,l4) \
- F77_CHAR_DEF3DSC(s5,p5,l5,s6,p6,l6,s7,p7,l7) \
- F77_CHAR_ASS4DSC(s1,p1,l1,s2,p2,l2,s3,p3,l3,s4,p4,l4) \
- F77_CHAR_ASS3DSC(s5,p5,l5,s6,p6,l6,s7,p7,l7) \
- i0 = (*name)( \
- F77_CHAR_USE4PTR(s1,p1,l1,s2,p2,l2,s3,p3,l3,s4,p4,l4), \
- F77_CHAR_USE3PTR(s5,p5,l5,s6,p6,l6,s7,p7,l7) \
- F77_CHAR_USE4LEN(s1,p1,l1,s2,p2,l2,s3,p3,l3,s4,p4,l4) \
- F77_CHAR_USE3LEN(s5,p5,l5,s6,p6,l6,s7,p7,l7) \
- ); } while(0)
-#endif
-#define F77_CALL_C7(name,p1,l1,p2,l2,p3,l3,p4,l4,p5,l5,p6,l6,p7,l7) do { \
- INT_FUNCPTR _p0_ = (INT_FUNCPTR)name; \
- F77_IFUN_C7(F77_i0,_p0_,p1,l1,p2,l2,p3,l3,p4,l4,p5,l5,p6,l6,p7,l7); \
- } while(0)
-
-
-#ifdef IBM370
-#pragma linkage(K77CCx,FORTRAN)
-#define F77_CALL_CCx(name,p1,l1,p2,l2,x3) do { \
- SUBROUTINE *F77 = name; \
- K77CCx(&F77,p1,l1,p2,l2,x3); } while(0)
-#else
-#define F77_CALL_CCx(name,p1,l1,p2,l2,x3) do { \
- F77_CHAR_DEF2DSC(s1,p1,l1,s2,p2,l2) \
- F77_CHAR_ASS2DSC(s1,p1,l1,s2,p2,l2) \
- name( F77_CHAR_USE2PTR(s1,p1,l1,s2,p2,l2), \
- x3 \
- F77_CHAR_USE2LEN(s1,p1,l1,s2,p2,l2) \
- F77_XXXX_USE_LEN(x3) \
- ); } while(0)
-#endif
-
-
-#ifdef IBM370
-#pragma linkage(K77CCxx,FORTRAN)
-#define F77_IFUN_CCxx(i0,name,p1,l1,p2,l2,x3,x4) do { \
- i0 = K77CCxx(&name,p1,l1,p2,l2,x3,x4); } while(0)
-#else
-#define F77_IFUN_CCxx(i0,name,p1,l1,p2,l2,x3,x4) do { \
- F77_CHAR_DEF2DSC(s1,p1,l1,s2,p2,l2) \
- F77_CHAR_ASS2DSC(s1,p1,l1,s2,p2,l2) \
- i0 = (*name)( \
- F77_CHAR_USE2PTR(s1,p1,l1,s2,p2,l2), \
- x3,x4 \
- F77_CHAR_USE2LEN(s1,p1,l1,s2,p2,l2) \
- ); } while(0)
-#endif
-#define F77_CALL_CCxx(name,p1,l1,p2,l2,x3,x4) do { \
- INT_FUNCPTR _p0_ = (INT_FUNCPTR)name; \
- F77_IFUN_CCxx(F77_i0,_p0_,p1,l1,p2,l2,x3,x4); \
- } while(0)
-
-
-#ifdef IBM370
-#pragma linkage(K77CCx3,FORTRAN)
-#define F77_IFUN_CCx3(i0,name,p1,l1,p2,l2,x3,x4,x5) do { \
- i0 = K77CCx3(&name,p1,l1,p2,l2,x3,x4,x5); } while(0)
-#else
-#define F77_IFUN_CCx3(i0,name,p1,l1,p2,l2,x3,x4,x5) do { \
- F77_CHAR_DEF2DSC(s1,p1,l1,s2,p2,l2) \
- F77_CHAR_ASS2DSC(s1,p1,l1,s2,p2,l2) \
- i0 = (*name)( \
- F77_CHAR_USE2PTR(s1,p1,l1,s2,p2,l2), \
- x3,x4,x5 \
- F77_CHAR_USE2LEN(s1,p1,l1,s2,p2,l2) \
- ); } while(0)
-#endif
-#define F77_CALL_CCx3(name,p1,l1,p2,l2,x3,x4,x5) do { \
- INT_FUNCPTR _p0_ = (INT_FUNCPTR)name; \
- F77_IFUN_CCx3(F77_i0,_p0_,p1,l1,p2,l2,x3,x4,x5); \
- } while(0)
-
-
-#ifdef IBM370
-#pragma linkage(K77Cx,FORTRAN)
-#define F77_IFUN_Cx(i0,name,p1,l1,x2) do { \
- i0 = K77Cx(&name,p1,l1,x2); } while(0)
-#else
-#define F77_IFUN_Cx(i0,name,p1,l1,x2) do { \
- F77_CHAR_DEF_DSC(s1,p1,l1) \
- F77_CHAR_ASS_DSC(s1,p1,l1) \
- i0 = (*name)( \
- F77_CHAR_USE_PTR(s1,p1,l1), \
- x2 \
- F77_CHAR_USE_LEN(s1,p1,l1) \
- F77_XXXX_USE_LEN(x2) \
- ); } while(0)
-#endif
-
-#define F77_CALL_Cx(name,p1,l1,x2) do { \
- INT_FUNCPTR _p0_ = (INT_FUNCPTR)name; \
- F77_IFUN_Cx(F77_i0,_p0_,p1,l1,x2); \
- } while(0)
-
-
-#ifdef IBM370
-#pragma linkage(K77CxC,FORTRAN)
-#define F77_CALL_CxC(name,p1,l1,x2,p3,l3) do { \
- SUBROUTINE *F77 = name; \
- K77CxC(&F77,p1,l1,x2,p3,l3); } while(0)
-#else
-#define F77_CALL_CxC(name,p1,l1,x2,p3,l3) do { \
- F77_CHAR_DEF2DSC(s1,p1,l1,s3,p3,l3) \
- F77_CHAR_ASS2DSC(s1,p1,l1,s3,p3,l3) \
- name( F77_CHAR_USE_PTR(s1,p1,l1), \
- x2, \
- F77_CHAR_USE_PTR(s3,p3,l3) \
- F77_CHAR_USE_LEN(s1,p1,l1) \
- F77_XXXX_USE_LEN(x2) \
- F77_CHAR_USE_LEN(s3,p3,l3) \
- ); } while(0)
-#endif
-
-
-#ifdef IBM370
-#pragma linkage(K77Cxx,FORTRAN)
-#define F77_CALL_Cxx(name,p1,l1,x2,x3) do { \
- SUBROUTINE *F77 = name; \
- K77Cxx(&F77,p1,l1,x2,x3); } while(0)
-#else
-#define F77_CALL_Cxx(name,p1,l1,x2,x3) do { \
- F77_CHAR_DEF_DSC(s1,p1,l1) \
- F77_CHAR_ASS_DSC(s1,p1,l1) \
- name( F77_CHAR_USE_PTR(s1,p1,l1), \
- x2,x3 \
- F77_CHAR_USE_LEN(s1,p1,l1) \
- F77_XXXX_USE2LEN(x2,x3) \
- ); } while(0)
-#endif
-
-
-#ifdef IBM370
-#pragma linkage(K77xC,FORTRAN)
-#define F77_CALL_xC(name,x1,p2,l2) do { \
- SUBROUTINE *F77 = name; \
- K77xC(&F77,x1,p2,l2); } while(0)
-#else
-#define F77_CALL_xC(name,x1,p2,l2) do { \
- F77_CHAR_DEF_DSC(s2,p2,l2) \
- F77_CHAR_ASS_DSC(s2,p2,l2) \
- name( x1, \
- F77_CHAR_USE_PTR(s2,p2,l2) \
- F77_XXXX_USE_LEN(x1) \
- F77_CHAR_USE_LEN(s2,p2,l2) \
- ); } while(0)
-#endif
-
-
-#ifdef IBM370
-#pragma linkage(K77xCCx,FORTRAN)
-#define F77_CALL_xCCx(name,x1,p2,l2,p3,l3,x4) do { \
- SUBROUTINE *F77 = name; \
- K77xCCx(&F77,x1,p2,l2,p3,l3,x4); } while(0)
-#else
-#define F77_CALL_xCCx(name,x1,p2,l2,p3,l3,x4) do { \
- F77_CHAR_DEF2DSC(s2,p2,l2,s3,p3,l3) \
- F77_CHAR_ASS2DSC(s2,p2,l2,s3,p3,l3) \
- name( x1, \
- F77_CHAR_USE2PTR(s2,p2,l2,s3,p3,l3), \
- x4 \
- F77_XXXX_USE_LEN(x1) \
- F77_CHAR_USE2LEN(s2,p2,l2,s3,p3,l3) \
- F77_XXXX_USE_LEN(x4) \
- ); } while(0)
-#endif
-
-
-#ifdef IBM370
-#pragma linkage(K77xCC,FORTRAN)
-#define F77_IFUN_xCC(i0,name,x1,p2,l2,p3,l3) do { \
- i0 = K77xCC(&name,x1,p2,l2,p3,l3); } while(0)
-#else
-#define F77_IFUN_xCC(i0,name,x1,p2,l2,p3,l3) do { \
- F77_CHAR_DEF2DSC(s2,p2,l2,s3,p3,l3) \
- F77_CHAR_ASS2DSC(s2,p2,l2,s3,p3,l3) \
- i0 = (*name)( x1, \
- F77_CHAR_USE2PTR(s2,p2,l2,s3,p3,l3) \
- F77_XXXX_USE_LEN(x1) \
- F77_CHAR_USE2LEN(s2,p2,l2,s3,p3,l3) \
- ); } while(0)
-#endif
-
-#define F77_CALL_xCC(name,x1,p2,l2,p3,l3) do { \
- INT_FUNCPTR _p0_ = (INT_FUNCPTR)name; \
- F77_IFUN_xCC(F77_i0,_p0_,x1,p2,l2,p3,l3); \
- } while(0)
-
-
-#ifdef IBM370
-#pragma linkage(K77xCx,FORTRAN)
-#define F77_IFUN_xCx(i0,name,x1,p2,l2,x3) do { \
- i0 = K77xCx(&name,x1,p2,l2,x3); } while(0)
-#else
-#define F77_IFUN_xCx(i0,name,x1,p2,l2,x3) do { \
- F77_CHAR_DEF_DSC(s2,p2,l2) \
- F77_CHAR_ASS_DSC(s2,p2,l2) \
- i0 = (*name)( x1, \
- F77_CHAR_USE_PTR(s2,p2,l2), \
- x3 \
- F77_XXXX_USE_LEN(x1) \
- F77_CHAR_USE_LEN(s2,p2,l2) \
- F77_XXXX_USE_LEN(x3) \
- ); } while(0)
-#endif
-
-#define F77_CALL_xCx(name,x1,p2,l2,x3) do { \
- INT_FUNCPTR _p0_ = (INT_FUNCPTR)name; \
- F77_IFUN_xCx(F77_i0,_p0_,x1,p2,l2,x3); \
- } while(0)
-
-
-#ifdef IBM370
-#pragma linkage(K77x4C,FORTRAN)
-#define F77_CALL_x4C(name,x1,x2,x3,x4,p5,l5) do { \
- SUBROUTINE *F77 = name; \
- K77x4C(&F77,x1,x2,x3,x4,p5,l5); } while(0)
-#else
-#define F77_CALL_x4C(name,x1,x2,x3,x4,p5,l5) do { \
- F77_CHAR_DEF_DSC(s5,p5,l5) \
- F77_CHAR_ASS_DSC(s5,p5,l5) \
- name( x1,x2,x3,x4, \
- F77_CHAR_USE_PTR(s5,p5,l5) \
- F77_XXXX_USE4LEN(x1,x2,x3,x4) \
- F77_CHAR_USE_LEN(s5,p5,l5) \
- ); } while(0)
-#endif
-
-
-#ifdef IBM370
-#pragma linkage(K77x4Cxx,FORTRAN)
-#define F77_CALL_x4Cxx(name,x1,x2,x3,x4,p5,l5,x6,x7) do { \
- SUBROUTINE *F77 = name; \
- K77x4Cxx(&F77,x1,x2,x3,x4,p5,l5,x6,x7); } while(0)
-#else
-#define F77_CALL_x4Cxx(name,x1,x2,x3,x4,p5,l5,x6,x7) do { \
- F77_CHAR_DEF_DSC(s5,p5,l5) \
- F77_CHAR_ASS_DSC(s5,p5,l5) \
- name( x1,x2,x3,x4, \
- F77_CHAR_USE_PTR(s5,p5,l5), \
- x6,x7 \
- F77_XXXX_USE4LEN(x1,x2,x3,x4) \
- F77_CHAR_USE_LEN(s5,p5,l5) \
- F77_XXXX_USE2LEN(x6,x7) \
- ); } while(0)
-#endif
-
-
-#ifdef IBM370
-#pragma linkage(KIGMENU,FORTRAN)
-/* 1 2 3 4 5 6 7 8 9 10 11 12 13 14 */
-#define F77_CALL_xCx5CxC3xC(name,a,b,B,c,d,e,f,g,h,H,i,j,J,k,K,l,L,m,n,N) do {\
- SUBROUTINE *F77 = name; \
- KIGMENU(&F77,a,b,B,c,d,e,f,g,h,H,i,j,J,k,K,l,L,m,n,N); } while(0)
-#else
-#define F77_CALL_xCx5CxC3xC(name,a,b,B,c,d,e,f,g,h,H,i,j,J,k,K,l,L,m,n,N) do {\
- F77_CHAR_DEF_DSC(sb,b,B) \
- F77_CHAR_DEF_DSC(sh,h,H) \
- F77_CHAR_DEF3DSC(sj,j,J,sk,k,K,sl,l,L) \
- F77_CHAR_DEF_DSC(sn,n,N) \
- F77_CHAR_ASS_DSC(sb,b,B) \
- F77_CHAR_ASS_DSC(sh,h,H) \
- F77_CHAR_ASS3DSC(sj,j,J,sk,k,K,sl,l,L) \
- F77_CHAR_ASS_DSC(sn,n,N) \
- name( a, \
- F77_CHAR_USE_PTR(sb,b,B), \
- c,d,e,f,g, \
- F77_CHAR_USE_PTR(sh,h,H), \
- i, \
- F77_CHAR_USE3PTR(sj,j,J,sk,k,K,sl,l,L), \
- m, \
- F77_CHAR_USE_PTR(sn,n,N) \
- F77_XXXX_USE_LEN(a) \
- F77_CHAR_USE_LEN(sb,b,B) \
- F77_XXXX_USE5LEN(c,d,e,f,g) \
- F77_CHAR_USE_LEN(sh,h,H) \
- F77_XXXX_USE_LEN(i) \
- F77_CHAR_USE3LEN(sj,j,J,sk,k,K,sl,l,L) \
- F77_XXXX_USE_LEN(m) \
- F77_CHAR_USE_LEN(sn,n,N) \
- ); } while(0)
-#endif
-
-
-#ifdef IBM370
-#define F77_IFUN_x(i0,name,x1) i0 = __CTOF(name,x1)
-#else
-#define F77_IFUN_x(i0,name,x1) i0 = (*name)(x1)
-#endif
-
-
-#ifdef IBM370
-#define F77_IFUN_xx(i0,name,x1,x2) i0 = __CTOF(name,x1,x2)
-#else
-#define F77_IFUN_xx(i0,name,x1,x2) i0 = (*name)(x1,x2)
-#endif
-
-
-#ifdef IBM370
-#pragma linkage(K77xCx8,FORTRAN)
-#define F77_IFUN_xCx8(i0,name,x1,p2,l2,x3,x4,x5,x6,x7,x8,x9,x10) do { \
- i0 = K77xCx8(&name,x1,p2,l2,x3,x4,x5,x6,x7,x8,x9,x10); } while(0)
-#else
-#define F77_IFUN_xCx8(i0,name,x1,p2,l2,x3,x4,x5,x6,x7,x8,x9,x10) do { \
- F77_CHAR_DEF_DSC(s2,p2,l2) \
- F77_CHAR_ASS_DSC(s2,p2,l2) \
- i0 = (*name)( x1, \
- F77_CHAR_USE_PTR(s2,p2,l2), \
- x3,x4,x5,x6,x7,x8,x9,x10 \
- F77_XXXX_USE_LEN(x1) \
- F77_CHAR_USE_LEN(s2,p2,l2) \
- F77_XXXX_USE8LEN(x3,x4,x5,x6,x7,x8,x9,x10) \
- ); } while(0)
-#endif
-
-
-extern LOGICAL ku_true( int return_true );
-
-
-/*
- * routines called by Fortran
- */
-#define Errrun F77_NAME(errrun,ERRRUN)
-#define Fmemcpy F77_NAME(fmemcpy,FMEMCPY)
-
-#if !defined(CERNLIB_GFORTRAN)
-#define Getarg F77_NAME(getarg,GETARG)
-#else
-#define Getarg _gfortran_getarg_i4
-#endif
- extern SUBROUTINE Getarg;
-#define Goparm F77_NAME(goparm,GOPARM)
- extern SUBROUTINE Goparm;
-
-#define Iclrwk F77_NAME(iclrwk,ICLRWK)
- extern SUBROUTINE Iclrwk;
-#define Iginit F77_NAME(iginit,IGINIT)
- extern SUBROUTINE Iginit;
-#define Igmenu F77_NAME(igmenu,IGMENU)
- extern SUBROUTINE Igmenu;
-#define Igrng F77_NAME(igrng,IGRNG)
- extern SUBROUTINE Igrng;
-#define Igsse F77_NAME(igsse,IGSSE)
- extern SUBROUTINE Igsse;
-#define Igsrap F77_NAME(igsrap,IGSRAP)
- extern SUBROUTINE Igsrap;
-#define Igwkty F77_NAME(igwkty,IGWKTY)
- extern SUBROUTINE Igwkty;
-
-#define Kcexec F77_NAME(kcexec,KCEXEC)
-
-#define Kdialo F77_NAME(kdialo,KDIALO)
- extern SUBROUTINE Kdialo;
-
-#define Kgetar F77_NAME(kgetar,KGETAR)
-
-#define Kiargc F77_NAME(kiargc,KIARGC)
- extern INT_FUNCTION Kiargc;
-#define Kibres F77_NAME(kibres,KIBRES)
- extern SUBROUTINE Kibres;
-#define Kiclos F77_NAME(kiclos,KICLOS)
- extern SUBROUTINE Kiclos;
-#define Kicomv F77_NAME(kicomv,KICOMV)
-#define Kierrf F77_NAME(kierrf,KIERRF)
-#ifdef CERNLIB_MSSTDCALL
- extern type_of_call Kierrf
- (char *, int); /* To make MS Fortran happy */
-#else
- extern SUBROUTINE Kierrf;
-#endif
-
-#define Kiinit F77_NAME(kiinit,KIINIT)
-#ifdef CERNLIB_MSSTDCALL
- extern type_of_call Kiinit
- (int *);
-#else
- extern SUBROUTINE Kiinit;
-#endif
-#define Kilun F77_NAME(kilun,KILUN)
- extern SUBROUTINE Kilun;
-#define Kipawc F77_NAME(kipawc,KIPAWC)
-#define Kipiaf F77_NAME(kipiaf,KIPIAF)
-#define Kiprmt F77_NAME(kiprmt,KIPRMT)
-#define Kirtim F77_NAME(kirtim,KIRTIM)
-#define Kisigm F77_NAME(kisigm,KISIGM)
-#define Kivect F77_NAME(kivect,KIVECT)
-
-#define Kmbrset F77_NAME(kmbrset,KMBRSET)
-#define Kmvsed F77_NAME(kmvsed,KMVSED)
- extern SUBROUTINE Kmvsed;
-#define Kmvspg F77_NAME(kmvspg,KMVSPG)
- extern SUBROUTINE Kmvspg;
-#define Kmvssh F77_NAME(kmvssh,KMVSSH)
- extern SUBROUTINE Kmvssh;
-
-#define Ksvpar F77_NAME(ksvpar,KSVPAR)
-
-#define Kuach F77_NAME(kuach,KUACH)
-#define Kuact F77_NAME(kuact,KUACT)
-#define Kualfa F77_NAME(kualfa,KUALFA)
-#define Kuappl F77_NAME(kuappl,KUAPPL)
-#define Kuargs F77_NAME(kuargs,KUARGS)
-#define Kubrek F77_NAME(kubrek,KUBREK)
-#define Kubrof F77_NAME(kubrof,KUBROF)
-#define Kubron F77_NAME(kubron,KUBRON)
-#define Kuclos F77_NAME(kuclos,KUCLOS)
-#ifdef CERNLIB_MSSTDCALL
- extern type_of_call Kuclos
- (int *, char *, int , int *);
-#else
- extern SUBROUTINE Kuclos;
-#endif
-
-#define Kucmd F77_NAME(kucmd,KUCMD)
-#define Kucmdl F77_NAME(kucmdl,KUCMDL)
-#define Kucomv F77_NAME(kucomv,KUCOMV)
-#define Kuedit F77_NAME(kuedit,KUEDIT)
-#define Kuesvr F77_NAME(kuesvr,KUESVR)
-#define Kueusr F77_NAME(kueusr,KUEUSR)
-#define Kuexec F77_NAME(kuexec,KUEXEC)
-#define Kuexel F77_NAME(kuexel,KUEXEL)
-#define Kuexit F77_NAME(kuexit,KUEXIT)
-#define Kufcas F77_NAME(kufcas,KUFCAS)
-#define Kufdef F77_NAME(kufdef,KUFDEF)
-#define Kugetc F77_NAME(kugetc,KUGETC)
-#define Kugete F77_NAME(kugete,KUGETE)
-#define Kugetf F77_NAME(kugetf,KUGETF)
-#define Kugeti F77_NAME(kugeti,KUGETI)
-#define Kugetl F77_NAME(kugetl,KUGETL)
-#define Kugetr F77_NAME(kugetr,KUGETR)
-#define Kugets F77_NAME(kugets,KUGETS)
-#define Kugrfl F77_NAME(kugrfl,KUGRFL)
-#define Kuguid F77_NAME(kuguid,KUGUID)
-#define Kuhelp F77_NAME(kuhelp,KUHELP)
-#define Kuhome F77_NAME(kuhome,KUHOME)
-#define Kuidf1 F77_NAME(kuidf1,KUIDF1)
- extern SUBROUTINE Kuidf1;
-#define Kuidf2 F77_NAME(kuidf2,KUIDF2)
- extern SUBROUTINE Kuidf2;
-#define Kuidfm F77_NAME(kuidfm,KUIDFM)
-#define Kuinim F77_NAME(kuinim,KUINIM)
-#define Kuinit F77_NAME(kuinit,KUINIT)
-#define Kuinps F77_NAME(kuinps,KUINPS)
-#define Kuinqf F77_NAME(kuinqf,KUINQF)
-#define Kxdsig F77_NAME(kxdsig,KXDSIG)
- extern SUBROUTINE Kxdsig;
-#ifdef CERNLIB_MSSTDCALL
- extern type_of_call Kuinqf
- (char *, int , int *);
-#else
- extern SUBROUTINE Kuinqf;
-#endif
-#define Kulun F77_NAME(kulun,KULUN)
-#define Kumloc F77_NAME(kumloc,KUMLOC)
-#define Kumout F77_NAME(kumout,KUMOUT)
-#define Kundpv F77_NAME(kundpv,KUNDPV)
-#define Kunpar F77_NAME(kunpar,KUNPAR)
-#define Kunwg F77_NAME(kunwg,KUNWG)
-#define Kuopen F77_NAME(kuopen,KUOPEN)
- extern SUBROUTINE Kuopen;
-#define Kupad F77_NAME(kupad,KUPAD)
-#define Kupar F77_NAME(kupar,KUPAR)
-#define Kupath F77_NAME(kupath,KUPATH)
-#define Kupatl F77_NAME(kupatl,KUPATL)
-#define Kuproc F77_NAME(kuproc,KUPROC)
-#define Kuprof F77_NAME(kuprof,KUPROF)
-#define Kuproi F77_NAME(kuproi,KUPROI)
-#define Kuprop F77_NAME(kuprop,KUPROP)
-#define Kupror F77_NAME(kupror,KUPROR)
-#define Kupros F77_NAME(kupros,KUPROS)
-#define Kumess F77_NAME(kumess,KUMESS)
-#define Kupval F77_NAME(kupval,KUPVAL)
-#define Kuqcas F77_NAME(kuqcas,KUQCAS)
-#define Kuqenv F77_NAME(kuqenv,KUQENV)
-#define Kuqexe F77_NAME(kuqexe,KUQEXE)
-#define Kuqkey F77_NAME(kuqkey,KUQKEY)
-#define Kuqsvr F77_NAME(kuqsvr,KUQSVR)
-#define Kuquit F77_NAME(kuquit,KUQUIT)
-#define Kuqvar F77_NAME(kuqvar,KUQVAR)
-#define Kuread F77_NAME(kuread,KUREAD)
-#ifdef CERNLIB_MSSTDCALL
- extern type_of_call Kuread
- (int *, char *, int , int *);
-#else
- extern SUBROUTINE Kuread;
-#endif
-#define Kusapp F77_NAME(kusapp,KUSAPP)
-#define Kuser F77_NAME(kuser,KUSER)
-#define Kuserid F77_NAME(kuserid,KUSERID)
-#define Kusibr F77_NAME(kusibr,KUSIBR)
-#define Kusigm F77_NAME(kusigm,KUSIGM)
-#define Kuspy F77_NAME(kuspy,KUSPY)
-#define Kustat F77_NAME(kustat,KUSTAT)
-#define Kustop F77_NAME(kustop,KUSTOP)
-#define Kuterm F77_NAME(kuterm,KUTERM)
-#define Kutime F77_NAME(kutime,KUTIME)
-#define Kutim0 F77_NAME(kutim0,KUTIM0)
- extern SUBROUTINE Kutim0;
-#define Kutrue F77_NAME(kutrue,KUTRUE)
-#define Kuvar F77_NAME(kuvar,KUVAR)
-#define Kuvcre F77_NAME(kuvcre,KUVCRE)
-#ifdef CERNLIB_MSSTDCALL
- extern type_of_call Kuvcre
- (char *, int, char *, int, int *, int *, int *);
-#else
- extern SUBROUTINE Kuvcre;
-#endif
-#define Kuvdel F77_NAME(kuvdel,KUVDEL)
-#ifdef CERNLIB_MSSTDCALL
- extern type_of_call Kuvdel
- ( char *, int);
-#else
- extern SUBROUTINE Kuvdel;
-#endif
-#define Kuvect F77_NAME(kuvect,KUVECT)
- extern SUBROUTINE Kuvect;
-#define Kuvnam F77_NAME(kuvnam,KUVNAM)
-#define Kuwhag F77_NAME(kuwhag,KUWHAG)
-#define Kuwham F77_NAME(kuwham,KUWHAM)
-#define Kuwhat F77_NAME(kuwhat,KUWHAT)
-#define Kuwrit F77_NAME(kuwrit,KUWRIT)
- extern SUBROUTINE Kuwrit;
-
-#define Kxcrv2 F77_NAME(kxcrv2,KXCRV2)
- extern SUBROUTINE Kxcrv2;
-
-#define Macdef F77_NAME(macdef,MACDEF)
- extern SUBROUTINE Macdef;
-
-#define Mdmenu F77_NAME(mdmenu,MDMENU)
-#define Mhi_close F77_NAME(mhi_close,MHI_CLOSE)
- extern SUBROUTINE Mhi_close;
-#define Mhi_open F77_NAME(mhi_open,MHI_OPEN)
- extern SUBROUTINE Mhi_open;
-
-#define Mzwipe F77_NAME(mzwipe,MZWIPE)
- extern SUBROUTINE Mzwipe;
-
-#define Traceq F77_NAME(traceq,TRACEQ)
- extern SUBROUTINE Traceq;
-
-#define Xuflow F77_NAME(xuflow,XUFLOW)
- extern SUBROUTINE Xuflow;
-
-
-#ifdef IBM370
-
-# pragma linkage(ERRRUN,FORTRAN)
-
-# pragma linkage(FMEMCPY,FORTRAN)
-
-# pragma linkage(GOPARM,FORTRAN)
-
-# pragma linkage(ICLRWK,FORTRAN)
-# pragma linkage(IGINIT,FORTRAN)
-# pragma linkage(IGMENU,FORTRAN)
-# pragma linkage(IGRNG,FORTRAN)
-# pragma linkage(IGSSE,FORTRAN)
-# pragma linkage(IGSRAP,FORTRAN)
-# pragma linkage(IGWKTY,FORTRAN)
-
-# pragma linkage(KCEXEC,FORTRAN)
-
-# pragma linkage(KDIALO,FORTRAN)
-
-# pragma linkage(KGETAR,FORTRAN)
-
-# pragma linkage(KIBRES,FORTRAN)
-# pragma linkage(KICLOS,FORTRAN)
-# pragma linkage(KICOMV,FORTRAN)
-# pragma linkage(KIERRF,FORTRAN)
-# pragma linkage(KIINIT,FORTRAN)
-# pragma linkage(KILUN,FORTRAN)
-# pragma linkage(KIPAWC,FORTRAN)
-# pragma linkage(KIPIAF,FORTRAN)
-# pragma linkage(KIPRMT,FORTRAN)
-# pragma linkage(KIRTIM,FORTRAN)
-# pragma linkage(KISIGM,FORTRAN)
-# pragma linkage(KIVECT,FORTRAN)
-
-# pragma linkage(KMBRSET,FORTRAN)
-# pragma linkage(KMVSED,FORTRAN)
-# pragma linkage(KMVSPG,FORTRAN)
-# pragma linkage(KMVSSH,FORTRAN)
-
-# pragma linkage(KSVPAR,FORTRAN)
-
-# pragma linkage(KUACH,FORTRAN)
-# pragma linkage(KUACT,FORTRAN)
-# pragma linkage(KUALFA,FORTRAN)
-# pragma linkage(KUAPPL,FORTRAN)
-# pragma linkage(KUARGS,FORTRAN)
-# pragma linkage(KUBREK,FORTRAN)
-# pragma linkage(KUBROF,FORTRAN)
-# pragma linkage(KUBRON,FORTRAN)
-# pragma linkage(KUCLOS,FORTRAN)
-# pragma linkage(KUCMD,FORTRAN)
-# pragma linkage(KUCMDL,FORTRAN)
-# pragma linkage(KUCOMV,FORTRAN)
-# pragma linkage(KUEDIT,FORTRAN)
-# pragma linkage(KUESVR,FORTRAN)
-# pragma linkage(KUEUSR,FORTRAN)
-# pragma linkage(KUEXEC,FORTRAN)
-# pragma linkage(KUEXEL,FORTRAN)
-# pragma linkage(KUEXIT,FORTRAN)
-# pragma linkage(KUFCAS,FORTRAN)
-# pragma linkage(KUFDEF,FORTRAN)
-# pragma linkage(KUGETC,FORTRAN)
-# pragma linkage(KUGETE,FORTRAN)
-# pragma linkage(KUGETF,FORTRAN)
-# pragma linkage(KUGETI,FORTRAN)
-# pragma linkage(KUGETL,FORTRAN)
-# pragma linkage(KUGETR,FORTRAN)
-# pragma linkage(KUGETS,FORTRAN)
-# pragma linkage(KUGRFL,FORTRAN)
-# pragma linkage(KUGUID,FORTRAN)
-# pragma linkage(KUHELP,FORTRAN)
-# pragma linkage(KUHOME,FORTRAN)
-# pragma linkage(KUIDF1,FORTRAN)
-# pragma linkage(KUIDF2,FORTRAN)
-# pragma linkage(KUIDFM,FORTRAN)
-# pragma linkage(KUINIM,FORTRAN)
-# pragma linkage(KUINIT,FORTRAN)
-# pragma linkage(KUINPS,FORTRAN)
-# pragma linkage(KUINQF,FORTRAN)
-# pragma linkage(KULUN,FORTRAN)
-# pragma linkage(KUMLOC,FORTRAN)
-# pragma linkage(KUMOUT,FORTRAN)
-# pragma linkage(KUNDPV,FORTRAN)
-# pragma linkage(KUNPAR,FORTRAN)
-# pragma linkage(KUNWG,FORTRAN)
-# pragma linkage(KUOPEN,FORTRAN)
-# pragma linkage(KUPAD,FORTRAN)
-# pragma linkage(KUPAR,FORTRAN)
-# pragma linkage(KUPATH,FORTRAN)
-# pragma linkage(KUPATL,FORTRAN)
-# pragma linkage(KUPROC,FORTRAN)
-# pragma linkage(KUPROF,FORTRAN)
-# pragma linkage(KUPROI,FORTRAN)
-# pragma linkage(KUPROP,FORTRAN)
-# pragma linkage(KUPROR,FORTRAN)
-# pragma linkage(KUPROS,FORTRAN)
-# pragma linkage(KUPVAL,FORTRAN)
-# pragma linkage(KUQCAS,FORTRAN)
-# pragma linkage(KUQENV,FORTRAN)
-# pragma linkage(KUQEXE,FORTRAN)
-# pragma linkage(KUQKEY,FORTRAN)
-# pragma linkage(KUQSVR,FORTRAN)
-# pragma linkage(KUQUIT,FORTRAN)
-# pragma linkage(KUQVAR,FORTRAN)
-# pragma linkage(KUREAD,FORTRAN)
-# pragma linkage(KUSAPP,FORTRAN)
-# pragma linkage(KUSIBR,FORTRAN)
-# pragma linkage(KUSIGM,FORTRAN)
-# pragma linkage(KUSPY,FORTRAN)
-# pragma linkage(KUSTAT,FORTRAN)
-# pragma linkage(KUSTOP,FORTRAN)
-# pragma linkage(KUTERM,FORTRAN)
-# pragma linkage(KUTIME,FORTRAN)
-# pragma linkage(KUTIM0,FORTRAN)
-# pragma linkage(KUTRUE,FORTRAN)
-# pragma linkage(KUSER,FORTRAN)
-# pragma linkage(KUVAR,FORTRAN)
-# pragma linkage(KUVCRE,FORTRAN)
-# pragma linkage(KUVDEL,FORTRAN)
-# pragma linkage(KUVECT,FORTRAN)
-# pragma linkage(KUVNAM,FORTRAN)
-# pragma linkage(KUWHAG,FORTRAN)
-# pragma linkage(KUWHAM,FORTRAN)
-# pragma linkage(KUWHAT,FORTRAN)
-# pragma linkage(KUWRIT,FORTRAN)
-# pragma linkage(KXDSIG,FORTRAN)
-
-# pragma linkage(KXCRV2,FORTRAN)
-
-# pragma linkage(MACDEF,FORTRAN)
-
-# pragma linkage(MDMENU,FORTRAN)
-# pragma linkage(MHI_CLOSE,FORTRAN)
-# pragma linkage(MHI_OPEN,FORTRAN)
-
-# pragma linkage(MZWIPE,FORTRAN)
-
-# pragma linkage(TRACEQ,FORTRAN)
-
-# pragma linkage(XUFLOW,FORTRAN)
-
-#endif
-
-
-#define MAXCMD 512 /* max length of a command line */
-#define MAXEDT 32 /* max length of names in edit server */
-#define MAXLEV 10 /* max levels of command name path */
-#define MAXSVR 20 /* max number of edit server processes */
-
-
-/*
- * The PAWC common is referenced through a pointer to allow the use of
- * dynamic common blocks on IBM systems.
- */
-
-#define Pawc kc_pawc
-
-EXTERN struct COMMON_PAWC {
- INTEGER NWPAR;
- INTEGER IXPAWC;
- INTEGER IHBOOK;
- INTEGER IXHIGZ;
- INTEGER IXKUIP;
- INTEGER IFENCE[5];
- INTEGER LQ[8];
- INTEGER DATA[999];
-} *Pawc;
-
-#define IQ(n) Pawc->DATA[n-1]
-#define Q(n) (((REAL*)(Pawc->DATA))[n-1])
-
diff --git a/src/packlib/kuip/kuip/khaix370.h b/src/packlib/kuip/kuip/khaix370.h
deleted file mode 100644
index 6898190..0000000
--- a/src/packlib/kuip/kuip/khaix370.h
+++ /dev/null
@@ -1,12 +0,0 @@
-/*
- * $Id: khaix370.h,v 1.1.1.1 1996/03/08 15:33:00 mclareni Exp $
- *
- * $Log: khaix370.h,v $
- * Revision 1.1.1.1 1996/03/08 15:33:00 mclareni
- * Kuip
- *
- */
-#ifndef AIX370
-# define AIX370
-#endif
-
diff --git a/src/packlib/kuip/kuip/khapoftn.h b/src/packlib/kuip/kuip/khapoftn.h
deleted file mode 100644
index 3564a1a..0000000
--- a/src/packlib/kuip/kuip/khapoftn.h
+++ /dev/null
@@ -1,12 +0,0 @@
-/*
- * $Id: khapoftn.h,v 1.1.1.1 1996/03/08 15:33:00 mclareni Exp $
- *
- * $Log: khapoftn.h,v $
- * Revision 1.1.1.1 1996/03/08 15:33:00 mclareni
- * Kuip
- *
- */
-#ifndef APOLLO_FTN
-# define APOLLO_FTN
-#endif
-
diff --git a/src/packlib/kuip/kuip/khash.h b/src/packlib/kuip/kuip/khash.h
deleted file mode 100644
index 727df26..0000000
--- a/src/packlib/kuip/kuip/khash.h
+++ /dev/null
@@ -1,45 +0,0 @@
-/*
- * $Id: khash.h,v 1.1.1.1 1996/03/08 15:33:00 mclareni Exp $
- *
- * $Log: khash.h,v $
- * Revision 1.1.1.1 1996/03/08 15:33:00 mclareni
- * Kuip
- *
- */
-/* khash.h: hash table management */
-
-typedef struct _HashArray {
- char *name; /* symbol name */
- void *value; /* symbol value */
- int tag;
-} HashArray;
-
-typedef struct _HashEntry {
- struct _HashEntry *next; /* link to next entry */
- char *name; /* symbol name */
- void *value; /* symbol value */
- int tag;
-} HashEntry;
-
-typedef struct {
- int size; /* table size should be a prime number */
- HashEntry **entries; /* pointer to array of size entries */
- int nentries; /* number of entries */
- int is_string; /* flag if strdup/free(value) should be used */
- int tag_only; /* flag if only tag field is used */
- int case_convert;
- int (*strcmp)(); /* strcmp/strcasecmp */
- int (*hash_cmp)(); /* hash_cmp/hash_casecmp */
-} HashTable;
-
-extern HashArray* hash_array( HashTable* );
-extern void hash_clear( HashTable* );
-extern void hash_config( HashTable*, const char* );
-extern HashTable* hash_create( int );
-extern void hash_destroy( HashTable* );
-extern int hash_entries( HashTable* );
-extern void hash_insert( HashTable*, const char*, const void*, int );
-extern void* hash_lookup( HashTable*, const char*, int* );
-extern void* hash_remove( HashTable*, const char* );
-
-
diff --git a/src/packlib/kuip/kuip/khibmmvs.h b/src/packlib/kuip/kuip/khibmmvs.h
deleted file mode 100644
index d8574f7..0000000
--- a/src/packlib/kuip/kuip/khibmmvs.h
+++ /dev/null
@@ -1,12 +0,0 @@
-/*
- * $Id: khibmmvs.h,v 1.1.1.1 1996/03/08 15:33:00 mclareni Exp $
- *
- * $Log: khibmmvs.h,v $
- * Revision 1.1.1.1 1996/03/08 15:33:00 mclareni
- * Kuip
- *
- */
-#ifndef IBMMVS
-# define IBMMVS
-#endif
-
diff --git a/src/packlib/kuip/kuip/khibmvm.h b/src/packlib/kuip/kuip/khibmvm.h
deleted file mode 100644
index b822a86..0000000
--- a/src/packlib/kuip/kuip/khibmvm.h
+++ /dev/null
@@ -1,12 +0,0 @@
-/*
- * $Id: khibmvm.h,v 1.1.1.1 1996/03/08 15:33:00 mclareni Exp $
- *
- * $Log: khibmvm.h,v $
- * Revision 1.1.1.1 1996/03/08 15:33:00 mclareni
- * Kuip
- *
- */
-#ifndef IBMVM
-# define IBMVM
-#endif
-
diff --git a/src/packlib/kuip/kuip/khnewlib.h b/src/packlib/kuip/kuip/khnewlib.h
deleted file mode 100644
index 5a2247b..0000000
--- a/src/packlib/kuip/kuip/khnewlib.h
+++ /dev/null
@@ -1,13 +0,0 @@
-/*
- * $Id: khnewlib.h,v 1.1.1.1 1996/03/08 15:33:00 mclareni Exp $
- *
- * $Log: khnewlib.h,v $
- * Revision 1.1.1.1 1996/03/08 15:33:00 mclareni
- * Kuip
- *
- */
-#ifndef NEWLIB
-# define NEWLIB
-#endif
-
-
diff --git a/src/packlib/kuip/kuip/klink.h b/src/packlib/kuip/kuip/klink.h
deleted file mode 100644
index 6d4e7c3..0000000
--- a/src/packlib/kuip/kuip/klink.h
+++ /dev/null
@@ -1,57 +0,0 @@
-/*
- * $Id: klink.h,v 1.2 1996/04/16 13:26:44 gunter Exp $
- *
- * $Log: klink.h,v $
- * Revision 1.2 1996/04/16 13:26:44 gunter
- * Mods to compile kuipc. The includes needed only for kuipc where moved
- * to kuipc, together with m4 files to create/update these header files.
- *
- * Revision 1.1.1.1 1996/03/08 15:33:00 mclareni
- * Kuip
- *
- */
-/* klink.h: demand linking of special routines */
-
-#define __ /* Null */
-
-#include "klink1.h"
-
-#undef __
-
-
-EXTERN struct {
- SUBROUTINE *user_exit_F; /* set by KUEXIT */
- SUBROUTINE *user_quit_F; /* set by KUQUIT */
- SUBROUTINE *user_break_F; /* set by KUBREK */
- SUBROUTINE *user_edit_F; /* set by KUEUSR */
- SUBROUTINE *user_comis_F; /* set by KUCOMV */
- SUBROUTINE *user_sigma_F; /* set by KUSIGM */
- SUBROUTINE *user_grfl_F; /* set by KUGRFL */
- SUBROUTINE *user_term_F; /* set by KUTERM */
- SUBROUTINE *user_input_F; /* set by KUSER */
- SUBROUTINE *user_locate_F; /* set by KUMLOC */
- /* indirect calls to avoid linking Motif */
- IntFunc *disp_panel_C; /* display command panel (km_display_cmdpan) */
- IntFunc *disp_kpanel_C; /* display KUIP panel (km_display_kpanel) */
- IntFunc *close_kpanel_C; /* close KUIP panel (km_close_kpanel) */
- IntFunc *disp_kmpanel_C; /* add panel inside palette (km_panel_add) */
- IntFunc *disp_text_C; /* display text widget (km_display_sctext) */
- IntFunc *disp_choice_C; /* display a choice of commands (?) */
- IntFunc *disp_clean_C; /* clean before action (km_destroy_all_popup)*/
- IntFunc *disp_flush_C; /* flush event queue (FlushEvents) */
- IntFunc *disp_busy_C; /* show busy cursor (km_all_cursor) */
- IntFunc *disp_exit_C; /* ask confirmation for exit */
- IntFunc *disp_quit_C; /* ask confirmation for exit */
- IntFunc *disp_select_C; /* select from a number of buttons */
- IntFunc *disp_cmd_list_C; /* display list of commands (km_cmd_list) */
- IntFunc *disp_list_C; /* display list of items (km_display_list) */
- IntFunc *callb_kmenu; /* kuipList callback in KMENU (km_kmenu_OK) */
- CharFunc *disp_prompt_C; /* prompt for input */
- CharFunc *disp_passwd_C; /* prompt for password input */
- /* indirect calls to avoid linking HIGZ without style G */
- IntFunc *higz_init_C; /* initialize menu mode */
-} kjmpaddr;
-
-
-#undef StartQuotedInclude
-#undef EndQuotedInclude
diff --git a/src/packlib/kuip/kuip/klink1.h b/src/packlib/kuip/kuip/klink1.h
deleted file mode 100644
index e406530..0000000
--- a/src/packlib/kuip/kuip/klink1.h
+++ /dev/null
@@ -1,11 +0,0 @@
-struct { /* */ __
- /* indirect calls to avoid linking HIGZ */ __
- IntFunc *graf_info_C; /* pass display, open and close (ixmotif) */ __
- SUBROUTINE *graf_size_F; /* resize window (IGRSIZ) */ __
- SUBROUTINE *graf_pick_F; /* identifying graphics objects (IGOBJ) */ __
- SUBROUTINE *graf_attr_F; /* set attributes (IGSET) */ __
- SUBROUTINE *graf_close_F; /* close workstation (ICLWK) */ __
- /* optional routines for Motif customization */ __
- pCharFunc *user_FallBk_C; /* get application fallbacks */ __
- IntFunc *user_TopWid_C; /* pass toplevel widget identifiers */ __
-} klnkaddr; /* */ __
diff --git a/src/packlib/kuip/kuip/kmacro.h b/src/packlib/kuip/kuip/kmacro.h
deleted file mode 100644
index 4b1b94d..0000000
--- a/src/packlib/kuip/kuip/kmacro.h
+++ /dev/null
@@ -1,95 +0,0 @@
-/*
- * $Id: kmacro.h,v 1.1.1.1 1996/03/08 15:33:00 mclareni Exp $
- *
- * $Log: kmacro.h,v $
- * Revision 1.1.1.1 1996/03/08 15:33:00 mclareni
- * Kuip
- *
- */
-/* kmacro.h: KUIP macros */
-
-typedef enum {
- APPLICATION_Statement,
- ASSIGNMENT_Statement,
- BREAKL_Statement,
- CASE_Label,
- CASE_Statement,
- COMMAND_Statement,
- DO_Statement,
- ELSE_Statement,
- ELSEIF_Statement,
- ENDCASE_Statement,
- ENDDO_Statement,
- ENDFOR_Statement,
- ENDIF_Statement,
- ENDWHILE_Statement,
- EOF_REACHED,
- EXITM_Statement,
- FOR_Statement,
- GOTO_Label,
- GOTO_Statement,
- IF_GOTO_Statement,
- IF_THEN_Statement,
- MACRO_Statement,
- NEXTL_Statement,
- OFF_ERROR_Statement,
- ON_ERROR_Statement,
- ON_ERROR_CONTINUE,
- ON_ERROR_EXITM,
- ON_ERROR_GOTO,
- ON_ERROR_STOPM,
- READ_Statement,
- REPEAT_Statement,
- RETURN_Statement,
- SHIFT_Statement,
- STOPM_Statement,
- UNTIL_Statement,
- WHILE_Statement,
- SYNTAX_ERROR
-} KumacStatement;
-
-typedef struct _KumacCode {
- int (*op)();
- char *arg[2];
-} KumacCode;
-
-typedef struct _KumacMacro {
- char *name;
- struct _KumacMacro *next;
- int ncode;
- KumacCode *code;
-} KumacMacro;
-
-typedef struct _KumacFile {
- char *path;
- int stamp;
- KumacMacro *macros;
-} KumacFile;
-
-typedef struct _ExecStack {
- KumacFile *file;
- KumacMacro *macro;
- char *argline;
- char *line_number;
- char *source_line;
- HashTable *variables;
- KumacStatement on_error_stmt;
- char *on_error_arg;
- KumacStatement off_error_stmt;
- char *off_error_arg;
- int pc;
- int status;
-} ExecStack;
-
-typedef struct _NestStack {
- KumacStatement stmt;
- char *var;
- char tmp1[16];
- char tmp2[16];
- char label1[16];
- char label2[16];
- char label3[16];
-} NestStack;
-
-extern void store_variable( ExecStack*, const char* name, const char* value );
-
diff --git a/src/packlib/kuip/kuip/kmenu.h b/src/packlib/kuip/kuip/kmenu.h
deleted file mode 100644
index f23b9db..0000000
--- a/src/packlib/kuip/kuip/kmenu.h
+++ /dev/null
@@ -1,51 +0,0 @@
-/*
- * $Id: kmenu.h,v 1.2 1996/04/16 13:26:46 gunter Exp $
- *
- * $Log: kmenu.h,v $
- * Revision 1.2 1996/04/16 13:26:46 gunter
- * Mods to compile kuipc. The includes needed only for kuipc where moved
- * to kuipc, together with m4 files to create/update these header files.
- *
- * Revision 1.1.1.1 1996/03/08 15:33:00 mclareni
- * Kuip
- *
- */
-/* kmenu.h: data structures for menu and command definitions */
-
-#define __ /* Null */
-
-#include "kmenu1.h"
-
-#include "kmenu2.h"
-
-#include "kmenu3.h"
-
-#include "kmenu4.h"
-
-#include "kmenu5.h"
-
-#include "kmenu6.h"
-
-#undef __
-
-/*
- * temporary fix until we can reserve an extra word in KmCommand structure
- * to count keyboard and macro commands separately
- */
-#define XCOUNT_SHIFT 10
-#define XCOUNT_OFFSET (1 << XCOUNT_SHIFT)
-#define XCOUNT_MASK (XCOUNT_OFFSET - 1)
-
-extern void check_version( int, int );
-extern void check_edit_server(void);
-extern int exec_cmd_string( const char*, int, int(*)() );
-extern int exec_decoded_cmd( KmCommand* );
-extern KmMenu* find_submenu( const char* );
-extern char* fmt_cmd_help( KmCommand*, int );
-extern void menu_style(void);
-extern void print_cmd_list( KmCommand**, const char* );
-extern void reset_arg_list( KmCommand* );
-extern KmMenu** root_menu_list( const char* );
-extern KmCommand* search_command( const char*, KmCommand*** );
-
-
diff --git a/src/packlib/kuip/kuip/kmenu1.h b/src/packlib/kuip/kuip/kmenu1.h
deleted file mode 100644
index 573ac5a..0000000
--- a/src/packlib/kuip/kuip/kmenu1.h
+++ /dev/null
@@ -1,18 +0,0 @@
-typedef enum { /* */ __
- KmFLAG_FORGET = 0x01, /* last value is not kept for Motif panels */ __
- KmFLAG_MINUS = 0x02, /* -VALUE is not an abbrev for CHOPT=VALUE */ __
- KmFLAG_QUOTE = 0x04, /* do not remove quotes */ __
- KmFLAG_VARARG = 0x08, /* append additional args to this param. */ __
- KmFLAG_CONST = 0x10, /* do not allow to assign a value */ __
- KmFLAG_HIDDEN = 0x20, /* do not show in menus */ __
- KmFLAG_SEPARATE = 0x40 /* treat arguments as separate tokens */ __
-} KmParFlag; /* */ __
- /* */ __
-typedef enum { /* */ __
- KmTYPE_CHAR = 'C', /* character string */ __
- KmTYPE_FILE = 'F', /* file name */ __
- KmTYPE_INT = 'I', /* integer */ __
- KmTYPE_OPTION = 'O', /* option */ __
- KmTYPE_REAL = 'R' /* real */ __
-} KmParType; /* */ __
- /* */ __
diff --git a/src/packlib/kuip/kuip/kmenu2.h b/src/packlib/kuip/kuip/kmenu2.h
deleted file mode 100644
index 9feb20b..0000000
--- a/src/packlib/kuip/kuip/kmenu2.h
+++ /dev/null
@@ -1,19 +0,0 @@
-typedef struct { /* file name */ __
- char *filter_default; /* filter wildcard */ __
- char *filter_current; /* current filter */ __
-} KmParFile; /* */ __
- /* */ __
-typedef struct { /* */ __
- char *range_lower; /* lower value of range */ __
- char *range_upper; /* upper value of range */ __
- char *slider_lower; /* lower limit for slider */ __
- char *slider_upper; /* upper limit for slider */ __
- int decimals; /* number of decimals used for slider */ __
-} KmParInt; /* */ __
- /* */ __
-typedef struct { /* option */ __
- char **text; /* explanations (parallel to range_value) */ __
- int *mutex; /* mutex group to which text belongs */ __
- int *radio; /* radio group to which text belongs */ __
-} KmParOption; /* */ __
- /* */ __
diff --git a/src/packlib/kuip/kuip/kmenu3.h b/src/packlib/kuip/kuip/kmenu3.h
deleted file mode 100644
index 318585a..0000000
--- a/src/packlib/kuip/kuip/kmenu3.h
+++ /dev/null
@@ -1,18 +0,0 @@
-typedef KmParInt KmParReal; /* real and int have the same fields */ __
- /* */ __
-typedef struct { /* */ __
- char *name; /* parameter name */ __
- int abbrev; /* minimum length that name is recognized */ __
- char *prompt; /* prompt string */ __
- char *dfault; /* default value */ __
- char *last; /* last value for Motif panel (malloced) */ __
- int width; /* width of input field */ __
- int range_count; /* number of items in range_value */ __
- char **range_value; /* list of allowed values */ __
- int select_count; /* number of items in select_count */ __
- char **select_value; /* list of values for selection box */ __
- KmParFlag flags; /* special flags */ __
- KmParType type; /* parameter type */ __
- void *ptype; /* structure pointer selected by type */ __
-} KmParameter; /* */ __
- /* */ __
diff --git a/src/packlib/kuip/kuip/kmenu4.h b/src/packlib/kuip/kuip/kmenu4.h
deleted file mode 100644
index d492a25..0000000
--- a/src/packlib/kuip/kuip/kmenu4.h
+++ /dev/null
@@ -1,27 +0,0 @@
-typedef struct _KmCommand { /* */ __
- struct _KmCommand *next; /* link to next command */ __
- char *path; /* command path */ __
- char *name; /* command name */ __
- int hidden; /* flag if command is invisible */ __
- int level; /* depth of submenus */ __
- int total; /* total number of parameters */ __
- int mandatory; /* number of mandatory parameters */ __
- KmParameter **par; /* list of total parameter descriptions */ __
- int list_par; /* index+1 of parameter taking a list */ __
- int xcount; /* count number of action calls */ __
- SUBROUTINE *action_F; /* action routine */ __
- IntFunc *action_C; /* action routine */ __
- SUBROUTINE *user_help_F; /* user help routine */ __
- pCharFunc *user_help_C; /* user help routine */ __
- int nguidance; /* number of lines in guidance text */ __
- char **guidance; /* help text */ __
- int nkeyword; /* number of lines for keywords */ __
- char **keyword; /* list of keywords */ __
- int nhlink; /* number of lines for links */ __
- char **hlink; /* list of links */ __
- int argc; /* number of arguments entered */ __
- char **argv; /* argc argument values */ __
- char *argline; /* argument line as entered */ __
- int *argoffs; /* argc offsets into argline for KUGETE */ __
-} KmCommand; /* */ __
- /* */ __
diff --git a/src/packlib/kuip/kuip/kmenu5.h b/src/packlib/kuip/kuip/kmenu5.h
deleted file mode 100644
index 5cd4e2d..0000000
--- a/src/packlib/kuip/kuip/kmenu5.h
+++ /dev/null
@@ -1,20 +0,0 @@
-typedef struct _KmMenu { /* */ __
- struct _KmMenu *next; /* link to next menu */ __
- struct _KmMenu *down; /* link to submenu */ __
- char *path; /* path of parent menu */ __
- char *name; /* menu name */ __
- int level; /* depth of submenus */ __
- KmCommand *cmds; /* link to first command */ __
- int nguidance; /* number of lines in guidance text */ __
- char **guidance; /* help text */ __
- int nkeyword; /* number of lines for keywords */ __
- char **keyword; /* list of keywords */ __
- int nhlink; /* number of lines for links */ __
- char **hlink; /* list of links */ __
-} KmMenu; /* */ __
- /* */ __
-extern void klnkbrcl(); /* */ __
-extern void klnkicon(); /* */ __
-extern void klnkkmcl(); /* */ __
-extern void klnkmenu(); /* */ __
- /* */ __
diff --git a/src/packlib/kuip/kuip/kmenu6.h b/src/packlib/kuip/kuip/kmenu6.h
deleted file mode 100644
index 78814cd..0000000
--- a/src/packlib/kuip/kuip/kmenu6.h
+++ /dev/null
@@ -1,18 +0,0 @@
-/*
- * $Id: kmenu6.h,v 1.1.1.1 1996/03/08 15:33:01 mclareni Exp $
- *
- * $Log: kmenu6.h,v $
- * Revision 1.1.1.1 1996/03/08 15:33:01 mclareni
- * Kuip
- *
- */
-/* Interface for building lists (with Motif) */
-typedef struct {
- char *listLabel;
- char *label;
- char *help;
- IntFunc *OKcallback;
- IntFunc *user_callback;
- char *OKcallback_data;
-} ListData;
-
diff --git a/src/packlib/kuip/kuip/kmpanel.h b/src/packlib/kuip/kuip/kmpanel.h
deleted file mode 100644
index ef48554..0000000
--- a/src/packlib/kuip/kuip/kmpanel.h
+++ /dev/null
@@ -1,53 +0,0 @@
-/*
- * $Id: kmpanel.h,v 1.1.1.1 1996/03/08 15:33:01 mclareni Exp $
- *
- * $Log: kmpanel.h,v $
- * Revision 1.1.1.1 1996/03/08 15:33:01 mclareni
- * Kuip
- *
- */
-
-/* kmpanel.h: C callable interface to command "panel ..." */
-/*
- 1) km_panel_close ("panel 0 c ...")
- 2) km_panel_display ("panel 0 d ...")
- 3) km_panel_reset ("panel 0 r ...")
- 4) km_panel_key ("panel x.y command [alias_label] [pixmap]"
- 5) km_panel_key_opt ("panel x.y command [alias_label] [pixmap] opt"
-*/
-
-#ifdef IBMVM
-#define km_panel_close km_pacl
-#define km_panel_display km_padi
-#define km_panel_reset km_pare
-#define km_panel_key km_pake
-#define km_panel_key_opt km_pako
-#endif
-
-/* km_panel_close : C callable interface to command "panel 0 c" (close) */
-extern void km_panel_close(
- char *title );
-
-/* km_panel_display : C callable interface to command "panel 0 d" (display) */
-extern void km_panel_display(
- char *title,
- char *geometry);
-
-/* km_panel_reset : C callable interface to command "panel 0 r" (reset panel) */
-extern void km_panel_reset(
- const char *name);
-
-/* km_panel_key : C callable interface to command "panel" for key definition */
-extern void km_panel_key(
- int row,
- int col,
- char *command,
- char *alias_label,
- char *pixmap);
-extern void km_panel_key_opt(
- int row,
- int col,
- char *command,
- char *alias_label,
- char *pixmap,
- char *opt);
diff --git a/src/packlib/kuip/kuip/kproto.h b/src/packlib/kuip/kuip/kproto.h
deleted file mode 100644
index b26efc5..0000000
--- a/src/packlib/kuip/kuip/kproto.h
+++ /dev/null
@@ -1,42 +0,0 @@
-/*
- * $Id: kproto.h,v 1.2 1998/08/25 12:47:56 mclareni Exp $
- *
- * $Log: kproto.h,v $
- * Revision 1.2 1998/08/25 12:47:56 mclareni
- * QMGLIBC changes for Linux RH51
- *
- * Revision 1.1.1.1 1996/03/08 15:33:01 mclareni
- * Kuip
- *
- */
-
-extern char* clean_word( char* );
-extern char* format_prompt( const char* );
-#if defined(CERNLIB_QMGLIBC)
-extern char* getline2( const char* );
-#else
-extern char* getline( const char* );
-#endif
-extern void gl_config( const char*, int );
-extern void gl_histadd( const char* );
-extern void gl_setwidth( int );
-extern char* input_line( const char*, char );
-extern void leave_kuip(void);
-extern int len_alias( const char*, int );
-extern int len_sysfun( const char* );
-extern int len_vector( const char* );
-extern char* quote_string( char*, int );
-extern void reset_break(void);
-extern char* split_at_semicolon( char* );
-
-extern void k_parse_args( const char*, char**, int* );
-
-
-#ifndef vms
-extern void signal_handler( int );
-#else
-extern int signal_handler( const void*, const void* );
-extern int control_C_ast( int );
-#endif
-
-
diff --git a/src/packlib/kuip/kuip/ksig.h b/src/packlib/kuip/kuip/ksig.h
deleted file mode 100644
index 23dcb07..0000000
--- a/src/packlib/kuip/kuip/ksig.h
+++ /dev/null
@@ -1,86 +0,0 @@
-/*
- * $Id: ksig.h,v 1.3 1997/11/28 17:27:14 mclareni Exp $
- *
- * $Log: ksig.h,v $
- * Revision 1.3 1997/11/28 17:27:14 mclareni
- * Numerous mods and some new routines to get Control-C working reasonably on NT
- *
- * Revision 1.2 1997/03/14 17:16:38 mclareni
- * WNT mods
- *
- * Revision 1.1.1.1 1996/03/08 15:33:01 mclareni
- * Kuip
- *
- */
-/*
- * 1997/11/28 17:16:38 V.Fine
- * Some new members have been introduced into the kc_break struct
- * Macro to set the exception handler routine for diff WIN32 platform
- * was done
- */
-/* ksig.h: signal and break handling */
-
-/*
- * Available signal handling package
- *
- * #define SIGNAL_POSIX ==> sigaction() for Unix
- * #define SIGNAL_BSD ==> sigvec() for VMS and NeXT
- * #define SIGNAL_V7 ==> signal()
- */
-#if !defined(SIGNAL_BSD) && !defined(SIGNAL_V7)
-# define SIGNAL_POSIX
-#elif !defined(WIN32)
-# define sigjmp_buf jmp_buf
-# define sigsetjmp(buf,save) setjmp(buf)
-# define siglongjmp(buf,val) longjmp(buf,val)
-# ifdef vms
-# define sv_flags sv_onstack
-# endif
-#elif defined(WIN32)
-# include <float.h>
-# define sigjmp_buf jmp_buf
- int sigsetjmp(sigjmp_buf *buffer, int save);
- void siglongjmp (sigjmp_buf buffer, int val);
- BOOL ConsoleSigHandler(DWORD sig);
-#endif
-
-EXTERN struct {
- int trap_enabled; /* flag if exceptions should be trapped */
- int intr_enabled; /* flag if ^C delivery is allowed */
- int intr_pending; /* flag if ^C happened while disabled */
- int intr_count; /* count number of consecutive ^C interrupts */
- int traceback; /* print traceback on signal */
-#ifdef WIN32
- int fperr; /* type of floating-point exception under Windows */
- HANDLE hdThread; /* The real handle of the thread to jump in */
- unsigned int uRetAddr; /* return address to the subroutine calling setjmp */
-#endif
- char *error_msg; /* messages is handler cannot do print */
- int soft_intr; /* flag to stop at a convenient point */
- int jump_set; /* flag if stack has been setup */
- sigjmp_buf stack;
- int sockfd; /* socket descriptor and routine to */
- void (*piaf_sync)(); /* resynchronize Piaf communication */
-} kc_break;
-
-#ifdef WIN32
-# if defined(_X86_)
-# define PROGCTR(Context) (Context.Eip)
-# endif
-
-# if defined(_MIPS_)
-# define PROGCTR(Context) (Context.Fir)
-# endif
-
-# if defined(_ALPHA_)
-# define PROGCTR(Context) (Context.Fir)
-# endif
-
-# if defined(_PPC_)
-# define PROGCTR(Context) (Context.Iar)
-# endif
-
-# if !defined(PROGCTR)
-# error Module contains CPU-specific code; modify and recompile.
-# endif
-#endif /* WIN32 */
diff --git a/src/packlib/kuip/kuip/kstring.h b/src/packlib/kuip/kuip/kstring.h
deleted file mode 100644
index 7811f15..0000000
--- a/src/packlib/kuip/kuip/kstring.h
+++ /dev/null
@@ -1,95 +0,0 @@
-/*
- * $Id: kstring.h,v 1.2 1997/03/14 17:16:39 mclareni Exp $
- *
- * $Log: kstring.h,v $
- * Revision 1.2 1997/03/14 17:16:39 mclareni
- * WNT mods
- *
- * Revision 1.1.1.1 1996/03/08 15:33:01 mclareni
- * Kuip
- *
- */
-
-#include <string.h>
-
-#ifdef __cplusplus
-extern "C" {
-#endif
-
-/*
- * quasi-standard functions missing in some C-libraries
- */
-
-#ifndef WIN32
-extern void* memmove( void* dst, const void* src, size_t n );
-#endif
-
-/* GF. make conform to kkern.c#if !defined(__convexc__)*/
-#ifndef HAVE_STRCASECMP
-extern int strcasecmp( const char* str1, const char* str2 );
-extern int strncasecmp( const char* str1, const char* str2, size_t n );
-#endif
-
-extern char* strrstr( const char* str1, const char* str2 );
-
-#define strdup Strdup /* prototype without const */
-extern char* strdup( const char* str );
-
-
-/*
- * convenience functions from kkern.c
- */
-extern char* str0dup( const char* str );
-extern char* str2dup( const char* str1, const char* str2 );
-extern char* str3dup( const char* str1, const char* str2, const char* str3 );
-extern char* str4dup( const char* str1, const char* str2, const char* str3,
- const char* str4 );
-extern char* str5dup( const char* str1, const char* str2, const char* str3,
- const char* str4, const char* str5 );
-extern char* strndup( const char* buf, size_t n );
-extern char* stridup( int i );
-
-extern char* mstrcat( char* ptr, const char* str );
-extern char* mstr2cat( char* ptr, const char* str1, const char* str2 );
-extern char* mstr3cat( char* ptr, const char* str1, const char* str2,
- const char* str3);
-extern char* mstr4cat( char* ptr, const char* str1, const char* str2,
- const char* str3, const char* str4 );
-extern char* mstrncat( char* ptr, const char* buf, size_t n );
-extern char* mstrccat( char* ptr, char c, size_t n );
-extern char* mstricat( char* ptr, int i );
-
-extern char* strrpbrk( const char* str1, const char* str2 );
-extern char* strqtok( char* str );
-extern char* strlower( char* str );
-extern char* strupper( char* str );
-extern char* strtrim( char* str );
-extern char* struntab( char* str );
-extern char* strfromd( double d, size_t prec );
-extern char* strfromi( int i, size_t prec );
-extern char* strblk0( char* str );
-
-extern int shsystem( const char* shell, const char* cmd );
-extern int checksum( const char* path );
-
-extern char* fexpand( const char* fname, const char* ftype );
-extern char* fsearch( const char* fname, const char* ftype, const char* path );
-extern char* fsymlink( const char* path );
-
-extern char* fstrdup( const char* buf, size_t len );
-extern char* fstr0dup( const char* buf, size_t len );
-extern char* fstrtrim( const char* buf, size_t len );
-extern char* fstr0trim( const char* buf, size_t len );
-
-extern size_t fstrlen( const char* buf, size_t len );
-extern size_t fstrset( char* buf, size_t len, const char* str );
-extern double fstrtod( const char* str, char** tail );
-extern int fstrtoi( const char* str, char** tail );
-extern char* fstrvec( char** pstr, size_t n, size_t* len );
-extern size_t mstrlen( char** pstr, size_t n );
-
-#ifdef __cplusplus
-}
-#endif
-
-
diff --git a/src/packlib/kuip/kuip/ksys.h b/src/packlib/kuip/kuip/ksys.h
deleted file mode 100644
index 2c67054..0000000
--- a/src/packlib/kuip/kuip/ksys.h
+++ /dev/null
@@ -1,602 +0,0 @@
-/*
- * $Id: ksys.h,v 1.7 2006/12/07 13:26:53 mclareni Exp $
- *
- * $Log: ksys.h,v $
- * Revision 1.7 2006/12/07 13:26:53 mclareni
- * Corrections for MacOSX on Intel
- *
- * Revision 1.6 2006/09/15 09:35:30 mclareni
- * Submitted mods for gcc4/gfortran and MacOSX, corrected to work also on slc4 with gcc3.4 and 4.1
- *
- * Revision 1.5 1997/09/02 14:50:01 mclareni
- * WINNT corrections
- *
- * Revision 1.4 1997/09/01 13:05:33 gunter
- * VMS 7 has sigmask in signal.h
- *
- * Revision 1.3 1997/03/14 17:16:39 mclareni
- * WNT mods
- *
- * Revision 1.2 1996/09/20 14:54:41 cernlib
- * add define MATCH_RE_COMP for linux
- *
- * Revision 1.1.1.1.2.1 1997/01/21 11:33:07 mclareni
- * All mods for Winnt 96a on winnt branch
- *
- * Revision 1.1.1.1 1996/03/08 15:33:01 mclareni
- * Kuip
- *
- */
-/* ksys.h: system dependent defines */
-
-/* update version if structures have changed */
-#define KUIP_VERSION 950303
-
-
-/* identify system if not possible from preprocessor defines */
-#if defined(CERNLIB_AIX370)
-#include "khaix370.h"
-#endif
-#if defined(CERNLIB_APOFTN)
-#include "khapoftn.h"
-#endif
-#if defined(CERNLIB_IBMVM)
-#include "khibmvm.h"
-#endif
-#if defined(CERNLIB_IBMMVS)
-#include "khibmmvs.h"
-#endif
-#if defined(CERNLIB_NEWLIB)
-#include "khnewlib.h"
-#endif
-
-
-#ifdef AIX370
-# define MACHINE_NAME "IBMAIX"
-# define UNIX
-# define F77_EXTERN_INDIRECT
-#endif
-
-
-#if defined(apollo) || defined(__apollo)
-# define MACHINE_NAME "APOLLO"
-# define APOLLO
-# define UNIX
-# include <apollo/base.h>
-# include <apollo/error.h>
-# include <apollo/ios.h>
-# include <apollo/pad.h>
-# include <apollo/pgm.h>
-# include <apollo/streams.h>
-# ifdef APOLLO_FTN /* using /com/ftn instead of /bin/f77 */
-# define F77_CHAR_LEN_IND
-# define F77_CHAR_LEN_TYPE short
-# define F77_EXTERN_LOWERCASE
-# endif
-# define F77_EXTERN_INDIRECT
-# define F77_COMMON(name) name __attribute((__section(name)))
-# ifndef EXTERN
-# define EXTERN /* essential for accessing COMMON blocks */
-# endif
-# define FATAL_SIGFPE
-# define HAVE_MEMMOVE
-# define HAVE_STRCASECMP
-# define NO_DIRENT_H
-# define TERMIO_BSD /* for getline we must compile under bsd4.3 */
-#endif
-
-
-#if defined(__convexc__)
-# define CONVEX
-# define MACHINE_NAME "CONVEX"
-# define UNIX
-# define F77_BLOCK(name,NAME) _##name##_
-# define F77_ARG_CONSTANT
-# ifndef EXTERN
-# define EXTERN /* essential for accessing COMMON blocks */
-# endif
-# define FATAL_SIGFPE
-# define HAVE_MEMMOVE
-# define HAVE_STRCASECMP
-# define HAVE_SELECT
-# define HAVE_VFORK
-# define MATCH_RE_COMP /* use re_comp/re_exec */
-# define TERMIO_MAP_NL /* need to map NL to NL-CR on output */
-# define USE_EDIT_SERVER
-#endif
-
-
-#ifdef CRAY
-# define MACHINE_NAME "CRAY"
-# define UNIX
-# include <fortran.h>
-# define F77_EXTERN_UPPERCASE
-# ifndef EXTERN
-# define EXTERN /* essential for accessing COMMON blocks */
-# endif
-# define HAVE_STRCASECMP
-# define NO_EDIT_SERVER
-#endif
-
-
-#if defined(__hpux)
-# define MACHINE_NAME "HPUX"
-# define HPUX
-# define UNIX
-# ifndef _HPUX_SOURCE
-# define _HPUX_SOURCE
-# endif
-# define FATAL_SIGFPE /* needs f77 +T and ON REAL UNDERFLOW IGNORE */
-# define HAVE_MEMMOVE
-# define HAVE_STRCASECMP
-# define HAVE_STRRSTR
-# define HAVE_SELECT
-# define SELECT_CAST(fds) (int*)fds
-#endif
-
-
-#ifdef _IBMR2
-# define IBMRT
-# define MACHINE_NAME "IBMRT"
-# define UNIX
-# define HAVE_MEMMOVE
-# define HAVE_STRCASECMP
-# include <sys/select.h>
-# define HAVE_SELECT
-# define BROKEN_F77_IO
-#endif
-
-
-#ifdef IBMVM
-# define ARG_STYLE_CMS
-# define MACHINE_NAME "IBM"
-# define OS_NAME "VM"
-# ifndef IBM370
-# define IBM370
-# endif
-# define KmTimeStamp TimeStamp
- typedef char TimeStamp[24];
- extern int get_stamp(char*,TimeStamp*);
-# define same_stamp(stamp1,stamp2) (strcmp(*(stamp1),*(stamp2)) == 0)
-#endif
-
-#ifdef IBMMVS
-# define MACHINE_NAME "IBMMVS"
-# define OS_NAME "MVS"
-# ifndef IBM370
-# define IBM370
-# endif
-#endif
-
-#ifdef IBM370
-# define F77_ARG_CONSTANT
-# define F77_CHAR_LEN_IND
- /* each parameter has a length argument ! */
-# define F77_XXXX_ARG_LEN(x) F77_CHAR_ARG_LEN(x)
-# define F77_EXTERN_INDIRECT
-# define F77_EXTERN_UPPERCASE
-# define NO_FCNTL_H
-# define NO_UNISTD_H
-# define SIGNAL_V7
-# define ALLOC_MIN_BYTES 128
-# define STUPID_MALLOC
-#endif
-
-
-#ifdef linux
-# define LINUX
-# define MACHINE_NAME "LINUX"
-# define UNIX
-# define HAVE_MEMMOVE
-# define HAVE_STRCASECMP
-# define HAVE_SELECT
-# define MATCH_RE_COMP /* use re_comp/re_exec */
-#endif
-
-
-#ifdef CERNLIB_MACOSX
-# define MACOSX
-# define MACHINE_NAME "MACOSX"
-# define UNIX
-# define HAVE_MEMMOVE
-# define HAVE_STRCASECMP
-# define HAVE_SELECT
-#endif
-
-
-#ifdef MSDOS
-# define MACHINE_NAME "IBMPC"
-# define OS_NAME "MSDOS"
-# define UNIX
-# define NO_EDIT_SERVER
-# define NO_SOCKET_H
-# define NO_SYS_TIME_H
-# define SIGNAL_V7
-# define SLASHES "\\/"
-# define TERMIO_MAP_NL /* need to map NL to NL-CR on output */
-#endif
-
-
-#if defined(WIN32) || defined(CERNLIB_WINNT)
-# define WINNT
-# ifdef _ALPHA_
-# define MACHINE_NAME "ALPHA"
-# else
-# define MACHINE_NAME "Intel"
-# endif
-# define OS_NAME "Windows"
-# define UNIX
-# define MSDOS
-
-# ifdef __STDC__
-# undef __STDC__
-# endif
-
-# include <io.h>
-# include <process.h>
-# include <direct.h>
-# include <windows.h>
-# define text_mode__()
-# define NO_EDIT_SERVER
-/* # define NO_SOCKET_H */
-# define NO_SYS_TIME_H
-# define NO_UNISTD_H
-# define HAVE_STAT_H
-# define SIGNAL_V7
-# define SLASHES "\\/"
-# define TERMIO_MAP_NL /* need to map NL to NL-CR on output */
-# define HAVE_MEMMOVE
-# ifdef CERNLIB_MSSTDCALL
-# define F77_EXTERN_UPPERCASE
-# else
-# define F77_EXTERN_LOWERCASE
-# endif
-#endif
-
-
-#ifdef NeXT
-# define MACHINE_NAME "NEXT"
-# define UNIX
-# define getcwd(path,maxlen) getwd(path)
-# define F77_BLOCK(lc,uc) lc
-# define F77_EXTERN_INDIRECT
- /* each parameter has a length argument ! */
-# define F77_XXXX_ARG_LEN(x) F77_CHAR_ARG_LEN(x)
-# define F77_XXXX_USE_LEN(x) ,286716 /* don't know if value matters */
-# define HAVE_MEMMOVE
-# define HAVE_VFORK
-# define MATCH_RE_COMP /* use re_comp/re_exec */
-# define NO_DIRENT_H
-# define NO_UNISTD_H
-# define SIGNAL_BSD
-# define TERMIO_BSD
-# define GETPGRP_BSD /* BSD getpgrp(pid) vs. POSIX getpgrp(void) */
-#endif
-
-
-#ifdef __osf__
-# define UNIX
-# ifdef __alpha
-# define ALPHA
-# define MACHINE_NAME "ALPHA"
-# endif
-# define HAVE_MEMMOVE
-# define HAVE_STRCASECMP
-# define HAVE_SELECT
-# define BROKEN_F77_IO
-#endif
-
-
-#if defined(__sgi)
-# define MACHINE_NAME "SGI"
-# define SGI
-# define UNIX
-# define HAVE_MEMMOVE
-# define HAVE_STRCASECMP
-# define HAVE_SELECT
-#endif
-
-
-#if defined(sun) || defined(__sun)
-# define SUN
-# define UNIX
-# ifdef CERNLIB_SOLARIS
-# define MACHINE_NAME "SOLARIS"
-# define SOLARIS
-# define HAVE_MEMMOVE
-# define HAVE_SELECT
-# define HAVE_STRCASECMP
-# define HAVE_VFORK
-# else
-# define MACHINE_NAME "SUN"
-# define HAVE_SELECT
-# define HAVE_STRCASECMP
-# define HAVE_VFORK
-# include <vfork.h>
-# define MATCH_RE_COMP /* use re_comp/re_exec */
-# define GETPGRP_BSD /* BSD getpgrp(pid) vs. POSIX getpgrp(void) */
-# endif
-#endif
-
-
-#if defined(__ultrix)
-# define MACHINE_NAME "DECS"
-# define ULTRIX
-# define UNIX
-# define HAVE_MEMMOVE
-# define HAVE_STRCASECMP
-# define HAVE_VFORK
-# define NEED_STRDUP
-# define TERMIO_BSD
-# define GETPGRP_BSD /* BSD getpgrp(pid) vs. POSIX getpgrp(void) */
-# define BROKEN_F77_IO
-#endif
-
-
-#ifdef vms
-# define OS_NAME "VMS"
-# ifdef __ALPHA
-# define ALPHA
-# define MACHINE_NAME "ALPHA"
-# else
-# define MACHINE_NAME "VAX"
-# define ConCat(con,cat) con/**/cat
-# endif
-# include <clidef.h>
-# include <descrip.h>
-# include <lib$routines.h> /* lib$... prototypes */
-# include <processes.h>
-# include <rmsdef.h>
-# include <dvidef.h>
-# include <iodef.h>
-# include <lckdef.h>
-# include <lnmdef.h>
-# include <psldef.h>
-# include <ssdef.h>
-# include <starlet.h> /* sys$... prototypes */
-# include <stsdef.h>
-# include <ttdef.h>
-# include <tt2def.h>
-# include <unixio.h>
-# include <unixlib.h>
-# ifndef R_OK /* no access() modes in unixio.h on VAX/VMS */
-# define F_OK 0
-# define X_OK 1
-# define W_OK 2
-# define R_OK 4
-# endif
-# define ARG_STYLE_VMS
-# define F77_EXTERN_LOWERCASE
-# define HAVE_MEMMOVE
-# define HAVE_STAT_H
-# define HAVE_VFORK /* actually have only vfork */
-# define NO_FCNTL_H
-# define NO_UNISTD_H
-# define SIGNAL_BSD
-# if __VMS_VER < 70000000
-# define sigmask(sig) (1L << (sig-1)) /* should be in signal.h */
-# endif
-# define USE_EDIT_SERVER /* only for TPU/DISPLAY=MOTIF */
-
-# if defined(VAXC) && !defined(__DECC)
-# define STUPID_MALLOC
-# endif
-
-# define fix_descriptor(dsc,str,n) \
- do { \
- dsc.dsc$b_dtype = DSC$K_DTYPE_T; \
- dsc.dsc$b_class = DSC$K_CLASS_S; \
- dsc.dsc$a_pointer = str; \
- dsc.dsc$w_length = n; \
- } while( 0 )
-
-# define var_descriptor(dsc,str) \
- do { \
- dsc.dsc$b_dtype = DSC$K_DTYPE_T; \
- dsc.dsc$b_class = DSC$K_CLASS_S; \
- dsc.dsc$a_pointer = str; \
- dsc.dsc$w_length = strlen( dsc.dsc$a_pointer ); \
- } while( 0 )
-
-#endif /* vms */
-
-
-#include <assert.h>
-#include <ctype.h>
-#include <errno.h>
-#ifndef NO_FCNTL_H
-#include <fcntl.h>
-#endif
-#include <math.h> /* contains strtod() and strtol() on some systems */
-#include <setjmp.h>
-#include <signal.h>
-#include <stdio.h>
-#ifdef DBMALLOC
-#include "dbmalloc.h" /* debug malloc */
-extern char* getenv(const char*);
-extern double strtod(const char*, char**);
-#else
-#include <stdlib.h>
-#endif
-#include <time.h>
-#ifndef NO_UNISTD_H
-#include <unistd.h>
-#endif
-
-
-#ifndef HAVE_VFORK
-# define vfork fork
-#endif
-
-
-#ifdef UNIX /* also defined for MSDOS and Windows/NT*/
-# ifndef OS_NAME
-# define OS_NAME "UNIX"
-# endif
-# include <sys/types.h>
-# include <sys/stat.h>
-# ifndef NO_SYS_TIME_H
-# include <sys/time.h> /* struct timeval */
-# endif
-# if !defined(MSDOS) && !defined(CERNLIB_WINNT)
-# include <sys/wait.h>
-# ifdef TERMIO_BSD
-# define TERMIO_MAP_NL /* need to map NL to NL-CR on output */
-# define HAVE_SELECT
-# endif
-# if !defined(TERMIO_BSD) && !defined(TERMIO_SYSV)
-# define TERMIO_POSIX
-# endif
-# if defined(HAVE_SELECT) && !defined(SELECT_CAST)
-# define SELECT_CAST(fds) fds
-# endif
-# include <pwd.h>
-# ifndef NO_DIRENT_H /* POSIX opendir() */
-# include <dirent.h>
-# else /* BSD opendir() */
-# include <sys/dir.h> /* plus <sys/types.h> */
-# define dirent direct /* struct dirent... */
-# ifndef S_IRUSR
-# define S_IRUSR (S_IREAD) /* read permission, owner */
-# define S_IWUSR (S_IWRITE) /* write permission, owner */
-# define S_IXUSR (S_IEXEC) /* execute/search permission, owner */
-# endif
-# endif
-# endif
-# define HAVE_STAT_H
-# ifndef NO_EDIT_SERVER
-# define USE_EDIT_SERVER
-# ifndef F_LOCK /* BSD file locking */
-# include <sys/file.h>
-# define lockf(fd,op,offs) flock(fd,op)
-# define F_LOCK LOCK_EX
-# define F_ULOCK LOCK_UN
-# endif
-# endif
-# ifndef SLASHES
-# define SLASHES "/"
-# endif
-#endif
-
-
-#ifdef SUN
-# ifndef CLOCKS_PER_SEC
-# define CLOCKS_PER_SEC 1000000 /* missing in time.h */
-# define difftime(t1,t0) ((double)(t1-t0))
-# define raise(sig) kill(getpid(),sig)
-# endif
-#endif
-
-
-#ifndef CLOCKS_PER_SEC
-# define CLOCKS_PER_SEC 100 /* missing in VAX/VMS time.h */
-#endif
-
-
-#ifdef HAVE_STAT_H
-# define KmTimeStamp struct stat
-# define get_stamp(path,stamp) stat(path,stamp)
-# define same_stamp(stamp1,stamp2) ((stamp2)->st_mtime == (stamp1)->st_mtime)
-#endif
-
-#ifndef KmTimeStamp
-# define KmTimeStamp int
-# define get_stamp(path,stamp) (*(stamp) = checksum(path))
-# define same_stamp(stamp1,stamp2) (*(stamp1) == *(stamp2))
-#endif
-
-
-#ifdef MATCH_RE_COMP
- extern char *re_comp();
- extern int re_exec();
-#else
- extern char *regcmp();
- extern char *regex();
-#endif
-
-
-
-/* command line arguments recognized by KUARGS */
-#if !defined(ARG_STYLE_CMS) && !defined(ARG_STYLE_VMS)
-# define ARG_STYLE_UNIX
-#endif
-
-
-#ifndef MACHINE_NAME
-# define MACHINE_NAME "UNKNOWN" /* value returned by $MACHINE */
-#endif
-
-#ifndef OS_NAME
-# define OS_NAME "UNKNOWN" /* value returned by $OS */
-#endif
-
-
-/* #define EXTERN must be in one routine to allocate space for globals */
-#ifndef EXTERN
-# define EXTERN extern
-#endif
-
-
-/*
- * Preprocessor syntax for token concatenation
- */
-#ifndef ConCat
-# define ConCat(con,cat) con##cat
-#endif
-
-
-/*
- * Prototyping for C functions
- */
-#define C_PROTO_0(name) \
- name(void)
-#define C_PROTO_1(name,arg1) \
- name(arg1)
-#define C_PROTO_2(name,arg1,arg2) \
- name(arg1,arg2)
-#define C_PROTO_3(name,arg1,arg2,arg3) \
- name(arg1,arg2,arg3)
-#define C_PROTO_4(name,arg1,arg2,arg3,arg4) \
- name(arg1,arg2,arg3,arg4)
-#define C_PROTO_5(name,arg1,arg2,arg3,arg4,arg5) \
- name(arg1,arg2,arg3,arg4,arg5)
-#define C_PROTO_6(name,arg1,arg2,arg3,arg4,arg5,arg6) \
- name(arg1,arg2,arg3,arg4,arg5,arg6)
-#define C_PROTO_7(name,arg1,arg2,arg3,arg4,arg5,arg6,arg7) \
- name(arg1,arg2,arg3,arg4,arg5,arg6,arg7)
-#define C_PROTO_8(name,arg1,arg2,arg3,arg4,arg5,arg6,arg7,arg8) \
- name(arg1,arg2,arg3,arg4,arg5,arg6,arg7,arg8)
-#define C_PROTO_9(name,arg1,arg2,arg3,arg4,arg5,arg6,arg7,arg8,arg9) \
- name(arg1,arg2,arg3,arg4,arg5,arg6,arg7,arg8,arg9)
-#define C_PROTO_13(name,a1,a2,a3,a4,a5,a6,a7,a8,a9,b0,b1,b2,b3) \
- name(a1,a2,a3,a4,a5,a6,a7,a8,a9,b0,b1,b2,b3)
-
-#define C_DECL_1(name,t1,p1) \
- name(t1 p1)
-#define C_DECL_2(name,t1,p1,t2,p2) \
- name(t1 p1,t2 p2)
-#define C_DECL_3(name,t1,p1,t2,p2,t3,p3) \
- name(t1 p1,t2 p2,t3 p3)
-#define C_DECL_4(name,t1,p1,t2,p2,t3,p3,t4,p4) \
- name(t1 p1,t2 p2,t3 p3,t4 p4)
-#define C_DECL_5(name,t1,p1,t2,p2,t3,p3,t4,p4,t5,p5) \
- name(t1 p1,t2 p2,t3 p3,t4 p4,t5 p5)
-#define C_DECL_6(name,t1,p1,t2,p2,t3,p3,t4,p4,t5,p5,t6,p6) \
- name(t1 p1,t2 p2,t3 p3,t4 p4,t5 p5,t6 p6)
-#define C_DECL_7(name,t1,p1,t2,p2,t3,p3,t4,p4,t5,p5,t6,p6,t7,p7) \
- name(t1 p1,t2 p2,t3 p3,t4 p4,t5 p5,t6 p6,t7 p7)
-#define C_DECL_8(name,t1,p1,t2,p2,t3,p3,t4,p4,t5,p5,t6,p6,t7,p7,t8,p8) \
- name(t1 p1,t2 p2,t3 p3,t4 p4,t5 p5,t6 p6,t7 p7,t8 p8)
-#define C_DECL_9(name,t1,p1,t2,p2,t3,p3,t4,p4,t5,p5,t6,p6,t7,p7,t8,p8,t9,p9)\
- name(t1 p1,t2 p2,t3 p3,t4 p4,t5 p5,t6 p6,t7 p7,t8 p8,t9 p9)
-#define C_DECL_13(name,t1,p1,t2,p2,t3,p3,t4,p4,t5,p5,t6,p6,t7,p7,t8,p8,\
-t9,p9,t10,p10,t11,p11,t12,p12,t13,p13) \
- name(t1 p1,t2 p2,t3 p3,t4 p4,t5 p5,t6 p6,t7 p7,t8 p8,\
-t9 p9,t10 p10,t11 p11,t12 p12,t13 p13)
-
-
-typedef int IntFunc();
-typedef char* CharFunc();
-typedef char** pCharFunc();
-
-
diff --git a/src/packlib/kuip/kuip/kucdes.inc b/src/packlib/kuip/kuip/kucdes.inc
deleted file mode 100644
index bcad696..0000000
--- a/src/packlib/kuip/kuip/kucdes.inc
+++ /dev/null
@@ -1,15 +0,0 @@
-*
-* $Id: kucdes.inc,v 1.1.1.1 1996/03/08 15:32:59 mclareni Exp $
-*
-* $Log: kucdes.inc,v $
-* Revision 1.1.1.1 1996/03/08 15:32:59 mclareni
-* Kuip
-*
-*
-#ifndef CERNLIB_KUIP_KUCDES_INC
-#define CERNLIB_KUIP_KUCDES_INC
-*
-*CMZ : 2.05/02 27/04/94 12.04.46 by Alfred Nathaniel
-*-- Author :
-
-#endif
diff --git a/src/packlib/kuip/kuip/kuip.h b/src/packlib/kuip/kuip/kuip.h
deleted file mode 100644
index dabeb74..0000000
--- a/src/packlib/kuip/kuip/kuip.h
+++ /dev/null
@@ -1,14 +0,0 @@
-/*
- * $Id: kuip.h,v 1.1.1.1 1996/03/08 15:33:01 mclareni Exp $
- *
- * $Log: kuip.h,v $
- * Revision 1.1.1.1 1996/03/08 15:33:01 mclareni
- * Kuip
- *
- */
-#include "ksys.h"
-#include "kstring.h"
-#include "kuser.h"
-#include "kproto.h"
-
-
diff --git a/src/packlib/kuip/kuip/kuser.h b/src/packlib/kuip/kuip/kuser.h
deleted file mode 100644
index b491df7..0000000
--- a/src/packlib/kuip/kuip/kuser.h
+++ /dev/null
@@ -1,108 +0,0 @@
-/*
- * $Id: kuser.h,v 1.2 2000/01/21 13:19:53 couet Exp $
- *
- * $Log: kuser.h,v $
- * Revision 1.2 2000/01/21 13:19:53 couet
- * - C++ keywords "template" and "delete" were used for variables names
- * in C prototypes. This prevent to use this include file with the
- * GNU C++ compiler g++.
- *
- * Revision 1.1.1.1 1996/03/08 15:33:01 mclareni
- * Kuip
- *
- */
-
-#define KUMAC_UNWIND -30041961 /* error status to quit macro execution */
-
-#ifdef __cplusplus
-extern "C" {
-#endif
-
-/*
- * C-interface functions
- */
-extern char* k_getar(void);
-extern void k_setar( size_t, char** );
-extern char* k_userid(void);
-
-extern void ku_alfa(void);
-extern char* ku_appl( int* luno, int* inmacro );
-
-extern int ku_bool( const char* expr );
-
-extern int ku_close( int luno );
-extern void ku_cmdl( const char* ctemplate );
-
-extern int ku_edit( const char* path, int use_server );
-extern char* ku_eval( const char* expr );
-extern int ku_exec( const char* cmd );
-extern int ku_exel( const char* cmd );
-extern char* ku_expr( const char* expr );
-
-extern char* ku_getc(void);
-extern char* ku_gete(void);
-extern char* ku_getf(void);
-extern int ku_geti(void);
-extern char* ku_getl(void);
-extern double ku_getr(void);
-extern char* ku_gets(void);
-
-extern char* ku_fcase( char* path );
-
-extern char* ku_home( const char* fname, const char* ftype );
-
-extern char* ku_inps( const char* prompt );
-extern int ku_inqf( const char* path );
-extern int ku_intr( int enable );
-
-extern void ku_last( const char* cmd );
-
-extern int ku_match( const char* string, const char* pattern,
- int ignore_case );
-extern int ku_math( const char* expr, double* result );
-extern int ku_more( const char* question, const char* line );
-
-extern int ku_npar(void);
-
-extern int ku_open( int luno, const char* path, const char* mode );
-
-extern void ku_pad( const char* path, int idelete );
-extern char* ku_path(void);
-extern void ku_piaf( int socket, void(*sync)() );
-extern char* ku_proc( const char* prompt, const char* dfault );
-extern char* ku_prof( const char* prompt, const char* dfault );
-extern int ku_proi( const char* prompt, int dfault );
-extern char* ku_prop( const char* prompt );
-extern double ku_pror( const char* prompt, double dfault );
-extern char* ku_pros( const char* prompt, const char* dfault );
-
-extern char** ku_qenv(void);
-extern char* ku_qexe( const char* fname );
-extern int ku_qkey(void);
-extern int ku_qmac( const char* mname );
-
-extern int ku_read( int luno, char* buf, size_t len );
-
-extern int ku_sapp( const char* path, const char* exit );
-extern void ku_shut(void);
-extern void ku_sibr(void);
-extern void ku_spy( const char* option );
-extern int ku_stop( int set );
-
-extern void ku_time( time_t, clock_t );
-extern void ku_trap( int enable, int traceback );
-
-extern int ku_vqaddr( const char* vname );
-extern int ku_vtype( const char* vname );
-extern int ku_vvalue( const char* vname, double* value );
-
-extern void ku_whag(void);
-extern void ku_what( void(*styleG)() );
-extern void ku_write( int, const char* line );
-
-extern int km_icon( const char*, const char* );
-
-#ifdef __cplusplus
-}
-#endif
-
diff --git a/src/packlib/kuip/kuip/mkqio.h b/src/packlib/kuip/kuip/mkqio.h
deleted file mode 100644
index 2e28aa1..0000000
--- a/src/packlib/kuip/kuip/mkqio.h
+++ /dev/null
@@ -1,55 +0,0 @@
-/*
- * $Id: mkqio.h,v 1.1.1.1 1996/03/08 15:32:59 mclareni Exp $
- *
- * $Log: mkqio.h,v $
- * Revision 1.1.1.1 1996/03/08 15:32:59 mclareni
- * Kuip
- *
- */
-#if defined(CERNLIB_VMS)
-/*** Routines for VMS QIO to Xtoolkit Input Event Processing ***/
-#ifndef _mkqio_
-#define _mkqio_
-
-/* Constants */
-
-#define MBX_EVENT_FLAG 23 /* event flag for add input synch */
-#define MBX_MAX_MSGSIZE 1500
-#define MISC_EVENT_FLAG 1 /* event flag for misc synch */
-
-/* Structure declarations */
-
-typedef struct _ItemList {
- unsigned short BufLen;
- short ItemCode;
- void *BufferP;
- unsigned short *RetLenP;
-} ItemList;
-
-typedef struct _MbxMessageRec {
- unsigned short ioStatus; /* Note: I/O status block is 8 bytes. */
- unsigned short ioLength; /* For mailbox reads, it is */
- unsigned int ioSenderPID; /* stat/leng/PID - don't split */
- int msgcnt;
- int bytcnt;
- int maxread;
- int chan;
- char buffer[MBX_MAX_MSGSIZE];
-} MbxMessageRec;
-
-extern MbxMessageRec MbxMessage;
-
-
-extern C_PROTO_3(int MbxRead,
- char *buf,
- int bufmax,
- Widget text_widget);
-extern C_PROTO_0(void MbxSetup);
-extern C_PROTO_2(void VMScrelnm,
- char *lognam,
- char *devnam);
-extern C_PROTO_1(void VMSsystem,
- char *buf);
-
-#endif /* _mkqio_ */
-#endif
diff --git a/src/packlib/kuip/kuip/mkterm.h b/src/packlib/kuip/kuip/mkterm.h
deleted file mode 100644
index dec70b0..0000000
--- a/src/packlib/kuip/kuip/mkterm.h
+++ /dev/null
@@ -1,35 +0,0 @@
-/*
- * $Id: mkterm.h,v 1.1.1.1 1996/03/08 15:33:01 mclareni Exp $
- *
- * $Log: mkterm.h,v $
- * Revision 1.1.1.1 1996/03/08 15:33:01 mclareni
- * Kuip
- *
- */
-
-#define ESCAPE "#@"
-
-
-typedef void (*KxtermActionProc)(
-#ifndef NO_PROTOTYPES
- char** /* params */,
- int /* num_params */
-#endif
-);
-
-typedef struct _KxtermActionsRec{
- char *string;
- KxtermActionProc proc;
-} KxtermActionsRec;
-
-typedef KxtermActionsRec *KxtermActionList;
-
-extern void kxterm_add_actions(
- KxtermActionList);
-extern void handle_kxterm_action(
- char *);
-extern void send_kxterm_cmd(
- char**);
-extern void send_single_kxterm_cmd(
- char*);
-
diff --git a/src/packlib/kuip/kuip/mkutfu.h b/src/packlib/kuip/kuip/mkutfu.h
deleted file mode 100644
index 79c39df..0000000
--- a/src/packlib/kuip/kuip/mkutfu.h
+++ /dev/null
@@ -1,59 +0,0 @@
-/*
- * $Id: mkutfu.h,v 1.1.1.1 1996/03/08 15:33:01 mclareni Exp $
- *
- * $Log: mkutfu.h,v $
- * Revision 1.1.1.1 1996/03/08 15:33:01 mclareni
- * Kuip
- *
- */
-/*** Utility functions which do NOT refer any Motif/X11 include files ***/
-#ifndef _mkutfu_
-#define _mkutfu_
-/* km_strempty : Returns true (1) if string is empty (only containing blanks) */
-extern C_PROTO_1(int km_strempty,
- char *);
-/* km_strip : Strip blanks from both sides of a string */
-extern C_PROTO_1(char *km_strip,
- char *);
-/* km_strend : Searches backwards for character c, ignoring ' ' and '\n' */
-extern C_PROTO_2(char *km_strend,
- char *,
- int);
-extern C_PROTO_4(void km_file_type,
- char *,
- char *,
- char *,
- int);
-/* km_scan_dir : Scan directory using filter */
-extern C_PROTO_4(char **km_scan_dir,
- char *,
- char *,
- int,
- int);
-extern C_PROTO_0(char *km_get_br_filter);
-
-extern C_PROTO_5(int km_select,
- int type,
- char *message,
- int nb_ans,
- char **answ,
- int def_ans);
-
-extern C_PROTO_2(char *km_prompt,
- char *,
- char *);
-
-extern C_PROTO_2(char *km_prompt_answer,
- char *,
- char *);
-
-extern C_PROTO_1(char *km_passwd_prompt,
- char *);
-
-/* km_palette : C callable interface for palette (command MULTI_PANEL) */
-extern C_PROTO_2(void km_palette,
- char *title,
- char *geometry);
-
-#endif /* _mkutfu_ */
-
diff --git a/src/packlib/kuip/kuip/pilot.h b/src/packlib/kuip/kuip/pilot.h
deleted file mode 100644
index 1d38924..0000000
--- a/src/packlib/kuip/kuip/pilot.h
+++ /dev/null
@@ -1,53 +0,0 @@
-#if defined(CERNLIB_UNIX)
-# ifndef CERNLIB_QFMSOFT
-# define CERNLIB_BSLASH
-# elif defined(CERNLIB_BSLASH)
-# undef CERNLIB_BSLASH
-# endif
-#endif
-
-#if (defined(CERNLIB_UNIX))||(!defined(CERNLIB_SINGLE))
-
-#ifndef CERNLIB_DOUBLE
-#define CERNLIB_DOUBLE
-#endif
-
-#endif
-
-#if defined(CERNLIB_VAXVMS)
-
-#ifndef CERNLIB_VAX
-#define CERNLIB_VAX
-#endif
-#ifndef CERNLIB_DOUBLE
-#define CERNLIB_DOUBLE
-#endif
-
-#endif
-
-#if defined(CERNLIB_QMVAOS)
-#ifndef CERNLIB_ALPHAOSF
-#define CERNLIB_ALPHAOSF
-#endif
-#endif
-
-#if defined(CERNLIB_QMALPH)
-#ifndef CERNLIB_ALPHAVMS
-#define CERNLIB_ALPHAVMS
-#define CERNLIB_BSLASH
-#endif
-#endif
-
-#if defined(CERNLIB_ALPHAVMS) || defined(CERNLIB_ALPHAOSF)
-#ifndef CERNLIB_ALPHA
-#define CERNLIB_ALPHA
-#endif
-#endif
-
-#if defined(CERNLIB_ALPHAVMS) || defined(CERNLIB_VAXVMS)
-#ifndef CERNLIB_VMS
-#define CERNLIB_VMS
-#endif
-#endif
-
-
diff --git a/src/packlib/kuip/kuiph/Imakefile b/src/packlib/kuip/kuiph/Imakefile
deleted file mode 100644
index 15a4311..0000000
--- a/src/packlib/kuip/kuiph/Imakefile
+++ /dev/null
@@ -1,3 +0,0 @@
-SRCS_C= khash.c kstring.c kuip.c
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kuip/kuiph/khash.c b/src/packlib/kuip/kuiph/khash.c
deleted file mode 100644
index 6e89278..0000000
--- a/src/packlib/kuip/kuiph/khash.c
+++ /dev/null
@@ -1,11 +0,0 @@
-/*
- * $Id: khash.c,v 1.1.1.1 1996/03/08 15:33:13 mclareni Exp $
- *
- * $Log: khash.c,v $
- * Revision 1.1.1.1 1996/03/08 15:33:13 mclareni
- * Kuip
- *
- */
-/*CMZ : 2.06/00 22/09/94 13.44.29 by Alfred Nathaniel*/
-/*-- Author : Alfred Nathaniel 22/09/94*/
-#include "kuip/khash.h"
diff --git a/src/packlib/kuip/kuiph/kstring.c b/src/packlib/kuip/kuiph/kstring.c
deleted file mode 100644
index c6b066d..0000000
--- a/src/packlib/kuip/kuiph/kstring.c
+++ /dev/null
@@ -1,11 +0,0 @@
-/*
- * $Id: kstring.c,v 1.1.1.1 1996/03/08 15:33:13 mclareni Exp $
- *
- * $Log: kstring.c,v $
- * Revision 1.1.1.1 1996/03/08 15:33:13 mclareni
- * Kuip
- *
- */
-/*CMZ : 2.05/09 12/07/94 14.55.03 by Alfred Nathaniel*/
-#include "kuip/kstring.h"
-/*-- Author : Alfred Nathaniel 12/07/94*/
diff --git a/src/packlib/kuip/kuiph/kuip.c b/src/packlib/kuip/kuiph/kuip.c
deleted file mode 100644
index 5bf0c9b..0000000
--- a/src/packlib/kuip/kuiph/kuip.c
+++ /dev/null
@@ -1,11 +0,0 @@
-/*
- * $Id: kuip.c,v 1.1.1.1 1996/03/08 15:33:13 mclareni Exp $
- *
- * $Log: kuip.c,v $
- * Revision 1.1.1.1 1996/03/08 15:33:13 mclareni
- * Kuip
- *
- */
-/*CMZ : 2.05/09 12/07/94 14.55.03 by Alfred Nathaniel*/
-/*-- Author : Alfred Nathaniel 12/07/94*/
-#include "kuip/kuser.h"
diff --git a/src/packlib/kuip/programs/Imakefile b/src/packlib/kuip/programs/Imakefile
deleted file mode 100644
index 60d60bd..0000000
--- a/src/packlib/kuip/programs/Imakefile
+++ /dev/null
@@ -1,18 +0,0 @@
-
-#define IHaveSubdirs
-#define PassCDebugFlags
-
-MotifDependantMakeVar(KXTERM,kxterm)
-
-
-#if ! defined(CERNLIB_WINNT)
-SUBDIRS= kuipc $(KXTERM)
-#endif
-
-#if defined(CERNLIB_UNIX) && !defined(CERNLIB_WINNT)
-SUBDIRS := $(SUBDIRS) kuesvr
-#endif
-
-InstallBinSubdirs($(SUBDIRS))
-
-DelegateTarget(bin/kuipc,kuipc)
diff --git a/src/packlib/kuip/programs/kuesvr/Imakefile b/src/packlib/kuip/programs/kuesvr/Imakefile
deleted file mode 100644
index 329a48e..0000000
--- a/src/packlib/kuip/programs/kuesvr/Imakefile
+++ /dev/null
@@ -1,4 +0,0 @@
-
-NormalProgramTarget(kuesvr,kuesvr.o,NullParameter,NullParameter,NullParameter)
-
-InstallProgram(kuesvr,$(CERN)/$(CERN_LEVEL)/bin)
diff --git a/src/packlib/kuip/programs/kuesvr/kuesvr.c b/src/packlib/kuip/programs/kuesvr/kuesvr.c
deleted file mode 100644
index ce0e561..0000000
--- a/src/packlib/kuip/programs/kuesvr/kuesvr.c
+++ /dev/null
@@ -1,115 +0,0 @@
-/*
- * $Id: kuesvr.c,v 1.2 2005/04/18 15:23:10 mclareni Exp $
- *
- * $Log: kuesvr.c,v $
- * Revision 1.2 2005/04/18 15:23:10 mclareni
- * Mods submitted by Kevin B. McCarty to fix insecure Cernlib uses of /tmp.
- *
- * Revision 1.1.1.1 1996/03/08 15:33:05 mclareni
- * Kuip
- *
- */
-/*CMZ : 2.05/09 06/07/94 17.33.53 by Alfred Nathaniel*/
-/*-- Author :*/
-
-#include "kuip/kuip.h"
-
-int pid = 0;
-char *editor = "vi";
-char *cmd = '\0';
-char *file = '\0';
-char *sfile = '\0';
-
-
-main(int argc, char **argv)
-{
- int c, fid;
- char *arg;
- char shcmd[512];
- char msg[BUFSIZ];
- time_t mtime;
- struct stat buf;
-
- /* scan options */
- while (--argc) {
- arg = *++argv;
- c = *arg;
- if (c == '-') {
- c = *++arg;
- switch (c) {
- case 'p':
- if (*++arg == 0)
- arg = *++argv;
- pid = atoi(arg);
- break;
- case 'e':
- if (*++arg == 0)
- arg = *++argv;
- editor = arg;
- break;
- case 'c':
- if (*++arg == 0)
- arg = *++argv;
- cmd = arg;
- break;
- case 't':
- if (*++arg == 0)
- arg = *++argv;
- sfile = arg;
- break;
- default:
- fprintf(stderr,"Usage: kuesvr -p pid -c cmd -t tmpfile [-e editor] file\n");
- exit(1);
- }
- } else {
- file = arg;
- break;
- }
- }
-
- if (!pid || !file || !cmd || !sfile) {
- fprintf(stderr,"Usage: kuesvr -p pid -c cmd -t tmpfile [-e editor] file\n");
- exit(1);
- }
-
- sprintf(shcmd, "%s %s", editor, file);
-
- stat(file, &buf);
- mtime = buf.st_mtime;
-
- system(shcmd);
-
- stat(file, &buf);
-
- /* open kuip edit server message file */
- fid = open(sfile, O_CREAT|O_APPEND|O_WRONLY, 0600);
- if (fid == -1) {
- perror("open");
- exit(1);
- }
-
- /* lock the file */
- if (lockf(fid, F_LOCK, (off_t)0) == -1) {
- perror("lockf");
- exit(1);
- }
-
- /* if file was not changed prepend a - to the filename */
- if (buf.st_mtime != mtime)
- sprintf(msg, "%s %s\n", file, cmd);
- else
- sprintf(msg, "-%s %s\n", file, cmd);
-
- write(fid, msg, strlen(msg));
-
- /* unlock the file */
- if (lockf(fid, F_ULOCK, (off_t)0) == -1) {
- perror("un-lockf");
- exit(1);
- }
-
- close(fid);
-
- /* signal the mother process (pid) that the editor terminated */
- kill(pid, SIGUSR1);
-}
diff --git a/src/packlib/kuip/programs/kuipc/Imakefile b/src/packlib/kuip/programs/kuipc/Imakefile
deleted file mode 100644
index f45c4c3..0000000
--- a/src/packlib/kuip/programs/kuipc/Imakefile
+++ /dev/null
@@ -1,19 +0,0 @@
-SRCS_C = kuipcc.c kkern.c
-OBJS = kuipcc.o kkern.o
-
-NormalProgramTarget(kuipc,$(OBJS),NullParameter,NullParameter,NullParameter)
-
-InstallProgram(kuipc,$(CERN_BINDIR))
-
-M4FILES= kbrow_q1.m4 kbrow_q2.m4 kbrow_q3.m4 kbrow_q4.m4 \ @@\
- kmenu_q1.m4 kmenu_q2.m4 kmenu_q3.m4 kmenu_q4.m4 kmenu_q5.m4 \ @@\
- klink_q1.m4
-
-HEADERS=$(M4FILES:.m4=.h)
-
-headers:: $(HEADERS)
-
-.SUFFIXES: .m4
-
-.m4.h:
- $(M4) $(ALLINCLUDES) $< > $@
diff --git a/src/packlib/kuip/programs/kuipc/kbrow_q1.h b/src/packlib/kuip/programs/kuipc/kbrow_q1.h
deleted file mode 100644
index 407b564..0000000
--- a/src/packlib/kuip/programs/kuipc/kbrow_q1.h
+++ /dev/null
@@ -1,42 +0,0 @@
-/*
- * $Id: kbrow_q1.h,v 1.2 1996/04/16 13:42:56 gunter Exp $
- *
- * $Log: kbrow_q1.h,v $
- * Revision 1.2 1996/04/16 13:42:56 gunter
- * Add kkern.c routines by including the routine from code_kuip; this resolves
- * missing symbols to build kuipc without any library.
- *
- * Revision 1.1 1996/04/16 13:29:36 gunter
- * Mods to compile kuipc.
- * The header files can be deleted and remade from the .m4 files. Use gnu's m4,
- * ie.:
- * gmake headers M4=/usr/local/bin/m4
- * And then
- * gmake kuipc
- *
- * Revision 1.1.1.1 1996/03/08 15:33:00 mclareni
- * Kuip
- *
- */
-
-
-"typedef unsigned long KmPixmap; /* Pixmap from <X11/X.h> */ \
-typedef void *KmWidget; /* Widget from <X11/Intrinsic.h> */ \
-typedef void *KmCalldata; /* XmAnyCallbackStruct from <Motif/Xm.h> */ \
- /* */ \
-typedef enum { /* */ \
- BRACT_OPEN = 0, /* */ \
- BRACT_ROOT = 1, /* */ \
- BRACT_CONT = 2, /* */ \
- BRACT_GRAF = 3 /* */ \
-} BrActTag; /* */ \
- /* */ \
-typedef enum { /* */ \
- BrActUpdate = 0x01, /* browser window has to be updated ('!') */ \
- BrActSeparator = 0x02, /* put separator in menu ('/') */ \
- BrActToggle = 0x04, /* register as toggle button */ \
- BrActToggleOn = 0x08, /* toggle state is on */ \
- BrActSensitive = 0x10 /* button is sensitive */ \
-} BrActFlag; /* */ \
- /* */ \
-"
diff --git a/src/packlib/kuip/programs/kuipc/kbrow_q1.m4 b/src/packlib/kuip/programs/kuipc/kbrow_q1.m4
deleted file mode 100644
index 599a385..0000000
--- a/src/packlib/kuip/programs/kuipc/kbrow_q1.m4
+++ /dev/null
@@ -1,19 +0,0 @@
-/*
- * $Id: kbrow_q1.m4,v 1.1 1996/04/16 13:29:36 gunter Exp $
- *
- * $Log: kbrow_q1.m4,v $
- * Revision 1.1 1996/04/16 13:29:36 gunter
- * Mods to compile kuipc.
- * The header files can be deleted and remade from the .m4 files. Use gnu's m4,
- * ie.:
- * gmake headers M4=/usr/local/bin/m4
- * And then
- * gmake kuipc
- *
- * Revision 1.1.1.1 1996/03/08 15:33:00 mclareni
- * Kuip
- *
- */
-define(__,\)
-
-"include(kuip/kbrow1.h)"
diff --git a/src/packlib/kuip/programs/kuipc/kbrow_q2.h b/src/packlib/kuip/programs/kuipc/kbrow_q2.h
deleted file mode 100644
index 0877194..0000000
--- a/src/packlib/kuip/programs/kuipc/kbrow_q2.h
+++ /dev/null
@@ -1,48 +0,0 @@
-/*
- * $Id: kbrow_q2.h,v 1.2 1996/04/16 13:42:57 gunter Exp $
- *
- * $Log: kbrow_q2.h,v $
- * Revision 1.2 1996/04/16 13:42:57 gunter
- * Add kkern.c routines by including the routine from code_kuip; this resolves
- * missing symbols to build kuipc without any library.
- *
- * Revision 1.1 1996/04/16 13:29:37 gunter
- * Mods to compile kuipc.
- * The header files can be deleted and remade from the .m4 files. Use gnu's m4,
- * ie.:
- * gmake headers M4=/usr/local/bin/m4
- * And then
- * gmake kuipc
- *
- * Revision 1.1.1.1 1996/03/08 15:33:00 mclareni
- * Kuip
- *
- */
-
-
-"typedef struct _BrAction { /* */ \
- struct _BrAction *next; /* link to next action binding */ \
- BrActFlag flags; /* */ \
- char *text; /* text line in menu */ \
- char *user_text; /* user text overriding CDF text (malloced)*/ \
- char *accel; /* accelerator */ \
- char *exec; /* action commands */ \
- SUBROUTINE *call_F; /* action routine */ \
- IntFunc *call_C; /* action function */ \
- BrActTag tag; /* for which window the action is defined */ \
- struct _BrClass *class; /* pointer to BrClass in case of open menu */ \
-} BrAction; /* */ \
- /* */ \
-typedef struct _BrClass { /* */ \
- struct _BrClass *next; /* link to next browsable class */ \
- char *name; /* unique identifier name */ \
- char *title; /* title for popup menu (maybe NULL) */ \
- SUBROUTINE *scan_km_F; /* user function scanning the directory */ \
- pCharFunc *scan_km_C; /* user function scanning the directory */ \
- SUBROUTINE *scan_br_F; /* user function scanning for browsables */ \
- pCharFunc *scan_br_C; /* user function scanning for browsables */ \
- BrAction *root; /* list of actions in root window */ \
- BrAction *open; /* list of actions in open menu */ \
-} BrClass; /* */ \
- /* */ \
-"
diff --git a/src/packlib/kuip/programs/kuipc/kbrow_q2.m4 b/src/packlib/kuip/programs/kuipc/kbrow_q2.m4
deleted file mode 100644
index f62950c..0000000
--- a/src/packlib/kuip/programs/kuipc/kbrow_q2.m4
+++ /dev/null
@@ -1,19 +0,0 @@
-/*
- * $Id: kbrow_q2.m4,v 1.1 1996/04/16 13:29:37 gunter Exp $
- *
- * $Log: kbrow_q2.m4,v $
- * Revision 1.1 1996/04/16 13:29:37 gunter
- * Mods to compile kuipc.
- * The header files can be deleted and remade from the .m4 files. Use gnu's m4,
- * ie.:
- * gmake headers M4=/usr/local/bin/m4
- * And then
- * gmake kuipc
- *
- * Revision 1.1.1.1 1996/03/08 15:33:00 mclareni
- * Kuip
- *
- */
-define(__,\)
-
-"include(kuip/kbrow2.h)"
diff --git a/src/packlib/kuip/programs/kuipc/kbrow_q3.h b/src/packlib/kuip/programs/kuipc/kbrow_q3.h
deleted file mode 100644
index c58fafe..0000000
--- a/src/packlib/kuip/programs/kuipc/kbrow_q3.h
+++ /dev/null
@@ -1,49 +0,0 @@
-/*
- * $Id: kbrow_q3.h,v 1.2 1996/04/16 13:42:57 gunter Exp $
- *
- * $Log: kbrow_q3.h,v $
- * Revision 1.2 1996/04/16 13:42:57 gunter
- * Add kkern.c routines by including the routine from code_kuip; this resolves
- * missing symbols to build kuipc without any library.
- *
- * Revision 1.1 1996/04/16 13:29:38 gunter
- * Mods to compile kuipc.
- * The header files can be deleted and remade from the .m4 files. Use gnu's m4,
- * ie.:
- * gmake headers M4=/usr/local/bin/m4
- * And then
- * gmake kuipc
- *
- * Revision 1.1.1.1 1996/03/08 15:33:00 mclareni
- * Kuip
- *
- */
-
-
-"typedef struct _KmIcon { /* */ \
- struct _KmIcon *next; /* link to next icon */ \
- char *name; /* unique identifier name */ \
- int width; /* width of the pixmap */ \
- int height; /* height of the pixmap */ \
- char *bitmap; /* bitmap data */ \
- KmPixmap pix; /* filled in Motif part */ \
- KmPixmap hi_pix; /* high lighted pixmap */ \
-} KmIcon; /* */ \
- /* */ \
-typedef struct _KmClass { /* */ \
- struct _KmClass *next; /* link to next object class */ \
- int is_dir; /* flag if class has is a directory */ \
- char *name; /* unique identifier name */ \
- char *title; /* title for popup menu (maybe NULL) */ \
- char *big_icon; /* name of the big icon */ \
- KmIcon *bicon; /* pointer to the big icon structure */ \
- char *sm_icon; /* name of the small icon */ \
- KmIcon *sicon; /* pointer to the small icon structure */ \
- SUBROUTINE *user_icon_F; /* user function to return icon bitmap */ \
- IntFunc *user_icon_C; /* user function to return icon bitmap */ \
- BrAction *cont; /* list of actions in content window */ \
- BrAction *graf; /* list of actions in graphics window */ \
- int obj_count; /* number of objects in content window */ \
-} KmClass; /* */ \
- /* */ \
-"
diff --git a/src/packlib/kuip/programs/kuipc/kbrow_q3.m4 b/src/packlib/kuip/programs/kuipc/kbrow_q3.m4
deleted file mode 100644
index a4fa1e6..0000000
--- a/src/packlib/kuip/programs/kuipc/kbrow_q3.m4
+++ /dev/null
@@ -1,19 +0,0 @@
-/*
- * $Id: kbrow_q3.m4,v 1.1 1996/04/16 13:29:38 gunter Exp $
- *
- * $Log: kbrow_q3.m4,v $
- * Revision 1.1 1996/04/16 13:29:38 gunter
- * Mods to compile kuipc.
- * The header files can be deleted and remade from the .m4 files. Use gnu's m4,
- * ie.:
- * gmake headers M4=/usr/local/bin/m4
- * And then
- * gmake kuipc
- *
- * Revision 1.1.1.1 1996/03/08 15:33:00 mclareni
- * Kuip
- *
- */
-define(__,\)
-
-"include(kuip/kbrow3.h)"
diff --git a/src/packlib/kuip/programs/kuipc/kbrow_q4.h b/src/packlib/kuip/programs/kuipc/kbrow_q4.h
deleted file mode 100644
index 522e9da..0000000
--- a/src/packlib/kuip/programs/kuipc/kbrow_q4.h
+++ /dev/null
@@ -1,46 +0,0 @@
-/*
- * $Id: kbrow_q4.h,v 1.2 1996/04/16 13:42:58 gunter Exp $
- *
- * $Log: kbrow_q4.h,v $
- * Revision 1.2 1996/04/16 13:42:58 gunter
- * Add kkern.c routines by including the routine from code_kuip; this resolves
- * missing symbols to build kuipc without any library.
- *
- * Revision 1.1 1996/04/16 13:29:39 gunter
- * Mods to compile kuipc.
- * The header files can be deleted and remade from the .m4 files. Use gnu's m4,
- * ie.:
- * gmake headers M4=/usr/local/bin/m4
- * And then
- * gmake kuipc
- *
- * Revision 1.1.1.1 1996/03/08 15:33:00 mclareni
- * Kuip
- *
- */
-
-
-"typedef enum { /* */ \
- KmButtSensitive = 0x00, /* sensitive button */ \
- KmButtNonSensitive = 0x01, /* non-sensitive button ('NS') */ \
- KmButtToggleSensitive = 0x02, /* toggle-sensitive button ('TS') */ \
- KmButtSensitivityMask = 0x03, /* mask for sensitivity type */ \
- KmButtSeparator = 0x04, /* put separator in menu ('/') */ \
- KmButtBrowser = 0x08 /* button is in main browser ('BR') */ \
-} KmButtFlag; /* */ \
- /* */ \
-typedef struct _KmButton { /* */ \
- struct _KmButton *next; /* button label or menu item */ \
- char *menu; /* menu name or NULL for buttons */ \
- char *label; /* button label or menu item */ \
- SUBROUTINE *call_F; /* callback routine (FORTRAN) */ \
- IntFunc *call_C; /* callback routine (C) */ \
- char *action; /* name of callback routine */ \
- char *mnemo; /* button mnemonic */ \
- char *accel; /* button accelerator */ \
- char *accel_text; /* button accelerator text */ \
- KmButtFlag flags; /* sensitivity type etc. */ \
- KmWidget widget; /* Motif widget ID */ \
-} KmButton; /* */ \
- /* */ \
-"
diff --git a/src/packlib/kuip/programs/kuipc/kbrow_q4.m4 b/src/packlib/kuip/programs/kuipc/kbrow_q4.m4
deleted file mode 100644
index d60862d..0000000
--- a/src/packlib/kuip/programs/kuipc/kbrow_q4.m4
+++ /dev/null
@@ -1,19 +0,0 @@
-/*
- * $Id: kbrow_q4.m4,v 1.1 1996/04/16 13:29:39 gunter Exp $
- *
- * $Log: kbrow_q4.m4,v $
- * Revision 1.1 1996/04/16 13:29:39 gunter
- * Mods to compile kuipc.
- * The header files can be deleted and remade from the .m4 files. Use gnu's m4,
- * ie.:
- * gmake headers M4=/usr/local/bin/m4
- * And then
- * gmake kuipc
- *
- * Revision 1.1.1.1 1996/03/08 15:33:00 mclareni
- * Kuip
- *
- */
-define(__,\)
-
-"include(kuip/kbrow4.h)"
diff --git a/src/packlib/kuip/programs/kuipc/kkern.c b/src/packlib/kuip/programs/kuipc/kkern.c
deleted file mode 100644
index ecc1a9a..0000000
--- a/src/packlib/kuip/programs/kuipc/kkern.c
+++ /dev/null
@@ -1 +0,0 @@
-#include "code_kuip/kkern.c"
diff --git a/src/packlib/kuip/programs/kuipc/klink_q1.h b/src/packlib/kuip/programs/kuipc/klink_q1.h
deleted file mode 100644
index c72418d..0000000
--- a/src/packlib/kuip/programs/kuipc/klink_q1.h
+++ /dev/null
@@ -1,34 +0,0 @@
-/*
- * $Id: klink_q1.h,v 1.2 1996/04/16 13:42:59 gunter Exp $
- *
- * $Log: klink_q1.h,v $
- * Revision 1.2 1996/04/16 13:42:59 gunter
- * Add kkern.c routines by including the routine from code_kuip; this resolves
- * missing symbols to build kuipc without any library.
- *
- * Revision 1.1 1996/04/16 13:29:41 gunter
- * Mods to compile kuipc.
- * The header files can be deleted and remade from the .m4 files. Use gnu's m4,
- * ie.:
- * gmake headers M4=/usr/local/bin/m4
- * And then
- * gmake kuipc
- *
- * Revision 1.1.1.1 1996/03/08 15:33:00 mclareni
- * Kuip
- *
- */
-
-
-"struct { /* */ \
- /* indirect calls to avoid linking HIGZ */ \
- IntFunc *graf_info_C; /* pass display, open and close (ixmotif) */ \
- SUBROUTINE *graf_size_F; /* resize window (IGRSIZ) */ \
- SUBROUTINE *graf_pick_F; /* identifying graphics objects (IGOBJ) */ \
- SUBROUTINE *graf_attr_F; /* set attributes (IGSET) */ \
- SUBROUTINE *graf_close_F; /* close workstation (ICLWK) */ \
- /* optional routines for Motif customization */ \
- pCharFunc *user_FallBk_C; /* get application fallbacks */ \
- IntFunc *user_TopWid_C; /* pass toplevel widget identifiers */ \
-} klnkaddr; /* */ \
-"
diff --git a/src/packlib/kuip/programs/kuipc/klink_q1.m4 b/src/packlib/kuip/programs/kuipc/klink_q1.m4
deleted file mode 100644
index dbed7df..0000000
--- a/src/packlib/kuip/programs/kuipc/klink_q1.m4
+++ /dev/null
@@ -1,19 +0,0 @@
-/*
- * $Id: klink_q1.m4,v 1.1 1996/04/16 13:29:41 gunter Exp $
- *
- * $Log: klink_q1.m4,v $
- * Revision 1.1 1996/04/16 13:29:41 gunter
- * Mods to compile kuipc.
- * The header files can be deleted and remade from the .m4 files. Use gnu's m4,
- * ie.:
- * gmake headers M4=/usr/local/bin/m4
- * And then
- * gmake kuipc
- *
- * Revision 1.1.1.1 1996/03/08 15:33:00 mclareni
- * Kuip
- *
- */
-define(__,\)
-
-"include(kuip/klink1.h)"
diff --git a/src/packlib/kuip/programs/kuipc/kmenu_q1.h b/src/packlib/kuip/programs/kuipc/kmenu_q1.h
deleted file mode 100644
index a8e8b3f..0000000
--- a/src/packlib/kuip/programs/kuipc/kmenu_q1.h
+++ /dev/null
@@ -1,41 +0,0 @@
-/*
- * $Id: kmenu_q1.h,v 1.2 1996/04/16 13:42:59 gunter Exp $
- *
- * $Log: kmenu_q1.h,v $
- * Revision 1.2 1996/04/16 13:42:59 gunter
- * Add kkern.c routines by including the routine from code_kuip; this resolves
- * missing symbols to build kuipc without any library.
- *
- * Revision 1.1 1996/04/16 13:29:42 gunter
- * Mods to compile kuipc.
- * The header files can be deleted and remade from the .m4 files. Use gnu's m4,
- * ie.:
- * gmake headers M4=/usr/local/bin/m4
- * And then
- * gmake kuipc
- *
- * Revision 1.1.1.1 1996/03/08 15:33:01 mclareni
- * Kuip
- *
- */
-
-
-"typedef enum { /* */ \
- KmFLAG_FORGET = 0x01, /* last value is not kept for Motif panels */ \
- KmFLAG_MINUS = 0x02, /* -VALUE is not an abbrev for CHOPT=VALUE */ \
- KmFLAG_QUOTE = 0x04, /* do not remove quotes */ \
- KmFLAG_VARARG = 0x08, /* append additional args to this param. */ \
- KmFLAG_CONST = 0x10, /* do not allow to assign a value */ \
- KmFLAG_HIDDEN = 0x20, /* do not show in menus */ \
- KmFLAG_SEPARATE = 0x40 /* treat arguments as separate tokens */ \
-} KmParFlag; /* */ \
- /* */ \
-typedef enum { /* */ \
- KmTYPE_CHAR = 'C', /* character string */ \
- KmTYPE_FILE = 'F', /* file name */ \
- KmTYPE_INT = 'I', /* integer */ \
- KmTYPE_OPTION = 'O', /* option */ \
- KmTYPE_REAL = 'R' /* real */ \
-} KmParType; /* */ \
- /* */ \
-"
diff --git a/src/packlib/kuip/programs/kuipc/kmenu_q1.m4 b/src/packlib/kuip/programs/kuipc/kmenu_q1.m4
deleted file mode 100644
index abb249d..0000000
--- a/src/packlib/kuip/programs/kuipc/kmenu_q1.m4
+++ /dev/null
@@ -1,19 +0,0 @@
-/*
- * $Id: kmenu_q1.m4,v 1.1 1996/04/16 13:29:42 gunter Exp $
- *
- * $Log: kmenu_q1.m4,v $
- * Revision 1.1 1996/04/16 13:29:42 gunter
- * Mods to compile kuipc.
- * The header files can be deleted and remade from the .m4 files. Use gnu's m4,
- * ie.:
- * gmake headers M4=/usr/local/bin/m4
- * And then
- * gmake kuipc
- *
- * Revision 1.1.1.1 1996/03/08 15:33:01 mclareni
- * Kuip
- *
- */
-define(__,\)
-
-"include(kuip/kmenu1.h)"
diff --git a/src/packlib/kuip/programs/kuipc/kmenu_q2.h b/src/packlib/kuip/programs/kuipc/kmenu_q2.h
deleted file mode 100644
index 612ab8b..0000000
--- a/src/packlib/kuip/programs/kuipc/kmenu_q2.h
+++ /dev/null
@@ -1,41 +0,0 @@
-/*
- * $Id: kmenu_q2.h,v 1.2 1996/04/16 13:43:00 gunter Exp $
- *
- * $Log: kmenu_q2.h,v $
- * Revision 1.2 1996/04/16 13:43:00 gunter
- * Add kkern.c routines by including the routine from code_kuip; this resolves
- * missing symbols to build kuipc without any library.
- *
- * Revision 1.1 1996/04/16 13:29:43 gunter
- * Mods to compile kuipc.
- * The header files can be deleted and remade from the .m4 files. Use gnu's m4,
- * ie.:
- * gmake headers M4=/usr/local/bin/m4
- * And then
- * gmake kuipc
- *
- * Revision 1.1.1.1 1996/03/08 15:33:01 mclareni
- * Kuip
- *
- */
-
-"typedef struct { /* file name */ \
- char *filter_default; /* filter wildcard */ \
- char *filter_current; /* current filter */ \
-} KmParFile; /* */ \
- /* */ \
-typedef struct { /* */ \
- char *range_lower; /* lower value of range */ \
- char *range_upper; /* upper value of range */ \
- char *slider_lower; /* lower limit for slider */ \
- char *slider_upper; /* upper limit for slider */ \
- int decimals; /* number of decimals used for slider */ \
-} KmParInt; /* */ \
- /* */ \
-typedef struct { /* option */ \
- char **text; /* explanations (parallel to range_value) */ \
- int *mutex; /* mutex group to which text belongs */ \
- int *radio; /* radio group to which text belongs */ \
-} KmParOption; /* */ \
- /* */ \
-"
diff --git a/src/packlib/kuip/programs/kuipc/kmenu_q2.m4 b/src/packlib/kuip/programs/kuipc/kmenu_q2.m4
deleted file mode 100644
index 62c1540..0000000
--- a/src/packlib/kuip/programs/kuipc/kmenu_q2.m4
+++ /dev/null
@@ -1,18 +0,0 @@
-/*
- * $Id: kmenu_q2.m4,v 1.1 1996/04/16 13:29:43 gunter Exp $
- *
- * $Log: kmenu_q2.m4,v $
- * Revision 1.1 1996/04/16 13:29:43 gunter
- * Mods to compile kuipc.
- * The header files can be deleted and remade from the .m4 files. Use gnu's m4,
- * ie.:
- * gmake headers M4=/usr/local/bin/m4
- * And then
- * gmake kuipc
- *
- * Revision 1.1.1.1 1996/03/08 15:33:01 mclareni
- * Kuip
- *
- */
-define(__,\)
-"include(kuip/kmenu2.h)"
diff --git a/src/packlib/kuip/programs/kuipc/kmenu_q3.h b/src/packlib/kuip/programs/kuipc/kmenu_q3.h
deleted file mode 100644
index 91a34d7..0000000
--- a/src/packlib/kuip/programs/kuipc/kmenu_q3.h
+++ /dev/null
@@ -1,41 +0,0 @@
-/*
- * $Id: kmenu_q3.h,v 1.2 1996/04/16 13:43:01 gunter Exp $
- *
- * $Log: kmenu_q3.h,v $
- * Revision 1.2 1996/04/16 13:43:01 gunter
- * Add kkern.c routines by including the routine from code_kuip; this resolves
- * missing symbols to build kuipc without any library.
- *
- * Revision 1.1 1996/04/16 13:29:44 gunter
- * Mods to compile kuipc.
- * The header files can be deleted and remade from the .m4 files. Use gnu's m4,
- * ie.:
- * gmake headers M4=/usr/local/bin/m4
- * And then
- * gmake kuipc
- *
- * Revision 1.1.1.1 1996/03/08 15:33:01 mclareni
- * Kuip
- *
- */
-
-
-"typedef KmParInt KmParReal; /* real and int have the same fields */ \
- /* */ \
-typedef struct { /* */ \
- char *name; /* parameter name */ \
- int abbrev; /* minimum length that name is recognized */ \
- char *prompt; /* prompt string */ \
- char *dfault; /* default value */ \
- char *last; /* last value for Motif panel (malloced) */ \
- int width; /* width of input field */ \
- int range_count; /* number of items in range_value */ \
- char **range_value; /* list of allowed values */ \
- int select_count; /* number of items in select_count */ \
- char **select_value; /* list of values for selection box */ \
- KmParFlag flags; /* special flags */ \
- KmParType type; /* parameter type */ \
- void *ptype; /* structure pointer selected by type */ \
-} KmParameter; /* */ \
- /* */ \
-"
diff --git a/src/packlib/kuip/programs/kuipc/kmenu_q3.m4 b/src/packlib/kuip/programs/kuipc/kmenu_q3.m4
deleted file mode 100644
index 1ec4a71..0000000
--- a/src/packlib/kuip/programs/kuipc/kmenu_q3.m4
+++ /dev/null
@@ -1,19 +0,0 @@
-/*
- * $Id: kmenu_q3.m4,v 1.1 1996/04/16 13:29:44 gunter Exp $
- *
- * $Log: kmenu_q3.m4,v $
- * Revision 1.1 1996/04/16 13:29:44 gunter
- * Mods to compile kuipc.
- * The header files can be deleted and remade from the .m4 files. Use gnu's m4,
- * ie.:
- * gmake headers M4=/usr/local/bin/m4
- * And then
- * gmake kuipc
- *
- * Revision 1.1.1.1 1996/03/08 15:33:01 mclareni
- * Kuip
- *
- */
-define(__,\)
-
-"include(kuip/kmenu3.h)"
diff --git a/src/packlib/kuip/programs/kuipc/kmenu_q4.h b/src/packlib/kuip/programs/kuipc/kmenu_q4.h
deleted file mode 100644
index a60e8a3..0000000
--- a/src/packlib/kuip/programs/kuipc/kmenu_q4.h
+++ /dev/null
@@ -1,51 +0,0 @@
-/*
- * $Id: kmenu_q4.h,v 1.3 1997/03/14 17:15:56 mclareni Exp $
- *
- * $Log: kmenu_q4.h,v $
- * Revision 1.3 1997/03/14 17:15:56 mclareni
- * WNT mods
- *
- * Revision 1.2.2.1 1997/01/21 11:33:18 mclareni
- * All mods for Winnt 96a on winnt branch
- *
- * Revision 1.1 1996/04/16 13:29:46 gunter
- * Mods to compile kuipc.
- * The header files can be deleted and remade from the .m4 files. Use gnu's m4,
- * ie.:
- * gmake headers M4=/usr/local/bin/m4
- * And then
- * gmake kuipc
- *
- * Revision 1.1.1.1 1996/03/08 15:33:01 mclareni
- * Kuip
- *
- */
-
-
-"typedef struct _KmCommand { /* */ \
- struct _KmCommand *next; /* link to next command */ \
- char *path; /* command path */ \
- char *name; /* command name */ \
- int hidden; /* flag if command is invisible */ \
- int level; /* depth of submenus */ \
- int total; /* total number of parameters */ \
- int mandatory; /* number of mandatory parameters */ \
- KmParameter **par; /* list of total parameter descriptions */ \
- int list_par; /* index+1 of parameter taking a list */ \
- int xcount; /* count number of action calls */ \
- SUBROUTINE *action_F; /* action routine */ \
- IntFunc *action_C; /* action routine */ \
- SUBROUTINE *user_help_F; /* user help routine */ \
- pCharFunc *user_help_C; /* user help routine */ \
- int nguidance; /* number of lines in guidance text */ \
- char **guidance; /* help text */ \
- int nkeyword; /* number of lines for keywords */ \
- char **keyword; /* list of keywords */ \
- int nhlink; /* number of lines for links */ \
- char **hlink; /* list of links */ \
- int argc; /* number of arguments entered */ \
- char **argv; /* argc argument values */ \
- char *argline; /* argument line as entered */ \
- int *argoffs; /* argc offsets into argline for KUGETE */ \
-} KmCommand; /* */ \
-"
diff --git a/src/packlib/kuip/programs/kuipc/kmenu_q4.m4 b/src/packlib/kuip/programs/kuipc/kmenu_q4.m4
deleted file mode 100644
index 0536df2..0000000
--- a/src/packlib/kuip/programs/kuipc/kmenu_q4.m4
+++ /dev/null
@@ -1,19 +0,0 @@
-/*
- * $Id: kmenu_q4.m4,v 1.1 1996/04/16 13:29:46 gunter Exp $
- *
- * $Log: kmenu_q4.m4,v $
- * Revision 1.1 1996/04/16 13:29:46 gunter
- * Mods to compile kuipc.
- * The header files can be deleted and remade from the .m4 files. Use gnu's m4,
- * ie.:
- * gmake headers M4=/usr/local/bin/m4
- * And then
- * gmake kuipc
- *
- * Revision 1.1.1.1 1996/03/08 15:33:01 mclareni
- * Kuip
- *
- */
-define(__,\)
-
-"include(kuip/kmenu4.h)"
diff --git a/src/packlib/kuip/programs/kuipc/kmenu_q5.h b/src/packlib/kuip/programs/kuipc/kmenu_q5.h
deleted file mode 100644
index 5cecfbf..0000000
--- a/src/packlib/kuip/programs/kuipc/kmenu_q5.h
+++ /dev/null
@@ -1,43 +0,0 @@
-/*
- * $Id: kmenu_q5.h,v 1.2 1996/04/16 13:43:03 gunter Exp $
- *
- * $Log: kmenu_q5.h,v $
- * Revision 1.2 1996/04/16 13:43:03 gunter
- * Add kkern.c routines by including the routine from code_kuip; this resolves
- * missing symbols to build kuipc without any library.
- *
- * Revision 1.1 1996/04/16 13:29:48 gunter
- * Mods to compile kuipc.
- * The header files can be deleted and remade from the .m4 files. Use gnu's m4,
- * ie.:
- * gmake headers M4=/usr/local/bin/m4
- * And then
- * gmake kuipc
- *
- * Revision 1.1.1.1 1996/03/08 15:33:01 mclareni
- * Kuip
- *
- */
-
-
-"typedef struct _KmMenu { /* */ \
- struct _KmMenu *next; /* link to next menu */ \
- struct _KmMenu *down; /* link to submenu */ \
- char *path; /* path of parent menu */ \
- char *name; /* menu name */ \
- int level; /* depth of submenus */ \
- KmCommand *cmds; /* link to first command */ \
- int nguidance; /* number of lines in guidance text */ \
- char **guidance; /* help text */ \
- int nkeyword; /* number of lines for keywords */ \
- char **keyword; /* list of keywords */ \
- int nhlink; /* number of lines for links */ \
- char **hlink; /* list of links */ \
-} KmMenu; /* */ \
- /* */ \
-extern void klnkbrcl(); /* */ \
-extern void klnkicon(); /* */ \
-extern void klnkkmcl(); /* */ \
-extern void klnkmenu(); /* */ \
- /* */ \
-"
diff --git a/src/packlib/kuip/programs/kuipc/kmenu_q5.m4 b/src/packlib/kuip/programs/kuipc/kmenu_q5.m4
deleted file mode 100644
index 9f9cb1b..0000000
--- a/src/packlib/kuip/programs/kuipc/kmenu_q5.m4
+++ /dev/null
@@ -1,19 +0,0 @@
-/*
- * $Id: kmenu_q5.m4,v 1.1 1996/04/16 13:29:48 gunter Exp $
- *
- * $Log: kmenu_q5.m4,v $
- * Revision 1.1 1996/04/16 13:29:48 gunter
- * Mods to compile kuipc.
- * The header files can be deleted and remade from the .m4 files. Use gnu's m4,
- * ie.:
- * gmake headers M4=/usr/local/bin/m4
- * And then
- * gmake kuipc
- *
- * Revision 1.1.1.1 1996/03/08 15:33:01 mclareni
- * Kuip
- *
- */
-define(__,\)
-
-"include(kuip/kmenu5.h)"
diff --git a/src/packlib/kuip/programs/kuipc/kuipcc.c b/src/packlib/kuip/programs/kuipc/kuipcc.c
deleted file mode 100644
index b5531e0..0000000
--- a/src/packlib/kuip/programs/kuipc/kuipcc.c
+++ /dev/null
@@ -1,3391 +0,0 @@
-/*
- * $Id: kuipcc.c,v 1.7 2000/03/27 14:13:17 couet Exp $
- *
- * $Log: kuipcc.c,v $
- * Revision 1.7 2000/03/27 14:13:17 couet
- * - Mod to suppress a warning on Solaris 2.7
- *
- * Revision 1.6 1998/02/12 10:31:28 gunter
- * Remove lines at start of .c output files setting wrong defaults for name
- * (upper/lower/underscore); this required a CERNLIB_ to be set compiling the
- * C code.
- *
- *
- *
- * CVS:----------------------------------------------------------------------
- * CVS:----------------------------------------------------------------------
- *
- * Revision 1.5 1997/11/19 16:42:54 mclareni
- * Correct typo
- *
- * Revision 1.4 1997/09/02 14:50:03 mclareni
- * WINNT corrections
- *
- * Revision 1.3 1997/03/14 17:15:56 mclareni
- * WNT mods
- *
- * Revision 1.2.2.1 1997/01/21 11:33:19 mclareni
- * All mods for Winnt 96a on winnt branch
- *
- * Revision 1.2 1996/04/16 13:29:49 gunter
- * Mods to compile kuipc.
- * The header files can be deleted and remade from the .m4 files. Use gnu's m4,
- * ie.:
- * gmake headers M4=/usr/local/bin/m4
- * And then
- * gmake kuipc
- *
- * Revision 1.1.1.1 1996/03/08 15:33:03 mclareni
- * Kuip
- *
- */
-/*CMZ : 2.06/09 27/02/95 16.54.36 by N.Cremel*/
-/*-- Author : Alfred Nathaniel 17/08/92*/
-/* kuipcc.c: KUIP CDF Compiler */
-
-#include "kuip/kuip.h"
-#include "kuip/kfor.h"
-#include "kuip/kbrow.h"
-#include "kuip/kmenu.h"
-
-#ifdef IBM370
-#define F77_EXTENSION ".fortran"
-#endif
-
-#ifdef vms
-#define F77_EXTENSION ".for"
-#endif
-
-#ifdef CERNLIB_WINNT
-#define F77_EXTENSION ".for"
-#endif
-
-#ifndef F77_EXTENSION
-#define F77_EXTENSION ".f"
-#endif
-
-#define MAXLINE 512 /* maximum length of lines */
-#define MAXNLEN 32 /* maximum length of names */
-
-enum { ACT_ION, ACT_USER };
-enum { BR_OWSE, BR_CLASS };
-enum { COM_MAND, COM_HELP };
-
-typedef struct {
- int used;
- int allocated;
- char *buffer;
-} Buffer;
-
-static Buffer cdef_menu;
-static Buffer cdef_body;
-static Buffer cdef_head;
-static Buffer cdef_tail;
-
-static Buffer fdef_body;
-static Buffer fdef_head;
-
-typedef struct {
- int groups;
- int *count;
- char ***value;
-} Group;
-
-typedef struct {
- char *name; /* parameter name */
- int abbrev; /* minimum length that name is recognized */
- char *prompt; /* prompt string */
- char *dfault; /* default value */
- char *width; /* width of input field */
- int range_count; /* number of range values */
- char **range_value;
- char **option_text; /* explanation text for options */
- Group mutex;
- int *mutex_index;
- Group radio;
- int *radio_index;
- int select_count; /* number of selection values */
- char **select_value;
- KmParFlag flags; /* special flags */
- KmParType type; /* parameter type */
- char *filter_default; /* file name filter */
- char *range_lower; /* lower range value */
- char *range_upper; /* upper range value */
- char *slider_lower; /* slider lower range */
- char *slider_upper; /* slider upper range */
-} Parameter;
-
-typedef struct _Command {
- struct _Command *next; /* link to next command structure */
- char *name; /* command name */
- int total; /* total number of parameters */
- int mandatory; /* number of mandatory parameters */
- int list_par; /* index+1 for parameter of list type */
- Parameter **par; /* parameter descriptions */
- char *action; /* name of action routine */
- char *user_help; /* name of user help routine */
- int nguidance; /* number of lines in guidance text */
- char **guidance; /* guidance text */
- int nkeyword; /* number of "keyword" commands/menus */
- char **keyword; /* "keyword" commands/menus list */
- int nhlink; /* number of "links" (for HTML) */
- char **hlink; /* "link" list */
- int nsource; /* number of lines in source text */
- char **source; /* source text */
-} Command;
-
-typedef struct _Menu {
- struct _Menu *next; /* link to next menu */
- struct _Menu *down; /* link to submenu */
- struct _Menu *up; /* link to parent menu */
- char *path; /* menu path */
- char *name; /* menu name */
- int level; /* depth of submenus */
- int ncmds; /* number of commands */
- Command **cmds; /* list of command */
- int nguidance; /* number of lines in guidance text */
- char **guidance; /* guidance text */
- int nkeyword; /* number of "keyword" commands/menus */
- char **keyword; /* "keyword" commands/menus list */
- int nhlink; /* number of "links" (for HTML) */
- char **hlink; /* "link" list */
-} Menu;
-
-typedef struct {
- char *text; /* menu text */
- char *accel; /* accelerator definition */
- char *exec; /* action commands */
- char *call; /* action routine */
- BrActFlag flags; /* flags from menu text and accelerator */
- BrActTag tag; /* for which window the action is defined */
-} Action;
-
-typedef struct {
- char *name; /* class name */
- char *title; /* class title */
- char *scan_km; /* user function scanning the directory */
- char *scan_br; /* user function scanning for browsables */
- int nroot; /* number of entries in root actions */
- Action **root; /* action bindings in root menu */
- int nopen; /* number of entries in open actions */
- Action **open; /* action bindings in open menu */
-} Browsable;
-
-typedef struct {
- char *name; /* class name */
- char *title; /* class title */
- char *big_icon; /* big icon name */
- char *sm_icon; /* small icon name */
- char *user_icon; /* name of user icon routine */
- int ncont; /* number of entries in cont actions */
- Action **cont; /* action bindings in content menu */
- int ngraf; /* number of entries in graf actions */
- Action **graf; /* action bindings in graphics menu */
-} Class;
-
-typedef struct {
- char *name; /* icon name */
- int width; /* width of the pixmap */
- int height; /* height of the pixmap */
- int nbitmap; /* length of bitmap */
- char *bitmap; /* bitmap data */
-} Icon;
-
-typedef struct {
- char *action; /* user routine */
- char *menu; /* menu title or NULL for a button */
- char *label; /* button label or menu item */
- char *mnemo; /* button mnemonic */
- char *accel; /* button accelerator */
- char *accel_text; /* accelerator text */
- KmButtFlag flags; /* sensitivity type */
-} Button;
-
-static char *motif_FallBk = NULL;
-static char *motif_TopWid = NULL;
-
-static char line[MAXLINE];
-
-static Menu root_menu = { (Menu*)0, (Menu*)0, &root_menu,
- "", "", 0, 0, (Command**)0, 0, (char**)0 };
-static Menu *curr_menu = &root_menu;
-static Command *curr_cmd;
-
-static Browsable **browsables;
-static int nbrowsables;
-static Class **classes;
-static int nclasses;
-static Icon **icons;
-static int nicons;
-static Button **buttons;
-static int nbuttons;
-static int have_graphics;
-
-static int line_count;
-static char full_line[MAXLINE]; /* line as read from CDF */
-static char **word; /* pointers to start of words in parsed line */
-static int nword; /* number of words on line */
-static int mword; /* length of **word */
-
-static char **external_F; /* list of external Fortran routines */
-static int nexternal_F; /* number of external Fortran routines */
-static char **external_C; /* list of external C functions */
-static int nexternal_C; /* number of external C functions */
-static int *texternal_C; /* type of external C functions */
-enum { FUNC_SUBR, FUNC_INT, FUNC_CHAR, FUNC_pCHAR };
-
-static int is_menu; /* flag if guidance belongs to menu */
-
-static char *curr_name; /* name of the C definition routine */
-
-static int cmode; /* flag if C code should be generated */
-static int fmode; /* flag if Fortran code should be generated */
-static int split; /* flag if code should go to separate files */
-static char ifile[256]; /* input file name */
-static char ofile[256]; /* output file name */
-
-#define Malloc(type,size) (type*)malloc( size*sizeof(type) )
-#define Malloc1(type) Malloc( type, 1 )
-#define Realloc(type,ptr,size) ( ptr == NULL ? Malloc( type, size ) \
- : (type*)realloc( (char*)ptr, size*sizeof(type) ) )
-
-static void appchr( Buffer*, int );
-static void append( Buffer*, const char* );
-static void appext( Buffer*, const char*, int );
-static void appflt( Buffer*, const char*, int );
-static void appint( Buffer*, int, int );
-static void applit( Buffer*, const char*, int );
-static void appnum( Buffer*, const char*, int, int );
-static void appstr( Buffer*, const char*, int );
-static void assign_external( const char*, const char*, int );
-static void cat_buffer( Buffer*, Buffer* );
-static void copy_buffer( Buffer*, Buffer* );
-static void check_abbrev( const char*, const char* );
-static void check_args( int, int );
-static void fatal( const char* );
-static Menu* find_menu( Menu*, const char* );
-static void finish_name(void);
-static void flush_buffer( Buffer* );
-static char* format_name( const char*, const char* );
-static void fredirect( const char* );
-static void init_buffer( Buffer* );
-static char* lowercase( const char* );
-static void new_action( Action*, const char*, const char*, const char*,
- const char*, BrActTag );
-static char* new_external_C( const char*, int );
-static char* new_external_F( const char* );
-static void only_cmode( const char* );
-static void only_fmode( const char* );
-static char* output_action( const char*, const char*, int, Action** );
-static void output_browsables(void);
-static void output_buttons(void);
-static void output_classes(void);
-static void output_cmd_list( Menu* );
-static void output_external(void);
-static void output_icons(void);
-static void output_kupval( const char*, const char*, const char*,
- const char*, const char*, const char* );
-static void output_menu_list( Menu* );
-static int parse_line(void);
-static char** parse_range( int*, const char* );
-static void proc_action( int );
-static void proc_browse(void);
-static void proc_button(void);
-static void proc_class(void);
-static void proc_command( int );
-static void proc_comment(void);
-static void proc_fortran(void);
-static void proc_graphics(void);
-static void proc_guidance(void);
-static void proc_keyword(void);
-static void proc_hlink(void);
-static void proc_icon_bitmaps(void);
-static void proc_menu(void);
-static void proc_motif_customize(void);
-static void proc_name(void);
-static void proc_parameters(void);
-static void quit(void);
-static int read_line(void);
-static int* set_groups( Parameter*, Group* );
-static void unread_line(void);
-static char* uppercase( const char* );
-static void warning( const char* );
-
-
-int main( argc, argv )
- int argc;
- char **argv;
-{
- char *p;
- int iarg = 1;
- int explicit = 0;
-
- cmode = 0;
-
- while( iarg < argc && argv[iarg][0] == '-' && argv[iarg][1] != '\0' ) {
- if( strcasecmp( argv[iarg], "-split" ) == 0 ) {
- split = 1;
- }
- else if( strcasecmp( argv[iarg], "-c" ) == 0 ) {
- cmode = 1;
- explicit = 1;
- }
- else if( strcasecmp( argv[iarg], "-f" ) == 0 ) {
- cmode = 0;
- explicit = 1;
- }
- else {
- fprintf( stderr, "Invalid option %s\n", argv[iarg] );
- quit();
- }
- iarg++;
- }
-
- if( argc > iarg ) {
- strcpy( ifile, argv[iarg] );
- iarg++;
- if( argc > iarg )
- strcpy( ofile, argv[iarg] );
- else {
- /* use input file name and chop off extension */
- strcpy( ofile, ifile );
- if( (p = strrchr( ofile, '.' )) != NULL && strpbrk( p, "/]" ) == NULL )
- *p = '\0';
- }
- }
- else {
- fprintf( stderr, "Enter CDF input file name: " );
- gets( ifile );
- fprintf( stderr, "Enter definition output file name: " );
- gets( ofile );
- }
-
- if( !explicit ) {
- /* derive output mode from file extension */
- int len = strlen( ofile );
- cmode = (strcasecmp( &ofile[len-2], ".c" ) == 0);
- }
- fmode = !cmode;
-
- if( (p = strrchr( ifile, '.' )) == NULL || strpbrk( p, "/]" ) != NULL )
- strcat( ifile, ".cdf" );
-
- if( (p = strrchr( ofile, '.' )) == NULL || strpbrk( p, "/]" ) != NULL )
- strcat( ofile, cmode ? ".c" : F77_EXTENSION );
-
- if( strcmp( ifile, "-" ) != 0 && freopen( ifile, "r", stdin ) == NULL ) {
- fprintf( stderr, "Cannot open input file '%s'\n", ifile );
- quit();
- }
- if( strcmp( ofile, "-" ) != 0 ) {
- fredirect( ofile );
- }
-
- while( read_line() > 0 ) {
-
- if( full_line[0] == '*' )
- continue;
-
- parse_line();
-
- if( strncasecmp( word[0], ">A", 2 ) == 0 ) {
- check_abbrev( word[0], ">Action" );
- proc_action( ACT_ION );
- }
- else if( strcasecmp( word[0], ">Browse" ) == 0 ) {
- proc_browse();
- }
- else if( strcasecmp( word[0], ">Button" ) == 0 ) {
- proc_button();
- }
- else if( strcasecmp( word[0], ">Class" ) == 0 ) {
- proc_class();
- }
- else if( strncasecmp( word[0], ">C", 2 ) == 0 ) {
- check_abbrev( word[0], ">Command" );
- proc_command( COM_MAND );
- }
- else if( strcasecmp( word[0], ">Fortran" ) == 0 ) {
- proc_fortran();
- }
- else if( strcasecmp( word[0], ">Graphics" ) == 0 ) {
- proc_graphics();
- }
- else if( strncasecmp( word[0], ">G", 2 ) == 0 ) {
- check_abbrev( word[0], ">Guidance" );
- proc_guidance();
- }
- else if( strncasecmp( word[0], ">K", 2 ) == 0 ) {
- check_abbrev( word[0], ">Keyword" );
- proc_keyword();
- }
- else if( strncasecmp( word[0], ">L", 2 ) == 0 ) {
- check_abbrev( word[0], ">Link" );
- proc_hlink();
- }
- else if( strncasecmp( word[0], ">H", 2 ) == 0 ) {
- check_abbrev( word[0], ">Help_item" );
- proc_command( COM_HELP );
- }
- else if( strcasecmp( word[0], ">Icon_bitmaps" ) == 0 ) {
- proc_icon_bitmaps();
- }
- else if( strcasecmp( word[0], ">Motif_customize" ) == 0 ) {
- proc_motif_customize();
- }
- else if( strncasecmp( word[0], ">M", 2 ) == 0 ) {
- check_abbrev( word[0], ">Menu" );
- proc_menu();
- }
- else if( strncasecmp( word[0], ">N", 2 ) == 0 ) {
- check_abbrev( word[0], ">Name" );
- proc_name();
- }
- else if( strncasecmp( word[0], ">P", 2 ) == 0 ) {
- check_abbrev( word[0], ">Parameters" );
- proc_parameters();
- }
- else if( strncasecmp( word[0], ">U", 2 ) == 0 ) {
- check_abbrev( word[0], ">User_help" );
- proc_action( ACT_USER );
- }
- else if( strncmp( word[0], ">*", 2 ) == 0 ) {
- proc_comment();
- }
- else {
- warning( "Invalid directive ignored" );
- proc_comment();
- }
- }
-
- finish_name();
- exit( 0 );
-}
-
-
-static
-void warning( const char *text )
-{
- fprintf( stderr, "Line %d - %s:\n%s\n", line_count, text, full_line );
-}
-
-
-static
-void fatal( const char *text )
-{
- warning( text );
- fprintf( stderr, "Fatal error in CDF\n" );
- quit();
-}
-
-
-static
-void quit()
-{
- exit( 1 );
-}
-
-
-static
-void only_cmode( const char *keyw )
-{
- if( !cmode ) {
- char text[80];
- sprintf( text, "%s only supported in C output mode", keyw );
- warning( text );
- }
-}
-
-
-static
-void only_fmode( const char *keyw )
-{
- if( !fmode ) {
- char text[80];
- sprintf( text, "%s only supported in Fortran output mode", keyw );
- warning( text );
- }
-}
-
-
-/*
- * redirect stdout into a file
- */
-static
-void fredirect( const char *file )
-{
- FILE *stream;
-#if 0
- char *format = fmode ? "rfm=var" : "rfm=stmlf";
- stream = freopen( file, "w", stdout, format );
-#else
- stream = freopen( file, "w", stdout );
-#endif
- if( stream == NULL ) {
- fprintf( stderr, "Cannot open output file '%s'\n", ofile );
- quit();
- }
-}
-
-
-/*****************************************************************************
- * routines for processing directives
- *****************************************************************************/
-
-/*
- * output code for >Action and >User_help
- */
-static
-void proc_action( int what )
-{
-
- check_args( 2, 2 );
-
- switch( what ) {
- case ACT_ION:
- curr_cmd->action = strdup( word[1] );
- break;
- case ACT_USER:
- curr_cmd->user_help = strdup( word[1] );
- break;
- }
-}
-
-
-/*
- * process comment lines >*
- */
-static
-void proc_comment()
-{
- while( read_line() > 0 ) {
- /* skip lines until next CDF directive */
- if( full_line[0] == '>' ) {
- unread_line();
- return;
- }
- }
-}
-
-
-/*
- * output code for >Browse
- */
-static
-void proc_browse()
-{
- Browsable *brw;
- BrActTag tag = BRACT_ROOT;
- Action *act;
-
- check_args( 4, 5 );
- only_cmode( ">Browse" );
-
- browsables = Realloc( Browsable*, browsables, ++nbrowsables );
- brw = browsables[nbrowsables-1] = Malloc1( Browsable );
-
- brw->name = strdup( word[1] );
- brw->title = str0dup( word[2] );
- brw->scan_km = str0dup( word[3] );
- brw->scan_br = str0dup( word[4] );
- brw->nroot = 0;
- brw->root = NULL;
- brw->nopen = 0;
- brw->open = NULL;
-
- while( read_line() > 0 ) {
-
- if( full_line[0] == '*' )
- continue;
-
- if( full_line[0] == '>' ) { /* loop until next CDF directive */
- unread_line();
- return;
- }
-
- parse_line();
- if( strcmp( word[0], "+" ) == 0 ) {
- tag = BRACT_OPEN;
- continue;
- }
- if( tag == BRACT_ROOT ) {
- brw->root = Realloc( Action*, brw->root, ++brw->nroot );
- act = brw->root[brw->nroot-1] = Malloc1( Action );
- }
- else {
- brw->open = Realloc( Action*, brw->open, ++brw->nopen );
- act = brw->open[brw->nopen-1] = Malloc1( Action );
- }
- new_action( act, word[0], word[1], word[2], word[3], tag );
- }
-}
-
-
-/*
- * output code for >Button action b_text m_text chopt
- * output code for >Button ...
- * ... menu-title [/]button-label callb_routine [mnem.] [acc.] [acct.] [chopt]
- */
-static
-void proc_button()
-{
- Button *but;
-
- check_args( 4, 8 );
- only_cmode( ">Button" );
-
- buttons = Realloc( Button*, buttons, ++nbuttons );
- but = buttons[nbuttons-1] = Malloc1( Button );
-
- but->menu = strdup( word[1] );
- but->label = strdup( word[2] );
- but->action = strdup( word[3] );
- but->mnemo = str0dup( word[4] );
- but->accel = str0dup( word[5] );
- but->accel_text = str0dup( word[6] );
- but->flags = KmButtSensitive;
- if( word[7] != NULL ) {
- if( strcasecmp( word[7], "NS" ) == 0 )
- but->flags = KmButtNonSensitive;
- else if( strcasecmp( word[7], "TS" ) == 0 )
- but->flags = KmButtToggleSensitive;
- else if( strcasecmp( word[7], "BR" ) == 0 )
- but->flags |= KmButtBrowser;
- else {
- warning( "Invalid button definition ignored" );
- nbuttons--;
- }
- }
- if( but->label[0] == '/' ) {
- but->label++;
- but->flags |= KmButtSeparator;
- }
-}
-
-
-/*
- * output code for >Class
- */
-static
-void proc_class()
-{
- Class *cls;
- BrActTag tag = BRACT_CONT;
- Action *act;
-
- check_args( 2, 5 );
- only_cmode( ">Class" );
-
- classes = Realloc( Class*, classes, ++nclasses );
- cls = classes[nclasses-1] = Malloc1( Class );
-
- cls->name = strdup( word[1] );
- cls->title = strdup( word[2] );
- cls->big_icon = str0dup( word[3] );
- cls->sm_icon = str0dup( word[4] );
- cls->user_icon = str0dup( word[5] );
- cls->ncont = 0;
- cls->cont = NULL;
- cls->ngraf = 0;
- cls->graf = NULL;
-
- while( read_line() > 0 ) {
-
- if( full_line[0] == '*' )
- continue;
-
- if( full_line[0] == '>' ) { /* loop until next CDF directive */
- unread_line();
- return;
- }
-
- parse_line();
- if( strcmp( word[0], "+" ) == 0 ) {
- tag = BRACT_GRAF;
- continue;
- }
- if( tag == BRACT_CONT ) {
- if( cls->ncont == 0 ) {
- if( ( cls->big_icon == NULL || cls->sm_icon == NULL )
- && cls->user_icon == NULL ) {
- warning( "Missing icon definition in >Class directive" );
- }
- if( cls->big_icon == NULL )
- cls->big_icon = "big_menu";
- if( cls->sm_icon == NULL )
- cls->sm_icon = "sm_menu";
- }
- cls->cont = Realloc( Action*, cls->cont, ++cls->ncont );
- act = cls->cont[cls->ncont-1] = Malloc1( Action );
- }
- else {
- cls->graf = Realloc( Action*, cls->graf, ++cls->ngraf );
- act = cls->graf[cls->ngraf-1] = Malloc1( Action );
- }
- new_action( act, word[0], word[1], word[2], word[3], tag );
- }
-}
-
-
-/*
- * output code for >Command and >Help_item
- */
-static
-void proc_command( int what )
-{
- check_args( 2, 2 );
-
- curr_menu->cmds = Realloc( Command*, curr_menu->cmds, ++curr_menu->ncmds );
- curr_cmd = curr_menu->cmds[curr_menu->ncmds-1] = Malloc1( Command );
-
- curr_cmd->name = strdup( word[1] );
- curr_cmd->total = 0;
- curr_cmd->mandatory = 0;
- curr_cmd->list_par = 0;
- curr_cmd->par = NULL;
- curr_cmd->action = NULL;
- curr_cmd->user_help = NULL;
- curr_cmd->nguidance = 0;
- curr_cmd->guidance = NULL;
- curr_cmd->nkeyword = 0;
- curr_cmd->keyword = NULL;
- curr_cmd->nhlink = 0;
- curr_cmd->hlink = NULL;
- curr_cmd->nsource = 0;
- curr_cmd->source = NULL;
-
- is_menu = 0;
-}
-
-
-/*
- * output code for >Fortran
- */
-static
-void proc_fortran()
-{
- int nsource = 0;
- char **source = NULL;
-
- check_args( 1, 1 );
- only_fmode( ">Fortran" );
-
- while( read_line() >= 0 ) {
-
- if( full_line[0] == '>' ) { /* loop until next CDF directive */
- unread_line();
- break;
- }
-
- if( !fmode )
- continue;
-
- source = Realloc( char*, source, ++nsource );
- source[nsource-1] = strdup( full_line );
- }
-
- curr_cmd->nsource = nsource;
- curr_cmd->source = source;
-}
-
-
-/*
- * output code for >Guidance
- */
-static
-void proc_guidance()
-{
- int nguidance = 0;
- char **guidance = NULL;
-
- check_args( 1, 1 );
-
- while( read_line() >= 0 ) {
-
- if( full_line[0] == '*' )
- continue;
-
- if( full_line[0] == '\0' )
- continue; /* ignore empty lines and comments */
-
- if( full_line[0] == '>' ) { /* loop until next CDF directive */
- unread_line();
- break;
- }
- if( strcmp( full_line, "." ) == 0 )
- full_line[0] = '\0'; /* make empty line */
- guidance = Realloc( char*, guidance, ++nguidance );
- guidance[nguidance-1] = strdup( full_line );
- }
- if( is_menu ) {
- curr_menu->nguidance = nguidance;
- curr_menu->guidance = guidance;
- }
- else {
- curr_cmd->nguidance = nguidance;
- curr_cmd->guidance = guidance;
- }
-}
-
-
-
-/*
- * output code for >Keyword
- */
-static
-void proc_keyword()
-{
- int nkeyword = 0;
- char **keyword = NULL;
-
- check_args( 1, 1 );
-
- while( read_line() >= 0 ) {
- int i;
-
- if( full_line[0] == '*' )
- continue;
-
- if( full_line[0] == '\0' )
- continue; /* ignore empty lines and comments */
-
- if( full_line[0] == '>' ) { /* loop until next CDF directive */
- unread_line();
- break; }
-
- parse_line();
- for (i = 0; i < nword; i++) {
- keyword = Realloc( char*, keyword, ++nkeyword );
- keyword[nkeyword-1] = strdup( word[i] );
- }
-
- } /* end ... while( read_line() >= 0 ) */
-
- if( is_menu ) {
- curr_menu->nkeyword = nkeyword;
- curr_menu->keyword = keyword;
- }
- else {
- curr_cmd->nkeyword = nkeyword;
- curr_cmd->keyword = keyword;
- }
-
-}
-
-
-/*
- * output code for >Link
- */
-static
-void proc_hlink()
-{
- int nhlink = 0;
- char **hlink = NULL;
-
- check_args( 1, 1 );
-
- while( read_line() >= 0 ) {
- int i;
-
- if( full_line[0] == '*' )
- continue;
-
- if( full_line[0] == '\0' )
- continue; /* ignore empty lines and comments */
-
- if( full_line[0] == '>' ) { /* loop until next CDF directive */
- unread_line();
- break; }
-
- parse_line();
- for (i = 0; i < nword; i++) {
- hlink = Realloc( char*, hlink, ++nhlink );
- hlink[nhlink-1] = strdup( word[i] );
- }
-
- } /* end ... while( read_line() >= 0 ) */
-
- if( is_menu ) {
- curr_menu->nhlink = nhlink;
- curr_menu->hlink = hlink;
- }
- else {
- curr_cmd->nhlink = nhlink;
- curr_cmd->hlink = hlink;
- }
-
-}
-
-
-/*
- * output code for >Icon_bitmaps
- */
-static
-void proc_icon_bitmaps()
-{
- check_args( 1, 1 );
- only_cmode( ">Icon" );
-
- while( read_line() > 0 ) {
- Icon *icn;
- char icon_name[32];
- char *p;
- int width;
- int height;
- int nbytes;
- int n;
-
- if( full_line[0] == '>' ) { /* loop until next CDF directive */
- unread_line();
- break;
- }
-
- parse_line();
- check_args( 3, 3 );
- if( strcmp( word[0], "#define" ) != 0 )
- check_args( 99, 99 );
-
- strcpy( icon_name, word[1] );
- if( (p = strrchr( icon_name, '_' )) == NULL )
- check_args( 99, 99 );
-
- *p++ = '\0';
- if( strcmp( p, "width" ) != 0 )
- check_args( 99, 99 );
-
- width = atoi( word[2] );
-
- if( read_line() <= 0 )
- check_args( 99, 99 );
- parse_line();
- check_args( 3, 3 );
- if( strcmp( word[0], "#define" ) != 0 )
- check_args( 99, 99 );
-
- if( strcmp( strrchr( word[1], '_' ), "_height" ) != 0 )
- check_args( 99, 99 );
-
- height = atoi( word[2] );
-
- if( read_line() <= 0 )
- check_args( 99, 99 );
- parse_line();
- check_args( 5, 5 );
- if( strcmp( word[0], "static" ) != 0 )
- check_args( 99, 99 );
-
- nbytes = ((width-1)/8+1) * height;
-
- icons = Realloc( Icon*, icons, ++nicons );
- icn = icons[nicons-1] = Malloc1( Icon );
- icn->name = strdup( icon_name );
- icn->width = width;
- icn->height = height;
- icn->nbitmap = nbytes;
- icn->bitmap = malloc( nbytes );
-
- for( n = 0; n < nbytes && read_line() > 0; n += 12 ) {
- int m = nbytes - n < 12 ? nbytes - n : 12;
- int i;
-
- parse_line();
- check_args( m, m );
-
- for( i = 0; i < m; i++ )
- icn->bitmap[n+i] = strtol( word[i], NULL, 0 );
- }
- }
-}
-
-
-/*
- * output code for >Menu
- */
-static
-void proc_menu()
-{
- check_args( 2, 2 );
-
- curr_menu = find_menu( curr_menu, word[1] );
- is_menu = 1;
-}
-
-
-/*
- * output code for >Motif_customize [user_res] [top_widget]
- */
-static
-void proc_motif_customize()
-{
- check_args( 1, 3 );
- only_cmode( ">Motif" );
-
- motif_FallBk = str0dup( word[1] );
- motif_TopWid = str0dup( word[2] );
-}
-
-
-/*
- * output code for >Name
- */
-static
-void proc_name()
-{
- check_args( 2, 2 );
-
- if( curr_name != NULL )
- finish_name();
- curr_name = lowercase( word[1] );
-
- curr_menu = &root_menu;
-}
-
-
-/*
- * output code for >Parameters
- */
-static
-void proc_parameters()
-{
- int optional = 0;
- int constant = 0;
-
- check_args( 1, 1 );
-
- while( read_line() > 0 ) {
- Parameter *par;
- char *star;
- int i;
-
- if( full_line[0] == '*' )
- continue;
-
- if( full_line[0] == '\0' ) /* ignore empty lines */
- continue;
-
- if( full_line[0] == '>' ) { /* loop until next CDF directive */
- unread_line();
- break;
- }
- if( strcmp( full_line, "+" ) == 0 ) { /* enter optional parameters */
- optional = 1;
- if( constant ) {
- warning( "Cannot have more optional parameters following constants" );
- }
- continue;
- }
- if( strcmp( full_line, "++" ) == 0 ) { /* enter constant parameters */
- optional = 1;
- constant = KmFLAG_CONST;
- continue;
- }
- parse_line();
- check_args( 3, 99 );
-
- if( !optional )
- curr_cmd->mandatory++;
-
- curr_cmd->par = Realloc( Parameter*, curr_cmd->par, ++curr_cmd->total );
- par = curr_cmd->par[curr_cmd->total-1] = Malloc1( Parameter );
-
- par->name = strdup( word[0] );
- star = strchr( par->name, '*' );
- if( star == NULL )
- par->abbrev = strlen( par->name );
- else {
- par->abbrev = star - par->name;
- strcpy( star, star + 1 );
- }
- par->prompt = strdup( word[1] );
- par->dfault = NULL;
- par->width = NULL;
- par->range_count = 0;
- par->range_value = NULL;
- par->option_text = NULL;
- par->mutex.groups = 0;
- par->mutex_index = NULL;
- par->radio.groups = 0;
- par->radio_index = NULL;
- par->select_count = 0;
- par->select_value = NULL;
- par->flags = constant;
- par->filter_default = NULL;
- par->range_lower = NULL;
- par->range_upper = NULL;
- par->slider_lower = NULL;
- par->slider_upper = NULL;
-
- if( strcasecmp( word[2], "C" ) == 0 )
- par->type = KmTYPE_CHAR;
- else if( strcasecmp( word[2], "I" ) == 0 )
- par->type = KmTYPE_INT;
- else if( strcasecmp( word[2], "R" ) == 0 )
- par->type = KmTYPE_REAL;
- else {
- warning( "Invalid parameter type; 'C' assumed" );
- par->type = KmTYPE_CHAR;
- }
-
- if( strncasecmp( word[0], "CHOPT", 5 ) == 0
- || strncasecmp( word[0], "OPTION", 6 ) == 0 )
- par->type = KmTYPE_OPTION;
-
- for( i = 3; i < nword; i++ ) {
- char *tag = word[i];
- char *value = strchr( tag, '=' );
- if( value != NULL ) {
- *value++ = '\0';
- if( *value == '\0' ) {
- if( i == nword - 1 ) {
- sprintf( line, "Value after %s= missing", tag );
- fatal( line );
- }
- value = word[++i];
- }
- }
-
- if( strcasecmp( tag, "D" ) == 0 ) { /* default */
- if( value == NULL )
- warning( "Default value missing" );
- else
- par->dfault = strdup( value );
- }
- else if( strcasecmp( tag, "R" ) == 0 ) { /* range */
- if( value == NULL )
- warning( "Range value missing" );
- else {
- char *colon = strchr( value, ':' );
- if( colon != NULL ) { /* R=lo:hi */
- if( colon != value ) {
- *colon = '\0';
- par->range_lower = strdup( value );
- value = colon + 1;
- }
- if( *value != '\0' ) {
- par->range_upper = strdup( value );
- }
- }
- else { /* range of discrete values */
- if( par->type == KmTYPE_CHAR )
- par->type = KmTYPE_OPTION;
- par->range_value = parse_range( &par->range_count, value );
- }
- }
- }
- else if( strcasecmp( tag, "FILE" ) == 0 ) {
- par->type = KmTYPE_FILE;
- par->filter_default = str0dup( value );
- }
- else if( strcasecmp( tag, "FORGET" ) == 0 ) {
- if( value != NULL )
- warning( "Value in FORGET definition ignored" );
- par->flags |= KmFLAG_FORGET;
- }
- else if( strcasecmp( tag, "HIDDEN" ) == 0 ) {
- if( value != NULL )
- warning( "Value in HIDDEN definition ignored" );
- if( !optional )
- warning( "Cannot use HIDDEN for mandatory parameter" );
- else
- par->flags |= KmFLAG_HIDDEN;
- }
- else if( strcasecmp( tag, "LOOP" ) == 0 ) {
- if( value != NULL )
- warning( "Value in LOOP definition ignored" );
- curr_cmd->list_par = curr_cmd->total;
- }
- else if( strcasecmp( tag, "MINUS" ) == 0 ) {
- if( value != NULL )
- warning( "Value in MINUS definition ignored" );
- par->flags |= KmFLAG_MINUS;
- }
- else if( strcasecmp( tag, "MUTEX" ) == 0 ) {
- only_cmode( "MUTEX" );
- if( value == NULL )
- warning( "MUTEX value missing" );
- else {
- int n;
- n = ++par->mutex.groups;
- if( par->mutex.groups == 1 ) {
- par->mutex.count = (int*)malloc( sizeof(int) );
- par->mutex.value = (char***)malloc( sizeof(char**) );
- }
- else {
- par->mutex.count = (int*)realloc( (char*)par->mutex.count,
- n * sizeof(int) );
- par->mutex.value = (char***)realloc( (char*)par->mutex.value,
- n * sizeof(char**) );
- }
- par->mutex.value[n-1] = parse_range( &par->mutex.count[n-1], value );
- }
- }
- else if( strcasecmp( tag, "OPTION" ) == 0 ) {
- if( value != NULL )
- warning( "Value in OPTION definition ignored" );
- par->type = KmTYPE_OPTION;
- }
- else if( strcasecmp( tag, "QUOTE" ) == 0 ) {
- if( value != NULL )
- warning( "Value in QUOTE definition ignored" );
- par->flags |= KmFLAG_QUOTE;
- }
- else if( strcasecmp( tag, "RADIO" ) == 0 ) {
- only_cmode( "RADIO" );
- if( value == NULL )
- warning( "RADIO value missing" );
- else {
- int n;
- n = ++par->radio.groups;
- if( par->radio.groups == 1 ) {
- par->radio.count = (int*)malloc( sizeof(int) );
- par->radio.value = (char***)malloc( sizeof(char**) );
- }
- else {
- par->radio.count = (int*)realloc( (char*)par->radio.count,
- n * sizeof(int) );
- par->radio.value = (char***)realloc( (char*)par->radio.value,
- n * sizeof(char**) );
- }
- par->radio.value[n-1] = parse_range( &par->radio.count[n-1], value );
- }
- }
- else if( strcasecmp( tag, "SELECT" ) == 0 ) {
- only_cmode( "SELECT" );
- if( value == NULL )
- warning( "SELECT value missing" );
- else
- par->select_value = parse_range( &par->select_count, value );
- }
- else if( strcasecmp( tag, "SEPARATE" ) == 0 ) {
- if( value != NULL )
- warning( "Value in SEPARATE definition ignored" );
- par->flags |= KmFLAG_SEPARATE;
- }
- else if( strcasecmp( tag, "SLIDER" ) == 0 ) {
- only_cmode( "SLIDER" );
- if( value == NULL )
- warning( "SLIDER value missing" );
- else {
- char *colon = strchr( value, ':' );
- if( colon != NULL ) {
- if( colon != value ) {
- *colon = '\0';
- par->slider_lower = strdup( value );
- value = colon + 1;
- }
- if( *value != '\0' ) {
- par->slider_upper = strdup( value );
- }
- }
- else
- warning( "Invalid SLIDER definition ignored" );
- }
- }
- else if( strcasecmp( tag, "VARARG" ) == 0 ) {
- if( value != NULL )
- warning( "Value in VARARG definition ignored" );
- par->flags |= KmFLAG_VARARG;
- }
- else if( strcasecmp( tag, "WIDTH" ) == 0 ) {
- only_cmode( "WIDTH" );
- if( value == NULL )
- warning( "WIDTH value missing" );
- else
- par->width = strdup( value );
- }
- else
- warning( "Invalid parameter definition ignored" );
- }
-
- if( par->type == KmTYPE_OPTION ) {
- /* read option explanations: "-X text" */
-
- if( par->range_count != 0 )
- par->option_text = (char**)calloc( par->range_count, sizeof(char*) );
-
- while( read_line() > 0 ) {
-
- if( full_line[0] == '*' ) /* ignore comments */
- continue;
-
- if( full_line[0] == '\0' ) /* ignore empty lines */
- continue;
-
- if( full_line[0] != '-' ) {
- unread_line();
- break;
- }
- else {
- char *value = strdup( full_line );
- char *text = strchr( value, ' ' );
- int n;
-
- if( text != NULL ) {
- char *p;
- *text++ = '\0';
- while( *text == ' ' ) {
- /* skip leading blanks */
- text++;
- }
- while( (p = strstr( text, " " )) != NULL ) {
- /* remove multiple blanks */
- strcpy( p, p + 1 );
- }
- }
- value++; /* skip the minus */
-
- /* look if option is already defined by R='...' */
- for( n = 0; n < par->range_count; n++ ) {
- if( strcasecmp( par->range_value[n], value ) == 0 )
- break;
- }
- if( n == par->range_count ) {
- par->range_count++;
- if( par->range_value == NULL ) {
- par->range_value = (char**)malloc( sizeof(char*) );
- par->option_text = (char**)malloc( sizeof(char*) );
- }
- else {
- par->range_value = (char**)realloc( (char*)par->range_value,
- (n+1) * sizeof(char*) );
- par->option_text = (char**)realloc( (char*)par->option_text,
- (n+1) * sizeof(char*) );
- }
- par->range_value[n] = value;
- }
- par->option_text[n] = text;
- }
- }
- if( par->dfault != NULL && par->range_count > 0
- && par->type != KmTYPE_OPTION ) {
- int n;
- /* look if default is already contained on value list */
- for( n = 0; n < par->range_count; n++ ) {
- if( strcasecmp( par->range_value[n], par->dfault ) == 0 )
- break;
- if( par->range_value[n][0] == '\0'
- && strcmp( par->dfault, " " ) == 0 )
- break;
- }
- if( n == par->range_count ) {
- par->range_count++;
- par->range_value = (char**)realloc( (char*)par->range_value,
- (n+1) * sizeof(char*) );
- par->option_text = (char**)realloc( (char*)par->option_text,
- (n+1) * sizeof(char*) );
- par->range_value[n] = par->dfault;
- par->option_text[n] = NULL;
- }
- }
- par->mutex_index = set_groups( par, &par->mutex );
- par->radio_index = set_groups( par, &par->radio );
- }
- }
-}
-
-
-/*
- * output code for >Graphics
- */
-static
-void proc_graphics()
-{
- check_args( 1, 1 );
- only_cmode( ">Graphics" );
-
- have_graphics = 1;
-}
-
-
-/*
- * output the epilog for the definition routine
- */
-static
-void finish_name()
-{
- static int first = 1;
-
- if( split ) {
- char fname[MAXNLEN];
- if( cmode )
- sprintf( fname, "%s.c", curr_name );
- if( fmode )
- sprintf( fname, "%s%s", curr_name, F77_EXTENSION );
- fredirect( fname );
- }
- if( cmode && (split || first) ) {
- time_t ltime;
- first = 0;
- time( <ime );
-
- append( &cdef_head, "\
-/*\n\
- * This file has been generated by the KUIP compiler. Do NOT change it!\n\
- *\n" );
- sprintf( line, " * KUIP header: %d Generation date: %s *\n",
- KUIP_VERSION, asctime( localtime( <ime ) ) );
- append( &cdef_head, line );
- sprintf( line, " * Input file: %s\n */\n\n", ifile );
- append( &cdef_head, line );
-
- append( &cdef_head, "\
-#if !defined(F77_LCASE) && !defined(F77_UCASE) && !defined(F77_USCORE)\n\
-# if defined(__EXTENDED__) && !defined(IBM370) && !defined(_IBMR2)\n\
-# define IBM370\n\
-# endif\n\
-# if defined(CRAY) || defined(IBM370) || defined(vms)\n\
-# define F77_UCASE\n\
-# else\n\
-# if ( defined(apollo) || defined(__apollo) ) && defined(APOFTN)\n\
-# define F77_LCASE\n\
-# else\n\
-# define F77_USCORE\n\
-# endif\n\
-# endif\n\
-#endif\n\
-\n\
-#if (defined(WIN32)||defined(CERNLIB_WINNT)) && defined(CERNLIB_MSSTDCALL)\n\
-#ifndef F77_UCASE\n\
-#define F77_UCASE\n\
-#endif\n\
-#define type_of_call _stdcall\n\
-#endif\n\
-#ifndef type_of_call\n\
-# define type_of_call\n\
-#endif\n\
-\n\
-typedef int IntFunc();\n\
-typedef char* CharFunc();\n\
-typedef char** pCharFunc();\n\
-typedef void type_of_call SUBROUTINE();\n\
-#ifdef IBM370\n\
-# pragma linkage(SUBROUTINE,FORTRAN)\n\
-#endif\n\
-\n\
-extern void klnkmenu();\n\
-extern void klnkbrcl();\n\
-extern void klnkkmcl();\n\
-extern void klnkicon();\n\
-extern void klnkbutt();\n\
-\n" );
- append( &cdef_head,
-#include "kbrow_q1.h"
- );
- append( &cdef_head, "\n\n" );
- append( &cdef_head,
-#include "kbrow_q2.h"
- );
- append( &cdef_head, "\n\n" );
- append( &cdef_head,
-#include "kbrow_q3.h"
- );
- append( &cdef_head, "\n\n" );
- append( &cdef_head,
-#include "kbrow_q4.h"
- );
- append( &cdef_head, "\n\n" );
- append( &cdef_head,
-#include "klink_q1.h"
- );
- append( &cdef_head, "\n\n" );
- append( &cdef_head,
-#include "kmenu_q1.h"
- );
- append( &cdef_head, "\n\n" );
- append( &cdef_head,
-#include "kmenu_q2.h"
- );
- append( &cdef_head, "\n\n" );
- append( &cdef_head,
-#include "kmenu_q3.h"
- );
- append( &cdef_head, "\n\n" );
- append( &cdef_head,
-#include "kmenu_q4.h"
- );
- append( &cdef_head, "\n\n" );
- append( &cdef_head,
-#include "kmenu_q5.h"
- );
- append( &cdef_head, "\n\n" );
- }
-
- if( cmode ) {
- sprintf( line, "void type_of_call %s()\n{\n\n", new_external_F( curr_name ) );
- append( &cdef_body, line );
- }
-
- if( fmode ) {
- sprintf( line, "\
- SUBROUTINE %s\n\
- CHARACTER*1 BS1\n\
- PARAMETER (BS1='\\\\')\n\
- PARAMETER (MGUIDL=199)\n\
- CHARACTER*80 GUID\n\
- COMMON /KCGUID/ GUID(MGUIDL)\n", uppercase( curr_name ) );
- append( &fdef_head, line );
- }
-
- if( root_menu.down != NULL ) {
- output_menu_list( &root_menu );
- sprintf( line, " klnkmenu( &_%s, %d );\n",
- &root_menu.down->path[1], KUIP_VERSION );
- append( &cdef_tail, line );
- root_menu.down = NULL;
- }
- if( nbrowsables > 0 ) {
- output_browsables();
- sprintf( line, " klnkbrcl( &brclass_1, %d );\n", KUIP_VERSION );
- append( &cdef_tail, line );
- nbrowsables = 0;
- browsables = NULL;
- }
- if( nclasses > 0 ) {
- output_classes();
- sprintf( line, " klnkkmcl( &kmclass_1, %d );\n", KUIP_VERSION );
- append( &cdef_tail, line );
- nclasses = 0;
- classes = NULL;
- }
- if( nicons > 0 ) {
- output_icons();
- sprintf( line, " klnkicon( &kmicons_1, %d );\n", KUIP_VERSION );
- append( &cdef_tail, line );
- nicons = 0;
- icons = NULL;
- }
- if( nbuttons > 0 ) {
- output_buttons();
- sprintf( line, " klnkbutt( &kmbuttons_1, %d );\n", KUIP_VERSION );
- append( &cdef_tail, line );
- nbuttons = 0;
- buttons = NULL;
- }
- if( have_graphics ) {
- assign_external( "graf_info", "ixmotif", FUNC_INT );
- assign_external( "graf_size", "IGRSIZ", FUNC_SUBR );
- assign_external( "graf_pick", "IGOBJ", FUNC_SUBR );
- assign_external( "graf_attr", "IGSET", FUNC_SUBR );
- assign_external( "graf_close", "ICLWK", FUNC_SUBR );
- have_graphics = 0;
- }
- if( motif_FallBk != NULL ) {
- assign_external( "user_FallBk", motif_FallBk, FUNC_pCHAR );
- motif_FallBk = NULL;
- }
- if( motif_TopWid != NULL ) {
- assign_external( "user_TopWid", motif_TopWid, FUNC_INT );
- motif_TopWid = NULL;
- }
- output_external();
-
- if( cmode ) {
- append( &cdef_tail, "}\n\n\n" );
- flush_buffer( &cdef_head );
- flush_buffer( &cdef_body );
- flush_buffer( &cdef_tail );
- }
-
- if( fmode ) {
- append( &fdef_body, "\
-\n\
- CALL KUCMD('/',' ','SW')\n\
-\n\
- END\n" );
- flush_buffer( &fdef_head );
- flush_buffer( &fdef_body );
- }
- is_menu = 0;
-}
-
-
-/*
- * change menu to the specified path
- * if menu does not exist then create it first
- */
-static
-Menu *find_menu( Menu *menu,
- const char *path )
-{
- Menu *m;
- char *name;
- char *tail;
-
- if( menu == NULL || path == NULL || path[0] == '\0' )
- fatal( "Invalid menu path" );
-
- if( strcmp( path, "/" ) == 0 )
- return &root_menu;
-
- if( strcmp( path, "\\" ) == 0 || strcmp( path, ".." ) == 0 )
- return menu->up;
-
- if( path[0] == '/' )
- return find_menu( &root_menu, &path[1] );
-
- if( path[0] == '\\' )
- return find_menu( menu->up, &path[1] );
-
- if( strncmp( path, "../", 3 ) == 0 )
- return find_menu( menu->up, &path[3] );
-
- name = strdup( path );
- if( (tail = strchr( name, '/' )) != NULL ) {
- *tail++ = '\0';
- menu = find_menu( menu, name );
- return find_menu( menu, tail );
- }
-
- if( menu->down == NULL )
- m = menu->down = Malloc1( Menu );
- else {
- Menu *prev = NULL;
- for( m = menu->down; m != NULL; m = m->next ) {
- if( strcasecmp( m->name, name ) == 0 )
- return m;
- prev = m;
- }
- m = prev->next = Malloc1( Menu );
- }
- m->next = NULL;
- m->down = NULL;
- m->up = menu;
- m->path = malloc( strlen( menu->path ) + strlen( name ) + 2 );
- sprintf( m->path, "%s/%s", menu->path, name );
- m->name = strdup( name );
- m->level = menu->level + 1;
- m->ncmds = 0;
- m->cmds = NULL;
- m->nguidance = 0;
- m->guidance = NULL;
- m->nkeyword = 0;
- m->keyword = NULL;
- m->nhlink = 0;
- m->hlink = NULL;
- return m;
-}
-
-
-/*
- * output code for the complete command tree
- */
-static
-void output_menu_list( Menu *menu )
-{
- if( menu == NULL || menu->down == NULL )
- return;
-
- if( fmode ) {
- for( menu = menu->down; menu != NULL; menu = menu->next ) {
-
- append( &fdef_body, "\n CALL KUCMD(' '" );
- appstr( &fdef_body, menu->name, 1 );
- append( &fdef_body, ",'C')\n" );
-
- if( menu->nguidance > 0 ) {
- int i;
- for( i = 0; i < menu->nguidance; i++ ) {
- sprintf( line, " GUID(%d)=", i + 1 );
- append( &fdef_body, line );
- appstr( &fdef_body, menu->guidance[i], 0 );
- append( &fdef_body, "\n" );
- }
- append( &fdef_body, " CALL KUGUID(" );
- appstr( &fdef_body, menu->name, 0 );
- sprintf( line, ",GUID,%d,'S')\n", menu->nguidance );
- append( &fdef_body, line );
- }
- append( &fdef_body, "\n CALL KUCMD(" );
- appstr( &fdef_body, menu->name, 0 );
- append( &fdef_body, ",' ','SW')\n" );
-
- output_cmd_list( menu );
- output_menu_list( menu );
-
- append( &fdef_body, "\n CALL KUCMD('..',' ','SW')\n" );
- }
- return;
- }
-
- for( menu = menu->down; menu != NULL; menu = menu->next ) {
- char *mname = format_name( menu->path, NULL );
- char *mnext = menu->next == NULL ? " (KmMenu*)0"
- : format_name( menu->next->path, NULL );
- char *mdown = menu->down == NULL ? " (KmMenu*)0"
- : format_name( menu->down->path, NULL );
- char *cname = menu->ncmds == 0 ? " (KmCommand*)0"
- : format_name( menu->path, menu->cmds[0]->name );
- char *gname = menu->nguidance == 0 ? " (char**)0"
- : format_name( menu->path, "guidance" );
- char *kname = menu->nkeyword == 0 ? " (char**)0"
- : format_name( menu->path, "keyword" );
- char *lname = menu->nhlink == 0 ? " (char**)0"
- : format_name( menu->path, "hlink" );
- Buffer cdef_temp;
-
- init_buffer( &cdef_temp );
- copy_buffer( &cdef_temp, &cdef_menu );
-
- output_menu_list( menu );
- output_cmd_list( menu );
-
- if( menu->nguidance > 0 ) {
- int i;
- sprintf( line, "static char *%s[] = { ", &gname[1] );
- append( &cdef_menu, line );
- for( i = 0; i < menu->nguidance; i++ )
- appstr( &cdef_menu, menu->guidance[i], i > 0 );
- append( &cdef_menu, " };\n" );
- }
- if( menu->nkeyword > 0 ) {
- int i;
- sprintf( line, "static char *%s[] = { ", &kname[1] );
- append( &cdef_menu, line );
- for( i = 0; i < menu->nkeyword; i++ )
- appstr( &cdef_menu, menu->keyword[i], i > 0 );
- append( &cdef_menu, " };\n" );
- }
- if( menu->nhlink > 0 ) {
- int i;
- sprintf( line, "static char *%s[] = { ", &lname[1] );
- append( &cdef_menu, line );
- for( i = 0; i < menu->nhlink; i++ )
- appstr( &cdef_menu, menu->hlink[i], i > 0 );
- append( &cdef_menu, " };\n" );
- }
- sprintf( line, "static KmMenu %s = { %s, %s", &mname[1], mnext, mdown );
- append( &cdef_menu, line );
- appstr( &cdef_menu, menu->path, 1 );
- appstr( &cdef_menu, menu->name, 1 );
- appint( &cdef_menu, menu->level, 1 );
- applit( &cdef_menu, cname, 1 );
- appint( &cdef_menu, menu->nguidance, 1 );
- applit( &cdef_menu, &gname[1], 1 );
- appint( &cdef_menu, menu->nkeyword, 1 );
- applit( &cdef_menu, &kname[1], 1 );
- appint( &cdef_menu, menu->nhlink, 1 );
- applit( &cdef_menu, &lname[1], 1 );
- append( &cdef_menu, " };\n\n" );
- cat_buffer( &cdef_menu, &cdef_temp );
- }
- cat_buffer( &cdef_body, &cdef_menu );
-}
-
-
-/*
- * output code for CALL KUPVAL
- */
-static
-void output_kupval( const char *cmd_name,
- const char *par_name,
- const char *ival,
- const char *rval,
- const char *cval,
- const char *tag )
-{
- append( &fdef_body, " CALL KUPVAL(" );
- appstr( &fdef_body, cmd_name, 0 );
- appstr( &fdef_body, par_name, 1 );
- applit( &fdef_body, ival, 1 );
- appflt( &fdef_body, rval, 1 );
- appstr( &fdef_body, cval, 1 );
- appstr( &fdef_body, tag, 1 );
- append( &fdef_body, ")\n" );
-}
-
-
-/*
- * output code for all commands linked to the menu
- */
-static
-void output_cmd_list( Menu *menu )
-{
- int ncmd;
-
- if( menu == NULL )
- return;
-
- if( fmode ) {
- for( ncmd = 0; ncmd < menu->ncmds; ncmd++ ) {
- Command *cmd = menu->cmds[ncmd];
- int n;
- int i;
-
- append( &fdef_body, "\n CALL KUCMD(' '" );
- appstr( &fdef_body, cmd->name, 1 );
- append( &fdef_body, ",'C')\n" );
-
- for( i = 0; i < cmd->total; i++ ) {
- Parameter *par = cmd->par[i];
- char *ptype;
- char popt[8];
- char *pdefc;
- char *pdefi;
- char *pdefr;
- char *prloi = NULL;
- char *prlor = NULL;
- char *prhii = NULL;
- char *prhir = NULL;
-
- popt[0] = '\0';
- if( i >= cmd->mandatory )
- strcat( popt, "O" );
- if( (par->flags & KmFLAG_CONST) != 0 )
- strcat( popt, "C" );
- if( (par->flags & KmFLAG_FORGET) != 0 )
- strcat( popt, "F" );
- if( (par->flags & KmFLAG_HIDDEN) != 0 )
- strcat( popt, "H" );
- if( (par->flags & KmFLAG_MINUS) != 0 )
- strcat( popt, "M" );
- if( (par->flags & KmFLAG_QUOTE) != 0 )
- strcat( popt, "Q" );
- if( (par->flags & KmFLAG_SEPARATE) != 0 )
- strcat( popt, "S" );
- if( (par->flags & KmFLAG_VARARG) != 0 )
- strcat( popt, "V" );
-
- switch( par->type ) {
- case KmTYPE_INT:
- ptype = "I";
- pdefc = " ";
- pdefi = par->dfault;
- pdefr = "0.";
- prloi = par->range_lower;
- prlor = "0.";
- prhii = par->range_upper;
- prhir = "0.";
- break;
- case KmTYPE_REAL:
- ptype = "R";
- pdefc = " ";
- pdefi = "0";
- pdefr = par->dfault;
- prloi = "0";
- prlor = par->range_lower;
- prhii = "0";
- prhir = par->range_upper;
- break;
- case KmTYPE_OPTION:
- ptype = "O";
- pdefc = par->dfault;
- pdefi = "0";
- pdefr = "0.";
- break;
- default:
- ptype = "C";
- pdefc = par->dfault;
- pdefi = "0";
- pdefr = "0.";
- break;
- }
-
- append( &fdef_body, " CALL KUPAR(" );
- appstr( &fdef_body, cmd->name, 0 );
- appstr( &fdef_body, par->name, 1 );
- appstr( &fdef_body, par->prompt, 1 );
- sprintf( line, ",'%s%s','S')\n", ptype, popt );
- append( &fdef_body, line );
-
- if( par->dfault != NULL )
- output_kupval( cmd->name, par->name, pdefi, pdefr, pdefc, "D" );
-
- if( par->range_lower != NULL )
- output_kupval( cmd->name, par->name, prloi, prlor, NULL, "L" );
-
- if( par->range_upper != NULL )
- output_kupval( cmd->name, par->name, prhii, prhir, NULL, "H" );
-
- if( par->range_count > 0 ) {
- if( par->type == KmTYPE_INT || par->type == KmTYPE_REAL ) {
- for( n = 0; n < par->range_count; n++ ) {
- if( par->type == KmTYPE_INT )
- output_kupval( cmd->name, par->name,
- par->range_value[n], "0.", NULL, "V" );
- else
- output_kupval( cmd->name, par->name,
- "0", par->range_value[n], NULL, "V" );
- }
- }
- else {
- if( par->range_value[0][0] == '\0' )
- strcpy( line, " " );
- else
- strcpy( line, par->range_value[0] );
-
- for( n = 1; n < par->range_count; n++ ) {
- if( par->range_value[n][0] == '\0' )
- strcat( line, ", " );
- else {
- strcat( line, "," );
- strcat( line, par->range_value[n] );
- }
- }
- output_kupval( cmd->name, par->name,
- "0", "0.", line, "V" );
-
- if( par->type == KmTYPE_OPTION ) {
- for( n = 0; n < par->range_count; n++ ) {
- if( par->option_text[n] != NULL ) {
- /* explanation text for "-option" */
- line[0] = '-';
- strcpy( &line[1], par->range_value[n] );
- output_kupval( cmd->name, par->name,
- "0", "0.", par->option_text[n], line );
- }
- }
- }
- }
- }
-
- if( par->abbrev != strlen( par->name ) ) {
- char pmlen[8];
- sprintf( pmlen, "%d", par->abbrev );
- output_kupval( cmd->name, par->name, pmlen, "0.", NULL, "ABBREV" );
- }
-
- if( par->flags != 0 ) {
- char pmflags[8];
- sprintf( pmflags, "%d", par->flags );
- output_kupval( cmd->name, par->name, pmflags, "0.", NULL, "FLAGS" );
- }
-
- if( cmd->list_par == i + 1 ) {
- output_kupval( cmd->name, par->name, "1", "0.", NULL, "LOOP" );
- }
- }
-
- if( cmd->nguidance > 0 ) {
- for( n = 0; n < cmd->nguidance; n++ ) {
- sprintf( line, " GUID(%d)=", n + 1 );
- append( &fdef_body, line );
- appstr( &fdef_body, cmd->guidance[n], 0 );
- append( &fdef_body, "\n" );
- }
- sprintf( line, "\
- CALL KUGUID('%s',GUID,%d,'S')\n",
- cmd->name, cmd->nguidance );
- append( &fdef_body, line );
- }
-
- if( cmd->user_help != NULL ) {
- sprintf( line, "\
- CALL KUACH('%s',%s)\n",
- cmd->name, cmd->user_help );
- append( &fdef_body, line );
- new_external_F( cmd->user_help );
- }
-
- if( cmd->action != NULL ) {
- sprintf( line, "\
- CALL KUACT('%s',%s)\n",
- cmd->name, cmd->action );
- append( &fdef_body, line );
- new_external_F( cmd->action );
- }
-
- for( n = 0; n < cmd->nsource; n++ ) {
- append( &fdef_body, cmd->source[n] );
- }
- }
- return;
- }
-
- for( ncmd = menu->ncmds; ncmd > 0; ncmd-- ) {
- Command *cmd = menu->cmds[ncmd-1];
- char *cname = format_name( menu->path, cmd->name );
- char *cnext = ncmd == menu->ncmds ? " (KmCommand*)0"
- : format_name( menu->path, menu->cmds[ncmd]->name );
- char *gname, *kname, *lname;
- char *plist;
-
- if( cmd->total == 0 ) {
- plist = " (KmParameter**)0";
- }
- else {
- int i;
- for( i = 0; i < cmd->total; i++ ) {
- Parameter *par = cmd->par[i];
- char *pname = format_name( &cname[1], par->name );
- char *prange;
- char *ptext = " (char**)0";
- char *pmutex = " (int*)0";
- char *pradio = " (int*)0";
- char *pselect;
- char *ptype = " (void*)0";
- char *ktype = NULL;
- int width = 0;
- int n;
-
- switch( par->type ) {
- case KmTYPE_CHAR:
- ktype = "KmTYPE_CHAR";
- width = 20;
- break;
- case KmTYPE_FILE:
- ktype = "KmTYPE_FILE";
- width = 20;
- break;
- case KmTYPE_INT:
- ktype = "KmTYPE_INT";
- width = 8;
- break;
- case KmTYPE_OPTION:
- ktype = "KmTYPE_OPTION";
- width = 20;
- break;
- case KmTYPE_REAL:
- ktype = "KmTYPE_REAL";
- width = 12;
- break;
- }
-
- /* discrete range values */
- if( par->range_count == 0 ) {
- prange = " (char**)0";
- }
- else {
- prange = format_name( &pname[1], "range" );
- sprintf( line, "static char *%s[] = { ", &prange[1] );
- append( &cdef_body, line );
- for( n = 0; n < par->range_count; n++ ) {
- appstr( &cdef_body, par->range_value[n], n > 0 );
- if( par->range_value[n][0] == '-' )
- par->flags |= KmFLAG_MINUS;
- }
- append( &cdef_body, " };\n" );
- width = 8;
- }
-
- /* values for selection box */
- if( par->select_count == 0 ) {
- par->select_count = par->range_count;
- pselect = prange;
- }
- else {
- pselect = format_name( &pname[1], "select" );
- sprintf( line, "static char *%s[] = { ", &pselect[1] );
- append( &cdef_body, line );
- for( n = 0; n < par->select_count; n++ )
- appstr( &cdef_body, par->select_value[n], n > 0 );
- append( &cdef_body, " };\n" );
- }
-
- /* type dependent substructures */
- switch( par->type ) {
- int decimals;
-
- case KmTYPE_CHAR:
- break;
-
- case KmTYPE_FILE:
- ptype = format_name( &pname[1], "type" );
- if( par->filter_default == NULL || par->filter_default[0] == '\0' )
- par->filter_default = "*.*";
- sprintf( line, "static KmParFile %s = { ", &ptype[1] );
- append( &cdef_body, line );
- appstr( &cdef_body, par->filter_default, 0 );
- append( &cdef_body, ", (char*)0 };\n" );
- break;
-
- case KmTYPE_OPTION:
- if( par->option_text != NULL ) {
- ptext = format_name( &pname[1], "text" );
- sprintf( line, "static char *%s[] = { ", &ptext[1] );
- append( &cdef_body, line );
- for( n = 0; n < par->range_count; n++ )
- appstr( &cdef_body, par->option_text[n], n > 0 );
- append( &cdef_body, " };\n" );
- }
- if( par->mutex_index != NULL ) {
- pmutex = format_name( &pname[1], "mutex" );
- sprintf( line, "static int %s[] = { ", &pmutex[1] );
- append( &cdef_body, line );
- for( n = 0; n < par->range_count; n++ )
- appint( &cdef_body, par->mutex_index[n], n > 0 );
- append( &cdef_body, " };\n" );
- }
- if( par->radio_index != NULL ) {
- pradio = format_name( &pname[1], "radio" );
- sprintf( line, "static int %s[] = { ", &pradio[1] );
- append( &cdef_body, line );
- for( n = 0; n < par->range_count; n++ )
- appint( &cdef_body, par->radio_index[n], n > 0 );
- append( &cdef_body, " };\n" );
- }
- ptype = format_name( &pname[1], "type" );
- sprintf( line, "static KmParOption %s = { ", &ptype[1] );
- append( &cdef_body, line );
- applit( &cdef_body, &ptext[1], 0 );
- applit( &cdef_body, &pmutex[1], 1 );
- applit( &cdef_body, &pradio[1], 1 );
- append( &cdef_body, " };\n" );
- break;
-
- case KmTYPE_INT:
- if( par->range_lower != NULL && par->range_upper != NULL ) {
- int lower = atoi( par->range_lower );
- int upper = atoi( par->range_upper );
- int max;
- if( lower < 0 )
- lower = -lower;
- if( upper < 0 )
- upper = -upper;
- max = lower > upper ? lower : upper;
- for( width = 1; max > 0; max /= 10 )
- width++;
- }
- /* fallthrough */
- case KmTYPE_REAL:
- ptype = format_name( &pname[1], "type" );
- if( par->slider_lower == NULL )
- par->slider_lower = par->range_lower;
- if( par->slider_upper == NULL )
- par->slider_upper = par->range_upper;
- decimals = 0;
- if( par->slider_lower != NULL ) {
- char *point = strchr( par->slider_lower, '.' );
- if( point != NULL )
- decimals = strlen( point + 1 );
- }
- if( par->slider_upper != NULL ) {
- char *point = strchr( par->slider_upper, '.' );
- if( point != NULL ) {
- int n = strlen( point + 1 );
- if( n > decimals )
- decimals = n;
- }
- }
- sprintf( line, "static KmPar%s %s = { ",
- par->type == KmTYPE_INT ? "Int " : "Real", &ptype[1] );
- append( &cdef_body, line );
- appstr( &cdef_body, par->range_lower, 0 );
- appstr( &cdef_body, par->range_upper, 1 );
- appstr( &cdef_body, par->slider_lower, 1 );
- appstr( &cdef_body, par->slider_upper, 1 );
- appint( &cdef_body, decimals, 1 );
- append( &cdef_body, " };\n" );
-
- break;
- }
-
- if( par->width != NULL )
- width = atoi( par->width );
-
- sprintf( line, "static KmParameter %s = { ", &pname[1] );
- append( &cdef_body, line);
- appstr( &cdef_body, par->name, 0 );
- appint( &cdef_body, par->abbrev, 1 );
- appstr( &cdef_body, par->prompt, 1 );
- appstr( &cdef_body, par->dfault, 1 );
- appstr( &cdef_body, NULL, 1 ); /* last */
- appint( &cdef_body, width, 1 );
- appint( &cdef_body, par->range_count, 1 );
- applit( &cdef_body, &prange[1], 1 );
- appint( &cdef_body, par->select_count, 1 );
- applit( &cdef_body, &pselect[1], 1 );
- appnum( &cdef_body, "(KmParFlag)", par->flags, 1 );
- applit( &cdef_body, ktype, 1 );
- applit( &cdef_body, ptype, 1 );
- append( &cdef_body, " };\n" );
- }
-
- plist = format_name( &cname[1], "parameters" );
- sprintf( line, "static KmParameter *%s[] = { ", &plist[1] );
- append( &cdef_body, line );
- for( i = 0; i < cmd->total; i++ ) {
- Parameter *par = cmd->par[i];
- char *pname = format_name( &cname[1], par->name );
- applit( &cdef_body, pname, i > 0 );
- }
- append( &cdef_body, " };\n" );
- }
-
- if( cmd->nguidance == 0 ) {
- gname = " (char**)0";
- }
- else {
- int i;
- gname = format_name( &cname[1], "guidance" );
- sprintf( line, "static char *%s[] = { ", &gname[1] );
- append( &cdef_body, line );
- for( i = 0; i < cmd->nguidance; i++ )
- appstr( &cdef_body, cmd->guidance[i], i > 0 );
- append( &cdef_body, " };\n" );
- }
-
- if( cmd->nkeyword == 0 ) {
- kname = " (char**)0";
- }
- else {
- int i;
- kname = format_name( &cname[1], "keyword" );
- sprintf( line, "static char *%s[] = { ", &kname[1] );
- append( &cdef_body, line );
- for( i = 0; i < cmd->nkeyword; i++ )
- appstr( &cdef_body, cmd->keyword[i], i > 0 );
- append( &cdef_body, " };\n" );
- }
-
- if( cmd->nhlink == 0 ) {
- lname = " (char**)0";
- }
- else {
- int i;
- lname = format_name( &cname[1], "hlink" );
- sprintf( line, "static char *%s[] = { ", &lname[1] );
- append( &cdef_body, line );
- for( i = 0; i < cmd->nhlink; i++ )
- appstr( &cdef_body, cmd->hlink[i], i > 0 );
- append( &cdef_body, " };\n" );
- }
-
-
- sprintf( line, "static KmCommand %s = { %s", &cname[1], cnext );
- append( &cdef_body, line );
- sprintf( line, "%s/%s", menu->path, cmd->name );
- appstr( &cdef_body, line, 1 );
- appstr( &cdef_body, cmd->name, 1 );
- append( &cdef_body, ", 0" ); /* hidden */
- appint( &cdef_body, menu->level, 1 );
- appint( &cdef_body, cmd->total, 1 );
- appint( &cdef_body, cmd->mandatory, 1 );
- applit( &cdef_body, &plist[1], 1 );
- appint( &cdef_body, cmd->list_par, 1 );
- append( &cdef_body, ", 0" ); /* xcount */
- appext( &cdef_body, cmd->action, FUNC_INT );
- appext( &cdef_body, cmd->user_help, FUNC_pCHAR );
- appint( &cdef_body, cmd->nguidance, 1 );
- applit( &cdef_body, &gname[1], 1 );
- appint( &cdef_body, cmd->nkeyword, 1 );
- applit( &cdef_body, &kname[1], 1 );
- appint( &cdef_body, cmd->nhlink, 1 );
- applit( &cdef_body, &lname[1], 1 );
- append( &cdef_body, ", 0, (char**)0, (char*)0, (int*)0 };\n\n" );
- }
-}
-
-
-/*
- * output code for linkage defines
- */
-static
-void output_external()
-{
- if( fmode ) {
- int i;
- for( i = 0; i < nexternal_F; i++ ) {
- append( &fdef_head, " EXTERNAL " );
- append( &fdef_head, uppercase( external_F[i] ) );
- append( &fdef_head, "\n" );
- }
- nexternal_F = 0;
- external_F = NULL;
- return;
- }
-
- if( nexternal_F > 0 ) {
- int i;
-
- append( &cdef_head, "#ifdef F77_LCASE\n" );
- for( i = 0; i < nexternal_F; i++ ) {
- char *name = external_F[i];
- sprintf( line, "# define %s_ %s\n", name, name );
- append( &cdef_head, line );
- }
- append( &cdef_head, "#endif\n\n" );
-
- append( &cdef_head, "#ifdef F77_UCASE\n" );
- for( i = 0; i < nexternal_F; i++ ) {
- char *name = external_F[i];
- sprintf( line, "# define %s_ %s\n", name, uppercase( name ) );
- append( &cdef_head, line );
- }
- append( &cdef_head, "#endif\n\n" );
-
- append( &cdef_head, "#ifdef IBM370\n" );
- for( i = 0; i < nexternal_F; i++ ) {
- char *name = external_F[i];
- sprintf( line, "# pragma linkage(%s,FORTRAN)\n", uppercase( name ) );
- append( &cdef_head, line );
- }
- append( &cdef_head, "#endif\n\n" );
-
- for( i = 0; i < nexternal_F; i++ ) {
- char *name = external_F[i];
- sprintf( line, "extern void type_of_call %s_();\n", name );
- append( &cdef_head, line );
- }
- append( &cdef_head, "\n" );
- nexternal_F = 0;
- external_F = NULL;
- }
-
- if( nexternal_C > 0 ) {
- int i;
- for( i = 0; i < nexternal_C; i++ ) {
- char *name = external_C[i];
- char *type = NULL;
- switch( texternal_C[i] ) {
- case FUNC_INT:
- type = "int ";
- break;
- case FUNC_CHAR:
- type = "char *";
- break;
- case FUNC_pCHAR:
- type = "char **";
- break;
- }
- sprintf( line, "extern %s%s();\n", type, name );
- append( &cdef_head, line );
- }
- append( &cdef_head, "\n" );
- nexternal_C = 0;
- external_C = NULL;
- texternal_C = NULL;
- }
-}
-
-
-/*
- * output code for external definitions
- */
-static
-void appext( Buffer *buf,
- const char *name,
- int type )
-{
- char *ffun = "(SUBROUTINE*)0";
- char *cfun = NULL;
-
- switch( type ) {
- case FUNC_INT:
- cfun = "(IntFunc*)0";
- break;
- case FUNC_CHAR:
- cfun = "(CharFunc*)0";
- break;
- case FUNC_pCHAR:
- cfun = "(pCharFunc*)0";
- break;
- }
-
- if( name != NULL ) {
- char *fun = strdup( name );
- char *lan = strchr( fun, '%' );
- int f77 = 1;
-
- if( lan != NULL ) {
- *lan++ = '\0';
- f77 = toupper( lan[0] ) != 'C';
- }
- if( f77 )
- ffun = new_external_F( fun );
- else
- cfun = new_external_C( fun, type );
- }
- applit( buf, ffun, 1 );
- applit( buf, cfun, 1 );
-}
-
-
-static
-void assign_external( const char *name,
- const char *fun,
- int type )
-{
- if( type == FUNC_SUBR )
- sprintf( line, " klnkaddr.%s_F = %s;\n",
- name, new_external_F( fun ) );
- else
- sprintf( line, " klnkaddr.%s_C = %s;\n",
- name, new_external_C( fun, type ) );
- append( &cdef_tail, line );
-}
-
-
-static
-char *new_external_F( const char *name )
-{
- int i;
- char *lname = lowercase( name );
- char *uname = malloc( 64 );
- sprintf( uname, "%s_", lname );
-
- for( i = 0; i < nexternal_F; i++ ) {
- if( strcasecmp( external_F[i], name ) == 0 )
- return uname;
- }
-
- external_F = Realloc( char*, external_F, ++nexternal_F );
- external_F[nexternal_F-1] = lname;
- return uname;
-}
-
-
-static
-char *new_external_C( const char *fun,
- int type )
-{
- char *name = strdup( fun );
- char *lan = strchr( name, '%' );
- int i;
-
- if( lan != NULL )
- *lan = '\0';
-
- for( i = 0; i < nexternal_C; i++ ) {
- if( strcasecmp( external_C[i], name ) == 0 )
- return name;
- }
-
- external_C = Realloc( char*, external_C, ++nexternal_C );
- external_C[nexternal_C-1] = strdup( name );
- texternal_C = Realloc( int, texternal_C, nexternal_C );
- texternal_C[nexternal_C-1] = type;
- return name;
-}
-
-
-/*
- * output code for browsable definitions
- */
-static
-void output_browsables()
-{
- int n;
- for( n = nbrowsables; n > 0; n-- ) {
- Browsable *brw = browsables[n-1];
- char *proot;
- char *popen;
- char bname[16];
-
- sprintf( bname, "brclass_%d", n );
- proot = output_action( bname, "root", brw->nroot, brw->root );
- popen = output_action( bname, "open", brw->nopen, brw->open );
-
- sprintf( line, "static BrClass %s = { ", bname );
- append( &cdef_body, line );
- if( n == nbrowsables )
- append( &cdef_body, "(BrClass*)0" );
- else {
- sprintf( line, "&brclass_%d", n + 1 );
- append( &cdef_body, line );
- }
- appstr( &cdef_body, brw->name, 1 );
- appstr( &cdef_body, brw->title, 1 );
- appext( &cdef_body, brw->scan_km, FUNC_pCHAR );
- appext( &cdef_body, brw->scan_br, FUNC_pCHAR );
- applit( &cdef_body, proot, 1 );
- applit( &cdef_body, popen, 1 );
- append( &cdef_body, " };\n\n" );
- }
-}
-
-
-/*
- * output code for class definitions
- */
-static
-void output_classes()
-{
- int n;
- for( n = nclasses; n > 0; n-- ) {
- Class *cls = classes[n-1];
- char *name = cls->name;
- int is_dir = name[0] == '/';
- char *pcont;
- char *pgraf;
- char cname[16];
-
- sprintf( cname, "kmclass_%d", n );
- pcont = output_action( cname, "cont", cls->ncont, cls->cont );
- pgraf = output_action( cname, "graf", cls->ngraf, cls->graf );
-
- sprintf( line, "static KmClass %s = { ", cname );
- append( &cdef_body, line );
- if( n == nclasses )
- append( &cdef_body, "(KmClass*)0" );
- else {
- sprintf( line, "&kmclass_%d", n + 1 );
- append( &cdef_body, line );
- }
- appint( &cdef_body, is_dir, 1 );
- appstr( &cdef_body, &name[is_dir], 1 );
- appstr( &cdef_body, cls->title, 1 );
- appstr( &cdef_body, cls->big_icon, 1 );
- append( &cdef_body, ", (KmIcon*)0" ); /* bicon */
- appstr( &cdef_body, cls->sm_icon, 1 );
- append( &cdef_body, ", (KmIcon*)0" ); /* sicon */
- appext( &cdef_body, cls->user_icon, FUNC_INT );
- applit( &cdef_body, pcont, 1 );
- applit( &cdef_body, pgraf, 1 );
- appint( &cdef_body, 0, 1 ); /* obj_count */
- append( &cdef_body, " };\n\n" );
- }
-}
-
-
-/*
- * output code for action definitions
- */
-static
-char *output_action( const char *cname,
- const char *aname,
- int n,
- Action **act_list )
-{
- char *pact = "(BrAction*)0";
- int i;
-
- for( i = n; i > 0; i-- ) {
- Action *act = act_list[i-1];
- char caname[32];
- char *tag = NULL;
-
- sprintf( caname, "&%s_%s_%d", cname, aname, i );
- if( i == 1 )
- pact = strdup( caname );
- sprintf( line, "static BrAction %s = { ", &caname[1] );
- append( &cdef_body, line );
- if( i == n )
- append( &cdef_body, "(BrAction*)0" );
- else {
- sprintf( line, "&%s_%s_%d", cname, aname, i + 1 );
- append( &cdef_body, line );
- }
- appnum( &cdef_body, "(BrActFlag)", act->flags, 1 );
- appstr( &cdef_body, act->text, 1 );
- appstr( &cdef_body, NULL, 1 ); /* user_text */
- appstr( &cdef_body, act->accel, 1 );
- appstr( &cdef_body, act->exec, 1 );
- appext( &cdef_body, act->call, FUNC_INT );
- switch( act->tag ) {
- case BRACT_OPEN:
- tag = "BRACT_OPEN";
- break;
- case BRACT_ROOT:
- tag = "BRACT_ROOT";
- break;
- case BRACT_CONT:
- tag = "BRACT_CONT";
- break;
- case BRACT_GRAF:
- tag = "BRACT_GRAF";
- break;
- }
- applit( &cdef_body, tag, 1 );
- append( &cdef_body, ", (BrClass*)0 };\n" );
- }
- return pact;
-}
-
-
-/*
- * output code for icon definitions
- */
-static
-void output_icons()
-{
- int n;
- for( n = nicons; n > 0; n-- ) {
- Icon *icn = icons[n-1];
- char bname[32];
- int i;
-
- sprintf( bname, "(char*)kmicons_%d_bitmap", n );
- sprintf( line, "static unsigned char %s[] = { ", bname + 7 );
- append( &cdef_body, line );
- for( i = 0; i < icn->nbitmap; i++ )
- appint( &cdef_body, icn->bitmap[i] & 0xFF, i > 0 );
- append( &cdef_body, " };\n" );
- sprintf( line, "static KmIcon kmicons_%d = { ", n );
- append( &cdef_body, line );
- if( n == nicons )
- append( &cdef_body, "(KmIcon*)0" );
- else {
- sprintf( line, "&kmicons_%d", n + 1 );
- append( &cdef_body, line );
- }
- appstr( &cdef_body, icn->name, 1 );
- appint( &cdef_body, icn->width, 1 );
- appint( &cdef_body, icn->height, 1 );
- applit( &cdef_body, bname, 1 );
- append( &cdef_body, ", (KmPixmap)0, (KmPixmap)0 };\n\n" );
- }
-}
-
-
-/*
- * output code for button definitions
- */
-static
-void output_buttons()
-{
- int n;
- char *name, *lan;
- for( n = nbuttons; n > 0; n-- ) {
- Button *but = buttons[n-1];
-
- sprintf( line, "static KmButton kmbuttons_%d = { ", n );
- append( &cdef_body, line );
- if( n == nbuttons )
- append( &cdef_body, "(KmButton*)0" );
- else {
- sprintf( line, "&kmbuttons_%d", n + 1 );
- append( &cdef_body, line );
- }
- appstr( &cdef_body, but->menu, 1 );
- appstr( &cdef_body, but->label, 1 );
- name = strdup (but->action);
- lan = strchr( name, '%' );
- if( lan != NULL ) {
- /* callback is a routine */
- *lan = '\0';
- appext( &cdef_body, but->action, FUNC_INT );
- appstr( &cdef_body, name, 1 );
- } else {
- /* callback is a command */
- char *p, *com;
- int il, i, j;
-
- while( (p = strstr( name, " " )) != NULL ) {
- /* remove multiple blanks */
- strcpy( p, p + 1 );
- }
- /* remove ending blanks */
- il = strlen(name);
- for (i = il-1; i >=0; i--) {
- if (name[i] == ' ')
- name[i] = '\0';
- else
- break;
- }
-
- applit (&cdef_body, "(SUBROUTINE*)0", 1);
- applit (&cdef_body, "(IntFunc*)0", 1);
- il = strlen(name);
- com = malloc(il + 10);
- strcpy (com, "BUTTON(");
- for (j=0; j < il; j++) {
- if (name[j] == ' ')
- com [j+7] = ',';
- else
- com [j+7] = name[j];
- }
- com [j+7] = ')';
- com [j+8] = '\0';
- appstr( &cdef_body, com, 1 );
- free (com);
- }
- free (name);
- appstr( &cdef_body, but->mnemo, 1 );
- appstr( &cdef_body, but->accel, 1 );
- appstr( &cdef_body, but->accel_text, 1 );
- appnum( &cdef_body, "(KmButtFlag)", but->flags, 1 );
- append( &cdef_body, ", (KmWidget)0 };\n\n" );
- }
-}
-
-
-/*****************************************************************************
- * routines for reading and parsing
- *****************************************************************************/
-
-static int line_in_buffer; /* flag used for unread_line() */
-
-/*
- * read next line from stdin into full_line and return length or -1 for EOF
- */
-static
-int read_line()
-{
- int n;
-
- if( line_in_buffer ) {
- line_in_buffer = 0;
- return strlen( full_line );
- }
-
- n = 0;
- while( 1 ) {
- line_count++;
- if( fgets( &full_line[n], (sizeof full_line) - n, stdin ) == NULL )
- return -1;
- n = strlen( full_line );
- while( n > 0 && strchr( " \t\n", full_line[n-1] ) != NULL )
- n--;
- if( n > 0 && full_line[n-1] == '_' )
- n--;
- else {
- full_line[n] = '\0';
- break;
- }
- }
-
- if( n == 0 )
- return read_line();
-
- else if( n > 0 && strchr( full_line, '\t' ) != NULL ) {
- char *line = struntab( strdup( full_line ) );
- strcpy( full_line, line );
- free( line );
- n = strlen( full_line );
- }
-
- return n;
-}
-
-
-/*
- * next read_line() will return the same line again
- */
-static
-void unread_line()
-{
- line_in_buffer = 1;
-}
-
-
-/*
- * parse the line into blank separated words
- */
-static
-int parse_line()
-{
- static char copy_line[MAXLINE];
- char *p;
- char *s;
- int n = 0;
- int quoted = 0;
- int i = 0;
-
- while( 1 ) {
- char c = full_line[i++];
-
- /* protect blanks inside quoted strings by replacing them with \n */
- if( c == ' ' && quoted )
- c = '\n';
- else if( c == '\'' ) {
- if( quoted && full_line[i] == '\'' ) {
- i++; /* keep one quote */
- }
- else {
- quoted = !quoted;
- continue; /* remove quotes */
- }
- }
- copy_line[n++] = c;
- if( c == '\0' )
- break;
- }
-
- if( mword < 10 ) {
- mword = 10;
- word = Malloc( char*, mword );
- }
-
- for( nword = 0; nword < mword; nword++ )
- word[nword] = NULL;
-
- for( nword = 0, s = copy_line; (p = strtok( s, " " )) != NULL; nword++ ) {
- if( nword == mword ) {
- mword += 10;
- word = Realloc( char*, word, mword );
- }
- if( p[0] == '.' && p[1] == '\0' )
- word[nword] = NULL;
- else
- word[nword] = p;
- s = NULL;
- }
-
- while( --n >= 0 ) {
- if( copy_line[n] == '\n' )
- copy_line[n] = ' ';
- }
-
- return nword;
-}
-
-
-/*
- * check that the directive is not abbreviated
- */
-static
-void check_abbrev( const char *is,
- const char *should )
-{
-#if 0
- if( strcasecmp( is, should ) != 0 ) {
- sprintf( line, "Abbreviation recognized as '%s'", should );
- warning( line );
- }
-#endif
-}
-
-
-/*
- * check that the number of blank separated fields is between nmin and nmax
- */
-static
-void check_args( int nmin,
- int nmax )
-{
- if( nword < nmin )
- fatal( "Too few arguments" );
- else if( nword > nmax )
- warning( "Too many arguments" );
-}
-
-
-/*****************************************************************************
- * routines for buffer management
- *****************************************************************************/
-
-/*
- * append text at end of buffer
- */
-static
-void append( Buffer *buf,
- const char *text )
-{
- int len = strlen( text );
- if( len == 0 )
- return;
- if( buf->buffer == NULL ) {
- buf->allocated = len * 2 + 1;
- buf->buffer = malloc( buf->allocated );
- }
- else if( buf->allocated < buf->used + len + 1 ) {
- buf->allocated += len * 2 + 1;
- buf->buffer = realloc( buf->buffer, buf->allocated );
- }
- strcpy( &buf->buffer[buf->used], text );
- buf->used += len;
-}
-
-
-/*
- * append a single character
- */
-static
-void appchr( Buffer *buf,
- int chr )
-{
- char str[2];
- str[0] = chr;
- str[1] = '\0';
- append( buf, str );
-}
-
-
-/*
- * append float constant encoded in text
- */
-static
-void appflt( Buffer *buf,
- const char *text,
- int comma )
-{
- if( comma )
- append( buf, "," );
- append( buf, text );
- if( strchr( text, '.' ) == NULL )
- append( buf, "." );
-}
-
-
-/*
- * append integer constant
- */
-static
-void appint( Buffer *buf,
- int n,
- int comma )
-{
- char text[16];
-
- if( comma )
- append( buf, ", " );
-
- sprintf( text, "%d", n );
- append( buf, text );
-}
-
-
-/*
- * append integer constant with type cast
- */
-static
-void appnum( Buffer *buf,
- const char *type,
- int n,
- int comma )
-{
- char text[16];
-
- if( comma )
- append( buf, ", " );
-
- append( buf, type );
- sprintf( text, "%d", n );
- append( buf, text );
-}
-
-
-/*
- * append text as literal
- */
-static
-void applit( Buffer *buf,
- const char *text,
- int comma )
-{
- if( fmode ) {
- if( comma )
- append( buf, "," );
-
- append( buf, text );
- return;
- }
-
- if( comma )
- append( buf, ", " );
-
- if( text == NULL )
- append( buf, "NULL" );
- else
- append( buf, text );
-}
-
-
-/*
- * append text as string protecting \ and "
- */
-static
-void appstr( Buffer *buf,
- const char *str,
- int comma )
-{
- char *text = (str == NULL) ? NULL : strdup( str );
- char *p;
-
- if( fmode ) {
-
- if( comma )
- append( buf, "," );
-
- if( text == NULL || text[0] == '\0' )
- append( buf, "' '" );
- else {
- int quoted = 0;
- int len = strlen( text );
- if( len > 1 && text[len-1] == ' ' ) {
- while( len > 1 && text[len-1] == ' ' )
- len--;
- text[len] = '\0';
- }
- for( p = text; *p != '\0'; p++ ) {
- if( *p == '\\' ) {
- if( quoted ) {
- append( buf, "'" );
- quoted = 0;
- }
- if( p != text )
- append( buf, "//" );
- append( buf, "BS1" );
- }
- else {
- if( !quoted ) {
- if( p != text )
- append( buf, "//" );
- append( buf, "'" );
- quoted = 1;
- }
- if( *p == '\'' )
- append( buf, "''" );
- else
- appchr( buf, *p );
- }
- }
- if( quoted )
- append( buf, "'" );
- }
-
- return;
- }
-
- if( comma )
- append( buf, ", " );
-
- if( text == NULL )
- append( buf, "(char*)0" );
- else {
- append( buf, "\"" );
- while( (p = strpbrk( text, "\\\"" )) != NULL ) {
- static char esc[] = "\\?";
- esc[1] = *p;
- *p++ = '\0';
- append( buf, text );
- append( buf, esc );
- text = p;
- }
- append( buf, text );
- append( buf, "\"" );
- }
-}
-
-
-/*
- * initialize a buffer
- */
-static
-void init_buffer( Buffer *buf )
-{
- buf->used = 0;
- buf->allocated = 0;
- buf->buffer = NULL;
-}
-
-
-/*
- * concatenate buf2 to buf1 and reset buf2
- */
-static
-void cat_buffer( Buffer *buf1,
- Buffer *buf2 )
-{
- if( buf2->used == 0 )
- return;
- if( buf1->used + buf2->used + 1 > buf1->allocated ) {
- buf1->allocated += buf2->allocated;
- buf1->buffer = realloc( buf1->buffer, buf1->allocated );
- }
- strcpy( &buf1->buffer[buf1->used], buf2->buffer );
- buf1->used += buf2->used;
- buf2->used = 0;
- buf2->allocated = 0;
- free( buf2->buffer );
- buf2->buffer = NULL;
-}
-
-
-/*
- * copy buf2 to buf1 and reset buf2
- */
-static
-void copy_buffer( Buffer *buf1,
- Buffer *buf2 )
-{
- if( buf1->buffer != NULL )
- free( buf1->buffer );
- buf1->used = buf2->used;
- buf1->allocated = buf2->allocated;
- buf1->buffer = buf2->buffer;
- buf2->used = 0;
- buf2->allocated = 0;
- buf2->buffer = NULL;
-}
-
-
-/*
- * output the buffer content taking care of continuation lines
- */
-static
-void flush_buffer( Buffer *buf )
-{
- int i;
-
- if( buf->used == 0 )
- return;
-
- if( fmode ) {
- int quoted = 0;
- int n0 = 0;
- for( i = 0; i < buf->used; ) {
- int nbreak = 0;
- int n = 0;
- char *p;
- for( p = &buf->buffer[i]; n + n0 < 72 && *p != '\0' && *p != '\n';
- p++, n++ ) {
- if( *p == '\'' )
- quoted = !quoted;
- else if( !quoted && *p == ',' )
- nbreak = n + 1; /* good break outside quotes */
- }
- if( *p == '\0' ) {
- fputs( &buf->buffer[i], stdout );
- break;
- }
- else if( *p == '\n' ) {
- strncpy( line, &buf->buffer[i], ++n );
- line[n] = '\0';
- n0 = 0;
- }
- else if( nbreak != 0 ) {
- n = nbreak;
- strncpy( line, &buf->buffer[i], n );
- strcpy( &line[n], "\n +" );
- n0 = 6;
- quoted = 0;
- }
- else if( p[-1] == '\'' && !quoted && p[0] != '\'' ) {
- strncpy( line, &buf->buffer[i], n );
- strcpy( &line[n], "\n +" );
- n0 = 6;
- }
- else if( p[-1] != ' ' && p[-1] != '\'' ) {
- strncpy( line, &buf->buffer[i], n );
- strcpy( &line[n], "\n +" );
- n0 = 6;
- }
- else {
- if( p[-1] == '\'' ) {
- while( p[-1] == '\'' ) {
- p--;
- n--;
- quoted = !quoted;
- }
- }
- else {
- n--;
- }
- strncpy( line, &buf->buffer[i], n );
- strcpy( &line[n], "'\n +//'" );
- n0 = 9;
- }
- fputs( line, stdout );
- i += n;
- }
- }
-
- if( cmode ) {
- int squoted = 0;
- int dquoted = 0;
- int bslashd = 0;
- for( i = 0; i < buf->used; ) {
- int nbreak = 0;
- int nquote = 0;
- int n = 0;
- char *p;
- for( p = &buf->buffer[i]; n < 79 && *p != '\0' && *p != '\n';
- p++, n++ ) {
- if( bslashd ) {
- bslashd = 0; /* ignore any character after \ */
- }
- else if( *p == '\\' ) {
- bslashd = 1;
- }
- else if( *p == '"' ) {
- if( !squoted )
- dquoted = !dquoted; /* " except inside ' */
- }
- else if( *p == '\'' ) {
- if( !dquoted )
- squoted = !squoted; /* ' except inside " */
- }
- else if( *p == ' ' ) {
- if( !squoted && !dquoted )
- nbreak = n; /* good break outside quotes */
- if( dquoted )
- nquote = n; /* good break inside quotes */
- }
- }
- if( *p == '\0' ) {
- fputs( &buf->buffer[i], stdout );
- break;
- }
- if( *p == '\n' ) {
- strncpy( line, &buf->buffer[i], ++n );
- line[n] = '\0';
- }
- else if( nbreak != 0 ) {
- n = nbreak;
- strncpy( line, &buf->buffer[i], n );
- strcpy( &line[n], "\n" );
- squoted = bslashd = 0;
- dquoted = 0;
- }
- else if( nquote != 0 ) {
- n = nquote;
- strncpy( line, &buf->buffer[i], n );
- strcpy( &line[n], "\\\n" );
- squoted = bslashd = 0;
- dquoted = 1;
- }
- else {
- strncpy( line, &buf->buffer[i], n );
- strcpy( &line[n], "\n" );
- }
- fputs( line, stdout );
- i += n;
- }
- }
- buf->used = 0;
-}
-
-
-/*
- * concatenate head and tail
- * translate each occurence of '/' into '_'
- */
-static
-char *format_name( const char *head,
- const char *tail )
-{
- char *name;
- int len = strlen( head ) + 1;
- int i;
-
- if( tail != NULL )
- len += strlen( tail ) + 1;
-
- name = malloc( len + 1 );
- strcpy( name, "&" );
- strcat( name, head );
- if( tail != NULL ) {
- strcat( name, "_" );
- strcat( name, tail );
- }
-
- for( i = 0; i < len; i++ ) {
- if( name[i] == '/' )
- name[i] = '_';
- }
- return name;
-}
-
-
-/*
- * return string converted to lowercase
- */
-static
-char *lowercase( const char *str )
-{
- return strlower( strdup( str ) );
-}
-
-
-/*
- * return string converted to uppercase
- */
-static
-char *uppercase( const char *str )
-{
- return strupper( strdup( str ) );
-}
-
-
-/*
- * parse comma separated list of range values
- */
-static
-char **parse_range( int *prange_count,
- const char *range )
-{
- int range_count = 0;
- char **range_value = NULL;
- char *s = strdup( range );
- char *p;
-
- for( range_count = 0; (p = strtok( s, "," )) != NULL; ) {
- range_value = Realloc( char*, range_value, ++range_count );
- range_value[range_count-1] = p;
- s = NULL;
- }
- *prange_count = range_count;
- return range_value;
-}
-
-
-/*
- * set index array for mutex and radio groups
- */
-static
-int *set_groups( Parameter *par,
- Group *group )
-{
- int *pindex = NULL;
-
- if( group != NULL && group->groups > 0 ) {
- int i;
-
- pindex = (int*)calloc( par->range_count, sizeof(int) );
-
- for( i = 0; i < group->groups; i++ ) {
- char **value = group->value[i];
- int j;
-
- for( j = 0; j < group->count[i]; j++ ) {
- int k;
-
- for( k = 0; k < par->range_count; k++ ) {
- if( strcasecmp( par->range_value[k], value[j] ) == 0 ) {
- if( pindex[k] != 0 ) {
- sprintf( line, "Redefining MUTEX or RADIO group for option '%s'",
- value[j] );
- warning( line );
- }
- pindex[k] = i + 1;
- break;
- }
- }
- if( k == par->range_count ) {
- sprintf( line, "Undefined MUTEX or RADIO option '%s'", value[j] );
- warning( line );
- }
- }
- }
- }
- return pindex;
-}
-
-
-static
-void new_action( Action *act,
- const char *text,
- const char *accel,
- const char *exec,
- const char *call,
- BrActTag tag )
-{
- act->flags = 0;
- if( text[0] == '/' ) {
- act->flags |= BrActSeparator;
- text++;
- }
- if( text[0] == '!' ) {
- act->flags |= BrActUpdate;
- text++;
- }
- act->text = strdup( text );
-
- if( accel != NULL ) {
- if( accel[0] == '/' ) {
- act->flags |= BrActSeparator;
- accel++;
- }
- if( accel[0] == '!' ) {
- act->flags |= BrActUpdate;
- accel++;
- }
- if( strncasecmp( accel, "T=", 2 ) == 0 ) {
- act->flags |= BrActToggle;
- if( accel[2] != '0' )
- act->flags |= BrActToggleOn;
- accel += 3;
- }
- }
- if( accel != NULL && strncasecmp( accel, "S=0", 3 ) == 0 ) {
- accel += 3;
- }
- else {
- act->flags |= BrActSensitive;
- }
- act->accel = str0dup( accel );
- act->exec = str0dup( exec );
- act->call = str0dup( call );
- act->tag = tag;
-}
diff --git a/src/packlib/kuip/programs/kxterm/Imakefile b/src/packlib/kuip/programs/kxterm/Imakefile
deleted file mode 100644
index 645f0fd..0000000
--- a/src/packlib/kuip/programs/kxterm/Imakefile
+++ /dev/null
@@ -1,26 +0,0 @@
-SRCS_C= actions.c dialogs.c help.c inputtrdial.c kuipio.c \ @@\
- kxpan.c kxterm.c menu.c saveastrdial.c searchdialog.c utils.c \ @@\
- uxpanel.c uxxt.c kkern.c
-
-#if defined(CERNLIB_VAXVMS)
-EXTRA_DEFINES=-DCERNLIB_VMS
-#endif
-
-PACKAGE_INCLUDES := $(PACKAGE_INCLUDES) MotifIncludes X11Includes
-
-SubdirLibraryTarget(kxtlib,NullParameter)
-
-DefinePackageLibrary(kxtlib)
-
-#if defined(CERNLIB_UNIX)
-CLIBS= -G Motif kernlib
-#endif
-
-#if defined(CERNLIB_VAXVMS)
-CLIBS= graflib/motif packlib kernlib
-#endif
-
-
-CernlibCcProgramTarget(kxterm,kxterm.o,$(PACKAGE_LIB),$(PACKAGE_LIB),$(CLIBS))
-
-InstallProgram(kxterm,$(CERN_BINDIR))
diff --git a/src/packlib/kuip/programs/kxterm/actions.c b/src/packlib/kuip/programs/kxterm/actions.c
deleted file mode 100644
index d1eacc5..0000000
--- a/src/packlib/kuip/programs/kxterm/actions.c
+++ /dev/null
@@ -1,140 +0,0 @@
-/*
- * $Id: actions.c,v 1.1.1.1 1996/03/08 15:33:04 mclareni Exp $
- *
- * $Log: actions.c,v $
- * Revision 1.1.1.1 1996/03/08 15:33:04 mclareni
- * Kuip
- *
- */
-/*CMZ : 2.03/09 01/09/93 15.14.30 by Alfred Nathaniel*/
-/*-- Author : Fons Rademakers 24/02/93*/
-/***********************************************************************
- * *
- * Kxterm action handling routines. *
- * *
- * Except for the sequences and the routines send_... the same as *
- * deck /CKUIP/KMTERM. *
- * *
- ***********************************************************************/
-
-#include <stdio.h>
-#include <stdlib.h>
-#include <string.h>
-
-#include <Xm/Xm.h>
-
-#define ESCAPE "#@"
-
-#include "utils.h"
-#include "actions.h"
-
-
-static int num_kxterm_actions;
-static KxtermActionList kxterm_actions;
-
-
-/***********************************************************************
- * *
- * Return kxterm action proc belonging to string. *
- * *
- ***********************************************************************/
-static KxtermActionProc kxterm_get_proc(string)
- char *string;
-{
- char *s, *s1;
- int i, l, n = num_kxterm_actions;
-
- s = string + strlen(ESCAPE);
- if ((s1 = strchr(s,'(')))
- l = s1 - s;
- else
- l = strlen(s);
-
- for (i = 0; i < n; i++)
- if (!strncmp(kxterm_actions[i].string, s, l))
- return kxterm_actions[i].proc;
-
- return (KxtermActionProc) NULL;
-
-}
-
-/***********************************************************************
- * *
- * Parse action arguments. *
- * *
- ***********************************************************************/
-static void parse_args( cmd, argv, argc )
- char *cmd;
- char **argv;
- int *argc;
-{
- char *s;
-
- *argc = 0;
- argv[0] = (char *)NULL;
-
- /* remove any trailing newline character */
- if ((s = strrchr(cmd, '\n')))
- *s = '\0';
-
- /* position at beginning of argument list */
- s = strchr(cmd, '(');
- if (!s) return;
-
- s = strtok(s, "(,)");
- while (s) {
- argv[(*argc)++] = strdup(s);
- s = strtok(NULL, ",)");
- }
-}
-
-/***********************************************************************
- * *
- * Register kxterm actions. *
- * *
- ***********************************************************************/
-void kxterm_add_actions(actions)
- KxtermActionList actions;
-{
- int i, n = num_kxterm_actions;
- int nact = 0;
-
- for (i = 0; actions[i].string; i++)
- nact++;
-
- if (!kxterm_actions)
- kxterm_actions = (KxtermActionList) malloc(
- (nact+n)*sizeof(KxtermActionsRec));
- else
- kxterm_actions = (KxtermActionList) realloc(kxterm_actions,
- (nact+n)*sizeof(KxtermActionsRec));
-
- for (i = n; i < n+nact; i++) {
- kxterm_actions[i].string = strdup(actions[i-n].string);
- kxterm_actions[i].proc = actions[i-n].proc;
- }
-
- num_kxterm_actions += nact;
-}
-
-/***********************************************************************
- * *
- * Handle kxterm actions. *
- * *
- ***********************************************************************/
-void handle_kxterm_action( cmd )
- char *cmd;
-{
- KxtermActionProc proc;
- char *argv[15];
- int argc, i;
-
- if ((proc = kxterm_get_proc(cmd))) {
- parse_args(cmd, argv, &argc);
-
- (proc)(argv, argc);
-
- for (i = 0; i < argc; i++)
- free(argv[i]);
- }
-}
diff --git a/src/packlib/kuip/programs/kxterm/actions.h b/src/packlib/kuip/programs/kxterm/actions.h
deleted file mode 100644
index 7cc06b8..0000000
--- a/src/packlib/kuip/programs/kxterm/actions.h
+++ /dev/null
@@ -1,37 +0,0 @@
-/*
- * $Id: actions.h,v 1.2 1996/04/11 10:04:20 cernlib Exp $
- *
- * $Log: actions.h,v $
- * Revision 1.2 1996/04/11 10:04:20 cernlib
- * Remobe fortran comment lines
- *
- * Revision 1.1.1.1 1996/03/08 15:33:05 mclareni
- * Kuip
- *
- */
-
-typedef void (*KxtermActionProc)(
-#ifndef _NO_PROTO
- char** /* params */,
- int /* num_params */
-#endif
-);
-
-typedef struct _KxtermActionsRec{
- char *string;
- KxtermActionProc proc;
-} KxtermActionsRec;
-
-typedef KxtermActionsRec *KxtermActionList;
-
-extern void kxterm_add_actions(
-#ifndef _NO_PROTO
- KxtermActionList
-#endif
- );
-extern void handle_kxterm_action(
-#ifndef _NO_PROTO
- char *
-#endif
- );
-
diff --git a/src/packlib/kuip/programs/kxterm/dialogs.c b/src/packlib/kuip/programs/kxterm/dialogs.c
deleted file mode 100644
index 20802eb..0000000
--- a/src/packlib/kuip/programs/kxterm/dialogs.c
+++ /dev/null
@@ -1,358 +0,0 @@
-/*
- * $Id: dialogs.c,v 1.1.1.1 1996/03/08 15:33:03 mclareni Exp $
- *
- * $Log: dialogs.c,v $
- * Revision 1.1.1.1 1996/03/08 15:33:03 mclareni
- * Kuip
- *
- */
-/*CMZ : 2.04/00 08/10/93 09.47.03 by Nicole Cremel*/
-/*-- Author : Fons Rademakers 8/01/93*/
-#include "kuip/kuip.h"
-
-#include <stdio.h>
-#include <string.h>
-#include <Xm/Xm.h>
-#include <X11/Shell.h>
-#include <Xm/DialogS.h>
-#include <Xm/MessageB.h>
-#include <Xm/SelectioB.h>
-
-extern XtAppContext UxAppContext;
-
-extern void helpPNBCallback(
-#ifndef _NO_PROTO
- Widget, char *, XmAnyCallbackStruct *
-#endif
- );
-
-
-/***********************************************************************
- * *
- * Get a response for the dialog. *
- * *
- ***********************************************************************/
-static void response( w, answer, cbs )
- Widget w;
- int *answer;
- XmAnyCallbackStruct *cbs;
-{
- if (cbs->reason == XmCR_OK)
- *answer = 1;
- else if (cbs->reason == XmCR_HELP)
- *answer = 2;
- else if (cbs->reason == XmCR_CANCEL)
- *answer = 3;
-}
-
-/***********************************************************************
- * *
- * Sets the destroyed flag for the dialog. *
- * *
- ***********************************************************************/
-static void destroy_dialog( w, destroyed, cbs )
- Widget w;
- Boolean *destroyed;
- XmAnyCallbackStruct *cbs;
-{
- *destroyed = True;
-}
-
-/***********************************************************************
- * *
- * Ask the user a question and wait for the answer. *
- * *
- ***********************************************************************/
-Boolean ask_user( parent, question, ans1, ans2, default_ans )
- Widget parent;
- char *question;
- char *ans1;
- char *ans2;
- int default_ans;
-{
- static Widget dialog = NULL;
- static Boolean destroyed = False;
- static int answer;
- Arg al[5];
- int ac;
- XmString xmstr, text, yes, no;
-
- answer = 0;
-
- /*
- * check if the dialog has been destroyed (because its parent
- * was destroyed)
- */
- if (destroyed) {
- destroyed = False;
- dialog = NULL;
- }
-
- /*
- * the dialog should be centered around the parent, if the parent
- * changes destroy the dialog and make it for the new parent
- */
- if (dialog && parent != XtParent(XtParent(dialog))) {
- XtDestroyWidget(dialog);
- dialog = NULL;
- }
-
- if (!dialog) {
- ac = 0;
- XtSetArg(al[ac], XmNautoUnmanage, False); ac++;
- XtSetArg(al[ac], XmNdialogStyle, XmDIALOG_FULL_APPLICATION_MODAL); ac++;
- xmstr = XmStringCreateLtoR("Question", XmSTRING_DEFAULT_CHARSET);
- XtSetArg(al[ac], XmNdialogTitle, xmstr); ac++;
- XtSetArg(al[ac], XmNnoResize, True); ac++;
- XtSetArg(al[ac], XmNdeleteResponse, XmDO_NOTHING); ac++;
- dialog = XmCreateQuestionDialog(parent, "questionDialog", al, ac);
- XtUnmanageChild(XmMessageBoxGetChild(dialog,
- XmDIALOG_CANCEL_BUTTON));
- XtAddCallback(dialog, XmNokCallback, (XtCallbackProc)response, &answer);
- XtAddCallback(dialog, XmNhelpCallback, (XtCallbackProc)response, &answer);
- XtAddCallback(dialog, XmNdestroyCallback, (XtCallbackProc)destroy_dialog,
- &destroyed);
- XmStringFree(xmstr);
- }
-
- text = XmStringCreateLtoR(question, XmSTRING_DEFAULT_CHARSET);
- yes = XmStringCreate(ans1, XmSTRING_DEFAULT_CHARSET);
- no = XmStringCreate(ans2, XmSTRING_DEFAULT_CHARSET);
- XtVaSetValues(dialog,
- XmNmessageString, text,
- XmNokLabelString, yes,
- XmNhelpLabelString, no,
- XmNdefaultButtonType, default_ans == 1 ?
- XmDIALOG_OK_BUTTON : XmDIALOG_CANCEL_BUTTON,
- NULL);
- XmStringFree(text);
- XmStringFree(yes);
- XmStringFree(no);
- XtManageChild(dialog);
-
- while (answer == 0) {
- XtAppProcessEvent(UxAppContext, XtIMAll);
- XSync(XtDisplay(dialog), 0);
- }
-
- XtUnmanageChild(dialog);
- XSync(XtDisplay(dialog), 0);
- XmUpdateDisplay(dialog);
-
- return(answer == 1 ? True : False);
-}
-
-/***********************************************************************
- * *
- * Warn the user and wait till he acknowledges. *
- * *
- ***********************************************************************/
-void warn_user( parent, warning )
- Widget parent;
- char *warning;
-{
- static Widget dialog = NULL;
- static Boolean destroyed = False;
- static int answer;
- Arg al[5];
- int ac;
- XmString xmstr, text;
-
- answer = 0;
-
- if (destroyed) {
- destroyed = False;
- dialog = NULL;
- }
-
- if (dialog && parent != XtParent(XtParent(dialog))) {
- XtDestroyWidget(dialog);
- dialog = NULL;
- }
-
- if (!dialog) {
- ac = 0;
- XtSetArg(al[ac], XmNautoUnmanage, False); ac++;
- XtSetArg(al[ac], XmNdialogStyle, XmDIALOG_FULL_APPLICATION_MODAL); ac++;
- xmstr = XmStringCreateLtoR("Warning", XmSTRING_DEFAULT_CHARSET);
- XtSetArg(al[ac], XmNdialogTitle, xmstr); ac++;
- XtSetArg(al[ac], XmNnoResize, True); ac++;
- XtSetArg(al[ac], XmNdeleteResponse, XmDO_NOTHING); ac++;
- dialog = XmCreateWarningDialog(parent, "warningDialog", al, ac);
- XtUnmanageChild(XmMessageBoxGetChild(dialog,
- XmDIALOG_CANCEL_BUTTON));
- XtAddCallback(dialog, XmNokCallback, (XtCallbackProc)response, &answer);
- XtAddCallback(dialog, XmNdestroyCallback, (XtCallbackProc)destroy_dialog,
- &destroyed);
- XmStringFree(xmstr);
- }
-
- XtRemoveAllCallbacks(dialog, XmNhelpCallback);
- XtUnmanageChild(XmMessageBoxGetChild(dialog,
- XmDIALOG_HELP_BUTTON));
-
- text = XmStringCreateLtoR(warning, XmSTRING_DEFAULT_CHARSET);
- XtVaSetValues(dialog,
- XmNmessageString, text,
- NULL);
- XmStringFree(text);
- XtManageChild(dialog);
-
- while (answer == 0) {
- XtAppProcessEvent(UxAppContext, XtIMAll);
- XSync(XtDisplay(dialog), 0);
- }
-
- XtUnmanageChild(dialog);
- XSync(XtDisplay(dialog), 0);
- XmUpdateDisplay(dialog);
-}
-
-/***********************************************************************
- * *
- * Inform the user and wait till he acknowledges. *
- * *
- ***********************************************************************/
-void inform_user( parent, warning )
- Widget parent;
- char *warning;
-{
- static Widget dialog = NULL;
- static Boolean destroyed = False;
- static int answer;
- Arg al[5];
- int ac;
- XmString xmstr, text;
-
- answer = 0;
-
- if (destroyed) {
- destroyed = False;
- dialog = NULL;
- }
-
- if (dialog && parent != XtParent(XtParent(dialog))) {
- XtDestroyWidget(dialog);
- dialog = NULL;
- }
-
- if (!dialog) {
- ac = 0;
- XtSetArg(al[ac], XmNautoUnmanage, False); ac++;
- XtSetArg(al[ac], XmNdialogStyle, XmDIALOG_FULL_APPLICATION_MODAL); ac++;
- xmstr = XmStringCreateLtoR("Information", XmSTRING_DEFAULT_CHARSET);
- XtSetArg(al[ac], XmNdialogTitle, xmstr); ac++;
- XtSetArg(al[ac], XmNnoResize, True); ac++;
- XtSetArg(al[ac], XmNdeleteResponse, XmDO_NOTHING); ac++;
- dialog = XmCreateInformationDialog(parent, "informationDialog", al, ac);
- XtUnmanageChild(XmMessageBoxGetChild(dialog,
- XmDIALOG_CANCEL_BUTTON));
- XtAddCallback(dialog, XmNokCallback, (XtCallbackProc)response, &answer);
- XtAddCallback(dialog, XmNdestroyCallback, (XtCallbackProc)destroy_dialog,
- &destroyed);
- XmStringFree(xmstr);
- }
-
- XtRemoveAllCallbacks(dialog, XmNhelpCallback);
- XtUnmanageChild(XmMessageBoxGetChild(dialog,
- XmDIALOG_HELP_BUTTON));
-
- text = XmStringCreateLtoR(warning, XmSTRING_DEFAULT_CHARSET);
- XtVaSetValues(dialog,
- XmNmessageString, text,
- NULL);
- XmStringFree(text);
- XtManageChild(dialog);
-
- while (answer == 0) {
- XtAppProcessEvent(UxAppContext, XtIMAll);
- XSync(XtDisplay(dialog), 0);
- }
-
- XtUnmanageChild(dialog);
- XSync(XtDisplay(dialog), 0);
- XmUpdateDisplay(dialog);
-}
-
-
-/***********************************************************************
- * *
- * Prompt the user and wait till he acknowledges. *
- * *
- ***********************************************************************/
-char *prompt_user( parent, prompt, default_line, help_item)
- Widget parent;
- char *prompt, *default_line, *help_item;
-{
- static Widget dialog = NULL;
- static Boolean destroyed = False;
- static int answer;
- Arg al[5];
- int ac;
- XmString xmstr, input_string;
-
- char *input_text = NULL;
-
- answer = 0;
-
- if (destroyed) {
- destroyed = False;
- dialog = NULL;
- }
-
- if (dialog) {
- XtDestroyWidget(dialog);
- dialog = NULL;
- }
-
- if (!dialog) {
- ac = 0;
- XtSetArg(al[ac], XmNautoUnmanage, False); ac++;
- XtSetArg(al[ac], XmNdialogStyle, XmDIALOG_FULL_APPLICATION_MODAL); ac++;
- xmstr = XmStringCreateLtoR("Prompt", XmSTRING_DEFAULT_CHARSET);
- XtSetArg(al[ac], XmNdialogTitle, xmstr); ac++;
- XtSetArg(al[ac], XmNnoResize, True); ac++;
- XtSetArg(al[ac], XmNdeleteResponse, XmDO_NOTHING); ac++;
- XtSetArg (al[ac],XmNselectionLabelString,
- XmStringCreateLtoR(prompt,XmSTRING_DEFAULT_CHARSET)); ac++;
- if (strlen(default_line) != 0) {
- XtSetArg (al[ac],XmNtextString,
- XmStringCreateLtoR(default_line, XmSTRING_DEFAULT_CHARSET)); ac++;
- }
- dialog = XmCreatePromptDialog(parent, "promptDialog", al, ac);
- XtAddCallback(dialog, XmNokCallback, (XtCallbackProc)response,
- &answer);
- XtAddCallback(dialog, XmNcancelCallback,
- (XtCallbackProc)response, &answer);
- XtAddCallback(dialog,XmNhelpCallback,
- (XtCallbackProc)helpPNBCallback,(XtPointer)help_item);
- XtAddCallback(dialog, XmNdestroyCallback, (XtCallbackProc)destroy_dialog,
- &destroyed);
- XmStringFree(xmstr);
- }
-
- XtManageChild(dialog);
-
- while (answer == 0) {
- XtAppProcessEvent(UxAppContext, XtIMAll);
- XSync(XtDisplay(dialog), 0);
- }
-
- XtUnmanageChild(dialog);
- XSync(XtDisplay(dialog), 0);
- XmUpdateDisplay(dialog);
-
- if (answer == 3) {
- return (NULL);
- } else {
- ac = 0;
- XtSetArg (al[ac], XmNtextString, &input_string); ac++;
- XtGetValues (dialog, al, ac);
- XmStringGetLtoR(input_string, XmSTRING_DEFAULT_CHARSET, &input_text);
- if( input_text == NULL || input_text[0] == '\0' )
- return NULL;
- else
- return (strdup(input_text));
- }
-
-}
diff --git a/src/packlib/kuip/programs/kxterm/help.c b/src/packlib/kuip/programs/kxterm/help.c
deleted file mode 100644
index efa9179..0000000
--- a/src/packlib/kuip/programs/kxterm/help.c
+++ /dev/null
@@ -1,325 +0,0 @@
-/*
- * $Id: help.c,v 1.1.1.1 1996/03/08 15:33:04 mclareni Exp $
- *
- * $Log: help.c,v $
- * Revision 1.1.1.1 1996/03/08 15:33:04 mclareni
- * Kuip
- *
- */
-/*CMZ : 2.04/02 27/10/93 15.09.43 by Fons Rademakers*/
-/*-- Author : Fons Rademakers 16/03/93*/
-
-#include <stdio.h>
-#include <Xm/Xm.h>
-#include <Xm/DialogS.h>
-#include <Xm/MenuShell.h>
-#include <Xm/Text.h>
-#include <Xm/ScrolledW.h>
-#include <Xm/SeparatoG.h>
-#include <Xm/PushBG.h>
-#include <Xm/Form.h>
-
-#include "uxxt.h"
-
-extern Widget kuipIo;
-
-Widget help[3];
-
-
-char *help_text[3] = {"\
- Kxterm -- Kuip Terminal Emulator\n\n\
-This terminal emulator combines the best features from\n\
-the (now defunct) Apollo DM pads (like: input and transcript\n\
-pads, automatic file backup of transcript pad, string\n\
-search in pads, etc.) and the Korn shell emacs-style\n\
-command line editing and command line recall mechanism.\n\n\
-Commands are typed in the input pad behind the application prompt.\n\
-Via the toggle buttons labeled \"H\" the input and/or transcript\n\
-pad can be placed in hold mode. In hold mode one can paste or type\n\
-a number of commands into the input pad and edit them without sending\n\
-the commands to the application. Releasing the hold button\n\
-will causes Kxterm to submit all lines, upto the line containing the\n\
-cursor, to the application. To submit the lines below the cursor,\n\
-just move the cursor down. In this way one can still edit the\n\
-lines just before they are being submitted to the application.\n\n\
-Commands can be edited in the input pad using emacs-like key\n\
-sequences. See help \"On Edit Keys\".\n\n\
-The transcript pad shows the executed commands and command\n\
-output. When in hold mode the transcript pad does not scroll to\n\
-make the new text visible.\n\n\
-Below follows a description of the different Kxterm menus:\n\
- File\n\
- About Kxterm...\n\
- Displays version information about Kxterm.\n\
- About <Application>...\n\
- Displays version information about the application\n\
- Kxterm is servicing.\n\
- Save Transcript\n\
- Write the contents of the transcript pad to the current\n\
- file. If there is no current file a file selection box\n\
- will appear.\n\
- Save Transcript As...\n\
- Write the contents of the transcript pad to a user-specified\n\
- file.\n\
- Print...\n\
- Print the contents of the transcript pad (not yet implemented).\n\
- Kill\n\
- Send a SIGINT signal to the application to cause it to\n\
- core dump. This is useful when the application is hanging or\n\
- blocked. Use only in emergency situations.\n\
- Exit\n\
- Exit Kxterm and the application.\n\n\
- Edit\n\
- Cut\n\
- Remove the selected text. The selected text is written to the\n\
- Cut & Paste buffer. Using the \"Paste\" function, it can be\n\
- written to any X11 program. In the transcript pad \"Cut\"\n\
- defaults to the \"Copy\" function.\n\
- Copy\n\
- Copy the selected text. The selected text is written to the\n\
- Cut & Paste buffer. Using the \"Paste\" function, it can be\n\
- written to any X11 program.\n\
- Paste\n\
- Insert text from the Cut & Paste buffer at the cursor location\n\
- into the input pad.\n\
- Search...\n\
- Search for a text string in the transcript pad.\n\n\
- View\n\
- Show Input\n\
- Show in a window all commands entered via the input pad.\n\n\
- Options\n\
- Clear Transcript Pad\n\
- Clear all text off of the top of the transcript pad.\n\
- Echo Command\n\
- Echo executed commands in transcript pad.\n\
- Timing\n\
- Report command execution time (real and CPU time).\n\
- Iconify\n\
- Iconify Kxterm and all windows of the application.\n\n\
- Help\n\
- On Kxterm\n\
- The help you are currently reading.\n\
- On Edit Keys\n\
- Help on the emacs-style edit key sequences.\n\n\
-All Kxterm menu's may be dynamically extended by the application.\n\
-See for help on these new menu items the application help.\n\n\
-",
-
-"\
- Kxterm -- X Resources\n\n\
-This is a list of X resources available to Kxterm.\n\n\
-Users can specify their own values for these resources in the standard\n\
-X/Motif way (via their own .Xdefaults file or, system wide, via a file\n\
-in the /usr/lib/X11/app-defaults directory). One just has to prefix the\n\
-desired resource by the class name of the application preceded by \"Kx\".\n\
-So for application \"App\" the Kxterm resource class is \"KxApp\".\n\n\
-Any default value is given behind the resource name.\n\n\
- *background:\n\n\
-Specify the background color for all windows.\n\n\
- *foreground:\n\n\
-Specify the foreground color for all windows.\n\n\
- *outputForm.height: 205\n\n\
-Height of the transcript pad (in pixels). This will scale the size of the\n\
-input pad accordingly.\n\n\
- *outputText*...:\n\n\
-All resources of the transcript pad text widget.\n\n\
- *inputText*...:\n\n\
-All resource of the input pad text widget.\n\n\
-",
-
-"\
- Kxterm -- Edit Key Sequences\n\n\
-\"C-b\" means holding down the Control key and pressing the b key.\n\
-\"M-\" stands for the Meta key and \"A-\" for the Alt key.\n\n\
-C-b: backward character\n\
-A-b: backward word\n\
-M-b: backward word\n\
-Shift A-b: backward word, extend selection\n\
-Shift M-b: backward word, extend selection\n\
-A-[: backward paragraph\n\
-M-[: backward paragraph\n\
-Shift A-[: backward paragraph, extend selection\n\
-Shift M-[: backward paragraph, extend selection\n\
-A-<: beginning of file\n\
-M-<: beginning of file\n\
-C-a: beginning of line\n\
-Shift C-a: beginning of line, extend selection\n\
-C-osfInsert: copy to clipboard\n\
-Shift osfDelete: cut to clipboard\n\
-Shift osfInsert: paste from clipboard\n\
-Alt->: end of file\n\
-M->: end of file\n\
-C-e: end of line\n\
-Shift C-e: end of line, extend selection\n\
-C-f: forward character\n\
-A-]: forward paragraph\n\
-M-]: forward paragraph\n\
-Shift A-]: forward paragraph, extend selection\n\
-Shift M-]: forward paragraph, extend selection\n\
-C-A-f: forward word\n\
-C-M-f: forward word\n\
-C-d: kill next character\n\
-A-BS: kill previous word\n\
-M-BS: kill previous word\n\
-C-w: kill region\n\
-C-y: yank back last thing killed\n\
-C-k: kill to end of line\n\
-C-u: kill line\n\
-A-DEL: kill to start of line\n\
-M-DEL: kill to start of line\n\
-C-o: newline and backup\n\
-C-j: newline and indent\n\
-C-n: get next command, in hold mode: next line\n\
-C-osfLeft: page left\n\
-C-osfRight: page right\n\
-C-p: get previous command, in hold mode: previous line\n\
-C-g: process cancel\n\
-C-l: redraw display\n\
-C-osfDown: next page\n\
-C-osfUp: previous page\n\
-C-SPC: set mark here\n\
-C-c: send kill signal to application\n\
-C-h: toggle hold button of pad containing input focus\n\
-F8: re-execute last executed command\n\
-Shift F8: put last executed command in input pad\n\
-Shift-TAB: change input focus\n\
-"
-};
-
-
-/***********************************************************************
- * *
- * Destroy the HELP dialog. *
- * *
- ***********************************************************************/
-static void destroy_help(w, dialog, call_data)
- Widget w;
- Widget dialog;
- XmAnyCallbackStruct *call_data;
-{
- if (dialog == help[0])
- help[0] = NULL;
- else if (dialog == help[1])
- help[1] = NULL;
- else
- help[2] = NULL;
-
- UxDestroyInterface(dialog);
-}
-
-/***********************************************************************
- * *
- * Show the help text in a dialog. *
- * *
- ***********************************************************************/
-static Widget show_help(parent, text, title)
- Widget parent;
- char *text;
- char *title;
-{
- Widget help_shell;
- Widget help_form;
- Widget ok_button;
- Widget sep;
- Widget help_sw;
- Widget text_w;
-
- help_shell = XtVaCreatePopupShell("help_shell",
- xmDialogShellWidgetClass, parent,
- XmNtitle, title,
- XmNdeleteResponse, XmDESTROY,
- NULL);
-
- help_form = XtVaCreateWidget("help_form",
- xmFormWidgetClass, help_shell,
- XmNautoUnmanage, FALSE,
- XmNheight, 350,
- XmNwidth, 635,
- NULL);
-
- ok_button = XtVaCreateManagedWidget("ok_button",
- xmPushButtonGadgetClass, help_form,
- XmNdefaultButtonShadowThickness, 1,
- XmNtopAttachment, XmATTACH_NONE,
- XmNleftPosition, 50,
- XmNleftOffset, -30,
- XmNleftAttachment, XmATTACH_POSITION,
- XmNbottomOffset, 10,
- XmNbottomAttachment, XmATTACH_FORM,
- XmNshowAsDefault, 1,
- RES_CONVERT(XmNlabelString, "OK"),
- XmNheight, 30,
- XmNwidth, 60,
- NULL);
-
- sep = XtVaCreateManagedWidget("sep",
- xmSeparatorGadgetClass, help_form,
- XmNbottomWidget, ok_button,
- XmNrightOffset, 0,
- XmNrightAttachment, XmATTACH_FORM,
- XmNleftOffset, 0,
- XmNleftAttachment, XmATTACH_FORM,
- XmNbottomOffset, 10,
- XmNbottomAttachment, XmATTACH_WIDGET,
- NULL);
-
- help_sw = XtVaCreateManagedWidget("help_sw",
- xmScrolledWindowWidgetClass, help_form,
- XmNbottomWidget, sep,
- XmNbottomOffset, 5,
- XmNbottomAttachment, XmATTACH_WIDGET,
- XmNtopOffset, 5,
- XmNtopAttachment, XmATTACH_FORM,
- XmNrightOffset, 5,
- XmNrightAttachment, XmATTACH_FORM,
- XmNleftOffset, 5,
- XmNleftAttachment, XmATTACH_FORM,
- XmNvisualPolicy, XmVARIABLE,
- XmNscrollingPolicy, XmAPPLICATION_DEFINED,
- XmNscrollBarDisplayPolicy, XmSTATIC,
- XmNshadowThickness, 0,
- NULL);
-
- text_w = XtVaCreateManagedWidget("text_w",
- xmTextWidgetClass, help_sw,
- XmNeditMode, XmMULTI_LINE_EDIT ,
- XmNeditable, FALSE,
- XmNvalue, text,
- NULL);
-
- XtVaSetValues(help_form, XmNdefaultButton, ok_button, NULL);
-
- XtAddCallback(ok_button, XmNactivateCallback,
- (XtCallbackProc)destroy_help, help_shell);
- XtAddCallback(help_shell, XmNdestroyCallback,
- (XtCallbackProc)destroy_help, help_shell);
-
- UxPopupInterface(help_shell, XtGrabNone);
-
- return(help_shell);
-}
-
-/***********************************************************************
- * *
- * Callback called by the help menu items. *
- * *
- ***********************************************************************/
-void help_cb(w, type, call_data)
- Widget w;
- int *type;
- XmAnyCallbackStruct *call_data;
-{
- int t = (int)type;
-
- if (help[t])
- XRaiseWindow(XtDisplay(help[t]), XtWindow(help[t]));
- else {
- if (t == 0)
- help[t] = show_help(kuipIo, help_text[t], "Help on: Kxterm");
- else if (t == 1)
- help[t] = show_help(kuipIo, help_text[t], "Help on: Kxterm Resources");
- else
- help[t] = show_help(kuipIo, help_text[t], "Help on: Edit Keys");
- }
-}
-
diff --git a/src/packlib/kuip/programs/kxterm/inputtrdial.c b/src/packlib/kuip/programs/kxterm/inputtrdial.c
deleted file mode 100644
index 3b4b688..0000000
--- a/src/packlib/kuip/programs/kxterm/inputtrdial.c
+++ /dev/null
@@ -1,210 +0,0 @@
-/*
- * $Id: inputtrdial.c,v 1.1.1.1 1996/03/08 15:33:04 mclareni Exp $
- *
- * $Log: inputtrdial.c,v $
- * Revision 1.1.1.1 1996/03/08 15:33:04 mclareni
- * Kuip
- *
- */
-/*CMZ : 2.00/09 18/01/93 12.55.17 by Alfred Nathaniel*/
-/*-- Author :*/
-
-/*******************************************************************************
- inputTrDialog.c
- (Generated from interface file inputTrDialog.i)
-*******************************************************************************/
-
-#include <stdio.h>
-#include <Xm/Xm.h>
-#include <Xm/DialogS.h>
-#include <Xm/MenuShell.h>
-#include "uxxt.h"
-
-#include <Xm/Text.h>
-#include <Xm/ScrolledW.h>
-#include <Xm/Separator.h>
-#include <Xm/PushB.h>
-#include <Xm/Form.h>
-
-/*******************************************************************************
- Includes, Defines, and Global variables from the Declarations Editor:
-*******************************************************************************/
-
-extern swidget kuipIo;
-
-/*******************************************************************************
- The definition of the context structure:
- If you create multiple instances of your interface, the context
- structure ensures that your callbacks use the variables for the
- correct instance.
-
- For each swidget in the interface, each argument to the Interface
- function, and each variable in the Instance Specific section of the
- Declarations Editor, there is an entry in the context structure.
- and a #define. The #define makes the variable name refer to the
- corresponding entry in the context structure.
-*******************************************************************************/
-
-typedef struct
-{
- Widget UxinputTrDialog;
- Widget Uxseparator2;
- Widget UxscrolledWindow;
-} _UxCinputTrDialog;
-
-#define inputTrDialog UxInputTrDialogContext->UxinputTrDialog
-#define separator2 UxInputTrDialogContext->Uxseparator2
-#define scrolledWindow UxInputTrDialogContext->UxscrolledWindow
-
-static _UxCinputTrDialog *UxInputTrDialogContext;
-
-Widget closeInputTrButton;
-Widget inputTrText;
-
-/*******************************************************************************
- Forward declarations of functions that are defined later in this file.
-*******************************************************************************/
-
-Widget create_inputTrDialog();
-
-/*******************************************************************************
- The following are callback functions.
-*******************************************************************************/
-
-/*******************************************************************************
- The 'build_' function creates all the widgets
- using the resource values specified in the Property Editor.
-*******************************************************************************/
-
-static Widget _Uxbuild_inputTrDialog()
-{
- Widget inputTrDialog_shell;
-
- inputTrDialog_shell = XtVaCreatePopupShell( "inputTrDialog_shell",
- xmDialogShellWidgetClass, kuipIo,
- XmNwidth, 520,
- XmNheight, 315,
- XmNshellUnitType, XmPIXELS,
- XmNtitle, "inputTrDialog",
- NULL );
-
- inputTrDialog = XtVaCreateWidget( "inputTrDialog",
- xmFormWidgetClass, inputTrDialog_shell,
- XmNdefaultPosition, FALSE,
- XmNautoUnmanage, FALSE,
- RES_CONVERT( XmNdialogTitle, "Input Transcript" ),
- XmNheight, 315,
- XmNwidth, 520,
- XmNunitType, XmPIXELS,
- NULL );
-
- UxPutContext( inputTrDialog, (char *) UxInputTrDialogContext );
-
- closeInputTrButton = XtVaCreateManagedWidget( "closeInputTrButton",
- xmPushButtonWidgetClass, inputTrDialog,
- XmNrightPosition, 60,
- XmNrightAttachment, XmATTACH_POSITION,
- XmNleftPosition, 40,
- XmNleftAttachment, XmATTACH_POSITION,
- RES_CONVERT( XmNlabelString, "Close" ),
- XmNbottomOffset, 10,
- XmNbottomAttachment, XmATTACH_FORM,
- XmNheight, 30,
- XmNwidth, 60,
- NULL );
-
- UxPutContext( closeInputTrButton, (char *) UxInputTrDialogContext );
-
- separator2 = XtVaCreateManagedWidget( "separator2",
- xmSeparatorWidgetClass, inputTrDialog,
- XmNrightAttachment, XmATTACH_FORM,
- XmNleftAttachment, XmATTACH_FORM,
- XmNbottomWidget, closeInputTrButton,
- XmNbottomOffset, 10,
- XmNbottomAttachment, XmATTACH_WIDGET,
- NULL );
-
- UxPutContext( separator2, (char *) UxInputTrDialogContext );
-
- scrolledWindow = XtVaCreateManagedWidget( "scrolledWindow",
- xmScrolledWindowWidgetClass, inputTrDialog,
- XmNbottomWidget, separator2,
- XmNbottomOffset, 5,
- XmNbottomAttachment, XmATTACH_WIDGET,
- XmNtopOffset, 5,
- XmNrightOffset, 5,
- XmNtopAttachment, XmATTACH_FORM,
- XmNrightAttachment, XmATTACH_FORM,
- XmNleftOffset, 5,
- XmNleftAttachment, XmATTACH_FORM,
- XmNshadowThickness, 0,
- XmNscrollBarDisplayPolicy, XmSTATIC,
- XmNvisualPolicy, XmVARIABLE,
- XmNscrollingPolicy, XmAPPLICATION_DEFINED,
- NULL );
-
- UxPutContext( scrolledWindow, (char *) UxInputTrDialogContext );
-
- inputTrText = XtVaCreateManagedWidget( "inputTrText",
- xmTextWidgetClass, scrolledWindow,
- XmNeditable, FALSE,
- XmNeditMode, XmMULTI_LINE_EDIT ,
- XmNheight, 210,
- XmNwidth, 495,
- NULL );
-
- UxPutContext( inputTrText, (char *) UxInputTrDialogContext );
-
- XtAddCallback( inputTrDialog, XmNdestroyCallback,
- UxFreeClientDataCB,
- (XtPointer) UxInputTrDialogContext );
-
- XtVaSetValues(inputTrDialog,
- XmNdefaultButton, closeInputTrButton,
- NULL );
-
-
-
- return ( inputTrDialog );
-}
-
-/*******************************************************************************
- The following function includes the code that was entered
- in the 'Initial Code' and 'Final Code' sections of the
- Declarations Editor. This function is called from the
- 'Interface function' below.
-*******************************************************************************/
-
-static Widget _Ux_create_inputTrDialog()
-{
- Widget rtrn;
- _UxCinputTrDialog *UxContext;
-
- UxInputTrDialogContext = UxContext =
- (_UxCinputTrDialog *) XtMalloc( sizeof(_UxCinputTrDialog) );
-
- rtrn = _Uxbuild_inputTrDialog();
-
- return(rtrn);
-}
-
-/*******************************************************************************
- The following is the 'Interface function' which is the
- external entry point for creating this interface.
- This function should be called from your application or from
- a callback function.
-*******************************************************************************/
-
-Widget create_inputTrDialog()
-{
- Widget _Uxrtrn;
-
- _Uxrtrn = _Ux_create_inputTrDialog();
-
- return ( _Uxrtrn );
-}
-
-/*******************************************************************************
- END OF FILE
-*******************************************************************************/
-
diff --git a/src/packlib/kuip/programs/kxterm/kkern.c b/src/packlib/kuip/programs/kxterm/kkern.c
deleted file mode 100644
index ecc1a9a..0000000
--- a/src/packlib/kuip/programs/kxterm/kkern.c
+++ /dev/null
@@ -1 +0,0 @@
-#include "code_kuip/kkern.c"
diff --git a/src/packlib/kuip/programs/kxterm/kuipio.c b/src/packlib/kuip/programs/kxterm/kuipio.c
deleted file mode 100644
index fbfce1c..0000000
--- a/src/packlib/kuip/programs/kxterm/kuipio.c
+++ /dev/null
@@ -1,794 +0,0 @@
-/*
- * $Id: kuipio.c,v 1.1.1.1 1996/03/08 15:33:04 mclareni Exp $
- *
- * $Log: kuipio.c,v $
- * Revision 1.1.1.1 1996/03/08 15:33:04 mclareni
- * Kuip
- *
- */
-/*CMZ : 2.04/04 13/12/93 10.26.28 by Alfred Nathaniel*/
-/*-- Author :*/
-
-/*******************************************************************************
- kuipIo.c
- (Generated from interface file kuipIo.i)
-*******************************************************************************/
-
-#include <stdio.h>
-#include <Xm/Xm.h>
-#include <Xm/MwmUtil.h>
-#include <X11/Shell.h>
-#include <Xm/MenuShell.h>
-#include "uxxt.h"
-
-#include <Xm/CascadeB.h>
-#include <Xm/Separator.h>
-#include <Xm/RowColumn.h>
-#include <Xm/Text.h>
-#include <Xm/ScrolledW.h>
-#include <Xm/PushB.h>
-#include <Xm/Label.h>
-#include <Xm/PanedW.h>
-#include <Xm/Form.h>
-#include <Xm/Frame.h>
-#include <Xm/MainW.h>
-
-
-
-/*******************************************************************************
- The definition of the context structure:
- If you create multiple copies of your interface, the context
- structure ensures that your callbacks use the variables for the
- correct copy.
-
- For each swidget in the interface, each argument to the Interface
- function, and each variable in the Interface Specific section of the
- Declarations Editor, there is an entry in the context structure.
- and a #define. The #define makes the variable name refer to the
- corresponding entry in the context structure.
-*******************************************************************************/
-
-typedef struct
-{
- Widget UxkuipIo;
- Widget Uxframe1;
- Widget Uxform1;
- Widget UxoutputForm;
- Widget Uxform3;
- Widget Uxlabel2;
- Widget UxscrolledWindow2;
- Widget UxinputForm;
- Widget Uxform2;
- Widget Uxlabel1;
- Widget UxscrolledWindow1;
- Widget UxFileMenu;
- Widget UxFileMenu_b11;
- Widget Uxmenu1_p1_b9;
- Widget Uxmenu1_p1_b8;
- Widget UxFileMenu_b8;
- Widget Uxmenu1_top_b1;
- Widget UxEditMenu;
- Widget Uxmenu1_p2_b5;
- Widget Uxmenu1_top_b2;
- Widget UxViewMenu;
- Widget Uxmenu1_top_b3;
- Widget UxOptionMenu;
- Widget Uxmenu1_top_b4;
- Widget UxHelpMenu;
- Widget Uxmenu1_top_b5;
-} _UxCkuipIo;
-
-static _UxCkuipIo *UxKuipIoContext;
-#define kuipIo UxKuipIoContext->UxkuipIo
-#define frame1 UxKuipIoContext->Uxframe1
-#define form1 UxKuipIoContext->Uxform1
-#define outputForm UxKuipIoContext->UxoutputForm
-#define form3 UxKuipIoContext->Uxform3
-#define label2 UxKuipIoContext->Uxlabel2
-#define scrolledWindow2 UxKuipIoContext->UxscrolledWindow2
-#define inputForm UxKuipIoContext->UxinputForm
-#define form2 UxKuipIoContext->Uxform2
-#define label1 UxKuipIoContext->Uxlabel1
-#define scrolledWindow1 UxKuipIoContext->UxscrolledWindow1
-#define FileMenu UxKuipIoContext->UxFileMenu
-#define FileMenu_b11 UxKuipIoContext->UxFileMenu_b11
-#define menu1_p1_b9 UxKuipIoContext->Uxmenu1_p1_b9
-#define menu1_p1_b8 UxKuipIoContext->Uxmenu1_p1_b8
-#define FileMenu_b8 UxKuipIoContext->UxFileMenu_b8
-#define menu1_top_b1 UxKuipIoContext->Uxmenu1_top_b1
-#define EditMenu UxKuipIoContext->UxEditMenu
-#define menu1_p2_b5 UxKuipIoContext->Uxmenu1_p2_b5
-#define menu1_top_b2 UxKuipIoContext->Uxmenu1_top_b2
-#define ViewMenu UxKuipIoContext->UxViewMenu
-#define menu1_top_b3 UxKuipIoContext->Uxmenu1_top_b3
-#define OptionMenu UxKuipIoContext->UxOptionMenu
-#define menu1_top_b4 UxKuipIoContext->Uxmenu1_top_b4
-#define HelpMenu UxKuipIoContext->UxHelpMenu
-#define menu1_top_b5 UxKuipIoContext->Uxmenu1_top_b5
-
-
-Widget panedWindow;
-Widget outputHoldButton;
-Widget lcdLabel;
-Widget outputText;
-Widget inputHoldButton;
-Widget cwdLabel;
-Widget inputText;
-Widget menuBar;
-Widget aboutButton;
-Widget aboutAppButton;
-Widget saveTransButton;
-Widget saveTransAsButton;
-Widget printButton;
-Widget killButton;
-Widget exitButton;
-Widget cutButton;
-Widget copyButton;
-Widget pasteButton;
-Widget searchButton;
-Widget showInputButton;
-Widget clearTrButton;
-Widget helpKxtermButton;
-Widget helpResourceButton;
-Widget helpEditButton;
-
-/*******************************************************************************
- Declarations of global functions.
-*******************************************************************************/
-
-Widget create_kuipIo();
-
-/*******************************************************************************
- The following are callback functions.
-*******************************************************************************/
-
-/*******************************************************************************
- The 'build_' function creates all the widgets
- using the resource values specified in the Property Editor.
-*******************************************************************************/
-
-static Widget _Uxbuild_kuipIo()
-{
- Widget _UxParent;
- Widget FileMenu_shell;
- Widget EditMenu_shell;
- Widget ViewMenu_shell;
- Widget OptionMenu_shell;
- Widget HelpMenu_shell;
-
-
- /* Creation of kuipIo */
- _UxParent = XtVaCreatePopupShell( "kuipIo_shell",
- topLevelShellWidgetClass, UxTopLevel,
- XmNx, 0,
- XmNy, 0,
- XmNwidth, 700,
- XmNheight, 495,
- XmNshellUnitType, XmPIXELS,
- NULL );
-
- kuipIo = XtVaCreateManagedWidget( "kuipIo",
- xmMainWindowWidgetClass,
- _UxParent,
- XmNunitType, XmPIXELS,
- XmNwidth, 700,
- XmNheight, 495,
- XmNshowSeparator, FALSE,
- NULL );
- UxPutContext( kuipIo, (char *) UxKuipIoContext );
-
-
- /* Creation of frame1 */
- frame1 = XtVaCreateManagedWidget( "frame1",
- xmFrameWidgetClass,
- kuipIo,
- NULL );
- UxPutContext( frame1, (char *) UxKuipIoContext );
-
-
- /* Creation of form1 */
- form1 = XtVaCreateManagedWidget( "form1",
- xmFormWidgetClass,
- frame1,
- NULL );
- UxPutContext( form1, (char *) UxKuipIoContext );
-
-
- /* Creation of panedWindow */
- panedWindow = XtVaCreateManagedWidget( "panedWindow",
- xmPanedWindowWidgetClass,
- form1,
- XmNbottomAttachment, XmATTACH_FORM,
- XmNleftAttachment, XmATTACH_FORM,
- XmNleftOffset, 0,
- XmNrightAttachment, XmATTACH_FORM,
- XmNrightOffset, 0,
- XmNtopAttachment, XmATTACH_FORM,
- NULL );
- UxPutContext( panedWindow, (char *) UxKuipIoContext );
-
-
- /* Creation of outputForm */
- outputForm = XtVaCreateManagedWidget( "outputForm",
- xmFormWidgetClass,
- panedWindow,
- XmNresizePolicy, XmRESIZE_NONE,
- NULL );
- UxPutContext( outputForm, (char *) UxKuipIoContext );
-
-
- /* Creation of form3 */
- form3 = XtVaCreateManagedWidget( "form3",
- xmFormWidgetClass,
- outputForm,
- XmNresizePolicy, XmRESIZE_NONE,
- XmNleftAttachment, XmATTACH_FORM,
- XmNrightAttachment, XmATTACH_FORM,
- XmNtopAttachment, XmATTACH_FORM,
- NULL );
- UxPutContext( form3, (char *) UxKuipIoContext );
-
-
- /* Creation of label2 */
- label2 = XtVaCreateManagedWidget( "label2",
- xmLabelWidgetClass,
- form3,
- XmNheight, 20,
- RES_CONVERT( XmNlabelString, "Transcript Pad" ),
- XmNbottomAttachment, XmATTACH_FORM,
- XmNleftAttachment, XmATTACH_FORM,
- XmNtopAttachment, XmATTACH_FORM,
- NULL );
- UxPutContext( label2, (char *) UxKuipIoContext );
-
-
- /* Creation of outputHoldButton */
- outputHoldButton = XtVaCreateManagedWidget( "outputHoldButton",
- xmPushButtonWidgetClass,
- form3,
- XmNheight, 25,
- RES_CONVERT( XmNlabelString, "H" ),
- XmNwidth, 25,
- XmNbottomAttachment, XmATTACH_FORM,
- XmNrightAttachment, XmATTACH_FORM,
- XmNrightOffset, 20,
- XmNtopAttachment, XmATTACH_FORM,
- NULL );
- UxPutContext( outputHoldButton, (char *) UxKuipIoContext );
-
-
- /* Creation of lcdLabel */
- lcdLabel = XtVaCreateManagedWidget( "lcdLabel",
- xmLabelWidgetClass,
- form3,
- XmNheight, 20,
- XmNalignment, XmALIGNMENT_END,
- XmNbottomAttachment, XmATTACH_FORM,
- RES_CONVERT( XmNlabelString, "" ),
- XmNleftAttachment, XmATTACH_WIDGET,
- XmNleftOffset, 5,
- XmNleftWidget, label2,
- XmNrightAttachment, XmATTACH_WIDGET,
- XmNrightOffset, 10,
- XmNrightWidget, outputHoldButton,
- XmNtopAttachment, XmATTACH_FORM,
- NULL );
- UxPutContext( lcdLabel, (char *) UxKuipIoContext );
-
-
- /* Creation of scrolledWindow2 */
- scrolledWindow2 = XtVaCreateManagedWidget( "scrolledWindow2",
- xmScrolledWindowWidgetClass,
- outputForm,
- XmNscrollingPolicy, XmAPPLICATION_DEFINED,
- XmNvisualPolicy, XmVARIABLE,
- XmNscrollBarDisplayPolicy, XmSTATIC,
- XmNshadowThickness, 0,
- XmNbottomAttachment, XmATTACH_FORM,
- XmNleftAttachment, XmATTACH_FORM,
- XmNrightAttachment, XmATTACH_FORM,
- XmNtopAttachment, XmATTACH_WIDGET,
- XmNtopWidget, form3,
- NULL );
- UxPutContext( scrolledWindow2, (char *) UxKuipIoContext );
-
-
- /* Creation of outputText */
- outputText = XtVaCreateManagedWidget( "outputText",
- xmTextWidgetClass,
- scrolledWindow2,
- XmNeditable, FALSE,
- XmNeditMode, XmMULTI_LINE_EDIT ,
- XmNblinkRate, 0,
- NULL );
- UxPutContext( outputText, (char *) UxKuipIoContext );
-
-
- /* Creation of inputForm */
- inputForm = XtVaCreateManagedWidget( "inputForm",
- xmFormWidgetClass,
- panedWindow,
- XmNresizePolicy, XmRESIZE_NONE,
- NULL );
- UxPutContext( inputForm, (char *) UxKuipIoContext );
-
-
- /* Creation of form2 */
- form2 = XtVaCreateManagedWidget( "form2",
- xmFormWidgetClass,
- inputForm,
- XmNresizePolicy, XmRESIZE_NONE,
- XmNleftAttachment, XmATTACH_FORM,
- XmNrightAttachment, XmATTACH_FORM,
- XmNtopAttachment, XmATTACH_FORM,
- NULL );
- UxPutContext( form2, (char *) UxKuipIoContext );
-
-
- /* Creation of label1 */
- label1 = XtVaCreateManagedWidget( "label1",
- xmLabelWidgetClass,
- form2,
- XmNheight, 20,
- RES_CONVERT( XmNlabelString, "Input Pad" ),
- XmNbottomAttachment, XmATTACH_FORM,
- XmNleftAttachment, XmATTACH_FORM,
- XmNtopAttachment, XmATTACH_FORM,
- NULL );
- UxPutContext( label1, (char *) UxKuipIoContext );
-
-
- /* Creation of inputHoldButton */
- inputHoldButton = XtVaCreateManagedWidget( "inputHoldButton",
- xmPushButtonWidgetClass,
- form2,
- RES_CONVERT( XmNlabelString, "H" ),
- XmNbottomAttachment, XmATTACH_FORM,
- XmNrightAttachment, XmATTACH_FORM,
- XmNrightOffset, 20,
- XmNtopAttachment, XmATTACH_FORM,
- XmNheight, 25,
- XmNwidth, 25,
- NULL );
- UxPutContext( inputHoldButton, (char *) UxKuipIoContext );
-
-
- /* Creation of cwdLabel */
- cwdLabel = XtVaCreateManagedWidget( "cwdLabel",
- xmLabelWidgetClass,
- form2,
- XmNheight, 20,
- XmNbottomAttachment, XmATTACH_FORM,
- XmNleftAttachment, XmATTACH_WIDGET,
- XmNleftOffset, 30,
- XmNleftWidget, label1,
- XmNrightAttachment, XmATTACH_WIDGET,
- XmNrightOffset, 10,
- XmNrightWidget, inputHoldButton,
- XmNtopAttachment, XmATTACH_FORM,
- XmNalignment, XmALIGNMENT_END,
- RES_CONVERT( XmNlabelString, "" ),
- NULL );
- UxPutContext( cwdLabel, (char *) UxKuipIoContext );
-
-
- /* Creation of scrolledWindow1 */
- scrolledWindow1 = XtVaCreateManagedWidget( "scrolledWindow1",
- xmScrolledWindowWidgetClass,
- inputForm,
- XmNscrollingPolicy, XmAPPLICATION_DEFINED,
- XmNvisualPolicy, XmVARIABLE,
- XmNscrollBarDisplayPolicy, XmSTATIC,
- XmNshadowThickness, 0,
- XmNbottomAttachment, XmATTACH_FORM,
- XmNleftAttachment, XmATTACH_FORM,
- XmNrightAttachment, XmATTACH_FORM,
- XmNtopAttachment, XmATTACH_WIDGET,
- XmNtopWidget, form2,
- NULL );
- UxPutContext( scrolledWindow1, (char *) UxKuipIoContext );
-
-
- /* Creation of inputText */
- inputText = XtVaCreateManagedWidget( "inputText",
- xmTextWidgetClass,
- scrolledWindow1,
- XmNeditMode, XmMULTI_LINE_EDIT ,
- XmNverifyBell, FALSE,
- XmNblinkRate, 0,
- NULL );
- UxPutContext( inputText, (char *) UxKuipIoContext );
-
-
- /* Creation of menuBar */
- menuBar = XtVaCreateManagedWidget( "menuBar",
- xmRowColumnWidgetClass,
- kuipIo,
- XmNrowColumnType, XmMENU_BAR,
- XmNmenuAccelerator, "<KeyUp>F10",
- NULL );
- UxPutContext( menuBar, (char *) UxKuipIoContext );
-
-
- /* Creation of FileMenu */
- FileMenu_shell = XtVaCreatePopupShell ("FileMenu_shell",
- xmMenuShellWidgetClass, menuBar,
- XmNwidth, 1,
- XmNheight, 1,
- XmNallowShellResize, TRUE,
- XmNoverrideRedirect, TRUE,
- NULL );
-
- FileMenu = XtVaCreateWidget( "FileMenu",
- xmRowColumnWidgetClass,
- FileMenu_shell,
- XmNrowColumnType, XmMENU_PULLDOWN,
- NULL );
- UxPutContext( FileMenu, (char *) UxKuipIoContext );
-
-
- /* Creation of aboutButton */
- aboutButton = XtVaCreateManagedWidget( "aboutButton",
- xmPushButtonWidgetClass,
- FileMenu,
- RES_CONVERT( XmNlabelString, "About Kxterm..." ),
- NULL );
- UxPutContext( aboutButton, (char *) UxKuipIoContext );
-
-
- /* Creation of aboutAppButton */
- aboutAppButton = XtVaCreateManagedWidget( "aboutAppButton",
- xmPushButtonWidgetClass,
- FileMenu,
- RES_CONVERT( XmNlabelString, "About Application..." ),
- NULL );
- UxPutContext( aboutAppButton, (char *) UxKuipIoContext );
-
-
- /* Creation of FileMenu_b11 */
- FileMenu_b11 = XtVaCreateManagedWidget( "FileMenu_b11",
- xmSeparatorWidgetClass,
- FileMenu,
- NULL );
- UxPutContext( FileMenu_b11, (char *) UxKuipIoContext );
-
-
- /* Creation of saveTransButton */
- saveTransButton = XtVaCreateManagedWidget( "saveTransButton",
- xmPushButtonWidgetClass,
- FileMenu,
- RES_CONVERT( XmNlabelString, "Save Transcript" ),
- RES_CONVERT( XmNmnemonic, "S" ),
- NULL );
- UxPutContext( saveTransButton, (char *) UxKuipIoContext );
-
-
- /* Creation of saveTransAsButton */
- saveTransAsButton = XtVaCreateManagedWidget( "saveTransAsButton",
- xmPushButtonWidgetClass,
- FileMenu,
- RES_CONVERT( XmNlabelString, "Save Transcript As..." ),
- RES_CONVERT( XmNmnemonic, "A" ),
- NULL );
- UxPutContext( saveTransAsButton, (char *) UxKuipIoContext );
-
-
- /* Creation of menu1_p1_b9 */
- menu1_p1_b9 = XtVaCreateManagedWidget( "menu1_p1_b9",
- xmSeparatorWidgetClass,
- FileMenu,
- NULL );
- UxPutContext( menu1_p1_b9, (char *) UxKuipIoContext );
-
-
- /* Creation of printButton */
- printButton = XtVaCreateManagedWidget( "printButton",
- xmPushButtonWidgetClass,
- FileMenu,
- RES_CONVERT( XmNlabelString, "Print..." ),
- RES_CONVERT( XmNmnemonic, "P" ),
- NULL );
- UxPutContext( printButton, (char *) UxKuipIoContext );
-
-
- /* Creation of menu1_p1_b8 */
- menu1_p1_b8 = XtVaCreateManagedWidget( "menu1_p1_b8",
- xmSeparatorWidgetClass,
- FileMenu,
- NULL );
- UxPutContext( menu1_p1_b8, (char *) UxKuipIoContext );
-
-
- /* Creation of killButton */
- killButton = XtVaCreateManagedWidget( "killButton",
- xmPushButtonWidgetClass,
- FileMenu,
- RES_CONVERT( XmNlabelString, "Kill" ),
- RES_CONVERT( XmNmnemonic, "K" ),
- NULL );
- UxPutContext( killButton, (char *) UxKuipIoContext );
-
-
- /* Creation of FileMenu_b8 */
- FileMenu_b8 = XtVaCreateManagedWidget( "FileMenu_b8",
- xmSeparatorWidgetClass,
- FileMenu,
- NULL );
- UxPutContext( FileMenu_b8, (char *) UxKuipIoContext );
-
-
- /* Creation of exitButton */
- exitButton = XtVaCreateManagedWidget( "exitButton",
- xmPushButtonWidgetClass,
- FileMenu,
- RES_CONVERT( XmNlabelString, "Exit" ),
- RES_CONVERT( XmNmnemonic, "E" ),
- NULL );
- UxPutContext( exitButton, (char *) UxKuipIoContext );
-
-
- /* Creation of menu1_top_b1 */
- menu1_top_b1 = XtVaCreateManagedWidget( "menu1_top_b1",
- xmCascadeButtonWidgetClass,
- menuBar,
- RES_CONVERT( XmNlabelString, "File" ),
- RES_CONVERT( XmNmnemonic, "F" ),
- XmNsubMenuId, FileMenu,
- NULL );
- UxPutContext( menu1_top_b1, (char *) UxKuipIoContext );
-
-
- /* Creation of EditMenu */
- EditMenu_shell = XtVaCreatePopupShell ("EditMenu_shell",
- xmMenuShellWidgetClass, menuBar,
- XmNwidth, 1,
- XmNheight, 1,
- XmNallowShellResize, TRUE,
- XmNoverrideRedirect, TRUE,
- NULL );
-
- EditMenu = XtVaCreateWidget( "EditMenu",
- xmRowColumnWidgetClass,
- EditMenu_shell,
- XmNrowColumnType, XmMENU_PULLDOWN,
- NULL );
- UxPutContext( EditMenu, (char *) UxKuipIoContext );
-
-
- /* Creation of cutButton */
- cutButton = XtVaCreateManagedWidget( "cutButton",
- xmPushButtonWidgetClass,
- EditMenu,
- RES_CONVERT( XmNlabelString, "Cut" ),
- RES_CONVERT( XmNmnemonic, "t" ),
- XmNaccelerator, "Shift<Key>Delete",
- RES_CONVERT( XmNacceleratorText, "Shift+Del" ),
- NULL );
- UxPutContext( cutButton, (char *) UxKuipIoContext );
-
-
- /* Creation of copyButton */
- copyButton = XtVaCreateManagedWidget( "copyButton",
- xmPushButtonWidgetClass,
- EditMenu,
- RES_CONVERT( XmNlabelString, "Copy" ),
- RES_CONVERT( XmNmnemonic, "C" ),
- XmNaccelerator, "Ctrl<Key>InsertChar",
- RES_CONVERT( XmNacceleratorText, "Ctrl+Ins" ),
- NULL );
- UxPutContext( copyButton, (char *) UxKuipIoContext );
-
-
- /* Creation of pasteButton */
- pasteButton = XtVaCreateManagedWidget( "pasteButton",
- xmPushButtonWidgetClass,
- EditMenu,
- RES_CONVERT( XmNlabelString, "Paste" ),
- RES_CONVERT( XmNmnemonic, "P" ),
- XmNaccelerator, "Shift<Key>InsertChar",
- RES_CONVERT( XmNacceleratorText, "Shift+Ins" ),
- NULL );
- UxPutContext( pasteButton, (char *) UxKuipIoContext );
-
-
- /* Creation of menu1_p2_b5 */
- menu1_p2_b5 = XtVaCreateManagedWidget( "menu1_p2_b5",
- xmSeparatorWidgetClass,
- EditMenu,
- NULL );
- UxPutContext( menu1_p2_b5, (char *) UxKuipIoContext );
-
-
- /* Creation of searchButton */
- searchButton = XtVaCreateManagedWidget( "searchButton",
- xmPushButtonWidgetClass,
- EditMenu,
- RES_CONVERT( XmNlabelString, "Search..." ),
- RES_CONVERT( XmNmnemonic, "S" ),
- XmNaccelerator, "Ctrl<Key>s",
- RES_CONVERT( XmNacceleratorText, "Ctrl+s" ),
- NULL );
- UxPutContext( searchButton, (char *) UxKuipIoContext );
-
-
- /* Creation of menu1_top_b2 */
- menu1_top_b2 = XtVaCreateManagedWidget( "menu1_top_b2",
- xmCascadeButtonWidgetClass,
- menuBar,
- RES_CONVERT( XmNlabelString, "Edit" ),
- XmNsubMenuId, EditMenu,
- RES_CONVERT( XmNmnemonic, "E" ),
- NULL );
- UxPutContext( menu1_top_b2, (char *) UxKuipIoContext );
-
-
- /* Creation of ViewMenu */
- ViewMenu_shell = XtVaCreatePopupShell ("ViewMenu_shell",
- xmMenuShellWidgetClass, menuBar,
- XmNwidth, 1,
- XmNheight, 1,
- XmNallowShellResize, TRUE,
- XmNoverrideRedirect, TRUE,
- NULL );
-
- ViewMenu = XtVaCreateWidget( "ViewMenu",
- xmRowColumnWidgetClass,
- ViewMenu_shell,
- XmNrowColumnType, XmMENU_PULLDOWN,
- NULL );
- UxPutContext( ViewMenu, (char *) UxKuipIoContext );
-
-
- /* Creation of showInputButton */
- showInputButton = XtVaCreateManagedWidget( "showInputButton",
- xmPushButtonWidgetClass,
- ViewMenu,
- RES_CONVERT( XmNlabelString, "Show Input" ),
- RES_CONVERT( XmNmnemonic, "S" ),
- NULL );
- UxPutContext( showInputButton, (char *) UxKuipIoContext );
-
-
- /* Creation of menu1_top_b3 */
- menu1_top_b3 = XtVaCreateManagedWidget( "menu1_top_b3",
- xmCascadeButtonWidgetClass,
- menuBar,
- RES_CONVERT( XmNlabelString, "View" ),
- XmNsubMenuId, ViewMenu,
- RES_CONVERT( XmNmnemonic, "V" ),
- NULL );
- UxPutContext( menu1_top_b3, (char *) UxKuipIoContext );
-
-
- /* Creation of OptionMenu */
- OptionMenu_shell = XtVaCreatePopupShell ("OptionMenu_shell",
- xmMenuShellWidgetClass, menuBar,
- XmNwidth, 1,
- XmNheight, 1,
- XmNallowShellResize, TRUE,
- XmNoverrideRedirect, TRUE,
- NULL );
-
- OptionMenu = XtVaCreateWidget( "OptionMenu",
- xmRowColumnWidgetClass,
- OptionMenu_shell,
- XmNrowColumnType, XmMENU_PULLDOWN,
- NULL );
- UxPutContext( OptionMenu, (char *) UxKuipIoContext );
-
-
- /* Creation of clearTrButton */
- clearTrButton = XtVaCreateManagedWidget( "clearTrButton",
- xmPushButtonWidgetClass,
- OptionMenu,
- RES_CONVERT( XmNlabelString, "Clear Transcript Pad" ),
- RES_CONVERT( XmNmnemonic, "C" ),
- NULL );
- UxPutContext( clearTrButton, (char *) UxKuipIoContext );
-
-
- /* Creation of menu1_top_b4 */
- menu1_top_b4 = XtVaCreateManagedWidget( "menu1_top_b4",
- xmCascadeButtonWidgetClass,
- menuBar,
- RES_CONVERT( XmNlabelString, "Options" ),
- RES_CONVERT( XmNmnemonic, "O" ),
- XmNsubMenuId, OptionMenu,
- NULL );
- UxPutContext( menu1_top_b4, (char *) UxKuipIoContext );
-
-
- /* Creation of HelpMenu */
- HelpMenu_shell = XtVaCreatePopupShell ("HelpMenu_shell",
- xmMenuShellWidgetClass, menuBar,
- XmNwidth, 1,
- XmNheight, 1,
- XmNallowShellResize, TRUE,
- XmNoverrideRedirect, TRUE,
- NULL );
-
- HelpMenu = XtVaCreateWidget( "HelpMenu",
- xmRowColumnWidgetClass,
- HelpMenu_shell,
- XmNrowColumnType, XmMENU_PULLDOWN,
- NULL );
- UxPutContext( HelpMenu, (char *) UxKuipIoContext );
-
-
- /* Creation of helpKxtermButton */
- helpKxtermButton = XtVaCreateManagedWidget( "helpKxtermButton",
- xmPushButtonWidgetClass,
- HelpMenu,
- RES_CONVERT( XmNlabelString, "On Kxterm" ),
- NULL );
- UxPutContext( helpKxtermButton, (char *) UxKuipIoContext );
-
-
- /* Creation of helpResourceButton */
- helpResourceButton = XtVaCreateManagedWidget( "helpResourceButton",
- xmPushButtonWidgetClass,
- HelpMenu,
- RES_CONVERT( XmNlabelString, "On Resources" ),
- NULL );
- UxPutContext( helpResourceButton, (char *) UxKuipIoContext );
-
-
- /* Creation of helpEditButton */
- helpEditButton = XtVaCreateManagedWidget( "helpEditButton",
- xmPushButtonWidgetClass,
- HelpMenu,
- RES_CONVERT( XmNlabelString, "On Edit Keys" ),
- NULL );
- UxPutContext( helpEditButton, (char *) UxKuipIoContext );
-
-
- /* Creation of menu1_top_b5 */
- menu1_top_b5 = XtVaCreateManagedWidget( "menu1_top_b5",
- xmCascadeButtonWidgetClass,
- menuBar,
- RES_CONVERT( XmNlabelString, "Help" ),
- RES_CONVERT( XmNmnemonic, "H" ),
- XmNsubMenuId, HelpMenu,
- NULL );
- UxPutContext( menu1_top_b5, (char *) UxKuipIoContext );
-
- XtVaSetValues(menuBar,
- XmNmenuHelpWidget, menu1_top_b5,
- NULL );
-
-
- XtAddCallback( kuipIo, XmNdestroyCallback,
- (XtCallbackProc) UxDestroyContextCB,
- (XtPointer) UxKuipIoContext);
-
- XmMainWindowSetAreas( kuipIo, menuBar, (Widget) NULL,
- (Widget) NULL, (Widget) NULL, frame1 );
-
- return ( kuipIo );
-}
-
-/*******************************************************************************
- The following is the 'Interface function' which is the
- external entry point for creating this interface.
- This function should be called from your application or from
- a callback function.
-*******************************************************************************/
-
-Widget create_kuipIo()
-{
- Widget rtrn;
- _UxCkuipIo *UxContext;
-
- UxKuipIoContext = UxContext =
- (_UxCkuipIo *) UxNewContext( sizeof(_UxCkuipIo), False );
-
-
- rtrn = _Uxbuild_kuipIo();
-
- return(rtrn);
-}
-
-/*******************************************************************************
- END OF FILE
-*******************************************************************************/
-
diff --git a/src/packlib/kuip/programs/kxterm/kxpan.c b/src/packlib/kuip/programs/kxterm/kxpan.c
deleted file mode 100644
index 70e6c8f..0000000
--- a/src/packlib/kuip/programs/kxterm/kxpan.c
+++ /dev/null
@@ -1,568 +0,0 @@
-/*
- * $Id: kxpan.c,v 1.1.1.1 1996/03/08 15:33:04 mclareni Exp $
- *
- * $Log: kxpan.c,v $
- * Revision 1.1.1.1 1996/03/08 15:33:04 mclareni
- * Kuip
- *
- */
-/*CMZ : 2.07/03 09/05/95 11.54.44 by N.Cremel*/
-/*-- Author : N.Cremel 10/08/92*/
-/******************************************************************************/
-/* */
-/* Basic Interface for "KXTERM Panels". */
-/* (connected to the file "panels" for building */
-/* panels with Architect : "create_kuipPanel"). */
-/* */
-/******************************************************************************/
-
-#include "kuip/kuip.h"
-
-#include <Xm/Xm.h>
-#include <X11/IntrinsicP.h>
-#if defined(__hpux) && XtSpecificationRelease == 4
-#include <X11/Protocols.h>
-#else
-#include <Xm/Protocols.h>
-#endif
-
-#include "utils.h"
-#include "uxxt.h"
-#define CONTEXT_MACRO_ACCESS 1
-/* #include "kuipPanel.h" */
-#include "uxpan.h"
-#undef CONTEXT_MACRO_ACCESS
-
-/***********************************************************************
- * *
- * Forward declarations of extern functions. *
- * *
- ***********************************************************************/
-
-extern Widget create_kuipPanel();
-
-extern void warn_user( /* from dialog.c */
-#ifndef _NO_PROTO
- Widget parent, char *warning
-#endif
- );
-extern void inform_user(
-#ifndef _NO_PROTO
- Widget parent, char *warning
-#endif
- );
-extern Boolean ask_user(
-#ifndef _NO_PROTO
- Widget parent, char *question, char *ans1, char *ans2,
- int default_ans
-#endif
- );
-extern char *prompt_user(
-#ifndef _NO_PROTO
- Widget parent,
- char *prompt, char *default_line, char *help_item
-#endif
- );
-extern void send_cmd(
-#ifndef _NO_PROTO
- char *
-#endif
- );
-
-/***********************************************************************
- * *
- * Forward declarations of local functions. *
- * *
- ***********************************************************************/
-static void panelfocusCallback(
-#ifndef _NO_PROTO
- Widget, caddr_t, XmAnyCallbackStruct *
-#endif
- );
-static void panel_execute(
-#ifndef _NO_PROTO
- Widget, caddr_t, XmAnyCallbackStruct *
-#endif
- );
-static void panel_save(
-#ifndef _NO_PROTO
- Widget , char *
-#endif
- );
-static void okPNBCallback(
-#ifndef _NO_PROTO
- Widget, Widget, XmAnyCallbackStruct *
-#endif
- );
-static void savePNBCallback(
-#ifndef _NO_PROTO
- Widget, Widget, XmAnyCallbackStruct *
-#endif
- );
-void helpPNBCallback(
-#ifndef _NO_PROTO
- Widget, char *, XmAnyCallbackStruct *
-#endif
- );
-
-static char *Mstrcat(
-#ifndef _NO_PROTO
- char *, const char *
-#endif
- );
-
-/***********************************************************************
- * *
- * Local datas. *
- * *
- ***********************************************************************/
-static int WM_x = 0; /* width of Window Manager decoration */
-static int WM_y = 0; /* height of Window Manager decoration */
-static char panel_geometry[512];
-
-static struct kxpanel {
- int panel_rows; /* number of rows */
- int *panel_cols; /* number of columns in each row */
- char ***panel_keys; /* key labels */
-} kx_panel = { 0, NULL, NULL };
-
-#define MAXCMD 512 /* max length of a command line */
-#define MAX_button 600 /* max. number of buttons in a panel */
- /* cf. KUIP : 30 lin. X 20 col. */
-#define MAX_string 80 /* max. length for string */
-#define MAX_stringl 240 /* max. length for long string */
-
-
-/******************************************************************************/
-/* void set_kxtpanel_rows (nrow, ncol, last) */
-/******************************************************************************/
-void set_kxtpanel_rows (nrow, ncol, last)
- int nrow, ncol, last;
-{
- int i, j;
-
- if (last == -1) {
-
- /* Reset old panel datas */
- for( i = 0; i < kx_panel.panel_rows; i++ ) {
- for( j = 0; j < kx_panel.panel_cols[i]; j++ ) {
- if (kx_panel.panel_keys[i][j] != NULL )
- free( kx_panel.panel_keys[i][j] );
- }
- if (kx_panel.panel_keys[i] != NULL ) {
- free( (char*)kx_panel.panel_keys[i] );
- kx_panel.panel_keys[i] = NULL;
- }
- kx_panel.panel_cols[i] = 0;
- }
-
- if( kx_panel.panel_rows != 0 ) {
- free( (char*)kx_panel.panel_cols );
- kx_panel.panel_cols = NULL;
- free( (char*)kx_panel.panel_keys );
- kx_panel.panel_keys = NULL;
- }
-
- /* new space allocation */
- kx_panel.panel_rows = nrow;
- kx_panel.panel_cols = (int*)malloc( nrow * sizeof(int) );
- kx_panel.panel_keys = (char***)malloc( nrow * sizeof(char**) );
- return;
- }
-
- kx_panel.panel_cols[nrow] = ncol;
- kx_panel.panel_keys[nrow] = (char**)malloc( ncol * sizeof(char**) );
- for( i = 0; i < ncol; i++ ) {
- kx_panel.panel_keys[nrow][i] = NULL;
- }
-
-}
-
-/******************************************************************************/
-/* void set_kxtpanel_keys (row, col, key) */
-/******************************************************************************/
-void set_kxtpanel_keys (row, col, key)
- int row, col;
- char *key;
-{
- if( kx_panel.panel_keys[row][col] != NULL )
- free( kx_panel.panel_keys[row][col] );
- if (key != NULL)
- kx_panel.panel_keys[row][col] = strdup( key );
- else
- kx_panel.panel_keys[row][col] = strdup( "" );
-}
-
-/******************************************************************************/
-/* void display_kxtpanel */
-/******************************************************************************/
-void display_kxtpanel (title, geometry)
- char *title, *geometry;
-{
- Widget panel_widget;
- Widget npbutton[MAX_button];
- char wname[MAX_stringl];
- int i, j, ncol, nbutton;
- short nrow;
-
- panel_widget = (Widget) create_kuipPanel();
-
- /*
- * find and restore the context
- * (to get to the widgets belonging to this dialog)
- */
- UxKuipPanelContext = (_UxCkuipPanel *)UxGetContext( panel_widget );
-
- strcpy (panel_geometry, geometry);
-
- /* Set title and geometry */
- if (geometry != NULL)
- XtVaSetValues(XtParent(panel_widget), XmNtitle, title,
- XmNiconName, title,
- XmNdefaultPosition, False,
- XmNgeometry, geometry,
- NULL);
- else
- XtVaSetValues(XtParent(panel_widget), XmNtitle, title,
- XmNiconName, title,
- NULL);
-
- /* Create RowColumn with push buttons child of Scrolled Window */
- nrow = kx_panel.panel_rows;
- XtVaSetValues(km_rowcolPNW, XmNnumColumns, nrow, NULL);
-
-
- /* Get maximum number of colums */
- ncol = 0;
- for (i = 0; i < nrow; i++) {
- if (kx_panel.panel_cols[i] > ncol) ncol = kx_panel.panel_cols[i]; }
-
- /* Create buttons */
- nbutton = 0;
- for (i = 0; i < nrow; i++) {
- int nc = kx_panel.panel_cols[i];
-
- if (nbutton >= MAX_button - 1) break;
- for (j = 0; j < nc; j++) {
- sprintf (wname, "NP%sB%d", title,j);
- if (kx_panel.panel_keys[i][j] != NULL)
- npbutton[nbutton] = XtVaCreateWidget (wname,
- xmPushButtonWidgetClass, km_rowcolPNW,
- RES_CONVERT( XmNlabelString, kx_panel.panel_keys[i][j]),
- NULL);
- else
- npbutton[nbutton] = XtVaCreateWidget (wname,
- xmPushButtonWidgetClass, km_rowcolPNW,
- RES_CONVERT( XmNlabelString, ""),
- NULL);
- XtOverrideTranslations (npbutton[nbutton],
- XtParseTranslationTable("<Btn3Down>:Arm()"));
- XtOverrideTranslations (npbutton[nbutton],
- XtParseTranslationTable("<Btn3Up>:Activate()"));
- XtAddCallback (npbutton[nbutton],XmNactivateCallback,
- (XtCallbackProc)panel_execute,NULL);
- nbutton ++;
- }
- for (j = nc; j < ncol; j++) {
- sprintf (wname, "NP%sB%d", title,j);
- npbutton[nbutton] = XtVaCreateWidget (wname,
- xmPushButtonWidgetClass, km_rowcolPNW,
- RES_CONVERT( XmNlabelString, ""),
- NULL);
- XtOverrideTranslations (npbutton[nbutton],
- XtParseTranslationTable("<Btn3Down>:Arm()"));
- XtOverrideTranslations (npbutton[nbutton],
- XtParseTranslationTable("<Btn3Up>:Activate()"));
- XtAddCallback (npbutton[nbutton],XmNactivateCallback,
- (XtCallbackProc)panel_execute,NULL);
- nbutton ++;
- }
- }
- XtManageChildren (npbutton, nbutton);
-
- XtAddCallback (km_okPNB,XmNactivateCallback,
- (XtCallbackProc)okPNBCallback, panel_widget);
- XtAddCallback (km_savePNB,XmNactivateCallback,
- (XtCallbackProc)savePNBCallback, panel_widget);
- XtAddCallback (km_helpPNB,XmNactivateCallback,
- (XtCallbackProc)helpPNBCallback,
- (XtPointer)"HELP_EDIT_PANEL");
- XtAddCallback (panel_widget,XmNfocusCallback,
- (XtCallbackProc)panelfocusCallback, NULL);
-
-
- UxPopupInterface(panel_widget, XtGrabNone);
-
- return;
-}
-
-static void panelfocusCallback( widget, tag, callback_data )
- Widget widget;
- caddr_t tag;
- XmAnyCallbackStruct *callback_data;
-{
- Position xpos, ypos;
- int ih, iw, ix, iy;
-
- static int ifirst = 0;
-
- if (ifirst == 0) {
- /* First time only we get WM decoration size */
- ifirst = 1;
- XtVaGetValues(XtParent(widget), XmNx, &xpos, XmNy, &ypos, NULL);
- sscanf (panel_geometry, "%dx%d+%d+%d", &iw, &ih, &ix, &iy);
- WM_x = xpos - ix;
- WM_y = ypos - iy;
- }
-}
-
-
-static void panel_execute( pbut_widget, tag, callback_data )
- Widget pbut_widget;
- caddr_t tag;
- XmAnyCallbackStruct *callback_data;
-{
- XmString xmstr_label;
- char *g_string;
- char cmd_start[MAXCMD];
- int i,ilen;
- int dollar_pos = -1;
-
-
- /*
- * Special case / selection with button 3 : erase label (new button)
- */
- if (callback_data->event->xbutton.button == 3) {
- XtVaSetValues (pbut_widget,
- RES_CONVERT( XmNlabelString, "" ),
- NULL);
- return;
- }
-
- XtVaGetValues (pbut_widget,
- XmNlabelString, &xmstr_label,
- NULL);
- XmStringGetLtoR (xmstr_label, XmSTRING_DEFAULT_CHARSET, &g_string);
- ilen = strlen(g_string);
- if (g_string != NULL) {
- char *blank_string = " ";
-
- /*
- * Special case / button selected is blank : ask for label
- */
- if ( ilen == 0 || strncmp(g_string,blank_string,ilen) == 0 ) {
- /* ask for new button label */
- char *blab;
- blab = prompt_user (UxTopLevel, "Give text to map in this button",
- "", "HELP_EDIT_PANEL");
- if (blab != NULL) XtVaSetValues (pbut_widget,
- RES_CONVERT( XmNlabelString, blab ), NULL);
- free (blab);
- return;
- }
- }
-
- /* Execute command ... */
- for (i=0; i<ilen; i++) {
- if (g_string[i] == '$') dollar_pos = i; }
- if (dollar_pos >= 0) {
- /* character "$" inside a key */
- char *command;
- char cmd_string[MAX_stringl];
- int lc;
-
- command = prompt_user (UxTopLevel,
- "Enter value which should replace $", "",
- "HELP_DOLLAR_PANEL");
- if (command == NULL) return;
- lc = strlen(command);
- for (i=0; i<dollar_pos; i++) {
- cmd_string[i] = g_string[i]; }
- for (i=dollar_pos; i<dollar_pos+lc; i++) {
- cmd_string[i] = command[i-dollar_pos]; }
- for (i=dollar_pos+lc; i<ilen-1+lc; i++) {
- /* skip "$" */
- cmd_string[i] = g_string[i+1-lc]; }
- cmd_string[i] = '\0';
- send_cmd (cmd_string);
- free (command);
- } else if (g_string[ilen-1] == '-') {
- /* key ending with minus */
- char *command;
- char cmd_string[MAX_stringl];
-
- if (g_string[ilen-2] == '-') {
- /* key ending with double minus */
- strcpy (cmd_start,g_string);
- cmd_start[ilen-2] = '\0';
- command = prompt_user (UxTopLevel, "Give Missing Value", "",
- "HELP_MINUS2_PANEL");
- if (command == NULL) return;
- strcat (cmd_start, command);
- send_cmd (cmd_start);
- } else {
- /* key ending with single minus */
- strcpy (cmd_start,g_string);
- cmd_start[ilen-1] = '\0';
- command = prompt_user (UxTopLevel, "Give Missing Value", "",
- "HELP_MINUS_PANEL");
- if (command == NULL) return;
- sprintf (cmd_string,"%s %s", cmd_start, command);
- send_cmd (cmd_string);
- } /* end ... if (g_string[ilen-2] == '-') */
- } else {
- /* Normal case : execute command directly */
- send_cmd (g_string);
- } /* end if (dollar_pos >= 0) */
-
- return;
-}
-
-static void panel_save (pwidget, name)
- Widget pwidget;
- char *name;
-{
- WidgetList bchild;
- FILE *ppf;
- char *fstr;
- String title;
- char display_string[MAX_stringl];
- Cardinal nbut;
- short nrow, ncol;
- Position xpos, ypos;
- Dimension dh, dw;
- int i, k, nbutton;
-
- /*
- * find and restore the context
- * (to get to the widgets belonging to this dialog)
- */
- UxKuipPanelContext = (_UxCkuipPanel *)UxGetContext( pwidget );
-
-
- /* Get values for panel geometry */
- XtVaGetValues (XtParent(pwidget), XmNtitle, &title,
- XmNx, &xpos, XmNy, &ypos,
- XmNheight, &dh, XmNwidth, &dw,
- NULL);
- /* We have to extract WM decoration from xpos and ypos */
- xpos = xpos - WM_x;
- ypos = ypos - WM_y;
- sprintf (display_string,"\npanel 0 T \'%s\' %dx%d+%d+%d\n",
- title, dw, dh, xpos, ypos);
-
- /* Get number and list of the rowcolumn push buttons children */
- XtVaGetValues (km_rowcolPNW, XmNnumChildren, &nbut,
- XmNchildren, &bchild,
- XmNnumColumns, &nrow, NULL);
-
- fstr = strdup ("*\n* MOTIF_PANEL ");
- fstr = Mstrcat (fstr, name);
- fstr = Mstrcat (fstr, "\n*\npanel 0");
- ncol = (short) (nbut / nrow);
- nbutton = 0;
- for (k = 0; k < nrow; k++) {
- for (i = 0; i < ncol; i++) {
- char cval[MAX_string];
- XmString xmstr_label;
- char *label;
- int ilen;
-
- if (ncol < 10)
- sprintf (cval,"\npanel %d.0%d \'", k+1,i+1);
- else
- sprintf (cval,"\npanel %d.%d \'", k+1,i+1);
- fstr = Mstrcat (fstr, cval);
- XtVaGetValues (bchild[nbutton], XmNlabelString, &xmstr_label, NULL);
- XmStringGetLtoR (xmstr_label, XmSTRING_DEFAULT_CHARSET, &label);
- if ( (ilen = strlen(label)) == 0 )
- fstr = Mstrcat (fstr, " ");
- else
- fstr = Mstrcat (fstr, label);
- fstr = Mstrcat (fstr, "\'");
- XtFree (label);
- nbutton++;
- }
- }
- fstr = Mstrcat (fstr, display_string);
-
- if ((ppf = fopen(name, "w")) == NULL) {
- char message[MAX_stringl];
-
- sprintf (message,"Unable to open file %s for write ", name);
- warn_user (UxTopLevel, message);
- return; }
- fwrite(fstr, sizeof(char), strlen(fstr), ppf);
- fclose(ppf);
-
-}
-
-static void okPNBCallback( widget, parent, data )
- Widget widget;
- Widget parent;
- XmAnyCallbackStruct *data;
-{
- UxDestroyInterface(parent);
-}
-
-static void savePNBCallback( widget, panel, callback_data )
- Widget widget;
- Widget panel;
- XmAnyCallbackStruct *callback_data;
-{
- FILE *tfp; /* Pointer to open file */
- char *macro_name;
-
-
-/* Get kuip macro name (panel definition) */
- macro_name = prompt_user (UxTopLevel, "Give KUIP macro file name", "",
- "HELP_SAVE_PANEL");
- if (macro_name == NULL) return;
-
-
-/* Check if file already exists and put a warning message */
- if ((tfp = fopen(macro_name, "r")) != NULL) {
- char cmess[MAX_stringl];
- int answ;
-
- sprintf (cmess,"File %s already exists: overwrite it ? (Y/N)",
- macro_name);
- answ = ask_user (UxTopLevel, cmess, "Yes", "No", 1);
- if (answ != 1) {
- fclose(tfp);
- return;
- }
- fclose(tfp);
- }
-
- /* Save file */
- panel_save (panel, macro_name);
-
- free (macro_name);
- return;
-}
-
-void helpPNBCallback( widget, hlpstr, callback_data )
- Widget widget;
- char *hlpstr;
- XmAnyCallbackStruct *callback_data;
-{
- char cmd_help[MAXCMD];
-
- sprintf (cmd_help, "HELP %s", hlpstr);
- send_cmd (cmd_help);
-}
-
-/*
- * concatenate two strings if the first one is allocated
- */
-static char *Mstrcat( str1, str2 )
- char *str1;
- const char *str2;
-{
- size_t len1 = strlen( str1 );
- size_t len2 = strlen( str2 );
- str1 = realloc( str1, len1 + len2 + 1 );
- strcpy( &str1[len1], str2 );
- return str1;
-}
diff --git a/src/packlib/kuip/programs/kxterm/kxterm.c b/src/packlib/kuip/programs/kxterm/kxterm.c
deleted file mode 100644
index d912b32..0000000
--- a/src/packlib/kuip/programs/kxterm/kxterm.c
+++ /dev/null
@@ -1,2754 +0,0 @@
-/*
- * $Id: kxterm.c,v 1.2 2005/04/18 15:23:10 mclareni Exp $
- *
- * $Log: kxterm.c,v $
- * Revision 1.2 2005/04/18 15:23:10 mclareni
- * Mods submitted by Kevin B. McCarty to fix insecure Cernlib uses of /tmp.
- *
- * Revision 1.1.1.1 1996/03/08 15:33:04 mclareni
- * Kuip
- *
- */
-/*CMZ : 2.06/03 10/01/95 08.59.54 by N.Cremel*/
-/*-- Author : Fons Rademakers 8/01/93*/
-/***********************************************************************
- * *
- * KXTERM -- Kuip Terminal Emulator. *
- * *
- * This terminal emulator combines the best features from the (now *
- * defunct) Apollo DM pads (like: input and transcript pads, *
- * automatic file backup of transcript, search in transcript pad, *
- * etc.) and the Korn shell emacs-style command line editing and *
- * command line recall mechanism. *
- * *
- ***********************************************************************/
-
-#include "kuip/kuip.h"
-
-#include <Xm/Xm.h>
-#include <Xm/Text.h>
-#include <Xm/FileSB.h>
-#include <Xm/ToggleB.h>
-#include <Xm/ToggleBG.h>
-#include <Xm/MessageB.h>
-#include <X11/IntrinsicP.h>
-#if defined(__hpux) && XtSpecificationRelease == 4
-#include <X11/Protocols.h>
-#else
-#include <Xm/Protocols.h>
-#endif
-#include <X11/cursorfont.h>
-#include <Xm/AtomMgr.h>
-
-#include "menu.h"
-#include "utils.h"
-#include "actions.h"
-#include "uxxt.h"
-#if defined(CERNLIB_VMS)
-#include "kuip/mkqio.h"
-#endif
-
-#define strrstr my_strrstr
-#if defined(__hpux)
-#undef strrstr
-#endif
-
-
-#define MAX_CMD_LENGTH 512
-#define INC_LENGTH 128
-#define MAX_FILE_LENGTH 256
-#define MAX_ITEMS 30
-
-#define CURSOR 1
-#define LINE 2
-
-#define ESCAPE "#@" /* escape sequence for special kxterm commands */
-#define STX '\2' /* Start Transmission: application is ready */
-
-
-#ifdef _NO_PROTO
-# define ZEROargs
-#else
-# define ZEROargs void
-#endif
-
-/* kxterm icon */
-#define kxterm_width 50
-#define kxterm_height 50
-static char kxterm_bits[] = {
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0xf0, 0xff, 0xff, 0x1f, 0x00, 0x00, 0x00, 0x1c, 0x00,
- 0x00, 0x60, 0x00, 0x00, 0x00, 0x07, 0x00, 0x00, 0x80, 0x01, 0x00, 0xc0,
- 0x55, 0x55, 0x55, 0x55, 0x06, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x04,
- 0x00, 0x40, 0x55, 0x55, 0x55, 0x55, 0x05, 0x00, 0x40, 0xaa, 0xaa, 0xaa,
- 0xaa, 0x06, 0x00, 0x40, 0xfd, 0xff, 0xff, 0xff, 0x05, 0x00, 0x40, 0xfe,
- 0xff, 0xff, 0x7f, 0x06, 0x00, 0x40, 0x0d, 0x00, 0xe0, 0x7f, 0x05, 0x00,
- 0x40, 0xee, 0xff, 0xef, 0x7f, 0x06, 0x00, 0x40, 0xed, 0xff, 0xeb, 0x7f,
- 0x05, 0x00, 0x40, 0xee, 0xff, 0xef, 0x7f, 0x06, 0x00, 0x40, 0xed, 0xff,
- 0xef, 0x7f, 0x05, 0x00, 0x40, 0x0e, 0x00, 0xe0, 0x7f, 0x06, 0x00, 0x40,
- 0xed, 0xff, 0xef, 0x7f, 0x05, 0x00, 0x40, 0x2e, 0xfe, 0xeb, 0x7f, 0x06,
- 0x00, 0x40, 0xed, 0xff, 0x0f, 0x40, 0x05, 0x00, 0x40, 0xee, 0xff, 0xef,
- 0x5f, 0x06, 0x00, 0x40, 0xed, 0xff, 0xef, 0x5f, 0x05, 0x00, 0x40, 0x0e,
- 0x00, 0xe0, 0x5f, 0x06, 0x00, 0x40, 0xfd, 0x7f, 0xff, 0x5f, 0x05, 0x00,
- 0x40, 0xfe, 0x7f, 0xff, 0x5f, 0x06, 0x00, 0x40, 0xfd, 0x7f, 0xf1, 0x5f,
- 0x05, 0x00, 0x40, 0xfe, 0x7f, 0xff, 0x5f, 0x06, 0x00, 0x40, 0xfd, 0x7f,
- 0x00, 0x40, 0x05, 0x00, 0x40, 0xfe, 0xff, 0xff, 0x7f, 0x06, 0x00, 0x40,
- 0xfd, 0xff, 0xff, 0x7f, 0x05, 0x00, 0x40, 0xfe, 0xff, 0xff, 0x7f, 0x06,
- 0x00, 0x40, 0x05, 0x00, 0x00, 0x00, 0x05, 0x00, 0x40, 0xaa, 0xaa, 0xaa,
- 0xaa, 0x06, 0x00, 0x40, 0x55, 0x55, 0x55, 0x55, 0x05, 0x00, 0x80, 0xff,
- 0xff, 0xff, 0xff, 0x03, 0x00, 0x00, 0xc0, 0xff, 0xff, 0x0f, 0x00, 0x00,
- 0x00, 0xe0, 0x1f, 0xc0, 0x0f, 0x00, 0x00, 0x00, 0xff, 0xff, 0xff, 0xff,
- 0x01, 0x00, 0x80, 0x01, 0x00, 0x00, 0x00, 0x01, 0x00, 0xc0, 0x50, 0x55,
- 0x15, 0x2a, 0x02, 0x00, 0x60, 0xa8, 0xaa, 0x2a, 0x54, 0x04, 0x00, 0x30,
- 0x54, 0x55, 0x55, 0xa8, 0x08, 0x00, 0x18, 0xaa, 0xaa, 0xaa, 0x50, 0x11,
- 0x00, 0x0c, 0x15, 0x00, 0x40, 0xa1, 0x22, 0x00, 0x04, 0x00, 0x00, 0x00,
- 0x00, 0x40, 0x00, 0xac, 0xaa, 0xaa, 0xaa, 0xaa, 0x6a, 0x00, 0x54, 0x55,
- 0x55, 0x55, 0x55, 0x55, 0x00, 0xfc, 0xff, 0xff, 0xff, 0xff, 0x7f, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00};
-
-/* Start houglass bitmaps (for wait_cursor) */
-#define hourglass_width 32
-#define hourglass_height 32
-#define hourglass_x_hot 15
-#define hourglass_y_hot 15
-static char hourglass_bits[] = {
- 0xe0, 0xff, 0xff, 0x03, 0xe0, 0xff, 0xff, 0x03, 0x40, 0x00, 0x00, 0x01,
- 0xe0, 0xff, 0xff, 0x03, 0x60, 0x00, 0x00, 0x03, 0x60, 0x00, 0x00, 0x03,
- 0x60, 0x00, 0x00, 0x03, 0x60, 0xc0, 0x01, 0x03, 0xc0, 0xa8, 0x8e, 0x01,
- 0x80, 0x55, 0xdd, 0x00, 0x00, 0xab, 0x6f, 0x00, 0x00, 0x56, 0x37, 0x00,
- 0x00, 0xec, 0x1b, 0x00, 0x00, 0xd8, 0x0d, 0x00, 0x00, 0xb0, 0x06, 0x00,
- 0x00, 0xa0, 0x02, 0x00, 0x00, 0x20, 0x02, 0x00, 0x00, 0xb0, 0x06, 0x00,
- 0x00, 0x98, 0x0c, 0x00, 0x00, 0x8c, 0x18, 0x00, 0x00, 0x06, 0x30, 0x00,
- 0x00, 0x83, 0x60, 0x00, 0x80, 0xc1, 0xc3, 0x00, 0xc0, 0xb0, 0x86, 0x01,
- 0x60, 0x5c, 0x1d, 0x03, 0x60, 0x2a, 0x39, 0x03, 0x60, 0xdd, 0x7f, 0x03,
- 0x60, 0x00, 0x00, 0x03, 0xe0, 0xff, 0xff, 0x03, 0x40, 0x00, 0x00, 0x01,
- 0xe0, 0xff, 0xff, 0x03, 0xe0, 0xff, 0xff, 0x03};
-
-#define hourglass_mask_width 32
-#define hourglass_mask_height 32
-static char hourglass_mask_bits []= {
- 0xe0, 0xff, 0xff, 0x03, 0xe0, 0xff, 0xff, 0x03, 0xc0, 0xff, 0xff, 0x01,
- 0xe0, 0xff, 0xff, 0x03, 0xe0, 0xff, 0xff, 0x03, 0xe0, 0xff, 0xff, 0x03,
- 0xe0, 0xff, 0xff, 0x03, 0xe0, 0xff, 0xff, 0x03, 0xc0, 0xff, 0xff, 0x01,
- 0x80, 0xff, 0xff, 0x00, 0x00, 0xff, 0x7f, 0x00, 0x00, 0xfe, 0x3f, 0x00,
- 0x00, 0xfc, 0x1f, 0x00, 0x00, 0xf8, 0x0f, 0x00, 0x00, 0xf0, 0x07, 0x00,
- 0x00, 0xe0, 0x03, 0x00, 0x00, 0xe0, 0x03, 0x00, 0x00, 0xf0, 0x07, 0x00,
- 0x00, 0xf8, 0x0f, 0x00, 0x00, 0xfc, 0x1f, 0x00, 0x00, 0xfe, 0x3f, 0x00,
- 0x00, 0xff, 0x7f, 0x00, 0x80, 0xff, 0xff, 0x00, 0xc0, 0xff, 0xff, 0x01,
- 0xe0, 0xff, 0xff, 0x03, 0xe0, 0xff, 0xff, 0x03, 0xe0, 0xff, 0xff, 0x03,
- 0xe0, 0xff, 0xff, 0x03, 0xe0, 0xff, 0xff, 0x03, 0xc0, 0xff, 0xff, 0x01,
- 0xe0, 0xff, 0xff, 0x03, 0xe0, 0xff, 0xff, 0x03};
-/* ... end houglass bitmaps */
-
-
-/* extern functions */
-extern Widget create_kuipIo(ZEROargs); /* routine created by Architect */
-extern Widget create_saveAsTrDialog(ZEROargs);
-extern Widget create_inputTrDialog(ZEROargs);
-extern Widget create_searchDialog(ZEROargs);
-
-extern void warn_user( /* from dialog.c */
-#ifndef _NO_PROTO
- Widget parent, char *warning
-#endif
- );
-extern void inform_user(
-#ifndef _NO_PROTO
- Widget parent, char *warning
-#endif
- );
-
-extern void help_cb(
-#ifndef _NO_PROTO
- Widget w, int *type, XmAnyCallbackStruct *call_data
-#endif
- );
-
-extern void set_kxtpanel_rows (
-#ifndef _NO_PROTO
- int nrow, int ncol, int last
-#endif
- );
-
-extern void set_kxtpanel_keys (
-#ifndef _NO_PROTO
- int row, int col, char *key
-#endif
- );
-
-extern void display_kxtpanel (
-#ifndef _NO_PROTO
- char *title, char *geometry
-#endif
- );
-
-/* extern widgets */
-extern Widget panedWindow; /* kuipIo interface */
-extern Widget cwdLabel;
-extern Widget lcdLabel;
-extern Widget outputText;
-extern Widget outputHoldButton;
-extern Widget inputText;
-extern Widget inputHoldButton;
-extern Widget menuBar;
-extern Widget aboutButton;
-extern Widget aboutAppButton;
-extern Widget saveTransButton;
-extern Widget saveTransAsButton;
-extern Widget printButton;
-extern Widget killButton;
-extern Widget exitButton;
-extern Widget cutButton;
-extern Widget copyButton;
-extern Widget pasteButton;
-extern Widget searchButton;
-extern Widget showInputButton;
-extern Widget clearTrButton;
-extern Widget helpKxtermButton;
-extern Widget helpResourceButton;
-extern Widget helpEditButton;
-extern Widget closeInputTrButton; /* Input Transcript Dialog */
-extern Widget inputTrText;
-extern Widget caseToggle; /* Search Dialog */
-extern Widget previousSearchButton;
-extern Widget nextSearchButton;
-extern Widget allSearchButton;
-extern Widget closeSearchButton;
-extern Widget searchText;
-
-/* global functions */
-void send_cmd(
-#ifndef _NO_PROTO
- char *
-#endif
- );
-
-/* local functions */
-static void exit_action(
-#ifndef _NO_PROTO
- char **, int
-#endif
- );
-static void quit_action(
-#ifndef _NO_PROTO
- char **, int
-#endif
- );
-static void cwd_action(
-#ifndef _NO_PROTO
- char **, int
-#endif
- );
-static void lcd_action(
-#ifndef _NO_PROTO
- char **, int
-#endif
- );
-static void prompt_action(
-#ifndef _NO_PROTO
- char **, int
-#endif
- );
-
-static void raise_action(
-#ifndef _NO_PROTO
- char **, int
-#endif
- );
-
-static void cursor_action(
-#ifndef _NO_PROTO
- char **, int
-#endif
- );
-
-static void newpanel_action(
-#ifndef _NO_PROTO
- char **, int
-#endif
- );
-
-static void panelrows_action(
-#ifndef _NO_PROTO
- char **, int
-#endif
- );
-
-static void panelkeys_action(
-#ifndef _NO_PROTO
- char **, int
-#endif
- );
-
-static void display_panel_action(
-#ifndef _NO_PROTO
- char **, int
-#endif
- );
-
-static void SendSignal(
-#ifndef _NO_PROTO
- Widget, XEvent *, String *, Cardinal *
-#endif
- );
-static void GetPreviousCommand(
-#ifndef _NO_PROTO
- Widget, XEvent *, String *, Cardinal *
-#endif
- );
-static void ResubmitCommand(
-#ifndef _NO_PROTO
- Widget, XEvent *, String *, Cardinal *
-#endif
- );
-static void ToggleHold(
-#ifndef _NO_PROTO
- Widget, XEvent *, String *, Cardinal *
-#endif
- );
-
-static void application_cmd_cb(
-#ifndef _NO_PROTO
- Widget, char *, XmAnyCallbackStruct *
-#endif
- );
-static void application_toggle_cb(
-#ifndef _NO_PROTO
- Widget, char*, XmToggleButtonCallbackStruct*
-#endif
- );
-
-/* global data */
-XtAppContext UxAppContext;
-Display *UxDisplay;
-int UxScreen;
-Colormap UxColormap;
-Widget UxTopLevel;
-Widget kuipIo; /* kxterm toplevel widget */
-
-XtInputId input_id;
-
-Boolean hold_input;
-Boolean hold_output;
-
-Boolean do_flush = False;
-Boolean changing_text = False;
-Boolean stop_sending = False;
-Boolean flow_control = False;
-int dont_move = 0;
-
-Boolean application_alive = True;
-Boolean user_said_exit = False;
-int parent_pid = 0;
-char *application_prompt = NULL;
-char *application_name = NULL;
-char *prog_name; /* name of this invocation of kxterm */
-
-char *input_tr_text = NULL;
-char *transcript_text = NULL;
-Boolean lower_text = False;
-
-char transcript_file[MAX_FILE_LENGTH]; /* transcript pad file */
-FILE *tfp; /* file pointer to transcript_file */
-Boolean tr_tmp_file = False; /* is transcript file a tmp file ? */
-
-char last_command[MAX_CMD_LENGTH];
-Boolean kxterm_iconic = False;
-
-Cursor main_cursor, wait_cursor;
-
-int Error; /* wanted by libPW.a routines */
-
-
-/*
- * Action commands that can be send by an application to kxterm.
- */
-static KxtermActionsRec kxterm_actions[] = {
- {"exit", exit_action}, /* exit of application and kxterm */
- {"quit", quit_action}, /* quit of application */
- {"cwd", cwd_action}, /* change the current working directory */
- {"lcd", lcd_action}, /* change the system working directory */
- {"prompt", prompt_action}, /* change the application prompt */
- {"raise", raise_action}, /* pop up kxterm window */
- {"cursor", cursor_action}, /* change kxterm cursor shape */
- {"setnewpanel", newpanel_action}, /* display new KXTERM panel */
- {"setpanelrows", panelrows_action}, /* set KXTERM panel nrow & ncol */
- {"setpanelkeys", panelkeys_action}, /* et KXTERM panel keys */
- {"display_panel", display_panel_action}, /* display KXTERM panel */
- {NULL, NULL},
-};
-
-static String fallbacks[] = {
- "*selectColor: green",
- "*kuipIo_shell.geometry: +0+0",
- "*outputForm.height: 205",
-/* "*keyboardFocusPolicy: pointer",*/
- "*doubleClickInterval: 400",
- NULL
-};
-
-static XrmOptionDescRec options[] = {
- {"-name", "*kuipIo_shell.title", XrmoptionSepArg, NULL},
- {"-name", "*kuipIo_shell.iconName", XrmoptionSepArg, NULL},
- {"-title", "*kuipIo_shell.title", XrmoptionSepArg, NULL},
- {"-n", "*kuipIo_shell.iconName", XrmoptionSepArg, NULL},
- {"-geometry", "*kuipIo_shell.geometry", XrmoptionSepArg, NULL},
- {"-iconic", "*kuipIo_shell.iconic", XrmoptionNoArg, "True"},
- {"-tfont", "*XmText*fontList", XrmoptionSepArg, NULL},
- {"-font", "*fontList", XrmoptionSepArg, NULL},
-};
-
-static XtActionsRec actions[] = {
- {"SendSignal", SendSignal},
- {"GetPreviousCommand", GetPreviousCommand},
- {"ResubmitCommand", ResubmitCommand},
- {"ToggleHold", ToggleHold},
-};
-
-/* emacs translations for the inputText widget */
-static char *translation_table =
- "Ctrl <Key>b: backward-character()\n\
- Alt <Key>b: backward-word()\n\
- Meta <Key>b: backward-word()\n\
- Shift Alt <Key>b: backward-word(extend)\n\
- Shift Meta <Key>b: backward-word(extend)\n\
- Alt <Key>[: backward-paragraph()\n\
- Meta <Key>[: backward-paragraph()\n\
- Shift Alt <Key>[: backward-paragraph(extend)\n\
- Shift Meta <Key>[: backward-paragraph(extend)\n\
- Alt <Key><: beginning-of-file()\n\
- Meta <Key><: beginning-of-file()\n\
- Ctrl <Key>a: beginning-of-line()\n\
- Shift Ctrl <Key>a: beginning-of-line(extend)\n\
- Ctrl <Key>osfInsert: copy-clipboard()\n\
- Shift <Key>osfDelete: cut-clipboard()\n\
- Shift <Key>osfInsert: paste-clipboard()\n\
- Alt <Key>>: end-of-file()\n\
- Meta <Key>>: end-of-file()\n\
- Ctrl <Key>e: end-of-line()\n\
- Shift Ctrl <Key>e: end-of-line(extend)\n\
- Ctrl <Key>f: forward-character()\n\
- Alt <Key>]: forward-paragraph()\n\
- Meta <Key>]: forward-paragraph()\n\
- Shift Alt <Key>]: forward-paragraph(extend)\n\
- Shift Meta <Key>]: forward-paragraph(extend)\n\
- Ctrl Alt <Key>f: forward-word()\n\
- Ctrl Meta <Key>f: forward-word()\n\
- Ctrl <Key>d: kill-next-character()\n\
- Alt <Key>BackSpace: kill-previous-word()\n\
- Meta <Key>BackSpace: kill-previous-word()\n\
- Ctrl <Key>w: key-select() kill-selection()\n\
- Ctrl <Key>y: unkill()\n\
- Ctrl <Key>k: kill-to-end-of-line()\n\
- Ctrl <Key>u: beginning-of-line() kill-to-end-of-line()\n\
- Alt <Key>Delete: kill-to-start-of-line()\n\
- Meta <Key>Delete: kill-to-start-of-line()\n\
- Ctrl <Key>o: newline-and-backup()\n\
- Ctrl <Key>j: newline-and-indent()\n\
- Ctrl <Key>n: next-line() GetPreviousCommand(NEXT)\n\
- Ctrl <Key>osfLeft: page-left()\n\
- Ctrl <Key>osfRight: page-right()\n\
- Ctrl <Key>p: previous-line() GetPreviousCommand()\n\
- Ctrl <Key>g: process-cancel()\n\
- Ctrl <Key>l: redraw-display()\n\
- Ctrl <Key>osfDown: next-page()\n\
- Ctrl <Key>osfUp: previous-page()\n\
- <Key>osfDown: next-line() GetPreviousCommand(NEXT)\n\
- <Key>osfUp: previous-line() GetPreviousCommand()\n\
- Ctrl <Key>space: set-anchor()\n\
- Ctrl <Key>c: SendSignal(SIGINT)\n\
- Ctrl <Key>h: ToggleHold()\n\
- Shift <Key>F8: ResubmitCommand()\n\
- <Key>F8: ResubmitCommand(EXEC)";
-
-/***********************************************************************
- * *
- * Free transcript text. *
- * *
- ***********************************************************************/
-void free_transcript_text()
-{
- XtFree(transcript_text);
- transcript_text = NULL;
- lower_text = False;
-}
-
-/***********************************************************************
- * *
- * Get a line from the text. Pos_type can be either CURSOR or LINE. *
- * When it is CURSOR pos is a cursor position in the text. When it *
- * is LINE and pos > 0 then it is a line pos from the beginning of *
- * the text and when pos < 0 then it is from the end of the text. *
- * The line returned should be freed by the calling routine to *
- * prevent memory loss and does not contain the \n character. *
- * *
- ***********************************************************************/
-static char *get_line( text, pos, pos_type )
- char *text;
- int pos;
- int pos_type;
-{
- char *s, *line = NULL;
- int pos1, pos2;
-
- if (!text || !*text)
- return NULL;
-
- switch (pos_type) {
- case CURSOR:
- /*
- * From pos search forward to the first '\n', then backwards
- * to the previous '\n'.
- */
- pos2 = 0;
- if ((s = strchr(&text[pos], '\n'))) {
- pos2 = (int)(s - text);
- text[pos2] = '\0';
- }
-
- if ((s = strrchr(text, '\n'))) {
- pos1 = (int)(s - text);
- line = XtMalloc(strlen(&text[pos1+1]) + 1);
- strcpy(line, &text[pos1+1]);
- } else {
- line = XtMalloc(strlen(text) + 1);
- strcpy(line, text);
- }
-
- if (pos2)
- text[pos2] = '\n';
- break;
- case LINE:
- if (!pos) return NULL;
- pos1 = 0;
- if (pos > 0) {
- for (s = text; (s = strchr(s, '\n')) != NULL; s++)
- if (++pos1 == pos) {
- line = get_line(text, (int)(s - text), CURSOR);
- return line;
- }
- return NULL;
- } else {
- pos2 = 0;
- while ((s = strrchr(text, '\n'))) {
- if (pos2) text[pos2] = '\n';
- if (--pos1 == pos) {
- line = get_line(text, (int)(s - text), CURSOR);
- return line;
- }
- pos2 = (int)(s - text);
- text[pos2] = '\0';
- }
- if (pos2) text[pos2] = '\n';
- return NULL;
- }
- break;
- }
- return line;
-}
-
-/***********************************************************************
- * *
- * Insert a string at the end of a XmText widget. *
- * *
- ***********************************************************************/
-void insert_string( text_widget, buf, show )
- Widget text_widget;
- char *buf;
- int show;
-{
- XmTextPosition pos = XmTextGetLastPosition(text_widget);
- XmTextInsert(text_widget, pos, buf);
-
- if (show) {
- pos = XmTextGetLastPosition(text_widget);
- XmTextSetInsertionPosition(text_widget, pos);
- XmTextShowPosition(text_widget, pos);
- }
-
- /* write into transcript file */
- if (tfp && text_widget == outputText) {
- fprintf(tfp, "%s", buf);
-
- /*
- * transcript_text is not valid anymore,
- * free the space and reset pointer
- */
- free_transcript_text();
- }
-}
-
-/***********************************************************************
- * *
- * Checks if a line begins with a prompt. If it does it returns *
- * the length of the prompt otherwise 0. *
- * *
- ***********************************************************************/
-int begins_with_prompt(char *line)
-{
- int len = 0;
-
- if (application_prompt) {
- char *s;
- int pl = strlen(application_prompt);
-
- /* simple case: direct match */
- if (!strncmp(line, application_prompt, pl))
- return pl;
-
- /* variable prompt of type: paw [xxx] */
- if ((s = strchr(application_prompt, '['))) {
-
- int l = s - application_prompt + 1;
- int extra = pl-(strchr(application_prompt,']')-application_prompt+1);
-
- if (!strncmp(line, application_prompt, l)) {
- len = strchr(line, ']') - line + 1 + extra;
- if (len < 0) len = 0;
- }
- }
- }
-
- return len;
-}
-
-/***********************************************************************
- * *
- * Show prompt in inputText widget. Kxterm is ready to send next *
- * command. *
- * *
- ***********************************************************************/
-void show_prompt()
-{
- if (application_prompt) {
- char *input = XmTextGetString(inputText);
- XmTextPosition pos = XmTextGetInsertionPosition(inputText);
-
- /* don't insert more than one prompt */
- if (begins_with_prompt(input)) {
- XtFree(input);
- return;
- }
-
- XmTextInsert(inputText, (XmTextPosition) 0, application_prompt);
-
- pos += strlen(application_prompt);
- XmTextSetInsertionPosition(inputText, pos);
-
- XtFree(input);
- }
-}
-
-/***********************************************************************
- * *
- * Close transcript file and exit kxterm. *
- * *
- ***********************************************************************/
-void exit_kxterm()
-{
- /* close transcript file and if it is a tmp file remove it */
- /* (the result of tmpfile() is removed automatically upon being closed) */
- if (tfp) {
- fclose(tfp);
- }
-
- exit(0);
-}
-
-/***********************************************************************
- * *
- * Handle menu building escape commands coming from the application. *
- * *
- ***********************************************************************/
-void menu_escape( cmd )
- char *cmd;
-{
- char *s, *menu, *menu_name;
- Widget pulldown;
- MenuItem *menu_item;
-
- /* get name of menu, e.g. *FileMenu */
- if ((s = strchr(cmd, ':'))) {
- menu = XtCalloc(s-cmd+1, 1);
- menu_name = XtCalloc(s-cmd+5+1, 1);
- strncpy(menu, cmd, s-cmd);
- sprintf(menu_name, "*%sMenu", menu);
-
- menu_item = (MenuItem *)XtMalloc(MAX_ITEMS*sizeof(MenuItem));
- if (add_menu_items(s+1, application_cmd_cb, application_toggle_cb,
- menu_item, MAX_ITEMS)) {
-
- /* does menu already exist? */
- pulldown = XtNameToWidget(menuBar, menu_name);
- if (pulldown) {
- /* add to existing pulldown menu */
- BuildMenu(pulldown, XmMENU_PULLDOWN, menu, menu[0], menu_item,
- True);
- } else {
- /* create new pulldown menu */
- BuildMenu(menuBar, XmMENU_PULLDOWN, menu, menu[0], menu_item,
- False);
- }
- }
- XtFree((char *)menu_item);
- XtFree(menu);
- XtFree(menu_name);
- }
-}
-
-/***********************************************************************
- * *
- * Handle exit action coming from the application. *
- * *
- ***********************************************************************/
-static void exit_action( argv, argc )
- char **argv;
- int argc;
-{
- user_said_exit = True;
-}
-
-/***********************************************************************
- * *
- * Handle quit action coming from the application. *
- * *
- ***********************************************************************/
-static void quit_action( argv, argc )
- char **argv;
- int argc;
-{
- user_said_exit = True;
-}
-
-/***********************************************************************
- * *
- * Handle cwd action coming from the application. *
- * This action displays the current working directory in the *
- * cwdLabel widget. *
- * *
- ***********************************************************************/
-static void cwd_action( argv, argc )
- char **argv;
- int argc;
-{
- XmString xms;
-
- if (argc)
- xms = XmStringCreate(argv[0], XmSTRING_DEFAULT_CHARSET);
- else
- xms = XmStringCreate("", XmSTRING_DEFAULT_CHARSET);
-
- XtVaSetValues(cwdLabel, XmNlabelString, xms, NULL);
- XmStringFree(xms);
-}
-
-/***********************************************************************
- * *
- * Handle lcd action coming from the application. *
- * This action displays the current system working directory in the *
- * lcdLabel widget. The system working directory is changed by the *
- * kuip command lcd. *
- * *
- ***********************************************************************/
-static void lcd_action( argv, argc )
- char **argv;
- int argc;
-{
- XmString xms;
-
- if (argc)
- xms = XmStringCreate(argv[0], XmSTRING_DEFAULT_CHARSET);
- else
- xms = XmStringCreate("", XmSTRING_DEFAULT_CHARSET);
-
- XtVaSetValues(lcdLabel, XmNlabelString, xms, NULL);
- XmStringFree(xms);
-}
-
-/***********************************************************************
- * *
- * Handle prompt action coming from the application. *
- * This action changes the application_prompt. *
- * *
- ***********************************************************************/
-static void prompt_action( argv, argc )
- char **argv;
- int argc;
-{
- char *newp;
-
- if (argc) {
- if (strempty(argv[0]))
- newp = NULL;
- else if (argv[0][strlen(argv[0])-1] != ' ') {
- /* prompt should end with ' ' */
- newp = malloc(strlen(argv[0]) + 2);
- sprintf(newp, "%s ", argv[0]);
- } else
- newp = strdup(argv[0]);
- } else
- newp = NULL;
-
- if (application_prompt) {
- int lnew = strlen(newp);
- char *input = XmTextGetString(inputText);
- XmTextPosition pos = XmTextGetInsertionPosition(inputText);
-
- XFlush(UxDisplay);
-
- changing_text = True;
-
- /* replace old prompt by new prompt */
- if (!strncmp(input, application_prompt, strlen(application_prompt))) {
- XmTextReplace(inputText, (XmTextPosition) 0,
- (XmTextPosition) strlen(application_prompt), newp);
- } else
- XmTextInsert(inputText, (XmTextPosition) 0, newp);
-
- /* changing_text = False; */
-
- if (newp)
- pos += lnew - strlen(application_prompt);
- else
- pos -= strlen(application_prompt);
-
- if (pos < lnew) pos = lnew;
-
- XmTextSetInsertionPosition(inputText, pos);
-
- XFlush(UxDisplay);
-
- changing_text = False;
-
- XtFree(input);
- free(application_prompt);
-
- if (newp)
- application_prompt = strdup(newp);
- else
- application_prompt = NULL;
-
- } else {
-
- if (newp)
- application_prompt = strdup(newp);
- else
- application_prompt = NULL;
-
- show_prompt();
- }
-
- if (newp) free(newp);
-}
-
-/***********************************************************************
- * *
- * Handle raise action coming from the application. *
- * This action popups the executive window. *
- * *
- ***********************************************************************/
-static void raise_action( argv, argc )
- char **argv;
- int argc;
-{
- XtPopup( XtParent(kuipIo), XtGrabNone );
-
- XMapRaised(XtDisplay(kuipIo), XtWindow(XtParent(kuipIo)));
- XFlush(XtDisplay(kuipIo));
-}
-
-/***********************************************************************
- * *
- * Handle raise action coming from the application. *
- * This action popups the executive window. *
- * *
- ***********************************************************************/
-static void cursor_action( argv, argc )
- char **argv;
- int argc;
-{
- XSetWindowAttributes attrs;
-
- if (!argc || strempty(argv[0])) return;
-
- if (!strcmp(argv[0], "wait")) {
- attrs.cursor = wait_cursor;
- XChangeWindowAttributes(UxDisplay, XtWindow(kuipIo), CWCursor, &attrs);
- } else if (!strcmp(argv[0], "main")) {
- attrs.cursor = main_cursor;
- XChangeWindowAttributes(UxDisplay, XtWindow(kuipIo), CWCursor, &attrs);
- }
-}
-
-static void newpanel_action( argv, argc )
- char **argv;
- int argc;
-{
- char *title;
- char geometry[128];
- int nc, nl, i, j;
-
- if (argc) {
- title = strdup(argv[0]);
- nl = atoi (argv[1]);
- nc = atoi (argv[2]);
- set_kxtpanel_rows (nl, 0, -1);
- for (i = 0; i < nl; i++) {
- set_kxtpanel_rows (i, nc, 0);
- }
- for (i = 0; i < nl; i++) {
- for (j = 0; j < nc; j++) {
- set_kxtpanel_keys (i, j, " ");
- }
- }
- sprintf (geometry,"%sx%s+%s+%s", argv[3], argv[4], argv[5], argv[6]);
- display_kxtpanel (title, geometry);
- free(title);
- }
-}
-
-static void panelrows_action( argv, argc )
- char **argv;
- int argc;
-{
- int nl, nc;
-
- if (argc) {
- nl = atoi (argv[0]);
- nc = atoi (argv[1]);
- if (nc == -1) {
- set_kxtpanel_rows (nl, 0, -1);
- } else {
- set_kxtpanel_rows (nl, nc, 0);
- }
- }
-}
-
-static void panelkeys_action( argv, argc )
- char **argv;
- int argc;
-{
- int nr, nc;
-
- if (argc) {
- nr = atoi (argv[0]);
- nc = atoi (argv[1]);
- if (strempty(argv[2]))
- set_kxtpanel_keys (nr, nc, " ");
- else
- set_kxtpanel_keys (nr, nc, argv[2]);
- }
-}
-
-static void display_panel_action( argv, argc )
- char **argv;
- int argc;
-{
- char *title, *geometry;
-
- if (argc) {
- title = strdup(argv[0]);
- geometry = strdup(argv[1]);
- display_kxtpanel (title, geometry);
- free (title);
- free (geometry);
- }
-}
-
-/***********************************************************************
- * *
- * Handle special (escaped) commands coming from the application. *
- * An escaped command starts with the ESCAPE sequence and ends with *
- * a newline (\n). *
- * There are two type of command: *
- * 1) Action commands with format: <ESCAPE><cmd>\n *
- * The <cmd> part is a kxterm action, e.g. "exit" or *
- * "cwd(//lun1)". For all defined actions see the action table *
- * defined in deck actions. *
- * 2) Menu building commands with format: *
- * <ESCAPE>M:<Menu name>:<item name>:[<cmd>]: *
- * [<button | toggle | separator>]:[<nmemonic>]: *
- * [<short cut>]:[<printed short cut>]\n *
- * The fields: <cmd>, <button...>, <nmemonic>, <short cut>, *
- * <printed short cut> are optional and may be *
- * replaced by a blank. If <cmd> is omitted *
- * <item name> will be used as <cmd>. If <button...> *
- * is omitted button will be used. For the other *
- * items there is no default. *
- * *
- ***********************************************************************/
-void handle_escapes( cmd )
- char *cmd;
-{
- char *s;
-
- s = cmd;
- s += strlen(ESCAPE); /* skip ESCAPE */
-
- if (!strncasecmp(s, "M:", 2)) {
- s += 2;
- menu_escape(s);
- } else
- handle_kxterm_action(cmd);
-}
-
-/***********************************************************************
- * *
- * Send command to application. *
- * *
- ***********************************************************************/
-void send_cmd( str )
- char *str;
-{
- int l;
- char *line, *cmd;
-
- /* cannot send anything when application is dead (pipes are broken) */
- if (!application_alive)
- return;
-
- line = str;
-
- /* strip off prompt */
- while ((l = begins_with_prompt(line)))
- line += l;
-
- cmd = strip(line);
-
- printf("%s\n", cmd);
-
- if (flow_control)
- stop_sending = True;
-
- /* write to input pad tmp file */
- if (!strempty(cmd)) {
- char *str1 = XtMalloc(strlen(cmd)+2);
- strcpy(last_command, cmd);
- sprintf(str1, "%s\n", cmd);
- if (inputTrText) {
- insert_string(inputTrText, str1, True);
- XtFree(input_tr_text);
- input_tr_text = NULL;
- }
- XtFree(str1);
- }
-
- XtFree(cmd);
-}
-
-/***********************************************************************
- * *
- * Send kxterm control (escaped) command to application. *
- * *
- ***********************************************************************/
-static void send_kxterm_cmd( str )
- char *str;
-{
- /*
- * cannot send any commands when application is dead (pipes are broken)
- * or when flow_control is not yet enabled
- */
- if (!application_alive || !flow_control)
- return;
-
- if (!strncmp(str, ESCAPE, strlen(ESCAPE))) {
- if (str[strlen(str)-1] == '\n')
- printf("%s", str);
- else
- printf("%s\n", str);
- }
-}
-
-/***********************************************************************
- * *
- * Toggle a pushbutton widget (switching shadow colors). *
- * *
- ***********************************************************************/
-void TogglePushButton( button, set )
- Widget button;
- int set;
-{
- Pixel ts, bs;
-
- if (set) {
- XtVaGetValues(button, XmNbottomShadowColor, &bs, XmNtopShadowColor, &ts,
- NULL);
- XtVaSetValues(button, XmNbottomShadowColor, ts, XmNtopShadowColor, bs,
- NULL);
- } else {
- XtVaGetValues(button, XmNbottomShadowColor, &ts, XmNtopShadowColor, &bs,
- NULL);
- XtVaSetValues(button, XmNbottomShadowColor, bs, XmNtopShadowColor, ts,
- NULL);
- }
-}
-
-/***********************************************************************
- * *
- * Flush input. Check if there is still an \n terminated string in *
- * the inputText widget and send it to the application. *
- * *
- ***********************************************************************/
-static void flush_input( new_insert )
- XmTextPosition *new_insert;
-{
- char *input, *line, *s;
- int len, len2, delete_to;
- XmTextPosition pos;
-
- if (hold_input || stop_sending) return;
-
- changing_text = True;
-
- input = XmTextGetString(inputText);
- s = strchr(input, '\n');
- if (s) {
- /*
- * Only flush up to the line containing the cursor.
- */
- if (new_insert)
- pos = *new_insert;
- else
- pos = XmTextGetInsertionPosition(inputText);
- len = s - input;
- if (pos > len) {
- line = XtCalloc(len+1, 1);
- strncpy(line, input, len);
-
- send_cmd(line);
-
- delete_to = len + 1;
-
- XtFree(line);
-
- /* delete text from beginning to current pos */
- XmTextReplace(inputText, (XmTextPosition)0,
- (XmTextPosition)delete_to, NULL);
-
- if (new_insert) {
- *new_insert -= delete_to;
- XmTextSetInsertionPosition(inputText, *new_insert);
-
- /*
- * Now some horrible piece of code to find out how many times
- * we should ignore the MotionVerifyCallback that will be
- * called a different number of times depending on where the
- * the cursor moved to. In the ideal case the above code
- * would have been sufficient. Whenever the text widget will
- * be fixed we could remove the following mess.
- */
-#if XmREVISION > 1
- dont_move = 1;
-#else
- s = strchr(input+delete_to, '\n');
- if (s) {
- len2 = s - (input+delete_to);
- if (len == len2)
- dont_move = 0;
- else if (*(input+delete_to+*new_insert) == '\n')
- dont_move = 1;
- else
- dont_move = 2;
- } else
- dont_move = 0;
-#endif
- }
- }
- }
-
- XtFree(input);
- changing_text = False;
-}
-
-/***********************************************************************
- * *
- * Write the transcript file. *
- * *
- ***********************************************************************/
-static void write_transcript( file )
- char *file;
-{
- /*
- * copy the temp file to user specified file, close temp file and open
- * user specified file again
- */
- if (tfp) {
- fflush(tfp);
- if (!strcmp(transcript_file, file))
- return;
- else {
- char line[MAX_FILE_LENGTH + 50];
- FILE *stream;
-
- if (!(stream = fopen(file, "w"))) {
- sprintf(line, "Cannot open transcript file %s",
- file);
- warn_user(kuipIo, line);
- }
- else {
- /* copy current transcript to new file */
- rewind( tfp );
- while( fgets( line, (sizeof line), tfp ) != NULL )
- fputs( line, stream );
- fclose( stream );
- fclose( tfp );
- tfp = fopen(file, "a+");
- strcpy(transcript_file, file);
-
- if (tr_tmp_file) {
- tr_tmp_file = False;
- }
- fflush(tfp);
- }
- }
- }
-}
-
-/***********************************************************************
- * *
- * Execute an application defined menu button. *
- * *
- ***********************************************************************/
-static void application_cmd_cb( w, cmd, cbs )
- Widget w;
- char *cmd;
- XmAnyCallbackStruct *cbs;
-{
- char *s;
-
- if (!application_alive)
- return;
-
- s = XtMalloc(strlen(cmd) + 20);
- sprintf(s, "%s\n", cmd);
-
- /*
- * Send special (hidden) kuip commands, like #@browser, directly without
- * going via the inputPad. This will prevent these commands from being
- * recorded in the input transcript.
- */
- if (!strncmp(s, ESCAPE, strlen(ESCAPE))) {
- send_kxterm_cmd(s);
-
- /* dirty, KUIP specific code */
- sprintf(s, "%siconify(UNMAP)", ESCAPE);
- if (!strcasecmp(cmd, s)) {
- IconifyShell(kuipIo);
- kxterm_iconic = True;
- }
- } else
- insert_string(inputText, s, True);
-
- XtFree(s);
-}
-
-/***********************************************************************
- * *
- * Execute an application defined toggle menu button. These commands *
- * must recognize the 'on' and 'off' options. *
- * *
- ***********************************************************************/
-static void application_toggle_cb( w, cmd, cbs )
- Widget w;
- char *cmd;
- XmToggleButtonCallbackStruct *cbs;
-{
- char *s;
-
- if (!application_alive)
- return;
-
- s = XtMalloc(strlen(cmd) + 10);
-
- /*
- * Send special (hidden) kuip commands, like #@browser, directly without
- * going via the inputPad. This will prevent these commands from being
- * recorded in the input transcript.
- */
- if (!strncmp(cmd, ESCAPE, strlen(ESCAPE))) {
-
- if (cbs->set)
- sprintf(s, "%s(ON)\n", cmd);
- else
- sprintf(s, "%s(OFF)\n", cmd);
- send_kxterm_cmd(s);
-
- } else {
-
- if (cbs->set)
- sprintf(s, "%s on\n", cmd);
- else
- sprintf(s, "%s off\n", cmd);
- insert_string(inputText, s, True);
-
- }
-
- XtFree(s);
-}
-
-/***********************************************************************
- * *
- * Get the arguments for the SAVE AS command and execute the *
- * command. *
- * *
- ***********************************************************************/
-static void get_saveAsArg( w, cd, call_data )
- Widget w;
- XtPointer cd;
- XmFileSelectionBoxCallbackStruct *call_data;
-{
- char *file;
-#ifdef vms
- char *p;
-#endif
-
- XmStringGetLtoR(call_data->value, XmSTRING_DEFAULT_CHARSET, &file);
- if (strempty(file)) {
- warn_user(w, "You must give a file name.");
- XtFree(file);
- return;
- }
-#ifdef vms
- if ((p = strchr(file, ';')) != NULL)
- *p = '\0';
- file = XtRealloc(file, strlen(file) + 3);
- strcat(file, ";0");
- if (strchr(file, ']') == NULL) {
-#else
- if (*file != '/') {
-#endif
- /*
- * if it is not a directory, determine the full pathname
- * of the selection by concatenating it to the "dir" part
- */
- char *dir, *newfile;
- XmStringGetLtoR(call_data->dir, XmSTRING_DEFAULT_CHARSET, &dir);
- newfile = XtMalloc(strlen(dir) + strlen(file) + 1);
- sprintf(newfile, "%s%s", dir, file);
- XtFree(dir);
- XtFree(file);
- file = newfile;
- }
-
- popdown_dialog(w);
-
- write_transcript(file);
-
- XtFree(file);
-}
-
-/***********************************************************************
- * *
- * Show about... dialog. *
- * *
- ***********************************************************************/
-static void about_cb( w, cd, cbs )
- Widget w;
- XtPointer cd;
- XmAnyCallbackStruct *cbs;
-{
- static Widget dialog = NULL;
-
- if (w == aboutButton) {
-
- if (!dialog) {
- Display *display;
- Pixmap pixmap;
- Pixel fg, bg;
-
- dialog = XmCreateMessageDialog(kuipIo, "aboutDialog", NULL, 0);
-
- display = XtDisplay(dialog);
- XtVaGetValues(dialog, XmNforeground, &fg, XmNbackground, &bg, NULL);
- pixmap = XCreatePixmapFromBitmapData(display,
- DefaultRootWindow(display),
- kxterm_bits, kxterm_width, kxterm_height,
- fg, bg, DefaultDepthOfScreen(XtScreen(dialog)));
-
- XtVaSetValues(dialog, RES_CONVERT(XmNmessageString,
- "Kxterm\n\nThe Kuip Terminal Emulator\n\nVersion 1.02\n"),
- XmNmessageAlignment, XmALIGNMENT_CENTER,
- RES_CONVERT(XmNdialogTitle, "About Kxterm"),
- XmNsymbolPixmap, pixmap,
- NULL);
-
- /* unmanage the Cancel and Help buttons */
- XtUnmanageChild(XmMessageBoxGetChild(dialog,
- XmDIALOG_CANCEL_BUTTON));
- XtUnmanageChild(XmMessageBoxGetChild(dialog,
- XmDIALOG_HELP_BUTTON));
- }
-
- /* popup dialog */
- XtManageChild(dialog);
-
- /*
- * If the dialog was already open, XtManageChild does nothing. In
- * this case, at least make sure the window is raised to the top
- * of the window tree (or as high as it can get).
- */
- XRaiseWindow(XtDisplay(dialog), XtWindow(XtParent(dialog)));
-
- } else {
- char *cmd = XtMalloc(strlen(ESCAPE)+7);
- sprintf(cmd, "%sabout\n", ESCAPE);
- send_kxterm_cmd(cmd);
- XtFree(cmd);
- }
-}
-
-/***********************************************************************
- * *
- * Save the transcript pad in a file. *
- * *
- ***********************************************************************/
-static void save_cb( w, cd, cbs )
- Widget w;
- XtPointer cd;
- XmAnyCallbackStruct *cbs;
-{
- XmAnyCallbackStruct cbs1;
-
- if (!tr_tmp_file)
- write_transcript(transcript_file);
- else {
- cbs1.reason = 0;
- cbs1.event = (XEvent *) NULL;
- XtCallCallbacks(saveTransAsButton, XmNactivateCallback, &cbs1);
- }
-}
-
-/***********************************************************************
- * *
- * Popup fileselectionbox. *
- * *
- ***********************************************************************/
-static void show_save_cb( w, cd, cbs )
- Widget w;
- XtPointer cd;
- XmAnyCallbackStruct *cbs;
-{
- static Widget dialog;
- XmString xmmask;
-
- if (!dialog) {
- dialog = create_saveAsTrDialog();
-
- /* unmanage the Help button */
- XtUnmanageChild(XmFileSelectionBoxGetChild(dialog, XmDIALOG_HELP_BUTTON));
- /*
- * install callbacks
- */
- InstallMwmCloseCallback(dialog, (XtCallbackProc)cancel_cb,
- (XtPointer)dialog);
-
- XtAddCallback(dialog, XmNokCallback,
- (XtCallbackProc)get_saveAsArg, NULL);
- XtAddCallback(dialog, XmNcancelCallback,
- (XtCallbackProc)cancel_cb, dialog);
-
- /* store w in userData */
- XtVaSetValues(dialog, XmNuserData, w, NULL);
- }
-
- XtVaGetValues(dialog, XmNdirMask, &xmmask, NULL);
- XmFileSelectionDoSearch(dialog, xmmask);
-
- /* make menu item insensitive and popup dialog */
- XtSetSensitive(w, False);
- XtManageChild(dialog);
-}
-
-/***********************************************************************
- * *
- * Exit callback routine. *
- * *
- ***********************************************************************/
-static void exit_cb( widget, client_data, call_data )
- Widget widget;
- XtPointer client_data;
- XtPointer call_data;
-{
-
- if (widget == killButton) {
-
- if (parent_pid) {
- kill(parent_pid, SIGQUIT);
- parent_pid = 0;
- }
- application_alive = False;
- return;
- /***
- } else if (widget == quitButton) {
-
- send_cmd("/kuip/quit");
- ***/
- } else {
-
- user_said_exit = True;
- if (!application_alive)
- exit_kxterm();
- send_cmd("/kuip/exit");
- }
-}
-
-/***********************************************************************
- * *
- * Return widget that hold current selection. *
- * *
- ***********************************************************************/
-static Widget get_selection_owner(w)
- Widget w;
-{
- Display *dpy = XtDisplay(w);
- Widget text_w;
- Window win;
- static Atom primary_atom;
- static Atom clipboard_atom;
-
- if (!primary_atom)
- primary_atom = XmInternAtom(dpy, "PRIMARY", False);
-
- if (!clipboard_atom)
- clipboard_atom = XmInternAtom(dpy, "CLIPBOARD", False);
-
- win = XGetSelectionOwner(dpy, primary_atom);
- if (win == None)
- win = XGetSelectionOwner(dpy, clipboard_atom);
-
- text_w = XtWindowToWidget(dpy, win);
-
- return(text_w);
-}
-
-/***********************************************************************
- * *
- * Cut and paste callback routine. *
- * *
- ***********************************************************************/
-static void cut_paste_cb(widget, item, cbs)
- Widget widget;
- XtPointer item;
- XtPointer cbs;
-{
- Widget text_w;
- int i = (int) item;
- Boolean result = True;
-
- text_w = get_selection_owner(widget);
- if (!text_w) {
- XBell(UxDisplay, 0);
- return;
- }
-
- switch (i) {
- case 0:
- if (text_w == inputText)
- result = XmTextCut(text_w, CurrentTime);
- else {
- result = XmTextCopy(text_w, CurrentTime);
- XBell(UxDisplay, 0);
- }
- break;
- case 1:
- result = XmTextCopy(text_w, CurrentTime);
- break;
- case 2:
- result = XmTextPaste(inputText);
- break;
- }
-
- if (!result)
- XBell(UxDisplay, 0);
-}
-
-/***********************************************************************
- * *
- * Search a string in the transcript pad. *
- * *
- ***********************************************************************/
-static void search_cb( w, cd, cbs )
- Widget w;
- XtPointer cd;
- XmAnyCallbackStruct *cbs;
-{
- XmTextPosition pos, last_pos;
- char *text, *pattern, *p, last_char;
- Boolean case_convert = False;
- int pat_len, nfound = 0;
-
- /* unhighlight any previously found pattern */
- pos = XmTextGetLastPosition(outputText);
- XmTextSetHighlight(outputText, 0, pos, XmHIGHLIGHT_NORMAL);
-
- if (!XmToggleButtonGetState(caseToggle))
- case_convert = True;
- else {
- if (lower_text)
- free_transcript_text();
- }
-
- if (transcript_text)
- text = transcript_text;
- else {
- if (!(text = XmTextGetString(outputText)) || !*text) {
- warn_user(w, "No text to search.");
- return;
- }
- transcript_text = text;
- }
-
- if (!(pattern = XmTextGetString(searchText)) || !*pattern) {
- warn_user(w, "Specify a search pattern.");
- return;
- }
- pat_len = strlen(pattern);
-
- if (case_convert) {
- lower(pattern);
- if (!lower_text)
- lower(text);
- lower_text = True;
- }
-
- if (w == nextSearchButton) {
- /* start searching at current position */
- pos = XmTextGetCursorPosition(outputText);
- if ((p = strstr(&text[pos], pattern))) {
- nfound++;
- /* get position where pattern was found */
- pos = (XmTextPosition)(p - text);
- XmTextSetInsertionPosition(outputText, pos+pat_len);
- XmTextSetHighlight(outputText, pos, pos+pat_len,
- XmHIGHLIGHT_SELECTED);
- }
- }
- if (w == previousSearchButton) {
- last_pos = XmTextGetCursorPosition(outputText);
- last_char = text[last_pos];
- text[last_pos] = '\0';
- if ((p = strrstr(&text[0], pattern))) {
- nfound++;
- /* get position where pattern was found */
- pos = (XmTextPosition)(p - text);
- XmTextSetInsertionPosition(outputText, pos);
- XmTextSetHighlight(outputText, pos, pos+pat_len,
- XmHIGHLIGHT_SELECTED);
- }
- text[last_pos] = last_char;
- }
- if (w == allSearchButton) {
- /* start at beginning of text */
- for (p = &text[0]; (p = strstr(p, pattern)) != NULL; p++) {
- nfound++;
- /* get position where pattern was found */
- pos = (XmTextPosition)(p - text);
- XmTextSetInsertionPosition(outputText, pos);
- XmTextSetHighlight(outputText, pos, pos+pat_len,
- XmHIGHLIGHT_SELECTED);
- }
- }
- if (!nfound)
- XBell(UxDisplay, 0);
-
- /*
- * Don't free text because it will be used for next searches
- */
- /* XtFree(text); */
- XtFree(pattern);
-}
-
-/***********************************************************************
- * *
- * Popup search dialog. *
- * *
- ***********************************************************************/
-static void show_search_cb( wgt, cd, cbs )
- Widget wgt;
- XtPointer cd;
- XmAnyCallbackStruct *cbs;
-{
- static Widget dialog;
- static Dimension h_org, w_org;
- static Position x_org, y_org;
- Dimension h, w, hd, wd;
- Position x, y;
-
- if (!dialog) {
- dialog = create_searchDialog();
-
- /*
- * install callbacks
- */
- InstallMwmCloseCallback(dialog, (XtCallbackProc)cancel_cb,
- (XtPointer)dialog);
-
- XtAddCallback(closeSearchButton, XmNactivateCallback,
- (XtCallbackProc)unmanage_cb, dialog);
-
- XtAddCallback(previousSearchButton, XmNactivateCallback,
- (XtCallbackProc)search_cb, NULL);
- XtAddCallback(nextSearchButton, XmNactivateCallback,
- (XtCallbackProc)search_cb, NULL);
- XtAddCallback(allSearchButton, XmNactivateCallback,
- (XtCallbackProc)search_cb, NULL);
-
- /* store w in userData */
- XtVaSetValues(dialog, XmNuserData, wgt, NULL);
- }
-
- /*
- * get kuipIo position and place the search dialog in the lower right corner
- */
- XtVaGetValues(XtParent(kuipIo), XmNx, &x, XmNy, &y,
- XmNheight, &h,
- XmNwidth, &w,
- NULL);
- if (x != x_org || y != y_org || h != h_org || w != w_org) {
- x_org = x;
- y_org = y;
- h_org = h;
- w_org = w;
- XtVaGetValues(dialog, XmNheight, &hd, XmNwidth, &wd, NULL);
- x = x_org + w_org - wd;
- if (x < 0) x = 0;
- y = y_org + h_org - hd;
- if (y < 0) y = 0;
- XtVaSetValues(dialog, XmNx, x, XmNy, y, NULL);
- }
-
- /* popup dialog */
- XtManageChild(dialog);
-
- /*
- * If the dialog was already open, XtManageChild does nothing. In
- * this case, at least make sure the window is raised to the top
- * of the window tree (or as high as it can get).
- */
- XRaiseWindow(XtDisplay(dialog), XtWindow(XtParent(dialog)));
-
- /* when explicit set the keyboard focus to inputText */
- XmProcessTraversal(searchText, XmTRAVERSE_CURRENT);
-}
-
-/***********************************************************************
- * *
- * Show in a text widget all commands issued via the input pad. *
- * *
- ***********************************************************************/
-static void show_input_cb( wgt, cd, cbs )
- Widget wgt;
- XtPointer cd;
- XmAnyCallbackStruct *cbs;
-{
- static Widget dialog;
- static Dimension h_org, w_org;
- static Position x_org, y_org;
- Dimension h, w, hd, wd;
- Position x, y;
-
- if (!dialog) {
- dialog = create_inputTrDialog();
-
- /*
- * install callbacks
- */
- InstallMwmCloseCallback(dialog, (XtCallbackProc)cancel_cb,
- (XtPointer)dialog);
-
- XtAddCallback(closeInputTrButton, XmNactivateCallback,
- (XtCallbackProc)unmanage_cb, dialog);
-
- /* store w in userData */
- XtVaSetValues(dialog, XmNuserData, wgt, NULL);
- }
-
- /* when called via init_kuipio do not popup dialog */
- if (!cbs->event) return;
-
- /*
- * get kuipIo position and place the search dialog in the lower right corner
- */
- XtVaGetValues(XtParent(kuipIo), XmNx, &x, XmNy, &y,
- XmNheight, &h,
- XmNwidth, &w,
- NULL);
- if (x != x_org || y != y_org || h != h_org || w != w_org) {
- x_org = x;
- y_org = y;
- h_org = h;
- w_org = w;
- XtVaGetValues(dialog, XmNheight, &hd, XmNwidth, &wd, NULL);
- x = x_org + w_org - wd/2;
- if (x < 0) x = 0;
- y = y_org + 35;
- XtVaSetValues(dialog, XmNx, x, XmNy, y, NULL);
- }
-
- /* popup dialog */
- XtManageChild(dialog);
-
- /*
- * If the dialog was already open, XtManageChild does nothing. In
- * this case, at least make sure the window is raised to the top
- * of the window tree (or as high as it can get).
- */
- XRaiseWindow(XtDisplay(dialog), XtWindow(XtParent(dialog)));
-}
-
-/***********************************************************************
- * *
- * Clear line of top of the transcript pad. *
- * *
- ***********************************************************************/
-static void clear_top_cb( w, cd, cbs )
- Widget w;
- XtPointer cd;
- XmAnyCallbackStruct *cbs;
-{
- XmTextPosition pos;
-
- /* get top character and delete from beginning to top character */
- XtVaGetValues(outputText, XmNtopCharacter, &pos, NULL);
-
- XmTextReplace(outputText, (XmTextPosition)0, pos-1, NULL);
-}
-
-/***********************************************************************
- * *
- * Check output coming from application for special kxterm commands. *
- * *
- ***********************************************************************/
-static void get_escaped_cmd( w, buf )
- Widget w;
- char *buf;
-{
- static char *cache = NULL;
-
- /* cache is used in case an escaped command spans buf boundaries */
-
- if( cache == NULL ) {
- cache = XtMalloc( strlen( buf ) + 1 );
- strcpy( cache, buf );
- }
- else {
- int n = strlen( cache );
- cache = XtRealloc( cache, n + strlen( buf ) + 1 );
- strcpy( cache + n, buf );
- }
-
- while( cache[0] != '\0' ) {
- char *s;
-
- if( cache[0] == '#' && cache[1] == '@' ) {
- /* buffer starts with a command */
-
- if( (s = strchr( cache, '\n' ) ) != NULL ) {
- /* command is complete */
- *s = '\0'; /* chop off at \n */
- handle_escapes( cache );
- strcpy( cache, s + 1 );
- }
- else {
- /* wait for rest coming in */
- break;
- }
- }
-
- else if( (s = strstr( cache, "\n#@" )) != NULL ) {
- /* command preceded by normal text */
- s[1] = '\0';
- insert_string( w, cache, !hold_output );
- cache[0] = '#';
- strcpy( cache + 1, s + 2 );
- }
-
- else if( cache[strlen(cache)-1] == '#' ) {
- if( (s = strrchr( cache, '\n' )) != NULL ) {
- /* output complete lines */
- char c = s[1];
- s[1] = '\0';
- insert_string( w, cache, !hold_output );
- cache[0] = c;
- strcpy( cache + 1, s + 2 );
- }
- /* wait because @ may follow with next buffer */
- break;
- }
-
- else {
- /* it is just plain text */
- insert_string( w, cache, !hold_output );
- cache[0] = '\0';
- }
- }
-}
-
-/***********************************************************************
- * *
- * Connection to application is broken. *
- * *
- ***********************************************************************/
-static void pipe_broken()
-{
- application_alive = False;
- if( user_said_exit ) {
- exit_kxterm();
- }
- else {
- XSetWindowAttributes attrs;
-
- insert_string(outputText, "\n\n\
-*** Application has died or is running in a loop. ***\n\n\
-Kxterm has been disconnected from application.\n\
-Select Exit from the File menu to exit Kxterm.\n\n", True);
-
- attrs.cursor = main_cursor;
- XChangeWindowAttributes(UxDisplay, XtWindow(kuipIo), CWCursor, &attrs);
-
- XtRemoveInput(input_id);
- }
-}
-
-
-/***********************************************************************
- * *
- * Write output coming from the application in the outputText *
- * widget. *
- * *
- ***********************************************************************/
-static void get_from_application( w, fid, id )
- Widget w;
- int *fid;
- XtInputId *id;
-{
- char buf[BUFSIZ];
- char *s;
- int nbytes;
- static int max_buf = BUFSIZ;
- static char *bigbuf;
-
- if (!bigbuf)
- bigbuf = XtCalloc(max_buf, 1);
-
- /*
- * Get all pending input and write to the outputText widget.
- */
-#ifdef VMS
- while ((nbytes = MbxRead(buf, BUFSIZ-1, w)) > 0) {
-#else /* VMS */
- while ((nbytes = read(*fid, buf, BUFSIZ-1)) > 0) {
-#endif /* VMS */
- /*
- * Null terminate the string.
- */
- buf[nbytes] = '\0';
-
- while (strlen(bigbuf) + nbytes + 1 > max_buf) {
- max_buf += INC_LENGTH;
- bigbuf = XtRealloc(bigbuf, max_buf);
- }
-
- strcat(bigbuf, buf);
-
- /* break loop if last character is either a \n ot STX */
- if (buf[nbytes-1] == '\n' || buf[nbytes-1] == STX)
- break;
- }
-
-#ifndef vms
- if (nbytes == 0) {
- pipe_broken();
- return;
- }
-#endif
-
- /*
- * If STX character (i.e. application ready), send next command
- * in input buffer and remove STX character from buffer.
- */
- if ((s = strchr(bigbuf, STX))) {
- flow_control = True;
- stop_sending = False;
- show_prompt();
- flush_input(0);
- strcpy(s, s+1);
- }
-
- /*
- * Check output coming from application for special kxterm commands.
- */
- get_escaped_cmd(w, bigbuf);
- bigbuf[0] = '\0';
-}
-
-/***********************************************************************
- * *
- * Toggle the Hold button. *
- * *
- ***********************************************************************/
-static void toggle_hold_button( w, cd, cbs )
- Widget w;
- XtPointer cd;
- XmAnyCallbackStruct *cbs;
-{
- if (w == inputHoldButton) {
- if (!hold_input)
- hold_input = True;
- else {
- hold_input = False;
- flush_input(0);
- }
- TogglePushButton(w, hold_input);
- } else {
- if (!hold_output)
- hold_output = True;
- else
- hold_output = False;
- TogglePushButton(w, hold_output);
- }
-}
-
-/***********************************************************************
- * *
- * Input callback routine. This routine tells the input_changed_cb *
- * to flush the input when a \n has been typed or pasted in. *
- * *
- ***********************************************************************/
-static void input_cb( w, cd, cbs )
- Widget w;
- XtPointer cd;
- XmTextVerifyCallbackStruct *cbs;
-{
- static Boolean handling_newline = False;
-
- dont_move = 0;
- do_flush = False;
-
- /*
- * Prevent deletion of the prompt.
- */
- if (application_prompt && !changing_text) {
- char *input = XmTextGetString(inputText);
- XmTextPosition pos = strlen(application_prompt);
- if (!strncmp(input, application_prompt, (size_t)pos) &&
- cbs->startPos < pos) {
- XtFree(input);
- if (cbs->endPos > pos) {
- char *s = XtCalloc(cbs->text->length+1, 1);
- strncat(s, cbs->text->ptr, cbs->text->length);
- XmTextReplace(inputText, pos, cbs->endPos, s);
- XmTextSetInsertionPosition(inputText, cbs->endPos);
- XtFree(s);
- }
- cbs->doit = False;
- return;
- }
- XtFree(input);
- }
-
- if (!cbs->text->length)
- return;
-
- /*
- * When input pad not in hold mode force \n character at end of line,
- * like korn shell.
- */
- if (!handling_newline && !hold_input &&
- cbs->text->length == 1 && cbs->text->ptr[0] == '\n') {
- char *s, *s1, *input = XmTextGetString(inputText);
- XmTextPosition pos;
- if ( (s = strchr(input,'\n')) != NULL )
- pos = s-input;
- else
- pos = XmTextGetLastPosition(inputText);
-
- handling_newline = True; /* flag to prevent recursion */
- s1 = XtCalloc(cbs->text->length+1, 1);
- strncat(s1, cbs->text->ptr, cbs->text->length);
- XmTextInsert(inputText, pos, s1);
- XmTextSetInsertionPosition(inputText, pos+1);
- XtFree(s1);
- handling_newline = False;
-
- XtFree(input);
- cbs->doit = False;
- return;
- }
-
- if (strchr(cbs->text->ptr, '\n'))
- do_flush = True;
-}
-
-/***********************************************************************
- * *
- * Input cursor move callback routine. When the cursor is moved down *
- * a line the line will be submitted. *
- * *
- ***********************************************************************/
-static void input_move_cb( w, cd, cbs )
- Widget w;
- XtPointer cd;
- XmTextVerifyCallbackStruct *cbs;
-{
- XmTextPosition pos;
-
- /* prevent recursive calling */
- if (changing_text) return;
-
- if (dont_move > 0) {
- cbs->doit = False;
- dont_move--;
- return;
- }
-
- /*
- * Prevent the cursor from moving into the prompt.
- */
- if (application_prompt) {
- char *input = XmTextGetString(inputText);
- pos = strlen(application_prompt);
- if (!strncmp(input, application_prompt, (size_t)pos) &&
- cbs->newInsert < pos) {
- XtFree(input);
- XmTextSetInsertionPosition(inputText, pos);
- cbs->doit = False;
- return;
- }
- XtFree(input);
- }
-
- /*
- * If the cursor is moved down, flush the buffer.
- *
- * newInsert is not correct if the cursor is moved down to a shorter line
- * using the next-line() or process-down() actions. In that case the
- * new cursor position is the old position + the line length. To correct
- * this the widget calls two more times the cursor position routines
- * (that in turn call this callback). Check what 1.2 is doing with this.
- */
- if (cbs->newInsert > cbs->currInsert) {
- pos = cbs->newInsert;
-
- flush_input(&cbs->newInsert);
-
- /*
- * If pos has been changed in flush_input cancel motion that
- * triggered this callback
- */
- if (pos != cbs->newInsert)
- cbs->doit = False;
- }
-}
-
-/***********************************************************************
- * *
- * Input changed callback routine. If a piece of text is inserted *
- * all lines terminated by \n will be submitted (unless the Hold *
- * button is active). The global flag changing_text prevents *
- * recursive calling of this routine when deleting text (in input_cb *
- * and flush_input. *
- * *
- ***********************************************************************/
-static void input_changed_cb( w, cd, cbs )
- Widget w;
- XtPointer cd;
- XmAnyCallbackStruct *cbs;
-{
- if (changing_text) return;
-
- if (do_flush) {
- flush_input(0);
- do_flush = False;
- }
-}
-
-/***********************************************************************
- * *
- * Action routine that will send a signal to the parent process. *
- * *
- ***********************************************************************/
-static void SendSignal( w, event, argv, args )
- Widget w;
- XEvent *event;
- String *argv;
- Cardinal *args;
-{
- if (*args == 1 && !strcmp(argv[0], "SIGINT")) {
- if (parent_pid) {
-#ifdef vms
- int kxterm_lock[2];
- int sigint_lock[2];
- char lock_name[32];
- struct dsc$descriptor_s lock;
-
- /*
- * We cannot use kill() to send a SIGINT from kxterm to the main
- * process. Instead we requests the lock which calls the blocking AST
- * in the main process.
- */
-
- sprintf( lock_name, "KXTERM%d", parent_pid );
- var_descriptor( lock, lock_name );
- sys$enqw( 0, LCK$K_EXMODE, kxterm_lock, 0,
- &lock, 0, NULL, 0, NULL, PSL$C_USER, 0 );
-
- sprintf( lock_name, "SIGINT%d", parent_pid );
- var_descriptor( lock, lock_name );
- sys$enqw( 0, LCK$K_EXMODE, sigint_lock, 0,
- &lock, 0, NULL, 0, NULL, PSL$C_USER, 0 );
-
- sys$deq( sigint_lock[1], NULL, PSL$C_USER, 0 );
- sys$deq( kxterm_lock[1], NULL, PSL$C_USER, 0 );
-#else
- kill(parent_pid, SIGINT);
-#endif
- }
- } else
- fprintf(stderr, "%s: Wrong signal specified.\n", prog_name);
-}
-
-/***********************************************************************
- * *
- * Action routine that will get the previous command into *
- * the input pad. *
- * *
- ***********************************************************************/
-static void GetPreviousCommand( w, event, argv, args )
- Widget w;
- XEvent *event;
- String *argv;
- Cardinal *args;
-{
- XmTextPosition pos;
- char *s, *text, *line;
- static int line_cnt = 0;
- static int line_max = -999999;
-
- if (w == inputText) {
-
- /*
- * Return if input is on hold or if input pad contains more than one line.
- */
- if (hold_input) return;
-
- s = XmTextGetString(inputText);
- if (strchr(s, '\n')) {
- XtFree(s);
- return;
- }
-
- pos = strlen(s);
- XtFree(s);
-
- /* get input transcript text */
- if (input_tr_text)
- text = input_tr_text;
- else {
- if (!(text = XmTextGetString(inputTrText)) || !*text)
- return;
- input_tr_text = text;
- line_cnt = 0;
- line_max = -999999;
- }
-
- if (*args == 1 && !strcmp(argv[0], "NEXT"))
- line_cnt++;
- else
- line_cnt--;
-
- if (line_cnt > 0) {
- line_cnt = 0;
- XBell(UxDisplay, 0);
- return;
- }
-
- if (line_cnt < line_max) {
- line_cnt = line_max;
- XBell(UxDisplay, 0);
- return;
- }
-
- line = get_line(text, line_cnt, LINE);
-
- if (application_prompt)
- XmTextReplace(inputText, (XmTextPosition)strlen(application_prompt),
- pos, line);
- else
- XmTextReplace(inputText, (XmTextPosition) 0, pos, line);
-
- pos = XmTextGetLastPosition(inputText);
- XmTextSetInsertionPosition(inputText, pos);
-
- if (!line && line_cnt < 0) {
- XBell(UxDisplay, 0);
- line_max = line_cnt;
- }
-
- XtFree(line);
- }
-}
-
-/***********************************************************************
- * *
- * Action routine that will resubmit the last executed command. *
- * *
- ***********************************************************************/
-static void ResubmitCommand( w, event, argv, args )
- Widget w;
- XEvent *event;
- String *argv;
- Cardinal *args;
-{
- XmTextPosition pos;
- char *text, *cmd, *line = NULL;
-
- if (w == inputText) {
-
- cmd = last_command;
-
- } else {
-
- int l;
-
- if (lower_text)
- free_transcript_text();
-
- if (transcript_text)
- text = transcript_text;
- else {
- if (!(text = XmTextGetString(outputText)) || !*text)
- return;
- transcript_text = text;
- }
- pos = XmTextGetInsertionPosition(outputText);
- line = get_line(text, (int)pos, CURSOR);
- if ((l = begins_with_prompt(line)))
- cmd = line + l;
- else
- cmd = line;
-
- }
-
- if (!strempty(cmd)) {
- if (*args == 1 && !strcmp(argv[0], "EXEC")) {
- char *s = XtMalloc(strlen(cmd) + 2);
- sprintf(s, "%s\n", cmd);
- insert_string(inputText, s, True);
- XtFree(s);
- } else
- insert_string(inputText, cmd, True);
- }
-
- XtFree(line);
-}
-
-/***********************************************************************
- * *
- * Toggle the Hold button. *
- * *
- ***********************************************************************/
-static void ToggleHold( w, event, argv, args )
- Widget w;
- XEvent *event;
- String *argv;
- Cardinal *args;
-{
- XmAnyCallbackStruct cbs;
-
- cbs.reason = 0;
- cbs.event = (XEvent *) NULL;
-
- if (w == inputText)
- XtCallCallbacks(inputHoldButton, XmNactivateCallback, &cbs);
- else
- XtCallCallbacks(outputHoldButton, XmNactivateCallback, &cbs);
-}
-
-/***********************************************************************
- * *
- * Watch the state of the window (iconic or normal). *
- * If the state becomes normal send the command #@iconify(MAP) to *
- * the application. KUIP will interpret this and de-iconify the *
- * toplevel shells of the application. *
- * *
- ***********************************************************************/
-static void state_watcher( w, client_data, event )
- Widget w;
- XtPointer client_data;
- XConfigureEvent *event;
-{
- char cmd[80];
- Position x, y;
- Dimension width, height;
- static int init = 0;
-
- switch (event->type) {
- case MapNotify: /* de-iconify */
- /*
- * De-iconfy all toplevel shells when kxterm was iconified using
- * the Iconify menu item.
- */
- if (kxterm_iconic) {
- sprintf(cmd, "%siconify(MAP)\n", ESCAPE);
- send_kxterm_cmd(cmd);
- kxterm_iconic = False;
- }
- break;
- case UnmapNotify: /* iconify */
- break;
- case ConfigureNotify:
- XtVaGetValues(XtParent(kuipIo), XmNx, &x, XmNy, &y,
- XmNwidth, &width, XmNheight, &height, NULL);
- /*
- * The first time this routine is called with the real size of the
- * toplevel shell, the other times the size of the toplevel shell
- * has been reduced by the WM decorations.
- */
- if (init) {
- sprintf(cmd, "%sgeometry(%d,%d,%d,%d)\n", ESCAPE, x, y,
- width, height);
- send_kxterm_cmd(cmd);
- }
-
- if (!init)
- init++;
- break;
- default:
- break;
- }
-}
-
-/***********************************************************************
- * *
- * Initialize kuipIo interface. *
- * *
- ***********************************************************************/
-static void init_kuipio()
-{
- Pixmap pixmap;
- Display *display;
- XColor color_defs[2];
- Pixmap hourglass_pixmap, hourglass_mask_pixmap;
- XmAnyCallbackStruct cbs;
-
- /* create interface */
- kuipIo = create_kuipIo();
-
- /* set Kxterm icon */
- display = XtDisplay(kuipIo);
- pixmap = XCreateBitmapFromData(display, DefaultRootWindow(display),
- kxterm_bits, kxterm_width, kxterm_height);
- XtVaSetValues(XtParent(kuipIo), XmNiconPixmap, pixmap, NULL);
-
- /* set Kxterm cursors */
- main_cursor = XCreateFontCursor(UxDisplay, XC_left_ptr);
- /* build wait cursor with hourglass pixmap */
- color_defs[0].pixel = BlackPixel(UxDisplay, UxScreen);
- color_defs[1].pixel = WhitePixel(UxDisplay, UxScreen);
- XQueryColors(UxDisplay, UxColormap, color_defs, 2);
- hourglass_pixmap = XCreatePixmapFromBitmapData(UxDisplay,
- DefaultRootWindow(UxDisplay), hourglass_bits,
- hourglass_width, hourglass_height,
- WhitePixel(UxDisplay, UxScreen),
- BlackPixel(UxDisplay, UxScreen), 1);
- hourglass_mask_pixmap = XCreatePixmapFromBitmapData(UxDisplay,
- DefaultRootWindow(UxDisplay), hourglass_mask_bits,
- hourglass_mask_width, hourglass_mask_height,
- WhitePixel(UxDisplay, UxScreen),
- BlackPixel(UxDisplay, UxScreen), 1);
- wait_cursor = XCreatePixmapCursor(UxDisplay, hourglass_pixmap,
- hourglass_mask_pixmap,
- &color_defs[0], &color_defs[1],
- hourglass_x_hot, hourglass_y_hot);
-
- /* add callback to window manager close button */
- InstallMwmCloseCallback(kuipIo, (XtCallbackProc)exit_cb,
- (XtPointer)NULL);
-
- /* install new action functions */
- XtAppAddActions(UxAppContext, actions, XtNumber(actions));
-
- /* override translation table for inputText and outputText widget */
- XtOverrideTranslations(inputText,
- XtParseTranslationTable(translation_table));
- XtOverrideTranslations(outputText,
- XtParseTranslationTable(translation_table));
-
- /* add File menu callbacks */
- XtAddCallback(aboutButton, XmNactivateCallback,
- (XtCallbackProc)about_cb, NULL);
- XtAddCallback(aboutAppButton, XmNactivateCallback,
- (XtCallbackProc)about_cb, NULL);
- XtAddCallback(saveTransButton, XmNactivateCallback,
- (XtCallbackProc)save_cb, NULL);
- XtAddCallback(saveTransAsButton, XmNactivateCallback,
- (XtCallbackProc)show_save_cb, NULL);
- XtSetSensitive(printButton, False);
- XtAddCallback(killButton, XmNactivateCallback, (XtCallbackProc)exit_cb,
- NULL);
- XtAddCallback(exitButton, XmNactivateCallback, (XtCallbackProc)exit_cb,
- NULL);
-
- /* add Edit menu callbacks */
- XtAddCallback(cutButton, XmNactivateCallback,
- (XtCallbackProc)cut_paste_cb, (int *)0);
- XtAddCallback(copyButton, XmNactivateCallback,
- (XtCallbackProc)cut_paste_cb, (int *)1);
- XtAddCallback(pasteButton, XmNactivateCallback,
- (XtCallbackProc)cut_paste_cb, (int *)2);
- XtAddCallback(searchButton, XmNactivateCallback,
- (XtCallbackProc)show_search_cb, NULL);
-
- /* add View menu callbacks */
- XtAddCallback(showInputButton, XmNactivateCallback,
- (XtCallbackProc)show_input_cb, NULL);
-
- /* create input transcript dialog, but do not popup dialog */
- cbs.reason = 0;
- cbs.event = (XEvent *) NULL;
- XtCallCallbacks(showInputButton,XmNactivateCallback, &cbs);
-
- /* add Option menu callbacks */
- XtAddCallback(clearTrButton, XmNactivateCallback,
- (XtCallbackProc)clear_top_cb, NULL);
-
- /* add Help menu callbacks */
- XtAddCallback(helpKxtermButton, XmNactivateCallback,
- (XtCallbackProc)help_cb, (int *)0);
- XtAddCallback(helpResourceButton, XmNactivateCallback,
- (XtCallbackProc)help_cb, (int *)1);
- XtAddCallback(helpEditButton, XmNactivateCallback,
- (XtCallbackProc)help_cb, (int *)2);
-
- /* hold push button callbacks */
- XtAddCallback(inputHoldButton, XmNactivateCallback,
- (XtCallbackProc)toggle_hold_button, NULL);
- XtAddCallback(outputHoldButton, XmNactivateCallback,
- (XtCallbackProc)toggle_hold_button, NULL);
-
- /* input, output text callbacks */
- XtAddCallback(inputText, XmNmodifyVerifyCallback, (XtCallbackProc)input_cb,
- NULL);
- XtAddCallback(inputText, XmNmotionVerifyCallback,
- (XtCallbackProc)input_move_cb, NULL);
- XtAddCallback(inputText, XmNvalueChangedCallback,
- (XtCallbackProc)input_changed_cb, NULL);
-
- /*
- * Add application name to some menu buttons
- */
- if (application_name) {
- char *s = XtMalloc(strlen(application_name) + 10);
- sprintf(s, "About %s...", application_name);
- XtVaSetValues(aboutAppButton, RES_CONVERT(XmNlabelString, s), NULL);
-
- sprintf(s, "Kill %s", application_name);
- XtVaSetValues(killButton, RES_CONVERT(XmNlabelString, s), NULL);
- XtFree(s);
- } else
- XtUnmanageChild(aboutAppButton);
-
- /*
- * Add tab groups for using with explicit keyboard focus policy.
- */
- TurnOffSashTraversal(panedWindow);
- XtVaSetValues(inputHoldButton, XmNtraversalOn, False,
- XmNnavigationType, XmNONE, NULL);
- XtVaSetValues(outputHoldButton, XmNtraversalOn, False,
- XmNnavigationType, XmNONE, NULL);
- XtVaSetValues(inputText, XmNtraversalOn, True,
- XmNnavigationType, XmTAB_GROUP, NULL);
- XtVaSetValues(outputText, XmNtraversalOn, True,
- XmNnavigationType, XmTAB_GROUP, NULL);
-
- /* popup interface */
- UxPopupInterface(kuipIo, XtGrabNone);
-
- /*
- * when explicit set the keyboard focus to inputText (after the
- * interface has been poped up)
- */
- XmProcessTraversal(inputText, XmTRAVERSE_CURRENT);
-}
-
-/***********************************************************************
- * *
- * Get non X11 command line options. *
- * *
- ***********************************************************************/
-static void get_options( argc, argv )
- int argc;
- char **argv;
-{
- int c;
- char *arg, *opt, *s;
-
- prog_name = strdup(argv[0]);
-
- /* scan options */
- while (--argc) {
- arg = *++argv;
- c = *arg;
- if (c == '-') {
- opt = ++arg;
- if (!strcmp(opt, "pid")) {
- arg = *++argv; --argc;
- parent_pid = atoi(arg);
- }
- else if (!strcmp(opt, "prompt")) {
- arg = *++argv; --argc;
- application_prompt = strdup(arg);
- if ((s = strchr(application_prompt, '>'))) {
- application_name = calloc((s-application_prompt)+1, 1);
- strncpy(application_name, application_prompt,
- s-application_prompt);
- }
- }
- else {
- fprintf(stderr,"\
-Usage: %s [class] [-name name] [-title title] [-n iconname]\n\
- [-geometry geom] [-font fn] [-tfont fn]\n\
- [-iconic] [-pid pid] [-prompt prompt]\n",
- prog_name);
- exit(1);
- }
- }
- }
-}
-
-
-#ifdef vms
-/***********************************************************************
- * *
- * Check if application is dead or alive. *
- * *
- ***********************************************************************/
-static void application_died( int ppid )
-{
- if( ppid != 0 ) {
- static int alive_lock[2];
- char lock_name[32];
- struct dsc$descriptor_s lock;
-
- application_alive = True;
- sprintf( lock_name, "ALIVE%d", ppid );
- var_descriptor( lock, lock_name );
- sys$enq( 0, LCK$K_EXMODE, alive_lock, 0,
- &lock, 0, application_died, 0, NULL, PSL$C_USER, 0 );
- }
- else {
- /* the lock has been granted because the application has died */
- pipe_broken();
- }
-}
-#endif
-
-
-/***********************************************************************
- * *
- * Main program. *
- * *
- ***********************************************************************/
-int main( argc, argv )
- unsigned int argc;
- char **argv;
-{
-
-#if XtSpecificationRelease <= 4 /* X11R4 */
- Cardinal xtargc = argc;
-#else /* X11R5 */
- int xtargc = argc;
-#endif
- char *class = "KXterm";
-
- if (argv[1] && argv[1][0] != '-')
- class = argv[1];
-
- /* init toolkit */
- UxTopLevel = XtAppInitialize(&UxAppContext, class,
- options, XtNumber(options),
- &xtargc, argv, fallbacks, NULL, 0);
- get_options(xtargc, argv);
-
- UxDisplay = XtDisplay(UxTopLevel);
- UxScreen = XDefaultScreen(UxDisplay);
- UxColormap = DefaultColormap(UxDisplay, UxScreen);
-
- XtVaSetValues(UxTopLevel,
- XmNmappedWhenManaged, False,
- XmNx, DisplayWidth(UxDisplay, UxScreen)/2,
- XmNy, DisplayWidth(UxDisplay, UxScreen)/2,
- XmNwidth, 1,
- XmNheight, 1,
- NULL);
-
- /* create and manage interface */
- init_kuipio();
-
- /* open tmpfile to save transcript pad */
- if (!(tfp = tmpfile())) {
- insert_string(outputText,
- "*** Cannot open tmp file to save transcript pad ***\n",
- False);
- XtSetSensitive(saveTransButton, False);
- XtSetSensitive(saveTransAsButton, False);
- }
- else {
- tr_tmp_file = True;
- /* since we don't know the filename created by tmpfile(), make it
- * the null string: */
- strcpy(transcript_file, "");
- }
-
- /* unbuffered I/O */
- setbuf(stdin, NULL);
- setbuf(stdout, NULL);
-
- /*
- * Register kxterm actions
- */
- kxterm_add_actions(kxterm_actions);
-
- /*
- * Install an event handler that looks for StructureNotify events
- * to see if kxterm is being iconified, de-iconified, resized or moved.
- */
- XtAddEventHandler(XtParent(kuipIo), StructureNotifyMask, False,
- (XtEventHandler)state_watcher, (XtPointer)NULL);
-
- /*
- * Add callback get_from_application() -- invoked when input is available
- * from stdin.
- */
-#ifdef VMS
- application_died( parent_pid );
-
- input_id = XtAppAddInput(UxAppContext,
- MBX_EVENT_FLAG, /* On OpenVMS, wait on event flag */
- &MbxMessage.ioStatus, /* I/O Status Block */
- (XtInputCallbackProc)get_from_application,
- outputText);
- MbxSetup();
-#else /* VMS */
- input_id = XtAppAddInput(UxAppContext, fileno(stdin),
- (XtPointer)XtInputReadMask,
- (XtInputCallbackProc)get_from_application,
- outputText);
-#endif /* VMS */
-
- /* send parent a message that we are ready to receive from its stdout */
- printf( "\n" );
-
- /* kxterm is ready for input; show prompt */
- show_prompt();
-
- /* start loop */
- XtRealizeWidget(UxTopLevel);
- XtAppMainLoop(UxAppContext);
-
- return 0;
-}
-
-
diff --git a/src/packlib/kuip/programs/kxterm/menu.c b/src/packlib/kuip/programs/kxterm/menu.c
deleted file mode 100644
index 5cfcdf4..0000000
--- a/src/packlib/kuip/programs/kxterm/menu.c
+++ /dev/null
@@ -1,272 +0,0 @@
-/*
- * $Id: menu.c,v 1.1.1.1 1996/03/08 15:33:04 mclareni Exp $
- *
- * $Log: menu.c,v $
- * Revision 1.1.1.1 1996/03/08 15:33:04 mclareni
- * Kuip
- *
- */
-/*CMZ : 2.06/03 10/01/95 09.18.41 by N.Cremel*/
-/*-- Author : Fons Rademakers 8/01/93*/
-#include <stdio.h>
-#include <string.h>
-#include <X11/StringDefs.h>
-#include <X11/Intrinsic.h>
-#include <Xm/Xm.h>
-#include <Xm/LabelG.h>
-#include <Xm/PushBG.h>
-#include <Xm/PushB.h>
-#include <Xm/ToggleB.h>
-#include <Xm/ToggleBG.h>
-#include <Xm/SeparatoG.h>
-#include <Xm/RowColumn.h>
-#include <Xm/MenuShell.h>
-#include <Xm/CascadeBG.h>
-
-#include "menu.h"
-#include "utils.h"
-
-
-/***********************************************************************
- * *
- * Fill MenuItem array. *
- * Function returns the number of items stored in the array, 0 when *
- * an error occured. *
- * *
- ***********************************************************************/
-int add_menu_items( item_string, push_cb, toggle_cb, items, max_items )
- char *item_string;
- void (*push_cb)();
- void (*toggle_cb)();
- MenuItem *items;
- int max_items;
-{
- char *str, *sav, *s1, *s2, *class;
- int item = 0;
- int i, l;
-
- l = strlen(item_string);
- if (*(item_string+l-1) != '\n') {
- str = XtMalloc(l+2);
- sprintf(str, "%s\n", item_string);
- } else {
- str = XtMalloc(l+1);
- strcpy(str, item_string);
- }
- sav = str;
-
- while ((s1 = strchr(str, '\n'))) {
- s1++;
- items[item].label = NULL;
- items[item].class = NULL;
- items[item].set = False;
- items[item].mnemonic = '\0';
- items[item].accelerator = NULL;
- items[item].accel_text = NULL;
- items[item].callback = NULL;
- items[item].callback_data = NULL;
- items[item].subitems = NULL;
- i = 0;
- s2 = strtok(str, ":\n");
- while (s2) {
- switch (i) {
- case 0:
- items[item].label = strip(s2);
- break;
- case 1:
- items[item].callback_data = (caddr_t) strip(s2);
- break;
- case 2:
- class = strip(s2);
- lower(class);
- if (*class == 'b') {
- items[item].class = &xmPushButtonGadgetClass;
- items[item].callback = push_cb;
- }
- else if (*class == 't') {
- items[item].class = &xmToggleButtonGadgetClass;
- items[item].callback = toggle_cb;
- if (strchr(class, '1'))
- items[item].set = True;
- }
- else if (*class == 's')
- items[item].class = &xmSeparatorGadgetClass;
- else if (*class == 'l')
- items[item].class = &xmLabelGadgetClass;
- XtFree(class);
- break;
- case 3:
- class = strip(s2);
- items[item].mnemonic = *class;
- XtFree(class);
- break;
- case 4:
- items[item].accelerator = strip(s2);
- break;
- case 5:
- items[item].accel_text = strip(s2);
- break;
- }
- if (s1 == strchr(s2, '\0')+1) break;
- i++;
- s2 = strtok((char *)NULL, ":\n");
- }
- if (items[item].callback_data && !*((int*)(items[item].callback_data))) {
- XtFree(items[item].callback_data);
- items[item].callback_data = NULL;
- }
- if (!items[item].callback_data) {
- items[item].callback_data = XtCalloc(strlen(items[item].label)+1, 1);
- strcpy(items[item].callback_data, items[item].label);
- }
- if (!items[item].class) {
- items[item].class = &xmPushButtonGadgetClass;
- items[item].callback = push_cb;
- }
- str = s1;
- item++;
- if (item >= max_items) {
- item--;
- items[item].label = NULL;
- XtFree(sav);
- return ++item;
- }
- items[item].label = NULL;
- if (!*s1) break;
- }
- XtFree(sav);
-
- return item;
-}
-
-/***********************************************************************
- * *
- * Build popup, option and pulldown menus, depending on the menu_type. *
- * It may be XmMENU_PULLDOWN, XmMENU_OPTION or XmMENU_POPUP. Pulldowns *
- * return the CascadeButton that pops up the menu. Popups return the *
- * menu. Option menus are created, but the RowColumn that acts as the *
- * option "area" is returned unmanaged. (The user must manage it.) *
- * Pulldown menus are built from cascade buttons, so this function *
- * also builds pullright menus. The function also adds the right *
- * callback for PushButton or ToggleButton menu items. *
- * *
- ***********************************************************************/
-Widget BuildMenu( parent, menu_type, menu_title, menu_mnemonic,
- items, add_to_menu )
- Widget parent;
- int menu_type;
- char *menu_title;
- int menu_mnemonic;
- MenuItem *items;
- int add_to_menu;
-{
- Widget menu, cascade, widget;
- char *name;
- int i;
- XmString str;
-
- if (add_to_menu) {
- menu = parent;
- } else {
- name = XtCalloc(strlen(menu_title) + 6, 1);
- if (menu_type == XmMENU_PULLDOWN || menu_type == XmMENU_OPTION) {
- sprintf(name, "%sMenu", menu_title);
- menu = XmCreatePulldownMenu(parent, name, NULL, 0);
- } else if (menu_type == XmMENU_POPUP) {
- sprintf(name, "%sPopup", menu_title);
- menu = XmCreatePopupMenu(parent, name, NULL, 0);
- } else {
- XtWarning("Invalid menu type passed to BuildMenu()");
- XtFree(name);
- return NULL;
- }
- XtFree(name);
-
- /* Pulldown menus require a cascade button to be made */
- if (menu_type == XmMENU_PULLDOWN) {
- str = XmStringCreateSimple(menu_title);
- cascade = XtVaCreateManagedWidget(menu_title,
- xmCascadeButtonGadgetClass, parent,
- XmNsubMenuId, menu,
- XmNlabelString, str,
- XmNmnemonic, menu_mnemonic,
- NULL);
- XmStringFree(str);
- } else if (menu_type == XmMENU_OPTION) {
- /* Option menus are a special case, but not hard to handle */
- Arg args[2];
- str = XmStringCreateSimple(menu_title);
- XtSetArg(args[0], XmNsubMenuId, menu);
- XtSetArg(args[1], XmNlabelString, str);
- /*
- * This really isn't a cascade, but this is the widget handle
- * we're going to return at the end of the function.
- */
- cascade = XmCreateOptionMenu(parent, menu_title, args, 2);
- XmStringFree(str);
- }
- }
-
- /* Now add the menu items */
- for (i = 0; items[i].label != NULL; i++) {
- /*
- * If subitems exist, create the pull-right menu by calling this
- * function recursively. Since the function returns a cascade
- * button, the widget returned is used..
- */
- if (items[i].subitems)
- if (menu_type == XmMENU_OPTION) {
- XtWarning("You can't have submenus from option menu items.");
- continue;
- } else
- widget = BuildMenu(menu, XmMENU_PULLDOWN,
- items[i].label, items[i].mnemonic,
- items[i].subitems, False);
- else
- widget = XtVaCreateManagedWidget(items[i].label,
- *items[i].class, menu,
- NULL);
-
- /*
- * If toggle button set default state, set can only be true when
- * class = xmToggleButtonWidgetClass
- */
- if (items[i].set)
- XtVaSetValues(widget, XmNset, True, NULL);
-
- /*
- * Whether the item is a real item or a cascade button with a
- * menu, it can still have a mnemonic.
- */
- if (items[i].mnemonic)
- XtVaSetValues(widget, XmNmnemonic, items[i].mnemonic, NULL);
-
- /*
- * Any item can have an accelerator, except cascade menus. But,
- * we don't worry about that; we know better in our declarations.
- */
- if (items[i].accelerator) {
- str = XmStringCreateSimple(items[i].accel_text);
- XtVaSetValues(widget,
- XmNaccelerator, items[i].accelerator,
- XmNacceleratorText, str,
- NULL);
- XmStringFree(str);
- }
-
- if (items[i].callback)
- XtAddCallback(widget,
- (items[i].class == &xmToggleButtonWidgetClass ||
- items[i].class == &xmToggleButtonGadgetClass) ?
- XmNvalueChangedCallback : /* ToggleButton class */
- XmNactivateCallback, /* PushButton class */
- items[i].callback, items[i].callback_data);
- }
-
- /*
- * For popup menus, just return the menu; pulldown menus, return
- * the cascade button; option menus, return the thing returned
- * from XmCreateOptionMenu(). This isn't a menu, or a cascade button!
- */
- return menu_type == XmMENU_POPUP ? menu : cascade;
-}
diff --git a/src/packlib/kuip/programs/kxterm/menu.h b/src/packlib/kuip/programs/kxterm/menu.h
deleted file mode 100644
index 25108bd..0000000
--- a/src/packlib/kuip/programs/kxterm/menu.h
+++ /dev/null
@@ -1,44 +0,0 @@
-/*
- * $Id: menu.h,v 1.2 1996/04/11 10:04:23 cernlib Exp $
- *
- * $Log: menu.h,v $
- * Revision 1.2 1996/04/11 10:04:23 cernlib
- * Remobe fortran comment lines
- *
- * Revision 1.1.1.1 1996/03/08 15:33:03 mclareni
- * Kuip
- *
- */
-/***********************************************************************
- * *
- * Menu.h, contains the prototypes for the menu building routines, *
- * and the defintion of the MenuItem data type. *
- * *
- ***********************************************************************/
-#ifndef _menu_h
-#define _menu_h
-
-typedef struct _menu_item {
- char *label;
- WidgetClass *class;
- Boolean set; /* default setting in case of toggle button */
- char mnemonic;
- char *accelerator;
- char *accel_text;
- void (*callback)();
- caddr_t callback_data;
- struct _menu_item *subitems;
-} MenuItem;
-
-extern int add_menu_items(
-#ifndef _NO_PROTO
- char *, void (*)(), void (*)(), MenuItem *, int
-#endif
- );
-extern Widget BuildMenu(
-#ifndef _NO_PROTO
- Widget, int, char *, int, MenuItem *, int
-#endif
- );
-
-#endif /* _menu_h */
diff --git a/src/packlib/kuip/programs/kxterm/saveastrdial.c b/src/packlib/kuip/programs/kxterm/saveastrdial.c
deleted file mode 100644
index 0a0c3dd..0000000
--- a/src/packlib/kuip/programs/kxterm/saveastrdial.c
+++ /dev/null
@@ -1,143 +0,0 @@
-/*
- * $Id: saveastrdial.c,v 1.1.1.1 1996/03/08 15:33:04 mclareni Exp $
- *
- * $Log: saveastrdial.c,v $
- * Revision 1.1.1.1 1996/03/08 15:33:04 mclareni
- * Kuip
- *
- */
-/*CMZ : 2.00/10 19/01/93 17.50.58 by Rene Brun*/
-/*-- Author :*/
-
-/*******************************************************************************
- saveAsTrDialog.c
- (Generated from interface file saveAsTrDialog.i)
-*******************************************************************************/
-
-#include <stdio.h>
-#include <Xm/Xm.h>
-#include <Xm/DialogS.h>
-#include <Xm/MenuShell.h>
-#include "uxxt.h"
-
-#include <Xm/FileSB.h>
-
-/*******************************************************************************
- Includes, Defines, and Global variables from the Declarations Editor:
-*******************************************************************************/
-
-extern swidget kuipIo;
-
-/*******************************************************************************
- The definition of the context structure:
- If you create multiple instances of your interface, the context
- structure ensures that your callbacks use the variables for the
- correct instance.
-
- For each swidget in the interface, each argument to the Interface
- function, and each variable in the Instance Specific section of the
- Declarations Editor, there is an entry in the context structure.
- and a #define. The #define makes the variable name refer to the
- corresponding entry in the context structure.
-*******************************************************************************/
-
-typedef struct
-{
- Widget UxsaveAsTrDialog;
-} _UxCsaveAsTrDialog;
-
-#define saveAsTrDialog UxSaveAsTrDialogContext->UxsaveAsTrDialog
-
-static _UxCsaveAsTrDialog *UxSaveAsTrDialogContext;
-
-
-/*******************************************************************************
- Forward declarations of functions that are defined later in this file.
-*******************************************************************************/
-
-Widget create_saveAsTrDialog();
-
-/*******************************************************************************
- The following are callback functions.
-*******************************************************************************/
-
-/*******************************************************************************
- The 'build_' function creates all the widgets
- using the resource values specified in the Property Editor.
-*******************************************************************************/
-
-static Widget _Uxbuild_saveAsTrDialog()
-{
- Widget saveAsTrDialog_shell;
-
- saveAsTrDialog_shell = XtVaCreatePopupShell( "saveAsTrDialog_shell",
- xmDialogShellWidgetClass, kuipIo,
- XmNx, 415,
- XmNy, 300,
- XmNwidth, 380,
- XmNheight, 400,
- XmNshellUnitType, XmPIXELS,
- XmNtitle, "saveAsTrDialog",
- NULL );
-
- saveAsTrDialog = XtVaCreateWidget( "saveAsTrDialog",
- xmFileSelectionBoxWidgetClass, saveAsTrDialog_shell,
- RES_CONVERT( XmNselectionLabelString, "Enter File Name" ),
- RES_CONVERT( XmNdirMask, "*.pad" ),
- RES_CONVERT( XmNdialogTitle, "Save Transcript Pad" ),
- XmNheight, 400,
- XmNwidth, 380,
- XmNunitType, XmPIXELS,
- NULL );
-
- UxPutContext( saveAsTrDialog, (char *) UxSaveAsTrDialogContext );
-
- XtAddCallback( saveAsTrDialog, XmNdestroyCallback,
- UxFreeClientDataCB,
- (XtPointer) UxSaveAsTrDialogContext );
-
-
-
- return ( saveAsTrDialog );
-}
-
-/*******************************************************************************
- The following function includes the code that was entered
- in the 'Initial Code' and 'Final Code' sections of the
- Declarations Editor. This function is called from the
- 'Interface function' below.
-*******************************************************************************/
-
-static Widget _Ux_create_saveAsTrDialog()
-{
- Widget rtrn;
- _UxCsaveAsTrDialog *UxContext;
-
- UxSaveAsTrDialogContext = UxContext =
- (_UxCsaveAsTrDialog *) XtMalloc( sizeof(_UxCsaveAsTrDialog) );
-
- rtrn = _Uxbuild_saveAsTrDialog();
-
- return(rtrn);
-}
-
-/*******************************************************************************
- The following is the 'Interface function' which is the
- external entry point for creating this interface.
- This function should be called from your application or from
- a callback function.
-*******************************************************************************/
-
-Widget create_saveAsTrDialog()
-{
- Widget _Uxrtrn;
-
- _Uxrtrn = _Ux_create_saveAsTrDialog();
-
- return ( _Uxrtrn );
-}
-
-/*******************************************************************************
- END OF FILE
-*******************************************************************************/
-
diff --git a/src/packlib/kuip/programs/kxterm/searchdialog.c b/src/packlib/kuip/programs/kxterm/searchdialog.c
deleted file mode 100644
index c18f747..0000000
--- a/src/packlib/kuip/programs/kxterm/searchdialog.c
+++ /dev/null
@@ -1,297 +0,0 @@
-/*
- * $Id: searchdialog.c,v 1.1.1.1 1996/03/08 15:33:04 mclareni Exp $
- *
- * $Log: searchdialog.c,v $
- * Revision 1.1.1.1 1996/03/08 15:33:04 mclareni
- * Kuip
- *
- */
-/*CMZ : 2.00/09 18/01/93 12.55.18 by Alfred Nathaniel*/
-/*-- Author :*/
-
-/*******************************************************************************
- searchDialog.c
- (Generated from interface file searchDialog.i)
-*******************************************************************************/
-
-#include <stdio.h>
-#include <Xm/Xm.h>
-#include <Xm/DialogS.h>
-#include <Xm/MenuShell.h>
-#include "uxxt.h"
-
-#include <Xm/ToggleB.h>
-#include <Xm/Separator.h>
-#include <Xm/PushB.h>
-#include <Xm/Text.h>
-#include <Xm/Label.h>
-#include <Xm/Form.h>
-#include <Xm/Form.h>
-
-/*******************************************************************************
- Includes, Defines, and Global variables from the Declarations Editor:
-*******************************************************************************/
-
-extern swidget kuipIo;
-
-/*******************************************************************************
- The definition of the context structure:
- If you create multiple instances of your interface, the context
- structure ensures that your callbacks use the variables for the
- correct instance.
-
- For each swidget in the interface, each argument to the Interface
- function, and each variable in the Instance Specific section of the
- Declarations Editor, there is an entry in the context structure.
- and a #define. The #define makes the variable name refer to the
- corresponding entry in the context structure.
-*******************************************************************************/
-
-typedef struct
-{
- Widget UxsearchDialog;
- Widget Uxform2;
- Widget Uxlabel3;
- Widget Uxseparator3;
- Widget Uxform1;
-} _UxCsearchDialog;
-
-#define searchDialog UxSearchDialogContext->UxsearchDialog
-#define form2 UxSearchDialogContext->Uxform2
-#define label3 UxSearchDialogContext->Uxlabel3
-#define separator3 UxSearchDialogContext->Uxseparator3
-#define form1 UxSearchDialogContext->Uxform1
-
-static _UxCsearchDialog *UxSearchDialogContext;
-
-Widget searchText;
-Widget closeSearchButton;
-Widget caseToggle;
-Widget nextSearchButton;
-Widget previousSearchButton;
-Widget allSearchButton;
-
-/*******************************************************************************
- Forward declarations of functions that are defined later in this file.
-*******************************************************************************/
-
-Widget create_searchDialog();
-
-/*******************************************************************************
- The following are callback functions.
-*******************************************************************************/
-
-/*******************************************************************************
- The 'build_' function creates all the widgets
- using the resource values specified in the Property Editor.
-*******************************************************************************/
-
-static Widget _Uxbuild_searchDialog()
-{
- Widget searchDialog_shell;
-
- searchDialog_shell = XtVaCreatePopupShell( "searchDialog_shell",
- xmDialogShellWidgetClass, kuipIo,
- XmNwidth, 395,
- XmNheight, 170,
- XmNshellUnitType, XmPIXELS,
- XmNtitle, "searchDialog",
- NULL );
-
- searchDialog = XtVaCreateWidget( "searchDialog",
- xmFormWidgetClass, searchDialog_shell,
- XmNdefaultPosition, FALSE,
- RES_CONVERT( XmNdialogTitle, "Search..." ),
- XmNautoUnmanage, FALSE,
- XmNheight, 170,
- XmNwidth, 395,
- XmNunitType, XmPIXELS,
- NULL );
-
- UxPutContext( searchDialog, (char *) UxSearchDialogContext );
-
- form2 = XtVaCreateManagedWidget( "form2",
- xmFormWidgetClass, searchDialog,
- XmNtopAttachment, XmATTACH_FORM,
- XmNtopOffset, 10,
- XmNrightOffset, 5,
- XmNrightAttachment, XmATTACH_FORM,
- XmNleftOffset, 5,
- XmNleftAttachment, XmATTACH_FORM,
- XmNresizePolicy, XmRESIZE_NONE,
- NULL );
-
- UxPutContext( form2, (char *) UxSearchDialogContext );
-
- label3 = XtVaCreateManagedWidget( "label3",
- xmLabelWidgetClass, form2,
- XmNtopAttachment, XmATTACH_FORM,
- XmNleftAttachment, XmATTACH_FORM,
- XmNbottomAttachment, XmATTACH_FORM,
- XmNalignment, XmALIGNMENT_BEGINNING,
- RES_CONVERT( XmNlabelString, "Search For:" ),
- XmNheight, 25,
- NULL );
-
- UxPutContext( label3, (char *) UxSearchDialogContext );
-
- searchText = XtVaCreateManagedWidget( "searchText",
- xmTextWidgetClass, form2,
- XmNleftWidget, label3,
- XmNleftOffset, 5,
- XmNtopAttachment, XmATTACH_FORM,
- XmNrightWidget, label3,
- XmNrightAttachment, XmATTACH_FORM,
- XmNleftAttachment, XmATTACH_WIDGET,
- XmNbottomAttachment, XmATTACH_FORM,
- XmNheight, 35,
- NULL );
-
- UxPutContext( searchText, (char *) UxSearchDialogContext );
-
- closeSearchButton = XtVaCreateManagedWidget( "closeSearchButton",
- xmPushButtonWidgetClass, searchDialog,
- XmNrightPosition, 60,
- XmNrightAttachment, XmATTACH_POSITION,
- XmNleftPosition, 40,
- XmNleftAttachment, XmATTACH_POSITION,
- RES_CONVERT( XmNlabelString, "Close" ),
- XmNbottomOffset, 10,
- XmNbottomAttachment, XmATTACH_FORM,
- XmNheight, 30,
- XmNwidth, 60,
- NULL );
-
- UxPutContext( closeSearchButton, (char *) UxSearchDialogContext );
-
- separator3 = XtVaCreateManagedWidget( "separator3",
- xmSeparatorWidgetClass, searchDialog,
- XmNbottomWidget, closeSearchButton,
- XmNrightAttachment, XmATTACH_FORM,
- XmNleftAttachment, XmATTACH_FORM,
- XmNbottomOffset, 10,
- XmNbottomAttachment, XmATTACH_WIDGET,
- NULL );
-
- UxPutContext( separator3, (char *) UxSearchDialogContext );
-
- form1 = XtVaCreateManagedWidget( "form1",
- xmFormWidgetClass, searchDialog,
- XmNtopWidget, form2,
- XmNtopOffset, 15,
- XmNtopAttachment, XmATTACH_WIDGET,
- XmNrightOffset, 5,
- XmNrightAttachment, XmATTACH_FORM,
- XmNleftOffset, 5,
- XmNleftAttachment, XmATTACH_FORM,
- XmNresizePolicy, XmRESIZE_NONE,
- NULL );
-
- UxPutContext( form1, (char *) UxSearchDialogContext );
-
- caseToggle = XtVaCreateManagedWidget( "caseToggle",
- xmToggleButtonWidgetClass, form1,
- XmNtopAttachment, XmATTACH_FORM,
- XmNleftAttachment, XmATTACH_FORM,
- XmNbottomAttachment, XmATTACH_FORM,
- XmNy, -5,
- XmNx, 50,
- RES_CONVERT( XmNlabelString, "Case Sensitive" ),
- XmNheight, 25,
- NULL );
-
- UxPutContext( caseToggle, (char *) UxSearchDialogContext );
-
- nextSearchButton = XtVaCreateManagedWidget( "nextSearchButton",
- xmPushButtonWidgetClass, form1,
- XmNtopAttachment, XmATTACH_FORM,
- XmNrightAttachment, XmATTACH_FORM,
- XmNbottomAttachment, XmATTACH_FORM,
- RES_CONVERT( XmNlabelString, "Next" ),
- XmNheight, 30,
- XmNwidth, 75,
- NULL );
-
- UxPutContext( nextSearchButton, (char *) UxSearchDialogContext );
-
- previousSearchButton = XtVaCreateManagedWidget( "previousSearchButton",
- xmPushButtonWidgetClass, form1,
- XmNtopAttachment, XmATTACH_FORM,
- XmNrightWidget, nextSearchButton,
- XmNrightOffset, 10,
- XmNrightAttachment, XmATTACH_WIDGET,
- XmNbottomAttachment, XmATTACH_FORM,
- RES_CONVERT( XmNlabelString, "Previous" ),
- XmNheight, 30,
- XmNwidth, 75,
- NULL );
-
- UxPutContext( previousSearchButton, (char *) UxSearchDialogContext );
-
- allSearchButton = XtVaCreateManagedWidget( "allSearchButton",
- xmPushButtonWidgetClass, form1,
- XmNtopAttachment, XmATTACH_FORM,
- XmNrightWidget, previousSearchButton,
- XmNrightOffset, 10,
- XmNrightAttachment, XmATTACH_WIDGET,
- RES_CONVERT( XmNlabelString, "All" ),
- XmNbottomAttachment, XmATTACH_FORM,
- XmNheight, 30,
- XmNwidth, 75,
- NULL );
-
- UxPutContext( allSearchButton, (char *) UxSearchDialogContext );
-
- XtAddCallback( searchDialog, XmNdestroyCallback,
- UxFreeClientDataCB,
- (XtPointer) UxSearchDialogContext );
-
- XtVaSetValues(searchDialog,
- XmNdefaultButton, nextSearchButton,
- NULL );
-
-
-
- return ( searchDialog );
-}
-
-/*******************************************************************************
- The following function includes the code that was entered
- in the 'Initial Code' and 'Final Code' sections of the
- Declarations Editor. This function is called from the
- 'Interface function' below.
-*******************************************************************************/
-
-static Widget _Ux_create_searchDialog()
-{
- Widget rtrn;
- _UxCsearchDialog *UxContext;
-
- UxSearchDialogContext = UxContext =
- (_UxCsearchDialog *) XtMalloc( sizeof(_UxCsearchDialog) );
-
- rtrn = _Uxbuild_searchDialog();
-
- return(rtrn);
-}
-
-/*******************************************************************************
- The following is the 'Interface function' which is the
- external entry point for creating this interface.
- This function should be called from your application or from
- a callback function.
-*******************************************************************************/
-
-Widget create_searchDialog()
-{
- Widget _Uxrtrn;
-
- _Uxrtrn = _Ux_create_searchDialog();
-
- return ( _Uxrtrn );
-}
-
-/*******************************************************************************
- END OF FILE
-*******************************************************************************/
-
diff --git a/src/packlib/kuip/programs/kxterm/utils.c b/src/packlib/kuip/programs/kxterm/utils.c
deleted file mode 100644
index 77b1134..0000000
--- a/src/packlib/kuip/programs/kxterm/utils.c
+++ /dev/null
@@ -1,293 +0,0 @@
-/*
- * $Id: utils.c,v 1.1.1.1 1996/03/08 15:33:04 mclareni Exp $
- *
- * $Log: utils.c,v $
- * Revision 1.1.1.1 1996/03/08 15:33:04 mclareni
- * Kuip
- *
- */
-/*CMZ : 2.06/03 10/01/95 09.20.57 by N.Cremel*/
-/*-- Author : Fons Rademakers 8/01/93*/
-/* includes */
-#include <ctype.h>
-#include <stdio.h>
-#include <string.h>
-#include <Xm/Xm.h>
-#include <Xm/SashP.h>
-#include <X11/IntrinsicP.h>
-#if defined(__hpux) && XtSpecificationRelease == 4
-#include <X11/Protocols.h>
-#else
-#include <Xm/Protocols.h>
-#endif
-#include <Xm/AtomMgr.h>
-
-#include "utils.h"
-
-
-/***********************************************************************
- * *
- * Returns pointer to last character when last character is c, *
- * otherwise 0. Ignore ' ' and \n. *
- * *
- ***********************************************************************/
-char *my_strrstr( s1, s2 )
- const char *s1;
- const char *s2;
-{
- int i;
- int ls1 = strlen(s1);
- int ls2 = strlen(s2);
-
- if (!s1 || !ls1 || !s2 || !ls2) return NULL;
-
- for (i = ls1; i > 0; i--) {
- if (s1[i-1] == *s2) {
- if (!strncmp(&s1[i-1], s2, ls2))
- return (char *)&s1[i-1];
- }
- }
- return NULL;
-}
-
-/***********************************************************************
- * *
- * Returns true if string is empty (only containing blanks). *
- * *
- ***********************************************************************/
-Boolean strempty( str )
- char *str;
-{
- char *sav = str;
- Boolean rtrn = True;
-
- if (!sav) return rtrn;
- if (strlen(sav) == 0) return rtrn;
-
- while (*sav) {
- if (*sav != ' ') {
- rtrn = False;
- break;
- }
- sav++;
- }
- return rtrn ;
-}
-
-/***********************************************************************
- * *
- * Strip blanks from both sides of a string. Space for the new *
- * string is allocated and a pointer to it is returned. *
- * The user must free the space. *
- * *
- ***********************************************************************/
-char *strip( s )
- char *s;
-{
- char *r, *t1, *t2;
- int l;
-
- l = strlen(s);
- r = XtCalloc(l+1, 1);
-
- if (l == 0) {
- *r = '\0';
- return r;
- }
-
- /* get rid of leading blanks */
- t1 = s;
- while (*t1 == ' ')
- t1++;
-
- t2 = s + l - 1;
- while (*t2 == ' ' && t2 > s)
- t2--;
-
- if (t1 > t2) {
- *r = '\0';
- return r;
- }
- strncpy(r, t1, (size_t) (t2-t1+1));
-
- return r;
-}
-
-/***********************************************************************
- * *
- * Returns pointer to last character when last character is c, *
- * otherwise 0. Ignore ' ' and \n. *
- * *
- ***********************************************************************/
-char *strend( str, c )
- char *str;
- int c;
-{
- int i;
-
- if (!str || !strlen(str)) return NULL;
-
- for (i = strlen(str); i > 0; i--) {
- if (str[i-1] == ' ' || str[i-1] == '\n')
- continue;
-
- if (str[i-1] != c)
- return NULL;
-
- return str+i-1;
- }
- return NULL;
-}
-
-/***********************************************************************
- * *
- * Change the characters in str into lower case. *
- * *
- ***********************************************************************/
-void lower( str )
- char *str;
-{
- if (str) {
- char *p = str;
- while (*p) {
- if (isupper(*p))
- *p = tolower(*p);
- p++;
- }
- }
-}
-
-/***********************************************************************
- * *
- * Popdown dialog and make menu item sensitive. *
- * *
- ***********************************************************************/
-void popdown_dialog( dialog )
- Widget dialog;
-{
- Widget button;
-
- XtVaGetValues(dialog, XmNuserData, &button, NULL);
-
- XtSetSensitive(button, True);
- XtUnmanageChild(dialog);
-}
-
-/***********************************************************************
- * *
- * Remove (unmanage) popup in case the cancel button was pressed, *
- * and make the menu button sensitive again (via popdown_dialog). *
- * *
- ***********************************************************************/
-void cancel_cb( w, dialog, call_data )
- Widget w;
- Widget dialog;
- XmAnyCallbackStruct *call_data;
-{
- popdown_dialog(dialog);
-}
-
-/***********************************************************************
- * *
- * Remove (unmanage) popup in case the cancel button was pressed. *
- * *
- ***********************************************************************/
-void unmanage_cb( w, dialog, call_data )
- Widget w;
- Widget dialog;
- XmAnyCallbackStruct *call_data;
-{
- XtUnmanageChild(dialog);
-}
-
-/***********************************************************************
- * *
- * Returns the true shell widget. *
- * *
- ***********************************************************************/
-static Widget GetTrueShell( w )
- Widget w;
-{
- Widget wgt = w;
-
- if (wgt && !XtIsShell(wgt)) {
- wgt = XtParent(wgt);
- }
- return wgt;
-}
-
-/***********************************************************************
- * *
- * Install MwmCloseCallback. *
- * *
- ***********************************************************************/
-void InstallMwmCloseCallback( w, callback, client_data )
- Widget w;
- XtCallbackProc callback;
- XtPointer client_data;
-{
- static Atom a = (Atom) NULL;
- Widget shell = GetTrueShell(w);
-
- if (!a)
- a = XmInternAtom(XtDisplay(shell), "WM_DELETE_WINDOW", False);
-
- if (XmIsVendorShell(shell)) {
- XmAddWMProtocols(shell, &a, 1);
- XmAddWMProtocolCallback(shell, a, callback, client_data);
- }
-}
-
-/***********************************************************************
- * *
- * Iconify a shell. *
- * *
- ***********************************************************************/
-void IconifyShell( shell )
- Widget shell;
-{
- static Atom a = (Atom) NULL;
- Display *dpy = XtDisplay(shell);
- XClientMessageEvent ev;
-
- if (!a)
- a = XmInternAtom(dpy, "WM_CHANGE_STATE", False);
-
- ev.type = ClientMessage;
- ev.display = dpy;
- ev.message_type = a;
- ev.format = 32;
- ev.data.l[0] = IconicState;
- ev.window = XtWindow(GetTrueShell(shell));
-
- XSendEvent(dpy,
- RootWindow(dpy, DefaultScreen(dpy)),
- True,
- (SubstructureRedirectMask | SubstructureNotifyMask),
- (XEvent *)&ev);
- XFlush(dpy);
-}
-
-/***********************************************************************
- * *
- * Resetting XmNtraversalOn on all the sashes in a paned window. *
- * *
- ***********************************************************************/
-void TurnOffSashTraversal( pane )
- Widget pane;
-{
- Widget *children;
- int num_children;
-
- XtVaGetValues(pane, XmNchildren, &children,
- XmNnumChildren, &num_children,
- NULL);
-
- /*
- * Instead of using the private function XmIsSash one could also
- * check for the widget name being "sash" (using XtName).
- */
- while (num_children--)
- if (XmIsSash(children[num_children]))
- XtVaSetValues(children[num_children], XmNtraversalOn, False, NULL);
-}
diff --git a/src/packlib/kuip/programs/kxterm/utils.h b/src/packlib/kuip/programs/kxterm/utils.h
deleted file mode 100644
index 6faf333..0000000
--- a/src/packlib/kuip/programs/kxterm/utils.h
+++ /dev/null
@@ -1,96 +0,0 @@
-/*
- * $Id: utils.h,v 1.3 1999/09/28 16:35:52 mclareni Exp $
- *
- * $Log: utils.h,v $
- * Revision 1.3 1999/09/28 16:35:52 mclareni
- * Remove strdup redefinition
- *
- * Revision 1.2 1996/04/11 10:04:24 cernlib
- * Remobe fortran comment lines
- *
- * Revision 1.1.1.1 1996/03/08 15:33:05 mclareni
- * Kuip
- *
- */
-/***********************************************************************
- * *
- * Utils.h, contains the utility routine prototypes. *
- * *
- ***********************************************************************/
-#ifndef _utils_h
-#define _utils_h
-
-#ifdef _NO_PROTO
-# define const
-#endif
-
-extern Boolean strempty(
-#ifndef _NO_PROTO
- char *
-#endif
- );
-extern char *my_strrstr(
-#ifndef _NO_PROTO
- const char *s1, const char *s2
-#endif
- );
-extern char *strip(
-#ifndef _NO_PROTO
- char *
-#endif
- );
-extern char *strend(
-#ifndef _NO_PROTO
- char *str, int c
-#endif
- );
-extern void lower(
-#ifndef _NO_PROTO
- char *str
-#endif
- );
-extern void popdown_dialog(
-#ifndef _NO_PROTO
- Widget dialog
-#endif
- );
-extern void cancel_cb(
-#ifndef _NO_PROTO
- Widget, Widget, XmAnyCallbackStruct *
-#endif
- );
-extern void unmanage_cb(
-#ifndef _NO_PROTO
- Widget, Widget, XmAnyCallbackStruct *
-#endif
- );
-extern void InstallMwmCloseCallback(
-#ifndef _NO_PROTO
- Widget, XtCallbackProc, XtPointer
-#endif
- );
-extern void IconifyShell(
-#ifndef _NO_PROTO
- Widget
-#endif
- );
-extern void TurnOffSashTraversal(
-#ifndef _NO_PROTO
- Widget
-#endif
- );
-
-#if !defined(__convexc__)
-extern int strcasecmp(
-#ifndef _NO_PROTO
- const char *s1, const char *s2
-#endif
- );
-extern int strncasecmp(
-#ifndef _NO_PROTO
- const char *s1, const char *s2, size_t n
-#endif
- );
-#endif /* __convexc__ */
-
-#endif /* _utils_h */
diff --git a/src/packlib/kuip/programs/kxterm/uxpan.h b/src/packlib/kuip/programs/kxterm/uxpan.h
deleted file mode 100644
index 2879c13..0000000
--- a/src/packlib/kuip/programs/kxterm/uxpan.h
+++ /dev/null
@@ -1,79 +0,0 @@
-/*
- * $Id: uxpan.h,v 1.2 1996/04/11 10:04:25 cernlib Exp $
- *
- * $Log: uxpan.h,v $
- * Revision 1.2 1996/04/11 10:04:25 cernlib
- * Remobe fortran comment lines
- *
- * Revision 1.1.1.1 1996/03/08 15:33:05 mclareni
- * Kuip
- *
- */
-/*******************************************************************************
- kuipPanel.h
- This header file is included by kuipPanel.c
-
-*******************************************************************************/
-
-#ifndef _KUIPPANEL_INCLUDED
-#define _KUIPPANEL_INCLUDED
-
-
-#include <stdio.h>
-#include <Xm/Xm.h>
-#include <Xm/MwmUtil.h>
-#include <X11/Shell.h>
-#include <Xm/MenuShell.h>
-/* #include "UxXt.h" */
-#include "uxxt.h"
-
-#include <Xm/PushB.h>
-#include <Xm/RowColumn.h>
-#include <Xm/ScrolledW.h>
-#include <Xm/SeparatoG.h>
-#include <Xm/Form.h>
-
-/*******************************************************************************
- The definition of the context structure:
- If you create multiple copies of your interface, the context
- structure ensures that your callbacks use the variables for the
- correct copy.
-
- For each swidget in the interface, each argument to the Interface
- function, and each variable in the Interface Specific section of the
- Declarations Editor, there is an entry in the context structure.
- and a #define. The #define makes the variable name refer to the
- corresponding entry in the context structure.
-*******************************************************************************/
-
-typedef struct
-{
- Widget UxkuipPanel;
- Widget UxseparatorPanel;
- Widget Uxkm_scrollPNW;
- Widget Uxkm_rowcolPNW;
- Widget Uxkm_okPNB;
- Widget Uxkm_savePNB;
- Widget Uxkm_helpPNB;
-} _UxCkuipPanel;
-
-#ifdef CONTEXT_MACRO_ACCESS
-static _UxCkuipPanel *UxKuipPanelContext;
-#define kuipPanel UxKuipPanelContext->UxkuipPanel
-#define separatorPanel UxKuipPanelContext->UxseparatorPanel
-#define km_scrollPNW UxKuipPanelContext->Uxkm_scrollPNW
-#define km_rowcolPNW UxKuipPanelContext->Uxkm_rowcolPNW
-#define km_okPNB UxKuipPanelContext->Uxkm_okPNB
-#define km_savePNB UxKuipPanelContext->Uxkm_savePNB
-#define km_helpPNB UxKuipPanelContext->Uxkm_helpPNB
-
-#endif /* CONTEXT_MACRO_ACCESS */
-
-
-/*******************************************************************************
- Declarations of global functions.
-*******************************************************************************/
-
-Widget create_kuipPanel();
-
-#endif /* _KUIPPANEL_INCLUDED */
diff --git a/src/packlib/kuip/programs/kxterm/uxpanel.c b/src/packlib/kuip/programs/kxterm/uxpanel.c
deleted file mode 100644
index 8b9f01b..0000000
--- a/src/packlib/kuip/programs/kxterm/uxpanel.c
+++ /dev/null
@@ -1,200 +0,0 @@
-/*
- * $Id: uxpanel.c,v 1.1.1.1 1996/03/08 15:33:04 mclareni Exp $
- *
- * $Log: uxpanel.c,v $
- * Revision 1.1.1.1 1996/03/08 15:33:04 mclareni
- * Kuip
- *
- */
-/*CMZ : 2.04/00 28/09/93 15.08.20 by Nicole Cremel*/
-/*-- Author : Nicole Cremel 28/09/93*/
-/*
- * kuipPanel.c
- */
-
-/*******************************************************************************
- kuipPanel.c
-
- Associated Header file: kuipPanel.h
-*******************************************************************************/
-
-#include <stdio.h>
-#include <Xm/Xm.h>
-#include <Xm/MwmUtil.h>
-#include <X11/Shell.h>
-#include <Xm/MenuShell.h>
-/* #include "UxXt.h" */
-#include "uxxt.h"
-
-#include <Xm/PushB.h>
-#include <Xm/RowColumn.h>
-#include <Xm/ScrolledW.h>
-#include <Xm/SeparatoG.h>
-#include <Xm/Form.h>
-
-
-
-/*******************************************************************************
- The following header file defines the context structure.
-*******************************************************************************/
-
-#define CONTEXT_MACRO_ACCESS 1
-/* #include "kuipPanel.h" */
-#include "uxpan.h"
-#undef CONTEXT_MACRO_ACCESS
-
-
-/*******************************************************************************
- The following are callback functions.
-*******************************************************************************/
-
-/*******************************************************************************
- The 'build_' function creates all the widgets
- using the resource values specified in the Property Editor.
-*******************************************************************************/
-
-static Widget _Uxbuild_kuipPanel()
-{
- Widget _UxParent;
-
-
- /* Creation of kuipPanel */
- _UxParent = XtVaCreatePopupShell( "kuipPanel_shell",
- topLevelShellWidgetClass, UxTopLevel,
- XmNtitle, "kuipPanel",
- XmNiconName, "kuipPanel",
- NULL );
-
- kuipPanel = XtVaCreateManagedWidget( "kuipPanel",
- xmFormWidgetClass,
- _UxParent,
- XmNdefaultPosition, FALSE,
- NULL );
- UxPutContext( kuipPanel, (char *) UxKuipPanelContext );
-
-
- /* Creation of separatorPanel */
- separatorPanel = XtVaCreateManagedWidget( "separatorPanel",
- xmSeparatorGadgetClass,
- kuipPanel,
- XmNheight, 10,
- XmNbottomOffset, 45,
- XmNrightAttachment, XmATTACH_FORM,
- XmNrightOffset, 0,
- XmNbottomAttachment, XmATTACH_FORM,
- XmNleftAttachment, XmATTACH_FORM,
- XmNleftOffset, 0,
- NULL );
- UxPutContext( separatorPanel, (char *) UxKuipPanelContext );
-
-
- /* Creation of km_scrollPNW */
- km_scrollPNW = XtVaCreateManagedWidget( "km_scrollPNW",
- xmScrolledWindowWidgetClass,
- kuipPanel,
- XmNscrollingPolicy, XmAUTOMATIC,
- XmNbottomOffset, 56,
- XmNrightAttachment, XmATTACH_FORM,
- XmNrightOffset, 5,
- XmNleftAttachment, XmATTACH_FORM,
- XmNleftOffset, 5,
- XmNtopOffset, 5,
- XmNbottomAttachment, XmATTACH_FORM,
- XmNtopAttachment, XmATTACH_FORM,
- NULL );
- UxPutContext( km_scrollPNW, (char *) UxKuipPanelContext );
-
-
- /* Creation of km_rowcolPNW */
- km_rowcolPNW = XtVaCreateManagedWidget( "km_rowcolPNW",
- xmRowColumnWidgetClass,
- km_scrollPNW,
- XmNadjustLast, FALSE,
- XmNorientation, XmHORIZONTAL,
- XmNpacking, XmPACK_COLUMN,
- NULL );
- UxPutContext( km_rowcolPNW, (char *) UxKuipPanelContext );
-
-
- /* Creation of km_okPNB */
- km_okPNB = XtVaCreateManagedWidget( "km_okPNB",
- xmPushButtonWidgetClass,
- kuipPanel,
- XmNheight, 30,
- RES_CONVERT( XmNlabelString, " Close " ),
- XmNrecomputeSize, FALSE,
- XmNdefaultButtonShadowThickness, 1,
- XmNbottomAttachment, XmATTACH_FORM,
- XmNbottomOffset, 5,
- XmNleftAttachment, XmATTACH_FORM,
- XmNleftOffset, 5,
- XmNshowAsDefault, 1,
- NULL );
- UxPutContext( km_okPNB, (char *) UxKuipPanelContext );
-
-
- /* Creation of km_savePNB */
- km_savePNB = XtVaCreateManagedWidget( "km_savePNB",
- xmPushButtonWidgetClass,
- kuipPanel,
- XmNheight, 30,
- XmNbottomAttachment, XmATTACH_FORM,
- XmNbottomOffset, 5,
- RES_CONVERT( XmNlabelString, " Save " ),
- XmNrecomputeSize, FALSE,
- XmNrightAttachment, XmATTACH_POSITION,
- XmNdefaultButtonShadowThickness, 1,
- XmNrightPosition, 50,
- XmNrightOffset, -30,
- XmNwidth, 50,
- NULL );
- UxPutContext( km_savePNB, (char *) UxKuipPanelContext );
-
-
- /* Creation of km_helpPNB */
- km_helpPNB = XtVaCreateManagedWidget( "km_helpPNB",
- xmPushButtonWidgetClass,
- kuipPanel,
- XmNheight, 30,
- XmNbottomAttachment, XmATTACH_FORM,
- XmNbottomOffset, 5,
- XmNrightAttachment, XmATTACH_FORM,
- XmNrightOffset, 5,
- RES_CONVERT( XmNlabelString, " Help " ),
- XmNdefaultButtonShadowThickness, 1,
- NULL );
- UxPutContext( km_helpPNB, (char *) UxKuipPanelContext );
-
-
- XtAddCallback( kuipPanel, XmNdestroyCallback,
- (XtCallbackProc) UxDestroyContextCB,
- (XtPointer) UxKuipPanelContext);
-
-
- return ( kuipPanel );
-}
-
-/*******************************************************************************
- The following is the 'Interface function' which is the
- external entry point for creating this interface.
- This function should be called from your application or from
- a callback function.
-*******************************************************************************/
-
-Widget create_kuipPanel()
-{
- Widget rtrn;
- _UxCkuipPanel *UxContext;
-
- UxKuipPanelContext = UxContext =
- (_UxCkuipPanel *) UxNewContext( sizeof(_UxCkuipPanel), False );
-
-
- rtrn = _Uxbuild_kuipPanel();
-
- return(rtrn);
-}
-
-/*******************************************************************************
- END OF FILE
-*******************************************************************************/
diff --git a/src/packlib/kuip/programs/kxterm/uxxt.c b/src/packlib/kuip/programs/kxterm/uxxt.c
deleted file mode 100644
index 7937205..0000000
--- a/src/packlib/kuip/programs/kxterm/uxxt.c
+++ /dev/null
@@ -1,805 +0,0 @@
-/*
- * $Id: uxxt.c,v 1.1.1.1 1996/03/08 15:33:04 mclareni Exp $
- *
- * $Log: uxxt.c,v $
- * Revision 1.1.1.1 1996/03/08 15:33:04 mclareni
- * Kuip
- *
- */
-/*CMZ : 2.06/06 18/01/95 15.31.09 by Gunter Folger*/
-/*-- Author :*/
-/*---------------------------------------------------------------------
- * $Date: 1996/03/08 15:33:04 $ $Revision: 1.1.1.1 $
- *---------------------------------------------------------------------
- *
- *
- * Copyright (c) 1991, Visual Edge Software Ltd.
- *
- * ALL RIGHTS RESERVED. Permission to use, copy, modify, and
- * distribute this software and its documentation for any purpose
- * and without fee is hereby granted, provided that the above
- * copyright notice appear in all copies and that both that
- * copyright notice and this permission notice appear in supporting
- * documentation, and that the name of Visual Edge Software not be
- * used in advertising or publicity pertaining to distribution of
- * the software without specific, written prior permission. The year
- * included in the notice is the year of the creation of the work.
- *-------------------------------------------------------------------*/
- /*------------------------------------------------------------------------
- * UxXt.c
- *-----------------------------------------------------------------------*/
-
-#include <stdio.h>
-#include <stdlib.h>
-
-#include <X11/Intrinsic.h>
-#include <X11/Shell.h>
-#include <X11/StringDefs.h>
-#include <X11/Xutil.h>
-#include <X11/X.h>
-#include <X11/Xmd.h>
-#include <X11/Xlib.h>
-#include <Xm/Xm.h>
-#include <Xm/DialogS.h>
-
-#ifdef UIL_CODE
-#include <Mrm/MrmPublic.h>
-#endif /* UIL_CODE */
-
-#include "kuip/kuip.h"
-#include "uxxt.h"
-
-static XContext xcontext_id = 0;
-
-/*****************************************************************************
-NAME: UxRealWidget( wgt )
-
-INPUT: Widget wgt - the top user-created widget
-
-RETURN: Widget - the shell widget
-
-DESCRIPTION: Given a widget, determines if the widget parent
- is a shell in which case the shell is returned
- otherwise, the widget itself is returned.
- This is needed for implicit shells to get the real
- shell behing the toplevel manager.
-
-CREATION: Visual Edge Software April 8 1993
-----------------------------------------------------------------------------*/
-#ifdef _NO_PROTO
-Widget UxRealWidget( wgt )
- Widget wgt;
-#else
-Widget UxRealWidget( Widget wgt )
-#endif
-{
- if (wgt) {
- if (XtIsShell(wgt)) {
- return(wgt);
- } else if (XtIsShell(XtParent(wgt))) {
- return XtParent(wgt);
- }
- }
- return wgt;
-}
-/******************************************************************************
-NAME: GetTrueToplevel( wgt )
-
-INPUT: Widget wgt - the top user-created widget
-
-RETURN: Widget - the shell widget
-
-DESCRIPTION: Returns the true toplevel of that interface.
- This is needed for implicit shells where the widget passed to
- one of the Ux functions is not always the shell.
-
-CREATION: Visual Edge Software April 6 1991
------------------------------------------------------------------------------*/
-#ifdef _NO_PROTO
-static Widget GetTrueToplevel( wgt )
- Widget wgt;
-#else
-static Widget GetTrueToplevel( Widget wgt )
-#endif
-{
- while (wgt && !XtIsShell(wgt))
- {
- wgt = XtParent(wgt);
- }
- return wgt;
-}
-
-/******************************************************************************
-NAME: handle_dialog_child( wgt, manage_func )
-
-INPUT: Widget wgt - the dialogShellWidget
- void (*manage_func)() - either XtManageChild
- or XtUnmanageChild
-
-RETURN: int - UX_NO_ERROR if successfull
- UX_ERROR otherwise
-
-DESCRIPTION: Handles the popping up or popping down of dialog shells
- by managing or unmanaging their children.
-
-CREATION: Visual Edge Software Sept 19/91
------------------------------------------------------------------------------*/
-#ifdef _NO_PROTO
-static int handle_dialog_child( wgt, manage_func )
- Widget wgt;
- void (*manage_func)();
-#else
-static int handle_dialog_child( Widget wgt, void (*manage_func)(Widget) )
-#endif
-{
- int i, num_children;
- Widget *children;
- int error_flag = UX_ERROR;
-
- XtVaGetValues( wgt,
- XmNnumChildren, &num_children,
- XmNchildren, &children,
- NULL );
-
- /*-----------------------------------------------------
- * We manage/unmanage the first rectObj child in the list.
- * Note that the check for rectObjClass is necessary since
- * some implementations of Motif add protocol children to
- * the dialogShell. Additionally, when the LANG is set to
- * Japanese, a widget of class Core is created. This widget
- * should not be managed. We'll skip it.
- *-----------------------------------------------------*/
-
- for (i = 0; i < num_children; i++)
- {
- if ( XtIsSubclass( children[i], rectObjClass ) &&
- (XtClass (children[i]) != coreWidgetClass))
- {
- (*manage_func)(children[i]);
- error_flag = UX_NO_ERROR;
- break;
- }
- }
-
- return ( error_flag );
-}
-
-/******************************************************************************
-NAME: popup_dialog( wgt, grab_flag )
-
-INPUT: Widget wgt - dialogShell to pop up
- XtGrabKind grab_flag - the grab flag
-
-RETURN: void
-
-DESCRIPTION: Pops up a dialogShell.
-
-CREATION: Visual Edge Software Sept 19/91
------------------------------------------------------------------------------*/
-#ifdef _NO_PROTO
-static void popup_dialog( wgt, grab_flag )
- Widget wgt;
- XtGrabKind grab_flag;
-#else
-static void popup_dialog( Widget wgt, XtGrabKind grab_flag )
-#endif
-{
- if ( handle_dialog_child( wgt, XtManageChild ) == UX_ERROR )
- XtPopup( wgt, grab_flag );
-}
-
-/******************************************************************************
-NAME: UxPopupInterface( wgt, grab_flag )
-
-INPUT: Widget wgt - Widget to popup
- XtGrabKind grab_flag - grab flag
-
-RETURN: int UX_ERROR or UX_NO_ERROR
-
-DESCRIPTION: Popups up an interface. The widget should be a toplevel widget.
- Note that special handling is required for dialogShells since
- those are popped up by managing their children if they have
- some.
- The grab_flag could be any of:
- no_grab (XtGrabNone)
- nonexclusive_grab (XtGrabNonexclusive)
- exclusive_grab (XtGrabExclusive)
-
-CREATION: Visual Edge Software April 6 1991
------------------------------------------------------------------------------*/
-#ifdef _NO_PROTO
-int UxPopupInterface( wgt, grab_flag )
- Widget wgt;
- XtGrabKind grab_flag;
-#else
-int UxPopupInterface( Widget wgt, XtGrabKind grab_flag )
-#endif
-{
- if (!(wgt = GetTrueToplevel(wgt)))
- return ( UX_ERROR );
-
- if ( XtIsSubclass( wgt, xmDialogShellWidgetClass ) )
- {
- popup_dialog( wgt, grab_flag );
- }
- else
- {
- XtPopup( wgt, grab_flag );
- }
-
- return ( UX_NO_ERROR );
-}
-
-/******************************************************************************
-NAME: popdown_dialog( wgt )
-
-INPUT: Widget wgt - dialogShell to popdown
-
-RETURN: void
-
-DESCRIPTION: Pops down a dialogShell.
-
-CREATION: Visual Edge Software Sept 19/91
------------------------------------------------------------------------------*/
-#ifdef _NO_PROTO
-static void popdown_dialog( wgt )
- Widget wgt;
-#else
-static void popdown_dialog( Widget wgt )
-#endif
-{
- if ( handle_dialog_child( wgt, XtUnmanageChild ) == UX_ERROR )
- XtPopdown( wgt );
-}
-
-/******************************************************************************
-NAME: UxPopdownInterface( wgt )
-
-INPUT: Widget wgt - Widget to popdown
-
-RETURN: int UX_ERROR / UX_NO_ERROR
-
-DESCRIPTION: Pops down an interface. The widget should be a toplevel widget.
- Note that special handling is required for dialogShells since
- those are popped down by unmanaging their children if they have
- some.
-
-CREATION: Visual Edge Software April 6 1991
------------------------------------------------------------------------------*/
-#ifdef _NO_PROTO
-int UxPopdownInterface( wgt )
- Widget wgt;
-#else
-int UxPopdownInterface( Widget wgt )
-#endif
-{
- if (!(wgt = GetTrueToplevel(wgt)))
- return ( UX_ERROR );
-
- if ( XtIsSubclass( wgt, xmDialogShellWidgetClass ) )
- {
- popdown_dialog( wgt );
- }
- else
- {
- XtPopdown( wgt );
- }
-
- return ( UX_NO_ERROR );
-}
-
-/******************************************************************************
-NAME: UxDestroyInterface( wgt )
-
-INPUT: Widget wgt - Widget to destroy
-
-RETURN: int UX_ERROR / UX_NO_ERROR
-
-DESCRIPTION: Destroys an interface. The widget should be a toplevel widget.
-
-CREATION: Visual Edge Software April 6 1991
------------------------------------------------------------------------------*/
-#ifdef _NO_PROTO
-int UxDestroyInterface( wgt )
- Widget wgt;
-#else
-int UxDestroyInterface( Widget wgt )
-#endif
-{
- if (!(wgt = GetTrueToplevel(wgt)))
- return ( UX_ERROR );
-
- XtDestroyWidget (wgt);
-
- return ( UX_NO_ERROR );
-}
-
-/******************************************************************************
-NAME: UxDeleteContextCB( wgt, client_data, call_data )
-
-INPUT: Widget wgt - widget causing the callback
- XtPointer client_data - not used
- XtPointer call_data - not used
-
-RETURN: void
-
-DESCRIPTION: Deletes the X context entry.
-
-EXT REFERENCES: UxTopLevel, xcontext_id
-
-CREATION: Visual Edge Software April 6 1991
------------------------------------------------------------------------------*/
-#ifdef _NO_PROTO
-void UxDeleteContextCB( wgt, client_data, _call_data )
- Widget wgt;
- XtPointer client_data, _call_data;
-#else
-void UxDeleteContextCB( Widget wgt, XtPointer client_data,
- XtPointer _call_data )
-#endif
-{
- (void) XDeleteContext( XtDisplay( UxTopLevel ),
- (Window) wgt,
- (XContext) client_data );
-}
-
-/******************************************************************************
-NAME: UxPutContext( wgt, context )
-
-INPUT: Widget wgt - Widget
- XtPointer context - context pointer
-
-RETURN: int UX_ERROR / UX_NO_ERROR
-
-DESCRIPTION: Uses the X Context manager to store the given context pointer
- in a memory location that is indexed by the given widget id.
- Also adds a destroyCallback to delete that context when the
- widget is destroyed.
-
-EXT REFERENCES: UxTopLevel, xcontext_id
-EXT EFFECTS: xcontext_id
-
-CREATION: Visual Edge Software April 6 1991
------------------------------------------------------------------------------*/
-#ifdef _NO_PROTO
-int UxPutContext( wgt, context )
- Widget wgt;
- caddr_t context;
-#else
-int UxPutContext( Widget wgt, caddr_t context )
-#endif
-{
- int status;
-
- if ( xcontext_id == 0 )
- xcontext_id = XUniqueContext();
-
- if ( wgt == NULL )
- return ( UX_ERROR );
-
- status = XSaveContext( XtDisplay( UxTopLevel ),
- (Window) wgt,
- xcontext_id,
- (char *) context );
- if ( status != 0 )
- return ( UX_ERROR );
-
- XtAddCallback (wgt, XmNdestroyCallback,
- UxDeleteContextCB, (XtPointer) xcontext_id);
-
- return ( UX_NO_ERROR );
-}
-
-/******************************************************************************
-NAME: UxGetContext( wgt )
-
-INPUT: Widget wgt - widget
-
-RETURN: caddr_t - the context pointer
-
-DESCRIPTION: Uses the X Context manager to find the context pointer
- stored in a memory location indexed by the given widget id.
-
-EXT REFERENCES: UxTopLevel, xcontext_id
-
-CREATION: Visual Edge Software April 6 1991
------------------------------------------------------------------------------*/
-#ifdef _NO_PROTO
-caddr_t UxGetContext( wgt )
- Widget wgt;
-#else
-caddr_t UxGetContext( Widget wgt )
-#endif
-{
- int status;
-#if XtSpecificationRelease <= 4 /* X11R4 */
- caddr_t context;
-#else /* X11R5 */
- XPointer context;
-#endif
-
- if ( wgt == NULL )
- return ( (caddr_t) NULL );
-
- status = XFindContext( XtDisplay( UxTopLevel ),
- (Window) wgt,
- xcontext_id,
- &context );
-
- if ( status != 0 )
- return ( (caddr_t) NULL );
-
- return ( context );
-}
-
-/******************************************************************************
-NAME: DelayedFreeData ( client_data, id )
-
-INPUT: XtPointer client_data - pointer to be freed
- XtIntervalId *id;
-
-RETURN: void
-
-DESCRIPTION: This XtTimerCallbackProc function simply frees the client data.
-
-CREATION: Visual Edge Software April 30 1993
------------------------------------------------------------------------------*/
-#ifdef _NO_PROTO
-static void DelayedFreeData( client_data, _id )
- XtPointer client_data;
- XtIntervalId *_id;
-#else
-static void DelayedFreeData( XtPointer client_data, XtIntervalId *_id)
-#endif
-{
- if (client_data != NULL) {
- XtFree((char *) client_data);
- }
-}
-/******************************************************************************
-NAME: UxDestroyContextCB ( wgt, client_data, call_data )
-
-INPUT: Widget wgt - widget
- XtPointer client_data - pointer to be freed
- XtPointer call_data - not used
-
-RETURN: void
-
-DESCRIPTION: This callback function registers a timeout to free the
- context structure. This mechanism is used to ensure that
- user's destroyCallbacks are executed before we free the
- context structure.
-
-CREATION: Visual Edge Software April 6 1991
------------------------------------------------------------------------------*/
-#ifdef _NO_PROTO
-void UxDestroyContextCB( _wgt, client_data, _call_data )
- Widget _wgt;
- XtPointer client_data, _call_data;
-#else
-void UxDestroyContextCB( Widget _wgt, XtPointer client_data,
- XtPointer _call_data )
-#endif
-{
- if (client_data != NULL) {
- XtAppAddTimeOut(UxAppContext, 0,
- DelayedFreeData, client_data);
- }
-}
-/******************************************************************************
-NAME: UxFreeClientDataCB( wgt, client_data, call_data )
-
-INPUT: Widget wgt - widget
- XtPointer client_data - pointer to be freed
- XtPointer call_data - not used
-
-RETURN: void
-
-DESCRIPTION: This callback function simply frees the client data.
-
-CREATION: Visual Edge Software April 6 1991
------------------------------------------------------------------------------*/
-#ifdef _NO_PROTO
-void UxFreeClientDataCB( _wgt, client_data, _call_data )
- Widget _wgt;
- XtPointer client_data, _call_data;
-#else
-void UxFreeClientDataCB( Widget _wgt, XtPointer client_data,
- XtPointer _call_data )
-#endif
-{
- if (client_data != NULL)
- XtFree((char *) client_data);
-}
-
-/******************************************************************************
-NAME: UxLoadResources( fname )
-
-INPUT: char *fname - name of resource file
-
-RETURN: void
-
-DESCRIPTION: This function is provided as a stub function to load the
- resource file that was generated by the C Code Generator
- into the current toolkit resource database.
- A call to this function is automatically generated with the
- appropriate resource filename when resources are set to Public.
-
-CREATION: Visual Edge Software April 6 1991
------------------------------------------------------------------------------*/
-#ifdef _NO_PROTO
-void UxLoadResources( _fname )
- char *_fname;
-#else
-void UxLoadResources( char *_fname )
-#endif
-{
-}
-
-/******************************************************************************
-NAME: UxConvertFontList( fontlist_str )
-
-INPUT: char *fontlist_str - string form of fontlist
-
-RETURN: XmFontList - fontlist
-
-DESCRIPTION: Converts a fontlist from the resource-file string format
- to the XmFontList type expected in C code.
- The conversion is done by a call to the built-in Motif convertor
- and the return value points into Xt's resource cache
- and so the return value should NOT be XmFontListFree'd.
-
-CREATION: Visual Edge Software June 17 1992
------------------------------------------------------------------------------*/
-#ifdef _NO_PROTO
-XmFontList UxConvertFontList( fontlist_str )
- char *fontlist_str;
-#else
-XmFontList UxConvertFontList( char *fontlist_str )
-#endif
-{
- XrmValue from, to;
- XmFontList fontlist = NULL;
-
- from.size = strlen( fontlist_str ) + 1;
- from.addr = fontlist_str;
-
- to.size = sizeof(XmFontList);
- to.addr = (caddr_t) &fontlist;
-
- XtConvertAndStore( UxTopLevel,
- XmRString, &from,
- XmRFontList, &to );
-
- return ( fontlist );
-}
-
-/******************************************************************************
-NAME: UxConvertValueWcs( value_str )
-
-INPUT: char *value_str - multi-byte (mbs) form of
- wide-character string (wcs)
-
-RETURN: wchar_t * - wide-character string
-
-DESCRIPTION: Convert a multibyte string to a wide character string
- The memory allocated for the return value is maintained
- until the next call to this function.
-
-CREATION: Visual Edge Software March 31, 1993
------------------------------------------------------------------------------*/
-#ifdef _NO_PROTO
-wchar_t * UxConvertValueWcs( value_str )
- char *value_str;
-#else
-wchar_t * UxConvertValueWcs( char *value_str )
-#endif
-{
- static wchar_t *wcs = NULL;
- int maxlen;
-
- if (!value_str) {
- return ((wchar_t*)0);
- }
-
- maxlen = strlen(value_str) + 1;
- wcs = (wchar_t *)UxRealloc(wcs,maxlen * sizeof(wchar_t));
- if (mbstowcs(wcs, value_str, maxlen) == (size_t)-1) {
- return ((wchar_t*)0);
- }
-
- return(wcs);
-}
-
-#if 0
-
-/******************************************************************************
-NAME: static ConvertPixmap( file_name, depth )
-
-INPUT: char *file_name - Pixmap file name
- int depth - 0 for no depth specified
-
-RETURN: Pixmap
-
-DESCRIPTION: If the depth argument is 0 , then call XmGetPixmap (no depth
- argument). Otherwise, call XmGetPixmapByDepth (with depth as
- specified by the argument).
- Since there is no way of knowing how long the Pixmaps will be
- used, they are never destroyed. This is not a serious problem
- since XmGetPixmap does not regenerate existing Pixmaps.
- It simply keeps a reference count for the number of times a
- Pixmap is returned.
-
-CREATION: Visual Edge Software March 31, 1993
------------------------------------------------------------------------------*/
-#ifdef _NO_PROTO
-static Pixmap ConvertPixmap( file_name, depth )
- char *file_name;
- int depth;
-#else
-static Pixmap ConvertPixmap( char *file_name, int depth )
-#endif
-{
- XrmValue fg_from, fg_to, bg_from, bg_to;
- Pixel fg, bg;
-
- fg_from.size = strlen(XtDefaultForeground);
- fg_from.addr = XtDefaultForeground;
- fg_to.addr = (XPointer)&fg;
- bg_from.size = strlen(XtDefaultBackground);
- bg_from.addr = XtDefaultBackground;
- bg_to.addr = (XPointer)&bg;
- if (!XtConvertAndStore
- (UxTopLevel, XtRString, &bg_from, XtRPixel, &bg_to)
- || !XtConvertAndStore
- (UxTopLevel, XtRString, &fg_from, XtRPixel, &fg_to)
- || (fg == bg)) {
- fg = WhitePixelOfScreen(XtScreen(UxTopLevel));
- bg = BlackPixelOfScreen(XtScreen(UxTopLevel));
- }
- if (depth)
- return (XmGetPixmapByDepth
- (XtScreen(UxTopLevel), file_name, fg, bg, depth));
-
- else
- return (XmGetPixmap(XtScreen(UxTopLevel), file_name, fg, bg));
-}
-
-/******************************************************************************
-NAME: UxConvert_bitmap( file_name )
-
-INPUT: char *file_name - bitmap file name
-
-RETURN: Pixmap - Pixmap of depth 1
-
-DESCRIPTION: Call ConvertPixmap with depth 1 (bitmap)
-
-CREATION: Visual Edge Software March 31, 1993
------------------------------------------------------------------------------*/
-#ifdef _NO_PROTO
-Pixmap UxConvert_bitmap( file_name )
- char *file_name;
-#else
-Pixmap UxConvert_bitmap( char *file_name )
-#endif
-{
- return (ConvertPixmap(file_name, 1));
-}
-
-/******************************************************************************
-NAME: UxConvertPixmap( file_name )
-
-INPUT: char *file_name - pixmap file name
-
-RETURN: Pixmap - Pixmap
-
-DESCRIPTION: Call ConvertPixmap with depth 0 (Pixmap)
-
-CREATION: Visual Edge Software March 31, 1993
------------------------------------------------------------------------------*/
-#ifdef _NO_PROTO
-Pixmap UxConvertPixmap( file_name )
- char *file_name;
-#else
-Pixmap UxConvertPixmap( char *file_name )
-#endif
-{
- return (ConvertPixmap(file_name, 0));
-}
-
-#endif
-
-/***************************************************************************
-NAME: UxRemoveValueFromArgList( args, ptr_num_args, res_name )
-INPUT: Arg *args : array of Arg's
- String res_name : name of resource
-INPUT & OUTPUT: Cardinal *ptr_num_args : number of Arg's
-RETURN: XtArgVal : value of resource
-DESCRIPTION: Searches for the named resource in the array of Arg's.
- If found, the corresponding element is removed from the array,
- the number of Arg's is decremented, and the resource value
- is returned.
- If the named resource is not found, the return value is zero.
-EXT REFERENCES: ---
-EXT EFFECTS: ---
-CREATION: Nov 27/92
-
----------------------------------------------------------------------------*/
-#ifdef _NO_PROTO
-XtArgVal UxRemoveValueFromArgList( args, ptr_num_args, res_name )
- Arg *args;
- Cardinal *ptr_num_args;
- String res_name;
-#else
-XtArgVal UxRemoveValueFromArgList( Arg *args, Cardinal *ptr_num_args,
- String res_name )
-#endif
-{
- Cardinal i, num_args;
-
- num_args = *ptr_num_args;
-
- for (i = 0; i < num_args; i++)
- {
- if ( ! strcmp( args[i].name, res_name ) )
- {
- Cardinal j;
- XtArgVal res_value = args[i].value;
-
- /* We remove this arg from the array by moving
- the remaining args down one in the array
- and decreasng the arg count */
-
- --num_args;
- for (j = i; j < num_args; j++)
- args[j] = args[j + 1];
-
- *ptr_num_args = num_args;
- return ( res_value );
- }
- }
-
- return ( (XtArgVal) 0 );
-}
-
-/*------------------------------------------------------------------------
- * NAME: UxNewContext
- * <Allocate a context structure>
- * INPUT: size -- of the desired structure
- * isSubclass -- nonzero if the requester is a subclass,
- * requiring that the result also be
- * returned for the base.
- * RETURNS: Pointer to a data area of (at least) the desired size.
- *------------------------------------------------------------------------*/
-#ifdef _NO_PROTO
-void* UxNewContext (size, isSubclass)
- size_t size;
- int isSubclass;
-#else
-void* UxNewContext (size_t size, int isSubclass)
-#endif /* _NO_PROTO */
-{
- static void* LastSubclassResult = 0;
- static int LastResultSize = 0;
-
- void * result;
-
- if (LastSubclassResult) {
- result = LastSubclassResult;
- } else {
- result = XtMalloc(size);
- }
-
- if (isSubclass) {
- LastSubclassResult = result;
- if (LastResultSize < size) {
- LastResultSize = size;
- }
- } else {
- LastSubclassResult = 0;
- LastResultSize = 0;
- }
-
- return (result);
-}
-/** end of file ***/
diff --git a/src/packlib/kuip/programs/kxterm/uxxt.h b/src/packlib/kuip/programs/kxterm/uxxt.h
deleted file mode 100644
index 18ab4c6..0000000
--- a/src/packlib/kuip/programs/kxterm/uxxt.h
+++ /dev/null
@@ -1,194 +0,0 @@
-/*
- * $Id: uxxt.h,v 1.2 1996/04/11 10:04:26 cernlib Exp $
- *
- * $Log: uxxt.h,v $
- * Revision 1.2 1996/04/11 10:04:26 cernlib
- * Remobe fortran comment lines
- *
- * Revision 1.1.1.1 1996/03/08 15:33:05 mclareni
- * Kuip
- *
- */
-/*---------------------------------------------------------------------
- * $Date: 1996/04/11 10:04:26 $ $Revision: 1.2 $
- *---------------------------------------------------------------------
- *
- *
- * Copyright (c) 1991, Visual Edge Software Ltd.
- *
- * ALL RIGHTS RESERVED. Permission to use, copy, modify, and
- * distribute this software and its documentation for any purpose
- * and without fee is hereby granted, provided that the above
- * copyright notice appear in all copies and that both that
- * copyright notice and this permission notice appear in supporting
- * documentation, and that the name of Visual Edge Software not be
- * used in advertising or publicity pertaining to distribution of
- * the software without specific, written prior permission. The year
- * included in the notice is the year of the creation of the work.
- *-------------------------------------------------------------------*/
-
-/*****************************************************************************/
-/* UxXt.h */
-/*****************************************************************************/
-
-#ifndef _UX_XT_H_
-#define _UX_XT_H_
-
-#include <stddef.h>
-#include <Xm/Xm.h>
-
-#ifdef UIL_CODE
-#include <Mrm/MrmPublic.h>
-#endif /* UIL_CODE */
-
-#if 0
-#ifdef __STDC__
-typedef char *caddr_t;
-#endif
-#endif
-
-/* Exception definitions for CORBA method bindings */
-typedef enum {
- NO_EXCEPTION,
- USER_EXCEPTION,
- SYSTEM_EXCEPTION
-} exception_type;
-
-typedef struct Environment {
- exception_type _major;
-} Environment;
-
-/* extern Environment UxEnv; */
-
-/* The following macros are used in converting string values to the form
- required by the widgets */
-
-#define RES_CONVERT( res_name, res_value) \
- XtVaTypedArg, (res_name), XmRString, (res_value), strlen(res_value) + 1
-
-#define UxPutStrRes( wgt, res_name, res_value ) \
- XtVaSetValues( wgt, RES_CONVERT( res_name, res_value ), NULL )
-
-
-#ifndef UX_INTERPRETER /* Omit this section when interpreting the code */
-
-/* The following macros are supplied for compatibility with swidget code */
-#define swidget Widget
-#define UxWidgetToSwidget(w) (w)
-#define UxGetWidget(sw) (sw)
-#define UxIsValidSwidget(sw) ((sw) != NULL)
-#define NO_PARENT ((Widget) NULL)
-#define UxThisWidget (UxWidget)
-
-/* Macros needed for the method support code */
-#define UxMalloc(a) (malloc(a))
-#define UxRealloc(a,b) (realloc((a), (b)))
-#define UxCalloc(a,b) (calloc((a), (b)))
-#define UxStrEqual(a,b) (!strcmp((a),(b)))
-#define UxGetParent(a) (XtParent((a)))
-
-#define no_grab XtGrabNone
-#define nonexclusive_grab XtGrabNonexclusive
-#define exclusive_grab XtGrabExclusive
-
-
-/* The following global variables are defined in the main() function */
-extern XtAppContext UxAppContext;
-extern Widget UxTopLevel;
-extern Display *UxDisplay;
-extern int UxScreen;
-
-
-/* The following are error codes returned by the functions in UxXt.c */
-#define UX_ERROR -1
-#define UX_NO_ERROR 0
-
-#ifdef UIL_CODE
-#ifdef _NO_PROTO
-extern void UxMrmFetchError();
-extern MrmHierarchy UxMrmOpenHierarchy();
-extern void UxMrmRegisterClass();
-#else
-extern void UxMrmFetchError(MrmHierarchy, char *, Widget, Cardinal);
-extern MrmHierarchy UxMrmOpenHierarchy( char *);
-extern void UxMrmRegisterClass( char *,
- Widget (*)(Widget, String, Arg *, Cardinal));
-#endif /* _NO_PROTO */
-#endif /* UIL_CODE */
-
-
-
-/* The following are declarations of the functions in UxXt.c */
-
-#ifdef _NO_PROTO
-
-extern int UxPopupInterface();
-extern int UxPopdownInterface();
-extern int UxDestroyInterface();
-extern int UxPutContext();
-extern caddr_t UxGetContext();
-extern void UxFreeClientDataCB();
-extern void UxLoadResources();
-extern XmFontList UxConvertFontList();
-extern Pixmap UxConvertPixmap();
-extern Pixmap UxConvert_bitmap();
-extern wchar_t * UxConvertValueWcs();
-extern void * UxNewContext();
-extern void UxDestroyContextCB();
-extern void UxDeleteContextCB();
-extern XtArgVal UxRemoveValueFromArgList();
-extern Widget UxChildSite();
-extern Widget UxRealWidget( );
-
-#else
-
-extern int UxPopupInterface( Widget wgt, XtGrabKind grab_flag );
-extern int UxPopdownInterface( Widget wgt );
-extern int UxDestroyInterface( Widget wgt);
-extern int UxPutContext( Widget wgt, caddr_t context );
-extern caddr_t UxGetContext( Widget wgt );
-extern void UxFreeClientDataCB( Widget wgt, XtPointer client_data,
- XtPointer call_data );
-extern void UxLoadResources( char *fname );
-extern XmFontList UxConvertFontList( char *fontlist_str );
-extern Pixmap UxConvertPixmap( char *file_name );
-extern Pixmap UxConvert_bitmap( char *file_name );
-extern wchar_t * UxConvertValueWcs( char *value_str );
-extern void * UxNewContext(size_t, int);
-extern void UxDestroyContextCB(Widget, XtPointer, XtPointer);
-extern void UxDeleteContextCB( Widget, XtPointer, XtPointer);
-extern XtArgVal UxRemoveValueFromArgList( Arg *args,
- Cardinal *ptr_num_args,
- String res_name );
-extern Widget UxChildSite( Widget );
-extern Widget UxRealWidget( Widget );
-
-#endif /* _NO_PROTO */
-
-#ifdef __cplusplus
-class _UxCInterface {
-
-public:
-
- virtual swidget childSite (Environment * pEnv) {
- if (pEnv)
- pEnv->_major = NO_EXCEPTION;
- return 0;
- }
- virtual swidget UxChildSite (swidget sw);
-
-protected:
- swidget UxThis;
-};
-
-#define CPLUS_ADAPT_CONTEXT(CLASS) \
- static inline \
- CLASS* UxGetContext(CLASS*self) {return self;} \
- static inline\
- void* UxGetContext(swidget any) {return ::UxGetContext(any);}
-
-#endif /* _cplusplus */
-
-#endif /* ! UX_INTERPRETER */
-
-#endif /* ! _UX_XT_H_ */
diff --git a/src/packlib/kuip/ykuip/Imakefile b/src/packlib/kuip/ykuip/Imakefile
deleted file mode 100644
index 2b90bb9..0000000
--- a/src/packlib/kuip/ykuip/Imakefile
+++ /dev/null
@@ -1,3 +0,0 @@
-SRCS_F= kmath_y.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/kuip/ykuip/kmath.y b/src/packlib/kuip/ykuip/kmath.y
deleted file mode 100644
index a49715a..0000000
--- a/src/packlib/kuip/ykuip/kmath.y
+++ /dev/null
@@ -1,1918 +0,0 @@
-/*
- * $Id: kmath.y,v 1.2 1997/01/17 17:07:28 cremel Exp $
- *
- * $Log: kmath.y,v $
- * Revision 1.2 1997/01/17 17:07:28 cremel
- * Bug correction for $UNQUOTE: this is the original code, written in Yacc.
- * --> must generate file code_kuip/kmath.c after yacc processing.
- *
- * Revision 1.1.1.1 1996/03/08 15:33:13 mclareni
- * Kuip
- *
- *
- *CMZ : 2.07/04 22/05/95 11.58.21 by Gunter Folger
- *-- Author : Alfred Nathaniel 29/06/93
- */
-/* kmath.y: KUIP expression evaluation */
-
-%{
-
-#include "kuip/kuip.h"
-#include "kuip/kfor.h"
-#include "kuip/kcom.h"
-#include "kuip/kmenu.h"
-#include "kuip/kflag.h"
-#include "kuip/khash.h"
-#include "kuip/kalias.h"
-#include "kuip/klink.h"
-#include "kuip/kmacro.h"
-
-enum {
- IFUN_x,
- IFUN_xx,
- IFUN_Cx,
- IFUN_CC,
- IFUN_CCxx,
- IFUN_CCx3,
- IFUN_xCx,
- IFUN_xCC,
- IFUN_xCx8
-};
-
-typedef struct _user_fundef {
- char *face_name; /* function name, e.g. HEXIST */
- int face_tok;
- char face_type[16];
- int face_const[16];
- char *face_sval[16];
- double face_dval[16];
- INT_FUNCPTR func;
- char *call_name;
- int call_tok;
- char call_type[16];
- int call_index[16];
- int call_const[16];
- char *call_sval[16];
- double call_dval[16];
- char *synopsis;
- char *guidance;
-} user_fundef;
-
-static user_fundef user_functions[100]; /* should be plenty */
-
-
-static char *pline;
-static int kline;
-static char *result;
-static int iresult;
-static double dresult;
-static int rsigma;
-static int wanted;
-
-/*
- * The nonum flag is set in some mid-rule actions that kmathlex should
- * classify a numeric constant as STRING.
- */
-static int nonum;
-
-static void call_user_function( const char*, char**, double*, int*, int );
-static int count_words( const char*, const char* );
-static char* extract_word( const char*, const char*, int );
-static char* join_words( const char*, const char*, int, int );
-static char* shell_line( const char*, int, const char* );
-static char* zero_pad( char*, int );
-
-extern int kmathparse(void);
-
-#ifdef ABS
-#undef ABS
-#endif
-
-%}
-
-
-%union {
- double dval;
- char *sval;
-}
-%token <dval> NUMBER
-%token <sval> STRING
-%token <sval> VNAME
-
-/* user defined functions */
-%token <sval> S_USER
-%token <sval> S_USER_S
-%token <sval> S_USER_X
-%token <sval> S_USER_X_S
-%token <sval> X_USER_S
-%token <sval> X_USER_X
-%token <sval> X_USER_X_S
-
-%token ABS
-%token INT
-%token MOD
-
-%token ANAM
-%token AVAL
-
-%token QUOTE
-%token UNQUOTE
-%token ENV
-%token FEXIST
-%token FORMAT
-%token INDEX
-%token LEN
-%token LOWER
-%token UPPER
-%token SUBSTRING
-%token WORD
-%token WORDS
-%token SHELL
-
-%token DEFINED
-%token INLINE
-%token iQUEST
-%token SIGMA
-%token RSIGMA
-
-%token VEXIST
-%token VDIM
-%token VLEN
-
-%token WANT_ANY
-%token WANT_BOOL
-%token WANT_MATH
-
-/*
- * Note that we cannot use character constants in the grammer because
- * Yacc translates them to integer constants according to the ASCII code
- */
-%token LT '<'
-%token EQ '='
-%token GT '>'
-%token PLUS '+'
-%token MINUS '-'
-%token STAR '*'
-%token SLASH '/'
-%token LPAR '('
-%token RPAR ')'
-%token COMMA ','
-
-%left OR /* logical operators */
-%left AND
-%left NOT
-%nonassoc LT EQ GT LE NE GE /* relational operators */
-%left PLUS MINUS
-%left STAR SLASH
-%left UPLUS UMINUS /* unary plus/minus */
-%left CONCAT
-
-%type <sval> Line
-%type <dval> Bool
-%type <dval> Expr
-%type <sval> Shell
-%type <sval> String
-%type <sval> Substring
-%type <sval> Word
-%type <sval> Words
-%type <sval> Vdim
-%type <sval> Vlen
-
-
-%%
-
-Line:
- WANT_BOOL Bool
- {
- iresult = $2; /* 0 or 1 */
- }
-
- | WANT_BOOL Expr
- {
- iresult = ($2 != 0);
- }
-
- | WANT_MATH Expr
- {
- dresult = $2;
- }
-
- | WANT_ANY Expr
- {
- int maxint = 0x7FFFFFFF;
- if( $2 <= maxint && $2 >= -maxint && (int)$2 == $2 ) {
- result = malloc( 16 );
- sprintf( result, "%d", (int)$2 );
- }
- else {
- result = strdup( strfromd( $2, 0 ) );
- }
- if( rsigma && strpbrk( result, ".eE" ) == NULL ) {
- /* append a dot to make an integer look like a float */
- result = mstrcat( result, "." );
- }
- }
-
- | WANT_ANY String
- {
- result = $2;
- }
-;
-
-
-Expr: NUMBER { $$ = $1; }
- | LPAR Expr RPAR { $$ = $2; }
- | PLUS Expr %prec UPLUS { $$ = $2; }
- | MINUS Expr %prec UMINUS { $$ = -$2; }
- | Expr PLUS Expr { $$ = $1 + $3; }
- | Expr MINUS Expr { $$ = $1 - $3; }
- | Expr STAR Expr { $$ = $1 * $3; }
- | ABS Expr RPAR { $$ = $2 < 0 ? -$2 : $2; }
- | INT Expr RPAR { $$ = (int)$2; }
- | iQUEST Expr RPAR { $$ = IQUEST((int)$2); }
-
- | Expr SLASH Expr
- {
- if( $3 != 0 )
- $$ = $1 / $3;
- else
- YYABORT;
- }
- | MOD Expr COMMA Expr RPAR
- {
- if( $4 != 0 )
-/* $$ = $2 / $4 - (int)($2 / $4); */
- $$ = (int) $2 % (int) $4;
- else
- YYABORT;
- }
-
-/* Without the nonum flag we get problems for strings looking like numbers */
- | LEN {nonum=1;} String RPAR
- {
- $$ = strlen( $3 );
- free( $3 );
- nonum = 0;
- }
-
- | INDEX {nonum=1;} String COMMA String RPAR
- {
- char *p = strstr( $3, $5 );
- if( p == NULL )
- $$ = 0;
- else
- $$ = p - $3 + 1;
- free( $3 );
- free( $5 );
- nonum = 0;
- }
-
- | Words RPAR
- {
- $$ = count_words( $1, " " );
- nonum = 0;
- }
-
- | Words COMMA String RPAR
- {
- $$ = count_words( $1, $3 );
- free( $3 );
- nonum = 0;
- }
-
- | FEXIST {nonum=1;} String RPAR
- {
- FILE *stream = fopen( $3, "r" );
- if( stream == NULL ) {
- $$ = 0;
- }
- else {
- $$ = 1;
- fclose( stream );
- }
- free( $3 );
- nonum = 0;
- }
-
- | VEXIST {nonum=1;} String RPAR
- {
- $$ = ku_vtype( $3 );
- free( $3 );
- nonum = 0;
- }
-
- | Vdim RPAR
- {
- if( ku_vtype( $1 ) != 0 )
- $$ = IQUEST( 31 );
- else
- $$ = 0;
- free( $1 );
- }
- | Vdim COMMA Expr RPAR
- {
- int n = $3;
- if( n >= 1 && n <= 3 && ku_vtype( $1 ) != 0 )
- $$ = IQUEST(30+n);
- else
- $$ = 0;
- free( $1 );
- }
-
- | Vlen RPAR
- {
- if( ku_vtype( $1 ) != 0 ) {
- int k = IQUEST(31);
- if( IQUEST(32) == 1 && IQUEST(33) == 1 ) {
- int low = ku_vqaddr( $1 );
- while( k > 0 && IQ(low+k-1) == 0 )
- k--;
- }
- $$ = k;
- }
- else
- $$ = 0;
- free( $1 );
- }
- | Vlen COMMA Expr RPAR
- {
- int n = $3;
- if( n >= 1 && n <= 3 && ku_vtype( $1 ) != 0 ) {
- int k = IQUEST(30+n);
- if( n == 1 && IQUEST(32) == 1 && IQUEST(33) == 1 ) {
- int low = ku_vqaddr( $1 );
- while( k > 0 && IQ(low+k-1) == 0 )
- k--;
- }
- $$ = k;
- }
- else
- $$ = 0;
- free( $1 );
- }
-
- | VNAME Expr RPAR
- {
- int n = strlen( $1 );
- $1 = realloc( $1, n + 16 );
- sprintf( &$1[n], "(%d)", (int)$2 );
- n = ku_vvalue( $1, &$$ );
- free( $1 );
- if( n != 0 )
- YYABORT;
- }
- | VNAME Expr COMMA Expr RPAR
- {
- int n = strlen( $1 );
- $1 = realloc( $1, n + 32 );
- sprintf( &$1[n], "(%d,%d)", (int)$2, (int)$4 );
- n = ku_vvalue( $1, &$$ );
- free( $1 );
- if( n != 0 )
- YYABORT;
- }
- | VNAME Expr COMMA Expr COMMA Expr RPAR
- {
- int n = strlen( $1 );
- $1 = realloc( $1, n + 48 );
- sprintf( &$1[n], "(%d,%d,%d)", (int)$2, (int)$4, (int)$6 );
- n = ku_vvalue( $1, &$$ );
- free( $1 );
- if( n != 0 )
- YYABORT;
- }
-
- | X_USER_S {nonum=1;} String RPAR
- {
- char *slist[2];
- double dlist[2];
- int which[2];
- which[0] = 2;
- slist[1] = $3;
- which[1] = 1;
- call_user_function( $1, slist, dlist, which, 1 );
- $$ = dlist[0];
- nonum = 0;
- }
-
- | X_USER_X Expr RPAR
- {
- char *slist[2];
- double dlist[2];
- int which[2];
- which[0] = 2;
- dlist[1] = $2;
- which[1] = 2;
- call_user_function( $1, slist, dlist, which, 1 );
- $$ = dlist[0];
- }
-
- | X_USER_X_S Expr COMMA {nonum=1;} String RPAR
- {
- char *slist[3];
- double dlist[3];
- int which[3];
- which[0] = 2;
- dlist[1] = $2;
- which[1] = 2;
- slist[2] = $5;
- which[2] = 1;
- call_user_function( $1, slist, dlist, which, 2 );
- $$ = dlist[0];
- nonum = 0;
- }
-
-;
-
-
-Bool: LPAR Bool RPAR { $$ = $2; }
- | NOT Bool { $$ = ! $2; }
- | Bool AND Bool { $$ = $1 && $3; }
- | Bool OR Bool { $$ = $1 || $3; }
- | Expr LT Expr { $$ = $1 < $3; }
- | Expr GT Expr { $$ = $1 > $3; }
- | Expr LE Expr { $$ = $1 <= $3; }
- | Expr GE Expr { $$ = $1 >= $3; }
-
-/*
- * Round to machine precision for comparison of two expressions
- */
- | Expr EQ Expr
- {
- char *s1 = strdup( strfromd( $1, 0 ) );
- $$ = (strcmp( s1, strfromd( $3, 0 ) ) == 0);
- free( s1 );
- }
- | Expr NE Expr
- {
- char *s1 = strdup( strfromd( $1, 0 ) );
- $$ = (strcmp( s1, strfromd( $3, 0 ) ) != 0);
- free( s1 );
- }
-
-/*
- * If either side is a String "=" and "<>" become string comparions.
- * The lexical tie-in avoids the rules "String EQ Expr" etc.
- */
- | String EQ {nonum=1;} String
- {
- $$ = (strcmp( $1, $4 ) == 0);
- free( $1 );
- free( $4 );
- nonum = 0;
- }
- | Expr EQ String
- {
- $$ = (strcmp( strfromd( $1,0 ), $3 ) == 0);
- free( $3 );
- }
-
- | String NE {nonum=1;} String
- {
- $$ = (strcmp( $1, $4 ) != 0);
- free( $1 );
- free( $4 );
- nonum = 0;
- }
- | Expr NE String
- {
- $$ = (strcmp( strfromd( $1,0 ), $3 ) != 0);
- free( $3 );
- }
-;
-
-String: STRING { $$ = $1; }
-
- | String CONCAT {nonum=1;} String
- {
- $$ = mstrcat( $1, $4 );
- free( $4 );
- nonum = 0;
- }
- | Expr CONCAT {nonum=1;} String
- {
- $$ = strdup( strfromd( $1, 0 ) );
- $$ = mstrcat( $$, $4);
- free( $4 );
- nonum = 0;
- }
-
- | S_USER RPAR
- {
- char *slist[1];
- double dlist[1];
- int which[1];
- which[0] = 1;
- call_user_function( $1, slist, dlist, which, 0 );
- $$ = slist[0];
- }
-
- | S_USER_S {nonum=1;} String RPAR
- {
- char *slist[2];
- double dlist[2];
- int which[2];
- which[0] = 1;
- slist[1] = $3;
- which[1] = 1;
- call_user_function( $1, slist, dlist, which, 1 );
- $$ = slist[0];
- nonum = 0;
- }
-
- | S_USER_X Expr RPAR
- {
- char *slist[2];
- double dlist[2];
- int which[2];
- which[0] = 1;
- dlist[1] = $2;
- which[1] = 2;
- call_user_function( $1, slist, dlist, which, 1 );
- $$ = slist[0];
- }
-
- | S_USER_X_S Expr COMMA {nonum=1;} String RPAR
- {
- char *slist[3];
- double dlist[3];
- int which[3];
- which[0] = 1;
- dlist[1] = $2;
- which[1] = 2;
- slist[2] = $5;
- which[2] = 1;
- call_user_function( $1, slist, dlist, which, 2 );
- $$ = slist[0];
- nonum = 0;
- }
-
- | ANAM Expr RPAR
- {
- int n = $2;
- if( n > 0 && n <= hash_entries( kc_alias.arg_table ) ) {
- HashArray *alias = hash_array( kc_alias.arg_table );
- $$ = strdup( alias[n-1].name );
- free( (char*)alias );
- }
- else
- YYABORT;
- }
-
- | AVAL Expr RPAR
- {
- int n = $2;
- if( n > 0 && n <= hash_entries( kc_alias.arg_table ) ) {
- HashArray *alias = hash_array( kc_alias.arg_table );
- $$ = strdup( (char*)alias[n-1].value );
- free( (char*)alias );
- }
- else
- YYABORT;
- }
-
- | ENV {nonum=1;} String RPAR
- {
- if( ($$ = getenv( $3 )) == NULL )
- $$ = "";
- free( $3 );
- $$ = strdup( $$ );
- nonum = 0;
- }
-
- | DEFINED {nonum=1;} String RPAR
- {
- int n = hash_entries( kc_alias.var_table );
- $$ = strdup( "" );
- if( n > 0 ) {
- HashArray *values = hash_array( kc_alias.var_table );
- int i;
- for( i = 0; i < n; i++ ) {
- char *name = values[i].name;
-
- if( ku_match( name, $3, 1 ) ) {
- if( $$[0] != '\0' )
- $$ = mstrcat( $$, " " );
- $$ = mstrcat( $$, name );
- }
- }
- free( (char*)values );
- }
- free( $3 );
- nonum = 0;
- }
-
-
- | FORMAT Expr COMMA String RPAR
- {
- char format[16];
- char *dot;
- int n = fstrtoi( $4 + 1, &dot );
- int m = 0;
-
- if( *dot == '.' ) {
- char *tail;
- m = fstrtoi( dot + 1, &tail );
- }
-
- $$ = realloc( $4, 256 ); /* some safety for too small n */
-
- switch( $$[0] ) {
-
- case 'I': case 'i':
- sprintf( format, "%%%dd", n );
- sprintf( $$, format, (int)$2 );
- if( m > 0 )
- $$ = zero_pad( $$, m );
- break;
-
- case 'Z': case 'z': /* hexadecimal */
- sprintf( format, "%%%dX", n );
- sprintf( $$, format, (int)$2 );
- if( m > 0 )
- $$ = zero_pad( $$, m );
- break;
-
- case 'F': case 'f':
- sprintf( format, "%%%d.%df", n, m );
- sprintf( $$, format, $2 );
- /* force a decimal point */
- if( strchr( $$, '.' ) == NULL )
- $$ = mstrcat( $$, "." );
- break;
-
- case 'E': case 'e':
- sprintf( format, "%%%d.%de", n, m );
- sprintf( $$, format, $2 );
- strupper( $$ );
- break;
-
- case 'G': case 'g':
- sprintf( format, "%%%d.%dg", n, m );
- sprintf( $$, format, $2 );
- strupper( $$ );
- break;
-
- default: /* error */
- free( $$ );
- YYABORT;
- break;
- }
- }
-
-
- | QUOTE {nonum=1;} String RPAR
- {
- $$ = quote_string( $3, 1 );
- nonum = 0;
- }
-
- | UNQUOTE {nonum=1;} String RPAR
- {
- /* int n = strlen( $$ ); - NC - */
- int n = strlen( $3 );
- $$ = $3;
- if( n >= 2 && $$[0] == '\'' && $$[n-1] == '\'' ) {
- char *p = $$;
- $$[n-1] = '\0';
- strcpy( $$, $$ + 1 );
- while( (p = strstr( p, "''" )) != NULL ) {
- strcpy( p, p + 1 );
- p++;
- }
- }
- nonum = 0;
- }
-
- | Word RPAR
- {
- $$ = extract_word( $1, " ", 1 );
- free( $1 );
- nonum = 0;
- }
- | Word COMMA Expr RPAR
- {
- $$ = extract_word( $1, " ", (int)$3 );
- free( $1 );
- }
- | Word COMMA Expr COMMA Expr RPAR
- {
- char *sep = " ";
- $$ = join_words( $1, sep, (int)$3, (int)$5 );
- free( $1 );
- }
- | Word COMMA Expr COMMA Expr COMMA {nonum=1;} String RPAR
- {
- $$ = join_words( $1, $8, (int)$3, (int)$5 );
- free( $1 );
- free( $8 );
- nonum = 0;
- }
-
- | LOWER {nonum=1;} String RPAR
- {
- $$ = strlower( $3 );
- nonum = 0;
- }
-
- | UPPER {nonum=1;} String RPAR
- {
- $$ = strupper( $3 );
- nonum = 0;
- }
-
-/* SUBSTRING(s,k) */
- | Substring Expr RPAR
- {
- int len = strlen( $1 );
- int k = $2;
- $$ = $1;
- if( k <= 0 )
- k += len + 1;
- if( k > len )
- $$[0] = '\0';
- else if( k < 1 )
- YYABORT;
- else
- strcpy( $$, $$ + k - 1 );
- }
-
-/* SUBSTRING(s,k,n) */
- | Substring Expr COMMA Expr RPAR
- {
- int len = strlen( $1 );
- int k = $2;
- int n = $4;
- $$ = $1;
- if( k <= 0 )
- k += len + 1;
- if( k > len )
- $$[0] = '\0';
- else if( k < 1 )
- YYABORT;
- else {
- strcpy( $$, $$ + k - 1 );
- if( k + n <= len )
- $$[n] = '\0';
- }
- }
-
-/* SHELL(cmd) */
- | Shell RPAR
- {
- $$ = shell_line( $1, 0, " " );
- free( $1 );
- }
-
-/* SHELL(cmd,sep) */
- | Shell COMMA String RPAR
- {
- $$ = shell_line( $1, 0, $3 );
- free( $1 );
- free( $3 );
- }
-
-/* SHELL(cmd,n) */
- | Shell COMMA Expr RPAR
- {
- int n = $3;
- $$ = shell_line( $1, n, NULL );
- free( $1 );
- }
-;
-
-
-/*
- * This rule allows to reset nonum before the parses has to decide between
- * SUBSTRING(s,k) and SUBSTRING(s,k,n).
- */
-Substring:
- SUBSTRING {nonum=1;} String COMMA
- {
- $$ = $3;
- nonum = 0;
- }
-
-Words: WORDS {nonum=1;} String
- {
- $$ = $3;
- }
-
-Word: WORD {nonum=1;} String
- {
- $$ = $3;
- nonum = 0;
- }
-
-Shell: SHELL {nonum=1;} String
- {
- $$ = $3;
- nonum = 0;
- }
-
-
-/*
- * For the vector functions we want to get the vector name as a STRING.
- * That avoids that single element vectors would come back as a NUMBER.
- */
-Vdim: VDIM {nonum=1;} String
- {
- $$ = $3;
- nonum = 0;
- }
-
-Vlen: VLEN {nonum=1;} String
- {
- $$ = $3;
- nonum = 0;
- }
-
-%%
-
-
-/*
- * execute a shell command and return the n'th line of its output
- * if n<=0 return complete output with newlines replaced by blanks
- */
-static
-char *shell_line( const char *cmd,
- int n,
- const char *sep )
-{
-#ifdef UNIX
- FILE *stream;
- char *shell_cmd;
- int status;
-
-#ifdef MSDOS
- shell_cmd = str3dup( cmd, " >", kc_flags.appl_file );
-#else
- /* protect against noclobber option */
- shell_cmd = str5dup( "cp /dev/null ", kc_flags.appl_file, " ; rm ",
- kc_flags.appl_file, " ; ( " );
- shell_cmd = mstr3cat( shell_cmd, cmd, " ) > ", kc_flags.appl_file );
-#endif
-
- status = shsystem( kc_value.set_host_shell, shell_cmd );
- free( shell_cmd );
- if( status == -1 ) {
- perror( "$SHELL" );
- }
- else if( (stream = fopen( kc_flags.appl_file, "r" )) != NULL ) {
- char line[1024];
- char *value = NULL;
-
- if( sep == NULL ) {
- while( --n > 0 ) {
- fgets( line, (sizeof line), stream );
- }
- if( fgets( line, (sizeof line), stream ) != NULL ) {
- int len = strlen( line );
- line[len-1] = '\0';
- value = strdup( line );
- }
- }
- else {
- while( fgets( line, (sizeof line), stream ) != NULL ) {
- int len = strlen( line );
- line[len-1] = '\0';
- if( value == NULL ) {
- value = strdup( line );
- }
- else {
- value = mstr2cat( value, sep, line );
- }
- }
- }
- fclose( stream );
- remove( kc_flags.appl_file );
- return value;
- }
-#endif
-
- return strdup( "" );
-}
-
-
-static
-int count_words( const char *line,
- const char *sep )
-{
- int n = 0;
- while( 1 ) {
- char *p = extract_word( line, sep, n + 1 );
- if( *p != '\0' ) {
- free( p );
- n++;
- }
- else {
- free( p );
- break;
- }
- }
- return n;
-}
-
-
-static
-char *extract_word( const char *line,
- const char *sep,
- int k )
-{
- const char *p = line;
- int n = 0;
- if( *sep != '\0' ) {
- while( k-- > 0 ) {
- p += n;
- while( *p != '\0' && strchr( sep, *p ) != NULL )
- p++;
- n = 0;
- while( strchr( sep, p[n] ) == NULL )
- n++;
- }
- }
- return strndup( p, n );
-}
-
-
-static
-char *join_words( const char *line,
- const char *sep,
- int k,
- int n )
-{
- char *words = strdup( "" );
- while( n-- > 0 ) {
- char *p = extract_word( line, sep, k++ );
- if( p[0] != '\0' ) {
- if( words[0] != '\0' )
- words = mstrcat( words, sep );
- words = mstrcat( words, p );
- free( p );
- }
- else {
- free( p );
- break;
- }
- }
- return words;
-}
-
-
-/*
- * VAX C printf() does not understand "%5.3d" to do zero padding
- * and we have to do it by hand.
- */
-static
-char* zero_pad( char *format,
- int m )
-{
- int n = strlen( format );
- int minus = 0;
-
- while( --n >= 0 && --m >= 0 ) {
- if( format[n] == '-' ) {
- minus = 1;
- format[n] = '0';
- }
- else if( format[n] == ' ' )
- format[n] = '0';
- }
-
- if( minus ) {
- if( n >= 0 )
- format[n] = '-';
- else {
- char *p = str2dup( "-", format );
- free( format );
- return p;
- }
- }
- return format;
-}
-
-
-/*
- * enter a user define system function
- * chname is of the form "<T>=<name>(<T><T>...)"
- */
-void F77_ENTRY_C4E(Kufdef,chsyn,chguid,chface,chcall,fun)
-/* { */
- char *face = fstrdup( chface, len_chface );
- char *call = fstrdup( chcall, len_chcall );
- int i;
-
- for( i = 0; i < sizeof(user_functions) / sizeof(user_fundef) - 1; i++ ) {
-
- if( user_functions[i].face_tok == 0 ) {
- char face_class[16];
- char call_class[16];
- int argc;
- char *p;
- int n;
-
- user_functions[i].face_name = face + 2;
- user_functions[i].face_type[0] = face[0];
- user_functions[i].face_sval[0] = NULL;
- p = strchr( face, ')' );
- *p = ',';
- p = strchr( face, '(' );
- *p++ = '\0';
-
- if( *p == ',' ) {
- n = 1; /* no arguments */
- }
- else {
- for( n = 1; *p != '\0'; n++ ) {
- char *argv = NULL;
-
- user_functions[i].face_type[n] = *p;
- if( p[1] == '=' ) {
- char *s = strchr( p, ',' );
- *s = '\0';
- argv = p + 2;
- p = s;
- }
- else {
- p += 2;
- }
- user_functions[i].face_sval[n] = argv;
- }
- }
- user_functions[i].face_type[n] = '\0';
- argc = n;
-
- for( n = 0; n < argc; n++ ) {
- char *argv = user_functions[i].face_sval[n];
-
- if( strchr( "stuS", user_functions[i].face_type[n] ) != NULL ) {
- face_class[n] = 'S';
- if( argv != NULL )
- user_functions[i].face_const[n] = 1;
- }
- else {
- face_class[n] = 'X';
- if( argv != NULL ) {
- user_functions[i].face_const[n] = 2;
- user_functions[i].face_dval[n] = atof( argv );
- }
- }
- }
- face_class[n] = '\0';
-
- if( strcmp( face_class, "S" ) == 0 ) {
- user_functions[i].face_tok = S_USER;
- }
- else if( strcmp( face_class, "SS" ) == 0 ) {
- user_functions[i].face_tok = S_USER_S;
- }
- else if( strcmp( face_class, "SX" ) == 0 ) {
- user_functions[i].face_tok = S_USER_X;
- }
- else if( strcmp( face_class, "SXS" ) == 0 ) {
- user_functions[i].face_tok = S_USER_X_S;
- }
- else if( strcmp( face_class, "XS" ) == 0 ) {
- user_functions[i].face_tok = X_USER_S;
- }
- else if( strcmp( face_class, "XX" ) == 0 ) {
- user_functions[i].face_tok = X_USER_X;
- }
- else if( strcmp( face_class, "XXS" ) == 0 ) {
- user_functions[i].face_tok = X_USER_X_S;
- }
- else {
- printf( " *** KUFDEF: %s face class %s not implemented\n",
- user_functions[i].face_name, face_class );
- return;
- }
-
- user_functions[i].func = (INT_FUNCPTR)fun;
- user_functions[i].call_name = call + 2;
- user_functions[i].call_type[0] = call[0];
- user_functions[i].call_sval[0] = NULL;
-
- p = strchr( call, ')' );
- *p = ',';
- p = strchr( call, '(' );
- *p++ = '\0';
- for( n = 1; *p != '\0'; n++ ) {
- char *argv = NULL;
-
- user_functions[i].call_type[n] = *p;
- if( isdigit( p[1] ) ) {
- user_functions[i].call_index[n] = p[1] - '0';
- p++;
- }
-
- if( p[1] == '=' ) {
- char *s = strchr( p, ',' );
- *s = '\0';
- argv = p + 2;
- p = s;
- }
- else {
- p += 2;
- }
- user_functions[i].call_sval[n] = argv;
- }
- user_functions[i].call_type[n] = '\0';
- argc = n;
-
- for( n = 0; n < argc; n++ ) {
- char *argv = user_functions[i].call_sval[n];
-
- if( strchr( "stuC$", user_functions[i].call_type[n] ) != NULL ) {
- call_class[n] = 'S';
- if( argv != NULL )
- user_functions[i].call_const[n] = 1;
- }
- else {
- call_class[n] = 'X';
- if( argv != NULL ) {
- user_functions[i].call_const[n] = 2;
- user_functions[i].call_dval[n] = atof( argv );
- }
- }
- }
- call_class[n] = '\0';
-
- if( strcmp( call_class, "XX" ) == 0 ) {
- user_functions[i].call_tok = IFUN_x;
- }
- else if( strcmp( call_class, "XXX" ) == 0 ) {
- user_functions[i].call_tok = IFUN_xx;
- }
- else if( strcmp( call_class, "XSX" ) == 0 ) {
- user_functions[i].call_tok = IFUN_Cx;
- }
- else if( strcmp( call_class, "XSS" ) == 0 ) {
- user_functions[i].call_tok = IFUN_CC;
- }
- else if( strcmp( call_class, "XSSXX" ) == 0 ) {
- user_functions[i].call_tok = IFUN_CCxx;
- }
- else if( strcmp( call_class, "XSSXXX" ) == 0 ) {
- user_functions[i].call_tok = IFUN_CCx3;
- }
- else if( strcmp( call_class, "XXSX" ) == 0 ) {
- user_functions[i].call_tok = IFUN_xCx;
- }
- else if( strcmp( call_class, "XXSS" ) == 0 ) {
- user_functions[i].call_tok = IFUN_xCC;
- }
- else if( strcmp( call_class, "XXSXXXXXXXX" ) == 0 ) {
- user_functions[i].call_tok = IFUN_xCx8;
- }
- else {
- printf( " *** KUFDEF: %s call class %s not implemented\n",
- user_functions[i].call_name, call_class );
- return;
- }
- user_functions[i].synopsis = fstrdup( chsyn, len_chsyn );
- user_functions[i].guidance = fstrdup( chguid, len_chguid );
- return;
- }
- }
- printf( " *** KUFDEF: too many definitions --- %s ignored\n", face );
-}
-
-
-/*
- * User help routine for /KUIP/FUNCTIONS
- */
-char **kxfunclist()
-{
- char **text = (char**)malloc( sizeof(char*) );
- int k = 0;
- int n;
-
- for( n = 0; user_functions[n].face_tok != 0; n++ ) {
-
- if( user_functions[n].synopsis[0] != '\0'
- || user_functions[n].guidance[0] != '\0' ) {
- int len = strlen( user_functions[n].synopsis );
-
- text[k] = str3dup( " ", user_functions[n].synopsis, " " );
- text[k] = mstrccat( text[k], '.', 28 - len );
- text[k] = mstr2cat( text[k], " ", user_functions[n].guidance );
- text = (char**)realloc( (char*)text, (k+2) * sizeof( char* ) );
- k++;
- }
- }
- text[k] = NULL;
-
- return text;
-}
-
-
-static
-void call_user_function( const char *name,
- char **slist,
- double *dlist,
- int *which,
- int npar )
-{
- user_fundef *ufun = NULL;
- char *sval[16];
- double dval[16];
- EQUIV_INT_REAL xval[16][10];
- char cval[16][256];
- char *p;
- char c;
- int i;
- int j;
-
- for( i = 0; user_functions[i].face_tok != 0; i++ ) {
-
- if( strcasecmp( user_functions[i].face_name, name ) == 0 ) {
-
- ufun = &user_functions[i];
- for( j = 1; j <= npar; j++ ) {
- if( ufun->face_const[j] == 1
- && strcasecmp( ufun->face_sval[j], slist[j] ) != 0 ) {
- ufun = NULL;
- break;
- }
- if( ufun->face_const[j] == 2
- && ufun->face_dval[j] != dlist[j] ) {
- ufun = NULL;
- break;
- }
- }
-
- if( ufun != NULL )
- break;
- }
- }
-
- if( ufun == NULL ) {
- char *comma = "";
- printf( " *** Invalid argument in function %s(", name );
- for( i = 1; i <= npar; i++ ) {
- if( which[i] == 1 )
- printf( "%s%s", comma, slist[i] );
- else
- printf( "%s%s", comma, strfromd( dlist[i], 0 ) );
- comma = ",";
- }
- printf( ")\n" );
-
- if( which[0] == 1 )
- slist[0] = str2dup( name, "(?)" );
- else
- dlist[0] = 1.2345e6;
- return;
- }
-
- for( i = 1; ufun->call_type[i] != '\0'; i++ ) {
- sval[i] = ufun->call_sval[i];
- dval[i] = ufun->call_dval[i];
- }
-
- for( i = 1; (c = ufun->face_type[i]) != '\0'; i++ ) {
-
- if( (p = strchr( ufun->call_type, c )) != NULL ) {
- int n = p - ufun->call_type;
-
- sval[n] = slist[i];
- dval[n] = dlist[i];
- }
- }
-
- for( i = 1; (c = ufun->call_type[i]) != '\0'; i++ ) {
-
- if( strchr( "stuC$", c ) != NULL ) {
- char *s = (sval[i] != NULL) ? sval[i] : "";
- if( c == '$' )
- s = ufun->call_name;
- else if( c == 'u' )
- strupper( s );
- fstrset( cval[i], 256, s );
- }
- else if( strchr( "ijkI", c ) != NULL ) {
- xval[i][0].i = dval[i];
- }
- else if( strchr( "lmnL", c ) != NULL ) {
- xval[i][0].l = ku_true( dval[i] != 0 );
- }
- else if( strchr( "xyzR", c ) != NULL ) {
- xval[i][0].r = dval[i];
- }
- }
-
- switch( ufun->call_tok ) {
-
- case IFUN_x:
- F77_IFUN_x(xval[0][0].i,ufun->func,xval[1]);
- break;
-
- case IFUN_xx:
- F77_IFUN_xx(xval[0][0].i,ufun->func,xval[1],xval[2]);
- break;
-
- case IFUN_Cx:
- F77_IFUN_Cx(xval[0][0].i,ufun->func,cval[1],256,xval[2]);
- break;
-
- case IFUN_CC:
- F77_IFUN_CC(xval[0][0].i,ufun->func,cval[1],256,cval[2],256);
- break;
-
- case IFUN_CCxx:
- F77_IFUN_CCxx(xval[0][0].i,ufun->func,cval[1],256,cval[2],256,
- xval[3],xval[4]);
- break;
-
- case IFUN_CCx3:
- F77_IFUN_CCx3(xval[0][0].i,ufun->func,cval[1],256,cval[2],256,
- xval[3],xval[4],xval[5]);
- break;
-
- case IFUN_xCx:
- F77_IFUN_xCx(xval[0][0].i,ufun->func,xval[1],cval[2],256,xval[3]);
- break;
-
- case IFUN_xCC:
- F77_IFUN_xCC(xval[0][0].i,ufun->func,xval[1],cval[2],256,cval[3],256);
- break;
-
- case IFUN_xCx8:
- F77_IFUN_xCx8(xval[0][0].i,ufun->func,xval[1],cval[2],256,
- xval[3],xval[4],xval[5],xval[6],
- xval[7],xval[8],xval[9],xval[10]);
- break;
- }
-
- c = ufun->face_type[0];
- p = strchr( ufun->call_type, c );
- i = p - ufun->call_type;
- j = ufun->call_index[i];
-
- if( strchr( "stu", c ) != NULL ) {
- slist[0] = fstrdup( cval[i], 256 );
- }
- else if( strchr( "ijk", c ) != NULL ) {
- dlist[0] = xval[i][j].i;
- }
- else if( strchr( "lmn", c ) != NULL ) {
- dlist[0] = (xval[i][j].l != ku_true( 0 ));
- }
- else if( strchr( "xyz", c ) != NULL ) {
- dlist[0] = xval[i][j].r;
- }
- else if( strchr( "def", c ) != NULL ) {
- DBLPREC dbl;
- memcpy( (void*)&dbl, (void*)xval[i], sizeof(DBLPREC) );
- dlist[0] = dbl;
- }
-}
-
-
-/*
- * Replace $EXEC functions which we can't leave to the non-reentrent parser.
- */
-char *repl_exec( const char *line )
-{
- int quoted = 0;
- const char *p;
-
- for( p = line; *p != '\0'; p++ ) {
- int n;
-
- if( *p == '\'' ) {
- quoted = !quoted;
- }
- else if( !quoted && strncasecmp( p, "$EXEC(", 6 ) == 0
- && (n = match_paren( p )) > 0 ) {
-
- char *args = clean_word( strndup( p + 6, n - 7 ) );
- char *cmd = str2dup( "EXEC ", args );
- char *new_line = strndup( line, p - line );
- char *old_value = strdup( hash_lookup( kc_alias.var_table, "@", NULL ) );
- char *value;
-
- ku_exel( cmd );
- free( args );
- free( cmd );
-
- value = quote_string( strdup( hash_lookup( kc_alias.var_table,
- "@", NULL ) ), 0 );
- store_variable( NULL, "@", old_value );
- free( old_value );
-
- new_line = mstr2cat( new_line, value, p + n );
- free( value );
-
- return new_line;
- }
- }
- return NULL;
-}
-
-
-char *subst_exec( const char *line )
-{
- char *ldup = strdup( line );
- char *p;
-
- while( (p = repl_exec( ldup )) != NULL ) {
- free( ldup );
- ldup = p;
- }
- return ldup;
-}
-
-
-/*
- * Evaluate an expression and return the result as an allocated string.
- * If the expression cannot be parsed a NULL string is returned.
- */
-char *ku_eval( const char *line )
-{
- char *val = NULL;
-
- /* pline must be the first of these static assignments !!! */
- pline = subst_exec( line );
- kline = 0;
- nonum = 0;
- rsigma = 0;
- wanted = WANT_ANY;
-
- if( kmathparse() == 0 )
- val = result;
-
- free( pline );
- return val;
-}
-
-
-/*
- * Evaluate numerical expressions
- */
-int ku_math( const char *line, double *dval )
-{
- int status = -1;
-
- /* pline must be the first of these static assignments !!! */
- pline = subst_exec( line );
- kline = 0;
- nonum = 0;
- rsigma = 0;
- wanted = WANT_MATH;
-
- if( kmathparse() == 0 ) {
- status = 0;
- *dval = dresult;
- }
-
- free( pline );
- return status;
-}
-
-
-/*
- * Evaluate boolean expressions
- * Return -1 if invalid expression
- */
-int ku_bool( const char *line )
-{
- int bool = -1;
-
- /* pline must be the first of these static assignments !!! */
- pline = subst_exec( line );
- kline = 0;
- nonum = 0;
- rsigma = 0;
- wanted = WANT_BOOL;
-
- if( kmathparse() == 0 )
- bool = iresult;
-
- free( pline );
- return bool;
-}
-
-
-/*
- * Evaluate expression.
- * For invalid expressions variable, alias, and system function substitution.
- */
-char *ku_expr( const char *line )
-{
- char *value = ku_eval( line );
-
- if( value == NULL ) {
- char *p;
- value = strdup( line );
-
- kc_alias.substitutions = 100; /* protect against recursive aliases */
-
- if( (p = subst_var_alias( value )) != NULL ) {
- free( value );
- value = p;
- }
-
- if( (p = subst_arg_alias( value )) != NULL ) {
- free( value );
- value = p;
- }
-
- if( (p = subst_sysfun( value, 1 )) != NULL ) {
- free( value );
- value = p;
- }
- }
- return value;
-}
-
-
-static
-int kmathlex()
-{
- static struct tokens {
- char *tok;
- int val;
- } op[] = {
- { "//", CONCAT},
- { ".NOT.", NOT },
- { ".AND.", AND },
- { ".OR.", OR },
- { ".LE.", LE }, { "<=", LE },
- { ".GE.", GE }, { ">=", GE },
- { ".NE.", NE }, { "<>", NE },
- { ".EQ.", EQ },
- { ".LT.", LT },
- { ".GT.", GT }
- }, fun[] = {
- { "ABS", ABS },
- { "INT", INT },
- { "MOD", MOD },
- { "$ANAM", ANAM },
- { "$AVAL", AVAL },
- { "$DEFINED", DEFINED },
- { "$ENV", ENV },
- { "$FEXIST", FEXIST },
- { "$FORMAT", FORMAT },
- { "$INDEX", INDEX },
- { "$INLINE", INLINE },
- { "$IQUEST", iQUEST },
- { "$LEN", LEN },
- { "$LOWER", LOWER },
- { "$QUOTE", QUOTE },
- { "$RSIGMA", RSIGMA },
- { "$SHELL", SHELL },
- { "$SIGMA", SIGMA },
- { "$SUBSTRING", SUBSTRING },
- { "$UNQUOTE", UNQUOTE },
- { "$UPPER", UPPER },
- { "$VDIM", VDIM },
- { "$VEXIST", VEXIST },
- { "$VLEN", VLEN },
- { "$WORD", WORD },
- { "$WORDS", WORDS },
- }, single[] = {
- { "<", LT },
- { "=", EQ },
- { ">", GT },
- { "+", PLUS },
- { "-", MINUS },
- { "*", STAR },
- { "/", SLASH },
- { "(", LPAR },
- { ")", RPAR },
- { ",", COMMA }
- };
- char *str;
- char *p;
- int c;
- int i;
- int n;
-
- if( wanted ) {
- int w = wanted;
- wanted = 0;
- return w;
- }
-
- while( (c = pline[kline]) == ' ' || c == '\t' )
- kline++; /* ignore spaces */
-
- if( c == '\0' )
- return 0;
-
- if( c == '\'' ) { /* quoted string */
- int quoted = 1;
- str = NULL;
-
- for( n = kline + 1; pline[n] != '\0'; n++ ) {
- if( pline[n] == '\'' ) {
- quoted = !quoted;
- if( !quoted && pline[n+1] != '\'' ) {
- str = strndup( &pline[kline+1], n - kline - 1 );
- break;
- }
- }
- }
- if( str != NULL ) { /* remove quotes */
- char *s;
- for( p = str; (s = strstr( p, "''" )) != NULL; p = s + 1 )
- strcpy( s, s + 1 );
- kmathlval.sval = str;
- kline = n + 1;
- return STRING;
- }
- }
-
- /* check for macro variable */
- if( c == '[' ) {
- /*
- * Isolate the variable name and classify the translation
- * as number or string.
- */
- int paren = 1;
-
- for( p = pline + kline + 1; *p != '\0'; p++ ) {
-
- if( *p == '[' ) {
- paren++;
- }
- else if( *p == ']' ) {
-
- if( --paren == 0 ) {
- int len = p - &pline[kline] + 1;
- char *name = strndup( &pline[kline], len );
- char *value = var_value( name );
- free( name );
-
- kline += len;
-
- /* e.g. for $UPPER([s]) do not try classify [s] as a number */
- if( !nonum ) {
- char *tail;
- kmathlval.dval = fstrtod( value, &tail );
- if( *tail == '\0' ) {
- free( value );
- return NUMBER;
- }
- /* allow "[vname]([i])" */
- if( ku_vtype( value ) != 0 ) {
- /*
- * test if name is followed by '('
- * otherwise it must be a single element vector for which we
- * return the immediate value
- */
- p = &pline[kline];
- while( *p == ' ' )
- p++;
- if( *p == '(' ) {
- kline = p - pline + 1;
- kmathlval.sval = value;
- return VNAME;
- }
- else if( ku_vvalue( value, &kmathlval.dval ) == 0 ) {
- kline = p - pline;
- free( value );
- return NUMBER;
- }
- }
- }
- kmathlval.sval = value;
- return STRING;
- }
- }
- }
- }
-
- /* numbers */
- if( !nonum && ( isdigit( c )
- || ( c == '.' && isdigit( pline[kline+1] ) ) ) ) {
- char *tail;
- str = pline + kline;
- kmathlval.dval = strtod( str, &tail );
- if( tail != str ) {
- kline += tail - str;
- return NUMBER;
- }
- }
-
- /* multiple character operators */
- for( i = 0; i < (sizeof op) / sizeof( struct tokens ); i++ ) {
- n = strlen( op[i].tok );
-
- if( strncasecmp( &pline[kline], op[i].tok, n ) == 0 ) {
- kline += n;
- return op[i].val;
- }
- }
-
- /* single character operators */
- for( i = 0; i < (sizeof single) / sizeof( struct tokens ); i++ ) {
- if( single[i].tok[0] == c ) {
- kline++;
- return single[i].val;
- }
- }
-
- /* alias names */
- n = len_alias( pline + kline, (kline > 0) ? pline[kline-1] : '\0' );
- if( n > 0 ) {
- char *name = strndup( &pline[kline], n );
- if( (p = subst_arg_alias( name )) != NULL ) {
- free( name );
- kline += n;
- if( !nonum ) {
- char *tail;
- kmathlval.dval = fstrtod( p, &tail );
- if( *tail == '\0' ) {
- free( p );
- return NUMBER;
- }
- }
- kmathlval.sval = p;
- return STRING;
- }
- free( name );
- }
-
- /* vector names */
- if( !nonum ) {
- n = len_vector( pline + kline );
- if( n > 0 ) {
- char *name = strndup( &pline[kline], n );
- if( ku_vtype( name ) != 0 ) {
- /*
- * test if name is followed by '('
- * otherwise it must be a single element vector for which we
- * return the immediate value
- */
- p = &pline[kline+n];
- while( *p == ' ' )
- p++;
- if( *p == '(' ) {
- kline = p - pline + 1;
- kmathlval.sval = name;
- return VNAME;
- }
- else if( ku_vvalue( name, &kmathlval.dval ) == 0 ) {
- kline = p - pline;
- free( name );
- return NUMBER;
- }
- }
- free( name );
- }
- }
-
- /* user defined functions */
- for( i = 0; user_functions[i].face_tok != 0; i++ ) {
- n = strlen( user_functions[i].face_name );
-
- if( strncasecmp( pline + kline, user_functions[i].face_name, n ) == 0 ) {
-
- while( pline[kline+n] == ' ' )
- n++;
-
- if( pline[kline+n] == '(' ) {
- kline += n + 1;
- kmathlval.sval = user_functions[i].face_name;
- return user_functions[i].face_tok;
- }
- }
- }
-
- /* system functions with arguments */
- for( i = 0; i < (sizeof fun) / sizeof( struct tokens ); i++ ) {
- int n = strlen( fun[i].tok );
-
- if( strncasecmp( &pline[kline], fun[i].tok, n ) == 0 ) {
- int k = kline + n;
-
- while( pline[k] == ' ' || pline[k] == '\t' )
- k++;
-
- if( pline[k] == '(' ) {
-
- if( fun[i].val == SIGMA || fun[i].val == RSIGMA
- || fun[i].val == INLINE ) {
- /*
- * SIGMA expressions do not follow our syntax rules.
- * We isolate the SIGMA expression by looking for the matching ")".
- * Before calling SIGMA we have to substitute macro variables and
- * system functions without arguments. We cannot substitute
- * system functions with arguments because this is done by the
- * expression parser which is not reentrant.
- * The result is returned as a vector name.
- *
- * INLINE allows textual substitution in an expression.
- * The argument is alias and variable expanded and replaced in the
- * expression line.
- */
- int len = match_paren( pline + k );
-
- if( len > 0 ) {
- char *expr = strndup( pline + k + 1, len - 2 );
-
- if( (p = subst_arg_alias( expr )) != NULL ) {
- free( expr );
- expr = p;
- }
- if( (p = subst_var_alias( expr )) != NULL ) {
- free( expr );
- expr = p;
- }
- if( (p = subst_sysfun( expr, 0 )) != NULL ) {
- free( expr );
- expr = p;
- }
-
- if( fun[i].val == INLINE ) {
- p = strndup( pline, kline );
- p = mstrcat( p, expr );
- free( expr );
- p = mstrcat( p, pline + k + len );
- free( pline );
- pline = p;
- return kmathlex();
- }
- else if( kjmpaddr.user_sigma_F != NULL ) {
- char vname[16]; /* temporary sigma vector */
-
- sprintf( vname, "?SIG%d", ++kc_flags.temp_vectors );
- p = str3dup( vname, "=", expr );
- free( expr );
- fstrset( Sikuip.CHSIGM, (sizeof Sikuip.CHSIGM), p );
- free( p );
-
- (*kjmpaddr.user_sigma_F)();
- if( IQUEST(1) != 0 ) {
- kc_flags.temp_vectors--;
- }
- else {
- rsigma = (fun[i].val == RSIGMA);
- kline = k + len;
- if( ku_vvalue( vname, &kmathlval.dval ) == 0 )
- return NUMBER;
- kmathlval.sval = strdup( vname );
- return STRING;
- }
- }
- }
- }
- else {
- kline = k + 1;
- return fun[i].val;
- }
- }
- }
- }
-
- /* system functions without arguments */
- if( c == '$' ) {
- if( (n = len_sysfun( pline + kline + 1 )) > 0 ) {
- char *name = strndup( pline + kline, n + 1 );
- char *value = repl_sysfun( name, 0 );
- free( name );
- if( value != NULL ) {
- kline += n + 1;
- if( !nonum ) {
- char *tail;
- kmathlval.dval = fstrtod( value, &tail );
- if( *tail == '\0' ) {
- free( value );
- return NUMBER;
- }
- }
- kmathlval.sval = value;
- return STRING;
- }
- }
- }
-
- /* classify other stuff as unquoted string */
- n = 1;
- while( strchr( " =,)[", pline[kline+n] ) == NULL )
- n++;
-
- str = strupper( strndup( pline + kline, n ) );
-
- /* check that there is no operator before the end of the string */
- for( i = 0; i < (sizeof op) / sizeof( struct tokens ); i++ ) {
- if( (p = strstr( str, op[i].tok )) != NULL ) {
- *p = '\0';
- }
- }
- n = strlen( str );
- free( str );
-
- kmathlval.sval = strndup( &pline[kline], n );
- kline += n;
- return STRING;
-}
-
-
-static
-void kmatherror()
-{
- /* ignore */
-}
diff --git a/src/packlib/minuit/Imakefile b/src/packlib/minuit/Imakefile
deleted file mode 100644
index 069a0b8..0000000
--- a/src/packlib/minuit/Imakefile
+++ /dev/null
@@ -1,13 +0,0 @@
-
-#define IHaveSubdirs
-#define PassCDebugFlags
-
-SUBDIRS= code examples minuit
-
-TopOfPackage(minuit)
-
-SubdirLibraryTarget(minuit,code)
-
-TestSubdirs(examples)
-
-InstallIncludeSubdirs(minuit)
diff --git a/src/packlib/minuit/code/Imakefile b/src/packlib/minuit/code/Imakefile
deleted file mode 100644
index 680126c..0000000
--- a/src/packlib/minuit/code/Imakefile
+++ /dev/null
@@ -1,11 +0,0 @@
-SRCS_F= minuit.F mnamin.F mnbins.F mncalf.F mncler.F mncntr.F mncomd.F \ @@\
- mncont.F mncrck.F mncros.F mncuve.F mnderi.F mndxdi.F mneig.F \ @@\
- mnemat.F mnerrs.F mneval.F mnexcm.F mnexin.F mnfixp.F mnfree.F \ @@\
- mngrad.F mnhelp.F mnhes1.F mnhess.F mnimpr.F mninex.F mninit.F \ @@\
- mninpu.F mnintr.F mnlims.F mnline.F mnmatu.F mnmigr.F mnmnos.F \ @@\
- mnmnot.F mnparm.F mnpars.F mnpfit.F mnpint.F mnplot.F mnpout.F \ @@\
- mnprin.F mnpsdf.F mnrazz.F mnread.F mnrn15.F mnrset.F mnsave.F \ @@\
- mnscan.F mnseek.F mnset.F mnseti.F mnsimp.F mnstat.F mnstin.F \ @@\
- mntiny.F mnunpt.F mnvers.F mnvert.F mnwarn.F mnwerr.F stand.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/minuit/code/minuit.F b/src/packlib/minuit/code/minuit.F
deleted file mode 100644
index 42dca92..0000000
--- a/src/packlib/minuit/code/minuit.F
+++ /dev/null
@@ -1,141 +0,0 @@
-*
-* $Id: minuit.F,v 1.1.1.1 1996/03/07 14:31:28 mclareni Exp $
-*
-* $Log: minuit.F,v $
-* Revision 1.1.1.1 1996/03/07 14:31:28 mclareni
-* Minuit
-*
-*
-#include "minuit/pilot.h"
- SUBROUTINE MINUIT(FCN,FUTIL)
-#include "minuit/d506dp.inc"
-#include "minuit/d506cm.inc"
-C
-C CPNAM Parameter name (10 characters)
-C U External (visible to user in FCN) value of parameter
-C ALIM, BLIM Lower and upper parameter limits. If both zero, no limits.
-C ERP,ERN Positive and negative MINOS errors, if calculated.
-C WERR External parameter error (standard deviation, defined by UP)
-C GLOBCC Global Correlation Coefficient
-C NVARL =-1 if parameter undefined, =0 if constant,
-C = 1 if variable without limits, =4 if variable with limits
-C (Note that if parameter has been fixed, NVARL=1 or =4, and NIOFEX=0)
-C NIOFEX Internal parameter number, or zero if not currently variable
-C NEXOFI External parameter number for currently variable parameters
-C X, XT Internal parameter values (X are sometimes saved in XT)
-C DIRIN (Internal) step sizes for current step
-C variables with names ending in ..S are saved values for fixed params
-C VHMAT (Internal) error matrix stored as Half MATrix, since
-C it is symmetric
-C VTHMAT VHMAT is sometimes saved in VTHMAT, especially in MNMNOT
-C
-C ISW definitions:
-C ISW(1) =0 normally, =1 means CALL LIMIT EXCEEDED
-C ISW(2) =0 means no error matrix
-C =1 means only approximate error matrix
-C =2 means full error matrix, but forced pos-def.
-C =3 means good normal full error matrix exists
-C ISW(3) =0 if Minuit is calculating the first derivatives
-C =1 if first derivatives calculated inside FCN
-C ISW(4) =-1 if most recent minimization did not converge.
-C = 0 if problem redefined since most recent minimization.
-C =+1 if most recent minimization did converge.
-C ISW(5) is the PRInt level. See SHO PRIntlevel
-C ISW(6) = 0 for batch mode, =1 for interactive mode
-C =-1 for originally interactive temporarily batch
-C
-C LWARN is true if warning messges are to be put out (default=true)
-C SET WARN turns it on, set NOWarn turns it off
-C LREPOR is true if exceptional conditions are put out (default=false)
-C SET DEBUG turns it on, SET NODebug turns it off
-C LIMSET is true if a parameter is up against limits (for MINOS)
-C LNOLIM is true if there are no limits on any parameters (not yet used)
-C LNEWMN is true if the previous process has unexpectedly improved FCN
-C LPHEAD is true if a heading should be put out for the next parameter
-C definition, false if a parameter has just been defined
-C
- EXTERNAL FCN,FUTIL
- CHARACTER*40 CWHYXT
- DATA CWHYXT/'FOR UNKNOWN REASONS '/
- DATA JSYSRD,JSYSWR,JSYSSA/5,6,7/
-C . . . . . . . . . . initialize minuit
- WRITE (JSYSWR,'(1X,75(1H*))')
- CALL MNINIT (JSYSRD,JSYSWR,JSYSSA)
-C . . . . initialize new data block
- 100 CONTINUE
- WRITE (ISYSWR,'(1X,75(1H*))')
- NBLOCK = NBLOCK + 1
- WRITE (ISYSWR,'(26X,A,I4)') 'MINUIT DATA BLOCK NO.',NBLOCK
- WRITE (ISYSWR,'(1X,75(1H*))')
-C . . . . . . . . . . . set parameter lists to undefined
- CALL MNCLER
-C . . . . . . . . read title
- CALL MNREAD(FCN,1,IFLGUT,FUTIL)
- IF (IFLGUT .EQ. 2) GO TO 500
- IF (IFLGUT .EQ. 3) GO TO 600
-C . . . . . . . . read parameters
- CALL MNREAD(FCN,2,IFLGUT,FUTIL)
- IF (IFLGUT .EQ. 2) GO TO 500
- IF (IFLGUT .EQ. 3) GO TO 600
- IF (IFLGUT .EQ. 4) GO TO 700
-C . . . . . . verify FCN not time-dependent
- WRITE (ISYSWR,'(/A,A)') ' MINUIT: FIRST CALL TO USER FUNCTION,',
- + ' WITH IFLAG=1'
- NPARX = NPAR
- CALL MNINEX(X)
- FZERO = UNDEFI
- CALL FCN(NPARX,GIN,FZERO,U,1,FUTIL)
- FIRST = UNDEFI
- CALL FCN(NPARX,GIN,FIRST,U,4,FUTIL)
- NFCN = 2
- IF (FZERO.EQ.UNDEFI .AND. FIRST.EQ.UNDEFI) THEN
- CWHYXT = 'BY ERROR IN USER FUNCTION. '
- WRITE (ISYSWR,'(/A,A/)') ' USER HAS NOT CALCULATED FUNCTION',
- + ' VALUE WHEN IFLAG=1 OR 4'
- GO TO 800
- ENDIF
- AMIN = FIRST
- IF (FIRST .EQ. UNDEFI) AMIN=FZERO
- CALL MNPRIN(1,AMIN)
- NFCN = 2
- IF (FIRST .EQ. FZERO) GO TO 300
- FNEW = 0.0
- CALL FCN(NPARX,GIN,FNEW,U,4,FUTIL)
- IF (FNEW .NE. AMIN) WRITE (ISYSWR,280) AMIN, FNEW
- 280 FORMAT (/' MINUIT WARNING: PROBABLE ERROR IN USER FUNCTION.'/
- + ' FOR FIXED VALUES OF PARAMETERS, FCN IS TIME-DEPENDENT'/
- + ' F =',E22.14,' FOR FIRST CALL'/
- + ' F =',E22.14,' FOR SECOND CALL.'/)
- NFCN = 3
- 300 FVAL3 = 2.0*AMIN+1.0
-C . . . . . . . . . . . read commands
- CALL MNREAD(FCN,3,IFLGUT,FUTIL)
- IF (IFLGUT .EQ. 2) GO TO 500
- IF (IFLGUT .EQ. 3) GO TO 600
- IF (IFLGUT .EQ. 4) GO TO 700
- CWHYXT = 'BY MINUIT COMMAND: '//CWORD
- IF (INDEX(CWORD,'STOP').GT. 0) GO TO 800
- IF (INDEX(CWORD,'EXI') .GT. 0) GO TO 800
- IF (INDEX(CWORD,'RET') .EQ. 0) GO TO 100
- CWHYXT = 'AND RETURNS TO USER PROGRAM. '
- WRITE (ISYSWR,'(A,A)') ' ..........MINUIT TERMINATED ',CWHYXT
- RETURN
-C . . . . . . stop conditions
- 500 CONTINUE
- CWHYXT = 'BY END-OF-DATA ON PRIMARY INPUT FILE. '
- GO TO 800
- 600 CONTINUE
- CWHYXT = 'BY UNRECOVERABLE READ ERROR ON INPUT. '
- GO TO 800
- 700 CONTINUE
- CWHYXT = ': FATAL ERROR IN PARAMETER DEFINITIONS. '
- 800 WRITE (ISYSWR,'(A,A)') ' ..........MINUIT TERMINATED ',CWHYXT
- STOP
-C
-C ......................entry to set unit numbers - - - - - - - - - -
- ENTRY MINTIO(I1,I2,I3)
- JSYSRD = I1
- JSYSWR = I2
- JSYSSA = I3
- RETURN
- END
diff --git a/src/packlib/minuit/code/mnamin.F b/src/packlib/minuit/code/mnamin.F
deleted file mode 100644
index a7cad5a..0000000
--- a/src/packlib/minuit/code/mnamin.F
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: mnamin.F,v 1.1.1.1 1996/03/07 14:31:28 mclareni Exp $
-*
-* $Log: mnamin.F,v $
-* Revision 1.1.1.1 1996/03/07 14:31:28 mclareni
-* Minuit
-*
-*
-#include "minuit/pilot.h"
- SUBROUTINE MNAMIN(FCN,FUTIL)
-#include "minuit/d506dp.inc"
-CC Called from many places. Initializes the value of AMIN by
-CC calling the user function. Prints out the function value and
-CC parameter values if Print Flag value is high enough.
-CC
-#include "minuit/d506cm.inc"
- EXTERNAL FCN,FUTIL
- NPARX = NPAR
- IF (ISW(5) .GE. 1) WRITE (ISYSWR,'(/A,A)') ' FIRST CALL TO ',
- + 'USER FUNCTION AT NEW START POINT, WITH IFLAG=4.'
- CALL MNEXIN(X)
- CALL FCN(NPARX,GIN,FNEW,U,4,FUTIL)
- NFCN = NFCN + 1
- AMIN = FNEW
- EDM = BIGEDM
- RETURN
- END
diff --git a/src/packlib/minuit/code/mnbins.F b/src/packlib/minuit/code/mnbins.F
deleted file mode 100644
index 8421c02..0000000
--- a/src/packlib/minuit/code/mnbins.F
+++ /dev/null
@@ -1,67 +0,0 @@
-*
-* $Id: mnbins.F,v 1.1.1.1 1996/03/07 14:31:28 mclareni Exp $
-*
-* $Log: mnbins.F,v $
-* Revision 1.1.1.1 1996/03/07 14:31:28 mclareni
-* Minuit
-*
-*
-#include "minuit/pilot.h"
- SUBROUTINE MNBINS(A1,A2,NAA,BL,BH,NB,BWID)
-#include "minuit/d506dp.inc"
-C SUBROUTINE TO DETERMINE REASONABLE HISTOGRAM INTERVALS
-C GIVEN ABSOLUTE UPPER AND LOWER BOUNDS A1 AND A2
-C AND DESIRED MAXIMUM NUMBER OF BINS NAA
-C PROGRAM MAKES REASONABLE BINNING FROM BL TO BH OF WIDTH BWID
-C F. JAMES, AUGUST, 1974 , stolen for Minuit, 1988
- PARAMETER (ZERO=0.0, ONE=1.0)
- AL = MIN(A1,A2)
- AH = MAX(A1,A2)
- IF (AL.EQ.AH) AH = AL + 1.
-C IF NAA .EQ. -1 , PROGRAM USES BWID INPUT FROM CALLING ROUTINE
- IF (NAA .EQ. -1) GO TO 150
- 10 NA = NAA - 1
- IF (NA .LT. 1) NA = 1
-C GET NOMINAL BIN WIDTH IN EXPON FORM
- 20 AWID = (AH-AL)/FLOAT(NA)
- LOG = INT(DLOG10(DBLE(AWID)))
- IF (AWID .LE. ONE) LOG=LOG-1
- SIGFIG = AWID * (10.00 **(-LOG))
-C ROUND MANTISSA UP TO 2, 2.5, 5, OR 10
- IF(SIGFIG .GT. 2.0) GO TO 40
- SIGRND = 2.0
- GO TO 100
- 40 IF (SIGFIG .GT. 2.5) GO TO 50
- SIGRND = 2.5
- GO TO 100
- 50 IF(SIGFIG .GT. 5.0) GO TO 60
- SIGRND =5.0
- GO TO 100
- 60 SIGRND = 1.0
- LOG = LOG + 1
- 100 CONTINUE
- BWID = SIGRND*10.0**LOG
- GO TO 200
-C GET NEW BOUNDS FROM NEW WIDTH BWID
- 150 IF (BWID .LE. ZERO) GO TO 10
- 200 CONTINUE
- ALB = AL/BWID
- LWID=ALB
- IF (ALB .LT. ZERO) LWID=LWID-1
- BL = BWID*FLOAT(LWID)
- ALB = AH/BWID + 1.0
- KWID = ALB
- IF (ALB .LT. ZERO) KWID=KWID-1
- BH = BWID*FLOAT(KWID)
- NB = KWID-LWID
- IF (NAA .GT. 5) GO TO 240
- IF (NAA .EQ. -1) RETURN
-C REQUEST FOR ONE BIN IS DIFFICULT CASE
- IF (NAA .GT. 1 .OR. NB .EQ. 1) RETURN
- BWID = BWID*2.0
- NB = 1
- RETURN
- 240 IF (2*NB .NE. NAA) RETURN
- NA = NA + 1
- GO TO 20
- END
diff --git a/src/packlib/minuit/code/mncalf.F b/src/packlib/minuit/code/mncalf.F
deleted file mode 100644
index 24e7317..0000000
--- a/src/packlib/minuit/code/mncalf.F
+++ /dev/null
@@ -1,40 +0,0 @@
-*
-* $Id: mncalf.F,v 1.1.1.1 1996/03/07 14:31:28 mclareni Exp $
-*
-* $Log: mncalf.F,v $
-* Revision 1.1.1.1 1996/03/07 14:31:28 mclareni
-* Minuit
-*
-*
-#include "minuit/pilot.h"
- SUBROUTINE MNCALF(FCN,PVEC,YCALF,FUTIL)
-#include "minuit/d506dp.inc"
-CC Called only from MNIMPR. Transforms the function FCN
-CC by dividing out the quadratic part in order to find further
-CC minima. Calculates ycalf = (f-fmin)/(x-xmin)*v*(x-xmin)
-CC
-#include "minuit/d506cm.inc"
- EXTERNAL FCN,FUTIL
- DIMENSION PVEC(15)
- NPARX = NPAR
- CALL MNINEX(PVEC)
- CALL FCN(NPARX,GIN,F,U,4,FUTIL)
- NFCN = NFCN + 1
- DO 200 I= 1, NPAR
- GRD(I) = 0.
- DO 200 J= 1, NPAR
- M = MAX(I,J)
- N = MIN(I,J)
- NDEX = M*(M-1)/2 + N
- 200 GRD(I) = GRD(I) + VTHMAT(NDEX) * (XT(J)-PVEC(J))
- DENOM = 0.
- DO 210 I= 1, NPAR
- 210 DENOM = DENOM + GRD(I) * (XT(I)-PVEC(I))
- IF (DENOM .LE. ZERO) THEN
- DCOVAR = 1.
- ISW(2) = 0
- DENOM = 1.0
- ENDIF
- YCALF = (F-APSI) / DENOM
- RETURN
- END
diff --git a/src/packlib/minuit/code/mncler.F b/src/packlib/minuit/code/mncler.F
deleted file mode 100644
index 4df4f80..0000000
--- a/src/packlib/minuit/code/mncler.F
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: mncler.F,v 1.1.1.1 1996/03/07 14:31:28 mclareni Exp $
-*
-* $Log: mncler.F,v $
-* Revision 1.1.1.1 1996/03/07 14:31:28 mclareni
-* Minuit
-*
-*
-#include "minuit/pilot.h"
- SUBROUTINE MNCLER
-#include "minuit/d506dp.inc"
-CC Called from MINUIT and by option from MNEXCM
-CC Resets the parameter list to UNDEFINED
-#include "minuit/d506cm.inc"
- NPFIX = 0
- NU = 0
- NPAR = 0
- NFCN = 0
- NWRMES(1) = 0
- NWRMES(2) = 0
- DO 10 I= 1, MAXEXT
- U(I) = 0.0
- CPNAM(I) = CUNDEF
- NVARL(I) = -1
- 10 NIOFEX(I) = 0
- CALL MNRSET(1)
- CFROM = 'CLEAR '
- NFCNFR = NFCN
- CSTATU ='UNDEFINED '
- LNOLIM = .TRUE.
- LPHEAD = .TRUE.
- RETURN
- END
diff --git a/src/packlib/minuit/code/mncntr.F b/src/packlib/minuit/code/mncntr.F
deleted file mode 100644
index 9e96942..0000000
--- a/src/packlib/minuit/code/mncntr.F
+++ /dev/null
@@ -1,155 +0,0 @@
-*
-* $Id: mncntr.F,v 1.1.1.1 1996/03/07 14:31:28 mclareni Exp $
-*
-* $Log: mncntr.F,v $
-* Revision 1.1.1.1 1996/03/07 14:31:28 mclareni
-* Minuit
-*
-*
-#include "minuit/pilot.h"
- SUBROUTINE MNCNTR(FCN,KE1,KE2,IERRF,FUTIL)
-#include "minuit/d506dp.inc"
-CC to print function contours in two variables, on line printer
-CC
-#include "minuit/d506cm.inc"
- EXTERNAL FCN,FUTIL
- PARAMETER (NUMBCS=20,NXMAX=115)
- DIMENSION CONTUR(NUMBCS), FCNA(NXMAX),FCNB(NXMAX)
- CHARACTER CLABEL*(NUMBCS)
- CHARACTER CHLN*(NXMAX),CHMID*(NXMAX),CHZERO*(NXMAX)
- DATA CLABEL/'0123456789ABCDEFGHIJ'/
-C input arguments: parx, pary, devs, ngrid
- IF (KE1.LE.0 .OR. KE2.LE.0) GO TO 1350
- IF (KE1.GT.NU .OR. KE2.GT.NU) GO TO 1350
- KI1 = NIOFEX(KE1)
- KI2 = NIOFEX(KE2)
- IF (KI1.LE.0 .OR. KI2.LE.0) GO TO 1350
- IF (KI1 .EQ. KI2) GO TO 1350
-C
- IF (ISW(2) .LT. 1) THEN
- CALL MNHESS(FCN,FUTIL)
- CALL MNWERR
- ENDIF
- NPARX = NPAR
- XSAV = U(KE1)
- YSAV = U(KE2)
- DEVS = WORD7(3)
- IF (DEVS .LE. ZERO) DEVS=2.
- XLO = U(KE1) - DEVS*WERR(KI1)
- XUP = U(KE1) + DEVS*WERR(KI1)
- YLO = U(KE2) - DEVS*WERR(KI2)
- YUP = U(KE2) + DEVS*WERR(KI2)
- NGRID = WORD7(4)
- IF (NGRID .LE. 0) THEN
- NGRID=25
- NX = MIN(NPAGWD-15,NGRID)
- NY = MIN(NPAGLN-7, NGRID)
- ELSE
- NX = NGRID
- NY = NGRID
- ENDIF
- IF (NX .LT. 11) NX=11
- IF (NY .LT. 11) NY=11
- IF (NX .GE. NXMAX) NX=NXMAX-1
-C ask if parameter outside limits
- IF (NVARL(KE1) .GT. 1) THEN
- IF (XLO .LT. ALIM(KE1)) XLO = ALIM(KE1)
- IF (XUP .GT. BLIM(KE1)) XUP = BLIM(KE1)
- ENDIF
- IF (NVARL(KE2) .GT. 1) THEN
- IF (YLO .LT. ALIM(KE2)) YLO = ALIM(KE2)
- IF (YUP .GT. BLIM(KE2)) YUP = BLIM(KE2)
- ENDIF
- BWIDX = (XUP-XLO)/REAL(NX)
- BWIDY = (YUP-YLO)/REAL(NY)
- IXMID = INT((XSAV-XLO)*REAL(NX)/(XUP-XLO)) + 1
- IF (AMIN .EQ. UNDEFI) CALL MNAMIN(FCN,FUTIL)
- DO 185 I= 1, NUMBCS
- CONTUR(I) = AMIN + UP*FLOAT(I-1)**2
- 185 CONTINUE
- CONTUR(1) = CONTUR(1) + 0.01*UP
-C fill FCNB to prepare first row, and find column zero
- U(KE2) = YUP
- IXZERO = 0
- XB4 = ONE
- DO 200 IX= 1, NX+1
- U(KE1) = XLO + REAL(IX-1)*BWIDX
- CALL FCN(NPARX,GIN,FF,U,4,FUTIL)
- FCNB(IX) = FF
- IF (XB4.LT.ZERO .AND. U(KE1).GT.ZERO) IXZERO = IX-1
- XB4 = U(KE1)
- CHMID(IX:IX) = '*'
- CHZERO(IX:IX)= '-'
- 200 CONTINUE
- WRITE (ISYSWR,'(A,I3,A,A)') ' Y-AXIS: PARAMETER ',
- + KE2,': ',CPNAM(KE2)
- IF (IXZERO .GT. 0) THEN
- CHZERO(IXZERO:IXZERO) = '+'
- CHLN = ' '
- WRITE (ISYSWR,'(12X,A,A)') CHLN(1:IXZERO),'X=0'
- ENDIF
-C loop over rows
- DO 280 IY= 1, NY
- UNEXT = U(KE2) - BWIDY
-C prepare this line's background pattern for contour
- CHLN = ' '
- CHLN(IXMID:IXMID) = '*'
- IF (IXZERO .NE. 0) CHLN(IXZERO:IXZERO) = ':'
- IF (U(KE2).GT.YSAV .AND. UNEXT.LT.YSAV) CHLN=CHMID
- IF (U(KE2).GT.ZERO .AND. UNEXT.LT.ZERO) CHLN=CHZERO
- U(KE2) = UNEXT
- YLABEL = U(KE2) + 0.5*BWIDY
-C move FCNB to FCNA and fill FCNB with next row
- DO 220 IX= 1, NX+1
- FCNA(IX) = FCNB(IX)
- U(KE1) = XLO + REAL(IX-1)*BWIDX
- CALL FCN(NPARX,GIN,FF,U,4,FUTIL)
- FCNB(IX) = FF
- 220 CONTINUE
-C look for contours crossing the FCNxy squares
- DO 250 IX= 1, NX
- FMX = MAX(FCNA(IX),FCNB(IX),FCNA(IX+1),FCNB(IX+1))
- FMN = MIN(FCNA(IX),FCNB(IX),FCNA(IX+1),FCNB(IX+1))
- DO 230 ICS= 1, NUMBCS
- IF (CONTUR(ICS) .GT. FMN) GO TO 240
- 230 CONTINUE
- GO TO 250
- 240 IF (CONTUR(ICS) .LT. FMX) CHLN(IX:IX)=CLABEL(ICS:ICS)
- 250 CONTINUE
-C print a row of the contour plot
- WRITE (ISYSWR,'(1X,G12.4,1X,A)') YLABEL,CHLN(1:NX)
- 280 CONTINUE
-C contours printed, label x-axis
- CHLN = ' '
- CHLN( 1: 1) = 'I'
- CHLN(IXMID:IXMID) = 'I'
- CHLN(NX:NX) = 'I'
- WRITE (ISYSWR,'(14X,A)') CHLN(1:NX)
-C the hardest of all: print x-axis scale!
- CHLN = ' '
- IF (NX .LE. 26) THEN
- NL = MAX(NX-12,2)
- NL2 = NL/2
- WRITE (ISYSWR,'(8X,G12.4,A,G12.4)') XLO,CHLN(1:NL),XUP
- WRITE (ISYSWR,'(14X,A,G12.4)') CHLN(1:NL2),XSAV
- ELSE
- NL = MAX(NX-24,2)/2
- NL2 = NL
- IF (NL .GT. 10) NL2=NL-6
- WRITE (ISYSWR,'(8X,G12.4,A,G12.4,A,G12.4)') XLO,
- + CHLN(1:NL),XSAV,CHLN(1:NL2),XUP
- ENDIF
- WRITE (ISYSWR,'(6X,A,I3,A,A,A,G12.4)') ' X-AXIS: PARAMETER',
- + KE1,': ',CPNAM(KE1),' ONE COLUMN=',BWIDX
- WRITE (ISYSWR,'(A,G12.4,A,G12.4,A)') ' FUNCTION VALUES: F(I)=',
- + AMIN,' +',UP,' *I**2'
-C finished. reset input values
- U(KE1) = XSAV
- U(KE2) = YSAV
- IERRF = 0
- RETURN
- 1350 WRITE (ISYSWR,1351)
- 1351 FORMAT (' INVALID PARAMETER NUMBER(S) REQUESTED. IGNORED.' /)
- IERRF = 1
- RETURN
- END
diff --git a/src/packlib/minuit/code/mncomd.F b/src/packlib/minuit/code/mncomd.F
deleted file mode 100644
index 9d8943d..0000000
--- a/src/packlib/minuit/code/mncomd.F
+++ /dev/null
@@ -1,103 +0,0 @@
-*
-* $Id: mncomd.F,v 1.1.1.1 1996/03/07 14:31:29 mclareni Exp $
-*
-* $Log: mncomd.F,v $
-* Revision 1.1.1.1 1996/03/07 14:31:29 mclareni
-* Minuit
-*
-*
-#include "minuit/pilot.h"
- SUBROUTINE MNCOMD(FCN,CRDBIN,ICONDN,FUTIL)
-#include "minuit/d506dp.inc"
-CC Called by user. 'Reads' a command string and executes.
-CC Equivalent to MNEXCM except that the command is given as a
-CC character string.
-CC
-CC ICONDN = 0: command executed normally
-CC 1: command is blank, ignored
-CC 2: command line unreadable, ignored
-CC 3: unknown command, ignored
-CC 4: abnormal termination (e.g., MIGRAD not converged)
-CC 5: command is a request to read PARAMETER definitions
-CC 6: 'SET INPUT' command
-CC 7: 'SET TITLE' command
-CC 8: 'SET COVAR' command
-CC 9: reserved
-CC 10: END command
-CC 11: EXIT or STOP command
-CC 12: RETURN command
-CC
-#include "minuit/d506cm.inc"
- DIMENSION PLIST(MAXP)
- CHARACTER COMAND*(MAXCWD)
- CHARACTER CLOWER*26, CUPPER*26
- LOGICAL LEADER
-C
- EXTERNAL FCN,FUTIL
- CHARACTER*(*) CRDBIN
- CHARACTER*100 CRDBUF
- DATA CLOWER/'abcdefghijklmnopqrstuvwxyz'/
- DATA CUPPER/'ABCDEFGHIJKLMNOPQRSTUVWXYZ'/
-C
- LENBUF = LEN(CRDBIN)
- CRDBUF = CRDBIN
- ICONDN = 0
-C record not case-sensitive, get upper case, strip leading blanks
- LEADER = .TRUE.
- IPOS = 1
- DO 110 I= 1, MIN(MAXCWD,LENBUF)
- IF (CRDBUF(I:I) .EQ. '''') GO TO 111
- IF (CRDBUF(I:I) .EQ. ' ') THEN
- IF (LEADER) IPOS = IPOS + 1
- GO TO 110
- ENDIF
- LEADER = .FALSE.
- DO 108 IC= 1, 26
- IF (CRDBUF(I:I) .EQ. CLOWER(IC:IC)) CRDBUF(I:I)=CUPPER(IC:IC)
- 108 CONTINUE
- 110 CONTINUE
- 111 CONTINUE
-C blank or null command
- IF (IPOS .GT. LENBUF) THEN
- WRITE (ISYSWR,'(A)') ' BLANK COMMAND IGNORED.'
- ICONDN = 1
- GO TO 900
- ENDIF
-C . . preemptive commands
-C if command is 'PARAMETER'
- IF (CRDBUF(IPOS:IPOS+2) .EQ. 'PAR') THEN
- ICONDN = 5
- LPHEAD = .TRUE.
- GO TO 900
- ENDIF
-C if command is 'SET INPUT'
- IF (CRDBUF(IPOS:IPOS+6) .EQ. 'SET INP') THEN
- ICONDN = 6
- LPHEAD = .TRUE.
- GO TO 900
- ENDIF
-C if command is 'SET TITLE'
- IF (CRDBUF(IPOS:IPOS+6) .EQ. 'SET TIT') THEN
- ICONDN = 7
- LPHEAD = .TRUE.
- GO TO 900
- ENDIF
-C if command is 'SET COVARIANCE'
- IF (CRDBUF(IPOS:IPOS+6) .EQ. 'SET COV') THEN
- ICONDN = 8
- LPHEAD = .TRUE.
- GO TO 900
- ENDIF
-C crack the command . . . . . . . . . . . . . . . .
- CALL MNCRCK(CRDBUF(IPOS:LENBUF),MAXCWD,COMAND,LNC,
- + MAXP, PLIST, LLIST, IERR,ISYSWR)
- IF (IERR .GT. 0) THEN
- WRITE (ISYSWR,'(A)') ' COMMAND CANNOT BE INTERPRETED'
- ICONDN = 2
- GO TO 900
- ENDIF
-C
- CALL MNEXCM(FCN,COMAND(1:LNC),PLIST,LLIST,IERR,FUTIL)
- ICONDN = IERR
- 900 RETURN
- END
diff --git a/src/packlib/minuit/code/mncont.F b/src/packlib/minuit/code/mncont.F
deleted file mode 100644
index a3d706f..0000000
--- a/src/packlib/minuit/code/mncont.F
+++ /dev/null
@@ -1,276 +0,0 @@
-*
-* $Id: mncont.F,v 1.1.1.1 1996/03/07 14:31:29 mclareni Exp $
-*
-* $Log: mncont.F,v $
-* Revision 1.1.1.1 1996/03/07 14:31:29 mclareni
-* Minuit
-*
-*
-#include "minuit/pilot.h"
- SUBROUTINE MNCONT(FCN,KE1,KE2,NPTU,XPTU,YPTU,IERRF,FUTIL)
-#include "minuit/d506dp.inc"
-CC Find NPTU points along a contour where the function
-CC FMIN (X(KE1),X(KE2)) = AMIN+UP
-CC where FMIN is the minimum of FCN with respect to all
-CC the other NPAR-2 variable parameters (if any).
-CC IERRF on return will be equal to the number of points found:
-CC NPTU if normal termination with NPTU points found
-CC -1 if errors in the calling sequence (KE1, KE2 not variable)
-CC 0 if less than four points can be found (using MNMNOT)
-CC n>3 if only n points can be found (n < NPTU)
-CC
-#include "minuit/d506cm.inc"
- DIMENSION XPTU(NPTU), YPTU(NPTU), W(MNI),GCC(MNI)
- CHARACTER CHERE*10
- PARAMETER (CHERE='MNContour ')
- LOGICAL LDEBUG
- EXTERNAL FCN,FUTIL
-C input arguments: parx, pary, devs, ngrid
- LDEBUG = (IDBG(6) .GE. 1)
- IF (KE1.LE.0 .OR. KE2.LE.0) GO TO 1350
- IF (KE1.GT.NU .OR. KE2.GT.NU) GO TO 1350
- KI1 = NIOFEX(KE1)
- KI2 = NIOFEX(KE2)
- IF (KI1.LE.0 .OR. KI2.LE.0) GO TO 1350
- IF (KI1 .EQ. KI2) GO TO 1350
- IF (NPTU .LT. 4) GO TO 1400
-C
- NFCNCO = NFCN
- NFCNMX = 100*(NPTU+5)*(NPAR+1)
-C The minimum
- CALL MNCUVE(FCN,FUTIL)
- U1MIN = U(KE1)
- U2MIN = U(KE2)
- IERRF = 0
- CFROM = CHERE
- NFCNFR = NFCNCO
- IF (ISW(5) .GE. 0) THEN
- WRITE (ISYSWR,'(1X,A,I4,A)')
- + 'START MNCONTOUR CALCULATION OF',NPTU,' POINTS ON CONTOUR.'
- IF (NPAR .GT. 2) THEN
- IF (NPAR .EQ. 3) THEN
- KI3 = 6 - KI1 - KI2
- KE3 = NEXOFI(KI3)
- WRITE (ISYSWR,'(1X,A,I3,2X,A)')
- + 'EACH POINT IS A MINIMUM WITH RESPECT TO PARAMETER ',
- + KE3, CPNAM(KE3)
- ELSE
- WRITE (ISYSWR,'(1X,A,I3,A)')
- + 'EACH POINT IS A MINIMUM WITH RESPECT TO THE OTHER',
- + NPAR-2, ' VARIABLE PARAMETERS.'
- ENDIF
- ENDIF
- ENDIF
-C
-C Find the first four points using MNMNOT
-C ........................ first two points
- CALL MNMNOT(FCN,KE1,KE2,VAL2PL,VAL2MI,FUTIL)
- IF (ERN(KI1) .EQ. UNDEFI) THEN
- XPTU(1) = ALIM(KE1)
- CALL MNWARN('W',CHERE,'Contour squeezed by parameter limits.')
- ELSE
- IF (ERN(KI1) .GE. ZERO) GO TO 1500
- XPTU(1) = U1MIN+ERN(KI1)
- ENDIF
- YPTU(1) = VAL2MI
-C
- IF (ERP(KI1) .EQ. UNDEFI) THEN
- XPTU(3) = BLIM(KE1)
- CALL MNWARN('W',CHERE,'Contour squeezed by parameter limits.')
- ELSE
- IF (ERP(KI1) .LE. ZERO) GO TO 1500
- XPTU(3) = U1MIN+ERP(KI1)
- ENDIF
- YPTU(3) = VAL2PL
- SCALX = 1.0/(XPTU(3) - XPTU(1))
-C ........................... next two points
- CALL MNMNOT(FCN,KE2,KE1,VAL2PL,VAL2MI,FUTIL)
- IF (ERN(KI2) .EQ. UNDEFI) THEN
- YPTU(2) = ALIM(KE2)
- CALL MNWARN('W',CHERE,'Contour squeezed by parameter limits.')
- ELSE
- IF (ERN(KI2) .GE. ZERO) GO TO 1500
- YPTU(2) = U2MIN+ERN(KI2)
- ENDIF
- XPTU(2) = VAL2MI
- IF (ERP(KI2) .EQ. UNDEFI) THEN
- YPTU(4) = BLIM(KE2)
- CALL MNWARN('W',CHERE,'Contour squeezed by parameter limits.')
- ELSE
- IF (ERP(KI2) .LE. ZERO) GO TO 1500
- YPTU(4) = U2MIN+ERP(KI2)
- ENDIF
- XPTU(4) = VAL2PL
- SCALY = 1.0/(YPTU(4) - YPTU(2))
- NOWPTS = 4
- NEXT = 5
- IF (LDEBUG) THEN
- WRITE (ISYSWR,'(A)') ' Plot of four points found by MINOS'
- XPT(1) = U1MIN
- YPT(1) = U2MIN
- CHPT(1) = ' '
- NALL = MIN(NOWPTS+1,MAXCPT)
- DO 85 I= 2, NALL
- XPT(I) = XPTU(I-1)
- YPT(I) = YPTU(I-1)
- 85 CONTINUE
- CHPT(2)= 'A'
- CHPT(3)= 'B'
- CHPT(4)= 'C'
- CHPT(5)= 'D'
- CALL MNPLOT(XPT,YPT,CHPT,NALL,ISYSWR,NPAGWD,NPAGLN)
- ENDIF
-C
-C ..................... save some values before fixing
- ISW2 = ISW(2)
- ISW4 = ISW(4)
- SIGSAV = EDM
- ISTRAV = ISTRAT
- DC = DCOVAR
- APSI = EPSI*0.5
- ABEST=AMIN
- MPAR=NPAR
- NFMXIN = NFCNMX
- DO 125 I= 1, MPAR
- 125 XT(I) = X(I)
- DO 130 J= 1, MPAR*(MPAR+1)/2
- 130 VTHMAT(J) = VHMAT(J)
- DO 135 I= 1, MPAR
- GCC(I) = GLOBCC(I)
- 135 W(I) = WERR(I)
-C fix the two parameters in question
- KINTS = NIOFEX(KE1)
- CALL MNFIXP (KINTS,IERR)
- KINTS = NIOFEX(KE2)
- CALL MNFIXP (KINTS,IERR)
-C ......................Fill in the rest of the points
- DO 900 INEW= NEXT, NPTU
-C find the two neighbouring points with largest separation
- BIGDIS = 0.
- DO 200 IOLD = 1, INEW-1
- I2 = IOLD + 1
- IF (I2 .EQ. INEW) I2 = 1
- DIST = (SCALX*(XPTU(IOLD)-XPTU(I2)))**2 +
- + (SCALY*(YPTU(IOLD)-YPTU(I2)))**2
- IF (DIST .GT. BIGDIS) THEN
- BIGDIS = DIST
- IDIST = IOLD
- ENDIF
- 200 CONTINUE
- I1 = IDIST
- I2 = I1 + 1
- IF (I2 .EQ. INEW) I2 = 1
-C next point goes between I1 and I2
- A1 = HALF
- A2 = HALF
- 300 XMIDCR = A1*XPTU(I1) + A2*XPTU(I2)
- YMIDCR = A1*YPTU(I1) + A2*YPTU(I2)
- XDIR = YPTU(I2) - YPTU(I1)
- YDIR = XPTU(I1) - XPTU(I2)
- SCLFAC = MAX(ABS(XDIR*SCALX), ABS(YDIR*SCALY))
- XDIRCR = XDIR/SCLFAC
- YDIRCR = YDIR/SCLFAC
- KE1CR = KE1
- KE2CR = KE2
-C Find the contour crossing point along DIR
- AMIN = ABEST
- CALL MNCROS(FCN,AOPT,IERCR,FUTIL)
- IF (IERCR .GT. 1) THEN
-C If cannot find mid-point, try closer to point 1
- IF (A1 .GT. HALF) THEN
- IF (ISW(5) .GE. 0)
- + WRITE (ISYSWR,'(A,A,I3,A)') ' MNCONT CANNOT FIND NEXT',
- + ' POINT ON CONTOUR. ONLY ',NOWPTS,' POINTS FOUND.'
- GO TO 950
- ENDIF
- CALL MNWARN('W',CHERE,'Cannot find midpoint, try closer.')
- A1 = 0.75
- A2 = 0.25
- GO TO 300
- ENDIF
-C Contour has been located, insert new point in list
- DO 830 MOVE= NOWPTS,I1+1,-1
- XPTU(MOVE+1) = XPTU(MOVE)
- YPTU(MOVE+1) = YPTU(MOVE)
- 830 CONTINUE
- NOWPTS = NOWPTS + 1
- XPTU(I1+1) = XMIDCR + XDIRCR*AOPT
- YPTU(I1+1) = YMIDCR + YDIRCR*AOPT
- 900 CONTINUE
- 950 CONTINUE
-C
- IERRF = NOWPTS
- CSTATU = 'SUCCESSFUL'
- IF (NOWPTS .LT. NPTU) CSTATU = 'INCOMPLETE'
-C make a lineprinter plot of the contour
- IF (ISW(5) .GE. 0) THEN
- XPT(1) = U1MIN
- YPT(1) = U2MIN
- CHPT(1) = ' '
- NALL = MIN(NOWPTS+1,MAXCPT)
- DO 1000 I= 2, NALL
- XPT(I) = XPTU(I-1)
- YPT(I) = YPTU(I-1)
- CHPT(I)= 'X'
- 1000 CONTINUE
- WRITE (ISYSWR,'(A,I3,2X,A)') ' Y-AXIS: PARAMETER ',KE2,
- + CPNAM(KE2)
- CALL MNPLOT(XPT,YPT,CHPT,NALL,ISYSWR,NPAGWD,NPAGLN)
- WRITE (ISYSWR,'(25X,A,I3,2X,A)') 'X-AXIS: PARAMETER ',
- + KE1,CPNAM(KE1)
- ENDIF
-C print out the coordinates around the contour
- IF (ISW(5) .GE. 1) THEN
- NPCOL = (NOWPTS+1)/2
- NFCOL = NOWPTS/2
- WRITE (ISYSWR,'(/I5,A,G13.5,A,G11.3)') NOWPTS,
- + ' POINTS ON CONTOUR. FMIN=',ABEST,' ERRDEF=',UP
- WRITE (ISYSWR,'(9X,A,3X,A,18X,A,3X,A)')
- + CPNAM(KE1),CPNAM(KE2),CPNAM(KE1),CPNAM(KE2)
- DO 1050 LINE = 1, NFCOL
- LR = LINE + NPCOL
- WRITE (ISYSWR,'(1X,I5,2G13.5,10X,I5,2G13.5)')
- + LINE,XPTU(LINE),YPTU(LINE),LR,XPTU(LR),YPTU(LR)
- 1050 CONTINUE
- IF (NFCOL .LT. NPCOL) WRITE (ISYSWR,'(1X,I5,2G13.5)')
- + NPCOL,XPTU(NPCOL),YPTU(NPCOL)
- ENDIF
-C . . contour finished. reset v
- ITAUR = 1
- CALL MNFREE(1)
- CALL MNFREE(1)
- DO 1100 J= 1, MPAR*(MPAR+1)/2
- 1100 VHMAT(J) = VTHMAT(J)
- DO 1120 I= 1, MPAR
- GLOBCC(I) = GCC(I)
- WERR(I) = W(I)
- 1120 X(I) = XT(I)
- CALL MNINEX (X)
- EDM = SIGSAV
- AMIN = ABEST
- ISW(2) = ISW2
- ISW(4) = ISW4
- DCOVAR = DC
- ITAUR = 0
- NFCNMX = NFMXIN
- ISTRAT = ISTRAV
- U(KE1) = U1MIN
- U(KE2) = U2MIN
- GO TO 2000
-C Error returns
- 1350 WRITE (ISYSWR,'(A)') ' INVALID PARAMETER NUMBERS.'
- GO TO 1450
- 1400 WRITE (ISYSWR,'(A)') ' LESS THAN FOUR POINTS REQUESTED.'
- 1450 IERRF = -1
- CSTATU = 'USER ERROR'
- GO TO 2000
- 1500 WRITE (ISYSWR,'(A)') ' MNCONT UNABLE TO FIND FOUR POINTS.'
- U(KE1) = U1MIN
- U(KE2) = U2MIN
- IERRF = 0
- CSTATU = 'FAILED'
- 2000 CONTINUE
- CFROM = CHERE
- NFCNFR = NFCNCO
- RETURN
- END
diff --git a/src/packlib/minuit/code/mncrck.F b/src/packlib/minuit/code/mncrck.F
deleted file mode 100644
index 3a88468..0000000
--- a/src/packlib/minuit/code/mncrck.F
+++ /dev/null
@@ -1,129 +0,0 @@
-*
-* $Id: mncrck.F,v 1.1.1.1 1996/03/07 14:31:29 mclareni Exp $
-*
-* $Log: mncrck.F,v $
-* Revision 1.1.1.1 1996/03/07 14:31:29 mclareni
-* Minuit
-*
-*
-#include "minuit/pilot.h"
- SUBROUTINE MNCRCK(CRDBUF,MAXCWD,COMAND,LNC,
- + MXP, PLIST, LLIST,IERR,ISYSWR)
-#include "minuit/d506dp.inc"
-CC
-CC Called from MNREAD.
-CC Cracks the free-format input, expecting zero or more
-CC alphanumeric fields (which it joins into COMAND(1:LNC))
-CC followed by one or more numeric fields separated by
-CC blanks and/or one comma. The numeric fields are put into
-CC the LLIST (but at most MXP) elements of PLIST.
-CC IERR = 0 if no errors,
-CC = 1 if error(s).
-CC Diagnostic messages are written to ISYSWR
-CC
- PARAMETER (MAXELM=25, MXLNEL=19)
- CHARACTER*(*) COMAND, CRDBUF
- CHARACTER CNUMER*13, CELMNT(MAXELM)*(MXLNEL), CNULL*15
- DIMENSION LELMNT(MAXELM),PLIST(MXP)
- DATA CNULL /')NULL STRING '/
- DATA CNUMER/'123456789-.0+'/
- IELMNT = 0
- LEND = LEN(CRDBUF)
- NEXTB = 1
- IERR = 0
-C . . . . loop over words CELMNT
- 10 CONTINUE
- DO 100 IPOS= NEXTB,LEND
- IBEGIN = IPOS
- IF (CRDBUF(IPOS:IPOS).EQ.' ') GO TO 100
- IF (CRDBUF(IPOS:IPOS).EQ.',') GO TO 250
- GO TO 150
- 100 CONTINUE
- GO TO 300
- 150 CONTINUE
-C found beginning of word, look for end
- DO 180 IPOS = IBEGIN+1,LEND
- IF (CRDBUF(IPOS:IPOS).EQ.' ') GO TO 250
- IF (CRDBUF(IPOS:IPOS).EQ.',') GO TO 250
- 180 CONTINUE
- IPOS = LEND+1
- 250 IEND = IPOS-1
- IELMNT = IELMNT + 1
- IF (IEND .GE. IBEGIN) THEN
- CELMNT(IELMNT) = CRDBUF(IBEGIN:IEND)
- ELSE
- CELMNT(IELMNT) = CNULL
- ENDIF
- LELMNT(IELMNT) = IEND-IBEGIN+1
- IF (LELMNT(IELMNT) .GT. MXLNEL) THEN
- WRITE (ISYSWR, 253) CRDBUF(IBEGIN:IEND),CELMNT(IELMNT)
- 253 FORMAT (' MINUIT WARNING: INPUT DATA WORD TOO LONG.'
- + /' ORIGINAL:',A
- + /' TRUNCATED TO:',A)
- LELMNT(IELMNT) = MXLNEL
- ENDIF
- IF (IPOS .GE. LEND) GO TO 300
- IF (IELMNT .GE. MAXELM) GO TO 300
-C look for comma or beginning of next word
- DO 280 IPOS= IEND+1,LEND
- IF (CRDBUF(IPOS:IPOS) .EQ. ' ') GO TO 280
- NEXTB = IPOS
- IF (CRDBUF(IPOS:IPOS) .EQ. ',') NEXTB = IPOS+1
- GO TO 10
- 280 CONTINUE
-C All elements found, join the alphabetic ones to
-C form a command
- 300 CONTINUE
- NELMNT = IELMNT
- COMAND = ' '
- LNC = 1
- PLIST(1) = 0.
- LLIST = 0
- IF (IELMNT .EQ. 0) GO TO 900
- KCMND = 0
- DO 400 IELMNT = 1, NELMNT
- IF (CELMNT(IELMNT) .EQ. CNULL) GO TO 450
- DO 350 IC= 1, 13
- IF (CELMNT(IELMNT)(1:1) .EQ. CNUMER(IC:IC)) GO TO 450
- 350 CONTINUE
- IF (KCMND .GE. MAXCWD) GO TO 400
- LEFT = MAXCWD-KCMND
- LTOADD = LELMNT(IELMNT)
- IF (LTOADD .GT. LEFT) LTOADD=LEFT
- COMAND(KCMND+1:KCMND+LTOADD) = CELMNT(IELMNT)(1:LTOADD)
- KCMND = KCMND + LTOADD
- IF (KCMND .EQ. MAXCWD) GO TO 400
- KCMND = KCMND + 1
- COMAND(KCMND:KCMND) = ' '
- 400 CONTINUE
- LNC = KCMND
- GO TO 900
- 450 CONTINUE
- LNC = KCMND
-C . . . . we have come to a numeric field
- LLIST = 0
- DO 600 IFLD= IELMNT,NELMNT
- LLIST = LLIST + 1
- IF (LLIST .GT. MXP) THEN
- NREQ = NELMNT-IELMNT+1
- WRITE (ISYSWR,511) NREQ,MXP
- 511 FORMAT (/' MINUIT WARNING IN MNCRCK: '/ ' COMMAND HAS INPUT',I5,
- + ' NUMERIC FIELDS, BUT MINUIT CAN ACCEPT ONLY',I3)
- GO TO 900
- ENDIF
- IF (CELMNT(IFLD) .EQ. CNULL) THEN
- PLIST(LLIST) = 0.
- ELSE
- READ (CELMNT(IFLD), '(BN,F19.0)',ERR=575) PLIST(LLIST)
- ENDIF
- GO TO 600
- 575 WRITE (ISYSWR,'(A,A,A)') ' FORMAT ERROR IN NUMERIC FIELD: "',
- + CELMNT(IFLD)(1:LELMNT(IFLD)),'"'
- IERR = 1
- PLIST(LLIST) = 0.
- 600 CONTINUE
-C end loop over numeric fields
- 900 CONTINUE
- IF (LNC .LE. 0) LNC=1
- RETURN
- END
diff --git a/src/packlib/minuit/code/mncros.F b/src/packlib/minuit/code/mncros.F
deleted file mode 100644
index c66cfab..0000000
--- a/src/packlib/minuit/code/mncros.F
+++ /dev/null
@@ -1,334 +0,0 @@
-*
-* $Id: mncros.F,v 1.1.1.1 1996/03/07 14:31:29 mclareni Exp $
-*
-* $Log: mncros.F,v $
-* Revision 1.1.1.1 1996/03/07 14:31:29 mclareni
-* Minuit
-*
-*
-#include "minuit/pilot.h"
- SUBROUTINE MNCROS(FCN,AOPT,IERCR,FUTIL)
-#include "minuit/d506dp.inc"
-CC Find point where MNEVAL=AMIN+UP, along the line through
-CC XMIDCR,YMIDCR with direction XDIRCR,YDIRCR, where X and Y
-CC are parameters KE1CR and KE2CR. If KE2CR=0 (from MINOS),
-CC only KE1CR is varied. From MNCONT, both are varied.
-CC Crossing point is at
-CC (U(KE1),U(KE2)) = (XMID,YMID) + AOPT*(XDIR,YDIR)
-CC
-#include "minuit/d506cm.inc"
- CHARACTER CHERE*10, CHARAL*28, CHSIGN*4
- PARAMETER (CHERE='MNCROS ', MLSB=3, MAXITR=15, TLR=0.01)
- DIMENSION FLSB(MLSB),ALSB(MLSB), COEFF(3)
- LOGICAL LDEBUG
- EXTERNAL FCN,FUTIL
- DATA CHARAL/' .ABCDEFGHIJKLMNOPQRSTUVWXYZ'/
- LDEBUG = (IDBG(6) .GE. 1)
- AMINSV = AMIN
-C convergence when F is within TLF of AIM and next prediction
-C of AOPT is within TLA of previous value of AOPT
- AIM = AMIN + UP
- TLF = TLR*UP
- TLA = TLR
- XPT(1) = 0.0
- YPT(1) = AIM
- CHPT(1) = ' '
- IPT = 1
- IF (KE2CR .EQ. 0) THEN
- XPT(2) = -1.0
- YPT(2) = AMIN
- CHPT(2) = '.'
- IPT = 2
- ENDIF
-C find the largest allowed A
- AULIM = 100.
- DO 100 IK= 1, 2
- IF (IK .EQ. 1) THEN
- KEX = KE1CR
- ZMID = XMIDCR
- ZDIR = XDIRCR
- ELSE
- IF (KE2CR .EQ. 0) GO TO 100
- KEX = KE2CR
- ZMID = YMIDCR
- ZDIR = YDIRCR
- ENDIF
- IF (NVARL(KEX) .LE. 1) GO TO 100
- IF (ZDIR .EQ. ZERO) GO TO 100
- ZLIM = ALIM(KEX)
- IF (ZDIR .GT. ZERO) ZLIM = BLIM(KEX)
- AULIM = MIN(AULIM,(ZLIM-ZMID)/ZDIR)
- 100 CONTINUE
-C LSB = Line Search Buffer
-C first point
- ANEXT = 0.
- AOPT = ANEXT
- LIMSET = .FALSE.
- IF (AULIM .LT. AOPT+TLA) LIMSET = .TRUE.
- CALL MNEVAL(FCN,ANEXT,FNEXT,IEREV,FUTIL)
-C debug printout:
- IF (LDEBUG) WRITE (ISYSWR,'(A,I8,A,F10.5,A,2F10.5)')
- + ' MNCROS: calls=',NFCN,' AIM=',AIM,' F,A=',FNEXT,AOPT
- IF (IEREV .GT. 0) GO TO 900
- IF (LIMSET .AND. FNEXT .LE. AIM) GO TO 930
- IPT = IPT + 1
- XPT(IPT) = ANEXT
- YPT(IPT) = FNEXT
- CHPT(IPT)= CHARAL(IPT:IPT)
- ALSB(1) = ANEXT
- FLSB(1) = FNEXT
- FNEXT = MAX(FNEXT,AMINSV+0.1*UP)
- AOPT = SQRT((UP)/(FNEXT-AMINSV)) - 1.0
- IF (ABS(FNEXT-AIM) .LT. TLF) GO TO 800
-C
- IF (AOPT .LT. -HALF) AOPT = -HALF
- IF (AOPT .GT. ONE) AOPT = ONE
- LIMSET = .FALSE.
- IF (AOPT .GT. AULIM) THEN
- AOPT = AULIM
- LIMSET = .TRUE.
- ENDIF
- CALL MNEVAL(FCN,AOPT,FNEXT,IEREV,FUTIL)
-C debug printout:
- IF (LDEBUG) WRITE (ISYSWR,'(A,I8,A,F10.5,A,2F10.5)')
- + ' MNCROS: calls=',NFCN,' AIM=',AIM,' F,A=',FNEXT,AOPT
- IF (IEREV .GT. 0) GO TO 900
- IF (LIMSET .AND. FNEXT .LE. AIM) GO TO 930
- ALSB(2) = AOPT
- IPT = IPT + 1
- XPT(IPT) = ALSB(2)
- YPT(IPT) = FNEXT
- CHPT(IPT)= CHARAL(IPT:IPT)
- FLSB(2) = FNEXT
- DFDA = (FLSB(2)-FLSB(1))/ (ALSB(2)-ALSB(1))
-C DFDA must be positive on the contour
- IF (DFDA .GT. ZERO) GO TO 460
- 300 CALL MNWARN('D',CHERE,'Looking for slope of the right sign')
- MAXLK = MAXITR - IPT
- DO 400 IT= 1, MAXLK
- ALSB(1) = ALSB(2)
- FLSB(1) = FLSB(2)
- AOPT = ALSB(1) + 0.2*REAL(IT)
- LIMSET = .FALSE.
- IF (AOPT .GT. AULIM) THEN
- AOPT = AULIM
- LIMSET = .TRUE.
- ENDIF
- CALL MNEVAL(FCN,AOPT,FNEXT,IEREV,FUTIL)
-C debug printout:
- IF (LDEBUG) WRITE (ISYSWR,'(A,I8,A,F10.5,A,2F10.5)')
- + ' MNCROS: calls=',NFCN,' AIM=',AIM,' F,A=',FNEXT,AOPT
- IF (IEREV .GT. 0) GO TO 900
- IF (LIMSET .AND. FNEXT .LE. AIM) GO TO 930
- ALSB(2) = AOPT
- IPT = IPT + 1
- XPT(IPT) = ALSB(2)
- YPT(IPT) = FNEXT
- CHPT(IPT)= CHARAL(IPT:IPT)
- FLSB(2) = FNEXT
- DFDA = (FLSB(2)-FLSB(1))/ (ALSB(2)-ALSB(1))
- IF (DFDA .GT. ZERO) GO TO 450
- 400 CONTINUE
- CALL MNWARN('W',CHERE,'Cannot find slope of the right sign')
- GO TO 950
- 450 CONTINUE
-C we have two points with the right slope
- 460 AOPT = ALSB(2) + (AIM-FLSB(2))/DFDA
- FDIST = MIN(ABS(AIM -FLSB(1)),ABS(AIM -FLSB(2)))
- ADIST = MIN(ABS(AOPT-ALSB(1)),ABS(AOPT-ALSB(2)))
- TLA = TLR
- IF (ABS(AOPT) .GT. ONE) TLA = TLR*ABS(AOPT)
- IF (ADIST .LT. TLA .AND. FDIST .LT. TLF) GO TO 800
- IF (IPT .GE. MAXITR) GO TO 950
- BMIN = MIN(ALSB(1),ALSB(2)) - 1.0
- IF (AOPT .LT. BMIN) AOPT = BMIN
- BMAX = MAX(ALSB(1),ALSB(2)) + 1.0
- IF (AOPT .GT. BMAX) AOPT = BMAX
-C Try a third point
- LIMSET = .FALSE.
- IF (AOPT .GT. AULIM) THEN
- AOPT = AULIM
- LIMSET = .TRUE.
- ENDIF
- CALL MNEVAL(FCN,AOPT,FNEXT,IEREV,FUTIL)
-C debug printout:
- IF (LDEBUG) WRITE (ISYSWR,'(A,I8,A,F10.5,A,2F10.5)')
- + ' MNCROS: calls=',NFCN,' AIM=',AIM,' F,A=',FNEXT,AOPT
- IF (IEREV .GT. 0) GO TO 900
- IF (LIMSET .AND. FNEXT .LE. AIM) GO TO 930
- ALSB(3) = AOPT
- IPT = IPT + 1
- XPT(IPT) = ALSB(3)
- YPT(IPT) = FNEXT
- CHPT(IPT)= CHARAL(IPT:IPT)
- FLSB(3) = FNEXT
- INEW = 3
-C now we have three points, ask how many <AIM
- ECARMN = ABS(FNEXT-AIM)
- IBEST = 3
- ECARMX = 0.
- NOLESS = 0
- DO 480 I= 1, 3
- ECART = ABS(FLSB(I) - AIM)
- IF (ECART .GT. ECARMX) THEN
- ECARMX = ECART
- IWORST = I
- ENDIF
- IF (ECART .LT. ECARMN) THEN
- ECARMN = ECART
- IBEST = I
- ENDIF
- IF (FLSB(I) .LT. AIM) NOLESS = NOLESS + 1
- 480 CONTINUE
- INEW = IBEST
-C if at least one on each side of AIM, fit a parabola
- IF (NOLESS.EQ.1 .OR. NOLESS.EQ.2) GO TO 500
-C if all three are above AIM, third must be closest to AIM
- IF (NOLESS .EQ. 0 .AND. IBEST .NE. 3) GO TO 950
-C if all three below, and third is not best, then slope
-C has again gone negative, look for positive slope.
- IF (NOLESS .EQ. 3 .AND. IBEST .NE. 3) THEN
- ALSB(2) = ALSB(3)
- FLSB(2) = FLSB(3)
- GO TO 300
- ENDIF
-C in other cases, new straight line thru last two points
- ALSB(IWORST) = ALSB(3)
- FLSB(IWORST) = FLSB(3)
- DFDA = (FLSB(2)-FLSB(1))/ (ALSB(2)-ALSB(1))
- GO TO 460
-C parabola fit
- 500 CALL MNPFIT(ALSB,FLSB,3,COEFF,SDEV)
- IF (COEFF(3) .LE. ZERO) CALL MNWARN ('D',CHERE,
- + 'Curvature is negative near contour line.')
- DETERM = COEFF(2)**2 - 4.*COEFF(3)*(COEFF(1)-AIM)
- IF (DETERM .LE. ZERO) THEN
- CALL MNWARN('D',CHERE,'Problem 2, impossible determinant')
- GO TO 950
- ENDIF
-C Find which root is the right one
- RT = SQRT(DETERM)
- X1 = (-COEFF(2) + RT)/(2.*COEFF(3))
- X2 = (-COEFF(2) - RT)/(2.*COEFF(3))
- S1 = COEFF(2) + 2.*X1*COEFF(3)
- S2 = COEFF(2) + 2.*X2*COEFF(3)
- IF (S1*S2 .GT. ZERO) WRITE (ISYSWR,'(A)') ' MNCONTour problem 1'
- AOPT = X1
- SLOPE = S1
- IF (S2 .GT. ZERO) THEN
- AOPT = X2
- SLOPE = S2
- ENDIF
-C ask if converged
- TLA = TLR
- IF (ABS(AOPT) .GT. ONE) TLA = TLR*ABS(AOPT)
- IF (ABS(AOPT-ALSB(IBEST)) .LT. TLA .AND.
- & ABS(FLSB(IBEST)-AIM) .LT. TLF) GO TO 800
- IF (IPT .GE. MAXITR) GO TO 950
-C see if proposed point is in acceptable zone between L and R
-C first find ILEFT, IRIGHT, IOUT and IBEST
- ILEFT = 0
- IRIGHT = 0
- IBEST = 1
- ECARMX = 0.
- ECARMN = ABS(AIM-FLSB(1))
- DO 550 I= 1, 3
- ECART = ABS(FLSB(I) - AIM)
- IF (ECART .LT. ECARMN) THEN
- ECARMN = ECART
- IBEST = I
- ENDIF
- IF (ECART .GT. ECARMX) ECARMX = ECART
- IF (FLSB(I) .GT. AIM) THEN
- IF (IRIGHT .EQ. 0) THEN
- IRIGHT = I
- ELSE IF (FLSB(I) .GT. FLSB(IRIGHT)) THEN
- IOUT = I
- ELSE
- IOUT = IRIGHT
- IRIGHT = I
- ENDIF
- ELSE IF (ILEFT .EQ. 0) THEN
- ILEFT = I
- ELSE IF (FLSB(I) .LT. FLSB(ILEFT)) THEN
- IOUT = I
- ELSE
- IOUT = ILEFT
- ILEFT = I
- ENDIF
- 550 CONTINUE
-C avoid keeping a very bad point next time around
- IF (ECARMX .GT. 10.*ABS(FLSB(IOUT)-AIM))
- & AOPT = HALF*AOPT + HALF*HALF*(ALSB(IRIGHT)+ALSB(ILEFT))
-C knowing ILEFT and IRIGHT, get acceptable window
- SMALLA = 0.1*TLA
- IF (SLOPE*SMALLA .GT. TLF) SMALLA = TLF/SLOPE
- ALEFT = ALSB(ILEFT) + SMALLA
- ARIGHT = ALSB(IRIGHT) - SMALLA
-C move proposed point AOPT into window if necessary
- IF (AOPT .LT. ALEFT) AOPT = ALEFT
- IF (AOPT .GT. ARIGHT) AOPT = ARIGHT
- IF (ALEFT .GT. ARIGHT)AOPT = HALF*(ALEFT + ARIGHT)
-C see if proposed point outside limits (should be impossible!)
- LIMSET = .FALSE.
- IF (AOPT .GT. AULIM) THEN
- AOPT = AULIM
- LIMSET = .TRUE.
- ENDIF
-C Evaluate function at new point AOPT
- CALL MNEVAL(FCN,AOPT,FNEXT,IEREV,FUTIL)
-C debug printout:
- IF (LDEBUG) WRITE (ISYSWR,'(A,I8,A,F10.5,A,2F10.5)')
- + ' MNCROS: calls=',NFCN,' AIM=',AIM,' F,A=',FNEXT,AOPT
- IF (IEREV .GT. 0) GO TO 900
- IF (LIMSET .AND. FNEXT .LE. AIM) GO TO 930
- IPT = IPT + 1
- XPT(IPT) = AOPT
- YPT(IPT) = FNEXT
- CHPT(IPT)= CHARAL(IPT:IPT)
-C Replace odd point by new one
- ALSB(IOUT) = AOPT
- FLSB(IOUT) = FNEXT
-C the new point may not be the best, but it is the only one
-C which could be good enough to pass convergence criteria
- IBEST = IOUT
- GO TO 500
-C
-C Contour has been located, return point to MNCONT OR MINOS
- 800 CONTINUE
- IERCR = 0
- GO TO 1000
-C error in the minimization
- 900 IF (IEREV .EQ. 1) GO TO 940
- GO TO 950
-C parameter up against limit
- 930 IERCR = 1
- GO TO 1000
-C too many calls to FCN
- 940 IERCR = 2
- GO TO 1000
-C cannot find next point
- 950 IERCR = 3
-C in any case
- 1000 CONTINUE
- IF (LDEBUG) THEN
- ITOOHI = 0
- DO 1100 I= 1, IPT
- IF (YPT(I) .GT. AIM+UP) THEN
- YPT(I) = AIM+UP
- CHPT(I) = '+'
- ITOOHI = 1
- ENDIF
- 1100 CONTINUE
- CHSIGN = 'POSI'
- IF (XDIRCR .LT. ZERO) CHSIGN = 'NEGA'
- IF (KE2CR .EQ. 0) WRITE (ISYSWR, '(2X,A,A,I3)')
- + CHSIGN,'TIVE MINOS ERROR, PARAMETER ',KE1CR
- IF (ITOOHI .EQ. 1) WRITE (ISYSWR, '(10X,A)')
- + 'POINTS LABELLED "+" WERE TOO HIGH TO PLOT.'
- IF (IERCR .EQ. 1) WRITE (ISYSWR,'(10X,A)')
- + 'RIGHTMOST POINT IS UP AGAINST LIMIT.'
- CALL MNPLOT(XPT,YPT,CHPT,IPT,ISYSWR,NPAGWD,NPAGLN)
- ENDIF
- RETURN
- END
diff --git a/src/packlib/minuit/code/mncuve.F b/src/packlib/minuit/code/mncuve.F
deleted file mode 100644
index d4c0db2..0000000
--- a/src/packlib/minuit/code/mncuve.F
+++ /dev/null
@@ -1,56 +0,0 @@
-*
-* $Id: mncuve.F,v 1.1.1.1 1996/03/07 14:31:29 mclareni Exp $
-*
-* $Log: mncuve.F,v $
-* Revision 1.1.1.1 1996/03/07 14:31:29 mclareni
-* Minuit
-*
-*
-#include "minuit/pilot.h"
- SUBROUTINE MNCUVE(FCN,FUTIL)
-#include "minuit/d506dp.inc"
-CC Makes sure that the current point is a local
-CC minimum and that the error matrix exists,
-CC or at least something good enough for MINOS and MNCONT
-CC
-#include "minuit/d506cm.inc"
- EXTERNAL FCN,FUTIL
- IF (ISW(4) .LT. 1) THEN
- WRITE (ISYSWR,'(/A,A)')
- + ' FUNCTION MUST BE MINIMIZED BEFORE CALLING ',CFROM
- APSI = EPSI
- CALL MNMIGR(FCN,FUTIL)
- ENDIF
- IF (ISW(2) .LT. 3) THEN
- CALL MNHESS(FCN,FUTIL)
- IF (ISW(2) .LT. 1) THEN
- CALL MNWARN('W',CFROM,'NO ERROR MATRIX. WILL IMPROVISE.')
- DO 555 I=1,NPAR
- NDEX = I*(I-1)/2
- DO 554 J=1,I-1
- NDEX = NDEX + 1
- 554 VHMAT(NDEX) = 0.
- NDEX = NDEX + 1
- IF (G2(I) .LE. ZERO) THEN
- WINT = WERR(I)
- IEXT = NEXOFI(I)
- IF (NVARL(IEXT) .GT. 1) THEN
- CALL MNDXDI(X(I),I,DXDI)
- IF (ABS(DXDI) .LT. .001) THEN
- WINT = .01
- ELSE
- WINT = WINT/ABS(DXDI)
- ENDIF
- ENDIF
- G2(I) = UP/WINT**2
- ENDIF
- VHMAT(NDEX) = 2./G2(I)
- 555 CONTINUE
- ISW(2) = 1
- DCOVAR = 1.
- ELSE
- CALL MNWERR
- ENDIF
- ENDIF
- RETURN
- END
diff --git a/src/packlib/minuit/code/mnderi.F b/src/packlib/minuit/code/mnderi.F
deleted file mode 100644
index d48b97d..0000000
--- a/src/packlib/minuit/code/mnderi.F
+++ /dev/null
@@ -1,141 +0,0 @@
-*
-* $Id: mnderi.F,v 1.2 1996/03/15 18:02:43 james Exp $
-*
-* $Log: mnderi.F,v $
-* Revision 1.2 1996/03/15 18:02:43 james
-* Modified Files:
-* mnderi.F eliminate possible division by zero
-* mnexcm.F suppress print on STOP when print flag=-1
-* set FVAL3 to flag if FCN already called with IFLAG=3
-* mninit.F set version 96.03
-* mnlims.F remove arguments, not needed
-* mnmigr.F VLEN -> LENV in debug print statement
-* mnparm.F move call to MNRSET to after NPAR redefined, to zero all
-* mnpsdf.F eliminate possible division by zero
-* mnscan.F suppress printout when print flag =-1
-* mnset.F remove arguments in call to MNLIMS
-* mnsimp.F fix CSTATU so status is PROGRESS only if new minimum
-* mnvert.F eliminate possible division by zero
-*
-* Revision 1.1.1.1 1996/03/07 14:31:29 mclareni
-* Minuit
-*
-*
-#include "minuit/pilot.h"
- SUBROUTINE MNDERI(FCN,FUTIL)
-#include "minuit/d506dp.inc"
-CC Calculates the first derivatives of FCN (GRD),
-CC either by finite differences or by transforming the user-
-CC supplied derivatives to internal coordinates,
-CC according to whether ISW(3) is zero or one.
-CC
-#include "minuit/d506cm.inc"
- EXTERNAL FCN,FUTIL
- LOGICAL LDEBUG
- CHARACTER CBF1*22
- NPARX = NPAR
- LDEBUG = (IDBG(2) .GE. 1)
- IF (AMIN .EQ. UNDEFI) CALL MNAMIN(FCN,FUTIL)
- IF (ISW(3) .EQ. 1) GO TO 100
- IF (LDEBUG) THEN
-C make sure starting at the right place
- CALL MNINEX(X)
- NPARX = NPAR
- CALL FCN(NPARX,GIN,FS1,U,4,FUTIL)
- NFCN = NFCN + 1
- IF (FS1 .NE. AMIN) THEN
- DF = AMIN - FS1
- WRITE (CBF1(1:12),'(G12.3)') DF
- CALL MNWARN('D','MNDERI',
- + 'function value differs from AMIN by '//CBF1(1:12) )
- AMIN = FS1
- ENDIF
- WRITE
- + (ISYSWR,'(/'' FIRST DERIVATIVE DEBUG PRINTOUT. MNDERI''/
- + '' PAR DERIV STEP MINSTEP OPTSTEP '',
- + '' D1-D2 2ND DRV'')')
- ENDIF
- DFMIN = 8. * EPSMA2*(ABS(AMIN)+UP)
- VRYSML = 8.* EPSMAC**2
- IF (ISTRAT .LE. 0) THEN
- NCYC = 2
- TLRSTP = 0.5
- TLRGRD = 0.1
- ELSE IF (ISTRAT .EQ. 1) THEN
- NCYC = 3
- TLRSTP = 0.3
- TLRGRD = 0.05
- ELSE
- NCYC = 5
- TLRSTP = 0.1
- TLRGRD = 0.02
- ENDIF
-C loop over variable parameters
- DO 60 I=1,NPAR
- EPSPRI = EPSMA2 + ABS(GRD(I)*EPSMA2)
-C two-point derivatives always assumed necessary
-C maximum number of cycles over step size depends on strategy
- XTF = X(I)
- STEPB4 = 0.
-C loop as little as possible here!
- DO 45 ICYC= 1, NCYC
-C ........ theoretically best step
- OPTSTP = SQRT(DFMIN/(ABS(G2(I))+EPSPRI))
-C step cannot decrease by more than a factor of ten
- STEP = MAX(OPTSTP, ABS(0.1*GSTEP(I)))
-C but if parameter has limits, max step size = 0.5
- IF (GSTEP(I).LT.ZERO .AND. STEP.GT.0.5) STEP=0.5
-C and not more than ten times the previous step
- STPMAX = 10.*ABS(GSTEP(I))
- IF (STEP .GT. STPMAX) STEP = STPMAX
-C minimum step size allowed by machine precision
- STPMIN = MAX(VRYSML, 8.*ABS(EPSMA2*X(I)))
- IF (STEP .LT. STPMIN) STEP = STPMIN
-C end of iterations if step change less than factor 2
- IF (ABS((STEP-STEPB4)/STEP) .LT. TLRSTP) GO TO 50
-C take step positive
- GSTEP(I) = SIGN(STEP, GSTEP(I))
- STEPB4 = STEP
- X(I) = XTF + STEP
- CALL MNINEX(X)
- CALL FCN(NPARX,GIN,FS1,U,4,FUTIL)
- NFCN=NFCN+1
-C take step negative
- X(I) = XTF - STEP
- CALL MNINEX(X)
- CALL FCN(NPARX,GIN,FS2,U,4,FUTIL)
- NFCN=NFCN+1
- GRBFOR = GRD(I)
- GRD(I) = (FS1-FS2)/(2.0*STEP)
- G2(I) = (FS1+FS2-2.0*AMIN)/(STEP**2)
- X(I) = XTF
- IF (LDEBUG) THEN
- D1D2 = (FS1+FS2-2.0*AMIN)/STEP
- WRITE (ISYSWR,41) I,GRD(I),STEP,STPMIN,OPTSTP,D1D2,G2(I)
- 41 FORMAT (I4,2G11.3,5G10.2)
- ENDIF
-C see if another iteration is necessary
- IF (ABS(GRBFOR-GRD(I))/(ABS(GRD(I))+DFMIN/STEP) .LT. TLRGRD)
- + GO TO 50
- 45 CONTINUE
-C end of ICYC loop. too many iterations
- IF (NCYC .EQ. 1) GO TO 50
- WRITE (CBF1,'(2E11.3)') GRD(I),GRBFOR
- CALL MNWARN('D','MNDERI',
- + 'First derivative not converged. '//CBF1)
- 50 CONTINUE
-C
- 60 CONTINUE
- CALL MNINEX(X)
- RETURN
-C . derivatives calc by fcn
- 100 DO 150 IINT= 1, NPAR
- IEXT = NEXOFI(IINT)
- IF (NVARL(IEXT) .GT. 1) GO TO 120
- GRD(IINT) = GIN(IEXT)
- GO TO 150
- 120 DD = (BLIM(IEXT)-ALIM(IEXT))*0.5 *COS(X(IINT))
- GRD(IINT) = GIN(IEXT)*DD
- 150 CONTINUE
- 200 RETURN
- END
diff --git a/src/packlib/minuit/code/mndxdi.F b/src/packlib/minuit/code/mndxdi.F
deleted file mode 100644
index 0e2760e..0000000
--- a/src/packlib/minuit/code/mndxdi.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: mndxdi.F,v 1.1.1.1 1996/03/07 14:31:29 mclareni Exp $
-*
-* $Log: mndxdi.F,v $
-* Revision 1.1.1.1 1996/03/07 14:31:29 mclareni
-* Minuit
-*
-*
-#include "minuit/pilot.h"
- SUBROUTINE MNDXDI(PINT,IPAR,DXDI)
-#include "minuit/d506dp.inc"
-CC calculates the transformation factor between external and
-CC internal parameter values. this factor is one for
-CC parameters which are not limited. called from MNEMAT.
-#include "minuit/d506cm.inc"
- I = NEXOFI(IPAR)
- DXDI = 1.0
- IF (NVARL(I) .GT. 1)
- + DXDI = 0.5 *ABS((BLIM(I)-ALIM(I)) * COS(PINT))
- RETURN
- END
diff --git a/src/packlib/minuit/code/mneig.F b/src/packlib/minuit/code/mneig.F
deleted file mode 100644
index 2922688..0000000
--- a/src/packlib/minuit/code/mneig.F
+++ /dev/null
@@ -1,195 +0,0 @@
-*
-* $Id: mneig.F,v 1.1.1.1 1996/03/07 14:31:29 mclareni Exp $
-*
-* $Log: mneig.F,v $
-* Revision 1.1.1.1 1996/03/07 14:31:29 mclareni
-* Minuit
-*
-*
-#include "minuit/pilot.h"
- SUBROUTINE MNEIG(A,NDIMA,N,MITS,WORK,PRECIS,IFAULT)
-#include "minuit/d506dp.inc"
-C
- PARAMETER (ZERO=0.0, ONE=1.0, TWO=2.0)
- PARAMETER (TOL=1.0E-35)
- DIMENSION A(NDIMA,*),WORK(*)
-C PRECIS is the machine precision EPSMAC
- IFAULT = 1
-C
- I = N
- DO 70 I1 = 2,N
- L = I-2
- F = A(I,I-1)
- GL = ZERO
-C
- IF(L .LT. 1) GO TO 25
-C
- DO 20 K = 1,L
- 20 GL = GL+A(I,K)**2
- 25 H = GL + F**2
-C
- IF(GL .GT. TOL) GO TO 30
-C
- WORK(I) = ZERO
- WORK(N+I) = F
- GO TO 65
- 30 L = L+1
-C
- GL = SQRT(H)
-C
- IF(F .GE. ZERO) GL = -GL
-C
- WORK(N+I) = GL
- H = H-F*GL
- A(I,I-1) = F-GL
- F = ZERO
- DO 50 J = 1,L
- A(J,I) = A(I,J)/H
- GL = ZERO
- DO 40 K = 1,J
- 40 GL = GL+A(J,K)*A(I,K)
-C
- IF(J .GE. L) GO TO 47
-C
- J1 = J+1
- DO 45 K = J1,L
- 45 GL = GL+A(K,J)*A(I,K)
- 47 WORK(N+J) = GL/H
- F = F+GL*A(J,I)
- 50 CONTINUE
- HH = F/(H+H)
- DO 60 J = 1,L
- F = A(I,J)
- GL = WORK(N+J)-HH*F
- WORK(N+J) = GL
- DO 60 K = 1,J
- A(J,K) = A(J,K)-F*WORK(N+K)-GL*A(I,K)
- 60 CONTINUE
- WORK(I) = H
- 65 I = I-1
- 70 CONTINUE
- WORK(1) = ZERO
- WORK(N+1) = ZERO
- DO 110 I = 1,N
- L = I-1
-C
- IF(WORK(I) .EQ. ZERO .OR. L .EQ. 0) GO TO 100
-C
- DO 90 J = 1,L
- GL = ZERO
- DO 80 K = 1,L
- 80 GL = GL+A(I,K)*A(K,J)
- DO 90 K = 1,L
- A(K,J) = A(K,J)-GL*A(K,I)
- 90 CONTINUE
- 100 WORK(I) = A(I,I)
- A(I,I) = ONE
-C
- IF(L .EQ. 0) GO TO 110
-C
- DO 105 J = 1,L
- A(I,J) = ZERO
- A(J,I) = ZERO
- 105 CONTINUE
- 110 CONTINUE
-C
-C
- N1 = N-1
- DO 130 I = 2,N
- I0 = N+I-1
- 130 WORK(I0) = WORK(I0+1)
- WORK(N+N) = ZERO
- B = ZERO
- F = ZERO
- DO 210 L = 1,N
- J = 0
- H = PRECIS*(ABS(WORK(L))+ABS(WORK(N+L)))
-C
- IF(B .LT. H) B = H
-C
- DO 140 M1 = L,N
- M = M1
-C
- IF(ABS(WORK(N+M)) .LE. B) GO TO 150
-C
- 140 CONTINUE
-C
- 150 IF(M .EQ. L) GO TO 205
-C
- 160 IF(J .EQ. MITS) RETURN
-C
- J = J+1
- PT = (WORK(L+1)-WORK(L))/(TWO*WORK(N+L))
- R = SQRT(PT*PT+ONE)
- PR = PT+R
-C
- IF(PT .LT. ZERO) PR=PT-R
-C
- H = WORK(L)-WORK(N+L)/PR
- DO 170 I=L,N
- 170 WORK(I) = WORK(I)-H
- F = F+H
- PT = WORK(M)
- C = ONE
- S = ZERO
- M1 = M-1
- I = M
- DO 200 I1 = L,M1
- J = I
- I = I-1
- GL = C*WORK(N+I)
- H = C*PT
-C
- IF(ABS(PT) .GE. ABS(WORK(N+I))) GO TO 180
-C
- C = PT/WORK(N+I)
- R = SQRT(C*C+ONE)
- WORK(N+J) = S*WORK(N+I)*R
- S = ONE/R
- C = C/R
- GO TO 190
- 180 C = WORK(N+I)/PT
- R = SQRT(C*C+ONE)
- WORK(N+J) = S*PT*R
- S = C/R
- C = ONE/R
- 190 PT = C*WORK(I)-S*GL
- WORK(J) = H+S*(C*GL+S*WORK(I))
- DO 200 K = 1,N
- H = A(K,J)
- A(K,J) = S*A(K,I)+C*H
- A(K,I) = C*A(K,I)-S*H
- 200 CONTINUE
- WORK(N+L) = S*PT
- WORK(L) = C*PT
-C
- IF(ABS(WORK(N+L)) .GT. B) GO TO 160
-C
- 205 WORK(L) = WORK(L)+F
- 210 CONTINUE
- DO 240 I=1,N1
- K = I
- PT = WORK(I)
- I1 = I+1
- DO 220 J = I1,N
-C
- IF(WORK(J) .GE. PT) GO TO 220
-C
- K = J
- PT = WORK(J)
- 220 CONTINUE
-C
- IF(K .EQ. I) GO TO 240
-C
- WORK(K) = WORK(I)
- WORK(I) = PT
- DO 230 J=1,N
- PT = A(J,I)
- A(J,I) = A(J,K)
- A(J,K) = PT
- 230 CONTINUE
- 240 CONTINUE
- IFAULT = 0
-C
- RETURN
- END
diff --git a/src/packlib/minuit/code/mnemat.F b/src/packlib/minuit/code/mnemat.F
deleted file mode 100644
index c234836..0000000
--- a/src/packlib/minuit/code/mnemat.F
+++ /dev/null
@@ -1,56 +0,0 @@
-*
-* $Id: mnemat.F,v 1.1.1.1 1996/03/07 14:31:29 mclareni Exp $
-*
-* $Log: mnemat.F,v $
-* Revision 1.1.1.1 1996/03/07 14:31:29 mclareni
-* Minuit
-*
-*
-#include "minuit/pilot.h"
- SUBROUTINE MNEMAT(EMAT,NDIM)
-#include "minuit/d506dp.inc"
- DIMENSION EMAT(NDIM,NDIM)
-CC Calculates the external error matrix from the internal
-CC to be called by user, who must dimension EMAT at (NDIM,NDIM)
-#include "minuit/d506cm.inc"
- IF (ISW(2) .LT. 1) RETURN
- IF (ISW(5) .GE. 2) WRITE (ISYSWR,'(/A,I4,A,I3,A,G10.3)')
- + ' EXTERNAL ERROR MATRIX. NDIM=',NDIM,' NPAR=',NPAR,
- + ' ERR DEF=',UP
-C size of matrix to be printed
- NPARD = NPAR
- IF (NDIM .LT. NPAR) THEN
- NPARD = NDIM
- IF (ISW(5) .GE. 0) WRITE (ISYSWR,'(A,A)') ' USER-DIMENSIONED ',
- + ' ARRAY EMAT NOT BIG ENOUGH. REDUCED MATRIX CALCULATED.'
- ENDIF
-C NPERLN is the number of elements that fit on one line
- NPERLN = (NPAGWD-5)/10
- NPERLN = MIN(NPERLN,13)
- IF (ISW(5).GE. 1 .AND. NPARD.GT.NPERLN) WRITE (ISYSWR,'(A)')
- + ' ELEMENTS ABOVE DIAGONAL ARE NOT PRINTED.'
-C I counts the rows of the matrix
- DO 110 I= 1, NPARD
- CALL MNDXDI(X(I),I,DXDI)
- KGA = I*(I-1)/2
- DO 100 J= 1, I
- CALL MNDXDI(X(J),J,DXDJ)
- KGB = KGA + J
- EMAT(I,J) = DXDI * VHMAT(KGB) * DXDJ * UP
- EMAT(J,I) = EMAT(I,J)
- 100 CONTINUE
- 110 CONTINUE
-C IZ is number of columns to be printed in row I
- IF (ISW(5) .GE. 2) THEN
- DO 160 I= 1, NPARD
- IZ = NPARD
- IF (NPARD .GE. NPERLN) IZ = I
- DO 150 K= 1, IZ, NPERLN
- K2 = K + NPERLN - 1
- IF (K2 .GT. IZ) K2=IZ
- WRITE (ISYSWR,'(1X,13E10.3)') (EMAT(I,KK),KK=K,K2)
- 150 CONTINUE
- 160 CONTINUE
- ENDIF
- RETURN
- END
diff --git a/src/packlib/minuit/code/mnerrs.F b/src/packlib/minuit/code/mnerrs.F
deleted file mode 100644
index 6fbe9ee..0000000
--- a/src/packlib/minuit/code/mnerrs.F
+++ /dev/null
@@ -1,50 +0,0 @@
-*
-* $Id: mnerrs.F,v 1.1.1.1 1996/03/07 14:31:29 mclareni Exp $
-*
-* $Log: mnerrs.F,v $
-* Revision 1.1.1.1 1996/03/07 14:31:29 mclareni
-* Minuit
-*
-*
-#include "minuit/pilot.h"
- SUBROUTINE MNERRS(NUMBER,EPLUS,EMINUS,EPARAB,GCC)
-#include "minuit/d506dp.inc"
-CC Called by user, utility routine to get MINOS errors
-CC If NUMBER is positive, then it is external parameter number,
-CC if negative, it is -internal number.
-CC values returned by MNERRS:
-CC EPLUS, EMINUS are MINOS errors of parameter NUMBER,
-CC EPARAB is 'parabolic' error (from error matrix).
-CC (Errors not calculated are set = 0.)
-CC GCC is global correlation coefficient from error matrix
-#include "minuit/d506cm.inc"
-C
- IEX = NUMBER
- IF (NUMBER .LT. 0) THEN
- IIN = -NUMBER
- IF (IIN .GT. NPAR) GO TO 900
- IEX = NEXOFI(IIN)
- ENDIF
- IF (IEX .GT. NU .OR. IEX .LE. 0) GO TO 900
- IIN = NIOFEX(IEX)
- IF (IIN .LE. 0) GO TO 900
-C IEX is external number, IIN is internal number
- EPLUS = ERP(IIN)
- IF (EPLUS.EQ.UNDEFI) EPLUS=0.
- EMINUS= ERN(IIN)
- IF (EMINUS.EQ.UNDEFI) EMINUS=0.
- CALL MNDXDI(X(IIN),IIN,DXDI)
- NDIAG = IIN*(IIN+1)/2
- EPARAB = ABS(DXDI*SQRT(ABS(UP*VHMAT(NDIAG))))
-C global correlation coefficient
- GCC = 0.
- IF (ISW(2) .LT. 2) GO TO 990
- GCC = GLOBCC(IIN)
- GO TO 990
-C ERROR. parameter number not valid
- 900 EPLUS = 0.
- EMINUS = 0.
- EPARAB = 0.
- GCC = 0.
- 990 RETURN
- END
diff --git a/src/packlib/minuit/code/mneval.F b/src/packlib/minuit/code/mneval.F
deleted file mode 100644
index 5d27819..0000000
--- a/src/packlib/minuit/code/mneval.F
+++ /dev/null
@@ -1,39 +0,0 @@
-*
-* $Id: mneval.F,v 1.1.1.1 1996/03/07 14:31:29 mclareni Exp $
-*
-* $Log: mneval.F,v $
-* Revision 1.1.1.1 1996/03/07 14:31:29 mclareni
-* Minuit
-*
-*
-#include "minuit/pilot.h"
- SUBROUTINE MNEVAL(FCN,ANEXT,FNEXT,IEREV,FUTIL)
-#include "minuit/d506dp.inc"
-CC Evaluates the function being analyzed by MNCROS, which is
-CC generally the minimum of FCN with respect to all remaining
-CC variable parameters. Common block /MN7XCR/ contains the
-CC data necessary to know the values of U(KE1CR) and U(KE2CR)
-CC to be used, namely U(KE1CR) = XMIDCR + ANEXT*XDIRCR
-CC and (if KE2CR .NE. 0) U(KE2CR) = YMIDCR + ANEXT*YDIRCR
-#include "minuit/d506cm.inc"
-CC
- EXTERNAL FCN,FUTIL
- U(KE1CR) = XMIDCR + ANEXT*XDIRCR
- IF ( KE2CR .NE. 0) U(KE2CR) = YMIDCR + ANEXT*YDIRCR
- CALL MNINEX(X)
- NPARX = NPAR
- CALL FCN(NPARX,GIN,FNEXT,U,4,FUTIL)
- NFCN = NFCN + 1
- IEREV = 0
- IF (NPAR .GT. 0) THEN
- ITAUR = 1
- AMIN = FNEXT
- ISW(1) = 0
- CALL MNMIGR(FCN,FUTIL)
- ITAUR = 0
- FNEXT = AMIN
- IF (ISW(1) .GE. 1) IEREV = 1
- IF (ISW(4) .LT. 1) IEREV = 2
- ENDIF
- RETURN
- END
diff --git a/src/packlib/minuit/code/mnexcm.F b/src/packlib/minuit/code/mnexcm.F
deleted file mode 100644
index 15db4db..0000000
--- a/src/packlib/minuit/code/mnexcm.F
+++ /dev/null
@@ -1,469 +0,0 @@
-*
-* $Id: mnexcm.F,v 1.2 1996/03/15 18:02:45 james Exp $
-*
-* $Log: mnexcm.F,v $
-* Revision 1.2 1996/03/15 18:02:45 james
-* Modified Files:
-* mnderi.F eliminate possible division by zero
-* mnexcm.F suppress print on STOP when print flag=-1
-* set FVAL3 to flag if FCN already called with IFLAG=3
-* mninit.F set version 96.03
-* mnlims.F remove arguments, not needed
-* mnmigr.F VLEN -> LENV in debug print statement
-* mnparm.F move call to MNRSET to after NPAR redefined, to zero all
-* mnpsdf.F eliminate possible division by zero
-* mnscan.F suppress printout when print flag =-1
-* mnset.F remove arguments in call to MNLIMS
-* mnsimp.F fix CSTATU so status is PROGRESS only if new minimum
-* mnvert.F eliminate possible division by zero
-*
-* Revision 1.1.1.1 1996/03/07 14:31:29 mclareni
-* Minuit
-*
-*
-#include "minuit/pilot.h"
- SUBROUTINE MNEXCM(FCN,COMAND,PLIST,LLIST,IERFLG,FUTIL)
-#include "minuit/d506dp.inc"
-CC Interprets a command and takes appropriate action,
-CC either directly by skipping to the corresponding code in
-CC MNEXCM, or by setting up a call to a subroutine
-CC
-#include "minuit/d506cm.inc"
- EXTERNAL FCN,FUTIL
- CHARACTER*(*) COMAND
-C Cannot say DIMENSION PLIST(LLIST) since LLIST can be =0.
- DIMENSION PLIST(*)
- PARAMETER (MXPT=101)
- DIMENSION XPTU(MXPT), YPTU(MXPT)
-C alphabetical order of command names!
- CHARACTER*10 CNAME(40), CNEWAY, CHWHY*18, C26*30, CVBLNK*2
- LOGICAL LTOFIX, LFIXED, LFREED
-C
- CHARACTER COMD*4
- CHARACTER CLOWER*26, CUPPER*26
- DATA CLOWER/'abcdefghijklmnopqrstuvwxyz'/
- DATA CUPPER/'ABCDEFGHIJKLMNOPQRSTUVWXYZ'/
-C
-C recognized MINUIT commands:
- DATA CNAME( 1) / 'MINImize ' /
- DATA CNAME( 2) / 'SEEk ' /
- DATA CNAME( 3) / 'SIMplex ' /
- DATA CNAME( 4) / 'MIGrad ' /
- DATA CNAME( 5) / 'MINOs ' /
- DATA CNAME( 6) / 'SET xxx ' /
- DATA CNAME( 7) / 'SHOw xxx ' /
- DATA CNAME( 8) / 'TOP of pag' /
- DATA CNAME( 9) / 'FIX ' /
- DATA CNAME(10) / 'REStore ' /
- DATA CNAME(11) / 'RELease ' /
- DATA CNAME(12) / 'SCAn ' /
- DATA CNAME(13) / 'CONtour ' /
- DATA CNAME(14) / 'HESse ' /
- DATA CNAME(15) / 'SAVe ' /
- DATA CNAME(16) / 'IMProve ' /
- DATA CNAME(17) / 'CALl fcn ' /
- DATA CNAME(18) / 'STAndard ' /
- DATA CNAME(19) / 'END ' /
- DATA CNAME(20) / 'EXIt ' /
- DATA CNAME(21) / 'RETurn ' /
- DATA CNAME(22) / 'CLEar ' /
- DATA CNAME(23) / 'HELP ' /
- DATA CNAME(24) / 'MNContour ' /
- DATA CNAME(25) / 'STOp ' /
- DATA CNAME(26) / 'JUMp ' /
- DATA CNAME(27) / ' ' /
- DATA CNAME(28) / ' ' /
- DATA CNAME(29) / ' ' /
- DATA CNAME(30) / ' ' /
- DATA CNAME(31) / ' ' /
- DATA CNAME(32) / ' ' /
- DATA CNAME(33) / ' ' /
-C obsolete commands:
- DATA CNAME(34) / 'COVARIANCE' /
- DATA CNAME(35) / 'PRINTOUT ' /
- DATA CNAME(36) / 'GRADIENT ' /
- DATA CNAME(37) / 'MATOUT ' /
- DATA CNAME(38) / 'ERROR DEF ' /
- DATA CNAME(39) / 'LIMITS ' /
- DATA CNAME(40) / 'PUNCH ' /
- DATA NNTOT/40/
-C IERFLG is now (94.5) defined the same as ICONDN in MNCOMD
-CC = 0: command executed normally
-CC 1: command is blank, ignored
-CC 2: command line unreadable, ignored
-CC 3: unknown command, ignored
-CC 4: abnormal termination (e.g., MIGRAD not converged)
-CC 9: reserved
-CC 10: END command
-CC 11: EXIT or STOP command
-CC 12: RETURN command
- LK = LEN(COMAND)
- IF (LK .GT. MAXCWD) LK=MAXCWD
- CWORD = COMAND(1:LK)
-C get upper case
- DO 16 ICOL= 1, LK
- DO 15 LET= 1, 26
- IF (CWORD(ICOL:ICOL) .EQ. CLOWER(LET:LET))
- + CWORD(ICOL:ICOL) = CUPPER(LET:LET)
- 15 CONTINUE
- 16 CONTINUE
-C Copy the first MAXP arguments into COMMON (WORD7), making
-C sure that WORD7(1)=0. if LLIST=0
- DO 20 IW= 1, MAXP
- WORD7(IW) = ZERO
- IF (IW .LE. LLIST) WORD7(IW) = PLIST(IW)
- 20 CONTINUE
- ICOMND = ICOMND + 1
- NFCNLC = NFCN
- IF (CWORD(1:7).NE.'SET PRI' .OR. WORD7(1).GE.0.) THEN
- IF (ISW(5) .GE. 0) THEN
- LNOW = LLIST
- IF (LNOW .GT. 4) LNOW=4
- WRITE (ISYSWR,25) ICOMND,CWORD(1:LK),(PLIST(I),I=1,LNOW)
- 25 FORMAT (1H ,10(1H*)/' **',I5,' **',A,4G12.4)
- INONDE = 0
- IF (LLIST .GT. LNOW) THEN
- KLL = LLIST
- IF (LLIST .GT. MAXP) THEN
- INONDE = 1
- KLL = MAXP
- ENDIF
- WRITE (CVBLNK,'(I2)') LK
- C26 = '(11H **********,'//CVBLNK//'X,4G12.4)'
- WRITE (ISYSWR,C26) (PLIST(I),I=LNOW+1,KLL)
- ENDIF
- WRITE (ISYSWR, '(1H ,10(1H*))' )
- IF (INONDE .GT. 0) WRITE (ISYSWR, '(1H ,10(1H*),A,I3,A)')
- + ' ERROR: ABOVE CALL TO MNEXCM TRIED TO PASS MORE THAN ',
- + MAXP,' PARAMETERS.'
- ENDIF
- ENDIF
- NFCNMX = WORD7(1)
- IF (NFCNMX .LE. 0) NFCNMX = 200 + 100*NPAR + 5*NPAR**2
- EPSI = WORD7(2)
- IF (EPSI .LE. ZERO) EPSI = 0.1 * UP
- LNEWMN = .FALSE.
- LPHEAD = .TRUE.
- ISW(1) = 0
- IERFLG = 0
-C look for command in list CNAME . . . . . . . . . .
- DO 80 I= 1, NNTOT
- IF (CWORD(1:3) .EQ. CNAME(I)(1:3)) GO TO 90
- 80 CONTINUE
- WRITE (ISYSWR,'(11X,''UNKNOWN COMMAND IGNORED:'',A)') COMAND
- IERFLG = 3
- GO TO 5000
-C normal case: recognized MINUIT command . . . . . . .
- 90 CONTINUE
- IF (CWORD(1:4) .EQ. 'MINO') I = 5
- IF (I.NE.6 .AND. I.NE.7 .AND. I.NE.8 .AND. I.NE.23) THEN
- CFROM = CNAME(I)
- NFCNFR = NFCN
- ENDIF
-C 1 2 3 4 5 6 7 8 9 10
- GO TO ( 400, 200, 300, 400, 500, 700, 700, 800, 900,1000,
- 1 1100,1200,1300,1400,1500,1600,1700,1800,1900,1900,
- 2 1900,2200,2300,2400,1900,2600,3300,3300,3300,3300,
- 3 3300,3300,3300,3400,3500,3600,3700,3800,3900,4000) , I
-C . . . . . . . . . . seek
- 200 CALL MNSEEK(FCN,FUTIL)
- GO TO 5000
-C . . . . . . . . . . simplex
- 300 CALL MNSIMP(FCN,FUTIL)
- IF (ISW(4) .LT. 1) IERFLG = 4
- GO TO 5000
-C . . . . . . migrad, minimize
- 400 CONTINUE
- NF = NFCN
- APSI = EPSI
- CALL MNMIGR(FCN,FUTIL)
- CALL MNWERR
- IF (ISW(4) .GE. 1) GO TO 5000
- IERFLG = 4
- IF (ISW(1) .EQ. 1) GO TO 5000
- IF (CWORD(1:3) .EQ. 'MIG') GO TO 5000
- NFCNMX = NFCNMX + NF - NFCN
- NF = NFCN
- CALL MNSIMP(FCN,FUTIL)
- IF (ISW(1) .EQ. 1) GO TO 5000
- NFCNMX = NFCNMX + NF - NFCN
- CALL MNMIGR(FCN,FUTIL)
- IF (ISW(4) .GE. 1) IERFLG = 0
- CALL MNWERR
- GO TO 5000
-C . . . . . . . . . . minos
- 500 CONTINUE
- NSUPER = NFCN + 2*(NPAR+1)*NFCNMX
-C possible loop over new minima
- EPSI = 0.1 * UP
- 510 CONTINUE
- CALL MNCUVE(FCN,FUTIL)
- CALL MNMNOS(FCN,FUTIL)
- IF (.NOT. LNEWMN) GO TO 5000
- CALL MNRSET(0)
- CALL MNMIGR(FCN,FUTIL)
- CALL MNWERR
- IF (NFCN .LT. NSUPER) GO TO 510
- WRITE (ISYSWR,'(/'' TOO MANY FUNCTION CALLS. MINOS GIVES UP''/)')
- IERFLG = 4
- GO TO 5000
-C . . . . . . . . . .set, show
- 700 CALL MNSET(FCN,FUTIL)
- GO TO 5000
-C . . . . . . . . . . top of page
- 800 CONTINUE
- WRITE (ISYSWR,'(1H1)')
- GO TO 5000
-C . . . . . . . . . . fix
- 900 LTOFIX = .TRUE.
-C . . (also release) ....
- 901 CONTINUE
- LFREED = .FALSE.
- LFIXED = .FALSE.
- IF (LLIST .EQ. 0) THEN
- WRITE (ISYSWR,'(A,A)') CWORD,': NO PARAMETERS REQUESTED '
- GO TO 5000
- ENDIF
- DO 950 ILIST= 1, LLIST
- IEXT = PLIST(ILIST)
- CHWHY = ' IS UNDEFINED.'
- IF (IEXT .LE. 0) GO TO 930
- IF (IEXT .GT. NU) GO TO 930
- IF (NVARL(IEXT) .LT. 0) GO TO 930
- CHWHY = ' IS CONSTANT. '
- IF (NVARL(IEXT) .EQ. 0) GO TO 930
- IINT = NIOFEX(IEXT)
- IF (LTOFIX) THEN
- CHWHY = ' ALREADY FIXED.'
- IF (IINT .EQ. 0) GO TO 930
- CALL MNFIXP(IINT,IERR)
- IF (IERR .EQ. 0) THEN
- LFIXED = .TRUE.
- ELSE
- IERFLG = 4
- ENDIF
- ELSE
- CHWHY = ' ALREADY VARIABLE.'
- IF (IINT .GT. 0) GO TO 930
- KRL = -IABS(IEXT)
- CALL MNFREE(KRL)
- LFREED = .TRUE.
- ENDIF
- GO TO 950
- 930 WRITE (ISYSWR,'(A,I4,A,A)') ' PARAMETER',IEXT,CHWHY,' IGNORED.'
- 950 CONTINUE
- IF (LFREED .OR. LFIXED) CALL MNRSET(0)
- IF (LFREED) THEN
- ISW(2) = 0
- DCOVAR = 1.
- EDM = BIGEDM
- ISW(4) = 0
- ENDIF
- CALL MNWERR
- IF (ISW(5) .GT. 1) CALL MNPRIN(5,AMIN)
- GO TO 5000
-C . . . . . . . . . . restore
- 1000 IT = WORD7(1)
- IF (IT.GT.1 .OR. IT.LT.0) GO TO 1005
- LFREED = (NPFIX .GT. 0)
- CALL MNFREE(IT)
- IF (LFREED) THEN
- CALL MNRSET(0)
- ISW(2) = 0
- DCOVAR = 1.
- EDM = BIGEDM
- ENDIF
- GO TO 5000
- 1005 WRITE (ISYSWR,'(A,I4)') ' IGNORED. UNKNOWN ARGUMENT:',IT
- IERFLG = 3
- GO TO 5000
-C . . . . . . . . . . release
- 1100 LTOFIX = .FALSE.
- GO TO 901
-C . . . . . . . . . . scan . . .
- 1200 CONTINUE
- IEXT = WORD7(1)
- IF (IEXT .LE. 0) GO TO 1210
- IT2 = 0
- IF (IEXT .LE. NU) IT2 = NIOFEX(IEXT)
- IF (IT2 .LE. 0) GO TO 1250
- 1210 CALL MNSCAN(FCN,FUTIL)
- GO TO 5000
- 1250 WRITE (ISYSWR,'(A,I4,A)') ' PARAMETER',IEXT,' NOT VARIABLE.'
- IERFLG = 3
- GO TO 5000
-C . . . . . . . . . . contour
- 1300 CONTINUE
- KE1 = WORD7(1)
- KE2 = WORD7(2)
- IF (KE1 .EQ. 0) THEN
- IF (NPAR .EQ. 2) THEN
- KE1 = NEXOFI(1)
- KE2 = NEXOFI(2)
- ELSE
- WRITE (ISYSWR,'(A,A)') CWORD,': NO PARAMETERS REQUESTED '
- IERFLG = 3
- GO TO 5000
- ENDIF
- ENDIF
- NFCNMX = 1000
- CALL MNCNTR(FCN,KE1,KE2,IERRF,FUTIL)
- IF (IERRF .GT. 0) IERFLG = 3
- GO TO 5000
-C . . . . . . . . . . hesse
- 1400 CONTINUE
- CALL MNHESS(FCN,FUTIL)
- CALL MNWERR
- IF (ISW(5) .GE. 0) CALL MNPRIN(2, AMIN)
- IF (ISW(5) .GE. 1) CALL MNMATU(1)
- GO TO 5000
-C . . . . . . . . . . save
- 1500 CONTINUE
- CALL MNSAVE
- GO TO 5000
-C . . . . . . . . . . improve
- 1600 CONTINUE
- CALL MNCUVE(FCN,FUTIL)
- CALL MNIMPR(FCN,FUTIL)
- IF (LNEWMN) GO TO 400
- IERFLG = 4
- GO TO 5000
-C . . . . . . . . . . call fcn
- 1700 IFLAG = WORD7(1)
- NPARX = NPAR
- F = UNDEFI
- CALL FCN(NPARX,GIN,F,U,IFLAG,FUTIL)
- NFCN = NFCN + 1
- NOWPRT = 0
- IF (F .NE. UNDEFI) THEN
- IF (AMIN .EQ. UNDEFI) THEN
- AMIN = F
- NOWPRT = 1
- ELSE IF (F .LT. AMIN) THEN
- AMIN = F
- NOWPRT = 1
- ENDIF
- IF (ISW(5).GE.0 .AND. IFLAG.LE.5 .AND. NOWPRT.EQ.1)
- + CALL MNPRIN(5,AMIN)
- IF (IFLAG .EQ. 3) FVAL3=F
- ENDIF
- IF (IFLAG .GT. 5) CALL MNRSET(1)
- GO TO 5000
-C . . . . . . . . . . standard
- 1800 CALL STAND
- GO TO 5000
-C . . . return, stop, end, exit
- 1900 IT = WORD7(1)
- IF (FVAL3 .NE. AMIN .AND. IT .EQ. 0) THEN
- IFLAG = 3
- IF (ISW(5) .GE. 0)
- +WRITE (ISYSWR,'(/A/)') ' CALL TO USER FUNCTION WITH IFLAG = 3'
- NPARX = NPAR
- CALL FCN(NPARX,GIN,F,U,IFLAG,FUTIL)
- NFCN = NFCN + 1
- FVAL3 = F
- ENDIF
- IERFLG = 11
- IF (CWORD(1:3) .EQ. 'END') IERFLG = 10
- IF (CWORD(1:3) .EQ. 'RET') IERFLG = 12
- GO TO 5000
-C . . . . . . . . . . clear
- 2200 CONTINUE
- CALL MNCLER
- IF (ISW(5) .GE. 1) WRITE (ISYSWR,'(A)')
- + ' MINUIT MEMORY CLEARED. NO PARAMETERS NOW DEFINED.'
- GO TO 5000
-C . . . . . . . . . . help
- 2300 CONTINUE
-CCCC IF (INDEX(CWORD,'SHO') .GT. 0) GO TO 700
-CCCC IF (INDEX(CWORD,'SET') .GT. 0) GO TO 700
- KCOL = 0
- DO 2310 ICOL= 5,LK
- IF (CWORD(ICOL:ICOL) .EQ. ' ') GO TO 2310
- KCOL = ICOL
- GO TO 2320
- 2310 CONTINUE
- 2320 CONTINUE
- IF (KCOL .EQ. 0) THEN
- COMD = '* '
- ELSE
- COMD = CWORD(KCOL:LK)
- ENDIF
- CALL MNHELP(COMD,ISYSWR)
- GO TO 5000
-C . . . . . . . . . . MNContour
- 2400 CONTINUE
- EPSI = 0.05 * UP
- KE1 = WORD7(1)
- KE2 = WORD7(2)
- IF (KE1.EQ.0 .AND. NPAR.EQ.2) THEN
- KE1 = NEXOFI(1)
- KE2 = NEXOFI(2)
- ENDIF
- NPTU = WORD7(3)
- IF (NPTU .LE. 0) NPTU=20
- IF (NPTU .GT. MXPT) NPTU = MXPT
- NFCNMX = 100*(NPTU+5)*(NPAR+1)
- CALL MNCONT(FCN,KE1,KE2,NPTU,XPTU,YPTU,IERRF,FUTIL)
- IF (IERRF .LT. NPTU) IERFLG = 4
- IF (IERRF .EQ. -1) IERFLG = 3
- GO TO 5000
-C . . . . . . . . . . jump
- 2600 CONTINUE
- STEP = WORD7(1)
- IF (STEP .LE. ZERO) STEP = 2.
- RNO = 0.
- IZERO = 0
- DO 2620 I= 1, NPAR
- CALL MNRN15(RNO,IZERO)
- RNO = 2.0*RNO - 1.0
- 2620 X(I) = X(I) + RNO*STEP*WERR(I)
- CALL MNINEX(X)
- CALL MNAMIN(FCN,FUTIL)
- CALL MNRSET(0)
- GO TO 5000
-C . . . . . . . . . . blank line
- 3300 CONTINUE
- WRITE (ISYSWR,'(10X,A)') ' BLANK COMMAND IGNORED.'
- IERFLG = 1
- GO TO 5000
-C . . . . . . . . obsolete commands . . . . . . . . . . . . . .
-C . . . . . . . . . . covariance
- 3400 CONTINUE
- WRITE (ISYSWR, '(A)') ' THE "COVARIANCE" COMMAND IS OSBSOLETE.',
- + ' THE COVARIANCE MATRIX IS NOW SAVED IN A DIFFERENT FORMAT',
- + ' WITH THE "SAVE" COMMAND AND READ IN WITH:"SET COVARIANCE"'
- IERFLG = 3
- GO TO 5000
-C . . . . . . . . . . printout
- 3500 CONTINUE
- CNEWAY = 'SET PRInt '
- GO TO 3100
-C . . . . . . . . . . gradient
- 3600 CONTINUE
- CNEWAY = 'SET GRAd '
- GO TO 3100
-C . . . . . . . . . . matout
- 3700 CONTINUE
- CNEWAY = 'SHOW COVar'
- GO TO 3100
-C . . . . . . . . . error def
- 3800 CONTINUE
- CNEWAY = 'SET ERRdef'
- GO TO 3100
-C . . . . . . . . . . limits
- 3900 CONTINUE
- CNEWAY = 'SET LIMits'
- GO TO 3100
-C . . . . . . . . . . punch
- 4000 CONTINUE
- CNEWAY = 'SAVE '
-C ....... come from obsolete commands
- 3100 WRITE (ISYSWR, 3101) CWORD,CNEWAY
- 3101 FORMAT (' OBSOLETE COMMAND:',1X,A10,5X,'PLEASE USE:',1X,A10)
- CWORD = CNEWAY
- IF (CWORD .EQ. 'SAVE ') GO TO 1500
- GO TO 700
-C . . . . . . . . . . . . . . . . . .
- 5000 RETURN
- END
diff --git a/src/packlib/minuit/code/mnexin.F b/src/packlib/minuit/code/mnexin.F
deleted file mode 100644
index 436d5bc..0000000
--- a/src/packlib/minuit/code/mnexin.F
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: mnexin.F,v 1.1.1.1 1996/03/07 14:31:29 mclareni Exp $
-*
-* $Log: mnexin.F,v $
-* Revision 1.1.1.1 1996/03/07 14:31:29 mclareni
-* Minuit
-*
-*
-#include "minuit/pilot.h"
- SUBROUTINE MNEXIN(PINT)
-#include "minuit/d506dp.inc"
-CC Transforms the external parameter values U to internal
-CC values in the dense array PINT. Subroutine MNPINT is used.
-CC
-#include "minuit/d506cm.inc"
- DIMENSION PINT(*)
- LIMSET = .FALSE.
- DO 100 IINT= 1, NPAR
- IEXT = NEXOFI(IINT)
- CALL MNPINT(U(IEXT),IEXT,PINTI)
- PINT(IINT) = PINTI
- 100 CONTINUE
- RETURN
- END
diff --git a/src/packlib/minuit/code/mnfixp.F b/src/packlib/minuit/code/mnfixp.F
deleted file mode 100644
index b28cefd..0000000
--- a/src/packlib/minuit/code/mnfixp.F
+++ /dev/null
@@ -1,81 +0,0 @@
-*
-* $Id: mnfixp.F,v 1.1.1.1 1996/03/07 14:31:29 mclareni Exp $
-*
-* $Log: mnfixp.F,v $
-* Revision 1.1.1.1 1996/03/07 14:31:29 mclareni
-* Minuit
-*
-*
-#include "minuit/pilot.h"
- SUBROUTINE MNFIXP(IINT,IERR)
-#include "minuit/d506dp.inc"
-CC removes parameter IINT from the internal (variable) parameter
-CC list, and arranges the rest of the list to fill the hole.
-CC
-#include "minuit/d506cm.inc"
- DIMENSION YY(MNI)
-C first see if it can be done
- IERR = 0
- IF (IINT.GT.NPAR .OR. IINT.LE.0) THEN
- IERR = 1
- WRITE (ISYSWR,'(A,I4)')
- + ' MINUIT ERROR. ARGUMENT TO MNFIXP=',IINT
- GO TO 300
- ENDIF
- IEXT = NEXOFI(IINT)
- IF (NPFIX .GE. MNI) THEN
- IERR = 1
- WRITE (ISYSWR,'(A,I4,A,I4)') ' MINUIT CANNOT FIX PARAMETER',
- + IEXT,' MAXIMUM NUMBER THAT CAN BE FIXED IS',MNI
- GO TO 300
- ENDIF
-C reduce number of variable parameters by one
- NIOFEX(IEXT) = 0
- NOLD = NPAR
- NPAR = NPAR - 1
-C save values in case parameter is later restored
- NPFIX = NPFIX + 1
- IPFIX(NPFIX) = IEXT
- LC = IINT
- XS(NPFIX) = X(LC)
- XTS(NPFIX) = XT(LC)
- DIRINS(NPFIX) = WERR(LC)
- GRDS(NPFIX) = GRD(LC)
- G2S(NPFIX) = G2(LC)
- GSTEPS(NPFIX) = GSTEP(LC)
-C shift values for other parameters to fill hole
- DO 100 IK= IEXT+1, NU
- IF (NIOFEX(IK) .GT. 0) THEN
- LC = NIOFEX(IK) - 1
- NIOFEX(IK) = LC
- NEXOFI(LC) = IK
- X(LC) = X(LC+1)
- XT(LC) = XT(LC+1)
- DIRIN(LC) = DIRIN(LC+1)
- WERR(LC) = WERR(LC+1)
- GRD(LC) = GRD(LC+1)
- G2(LC) = G2(LC+1)
- GSTEP(LC) = GSTEP(LC+1)
- ENDIF
- 100 CONTINUE
- IF (ISW(2) .LE. 0) GO TO 300
-C remove one row and one column from variance matrix
- IF (NPAR .LE. 0) GO TO 300
- DO 260 I= 1, NOLD
- M = MAX(I,IINT)
- N = MIN(I,IINT)
- NDEX = M*(M-1)/2 + N
- 260 YY(I)=VHMAT(NDEX)
- YYOVER = 1.0/YY(IINT)
- KNEW = 0
- KOLD = 0
- DO 294 I= 1, NOLD
- DO 292 J= 1, I
- KOLD = KOLD + 1
- IF (J.EQ.IINT .OR. I.EQ.IINT) GO TO 292
- KNEW = KNEW + 1
- VHMAT(KNEW) = VHMAT(KOLD) - YY(J)*YY(I)*YYOVER
- 292 CONTINUE
- 294 CONTINUE
- 300 RETURN
- END
diff --git a/src/packlib/minuit/code/mnfree.F b/src/packlib/minuit/code/mnfree.F
deleted file mode 100644
index 44a6e10..0000000
--- a/src/packlib/minuit/code/mnfree.F
+++ /dev/null
@@ -1,109 +0,0 @@
-*
-* $Id: mnfree.F,v 1.1.1.1 1996/03/07 14:31:29 mclareni Exp $
-*
-* $Log: mnfree.F,v $
-* Revision 1.1.1.1 1996/03/07 14:31:29 mclareni
-* Minuit
-*
-*
-#include "minuit/pilot.h"
- SUBROUTINE MNFREE(K)
-#include "minuit/d506dp.inc"
-CC Restores one or more fixed parameter(s) to variable status
-CC by inserting it into the internal parameter list at the
-CC appropriate place.
-CC
-#include "minuit/d506cm.inc"
-C-- K = 0 means restore all parameters
-C-- K = 1 means restore the last parameter fixed
-C-- K = -I means restore external parameter I (if possible)
-C-- IQ = fix-location where internal parameters were stored
-C-- IR = external number of parameter being restored
-C-- IS = internal number of parameter being restored
- IF (K .GT. 1) WRITE (ISYSWR,510)
- IF (NPFIX .LT. 1) WRITE (ISYSWR,500)
- IF (K.EQ.1 .OR. K.EQ.0) GO TO 40
-C release parameter with specified external number
- KA = IABS(K)
- IF (NIOFEX(KA) .EQ. 0) GO TO 15
- WRITE (ISYSWR,540)
- 540 FORMAT (' IGNORED. PARAMETER SPECIFIED IS ALREADY VARIABLE.')
- RETURN
- 15 IF (NPFIX .LT. 1) GO TO 21
- DO 20 IK= 1, NPFIX
- IF (IPFIX(IK) .EQ. KA) GO TO 24
- 20 CONTINUE
- 21 WRITE (ISYSWR,530) KA
- 530 FORMAT (' PARAMETER',I4,' NOT FIXED. CANNOT BE RELEASED.')
- RETURN
- 24 IF (IK .EQ. NPFIX) GO TO 40
-C move specified parameter to end of list
- IPSAV = KA
- XV = XS(IK)
- XTV = XTS(IK)
- DIRINV = DIRINS(IK)
- GRDV = GRDS(IK)
- G2V = G2S(IK)
- GSTEPV = GSTEPS(IK)
- DO 30 I= IK+1,NPFIX
- IPFIX(I-1) = IPFIX(I)
- XS(I-1) = XS(I)
- XTS(I-1) = XTS(I)
- DIRINS(I-1) = DIRINS(I)
- GRDS(I-1) = GRDS(I)
- G2S(I-1) = G2S(I)
- GSTEPS(I-1) = GSTEPS(I)
- 30 CONTINUE
- IPFIX(NPFIX) = IPSAV
- XS(NPFIX) = XV
- XTS(NPFIX) = XTV
- DIRINS(NPFIX) = DIRINV
- GRDS(NPFIX) = GRDV
- G2S(NPFIX) = G2V
- GSTEPS(NPFIX) = GSTEPV
-C restore last parameter in fixed list -- IPFIX(NPFIX)
- 40 CONTINUE
- IF (NPFIX .LT. 1) GO TO 300
- IR = IPFIX(NPFIX)
- IS = 0
- DO 100 IK= NU, IR, -1
- IF (NIOFEX(IK) .GT. 0) THEN
- LC = NIOFEX(IK) + 1
- IS = LC - 1
- NIOFEX(IK) = LC
- NEXOFI(LC) = IK
- X(LC) = X(LC-1)
- XT(LC) = XT(LC-1)
- DIRIN(LC) = DIRIN(LC-1)
- WERR(LC) = WERR(LC-1)
- GRD(LC) = GRD(LC-1)
- G2(LC) = G2(LC-1)
- GSTEP(LC) = GSTEP(LC-1)
- ENDIF
- 100 CONTINUE
- NPAR = NPAR + 1
- IF (IS .EQ. 0) IS = NPAR
- NIOFEX(IR) = IS
- NEXOFI(IS) = IR
- IQ = NPFIX
- X(IS) = XS(IQ)
- XT(IS) = XTS(IQ)
- DIRIN(IS) = DIRINS(IQ)
- WERR(IS) = DIRINS(IQ)
- GRD(IS) = GRDS(IQ)
- G2(IS) = G2S(IQ)
- GSTEP(IS) = GSTEPS(IQ)
- NPFIX = NPFIX - 1
- ISW(2) = 0
- DCOVAR = 1.
- IF (ISW(5)-ITAUR .GE. 1) WRITE(ISYSWR,520) IR,CPNAM(IR)
- IF (K.EQ.0) GO TO 40
- 300 CONTINUE
-C if different from internal, external values are taken
- CALL MNEXIN(X)
- 400 RETURN
- 500 FORMAT (' CALL TO MNFREE IGNORED. THERE ARE NO FIXED PA',
- + 'RAMETERS'/)
- 510 FORMAT (' CALL TO MNFREE IGNORED. ARGUMENT GREATER THAN ONE'/)
- 520 FORMAT (20X, 9HPARAMETER,I4,2H, ,A10,' RESTORED TO VARIABLE.')
- END
diff --git a/src/packlib/minuit/code/mngrad.F b/src/packlib/minuit/code/mngrad.F
deleted file mode 100644
index 2ae3834..0000000
--- a/src/packlib/minuit/code/mngrad.F
+++ /dev/null
@@ -1,71 +0,0 @@
-*
-* $Id: mngrad.F,v 1.1.1.1 1996/03/07 14:31:29 mclareni Exp $
-*
-* $Log: mngrad.F,v $
-* Revision 1.1.1.1 1996/03/07 14:31:29 mclareni
-* Minuit
-*
-*
-#include "minuit/pilot.h"
- SUBROUTINE MNGRAD(FCN,FUTIL)
-#include "minuit/d506dp.inc"
-CC Called from MNSET
-CC Interprets the SET GRAD command, which informs MINUIT whether
-CC the first derivatives of FCN will be calculated by the user
-CC inside FCN. It can check the user's derivative calculation
-CC by comparing it with a finite difference approximation.
-CC
-#include "minuit/d506cm.inc"
-C
- EXTERNAL FCN,FUTIL
- CHARACTER*4 CGOOD,CBAD,CNONE,CWD
- LOGICAL LNONE
- DIMENSION GF(MNI)
- PARAMETER (CGOOD='GOOD',CBAD=' BAD',CNONE='NONE')
-C
- ISW(3) = 1
- NPARX = NPAR
- IF (WORD7(1) .GT. ZERO) GO TO 2000
-C get user-calculated first derivatives from FCN
- DO 30 I= 1, NU
- 30 GIN(I) = UNDEFI
- CALL MNINEX(X)
- CALL FCN(NPARX,GIN,FZERO,U,2,FUTIL)
- NFCN = NFCN + 1
- CALL MNDERI(FCN,FUTIL)
- DO 40 I= 1, NPAR
- 40 GF(I) = GRD(I)
-C get MINUIT-calculated first derivatives
- ISW(3) = 0
- ISTSAV = ISTRAT
- ISTRAT = 2
- CALL MNHES1(FCN,FUTIL)
- ISTRAT = ISTSAV
- WRITE (ISYSWR,51)
- 51 FORMAT(/' CHECK OF GRADIENT CALCULATION IN FCN'/12X,'PARAMETER',
- + 6X,9HG(IN FCN) ,3X,9HG(MINUIT) ,2X,'DG(MINUIT)',3X,9HAGREEMENT)
- ISW(3) = 1
- LNONE = .FALSE.
- DO 100 LC = 1, NPAR
- I = NEXOFI(LC)
- CWD = CGOOD
- ERR = DGRD(LC)
- IF (ABS(GF(LC)-GRD(LC)) .GT. ERR) CWD = CBAD
- IF (GIN(I) .EQ. UNDEFI) THEN
- CWD = CNONE
- LNONE = .TRUE.
- GF(LC) = 0.
- ENDIF
- IF (CWD .NE. CGOOD) ISW(3) = 0
- WRITE (ISYSWR,99) I,CPNAM(I),GF(LC),GRD(LC),ERR,CWD
- 99 FORMAT (7X,I5,2X ,A10,3E12.4,4X ,A4)
- 100 CONTINUE
- IF (LNONE) WRITE (ISYSWR,'(A)')
- + ' AGREEMENT=NONE MEANS FCN DID NOT CALCULATE THE DERIVATIVE'
- IF (ISW(3) .EQ. 0) WRITE (ISYSWR,1003)
- 1003 FORMAT(/' MINUIT DOES NOT ACCEPT DERIVATIVE CALCULATIONS BY FCN'/
- + ' TO FORCE ACCEPTANCE, ENTER "SET GRAD 1"'/)
-C
- 2000 CONTINUE
- RETURN
- END
diff --git a/src/packlib/minuit/code/mnhelp.F b/src/packlib/minuit/code/mnhelp.F
deleted file mode 100644
index 85e3d87..0000000
--- a/src/packlib/minuit/code/mnhelp.F
+++ /dev/null
@@ -1,624 +0,0 @@
-*
-* $Id: mnhelp.F,v 1.2 1999/09/03 09:17:47 couet Exp $
-*
-* $Log: mnhelp.F,v $
-* Revision 1.2 1999/09/03 09:17:47 couet
-* - \Cind{} removed in the help of minuit. This was a Tex directive which very
-* likely has been forgotten during a Tex to f77 translation. This didn't
-* compile on RH6.
-*
-* Revision 1.1.1.1 1996/03/07 14:31:30 mclareni
-* Minuit
-*
-*
-#include "minuit/pilot.h"
- SUBROUTINE MNHELP(COMD,LOUT)
-*.
-*. HELP routine for MINUIT interactive commands.
-*.
-*. COMD ='* ' prints a global help for all commands
-*. COMD =Command_name: print detailed help for one command.
-*. Note that at least 3 characters must be given for the command name.
-*.
-*. Author: Rene Brun
-* comments extracted from the MINUIT documentation file.
-*.
- CHARACTER*(*) COMD
- CHARACTER*3 CMD3
-*.
-*-- command name ASSUMED to be in upper case
-*__________________________________________________________________
-*--
-*-- Global HELP: Summary of all commands
-*-- ====================================
-*--
- IF(COMD(1:1) .EQ. '*')THEN
- WRITE(LOUT,10000)
- WRITE(LOUT,10001)
- GO TO 99
- ENDIF
-10000 FORMAT(' ==>List of MINUIT Interactive commands:',/,
- +' CLEar Reset all parameter names and values undefined',/,
- +' CONtour Make contour map of the user function',/,
- +' EXIT Exit from Interactive Minuit',/,
- +' FIX Cause parameter(s) to remain constant',/,
- +' HESse Calculate the Hessian or error matrix.',/,
- +' IMPROVE Search for a new minimum around current minimum',/,
- +' MIGrad Minimize by the method of Migrad',/,
- +' MINImize MIGRAD + SIMPLEX method if Migrad fails',/,
- +' MINOs Exact (non-linear) parameter error analysis')
-10001 FORMAT(' MNContour Calculate one MINOS function contour',/,
- +' PARameter Define or redefine new parameters and values',/,
- +' RELease Make previously FIXed parameters variable again',/,
- +' REStore Release last parameter fixed',/,
- +' SAVe Save current parameter values on a file',/,
- +' SCAn Scan the user function by varying parameters',/,
- +' SEEk Minimize by the method of Monte Carlo',/,
- +' SET Set various MINUIT constants or conditions',/,
- +' SHOw Show values of current constants or conditions',/,
- +' SIMplex Minimize by the method of Simplex')
-*
- CMD3=COMD(1:3)
-*__________________________________________________________________
-*--
-*-- Command CLEAR
-*-- =============
-*.
- IF(CMD3.EQ.'CLE')THEN
- WRITE(LOUT,10100)
- GO TO 99
- ENDIF
-10100 FORMAT(' ***>CLEAR',/,
- +' Resets all parameter names and values to undefined.',/,
- +' Must normally be followed by a PARameters command or ',/,
- +' equivalent, in order to define parameter values.')
-*__________________________________________________________________
-*--
-*-- Command CONTOUR
-*-- ===============
-*.
- IF(CMD3.EQ.'CON')THEN
- WRITE(LOUT,10200)
- GO TO 99
- ENDIF
-10200 FORMAT(' ***>CONTOUR <par1> <par2> [devs] [ngrid]',/,
- +' Instructs Minuit to trace contour lines of the user function',/,
- +' with respect to the two parameters whose external numbers',/,
- +' are <par1> and <par2>.',/,
- +' Other variable parameters of the function, if any, will have',/,
- +' their values fixed at the current values during the contour',/,
- +' tracing. The optional parameter [devs] (default value 2.)',/,
- +' gives the number of standard deviations in each parameter',/,
- +' which should lie entirely within the plotting area.',/,
- +' Optional parameter [ngrid] (default value 25 unless page',/,
- +' size is too small) determines the resolution of the plot,',/,
- +' i.e. the number of rows and columns of the grid at which the',/,
- +' function will be evaluated. [See also MNContour.]')
-*__________________________________________________________________
-*--
-*-- Command END
-*-- ===========
-*.
- IF(CMD3.EQ.'END')THEN
- WRITE(LOUT,10300)
- GO TO 99
- ENDIF
-10300 FORMAT(' ***>END',/,
- +' Signals the end of a data block (i.e., the end of a fit),',/,
- +' and implies that execution should continue, because another',/,
- +' Data Block follows. A Data Block is a set of Minuit data',/,
- +' consisting of',/,
- +' (1) A Title,',/,
- +' (2) One or more Parameter Definitions,',/,
- +' (3) A blank line, and',/,
- +' (4) A set of Minuit Commands.',/,
- +' The END command is used when more than one Data Block is to',/,
- +' be used with the same FCN function. It first causes Minuit',/,
- +' to issue a CALL FCN with IFLAG=3, in order to allow FCN to',/,
- +' perform any calculations associated with the final fitted',/,
- +' parameter values, unless a CALL FCN 3 command has already',/,
- +' been executed at the current FCN value.')
-*__________________________________________________________________
-*.
-*--
-*-- Command EXIT
-*-- ============
- IF(CMD3 .EQ.'EXI')THEN
- WRITE(LOUT,10400)
- GO TO 99
- ENDIF
-10400 FORMAT(' ***>EXIT',/,
- +' Signals the end of execution.',/,
- +' The EXIT command first causes Minuit to issue a CALL FCN',/,
- +' with IFLAG=3, to allow FCN to perform any calculations',/,
- +' associated with the final fitted parameter values, unless a',/,
- +' CALL FCN 3 command has already been executed.')
-*__________________________________________________________________
-*--
-*-- Command FIX
-*-- ===========
-*.
- IF(CMD3.EQ.'FIX')THEN
- WRITE(LOUT,10500)
- GO TO 99
- ENDIF
-10500 FORMAT(' ***>FIX} <parno> [parno] ... [parno]',/,
- +' Causes parameter(s) <parno> to be removed from the list of',/,
- +' variable parameters, and their value(s) will remain constant',/,
- +' during subsequent minimizations, etc., until another command',/,
- +' changes their value(s) or status.')
-*__________________________________________________________________
-*--
-*-- Command HESSE
-*-- =============
-*.
- IF(CMD3.EQ.'HES')THEN
- WRITE(LOUT,10600)
- GO TO 99
- ENDIF
-10600 FORMAT(' ***>HESse [maxcalls]',/,
- +' Calculate, by finite differences, the Hessian or error matrix.',
- +/,' That is, it calculates the full matrix of second derivatives'
- +,/,' of the function with respect to the currently variable',/,
- +' parameters, and inverts it, printing out the resulting error',/,
- +' matrix. The optional argument [maxcalls] specifies the',/,
- +' (approximate) maximum number of function calls after which',/,
- +' the calculation will be stopped.')
-*__________________________________________________________________
-*--
-*-- Command IMPROVE
-*-- ===============
-*.
- IF(CMD3.EQ.'IMP')THEN
- WRITE(LOUT,10700)
- GO TO 99
- ENDIF
-10700 FORMAT(' ***>IMPROVE [maxcalls]',/,
- +' If a previous minimization has converged, and the current',/,
- +' values of the parameters therefore correspond to a local',/,
- +' minimum of the function, this command requests a search for',/,
- +' additional distinct local minima.',/,
- +' The optional argument [maxcalls] specifies the (approximate)',/,
- +' maximum number of function calls after which the calculation',/,
- +' will be stopped.')
-*__________________________________________________________________
-*--
-*-- Command MIGRAD
-*-- ==============
-*.
- IF(CMD3.EQ.'MIG')THEN
- WRITE(LOUT,10800)
- GO TO 99
- ENDIF
-10800 FORMAT(' ***>MIGrad [maxcalls] [tolerance]',/,
- +' Causes minimization of the function by the method of Migrad,',/,
- +' the most efficient and complete single method, recommended',/,
- +' for general functions (see also MINImize).',/,
- +' The minimization produces as a by-product the error matrix',/,
- +' of the parameters, which is usually reliable unless warning',/,
- +' messages are produced.',/,
- +' The optional argument [maxcalls] specifies the (approximate)',/,
- +' maximum number of function calls after which the calculation',/,
- +' will be stopped even if it has not yet converged.',/,
- +' The optional argument [tolerance] specifies required tolerance',
- +/,' on the function value at the minimum.',/,
- +' The default tolerance is 0.1, and the minimization will stop',/,
- +' when the estimated vertical distance to the minimum (EDM) is',/,
- +' less than 0.001*[tolerance]*UP (see [SET ERRordef]).')
-*__________________________________________________________________
-*--
-*-- Command MINIMIZE
-*-- ================
-*.
- IF(COMD(1:4).EQ.'MINI')THEN
- WRITE(LOUT,10900)
- GO TO 99
- ENDIF
-10900 FORMAT(' ***>MINImize [maxcalls] [tolerance]',/,
- +' Causes minimization of the function by the method of Migrad,',/,
- +' as does the MIGrad command, but switches to the SIMplex method',
- +/,' if Migrad fails to converge. Arguments are as for MIGrad.',/,
- +' Note that command requires four characters to be unambiguous.')
-*__________________________________________________________________
-*--
-*-- Command MINOS
-*-- =============
-*.
- IF(COMD(1:4).EQ.'MINO')THEN
- WRITE(LOUT,11000)
- GO TO 99
- ENDIF
-11000 FORMAT(' ***>MINOs [maxcalls] [parno] [parno] ...',/,
- +' Causes a Minos error analysis to be performed on the parameters'
- +,/,' whose numbers [parno] are specified. If none are specified,',
- +/,' Minos errors are calculated for all variable parameters.',/,
- +' Minos errors may be expensive to calculate, but are very',/,
- +' reliable since they take account of non-linearities in the',/,
- +' problem as well as parameter correlations, and are in general',/
- +' asymmetric.',/,
- +' The optional argument [maxcalls] specifies the (approximate)',/,
- +' maximum number of function calls per parameter requested,',/,
- +' after which the calculation will stop for that parameter.')
-*__________________________________________________________________
-*--
-*-- Command MNCONTOUR
-*-- =================
-*.
- IF(CMD3.EQ.'MNC')THEN
- WRITE(LOUT,11100)
- GO TO 99
- ENDIF
-11100 FORMAT(' ***>MNContour <par1> <par2> [npts]',/,
- +' Calculates one function contour of FCN with respect to',/,
- +' parameters par1 and par2, with FCN minimized always with',/,
- +' respect to all other NPAR-2 variable parameters (if any).',/,
- +' Minuit will try to find npts points on the contour (default 20)'
- +,/,' If only two parameters are variable at the time, it is not',
- +/,' necessary to specify their numbers. To calculate more than',/,
- +' one contour, it is necessary to SET ERRordef to the appropriate'
- +,/,' value and issue the MNContour command for each contour.')
-*__________________________________________________________________
-*--
-*-- Command PARAMETER
-*-- =================
-*.
- IF(CMD3.EQ.'PAR')THEN
- WRITE(LOUT,11150)
- GO TO 99
- ENDIF
-11150 FORMAT(' ***>PARameters',/,
- +' followed by one or more parameter definitions.',/,
- +' Parameter definitions are of the form:',/,
- +' <number> ''name'' <value> <step> [lolim] [uplim] ',/,
- +' for example:',/,
- +' 3 ''K width'' 1.2 0.1' ,/,
- +' the last definition is followed by a blank line or a zero.')
-*__________________________________________________________________
-*--
-*-- Command RELEASE
-*-- ===============
-*.
- IF(CMD3.EQ.'REL')THEN
- WRITE(LOUT,11200)
- GO TO 99
- ENDIF
-11200 FORMAT(' ***>RELease <parno> [parno] ... [parno]',/,
- +' If <parno> is the number of a previously variable parameter',/,
- +' which has been fixed by a command: FIX <parno>, then that',/,
- +' parameter will return to variable status. Otherwise a warning'
- +,/,' message is printed and the command is ignored.',/,
- +' Note that this command operates only on parameters which were',/
- +' at one time variable and have been FIXed. It cannot make',/,
- +' constant parameters variable; that must be done by redefining',/
- +' the parameter with a PARameters command.')
-*__________________________________________________________________
-*--
-*-- Command RESTORE
-*-- ===============
-*.
- IF(CMD3.EQ.'RES')THEN
- WRITE(LOUT,11300)
- GO TO 99
- ENDIF
-11300 FORMAT(' ***>REStore [code]',/,
- +' If no [code] is specified, this command restores all previously'
- +,/,' FIXed parameters to variable status. If [code]=1, then only',
- +/,' the last parameter FIXed is restored to variable status.',/,
- +' If code is neither zero nor one, the command is ignored.')
-*__________________________________________________________________
-*--
-*-- Command RETURN
-*-- ==============
-*.
- IF(CMD3.EQ.'RET')THEN
- WRITE(LOUT,11400)
- GO TO 99
- ENDIF
-11400 FORMAT(' ***>RETURN',/,
- +' Signals the end of a data block, and instructs Minuit to return'
- +,/,' to the program which called it. The RETurn command first',/,
- +' causes Minuit to CALL FCN with IFLAG=3, in order to allow FCN',/
- +,' to perform any calculations associated with the final fitted',/
- +,' parameter values, unless a CALL FCN 3 command has already been'
- +,/,' executed at the current FCN value.')
-*__________________________________________________________________
-*--
-*-- Command SAVE
-*-- ============
-*.
- IF(CMD3.EQ.'SAV')THEN
- WRITE(LOUT,11500)
- GO TO 99
- ENDIF
-11500 FORMAT(' ***>SAVe',/,
- +' Causes the current parameter values to be saved on a file in',/,
- +' such a format that they can be read in again as Minuit',/,
- +' parameter definitions. If the covariance matrix exists, it is',/
- +,' also output in such a format. The unit number is by default 7,'
- +,/,' or that specified by the user in his call to MINTIO or',/,
- +' MNINIT. The user is responsible for opening the file previous'
- +,/,' to issuing the [SAVe] command (except where this can be done'
- +,/,' interactively).')
-*__________________________________________________________________
-*--
-*-- Command SCAN
-*-- ============
-*.
- IF(CMD3.EQ.'SCA')THEN
- WRITE(LOUT,11600)
- GO TO 99
- ENDIF
-11600 FORMAT(' ***>SCAn [parno] [numpts] [from] [to]',/,
- +' Scans the value of the user function by varying parameter',/,
- +' number [parno], leaving all other parameters fixed at the',/,
- +' current value. If [parno] is not specified, all variable',/,
- +' parameters are scanned in sequence.',/,
- +' The number of points [numpts] in the scan is 40 by default,',/,
- +' and cannot exceed 100. The range of the scan is by default',/,
- +' 2 standard deviations on each side of the current best value,',
- +/,' but can be specified as from [from] to [to].',/,
- +' After each scan, if a new minimum is found, the best parameter'
- +,/,' values are retained as start values for future scans or',/,
- +' minimizations. The curve resulting from each scan is plotted',/
- +,' on the output unit in order to show the approximate behaviour'
- +,/,' of the function.',/,
- +' This command is not intended for minimization, but is sometimes'
- +,/,' useful for debugging the user function or finding a',/,
- +' reasonable starting point.')
-*__________________________________________________________________
-*--
-*-- Command SEEK
-*-- ============
-*.
- IF(CMD3.EQ.'SEE')THEN
- WRITE(LOUT,11700)
- GO TO 99
- ENDIF
-11700 FORMAT(' ***>SEEk [maxcalls] [devs]',/,
- +' Causes a Monte Carlo minimization of the function, by choosing',
- +/,' random values of the variable parameters, chosen uniformly',/,
- +' over a hypercube centered at the current best value.',/,
- +' The region size is by default 3 standard deviations on each',/,
- +' side, but can be changed by specifying the value of [devs].')
-*__________________________________________________________________
-*--
-*-- Command SET
-*-- ===========
-*.
- IF(CMD3.EQ.'SET')THEN
- WRITE(LOUT,11800)
- WRITE(LOUT,11801)
- WRITE(LOUT,11802)
- WRITE(LOUT,11803)
- WRITE(LOUT,11804)
- WRITE(LOUT,11805)
- WRITE(LOUT,11806)
- WRITE(LOUT,11807)
- WRITE(LOUT,11808)
- WRITE(LOUT,11809)
- WRITE(LOUT,11810)
- WRITE(LOUT,11811)
- WRITE(LOUT,11812)
- WRITE(LOUT,11813)
- WRITE(LOUT,11814)
- WRITE(LOUT,11815)
- WRITE(LOUT,11816)
- WRITE(LOUT,11817)
- GO TO 99
- ENDIF
-11800 FORMAT(' ***>SET <option_name>',/,/,
- +' SET BATch',/,
- +' Informs Minuit that it is running in batch mode.',//,
-
- +' SET EPSmachine <accuracy>',/,
- +' Informs Minuit that the relative floating point arithmetic',/
- +' precision is <accuracy>. Minuit determines the nominal',/,
- +' precision itself, but the SET EPSmachine command can be',/,
- +' used to override Minuit own determination, when the user',/,
- +' knows that the FCN function value is not calculated to',/,
- +' the nominal machine accuracy. Typical values of <accuracy>',/
- +' are between 10**-5 and 10**-14.')
-
-11801 FORMAT(/,' SET ERRordef <up>',/,
- +' Sets the value of UP (default value= 1.), defining parameter'
- +,/,' errors. Minuit defines parameter errors as the change',/,
- +' in parameter value required to change the function value',/,
- +' by UP. Normally, for chisquared fits UP=1, and for negative'
- +,/,' log likelihood, UP=0.5.')
-
-11802 FORMAT(/,' SET GRAdient [force]',/,
- +' Informs Minuit that the user function is prepared to',/,
- +' calculate its own first derivatives and return their values'
- +,/,' in the array GRAD when IFLAG=2 (see specs of FCN).',/,
- +' If [force] is not specified, Minuit will calculate',/,
- +' the FCN derivatives by finite differences at the current',/,
- +' point and compare with the user calculation at that point,'
- +,/,' accepting the user values only if they agree.',/,
- +' If [force]=1, Minuit does not do its own derivative',/,
- +' calculation, and uses the derivatives calculated in FCN.')
-
-11803 FORMAT(/,' SET INPut [unitno] [filename]',/,
- +' Causes Minuit, in data-driven mode only, to read subsequent',
- +/,' commands (or parameter definitions) from a different input'
- +,/,' file. If no [unitno] is specified, reading reverts to the'
- +,/,' previous input file, assuming that there was one.',/,
- +' If [unitno] is specified, and that unit has not been opened,'
- +,/,' then Minuit attempts to open the file [filename]} if a',/,
- +' name is specified. If running in interactive mode and',/,
- +' [filename] is not specified and [unitno] is not opened,',/,
- +' Minuit prompts the user to enter a file name.',/,
- +' If the word REWIND is added to the command (note:no blanks',/
- +' between INPUT and REWIND), the file is rewound before',/,
- +' reading. Note that this command is implemented in standard',/
- +' Fortran 77 and the results may depend on the system;',/,
- +' for example, if a filename is given under VM/CMS, it must',/,
- +' be preceeded by a slash.')
-
-11804 FORMAT(/,' SET INTeractive',/,
- +' Informs Minuit that it is running interactively.')
-
-11805 FORMAT(/,' SET LIMits [parno] [lolim] [uplim]',/,
- +' Allows the user to change the limits on one or all',/,
- +' parameters. If no arguments are specified, all limits are',/,
- +' removed from all parameters. If [parno] alone is specified,',
- +/,' limits are removed from parameter [parno].',/,
- +' If all arguments are specified, then parameter [parno] will',
- +/,' be bounded between [lolim] and [uplim].',/,
- +' Limits can be specified in either order, Minuit will take',/,
- +' the smaller as [lolim] and the larger as [uplim].',/,
- +' However, if [lolim] is equal to [uplim], an error condition',
- +/,' results.')
-
-11806 FORMAT(/,' SET LINesperpage',/,
- +' Sets the number of lines for one page of output.',/,
- +' Default value is 24 for interactive mode')
-
-11807 FORMAT(/,' SET NOGradient',/,
- +' The inverse of SET GRAdient, instructs Minuit not to',
- +/,' use the first derivatives calculated by the user in FCN.')
-
-11808 FORMAT(/,' SET NOWarnings',/,
- +' Supresses Minuit warning messages.')
-
-11809 FORMAT(/,' SET OUTputfile <unitno>',/,
- +' Instructs Minuit to write further output to unit <unitno>.')
-
-11810 FORMAT(/,' SET PAGethrow <integer>',/,
- +' Sets the carriage control character for ``new page'' to',/,
- +' <integer>. Thus the value 1 produces a new page, and 0',/,
- +' produces a blank line, on some devices (see TOPofpage)')
-
-
-11811 FORMAT(/,' SET PARameter <parno> <value>',/,
- +' Sets the value of parameter <parno> to <value>.',/,
- +' The parameter in question may be variable, fixed, or',/,
- +' constant, but must be defined.')
-
-11812 FORMAT(/,' SET PRIntout <level>',/,
- +' Sets the print level, determining how much output will be',/,
- +' produced. Allowed values and their meanings are displayed',/,
- +' after a SHOw PRInt command, and are currently <level>=:',/,
- +' [-1] no output except from SHOW commands',/,
- +' [0] minimum output',/,
- +' [1] default value, normal output',/,
- +' [2] additional output giving intermediate results.',/,
- +' [3] maximum output, showing progress of minimizations.',/
- +' Note: See also the SET WARnings command.')
-
-11813 FORMAT(/,' SET RANdomgenerator <seed>',/,
- +' Sets the seed of the random number generator used in SEEk.',/
- +' This can be any integer between 10000 and 900000000, for',/,
- +' example one which was output from a SHOw RANdom command of',/
- +' a previous run.')
-
-11814 FORMAT(/,' SET STRategy <level>',/,
- +' Sets the strategy to be used in calculating first and second'
- +,/,' derivatives and in certain minimization methods.',/,
- +' In general, low values of <level> mean fewer function calls',
- +/,' and high values mean more reliable minimization.',/,
- +' Currently allowed values are 0, 1 (default), and 2.')
-
-11815 FORMAT(/,' SET TITle',/,
- +' Informs Minuit that the next input line is to be considered',
- +/,' the (new) title for this task or sub-task. This is for',/,
- +' the convenience of the user in reading his output.')
-
-11816 FORMAT(/,' SET WARnings',/,
- +' Instructs Minuit to output warning messages when suspicious',
- +/,' conditions arise which may indicate unreliable results.',/
- +' This is the default.')
-
-11817 FORMAT(/,' SET WIDthpage',/,
- +' Informs Minuit of the output page width.',/,
- +' Default values are 80 for interactive jobs')
-*__________________________________________________________________
-*--
-*-- Command SHOW
-*-- ============
-*.
- IF(CMD3.EQ.'SHO')THEN
- WRITE(LOUT,11900)
- WRITE(LOUT,11901)
- WRITE(LOUT,11902)
- WRITE(LOUT,11903)
- WRITE(LOUT,11904)
- GO TO 99
- ENDIF
-11900 FORMAT(' ***>SHOw <option_name>',/,
- +' All SET XXXX commands have a corresponding SHOw XXXX command.',
- +/,' In addition, the SHOw commands listed starting here have no',
- +/,' corresponding SET command for obvious reasons.')
-
-11901 FORMAT(/,' SHOw CORrelations',/,
- +' Calculates and prints the parameter correlations from the',/,
- +' error matrix.')
-
-11902 FORMAT(/,' SHOw COVariance',/,
- +' Prints the (external) covariance (error) matrix.')
-
-11903 FORMAT(/,' SHOw EIGenvalues',/,
- +' Calculates and prints the eigenvalues of the covariance',/,
- +' matrix.')
-
-11904 FORMAT(/,' SHOw FCNvalue',/,
- +' Prints the current value of FCN.')
-*__________________________________________________________________
-*--
-*-- Command SIMPLEX
-*-- ===============
-*.
- IF(CMD3.EQ.'SIM')THEN
- WRITE(LOUT,12000)
- GO TO 99
- ENDIF
-12000 FORMAT(' ***>SIMplex [maxcalls] [tolerance]',/,
- +' Performs a function minimization using the simplex method of',/
- +' Nelder and Mead. Minimization terminates either when the',/,
- +' function has been called (approximately) [maxcalls] times,',/,
- +' or when the estimated vertical distance to minimum (EDM) is',/,
- +' less than [tolerance].',/,
- +' The default value of [tolerance] is 0.1*UP(see SET ERRordef).')
-*__________________________________________________________________
-*--
-*-- Command STANDARD
-*-- ================
-*.
- IF(CMD3.EQ.'STA')THEN
- WRITE(LOUT,12100)
- GO TO 99
- ENDIF
-12100 FORMAT(' ***>STAndard',/,
- +' Causes Minuit to execute the Fortran instruction CALL STAND',/,
- +' where STAND is a subroutine supplied by the user.')
-*__________________________________________________________________
-*--
-*-- Command STOP
-*-- ============
-*.
- IF(CMD3.EQ.'STO')THEN
- WRITE(LOUT,12200)
- GO TO 99
- ENDIF
-12200 FORMAT(' ***>STOP',/,
- +' Same as EXIT.')
-*__________________________________________________________________
-*--
-*-- Command TOPOFPAGE
-*-- =================
-*.
- IF(CMD3.EQ.'TOP')THEN
- WRITE(LOUT,12300)
- GO TO 99
- ENDIF
-12300 FORMAT(' ***>TOPofpage',/,
- +' Causes Minuit to write the character specified in a',/,
- +' SET PAGethrow command (default = 1) to column 1 of the output'
- +,/,' file, which may or may not position your output medium to',
- +/,' the top of a page depending on the device and system.')
-*__________________________________________________________________
-*
- WRITE(LOUT,13000)
-13000 FORMAT(' Unknown MINUIT command. Type HELP for list of commands.')
-*
- 99 RETURN
- END
diff --git a/src/packlib/minuit/code/mnhes1.F b/src/packlib/minuit/code/mnhes1.F
deleted file mode 100644
index fa35a10..0000000
--- a/src/packlib/minuit/code/mnhes1.F
+++ /dev/null
@@ -1,78 +0,0 @@
-*
-* $Id: mnhes1.F,v 1.1.1.1 1996/03/07 14:31:30 mclareni Exp $
-*
-* $Log: mnhes1.F,v $
-* Revision 1.1.1.1 1996/03/07 14:31:30 mclareni
-* Minuit
-*
-*
-#include "minuit/pilot.h"
- SUBROUTINE MNHES1(FCN,FUTIL)
-#include "minuit/d506dp.inc"
-CC Called from MNHESS and MNGRAD
-CC Calculate first derivatives (GRD) and uncertainties (DGRD)
-CC and appropriate step sizes GSTEP
-#include "minuit/d506cm.inc"
- EXTERNAL FCN,FUTIL
- LOGICAL LDEBUG
- CHARACTER CBF1*22
- LDEBUG = (IDBG(5) .GE. 1)
- IF (ISTRAT .LE. 0) NCYC = 1
- IF (ISTRAT .EQ. 1) NCYC = 2
- IF (ISTRAT .GT. 1) NCYC = 6
- IDRV = 1
- NPARX = NPAR
- DFMIN = 4.*EPSMA2*(ABS(AMIN)+UP)
-C main loop over parameters
- DO 100 I= 1, NPAR
- XTF = X(I)
- DMIN = 4.*EPSMA2*ABS(XTF)
- EPSPRI = EPSMA2 + ABS(GRD(I)*EPSMA2)
- OPTSTP = SQRT(DFMIN/(ABS(G2(I))+EPSPRI))
- D = 0.2 * ABS(GSTEP(I))
- IF (D .GT. OPTSTP) D = OPTSTP
- IF (D .LT. DMIN) D = DMIN
- CHGOLD = 10000.
-C iterate reducing step size
- DO 50 ICYC= 1, NCYC
- X(I) = XTF + D
- CALL MNINEX(X)
- CALL FCN(NPARX,GIN,FS1,U,4,FUTIL)
- NFCN = NFCN + 1
- X(I) = XTF - D
- CALL MNINEX(X)
- CALL FCN(NPARX,GIN,FS2,U,4,FUTIL)
- NFCN = NFCN + 1
- X(I) = XTF
-C check if step sizes appropriate
- SAG = 0.5*(FS1+FS2-2.0*AMIN)
- GRDOLD = GRD(I)
- GRDNEW = (FS1-FS2)/(2.0*D)
- DGMIN = EPSMAC*(ABS(FS1)+ABS(FS2))/D
- IF (LDEBUG) WRITE (ISYSWR,11) I,IDRV,GSTEP(I),D,G2(I),GRDNEW,SAG
- 11 FORMAT (I4,I2,6G12.5)
- IF (GRDNEW .EQ. ZERO) GO TO 60
- CHANGE = ABS((GRDOLD-GRDNEW)/GRDNEW)
- IF (CHANGE.GT.CHGOLD .AND. ICYC.GT.1) GO TO 60
- CHGOLD = CHANGE
- GRD(I) = GRDNEW
- GSTEP(I) = SIGN(D,GSTEP(I))
-C decrease step until first derivative changes by <5%
- IF (CHANGE .LT. 0.05) GO TO 60
- IF (ABS(GRDOLD-GRDNEW) .LT. DGMIN) GO TO 60
- IF (D .LT. DMIN) THEN
- CALL MNWARN('D','MNHES1','Step size too small for 1st drv.')
- GO TO 60
- ENDIF
- D = 0.2*D
- 50 CONTINUE
-C loop satisfied = too many iter
- WRITE (CBF1,'(2G11.3)') GRDOLD,GRDNEW
- CALL MNWARN('D','MNHES1','Too many iterations on D1.'//CBF1)
- 60 CONTINUE
- DGRD(I) = MAX(DGMIN,ABS(GRDOLD-GRDNEW))
- 100 CONTINUE
-C end of first deriv. loop
- CALL MNINEX(X)
- RETURN
- END
diff --git a/src/packlib/minuit/code/mnhess.F b/src/packlib/minuit/code/mnhess.F
deleted file mode 100644
index 1e76665..0000000
--- a/src/packlib/minuit/code/mnhess.F
+++ /dev/null
@@ -1,223 +0,0 @@
-*
-* $Id: mnhess.F,v 1.1.1.1 1996/03/07 14:31:30 mclareni Exp $
-*
-* $Log: mnhess.F,v $
-* Revision 1.1.1.1 1996/03/07 14:31:30 mclareni
-* Minuit
-*
-*
-#include "minuit/pilot.h"
- SUBROUTINE MNHESS(FCN,FUTIL)
-#include "minuit/d506dp.inc"
-CC Calculates the full second-derivative matrix of FCN
-CC by taking finite differences. When calculating diagonal
-CC elements, it may iterate so that step size is nearly that
-CC which gives function change= UP/10. The first derivatives
-CC of course come as a free side effect, but with a smaller
-CC step size in order to obtain a known accuracy.
-CC
-#include "minuit/d506cm.inc"
- EXTERNAL FCN,FUTIL
- DIMENSION YY(MNI)
- LOGICAL LDEBUG
- CHARACTER CBF1*22
-C
- LDEBUG = (IDBG(3) .GE. 1)
- IF (AMIN .EQ. UNDEFI) CALL MNAMIN(FCN,FUTIL)
- IF (ISTRAT .LE. 0) THEN
- NCYC = 3
- TLRSTP = 0.5
- TLRG2 = 0.1
- ELSE IF (ISTRAT .EQ. 1) THEN
- NCYC = 5
- TLRSTP = 0.3
- TLRG2 = 0.05
- ELSE
- NCYC = 7
- TLRSTP = 0.1
- TLRG2 = 0.02
- ENDIF
- IF (ISW(5).GE.2 .OR. LDEBUG) WRITE (ISYSWR,'(A)')
- + ' START COVARIANCE MATRIX CALCULATION.'
- CFROM = 'HESSE '
- NFCNFR = NFCN
- CSTATU= 'OK '
- NPARD = NPAR
-C make sure starting at the right place
- CALL MNINEX(X)
- NPARX = NPAR
- CALL FCN(NPARX,GIN,FS1,U,4,FUTIL)
- NFCN = NFCN + 1
- IF (FS1 .NE. AMIN) THEN
- DF = AMIN - FS1
- WRITE (CBF1(1:12),'(G12.3)') DF
- CALL MNWARN('D','MNHESS',
- + 'function value differs from AMIN by '//CBF1(1:12) )
- ENDIF
- AMIN = FS1
- IF (LDEBUG) WRITE (ISYSWR,'(A,A)') ' PAR D GSTEP ',
- +' D G2 GRD SAG '
-C . . . . . . diagonal elements .
-C ISW(2) = 1 if approx, 2 if not posdef, 3 if ok
-C AIMSAG is the sagitta we are aiming for in second deriv calc.
- AIMSAG = SQRT(EPSMA2)*(ABS(AMIN)+UP)
-C Zero the second derivative matrix
- NPAR2 = NPAR*(NPAR+1)/2
- DO 10 I= 1,NPAR2
- 10 VHMAT(I) = 0.
-C
-C Loop over variable parameters for second derivatives
- IDRV = 2
- DO 100 ID= 1, NPARD
- I = ID + NPAR - NPARD
- IEXT = NEXOFI(I)
- IF (G2(I) .EQ. ZERO) THEN
- WRITE (CBF1(1:4),'(I4)') IEXT
- CALL MNWARN('W','HESSE',
- + 'Second derivative enters zero, param '//CBF1(1:4) )
- WINT = WERR(I)
- IF (NVARL(IEXT) .GT. 1) THEN
- CALL MNDXDI(X(I),I,DXDI)
- IF (ABS(DXDI) .LT. .001) THEN
- WINT = .01
- ELSE
- WINT = WINT/ABS(DXDI)
- ENDIF
- ENDIF
- G2(I) = UP/WINT**2
- ENDIF
- XTF = X(I)
- DMIN = 8.*EPSMA2*ABS(XTF)
-C
-C find step which gives sagitta = AIMSAG
- D = ABS(GSTEP(I))
- DO 40 ICYC= 1, NCYC
-C loop here only if SAG=0.
- DO 25 MULTPY= 1, 5
-C take two steps
- X(I) = XTF + D
- CALL MNINEX(X)
- NPARX = NPAR
- CALL FCN(NPARX,GIN,FS1,U,4,FUTIL)
- NFCN = NFCN + 1
- X(I) = XTF - D
- CALL MNINEX(X)
- CALL FCN(NPARX,GIN,FS2,U,4,FUTIL)
- NFCN = NFCN + 1
- X(I) = XTF
- SAG = 0.5*(FS1+FS2-2.0*AMIN)
- IF (SAG .NE. ZERO) GO TO 30
- IF (GSTEP(I) .LT. ZERO) THEN
- IF (D .GE. .5) GO TO 26
- D = 10.*D
- IF (D .GT. 0.5) D = 0.51
- GO TO 25
- ENDIF
- D = 10.*D
- 25 CONTINUE
- 26 WRITE (CBF1(1:4),'(I4)') IEXT
- CALL MNWARN('W','HESSE',
- + 'Second derivative zero for parameter'//CBF1(1:4) )
- GO TO 390
-C SAG is not zero
- 30 G2BFOR = G2(I)
- G2(I) = 2.*SAG/D**2
- GRD(I) = (FS1-FS2)/(2.*D)
- IF (LDEBUG) WRITE (ISYSWR,31) I,IDRV,GSTEP(I),D,G2(I),GRD(I),SAG
- 31 FORMAT (I4,I2,6G12.5)
- GSTEP(I) = SIGN(D,GSTEP(I))
- DIRIN(I) = D
- YY(I) = FS1
- DLAST = D
- D = SQRT(2.0*AIMSAG/ABS(G2(I)))
-C if parameter has limits, max int step size = 0.5
- STPINM = 0.5
- IF (GSTEP(I) .LT. ZERO) D = MIN(D,STPINM)
- IF (D .LT. DMIN) D = DMIN
-C see if converged
- IF (ABS((D-DLAST)/D) .LT. TLRSTP) GO TO 50
- IF (ABS((G2(I)-G2BFOR)/G2(I)) .LT. TLRG2 ) GO TO 50
- D = MIN(D, 10.*DLAST)
- D = MAX(D, 0.1*DLAST)
- 40 CONTINUE
-C end of step size loop
- WRITE (CBF1,'(I2,2E10.2)') IEXT,SAG,AIMSAG
- CALL MNWARN('D','MNHESS','Second Deriv. SAG,AIM= '//CBF1)
-C
- 50 CONTINUE
- NDEX = I*(I+1)/2
- VHMAT(NDEX) = G2(I)
- 100 CONTINUE
-C end of diagonal second derivative loop
- CALL MNINEX(X)
-C refine the first derivatives
- IF (ISTRAT .GT. 0) CALL MNHES1(FCN,FUTIL)
- ISW(2) = 3
- DCOVAR = 0.
-C . . . . off-diagonal elements
- IF (NPAR .EQ. 1) GO TO 214
- DO 200 I= 1, NPAR
- DO 180 J= 1, I-1
- XTI = X(I)
- XTJ = X(J)
- X(I) = XTI + DIRIN(I)
- X(J) = XTJ + DIRIN(J)
- CALL MNINEX(X)
- CALL FCN(NPARX,GIN,FS1,U,4,FUTIL)
- NFCN = NFCN + 1
- X(I) = XTI
- X(J) = XTJ
- ELEM = (FS1+AMIN-YY(I)-YY(J)) / (DIRIN(I)*DIRIN(J))
- NDEX = I*(I-1)/2 + J
- VHMAT(NDEX) = ELEM
- 180 CONTINUE
- 200 CONTINUE
- 214 CALL MNINEX(X)
-C verify matrix positive-definite
- CALL MNPSDF
- DO 220 I= 1, NPAR
- DO 219 J= 1, I
- NDEX = I*(I-1)/2 + J
- P(I,J) = VHMAT(NDEX)
- 219 P(J,I) = P(I,J)
- 220 CONTINUE
- CALL MNVERT(P,MAXINT,MAXINT,NPAR,IFAIL)
- IF (IFAIL .GT. 0) THEN
- CALL MNWARN('W','HESSE', 'Matrix inversion fails.')
- GO TO 390
- ENDIF
-C . . . . . . . calculate e d m
- EDM = 0.
- DO 230 I= 1, NPAR
-C off-diagonal elements
- NDEX = I*(I-1)/2
- DO 225 J= 1, I-1
- NDEX = NDEX + 1
- ZTEMP = 2.0 * P(I,J)
- EDM = EDM + GRD(I)*ZTEMP*GRD(J)
- 225 VHMAT(NDEX) = ZTEMP
-C diagonal elements
- NDEX = NDEX + 1
- VHMAT(NDEX) = 2.0 * P(I,I)
- EDM = EDM + P(I,I) * GRD(I)**2
- 230 CONTINUE
- IF (ISW(5).GE.1 .AND. ISW(2).EQ.3 .AND. ITAUR.EQ.0)
- + WRITE(ISYSWR,'(A)')' COVARIANCE MATRIX CALCULATED SUCCESSFULLY'
- GO TO 900
-C failure to invert 2nd deriv matrix
- 390 ISW(2) = 1
- DCOVAR = 1.
- CSTATU = 'FAILED '
- IF (ISW(5) .GE. 0) WRITE (ISYSWR,'(A)')
- + ' MNHESS FAILS AND WILL RETURN DIAGONAL MATRIX. '
- DO 395 I= 1, NPAR
- NDEX = I*(I-1)/2
- DO 394 J= 1, I-1
- NDEX = NDEX + 1
- 394 VHMAT(NDEX) = 0.0
- NDEX = NDEX +1
- G2I = G2(I)
- IF (G2I .LE. ZERO) G2I = 1.0
- 395 VHMAT(NDEX) = 2.0/G2I
- 900 RETURN
- END
diff --git a/src/packlib/minuit/code/mnimpr.F b/src/packlib/minuit/code/mnimpr.F
deleted file mode 100644
index 2691559..0000000
--- a/src/packlib/minuit/code/mnimpr.F
+++ /dev/null
@@ -1,190 +0,0 @@
-*
-* $Id: mnimpr.F,v 1.1.1.1 1996/03/07 14:31:30 mclareni Exp $
-*
-* $Log: mnimpr.F,v $
-* Revision 1.1.1.1 1996/03/07 14:31:30 mclareni
-* Minuit
-*
-*
-#include "minuit/pilot.h"
- SUBROUTINE MNIMPR(FCN,FUTIL)
-#include "minuit/d506dp.inc"
-CC Attempts to improve on a good local minimum by finding a
-CC better one. The quadratic part of FCN is removed by MNCALF
-CC and this transformed function is minimized using the simplex
-CC method from several random starting points.
-CC ref. -- Goldstein and Price, Math.Comp. 25, 569 (1971)
-CC
-#include "minuit/d506cm.inc"
- EXTERNAL FCN,FUTIL
- DIMENSION DSAV(MNI), Y(MNI+1)
- PARAMETER (ALPHA=1.,BETA=0.5,GAMMA=2.0)
- DATA RNUM/0./
- IF (NPAR .LE. 0) RETURN
- IF (AMIN .EQ. UNDEFI) CALL MNAMIN(FCN,FUTIL)
- CSTATU = 'UNCHANGED '
- ITAUR = 1
- EPSI = 0.1*UP
- NPFN=NFCN
- NLOOP = WORD7(2)
- IF (NLOOP .LE. 0) NLOOP = NPAR + 4
- NPARX = NPAR
- NPARP1=NPAR+1
- WG = 1.0/FLOAT(NPAR)
- SIGSAV = EDM
- APSI = AMIN
- DO 2 I= 1, NPAR
- XT(I) = X(I)
- DSAV(I) = WERR(I)
- DO 2 J = 1, I
- NDEX = I*(I-1)/2 + J
- P(I,J) = VHMAT(NDEX)
- 2 P(J,I) = P(I,J)
- CALL MNVERT(P,MAXINT,MAXINT,NPAR,IFAIL)
- IF (IFAIL .GE. 1) GO TO 280
-C Save inverted matrix in VT
- DO 12 I= 1, NPAR
- NDEX = I*(I-1)/2
- DO 12 J= 1, I
- NDEX = NDEX + 1
- 12 VTHMAT(NDEX) = P(I,J)
- LOOP = 0
-C
- 20 CONTINUE
- DO 25 I= 1, NPAR
- DIRIN(I) = 2.0*DSAV(I)
- CALL MNRN15(RNUM,ISEED)
- 25 X(I) = XT(I) + 2.0*DIRIN(I)*(RNUM-0.5)
- LOOP = LOOP + 1
- REG = 2.0
- IF (ISW(5) .GE. 0) WRITE (ISYSWR, 1040) LOOP
- 30 CALL MNCALF(FCN,X,YCALF,FUTIL)
- AMIN = YCALF
-C . . . . set up random simplex
- JL = NPARP1
- JH = NPARP1
- Y(NPARP1) = AMIN
- AMAX = AMIN
- DO 45 I= 1, NPAR
- XI = X(I)
- CALL MNRN15(RNUM,ISEED)
- X(I) = XI - DIRIN(I) *(RNUM-0.5)
- CALL MNCALF(FCN,X,YCALF,FUTIL)
- Y(I) = YCALF
- IF (Y(I) .LT. AMIN) THEN
- AMIN = Y(I)
- JL = I
- ELSE IF (Y(I) .GT. AMAX) THEN
- AMAX = Y(I)
- JH = I
- ENDIF
- DO 40 J= 1, NPAR
- 40 P(J,I) = X(J)
- P(I,NPARP1) = XI
- X(I) = XI
- 45 CONTINUE
-C
- EDM = AMIN
- SIG2 = EDM
-C . . . . . . . start main loop
- 50 CONTINUE
- IF (AMIN .LT. ZERO) GO TO 95
- IF (ISW(2) .LE. 2) GO TO 280
- EP = 0.1*AMIN
- IF (SIG2 .LT. EP .AND. EDM.LT.EP ) GO TO 100
- SIG2 = EDM
- IF ((NFCN-NPFN) .GT. NFCNMX) GO TO 300
-C calculate new point * by reflection
- DO 60 I= 1, NPAR
- PB = 0.
- DO 59 J= 1, NPARP1
- 59 PB = PB + WG * P(I,J)
- PBAR(I) = PB - WG * P(I,JH)
- 60 PSTAR(I)=(1.+ALPHA)*PBAR(I)-ALPHA*P(I,JH)
- CALL MNCALF(FCN,PSTAR,YCALF,FUTIL)
- YSTAR = YCALF
- IF(YSTAR.GE.AMIN) GO TO 70
-C point * better than jl, calculate new point **
- DO 61 I=1,NPAR
- 61 PSTST(I)=GAMMA*PSTAR(I)+(1.-GAMMA)*PBAR(I)
- CALL MNCALF(FCN,PSTST,YCALF,FUTIL)
- YSTST = YCALF
- 66 IF (YSTST .LT. Y(JL)) GO TO 67
- CALL MNRAZZ(YSTAR,PSTAR,Y,JH,JL)
- GO TO 50
- 67 CALL MNRAZZ(YSTST,PSTST,Y,JH,JL)
- GO TO 50
-C point * is not as good as jl
- 70 IF (YSTAR .GE. Y(JH)) GO TO 73
- JHOLD = JH
- CALL MNRAZZ(YSTAR,PSTAR,Y,JH,JL)
- IF (JHOLD .NE. JH) GO TO 50
-C calculate new point **
- 73 DO 74 I=1,NPAR
- 74 PSTST(I)=BETA*P(I,JH)+(1.-BETA)*PBAR(I)
- CALL MNCALF(FCN,PSTST,YCALF,FUTIL)
- YSTST = YCALF
- IF(YSTST.GT.Y(JH)) GO TO 30
-C point ** is better than jh
- IF (YSTST .LT. AMIN) GO TO 67
- CALL MNRAZZ(YSTST,PSTST,Y,JH,JL)
- GO TO 50
-C . . . . . . end main loop
- 95 IF (ISW(5) .GE. 0) WRITE (ISYSWR,1000)
- REG = 0.1
-C . . . . . ask if point is new
- 100 CALL MNINEX(X)
- CALL FCN(NPARX,GIN,AMIN,U,4,FUTIL)
- NFCN = NFCN + 1
- DO 120 I= 1, NPAR
- DIRIN(I) = REG*DSAV(I)
- IF (ABS(X(I)-XT(I)) .GT. DIRIN(I)) GO TO 150
- 120 CONTINUE
- GO TO 230
- 150 NFCNMX = NFCNMX + NPFN - NFCN
- NPFN = NFCN
- CALL MNSIMP(FCN,FUTIL)
- IF (AMIN .GE. APSI) GO TO 325
- DO 220 I= 1, NPAR
- DIRIN(I) = 0.1 *DSAV(I)
- IF (ABS(X(I)-XT(I)) .GT. DIRIN(I)) GO TO 250
- 220 CONTINUE
- 230 IF (AMIN .LT. APSI) GO TO 350
- GO TO 325
-C . . . . . . truly new minimum
- 250 LNEWMN = .TRUE.
- IF (ISW(2) .GE. 1) THEN
- ISW(2) = 1
- DCOVAR = MAX(DCOVAR,HALF)
- ELSE
- DCOVAR = 1.
- ENDIF
- ITAUR = 0
- NFCNMX = NFCNMX + NPFN - NFCN
- CSTATU = 'NEW MINIMU'
- IF (ISW(5) .GE. 0) WRITE (ISYSWR,1030)
- RETURN
-C . . . return to previous region
- 280 IF (ISW(5) .GT. 0) WRITE (ISYSWR,1020)
- GO TO 325
- 300 ISW(1) = 1
- 325 DO 330 I= 1, NPAR
- DIRIN(I) = 0.01*DSAV(I)
- 330 X(I) = XT(I)
- AMIN = APSI
- EDM = SIGSAV
- 350 CALL MNINEX(X)
- IF (ISW(5) .GT. 0) WRITE (ISYSWR,1010)
- CSTATU= 'UNCHANGED '
- CALL MNRSET(0)
- IF (ISW(2) .LT. 2) GO TO 380
- IF (LOOP .LT. NLOOP .AND. ISW(1) .LT. 1) GO TO 20
- 380 CALL MNPRIN (5,AMIN)
- ITAUR = 0
- RETURN
- 1000 FORMAT (54H AN IMPROVEMENT ON THE PREVIOUS MINIMUM HAS BEEN FOUND)
- 1010 FORMAT (51H IMPROVE HAS RETURNED TO REGION OF ORIGINAL MINIMUM)
- 1020 FORMAT (/44H COVARIANCE MATRIX WAS NOT POSITIVE-DEFINITE)
- 1030 FORMAT (/38H IMPROVE HAS FOUND A TRULY NEW MINIMUM/1H ,37(1H*)/)
- 1040 FORMAT (/18H START ATTEMPT NO.,I2, 20H TO FIND NEW MINIMUM)
- END
diff --git a/src/packlib/minuit/code/mninex.F b/src/packlib/minuit/code/mninex.F
deleted file mode 100644
index 685d7e4..0000000
--- a/src/packlib/minuit/code/mninex.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: mninex.F,v 1.1.1.1 1996/03/07 14:31:30 mclareni Exp $
-*
-* $Log: mninex.F,v $
-* Revision 1.1.1.1 1996/03/07 14:31:30 mclareni
-* Minuit
-*
-*
-#include "minuit/pilot.h"
- SUBROUTINE MNINEX(PINT)
-#include "minuit/d506dp.inc"
-CC Transforms from internal coordinates (PINT) to external
-CC parameters (U). The minimizing routines which work in
-CC internal coordinates call this routine before calling FCN.
-#include "minuit/d506cm.inc"
- DIMENSION PINT(*)
- DO 100 J= 1, NPAR
- I = NEXOFI(J)
- IF (NVARL(I) .EQ. 1) THEN
- U(I) = PINT(J)
- ELSE
- U(I) = ALIM(I) + 0.5*(SIN(PINT(J)) +1.0) * (BLIM(I)-ALIM(I))
- ENDIF
- 100 CONTINUE
- RETURN
- END
diff --git a/src/packlib/minuit/code/mninit.F b/src/packlib/minuit/code/mninit.F
deleted file mode 100644
index 0554376..0000000
--- a/src/packlib/minuit/code/mninit.F
+++ /dev/null
@@ -1,125 +0,0 @@
-*
-* $Id: mninit.F,v 1.4 1997/09/02 15:16:08 mclareni Exp $
-*
-* $Log: mninit.F,v $
-* Revision 1.4 1997/09/02 15:16:08 mclareni
-* WINNT corrections
-*
-* Revision 1.3 1997/03/14 17:18:00 mclareni
-* WNT mods
-*
-* Revision 1.2.2.1 1997/01/21 11:33:28 mclareni
-* All mods for Winnt 96a on winnt branch
-*
-* Revision 1.2 1996/03/15 18:02:47 james
-* Modified Files:
-* mnderi.F eliminate possible division by zero
-* mnexcm.F suppress print on STOP when print flag=-1
-* set FVAL3 to flag if FCN already called with IFLAG=3
-* mninit.F set version 96.03
-* mnlims.F remove arguments, not needed
-* mnmigr.F VLEN -> LENV in debug print statement
-* mnparm.F move call to MNRSET to after NPAR redefined, to zero all
-* mnpsdf.F eliminate possible division by zero
-* mnscan.F suppress printout when print flag =-1
-* mnset.F remove arguments in call to MNLIMS
-* mnsimp.F fix CSTATU so status is PROGRESS only if new minimum
-* mnvert.F eliminate possible division by zero
-*
-* Revision 1.1.1.1 1996/03/07 14:31:30 mclareni
-* Minuit
-*
-*
-#include "minuit/pilot.h"
- SUBROUTINE MNINIT (I1,I2,I3)
-#include "minuit/d506dp.inc"
-CC This is the main initialization subroutine for MINUIT
-CC It initializes some constants in common
-CC (including the logical I/O unit nos.),
-CC
-#include "minuit/d506cm.inc"
-C
- EXTERNAL INTRAC
- LOGICAL INTRAC
-C I/O unit numbers
- ISYSRD = I1
- ISYSWR = I2
- ISTKWR(1) = ISYSWR
- NSTKWR = 1
- ISYSSA = I3
- NSTKRD = 0
-C version identifier
- CVRSN = '96.03 '
-C some CONSTANT constants in COMMON
- MAXINT=MNI
- MAXEXT=MNE
- UNDEFI = -54321.
- BIGEDM = 123456.
- CUNDEF = ')UNDEFINED'
- COVMES(0) = 'NO ERROR MATRIX '
- COVMES(1) = 'ERR MATRIX APPROXIMATE'
- COVMES(2) = 'ERR MATRIX NOT POS-DEF'
- COVMES(3) = 'ERROR MATRIX ACCURATE '
-C some starting values in COMMON
- NBLOCK = 0
- ICOMND = 0
- CTITL = CUNDEF
- CFROM = 'INPUT '
- NFCNFR = NFCN
- CSTATU= 'INITIALIZE'
- ISW(3) = 0
- ISW(4) = 0
- ISW(5) = 1
-C ISW(6)=0 for batch jobs, =1 for interactive jobs
-C =-1 for originally interactive temporarily batch
- ISW(6) = 0
-#ifndef CERNLIB_MSSTDCALL
- IF (INTRAC(DUMMY)) ISW(6) = 1
-#else
- IF (INTRAC()) ISW(6) = 1
-#endif
-C DEBUG options set to default values
- DO 10 IDB= 0, MAXDBG
- 10 IDBG(IDB) = 0
- LREPOR = .FALSE.
- LWARN = .TRUE.
- LIMSET = .FALSE.
- LNEWMN = .FALSE.
- ISTRAT = 1
- ITAUR = 0
-C default page dimensions and 'new page' carriage control integer
- NPAGWD = 120
- NPAGLN = 56
- NEWPAG = 1
- IF (ISW(6) .GT. 0) THEN
- NPAGWD = 80
- NPAGLN = 30
- NEWPAG = 0
- ENDIF
- UP = 1.0
- UPDFLT = UP
-C determine machine accuracy epsmac
- EPSTRY = 0.5
- DO 33 I= 1, 100
- EPSTRY = EPSTRY * 0.5
- EPSP1 = ONE + EPSTRY
- CALL MNTINY(EPSP1, EPSBAK)
- IF (EPSBAK .LT. EPSTRY) GO TO 35
- 33 CONTINUE
- EPSTRY = 1.0E-7
- EPSMAC = 4.0*EPSTRY
- WRITE (ISYSWR,'(A,A,E10.2)') ' MNINIT UNABLE TO DETERMINE',
- + ' ARITHMETIC PRECISION. WILL ASSUME:',EPSMAC
- 35 EPSMAC = 8.0 * EPSTRY
- EPSMA2 = 2.0 * SQRT(EPSMAC)
-C the vlims are a non-negligible distance from pi/2
-C used by MNPINT to set variables "near" the physical limits
- PIBY2 = 2.0*ATAN(1.0)
- DISTNN = 8.0*SQRT(EPSMA2)
- VLIMHI = PIBY2 - DISTNN
- VLIMLO = -PIBY2 + DISTNN
- CALL MNCLER
- WRITE (ISYSWR,'(3A,I3,A,I3,A,E10.2)') ' MINUIT RELEASE ',CVRSN,
- +' INITIALIZED. DIMENSIONS ',MNE,'/',MNI,' EPSMAC=',EPSMAC
- RETURN
- END
diff --git a/src/packlib/minuit/code/mninpu.F b/src/packlib/minuit/code/mninpu.F
deleted file mode 100644
index ab507af..0000000
--- a/src/packlib/minuit/code/mninpu.F
+++ /dev/null
@@ -1,44 +0,0 @@
-*
-* $Id: mninpu.F,v 1.1.1.1 1996/03/07 14:31:30 mclareni Exp $
-*
-* $Log: mninpu.F,v $
-* Revision 1.1.1.1 1996/03/07 14:31:30 mclareni
-* Minuit
-*
-*
-#include "minuit/pilot.h"
- SUBROUTINE MNINPU(IUNIT,IERR)
-#include "minuit/d506dp.inc"
-CC called by the user to SET INPUT to IUNIT,
-CC an alternative to MNSTIN where the user can specify just
-CC a logical unit number and he is not interrogated about
-CC open files and rewinding, all that is the responsibility
-CC of the user and cannot be fixed interactively.
-#include "minuit/d506cm.inc"
-C
- IERR = 0
-C IUNIT = 0, revert to previous input file
- IF (IUNIT .EQ. 0) THEN
- IF (NSTKRD .EQ. 0) THEN
- WRITE (ISYSWR, '(A)') ' CALL TO MNINPU(0) IGNORED'
- WRITE (ISYSWR, '(A)') ' ALREADY READING FROM PRIMARY INPUT'
- ELSE
- ISYSRD = ISTKRD(NSTKRD)
- NSTKRD = NSTKRD - 1
- ENDIF
-C
-C new input file
- ELSE
- IF (NSTKRD .GE. MAXSTK) THEN
- WRITE (ISYSWR, '(A)') ' INPUT FILE STACK SIZE EXCEEDED.'
- GO TO 800
- ENDIF
- NSTKRD = NSTKRD + 1
- ISTKRD(NSTKRD) = ISYSRD
- ISYSRD = IUNIT
- ENDIF
-C
- RETURN
- 800 IERR = 1
- RETURN
- END
diff --git a/src/packlib/minuit/code/mnintr.F b/src/packlib/minuit/code/mnintr.F
deleted file mode 100644
index 316a97e..0000000
--- a/src/packlib/minuit/code/mnintr.F
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: mnintr.F,v 1.1.1.1 1996/03/07 14:31:30 mclareni Exp $
-*
-* $Log: mnintr.F,v $
-* Revision 1.1.1.1 1996/03/07 14:31:30 mclareni
-* Minuit
-*
-*
-#include "minuit/pilot.h"
- SUBROUTINE MNINTR(FCN,FUTIL)
-#include "minuit/d506dp.inc"
-CC Called by user. Interfaces to MNREAD to allow user to change
-CC easily from Fortran-callable to interactive mode.
-CC
-#include "minuit/d506cm.inc"
- EXTERNAL FCN,FUTIL
- IFLGIN = 3
- CALL MNREAD(FCN,IFLGIN,IFLGUT,FUTIL)
- WRITE (ISYSWR,'(2A/)') ' END OF MINUIT COMMAND INPUT. ',
- + ' RETURN TO USER PROGRAM.'
- RETURN
- END
diff --git a/src/packlib/minuit/code/mnlims.F b/src/packlib/minuit/code/mnlims.F
deleted file mode 100644
index adfaf29..0000000
--- a/src/packlib/minuit/code/mnlims.F
+++ /dev/null
@@ -1,125 +0,0 @@
-*
-* $Id: mnlims.F,v 1.2 1996/03/15 18:02:48 james Exp $
-*
-* $Log: mnlims.F,v $
-* Revision 1.2 1996/03/15 18:02:48 james
-* Modified Files:
-* mnderi.F eliminate possible division by zero
-* mnexcm.F suppress print on STOP when print flag=-1
-* set FVAL3 to flag if FCN already called with IFLAG=3
-* mninit.F set version 96.03
-* mnlims.F remove arguments, not needed
-* mnmigr.F VLEN -> LENV in debug print statement
-* mnparm.F move call to MNRSET to after NPAR redefined, to zero all
-* mnpsdf.F eliminate possible division by zero
-* mnscan.F suppress printout when print flag =-1
-* mnset.F remove arguments in call to MNLIMS
-* mnsimp.F fix CSTATU so status is PROGRESS only if new minimum
-* mnvert.F eliminate possible division by zero
-*
-* Revision 1.1.1.1 1996/03/07 14:31:30 mclareni
-* Minuit
-*
-*
-#include "minuit/pilot.h"
- SUBROUTINE MNLIMS
-#include "minuit/d506dp.inc"
-CC Called from MNSET
-CC Interprets the SET LIM command, to reset the parameter limits
-CC
-#include "minuit/d506cm.inc"
-C
- CFROM = 'SET LIM '
- NFCNFR = NFCN
- CSTATU= 'NO CHANGE '
- I2 = WORD7(1)
- IF (I2 .GT. MAXEXT .OR. I2 .LT. 0) GO TO 900
- IF (I2 .GT. 0) GO TO 30
-C set limits on all parameters
- NEWCOD = 4
- IF (WORD7(2) .EQ. WORD7(3)) NEWCOD = 1
- DO 20 INU= 1, NU
- IF (NVARL(INU) .LE. 0) GO TO 20
- IF (NVARL(INU).EQ.1 .AND. NEWCOD.EQ.1) GO TO 20
- KINT = NIOFEX(INU)
-C see if parameter has been fixed
- IF (KINT .LE. 0) THEN
- IF (ISW(5) .GE. 0) WRITE (ISYSWR,'(11X,A,I3)')
- + ' LIMITS NOT CHANGED FOR FIXED PARAMETER:',INU
- GO TO 20
- ENDIF
- IF (NEWCOD .EQ. 1) THEN
-C remove limits from parameter
- IF (ISW(5) .GT. 0) WRITE (ISYSWR,134) INU
- CSTATU = 'NEW LIMITS'
- CALL MNDXDI(X(KINT),KINT,DXDI)
- SNEW = GSTEP(KINT)*DXDI
- GSTEP(KINT) = ABS(SNEW)
- NVARL(INU) = 1
- ELSE
-C put limits on parameter
- ALIM(INU) = MIN(WORD7(2),WORD7(3))
- BLIM(INU) = MAX(WORD7(2),WORD7(3))
- IF (ISW(5) .GT. 0) WRITE (ISYSWR,237) INU,ALIM(INU),BLIM(INU)
- NVARL(INU) = 4
- CSTATU = 'NEW LIMITS'
- GSTEP(KINT) = -0.1
- ENDIF
- 20 CONTINUE
- GO TO 900
-C set limits on one parameter
- 30 IF (NVARL(I2) .LE. 0) THEN
- WRITE (ISYSWR,'(A,I3,A)') ' PARAMETER ',I2,' IS NOT VARIABLE.'
- GO TO 900
- ENDIF
- KINT = NIOFEX(I2)
-C see if parameter was fixed
- IF (KINT .EQ. 0) THEN
- WRITE (ISYSWR,'(A,I3)')
- + ' REQUEST TO CHANGE LIMITS ON FIXED PARAMETER:',I2
- DO 82 IFX= 1, NPFIX
- IF (I2 .EQ. IPFIX(IFX)) GO TO 92
- 82 CONTINUE
- WRITE (ISYSWR,'(A)') ' MINUIT BUG IN MNLIMS. SEE F. JAMES'
- 92 CONTINUE
- ENDIF
- IF (WORD7(2) .NE. WORD7(3)) GO TO 235
-C remove limits
- IF (NVARL(I2) .NE. 1) THEN
- IF (ISW(5) .GT. 0) WRITE (ISYSWR,134) I2
- 134 FORMAT (30H LIMITS REMOVED FROM PARAMETER ,I4)
- CSTATU = 'NEW LIMITS'
- IF (KINT .LE. 0) THEN
- GSTEPS(IFX) = ABS(GSTEPS(IFX))
- ELSE
- CALL MNDXDI(X(KINT),KINT,DXDI)
- IF (ABS(DXDI) .LT. 0.01) DXDI=0.01
- GSTEP(KINT) = ABS(GSTEP(KINT)*DXDI)
- GRD(KINT) = GRD(KINT)*DXDI
- ENDIF
- NVARL(I2) = 1
- ELSE
- WRITE (ISYSWR,'(A,I3)') ' NO LIMITS SPECIFIED. PARAMETER ',
- + I2,' IS ALREADY UNLIMITED. NO CHANGE.'
- ENDIF
- GO TO 900
-C put on limits
- 235 ALIM(I2) = MIN(WORD7(2),WORD7(3))
- BLIM(I2) = MAX(WORD7(2),WORD7(3))
- NVARL(I2) = 4
- IF (ISW(5) .GT. 0) WRITE (ISYSWR,237) I2,ALIM(I2),BLIM(I2)
- 237 FORMAT (10H PARAMETER ,I3, 14H LIMITS SET TO ,2G15.5)
- CSTATU = 'NEW LIMITS'
- IF (KINT .LE. 0) THEN
- GSTEPS(IFX) = -0.1
- ELSE
- GSTEP(KINT) = -0.1
- ENDIF
-C
- 900 CONTINUE
- IF (CSTATU .NE. 'NO CHANGE ') THEN
- CALL MNEXIN(X)
- CALL MNRSET(1)
- ENDIF
- RETURN
- END
diff --git a/src/packlib/minuit/code/mnline.F b/src/packlib/minuit/code/mnline.F
deleted file mode 100644
index 8794422..0000000
--- a/src/packlib/minuit/code/mnline.F
+++ /dev/null
@@ -1,223 +0,0 @@
-*
-* $Id: mnline.F,v 1.1.1.1 1996/03/07 14:31:30 mclareni Exp $
-*
-* $Log: mnline.F,v $
-* Revision 1.1.1.1 1996/03/07 14:31:30 mclareni
-* Minuit
-*
-*
-#include "minuit/pilot.h"
- SUBROUTINE MNLINE(FCN,START,FSTART,STEP,SLOPE,TOLER,FUTIL)
-#include "minuit/d506dp.inc"
-CC Perform a line search from position START
-CC along direction STEP, where the length of vector STEP
-CC gives the expected position of minimum.
-CC FSTART is value of function at START
-CC SLOPE (if non-zero) is df/dx along STEP at START
-CC TOLER is initial tolerance of minimum in direction STEP
-#include "minuit/d506cm.inc"
- EXTERNAL FCN,FUTIL
- DIMENSION START(*), STEP(*)
- PARAMETER (MAXPT=12)
- DIMENSION XPQ(MAXPT),YPQ(MAXPT)
- CHARACTER*1 CHPQ(MAXPT)
- DIMENSION XVALS(3),FVALS(3),COEFF(3)
- CHARACTER*26 CHARAL
- CHARACTER*60 CMESS
- PARAMETER (SLAMBG=5.,ALPHA=2.)
-C SLAMBG and ALPHA control the maximum individual steps allowed.
-C The first step is always =1. The max length of second step is SLAMBG.
-C The max size of subsequent steps is the maximum previous successful
-C step multiplied by ALPHA + the size of most recent successful step,
-C but cannot be smaller than SLAMBG.
- LOGICAL LDEBUG
- DATA CHARAL / 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' /
- LDEBUG = (IDBG(1).GE.1)
-C starting values for overall limits on total step SLAM
- OVERAL = 1000.
- UNDRAL = -100.
-C debug check if start is ok
- IF (LDEBUG) THEN
- CALL MNINEX(START)
- CALL FCN(NPARX,GIN,F1,U,4,FUTIL)
- NFCN=NFCN+1
- IF (F1 .NE. FSTART) THEN
- WRITE (ISYSWR,'(A/2E14.5/2X,10F10.5)')
- + ' MNLINE start point not consistent, F values, parameters=',
- + (X(KK),KK=1,NPAR)
- ENDIF
- ENDIF
-C . set up linear search along STEP
-
- FVMIN = FSTART
- XVMIN = ZERO
- NXYPT = 1
- CHPQ(1) = CHARAL(1:1)
- XPQ(1) = 0.
- YPQ(1) = FSTART
-C SLAMIN = smallest possible value of ABS(SLAM)
- SLAMIN = ZERO
- DO 20 I= 1, NPAR
- IF (STEP(I) .EQ. ZERO) GO TO 20
- RATIO = ABS(START(I)/STEP(I))
- IF (SLAMIN .EQ. ZERO) SLAMIN = RATIO
- IF (RATIO .LT. SLAMIN) SLAMIN = RATIO
- 20 X(I) = START(I) + STEP(I)
- IF (SLAMIN .EQ. ZERO) SLAMIN = EPSMAC
- SLAMIN = SLAMIN*EPSMA2
- NPARX = NPAR
-C
- CALL MNINEX(X)
- CALL FCN(NPARX,GIN,F1,U,4,FUTIL)
- NFCN=NFCN+1
- NXYPT = NXYPT + 1
- CHPQ(NXYPT) = CHARAL(NXYPT:NXYPT)
- XPQ(NXYPT) = 1.
- YPQ(NXYPT) = F1
- IF (F1 .LT. FSTART) THEN
- FVMIN = F1
- XVMIN = 1.0
- ENDIF
-C . quadr interp using slope GDEL and two points
- SLAM = 1.
- TOLER8 = TOLER
- SLAMAX = SLAMBG
- FLAST = F1
-C can iterate on two-points (cut) if no imprvmnt
- 25 CONTINUE
- DENOM = 2.0*(FLAST-FSTART-SLOPE*SLAM)/SLAM**2
-C IF (DENOM .EQ. ZERO) DENOM = -0.1*SLOPE
- SLAM = 1.
- IF (DENOM .NE. ZERO) SLAM = -SLOPE/DENOM
- IF (SLAM .LT. ZERO) SLAM = SLAMAX
- IF (SLAM .GT. SLAMAX) SLAM = SLAMAX
- IF (SLAM .LT. TOLER8) SLAM = TOLER8
- IF (SLAM .LT. SLAMIN) GO TO 80
- IF (ABS(SLAM-1.0).LT.TOLER8 .AND. F1.LT.FSTART) GO TO 70
- IF (ABS(SLAM-1.0).LT.TOLER8) SLAM = 1.0+TOLER8
- IF (NXYPT .GE. MAXPT) GO TO 65
- DO 30 I= 1, NPAR
- 30 X(I) = START(I) + SLAM*STEP(I)
- CALL MNINEX(X)
- CALL FCN(NPAR,GIN,F2,U,4,FUTIL)
- NFCN = NFCN + 1
- NXYPT = NXYPT + 1
- CHPQ(NXYPT) = CHARAL(NXYPT:NXYPT)
- XPQ(NXYPT) = SLAM
- YPQ(NXYPT) = F2
- IF (F2 .LT. FVMIN) THEN
- FVMIN = F2
- XVMIN = SLAM
- ENDIF
- IF (FSTART .EQ. FVMIN) THEN
- FLAST = F2
- TOLER8 = TOLER*SLAM
- OVERAL = SLAM-TOLER8
- SLAMAX = OVERAL
- GO TO 25
- ENDIF
-C . quadr interp using 3 points
- XVALS(1) = XPQ(1)
- FVALS(1) = YPQ(1)
- XVALS(2) = XPQ(NXYPT-1)
- FVALS(2) = YPQ(NXYPT-1)
- XVALS(3) = XPQ(NXYPT)
- FVALS(3) = YPQ(NXYPT)
-C begin iteration, calculate desired step
- 50 CONTINUE
- SLAMAX = MAX(SLAMAX,ALPHA*ABS(XVMIN))
- CALL MNPFIT(XVALS,FVALS,3,COEFF,SDEV)
- IF (COEFF(3) .LE. ZERO) THEN
- SLOPEM = 2.0*COEFF(3)*XVMIN + COEFF(2)
- IF (SLOPEM .LE. ZERO) THEN
- SLAM = XVMIN + SLAMAX
- ELSE
- SLAM = XVMIN - SLAMAX
- ENDIF
- ELSE
- SLAM = -COEFF(2)/(2.0*COEFF(3))
- IF (SLAM .GT. XVMIN+SLAMAX) SLAM = XVMIN+SLAMAX
- IF (SLAM .LT. XVMIN-SLAMAX) SLAM = XVMIN-SLAMAX
- ENDIF
- IF (SLAM .GT. ZERO) THEN
- IF (SLAM .GT. OVERAL) SLAM = OVERAL
- ELSE
- IF (SLAM .LT. UNDRAL) SLAM = UNDRAL
- ENDIF
-C come here if step was cut below
- 52 CONTINUE
- TOLER9 = MAX(TOLER8,ABS(TOLER8*SLAM))
- DO 55 IPT= 1, 3
- IF (ABS(SLAM-XVALS(IPT)) .LT. TOLER9) GO TO 70
- 55 CONTINUE
-C take the step
- IF (NXYPT .GE. MAXPT) GO TO 65
- DO 60 I= 1, NPAR
- 60 X(I) = START(I)+SLAM*STEP(I)
- CALL MNINEX(X)
- CALL FCN(NPARX,GIN,F3,U,4,FUTIL)
- NFCN = NFCN + 1
- NXYPT = NXYPT + 1
- CHPQ(NXYPT) = CHARAL(NXYPT:NXYPT)
- XPQ(NXYPT) = SLAM
- YPQ(NXYPT) = F3
-C find worst previous point out of three
- FVMAX = FVALS(1)
- NVMAX = 1
- IF (FVALS(2) .GT. FVMAX) THEN
- FVMAX = FVALS(2)
- NVMAX = 2
- ENDIF
- IF (FVALS(3) .GT. FVMAX) THEN
- FVMAX = FVALS(3)
- NVMAX = 3
- ENDIF
-C if latest point worse than all three previous, cut step
- IF (F3 .GE. FVMAX) THEN
- IF (NXYPT .GE. MAXPT) GO TO 65
- IF (SLAM .GT. XVMIN) OVERAL = MIN(OVERAL,SLAM-TOLER8)
- IF (SLAM .LT. XVMIN) UNDRAL = MAX(UNDRAL,SLAM+TOLER8)
- SLAM = 0.5*(SLAM+XVMIN)
- GO TO 52
- ENDIF
-C prepare another iteration, replace worst previous point
- XVALS(NVMAX) = SLAM
- FVALS(NVMAX) = F3
- IF (F3 .LT. FVMIN) THEN
- FVMIN = F3
- XVMIN = SLAM
- ELSE
- IF (SLAM .GT. XVMIN) OVERAL = MIN(OVERAL,SLAM-TOLER8)
- IF (SLAM .LT. XVMIN) UNDRAL = MAX(UNDRAL,SLAM+TOLER8)
- ENDIF
- IF (NXYPT .LT. MAXPT) GO TO 50
-C . . end of iteration . . .
-C stop because too many iterations
- 65 CMESS = ' LINE SEARCH HAS EXHAUSTED THE LIMIT OF FUNCTION CALLS '
- IF (LDEBUG) THEN
- WRITE (ISYSWR,'(A/(2X,6G12.4))') ' MNLINE DEBUG: steps=',
- + (STEP(KK),KK=1,NPAR)
- ENDIF
- GO TO 100
-C stop because within tolerance
- 70 CONTINUE
- CMESS = ' LINE SEARCH HAS ATTAINED TOLERANCE '
- GO TO 100
- 80 CONTINUE
- CMESS = ' STEP SIZE AT ARITHMETICALLY ALLOWED MINIMUM'
- 100 CONTINUE
- AMIN = FVMIN
- DO 120 I= 1, NPAR
- DIRIN(I) = STEP(I)*XVMIN
- 120 X(I) = START(I) + DIRIN(I)
- CALL MNINEX(X)
- IF (XVMIN .LT. 0.) CALL MNWARN('D','MNLINE',
- + ' LINE MINIMUM IN BACKWARDS DIRECTION')
- IF (FVMIN .EQ. FSTART) CALL MNWARN('D','MNLINE',
- + ' LINE SEARCH FINDS NO IMPROVEMENT ')
- IF (LDEBUG) THEN
- WRITE (ISYSWR,'('' AFTER'',I3,'' POINTS,'',A)') NXYPT,CMESS
- CALL MNPLOT(XPQ,YPQ,CHPQ,NXYPT,ISYSWR,NPAGWD,NPAGLN)
- ENDIF
- RETURN
- END
diff --git a/src/packlib/minuit/code/mnmatu.F b/src/packlib/minuit/code/mnmatu.F
deleted file mode 100644
index 68db1ea..0000000
--- a/src/packlib/minuit/code/mnmatu.F
+++ /dev/null
@@ -1,69 +0,0 @@
-*
-* $Id: mnmatu.F,v 1.1.1.1 1996/03/07 14:31:30 mclareni Exp $
-*
-* $Log: mnmatu.F,v $
-* Revision 1.1.1.1 1996/03/07 14:31:30 mclareni
-* Minuit
-*
-*
-#include "minuit/pilot.h"
- SUBROUTINE MNMATU(KODE)
-#include "minuit/d506dp.inc"
-CC prints the covariance matrix v when KODE=1.
-CC always prints the global correlations, and
-CC calculates and prints the individual correlation coefficients
-CC
-#include "minuit/d506cm.inc"
- DIMENSION VLINE(MNI)
- ISW2 = ISW(2)
- IF (ISW2 .LT. 1) THEN
- WRITE (ISYSWR,'(1X,A)') COVMES(ISW2)
- GO TO 500
- ENDIF
- IF (NPAR .EQ. 0) THEN
- WRITE (ISYSWR,'('' MNMATU: NPAR=0'')')
- GO TO 500
- ENDIF
-C . . . . .external error matrix
- IF (KODE .EQ. 1) THEN
- ISW5 = ISW(5)
- ISW(5) = 2
- CALL MNEMAT(P,MAXINT)
- IF (ISW2.LT.3) WRITE (ISYSWR,'(1X,A)') COVMES(ISW2)
- ISW(5) = ISW5
- ENDIF
-C . . . . . correlation coeffs. .
- IF (NPAR .LE. 1) GO TO 500
- CALL MNWERR
-C NCOEF is number of coeff. that fit on one line, not to exceed 20
- NCOEF = (NPAGWD-19)/6
- NCOEF = MIN(NCOEF,20)
- NPARM = MIN(NPAR,NCOEF)
- WRITE (ISYSWR, 150) (NEXOFI(ID),ID=1,NPARM)
- 150 FORMAT (/36H PARAMETER CORRELATION COEFFICIENTS /
- + 18H NO. GLOBAL ,20I6)
- DO 200 I= 1, NPAR
- IX = NEXOFI(I)
- NDI = I*(I+1)/2
- DO 170 J= 1, NPAR
- M = MAX(I,J)
- N = MIN(I,J)
- NDEX = M*(M-1)/2 + N
- NDJ = J*(J+1)/2
- 170 VLINE(J) = VHMAT(NDEX)/SQRT(ABS(VHMAT(NDI)*VHMAT(NDJ)))
- NPARM = MIN(NPAR,NCOEF)
- WRITE (ISYSWR,171) IX, GLOBCC(I), (VLINE(IT),IT=1,NPARM)
- 171 FORMAT (6X,I3,2X,F7.5,1X,20F6.3)
- IF (I.LE.NPARM) GO TO 200
- DO 190 ISO= 1, 10
- NSOFAR = NPARM
- NPARM = MIN(NPAR,NSOFAR+NCOEF)
- WRITE (ISYSWR,181) (VLINE(IT),IT=NSOFAR+1,NPARM)
- 181 FORMAT (19X,20F6.3)
- IF (I .LE. NPARM) GO TO 192
- 190 CONTINUE
- 192 CONTINUE
- 200 CONTINUE
- IF (ISW2.LT.3) WRITE (ISYSWR,'(1X,A)') COVMES(ISW2)
- 500 RETURN
- END
diff --git a/src/packlib/minuit/code/mnmigr.F b/src/packlib/minuit/code/mnmigr.F
deleted file mode 100644
index a7a57ff..0000000
--- a/src/packlib/minuit/code/mnmigr.F
+++ /dev/null
@@ -1,320 +0,0 @@
-*
-* $Id: mnmigr.F,v 1.2 1996/03/15 18:02:49 james Exp $
-*
-* $Log: mnmigr.F,v $
-* Revision 1.2 1996/03/15 18:02:49 james
-* Modified Files:
-* mnderi.F eliminate possible division by zero
-* mnexcm.F suppress print on STOP when print flag=-1
-* set FVAL3 to flag if FCN already called with IFLAG=3
-* mninit.F set version 96.03
-* mnlims.F remove arguments, not needed
-* mnmigr.F VLEN -> LENV in debug print statement
-* mnparm.F move call to MNRSET to after NPAR redefined, to zero all
-* mnpsdf.F eliminate possible division by zero
-* mnscan.F suppress printout when print flag =-1
-* mnset.F remove arguments in call to MNLIMS
-* mnsimp.F fix CSTATU so status is PROGRESS only if new minimum
-* mnvert.F eliminate possible division by zero
-*
-* Revision 1.1.1.1 1996/03/07 14:31:30 mclareni
-* Minuit
-*
-*
-#include "minuit/pilot.h"
- SUBROUTINE MNMIGR(FCN,FUTIL)
-#include "minuit/d506dp.inc"
-CC Performs a local function minimization using basically the
-CC method of Davidon-Fletcher-Powell as modified by Fletcher
-CC ref. -- Fletcher, Comp.J. 13,317 (1970) "switching method"
-CC
-#include "minuit/d506cm.inc"
- EXTERNAL FCN,FUTIL
- DIMENSION GS(MNI), STEP(MNI), XXS(MNI), FLNU(MNI), VG(MNI)
- LOGICAL LDEBUG
- PARAMETER (TOLER=0.05)
- IF (NPAR .LE. 0) RETURN
- IF (AMIN .EQ. UNDEFI) CALL MNAMIN(FCN,FUTIL)
- LDEBUG = (IDBG(4) .GE. 1)
- CFROM = 'MIGRAD '
- NFCNFR = NFCN
- NFCNMG = NFCN
- CSTATU= 'INITIATE '
- ISWTR = ISW(5) - 2*ITAUR
- NPFN = NFCN
- NPARX = NPAR
- LENV = NPAR*(NPAR+1)/2
- NRSTRT = 0
- NPSDF = 0
- LINED2 = 0
- ISW(4) = -1
- RHOTOL = 1.0E-3*APSI
- IF (ISWTR .GE. 1) WRITE (ISYSWR,470) ISTRAT,RHOTOL
- 470 FORMAT (' START MIGRAD MINIMIZATION. STRATEGY',I2,
- +'. CONVERGENCE WHEN EDM .LT.',E9.2)
-C initialization strategy
- IF (ISTRAT.LT.2 .OR. ISW(2).GE.3) GO TO 2
-C come (back) here to restart completely
- 1 CONTINUE
- IF (NRSTRT .GT. ISTRAT) THEN
- CSTATU= 'FAILED '
- ISW(4) = -1
- GO TO 230
- ENDIF
-C . get full covariance and gradient
- CALL MNHESS(FCN,FUTIL)
- CALL MNWERR
- NPSDF = 0
- IF (ISW(2) .GE. 1) GO TO 10
-C . get gradient at start point
- 2 CONTINUE
- CALL MNINEX(X)
- IF (ISW(3) .EQ. 1) THEN
- CALL FCN(NPARX,GIN,FZERO,U,2,FUTIL)
- NFCN = NFCN + 1
- ENDIF
- CALL MNDERI(FCN,FUTIL)
- IF (ISW(2) .GE. 1) GO TO 10
-C sometimes start with diagonal matrix
- DO 3 I= 1, NPAR
- XXS(I) = X(I)
- STEP(I) = ZERO
- 3 CONTINUE
-C do line search if second derivative negative
- LINED2 = LINED2 + 1
- IF (LINED2 .LT. (ISTRAT+1)*NPAR) THEN
- DO 5 I= 1, NPAR
- IF (G2(I) .GT. ZERO) GO TO 5
- STEP(I) = -SIGN(GSTEP(I),GRD(I))
- GDEL = STEP(I)*GRD(I)
- FS = AMIN
- CALL MNLINE(FCN,XXS,FS,STEP,GDEL,TOLER,FUTIL)
- CALL MNWARN('D','MNMIGR','Negative G2 line search')
- IEXT = NEXOFI(I)
- IF (LDEBUG) WRITE (ISYSWR,'(A,I3,2G13.3)')
- + ' Negative G2 line search, param ',IEXT,FS,AMIN
- GO TO 2
- 5 CONTINUE
- ENDIF
-C make diagonal error matrix
- DO 8 I=1,NPAR
- NDEX = I*(I-1)/2
- DO 7 J=1,I-1
- NDEX = NDEX + 1
- 7 VHMAT(NDEX) = 0.
- NDEX = NDEX + 1
- IF (G2(I) .LE. ZERO) G2(I) = 1.
- VHMAT(NDEX) = 2./G2(I)
- 8 CONTINUE
- DCOVAR = 1.
- IF (LDEBUG) WRITE (ISYSWR,'(A,A/(1X,10G10.2))') ' DEBUG MNMIGR,',
- + ' STARTING MATRIX DIAGONAL, VHMAT=', (VHMAT(KK),KK=1,LENV)
-C ready to start first iteration
- 10 CONTINUE
- NRSTRT = NRSTRT + 1
- IF (NRSTRT .GT. ISTRAT+1) THEN
- CSTATU= 'FAILED '
- GO TO 230
- ENDIF
- FS = AMIN
-C . . . get EDM and set up loop
- EDM = 0.
- DO 18 I= 1, NPAR
- GS(I) = GRD(I)
- XXS(I) = X(I)
- NDEX = I*(I-1)/2
- DO 17 J= 1, I-1
- NDEX = NDEX + 1
- 17 EDM = EDM + GS(I)*VHMAT(NDEX)*GS(J)
- NDEX = NDEX + 1
- 18 EDM = EDM + 0.5 * GS(I)**2 *VHMAT(NDEX)
- EDM = EDM * 0.5 * (1.0+3.0*DCOVAR)
- IF (EDM .LT. ZERO) THEN
- CALL MNWARN('W','MIGRAD','STARTING MATRIX NOT POS-DEFINITE.')
- ISW(2) = 0
- DCOVAR = 1.
- GO TO 2
- ENDIF
- IF (ISW(2) .EQ. 0) EDM=BIGEDM
- ITER = 0
- CALL MNINEX(X)
- CALL MNWERR
- IF (ISWTR .GE. 1) CALL MNPRIN(3,AMIN)
- IF (ISWTR .GE. 2) CALL MNMATU(0)
-C . . . . . start main loop
- 24 CONTINUE
- IF (NFCN-NPFN .GE. NFCNMX) GO TO 190
- GDEL = 0.
- GSSQ = 0.
- DO 30 I=1,NPAR
- RI = 0.
- GSSQ = GSSQ + GS(I)**2
- DO 25 J=1,NPAR
- M = MAX(I,J)
- N = MIN(I,J)
- NDEX = M*(M-1)/2 + N
- 25 RI = RI + VHMAT(NDEX) *GS(J)
- STEP(I) = -0.5*RI
- 30 GDEL = GDEL + STEP(I)*GS(I)
- IF (GSSQ .EQ. ZERO) THEN
- CALL MNWARN('D','MIGRAD',
- + ' FIRST DERIVATIVES OF FCN ARE ALL ZERO')
- GO TO 300
- ENDIF
-C if gdel positive, V not posdef
- IF (GDEL .GE. ZERO) THEN
- CALL MNWARN('D','MIGRAD',' NEWTON STEP NOT DESCENT.')
- IF (NPSDF .EQ. 1) GO TO 1
- CALL MNPSDF
- NPSDF = 1
- GO TO 24
- ENDIF
-C . . . . do line search
- CALL MNLINE(FCN,XXS,FS,STEP,GDEL,TOLER,FUTIL)
- IF (AMIN .EQ. FS) GO TO 200
- CFROM = 'MIGRAD '
- NFCNFR = NFCNMG
- CSTATU= 'PROGRESS '
-C . get gradient at new point
- CALL MNINEX(X)
- IF (ISW(3) .EQ. 1) THEN
- CALL FCN(NPARX,GIN,FZERO,U,2,FUTIL)
- NFCN = NFCN + 1
- ENDIF
- CALL MNDERI(FCN,FUTIL)
-C . calculate new EDM
- NPSDF = 0
- 81 EDM = 0.
- GVG = 0.
- DELGAM = 0.
- GDGSSQ = 0.
- DO 100 I= 1, NPAR
- RI = 0.
- VGI = 0.
- DO 90 J= 1, NPAR
- M = MAX(I,J)
- N = MIN(I,J)
- NDEX = M*(M-1)/2 + N
- VGI = VGI + VHMAT(NDEX)*(GRD(J)-GS(J))
- 90 RI = RI + VHMAT(NDEX)* GRD(J)
- VG(I) = VGI*0.5
- GAMI = GRD(I) - GS(I)
- GDGSSQ = GDGSSQ + GAMI**2
- GVG = GVG + GAMI*VG(I)
- DELGAM = DELGAM + DIRIN(I)*GAMI
- 100 EDM = EDM + GRD(I)*RI*0.5
- EDM = EDM * 0.5 * (1.0 + 3.0*DCOVAR)
-C . if EDM negative, not positive-definite
- IF (EDM .LT. ZERO .OR. GVG .LE. ZERO) THEN
- CALL MNWARN('D','MIGRAD','NOT POS-DEF. EDM OR GVG NEGATIVE.')
- CSTATU = 'NOT POSDEF'
- IF (NPSDF .EQ. 1) GO TO 230
- CALL MNPSDF
- NPSDF = 1
- GO TO 81
- ENDIF
-C print information about this iteration
- ITER = ITER + 1
- IF (ISWTR.GE.3 .OR. (ISWTR.EQ.2.AND.MOD(ITER,10).EQ.1)) THEN
- CALL MNWERR
- CALL MNPRIN(3,AMIN)
- ENDIF
- IF (GDGSSQ .EQ. ZERO) CALL MNWARN('D','MIGRAD',
- + 'NO CHANGE IN FIRST DERIVATIVES OVER LAST STEP')
- IF (DELGAM .LT. ZERO) CALL MNWARN('D','MIGRAD',
- + 'FIRST DERIVATIVES INCREASING ALONG SEARCH LINE')
-C . update covariance matrix
- CSTATU = 'IMPROVEMNT'
- IF (LDEBUG) WRITE (ISYSWR,'(A,(1X,10G10.3))') ' VHMAT 1 =',
- + (VHMAT(KK),KK=1,10)
- DSUM = 0.
- VSUM = 0.
- DO 120 I=1, NPAR
- DO 120 J=1, I
- D = DIRIN(I)*DIRIN(J)/DELGAM - VG(I)*VG(J)/GVG
- DSUM = DSUM + ABS(D)
- NDEX = I*(I-1)/2 + J
- VHMAT(NDEX) = VHMAT(NDEX) + 2.0*D
- VSUM = VSUM + ABS(VHMAT(NDEX))
- 120 CONTINUE
-C smooth local fluctuations by averaging DCOVAR
- DCOVAR = 0.5*(DCOVAR + DSUM/VSUM)
- IF (ISWTR.GE.3 .OR. LDEBUG) WRITE (ISYSWR,'(A,F5.1,A)')
- + ' RELATIVE CHANGE IN COV. MATRIX=',DCOVAR*100.,'%'
- IF (LDEBUG) WRITE (ISYSWR,'(A,(1X,10G10.3))') ' VHMAT 2 =',
- + (VHMAT(KK),KK=1,10)
- IF (DELGAM .LE. GVG) GO TO 135
- DO 125 I= 1, NPAR
- 125 FLNU(I) = DIRIN(I)/DELGAM - VG(I)/GVG
- DO 130 I= 1, NPAR
- DO 130 J= 1, I
- NDEX = I*(I-1)/2 + J
- 130 VHMAT(NDEX) = VHMAT(NDEX) + 2.0*GVG*FLNU(I)*FLNU(J)
- 135 CONTINUE
-C and see if converged
- IF (EDM .LT. 0.1*RHOTOL) GO TO 300
-C if not, prepare next iteration
- DO 140 I= 1, NPAR
- XXS(I) = X(I)
- GS(I) = GRD(I)
- 140 CONTINUE
- FS = AMIN
- IF (ISW(2) .EQ. 0 .AND. DCOVAR.LT. 0.5 ) ISW(2) = 1
- IF (ISW(2) .EQ. 3 .AND. DCOVAR.GT. 0.1 ) ISW(2) = 1
- IF (ISW(2) .EQ. 1 .AND. DCOVAR.LT. 0.05) ISW(2) = 3
- GO TO 24
-C . . . . . end main loop
-C . . call limit in MNMIGR
- 190 ISW(1) = 1
- IF (ISW(5) .GE. 0)
- + WRITE (ISYSWR,'(A)') ' CALL LIMIT EXCEEDED IN MIGRAD.'
- CSTATU = 'CALL LIMIT'
- GO TO 230
-C . . fails to improve . .
- 200 IF (ISWTR .GE. 1) WRITE (ISYSWR,'(A)')
- + ' MIGRAD FAILS TO FIND IMPROVEMENT'
- DO 210 I= 1, NPAR
- 210 X(I) = XXS(I)
- IF (EDM .LT. RHOTOL) GO TO 300
- IF (EDM .LT. ABS(EPSMA2*AMIN)) THEN
- IF (ISWTR .GE. 0) WRITE (ISYSWR, '(A)')
- + ' MACHINE ACCURACY LIMITS FURTHER IMPROVEMENT.'
- GO TO 300
- ENDIF
- IF (ISTRAT .LT. 1) THEN
- IF (ISW(5) .GE. 0) WRITE (ISYSWR, '(A)')
- + ' MIGRAD FAILS WITH STRATEGY=0. WILL TRY WITH STRATEGY=1.'
- ISTRAT = 1
- ENDIF
- GO TO 1
-C . . fails to converge
- 230 IF (ISWTR .GE. 0) WRITE (ISYSWR,'(A)')
- + ' MIGRAD TERMINATED WITHOUT CONVERGENCE.'
- IF (ISW(2) .EQ. 3) ISW(2) = 1
- ISW(4) = -1
- GO TO 400
-C . . apparent convergence
- 300 IF (ISWTR .GE. 0) WRITE(ISYSWR,'(/A)')
- + ' MIGRAD MINIMIZATION HAS CONVERGED.'
- IF (ITAUR .EQ. 0) THEN
- IF (ISTRAT .GE. 2 .OR. (ISTRAT.EQ.1.AND.ISW(2).LT.3)) THEN
- IF (ISW(5) .GE. 0) WRITE (ISYSWR, '(/A)')
- + ' MIGRAD WILL VERIFY CONVERGENCE AND ERROR MATRIX.'
- CALL MNHESS(FCN,FUTIL)
- CALL MNWERR
- NPSDF = 0
- IF (EDM .GT. RHOTOL) GO TO 10
- ENDIF
- ENDIF
- CSTATU='CONVERGED '
- ISW(4) = 1
-C come here in any case
- 400 CONTINUE
- CFROM = 'MIGRAD '
- NFCNFR = NFCNMG
- CALL MNINEX(X)
- CALL MNWERR
- IF (ISWTR .GE. 0) CALL MNPRIN (3,AMIN)
- IF (ISWTR .GE. 1) CALL MNMATU(1)
- RETURN
- END
diff --git a/src/packlib/minuit/code/mnmnos.F b/src/packlib/minuit/code/mnmnos.F
deleted file mode 100644
index b850d3a..0000000
--- a/src/packlib/minuit/code/mnmnos.F
+++ /dev/null
@@ -1,80 +0,0 @@
-*
-* $Id: mnmnos.F,v 1.1.1.1 1996/03/07 14:31:30 mclareni Exp $
-*
-* $Log: mnmnos.F,v $
-* Revision 1.1.1.1 1996/03/07 14:31:30 mclareni
-* Minuit
-*
-*
-#include "minuit/pilot.h"
- SUBROUTINE MNMNOS(FCN,FUTIL)
-#include "minuit/d506dp.inc"
-CC Performs a MINOS error analysis on those parameters for
-CC which it is requested on the MINOS command by calling
-CC MNMNOT for each parameter requested.
-#include "minuit/d506cm.inc"
- EXTERNAL FCN,FUTIL
- IF (NPAR .LE. 0) GO TO 700
- NGOOD = 0
- NBAD = 0
- NFCNMI = NFCN
-C . loop over parameters requested
- DO 570 KNT= 1, NPAR
- IF (INT(WORD7(2)) .EQ. 0) THEN
- ILAX = NEXOFI(KNT)
- ELSE
- IF (KNT .GE. 7) GO TO 580
- ILAX = INT(WORD7(KNT+1))
- IF (ILAX .EQ. 0) GO TO 580
- IF (ILAX .GT. 0 .AND. ILAX .LE. NU) THEN
- IF (NIOFEX(ILAX) .GT. 0) GO TO 565
- ENDIF
- WRITE (ISYSWR,564) ILAX
- 564 FORMAT (' PARAMETER NUMBER ',I5,' NOT VARIABLE. IGNORED.')
- GO TO 570
- ENDIF
- 565 CONTINUE
-C calculate one pair of M E's
- ILAX2 = 0
- CALL MNMNOT(FCN,ILAX,ILAX2,VAL2PL,VAL2MI,FUTIL)
- IF (LNEWMN) GO TO 650
-C update NGOOD and NBAD
- IIN = NIOFEX(ILAX)
- IF (ERP(IIN) .GT. ZERO) THEN
- NGOOD=NGOOD+1
- ELSE
- NBAD=NBAD+1
- ENDIF
- IF (ERN(IIN) .LT. ZERO) THEN
- NGOOD=NGOOD+1
- ELSE
- NBAD=NBAD+1
- ENDIF
- 570 CONTINUE
-C end of loop . . . . . . .
- 580 CONTINUE
-C . . . . printout final values .
- CFROM = 'MINOS '
- NFCNFR = NFCNMI
- CSTATU= 'UNCHANGED '
- IF (NGOOD.EQ.0.AND.NBAD.EQ.0) GO TO 700
- IF (NGOOD.GT.0.AND.NBAD.EQ.0) CSTATU='SUCCESSFUL'
- IF (NGOOD.EQ.0.AND.NBAD.GT.0) CSTATU='FAILURE '
- IF (NGOOD.GT.0.AND.NBAD.GT.0) CSTATU='PROBLEMS '
- IF (ISW(5) .GE. 0) CALL MNPRIN(4,AMIN)
- IF (ISW(5) .GE. 2) CALL MNMATU(0)
- GO TO 900
-C . . . new minimum found . . . .
- 650 CONTINUE
- CFROM = 'MINOS '
- NFCNFR = NFCNMI
- CSTATU= 'NEW MINIMU'
- IF (ISW(5) .GE. 0) CALL MNPRIN(4,AMIN)
- WRITE (ISYSWR,675)
- 675 FORMAT(/50H NEW MINIMUM FOUND. GO BACK TO MINIMIZATION STEP./1H ,
- +60(1H=)/60X,1HV/60X,1HV/60X,1HV/57X,7HVVVVVVV/58X,5HVVVVV/59X,
- +3HVVV/60X,1HV//)
- GO TO 900
- 700 WRITE (ISYSWR,'(A)') ' THERE ARE NO MINOS ERRORS TO CALCULATE.'
- 900 RETURN
- END
diff --git a/src/packlib/minuit/code/mnmnot.F b/src/packlib/minuit/code/mnmnot.F
deleted file mode 100644
index 9f0c6ad..0000000
--- a/src/packlib/minuit/code/mnmnot.F
+++ /dev/null
@@ -1,173 +0,0 @@
-*
-* $Id: mnmnot.F,v 1.1.1.1 1996/03/07 14:31:30 mclareni Exp $
-*
-* $Log: mnmnot.F,v $
-* Revision 1.1.1.1 1996/03/07 14:31:30 mclareni
-* Minuit
-*
-*
-#include "minuit/pilot.h"
- SUBROUTINE MNMNOT(FCN,ILAX,ILAX2,VAL2PL,VAL2MI,FUTIL)
-#include "minuit/d506dp.inc"
-CC Performs a MINOS error analysis on one parameter.
-CC The parameter ILAX is varied, and the minimum of the
-CC function with respect to the other parameters is followed
-CC until it crosses the value FMIN+UP.
-CC
-#include "minuit/d506cm.inc"
- EXTERNAL FCN,FUTIL
- DIMENSION XDEV(MNI),W(MNI),GCC(MNI)
- CHARACTER*4 CPOS,CNEG,CSIG
- PARAMETER (CPOS='POSI',CNEG='NEGA')
-C . . save and prepare start vals
- ISW2 = ISW(2)
- ISW4 = ISW(4)
- SIGSAV = EDM
- ISTRAV = ISTRAT
- DC = DCOVAR
- LNEWMN = .FALSE.
- APSI = EPSI*0.5
- ABEST=AMIN
- MPAR=NPAR
- NFMXIN = NFCNMX
- DO 125 I= 1, MPAR
- 125 XT(I) = X(I)
- DO 130 J= 1, MPAR*(MPAR+1)/2
- 130 VTHMAT(J) = VHMAT(J)
- DO 135 I= 1, MPAR
- GCC(I) = GLOBCC(I)
- 135 W(I) = WERR(I)
- IT = NIOFEX(ILAX)
- ERP(IT) = 0.
- ERN(IT) = 0.
- CALL MNINEX(XT)
- UT = U(ILAX)
- IF (NVARL(ILAX) .EQ. 1) THEN
- ALIM(ILAX) = UT -100.*W(IT)
- BLIM(ILAX) = UT +100.*W(IT)
- ENDIF
- NDEX = IT*(IT+1)/2
- XUNIT = SQRT(UP/VTHMAT(NDEX))
- MARC = 0
- DO 162 I= 1, MPAR
- IF (I .EQ. IT) GO TO 162
- MARC = MARC + 1
- IMAX = MAX(IT,I)
- INDX = IMAX*(IMAX-1)/2 + MIN(IT,I)
- XDEV(MARC) = XUNIT*VTHMAT(INDX)
- 162 CONTINUE
-C fix the parameter in question
- CALL MNFIXP (IT,IERR)
- IF (IERR .GT. 0) THEN
- WRITE (ISYSWR,'(A,I5,A,I5)')
- + ' MINUIT ERROR. CANNOT FIX PARAMETER',ILAX,' INTERNAL',IT
- GO TO 700
- ENDIF
-C . . . . . Nota Bene: from here on, NPAR=MPAR-1
-C Remember: MNFIXP squeezes IT out of X, XT, WERR, and VHMAT,
-C not W, VTHMAT
- DO 500 ISIG= 1,2
- IF (ISIG .EQ. 1) THEN
- SIG = 1.0
- CSIG = CPOS
- ELSE
- SIG = -1.0
- CSIG = CNEG
- ENDIF
-C . sig=sign of error being calcd
- IF (ISW(5) .GT. 1) WRITE (ISYSWR,806) CSIG,ILAX,CPNAM(ILAX)
- 806 FORMAT (/' DETERMINATION OF ',A4,'TIVE MINOS ERROR FOR PARAMETER',
- + I3, 2X ,A)
- IF (ISW(2).LE.0) CALL MNWARN('D','MINOS','NO COVARIANCE MATRIX.')
- NLIMIT = NFCN + NFMXIN
- ISTRAT = MAX(ISTRAV-1,0)
- DU1 = W(IT)
- U(ILAX) = UT + SIG*DU1
- U(ILAX) = MIN(U(ILAX),BLIM(ILAX))
- U(ILAX) = MAX(U(ILAX),ALIM(ILAX))
- DELU = U(ILAX) - UT
-C stop if already at limit with negligible step size
- IF (ABS(DELU)/(ABS(UT)+ABS(U(ILAX))) .LT. EPSMAC) GO TO 440
- FAC = DELU/W(IT)
- DO 185 I= 1, NPAR
- 185 X(I) = XT(I) + FAC*XDEV(I)
- IF (ISW(5) .GT. 1) WRITE (ISYSWR,801) ILAX,UT,DELU,U(ILAX)
- 801 FORMAT (/' PARAMETER',I4,' SET TO',E11.3,' + ',E10.3,' = ',E12.3)
-C loop to hit AMIN+UP
- KE1CR = ILAX
- KE2CR = 0
- XMIDCR = U(ILAX)
- XDIRCR = DELU
-C
- AMIN = ABEST
- NFCNMX = NLIMIT - NFCN
- CALL MNCROS(FCN,AOPT,IERCR,FUTIL)
- IF (ABEST-AMIN .GT. 0.01*UP) GO TO 650
- IF (IERCR .EQ. 1) GO TO 440
- IF (IERCR .EQ. 2) GO TO 450
- IF (IERCR .EQ. 3) GO TO 460
-C . error successfully calculated
- EROS = XMIDCR-UT + AOPT*XDIRCR
- IF (ISW(5) .GT. 1) WRITE (ISYSWR,808) CSIG,ILAX,CPNAM(ILAX),EROS
- 808 FORMAT (/9X,4HTHE ,A4, 29HTIVE MINOS ERROR OF PARAMETER,I3, 2H
- +, ,A10, 4H, IS ,E12.4)
- GO TO 480
-C . . . . . . . . failure returns
- 440 IF (ISW(5) .GE. 1) WRITE(ISYSWR,807) CSIG,ILAX,CPNAM(ILAX)
- 807 FORMAT (5X,'THE ',A4,'TIVE MINOS ERROR OF PARAMETER',I3,', ',A,
- +', EXCEEDS ITS LIMIT.'/)
- EROS = UNDEFI
- GO TO 480
- 450 IF (ISW(5) .GE. 1) WRITE (ISYSWR, 802) CSIG,ILAX,NFMXIN
- 802 FORMAT (9X,'THE ',A,'TIVE MINOS ERROR',I4,' REQUIRES MORE THAN',
- + I5,' FUNCTION CALLS.'/)
- EROS = 0.
- GO TO 480
- 460 IF (ISW(5) .GE. 1) WRITE (ISYSWR, 805) CSIG,ILAX
- 805 FORMAT (25X,A,'TIVE MINOS ERROR NOT CALCULATED FOR PARAMETER',I4/)
- EROS = 0.
-C
- 480 IF (ISW(5) .GT. 1) WRITE (ISYSWR,'(5X, 74(1H*))')
- IF (SIG .LT. ZERO) THEN
- ERN(IT) = EROS
- IF (ILAX2.GT.0 .AND. ILAX2.LE.NU) VAL2MI = U(ILAX2)
- ELSE
- ERP(IT) = EROS
- IF (ILAX2.GT.0 .AND. ILAX2.LE.NU) VAL2PL = U(ILAX2)
- ENDIF
- 500 CONTINUE
-C . . parameter finished. reset v
-C normal termination
- ITAUR = 1
- CALL MNFREE(1)
- DO 550 J= 1, MPAR*(MPAR+1)/2
- 550 VHMAT(J) = VTHMAT(J)
- DO 595 I= 1, MPAR
- WERR(I) = W(I)
- GLOBCC(I) = GCC(I)
- 595 X(I) = XT(I)
- CALL MNINEX (X)
- EDM = SIGSAV
- AMIN = ABEST
- ISW(2) = ISW2
- ISW(4) = ISW4
- DCOVAR = DC
- GO TO 700
-C new minimum
- 650 LNEWMN = .TRUE.
- ISW(2) = 0
- DCOVAR = 1.
- ISW(4) = 0
- SAV = U(ILAX)
- ITAUR = 1
- CALL MNFREE(1)
- U(ILAX) = SAV
- CALL MNEXIN(X)
- EDM = BIGEDM
-C in any case
- 700 CONTINUE
- ITAUR = 0
- NFCNMX = NFMXIN
- ISTRAT = ISTRAV
- RETURN
- END
diff --git a/src/packlib/minuit/code/mnparm.F b/src/packlib/minuit/code/mnparm.F
deleted file mode 100644
index 42ee370..0000000
--- a/src/packlib/minuit/code/mnparm.F
+++ /dev/null
@@ -1,220 +0,0 @@
-*
-* $Id: mnparm.F,v 1.2 1996/03/15 18:02:50 james Exp $
-*
-* $Log: mnparm.F,v $
-* Revision 1.2 1996/03/15 18:02:50 james
-* Modified Files:
-* mnderi.F eliminate possible division by zero
-* mnexcm.F suppress print on STOP when print flag=-1
-* set FVAL3 to flag if FCN already called with IFLAG=3
-* mninit.F set version 96.03
-* mnlims.F remove arguments, not needed
-* mnmigr.F VLEN -> LENV in debug print statement
-* mnparm.F move call to MNRSET to after NPAR redefined, to zero all
-* mnpsdf.F eliminate possible division by zero
-* mnscan.F suppress printout when print flag =-1
-* mnset.F remove arguments in call to MNLIMS
-* mnsimp.F fix CSTATU so status is PROGRESS only if new minimum
-* mnvert.F eliminate possible division by zero
-*
-* Revision 1.1.1.1 1996/03/07 14:31:31 mclareni
-* Minuit
-*
-*
-#include "minuit/pilot.h"
- SUBROUTINE MNPARM(K,CNAMJ,UK,WK,A,B,IERFLG)
-#include "minuit/d506dp.inc"
-CC Called from MNPARS and user-callable
-CC Implements one parameter definition, that is:
-CC K (external) parameter number
-CC CNAMK parameter name
-CC UK starting value
-CC WK starting step size or uncertainty
-CC A, B lower and upper physical parameter limits
-CC and sets up (updates) the parameter lists.
-CC Output: IERFLG=0 if no problems
-CC >0 if MNPARM unable to implement definition
-CC
-#include "minuit/d506cm.inc"
- CHARACTER*(*) CNAMJ
- CHARACTER CNAMK*10, CHBUFI*4
-C
- CNAMK = CNAMJ
- KINT = NPAR
- IF (K.LT.1 .OR. K.GT.MAXEXT) THEN
-C parameter number exceeds allowed maximum value
- WRITE (ISYSWR,9) K,MAXEXT
- 9 FORMAT (/' MINUIT USER ERROR. PARAMETER NUMBER IS',I11/
- + ', ALLOWED RANGE IS ONE TO',I4/)
- GO TO 800
- ENDIF
-C normal parameter request
- KTOFIX = 0
- IF (NVARL(K) .LT. 0) GO TO 50
-C previously defined parameter is being redefined
-C find if parameter was fixed
- DO 40 IX= 1, NPFIX
- IF (IPFIX(IX) .EQ. K) KTOFIX = K
- 40 CONTINUE
- IF (KTOFIX .GT. 0) THEN
- CALL MNWARN('W','PARAM DEF','REDEFINING A FIXED PARAMETER.')
- IF (KINT .GE. MAXINT) THEN
- WRITE (ISYSWR,'(A)') ' CANNOT RELEASE. MAX NPAR EXCEEDED.'
- GO TO 800
- ENDIF
- CALL MNFREE(-K)
- ENDIF
-C if redefining previously variable parameter
- IF(NIOFEX(K) .GT. 0) KINT = NPAR-1
- 50 CONTINUE
-C
-C . . .print heading
- IF (LPHEAD .AND. ISW(5).GE.0) THEN
- WRITE (ISYSWR,61)
- LPHEAD = .FALSE.
- ENDIF
- 61 FORMAT(/' PARAMETER DEFINITIONS:'/
- + ' NO. NAME VALUE STEP SIZE LIMITS')
- IF (WK .GT. ZERO) GO TO 122
-C . . .constant parameter . . . .
- IF (ISW(5) .GE. 0) WRITE (ISYSWR, 82) K,CNAMK,UK
- 82 FORMAT (1X,I5,1X,1H',A10,1H',1X,G13.5, ' constant')
- NVL = 0
- GO TO 200
- 122 IF (A.EQ.ZERO .AND. B.EQ.ZERO) THEN
-C variable parameter without limits
- NVL = 1
- IF (ISW(5) .GE. 0) WRITE (ISYSWR, 127) K,CNAMK,UK,WK
- 127 FORMAT (1X,I5,1X,1H',A10,1H',1X,2G13.5, ' no limits')
- ELSE
-C variable parameter with limits
- NVL = 4
- LNOLIM = .FALSE.
- IF (ISW(5) .GE. 0) WRITE (ISYSWR, 132) K,CNAMK,UK,WK,A,B
- 132 FORMAT(1X,I5,1X,1H',A10,1H',1X,2G13.5,2X,2G13.5)
- ENDIF
-C . . request for another variable parameter
- KINT = KINT + 1
- IF (KINT .GT. MAXINT) THEN
- WRITE (ISYSWR,135) MAXINT
- 135 FORMAT (/' MINUIT USER ERROR. TOO MANY VARIABLE PARAMETERS.'/
- + ' THIS VERSION OF MINUIT DIMENSIONED FOR',I4//)
- GO TO 800
- ENDIF
- IF (NVL .EQ. 1) GO TO 200
- IF (A .EQ. B) THEN
- WRITE (ISYSWR,'(/A,A/A/)') ' USER ERROR IN MINUIT PARAMETER',
- + ' DEFINITION',' UPPER AND LOWER LIMITS EQUAL.'
- GO TO 800
- ENDIF
- IF (B .LT. A) THEN
- SAV = B
- B = A
- A = SAV
- CALL MNWARN('W','PARAM DEF','PARAMETER LIMITS WERE REVERSED.')
- IF (LWARN) LPHEAD=.TRUE.
- ENDIF
- IF ((B-A) .GT. 1.0E7) THEN
- WRITE (CHBUFI,'(I4)') K
- CALL MNWARN('W','PARAM DEF',
- + 'LIMITS ON PARAM'//CHBUFI//' TOO FAR APART.')
- IF (LWARN) LPHEAD=.TRUE.
- ENDIF
- DANGER = (B-UK)*(UK-A)
- IF (DANGER .LT. 0.)
- + CALL MNWARN('W','PARAM DEF','STARTING VALUE OUTSIDE LIMITS.')
- IF (DANGER .EQ. 0.)
- + CALL MNWARN('W','PARAM DEF','STARTING VALUE IS AT LIMIT.')
- 200 CONTINUE
-C . . . input OK, set values, arrange lists,
-C calculate step sizes GSTEP, DIRIN
- CFROM = 'PARAMETR'
- NFCNFR = NFCN
- CSTATU= 'NEW VALUES'
- NU = MAX(NU,K)
- CPNAM(K) = CNAMK
- U(K) = UK
- ALIM(K) = A
- BLIM(K) = B
- NVARL(K) = NVL
-C K is external number of new parameter
-C LASTIN is the number of var. params with ext. param. no.< K
- LASTIN = 0
- DO 240 IX= 1, K-1
- IF (NIOFEX(IX) .GT. 0) LASTIN=LASTIN+1
- 240 CONTINUE
-C KINT is new number of variable params, NPAR is old
- IF (KINT .EQ. NPAR) GO TO 280
- IF (KINT .GT. NPAR) THEN
-C insert new variable parameter in list
- DO 260 IN= NPAR,LASTIN+1,-1
- IX = NEXOFI(IN)
- NIOFEX(IX) = IN+1
- NEXOFI(IN+1)= IX
- X (IN+1) = X (IN)
- XT (IN+1) = XT (IN)
- DIRIN(IN+1) = DIRIN(IN)
- G2 (IN+1) = G2 (IN)
- GSTEP(IN+1) = GSTEP(IN)
- 260 CONTINUE
- ELSE
-C remove variable parameter from list
- DO 270 IN= LASTIN+1,KINT
- IX = NEXOFI(IN+1)
- NIOFEX(IX) = IN
- NEXOFI(IN)= IX
- X (IN)= X (IN+1)
- XT (IN)= XT (IN+1)
- DIRIN (IN)= DIRIN(IN+1)
- G2 (IN)= G2 (IN+1)
- GSTEP (IN)= GSTEP(IN+1)
- 270 CONTINUE
- ENDIF
- 280 CONTINUE
- IX = K
- NIOFEX(IX) = 0
- NPAR = KINT
- CALL MNRSET(1)
-C lists are now arranged . . . .
- IF (NVL .GT. 0) THEN
- IN = LASTIN+1
- NEXOFI(IN) = IX
- NIOFEX(IX) = IN
- SAV = U(IX)
- CALL MNPINT(SAV,IX,PINTI)
- X(IN) = PINTI
- XT(IN) = X(IN)
- WERR(IN) = WK
- SAV2 = SAV + WK
- CALL MNPINT(SAV2,IX,PINTI)
- VPLU = PINTI - X(IN)
- SAV2 = SAV - WK
- CALL MNPINT(SAV2,IX,PINTI)
- VMINU = PINTI - X(IN)
- DIRIN(IN) = 0.5 * (ABS(VPLU) +ABS(VMINU))
- G2(IN) = 2.0*UP / DIRIN(IN)**2
- GSMIN = 8.*EPSMA2*ABS(X(IN))
- GSTEP(IN) = MAX (GSMIN, 0.1*DIRIN(IN))
- IF (AMIN .NE. UNDEFI) THEN
- SMALL = SQRT(EPSMA2*(AMIN+UP)/UP)
- GSTEP(IN) = MAX(GSMIN, SMALL*DIRIN(IN))
- ENDIF
- GRD (IN) = G2(IN)*DIRIN(IN)
-C if parameter has limits
- IF (NVARL(K) .GT. 1) THEN
- IF (GSTEP(IN).GT. 0.5) GSTEP(IN)=0.5
- GSTEP(IN) = -GSTEP(IN)
- ENDIF
- ENDIF
- IF (KTOFIX .GT. 0) THEN
- KINFIX = NIOFEX(KTOFIX)
- IF (KINFIX .GT. 0) CALL MNFIXP(KINFIX,IERR)
- IF (IERR .GT. 0) GO TO 800
- ENDIF
- IERFLG = 0
- RETURN
-C error on input, unable to implement request . . . .
- 800 CONTINUE
- IERFLG = 1
- RETURN
- END
diff --git a/src/packlib/minuit/code/mnpars.F b/src/packlib/minuit/code/mnpars.F
deleted file mode 100644
index 40da082..0000000
--- a/src/packlib/minuit/code/mnpars.F
+++ /dev/null
@@ -1,90 +0,0 @@
-*
-* $Id: mnpars.F,v 1.1.1.1 1996/03/07 14:31:31 mclareni Exp $
-*
-* $Log: mnpars.F,v $
-* Revision 1.1.1.1 1996/03/07 14:31:31 mclareni
-* Minuit
-*
-*
-#include "minuit/pilot.h"
- SUBROUTINE MNPARS(CRDBUF,ICONDN)
-#include "minuit/d506dp.inc"
-CC Called from MNREAD and user-callable
-CC Implements one parameter definition, that is:
-CC parses the string CRDBUF and calls MNPARM
-C
-C output conditions:
-C ICONDN = 0 all OK
-C ICONDN = 1 error, attempt to define parameter is ignored
-C ICONDN = 2 end of parameter definitions
-C
-#include "minuit/d506cm.inc"
-C
- DIMENSION PLIST(MAXP)
- CHARACTER CNAMK*10, CRDBUF*(*) , CELMNT*20 , COMAND*(MAXCWD)
-C
- LENBUF = LEN(CRDBUF)
-C find out whether fixed or free-field format
- KAPO1 = INDEX(CRDBUF,'''')
- IF (KAPO1 .EQ. 0) GO TO 150
- KAPO2 = INDEX(CRDBUF(KAPO1+1:),'''')
- IF (KAPO2 .EQ. 0) GO TO 150
-C new (free-field) format
- KAPO2 = KAPO2 + KAPO1
-C skip leading blanks if any
- DO 115 ISTART=1, KAPO1-1
- IF (CRDBUF(ISTART:ISTART) .NE. ' ') GO TO 120
- 115 CONTINUE
- GO TO 210
- 120 CONTINUE
-C parameter number integer
- CELMNT = CRDBUF(ISTART:KAPO1-1)
- READ (CELMNT,'(BN,F20.0)',ERR=180) FK
- K = FK
- IF (K .LE. 0) GO TO 210
- CNAMK = 'PARAM '//CELMNT
- IF (KAPO2-KAPO1 .GT. 1) CNAMK = CRDBUF(KAPO1+1:KAPO2-1)
-C special handling if comma or blanks and a comma follow 'name'
- DO 135 ICY= KAPO2+1,LENBUF
- IF (CRDBUF(ICY:ICY) .EQ. ',') GO TO 139
- IF (CRDBUF(ICY:ICY) .NE. ' ') GO TO 140
- 135 CONTINUE
- UK = 0.
- WK = 0.
- A = 0.
- B = 0.
- GO TO 170
- 139 CONTINUE
- ICY = ICY+1
- 140 CONTINUE
- IBEGIN = ICY
- CALL MNCRCK(CRDBUF(IBEGIN:),MAXCWD,COMAND,LNC,
- + MAXP,PLIST,LLIST, IERR,ISYSWR)
- IF (IERR .GT. 0) GO TO 180
- UK = PLIST(1)
- WK = 0.
- IF (LLIST .GE. 2) WK = PLIST(2)
- A = 0.
- IF (LLIST .GE. 3) A = PLIST(3)
- B = 0.
- IF (LLIST .GE. 4) B = PLIST(4)
- GO TO 170
-C old (fixed-field) format
- 150 CONTINUE
- READ (CRDBUF, 158,ERR=180) XK,CNAMK,UK,WK,A,B
- 158 FORMAT (BN,F10.0, A10, 4F10.0)
- K = XK
- IF (K .EQ. 0) GO TO 210
-C parameter format cracked, implement parameter definition
- 170 CALL MNPARM(K,CNAMK,UK,WK,A,B,IERR)
- ICONDN = IERR
- RETURN
-C format or other error
- 180 CONTINUE
- ICONDN = 1
- RETURN
-C end of data
- 210 CONTINUE
- ICONDN = 2
- RETURN
- END
diff --git a/src/packlib/minuit/code/mnpfit.F b/src/packlib/minuit/code/mnpfit.F
deleted file mode 100644
index 414cf0f..0000000
--- a/src/packlib/minuit/code/mnpfit.F
+++ /dev/null
@@ -1,70 +0,0 @@
-*
-* $Id: mnpfit.F,v 1.1.1.1 1996/03/07 14:31:31 mclareni Exp $
-*
-* $Log: mnpfit.F,v $
-* Revision 1.1.1.1 1996/03/07 14:31:31 mclareni
-* Minuit
-*
-*
-#include "minuit/pilot.h"
- SUBROUTINE MNPFIT(PARX2P,PARY2P,NPAR2P,COEF2P,SDEV2P)
-#include "minuit/d506dp.inc"
-C
-C to fit a parabola to npar2p points
-C
-C npar2p no. of points
-C parx2p(i) x value of point i
-C pary2p(i) y value of point i
-C
-C coef2p(1...3) coefficients of the fitted parabola
-C y=coef2p(1) + coef2p(2)*x + coef2p(3)*x**2
-C sdev2p= variance
-C method : chi**2 = min equation solved explicitly
- DIMENSION PARX2P(NPAR2P),PARY2P(NPAR2P),COEF2P(NPAR2P)
- DIMENSION CZ(3)
-C
- DO 3 I=1,3
- 3 CZ(I)=0.
- SDEV2P=0.
- IF(NPAR2P.LT.3) GO TO 10
- F=NPAR2P
-C--- center x values for reasons of machine precision
- XM=0.
- DO 2 I=1,NPAR2P
- 2 XM=XM+PARX2P(I)
- XM=XM/F
- X2=0.
- X3=0.
- X4=0.
- Y=0.
- Y2=0.
- XY=0.
- X2Y=0.
- DO 1 I=1,NPAR2P
- S=PARX2P(I)-XM
- T=PARY2P(I)
- S2=S*S
- X2=X2+S2
- X3=X3+S*S2
- X4=X4+S2*S2
- Y=Y+T
- Y2=Y2+T*T
- XY=XY+S*T
- X2Y=X2Y+S2*T
- 1 CONTINUE
- A=(F*X4-X2**2)*X2-F*X3**2
- IF(A.EQ.0.) GOTO 10
- CZ(3)=(X2*(F*X2Y-X2*Y)-F*X3*XY)/A
- CZ(2)=(XY-X3*CZ(3))/X2
- CZ(1)=(Y-X2*CZ(3))/F
- IF(NPAR2P.EQ.3) GOTO 6
- SDEV2P=Y2-(CZ(1)*Y+CZ(2)*XY+CZ(3)*X2Y)
- IF(SDEV2P.LT.0.) SDEV2P=0.
- SDEV2P=SDEV2P/(F-3.)
- 6 CZ(1)=CZ(1)+XM*(XM*CZ(3)-CZ(2))
- CZ(2)=CZ(2)-2.*XM*CZ(3)
- 10 CONTINUE
- DO 11 I=1,3
- 11 COEF2P(I)=CZ(I)
- RETURN
- END
diff --git a/src/packlib/minuit/code/mnpint.F b/src/packlib/minuit/code/mnpint.F
deleted file mode 100644
index 7303772..0000000
--- a/src/packlib/minuit/code/mnpint.F
+++ /dev/null
@@ -1,44 +0,0 @@
-*
-* $Id: mnpint.F,v 1.1.1.1 1996/03/07 14:31:31 mclareni Exp $
-*
-* $Log: mnpint.F,v $
-* Revision 1.1.1.1 1996/03/07 14:31:31 mclareni
-* Minuit
-*
-*
-#include "minuit/pilot.h"
- SUBROUTINE MNPINT(PEXTI,I,PINTI)
-#include "minuit/d506dp.inc"
-CC Calculates the internal parameter value PINTI corresponding
-CC to the external value PEXTI for parameter I.
-CC
-#include "minuit/d506cm.inc"
- CHARACTER CHBUFI*4, CHBUF2*30
- PINTI = PEXTI
- IGO = NVARL(I)
- IF (IGO .EQ. 4) THEN
-C-- there are two limits
- ALIMI = ALIM(I)
- BLIMI = BLIM(I)
- YY=2.0*(PEXTI-ALIMI)/(BLIMI-ALIMI) - 1.0
- YY2 = YY**2
- IF (YY2 .GE. (1.0- EPSMA2)) THEN
- IF (YY .LT. 0.) THEN
- A = VLIMLO
- CHBUF2 = ' IS AT ITS LOWER ALLOWED LIMIT.'
- ELSE
- A = VLIMHI
- CHBUF2 = ' IS AT ITS UPPER ALLOWED LIMIT.'
- ENDIF
- PINTI = A
- PEXTI = ALIMI + 0.5* (BLIMI-ALIMI) *(SIN(A) +1.0)
- LIMSET = .TRUE.
- WRITE (CHBUFI,'(I4)') I
- IF (YY2 .GT. 1.0) CHBUF2 = ' BROUGHT BACK INSIDE LIMITS.'
- CALL MNWARN('W',CFROM,'VARIABLE'//CHBUFI//CHBUF2)
- ELSE
- PINTI = ASIN(YY)
- ENDIF
- ENDIF
- RETURN
- END
diff --git a/src/packlib/minuit/code/mnplot.F b/src/packlib/minuit/code/mnplot.F
deleted file mode 100644
index 77f5176..0000000
--- a/src/packlib/minuit/code/mnplot.F
+++ /dev/null
@@ -1,149 +0,0 @@
-*
-* $Id: mnplot.F,v 1.1.1.1 1996/03/07 14:31:31 mclareni Exp $
-*
-* $Log: mnplot.F,v $
-* Revision 1.1.1.1 1996/03/07 14:31:31 mclareni
-* Minuit
-*
-*
-#include "minuit/pilot.h"
- SUBROUTINE MNPLOT(XPT,YPT,CHPT,NXYPT,NUNIT,NPAGWD,NPAGLN)
-#include "minuit/d506dp.inc"
-CC plots points in array xypt onto one page with labelled axes
-CC NXYPT is the number of points to be plotted
-CC XPT(I) = x-coord. of ith point
-CC YPT(I) = y-coord. of ith point
-CC CHPT(I) = character to be plotted at this position
-CC the input point arrays XPT, YPT, CHPT are destroyed.
-CC
- DIMENSION XPT(*), YPT(*)
- CHARACTER*1 CHPT(*) , CHSAV, CHBEST, CDOT, CSLASH, CBLANK
- PARAMETER (MAXWID=100)
- CHARACTER CLINE*100, CHMESS*30
- DIMENSION XVALUS(12)
- LOGICAL OVERPR
- DATA CDOT,CSLASH,CBLANK/ '.' , '/' , ' '/
- MAXNX = MIN(NPAGWD-20,MAXWID)
- IF (MAXNX .LT. 10) MAXNX = 10
- MAXNY = NPAGLN
- IF (MAXNY .LT. 10) MAXNY = 10
- IF (NXYPT .LE. 1) RETURN
- XBEST = XPT(1)
- YBEST = YPT(1)
- CHBEST = CHPT(1)
-C order the points by decreasing y
- KM1 = NXYPT - 1
- DO 150 I= 1, KM1
- IQUIT = 0
- NI = NXYPT - I
- DO 140 J= 1, NI
- IF (YPT(J) .GT. YPT(J+1)) GO TO 140
- SAVX = XPT(J)
- XPT(J) = XPT(J+1)
- XPT(J+1) = SAVX
- SAVY = YPT(J)
- YPT(J) = YPT(J+1)
- YPT(J+1) = SAVY
- CHSAV = CHPT(J)
- CHPT(J) = CHPT(J+1)
- CHPT(J+1) = CHSAV
- IQUIT = 1
- 140 CONTINUE
- IF (IQUIT .EQ. 0) GO TO 160
- 150 CONTINUE
- 160 CONTINUE
-C find extreme values
- XMAX = XPT(1)
- XMIN = XMAX
- DO 200 I= 1, NXYPT
- IF (XPT(I) .GT. XMAX) XMAX = XPT(I)
- IF (XPT(I) .LT. XMIN) XMIN = XPT(I)
- 200 CONTINUE
- DXX = 0.001*(XMAX-XMIN)
- XMAX = XMAX + DXX
- XMIN = XMIN - DXX
- CALL MNBINS(XMIN,XMAX,MAXNX,XMIN,XMAX,NX,BWIDX)
- YMAX = YPT(1)
- YMIN = YPT(NXYPT)
- IF (YMAX .EQ. YMIN) YMAX=YMIN+1.0
- DYY = 0.001*(YMAX-YMIN)
- YMAX = YMAX + DYY
- YMIN = YMIN - DYY
- CALL MNBINS(YMIN,YMAX,MAXNY,YMIN,YMAX,NY,BWIDY)
- ANY = NY
-C if first point is blank, it is an 'origin'
- IF (CHBEST .EQ. CBLANK) GO TO 50
- XBEST = 0.5 * (XMAX+XMIN)
- YBEST = 0.5 * (YMAX+YMIN)
- 50 CONTINUE
-C find scale constants
- AX = 1.0/BWIDX
- AY = 1.0/BWIDY
- BX = -AX*XMIN + 2.0
- BY = -AY*YMIN - 2.0
-C convert points to grid positions
- DO 300 I= 1, NXYPT
- XPT(I) = AX*XPT(I) + BX
- 300 YPT(I) = ANY-AY*YPT(I) - BY
- NXBEST = AX*XBEST + BX
- NYBEST = ANY - AY*YBEST - BY
-C print the points
- NY = NY + 2
- NX = NX + 2
- ISP1 = 1
- LINODD = 1
- OVERPR=.FALSE.
- DO 400 I= 1, NY
- DO 310 IBK= 1, NX
- 310 CLINE (IBK:IBK) = CBLANK
- CLINE(1:1) = CDOT
- CLINE(NX:NX) = CDOT
- CLINE(NXBEST:NXBEST) = CDOT
- IF (I.NE.1 .AND. I.NE.NYBEST .AND. I.NE.NY) GO TO 320
- DO 315 J= 1, NX
- 315 CLINE(J:J) = CDOT
- 320 CONTINUE
- YPRT = YMAX - FLOAT(I-1)*BWIDY
- IF (ISP1 .GT. NXYPT) GO TO 350
-C find the points to be plotted on this line
- DO 341 K= ISP1,NXYPT
- KS = YPT(K)
- IF (KS .GT. I) GO TO 345
- IX = XPT(K)
- IF (CLINE(IX:IX) .EQ. CDOT) GO TO 340
- IF (CLINE(IX:IX) .EQ. CBLANK) GO TO 340
- IF (CLINE(IX:IX) .EQ.CHPT(K)) GO TO 341
- OVERPR = .TRUE.
-C OVERPR is true if one or more positions contains more than
-C one point
- CLINE(IX:IX) = '&'
- GO TO 341
- 340 CLINE(IX:IX) = CHPT(K)
- 341 CONTINUE
- ISP1 = NXYPT + 1
- GO TO 350
- 345 ISP1 = K
- 350 CONTINUE
- IF (LINODD .EQ. 1 .OR. I .EQ. NY) GO TO 380
- LINODD = 1
- WRITE (NUNIT, '(18X,A)') CLINE(:NX)
- GO TO 400
- 380 WRITE (NUNIT,'(1X,G14.7,A,A)') YPRT, ' ..', CLINE(:NX)
- LINODD = 0
- 400 CONTINUE
-C print labels on x-axis every ten columns
- DO 410 IBK= 1, NX
- CLINE(IBK:IBK) = CBLANK
- IF (MOD(IBK,10) .EQ. 1) CLINE(IBK:IBK) = CSLASH
- 410 CONTINUE
- WRITE (NUNIT, '(18X,A)') CLINE(:NX)
-C
- DO 430 IBK= 1, 12
- 430 XVALUS(IBK) = XMIN + FLOAT(IBK-1)*10.*BWIDX
- ITEN = (NX+9) / 10
- WRITE (NUNIT,'(12X,12G10.4)') (XVALUS(IBK), IBK=1,ITEN)
- CHMESS = ' '
- IF (OVERPR) CHMESS=' Overprint character is &'
- WRITE (NUNIT,'(25X,A,G13.7,A)') 'ONE COLUMN=',BWIDX, CHMESS
- 500 RETURN
- END
diff --git a/src/packlib/minuit/code/mnpout.F b/src/packlib/minuit/code/mnpout.F
deleted file mode 100644
index 087a73b..0000000
--- a/src/packlib/minuit/code/mnpout.F
+++ /dev/null
@@ -1,62 +0,0 @@
-*
-* $Id: mnpout.F,v 1.1.1.1 1996/03/07 14:31:31 mclareni Exp $
-*
-* $Log: mnpout.F,v $
-* Revision 1.1.1.1 1996/03/07 14:31:31 mclareni
-* Minuit
-*
-*
-#include "minuit/pilot.h"
- SUBROUTINE MNPOUT(IUEXT,CHNAM,VAL,ERR,XLOLIM,XUPLIM,IUINT)
-#include "minuit/d506dp.inc"
-CC User-called
-CC Provides the user with information concerning the current status
-CC of parameter number IUEXT. Namely, it returns:
-CC CHNAM: the name of the parameter
-CC VAL: the current (external) value of the parameter
-CC ERR: the current estimate of the parameter uncertainty
-CC XLOLIM: the lower bound (or zero if no limits)
-CC XUPLIM: the upper bound (or zero if no limits)
-CC IUINT: the internal parameter number (or zero if not variable,
-CC or negative if undefined).
-CC Note also: If IUEXT is negative, then it is -internal parameter
-CC number, and IUINT is returned as the EXTERNAL number.
-CC Except for IUINT, this is exactly the inverse of MNPARM
-CC
-#include "minuit/d506cm.inc"
- CHARACTER*(*) CHNAM
- XLOLIM = 0.
- XUPLIM = 0.
- ERR = 0.
- IF (IUEXT .EQ. 0) GO TO 100
- IF (IUEXT .LT. 0) THEN
-C internal parameter number specified
- IINT = -IUEXT
- IF (IINT .GT. NPAR) GO TO 100
- IEXT = NEXOFI(IINT)
- IUINT = IEXT
- ELSE
-C external parameter number specified
- IEXT = IUEXT
- IF (IEXT .EQ. 0) GO TO 100
- IF (IEXT .GT. NU) GO TO 100
- IINT = NIOFEX(IEXT)
- IUINT = IINT
- ENDIF
-C in both cases
- NVL = NVARL(IEXT)
- IF (NVL .LT. 0) GO TO 100
- CHNAM = CPNAM(IEXT)
- VAL = U(IEXT)
- IF (IINT .GT. 0) ERR = WERR(IINT)
- IF (NVL .EQ. 4) THEN
- XLOLIM = ALIM(IEXT)
- XUPLIM = BLIM(IEXT)
- ENDIF
- RETURN
-C parameter is undefined
- 100 IUINT = -1
- CHNAM = 'undefined'
- VAL = 0.
- RETURN
- END
diff --git a/src/packlib/minuit/code/mnprin.F b/src/packlib/minuit/code/mnprin.F
deleted file mode 100644
index 8cd9773..0000000
--- a/src/packlib/minuit/code/mnprin.F
+++ /dev/null
@@ -1,194 +0,0 @@
-*
-* $Id: mnprin.F,v 1.1.1.1 1996/03/07 14:31:31 mclareni Exp $
-*
-* $Log: mnprin.F,v $
-* Revision 1.1.1.1 1996/03/07 14:31:31 mclareni
-* Minuit
-*
-*
-#include "minuit/pilot.h"
- SUBROUTINE MNPRIN (INKODE,FVAL)
-#include "minuit/d506dp.inc"
-CC Prints the values of the parameters at the time of the call.
-CC also prints other relevant information such as function value,
-CC estimated distance to minimum, parameter errors, step sizes.
-CC
-C According to the value of IKODE, the printout is:
-C IKODE=INKODE= 0 only info about function value
-C 1 parameter values, errors, limits
-C 2 values, errors, step sizes, internal values
-C 3 values, errors, step sizes, first derivs.
-C 4 values, parabolic errors, MINOS errors
-C when INKODE=5, MNPRIN chooses IKODE=1,2, or 3, according to ISW(2)
-C
-#include "minuit/d506cm.inc"
-C
- CHARACTER*14 COLHDU(6),COLHDL(6), CX2,CX3,CGETX
- CHARACTER*11 CNAMBF, CBLANK
- CHARACTER CHEDM*10, CHEVAL*15
- PARAMETER (CGETX='PLEASE GET X..')
- DATA CBLANK/' '/
-C
- IF (NU .EQ. 0) THEN
- WRITE (ISYSWR,'(A)') ' THERE ARE CURRENTLY NO PARAMETERS DEFINED'
- GO TO 700
- ENDIF
-C get value of IKODE based in INKODE, ISW(2)
- IKODE = INKODE
- IF (INKODE .EQ. 5) THEN
- IKODE = ISW(2)+1
- IF (IKODE .GT. 3) IKODE=3
- ENDIF
-C set 'default' column headings
- DO 5 K= 1, 6
- COLHDU(K) = 'UNDEFINED'
- 5 COLHDL(K) = 'COLUMN HEAD'
-C print title if Minos errors, and title exists.
- IF (IKODE.EQ.4 .AND. CTITL.NE.CUNDEF)
- + WRITE (ISYSWR,'(/A,A)') ' MINUIT TASK: ',CTITL
-C report function value and status
- IF (FVAL .EQ. UNDEFI) THEN
- CHEVAL = ' unknown '
- ELSE
- WRITE (CHEVAL,'(G15.7)') FVAL
- ENDIF
- IF (EDM .EQ. BIGEDM) THEN
- CHEDM = ' unknown '
- ELSE
- WRITE (CHEDM, '(E10.2)') EDM
- ENDIF
- NC = NFCN-NFCNFR
- WRITE (ISYSWR,905) CHEVAL,CFROM,CSTATU,NC,NFCN
- 905 FORMAT (/' FCN=',A,' FROM ',A8,' STATUS=',A10,I6,' CALLS',
- + I9,' TOTAL')
- M = ISW(2)
- IF (M.EQ.0 .OR. M.EQ.2 .OR. DCOVAR.EQ.ZERO) THEN
- WRITE (ISYSWR,907) CHEDM,ISTRAT,COVMES(M)
- 907 FORMAT (21X,'EDM=',A,' STRATEGY=',I2,6X,A)
- ELSE
- DCMAX = 1.
- DC = MIN(DCOVAR,DCMAX) * 100.
- WRITE (ISYSWR,908) CHEDM,ISTRAT,DC
- 908 FORMAT (21X,'EDM=',A,' STRATEGY=',I1,' ERROR MATRIX',
- + ' UNCERTAINTY=',F5.1,'%')
- ENDIF
-C
- IF (IKODE .EQ. 0) GO TO 700
-C find longest name (for Rene!)
- NTRAIL = 10
- DO 20 I= 1, NU
- IF (NVARL(I) .LT. 0) GO TO 20
- DO 15 IC= 10,1,-1
- IF (CPNAM(I)(IC:IC) .NE. ' ') GO TO 16
- 15 CONTINUE
- IC = 1
- 16 LBL = 10-IC
- IF (LBL .LT. NTRAIL) NTRAIL=LBL
- 20 CONTINUE
- NADD = NTRAIL/2 + 1
- IF (IKODE .EQ. 1) THEN
- COLHDU(1) = ' '
- COLHDL(1) = ' ERROR '
- COLHDU(2) = ' PHYSICAL'
- COLHDU(3) = ' LIMITS '
- COLHDL(2) = ' NEGATIVE '
- COLHDL(3) = ' POSITIVE '
- ENDIF
- IF (IKODE .EQ. 2) THEN
- COLHDU(1) = ' '
- COLHDL(1) = ' ERROR '
- COLHDU(2) = ' INTERNAL '
- COLHDL(2) = ' STEP SIZE '
- COLHDU(3) = ' INTERNAL '
- COLHDL(3) = ' VALUE '
- ENDIF
- IF (IKODE .EQ. 3) THEN
- COLHDU(1) = ' '
- COLHDL(1) = ' ERROR '
- COLHDU(2) = ' STEP '
- COLHDL(2) = ' SIZE '
- COLHDU(3) = ' FIRST '
- COLHDL(3) = ' DERIVATIVE '
- ENDIF
- IF (IKODE .EQ. 4) THEN
- COLHDU(1) = ' PARABOLIC '
- COLHDL(1) = ' ERROR '
- COLHDU(2) = ' MINOS '
- COLHDU(3) = 'ERRORS '
- COLHDL(2) = ' NEGATIVE '
- COLHDL(3) = ' POSITIVE '
- ENDIF
-C
- IF (IKODE .NE. 4) THEN
- IF (ISW(2) .LT. 3) COLHDU(1)=' APPROXIMATE '
- IF (ISW(2) .LT. 1) COLHDU(1)=' CURRENT GUESS'
- ENDIF
- NCOL = 3
- WRITE (ISYSWR, 910) (COLHDU(KK),KK=1,NCOL)
- WRITE (ISYSWR, 911) (COLHDL(KK),KK=1,NCOL)
- 910 FORMAT (/' EXT PARAMETER ', 13X ,6A14)
- 911 FORMAT ( ' NO. NAME ',' VALUE ',6A14)
-C
-C . . . loop over parameters . .
- DO 200 I= 1, NU
- IF (NVARL(I) .LT. 0) GO TO 200
- L = NIOFEX(I)
- CNAMBF = CBLANK(1:NADD)//CPNAM(I)
- IF (L .EQ. 0) GO TO 55
-C variable parameter.
- X1 = WERR(L)
- CX2 = CGETX
- CX3 = CGETX
- IF (IKODE .EQ. 1) THEN
- IF (NVARL(I) .LE. 1) THEN
- WRITE (ISYSWR, 952) I,CNAMBF,U(I),X1
- GO TO 200
- ELSE
- X2 = ALIM(I)
- X3 = BLIM(I)
- ENDIF
- ENDIF
- IF (IKODE .EQ. 2) THEN
- X2 = DIRIN(L)
- X3 = X(L)
- ENDIF
- IF (IKODE .EQ. 3) THEN
- X2 = DIRIN(L)
- X3 = GRD(L)
- IF (NVARL(I).GT.1 .AND. ABS(COS(X(L))) .LT. 0.001)
- + CX3 = '** at limit **'
- ENDIF
- IF (IKODE .EQ. 4) THEN
- X2 = ERN(L)
- IF (X2.EQ.ZERO) CX2=' '
- IF (X2.EQ.UNDEFI) CX2=' at limit '
- X3 = ERP(L)
- IF (X3.EQ.ZERO) CX3=' '
- IF (X3.EQ.UNDEFI) CX3=' at limit '
- ENDIF
- IF (CX2.EQ.CGETX) WRITE (CX2,'(G14.5)') X2
- IF (CX3.EQ.CGETX) WRITE (CX3,'(G14.5)') X3
- WRITE (ISYSWR,952) I,CNAMBF,U(I),X1,CX2,CX3
- 952 FORMAT (I4,1X,A11,2G14.5,2A)
-C check if parameter is at limit
- IF (NVARL(I) .LE. 1 .OR. IKODE .EQ. 3) GO TO 200
- IF (ABS(COS(X(L))) .LT. 0.001) WRITE (ISYSWR,1004)
- 1004 FORMAT (1H ,32X,42HWARNING - - ABOVE PARAMETER IS AT LIMIT.)
- GO TO 200
-C
-C print constant or fixed parameter.
- 55 CONTINUE
- COLHDU(1) = ' constant '
- IF (NVARL(I).GT.0) COLHDU(1) = ' fixed '
- IF (NVARL(I).EQ.4 .AND. IKODE.EQ.1) THEN
- WRITE (ISYSWR,'(I4,1X,A11,G14.5,A,2G14.5)')
- + I,CNAMBF,U(I),COLHDU(1),ALIM(I),BLIM(I)
- ELSE
- WRITE (ISYSWR,'(I4,1X,A11,G14.5,A)') I,CNAMBF,U(I),COLHDU(1)
- ENDIF
- 200 CONTINUE
-C
- IF (UP.NE.UPDFLT) WRITE (ISYSWR,'(31X,A,G10.3)') 'ERR DEF=',UP
- 700 CONTINUE
- RETURN
- END
diff --git a/src/packlib/minuit/code/mnpsdf.F b/src/packlib/minuit/code/mnpsdf.F
deleted file mode 100644
index 8e4b5dd..0000000
--- a/src/packlib/minuit/code/mnpsdf.F
+++ /dev/null
@@ -1,91 +0,0 @@
-*
-* $Id: mnpsdf.F,v 1.2 1996/03/15 18:02:50 james Exp $
-*
-* $Log: mnpsdf.F,v $
-* Revision 1.2 1996/03/15 18:02:50 james
-* Modified Files:
-* mnderi.F eliminate possible division by zero
-* mnexcm.F suppress print on STOP when print flag=-1
-* set FVAL3 to flag if FCN already called with IFLAG=3
-* mninit.F set version 96.03
-* mnlims.F remove arguments, not needed
-* mnmigr.F VLEN -> LENV in debug print statement
-* mnparm.F move call to MNRSET to after NPAR redefined, to zero all
-* mnpsdf.F eliminate possible division by zero
-* mnscan.F suppress printout when print flag =-1
-* mnset.F remove arguments in call to MNLIMS
-* mnsimp.F fix CSTATU so status is PROGRESS only if new minimum
-* mnvert.F eliminate possible division by zero
-*
-* Revision 1.1.1.1 1996/03/07 14:31:31 mclareni
-* Minuit
-*
-*
-#include "minuit/pilot.h"
- SUBROUTINE MNPSDF
-#include "minuit/d506dp.inc"
-CC calculates the eigenvalues of v to see if positive-def.
-CC if not, adds constant along diagonal to make positive.
-#include "minuit/d506cm.inc"
- CHARACTER CHBUFF*12
- DIMENSION S(MNI)
- EPSMIN = 1.0E-6
- EPSPDF = MAX(EPSMIN, EPSMA2)
- DGMIN = VHMAT(1)
-C Check if negative or zero on diagonal
- DO 200 I= 1, NPAR
- NDEX = I*(I+1)/2
- IF (VHMAT(NDEX) .LE. ZERO) THEN
- WRITE (CHBUFF(1:3),'(I3)') I
- CALL MNWARN('W',CFROM,
- +'Negative diagonal element'//CHBUFF(1:3)//' in Error Matrix')
- ENDIF
- IF (VHMAT(NDEX) .LT. DGMIN) DGMIN = VHMAT(NDEX)
- 200 CONTINUE
- IF (DGMIN .LE. ZERO) THEN
- DG = (ONE+EPSPDF) - DGMIN
- WRITE (CHBUFF,'(E12.2)') DG
- CALL MNWARN('W',CFROM,
- + CHBUFF//' added to diagonal of error matrix')
- ELSE
- DG = ZERO
- ENDIF
-C Store VHMAT in P, make sure diagonal pos.
- DO 213 I= 1, NPAR
- NDEX = I*(I-1)/2
- NDEXD = NDEX + I
- VHMAT(NDEXD) = VHMAT(NDEXD) + DG
- IF (VHMAT(NDEXD) .LE. ZERO) VHMAT(NDEXD) = 1.0
- S(I) = 1.0/SQRT(VHMAT(NDEXD))
- DO 213 J= 1, I
- NDEX = NDEX + 1
- 213 P(I,J) = VHMAT(NDEX) * S(I)*S(J)
-C call eigen (p,p,maxint,npar,pstar,-npar)
- CALL MNEIG(P,MAXINT,NPAR,MAXINT,PSTAR,EPSPDF,IFAULT)
- PMIN = PSTAR(1)
- PMAX = PSTAR(1)
- DO 215 IP= 2, NPAR
- IF (PSTAR(IP) .LT. PMIN) PMIN = PSTAR(IP)
- IF (PSTAR(IP) .GT. PMAX) PMAX = PSTAR(IP)
- 215 CONTINUE
- PMAX = MAX(ABS(PMAX), ONE)
- IF ((PMIN .LE. ZERO .AND. LWARN) .OR. ISW(5) .GE. 2) THEN
- WRITE (ISYSWR,550)
- WRITE (ISYSWR,551) (PSTAR(IP),IP=1,NPAR)
- ENDIF
- IF (PMIN .GT. EPSPDF*PMAX) GO TO 217
- IF (ISW(2) .EQ. 3) ISW(2)=2
- PADD = 1.0E-3*PMAX - PMIN
- DO 216 IP= 1, NPAR
- NDEX = IP*(IP+1)/2
- 216 VHMAT(NDEX) = VHMAT(NDEX) *(1.0 + PADD)
- CSTATU= 'NOT POSDEF'
- WRITE (CHBUFF,'(G12.5)') PADD
- CALL MNWARN('W',CFROM,
- + 'MATRIX FORCED POS-DEF BY ADDING '//CHBUFF//' TO DIAGONAL.')
- 217 CONTINUE
-C
- 550 FORMAT (' EIGENVALUES OF SECOND-DERIVATIVE MATRIX:' )
- 551 FORMAT (7X,6E12.4)
- RETURN
- END
diff --git a/src/packlib/minuit/code/mnrazz.F b/src/packlib/minuit/code/mnrazz.F
deleted file mode 100644
index 9a66379..0000000
--- a/src/packlib/minuit/code/mnrazz.F
+++ /dev/null
@@ -1,51 +0,0 @@
-*
-* $Id: mnrazz.F,v 1.1.1.1 1996/03/07 14:31:31 mclareni Exp $
-*
-* $Log: mnrazz.F,v $
-* Revision 1.1.1.1 1996/03/07 14:31:31 mclareni
-* Minuit
-*
-*
-#include "minuit/pilot.h"
- SUBROUTINE MNRAZZ(YNEW,PNEW,Y,JH,JL)
-#include "minuit/d506dp.inc"
-CC Called only by MNSIMP (and MNIMPR) to add a new point
-CC and remove an old one from the current simplex, and get the
-CC estimated distance to minimum.
-CC
-#include "minuit/d506cm.inc"
- DIMENSION PNEW(*), Y(*)
- DO 10 I=1,NPAR
- 10 P(I,JH) = PNEW(I)
- Y(JH)=YNEW
- IF(YNEW .LT. AMIN) THEN
- DO 15 I=1,NPAR
- 15 X(I) = PNEW(I)
- CALL MNINEX(X)
- AMIN = YNEW
- CSTATU = 'PROGRESS '
- JL=JH
- ENDIF
- JH = 1
- NPARP1 = NPAR+1
- 20 DO 25 J=2,NPARP1
- IF (Y(J) .GT. Y(JH)) JH = J
- 25 CONTINUE
- EDM = Y(JH) - Y(JL)
- IF (EDM .LE. ZERO) GO TO 45
- DO 35 I= 1, NPAR
- PBIG = P(I,1)
- PLIT = PBIG
- DO 30 J= 2, NPARP1
- IF (P(I,J) .GT. PBIG) PBIG = P(I,J)
- IF (P(I,J) .LT. PLIT) PLIT = P(I,J)
- 30 CONTINUE
- DIRIN(I) = PBIG - PLIT
- 35 CONTINUE
- 40 RETURN
- 45 WRITE (ISYSWR, 1000) NPAR
- GO TO 40
- 1000 FORMAT (' FUNCTION VALUE DOES NOT SEEM TO DEPEND ON ANY OF THE',
- + I3,' VARIABLE PARAMETERS.' /10X,'VERIFY THAT STEP SIZES ARE',
- + ' BIG ENOUGH AND CHECK FCN LOGIC.'/1X,79(1H*)/1X,79(1H*)/)
- END
diff --git a/src/packlib/minuit/code/mnread.F b/src/packlib/minuit/code/mnread.F
deleted file mode 100644
index bd04f6a..0000000
--- a/src/packlib/minuit/code/mnread.F
+++ /dev/null
@@ -1,192 +0,0 @@
-*
-* $Id: mnread.F,v 1.1.1.1 1996/03/07 14:31:31 mclareni Exp $
-*
-* $Log: mnread.F,v $
-* Revision 1.1.1.1 1996/03/07 14:31:31 mclareni
-* Minuit
-*
-*
-#include "minuit/pilot.h"
- SUBROUTINE MNREAD(FCN,IFLGIN,IFLGUT,FUTIL)
-#include "minuit/d506dp.inc"
-CC Called from MINUIT. Reads all user input to MINUIT.
-CC This routine is highly unstructured and defies normal logic.
-CC
-CC IFLGIN indicates the function originally requested:
-CC = 1: read one-line title
-CC 2: read parameter definitions
-CC 3: read MINUIT commands
-CC
-CC IFLGUT= 1: reading terminated normally
-CC 2: end-of-data on input
-CC 3: unrecoverable read error
-CC 4: unable to process parameter requests
-CC 5: more than 100 incomprehensible commands
-CC internally,
-CC IFLGDO indicates the subfunction to be performed on the next
-CC input record: 1: read a one-line title
-CC 2: read a parameter definition
-CC 3: read a command
-CC 4: read in covariance matrix
-CC for example, when IFLGIN=3, but IFLGDO=1, then it should read
-CC a title, but this was requested by a command, not by MINUIT.
-CC
-#include "minuit/d506cm.inc"
- EXTERNAL FCN,FUTIL
- CHARACTER CRDBUF*80, CUPBUF*10
- CHARACTER CPROMT(3)*40, CLOWER*26, CUPPER*26
- LOGICAL LEOF
- DATA CPROMT/' ENTER MINUIT TITLE, or "SET INPUT n" : ',
- + ' ENTER MINUIT PARAMETER DEFINITION: ',
- + ' ENTER MINUIT COMMAND: '/
-C
- DATA CLOWER/'abcdefghijklmnopqrstuvwxyz'/
- DATA CUPPER/'ABCDEFGHIJKLMNOPQRSTUVWXYZ'/
-C
- IFLGUT = 1
- IFLGDO = IFLGIN
- LEOF = .FALSE.
- INCOMP = 0
-C . . . . read next record
- 10 CONTINUE
- IF (ISW(6) .EQ. 1) THEN
- WRITE (ISYSWR,'(A)') CPROMT(IFLGDO)
- IF (IFLGDO .EQ. 2) LPHEAD = .FALSE.
- ENDIF
- CRDBUF = ' '
- READ (ISYSRD,'(A)',ERR=500,END=45) CRDBUF
-C
-C CUPBUF is the first few characters in upper case
- CUPBUF(1:10) = CRDBUF(1:10)
- DO 12 I= 1, 10
- IF (CRDBUF(I:I) .EQ. '''') GO TO 13
- DO 11 IC= 1, 26
- IF (CRDBUF(I:I) .EQ. CLOWER(IC:IC)) CUPBUF(I:I)=CUPPER(IC:IC)
- 11 CONTINUE
- 12 CONTINUE
- 13 CONTINUE
-C . . preemptive commands
- LEOF = .FALSE.
- IF (INDEX(CUPBUF,'*EOF') .EQ. 1) THEN
- WRITE (ISYSWR,'(A,I3)') ' *EOF ENCOUNTERED ON UNIT NO.',ISYSRD
- LPHEAD = .TRUE.
- GO TO 50
- ENDIF
- IF (INDEX(CUPBUF,'SET INP') .EQ. 1) THEN
- ICOMND = ICOMND + 1
- WRITE (ISYSWR, 21) ICOMND,CRDBUF(1:50)
- 21 FORMAT (' **********'/' **',I5,' **',A/' **********')
- LPHEAD = .TRUE.
- GO TO 50
- ENDIF
- GO TO 80
-C . . hardware EOF on current ISYSRD
- 45 CRDBUF = '*EOF '
- WRITE (ISYSWR,'(A,I3)') ' END OF DATA ON UNIT NO.',ISYSRD
-C or SET INPUT command
- 50 CONTINUE
- CALL MNSTIN(CRDBUF,IERR)
- IF (IERR .EQ. 0) GO TO 10
- IF (IERR .EQ. 2) THEN
- IF (.NOT. LEOF) THEN
- WRITE (ISYSWR,'(A,A/)') ' TWO CONSECUTIVE EOFs ON ',
- + 'PRIMARY INPUT FILE WILL TERMINATE EXECUTION.'
- LEOF = .TRUE.
- GO TO 10
- ENDIF
- ENDIF
- IFLGUT = IERR
- GO TO 900
- 80 IF (IFLGDO .GT. 1) GO TO 100
-C read title . . . . . IFLGDO = 1
-C if title is 'SET TITLE', skip and read again
- IF (INDEX(CUPBUF,'SET TIT') .EQ. 1) GO TO 10
- CALL MNSETI(CRDBUF(1:50))
- WRITE (ISYSWR,'(1X,A50)') CTITL
- WRITE (ISYSWR,'(1X,78(1H*))')
- LPHEAD = .TRUE.
- IF (IFLGIN .EQ. IFLGDO) GO TO 900
- IFLGDO = IFLGIN
- GO TO 10
-C data record is not a title.
- 100 CONTINUE
- IF (IFLGDO .GT. 2) GO TO 300
-C expect parameter definitions. IFLGDO = 2
-C if parameter def is 'PARAMETER', skip and read again
- IF (INDEX(CUPBUF,'PAR') .EQ. 1) GO TO 10
-C if line starts with SET TITLE, read a title first
- IF (INDEX(CUPBUF,'SET TIT') .EQ. 1) THEN
- IFLGDO = 1
- GO TO 10
- ENDIF
-C we really have parameter definitions now
- CALL MNPARS(CRDBUF,ICONDP)
- IF (ICONDP .EQ. 0) GO TO 10
-C format error
- IF (ICONDP .EQ. 1) THEN
- IF (ISW(6) .EQ. 1) THEN
- WRITE (ISYSWR,'(A)') ' FORMAT ERROR. IGNORED. ENTER AGAIN.'
- GO TO 10
- ELSE
- WRITE (ISYSWR,'(A)') ' ERROR IN PARAMETER DEFINITION'
- IFLGUT = 4
- GO TO 900
- ENDIF
- ENDIF
-C ICONDP = 2 . . . end parameter requests
- IF (ISW(5).GE.0 .AND. ISW(6).LT.1) WRITE (ISYSWR,'(4X,75(1H*))')
- LPHEAD = .TRUE.
- IF (IFLGIN .EQ. IFLGDO) GO TO 900
- IFLGDO = IFLGIN
- GO TO 10
-C . . . . . IFLGDO = 3
-C read commands
- 300 CONTINUE
- CALL MNCOMD(FCN,CRDBUF,ICONDN,FUTIL)
-CC ICONDN = 0: command executed normally
-CC 1: command is blank, ignored
-CC 2: command line unreadable, ignored
-CC 3: unknown command, ignored
-CC 4: abnormal termination (e.g., MIGRAD not converged)
-CC 5: command is a request to read PARAMETER definitions
-CC 6: 'SET INPUT' command
-CC 7: 'SET TITLE' command
-CC 8: 'SET COVAR' command
-CC 9: reserved
-CC 10: END command
-CC 11: EXIT or STOP command
-CC 12: RETURN command
- IF (ICONDN .EQ. 2 .OR. ICONDN .EQ. 3) THEN
- INCOMP = INCOMP + 1
- IF (INCOMP .GT. 100) THEN
- IFLGUT = 5
- GO TO 900
- ENDIF
- ENDIF
-C parameter
- IF (ICONDN .EQ. 5) IFLGDO = 2
-C SET INPUT
- IF (ICONDN .EQ. 6) GO TO 50
-C SET TITLE
- IF (ICONDN .EQ. 7) IFLGDO = 1
-C . . . . . . . . . . set covar
- IF (ICONDN .EQ. 8) THEN
- ICOMND = ICOMND + 1
- WRITE (ISYSWR,405) ICOMND,CRDBUF(1:50)
- 405 FORMAT (1H ,10(1H*)/' **',I5,' **',A)
- WRITE (ISYSWR, '(1H ,10(1H*))' )
- NPAR2 = NPAR*(NPAR+1)/2
- READ (ISYSRD,420,ERR=500,END=45) (VHMAT(I),I=1,NPAR2)
- 420 FORMAT (BN,7E11.4,3X)
- ISW(2) = 3
- DCOVAR = 0.0
- IF (ISW(5) .GE. 0) CALL MNMATU(1)
- IF (ISW(5) .GE. 1) CALL MNPRIN(2,AMIN)
- GO TO 10
- ENDIF
- IF (ICONDN .LT. 10) GO TO 10
- GO TO 900
-C . . . . error conditions
- 500 IFLGUT = 3
- 900 RETURN
- END
diff --git a/src/packlib/minuit/code/mnrn15.F b/src/packlib/minuit/code/mnrn15.F
deleted file mode 100644
index d96affe..0000000
--- a/src/packlib/minuit/code/mnrn15.F
+++ /dev/null
@@ -1,30 +0,0 @@
-*
-* $Id: mnrn15.F,v 1.1.1.1 1996/03/07 14:31:31 mclareni Exp $
-*
-* $Log: mnrn15.F,v $
-* Revision 1.1.1.1 1996/03/07 14:31:31 mclareni
-* Minuit
-*
-*
-#include "minuit/pilot.h"
- SUBROUTINE MNRN15(VAL,INSEED)
-#include "minuit/d506dp.inc"
-C This is a super-portable random number generator.
-C It should not overflow on any 32-bit machine.
-C The cycle is only ~10**9, so use with care!
-C Note especially that VAL must not be undefined on input.
-C Set Default Starting Seed
- PARAMETER (THREE=3.0)
- DATA ISEED/12345/
- IF (VAL .EQ. THREE) GO TO 100
-C
- INSEED = ISEED
- K = ISEED/53668
- ISEED = 40014*(ISEED-K*53668) - K*12211
- IF (ISEED .LT. 0) ISEED = ISEED + 2147483563
- VAL = REAL(ISEED) * 4.656613E-10
- RETURN
-C "entry" to set seed, flag is VAL=3.
- 100 ISEED = INSEED
- RETURN
- END
diff --git a/src/packlib/minuit/code/mnrset.F b/src/packlib/minuit/code/mnrset.F
deleted file mode 100644
index 3e4c13d..0000000
--- a/src/packlib/minuit/code/mnrset.F
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: mnrset.F,v 1.1.1.1 1996/03/07 14:31:31 mclareni Exp $
-*
-* $Log: mnrset.F,v $
-* Revision 1.1.1.1 1996/03/07 14:31:31 mclareni
-* Minuit
-*
-*
-#include "minuit/pilot.h"
- SUBROUTINE MNRSET(IOPT)
-#include "minuit/d506dp.inc"
-CC Called from MNCLER and whenever problem changes, for example
-CC after SET LIMITS, SET PARAM, CALL FCN 6
-CC If IOPT=1,
-CC Resets function value and errors to UNDEFINED
-CC If IOPT=0, sets only MINOS errors to undefined
-#include "minuit/d506cm.inc"
- CSTATU = 'RESET '
- IF (IOPT .GE. 1) THEN
- AMIN = UNDEFI
- FVAL3 = 2.0*ABS(AMIN) + 1.
- EDM = BIGEDM
- ISW(4) = 0
- ISW(2) = 0
- DCOVAR = 1.
- ISW(1) = 0
- ENDIF
- LNOLIM = .TRUE.
- DO 10 I= 1, NPAR
- IEXT = NEXOFI(I)
- IF (NVARL(IEXT) .GE. 4) LNOLIM=.FALSE.
- ERP(I) = ZERO
- ERN(I) = ZERO
- GLOBCC(I) = ZERO
- 10 CONTINUE
- IF (ISW(2) .GE. 1) THEN
- ISW(2) = 1
- DCOVAR = MAX(DCOVAR,HALF)
- ENDIF
- RETURN
- END
diff --git a/src/packlib/minuit/code/mnsave.F b/src/packlib/minuit/code/mnsave.F
deleted file mode 100644
index 8949aa6..0000000
--- a/src/packlib/minuit/code/mnsave.F
+++ /dev/null
@@ -1,91 +0,0 @@
-*
-* $Id: mnsave.F,v 1.1.1.1 1996/03/07 14:31:31 mclareni Exp $
-*
-* $Log: mnsave.F,v $
-* Revision 1.1.1.1 1996/03/07 14:31:31 mclareni
-* Minuit
-*
-*
-#include "minuit/pilot.h"
- SUBROUTINE MNSAVE
-#include "minuit/d506dp.inc"
-CC Writes current parameter values and step sizes onto file ISYSSA
-CC in format which can be reread by Minuit for restarting.
-CC The covariance matrix is also output if it exists.
-CC
-#include "minuit/d506cm.inc"
- LOGICAL LOPEN,LNAME
- CHARACTER CGNAME*64, CFNAME*64, CANSWR*1
-C
- INQUIRE(UNIT=ISYSSA,OPENED=LOPEN,NAMED=LNAME,NAME=CGNAME)
- IF (LOPEN) THEN
- IF (.NOT.LNAME) CGNAME='UNNAMED FILE'
- WRITE (ISYSWR,32) ISYSSA,CGNAME
- 32 FORMAT (' CURRENT VALUES WILL BE SAVED ON UNIT',I3,': ',A/)
- ELSE
-C new file, open it
- WRITE (ISYSWR,35) ISYSSA
- 35 FORMAT (' UNIT',I3,' IS NOT OPENED.')
- IF (ISW(6) .EQ. 1) THEN
- WRITE (ISYSWR,'(A)') ' PLEASE GIVE FILE NAME:'
- READ (ISYSRD,'(A)') CFNAME
- OPEN (UNIT=ISYSSA,FILE=CFNAME,STATUS='NEW',ERR=600)
- CGNAME = CFNAME
- ELSE
- GO TO 650
- ENDIF
- ENDIF
-C file is now correctly opened
- IF (ISW(6) .EQ. 1) THEN
- WRITE (ISYSWR,37) ISYSSA
- 37 FORMAT (' SHOULD UNIT',I3,' BE REWOUND BEFORE WRITING TO IT?' )
- READ (ISYSRD,'(A)') CANSWR
- IF (CANSWR.EQ.'Y' .OR. CANSWR.EQ.'y') REWIND ISYSSA
- ENDIF
-C and rewound if requested
- WRITE (ISYSSA,'(10HSET TITLE )',ERR=700)
- WRITE (ISYSSA,'(A)') CTITL
- WRITE (ISYSSA,'(10HPARAMETERS)')
- NLINES = 3
-C write out parameter values
- DO 200 I= 1, NU
- IF (NVARL(I) .LT. 0) GO TO 200
- NLINES = NLINES + 1
- IINT = NIOFEX(I)
- IF (NVARL(I) .GT. 1) GO TO 100
-C parameter without limits
- WRITE (ISYSSA,1001) I,CPNAM(I),U(I),WERR(IINT)
- GO TO 200
-C parameter with limits
- 100 CONTINUE
- WRITE (ISYSSA,1001) I,CPNAM(I),U(I),WERR(IINT),ALIM(I),BLIM(I)
- 1001 FORMAT (1X,I5,1H',A10,1H',4E13.5)
- 200 CONTINUE
- WRITE (ISYSSA,'(A)') ' '
- NLINES = NLINES + 1
-C write out covariance matrix, if any
- IF (ISW(2) .LT. 1) GO TO 750
- WRITE (ISYSSA,1003,ERR=700) NPAR
- 1003 FORMAT ('SET COVARIANCE',I6)
- NPAR2 = NPAR*(NPAR+1)/2
- WRITE (ISYSSA,1004) (VHMAT(I),I=1,NPAR2)
- 1004 FORMAT (BN,7E11.4,3X)
- NCOVAR = NPAR2/7 + 1
- IF (MOD(NPAR2,7) .GT. 0) NCOVAR = NCOVAR + 1
- NLINES = NLINES + NCOVAR
- WRITE (ISYSWR, 501) NLINES,ISYSSA,CGNAME(1:45)
- 501 FORMAT (1X,I5,' RECORDS WRITTEN TO UNIT',I4,':',A)
- IF (NCOVAR .GT. 0) WRITE (ISYSWR, 502) NCOVAR
- 502 FORMAT (' INCLUDING',I5,' RECORDS FOR THE COVARIANCE MATRIX.'/)
- GO TO 900
-C some error conditions
- 600 WRITE (ISYSWR,'(A,I4)') ' I/O ERROR: UNABLE TO OPEN UNIT',ISYSSA
- GO TO 900
- 650 WRITE (ISYSWR,'(A,I4,A)') ' UNIT',ISYSSA,' IS NOT OPENED.'
- GO TO 900
- 700 WRITE (ISYSWR,'(A,I4)') ' ERROR: UNABLE TO WRITE TO UNIT',ISYSSA
- GO TO 900
- 750 WRITE (ISYSWR,'(A)') ' THERE IS NO COVARIANCE MATRIX TO SAVE.'
-C
- 900 RETURN
- END
diff --git a/src/packlib/minuit/code/mnscan.F b/src/packlib/minuit/code/mnscan.F
deleted file mode 100644
index b6196e8..0000000
--- a/src/packlib/minuit/code/mnscan.F
+++ /dev/null
@@ -1,123 +0,0 @@
-*
-* $Id: mnscan.F,v 1.2 1996/03/15 18:02:51 james Exp $
-*
-* $Log: mnscan.F,v $
-* Revision 1.2 1996/03/15 18:02:51 james
-* Modified Files:
-* mnderi.F eliminate possible division by zero
-* mnexcm.F suppress print on STOP when print flag=-1
-* set FVAL3 to flag if FCN already called with IFLAG=3
-* mninit.F set version 96.03
-* mnlims.F remove arguments, not needed
-* mnmigr.F VLEN -> LENV in debug print statement
-* mnparm.F move call to MNRSET to after NPAR redefined, to zero all
-* mnpsdf.F eliminate possible division by zero
-* mnscan.F suppress printout when print flag =-1
-* mnset.F remove arguments in call to MNLIMS
-* mnsimp.F fix CSTATU so status is PROGRESS only if new minimum
-* mnvert.F eliminate possible division by zero
-*
-* Revision 1.1.1.1 1996/03/07 14:31:31 mclareni
-* Minuit
-*
-*
-#include "minuit/pilot.h"
- SUBROUTINE MNSCAN(FCN,FUTIL)
-#include "minuit/d506dp.inc"
-CC Scans the values of FCN as a function of one parameter
-CC and plots the resulting values as a curve using MNPLOT.
-CC It may be called to scan one parameter or all parameters.
-CC retains the best function and parameter values found.
-#include "minuit/d506cm.inc"
- EXTERNAL FCN,FUTIL
- XLREQ = MIN(WORD7(3),WORD7(4))
- XHREQ = MAX(WORD7(3),WORD7(4))
- NCALL = WORD7(2) + 0.01
- IF (NCALL .LE. 1) NCALL = 41
- IF (NCALL .GT. MAXCPT) NCALL = MAXCPT
- NCCALL = NCALL
- IF (AMIN .EQ. UNDEFI) CALL MNAMIN(FCN,FUTIL)
- IPARWD = WORD7(1) + 0.1
- IPAR = MAX(IPARWD, 0)
- IINT = NIOFEX(IPAR)
- CSTATU = 'NO CHANGE'
- IF (IPARWD .GT. 0) GO TO 200
-C
-C equivalent to a loop over parameters requested
- 100 IPAR = IPAR + 1
- IF (IPAR .GT. NU) GO TO 900
- IINT = NIOFEX(IPAR)
- IF (IINT .LE. 0) GO TO 100
-C set up range for parameter IPAR
- 200 CONTINUE
- UBEST = U(IPAR)
- XPT(1) = UBEST
- YPT(1) = AMIN
- CHPT(1)= ' '
- XPT(2) = UBEST
- YPT(2) = AMIN
- CHPT(2)= 'X'
- NXYPT = 2
- IF (NVARL(IPAR) .GT. 1) GO TO 300
-C no limits on parameter
- IF (XLREQ .EQ. XHREQ) GO TO 250
- UNEXT = XLREQ
- STEP = (XHREQ-XLREQ)/FLOAT(NCALL-1)
- GO TO 500
- 250 CONTINUE
- XL = UBEST - WERR(IINT)
- XH = UBEST+ WERR(IINT)
- CALL MNBINS(XL,XH,NCALL, UNEXT,UHIGH,NBINS,STEP)
- NCCALL = NBINS + 1
- GO TO 500
-C limits on parameter
- 300 CONTINUE
- IF (XLREQ .EQ. XHREQ) GO TO 350
- XL = MAX(XLREQ,ALIM(IPAR))
- XH = MIN(XHREQ,BLIM(IPAR))
- IF (XL .GE. XH) GO TO 700
- UNEXT = XL
- STEP = (XH-XL)/FLOAT(NCALL-1)
- GO TO 500
- 350 CONTINUE
- UNEXT = ALIM(IPAR)
- STEP = (BLIM(IPAR)-ALIM(IPAR))/FLOAT(NCALL-1)
-C main scanning loop over parameter IPAR
- 500 CONTINUE
- DO 600 ICALL = 1, NCCALL
- U(IPAR) = UNEXT
- NPARX = NPAR
- CALL FCN(NPARX,GIN,FNEXT,U,4,FUTIL)
- NFCN = NFCN + 1
- NXYPT = NXYPT + 1
- XPT(NXYPT) = UNEXT
- YPT(NXYPT) = FNEXT
- CHPT(NXYPT) = '*'
- IF (FNEXT .LT. AMIN) THEN
- AMIN = FNEXT
- UBEST = UNEXT
- CSTATU= 'IMPROVED '
- ENDIF
- 530 CONTINUE
- UNEXT = UNEXT + STEP
- 600 CONTINUE
-C finished with scan of parameter IPAR
- U(IPAR) = UBEST
- CALL MNEXIN(X)
- IF (ISW(5) .GE. 1) THEN
- WRITE (ISYSWR,1001) NEWPAG,IPAR,CPNAM(IPAR)
- NUNIT = ISYSWR
- CALL MNPLOT(XPT,YPT,CHPT,NXYPT,NUNIT,NPAGWD,NPAGLN)
- ENDIF
- GO TO 800
- 700 CONTINUE
- WRITE (ISYSWR,1000) IPAR
- 800 CONTINUE
- IF (IPARWD .LE. 0) GO TO 100
-C finished with all parameters
- 900 CONTINUE
- IF (ISW(5) .GE. 0) CALL MNPRIN(5,AMIN)
- RETURN
- 1000 FORMAT (46H REQUESTED RANGE OUTSIDE LIMITS FOR PARAMETER ,I3/)
- 1001 FORMAT (I1,'SCAN OF PARAMETER NO.',I3,3H, ,A10)
- END
diff --git a/src/packlib/minuit/code/mnseek.F b/src/packlib/minuit/code/mnseek.F
deleted file mode 100644
index 9b74c17..0000000
--- a/src/packlib/minuit/code/mnseek.F
+++ /dev/null
@@ -1,101 +0,0 @@
-*
-* $Id: mnseek.F,v 1.1.1.1 1996/03/07 14:31:31 mclareni Exp $
-*
-* $Log: mnseek.F,v $
-* Revision 1.1.1.1 1996/03/07 14:31:31 mclareni
-* Minuit
-*
-*
-#include "minuit/pilot.h"
- SUBROUTINE MNSEEK(FCN,FUTIL)
-#include "minuit/d506dp.inc"
-CC Performs a rough (but global) minimization by monte carlo search.
-CC Each time a new minimum is found, the search area is shifted
-CC to be centered at the best value. Random points are chosen
-CC uniformly over a hypercube determined by current step sizes.
-CC The Metropolis algorithm accepts a worse point with probability
-CC exp(-d/UP), where d is the degradation. Improved points
-CC are of course always accepted. Actual steps are random
-CC multiples of the nominal steps (DIRIN).
-CC
-#include "minuit/d506cm.inc"
- EXTERNAL FCN,FUTIL
- PARAMETER (TWOPI=2.0*3.141593)
- DIMENSION XBEST(MNI), XMID(MNI)
- MXFAIL = WORD7(1)
- IF (MXFAIL .LE. 0) MXFAIL=100+20*NPAR
- MXSTEP = 10*MXFAIL
- IF (AMIN .EQ. UNDEFI) CALL MNAMIN(FCN,FUTIL)
- ALPHA = WORD7(2)
- IF (ALPHA .LE. ZERO) ALPHA=3.
- IF (ISW(5) .GE. 1) WRITE (ISYSWR, 3) MXFAIL,MXSTEP,ALPHA
- 3 FORMAT (' MNSEEK: MONTE CARLO MINIMIZATION USING METROPOLIS',
- + ' ALGORITHM'/' TO STOP AFTER',I6,' SUCCESSIVE FAILURES, OR',
- + I7,' STEPS'/' MAXIMUM STEP SIZE IS',F9.3,' ERROR BARS.')
- CSTATU= 'INITIAL '
- IF (ISW(5) .GE. 2) CALL MNPRIN(2,AMIN)
- CSTATU = 'UNCHANGED '
- IFAIL = 0
- RNUM = ZERO
- RNUM1 = ZERO
- RNUM2 = ZERO
- NPARX = NPAR
- FLAST = AMIN
-C set up step sizes, starting values
- DO 10 IPAR = 1, NPAR
- IEXT = NEXOFI(IPAR)
- DIRIN(IPAR) = 2.0*ALPHA*WERR(IPAR)
- IF (NVARL(IEXT) .GT. 1) THEN
-C parameter with limits
- CALL MNDXDI(X(IPAR),IPAR,DXDI)
- IF (DXDI .EQ. ZERO) DXDI=1.
- DIRIN(IPAR) = 2.0*ALPHA*WERR(IPAR)/DXDI
- IF (ABS(DIRIN(IPAR)).GT.TWOPI) DIRIN(IPAR)=TWOPI
- ENDIF
- XMID(IPAR) = X(IPAR)
- 10 XBEST(IPAR) = X(IPAR)
-C search loop
- DO 500 ISTEP= 1, MXSTEP
- IF (IFAIL .GE. MXFAIL) GO TO 600
- DO 100 IPAR= 1, NPAR
- CALL MNRN15(RNUM1,ISEED)
- CALL MNRN15(RNUM2,ISEED)
- 100 X(IPAR) = XMID(IPAR) + 0.5*(RNUM1+RNUM2-1.)*DIRIN(IPAR)
- CALL MNINEX(X)
- CALL FCN(NPARX,GIN,FTRY,U,4,FUTIL)
- NFCN = NFCN + 1
- IF (FTRY .LT. FLAST) THEN
- IF (FTRY .LT. AMIN) THEN
- CSTATU = 'IMPROVEMNT'
- AMIN = FTRY
- DO 200 IB= 1, NPAR
- 200 XBEST(IB) = X(IB)
- IFAIL = 0
- IF (ISW(5) .GE. 2) CALL MNPRIN(2,AMIN)
- ENDIF
- GO TO 300
- ELSE
- IFAIL = IFAIL + 1
-C Metropolis algorithm
- BAR = (AMIN-FTRY)/UP
- CALL MNRN15(RNUM,ISEED)
- IF (BAR .LT. LOG(RNUM)) GO TO 500
- ENDIF
-C Accept new point, move there
- 300 CONTINUE
- DO 350 J= 1, NPAR
- XMID(J) = X(J)
- 350 CONTINUE
- FLAST = FTRY
- 500 CONTINUE
-C end search loop
- 600 CONTINUE
- IF (ISW(5) .GT. 1) WRITE (ISYSWR,601) IFAIL
- 601 FORMAT(' MNSEEK:',I5,' SUCCESSIVE UNSUCCESSFUL TRIALS.')
- DO 700 IB= 1, NPAR
- 700 X(IB) = XBEST(IB)
- CALL MNINEX(X)
- IF (ISW(5) .GE. 1) CALL MNPRIN(2,AMIN)
- IF (ISW(5) .EQ. 0) CALL MNPRIN(0,AMIN)
- RETURN
- END
diff --git a/src/packlib/minuit/code/mnset.F b/src/packlib/minuit/code/mnset.F
deleted file mode 100644
index d951276..0000000
--- a/src/packlib/minuit/code/mnset.F
+++ /dev/null
@@ -1,422 +0,0 @@
-*
-* $Id: mnset.F,v 1.2 1996/03/15 18:02:52 james Exp $
-*
-* $Log: mnset.F,v $
-* Revision 1.2 1996/03/15 18:02:52 james
-* Modified Files:
-* mnderi.F eliminate possible division by zero
-* mnexcm.F suppress print on STOP when print flag=-1
-* set FVAL3 to flag if FCN already called with IFLAG=3
-* mninit.F set version 96.03
-* mnlims.F remove arguments, not needed
-* mnmigr.F VLEN -> LENV in debug print statement
-* mnparm.F move call to MNRSET to after NPAR redefined, to zero all
-* mnpsdf.F eliminate possible division by zero
-* mnscan.F suppress printout when print flag =-1
-* mnset.F remove arguments in call to MNLIMS
-* mnsimp.F fix CSTATU so status is PROGRESS only if new minimum
-* mnvert.F eliminate possible division by zero
-*
-* Revision 1.1.1.1 1996/03/07 14:31:29 mclareni
-* Minuit
-*
-*
-#include "minuit/pilot.h"
- SUBROUTINE MNSET(FCN,FUTIL)
-#include "minuit/d506dp.inc"
-CC Called from MNEXCM
-CC Interprets the commands that start with SET and SHOW
-CC
-#include "minuit/d506cm.inc"
-C
- EXTERNAL FCN,FUTIL
-C file characteristics for SET INPUT
- LOGICAL LNAME
- CHARACTER CFNAME*64, CMODE*16
-C 'SET ' or 'SHOW', 'ON ' or 'OFF', 'SUPPRESSED' or 'REPORTED '
- CHARACTER CKIND*4, COPT*3, CWARN*10
-C explanation of print level numbers -1:3 and strategies 0:2
- CHARACTER CPRLEV(-1:3)*34 ,CSTRAT(0:2)*44
-C identification of debug options
- PARAMETER (NUMDBG = 6)
- CHARACTER*40 CDBOPT(0:NUMDBG)
-C things that can be set or shown
- CHARACTER*10 CNAME(30)
- DATA CNAME( 1)/'FCN value '/
- DATA CNAME( 2)/'PARameters'/
- DATA CNAME( 3)/'LIMits '/
- DATA CNAME( 4)/'COVariance'/
- DATA CNAME( 5)/'CORrelatio'/
- DATA CNAME( 6)/'PRInt levl'/
- DATA CNAME( 7)/'NOGradient'/
- DATA CNAME( 8)/'GRAdient '/
- DATA CNAME( 9)/'ERRor def '/
- DATA CNAME(10)/'INPut file'/
- DATA CNAME(11)/'WIDth page'/
- DATA CNAME(12)/'LINes page'/
- DATA CNAME(13)/'NOWarnings'/
- DATA CNAME(14)/'WARnings '/
- DATA CNAME(15)/'RANdom gen'/
- DATA CNAME(16)/'TITle '/
- DATA CNAME(17)/'STRategy '/
- DATA CNAME(18)/'EIGenvalue'/
- DATA CNAME(19)/'PAGe throw'/
- DATA CNAME(20)/'MINos errs'/
- DATA CNAME(21)/'EPSmachine'/
- DATA CNAME(22)/'OUTputfile'/
- DATA CNAME(23)/'BATch '/
- DATA CNAME(24)/'INTeractiv'/
- DATA CNAME(25)/'VERsion '/
- DATA NNAME/25/
-C options not intended for normal users
- DATA CNAME(26)/'reserve '/
- DATA CNAME(27)/'NODebug '/
- DATA CNAME(28)/'DEBug '/
- DATA CNAME(29)/'SHOw '/
- DATA CNAME(30)/'SET '/
- DATA NNTOT/30/
-C
- DATA CPRLEV(-1)/'-1: NO OUTPUT EXCEPT FROM "SHOW" '/
- DATA CPRLEV( 0)/' 0: REDUCED OUTPUT '/
- DATA CPRLEV( 1)/' 1: NORMAL OUTPUT '/
- DATA CPRLEV( 2)/' 2: EXTRA OUTPUT FOR PROBLEM CASES'/
- DATA CPRLEV( 3)/' 3: MAXIMUM OUTPUT '/
-C
- DATA CSTRAT( 0)/' 0: MINIMIZE THE NUMBER OF CALLS TO FUNCTION'/
- DATA CSTRAT( 1)/' 1: TRY TO BALANCE SPEED AGAINST RELIABILITY'/
- DATA CSTRAT( 2)/' 2: MAKE SURE MINIMUM TRUE, ERRORS CORRECT '/
-C
- DATA CDBOPT(0)/'REPORT ALL EXCEPTIONAL CONDITIONS '/
- DATA CDBOPT(1)/'MNLINE: LINE SEARCH MINIMIZATION '/
- DATA CDBOPT(2)/'MNDERI: FIRST DERIVATIVE CALCULATIONS '/
- DATA CDBOPT(3)/'MNHESS: SECOND DERIVATIVE CALCULATIONS '/
- DATA CDBOPT(4)/'MNMIGR: COVARIANCE MATRIX UPDATES '/
- DATA CDBOPT(5)/'MNHES1: FIRST DERIVATIVE UNCERTAINTIES '/
- DATA CDBOPT(6)/'MNCONT: MNCONTOUR PLOT (MNCROS SEARCH) '/
-C
-C
- DO 2 I= 1, NNTOT
- IF (INDEX(CWORD(4:10),CNAME(I)(1:3)) .GT. 0) GO TO 5
- 2 CONTINUE
- I = 0
- 5 KNAME = I
-C
-C Command could be SET xxx, SHOW xxx, HELP SET or HELP SHOW
- IF (INDEX(CWORD(1:4),'HEL') .GT. 0) GO TO 2000
- IF (INDEX(CWORD(1:4),'SHO') .GT. 0) GO TO 1000
- IF (INDEX(CWORD(1:4),'SET') .EQ. 0) GO TO 1900
-C ---
- CKIND = 'SET '
-C . . . . . . . . . . set unknown
- IF (KNAME .LE. 0) GO TO 1900
-C . . . . . . . . . . set known
- GO TO(3000, 20, 30, 40,3000, 60, 70, 80, 90, 100,
- + 110, 120, 130, 140, 150, 160, 170,3000, 190,3000,
- + 210, 220, 230, 240,3000,1900, 270, 280, 290, 300) , KNAME
-C
-C . . . . . . . . . . set param
- 20 CONTINUE
- IPRM = WORD7(1)
- IF (IPRM .GT. NU) GO TO 25
- IF (IPRM .LE. 0) GO TO 25
- IF (NVARL(IPRM) .LT. 0) GO TO 25
- U(IPRM) = WORD7(2)
- CALL MNEXIN(X)
- ISW2 = ISW(2)
- CALL MNRSET(1)
-C Keep approximate covariance matrix, even if new param value
- ISW(2) = MIN(ISW2,1)
- CFROM = 'SET PARM'
- NFCNFR = NFCN
- CSTATU = 'NEW VALUES'
- GO TO 4000
- 25 WRITE (ISYSWR,'(A/)') ' UNDEFINED PARAMETER NUMBER. IGNORED.'
- GO TO 4000
-C . . . . . . . . . . set limits
- 30 CALL MNLIMS
- GO TO 4000
-C . . . . . . . . . . set covar
- 40 CONTINUE
-C this command must be handled by MNREAD, and is not Fortran-callable
- GO TO 3000
-C . . . . . . . . . . set print
- 60 ISW(5) = WORD7(1)
- GO TO 4000
-C . . . . . . . . . . set nograd
- 70 ISW(3) = 0
- GO TO 4000
-C . . . . . . . . . . set grad
- 80 CALL MNGRAD(FCN,FUTIL)
- GO TO 4000
-C . . . . . . . . . . set errdef
- 90 IF (WORD7(1) .EQ. UP) GO TO 4000
- IF (WORD7(1) .LE. ZERO) THEN
- IF (UP .EQ. UPDFLT) GO TO 4000
- UP = UPDFLT
- ELSE
- UP = WORD7(1)
- ENDIF
- DO 95 I= 1, NPAR
- ERN(I) = 0.
- 95 ERP(I) = 0.
- CALL MNWERR
- GO TO 4000
-C . . . . . . . . . . set input
-C This command must be handled by MNREAD. If it gets this far,
-C it is illegal.
- 100 CONTINUE
- GO TO 3000
-C . . . . . . . . . . set width
- 110 NPAGWD = WORD7(1)
- NPAGWD = MAX(NPAGWD,50)
- GO TO 4000
-C . . . . . . . . . . set lines
- 120 NPAGLN = WORD7(1)
- GO TO 4000
-C . . . . . . . . . . set nowarn
- 130 LWARN = .FALSE.
- GO TO 4000
-C . . . . . . . . . . set warn
- 140 LWARN = .TRUE.
- CALL MNWARN('W','SHO','SHO')
- GO TO 4000
-C . . . . . . . . . . set random
- 150 JSEED = INT(WORD7(1))
- VAL = 3.
- CALL MNRN15(VAL, JSEED)
- IF (ISW(5) .GT. 0) WRITE (ISYSWR, 151) JSEED
- 151 FORMAT (' MINUIT RANDOM NUMBER SEED SET TO ',I10)
- GO TO 4000
-C . . . . . . . . . . set title
- 160 CONTINUE
-C this command must be handled by MNREAD, and is not Fortran-callable
- GO TO 3000
-C . . . . . . . . . set strategy
- 170 ISTRAT = WORD7(1)
- ISTRAT = MAX(ISTRAT,0)
- ISTRAT = MIN(ISTRAT,2)
- IF (ISW(5) .GT. 0) GO TO 1172
- GO TO 4000
-C . . . . . . . . . set page throw
- 190 NEWPAG = WORD7(1)
- GO TO 1190
-C . . . . . . . . . . set epsmac
- 210 IF (WORD7(1).GT.ZERO .AND. WORD7(1).LT.0.1) EPSMAC = WORD7(1)
- EPSMA2 = SQRT(EPSMAC)
- GO TO 1210
-C . . . . . . . . . . set outputfile
- 220 CONTINUE
- IUNIT = WORD7(1)
- ISYSWR = IUNIT
- ISTKWR(1) = IUNIT
- IF (ISW(5) .GE. 0) GO TO 1220
- GO TO 4000
-C . . . . . . . . . . set batch
- 230 ISW(6) = 0
- IF (ISW(5) .GE. 0) GO TO 1100
- GO TO 4000
-C . . . . . . . . . . set interactive
- 240 ISW(6) = 1
- IF (ISW(5) .GE. 0) GO TO 1100
- GO TO 4000
-C . . . . . . . . . . set nodebug
- 270 ISET = 0
- GO TO 281
-C . . . . . . . . . . set debug
- 280 ISET = 1
- 281 CONTINUE
- IDBOPT = WORD7(1)
- IF (IDBOPT .GT. NUMDBG) GO TO 288
- IF (IDBOPT .GE. 0) THEN
- IDBG(IDBOPT) = ISET
- IF (ISET .EQ. 1) IDBG(0) = 1
- ELSE
-C SET DEBUG -1 sets all debug options
- DO 285 ID= 0, NUMDBG
- 285 IDBG(ID) = ISET
- ENDIF
- LREPOR = (IDBG(0) .GE. 1)
- CALL MNWARN('D','SHO','SHO')
- GO TO 4000
- 288 WRITE (ISYSWR,289) IDBOPT
- 289 FORMAT (' UNKNOWN DEBUG OPTION',I6,' REQUESTED. IGNORED')
- GO TO 4000
-C . . . . . . . . . . set show
- 290 CONTINUE
-C . . . . . . . . . . set set
- 300 CONTINUE
- GO TO 3000
-C -----------------------------------------------------
- 1000 CONTINUE
-C at this point, CWORD must be 'SHOW'
- CKIND = 'SHOW'
- IF (KNAME .LE. 0) GO TO 1900
- GO TO (1010,1020,1030,1040,1050,1060,1070,1070,1090,1100,
- + 1110,1120,1130,1130,1150,1160,1170,1180,1190,1200,
- + 1210,1220,1100,1100,1250,1900,1270,1270,1290,1300),KNAME
-C
-C . . . . . . . . . . show fcn
- 1010 CONTINUE
- IF (AMIN .EQ. UNDEFI) CALL MNAMIN(FCN,FUTIL)
- CALL MNPRIN (0,AMIN)
- GO TO 4000
-C . . . . . . . . . . show param
- 1020 CONTINUE
- IF (AMIN .EQ. UNDEFI) CALL MNAMIN(FCN,FUTIL)
- CALL MNPRIN (5,AMIN)
- GO TO 4000
-C . . . . . . . . . . show limits
- 1030 CONTINUE
- IF (AMIN .EQ. UNDEFI) CALL MNAMIN(FCN,FUTIL)
- CALL MNPRIN (1,AMIN)
- GO TO 4000
-C . . . . . . . . . . show covar
- 1040 CALL MNMATU(1)
- GO TO 4000
-C . . . . . . . . . . show corre
- 1050 CALL MNMATU(0)
- GO TO 4000
-C . . . . . . . . . . show print
- 1060 CONTINUE
- IF (ISW(5) .LT.-1) ISW(5) = -1
- IF (ISW(5) .GT. 3) ISW(5) = 3
- WRITE (ISYSWR,'(A)') ' ALLOWED PRINT LEVELS ARE:'
- WRITE (ISYSWR,'(27X,A)') CPRLEV
- WRITE (ISYSWR,1061) CPRLEV(ISW(5))
- 1061 FORMAT (/' CURRENT PRINTOUT LEVEL IS ',A)
- GO TO 4000
-C . . . . . . . show nograd, grad
- 1070 CONTINUE
- IF (ISW(3) .LE. 0) THEN
- WRITE (ISYSWR, 1081)
- 1081 FORMAT(' NOGRAD IS SET. DERIVATIVES NOT COMPUTED IN FCN.')
- ELSE
- WRITE (ISYSWR, 1082)
- 1082 FORMAT(' GRAD IS SET. USER COMPUTES DERIVATIVES IN FCN.')
- ENDIF
- GO TO 4000
-C . . . . . . . . . . show errdef
- 1090 WRITE (ISYSWR, 1091) UP
- 1091 FORMAT (' ERRORS CORRESPOND TO FUNCTION CHANGE OF',G13.5)
- GO TO 4000
-C . . . . . . . . . . show input,
-C batch, or interactive
- 1100 CONTINUE
- INQUIRE(UNIT=ISYSRD,NAMED=LNAME,NAME=CFNAME)
- CMODE = 'BATCH MODE '
- IF (ISW(6) .EQ. 1) CMODE = 'INTERACTIVE MODE'
- IF (.NOT. LNAME) CFNAME='unknown'
- WRITE (ISYSWR,1002) CMODE,ISYSRD,CFNAME
- 1002 FORMAT (' INPUT NOW BEING READ IN ',A,' FROM UNIT NO.',I3/
- + ' FILENAME: ',A)
- GO TO 4000
-C . . . . . . . . . . show width
- 1110 WRITE (ISYSWR,1111) NPAGWD
- 1111 FORMAT (10X,'PAGE WIDTH IS SET TO',I4,' COLUMNS')
- GO TO 4000
-C . . . . . . . . . . show lines
- 1120 WRITE (ISYSWR,1121) NPAGLN
- 1121 FORMAT (10X,'PAGE LENGTH IS SET TO',I4,' LINES')
- GO TO 4000
-C . . . . . . .show nowarn, warn
- 1130 CONTINUE
- CWARN = 'SUPPRESSED'
- IF (LWARN) CWARN = 'REPORTED '
- WRITE (ISYSWR,1141) CWARN
- 1141 FORMAT (' MINUIT WARNING MESSAGES ARE ',A)
- IF (.NOT. LWARN) CALL MNWARN('W','SHO','SHO')
- GO TO 4000
-C . . . . . . . . . . show random
- 1150 VAL = 0.
- CALL MNRN15(VAL,IGRAIN)
- IKSEED = IGRAIN
- WRITE (ISYSWR, 1151) IKSEED
- 1151 FORMAT (' MINUIT RNDM SEED IS CURRENTLY=',I10/)
- VAL = 3.0
- ISEED = IKSEED
- CALL MNRN15(VAL,ISEED)
- GO TO 4000
-C . . . . . . . . . show title
- 1160 WRITE (ISYSWR,'(A,A)') ' TITLE OF CURRENT TASK IS:',CTITL
- GO TO 4000
-C . . . . . . . show strategy
- 1170 WRITE (ISYSWR, '(A)') ' ALLOWED STRATEGIES ARE:'
- WRITE (ISYSWR, '(20X,A)') CSTRAT
- 1172 WRITE (ISYSWR, 1175) CSTRAT(ISTRAT)
- 1175 FORMAT (/' NOW USING STRATEGY ',A/)
- GO TO 4000
-C . . . . . show eigenvalues
- 1180 CONTINUE
- ISWSAV = ISW(5)
- ISW(5) = 3
- IF (ISW(2) .LT. 1) THEN
- WRITE (ISYSWR,'(1X,A)') COVMES(0)
- ELSE
- CALL MNPSDF
- ENDIF
- ISW(5) = ISWSAV
- GO TO 4000
-C . . . . . show page throw
- 1190 WRITE (ISYSWR,'(A,I3)') ' PAGE THROW CARRIAGE CONTROL =',NEWPAG
- IF (NEWPAG .EQ. 0)
- + WRITE (ISYSWR,'(A)') ' NO PAGE THROWS IN MINUIT OUTPUT'
- GO TO 4000
-C . . . . . . show minos errors
- 1200 CONTINUE
- DO 1202 II= 1, NPAR
- IF (ERP(II).GT.ZERO .OR. ERN(II).LT.ZERO) GO TO 1204
- 1202 CONTINUE
- WRITE (ISYSWR,'(A)')
- + ' THERE ARE NO MINOS ERRORS CURRENTLY VALID.'
- GO TO 4000
- 1204 CONTINUE
- CALL MNPRIN(4,AMIN)
- GO TO 4000
-C . . . . . . . . . show epsmac
- 1210 WRITE (ISYSWR,'(A,E12.3)')
- + ' FLOATING-POINT NUMBERS ASSUMED ACCURATE TO',EPSMAC
- GO TO 4000
-C . . . . . . show outputfiles
- 1220 CONTINUE
- WRITE (ISYSWR,'(A,I4)') ' MINUIT PRIMARY OUTPUT TO UNIT',ISYSWR
- GO TO 4000
-C . . . . . . show version
- 1250 CONTINUE
- WRITE (ISYSWR,'(A,A)') ' THIS IS MINUIT VERSION:',CVRSN
- GO TO 4000
-C . . . . . . show nodebug, debug
- 1270 CONTINUE
- DO 1285 ID= 0, NUMDBG
- COPT = 'OFF'
- IF (IDBG(ID) .GE. 1) COPT = 'ON '
- 1285 WRITE (ISYSWR,1286) ID, COPT, CDBOPT(ID)
- 1286 FORMAT (10X,'DEBUG OPTION',I3,' IS ',A3,' :',A)
- IF (.NOT. LREPOR) CALL MNWARN('D','SHO','SHO')
- GO TO 4000
-C . . . . . . . . . . show show
- 1290 CKIND = 'SHOW'
- GO TO 2100
-C . . . . . . . . . . show set
- 1300 CKIND = 'SET '
- GO TO 2100
-
-C -----------------------------------------------------
-C UNKNOWN COMMAND
- 1900 WRITE (ISYSWR, 1901) CWORD
- 1901 FORMAT (' THE COMMAND:',A10,' IS UNKNOWN.'/)
- GO TO 2100
-C -----------------------------------------------------
-C HELP SHOW, HELP SET, SHOW SET, or SHOW SHOW
- 2000 CKIND = 'SET '
- IF (INDEX(CWORD(4:10),'SHO') .GT. 0) CKIND = 'SHOW'
- 2100 WRITE (ISYSWR, 2101) CKIND,CKIND, (CNAME(KK),KK=1,NNAME)
- 2101 FORMAT (' THE FORMAT OF THE ',A4,' COMMAND IS:'//
- + 1X,A4,' xxx [numerical arguments if any]'//
- + ' WHERE xxx MAY BE ONE OF THE FOLLOWING:'/
- + (7X,6A12))
- GO TO 4000
-C -----------------------------------------------------
-C ILLEGAL COMMAND
- 3000 WRITE (ISYSWR,'('' ABOVE COMMAND IS ILLEGAL. IGNORED'')')
- 4000 RETURN
- END
diff --git a/src/packlib/minuit/code/mnseti.F b/src/packlib/minuit/code/mnseti.F
deleted file mode 100644
index 3c43a1a..0000000
--- a/src/packlib/minuit/code/mnseti.F
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: mnseti.F,v 1.1.1.1 1996/03/07 14:31:31 mclareni Exp $
-*
-* $Log: mnseti.F,v $
-* Revision 1.1.1.1 1996/03/07 14:31:31 mclareni
-* Minuit
-*
-*
-#include "minuit/pilot.h"
- SUBROUTINE MNSETI(TIT)
-#include "minuit/d506dp.inc"
-CC Called by user to set or change title of current task.
-CC
-#include "minuit/d506cm.inc"
- CHARACTER*(*) TIT
- CTITL = TIT
- RETURN
- END
diff --git a/src/packlib/minuit/code/mnsimp.F b/src/packlib/minuit/code/mnsimp.F
deleted file mode 100644
index 162cc2e..0000000
--- a/src/packlib/minuit/code/mnsimp.F
+++ /dev/null
@@ -1,203 +0,0 @@
-*
-* $Id: mnsimp.F,v 1.2 1996/03/15 18:02:54 james Exp $
-*
-* $Log: mnsimp.F,v $
-* Revision 1.2 1996/03/15 18:02:54 james
-* Modified Files:
-* mnderi.F eliminate possible division by zero
-* mnexcm.F suppress print on STOP when print flag=-1
-* set FVAL3 to flag if FCN already called with IFLAG=3
-* mninit.F set version 96.03
-* mnlims.F remove arguments, not needed
-* mnmigr.F VLEN -> LENV in debug print statement
-* mnparm.F move call to MNRSET to after NPAR redefined, to zero all
-* mnpsdf.F eliminate possible division by zero
-* mnscan.F suppress printout when print flag =-1
-* mnset.F remove arguments in call to MNLIMS
-* mnsimp.F fix CSTATU so status is PROGRESS only if new minimum
-* mnvert.F eliminate possible division by zero
-*
-* Revision 1.1.1.1 1996/03/07 14:31:31 mclareni
-* Minuit
-*
-*
-#include "minuit/pilot.h"
- SUBROUTINE MNSIMP(FCN,FUTIL)
-#include "minuit/d506dp.inc"
-CC Performs a minimization using the simplex method of Nelder
-CC and Mead (ref. -- Comp. J. 7,308 (1965)).
-CC
-#include "minuit/d506cm.inc"
- EXTERNAL FCN,FUTIL
- DIMENSION Y(MNI+1)
- DATA ALPHA,BETA,GAMMA,RHOMIN,RHOMAX / 1.0, 0.5, 2.0, 4.0, 8.0/
- IF (NPAR .LE. 0) RETURN
- IF (AMIN .EQ. UNDEFI) CALL MNAMIN(FCN,FUTIL)
- CFROM = 'SIMPLEX '
- NFCNFR = NFCN
- CSTATU= 'UNCHANGED '
- NPFN=NFCN
- NPARP1=NPAR+1
- NPARX = NPAR
- RHO1 = 1.0 + ALPHA
- RHO2 = RHO1 + ALPHA*GAMMA
- WG = 1.0/FLOAT(NPAR)
- IF (ISW(5) .GE. 0) WRITE(ISYSWR,100) EPSI
- 100 FORMAT(' START SIMPLEX MINIMIZATION. CONVERGENCE WHEN EDM .LT.'
- +,E10.2 )
- DO 2 I= 1, NPAR
- DIRIN(I) = WERR(I)
- CALL MNDXDI(X(I),I,DXDI)
- IF (DXDI .NE. ZERO) DIRIN(I)=WERR(I)/DXDI
- DMIN = EPSMA2*ABS(X(I))
- IF (DIRIN(I) .LT. DMIN) DIRIN(I)=DMIN
- 2 CONTINUE
-C** choose the initial simplex using single-parameter searches
- 1 CONTINUE
- YNPP1 = AMIN
- JL = NPARP1
- Y(NPARP1) = AMIN
- ABSMIN = AMIN
- DO 10 I= 1, NPAR
- AMING = AMIN
- PBAR(I) = X(I)
- BESTX = X(I)
- KG = 0
- NS = 0
- NF = 0
- 4 X(I) = BESTX + DIRIN(I)
- CALL MNINEX(X)
- CALL FCN(NPARX,GIN, F, U, 4, FUTIL)
- NFCN = NFCN + 1
- IF (F .LT. AMING) GO TO 6
-C failure
- IF (KG .EQ. 1) GO TO 8
- KG = -1
- NF = NF + 1
- DIRIN(I) = DIRIN(I) * (-0.4)
- IF (NF .LT. 3) GO TO 4
-C stop after three failures
- BESTX = X(I)
- DIRIN(I) = DIRIN(I) * 3.0
- AMING = F
- GO TO 8
-C
-C success
- 6 BESTX = X(I)
- DIRIN(I) = DIRIN(I) * 3.0
- AMING = F
- CSTATU= 'PROGRESS '
- KG = 1
- NS = NS + 1
- IF (NS .LT. 6) GO TO 4
-C
-C 3 failures or 6 successes or
-C local minimum found in ith direction
- 8 Y(I) = AMING
- IF (AMING .LT. ABSMIN) JL = I
- IF (AMING .LT. ABSMIN) ABSMIN = AMING
- X(I) = BESTX
- DO 9 K= 1, NPAR
- 9 P(K,I) = X(K)
- 10 CONTINUE
- JH = NPARP1
- AMIN=Y(JL)
- CALL MNRAZZ(YNPP1,PBAR,Y,JH,JL)
- DO 20 I= 1, NPAR
- 20 X(I) = P(I,JL)
- CALL MNINEX(X)
- IF (ISW(5) .GE. 1) CALL MNPRIN(5,AMIN)
- EDM = BIGEDM
- SIG2 = EDM
- NCYCL=0
-C . . . . . start main loop
- 50 CONTINUE
- IF (SIG2 .LT. EPSI .AND. EDM.LT.EPSI) GO TO 76
- SIG2 = EDM
- IF ((NFCN-NPFN) .GT. NFCNMX) GO TO 78
-C calculate new point * by reflection
- DO 60 I= 1, NPAR
- PB = 0.
- DO 59 J= 1, NPARP1
- 59 PB = PB + WG * P(I,J)
- PBAR(I) = PB - WG * P(I,JH)
- 60 PSTAR(I)=(1.+ALPHA)*PBAR(I)-ALPHA*P(I,JH)
- CALL MNINEX(PSTAR)
- CALL FCN(NPARX,GIN,YSTAR,U,4,FUTIL)
- NFCN=NFCN+1
- IF(YSTAR.GE.AMIN) GO TO 70
-C point * better than jl, calculate new point **
- CSTATU = 'PROGRESS '
- DO 61 I=1,NPAR
- 61 PSTST(I)=GAMMA*PSTAR(I)+(1.-GAMMA)*PBAR(I)
- CALL MNINEX(PSTST)
- CALL FCN(NPARX,GIN,YSTST,U,4,FUTIL)
- NFCN=NFCN+1
-C try a parabola through ph, pstar, pstst. min = prho
- Y1 = (YSTAR-Y(JH)) * RHO2
- Y2 = (YSTST-Y(JH)) * RHO1
- RHO = 0.5 * (RHO2*Y1 -RHO1*Y2) / (Y1 -Y2)
- IF (RHO .LT. RHOMIN) GO TO 66
- IF (RHO .GT. RHOMAX) RHO = RHOMAX
- DO 64 I= 1, NPAR
- 64 PRHO(I) = RHO*PBAR(I) + (1.0-RHO)*P(I,JH)
- CALL MNINEX(PRHO)
- CALL FCN(NPARX,GIN,YRHO, U,4,FUTIL)
- NFCN = NFCN + 1
- IF (YRHO .LT. AMIN) CSTATU = 'PROGRESS '
- IF (YRHO .LT. Y(JL) .AND. YRHO .LT. YSTST) GO TO 65
- IF (YSTST .LT. Y(JL)) GO TO 67
- IF (YRHO .GT. Y(JL)) GO TO 66
-C accept minimum point of parabola, PRHO
- 65 CALL MNRAZZ (YRHO,PRHO,Y,JH,JL)
- GO TO 68
- 66 IF (YSTST .LT. Y(JL)) GO TO 67
- CALL MNRAZZ(YSTAR,PSTAR,Y,JH,JL)
- GO TO 68
- 67 CALL MNRAZZ(YSTST,PSTST,Y,JH,JL)
- 68 NCYCL=NCYCL+1
- IF (ISW(5) .LT. 2) GO TO 50
- IF (ISW(5) .GE. 3 .OR. MOD(NCYCL, 10) .EQ. 0) CALL MNPRIN(5,AMIN)
- GO TO 50
-C point * is not as good as jl
- 70 IF (YSTAR .GE. Y(JH)) GO TO 73
- JHOLD = JH
- CALL MNRAZZ(YSTAR,PSTAR,Y,JH,JL)
- IF (JHOLD .NE. JH) GO TO 50
-C calculate new point **
- 73 DO 74 I=1,NPAR
- 74 PSTST(I)=BETA*P(I,JH)+(1.-BETA)*PBAR(I)
- CALL MNINEX (PSTST)
- CALL FCN(NPARX,GIN,YSTST,U,4,FUTIL)
- NFCN=NFCN+1
- IF(YSTST.GT.Y(JH)) GO TO 1
-C point ** is better than jh
- IF (YSTST .LT. AMIN) CSTATU = 'PROGRESS '
- IF (YSTST .LT. AMIN) GO TO 67
- CALL MNRAZZ(YSTST,PSTST,Y,JH,JL)
- GO TO 50
-C . . . . . . end main loop
- 76 IF (ISW(5) .GE. 0) WRITE(ISYSWR,'(A)')
- + ' SIMPLEX MINIMIZATION HAS CONVERGED.'
- ISW(4) = 1
- GO TO 80
- 78 IF (ISW(5) .GE. 0) WRITE(ISYSWR,'(A)')
- + ' SIMPLEX TERMINATES WITHOUT CONVERGENCE.'
- CSTATU= 'CALL LIMIT'
- ISW(4) = -1
- ISW(1) = 1
- 80 DO 82 I=1,NPAR
- PB = 0.
- DO 81 J=1,NPARP1
- 81 PB = PB + WG * P(I,J)
- 82 PBAR(I) = PB - WG * P(I,JH)
- CALL MNINEX(PBAR)
- CALL FCN(NPARX,GIN,YPBAR,U,4,FUTIL)
- NFCN=NFCN+1
- IF (YPBAR .LT. AMIN) CALL MNRAZZ(YPBAR,PBAR,Y,JH,JL)
- CALL MNINEX(X)
- IF (NFCNMX+NPFN-NFCN .LT. 3*NPAR) GO TO 90
- IF (EDM .GT. 2.0*EPSI) GO TO 1
- 90 IF (ISW(5) .GE. 0) CALL MNPRIN(5, AMIN)
- RETURN
- END
diff --git a/src/packlib/minuit/code/mnstat.F b/src/packlib/minuit/code/mnstat.F
deleted file mode 100644
index ad4490f..0000000
--- a/src/packlib/minuit/code/mnstat.F
+++ /dev/null
@@ -1,42 +0,0 @@
-*
-* $Id: mnstat.F,v 1.1.1.1 1996/03/07 14:31:31 mclareni Exp $
-*
-* $Log: mnstat.F,v $
-* Revision 1.1.1.1 1996/03/07 14:31:31 mclareni
-* Minuit
-*
-*
-#include "minuit/pilot.h"
- SUBROUTINE MNSTAT(FMIN,FEDM,ERRDEF,NPARI,NPARX,ISTAT)
-#include "minuit/d506dp.inc"
-CC User-called
-CC Provides the user with information concerning the current status
-CC of the current minimization. Namely, it returns:
-CC FMIN: the best function value found so far
-CC FEDM: the estimated vertical distance remaining to minimum
-CC ERRDEF: the value of UP defining parameter uncertainties
-CC NPARI: the number of currently variable parameters
-CC NPARX: the highest (external) parameter number defined by user
-CC ISTAT: a status integer indicating how good is the covariance
-CC matrix: 0= not calculated at all
-CC 1= approximation only, not accurate
-CC 2= full matrix, but forced positive-definite
-CC 3= full accurate covariance matrix
-CC
-#include "minuit/d506cm.inc"
- FMIN = AMIN
- FEDM = EDM
- ERRDEF = UP
- NPARI = NPAR
- NPARX = NU
- ISTAT = ISW(2)
- IF (EDM .EQ. BIGEDM) THEN
- FEDM = UP
- ENDIF
- IF (AMIN .EQ. UNDEFI) THEN
- FMIN = 0.0
- FEDM = UP
- ISTAT= 0
- ENDIF
- RETURN
- END
diff --git a/src/packlib/minuit/code/mnstin.F b/src/packlib/minuit/code/mnstin.F
deleted file mode 100644
index 872355c..0000000
--- a/src/packlib/minuit/code/mnstin.F
+++ /dev/null
@@ -1,175 +0,0 @@
-*
-* $Id: mnstin.F,v 1.1.1.1 1996/03/07 14:31:32 mclareni Exp $
-*
-* $Log: mnstin.F,v $
-* Revision 1.1.1.1 1996/03/07 14:31:32 mclareni
-* Minuit
-*
-*
-#include "minuit/pilot.h"
- SUBROUTINE MNSTIN(CRDBUF,IERR)
-#include "minuit/d506dp.inc"
-CC Called from MNREAD.
-CC Implements the SET INPUT command to change input units.
-CC If command is: 'SET INPUT' 'SET INPUT 0' or '*EOF',
-CC or 'SET INPUT , , ',
-CC reverts to previous input unit number,if any.
-CC
-CC If it is: 'SET INPUT n' or 'SET INPUT n filename',
-CC changes to new input file, added to stack
-CC
-CC IERR = 0: reading terminated normally
-CC 2: end-of-data on primary input file
-CC 3: unrecoverable read error
-CC 4: unable to process request
-CC
-#include "minuit/d506cm.inc"
- CHARACTER CRDBUF*(*),CUNIT*10,CFNAME*64,CGNAME*64,CANSWR*1
- CHARACTER CMODE*16
- LOGICAL LOPEN,LREWIN,NONAME,LNAME,MNUNPT
- NONAME = .TRUE.
- IERR = 0
- IF (INDEX(CRDBUF,'*EOF') .EQ. 1) GO TO 190
- IF (INDEX(CRDBUF,'*eof') .EQ. 1) GO TO 190
- LEND = LEN(CRDBUF)
-C look for end of SET INPUT command
- DO 20 IC= 8,LEND
- IF (CRDBUF(IC:IC) .EQ. ' ') GO TO 25
- IF (CRDBUF(IC:IC) .EQ. ',') GO TO 53
- 20 CONTINUE
- GO TO 200
- 25 CONTINUE
-C look for end of separator between command and first argument
- ICOL = IC+1
- DO 50 IC= ICOL,LEND
- IF (CRDBUF(IC:IC) .EQ. ' ') GO TO 50
- IF (CRDBUF(IC:IC) .EQ. ',') GO TO 53
- GO TO 55
- 50 CONTINUE
- GO TO 200
- 53 IC = IC + 1
- 55 IC1 = IC
-C see if "REWIND" was requested in command
- LREWIN = .FALSE.
- IF (INDEX(CRDBUF(1:IC1),'REW') .GT. 5) LREWIN=.TRUE.
- IF (INDEX(CRDBUF(1:IC1),'rew') .GT. 5) LREWIN=.TRUE.
-C first argument begins in or after col IC1
- DO 75 IC= IC1,LEND
- IF (CRDBUF(IC:IC) .EQ. ' ') GO TO 75
- IF (CRDBUF(IC:IC) .EQ. ',') GO TO 200
- GO TO 80
- 75 CONTINUE
- GO TO 200
- 80 IC1 = IC
-C first argument really begins in col IC1
- DO 100 IC= IC1+1,LEND
- IF (CRDBUF(IC:IC) .EQ. ' ') GO TO 108
- IF (CRDBUF(IC:IC) .EQ. ',') GO TO 108
- 100 CONTINUE
- IC = LEND + 1
- 108 IC2 = IC-1
-C end of first argument is in col IC2
- 110 CONTINUE
- CUNIT = CRDBUF(IC1:IC2)
- WRITE (ISYSWR,'(A,A)') ' UNIT NO. :',CUNIT
- READ (CUNIT,'(BN,F10.0)',ERR=500) FUNIT
- IUNIT = FUNIT
- IF (IUNIT .EQ. 0) GO TO 200
-C skip blanks and commas, find file name
- DO 120 IC= IC2+1,LEND
- IF (CRDBUF(IC:IC) .EQ. ' ') GO TO 120
- IF (CRDBUF(IC:IC) .EQ. ',') GO TO 120
- GO TO 130
- 120 CONTINUE
- GO TO 131
- 130 CONTINUE
- CFNAME = CRDBUF(IC:LEND)
- NONAME = .FALSE.
- WRITE (ISYSWR, '(A,A)') ' FILE NAME IS:',CFNAME
-C ask if file exists, if not ask for name and open it
- 131 CONTINUE
- INQUIRE(UNIT=IUNIT,OPENED=LOPEN,NAMED=LNAME,NAME=CGNAME)
- IF (LOPEN) THEN
- IF (NONAME) THEN
- GO TO 136
- ELSE
- IF (.NOT.LNAME) CGNAME='unknown'
- WRITE (ISYSWR,132) IUNIT,CGNAME,CFNAME
- 132 FORMAT (' UNIT',I3,' ALREADY OPENED WITH NAME:',A/
- + ' NEW NAME IGNORED:',A)
- ENDIF
- ELSE
-C new file, open it
- WRITE (ISYSWR,135) IUNIT
- 135 FORMAT (' UNIT',I3,' IS NOT OPENED.')
- IF (NONAME) THEN
- WRITE (ISYSWR,'(A)') ' NO FILE NAME GIVEN IN COMMAND.'
- IF (ISW(6) .LT. 1) GO TO 800
- WRITE (ISYSWR,'(A)') ' PLEASE GIVE FILE NAME:'
- READ (ISYSRD,'(A)') CFNAME
- ENDIF
- OPEN (UNIT=IUNIT,FILE=CFNAME,STATUS='OLD',ERR=600)
- WRITE (ISYSWR,'(A)') ' FILE OPENED SUCCESSFULLY.'
- ENDIF
-C . . file is correctly opened
- 136 IF (LREWIN) GO TO 150
- IF (ISW(6) .LT. 1) GO TO 300
- WRITE (ISYSWR,137) IUNIT
- 137 FORMAT (' SHOULD UNIT',I3,' BE REWOUND?' )
- READ (ISYSRD,'(A)') CANSWR
- IF (CANSWR.NE.'Y' .AND. CANSWR.NE.'y') GO TO 300
- 150 REWIND IUNIT
- GO TO 300
-C *EOF
- 190 CONTINUE
- IF (NSTKRD .EQ. 0) THEN
- IERR = 2
- GO TO 900
- ENDIF
-C revert to previous input file
- 200 CONTINUE
- IF (NSTKRD .EQ. 0) THEN
- WRITE (ISYSWR, '(A,A)') ' COMMAND IGNORED:',CRDBUF
- WRITE (ISYSWR, '(A)') ' ALREADY READING FROM PRIMARY INPUT'
- ELSE
- ISYSRD = ISTKRD(NSTKRD)
- NSTKRD = NSTKRD - 1
- IF (NSTKRD .EQ. 0) ISW(6) = IABS(ISW(6))
- IF (ISW(5) .GE. 0) THEN
- INQUIRE(UNIT=ISYSRD,NAMED=LNAME,NAME=CFNAME)
- CMODE = 'BATCH MODE '
- IF (ISW(6) .EQ. 1) CMODE = 'INTERACTIVE MODE'
- IF (.NOT.LNAME) CFNAME='unknown'
- IF (MNUNPT(CFNAME)) CFNAME='unprintable'
- WRITE (ISYSWR,290) CMODE,ISYSRD,CFNAME
- 290 FORMAT (' INPUT WILL NOW BE READ IN ',A,' FROM UNIT NO.',I3/
- + ' FILENAME: ',A)
- ENDIF
- ENDIF
- GO TO 900
-C switch to new input file, add to stack
- 300 CONTINUE
- IF (NSTKRD .GE. MAXSTK) THEN
- WRITE (ISYSWR, '(A)') ' INPUT FILE STACK SIZE EXCEEDED.'
- GO TO 800
- ENDIF
- NSTKRD = NSTKRD + 1
- ISTKRD(NSTKRD) = ISYSRD
- ISYSRD = IUNIT
-C ISW(6) = 0 for batch, =1 for interactive, and
-C =-1 for originally interactive temporarily batch
- IF (ISW(6) .EQ. 1) ISW(6) = -1
- GO TO 900
-C format error
- 500 CONTINUE
- WRITE (ISYSWR,'(A,A)') ' CANNOT READ FOLLOWING AS INTEGER:',CUNIT
- GO TO 800
- 600 CONTINUE
- WRITE (ISYSWR, 601) CFNAME
- 601 FORMAT (' SYSTEM IS UNABLE TO OPEN FILE:',A)
-C serious error
- 800 CONTINUE
- IERR = 3
- 900 CONTINUE
- RETURN
- END
diff --git a/src/packlib/minuit/code/mntiny.F b/src/packlib/minuit/code/mntiny.F
deleted file mode 100644
index dabbdcd..0000000
--- a/src/packlib/minuit/code/mntiny.F
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: mntiny.F,v 1.1.1.1 1996/03/07 14:31:32 mclareni Exp $
-*
-* $Log: mntiny.F,v $
-* Revision 1.1.1.1 1996/03/07 14:31:32 mclareni
-* Minuit
-*
-*
-#include "minuit/pilot.h"
- SUBROUTINE MNTINY(EPSP1,EPSBAK)
-#include "minuit/d506dp.inc"
-CC Compares its argument with the value 1.0, and returns
-CC the value .TRUE. if they are equal. To find EPSMAC
-CC safely by foiling the Fortran optimizer
-CC
- PARAMETER (ONE=1.0)
- EPSBAK = EPSP1 - ONE
- RETURN
- END
diff --git a/src/packlib/minuit/code/mnunpt.F b/src/packlib/minuit/code/mnunpt.F
deleted file mode 100644
index 645d7fa..0000000
--- a/src/packlib/minuit/code/mnunpt.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: mnunpt.F,v 1.1.1.1 1996/03/07 14:31:32 mclareni Exp $
-*
-* $Log: mnunpt.F,v $
-* Revision 1.1.1.1 1996/03/07 14:31:32 mclareni
-* Minuit
-*
-*
-#include "minuit/pilot.h"
- LOGICAL FUNCTION MNUNPT(CFNAME)
-C is .TRUE. if CFNAME contains unprintable characters.
- CHARACTER CFNAME*(*)
- CHARACTER CPT*80, CP1*40,CP2*40
- PARAMETER (CP1=' ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklm')
- PARAMETER (CP2='nopqrstuvwxyz1234567890./;:[]$%*_!@#&+()')
- CPT=CP1//CP2
- MNUNPT = .FALSE.
- L = LEN(CFNAME)
- DO 100 I= 1, L
- DO 50 IC= 1, 80
- IF (CFNAME(I:I) .EQ. CPT(IC:IC)) GO TO 100
- 50 CONTINUE
- MNUNPT = .TRUE.
- GO TO 150
- 100 CONTINUE
- 150 CONTINUE
- RETURN
- END
diff --git a/src/packlib/minuit/code/mnvers.F b/src/packlib/minuit/code/mnvers.F
deleted file mode 100644
index 4e78195..0000000
--- a/src/packlib/minuit/code/mnvers.F
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: mnvers.F,v 1.1.1.1 1996/03/07 14:31:32 mclareni Exp $
-*
-* $Log: mnvers.F,v $
-* Revision 1.1.1.1 1996/03/07 14:31:32 mclareni
-* Minuit
-*
-*
-#include "minuit/pilot.h"
- SUBROUTINE MNVERS(CV)
-#include "minuit/d506dp.inc"
-CC Returns the Minuit version in CV, char*6
-CC
-#include "minuit/d506cm.inc"
- CHARACTER*(*) CV
- CV = CVRSN
- RETURN
- END
diff --git a/src/packlib/minuit/code/mnvert.F b/src/packlib/minuit/code/mnvert.F
deleted file mode 100644
index 2059870..0000000
--- a/src/packlib/minuit/code/mnvert.F
+++ /dev/null
@@ -1,77 +0,0 @@
-*
-* $Id: mnvert.F,v 1.2 1996/03/15 18:02:54 james Exp $
-*
-* $Log: mnvert.F,v $
-* Revision 1.2 1996/03/15 18:02:54 james
-* Modified Files:
-* mnderi.F eliminate possible division by zero
-* mnexcm.F suppress print on STOP when print flag=-1
-* set FVAL3 to flag if FCN already called with IFLAG=3
-* mninit.F set version 96.03
-* mnlims.F remove arguments, not needed
-* mnmigr.F VLEN -> LENV in debug print statement
-* mnparm.F move call to MNRSET to after NPAR redefined, to zero all
-* mnpsdf.F eliminate possible division by zero
-* mnscan.F suppress printout when print flag =-1
-* mnset.F remove arguments in call to MNLIMS
-* mnsimp.F fix CSTATU so status is PROGRESS only if new minimum
-* mnvert.F eliminate possible division by zero
-*
-* Revision 1.1.1.1 1996/03/07 14:31:32 mclareni
-* Minuit
-*
-*
-#include "minuit/pilot.h"
- SUBROUTINE MNVERT(A,L,M,N,IFAIL)
-#include "minuit/d506dp.inc"
-CC inverts a symmetric matrix. matrix is first scaled to
-CC have all ones on the diagonal (equivalent to change of units)
-CC but no pivoting is done since matrix is positive-definite.
-CC
-#include "minuit/d506cm.inc"
- DIMENSION A(L,M) ,PP(MNI), Q(MNI), S(MNI)
- IFAIL=0
- IF (N .LT. 1) GO TO 100
- IF (N .GT. MAXINT) GO TO 100
-C scale matrix by sqrt of diag elements
- DO 8 I=1,N
- SI = A(I,I)
- IF (SI) 100,100,8
- 8 S(I) = 1.0/SQRT(SI)
- DO 20 I= 1, N
- DO 20 J= 1, N
- 20 A(I,J) = A(I,J) *S(I)*S(J)
-C . . . start main loop . . . .
- DO 65 I=1,N
- K = I
-C preparation for elimination step1
- IF (A(K,K) .EQ. ZERO) GO TO 100
- Q(K)=1./A(K,K)
- PP(K) = 1.0
- A(K,K)=0.0
- KP1=K+1
- KM1=K-1
- IF(KM1)100,50,40
- 40 DO 49 J=1,KM1
- PP(J)=A(J,K)
- Q(J)=A(J,K)*Q(K)
- 49 A(J,K)=0.
- 50 IF(K-N)51,60,100
- 51 DO 59 J=KP1,N
- PP(J)=A(K,J)
- Q(J)=-A(K,J)*Q(K)
- 59 A(K,J)=0.0
-C elimination proper
- 60 DO 65 J=1,N
- DO 65 K=J,N
- 65 A(J,K)=A(J,K)+PP(J)*Q(K)
-C elements of left diagonal and unscaling
- DO 70 J= 1, N
- DO 70 K= 1, J
- A(K,J) = A(K,J) *S(K)*S(J)
- 70 A(J,K) = A(K,J)
- RETURN
-C failure return
- 100 IFAIL=1
- RETURN
- END
diff --git a/src/packlib/minuit/code/mnwarn.F b/src/packlib/minuit/code/mnwarn.F
deleted file mode 100644
index 84b5608..0000000
--- a/src/packlib/minuit/code/mnwarn.F
+++ /dev/null
@@ -1,89 +0,0 @@
-*
-* $Id: mnwarn.F,v 1.1.1.1 1996/03/07 14:31:32 mclareni Exp $
-*
-* $Log: mnwarn.F,v $
-* Revision 1.1.1.1 1996/03/07 14:31:32 mclareni
-* Minuit
-*
-*
-#include "minuit/pilot.h"
- SUBROUTINE MNWARN(COPT,CORG,CMES)
-C If COPT='W', CMES is a WARning message from CORG.
-C If COPT='D', CMES is a DEBug message from CORG.
-C If SET WARnings is in effect (the default), this routine
-C prints the warning message CMES coming from CORG.
-C If SET NOWarnings is in effect, the warning message is
-C stored in a circular buffer of length MAXMES.
-C If called with CORG=CMES='SHO', it prints the messages in
-C the circular buffer, FIFO, and empties the buffer.
-#include "minuit/d506dp.inc"
-#include "minuit/d506cm.inc"
- CHARACTER COPT*1, CORG*(*), CMES*(*), CTYP*7
- PARAMETER (MAXMES=10)
- CHARACTER ORIGIN(MAXMES,2)*10, WARMES(MAXMES,2)*60
- COMMON/MN7WRC/ORIGIN, WARMES
- COMMON/MN7WRI/NFCWAR(MAXMES,2),ICIRC(2)
- CHARACTER ENGLSH*20
-C
- IF (CORG(1:3).EQ.'SHO' .AND. CMES(1:3).EQ.'SHO') GO TO 200
-C Either print warning or put in buffer
- IF (COPT .EQ. 'W') THEN
- ITYP = 1
- IF (LWARN) THEN
- WRITE (ISYSWR,'(A,A/A,A)') ' MINUIT WARNING IN ',CORG,
- + ' ============== ',CMES
- RETURN
- ENDIF
- ELSE
- ITYP = 2
- IF (LREPOR) THEN
- WRITE (ISYSWR,'(A,A/A,A)') ' MINUIT DEBUG FOR ',CORG,
- + ' ============== ',CMES
- RETURN
- ENDIF
- ENDIF
-C if appropriate flag is off, fill circular buffer
- IF (NWRMES(ITYP) .EQ. 0) ICIRC(ITYP) = 0
- NWRMES(ITYP) = NWRMES(ITYP) + 1
- ICIRC(ITYP) = ICIRC(ITYP) + 1
- IF (ICIRC(ITYP) .GT. MAXMES) ICIRC(ITYP) = 1
- IC = ICIRC(ITYP)
- ORIGIN(IC,ITYP) = CORG
- WARMES(IC,ITYP) = CMES
- NFCWAR(IC,ITYP) = NFCN
- RETURN
-C
-C 'SHO WARnings', ask if any suppressed mess in buffer
- 200 CONTINUE
- IF (COPT .EQ. 'W') THEN
- ITYP = 1
- CTYP = 'WARNING'
- ELSE
- ITYP = 2
- CTYP = '*DEBUG*'
- ENDIF
- IF (NWRMES(ITYP) .GT. 0) THEN
- ENGLSH = ' WAS SUPPRESSED. '
- IF (NWRMES(ITYP) .GT. 1) ENGLSH = 'S WERE SUPPRESSED.'
- WRITE (ISYSWR,'(/1X,I5,A,A,A,A/)') NWRMES(ITYP),
- + ' MINUIT ',CTYP,' MESSAGE', ENGLSH
- NM = NWRMES(ITYP)
- IC = 0
- IF (NM .GT. MAXMES) THEN
- WRITE (ISYSWR,'(A,I2,A)') ' ONLY THE MOST RECENT ',
- + MAXMES,' WILL BE LISTED BELOW.'
- NM = MAXMES
- IC = ICIRC(ITYP)
- ENDIF
- WRITE (ISYSWR,'(A)') ' CALLS ORIGIN MESSAGE'
- DO 300 I= 1, NM
- IC = IC + 1
- IF (IC .GT. MAXMES) IC = 1
- WRITE (ISYSWR,'(1X,I6,1X,A,1X,A)')
- + NFCWAR(IC,ITYP),ORIGIN(IC,ITYP),WARMES(IC,ITYP)
- 300 CONTINUE
- NWRMES(ITYP) = 0
- WRITE (ISYSWR,'(1H )')
- ENDIF
- RETURN
- END
diff --git a/src/packlib/minuit/code/mnwerr.F b/src/packlib/minuit/code/mnwerr.F
deleted file mode 100644
index 066566d..0000000
--- a/src/packlib/minuit/code/mnwerr.F
+++ /dev/null
@@ -1,57 +0,0 @@
-*
-* $Id: mnwerr.F,v 1.1.1.1 1996/03/07 14:31:32 mclareni Exp $
-*
-* $Log: mnwerr.F,v $
-* Revision 1.1.1.1 1996/03/07 14:31:32 mclareni
-* Minuit
-*
-*
-#include "minuit/pilot.h"
- SUBROUTINE MNWERR
-#include "minuit/d506dp.inc"
-CC Calculates the WERR, external parameter errors,
-CC and the global correlation coefficients, to be called
-CC whenever a new covariance matrix is available.
-CC
-#include "minuit/d506cm.inc"
-C calculate external error if v exists
- IF (ISW(2) .GE. 1) THEN
- DO 100 L= 1, NPAR
- NDEX = L*(L+1)/2
- DX = SQRT(ABS(VHMAT(NDEX)*UP))
- I = NEXOFI(L)
- IF (NVARL(I) .GT. 1) THEN
- AL = ALIM(I)
- BA = BLIM(I) - AL
- DU1 = AL + 0.5 *(SIN(X(L)+DX) +1.0) * BA - U(I)
- DU2 = AL + 0.5 *(SIN(X(L)-DX) +1.0) * BA - U(I)
- IF (DX .GT. 1.0) DU1 = BA
- DX = 0.5 * (ABS(DU1) + ABS(DU2))
- ENDIF
- WERR(L) = DX
- 100 CONTINUE
- ENDIF
-C global correlation coefficients
- IF (ISW(2) .GE. 1) THEN
- DO 130 I= 1, NPAR
- GLOBCC(I) = 0.
- K1 = I*(I-1)/2
- DO 130 J= 1, I
- K = K1 + J
- P(I,J) = VHMAT(K)
- 130 P(J,I) = P(I,J)
- CALL MNVERT(P,MAXINT,MAXINT,NPAR,IERR)
- IF (IERR .EQ. 0) THEN
- DO 150 IIN= 1, NPAR
- NDIAG = IIN*(IIN+1)/2
- DENOM = P(IIN,IIN)*VHMAT(NDIAG)
- IF (DENOM.LE.ONE .AND. DENOM.GE.ZERO) THEN
- GLOBCC(IIN) = 0.
- ELSE
- GLOBCC(IIN) = SQRT(1.0-1.0/DENOM)
- ENDIF
- 150 CONTINUE
- ENDIF
- ENDIF
- RETURN
- END
diff --git a/src/packlib/minuit/code/stand.F b/src/packlib/minuit/code/stand.F
deleted file mode 100644
index be178e4..0000000
--- a/src/packlib/minuit/code/stand.F
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: stand.F,v 1.1.1.1 1996/03/07 14:31:30 mclareni Exp $
-*
-* $Log: stand.F,v $
-* Revision 1.1.1.1 1996/03/07 14:31:30 mclareni
-* Minuit
-*
-*
-#include "minuit/pilot.h"
- SUBROUTINE STAND
-#include "minuit/d506dp.inc"
-CC optional user-supplied subroutine is called whenever the
-CC command "standard" appears.
-CC
- RETURN
- END
diff --git a/src/packlib/minuit/examples/Imakefile b/src/packlib/minuit/examples/Imakefile
deleted file mode 100644
index 335b494..0000000
--- a/src/packlib/minuit/examples/Imakefile
+++ /dev/null
@@ -1,14 +0,0 @@
-SRCS_F= fcnk0.F minexam.F
-OBJS = fcnk0.o minexam.o
-
-FORTRANSAVEOPTION=FortranSaveFlags
-
-DefinePackageLibrary(NullParameter)
-
-#ifdef CERNLIB_WINNT
-FDEBUGFLAGS=NoOpFortranDebugFlags
-#endif
-
-CernlibFortranProgramTarget(minuit,$(OBJS),$(PACKAGE_LIB),$(PACKAGE_LIB),NullParameter)
-
-TestTarget(minuit,NullParameter,NullParameter)
diff --git a/src/packlib/minuit/examples/fcnk0.F b/src/packlib/minuit/examples/fcnk0.F
deleted file mode 100644
index 98f7305..0000000
--- a/src/packlib/minuit/examples/fcnk0.F
+++ /dev/null
@@ -1,133 +0,0 @@
-*
-* $Id: fcnk0.F,v 1.2 2006/09/15 09:35:30 mclareni Exp $
-*
-* $Log: fcnk0.F,v $
-* Revision 1.2 2006/09/15 09:35:30 mclareni
-* Submitted mods for gcc4/gfortran and MacOSX, corrected to work also on slc4 with gcc3.4 and 4.1
-*
-* Revision 1.1.1.1 1996/03/07 14:31:32 mclareni
-* Minuit
-*
-*
-#include "minuit/pilot.h"
- SUBROUTINE FCNK0(NPAR,GIN,F,X,IFLAG)
-#include "minuit/d506dp.inc"
- REAL THPLUI, THMINI
- DIMENSION X(*),GIN(*)
- PARAMETER (MXBIN=50)
- DIMENSION THPLU(MXBIN),THMIN(MXBIN),T(MXBIN),
- + EVTP(MXBIN),EVTM(MXBIN)
- DATA NBINS,NEVTOT/ 30,250/
- DATA (EVTP(IGOD),IGOD=1,30)
- + /11., 9., 13., 13., 17., 9., 1., 7., 8., 9.,
- + 6., 4., 6., 3., 7., 4., 7., 3., 8., 4.,
- + 6., 5., 7., 2., 7., 1., 4., 1., 4., 5./
- DATA (EVTM(IGOD),IGOD=1,30)
- + / 0., 0., 0., 0., 0., 0., 0., 0., 1., 1.,
- + 0., 2., 1., 4., 4., 2., 4., 2., 2., 0.,
- + 2., 3., 7., 2., 3., 6., 2., 4., 1., 5./
-#if defined(CERNLIB_GFORTRAN)
- save
-#endif
-C
- XRE = X(1)
- XIM = X(2)
- DM = X(5)
- GAMS = 1.0/X(10)
- GAML = 1.0/X(11)
- GAMLS = 0.5*(GAML+GAMS)
- IF (IFLAG .NE. 1) GO TO 300
-C generate random data
- STHPLU = 0.
- STHMIN = 0.
- DO 200 I= 1, NBINS
- T(I) = 0.1*REAL(I)
- TI = T(I)
- EHALF = EXP(-TI*GAMLS)
- TH = ((1.0-XRE)**2 + XIM**2) * EXP(-TI*GAML)
- TH = TH + ((1.0+XRE)**2 + XIM**2) * EXP(-TI*GAMS)
- TH = TH - 4.0*XIM*SIN(DM*TI) * EHALF
- STERM = 2.0*(1.0-XRE**2-XIM**2)*COS(DM*TI) * EHALF
- THPLU(I) = TH + STERM
- THMIN(I) = TH - STERM
- STHPLU = STHPLU + THPLU(I)
- STHMIN = STHMIN + THMIN(I)
- 200 CONTINUE
- NEVPLU = REAL(NEVTOT)*(STHPLU/(STHPLU+STHMIN))
- NEVMIN = REAL(NEVTOT)*(STHMIN/(STHPLU+STHMIN))
- WRITE (6,'(A)') ' LEPTONIC K ZERO DECAYS'
- WRITE (6,'(A,3I10)') ' PLUS, MINUS, TOTAL=',NEVPLU,NEVMIN,NEVTOT
- WRITE (6,'(A)')
- + '0 TIME THEOR+ EXPTL+ THEOR- EXPTL-'
- SEVTP = 0.
- SEVTM = 0.
- DO 250 I= 1, NBINS
- THPLU(I) = THPLU(I)*REAL(NEVPLU) / STHPLU
- THMIN(I) = THMIN(I)*REAL(NEVMIN) / STHMIN
- THPLUI = THPLU(I)
-CCC CALL POISSN(THPLUI,NP,IERROR)
-CCC EVTP(I) = NP
- SEVTP = SEVTP + EVTP(I)
- THMINI = THMIN(I)
-CCC CALL POISSN(THMINI,NM,IERROR)
-CCC EVTM(I) = NM
- SEVTM = SEVTM + EVTM(I)
- IF (IFLAG .NE. 4)
- + WRITE (6,'(1X,5G12.4)') T(I),THPLU(I),EVTP(I),THMIN(I),EVTM(I)
- 250 CONTINUE
- WRITE (6, '(A,2F10.2)') ' DATA EVTS PLUS, MINUS=', SEVTP,SEVTM
-C calculate chisquared
- 300 CONTINUE
- CHISQ = 0.
- STHPLU = 0.
- STHMIN = 0.
- DO 400 I= 1, NBINS
- TI = T(I)
- EHALF = EXP(-TI*GAMLS)
- TH = ((1.0-XRE)**2 + XIM**2) * EXP(-TI*GAML)
- TH = TH + ((1.0+XRE)**2 + XIM**2) * EXP(-TI*GAMS)
- TH = TH - 4.0*XIM*SIN(DM*TI) * EHALF
- STERM = 2.0*(1.0-XRE**2-XIM**2)*COS(DM*TI) * EHALF
- THPLU(I) = TH + STERM
- THMIN(I) = TH - STERM
- STHPLU = STHPLU + THPLU(I)
- STHMIN = STHMIN + THMIN(I)
- 400 CONTINUE
- THP = 0.
- THM = 0.
- EVP = 0.
- EVM = 0.
- IF (IFLAG .NE. 4) WRITE (6,'(1H0,10X,A,20X,A)')
- + 'POSITIVE LEPTONS','NEGATIVE LEPTONS'
- IF (IFLAG .NE. 4) WRITE (6,'(A,3X,A)')
- + ' TIME THEOR EXPTL CHISQ',
- + ' TIME THEOR EXPTL CHISQ'
-C
- DO 450 I= 1, NBINS
- THPLU(I) = THPLU(I)*SEVTP / STHPLU
- THMIN(I) = THMIN(I)*SEVTM / STHMIN
- THP = THP + THPLU(I)
- THM = THM + THMIN(I)
- EVP = EVP + EVTP(I)
- EVM = EVM + EVTM(I)
-C Sum over bins until at least four events found
- IF (EVP .GT. 3.) THEN
- CHI1 = (EVP-THP)**2/EVP
- CHISQ = CHISQ + CHI1
- IF (IFLAG .NE. 4)
- + WRITE (6,'(1X,4F9.3)') T(I),THP,EVP,CHI1
- THP = 0.
- EVP = 0.
- ENDIF
- IF (EVM .GT. 3) THEN
- CHI2 = (EVM-THM)**2/EVM
- CHISQ = CHISQ + CHI2
- IF (IFLAG .NE. 4)
- + WRITE (6,'(42X,4F9.3)') T(I),THM,EVM,CHI2
- THM = 0.
- EVM = 0.
- ENDIF
- 450 CONTINUE
- F = CHISQ
- RETURN
- END
diff --git a/src/packlib/minuit/examples/minexam.F b/src/packlib/minuit/examples/minexam.F
deleted file mode 100644
index b7626b5..0000000
--- a/src/packlib/minuit/examples/minexam.F
+++ /dev/null
@@ -1,47 +0,0 @@
-*
-* $Id: minexam.F,v 1.1.1.1 1996/03/07 14:31:32 mclareni Exp $
-*
-* $Log: minexam.F,v $
-* Revision 1.1.1.1 1996/03/07 14:31:32 mclareni
-* Minuit
-*
-*
-#include "minuit/pilot.h"
- PROGRAM MNEXAM
-C Minuit test case. Fortran-callable.
-C Fit randomly-generated leptonic K0 decays to the
-C time distribution expected for interfering K1 and K2,
-C with free parameters Re(X), Im(X), DeltaM, and GammaS.
-#include "minuit/d506dp.inc"
- EXTERNAL FCNK0
-CC OPEN (UNIT=6,FILE='DSDQ.OUT',STATUS='NEW',FORM='FORMATTED')
- DIMENSION NPRM(5),VSTRT(5),STP(5)
- CHARACTER*10 PNAM(5)
- DATA NPRM / 1 , 2 , 5 , 10 , 11 /
- DATA PNAM /'Re(X)', 'Im(X)', 'Delta M','T Kshort','T Klong'/
- DATA VSTRT/ 0. , 0. , .535 , .892 , 518.3 /
- DATA STP / 0.1 , 0.1 , 0.1 , 0. , 0. /
- DATA ZERO,ONE,THREE,FIVE / 0., 1., 3., 5. /
- CALL MNINIT(5,6,7)
- DO 11 I= 1, 5
- CALL MNPARM(NPRM(I),PNAM(I),VSTRT(I),STP(I),ZERO,ZERO,IERFLG)
- IF (IERFLG .NE. 0) THEN
- WRITE (6,'(A,I3)') ' UNABLE TO DEFINE PARAMETER NO.',I
- STOP
- ENDIF
- 11 CONTINUE
-C
- CALL MNSETI('Time Distribution of Leptonic K0 Decays')
-C Request FCN to read in (or generate random) data (IFLAG=1)
- CALL MNEXCM(FCNK0, 'CALL FCN', ONE ,1,IERFLG, 0)
-C
- CALL MNEXCM(FCNK0,'FIX', FIVE ,1,IERFLG,0)
- CALL MNEXCM(FCNK0,'SET PRINT', ZERO ,1,IERFLG,0)
- CALL MNEXCM(FCNK0,'MIGRAD', ZERO ,0,IERFLG,0)
- CALL MNEXCM(FCNK0,'MINOS', ZERO ,0,IERFLG,0)
- CALL MNEXCM(FCNK0,'RELEASE', FIVE ,1,IERFLG,0)
- CALL MNEXCM(FCNK0,'MIGRAD', ZERO ,0,IERFLG,0)
- CALL MNEXCM(FCNK0,'MINOS', ZERO ,0,IERFLG,0)
- CALL MNEXCM(FCNK0,'CALL FCN', THREE , 1,IERFLG,0)
- STOP
- END
diff --git a/src/packlib/minuit/minuit/Imakefile b/src/packlib/minuit/minuit/Imakefile
deleted file mode 100644
index 6e16f8a..0000000
--- a/src/packlib/minuit/minuit/Imakefile
+++ /dev/null
@@ -1,3 +0,0 @@
-INCLUDES= d506cm.inc d506dp.inc pilot.h
-
-InstallIncludes($(INCLUDES),$(CERN_INCLUDEDIR),minuit)
diff --git a/src/packlib/minuit/minuit/d506cm.inc b/src/packlib/minuit/minuit/d506cm.inc
deleted file mode 100644
index 3eb958c..0000000
--- a/src/packlib/minuit/minuit/d506cm.inc
+++ /dev/null
@@ -1,52 +0,0 @@
-*
-* $Id: d506cm.inc,v 1.1.1.1 1996/03/07 14:31:32 mclareni Exp $
-*
-* $Log: d506cm.inc,v $
-* Revision 1.1.1.1 1996/03/07 14:31:32 mclareni
-* Minuit
-*
-*
-#ifndef CERNLIB_MINUIT_D506CM_INC
-#define CERNLIB_MINUIT_D506CM_INC
-*
-*
-* d506cm.inc
-*
- PARAMETER (MNE=100 , MNI=50)
- PARAMETER (MNIHL=MNI*(MNI+1)/2)
- CHARACTER*10 CPNAM
- COMMON
- 1/MN7NAM/ CPNAM(MNE)
- 2/MN7EXT/ U(MNE) ,ALIM(MNE) ,BLIM(MNE)
- 3/MN7ERR/ ERP(MNI) ,ERN(MNI) ,WERR(MNI) ,GLOBCC(MNI)
- 4/MN7INX/ NVARL(MNE) ,NIOFEX(MNE),NEXOFI(MNI)
- 5/MN7INT/ X(MNI) ,XT(MNI) ,DIRIN(MNI)
- 6/MN7FX2/ XS(MNI) ,XTS(MNI) ,DIRINS(MNI)
- 7/MN7DER/ GRD(MNI) ,G2(MNI) ,GSTEP(MNI) ,GIN(MNE) ,DGRD(MNI)
- 8/MN7FX3/ GRDS(MNI) ,G2S(MNI) ,GSTEPS(MNI)
- 9/MN7FX1/ IPFIX(MNI) ,NPFIX
- A/MN7VAR/ VHMAT(MNIHL)
- B/MN7VAT/ VTHMAT(MNIHL)
- C/MN7SIM/ P(MNI,MNI+1),PSTAR(MNI),PSTST(MNI) ,PBAR(MNI),PRHO(MNI)
-C
- PARAMETER (MAXDBG=10, MAXSTK=10, MAXCWD=20, MAXP=30, MAXCPT=101)
- PARAMETER (ZERO=0.0, ONE=1.0, HALF=0.5)
- COMMON
- D/MN7NPR/ MAXINT ,NPAR ,MAXEXT ,NU
- E/MN7IOU/ ISYSRD ,ISYSWR ,ISYSSA ,NPAGWD ,NPAGLN ,NEWPAG
- E/MN7IO2/ ISTKRD(MAXSTK) ,NSTKRD ,ISTKWR(MAXSTK) ,NSTKWR
- F/MN7TIT/ CFROM ,CSTATU ,CTITL ,CWORD ,CUNDEF ,CVRSN ,COVMES
- G/MN7FLG/ ISW(7) ,IDBG(0:MAXDBG) ,NBLOCK ,ICOMND
- H/MN7MIN/ AMIN ,UP ,EDM ,FVAL3 ,EPSI ,APSI ,DCOVAR
- I/MN7CNV/ NFCN ,NFCNMX ,NFCNLC ,NFCNFR ,ITAUR,ISTRAT,NWRMES(2)
- J/MN7ARG/ WORD7(MAXP)
- K/MN7LOG/ LWARN ,LREPOR ,LIMSET ,LNOLIM ,LNEWMN ,LPHEAD
- L/MN7CNS/ EPSMAC ,EPSMA2 ,VLIMLO ,VLIMHI ,UNDEFI ,BIGEDM,UPDFLT
- M/MN7RPT/ XPT(MAXCPT) ,YPT(MAXCPT)
- N/MN7CPT/ CHPT(MAXCPT)
- o/MN7XCR/ XMIDCR ,YMIDCR ,XDIRCR ,YDIRCR ,KE1CR ,KE2CR
- CHARACTER CTITL*50, CWORD*(MAXCWD), CUNDEF*10, CFROM*8,
- + CVRSN*6, COVMES(0:3)*22, CSTATU*10, CHPT*1
- LOGICAL LWARN, LREPOR, LIMSET, LNOLIM, LNEWMN, LPHEAD
-
-#endif
diff --git a/src/packlib/minuit/minuit/d506dp.inc b/src/packlib/minuit/minuit/d506dp.inc
deleted file mode 100644
index 7cacac8..0000000
--- a/src/packlib/minuit/minuit/d506dp.inc
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: d506dp.inc,v 1.1.1.1 1996/03/07 14:31:32 mclareni Exp $
-*
-* $Log: d506dp.inc,v $
-* Revision 1.1.1.1 1996/03/07 14:31:32 mclareni
-* Minuit
-*
-*
-#ifndef CERNLIB_MINUIT_D506DP_INC
-#define CERNLIB_MINUIT_D506DP_INC
-*
-*
-* d506dp.inc
-*
-#if defined(CERNLIB_DOUBLE)
-C ************ DOUBLE PRECISION VERSION *************
- IMPLICIT DOUBLE PRECISION (A-H,O-Z)
-#endif
-#if !defined(CERNLIB_DOUBLE)
-C ************ SINGLE PRECISION VERSION *************
-#endif
-
-#endif
diff --git a/src/packlib/minuit/minuit/pilot.h b/src/packlib/minuit/minuit/pilot.h
deleted file mode 100644
index 238733a..0000000
--- a/src/packlib/minuit/minuit/pilot.h
+++ /dev/null
@@ -1,7 +0,0 @@
-#if 0
-#endif
-#if !defined(CERNLIB_SINGLE)
-#ifndef CERNLIB_DOUBLE
-#define CERNLIB_DOUBLE
-#endif
-#endif
diff --git a/src/packlib/minuit/obsolete/old506.F b/src/packlib/minuit/obsolete/old506.F
deleted file mode 100644
index 13e906b..0000000
--- a/src/packlib/minuit/obsolete/old506.F
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: old506.F,v 1.1.1.1 1996/03/07 14:31:33 mclareni Exp $
-*
-* $Log: old506.F,v $
-* Revision 1.1.1.1 1996/03/07 14:31:33 mclareni
-* Minuit
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_minuit/pilot.h"
-#if defined(CERNLIB_NEVER)
- SUBROUTINE MINNEW
-C
- ENTRY MINTS
- ENTRY MINTL
- ENTRY MINTSD
- ENTRY MINTLD
-C
- EXTERNAL FCN
-C
- CALL MINUIT(FCN,0)
- RETURN
- END
-#endif
diff --git a/src/packlib/minuit/versions/inform.dat b/src/packlib/minuit/versions/inform.dat
deleted file mode 100644
index 5f4b11b..0000000
--- a/src/packlib/minuit/versions/inform.dat
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: inform.dat,v 1.1.1.1 1996/03/07 14:31:32 mclareni Exp $
-*
-* $Log: inform.dat,v $
-* Revision 1.1.1.1 1996/03/07 14:31:32 mclareni
-* Minuit
-*
-*
-* General information
-C MINUIT 0.00 000000 00.00 CERN Program Library D506 MINUIT
-C FUNCTION MINIMISATION AND ERROR ANALYSIS. F.JAMES CN/CERN
-C
diff --git a/src/packlib/minuit/versions/v204.dat b/src/packlib/minuit/versions/v204.dat
deleted file mode 100644
index 4e781b0..0000000
--- a/src/packlib/minuit/versions/v204.dat
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: v204.dat,v 1.1.1.1 1996/03/07 14:31:33 mclareni Exp $
-*
-* $Log: v204.dat,v $
-* Revision 1.1.1.1 1996/03/07 14:31:33 mclareni
-* Minuit
-*
-*
-* Version 2.04 901031 15.30
-C
-C- Introduce the following patches/flags:
-C > SMINUIT : source patch
-C > FMINUIT : flags patch (renamed from MNFLAGS)
-C > DMINUIT : documentation patch
-C
-C- Routine changes:
-C > P=MINUIT,D=MNINIT Update version
-C > P=MINUIT,D=MNSAVE Minor change in FORMAT statement
-C > P=MINUIT,D=MNCONT Compute NFCNMX
-C > P=MINUIT,D=MNLINE Protect SLAM against null denominators
-C
diff --git a/src/packlib/minuit/versions/v205.dat b/src/packlib/minuit/versions/v205.dat
deleted file mode 100644
index 355aa13..0000000
--- a/src/packlib/minuit/versions/v205.dat
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: v205.dat,v 1.1.1.1 1996/03/07 14:31:33 mclareni Exp $
-*
-* $Log: v205.dat,v $
-* Revision 1.1.1.1 1996/03/07 14:31:33 mclareni
-* Minuit
-*
-*
-* Version 2.05 910209 18.10
-C
-C- Patch/flag changes:
-C > IBMVM : for IBM VM/CMS. IBM=IBMVM or IBMMVS
-C > VAXVMS : for Vax VMS . VAX=VAXVMS or VAXULX.
-C > HPUX : for HP/UX
-C > MIPS : for MIPS machine
-C
diff --git a/src/packlib/minuit/versions/v206.dat b/src/packlib/minuit/versions/v206.dat
deleted file mode 100644
index b6ffa52..0000000
--- a/src/packlib/minuit/versions/v206.dat
+++ /dev/null
@@ -1,13 +0,0 @@
-*
-* $Id: v206.dat,v 1.1.1.1 1996/03/07 14:31:33 mclareni Exp $
-*
-* $Log: v206.dat,v $
-* Revision 1.1.1.1 1996/03/07 14:31:33 mclareni
-* Minuit
-*
-*
-* Version 2.06 910723 13.00
-C
-C- Patch/flag changes:
-C > FMINUIT : Add AMIGAUX, CDCUX, IBMPC, IBMUX, MACAUX, NECSX
-C
diff --git a/src/packlib/minuit/versions/v207.dat b/src/packlib/minuit/versions/v207.dat
deleted file mode 100644
index a46a4fe..0000000
--- a/src/packlib/minuit/versions/v207.dat
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: v207.dat,v 1.1.1.1 1996/03/07 14:31:33 mclareni Exp $
-*
-* $Log: v207.dat,v $
-* Revision 1.1.1.1 1996/03/07 14:31:33 mclareni
-* Minuit
-*
-*
-* Version 2.07 930723 12.00
-C
-C- Introduce the following decks:
-C MNPARS new routine, user-callable, to define a parameter
-C specified only by a character-string
-C MNINPU new routine, user-callable, to change input unit
-C MNCOMD new routine, user-callable, to execute a command
-C specified only by a character-string
-C- Major changes in:
-C MNREAD which now calls MNPARS instead of MNPARM (then
-C MNPARS calls MNPARM, so where is the big deal?)
-C- Small but important changes in:
-C MNCROS to keep points inside limits in ALL cases.
-C MNMNOT to keep points inside limits in ALL cases.
-C MNCONT to get the error flag right
-C all routines using ISW(6) which can now take on values 1,0,-1
-C- Very Minor changes in many routines
-C
diff --git a/src/packlib/minuit/versions/v208.dat b/src/packlib/minuit/versions/v208.dat
deleted file mode 100644
index 6f2e4d9..0000000
--- a/src/packlib/minuit/versions/v208.dat
+++ /dev/null
@@ -1,11 +0,0 @@
-*
-* $Id: v208.dat,v 1.1.1.1 1996/03/07 14:31:33 mclareni Exp $
-*
-* $Log: v208.dat,v $
-* Revision 1.1.1.1 1996/03/07 14:31:33 mclareni
-* Minuit
-*
-*
-* Version 2.08 930803 14.00
-C MNHELP new help facility
-C trivial fix in MNCONT
diff --git a/src/packlib/minuit/versions/v209.dat b/src/packlib/minuit/versions/v209.dat
deleted file mode 100644
index 0d920e8..0000000
--- a/src/packlib/minuit/versions/v209.dat
+++ /dev/null
@@ -1,10 +0,0 @@
-*
-* $Id: v209.dat,v 1.1.1.1 1996/03/07 14:31:33 mclareni Exp $
-*
-* $Log: v209.dat,v $
-* Revision 1.1.1.1 1996/03/07 14:31:33 mclareni
-* Minuit
-*
-*
-* Version 2.09
-C MNEXCM fix to protect against bad input of LLIST
diff --git a/src/packlib/minuit/versions/v210.dat b/src/packlib/minuit/versions/v210.dat
deleted file mode 100644
index 0a5525e..0000000
--- a/src/packlib/minuit/versions/v210.dat
+++ /dev/null
@@ -1,13 +0,0 @@
-*
-* $Id: v210.dat,v 1.1.1.1 1996/03/07 14:31:33 mclareni Exp $
-*
-* $Log: v210.dat,v $
-* Revision 1.1.1.1 1996/03/07 14:31:33 mclareni
-* Minuit
-*
-*
-* Version 2.10 931125 Minuit 93.11
-C MNCOMD fix serious bug in converting command to upper case
-C MNEXCM, MNLIMS, MNMNOT removed unused variable references
-C MNFREE suppress print message when print level .lt. 1
-C MNPARM, MNPARS, MNREAD print header line when appropriate
diff --git a/src/packlib/minuit/versions/v211.dat b/src/packlib/minuit/versions/v211.dat
deleted file mode 100644
index 8bd6b36..0000000
--- a/src/packlib/minuit/versions/v211.dat
+++ /dev/null
@@ -1,14 +0,0 @@
-*
-* $Id: v211.dat,v 1.1.1.1 1996/03/07 14:31:33 mclareni Exp $
-*
-* $Log: v211.dat,v $
-* Revision 1.1.1.1 1996/03/07 14:31:33 mclareni
-* Minuit
-*
-*
-* Version 2.11 940901 Minuit 94.09
-C MNEMAT and MNPRIN print one more digit of UP (G10.2 -> G10.3)
-C MNMNOT fix bug: sometimes returned wrong value with limits
-C MNCOMD and MNEXCM make error return codes consistent
-C MNSEEK avoid exponential overflows by using logs
-C MNCROS improve convergence criteria (for MNCONT, MINOS)
diff --git a/src/packlib/minuit/versions/v212.dat b/src/packlib/minuit/versions/v212.dat
deleted file mode 100644
index 484c7c9..0000000
--- a/src/packlib/minuit/versions/v212.dat
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: v212.dat,v 1.1.1.1 1996/03/07 14:31:33 mclareni Exp $
-*
-* $Log: v212.dat,v $
-* Revision 1.1.1.1 1996/03/07 14:31:33 mclareni
-* Minuit
-*
-*
-* Version 2.12 950301 Munuit 95.03
-C MNEXCM fix bug: did not RETURN after CALL FCN 3
-C MNSET add new command: SHOw VERsion
-C MNVERS new routine to return Minuit version identifier.
diff --git a/src/packlib/vmslibfiles/Imakefile b/src/packlib/vmslibfiles/Imakefile
deleted file mode 100644
index 2d0a2ad..0000000
--- a/src/packlib/vmslibfiles/Imakefile
+++ /dev/null
@@ -1,75 +0,0 @@
-#ifdef CERNLIB_VAXVMS
-
-/* These are files needed on VMS and which need to be installed in
- * the bin and lib directory
- */
-
-/* cernlib for vms; rules for msg and cld are needed ONLY here. */
-
-/* There is a switch CERNLIB_CLD which you may set.
- * I think then you need to install cernlib with cld ?
-DEFINES=-DCERNLIB_CLD.
- * GF
- */
-
-cernlibmsg.obj: cernlibmsg.msg
- message/object=$@ $<
-
-cernlibcld.obj: cernlibcld.cld
- set command/object=$@ $<
-
-cernlibcld.cld: cernlibcld.$$cld
- fpp $(CERNDEFINES) $(DEFINES) $< $@
-
-/* Avoid traceback */
-LINK:=$(LINK)/NOTRACE
-
-NormalProgramTarget(cernlib,cernlib.o cernlibmsg.obj cernlibcld.obj,$(CERN_LIBDIR)kernlib.olb,$(CERN_LIBDIR)kernlib/lib,NullParameter)
-
-InstallProgram(cernlib,$(CERN_BINDIR))
-
-/* Various .opt files */
-
-#ifndef CERNLIB_QMALPH
-InstallNonExecFileTarget(install.lib,grafx11_decw.opt,$(CERN_LIBDIR))
-CopyFile(vmslib_u.opt_vax,vmslib_u.opt)
-#endif
-
-InstallNonExecFileTarget(install.lib,gphigs.opt,$(CERN_LIBDIR))
-InstallNonExecFileTarget(install.lib,grafdgks.opt,$(CERN_LIBDIR))
-InstallNonExecFileTarget(install.lib,grafmotif.opt,$(CERN_LIBDIR))
-InstallNonExecFileTarget(install.lib,grafmotif12.opt,$(CERN_LIBDIR))
-InstallNonExecFileTarget(install.lib,grafx11.opt,$(CERN_LIBDIR))
-InstallNonExecFileTarget(install.lib,kuip.opt,$(CERN_LIBDIR))
-InstallNonExecFileTarget(install.lib,packlib.opt,$(CERN_LIBDIR))
-InstallNonExecFileTarget(install.lib,squeeze.opt,$(CERN_LIBDIR))
-InstallNonExecFileTarget(install.lib,sysexe.opt,$(CERN_LIBDIR))
-InstallNonExecFileTarget(install.lib,tcpmod.opt,$(CERN_LIBDIR))
-InstallNonExecFileTarget(install.lib,vmslib_m.opt,$(CERN_LIBDIR))
-InstallNonExecFileTarget(install.lib,vmslib_u.opt,$(CERN_LIBDIR))
-InstallNonExecFileTarget(install.lib,vmslib_w.opt,$(CERN_LIBDIR))
-
-/*
- * Sources for some .obj files ( see below )
- */
-
-InstallNonExecFileTarget(install.lib,ctldummy.for,$(CERN_LIBDIR))
-InstallNonExecFileTarget(install.lib,mndummy.for,$(CERN_LIBDIR))
-InstallNonExecFileTarget(install.lib,getservbyname.c,$(CERN_LIBDIR))
-InstallNonExecFileTarget(install.lib,xxint.c,$(CERN_LIBDIR))
-
-/* ... and the objects
- */
-InstallNonExecFileTarget(install.lib,ctldummy.obj,$(CERN_LIBDIR))
-InstallNonExecFileTarget(install.lib,mndummy.obj,$(CERN_LIBDIR))
-InstallNonExecFileTarget(install.lib,getservbyname.obj,$(CERN_LIBDIR))
-/* InstallNonExecFileTarget(install.lib,xxint.obj,$(CERN_LIBDIR)) */
-
-
-
-#else
-
-install.lib::
-
-#endif
-
diff --git a/src/packlib/vmslibfiles/cernlib.F b/src/packlib/vmslibfiles/cernlib.F
deleted file mode 100644
index 207642c..0000000
--- a/src/packlib/vmslibfiles/cernlib.F
+++ /dev/null
@@ -1,767 +0,0 @@
- PROGRAM CERNLIB
-C***********************************************************************
-C* *
-C* CERNLIB Command v2.27 *
-C* *
-C* Author: F.Carminati 13-01-1989 *
-C* *
-C* Mods Date Comment *
-C* MARQUINA 89/02/16 Add HERWIG,ISAJET,JETSET,COJETS,GEANT,PAWLIB *
-C* MARQUINA 89/04/06 Change root directories for NAG+GKS *
-C* Fix NPACKLIB/OPT *
-C* MARQUINA 89/04/10 Partially rewritten *
-C* MARQUINA 89/07/04 Add CNL qualif., protect against undef.symbols*
-C* MARQUINA 89/07/17 Add EURODEC *
-C* CARMINATI 89/09/07 Correct bug in LIBSET when no GKS & NAG *
-C* CARMINATI 90/01/03 Add JETSET72 and search lists for root *
-C* MARQUINA 90/07/25 Add MPALIB *
-C* 90/08/16 Add VMSLIB, change LIBVER to CERN_LEVEL *
-C* 90/10/23 Add PHOTOS *
-C* 90/10/31 Add TWISTER, provide special GRAF libs *
-C* Process X11,DGKS qualifiers *
-C* 90/11/13 Change NPACKLIB > PACKLIB, NGRAFLIB > GRAFLIB *
-C* Provide GRAFxxx.OPT with GRAFLIB/xxx *
-C* 91/03/06 Add FRITIOF *
-C* 91/04/09 Add PDFLIB,ARIADNE *
-C* 91/04/17 Add GEANT313 *
-C* 91/09/12 Swap JETSET and JETSET72 *
-C* 92/02/15 Enable wild-char matching of libraries *
-C* 92/02/28 Add GKS option + NAGGLIB *
-C* Enable access to GKS-only *
-C* JAMIE 92/03/03 Integrate CLD in the image *
-C* MARQUINA 92/04/09 Support MC versions for GEANT,HERWIG,JETSET *
-C* MARQUINA 92/06/28 Add MATHLIB, PYTHIA, use PYTHIA 5.6 *
-C* Fix bug when lib declared after GRAFLIB/NOSHA *
-C* 92/07/28 Add LEPTO, move to HERWIG 5.5 *
-C* Add PHTOOLS when requiring GENLIB *
-C* 93/02/08 version ISAJET, move to HERWIG 5.6 *
-C* 93/09/14 Add MOTIF option, move to ISAJET 7.2 *
-C* 93/09/18 Check if GKS is available to choose default *
-C* 93/12/10 Add GPHIGS,PHIGS,DECGKS options and GPHIGS lib*
-C* Jamie 94/02/21 Permit CERN_LEVEL=yyv, e.g. 94A *
-C* 94/03/08 Change versions of MCLIBS *
-C* *
-C***********************************************************************
- IMPLICIT INTEGER(A-Z)
- INCLUDE '($LIBCLIDEF)'
- PARAMETER (MCV=6)
- CHARACTER LIBS*255, LIBRARY*255, INCLUDE*255, OUTLIB*255
- CHARACTER OLDDIR*32, OLDDEV*64, LINE*80
- CHARACTER*20 LBKEY(25),LBLIST(25,2),LBKEYM,MCNAME(MCV)
- CHARACTER*9 MODE(5)
- DIMENSION MODL(5)
- EXTERNAL CLI$_PRESENT, CLI$_NEGATED, CLI$_COMMA
- EXTERNAL CLI$_LOCPRES, CLI$_LOCNEG
- EXTERNAL SS$_NORMAL, RMS$_NMF, LIB$_STRTRU, LIB$_NOSUCHSYM
- EXTERNAL CRN_NOFILE, CRN_NOLIB, CRN_NOSUCC, CRN_PRODV
- EXTERNAL CRN_NEWLIB
-#ifndef CERNLIB_CLD
- EXTERNAL LIB$GET_INPUT,CERNLIBCLD
- INTEGER CLI$DCL_PARSE,STATUS
-#endif
- LOGICAL HBOOK4, GTS2D, GTS3D, KEY, FRSKEY, NEWLIB, DEBUG,GKSEXIST
- LOGICAL KERN,PACK,DONE,GKS,X11,DGKS,MOTIF,LEXIST,ADDGKS,GKSSHR
- LOGICAL PHIGS
- CHARACTER*255 CHLINE
- CHARACTER*10 FORCE
- CHARACTER*3 VER(4), DEF, CUR, DCNL, CCNL, MCVER(MCV),MCVERD
- CHARACTER*25 RTDIR
- CHARACTER*19 CLIB
- CHARACTER*26 ALFBET
- CHARACTER*10 CHNUM
- DATA ALFBET/'ABCDEFGHIJKLMNOPQRSTUVWXYZ'/
- DATA CHNUM /'1234567890'/
- DATA CLIB/'SYS$LIBRARY:VAXCRTL'/
- DATA LEND/1/,CONTEXT/0/,LIBS/' '/,LLIB/0/,NEWLIB/.FALSE./
- DATA MODE/'SHAREABLE','OPTION','LIBRARY','INCLUDE',' '/
- DATA MODL/9,6,7,7,1/
- DATA DONE/.FALSE./,KERN/.FALSE./,PACK/.FALSE./,GKS/.FALSE./
- DATA GTS2D/.FALSE./,GTS3D/.FALSE./,ADDGKS/.FALSE./
- DATA VER/'OLD','PRO','NEW','CNL'/,DCNL/' '/,CCNL/' '/
- DATA NKEY/23/
- DATA LBKEY/
- + 'MATHLIB' ,'GRAFLIB' ,'GKS' ,'PACKLIB' ,'KERNLIB' ,
- + 'NAGLIB' ,'PAWLIB' ,'HERWIG*' ,'ISAJET*' ,'JETSET*' ,
- + 'COJETS' ,'GEANT*' ,'EURODEC' ,'FRITIOF' ,'PYTHIA*' ,
- + 'VMSLIB' ,'PHOTOS' ,'TWISTER' ,'ARIADNE' ,'PDFLIB' ,
- + 'LEPTO* ' ,'PHTOOLS ','GPHIGS ' ,' ',' ' /
- DATA LBLIST/
- + 'MATHLIB' ,'OGRAFLIB','SGKS' ,'OPACKLIB','KERNLIB' ,
- + 'NAGLIB' ,'PAWLIB' ,'HERWIG*' ,'ISAJET*' ,'JETSET*' ,
- + 'COJETS' ,'GEANT*' ,'EURODEC' ,'FRITIOF' ,'PYTHIA*' ,
- + 'VMSLIB' ,'PHOTOS' ,'TWISTER' ,'ARIADNE' ,'PDFLIB' ,
- + 'LEPTO* ' ,'PHTOOLS ','GPHIGS ' ,' ',' ' ,
- + 'MATHLIB' ,'GRAFLIB' ,'GKS' ,'PACKLIB' ,'KERNLIB' ,
- + 'NAGLIB ','PAWLIB' ,'HERWIG*' ,'ISAJET*' ,'JETSET*' ,
- + 'COJETS' ,'GEANT*' ,'EURODEC' ,'FRITIOF' ,'PYTHIA*' ,
- + 'VMSLIB' ,'PHOTOS' ,'TWISTER' ,'ARIADNE' ,'PDFLIB' ,
- + 'LEPTO* ' ,'PHTOOLS ','GPHIGS ' ,' ',' ' /
- DATA MCNAME/
- + 'GEANT' ,'HERWIG' ,'JETSET' ,'LEPTO' ,'PYTHIA' ,
- + 'ISAJET' /
- DATA MCVER/
- + '321' ,'59' ,'74' ,'63' ,'57' ,
- + '722' /
-#ifndef CERNLIB_CLD
-C
-C Obtain command line
-C
- STATUS=LIB$GET_FOREIGN(CHLINE,,LLINE)
- IF(.NOT.STATUS) CALL LIB$SIGNAL(%VAL(STATUS))
-C
-C Parse command line
-C
- STATUS=CLI$DCL_PARSE('CERNLIB '//CHLINE(1:LLINE),
- + CERNLIBCLD,LIB$GET_INPUT)
- IF(.NOT.STATUS) CALL LIB$SIGNAL(%VAL(STATUS))
-#endif
-C
- MODE(5)=MODE(3)
- OLDDEV = ' '
- OLDDIR = ' '
- RECODE=LIB$FIND_FILE('*.*',OUTLIB,DUMCON,,)
- IF(RECODE) CALL FTRIM(OLDDEV,OLDDIR,OUTLIB,INIT,IEND)
- FRSKEY = .TRUE.
-C**** Get default directory: PROduction, OLD or NEW
- DEF = ' '
- CUR = ' '
- LENCUR=0
- RECODE=LIB$GET_SYMBOL('CERN_LEVEL',CUR,LENCUR,)
- IF(RECODE) THEN
- DO J=1,3
- IF(CUR.EQ.VER(J)) DEF=CUR
- END DO
- IF(DEF.EQ.' '.AND.INDXNC(CUR).EQ.0) THEN
- DEF ='CNL'
- DCNL=CUR
- ENDIF
- END IF
-*
-* Permit yyv, e.g. 94A, or --since 98--just the year ( ie. 98 )
-*
- IF(INDEX(CHNUM,CUR(1:1)).NE.0.AND.INDEX(CHNUM,CUR(2:2)).NE.0.AND.
- + ( LENCUR.EQ.2 .OR.
- + (LENCUR.EQ.3 .AND. INDEX(ALFBET,CUR(3:3)).NE.0) ) ) DEF = CUR
-
- IF(DEF.EQ.' ') DEF='PRO'
- DO J=1,4
- IF(CLI$PRESENT(VER(J)).EQ.%LOC(CLI$_PRESENT)) THEN
- DEF = VER(J)
- IF(J.EQ.4) THEN
- RECODE=CLI$GET_VALUE('CNL',DCNL,)
- IF(.NOT.RECODE) RECODE = LIB$SIGNAL(%VAL(RECODE))
- ENDIF
- ENDIF
- END DO
- CALL LIBSET(DEF//DCNL,'CERN_ROOT')
- CALL LIBSET(DEF//DCNL,'GKS_ROOT')
-C CALL LIBSET(DEF//DCNL,'NAG_ROOT')
-
-C**** Find out default MC versions
- DO J=1,MCV
- RECODE=LIB$GET_SYMBOL(MCNAME(J)//'_LEVEL',MCVERD,,)
- IF(RECODE) MCVER(J)=MCVERD
- END DO
-C**** Parse command: check parameters
-C LBFLAG =1 libraries supplied
-C 2 set packlib
-C 3 set kernlib
-C 4 user libraries supplied
-
- LBFLAG=2
- IF(CLI$PRESENT('USER')) LBFLAG=4
- IF(CLI$PRESENT('P1')) LBFLAG=1
-C**** User libraries missing
- IF(LBFLAG.EQ.4) GOTO 990
- IF(LBFLAG.EQ.2) DONE=.TRUE.
-
-C**** Set flags for GLOBAL qualifiers
-
- NEWLIB = DEF.EQ.'NEW'
- HBOOK4 = .NOT.(
- + CLI$PRESENT('HNEW') .EQ.%LOC(CLI$_NEGATED).OR.
- + CLI$PRESENT('HOLD') .EQ.%LOC(CLI$_PRESENT).OR.
- + CLI$PRESENT('PLOT10').EQ.%LOC(CLI$_PRESENT))
-
- DGKS = CLI$PRESENT('DGKS') .EQ.%LOC(CLI$_PRESENT).OR.
- + CLI$PRESENT('DECGKS').EQ.%LOC(CLI$_PRESENT)
- X11 = CLI$PRESENT('X11') .EQ.%LOC(CLI$_PRESENT)
- MOTIF = CLI$PRESENT('MOTIF') .EQ.%LOC(CLI$_PRESENT)
- PHIGS = CLI$PRESENT('GPHIGS').EQ.%LOC(CLI$_PRESENT).OR.
- + CLI$PRESENT('PHIGS') .EQ.%LOC(CLI$_PRESENT)
- IF(.NOT.(DGKS.OR.MOTIF.OR.PHIGS.OR.GKSEXIST(DEF))) X11=.TRUE.
-
- IF(.NOT.(X11.OR.DGKS.OR.MOTIF.OR.PHIGS)) THEN
- GTS3D = CLI$PRESENT('GTS3D') .EQ.%LOC(CLI$_PRESENT).OR.
- + CLI$PRESENT('GTS2D') .EQ.%LOC(CLI$_NEGATED)
- GTS2D = HBOOK4.AND..NOT.GTS3D
- ADDGKS = CLI$PRESENT('GKS') .EQ.%LOC(CLI$_PRESENT).OR.
- + CLI$PRESENT('GTS2D') .EQ.%LOC(CLI$_PRESENT).OR.GTS3D
- ENDIF
-
- DEBUG = CLI$PRESENT('DEBUG') .EQ.%LOC(CLI$_PRESENT)
-
-C**** Set proper GTS libraries in LBLIST
- IF(GTS2D) THEN
-C LBLIST(3,1)='GKS_ROOT:[LIB]GKS'
- LBLIST(3,2)='GKS_LIB'
- ELSEIF(GTS3D) THEN
-C LBLIST(3,1)='GKS_ROOT:[LIB]GKS'
- LBLIST(3,2)='GKS3D_LIB'
- ENDIF
-C**** Choose the LBLIST Library set: HOLD=1, HNEW=2
- ISET=1
- IF(HBOOK4) ISET=2
-1 CONTINUE
- CUR =DEF
- CCNL=DCNL
- IF(DEBUG) PRINT *,'DEF=',LBFLAG
- GOTO(10,20,30,200),LBFLAG
-10 CONTINUE
-C**** "parameter" libraries
- LAST = CLI$GET_VALUE('P1',LIBRARY,LLIB)
- IF(DEBUG) PRINT *,'LST=',LAST,' LIB=',LIBRARY(:LLIB)
- IF(.NOT.LAST) LAST = LIB$SIGNAL(%VAL(LAST))
-C**** Set CUR version if locally present
- DO J=1,4
- IF(CLI$PRESENT(VER(J)).EQ.%LOC(CLI$_LOCPRES)) THEN
- CUR=VER(J)
- IF(J.EQ.3) NEWLIB=.TRUE.
- IF(J.EQ.4) THEN
- RECODE=CLI$GET_VALUE('CNL',CCNL,LCNL)
- IF(.NOT.RECODE) RECODE = LIB$SIGNAL(%VAL(RECODE))
- ENDIF
- END IF
- END DO
- IF(LAST.EQ.%LOC(SS$_NORMAL)) DONE=.TRUE.
- GOTO 50
-20 CONTINUE
-C**** Packlib
- KEY =.TRUE.
- LIBRARY='CRN'
- IKEY =4
- GOTO 56
-30 CONTINUE
-C**** Kernlib
- KEY =.TRUE.
- LIBRARY='CRN'
- IKEY =5
- GOTO 56
-C40 CONTINUE
-50 CONTINUE
- CHLINE=' '
-C----
-C Point to new MATHLIB library when using old keywords
-C
- IF(INDEX('GENLIB BVSL MPALIB LAPACK',LIBRARY(:LLIB)).NE.0) THEN
- IF(LIBRARY(:6).EQ.'GENLIB') CHLINE='PHTOOLS'
- LIBRARY='MATHLIB'
- LLIB =7
- ENDIF
- IF(LIBRARY(:5).EQ.'LEPTO') CHLINE='JETSET'
-C----
-C PYTHIA is inside JETSET
-C
- IF(LIBRARY(1:6).EQ.'PYTHIA') THEN
- LIBRARY='JETSET'
- LLIB =6
- ENDIF
-C
- IF(LIBRARY(:LLIB).EQ.'GKS')
- + GKSSHR=CLI$PRESENT('SHAREABLE').NE.%LOC(CLI$_LOCNEG)
-
-51 CONTINUE
- KEY = .FALSE.
- DO K=1,MCV
- IF(LIBRARY(:LLIB).EQ.MCNAME(K)) THEN
- LIBRARY(LLIB+1:)=MCVER(K)
- LLIB=LENOCC(LIBRARY)
- IF(DEBUG) PRINT *,'MCV=',MCVER(K),LIBRARY(:LLIB)
- ENDIF
- END DO
-C
- DO 55 N=1,NKEY
- LBKEYM=LBKEY(N)
- IPSTAR=INDEX(LBKEYM,'*')
- IF(IPSTAR.GT.0) LBKEYM(IPSTAR:)=LIBRARY(IPSTAR:LLIB)
- IF(LIBRARY(:LLIB).NE.LBKEYM) GOTO 55
- KEY =.TRUE.
- IKEY =N
- LIBRARY='CRN'
- IF(IPSTAR.GT.0) LBLIST(IKEY,ISET)=LBKEYM
- IF(N.EQ.3) THEN
-C*** GKS SECTION
- IF(HBOOK4) THEN
- IF(GKSSHR) THEN
- DO K=1,4
- IF(CLI$PRESENT(VER(K)).EQ.%LOC(CLI$_LOCPRES)) THEN
- CALL LIBSET(VER(K)//CCNL,'GKS_ROOT')
- CONTEXT=0
- END IF
- END DO
- IF(GTS2D) LBLIST(N,2)='GKS'
- IF(GTS3D) LBLIST(N,2)='GKS3D'
- ELSE
- FORCE='OPTION'
- END IF
- ENDIF
- LIBRARY='GKS'
- ELSEIF(N.EQ.6) THEN
-C**** NAG Section
-C IF(CUR.NE.'PRO')
-C + RECODE=LIB$SIGNAL(CRN_PRODV,%VAL(2),CUR,'NAGLIB')
- IF(CLI$PRESENT('SHAREABLE').NE.%LOC(CLI$_LOCNEG)) THEN
- DO K=1,4
- IF(CLI$PRESENT(VER(K)).EQ.%LOC(CLI$_LOCPRES)) THEN
-C CALL LIBSET(VER(K)//CCNL,'NAG_ROOT')
- CONTEXT=0
- END IF
- END DO
- ELSE
- FORCE='OPTION'
- END IF
- LIBRARY='NAG'
- IF(ADDGKS) LBLIST(N,2)='NAGGLIB'
- ELSEIF(N.EQ.23) THEN
-C**** PHIGS Section
- FORCE='OPTION'
- ENDIF
- GOTO 56
-55 CONTINUE
- GOTO 60
-56 CONTINUE
-C**** CERN Library matched
- LIBRARY=RTDIR(CUR//CCNL,LIBRARY(1:3))
- LLIB =LENOCC(LIBRARY)
- LIBRARY=LIBRARY(:LLIB)//LBLIST(IKEY,ISET)
- LLIB =LENOCC(LIBRARY)
- IF(IKEY.EQ.4) PACK=.TRUE.
- IF(IKEY.EQ.5) KERN=.TRUE.
-60 CONTINUE
- IF(DEBUG) PRINT *,'LEN=',LLIB,' LIB=',LIBRARY(:LLIB)
-C****
- IF(KEY.AND.FRSKEY) THEN
- CONTEXT = 0
- OUTLIB = ' '
- OLDDEV = ' '
- OLDDIR = ' '
- END IF
- FRSKEY=.NOT.KEY
-
-C**** Find out Library mode. Default PACKLIB+KERNLIB are LIBs
-C IFLAG =1 SHAreable Library
-C 2 OPTion
-C 3 LIBrary
-C 4 INClude
-C 5 LIB=default
-
- IFLAG=5
- IF(LBFLAG.EQ.1) THEN
- DO N=1,4
- L=MODL(N)
- IF(CLI$PRESENT(MODE(N)(:L)).EQ.%LOC(CLI$_LOCPRES).OR.
- + FORCE.EQ.MODE(N)(:L)) IFLAG=N
- ENDDO
- ENDIF
- IF(DEBUG) PRINT *,'LST=',LAST,' FLG=',IFLAG
-
-C**** Do not resolve GKS
- IF(IKEY.EQ.3) THEN
- IF(.NOT.GKS) THEN
- LIBS(LEND:) = ','//LIBRARY(:LLIB)//'/'//MODE(IFLAG)(1:3)
- LEND = LEND +LLIB+5
- ENDIF
- IF(CUR.EQ.DEF) GKS=.TRUE.
- OLDDEV = 'GKS_ROOT:'
- OLDDIR = '[LIB]'
- GOTO 160
- ENDIF
- IF(IFLAG.EQ.1.AND.(IKEY.EQ.4.OR.IKEY.EQ.6)) IFLAG=2
-C**** Take default for KERNLIB
- GOTO(110,120,130,140,150),IFLAG
-110 CONTINUE
-C**** Shareable library
- IF(LBFLAG.GT.1) THEN
- RECODE=LIB$SIGNAL(CRN_NOFILE,%VAL(1),LIBRARY(:LLIB))
- GOTO 160
- ENDIF
- RECODE=LIB$FIND_FILE(LIBRARY,OUTLIB,CONTEXT,'.EXE',OUTLIB)
- IF (RECODE) THEN
- CALL FTRIM(OLDDEV,OLDDIR,OUTLIB,INIT,IEND)
- LIBS(LEND:) = ','//OUTLIB(INIT:IEND)//'/SHA'
- LEND = LEND + IEND - INIT + 1 + 5
- IF(CLI$GET_VALUE('SHAREABLE',LIBRARY,LLIB)) THEN
- LIBS(LEND:) = '='//LIBRARY(:LLIB)
- LEND = LEND + 1 + LLIB
- END IF
- IF(CLI$PRESENT('INCLUDE').EQ.%LOC(CLI$_LOCPRES)) THEN
- INCLUDE = '/INC=('
- END = 7
- RECODE = %LOC(CLI$_COMMA)
- DO WHILE(RECODE.NE.%LOC(SS$_NORMAL))
- RECODE=CLI$GET_VALUE('INCLUDE',LIBRARY,LLIB)
- IF(.NOT.RECODE) THEN
- RECODE = LIB$SIGNAL(%VAL(RECODE))
- ELSE IF(RECODE.EQ.%LOC(SS$_NORMAL)) THEN
- INCLUDE(END:)=LIBRARY(:LLIB)//')'
- END = END+LLIB+1
- ELSE IF(RECODE.NE.%LOC(CLI$_ABSENT)) THEN
- INCLUDE(END:)=LIBRARY(:LLIB)//','
- END = END+LLIB+1
- END IF
- END DO
- END = END - 1
- LIBS(LEND:) = INCLUDE(:END)
- LEND = LEND + END
- END IF
- ELSE
- POINT = INDEX(LIBRARY,'.')
- IF(POINT.EQ.0) THEN
- LIBRARY(LLIB+1:)='.EXE'
- LLIB=LLIB+4
- END IF
- IF(RECODE.EQ.%LOC(RMS$_NMF)) THEN
- RECODE=LIB$SIGNAL(CRN_NOSUCC,%VAL(1),LIBRARY(:LLIB))
- END IF
- RECODE=LIB$SIGNAL(CRN_NOFILE,%VAL(1),LIBRARY(:LLIB))
- END IF
- GOTO 160
-120 CONTINUE
-C**** Option
- IF(LBFLAG.GT.2) THEN
- RECODE=LIB$SIGNAL(CRN_NOFILE,%VAL(1),LIBRARY(:LLIB))
- GOTO 160
- ENDIF
- RECODE=LIB$FIND_FILE(LIBRARY,OUTLIB,CONTEXT,'.OPT',OUTLIB)
- IF (RECODE) THEN
- CALL FTRIM(OLDDEV,OLDDIR,OUTLIB,INIT,IEND)
- LIBS(LEND:) = ','//OUTLIB(INIT:IEND)//'/OPT'
- LEND = LEND + 5 + IEND - INIT + 1
- ELSE
- POINT = INDEX(LIBRARY,']')
- POINT = INDEX(LIBRARY(POINT+1:),'.')+POINT
- IF(POINT.EQ.0) THEN
- LIBRARY(LLIB+1:)='.OPT'
- LLIB=LLIB+4
- END IF
- IF(RECODE.EQ.%LOC(RMS$_NMF)) THEN
- RECODE=LIB$SIGNAL(CRN_NOSUCC,%VAL(1),LIBRARY(:LLIB))
- END IF
- RECODE=LIB$SIGNAL(CRN_NOFILE,%VAL(1),LIBRARY(:LLIB))
- END IF
- GOTO 160
-130 CONTINUE
-C**** Library
-140 CONTINUE
-C**** Include
- RECODE=LIB$FIND_FILE(LIBRARY,OUTLIB,CONTEXT,'.OLB',OUTLIB)
- IF(RECODE) THEN
- CALL FTRIM(OLDDEV,OLDDIR,OUTLIB,INIT,IEND)
- LIBS(LEND:) = ','//OUTLIB(INIT:IEND)
- LEND = LEND + IEND - INIT + 1 + 1
- IF(CLI$PRESENT('LIBRARY').EQ.%LOC(CLI$_LOCPRES)) THEN
- LIBS(LEND:) = '/LIB'
- LEND = LEND + 4
- END IF
-C IF(CLI$PRESENT('INCLUDE').EQ.%LOC(CLI$_LOCPRES).AND.
-C + DEFAULT.LE.1) THEN
- IF(CLI$PRESENT('INCLUDE').EQ.%LOC(CLI$_LOCPRES))THEN
- INCLUDE = '/INC=('
- END = 7
- RECODE = %LOC(CLI$_COMMA)
- DO WHILE(RECODE.NE.%LOC(SS$_NORMAL))
- RECODE=CLI$GET_VALUE('INCLUDE',LIBRARY,LLIB)
- IF(.NOT.RECODE) THEN
- RECODE = LIB$SIGNAL(%VAL(RECODE))
- ELSE IF(RECODE.EQ.%LOC(SS$_NORMAL)) THEN
- INCLUDE(END:)=LIBRARY(:LLIB)//')'
- END = END+LLIB+1
- ELSE IF(RECODE.NE.%LOC(CLI$_ABSENT)) THEN
- INCLUDE(END:)=LIBRARY(:LLIB)//','
- END = END+LLIB+1
- END IF
- END DO
- END = END - 1
- LIBS(LEND:) = INCLUDE(:END)
- LEND = LEND + END
- END IF
- ELSEIF(RECODE.EQ.%LOC(RMS$_NMF)) THEN
- POINT = INDEX(LIBRARY,']')
- POINT = INDEX(LIBRARY(POINT+1:),'.')+POINT
- IF(POINT.EQ.0) THEN
- LIBRARY(LLIB+1:)='.OLB'
- LLIB=LLIB+4
- END IF
- RECODE=LIB$SIGNAL(CRN_NOSUCC,%VAL(1),LIBRARY(:LLIB))
- RECODE=LIB$SIGNAL(CRN_NOFILE,%VAL(1),LIBRARY(:LLIB))
- ELSE
- POINT = INDEX(LIBRARY,']')
- POINT = INDEX(LIBRARY(POINT+1:),'.')+POINT
- IF(POINT.EQ.0) THEN
- LIBRARY(LLIB+1:)='.OLB'
- LLIB=LLIB+4
- END IF
- RECODE=LIB$SIGNAL(CRN_NOFILE,%VAL(1),LIBRARY(:LLIB))
- END IF
- GOTO 160
-150 CONTINUE
-C**** Other
- RECODE=LIB$FIND_FILE(LIBRARY,OUTLIB,CONTEXT,'.OLB',OUTLIB)
- IF(RECODE) THEN
- CALL FTRIM(OLDDEV,OLDDIR,OUTLIB,INIT,IEND)
- LIBS(LEND:) = ','//OUTLIB(INIT:IEND)
- LEND = LEND + IEND - INIT + 1 + 1
- IF(INDEX(OUTLIB,'.OLB').NE.0) THEN
- LIBS(LEND:) = '/LIB'
- LEND = LEND +4
- ELSE
- LIBS(LEND:) = OUTLIB(IEND+1:IEND+4)
- LEND = LEND +4
- END IF
- IF(DEBUG) PRINT *,'LIB$=',LIBS(:LEND)
- ELSE
- POINT = INDEX(LIBRARY,']')
- POINT = INDEX(LIBRARY(POINT+1:),'.')+POINT
- IF(POINT.EQ.0) THEN
- LIBRARY(LLIB+1:)='.OLB'
- LLIB=LLIB+4
- END IF
- IF(RECODE.EQ.%LOC(RMS$_NMF)) THEN
- RECODE=LIB$SIGNAL(CRN_NOSUCC,%VAL(1),LIBRARY(:LLIB))
- END IF
- RECODE=LIB$SIGNAL(CRN_NOFILE,%VAL(1),LIBRARY(:LLIB))
- END IF
-C**** End ------------
-160 CONTINUE
- IF(DEBUG) PRINT *,'LIB=',LIBRARY(:LLIB),'/',MODE(IFLAG)
- LLIB = 0
- IF(IKEY.EQ.2) THEN
- IF (X11 ) THEN
- LIBS(LEND:)=',GRAFX11/LIB,GRAFX11/OPT'
- LEND=LEND+24
- ELSEIF(MOTIF) THEN
- LIBS(LEND:)=',GRAFX11/LIB,GRAFMOTIF/OPT'
- LEND=LEND+26
- ELSEIF(PHIGS) THEN
- LIBS(LEND:)=',GRAFX11/LIB,GPHIGS/OPT'
- LEND=LEND+23
- ELSEIF(DGKS) THEN
- LIBS(LEND:)=',GRAFDGKS/LIB,GRAFDGKS/OPT'
- LEND=LEND+26
- ELSEIF(GTS3D) THEN
- LIBS(LEND:)=',GRAFGKS3D/LIB'
- LEND=LEND+14
- ADDGKS=.TRUE.
- ELSE
- LIBS(LEND:)=',GRAFGKS/LIB'
- LEND=LEND+12
- ADDGKS=.TRUE.
- GKSSHR=CLI$PRESENT('SHAREABLE').NE.%LOC(CLI$_LOCNEG)
- ENDIF
- END IF
- IF(CHLINE.NE.' ') THEN
- LIBRARY=CHLINE
- LLIB =LENOCC(CHLINE)
- CHLINE =' '
- GOTO 51
- ENDIF
- IF(DONE) THEN
- IF(ADDGKS) THEN
- IF(IKEY.EQ.6) THEN
- LIBS(LEND:)=',NAGLIB/LIB'
- LEND=LEND+11
- ENDIF
- LIBRARY = 'GKS'
- LLIB = 3
- ADDGKS = .FALSE.
- GOTO 51
- ENDIF
- LBFLAG=2
- IF(PACK) LBFLAG=3
- IF(KERN) LBFLAG=4
-C + LBFLAG=3
-C IF(KERN.OR.(LIBRARY(:LLIB).EQ.'KERNLIB'.AND.CUR.EQ.DEF))
-C + LBFLAG=4
- IF(CLI$PRESENT('USER')) LBFLAG=4
- END IF
- GOTO 1
-200 CONTINUE
- LEND = LEND-1
- IF(LEND.LE.1) GOTO 990
-C**** Set LIB$ symbol
- IF(DEBUG) PRINT *,LIBS(2:LEND)
-#if !defined(CERNLIB_QMALPH) & !defined(CERNLIB_QCDEC)
-C* Add the C run-time Library if available on standard VMS
- INQUIRE(FILE=CLIB//'.OLB',EXIST=LEXIST)
- IF(LEXIST) THEN
- LIBS(LEND+1:)=','//CLIB//'/LIB'
- LEND=LEND+24
- ENDIF
-#endif
- RECODE=LIB$SET_SYMBOL('LIB$',LIBS(2:LEND),LIB$K_CLI_GLOBAL_SYM)
- IF(.NOT.RECODE) RECODE=LIB$SIGNAL(%VAL(RECODE))
- IF(CLI$PRESENT('LOG')) THEN
- RECODE=LIB$PUT_OUTPUT('LIB$ = '//LIBS(2:LEND))
- IF(.NOT.RECODE) RECODE=LIB$SIGNAL(%VAL(RECODE))
- END IF
- CALL UMLOG('CERNLIB',LIBS(2:LEND))
- GOTO 991
- 990 CONTINUE
- RECODE=LIB$SIGNAL(CRN_NOLIB,%VAL(0))
- 991 CONTINUE
- IF(NEWLIB) THEN
- OPEN(UNIT=1,FILE='CERN:[NEW.DOC]INSTALL.DOC',FORM='FORMATTED',
- + SHARED,READONLY,STATUS='OLD',IOSTAT=IOS)
- IF(IOS.NE.0) GO TO 995
- 994 READ(1,'(A)',END=995) LINE
- RECODE = LIB$SIGNAL(CRN_NEWLIB,%VAL(1),LINE(1:LENOCC(LINE)))
- GO TO 994
- 995 CLOSE(1)
- END IF
- END
- CHARACTER*(*) FUNCTION RTDIR(VER,FLG)
- CHARACTER*(*) VER,FLG
- IF(FLG.EQ.'CRN') RTDIR = 'CERN:['//VER(1:LENOCC(VER))//'.LIB]'
-C**** Do not resolve GKS library
-C IF(FLG.EQ.'GKS') RTDIR = 'CERN:[GKS.'//VER(1:LENOCC(VER))//'.LIB]'
- IF(FLG.EQ.'GKS') RTDIR = ' '
- IF(FLG.EQ.'NAG') RTDIR = 'NAG_ROOT:[LIB]'
- END
- SUBROUTINE LIBSET(VER,ROOT)
-C
- IMPLICIT INTEGER(A-Z)
- INCLUDE '($LNMDEF)'
- PARAMETER(MAXIDX=20)
- CHARACTER*(*) VER
- CHARACTER*8 ROOT
- CHARACTER*255 DIRNAM(0:MAXIDX-1)
- INTEGER*2 ITEML2(80),JTEML2(20)
- INTEGER ITEML4(40),JTEML4(10)
- EQUIVALENCE (ITEML2,ITEML4), (JTEML2,JTEML4)
- EXTERNAL SS$_NOLOGNAM, CRN_TOOMALNM, SS$_SUPERSEDE
-C
-C RECODE=LIB$DELETE_LOGICAL(ROOT,'LNM$PROCESS_TABLE')
-C IF(.NOT.RECODE.AND.RECODE.NE.%LOC(SS$_NOLOGNAM))
-C + RECODE = LIB$SIGNAL(%VAL(RECODE))
-C
- ITEML2(1)=4
- ITEML2(2)=LNM$_MAX_INDEX
- ITEML4(2)=%LOC(MINDEX)
- ITEML4(3)=0
- ITEML4(4)=0
- RECODE=SYS$TRNLNM(,'LNM$FILE_DEV',ROOT,,ITEML4)
- IF(RECODE.EQ.%LOC(SS$_NOLOGNAM)) RETURN
- IF(.NOT.RECODE) RECODE = LIB$SIGNAL(%VAL(RECODE))
- IF(MINDEX.GT.MAXIDX)
- +RECODE = LIB$SIGNAL(CRN_TOOMALNM,%VAL(2),%VAL(MINDEX),ROOT)
-C
- IOK = -1
- DO NINDEX = 0, MINDEX
- JTEML2(1)=4
- JTEML2(2)=LNM$_INDEX
- JTEML4(2)=%LOC(NINDEX)
- JTEML4(3)=0
- JTEML2(7)=255
- JTEML2(8)=LNM$_STRING
- JTEML4(5)=%LOC(DIRNAM(NINDEX))
- JTEML4(6)=%LOC(DIRLEN)
- JTEML4(7)=0
- RECODE=SYS$TRNLNM(,'LNM$FILE_DEV',ROOT,,JTEML4)
- IF(RECODE.EQ.%LOC(SS$_NOLOGNAM)) RETURN
- IF(.NOT.RECODE) RECODE = LIB$SIGNAL(%VAL(RECODE))
-C
- IVLEN= LENOCC(VER)
- IVER = INDEX(DIRNAM(NINDEX)(1:DIRLEN),VER(1:IVLEN))
- ICUR = INDEX(DIRNAM(NINDEX)(1:DIRLEN),'.PRO.')+
- + INDEX(DIRNAM(NINDEX)(1:DIRLEN),'.OLD.')+
- + INDEX(DIRNAM(NINDEX)(1:DIRLEN),'.NEW.')+
- + INDEX(DIRNAM(NINDEX)(1:DIRLEN),'.CNL')
- IF(IVER.NE.0) IOK = IOK + 1
- DIRNAM(NINDEX)(ICUR+1:ICUR+IVLEN)=VER(1:IVLEN)
- DIRNAM(NINDEX)(ICUR+IVLEN+2:ICUR+IVLEN+2)=']'
-C
- IPOINT = (NINDEX + 1) * 3
- ITEML2(IPOINT*2+1) = DIRLEN+IVLEN-3
- ITEML2(IPOINT*2+2) = LNM$_STRING
- ITEML4(IPOINT +2) = %LOC(DIRNAM(NINDEX))
- ITEML4(IPOINT +3) = 0
- END DO
- IF(IOK.LT.MINDEX) THEN
- ITEML4(IPOINT +4) = 0
-C
- ITEML2(1) = 4
- ITEML2(2) = LNM$_ATTRIBUTES
- ITEML4(2) = %LOC(LNM$M_CONCEALED)
- ITEML4(3) = 0
-C
- RECODE=LIB$SET_LOGICAL(ROOT,,,,ITEML4)
-C IF(.NOT.RECODE) RECODE=LIB$SIGNAL(%VAL(RECODE))
- IF(.NOT.RECODE.AND.RECODE.NE.%LOC(SS$_SUPERSEDE))
- + RECODE = LIB$SIGNAL(%VAL(RECODE))
-C
- END IF
- END
- SUBROUTINE FTRIM(OLDDEV,OLDDIR,OUTLIB,INIT,IFILEN)
-C
- IMPLICIT INTEGER (A-Z)
- CHARACTER*(*) OLDDEV,OLDDIR,OUTLIB
-C
-C Find NODE + DEVICE
-C
- INODIN = 1
- INODEN = INDEX(OUTLIB,'::') + 1
- IF(INODEN.EQ.1) INODEN = 0
- IDEVIN = INODEN + 1
- IDEVEN = INDEX(OUTLIB(IDEVIN:),':') + IDEVIN - 1
- IDIRIN = IDEVEN + 1
- IDIREN = IDEVEN + LASTPO(']',OUTLIB(IDIRIN:),LEN(OUTLIB)-IDIRIN)
- IFILIN = IDIREN + 1
- IFILEN = INDEX(OUTLIB(IFILIN:),'.')+IFILIN-2
- INIT = IFILIN
- IF(OLDDEV.NE.OUTLIB(INODIN:IDEVEN)) THEN
- OLDDEV = OUTLIB(INODIN:IDEVEN)
- INIT = INODIN
- IF(OLDDIR.NE.OUTLIB(IDIRIN:IDIREN)) THEN
- OLDDIR = OUTLIB(IDIRIN:IDIREN)
- END IF
- ELSE
- IF(OLDDIR.NE.OUTLIB(IDIRIN:IDIREN)) THEN
- OLDDIR = OUTLIB(IDIRIN:IDIREN)
- INIT = IDIRIN
- END IF
- END IF
- END
- FUNCTION LASTPO(CHR,STRING,ISTRT)
- CHARACTER*(*) STRING
- CHARACTER*1 CHR
- N=ISTRT
- DO WHILE(STRING(N:N).NE.CHR.AND.N.GT.0)
- N=N-1
- ENDDO
- LASTPO=N
- RETURN
- END
- LOGICAL FUNCTION GKSEXIST(VER)
-C
- IMPLICIT INTEGER(A-Z)
- INCLUDE '($LNMDEF)'
- CHARACTER*255 GKSLIB
- CHARACTER*(*) VER
- INTEGER*2 ITEML2(6)
- INTEGER ITEML4(3)
- EQUIVALENCE (ITEML2,ITEML4)
- EXTERNAL SS$_NOLOGNAM
-
- ITEML2(1)=255
- ITEML2(2)=LNM$_STRING
- ITEML4(2)=%LOC(GKSLIB)
- ITEML4(3)=%LOC(GKSLEN)
- RECODE=SYS$TRNLNM(,'LNM$DCL_LOGICAL','CERN',,ITEML4)
- GKSEXIST=.FALSE.
- IF(RECODE.EQ.%LOC(SS$_NOLOGNAM)) RETURN
-C IF(.NOT.RECODE) RECODE = LIB$SIGNAL(%VAL(RECODE))
-
- GKSLIB(GKSLEN:)='GKS.'//VER//'.LIB]GKS.OLB'
- INQUIRE(FILE=GKSLIB,EXIST=GKSEXIST)
-C
- END
diff --git a/src/packlib/vmslibfiles/cernlibcld.CLD b/src/packlib/vmslibfiles/cernlibcld.CLD
deleted file mode 100644
index d969478..0000000
--- a/src/packlib/vmslibfiles/cernlibcld.CLD
+++ /dev/null
@@ -1,42 +0,0 @@
-#ifndef CERNLIB_CLD
-module cernlibcld
-#endif
-define verb CERNLIB
-#ifdef CERNLIB_CLD
- image "CERN_ROOT:[exe]CERNLIB"
-#endif
- parameter P1,VALUE(NOCONCATENATE,LIST,TYPE=$FILE)
- qualifier INCLUDE,PLACEMENT=LOCAL,NONNEGATABLE
- VALUE(REQUIRED,LIST)
- qualifier LIBRARY,PLACEMENT=LOCAL,NONNEGATABLE
- qualifier SHAREABLE,PLACEMENT=LOCAL,
- VALUE(TYPE=COPY_TYPE)
- qualifier OPTION,PLACEMENT=LOCAL,NONNEGATABLE
- qualifier SELECTIVE_SEARCH,PLACEMENT=LOCAL,NONNEGATABLE
- qualifier HNEW,DEFAULT,PLACEMENT=GLOBAL
- qualifier HOLD,PLACEMENT=GLOBAL
- qualifier PLOT10,PLACEMENT=GLOBAL
- qualifier GTS2D,DEFAULT,PLACEMENT=GLOBAL
- qualifier GTS3D,PLACEMENT=GLOBAL
- qualifier GKS,PLACEMENT=GLOBAL
- qualifier X11,PLACEMENT=GLOBAL
- qualifier MOTIF,PLACEMENT=GLOBAL
- qualifier PHIGS,PLACEMENT=GLOBAL
- qualifier GPHIGS,PLACEMENT=GLOBAL
- qualifier DGKS,PLACEMENT=GLOBAL
- qualifier DECGKS,PLACEMENT=GLOBAL
- qualifier OLD,PLACEMENT=POSITIONAL
- qualifier PRO,PLACEMENT=POSITIONAL
- qualifier NEW,PLACEMENT=POSITIONAL
- qualifier USER,PLACEMENT=GLOBAL
- qualifier LOG,PLACEMENT=GLOBAL,DEFAULT
- qualifier DEBUG,PLACEMENT=GLOBAL
- qualifier CNL,PLACEMENT=POSITIONAL,NONNEGATABLE
- VALUE(REQUIRED,TYPE=$NUMBER)
- disallow (HNEW and HOLD) or (HOLD and GTS2D) or
- (HOLD and GTS3D) or (GTS2D and GTS3D) or
- (HNEW and PLOT10) or (PLOT10 and GTS2D) or
- (PLOT10 and GTS3D)
-
- define type COPY_TYPE
- keyword NOCOPY,NONNEGATABLE
diff --git a/src/packlib/vmslibfiles/cernlibmsg.msg b/src/packlib/vmslibfiles/cernlibmsg.msg
deleted file mode 100644
index d3e14e4..0000000
--- a/src/packlib/vmslibfiles/cernlibmsg.msg
+++ /dev/null
@@ -1,14 +0,0 @@
-.title CERNLIB format conversion utility
-.ident 'VERSION 1.00'
-.facility CERNLIB,1007/prefix=CRN_
-.severity INFORMATION
-NEWLIB <!AS>/fao_count=1
-.severity WARNING
-NOFILE <file !AS not added>/fao_count=1
-NOSUCC <file !AS already encountered>/fao_count=1
-PRODV <no !AS version available for !AS, PRO version used>/fao_count=2
-.severity ERROR
-NOLIB <no library defined>/fao_count=0
-.severity FATAL
-TOOMALNM <too many logical names (!UL) for !AS>/fao_count=2
-.end
diff --git a/src/packlib/vmslibfiles/ctldummy.for b/src/packlib/vmslibfiles/ctldummy.for
deleted file mode 100644
index 7a842f3..0000000
--- a/src/packlib/vmslibfiles/ctldummy.for
+++ /dev/null
@@ -1,4 +0,0 @@
- SUBROUTINE CTL$GL_PCB
- ENTRY CTL$T_ACCOUNT
- ENTRY CTL$T_USERNAME
- END
diff --git a/src/packlib/vmslibfiles/czdummy.for b/src/packlib/vmslibfiles/czdummy.for
deleted file mode 100644
index bf88507..0000000
--- a/src/packlib/vmslibfiles/czdummy.for
+++ /dev/null
@@ -1,34 +0,0 @@
- subroutine czdummy
- entry czopen
- entry czclos
- entry czputa
- entry czgeta
- entry czputc
- entry czgetc
- entry cztcp
- entry CONNECT
- entry GETHOSTBYNAME
- entry GETSERVBYNAME
- entry HTONS
- entry INET_ADDR
- entry RECV
- entry SELECT
- entry SEND
- entry SETSOCKOPT
- entry SHUTDOWN
- entry SOCKET
- entry MULTINET_CONNECT
- entry MULTINET_GETHOSTBYNAME
- entry MULTINET_GETSERVBYNAME
- entry MULTINET_HTONS
- entry MULTINET_INET_ADDR
- entry MULTINET_RECV
- entry MULTINET_SELECT
- entry MULTINET_SEND
- entry MULTINET_SETSOCKOPT
- entry MULTINET_SOCKET
- entry multinet_get_socket_errno_addr
- entry socket_close
- entry socket_ioctl
- entry socket_perror
- end
diff --git a/src/packlib/vmslibfiles/getservbyname.c b/src/packlib/vmslibfiles/getservbyname.c
deleted file mode 100644
index eaa0835..0000000
--- a/src/packlib/vmslibfiles/getservbyname.c
+++ /dev/null
@@ -1,119 +0,0 @@
-
-/* R. Ball (University of Michigan) at the behest of */
-/* J. Shiers (CERN/CN) */
-/* Feb. 11, 1991 */
-/* Replace the non-supported UCX routine getservbyname. */
-/* Input is the pseudo-Unix file SERVFILE[], a copy of */
-/* /etc/services from a Unix machine supporting zftp/zserv. */
-/* alias names are neither searched nor recorded. */
-
-#include <stdio.h>
-#include <string.h> /* strcmp */
-#include <stdlib.h> /* atoi */
-#include <varargs.h>
-#include <netdb.h>
-#include <socket.h>
-#include <in.h>
-
-/* From netdb.h, the servent structure definition follows: */
-/* struct servent { */
-/* char *s_name; */
-/* char **s_aliases; */
-/* int s_port; */
-/* char *s_proto; */
-/* }; */
-
-struct servent *getservucxline (const char *name,const char *proto);
-
-static char SERVFILE[] = "cern:[pro.exe]etc.services";
-static struct servent ucx_sp;
-static char comp_str[80], pro_nam[80];
-
-struct servent *
-getservbyname ( service, protocol )
-const char *service, *protocol;
-{
- struct servent *p;
- p = getservucxline ( service, protocol );
- return (p);
-}
-
-struct servent *
-getservucxline ( service, protocol )
-const char *service, *protocol;
-{
- FILE *inter;
- char string[80], c, *copc;
- int numser, max_string;
- char num_str[80];
- char *ipoint;
- int i, j, k;
-
-/* OPEN the file of services for read_only. Loop, reading the file */
-/* until end of file or the services match. */
- inter = fopen( SERVFILE, "r" );
- while ( (ipoint=fgets( string, 80, inter)) != NULL)
- {
- for (i=0; ((c=string[i])!='#') && (i<80) && (c!='\n'); i++)
- max_string=i;
- if (c!='#') max_string++;
- if (string[0] != '#')
- {
-
-/* First off, find the service name. Be cheap, ignore the aliases. */
- for (i=0; i<max_string; i++)
- {
- if ( ((c=string[i])!= ' ') && (c!='\t')) comp_str[i] = c;
- else
- {
- comp_str[i] = '\0';
- break;
- }
- }
- if (strcmp(service,comp_str) == 0)
- {
-
-/* Keep going as the service name matched. Get the socket number. */
- i++;
- for (j=i; j<max_string; j++)
- {
- if (((c=string[j]) != '\n') && (c != '/')) num_str[j-i] = c;
- else
- {
- num_str[j-i] = '\0';
- break;
- }
- }
- numser = htons((u_short)atoi(num_str));
-
-/* Get the protocol name. We may need to match it. */
- j++;
- for (k=j; k<=max_string; k++)
- {
- if ( ((c=string[k])!=' ') && (c!='\t') && (c!='\n'))
- pro_nam[k-j] = c;
- else
- {
- pro_nam[k-j] = '\0';
- break;
- }
- }
- if ((protocol == NULL) || (strcmp(protocol, pro_nam) == 0))
- {
-
-/* We have a successful match. Fill the structure values and break. */
- ucx_sp.s_port = numser;
- ucx_sp.s_name = comp_str;
- ucx_sp.s_proto = pro_nam;
-/* Ignore the aliases. */
- break;
- }
- }
- }
- }
-
-/* Clean up and exit. */
- fclose(inter);
- if (ipoint == NULL) return(NULL);
- else return(&ucx_sp);
-}
diff --git a/src/packlib/vmslibfiles/gphigs.opt b/src/packlib/vmslibfiles/gphigs.opt
deleted file mode 100644
index 3fa1703..0000000
--- a/src/packlib/vmslibfiles/gphigs.opt
+++ /dev/null
@@ -1,2 +0,0 @@
-CERN:[PHIGS.PRO.GPHIGS_C_V2.LIB]gphigsf2c/lib,gphigsc/lib,-
-sys$share:decw$xlibshr/share
diff --git a/src/packlib/vmslibfiles/grafdgks.opt b/src/packlib/vmslibfiles/grafdgks.opt
deleted file mode 100644
index 6672ec5..0000000
--- a/src/packlib/vmslibfiles/grafdgks.opt
+++ /dev/null
@@ -1 +0,0 @@
-sys$library:GKSFORBND/lib
diff --git a/src/packlib/vmslibfiles/grafmotif.opt b/src/packlib/vmslibfiles/grafmotif.opt
deleted file mode 100644
index a3d27bd..0000000
--- a/src/packlib/vmslibfiles/grafmotif.opt
+++ /dev/null
@@ -1 +0,0 @@
-sys$share:decw$xmlibshr12.exe/share,decw$xtlibshrr5.exe/share,decw$xlibshr.exe/share
diff --git a/src/packlib/vmslibfiles/grafmotif12.opt b/src/packlib/vmslibfiles/grafmotif12.opt
deleted file mode 100644
index a3d27bd..0000000
--- a/src/packlib/vmslibfiles/grafmotif12.opt
+++ /dev/null
@@ -1 +0,0 @@
-sys$share:decw$xmlibshr12.exe/share,decw$xtlibshrr5.exe/share,decw$xlibshr.exe/share
diff --git a/src/packlib/vmslibfiles/grafx11.opt b/src/packlib/vmslibfiles/grafx11.opt
deleted file mode 100644
index 886851d..0000000
--- a/src/packlib/vmslibfiles/grafx11.opt
+++ /dev/null
@@ -1 +0,0 @@
-sys$share:decw$xlibshr.exe/share,decw$dwtlibshr.exe/share
diff --git a/src/packlib/vmslibfiles/grafx11_decw.opt b/src/packlib/vmslibfiles/grafx11_decw.opt
deleted file mode 100644
index d4e8ef8..0000000
--- a/src/packlib/vmslibfiles/grafx11_decw.opt
+++ /dev/null
@@ -1 +0,0 @@
-cern:[decw]decw$xlibshr.exe/share,decw$dwtlibshr.exe/share,decw$transport_common.exe/share
diff --git a/src/packlib/vmslibfiles/gxint316.for b/src/packlib/vmslibfiles/gxint316.for
deleted file mode 100644
index 9c878e9..0000000
--- a/src/packlib/vmslibfiles/gxint316.for
+++ /dev/null
@@ -1,39 +0,0 @@
-CDECK ID>, BLANKDEK.
-*CMZ : 3.16/00 18/10/93 22.23.21 by Federico Carminati
-*-- Author :
-CDECK ID>, BLANKDEK.
-*CMZ : 3.16/00 18/10/93 22.23.21 by Federico Carminati
-*-- Author :
-CDECK ID>, BLANKDEK.
-*CMZ : 3.16/00 03/12/93 20.57.15 by Federico Carminati
-*-- Author :
-CDECK ID>, BLANKDEK.
-*CMZ : 3.16/00 19/11/92 15.01.21 by Federico Carminati
-*-- Author :
-CDECK ID>, GXINT.
-*CMZ : 3.16/00 06/12/93 11.22.04 by Federico Carminati
-*-- Author : Rene Brun 03/01/89
- PROGRAM GXINT
-*
-* GEANT main program. To link with the MOTIF user interface
-* the routine GPAWPP(NWGEAN,NWPAW) should be called, whereas
-* the routine GPAW(NWGEAN,NWPAW) gives access to the basic
-* graphics version.
-*
- PARAMETER (NWGEAN=8000000,NWPAW=1000000)
- COMMON/GCBANK/GEANT(NWGEAN)
- COMMON/PAWC/PAW(NWPAW)
-*
- CALL GPAW(NWGEAN,NWPAW)
-*
- END
- SUBROUTINE QNEXT
- END
- SUBROUTINE CZOPEN
- END
- SUBROUTINE CZTCP
- END
- SUBROUTINE CZCLOS
- END
- SUBROUTINE CZPUTA
- END
diff --git a/src/packlib/vmslibfiles/gxint321.for b/src/packlib/vmslibfiles/gxint321.for
deleted file mode 100644
index 2759eaf..0000000
--- a/src/packlib/vmslibfiles/gxint321.for
+++ /dev/null
@@ -1,57 +0,0 @@
-CDECK ID>, BLANKDEK.
-*CMZ : 3.21/02 29/03/94 15.41.18 by S.Giani
-*-- Author :
-CDECK ID>, BLANKDEK.
-*CMZ : 3.21/04 24/02/95 17.11.40 by S.Giani
-*-- Author :
-CDECK ID>, GEANFC.
-*CMZ : 3.21/04 29/03/94 15.41.50 by S.Giani
-*-- Author :
-CDECK ID>, GEANGC.
-*CMZ : 3.21/04 29/03/94 15.41.50 by S.Giani
-*-- Author :
-CDECK ID>, GEANHC.
-*CMZ : 3.21/04 29/03/94 15.41.50 by S.Giani
-*-- Author :
-CDECK ID>, GEANTC.
-*CMZ : 3.21/04 29/03/94 15.41.50 by S.Giani
-*-- Author :
-CDECK ID>, GEANMC.
-*CMZ : 3.21/04 29/03/94 15.41.50 by S.Giani
-*-- Author :
-CDECK ID>, BLANKDEK.
-*CMZ : 3.21/02 29/03/94 15.41.18 by S.Giani
-*-- Author :
-CDECK ID>, BLANKDEK.
-*CMZ : 3.21/02 29/03/94 15.41.18 by S.Giani
-*-- Author :
-CDECK ID>, BLANKDEK.
-*CMZ : 3.21/02 29/03/94 15.41.32 by S.Giani
-*-- Author :
-CDECK ID>, GXINT.
-*CMZ : 3.21/02 29/03/94 15.41.33 by S.Giani
-*-- Author :
- PROGRAM GXINT
-*
-* GEANT main program. To link with the MOTIF user interface
-* the routine GPAWPP(NWGEAN,NWPAW) should be called, whereas
-* the routine GPAW(NWGEAN,NWPAW) gives access to the basic
-* graphics version.
-*
- PARAMETER (NWGEAN=3000000,NWPAW=1000000)
- COMMON/GCBANK/GEANT(NWGEAN)
- COMMON/PAWC/PAW(NWPAW)
-*
- CALL GPAW(NWGEAN,NWPAW)
-*
- END
- SUBROUTINE QNEXT
- END
- SUBROUTINE CZOPEN
- END
- SUBROUTINE CZTCP
- END
- SUBROUTINE CZCLOS
- END
- SUBROUTINE CZPUTA
- END
diff --git a/src/packlib/vmslibfiles/kuip.opt b/src/packlib/vmslibfiles/kuip.opt
deleted file mode 100644
index 2286fda..0000000
--- a/src/packlib/vmslibfiles/kuip.opt
+++ /dev/null
@@ -1,9 +0,0 @@
-PSECT_ATTR=KCVECT,QUAD
-PSECT_ATTR=QUEST,QUAD
-PSECT_ATTR=KCUTIL,QUAD
-PSECT_ATTR=SIKUIP,QUAD
-PSECT_ATTR=KCPARC,QUAD
-PSECT_ATTR=KCWORK,QUAD
-PSECT_ATTR=PAWLUN,QUAD
-PSECT_ATTR=H_NERR,QUAD
-PSECT_ATTR=H_ERRLIST,QUAD
diff --git a/src/packlib/vmslibfiles/kuip_decc.opt b/src/packlib/vmslibfiles/kuip_decc.opt
deleted file mode 100644
index 2286fda..0000000
--- a/src/packlib/vmslibfiles/kuip_decc.opt
+++ /dev/null
@@ -1,9 +0,0 @@
-PSECT_ATTR=KCVECT,QUAD
-PSECT_ATTR=QUEST,QUAD
-PSECT_ATTR=KCUTIL,QUAD
-PSECT_ATTR=SIKUIP,QUAD
-PSECT_ATTR=KCPARC,QUAD
-PSECT_ATTR=KCWORK,QUAD
-PSECT_ATTR=PAWLUN,QUAD
-PSECT_ATTR=H_NERR,QUAD
-PSECT_ATTR=H_ERRLIST,QUAD
diff --git a/src/packlib/vmslibfiles/mndummy.for b/src/packlib/vmslibfiles/mndummy.for
deleted file mode 100644
index 3654a4d..0000000
--- a/src/packlib/vmslibfiles/mndummy.for
+++ /dev/null
@@ -1,17 +0,0 @@
- subroutine mndummy
- entry MULTINET_CONNECT
- entry MULTINET_GETHOSTBYNAME
- entry MULTINET_GETSERVBYNAME
- entry MULTINET_HTONS
- entry MULTINET_INET_ADDR
- entry MULTINET_RECV
- entry MULTINET_SELECT
- entry MULTINET_SEND
- entry MULTINET_SETSOCKOPT
- entry MULTINET_SHUTDOWN
- entry MULTINET_SOCKET
- entry multinet_get_socket_errno_addr
- entry socket_close
- entry socket_ioctl
- entry socket_perror
- end
diff --git a/src/packlib/vmslibfiles/packlib.opt b/src/packlib/vmslibfiles/packlib.opt
deleted file mode 100644
index e372f0f..0000000
--- a/src/packlib/vmslibfiles/packlib.opt
+++ /dev/null
@@ -1,190 +0,0 @@
-PACKSHARE/shareable
-PSECT_ATTR=$BLANK,NOSHR
-PSECT_ATTR=CFREAD,NOSHR
-PSECT_ATTR=CIUMOD,NOSHR
-PSECT_ATTR=DZC1,NOSHR
-PSECT_ATTR=DZC1CH,NOSHR
-PSECT_ATTR=EPCOMM,NOSHR
-PSECT_ATTR=EPVAXN,NOSHR
-PSECT_ATTR=FFCHAR,NOSHR
-PSECT_ATTR=FFCOMM,NOSHR
-PSECT_ATTR=FZCF,NOSHR
-PSECT_ATTR=FZCI,NOSHR
-PSECT_ATTR=FZCOCC,NOSHR
-PSECT_ATTR=FZCSEG,NOSHR
-PSECT_ATTR=FZCX,NOSHR
-PSECT_ATTR=FZSTAT,NOSHR
-PSECT_ATTR=HCBITS,NOSHR
-PSECT_ATTR=HCBOOK,NOSHR
-PSECT_ATTR=HCDIRC,NOSHR
-PSECT_ATTR=HCDIRN,NOSHR
-PSECT_ATTR=HCFILE,NOSHR
-PSECT_ATTR=HCFIT1,NOSHR
-PSECT_ATTR=HCFIT2,NOSHR
-PSECT_ATTR=HCFIT3,NOSHR
-PSECT_ATTR=HCFIT6,NOSHR
-PSECT_ATTR=HCFITF,NOSHR
-PSECT_ATTR=HCFITN,NOSHR
-PSECT_ATTR=HCFITR,NOSHR
-PSECT_ATTR=HCFITS,NOSHR
-PSECT_ATTR=HCFLAG,NOSHR
-PSECT_ATTR=HCFORM,NOSHR
-PSECT_ATTR=HCGARB,NOSHR
-PSECT_ATTR=HCMAIL,NOSHR
-PSECT_ATTR=HCPAR0,NOSHR
-PSECT_ATTR=HCPAR1,NOSHR
-PSECT_ATTR=HCPAR2,NOSHR
-PSECT_ATTR=HCPOUT,NOSHR
-PSECT_ATTR=HCPRIN,NOSHR
-PSECT_ATTR=HCUNIT,NOSHR
-PSECT_ATTR=HCVERS,NOSHR
-PSECT_ATTR=HEXPO,NOSHR
-PSECT_ATTR=HFLAG,NOSHR
-PSECT_ATTR=HFORM,NOSHR
-PSECT_ATTR=HI3DVW,NOSHR
-PSECT_ATTR=HIATT,NOSHR
-PSECT_ATTR=HIDIM,NOSHR
-PSECT_ATTR=HIFLAG,NOSHR
-PSECT_ATTR=HIFLAT,NOSHR
-PSECT_ATTR=HILBL1,NOSHR
-PSECT_ATTR=HILBL2,NOSHR
-PSECT_ATTR=HILINK,NOSHR
-PSECT_ATTR=HILOC,NOSHR
-PSECT_ATTR=HILUN,NOSHR
-PSECT_ATTR=HIMAIC,NOSHR
-PSECT_ATTR=HIMENU,NOSHR
-PSECT_ATTR=HIMETA,NOSHR
-PSECT_ATTR=HINT,NOSHR
-PSECT_ATTR=HINUM,NOSHR
-PSECT_ATTR=HIPOSC,NOSHR
-PSECT_ATTR=HIPOST,NOSHR
-PSECT_ATTR=HIPTR,NOSHR
-PSECT_ATTR=HISAVE,NOSHR
-PSECT_ATTR=HISIZE,NOSHR
-PSECT_ATTR=HIVERS,NOSHR
-PSECT_ATTR=HMIBUF,NOSHR
-PSECT_ATTR=KAX010,NOSHR
-PSECT_ATTR=KAX020,NOSHR
-PSECT_ATTR=KAX02C,NOSHR
-PSECT_ATTR=KAX030,NOSHR
-PSECT_ATTR=KAX040,NOSHR
-PSECT_ATTR=KAX050,NOSHR
-PSECT_ATTR=KAX060,NOSHR
-PSECT_ATTR=KAX070,NOSHR
-PSECT_ATTR=KAX080,NOSHR
-PSECT_ATTR=KAX090,NOSHR
-PSECT_ATTR=KAX0A0,NOSHR
-PSECT_ATTR=KAX0B0,NOSHR
-PSECT_ATTR=KCALIA,NOSHR
-PSECT_ATTR=KCALIC,NOSHR
-PSECT_ATTR=KCAPPL,NOSHR
-PSECT_ATTR=KCAPPM,NOSHR
-PSECT_ATTR=KCBANC,NOSHR
-PSECT_ATTR=KCBRE0,NOSHR
-PSECT_ATTR=KCBREK,NOSHR
-PSECT_ATTR=KCDBUG,NOSHR
-PSECT_ATTR=KCERR,NOSHR
-PSECT_ATTR=KCEXEL,NOSHR
-PSECT_ATTR=KCEXIT,NOSHR
-PSECT_ATTR=KCFORM,NOSHR
-PSECT_ATTR=KCGKS,NOSHR
-PSECT_ATTR=KCGKSC,NOSHR
-PSECT_ATTR=KCGUID,NOSHR
-PSECT_ATTR=KCHELP,NOSHR
-PSECT_ATTR=KCHIS,NOSHR
-PSECT_ATTR=KCHISC,NOSHR
-PSECT_ATTR=KCLAST,NOSHR
-PSECT_ATTR=KCLINK,NOSHR
-PSECT_ATTR=KCLUI,NOSHR
-PSECT_ATTR=KCMAC,NOSHR
-PSECT_ATTR=KCMACC,NOSHR
-PSECT_ATTR=KCMEC,NOSHR
-PSECT_ATTR=KCMECC,NOSHR
-PSECT_ATTR=KCMECI,NOSHR
-PSECT_ATTR=KCMENU,NOSHR
-PSECT_ATTR=KCNDPV,NOSHR
-PSECT_ATTR=KCNWG,NOSHR
-PSECT_ATTR=KCPARC,NOSHR
-PSECT_ATTR=KCPARI,NOSHR
-PSECT_ATTR=KCPARS,NOSHR
-PSECT_ATTR=KCPART,NOSHR
-PSECT_ATTR=KCROOT,NOSHR
-PSECT_ATTR=KCSIGM,NOSHR
-PSECT_ATTR=KCSPR,NOSHR
-PSECT_ATTR=KCUNIT,NOSHR
-PSECT_ATTR=KCUSER,NOSHR
-PSECT_ATTR=KCUTIL,NOSHR
-PSECT_ATTR=KCVADD,NOSHR
-PSECT_ATTR=KCVAX,NOSHR
-PSECT_ATTR=KCVECT,NOSHR
-PSECT_ATTR=KCWIND,NOSHR
-PSECT_ATTR=KCWORK,NOSHR
-PSECT_ATTR=MN7ARG,NOSHR
-PSECT_ATTR=MN7CNS,NOSHR
-PSECT_ATTR=MN7CNV,NOSHR
-PSECT_ATTR=MN7CPT,NOSHR
-PSECT_ATTR=MN7DER,NOSHR
-PSECT_ATTR=MN7ERR,NOSHR
-PSECT_ATTR=MN7EXT,NOSHR
-PSECT_ATTR=MN7FLG,NOSHR
-PSECT_ATTR=MN7FX1,NOSHR
-PSECT_ATTR=MN7FX2,NOSHR
-PSECT_ATTR=MN7FX3,NOSHR
-PSECT_ATTR=MN7INT,NOSHR
-PSECT_ATTR=MN7INX,NOSHR
-PSECT_ATTR=MN7IO2,NOSHR
-PSECT_ATTR=MN7IOU,NOSHR
-PSECT_ATTR=MN7LOG,NOSHR
-PSECT_ATTR=MN7MIN,NOSHR
-PSECT_ATTR=MN7NAM,NOSHR
-PSECT_ATTR=MN7NPR,NOSHR
-PSECT_ATTR=MN7RPT,NOSHR
-PSECT_ATTR=MN7SIM,NOSHR
-PSECT_ATTR=MN7TIT,NOSHR
-PSECT_ATTR=MN7VAR,NOSHR
-PSECT_ATTR=MN7VAT,NOSHR
-PSECT_ATTR=MN7WRC,NOSHR
-PSECT_ATTR=MN7WRI,NOSHR
-PSECT_ATTR=MN7XCR,NOSHR
-PSECT_ATTR=MZCA,NOSHR
-PSECT_ATTR=MZCB,NOSHR
-PSECT_ATTR=MZCC,NOSHR
-PSECT_ATTR=MZCL,NOSHR
-PSECT_ATTR=MZCN,NOSHR
-PSECT_ATTR=MZCT,NOSHR
-PSECT_ATTR=MZCWK,NOSHR
-PSECT_ATTR=MZIOC,NOSHR
-PSECT_ATTR=OPENCOM,NOSHR
-PSECT_ATTR=PAWC,NOSHR
-PSECT_ATTR=PAWIDN,NOSHR
-PSECT_ATTR=PAWPAR,NOSHR
-PSECT_ATTR=QUEST,NOSHR
-PSECT_ATTR=RANEC1,NOSHR
-PSECT_ATTR=RANMA1,NOSHR
-PSECT_ATTR=RANMA2,NOSHR
-PSECT_ATTR=RZCH,NOSHR
-PSECT_ATTR=RZCKEY,NOSHR
-PSECT_ATTR=RZCL,NOSHR
-PSECT_ATTR=RZCLUN,NOSHR
-PSECT_ATTR=RZCOUT,NOSHR
-PSECT_ATTR=RZDIRC,NOSHR
-PSECT_ATTR=RZDIRN,NOSHR
-PSECT_ATTR=SIKUIP,NOSHR
-PSECT_ATTR=SLATE,NOSHR
-PSECT_ATTR=TLSDIM,NOSHR
-PSECT_ATTR=VAXTIOC,NOSHR
-PSECT_ATTR=VIEWVE,NOSHR
-PSECT_ATTR=ZBCD,NOSHR
-PSECT_ATTR=ZBCDCH,NOSHR
-PSECT_ATTR=ZCETA,NOSHR
-PSECT_ATTR=ZCFORM,NOSHR
-PSECT_ATTR=ZEBQ,NOSHR
-PSECT_ATTR=ZHEADP,NOSHR
-PSECT_ATTR=ZKRAKC,NOSHR
-PSECT_ATTR=ZLIMIT,NOSHR
-PSECT_ATTR=ZMACH,NOSHR
-PSECT_ATTR=ZNATUR,NOSHR
-PSECT_ATTR=ZSTATE,NOSHR
-PSECT_ATTR=ZTELLC,NOSHR
-PSECT_ATTR=ZUNIT,NOSHR
-PSECT_ATTR=ZUNITZ,NOSHR
diff --git a/src/packlib/vmslibfiles/squeeze.opt b/src/packlib/vmslibfiles/squeeze.opt
deleted file mode 100644
index 0869482..0000000
--- a/src/packlib/vmslibfiles/squeeze.opt
+++ /dev/null
@@ -1,12 +0,0 @@
-!
-! Linker options to reduce the image size
-!
-! Uninitialised, writeable portion of image section
-! only eligible for compression if it contains at
-! least 20 contiguous pages
-!
-DZRO_MIN=20
-!
-! Compression stops at 512 image sections
-!
-ISD_MAX=512
diff --git a/src/packlib/vmslibfiles/sysexe.opt b/src/packlib/vmslibfiles/sysexe.opt
deleted file mode 100644
index 9ce6a11..0000000
--- a/src/packlib/vmslibfiles/sysexe.opt
+++ /dev/null
@@ -1 +0,0 @@
-SYS$SYSTEM:sys.stb
diff --git a/src/packlib/vmslibfiles/tcpmod.opt b/src/packlib/vmslibfiles/tcpmod.opt
deleted file mode 100644
index 50c686d..0000000
--- a/src/packlib/vmslibfiles/tcpmod.opt
+++ /dev/null
@@ -1,5 +0,0 @@
-!
-! Linker options to reduce the image size
-!
-ISD_MAX=512 ! Maximum number oof image sections
-DZRO_MIN=20 ! Minimum size of a demand zero page
diff --git a/src/packlib/vmslibfiles/vmslib_m.opt b/src/packlib/vmslibfiles/vmslib_m.opt
deleted file mode 100644
index ae00b8e..0000000
--- a/src/packlib/vmslibfiles/vmslib_m.opt
+++ /dev/null
@@ -1 +0,0 @@
-multinet_socket_library/share
diff --git a/src/packlib/vmslibfiles/vmslib_m_decc.opt b/src/packlib/vmslibfiles/vmslib_m_decc.opt
deleted file mode 100644
index ae00b8e..0000000
--- a/src/packlib/vmslibfiles/vmslib_m_decc.opt
+++ /dev/null
@@ -1 +0,0 @@
-multinet_socket_library/share
diff --git a/src/packlib/vmslibfiles/vmslib_u.opt b/src/packlib/vmslibfiles/vmslib_u.opt
deleted file mode 100644
index e69de29..0000000
diff --git a/src/packlib/vmslibfiles/vmslib_u.opt_vax b/src/packlib/vmslibfiles/vmslib_u.opt_vax
deleted file mode 100644
index 690800c..0000000
--- a/src/packlib/vmslibfiles/vmslib_u.opt_vax
+++ /dev/null
@@ -1,2 +0,0 @@
-SYS$LIBRARY:ucx$ipc/lib
-SYS$LIBRARY:vaxcrtl/share
diff --git a/src/packlib/vmslibfiles/vmslib_u_decc.opt b/src/packlib/vmslibfiles/vmslib_u_decc.opt
deleted file mode 100644
index d4f6e34..0000000
--- a/src/packlib/vmslibfiles/vmslib_u_decc.opt
+++ /dev/null
@@ -1 +0,0 @@
-SYS$LIBRARY:ucx$ipc/lib
diff --git a/src/packlib/vmslibfiles/vmslib_w.opt b/src/packlib/vmslibfiles/vmslib_w.opt
deleted file mode 100644
index eed6bd4..0000000
--- a/src/packlib/vmslibfiles/vmslib_w.opt
+++ /dev/null
@@ -1,2 +0,0 @@
-CERN_ROOT:[lib]VMSLIB/lib
-SYS$LIBRARY:vaxcrtl/share
diff --git a/src/packlib/vmslibfiles/vmslib_w_decc.opt b/src/packlib/vmslibfiles/vmslib_w_decc.opt
deleted file mode 100644
index bae225a..0000000
--- a/src/packlib/vmslibfiles/vmslib_w_decc.opt
+++ /dev/null
@@ -1 +0,0 @@
-CERN_ROOT:[lib]VMSLIB/lib
diff --git a/src/packlib/vmslibfiles/xxint.c b/src/packlib/vmslibfiles/xxint.c
deleted file mode 100644
index 81ec749..0000000
--- a/src/packlib/vmslibfiles/xxint.c
+++ /dev/null
@@ -1,2410 +0,0 @@
-/*CMZ : 16/08/94 14.51.11 by O.Couet*/
-/*CMZ : 1.21/08 08/07/94 17.41.47 by O.Couet*/
-/*CMZ : 1.21/07 30/06/94 10.24.16 by O.Couet*/
-/*CMZ : 1.21/06 27/06/94 17.01.24 by O.Couet*/
-/*CMZ : 1.21/05 14/06/94 17.42.26 by O.Couet*/
-/*CMZ : 1.21/04 09/06/94 12.47.15 by O.Couet*/
-/*CMZ : 1.21/03 02/06/94 13.23.37 by O.Couet*/
-/*CMZ : 1.21/01 31/03/94 17.34.56 by O.Couet*/
-/*CMZ : 1.20/10 16/02/94 09.23.02 by O.Couet*/
-/*CMZ : 1.20/09 24/01/94 14.21.32 by O.Couet*/
-/*CMZ : 1.20/08 19/01/94 14.42.58 by O.Couet*/
-/*CMZ : 1.20/07 13/01/94 11.20.40 by O.Couet*/
-/*CMZ : 1.20/03 23/11/93 10.55.06 by O.Couet*/
-/*-- Author : O.Couet*/
-/*
- * Fortran interface to X11 window routines for HIGZ
- */
-#include <stdio.h>
-#include <string.h>
-#include <stdlib.h>
-#include <ctype.h>
-#include <math.h>
-#include <descrip.h>
-#include <lnmdef.h>
-#include <types.h>
-#include <socket.h> /* for gethostname() */
-#define CADDR_T /* defined in types.h would be redefined in Xlib.h */
-#include <decw$include/Xlib.h>
-#include <decw$include/Xutil.h>
-#include <decw$include/Xatom.h>
-#include <decw$include/cursorfont.h>
-#include <decw$include/keysym.h>
-
-#define max(a,b) ((a) > (b) ? (a) : (b))
-#define min(a,b) ((a) < (b) ? (a) : (b))
-#define forever while(1)
-#define LNULL 0L
-
-#define MAXWN 20 /* maximum number of windows */
-static struct {
- int open; /* 1 if the window is open, 0 if not */
- int motif; /* 1 if the window is a motif window */
- Drawable motif_window; /* adress of the Motif window */
- int double_buffer; /* 1 if the double buffer is on, 0 if not */
- Drawable drawing; /* drawing area, equal to window or buffer */
- Drawable window; /* X11 window */
- Drawable buffer; /* pixmap used for double buffer */
- int width; /* width of the window */
- int height; /* height of the window */
- int clip; /* 1 if the clipping is on */
- int xclip; /* x coordinate of the clipping rectangle */
- int yclip; /* y coordinate of the clipping rectangle */
- int wclip; /* width of the clipping rectangle */
- int hclip; /* height of the clipping rectangle */
-} windows[MAXWN], /* windows : list of the opened windows */
- *cws, *tws, *sws; /* cws : pointer to the current window */
- /* tws : temporary pointer */
- /* sws : saved window (ixsavwi ixsetwi) */
-
-Drawable oldwin; /* allows to save the current opened window */
-static int ispix = 0; /* if ispix=1 a pixmap has been opened */
-
-static XClassHint class_hints = {"higz", "HIGZ"}; /* Class name is HIGZ */
-
-static Display *display;
-static int isdisp = 0; /* if isdisp=1 the display has been opened */
-static Screen *screen;
-static int screen_number;
-static char hname[132]; /* host name */
-static char vendor[132]; /* output of XServerVendor */
-
-static Window (*motif_open) (); /* external routine to open a motif window */
-static void (*motif_init) (); /* external routine to init a motif window */
-static void (*motif_close) (); /* external routine to close a motif window */
-
-static int external_int = 0;
-static Drawable external_window;
-
-static int do_raise = 0; /* if do_raise =1 cws is raised in ixupdwi */
-
-/*
- * colors[1] : foreground also used for b/w screen
- * colors[0] : background also used for b/w screen
- * colors[2..MAXCOL-1] : colors which can be set by IXSETCO
- */
-static int colored; /* Flag if color screen */
-static Colormap colormap; /* Maba's Colormap */
-
-#define MAXCOL 256
-static struct {
- int defined;
- unsigned long pixel;
- float red;
- float green;
- float blue;
-} colors[MAXCOL] = {0, 0, 1., 1., 1.};
-
-/*
- * Primitives Graphic Contexts global for all windows
- */
-#define MAXGC 7
-static GC gclist[MAXGC];
-static GC *gcline = &gclist[0]; /* Polylines */
-static GC *gcmark = &gclist[1]; /* Polymarker */
-static GC *gcfill = &gclist[2]; /* Fill areas */
-static GC *gctext = &gclist[3]; /* Text */
-static GC *gcinvt = &gclist[4]; /* Inverse text */
-static GC *gcdash = &gclist[5]; /* Dashed lines */
-static GC *gcpxmp = &gclist[6]; /* Pixmap management */
-
-static unsigned long gc_mask = GCForeground | GCBackground;
-static XGCValues gc_return;
-
-/*
- * Input echo Graphic Context global for all windows
- */
-static GC gcecho; /* input echo */
-static XGCValues gcechov;
-
-static int fill_hollow; /* Flag if fill style is hollow */
-static Pixmap fill_pattern = (Pixmap)LNULL; /* Fill pattern */
-static int current_fasi = 0; /* Current fill area style index */
-static int text_align = 0; /* Align text left, center, right */
-
-/*
- * Text management
- */
-#define MAXFONT 4
-static struct {
- XFontStruct *id;
- char name[80]; /* font name */
-} font[MAXFONT]; /* list of fonts loaded */
-static XFontStruct *text_font; /* current font */
-static int current_font_number = 0; /* current font number in font[] */
-
-/*
- * keep style values for line GC
- */
-static int line_width = 0;
-static int line_style = LineSolid;
-static int cap_style = CapButt;
-static int join_style = JoinMiter;
-static char dash_list[4];
-static int dash_length = 0;
-static int dash_offset = 0;
-
-/*
- * event masks
- */
-static unsigned long mouse_mask = ButtonPressMask | ButtonReleaseMask |
- EnterWindowMask | LeaveWindowMask |
- PointerMotionMask | KeyPressMask |
- KeyReleaseMask;
-static unsigned long keybd_mask = ButtonPressMask | KeyPressMask |
- EnterWindowMask | LeaveWindowMask;
-
-/*
- * last cursor positions
- */
-static int xloc = 0;
-static int yloc = 0;
-static int xlocp = 0;
-static int ylocp = 0;
-
-/*
- * data to create an invisible cursor
- */
-static char null_cursor_bits[] = {
-0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
-static Cursor null_cursor = (Cursor)LNULL;
-
-/*
- * data to create fill area interior style
- */
-static char p1_bits[] = {
- 0xaa, 0xaa, 0x55, 0x55, 0xaa, 0xaa, 0x55, 0x55, 0xaa, 0xaa, 0x55, 0x55,
- 0xaa, 0xaa, 0x55, 0x55, 0xaa, 0xaa, 0x55, 0x55, 0xaa, 0xaa, 0x55, 0x55,
- 0xaa, 0xaa, 0x55, 0x55, 0xaa, 0xaa, 0x55, 0x55};
-static char p2_bits[] = {
- 0x44, 0x44, 0x11, 0x11, 0x44, 0x44, 0x11, 0x11, 0x44, 0x44, 0x11, 0x11,
- 0x44, 0x44, 0x11, 0x11, 0x44, 0x44, 0x11, 0x11, 0x44, 0x44, 0x11, 0x11,
- 0x44, 0x44, 0x11, 0x11, 0x44, 0x44, 0x11, 0x11};
-static char p3_bits[] = {
- 0x00, 0x00, 0x44, 0x44, 0x00, 0x00, 0x11, 0x11, 0x00, 0x00, 0x44, 0x44,
- 0x00, 0x00, 0x11, 0x11, 0x00, 0x00, 0x44, 0x44, 0x00, 0x00, 0x11, 0x11,
- 0x00, 0x00, 0x44, 0x44, 0x00, 0x00, 0x11, 0x11};
-static char p4_bits[] = {
- 0x80, 0x80, 0x40, 0x40, 0x20, 0x20, 0x10, 0x10, 0x08, 0x08, 0x04, 0x04,
- 0x02, 0x02, 0x01, 0x01, 0x80, 0x80, 0x40, 0x40, 0x20, 0x20, 0x10, 0x10,
- 0x08, 0x08, 0x04, 0x04, 0x02, 0x02, 0x01, 0x01};
-static char p5_bits[] = {
- 0x20, 0x20, 0x40, 0x40, 0x80, 0x80, 0x01, 0x01, 0x02, 0x02, 0x04, 0x04,
- 0x08, 0x08, 0x10, 0x10, 0x20, 0x20, 0x40, 0x40, 0x80, 0x80, 0x01, 0x01,
- 0x02, 0x02, 0x04, 0x04, 0x08, 0x08, 0x10, 0x10};
-static char p6_bits[] = {
- 0x44, 0x44, 0x44, 0x44, 0x44, 0x44, 0x44, 0x44, 0x44, 0x44, 0x44, 0x44,
- 0x44, 0x44, 0x44, 0x44, 0x44, 0x44, 0x44, 0x44, 0x44, 0x44, 0x44, 0x44,
- 0x44, 0x44, 0x44, 0x44, 0x44, 0x44, 0x44, 0x44};
-static char p7_bits[] = {
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0xff, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0xff, 0xff, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0xff,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0xff};
-static char p8_bits[] = {
- 0x11, 0x11, 0xb8, 0xb8, 0x7c, 0x7c, 0x3a, 0x3a, 0x11, 0x11, 0xa3, 0xa3,
- 0xc7, 0xc7, 0x8b, 0x8b, 0x11, 0x11, 0xb8, 0xb8, 0x7c, 0x7c, 0x3a, 0x3a,
- 0x11, 0x11, 0xa3, 0xa3, 0xc7, 0xc7, 0x8b, 0x8b};
-static char p9_bits[] = {
- 0x10, 0x10, 0x10, 0x10, 0x28, 0x28, 0xc7, 0xc7, 0x01, 0x01, 0x01, 0x01,
- 0x82, 0x82, 0x7c, 0x7c, 0x10, 0x10, 0x10, 0x10, 0x28, 0x28, 0xc7, 0xc7,
- 0x01, 0x01, 0x01, 0x01, 0x82, 0x82, 0x7c, 0x7c};
-
-#define MAXMK 100
-static struct {
- int type;
- int n;
- XPoint xy[MAXMK];
-} marker; /* point list to draw marker */
-
-
-/*
- * Set input on or off
- */
-void
- setinput(inp)
-int inp;
-{
- XSetWindowAttributes attributes;
- unsigned long attr_mask = 0;
-
- if( inp == 1 ) {
- attributes.event_mask = mouse_mask | keybd_mask;
- attr_mask |= CWEventMask;
- XChangeWindowAttributes ( display, cws->window, attr_mask, &attributes);
- }
- else {
- attr_mask = 0;
- attributes.event_mask = NoEventMask;
- attr_mask |= CWEventMask;
- XChangeWindowAttributes ( display, cws->window, attr_mask, &attributes);
- }
-}
-
-
-/*
- * set the foreground color in GC
- */
-void
- setcolor( gc, ci )
-GC gc;
-int ci;
-{
- if( colored && ( ci < 0 || ci >= MAXCOL || !colors[ci].defined ) )
- {
- ci = 0;
- }
- else if (!colored && ci < 0 )
- {
- ci = 0;
- }
- else if (!colored && ci > 0 )
- {
- ci = 1;
- }
-
- XSetForeground( display, gc, colors[ci].pixel );
-
- /* make sure that foreground and background are different */
- if( gc->values.foreground == gc->values.background )
- XSetBackground( display, gc, colors[!ci].pixel );
-}
-
-
-/*
- * return null terminated and blank trimmed string
- */
-char*
- string( s, l )
-char *s;
-int l;
-{
- static char str[256];
- int i;
-
- if( l >= sizeof( str ) )
- l = sizeof( str ) - 1;
-
- for( i = 0; i < l; i++ )
- str[i] = s[i];
- while( l > 0 && str[l-1] == ' ' )
- l--;
-
- str[l] = '\0';
- return( str );
-}
-
-
-
-
-/*
- * Allows to set the DISPLAY and the WINDOW address
- * from outside HIGZ (ie a MOTIF program).
- */
-void
- ixsdswi( dsp , win )
- Display *dsp;
- Window win;
-{
- external_int = 1;
- external_window = win;
- display = dsp;
-}
-
-/*
- * Allows KUIP to give to HIGZ the adress of three routines:
- * 1) motif_open : to open a KUIP motif window
- * 2) motif_init : to initalize a KUIP motif window (add the callbacks)
- * 3) motif_close : to close a KUIP motif window
- */
-void
- ixmotif( dsp , open, init, close)
- Display *dsp;
- Window (*open)();
- void (*init)();
- void (*close)();
-{
- display = dsp;
- motif_open = open;
- motif_init = init;
- motif_close = close;
-}
-
-
-/*
- * SUBROUTINE IXMINIT(WID)
- * INTEGER WID : Window ID
- *
- * Initialize the Motif windows (add the callbacks)
- */
-void
- ixminit(wid)
- int *wid;
-{
- if (motif_init != NULL) (*motif_init) (*wid+1);
-}
-
-
-/*
- * SUBROUTINE IXSETHN(LENHST,HOST)
- * INTEGER LENHST : host name length
- * CHARACTER*(*) HOST : host name
- *
- * Set host name (fill global variable hname)
- */
-void
- ixsethn( lenhst,
- dsc_host )
-struct dsc$descriptor_s *dsc_host;
-int *lenhst;
-{
- char *host = dsc_host->dsc$a_pointer;
-
-strcpy (hname,string( host, *lenhst ));
-}
-
-
-/*
- * INTEGER FUNCTION IXOPNDS(LENHST,HOST)
- * INTEGER LENHST : host name length
- * CHARACTER*(*) HOST : host name
- *
- * Open the display. Return -1 if the opening fails
- */
-int
- ixopnds( lenhst,
- dsc_host )
-struct dsc$descriptor_s *dsc_host;
-int *lenhst;
-{
- char *host = dsc_host->dsc$a_pointer;
- Pixmap pixmp1,pixmp2;
- XColor fore,back;
- char **fontlist;
- int fontcount;
- int i;
- extern char *getenv();
-
-/*
- * Try to open the DISPLAY
- */
- if( display == NULL ) {
- display = XOpenDisplay( string( host, *lenhst ));
- if( display == NULL ) return( -1 );
- }
-
- screen_number = DefaultScreen( display );
- screen = ScreenOfDisplay( display, screen_number);
- colored = DisplayPlanes( display, screen_number ) > 1;
-
- if(colored) colormap = DefaultColormap( display, screen_number);
-
- colors[1].defined = 1; /* default foreground */
- colors[1].pixel = BlackPixel( display, screen_number );
- colors[0].defined = 1; /* default background */
- colors[0].pixel = WhitePixel( display, screen_number );
-
-/*
- * Inquire the the XServer Vendor
- */
- strcpy (vendor,XServerVendor(display));
-
-/*
- * Create primitives graphic contexts
- */
- for( i = 0; i < MAXGC; i++ )
- gclist[i] = XCreateGC( display, RootWindow( display, screen_number ),
- 0, NULL );
- XSetForeground( display, *gcinvt, (*gctext)->values.background );
- XSetBackground( display, *gcinvt, (*gctext)->values.foreground );
-
-
-/*
- * Create input echo graphic context
- */
- gcechov.foreground = BlackPixel( display, screen_number );
- gcechov.background = WhitePixel( display, screen_number );
- if(strstr(vendor,"Hewlett")) {
- gcechov.function = GXxor;
- } else {
- gcechov.function = GXinvert;
- }
- gcecho = XCreateGC( display, RootWindow( display, screen_number ),
- GCForeground | GCBackground | GCFunction,
- &gcechov );
-/*
- * Load a default Font
- */
- if ( !isdisp ) {
- fontlist = XListFonts( display, "*courier*", 1, &fontcount );
- if ( fontcount != 0 ) {
- text_font = XLoadQueryFont( display, fontlist[0] );
- for ( i = 0; i < MAXFONT; i++ ) {
- font[i].id = NULL;
- strcpy( font[i].name, " " );
- }
- current_font_number = 0;
- } else {
- printf("No default font loaded \n");
- }
- isdisp = 1;
- }
-/*
- * Create a null cursor
- */
- pixmp1 = XCreateBitmapFromData(display,
- RootWindow( display, screen_number ),
- null_cursor_bits, 16, 16);
- pixmp2 = XCreateBitmapFromData(display,
- RootWindow( display, screen_number ),
- null_cursor_bits, 16, 16);
- null_cursor = XCreatePixmapCursor(display,pixmp1,pixmp2,&fore,&back,0,0);
- return( 0 );
-}
-
-
-/*
- * INTEGER FUNCTION IXOPNWI(X,Y,W,H,LENTIT,TITLE,FLAG)
- * INTEGER X,Y : initial window position
- * INTEGER W,H : initial window width and height
- * INTEGER LENTIT : title length
- * CHARACTER*(*) TITLE : window title
- * INTEGER FLAG : FLAG<>1 allows to open a non MOTIF window
- * even if ixmotif has been called.
- *
- * Open window and returns window number which can be used with IXSELWIN
- * return -1 if window creation fails
- */
-int
- ixopnwi( x, y, w, h, lentit,
- dsc_title, flag )
-struct dsc$descriptor_s *dsc_title;
-int *x, *y;
-int *w, *h;
-int *lentit;
-int *flag;
-{
- char *title = dsc_title->dsc$a_pointer;
- XSetWindowAttributes attributes;
- unsigned long attr_mask = 0;
- char long_title[256];
- char host_name[64];
- XWMHints wm_hints;
- XSizeHints size_hints;
- int wid;
- int xval, yval;
- unsigned int wval, hval, border, depth;
- Window root;
-
- if (external_int == 1) {
- XGetGeometry( display, external_window, &root,
- &xval, &yval, &wval, &hval, &border, &depth );
- }
- else {
- xval = *x;
- yval = *y;
- wval = *w;
- hval = *h;
- }
-
-/*
- * Select next free window number
- */
- for ( wid = 0; wid < MAXWN; wid++ )
- if ( !windows[wid].open ) {
- windows[wid].open = 1;
- cws = &windows[wid];
- break;
- }
-/*
- * Create a Motif window
- */
- if (motif_open != NULL && *flag == 0) {
- cws->motif_window = (*motif_open) (wid+1, xval, yval, wval, hval);
- if ( !cws->motif_window ) return( -1 );
- XGetGeometry( display, cws->motif_window, &root,
- &xval, &yval, &wval, &hval, &border, &depth );
- }
-
- if ( wid == MAXWN ) return( -1 );
-/*
- * Create window
- */
- attributes.background_pixel = colors[0].pixel;
- attr_mask |= CWBackPixel;
- attributes.border_pixel = colors[1].pixel;
- attr_mask |= CWBorderPixel;
- attributes.event_mask = NoEventMask;
- attr_mask |= CWEventMask;
- attributes.backing_store = Always;
- attr_mask |= CWBackingStore;
- if ( colored ) {
- attributes.colormap = colormap;
- attr_mask |= CWColormap;
- }
- if (motif_open != NULL && *flag == 0) {
- cws->window = XCreateWindow(display, cws->motif_window,
- xval, yval, wval, hval, 0, CopyFromParent,
- InputOutput, CopyFromParent,
- attr_mask, &attributes );
- cws->motif = 1;
- } else {
- if (external_int == 1) {
- cws->window = XCreateWindow(display, external_window,
- xval, yval, wval, hval, 0, CopyFromParent,
- InputOutput, CopyFromParent,
- attr_mask, &attributes );
- external_int = 0;
- cws->motif = 1;
- cws->motif_window = external_window;
- } else {
- cws->motif = 0;
- cws->window = XCreateWindow(display,
- RootWindow( display, screen_number),
- xval, yval, wval, hval, 1, CopyFromParent,
- InputOutput, CopyFromParent,
- attr_mask, &attributes );
- strcpy( long_title, string( title, *lentit ) );
- if (long_title[0] != '-') {
- strcat( long_title, " @ " );
- gethostname( host_name, sizeof( host_name ) );
- strcat( long_title, host_name );
- } else {
- long_title[0] = ' ';
- }
- XStoreName( display, cws->window, long_title );
- XSetIconName( display, cws->window, long_title );
- }
- }
-/*
- * Set window manager hints
- */
- wm_hints.flags = InputHint;
- wm_hints.input = False; /* don't grab input focus */
- XSetWMHints( display, cws->window, &wm_hints );
-/*
- * Set window size hints
- */
- size_hints.flags = USPosition | USSize;
- size_hints.x = xval;
- size_hints.y = yval;
- size_hints.width = wval;
- size_hints.height = hval;
- XSetNormalHints( display, cws->window, &size_hints );
-
- XMoveWindow( display, cws->window, xval, yval );
- XResizeWindow( display, cws->window, wval, hval );
- XMapWindow( display, cws->window );
- XFlush( display );
-/*
- * Set the Class Hint
- */
- XSetClassHint(display, cws->window, &class_hints);
-/*
- * Initialise the window structure
- */
- cws->drawing = cws->window;
- cws->buffer = (Drawable)NULL;
- cws->double_buffer = (int)NULL;
- cws->clip = (int)NULL;
- cws->width = wval;
- cws->height = hval;
-
- return( wid );
-}
-
-
-/*
- * SUBROUTINE IXRSCWI(WID, W, H)
- * INTEGER WID : Window identifier.
- * INTEGER W : Width
- * INTEGER H : Heigth
- *
- * Rescale the window WID
- */
-void
- ixrscwi(wid, w, h)
- int *wid;
- int *w;
- int *h;
-{
- int i;
-
- tws = &windows[*wid];
- if (!tws->open) return;
-
- XResizeWindow( display, tws->window, *w, *h );
-
- if( tws->double_buffer ) {
- XFreePixmap(display,tws->buffer);
- tws->buffer = XCreatePixmap(display, RootWindow( display, screen_number),
- *w, *h, DefaultDepth(display,screen_number));
- for( i = 0; i < MAXGC; i++ ) XSetClipMask( display, gclist[i], None );
- setcolor( *gcpxmp, 0);
- XFillRectangle( display, tws->buffer, *gcpxmp, 0, 0, *w, *h);
- setcolor( *gcpxmp, 1);
- tws->drawing = tws->buffer;
- }
- tws->width = *w;
- tws->height = *h;
-}
-
-void
- ix2bon()
-{
- int i;
-
- if (tws->double_buffer) return;
- tws->buffer = XCreatePixmap(display, RootWindow( display, screen_number),
- tws->width, tws->height, DefaultDepth(display,screen_number));
- for( i = 0; i < MAXGC; i++ ) XSetClipMask( display, gclist[i], None );
- XCopyArea( display, tws->window, tws->buffer,
- *gcpxmp, 0, 0, tws->width, tws->height, 0, 0 );
- tws->double_buffer = 1;
- tws->drawing = tws->buffer;
- return;
-}
-
-void
- ix2boff()
-{
- if (!tws->double_buffer) return;
- XFreePixmap(display,tws->buffer);
- tws->double_buffer = 0;
- tws->drawing = tws->window;
- return;
-}
-
-/*
- * SUBROUTINE IXS2BUF(WID,MODE)
- * INTEGER WID : Window identifier.
- * 999 means all the opened windows.
- * INTEGER MODE : 1 double buffer is on
- * 0 double buffer is off
- *
- * Set the double buffer on/off on window WID.
- */
-void
- ixs2buf( wid, mode )
- int *wid;
- int *mode;
-{
- int i;
-
- if ( *wid == 999 ) {
- for ( i = 0; i < MAXWN; i++ ) {
- tws = &windows[i];
- if (tws->open) {
- switch ( *mode ) {
- case 1 :
- ix2bon();
- break;
- default:
- ix2boff();
- break;
- }
- }
- }
- } else {
- tws = &windows[*wid];
- if (!tws->open) return;
- switch ( *mode ) {
- case 1 :
- ix2bon();
- return;
- default:
- ix2boff();
- return;
- }
- }
-}
-
-/*
- * SUBROUTINE IXQ2BUF(WID)
- * INTEGER WID : Window identifier.
- *
- * Query the double buffer value for the window WID.
- */
-int
- ixq2buf( wid )
- int *wid;
-{
- tws = &windows[*wid];
- if (!tws->open) {
- return -1;
- } else {
- return tws->double_buffer;
- }
-}
-
-/*
- * INTEGER FUNCTION IXOPNPX(W, H)
- * INTEGER W,H : Width and height of the pixmap.
- *
- * Open a new pixmap.
- */
-int
- ixopnpx(w, h)
-int *w, *h;
-{
- Drawable pixtemp;
- Window root;
- unsigned int wval, hval;
- int xx, yy, i ;
- unsigned int ww, hh, border, depth;
- wval = *w;
- hval = *h;
-
- oldwin = cws->drawing;
- pixtemp = XCreatePixmap(display, RootWindow( display, screen_number),
- wval, hval, DefaultDepth(display,screen_number));
- ispix = 1;
- XGetGeometry( display, pixtemp, &root, &xx, &yy, &ww, &hh, &border, &depth );
-
- for( i = 0; i < MAXGC; i++ )
- XSetClipMask( display, gclist[i], None );
-
- setcolor( *gcpxmp, 0);
- XFillRectangle( display, pixtemp, *gcpxmp,0 ,0 ,ww ,hh);
- setcolor( *gcpxmp, 1);
-
- cws->drawing = pixtemp;
- return ( pixtemp );
-}
-
-
-/*
- * SUBROUTINE IXCLRPX(PIX)
- * INTEGER PIX : Pixmap address
- *
- * Clear the pixmap PIX.
- */
-void
- ixclrpx(pix )
-Drawable *pix;
-{
- Window root;
- int xx, yy;
- unsigned int ww, hh, border, depth;
- XGetGeometry( display, *pix, &root, &xx, &yy, &ww, &hh, &border, &depth );
- setcolor( *gcpxmp, 0);
- XFillRectangle( display, *pix, *gcpxmp,0 ,0 ,ww ,hh);
- setcolor( *gcpxmp, 1);
- XFlush( display );
-}
-
-
-/*
- * SUBROUTINE IXCLPX
- *
- * Close the current opened pixmap.
- */
-void
- ixclpx()
-{
- XFlush( display );
- cws->drawing = oldwin;
- ispix = 0;
-}
-
-
-/*
- * SUBROUTINE IXCPPX(PIX, XPOS, YPOS)
- * INTEGER PIX : Pixmap address
- * INTEGER XPOS, YPOS : Pixmap Position
- *
- * Copy the pixmap PIX at the position XPOS YPOS.
- */
-void
- ixcppx(pix, xpos, ypos)
-Drawable *pix;
-int *xpos, *ypos;
-{
- Window root;
- int xx, yy;
- unsigned int ww, hh, border, depth;
- XGetGeometry( display, *pix, &root, &xx, &yy, &ww, &hh, &border, &depth );
- XCopyArea(display,*pix,cws->drawing,*gcpxmp,0,0,ww,hh,*xpos,*ypos);
- XFlush( display );
-}
-
-
-/*
- * SUBROUTINE IXWRPX(PIX,W,H,LENNAME,PXNAME)
- * INTEGER PIX : Pixmap address
- * INTEGER W,H : Width and height of the pixmap.
- * INTEGER LENNAME : pixmap name length
- * CHARACTER*(*) PXNAME: pixmap name
- *
- * Write the pixmap IPX in the bitmap file PXNAME.
- */
-void
- ixwrpx(pix, w, h, lenname,
- dsc_pxname )
-struct dsc$descriptor_s *dsc_pxname;
-Drawable *pix;
-int *w, *h;
-int *lenname;
-{
- char *pxname = dsc_pxname->dsc$a_pointer;
- unsigned int wval, hval;
- wval = *w;
- hval = *h;
- XWriteBitmapFile(display,string(pxname,*lenname),*pix,wval,hval,-1,-1);
-}
-
-
-/*
- * SUBROUTINE IXWIPX(PIX, XPOS, YPOS)
- * INTEGER PIX : Pixmap address
- * INTEGER XPOS, YPOS : Position in the current window
- *
- * Copy the area at the position XPOS YPOS in the current
- * window in the pixmap PIX. The area copied has the size
- * of the pixmap PIX.
- */
-void
- ixwipx(pix, xpos, ypos )
-Drawable *pix;
-int *xpos, *ypos;
-{
- Window root;
- int xx, yy;
- unsigned int ww, hh, border, depth;
- XGetGeometry( display, *pix, &root, &xx, &yy, &ww, &hh, &border, &depth );
- XCopyArea(display,cws->drawing,*pix,*gcpxmp,*xpos,*ypos,ww,hh,0,0);
- XFlush( display );
-}
-
-
-/*
- * SUBROUTINE IXRMPX(PIX)
- * INTEGER PIX : Pixmap adress
- *
- * Remove the pixmap PIX.
- */
-void
- ixrmpx(pix)
-Drawable *pix;
-{
- XFreePixmap(display,*pix);
-}
-
-
-/*
- * SUBROUTINE IXCLSDS
- *
- * Delete all windows and close connection
- */
-void
- ixclsds()
-{
- int Motif = (int)NULL;
- int i;
-
- if(display == NULL) return;
-
- for( i = 0; i < MAXFONT; i++ ) {
- if ( font[i].id ) {
- XFreeFont ( display, font[i].id);
- font[i].id = NULL;
- }
- }
-
- for( i = 0; i < MAXWN; i++ ) {
- windows[i].open = 0;
- if( windows[i].motif )
- Motif = 1;
- }
- if(display != NULL && Motif == (int)NULL) XCloseDisplay( display );
- display = NULL;
- cws = NULL;
- tws = NULL;
- isdisp = 0;
-}
-
-
-/*
- * SUBROUTINE IXCLSWI
- *
- * Delete current window
- */
-void
- ixclswi()
-{
- int wid;
-
- XDestroyWindow( display, cws->window );
-
- if( cws->double_buffer ) XFreePixmap( display, cws->buffer);
-
- if (cws->motif && motif_close != NULL) {
- for( wid = 0; wid < MAXWN; wid++ ) {
- if (cws->motif_window == windows[wid].motif_window) {
- (*motif_close) (wid+1);
- break; }
- }
- }
-
- XFlush( display );
-
- cws->open = (int)NULL;
-
- for( wid = 0; wid < MAXWN; wid++ )
- if( windows[wid].open ) {
- cws = &windows[wid];
- return;
- }
-
- ixclsds(); /* no open window left */
-}
-
-
-/*
- * SUBROUTINE IXSELWI(WID)
- * INTEGER WID : window number returned by IXOPNWIN
- *
- * Select window to which subsequent output is directed
- */
-void
- ixselwi( wid )
-int *wid;
-{
- XRectangle region;
- int i;
-
- if( *wid < 0 || *wid >= MAXWN || !windows[*wid].open ) return;
-
- cws = &windows[*wid];
-
- if ( cws->clip && !ispix && !cws->double_buffer ) {
- region.x = cws->xclip;
- region.y = cws->yclip;
- region.width = cws->wclip;
- region.height = cws->hclip;
- for( i = 0; i < MAXGC; i++ )
- XSetClipRectangles( display, gclist[i], 0, 0, ®ion, 1, YXBanded );
- } else {
- for( i = 0; i < MAXGC; i++ )
- XSetClipMask( display, gclist[i], None );
- }
-}
-
-
-/*
- * SUBROUTINE IXSAVWI
- *
- * Save the adress of the current active window
- */
-void
- ixsavwi()
-{
- sws = cws;
-}
-
-
-/*
- * SUBROUTINE IXSETWI
- *
- * Restore the adress of the saved window
- */
-void
- ixsetwi()
-{
- cws = sws;
-}
-
-
-/*
- * SUBROUTINE IXGETGE(WID,X,Y,W,H)
- * INTEGER WID : window identifier
- * INTEGER X,Y : window position (output)
- * INTEGER W,H : window size (output)
- *
- * Return position and size of window wid
- * if wid < 0 the size of the display is returned
- */
-void
- ixgetge( wid, x, y, w, h )
-int *wid;
-int *x, *y;
-unsigned int *w, *h;
-{
- Window junkwin;
- if( *wid < 0 ) {
- *x = 0;
- *y = 0;
- *w = DisplayWidth(display,screen_number);
- *h = DisplayHeight(display,screen_number);
- } else {
- Window root;
- unsigned int border, depth;
- unsigned int width, height;
-
- tws = &windows[*wid];
- XGetGeometry(display, tws->drawing, &root, x, y,
- &width, &height, &border, &depth);
- (void) XTranslateCoordinates (display, tws->window,
- RootWindow( display, screen_number),
- 0, 0, x, y, &junkwin);
- if( width > 0 && height > 0 ) {
- tws->width = width;
- tws->height = height;
- }
- *w=tws->width-1;
- *h=tws->height-1;
- }
-}
-
-
-/*
- * SUBROUTINE IXGETPL(NPLANES)
- * INTEGER NPLANES : number of bit planes
- *
- * Get maximum number of planes
- */
-void
- ixgetpl(nplanes)
-int *nplanes;
-{
- *nplanes = DisplayPlanes( display, screen_number );
-}
-
-
-/*
- * SUBROUTINE IXRSIZ(WID)
- * INTEGER WID : window to be resized
- *
- * Resize the current window if necessary
- */
-void
- ixrsiz(wid)
-int *wid;
-{
- int i;
- int xval, yval;
- Window root;
- unsigned int wval, hval, border, depth;
-
- tws = &windows[*wid];
-
- if( !tws->motif ) return;
-
- XGetGeometry( display, tws->motif_window, &root,
- &xval, &yval, &wval, &hval, &border, &depth );
- XResizeWindow( display, tws->window, wval, hval );
-
- if( tws->double_buffer ) {
- XFreePixmap(display,tws->buffer);
- tws->buffer = XCreatePixmap(display, RootWindow( display, screen_number),
- wval, hval, DefaultDepth(display,screen_number));
- for( i = 0; i < MAXGC; i++ ) XSetClipMask( display, gclist[i], None );
- setcolor( *gcpxmp, 0);
- XFillRectangle( display, tws->buffer, *gcpxmp, 0, 0, wval, hval);
- setcolor( *gcpxmp, 1);
- tws->drawing = tws->buffer;
- }
- tws->width = wval;
- tws->height = hval;
-}
-
-
-/*
- * SUBROUTINE IXGETHT(IL,CHHOST)
- * INTEGER IL : host name length (output)
- * CHARACTER*(*) CHHOST : host name (output)
- *
- * Return the host name given with IGWKTY.
- */
-void
- ixgetht (il, chhost)
- int *il;
- char *chhost; /* host name */
-{
- *il = strlen (hname);
- strcpy (chhost, hname);
-}
-
-
-/*
- * SUBROUTINE IXGETWI(WKID,IDG)
- * INTEGER WKID : Workstation identifier (input)
- * INTEGER IDG : Window identifier (output)
- *
- * Return the host name given with IGWKTY.
- */
-void
- ixgetwi (wkid, idg)
- int *wkid;
- Window *idg;
-{
- *idg = windows[*wkid-1].window;
-}
-
-
-/*
- * SUBROUTINE IXCLRWI
- *
- * Clear current window
- */
-void
- ixclrwi()
-{
-
- if ( !ispix && !cws->double_buffer ) {
- XSetWindowBackground( display, cws->drawing, colors[0].pixel );
- XClearWindow( display, cws->drawing );
- } else {
- setcolor( *gcpxmp, 0);
- XFillRectangle( display, cws->drawing, *gcpxmp,
- 0, 0, cws->width, cws->height );
- setcolor( *gcpxmp, 1);
- }
- do_raise = 1;
- XFlush( display );
-}
-
-
-/*
- * SUBROUTINE IXUPDWI(MODE)
- * INTEGER MODE : (1) or (11) The window is raised
- * (0) or (10) The window is not raised
- * (0) or (1) no synchonisation between client and server
- * (10) or (11) synchonisation between client and server
- *
- * Update display and raise current window to top of stack.
- * Synchronise client and server once (not permanent).
- * Copy the pixmap cws->buffer on the window cws-> window
- * if the double buffer is on.
- */
-void
- ixupdwi(mode)
- int *mode;
-{
- if ( *mode == 1 || *mode == 11 ) {
- if ( do_raise ) {
- XRaiseWindow( display, cws->window );
- do_raise = 0;
- }
- }
- if ( cws->double_buffer ) {
- XCopyArea( display, cws->drawing, cws->window,
- *gcpxmp, 0, 0, cws->width, cws->height, 0, 0 );
- }
- if ( *mode == 0 || *mode == 1 ) {
- XFlush( display );
- } else {
- XSync( display ,0);
- }
-}
-
-
-/*
- * SUBROUTINE IXCLIP(WID,X,Y,W,H)
- * INTEGER WID : Window indentifier
- * INTEGER X,Y : origin of clipping rectangle
- * INTEGER W,H : size of clipping rectangle;
- *
- * Set clipping region for the window wid
- */
-void
- ixclip( wid, x, y, w, h )
-int *wid;
-int *x, *y;
-int *w, *h;
-{
- XRectangle region;
- int i;
-
- tws = &windows[*wid];
- tws->xclip = *x;
- tws->yclip = *y;
- tws->wclip = *w;
- tws->hclip = *h;
- tws->clip = 1;
- if ( cws->clip && !ispix && !cws->double_buffer ) {
- region.x = cws->xclip;
- region.y = cws->yclip;
- region.width = cws->wclip;
- region.height = cws->hclip;
- for( i = 0; i < MAXGC; i++ )
- XSetClipRectangles( display, gclist[i], 0, 0, ®ion, 1, YXBanded );
- }
-}
-
-
-/*
- * SUBROUTINE IXNOCLI(WID)
- * INTEGER WID : Window indentifier
- *
- * Switch off the clipping for the window wid
- */
-void
- ixnocli(wid)
-int *wid;
-{
- int i;
-
- tws = &windows[*wid];
- tws->clip = (int)NULL;
-
- for( i = 0; i < MAXGC; i++ )
- XSetClipMask( display, gclist[i], None );
-}
-
-
-/*
- * SUBROUTINE IXSETCO(CINDEX,R,G,B)
- * INTEGER CINDEX : color index
- * REAL R,G,B : red, green, blue intensities between 0.0 and 1.0
- *
- * Set color intensities for given color index
- */
-#define BIGGEST_RGB_VALUE 65535
-
-void
- ixsetco( cindex, r, g, b )
-int *cindex;
-float *r, *g, *b;
-{
- XColor xcol;
-
- if( colored && *cindex >= 0 && *cindex < MAXCOL ) {
- xcol.red = (unsigned short)( *r * BIGGEST_RGB_VALUE );
- xcol.green = (unsigned short)( *g * BIGGEST_RGB_VALUE );
- xcol.blue = (unsigned short)( *b * BIGGEST_RGB_VALUE );
- xcol.flags = DoRed || DoGreen || DoBlue;
- if( XAllocColor( display, colormap, &xcol ) != (Status)NULL ) {
- colors[*cindex].defined = 1;
- colors[*cindex].pixel = xcol.pixel;
- colors[*cindex].red = *r;
- colors[*cindex].green = *g;
- colors[*cindex].blue = *b;
- }
- }
-/*
- XColor xcol;
- static unsigned long pixel[MAXCOL] = {0} ;
- int inum;
- Colormap *cm = XListInstalledColormaps (display, cws->window, &inum);
-
- if( !colored || *cindex < 0 || *cindex >= MAXCOL ) return;
- if (*r < 0.) *r = 0.;
- if (*g < 0.) *g = 0.;
- if (*b < 0.) *b = 0.;
- if (*r > 1.) *r = 1.;
- if (*g > 1.) *g = 1.;
- if (*b > 1.) *b = 1.;
- if (pixel[*cindex] == 0) {
- XAllocColorCells(display,colormap, 0,NULL,0,&pixel[*cindex],1); }
-
- xcol.pixel = pixel[*cindex];
- xcol.red = (unsigned short)( *r * BIGGEST_RGB_VALUE );
- xcol.green = (unsigned short)( *g * BIGGEST_RGB_VALUE );
- xcol.blue = (unsigned short)( *b * BIGGEST_RGB_VALUE );
- xcol.flags = DoRed || DoGreen || DoBlue;
-
- colors[*cindex].defined = 1;
- colors[*cindex].pixel = xcol.pixel;
- colors[*cindex].red = *r;
- colors[*cindex].green = *g;
- colors[*cindex].blue = *b;
- XStoreColor(display,DefaultColormap(display,screen_number),&xcol);
-
- *cm = (Colormap) XListInstalledColormaps (display, cws->window, &inum);
-*/
-}
-
-
-void
- ixgetcol( index, r, g, b )
-int index; /* input */
-float *r, *g, *b; /* output */
-{
- *r = colors[index].red;
- *g = colors[index].green;
- *b = colors[index].blue;
- return ;
-}
-
-
-/*
- * SUBROUTINE IXSETLN(WIDTH)
- * INTEGER WIDTH : line width in pixels
- *
- * Set line width
- */
-void
- ixsetln( width )
-int *width;
-{
- if( *width == 1) {
- line_width = 0;
- }
- else {
- line_width = *width;
- }
- XSetLineAttributes( display, *gcline, line_width,
- line_style, cap_style, join_style );
- XSetLineAttributes( display, *gcdash, line_width,
- line_style, cap_style, join_style );
-}
-
-
-/*
- * SUBROUTINE IXSETLS(N,DASH)
- * INTEGER N : length of dash list
- * INTEGER DASH(N) : dash segment lengths
- *
- * Set line style:
- * if N.LE.0 use solid lines
- * if N.GT.0 use dashed lines described by DASH(N)
- * e.g. N=4,DASH=(6,3,1,3) gives a dashed-dotted line with dash length 6
- * and a gap of 7 between dashes
- */
-void
- ixsetls( n, dash )
-int *n;
-int *dash;
-{
- if( *n <= 0 ) {
- line_style = LineSolid;
- XSetLineAttributes( display, *gcline, line_width,
- line_style, cap_style, join_style );
- }
- else {
- int i, j;
- dash_length = 0;
- for( i = 0, j = 0; i < sizeof( dash_list ); i++ ) {
- dash_list[i] = dash[j];
- dash_length += dash_list[i];
- if( ++j >= *n ) j = 0;
- }
- dash_offset = 0;
- line_style = LineOnOffDash;
- XSetLineAttributes( display, *gcdash, line_width,
- line_style, cap_style, join_style );
- }
-}
-
-
-/*
- * SUBROUTINE IXSETLC(CINDEX)
- * INTEGER CINDEX : color index defined my IXSETCOL
- *
- * Set color index for lines
- */
-void
- ixsetlc( cindex )
-int *cindex;
-{
- setcolor( *gcline, *cindex );
- setcolor( *gcdash, *cindex );
-}
-
-
-/*
- * SUBROUTINE IXLINE(N,XY)
- * INTEGER N : number of points
- * INTEGER*2 XY(2,N) : list of points
- *
- * Draw a line through all points
- */
-void
- ixline( n, xy )
-int *n;
-XPoint *xy;
-{
- if ( *n > 1 )
- {
- if( line_style == LineSolid )
- XDrawLines( display, cws->drawing, *gcline, xy, *n, CoordModeOrigin );
- else {
- int i;
- XSetDashes( display, *gcdash,
- dash_offset, dash_list, sizeof( dash_list ) );
- XDrawLines( display, cws->drawing, *gcdash, xy, *n, CoordModeOrigin );
-
- /* calculate length of line to update dash offset */
- for( i = 1; i < *n; i++ ) {
- int dx = xy[i].x - xy[i-1].x;
- int dy = xy[i].y - xy[i-1].y;
- if( dx < 0 ) dx = - dx;
- if( dy < 0 ) dy = - dy;
- dash_offset += dx > dy ? dx : dy;
- }
- dash_offset %= dash_length;
- }
- }
- else
- {
- int px,py;
- px=xy[0].x;
- py=xy[0].y;
- XDrawPoint(display, cws->drawing,
- line_style == LineSolid ? *gcline : *gcdash, px, py);
- }
- do_raise = 1;
-}
-
-
-/*
- * SUBROUTINE IXSETMS(TYPE,N,XY)
- * INTEGER TYPE : marker type
- * INTEGER N : length of marker description
- * INTEGER*2 XY(2,N) : list of points describing marker shape
- *
- * Set marker style:
- * if N.EQ.0 marker is a single point
- * if TYPE.EQ.0 marker is hollow circle of diameter N
- * if TYPE.EQ.1 marker is filled circle of diameter N
- * if TYPE.EQ.2 marker is a hollow polygon describe by line XY
- * if TYPE.EQ.3 marker is a filled polygon describe by line XY
- * if TYPE.EQ.4 marker is described by segmented line XY
- * e.g. TYPE=4,N=4,XY=(-3,0,3,0,0,-3,0,3) sets a plus shape of 7x7 pixels
- */
-void
- ixsetms( type, n, xy )
-int *type;
-int *n;
-XPoint *xy;
-{
- int i;
-
- marker.type = *type;
- marker.n = *n < MAXMK ? *n : MAXMK;
- if( marker.type >= 2 )
- for( i = 0; i < marker.n; i++ )
- marker.xy[i] = xy[i];
-}
-
-
-/*
- * SUBROUTINE IXSETMC(CINDEX)
- * INTEGER CINDEX : color index defined my IXSETCOL
- *
- * Set color index for markers
- */
-void
- ixsetmc( cindex )
-int *cindex;
-{
- setcolor( *gcmark, *cindex );
-}
-
-
-/*
- * SUBROUTINE IXMARKE(N,XY)
- * INTEGER N : number of points
- * INTEGER*2 XY(2,N) : list of points
- *
- * Draw a marker at each point
- */
-void
- ixmarke( n, xy )
-int *n;
-XPoint *xy;
-{
- do_raise = 1;
- if( marker.n <= 0 )
- XDrawPoints( display, cws->drawing, *gcmark, xy, *n, CoordModeOrigin );
- else {
- int r = marker.n / 2;
- int m;
-
- for( m = 0; m < *n; m++ ) {
- int hollow = 0;
-
- switch( marker.type ) {
- int i;
-
- case 0: /* hollow circle */
- XDrawArc( display, cws->drawing, *gcmark,
- xy[m].x - r, xy[m].y - r, marker.n, marker.n, 0, 360 * 64 );
- break;
-
- case 1: /* filled circle */
- XFillArc( display, cws->drawing, *gcmark,
- xy[m].x - r, xy[m].y - r, marker.n, marker.n, 0, 360 * 64 );
- break;
-
- case 2: /* hollow polygon */
- hollow = 1;
- case 3: /* filled polygon */
- for( i = 0; i < marker.n; i++ ) {
- marker.xy[i].x += xy[m].x;
- marker.xy[i].y += xy[m].y;
- }
- if( hollow )
- XDrawLines( display, cws->drawing, *gcmark,
- marker.xy, marker.n, CoordModeOrigin );
- else
- XFillPolygon( display, cws->drawing, *gcmark,
- marker.xy, marker.n, Nonconvex, CoordModeOrigin );
- for( i = 0; i < marker.n; i++ ) {
- marker.xy[i].x -= xy[m].x;
- marker.xy[i].y -= xy[m].y;
- }
- break;
-
- case 4: /* segmented line */
- for( i = 0; i < marker.n; i += 2 )
- XDrawLine( display, cws->drawing, *gcmark,
- xy[m].x + marker.xy[i].x, xy[m].y + marker.xy[i].y,
- xy[m].x + marker.xy[i+1].x, xy[m].y + marker.xy[i+1].y );
- break;
- }
- }
- }
-}
-
-
-/*
- * SUBROUTINE IXSETFS(STYLE,FASI)
- * INTEGER STYLE : fill area interior style hollow or solid
- *
- * Set fill area style
- */
-void
- ixsetfs( style, fasi )
-int *style;
-int *fasi;
-{
-
- switch( *style ) {
-
- case 1: /* solid */
- fill_hollow = 0;
- XSetFillStyle( display, *gcfill, FillSolid );
- break;
-
- case 2: /* pattern */
- fill_hollow = 1;
- break;
-
- case 3: /* hatch */
- fill_hollow = 0;
- XSetFillStyle( display, *gcfill, FillStippled );
- if( *fasi != current_fasi ) {
- if( fill_pattern != (Pixmap)NULL ) {
- XFreePixmap( display, fill_pattern );
- fill_pattern = (Pixmap)NULL;
- }
- switch( *fasi ) {
- case 1: fill_pattern = XCreateBitmapFromData(display,
- RootWindow( display, screen_number), p1_bits, 16, 16);
- break;
- case 2: fill_pattern = XCreateBitmapFromData(display,
- RootWindow( display, screen_number), p2_bits, 16, 16);
- break;
- case 3: fill_pattern = XCreateBitmapFromData(display,
- RootWindow( display, screen_number), p3_bits, 16, 16);
- break;
- case 4: fill_pattern = XCreateBitmapFromData(display,
- RootWindow( display, screen_number), p4_bits, 16, 16);
- break;
- case 5: fill_pattern = XCreateBitmapFromData(display,
- RootWindow( display, screen_number), p5_bits, 16, 16);
- break;
- case 6: fill_pattern = XCreateBitmapFromData(display,
- RootWindow( display, screen_number), p6_bits, 16, 16);
- break;
- case 7: fill_pattern = XCreateBitmapFromData(display,
- RootWindow( display, screen_number), p7_bits, 16, 16);
- break;
- case 8: fill_pattern = XCreateBitmapFromData(display,
- RootWindow( display, screen_number), p8_bits, 16, 16);
- break;
- case 9: fill_pattern = XCreateBitmapFromData(display,
- RootWindow( display, screen_number), p9_bits, 16, 16);
- break;
- default: fill_pattern = XCreateBitmapFromData(display,
- RootWindow( display, screen_number), p2_bits, 16, 16);
- break;
- }
- XSetStipple( display, *gcfill, fill_pattern );
- current_fasi = *fasi;
- }
- break;
-
- default:
- fill_hollow = 1;
- }
-}
-
-
-/*
- * SUBROUTINE IXSETFC(CINDEX)
- * INTEGER CINDEX : color index defined my IXSETCOL
- *
- * Set color index for fill areas
- */
-void
- ixsetfc( cindex )
-int *cindex;
-{
- setcolor( *gcfill, *cindex );
-
- /* invalidate fill pattern */
- if( fill_pattern != (Pixmap)NULL ) {
- XFreePixmap( display, fill_pattern );
- fill_pattern = (Pixmap)NULL;
- }
-}
-
-
-/*
- * SUBROUTINE IXFLARE(N,XY)
- * INTEGER N : number of points
- * INTEGER*2 XY(2,N) : list of points
- *
- * Fill area described by polygon
- */
-void
- ixflare( n, xy )
-int *n;
-XPoint *xy;
-{
- if( fill_hollow )
- XDrawLines( display, cws->drawing, *gcfill, xy, *n, CoordModeOrigin );
-
- else {
- XFillPolygon( display, cws->drawing, *gcfill,
- xy, *n, Nonconvex, CoordModeOrigin );
- }
- do_raise = 1;
-}
-
-
-/*
- * SUBROUTINE IXSETTA(TXALH,TXALV)
- * INTEGER TXALH : horizontal text alignment
- * INTEGER TXALV : vertical text alignment
- */
-void
- ixsetta( txalh, txalv )
-int *txalh;
-int *txalv;
-{
- switch ( *txalh ) {
-
- case 0 :
- case 1 : switch ( *txalv) {
- case 0 : text_align = 7;
- break;
- case 1 :
- case 2 : text_align = 1;
- break;
- case 3 : text_align = 4;
- break;
- }
- break;
- case 2 : switch ( *txalv) {
- case 0 : text_align = 8;
- break;
- case 1 :
- case 2 : text_align = 2;
- break;
- case 3 : text_align = 5;
- break;
- }
- break;
- case 3 : switch ( *txalv) {
- case 0 : text_align = 9;
- break;
- case 1 :
- case 2 : text_align = 3;
- break;
- case 3 : text_align = 6;
- break;
- }
- break;
- }
-}
-
-
-/*
- * FUNCTION IXSETTF(MODE,LENFNT,FONTNAME)
- * INTEGER MODE : loading flag
- * MODE=0 : search if the font exist
- * MODE=1 : search the font and load it if it exist
- * INTEGER LENFNT : font name length
- * CHARACTER*(*) FONT : font name
- *
- * Set text font to specified name. This function returns 0 if
- * the specified font is found, 1 if not.
- */
-int
- ixsettf( mode, lenfnt,
- dsc_fontname )
-struct dsc$descriptor_s *dsc_fontname;
-int *mode;
-int *lenfnt;
-{
- char *fontname = dsc_fontname->dsc$a_pointer;
- char **fontlist;
- int fontcount;
- int i;
-
- if ( *mode != 0 ) {
- for ( i = 0; i < MAXFONT; i++ ) {
- if (strcmp(string( fontname, *lenfnt ), font[i].name) == 0) {
- text_font = font[i].id;
- XSetFont( display, *gctext, text_font->fid);
- XSetFont( display, *gcinvt, text_font->fid);
- return(0);
- }
- }
- }
-
- fontlist = XListFonts( display, string( fontname, *lenfnt ), 1, &fontcount);
-
- if ( fontcount != 0 ) {
- if ( *mode != 0 ) {
- if ( font[current_font_number].id )
- XFreeFont ( display, font[current_font_number].id);
- text_font = XLoadQueryFont( display, fontlist[0]);
- XSetFont( display, *gctext, text_font->fid);
- XSetFont( display, *gcinvt, text_font->fid);
- font[current_font_number].id = text_font;
- strcpy (font[current_font_number].name,string( fontname, *lenfnt ));
- current_font_number++;
- if ( current_font_number == MAXFONT ) current_font_number = 0;
- }
- return(0);
- }
- else {
- return(1);
- }
-}
-
-
-/*
- * SUBROUTINE IXSETTC(CINDEX)
- * INTEGER CINDEX : color index defined my IXSETCOL
- *
- * Set color index for text
- */
-void
- ixsettc( cindex )
-int *cindex;
-{
- setcolor( *gctext, *cindex );
-
- XSetForeground( display, *gcinvt, (*gctext)->values.background );
- XSetBackground( display, *gcinvt, (*gctext)->values.foreground );
- XSetBackground( display, *gctext, colors[0].pixel );
-}
-
-
-/*
- * SUBROUTINE IXTEXT(MODE,X,Y,ANGLE,MGN,LENTXT,TEXT)
- * INTEGER MODE : drawing mode
- * MODE=0 : the background is not drawn
- * MODE=1 : the background is drawn
- * INTEGER X,Y : text position
- * REAL ANGLE : text angle
- * REAL MGN : magnification factor
- * INTEGER LENTXT : text length
- * CHARACTER*(*) TEXT : text string
- *
- * Draw a text string using current font
- */
-void
- ixtext( mode, x, y, angle, mgn, lentxt,
- dsc_text )
-struct dsc$descriptor_s *dsc_text;
-int *mode;
-int *x, *y;
-float *angle;
-float *mgn;
-int *lentxt;
-{
- char *text = dsc_text->dsc$a_pointer;
-
- XRotSetMagnification(*mgn);
-
- switch ( *mode ) {
-
- case 0 : XRotDrawAlignedString( display, text_font, *angle,
- cws->drawing, *gctext, *x, *y, string(text,*lentxt), text_align );
- break;
-
- case 1 : XRotDrawAlignedImageString( display, text_font, *angle,
- cws->drawing, *gctext, *x, *y, string(text,*lentxt), text_align );
- break;
-
- default: break;
- }
- do_raise = 1;
-}
-
-
-/*
- * SUBROUTINE IXTXTL(IW,IH,LMESS,MESS)
- * INTEGER IW : text width
- * INTEGER IH : text height
- * INTEGER LMES : message length
- * CHARACTER*(*) MESS : message
- *
- * Return the size of a character string
- */
-void
- ixtxtl( w, h, lmess,
- dsc_mess )
-struct dsc$descriptor_s *dsc_mess;
-int *lmess;
-int *w;
-int *h;
-{
- char *mess = dsc_mess->dsc$a_pointer;
- *w = XTextWidth( text_font, mess, *lmess );
- *h = text_font->ascent;
-}
-
-
-/*
- * SUBROUTINE IXBOX(X1,X2,Y1,Y2,MODE)
- * INTEGER X1,Y1 : left down corner
- * INTEGER X2,Y2 : right up corner
- * INTEGER MODE : drawing mode
- *
- * MODE=0 hollow
- * MODE=1 solid
- *
- * Draw a box
- */
-void
- ixbox( x1, x2, y1, y2, mode)
-int *x1, *x2, *y1, *y2;
-int *mode;
-{
- switch ( *mode ) {
-
- case 0 : XDrawRectangle( display, cws->drawing, *gcline,
- min(*x1,*x2), min(*y1,*y2),
- abs(*x2-*x1), abs(*y2-*y1));
- break;
-
- case 1 : XFillRectangle( display, cws->drawing, *gcfill,
- min(*x1,*x2), min(*y1,*y2),
- abs(*x2-*x1), abs(*y2-*y1));
- break;
-
- default: break;
- }
- do_raise = 1;
-}
-
-
-/*
- * SUBROUTINE IXCA(X1,X2,Y1,Y2,NX,NY,IC)
- * INTEGER X1,Y1 : left down corner
- * INTEGER X2,Y2 : right up corner
- * INTEGER NX,NY : array size
- * INTEGER IC : array
- *
- * Draw a cell array. The drawing is done with the pixel presicion
- * if (X2-X1)/NX (or Y) is not a exact pixel number the position of
- * the top rigth corner may be wrong.
- */
-void
- ixca(x1, x2, y1, y2, nx, ny, ic)
-int *x1, *x2, *y1, *y2, *nx, *ny;
-int ic[];
-{
- int i,j,icol,ix,iy,w,h,current_icol;
-
- current_icol = -1;
- w = max((*x2-*x1)/(*nx),1);
- h = max((*y1-*y2)/(*ny),1);
- ix = *x1;
-
- for ( i=0; i<*nx; i++ ) {
- iy = *y1-h;
- for ( j=0; j<*ny; j++ ) {
- icol = ic[i+(*nx*j)];
- if(icol != current_icol){
- XSetForeground( display, *gcfill, colors[icol].pixel );
- current_icol = icol;
- }
- XFillRectangle( display, cws->drawing, *gcfill, ix, iy, w, h);
- iy = iy-h;
- }
- ix = ix+w;
- }
-}
-
-
-/*
- * SUBROUTINE IXDRMDE(MODE)
- * INTEGER MODE : drawing mode
- *
- * MODE=1 copy
- * MODE=2 xor
- * MODE=3 invert
- * MODE=4 set the suitable mode for cursor echo accordinf to
- * the vendor.
- *
- * Set the drawing mode
- */
-void
- ixdrmde( mode )
- int *mode;
-{
- int i;
- switch ( *mode ) {
-
- case 1 :
- for ( i = 0; i < MAXGC; i++ ) XSetFunction( display, gclist[i], GXcopy);
- break;
-
- case 2 :
- for ( i = 0; i < MAXGC; i++ ) XSetFunction( display, gclist[i], GXxor);
- break;
-
- case 3 :
- for ( i = 0; i < MAXGC; i++ ) XSetFunction( display, gclist[i], GXinvert);
- break;
-
- case 4 :
- if(strstr(vendor,"Hewlett")) {
- for ( i = 0; i < MAXGC; i++ ) XSetFunction( display, gclist[i], GXinvert);
- } else {
- for ( i = 0; i < MAXGC; i++ ) XSetFunction( display, gclist[i], GXxor);
- }
- break;
-
- default: break;
- }
-}
-
-
-/*
- * SUBROUTINE IXSYNC(MODE)
- * INTEGER MODE : synchronisation on/off
- *
- * MODE=1 on
- * MODE<>0 off
- *
- * Set synchronisation on or off
- */
-void
- ixsync( mode )
- int *mode;
-{
- switch ( *mode ) {
-
- case 1 :
- XSynchronize(display,1);
- break;
-
- default:
- XSynchronize(display,0);
- break;
- }
-}
-
-
-/*
- * SUBROUTINE IXQPTR(IX,IY)
- *
- * Output parameters:
- *
- * INTEGER IX : X coordinate of pointer
- * INTEGER IY : Y coordinate of pointer
- * (both coordinates are relative to the origin of the root window)
- */
-void ixqptr( ix, iy )
-int *ix,*iy;
-{
- Window idg;
-
- Window root_return,child_return;
- int win_x_return,win_y_return;
- int root_x_return,root_y_return;
- unsigned int mask_return;
-
- XQueryPointer(display,cws->window,&root_return,
- &child_return,&root_x_return,&root_y_return,&win_x_return,
- &win_y_return,&mask_return);
-
- *ix = (int)root_x_return;
- *iy = (int)root_y_return;
-
-}
-
-
-/*
- * SUBROUTINE IXWARP(IX,IY)
- *
- * Input parameters:
- *
- * INTEGER IX : New X coordinate of pointer
- * INTEGER IY : New Y coordinate of pointer
- * (both coordinates are relative to the origin of the current window)
- */
-void ixwarp( ix, iy )
-int *ix,*iy;
-{
- XWarpPointer(display,0,cws->window,0,0,0,0,*ix,*iy);
-}
-
-
-/*
- * INTEGER FUNCTION IXREQLO(MODE,CTYP,X,Y)
- * INTEGER X,Y : cursor position out moment of button press (output)
- * INTEGER CTYP : cursor type (input)
- *
- * CTYP=1 tracking cross
- * CTYP=2 cross-hair
- * CTYP=3 rubber circle
- * CTYP=4 rubber band
- * CTYP=5 rubber rectangle
- *
- * INTEGER MODE : input mode
- *
- * MODE=0 request
- * MODE=1 sample
- *
- * Request locator:
- * return button number 1 = left is pressed
- * 2 = middle is pressed
- * 3 = right is pressed
- * in sample mode:
- * 11 = left is released
- * 12 = middle is released
- * 13 = right is released
- * -1 = nothing is pressed or released
- * -2 = leave the window
- * else = keycode (keyboard is pressed)
- */
-int
- ixreqlo( mode, ctyp, x, y )
-int *mode, *ctyp, *x, *y;
-{
- static Cursor cursor = (Cursor)LNULL;
- XEvent event;
- int button_press;
- int radius;
-
- setinput(1);
-
-/*
- * Change the cursor shape
- */
- if( cursor == (Cursor)NULL ) {
- if( *ctyp > 1 ) {
- XDefineCursor( display, cws->window, null_cursor );
- XSetForeground( display, gcecho, colors[0].pixel );
- } else {
- cursor = XCreateFontCursor( display, XC_crosshair );
- XDefineCursor( display, cws->window, cursor );
- }
- }
-
-/*
- * Event loop
- */
- button_press = 0;
-
- while ( button_press == 0 ) {
-
- switch ( *ctyp ) {
-
- case 1 : break;
-
- case 2 : XDrawLine( display, cws->window, gcecho,
- xloc, 0, xloc, cws->height);
- XDrawLine( display, cws->window, gcecho,
- 0, yloc, cws->width, yloc);
- break;
-
- case 3 : radius = (int) sqrt((double)((xloc-xlocp)*(xloc-xlocp)+
- (yloc-ylocp)*(yloc-ylocp)));
- XDrawArc( display, cws->window, gcecho,
- xlocp-radius, ylocp-radius,
- 2*radius, 2*radius, 0, 23040);
-
- case 4 : XDrawLine( display, cws->window, gcecho,
- xlocp, ylocp, xloc, yloc);
- break;
-
- case 5 : XDrawRectangle( display, cws->window, gcecho,
- min(xlocp,xloc), min(ylocp,yloc),
- abs(xloc-xlocp), abs(yloc-ylocp));
- break;
-
- default: break;
- }
-
- while ( XEventsQueued( display, QueuedAlready) > 1) {
- XNextEvent( display, &event);
- }
- XWindowEvent( display, cws->window, mouse_mask, &event );
-
- switch ( *ctyp ) {
-
- case 1 : break;
-
- case 2 : XDrawLine( display, cws->window, gcecho,
- xloc, 0, xloc, cws->height);
- XDrawLine( display, cws->window, gcecho,
- 0, yloc, cws->width, yloc);
- break;
-
- case 3 : radius = (int) sqrt((double)((xloc-xlocp)*(xloc-xlocp)+
- (yloc-ylocp)*(yloc-ylocp)));
- XDrawArc( display, cws->window, gcecho,
- xlocp-radius, ylocp-radius,
- 2*radius, 2*radius, 0, 23040);
-
- case 4 : XDrawLine( display, cws->window, gcecho,
- xlocp, ylocp, xloc, yloc);
- break;
-
- case 5 : XDrawRectangle( display, cws->window, gcecho,
- min(xlocp,xloc), min(ylocp,yloc),
- abs(xloc-xlocp), abs(yloc-ylocp));
- break;
-
- default: break;
- }
-
- xloc = event.xbutton.x;
- yloc = event.xbutton.y;
-
- switch ( event.type ) {
-
- case LeaveNotify :
- if( *mode == 0 ) {
- forever {
- XNextEvent( display, &event);
- if( event.type == EnterNotify ) break;
- }
- } else {
- button_press = -2;
- }
- break;
-
- case ButtonPress :
- button_press = event.xbutton.button ;
- xlocp = event.xbutton.x;
- ylocp = event.xbutton.y;
- XUndefineCursor( display, cws->window );
- cursor = (Cursor)NULL;
- break;
-
- case ButtonRelease :
- if( *mode == 1 ) {
- button_press = 10+event.xbutton.button ;
- xlocp = event.xbutton.x;
- ylocp = event.xbutton.y;
- }
- break;
-
- case KeyPress :
- if( *mode == 1 ) {
- button_press = event.xkey.keycode;
- xlocp = event.xbutton.x;
- ylocp = event.xbutton.y;
- }
- break;
-
- case KeyRelease :
- if( *mode == 1 ) {
- button_press = -event.xkey.keycode;
- xlocp = event.xbutton.x;
- ylocp = event.xbutton.y;
- }
- break;
-
- default : break;
- }
-
- if( *mode == 1 ) {
- if( button_press == 0 )
- button_press = -1;
- break;
- }
- }
- *x = event.xbutton.x;
- *y = event.xbutton.y;
- setinput(0);
- return( button_press );
-}
-
-
-/*
- * INTEGER FUNCTION IXREQST(X,Y,LEN,TEXT)
- * INTEGER X,Y : position where text is displayed
- * INTEGER LEN : text length
- * CHARACTER*(*) TEXT : text displayed (input), edited text (output)
- *
- * Request string:
- * text is displayed and can be edited with Emacs-like keybinding
- * return termination code (0 for ESC, 1 for RETURN)
- */
-int
- ixreqst( x, y, len_text,
- dsc_text )
-struct dsc$descriptor_s *dsc_text;
-int *len_text;
-int *x, *y;
-{
- char *text = dsc_text->dsc$a_pointer;
- static Cursor cursor = (Cursor)LNULL;
- static int percent = 0; /* bell volume */
- Window focuswindow;
- int focusrevert;
- XEvent event;
- KeySym keysym;
- int key = -1;
- int nt; /* defined length of text */
- int pt; /* cursor position in text */
-
- setinput(1);
-
- /* change the cursor shape */
- if( cursor == (Cursor)NULL ) {
- XKeyboardState kbstate;
- cursor = XCreateFontCursor( display, XC_question_arrow );
- XGetKeyboardControl( display, &kbstate );
- percent = kbstate.bell_percent;
- }
- if( cursor != (Cursor)NULL )
- XDefineCursor( display, cws->window, cursor );
- for( nt = *len_text; nt > 0 && text[nt-1] == ' '; nt-- );
- pt = nt;
- XGetInputFocus( display, &focuswindow, &focusrevert );
- XSetInputFocus( display, cws->window, focusrevert, CurrentTime );
- while( key < 0 ) {
- char keybuf[8];
- char nbytes;
- int dx;
- int i;
- XDrawImageString( display, cws->window, *gctext,
- *x, *y, text, nt );
- dx = XTextWidth( text_font, text, nt );
- XDrawImageString( display, cws->window, *gctext,
- *x + dx, *y, " ", 1 );
- dx = pt == 0 ? 0 : XTextWidth( text_font, text, pt );
- XDrawImageString( display, cws->window, *gcinvt,
- *x + dx, *y, pt < *len_text ? &text[pt] : " ", 1 );
- XWindowEvent( display, cws->window, keybd_mask, &event );
- switch( event.type ) {
- case ButtonPress:
- case EnterNotify:
- XSetInputFocus( display, cws->window, focusrevert, CurrentTime );
- break;
- case LeaveNotify:
- XSetInputFocus( display, focuswindow, focusrevert, CurrentTime );
- break;
- case KeyPress:
- nbytes = XLookupString( &event.xkey, keybuf, sizeof( keybuf ),
- &keysym, NULL );
- switch( keysym ) { /* map cursor keys */
- case XK_Left:
- keybuf[0] = '\002'; /* Control-B */
- nbytes = 1;
- break;
- case XK_Right:
- keybuf[0] = '\006'; /* Control-F */
- nbytes = 1;
- break;
- }
- if( nbytes == 1 ) {
- if( isascii( keybuf[0] ) && isprint( keybuf[0] ) ) {
- /* insert character */
- if( nt < *len_text )
- nt++;
- for( i = nt - 1; i > pt; i-- )
- text[i] = text[i-1];
- if( pt < *len_text ) {
- text[pt] = keybuf[0];
- pt++;
- }
- }
- else
- switch( keybuf[0] ) {
- /* Emacs-like editing keys */
-
- case '\010': /* backspace */
- case '\177': /* delete */
- /* delete backward */
- if( pt > 0 ) {
- for( i = pt; i < nt; i++ )
- text[i-1] = text[i];
- text[nt-1] = ' ';
- nt--;
- pt--;
- }
- break;
- case '\001': /* ^A */
- /* beginning of line */
- pt = 0;
- break;
- case '\002': /* ^B */
- /* move backward */
- if( pt > 0 )
- pt--;
- break;
- case '\004': /* ^D */
- /* delete forward */
- if( pt > 0 ) {
- for( i = pt; i < nt; i++ )
- text[i-1] = text[i];
- text[nt-1] = ' ';
- pt--;
- }
- break;
- case '\005': /* ^E */
- /* end of line */
- pt = nt;
- break;
-
- case '\006': /* ^F */
- /* move forward */
- if( pt < nt )
- pt++;
- break;
- case '\013': /* ^K */
- /* delete to end of line */
- for( i = pt; i < nt; i++ )
- text[i] = ' ';
- nt = pt;
- break;
- case '\024': /* ^T */
- /* transpose */
- if( pt > 0 ) {
- char c = text[pt];
- text[pt] = text[pt-1];
- text[pt-1] = c;
- }
- break;
- case '\012': /* newline */
- case '\015': /* return */
- key = 1;
- break;
- case '\033': /* escape */
- key = 0;
- break;
-
- default:
- XBell( display, percent );
- }
- }
- }
- }
- XSetInputFocus( display, focuswindow, focusrevert, CurrentTime );
-
- if( cursor != (Cursor)NULL ) {
- XUndefineCursor( display, cws->window );
- cursor = (Cursor)LNULL;
- }
-
- setinput(0);
-
- return( key );
-}
diff --git a/src/packlib/zbook/Imakefile b/src/packlib/zbook/Imakefile
deleted file mode 100644
index 4fbe707..0000000
--- a/src/packlib/zbook/Imakefile
+++ /dev/null
@@ -1,14 +0,0 @@
-
-#define IHaveSubdirs
-#define PassCDebugFlags
-
-LIBDIRS= code ybook
-SUBDIRS= $(LIBDIRS) test zbook
-
-TopOfPackage(zbook)
-
-SubdirLibraryTarget(zbook,$(LIBDIRS))
-
-TestSubdirs(test)
-
-InstallIncludeSubdirs(zbook)
diff --git a/src/packlib/zbook/code/Imakefile b/src/packlib/zbook/code/Imakefile
deleted file mode 100644
index c73c316..0000000
--- a/src/packlib/zbook/code/Imakefile
+++ /dev/null
@@ -1,22 +0,0 @@
-SRCS_F= zagain.F zbform.F zbook.F zbook0.F zbookn.F zbooks.F zbookt.F \ @@\
- zbug.F zclose.F zdebug.F zdelet.F zdgarb.F zdisk.F zdrop.F \ @@\
- zecfor.F zepcat.F zepcls.F zepdef.F zepend.F zepin.F zepkey.F \ @@\
- zeploc.F zepnxt.F zepout.F zerror.F zfconv.F zfetch.F zfribm.F \ @@\
- zgarb.F zgform.F zgtfor.F zhinit.F zhlim.F zidok.F zinit.F \ @@\
- ziodo.F zleft.F zloc.F zlocal.F zlook.F zmigra.F \ @@\
- zmove.F zname.F znamsr.F zopen.F zpbank.F zprint.F zptfor.F \ @@\
- zptree.F zpush.F zpush0.F zpushs.F zread.F zrecal.F zreset.F \ @@\
- zscr.F zsearc.F zshifd.F zshifp.F zshift.F zstore.F zswap.F \ @@\
- ztoibm.F ztrap.F zuploc.F zuser.F zwork.F zwrite.F
-
-#ifdef CERNLIB_UNIX
-
-SRCS_C= zjump.c
-
-#else
-
-SRCS_F:=$(SRCS_F) zjumpft.F
-
-#endif
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/zbook/code/zagain.F b/src/packlib/zbook/code/zagain.F
deleted file mode 100644
index 8d16143..0000000
--- a/src/packlib/zbook/code/zagain.F
+++ /dev/null
@@ -1,70 +0,0 @@
-*
-* $Id: zagain.F,v 1.1.1.1 1996/03/08 12:01:11 mclareni Exp $
-*
-* $Log: zagain.F,v $
-* Revision 1.1.1.1 1996/03/08 12:01:11 mclareni
-* Zbook
-*
-*
-#include "zbook/pilot.h"
- SUBROUTINE ZAGAIN(IZ,ID)
-C
-C ******************************************************************
-C * *
-C * DELETES BANK ID AND ALL BANKS CREATED AFTERWARDS *
-C * *
-C ******************************************************************
-C
- DIMENSION IZ(1),ID(1)
- LOGICAL ZIDOK
-C
-C ------------------------------------------------------------------
-C
- IF (ZIDOK(IZ,ID)) GO TO 10
- CALL ZERROR(IZ,300,'ZAGAIN',ID)
- RETURN
-C
- 10 JZ = IZ(1)
- IZ(JZ + 6) = 0
- IDATA=ID(1)
- ILINK=IDATA+IZ(IDATA)+1
- IFIRST=IDATA-IZ(ILINK)-1
- IF (IFIRST.GT.IZ(JZ + 14)) GO TO 30
- IF (IFIRST.LT.1) GO TO 30
-C
-C UPDATE LOCAL POINTERS
-C
- IF(IZ(JZ-1).NE.0) CALL ZUPLOC(IZ,IFIRST,IZ(JZ+15),0)
-C
- IZ(JZ + 15) = IFIRST
- IZ(JZ + 1) = IZ(JZ + 14) - IFIRST
- IAGAIN = IFIRST
- 20 NLONG = IZ(IFIRST)
- IF (NLONG.EQ.0) GO TO 99
- N = IABS(NLONG)
- IFIRST = IFIRST + N
- IF (IFIRST.GT.IZ(JZ + 14)) GO TO 30
- IF (NLONG.GT.0) GO TO 25
- IZ(JZ + 5) = IZ(JZ + 5) - N
- GO TO 20
-C
- 25 NID = IZ(IFIRST - 1)
- IF (NID.LT.IZ(JZ + 12)) GO TO 30
- IF (NID.GT.IZ(JZ + 13)) GO TO 30
- IZ(NID) = 0
- GO TO 20
-C
- 30 NBANK = IZ(JZ + 3)
- IF (NBANK.LE.0) GO TO 60
- IF (NBANK.GT.IZ(JZ + 14)) GO TO 60
- DO 50 I = 1,NBANK
- IF(IZ(I+1).GE.IDATA)IZ(I+1)=0
- 50 CONTINUE
-C
- 60 CALL ZERROR(IZ,400,'ZAGAIN',ID)
- RETURN
-C
- 99 IZ(IAGAIN) = 0
- ID(1)=0
- RETURN
- END
diff --git a/src/packlib/zbook/code/zbform.F b/src/packlib/zbook/code/zbform.F
deleted file mode 100644
index 1dec802..0000000
--- a/src/packlib/zbook/code/zbform.F
+++ /dev/null
@@ -1,38 +0,0 @@
-*
-* $Id: zbform.F,v 1.1.1.1 1996/03/08 12:01:11 mclareni Exp $
-*
-* $Log: zbform.F,v $
-* Revision 1.1.1.1 1996/03/08 12:01:11 mclareni
-* Zbook
-*
-*
-#include "zbook/pilot.h"
- SUBROUTINE ZBFORM(IZ,SNAME,SFORM)
-*
-* author HG 7/4/84
-*
-* BOOKS A FORMAT FOR A BANK. THE REFERENCE TO THE FORMAT
-* IS THROUGH THE BANK NAME. FOR THE FORMAT CONVENTION,
-* SEE ROUTINE ZECFOR.
-*
-* INPUT
-* IZ STRUCTURE
-* SNAME BANK NAME (UP TO 4 CHARACTERS)
-* SFORM FORMAT
-*
- DIMENSION IZ(*)
- CHARACTER *(*) SFORM,SNAME
- CHARACTER *4 SNAMEL
- DIMENSION IBUF(51)
-*
-*--- GET OUTPUT UNIT
- LOUT=IZ(IZ(1)+4)
-*--- CONVERT NAME TO HOLL.
- SNAMEL=' '
- SNAMEL(1:MIN(4,LEN(SNAME)))=SNAME
- CALL UCTOH(SNAMEL,NAME,4,4)
-*--- CONVERT FORMAT
- CALL ZECFOR(SFORM,50,NW,IBUF,LOUT)
-*--- PUT FORMAT AWAY
- CALL ZPTFOR(IZ,NAME,NW,IBUF)
- END
diff --git a/src/packlib/zbook/code/zbook.F b/src/packlib/zbook/code/zbook.F
deleted file mode 100644
index 725476f..0000000
--- a/src/packlib/zbook/code/zbook.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: zbook.F,v 1.1.1.1 1996/03/08 12:01:11 mclareni Exp $
-*
-* $Log: zbook.F,v $
-* Revision 1.1.1.1 1996/03/08 12:01:11 mclareni
-* Zbook
-*
-*
-#include "zbook/pilot.h"
- SUBROUTINE ZBOOK(IZ,ID,ND)
-C
-C ******************************************************************
-C * *
-C * CREATION OF A BANK (DATA ONLY) *
-C * *
-C ******************************************************************
-C
- DIMENSION IZ(1),ID(1)
-C
-C ------------------------------------------------------------------
-C
- JZ = IZ(1)
- IZ(JZ + 17) = 1
- CALL ZBOOKN(IZ,ID,ND,0,' ',0)
- RETURN
- END
diff --git a/src/packlib/zbook/code/zbook0.F b/src/packlib/zbook/code/zbook0.F
deleted file mode 100644
index 5d82eef..0000000
--- a/src/packlib/zbook/code/zbook0.F
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: zbook0.F,v 1.1.1.1 1996/03/08 12:01:11 mclareni Exp $
-*
-* $Log: zbook0.F,v $
-* Revision 1.1.1.1 1996/03/08 12:01:11 mclareni
-* Zbook
-*
-*
-#include "zbook/pilot.h"
- SUBROUTINE ZBOOK0(IZ,ID,ND)
-C
-C ******************************************************************
-C * *
-C * SAME AS ZBOOK *
-C * PRESETS CONTENTS TO 0. *
-C * *
-C ******************************************************************
-C
- DIMENSION IZ(1),ID(1)
-C
-C ------------------------------------------------------------------
-C
- CALL ZBOOKN(IZ,ID,ND,0,' ',0)
- RETURN
- END
diff --git a/src/packlib/zbook/code/zbookn.F b/src/packlib/zbook/code/zbookn.F
deleted file mode 100644
index 71afcb3..0000000
--- a/src/packlib/zbook/code/zbookn.F
+++ /dev/null
@@ -1,75 +0,0 @@
-*
-* $Id: zbookn.F,v 1.1.1.1 1996/03/08 12:01:11 mclareni Exp $
-*
-* $Log: zbookn.F,v $
-* Revision 1.1.1.1 1996/03/08 12:01:11 mclareni
-* Zbook
-*
-*
-#include "zbook/pilot.h"
- SUBROUTINE ZBOOKN(IZ,ID,ND,NL,NAME,NR)
-C
-C ******************************************************************
-C * *
-C * SAME AS ZBOOKS + ZNAME *
-C * *
-C ******************************************************************
-C
- DIMENSION IZ(1),ID(1)
- LOGICAL ZIDOK
-C
-C ------------------------------------------------------------------
-C
- CALL UCTOH(NAME,NAMEC,4,4)
- JZ = IZ(1)
- IZ(JZ + 6) = 0
- IF (.NOT.ZIDOK(IZ,ID)) GO TO 10
-C
-C BANK ALREADY EXISTS DELETE IT
-C
- CALL ZERROR(IZ,200,'ZBOOKN',ID)
- CALL ZDELET(IZ,ID)
-C
- 10 NID = LOCF(ID(1)) + IZ(JZ + 16) + 1
- IZ(JZ + 18) = NID
- ID(1) = 0
- NN = ND + NL + 6
- IF (NN.LE.IZ(JZ + 1)) GO TO 20
- CALL ZGARB(IZ)
- IF (IZ(JZ + 6).NE.0) GO TO 99
- NID = IZ(JZ + 18)
- IF (NN.LE.IZ(JZ + 1)) GO TO 20
- NMOVE = NN - IZ(JZ + 1) + 1
- CALL ZMOVE(IZ,NMOVE)
- IF (NN.LE.IZ(JZ + 1)) GO TO 20
- CALL ZERROR(IZ,100,'ZBOOKN',ID)
- GO TO 99
-C
- 20 IFIRST = IZ(JZ + 15)
- IZ(IFIRST) = NN
- NZERO = NL
- IF (IZ(JZ + 17).EQ.0)NZERO = NZERO + ND + 1
-#if !defined(CERNLIB_BESM6)
- IF(NZERO.GT.0) CALL VZERO(IZ(IFIRST+1),NZERO)
-#endif
-#if defined(CERNLIB_BESM6)
- IF(NZERO.GT.0) CALL UZERO(IZ(IFIRST+1),1,NZERO)
-#endif
- IDATA=IFIRST+NL+1
- IZ(IDATA)=ND+2
- IZLAST=IDATA+ND+5
- IZ(IZLAST - 4) = NAMEC
- IZ(IZLAST - 3) = NR
- IZ(IZLAST - 2) = NL
- IZ(IZLAST - 1) = NID
- IZ(NID)=IDATA
- IZ(IZLAST) = 0
- IZ(JZ + 15) = IZLAST
- IZ(JZ + 1) = IZ(JZ + 14) - IZLAST
- IZ(JZ + 8) = IZ(JZ + 8) + 1
- IF (NID.LT.IZ(JZ + 12))IZ(JZ + 12) = NID
- IF (NID.GT.IZ(JZ + 13))IZ(JZ + 13) = NID
-C
- 99 IZ(JZ + 17) = 0
- RETURN
- END
diff --git a/src/packlib/zbook/code/zbooks.F b/src/packlib/zbook/code/zbooks.F
deleted file mode 100644
index 2a399bc..0000000
--- a/src/packlib/zbook/code/zbooks.F
+++ /dev/null
@@ -1,85 +0,0 @@
-*
-* $Id: zbooks.F,v 1.1.1.1 1996/03/08 12:01:11 mclareni Exp $
-*
-* $Log: zbooks.F,v $
-* Revision 1.1.1.1 1996/03/08 12:01:11 mclareni
-* Zbook
-*
-*
-#include "zbook/pilot.h"
- SUBROUTINE ZBOOKS(IZ,ID,ND,NL)
-C
-C ******************************************************************
-C * *
-C * CREATES A BANK WITH ND DATA WORDS AND NL LINKS *
-C * *
-C * IZ(ID-NL-1) = ND+NL+6 *
-C * IZ(ID-NL) = POINTER FOR NL TH LINK *
-C * IZ(ID- 1) = POINTER FOR FIRST LINK *
-C * IZ(ID) = ND+2 *
-C * IZ(ID+ 1) = FIRST USED WORD *
-C * IZ(ID+ND) = LAST USER WORD *
-C * IZ(ID+ND+1) = NAME OF THE BANK *
-C * IZ(ID+ND+2) = USER BANK NUMBER *
-C * IZ(ID+ND+3) = NL *
-C * IZ(ID+ND+4) = RELATIVE ADDRESS OF ID *
-C * *
-C ******************************************************************
-C
- DIMENSION IZ(1),ID(1)
- LOGICAL ZIDOK
-C
-C ------------------------------------------------------------------
-C
- JZ = IZ(1)
- IZ(JZ + 6) = 0
- IF (.NOT.ZIDOK(IZ,ID)) GO TO 10
-C
-C BANK ALREADY EXISTS DELETE IT
-C
- CALL ZERROR(IZ,200,'ZBOOKS',ID)
- CALL ZDELET(IZ,ID)
-C
- 10 NID = LOCF(ID(1)) + IZ(JZ + 16) + 1
- IZ(JZ + 18) = NID
- ID(1) = 0
- NN = ND + NL + 6
- IF (NN.LE.IZ(JZ + 1)) GO TO 20
- CALL ZGARB(IZ)
- IF (IZ(JZ + 6).NE.0) GO TO 99
- NID = IZ(JZ + 18)
- IF (NN.LE.IZ(JZ + 1)) GO TO 20
- NMOVE = NN - IZ(JZ + 1) + 1
- CALL ZMOVE(IZ,NMOVE)
- IF (NN.LE.IZ(JZ + 1)) GO TO 20
- CALL ZERROR(IZ,100,'ZBOOKS',ID)
- GO TO 99
-C
- 20 IFIRST = IZ(JZ + 15)
- IZ(IFIRST) = NN
- NZERO = NL
- IF (IZ(JZ + 17).EQ.0)NZERO = NZERO + ND + 1
-#if !defined(CERNLIB_BESM6)
- IF(NZERO.GT.0) CALL VZERO(IZ(IFIRST+1),NZERO)
-#endif
-#if defined(CERNLIB_BESM6)
- IF(NZERO.GT.0) CALL UZERO(IZ(IFIRST+1),1,NZERO)
-#endif
- IDATA=IFIRST+NL+1
- IZ(IDATA)=ND+2
- IZLAST=IDATA+ND+5
- CALL UCTOH(' ',IZ(IZLAST - 4),4,4)
- IZ(IZLAST - 3) = 0
- IZ(IZLAST - 2) = NL
- IZ(IZLAST - 1) = NID
- IZ(NID)=IDATA
- IZ(IZLAST) = 0
- IZ(JZ + 15) = IZLAST
- IZ(JZ + 1) = IZ(JZ + 14) - IZLAST
- IZ(JZ + 8) = IZ(JZ + 8) + 1
- IF (NID.LT.IZ(JZ + 12))IZ(JZ + 12) = NID
- IF (NID.GT.IZ(JZ + 13))IZ(JZ + 13) = NID
-C
- 99 IZ(JZ + 17) = 0
- RETURN
- END
diff --git a/src/packlib/zbook/code/zbookt.F b/src/packlib/zbook/code/zbookt.F
deleted file mode 100644
index dedb7c8..0000000
--- a/src/packlib/zbook/code/zbookt.F
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: zbookt.F,v 1.1.1.1 1996/03/08 12:01:11 mclareni Exp $
-*
-* $Log: zbookt.F,v $
-* Revision 1.1.1.1 1996/03/08 12:01:11 mclareni
-* Zbook
-*
-*
-#include "zbook/pilot.h"
- SUBROUTINE ZBOOKT ( LUN)
-C.
-C.
-C. ******************************************************************
-C. * *
-C. * *
-C. * *
-C. * *
-C. ******************************************************************
-C.
- WRITE (LUN,1000)
- RETURN
- 1000 FORMAT ('0PACKAGE COMPILED FROM PAM FILE= ',
- + 40H ZBOOK 2.28 940830 Q210
- +/)
- END
diff --git a/src/packlib/zbook/code/zbug.F b/src/packlib/zbook/code/zbug.F
deleted file mode 100644
index 8183083..0000000
--- a/src/packlib/zbook/code/zbug.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: zbug.F,v 1.1.1.1 1996/03/08 12:01:11 mclareni Exp $
-*
-* $Log: zbug.F,v $
-* Revision 1.1.1.1 1996/03/08 12:01:11 mclareni
-* Zbook
-*
-*
-#include "zbook/pilot.h"
- LOGICAL FUNCTION ZBUG(IZ,IERROR)
-C
-C ******************************************************************
-C * *
-C * ZBUG IS.TRUE. IF THE CURRENT STATUS ERROR *
-C * IS EQUAL TO IERROR *
-C * *
-C ******************************************************************
-C
- DIMENSION IZ(1)
-C
-C ------------------------------------------------------------------
-C
- JZ = IZ(1)
- ZBUG = IZ(JZ + 6).EQ.IERROR
- RETURN
- END
diff --git a/src/packlib/zbook/code/zclose.F b/src/packlib/zbook/code/zclose.F
deleted file mode 100644
index 012b97b..0000000
--- a/src/packlib/zbook/code/zclose.F
+++ /dev/null
@@ -1,76 +0,0 @@
-*
-* $Id: zclose.F,v 1.1.1.1 1996/03/08 12:01:11 mclareni Exp $
-*
-* $Log: zclose.F,v $
-* Revision 1.1.1.1 1996/03/08 12:01:11 mclareni
-* Zbook
-*
-*
-#include "zbook/pilot.h"
- SUBROUTINE ZCLOSE(IZ,LUN)
-C
-C ******************************************************************
-C * *
-C * CLOSE MASS STORAGE FILE *
-C * BANK DESCRIPTOR IS DELETED FROM MEMORY *
-C * *
-C ******************************************************************
-C
- DIMENSION IZ(1)
-C
-C ------------------------------------------------------------------
-C
- JZ = IZ(1)
- IZ(JZ + 6) = 0
- JD = IZ(JZ - 2)
- IF (JD.EQ.0) GO TO 95
- NL = IZ(JD) - 2
- NLUN = 1
- 5 IF (IZ(JD + NLUN).EQ.LUN) GO TO 7
- NLUN = NLUN + 1
- IF (NLUN.LE.NL) GO TO 5
- GO TO 95
-C
- 7 JDIR = IZ(JD - NLUN)
- IF(IZ(JDIR+10).EQ.0)GO TO 20
- IZ(JDIR+10)=0
- IF (IZ(JDIR + 6).NE.0) GO TO 10
- CALL ZPUSHS(IZ,JDIR,3,0)
- IF (IZ(JZ + 6).NE.0) GO TO 99
- IZ(JDIR + 6) = 1
-C
-C WRITE DIRECTORY AS A NORMAL BANK WITH KEY='ZDIR'
-C
- 10 CALL ZWRITE(IZ,JDIR,LUN,'ZDIR')
- IF (IZ(JZ + 6).NE.0) GO TO 99
-C
- CALL ZSEARC(IZ,NLUN,'ZDIR',LOC)
- IF (LOC.LT.0) GO TO 99
- IZ(JDIR + 4) = IZ(JDIR + 3)
- IZ(JDIR + 5) = IZ(LOC + 1)
- IZ(JDIR + 6) = JBYT(IZ(LOC + 2),1,18)
-C
-C WRITES RECORD 1 GENERAL DIRECTORY
-C
- CALL ZIODO(LUN,0,IZ(JDIR+3),IZ(JDIR+4),3,2)
-C
-C DELETE DIRECTORY BANK FROM MEMORY
-C
-#if defined(CERNLIB_CDC)
- IF(LUN.LE.0)GO TO 20
- CALL CLOSMS(LUN)
-#endif
-#if defined(CERNLIB_NORD)
- CLOSE(LUN)
-#endif
- 20 CALL ZDELET(IZ,JDIR)
- JD = IZ(JZ - 2)
- IZ(JD + NLUN) = 0
- GO TO 99
-C
-C LUN IS UNDEFINED
-C
- 95 CALL ZERROR(IZ,900,'ZCLOSE',0)
-C
- 99 RETURN
- END
diff --git a/src/packlib/zbook/code/zdebug.F b/src/packlib/zbook/code/zdebug.F
deleted file mode 100644
index a7c15ab..0000000
--- a/src/packlib/zbook/code/zdebug.F
+++ /dev/null
@@ -1,130 +0,0 @@
-*
-* $Id: zdebug.F,v 1.1.1.1 1996/03/08 12:01:11 mclareni Exp $
-*
-* $Log: zdebug.F,v $
-* Revision 1.1.1.1 1996/03/08 12:01:11 mclareni
-* Zbook
-*
-*
-#include "zbook/pilot.h"
- SUBROUTINE ZDEBUG(IZ,LOUT,IERROR,KEY)
-C
-C ******************************************************************
-C * *
-C * DEBUG THE DATA BANK STRUCTURE *
-C * PRINT POINTERS TO DATA BANKS , LENGTHS *
-C * AND NUMBER OF THE IDENTIFIERS *
-C * *
-C ******************************************************************
-C
- DIMENSION IZ(1),KEY(1),IKEY(6)
- DATA IPRINT/0/
-C
-C ------------------------------------------------------------------
-C
- IF (IPRINT.NE.0) GO TO 99
- JZ = IZ(1)
- NWORDS = IZ(JZ + 14)
- IF (IERROR.EQ. - 1) GO TO 90
- IERROR=0
-C
-C TEST LENGTH OF THE STRUCTURE
-C
- 10 IF (NWORDS.GT.0) GO TO 20
- IF (IPRINT.EQ.0) GO TO 90
- WRITE(LOUT,1100)NWORDS
- GO TO 99
- 20 CONTINUE
-C
-C TEST LENGTH OF USED AND UNUSED SPACE
-C
- LUSED = IZ(JZ + 15)
- LUNUS = IZ(JZ + 1)
- IF (NWORDS.EQ.LUSED + LUNUS) GO TO 30
- IF (IPRINT.EQ.0) GO TO 90
- WRITE(LOUT,1200)NWORDS,LUSED,LUNUS
- GO TO 99
- 30 CONTINUE
-C
- NBANK = IZ(JZ + 3)
- IF (IPRINT.NE.0)WRITE(LOUT,1300)NWORDS,LUSED,LUNUS,NBANK
-C
-C TEST IF FIRST UNUSED WORD CONTAIN 0.
-C
- II = IZ(JZ + 15)
- IFUNUS = IZ(II)
- IF (IFUNUS.EQ.0) GO TO 40
- IF (IPRINT.EQ.0) GO TO 90
- WRITE(LOUT,1400)IFUNUS
-C
-C LOOP ON THE NBANK BANKS
-C
- 40 IF (IPRINT.NE.0)WRITE(LOUT,1600)
-C
- IFIRST = JZ + IZ(JZ) + 3
- 50 IF (IFIRST.GE.IZ(JZ + 15)) GO TO 99
- NLONG = IABS(IZ(IFIRST))
- IER = 1
- IF (NLONG.GT.NWORDS - IFIRST) GO TO 60
- ILAST = IFIRST + NLONG - 1
- IF (IZ(IFIRST).LT.0) GO TO 70
- NID = IZ(ILAST)
- IER = 2
- IF (NID.LT.IZ(JZ + 12)) GO TO 60
- IF (NID.GT.IZ(JZ + 13)) GO TO 60
- NLINK = IZ(ILAST - 1)
- IDATA=IFIRST+NLINK+1
- IF (IPRINT.NE.0)WRITE(LOUT,1700)
- + IFIRST,IZ(IFIRST),ILAST,NID,IZ(NID)
- + ,IZ(ILAST-3),IZ(ILAST-2)
- IER = 3
- IF(IDATA.NE.IZ(NID))GO TO 60
- IER = 4
- IF(IDATA+IZ(IDATA)+2.EQ.ILAST)GO TO 70
- 60 IF (IPRINT.EQ.0) GO TO 90
- WRITE(LOUT,1800)IFIRST
- IF (IER.GT.1)WRITE(LOUT,2050)IZ(ILAST-3),IZ(ILAST-2),IZ(ILAST-1)
- IF (IER.EQ.1)WRITE(LOUT,2100)IZ(IFIRST)
- IF (IER.EQ.2)WRITE(LOUT,2200)NID
- IF(IER.EQ.3)WRITE(LOUT,2300)IDATA,NID
- IF(IER.EQ.4)WRITE(LOUT,2400)IZ(IDATA)
- GO TO 99
-C
- 70 IFIRST = ILAST + 1
- GO TO 50
-C
- 90 IPRINT = 1
- CALL UCTOH1(KEY,IKEY,6)
- WRITE(LOUT,1000)IKEY
- GO TO 10
-C
- 1000 FORMAT(///,' ***** ZDEBUG IS CALLED AT ',6A1,/)
- 1100 FORMAT(' ZBOOK ERROR IN STRUCTURE LENGTH',I6)
- 1200 FORMAT(' ZBOOK ERROR STRUCTURE LENGTH',I6,' .NE. LENGTH'
- + ,' USED',I6,' + LENGTH UNUSED',I6)
- 1300 FORMAT(' ZBOOK STRUCTURE LENGTH',I6,' LENGTH'
- + ,' USED',I6,' LENGTH UNUSED',I6,' NUMBER OF BANKS ',I6)
- 1400 FORMAT(' FIRST UNUSED WORD SHOULD BE ZERO AND NOT ',I6)
- 1500 FORMAT(' NUMBER OF BANKS IS NOT REASONABLE',I6)
- 1600 FORMAT(///,6X,'IFIRST',5X,'IZ(IFIRST)',5X,'ILAST',5X,
- + 'IZ(ILAST)',5X,'ID=IZ(IZ(ILAST))',
- + 5X,'NAME',7X,'NUMBER',/)
- 1700 FORMAT(6X,I6,6X,I6,6X,I6,6X,I8,7X,I6,14X,A4,1X,I10)
- 1800 FORMAT(' ***** BANK STARTING AT ADDRESS',I10,
- + ' HAS BEEN OVERWRITTEN ',/)
- 2050 FORMAT(' ***** USER BANK NAME =',A4,/,
- + ' ***** USER BANK NUMBER =',I10,/,
- + ' ***** NUMBER OF POINTERS =',I10,/)
- 2100 FORMAT(' ***** THE TOTAL NUMBER OF WORDS IN THE BANK =',
- + I10,/,' ***** HAS BEEN OVERWRITTEN',/)
- 2200 FORMAT(' ***** THE LAST WORD OF THE BANK =',I10,/,
- + ' ***** IS NOT A VALID POINTER NUMBER',/)
- 2300 FORMAT(' ***** THE BANK ADDRESS ',I10,/,
- + ' ***** DOES NOT MATCH WITH THE POINTER NO =',I10,/)
- 2400 FORMAT(' ***** THE NUMBER OF DATA WORDS ',I10,/,
- + ' ***** HAS BEEN OVERWRITTEN',/)
-C
- 99 IF (IERROR.EQ. - 1)IPRINT = 0
- IF (IPRINT.NE.0)IERROR = IPRINT
- RETURN
- END
diff --git a/src/packlib/zbook/code/zdelet.F b/src/packlib/zbook/code/zdelet.F
deleted file mode 100644
index d435d71..0000000
--- a/src/packlib/zbook/code/zdelet.F
+++ /dev/null
@@ -1,54 +0,0 @@
-*
-* $Id: zdelet.F,v 1.1.1.1 1996/03/08 12:01:11 mclareni Exp $
-*
-* $Log: zdelet.F,v $
-* Revision 1.1.1.1 1996/03/08 12:01:11 mclareni
-* Zbook
-*
-*
-#include "zbook/pilot.h"
- SUBROUTINE ZDELET(IZ,ID)
-C
-C ******************************************************************
-C * *
-C * DELETES BANK ID *
-C * *
-C ******************************************************************
-C
- DIMENSION IZ(1),ID(1)
- LOGICAL ZIDOK
-C
-C ------------------------------------------------------------------
-C
- JZ = IZ(1)
- IF (ZIDOK(IZ,ID)) GO TO 5
- CALL ZERROR(IZ,300,'ZDELET',ID)
- RETURN
- 5 IZ(JZ + 6) = 0
- IDATA=ID(1)
- ILINK=IDATA+IZ(IDATA)+1
- IF (IZ(ILINK).NE.0) GO TO 20
- IFNEW = ILINK + 2
- IFIRST=IDATA-1
- NLESS = IZ(IFIRST)
- NID = IZ(ILINK + 1)
- IF (IZ(JZ - 1).EQ.0) GO TO 10
-C
-C UPDATE LOCAL POINTERS
-C
- CALL ZUPLOC(IZ,IFIRST,ILINK,0)
-C
- 10 IMAX = IZ(JZ + 15)
- CALL ZSHIFT(IZ,IFNEW,IMAX,-NLESS,'ZDELET')
- IF (IZ(JZ + 6).NE.0)RETURN
-C
- ID(1) = 0
- IZ(NID) = 0
- RETURN
-C
-C BANK OF POINTERS
-C
- 20 CALL ZDROP(IZ,ID)
- CALL ZGARB(IZ)
- RETURN
- END
diff --git a/src/packlib/zbook/code/zdgarb.F b/src/packlib/zbook/code/zdgarb.F
deleted file mode 100644
index 9d93470..0000000
--- a/src/packlib/zbook/code/zdgarb.F
+++ /dev/null
@@ -1,83 +0,0 @@
-*
-* $Id: zdgarb.F,v 1.1.1.1 1996/03/08 12:01:11 mclareni Exp $
-*
-* $Log: zdgarb.F,v $
-* Revision 1.1.1.1 1996/03/08 12:01:11 mclareni
-* Zbook
-*
-*
-#include "zbook/pilot.h"
- SUBROUTINE ZDGARB(IZ,NLUN)
-C
-C ******************************************************************
-C * *
-C * PERFORMS A GARBAGE COLLECTION ON MASS STORAGE *
-C * ALL USED RECORDS BECOME CONSECUTIVE *
-C * *
-C ******************************************************************
-C
- DIMENSION IZ(1)
-C
-C ------------------------------------------------------------------
-C
- JZ = IZ(1)
- JD = IZ(JZ - 2)
- JDIR = IZ(JD - NLUN)
- LUN = IZ(JD + NLUN)
- LREC = IZ(JDIR + 3)
- KEYOLD = 0
-C
-C CREATES TEMPORARY BANK TO HANDLE RECORD BUFFER
-C
- CALL ZBOOKN(IZ,IZ(JZ-3),LREC,0,'*GAR',1)
- JGARB = IZ(JZ - 3)
- IF (JGARB.EQ.0) GO TO 99
-C
-C SEARCH NEXT ZERO RECORD
-C
- JD = IZ(JZ - 2)
- JDIR = IZ(JD - NLUN)
- NZERO = IZ(JDIR + 8)
- NONE = NZERO + 1
- 10 IF (IZ(JDIR + 10 + NZERO).EQ.0) GO TO 20
- NZERO = NZERO + 1
- GO TO 10
-C
-C SEARCH NEXT NON ZERO RECORD
-C
- 20 IF (NONE.LE.NZERO)NONE = NZERO + 1
- 30 IF (NONE.GT.IZ(JDIR + 2)) GO TO 60
- IF (IZ(JDIR + 10 + NONE).NE.0) GO TO 40
- NONE = NONE + 1
- GO TO 30
-C
-C COPY NONE TO NZERO
-C
- 40 CALL ZIODO(LUN,NONE ,LREC,IZ(JGARB+1),LREC,1)
- CALL ZIODO(LUN,NZERO,LREC,IZ(JGARB+1),LREC,2)
-C
-C RESET POINTERS IN IDS BANK
-C
- IF (IZ(JDIR + 10 + NONE).EQ.KEYOLD) GO TO 50
- KEYOLD = IZ(JDIR + 10 + NONE)
- CALL ZSEARC(IZ,NLUN,KEYOLD,LOC)
- IF (LOC.LE.0) GO TO 91
- IZ(LOC + 1) = NZERO
- 50 IZ(JDIR + 10 + NZERO) = IZ(JDIR + 10 + NONE)
- IZ(JDIR + 10 + NONE) = 0
- NONE = NONE + 1
- NZERO = NZERO + 1
- GO TO 30
-C
-C RESET FIRST NON ZERO RECORD
-C
- 60 IZ(JDIR + 8) = NZERO
- CALL ZDELET(IZ,IZ(JZ-3))
- GO TO 99
-C
-C STRUCTURE HAS BEEN OVERWRITTEN
-C
- 91 CALL ZERROR(IZ,400,'ZDGARB',KEYOLD)
-C
- 99 RETURN
- END
diff --git a/src/packlib/zbook/code/zdisk.F b/src/packlib/zbook/code/zdisk.F
deleted file mode 100644
index 70a1c3f..0000000
--- a/src/packlib/zbook/code/zdisk.F
+++ /dev/null
@@ -1,106 +0,0 @@
-*
-* $Id: zdisk.F,v 1.1.1.1 1996/03/08 12:01:12 mclareni Exp $
-*
-* $Log: zdisk.F,v $
-* Revision 1.1.1.1 1996/03/08 12:01:12 mclareni
-* Zbook
-*
-*
-#include "zbook/pilot.h"
- SUBROUTINE ZDISK(IZ,LUN,NREC,LREC)
-C
-C ******************************************************************
-C * *
-C * INITIALIZES BANK FOR DISK/LCM OVERFLOW *
-C * POINTER TO THE DISK DESCRIPTION BANK IS *
-C * JD=IZ(JZ-2) POINTER TO DISK DIRECTORY *
-C * *
-C * IZ(JD+NLUN) = LUN *
-C * IZ(JD-NLUN) = POINTER FOR DIRECTORY FOR LUN *
-C * *
-C * IZ(JDIR+1) = LUN *
-C * 2 = NREC *
-C * 3 = LREC *
-C * 4 = POINTER TO FIRST KEY IN JDIR *
-C * 5 = POINTER TO LAST KEY IN JDIR+4 *
-C * 6 = NUMBER OF FREE PLACES FOR KEYS *
-C * 7 = NUMBER OF FREE RECORDS *
-C * 8 = POINTER TO FIRST UNUSED RECORD *
-C * 9 = POINTER TO GARBAGE COLLECTION BANK *
-C * 10 = 1 IF DATA SET HAS BEEN MODIFIED *
-C * *
-C * IZ(JDIR+11)----->IZ(JDIR+10+NREC)=RECORD DESCRIPTION *
-C * IZ(JDIR+10+IREC)=KEY IF IREC CONTAINS ID *
-C * =0 IF IREC IS FREE *
-C * *
-C * IZ(JDIR+10+NREC+1) = KEY1 *
-C * 2 = FIRST RECORD CONTAINING ID1 *
-C * 3 = NUMBER OF WORDS IN BANK ID1 *
-C * 4 = KEY2 *
-C * 5 = ETC. *
-C * *
-C ******************************************************************
-C
- DIMENSION IZ(1)
-#if defined(CERNLIB_UNIVAC)
- CHARACTER * 7 IDIM
-#endif
-C
-C ------------------------------------------------------------------
-C
- JZ = IZ(1)
- IZ(JZ + 6) = 0
- IF (IZ(JZ - 2).NE.0) GO TO 3
- CALL ZBOOKN(IZ,IZ(JZ-2),1,1,'*ZDI',1)
- 3 JD = IZ(JZ - 2)
- IF (JD.EQ.0) GO TO 99
- NL = IZ(JD) - 2
- NLUN = 1
-C
- 5 IF (IZ(JD + NLUN).EQ.0.AND.IZ(JD - NLUN).EQ.0) GO TO 7
- NLUN = NLUN + 1
- IF(NLUN.GT.NL) CALL ZPUSHS(IZ,JD,1,1)
- IF (IZ(JZ + 6).NE.0) GO TO 99
- GO TO 5
-C
- 7 CALL ZBOOKN(IZ,IZ(JD-NLUN),NREC+40,0,'*DIR',LUN)
- JD = IZ(JZ - 2)
- JDIR = IZ(JD - NLUN)
- IF (JDIR.EQ.0) GO TO 99
- JD = IZ(JZ - 2)
-C
- IZ(JD + NLUN) = LUN
- IZ(JDIR + 1) = LUN
- IZ(JDIR + 2) = NREC - 1
- IZ(JDIR + 3) = LREC
- IZ(JDIR + 4) = 11 + NREC
- IZ(JDIR + 5) = IZ(JDIR + 4)
- IZ(JDIR + 6) = 10
- IZ(JDIR + 7) = NREC - 1
- IZ(JDIR + 8) = 1
- IZ(JDIR + 10)=1
-#if defined(CERNLIB_UNIVAC)
-C
-C ASSIGN A TEMPORARY WORD-ADDRESSABLE FILE 'Z$B' FOR LUN=0
-C
- IF (LUN.EQ.0) THEN
- NWMAX = ((NREC * LREC + 99999) / 100000) * 100000
- IF (NWMAX.LT.1000000) THEN
- ENCODE(7,10,IDIM) NWMAX
- ELSE
- ENCODE(7,11,IDIM) NWMAX
- ENDIF
- ISTAT = FACSF2('@ASG,T Z$B.,D4///'//IDIM//' . ')
- IF (ISTAT.LT.0) THEN
- WRITE(6,12) ISTAT
- STOP 'ZDISK'
- ENDIF
- ENDIF
- 10 FORMAT(I6,1X)
- 11 FORMAT(I7)
- 12 FORMAT(' LUN=0 (FILE Z$B) CANNOT BE ASSIGNED IN ZDISK. STATUS:',
- + O14)
-#endif
-C
- 99 RETURN
- END
diff --git a/src/packlib/zbook/code/zdrop.F b/src/packlib/zbook/code/zdrop.F
deleted file mode 100644
index 68c625b..0000000
--- a/src/packlib/zbook/code/zdrop.F
+++ /dev/null
@@ -1,97 +0,0 @@
-*
-* $Id: zdrop.F,v 1.1.1.1 1996/03/08 12:01:12 mclareni Exp $
-*
-* $Log: zdrop.F,v $
-* Revision 1.1.1.1 1996/03/08 12:01:12 mclareni
-* Zbook
-*
-*
-#include "zbook/pilot.h"
- SUBROUTINE ZDROP(IZ,ID)
-C
-C ******************************************************************
-C * *
-C * DROPS BANK ID *
-C * IF ID IS A BANK OF POINTERS,ZDROP DROPS *
-C * LOWER BANKS AS WELL (UP TO 10 LEVELS) *
-C * *
-C ******************************************************************
-C
- DIMENSION IZ(1),ID(1)
- DIMENSION JD(51),NL(51)
- LOGICAL ZIDOK
-C
- DATA MAXLEV/50/
-C
-C ------------------------------------------------------------------
-C
- IF (ZIDOK(IZ,ID)) GO TO 10
- CALL ZERROR(IZ,300,'ZDROP ',ID)
- RETURN
- 10 JZ = IZ(1)
- IZ(JZ + 6) = 0
- I = 1
- JD(I) = ID(1)
- ID(1) = 0
- JDI = JD(I)
- ND = IZ(JDI)
- IL = JDI + ND + 1
- NL(I) = IZ(IL)
- IFIRST = JDI - NL(I) - 1
- IF(IZ(JZ-1).NE.0) CALL ZUPLOC(IZ,IFIRST,IL,0)
- IF (IZ(IL).EQ.0.AND.IZ(IL + 2).EQ.0) GO TO 60
- IZ(JZ + 5) = IZ(JZ + 5) + IZ(IFIRST)
- IZ(IFIRST) = - IZ(IFIRST)
- NID = IZ(IL + 1)
- IZ(NID) = 0
- IF (NL(I).LE.0) GO TO 999
-C
- 21 CONTINUE
- JDI = JD(I)
- NLI = NL(I)
- JD(I + 1) = IZ(JDI - NLI)
- IF (JD(I + 1).NE.0) GO TO 50
- 45 CONTINUE
- NL(I) = NL(I) - 1
- IF (NL(I).NE.0) GO TO 21
- I = I - 1
- IF (I.LE.0) GO TO 999
- GO TO 45
- 50 CONTINUE
- JDI = JD(I + 1)
- ND = IZ(JDI)
- IL = JDI + ND + 1
- NL(I + 1) = IZ(IL)
- IFIRST = JDI - NL(I + 1) - 1
- IF(IZ(JZ-1).NE.0) CALL ZUPLOC(IZ,IFIRST,IL,0)
- IZ(JZ + 5) = IZ(JZ + 5) + IZ(IFIRST)
- IZ(IFIRST) = - IZ(IFIRST)
- NID = IZ(IL + 1)
- IF (NID.LT.IZ(JZ + 12)) GO TO 940
- IF (NID.GT.IZ(JZ + 13)) GO TO 940
- IZ(NID) = 0
- IF (NL(I + 1).LE.0) GO TO 45
- I = I + 1
- IF (I.GT.MAXLEV) GO TO 980
- GO TO 21
-C
-C LAST DATA BANK IN MEMORY ===> DELETE IT
-C
- 60 IZ(JZ + 15) = IFIRST
- IZ(JZ + 1) = IZ(JZ + 14) - IFIRST
- IZ(IFIRST) = 0
- NID = IZ(IL + 1)
- IZ(NID) = 0
- GO TO 999
-C
-C ERROR IN STRUCTURE
-C
- 940 CALL ZERROR(IZ,400,'ZDROP ',ID)
- GO TO 999
-C
-C LEVEL TOO BIG
-C
- 980 CALL ZERROR(IZ,800,'ZDROP ',ID)
-C
- 999 RETURN
- END
diff --git a/src/packlib/zbook/code/zecfor.F b/src/packlib/zbook/code/zecfor.F
deleted file mode 100644
index f90594c..0000000
--- a/src/packlib/zbook/code/zecfor.F
+++ /dev/null
@@ -1,112 +0,0 @@
-*
-* $Id: zecfor.F,v 1.1.1.1 1996/03/08 12:01:12 mclareni Exp $
-*
-* $Log: zecfor.F,v $
-* Revision 1.1.1.1 1996/03/08 12:01:12 mclareni
-* Zbook
-*
-*
-#include "zbook/pilot.h"
- SUBROUTINE ZECFOR(FORM,NWMAX,NW,IW,LOUT)
-*
-*--- DECODES A FORMAT DESCRIPTION FOR BANKS
-*
-* author HG 7/4/84
-*
-*--- INPUT
-* FORM (TYPE CHARACTER) FORMAT
-* NWMAX SPACE AVAILABLE IN IW
-*--- OUTPUT
-* NW NO. OF WORDS IN IW
-* IW (ARRAY) CONVERTED FORMAT
-* LOUT PRINT OUTPUT UNIT
-*
-* THERE ARE FOUR TYPES OF CONVERSION POSSIBLE, 'A' FOR HOLLERITH,
-* 'F' FOR SINGLE PRECISION FLOATING, 'I' FOR INTEGER,
-* 'X' FOR NO CONVERSION.
-*
-* BLANKS ARE NOT SIGNIFICANT.
-*
-* FORMATS MAY CONSIST OF A HEADER PART, OR A PART WHICH IS
-* REPEATED, OR BOTH.
-*
-* THE HEADER PART IS EXECUTED ONCE, THE REST IS LEFT UNTOUCHED.
-* THE REPEAT OPTION ALLOWS TO EXECUTE A FORMAT UNTIL THE END OF
-* THE ARRAY TO CONVERT.
-*
-* A BRACKET WITHOUT REPETITION FACTOR IN FRONT INDICATES THE START OF
-* THE PART TO BE REPEATED.
-*
-* REPETITION FACTORS MUST NOT BE GREATER THAN 1000.
-*
-* MULTIPLE BRACKETS ARE NOT PERMITTED.
-*
-* EXAMPLE: 3I,F,1X,2A,4I,4(3F,3I),(I,2F)
-* MEANS
-* CONVERT FIRST THREE WORDS AS INTEGER,ONE WORD AS F, SKIP ONE WORD,
-* TWO WORDS AS HOLLERITH, FOUR INTEGERS, THEN FOUR TIMES
-* THREE FLOATING AND THREE INTEGERS, THE REST AS ONE INTEGER AND TWO
-* FLOATING ALTERNATING.
-*
-* SECOND EXAMPLE: (I) MEANS CONVERT THE WHOLE ARRAY AS INTEGER.
-*
-* THE OUTPUT IN IW CONSISTS OF THE COUNT FOR EACH TYPE, PLUS
-* 10000 FOR 'X', 20000 FOR 'I', 30000 FOR 'F', 40000 FOR 'A'.
-* ACTUALLY, ANY CHARACTER OTHER THAN A,F, OR I IS TREATED LIKE X.
-*
-* REPETITION FACTORS ARE PUT IN FRONT OF THE BRACKET, A WORD '50000'
-* INDICATES THE END.
-*
-* A WORD CONTAINING 0 INDICATES THE START OF THE PART TO BE REPEATED.
-*
-* EXAMPLE: THE FIRST FORMAT ABOVE WOULD RESULT IN:
-* NW = 13
-* IW = 20003 30001 10001 40002 20004 4 30003 20003 50000
-* 0 20001 30002 50000
-*
-* IF THE FORMAT GIVEN IS ENTIRELY BLANK, NW IS RETURNED AS ZERO.
-*
- DIMENSION IW(*)
- CHARACTER *(*) FORM,STEMP*1
- NW=0
- K=0
- IL=0
- DO 10 I=1,LEN(FORM)
- STEMP=FORM(I:I)
- ICH=ICHAR(STEMP)
- IF (STEMP.EQ.'(') THEN
- IF (NW.EQ.NWMAX) GOTO 20
- NW=NW+1
- IW(NW)=K
- K=0
- IL=I
- ELSEIF (STEMP.EQ.')') THEN
- IF (NW.EQ.NWMAX) GOTO 20
- NW=NW+1
- IW(NW)=50000
- IL=I
- ELSEIF (ICH.GE.ICHAR('A').AND.ICH.LE.ICHAR('Z')) THEN
- IF (STEMP.EQ.'A') THEN
- KADD=40000
- ELSEIF (STEMP.EQ.'I') THEN
- KADD=20000
- ELSEIF (STEMP.EQ.'F') THEN
- KADD=30000
- ELSE
- KADD=10000
- ENDIF
- IF (NW.EQ.NWMAX) GOTO 20
- NW=NW+1
- IW(NW)=KADD+MAX(K,1)
- K=0
- IL=I
- ELSEIF (ICH.GE.ICHAR('0').AND.ICH.LE.ICHAR('9')) THEN
- K=MIN(1000,10*K+ICH-ICHAR('0'))
- ENDIF
- 10 CONTINUE
- GOTO 999
- 20 CONTINUE
- WRITE (LOUT,10000) FORM(:IL)
-10000 FORMAT(/' ++++++++ZBFORM - USER BANK FORMAT TOO LONG, CUT TO',
- + ' ''',A,''''/)
- 999 END
diff --git a/src/packlib/zbook/code/zepcat.F b/src/packlib/zbook/code/zepcat.F
deleted file mode 100644
index c2952dd..0000000
--- a/src/packlib/zbook/code/zepcat.F
+++ /dev/null
@@ -1,104 +0,0 @@
-*
-* $Id: zepcat.F,v 1.1.1.1 1996/03/08 12:01:12 mclareni Exp $
-*
-* $Log: zepcat.F,v $
-* Revision 1.1.1.1 1996/03/08 12:01:12 mclareni
-* Zbook
-*
-*
-#include "zbook/pilot.h"
- SUBROUTINE ZEPCAT (IZ,LUN,JCAT,IDCAT,IERR)
-C
-C ******************************************************************
-C * *
-C * *
-C * READS NEXT CATALOG AND RETURN LIST OF KEYS *
-C * IN BANK POINTED BY JCAT *
-C * *
-C * IF JCAT DOES NOT EXIST IT IS CREATED *
-C * IF IT EXISTS ITS SIZE IS ADJUSTED TO THE CURRENT *
-C * SIZE OF THE CATALOG *
-C * *
-C * THE CATALOG IDENTIFIER IS RETURNED IN IDCAT *
-C * *
-C * *
-C ******************************************************************
-C
- DIMENSION IZ(1), JCAT(1)
- LOGICAL ZIDOK
-C
-C ------------------------------------------------------------------
-C
- IERR = 0
- IDS = IZ(1)
- IZ(IDS+6)=0
-C
-C CHECK IF HEADER ALREADY READ
-C
- JBUF = IZ(IDS - 3)
- IF (JBUF.LE.0) GO TO 10
-C
- NUNIT = IZ(JBUF) - 2
- LBUF = IUCOMP (LUN,IZ(JBUF + 1),NUNIT)
- IF (LBUF.EQ.0) GO TO 10
-C
- JBUF = IZ(JBUF - LBUF) + 1
- IF (IZ(JBUF).NE.1) GO TO 10
-C
-C ALREADY READ
-C
- IDCAT = IZ(JBUF + 1)
- GO TO 20
-C
-C LOOK FOR NEXT CATALOG
-C
- 10 CALL ZEPNXT (IZ,LUN,IDCAT,IERR)
- IF (IERR.NE.0.AND.IERR.NE.6) GO TO 50
-C
-C COMPUTE 'NKEY'
-C
- 20 CALL EPGETW (LUN,20,IW20,IERR)
- IF (IERR.NE.0) GO TO 50
-C
- CALL EPGETW (LUN,21,IW21,IERR)
- IF (IERR.NE.0) GO TO 50
-C
- NKEY = (IW20 - IW21) / 2
-C
-C CHECK IF JCAT IS A VALID POINTER
-C
- IF (.NOT.ZIDOK(IZ,JCAT)) GO TO 30
-C
-C JCAT IS A VALID POINTER
-C
- KCAT = JCAT(1)
- NPUSH = NKEY - IZ(KCAT) + 2
- CALL ZPUSHS(IZ,JCAT(1),NPUSH,0)
- GO TO 40
-C
-C BANK 'JCAT' DOES NOT EXIST
-C
- 30 CALL ZBOOKN (IZ,JCAT(1),NKEY,0,'*CAT',1)
-C
- 40 IF (IZ(IDS + 6).NE.0) GO TO 50
-C
- JBUF = IZ(IDS - 3)
- NUNIT = IZ(JBUF) - 2
- LBUF = IUCOMP (LUN,IZ(JBUF + 1),NUNIT)
- JBUF = IZ(JBUF - LBUF) + 3
- KCAT = JCAT(1)
-C
-C READ IN CATALOG
-C
- CALL EPFRD (LUN,13,NW,IZ(KCAT+1),IZ(JBUF),IERR)
- IF (IERR.NE.0) GO TO 50
-C
- JF = JBUF - 2
- IZ(JF) = 2
-C
- CALL ZFRIBM (IZ(KCAT+1),NKEY,2)
-C
- 50 IERR = IERR + IZ(IDS + 6)
-C
- RETURN
- END
diff --git a/src/packlib/zbook/code/zepcls.F b/src/packlib/zbook/code/zepcls.F
deleted file mode 100644
index 7544e34..0000000
--- a/src/packlib/zbook/code/zepcls.F
+++ /dev/null
@@ -1,43 +0,0 @@
-*
-* $Id: zepcls.F,v 1.1.1.1 1996/03/08 12:01:12 mclareni Exp $
-*
-* $Log: zepcls.F,v $
-* Revision 1.1.1.1 1996/03/08 12:01:12 mclareni
-* Zbook
-*
-*
-#include "zbook/pilot.h"
- SUBROUTINE ZEPCLS(IZ,LUN,IERR)
-C.
-C. ******************************************************************
-C. * *
-C. * *
-C. * IF LUN IS INPUT UNIT DO NOTHING *
-C. * IF LUN IS OUTPUT CALL EPCLOS *
-C. * IF LUN=0 CLOSE ALL OPEN FILES *
-C. * *
-C. * *
-C. ******************************************************************
-C.
- DIMENSION IZ(1)
-C.
-C. ------------------------------------------------------------------
-C.
- IERR = 0
- JZ = IZ(1)
- JD = IZ(JZ - 3)
- IF (JD.LE.0) GO TO 99
- NL = IZ(JD) - 2
-C
- DO 10 NLUN = 1,NL
- IF (LUN.NE.0.AND.LUN.NE.IZ(JD + NLUN)) GO TO 10
-C
- JBUF = IZ(JD - NLUN)
- IF (JBUF.LE.0) GO TO 10
- LU=IZ(JD+NLUN)
-C
- IF(IZ(JBUF+1).GT.3) CALL EPCLOS(LU,IZ(JBUF+3),IERR)
- 10 CONTINUE
-C
- 99 RETURN
- END
diff --git a/src/packlib/zbook/code/zepdef.F b/src/packlib/zbook/code/zepdef.F
deleted file mode 100644
index 85b1b73..0000000
--- a/src/packlib/zbook/code/zepdef.F
+++ /dev/null
@@ -1,68 +0,0 @@
-*
-* $Id: zepdef.F,v 1.1.1.1 1996/03/08 12:01:12 mclareni Exp $
-*
-* $Log: zepdef.F,v $
-* Revision 1.1.1.1 1996/03/08 12:01:12 mclareni
-* Zbook
-*
-*
-#include "zbook/pilot.h"
- SUBROUTINE ZEPDEF(IZ,LUN,LREC,IERR)
-C
-C ******************************************************************
-C * *
-C * INITIALISE EP PACKAGE FOR LOGICAL UNIT LUN *
-C * LREC IS THE SIZE IN 16 BITS WORDS *
-C * OF THE PHYSICAL RECORD *
-C * IF(LREC=0)LREC IS SET TO THE DEFAULT EPREAD VALUE *
-C * *
-C ******************************************************************
-C
- DIMENSION IZ(1)
-#include "zbook/wlength.inc"
-C
-C ------------------------------------------------------------------
-C
- JZ = IZ(1)
- IZ(JZ + 6) = 0
- IERR = 0
- IF (IZ(JZ - 3).GT.0) GO TO 10
-C
-C INITIALISE EP PACKAGE
-C
- CALL EPINIT
-C
-C CREATE SYSTEM BANK AND ASSOCIATED BUFFER BANK
-C
- CALL ZBOOKN(IZ,IZ(JZ-3),1,1,'*ZEP',1)
-C
- 10 JD = IZ(JZ - 3)
- IF (JD.LE.0) GO TO 99
- NL = IZ(JD) - 2
- NLUN = 1
-C
- 20 IF (IZ(JD - NLUN).LE.0) GO TO 30
- NLUN = NLUN + 1
- IF(NLUN.GT.NL) CALL ZPUSHS(IZ,JD,1,1)
- IF (IZ(JZ + 6).NE.0) GO TO 99
- GO TO 20
-C
-C COMPUTE BUFFER LENGTH AS A FUNCTION OF LREC
-C
- 30 LR = LREC
- IF (LR.LE.0)LR = 1800
- NW = (16 * LR - 1) / NBIT + 3
-C
- IF(LREC.GT.0) CALL EPSETW(LUN,1,LR,IERR)
- IF (IERR.NE.0) GO TO 99
- CALL EPSETW(LUN,5,-1,IERR)
- IF (IERR.NE.0) GO TO 99
- CALL EPSETW(LUN,6,-1,IERR)
- IF (IERR.NE.0) GO TO 99
- IZ(JD + NLUN) = LUN
-C
- CALL ZBOOKN(IZ,IZ(JD-NLUN),NW,0,'*LUN',LUN)
-C
- 99 IERR = IERR + IZ(JZ + 6)
- RETURN
- END
diff --git a/src/packlib/zbook/code/zepend.F b/src/packlib/zbook/code/zepend.F
deleted file mode 100644
index c9d5220..0000000
--- a/src/packlib/zbook/code/zepend.F
+++ /dev/null
@@ -1,46 +0,0 @@
-*
-* $Id: zepend.F,v 1.1.1.1 1996/03/08 12:01:12 mclareni Exp $
-*
-* $Log: zepend.F,v $
-* Revision 1.1.1.1 1996/03/08 12:01:12 mclareni
-* Zbook
-*
-*
-#include "zbook/pilot.h"
- SUBROUTINE ZEPEND(IZ,LUN,IERR)
-C
-C ******************************************************************
-C * *
-C * IF LUN IS INPUT UNIT DELETE SYSTEM BANK *
-C * IF LUN IS OUTPUT DELETE SYSTEM BANK *
-C * CALL EPEND *
-C * IF LUN=0 CLOSE ALL OPEN FILES *
-C * *
-C ******************************************************************
-C
- DIMENSION IZ(1)
-C
-C ------------------------------------------------------------------
-C
- IERR = 0
- JZ = IZ(1)
- JD = IZ(JZ - 3)
- IF (JD.LE.0) GO TO 99
- NL = IZ(JD) - 2
-C
- DO 10 NLUN = 1,NL
- IF (LUN.NE.0.AND.LUN.NE.IZ(JD + NLUN)) GO TO 10
-C
- JBUF = IZ(JD - NLUN)
- IF (JBUF.LE.0) GO TO 10
- LU=IZ(JD+NLUN)
-C
- IF(IZ(JBUF+1).GT.3) CALL EPEND(LU,IZ(JBUF+3),IERR)
-C
- CALL ZDELET(IZ,JBUF)
-C
- IZ(JD + NLUN) = 0
- 10 CONTINUE
-C
- 99 RETURN
- END
diff --git a/src/packlib/zbook/code/zepin.F b/src/packlib/zbook/code/zepin.F
deleted file mode 100644
index cac4ebe..0000000
--- a/src/packlib/zbook/code/zepin.F
+++ /dev/null
@@ -1,277 +0,0 @@
-*
-* $Id: zepin.F,v 1.1.1.1 1996/03/08 12:01:12 mclareni Exp $
-*
-* $Log: zepin.F,v $
-* Revision 1.1.1.1 1996/03/08 12:01:12 mclareni
-* Zbook
-*
-*
-#include "zbook/pilot.h"
- SUBROUTINE ZEPIN (IZ,LUN,KEYS,NKEYS,IDCAT,IERR)
-C
-C ******************************************************************
-C * *
-C * *
-C * READS NEXT LOGICAL EVENT IDENTIFIED BY THE *
-C * LIST OF NKEY KEYWORDS *
-C * THE CURRENT CATALOG IDENTIFIER IS RETURNED IN IDCAT *
-C * IF ZEPCAT WAS CALLED PRIOR TO ZEPIN THEN *
-C * ZEPIN STARTS TO READ AT THE FIRST KEY *
-C * UNLESS IT READS THE NEXT CATALOG TOO *
-C * *
-C * *
-C ******************************************************************
-C
-C--- Inserted by HG
- COMMON/ZCFORM/NLFORM,JD(60)
- DIMENSION IFORBF(50)
- EQUIVALENCE (IFORBF(1),JD(11))
-C---
- DIMENSION IZ(1) , KEYS(1), IH(60)
- DIMENSION JL(10) , JM(10)
- DIMENSION MODSEP(8),NUM(40),LL(4)
-C
- DATA MODSEP/11,12,13,13,13,12,13,13/
-C
-#include "zbook/wlength.inc"
- DATA IFIRST/0/
-C
-C ------------------------------------------------------------------
-C
-C--- Inserted by HG
- NAMEL=0
- NWFORL=0
- NLFORM=10
- IF(IFIRST.EQ.0) THEN
- IFIRST=1
- CALL ZLOCAL(IZ,NLFORM)
- CALL UCTOH('****',MISS,4,4)
- CALL UCTOH(' ',IBLANK,4,4)
- CALL UCTOH1(' 1234567890ABCDEFGHIJKLMNOPQRSTUVWXYZ*+-'
- + ,NUM(1),40)
- ENDIF
-C---
- NKEY = NKEYS
- IERR = 0
- IDS = IZ(1)
- IZ(IDS+6)= 0
-C
-C DEFINE LASOPD (LAST OPERATION DONE)
-C
- JBUF = IZ(IDS - 3)
- IF (JBUF.LE.0) GO TO 10
-C
- NUNIT = IZ(JBUF) - 2
- LBUF=1
- DO 5 I=1,NUNIT
- IF(IZ(JBUF+I).NE.LUN)GO TO 5
- LBUF=I
- GO TO 7
- 5 CONTINUE
- CALL ZERROR(IZ,900,'ZEPIN ',IDS)
- GO TO 180
-C
- 7 JBUF = IZ(JBUF - LBUF) + 3
- LASOPD = IZ(JBUF - 2)
-C
- IF (LASOPD.EQ.0) GO TO 10
- IF (LASOPD.EQ.3) GO TO 10
-C
- IDCAT = IZ(JBUF - 1)
- GO TO 20
-C
-C READ IN NEXT CATALOG HEADER
-C
- 10 CALL ZEPNXT (IZ,LUN,IDCAT,IERR)
- IF (IERR.NE.0.AND.IERR.NE.6) GO TO 180
-C
-C PERFORM SYSTEMATIC GARBAGE COLLECTION
-C
- 20 IF(IZ(IDS+5).LE.0)GO TO 50
- CALL ZGARB(IZ)
- 50 CONTINUE
- IDS=IZ(1)
- IF(IZ(IDS+6).NE.0)GO TO 180
- JBUF=IZ(IDS-3)
- JBUF=IZ(JBUF-LBUF)+3
-C
- CALL EPFHDR (LUN,7,IH,IZ(JBUF),IERR)
- IF (IERR.NE.0.AND.IERR.NE.6) GO TO 180
-C
- 60 IF (IH(2).EQ.4) GO TO 170
- IF (IH(2).NE.2) GO TO 50
- IF (NKEY.LE.0) GO TO 50
-C
-C KEY HEADER
-C
- CALL EPFRD (LUN,13,NW,IH,IZ(JBUF),IERR)
- IF (IERR.NE.0) GO TO 180
- CALL ZFRIBM(IH,NW,2)
-C
- KEY = IH(1)
-C
- DO 62 I=1,NKEY
- IF(KEY.EQ.KEYS(I))GO TO 63
- 62 CONTINUE
- GO TO 50
-C
- 63 CALL ZEPLOC (IZ,KEY,NID,NMEMB,ICODE)
- IF (NID.EQ.0) GO TO 50
- IF (NMEMB.EQ.0) GO TO 50
-C
- ICODE = MOD (IH(2),10)
- MODEP = MODSEP(ICODE + 1)
- NMB = 1
-C
- 70 NST = 1
- JD(1) = NID + NMB
- JL(1) = 2
- JM(1) = 1
-C
- 80 CONTINUE
- JBUF=IZ(IDS-3)
- JBUF=IZ(JBUF-LBUF)+3
- CALL EPFHDR (LUN,60,IH,IZ(JBUF),IERR)
- IF (IERR.NE.0.AND.IERR.NE.6) GO TO 180
- IF (IH(2).NE.5) GO TO 83
-C
-C SET OF MISSING BANKS
-C
- NMSS = IH(4)
- IF (NST.NE.1) GO TO 82
-C
- NMB = NMB + NMSS
- IF (NMB.GT.NMEMB) GO TO 50
- GO TO 70
-C
- 82 JL(NST) = JL(NST) - NMSS
- IF (JL(NST).GT.0) GO TO 80
-C
- NST = NST - 1
- GO TO 80
-C
- 83 IF (IH(2).NE.3) GO TO 60
-C
-C BANK HEADER
-C
- NWH = IH(3)
- NDATA = IH(1) - IH(3)
-C--- Inserted by HG
- NWFOR=0
- IF(NWH.LE.7) GOTO 831
- NWFOR=IH(NWH)
- NWH=NWH-NWFOR-1
- 831 CONTINUE
-C---
- ISIT = NWH - 2
- IF (ISIT.GT.2) ISIT = ISIT - 1
-C
- GO TO (84,85,86,87), ISIT
-C
- 84 NLINKS = 0
- NAME=IBLANK
- NUMB=0
- GO TO 89
-C
- 85 NLINKS = IH(4)
- NAME=IBLANK
- NUMB=0
- GO TO 89
-C
- 86 NLINKS = 0
- NUMB = IH(6)
- JJ1=MOD(IH(4),256)
- JJ2=MOD(IH(4)/256,256)
- JJ3=MOD(IH(5),256)
- JJ4=MOD(IH(5)/256,256)
- LL(1)=NUM(JJ1)
- LL(2)=NUM(JJ2)
- LL(3)=NUM(JJ3)
- LL(4)=NUM(JJ4)
- CALL UBUNCH(LL,NAME,4)
- GO TO 89
-C
- 87 NLINKS = IH(4)
- NUMB = IH(7)
- JJ1=MOD(IH(5),256)
- JJ2=MOD(IH(5)/256,256)
- JJ3=MOD(IH(6),256)
- JJ4=MOD(IH(6)/256,256)
- LL(1)=NUM(JJ1)
- LL(2)=NUM(JJ2)
- LL(3)=NUM(JJ3)
- LL(4)=NUM(JJ4)
- CALL UBUNCH(LL,NAME,4)
-C
- IF (NAME.EQ.MISS) GO TO 130
-C
- 89 IF (ICODE.EQ.1) GO TO 100
- IF (ICODE.EQ.5) GO TO 100
- IF (ICODE.EQ.0) GO TO 90
-C
- NDATA = NDATA / 2
- GO TO 100
-C
- 90 NDATA = (NDATA*16-1) / NBIT + 1
-C
- 100 J = JD(NST) - JM(NST) + JL(NST) - 1
- IZ(IDS+17) = 1
- CALL ZBOOKN (IZ,IZ(J),NDATA,NLINKS,NAME,NUMB)
- IF(IZ(IDS+6).EQ.200)IZ(IDS+6)=0
- IF (IZ(IDS + 6).NE.0) GO TO 180
-C
- J = JD(NST) - JM(NST) + JL(NST) - 1
- K = IZ(J)
- CALL EPFRD (LUN,MODEP,NW,IZ(K+1),IZ(JBUF),IERR)
- IF (IERR.NE.0) GO TO 180
-C--- Inserted by HG
- IF(NWFOR.NE.0) THEN
-C--- BANK HAS A FORMAT - STORE IT AWAY
- CALL ZPTFOR(IZ,NAME,NWFOR,IH(NWH+1))
- J = JD(NST) - JM(NST) + JL(NST) - 1
- K = IZ(J)
- NWFORL=NWFOR
- CALL UCOPY(IH(NWH+1),IFORBF,NWFOR)
- ELSEIF(NWFORL.EQ.0.OR.NAME.NE.NAMEL) THEN
- NWFORL=0
- GOTO 120
- ENDIF
- IF(NDATA.GT.0.AND.ICODE.NE.0)
- + CALL ZFCONV(IFORBF,NWFORL,IZ(K+1),NDATA,0)
- GOTO 130
- 120 CONTINUE
-C---
- IF (ICODE.EQ.5.OR.ICODE.EQ.0) GO TO 130
-C
- J = JD(NST) - JM(NST) + JL(NST) - 1
- K = IZ(J)
- CALL ZFRIBM (IZ(K+1),NDATA,ICODE)
-C
- 130 NAMEL=NAME
- JL(NST) = JL(NST) - 1
- IF (JL(NST).NE.0) GO TO 140
-C
- NST = NST - 1
-C
- 140 IF (NLINKS.NE.0) GO TO 150
- IF (NST.NE.1) GO TO 80
- GO TO 160
-C
- 150 NST = NST + 1
- JD(NST) = K
- JL(NST) = NLINKS
- JM(NST) = NLINKS
- GO TO 80
-C
- 160 NMB = NMB + 1
- IF (NMB.GT.NMEMB) GO TO 50
- GO TO 70
-C
- 170 JF = JBUF - 2
- IZ(JF) = 3
-C
- 180 IERR = IERR + IZ(IDS + 6)
-C
- NLFORM=0
- RETURN
- END
diff --git a/src/packlib/zbook/code/zepkey.F b/src/packlib/zbook/code/zepkey.F
deleted file mode 100644
index d330fcb..0000000
--- a/src/packlib/zbook/code/zepkey.F
+++ /dev/null
@@ -1,150 +0,0 @@
-*
-* $Id: zepkey.F,v 1.1.1.1 1996/03/08 12:01:12 mclareni Exp $
-*
-* $Log: zepkey.F,v $
-* Revision 1.1.1.1 1996/03/08 12:01:12 mclareni
-* Zbook
-*
-*
-#include "zbook/pilot.h"
- SUBROUTINE ZEPKEY(IZ,ID,KEYI,NELEM,MODE,IERR)
-C
-C ******************************************************************
-C * *
-C * ROUTINE TO ASSIGN A KEY TO A POINTER AND DEFINE *
-C * ITS CHARACTERISTICS *
-C * *
-C * ID POINTER TO A ZBOOK BANK *
-C * KEY ASSOCIATED KEYWORD *
-C * NELEM NUMBER OF ELEMENTS OF ID *
-C * (E.G. DIMENSION ID(NELEM) *
-C * MODE DESCRIPTION OF BANK ID FOR AUTOMATIC *
-C * CONVERSION TO MACHINE INDEPENDENT FORMAT *
-C * MODE=0 BIT STRING *
-C * =1 16 BITS SIGNED INTEGER *
-C * =2 32 BITS SIGNED INTEGER *
-C * =3 FLOATING POINTS *
-C * =4 ALPHANUMERIC *
-C * =5 16 BITS UNSIGNED INTEGER *
-C * =6 32 BITS UNSIGNED INTEGER *
-C * =7 MIXTURE OF FLOATING POINTS AND INTEGERS *
-C * =11 SAME AS 1 (BANK NOT DESTROYED) *
-C * =12 2 "" "" *
-C * =13 3 "" "" *
-C * =14 4 "" "" *
-C * =15 5 "" "" *
-C * =16 6 "" "" *
-C * =17 7 "" "" *
-C * *
-C ******************************************************************
-C
- DIMENSION IZ(1),ID(1)
-C
-C ------------------------------------------------------------------
-C
- IERR = 0
- KEY = KEYI
- JZ = IZ(1)
- IZ(JZ + 6) = 0
- JZ4 = IZ(JZ - 4)
- LOC = 0
- IF (JZ4.GT.0) GO TO 10
-C
-C FIRST CALL TO ZEPKEY ---> CREATE SYSTEM BANKS
-C
- CALL ZBOOKN(IZ,IZ(JZ-4),0,4,'*EPK',1)
- IF (IZ(JZ + 6).NE.0) GO TO 99
- JZ4 = IZ(JZ - 4)
-C
- CALL ZBOOKN(IZ,IZ(JZ4-1),1,0,'*KEY',1)
- JZ4 = IZ(JZ - 4)
- CALL ZBOOKN(IZ,IZ(JZ4-2),1,0,'*NID',1)
- JZ4 = IZ(JZ - 4)
- CALL ZBOOKN(IZ,IZ(JZ4-3),1,0,'*NEL',1)
- JZ4 = IZ(JZ - 4)
- CALL ZBOOKN(IZ,IZ(JZ4-4),1,0,'*COD',1)
- JZ4 = IZ(JZ - 4)
- IF (IZ(JZ + 6).NE.0) GO TO 99
-C
- LOC = 1
-C
-C NOT THE FIRST CALL .. SEARCH IF KEY IS ALREADY IN TABLE
-C
- 10 JKEY = IZ(JZ4 - 1)
- JNID = IZ(JZ4 - 2)
- JNEL = IZ(JZ4 - 3)
- JCOD = IZ(JZ4 - 4)
- NKEY = IZ(JKEY) - 2
- IF (NKEY.EQ.0) GO TO 20
- IF (LOC.NE.0) GO TO 20
-C
- LUP = NKEY + 1
- LDOWN = 0
-C
- 11 IF (LUP-LDOWN.LE.1) GO TO 14
- LMEAN = (LUP+LDOWN) / 2
- LOC = LMEAN
- IF (KEY-IZ(JKEY+LOC)) 12,20,13
-C
- 12 LUP = LMEAN
- GO TO 11
-C
- 13 LDOWN = LMEAN
- LOC = LOC + 1
- GO TO 11
-C
- 14 LOC = -LOC
-C
- 20 IF (NELEM.LT.0) GO TO 50
- IF (LOC.GT.0) GO TO 40
- LOC = -LOC
-C
- CALL ZPUSHS(IZ,JKEY,1,0)
- JNID = IZ(JZ4 - 2)
- CALL ZPUSHS(IZ,JNID,1,0)
- JNEL = IZ(JZ4 - 3)
- CALL ZPUSHS(IZ,JNEL,1,0)
- JCOD = IZ(JZ4 - 4)
- CALL ZPUSHS(IZ,JCOD,1,0)
- IF (IZ(JZ + 6).NE.0) GO TO 99
- NCOPY = NKEY - LOC + 1
- IF (NCOPY.LE.0) GO TO 40
-C
- DO 30 I=1,NCOPY
- J=LOC+NCOPY-I
- IZ(JNID+J+1)=IZ(JNID+J)
- IZ(JNEL+J+1)=IZ(JNEL+J)
- IZ(JCOD+J+1)=IZ(JCOD+J)
- IZ(JKEY+J+1)=IZ(JKEY+J)
- 30 CONTINUE
-C
- 40 IZ(JKEY + LOC) = KEY
- IZ(JNID + LOC) = LOCF(ID(1)) + IZ(JZ + 16)
- IZ(JNEL + LOC) = NELEM
- IZ(JCOD + LOC) = MODE
- GO TO 99
-C
-C NELEM<0 SUPPRESS KEY IF IT EXISTS
-C
- 50 IF (NKEY.EQ.0) GO TO 99
- IF (LOC.LE.0) GO TO 99
-C
- NCOPY = NKEY - LOC
- IF (NCOPY.LE.0) GO TO 60
-C
- DO 55 I=1,NCOPY
- J=LOC+I
- IZ(JNID+J-1)=IZ(JNID+J)
- IZ(JNEL+J-1)=IZ(JNEL+J)
- IZ(JCOD+J-1)=IZ(JCOD+J)
- IZ(JKEY+J-1)=IZ(JKEY+J)
- 55 CONTINUE
-C
- 60 CALL ZPUSHS(IZ,IZ(JZ4-1),-1,0)
- CALL ZPUSHS(IZ,IZ(JZ4-2),-1,0)
- CALL ZPUSHS(IZ,IZ(JZ4-3),-1,0)
- CALL ZPUSHS(IZ,IZ(JZ4-4),-1,0)
-C
- 99 IERR = IZ(JZ + 6)
- RETURN
- END
diff --git a/src/packlib/zbook/code/zeploc.F b/src/packlib/zbook/code/zeploc.F
deleted file mode 100644
index 14ddb7b..0000000
--- a/src/packlib/zbook/code/zeploc.F
+++ /dev/null
@@ -1,56 +0,0 @@
-*
-* $Id: zeploc.F,v 1.1.1.1 1996/03/08 12:01:12 mclareni Exp $
-*
-* $Log: zeploc.F,v $
-* Revision 1.1.1.1 1996/03/08 12:01:12 mclareni
-* Zbook
-*
-*
-#include "zbook/pilot.h"
- SUBROUTINE ZEPLOC (IZ,KEY,LOCID,NMEMBS,ICODE)
-C
-C ******************************************************************
-C * *
-C * *
-C * RETRIEVES THE LOCATION OF THE IDENTIFIER OF A *
-C * BANK LABELLED 'KEY' *
-C * *
-C * *
-C ******************************************************************
-C
- DIMENSION IZ(1)
-C
-C ------------------------------------------------------------------
-C
- LOCID = 0
- JZ = IZ(1)
- JZ4 = IZ(JZ - 4)
- IF (JZ4.LE.0) GO TO 999
-C
- JKEY = IZ(JZ4 - 1)
- LKEY = 0
- LUP = IZ(JKEY) - 1
- LDOWN = 0
-C
- 10 IF (LUP-LDOWN.LE.1) GO TO 999
-C
- LMEAN = (LUP+LDOWN)/ 2
- LKEY = LMEAN
- IF (KEY-IZ(JKEY+LKEY)) 20,40,30
-C
- 20 LUP = LMEAN
- GO TO 10
-C
- 30 LDOWN = LMEAN
- LKEY = LKEY + 1
- GO TO 10
-C
- 40 JNID = IZ(JZ4 - 2)
- JNEL = IZ(JZ4 - 3)
- JCOD = IZ(JZ4 - 4)
- LOCID = IZ(JNID + LKEY)
- NMEMBS = IZ(JNEL + LKEY)
- ICODE = IZ(JCOD + LKEY)
-C
- 999 RETURN
- END
diff --git a/src/packlib/zbook/code/zepnxt.F b/src/packlib/zbook/code/zepnxt.F
deleted file mode 100644
index a369266..0000000
--- a/src/packlib/zbook/code/zepnxt.F
+++ /dev/null
@@ -1,62 +0,0 @@
-*
-* $Id: zepnxt.F,v 1.1.1.1 1996/03/08 12:01:12 mclareni Exp $
-*
-* $Log: zepnxt.F,v $
-* Revision 1.1.1.1 1996/03/08 12:01:12 mclareni
-* Zbook
-*
-*
-#include "zbook/pilot.h"
- SUBROUTINE ZEPNXT (IZ,LUN,IDCAT,IERR)
-C
-C ******************************************************************
-C * *
-C * *
-C * READS NEXT CATALOG AND RETURN CATALOG IDENTIFIER *
-C * IN IDCAT *
-C * *
-C * *
-C ******************************************************************
-C
- DIMENSION IZ(1), IH(4)
-C
-C ------------------------------------------------------------------
-C
- IERR = 0
- IDS = IZ(1)
- IZ(IDS+6)=0
-C
-C CHECK IF LUN IS DEFINED
-C
- JBUF = IZ(IDS - 3)
- IF (JBUF.LE.0) GO TO 10
-C
- NUNIT = IZ(JBUF) - 2
- DO 5 I=1,NUNIT
- IF(IZ(JBUF+I).NE.LUN)GO TO 5
- LBUF=I
- GO TO 20
- 5 CONTINUE
-C
-C LUN IS UNDEFINED
-C
- 10 CALL ZERROR (IZ,900,'ZEPNXT',0)
- GO TO 40
-C
-C LUN IS DEFINED
-C
- 20 JBUF = IZ(JBUF - LBUF) + 3
-C
- 30 CALL EPFHDR (LUN,4,IH,IZ(JBUF),IERR)
- IF (IERR.NE.0.AND.IERR.NE.6) GO TO 40
- IF (IH(2).NE.1) GO TO 30
-C
- IDCAT = IH(4)
- JF = JBUF - 2
- IZ(JF) = 1
- IZ(JF + 1) = IDCAT
-C
- 40 IERR = IERR + IZ(IDS + 6)
-C
- RETURN
- END
diff --git a/src/packlib/zbook/code/zepout.F b/src/packlib/zbook/code/zepout.F
deleted file mode 100644
index c285172..0000000
--- a/src/packlib/zbook/code/zepout.F
+++ /dev/null
@@ -1,356 +0,0 @@
-*
-* $Id: zepout.F,v 1.1.1.1 1996/03/08 12:01:12 mclareni Exp $
-*
-* $Log: zepout.F,v $
-* Revision 1.1.1.1 1996/03/08 12:01:12 mclareni
-* Zbook
-*
-*
-#include "zbook/pilot.h"
- SUBROUTINE ZEPOUT (IZ,LUN,KEYS,NKEYS,IDCAT,IERR)
-C
-C ******************************************************************
-C * *
-C * *
-C * WRITES NEXT LOGICAL EVENT IDENTIFIED BY THE *
-C * LIST OF NKEY KEYWORDS *
-C * A CATALOG IS WRITTEN AS THE FIRST EP RECORD *
-C * AND IT IS IDENTIFIED BY IDCAT *
-C * *
-C * *
-C ******************************************************************
-C
- DIMENSION IZ(1) , KEYS(1), IH(60) , IDUM(2)
-C--- Inserted by HG
- COMMON/ZCFORM/NLFORM,JD(60)
- DIMENSION IFORBF(50)
- EQUIVALENCE (IFORBF(1),JD(11))
-C---
- DIMENSION JL(10) , JM(10)
- DIMENSION MODSEP(8)
- LOGICAL ZIDOK
-C
- DATA MAXLEV/10/
- DATA IBLA/4H /
- DATA MODSEP/1,2,3,3,3,2,3,3/
-C
-#include "zbook/wlength.inc"
-C
-C ------------------------------------------------------------------
-C
-C--- Inserted by HG
- NAMEL=0
- NWFORL=0
-C---
- NKEY = NKEYS
- IERR = 0
- LC = 0
- IDS = IZ(1)
- IZ(IDS+6)=0
-C
-C CHECK IF LUN IS DEFINED
-C
- JBUF = IZ(IDS - 3)
- IF (JBUF.LE.0) GO TO 10
-C
- NUNIT = IZ(JBUF) - 2
- LBUF = IUCOMP (LUN,IZ(JBUF + 1),NUNIT)
- IF (LBUF.NE.0) GO TO 20
-C
-C LUN IS UNDEFINED
-C
- 10 CALL ZERROR (IZ,900,'ZEPOUT',0)
- GO TO 260
-C
-C LUN IS DEFINED
-C
- 20 JBUF = IZ(JBUF - LBUF) + 3
- IH(2) = 1
- IH(4) = IDCAT
-C
- IF (NKEY.LE.0) GO TO 30
-C
- CALL ZBOOK (IZ,LC,NKEY)
- IF (LC.EQ.0) GO TO 260
-C
- JBUF = IZ(IDS - 3)
- JBUF = IZ(JBUF - LBUF) + 3
-C
- CALL UCOPY (KEYS,IZ(LC+1),NKEY)
- CALL ZTOIBM (IZ(LC+1),NKEY,2)
-C
-C WRITE CATALOG
-C
- 30 CALL EPOUTL (LUN,3,4,IH,NKEY,IZ(LC+1),IZ(JBUF),IERR)
-C
- IF (IERR.NE.0) GO TO 240
-C
- JF = JBUF - 2
- IZ(JF) = 4
-C
- IF (NKEY.LE.0) GO TO 230
-C
-C LOOP ON KEYS
-C
- DO 220 N = 1,NKEY
- KEY = KEYS(N)
-C
-C CHECK IF ACTIVE KEY
-C
- CALL ZEPLOC (IZ,KEY,NID,NMEMBS,ICODE)
- IF (NID.EQ.0) GO TO 220
-C
- IDUM(1) = KEY
-C
- IH(2) = 2
- IDUM(2) = ICODE
- CALL ZTOIBM (IDUM,2,2)
-C
-C WRITE KEY HEADER
-C
- CALL EPOUTL (LUN,3,3,IH,2,IDUM,IZ(JBUF),IERR)
- IF (IERR.NE.0) GO TO 250
-C
- IF (NMEMBS.LE.0) GO TO 220
-C
- NMSS = 0
-C
-C LOOP ON MEMBERS
-C
- DO 210 NMB = 1,NMEMBS
- IDSAVE = IZ(NID + NMB)
-C
-C CHECK IF IT CAN BE WRITTEN
-C
- NMAX = 0
- NST = 1
- JD(1) = NID + NMB
- JL(1) = 2
- JM(1) = 1
-C
- 40 ID = JD(NST)
- NLII = JM(NST) - JL(NST) + 1
- IDD = IZ(ID - NLII)
- NLINKS = 0
-C
- IF (.NOT.ZIDOK(IZ,IDD)) GO TO 50
-C
- NDATA = IZ(IDD) - 2
- NLINKS = IZ(IDD+NDATA+3)
- IF (NDATA.LE.NMAX) GO TO 50
-C
- NMAX = NDATA
-C
- 50 JL(NST) = JL(NST) - 1
- IF (JL(NST).NE.0) GO TO 60
-C
- NST = NST - 1
-C
- 60 IF (NLINKS.NE.0) GO TO 70
- IF (NST.NE.1) GO TO 40
- GO TO 90
-C
- 70 NST = NST + 1
- IF (NST.LE.MAXLEV) GO TO 80
-C
-C TOO MANY LEVELS
-C
- CALL ZERROR (IZ,800,'ZEPOUT',IDSAVE)
- GO TO 230
-C
- 80 JD(NST) = IDD
- JL(NST) = NLINKS
- JM(NST) = JL(NST)
- GO TO 40
-C
-C LOOK FOR SPACE TO COPY THE BANKS
-C
- 90 IF (ICODE.LE.10) GO TO 110
-C
- NDATA = IZ(LC) - 2
- IF (NDATA.GE.NMAX) GO TO 110
-C
- CALL ZPUSH (IZ,LC,NMAX-NDATA)
- IF (IZ(IDS + 6).EQ.0) GO TO 100
-C
-C SPACE PROBLEM: STOP
-C
- GO TO 230
-C
- 100 JBUF = IZ(IDS - 3)
- JBUF = IZ(JBUF - LBUF) + 3
-C
-C WRITE A TREE
-C
- 110 NST = 1
- JD(1) = NID + NMB
- JL(1) = 2
- JM(1) = 1
-C
- 120 ID = JD(NST)
- NLII = JM(NST) - JL(NST) + 1
- IDD = IZ(ID - NLII)
-C
- IF (ZIDOK(IZ,IDD)) GO TO 130
-C
-C MISSING BANK
-C
- NMSS = NMSS + 1
- NLINKS = 0
- GO TO 185
-C
-C WELL DEFINED BANK
-C
- 130 NDATA = IZ(IDD) - 2
- NLINKS = IZ(IDD+NDATA+3)
- NAME = IZ(IDD+NDATA+1)
- NUMB = IZ(IDD+NDATA+2)
-C
- IF (NMSS.EQ.0) GO TO 140
-C
- IH(2) = 5
- IH(4) = NMSS
- NMSS = 0
-C
- CALL EPOUTL (LUN,1,4,IH,0,IZ,IZ(JBUF),IERR)
-C
- IF (IERR.NE.0) GO TO 250
-C
- 140 IH(2) = 3
- ISIT = 1
- IF (NLINKS.NE.0) ISIT = ISIT + 1
- IF (NAME.NE.IBLA.OR.NUMB.NE.0) ISIT = ISIT + 2
-C--- Inserted by HG
-C CHECK WHETHER NAME IN FORMAT TABLE, GET REF.
-C DO NOTHING IF SAME NAME AS PREVIOUS
- IF(NAME.NE.NAMEL) THEN
- CALL ZNAMSR(IZ,NAME,IPOS,LAST)
- NAMEL=NAME
- NWFORL=0
- ELSE
- IPOS=0
- ENDIF
-C---
-C
- GO TO (141,142,143,144), ISIT
-C
- 141 NWH = 3
- GO TO 149
-C
- 142 NWH = 4
- IH(4) = NLINKS
- GO TO 149
-C
- 143 NWH = 6
-C
- CALL ZTOIBM (NAME,1,4)
-C
- IH(4) = JBYT (NAME, 1,16)
- IH(5) = JBYT (NAME,17,16)
- IH(6) = NUMB
- GO TO 149
-C
- 144 NWH = 7
-C
- CALL ZTOIBM (NAME,1,4)
-C
- IH(4) = NLINKS
- IH(5) = JBYT (NAME, 1,16)
- IH(6) = JBYT (NAME,17,16)
- IH(7) = NUMB
-C
- 149 CONTINUE
-C--- Inserted by HG
- IF(IPOS.GT.0.AND.NWH.GE.6) THEN
-C--- BANK HAS A FORMAT - PUT IT IN LOG. REC. HEADER
- CALL ZGTFOR(IZ,IPOS,NWFOR,IH(NWH+1))
- CALL UCOPY(IH(NWH+1),IFORBF,NWFOR)
- NWFORL=NWFOR
- NWH=NWH+NWFOR+1
- IH(NWH)=NWFOR
- ENDIF
-C---
- MODE = MOD (ICODE,10)
- MODEP = MODSEP(MODE + 1)
- IDB = IDD
- IF (NDATA.EQ. 0) GO TO 180
- IF (ICODE.LE.10) GO TO 150
-C
- CALL UCOPY (IZ(IDD+1),IZ(LC+1),NDATA)
- IDD = LC
-C
- 150 IF (MODE.NE.0) GO TO 160
-C
- NDATA = (NDATA*NBIT-1) / 16 + 1
- GO TO 180
-C
- 160 CONTINUE
-C--- Inserted by HG
- IF(NWFORL.GT.0) GOTO 170
-C---
- IF (MODE.EQ.5) GO TO 180
-C
- CALL ZTOIBM (IZ(IDD+1),NDATA,MODE)
-C--- Inserted by HG
- GOTO 180
- 170 CONTINUE
- IF(NDATA.GT.0)CALL ZFCONV(IFORBF,NWFOR,IZ(IDD+1),NDATA,1)
-C---
-C
-C WRITE A BANK
-C
- 180 CALL EPOUTL (LUN,MODEP,NWH,IH,NDATA,IZ(IDD+1),IZ(JBUF),IERR)
-C
- IF (IERR.NE.0) GO TO 250
-C
- 185 JL(NST) = JL(NST) - 1
- IF (JL(NST).NE.0) GO TO 190
-C
- NST = NST - 1
- IF (NMSS.EQ.0) GO TO 190
-C
- IH(2) = 5
- IH(4) = NMSS
- NMSS = 0
-C
- CALL EPOUTL (LUN,1,4,IH,0,IZ,IZ(JBUF),IERR)
-C
- IF (IERR.NE.0) GO TO 250
-C
- 190 IF (NLINKS.NE.0) GO TO 200
- IF (NST.NE.1) GO TO 120
- GO TO 210
-C
- 200 NST = NST + 1
- JD(NST) = IDB
- JL(NST) = NLINKS
- JM(NST) = JL(NST)
- GO TO 120
-C
- 210 CONTINUE
-C
- IF (NMSS.EQ.0) GO TO 220
-C
- IH(2) = 5
- IH(4) = NMSS
-C
- CALL EPOUTL (LUN,1,4,IH,0,IZ,IZ(JBUF),IERR)
-C
- IF (IERR.NE.0) GO TO 250
-C
- 220 CONTINUE
-C
- 230 IH(2) = 4
-C
-C WRITE TRAILER RECORD
-C
- CALL EPOUTL (LUN,1,3,IH,0,IZ,IZ(JBUF),IERR)
-C
- 240 IF (LC.LE.0) GO TO 260
-C
- 250 CALL ZDELET (IZ,LC)
-C
- 260 IERR = IERR + IZ(IDS + 6)
-C
- RETURN
- END
diff --git a/src/packlib/zbook/code/zerror.F b/src/packlib/zbook/code/zerror.F
deleted file mode 100644
index b4889e0..0000000
--- a/src/packlib/zbook/code/zerror.F
+++ /dev/null
@@ -1,54 +0,0 @@
-*
-* $Id: zerror.F,v 1.1.1.1 1996/03/08 12:01:12 mclareni Exp $
-*
-* $Log: zerror.F,v $
-* Revision 1.1.1.1 1996/03/08 12:01:12 mclareni
-* Zbook
-*
-*
-#include "zbook/pilot.h"
- SUBROUTINE ZERROR(IZ,IERR,KEY,ID)
-C
-C ******************************************************************
-C * *
-C * PRINTS ERROR MESSAGES ON UNIT LOUT *
-C * *
-C ******************************************************************
-C
- DIMENSION IZ(1),KEY(1),LAB(6),ID(1)
-C
-C ------------------------------------------------------------------
-C
-C CALL USER ROUTINE
-C
- NEWERR = IERR
- JZ = IZ(1)
- IF(IZ(JZ+19).EQ.0) CALL ZUSER(IZ,NEWERR,KEY,ID)
-#if (defined(CERNLIB_SINGLE)||defined(CERNLIB_DOUBLE)||defined(CERNLIB_UNIVAC)||defined(CERNLIB_PDP10))&&(!defined(CERNLIB_VAX))&&(!defined(CERNLIB_BESM6))
- IF(IZ(JZ+19).NE.0) CALL ZJUMP(IZ(JZ+19),IZ,NEWERR,KEY,ID)
-#endif
-#if defined(CERNLIB_VAX)
- IF(IZ(JZ+19).NE.0) CALL ZJUMP(%VAL(IZ(JZ+19)),IZ,NEWERR,KEY,ID)
-#endif
-#if defined(CERNLIB_BESM6)
- IF(IZ(JZ+19).NE.0) CALL ZJUMP(IZ,NEWERR,KEY,ID,IZ(JZ+19))
-#endif
-C
- IF (NEWERR.LE.0)RETURN
-C
- IZ(JZ + 6) = NEWERR
- IZ(JZ + 10) = IZ(JZ + 10) - 1
- IF (IZ(JZ + 10).LT.0)RETURN
- LOUT = IZ(JZ + 4)
- NID = LOCF(ID(1)) + IZ(JZ + 16) + 1
- CALL UCTOH1(KEY,LAB,6)
- WRITE(LOUT,1000)NEWERR,LAB,NID
- IF (IZ(JZ + 10).EQ.0)WRITE(LOUT,2000)
-C
- 1000 FORMAT(11X,'***** ERROR NO =',I4,2X,'IN CALLING ROUTINE ',
- + 6A1,5X,'NID =',I6,/)
- 2000 FORMAT(/11X,'***** MAXIMUM NUMBER OF PRINTED MESSAGES REACHED IN'
- +,' ZBOOK'/)
-C
- RETURN
- END
diff --git a/src/packlib/zbook/code/zfconv.F b/src/packlib/zbook/code/zfconv.F
deleted file mode 100644
index fda047c..0000000
--- a/src/packlib/zbook/code/zfconv.F
+++ /dev/null
@@ -1,100 +0,0 @@
-*
-* $Id: zfconv.F,v 1.1.1.1 1996/03/08 12:01:12 mclareni Exp $
-*
-* $Log: zfconv.F,v $
-* Revision 1.1.1.1 1996/03/08 12:01:12 mclareni
-* Zbook
-*
-*
-#include "zbook/pilot.h"
- SUBROUTINE ZFCONV(IW,NW,IARR,NARR,ISENSE)
-*
-* CONVERTS CONTENTS OF ARRAY IARR TO FLOATING OR BACK TO INTEGER
-* ACCORDING TO A SPECIFIED FORMAT.
-*
-* author HG 7/4/84
-*
-* INPUT
-* IW CONVERSION FORMAT (SEE ROUTINE BKBOOK)
-* NW LENGTH OF FORMAT
-* NARR LENGTH OF IARR
-* ISENSE FLAG FOR CONVERSION DIRECTION: +1 INTERNAL TO EXTERNAL,
-* ELSE EXTERNAL TO INTERNAL.
-* INPUT/OUTPUT
-* IARR ARRAY WITH CONVERTED NUMBERS
-*
- DIMENSION IARR(*),IW(*)
-#if defined(CERNLIB_VAX)
-*--- FOR TEXT SWAPS
- INTEGER *2 INST2(2),INST2T
- EQUIVALENCE (INST4,INST2(1))
-#endif
- IPNT=0
- IFNT=0
- 10 IFNT=IFNT+1
- IF (IFNT.GT.NW) GOTO 70
- IF(IW(IFNT).LT.10000) THEN
-*--- REPETITION COUNT
- IF (IFNT.EQ.NW) GOTO 70
- IREP=IW(IFNT)
- IF (IREP.EQ.0) IREP=10000000
- IL1=IFNT+1
- DO 20 I=IL1,NW
- IF (IW(I).EQ.50000) GOTO 30
- 20 CONTINUE
- I=NW+1
- 30 CONTINUE
- IL2=I-1
- IFNT=I
- ELSE
- IREP=1
- IL1=IFNT
- IL2=IFNT
- ENDIF
- 40 CONTINUE
- DO 60 I=IL1,IL2
- ICODE=IW(I)/10000
- IF (IL1.EQ.IL2.AND.IREP.GT.1000000) THEN
-*--- INFINITE COUNT ONLY ONE FORMAT
- ICNT=NARR-IPNT
- ELSE
- ICNT=MIN(NARR-IPNT,IW(I)-10000*ICODE)
- ENDIF
- IF (ICODE.GE.2.AND.ICODE.LE.3) THEN
- IF (ISENSE.EQ.1) THEN
- CALL CTOIBM(IARR(IPNT+1),ICNT,ICODE)
- ELSE
- CALL CFRIBM(IARR(IPNT+1),ICNT,ICODE)
- ENDIF
- ELSEIF (ICODE.EQ.4) THEN
- IF (ISENSE.EQ.1) THEN
- CALL ZTOIBM(IARR(IPNT+1),ICNT,ICODE)
- ELSE
- CALL ZFRIBM(IARR(IPNT+1),ICNT,ICODE)
- ENDIF
-#if defined(CERNLIB_VAX)
-*--- SWAP 16 BIT WORDS FOR TEXT
- DO 50 J=1,ICNT
- INST4=IARR(IPNT+J)
- INST2T=INST2(1)
- INST2(1)=INST2(2)
- INST2(2)=INST2T
- 50 IARR(IPNT+J)=INST4
-#endif
- ENDIF
- IPNT=IPNT+ICNT
- IF (IPNT.EQ.NARR) GOTO 999
- 60 CONTINUE
- IREP=IREP-1
- IF (IREP.EQ.0) GOTO 10
- GOTO 40
- 70 CONTINUE
- IF(IPNT.LT.NARR) THEN
-*--- CONVERT REST AS FLOATING
- IF (ISENSE.EQ.1) THEN
- CALL CTOIBM(IARR(IPNT+1),NARR-IPNT,3)
- ELSE
- CALL CFRIBM(IARR(IPNT+1),NARR-IPNT,3)
- ENDIF
- ENDIF
- 999 END
diff --git a/src/packlib/zbook/code/zfetch.F b/src/packlib/zbook/code/zfetch.F
deleted file mode 100644
index 0e440c1..0000000
--- a/src/packlib/zbook/code/zfetch.F
+++ /dev/null
@@ -1,82 +0,0 @@
-*
-* $Id: zfetch.F,v 1.1.1.1 1996/03/08 12:01:12 mclareni Exp $
-*
-* $Log: zfetch.F,v $
-* Revision 1.1.1.1 1996/03/08 12:01:12 mclareni
-* Zbook
-*
-*
-#include "zbook/pilot.h"
- SUBROUTINE ZFETCH(IZ,ID,LUNIT,KEY)
-C
-C ******************************************************************
-C * *
-C * FETCHS BANK ID STORED ON LOGICAL UNIT LUNIT *
-C * WITH PASSWORD=KEY AND CREATES A BANK *
-C * *
-C ******************************************************************
-C
- DIMENSION IZ(1),ID(1)
-#if defined(CERNLIB_BESM6)
- DIMENSION LABNW(2)
- EQUIVALENCE(LABNW(1),LAB),(LABNW(2),NW)
-#endif
- LOGICAL ZIDOK
-C
-C ------------------------------------------------------------------
-C
- N1 = 0
- JZ = IZ(1)
- IZ(JZ + 6) = 0
-C
-#if !defined(CERNLIB_BESM6)
- 10 READ(LUNIT)LAB,NW
-#endif
-#if defined(CERNLIB_BESM6)
- 10 CALL SREAD(LUNIT,LABNW(1),LABNW(2),0)
-#endif
- IF (NW.NE.0) GO TO 15
-C
- IF (N1.EQ.1) GO TO 99
- N1 = 1
-#if !defined(CERNLIB_BESM6)
- REWIND LUNIT
-#endif
-#if defined(CERNLIB_BESM6)
- CALL REWIND(LUNIT)
-#endif
- GO TO 10
-C
- 15 IF (LAB.EQ.KEY) GO TO 20
-#if !defined(CERNLIB_BESM6)
- READ(LUNIT) W
-#endif
-#if defined(CERNLIB_BESM6)
- CALL SREAD(LUNIT,W,W,0)
-#endif
- GO TO 10
-C
- 20 N = JBYT(NW,1,18)
- NL = JBYT(NW,19,14) - 1
- ND = N
- IF (NL.GE.0)ND = N - 2
- IF (NL.LT.0)NL = 0
- IF(.NOT.ZIDOK(IZ,ID)) CALL ZBOOKN(IZ,ID,ND,NL,' ',0)
- IF (ID(1).LE.0)RETURN
- IDATA=ID(1)
- NOLD=IZ(IDATA)
- N1 = ND - NOLD + 2
- IF (N1.EQ.0) GO TO 25
- CALL ZPUSHS(IZ,ID,N1,0)
- IF (IZ(JZ + 6).NE.0) GO TO 99
- IDATA=ID(1)
- IF(IZ(IDATA).EQ.NOLD)RETURN
-#if !defined(CERNLIB_BESM6)
- 25 READ(LUNIT)(IZ(IDATA+J),J=1,N)
-#endif
-#if defined(CERNLIB_BESM6)
- 25 CALL SREAD(LUNIT,IZ(IDATA+1),N,1)
-#endif
-C
- 99 RETURN
- END
diff --git a/src/packlib/zbook/code/zfribm.F b/src/packlib/zbook/code/zfribm.F
deleted file mode 100644
index a78947a..0000000
--- a/src/packlib/zbook/code/zfribm.F
+++ /dev/null
@@ -1,102 +0,0 @@
-*
-* $Id: zfribm.F,v 1.1.1.1 1996/03/08 12:01:12 mclareni Exp $
-*
-* $Log: zfribm.F,v $
-* Revision 1.1.1.1 1996/03/08 12:01:12 mclareni
-* Zbook
-*
-*
-#include "zbook/pilot.h"
- SUBROUTINE ZFRIBM(IA,N,MODE)
-C
-C ******************************************************************
-C * *
-C * CONVERTS N WORDS OF ARRAY A FROM MACHINE *
-C * INDEPENDENT FORMAT *
-C * *
-C * MODE=0 BIT STRING *
-C * MODE=1 SIGNED INTEGER 16 BITS *
-C * MODE=2 SIGNED INTEGER 32 BITS *
-C * MODE=3 FLOATING POINTS IBM FORMAT *
-C * MODE=4 ALPHANUMERIC TO INTEGER *
-C * MODE=5 UNSIGNED INTEGER 16 BITS *
-C * MODE=6 UNSIGNED 32 BITS INTEGER *
-C * MODE=7 MIXTURE OF FLOATING AND INTEGERS *
-C * *
-C ******************************************************************
-C
- DIMENSION NUM(40),LL(4),IA(1)
-#if defined(CERNLIB_VAX)
- INTEGER*2 JTEST(2),JTEMP
- EQUIVALENCE (ITEST,JTEST)
-#endif
-C
- DATA NCHARS/40/
- DATA IFIRST/0/
-C
-C ------------------------------------------------------------------
-C
- IF (N.LE.0) GO TO 99
- IF (MODE.EQ.4) GO TO 10
- IF (MODE.EQ.7) GO TO 40
-C
- CALL CFRIBM(IA,N,MODE)
- GO TO 99
-C
- 10 IF(IFIRST.EQ.0)THEN
- CALL UCTOH1(' 1234567890ABCDEFGHIJKLMNOPQRSTUVWXYZ*+-'
- + ,NUM(1),NCHARS)
-C
- IFIRST = 1
- ENDIF
-C
- DO 30 I = 1,N
- IJ = IA(I)
-C
- DO 20 K = 1,4
- L = 8 * K - 7
- JJ = JBYT(IJ,L,8)
- IF (JJ.LE.0 .OR. JJ.GT.NCHARS) JJ = 1
- LL(K) = NUM(JJ)
- 20 CONTINUE
-C
- CALL UBUNCH(LL,IA(I),4)
- 30 CONTINUE
- GO TO 99
-C
- 40 NOLD = 0
-C
- DO 70 I = 1,N
-#if !defined(CERNLIB_VAX)
- IF (IABS(IA(I)).GE.2**23) GO TO 60
-#endif
-#if defined(CERNLIB_VAX)
- ITEST=IA(I)
- JTEMP=JTEST(1)
- JTEST(1)=JTEST(2)
- JTEST(2)=JTEMP
- IF(IABS(ITEST).GE.2**23) GO TO 60
-#endif
-C
- IF (NOLD.EQ.0) GO TO 50
- CALL CFRIBM(IA(LAST),NOLD,3)
- NOLD = 0
-C
-#if !defined(CERNLIB_VAX)
- 50 K = IA(I)
-#endif
-#if defined(CERNLIB_VAX)
- 50 K = ITEST
-#endif
- IF (K.GT.2**22)K = - (K - 2**22)
- IA(I) = K
- GO TO 70
-C
- 60 IF (NOLD.EQ.0)LAST = I
- NOLD = NOLD + 1
- 70 CONTINUE
-C
- IF(NOLD.NE.0) CALL CFRIBM(IA(LAST),NOLD,3)
-C
- 99 RETURN
- END
diff --git a/src/packlib/zbook/code/zgarb.F b/src/packlib/zbook/code/zgarb.F
deleted file mode 100644
index dbd70b7..0000000
--- a/src/packlib/zbook/code/zgarb.F
+++ /dev/null
@@ -1,67 +0,0 @@
-*
-* $Id: zgarb.F,v 1.1.1.1 1996/03/08 12:01:12 mclareni Exp $
-*
-* $Log: zgarb.F,v $
-* Revision 1.1.1.1 1996/03/08 12:01:12 mclareni
-* Zbook
-*
-*
-#include "zbook/pilot.h"
- SUBROUTINE ZGARB(IZ)
-C
-C ******************************************************************
-C * *
-C * PERFORMS A GARBAGE COLLECTION *
-C * ALL DROPPED BANKS ARE DELETED FROM MEMORY *
-C * *
-C ******************************************************************
-C
- DIMENSION IZ(1)
-C
-C ------------------------------------------------------------------
-C
- JZ = IZ(1)
- IF (IZ(JZ + 5).LE.0) GO TO 99
- IFOLD = JZ + IZ(JZ) + 3
- IFIRST = IFOLD
-C
- 10 NLONG = IZ(IFIRST)
- IF (NLONG.EQ.0) GO TO 90
- IF (NLONG.GT.0) GO TO 20
-C
-C DROPPED BANKS
-C
- IFIRST = IFIRST - NLONG
- GO TO 10
-C
-C LIFE BANKS
-C
- 20 IF (IFIRST.NE.IFOLD) GO TO 30
- IFIRST = IFIRST + NLONG
- IFOLD = IFIRST
- GO TO 10
-C
- 30 ILAST = IFIRST + NLONG - 1
- IF (ILAST.GT.IZ(JZ + 15)) GO TO 90
- IF (IZ(ILAST + 1).LE.0) GO TO 40
- NLONG = NLONG + IZ(ILAST + 1)
- GO TO 30
-C
- 40 NPUSH = IFOLD - IFIRST
- IF (IZ(JZ + 18).GT.IFIRST.AND.IZ(JZ + 18).LT.ILAST)
- + IZ(JZ+18)=IZ(JZ+18)+NPUSH
- NID = IZ(ILAST)
- CALL ZSHIFT(IZ,IFIRST,ILAST,NPUSH,'ZGARB ')
- IF (IZ(JZ + 6).NE.0) GO TO 99
- IFOLD = IFOLD + NLONG
- IFIRST = ILAST + 1
- GO TO 10
-C
- 90 IZ(JZ + 15) = IFOLD
- IZ(IFOLD) = 0
- IZ(JZ + 1) = IZ(JZ + 14) - IZ(JZ + 15)
- IZ(JZ + 5) = 0
- IZ(JZ + 9) = IZ(JZ + 9) + 1
-C
- 99 RETURN
- END
diff --git a/src/packlib/zbook/code/zgform.F b/src/packlib/zbook/code/zgform.F
deleted file mode 100644
index cb44a4c..0000000
--- a/src/packlib/zbook/code/zgform.F
+++ /dev/null
@@ -1,80 +0,0 @@
-*
-* $Id: zgform.F,v 1.1.1.1 1996/03/08 12:01:12 mclareni Exp $
-*
-* $Log: zgform.F,v $
-* Revision 1.1.1.1 1996/03/08 12:01:12 mclareni
-* Zbook
-*
-*
-#include "zbook/pilot.h"
- SUBROUTINE ZGFORM(IZ,SNAME,SFORM)
-*
-*--- RETURNS A BANK FORMAT AS CHARACTER STRING
-*
-* author HG 4/12/84
-*
-*--- INPUT
-* IZ STRUCTURE
-* SNAME BANK NAME, TYPE CHARACTER
-*--- OUTPUT
-* SFORM FORMAT AS STRING, OR ALL BLANK IF NONE
-*
-* For description of formats, see routine ZECFOR.
-*
- DIMENSION IZ(*),IW(50)
- CHARACTER SNAME*(*), SFORM*(*), SLOC*200, STEMP*1, STYP(4)*1
- DATA STYP/'X','I','F','A'/
- SFORM=' '
- CALL UCTOH(SNAME,NAME,4,4)
- CALL ZNAMSR(IZ,NAME,IST,LAST)
- IF(IST.GT.0) THEN
-*--- name is in table - get format in IW
- CALL ZGTFOR(IZ,IST,NW,IW)
- NCH=0
- DO 10 I=1,NW
- NF=IW(I)/10000
- N=IW(I)-10000*NF
- IF (NF.EQ.0) THEN
-*--- repetition factor, or start of endless loop
- IF (NCH.GT.0) THEN
-*--- add comma to previous items
- NCH=NCH+1
- SLOC(NCH:NCH)=','
- ENDIF
- IF (N.GT.0) THEN
- WRITE (SLOC(NCH+1:),'(I4)') N
- NCH=NCH+4
- ENDIF
- NCH=NCH+1
- SLOC(NCH:NCH)='('
- ELSEIF (NF.GT.0.AND.NF.LT.5) THEN
-*--- format of type NF
- IF (NCH.GT.0) THEN
- IF (SLOC(NCH:NCH).NE.'(') THEN
-*--- add comma to previous items
- NCH=NCH+1
- SLOC(NCH:NCH)=','
- ENDIF
- ENDIF
- WRITE (SLOC(NCH+1:),'(I4)') N
- NCH=NCH+5
- SLOC(NCH:NCH)=STYP(NF)
- ELSE
-*--- 50000 = end of bracket
- NCH=NCH+1
- SLOC(NCH:NCH)=')'
- ENDIF
- 10 CONTINUE
-*--- store in SFORM without blanks
- N=0
- NMAX=LEN(SFORM)
- DO 20 J=1,NCH
- STEMP=SLOC(J:J)
- IF (STEMP.NE.' ') THEN
- IF (N.EQ.NMAX) GOTO 999
- N=N+1
- SFORM(N:N)=STEMP
- ENDIF
- 20 CONTINUE
- ENDIF
- 999 END
diff --git a/src/packlib/zbook/code/zgtfor.F b/src/packlib/zbook/code/zgtfor.F
deleted file mode 100644
index ea0f1bd..0000000
--- a/src/packlib/zbook/code/zgtfor.F
+++ /dev/null
@@ -1,35 +0,0 @@
-*
-* $Id: zgtfor.F,v 1.1.1.1 1996/03/08 12:01:12 mclareni Exp $
-*
-* $Log: zgtfor.F,v $
-* Revision 1.1.1.1 1996/03/08 12:01:12 mclareni
-* Zbook
-*
-*
-#include "zbook/pilot.h"
- SUBROUTINE ZGTFOR(IZ,IST,NW,IW)
-*
-* author HG 7/4/84
-*
-* PUTS BANK FORMAT INTO AN ARRAY
-*
-* INPUT
-* IZ STRUCTURE
-* IST NO. OF FORMAT
-* OUTPUT
-* NW NO. OF WORDS, 0 IF NO FORMAT FOUND
-* IW FORMAT IN CONVERTED (INTEGER) FORM (SEE ZECFOR)
-*
- PARAMETER (MLINK=6,MFBANK=4)
- DIMENSION IW(*),IZ(*)
- LOGICAL ZIDOK
-*
- NW=0
- JMOTH=IZ(IZ(1)-MLINK)
- IF(ZIDOK(IZ,JMOTH)) THEN
- IF (IST.GT.0.AND.IST.LE.IZ(JMOTH+1)) THEN
- NW=IZ(IZ(JMOTH-3)+IST)
- CALL UCOPY(IZ(IZ(JMOTH-4)+IZ(IZ(JMOTH-2)+IST)+1),IW,NW)
- ENDIF
- ENDIF
- END
diff --git a/src/packlib/zbook/code/zhinit.F b/src/packlib/zbook/code/zhinit.F
deleted file mode 100644
index fa8760f..0000000
--- a/src/packlib/zbook/code/zhinit.F
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: zhinit.F,v 1.1.1.1 1996/03/08 12:01:12 mclareni Exp $
-*
-* $Log: zhinit.F,v $
-* Revision 1.1.1.1 1996/03/08 12:01:12 mclareni
-* Zbook
-*
-*
-#include "zbook/pilot.h"
- SUBROUTINE ZHINIT(IZ,IW,NWORDS)
-C
-C ******************************************************************
-C * *
-C * INITIALISES A DYNAMIC AREA IN BLANK COMMON *
-C * EXTEND MEMORY USING THE HBOOK ROUTINE HISTGO *
-C * *
-C ******************************************************************
-C
- DIMENSION IZ(1),IW(1)
-C
-C ------------------------------------------------------------------
-C
- CALL HISTGO(NWORDS)
-C
- CALL ZINIT(IZ,IW,NWORDS)
- JZ = IZ(1)
- IZ(JZ + 11) = 1000000
- RETURN
- END
diff --git a/src/packlib/zbook/code/zhlim.F b/src/packlib/zbook/code/zhlim.F
deleted file mode 100644
index a926435..0000000
--- a/src/packlib/zbook/code/zhlim.F
+++ /dev/null
@@ -1,50 +0,0 @@
-*
-* $Id: zhlim.F,v 1.1.1.1 1996/03/08 12:01:12 mclareni Exp $
-*
-* $Log: zhlim.F,v $
-* Revision 1.1.1.1 1996/03/08 12:01:12 mclareni
-* Zbook
-*
-*
-#include "zbook/pilot.h"
- SUBROUTINE ZHLIM
-C.
-C.
-C. ******************************************************************
-C. * *
-C. * *
-C. * FIX THE BOUNDARY BETWEEN ZBOOK AND HBOOK AREAS *
-C. * IN // IN ORDER TO PROVIDE SUFFICIENT SPACE TO HBOOK *
-C. * FOR FILLING AND PRINTING *
-C. * *
-C. * *
-C. ******************************************************************
-C.
- COMMON//IZ(1)
-C
- COMMON/HFLAG /ID ,IDBADD,LID ,IDLAST,IDHOLD,NBIT ,NBITCH,
- + NCHAR ,NX0 ,NX1 ,NX2 ,INTER ,INDEX ,LAST ,LIMIT ,
- + LFIEL ,NEWHIS,NRLENG,NWLIB ,NWFLAG,NBFLAG,NWSTAT,NRHIST,
- + IDISC ,LFHIST,LLHIST,NWHIST,IERR ,NV ,NRDIS ,IA2
-C
-C.
-C.
-C. ------------------------------------------------------------------
-C.
-C.
-C NHBOOK IS THE SPACE NECESSARY FOR HBOOK
-C NX0 IS THE START ADRESS OF HBOOK IN //
-C NEWHIS HIGHEST CURRENT HBOOK LOCATION IN //
-C
-C 1000 WORDS ARE KEPT AS RESERVE FOR FILLING+PRINTING
-C
- NHBOOK=NEWHIS-NX0+1000
-C
-C NOW SET THE MAXIMUM SPACE FOR ZBOOK
-C (SEE ZHINIT DOCUMENTATION)
-C
- JZ=IZ(1)
- IZ(JZ+11)=LIMIT-NHBOOK
-C
- RETURN
- END
diff --git a/src/packlib/zbook/code/zidok.F b/src/packlib/zbook/code/zidok.F
deleted file mode 100644
index 376e865..0000000
--- a/src/packlib/zbook/code/zidok.F
+++ /dev/null
@@ -1,42 +0,0 @@
-*
-* $Id: zidok.F,v 1.1.1.1 1996/03/08 12:01:12 mclareni Exp $
-*
-* $Log: zidok.F,v $
-* Revision 1.1.1.1 1996/03/08 12:01:12 mclareni
-* Zbook
-*
-*
-#include "zbook/pilot.h"
- LOGICAL FUNCTION ZIDOK(IZ,ID)
-C
-C ******************************************************************
-C * *
-C * *
-C * CHECKS IF 'ID' IS A VALID POINTER *
-C * *
-C * *
-C ******************************************************************
-C
- DIMENSION IZ(1)
-C
-C ------------------------------------------------------------------
-C
- ZIDOK = .FALSE.
-C
- IDS = IZ(1)
- IF (ID.LT.1) GO TO 99
- IF (ID.GT.IZ(IDS + 15)) GO TO 99
-C
- ILAST = ID + IZ(ID) + 2
- IF (ILAST.LT.1) GO TO 99
- IF (ILAST.GT.IZ(IDS + 15)) GO TO 99
-C
- NID = IZ(ILAST)
- IF (NID.LT.IZ(IDS + 12)) GO TO 99
- IF (NID.GT.IZ(IDS + 13)) GO TO 99
- IF (IZ(NID).NE.ID) GO TO 99
-C
- ZIDOK = .TRUE.
-C
- 99 RETURN
- END
diff --git a/src/packlib/zbook/code/zinit.F b/src/packlib/zbook/code/zinit.F
deleted file mode 100644
index 64a1035..0000000
--- a/src/packlib/zbook/code/zinit.F
+++ /dev/null
@@ -1,101 +0,0 @@
-*
-* $Id: zinit.F,v 1.1.1.1 1996/03/08 12:01:12 mclareni Exp $
-*
-* $Log: zinit.F,v $
-* Revision 1.1.1.1 1996/03/08 12:01:12 mclareni
-* Zbook
-*
-*
-#include "zbook/pilot.h"
- SUBROUTINE ZINIT(IZ,IW,NWORDS)
-C
-C ******************************************************************
-C * *
-C * INITIALISATION OF THE DATA STRUCTURE IZ *
-C * *
-C * IZ(1) JZ =ZBOOK DIRECTORY *
-C * IZ(JZ- 6) JDESC BANK DESCRIPTOR *
-C * IZ(JZ- 5) JBUF BUFFER FOR DIRECT ACCESS *
-C * IZ(JZ- 4) RESERVED FOR INTERNAL ZBOOK MANAGEMENT *
-C * IZ(JZ- 3) RESERVED FOR INTERNAL ZBOOK MANAGEMENT *
-C * IZ(JZ- 2) JDIR =DISK DIRECTORY FOR LUNS *
-C * IZ(JZ- 1) JLOC =BANK FOR LOCAL POINTERS *
-C * *
-C * IZ(JZ+ 1) NFREE =FREE SPACE WITHOUT G.C *
-C * IZ(JZ+ 2) NWORK =LENGTH OF WORKING SPACE *
-C * IZ(JZ+ 3) NBANK =NUMBER OF IDS FOLLOWING IZ(1) *
-C * IZ(JZ+ 4) LOUT =LOGICAL UNIT FOR OUTPUT *
-C * IZ(JZ+ 5) NUMBER OF WORDS IN DROPPED BANKS *
-C * IZ(JZ+ 6) CURRENT ERROR NUMBER *
-C * IZ(JZ+ 7) NUMBER OF PUSHED BANKS *
-C * IZ(JZ+ 8) NUMBER OF CREATED BANKS *
-C * IZ(JZ+ 9) NUMBER OF GARBAGE COLLECTIONS *
-C * IZ(JZ+10) MAX NUMBER OF ERROR MESSAGES PRINTED *
-C * IZ(JZ+11) UPPER LIMIT FOR ZHINIT (HBOOK) *
-C * IZ(JZ+12) LOWER ADDRESS RELATIVE TO IZ(1) *
-C * IZ(JZ+13) HIGHEST "" *
-C * IZ(JZ+14) CURRENT LENGTH OF THE STRUCTURE(NWORDS) *
-C * IZ(JZ+15) IZLAST =POINTER FOR NEXT CREATED BANK *
-C * IZ(JZ+16) -LOCF(IZ(1)) *
-C * IZ(JZ+17) INTERNAL ZBOOK FLAG *
-C * IZ(JZ+18) INTERNAL ZBOOK FLAG *
-C * IZ(JZ+19) ADDRESS OF RECOVERY ROUTINE *
-C * *
-C ******************************************************************
-C
- COMMON/ZCFORM/NLFORM,JD(60)
- DIMENSION IZ(30),IW(1)
-#if (defined(CERNLIB_SINGLE)||defined(CERNLIB_DOUBLE)||defined(CERNLIB_UNIVAC))&&(!defined(CERNLIB_APOLLO))&&(!defined(CERNLIB_CDC))
- DATA LOUT/6/
-#endif
-#if defined(CERNLIB_CDC)
- DATA LOUT/L"OUTPUT"/
-#endif
-#if defined(CERNLIB_APOLLO)
- DATA LOUT/7/
-#endif
-#if defined(CERNLIB_BESM6)
- DATA LOUT/51/
-#endif
-#if defined(CERNLIB_PDP10)
- DATA LOUT/3/
-#endif
- DATA NDIR/31/
-C
-C ------------------------------------------------------------------
-C
- CALL UMLOG('ZBOOK',' ')
-C
- LOC0 = LOCF(IZ(1))
- NBANK = LOCF(IW(1)) - LOC0 - 1
-#if !defined(CERNLIB_BESM6)
- CALL VZERO(IZ(2),NBANK+NDIR+1)
-#endif
-#if defined(CERNLIB_BESM6)
- CALL UZERO(IZ,2,NBANK+NDIR+2)
-#endif
- IZ(NBANK + 2) = NDIR
- IZ(1) = NBANK + 9
- JZ = IZ(1)
- IZ(JZ) = 21
- IZ(JZ + 1) = NWORDS - NBANK - NDIR - 2
- IZ(JZ + 3) = NBANK
- IZ(JZ + 4) = LOUT
- IZ(JZ + 10) = 100
- IZ(JZ + 11) = NWORDS
- IZ(JZ + 13) = NBANK
- IF (NBANK.LE.0)IZ(JZ + 13) = 1
- IZ(JZ + 14) = NWORDS
- IZ(JZ + 15) = NBANK + NDIR + 2
- IZ(JZ + 16) = - LOC0
- CALL UCTOH('*SYS',IZ(JZ + 20),4,4)
- IZ(JZ + 21) = 1
- IZ(JZ + 22) = 6
- IZ(JZ + 23) = 1
-C--- ADDED BY HG
-C DUMMY CALL TO CREATE SYSTEM BANKS FOR FORMATS
- CALL ZBFORM(IZ,'*ZBF','X')
-C---- Initialize HBOOK output unit
- CALL HOUTPU(LOUT)
- RETURN
- END
diff --git a/src/packlib/zbook/code/ziodo.F b/src/packlib/zbook/code/ziodo.F
deleted file mode 100644
index 79e533b..0000000
--- a/src/packlib/zbook/code/ziodo.F
+++ /dev/null
@@ -1,132 +0,0 @@
-*
-* $Id: ziodo.F,v 1.1.1.1 1996/03/08 12:01:12 mclareni Exp $
-*
-* $Log: ziodo.F,v $
-* Revision 1.1.1.1 1996/03/08 12:01:12 mclareni
-* Zbook
-*
-*
-#include "zbook/pilot.h"
- SUBROUTINE ZIODO(LUN,NREC,LREC,IBUF,N,IRW)
-C
-C ******************************************************************
-C * *
-C * I/O ROUTINES FOR DISK/LCM *
-C * *
-C * NREC FIRST RECORD NUMBER *
-C * LREC LENGTH OF RECORD *
-C * IBUF ADDRESS OF BUFFER TO BE READ/WRITTEN ON NREC *
-C * N LENGTH OF IBUF *
-C * IRW =1 TO READ *
-C * IRW =2 TO WRITE *
-C * LUN >0 DISK ACCESS I/O *
-C * LUN =0 LCM USER (CDC) / FASTIO (UNIVAC) *
-C * LUN <0 LCM FOR HBOOK *
-C * *
-C ******************************************************************
-C
-#if defined(CERNLIB_LCM)
- LEVEL 3,/ZLCM/
- COMMON/ZLCM/ZL(1)
- COMMON/HBLCM1/LX1,LX2,LX3
-#endif
- DIMENSION IBUF(1)
-#if defined(CERNLIB_UNIVAC)
- DATA FILEZB/'Z$B 'F/
-#endif
-C
-C ------------------------------------------------------------------
-C
- IF (N.LE.0) GO TO 99
-#if defined(CERNLIB_LCM)
- IF (LUN.GT.0) GO TO 20
- JFIRST = NREC * LREC + 1
- IF (LUN.LT.0)JFIRST = JFIRST + LX1
- IF (IRW.NE.1) GO TO 10
-C
-C READ FROM LCM
-C
- CALL MOVLEV(ZL(JFIRST),IBUF,N)
- GO TO 99
-C
-C WRITE ON LCM
-C
- 10 CALL MOVLEV(IBUF,ZL(JFIRST),N)
- GO TO 99
- 20 CONTINUE
-#endif
-#if defined(CERNLIB_UNIVAC)
- IF (LUN.GT.0) GO TO 20
-C
-C USE WORD-ADDRESSABLE FASTIO WHEN LUN=0
-C
- IADD = NREC * LREC
- IF(IRW.EQ.1) CALL FIOR(FILEZB,IBUF,N,IADD,ISTAT)
- IF(IRW.NE.1) CALL FIOW(FILEZB,IBUF,N,IADD,ISTAT)
- IF (ISTAT.LT.0) THEN
- WRITE(6,10) IRW,NREC,LREC,IADD,ISTAT
- IF (IRW.EQ.1) STOP 'ZIODO'
- ENDIF
- GO TO 99
- 10 FORMAT(' I/O ERROR IN ZIODO FOR LUN=0 (FILE Z$B).',/,
- + ' IRW=',I2,' NREC=',I4,' LREC=',I5,' IADD=',I8,
- + ' ISTAT=',O14)
- 20 CONTINUE
-#endif
- NR = (N + LREC - 1) / LREC
-C
-C READ FROM LOGICAL UNIT LUN
-C
- IF (IRW.NE.1) GO TO 40
- DO 30 I = 1,NR
- IREC = NREC + I
- JFIRST = (I - 1) * LREC + 1
- JLAST = JFIRST + LREC - 1
- IF (JLAST.GT.N)JLAST = N
-#if (defined(CERNLIB_SINGLE)||defined(CERNLIB_DOUBLE))&&(!defined(CERNLIB_CDC))&&(!defined(CERNLIB_VAX))
- READ(UNIT=LUN,REC=IREC)(IBUF(J),J = JFIRST,JLAST)
-#endif
-#if defined(CERNLIB_CDC)
- CALL READMS(LUN,IBUF(JFIRST),JLAST-JFIRST+1,IREC)
-#endif
-#if defined(CERNLIB_NORD)
-C CALL RFILE(LUN,0,IBUF(JFIRST),IREC,JLAST-JFIRST+1)
-#endif
-#if defined(CERNLIB_VAX)||defined(CERNLIB_PR1ME)||defined(CERNLIB_UNIVAC)||defined(CERNLIB_PDP10)
- READ(LUN'IREC)(IBUF(J),J = JFIRST,JLAST)
-#endif
-#if defined(CERNLIB_BESM6)
- IWAD=(IREC-1)*NREC+1
- CALL RREAD(LUN,IBUF(JFIRST),IBUF(JLAST),IWAD)
-#endif
- 30 CONTINUE
- GO TO 99
-C
-C WRITE ONTO LOGICAL UNIT LUN
-C
- 40 CONTINUE
- DO 50 I = 1,NR
- IREC = NREC + I
- JFIRST = (I - 1) * LREC + 1
- JLAST = JFIRST + LREC - 1
- IF (JLAST.GT.N)JLAST = N
-#if (defined(CERNLIB_SINGLE)||defined(CERNLIB_DOUBLE))&&(!defined(CERNLIB_CDC))&&(!defined(CERNLIB_VAX))
- WRITE(UNIT=LUN,REC=IREC)(IBUF(J),J = JFIRST,JLAST)
-#endif
-#if defined(CERNLIB_CDC)
- CALL WRITMS(LUN,IBUF(JFIRST),JLAST-JFIRST+1,IREC)
-#endif
-#if defined(CERNLIB_NORD)
-C CALL WFILE(LUN,0,IBUF(JFIRST),IREC,JLAST-JFIRST+1)
-#endif
-#if defined(CERNLIB_VAX)||defined(CERNLIB_PR1ME)||defined(CERNLIB_UNIVAC)||defined(CERNLIB_PDP10)
- WRITE(LUN'IREC)(IBUF(J),J = JFIRST,JLAST)
-#endif
-#if defined(CERNLIB_BESM6)
- IWAD=(IREC-1)*LREC+1
- CALL RWRITE(LUN,IBUF(JFIRST),IBUF(JLAST),IWAD)
-#endif
- 50 CONTINUE
-C
- 99 RETURN
- END
diff --git a/src/packlib/zbook/code/zjump.c b/src/packlib/zbook/code/zjump.c
deleted file mode 100644
index af90f25..0000000
--- a/src/packlib/zbook/code/zjump.c
+++ /dev/null
@@ -1,25 +0,0 @@
-/*
- * $Id: zjump.c,v 1.1.1.1 1996/03/08 12:01:12 mclareni Exp $
- *
- * $Log: zjump.c,v $
- * Revision 1.1.1.1 1996/03/08 12:01:12 mclareni
- * Zbook
- *
- */
-#include "zbook/pilot_c.h"
-#if defined(CERNLIB_UNIX)
-#if defined(CERNLIB_QX_SC)
-zjump_(name,p1,p2,p3,p4)
-#endif
-#if defined(CERNLIB_QXNO_SC)
-zjump(name,p1,p2,p3,p4)
-#endif
-#if defined(CERNLIB_QXCAPT)
-ZJUMP(name,p1,p2,p3,p4)
-#endif
-char *p1, *p2, *p3, *p4;
-void (**name)();
-{
- (**name)(p1, p2, p3, p4);
-}
-#endif
diff --git a/src/packlib/zbook/code/zjumpft.F b/src/packlib/zbook/code/zjumpft.F
deleted file mode 100644
index fdcaf33..0000000
--- a/src/packlib/zbook/code/zjumpft.F
+++ /dev/null
@@ -1,15 +0,0 @@
-*
-* $Id: zjumpft.F,v 1.1.1.1 1996/03/08 12:01:12 mclareni Exp $
-*
-* $Log: zjumpft.F,v $
-* Revision 1.1.1.1 1996/03/08 12:01:12 mclareni
-* Zbook
-*
-*
-#include "zbook/pilot.h"
-#if defined(CERNLIB_IBM)||defined(CERNLIB_VAX)||defined(CERNLIB_NORD)
- SUBROUTINE ZJUMP (NAME,P1,P2,P3,P4)
- DIMENSION P1(*),P2(*),P3(*),P4(*)
- CALL NAME (P1,P2,P3,P4)
- END
-#endif
diff --git a/src/packlib/zbook/code/zleft.F b/src/packlib/zbook/code/zleft.F
deleted file mode 100644
index 6872c7b..0000000
--- a/src/packlib/zbook/code/zleft.F
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: zleft.F,v 1.1.1.1 1996/03/08 12:01:12 mclareni Exp $
-*
-* $Log: zleft.F,v $
-* Revision 1.1.1.1 1996/03/08 12:01:12 mclareni
-* Zbook
-*
-*
-#include "zbook/pilot.h"
- SUBROUTINE ZLEFT(IZ,NLEFT)
-C
-C ******************************************************************
-C * *
-C * RETURNS THE TOTAL NUMBER OF FREE LOCATIONS *
-C * *
-C ******************************************************************
-C
- DIMENSION IZ(1)
-C
-C ------------------------------------------------------------------
-C
- JZ = IZ(1)
- NLEFT = IZ(JZ + 5) + IZ(JZ + 1)
- RETURN
- END
diff --git a/src/packlib/zbook/code/zloc.F b/src/packlib/zbook/code/zloc.F
deleted file mode 100644
index af34654..0000000
--- a/src/packlib/zbook/code/zloc.F
+++ /dev/null
@@ -1,38 +0,0 @@
-*
-* $Id: zloc.F,v 1.1.1.1 1996/03/08 12:01:12 mclareni Exp $
-*
-* $Log: zloc.F,v $
-* Revision 1.1.1.1 1996/03/08 12:01:12 mclareni
-* Zbook
-*
-*
-#include "zbook/pilot.h"
- SUBROUTINE ZLOC(IZ,NAME,NR,LOC)
-C
-C ******************************************************************
-C * *
-C * RETURN ADDRESS OF BANK (NAME,NR) *
-C * *
-C ******************************************************************
-C
- DIMENSION IZ(1)
-C
-C ------------------------------------------------------------------
-C
- LOC = 0
- JZ = IZ(1)
- N = IZ(JZ)
- IFIRST = JZ - IZ(JZ + N + 1) - 1
- CALL UCTOH(NAME,NAMEC,4,4)
- 10 N = IZ(IFIRST)
- IF (N.EQ.0) GO TO 99
- IF (N.LT.0) GO TO 20
- INAME = IFIRST + N - 4
- IF (IZ(INAME).EQ.NAMEC.AND.IZ(INAME + 1).EQ.NR) GO TO 30
- IFIRST = IFIRST + N
- GO TO 10
- 20 IFIRST = IFIRST - N
- GO TO 10
- 30 LOC = IFIRST + IZ(INAME + 2) + 1
- 99 RETURN
- END
diff --git a/src/packlib/zbook/code/zlocal.F b/src/packlib/zbook/code/zlocal.F
deleted file mode 100644
index 8106518..0000000
--- a/src/packlib/zbook/code/zlocal.F
+++ /dev/null
@@ -1,47 +0,0 @@
-*
-* $Id: zlocal.F,v 1.1.1.1 1996/03/08 12:01:12 mclareni Exp $
-*
-* $Log: zlocal.F,v $
-* Revision 1.1.1.1 1996/03/08 12:01:12 mclareni
-* Zbook
-*
-*
-#include "zbook/pilot.h"
- SUBROUTINE ZLOCAL(IZ,IAD)
-C
-C ******************************************************************
-C * *
-C * STORE ADDRESS OF LOCAL USER POINTERS TO BE UPDATED *
-C * *
-C ******************************************************************
-C
- DIMENSION IZ(1),IAD(1)
-C
-C ------------------------------------------------------------------
-C
- JZ = IZ(1)
- LOCAD = LOCF(IAD(1)) + IZ(JZ + 16) + 1
- IF (IZ(JZ - 1).NE.0) GO TO 10
-C
-C CREATE BANK TO STORE FIRST ADDRESS OF LOCAL POINTERS
-C
- CALL ZBOOKN(IZ,IZ(JZ-1),1,0,'*LOC',1)
- JLOC = IZ(JZ - 1)
- IF (JLOC.EQ.0) GO TO 99
- IZ(JLOC + 1) = LOCAD
- GO TO 99
-C
-C CHECK IF ADDRESS ALREADY STORED
-C
- 10 JLOC = IZ(JZ - 1)
- NLOC = IZ(JLOC) - 2
- DO 20 I = 1,NLOC
- IF (IZ(JLOC + I).EQ.LOCAD) GO TO 99
- 20 CONTINUE
-C
- CALL ZPUSHS(IZ,JLOC,1,0)
- IF (IZ(JZ + 6).NE.0) GO TO 99
- IZ(JLOC + NLOC + 1) = LOCAD
-C
- 99 RETURN
- END
diff --git a/src/packlib/zbook/code/zlook.F b/src/packlib/zbook/code/zlook.F
deleted file mode 100644
index 8105f3d..0000000
--- a/src/packlib/zbook/code/zlook.F
+++ /dev/null
@@ -1,45 +0,0 @@
-*
-* $Id: zlook.F,v 1.1.1.1 1996/03/08 12:01:12 mclareni Exp $
-*
-* $Log: zlook.F,v $
-* Revision 1.1.1.1 1996/03/08 12:01:12 mclareni
-* Zbook
-*
-*
-#include "zbook/pilot.h"
- SUBROUTINE ZLOOK(IZ,LUN,KEY,LOC)
-C
-C ******************************************************************
-C * *
-C * RETURN ADDRESS OF BANK WITH KEYWORD KEY *
-C * IN THE DIRECTORY BANK *
-C * IF(LOC.LE.0)KEY DOES NOT EXIST *
-C * IF(LOC.GT.0)THEN *
-C * IZ(LOC)=KEY *
-C * IZ(LOC+1)=NUMBER OF THE FIRST RECORD ONTO DISK *
-C * IZ(LOC+2)=NUMBER OF WORDS IN THE BANK *
-C * *
-C ******************************************************************
-C
- DIMENSION IZ(1)
-C
-C ------------------------------------------------------------------
-C
- JZ = IZ(1)
- LOC = - 1
- JD = IZ(JZ - 2)
- IF (JD.EQ.0) GO TO 10
- NL = IZ(JD) - 2
- NLUN = 1
- 5 IF (IZ(JD + NLUN).EQ.LUN) GO TO 7
- NLUN = NLUN + 1
- IF (NLUN.LE.NL) GO TO 5
- GO TO 10
-C
- 7 CALL ZSEARC(IZ,NLUN,KEY,LOC)
- GO TO 99
-C
- 10 CALL ZERROR(IZ,900,'ZLOOK ',0)
-C
- 99 RETURN
- END
diff --git a/src/packlib/zbook/code/zmigra.F b/src/packlib/zbook/code/zmigra.F
deleted file mode 100644
index 7733826..0000000
--- a/src/packlib/zbook/code/zmigra.F
+++ /dev/null
@@ -1,60 +0,0 @@
-*
-* $Id: zmigra.F,v 1.1.1.1 1996/03/08 12:01:13 mclareni Exp $
-*
-* $Log: zmigra.F,v $
-* Revision 1.1.1.1 1996/03/08 12:01:13 mclareni
-* Zbook
-*
-*
-#include "zbook/pilot.h"
- SUBROUTINE ZMIGRA(IZ,ID,LUN)
-C
-C ******************************************************************
-C * *
-C * SAME AS ZWRITE + ZDROP *
-C * *
-C ******************************************************************
-C
- DIMENSION IZ(1),ID(1)
- LOGICAL ZIDOK
-C
-C ------------------------------------------------------------------
-C
- JZ = IZ(1)
- IZ(JZ + 6) = 0
- JD = IZ(JZ - 2)
- IF (JD.EQ.0) GO TO 900
- NL = IZ(JD) - 2
- NLUN = 1
- 5 IF (IZ(JD + NLUN).EQ.LUN) GO TO 7
- NLUN = NLUN + 1
- IF (NLUN.LE.NL) GO TO 5
- GO TO 900
- 7 JDIR = IZ(JD - NLUN)
- IF (.NOT.ZIDOK(IZ,ID)) GO TO 300
- JKEY = IZ(JDIR + 4)
- LBLG = IZ(JDIR + 5)
- KEY = 900000
- NKEY = (LBLG - JKEY) / 3
- IF (NKEY.LE.0) GO TO 9
- KEYBLG = IZ(JDIR + LBLG - 3)
- IF (KEYBLG.GE.900000) KEY = KEYBLG + 1
-C
- 9 CALL ZWRITE(IZ,ID,LUN,KEY)
- IF (IZ(JZ + 6).NE.0) RETURN
-C
- IDATA=ID(1)
- ILAST=IDATA+IZ(IDATA)+2
- NID=IZ(ILAST)
- CALL ZDROP(IZ,ID)
- IF (IZ(JZ + 6).NE.0) RETURN
-C
- ID(1) = - KEY
- IZ(NID) = - KEY
-C
- 99 RETURN
- 300 CALL ZERROR(IZ,300,'ZMIGRA',ID)
- GO TO 99
- 900 CALL ZERROR(IZ,900,'ZMIGRA',ID)
- GO TO 99
- END
diff --git a/src/packlib/zbook/code/zmove.F b/src/packlib/zbook/code/zmove.F
deleted file mode 100644
index 2e7ac00..0000000
--- a/src/packlib/zbook/code/zmove.F
+++ /dev/null
@@ -1,44 +0,0 @@
-*
-* $Id: zmove.F,v 1.1.1.1 1996/03/08 12:01:13 mclareni Exp $
-*
-* $Log: zmove.F,v $
-* Revision 1.1.1.1 1996/03/08 12:01:13 mclareni
-* Zbook
-*
-*
-#include "zbook/pilot.h"
- SUBROUTINE ZMOVE(IZ,N)
-C
-C ******************************************************************
-C * *
-C * MOVE END OF DYNAMIC AREA IZ BY N WORDS *
-C * N POSITIVE OR NEGATIVE *
-C * IF N.GT.0 POSSIBILITY OF MEMORY EXTENSION *
-C * *
-C ******************************************************************
-C
- COMMON/HFLAG/IH(31)
- DIMENSION IZ(1)
-C
-C ------------------------------------------------------------------
-C
- JZ = IZ(1)
- NW = IZ(JZ + 14)
- NEW = NW + N
- IF (NW + N.GT.IZ(JZ + 11))RETURN
-C
- IF (N)10,99,20
- 10 CALL ZGARB(IZ)
- IF (IZ(JZ + 1).GT. - N) GO TO 30
- CALL ZERROR(IZ,500,'ZMOVE ',0)
- GO TO 99
-C
- 20 CALL HISTGO(NEW)
- IF (IH(9).NE.NEW + 1)RETURN
-C
- 30 IZ(JZ + 14) = NEW
- IZ(JZ + 1) = IZ(JZ + 1) + N
- IF(N.LT.0) CALL HISTGO(NEW)
-C
- 99 RETURN
- END
diff --git a/src/packlib/zbook/code/zname.F b/src/packlib/zbook/code/zname.F
deleted file mode 100644
index 37e88bb..0000000
--- a/src/packlib/zbook/code/zname.F
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: zname.F,v 1.1.1.1 1996/03/08 12:01:13 mclareni Exp $
-*
-* $Log: zname.F,v $
-* Revision 1.1.1.1 1996/03/08 12:01:13 mclareni
-* Zbook
-*
-*
-#include "zbook/pilot.h"
- SUBROUTINE ZNAME(IZ,ID,NAME,NR)
-C
-C ******************************************************************
-C * *
-C * STORE USER BANK NAME AND NUMBER *
-C * *
-C ******************************************************************
-C
- DIMENSION IZ(1),ID(1)
- LOGICAL ZIDOK
-C
-C ------------------------------------------------------------------
-C
- CALL UCTOH(NAME,NAMEC,4,4)
- IF (ZIDOK(IZ,ID)) GO TO 10
- CALL ZERROR(IZ,300,'ZNAME ',ID)
- RETURN
-C
- 10 JZ = IZ(1)
- IDATA=ID(1)
- ND=IZ(IDATA)
- IZ(IDATA+ND-1)=NAMEC
- IZ(IDATA+ND)=NR
- RETURN
- END
diff --git a/src/packlib/zbook/code/znamsr.F b/src/packlib/zbook/code/znamsr.F
deleted file mode 100644
index 4897a37..0000000
--- a/src/packlib/zbook/code/znamsr.F
+++ /dev/null
@@ -1,51 +0,0 @@
-*
-* $Id: znamsr.F,v 1.1.1.1 1996/03/08 12:01:13 mclareni Exp $
-*
-* $Log: znamsr.F,v $
-* Revision 1.1.1.1 1996/03/08 12:01:13 mclareni
-* Zbook
-*
-*
-#include "zbook/pilot.h"
- SUBROUTINE ZNAMSR(IZ,NAME,IST,LAST)
-*--- PERFORMS BINARY SEARCH IN TABLE WITH NAMES IN
-*--- ASCENDING ORDER.
-*--- INPUT
-* NAME ELEMENT TO LOOK FOR
-*--- OUTPUT
-* IST = -1 NO BANK FOR NAMES FOUND
-* = 0 NAME NOT FOUND IN TABLE
-* OTHERWISE PLACE OF NAME IN LIST
-* LAST = 0 NAME FOUND
-* OTHERWISE NAME IN LIST BEHIND WHICH NAME BELONGS
- PARAMETER (MLINK=6,MFBANK=4)
- DIMENSION IZ(*)
- CHARACTER *4 SNAME,SLIST
- LOGICAL ZIDOK
- IST=-1
- LAST=0
- J=IZ(IZ(1)-MLINK)
- IF (.NOT.ZIDOK(IZ,J)) GOTO 999
- N=IZ(J+1)
- JN=IZ(J-1)
- IF (.NOT.ZIDOK(IZ,JN)) GOTO 999
- IST=0
- IF(N.GT.0) THEN
- KPOS=0
- CALL UHTOC(NAME,4,SNAME,4)
- 10 M=(N+1)/2
- LAST=KPOS+M
- CALL UHTOC(IZ(JN+LAST),4,SLIST,4)
- IF (SNAME.LT.SLIST) THEN
- N=M
- LAST=LAST-1
- IF (N.GT.1) GOTO 10
- ELSEIF (SNAME.GT.SLIST) THEN
- KPOS=LAST
- N=N-M
- IF (N.GT.0) GOTO 10
- ELSE
- IST=LAST
- ENDIF
- ENDIF
- 999 END
diff --git a/src/packlib/zbook/code/zopen.F b/src/packlib/zbook/code/zopen.F
deleted file mode 100644
index c2da443..0000000
--- a/src/packlib/zbook/code/zopen.F
+++ /dev/null
@@ -1,46 +0,0 @@
-*
-* $Id: zopen.F,v 1.1.1.1 1996/03/08 12:01:13 mclareni Exp $
-*
-* $Log: zopen.F,v $
-* Revision 1.1.1.1 1996/03/08 12:01:13 mclareni
-* Zbook
-*
-*
-#include "zbook/pilot.h"
- SUBROUTINE ZOPEN(IZ,LUN)
-C
-C ******************************************************************
-C * *
-C * DIRECTORY FROM MASS STORAGE FILE LUN IS READ *
-C * IN MASS STORAGE DESCRIPTION BANK *
-C * *
-C ******************************************************************
-C
- DIMENSION IZ(1),IDIR(3)
-C
-C ------------------------------------------------------------------
-C
- CALL ZIODO(LUN,0,3,IDIR,3,1)
- JZ = IZ(1)
- IZ(JZ + 6) = 0
- IF(IZ(JZ-2).EQ.0) CALL ZBOOKN(IZ,IZ(JZ-2),1,1,'*ZDI',1)
- JD = IZ(JZ - 2)
- IF (JD.EQ.0) GO TO 99
- NL = IZ(JD) - 2
- NLUN = 1
-C
- 5 IF (IZ(JD + NLUN).EQ.0.AND.IZ(JD - NLUN).EQ.0) GO TO 7
- NLUN = NLUN + 1
- IF(NLUN.GT.NL) CALL ZPUSHS(IZ,JD,1,1)
- IF (IZ(JZ + 6).NE.0) GO TO 99
- GO TO 5
- 7 CALL ZBOOKN(IZ,IZ(JD-NLUN),IDIR(3)-2,0,'*LUN',LUN)
- JD = IZ(JZ - 2)
- JDIR = IZ(JD - NLUN)
- IF (JDIR.EQ.0) GO TO 99
- CALL ZIODO(LUN,IDIR(2),IDIR(1),IZ(JDIR+1),IDIR(3),1)
- IZ(JDIR + 1) = LUN
- IZ(JDIR+10)=0
- IZ(JD + NLUN) = LUN
- 99 RETURN
- END
diff --git a/src/packlib/zbook/code/zpbank.F b/src/packlib/zbook/code/zpbank.F
deleted file mode 100644
index 241d16c..0000000
--- a/src/packlib/zbook/code/zpbank.F
+++ /dev/null
@@ -1,154 +0,0 @@
-*
-* $Id: zpbank.F,v 1.1.1.1 1996/03/08 12:01:13 mclareni Exp $
-*
-* $Log: zpbank.F,v $
-* Revision 1.1.1.1 1996/03/08 12:01:13 mclareni
-* Zbook
-*
-*
-#include "zbook/pilot.h"
- SUBROUTINE ZPBANK(IZ,JPBANK,NFROM,NTO)
-*
-* ROUTINE TO PRINT ONE ZBOOK BANK ACCORDING TO FORMAT
-*
-* author HG 7/4/84
-*
-* INPUT
-* IZ STRUCTURE
-* JPBANK BANK POINTER
-* NFROM FIRST WORD IN BANK TO PRINT
-* NTO LAST WORD IN BANK TO PRINT
-*
- PARAMETER (MLINK=6,MFBANK=4,MPMOD=10,MINL=3)
- EQUIVALENCE (IOUT,OUT)
- DIMENSION IZ(*)
- CHARACTER SLINE*120,SNAME*4,SBUFF*120
- DIMENSION IW(53)
-*
- LOGICAL ZIDOK
-*
- IF(ZIDOK(IZ,JPBANK)) GO TO 10
- CALL ZERROR(IZ,300,'ZPBANK',JPBANK)
- RETURN
-*
- 10 LOUT=IZ(IZ(1)+4)
- LENGTH=IZ(JPBANK)-2
- NUP=MIN(LENGTH,NTO)
- NAME=IZ(JPBANK+LENGTH+1)
- CALL ZNAMSR(IZ,NAME,IST,LAST)
- IF(IST.LE.0) THEN
-*--- NO FORMAT FOR THIS BANK STORED - USE FLOATING
- NW=2
- IW(1)=0
- IW(2)=31000
- ELSE
- CALL ZGTFOR(IZ,IST,NW,IW)
- DO 20 I=1,NW
- IF (IW(I).EQ.0) GOTO 30
- 20 CONTINUE
-*--- NO INFINITE REPETITION GIVEN - PRINT REST IN FLOATING
- IW(NW+1)=0
- IW(NW+2)=31000
- NW=NW+2
- ENDIF
- 30 CONTINUE
- SLINE=' '
- ICPT=0
- ICNT=0
- IPNT=0
- IH=0
- IFNT=0
- JCNT=0
- 40 IFNT=IFNT+1
- IF (IFNT.GT.NW) GOTO 110
- IF(IW(IFNT).LT.10000) THEN
-*--- REPETITION COUNT
- IF (IFNT.EQ.NW) GOTO 110
- IREP=IW(IFNT)
- IF (IREP.EQ.0) IREP=10000000
- IL1=IFNT+1
- DO 50 I=IL1,NW
- IF (IW(I).EQ.50000) GOTO 60
- 50 CONTINUE
- I=NW+1
- 60 CONTINUE
- IL2=I-1
- IFNT=I
- ELSE
- IREP=1
- IL1=IFNT
- IL2=IFNT
- ENDIF
- 70 CONTINUE
- DO 100 I=IL1,IL2
- ICODE=IW(I)/10000
- DO 90 J=1,IW(I)-10000*ICODE
- IF (IPNT.GE.NUP) GOTO 110
- IPNT=IPNT+1
- IF (IPNT.LT.NFROM) GOTO 90
- IF(ICPT.EQ.0) LEFT=IPNT
- IOUT=IZ(JPBANK+IPNT)
- IF (ICODE.EQ.4) THEN
- CALL UHTOC(IOUT,4,SNAME,4)
- SLINE(ICPT+5:ICPT+8)=SNAME
- ELSEIF (ICODE.EQ.1) THEN
- WRITE (SLINE(ICPT+1:),'(Z11)') IOUT
- ELSEIF (ICODE.EQ.2) THEN
- WRITE (SLINE(ICPT+1:),'(I12)') IOUT
- ELSEIF (ICODE.EQ.3) THEN
- WRITE (SLINE(ICPT+1:),'(G12.4)') OUT
- ENDIF
- ICNT=ICNT+1
- IF (ICNT.EQ.MPMOD) THEN
- IF(JCNT.EQ.0) THEN
-*--- first line
- LSTART=LEFT
- SBUFF=SLINE
- JCNT=1
- ELSEIF(SBUFF.EQ.SLINE) THEN
- JCNT=JCNT+1
- LEFTP=LEFT
- ELSE
- IF(JCNT.GE.MINL) THEN
- WRITE(LOUT,10000) LSTART
- WRITE(LOUT,10010) LEFTP,SBUFF
- ELSE
- LF=LSTART-MPMOD
- DO 80 JJ=1,JCNT
- LF=LF+MPMOD
- WRITE(LOUT,10010) LF,SBUFF
- 80 CONTINUE
- ENDIF
- SBUFF=SLINE
- JCNT=1
- LSTART=LEFT
- ENDIF
- SLINE=' '
- ICPT=0
- ICNT=0
- ELSE
- ICPT=ICPT+12
- ENDIF
- 90 CONTINUE
- 100 CONTINUE
- IREP=IREP-1
- IF (IREP.EQ.0) GOTO 40
- GOTO 70
- 110 CONTINUE
- IF(JCNT.GE.MINL) THEN
- WRITE(LOUT,10000) LSTART
- WRITE(LOUT,10010) LEFTP,SBUFF
- ELSEIF(JCNT.GT.0) THEN
- LF=LSTART-MPMOD
- DO 120 JJ=1,JCNT
- LF=LF+MPMOD
- WRITE(LOUT,10010) LF,SBUFF
- 120 CONTINUE
- ENDIF
- IF(ICNT.NE.0) THEN
- WRITE (LOUT,10010) LEFT,SLINE
- ENDIF
-10000 FORMAT(1X,I5,': ',5('===='), ' and following lines identical to:')
-
-10010 FORMAT(1X,I5,':',1X,A120)
- 999 END
diff --git a/src/packlib/zbook/code/zprint.F b/src/packlib/zbook/code/zprint.F
deleted file mode 100644
index 15a08d9..0000000
--- a/src/packlib/zbook/code/zprint.F
+++ /dev/null
@@ -1,265 +0,0 @@
-*
-* $Id: zprint.F,v 1.1.1.1 1996/03/08 12:01:13 mclareni Exp $
-*
-* $Log: zprint.F,v $
-* Revision 1.1.1.1 1996/03/08 12:01:13 mclareni
-* Zbook
-*
-*
-#include "zbook/pilot.h"
-#if !defined(CERNLIB_ANORMAL)
- SUBROUTINE ZPRINT(IZ,IDD,KABEL,KFORMA,NL1,NL2)
-#endif
-#if defined(CERNLIB_ANORMAL)
- SUBROUTINE AZPRIN(IZ,IDD,KABEL,KFORMA,NL1,NL2)
-#endif
-C
-C ******************************************************************
-C * *
-C * PRINTS CONTENTS OF BANK ID WITH TITLE KEY *
-C * *
-C * KFORMA=1HI IN INTEGER I10 *
-C * 1HB IN OCTAL OR HEXADECIMAL *
-C * 1HA IN ALPHANUMERIC (A4,A6,A10) *
-C * 1HF IN F10.3 *
-C * 1HE IN E15.7 *
-C * 1HO SAME AS 1HB *
-C * 1HZ SAME AS 1HB *
-C * NNH(FORMAT) PRINTS THE DATA IN USER FORMAT *
-C * NN IS THE LENGHT OF THE STRING *
-C * *
-C ******************************************************************
-C
- PARAMETER (MINL=3)
- CHARACTER *120 SLINE,SBUFF
- DIMENSION IZ(1),IC(10),C(10),IST(5)
- EQUIVALENCE (IC(1),C(1))
-C
- DIMENSION KEY(20),JFORMA(9),NAME(4)
- DIMENSION KABEL(1)
-C
- DATA JFORMA/1HI,1HB,1HA,1HF,1HE,1HO,1HZ,1H(,1HU/
-#if defined(CERNLIB_SINGLE)||defined(CERNLIB_BESM6)||defined(CERNLIB_PDP10)
- DATA IST/10,5,10,10,5/
-#endif
-#if (defined(CERNLIB_DOUBLE))&&(!defined(CERNLIB_NORD))
- DATA IST/10,10,20,10,5/
-#endif
-#if defined(CERNLIB_NORD)
- DATA IST/10,5,20,10,5/
-#endif
-#if defined(CERNLIB_UNIVAC)
- DATA IST/10,8,20,10,5/
-#endif
- DATA IDOL/1H$/
-C
-C ------------------------------------------------------------------
-C
- JZ = IZ(1)
- LOUT = IZ(JZ + 4)
- NARG = 6
- CALL NOARG(NARG)
- IDATA=0
- IF(NARG.GT.1)IDATA=IDD
- N1 = 1
- N2 = IZ(JZ + 14)
- NR = 0
- IF(IDATA.GT.0.AND.IDATA.LT.IZ(JZ+14))GO TO 2
- I1 = 0
- ILAST = 0
- NL = 0
- ND = 0
- CALL UCTOH1('DUMP',NAME,4)
- GO TO 3
-C
- 2 I1=IDATA
- N2=IZ(IDATA)-2
- ND=N2
- ILAST=IDATA+N2+4
- NID = IZ(ILAST)
- NR = IZ(ILAST - 2)
- CALL UBLOW(IZ(ILAST-3),NAME,4)
- 3 CALL VBLANK(KEY,20)
- IFORMA = JFORMA(4)
-C
- GO TO (9,9,7,6,5,4),NARG
-C
- 4 IF (NL2.NE.0)N2 = NL2
- 5 IF (NL1.NE.0)N1 = NL1
- 6 CONTINUE
- IF(KFORMA.NE.0) CALL UCTOH1(KFORMA,IFORMA,1)
- 7 CONTINUE
- IF (KABEL(1).EQ.0) GO TO 9
- CALL UCTOH1(KABEL,KEY,20)
- DO 8 I = 1,20
- IF (KEY(I).NE.IDOL) GO TO 8
- CALL VBLANK(KEY(I),20-I+1)
- GO TO 9
- 8 CONTINUE
-C
- 9 I1 = I1 + N1
- I2 = I1 + N2 - 1
-C
- IF(IDATA.NE.0)NL=IZ(ILAST-1)
- IF(IDATA.NE.0)WRITE(LOUT,6000)NAME,NR,KEY,ND,NL,IDATA,NID
- IF(IDATA.NE.0)ND=N2
- IF(IDATA.EQ.0)WRITE(LOUT,6001)NAME,KEY,I1,I2
-C
- IF (NL.LE.0) GO TO 11
- WRITE(LOUT,7000)
- K1 = 1
- DO 12 I = 1,NL,10
- K2 = MIN0(NL,K1 + 9)
- WRITE(LOUT,1000) I,(IZ(IDATA-K),K=K1,K2)
- K1 = K1 + 10
- 12 CONTINUE
- IF (I2.LT.I1)RETURN
- WRITE(LOUT,7001)
- 11 CONTINUE
- IF (I2.LT.I1)RETURN
-C
- IF (IFORMA.NE.JFORMA(8)) GO TO 13
- RETURN
-C
- 13 CONTINUE
-C
-C--- Inserted by HG
- IF(IFORMA.EQ.JFORMA(9).AND.IDATA.GT.0) THEN
-C--- USER FORMAT
- CALL ZPBANK(IZ,IDD,N1,N2+N1-1)
- RETURN
- ENDIF
-C---
- DO 10 I = 1,7
- IF (IFORMA.NE.JFORMA(I)) GO TO 10
- JF = I
- IF (JF.GT.5)JF = 2
- GO TO 15
- 10 CONTINUE
- JF = 4
- 15 ISTEP = IST(JF)
- I = N1 - ISTEP
-C
- JCNT=0
- DO 111 J = I1,I2,ISTEP
- I = I + ISTEP
- K = J + ISTEP - 1
- IF (K.GT.I2)K = I2
- M = 0
- DO 40 L = J,K
- M = M + 1
- GO TO (20,50,50,30,30),JF
- 20 IC(M) = INTARG(IZ(L))
- GO TO 40
- 30 C(M) = FLOARG(IZ(L))
- 40 CONTINUE
-C
- 50 CONTINUE
- SLINE=' '
- GO TO (60,70,80,90,100),JF
-C
-C IN INTEGER
-C
- 60 WRITE(SLINE,1000)(IC(L),L = 1,M)
- GO TO 110
-C
-C IN BINARY (OCTAL OR HEXADECIMAL)
-C
- 70 WRITE(SLINE,2000)(IZ(L),L = J,K)
- GO TO 110
-C
-C IN ALPHANUMERIC
-C
- 80 WRITE(SLINE,3000)(IZ(L),L = J,K)
- GO TO 110
-C
-C IN F10.3
-C
- 90 WRITE(SLINE,4000)(C(L),L = 1,M)
- GO TO 110
-C
-C IN E15.7
-C
- 100 WRITE(SLINE,5000)(C(L),L = 1,M)
-C
- 110 CONTINUE
-*--- suppress multiple lines if at least MINL of them
- IF(JCNT.EQ.0) THEN
- JCNT=1
- SBUFF=SLINE
- LSTART=I
- LEFT=I
- ELSEIF(SLINE.EQ.SBUFF) THEN
- JCNT=JCNT+1
- LEFT=I
- ELSE
- IF(JCNT.GE.MINL) THEN
- WRITE(LOUT,10110) LSTART
- WRITE(LOUT,10100) LEFT,SBUFF
- ELSE
- LF=LSTART-ISTEP
- DO 240 JJ=1,JCNT
- LF=LF+ISTEP
- WRITE(LOUT,10100) LF,SBUFF
- 240 CONTINUE
- ENDIF
- SBUFF=SLINE
- JCNT=1
- LSTART=I
- LEFT=I
- ENDIF
-C
- 111 CONTINUE
- IF(JCNT.GE.MINL) THEN
- WRITE(LOUT,10110) LSTART
- WRITE(LOUT,10100) LEFT,SBUFF
- ELSEIF(JCNT.GT.0) THEN
- LF=LSTART-ISTEP
- DO 260 JJ=1,JCNT
- LF=LF+ISTEP
- WRITE(LOUT,10100) LF,SBUFF
- 260 CONTINUE
- ENDIF
- RETURN
-C
-#if defined(CERNLIB_CDC)
- 2000 FORMAT(5(2X,O20))
- 3000 FORMAT(10(2X,A10))
-#endif
-#if defined(CERNLIB_CRAY)||defined(CERNLIB_CONVEX)
- 2000 FORMAT(5(2X,O22))
- 3000 FORMAT(10(2X,A8))
-#endif
-#if (defined(CERNLIB_IBM)||defined(CERNLIB_VAX)||defined(CERNLIB_APOLLO)||defined(CERNLIB_UNIX))&&(!defined(CERNLIB_CONVEX))
- 2000 FORMAT(10(2X,Z8))
- 3000 FORMAT(20(2X,A4))
-#endif
-#if defined(CERNLIB_UNIVAC)
- 2000 FORMAT(8O14)
- 3000 FORMAT(20(2X,A4))
-#endif
-#if defined(CERNLIB_NORD)
- 2000 FORMAT(5(2X,O11))
- 3000 FORMAT(20(2X,A4))
-#endif
-#if defined(CERNLIB_BESM6)
- 2000 FORMAT(5(2X,O16))
- 3000 FORMAT(10(2X,A6))
-#endif
-#if defined(CERNLIB_PDP10)
- 2000 FORMAT(5(2X,I10))
- 3000 FORMAT(10(2X,A5))
-#endif
- 1000 FORMAT(10(2X,I10))
- 4000 FORMAT(10(2X,F10.3))
- 5000 FORMAT(5(5X,E15.7))
- 6000 FORMAT(/,10X,' +++ BANK ',4A1,' NO =',I6,' ',20A1
- +,' ND =',I6,' NL =',I6,' ID =',I6,' NID =',I6,' +++')
- 6001 FORMAT(/,10X,' +++ BANK ',4A1,3X,20A1
- +,' BETWEEN LOCATIONS ',I6,' AND ',I6,' +++')
- 7000 FORMAT(' LINKS')
- 7001 FORMAT(' DATA')
-10100 FORMAT(1X,I5,A120)
-10110 FORMAT(1X,I5,' ',5('===='), ' and following lines identical to:')
-
- END
diff --git a/src/packlib/zbook/code/zptfor.F b/src/packlib/zbook/code/zptfor.F
deleted file mode 100644
index f198948..0000000
--- a/src/packlib/zbook/code/zptfor.F
+++ /dev/null
@@ -1,118 +0,0 @@
-*
-* $Id: zptfor.F,v 1.1.1.1 1996/03/08 12:01:13 mclareni Exp $
-*
-* $Log: zptfor.F,v $
-* Revision 1.1.1.1 1996/03/08 12:01:13 mclareni
-* Zbook
-*
-*
-#include "zbook/pilot.h"
- SUBROUTINE ZPTFOR(IZ,NAME,NW,IW)
-*
-* author HG 7/4/84
-*
-* STORES A CONVERTED FORMAT FOR A BANK.
-*
-* INPUT
-* IZ STRUCTURE
-* NAME BANK NAME (UP TO 4 CHARACTERS)
-* NW NO. OF WORDS IN IW
-* IW ARRAY CONTAINING FORMAT DESCRIPTION (SEE ZECFOR)
-*
- PARAMETER (MLINK=6,MFBANK=4)
- DIMENSION IZ(*),IW(*)
-*
- LENGZB(JDUM)=IZ(JDUM)-2
-*
-*--- CHECK FOR CORRECT ZBOOK VERSION (AT LEAST 6 SYSTEM LINKS)
- IF (IZ(IZ(1)+IZ(IZ(1))+1).LT.MLINK) GOTO 50
- IF(IZ(IZ(1)-MLINK).EQ.0) THEN
-*--- FIRST CALL - INITIALIZE
-*
-* BOOK SYSTEM BANK NO. MLINK, AND MFBANK DAUGHTERS.
-*
-* CONTENTS:
-* MOTHER WORD 1 = NO. OF FORMATS BOOKED
-* DAUGTHER 1 BANK NAMES IN H FORMAT (4 MAX.)
-* 2 REF. TO FORMAT IN DAUGTHER 4
-* 3 LENGTH OF FORMAT
-* 4 FORMAT(S)
-*
- CALL ZBOOKN(IZ,IZ(IZ(1)-MLINK),1,MFBANK,'*FOR',0)
- IERR=IZ(IZ(1)+6)
- IF (IERR.NE.0) GOTO 50
- DO 10 I=1,3
- CALL ZBOOKN(IZ,IZ(IZ(IZ(1)-MLINK)-I),20,0,'*FOR',I)
- 10 CONTINUE
- CALL ZBOOKN(IZ,IZ(IZ(IZ(1)-MLINK)-4),0,0,'*FOR',4)
- IERR=IZ(IZ(1)+6)
- IF (IERR.NE.0) GOTO 50
- ENDIF
-*--- LOOK FOR NAME IN LIST (BINARY SEARCH)
- JMOTH=IZ(IZ(1)-MLINK)
- NFORM=IZ(JMOTH+1)
- CALL ZNAMSR(IZ,NAME,IST,LAST)
- IF (IST.LT.0) GOTO 50
- IF(IST.EQ.0) THEN
-*--- FORMAT NOT YET IN TABLE - ADD IT BEHIND LAST
- IF (LENGZB(IZ(JMOTH-1)).EQ.NFORM) THEN
- DO 20 I=1,3
- JZL=IZ(IZ(IZ(1)-MLINK)-I)
- CALL ZPUSHS(IZ,JZL,20,0)
- 20 CONTINUE
- IERR=IZ(IZ(1)+6)
- IF (IERR.NE.0) GOTO 50
- JMOTH=IZ(IZ(1)-MLINK)
- ENDIF
-*--- PUSH EXISTING NAMES AND POINTERS UP ONE WORD
- IF (LAST.LT.NFORM) THEN
- DO 30 I=1,3
- J=IZ(JMOTH-I)+LAST+1
- CALL UCOPY2(IZ(J),IZ(J+1),NFORM-LAST)
- 30 CONTINUE
- ENDIF
-*--- STORE NEW FORMAT
- IZ(JMOTH+1)=NFORM+1
- LENGTH=LENGZB(IZ(JMOTH-4))
- IZ(IZ(JMOTH-1)+LAST+1)=NAME
- IZ(IZ(JMOTH-2)+LAST+1)=LENGTH
- IZ(IZ(JMOTH-3)+LAST+1)=NW
- JZL=IZ(IZ(IZ(1)-MLINK)-4)
- CALL ZPUSHS(IZ,JZL,NW,0)
- IERR=IZ(IZ(1)+6)
- IF (IERR.NE.0) GOTO 50
- CALL UCOPY(IW,IZ(JZL+LENGTH+1),NW)
- ELSE
-*--- FORMAT ALREADY IN TABLE - REPLACE
- LFORM=IZ(IZ(JMOTH-3)+IST)
- KDIFF=NW-LFORM
- KOFF=IZ(IZ(JMOTH-2)+IST)
- IF (KDIFF.GT.0) THEN
- JZL=IZ(IZ(IZ(1)-MLINK)-4)
- CALL ZPUSHS(IZ,JZL,KDIFF,0)
- JMOTH=IZ(IZ(1)-MLINK)
- ENDIF
- IF (KDIFF.NE.0) THEN
- K1=IZ(JMOTH-4)+KOFF+LFORM+1
- K2=IZ(JMOTH-4)+KOFF+NW+1
- KTOT=LENGZB(IZ(JMOTH-4))-KOFF-LFORM
- IF(KDIFF.GT.0) KTOT=KTOT-KDIFF
-*--- MOVE ALL FOLLOWING FORMATS UP, MODIFY POINTERS
- IF (KTOT.GT.0) CALL UCOPY2(IZ(K1),IZ(K2),KTOT)
- IZ(IZ(JMOTH-3)+IST)=NW
- DO 40 I=1,NFORM
- IF (IZ(IZ(JMOTH-2)+I).GT.KOFF) THEN
- IZ(IZ(JMOTH-2)+I)=IZ(IZ(JMOTH-2)+I)+KDIFF
- ENDIF
- 40 CONTINUE
- ENDIF
- CALL UCOPY(IW,IZ(IZ(JMOTH-4)+KOFF+1),NW)
- JZL=IZ(IZ(IZ(1)-MLINK)-4)
- IF (KDIFF.LT.0) CALL ZPUSHS(IZ,JZL,KDIFF,0)
- ENDIF
- GOTO 999
- 50 CONTINUE
- LOUT=IZ(IZ(1)+4)
- WRITE (LOUT,10000)
-10000 FORMAT(/' +++ZPTFOR - ERROR AT CALL, NO ACTION TAKEN')
- 999 END
diff --git a/src/packlib/zbook/code/zptree.F b/src/packlib/zbook/code/zptree.F
deleted file mode 100644
index e2ea484..0000000
--- a/src/packlib/zbook/code/zptree.F
+++ /dev/null
@@ -1,87 +0,0 @@
-*
-* $Id: zptree.F,v 1.1.1.1 1996/03/08 12:01:13 mclareni Exp $
-*
-* $Log: zptree.F,v $
-* Revision 1.1.1.1 1996/03/08 12:01:13 mclareni
-* Zbook
-*
-*
-#include "zbook/pilot.h"
- SUBROUTINE ZPTREE(IZ,ID,LABEL,LFRMT)
-C
-C ******************************************************************
-C * *
-C * PRINTS THE STRUCTURE DEPENDING ON BANK ID *
-C * *
-C ******************************************************************
-C
- DIMENSION IZ(1),ID(1)
- DIMENSION LABEL(1)
- DIMENSION JD(51),NL(51),NM(51)
-C
- DATA MAXLEV/50/
-C
-C ------------------------------------------------------------------
-C
- IF (ID(1).EQ.0) RETURN
- JZ = IZ(1)
- LOUT = IZ(JZ + 4)
- I = 1
- JD(I) = ID(1)
- JDI = JD(I)
- LEVEL = I - 1
- WRITE(LOUT,6001) LEVEL
- LLEVL = LEVEL
- CALL ZPRINT(IZ,JDI,LABEL,LFRMT,0,0)
- ND = IZ(JDI)
- IL = JDI + ND + 1
- NID = IZ(IL + 1)
- IF (NID.LT.IZ(JZ + 12)) GO TO 940
- IF (NID.GT.IZ(JZ + 13)) GO TO 940
- NL(I) = IZ(IL)
- NM(I) = NL(I)
- IF (NL(I).LE.0) GO TO 999
-C
- 21 CONTINUE
- JDI = JD(I)
- NLI = NL(I)
- NMI = NM(I)
- NLII = NMI - NLI + 1
- JD(I + 1) = IZ(JDI - NLII)
- IF (JD(I + 1).NE.0) GO TO 50
- 45 CONTINUE
- NL(I) = NL(I) - 1
- IF (NL(I).NE.0) GO TO 21
- I = I - 1
- IF (I.LE.0) GO TO 999
- GO TO 45
- 50 CONTINUE
- JDI = JD(I + 1)
- ND = IZ(JDI)
- IL = JDI + ND + 1
- NID = IZ(IL + 1)
- IF (NID.LT.IZ(JZ + 12)) GO TO 940
- IF (NID.GT.IZ(JZ + 13)) GO TO 940
- NL(I + 1) = IZ(IL)
- NM(I + 1) = NL(I + 1)
- LEVEL = I
- IF (LLEVL.NE.LEVEL) WRITE(LOUT,6001) LEVEL
- LLEVL = LEVEL
- CALL ZPRINT(IZ,JDI,LABEL,LFRMT,0,0)
- IF (NL(I + 1).LE.0) GO TO 45
- I = I + 1
- IF (I.GT.MAXLEV) GO TO 980
- GO TO 21
-C
-C ERROR IN STRUCTURE
-C
- 940 CALL ZERROR(IZ,400,'ZPTREE',ID)
- GO TO 999
-C
-C LEVEL TOO BIG
-C
- 980 CALL ZERROR(IZ,800,'ZPTREE',ID)
-C
- 999 RETURN
- 6001 FORMAT(//,10X,' +++ LEVEL ',I3)
- END
diff --git a/src/packlib/zbook/code/zpush.F b/src/packlib/zbook/code/zpush.F
deleted file mode 100644
index bf00088..0000000
--- a/src/packlib/zbook/code/zpush.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: zpush.F,v 1.1.1.1 1996/03/08 12:01:13 mclareni Exp $
-*
-* $Log: zpush.F,v $
-* Revision 1.1.1.1 1996/03/08 12:01:13 mclareni
-* Zbook
-*
-*
-#include "zbook/pilot.h"
- SUBROUTINE ZPUSH(IZ,ID,NDP)
-C
-C ******************************************************************
-C * *
-C * PUSH DATA BANK ID BY NDP WORDS *
-C * *
-C ******************************************************************
-C
- DIMENSION IZ(1),ID(1)
-C
-C ------------------------------------------------------------------
-C
- JZ = IZ(1)
- IZ(JZ + 17) = 1
- CALL ZPUSHS(IZ,ID,NDP,0)
- RETURN
- END
diff --git a/src/packlib/zbook/code/zpush0.F b/src/packlib/zbook/code/zpush0.F
deleted file mode 100644
index 93e6e0e..0000000
--- a/src/packlib/zbook/code/zpush0.F
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: zpush0.F,v 1.1.1.1 1996/03/08 12:01:13 mclareni Exp $
-*
-* $Log: zpush0.F,v $
-* Revision 1.1.1.1 1996/03/08 12:01:13 mclareni
-* Zbook
-*
-*
-#include "zbook/pilot.h"
- SUBROUTINE ZPUSH0(IZ,ID,NDP)
-C
-C ******************************************************************
-C * *
-C * PUSH DATA BANK ID BY NDP WORDS *
-C * *
-C ******************************************************************
-C
- DIMENSION IZ(1),ID(1)
-C
-C ------------------------------------------------------------------
-C
- CALL ZPUSHS(IZ,ID,NDP,0)
- RETURN
- END
diff --git a/src/packlib/zbook/code/zpushs.F b/src/packlib/zbook/code/zpushs.F
deleted file mode 100644
index 27be973..0000000
--- a/src/packlib/zbook/code/zpushs.F
+++ /dev/null
@@ -1,168 +0,0 @@
-*
-* $Id: zpushs.F,v 1.1.1.1 1996/03/08 12:01:13 mclareni Exp $
-*
-* $Log: zpushs.F,v $
-* Revision 1.1.1.1 1996/03/08 12:01:13 mclareni
-* Zbook
-*
-*
-#include "zbook/pilot.h"
- SUBROUTINE ZPUSHS(IZ,ID,NDDP,NLLP)
-C
-C ******************************************************************
-C * *
-C * PUSH BANK ID BY NPUSH WORDS (NPUSH,POSITIVE OR NEGATIVE *
-C * SHIFTING ALL BANKS CREATED AFTER ID *
-C * *
-C ******************************************************************
-C
- DIMENSION IZ(1),ID(1)
- LOGICAL ZIDOK
-C
-C ------------------------------------------------------------------
-C
- JZ = IZ(1)
- IF (ZIDOK(IZ,ID)) GO TO 5
- CALL ZERROR(IZ,300,'ZPUSHS',ID)
- RETURN
-C
- 5 IF (NDDP.EQ.0.AND.NLLP.EQ.0) GO TO 999
- NPUSH = NDDP + NLLP
- IZ(JZ + 6) = 0
- IF (NPUSH.LE.IZ(JZ + 1)) GO TO 10
- IDATA=ID(1)
- ILAST=IDATA+IZ(IDATA)+2
- NID = IZ(ILAST)
- IZ(JZ + 18) = NID
- CALL ZGARB(IZ)
- NID = IZ(JZ + 18)
- ID(1) = IZ(NID)
- IF (NPUSH.LE.IZ(JZ + 1)) GO TO 10
- NMOVE = NPUSH - IZ(JZ + 1) + 1
- CALL ZMOVE(IZ,NMOVE)
- IF (NPUSH.LE.IZ(JZ + 1)) GO TO 10
- CALL ZERROR(IZ,100,'ZPUSHS',ID)
- GO TO 999
-C
- 10 IDATA=ID(1)
- ILAST=IDATA+IZ(IDATA)+2
- IF (ILAST.LE.0) GO TO 900
- IF (ILAST.GT.IZ(JZ + 15)) GO TO 900
- NID = IZ(ILAST)
- IF (NID.LT.IZ(JZ + 12)) GO TO 900
- IF (NID.GT.IZ(JZ + 13)) GO TO 900
- NLINK = IZ(ILAST - 1)
- IFIRST=IDATA-NLINK-1
- IF (IFIRST.LE.0) GO TO 900
- IF (IFIRST.GT.IZ(JZ + 15)) GO TO 900
- NDP = NDDP
- IF(NDP.LT.-IZ(IDATA)+2)NDP=-IZ(IDATA)+2
- NLP = NLLP
- IF (NLP.LT. - NLINK)NLP = - NLINK
-C
- IF (NPUSH.EQ.0) GO TO 200
- IF (NPUSH.LT.0) GO TO 300
-C
-C========= A, NPUSH POSITIVE
-C
- IMAX = IZ(JZ + 15)
- CALL ZSHIFT(IZ,ILAST+1,IMAX,NPUSH,'ZPUSHS')
- IF (IZ(JZ + 6).NE.0) GO TO 999
- IZ(ILAST+NPUSH )=IZ(ILAST )
- IZ(ILAST+NPUSH-1)=IZ(ILAST-1)
- IZ(ILAST+NPUSH-2)=IZ(ILAST-2)
- IZ(ILAST+NPUSH-3)=IZ(ILAST-3)
- IF(IZ(JZ-1).NE.0) CALL ZUPLOC(IZ,ILAST-3,ILAST,NPUSH)
- ILAST = ILAST + NPUSH
-C
- IF (NLP.EQ.0) GO TO 140
- IF (NLP.LT.0) GO TO 170
-C
-C NPUSH>0 NLP>0 NDP>0
-C NPUSH>0 NLP>0 NDP=0
-C NPUSH>0 NLP>0 NDP<0
-C NPUSH=0 NLP>0 NDP<0
-C
- 120 CALL ZSHIFD(IZ,IDATA,ILAST,NLP,NDP)
- CALL ZSHIFP(IZ,IFIRST,IDATA,ILAST,NLP)
- GO TO 400
-C
-C NPUSH>0 NLP=0 NDP>0
-C
- 140 CONTINUE
- CALL ZSHIFD(IZ,IDATA,ILAST,NLP,NDP)
- GO TO 400
-C
-C NPUSH>0 NLP<0 NDP>0
-C NPUSH=0 NLP<0 NDP>0
-C
- 170 CONTINUE
- CALL ZSHIFP(IZ,IFIRST,IDATA,ILAST,NLP)
- CALL ZSHIFD(IZ,IDATA,ILAST,NLP,NDP)
- GO TO 400
-C
-C======== B, NPUSH=0
-C
- 200 IF (NLP.LT.0) GO TO 170
- GO TO 120
-C
-C======== C, NPUSH NEGATIVE
-C
- 300 IF (NLP.EQ.0) GO TO 330
- IF (NLP.LT.0) GO TO 350
-C
-C NPUSH<0 NLP>0 NDP<0
-C
- CALL ZSHIFD(IZ,IDATA,ILAST,NLP,NDP)
- CALL ZSHIFP(IZ,IFIRST,IDATA,ILAST,NLP)
- GO TO 390
-C
-C NPUSH<0 NLP=0 NDP<0
-C
- 330 CONTINUE
- CALL ZSHIFD(IZ,IDATA,ILAST,NLP,NDP)
- GO TO 390
-C
-C NPUSH<0 NLP<0 NDP>0
-C NPUSH<0 NLP<0 NDP=0
-C NPUSH<0 NLP<0 NDP<0
-C
- 350 CALL ZSHIFP(IZ,IFIRST,IDATA,ILAST,NLP)
- CALL ZSHIFD(IZ,IDATA,ILAST,NLP,NDP)
-C
- 390 ILNEW = ILAST + NPUSH
- IF(NPUSH.GT.0)GO TO 392
- IZ(ILNEW-3)=IZ(ILAST-3)
- IZ(ILNEW-2)=IZ(ILAST-2)
- IZ(ILNEW-1)=IZ(ILAST-1)
- IZ(ILNEW )=IZ(ILAST )
- GO TO 394
-C
- 392 IZ(ILNEW )=IZ(ILAST )
- IZ(ILNEW-1)=IZ(ILAST-1)
- IZ(ILNEW-2)=IZ(ILAST-2)
- IZ(ILNEW-3)=IZ(ILAST-3)
-C
- 394 IF (ILAST + 1.EQ.IZ(JZ + 15)) GO TO 395
- IZ(ILNEW + 1) = NPUSH
- IZ(JZ + 5) = IZ(JZ + 5) - NPUSH
- GO TO 400
-C
- 395 IZ(JZ + 15) = ILNEW + 1
- IZ(ILNEW + 1) = 0
- IZ(JZ + 1) = IZ(JZ + 1) - NPUSH
-C
- 400 IZ(IFIRST) = IZ(IFIRST) + NPUSH
- IZ(NID)=IDATA
- ID(1)=IDATA
- GO TO 999
-C
-C
-C STRUCTURE OVERWRITTEN
-C
- 900 CALL ZERROR(IZ,400,'ZPUSHS',ID)
-C
- 999 IZ(JZ + 17) = 0
- IZ(JZ + 7) = IZ(JZ + 7) + 1
- RETURN
- END
diff --git a/src/packlib/zbook/code/zread.F b/src/packlib/zbook/code/zread.F
deleted file mode 100644
index 8f93497..0000000
--- a/src/packlib/zbook/code/zread.F
+++ /dev/null
@@ -1,151 +0,0 @@
-*
-* $Id: zread.F,v 1.1.1.1 1996/03/08 12:01:13 mclareni Exp $
-*
-* $Log: zread.F,v $
-* Revision 1.1.1.1 1996/03/08 12:01:13 mclareni
-* Zbook
-*
-*
-#include "zbook/pilot.h"
- SUBROUTINE ZREAD(IZ,ID,LUN,KEYI)
-C
-C ******************************************************************
-C * *
-C * COPIES ID FROM MASS STORAGE TO MEMORY *
-C * A, IF ID DOES NOT EXIST IN MEMORY *
-C * IT WILL BE CREATED *
-C * B, IF ID EXISTS AND BIG ENOUGH-->STRAIGTH COPY *
-C * C, IF ID EXISTS BUT NOT BIG ENOUGH--> *
-C * PUSH BEFORE COPY *
-C * *
-C ******************************************************************
-C
- DIMENSION IZ(1),ID(1)
- DIMENSION KD(51),NK(51)
- LOGICAL ZIDOK
-C
- DATA MAXLEV/50/
-C
-C ------------------------------------------------------------------
-C
- KEY = KEYI
- JZ = IZ(1)
- IZ(JZ + 6) = 0
- JD = IZ(JZ - 2)
- IF (JD.EQ.0) GO TO 95
- NL = IZ(JD) - 2
- NLUN = 1
- 5 IF (IZ(JD + NLUN).EQ.LUN) GO TO 7
- NLUN = NLUN + 1
- IF (NLUN.LE.NL) GO TO 5
- GO TO 95
-C
- 7 JDIR = IZ(JD - NLUN)
-C
- CALL ZSEARC(IZ,NLUN,KEY,LOC)
- IF (LOC.LE.0) GO TO 91
-C
- IF = IZ(LOC + 1)
- ND = IABS(IZ(LOC + 2))
- LREC = IZ(JDIR + 3)
- IF (IZ(LOC + 2).LT.0) GO TO 30
-C
- IF (ZIDOK(IZ,ID)) GO TO 10
- 8 IZ(JZ+17) = 1
- CALL ZBOOKN(IZ,ID,ND-2,0,' ',0)
- IF (IZ(JZ+6).NE.0) GO TO 99
- NID = IZ(JZ+18)
- IDATA=IZ(NID)
- GO TO 20
-C
- 10 IDATA=ID(1)
- NOLD=IZ(IDATA)
- IF (NOLD.EQ.ND) GO TO 20
- IF (NOLD.GT.ND) GO TO 15
-C
- CALL ZDROP (IZ,ID)
- GO TO 8
-C
- 15 CALL ZPUSHS(IZ,IDATA,ND-NOLD,0)
- IF (IZ(JZ + 6).NE.0) GO TO 99
-C
- 20 CALL ZIODO(LUN,IF,LREC,IZ(IDATA+1),ND,1)
-C
- GO TO 99
-C
-C TREE STRUCTURE
-C
- 30 IF(ZIDOK(IZ,ID)) CALL ZDROP(IZ,ID)
-C
- IZ(JZ+17) = 1
- NID = LOCF(ID(1))+IZ(JZ+16)+1
- IF (ND.LE.IZ(JZ+1)) GO TO 35
-C
- IZ(JZ+18) = NID
- CALL ZGARB(IZ)
- NID = IZ(JZ+18)
-C
- 35 CALL ZBOOKN(IZ,IZ(JZ-5),ND-6,0,'JBUF',0)
- JZ=IZ(1)
- JBUF=IZ(JZ-5)
- IF (JBUF.EQ.0) GO TO 99
-C
- CALL ZIODO(LUN,IF,LREC,IZ(JBUF-1),ND,1)
-C
- ND = IZ(JBUF - 1)
- ILINK = JBUF + ND - 3
- NLINK = IZ(ILINK)
- IZ(NID)= JBUF + NLINK
-#if defined(CERNLIB_CRAY)||defined(CERNLIB_CONVEX)
- ID(1) = IZ(NID)
-#endif
- IZ(ILINK + 1) = NID
- IF(NID.LT.IZ(JZ+12))IZ(JZ+12)=NID
- IF(NID.GT.IZ(JZ+13))IZ(JZ+13)=NID
-C
-C NOW SCAN TREE TO UPDATE POINTERS AND ADDRESSES
-C
- I = 1
- NK(I) = NLINK
- IFIRST = ILINK + 2
- KD(I) = ID(1)
-C
- 40 IF (NK(I).GT.0) GO TO 42
- 41 I = I - 1
- IF(I.LE.0)IZ(JZ-5)=0
- IF (I.LE.0) GO TO 99
- GO TO 40
- 42 JD = KD(I) - NK(I)
- IF (IZ(JD).NE.0) GO TO 43
- NK(I) = NK(I) - 1
- IF (NK(I).LE.0) GO TO 41
- GO TO 42
- 43 NK(I) = NK(I) - 1
- I = I + 1
- IF (I.GT.MAXLEV) GO TO 94
- ILAST = IFIRST + IZ(IFIRST) - 1
- NK(I) = IZ(ILAST - 1)
- KD(I) = IFIRST + NK(I) + 1
- IFIRST = ILAST + 1
- IZ(JD) = KD(I)
- IZ(ILAST) = JD
- IF (JD.LT.IZ(JZ + 12)) IZ(JZ + 12) = JD
- IF (JD.GT.IZ(JZ + 13)) IZ(JZ + 13) = JD
- GO TO 40
-C
-C ID DOES NOT EXIST ON MASS STORAGE
-C
- 91 CALL ZERROR(IZ,700,'ZREAD ',ID)
- GO TO 99
-C
-C LEVEL TOO HIGH
-C
- 94 CALL ZERROR(IZ,800,'ZREAD ',ID)
- GO TO 99
-C
-C UNDEFINED INPUT UNIT
-C
- 95 CALL ZERROR(IZ,900,'ZREAD ',ID)
-C
- 99 RETURN
- END
diff --git a/src/packlib/zbook/code/zrecal.F b/src/packlib/zbook/code/zrecal.F
deleted file mode 100644
index 4602fea..0000000
--- a/src/packlib/zbook/code/zrecal.F
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: zrecal.F,v 1.1.1.1 1996/03/08 12:01:13 mclareni Exp $
-*
-* $Log: zrecal.F,v $
-* Revision 1.1.1.1 1996/03/08 12:01:13 mclareni
-* Zbook
-*
-*
-#include "zbook/pilot.h"
- SUBROUTINE ZRECAL(IZ,ID,LUN)
-C
-C ******************************************************************
-C * *
-C * SAME AS ZREAD + ZSCR *
-C * *
-C ******************************************************************
-C
- DIMENSION IZ(1),ID(1)
- LOGICAL ZIDOK
-C
-C ------------------------------------------------------------------
-C
- IDD = ID(1)
- IF (ZIDOK(IZ,ID)) RETURN
- KEY = - IDD
- ID(1) = 0
-C
- CALL ZREAD(IZ,ID,LUN,KEY)
- IF (ID(1).EQ.0) RETURN
-C
- CALL ZSCR(IZ,LUN,KEY)
-C
- RETURN
- END
diff --git a/src/packlib/zbook/code/zreset.F b/src/packlib/zbook/code/zreset.F
deleted file mode 100644
index 9b45333..0000000
--- a/src/packlib/zbook/code/zreset.F
+++ /dev/null
@@ -1,35 +0,0 @@
-*
-* $Id: zreset.F,v 1.1.1.1 1996/03/08 12:01:13 mclareni Exp $
-*
-* $Log: zreset.F,v $
-* Revision 1.1.1.1 1996/03/08 12:01:13 mclareni
-* Zbook
-*
-*
-#include "zbook/pilot.h"
- SUBROUTINE ZRESET(IZ,ID)
-C
-C ******************************************************************
-C * *
-C * CLEARS THE CONTENT OF BANK ID *
-C * *
-C ******************************************************************
-C
- DIMENSION IZ(1),ID(1)
- LOGICAL ZIDOK
-C
-C ------------------------------------------------------------------
-C
- IDATA=ID(1)
- IF (ZIDOK(IZ,ID)) GO TO 10
- CALL ZERROR(IZ,300,'ZRESET',ID)
- RETURN
-C
-#if !defined(CERNLIB_BESM6)
- 10 CALL VZERO(IZ(IDATA+1),IZ(IDATA)-2)
-#endif
-#if defined(CERNLIB_BESM6)
- 10 CALL UZERO(IZ(IDATA+1),1,IZ(IDATA)-2)
-#endif
- RETURN
- END
diff --git a/src/packlib/zbook/code/zscr.F b/src/packlib/zbook/code/zscr.F
deleted file mode 100644
index cb2a7ed..0000000
--- a/src/packlib/zbook/code/zscr.F
+++ /dev/null
@@ -1,69 +0,0 @@
-*
-* $Id: zscr.F,v 1.1.1.1 1996/03/08 12:01:13 mclareni Exp $
-*
-* $Log: zscr.F,v $
-* Revision 1.1.1.1 1996/03/08 12:01:13 mclareni
-* Zbook
-*
-*
-#include "zbook/pilot.h"
- SUBROUTINE ZSCR(IZ,LUN,KEY)
-C
-C ******************************************************************
-C * *
-C * SCRATCHES BANK WITH PASSWORD KEY ON MASS STORAGE *
-C * *
-C ******************************************************************
-C
- DIMENSION IZ(1)
-C
-C ------------------------------------------------------------------
-C
- JZ = IZ(1)
- IZ(JZ + 6) = 0
- JD = IZ(JZ - 2)
- IF (JD.EQ.0) GO TO 95
- NL = IZ(JD) - 2
- NLUN = 1
- 5 IF (IZ(JD + NLUN).EQ.LUN) GO TO 7
- NLUN = NLUN + 1
- IF (NLUN.LE.NL) GO TO 5
- GO TO 95
-C
- 7 CALL ZSEARC(IZ,NLUN,KEY,LOC)
- IF (LOC.LE.0) GO TO 91
-C
-C RESET RECORD POINTERS
-C
- JDIR = IZ(JD - NLUN)
- IZ(JDIR + 10) = 1
- IF = IZ(LOC + 1)
- NW = IABS(IZ(LOC + 2))
- NR = (NW + IZ(JDIR + 3) - 1) / IZ(JDIR + 3)
- DO 10 I = 1,NR
- 10 IZ(JDIR + 9 + IF + I) = 0
- IZ(JDIR + 7) = IZ(JDIR + 7) + NR
- IF (IF.LT.IZ(JDIR + 8))IZ(JDIR + 8) = IF
-C
-C DELETES ID FROM ADDRESS TABLE
-C
- N = IZ(JDIR + 5) + JDIR - LOC - 3
- IF (N.EQ.0) GO TO 30
- DO 20 I = 1,N
- 20 IZ(LOC + I - 1) = IZ(LOC + I + 2)
-C
- 30 IZ(JDIR + 6) = IZ(JDIR + 6) + 1
- IZ(JDIR + 5) = IZ(JDIR + 5) - 3
- GO TO 99
-C
-C ID DOES NOT EXIST ON MASS STORAGE
-C
- 91 CALL ZERROR(IZ,700,'ZSCR ',0)
- GO TO 99
-C
-C LUN IS UNDEFINED
-C
- 95 CALL ZERROR(IZ,900,'ZSCR ',0)
-C
- 99 RETURN
- END
diff --git a/src/packlib/zbook/code/zsearc.F b/src/packlib/zbook/code/zsearc.F
deleted file mode 100644
index b739b34..0000000
--- a/src/packlib/zbook/code/zsearc.F
+++ /dev/null
@@ -1,46 +0,0 @@
-*
-* $Id: zsearc.F,v 1.1.1.1 1996/03/08 12:01:13 mclareni Exp $
-*
-* $Log: zsearc.F,v $
-* Revision 1.1.1.1 1996/03/08 12:01:13 mclareni
-* Zbook
-*
-*
-#include "zbook/pilot.h"
- SUBROUTINE ZSEARC(IZ,NLUN,KEY,LOC)
-C
-C ******************************************************************
-C * *
-C * LOCATES KEYWORD=KEY IN THE ADDRESS TABLE FOR *
-C * MASS STORAGE ACCESS (BINARY SEARCH) *
-C * *
-C ******************************************************************
-C
- DIMENSION IZ(1)
-C
-C ------------------------------------------------------------------
-C
- JZ = IZ(1)
- JD = IZ(JZ - 2)
- JDIR = IZ(JD - NLUN)
-C
- LOCID = IZ(JDIR + 4) + JDIR
- LUP = (IZ(JDIR + 5) - IZ(JDIR + 4)) / 3 + 1
- LDOWN = 0
-C
- 10 IF (LUP - LDOWN.LE.1) GO TO 40
- LMEAN = (LUP + LDOWN) / 2
- LOCID = IZ(JDIR + 4) + 3 * (LMEAN - 1) + JDIR
- IF (KEY - IZ(LOCID))20,99,30
- 20 LUP = LMEAN
- GO TO 10
-C
- 30 LDOWN = LMEAN
- LOCID = LOCID + 3
- GO TO 10
-C
- 40 LOCID = - LOCID
-C
- 99 LOC = LOCID
- RETURN
- END
diff --git a/src/packlib/zbook/code/zshifd.F b/src/packlib/zbook/code/zshifd.F
deleted file mode 100644
index 0e47e58..0000000
--- a/src/packlib/zbook/code/zshifd.F
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: zshifd.F,v 1.1.1.1 1996/03/08 12:01:13 mclareni Exp $
-*
-* $Log: zshifd.F,v $
-* Revision 1.1.1.1 1996/03/08 12:01:13 mclareni
-* Zbook
-*
-*
-#include "zbook/pilot.h"
- SUBROUTINE ZSHIFD(IZ,IDATA,ILAST,NPUSH,NDP)
-C
-C ******************************************************************
-C * *
-C * SHIFT DATA AREA IN BANK POINTED BY IDATA *
-C * *
-C ******************************************************************
-C
- DIMENSION IZ(1)
-C
-C ------------------------------------------------------------------
-C
- JZ = IZ(1)
- ND=IZ(IDATA)
- IF (NPUSH.EQ.0) GO TO 10
- CALL UCOPY2(IZ(IDATA),IZ(IDATA+NPUSH),ND-1)
- IF(IZ(JZ-1).NE.0)CALL ZUPLOC(IZ,IDATA,ILAST,NPUSH)
- IDATA=IDATA+NPUSH
-C
- 10 IF (NDP.EQ.0) GO TO 99
- IZ(IDATA)=IZ(IDATA)+NDP
- IF (IZ(JZ + 17).NE.0) GO TO 99
- IF (NDP.LE.0) GO TO 99
-#if !defined(CERNLIB_BESM6)
- CALL VZERO(IZ(IDATA+ND-1),NDP)
-#endif
-#if defined(CERNLIB_BESM6)
- CALL UZERO(IZ(IDATA+ND-1),1,NDP)
-#endif
-C
- 99 RETURN
- END
diff --git a/src/packlib/zbook/code/zshifp.F b/src/packlib/zbook/code/zshifp.F
deleted file mode 100644
index a659e06..0000000
--- a/src/packlib/zbook/code/zshifp.F
+++ /dev/null
@@ -1,72 +0,0 @@
-*
-* $Id: zshifp.F,v 1.1.1.1 1996/03/08 12:01:13 mclareni Exp $
-*
-* $Log: zshifp.F,v $
-* Revision 1.1.1.1 1996/03/08 12:01:13 mclareni
-* Zbook
-*
-*
-#include "zbook/pilot.h"
- SUBROUTINE ZSHIFP(IZ,IFIRST,IDATA,ILAST,NLP)
-C
-C ******************************************************************
-C * *
-C * SHIFT POINTERS AREA IN BANK POINTED BY IDATA *
-C * *
-C ******************************************************************
-C
- DIMENSION IZ(1)
-C
-C ------------------------------------------------------------------
-C
- JZ = IZ(1)
- NLINK = IZ(ILAST - 1)
- IZ(ILAST - 1) = NLINK + NLP
- IF (NLINK.EQ.0) GO TO 50
-C
- IF (NLP.GE.0) GO TO 20
- N = - NLP
- DO 10 I = 1,N
- IF (IZ(IFIRST + I).EQ.0) GO TO 10
- CALL ZDROP(IZ,IZ(IFIRST+I))
- 10 CONTINUE
- 20 CONTINUE
-C
- DO 30 I = 1,NLINK
- JP = IZ(IFIRST + I)
- IF (JP.EQ.0) GO TO 30
- ND = IZ(JP)
- IL = JP + ND + 2
- IF (IL.LT.0) GO TO 90
- IF (IL.GT.IZ(JZ + 14)) GO TO 90
- NID = IZ(IL) + NLP
- IF (NID.LT.IZ(JZ + 12))IZ(JZ + 12) = NID
- IF (NID.GT.IZ(JZ + 13))IZ(JZ + 13) = NID
- IZ(IL) = NID
- 30 CONTINUE
-C
- IF (NLP.GT.0) GO TO 40
- IF(IZ(JZ-1).NE.0)CALL ZUPLOC(IZ,IFIRST-NLP+1,IDATA-1,NLP)
- N = NLINK + NLP
- IF (N.LE.0) GO TO 99
- CALL UCOPY2(IZ(IFIRST-NLP+1),IZ(IFIRST+1),N)
- GO TO 99
-C
- 40 IF(IZ(JZ-1).NE.0)CALL ZUPLOC(IZ,IFIRST+1,IDATA-1,NLP)
- CALL UCOPY2(IZ(IFIRST+1),IZ(IFIRST+NLP+1),NLINK)
-C
- 50 IF (NLP.LE.0) GO TO 99
-#if !defined(CERNLIB_BESM6)
- CALL VZERO(IZ(IFIRST+1),NLP)
-#endif
-#if defined(CERNLIB_BESM6)
- CALL UZERO(IZ(IFIRST+1),1,NLP)
-#endif
- GO TO 99
-C
-C STRUCTURE HAS BEEN OVERWRITTEN
-C
- 90 CALL ZERROR(IZ,400,'ZSHIFP',0)
-C
- 99 RETURN
- END
diff --git a/src/packlib/zbook/code/zshift.F b/src/packlib/zbook/code/zshift.F
deleted file mode 100644
index 70fbf55..0000000
--- a/src/packlib/zbook/code/zshift.F
+++ /dev/null
@@ -1,111 +0,0 @@
-*
-* $Id: zshift.F,v 1.1.1.1 1996/03/08 12:01:13 mclareni Exp $
-*
-* $Log: zshift.F,v $
-* Revision 1.1.1.1 1996/03/08 12:01:13 mclareni
-* Zbook
-*
-*
-#include "zbook/pilot.h"
- SUBROUTINE ZSHIFT(IZ,IOLD,IMAX,NPUSH,LABEL)
-C
-C
-C ******************************************************************
-C * *
-C * *
-C * INTERNAL ZBOOK ROUTINE *
-C * MODIFICATION TO ALLOW MOTHER BANKS TO FOLLOW DAUGHTERS *
-C * *
-C * MODS BY DANNY LANSKE + FRANZ-JOSEF HASERT *
-C * SHIFT MEMORY FROM ADDRESS I1 BY NPUSH WORDS *
-C * *
-C * *
-C ******************************************************************
-C
- DIMENSION IZ(1),LABEL(1)
-C
-C
-C ------------------------------------------------------------------
-C
-C
- LOGICAL INSIDE
-C
- INSIDE (IPOINT) = IPOINT .GE. IOLD .AND. IPOINT .LT. IMAX
-C
- JZ = IZ(1)
- IFIRST = IOLD + NPUSH
- CALL UCOPY2(IZ(IOLD),IZ(IFIRST),IMAX-IOLD+1)
-C
- IF (IFIRST.GE.IMAX + NPUSH) GO TO 30
-C
- 10 NLONG = IZ(IFIRST)
- IFIRST = IFIRST + IABS(NLONG)
- IF (IFIRST.GT.IZ(JZ + 14)) GO TO 90
- IF (NLONG.LT.0) GO TO 25
-C
-C UPDATE POINTERS AREA (IF ANY)
-C
- NLID = IZ(IFIRST - 1)
- IF(NLID .LT. IZ(JZ+12)) GO TO 90
- IF(NLID .GT. IZ(JZ+13)) GO TO 90
-C
- IF(INSIDE(NLID)) GO TO 12
-C
- IF(NLID .NE. 1) IZ(NLID) = IZ(NLID) + NPUSH
- GO TO 14
-C
- 12 CONTINUE
- NLID = NLID + NPUSH
- IF(NLID .LT. IZ(JZ+12)) IZ(JZ+12) = NLID
- IF(NLID .GT. IZ(JZ+13)) IZ(JZ+13) = NLID
- IZ(IFIRST - 1) = NLID
-C
- 14 CONTINUE
- ILINK = IFIRST - 2
- NLINK = IZ(ILINK)
- IF(NLINK .LE. 0) GO TO 25
-C
- IDATA = IFIRST - NLONG + NLINK + 1
-C
- DO 20 I = 1, NLINK
- JP = IZ(IDATA - I)
- IF(JP .EQ. 0) GO TO 20
-C
- IF(INSIDE(JP)) GO TO 16
-C
- IF(JP .GT. IZ(JZ+14)) GO TO 90
-C
- ND = IZ(JP)
- IL = JP + ND + 2
- IF(IL .LE. 0) GO TO 90
- IF(IL .GT. IZ(JZ+14)) GO TO 90
-C
- NID = IZ(IL) + NPUSH
- IF(NID .LT. IZ(JZ+12)) IZ(JZ+12) = NID
- IF(NID .GT. IZ(JZ+13)) IZ(JZ+13) = NID
- IZ(IL) = NID
- GO TO 20
-C
- 16 CONTINUE
- JP = JP + NPUSH
- IF(JP .GT. IZ(JZ+14)) GO TO 90
- IZ(IDATA - I) = JP
-C
- 20 CONTINUE
- 25 IF (IZ(IFIRST).EQ.0) GO TO 30
- IF (IFIRST.LE.IMAX + NPUSH) GO TO 10
-C
-C UPDATE USER LOCAL POINTERS
-C
- 30 IF (IZ(JZ - 1).EQ.0) GO TO 95
- IF (IOLD.GE.IMAX) GO TO 95
- CALL ZUPLOC(IZ,IOLD,IMAX,NPUSH)
- GO TO 95
- 90 CALL ZERROR(IZ,400,LABEL ,0)
- RETURN
-C
- 95 IF (IMAX.LT.IZ(JZ + 15)) GO TO 99
- IZ(JZ + 15) = IZ(JZ + 15) + NPUSH
- IZ(JZ + 1) = IZ(JZ + 14) - IZ(JZ + 15)
- 99 RETURN
- END
diff --git a/src/packlib/zbook/code/zstore.F b/src/packlib/zbook/code/zstore.F
deleted file mode 100644
index eb54c97..0000000
--- a/src/packlib/zbook/code/zstore.F
+++ /dev/null
@@ -1,55 +0,0 @@
-*
-* $Id: zstore.F,v 1.1.1.1 1996/03/08 12:01:13 mclareni Exp $
-*
-* $Log: zstore.F,v $
-* Revision 1.1.1.1 1996/03/08 12:01:13 mclareni
-* Zbook
-*
-*
-#include "zbook/pilot.h"
- SUBROUTINE ZSTORE(IZ,ID,LUNIT,KEY)
-C
-C ******************************************************************
-C * *
-C * STORES ON LOGICAL UNIT LUNIT THE BANK ID WITH *
-C * A PASSWORD=KEY *
-C * *
-C ******************************************************************
-C
- DIMENSION IZ(1),ID(1)
-#if defined(CERNLIB_BESM6)
- DIMENSION LABNW(2)
- EQUIVALENCE(LABNW(1),KEI),(LABNW(2),NW)
-#endif
- LOGICAL ZIDOK
-C
-C ------------------------------------------------------------------
-C
- IDATA=ID(1)
- IF (ZIDOK(IZ,ID)) GO TO 10
- CALL ZERROR(IZ,300,'ZSTORE',ID)
- RETURN
-C
- 10 ND=IZ(IDATA)
- NL=IZ(IDATA+ND+1)+1
- NW = ND
- CALL SBYT(NL,NW,19,14)
-#if !defined(CERNLIB_BESM6)
- WRITE (LUNIT)KEY,NW
- WRITE(LUNIT)(IZ(IDATA+J),J=1,ND)
- J = 0
- WRITE(LUNIT)J,J
- BACKSPACE LUNIT
-#endif
-#if defined(CERNLIB_BESM6)
- KEI=KEY
- CALL SWRITE(LUNIT,LABNW(1),LABNW(2),0)
- CALL SWRITE(LUNIT,IZ(IDATA+1),ND,1)
- LABNW(1)=0
- LABNW(2)=0
- CALL SWRITE(LUNIT,LABNW(1),LABNW(2),0)
- CALL SBACK(LUNIT)
-#endif
-C
- RETURN
- END
diff --git a/src/packlib/zbook/code/zswap.F b/src/packlib/zbook/code/zswap.F
deleted file mode 100644
index db69e02..0000000
--- a/src/packlib/zbook/code/zswap.F
+++ /dev/null
@@ -1,105 +0,0 @@
-*
-* $Id: zswap.F,v 1.1.1.1 1996/03/08 12:01:13 mclareni Exp $
-*
-* $Log: zswap.F,v $
-* Revision 1.1.1.1 1996/03/08 12:01:13 mclareni
-* Zbook
-*
-*
-#include "zbook/pilot.h"
- SUBROUTINE ZSWAP(IZ,IDA,IDB)
-C
-C ******************************************************************
-C * *
-C * INTERCHANGE BANKS IDA AND IDB *
-C * *
-C ******************************************************************
-C
- DIMENSION IZ(1),IDA(1),IDB(1)
- LOGICAL ZIDOK
-C
-C ------------------------------------------------------------------
-C
- ID1 = IDA(1)
- ID2 = IDB(1)
- JZ = IZ(1)
- JZ16 = IZ(JZ + 16)
-C
-C CHECK IF ID1 IS A VALID POINTER
-C
- IF (ZIDOK(IZ,ID1)) GO TO 21
- ID1 = 0
-C
-C CHECK IF ID2 IS A VALID POINTER
-C
- 21 IF (ZIDOK(IZ,ID2)) GO TO 31
- ID2 = 0
-C
-C DO THE SWAPING OF THE BANKS
-C
- 31 CONTINUE
- IF (ID1.EQ.0 .AND. ID2.EQ.0) GO TO 999
- IF (ID1.EQ.0) GO TO 101
- L1 = IZ(ID1)
- ILST1 = ID1 + L1 + 2
- NID1 = IZ(ILST1)
- 101 CONTINUE
- IF (ID2.EQ.0) GO TO 102
- L2 = IZ(ID2)
- ILST2 = ID2 + L2 + 2
- NID2 = IZ(ILST2)
- 102 CONTINUE
- IDA(1) = ID2
- IDB(1) = ID1
- IF (ID1.EQ.0.OR.ID2.EQ.0) GO TO 103
- IZ(ILST1) = NID2
- IZ(ILST2) = NID1
- IZ(NID1) = ID2
- IZ(NID2) = ID1
- 103 IF (ID1.NE.0) GO TO 104
- IZ(ILST2) = LOCF(IDA(1)) + JZ16 + 1
- IZ(JZ + 12) = MIN0(IZ(ILST2),IZ(JZ + 12))
- IZ(JZ + 13) = MAX0(IZ(ILST2),IZ(JZ + 13))
- IZ(NID2) = 0
- 104 IF (ID2.NE.0) GO TO 105
- IZ(ILST1) = LOCF(IDB(1)) + JZ16 + 1
- IZ(JZ + 12) = MIN0(IZ(ILST1),IZ(JZ + 12))
- IZ(JZ + 13) = MAX0(IZ(ILST1),IZ(JZ + 13))
- IZ(NID1) = 0
-C
-C UPDATE LOCAL POINTERS
-C
- 105 JLOC = IZ(JZ - 1)
- IF (JLOC.EQ.0) GO TO 999
- NLOC = IZ(JLOC) - 2
- IF (NLOC.LE.0) GO TO 999
-C
- DO 211 I = 1,NLOC
- JL = IZ(JLOC + I)
- IF (JL.EQ.0) GO TO 211
- NL = IZ(JL)
- IF (NL.LE.0) GO TO 211
-C
- DO 212 J = 1,NL
- IF (IZ(JL + J).EQ.0) GO TO 212
- IF (IZ(JL + J).EQ.ID1) IZ(JL + J) = - ID2
- IF (IZ(JL + J).EQ.ID2) IZ(JL + J) = - ID1
- 212 CONTINUE
-C
- 211 CONTINUE
-C
- DO 221 I = 1,NLOC
- JL = IZ(JLOC + I)
- IF (JL.EQ.0) GO TO 221
- NL = IZ(JL)
- IF (NL.LE.0) GO TO 221
-C
- DO 222 J = 1,NL
- IF (IZ(JL + J).LT.0) IZ(JL + J) = - IZ(JL + J)
- 222 CONTINUE
-C
- 221 CONTINUE
-C
- 999 RETURN
-C
- END
diff --git a/src/packlib/zbook/code/ztoibm.F b/src/packlib/zbook/code/ztoibm.F
deleted file mode 100644
index 14165d9..0000000
--- a/src/packlib/zbook/code/ztoibm.F
+++ /dev/null
@@ -1,88 +0,0 @@
-*
-* $Id: ztoibm.F,v 1.1.1.1 1996/03/08 12:01:13 mclareni Exp $
-*
-* $Log: ztoibm.F,v $
-* Revision 1.1.1.1 1996/03/08 12:01:13 mclareni
-* Zbook
-*
-*
-#include "zbook/pilot.h"
- SUBROUTINE ZTOIBM(IA,N,MODE)
-C
-C ******************************************************************
-C * *
-C * CONVERTS N WORDS OF ARRAY A IN MACHINE INDEPENDENT *
-C * FORMAT *
-C * *
-C * MODE=0 BIT STRING *
-C * MODE=1 INTEGER 16 BITS *
-C * MODE=2 INTEGER 32 BITS *
-C * MODE=3 FLOATING POINTS IBM FORMAT *
-C * MODE=4 ALPHANUMERIC TO INTEGER *
-C * MODE=5 UNSIGNED INTEGER 16 BITS *
-C * MODE=6 UNSIGNED 32 BITS INTEGER *
-C * MODE=7 MIXTURE OF FLOATING AND INTEGERS *
-C * *
-C ******************************************************************
-C
- DIMENSION NUM(40),JJ(4),LL(4),IA(1)
-C
- DATA NCHARS/40/
- DATA IFIRST/0/
-C
-C ------------------------------------------------------------------
-C
- IF (N.LE.0) GO TO 99
- IF (MODE.EQ.4) GO TO 10
- IF (MODE.EQ.7) GO TO 40
-C
- CALL CTOIBM(IA,N,MODE)
- GO TO 99
-C
- 10 IF(IFIRST.EQ.0)THEN
- IFIRST = 1
- CALL UCTOH1(' 1234567890ABCDEFGHIJKLMNOPQRSTUVWXYZ*+-'
- + ,NUM(1),NCHARS)
- ENDIF
-C
- DO 30 I = 1,N
-C
- CALL UBLOW(IA(I),LL,4)
-C
- DO 20 K = 1,4
- JJ(K) = IUCOMP(LL(K),NUM(1),NCHARS)
- IF (JJ(K).EQ.0) JJ(K) = 1
- 20 CONTINUE
-C
- IJ = JJ(1)
-C
- CALL SBYT(JJ(2),IJ, 9,8)
- CALL SBYT(JJ(3),IJ,17,8)
- CALL SBYT(JJ(4),IJ,25,8)
-C
- IA(I) = IJ
- 30 CONTINUE
- GO TO 99
-C
- 40 NOLD = 0
-C
- DO 70 I = 1,N
- IF (IABS(IA(I)).GE.2**23) GO TO 60
-C
- IF (NOLD.EQ.0) GO TO 50
- CALL CTOIBM(IA(LAST),NOLD,3)
- NOLD = 0
-C
- 50 K = IA(I)
- IF (K.LT.0)K = - K + 2**22
- IA(I) = K
- GO TO 70
-C
- 60 IF (NOLD.EQ.0)LAST = I
- NOLD = NOLD + 1
- 70 CONTINUE
-C
- IF(NOLD.NE.0) CALL CTOIBM(IA(LAST),NOLD,3)
-C
- 99 RETURN
- END
diff --git a/src/packlib/zbook/code/ztrap.F b/src/packlib/zbook/code/ztrap.F
deleted file mode 100644
index a55a1c9..0000000
--- a/src/packlib/zbook/code/ztrap.F
+++ /dev/null
@@ -1,55 +0,0 @@
-*
-* $Id: ztrap.F,v 1.1.1.1 1996/03/08 12:01:13 mclareni Exp $
-*
-* $Log: ztrap.F,v $
-* Revision 1.1.1.1 1996/03/08 12:01:13 mclareni
-* Zbook
-*
-*
-#include "zbook/pilot.h"
-#if defined(CERNLIB_SINGLE)||defined(CERNLIB_DOUBLE)||defined(CERNLIB_UNIVAC)||defined(CERNLIB_BESM6)
- SUBROUTINE ZTRAP(IZ,IUSER)
-C
-C ******************************************************************
-C * *
-C * STORE ADDRESS OF RECOVERY ROUTINE *
-C * *
-C ******************************************************************
-C
- DIMENSION IZ(1)
-#if defined(CERNLIB_CDC)||defined(CERNLIB_UNIVAC)||defined(CERNLIB_UNIX)
- EXTERNAL IUSER
-#endif
-C
-C ------------------------------------------------------------------
-C
- JZ = IZ(1)
-#if (defined(CERNLIB_APOLLO))&&(!defined(CERNLIB_UNIX))
- IZ(JZ+19) = IADDR(IUSER)
-#endif
-#if defined(CERNLIB_CDC)
- IZ(JZ+19) = LOCF(IUSER)
-#endif
-#if defined(CERNLIB_IBM)
- IZ(JZ+19) = IUSER
-#endif
-#if defined(CERNLIB_NORD)
- IZ(JZ+19) = IUSER
-#endif
-#if defined(CERNLIB_CRAY)
- IZ(JZ+19) = LOC(IUSER)
-#endif
-#if defined(CERNLIB_UNIVAC)
- IZ(JZ+19) = LOCF(IUSER)
-#endif
-#if defined(CERNLIB_VAX)
- IZ(JZ+19) = %LOC(IUSER)
-#endif
-#if defined(CERNLIB_BESM6)
- IZ(JZ+19) = LOCF(IUSER)
-#endif
-#if defined(CERNLIB_UNIX)
- IZ(JZ+19) = LOCB(IUSER)
-#endif
- END
-#endif
diff --git a/src/packlib/zbook/code/zuploc.F b/src/packlib/zbook/code/zuploc.F
deleted file mode 100644
index e11e395..0000000
--- a/src/packlib/zbook/code/zuploc.F
+++ /dev/null
@@ -1,44 +0,0 @@
-*
-* $Id: zuploc.F,v 1.1.1.1 1996/03/08 12:01:13 mclareni Exp $
-*
-* $Log: zuploc.F,v $
-* Revision 1.1.1.1 1996/03/08 12:01:13 mclareni
-* Zbook
-*
-*
-#include "zbook/pilot.h"
- SUBROUTINE ZUPLOC(IZ,IFIRST,ILAST,NP)
-C
-C ******************************************************************
-C * *
-C * UPDATE USER LOCAL POINTERS POINTING IN *
-C * THE AREA IZ(IFIRST)---> IZ(ILAST) *
-C * *
-C ******************************************************************
-C
- DIMENSION IZ(1)
-C
-C ------------------------------------------------------------------
-C
- JZ = IZ(1)
- JLOC = IZ(JZ - 1)
- NLOC = IZ(JLOC) - 2
- IF (NLOC.LE.0) GO TO 99
-C
- NPUSH = NP
- DO 20 I = 1,NLOC
- JL = IZ(JLOC + I)
- IF (JL.EQ.0) GO TO 20
- NL = IZ(JL)
- IF (NL.LE.0) GO TO 20
-C
- DO 10 J = 1,NL
- IF (IZ(JL + J).LT.IFIRST) GO TO 10
- IF (IZ(JL + J).GT.ILAST) GO TO 10
- IF (NPUSH.NE.0)IZ(JL + J) = IZ(JL + J) + NPUSH
- IF (NPUSH.EQ.0)IZ(JL + J) = 0
- 10 CONTINUE
- 20 CONTINUE
-C
- 99 RETURN
- END
diff --git a/src/packlib/zbook/code/zuser.F b/src/packlib/zbook/code/zuser.F
deleted file mode 100644
index 1507748..0000000
--- a/src/packlib/zbook/code/zuser.F
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: zuser.F,v 1.1.1.1 1996/03/08 12:01:13 mclareni Exp $
-*
-* $Log: zuser.F,v $
-* Revision 1.1.1.1 1996/03/08 12:01:13 mclareni
-* Zbook
-*
-*
-#include "zbook/pilot.h"
- SUBROUTINE ZUSER(IZ,I,KEY,ID)
-C
-C ******************************************************************
-C * *
-C * DUMMY ROUTINE CALLED BY ZERROR *
-C * CAN BE ACTIVATED BY THE USER *
-C * *
-C ******************************************************************
-C
- RETURN
- END
diff --git a/src/packlib/zbook/code/zwork.F b/src/packlib/zbook/code/zwork.F
deleted file mode 100644
index 83bda4f..0000000
--- a/src/packlib/zbook/code/zwork.F
+++ /dev/null
@@ -1,43 +0,0 @@
-*
-* $Id: zwork.F,v 1.1.1.1 1996/03/08 12:01:13 mclareni Exp $
-*
-* $Log: zwork.F,v $
-* Revision 1.1.1.1 1996/03/08 12:01:13 mclareni
-* Zbook
-*
-*
-#include "zbook/pilot.h"
- SUBROUTINE ZWORK(IZ,IWORK)
-C
-C ******************************************************************
-C * *
-C * RESERVES IWORK WORDS OF WORKING SPACE *
-C * *
-C ******************************************************************
-C
- DIMENSION IZ(1)
-C
-C ------------------------------------------------------------------
-C
- JZ = IZ(1)
- IZ(JZ + 6) = 0
- N = IWORK - IZ(JZ + 2)
- IF (N.EQ.0) GO TO 99
- IF (N.LE.IZ(JZ + 1)) GO TO 10
- CALL ZGARB(IZ)
- IF (N.LE.IZ(JZ + 1)) GO TO 10
- NMOVE = N - IZ(JZ + 1) + 1
- CALL ZMOVE(IZ,NMOVE)
- IF (N.LE.IZ(JZ + 1)) GO TO 10
- CALL ZERROR(IZ,100,'ZWORK ',0)
- RETURN
-C
- 10 IOLD = IZ(JZ + 3) + IZ(JZ + 2) + 2
- IZ(JZ + 2) = IWORK
- IZLAST = IZ(JZ + 15)
- IZ(1) = JZ + N
-C
- CALL ZSHIFT(IZ,IOLD,IZLAST,N,'ZWORK ')
-C
- 99 RETURN
- END
diff --git a/src/packlib/zbook/code/zwrite.F b/src/packlib/zbook/code/zwrite.F
deleted file mode 100644
index f2b741b..0000000
--- a/src/packlib/zbook/code/zwrite.F
+++ /dev/null
@@ -1,285 +0,0 @@
-*
-* $Id: zwrite.F,v 1.1.1.1 1996/03/08 12:01:13 mclareni Exp $
-*
-* $Log: zwrite.F,v $
-* Revision 1.1.1.1 1996/03/08 12:01:13 mclareni
-* Zbook
-*
-*
-#include "zbook/pilot.h"
- SUBROUTINE ZWRITE(IZ,ID,LUN,KEYI)
-C
-C ******************************************************************
-C * *
-C * BANK WITH POINTER ID IS COPIED ONTO MASS STORAGE *
-C * IF ID ALREADY EXISTS ON LUN THEN IT IS SCRATCHED *
-C * AND RECREATED *
-C * *
-C ******************************************************************
-C
- DIMENSION IZ(1),ID(1)
- DIMENSION KD(51),NK(51)
- LOGICAL ZIDOK
-C
- DATA MAXLEV/50/
-C
-C ------------------------------------------------------------------
-C
- JZ = IZ(1)
- KEY = KEYI
- IZ(JZ + 6) = 0
- JD = IZ(JZ - 2)
- IF (JD.LE.0) GO TO 900
- N = IZ(JD) - 2
- NLUN = 1
- 10 IF (IZ(JD + NLUN).EQ.LUN) GO TO 20
- NLUN = NLUN + 1
- IF (NLUN.LE.N) GO TO 10
- GO TO 900
-C
- 20 JDIR = IZ(JD - NLUN)
- IF (.NOT.ZIDOK(IZ,ID)) GO TO 310
- IZ(JDIR + 10) = 1
- IPUSH=0
- NXBUF = IZ(JDIR + 3)
- IDATA=ID(1)
- ND=IZ(IDATA)
- NID=IZ(IDATA+ND+2)
- NLINK=IZ(IDATA+ND+1)
- IF (IZ(JZ + 5).LE.0) GO TO 25
- IF (IZ(JZ + 1).GT.42 + 2 * NXBUF) GO TO 25
-C
-C PERFORM GARBAGE COLLECTION
-C
- IZ(JZ + 18) = NID
- CALL ZGARB(IZ)
- NID = IZ(JZ + 18)
- IDATA=IZ(NID)
- JD = IZ(JZ - 2)
- JDIR = IZ(JD - NLUN)
-C
- 25 IF (NLINK.EQ.0) GO TO 60
-C
-C BANK IS A TREE COMPUTE TOTAL NUMBER OF WORDS
-C
- CALL ZBOOKN(IZ,IZ(JZ-5),NXBUF,0,'*BUF',1)
- JBUF=IZ(JZ-5)
- IF (JBUF.EQ.0) GO TO 999
-C
- ND = 0
- I = 1
- KD(I)=IDATA
- KDI = KD(I)
- NDATA=IZ(KDI)
- IL=KDI+NDATA+1
- NID = IZ(IL + 1)
- IF (NID.LT.IZ(JZ + 12)) GO TO 330
- IF (NID.GT.IZ(JZ + 13)) GO TO 330
- NK(I) = IZ(IL)
- IFIRST = KDI - NK(I) - 1
- ND = ND + IZ(IFIRST)
- IF (NK(I).LE.0) GO TO 60
- 30 KDI = KD(I)
- NLI = NK(I)
- KD(I + 1) = IZ(KDI - NLI)
- IF (KD(I + 1).NE.0) GO TO 50
- 40 NK(I) = NK(I) - 1
- IF (NK(I).NE.0) GO TO 30
- I = I - 1
- IF (I.LE.0) GO TO 60
- GO TO 40
- 50 KDI = KD(I + 1)
- NDATA=IZ(KDI)
- IL=KDI+NDATA+1
- NID = IZ(IL + 1)
- IF (NID.LT.IZ(JZ + 12)) GO TO 330
- IF (NID.GT.IZ(JZ + 13)) GO TO 330
- NK(I + 1) = IZ(IL)
- IFIRST = KDI - NK(I + 1) - 1
- ND = ND + IZ(IFIRST)
- IF (NK(I + 1).LE.0) GO TO 40
- I = I + 1
- IF (I.GT.MAXLEV) GO TO 320
- GO TO 30
-C
- 60 NR = (ND - 1 + NXBUF) / NXBUF
-C
- CALL ZSEARC(IZ,NLUN,KEY,LOC)
- IF (LOC.LE.0) GO TO 80
-C
-C ID ALREADY EXISTING SCRATCH IF DIFFERENT SPACE
-C UNLESS JUST REPLACE
-C
- IF = IZ(LOC + 1)
- NW = IABS(IZ(LOC + 2))
- NROLD = (NW + NXBUF - 1) / NXBUF
- IF (NROLD.EQ.NR) GO TO 180
- IF (IF.LT.IZ(JDIR + 8))IZ(JDIR + 8) = IF
-C
- DO 70 I = 1,NROLD
- 70 IZ(JDIR + 9 + IF + I) = 0
- IZ(JDIR + 7) = IZ(JDIR + 7) + NROLD
- IF (IZ(JDIR + 7).LT.NR) GO TO 300
- GO TO 120
-C
-C INSERTS ID IN THE IDS TABLE
-C
- 80 LOC = - LOC
- IF (IZ(JDIR + 7).LT.NR) GO TO 300
- IF (IZ(JDIR + 6).GT.0) GO TO 90
- IF(IDATA.GT.JDIR)IDATA=IDATA+30
- IPUSH=1
- NIDPAR=LOCF(ID(1))+IZ(JZ+16)+1
- CALL ZPUSHS(IZ,JDIR,30,0)
- JBUF=IZ(JZ-5)
- IF (IZ(JZ + 6).NE.0) GO TO 999
- IZ(JDIR + 6) = IZ(JDIR + 6) + 10
-C
- 90 N = IZ(JDIR + 5) + JDIR - LOC
- IF (N.EQ.0) GO TO 110
- DO 100 I = 1,N
- 100 IZ(LOC + N - I + 3) = IZ(LOC + N - I)
- 110 IZ(JDIR + 5) = IZ(JDIR + 5) + 3
- IZ(JDIR + 6) = IZ(JDIR + 6) - 1
-C
-C SEARCH FOR NR CONSECUTIVE RECORDS
-C
- 120 IF = IZ(JDIR + 8)
- 130 N = 1
- DO 140 I = 1,NR
- IF (IZ(JDIR + 9 + IF + I).NE.0) GO TO 150
- N = N + 1
- 140 CONTINUE
- GO TO 160
-C
- 150 IF = IF + N
- IF (IF + NR.LE.IZ(JDIR + 2)) GO TO 130
-C
-C GARBAGE COLLECTION NECESSARY
-C
- CALL ZDGARB(IZ,NLUN)
-C
- IF (IZ(JDIR + 2) - IZ(JDIR + 8).LT.NR - 1) GO TO 999
- GO TO 120
-C
- 160 IZ(LOC) = KEY
- IZ(LOC + 1) = IF
- IF(IPUSH.EQ.0)GO TO 165
- IF(NIDPAR.EQ.NID)GO TO 165
- ID(1)=IDATA
-C
- 165 IF (IZ(JDIR + 8).EQ.IF)IZ(JDIR + 8) = IF + NR
- IZ(JDIR + 7) = IZ(JDIR + 7) - NR
- DO 170 I = 1,NR
- 170 IZ(JDIR + 9 + IF + I) = KEY
-C
- 180 IF (NLINK.NE.0) GO TO 190
- IZ(LOC + 2) = ND
-C
-C NOW WRITE BANK ONTO MASS STORAGE
-C
- CALL ZIODO(LUN,IF,NXBUF,IZ(IDATA+1),ND,2)
-C
- GO TO 999
-C
-C NOW WRITE TREE
-C
- 190 IZ(LOC + 2) = - ND
-C
- IREC = 0
- IPBUF = 0
- IPZBK = 0
- NWBUF = NXBUF
- I = 1
- KD(I)=IDATA
- KDI = KD(I)
- NDATA=IZ(KDI)
- IL=KDI+NDATA+1
- NK(I) = IZ(IL)
- IFIRST = KDI - NK(I) - 1
- ND = IZ(IFIRST)
- NWZBK = ND
- 200 IF (NWBUF.GT.NWZBK) GO TO 210
- IREC = IREC + 1
- CALL UCOPY(IZ(IFIRST+IPZBK),IZ(JBUF+IPBUF+1),NWBUF)
- CALL ZIODO(LUN,IF+IREC-1,NXBUF,IZ(JBUF+1),NXBUF,2)
- IPZBK = IPZBK + NWBUF
- NWZBK = NWZBK - NWBUF
- IPBUF = 0
- NWBUF = NXBUF
- IF (NWZBK.EQ.0) GO TO 220
- GO TO 200
- 210 CALL UCOPY(IZ(IFIRST+IPZBK),IZ(JBUF+IPBUF+1),NWZBK)
- IPBUF = IPBUF + NWZBK
- NWBUF = NWBUF - NWZBK
- 220 IPZBK = 0
- IF (NK(I).LE.0) GO TO 290
- 230 KDI = KD(I)
- NLI = NK(I)
- KD(I + 1) = IZ(KDI - NLI)
- IF (KD(I + 1).NE.0) GO TO 250
- 240 NK(I) = NK(I) - 1
- IF (NK(I).NE.0) GO TO 230
- I = I - 1
- IF (I.LE.0) GO TO 290
- GO TO 240
- 250 KDI = KD(I + 1)
- NDATA=IZ(KDI)
- IL=KDI+NDATA+1
- NK(I + 1) = IZ(IL)
- IFIRST = KDI - NK(I + 1) - 1
- ND = IZ(IFIRST)
- NWZBK = ND
- 260 IF (NWBUF.GT.NWZBK) GO TO 270
- IREC = IREC + 1
- CALL UCOPY(IZ(IFIRST+IPZBK),IZ(JBUF+IPBUF+1),NWBUF)
- CALL ZIODO(LUN,IF+IREC-1,NXBUF,IZ(JBUF+1),NXBUF,2)
- IPZBK = IPZBK + NWBUF
- NWZBK = NWZBK - NWBUF
- IPBUF = 0
- NWBUF = NXBUF
- IF (NWZBK.EQ.0) GO TO 280
- GO TO 260
- 270 CALL UCOPY(IZ(IFIRST+IPZBK),IZ(JBUF+IPBUF+1),NWZBK)
- IPBUF = IPBUF + NWZBK
- NWBUF = NWBUF - NWZBK
- 280 IPZBK = 0
- IF (NK(I + 1).LE.0) GO TO 240
- I = I + 1
- IF (I.GT.MAXLEV) GO TO 320
- GO TO 230
-C
- 290 IREC = IREC + 1
- IF(IPBUF.GT.0) CALL ZIODO(LUN,IF+IREC-1,NXBUF,IZ(JBUF+1),
- + IPBUF,2)
-C
- CALL ZDELET(IZ,JBUF)
-C
- GO TO 999
-C
-C NO MORE SPACE ON MASS STORAGE
-C
- 300 CALL ZERROR(IZ,600,'ZWRITE',ID)
- GO TO 999
-C
-C ID DOES NOT EXIST
-C
- 310 CALL ZERROR(IZ,300,'ZWRITE',ID)
- GO TO 999
-C
-C LEVEL TOO HIGH
-C
- 320 CALL ZERROR(IZ,800,'ZWRITE',ID)
- GO TO 999
-C
-C ERROR IN STRUCTURE
-C
- 330 CALL ZERROR(IZ,400,'ZWRITE',ID)
- GO TO 999
-C
-C UNDEFINED OUTPUT UNIT
-C
- 900 CALL ZERROR(IZ,900,'ZWRITE',ID)
-C
- 999 RETURN
- END
diff --git a/src/packlib/zbook/obsolete/assembler/zjumpbe.s b/src/packlib/zbook/obsolete/assembler/zjumpbe.s
deleted file mode 100644
index 0242812..0000000
--- a/src/packlib/zbook/obsolete/assembler/zjumpbe.s
+++ /dev/null
@@ -1,15 +0,0 @@
-*
-* $Id: zjumpbe.s,v 1.1.1.1 1996/03/08 12:01:16 mclareni Exp $
-*
-* $Log: zjumpbe.s,v $
-* Revision 1.1.1.1 1996/03/08 12:01:16 mclareni
-* Zbook
-*
-*
-#if defined(CERNLIB_BESM6)
- ZJUMP : , NAME ,
- , STI , 8
- 8 , WTC ,
- , UJ ,
- , END ,
-#endif
diff --git a/src/packlib/zbook/obsolete/assembler/zjumpcd.s b/src/packlib/zbook/obsolete/assembler/zjumpcd.s
deleted file mode 100644
index baff689..0000000
--- a/src/packlib/zbook/obsolete/assembler/zjumpcd.s
+++ /dev/null
@@ -1,58 +0,0 @@
-*
-* $Id: zjumpcd.s,v 1.1.1.1 1996/03/08 12:01:16 mclareni Exp $
-*
-* $Log: zjumpcd.s,v $
-* Revision 1.1.1.1 1996/03/08 12:01:16 mclareni
-* Zbook
-*
-*
-#if defined(CERNLIB_CDC)
- IDENT ZJUMP
- TITLE ZJUMP - CALL TO ZBOOK RECOVERY ROUTINE
- COMMENT CALL TO ZBOOK RECOVERY ROUTINE
-*****
-*
-* CALLING SEQUENCE - CALL ZJUMP(ADR,P1,P2,.....,PN)
-*
-* ROUTINE WILL PERFORM RETURN JUMP TO THE RECOVERY ROUTINE
-* WITH THE ENTRY POINT ADDRESS GIVEN IN THE 1-ST PARAMETER (ADR).
-* THE PARAMETERS (P1,...,PN) WILL BE TRANSMITED AS THE
-* PARAMETERS TO THE RECOVERY ROUTINE.
-*
-* THE PARAMETER ADR MUST BE CALCULATED USING THE CALL
-* TO THE FUNCTION LOCF IN THE CALLING ROUTINE
-* (RECOVER MUST BE DECLARED EXTERNAL).
-*
-* ADR = LOCF(RECOVER)
-*
-* IN THE CALLING ROUTINE AND RECOVER MUST BE DECLARED EXTERNAL.
-*
-* FTN4 CALLING CONVENTIONS
-*
-* W.W. 20/05/81
-*
-*****
- ENTRY ZJUMP
- TRACE VFD 42/0HZJUMP,18/ZJUMP
- ZJUMP EQ *+1S17 .ENTRY/EXIT
-* .ASSUMING FTN4 CONVENTIONS,
-* .ADDRESS OF THE 1-ST PARAM. IN X1
- SA2 X1 .GET ADDRESS OF THE 1-ST PARAM.
- SA5 CALL .LOAD RJ INSTRUCTION INTO THE X5
- SX0 X2 .GET BITS 0-17 OF THE 1-ST PARAM. INTO X0
- MX7 -18 .FORM MASK IN X7
- LX0 30 .SHIFT ADDRESS IN X0
- LX7 30 .SHIFT MASK IN X7
- BX4 X7*X5 .FORCE ZERO INTO ADDRESS PART OF RJ
- SB1 1 .B1=1
- BX6 X4+X0 .PUT THE ADDRESS FROM X0 INTO RJ
- SA1 A1+B1 .PREPARE ADDRESS OF PARAM. LIST
- SA6 CALL .SAVE RJ INTO HIS PLACE
- + RJ TRICK .THIS IS THE TRICKY CALL,
-* .FOR CLEARING THE STACK.
- TRICK BSSZ 1
- CALL RJ CALL .THIS WILL DO THE JOB......
- - VFD 12/0,18/TRACE
- EQ ZJUMP .THE JOB IS DONE, RETURN......
- END
-#endif
diff --git a/src/packlib/zbook/obsolete/assembler/zjumppr.s b/src/packlib/zbook/obsolete/assembler/zjumppr.s
deleted file mode 100644
index e293826..0000000
--- a/src/packlib/zbook/obsolete/assembler/zjumppr.s
+++ /dev/null
@@ -1,52 +0,0 @@
-*
-* $Id: zjumppr.s,v 1.1.1.1 1996/03/08 12:01:16 mclareni Exp $
-*
-* $Log: zjumppr.s,v $
-* Revision 1.1.1.1 1996/03/08 12:01:16 mclareni
-* Zbook
-*
-*
-#if defined(CERNLIB_PR1ME)
-*---
-*
-* ZJUMP , V01.00 14/03/83 WW -64V MODE-
-*
-* CALLING SEQUENCE (FORTRAN):
-*
-* CALL ZJUMP(IZ(JZ+19),A1,A2,A3,A4)
-*
-* THIS ROUTINE IS CALLED FROM ZERROR (BY ZBOOK SYSTEM)
-*
-*---
- ENT ZJUMP,ZJMP1 ENTRY DECLARATION
-*
- SEG 64V-MODE SEGMENTED ADDRESSING
-*
-ZJUMP EQU * ECB CAUSES CONTROL TO BE PASSED HERE ON CALL
- ARGT TRANSFER POINTERS TO ARGUMENTS
-*
- LDL AADR,*
- STL LADR
-*
-*---PERFORM CALL TO RECOVERY ROUTINE
- PCL LADR,*
-*
-*---CREATE THE ARGUMENT LIST
- AP BADR,*S
- AP CADR,*S
- AP DADR,*S
- AP EADR,*SL
-*
-*---RETURN FROM THE ROUTINE
- PRTN
-*
- DYNM AADR(3),BADR(3),CADR(3),DADR(3),EADR(3)
-*
- LINK
-LADR OCT 0
- OCT 0
-*
-ZJMP1 ECB ZJUMP,,AADR,5
-*
- END
-#endif
diff --git a/src/packlib/zbook/obsolete/assembler/ztrpass.s b/src/packlib/zbook/obsolete/assembler/ztrpass.s
deleted file mode 100644
index eaad1c1..0000000
--- a/src/packlib/zbook/obsolete/assembler/ztrpass.s
+++ /dev/null
@@ -1,47 +0,0 @@
-*
-* $Id: ztrpass.s,v 1.1.1.1 1996/03/08 12:01:16 mclareni Exp $
-*
-* $Log: ztrpass.s,v $
-* Revision 1.1.1.1 1996/03/08 12:01:16 mclareni
-* Zbook
-*
-*
-#if defined(CERNLIB_PR1ME)
-*---
-*
-* ZTRAP , V01.00 14/03/83 WW -64V MODE-
-*
-* CALLING SEQUENCE (FORTRAN):
-*
-* CALL ZTRAP(IZ,RECOVER)
-*
-* THIS IS USER ROUTINE , RECOVER HAS TO BE DECLARED EXTERNAL
-*
-*---
- ENT ZTRAP,ZTRP1 ENTRY DECLARATION
-*
- SEG 64V-MODE SEGMENTED ADDRESSING
- RLIT PLACE LITERALS IN PROCEDURE FRAME
-*
-ZTRAP EQU * ECB CAUSES CONTROL TO BE PASSED HERE ON CALL
- ARGT TRANSFER POINTERS TO ARGUMENTS
-*
- LDL AADR,*
- LLS 1
- ADL AADR
- STL STACK
- LDL BADR,* F77 CONVENTION FOR PASSING EXTERNALS
- LDX =36
- STL STACK,*X
-*
-*---RETURN FROM THE ROUTINE
- PRTN
-*
- DYNM AADR(3),BADR(3),STACK(2)
-*
- LINK
-*
-ZTRP1 ECB ZTRAP,,AADR,2
-*
- END
-#endif
diff --git a/src/packlib/zbook/obsolete/zjumpap.F b/src/packlib/zbook/obsolete/zjumpap.F
deleted file mode 100644
index 5469889..0000000
--- a/src/packlib/zbook/obsolete/zjumpap.F
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: zjumpap.F,v 1.1.1.1 1996/03/08 12:01:16 mclareni Exp $
-*
-* $Log: zjumpap.F,v $
-* Revision 1.1.1.1 1996/03/08 12:01:16 mclareni
-* Zbook
-*
-*
-#include "zbook/pilot.h"
-#if (defined(CERNLIB_APOLLO))&&(!defined(CERNLIB_UNIX))
- SUBROUTINE ZJUMP (NAME,P1,P2,P3,P4)
- DIMENSION P1(*),P2(*),P3(*),P4(*)
- INTEGER*4 IPOINT
- POINTER /IPOINT/ M
-C
- IPOINT=NAME
- CALL ZJUMP2(M,P1,P2,P3,P4)
- END
- SUBROUTINE ZJUMP2(SUBR,P1,P2,P3,P4)
- EXTERNAL SUBR
- DIMENSION P1(*),P2(*),P3(*),P4(*)
-C
- CALL SUBR(P1,P2,P3,P4)
- END
-#endif
diff --git a/src/packlib/zbook/obsolete/zjumpcr.F b/src/packlib/zbook/obsolete/zjumpcr.F
deleted file mode 100644
index d8c67f2..0000000
--- a/src/packlib/zbook/obsolete/zjumpcr.F
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: zjumpcr.F,v 1.1.1.1 1996/03/08 12:01:16 mclareni Exp $
-*
-* $Log: zjumpcr.F,v $
-* Revision 1.1.1.1 1996/03/08 12:01:16 mclareni
-* Zbook
-*
-*
-#include "zbook/pilot.h"
-#if defined(CERNLIB_CRAY)
- SUBROUTINE ZJUMP (NAME,P1,P2,P3,P4)
- DIMENSION P1(*),P2(*),P3(*),P4(*)
- POINTER (IPOINT,M)
-C
- IPOINT=NAME
- CALL ZJUMP2(M,P1,P2,P3,P4)
- END
- SUBROUTINE ZJUMP2(SUBR,P1,P2,P3,P4)
- DIMENSION P1(*),P2(*),P3(*),P4(*)
-C
- CALL SUBR(P1,P2,P3,P4)
- END
-#endif
diff --git a/src/packlib/zbook/obsolete/zunivac/fastio.s b/src/packlib/zbook/obsolete/zunivac/fastio.s
deleted file mode 100644
index 5bc65c6..0000000
--- a/src/packlib/zbook/obsolete/zunivac/fastio.s
+++ /dev/null
@@ -1,57 +0,0 @@
-*
-* $Id: fastio.s,v 1.1.1.1 1996/03/08 12:01:16 mclareni Exp $
-*
-* $Log: fastio.s,v $
-* Revision 1.1.1.1 1996/03/08 12:01:16 mclareni
-* Zbook
-*
-*
-#if defined(CERNLIB_UNIVAC)
- . SUBROUTINE FIOR/W/SCR/GW('FILENAME',BUFFERADR,NWORDS,STARTADR,STATUS)
- . CODED BY B.S.NILSSON, NBI, COPENHAGEN 1977-05-13
- . THOROUGH REVISION MADE ON 1980-03-12
- . THIS IS A F T N VERSION REQUIRING FILENAME IN FIELDATA CODE
- .
- AXR$ .
-$(0),IOPKT I$OD ' ',0 0,0 0 . I/O PACKET
-$(1),FIOSCR* LA,U A3,SCR$ . SCATTER READ ENTRY
- J ALL .
-FIOGW* LA,U A3,GW$ . GATHER WRITE ENTRY
- J ALL .
-FIOR* LA,U A3,R$ . READ ENTRY
- J ALL .
-FIOW* LA,U A3,W$ . WRITE ENTRY
-ALL LA,U A2,IOPKT . (IOPKT) IN A2
- SA,S2 A3,3,A2 .
- LA A3,A0 . SAVE A0 IN A3
- LA A1,0,A0 .
- SFS 1,A2 . SET BLANKS IN 2ND HALF OF FILENAME
- DL A4,0,A1 .
- SA A4,0,A2 . FILENAME FIRST WORD
- LA,S6 A4,0,A2 . CHECK FOR BLANK IN 6TH CHAR
- TNE,U A4,05 .
- J CONT .
- LA A4,A5 .
- SSL A4,30 . CHECK FOR 7TH CHARACTER BLANK
- TNE,U A4,05 .
- J CONT .
- TE,U A4,077 . CHECK 7TH CHARACTER FOR STOPCODE
- SA A5,1,A2 . NO, STORE FILENAME SECOND WORD
-CONT LA A1,1,A0 .
- SA,H2 A1,4,A2 . BUFFER ADDRESS
- LA A1,2,A0 .
- LA A4,0,A1 .
- SA,H1 A4,4,A2 . NUMBER OF WORDS
- LA A1,3,A0 .
- LA A4,0,A1 .
- SA A4,5,A2 . START ADDRESS
- LA A0,A2 . MAKE I/O ER
- ER IOW$ .
- LNA,S1 A4,3,A2 . GET STATUS
- JNZ A4,$+2 . EVERYTHING OK ?
- LA,H2 A4,3,A2 . YES, STATUS = # OF WORDS
- LA A0,4,A3 .
- SA A4,0,A0 .
- J 0,X11 . RETURN
- END .
-#endif
diff --git a/src/packlib/zbook/obsolete/zunivac/noargz.F b/src/packlib/zbook/obsolete/zunivac/noargz.F
deleted file mode 100644
index 64bcd4a..0000000
--- a/src/packlib/zbook/obsolete/zunivac/noargz.F
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: noargz.F,v 1.1.1.1 1996/03/08 12:01:16 mclareni Exp $
-*
-* $Log: noargz.F,v $
-* Revision 1.1.1.1 1996/03/08 12:01:16 mclareni
-* Zbook
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_zbook/pilot.h"
-#if defined(CERNLIB_UNIVAC)
- at ASG,T B.
- at COPY,R ZPRINT,B.AZPRIN
- at DELETE,R ZPRINT
- at MASM,IS B.NOARG
- . SUBROUTINE NOARG(NARG) RETURNS NUMBER OF ARGUMENTS IN A SUBROUTINE
- . OR FUNCTION CALL.
- . UNIVAC F T N VERSION BY B.S. NILSSON, NBI, MAY 1981.
- .
- AXR$ .
- $INFO 2 'HNOARG',2 .
-$(2),NARG + 0 .
-$(1),NOARG*
- LA,U A2,NARG . GET ADDR(NARG) IN A2
- LA A1,0,A0 . GET ADDRESS OF ARG
- LA,Q2 A0,0,A2 . # OF ARGUMENTS
- SA A0,0,A1 . STORE IT
- J 0,X11 . RETURN
- END .
- at MASM,IS B.ZPRINT$A
- AXR$ .
- $INFO 2 'HNOARG',2 .
-$(2),NARG + 0 .
-$(1),ZPRINT* LA,U A1,NARG . ADDR(NARG)
- SA A0,0,A1 . STORE A0 IN NARG
- J AZPRIN .
- END
- at MAP,ISR ,TPF$.ZPRINT
- IN B.AZPRIN,.ZPRINT$A,.NOARG
- DEF ZPRINT
-#endif
diff --git a/src/packlib/zbook/obsolete/zunivac/zjumpun.s b/src/packlib/zbook/obsolete/zunivac/zjumpun.s
deleted file mode 100644
index a30fd76..0000000
--- a/src/packlib/zbook/obsolete/zunivac/zjumpun.s
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: zjumpun.s,v 1.1.1.1 1996/03/08 12:01:16 mclareni Exp $
-*
-* $Log: zjumpun.s,v $
-* Revision 1.1.1.1 1996/03/08 12:01:16 mclareni
-* Zbook
-*
-*
-#if defined(CERNLIB_UNIVAC)
- at ASM,IS ,ZJUMP
- AXR$
-$(1),ZJUMP*
- LA A2,0,A0 .
- LA A3,0,A2 . ADDR(NAME)
- AA,U A0,1 . AO POINTS TO P1-ITEM IN
- SSC A0,18 . PARAMETER LIST
- ANA,U A0,1 . SUBTRACT # OF ARGS BY ONE
- OR,U A0,01000 . DISABLE TYPE-CHECKING
- LA A0,A1 .
- SSC A0,18 .
- J 0,A3 . JUMP ON TO 'NAME'
- END
-#endif
diff --git a/src/packlib/zbook/test/Imakefile b/src/packlib/zbook/test/Imakefile
deleted file mode 100644
index 1a7e3b2..0000000
--- a/src/packlib/zbook/test/Imakefile
+++ /dev/null
@@ -1,10 +0,0 @@
-SRCS_F= recovb.F recovz.F zepex1.F zepex2.F zexam1.F zexam2.F \ @@\
- zexam3.F zexam4.F zexam5.F zexam6.F zexam7.F zexam8.F zexam9.F
-
-DefinePackageLibrary(zbookt)
-
-SubdirLibraryTarget(zbookt,NullParameter)
-
-CernlibFortranProgramTarget(zexam,zexam.o,$(PACKAGE_LIB),$(PACKAGE_LIB),packlib)
-
-TestTarget(zexam,NullParameter,NullParameter)
diff --git a/src/packlib/zbook/test/recovb.F b/src/packlib/zbook/test/recovb.F
deleted file mode 100644
index 43301bb..0000000
--- a/src/packlib/zbook/test/recovb.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: recovb.F,v 1.1.1.1 1996/03/08 12:01:14 mclareni Exp $
-*
-* $Log: recovb.F,v $
-* Revision 1.1.1.1 1996/03/08 12:01:14 mclareni
-* Zbook
-*
-*
-#include "zbook/pilot.h"
- SUBROUTINE RECOVB(B,IERROR,LABEL,ID)
-C
- DIMENSION B(1), LABEL(1), ILABEL(6)
-C
- CALL UCTOH1(LABEL,ILABEL,6)
-C
- WRITE(6,1010)
- WRITE(6,1020)
- WRITE(6,1030) ILABEL, IERROR
- WRITE(6,1020)
- WRITE(6,1010)
- WRITE(6,1040)
-C
- RETURN
- 1010 FORMAT (1X,80('*'))
- 1020 FORMAT (1X,20('*'),40X,20('*'))
- 1030 FORMAT (1X,20('*'),6X,'CALL ',6A1,'(B,...) ERROR',I4,6X,20('*'))
- 1040 FORMAT ('0')
- END
diff --git a/src/packlib/zbook/test/recovz.F b/src/packlib/zbook/test/recovz.F
deleted file mode 100644
index 62b3d19..0000000
--- a/src/packlib/zbook/test/recovz.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: recovz.F,v 1.1.1.1 1996/03/08 12:01:14 mclareni Exp $
-*
-* $Log: recovz.F,v $
-* Revision 1.1.1.1 1996/03/08 12:01:14 mclareni
-* Zbook
-*
-*
-#include "zbook/pilot.h"
- SUBROUTINE RECOVZ(Z,IERROR,LABEL,ID)
-C
- DIMENSION Z(1), LABEL(1), ILABEL(6)
-C
- CALL UCTOH1(LABEL,ILABEL,6)
-C
- WRITE(6,1010)
- WRITE(6,1020)
- WRITE(6,1030) ILABEL, IERROR
- WRITE(6,1020)
- WRITE(6,1010)
- WRITE(6,1040)
-C
- RETURN
- 1010 FORMAT (1X,80('*'))
- 1020 FORMAT (1X,20('*'),40X,20('*'))
- 1030 FORMAT (1X,20('*'),6X,'CALL ',6A1,'(Z,...) ERROR',I4,6X,20('*'))
- 1040 FORMAT ('0')
- END
diff --git a/src/packlib/zbook/test/zepex1.F b/src/packlib/zbook/test/zepex1.F
deleted file mode 100644
index 82f4fc0..0000000
--- a/src/packlib/zbook/test/zepex1.F
+++ /dev/null
@@ -1,62 +0,0 @@
-*
-* $Id: zepex1.F,v 1.1.1.1 1996/03/08 12:01:14 mclareni Exp $
-*
-* $Log: zepex1.F,v $
-* Revision 1.1.1.1 1996/03/08 12:01:14 mclareni
-* Zbook
-*
-*
-#include "zbook/pilot.h"
- SUBROUTINE ZEPEX1
-C
-C EXAMPLE 10: - USAGE OF ZEPOUT TO WRITE BANKS IN MACHINE
-C INDEPENDENT FORMAT
-C
- COMMON/ZEPCMM/Z(1),ID1,ID2(3),ID3,WS(1)
- DIMENSION IZ(10000),IWS(1)
- EQUIVALENCE (IZ(1),Z(1)), (IWS(1),WS(1))
-C
- DIMENSION KEYO(3)
-C
- DATA KEYO,LUNO,LREC/1000, 2000, 3000, 2, 0/
-C
- CALL ZINIT (IZ,WS,10000)
-C
- CALL ZEPKEY (IZ,ID1,1000, 1,11,IERR)
- CALL ZEPKEY (IZ,ID2,2000, 3,12,IERR)
- CALL ZEPKEY (IZ,ID3,3000, 1,13,IERR)
-C
- CALL ZEPDEF (IZ,LUNO,LREC,IERR)
- IF (IERR.NE.0) GO TO 999
-C
-C LOOP ON EVENTS
-C
- DO 30 IEVENT = 1,5
-C
- CALL ZBOOKN (IZ,ID1,10,0,3HID1,1)
- CALL ZBOOKN (IZ,ID3,10,1,3HID3,1)
- CALL ZBOOKN (IZ,IZ(ID3-1),7,0,3HID3,11)
-C
- DO 10 I = 1,3
- 10 CALL ZBOOKN (IZ,ID2(I),10,0,3HID2,I)
-C
- ID31 = IZ(ID3 - 1)
- CALL VFILL (IZ(ID1+1),10,-17+IEVENT)
- CALL VFILL (IZ(ID3+1),10,-57.)
- CALL VFILL (IZ(ID31+1),7,99.)
-C
- DO 20 I = 1,3
- ID2I = ID2(I)
- 20 CALL VFILL (IZ(ID2I+1),10,-200000-IEVENT)
-C
- CALL ZEPOUT (IZ,LUNO,KEYO(1),1,1,IERR)
- CALL ZEPOUT (IZ,LUNO,KEYO(2),1,2,IERR)
- CALL ZEPOUT (IZ,LUNO,KEYO(3),1,3,IERR)
- CALL ZEPOUT (IZ,LUNO,KEYO(1),3,123,IERR)
-C
- 30 CALL ZAGAIN (IZ,ID1)
-C
- CALL ZEPEND(IZ,0,IERR)
-C
- 999 RETURN
- END
diff --git a/src/packlib/zbook/test/zepex2.F b/src/packlib/zbook/test/zepex2.F
deleted file mode 100644
index dc48d17..0000000
--- a/src/packlib/zbook/test/zepex2.F
+++ /dev/null
@@ -1,64 +0,0 @@
-*
-* $Id: zepex2.F,v 1.1.1.1 1996/03/08 12:01:14 mclareni Exp $
-*
-* $Log: zepex2.F,v $
-* Revision 1.1.1.1 1996/03/08 12:01:14 mclareni
-* Zbook
-*
-*
-#include "zbook/pilot.h"
- SUBROUTINE ZEPEX2
-C
-C EXAMPLE 11: - USAGE OF ZEPNXT, ZEPCAT, ZEPIN TO READ THE
-C FILE WRITTEN IN EXAMPLE 10
-C
- COMMON/ZEPCMM/Z(1),ID1,ID2(3),ID3,IDF,WS(1)
- DIMENSION IZ(10000),IWS(1)
- EQUIVALENCE (IZ(1),Z(1)), (IWS(1),WS(1))
-C
- DIMENSION KEYI(3)
-C
- DATA KEYI,LUNI,LREC/1000, 2000, 3000, 2, 0/
-C
- CALL ZINIT (IZ,WS,10000)
-C
- CALL ZEPKEY (IZ,ID1,1000, 1, 0,IERR)
- CALL ZEPKEY (IZ,ID2,2000, 3, 0,IERR)
- CALL ZEPKEY (IZ,ID3,3000, 1, 0,IERR)
-C
- CALL ZEPDEF (IZ,LUNI,LREC,IERR)
- IF (IERR.NE.0) GO TO 999
-C
-C LOOP ON EVENTS
-C
- DO 40 IEVENT = 1,999
-C
- CALL ZBOOK (IZ,IDF,0)
-C
- 10 CALL ZEPNXT (IZ,LUNI,LABEL,IERR)
- IF (IERR.NE.0) GO TO 999
-C
- WRITE(6,1000) LABEL
- IF (IEVENT.GT.1) GO TO 20
-C
- CALL ZEPCAT (IZ,LUNI,JCAT,LABEL,IERR)
- IF (IERR.NE.0) GO TO 999
-C
- CALL ZPTREE (IZ,JCAT,8HCATALOG$,1HI)
-C
- 20 IF (LABEL.NE.123) GO TO 10
-C
- CALL ZEPIN (IZ,LUNI,KEYI(1),3,LABEL,IERR)
- IF (IERR.NE.0) GO TO 999
-C
- CALL ZPTREE (IZ,ID1,'ID1$',1HI)
- CALL ZPTREE (IZ,ID3,'ID3$',1HF)
-C
- DO 30 I = 1,3
- 30 CALL ZPTREE (IZ,ID2(I),'ID2$',1HI)
-C
- 40 CALL ZAGAIN (IZ,IDF)
-C
- 999 RETURN
- 1000 FORMAT ('0',20('*'),10X,'LABEL',9X,I3,13X,20('*'))
- END
diff --git a/src/packlib/zbook/test/zexam.F b/src/packlib/zbook/test/zexam.F
deleted file mode 100644
index 8dd521f..0000000
--- a/src/packlib/zbook/test/zexam.F
+++ /dev/null
@@ -1,144 +0,0 @@
-*
-* $Id: zexam.F,v 1.1.1.1 1996/03/08 12:01:14 mclareni Exp $
-*
-* $Log: zexam.F,v $
-* Revision 1.1.1.1 1996/03/08 12:01:14 mclareni
-* Zbook
-*
-*
-#include "zbook/pilot.h"
-#if defined(CERNLIB_CDC)
- PROGRAM ZEXAM(OUTPUT,TAPE1,TAPE2,TAPE6=OUTPUT)
-#endif
-#if !defined(CERNLIB_CDC)
- PROGRAM ZEXAM
-#endif
-C
- I = 1
- WRITE(6,1000)
- WRITE(6,1010)
- WRITE(6,1020)
- WRITE(6,1030) I
- WRITE(6,1020)
- WRITE(6,1010)
- WRITE(6,1040)
-C
- CALL ZEXAM1
-C
- I = 2
- WRITE(6,1010)
- WRITE(6,1020)
- WRITE(6,1030) I
- WRITE(6,1020)
- WRITE(6,1010)
- WRITE(6,1040)
-C
- CALL ZEXAM2
-C
- I = 3
- WRITE(6,1010)
- WRITE(6,1020)
- WRITE(6,1030) I
- WRITE(6,1020)
- WRITE(6,1010)
-C
- CALL ZEXAM3
-C
- I = 4
- WRITE(6,1040)
- WRITE(6,1010)
- WRITE(6,1020)
- WRITE(6,1030) I
- WRITE(6,1020)
- WRITE(6,1010)
-C
- CALL ZEXAM4
-C
- I = 5
- WRITE(6,1040)
- WRITE(6,1010)
- WRITE(6,1020)
- WRITE(6,1030) I
- WRITE(6,1020)
- WRITE(6,1010)
-C
- CALL ZEXAM5
-C
- I = 6
- WRITE(6,1040)
- WRITE(6,1010)
- WRITE(6,1020)
- WRITE(6,1030) I
- WRITE(6,1020)
- WRITE(6,1010)
-C
- CALL ZEXAM6
-C
- I = 7
- WRITE(6,1040)
- WRITE(6,1010)
- WRITE(6,1020)
- WRITE(6,1030) I
- WRITE(6,1020)
- WRITE(6,1010)
-C
- CALL ZEXAM7
-C
- I = 8
- WRITE(6,1040)
- WRITE(6,1010)
- WRITE(6,1020)
- WRITE(6,1030) I
- WRITE(6,1020)
- WRITE(6,1010)
- WRITE(6,1040)
-C
- CALL ZEXAM8
-C
- I = 9
- WRITE(6,1010)
- WRITE(6,1020)
- WRITE(6,1030) I
- WRITE(6,1020)
- WRITE(6,1060)
- WRITE(6,1070)
- WRITE(6,1020)
- WRITE(6,1010)
- WRITE(6,1040)
-C
- CALL ZEXAM9
-C
-#if defined(CERNLIB_IBM)||defined(CERNLIB_VAXVMS)
- I = 1
- WRITE(6,1010)
- WRITE(6,1020)
- WRITE(6,1050) I
- WRITE(6,1020)
- WRITE(6,1010)
- WRITE(6,1040)
-C
- CALL ZEPEX1
-C
- CALL EPRWND (2,IBUF,IERR)
-C
- I = 2
- WRITE(6,1010)
- WRITE(6,1020)
- WRITE(6,1050) I
- WRITE(6,1020)
- WRITE(6,1010)
-C
- CALL ZEPEX2
-#endif
-C
- STOP
- 1000 FORMAT ('1')
- 1010 FORMAT (1X,80('*'))
- 1020 FORMAT (1X,20('*'),40X,20('*'))
- 1030 FORMAT (1X,20('*'),10X,'SUBROUTINE ZEXAM',I1,13X,20('*'))
- 1040 FORMAT ('0')
- 1050 FORMAT (1X,20('*'),10X,'SUBROUTINE ZEPEX',I1,13X,20('*'))
- 1060 FORMAT (1X,20('*'),' ZBOOK ERRORS ARE GENERATED ON PURPOSE '
- *,20('*'))
- 1070 FORMAT (1X,20('*'),' TO TEST RECOVERY ROUTINES ',13X,20('*'))
- END
diff --git a/src/packlib/zbook/test/zexam1.F b/src/packlib/zbook/test/zexam1.F
deleted file mode 100644
index 4844a0a..0000000
--- a/src/packlib/zbook/test/zexam1.F
+++ /dev/null
@@ -1,43 +0,0 @@
-*
-* $Id: zexam1.F,v 1.1.1.1 1996/03/08 12:01:14 mclareni Exp $
-*
-* $Log: zexam1.F,v $
-* Revision 1.1.1.1 1996/03/08 12:01:14 mclareni
-* Zbook
-*
-*
-#include "zbook/pilot.h"
- SUBROUTINE ZEXAM1
-C
-C EXAMPLE 1: - INITIALISATION OF A DYNAMIC STRUCTURE
-C - BOOKING AND FILLING OF A BANK
-C - ACCESS TO DATA STORED IN A BANK
-C
- COMMON/ZCOMM/Z(1),ID1,ID2,ID3,WS(1)
- DIMENSION IZ(1000),IWS(1)
- EQUIVALENCE (IZ(1),Z(1)), (IWS(1),WS(1))
-C
-C INITIALISATION
-C
- CALL ZINIT (Z,WS,1000)
-C
-C BOOKING
-C
- NWORDS = 23
- CALL ZBOOK (Z,ID1,NWORDS)
-C
-C CHECK IF BANK EXISTS
-C
- IF (ID1.EQ.0) GO TO 999
-C
-C FILLING
-C
- DO 10 I = 1,NWORDS
- 10 IZ(ID1 + I) = I
-C
-C ACCESS TO DATA STORED IN THE BANK
-C
- ILAST = IZ(ID1 + NWORDS)
-C
- 999 RETURN
- END
diff --git a/src/packlib/zbook/test/zexam2.F b/src/packlib/zbook/test/zexam2.F
deleted file mode 100644
index 7eea4d8..0000000
--- a/src/packlib/zbook/test/zexam2.F
+++ /dev/null
@@ -1,57 +0,0 @@
-*
-* $Id: zexam2.F,v 1.1.1.1 1996/03/08 12:01:14 mclareni Exp $
-*
-* $Log: zexam2.F,v $
-* Revision 1.1.1.1 1996/03/08 12:01:14 mclareni
-* Zbook
-*
-*
-#include "zbook/pilot.h"
- SUBROUTINE ZEXAM2
-C
-C EXAMPLE 2: - INITIALISATION OF A DYNAMIC STRUCTURE
-C - BOOKING AND FILLING OF BANKS
-C - USAGE OF WORKING SPACE
-C
- COMMON/ZCOMM/Z(1),ID1,ID2,ID3,WS(1)
- DIMENSION IZ(1000),IWS(1)
- EQUIVALENCE (IZ(1),Z(1)), (IWS(1),WS(1))
-C
- COMMON/MOREID/IDMORE(10)
-C
-C INITIALISATION
-C
- CALL ZINIT (Z,WS,1000)
-C
-C BOOKING OF BANKS
-C
- NWORDS = 23
- CALL ZBOOK0 (Z,ID1,NWORDS)
- CALL ZBOOK0 (Z,ID2,NWORDS)
- CALL ZBOOK0 (Z,ID3,NWORDS)
-C
-C MORE BANKS (IDENTIFIERS STORED IN A LABELLED COMMON BLOCK)
-C
- NWORDS = 11
-C
- DO 10 I = 1,10
- 10 CALL ZBOOK0 (Z,IDMORE(I),NWORDS)
-C
-C IDENTIFIERS CAN BE LOCAL VARIABLES
-C
- LOCAL = 0
- CALL ZBOOK0 (Z,LOCAL,NWORDS)
-C
-C WORKING SPACE
-C
- NWORK = 11
- CALL ZLEFT (Z,NLEFT)
- IF (NLEFT.LT.NWORK) GO TO 999
-C
- CALL ZWORK (Z,NWORK)
-C
- DO 20 I = 1,NWORK
- 20 WS(I) = FLOAT (I)
-C
- 999 RETURN
- END
diff --git a/src/packlib/zbook/test/zexam3.F b/src/packlib/zbook/test/zexam3.F
deleted file mode 100644
index 5566ddb..0000000
--- a/src/packlib/zbook/test/zexam3.F
+++ /dev/null
@@ -1,59 +0,0 @@
-*
-* $Id: zexam3.F,v 1.1.1.1 1996/03/08 12:01:14 mclareni Exp $
-*
-* $Log: zexam3.F,v $
-* Revision 1.1.1.1 1996/03/08 12:01:14 mclareni
-* Zbook
-*
-*
-#include "zbook/pilot.h"
- SUBROUTINE ZEXAM3
-C
-C EXAMPLE 3: - INITIALISATION OF A DYNAMIC STRUCTURE
-C - BOOKING AND FILLING OF A BANK
-C - USAGE OF ZPUSH, ZNAME, ZPRINT, ZDROP
-C
- COMMON/ZCOMM/Z(1),ID1,ID2,ID3,WS(1)
- DIMENSION IZ(1000),IWS(1)
- EQUIVALENCE (IZ(1),Z(1)), (IWS(1),WS(1))
-C
- LOGICAL ZBUG
-C
-C INITIALISATION
-C
- CALL ZINIT (Z,WS,1000)
-C
-C BOOKING AND FILLING
-C
- NWORDS = 23
- CALL ZBOOK (Z,ID3,NWORDS)
-C
- IF (ID3.EQ.0) GO TO 999
-C
- DO 10 I = 1,NWORDS
- 10 IZ(ID3 + I) = I
-C
-C CHANGE THE BANK LENGTH
-C
- NMORE = 3
- CALL ZPUSH (Z,ID3,NMORE)
- IF (ZBUG (Z,100)) GO TO 999
-C
- DO 20 I = 1,NMORE
- J = ID3 + NWORDS + I
- 20 Z(J) = FLOAT (I)
-C
-C NAME AND NUMBER
-C
- CALL ZNAME (Z,ID3,'TEST',1)
-C
-C PRINT THE BANK
-C
- CALL ZPRINT (Z,ID3,18HBANK OF EXAMPLE 3$,1HF,0,0)
-C
-C DROP IT
-C
- CALL ZDROP (Z,ID3)
-C
- 999 RETURN
- END
diff --git a/src/packlib/zbook/test/zexam4.F b/src/packlib/zbook/test/zexam4.F
deleted file mode 100644
index b4d4c1d..0000000
--- a/src/packlib/zbook/test/zexam4.F
+++ /dev/null
@@ -1,55 +0,0 @@
-*
-* $Id: zexam4.F,v 1.1.1.1 1996/03/08 12:01:14 mclareni Exp $
-*
-* $Log: zexam4.F,v $
-* Revision 1.1.1.1 1996/03/08 12:01:14 mclareni
-* Zbook
-*
-*
-#include "zbook/pilot.h"
- SUBROUTINE ZEXAM4
-C
-C EXAMPLE 4: - INITIALISATION OF A DYNAMIC STRUCTURE
-C - CREATION OF A TREE STRUCTURE:
-C 2 DATA BANKS LINKED TO A MOTHER BANK.
-C THE MOTHER BANK CONTAINS LINKS AND DATA.
-C
- COMMON/ZCOMM/Z(1),ID1,ID2,ID3,WS(1)
- DIMENSION IZ(1000),IWS(1)
- EQUIVALENCE (IZ(1),Z(1)), (IWS(1),WS(1))
-C
-C INITIALISATION
-C
- CALL ZINIT (Z,WS,1000)
-C
-C CREATION OF THE MOTHER BANK
-C
- NDATA = 5
- NLINKS = 2
-C
- CALL ZBOOKN (Z,ID2,NDATA,NLINKS,'ZEX4',1)
- IF (ID2.EQ.0) GO TO 999
-C
-C FILL MOTHER BANK
-C
- DO 10 I = 1,NDATA
- 10 IZ(ID2 + I) = I
-C
-C CREATION OF THE OTHER BANKS (THE BRANCHES OF THE TREE)
-C
- CALL ZBOOKN (Z,IZ(ID2-1),NDATA,0,'ZEX4',11)
- CALL ZBOOKN (Z,IZ(ID2-2),NDATA,0,'ZEX4',12)
-C
- J1 = IZ(ID2 - 1)
- J2 = IZ(ID2 - 2)
- IF (J1.EQ.0.OR.J2.EQ.0) GO TO 999
-C
- CALL VFILL (Z(J1+1),NDATA,5.)
- CALL VFILL (Z(J2+1),NDATA,6.)
-C
- CALL ZPRINT (Z,ID2,12HMOTHER BANK$,1HF,0,0)
- CALL ZPRINT (Z,J1,9HBRANCH 1$,1HF,0,0)
- CALL ZPRINT (Z,J2,9HBRANCH 2$,1HF,0,0)
-C
- 999 RETURN
- END
diff --git a/src/packlib/zbook/test/zexam5.F b/src/packlib/zbook/test/zexam5.F
deleted file mode 100644
index ab447a8..0000000
--- a/src/packlib/zbook/test/zexam5.F
+++ /dev/null
@@ -1,70 +0,0 @@
-*
-* $Id: zexam5.F,v 1.2 2006/09/15 09:35:31 mclareni Exp $
-*
-* $Log: zexam5.F,v $
-* Revision 1.2 2006/09/15 09:35:31 mclareni
-* Submitted mods for gcc4/gfortran and MacOSX, corrected to work also on slc4 with gcc3.4 and 4.1
-*
-* Revision 1.1.1.1 1996/03/08 12:01:14 mclareni
-* Zbook
-*
-*
-#include "zbook/pilot.h"
- SUBROUTINE ZEXAM5
-C
-C EXAMPLE 5: - INITIALISATION OF A DYNAMIC STRUCTURE
-C - CREATION OF A TREE STRUCTURE (AS IN EXAMPLE 4).
-C - A NEW BRANCH AND NEW DATA CHANGE THE STRUCTURE
-C
- COMMON/ZCOMM/Z(1),ID1,ID2,ID3,WS(1)
- DIMENSION IZ(1000),IWS(1)
- EQUIVALENCE (IZ(1),Z(1)), (IWS(1),WS(1))
-C
- LOGICAL ZBUG
-C
-C INITIALISATION
-C
- CALL ZINIT (Z,WS,1000)
-C
-C CREATION OF A TREE (AS IN EXAMPLE 4)
-C
- NDATA = 5
- NLINKS = 2
-C
- CALL ZBOOKN (Z,ID2,NDATA,NLINKS,'ZEX5',1)
- IF (ID2.EQ.0) GO TO 999
-C
- DO 10 I = 1,NDATA
- 10 IZ(ID2 + I) = I
-C
- CALL ZBOOKN (Z,IZ(ID2-1),NDATA,0,'ZEX5',11)
- CALL ZBOOKN (Z,IZ(ID2-2),NDATA,0,'ZEX5',12)
-C
- J1 = IZ(ID2 - 1)
- J2 = IZ(ID2 - 2)
- IF (J1.EQ.0.OR.J2.EQ.0) GO TO 999
-C
- CALL VFILL (Z(J1+1),NDATA,5.)
- CALL VFILL (Z(J2+1),NDATA,6.)
-C
-C MODIFY THE MOTHER BANK
-C
- MDATA = 2
- MLINK = 1
-C
- CALL ZPUSHS (Z,ID2,MDATA,MLINK)
- IF (ZBUG (Z,100)) GO TO 999
-C
-C NEW BRANCH
-C
-#if !defined(CERNLIB_GFORTRAN)
- CALL ZBOOKN (Z,IZ(ID2-NLINKS-1),NDATA+MDATA,0,3HNEW,1)
-#else
- CALL ZBOOKN (Z,IZ(ID2-NLINKS-1),NDATA+MDATA,0,4HNEW ,1)
-#endif
- IF (ZBUG (Z,100)) GO TO 999
-C
- CALL ZPTREE (Z,ID2,5HTREE$,1HF)
-C
- 999 RETURN
- END
diff --git a/src/packlib/zbook/test/zexam6.F b/src/packlib/zbook/test/zexam6.F
deleted file mode 100644
index fbc50bb..0000000
--- a/src/packlib/zbook/test/zexam6.F
+++ /dev/null
@@ -1,55 +0,0 @@
-*
-* $Id: zexam6.F,v 1.1.1.1 1996/03/08 12:01:14 mclareni Exp $
-*
-* $Log: zexam6.F,v $
-* Revision 1.1.1.1 1996/03/08 12:01:14 mclareni
-* Zbook
-*
-*
-#include "zbook/pilot.h"
- SUBROUTINE ZEXAM6
-C
-C EXAMPLE 6: - USAGE OF ZLOCAL
-C
- COMMON/ZCOMM/Z(1),ID1,ID2,ID3,WS(1)
- DIMENSION IZ(1000),IWS(1)
- EQUIVALENCE (IZ(1),Z(1)), (IWS(1),WS(1))
-C
- COMMON/LOCAL/NLOCAL,LOCAL1,LOCAL2,LOCAL3
-C
-C INITIALISATION
-C
- CALL ZINIT (Z,WS,1000)
-C
- NWORDS = 12
- CALL ZBOOK (Z,ID1,NWORDS)
- IF (ID1.EQ.0) GO TO 999
-C
-C J1 POINTS TO THE LAST DATA WORD IN THE BANK
-C
- J1 = ID1 + NWORDS
-C
-C CREATION OF A WORKING SPACE: IDENTIFIERS ARE AUTOMATICALLY UDATED
-C LOCAL POINTERS MUST BE UPDATED BY THE USER
-C
- NWORK = 23
- CALL ZWORK (Z,NWORK)
-C
- J1 = ID1 + NWORDS
-C
-C LOCAL1 POINTS TO THE SECOND DATA WORD IN THE BANK
-C
- LOCAL1 = ID1 + 2
-C
-C LOCAL1 WILL BE AUTOMATICALLY UPDATED
-C
- CALL ZLOCAL (Z,NLOCAL)
- NLOCAL = 1
-C
- NWORK = NWORK + 10
- CALL ZWORK (Z,NWORK)
-C
-C LOCAL1 POINTS TO THE SECOND WORD OF THE BANK
-C
- 999 RETURN
- END
diff --git a/src/packlib/zbook/test/zexam7.F b/src/packlib/zbook/test/zexam7.F
deleted file mode 100644
index 24410dc..0000000
--- a/src/packlib/zbook/test/zexam7.F
+++ /dev/null
@@ -1,78 +0,0 @@
-*
-* $Id: zexam7.F,v 1.1.1.1 1996/03/08 12:01:14 mclareni Exp $
-*
-* $Log: zexam7.F,v $
-* Revision 1.1.1.1 1996/03/08 12:01:14 mclareni
-* Zbook
-*
-*
-#include "zbook/pilot.h"
- SUBROUTINE ZEXAM7
-C
-C EXAMPLE 7: - USAGE OF ZWRITE AND ZREAD
-C
- COMMON/ZCOMM/Z(1),ID1,ID2,ID3,WS(1)
- DIMENSION IZ(1000),IWS(1)
- EQUIVALENCE (IZ(1),Z(1)), (IWS(1),WS(1))
-C
-#if defined(CERNLIB_CDC)
- DIMENSION INDEX(501)
-C
- CALL OPENMS (1,INDEX,501,0)
-#endif
-#if defined(CERNLIB_IBM)
-C DEFINE FILE 1(500,100,U,INDEX)
- OPEN (UNIT=1,STATUS='NEW',ACCESS='DIRECT',RECL=2000)
-#endif
-#if defined(CERNLIB_UNIVAC)
- DEFINE FILE 1(500,100,U,INDEX)
-#endif
-#if defined(CERNLIB_VAX)
- DEFINE FILE 1(500,200,U,INDEX)
-#endif
-#if defined(CERNLIB_CRAY)||defined(CERNLIB_CONVEX)
- OPEN (1,ACCESS='DIRECT',FORM='UNFORMATTED',RECL=4000)
-#endif
-#if defined(CERNLIB_APOLLO)||defined(CERNLIB_UNIX)
- OPEN (1,STATUS='SCRATCH',ACCESS='DIRECT',RECL=400)
-#endif
-C
-C INITIALISATION
-C
- CALL ZINIT (Z,WS,1000)
-C
- LUNIT = 1
- NREC = 500
- LREC = 100
-C
-C
- CALL ZDISK (Z,LUNIT,NREC,LREC)
-C
-C BOOKING AND FILLING OF A BANK
-C
- CALL ZBOOK (Z,ID1,10)
- IF (ID1.EQ.0) GO TO 999
-C
- CALL VFILL (Z(ID1+1),10,999.)
-C
-C WRITE THE BANK ON DISK
-C
- KEY = 1
- CALL ZWRITE (Z,ID1,LUNIT,KEY)
-C
-C DROP IT
-C
- CALL ZDROP (Z,ID1)
-C
-C READ IN MEMORY THE BANK PREVIOUSLY WRITTEN ON DISK
-C
- CALL ZREAD (Z,ID3,LUNIT,KEY)
-C
-C PRINT IT
-C
- CALL ZPRINT (Z,ID3,12HOLD ID: ID1$,1HF,2,8)
-C
- CALL ZCLOSE(Z,LUNIT)
-C
- 999 RETURN
- END
diff --git a/src/packlib/zbook/test/zexam8.F b/src/packlib/zbook/test/zexam8.F
deleted file mode 100644
index d662a6a..0000000
--- a/src/packlib/zbook/test/zexam8.F
+++ /dev/null
@@ -1,42 +0,0 @@
-*
-* $Id: zexam8.F,v 1.1.1.1 1996/03/08 12:01:14 mclareni Exp $
-*
-* $Log: zexam8.F,v $
-* Revision 1.1.1.1 1996/03/08 12:01:14 mclareni
-* Zbook
-*
-*
-#include "zbook/pilot.h"
- SUBROUTINE ZEXAM8
-C
-C EXAMPLE 8: - MANAGEMENT OF TWO DYNAMIC MEMORIES
-C
- COMMON/ZCOMM/Z(1),ID1,ID2,ID3,WS(1)
- DIMENSION IZ(1000),IWS(1)
- EQUIVALENCE (IZ(1),Z(1)), (IWS(1),WS(1))
-C
- COMMON//B(1),BWS(1)
- DIMENSION IB(2000),IBWS(1)
- EQUIVALENCE (B(1),IB(1)), (BWS(1),IBWS(1))
-C
- COMMON/POINTS/IP1,IP2,IP3
-C
-C INITIALISATION
-C
- CALL ZINIT (Z,WS,1000)
- CALL ZHINIT (B,BWS,2000)
- CALL VZERO (IP1,3)
-C
-C BOOKING OF BANKS
-C
- CALL ZBOOK (Z,ID1,50)
- CALL ZBOOK (Z,ID2,43)
- CALL ZBOOK (Z,ID3,45)
-C
- CALL ZBOOK (Z,IP1,37)
-C
- CALL ZBOOK (B,IP2,33)
- CALL ZBOOK (B,IP3,29)
-C
- 999 RETURN
- END
diff --git a/src/packlib/zbook/test/zexam9.F b/src/packlib/zbook/test/zexam9.F
deleted file mode 100644
index fa87c90..0000000
--- a/src/packlib/zbook/test/zexam9.F
+++ /dev/null
@@ -1,47 +0,0 @@
-*
-* $Id: zexam9.F,v 1.1.1.1 1996/03/08 12:01:14 mclareni Exp $
-*
-* $Log: zexam9.F,v $
-* Revision 1.1.1.1 1996/03/08 12:01:14 mclareni
-* Zbook
-*
-*
-#include "zbook/pilot.h"
- SUBROUTINE ZEXAM9
-C
-C EXAMPLE 9: - USAGE OF ZTRAP
-C
- COMMON/ZCOMM/Z(1),ID1,ID2,ID3,WS(1)
- DIMENSION IZ(1000),IWS(1)
- EQUIVALENCE (IZ(1),Z(1)), (IWS(1),WS(1))
-C
- COMMON//B(1),BWS(1)
- DIMENSION IB(2000),IBWS(1)
- EQUIVALENCE (B(1),IB(1)), (BWS(1),IBWS(1))
-C
- COMMON/POINTS/IP1,IP2,IP3
-C
- EXTERNAL RECOVZ, RECOVB
-C
-C INITIALISATION
-C
- CALL ZINIT (Z,WS,1000)
- CALL ZINIT (B,BWS,2000)
- CALL VZERO (IP1,3)
-C
-C MANAGEMENT OF DYNAMIC MEMORY 'Z': IN CASE OF ZBOOK ERROR
-C CALL RECOVZ
-C
- CALL ZTRAP (Z,RECOVZ)
-C
- CALL ZDROP (Z,ID1)
-C
-C MANAGEMENT OF DYNAMIC MEMORY 'B': IN CASE OF ZBOOK ERROR
-C CALL RECOVB
-C
- CALL ZTRAP (B,RECOVB)
-C
- CALL ZBOOK (B,IP1,3000)
-C
- 999 RETURN
- END
diff --git a/src/packlib/zbook/versions/cdc_jcl b/src/packlib/zbook/versions/cdc_jcl
deleted file mode 100644
index c49c57c..0000000
--- a/src/packlib/zbook/versions/cdc_jcl
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: cdc_jcl,v 1.1.1.1 1996/03/08 12:01:16 mclareni Exp $
-*
-* $Log: cdc_jcl,v $
-* Revision 1.1.1.1 1996/03/08 12:01:16 mclareni
-* Zbook
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_zbook/pilot.h"
-JOB.
-ACCOUNT,....
-FIND,PAM,PROZBOOKPAM,ID=PROGLIB.
-FIND,ULIB,ID=PHLIB.
-LIBRARY,ULIB.
-YPATCHY.
-LIBRARY.
-RETURN,PAM,ULIB.
-FTN,I=ASM.
-RETURN,ASM.
-FIND,LIB,7600LIBRARY.
-FIND,GENLIB.
-LIBRARY,GENLIB,LIB.
-LGO.
-%EOR
-&USE,CDC,ZEXAM.
-&EXE.
-&PAM.
-&QUIT.
diff --git a/src/packlib/zbook/versions/ibm_jcl b/src/packlib/zbook/versions/ibm_jcl
deleted file mode 100644
index 1e474d3..0000000
--- a/src/packlib/zbook/versions/ibm_jcl
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: ibm_jcl,v 1.1.1.1 1996/03/08 12:01:16 mclareni Exp $
-*
-* $Log: ibm_jcl,v $
-* Revision 1.1.1.1 1996/03/08 12:01:16 mclareni
-* Zbook
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_zbook/pilot.h"
-// JOB ,TIME=(0,14)
-// EXEC YPATCHY,PAMDSN='CR.PUB.PAM.PRO.ZBOOK'
-//Y.SYSIN DD *
-&USE,IBM,ZEXAM.
-&EXE,P=ZEXAM.
-&PAM,11
-&QUIT
-/*
-// EXEC NFORTCG,LLB1='CR.PUB.GENLIB'
-//C.SYSIN DD DSN=&&ASM,DISP=(OLD,PASS)
-//G.FT01F001 DD DSN=GG.UUU.XXXX,DISP=(NEW,DELETE),SPACE=(CYL,(1,1)),
-// UNIT=SYSDA,DCB=(BLKSIZE=400,LRECL=400),LABEL=(,,,OUT)
-//G.IOFILE02 DD DSN=GG.UUU.XXXXXX,DISP=(NEW,DELETE),SPACE=(CYL,(1,1)),
-// UNIT=SYSDA,DCB=(RECFM=U,BLKSIZE=3600,LRECL=3600),LABEL=(,,,OUT)
-// EXEC CIAO
diff --git a/src/packlib/zbook/versions/patchy_flags b/src/packlib/zbook/versions/patchy_flags
deleted file mode 100644
index d0c3e2a..0000000
--- a/src/packlib/zbook/versions/patchy_flags
+++ /dev/null
@@ -1,91 +0,0 @@
-*
-* $Id: patchy_flags,v 1.1.1.1 1996/03/08 12:01:16 mclareni Exp $
-*
-* $Log: patchy_flags,v $
-* Revision 1.1.1.1 1996/03/08 12:01:16 mclareni
-* Zbook
-*
-*
-* Flags patch
-* This directory was created from zbook.car patch fzbook
-#if defined(CERNLIB_IBMAIX)
-#ifndef CERNLIB_AIX370
-#define CERNLIB_AIX370
-#endif
-#endif
-#if defined(CERNLIB_IBMMVS)||defined(CERNLIB_IBMVM)
-#ifndef CERNLIB_IBM
-#define CERNLIB_IBM
-#endif
-#endif
-#if defined(CERNLIB_ALLIANT)||defined(CERNLIB_APOLLO)||defined(CERNLIB_CONVEX)||defined(CERNLIB_IBMAIX)||defined(CERNLIB_NECSX)||defined(CERNLIB_UNISYS)
-#ifndef CERNLIB_UNIX
-#define CERNLIB_UNIX
-#endif
-#endif
-#if defined(CERNLIB_DECS)||defined(CERNLIB_HPUX)||defined(CERNLIB_IBMRT)||defined(CERNLIB_SGI)||defined(CERNLIB_SUN)
-#ifndef CERNLIB_UNIX
-#define CERNLIB_UNIX
-#endif
-#endif
-#if defined(CERNLIB_AMIGAUX)||defined(CERNLIB_CDCUX)||defined(CERNLIB_GOULD)||defined(CERNLIB_IPSC)||defined(CERNLIB_MACMPW)||defined(CERNLIB_MACAUX)||defined(CERNLIB_MIPS)
-#ifndef CERNLIB_UNIX
-#define CERNLIB_UNIX
-#endif
-#endif
-#if defined(CERNLIB_MSDOS)||defined(CERNLIB_IBMUX)||defined(CERNLIB_LINUX)||defined(CERNLIB_NEXT)
-#ifndef CERNLIB_UNIX
-#define CERNLIB_UNIX
-#endif
-#endif
-#if defined(CERNLIB_VAXVMS)||defined(CERNLIB_VAXULX)
-#ifndef CERNLIB_VAX
-#define CERNLIB_VAX
-#endif
-#endif
-#if defined(CERNLIB_CDC)||defined(CERNLIB_CRAY)
-#ifndef CERNLIB_SINGLE
-#define CERNLIB_SINGLE
-#endif
-#endif
-#if defined(CERNLIB_IBM)||defined(CERNLIB_VAX)||defined(CERNLIB_NORD)
-#ifndef CERNLIB_DOUBLE
-#define CERNLIB_DOUBLE
-#endif
-#endif
-#if (defined(CERNLIB_UNIX))&&(!defined(CERNLIB_SINGLE))
-#ifndef CERNLIB_DOUBLE
-#define CERNLIB_DOUBLE
-#endif
-#endif
-#if defined(CERNLIB_IBM)
-#ifndef CERNLIB_QMIBMXA
-#define CERNLIB_QMIBMXA
-#endif
-#endif
-#if defined(CERNLIB_ND100B16)||defined(CERNLIB_ND100B32)||defined(CERNLIB_ND50)||defined(CERNLIB_ND500)||defined(CERNLIB_NORD50)||defined(CERNLIB_NORD500)
-#ifndef CERNLIB_NORD
-#define CERNLIB_NORD
-#endif
-#endif
-#if defined(CERNLIB_PR1ME)
-#ifndef CERNLIB_DOUBLE
-#define CERNLIB_DOUBLE
-#endif
-#endif
-#if defined(CERNLIB_APOLLO)
-#ifndef CERNLIB_QXNO_SC
-#define CERNLIB_QXNO_SC
-#endif
-#endif
-#if defined(CERNLIB_CRAY)
-#ifndef CERNLIB_QXCAPT
-#define CERNLIB_QXCAPT
-#endif
-#endif
-* SUN,SGI,DEC,CVX,IRS,HPX,IBX
-#if (!defined(CERNLIB_QXNO_SC))&&(!defined(CERNLIB_QXCAPT))
-#ifndef CERNLIB_QX_SC
-#define CERNLIB_QX_SC
-#endif
-#endif
diff --git a/src/packlib/zbook/versions/v200202.dat b/src/packlib/zbook/versions/v200202.dat
deleted file mode 100644
index 29be0a9..0000000
--- a/src/packlib/zbook/versions/v200202.dat
+++ /dev/null
@@ -1,8 +0,0 @@
-*
-* $Id: v200202.dat,v 1.1.1.1 1996/03/08 12:01:16 mclareni Exp $
-*
-* $Log: v200202.dat,v $
-* Revision 1.1.1.1 1996/03/08 12:01:16 mclareni
-* Zbook
-*
-*
diff --git a/src/packlib/zbook/versions/v203.dat b/src/packlib/zbook/versions/v203.dat
deleted file mode 100644
index 294169d..0000000
--- a/src/packlib/zbook/versions/v203.dat
+++ /dev/null
@@ -1,13 +0,0 @@
-*
-* $Id: v203.dat,v 1.1.1.1 1996/03/08 12:01:16 mclareni Exp $
-*
-* $Log: v203.dat,v $
-* Revision 1.1.1.1 1996/03/08 12:01:16 mclareni
-* Zbook
-*
-*
-* Version 2.03
-C ZEPIN TIMING OPTIMIZED
-C USING NEW FAST EPIO ROUTINES
-C NEW ROUTINE ZBOOKT (RETURNS ZBOOK VERSION)
-C
diff --git a/src/packlib/zbook/versions/v204.dat b/src/packlib/zbook/versions/v204.dat
deleted file mode 100644
index 1cc81c5..0000000
--- a/src/packlib/zbook/versions/v204.dat
+++ /dev/null
@@ -1,11 +0,0 @@
-*
-* $Id: v204.dat,v 1.1.1.1 1996/03/08 12:01:15 mclareni Exp $
-*
-* $Log: v204.dat,v $
-* Revision 1.1.1.1 1996/03/08 12:01:15 mclareni
-* Zbook
-*
-*
-* Version 2.04 820419
-C SMALL PRINTING MODIFICATION IN ZDEBUG
-C
diff --git a/src/packlib/zbook/versions/v205.dat b/src/packlib/zbook/versions/v205.dat
deleted file mode 100644
index 7feec88..0000000
--- a/src/packlib/zbook/versions/v205.dat
+++ /dev/null
@@ -1,15 +0,0 @@
-*
-* $Id: v205.dat,v 1.1.1.1 1996/03/08 12:01:15 mclareni Exp $
-*
-* $Log: v205.dat,v $
-* Revision 1.1.1.1 1996/03/08 12:01:15 mclareni
-* Zbook
-*
-*
-* Version 2.05 820601
-C FORTRAN 77 VERSION INTRODUCED (+USE,F77)
-C PATCH TEST INTRODUCED
-C MINOR MODIFICATIONS IN ZFRIBM,ZTOIBM,ZEPIN,ZEPNXT,ZEPOUT
-C ZMIGRA,ZREAD,ZWRITE,ZSCR,ZLOOK,ZCLOSE
-C ZWORK,ZSHIFT
-C
diff --git a/src/packlib/zbook/versions/v206.dat b/src/packlib/zbook/versions/v206.dat
deleted file mode 100644
index 230a332..0000000
--- a/src/packlib/zbook/versions/v206.dat
+++ /dev/null
@@ -1,11 +0,0 @@
-*
-* $Id: v206.dat,v 1.1.1.1 1996/03/08 12:01:15 mclareni Exp $
-*
-* $Log: v206.dat,v $
-* Revision 1.1.1.1 1996/03/08 12:01:15 mclareni
-* Zbook
-*
-*
-* Version 2.06 820707
-C SMALL BUG FIXED IN ZEPOUT
-C
diff --git a/src/packlib/zbook/versions/v207.dat b/src/packlib/zbook/versions/v207.dat
deleted file mode 100644
index 8f06164..0000000
--- a/src/packlib/zbook/versions/v207.dat
+++ /dev/null
@@ -1,11 +0,0 @@
-*
-* $Id: v207.dat,v 1.1.1.1 1996/03/08 12:01:15 mclareni Exp $
-*
-* $Log: v207.dat,v $
-* Revision 1.1.1.1 1996/03/08 12:01:15 mclareni
-* Zbook
-*
-*
-* Version 2.07 821126
-C PROTECTION IN ZEPKEY
-C
diff --git a/src/packlib/zbook/versions/v208.dat b/src/packlib/zbook/versions/v208.dat
deleted file mode 100644
index 1213d1e..0000000
--- a/src/packlib/zbook/versions/v208.dat
+++ /dev/null
@@ -1,11 +0,0 @@
-*
-* $Id: v208.dat,v 1.1.1.1 1996/03/08 12:01:15 mclareni Exp $
-*
-* $Log: v208.dat,v $
-* Revision 1.1.1.1 1996/03/08 12:01:15 mclareni
-* Zbook
-*
-*
-* Version 2.08 830310
-C ERROR MESSAGE ADDED IN ZEPIN
-C
diff --git a/src/packlib/zbook/versions/v209.dat b/src/packlib/zbook/versions/v209.dat
deleted file mode 100644
index 88b1d88..0000000
--- a/src/packlib/zbook/versions/v209.dat
+++ /dev/null
@@ -1,11 +0,0 @@
-*
-* $Id: v209.dat,v 1.1.1.1 1996/03/08 12:01:15 mclareni Exp $
-*
-* $Log: v209.dat,v $
-* Revision 1.1.1.1 1996/03/08 12:01:15 mclareni
-* Zbook
-*
-*
-* Version 2.09 831122
-C IMPROVEMENTS IN ZSHIFT
-C
diff --git a/src/packlib/zbook/versions/v210.dat b/src/packlib/zbook/versions/v210.dat
deleted file mode 100644
index 65aa4e2..0000000
--- a/src/packlib/zbook/versions/v210.dat
+++ /dev/null
@@ -1,11 +0,0 @@
-*
-* $Id: v210.dat,v 1.1.1.1 1996/03/08 12:01:15 mclareni Exp $
-*
-* $Log: v210.dat,v $
-* Revision 1.1.1.1 1996/03/08 12:01:15 mclareni
-* Zbook
-*
-*
-* Version 2.10 840324
-C Calls to UCOPY2 removed from ZPUSHS
-C
diff --git a/src/packlib/zbook/versions/v211.dat b/src/packlib/zbook/versions/v211.dat
deleted file mode 100644
index a9adfab..0000000
--- a/src/packlib/zbook/versions/v211.dat
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: v211.dat,v 1.1.1.1 1996/03/08 12:01:15 mclareni Exp $
-*
-* $Log: v211.dat,v $
-* Revision 1.1.1.1 1996/03/08 12:01:15 mclareni
-* Zbook
-*
-*
-* Version 2.11 840510
-C 2 more links added in the system bank
-C CRAY AND PR1ME versions introduced
-C New routine ZBFORM (See documentation)
-C Mods in ZEPIN,ZEPOUT,ZPRINT,ZINIT to take advantage of ZBFORM
-C Changes to compile under IBM VS compiler
-C PATCHY flag 'NORMAL' has been removed (default)
-C
diff --git a/src/packlib/zbook/versions/v212.dat b/src/packlib/zbook/versions/v212.dat
deleted file mode 100644
index ed9e822..0000000
--- a/src/packlib/zbook/versions/v212.dat
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: v212.dat,v 1.1.1.1 1996/03/08 12:01:15 mclareni Exp $
-*
-* $Log: v212.dat,v $
-* Revision 1.1.1.1 1996/03/08 12:01:15 mclareni
-* Zbook
-*
-*
-* Version 2.12 840919
-C New routine ZEPCLS
-C Protection introduced in ZBFORM
-C
diff --git a/src/packlib/zbook/versions/v213.dat b/src/packlib/zbook/versions/v213.dat
deleted file mode 100644
index 115f472..0000000
--- a/src/packlib/zbook/versions/v213.dat
+++ /dev/null
@@ -1,15 +0,0 @@
-*
-* $Id: v213.dat,v 1.1.1.1 1996/03/08 12:01:15 mclareni Exp $
-*
-* $Log: v213.dat,v $
-* Revision 1.1.1.1 1996/03/08 12:01:15 mclareni
-* Zbook
-*
-*
-* Version 2.13 841125
-C Protections in ZFCONV for the IBM VS compiler
-C Protections in ZPTFOR for the SIEMENS compiler
-C ZTRAP/ZJUMP implemented on APOLLO (A.Petrilli)
-C ZNAMSR modified to use type CHARACTER for binary search
-C New routine ZGFORM returning a bank format (see documentation)
-C
diff --git a/src/packlib/zbook/versions/v214.dat b/src/packlib/zbook/versions/v214.dat
deleted file mode 100644
index 3f06175..0000000
--- a/src/packlib/zbook/versions/v214.dat
+++ /dev/null
@@ -1,14 +0,0 @@
-*
-* $Id: v214.dat,v 1.1.1.1 1996/03/08 12:01:15 mclareni Exp $
-*
-* $Log: v214.dat,v $
-* Revision 1.1.1.1 1996/03/08 12:01:15 mclareni
-* Zbook
-*
-*
-* Version 2.14 850328
-C In addition to nH... (hollerith), CHARACTER strings ('...')
-C and CHARACTER variables are now allowed in calls
-C to ZBOOK routines
-C Bank format stored even if no conversion (ZEPIN)
-C
diff --git a/src/packlib/zbook/versions/v215.dat b/src/packlib/zbook/versions/v215.dat
deleted file mode 100644
index 5004b60..0000000
--- a/src/packlib/zbook/versions/v215.dat
+++ /dev/null
@@ -1,13 +0,0 @@
-*
-* $Id: v215.dat,v 1.1.1.1 1996/03/08 12:01:15 mclareni Exp $
-*
-* $Log: v215.dat,v $
-* Revision 1.1.1.1 1996/03/08 12:01:15 mclareni
-* Zbook
-*
-*
-* Version 2.15 850709
-C Two minor corrections for formatted banks: addition of
-C hexadecimal print (ZPBANK), bug corrected in ZPTFOR
-C (both only if F77 on).
-C
diff --git a/src/packlib/zbook/versions/v216.dat b/src/packlib/zbook/versions/v216.dat
deleted file mode 100644
index 1181721..0000000
--- a/src/packlib/zbook/versions/v216.dat
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: v216.dat,v 1.1.1.1 1996/03/08 12:01:15 mclareni Exp $
-*
-* $Log: v216.dat,v $
-* Revision 1.1.1.1 1996/03/08 12:01:15 mclareni
-* Zbook
-*
-*
-* Version 2.16 850911
-C Character strings now working on NORD500
-C FORTRAN 4 version is not supported anymore
-C Modified ZPRINT (ZPBANK) routines:
-C three or more identical lines printed only once.
-C The call to ZPBANK is corrected.
-C FORTRAN77 version made default, old version suppressed.
-C NORD mods: RFILE and WFILE calls replaced by READ, WRITE.
-C Patch ZCDES suppressed.
-C
diff --git a/src/packlib/zbook/versions/v217.dat b/src/packlib/zbook/versions/v217.dat
deleted file mode 100644
index 1782038..0000000
--- a/src/packlib/zbook/versions/v217.dat
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: v217.dat,v 1.1.1.1 1996/03/08 12:01:15 mclareni Exp $
-*
-* $Log: v217.dat,v $
-* Revision 1.1.1.1 1996/03/08 12:01:15 mclareni
-* Zbook
-*
-*
-* Version 2.17 851120
-C Minor correction in ZPRINT
-C Correction for mode 0 read in ZEPIN
-C
diff --git a/src/packlib/zbook/versions/v218.dat b/src/packlib/zbook/versions/v218.dat
deleted file mode 100644
index bccf364..0000000
--- a/src/packlib/zbook/versions/v218.dat
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: v218.dat,v 1.1.1.1 1996/03/08 12:01:15 mclareni Exp $
-*
-* $Log: v218.dat,v $
-* Revision 1.1.1.1 1996/03/08 12:01:15 mclareni
-* Zbook
-*
-*
-* Version 2.18 860108
-C Minor correction in ZPRINT
-C Correction for mode 0 read in ZEPIN
-C
diff --git a/src/packlib/zbook/versions/v219.dat b/src/packlib/zbook/versions/v219.dat
deleted file mode 100644
index e8c9ba9..0000000
--- a/src/packlib/zbook/versions/v219.dat
+++ /dev/null
@@ -1,11 +0,0 @@
-*
-* $Id: v219.dat,v 1.1.1.1 1996/03/08 12:01:15 mclareni Exp $
-*
-* $Log: v219.dat,v $
-* Revision 1.1.1.1 1996/03/08 12:01:15 mclareni
-* Zbook
-*
-*
-* Version 2.19
-C CRAY VERSIONS OF ZJUMP AND ZTRAP ADDED
-C
diff --git a/src/packlib/zbook/versions/v220.dat b/src/packlib/zbook/versions/v220.dat
deleted file mode 100644
index 68c475c..0000000
--- a/src/packlib/zbook/versions/v220.dat
+++ /dev/null
@@ -1,14 +0,0 @@
-*
-* $Id: v220.dat,v 1.1.1.1 1996/03/08 12:01:15 mclareni Exp $
-*
-* $Log: v220.dat,v $
-* Revision 1.1.1.1 1996/03/08 12:01:15 mclareni
-* Zbook
-*
-*
-* Version 2.20
-C APOLLO CORRECTIONS IN EXAMPLES
-C GENERAL BUG FIXES IN ROUTINE ZFRIBM
-C PATCH ZCRAY ZPR1ME DELETED
-C MINOR MODIFICATIONS TO ZJUMP AND ZTRAP
-C
diff --git a/src/packlib/zbook/versions/v221.dat b/src/packlib/zbook/versions/v221.dat
deleted file mode 100644
index 130495f..0000000
--- a/src/packlib/zbook/versions/v221.dat
+++ /dev/null
@@ -1,10 +0,0 @@
-*
-* $Id: v221.dat,v 1.1.1.1 1996/03/08 12:01:15 mclareni Exp $
-*
-* $Log: v221.dat,v $
-* Revision 1.1.1.1 1996/03/08 12:01:15 mclareni
-* Zbook
-*
-*
-* Version 2.21 880704 11.27
-C SMALL CORRECTION IN ZJUMP FOR APOLLO
diff --git a/src/packlib/zbook/versions/v222.dat b/src/packlib/zbook/versions/v222.dat
deleted file mode 100644
index 169644e..0000000
--- a/src/packlib/zbook/versions/v222.dat
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: v222.dat,v 1.1.1.1 1996/03/08 12:01:15 mclareni Exp $
-*
-* $Log: v222.dat,v $
-* Revision 1.1.1.1 1996/03/08 12:01:15 mclareni
-* Zbook
-*
-*
-* Version 2.22 900916 16.00
-C- New patches/flags:
-C SZBOOK: Source patch
-C FZBOOK: Flags patch
-C DZBOOK: Documentation patch (originally in P=HISTORY + P=INFORM)
-C segmenting version updates in decks
-C
-C- Reorganization of the pam structure
-C > Rename P=TEST to P=TZBOOK.
-C > Split P=ZBOOK,D=ZJUMP into the different machine versions
-C > Enable CONVEX version as CRAY
-C
-C- Modifications
-C > P=ZBOOK . Create sequence WLENGTH for ZEPDEF,ZEPIN,ZEPOUT
-C > P=ZBOOK,D=ZJUMP . Add C-version for UNIX
-C > P=ZBOOK,D=ZTRAP . Use LOCB in UNIX version
-C > P=ZBOOK,D=ZEPDEF. Use sequence WLENGTH
-C > P=ZBOOK,D=ZEPIN . Use sequence WLENGTH
-C > P=ZBOOK,D=ZEPOUT. Use sequence WLENGTH
-C > P=ZBOOK,D=ZINIT . Add LOUT for UNIX
-C > P=ZBOOK,D=ZIODO . Add READ/WRITE for UNIX
-C > P=ZEXAM,D=ZEXAM7. Correct OPEN(UNIT=1) for IBM, add OPEN for UNIX
-C
diff --git a/src/packlib/zbook/versions/v223.dat b/src/packlib/zbook/versions/v223.dat
deleted file mode 100644
index 2ab822f..0000000
--- a/src/packlib/zbook/versions/v223.dat
+++ /dev/null
@@ -1,15 +0,0 @@
-*
-* $Id: v223.dat,v 1.1.1.1 1996/03/08 12:01:15 mclareni Exp $
-*
-* $Log: v223.dat,v $
-* Revision 1.1.1.1 1996/03/08 12:01:15 mclareni
-* Zbook
-*
-*
-* Version 2.23 910210 16.30
-C- New patches/flags:
-C > Add HPUX, MIPS, IBMVM, IBMMVS, VAXVMS, VAXULX.
-C- Modifications
-C > P=ZBOOK,D=ZPRINT. Fix FORMAT statements for CONVEX
-C > P=ZBOOK,D=ZUSER . Enable for UNIX (disabled in 2.22)
-C
diff --git a/src/packlib/zbook/versions/v224.dat b/src/packlib/zbook/versions/v224.dat
deleted file mode 100644
index 4a0cf52..0000000
--- a/src/packlib/zbook/versions/v224.dat
+++ /dev/null
@@ -1,13 +0,0 @@
-*
-* $Id: v224.dat,v 1.1.1.1 1996/03/08 12:01:15 mclareni Exp $
-*
-* $Log: v224.dat,v $
-* Revision 1.1.1.1 1996/03/08 12:01:15 mclareni
-* Zbook
-*
-*
-* Version 2.24 910815 10.00
-C- Modifications
-C > P=FZBOOK . Update table of machines
-C Introduce QX_SC,QXNO_SC, QXCAPT in C-code
-C
diff --git a/src/packlib/zbook/versions/v225.dat b/src/packlib/zbook/versions/v225.dat
deleted file mode 100644
index 66fdbe9..0000000
--- a/src/packlib/zbook/versions/v225.dat
+++ /dev/null
@@ -1,15 +0,0 @@
-*
-* $Id: v225.dat,v 1.1.1.1 1996/03/08 12:01:15 mclareni Exp $
-*
-* $Log: v225.dat,v $
-* Revision 1.1.1.1 1996/03/08 12:01:15 mclareni
-* Zbook
-*
-*
-* Version 2.25 920720 2.00
-C- New patches/flags:
-C > Add IPSC, MSDOS
-C- Modifications
-C > P=ZBOOK ,D=ZINIT. Initialize HBOOK output unit
-C > P=ZEXAM ,D=ZEXAM. Disable ZEPEX1,2 except for VM and Vax/VMS
-C
diff --git a/src/packlib/zbook/versions/v226.dat b/src/packlib/zbook/versions/v226.dat
deleted file mode 100644
index 6816143..0000000
--- a/src/packlib/zbook/versions/v226.dat
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: v226.dat,v 1.1.1.1 1996/03/08 12:01:15 mclareni Exp $
-*
-* $Log: v226.dat,v $
-* Revision 1.1.1.1 1996/03/08 12:01:15 mclareni
-* Zbook
-*
-*
-* Version 2.26 930315 18.00
-C- Modifications
-C > P=ZBOOK ,D=ZINIT. Monitor usage
-C
diff --git a/src/packlib/zbook/versions/v227.dat b/src/packlib/zbook/versions/v227.dat
deleted file mode 100644
index a8ad15d..0000000
--- a/src/packlib/zbook/versions/v227.dat
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: v227.dat,v 1.1.1.1 1996/03/08 12:01:15 mclareni Exp $
-*
-* $Log: v227.dat,v $
-* Revision 1.1.1.1 1996/03/08 12:01:15 mclareni
-* Zbook
-*
-*
-* Version 2.27 931007 20.10
-C- New patches/flags:
-C > Add LINUX
-C
diff --git a/src/packlib/zbook/versions/v228.dat b/src/packlib/zbook/versions/v228.dat
deleted file mode 100644
index 3904cd3..0000000
--- a/src/packlib/zbook/versions/v228.dat
+++ /dev/null
@@ -1,11 +0,0 @@
-*
-* $Id: v228.dat,v 1.1.1.1 1996/03/08 12:01:14 mclareni Exp $
-*
-* $Log: v228.dat,v $
-* Revision 1.1.1.1 1996/03/08 12:01:14 mclareni
-* Zbook
-*
-*
-* Version 2.28 940830 14.20
-C Fix +SELF in ZERROR (JDS)
-C
diff --git a/src/packlib/zbook/ybook/Imakefile b/src/packlib/zbook/ybook/Imakefile
deleted file mode 100644
index 0d12eb6..0000000
--- a/src/packlib/zbook/ybook/Imakefile
+++ /dev/null
@@ -1,4 +0,0 @@
-SRCS_F= \ @@\
- ybook.F ybook0.F yfetch.F yinit.F ymove.F ypush.F ywork.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/zbook/ybook/ybook.F b/src/packlib/zbook/ybook/ybook.F
deleted file mode 100644
index 05bd7e1..0000000
--- a/src/packlib/zbook/ybook/ybook.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: ybook.F,v 1.1.1.1 1996/03/08 12:01:14 mclareni Exp $
-*
-* $Log: ybook.F,v $
-* Revision 1.1.1.1 1996/03/08 12:01:14 mclareni
-* Zbook
-*
-*
- SUBROUTINE YBOOK(IZ,ID,N)
-C
-C ******************************************************************
-C * *
-C * CREATION OF A BANK WITH POINTER ID IN BLANK COMMON *
-C * CHECKS SPACE. IF NOT ENOUGH ---> CALL HISTGO *
-C * *
-C ******************************************************************
-C
- DIMENSION IZ(1),ID(1)
-C
-C ------------------------------------------------------------------
-C
- JZ = IZ(1)
- IZ(JZ + 17) = 1
- CALL ZBOOKN(IZ,ID,N,0,' ',0)
- RETURN
- END
diff --git a/src/packlib/zbook/ybook/ybook0.F b/src/packlib/zbook/ybook/ybook0.F
deleted file mode 100644
index ffa6090..0000000
--- a/src/packlib/zbook/ybook/ybook0.F
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: ybook0.F,v 1.1.1.1 1996/03/08 12:01:14 mclareni Exp $
-*
-* $Log: ybook0.F,v $
-* Revision 1.1.1.1 1996/03/08 12:01:14 mclareni
-* Zbook
-*
-*
- SUBROUTINE YBOOK0(IZ,ID,N)
-C
-C ******************************************************************
-C * *
-C * SAME AS YBOOK + PRESET CONTENTS TO 0 *
-C * *
-C ******************************************************************
-C
- DIMENSION IZ(1),ID(1)
-C
-C ------------------------------------------------------------------
-C
- CALL ZBOOKN(IZ,ID,N,0,' ',0)
- RETURN
- END
diff --git a/src/packlib/zbook/ybook/yfetch.F b/src/packlib/zbook/ybook/yfetch.F
deleted file mode 100644
index 9d93870..0000000
--- a/src/packlib/zbook/ybook/yfetch.F
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: yfetch.F,v 1.1.1.1 1996/03/08 12:01:14 mclareni Exp $
-*
-* $Log: yfetch.F,v $
-* Revision 1.1.1.1 1996/03/08 12:01:14 mclareni
-* Zbook
-*
-*
- SUBROUTINE YFETCH(IZ,ID,LUNIT,KEY)
-C
-C ******************************************************************
-C * *
-C * FETCHS BANK ID STORED ON LOGICAL UNIT LUNIT *
-C * WITH PASSWORD=KEY AND CREATES A BANK *
-C * *
-C ******************************************************************
-C
- DIMENSION IZ(1),ID(1),KEY(1)
-C
-C ------------------------------------------------------------------
-C
- CALL ZFETCH(IZ,ID,LUNIT,KEY)
- RETURN
- END
diff --git a/src/packlib/zbook/ybook/yinit.F b/src/packlib/zbook/ybook/yinit.F
deleted file mode 100644
index 1d70273..0000000
--- a/src/packlib/zbook/ybook/yinit.F
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: yinit.F,v 1.1.1.1 1996/03/08 12:01:14 mclareni Exp $
-*
-* $Log: yinit.F,v $
-* Revision 1.1.1.1 1996/03/08 12:01:14 mclareni
-* Zbook
-*
-*
- SUBROUTINE YINIT(IZ,IW,NWORDS)
-C
-C ******************************************************************
-C * *
-C * INITIALISES A DYNAMIC AREA IN BLANK COMMON *
-C * EXTEND MEMORY *
-C * *
-C ******************************************************************
-C
- DIMENSION IZ(1),IW(1)
-C
-C ------------------------------------------------------------------
-C
- CALL ZHINIT(IZ,IW,NWORDS)
- RETURN
- END
diff --git a/src/packlib/zbook/ybook/ymove.F b/src/packlib/zbook/ybook/ymove.F
deleted file mode 100644
index 4c3d40a..0000000
--- a/src/packlib/zbook/ybook/ymove.F
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: ymove.F,v 1.1.1.1 1996/03/08 12:01:14 mclareni Exp $
-*
-* $Log: ymove.F,v $
-* Revision 1.1.1.1 1996/03/08 12:01:14 mclareni
-* Zbook
-*
-*
- SUBROUTINE YMOVE(IZ,N)
-C
-C ******************************************************************
-C * *
-C * MOVE END OF DYNAMIC AREA IZ BY N WORDS *
-C * N POSITIVE OR NEGATIVE *
-C * IF N.GT.0 POSSIBILITY OF MEMORY EXTENSION *
-C * *
-C ******************************************************************
-C
- DIMENSION IZ(1)
-C
-C ------------------------------------------------------------------
-C
- CALL ZMOVE(IZ,N)
- RETURN
- END
diff --git a/src/packlib/zbook/ybook/ypush.F b/src/packlib/zbook/ybook/ypush.F
deleted file mode 100644
index a5a173e..0000000
--- a/src/packlib/zbook/ybook/ypush.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: ypush.F,v 1.1.1.1 1996/03/08 12:01:14 mclareni Exp $
-*
-* $Log: ypush.F,v $
-* Revision 1.1.1.1 1996/03/08 12:01:14 mclareni
-* Zbook
-*
-*
- SUBROUTINE YPUSH(IZ,ID,NPUSH)
-C
-C ******************************************************************
-C * *
-C * REQUESTS N MORE (OR LESS) WORDS IN BANK ID (BLANK COMMON)*
-C * IF NOT ENOUGH SPACE REQUESTS MORE WORDS FOR *
-C * THE DYNAMIC STRUCTURE THROUGH THE HBOOK ROUTINE HISTGO *
-C * *
-C ******************************************************************
-C
- DIMENSION IZ(1),ID(1)
-C
-C ------------------------------------------------------------------
-C
- JZ = IZ(1)
- IZ(JZ + 17) = 1
- CALL ZPUSHS(IZ,ID,NPUSH,0)
- RETURN
-C
- END
diff --git a/src/packlib/zbook/ybook/ywork.F b/src/packlib/zbook/ybook/ywork.F
deleted file mode 100644
index 4be0c2c..0000000
--- a/src/packlib/zbook/ybook/ywork.F
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: ywork.F,v 1.1.1.1 1996/03/08 12:01:14 mclareni Exp $
-*
-* $Log: ywork.F,v $
-* Revision 1.1.1.1 1996/03/08 12:01:14 mclareni
-* Zbook
-*
-*
- SUBROUTINE YWORK(IZ,IWORK)
-C
-C ******************************************************************
-C * *
-C * RESERVES NWORK WORDS OF WORKINS SPACE IN BLANK COMMON *
-C * REDEFINES SIZE OF DYNAMIC STRUCTURE IF NOT ENOUGH SPACE *
-C * *
-C ******************************************************************
-C
- DIMENSION IZ(1)
-C
-C ------------------------------------------------------------------
-C
- CALL ZWORK(IZ,IWORK)
- RETURN
- END
diff --git a/src/packlib/zbook/zbook/Imakefile b/src/packlib/zbook/zbook/Imakefile
deleted file mode 100644
index de57ca5..0000000
--- a/src/packlib/zbook/zbook/Imakefile
+++ /dev/null
@@ -1,3 +0,0 @@
-INCLUDES= wlength.inc pilot.h pilot_c.h
-
-InstallIncludes($(INCLUDES),$(CERN_INCLUDEDIR),zbook)
diff --git a/src/packlib/zbook/zbook/pilot.h b/src/packlib/zbook/zbook/pilot.h
deleted file mode 100644
index 7a22016..0000000
--- a/src/packlib/zbook/zbook/pilot.h
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: pilot.h,v 1.1.1.1 1996/03/08 12:01:14 mclareni Exp $
-*
-* $Log: pilot.h,v $
-* Revision 1.1.1.1 1996/03/08 12:01:14 mclareni
-* Zbook
-*
-*
-#ifndef CERNLIB_UNIX
-#define CERNLIB_UNIX
-#endif
-
-#if (defined(CERNLIB_UNIX))&&(!defined(CERNLIB_SINGLE))
-#ifndef CERNLIB_DOUBLE
-#define CERNLIB_DOUBLE
-#endif
-#endif
-
-#if (!defined(CERNLIB_QXNO_SC))&&(!defined(CERNLIB_QXCAPT))
-#ifndef CERNLIB_QX_SC
-#define CERNLIB_QX_SC
-#endif
-#endif
diff --git a/src/packlib/zbook/zbook/pilot_c.h b/src/packlib/zbook/zbook/pilot_c.h
deleted file mode 100644
index f6ce8b0..0000000
--- a/src/packlib/zbook/zbook/pilot_c.h
+++ /dev/null
@@ -1,32 +0,0 @@
-/*
-* $Id: pilot_c.h,v 1.1.1.1 1996/03/08 12:01:14 mclareni Exp $
-*
-* $Log: pilot_c.h,v $
-* Revision 1.1.1.1 1996/03/08 12:01:14 mclareni
-* Zbook
-*
-*/
-
-#if (defined(CERNLIB_UNIX))&&(!defined(CERNLIB_SINGLE))
-#ifndef CERNLIB_DOUBLE
-#define CERNLIB_DOUBLE
-#endif
-#endif
-
-#ifdef CERNLIB_APOLLO
-#ifndef CERNLIB_QXNO_SC
-#define CERNLIB_QXNO_SC
-#endif
-#endif
-
-#ifdef CERNLIB_CRAY
-#ifndef CERNLIB_QXCAPT
-#define CERNLIB_QXCAPT
-#endif
-#endif
-
-#if (!defined(CERNLIB_QXNO_SC))&&(!defined(CERNLIB_QXCAPT))
-#ifndef CERNLIB_QX_SC
-#define CERNLIB_QX_SC
-#endif
-#endif
diff --git a/src/packlib/zbook/zbook/wlength.inc b/src/packlib/zbook/zbook/wlength.inc
deleted file mode 100644
index 20e34af..0000000
--- a/src/packlib/zbook/zbook/wlength.inc
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: wlength.inc,v 1.1.1.1 1996/03/08 12:01:13 mclareni Exp $
-*
-* $Log: wlength.inc,v $
-* Revision 1.1.1.1 1996/03/08 12:01:13 mclareni
-* Zbook
-*
-*
-*
-* wlength.inc
-*
-#if defined(CERNLIB_DOUBLE)
- DATA NBIT/32/
-#endif
-#if (defined(CERNLIB_SINGLE))&&(!defined(CERNLIB_CDC))
- DATA NBIT/64/
-#endif
-#if defined(CERNLIB_CDC)
- DATA NBIT/60/
-#endif
-#if defined(CERNLIB_UNIVAC)||defined(CERNLIB_PDP10)
- DATA NBIT/36/
-#endif
-#if defined(CERNLIB_BESM6)
- DATA NBIT/48/
-#endif
diff --git a/src/packlib/zebra/Imakefile b/src/packlib/zebra/Imakefile
deleted file mode 100644
index 6f74a33..0000000
--- a/src/packlib/zebra/Imakefile
+++ /dev/null
@@ -1,14 +0,0 @@
-
-#define IHaveSubdirs
-#define PassCDebugFlags
-
-LIBDIRS= dzebra fq jz91 mq mqg mqs mqv qend qutil rz tq
-SUBDIRS= $(LIBDIRS) test zebra
-
-TopOfPackage(zebra)
-
-SubdirLibraryTarget(zebra,$(LIBDIRS))
-
-TestSubdirs(test)
-
-InstallIncludeSubdirs(zebra)
diff --git a/src/packlib/zebra/doc/rzdoc.doc b/src/packlib/zebra/doc/rzdoc.doc
deleted file mode 100644
index 5e1a94d..0000000
--- a/src/packlib/zebra/doc/rzdoc.doc
+++ /dev/null
@@ -1,264 +0,0 @@
-*
-* $Id: rzdoc.doc,v 1.1.1.1 1996/03/06 10:47:05 mclareni Exp $
-*
-* $Log: rzdoc.doc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:05 mclareni
-* Zebra
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_zebra/pilot.h"
-* ********************************
-* * Directory Data Structure *
-* ********************************
-*
-* - Each LUN has a control bank in the linear chain pointed
-* by LQRS (system link 7). This bank is pointed by LTOP.
-*
-* - STATUS word description
-* - bit 1 =1 if no authorisation to modify directory
-* - bit 2 =1 if directory has been modified
-* - bit 3 =1 if file locked by 'RZFILE'
-* - bit 4 =1 if ORGANIZATION='RELATIVE' on VAX
-* - bit 5 =1 if C file access routine used
-* - bit 11-17 LOG level (default taken from MZ)
-*
-* - LTOP description
-*
-* *********************************************************
-* * -10* * Free reference link *
-* * -9 * * Free *
-* * -8 * LCORD * Pointer to odered cycles (RZCOPY) *
-* * -7 * LRIN * Pointer to input buffer *
-* * -6 * LROUT * Pointer to output buffer *
-* * -5 * LPURG * Pointer to list of purged records *
-* * -4 * LFROM * Pointer to copied directory *
-* * -3 * LUSED * pointer to list of used records *
-* * -2 * LFREE * Pointer to list of free records *
-* * -1 * LSDIR * Pointer to first subdirectory *
-* LTOP==>*IIII* * Status word *
-* * +1 * IDNAME* *
-* * +2 * * A , B , S , K , C areas *
-* * +3 * * *
-* * .. * * See below *
-* *LREC* * *
-* *********************************************************
-*
-* ************************************
-* * - A- DIRECTORY CONSTANTS *
-* ************************************
-* *******************************************************************
-* * WORD * TAG * CONTENT *
-* *******************************************************************
-* * 1 * * Directory name (up to 16 characters) *
-* * 2 * IDNAME * " *
-* * 3 * * " *
-* * 4 * * " *
-*KUP * 5 * * Record number of the mother directory, *
-* * 6 * * or C file pointer (words 5 and 6) *
-*KPW1 * 7 * IWPW1 * Write password (1st part) *
-* * 8 * IWPW2 * (2nd part) *
-* * 9 * NCHDRW * No. of char. DIR(1:5),WPW(6:10), and *
-* * * * bit 12 eXchange mode *
-*KDATEC * 10 * IDATEC * Creation date/time *
-*KDATEM * 11 * IDATEM * Last mod date/time *
-*KQUOTA * 12 * NQUOTA * Maximum number of records QUOTA *
-*KRUSED * 13 * NRUSED * Number of used records *
-*KWUSED * 14 * NWUSED * Number of words used MOD 1000000 *
-*KMEGA * 15 * NMEGA * Number of megawords used *
-*KRZVER * 16 * RZVER * Version of _this_ structure *
-*KIRIN * 17 * IRIN * Record number currently in LRIN *
-*KIROUT * 18 * IROUT * Record number currently in LROUT *
-*KRLOUT * 19 * IRLOUT* Number of the last record written *
-*KIP1 * 20 * IP1 * Pointer to first free word in IRLOUT *
-* * 21 * ICONT * Record number continuation *
-*KNFREE * 22 * NFREE * Number of words free in F *
-*KNSD * 23 * NSD * Number of subdirectories *
-*KLD * 24 * LD * Pointer to directory records *
-*KLB * 25 * LB * Pointer to file descriptor (only for TOP)*
-*KLS * 26 * LS * Pointer to first subdirectory S *
-*KLK * 27 * LK * Pointer to first KEY K *
-*KLF * 28 * LF * Pointer to free space F *
-*KLC * 29 * LC * Pointer to last cycle C *
-*KLE * 30 * LE * Pointer to end of directory *
-*KNKEYS * 31 * NKEYS * Number of keys in that directory *
-*KNWKEY * 32 * NWKEY * Number of elements in one key *
-*KKDES * 33 * KDES * KEYS descriptor (3 bits per element) *
-* * * ... * 10 keys per word *
-*KTAGS * 34+. * TAG11 * First part of CHTAG(1) 4 characters *
-* * 35+. * TAG12 * Second part *
-* * .. * * .... *
-* * * TAGN1 * First part of CHTAG(NWKEY) *
-* * * TAGN2 * Second part *
-* LD-> * +0 * NRD * Number of records to describe this dir. *
-* * +1 * IREC * Record number 1 of directory *
-* * +2 * * 2 *
-* * .. * * .. *
-* * +NRD * * NRD *
-* *******************************************************************
-*
-*
-*
-*
-* *****************************************
-* * - B- FILE DESCRIPTOR STRUCTURE *
-* *****************************************
-*
-* LB=IQ(KQSP+LTOP+25)
-*
-* *******************************************************************
-* * WORD * TAG * CONTENT *
-* *******************************************************************
-* LB-> * 1 * NWREC * Number of words for bitmap descriptor *
-* * 2 * LREC * Physical record length (in words) *
-* * 3 * IDATE * Creation date of the file *
-* * 4 * * BITMAP *
-* * 5 * * 1 bit per record on the file *
-* * . * * .. *
-* * * * etc... *
-* *******************************************************************
-*
-*
-*
-*
-* ********************************************
-* * - S- SUBDIRECTORY DESCRIPTOR STRUCTURE *
-* ********************************************
-*
-* LS=IQ(KQSP+LTOP+26)
-*
-* *******************************************************************
-* * WORD * TAG * CONTENT *
-* *******************************************************************
-* LS-> * 1 * NAM1 * Name of 1st subdirectory *
-* * 2 * NAM2 * " *
-* * 3 * NAM3 * " *
-* * 4 * NAM4 * " *
-* * 5 * NCHSD * Number of characters in subdirectory name *
-* * 6 * IRECSD * Record number of this subdirectory *
-* * 7 * IDTIME * Date and Time of creation of subdirectory *
-* * 8 * NAM1 * Name of 2nd subdirectory *
-* * 9 * NAM2 * " *
-* * 10 * NAM3 * " *
-* * 11 * NAM4 * " *
-* * 12 * NCHSD * Number of characters in subdirectory name *
-* * 13 * IRECSD * Record number of this subdirectory *
-* * 14 * IDTIME * Date and Time of creation of subdirectory *
-* * . * * .. *
-* * * * etc... *
-* *******************************************************************
-*
-*
-*
-* **********************************
-* * - K- KEYS STRUCTURE *
-* **********************************
-*
-* LK=IQ(KQSP+LTOP+27)
-*
-* *******************************************************************
-* * WORD * TAG * CONTENT *
-* *******************************************************************
-* LK-> * 1 * LCYC * Pointer to highest cycle in C for key 1 *
-* * 2 * KEYS(1)* First element of key 1 *
-* * 3 * KEYS(2)* Second element of key 1 (if any) *
-* * . * * ........... *
-* *NWKEY+1* KEYS() * NWKEYth element of key 1 *
-* * . * LCYC * Pointer to highest cycle in C for key 2 *
-* * . * * First element of key 2 *
-* * . * * Second element of key 2 (if any) *
-* * . * * ........... *
-* * . * * NWKEYth element of key 2 *
-* * . * * ........... *
-* * . * * ........... *
-* * . * * ........... *
-* * . * LCYC * Pointer to highest cycle in C for key NKEYS*
-* * . * * First element of key NKEYS *
-* * . * * Second element of key NKEYS (if any) *
-* * . * * ........... *
-* * . * * NWKEYth element of key NKEYS *
-* *******************************************************************
-*
-*
-*
-* **********************************
-* * LOCK record STRUCTURE *
-* **********************************
-*
-* *******************************************************************
-* * WORD * TAG * CONTENT *
-* *******************************************************************
-* * 1 * NLOCK * Number of locks *
-* * 2 * IFREE * Pointer to first free word in record *
-* * 3 * FLAG * LOCK flag *
-* * 4 * NWLOCK * Number of words for 1st lock *
-* * 5 * LOCK1 * First part of the lock ID *
-* * 6 * LOCK2 * Second part of the lock ID *
-* * 7 * DATE/T * Date and time of the lock *
-* * 8 * IRECD * Record number of the locked directory *
-* * 9 * ND * Number of couples (first,last) *
-* * 10 * IR1 * 1st record locked *
-* * 11 * IRL * last record locked *
-* * 12 * IR1 * " *
-* * 13 * IRL * " *
-* * 14 * .. * *
-*NWLOCK+4* * NWLOCK * Number of words for second lock *
-* * . * * .. *
-* * * * etc... *
-*IFREE * . * 0 * First free word (content=0) *
-* * . * * .. *
-* *******************************************************************
-*
-*
-*
-* **********************************
-* * - C- CYCLES STRUCTURE *
-* **********************************
-*
-*
-* For each cycle (version 0)
-*
-* WORD 1 - Pointer to previous cycle of KEY (bits 1 to 16)(0 if no)
-* - Second record (if there) (bits 17 to 32)
-*
-* WORD 2 - Creation date relative to 1986 (bits 9 TO 32)
-* - Creation time. 1minute precision
-* - RZKEEP (bit 5)
-* - Append mode (bit 4)
-* - Vector format (if RZVOUT) (bits 1 to 3)
-*
-* WORD 3 - Record number where data str. starts (bits 17 to 32)
-* - Offset in record (bits 1 to 16)
-*
-* WORD 4 - Number of words in data structure (bits 1 to 20)
-* - Cycle number (bits 21 to 32)
-*
-* For each cycle (version 1)
-*
-* WORD 1 - Pointer to previous cycle of KEY (0 if no)
-*
-* WORD 2 - Creation date relative to 1986 (bits 9 TO 32)
-* - Creation time. 1minute precision
-* - RZKEEP (bit 5)
-* - Append mode (bit 4)
-* - Vector format (if RZVOUT) (bits 1 to 3)
-*
-* WORD 3 - Record number where data str. starts
-*
-* WORD 4 - Offset in record (bits 1 to 20)
-* - Cycle number (bits 21 to 32)
-*
-* WORD 5 - Number of words in data structure
-*
-* WORD 6 - Second record (if there)
-*
-* WORD 7 - Key number to which the cycle belongs
-* (This is in fact KEY(1) of the corresponding key
-* and so is only a soft cross-check - the absolute
-* key number will change if entries are deleted).
-*
-*
-* The pointer LCYC in structure K points to WORD 1
-*
-*
-*Last line of RZ PAM
diff --git a/src/packlib/zebra/dzebra/Imakefile b/src/packlib/zebra/dzebra/Imakefile
deleted file mode 100644
index 62ee008..0000000
--- a/src/packlib/zebra/dzebra/Imakefile
+++ /dev/null
@@ -1,13 +0,0 @@
-SRCS_F= dzare1.F dzarea.F dzbkdv.F dzbkhd.F dzbkup.F dzbkxr.F \ @@\
- dzchbk.F dzchst.F dzchv1.F dzchvc.F dzdata.F dzform.F dzforp.F \ @@\
- dziopd.F dzioph.F dziopr.F dzmap.F dzopt.F dzshow.F dzshpr.F \ @@\
- dzsnap.F dzstdv.F dzstla.F dzstor.F dzsurv.F dzswap.F dztext.F \ @@\
- dztyp.F dzveri.F dzzero.F lzloc.F nzleft.F zdvcop.F zpage.F
-
-#ifdef CERNLIB_HPUX
-SpecialFortranLibObjectRule(dzbkhd,dzbkhd,'-WF,-P',NullParameter)
-SpecialFortranLibObjectRule(dzsnap,dzsnap,'-WF,-P',NullParameter)
-SpecialFortranLibObjectRule(dzstor,dzstor,'-WF,-P',NullParameter)
-#endif
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/zebra/dzebra/dzare1.F b/src/packlib/zebra/dzebra/dzare1.F
deleted file mode 100644
index 3dfcafa..0000000
--- a/src/packlib/zebra/dzebra/dzare1.F
+++ /dev/null
@@ -1,232 +0,0 @@
-*
-* $Id: dzare1.F,v 1.2 1996/04/24 17:26:00 mclareni Exp $
-*
-* $Log: dzare1.F,v $
-* Revision 1.2 1996/04/24 17:26:00 mclareni
-* Extend the include file cleanup to dzebra, rz and tq, and also add
-* dependencies in some cases.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:06 mclareni
-* Zebra
-*
-*
-*-----------------------------------------------------------
-#include "zebra/pilot.h"
-#if (defined(CERNLIB_DEBUGON))&&(defined(CERNLIB_VFORT))
-#include "zebra/debugvf1.inc"
-#endif
- SUBROUTINE DZARE1 (CHTEXT,CLA,LLA,CHOPT)
- SAVE CLATYP
-#include "zebra/mqsys.inc"
-#include "zebra/qequ.inc"
-#include "zebra/mzcn.inc"
-#include "zebra/zbcdch.inc"
-#include "zebra/zbcdk.inc"
-#include "zebra/zstate.inc"
-#include "zebra/zunit.inc"
-#include "zebra/dzc1.inc"
-#include "zebra/questparq.inc"
-#include "zebra/storparq.inc"
- CHARACTER *(*) CLA,CHOPT,CHTEXT
- INTEGER ILANAM(2)
-
- CHARACTER CHROUT*(*),CHSTAK*6, CLATYP(0:1)*9, CLA8*8, CAKTIV*8
- PARAMETER (CHROUT = 'DZARE1')
- DATA CLATYP /'PERMANENT','TEMPORARY'/
-
-#include "zebra/q_jbit.inc"
-#include "zebra/q_jbyt.inc"
-
-#if (defined(CERNLIB_DEBUGON))&&(defined(CERNLIB_VFORT))
-#include "zebra/debugvf2.inc"
-#endif
-
-
- CHSTAK = CQSTAK(MCQSIQ:)
- CQSTAK(MCQSIQ:) = CHROUT
-
- IF (LQSTA(KQT+JQDVSY).EQ.LQEND(KQT+JQDVSY)) THEN
- IQUEST(1) = 0
- GO TO 999
- ENDIF
-
- LSYSB = LQSYSS(KQT+MSYLAQ)
- CALL MZCHLS(NCHEKQ,LSYSB)
- IF (IQFOUL.NE.0) THEN
- WRITE(CQINFO,'(''Store = '',2A4)') NQSNAM(1),NQSNAM(2)
- CALL DZTEXT(MARE1Q,CHTEXT,0)
- GO TO 999
- ENDIF
-
-
- NWTAB = IQ(KQS+LSYSB+MLAUSQ)
- IF(NWTAB.LE.1) THEN
- WRITE(CQINFO,'(''Store = '',2A4)') NQSNAM(1),NQSNAM(2)
- CALL DZTEXT(MARE2Q,CHTEXT,0)
- GO TO 999
- ENDIF
-
- IF (IFLOPT(MPOSNQ).NE.0) THEN
-
-
- CLA8 = CLA
- CALL UCTOH (CLA8,ILANAM,4,8)
- ELSE
-
-
- LLINK = LOCF(LLA) - LQSTOR
- ENDIF
-
-
- LENTRY = LSYSB + KQS + MLAUSQ
-
- IFOUND = 0
-
- DO 100 IENTRY = 1,(NWTAB-1)/NLAENQ
-
-
- IF (IFLOPT(MPOSNQ).NE.0) THEN
- IF(CLA.NE.' ') THEN
- IF (ILANAM(1).NE.IQ(LENTRY+MLAN1Q) .OR.
- X ILANAM(2).NE.IQ(LENTRY+MLAN2Q) ) GO TO 100
- ELSE
- IF(IENTRY.LE.2) GO TO 100
- ENDIF
-
- ELSE
-
-
- IF (LLINK.LT.IQ(LENTRY+MLAADQ) .OR.
- X LLINK.GT.IQ(LENTRY+MLALTQ) ) GO TO 100
-
- ENDIF
-
-
- LLAAR1 = IQ(LENTRY+MLAADQ)
- LLAARL = IQ(LENTRY+MLALTQ)
- NLANS = IQ(LENTRY+MLANSQ)
- JTEMP = JBIT(NLANS,JLATMQ)
- NTEMP = NLATMQ*JTEMP
- NLANS = JBYT(NLANS,JLANSQ,NLANSQ)-NTEMP
- IF(JTEMP.EQ.0.OR.
- + (JTEMP.EQ.1.AND.LQ(KQS+LLAAR1+MLACTQ-1).NE.0)) THEN
- CAKTIV = ' ACTIVE'
- ELSE
- CAKTIV = 'INACTIVE'
- ENDIF
-
-
- DO 50 I = NTEMP,NLANS-1
- LS = LQ(KQS+LLAAR1+I)
- IF (LS.EQ.0) GO TO 50
- CALL MZCHLS(NCHEKQ,LS)
- ID = IQID
- IF (JBIT(IQ(KQS+LS),IQDROP).EQ.1) GO TO 50
- IF (IQFOUL.EQ.0) THEN
- LUP = LQLUP(KQS+LS)
- IF (LUP.EQ.0) GO TO 40
- CALL MZCHLS(NCHEKQ,LUP)
- IF (IQFOUL.NE.0) THEN
- WRITE(CQINFO,
- X '(2A4,''/'',I5,''= '',A4,2I10)')
- X IQ(LENTRY+MLAN1Q),IQ(LENTRY+MLAN2Q),
- X I+1,ID,LS,LUP
- CALL DZTEXT(MARE3Q,CDUMMQ,0)
- ENDIF
- 40 LORIG = LQLORG(KQS+LS)
- IF (LORIG.EQ.0) GO TO 50
- IF(LORIG.LT.IQTABV(KQT+13).OR.LORIG.GT.IQTABV(KQT+14))
- X THEN
- WRITE(CQINFO,'(2A4,''/'',I5,''= '',A4,2I10)')
- X IQ(LENTRY+MLAN1Q),IQ(LENTRY+MLAN2Q),
- X I+1,ID,LS,LORIG
- CALL DZTEXT(MARE4Q,CDUMMQ,0)
- ELSEIF (LQ(KQS+LORIG).NE.LS) THEN
- WRITE(CQINFO,'(2A4,''/'',I5,''= '',A4,2I10)')
- X IQ(LENTRY+MLAN1Q),IQ(LENTRY+MLAN2Q),
- X I+1,ID,LS,LORIG
- CALL DZTEXT(MARE4Q,CDUMMQ,0)
- ENDIF
- IF (IQND.LT.NQDCUT.AND.IFLOPT(MPOSTQ).NE.0)
- X CALL SBIT1 (IQ(KQS+LS),IQCRIT)
- ELSE
- WRITE(CQINFO,'(2A4,''/'',I5,''='',I10)')
- X IQ(LENTRY+MLAN1Q),IQ(LENTRY+MLAN2Q),I+1,LS
- CALL DZTEXT(MARE5Q,CDUMMQ,0)
- ENDIF
- 50 CONTINUE
-
- IF (IFLOPT(MPOSQQ).EQ.0) THEN
- IF (CHTEXT.NE.CDUMMQ) THEN
- CQMAP(1) = ' '
- CQMAP(2) = ' DZAREA -- '
- CQMAP(2)(12:) = CHTEXT
- WRITE(CQMAP(2)(80:),'('' -- Dump of link area '',2A4,
- W '' Options: '',A)')
- W IQ(LENTRY+MLAN1Q),IQ(LENTRY+MLAN2Q),CHOPT
- CALL DZTEXT(0,CDUMMQ,2)
- ENDIF
-
- CQMAP(1) = ' '
- WRITE(CQMAP(2),
-#if !defined(CERNLIB_OCTMAP)
- W '('' This '',A9,'' LINK AREA is at absolute address '',Z8,
-#endif
-#if defined(CERNLIB_OCTMAP)
- W '('' This '',A9,'' LINK AREA is at absolute address '',O11,
-#endif
- W '' with NL/NS ='',I7,''/'',I7,4X,'' and is '',A8)' )
- W CLATYP(JTEMP),(LLAAR1+LQSTOR)
-#if !defined(CERNLIB_WORDMAP)
- W *4
-#endif
- W ,LLAARL-LLAAR1-NTEMP,NLANS,CAKTIV
- CALL DZTEXT(0,CDUMMQ,2)
- CALL DZTEXT(1,CDUMMQ,1)
-
-
- LBASE = LLAAR1 + NTEMP - 1
- IBASE = 0
- NDW = LLAARL - LLAAR1 - NTEMP
- JDFD = NDW + 1
-
- CALL DZDATA(CDUMMQ)
-
- IFOUND = 1
- IF (IFLOPT(MPOSNQ).NE.0) THEN
- IF (CLA.NE.' ') GO TO 999
- ELSE
- GO TO 999
- ENDIF
- ELSE
- IQUEST(10) = IENTRY
- IQUEST(11) = IQ(LENTRY+MLAN1Q)
- IQUEST(12) = IQ(LENTRY+MLAN2Q)
- IQUEST(13) = LLAAR1
- IQUEST(14) = LLAAR1 + NLANS
- IQUEST(15) = LLAARL
- IQUEST(16) = NLANS
- IQUEST(17) = LLAARL-LLAAR1
- IQUEST(18) = JTEMP
- IQUEST(19) = LQ(KQS+LLAAR1+MLACTQ-1)
- GO TO 999
- ENDIF
- 100 LENTRY = LENTRY + NLAENQ
-
- IF (IFOUND.EQ.0) THEN
- IF (IFLOPT(MPOSQQ).EQ.0) THEN
- IF (IFLOPT(MPOSNQ).NE.0) THEN
- WRITE(CQINFO,'(A)') CLA8
- CALL DZTEXT(MARE6Q,CHTEXT,0)
- ELSE
- WRITE(CQINFO,'(I8)') LLINK
- CALL DZTEXT(MARE7Q,CHTEXT,0)
- ENDIF
- ELSE
- IQUEST(10) = 0
- ENDIF
- ENDIF
-
- 999 CQSTAK(MCQSIQ:) = CHSTAK
- RETURN
- END
diff --git a/src/packlib/zebra/dzebra/dzarea.F b/src/packlib/zebra/dzebra/dzarea.F
deleted file mode 100644
index d6d3d0a..0000000
--- a/src/packlib/zebra/dzebra/dzarea.F
+++ /dev/null
@@ -1,37 +0,0 @@
-*
-* $Id: dzarea.F,v 1.1.1.1 1996/03/06 10:47:05 mclareni Exp $
-*
-* $Log: dzarea.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:05 mclareni
-* Zebra
-*
-*
-*-----------------------------------------------------------
-#include "zebra/pilot.h"
-#if (defined(CERNLIB_DEBUGON))&&(defined(CERNLIB_VFORT))
-#include "zebra/debugvf1.inc"
-#endif
- SUBROUTINE DZAREA (CHTEXT,IXSTOR,CLA,LLA,CHOPT)
-#include "zebra/quest.inc"
-#include "zebra/dzc1.inc"
- CHARACTER *(*) CLA,CHOPT,CHTEXT
-
- CHARACTER CHROUT*(*)
- PARAMETER (CHROUT = 'DZAREA')
-
- ENTRY DZLINK (CHTEXT,IXSTOR,CLA,LLA,CHOPT)
-#if (defined(CERNLIB_DEBUGON))&&(defined(CERNLIB_VFORT))
-#include "zebra/debugvf2.inc"
-#endif
-
- CQSTAK = CHROUT//'/'
- IQUEST(1) = 0
-
- CALL DZOPT(CHOPT)
-
- CALL MZSDIV(IXSTOR,-1)
-
- CALL DZARE1(CHTEXT,CLA,LLA,CHOPT)
-
- 999 RETURN
- END
diff --git a/src/packlib/zebra/dzebra/dzbkdv.F b/src/packlib/zebra/dzebra/dzbkdv.F
deleted file mode 100644
index 6034736..0000000
--- a/src/packlib/zebra/dzebra/dzbkdv.F
+++ /dev/null
@@ -1,55 +0,0 @@
-*
-* $Id: dzbkdv.F,v 1.1.1.1 1996/03/06 10:47:06 mclareni Exp $
-*
-* $Log: dzbkdv.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:06 mclareni
-* Zebra
-*
-*
-*-----------------------------------------------------------
-#include "zebra/pilot.h"
-#if (defined(CERNLIB_DEBUGON))&&(defined(CERNLIB_VFORT))
-#include "zebra/debugvf1.inc"
-#endif
- SUBROUTINE DZBKDV(LBANK)
-#include "zebra/questparq.inc"
-#include "zebra/mqsys.inc"
-#include "zebra/mzcn.inc"
-#include "zebra/dzc1.inc"
-
- CHARACTER CHROUT*(*),CHSTAK*6
- PARAMETER (CHROUT = 'DZBKDV')
-
-#if (defined(CERNLIB_DEBUGON))&&(defined(CERNLIB_VFORT))
-#include "zebra/debugvf2.inc"
-#endif
-
-
- CHSTAK = CQSTAK(MCQSIQ:)
- CQSTAK(MCQSIQ:) = CHROUT
-
-
- JQDIVI = 1
- IF (LBANK.LT.LQEND(KQT+JQDVLL)) GO TO 100
- IF (LBANK.GE.LQEND(KQT+NDVMXQ)) THEN
- CALL DZTEXT(MBKD1Q,CDUMMQ,0)
- IQUEST(1) = 1
- GO TO 999
- ENDIF
- JQDIVI = JQDVSY
-
- 100 IF (LBANK.LT.LQEND(KQT+JQDIVI)) GO TO 200
- JQDIVI = JQDIVI + 1
- GO TO 100
-
- 200 IF (LBANK.LT.LQSTA(KQT+JQDIVI)) THEN
- CALL DZTEXT(MBKD2Q,CDUMMQ,0)
- IQUEST(1) = 1
- GO TO 999
- ENDIF
- CALL UHTOC(IQDN1(KQT+JQDIVI),4,CQDIV(1:),4)
- CALL UHTOC(IQDN2(KQT+JQDIVI),4,CQDIV(5:),4)
-
- 999 CQSTAK(MCQSIQ:) = CHSTAK
- RETURN
- END
diff --git a/src/packlib/zebra/dzebra/dzbkhd.F b/src/packlib/zebra/dzebra/dzbkhd.F
deleted file mode 100644
index 5bf9881..0000000
--- a/src/packlib/zebra/dzebra/dzbkhd.F
+++ /dev/null
@@ -1,94 +0,0 @@
-*
-* $Id: dzbkhd.F,v 1.2 1996/04/24 17:26:02 mclareni Exp $
-*
-* $Log: dzbkhd.F,v $
-* Revision 1.2 1996/04/24 17:26:02 mclareni
-* Extend the include file cleanup to dzebra, rz and tq, and also add
-* dependencies in some cases.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:06 mclareni
-* Zebra
-*
-*
-*-----------------------------------------------------------
-#include "zebra/pilot.h"
-#if (defined(CERNLIB_DEBUGON))&&(defined(CERNLIB_VFORT))
-#include "zebra/debugvf1.inc"
-#endif
- SUBROUTINE DZBKHD
-#include "zebra/bankparq.inc"
-#include "zebra/questparq.inc"
-#include "zebra/mqsys.inc"
-#include "zebra/qequ.inc"
-#include "zebra/mzcn.inc"
-#include "zebra/zbcdch.inc"
-#include "zebra/zbcdk.inc"
-#include "zebra/zunit.inc"
-#include "zebra/dzc1.inc"
-
- CHARACTER CHROUT*(*),CHSTAK*6,CLIVE*1,CLORIG*8
- PARAMETER (CHROUT = 'DZBKHD')
-
-#include "zebra/q_jbit.inc"
-#include "zebra/q_jbyt.inc"
-
-#if (defined(CERNLIB_DEBUGON))&&(defined(CERNLIB_VFORT))
-#include "zebra/debugvf2.inc"
-#endif
-
-
- CHSTAK = CQSTAK(MCQSIQ:)
- CQSTAK(MCQSIQ:) = CHROUT
-
- IF (JBIT(IQ(KQS+LS),IQDROP).EQ.0) THEN
-
- CALL DZBKDV(LS)
- IF (IQUEST(1).NE.0) GO TO 999
-
-
- CALL DZBKUP(LS)
-
-
- CALL DZBKXR(LS)
-
- CLIVE = ' '
- ELSE
- CLIVE = '('
- ENDIF
-
-
- LORIG = LQLORG(KQS+LS)
- IF (LORIG.NE.LNULL) THEN
- IF (LORIG.LT.IQTABV(KQT+13).OR.LORIG.GT.IQTABV(KQT+14)) THEN
- CLORIG = '_'
- ELSE
- WRITE(CLORIG,'(I8)') LQ(KQS+LORIG)
- ENDIF
- ELSE
- CLORIG = '0'
- ENDIF
-
-
- WRITE(CQLINE,
- W '(1X,A1,A4,''.'',I6,I9,''('',A ,'') SY/US/IO '',Z4,''/'',Z5,
- W ''/'',Z4,'' NL/NS/ND'',I5,''/'',I5,''/'',I8,'' N/U/O/@O'',
-#if (!defined(CERNLIB_QMIBM))&&(!defined(CERNLIB_QMVAX))
- W I8,''/'',I8,''/'',I8,''/'',A)', ERR=999)
-#endif
-#if defined(CERNLIB_QMVAX)
- W I8,''/'',I8,''/'',I8,''/'',A)', IOSTAT=ISTAT)
-#endif
-#if defined(CERNLIB_QMIBM)
- W I8,''/'',I8,''/'',I8,''/'',A)')
-#endif
- W CLIVE, IQWIDH(KQS+LS),IQWIDN(KQS+LS),LS,CQDIV,
- W JBYT(IQ(KQS+LS),JBKSYQ,NBKSYQ),JBYT(IQ(KQS+LS),JBKUSQ,NBKUSQ),
- W JBYT(LQ(KQS+LN+MBKIOQ),JBKIOQ,NBKIOQ),NL,NS,ND,
- W LQ(KQS+LS),LQLUP(KQS+LS),LORIG,CLORIG
-
- IF (IFLOPT(MPOSQQ).EQ.0) CALL DZTEXT(0,CDUMMQ,1)
- IQUEST(1) = 0
-
- 999 CQSTAK(MCQSIQ:) = CHSTAK
- RETURN
- END
diff --git a/src/packlib/zebra/dzebra/dzbkup.F b/src/packlib/zebra/dzebra/dzbkup.F
deleted file mode 100644
index 2b8ab32..0000000
--- a/src/packlib/zebra/dzebra/dzbkup.F
+++ /dev/null
@@ -1,147 +0,0 @@
-*
-* $Id: dzbkup.F,v 1.2 1996/04/24 17:26:03 mclareni Exp $
-*
-* $Log: dzbkup.F,v $
-* Revision 1.2 1996/04/24 17:26:03 mclareni
-* Extend the include file cleanup to dzebra, rz and tq, and also add
-* dependencies in some cases.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:06 mclareni
-* Zebra
-*
-*
-*-----------------------------------------------------------
-#include "zebra/pilot.h"
-#if (defined(CERNLIB_DEBUGON))&&(defined(CERNLIB_VFORT))
-#include "zebra/debugvf1.inc"
-#endif
- SUBROUTINE DZBKUP(LBANK)
- SAVE LASTAK,NLASTR
-#include "zebra/bankparq.inc"
-#include "zebra/questparq.inc"
-#include "zebra/storparq.inc"
-#include "zebra/mqsys.inc"
-#include "zebra/qequ.inc"
-#include "zebra/mzcn.inc"
-#include "zebra/dzc1.inc"
-
- CHARACTER CHROUT*(*),CHSTAK*6
- PARAMETER (CHROUT = 'DZBKUP')
-
- PARAMETER (NSTAKQ = 200)
- INTEGER LASTAK(NSTAKQ)
-
-#include "zebra/q_jbit.inc"
-#include "zebra/q_jbyt.inc"
-
-#if (defined(CERNLIB_DEBUGON))&&(defined(CERNLIB_VFORT))
-#include "zebra/debugvf2.inc"
-#endif
-
-
- CHSTAK = CQSTAK(MCQSIQ:)
- CQSTAK(MCQSIQ:) = CHROUT
-
-
- IF (LBANK.EQ.0) THEN
-
-
- LLASTR = 1
- NLASTR = 0
-
- IF (LQSTA(KQT+JQDVSY).EQ.LQEND(KQT+JQDVSY)) GO TO 999
-
- LSYSB = LQSYSS(KQT+MSYLAQ)
- IF(LSYSB.GT.0) THEN
- CALL MZCHLS(NCHEKQ,LSYSB)
- IF (IQFOUL.NE.0) THEN
- WRITE(CQINFO,'(''Store = '',2A4)')
- X NQSNAM(1),NQSNAM(2)
- CALL DZTEXT(MARE1Q,CDUMMQ,0)
- IQUEST(1) = 1
- GO TO 999
- ENDIF
-
-
- NWTAB = IQ(KQS+LSYSB+MLAUSQ)
-
-
- LENTRY = LSYSB + KQS + MLAUSQ
-
- DO 100 IENTRY = 1,(NWTAB-1)/NLAENQ
-
- LLAAR1 = IQ(LENTRY+MLAADQ)
- NLANS = IQ(LENTRY+MLANSQ)
- JTEMP = JBIT(NLANS,JLATMQ)
- NTEMP = NLATMQ*JTEMP
- NLANS = JBYT(IQ(LENTRY+MLANSQ),JLANSQ,NLANSQ) - NTEMP
- IF (NLANS.GT.0) THEN
- IF (NLASTR.GE.NSTAKQ/2) THEN
- WRITE(CQINFO,'('' LLASTR NSTAKQ '',2I6)')
- X LLASTR,NSTAKQ
- CALL DZTEXT(MBKU1Q,CDUMMQ,0)
- IQUEST(1) = 1
- GO TO 999
- ENDIF
- LASTAK(LLASTR ) = LLAAR1+NTEMP
- LASTAK(LLASTR+1) = LLAAR1+NTEMP+NLANS-1
- NLASTR = NLASTR+1
- LLASTR = LLASTR+2
- ENDIF
-
- LENTRY = LENTRY + NLAENQ
- 100 CONTINUE
- ENDIF
- GO TO 999
- ELSE
-
-
- LUP = LQLUP(KQS+LBANK)
- IF (LUP.NE.0) THEN
- CALL MZCHLS(NCHEKQ,LUP)
- IF (IQFOUL.NE.0) THEN
- CALL DZBKDV(LBANK)
- IF (IQUEST(1).NE.0) GO TO 999
- CQINFO = CQDIV//'/'
- WRITE(CQINFO(10:),'(I8,'','',I8,'','',I4)')
- X LBANK,LUP,IQFOUL
- CALL DZTEXT(MBKU2Q,CDUMMQ,0)
- IQUEST(1) = 1
- GO TO 999
- ENDIF
- ENDIF
-
-
- LSUP = LQLORG(KQS+LBANK)
- IF (LSUP.EQ.0.AND.LUP.EQ.0) GO TO 999
- IF (LSUP.LT.LQSTA(KQT+1).OR.
- X LSUP.GT.LQSTA(KQT+NDVMXQ+1)) THEN
- LOCSUP = LSUP
- DO 200 I = 1,NLASTR
- IF (LOCSUP.GE.LASTAK(I*2-1)
- X .AND.
- X LOCSUP.LE.LASTAK(I*2)) GO TO 300
- 200 CONTINUE
- CALL DZBKDV(LS)
- IF (IQUEST(1).NE.0) GO TO 999
- WRITE(CQINFO,'(A,''/'',I8,'','',I8,''('',Z8,'')'')')
- X CQDIV,LS,LSUP,LSUP+LQSTOR
- CALL DZTEXT(MBKU3Q,CDUMMQ,0)
- IQUEST(1) = 1
- GO TO 999
- ENDIF
-
-
- 300 IF (LQ(LSUP+KQS).NE.LS) THEN
- WRITE(CQINFO,'(I8,''('',Z8,'')'',2I8)')
- X LSUP,LSUP+LQSTOR,LQ(LSUP+KQS),LS
- CALL DZTEXT(MBKU4Q,CDUMMQ,0)
- IQUEST(1) = 1
- GO TO 999
- ENDIF
- GO TO 999
- ENDIF
-
- 999 CQSTAK(MCQSIQ:) = CHSTAK
- RETURN
- END
diff --git a/src/packlib/zebra/dzebra/dzbkxr.F b/src/packlib/zebra/dzebra/dzbkxr.F
deleted file mode 100644
index 8f8f3d1..0000000
--- a/src/packlib/zebra/dzebra/dzbkxr.F
+++ /dev/null
@@ -1,148 +0,0 @@
-*
-* $Id: dzbkxr.F,v 1.2 1996/04/24 17:26:04 mclareni Exp $
-*
-* $Log: dzbkxr.F,v $
-* Revision 1.2 1996/04/24 17:26:04 mclareni
-* Extend the include file cleanup to dzebra, rz and tq, and also add
-* dependencies in some cases.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:06 mclareni
-* Zebra
-*
-*
-*-----------------------------------------------------------
-#include "zebra/pilot.h"
-#if (defined(CERNLIB_DEBUGON))&&(defined(CERNLIB_VFORT))
-#include "zebra/debugvf1.inc"
-#endif
- SUBROUTINE DZBKXR(LBANK)
- SAVE NDVXRF
-#include "zebra/bankparq.inc"
-#include "zebra/divparq.inc"
-#include "zebra/questparq.inc"
-#include "zebra/mqsys.inc"
-#include "zebra/qequ.inc"
-#include "zebra/mzcn.inc"
-#include "zebra/dzc1.inc"
-
- CHARACTER CHROUT*(*),CHSTAK*6
- PARAMETER (CHROUT = 'DZBKXR')
-
-#include "zebra/q_jbit.inc"
-#include "zebra/q_jbyt.inc"
-
-#if (defined(CERNLIB_DEBUGON))&&(defined(CERNLIB_VFORT))
-#include "zebra/debugvf2.inc"
-#endif
-
-
- CHSTAK = CQSTAK(MCQSIQ:)
- CQSTAK(MCQSIQ:) = CHROUT
-
- IF (LBANK.EQ.0) THEN
-
-
-
- IXREF = IQRTO(KQT+JQDIVI)
- DO 110 I=1,NDVMXQ
- IF (JBIT(IXREF,I).NE.0) THEN
- IQUEST(30+I) = 1
- ELSE
- IQUEST(30+I) = 0
- ENDIF
- 110 CONTINUE
- IF (JBIT(IXREF,JDVUSQ).EQ.1) THEN
- DO 120 I=1,JQDVLL
- 120 IQUEST(30+I) = 1
- ENDIF
- IF (JBYT(IXREF,JDVLGQ,2).NE.0) THEN
- DO 130 I=JQDVSY+1,NDVMXQ
- 130 IQUEST(30+I) = 1
- ENDIF
- IF (JBIT(IXREF,JDVSYQ).EQ.1) IQUEST(30+JQDVSY) = 1
- IQUEST(30+JQDIVI) = 1
- NDVXRF = 0
- DO 140 I=1,NDVMXQ
- IF (I.GT.JQDVLL.AND.I.LT.JQDVSY) GO TO 140
- IF (IQUEST(30+I).EQ.1) THEN
- NDVXRF = NDVXRF + 1
- IQUEST(30+NDVXRF) = I
- ENDIF
- 140 CONTINUE
-
- GO TO 999
- ELSE
-
-
- LB = LBANK-NL+KQS
- LE = LBANK +KQS
- DO 220 L=LB,LE
- IF (LQ(L).EQ.0) GO TO 220
- DO 210 I=1,NDVXRF
- IDVXRF = IQUEST(30+I)
- IF (LQ(L).GE.LQSTA(KQT+IDVXRF).AND.
- X LQ(L).LT.LQEND(KQT+IDVXRF) ) GO TO 220
- 210 CONTINUE
- CALL DZBKDV(LBANK)
- IF (IQUEST(1).NE.0) GO TO 999
- CQINFO = CQDIV//'/'
- CALL DZBKDV(LQ(L))
- IF (IQUEST(1).NE.0) GO TO 999
- WRITE(CQINFO(10:),'(I8,'','',A,''/'',I8)')
- X LBANK,CQDIV,LQ(L)
- CALL DZTEXT(MBKX1Q,CDUMMQ,0)
- IQUEST(1) = 1
- GO TO 999
- 220 CONTINUE
-
-
- LUP = LQLUP(KQS+LBANK)
-
- IF (LUP.NE.0) THEN
- DO 310 I=1,NDVXRF
- IDVXRF = IQUEST(30+I)
- IF (LUP.GE.LQSTA(KQT+IDVXRF).AND.
- X LUP.LT.LQEND(KQT+IDVXRF) ) GO TO 400
- 310 CONTINUE
- CALL DZBKDV(LBANK)
- IF (IQUEST(1).NE.0) GO TO 999
- CQINFO = CQDIV//'/'
- CALL DZBKDV(LUP)
- IF (IQUEST(1).NE.0) GO TO 999
- WRITE(CQINFO(10:),'(I8,'','',A,''/'',I8)')
- X LBANK,CQDIV,LUP
- CALL DZTEXT(MBKX2Q,CDUMMQ,0)
- IQUEST(1) = 1
- GO TO 999
- ENDIF
-
-
- 400 LSUP = LQLORG(KQS+LBANK)
-
- IF (LSUP.EQ.0.AND.LUP.EQ.0) GO TO 999
- IF (LSUP.GE.LQSTA(KQT+1).AND.
- X LSUP.LE.LQSTA(KQT+NDVMXQ+1)) THEN
-
-
- DO 410 I=1,NDVXRF
- IDVXRF = IQUEST(30+I)
- IF (LSUP.GE.LQSTA(KQT+IDVXRF).AND.
- X LSUP.LT.LQEND(KQT+IDVXRF) ) GO TO 999
- 410 CONTINUE
-
- CALL DZBKDV(LBANK)
- IF (IQUEST(1).NE.0) GO TO 999
- CQINFO = CQDIV//'/'
- CALL DZBKDV(LSUP)
- IF (IQUEST(1).NE.0) GO TO 999
- WRITE(CQINFO(10:),'(I8,'','',A,''/'',I8)')
- X LBANK,CQDIV,LSUP
- CALL DZTEXT(MBKX3Q,CDUMMQ,0)
- IQUEST(1) = 1
- GO TO 999
- ENDIF
- ENDIF
-
- 999 CQSTAK(MCQSIQ:) = CHSTAK
- RETURN
- END
diff --git a/src/packlib/zebra/dzebra/dzchbk.F b/src/packlib/zebra/dzebra/dzchbk.F
deleted file mode 100644
index 96ecf31..0000000
--- a/src/packlib/zebra/dzebra/dzchbk.F
+++ /dev/null
@@ -1,107 +0,0 @@
-*
-* $Id: dzchbk.F,v 1.1.1.1 1996/03/06 10:47:06 mclareni Exp $
-*
-* $Log: dzchbk.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:06 mclareni
-* Zebra
-*
-*
-*-----------------------------------------------------------
-#include "zebra/pilot.h"
-#if (defined(CERNLIB_DEBUGON))&&(defined(CERNLIB_VFORT))
-#include "zebra/debugvf1.inc"
-#endif
- SUBROUTINE DZCHBK (CHTEXT,IXDIV,LBANK,CHOPT,ISUM)
- SAVE CHPART
-#include "zebra/mqsys.inc"
-#include "zebra/mzcn.inc"
-#include "zebra/zbcdch.inc"
-#include "zebra/zbcdk.inc"
-#include "zebra/zunit.inc"
-#include "zebra/dzc1.inc"
- CHARACTER *(*) CHOPT,CHTEXT,CHPART(4)*6
- PARAMETER ( NLSUMQ = 8 )
- INTEGER ISUM(*),ISMOLD(NLSUMQ)
-#include "zebra/bankparq.inc"
-#include "zebra/storparq.inc"
- PARAMETER ( MDATAQ = 1 )
- PARAMETER ( MLINKQ = 3 )
- PARAMETER ( MSYSTQ = 5 )
- PARAMETER ( MBANKQ = 7 )
-
- CHARACTER CHROUT*(*)
- PARAMETER (CHROUT = 'DZCHBK')
-
- DATA CHPART /'DATA','LINK','SYSTEM','GLOBAL'/
-#if (defined(CERNLIB_DEBUGON))&&(defined(CERNLIB_VFORT))
-#include "zebra/debugvf2.inc"
-#endif
-
- CQSTAK = CHROUT//'/'
- IQUEST(1) = 0
-
- CALL DZOPT(CHOPT)
-
- IOPTV = IFLOPT(MPOSVQ)
-
- CALL MZSDIV(IXDIV,-1)
- CALL MZCHLS(-7,LBANK)
-
- IF (IOPTV.NE.0) THEN
- DO 100 I=1,NLSUMQ
- 100 ISMOLD(I) = ISUM(I)
- ENDIF
-
- CALL DZCHV1 (LBANK+1+NOFLIQ+KQS,LBANK+IQND+NOFLIQ+KQS,0,
- X ISUM(MDATAQ) )
- IF (IQUEST(1).NE.0) GO TO 999
- CALL DZCHV1 (LBANK-IQNL+KQS,LBANK-1+KQS,0,ISUM(MLINKQ))
- IF (IQUEST(1).NE.0) GO TO 999
- CALL DZCHV1 (LBANK+KQS,LBANK+NOFLIQ+KQS,0,ISUM(MSYSTQ))
- IF (IQUEST(1).NE.0) GO TO 999
- CALL DZCHV1 (LBANK-IQNL-NBKHDQ+KQS,LBANK+IQND+NOFLIQ+KQS,0,
- X ISUM(MBANKQ) )
- IF (IQUEST(1).NE.0) GO TO 999
-
- IF (IOPTV.NE.0) THEN
- DO 200 I=1,NLSUMQ/2
- II = (I-1)*2 + 1
- IF ( (ISUM(II) .NE.ISMOLD(II) )
- I .OR. (ISUM(II+1).NE.ISMOLD(II+1)) ) THEN
- IQUEST(10+I) = 1
- IQUEST(1) = 1
- ELSE
- IQUEST(10+I) = 0
- ENDIF
- 200 CONTINUE
- ENDIF
-
- IF (CHTEXT.NE.CDUMMQ) THEN
- CQMAP(1) = ' '
- CQMAP(2)(1:10) = ' * '//CHROUT//' '
- CQMAP(2)(11:29) = CHTEXT
- CQMAP(2)(30:41) = ' / OPTION : '
- CQMAP(2)(42:47) = CHOPT
- DO 300 I=1,NLSUMQ/2
- II = (I-1)*2 + 1
- IF (IOPTV.NE.0) THEN
- IF (IQUEST(10+I).NE.0) THEN
- CQMAP(2)(118:130) = '??PROBLEMS? '
- ELSE
- CQMAP(2)(118:130) = ' OK'
- ENDIF
- WRITE(CQMAP(2)(48:117),
- W '(''OLD='',Z4,1X,Z16,4X,''NEW='',Z4,1X,Z16,T63,A)')
- W ISMOLD(II+1),ISMOLD(II),ISUM(II+1),ISUM(II),CHPART(I)
- ELSE
-
- WRITE(CQMAP(2)(48:),'(''NEW='',Z4,1X,Z16,T63,A)')
- W ISUM(II+1),ISUM(II),CHPART(I)
- ENDIF
- CALL DZTEXT(0,CDUMMQ,2)
- CQMAP(2) = ' '
- 300 CONTINUE
- ENDIF
-
- 999 RETURN
- END
diff --git a/src/packlib/zebra/dzebra/dzchst.F b/src/packlib/zebra/dzebra/dzchst.F
deleted file mode 100644
index 18b199f..0000000
--- a/src/packlib/zebra/dzebra/dzchst.F
+++ /dev/null
@@ -1,234 +0,0 @@
-*
-* $Id: dzchst.F,v 1.2 1996/04/24 17:26:06 mclareni Exp $
-*
-* $Log: dzchst.F,v $
-* Revision 1.2 1996/04/24 17:26:06 mclareni
-* Extend the include file cleanup to dzebra, rz and tq, and also add
-* dependencies in some cases.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:06 mclareni
-* Zebra
-*
-*
-*-----------------------------------------------------------
-#include "zebra/pilot.h"
-#if (defined(CERNLIB_DEBUGON))&&(defined(CERNLIB_VFORT))
-#include "zebra/debugvf1.inc"
-#endif
- SUBROUTINE DZCHST (CHTEXT,IXDIV,LBANK,CHOPT,ISUM)
- SAVE CHPART
-#include "zebra/bankparq.inc"
-#include "zebra/questparq.inc"
-#include "zebra/storparq.inc"
-#include "zebra/mqsys.inc"
-#include "zebra/qequ.inc"
-#include "zebra/mzcn.inc"
-#include "zebra/zbcdch.inc"
-#include "zebra/zbcdk.inc"
-#include "zebra/zunit.inc"
-#include "zebra/dzc1.inc"
- CHARACTER *(*) CHOPT,CHTEXT,CHPART(3)*6
-
- CHARACTER CHROUT*(*)
- PARAMETER (CHROUT = 'DZCHST')
-
- PARAMETER ( NPDENQ = 3 )
- PARAMETER ( MPDCUQ = 1 )
- PARAMETER ( MPDNCQ = 2 )
- PARAMETER ( MPDNSQ = 3 )
-
-* 32 BIT MACHINES
-#if defined(CERNLIB_B32)
- PARAMETER ( NBITS = 8 )
-* 36 BIT MACHINE
-#endif
-#if defined(CERNLIB_B36)
- PARAMETER ( NBITS = 9 )
-* 60 BIT MACHINE
-#endif
-#if defined(CERNLIB_B60)
- PARAMETER ( NBITS = 15 )
-* 64 BIT MACHINE
-#endif
-#if defined(CERNLIB_B64)
- PARAMETER ( NBITS = 16 )
-#endif
-
- PARAMETER ( NLSUMQ = 6 )
- INTEGER ISUM(*),ISMOLD(NLSUMQ)
-
- DATA CHPART /'DATA','LINK','SYSTEM'/
-
-#if (defined(CERNLIB_DEBUGON))&&(defined(CERNLIB_VFORT))
-#include "zebra/debugvf2.inc"
-#endif
-
- CQSTAK = CHROUT//'/'
- IQUEST(1) = 0
-
- CALL DZOPT(CHOPT)
-
- IF (IFLOPT(MPOSVQ).NE.0) THEN
- DO 10 I=1,NLSUMQ
- 10 ISMOLD(I) = ISUM(I)
- ENDIF
-
- CALL MZSDIV(IXDIV,-1)
-
-
- LWORK = NQOFFS(1) + LQEND(1) - NPDENQ - 1
- LWORKE = NQOFFS(1) + LQSTA(2) - NPDENQ
-
-
- LCUR = LBANK
- LEVEL = 0
-
-
- MAXALL = 0
- NTBANK = 0
- DO 20 I=1,NDVMXQ
- IF(I.LE.JQDVLL.OR.I.GE.JQDVSY)
- I MAXALL = MAXALL + LQEND(KQT+I) - LQSTA(KQT+I)
- 20 CONTINUE
-
-
-
- CALL VZERO(IQUEST(71),12)
-
-
- 100 CALL MZCHLS (NCHEKQ,LCUR)
- IF (IQFOUL.NE.0) THEN
- CALL DZBKDV(LCUR)
- IF (IQUEST(1).NE.0) GO TO 999
- WRITE(CQINFO,'(A,''/'',I8)') CQDIV,LCUR
- CALL DZTEXT(MSHP1Q,CDUMMQ,0)
- IQUEST(1) = 1
- GO TO 999
- ENDIF
-
- CALL DZCHV1 (LCUR+1+NOFLIQ+KQS,LCUR+IQND+NOFLIQ+KQS,70,0)
- IF (IQUEST(1).NE.0) GO TO 999
- CALL DZCHV1 (LCUR-IQNL+KQS,LCUR+2+KQS,74,0)
- IF (IQUEST(1).NE.0) GO TO 999
- CALL DZCHV1 (LCUR+3+KQS,LCUR+NOFLIQ+KQS,78,0)
- IF (IQUEST(1).NE.0) GO TO 999
- CALL DZCHV1 (LCUR-IQNL-1+KQS,LCUR-IQNL-1+KQS,78,0)
- IF (IQUEST(1).NE.0) GO TO 999
-
- NTBANK = NTBANK + NL + ND + NBKOHQ
- IF (NTBANK.GE.MAXALL) THEN
- WRITE(CQINFO,'(I10,''/'',I10)') MAXALL,NTBANK
- CALL DZTEXT(MSHO1Q,CDUMMQ,0)
- IQUEST(1) = 1
- GO TO 999
- ENDIF
-
-
- LEVEL = LEVEL+1
- LWORK = LWORK + NPDENQ
- IF (LWORK.GE.LWORKE) THEN
- WRITE(CQINFO,'(I10)') LEVEL
- CALL DZTEXT(MSHO2Q,CDUMMQ,0)
- IQUEST(1) = 1
- GO TO 999
- ENDIF
-
-
- IF (IFLOPT(MPOSDQ).EQ.0) IQNS = 0
-
- LQ(LWORK+MPDCUQ) = LCUR
- LQ(LWORK+MPDNCQ) = IQNS
- LQ(LWORK+MPDNSQ) = IQNS
-
-
- 200 IF (LQ(LWORK+MPDNCQ).LE.0) THEN
- IF (LEVEL.GT.1.OR.IFLOPT(MPOSLQ).NE.0) THEN
- LCUR = LQ(KQS + LQ(LWORK+MPDCUQ))
- LEVEL = LEVEL - 1
- LWORK = LWORK - NPDENQ
- IF (LCUR.NE.LNULL) THEN
- GO TO 100
- ELSE
- IF (LEVEL.GT.0) THEN
- GO TO 200
- ELSE
- GO TO 300
- ENDIF
- ENDIF
- ELSE
- LEVEL = LEVEL-1
- LWORK = LWORK - NPDENQ
- IF (LEVEL.GT.0) THEN
- GO TO 200
- ELSE
- GO TO 300
- ENDIF
- ENDIF
- ENDIF
-
-
- LQ(LWORK+MPDNCQ) = LQ(LWORK+MPDNCQ) - 1
- LCUR = LQ(KQS+LQ(LWORK+MPDCUQ)
- X -LQ(LWORK+MPDNSQ)+LQ(LWORK+MPDNCQ))
-
- IF (LCUR.EQ.LNULL) GO TO 200
- GO TO 100
-
-
-
- 300 DO 320 I=1,NLSUMQ/2
- II = (I-1)*2
-
- JCARRY = 0
- IBIT = 1
- DO 310 JF=70+I*4-3,70+I*4
- IQUEST (JF) = IQUEST(JF) + JCARRY
- JCARRY = IQUEST(JF)/2**NBITS
- IQUEST (JF) = IQUEST(JF) - JCARRY*(2**NBITS)
- CALL SBYT(IQUEST(JF),ISUM(II+1),IBIT,NBITS)
- 310 IBIT = IBIT + NBITS
- ISUM(II+2) = JCARRY
- 320 CONTINUE
-
- IF (IFLOPT(MPOSVQ).NE.0) THEN
- DO 400 I=1,NLSUMQ/2
- II = (I-1)*2 + 1
- IF ( (ISUM(II) .NE.ISMOLD(II) )
- I .OR. (ISUM(II+1).NE.ISMOLD(II+1)) ) THEN
- IQUEST(10+I) = 1
- IQUEST(1) = 1
- ELSE
- IQUEST(10+I) = 0
- ENDIF
- 400 CONTINUE
- ENDIF
-
- IF (CHTEXT.NE.CDUMMQ) THEN
- CQMAP(1) = ' '
- CQMAP(2)(1:10) = ' * '//CHROUT//' '
- CQMAP(2)(11:29) = CHTEXT
- CQMAP(2)(30:41) = ' / OPTION : '
- CQMAP(2)(42:47) = CHOPT
- DO 500 I=1,NLSUMQ/2
- II = (I-1)*2 + 1
- IF (IFLOPT(MPOSVQ).NE.0) THEN
- IF (IQUEST(10+I).NE.0) THEN
- CQMAP(2)(118:130) = '??PROBLEMS? '
- ELSE
- CQMAP(2)(118:130) = ' OK'
- ENDIF
- WRITE(CQMAP(2)(48:117),
- W '(''OLD='',Z4,1X,Z16,4X,''NEW='',Z4,1X,Z16,T63,A)')
- W ISMOLD(II+1),ISMOLD(II),ISUM(II+1),ISUM(II),CHPART(I)
- ELSE
-
- WRITE(CQMAP(2)(48:),'(''NEW='',Z4,1X,Z16,T63,A)')
- W ISUM(II+1),ISUM(II),CHPART(I)
- ENDIF
- CALL DZTEXT(0,CDUMMQ,2)
- CQMAP(2) = ' '
- 500 CONTINUE
- ENDIF
-
- 999 RETURN
- END
diff --git a/src/packlib/zebra/dzebra/dzchv1.F b/src/packlib/zebra/dzebra/dzchv1.F
deleted file mode 100644
index 07a9e2c..0000000
--- a/src/packlib/zebra/dzebra/dzchv1.F
+++ /dev/null
@@ -1,100 +0,0 @@
-*
-* $Id: dzchv1.F,v 1.2 1996/04/24 17:26:07 mclareni Exp $
-*
-* $Log: dzchv1.F,v $
-* Revision 1.2 1996/04/24 17:26:07 mclareni
-* Extend the include file cleanup to dzebra, rz and tq, and also add
-* dependencies in some cases.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:06 mclareni
-* Zebra
-*
-*
-*-----------------------------------------------------------
-#include "zebra/pilot.h"
- SUBROUTINE DZCHV1 (LBEGIN,LEND,IXQUES,ISUM)
-#if defined(CERNLIB_QMCRY)
-CDIR$ INTEGER=64
-#endif
-#include "zebra/mqsys.inc"
-#include "zebra/zbcdch.inc"
-#include "zebra/zbcdk.inc"
-#include "zebra/zunit.inc"
-#include "zebra/dzc1.inc"
-#include "zebra/questparq.inc"
-#include "zebra/storparq.inc"
- INTEGER ISUM(*)
- PARAMETER ( NFIELD = 4 )
-* 32 BIT MACHINES
-#if defined(CERNLIB_B32)
- PARAMETER ( NBITS = 8 )
-* 36 BIT MACHINE
-#endif
-#if defined(CERNLIB_B36)
- PARAMETER ( NBITS = 9 )
-* 60 BIT MACHINE
-#endif
-#if defined(CERNLIB_B60)
- PARAMETER ( NBITS = 15 )
-* 64 BIT MACHINE
-#endif
-#if defined(CERNLIB_B64)
- PARAMETER ( NBITS = 16 )
-#endif
- PARAMETER ( NWMAX = 2**(NBITS*(NFIELD-1)-1) )
- INTEGER IFIELD(NFIELD)
-
- CHARACTER CHROUT*(*),CHSTAK*6
- PARAMETER (CHROUT = 'DZCHV1')
-
-#include "zebra/q_jbyt.inc"
-
-#if (defined(CERNLIB_DEBUGON))&&(defined(CERNLIB_VFORT))
-#include "zebra/debugvf2.inc"
-#endif
-
-
-
-
- CHSTAK = CQSTAK(MCQSIQ:)
- CQSTAK(MCQSIQ:) = CHROUT
-
- NWTOT = LEND - LBEGIN + 1
- IF (NWTOT.GT.NWMAX) THEN
- WRITE(CQINFO,'(2I10)') NWTOT,NWMAX
- CALL DZTEXT(MCHV1Q,CDUMMQ,0)
- IQUEST(1) = 1
- GO TO 999
- ENDIF
-
- IF (IXQUES.NE.0) THEN
- DO 10 JF=1,NFIELD
- 10 IFIELD(JF) = IQUEST(IXQUES+JF)
- ELSE
- DO 20 JF=1,NFIELD
- 20 IFIELD(JF) = 0
- ENDIF
-
-
- DO 100 JW=LBEGIN,LEND
- DO 100 JF=1,NFIELD
- JFIELD=JBYT(LQ(JW),(JF-1)*NBITS+1,NBITS)
- 100 IFIELD (JF) = IFIELD(JF) + JFIELD
-
- IF (IXQUES.EQ.0) THEN
- JCARRY = 0
-
- DO 200 JF=1,NFIELD
- IFIELD (JF) = IFIELD(JF) + JCARRY
- JCARRY = IFIELD(JF)/2**NBITS
- IFIELD (JF) = IFIELD(JF) - JCARRY*(2**NBITS)
- 200 CALL SBYT(IFIELD(JF),ISUM(1),(JF-1)*NBITS+1,NBITS)
- ISUM(2) = JCARRY
- ELSE
- DO 300 JF=1,4
- 300 IQUEST(IXQUES+JF) = IFIELD(JF)
- ENDIF
-
- 999 CQSTAK(MCQSIQ:) = CHSTAK
- RETURN
- END
diff --git a/src/packlib/zebra/dzebra/dzchvc.F b/src/packlib/zebra/dzebra/dzchvc.F
deleted file mode 100644
index bc273e7..0000000
--- a/src/packlib/zebra/dzebra/dzchvc.F
+++ /dev/null
@@ -1,82 +0,0 @@
-*
-* $Id: dzchvc.F,v 1.2 1996/04/24 17:26:07 mclareni Exp $
-*
-* $Log: dzchvc.F,v $
-* Revision 1.2 1996/04/24 17:26:07 mclareni
-* Extend the include file cleanup to dzebra, rz and tq, and also add
-* dependencies in some cases.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:06 mclareni
-* Zebra
-*
-*
-*-----------------------------------------------------------
-#include "zebra/pilot.h"
-#if (defined(CERNLIB_DEBUGON))&&(defined(CERNLIB_VFORT))
-#include "zebra/debugvf1.inc"
-#endif
- SUBROUTINE DZCHVC (CHTEXT,IXSTOR,LBEGIN,LEND,CHOPT,ISUM)
-#include "zebra/mqsys.inc"
-#include "zebra/zbcdch.inc"
-#include "zebra/zbcdk.inc"
-#include "zebra/zunit.inc"
-#include "zebra/dzc1.inc"
-#include "zebra/storparq.inc"
- CHARACTER *(*) CHOPT,CHTEXT
- PARAMETER ( NLSUMQ = 2 )
- INTEGER ISUM(*),ISMOLD(NLSUMQ)
-
- CHARACTER CHROUT*(*)
- PARAMETER (CHROUT = 'DZCHVC')
-
-#if (defined(CERNLIB_DEBUGON))&&(defined(CERNLIB_VFORT))
-#include "zebra/debugvf2.inc"
-#endif
-
- CQSTAK = CHROUT//'/'
- IQUEST(1) = 0
-
- CALL DZOPT(CHOPT)
-
- CALL MZSDIV(IXSTOR,-1)
-
- IF (IFLOPT(MPOSVQ).NE.0) THEN
- ISMOLD(1) = ISUM(1)
- ISMOLD(2) = ISUM(2)
- ENDIF
-
-
- CALL DZCHV1(LBEGIN+KQS,LEND+KQS,0,ISUM)
- IF(IQUEST(1).NE.0) GO TO 999
-
-
- IF (IFLOPT(MPOSVQ).NE.0) THEN
- IF ((ISUM(1).NE.ISMOLD(1)).OR.(ISUM(2).NE.ISMOLD(2))) THEN
- IQUEST(1) = 1
- ENDIF
- ENDIF
-
- IF (CHTEXT.NE.CDUMMQ) THEN
- CQMAP(1) = ' '
- CQMAP(2)(1:10) = ' * '//CHROUT//' '
- CQMAP(2)(11:29) = CHTEXT
- CQMAP(2)(30:41) = ' / OPTION : '
- CQMAP(2)(42:47) = CHOPT
- IF (IFLOPT(MPOSVQ).NE.0) THEN
- IF (IQUEST(1).NE.0) THEN
- CQMAP(2)(118:130) = '??PROBLEMS? '
- ELSE
- CQMAP(2)(118:130) = ' OK'
- ENDIF
- WRITE(CQMAP(2)(48:117),
- W '(''OLD='',Z4,1X,Z16,4X,''NEW='',Z4,1X,Z16)')
- W ISMOLD(2),ISMOLD(1),ISUM(2),ISUM(1)
- ELSE
- WRITE(CQLINE(48:),'(''NEW='',Z4,1X,Z16)') ISUM(2),ISUM(1)
- ENDIF
- CALL DZTEXT(0,CDUMMQ,2)
- CQMAP(2) = ' '
- ENDIF
-
- 999 RETURN
- END
diff --git a/src/packlib/zebra/dzebra/dzdata.F b/src/packlib/zebra/dzebra/dzdata.F
deleted file mode 100644
index efe3f81..0000000
--- a/src/packlib/zebra/dzebra/dzdata.F
+++ /dev/null
@@ -1,169 +0,0 @@
-*
-* $Id: dzdata.F,v 1.1.1.1 1996/03/06 10:47:06 mclareni Exp $
-*
-* $Log: dzdata.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:06 mclareni
-* Zebra
-*
-*
-*-----------------------------------------------------------
-#include "zebra/pilot.h"
-#if (defined(CERNLIB_DEBUGON))&&(defined(CERNLIB_VFORT))
-#include "zebra/debugvf1.inc"
-#endif
- SUBROUTINE DZDATA (CHTEXT)
- SAVE IHOLE
-#include "zebra/mqsys.inc"
-#include "zebra/qequ.inc"
-#include "zebra/mzcn.inc"
-#include "zebra/zmach.inc"
-#include "zebra/zunit.inc"
-#include "zebra/dzc1.inc"
-
-
- PARAMETER ( MLITXQ = 6 )
- PARAMETER ( NLINEQ = 24 )
- PARAMETER ( MLLKBQ = 17 , MLLKEQ = 24 )
- PARAMETER ( MLDRQ = 10 )
- PARAMETER ( MLIDBQ = 11 , MLIDEQ = 14 )
-
- PARAMETER ( NENLNQ = 5 )
- PARAMETER ( NLNGRQ = 10 )
-
- CHARACTER*(*) CHTEXT
-
- CHARACTER CHROUT*(*),CHSTAK*6 ,CTEXT1*1,CSTART*3
- PARAMETER (CHROUT = 'DZDATA')
- DATA IHOLE /4H*HO*/
-
-#if (defined(CERNLIB_DEBUGON))&&(defined(CERNLIB_VFORT))
-#include "zebra/debugvf2.inc"
-#endif
-
-
- CHSTAK = CQSTAK(MCQSIQ:)
- CQSTAK(MCQSIQ:) = CHROUT
-
- IF (NDW.LE.0) GO TO 999
-
- CTEXT1 = CHTEXT(1:1)
- CSTART = ' '
- IF (LEN(CHTEXT).GT.1) THEN
- IF (CTEXT1.EQ.'+') CSTART = CHTEXT(2:)
- ENDIF
-
- 9 IF (CHTEXT.NE.CDUMMQ.AND.CTEXT1.NE.'+') THEN
- CQLINE = ' '//CHTEXT
- CQLINE(60:) = '--------------------'
- CALL DZTEXT(0,CDUMMQ,1)
- ENDIF
- JDST = 1
-
-
- 10 JDL = JDST
-
- 12 NSAME= IUSAME (LQ(LBASE+KQS+1),JDL,NDW,30,JSAME)
-
- JDL = JSAME + NSAME - 1
- IF (JDL.NE.NDW) JDL=10*(JDL/10)
- IF (JSAME.NE.JDST) GO TO 20
- 16 J = LBASE + JSAME
- N = JDL+1 - JSAME
- WRITE(CQLINE,'(T30,''====='',I9,'' WORDS from'',I9,
- X '' to'',I9,'' all contain'',Z18)') N,JSAME,JDL,LQ(J+KQS)
- CALL DZTEXT(0,CDUMMQ,1)
- IF (JDL.GE.NDW) GO TO 999
- JDST= JDL + 1
- GO TO 10
-
- 20 JDE = JSAME - 1
- N = JDE - JDST
- NPG = N/NENLNQ + 1
- IF (NPG.GT.NLNGRQ) NPG = NLNGRQ
- NPG1= NPG + 1
- NGRV= N/(NPG*NENLNQ) + 1
-
- CALL ZPAGE (IQPRNT,NPG1)
- NGRP = (NQLNOR-NQUSED)/NPG1
- NGRV = MIN(NGRV,NGRP)
-
- NSTEP= NPG*NGRV
- JDE = MIN(NDW,JDST-1+NENLNQ*NSTEP)
- IF (JDE.NE.NDW.AND.JDE.GE.JDL) GO TO 12
- JSAME= MAX(JDE+1,JSAME)
- NPG = MIN(NPG,JDE+1-JDST)
- DO 300 JGROUP=1,NGRV
- IF (JGROUP.GT.1) CALL ZPAGE(IQPRNT,1)
- CQLINE = ' '//CSTART
- ILINE = MLITXQ
-
- DO 200 JLINE=1,NPG
- JD = JDST
-
- DO 100 JWORD=1,NENLNQ
- IF (JD.GT.JDE) GO TO 100
- CALL DZTYP
- IPBEG = ILINE + 1
- IPEND = ILINE + NLINEQ
- IF (JTYP.LT.0) THEN
- WRITE(CQLINE(ILINE+1:ILINE+6),'(I6)') JD+IBASE
- IF (IQFOUL.EQ.0) THEN
- IF (JBIT(IQ(KQS+IQLS),IQDROP).EQ.1)
- I CQLINE(ILINE+MLDRQ:ILINE+MLDRQ) = '('
- IF (IQND.LT.0) IQID = IHOLE
- WRITE
- W (CQLINE(ILINE+MLIDBQ:ILINE+MLIDEQ),'(A4)')IQID
- ELSEIF (IQFOUL.GT.0) THEN
- CQLINE(ILINE+MLDRQ:ILINE+MLDRQ) = '?'
- CQLINE(ILINE+MLIDBQ:ILINE+MLIDEQ) = '****'
- ELSE
- CQLINE(ILINE+MLDRQ:ILINE+MLDRQ) = '?'
- CQLINE(ILINE+MLIDBQ:ILINE+MLIDEQ) = '-'
- ENDIF
- WRITE
- W (CQLINE(ILINE+MLLKBQ:ILINE+MLLKEQ),'(I8)')
- W LQ(KQS+LBASE+JD)
- ILINE = ILINE + NLINEQ
- ELSEIF (JTYP.EQ.1) THEN
-#if defined(CERNLIB_QMIBM)||defined(CERNLIB_QMIBX)||defined(CERNLIB_QMND3)||defined(CERNLIB_QMCRY)||defined(CERNLIB_QMDOS)
- WRITE(CQLINE(IPBEG:IPEND),'(I6,1X,''Z'',Z16)')
-#endif
-#if (!defined(CERNLIB_QMIBM))&&(!defined(CERNLIB_QMIBX))&&(!defined(CERNLIB_QMND3))&&(!defined(CERNLIB_QMCRY))&&(!defined(CERNLIB_QMDOS))
- WRITE(CQLINE(IPBEG:IPEND),'(I6,1X,''Z'',Z16.16)')
-#endif
- W JD+IBASE,LQ(KQS+LBASE+JD)
- ELSEIF (JTYP.EQ.2) THEN
- WRITE(CQLINE(IPBEG:IPEND),'(I6,I18)')
- W JD+IBASE,LQ(KQS+LBASE+JD)
- ELSEIF (JTYP.EQ.3) THEN
- WRITE(CQLINE(IPBEG:IPEND),'(I6,8X,F10.1)')
- W JD+IBASE,Q(KQS+LBASE+JD-NOFLIQ)
- ELSEIF (JTYP.EQ.4) THEN
- WRITE(CQLINE(IPBEG:IPEND),'(I6,6X,F12.3)')
- W JD+IBASE,Q(KQS+LBASE+JD-NOFLIQ)
- ELSEIF (JTYP.EQ.5) THEN
- WRITE(CQLINE(IPBEG:IPEND),'(I6,2X,F16.7)')
- W JD+IBASE,Q(KQS+LBASE+JD-NOFLIQ)
- ELSEIF (JTYP.EQ.6) THEN
- WRITE(CQLINE(IPBEG:IPEND),'(I6,2X,E16.7)')
- W JD+IBASE,Q(KQS+LBASE+JD-NOFLIQ)
- ELSEIF (JTYP.EQ.7) THEN
- WRITE(CQLINE(IPBEG:IPEND),'(I6,13X,''"'',A4)')
- W JD+IBASE,LQ(KQS+LBASE+JD)
- ENDIF
- ILINE = IPEND
- JD = JD + NSTEP
- 100 CONTINUE
- CALL DZTEXT(0,CDUMMQ,1)
- CQLINE = ' '//CSTART
- ILINE = MLITXQ
- 200 JDST= JDST + 1
-
- 300 CONTINUE
-
- JDST= JDE + 1
- IF (JDST.LT.JSAME) GO TO 20
- IF (JDST.LT.NDW) GO TO 16
-
- 999 CQSTAK(MCQSIQ:) = CHSTAK
- END
diff --git a/src/packlib/zebra/dzebra/dzform.F b/src/packlib/zebra/dzebra/dzform.F
deleted file mode 100644
index de675d3..0000000
--- a/src/packlib/zebra/dzebra/dzform.F
+++ /dev/null
@@ -1,119 +0,0 @@
-*
-* $Id: dzform.F,v 1.2 1996/04/24 17:26:08 mclareni Exp $
-*
-* $Log: dzform.F,v $
-* Revision 1.2 1996/04/24 17:26:08 mclareni
-* Extend the include file cleanup to dzebra, rz and tq, and also add
-* dependencies in some cases.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:06 mclareni
-* Zebra
-*
-*
-*-----------------------------------------------------------
-#include "zebra/pilot.h"
-#if (defined(CERNLIB_DEBUGON))&&(defined(CERNLIB_VFORT))
-#include "zebra/debugvf1.inc"
-#endif
- SUBROUTINE DZFORM(IXSTOR,LBANK)
-#include "zebra/mqsys.inc"
-#include "zebra/qequ.inc"
-#include "zebra/mzcn.inc"
-#include "zebra/zunit.inc"
-#include "zebra/eqlqform.inc"
-#include "zebra/dzc1.inc"
-#include "zebra/questparq.inc"
-
- CHARACTER CHROUT*(*)
- PARAMETER (CHROUT = 'DZFORM')
-
-#include "zebra/q_jbyt.inc"
-
-#if (defined(CERNLIB_DEBUGON))&&(defined(CERNLIB_VFORT))
-#include "zebra/debugvf2.inc"
-#endif
-
- CQSTAK = CHROUT//'/'
- IQUEST(1) = 0
-
- IF (LBANK.EQ.0) THEN
-
-
- IF (LQFORM.EQ.0) GO TO 999
-
- CQMAP(1) = ' '
- CQMAP(2) =' DZFORM -- List of the IO characteristics '//
- X 'known to ZEBRA'
- CQMAP(3) = ' ========================================'//
- X '=============='
- CALL DZTEXT(0,CDUMMQ,3)
-
- LIOD = LQ(KQSP+LQFORM-2)
- LID = LQFORM
- DO 200 I = 1,2
- LIX = LQ(KQSP+LID-1)
- NWID = IQ(KQSP+LID+1)
- IF (NWID.GT.0) THEN
- CALL SORTZV
- X (IQ(KQSP+LID+4),LQ(LQWKTB),MIN(NWID,NQWKTB),0,0,0)
- ENDIF
- DO 100 J = 0,NWID-1
- CQLINE = ' '
- INDXA = LQ(LQWKTB+J)
- IXIOD = IQ(KQSP+LIX+INDXA)
- NWIO = JBYT(IQ(KQSP+LIOD+IXIOD+1),7,5) - 1
- CALL MZIOCR(IQ(KQSP+LIOD+IXIOD+1))
- IF(IQUEST(1).LT.0) THEN
- WRITE(CQINFO,'(A4)') IQ(KQSP+LID+INDXA+3)
- CALL DZTEXT(MFOR1Q,CDUMMQ,0)
- GO TO 999
- ELSE
- IQUEST(1) = 0
- ENDIF
- WRITE(CQLINE(1:37),
- X '('' Format for ID='',A4,'' is NWIO=1/2+'',I2,1X)')
- X IQ(KQSP+LID+INDXA+3),NWIO
- CALL DZFORP
- 100 CONTINUE
- LID=LQ(KQSP+LID)
- 200 CONTINUE
-
- ELSE
-
-
- IF (IXSTOR.NE.NCHEKQ) THEN
- CALL MZSDIV(IXSTOR,-1)
- ENDIF
-
- CALL MZCHLS(NCHEKQ,LBANK)
-
- IF(IQFOUL.NE.0) THEN
- CALL DZBKDV(LBANK)
- IF (IQUEST(1).NE.0) GO TO 999
- WRITE(CQINFO,'(A,''/'',I10,'','',I4)') CQDIV,LBANK,IQFOUL
- CALL DZTEXT(MFOR2Q,CDUMMQ,0)
- GO TO 999
- ENDIF
-
- CALL MZIOCR(LQ(KQS+IQLN))
-
- IF(IQUEST(1).LT.0) THEN
- CALL DZBKDV(LBANK)
- IF (IQUEST(1).NE.0) GO TO 999
- WRITE(CQINFO,'(A,''/'',I10,'','',A4)') CQDIV,LBANK,IQID
- CALL DZTEXT(MFOR3Q,CDUMMQ,0)
- GO TO 999
- ELSE
- IQUEST(1) = 0
- ENDIF
-
- CQLINE = ' '
-
- WRITE(CQLINE(1:37),
- X '('' DZFORM for ID='',A4,'' is NWIO=1/2+'',I2,1X)') IQID,IQNIO
-
- CALL DZFORP
- ENDIF
-
- 999 RETURN
- END
diff --git a/src/packlib/zebra/dzebra/dzforp.F b/src/packlib/zebra/dzebra/dzforp.F
deleted file mode 100644
index c2f6d85..0000000
--- a/src/packlib/zebra/dzebra/dzforp.F
+++ /dev/null
@@ -1,84 +0,0 @@
-*
-* $Id: dzforp.F,v 1.1.1.1 1996/03/06 10:47:06 mclareni Exp $
-*
-* $Log: dzforp.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:06 mclareni
-* Zebra
-*
-*
-*-----------------------------------------------------------
-#include "zebra/pilot.h"
-#if (defined(CERNLIB_DEBUGON))&&(defined(CERNLIB_VFORT))
-#include "zebra/debugvf1.inc"
-#endif
- SUBROUTINE DZFORP
- SAVE KFOTYP
-#include "zebra/mqsys.inc"
-#include "zebra/qequ.inc"
-#include "zebra/mzioc.inc"
-#include "zebra/zunit.inc"
-#include "zebra/dzc1.inc"
-#include "zebra/bkfoparq.inc"
-
- CHARACTER CHROUT*(*),CHSTAK*6,KFOTYP(0:11)*1
- PARAMETER (CHROUT = 'DZFORP')
- DATA KFOTYP /'U','B','I','F','D','H','*','S','*','N','*','L'/
-#if (defined(CERNLIB_DEBUGON))&&(defined(CERNLIB_VFORT))
-#include "zebra/debugvf2.inc"
-#endif
-
-
-
-
-
- CHSTAK = CQSTAK(MCQSIQ:)
- CQSTAK(MCQSIQ:) = CHROUT
-
- IPOS = 38
-
- DO 100 JFOCUR = 1,JFOEND,2
-
-
- IF (JFOCUR.EQ.JFOREP+1) THEN
- WRITE(CQLINE(IPOS:IPOS+1),'(''/ '')')
- IPOS = IPOS + 2
- ENDIF
- ITYPE = MFO(JFOCUR)
- IF (ITYPE.EQ.IFOSEQ) THEN
- WRITE(CQLINE(IPOS:IPOS+1),'(''*'',A1)') KFOTYP(ITYPE)
- IPOS = IPOS + 3
- GO TO 100
- ENDIF
- NWSEC = MFO(JFOCUR+1)
- ITYPE = MIN(ITYPE,8)
- IF (NWSEC.LT.0) THEN
- WRITE(CQLINE(IPOS:IPOS+1),'(''-'',A1)') KFOTYP(ITYPE)
- IPOS = IPOS + 3
- ELSEIF (NWSEC.EQ.0) THEN
- WRITE(CQLINE(IPOS:IPOS+1),'(''*'',A1)') KFOTYP(ITYPE)
- IPOS = IPOS + 3
- ELSE
- DO 10 I=1,100
- IF(NWSEC.EQ.0) GO TO 20
- IQUEST(I)=MOD(NWSEC,10)
- NWSEC = NWSEC/10
- 10 CONTINUE
- 20 DO 30 J=1,I-1
- WRITE(CQLINE(IPOS:IPOS),'(I1)') IQUEST(I-J)
- IPOS = IPOS + 1
- 30 CONTINUE
- WRITE(CQLINE(IPOS:IPOS),'(A1)') KFOTYP(ITYPE)
- IPOS = IPOS + 2
- ENDIF
-
- IF (IPOS.GT.100) THEN
- CALL DZTEXT(0,CDUMMQ,1)
- IPOS = 23
- CQLINE = ' '
- ENDIF
- 100 CONTINUE
-
- IF (IPOS.GT.23) CALL DZTEXT(0,CDUMMQ,1)
-
- 999 CQSTAK(MCQSIQ:) = CHSTAK
- END
diff --git a/src/packlib/zebra/dzebra/dziopd.F b/src/packlib/zebra/dzebra/dziopd.F
deleted file mode 100644
index 665ec26..0000000
--- a/src/packlib/zebra/dzebra/dziopd.F
+++ /dev/null
@@ -1,202 +0,0 @@
-*
-* $Id: dziopd.F,v 1.2 1996/04/24 17:26:11 mclareni Exp $
-*
-* $Log: dziopd.F,v $
-* Revision 1.2 1996/04/24 17:26:11 mclareni
-* Extend the include file cleanup to dzebra, rz and tq, and also add
-* dependencies in some cases.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:06 mclareni
-* Zebra
-*
-*
-*-----------------------------------------------------------
-#include "zebra/pilot.h"
-#if (defined(CERNLIB_DEBUGON))&&(defined(CERNLIB_VFORT))
-#include "zebra/debugvf1.inc"
-#endif
- SUBROUTINE DZIOPD (IFIRST,ILAST)
- SAVE KFOTYP
-#include "zebra/mqsys.inc"
-#include "zebra/qequ.inc"
-#include "zebra/mzioc.inc"
-#include "zebra/zbcdk.inc"
-#include "zebra/zunit.inc"
-#include "zebra/dzc1.inc"
-#include "zebra/bkfoparq.inc"
-
- PARAMETER (NENLNQ = 5 )
- PARAMETER (NLNGRQ = 10)
- PARAMETER (NLISTQ = 6 )
- PARAMETER (NLINEQ = 24)
-
- CHARACTER CHROUT*(*),CHSTAK*6,KFOTYP(0:11)*1,CDWORD*31
- DOUBLE PRECISION DWORD
- INTEGER IWORD
- REAL RWORD
- EQUIVALENCE (DWORD,IWORD,RWORD)
- PARAMETER (CHROUT = 'DZIOPD')
- DATA KFOTYP /'U','B','I','F','D','H','*','S','*','N','*','L'/
-
-#if (defined(CERNLIB_DEBUGON))&&(defined(CERNLIB_VFORT))
-#include "zebra/debugvf2.inc"
-#endif
-
-
-
-
-
-
-
- CHSTAK = CQSTAK(MCQSIQ:)
- CQSTAK(MCQSIQ:) = CHROUT
-
- INLINE = NLISTQ
- ILINE = 1
- NLINES = MIN((ILAST-IFIRST)/NENLNQ+1,NLNGRQ)
- DO 5 I=1,NLINES
- 5 CQMAP(I) = ' '
- CALL ZPAGE(IQPRNT,NLINES+2)
- CQLINE = ' DATA part of bank'
- CQLINE(60:) = '--------------------'
- IF(IFLOPT(MPOSQQ).EQ.0) CALL DZTEXT(0,CDUMMQ,1)
-
- JDATA = 0
- JFOCUR = 0
- NWPRNT = 0
-
-
- 10 ITYPE = MFO(JFOCUR+1)
- IF (ITYPE.EQ.7) GO TO 40
- NWSEC = MFO(JFOCUR+2)
- IF (NWSEC) 20, 30, 60
-
-
- 20 NWSEC = ILAST - JDATA
- GO TO 60
-
-
- 30 JDATA = JDATA + 1
- IWORD = IQ(KQS+LS+JDATA)
- NWSEC = IWORD
- IF (JDATA.GE.IFIRST) THEN
- WRITE(CQMAP(ILINE)(INLINE+1:INLINE+NLINEQ),
- + '(I6,'' *'',A1,''('',I13,'')'')')
- + JDATA,KFOTYP(MIN(ITYPE,6)),NWSEC
- NWPRNT = NWPRNT + 1
- ENDIF
- GO TO 50
-
-
- 40 JDATA = JDATA + 1
- IWORD = IQ(KQS+LS+JDATA)
- ITYPE = MOD (IWORD,16)
- NWSEC = IWORD/16
- IF (JDATA.GE.IFIRST) THEN
- WRITE(CQMAP(ILINE)(INLINE+1:INLINE+NLINEQ),
- + '(I6,'' *S('',A1,'','',I11,'')'')')
- + JDATA,KFOTYP(MIN(ITYPE,6)),NWSEC
- NWPRNT = NWPRNT + 1
- ENDIF
-
- 50 IF (JDATA.GE.IFIRST) THEN
- IF ( (INLINE.EQ.NLISTQ+(NENLNQ-1)*NLINEQ)
- X .AND. (ILINE.EQ.NLINES) ) THEN
- IF (IFLOPT(MPOSQQ).NE.0) GO TO 999
- IF (NWPRNT.GT.NLNGRQ*NENLNQ) CALL DZTEXT(1,CDUMMQ,1)
- CALL DZTEXT(0,CDUMMQ,NLINES)
- INLINE = NLISTQ
- ILINE = 1
- NLINES = MIN((ILAST-JDATA-1)/NENLNQ+1,NLNGRQ)
- DO 55 I=1,NLINES
- 55 CQMAP(I) = ' '
- ELSEIF (ILINE.EQ.NLINES) THEN
- ILINE = 1
- INLINE = INLINE + NLINEQ
- ELSE
- ILINE = ILINE + 1
- ENDIF
- ENDIF
-
- IF (ITYPE.GE.8) THEN
- ITYPE = 0
- NWSEC = ILAST - JDATA
- IQUEST(11) = -ITYPE
- ELSEIF (NWSEC.EQ.0) THEN
- ITYPE = 0
- GO TO 900
- ELSEIF (NWSEC.LT.0) THEN
- ITYPE = 0
- NWSEC = ILAST - JDATA
- IQUEST(11) = -ITYPE-32
- ENDIF
-
-
- 60 IDBLE = 0
- DO 100 I=MAX(JDATA+1,IFIRST),MIN(JDATA+NWSEC,ILAST)
- IWORD = IQ(KQS+LS+I)
- IF (IDBLE.EQ.1) THEN
- WRITE(CQMAP(ILINE)(INLINE+1:INLINE+NLINEQ),
- + '(I6,1X,A,'')'')') NWPRNT+IFIRST,CDWORD(16:)
- IDBLE = 0
- ELSEIF (ITYPE.EQ.IFOHOQ) THEN
- WRITE(CQMAP(ILINE)(INLINE+1:INLINE+NLINEQ),
- + '(I6,5X,''"'',A12)') NWPRNT+IFIRST,IWORD
- ELSEIF (ITYPE.EQ.IFOINQ) THEN
- WRITE(CQMAP(ILINE)(INLINE+1:INLINE+NLINEQ),
- + '(I6,I18)') NWPRNT+IFIRST,IWORD
- ELSEIF (ITYPE.EQ.IFOFLQ) THEN
- WRITE(CQMAP(ILINE)(INLINE+1:INLINE+NLINEQ),
- + '(I6,G18.8)') NWPRNT+IFIRST,RWORD
- ELSEIF (ITYPE.EQ.IFODOQ) THEN
- CALL UCOPY(Q(KQS+LS+I),DWORD,2)
- WRITE(CDWORD,'(D31.24)') DWORD
- WRITE(CQMAP(ILINE)(INLINE+1:INLINE+NLINEQ),
- + '(I6,1X,''D('',A)') NWPRNT+IFIRST,CDWORD(:15)
- IDBLE = 1
- ELSE
- WRITE(CQMAP(ILINE)(INLINE+1:INLINE+NLINEQ),
- + '(I6,'' Z'',Z16)') NWPRNT+IFIRST,IWORD
- ENDIF
- NWPRNT = NWPRNT + 1
-
- IF ( (INLINE.EQ.NLISTQ+(NENLNQ-1)*NLINEQ)
- X .AND. (ILINE.EQ.NLINES) ) THEN
- IF (IFLOPT(MPOSQQ).NE.0) GO TO 999
- IF (NWPRNT.GT.NLNGRQ*NENLNQ) CALL DZTEXT(1,CDUMMQ,1)
- CALL DZTEXT(0,CDUMMQ,NLINES)
- INLINE = NLISTQ
- ILINE = 1
- NLINES = MIN((ILAST-NWPRNT-1)/NENLNQ+1,NLNGRQ)
- DO 65 J=1,NLINES
- 65 CQMAP(J) = ' '
- ELSEIF (ILINE.EQ.NLINES) THEN
- ILINE = 1
- INLINE = INLINE + NLINEQ
- ELSE
- ILINE = ILINE + 1
- ENDIF
-
- 100 CONTINUE
-
-
- JDATA = JDATA + NWSEC
-
- IF (JDATA.GE.ILAST) GO TO 900
-
- IF (JDATA.LT.ILAST) THEN
- JFOCUR = JFOCUR + 2
- IF (JFOCUR.LT.JFOEND) GO TO 10
- JFOCUR = JFOREP
- GO TO 10
- ENDIF
-
-
- 900 IF (IFLOPT(MPOSQQ).NE.0) GO TO 999
- IF (INLINE.NE.NLISTQ.OR.ILINE.NE.1) THEN
- IF (NWPRNT.GT.NLNGRQ*NENLNQ) CALL DZTEXT(1,CDUMMQ,1)
- CALL DZTEXT(0,CDUMMQ,NLINES)
- ENDIF
-
- 999 CQSTAK(MCQSIQ:) = CHSTAK
- END
diff --git a/src/packlib/zebra/dzebra/dzioph.F b/src/packlib/zebra/dzebra/dzioph.F
deleted file mode 100644
index ad706d7..0000000
--- a/src/packlib/zebra/dzebra/dzioph.F
+++ /dev/null
@@ -1,234 +0,0 @@
-*
-* $Id: dzioph.F,v 1.2 1996/04/24 17:26:11 mclareni Exp $
-*
-* $Log: dzioph.F,v $
-* Revision 1.2 1996/04/24 17:26:11 mclareni
-* Extend the include file cleanup to dzebra, rz and tq, and also add
-* dependencies in some cases.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:06 mclareni
-* Zebra
-*
-*
-*-----------------------------------------------------------
-#include "zebra/pilot.h"
-#if (defined(CERNLIB_DEBUGON))&&(defined(CERNLIB_VFORT))
-#include "zebra/debugvf1.inc"
-#endif
- SUBROUTINE DZIOPH (IFIRST,ILAST)
- SAVE KFOTYP
-#include "zebra/mqsys.inc"
-#include "zebra/qequ.inc"
-#include "zebra/mzioc.inc"
-#include "zebra/zbcdk.inc"
-#include "zebra/zunit.inc"
-#include "zebra/dzc1.inc"
-#include "zebra/bkfoparq.inc"
-
- CHARACTER CHROUT*(*),CHSTAK*6,KFOTYP(0:11)*1
-#if defined(CERNLIB_QMCRY)||defined(CERNLIB_QMCDC)
- CHARACTER CDWORD*36
-#endif
-#if (!defined(CERNLIB_QMCRY))&&(!defined(CERNLIB_QMCDC))
- CHARACTER CDWORD*20
-#endif
- DOUBLE PRECISION DWORD
- INTEGER IWORD
- REAL RWORD
- EQUIVALENCE (DWORD,IWORD,RWORD)
- PARAMETER (CHROUT = 'DZIOPH')
- DATA KFOTYP /'U','B','I','F','D','H','*','S','*','N','*','L'/
-
-#if (defined(CERNLIB_DEBUGON))&&(defined(CERNLIB_VFORT))
-#include "zebra/debugvf2.inc"
-#endif
-
-
-
-
-
-
-
- CHSTAK = CQSTAK(MCQSIQ:)
- CQSTAK(MCQSIQ:) = CHROUT
-
- CALL ZPAGE(IQPRNT,MIN((ILAST-IFIRST)/10+2,5))
- CQLINE = ' -------- DATA part of bank --------'
- IF (IFLOPT(MPOSQQ).EQ.0) CALL DZTEXT(0,CDUMMQ,1)
-
- WRITE (CQLINE,'(1X,I7,'' /'',120X)') IFIRST
- INLINE =11
-
- JDATA = 0
- JFOCUR = 0
- NWPRNT = 0
-
-
- 10 ITYPE = MFO(JFOCUR+1)
- IF (ITYPE.EQ.7) GO TO 40
- NWSEC = MFO(JFOCUR+2)
- IF (NWSEC) 20, 30, 60
-
-
- 20 NWSEC = ILAST - JDATA
- GO TO 60
-
-
- 30 JDATA = JDATA + 1
- IWORD = IQ(KQS+LS+JDATA)
- NWSEC = IWORD
- IF (JDATA.GE.IFIRST) THEN
-#if defined(CERNLIB_QMCRY)||defined(CERNLIB_QMCDC)
- WRITE(CQLINE(INLINE:INLINE+19),'('' *'',A1,''('',I15,'')'')')
- + KFOTYP(MIN(ITYPE,6)),NWSEC
-#endif
-#if (!defined(CERNLIB_QMCRY))&&(!defined(CERNLIB_QMCDC))
- WRITE(CQLINE(INLINE:INLINE+11),'('' *'',A1,''('', I7,'')'')')
- + KFOTYP(MIN(ITYPE,6)),NWSEC
-#endif
- NWPRNT = NWPRNT + 1
- ENDIF
- GO TO 50
-
-
- 40 JDATA = JDATA + 1
- IWORD = IQ(KQS+LS+JDATA)
- ITYPE = MOD (IWORD,16)
- NWSEC = IWORD/16
- IF (JDATA.GE.IFIRST) THEN
-#if defined(CERNLIB_QMCRY)||defined(CERNLIB_QMCDC)
- WRITE(CQLINE(INLINE:INLINE+19),'('' *S('',A1,'','',I13,'')'')')
-#endif
-#if (!defined(CERNLIB_QMCRY))&&(!defined(CERNLIB_QMCDC))
- WRITE(CQLINE(INLINE:INLINE+11),'('' *S('',A1,'','', I5,'')'')')
-#endif
- + KFOTYP(MIN(ITYPE,6)),NWSEC
- NWPRNT = NWPRNT + 1
- ENDIF
-
- 50 IF (JDATA.GE.IFIRST) THEN
-#if defined(CERNLIB_QMCRY)||defined(CERNLIB_QMCDC)
- IF (MOD(NWPRNT,6).EQ.0) THEN
-#endif
-#if (!defined(CERNLIB_QMCRY))&&(!defined(CERNLIB_QMCDC))
- IF (MOD(NWPRNT,10).EQ.0) THEN
-#endif
- IF (IFLOPT(MPOSQQ).NE.0) GO TO 999
- CALL DZTEXT(0,CDUMMQ,1)
- WRITE (CQLINE,'(1X,I7,'' /'',120X)') NWPRNT+IFIRST
- INLINE =11
- ELSE
-#if defined(CERNLIB_QMCRY)||defined(CERNLIB_QMCDC)
- INLINE = INLINE + 20
-#endif
-#if (!defined(CERNLIB_QMCRY))&&(!defined(CERNLIB_QMCDC))
- INLINE = INLINE + 12
-#endif
- ENDIF
- ENDIF
-
- IF (ITYPE.GE.8) THEN
- ITYPE = 0
- NWSEC = ILAST - JDATA
- IQUEST(11) = -ITYPE
- ELSEIF (NWSEC.EQ.0) THEN
- ITYPE = 0
- GO TO 900
- ELSEIF (NWSEC.LT.0) THEN
- ITYPE = 0
- NWSEC = ILAST - JDATA
- IQUEST(11) = -ITYPE-32
- ENDIF
-
-
- 60 IDBLE = 0
- DO 100 I=MAX(JDATA+1,IFIRST),MIN(JDATA+NWSEC,ILAST)
- IWORD = IQ(KQS+LS+I)
- IF (IDBLE.EQ.1) THEN
-#if defined(CERNLIB_QMCRY)||defined(CERNLIB_QMCDC)
- WRITE(CQLINE(INLINE:INLINE+19),'(A,'')'')') CDWORD(18:)
-#endif
-#if (!defined(CERNLIB_QMCRY))&&(!defined(CERNLIB_QMCDC))
- WRITE(CQLINE(INLINE:INLINE+11),'(A,'')'')') CDWORD(10:)
-#endif
- IDBLE = 0
- ELSEIF (ITYPE.EQ.IFOHOQ) THEN
-#if defined(CERNLIB_QMCRY)||defined(CERNLIB_QMCDC)
- WRITE(CQLINE(INLINE:INLINE+19),'(7X,''"'',A12)') IWORD
-#endif
-#if (!defined(CERNLIB_QMCRY))&&(!defined(CERNLIB_QMCDC))
- WRITE(CQLINE(INLINE:INLINE+11),'(7X,''"'',A4)') IWORD
-#endif
- ELSEIF (ITYPE.EQ.IFOINQ) THEN
-#if defined(CERNLIB_QMCRY)||defined(CERNLIB_QMCDC)
- WRITE(CQLINE(INLINE:INLINE+19),'(I20)') IWORD
-#endif
-#if (!defined(CERNLIB_QMCRY))&&(!defined(CERNLIB_QMCDC))
- WRITE(CQLINE(INLINE:INLINE+11),'(I12)') IWORD
-#endif
- ELSEIF (ITYPE.EQ.IFOFLQ) THEN
-#if defined(CERNLIB_QMCRY)||defined(CERNLIB_QMCDC)
- WRITE(CQLINE(INLINE:INLINE+19),'(G20.14)') RWORD
-#endif
-#if (!defined(CERNLIB_QMCRY))&&(!defined(CERNLIB_QMCDC))
- WRITE(CQLINE(INLINE:INLINE+11),'(G12.4)') RWORD
-#endif
- ELSEIF (ITYPE.EQ.IFODOQ) THEN
- CALL UCOPY(Q(KQS+LS+I),DWORD,2)
-#if defined(CERNLIB_QMCRY)||defined(CERNLIB_QMCDC)
- WRITE(CDWORD,'(D36.29)') DWORD
- WRITE(CQLINE(INLINE:INLINE+19),'('' D('',A)') CDWORD(:17)
-#endif
-#if (!defined(CERNLIB_QMCRY))&&(!defined(CERNLIB_QMCDC))
- WRITE(CDWORD,'(D20.13)') DWORD
- WRITE(CQLINE(INLINE:INLINE+11),'('' D('',A)') CDWORD(:9)
-#endif
- IDBLE = 1
- ELSE
-#if defined(CERNLIB_QMCRY)||defined(CERNLIB_QMCDC)
- WRITE(CQLINE(INLINE:INLINE+19),'('' Z '',Z16)') IWORD
-#endif
-#if (!defined(CERNLIB_QMCRY))&&(!defined(CERNLIB_QMCDC))
- WRITE(CQLINE(INLINE:INLINE+11),'('' Z '',Z8)') IWORD
-#endif
- ENDIF
- NWPRNT = NWPRNT + 1
-
-#if defined(CERNLIB_QMCRY)||defined(CERNLIB_QMCDC)
- IF (MOD(NWPRNT,6).EQ.0) THEN
-#endif
-#if (!defined(CERNLIB_QMCRY))&&(!defined(CERNLIB_QMCDC))
- IF (MOD(NWPRNT,10).EQ.0) THEN
-#endif
- IF (IFLOPT(MPOSQQ).NE.0) GO TO 999
- CALL DZTEXT(0,CDUMMQ,1)
- WRITE (CQLINE,'(1X,I7,'' /'',120X)') NWPRNT+IFIRST
- INLINE =11
- ELSE
-#if defined(CERNLIB_QMCRY)||defined(CERNLIB_QMCDC)
- INLINE = INLINE + 20
-#endif
-#if (!defined(CERNLIB_QMCRY))&&(!defined(CERNLIB_QMCDC))
- INLINE = INLINE + 12
-#endif
- ENDIF
-
- 100 CONTINUE
-
-
- JDATA = JDATA + NWSEC
-
- IF (JDATA.GE.ILAST) GO TO 900
-
- IF (JDATA.LT.ILAST) THEN
- JFOCUR = JFOCUR + 2
- IF (JFOCUR.LT.JFOEND) GO TO 10
- JFOCUR = JFOREP
- GO TO 10
- ENDIF
-
-
- 900 IF (INLINE.NE.11.AND.IFLOPT(MPOSQQ).EQ.0) CALL DZTEXT(0,CDUMMQ,1)
-
- 999 CQSTAK(MCQSIQ:) = CHSTAK
- END
diff --git a/src/packlib/zebra/dzebra/dziopr.F b/src/packlib/zebra/dzebra/dziopr.F
deleted file mode 100644
index d956252..0000000
--- a/src/packlib/zebra/dzebra/dziopr.F
+++ /dev/null
@@ -1,62 +0,0 @@
-*
-* $Id: dziopr.F,v 1.1.1.1 1996/03/06 10:47:06 mclareni Exp $
-*
-* $Log: dziopr.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:06 mclareni
-* Zebra
-*
-*
-*-----------------------------------------------------------
-#include "zebra/pilot.h"
-#if (defined(CERNLIB_DEBUGON))&&(defined(CERNLIB_VFORT))
-#include "zebra/debugvf1.inc"
-#endif
- SUBROUTINE DZIOPR (IFIRST,ILAST)
-#include "zebra/mqsys.inc"
-#include "zebra/qequ.inc"
-#include "zebra/mzioc.inc"
-#include "zebra/zbcdk.inc"
-#include "zebra/zunit.inc"
-#include "zebra/dzc1.inc"
-#include "zebra/questparq.inc"
-#include "zebra/bkfoparq.inc"
-
- CHARACTER CHROUT*(*),CHSTAK*6
- PARAMETER (CHROUT = 'DZIOPR')
-
-#if (defined(CERNLIB_DEBUGON))&&(defined(CERNLIB_VFORT))
-#include "zebra/debugvf2.inc"
-#endif
-
-
- CHSTAK = CQSTAK(MCQSIQ:)
- CQSTAK(MCQSIQ:) = CHROUT
-
-
- IF (IFLOPT(MPOSZQ).NE.0) THEN
- MFO(1) = IFOBIQ
- MFO(2) = -1
- ELSE
- CALL MZIOCR(LQ(KQS+LN))
-
- IF (IQUEST(1).LT.0) THEN
- CALL DZBKDV(LS)
- IF (IQUEST(1).NE.0) GO TO 999
- WRITE(CQINFO,'(A,''/'',I8,'','',I8,''/'',Z8)')
- + CQDIV,LS,LN,LQ(KQS+LN)
- CALL DZTEXT(MIOP1Q,CDUMMQ,0)
- GO TO 999
- ELSE
- IQUEST(1) = 0
- ENDIF
- ENDIF
-
- IF (IFLOPT(MPOSDQ).NE.0) THEN
- CALL DZIOPD(IFIRST,ILAST)
- ELSE
- CALL DZIOPH(IFIRST,ILAST)
- ENDIF
-
- 999 CQSTAK(MCQSIQ:) = CHSTAK
- RETURN
- END
diff --git a/src/packlib/zebra/dzebra/dzmap.F b/src/packlib/zebra/dzebra/dzmap.F
deleted file mode 100644
index 8eedc96..0000000
--- a/src/packlib/zebra/dzebra/dzmap.F
+++ /dev/null
@@ -1,185 +0,0 @@
-*
-* $Id: dzmap.F,v 1.2 1996/04/24 17:26:12 mclareni Exp $
-*
-* $Log: dzmap.F,v $
-* Revision 1.2 1996/04/24 17:26:12 mclareni
-* Extend the include file cleanup to dzebra, rz and tq, and also add
-* dependencies in some cases.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:07 mclareni
-* Zebra
-*
-*
-*------------------------------------------------------------
-#include "zebra/pilot.h"
-#if (defined(CERNLIB_DEBUGON))&&(defined(CERNLIB_VFORT))
-#include "zebra/debugvf1.inc"
-#endif
- SUBROUTINE DZMAP
-#include "zebra/bankparq.inc"
-#include "zebra/divparq.inc"
-#include "zebra/storparq.inc"
-#include "zebra/mqsys.inc"
-#include "zebra/qequ.inc"
-#include "zebra/mzcn.inc"
-#include "zebra/zbcd.inc"
-#include "zebra/zbcdk.inc"
-#include "zebra/zunit.inc"
-#include "zebra/dzc1.inc"
-
-
- PARAMETER ( NLMAPQ = 7 )
- PARAMETER ( ISIDEQ = 6 )
- PARAMETER ( ILINKQ = 15)
- PARAMETER ( NLINKQ = 14)
- PARAMETER ( IMAD1Q = 1 , IMAD2Q= 8)
- PARAMETER ( IMTG1Q = 9 , IMTG2Q= 9)
- PARAMETER ( IMID1Q = 10, IMID2Q= 13)
-
- CHARACTER CHROUT*(*),CHSTAK*6
- PARAMETER (CHROUT = 'DZMAP' )
-
-#include "zebra/q_jbit.inc"
-
-#if (defined(CERNLIB_DEBUGON))&&(defined(CERNLIB_VFORT))
-#include "zebra/debugvf2.inc"
-#endif
-
-
- CHSTAK = CQSTAK(MCQSIQ:)
- CQSTAK(MCQSIQ:) = CHROUT
-
- IDOPT = IFLOPT(MPOSDQ)
-
-
- IF (LN.GT.0) THEN
- CALL MZCHLN(NCHEKQ,LN)
- IF (IQFOUL.NE.0) GO TO 998
- ELSE
- CALL MZCHLS(NCHEKQ,LS)
- IF (IQFOUL.NE.0) GO TO 998
- ENDIF
-
- IF (IQND.LT.0) THEN
- IF (IFLOPT(MPOSHQ).NE.0) THEN
-
- WRITE(CQLINE,
-#if !defined(CERNLIB_OCTMAP)
- W '(1X,''(*HO*'',1X,I8,''('',Z8,
-#endif
-#if defined(CERNLIB_OCTMAP)
- W '(1X,''(*HO*'',1X,I8,''('',O8,
-#endif
- W '') -- HOLE of '',I8,'' words'')') IQLN,(IQLN+LQSTOR)
-* MAP addresses are in BYTES
-#if !defined(CERNLIB_WORDMAP)
- W *4
-#endif
- W ,-IQND
-
- CALL DZTEXT(0,CDUMMQ,1)
- ENDIF
- LX = IQNX
- GO TO 999
- ELSE
- LS = IQLS
- NL = IQNL
- NS = IQNS
- ND = IQND
- LX = IQNX
- ENDIF
-
- IF (IFLOPT(MPOSKQ).EQ.0) THEN
- JDROP = JBIT(IQ(KQS+IQLS),IQDROP)
- ELSE
- JDROP = 0
- ENDIF
- MARKD = 0
- IF (JDROP.EQ.0) THEN
- IF(IFLOPT(MPOSDQ).NE.0) THEN
- MARKD = JRSBYT(0,IQ(KQS+LS),IQMARK,1)
- IFLOPT(MPOSDQ) = 0
- ENDIF
- IF(IFLOPT(MPOSCQ).NE.0) THEN
- MARKD = JRSBYT(0,IQ(KQS+LS),IQCRIT,1) + MARKD
- ENDIF
- IF (MARKD+IFLOPT(MPOSFQ).NE.0) THEN
- IFLOPT(MPOSDQ) = 1
- CALL DZSHPR(LS,0,0,0,0)
- GO TO 999
- ENDIF
- IF (MARKD+IFLOPT(MPOSEQ).NE.0) THEN
- IFLOPT(MPOSDQ) = 1
- CALL DZSHPR(LS,0,0,0,-1)
- GO TO 999
- ENDIF
- ENDIF
-
- CALL DZBKHD
- IF (IQUEST(1).NE.0) GO TO 998
-
-
- IF (NL.EQ.0) GO TO 999
-
-
- CQLINE = ' . LINKS'
- LAST = LS - NL
- L = LAST
-
- DO 43 J=1,NL
- IF (LQ(L+KQS).NE.0) GO TO 44
- 43 L = L+1
- 44 NP= LS - L
-
- IF (NP.EQ.0) GO TO 999
-
- IF (NP.GT.NLMAPQ) THEN
- CQLINE(ISIDEQ+1:ISIDEQ+1) = '+'
- NP = NLMAPQ
- ENDIF
-
- IF (JDROP.NE.0) CQLINE(ISIDEQ:ISIDEQ+1) = '**'
-
- L = LS + KQS
- DO 50 J=1,NP
- I = (J-1)*NLINKQ + ILINKQ
- LINK = LQ (L-J)
- WRITE(CQLINE(I+IMAD1Q:I+IMAD2Q),'(I8)') LINK
- IF (LINK.EQ.LNULL) GO TO 50
- CALL MZCHLS(NCHEKQ,LINK)
- WRITE(CQLINE(I+IMID1Q:I+IMID2Q),'(A4)') IQID
-
- IF (IQFOUL.EQ.0) THEN
- IF (JBIT(IQ(KQS+LINK),IQDROP).NE.0) THEN
- CQLINE(I+IMTG1Q:I+IMTG2Q) = '('
- IF (JDROP.EQ.0) CQLINE(ISIDEQ+1:ISIDEQ+1) = 'F'
- IF (IQND.LT.0) CQLINE(I+IMID1Q:I+IMID2Q) = '*HO*'
- ELSE
- IF (JDROP.NE.0.AND.J.LE.NS.AND.J.GT.1) THEN
- CQLINE(ISIDEQ+1:ISIDEQ+1) = 'F'
- ENDIF
- ENDIF
- ELSEIF (IQFOUL.GT.0) THEN
- IF (J.LE.NS) THEN
- CQLINE(I+IMID1Q:I+IMID2Q) = '****'
- CQLINE(ISIDEQ+1:ISIDEQ+1) = 'F'
- ELSE
- CQLINE(I+IMID1Q:I+IMID2Q) = '-'
- ENDIF
- ELSE
- CQLINE(I+IMID1Q:I+IMID2Q) = '****'
- CQLINE(ISIDEQ+1:ISIDEQ+1) = 'F'
- ENDIF
-
- 50 CONTINUE
-
-
- CALL DZTEXT(0,CDUMMQ,1)
-
- GO TO 999
-
- 998 IQUEST(1) = 1
-
- 999 IFLOPT(MPOSDQ) = IDOPT
- CQSTAK(MCQSIQ:) = CHSTAK
- END
diff --git a/src/packlib/zebra/dzebra/dzopt.F b/src/packlib/zebra/dzebra/dzopt.F
deleted file mode 100644
index 9a16242..0000000
--- a/src/packlib/zebra/dzebra/dzopt.F
+++ /dev/null
@@ -1,37 +0,0 @@
-*
-* $Id: dzopt.F,v 1.1.1.1 1996/03/06 10:47:07 mclareni Exp $
-*
-* $Log: dzopt.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:07 mclareni
-* Zebra
-*
-*
-*------------------------------------------------------------
-#include "zebra/pilot.h"
-#if (defined(CERNLIB_DEBUGON))&&(defined(CERNLIB_VFORT))
-#include "zebra/debugvf1.inc"
-#endif
- SUBROUTINE DZOPT(CHOPT)
-#include "zebra/dzc1.inc"
- CHARACTER *(*) CHOPT,CLETT
-
- PARAMETER
- X (CLETT = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz')
-
-
-#if (defined(CERNLIB_DEBUGON))&&(defined(CERNLIB_VFORT))
-#include "zebra/debugvf2.inc"
-#endif
-
-
- DO 10 I=1,26
- 10 IFLOPT(I) = 0
-
-
- DO 20 I=1,LEN(CHOPT)
- J = INDEX(CLETT,CHOPT(I:I))
- IF (J.NE.0) IFLOPT(J - ((J-1)/26)*26) = 1
- 20 CONTINUE
-
- 999 RETURN
- END
diff --git a/src/packlib/zebra/dzebra/dzshow.F b/src/packlib/zebra/dzebra/dzshow.F
deleted file mode 100644
index dc1cf68..0000000
--- a/src/packlib/zebra/dzebra/dzshow.F
+++ /dev/null
@@ -1,181 +0,0 @@
-*
-* $Id: dzshow.F,v 1.2 1996/04/24 17:26:13 mclareni Exp $
-*
-* $Log: dzshow.F,v $
-* Revision 1.2 1996/04/24 17:26:13 mclareni
-* Extend the include file cleanup to dzebra, rz and tq, and also add
-* dependencies in some cases.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:07 mclareni
-* Zebra
-*
-*
-*-----------------------------------------------------------
-#include "zebra/pilot.h"
-#if (defined(CERNLIB_DEBUGON))&&(defined(CERNLIB_VFORT))
-#include "zebra/debugvf1.inc"
-#endif
- SUBROUTINE DZSHOW
- X (CHTEXT,IXSTOR,LBANK,CHOPT,ILINK1,ILINK2,IDATA1,IDATA2)
-#include "zebra/bankparq.inc"
-#include "zebra/questparq.inc"
-#include "zebra/storparq.inc"
-#include "zebra/mqsys.inc"
-#include "zebra/qequ.inc"
-#include "zebra/mzcn.inc"
-#include "zebra/zbcdch.inc"
-#include "zebra/zbcdk.inc"
-#include "zebra/zunit.inc"
-#include "zebra/dzc1.inc"
- CHARACTER *(*) CHOPT,CHTEXT
-
- PARAMETER ( NPDENQ = 3 )
- PARAMETER ( MPDCUQ = 1 )
- PARAMETER ( MPDNCQ = 2 )
- PARAMETER ( MPDNSQ = 3 )
-
- CHARACTER CHROUT*(*)
- PARAMETER (CHROUT = 'DZSHOW')
-
-#include "zebra/q_jbit.inc"
-
-#if (defined(CERNLIB_DEBUGON))&&(defined(CERNLIB_VFORT))
-#include "zebra/debugvf2.inc"
-#endif
-
- CQSTAK = CHROUT//'/'
- IQUEST(1) = 0
-
- IF (CHTEXT.NE.CDUMMQ) THEN
- CQMAP(1) = ' '
- CQMAP(2)(1:12) = ' DZSHOW --- '
- CQMAP(2)(13:100) = CHTEXT
- CQMAP(2)(101:110) = 'OPTIONS : '
- CQMAP(2)(111:130) = CHOPT
- CALL DZTEXT(0,CDUMMQ,2)
- ENDIF
-
- CALL DZOPT(CHOPT)
-
- CALL MZSDIV(IXSTOR,-1)
-
-
- IF (LBANK.EQ.0) GO TO 999
- IF (JBIT(IQ(LBANK+KQS),IQDROP).EQ.1) GO TO 999
-
-
- CALL DZBKUP(0)
- IF (IQUEST(1).NE.0) GO TO 999
-
-
- LWORK = NQOFFS(1) + LQEND(1) - NPDENQ - 1
- LWORKE = NQOFFS(1) + LQSTA(2) - NPDENQ
-
-
- LCUR = LBANK
- LEVEL = 0
- LEVELO = -1
-
-
- MAXALL = 0
- NTBANK = 0
- DO 20 I=1,NDVMXQ
- IF(I.LE.JQDVLL.OR.I.GE.JQDVSY)
- I MAXALL = MAXALL + LQEND(KQT+I) - LQSTA(KQT+I)
- 20 CONTINUE
-
-
-
-100 IF ( LEVEL.NE.LEVELO ) THEN
-
-
- IF(IFLOPT(MPOSVQ).NE.0) THEN
- CQMAP(1) = ' '
- WRITE(CQMAP(2),'('' DZSHOW +++++ LEVEL '',I5,1X,
- W 10(''+''),T50,''Store '',2A4,'' at absolute address '',
-#if defined(CERNLIB_OCTMAP)
- W O12,T100,10(''+'') )')
-#endif
-#if !defined(CERNLIB_OCTMAP)
- W Z8,T100,10(''+'') )')
-#endif
- W LEVEL,NQSNAM(1),NQSNAM(2),
-* Map addresses expressed in machine words
-#if defined(CERNLIB_WORDMAP)
- W LQSTOR+1
-* Map addresses expressed in bytes
-#endif
-#if !defined(CERNLIB_WORDMAP)
- W (LQSTOR+1)*4
-#endif
- CQMAP(3) = ' '
- CALL DZTEXT(0,CDUMMQ,3)
- ENDIF
-
- LEVELO = LEVEL
-
- ENDIF
-
-
- CALL DZSHPR (LCUR,ILINK1,ILINK2,IDATA1,IDATA2)
- IF (IQUEST(1).NE.0) GO TO 999
-
- NTBANK = NTBANK + NL + ND + NBKOHQ
- IF (NTBANK.GE.MAXALL) THEN
- WRITE(CQINFO,'(I10,''/'',I10)') MAXALL,NTBANK
- CALL DZTEXT(MSHO1Q,CDUMMQ,0)
- GO TO 999
- ENDIF
-
-
- LEVEL = LEVEL+1
- LWORK = LWORK + NPDENQ
- IF (LWORK.GE.LWORKE) THEN
- WRITE(CQINFO,'(I10)') LEVEL
- CALL DZTEXT(MSHO2Q,CDUMMQ,0)
- GO TO 999
- ENDIF
-
-
- IF (IFLOPT(MPOSVQ).EQ.0) NS=0
-
- LQ(LWORK+MPDCUQ) = LCUR
- LQ(LWORK+MPDNCQ) = NS
- LQ(LWORK+MPDNSQ) = NS
-
-
-200 IF (LQ(LWORK+MPDNCQ).LE.0) THEN
- IF (LEVEL.GT.1.OR.IFLOPT(MPOSLQ).NE.0) THEN
- LCUR = LQ(KQS + LQ(LWORK+MPDCUQ))
- LEVEL = LEVEL - 1
- LWORK = LWORK - NPDENQ
- IF (LCUR.NE.LNULL) THEN
- GO TO 100
- ELSE
- IF (LEVEL.GT.0) THEN
- GO TO 200
- ELSE
- GO TO 999
- ENDIF
- ENDIF
- ELSE
- LEVEL = LEVEL-1
- LWORK = LWORK - NPDENQ
- IF (LEVEL.GT.0) THEN
- GO TO 200
- ELSE
- GO TO 999
- ENDIF
- ENDIF
- ENDIF
-
-
- LQ(LWORK+MPDNCQ) = LQ(LWORK+MPDNCQ) - 1
- LCUR = LQ(KQS+LQ(LWORK+MPDCUQ)
- X -LQ(LWORK+MPDNSQ)+LQ(LWORK+MPDNCQ))
-
- IF (LCUR.EQ.LNULL) GO TO 200
- GO TO 100
-
- 999 RETURN
- END
diff --git a/src/packlib/zebra/dzebra/dzshpr.F b/src/packlib/zebra/dzebra/dzshpr.F
deleted file mode 100644
index b025273..0000000
--- a/src/packlib/zebra/dzebra/dzshpr.F
+++ /dev/null
@@ -1,153 +0,0 @@
-*
-* $Id: dzshpr.F,v 1.2 1996/04/24 17:26:14 mclareni Exp $
-*
-* $Log: dzshpr.F,v $
-* Revision 1.2 1996/04/24 17:26:14 mclareni
-* Extend the include file cleanup to dzebra, rz and tq, and also add
-* dependencies in some cases.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:07 mclareni
-* Zebra
-*
-*
-*-----------------------------------------------------------
-#include "zebra/pilot.h"
-#if (defined(CERNLIB_DEBUGON))&&(defined(CERNLIB_VFORT))
-#include "zebra/debugvf1.inc"
-#endif
- SUBROUTINE DZSHPR (LBANK,ILINK1,ILINK2,IDATA1,IDATA2)
-#include "zebra/mqsys.inc"
-#include "zebra/qequ.inc"
-#include "zebra/mzcn.inc"
-#include "zebra/zbcdk.inc"
-#include "zebra/zunit.inc"
-#include "zebra/dzc1.inc"
-#include "zebra/bankparq.inc"
-#include "zebra/divparq.inc"
-#include "zebra/questparq.inc"
-#include "zebra/storparq.inc"
-
- CHARACTER CHROUT*(*),CHSTAK*6
- PARAMETER (CHROUT = 'DZSHPR')
-
-#include "zebra/q_jbyt.inc"
-
-#if (defined(CERNLIB_DEBUGON))&&(defined(CERNLIB_VFORT))
-#include "zebra/debugvf2.inc"
-#endif
-
-
- CHSTAK = CQSTAK(MCQSIQ:)
- CQSTAK(MCQSIQ:) = CHROUT
-
-
- CALL MZCHLS (NCHEKQ,LBANK)
- IF (IQFOUL.NE.0) THEN
- CALL DZBKDV(LBANK)
- IF (IQUEST(1).NE.0) GO TO 999
- WRITE(CQINFO,'(A,''/'',I8)') CQDIV,LBANK
- CALL DZTEXT(MSHP1Q,CDUMMQ,0)
- GO TO 999
- ENDIF
-
-
- CALL DZBKDV(IQLS)
- IF (IQUEST(1).NE.0) GO TO 999
-
-
- CALL DZBKXR(0)
- IF (IQUEST(1).NE.0) GO TO 999
-
- LN = IQLN
- LS = IQLS
- NL = IQNL
- NS = IQNS
- ND = IQND
- IO = JBYT (LQ(KQS+IQLN+MBKIOQ),JBKIOQ,NBKIOQ)
-
- CALL DZBKHD
- IF (IQUEST(1).NE.0) GO TO 999
-
-
- IF (ILINK1.GT.ILINK2.OR.NL.EQ.0) GO TO 100
-
- IL1 = ILINK1
- IL2 = ILINK2
-
-
- IF (IL1.LE.0.OR.IL1.GT.NL) IL1=1
- IF (IL2.LE.0.OR.IL2.GT.NL) IL2=NL
-
- IF (IFLOPT(MPOSDQ).NE.0) THEN
-
-
-
- IBEGIN = MIN(NL,IL2)
- IF (IL1.LE.NS) THEN
- IBASE = NS
- ELSE
- IBASE = IL1-1
- ENDIF
-
- NDW = IBEGIN-IBASE
- JDFD = NDW + 1
-
- IF (NDW.GT.0) THEN
- IF (NDW.GT.NQWKTB) THEN
- LBASE = LS-IBEGIN-1
- CALL DZDATA('REFERENCE links -- to be inverted --')
- ELSE
- CALL UCOPIV (LQ(KQS+LS-IBEGIN),LQ(LQWKTB),NDW)
- LBASE = LQWKTB - 1 - KQS
- CALL DZDATA('REFERENCE links')
- ENDIF
- ENDIF
-
-
-
- IBEGIN = MIN(NS,IL2)
- IBASE = IL1-1
-
- NDW = IBEGIN-IBASE
- JDFD = NDW + 1
-
- IF (NDW.GT.0) THEN
- IF (NDW.GE.NQWKTB) THEN
- LBASE = LS-IBEGIN-1
- CALL DZDATA('STRUCTURAL links -- to be inverted --')
- ELSE
- CALL UCOPIV (LQ(KQS+LS-IBEGIN),LQ(LQWKTB),NDW)
- LBASE = LQWKTB - 1 - KQS
- CALL DZDATA('STRUCTURAL links')
- ENDIF
- ENDIF
-
- ELSE
-
-
- CALL ZPAGE(IQPRNT,MIN((IL2-IL1-1)/10+2,5))
- CQLINE = ' -------- LINK part of bank --------'
- CALL DZTEXT(0,CDUMMQ,1)
- DO 50 I=IL1,IL2,10
- WRITE (CQLINE,'(1X,I7,'' /'',10I12)')
- + I,(LQ(KQS+LS-J),J=I,MIN(IL2,I+9))
- CALL DZTEXT(0,CDUMMQ,1)
- 50 CONTINUE
-
- ENDIF
-
-
- 100 IF (ND.EQ.0.OR.IDATA2.LT.IDATA1) GO TO 999
-
- ID1 = IDATA1
- ID2 = IDATA2
-
-
- IF (ID1.LE.0.OR.ID1.GT.ND) ID1=1
- IF (ID2.LE.0.OR.ID2.GT.ND) ID2=ND
-
- CALL DZIOPR(ID1,ID2)
-
- 999 CQSTAK(MCQSIQ:) = CHSTAK
- RETURN
- END
diff --git a/src/packlib/zebra/dzebra/dzsnap.F b/src/packlib/zebra/dzebra/dzsnap.F
deleted file mode 100644
index aafb6fa..0000000
--- a/src/packlib/zebra/dzebra/dzsnap.F
+++ /dev/null
@@ -1,280 +0,0 @@
-*
-* $Id: dzsnap.F,v 1.2 1996/04/24 17:26:15 mclareni Exp $
-*
-* $Log: dzsnap.F,v $
-* Revision 1.2 1996/04/24 17:26:15 mclareni
-* Extend the include file cleanup to dzebra, rz and tq, and also add
-* dependencies in some cases.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:07 mclareni
-* Zebra
-*
-*
-*-----------------------------------------------------------
-#include "zebra/pilot.h"
-#if (defined(CERNLIB_DEBUGON))&&(defined(CERNLIB_VFORT))
-#include "zebra/debugvf1.inc"
-#endif
- SUBROUTINE DZSNAP (CHTEXT,IXDIV,CHOPT)
-#include "zebra/mqsys.inc"
-#include "zebra/qequ.inc"
-#include "zebra/mzcn.inc"
-#include "zebra/zbcdch.inc"
-#include "zebra/zbcdk.inc"
-#include "zebra/zmach.inc"
-#include "zebra/zstate.inc"
-#include "zebra/zunit.inc"
-#include "zebra/dzc1.inc"
-#include "zebra/bankparq.inc"
-#include "zebra/divparq.inc"
-#include "zebra/questparq.inc"
-#include "zebra/storparq.inc"
- CHARACTER *(*) CHTEXT,CHOPT
-
- CHARACTER CHROUT*(*)
- PARAMETER (CHROUT = 'DZSNAP')
-
-#include "zebra/q_jbit.inc"
-#include "zebra/q_jbyt.inc"
-
-#if (defined(CERNLIB_DEBUGON))&&(defined(CERNLIB_VFORT))
-#include "zebra/debugvf2.inc"
-#endif
-
- CQSTAK = CHROUT//'/'
- IQUEST(1) = 0
- IF (CHTEXT.NE.CDUMMQ) THEN
- CQMAP(1) = ' '
- CQMAP(2)(1:12) = ' DZSNAP --- '
- CQMAP(2)(13:100) = CHTEXT
- CQMAP(2)(101:110) = 'OPTIONS : '
- CQMAP(2)(111:130) = CHOPT
- CALL DZTEXT(0,CDUMMQ,2)
- ENDIF
-
- CALL DZOPT(CHOPT)
-
-
- CALL MZSDIV(IXDIV,0)
-
- CQMAP(1) = ' '
- CQMAP(2) = ' NAME LQSTOR NQSTRU NQREF NQLINK '//
- X 'LQMINR LQ2END JQDVLL JQDVSY NQFEND LOW-1 LOW-N '//
- X 'HIGH-1 HIGH-N SYST-1 SYST-N END'
-#if defined(CERNLIB_OCTMAP)
- WRITE(CQMAP(3),'(2X,2A4,''('',O8,'')'',15I7)')
-#endif
-#if !defined(CERNLIB_OCTMAP)
- WRITE(CQMAP(3),'(2X,2A4,''('',Z8,'')'',15I7)')
-#endif
- W NQSNAM(1) , NQSNAM(2) ,
-* Map addresses expressed in machine words
-#if defined(CERNLIB_WORDMAP)
- W LQSTOR+1 ,
-* Map addresses expressed in bytes
-#endif
-#if !defined(CERNLIB_WORDMAP)
- W (LQSTOR+1)*4 ,
-#endif
- W NQSTRU , NQREF , NQLINK , NQMINR ,
- W LQ2END , JQDVLL , JQDVSY , NQFEND ,
- W LQSTA (KQT+MDVLWQ),LQEND (KQT+MDVLWQ)-1 ,
- W LQSTA (KQT+MDVHGQ),LQEND (KQT+MDVHGQ)-1 ,
- W LQSTA (KQT+JQDVSY),LQEND (KQT+JQDVSY)-1 ,
- W LQSTA (KQT+NDVMXQ+1)-1
-
- CALL DZTEXT(0,CDUMMQ,3)
-
-
-
- DO 100 IFENCE=-NQFEND+1,0
- IF(LQ(KQS+IFENCE).NE.IQNIL) THEN
- WRITE (CQINFO,'(I5,1X,Z16)') IFENCE,LQ(KQS+IFENCE)
- CALL DZTEXT(MSNA1Q,CDUMMQ,0)
- IF (IFLOPT(MPOSSQ).NE.0) GO TO 998
- ENDIF
- 100 CONTINUE
-
-
- IF ((LQ(KQS+LQSTA(KQT+21)+1).NE.IQNIL) .OR.
- X (LQ(KQS+LQSTA(KQT+21)+2).NE.IQNIL) ) THEN
- WRITE (CQINFO,'(Z16,1X,Z16)')
- X LQ(KQS+LQSTA(KQT+21)+1),LQ(KQS+LQSTA(KQT+21)+2)
- CALL DZTEXT(MSNA2Q,CDUMMQ,0)
- IF (IFLOPT(MPOSSQ).NE.0) GO TO 998
- ENDIF
-
- IF(NQSTRU.GT.NQREF) THEN
- WRITE (CQINFO,'(I8,''>'',I8)') NQSTRU,NQREF
- CALL DZTEXT(MSNA3Q,CDUMMQ,0)
- IF (IFLOPT(MPOSSQ).NE.0) GO TO 998
- ENDIF
-
- IF(NQREF.GT.NQLINK) THEN
- WRITE (CQINFO,'(I8,''>'',I8)') NQREF,NQLINK
- CALL DZTEXT(MSNA4Q,CDUMMQ,0)
- IF (IFLOPT(MPOSSQ).NE.0) GO TO 998
- ENDIF
-
- IF(LQSTA(KQT+2)-LQEND(KQT+1).LT.NQMINR) THEN
- WRITE (CQINFO,'(I8,''-'',I8,''<'',I8)')
- X LQSTA(KQT+2),LQEND(KQT+1),NQMINR
- CALL DZTEXT(MSNA5Q,CDUMMQ,0)
- IF (IFLOPT(MPOSSQ).NE.0) GO TO 998
- ENDIF
-
- IF(NQMINR.GT.LQ2END) THEN
- WRITE (CQINFO,'(I8,''>'',I8)') NQMINR,LQ2END
- CALL DZTEXT(MSNA6Q,CDUMMQ,0)
- IF (IFLOPT(MPOSSQ).NE.0) GO TO 998
- ENDIF
-
- IF(LQ2END.GT.LQSTA(KQT+21)) THEN
- WRITE (CQINFO,'(I8,''>'',I8)') LQ2END,LQSTA(KQT+21)
- CALL DZTEXT(MSNA7Q,CDUMMQ,0)
- IF (IFLOPT(MPOSSQ).NE.0) GO TO 998
- ENDIF
-
-
- IF (IFLOPT(MPOSTQ).NE.0) THEN
- IFLOPT(MPOSCQ) = 1
- CALL UCOPY(IFLOPT,IQUEST(71),26)
- CALL VZERO(IFLOPT,26)
- IFLOPT(MPOSNQ) = 1
- IFLOPT(MPOSQQ) = 1
- IFLOPT(MPOSTQ) = 1
- CALL DZARE1('DZSNAP L option',' ',0,'NQT')
- CALL UCOPY(IQUEST(71),IFLOPT,26)
- ENDIF
- IF (IFLOPT(MPOSLQ).NE.0) THEN
- CALL UCOPY(IFLOPT,IQUEST(71),26)
- CALL VZERO(IFLOPT,26)
- IFLOPT(MPOSNQ) = 1
- CALL DZARE1('DZSNAP L option',' ',0,'N')
- CALL UCOPY(IQUEST(71),IFLOPT,26)
- ENDIF
- IF (IFLOPT(MPOSWQ).NE.0) THEN
- CQMAP(1) = ' '
-#if !defined(CERNLIB_OCTMAP)
- WRITE(CQMAP(2),'('' WORKING SPACE ADR(LQ(0)) = '',Z8)')
-#endif
-#if defined(CERNLIB_OCTMAP)
- WRITE(CQMAP(2),'('' WORKING SPACE ADR(LQ(0)) = '',O8)')
-* Map addresses expressed in machine words
-#endif
-#if defined(CERNLIB_WORDMAP)
- W LQSTOR+1
-* Map addresses expressed in bytes
-#endif
-#if !defined(CERNLIB_WORDMAP)
- W (LQSTOR+1)*4
-#endif
- CALL DZTEXT(0,CDUMMQ,2)
- LBASE = 0
- IBASE = 0
- JDFD = NQLINK + 1
- NDW = LQSTA(KQT+1) - 1
- IF (IFLOPT(MPOSTQ).NE.0) THEN
- NDW = MIN(NDW,NQWCUT+NQLINK)
- ELSE
- NDW = MIN(NDW,NQLINK)
- ENDIF
- CALL DZDATA(CDUMMQ)
- ENDIF
-
-
- IF (JBYT(IXDIV,1,JSTIDQ-1).EQ.0) THEN
- JJDIV = MZIXCO(IXDIV+21,IXDIV+22,0,0)
- JJDIV = MZDVAC(JJDIV)
- ELSE
- JJDIV = MZDVAC (IXDIV)
- ENDIF
-
- IF (IFLOPT(MPOSEQ)+IFLOPT(MPOSFQ)+IFLOPT(MPOSMQ).EQ.0) GO TO 999
-
-
-
- NDZRSV = 0
- CALL DZBKUP(0)
- IF (IQUEST(1).NE.0) GO TO 999
-
- DO 1000 JDIVI = 1,NDVMXQ
- IF ( JDIVI.GT.JQDVLL.AND.JDIVI.LT.JQDVSY) GO TO 1000
- IF (JBIT(JJDIV,JDIVI).EQ.0) GO TO 1000
- WRITE(CQMAP,'(1X,/,
- W '' DZSNAP. ----- Store nb.'',I2,'' = '',2A4,
- W '' Division nb.'',I2,'' = '',2A4,20X,20(''-''),/)')
- W JQSTOR,NQSNAM(1), NQSNAM(2),
- W JDIVI,IQDN1(KQT+JDIVI),IQDN2(KQT+JDIVI)
- CALL DZTEXT(0,CDUMMQ,3)
- LN = LQSTA(KQT+JDIVI)
- LSTOP = LQEND(KQT+JDIVI)
- IF(LN.EQ.LSTOP) THEN
- CQLINE = ' -- Division contains no banks --'
- CALL DZTEXT(0,CDUMMQ,1)
- GO TO 1000
- ENDIF
-
-
-
- JQDIVI = JDIVI
- CALL DZBKXR(0)
- IF (IQUEST(1).NE.0) GO TO 999
-
- 300 IF(LN.LT.LSTOP) THEN
- CALL DZMAP
- IF (IQUEST(1).NE.0) GO TO 400
- LN = LX
- GO TO 300
- ENDIF
-
- GO TO 1000
- 400 WRITE(CQINFO,'(I8)') LN
- CALL DZTEXT(MSNA8Q,CDUMMQ,0)
- LBKCL= LN
- IFLOPT(MPOSWQ) = -1
- 500 LBK = LN
- 600 LBK = LBK + 1
- IF (LBK.GE.LSTOP) THEN
- LN = LSTOP
- LBASE = LBKCL-1
- IBASE = LBASE
- NDW = MIN(LN - LBKCL,NQWCUT)
- JDFD = 1
- CALL DZDATA(CDUMMQ)
- GO TO 1000
- ENDIF
- CALL MZCHLN (NCHEKQ,LBK)
- IF (IQFOUL.NE.0) GO TO 600
- LN = LBK
- LBK = IQNX
- IF (LBK.GE.LSTOP) THEN
- LN = LSTOP
- LBASE = LBKCL-1
- IBASE = LBASE
- NDW = MIN(LN - LBKCL,NQWCUT)
- JDFD = 1
- CALL DZDATA(CDUMMQ)
- GO TO 1000
- ENDIF
- CALL MZCHLN (NCHEKQ,LBK)
- IF (IQFOUL.NE.0) GO TO 500
- 700 CONTINUE
- LBASE = LBKCL-1
- IBASE = LBASE
- NDW = MIN(LN - LBKCL,NQWCUT)
- JDFD = 1
- CALL DZDATA(CDUMMQ)
- WRITE(CQMAP,'(1X,/,'' RECOVER AT ADR'',I8)') LN
- CALL DZTEXT(0,CDUMMQ,2)
- IQUEST(1) = 0
- GO TO 300
-
- 1000 CONTINUE
-
- GO TO 999
-
- 998 IQUEST(1) = 1
-
- 999 RETURN
- END
diff --git a/src/packlib/zebra/dzebra/dzstdv.F b/src/packlib/zebra/dzebra/dzstdv.F
deleted file mode 100644
index b661a3e..0000000
--- a/src/packlib/zebra/dzebra/dzstdv.F
+++ /dev/null
@@ -1,138 +0,0 @@
-*
-* $Id: dzstdv.F,v 1.2 1996/04/24 17:26:16 mclareni Exp $
-*
-* $Log: dzstdv.F,v $
-* Revision 1.2 1996/04/24 17:26:16 mclareni
-* Extend the include file cleanup to dzebra, rz and tq, and also add
-* dependencies in some cases.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:07 mclareni
-* Zebra
-*
-*
-*-----------------------------------------------------------
-#include "zebra/pilot.h"
-#if (defined(CERNLIB_DEBUGON))&&(defined(CERNLIB_VFORT))
-#include "zebra/debugvf1.inc"
-#endif
- SUBROUTINE DZSTDV
- SAVE CKINDV,CMODV
-#include "zebra/bankparq.inc"
-#include "zebra/divparq.inc"
-#include "zebra/mqsys.inc"
-#include "zebra/qequ.inc"
-#include "zebra/mzcn.inc"
-#include "zebra/zunit.inc"
-#include "zebra/dzc1.inc"
- CHARACTER CKINDV(4)*7,CMODV(0:1)*5
-
- CHARACTER CHROUT*(*),CHSTAK*6
- PARAMETER (CHROUT = 'DZSTDV')
-
-#include "zebra/q_jbit.inc"
-#include "zebra/q_jbyt.inc"
-
-#if (defined(CERNLIB_DEBUGON))&&(defined(CERNLIB_VFORT))
-#include "zebra/debugvf2.inc"
-#endif
-
- DATA CKINDV / 'U/EVENT' , ' U/LONG' , 'PACKAGE' , ' SYSTEM' /
- DATA CMODV / 'FORWD' , 'REVRS' /
-
-
- CHSTAK = CQSTAK(MCQSIQ:)
- CQSTAK(MCQSIQ:) = CHROUT
-
-
- CQMAP(1) = ' '
- CQMAP(2) = ' --- Division parameters ---'
- CQMAP(3) = ' '
- CQMAP(4) = ' DIVISION START END MAX '//
- X 'KIND MODE WIPES GARB. GARB. PUSHES'//
- X ' LIVE BANKS DROPPED BANKS BANKS TOTAL'
- CQMAP(5) = ' NB. NAME ADDRESS ADDRESS LENGTH '//
- X ' SYST. FREE '//
- X ' NUMB. LENGTH NUMB. LENGTH NUMB. LENGTH'
- CQMAP(6) = ' ========================================='//
- X '======================================='//
- X '=============================================='
- CALL DZTEXT(0,CDUMMQ,6)
-
-
- DO 300 JDIVI = 1,NDVMXQ
-
-
- IF (JDIVI.GT.JQDVLL.AND.JDIVI.LT.JQDVSY) GO TO 300
- IMODE = JBIT(IQMODE(KQT+JDIVI),JDVBFQ)
- JKINDU = JBYT(IQKIND(KQT+JDIVI),JDVUSQ,JDVSYQ-NDVIDQ)
- IKIND = MIN(JKINDU/2+1,IDVSYQ)
-
- NBANK = 0
- NDROP = 0
- NBANKL = 0
- NDROPL = 0
- LN = LQSTA (KQT+JDIVI)
- LIMIT = LQEND (KQT+JDIVI)
- IQFOUL = 0
-
-100 IF (LN.GE.LIMIT) GO TO 200
- CALL MZCHLN(NCHEKQ,LN)
- IF(IQFOUL.NE.0) GO TO 200
- NBKTOT = IQNX - LN
-
- IF (IQND.LT.0) THEN
- NDROP = NDROP + 1
- NDROPL = NDROPL + NBKTOT
- ELSE
- IF (JBIT(IQ(KQS+IQLS),IQDROP).EQ.1) THEN
- NDROP = NDROP + 1
- NDROPL = NDROPL + NBKTOT
- ELSE
- NBANK = NBANK + 1
- NBANKL = NBANKL + NBKTOT
- ENDIF
- ENDIF
-
- LN = IQNX
-
- GO TO 100
-
- 200 IF (IQFOUL.EQ.0) THEN
- WRITE(CQLINE,
-#if !defined(CERNLIB_QMIBM)
- W '(I4,2X,2A4,3I8,1X,A7,2X,A5,4I7,2X,3(I6,I9))',ERR=300)
-#endif
-#if defined(CERNLIB_QMIBM)
- W '(I4,2X,2A4,3I8,1X,A7,2X,A5,4I7,2X,3(I6,I9))')
-#endif
- W JDIVI , IQDN1(KQT+JDIVI) , IQDN2(KQT+JDIVI) ,
- W LQSTA(KQT+JDIVI),LQEND(KQT+JDIVI)-1,NQDSIZ(KQT+JDIVI),
- W CKINDV(IKIND) , CMODV(IMODE) , NQDWIP(KQT+JDIVI) ,
- W NQDGAU(KQT+JDIVI),NQDGAF(KQT+JDIVI),NQDPSH(KQT+JDIVI),
- W NBANK , NBANKL , NDROP , NDROPL ,
- W NBANK + NDROP , NBANKL + NDROPL
- CALL DZTEXT(0,CDUMMQ,1)
-
- ELSE
-
-
- WRITE(CQMAP,'('' ?????? Bank beginning at address='',I8,
- W '' has problems -- no bank statistics'',/,
-#if !defined(CERNLIB_QMIBM)
- W I4,2X,2A4,3I8,1X,A7,2X,A5,4I7,2X)',ERR=300)
-#endif
-#if defined(CERNLIB_QMIBM)
- W I4,2X,2A4,3I8,1X,A7,2X,A5,4I7,2X)')
-#endif
- W LN, JDIVI,IQDN1(KQT+JDIVI),IQDN2(KQT+JDIVI),
- W LQSTA(KQT+JDIVI),LQEND(KQT+JDIVI)-1,NQDSIZ(KQT+JDIVI),
- W CKINDV(IKIND) , CMODV(IMODE) , NQDWIP(KQT+JDIVI) ,
- W NQDGAU(KQT+JDIVI),NQDGAF(KQT+JDIVI),NQDPSH(KQT+JDIVI)
- CALL DZTEXT(0,CDUMMQ,2)
-
- ENDIF
-
- 300 CONTINUE
-
- 999 CQSTAK(MCQSIQ:) = CHSTAK
- END
diff --git a/src/packlib/zebra/dzebra/dzstla.F b/src/packlib/zebra/dzebra/dzstla.F
deleted file mode 100644
index 49f3989..0000000
--- a/src/packlib/zebra/dzebra/dzstla.F
+++ /dev/null
@@ -1,108 +0,0 @@
-*
-* $Id: dzstla.F,v 1.2 1996/04/24 17:26:17 mclareni Exp $
-*
-* $Log: dzstla.F,v $
-* Revision 1.2 1996/04/24 17:26:17 mclareni
-* Extend the include file cleanup to dzebra, rz and tq, and also add
-* dependencies in some cases.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:07 mclareni
-* Zebra
-*
-*
-*-----------------------------------------------------------
-#include "zebra/pilot.h"
-#if (defined(CERNLIB_DEBUGON))&&(defined(CERNLIB_VFORT))
-#include "zebra/debugvf1.inc"
-#endif
- SUBROUTINE DZSTLA
- SAVE CLATYP
-#include "zebra/divparq.inc"
-#include "zebra/storparq.inc"
-#include "zebra/questparq.inc"
-#include "zebra/mqsys.inc"
-#include "zebra/qequ.inc"
-#include "zebra/mzcn.inc"
-#include "zebra/zunit.inc"
-#include "zebra/dzc1.inc"
-
- CHARACTER CHROUT*(*),CHSTAK*6, CLATYP(0:1)*9, CAKTIV*8
- PARAMETER (CHROUT = 'DZSTLA')
- DATA CLATYP /'PERMANENT','TEMPORARY'/
-
-#include "zebra/q_jbit.inc"
-#include "zebra/q_jbyt.inc"
-
-#if (defined(CERNLIB_DEBUGON))&&(defined(CERNLIB_VFORT))
-#include "zebra/debugvf2.inc"
-#endif
-
-
- CHSTAK = CQSTAK(MCQSIQ:)
- CQSTAK(MCQSIQ:) = CHROUT
-
-
- IF (LQSTA(KQT+JQDVSY).EQ.LQEND(KQT+JQDVSY)) GO TO 999
-
- LSYSB = LQSYSS(KQT+MSYLAQ)
- CALL MZCHLS(NCHEKQ,LSYSB)
- IF (IQFOUL.NE.0) THEN
- CALL DZTEXT(MARE1Q,CDUMMQ,0)
- GO TO 999
- ENDIF
-
-
- NWTAB = IQ(KQS+LSYSB+MLAUSQ)
-
-
- LENTRY = LSYSB + KQS + MLAUSQ
-
- CQMAP(1) = ' '
- CQMAP(2) = ' --- Link area parameters ---'
- CQMAP(3) = ' '
- CALL DZTEXT(0,CDUMMQ,3)
-
- DO 200 IENTRY = 1,(NWTAB-1)/NLAENQ
-
- LLAAR1 = IQ(LENTRY+MLAADQ)
- LLAARL = IQ(LENTRY+MLALTQ)
- NLANS = IQ(LENTRY+MLANSQ)
- NAME1 = IQ(LENTRY+MLAN1Q)
- NAME2 = IQ(LENTRY+MLAN2Q)
- JTEMP = JBIT(NLANS,JLATMQ)
- NTEMP = NLATMQ*JTEMP
- NLANS = JBYT(NLANS,JLANSQ,NLANSQ)-NTEMP
- IF (
- X JTEMP.EQ.0
- X .OR.
- X (JTEMP.EQ.1.AND.LQ(KQS+LLAAR1+MLACTQ-1).NE.0) )
- X THEN
- CAKTIV = ' ACTIVE'
- ELSE
- CAKTIV = 'INACTIVE'
- ENDIF
-
- LLAABS = LLAAR1 + LQSTOR
-* MAP addresses are in BYTES
-#if !defined(CERNLIB_WORDMAP)
- LLAABS = LLAABS*4
-#endif
- NDW = LLAARL - LLAAR1 - NTEMP
-
- WRITE(CQLINE,'(1X,2A4,1X,A9,'' LIST AREA'',5X,
-#if !defined(CERNLIB_OCTMAP)
- W '' is at absolute '',Z8,'' NL/NS '',2I5,
-#endif
-#if defined(CERNLIB_OCTMAP)
- W ''is at absolute '',O11,'' NL/NS '',2I5,
-#endif
- W 5X,''status '',A8)' )
- W NAME1,NAME2,CLATYP(JTEMP),LLAABS,NDW,NLANS,CAKTIV
- CALL DZTEXT(0,CDUMMQ,1)
-
- LENTRY = LENTRY + NLAENQ
-
- 200 CONTINUE
-
- 999 CQSTAK(MCQSIQ:) = CHSTAK
- END
diff --git a/src/packlib/zebra/dzebra/dzstor.F b/src/packlib/zebra/dzebra/dzstor.F
deleted file mode 100644
index 2ee7fe7..0000000
--- a/src/packlib/zebra/dzebra/dzstor.F
+++ /dev/null
@@ -1,72 +0,0 @@
-*
-* $Id: dzstor.F,v 1.1.1.1 1996/03/06 10:47:07 mclareni Exp $
-*
-* $Log: dzstor.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:07 mclareni
-* Zebra
-*
-*
-*-----------------------------------------------------------
-#include "zebra/pilot.h"
-#if (defined(CERNLIB_DEBUGON))&&(defined(CERNLIB_VFORT))
-#include "zebra/debugvf1.inc"
-#endif
- SUBROUTINE DZSTOR (CHTEXT,IXSTOR)
-#include "zebra/mqsys.inc"
-#include "zebra/qequ.inc"
-#include "zebra/zunit.inc"
-#include "zebra/dzc1.inc"
-#include "zebra/divparq.inc"
-#include "zebra/storparq.inc"
- CHARACTER *(*) CHTEXT
-
- CHARACTER CHROUT*(*)
- PARAMETER (CHROUT = 'DZSTOR')
-
-#if (defined(CERNLIB_DEBUGON))&&(defined(CERNLIB_VFORT))
-#include "zebra/debugvf2.inc"
-#endif
-
- CQSTAK = CHROUT//'/'
- IQUEST(1) = 0
-
- IF (CHTEXT.NE.CDUMMQ) THEN
- CQMAP(1) = ' '
- CQMAP(2) = ' DZSTOR --- '
- CQMAP(2)(13:) = CHTEXT
- CALL DZTEXT(0,CDUMMQ,2)
- ENDIF
-
- CALL MZSDIV (IXSTOR,-1)
-
-
- LSTABS = LQSTOR + 1
-* MAP addresses are in BYTES
-#if !defined(CERNLIB_WORDMAP)
- LSTABS = LSTABS*4
-#endif
- WRITE(CQMAP,'(1X,/,'' --- Store Parameters ---'',/,
- W'' Id Name Abs.addr. Length Fence NS NL'',
- W'' WS Min.Resv. Act.Resv. Min(1+2) Low High'',/,
-#if (!defined(CERNLIB_OCTMAP))&&(!defined(CERNLIB_QMIBM))
- W I3,2X,2A4,2X,Z8,1X,5I8,3I11,2I6)',ERR=999)
-#endif
-#if (!defined(CERNLIB_OCTMAP))&&(defined(CERNLIB_QMIBM))
- W I3,2X,2A4,2X,Z8,1X,5I8,3I11,2I6)')
-#endif
-#if defined(CERNLIB_OCTMAP)
- W I3,2X,2A4,2X,O8,1X,5I8,3I11,2I6)',ERR=999)
-#endif
- W JQSTOR , NQSNAM(1) , NQSNAM(2) ,
- W LSTABS , LQSTA(KQT+NDVMXQ+1)-1 , NQFEND ,
- W NQSTRU , NQREF-NQSTRU , NQLINK-NQREF ,
- W NQMINR , LQSTA(KQT+MDVHGQ)-LQEND(KQT+MDVLWQ) ,
- W LQ2END-1 , JQDVLL , 20-JQDVSY
- CALL DZTEXT(0,CDUMMQ,4)
-
- CALL DZSTDV
-
- CALL DZSTLA
-
- 999 RETURN
- END
diff --git a/src/packlib/zebra/dzebra/dzsurv.F b/src/packlib/zebra/dzebra/dzsurv.F
deleted file mode 100644
index 8dc984d..0000000
--- a/src/packlib/zebra/dzebra/dzsurv.F
+++ /dev/null
@@ -1,244 +0,0 @@
-*
-* $Id: dzsurv.F,v 1.2 1996/04/24 17:26:18 mclareni Exp $
-*
-* $Log: dzsurv.F,v $
-* Revision 1.2 1996/04/24 17:26:18 mclareni
-* Extend the include file cleanup to dzebra, rz and tq, and also add
-* dependencies in some cases.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:07 mclareni
-* Zebra
-*
-*
-*-----------------------------------------------------------
-#include "zebra/pilot.h"
-#if (defined(CERNLIB_DEBUGON))&&(defined(CERNLIB_VFORT))
-#include "zebra/debugvf1.inc"
-#endif
- SUBROUTINE DZSURV (CHTEXT,IXDIV,LBANK)
- SAVE NWDES
-#include "zebra/bankparq.inc"
-#include "zebra/divparq.inc"
-#include "zebra/questparq.inc"
-#include "zebra/mqsys.inc"
-#include "zebra/qequ.inc"
-#include "zebra/mzcn.inc"
-#include "zebra/zbcd.inc"
-#include "zebra/zbcdk.inc"
-#include "zebra/zunit.inc"
-#include "zebra/dzc1.inc"
- DIMENSION NEWID(10)
-
- CHARACTER CHTEXT*(*)
-
- CHARACTER CHROUT*(*)
- PARAMETER (CHROUT = 'DZSURV')
-
-#include "zebra/q_jbit.inc"
-
-#if (defined(CERNLIB_DEBUGON))&&(defined(CERNLIB_VFORT))
-#include "zebra/debugvf2.inc"
-#endif
-
- DATA NWDES / 4 /
-
-
- CQSTAK = CHROUT//'/'
- IQUEST(1) = 0
-
- CALL MZSDIV (IXDIV,-1)
-
-
- IF (LBANK.EQ.0) GO TO 999
- IF (JBIT(IQ(LBANK+KQS),IQDROP).EQ.1) GO TO 999
-
- LSTART = LBANK
-
- CALL MZCHLS(NCHEKQ,LSTART)
- IF (IQFOUL.NE.0) GO TO 91
- IDSTR = IQID
-
-
- IF (CHTEXT.NE.CDUMMQ.AND.CHTEXT.NE.'-') THEN
- CALL ZPAGE(IQPRNT,7)
- CQMAP(1) = ' '
- CQMAP(2) = ' DZSURV --- '
- CQMAP(2)(13:99) = CHTEXT
- WRITE(CQMAP(2)(100:),'('' ST= '',2A4,'' LSTART= '',I8)')
- X NQPNAM(KQT+1),NQPNAM(KQT+2),LSTART
- CALL DZTEXT(0,CDUMMQ,2)
- ENDIF
-
- IF (CHTEXT.NE.'-') THEN
- CALL ZPAGE(IQPRNT,5)
- CQMAP(1) = ' '
- CQMAP(2) = ' NWCUM NW WBK NBK IDENTIFIER(S)'
- CQMAP(3) = ' '
- CALL DZTEXT(0,CDUMMQ,3)
- ENDIF
-
- MAXALL = 0
- DO 20 I=1,NDVMXQ
- IF(I.LE.JQDVLL.OR.I.GE.JQDVSY)
- I MAXALL = MAXALL + LQEND(KQT+I) - LQSTA(KQT+I)
- 20 CONTINUE
- NBCUM = 0
- NWCUM = 0
- NEWNW = 0
- NEWND = 0
- NEWNBK = 0
- NEWRIN = IQBLAN
- NEWLOW = 99
- NEWUP = 1
- NEWNID = 0
- NEWID(1) = 0
- NEWLEV = 1
- LEVELH = 0
- LTAB1 = NQOFFT(1)
- LEND1 = LQEND(LTAB1+1)
- LWORK = LQWKTB
- NWORK = NQWKTB
- NLVMAX = NWORK/NWDES
- LDESC = LWORK - NWDES
- LKBCD = IQBLAN
- LGO = LSTART
- L = LSTART
-
- GO TO 52
- 31 NEWLEV = NEWLEV - 1
-
- IF (CHTEXT.NE.'-') CALL DZTEXT(1,CDUMMQ,1)
-
- IF (NEWLEV.EQ.1) GO TO 9991
- LDESC = LDESC - NWDES
- 34 IF (LQ(LDESC).EQ.LQ(LDESC+1)) GO TO 31
- LQ(LDESC) = LQ(LDESC) + 1
- 39 CALL VBLANK (IQUEST(2),3)
- CALL USET (LQ(LDESC),IQUEST,2,4)
- IQUEST(1) = IQMINS
- CALL URIGHT (IQUEST,1,4)
- CALL UBUNCH (IQUEST,LKBCD,4)
- NEWNW = 0
- NEWND = 0
- NEWNBK = 0
- NEWRIN = IQBLAN
- NEWLOW = 99
- NEWUP = 1
- NEWNID = 0
- NEWID(1) = 0
- LEVELH = 1
- LDESH = LWORK
- LGO = LSTART
- GO TO 42
- 41 LEVELH = LEVELH + 1
- LDESH = LDESH + NWDES
- 42 JFOLL = LQ(LDESH)
- LQ(LDESH+2) = LGO
- LQ(LDESH+3) = LGO
- LM = LGO
- GO TO 46
- 43 NEWRIN = IQLETT(MPOSRQ)
- 44 IF (LEVELH.EQ.0) GO TO 71
- 45 LM = LQ(LM+KQS)
- IF (LM.EQ.0) GO TO 47
- IF (LM.EQ.LQ(LDESH+3)) GO TO 47
- 46 CALL MZCHLS (NCHEKQ,LM)
- IF (IQFOUL.NE.0) GO TO 91
- IF (IQNS-JFOLL.LT.0) GO TO 45
- LQ(LDESH+2) = LM
- K = LM - JFOLL
- LGO = LQ(K+KQS)
-
- IF (LGO.EQ.0) GO TO 45
- IF (LEVELH+1.LT.NEWLEV) GO TO 41
- L = LGO
- GO TO 52
- 47 LEVELH = LEVELH - 1
- IF (LEVELH.EQ.0) GO TO 71
- LDESH = LDESH - NWDES
- JFOLL = LQ(LDESH)
- LM = LQ(LDESH+2)
- GO TO 45
- 51 K = L
- L = LQ(K+KQS)
- IF (L.EQ.0) GO TO 44
- IF (L.EQ.LGO) GO TO 43
- 52 CALL MZCHLS(NCHEKQ,L)
- IF (IQFOUL.NE.0) GO TO 91
- NEWNBK = NEWNBK + 1
- N = NBKOHQ + IQNL + IQND
- NEWND = MAX(NEWND,N)
- NEWNW = NEWNW + N
- IF (NEWNW.GE.MAXALL) GO TO 71
- IF (IQID.EQ.NEWID(1)) GO TO 57
- IF (NEWNID.EQ.0) GO TO 56
- IF (NEWNID.EQ.10) GO TO 57
- IF (IUCOMP(IQID,NEWID,NEWNID).NE.0) GO TO 57
- 56 NEWNID = NEWNID + 1
- NEWID(NEWNID) = IQID
- 57 IF (IQNS.EQ.0) GO TO 51
- N = MIN(NEWLOW-1,IQNS)
- DO 62 J=1,N
- IF (LQ(L-J+KQS).NE.0) THEN
- NEWLOW = J
- GO TO 64
- ENDIF
- 62 CONTINUE
- 64 JA = MAX(NEWLOW,NEWUP) + 1
- DO 65 J=JA,IQNS
- IF (LQ(L-J+KQS).NE.0) NEWUP=J
- 65 CONTINUE
-
- GO TO 51
- 71 IF (NEWNBK.EQ.0) GO TO 75
- NBCUM = NBCUM + NEWNBK
- NWCUM = NWCUM + NEWNW
- CALL VBLANK(IQUEST,NEWLEV)
- IQUEST(NEWLEV) = LKBCD
- NEWNID = MIN(NEWNID,21-NEWLEV)
- IF (CHTEXT.NE.'-') THEN
- WRITE(CQLINE,'(1X,2I7,I6,I5,2(1X,A1),20(1X,A4))')
- W NWCUM,NEWNW,NEWND,NEWNBK,NEWRIN
- W, (IQUEST(J),J=1,NEWLEV)
- W, (NEWID(J), J=1,NEWNID)
- CALL DZTEXT(0,CDUMMQ,1)
- ENDIF
-
- IF (NWCUM.GT.MAXALL) THEN
- WRITE(CQINFO,'(I10,''/'',I10)') NWCUM,MAXALL
- CALL DZTEXT(MSHO1Q,CDUMMQ,0)
- IQUEST(1) = 1
- GO TO 999
- ENDIF
-
- IF (NEWLOW.GE.64) GO TO 75
- IF (NEWLEV.GE.NLVMAX) GO TO 74
- NEWLEV = NEWLEV + 1
- LDESC = LDESC + NWDES
- LQ(LDESC) = NEWLOW
- LQ(LDESC+1) = MAX(NEWLOW,NEWUP)
- GO TO 39
- 74 CALL DZTEXT(MSUR1Q,CDUMMQ,0)
- 75 IF (NEWLEV.NE.1) GO TO 34
- GO TO 9991
- 91 IQUEST(1) = LGO
- IQUEST(2) = K
- IQUEST(3) = L
- CALL ZFATAM (CHROUT)
-
-
- 9991 IF (CHTEXT.NE.'-') THEN
- WRITE(CQMAP,'(1X,/,'' DZSURV --- The structure supported by'',
- + '' bank '',A4,'' at '',I10,'' in store '',2A4,'' occupies '',
- + I10,'' words in '',I6,'' banks '')')
- + IDSTR,LSTART,NQPNAM(KQT+1),NQPNAM(KQT+2),NWCUM,NBCUM
- CALL DZTEXT(0,CDUMMQ,2)
- ENDIF
- IQUEST(11) = IDSTR
- IQUEST(12) = LSTART
- IQUEST(13) = NQPNAM(KQT+1)
- IQUEST(14) = NQPNAM(KQT+2)
- IQUEST(15) = NWCUM
- IQUEST(16) = NBCUM
- 999 RETURN
- END
diff --git a/src/packlib/zebra/dzebra/dzswap.F b/src/packlib/zebra/dzebra/dzswap.F
deleted file mode 100644
index 1c55248..0000000
--- a/src/packlib/zebra/dzebra/dzswap.F
+++ /dev/null
@@ -1,270 +0,0 @@
-*
-* $Id: dzswap.F,v 1.2 1996/04/24 17:26:18 mclareni Exp $
-*
-* $Log: dzswap.F,v $
-* Revision 1.2 1996/04/24 17:26:18 mclareni
-* Extend the include file cleanup to dzebra, rz and tq, and also add
-* dependencies in some cases.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:07 mclareni
-* Zebra
-*
-*
-*----------------------------------------------------------
-#include "zebra/pilot.h"
- SUBROUTINE DZSWAP (IXSTOR,LSTR1,LSTR2,CHOPT)
-
-
-#include "zebra/mqsys.inc"
-#include "zebra/mzcn.inc"
-#include "zebra/qequ.inc"
-#include "zebra/zstate.inc"
-#include "zebra/zunit.inc"
-#include "zebra/storparq.inc"
-#include "zebra/dzc1.inc"
-
- CHARACTER *(*) CHOPT
- SAVE NAMESR
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HZSWA, 4HP /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HZSWAP /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- DATA NAMESR / 'ZSWAP ' /
-#endif
-#include "zebra/q_jbit.inc"
-#include "zebra/q_jbyt.inc"
-
-#include "zebra/qtrace.inc"
-
- IF (IXSTOR.NE.NCHEKQ) CALL MZSDIV (IXSTOR,-1)
-
- L1 = LSTR1
- L2 = LSTR2
-
- IFLAG = INDEX(CHOPT,'R')
-
-
- IF (LQSTA(KQT+JQDVSY).EQ.LQEND(KQT+JQDVSY)) IFLAG = 0
-
-#if defined(CERNLIB_QDEVZE)
- IF (NQDEVZ.NE.0) WRITE(IQPRNT,
- +'(''0DEVZE ZSWAP, ENTRY:IXSTOR,LSTR1,LSTR2,IFLAG= '',Z8,3I8)')
- + IXSTOR,L1,L2,IFLAG
-#endif
-
- IF (L1.EQ.0 .OR. L2.EQ.0) GO TO 999
-
- CALL MZCHLS(NCHEKQ,L1)
- IF (IQFOUL.NE.0) THEN
- WRITE(IQPRNT,'(''0ZSWAP - BANK1 INVALID'')')
- GO TO 998
- ENDIF
-
- CALL MZCHLS(NCHEKQ,L2)
- IF (IQFOUL.NE.0) THEN
- WRITE(IQPRNT,'(''0ZSWAP - BANK2 INVALID'')')
- GO TO 998
- ENDIF
-
- LNEXT1 = LQ(KQS+L1)
- IF (LNEXT1.NE.0) CALL MZCHLS(NCHEKQ,LNEXT1)
- IF (IQFOUL.NE.0) THEN
- WRITE(IQPRNT,'(''0ZSWAP - Next of LSTR1 invalid'',2I8)')
- + L1,LNEXT1
- GO TO 998
- ENDIF
- LUP1 = LQLUP(KQS+L1)
- IF (LUP1.NE.0) CALL MZCHLS(NCHEKQ,LUP1)
- IF (IQFOUL.NE.0) THEN
- WRITE(IQPRNT,'(''0ZSWAP - Origin of LSTR1 invalid'',2I8)')
- + L1,LUP1
- GO TO 998
- ENDIF
- LSUP1 = LQLORG(KQS+L1)
- IF (LQ(KQS+LSUP1).NE.L1) THEN
- WRITE(IQPRNT,'(''0ZSWAP - R link invalid (@r # LSTR1)'',
- + 2I8)') L1,LQ(KQS+LSUP1)
- GO TO 998
- ENDIF
-
- LNEXT2 = LQ(KQS+L2)
- IF (LNEXT2.NE.0) CALL MZCHLS(NCHEKQ,LNEXT2)
- IF (IQFOUL.NE.0) THEN
- WRITE(IQPRNT,'(''0ZSWAP - Next of LSTR2 invalid'',2I8)')
- + L2,LNEXT2
- GO TO 998
- ENDIF
- LUP2 = LQLUP(KQS+L2)
- IF (LUP2.NE.0) CALL MZCHLS(NCHEKQ,LUP2)
- IF (IQFOUL.NE.0) THEN
- WRITE(IQPRNT,'(''0ZSWAP - Origin of LSTR2 invalid'',2I8)')
- + L2,LUP2
- GO TO 998
- ENDIF
- LSUP2 = LQLORG(KQS+L2)
- IF (LQ(KQS+LSUP2).NE.L2) THEN
- WRITE(IQPRNT,'(''0ZSWAP - R link invalid (@r # LSTR2)'',
- + 2I8)') L2,LQ(KQS+LSUP2)
- GO TO 998
- ENDIF
-
-#if defined(CERNLIB_QDEVZE)
- IF (NQDEVZ.NE.0) WRITE(IQPRNT,
- +'(''0DEVZE ZSWAP, Before SWAP ,L1,N,O,P, at P '',5I8,/,
- + '' ZSWAP, Before SWAP ,L2,N,O,P, at P '',5I8)')
- + L1,LQ(KQS+L1),LQLUP(KQS+L1),LQLORG(KQS+L1),
- + LQ(KQS+LQLORG(KQS+L1)),
- + L2,LQ(KQS+L2),LQLUP(KQS+L2),LQLORG(KQS+L2),
- + LQ(KQS+LQLORG(KQS+L2))
-#endif
-
- IF (LNEXT1.EQ.L2) THEN
- LQ(KQS+L1) = LNEXT2
- LQ(KQS+L2) = L1
- LQLORG(KQS+L1) = L2
- LQLORG(KQS+L2) = LSUP1
- LQ(KQS+LSUP1) = L2
- IF (LNEXT2.NE.0) LQLORG(KQS+LNEXT2) = L1
- ELSEIF(L1.EQ.LNEXT2) THEN
- LQ(KQS+L1) = L2
- LQ(KQS+L2) = LNEXT1
- LQLORG(KQS+L1) = LSUP2
- LQLORG(KQS+L2) = L1
- LQ(KQS+LSUP2) = L1
- IF (LNEXT1.NE.0) LQLORG(KQS+LNEXT1) = L2
- ELSE
- LQ(KQS+L1) = LNEXT2
- LQ(KQS+L2) = LNEXT1
- LQLUP(KQS+L1) = LUP2
- LQLUP(KQS+L2) = LUP1
- LQLORG(KQS+L1) = LSUP2
- LQLORG(KQS+L2) = LSUP1
- LQ(KQS+LSUP1) = L2
- LQ(KQS+LSUP2) = L1
- IF (LNEXT1.NE.0) LQLORG(KQS+LNEXT1) = L2
- IF (LNEXT2.NE.0) LQLORG(KQS+LNEXT2) = L1
- ENDIF
-
- LSTR1 = L2
- LSTR2 = L1
-
-#if defined(CERNLIB_QDEVZE)
- IF (NQDEVZ.NE.0) WRITE(IQPRNT,
- +'(''0DEVZE ZSWAP, After SWAP ,LSTR1,N,O,P, at P '',5I8,/,
- + '' ZSWAP, After SWAP ,LSTR2,N,O,P, at P '',5I8)')
- + LSTR1,LQ(KQS+LSTR1),LQLUP(KQS+LSTR1),LQLORG(KQS+LSTR1),
- + LQ(KQS+LQLORG(KQS+LSTR1)),
- + LSTR2,LQ(KQS+LSTR2),LQLUP(KQS+LSTR2),LQLORG(KQS+LSTR2),
- + LQ(KQS+LQLORG(KQS+LSTR2))
-#endif
-
-
- IF (IFLAG.NE.0) THEN
- LSYSB = LQSYSS(KQT+MSYLAQ)
- IF(LSYSB.GT.0) THEN
- CALL MZCHLS(NCHEKQ,LSYSB)
- IF (IQFOUL.NE.0) THEN
- WRITE(IQPRNT,
- X '(''0ZSWAP - LINK AREA SYSTEM BANK INVALID'')')
- GO TO 998
- ENDIF
-
-
- NWTAB = IQ(KQS+LSYSB+MLAUSQ)
-
-
- LENTRY = LSYSB + KQS + MLAUSQ
-
- DO 300 IENTRY = 1,(NWTAB-1)/NLAENQ
-
- LLAAR1 = IQ(LENTRY+MLAADQ) + KQS
- LLAARL = IQ(LENTRY+MLALTQ) + KQS
- NLANS = IQ(LENTRY+MLANSQ)
- JTEMP = JBIT(NLANS,JLATMQ)
- NTEMP = NLATMQ*JTEMP
- NLANS = JBYT(IQ(LENTRY+MLANSQ),JLANSQ,NLANSQ) - NTEMP
- IF(JTEMP.EQ.1.AND.LQ(LLAAR1+MLACTQ-1).EQ.0) GO TO 300
- DO 200 I=LLAAR1+NTEMP+NLANS , LLAARL-1
- IF (LQ(I).EQ.L1) THEN
- LQ(I) = L2
- ELSEIF(LQ(I).EQ.L2) THEN
- LQ(I) = L1
- ENDIF
- 200 CONTINUE
-
- LENTRY = LENTRY + NLAENQ
- 300 CONTINUE
-
- ENDIF
-
-
-
- IDIV1 = 1
- IF (L1.LT.LQEND(KQT+JQDVLL)) GO TO 410
- IF (L1.GE.LQEND(KQT+NDVMXQ)) GO TO 998
- IDIV1 = JQDVSY
-
- 410 IF (L1.LT.LQEND(KQT+IDIV1 )) GO TO 420
- IDIV1 = IDIV1 + 1
- GO TO 410
-
- 420 IF (L1.LT.LQSTA(KQT+IDIV1 )) GO TO 998
-
-
- IDIV2 = 1
- IF (L2.LT.LQEND(KQT+JQDVLL)) GO TO 510
- IF (L2.GE.LQEND(KQT+NDVMXQ)) GO TO 998
- IDIV2 = JQDVSY
-
- 510 IF (L2.LT.LQEND(KQT+IDIV2 )) GO TO 520
- IDIV2 = IDIV2 + 1
- GO TO 510
-
- 520 IF (L2.LT.LQSTA(KQT+IDIV2 )) GO TO 998
-
-#if defined(CERNLIB_QDEVZE)
- IF (NQDEVZ.NE.0) WRITE(IQPRNT,
- +'(''0DEVZE ZSWAP, Divs : L1,IDIV1,L2,IDIV2= '',4I8)')
- + L1,IDIV1,L2,IDIV2
-#endif
-
-
- DO 1700 JQDIVI = 1,NDVMXQ
- IF (JQDIVI.GT.JQDVLL.AND.JQDIVI.LT.JQDVSY) GO TO 1700
-
- LN = LQSTA(KQT+JQDIVI)
- 1300 IF (LN.LT.LQEND(KQT+JQDIVI)) THEN
- CALL MZCHLN(NCHEKQ,LN)
- IF (IQFOUL.NE.0) THEN
- WRITE(IQPRNT,
- X '(''0ZSWAP - BANK INVALID AT'',I10)') LN
- GO TO 998
- ENDIF
- LN = IQNX
- IF (JBIT(IQ(KQS+IQLS),IQDROP).EQ.0) THEN
- DO 1400 L = IQLS-IQNL+KQS , IQLS-IQNS+KQS-1
- IF (LQ(L).EQ.L1) THEN
- LQ(L) = L2
- ELSEIF(LQ(L).EQ.L2) THEN
- LQ(L) = L1
- ENDIF
- 1400 CONTINUE
- ENDIF
- GO TO 1300
- ENDIF
- 1700 CONTINUE
-
- ENDIF
-
- GO TO 999
-
- 998 CONTINUE
-#include "zebra/qtofatal.inc"
-
-#include "zebra/qtrace99.inc"
- END
diff --git a/src/packlib/zebra/dzebra/dztext.F b/src/packlib/zebra/dzebra/dztext.F
deleted file mode 100644
index cf1cc49..0000000
--- a/src/packlib/zebra/dzebra/dztext.F
+++ /dev/null
@@ -1,122 +0,0 @@
-*
-* $Id: dztext.F,v 1.1.1.1 1996/03/06 10:47:07 mclareni Exp $
-*
-* $Log: dztext.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:07 mclareni
-* Zebra
-*
-*
-* ----------------------------------------------------------
-#include "zebra/pilot.h"
-#if (defined(CERNLIB_DEBUGON))&&(defined(CERNLIB_VFORT))
-#include "zebra/debugvf1.inc"
-#endif
- SUBROUTINE DZTEXT(IERCOD,CHTEXT,NLINES)
- SAVE CERCOD
- CHARACTER*(*) CHTEXT,CSEVER
- PARAMETER (CSEVER = ' ?? ')
-#include "zebra/zunit.inc"
-#include "zebra/dzc1.inc"
-#include "zebra/questparq.inc"
- CHARACTER CERCOD(MVE10Q:-1)*63
-
- DATA CERCOD(MARE1Q)/'Link area system bank invalid'/
- DATA CERCOD(MARE2Q)/'Link area system bank empty'/
- DATA CERCOD(MARE3Q)/
- X'Link area has bank with LU not Valid -- LA/position= ID LS LUP'/
- DATA CERCOD(MARE4Q)/
- X'Link area bank with invalid LORIG -- LA/position= ID LS LORIG'/
- DATA CERCOD(MARE5Q)/
- X'Link area has invalid bank address -- LA/position=LBANK'/
- DATA CERCOD(MARE6Q)/'Link area not found -- Name:'/
- DATA CERCOD(MARE7Q)/'Link area not found -- Address:'/
- DATA CERCOD(MBKD1Q)/'Bank address outside store bounds'/
- DATA CERCOD(MBKD2Q)/'Bank address outside division bounds'/
- DATA CERCOD(MBKU1Q)/'Too many link areas to check'/
- DATA CERCOD(MBKU2Q)/'UP bank incorrect DIV/LS,LUP,IQFOUL'/
- DATA CERCOD(MBKU3Q)/
- X'OR does not point into a valid link area -- DIV/LS,LORIG'/
- DATA CERCOD(MBKU4Q)/
- X'Contents @OR not equal to LS -- LORIG/(LORIG), at LORIG/LS '/
- DATA CERCOD(MBKX1Q)/
- X'Link references forbidden division DIV/LS,DIV/LQ(L)'/
- DATA CERCOD(MBKX2Q)/
- X'UP link references forbidden division DIV/LS,DIV/UP'/
- DATA CERCOD(MBKX3Q)/
- X'OR link references forbidden division DIV/LS,DIV/OR'/
- DATA CERCOD(MCHV1Q)/'Too many words to monitor -- Actual/maximum'/
- DATA CERCOD(MFOR1Q)/'IO characteristic invalid for identifier: '/
- DATA CERCOD(MFOR2Q)/'Bank invalid -- DIV/LBANK,IQFOUL'/
- DATA CERCOD(MFOR3Q)/
- X'Bank IO characteristic invalid -- DIV/LBANK,ID'/
- DATA CERCOD(MIOP1Q)/'Invalid IO descriptor -- DIV/LS,LN/@LN'/
- DATA CERCOD(MSHO1Q)/
- X'QUIT on structural loop -- Maximal/Total Nb. of banks '/
- DATA CERCOD(MSHO2Q)/'STACK overflow -- Number of levels '/
- DATA CERCOD(MSHP1Q)/'Faulty bank -- DIV/LBANK'/
- DATA CERCOD(MSNA1Q)/
- X'Store fence area corrupt -- Address and contents'/
- DATA CERCOD(MSNA2Q)/
- X'Store end overwritten -- Contents of 2 last words'/
- DATA CERCOD(MSNA3Q)/'Store parameters wrong -- NQSTRU>NQREF'/
- DATA CERCOD(MSNA4Q)/'Store parameters wrong -- NQREF>NQLINK'/
- DATA CERCOD(MSNA5Q)/
- X'Store parameters wrong -- LQSTA(2)-LQEND(1)<NQMINR'/
- DATA CERCOD(MSNA6Q)/'Store parameters wrong -- NQMINR>LQ2END'/
- DATA CERCOD(MSNA7Q)/'Store parameters wrong -- LQ2END>LAST'/
- DATA CERCOD(MSNA8Q)/'Bank chaining clobbered -- Address'/
- DATA CERCOD(MSUR1Q)/
- X'Probable loop in d/s -- Total length in store < length d/s '/
- DATA CERCOD(MVER1Q)/'Division parameters wrong -- LQSTA>LQEND'/
- DATA CERCOD(MVER2Q)/
- X'Division parameters wrong -- LQSTA<L(PREVIOUS)'/
- DATA CERCOD(MVER3Q)/
- X'Division parameters wrong -- div. length > max. allowed'/
- DATA CERCOD(MVER4Q)/
- X'Division parameters wrong -- invalid division mode'/
- DATA CERCOD(MVER5Q)/
- X'Division parameters wrong -- Duplicate bit DIV1/I,DIV2/I'/
- DATA CERCOD(MVER6Q)/
- X'Division parameters wrong -- Kind user : JDV,JLL,JSY,KIND'/
- DATA CERCOD(MVER7Q)/
- X'Division parameters wrong -- Kind system : JDV,JLL,JSY,KIND'/
- DATA CERCOD(MVER8Q)/
- X'Division parameters wrong -- Kind high : JDV,JLL,JSY,KIND'/
- DATA CERCOD(MVER9Q)/
- X'Bank in linear scan incorrect -- DIV/LN/IQFOUL'/
- DATA CERCOD(MVE10Q)/'Down bank incorrect DIV/L/LQ(L)/IQFOUL'/
-
-#if (defined(CERNLIB_DEBUGON))&&(defined(CERNLIB_VFORT))
-#include "zebra/debugvf2.inc"
-#endif
-
- IF (CHTEXT.NE.CDUMMQ) THEN
- CALL ZPAGE(IQPRNT,2+NLINES)
- IMTEXT = MIN(100,LEN(CHTEXT))
- WRITE(IQPRNT,'(''0'',A,'' -- '',A)')
- X CQSTAK(1:6),CHTEXT(1:IMTEXT)
- NQUSED = NQUSED + 2
- ENDIF
-
- IF (IERCOD.LT.0) THEN
- CALL ZPAGE(IQPRNT,2)
- CQLINE='0'//CQSTAK
- CQLINE(MCQLGQ:) = CSEVER
- CQLINE(MCQLTQ:) = CERCOD(IERCOD)
- CQLINE(MCQLIQ:) = CQINFO//CSEVER
- WRITE(IQPRNT,'(A)') CQLINE
- NQUSED = NQUSED + 2
- ELSEIF (IERCOD.EQ.0) THEN
- CALL ZPAGE(IQPRNT,NLINES)
- WRITE (IQPRNT,'(A)') (CQMAP(I),I=1,NLINES)
- NQUSED = NQUSED + NLINES
- ELSEIF (IERCOD.GT.0) THEN
- CALL ZPAGE(IQPRNT,NLINES)
- DO 100 I=1,NLINES
- WRITE (IQPRNT,'(1X)')
- 100 CONTINUE
- NQUSED = NQUSED + NLINES
- ENDIF
-
- 999 RETURN
- END
diff --git a/src/packlib/zebra/dzebra/dztyp.F b/src/packlib/zebra/dzebra/dztyp.F
deleted file mode 100644
index dc7c73f..0000000
--- a/src/packlib/zebra/dzebra/dztyp.F
+++ /dev/null
@@ -1,115 +0,0 @@
-*
-* $Id: dztyp.F,v 1.1.1.1 1996/03/06 10:47:07 mclareni Exp $
-*
-* $Log: dztyp.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:07 mclareni
-* Zebra
-*
-*
-*------------------------------------------------------------
-#include "zebra/pilot.h"
-#if (defined(CERNLIB_DEBUGON))&&(defined(CERNLIB_VFORT))
-#include "zebra/debugvf1.inc"
-#endif
- SUBROUTINE DZTYP
- SAVE ALOW,AUP,BLOW,BUP,ILIM
-#include "zebra/mqsys.inc"
-#include "zebra/qequ.inc"
-#include "zebra/zbcd.inc"
-#include "zebra/zbcdk.inc"
-#include "zebra/zmach.inc"
-#include "zebra/dzc1.inc"
-
- PARAMETER (IUMOIQ = 0)
-
- INTEGER IA,IWORD
- REAL A, WORD
- EQUIVALENCE (WORD,IWORD), (A,IA)
-
- CHARACTER CHROUT*(*),CHSTAK*6
- PARAMETER (CHROUT = 'DZTYP' )
-
-#if (defined(CERNLIB_DEBUGON))&&(defined(CERNLIB_VFORT))
-#include "zebra/debugvf2.inc"
-#endif
-
- DATA ILIM/10000000/,ALOW,AUP/.001,1.0E6/,BLOW,BUP/1.0E-20,1.0E20/
-
-
-
- CHSTAK = CQSTAK(MCQSIQ:)
- CQSTAK(MCQSIQ:) = CHROUT
-
- J = LBASE + JD
- IWORD = LQ(KQS+J)
- JTYP = 1
- IF (IWORD.EQ.IQNIL.OR.IWORD.EQ.IQNIL+J) GO TO 999
-
- IDLINK = JD+1 - JDFD
-
- IIUMOD = IUMODE(WORD)
-
- IF (IDLINK.LE.0) THEN
- IF (IIUMOD.NE.IUMOIQ) GO TO 999
- IF (IWORD.EQ.LNULL) THEN
- JTYP = 2
- ELSE
- CALL MZCHLS(NCHEKQ,IWORD)
- JTYP = -1
- ENDIF
- GO TO 999
- ENDIF
-
-
-
- IF (IFLOPT(MPOSZQ).NE.0) GO TO 100
-
-
- ITYPE = 0
-
- IF(IIUMOD.EQ.IUMOIQ) GO TO 300
- IF (IWORD.EQ.IQBLAN) GO TO 200
- IF (WORD.EQ.0.) THEN
- GO TO 400
- ELSEIF (WORD.LT.0.) THEN
- IF (WORD.LT.-BLOW.AND.WORD.GT.-BUP) GO TO 400
- ELSE
- IF (WORD.GT.BLOW.AND.WORD.LT.BUP) GO TO 400
- ENDIF
- CALL UBLOW(WORD,IQUEST,NQCHAW)
- DO 90 J=1,NQCHAW
- IF (IZBCD(IQUEST(J)).GE.48) GO TO 100
- 90 CONTINUE
- GO TO 200
-
-
- 100 JTYP = 1
- GO TO 999
-
-
- 200 JTYP = 7
- GO TO 999
-
-
- 300 IF ((IWORD.GE.0.AND.IWORD.LT.ILIM).OR.
- X (IWORD.LT.0.AND.IWORD.GT.-ILIM) ) THEN
- JTYP = 2
- ENDIF
- GO TO 999
-
-
- 400 A = ABS(WORD)
- JTYP = 6
- IF (A.EQ.0.) THEN
- JTYP = 3
- ELSEIF (A.LT.AUP.AND.A.GT.ALOW) THEN
- JTYP = 4
- IF (A.EQ.AINT(A)) THEN
- JTYP = 3
- ELSEIF (A.LT.100.) THEN
- JTYP = 5
- ENDIF
- ENDIF
-
- 999 CQSTAK(MCQSIQ:) = CHSTAK
- END
diff --git a/src/packlib/zebra/dzebra/dzveri.F b/src/packlib/zebra/dzebra/dzveri.F
deleted file mode 100644
index b7e986b..0000000
--- a/src/packlib/zebra/dzebra/dzveri.F
+++ /dev/null
@@ -1,326 +0,0 @@
-*
-* $Id: dzveri.F,v 1.2 1996/04/24 17:26:20 mclareni Exp $
-*
-* $Log: dzveri.F,v $
-* Revision 1.2 1996/04/24 17:26:20 mclareni
-* Extend the include file cleanup to dzebra, rz and tq, and also add
-* dependencies in some cases.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:07 mclareni
-* Zebra
-*
-*
-*-----------------------------------------------------------
-#include "zebra/pilot.h"
-#if (defined(CERNLIB_DEBUGON))&&(defined(CERNLIB_VFORT))
-#include "zebra/debugvf1.inc"
-#endif
- SUBROUTINE DZVERI (CHTEXT,IXDIV,CHOPT)
-#include "zebra/mqsys.inc"
-#include "zebra/qequ.inc"
-#include "zebra/mzcn.inc"
-#include "zebra/zbcdch.inc"
-#include "zebra/zbcdk.inc"
-#include "zebra/zmach.inc"
-#include "zebra/zunit.inc"
-#include "zebra/dzc1.inc"
-#include "zebra/bankparq.inc"
-#include "zebra/divparq.inc"
-#include "zebra/questparq.inc"
-#include "zebra/storparq.inc"
-
- PARAMETER (KINUSQ=2**(IDVUSQ-1),KINSYQ=2**(IDVSYQ-1))
-
- CHARACTER*(*) CHOPT,CHTEXT
- CHARACTER CHROUT*(*)
- PARAMETER (CHROUT = 'DZVERI')
-
-#include "zebra/q_jbit.inc"
-#include "zebra/q_jbyt.inc"
-
-#if (defined(CERNLIB_DEBUGON))&&(defined(CERNLIB_VFORT))
-#include "zebra/debugvf2.inc"
-#endif
-
- CQSTAK = CHROUT//'/'
- IQUEST(1) = 0
-
- CALL MZSDIV (IXDIV,-1)
-
- CALL DZOPT(CHOPT)
-
-
-
- ICHAIN = 1
- ISTRUC = 0
-
- IF (IFLOPT(MPOSSQ).NE.0.AND.IFLOPT(MPOSCQ).EQ.0) THEN
- ICHAIN = 0
- ENDIF
- IF (IFLOPT(MPOSLQ).NE.0) THEN
- ICHAIN = 1
- ISTRUC = 1
- ENDIF
-
- IF (IFLOPT(MPOSSQ).EQ.0) GO TO 1000
-
-
- DO 100 IFENCE=-NQFEND+1,0
- IF(LQ(KQS+IFENCE).NE.IQNIL) THEN
- WRITE (CQINFO,'(I5,1X,Z16)') IFENCE,LQ(KQS+IFENCE)
- CALL DZTEXT(MSNA1Q,CDUMMQ,0)
- GO TO 998
- ENDIF
- 100 CONTINUE
-
-
- IF ((LQ(KQS+LQSTA(KQT+21)+1).NE.IQNIL) .OR.
- X (LQ(KQS+LQSTA(KQT+21)+2).NE.IQNIL) ) THEN
- WRITE (CQINFO,'(Z16,1X,Z16)')
- X LQ(KQS+LQSTA(KQT+21)+1),LQ(KQS+LQSTA(KQT+21)+2)
- CALL DZTEXT(MSNA2Q,CDUMMQ,0)
- GO TO 998
- ENDIF
-
- IF(NQSTRU.GT.NQREF) THEN
- WRITE (CQINFO,'(I8,''>'',I8)') NQSTRU,NQREF
- CALL DZTEXT(MSNA3Q,CDUMMQ,0)
- GO TO 998
- ENDIF
-
- IF(NQREF.GT.NQLINK) THEN
- WRITE (CQINFO,'(I8,''>'',I8)') NQREF,NQLINK
- CALL DZTEXT(MSNA4Q,CDUMMQ,0)
- GO TO 998
- ENDIF
-
- IF(LQSTA(KQT+2)-LQEND(KQT+1).LT.NQMINR) THEN
- WRITE (CQINFO,'(I8,''-'',I8,''<'',I8)')
- X LQSTA(KQT+2),LQEND(KQT+1),NQMINR
- CALL DZTEXT(MSNA5Q,CDUMMQ,0)
- GO TO 998
- ENDIF
-
- IF(NQMINR.GT.LQ2END) THEN
- WRITE (CQINFO,'(I8,''>'',I8)') NQMINR,LQ2END
- CALL DZTEXT(MSNA6Q,CDUMMQ,0)
- GO TO 998
- ENDIF
-
- IF(LQ2END.GT.LQSTA(KQT+21)) THEN
- WRITE (CQINFO,'(I8,''>'',I8)') LQ2END,LQSTA(KQT+21)
- CALL DZTEXT(MSNA7Q,CDUMMQ,0)
- GO TO 998
- ENDIF
-
-
-
- LPREV = NQLINK
- DO 300 JDIVI=1,NDVMXQ
- IF(JDIVI.GT.JQDVLL.AND.JDIVI.LT.JQDVSY) GO TO 300
-
- CALL UHTOC (IQDN1(KQT+JDIVI),4,CQDIV(1:4),4)
- CALL UHTOC (IQDN2(KQT+JDIVI),4,CQDIV(5:8),4)
- CQINFO = CQDIV//'/'
-
- IF(LQSTA(KQT+JDIVI).GT.LQEND(KQT+JDIVI)) THEN
- WRITE (CQINFO(10:),'(I8,''>'',I8)')
- X LQSTA(KQT+JDIVI),LQEND(KQT+JDIVI)
- CALL DZTEXT(MVER1Q,CDUMMQ,0)
- GO TO 998
- ENDIF
-
- IF(LQSTA(KQT+JDIVI).LT.LPREV ) THEN
- WRITE (CQINFO(10:),'(I8,''<'',I8)') LQSTA(KQT+JDIVI),LPREV
- CALL DZTEXT(MVER2Q,CDUMMQ,0)
- GO TO 998
- ENDIF
-
- IF((LQEND(KQT+JDIVI)-LQSTA(KQT+JDIVI)).GT.
- X NQDMAX(KQT+JDIVI) ) THEN
- WRITE (CQINFO(10:),'(I8,''>'',I8)')
- X (LQEND(KQT+JDIVI)-LQSTA(KQT+JDIVI)),NQDMAX(KQT+JDIVI)
- CALL DZTEXT(MVER3Q,CDUMMQ,0)
- GO TO 998
- ENDIF
-
- IF(IQMODE(KQT+JDIVI).NE.IDVFWQ .AND.
- X IQMODE(KQT+JDIVI).NE.IDVBWQ ) THEN
- WRITE (CQINFO(10:),'(I10)') IQMODE(KQT+JDIVI)
- CALL DZTEXT(MVER4Q,CDUMMQ,0)
- GO TO 998
- ENDIF
-
- MKIND = IQKIND(KQT+JDIVI)
-
- DO 200 I=1,NDVMXQ
- IF(I.NE.JDIVI.AND.JBIT(MKIND,I).EQ.1) THEN
- WRITE (CQINFO(10:),'(I2,'', /'',I2)') JDIVI,I
- CALL UHTOC (IQDN1(KQT+JDIVI),4,CQINFO(13:16),4)
- CALL UHTOC (IQDN2(KQT+JDIVI),4,CQINFO(17:20),4)
- CALL DZTEXT(MVER5Q,CDUMMQ,0)
- GO TO 998
- ENDIF
- 200 CONTINUE
-
- MKIND = JBYT(MKIND,JDVUSQ,JDVSYQ-NDVIDQ)
- IF(JDIVI.LE.JQDVLL) THEN
- IF(MKIND.NE.KINUSQ) THEN
- WRITE (CQINFO(10:),'(4I5)') JDIVI,JQDVLL,JQDVSY,MKIND
- CALL DZTEXT(MVER6Q,CDUMMQ,0)
- GO TO 998
- ENDIF
- ELSEIF(JDIVI.EQ.JQDVSY) THEN
- IF(MKIND.NE.KINSYQ) THEN
- WRITE (CQINFO(10:),'(4I5)') JDIVI,JQDVLL,JQDVSY,MKIND
- CALL DZTEXT(MVER7Q,CDUMMQ,0)
- GO TO 998
- ENDIF
- ELSE
- IF(MKIND.EQ.KINUSQ.OR.MKIND.EQ.KINSYQ) THEN
- WRITE (CQINFO(10:),'(4I5)') JDIVI,JQDVLL,JQDVSY,MKIND
- CALL DZTEXT(MVER8Q,CDUMMQ,0)
- GO TO 998
- ENDIF
- ENDIF
- LPREV = LQEND(KQT+JDIVI)
- 300 CONTINUE
-
-
-
- 1000 IF (ICHAIN.EQ.0) GO TO 1999
-
- IF (ISTRUC.NE.0) THEN
-
-
- NDZRSV = 0
- CALL DZBKUP(0)
- IF (IQUEST(1).NE.0) GO TO 998
-
- ENDIF
-
-
- CALL UCOPY(IFLOPT,IQUEST(71),26)
- CALL VZERO(IFLOPT,26)
- IFLOPT(MPOSNQ) = 1
- IFLOPT(MPOSQQ) = 1
- CALL DZARE1('DZVERI L option',' ',0,'NQ')
- CALL UCOPY(IQUEST(71),IFLOPT,26)
-
-
- IF (JBYT(IXDIV,1,JSTIDQ-1).EQ.0) THEN
- JJDIV = MZIXCO(IXDIV+21,IXDIV+22,0,0)
- JJDIV = MZDVAC(JJDIV)
- ELSE
- JJDIV = MZDVAC (IXDIV)
- ENDIF
-
- DO 1700 JDIVI = 1,NDVMXQ
- IF (JDIVI.GT.JQDVLL.AND.JDIVI.LT.JQDVSY) GO TO 1700
-
- IF (JBIT(JJDIV,JDIVI).EQ.0) GO TO 1700
-
- CALL UHTOC (IQDN1(KQT+JDIVI),4,CQDIV(1:4),4)
- CALL UHTOC (IQDN2(KQT+JDIVI),4,CQDIV(5:8),4)
- CQINFO = CQDIV//'/'
-
-
- JQDIVI = JDIVI
- CALL DZBKXR(0)
- IF (IQUEST(1).NE.0) GO TO 998
-
-
- LN = LQSTA(KQT+JDIVI)
- 1300 IF (LN.LT.LQEND(KQT+JDIVI)) THEN
- CALL MZCHLN(NCHEKQ,LN)
- IF (IQFOUL.NE.0) THEN
- WRITE(CQINFO(10:),'(3I10)') JDIVI,LN,IQFOUL
- CALL DZTEXT(MVER9Q,CDUMMQ,0)
- GO TO 998
- ENDIF
- LN = IQNX
- LS = IQLS
- NL = IQNL
- IF (IQND.LT.0) GO TO 1300
- IF (JBIT(IQ(KQS+LS),IQDROP).EQ.1) GO TO 1300
-
-
- IF (ISTRUC.EQ.1) THEN
- LB = IQLS-IQNS+KQS
- LE = IQLS +KQS
- DO 1400 L=LB,LE
- IF (LQ(L).EQ.0) GO TO 1400
- CALL MZCHLS(NCHEKQ,LQ(L))
- IF (IQFOUL.NE.0) THEN
- CALL DZBKDV(LQ(L))
- IF (IQUEST(1).NE.0) GO TO 998
- WRITE(CQINFO(10:),
- X '(I8,'','',A,''/'',I8,'','',I4)')
- X L-KQS,CQDIV,LQ(L),IQFOUL
- GO TO 998
- ENDIF
- 1400 CONTINUE
- CALL DZBKUP(LS)
- IF (IQUEST(1).NE.0) GO TO 998
- CALL DZBKXR(LS)
- IF (IQUEST(1).NE.0) GO TO 998
- ENDIF
-
- GO TO 1300
- ENDIF
- 1700 CONTINUE
-
- 1999 IF (CHTEXT.NE.CDUMMQ) THEN
- CQMAP(1) = ' '
- CQMAP(2) = ' DZVERI --- '
- CQMAP(2)(13:99) = CHTEXT
- CQMAP(2)(101:110) = 'OPTIONS : '
- CQMAP(2)(111:120) = CHOPT
- CQMAP(2)(126:) = 'OK'
- CALL DZTEXT(0,CDUMMQ,2)
- ENDIF
- GO TO 999
-
-
- 998 IF (CHTEXT.NE.CDUMMQ) THEN
- CQMAP(1) = ' '
- CQMAP(2) = ' DZVERI --- '
- CQMAP(2)(13:99) = CHTEXT
- CQMAP(2)(101:110) = 'OPTIONS : '
- CQMAP(2)(111:115) = CHOPT
- CQMAP(2)(117:) = '??PROBLEMS ? '
- CALL DZTEXT(0,CDUMMQ,2)
- ENDIF
- IQUEST(1)=1
-
-
- NQFATA = 2
- IQUEST(11) = JQSTOR
- IQUEST(12) = JDIVI
- IF(ICHAIN.NE.0) THEN
- IQUEST(13) = LN
- IQUEST(14) = IQLS
- IQUEST(15) = IQNL
- IQUEST(16) = IQNS
- IQUEST(17) = IQND
- NQFATA = 17
- IF(ISTRUC.EQ.1) THEN
- NQFATA = 21
- IF(L.GE.LQSTA(KQT+JDIVI).AND.L.LT.LQEND(KQT+JDIVI)) THEN
- IQUEST(18) = L
- IQUEST(19) = LQ(L)
- ELSE
- IQUEST(18) = 0
- IQUEST(19) = 0
- ENDIF
- IQUEST(20) = LQLUP(KQS+LS)
- IQUEST(21) = LQLORG(KQS+LS)
- ENDIF
- ENDIF
-
-
- IF(IFLOPT(MPOSFQ).NE.0) CALL ZFATAM(CHROUT)
-
-
- 999 RETURN
- END
diff --git a/src/packlib/zebra/dzebra/dzzero.F b/src/packlib/zebra/dzebra/dzzero.F
deleted file mode 100644
index ffd3f77..0000000
--- a/src/packlib/zebra/dzebra/dzzero.F
+++ /dev/null
@@ -1,108 +0,0 @@
-*
-* $Id: dzzero.F,v 1.1.1.1 1996/03/06 10:47:07 mclareni Exp $
-*
-* $Log: dzzero.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:07 mclareni
-* Zebra
-*
-*
-*-----------------------------------------------------------
-#include "zebra/pilot.h"
-#if (defined(CERNLIB_DEBUGON))&&(defined(CERNLIB_VFORT))
-#include "zebra/debugvf1.inc"
-#endif
- SUBROUTINE DZZERO (IXSTOR,LBANK)
-#include "zebra/mqsys.inc"
-#include "zebra/mzcn.inc"
-#include "zebra/mzioc.inc"
-
- CHARACTER CLZERO*4
- DOUBLE PRECISION DLZERO
- INTEGER HLZERO , ILZERO
- REAL RLZERO
- SAVE CLZERO,DLZERO,HLZERO,ILZERO,RLZERO,IFIRST
- DATA CLZERO,DLZERO,ILZERO,RLZERO /' ',0.0D0,0,0.0/ ,IFIRST /1/
-
-#if (defined(CERNLIB_DEBUGON))&&(defined(CERNLIB_VFORT))
-#include "zebra/debugvf2.inc"
-#endif
-
-
-
-
- IF (IFIRST.EQ.1) THEN
- IFIRST=0
- CALL UCTOH(CLZERO,HLZERO,4,4)
- ENDIF
-
-
- CALL MZSDIV(IXSTOR,-1)
- CALL MZCHLS(-7,LBANK)
- CALL MZIOCR(LQ(KQS+IQLN))
- IF(IQFOUL.NE.0) GO TO 999
-
- JDATA = 0
- JFOCUR = 0
-
-
- 10 ITYPE = MFO(JFOCUR+1)
- IF (ITYPE.EQ.7) GO TO 40
- NWSEC = MFO(JFOCUR+2)
- IF (NWSEC) 20, 30, 60
-
-
- 20 NWSEC = IQND - JDATA
- GO TO 60
-
-
- 30 JDATA = JDATA + 1
- IWORD = IQ(KQS+LBANK+JDATA)
- NWSEC = IWORD
- GO TO 50
-
-
- 40 JDATA = JDATA + 1
- IWORD = IQ(KQS+LBANK+JDATA)
- ITYPE = MOD (IWORD,16)
- NWSEC = IWORD/16
-
- 50 IF (ITYPE.GT.5.OR.ITYPE.LT.0) THEN
- ITYPE = 0
- NWSEC = IQND - JDATA
- ELSEIF (NWSEC.LE.0) THEN
- NWSEC = IQND - JDATA
- ENDIF
-
-
- 60 IDBLE = 0
- DO 100 I=JDATA+1,JDATA+NWSEC
- IF (IDBLE.EQ.1) THEN
- IDBLE = 0
- ELSEIF (ITYPE.EQ.3) THEN
- Q(KQS+LBANK+I) = RLZERO
- ELSEIF (ITYPE.EQ.4) THEN
- CALL UCOPY(DLZERO,Q(KQS+LBANK+I),2)
- IDBLE = 1
- ELSEIF (ITYPE.EQ.5) THEN
- IQ(KQS+LBANK+I) = HLZERO
- ELSE
- IQ(KQS+LBANK+I) = ILZERO
- ENDIF
-
- 100 CONTINUE
-
-
- JDATA = JDATA + NWSEC
-
- IF (JDATA.GE.IQND) GO TO 999
-
- IF (JDATA.LT.IQND) THEN
- JFOCUR = JFOCUR + 2
- IF (JFOCUR.LT.JFOEND) GO TO 10
- JFOCUR = JFOREP
- GO TO 10
- ENDIF
-
-
- 999 RETURN
- END
diff --git a/src/packlib/zebra/dzebra/lzloc.F b/src/packlib/zebra/dzebra/lzloc.F
deleted file mode 100644
index 7ca7a0e..0000000
--- a/src/packlib/zebra/dzebra/lzloc.F
+++ /dev/null
@@ -1,61 +0,0 @@
-*
-* $Id: lzloc.F,v 1.1.1.1 1996/03/06 10:47:07 mclareni Exp $
-*
-* $Log: lzloc.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:07 mclareni
-* Zebra
-*
-*
-*------------------------------------------------------------
-#include "zebra/pilot.h"
- FUNCTION LZLOC (IXDIV,CHID,IDN)
-#include "zebra/mqsys.inc"
-#include "zebra/mzcn.inc"
-#include "zebra/qequ.inc"
-#include "zebra/zunit.inc"
-
- CHARACTER CHROUT*(*),CHBANK*4,CHID*(*)
- PARAMETER (CHROUT = 'LZLOC ')
-
-
- CHBANK = CHID
- IQUEST(1) = 0
- LZLOC = 0
-
- CALL UCTOH (CHBANK,NAME,4,4)
-
- CALL MZSDIV (IXDIV,0)
-
-
- IF (JQDIVI.EQ.0) THEN
- JDBEG = 1
- JDEND = 20
- ELSE
- JDBEG = JQDIVI
- JDEND = JQDIVI
- ENDIF
-
- DO 200 JDIVI = JDBEG,JDEND
- IF(JDIVI.GT.JQDVLL.AND.JDIVI.LT.JQDVSY) GO TO 200
- LN = LQSTA(KQT+JDIVI)
- 100 IF (LN.LT.LQEND(KQT+JDIVI)) THEN
- CALL MZCHLN(-7,LN)
- IF (IQFOUL.NE.0) THEN
- CALL ZPAGE(IQPRNT,2)
- WRITE(IQPRNT,'(''0?? LZLOC -- Incorrect bank found'',
- + '' in linear scan beginning at '',I8)') LN
- NQUSED = NQUSED + 2
- IQUEST(1) = IQFOUL
- GO TO 999
- ENDIF
- LN = IQNX
- IF (IQND.LT.0) GO TO 100
- IF (IQID.NE.NAME) GO TO 100
- IF (IQWIDN(KQS+IQLS).NE.IDN) GO TO 100
- LZLOC = IQLS
- GO TO 999
- ENDIF
- 200 CONTINUE
-
- 999 RETURN
- END
diff --git a/src/packlib/zebra/dzebra/nzleft.F b/src/packlib/zebra/dzebra/nzleft.F
deleted file mode 100644
index 9ca2300..0000000
--- a/src/packlib/zebra/dzebra/nzleft.F
+++ /dev/null
@@ -1,70 +0,0 @@
-*
-* $Id: nzleft.F,v 1.3 1997/03/14 17:19:29 mclareni Exp $
-*
-* $Log: nzleft.F,v $
-* Revision 1.3 1997/03/14 17:19:29 mclareni
-* WNT mods
-*
-* Revision 1.2.2.1 1997/01/21 11:33:38 mclareni
-* All mods for Winnt 96a on winnt branch
-*
-* Revision 1.2 1996/04/24 17:26:20 mclareni
-* Extend the include file cleanup to dzebra, rz and tq, and also add
-* dependencies in some cases.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:07 mclareni
-* Zebra
-*
-*
-*-----------------------------------------------------------
-#include "zebra/pilot.h"
- FUNCTION NZLEFT (IXDIV,IOPT)
-#include "zebra/mqsys.inc"
-
-#include "zebra/q_jbit.inc"
-#include "zebra/q_jbyt.inc"
-
- CALL MZSDIV (IXDIV,1)
-
-
- JQDIVR = JQDIVI
- IF (JQDIVR.LT.3) GO TO 41
- JQMODE = JBIT (IQMODE(KQT+JQDIVR), 1)
- JQKIND = JBYT (IQKIND(KQT+JQDIVR),21,4)
- JQSHAR = 0
- IF (JQMODE.NE.0) GO TO 31
-
-
- JQDIVN = JQDIVR + 1
- IF (JQDIVR.EQ.JQDVLL) GO TO 24
- IF (JQDIVR.EQ.20) GO TO 25
-
- IF (JBYT(IQKIND(KQT+JQDIVN),21,4).NE.JQKIND) GO TO 25
- IF (JBYT(IQMODE(KQT+JQDIVN),21,4).EQ.JQMODE) GO TO 25
- NZLEFT = LQSTA(KQT+JQDIVN) - LQEND(KQT+JQDIVR)
- GO TO 100
-
- 24 JQDIVN = JQDVSY
- 25 L = MIN(LQSTA(KQT+JQDIVR)+NQDMAX(KQT+JQDIVR),
- + LQSTA(KQT+JQDIVN) )
- NZLEFT = L - LQEND(KQT+JQDIVR)
- GO TO 100
-
-
- 31 JQDIVN = JQDIVR - 1
- IF (JQDIVR.EQ.JQDVSY) GO TO 34
- IF (JBYT(IQKIND(KQT+JQDIVN),21,4).NE.JQKIND) GO TO 35
- IF (JBYT(IQMODE(KQT+JQDIVN),21,4).EQ.JQMODE) GO TO 35
- NZLEFT = LQSTA(KQT+JQDIVR) - LQEND(KQT+JQDIVN)
- GO TO 100
-
- 34 JQDIVN = JQDVLL
- 35 NZLEFT = NQDMAX(KQT+JQDIVR)-LQEND(KQT+JQDIVR)+LQEND(KQT+JQDIVN)
- GO TO 100
-
-
- 41 NZLEFT = LQSTA(KQT+2) - LQEND(KQT+1) - NQMINR
-
- 100 IQUEST(11) = LQEND(KQT+JQDIVI) - LQSTA(KQT+JQDIVI)
-
- END
diff --git a/src/packlib/zebra/dzebra/zdvcop.F b/src/packlib/zebra/dzebra/zdvcop.F
deleted file mode 100644
index 24123ea..0000000
--- a/src/packlib/zebra/dzebra/zdvcop.F
+++ /dev/null
@@ -1,132 +0,0 @@
-*
-* $Id: zdvcop.F,v 1.1.1.1 1996/03/06 10:47:07 mclareni Exp $
-*
-* $Log: zdvcop.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:07 mclareni
-* Zebra
-*
-*
-*-----------------------------------------------------------
-#include "zebra/pilot.h"
-#if (defined(CERNLIB_DEBUGON))&&(defined(CERNLIB_VFORT))
-#include "zebra/debugvf1.inc"
-#endif
- SUBROUTINE ZDVCOP (IXDVFR,LIN,IXDVTO,LOUT,*)
-#include "zebra/mqsys.inc"
-#include "zebra/qequ.inc"
-#include "zebra/mzct.inc"
-#include "zebra/zstate.inc"
-#include "zebra/zunit.inc"
-#include "zebra/dzc1.inc"
-#include "zebra/bankparq.inc"
-#include "zebra/divparq.inc"
-#include "zebra/storparq.inc"
- CHARACTER CHROUT*(*)
- PARAMETER (CHROUT = 'ZDVCOP')
-#include "zebra/q_jbit.inc"
-
-#if (defined(CERNLIB_DEBUGON))&&(defined(CERNLIB_VFORT))
-#include "zebra/debugvf2.inc"
-#endif
-
- CALL MZSDIV(IXDVFR,1)
- JSTOR1 = JQSTOR
- JDIV1 = JQDIVI
- CALL MZSDIV(IXDVTO,1)
- JSTOR2 = JQSTOR
- JDIV2 = JQDIVI
- IF (JSTOR1.NE.JSTOR2) THEN
- WRITE(IQPRNT,'('' ZDVCOP -- Stores different '',2I5)')
- W JSTOR1,JSTOR2
- GO TO 998
- ENDIF
-
- IF (JDIV1.EQ.JDIV2) GO TO 999
-
- IF (JDIV1.GT.JQDVLL.AND.JDIV1.LT.JQDVSY) THEN
- WRITE(IQPRNT,'('' ZDVCOP -- Division 1 ID invalid '',I5)')
- W JDIV1
- GO TO 998
- ENDIF
- IF (JDIV2.GT.JQDVLL.AND.JDIV2.LT.JQDVSY) THEN
- WRITE(IQPRNT,'('' ZDVCOP -- Division 2 ID invalid '',I5)')
- W JDIV2
- GO TO 998
-
- ENDIF
- CALL MZGARB(IXDVFR,IXDVTO)
- JQDVM1 = 0
- JQDVM2 = 0
- NQDVMV = 0
-
- NWORDS = LQEND(KQT+JDIV1)-LQSTA(KQT+JDIV1)
-
- IF (JBIT(IQMODE(KQT+JDIV2),JDVBFQ).EQ.IDVFWQ) THEN
-
-
- IF (JDIV2.EQ.JQDVLL) THEN
- JNEXT = JQDVSY
- ELSE
- JNEXT = JDIV2 + 1
- ENDIF
- IF (NWORDS.GT.LQSTA(KQT+JNEXT)-LQSTA(KQT+JDIV2)) THEN
- WRITE(IQPRNT,'('' ZDVCOP -- TARGET DIVISION TOO SMALL'')')
- GO TO 998
- ENDIF
- CALL UCOPY
- U (LQ(KQS+LQSTA(KQT+JDIV1)),LQ(KQS+LQSTA(KQT+JDIV2)),NWORDS)
- LQEND(KQT+JDIV2) = LQSTA(KQT+JDIV2)+NWORDS
- NMOVE = LQSTA(KQT+JDIV2)-LQSTA(KQT+JDIV1)
- ELSE
-
-
- IF (NWORDS.GT.LQEND(KQT+JDIV2)-LQEND(KQT+JDIV2-1)) THEN
- WRITE(IQPRNT,'('' ZDVCOP -- TARGET DIVISION TOO SMALL'')')
- GO TO 998
- ENDIF
- CALL UCOPY
- U (LQ(KQS+LQSTA(KQT+JDIV1)),LQ(KQS+LQEND(KQT+JDIV2)-NWORDS)
- U ,NWORDS )
- LQSTA(KQT+JDIV2) = LQEND(KQT+JDIV2)-NWORDS
- NMOVE = LQEND(KQT+JDIV2)-LQSTA(KQT+JDIV1)-NWORDS
- ENDIF
-
- LQMTA = NQOFFS(1) + LQEND(1)
- MQDVGA = 0
- MQDVWI = 0
- CALL SBIT1(MQDVGA,JDIV2)
- CALL MZTABM
- LQMTE = LQMTA + JDIV2*8
- DO 300 L=LQMTA,LQMTE-1,8
- IF(LQ(L).EQ.JDIV2) THEN
- LQ(L+1) = 1
- ELSE
- LQ(L+1) = -1
- ENDIF
- 300 CONTINUE
- LQRTA = LQMTE
- LQTA = LQRTA + 2
- LQ(LQTA-1) = LQSTA(KQT+JDIV1)
- LQ(LQTA ) = LQSTA(KQT+JDIV1)
- LQ(LQTA+1) = LQEND(KQT+JDIV1)
- LQ(LQTA+2) = NMOVE
- LQ(LQTA+3) = 0
- LQTE = LQTA + 4
- LQ(LQTE ) = LQEND(KQT+JDIV1)
- LSUP = LQLORG(KQS+LIN)
- IF (LSUP.NE.0) THEN
- LQLORG(KQS+LIN+NMOVE) = LSUP+LOCF(LOUT)-LOCF(LIN)
- ELSE
- LQLORG(KQS+LIN+NMOVE) = 0
- ENDIF
-#if defined(CERNLIB_QDEVZE)
- IF(NQDEVZ.NE.0) CALL CQDTAB (0)
-#endif
- CALL MZRELB
- LOUT = LIN + NMOVE
-
- GO TO 999
-
- 998 RETURN 1
- 999 RETURN
- END
diff --git a/src/packlib/zebra/dzebra/zpage.F b/src/packlib/zebra/dzebra/zpage.F
deleted file mode 100644
index ec65eab..0000000
--- a/src/packlib/zebra/dzebra/zpage.F
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: zpage.F,v 1.2 1999/06/14 13:59:08 couet Exp $
-*
-* $Log: zpage.F,v $
-* Revision 1.2 1999/06/14 13:59:08 couet
-* - Mods for Y2K in the date/time output
-*
-* Revision 1.1.1.1 1996/03/06 10:47:07 mclareni
-* Zebra
-*
-*
-*------------------------------------------------------------
-#include "zebra/pilot.h"
- SUBROUTINE ZPAGE(LUN,LINES)
-#include "zebra/zheadp.inc"
-#include "zebra/zmach.inc"
-#include "zebra/zunit.inc"
- DIMENSION LUNS(3)
- EQUIVALENCE (LUNS(1),IQPRNT)
- IF (LINES.LT.0) GO TO 11
-* For C printer
-#if defined(CERNLIB_QMIBM)
- 7 IF(NQUSED.LE.NQLMAX-2) GO TO 8
- NQUSED= NQUSED - NQLMAX + 2
-#endif
-#if !defined(CERNLIB_QMIBM)
- 7 IF(NQUSED.LE.NQLMAX) GO TO 8
- NQUSED= NQUSED - NQLMAX
-#endif
- GO TO 7
- 8 IF (NQUSED+LINES.LE.NQLNOR-2) RETURN
- 11 JLUN = IUCOMP (LUN,LUNS,3) + 1
- IQPAGE = NQPAGE(JLUN) + 1
- NQPAGE(JLUN) = IQPAGE
- NQUSED = NQLPTH + 1
- WRITE (LUN,
- W '(''1'',20A4,28X,I6.6,''/'',I4.4,'' PAGE'',I5)')
- W IQHEAD,IQDATE,IQTIME,IQPAGE
-
- 999 RETURN
- END
diff --git a/src/packlib/zebra/fq/Imakefile b/src/packlib/zebra/fq/Imakefile
deleted file mode 100644
index d372450..0000000
--- a/src/packlib/zebra/fq/Imakefile
+++ /dev/null
@@ -1,27 +0,0 @@
-SRCS_F= fzcffn.F fzcffx.F fzcopy.F fzendi.F fzendo.F fzficr.F \ @@\
- fzfile.F fzhook.F fziacn.F fzialn.F fziasc.F fzichh.F \ @@\
- fzidat.F fzidia.F fzidum.F fziffn.F fziffx.F fzilin.F fzimtb.F \ @@\
- fzin.F fzinfo.F fzinxt.F fzipha.F fziphd.F fziphm.F fziphr.F \ @@\
- fziprl.F fzirec.F fzirel.F fzitrn.F fzlimi.F fzloc.F \ @@\
- fzlogl.F fzmach.F fzmemo.F fzoaln.F fzoapk.F fzoasc.F \ @@\
- fzodat.F fzoffn.F fzoffx.F fzon1.F fzon2.F fzon3.F fzon4.F \ @@\
- fzon5.F fzon6.F fzophr.F fzorec.F fzotab.F fzotrn.F \ @@\
- fzotxt.F fzout.F fzrun.F fzudat.F
-
-#if !defined(CERNLIB_UNIX) \
- || defined(CERNLIB_DECS) || defined(CERNLIB_CERNLIB_QMVAOS) \
- || defined(CERNLIB_WINNT) || (defined(CERNLIB_LINUX) && !defined(CERNLIB_PPC))
-
-/* data format is NOT IEEE big endian --> need to convert */
-
-SRCS_F := $(SRCS_F) fzicv.F fzitrx.F fzocv.F fzotrx.F
-#endif
-
-#ifdef CERNLIB_HPUX
-SpecialFortranLibObjectRule(fzichh,fzichh,'-WF,-P',NullParameter)
-SpecialFortranLibObjectRule(fziffn,fziffn,'-WF,-P',NullParameter)
-SpecialFortranLibObjectRule(fziffx,fziffx,'-WF,-P',NullParameter)
-#endif
-
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/zebra/fq/fzcffn.F b/src/packlib/zebra/fq/fzcffn.F
deleted file mode 100644
index 5aaa7bc..0000000
--- a/src/packlib/zebra/fq/fzcffn.F
+++ /dev/null
@@ -1,210 +0,0 @@
-*
-* $Id: fzcffn.F,v 1.3 1999/06/18 13:28:33 couet Exp $
-*
-* $Log: fzcffn.F,v $
-* Revision 1.3 1999/06/18 13:28:33 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.2 1996/04/18 16:10:15 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:08 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
-#if defined(CERNLIB_FZFFNAT)
- SUBROUTINE FZCFFN
-
-C- Copy table + bank material for input file format native,
-C- subsidiary to FZCOPY
-
-#include "zebra/zunit.inc"
-#include "zebra/mqsys.inc"
-#include "zebra/eqlqf.inc"
-#include "zebra/mzct.inc"
-#include "zebra/mzcwk.inc"
-#include "zebra/fzci.inc"
-#include "zebra/fzcx.inc"
-#include "zebra/fzcseg.inc"
-*
- EQUIVALENCE (LRTYP,IDI(2))
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HFZCF, 4HFN /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HFZCFFN /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'FZCFFN ')
-#endif
-
-#include "zebra/qtrace.inc"
-
-
- NWDO = NWBKX
- ISTTAB = IQUEST(7)
- IF (IFIFOX.EQ.0) GO TO 41
-
-C-------------------------------------------------
-C- Output file format exchange
-C-------------------------------------------------
-
-C---- Copy early table words
-
- IF (ISTTAB) 23, 21, 24
- 21 CALL FZOTRN (LQ(LQTA), NWTABX)
- GO TO 24
-
-C---- Copy table and bank material
-
- 23 NWDO = NWTABX + NWBKX
- 24 NEXT = -7
- LAST = 7
- JIN = 1
-
- 31 NWR = NQWKTT
- CALL XINBS (LUNI,LRTYP,1,IQWKTB(JIN),NWR)
- IF (NWR.EQ.0) GO TO 411
- IF (NWR.LT.0) GO TO 751
- NRECAI = NRECAI + 1
- NWRDAI = NWRDAI + NWR + 3
- IF (LRTYP.EQ.1) GO TO 424
- IF (LRTYP.LT.4) GO TO 733
- IF (LRTYP.EQ.5) GO TO 31
- IF (LRTYP.EQ.6) GO TO 31
- IF (LRTYP.GE.9) GO TO 733
-
- NWDO = NWDO - NWR
- IF (NWDO.LT.0) GO TO 734
- IF (NWDO.NE.0) THEN
- IF (LRTYP.EQ.8) GO TO 735
- ELSE
- IF (LAST.NE.0) THEN
- IF (LRTYP.NE.8) GO TO 736
- ENDIF
- ENDIF
- IF (NEXT.EQ.0) GO TO 46
-
- 36 CALL FZOTRN (IQWKTB,NWR)
- IF (NWDO.NE.0) GO TO 31
-
- CALL FZOREC
-#include "zebra/qtrace99.inc"
- RETURN
-
-C-------------------------------------------------
-C- Output file format native
-C-------------------------------------------------
-
-C---- Copy early table words
-
- 41 IDX(2) = 4
- MINREC = (4*MAXREX) / 5
- LAST = 0
- NEXT = 0
- IF (ISTTAB) 43, 42, 61
- 42 CALL FZON1 (LQ(LQTA), NWTABX)
- GO TO 61
-
-C---- Copy the table material
-
- 43 NWDO = NWTABX
-
- 44 JIN = 1
- GO TO 31
-
- 46 JIN = JIN + NWR
- IF (NWDO.NE.0) THEN
- IF (JIN.LT.NQWKTT) GO TO 31
- ENDIF
-
- JEX = 1
- 47 NEX = MIN (JIN-JEX, MAXREX)
- IF (NWDO.EQ.0) THEN
- IF (LAST.NE.0) THEN
- IF (JEX+NEX.EQ.JIN) IDX(2) = 8
- ENDIF
- GO TO 48
- ENDIF
-
- IF (NEX.GE.MINREC) GO TO 48
- CALL UCOPY (IQWKTB(JEX),IQWKTB,NEX)
- JIN = NEX + 1
- GO TO 31
-
- 48 CALL FZON1 (IQWKTB(JEX),NEX)
- JEX = JEX + NEX
- IF (JEX.LT.JIN) GO TO 47
- IF (NWDO.NE.0) GO TO 44
-
- IF (LAST.NE.0) GO TO 999
- IF (IDX(2).NE.4) GO TO 63
-
-C---- Copy the bank material
-
- 61 IDX(2) = 7
- IF (NQSEG.EQ.0) THEN
- LAST = 7
- NWDO = NWBKX
- GO TO 44
- ENDIF
-
- JSEG = 0
- 63 JSEG = JSEG + 1
- NWDO = IQSEGD(JSEG)
- IF (JSEG.EQ.NQSEG) LAST=7
- GO TO 44
-
-C-----------------------------------------------------------
-C-- Input errors
-C-----------------------------------------------------------
-
-C-- Unexpected end-of-file
-
- 411 JRETCD = 1
- GO TO 999
-
-C-- Unexpected start/end of run
-
- 424 JRETCD = 2
- NWRU = MIN (78, NWR)
- LFIIOC = LQFI + JAUIOC
- IQ(KQSP+LFIIOC) = NWRU
- CALL UCOPY (IQWKTB,IQ(KQSP+LFIIOC+1),NWRU)
- GO TO 999
-
-C-- BAD DATA
-
-C- JERROR = 437 emergency stop record seen
- 737 JERROR = 437
- JRETCD = 8
- GO TO 999
-
-C- JERROR = 436 last bank material record needed is not type 8
- 736 JERROR = 1
-
-C- JERROR = 435 premature LR type 8
- 735 JERROR = JERROR + 1
-
-C- JERROR = 434 table or d/s data longer than expected
- 734 JERROR = JERROR + 1
-
-C- JERROR = 433 record of unexpected record type read
- 733 JERROR = 433 + JERROR
- IF (LRTYP.EQ.9) GO TO 737
- JRETCD = 5
- GO TO 999
-
-C-- READ ERROR
-
- 751 JERROR = 451
- NWERR = 1
- IQUEST(14) = -NWR
- JRETCD = 7
- GO TO 999
- END
-#endif
diff --git a/src/packlib/zebra/fq/fzcffx.F b/src/packlib/zebra/fq/fzcffx.F
deleted file mode 100644
index 50c9df0..0000000
--- a/src/packlib/zebra/fq/fzcffx.F
+++ /dev/null
@@ -1,141 +0,0 @@
-*
-* $Id: fzcffx.F,v 1.2 1999/06/18 13:28:34 couet Exp $
-*
-* $Log: fzcffx.F,v $
-* Revision 1.2 1999/06/18 13:28:34 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:10 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE FZCFFX
-
-C- Copy table + bank material for input file format X,
-C- subsidiary to FZCOPY
-
-#include "zebra/zunit.inc"
-#include "zebra/mqsys.inc"
-#include "zebra/eqlqf.inc"
-#include "zebra/mzct.inc"
-#include "zebra/mzcwk.inc"
-#include "zebra/fzci.inc"
-#include "zebra/fzcx.inc"
-#include "zebra/fzcseg.inc"
-*
- EQUIVALENCE (LRTYP,IDI(2))
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HFZCF, 4HFX /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HFZCFFX /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'FZCFFX ')
-#endif
-
-#include "zebra/qtraceq.inc"
-
-
- NWDO = NWBKX
- ISTTAB = IQUEST(7)
-#if defined(CERNLIB_FZFFNAT)
- IF (IFIFOX.EQ.0) GO TO 41
-#endif
-
-C-------------------------------------------------
-C- Output file format exchange
-C-------------------------------------------------
-
- IF (ISTTAB.LT.0) NWDO = NWDO + NWTABX
-
- 24 CALL FZIACN (NWDO,LDATA,NWACC)
- IF (IFLAGI.NE.0) GO TO 999
-
- CALL FZOTRN (LQ(LDATA),NWACC)
- NWDO = NWDO - NWACC
- IF (NWDO.NE.0) GO TO 24
-
- 29 CALL FZIREC
- IF (N4RESI.NE.0) GO TO 991
-
- IF (IFIFOX.NE.0) CALL FZOREC
-
-#include "zebra/qtrace99.inc"
- RETURN
-
-C-------------------------------------------------
-C- Output file format native
-C-------------------------------------------------
-
-#if defined(CERNLIB_FZFFNAT)
- 41 MINREC = (4*MAXREX) / 5
- LAST = 0
- IF (ISTTAB.GE.0) GO TO 61
-
-C---- Copy the table
-
- IDX(2) = 4
- NWDO = NWTABX
-
- 44 NWR = MIN (NWDO, MAXREX)
- CALL FZIACN (NWR,LDATA,NWACC)
- IF (IFLAGI.NE.0) GO TO 999
- NWDO = NWDO - NWACC
- IF (NWDO.EQ.0) THEN
- IF (LAST.NE.0) IDX(2)=8
- CALL FZON1 (LQ(LDATA),NWACC)
- GO TO 58
- ENDIF
-
- IF (NWACC.GE.MINREC) THEN
- CALL FZON1 (LQ(LDATA),NWACC)
- GO TO 44
- ENDIF
-
- NIN = 0
- 46 CALL UCOPY (LQ(LDATA),IQWKTB(NIN+1),NWACC)
- NIN = NIN + NWACC
-
- NWR = MIN (NWDO, MAXREX-NIN)
- CALL FZIACN (NWR,LDATA,NWACC)
- IF (IFLAGI.NE.0) GO TO 999
- NWDO = NWDO - NWACC
- IF (NWDO.EQ.0) THEN
- IF (LAST.NE.0) IDX(2)=8
- ELSE
- IF (NIN+NWACC.LT.MINREC) GO TO 46
- ENDIF
-
- CALL FZON2 (IQWKTB,NIN,LQ(LDATA),NWACC)
- IF (NWDO.NE.0) GO TO 44
-
- 58 IF (LAST.NE.0) GO TO 999
- IF (IDX(2).NE.4) GO TO 63
-
-C---- Copy the bank material
-
- 61 IDX(2) = 7
- IF (NQSEG.EQ.0) THEN
- LAST = 7
- NWDO = NWBKX
- GO TO 44
- ENDIF
-
- JSEG = 0
- 63 JSEG = JSEG + 1
- NWDO = IQSEGD(JSEG)
- IF (JSEG.EQ.NQSEG) LAST=7
- GO TO 44
-#endif
-C---- Error handling
-
-C- JERROR = 455 bank material does not end exactly with LR
- 991 JERROR = 455
- JRETCD = 5
- GO TO 999
- END
diff --git a/src/packlib/zebra/fq/fzclosex.inc b/src/packlib/zebra/fq/fzclosex.inc
deleted file mode 100644
index 487b9e5..0000000
--- a/src/packlib/zebra/fq/fzclosex.inc
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: fzclosex.inc,v 1.1.1.1 1996/03/06 10:47:10 mclareni Exp $
-*
-* $Log: fzclosex.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:10 mclareni
-* Zebra
-*
-*
-*
-* fzclosex.inc
-*
-#if (defined(CERNLIB_QMIBM))&&(defined(CERNLIB_IOPACK))
- IF (IACMOF.EQ.0) GO TO 48
- CALL IOCLOS (LUNF,ISW)
- GO TO 49
-#endif
-*
-* fzclosex.inc
-*
-#if defined(CERNLIB_QMND3)
- IF (IACMOF.NE.0) GO TO 99
-#endif
diff --git a/src/packlib/zebra/fq/fzcopy.F b/src/packlib/zebra/fq/fzcopy.F
deleted file mode 100644
index e2a1edb..0000000
--- a/src/packlib/zebra/fq/fzcopy.F
+++ /dev/null
@@ -1,388 +0,0 @@
-*
-* $Id: fzcopy.F,v 1.3 1999/06/18 13:28:35 couet Exp $
-*
-* $Log: fzcopy.F,v $
-* Revision 1.3 1999/06/18 13:28:35 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.2 1996/04/18 16:10:18 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:10 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE FZCOPY (LUNIN,LUNOUT,IEVP,CHOPT,NIOP,NUHP,IUHEAD)
-
-C- Control routine to copy d/s without expansion, user called
-
-#include "zebra/zstate.inc"
-#include "zebra/zunit.inc"
-#include "zebra/mqsys.inc"
-#include "zebra/eqlqf.inc"
-#include "zebra/mzcwk.inc"
-#include "zebra/mzct.inc"
-#include "zebra/fzci.inc"
-#include "zebra/fzcx.inc"
-#include "zebra/fzcseg.inc"
-*
- DIMENSION LUNIN(9),LUNOUT(9),IEVP(9)
- DIMENSION NIOP(9),NUHP(9),IUHEAD(99)
- DIMENSION NEWOPT(3)
- CHARACTER CHOPT*(*)
- EQUIVALENCE (LRTYP,IDI(2))
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HFZCO, 4HPY /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HFZCOPY /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'FZCOPY ')
-#endif
-
-#include "zebra/q_jbyt.inc"
-
-#include "zebra/qtrace.inc"
-
- LUNNI = LUNIN(1)
- LUNNX = LUNOUT(1)
- IEVFLX = IEVP(1)
- IOCHX(1)= NIOP(1)
- NWUHOR = MAX (NUHP(1),0)
- NWUHX = MIN (NWUHOR,400)
- NWFILX = 0
- NWMEMT = 0
- IFSENT = 0
- ICOPYX = 7
- CALL UOPTC (CHOPT,'ITP',NEWOPT)
-
-C---- Set current output unit
-
- IF (LUNNX.NE.LUNX) CALL FZLOC (LUNNX,2)
-#if defined(CERNLIB_QDEBPRI)
- IF (LOGLVX.GE.2) THEN
- IF (LOGLVX.GE.3) WRITE (IQLOG,9110)
- WRITE (IQLOG,9111) LUNNI,LUNNX,IEVFLX,IACTVX,CHOPT
- ENDIF
- 9110 FORMAT (1X)
- 9111 FORMAT (' FZCOPY- LUNin/out=',2I3,' IEVFL,IACTV,OPT=',2I3,1X,A)
-
-#endif
-#if defined(CERNLIB_QPRINT)
- IF (NWUHOR.GT.NWUHX) THEN
- IF (LOGLVX.GE.-2) WRITE (IQLOG,9112) LUNX,NWUHOR
- ENDIF
- 9112 FORMAT (1X/' FZOUT. LUN=',I4,' Of ',I4,' user header words',
- F' only 400 are taken !!!')
-#endif
-#if defined(CERNLIB_FZCHANNEL)
- IF (IACMOX.EQ.3) THEN
- IF (IADOPX.EQ.0) GO TO 907
- ENDIF
-
-#endif
-#if defined(CERNLIB_FZMEMORY)
- IF (IFIFOX.EQ.3) THEN
- IADOPX = IQ(KQSP+LQFX+8)
- IF (IADOPX.EQ.0) GO TO 907
- IQ(KQSP+LQFX+1) = IADOPX
- ENDIF
-
-#endif
- IF (IACTVX.GE.16) GO TO 901
-
-C---- Set current input unit
-
- IF (LUNNI.NE.LUNI) CALL FZLOC (LUNNI,1)
-
-C-- Check compatibility
-
- IF (IDAFOX.NE.IDAFOI) GO TO 941
- IF (IFIFOX.EQ.4) GO TO 944
- IF (IFIFOI.EQ.4) GO TO 944
- IF (IFIFOI.EQ.0) THEN
- IF (MAXREI.GE.NQWKTB) GO TO 942
- ENDIF
-
-C-- Get the parameters of the pending d/s
-
- LFIIOC = LQFI + JAUIOC
- LFISEG = LQFI + JAUSEG
-
- NWRDAI = IQ(KQSP+LQFI+20)
- NRECAI = IQ(KQSP+LQFI+21)
- LRTYP = IQ(KQSP+LQFI+27)
- NWTABI = IQ(KQSP+LQFI+41)
- NWBKI = IQ(KQSP+LQFI+42)
- NWSEGI = IQ(KQSP+LFISEG)
- LENTRI = IQ(KQSP+LQFI+43)
- IF (LRTYP.GE.5) GO TO 949
- IF (LRTYP.LE.1) GO TO 949
-
- JRETCD = 0
- JERROR = 0
- NWERR = 0
-#if defined(CERNLIB_FZCHANNEL)
- IF (IACMOI.EQ.3) THEN
- IF (IACMOX.EQ.3) GO TO 943
- ENDIF
-#endif
-
-C------ Transmit the pilot
-
- NWSEGX = NWSEGI
- NWTABX = NWTABI
- NWBKX = NWBKI
- LENTRX = LENTRI
-
- NWTXX = 0
- NWUHCX = 0
- NWIOX = 0
-
-C-- Ready I/O characteristic
-
- IF (NWUHX.EQ.0) GO TO 39
- IF (NEWOPT(1).EQ.0) THEN
- NWIOX = IQ(KQSP+LFIIOC)
- CALL UCOPY (IQ(KQSP+LFIIOC+1),IOCHX,NWIOX)
- GO TO 38
- ENDIF
-
- IF (IOCHX(1)) 34, 32, 33
- 32 IOCHX(1) = 3
- 33 NWIOX = 1
- IF (IOCHX(1).LT.8) GO TO 38
- 34 NWIOX = JBYT (IOCHX(1), 7,5)
- J = JBYT (IOCHX(1),12,5)
- IF (JBYT (IOCHX(1), 1,6).NE.1) GO TO 903
- IF (NWIOX.GT.16) GO TO 903
- IF (NWIOX.NE.J+1) GO TO 903
-
- IF (NWIOX.GT.1) CALL UCOPY (NIOP,IOCHX,NWIOX)
- 38 NWUHCX = NWUHX + NWIOX
- 39 CONTINUE
-
-C-- Ready text vector
-
- IF (NEWOPT(2).EQ.0) THEN
- LTEXTX = LQ(KQSP+LQFI-2)
- ELSE
- LTEXTX = LQ(KQSP+LQFX-2)
- ENDIF
- IF (LTEXTX.NE.0) CALL FZOTXT
-
-C-- Ready segment table
-
- NQSEG = NWSEGX / 3
- IF (NQSEG.NE.0) THEN
- N = 2*NQSEG
- CALL UCOPY (IQ(KQSP+LFISEG+1), IQSEGH,N)
- CALL UCOPY (IQ(KQSP+LFISEG+1+N), IQSEGD,NQSEG)
- ENDIF
- IQSGLU = LUNI
-
-C-- Ready early table
-
-C- ISTTAB : transmission status of table words
-C- -1 not yet read, 0 read into LQ(LQTA), +1 written
-
- LQTA = LQWKTB
- LQTE = LQTA + 2*NWTABI
-
- ISTTAB = 1
- IF (NWTABX.EQ.0) GO TO 121
- ISTTAB = -1
-#if defined(CERNLIB_FZFFNAT)
- IF (NWTABX.GE.41) GO TO 121
-
- IF (IFIFOI.EQ.0) THEN
- LFIEAR = LQFI + JAUEAR
- NTBE = IQ(KQSP+LFIEAR)
- IF (NTBE.NE.0) THEN
- CALL UCOPY (IQ(KQSP+LFIEAR+1),LQ(LQTA),NWTABI)
- ISTTAB = 0
- GO TO 121
- ENDIF
- ENDIF
-
- IF (IFIFOX.NE.0) GO TO 121
- IF (IFIFOI.EQ.0) THEN
- CALL FZIFFN (2)
- ELSE
- CALL FZIFFX (2)
- ENDIF
- IF (JRETCD.NE.0) GO TO 971
- LQTA = LQTA + NWTABI
- ISTTAB = 0
-#endif
-
-C------ Output the pilot record
-
- 121 IDX(2) = 3
- IF (IEVFLX.NE.0) IDX(2)=2
- NWMEMT = 20 + NWUHCX + NWSEGX + NWTXX + NWTABX + NWBKX
-
-#if defined(CERNLIB_QDEBPRI)
- IF (LOGLVX.GE.2) WRITE (IQLOG,9121) LENTRX,NWTABX,NWBKX
- 9121 FORMAT (10X,' LENTRY=',I9,' NWTAB,NWBANK=',I5,I7)
-
-#endif
-#if defined(CERNLIB_FZFFNAT)
- IF (IFIFOX.EQ.0) THEN
- CALL FZOFFN (IUHEAD)
- IF (IQUEST(7).EQ.1) ISTTAB = 1
- GO TO 124
- ENDIF
-#endif
-#if defined(CERNLIB_FZMEMORY)
- IF (IFIFOX.EQ.3) THEN
- IF (NWMEMT.GT.IQ(KQSP+LQFX+9)) GO TO 909
- ENDIF
-#endif
- CALL FZOFFX (IUHEAD)
- 124 IQ(KQSP+LQFX+15) = IQ(KQSP+LQFX+15) + 1
- IFSENT = 7
-
- IACTVX = 12
- IF (NWBKX.EQ.0) GO TO 190
-
-C------ Copy table and bank material
-
- IQ(KQSP+LQFI+16) = IQ(KQSP+LQFI+16) + 1
- IQ(KQSP+LQFX+16) = IQ(KQSP+LQFX+16) + 1
-
- IQUEST(7) = ISTTAB
- IDX(2) = 0
-#if defined(CERNLIB_FZFFNAT)
- IF (IFIFOI.EQ.0) THEN
- CALL FZCFFN
- GO TO 189
- ENDIF
-#endif
- CALL FZCFFX
- 189 IF (JRETCD.NE.0) GO TO 971
- GO TO 191
-
-C---- Test for pseudo end-of-tape
-
- 190 IQ(KQSP+LQFX+17) = IQ(KQSP+LQFX+17) + 1
- LRTYP = 0
- 191 NUM1 = IQ(KQSP+LQFX+19)
- NUM2 = IQ(KQSP+LQFX+20)
- 192 IF (NUM2.GE.1000000) THEN
- NUM1 = NUM1 + 1
- NUM2 = NUM2 - 1000000
- IQ(KQSP+LQFX+19) = NUM1
- IQ(KQSP+LQFX+20) = NUM2
- GO TO 192
- ENDIF
-
- LIM1 = IQ(KQSP+LQFX+37)
- LIM2 = IQ(KQSP+LQFX+38)
-
- IF (LIM1+LIM2.EQ.0) GO TO 991
- IF (NUM1-LIM1) 991, 196, 197
- 196 IF (NUM2.LT.LIM2) GO TO 991
-
- 197 IQUEST(1) = 1
- GO TO 992
-
-C-------------------------------------------------
-C- ERROR HANDLING
-C-------------------------------------------------
-
- 901 IF (IACTVX.EQ.17) CALL ZFATAM ('FZCOPY - Going beyond EoD.')
- IACTVX = 17
- GO TO 929
-
- 903 IQUEST(11) = IOCHX(1)
- CALL ZFATAM ('FZCOPY - IOCH invalid.')
-
-#if defined(CERNLIB_FZCHANNEL)||defined(CERNLIB_FZMEMORY)
- 907 IQUEST(11) = LUNX
- CALL ZFATAM ('FZCOPY - User routine / buffer not connected.')
-
-#endif
-#if defined(CERNLIB_FZMEMORY)
- 909 IQUEST(2) = 14
- IQUEST(8) = IQ(KQSP+LQFX+9)
- IQUEST(9) = NWMEMT
- IQUEST(11) = LUNX
- IF (NEWOPT(3).EQ.0) CALL ZTELL (14,1)
-#endif
- 929 IQUEST(1) = 2
- GO TO 998
-
-C- JERROR = 409 input not positioned
- 949 JERROR = 4
-
-C- JERROR = 404 Alfa mode not allowed
- 944 JERROR = JERROR + 1
-
-C- JERROR = 403 input/output both channel mode
- 943 JERROR = JERROR + 1
-
-C- JERROR = 402 native input record length too long
- 942 JERROR = JERROR + 1
-
-C- JERROR = 401 input/output different data format
- 941 JERROR = 401 + JERROR
- IF (NEWOPT(3).EQ.0) NEWOPT(3)=-1
- JRETCD = 4
-
-C------- Input errors
-
-C-- write emergency stop signal
-
- 971 IF (IFSENT.EQ.0) GO TO 974
- IDX(2) = 9
-#if defined(CERNLIB_FZFFNAT)
- IF (IFIFOX.EQ.0) THEN
- CALL FZON1 (9,1)
- GO TO 972
- ENDIF
-#endif
- CALL FZOREC
- 972 IACTVX = 12
-
- 974 CALL FZIDIA
- IQ(KQSP+LQFI+26) = IQUEST(1)
- IF (NEWOPT(3).LT.0) CALL ZFATAL
- GO TO 997
-
-C-------------------------------------------------
-C- COMMON EXIT
-C-------------------------------------------------
-
- 991 IQUEST(1) = 0
- 992 IQUEST(2) = 0
- IQUEST(5) = IQ(KQSP+LQFX+31)
- IQUEST(6) = IQ(KQSP+LQFX+32)
-#if defined(CERNLIB_FZMEMORY)
- IF (IFIFOX.EQ.3)
- +IQUEST(9) = IQ(KQSP+LQFX+1) - IQ(KQSP+LQFX+8)
-#endif
- IQUEST(10) = NWMEMT
- IQUEST(11) = NWBKX
- IQUEST(12) = NWTABX
- IQUEST(13) = IQ(KQSP+LQFX+15)
- IQUEST(14) = IQ(KQSP+LQFX+19)
- IQUEST(15) = IQ(KQSP+LQFX+20)
- IQUEST(16) = IQ(KQSP+LQFX+21)
- IQUEST(17) = IQ(KQSP+LQFX+22)
-
-C-- update the input control bank
- IQ(KQSP+LQFI+26) = 0
- 997 IQ(KQSP+LQFI+2) = IACTVI
- IQ(KQSP+LQFI+20) = NWRDAI
- IQ(KQSP+LQFI+21) = NRECAI
- IQ(KQSP+LQFI+27) = LRTYP
- 998 IQ(KQSP+LQFX+2) = IACTVX
-#include "zebra/qtrace99.inc"
- RETURN
- END
diff --git a/src/packlib/zebra/fq/fzcvdlnx.inc b/src/packlib/zebra/fq/fzcvdlnx.inc
deleted file mode 100644
index d33ec1a..0000000
--- a/src/packlib/zebra/fq/fzcvdlnx.inc
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: fzcvdlnx.inc,v 1.2 1998/09/25 09:32:54 mclareni Exp $
-*
-* $Log: fzcvdlnx.inc,v $
-* Revision 1.2 1998/09/25 09:32:54 mclareni
-* Modifications for the Mklinux port flagged by CERNLIB_PPC
-*
-* Revision 1.1.1.1 1996/03/06 10:47:10 mclareni
-* Zebra
-*
-*
-* swop halves of double precision numbers
-*
-* fzcvdlnx.inc
-*
-#if (defined(CERNLIB_QMLNX) && !defined(CERNLIB_PPC))
-C-- LNX : exchange left and right half of each d/p number
- DO 449 JL=1,NDPN
- MT(JMT+1) = MS(JMS+2)
- MT(JMT+2) = MS(JMS+1)
- JMT = JMT + 2
- 449 JMS = JMS + 2
-#endif
diff --git a/src/packlib/zebra/fq/fzcvdpc.inc b/src/packlib/zebra/fq/fzcvdpc.inc
deleted file mode 100644
index db903d8..0000000
--- a/src/packlib/zebra/fq/fzcvdpc.inc
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: fzcvdpc.inc,v 1.2 1997/03/14 17:19:49 mclareni Exp $
-*
-* $Log: fzcvdpc.inc,v $
-* Revision 1.2 1997/03/14 17:19:49 mclareni
-* WNT mods
-*
-* Revision 1.1.1.1.2.1 1997/01/21 11:33:39 mclareni
-* All mods for Winnt 96a on winnt branch
-*
-* Revision 1.1.1.1 1996/03/06 10:47:10 mclareni
-* Zebra
-*
-*
-* swop halves of double precision numbers
-*
-* fzcvdpc.inc
-*
-#if defined(CERNLIB_QMDOS) || defined(CERNLIB_WINNT)
-C-- PC : exchange left and right half of each d/p number
- DO 449 JL=1,NDPN
- MT(JMT+1) = MS(JMS+2)
- MT(JMT+2) = MS(JMS+1)
- JMT = JMT + 2
- 449 JMS = JMS + 2
-#endif
diff --git a/src/packlib/zebra/fq/fzcvdtmo.inc b/src/packlib/zebra/fq/fzcvdtmo.inc
deleted file mode 100644
index f538c3e..0000000
--- a/src/packlib/zebra/fq/fzcvdtmo.inc
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: fzcvdtmo.inc,v 1.1.1.1 1996/03/06 10:47:11 mclareni Exp $
-*
-* $Log: fzcvdtmo.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:11 mclareni
-* Zebra
-*
-*
-* swop halves of double precision numbers
-*
-* fzcvdtmo.inc
-*
-#if defined(CERNLIB_QMTMO)
-C-- TMO : exchange left and right half of each d/p number
- DO 449 JL=1,NDPN
- MT(JMT+1) = MS(JMS+2)
- MT(JMT+2) = MS(JMS+1)
- JMT = JMT + 2
- 449 JMS = JMS + 2
-#endif
diff --git a/src/packlib/zebra/fq/fzcvdvmi.inc b/src/packlib/zebra/fq/fzcvdvmi.inc
deleted file mode 100644
index 9bb35d4..0000000
--- a/src/packlib/zebra/fq/fzcvdvmi.inc
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: fzcvdvmi.inc,v 1.1.1.1 1996/03/06 10:47:11 mclareni Exp $
-*
-* $Log: fzcvdvmi.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:11 mclareni
-* Zebra
-*
-*
-* swop halves of double precision numbers
-*
-* fzcvdvmi.inc
-*
-#if defined(CERNLIB_QMVMI)
-C-- VMI : exchange left and right half of each d/p number
- DO 449 JL=1,NDPN
- MT(JMT+1) = MS(JMS+2)
- MT(JMT+2) = MS(JMS+1)
- JMT = JMT + 2
- 449 JMS = JMS + 2
-#endif
diff --git a/src/packlib/zebra/fq/fzcvhibm.inc b/src/packlib/zebra/fq/fzcvhibm.inc
deleted file mode 100644
index 7c3b65f..0000000
--- a/src/packlib/zebra/fq/fzcvhibm.inc
+++ /dev/null
@@ -1,48 +0,0 @@
-*
-* $Id: fzcvhibm.inc,v 1.1.1.1 1996/03/06 10:47:10 mclareni Exp $
-*
-* $Log: fzcvhibm.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:10 mclareni
-* Zebra
-*
-*
-* convert EBCDIC <-> ASCII
-*
-* fzcvhibm.inc
-*
-#if defined(CERNLIB_QMIBM)
-C-- IBM conversion EBCDIC <--> ASCII
- NTHR = NWDO
- 522 NTH = MIN (NTHR,24)
- NCH = 4*NTH
- CALL UPKCH (MS(JMS+1),IQUEST,NCH,IPKVEC)
- DO 529 JCH=1,NCH
- J = MIN (MAX(IQUEST(JCH)-JCHMIN,0), JCHMAX)
- 529 IQUEST(JCH) = MTAB(J+1)
- CALL PKCHAR (IQUEST,MT(JMT+1),NCH,IPKVEC)
- JMT = JMT + NTH
- JMS = JMS + NTH
- NTHR = NTHR - NTH
- IF (NTHR.NE.0) GO TO 522
- GO TO 801
-#endif
-* convert EBCDIC <-> ASCII
-*
-* fzcvhibm.inc
-*
-#if defined(CERNLIB_QMIBMD)
-C-- IBM conversion EBCDIC <--> ASCII
- NTHR = NWDO
- 522 NTH = MIN (NTHR,24)
- NCH = 4*NTH
- CALL UPKCH (MS(JMS+1),IQUEST,NCH,IPKVEC)
- DO 529 JCH=1,NCH
- J = MIN (MAX(IQUEST(JCH)-JCHMIN,0), JCHMAX)
- 529 IQUEST(JCH) = MTAB(J+1)
- CALL PKCHAR (IQUEST,MT(JMT+1),NCH,IPKVEC)
- JMT = JMT + NTH
- JMS = JMS + NTH
- NTHR = NTHR - NTH
- IF (NTHR.NE.0) GO TO 522
- GO TO 801
-#endif
diff --git a/src/packlib/zebra/fq/fzcvhlnx.inc b/src/packlib/zebra/fq/fzcvhlnx.inc
deleted file mode 100644
index daf109d..0000000
--- a/src/packlib/zebra/fq/fzcvhlnx.inc
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: fzcvhlnx.inc,v 1.2 1998/09/25 09:32:56 mclareni Exp $
-*
-* $Log: fzcvhlnx.inc,v $
-* Revision 1.2 1998/09/25 09:32:56 mclareni
-* Modifications for the Mklinux port flagged by CERNLIB_PPC
-*
-* Revision 1.1.1.1 1996/03/06 10:47:11 mclareni
-* Zebra
-*
-*
-* invert ASCII characters
-*
-* fzcvhlnx.inc
-*
-#if (defined(CERNLIB_QMLNX) && !defined(CERNLIB_PPC))
-C-- VAX : invert ASCII characters
- CALL VXINVC (MS(JMS+1),MT(JMT+1),NWDO)
- JMT = JMT + NWDO
- JMS = JMS + NWDO
- GO TO 801
-#endif
diff --git a/src/packlib/zebra/fq/fzcvhpc.inc b/src/packlib/zebra/fq/fzcvhpc.inc
deleted file mode 100644
index 4690b4e..0000000
--- a/src/packlib/zebra/fq/fzcvhpc.inc
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: fzcvhpc.inc,v 1.2 1997/03/14 17:19:50 mclareni Exp $
-*
-* $Log: fzcvhpc.inc,v $
-* Revision 1.2 1997/03/14 17:19:50 mclareni
-* WNT mods
-*
-* Revision 1.1.1.1.2.1 1997/01/21 11:33:40 mclareni
-* All mods for Winnt 96a on winnt branch
-*
-* Revision 1.1.1.1 1996/03/06 10:47:10 mclareni
-* Zebra
-*
-*
-* invert ASCII characters
-*
-* fzcvhpc.inc
-*
-#if defined(CERNLIB_QMDOS) || defined(CERNLIB_WINNT)
-C-- PC : invert ASCII characters
- CALL VXINVC (MS(JMS+1),MT(JMT+1),NWDO)
- JMT = JMT + NWDO
- JMS = JMS + NWDO
- GO TO 801
-#endif
diff --git a/src/packlib/zebra/fq/fzcvhtmo.inc b/src/packlib/zebra/fq/fzcvhtmo.inc
deleted file mode 100644
index 34a0810..0000000
--- a/src/packlib/zebra/fq/fzcvhtmo.inc
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: fzcvhtmo.inc,v 1.1.1.1 1996/03/06 10:47:11 mclareni Exp $
-*
-* $Log: fzcvhtmo.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:11 mclareni
-* Zebra
-*
-*
-* invert ASCII characters
-*
-* fzcvhtmo.inc
-*
-#if defined(CERNLIB_QMTMO)
-C-- TMO : invert ASCII characters
- CALL VXINVC (MS(JMS+1),MT(JMT+1),NWDO)
- JMT = JMT + NWDO
- JMS = JMS + NWDO
- GO TO 801
-#endif
diff --git a/src/packlib/zebra/fq/fzcvhvax.inc b/src/packlib/zebra/fq/fzcvhvax.inc
deleted file mode 100644
index cde6c9d..0000000
--- a/src/packlib/zebra/fq/fzcvhvax.inc
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: fzcvhvax.inc,v 1.1.1.1 1996/03/06 10:47:11 mclareni Exp $
-*
-* $Log: fzcvhvax.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:11 mclareni
-* Zebra
-*
-*
-* invert ASCII characters
-*
-* fzcvhvax.inc
-*
-#if defined(CERNLIB_QMVAX)
-C-- VAX : invert ASCII characters
- CALL VXINVC (MS(JMS+1),MT(JMT+1),NWDO)
- JMT = JMT + NWDO
- JMS = JMS + NWDO
- GO TO 801
-#endif
diff --git a/src/packlib/zebra/fq/fzcvhvmi.inc b/src/packlib/zebra/fq/fzcvhvmi.inc
deleted file mode 100644
index 4db5ebf..0000000
--- a/src/packlib/zebra/fq/fzcvhvmi.inc
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: fzcvhvmi.inc,v 1.1.1.1 1996/03/06 10:47:11 mclareni Exp $
-*
-* $Log: fzcvhvmi.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:11 mclareni
-* Zebra
-*
-*
-* invert ASCII characters
-*
-* fzcvhvmi.inc
-*
-#if defined(CERNLIB_QMVMI)
-C-- VAX : invert ASCII characters
- CALL VXINVC (MS(JMS+1),MT(JMT+1),NWDO)
- JMT = JMT + NWDO
- JMS = JMS + NWDO
- GO TO 801
-#endif
diff --git a/src/packlib/zebra/fq/fzdaeof.inc b/src/packlib/zebra/fq/fzdaeof.inc
deleted file mode 100644
index 7d55f37..0000000
--- a/src/packlib/zebra/fq/fzdaeof.inc
+++ /dev/null
@@ -1,53 +0,0 @@
-*
-* $Id: fzdaeof.inc,v 1.2 2006/09/15 09:35:31 mclareni Exp $
-*
-* $Log: fzdaeof.inc,v $
-* Revision 1.2 2006/09/15 09:35:31 mclareni
-* Submitted mods for gcc4/gfortran and MacOSX, corrected to work also on slc4 with gcc3.4 and 4.1
-*
-* Revision 1.1.1.1 1996/03/06 10:47:08 mclareni
-* Zebra
-*
-*
-* EoF on direct-access file
-*
-* fzdaeof.inc
-*
-#if defined(CERNLIB_QMAPO)
- PARAMETER (IOSEOF = 84148232)
-#elif defined(CERNLIB_QMCRY)
- PARAMETER (IOSEOF = 5)
-#elif (defined(CERNLIB_QMCV64))&&(!defined(CERNLIB_QIEEE))
- PARAMETER (IOSEOF = 134)
-#elif (defined(CERNLIB_QMCV32))&&(!defined(CERNLIB_QIEEE))
- PARAMETER (IOSEOF = 134)
-#elif (defined(CERNLIB_QMCV32))&&(defined(CERNLIB_QIEEE))
- PARAMETER (IOSEOF = 134)
-#elif defined(CERNLIB_QMHPX)
- PARAMETER (IOSEOF = 922)
-#elif defined(CERNLIB_QMIRT)
-*** PARAMETER (IOSEOF = 10) !* for xlf 2.2
-*** PARAMETER (IOSEOF = 122) !* for xlf 2.3
- PARAMETER (IOSEOF = 1) !* for xlf 3.2
-#elif defined(CERNLIB_QMIRTD)
-*** PARAMETER (IOSEOF = 10) !* for xlf 2.2
-*** PARAMETER (IOSEOF = 122) !* for xlf 2.3
- PARAMETER (IOSEOF = 1) !* for xlf 3.2
-#elif defined(CERNLIB_QMLNX) && !defined(CERNLIB_GFORTRAN)
- PARAMETER (IOSEOF = 36)
-#elif defined(CERNLIB_QMOS9)
- PARAMETER (IOSEOF = 326)
-#elif defined(CERNLIB_QMSGI)
- PARAMETER (IOSEOF = 27)
-#elif defined(CERNLIB_QMVAX)
- PARAMETER (IOSEOF = 36)
-#elif defined(CERNLIB_QMVMI)
- PARAMETER (IOSEOF = 36)
-#elif defined(CERNLIB_WINDOWS)
-* only valid for dec fortran (e.g. not f2c + microsoft c)
- PARAMETER (IOSEOF = 36)
-#elif defined(CERNLIB_GFORTRAN)
- PARAMETER (IOSEOF = 3)
-#elif 1
- PARAMETER (IOSEOF = -1)
-#endif
diff --git a/src/packlib/zebra/fq/fzdaeofx.inc b/src/packlib/zebra/fq/fzdaeofx.inc
deleted file mode 100644
index a6e5bf4..0000000
--- a/src/packlib/zebra/fq/fzdaeofx.inc
+++ /dev/null
@@ -1,29 +0,0 @@
-*
-* $Id: fzdaeofx.inc,v 1.1.1.1 1996/03/06 10:47:11 mclareni Exp $
-*
-* $Log: fzdaeofx.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:11 mclareni
-* Zebra
-*
-*
-* Extra EOF test
-*
-* fzdaeofx.inc
-*
-#if defined(CERNLIB_QMIRT)
- IF (ISW.EQ.122) GO TO 841
-#endif
-* Extra EOF test
-*
-* fzdaeofx.inc
-*
-#if defined(CERNLIB_QMIRTD)
- IF (ISW.EQ.122) GO TO 841
-* needs packing machine words <-> file words
-#ifndef CERNLIB_FQNEEDPK
-#endif
-* needs convert machine words <-> file words
-#ifndef CERNLIB_FQNEEDCV
-#endif
-* -------------- sequences for output ---------------------
-#endif
diff --git a/src/packlib/zebra/fq/fzendi.F b/src/packlib/zebra/fq/fzendi.F
deleted file mode 100644
index 1040394..0000000
--- a/src/packlib/zebra/fq/fzendi.F
+++ /dev/null
@@ -1,234 +0,0 @@
-*
-* $Id: fzendi.F,v 1.2 1999/06/18 13:28:36 couet Exp $
-*
-* $Log: fzendi.F,v $
-* Revision 1.2 1999/06/18 13:28:36 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:11 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE FZENDI (LUNPAR,CHOPT)
-
-C- TERMINATION OF ZEBRA INPUT FILE
-
-#include "zebra/zunit.inc"
-#include "zebra/mqsys.inc"
-#include "zebra/eqlqf.inc"
-#include "zebra/fzstat.inc"
-#include "zebra/fzcf.inc"
-#include "zebra/fzci.inc"
-*
- DIMENSION LUNPAR(9)
- CHARACTER CHOPT*(*)
- DIMENSION IOPNUM(4)
- EQUIVALENCE (IOPTT,IOPTVF(1)), (IOPTR,IOPTVF(6))
- +, (IOPTN,IOPTVF(2)), (IOPTU,IOPTVF(7))
- +, (IOPTC,IOPTVF(3)), (IOPTX,IOPTVF(8))
- +, (IOPTI,IOPTVF(4)), (IOPTK,IOPTVF(9))
- +, (IOPTO,IOPTVF(5)), (IOPTQ,IOPTVF(10))
- +, (IOPNUM(1),IOPTVF(11))
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HFZEN, 4HDI /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HFZENDI /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'FZENDI ')
-#endif
-
-#include "zebra/q_jbit.inc"
-
-#include "zebra/qtrace.inc"
-
- LUNORG = LUNPAR(1)
- LUN = LUNORG
- CALL UOPTC (CHOPT,'TNCIORUXKQ0123',IOPTVF)
- INFLUN = 0
-
- NEOF = -1
- IF (IOPNUM(4).NE.0) NEOF=3
- IF (IOPNUM(3).NE.0) NEOF=2
- IF (IOPNUM(2).NE.0) NEOF=1
- IF (IOPNUM(1).NE.0) NEOF=0
- IOPTK = 1
-
-C-- Terminate option selected
-
- IF (IOPTT.NE.0) THEN
- IOPTN = 0
- IOPTC = 0
- IOPTI = 0
- IOPTO = 0
- IOPTK = 0
-
-C-- New option selected
-
- ELSEIF (IOPTN.NE.0) THEN
- IOPTC = 0
- IOPTI = 0
- IOPTO = 0
- ELSE
- IOPTR = 0
- IOPTU = 0
- IOPTX = 0
- ENDIF
-
-C-- Continue option selected
-
- IF (IOPTC.NE.0) THEN
- IOPTI = 0
- IOPTO = 0
- ENDIF
-
-C-- Input option selected
-
- IF (IOPTI.NE.0) THEN
- IOPTO = 0
- IOPTR = 1
- ENDIF
-
-C---- LOOP OVER ALL INPUT FILES IF LUNPAR=0
-
- IF (LUN.NE.0) GO TO 24
- LQFF = LQFS
- GO TO 22
-
- 21 LQFF = LQ(KQSP+LQFF)
- 22 IF (LQFF.EQ.0) GO TO 999
- LUN = IQ(KQSP+LQFF-5)
-
- LUNI = 0
- IQUEST(1) = -7
- CALL FZLOC (LUN,-1)
- IF (LUNI.EQ.LUN) GO TO 31
- GO TO 21
-
-C-- FZENDI called for one particular input file
-
- 24 LUNI = 0
- IQUEST(1) = 0
- CALL FZLOC (LUN,-1)
- IF (LUNI.EQ.LUN) GO TO 31
-#if defined(CERNLIB_QPRINT)
- IF (IOPTQ.EQ.0) THEN
- WRITE (IQLOG,9024) LUN
- IF (LUNF.EQ.LUN) WRITE (IQLOG,9025) IACTVF
- ENDIF
- 9024 FORMAT (1X/' FZENDI. LUN=',I3,' is not a valid input file')
- 9025 FORMAT (10X,'last activity=',I2)
-#endif
- GO TO 999
-
-C-------------------------------------------------
-C- Do input file
-C-------------------------------------------------
-
- 31 IF (IOPTQ.NE.0) LOGLVF=-2
-#if defined(CERNLIB_QPRINT)
- IF (LOGLVF.GE.0)
- +WRITE (IQLOG,9031) LUN,IACTVF,CHOPT
- 9031 FORMAT (1X/' FZENDI. For input file at LUN=',I3,
- F', Last activity=',I2,', OPT= ',A)
-#endif
- IF (IACTVF.GE.8) GO TO 61
-
-C---- Print file usage
-
-#if defined(CERNLIB_QPRINT)
- IF (LOGLVF.LT.0) GO TO 39
- IF (IQ(KQSP+LQFF+28).EQ.IQ(KQSP+LQFF+15)) GO TO 39
- N = 21
- IF (IFIFOF.NE.0) N=24
- WRITE (IQLOG,9036) (IQ(KQSP+LQFF+J),J=11,N)
- 9036 FORMAT (10X,'Number of objects read : '
- F/10X,I9,' System EOF'
- F/10X,I9,' Zebra EOF'
- F/10X,I9,' End-of-Run'
- F/10X,I9,' Start-of-Run'
- F/10X,I9,' Pilot records'
- F/10X,I9,' Non-empty d/s selected'
- F/10X,I9,' Empty d/s selected'
- F/10X,I9,' Read or Data errors'
- F/7X,I12,' Mega-words +'
- F/7X,I12,' words'
- F/10X,I9,' Good logical records',:/
- F 10X,I9,' Good physical records'
- F/10X,I9,' Steering blocks'
- F/10X,I9,' Words with conversion problems')
-
- IQ(KQSP+LQFF+28) = IQ(KQSP+LQFF+15)
-#endif
- 39 INFLUN = LUN
- INFSTA = IQ(KQSP+LQFF)
- CALL UCOPY (IQ(KQSP+LQFF+1), INFOFZ, 40)
-
-C---- New file to be connected by the user
-
- IF (IOPTN.EQ.0) GO TO 44
- IQ(KQSP+LQFF+2) = 8
- CALL VZERO (IQ(KQSP+LQFF+30),7)
- IF (IOPTR.NE.0) GO TO 57
- GO TO 71
-
-C-- Continue to read next file on same
-
- 44 IF (IOPTC.EQ.0) GO TO 51
- IF (IACTVF.NE.5) GO TO 48
- IF (IACMOF.NE.1) GO TO 79
- IF (JBIT(MSTATF,13).EQ.0) GO TO 79
-
-#include "fzendicx.inc"
-* Ignoring t=pass
- GO TO 79
-
- 48 CONTINUE
-#if defined(CERNLIB_QPRINT)
- IF (LOGLVF.GE.-2) WRITE (IQLOG,9048) LUNF
- 9048 FORMAT (' FZENDI. LUN=',I3,' not positioned on system EoF;',
- F' C-option is redundant.')
-#endif
- GO TO 79
-
-C---- REWIND
-
- 51 IF (IOPTR.EQ.0) GO TO 61
-
- IQ(KQSP+LQFF+2) = 8
- CALL VZERO (IQ(KQSP+LQFF+11),23)
-
- 57 CALL FZMACH (0)
-
-C---- Switch to output
-
- 61 IF (IOPTO.EQ.0) GO TO 71
- IQ(KQSP+LQFF+2) = 10
- IF (NEOF.GE.0) THEN
- CALL SBYT (NEOF, IQ(KQSP+LQFF), 13,2)
-#if defined(CERNLIB_QPRINT)
- IF (LOGLVF.GE.0) WRITE (IQLOG,9062) LUN,NEOF
- 9062 FORMAT (10X,'LUN=',I4,' Set NEOF =',I2)
-#endif
- ENDIF
-
-C---- Close the file, Drop the control bank
-
- 71 IF (IOPTX.NE.0) THEN
- CALL FZMACH (2)
- IQ(KQSP+LQFF+1) = IADOPF
- ENDIF
-
- IF (IOPTK.EQ.0) CALL MZDROP (0,LQFF,'.')
-
- 79 LUNI = 0
- IF (LUNORG.EQ.0) GO TO 21
-
-#include "zebra/qtrace99.inc"
- RETURN
- END
diff --git a/src/packlib/zebra/fq/fzendicx.inc b/src/packlib/zebra/fq/fzendicx.inc
deleted file mode 100644
index 943dec1..0000000
--- a/src/packlib/zebra/fq/fzendicx.inc
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: fzendicx.inc,v 1.1.1.1 1996/03/06 10:47:10 mclareni Exp $
-*
-* $Log: fzendicx.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:10 mclareni
-* Zebra
-*
-*
-*
-* fzendicx.inc
-*
-#if (defined(CERNLIB_QMIBM))&&(defined(CERNLIB_IOPACK))
-#if !defined(CERNLIB_QIBM_VM)
- CALL IODD (LUNF,ISW)
-#endif
-#endif
-#if (defined(CERNLIB_QMIBM))&&(defined(CERNLIB_IOPACK))
- CALL IOMOVE (LUNF,-1,ISW)
-* -------------- sequences for FZMACH ---------------------
-#endif
diff --git a/src/packlib/zebra/fq/fzendo.F b/src/packlib/zebra/fq/fzendo.F
deleted file mode 100644
index 784423e..0000000
--- a/src/packlib/zebra/fq/fzendo.F
+++ /dev/null
@@ -1,248 +0,0 @@
-*
-* $Id: fzendo.F,v 1.3 1999/06/18 13:28:36 couet Exp $
-*
-* $Log: fzendo.F,v $
-* Revision 1.3 1999/06/18 13:28:36 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.2 1996/04/18 16:10:20 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:11 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE FZENDO (LUNPAR,CHOPT)
-
-C- TERMINATION OF ZEBRA OUTPUT FILE
-
-#include "zebra/zunit.inc"
-#include "zebra/mqsys.inc"
-#include "zebra/eqlqf.inc"
-#include "zebra/fzstat.inc"
-#include "zebra/fzcf.inc"
-#include "zebra/fzcx.inc"
-*
- DIMENSION LUNPAR(9)
- CHARACTER CHOPT*(*)
- DIMENSION IOPNUM(4)
- EQUIVALENCE (IOPTT,IOPTVF(1)), (IOPTR,IOPTVF(6))
- +, (IOPTN,IOPTVF(2)), (IOPTU,IOPTVF(7))
- +, (IOPTC,IOPTVF(3)), (IOPTX,IOPTVF(8))
- +, (IOPTI,IOPTVF(4)), (IOPTK,IOPTVF(9))
- +, (IOPTO,IOPTVF(5)), (IOPTQ,IOPTVF(10))
- +, (IOPNUM(1),IOPTVF(11))
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HFZEN, 4HDO /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HFZENDO /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'FZENDO ')
-#endif
-
-
-#include "zebra/qtrace.inc"
-
- LUNORG = LUNPAR(1)
- LUN = LUNORG
- CALL UOPTC (CHOPT,'TNCIORUXKQ0123',IOPTVF)
- INFLUN = 0
-
- NEOF = -1
- IF (IOPNUM(4).NE.0) NEOF=3
- IF (IOPNUM(3).NE.0) NEOF=2
- IF (IOPNUM(2).NE.0) NEOF=1
- IF (IOPNUM(1).NE.0) NEOF=0
-
- LEVOUT = 0
- IOPTK = 1
-
-C-- Terminate option selected
-
- IF (IOPTT.NE.0) THEN
- LEVOUT = 16
- IOPTN = 0
- IOPTC = 0
- IOPTI = 0
- IOPTO = 0
- IOPTK = 0
-
-C-- New option selected
-
- ELSEIF (IOPTN.NE.0) THEN
- LEVOUT = 16
- IOPTC = 0
- IOPTI = 0
- IOPTO = 0
- ELSE
- IOPTR = 0
- IOPTU = 0
- IOPTX = 0
- ENDIF
-
-C-- Continue option selected
-
- IF (IOPTC.NE.0) THEN
- LEVOUT = 15
- IOPTI = 0
- IOPTO = 0
- ENDIF
-
-C-- Input option selected
-
- IF (IOPTI.NE.0) THEN
- LEVOUT = 16
- IOPTR = 1
- IF (IOPTO.NE.0) IOPTO=-1
- ENDIF
-
-C-- Output option selected
-
- IF (IOPTO.GT.0) THEN
- LEVOUT = 16
- IOPTR = 1
- ENDIF
-
-C---- LOOP OVER ALL OUTPUT FILES IF LUNPAR=0
-
- IF (LUN.NE.0) GO TO 24
- LQFF = LQFS
- GO TO 22
-
- 21 LQFF = LQ(KQSP+LQFF)
- 22 IF (LQFF.EQ.0) GO TO 999
- LUN = IQ(KQSP+LQFF-5)
-
- LUNX = 0
- IQUEST(1) = -7
- CALL FZLOC (LUN,-2)
- IF (LUNX.EQ.LUN) GO TO 31
- GO TO 21
-
-C-- FZENDO called for one particular output file
-
- 24 LUNX = 0
- IQUEST(1) = 0
- CALL FZLOC (LUN,-2)
- IF (LUNX.EQ.LUN) GO TO 31
-#if defined(CERNLIB_QPRINT)
- IF (IOPTQ.EQ.0) THEN
- WRITE (IQLOG,9024) LUN
- IF (LUNF.EQ.LUN) WRITE (IQLOG,9025) IACTVF
- ENDIF
- 9024 FORMAT (1X/' FZENDO. LUN=',I3,' is not a valid output file')
- 9025 FORMAT (10X,'last activity=',I2)
-#endif
- GO TO 999
-
-C-------------------------------------------------
-C- Do output file
-C-------------------------------------------------
-
- 31 IF (IOPTQ.NE.0) LOGLVX=-2
- LOGLVF = LOGLVX
-
-C- LEVOUT = 13 flush buffer
-C- 14 write E-o-Run
-C- 15 write E-o-File
-C- 16 write E-o-Data
-
-#if defined(CERNLIB_QPRINT)
- IF (LOGLVX.GE.0)
- +WRITE (IQLOG,9031) LUN,IACTVF,CHOPT
- 9031 FORMAT (1X/' FZENDO. For output file at LUN=',I3,
- F', Last activity=',I2,', OPT= ',A)
-#endif
-
- IF (IACTVF.LT.11) GO TO 71
- IF (IACTVF.EQ.18) GO TO 71
- IF (MEDIUX.LT.6) THEN
- IF (LEVOUT.GT.IACTVF)
- + CALL FZOUT (LUN,-7,0,LEVOUT,'FZEND',0,0,0)
- ENDIF
-
-C---- Print file usage
-
-#if defined(CERNLIB_QPRINT)
- IF (LOGLVX.LT.0) GO TO 39
- IF (IQ(KQSP+LQFF+28).EQ.IQ(KQSP+LQFF+15)) GO TO 39
- N = 21
- IF (IFIFOF.NE.0) N=24
- WRITE (IQLOG,9036) (IQ(KQSP+LQFF+J),J=11,N)
- 9036 FORMAT (10X,'Number of objects written : '
- F/10X,I9,' System EOF'
- F/10X,I9,' Zebra EOF'
- F/10X,I9,' End-of-Run'
- F/10X,I9,' Start-of-Run'
- F/10X,I9,' Pilot records'
- F/10X,I9,' Non-empty d/s'
- F/10X,I9,' Empty d/s'
- F/10X,I9,' Number of errors'
- F/7X,I12,' Mega-words +'
- F/7X,I12,' words'
- F/10X,I9,' Logical records',:/
- F 10X,I9,' Physical records'
- F/10X,I9,' Steering blocks'
- F/10X,I9,' Words with conversion problems')
-
- IQ(KQSP+LQFF+28) = IQ(KQSP+LQFF+15)
-#endif
- 39 INFLUN = LUN
- INFSTA = IQ(KQSP+LQFF)
- CALL UCOPY (IQ(KQSP+LQFF+1), INFOFZ, 40)
-
-C---- New file to be connected by the user
-
- IF (IOPTN.EQ.0) GO TO 44
- IQ(KQSP+LQFF+2) = 10
- CALL VZERO (IQ(KQSP+LQFF+30),7)
- IF (IOPTR.NE.0) GO TO 57
- GO TO 71
-
-C---- Switch to Input
-
- 44 IF (IOPTI.EQ.0) GO TO 51
- IF (NEOF.GE.0) THEN
- CALL SBYT (NEOF, IQ(KQSP+LQFF), 13,2)
-#if defined(CERNLIB_QPRINT)
- IF (LOGLVX.GE.0) WRITE (IQLOG,9044) LUN,NEOF
- 9044 FORMAT (10X,'LUN=',I4,' Set NEOF =',I2)
-#endif
- ENDIF
-
-C---- Rewind
-
- 51 IF (IOPTR.EQ.0) GO TO 71
-
- CALL VZERO (IQ(KQSP+LQFF+11),23)
-
- IF (IOPTO.GT.0) THEN
- IQ(KQSP+LQFF+2) = 10
- ELSE
- IQ(KQSP+LQFF+2) = 18
- IF (IOPTO.EQ.0) CALL SBIT0 (IQ(KQSP+LQFF),12)
- ENDIF
-
- 57 CALL FZMACH (IOPTU)
-
-C---- Close the file, Drop the control bank
-
- 71 IF (IOPTX.NE.0) THEN
- CALL FZMACH (2)
- IQ(KQSP+LQFF+1) = IADOPF
- ENDIF
-
- IF (IOPTK.EQ.0) CALL MZDROP (0,LQFF,'.')
-
- LUNX = 0
- IF (LUNORG.EQ.0) GO TO 21
-
-#include "zebra/qtrace99.inc"
- RETURN
- END
diff --git a/src/packlib/zebra/fq/fzfiblki.inc b/src/packlib/zebra/fq/fzfiblki.inc
deleted file mode 100644
index c744067..0000000
--- a/src/packlib/zebra/fq/fzfiblki.inc
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: fzfiblki.inc,v 1.1.1.1 1996/03/06 10:47:11 mclareni Exp $
-*
-* $Log: fzfiblki.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:11 mclareni
-* Zebra
-*
-*
-*
-* fzfiblki.inc
-*
-#if defined(CERNLIB_QMPDP)
-C-- Block formats not yet programmed for this machine
- IF (IDAFO.NE.0) GO TO 93
-#endif
-*
-* fzfiblki.inc
-*
-#if defined(CERNLIB_QMUNO)
-C-- Block formats not yet programmed for this machine
- IF (IDAFO.NE.0) GO TO 93
-#endif
diff --git a/src/packlib/zebra/fq/fzficc.inc b/src/packlib/zebra/fq/fzficc.inc
deleted file mode 100644
index 996d797..0000000
--- a/src/packlib/zebra/fq/fzficc.inc
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: fzficc.inc,v 1.1.1.1 1996/03/06 10:47:08 mclareni Exp $
-*
-* $Log: fzficc.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:08 mclareni
-* Zebra
-*
-*
-* Options for FZFILE
-*
-* fzficc.inc
-*
- EQUIVALENCE (IOPTM, IOPTVF(5)), (IOPTX, IOPTVF(15))
- +, (IOPTC, IOPTVF(6)), (IOPTN, IOPTVF(16))
- +, (IOPTA, IOPTVF(7)), (IOPTS, IOPTVF(17))
- +, (IOPTD, IOPTVF(8)), (IOPTU, IOPTVF(18))
- +, (IOPTT, IOPTVF(9)), (IOPTI, IOPTVF(19))
- +, (IOPTAS,IOPTVF(10)), (IOPTO, IOPTVF(20))
- +, (IOPTK, IOPTVF(11)), (IOPTR, IOPTVF(21))
- +, (IOPTL, IOPTVF(12)), (IOPTP, IOPTVF(22))
- +, (IOPTY, IOPTVF(13)), (IOPTQ, IOPTVF(23))
- +, (IOPTF, IOPTVF(14)), (IFLERR,IOPTVF(24))
diff --git a/src/packlib/zebra/fq/fzficr.F b/src/packlib/zebra/fq/fzficr.F
deleted file mode 100644
index 7dc68f1..0000000
--- a/src/packlib/zebra/fq/fzficr.F
+++ /dev/null
@@ -1,102 +0,0 @@
-*
-* $Id: fzficr.F,v 1.2 1999/06/18 13:28:37 couet Exp $
-*
-* $Log: fzficr.F,v $
-* Revision 1.2 1999/06/18 13:28:37 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:11 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE FZFICR (MODE,CHOPT)
-
-C- Crack (MODE=0) or pack the options for FZFILE
-
-#include "zebra/fzcf.inc"
-#include "fzficc.inc"
-*
- CHARACTER CHOPT*(*)
- PARAMETER (NOPT=23, NOPCH=14)
- DIMENSION IOPCH(NOPCH)
- EQUIVALENCE (IOPCH(1),IOPTVF(5))
- CHARACTER OPTSTR*(NOPT), CHX(NOPCH-1)*10, CHWK*1
-
- DATA OPTSTR / '0123MCADT*KLYFXNSUIORPQ' /
-C- _:.=+=.:_1_:.=+=.:_2_:.
-
-C- _:.=+=.:_1_:.=
-C- MCADT*KLY
- DATA CHX / 'C- '
- +, 'A-- '
- +, 'D-+- '
- +, 'T-- - '
- +, '*----- '
- +, 'K---??+ '
- +, 'L---+++- '
- +, 'Y----++-- '
- +, 'F--iddd---'
- +, 'Xiiii++iii'
- +, 'N+++++d+++'
- +, 'Si++++++++'
- +, 'U++-------' /
-C- MCADT*KLY
-
-
-C-- Blow the option string
-
- IF (MODE.NE.0) GO TO 41
- CALL UOPTC (CHOPT,OPTSTR,IOPTVF)
- IFLERR = 0
-
-C-- Check compatibility
-
- DO 27 JP=1,9
- IF (IOPCH(JP).EQ.0) GO TO 27
-
- DO 24 JS=JP+1,NOPCH
- CHWK = CHX(JS-1)(JP+1:JP+1)
- IF (IOPCH(JS).EQ.0) THEN
- IF (CHWK.EQ.'i') IOPCH(JS) = -1
- GO TO 24
- ENDIF
-
- IF (CHWK.EQ.'-') THEN
- IOPCH(JS) = 0
- IFLERR = IFLERR + 1
- ENDIF
- 24 CONTINUE
- 27 CONTINUE
-
- IF (IOPTI+IOPTO.EQ.0) IOPTI=1
-
- NEOF = -1
- IF (IOPTVF(4) .NE.0) NEOF=3
- IF (IOPTVF(3) .NE.0) NEOF=2
- IF (IOPTVF(2) .NE.0) NEOF=1
- IF (IOPTVF(1) .NE.0) NEOF=0
- IOPTVF(1) = NEOF
-
- IF (IOPTM+IOPTC+IOPTA+IOPTD+IOPTT+IOPTAS.EQ.0) IOPTAS=-1
- RETURN
-
-C---- Construct text string of options used
-
- 41 CHOPT = ' '
- N = 0
- DO 44 J=5,NOPT
- IF (IOPTVF(J).EQ.1) THEN
- N = N + 1
- CHOPT(N:N) = OPTSTR(J:J)
- ENDIF
- 44 IOPTVF(J) = IABS(IOPTVF(J))
-
- NEOF = IOPTVF(1)
- IF (NEOF.GE.0) THEN
- N = N + 2
- CALL CSETDI (NEOF,CHOPT,N,N)
- ENDIF
- RETURN
- END
diff --git a/src/packlib/zebra/fq/fzfile.F b/src/packlib/zebra/fq/fzfile.F
deleted file mode 100644
index e5d57a9..0000000
--- a/src/packlib/zebra/fq/fzfile.F
+++ /dev/null
@@ -1,362 +0,0 @@
-*
-* $Id: fzfile.F,v 1.4 1999/06/18 13:28:38 couet Exp $
-*
-* $Log: fzfile.F,v $
-* Revision 1.4 1999/06/18 13:28:38 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.3 1999/06/18 12:04:37 couet
-* - The version is now defined in one central place
-*
-* Revision 1.2 1996/04/18 16:10:23 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:10 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE FZFILE (LUNP,LRECP,CHOPT)
-
-C- Initialize Sequential Zebra I/O unit, User called
-
-#include "zebra/zmach.inc"
-#include "zebra/zstate.inc"
-#include "zebra/zunit.inc"
-#include "zebra/mqsys.inc"
-#include "zebra/mzcwk.inc"
-#include "zebra/eqlqf.inc"
-#include "zebra/fzci.inc"
-#include "zebra/fzcx.inc"
-#include "zebra/fzcf.inc"
-#include "fzficc.inc"
-*
- CHARACTER*4 CVERSN
- DIMENSION LUNP(9),LRECP(9)
- DIMENSION MMFZ(5)
- CHARACTER CHOPT*(*)
- CHARACTER HOLD*12
- CHARACTER VIDQQ*20
-#if defined(CERNLIB_QMVDS)
- SAVE MMFZ
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HFZFI, 4HLE /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HFZFILE /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'FZFILE ')
-#endif
-#if defined(CERNLIB_QHOLL)
- DATA MMFZ / 4HFZ , 2, 1, -1, 2 /
-#endif
-#if !defined(CERNLIB_QHOLL)
- DATA MMFZ / 0, 2, 1, -1, 2 /
-#endif
-
-#include "zebra/q_or.inc"
-#include "zebra/q_shiftl.inc"
-
-#include "zebra/qtrace.inc"
-*
-#include "zebra/qversion.inc"
- WRITE(CVERSN,'(F4.2)') QVERSN
- VIDQQ = '@(#)ZEFQ '//CVERSN//'>'
-*
- LUN = LUNP(1)
- LREC = LRECP(1)
- LUNPTR= IQUEST(1)
-
- CALL FZFICR (0, CHOPT)
-
- LOGLV = NQLOGD
- IF (IOPTQ.NE.0) LOGLV = MIN (LOGLV, -2)
-#if defined(CERNLIB_QPRINT)
- IF (LOGLV.GE.0) WRITE (IQLOG,9001) LUN,CHOPT
- 9001 FORMAT (1X/' FZFILE. LUN=',I3,' initialize for OPT= ',A)
-#endif
-
- IF (NQSTOR.LT.0)
- + CALL ZFATAM ('FZFILE - no dynamic store initialized.')
-
- IF (LUN.LE.0) GO TO 92
- NEOFOP = -1
- IDAFO = 0
- IACMO = 0
- IADOP = 0
- INCBP = 0
- INCBUF = 0
- NWLIFT = 0
- NWXBUF = 0
- JOFFSI = 0
- JOFFSO = 0
-
-#if defined(CERNLIB_FQXISN)
- IUPAK = 1
-#endif
-#if !defined(CERNLIB_FQXISN)
- IUPAK = MIN (1, IOPTN+IOPTU+IOPTA)
-#endif
-
- LRECX = 30 * (LREC/30)
- IF (LRECX.LE.0) LRECX = 900
- NWRECX = LRECX
-#if !defined(CERNLIB_B32)||defined(CERNLIB_QMIRTD)
-#include "fzfilelg.inc"
-#endif
-
-C--------------------------------------------------------
-C---- Memory mode
-C--------------------------------------------------------
-
- IF (IOPTM.EQ.0) GO TO 24
-#if (defined(CERNLIB_FZMEMORY))&&(!defined(CERNLIB_FQXISN))
- IF (IOPTN.EQ.0) IDAFO = 1
-#endif
-#if defined(CERNLIB_FZMEMORY)
- MEDIUM = 6
- IFIFO = 3
- IOPTR = 0
- JOFFSI = 0
- GO TO 59
-#endif
-#if !defined(CERNLIB_FZMEMORY)
- GO TO 93
-#endif
-
-C--------------------------------------------------------
-C---- Alfa mode
-C--------------------------------------------------------
-
- 24 MEDIUM = IOPTT
- IF (IOPTA.EQ.0) GO TO 31
-#if (defined(CERNLIB_FZALFA))&&(!defined(CERNLIB_FQXISN))
- IDAFO = 1
-#endif
-#if defined(CERNLIB_FZALFA)
- IFIFO = 4
- LREC = 900
- NWREC = 0
- JOFFSI = 0
-
- IF (IOPTO.NE.0) THEN
- NWXBUF = 128
- JOFFSO = NWXBUF
- ENDIF
- GO TO 67
-#endif
-#if !defined(CERNLIB_FZALFA)
- GO TO 93
-#endif
-
-C-------------------------------------------------
-C-------- Mode not Memory, not Alfa, check L,K,C
-C-------------------------------------------------
-
- 31 IFIFO = IABS (IOPTX)
-#if !defined(CERNLIB_FQXISN)
- IF (IOPTN.EQ.0) IDAFO = IFIFO
-#endif
-
- IF (IFIFO.EQ.0) GO TO 41
-
-C-- Access channel
-
- IF (IOPTC.EQ.0) GO TO 34
-#if defined(CERNLIB_FZCHANNEL)
- MEDIUM = 4 + IOPTT
- IACMO = 3
- IOPTR = 0
- GO TO 36
-#endif
-#if !defined(CERNLIB_FZCHANNEL)
- GO TO 93
-#endif
-
-C-- Access L or K
-
- 34 IF (IOPTL+IOPTK.EQ.0) GO TO 36
-#if defined(CERNLIB_FZLIBC)
- IACMO = 2
- IADOP = LUNPTR
- MEDIUM = IOPTT + 2*IOPTK
- IF (IADOP.LT.0) GO TO 94
-#endif
-#if !defined(CERNLIB_FZLIBC)
- GO TO 93
-#endif
-
-C-------------------------------------------------
-C---- Mode Direct-access
-C-------------------------------------------------
-
- 36 IF (IOPTD.EQ.0) GO TO 51
-#if (defined(CERNLIB_FZDACC))&&(!defined(CERNLIB_FZDACCH))
- IF (IOPTC.NE.0) GO TO 93
-#endif
-#if (defined(CERNLIB_FZDACC))&&(!defined(CERNLIB_FZDACCL))
- IF (IOPTL+IOPTK.NE.0) GO TO 93
-#endif
-#if defined(CERNLIB_FZDACC)
- IFIFO = 2
- GO TO 59
-#endif
-#if !defined(CERNLIB_FZDACC)
- GO TO 93
-#endif
-
-C-------------------------------------------------
-C---- Mode Sequential
-C-------------------------------------------------
-
-C------ Native File Format
-
- 41 NEOFOP = IOPTVF(1)
-#if defined(CERNLIB_FZFFNAT)
- IUPAK = 1
- IF (LREC.LE.0) LREC=2440
-
-#include "fzfilen1.inc"
-* Ignoring t=pass
-
- IF (IOPTO.NE.0) LREC = MIN (LREC, 2499)
- LRECPR = LREC
- LREC = LREC - 2
- NWLIFT = 170
-
-#include "fzfilen2.inc"
-* Ignoring t=pass
-
- GO TO 71
-#endif
-#if !defined(CERNLIB_FZFFNAT)
- GO TO 93
-#endif
-
-C---- Sequential Exchange File Format
-
- 51 IF (IOPTC.NE.0) GO TO 59
- NEOFOP = IOPTVF(1)
- IF (IOPTL+IOPTK.NE.0) GO TO 59
-
-#include "fzfilex7.inc"
-* Ignoring t=pass
-
- 59 LREC = LRECX
- NWREC = NWRECX
-
- 67 LRECPR = LREC
- INCBP = 61
- IF (IOPTI.NE.0) INCBP = 141
- INCBUF = 7
-
-C-------------------------------------------------
-C---- Ready new unit
-C-------------------------------------------------
-
- 71 LUNI = 0
- LUNX = 0
-
-#include "fzfiblki.inc"
-
- CALL FZLOC (LUN,0)
- IF (LUNF.NE.0) GO TO 91
-
-C-- Construct text string of options used
-C-- also : IOPTVF(J) = IABS(IOPTVF(J))
-
- IOPTVF(1) = NEOFOP
- CALL FZFICR (7, HOLD)
-
-C-------------------------------------------------
-C- Lift and fill control bank
-C-------------------------------------------------
-
-#if !defined(CERNLIB_QHOLL)
- CALL UCTOH ('FZ ', MMFZ, 4,4)
-#endif
- IF (NWLIFT.EQ.0) NWLIFT = INCBP + INCBUF + LREC + NWXBUF + 4
- MMFZ(4) = NWLIFT
- CALL MZLIFT (JQPDVS,LQFF,LQFS,1,MMFZ,0)
-
- NEOF = MAX (0, NEOFOP)
-
- MSTAT = IOR (MEDIUM,ISHFTL(IFIFO, 3))
- MSTAT = IOR (MSTAT, ISHFTL(IDAFO, 6))
- MSTAT = IOR (MSTAT, ISHFTL(IACMO, 7))
- MSTAT = IOR (MSTAT, ISHFTL(IOPTI, 10))
- MSTAT = IOR (MSTAT, ISHFTL(IOPTO, 11))
- MSTAT = IOR (MSTAT, ISHFTL(NEOF, 12))
- MSTAT = IOR (MSTAT, ISHFTL(IOPTS, 14))
- MSTAT = IOR (MSTAT, ISHFTL(IUPAK, 15))
-
- IQ(KQS+LQFF-5) = LUN
- IQ(KQS+LQFF) = IOR (IQ(KQS+LQFF), MSTAT)
- IQ(KQS+LQFF+1) = IADOP
- IQ(KQS+LQFF+3) = INCBP
- IQ(KQS+LQFF+4) = LOGLV
- IQ(KQS+LQFF+5) = LREC
-
- IF (IFIFO.NE.0) THEN
- LBPAR = LQFF + INCBP
- IQ(KQS+LBPAR) = LREC
- IQ(KQS+LBPAR+1) = NWREC
- IQ(KQS+LBPAR+2) = INCBUF
- IQ(KQS+LBPAR+3) = JOFFSI
- IQ(KQS+LBPAR+4) = JOFFSO
- ENDIF
-
-C-- Print options used
-
-#if defined(CERNLIB_QPRINT)
- NHOLD = LNBLNK (HOLD)
- IF (IFLERR.EQ.0) THEN
- IF (LOGLV.LT.-1) GO TO 88
- WRITE (IQLOG,9086) LRECPR,HOLD(1:NHOLD)
- ELSE
- WRITE (IQLOG,9087) LRECPR,HOLD(1:NHOLD)
- ENDIF
-
- 9086 FORMAT (' FZFILE. Use LREC=',I5,', options= ',A)
- 9087 FORMAT (' FZFILE. !!! Incompatible options, use LREC=',I5,
- F ', options= ',A)
-#endif
-
-C---- REWIND
-
- 88 CALL FZLOC (LUN,0)
- IF (IOPTR.NE.0) CALL FZMACH (0)
- IQUEST(1) = 0
- GO TO 999
-
-C-------------------------------------------------
-C- Error handling
-C-------------------------------------------------
-
- 91 IQUEST(1) = 1
- IF (IOPTP.NE.0) GO TO 999
- CALL ZFATAM ('FZFILE - File already open.')
-
- 92 IQUEST(1) = 2
- IF (IOPTP.NE.0) GO TO 999
- CALL ZFATAM ('FZFILE - LUN invalid.')
-
- 93 IQUEST(1) = 3
- IF (IOPTP.NE.0) GO TO 999
- CALL ZFATAM ('FZFILE - Requested format not available.')
- CALL ZFATAM (VIDQQ)
-
-#if defined(CERNLIB_FZLIBC)
- 94 IQUEST(1) = 4
- IF (IOPTP.NE.0) GO TO 999
- CALL ZFATAM ('FZFILE - L mode and IQUEST(1) < 0 on call.')
-#endif
-
-#include "zebra/qtrace99.inc"
- RETURN
- END
diff --git a/src/packlib/zebra/fq/fzfilelg.inc b/src/packlib/zebra/fq/fzfilelg.inc
deleted file mode 100644
index 46bc1c8..0000000
--- a/src/packlib/zebra/fq/fzfilelg.inc
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: fzfilelg.inc,v 1.1.1.1 1996/03/06 10:47:11 mclareni Exp $
-*
-* $Log: fzfilelg.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:11 mclareni
-* Zebra
-*
-*
-*
-* fzfilelg.inc
-*
-#if defined(CERNLIB_QMIRTD)
- IF (IUPAK.EQ.0) THEN
- NWRECX = (32*NWRECX) / 64
- JOFFSI = LRECX+2 - NWRECX
- ENDIF
-#else
- IF (IUPAK.EQ.0) THEN
- NWRECX = (32*NWRECX) / IQBITW
- JOFFSI = LRECX+2 - NWRECX
- ENDIF
-#endif
diff --git a/src/packlib/zebra/fq/fzfilen1.inc b/src/packlib/zebra/fq/fzfilen1.inc
deleted file mode 100644
index d09ffd5..0000000
--- a/src/packlib/zebra/fq/fzfilen1.inc
+++ /dev/null
@@ -1,35 +0,0 @@
-*
-* $Id: fzfilen1.inc,v 1.1.1.1 1996/03/06 10:47:11 mclareni Exp $
-*
-* $Log: fzfilen1.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:11 mclareni
-* Zebra
-*
-*
-*
-* fzfilen1.inc
-*
-#if defined(CERNLIB_QMLNX)
- IF (IOPTT.NE.0) LREC=MIN(LREC,2499)
-C- maximum logical record size for tape files on the VAX (ANSI)
-* -------------- sequences for output ---------------------
-#endif
-* -------------- conversions for output -------------------
-*
-* fzfilen1.inc
-*
-#if defined(CERNLIB_QMVAX)
- IF (IOPTT.NE.0) LREC=MIN(LREC,2499)
-C- maximum logical record size for tape files on the VAX (ANSI)
-* -------------- sequences for output ---------------------
-#endif
-* -------------- conversions for output -------------------
-*
-* fzfilen1.inc
-*
-#if defined(CERNLIB_QMVMI)
- IF (IOPTT.NE.0) LREC=MIN(LREC,2499)
-C- maximum logical record size for tape files on the VAX (ANSI)
-* -------------- sequences for output ---------------------
-#endif
-* -------------- conversions for output -------------------
diff --git a/src/packlib/zebra/fq/fzfilen2.inc b/src/packlib/zebra/fq/fzfilen2.inc
deleted file mode 100644
index 2cb1239..0000000
--- a/src/packlib/zebra/fq/fzfilen2.inc
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: fzfilen2.inc,v 1.1.1.1 1996/03/06 10:47:08 mclareni Exp $
-*
-* $Log: fzfilen2.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:08 mclareni
-* Zebra
-*
-*
-*
-* fzfilen2.inc
-*
-#if defined(CERNLIB_QMCDC)
- IF (NEOFOP.LT.0) NEOFOP = IOPTT + 2
-#endif
-*
-* fzfilen2.inc
-*
-#if defined(CERNLIB_QMND3)
- IF (IOPTT.EQ.1) NEOF=2
-#endif
diff --git a/src/packlib/zebra/fq/fzfilex7.inc b/src/packlib/zebra/fq/fzfilex7.inc
deleted file mode 100644
index eb1b4a4..0000000
--- a/src/packlib/zebra/fq/fzfilex7.inc
+++ /dev/null
@@ -1,33 +0,0 @@
-*
-* $Id: fzfilex7.inc,v 1.1.1.1 1996/03/06 10:47:08 mclareni Exp $
-*
-* $Log: fzfilex7.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:08 mclareni
-* Zebra
-*
-*
-*
-* fzfilex7.inc
-*
-#if defined(CERNLIB_QMCDC)
- IF (NEOFOP.LT.0) NEOFOP = IOPTT + 2
-* -------------- sequences for output ---------------------
-#endif
-*
-* fzfilex7.inc
-*
-#if (defined(CERNLIB_QMIBM))&&(defined(CERNLIB_IOPACK))
- IACMO = IOPTY
-* -------------- sequences for output ---------------------
-#endif
-*
-* fzfilex7.inc
-*
-#if defined(CERNLIB_QMND3)
- IF (IOPTT.NE.0) THEN
- IF (IOPTF.EQ.0) IOPTY = 1
- NEOF = 2
- ENDIF
- IACMO = IOPTY
-* -------------- sequences for output ---------------------
-#endif
diff --git a/src/packlib/zebra/fq/fzhci.inc b/src/packlib/zebra/fq/fzhci.inc
deleted file mode 100644
index 6dc1510..0000000
--- a/src/packlib/zebra/fq/fzhci.inc
+++ /dev/null
@@ -1,13 +0,0 @@
-*
-* $Id: fzhci.inc,v 1.1.1.1 1996/03/06 10:47:08 mclareni Exp $
-*
-* $Log: fzhci.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:08 mclareni
-* Zebra
-*
-*
-* Physical record header
-*
-* fzhci.inc
-*
- COMMON /FZHCI/ MPHRI(5),JRECI,NTLRI,NFSTI,JMODI,NWRI
diff --git a/src/packlib/zebra/fq/fzhook.F b/src/packlib/zebra/fq/fzhook.F
deleted file mode 100644
index aaccf70..0000000
--- a/src/packlib/zebra/fq/fzhook.F
+++ /dev/null
@@ -1,77 +0,0 @@
-*
-* $Id: fzhook.F,v 1.2 1999/06/18 13:28:40 couet Exp $
-*
-* $Log: fzhook.F,v $
-* Revision 1.2 1999/06/18 13:28:40 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:11 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
-#if defined(CERNLIB_FZCHANNEL)
- SUBROUTINE FZHOOK (LUNP,TARGET,BUF)
-
-C- Connect user routine TARGET for Channel mode, User called
-
-#include "zebra/zunit.inc"
-#include "zebra/mqsys.inc"
-#include "zebra/eqlqf.inc"
-#include "zebra/fzci.inc"
-#include "zebra/fzcx.inc"
-#include "zebra/fzcf.inc"
-*
- DIMENSION LUNP(9), BUF(9)
- EXTERNAL TARGET
-
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HFZHO, 4HOK /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HFZHOOK /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'FZHOOK ')
-#endif
-
-* quick trace without test on capacity
-#include "zebra/qtraceq.inc"
-
- LUN = LUNP(1)
-
- CALL FZLOC (LUN,0)
- IF (LUNF.EQ.0) LOGLVF=1
- IF (IACMOF.NE.3) LOGLVF=1
-
-#if defined(CERNLIB_QPRINT)
- IF (LOGLVF.GE.1) WRITE (IQLOG,9024) LUN
- 9024 FORMAT (1X/' FZHOOK. Connect user routine for LUN=',I3)
-
-#endif
- IF (LUNF.EQ.0) GO TO 91
- IF (IACMOF.NE.3) GO TO 92
-
- IQUEST(2) = JUMPAD (TARGET)
- IQ(KQSP+LQFF+1) = IQUEST(2)
- IF (LUNF.EQ.LUNI) IADOPI = IQUEST(2)
- IF (LUNF.EQ.LUNX) IADOPX = IQUEST(2)
- GO TO 999
-
-C-------------------------------------------------
-C- Error handling
-C-------------------------------------------------
-
- 91 IQUEST(1) = 1
- CALL ZFATAM ('FZHOOK - Stream not existing.')
-
- 92 IQUEST(1) = 2
- CALL ZFATAM ('FZHOOK - Stream not ready for Channel mode.')
-
-#include "zebra/qtrace99.inc"
- RETURN
- END
-#endif
diff --git a/src/packlib/zebra/fq/fziacn.F b/src/packlib/zebra/fq/fziacn.F
deleted file mode 100644
index 900cb53..0000000
--- a/src/packlib/zebra/fq/fziacn.F
+++ /dev/null
@@ -1,71 +0,0 @@
-*
-* $Id: fziacn.F,v 1.2 1999/06/18 13:28:42 couet Exp $
-*
-* $Log: fziacn.F,v $
-* Revision 1.2 1999/06/18 13:28:42 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:11 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE FZIACN (NWBAT,LDATA,NWACC)
-
-C- Access one batch of data from the input buffer,
-C- exchange file format, native data format
-C- service routine to FZCOPY
-C- careful : must not be called with N4SKII=0 .AND. NWBAT=0
-
-#include "zebra/zunit.inc"
-#include "zebra/zebq.inc"
-#include "zebra/mzca.inc"
-#include "zebra/fzci.inc"
-*
- DIMENSION NWBAT(9)
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HFZIA, 4HCN /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HFZIACN /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'FZIACN ')
-#endif
-
-
-* quick trace without test on capacity
-#include "zebra/qtraceq.inc"
-
- NWDO = NWBAT(1)
- NDONE = 0
-
- 24 NWAV = L4ENDI - L4CURI
- IF (NWAV.EQ.0) GO TO 41
- IF (N4SKII.NE.0) GO TO 31
-
- NDONE = MIN (NWDO, NWAV)
- LDATA = L4CURI
- L4CURI = L4CURI + NDONE
-#include "zebra/qtrace99.inc"
- NWACC = NDONE
- RETURN
-
-C-- Skip over N4SKII leading data words
-
- 31 NSK = MIN (N4SKII,NWAV)
- L4CURI = L4CURI + NSK
- N4SKII = N4SKII - NSK
- IF (N4SKII.EQ.0) GO TO 46
-
-C---- Read next PhR / LR for batch continued
-
- 41 IFLAGI = -1
- CALL FZIREC
- IF (IFLAGI.NE.0) GO TO 999
- 46 IF (NWDO+N4SKII.NE.0) GO TO 24
- GO TO 999
- END
diff --git a/src/packlib/zebra/fq/fzialn.F b/src/packlib/zebra/fq/fzialn.F
deleted file mode 100644
index b3f636b..0000000
--- a/src/packlib/zebra/fq/fzialn.F
+++ /dev/null
@@ -1,160 +0,0 @@
-*
-* $Id: fzialn.F,v 1.2 1999/06/18 13:28:43 couet Exp $
-*
-* $Log: fzialn.F,v $
-* Revision 1.2 1999/06/18 13:28:43 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:11 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
-#if defined(CERNLIB_FZALFA)
- SUBROUTINE FZIALN
-
-C- Read 80 characters to the card buffer;
-C- service routine to FZIASC.
-
-#include "zebra/zbcd.inc"
-#include "zebra/zkrakcc.inc"
-#include "zebra/zstate.inc"
-#include "zebra/zunit.inc"
-#include "zebra/mqsysh.inc"
-#include "zebra/fzci.inc"
-*
- CHARACTER LINER*80
- EQUIVALENCE (LINER,CQHOLK)
-
- EQUIVALENCE (LUN,IQUEST(90)), (JSKIP,IQUEST(91))
- EQUIVALENCE (MRSTA,IQUEST(92)), (MREND,IQUEST(93))
- EQUIVALENCE (JTKC,IQUEST(96)), (JTKL,IQUEST(97))
- +, (JTKE,IQUEST(98))
-
-
-C-- Save trailing card buffer not yet analysed
-
- JTKE = JTKE - 1
- NSV = JTKE - JTKC
- IWDSV = IQKRAK(JTKE)
-
- IF (NSV.GT.0) THEN
-#if defined(CERNLIB_FQABLANK)
- NSH = 160 - JTKE
- CALL UCOPY2 (IQKRAK(JTKC),IQKRAK(JTKC+NSH),NSV)
- JTKC = JTKC + NSH
- JTKE = 160
-#endif
- DO 18 J=JTKC,JTKE-1
- 18 IQKRAK(J-79) = IQKRAK(J)
- ENDIF
-
-C-- Read next line
-
- 21 CONTINUE
- 8000 FORMAT (A)
-#if defined(CERNLIB_QERREND)
- READ (LUN,8000,END=81,ERR=82) LINER
-#endif
-#if !defined(CERNLIB_QERREND)
- READ (LUN,8000,IOSTAT=JSTAT) LINER
- IF (JSTAT.NE.0) GO TO 81
-#endif
-#if defined(CERNLIB_QDEVZE)
- IF (LOGLVI.GE.3) WRITE (IQLOG,9821) LINER
- 9821 FORMAT (' FZIALN- Read line=',A)
-#endif
-
- CALL IZCHAV (80)
-
- JSTA = 2
- NOFF = 6
-
-C-- Check special conditions
-
- IF (IQCETK(1).NE.45) GO TO 41
- IF (JSKIP.NE.0) GO TO 51
-
-C-- Ready start/end pointers
-
- 26 IF (NSV.GE.0) THEN
- JTKC = 81 - NSV
- IQCETK(1) = IWDSV
- ELSE
- JTKC = 80 + JSTA
- ENDIF
- JTKE = 161
-
-C-- Purge blanks from line, if FQABLANK
-
-#if defined(CERNLIB_FQABLANK)
- JTKE = 80 + JSTA
- DO 34 J=JSTA,80
- IF (IQCETK(J).EQ.45) GO TO 34
- IQKRAK(JTKE) = IQCETK(J)
- JTKE = JTKE + 1
- 34 CONTINUE
-#endif
- JTKL = JTKE - NOFF
- RETURN
-
-C---- Control-line read
-
-C-- End of physical record
-
- 41 IF (IQCETK(2).EQ.59) GO TO 45
- IF (IQCETK(1).NE.60) GO TO 91
- IF (JSKIP.NE.0) GO TO 21
- MREND = 1
- NOFF = 0
- GO TO 26
-
-C-- Start of physical record
-
- 45 NSV = -1
- MRSTA = 1
- IF (IQCETK(3).NE.27) MRSTA=2
-
- JSTA = 4
- IF (IQCETK(1).EQ.59) GO TO 26
- IF (IQCETK(1).NE.60) GO TO 91
- MREND = 1
- NOFF = 0
- GO TO 26
-
-C---- Fast skip of trailing record
-
- 51 CONTINUE
-#if defined(CERNLIB_QERREND)
- READ (LUN,8000,END=81,ERR=82) LINER(1:1)
-#endif
-#if !defined(CERNLIB_QERREND)
- READ (LUN,8000,IOSTAT=JSTAT) LINER(1:1)
- IF (JSTAT.NE.0) GO TO 81
-#endif
-#if defined(CERNLIB_QDEVZE)
- IF (LOGLVI.GE.4) WRITE (IQLOG,9852)
- 9852 FORMAT (' FZIALN- Skip line')
-#endif
-
- IF (LINER(1:1).EQ.' ') GO TO 51
- GO TO 21
-
-C------ End-of-File, Read Error
-
-#if defined(CERNLIB_QERREND)
- 81 IQUEST(1) = -2
- 82 IQUEST(1) = IQUEST(1) + 1
-#endif
-#if !defined(CERNLIB_QERREND)
- 81 IQUEST(1) = JSTAT
-#endif
- RETURN
-
-C---- Context error
-
- 91 IQUEST(1) = 7799
- RETURN
- END
-#endif
diff --git a/src/packlib/zebra/fq/fziasc.F b/src/packlib/zebra/fq/fziasc.F
deleted file mode 100644
index 357fbb4..0000000
--- a/src/packlib/zebra/fq/fziasc.F
+++ /dev/null
@@ -1,357 +0,0 @@
-*
-* $Id: fziasc.F,v 1.3 1999/06/18 13:28:45 couet Exp $
-*
-* $Log: fziasc.F,v $
-* Revision 1.3 1999/06/18 13:28:45 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.2 1996/04/18 16:10:24 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:12 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
-#if defined(CERNLIB_FZALFA)
- SUBROUTINE FZIASC (NRSKPP)
-
-C- Read one physical record from cards in ALFA mode,
-C- service routine to FZIN, called via FZIPHA
-
-C- Do not expand fast blocks if NRSKIP not zero
-
-C- The record is stored into words LQ(LBUFA) to LQ(LBUFE-1)
-C- It is a 'fast' record if JFAST .NE. 0
-
-#include "zebra/zbcd.inc"
-#include "zebra/zkrakc.inc"
-#include "zebra/zstate.inc"
-#include "zebra/zunit.inc"
-#include "zebra/mqsysh.inc"
-#include "zebra/fzci.inc"
-*
- DIMENSION NRSKPP(9)
- DIMENSION INITV(6), NBV(6), ICHSUM(2,2)
-
- EQUIVALENCE (LUN,IQUEST(90)), (JSKIP,IQUEST(91))
- EQUIVALENCE (MRSTA,IQUEST(92)), (MREND,IQUEST(93))
- EQUIVALENCE (JTKC,IQUEST(96)), (JTKL,IQUEST(97))
- +, (JTKE,IQUEST(98))
-
-#if defined(CERNLIB_QMVDS)
- SAVE INITV
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HFZIA, 4HSC /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HFZIASC /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'FZIASC ')
-#endif
- DATA INITV / 0, 1, 2, 3, 0, 134217727 /
-C- = 7FFFFFF Hex
-
-#include "zebra/q_or.inc"
-#include "zebra/q_shiftl.inc"
-#include "zebra/q_jbyt.inc"
-
-#include "zebra/qtraceq.inc"
-
- LUN = LUNI
- LBUFA = L4STAI
- LBUFE = L4STAI + MAXREI
- NRSKIP = NRSKPP(1)
-
- LBUFC = LBUFA
- IFLREP = 0
- JCHSUM = 0
-
- ICHSUM(1,1) = 0
- ICHSUM(2,1) = 0
-
-C---- Read first line of next physical record
-
- IQUEST(1) = 0
- JTKC = 81
- JTKE = JTKC
- MRSTA = 0
- MREND = 0
- JSKIP = 7
-
- CALL FZIALN
- IF (IQUEST(1).NE.0) GO TO 101
- IF (MRSTA.GT.1) THEN
- JFAST = 0
- LBUFC = LBUFC+4
- ELSE
- JFAST = 7
- IF (NRSKIP.NE.0) GO TO 999
- IF (NFASTI.EQ.0) GO TO 999
- ENDIF
-
- MRSTA = 0
- JSKIP = 0
- ITYPE = 0
-
-C------- Do next word
-
- 31 IF (JTKC.GE.JTKL) THEN
- IF (MREND.NE.0) GO TO 911
- CALL FZIALN
- IF (IQUEST(1).NE.0) GO TO 101
- ENDIF
-
-C-- Handle running type, check termination
-
- IF (ITYPE.LE.0) GO TO 34
- IF (IQKRAK(JTKC).LT.33) GO TO 41
- GO TO 70
-
-C-- Find type of next word
-
- 34 JTYPC = IQKRAK(JTKC)
- JTKC = JTKC + 1
-#if defined(CERNLIB_QDEVZE)
- IF (LOGLVI.GE.6) WRITE (IQLOG,9834) JTYPC,IQLETT(JTYPC)
- 9834 FORMAT (' FZIASC- Next control code/char.=',I4,1X,A1)
-#endif
- IF (JTYPC.GE.42) GO TO 71
- IF (JTYPC-26) 36, 912, 35
- 35 IWORD = JTYPC - 27
- IF (IWORD.LT.10) GO TO 61
- JTYPC = JTYPC - 11
- 36 JTYPC = JTYPC - 1
- JTYPE = JTYPC / 5
- JTYPS = JTYPC - 5*JTYPE
- JTYPE = JTYPE + 1
-
- NBUSE = 6 - JTYPS
- IF (JTYPE.GE.5) NBUSE=NBUSE-1
-
- INIT = ISHFTL (INITV(JTYPE), 5)
-
-C---- Compose next word
-
-C-- copy bytes and check validity
-
- 41 DO 42 J=1,NBUSE
- NBV(J) = IQKRAK(JTKC) - 1
- IF (NBV(J).GE.32) GO TO 913
- 42 JTKC = JTKC + 1
-
- IWORD = IOR (NBV(1),INIT)
-
- IF (JTYPE.LT.5) GO TO 51
-
-C-- Compose NBUSE 5-bit bytes for JTYPE=5,6
-
- GO TO ( 60, 44, 45, 46, 47, 48), NBUSE
-
- 44 IWORD = IOR (NBV(2), ISHFTL(IWORD,5))
- GO TO 60
-
- 45 IWORD = IOR (NBV(2), ISHFTL(IWORD,5))
- IWORD = IOR (NBV(3), ISHFTL(IWORD,5))
- GO TO 60
-
- 46 IWORD = IOR (NBV(2), ISHFTL(IWORD,5))
- IWORD = IOR (NBV(3), ISHFTL(IWORD,5))
- IWORD = IOR (NBV(4), ISHFTL(IWORD,5))
- GO TO 60
-
- 47 IWORD = IOR (NBV(2), ISHFTL(IWORD,5))
- IWORD = IOR (NBV(3), ISHFTL(IWORD,5))
- IWORD = IOR (NBV(4), ISHFTL(IWORD,5))
- IWORD = IOR (NBV(5), ISHFTL(IWORD,5))
- GO TO 60
-
- 48 IWORD = IOR (NBV(2), ISHFTL(IWORD,5))
- IWORD = IOR (NBV(3), ISHFTL(IWORD,5))
- IWORD = IOR (NBV(4), ISHFTL(IWORD,5))
- IWORD = IOR (NBV(5), ISHFTL(IWORD,5))
- IWORD = IOR (NBV(6), ISHFTL(IWORD,5))
- GO TO 60
-
-C-- Compose NBUSE 5-bit bytes for JTYPE=1,2,3,4
-
- 51 GO TO ( 60, 54, 55, 56, 57, 58), NBUSE
-
- 54 IWORD = IOR (NBV(2), ISHFTL(IWORD,5))
- IWORD = ISHFTL (IWORD,20)
- GO TO 60
-
- 55 IWORD = IOR (NBV(2), ISHFTL(IWORD,5))
- IWORD = IOR (NBV(3), ISHFTL(IWORD,5))
- IWORD = ISHFTL (IWORD,15)
- GO TO 60
-
- 56 IWORD = IOR (NBV(2), ISHFTL(IWORD,5))
- IWORD = IOR (NBV(3), ISHFTL(IWORD,5))
- IWORD = IOR (NBV(4), ISHFTL(IWORD,5))
- IWORD = ISHFTL (IWORD,10)
- GO TO 60
-
- 57 IWORD = IOR (NBV(2), ISHFTL(IWORD,5))
- IWORD = IOR (NBV(3), ISHFTL(IWORD,5))
- IWORD = IOR (NBV(4), ISHFTL(IWORD,5))
- IWORD = IOR (NBV(5), ISHFTL(IWORD,5))
- IWORD = ISHFTL (IWORD,5)
- GO TO 60
-
- 58 IWORD = IOR (NBV(2), ISHFTL(IWORD,5))
- IWORD = IOR (NBV(3), ISHFTL(IWORD,5))
- IWORD = IOR (NBV(4), ISHFTL(IWORD,5))
- IWORD = IOR (NBV(5), ISHFTL(IWORD,5))
- IWORD = IOR (NBV(6), ISHFTL(IWORD,5))
-
-C-- Store composed word
-
-#if defined(CERNLIB_QDEVZE)
- 60 IF (LOGLVI.GE.6) WRITE (IQLOG,9860) IWORD,(NBV(J),J=1,NBUSE)
- 9860 FORMAT (' FZIASC- Composed word= ',Z8,6I3)
- GO TO 62
- 61 IF (LOGLVI.GE.6) WRITE (IQLOG,9861) IWORD
- 9861 FORMAT (' FZIASC- Integer word= ',I8)
- 62 CONTINUE
-#endif
-#if !defined(CERNLIB_QDEVZE)
- 60 CONTINUE
- 61 CONTINUE
-#endif
- IF (JCHSUM.NE.0) GO TO 82
-
- ICHSUM(1,1) = ICHSUM(1,1) + JBYT (IWORD,17,16)
- ICHSUM(2,1) = ICHSUM(2,1) + JBYT (IWORD, 1,16)
-
- IF (IFLREP.NE.0) GO TO 63
- IF (LBUFC.GE.LBUFE) GO TO 914
- LQ(LBUFC) = IWORD
- LBUFC = LBUFC + 1
- IF (ITYPE.GE.0) GO TO 31
- ITYPE = JTYPE
- GO TO 31
-
-C---- Repetition executed
-
- 63 N = IWORD + 1
- LBUFN = LBUFC + N
- IF (LBUFN.GT.LBUFE) GO TO 915
- IF (N.LE.0) GO TO 916
-
- DO 64 L=LBUFC,LBUFN-1
- 64 LQ(L) = IWDREP
- LBUFC = LBUFN
-
- IFLREP = 0
- GO TO 31
-
-C---- Control symbols
-
-C-- = : repetition signalled
-
- 70 JTYPC = IQKRAK(JTKC)
- JTKC = JTKC + 1
- 71 IF (JTYPC-44) 912, 72, 74
- 72 IF (JCHSUM.EQ.1) GO TO 920
- IWDREP = IWORD
- IFLREP = 7
- ITYPE = 0
- GO TO 31
-
-C-- close sq bracket : stop running type
-
- 74 IF (JTYPC-54) 912, 75, 77
- 75 ITYPE = 0
- GO TO 31
-
-C-- open sq bracket : start running type
-
- 77 IF (JTYPC-58) 912, 78, 81
- 78 IF (ITYPE.LT.0) GO TO 917
- ITYPE = -7
- GO TO 31
-
-C-- < : end of physical record
-
- 81 IF (JTYPC.NE.60) GO TO 912
- IF (LBUFC.NE.LBUFE) GO TO 918
- IF (JCHSUM.NE.0) GO TO 999
- IF (IFLREP.NE.0) GO TO 920
- ITYPE = 0
- JCHSUM = 1
- GO TO 31
-
-C-- Check-sum reading
-
- 82 IF (IFLREP.NE.0) IWORD = IWDREP
- ICHSUM(JCHSUM,2) = IWORD
-
- JCHSUM = JCHSUM + 1
- IF (JCHSUM.EQ.2) GO TO 31
-
- IF (ICHSUM(1,1).NE.ICHSUM(1,2)) GO TO 919
- IF (ICHSUM(2,1).NE.ICHSUM(2,2)) GO TO 919
-
-#include "zebra/qtrace99.inc"
- IQUEST(92) = JFAST
- RETURN
-
-C------ Errors
-
- 101 IF (IQUEST(1).LT.0) GO TO 999
- IF (IQUEST(1).EQ.7799) GO TO 910
-
-C-- Read Error
-
- JRETCD = 7
- JERROR = 309
- NWERR = 1
- IQUEST(14) = IQUEST(1)
- GO TO 999
-
-C---- Record context errors
-
-C- JERROR = 310 Invalid character in column 1
- 910 JERROR = -1
-
-C- JERROR = 311 Record shorter than expected
- 911 JERROR = JERROR - 1
-
-C- JERROR = 312 Faulty type code
- 912 JERROR = JERROR - 1
-
-C- JERROR = 313 Faulty numeric value, > 31
- 913 JERROR = JERROR - 1
-
-C- JERROR = 314 Record longer than expected
- 914 JERROR = JERROR - 1
-
-C- JERROR = 315 Repetition count overshoots record end
- 915 JERROR = JERROR - 1
-
-C- JERROR = 316 Repetition count negative
- 916 JERROR = JERROR - 1
-
-C- JERROR = 317 Double open square bracket
- 917 JERROR = JERROR - 1
-
-C- JERROR = 318 Record shorter than expected
- 918 JERROR = JERROR - 1
-
-C- JERROR = 319 Check-sum error
- 919 JERROR = JERROR - 1
-
-C- JERROR = 320 Illegal combination =< or <=
- 920 JERROR = JERROR + 320
- JRETCD = 5
- NWERR = 0
- IQUEST(1) = 7
- GO TO 999
- END
-#endif
diff --git a/src/packlib/zebra/fq/fzichh.F b/src/packlib/zebra/fq/fzichh.F
deleted file mode 100644
index 857346f..0000000
--- a/src/packlib/zebra/fq/fzichh.F
+++ /dev/null
@@ -1,135 +0,0 @@
-*
-* $Id: fzichh.F,v 1.3 1999/06/18 13:28:46 couet Exp $
-*
-* $Log: fzichh.F,v $
-* Revision 1.3 1999/06/18 13:28:46 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.2 1996/04/18 16:10:28 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:10 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE FZICHH (IOMODE,MREC,IHOW)
-
-C- Check physical block header in MREC
-
-C- in : IHOW = 1 fast block expected
-C- 0 steering block expected
-C- -1 scanning for next steering block
-C- -2 steering block expected when starting
-
-C- out : IRETN in IQUEST(1)
-C- IRETN = 0 as expected
-C- 1 trouble
-C- 3 steering block ok, but with wrong length
-C- 4 end-of-file reached (only IBM just now)
-
-
-#include "zebra/zunit.inc"
-#include "zebra/quest.inc"
-#include "zebra/fzcx.inc"
-#include "zebra/fzci.inc"
-#include "fzhci.inc"
-*
- DIMENSION MREC(8)
-#include "fzstamp.inc"
-#include "fzntolds.inc"
-#if defined(CERNLIB_QMIBM)||defined(CERNLIB_QMIBMD)
-C PARAMETER (MASK = Z FF000000)
- PARAMETER (MASK = -16777216)
-#endif
-
-#include "zebra/q_jbyt.inc"
-
-
- IRETN = 0
- CALL UCOPY (MREC,MPHRI,8)
- JMODI = JBYT(MPHRI(5),30,3)
- NWRI = JBYT(MPHRI(5),1,28)
- IF (MPHRI(1) .NE. MCCW1) GO TO 71
- IF (MPHRI(2) .NE. MCCW2) GO TO 71
- IF (MPHRI(3) .NE. MCCW3) GO TO 71
- IF (MPHRI(4) .NE. MCCW4) GO TO 71
- IF (JMODI.GE.5) GO TO 71
- IF (JMODI.EQ.3) GO TO 71
- IF (NWRI.GE.NTOLDS) GO TO 71
-
- IF (JRECI.LT.0) GO TO 71
- IF (NTLRI.LT.0) GO TO 71
- IF (NTLRI.GT.NWRI) GO TO 71
- IF (NFSTI.LT.0) GO TO 71
- IF (NFSTI.GE.16384) GO TO 71
- IF (IOMODE.NE.0) GO TO 26
- IF (NFSTI*MAXREI.GT.NTOLDS) GO TO 71
- IF (NWRI.NE.MAXREI) GO TO 61
-
- 26 IF (IHOW.GT.0) GO TO 41
- 27 IQUEST(1) = IRETN
- RETURN
-
-C---- Unexpected steering block
-
- 41 IRETN = 1
- GO TO 27
-
-C---- Steering block of unexpected length
-
- 61 IF (IHOW.LE.0) IRETN = 3
- GO TO 27
-
-C---- Not a steering block
-
- 71 IF (IHOW.GT.0) GO TO 27
-#if defined(CERNLIB_QMIBM)||defined(CERNLIB_QMIBMD)
-
-C---- IBM : detect end-of-file on direct-access file if :
-C-- 1) file-format D
-C-- 2) just after Zebra EoF
-C-- 3) record starts with FF000000, rest zero
-
- IF (IOMODE.NE.0) GO TO 74
- IF (IFIFOI.NE.2) GO TO 74
- IF (IACTVI.NE.4) GO TO 74
- IF (MPHRI(1).NE.MASK) GO TO 74
- DO 73 J=2,8
- IF (MREC(J).NE.0) GO TO 74
- 73 CONTINUE
- IRETN = 4
- GO TO 27
-
-#endif
- 74 IRETN = 1
-#if defined(CERNLIB_QPRINT)
- IF (IHOW.EQ.-1) GO TO 27
- IF (LOGLVI.LT.-1) GO TO 27
- LUN = LUNI
- IF (IOMODE.NE.0) LUN = LUNX
- IQUEST(1) = MCCW1
- IQUEST(2) = MCCW2
- IQUEST(3) = MCCW3
- IQUEST(4) = MCCW4
- CALL UCOPY (MPHRI, IQUEST(5), 8)
- IQUEST(13) = NWRI
- CALL UCOPY (JRECI, IQUEST(14),3)
- WRITE (IQLOG,9801) LUN,(IQUEST(J),J=1,16)
- 9801 FORMAT (1X/' FZIPHx. LUN=',I4,', Error 201, dump Block Header :'
-#endif
-#if (defined(CERNLIB_QPRINT))&&(!defined(CERNLIB_HEX))&&(defined(CERNLIB_B60M))
- F/4X,'Must be:',4O23
- F/4X,'Oct 1-4:',4O23/8X,'5-8:',4O23/4X,'Dec 5-8:',4I23)
-#endif
-#if (defined(CERNLIB_QPRINT))&&(!defined(CERNLIB_HEX))&&(!defined(CERNLIB_B60M))
- F/4X,'Must be:',4O17
- F/4X,'Oct 1-4:',4O17/8X,'5-8:',4O17/4X,'Dec 5-8:',4I17)
-#endif
-#if (defined(CERNLIB_QPRINT))&&(defined(CERNLIB_HEX))
- F/4X,'Must be:',4Z17
- F/4X,'Hex 1-4:',4Z17/8X,'5-8:',4Z17/4X,'Dec 5-8:',4I17)
-#endif
- GO TO 27
- END
diff --git a/src/packlib/zebra/fq/fzicv.F b/src/packlib/zebra/fq/fzicv.F
deleted file mode 100644
index e11f669..0000000
--- a/src/packlib/zebra/fq/fzicv.F
+++ /dev/null
@@ -1,238 +0,0 @@
-*
-* $Id: fzicv.F,v 1.3 1999/06/18 13:28:47 couet Exp $
-*
-* $Log: fzicv.F,v $
-* Revision 1.3 1999/06/18 13:28:47 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.2 1996/04/18 16:10:29 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:08 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
-#if !defined(CERNLIB_FQXISN)
- SUBROUTINE FZICV (MS,MT)
-
-C- Convert for input with copy
-C- from source in exchange to target in native data format
-
-#include "zebra/quest.inc"
-#include "zebra/mzioc.inc"
-*
- DIMENSION MS(99), MT(99)
-
- DOUBLE PRECISION THDB
- DIMENSION THIS(2)
- EQUIVALENCE (THDB,THIS)
- EQUIVALENCE (ITHA,THA,THIS(1)), (ITHB,THB,THIS(2))
-
-C---- Conversion Control in /MZIOC/ :
-
-C- for a given call translation source MS -> target MT is done
-C- either for a complete batch of NWFOTT words
-C- if NWFODN.EQ.0 and NWFOAV.GE.NWFOTT
-
-C- or for the first instalment of a batch of NWFOTT words
-C- if NWFODN.EQ.0 and NWFOAV.LT.NWFOTT
-
-C- or for a new instalment of N=MIN(NWFOAV,NWFOTT-NWFODN)
-C- words, if NWFODN.NE.0
-
-C- * marks words to be initialized by the caller
-C- only for the call at the beginning of a new batch
-C-
-C- NWFOAV number of words available in the buffer to receive
-C- the result
-C- set by the caller whenever a new lot of data
-C- becomes available for conversion (new buffer)
-C- counted down by FZICV
-C- * NWFOTT total number of words in the batch to be done,
-C- maybe in several instalments
-C- * NWFODN number of words in the batch already done
-C- set to zero by the caller at start of batch
-C- (in fact MZIOCR sets it to zero)
-C- NWFORE n.w. remaining to be done for the pending batch
-C- set by FZICV, zero if end of batch
-C-
-C- IFOCON remembers the last conversion problem
-C- (1) error code if -ve, conversion type if +ve
-C- (2) location of the word
-C- (3) content of the word
-
-C- MFOSAV
-C- (1+2) saves type and word-count for re-entry
-
-C- * JFOEND position of last sector plus 1
-C- * JFOREP position of repeat sector descr.
-C- JFOCUR position of current sector description
-
-C- * MFO(JFO+1) t= sector type as in format
-C- * +2) c= word count as in format
-C- c > 0 : no. of words
-C- c = 0 : dynamic sector
-C- c < 0 : indefinite sector, rest of the bank
-
-C- JMS # of words done so far for the current call
-C- JMT # of words done so far for the current batch
-
-#include "fzicvd1.inc"
-#include "fzicvd2.inc"
-
-#include "zebra/q_jbit.inc"
-#include "zebra/q_jbyt.inc"
-
-
- JMS = 0
- IF (NWFODN.NE.0) GO TO 30
-
- NWFORE = NWFOTT
- JMSEX = MIN (NWFORE,NWFOAV)
-
- JMT = 0
- JFOCUR = 0
- IFOCON(1) = 0
-
-C------ Start next sector
-
- 21 ITYPE = MFO(JFOCUR+1)
- IF (ITYPE.EQ.7) GO TO 24
- NWSEC = MFO(JFOCUR+2)
- IF (NWSEC) 22, 23, 31
-
-C-- Rest of the bank
-
- 22 NWSEC = NWFORE
- GO TO 31
-
-C-- Dynamic sector
-
- 23 IWORD = MS(JMS+1)
- NWSEC = IWORD
- GO TO 25
-
-C-- Self-describing sector
-
- 24 IWORD = MS(JMS+1)
- ITYPE = MOD (IWORD,16)
- NWSEC = IWORD/16
-
- 25 MT(JMT+1) = IWORD
- JMS = JMS + 1
- JMT = JMT + 1
- NWFORE = NWFORE - 1
-
- IF (ITYPE.GE.8) GO TO 27
- IF (NWSEC.EQ.0) GO TO 29
- IF (NWSEC.GT.0) GO TO 31
-
-C-- Faulty sector control word
-
- 27 IFOCON(1) = -1
- IFOCON(2) = JMT
- IFOCON(3) = IWORD
-
-C-- Rest of the bank is unused
-
- 29 ITYPE = 0
- NWSEC = NWFORE
- GO TO 31
-
-C-- RE-ENTRY TO CONTINUE
-
- 30 JMSEX = MIN (NWFORE,NWFOAV)
- JMT = NWFODN
- ITYPE = MFOSAV(1)
- NWSEC = MFOSAV(2)
-
-C------ CONVERSION LOOPS
-
- 31 NWDO = MIN (NWSEC,JMSEX-JMS)
- IF (NWDO.EQ.0) GO TO 801
- IF (ITYPE.LE.0) GO TO 91
- GO TO (101,201,301,401,501,101,101), ITYPE
-
-C-- Rest of the bank unused
-
- 91 CALL VZERO (MT(JMT+1),NWDO)
- JMT = JMT + NWDO
- JMS = JMS + NWDO
- GO TO 801
-
-C-- B - bit strings
-
-
-C-- I - integers
-
-#include "fzicvfi.inc"
-* Ignoring t=pass
-
-C-- F - floating
-
-#include "fzicvff.inc"
-* Ignoring t=pass
-
-C-- D - double precision
-
- 401 NDPN = NWDO / 2
- NWDODB = NDPN * 2
- IF (NWDODB.EQ.0) GO TO 451
-#include "fzicvfd.inc"
- 451 IF (NWDODB .EQ.NWDO) GO TO 801
- IF (NWDODB+1.EQ.NWSEC) GO TO 471
- IF (NWDODB+1.EQ.NWFORE) GO TO 471
- NWDO = NWDODB
- JMS = JMS + 2
- GO TO 801
-
-C-- Error : odd number of double-precision words
-
- 471 JMT = JMT + 1
- JMS = JMS + 1
- IFOCON(1) = -2
- IFOCON(2) = JMT
- IFOCON(3) = NWDO
- MT(JMT) = 0
- GO TO 801
-
-C-- H - hollerith
-
- 501 CONTINUE
-#include "fzicvfh.inc"
-* Ignoring t=pass
-
-C---- COPY AS IS
-
-#include "fzicvjf.inc"
-#include "fzicvji.inc"
- 101 CONTINUE
- CALL UCOPY (MS(JMS+1),MT(JMT+1),NWDO)
- JMT = JMT + NWDO
- JMS = JMS + NWDO
-
-C------ END OF SECTOR
-
- 801 NWFORE = NWFOTT - JMT
- IF (JMS.GE.JMSEX) GO TO 804
- JFOCUR = JFOCUR + 2
- IF (JFOCUR.LT.JFOEND) GO TO 21
- JFOCUR = JFOREP
- GO TO 21
-
-C-- Data or buffer exhausted
-
- 804 IQUEST(1) = JMS
- NWFOAV = NWFOAV - JMS
- IF (NWFORE.EQ.0) RETURN
-
-C-- Ready for re-entry
-
- NWFODN = JMT
- MFOSAV(1) = ITYPE
- MFOSAV(2) = NWSEC - NWDO
- RETURN
- END
-#endif
diff --git a/src/packlib/zebra/fq/fzicvd1.inc b/src/packlib/zebra/fq/fzicvd1.inc
deleted file mode 100644
index 31bc2d3..0000000
--- a/src/packlib/zebra/fq/fzicvd1.inc
+++ /dev/null
@@ -1,49 +0,0 @@
-*
-* $Id: fzicvd1.inc,v 1.1.1.1 1996/03/06 10:47:09 mclareni Exp $
-*
-* $Log: fzicvd1.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:09 mclareni
-* Zebra
-*
-*
-*
-* fzicvd1.inc
-*
-#if defined(CERNLIB_QMCDC)
- PARAMETER (JCHMIN = 31, JCHMAX = 92)
- DIMENSION IPKVU(5), IPKVP(5), MTAB(93)
-#endif
-*
-* fzicvd1.inc
-*
-#if defined(CERNLIB_QMCRY)
- PARAMETER (JEXMIN = -1023, JEXMAX=1023)
- PARAMETER (IOVPMS = 0 60000 40000000 00000000 B)
- PARAMETER (IOVNMS = 1 60000 40000000 00000000 B)
- PARAMETER (IBADMS = IOVPMS)
- PARAMETER (IBADMD = IBADMS, IBADME = 0)
- PARAMETER (IOVPMD = IOVPMS, IOVNMD = IOVNMS)
- PARAMETER (IBL32 = 4010020040 B)
-#endif
-*
-* fzicvd1.inc
-*
-#if (defined(CERNLIB_QMCV64))&&(!defined(CERNLIB_QIEEE))
- PARAMETER (IBL32 = '20202020'X)
- PARAMETER (MSKB32= '80000000'X)
- PARAMETER (MSKL32= 'FFFFFFFF00000000'X)
-#endif
-*
-* fzicvd1.inc
-*
-#if defined(CERNLIB_QMIBM)
- PARAMETER (JCHMIN = 31, JCHMAX = 96)
- DIMENSION IPKVEC(5), MTAB(97)
-#endif
-*
-* fzicvd1.inc
-*
-#if defined(CERNLIB_QMIBMD)
- PARAMETER (JCHMIN = 31, JCHMAX = 96)
- DIMENSION IPKVEC(5), MTAB(97)
-#endif
diff --git a/src/packlib/zebra/fq/fzicvd2.inc b/src/packlib/zebra/fq/fzicvd2.inc
deleted file mode 100644
index c3a0fce..0000000
--- a/src/packlib/zebra/fq/fzicvd2.inc
+++ /dev/null
@@ -1,78 +0,0 @@
-*
-* $Id: fzicvd2.inc,v 1.1.1.1 1996/03/06 10:47:09 mclareni Exp $
-*
-* $Log: fzicvd2.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:09 mclareni
-* Zebra
-*
-*
-*
-* fzicvd2.inc
-*
-#if defined(CERNLIB_QMCDC)
- DATA IPKVU / 8, 4, 0,28, 0 /
- DATA IPKVP / 6, 4, 0, 0, O"555555555555" /
- DATA MTAB /
- + 57, 45, 54, 52, 48, 43, 51, 55, 56, 41
- +, 42, 39, 37, 46, 38, 47, 40, 27, 28, 29
- +, 30, 31, 32, 33, 34, 35, 36, 51, 63, 58
- +, 44, 59, 57, 60, 1, 2, 3, 4, 5, 6
- +, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16
- +, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26
- +, 49, 61, 50, 62, 53, 57, 1, 2, 3, 4
- +, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14
- +, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24
- +, 25, 26, 57 /
-
-C- ? ! " # $ % & ' ( ) * + , - . / 0 1 2
-C- 3 4 5 6 7 8 9 : ; < = > ? @ A B C D E F
-C- G H I J K L M N O P Q R S T U V W X Y Z
-C- [ \ ] ^ _ ? a b c d e f g h i j k l m n
-C- o p q r s t u v w x y z ?
-#endif
-*
-* fzicvd2.inc
-*
-#if defined(CERNLIB_QMIBM)
- DATA IPKVEC / 8, 0, 0, 0, 0 /
- DATA MTAB /
- + 111, 64, 90, 127, 123, 91, 108, 80, 125, 77
- +, 93, 92, 78, 107, 96, 75, 97, 240, 241, 242
- +, 243, 244, 245, 246, 247, 248, 249, 122, 94, 76
- +, 126, 110, 111, 124, 193, 194, 195, 196, 197, 198
- +, 199, 200, 201, 209, 210, 211, 212, 213, 214, 215
- +, 216, 217, 226, 227, 228, 229, 230, 231, 232, 233
- +, 173, 224, 189, 106, 109, 121, 129, 130, 131, 132
- +, 133, 134, 135, 136, 137, 145, 146, 147, 148, 149
- +, 150, 151, 152, 153, 162, 163, 164, 165, 166, 167
- +, 168, 169, 139, 79, 155, 95, 111 /
-
-C- ? ! " # $ % & ' ( ) * + , - . / 0 1 2
-C- 3 4 5 6 7 8 9 : ; < = > ? @ A B C D E F
-C- G H I J K L M N O P Q R S T U V W X Y Z
-C- [ \ ] ^ _ ` a b c d e f g h i j k l m n
-C- o p q r s t u v w x y z { | } ~ ?
-#endif
-*
-* fzicvd2.inc
-*
-#if defined(CERNLIB_QMIBMD)
- DATA IPKVEC / 8, 0, 0, 0, 0 /
- DATA MTAB /
- + 111, 64, 90, 127, 123, 91, 108, 80, 125, 77
- +, 93, 92, 78, 107, 96, 75, 97, 240, 241, 242
- +, 243, 244, 245, 246, 247, 248, 249, 122, 94, 76
- +, 126, 110, 111, 124, 193, 194, 195, 196, 197, 198
- +, 199, 200, 201, 209, 210, 211, 212, 213, 214, 215
- +, 216, 217, 226, 227, 228, 229, 230, 231, 232, 233
- +, 173, 224, 189, 106, 109, 121, 129, 130, 131, 132
- +, 133, 134, 135, 136, 137, 145, 146, 147, 148, 149
- +, 150, 151, 152, 153, 162, 163, 164, 165, 166, 167
- +, 168, 169, 139, 79, 155, 95, 111 /
-
-C- ? ! " # $ % & ' ( ) * + , - . / 0 1 2
-C- 3 4 5 6 7 8 9 : ; < = > ? @ A B C D E F
-C- G H I J K L M N O P Q R S T U V W X Y Z
-C- [ \ ] ^ _ ` a b c d e f g h i j k l m n
-C- o p q r s t u v w x y z { | } ~ ?
-#endif
diff --git a/src/packlib/zebra/fq/fzicvfd.inc b/src/packlib/zebra/fq/fzicvfd.inc
deleted file mode 100644
index 2118a6b..0000000
--- a/src/packlib/zebra/fq/fzicvfd.inc
+++ /dev/null
@@ -1,98 +0,0 @@
-*
-* $Id: fzicvfd.inc,v 1.2 1997/03/14 17:19:50 mclareni Exp $
-*
-* $Log: fzicvfd.inc,v $
-* Revision 1.2 1997/03/14 17:19:50 mclareni
-* WNT mods
-*
-* Revision 1.1.1.1.2.1 1997/01/21 11:33:40 mclareni
-* All mods for Winnt 96a on winnt branch
-*
-* Revision 1.1.1.1 1996/03/06 10:47:10 mclareni
-* Zebra
-*
-*
-* cv IEEE -> double
-*
-* fzicvfd.inc
-*
-#if defined(CERNLIB_QMDOS) || defined(CERNLIB_WINNT)
-#include "fzcvdpc.inc"
-#elif defined(CERNLIB_QMLNX)
-#include "fzcvdlnx.inc"
-#elif defined(CERNLIB_QMTMO)
-#include "fzcvdtmo.inc"
-#elif defined(CERNLIB_QMVMI)
-#include "fzcvdvmi.inc"
-#elif defined(CERNLIB_FQIE3TDC)
-C-- Default conversion from double IEEE to internal
- CALL IE3TOD (MS(JMS+1),MT(JMT+1),NDPN,JBAD)
- IF (JBAD.NE.0) THEN
- JBAD = 2*JBAD - 1
- IFOCON(1) = 4
- IFOCON(2) = JMT + JBAD
- IFOCON(3) = MS(JMS+JBAD)
- ENDIF
- JMT = JMT + NWDODB
- JMS = JMS + NWDODB
-#elif defined(CERNLIB_FQCVDFF)
-C-- Default conversion from double IEEE to internal
- DO 449 JL=1,NWDODB,2
- ITHA = MS(JMS+1)
- IF (ITHA.EQ.0) GO TO 442
- ITHB = MS(JMS+2)
- JSIGN = JBIT (ITHA,32)
- JEXP = JBYT (ITHA,21,11)
- JMANT = JBYT (ITHA, 1,20)
- IF (JEXP.EQ.0) GO TO 431
- IF (JEXP.EQ.2047) GO TO 433
-
- JMANT = JMANT + 1 048 576
- JEXP = JEXP - 1023
- IF (JEXP.GT.JEXMAX) GO TO 432
- 424 IF (JEXP.LT.JEXMIN) GO TO 441
-
- JMANS = JBYT (ITHB,17,16)
- JMANR = JBYT (ITHB, 1,16)
-
- JPRE = ISIGN (48,JEXP)
- THDB = ( DBLE(JMANT)
- + + DBLE(FLOAT(JMANS)*2.**(-16))
- + + DBLE(FLOAT(JMANR)*2.**(-32)) ) * 2.**(JPRE-20)
- THDB = THDB * 2.**(JEXP-JPRE)
- IF (JSIGN.EQ.0) GO TO 447
- THDB = -THDB
- GO TO 447
-
- 431 IF (JMANT.EQ.0) GO TO 441
- JEXP = -1022
- GO TO 424
-
- 432 JMANT = 0
- 433 IF (JMANT.EQ.0) THEN
- IF (JSIGN.EQ.0) THEN
- ITHB = IOVPMD
- ELSE
- ITHB = IOVNMD
- ENDIF
- ELSE
- ITHB = IBADMD
- ENDIF
- IFOCON(1) = 4
- IFOCON(2) = JMT
- IFOCON(3) = ITHA
- ITHA = ITHB
- ITHB = IBADME
- GO TO 447
-
- 441 ITHA = 0
- 442 ITHB = 0
- 447 MT(JMT+1) = ITHA
- MT(JMT+2) = ITHB
- JMT = JMT + 2
- 449 JMS = JMS + 2
-#elif 1
- CALL UCOPY (MS(JMS+1),MT(JMT+1),NWDODB)
- JMT = JMT + NWDODB
- JMS = JMS + NWDODB
-#endif
diff --git a/src/packlib/zebra/fq/fzicvff.inc b/src/packlib/zebra/fq/fzicvff.inc
deleted file mode 100644
index ff4d4d7..0000000
--- a/src/packlib/zebra/fq/fzicvff.inc
+++ /dev/null
@@ -1,84 +0,0 @@
-*
-* $Id: fzicvff.inc,v 1.1.1.1 1996/03/06 10:47:12 mclareni Exp $
-*
-* $Log: fzicvff.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:12 mclareni
-* Zebra
-*
-*
-* cv IEEE -> single
-*
-* fzicvff.inc
-*
-#if defined(CERNLIB_FQIE3TSC)
-C-- Default conversion from single IEEE to internal
- 301 CALL IE3TOS (MS(JMS+1),MT(JMT+1),NWDO,JBAD)
- IF (JBAD.NE.0) GO TO 331
- 304 JMT = JMT + NWDO
- JMS = JMS + NWDO
- GO TO 801
-
- 331 IFOCON(1) = 3
- IFOCON(2) = JMT + JBAD
- IFOCON(3) = MS(JMS+JBAD)
- GO TO 304
-#endif
-* cv IEEE -> single
-*
-* fzicvff.inc
-*
-#if defined(CERNLIB_FQCVDFF)
-C-- Default conversion from single IEEE to internal
- 301 DO 349 JL=1,NWDO
- ITHA = MS(JMS+1)
- IF (ITHA.EQ.0) GO TO 347
- JSIGN = JBIT (ITHA,32)
- JEXP = JBYT (ITHA,24,8)
- JMANT = JBYT (ITHA,1,23)
- IF (JEXP.EQ.0) GO TO 331
- IF (JEXP.EQ.255) GO TO 333
- JEXP = JEXP - 127
-* test on exponent range
-#if defined(CERNLIB_FQCVDFFT)
-#include "fzicvff2.inc"
-#endif
- JPRE = ISIGN (23,JEXP)
- JMANT = JMANT + 8 388 608
- THA = FLOAT(JMANT) * 2.**(JPRE-23)
- THA = THA * 2.**(JEXP-JPRE)
- IF (JSIGN.EQ.0) GO TO 347
- THA = -THA
- GO TO 347
-
- 331 IF (JMANT.EQ.0) GO TO 341
- THA = FLOAT(JMANT) * 2.**(-63)
- THA = THA * 2.**(-86)
- IF (ITHA .EQ.0) GO TO 347
- IF (JSIGN.EQ.0) GO TO 347
- THA = -THA
- GO TO 347
-
-#if defined(CERNLIB_FQCVDFFT)
-#include "fzicvff3.inc"
-#endif
- 333 IF (JMANT.EQ.0) THEN
- IF (JSIGN.EQ.0) THEN
- ITHB = IOVPMS
- ELSE
- ITHB = IOVNMS
- ENDIF
- ELSE
- ITHB = IBADMS
- ENDIF
- IFOCON(1) = 3
- IFOCON(2) = JMT
- IFOCON(3) = ITHA
- ITHA = ITHB
- GO TO 347
-
- 341 ITHA = 0
- 347 MT(JMT+1) = ITHA
- JMT = JMT + 1
- 349 JMS = JMS + 1
- GO TO 801
-#endif
diff --git a/src/packlib/zebra/fq/fzicvff2.inc b/src/packlib/zebra/fq/fzicvff2.inc
deleted file mode 100644
index 203cc39..0000000
--- a/src/packlib/zebra/fq/fzicvff2.inc
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: fzicvff2.inc,v 1.1.1.1 1996/03/06 10:47:12 mclareni Exp $
-*
-* $Log: fzicvff2.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:12 mclareni
-* Zebra
-*
-*
-* with test on expon.
-*
-* fzicvff2.inc
-*
-#if defined(CERNLIB_FQCVDFFT)
- IF (JEXP.LT.JEXMIN) GO TO 341
- IF (JEXP.GT.JEXMAX) GO TO 332
-#endif
diff --git a/src/packlib/zebra/fq/fzicvff3.inc b/src/packlib/zebra/fq/fzicvff3.inc
deleted file mode 100644
index d14c697..0000000
--- a/src/packlib/zebra/fq/fzicvff3.inc
+++ /dev/null
@@ -1,14 +0,0 @@
-*
-* $Id: fzicvff3.inc,v 1.1.1.1 1996/03/06 10:47:12 mclareni Exp $
-*
-* $Log: fzicvff3.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:12 mclareni
-* Zebra
-*
-*
-*
-* fzicvff3.inc
-*
-#if defined(CERNLIB_FQCVDFFT)
- 332 JMANT = 0
-#endif
diff --git a/src/packlib/zebra/fq/fzicvfh.inc b/src/packlib/zebra/fq/fzicvfh.inc
deleted file mode 100644
index 97e5a6f..0000000
--- a/src/packlib/zebra/fq/fzicvfh.inc
+++ /dev/null
@@ -1,104 +0,0 @@
-*
-* $Id: fzicvfh.inc,v 1.2 1997/03/14 17:19:51 mclareni Exp $
-*
-* $Log: fzicvfh.inc,v $
-* Revision 1.2 1997/03/14 17:19:51 mclareni
-* WNT mods
-*
-* Revision 1.1.1.1.2.1 1997/01/21 11:33:41 mclareni
-* All mods for Winnt 96a on winnt branch
-*
-* Revision 1.1.1.1 1996/03/06 10:47:10 mclareni
-* Zebra
-*
-*
-* convert ASCII -> Display Code
-*
-* fzicvfh.inc
-*
-#if defined(CERNLIB_QMCDC)
- NTHR = NWDO
- 522 NTH = MIN (NTHR,24)
- NCH = 4*NTH
- CALL UPKCH (MS(JMS+1),IQUEST,NCH,IPKVU)
- DO 529 JCH=1,NCH
- J = MIN (MAX(IQUEST(JCH)-JCHMIN,0), JCHMAX)
- 529 IQUEST(JCH) = MTAB(J+1)
- CALL PKCHAR (IQUEST,MT(JMT+1),NCH,IPKVP)
- JMT = JMT + NTH
- JMS = JMS + NTH
- NTHR = NTHR - NTH
- IF (NTHR.NE.0) GO TO 522
- GO TO 801
-#endif
-* left adjust 4 ASCII ch., blank fill
-*
-* fzicvfh.inc
-*
-#if defined(CERNLIB_QMCRY)
- DO 519 JL=1,NWDO
- MT(JMT+1) = SHIFTL (MS(JMS+1), 32) .OR. IBL32
- JMT = JMT + 1
- 519 JMS = JMS + 1
- GO TO 801
-#endif
-* left adjust 4 ASCII ch., blank fill
-*
-* fzicvfh.inc
-*
-#if (defined(CERNLIB_QMCV64))&&(!defined(CERNLIB_QIEEE))
- DO 519 JL=1,NWDO
- MT(JMT+1) = ISHFT (MS(JMS+1), 32) .OR. IBL32
- JMT = JMT + 1
- 519 JMS = JMS + 1
- GO TO 801
-#endif
-* invert ASCII characters
-*
-* fzicvfh.inc
-*
-#if defined(CERNLIB_QMDOS) || defined(CERNLIB_WINNT)
-#include "fzcvhpc.inc"
-#endif
-* convert ASCII -> EBCDIC
-*
-* fzicvfh.inc
-*
-#if defined(CERNLIB_QMIBM)
-#include "fzcvhibm.inc"
-#endif
-* convert ASCII -> EBCDIC
-*
-* fzicvfh.inc
-*
-#if defined(CERNLIB_QMIBMD)
-#include "fzcvhibm.inc"
-#endif
-* invert ASCII characters
-*
-* fzicvfh.inc
-*
-#if defined(CERNLIB_QMLNX)
-#include "fzcvhlnx.inc"
-#endif
-* invert ASCII characters
-*
-* fzicvfh.inc
-*
-#if defined(CERNLIB_QMTMO)
-#include "fzcvhtmo.inc"
-#endif
-* invert ASCII characters
-*
-* fzicvfh.inc
-*
-#if defined(CERNLIB_QMVAX)
-#include "fzcvhvax.inc"
-#endif
-* invert ASCII characters
-*
-* fzicvfh.inc
-*
-#if defined(CERNLIB_QMVMI)
-#include "fzcvhvmi.inc"
-#endif
diff --git a/src/packlib/zebra/fq/fzicvfi.inc b/src/packlib/zebra/fq/fzicvfi.inc
deleted file mode 100644
index 89ca723..0000000
--- a/src/packlib/zebra/fq/fzicvfi.inc
+++ /dev/null
@@ -1,62 +0,0 @@
-*
-* $Id: fzicvfi.inc,v 1.1.1.1 1996/03/06 10:47:09 mclareni Exp $
-*
-* $Log: fzicvfi.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:09 mclareni
-* Zebra
-*
-*
-* sign-extension for integer input
-*
-* fzicvfi.inc
-*
-#if defined(CERNLIB_QMCDC)
- 201 DO 229 J=1,NWDO
- ITHA = MS(JMS+1)
- IF ((ITHA.AND.O"20000000000").NE.0) ITHA= MASK(28).OR.(ITHA-1)
- MT(JMT+1) = ITHA
- JMT = JMT + 1
- 229 JMS = JMS + 1
- GO TO 801
-#endif
-* use default CALL IE3TOS for input single prec.
-#ifndef CERNLIB_FQIE3TSC
-#endif
-* use default CALL IE3TOD for input double prec.
-#ifndef CERNLIB_FQIE3TDC
-#endif
-* sign-extension for integer input
-*
-* fzicvfi.inc
-*
-#if defined(CERNLIB_QMCRY)
- 201 DO 229 J=1,NWDO
- ITHA = MS(JMS+1)
- IF ((ITHA.AND.20000000000B).NE.0) ITHA= ITHA .OR. MASK(32)
- MT(JMT+1) = ITHA
- JMT = JMT + 1
- 229 JMS = JMS + 1
- GO TO 801
-#endif
-* use default in-line conversion for input floating
-#ifndef CERNLIB_FQCVDFF
-#endif
-* sign-extension for integer input
-*
-* fzicvfi.inc
-*
-#if (defined(CERNLIB_QMCV64))&&(!defined(CERNLIB_QIEEE))
- 201 DO 229 J=1,NWDO
- ITHA = MS(JMS+1)
- IF ((ITHA.AND.MSKB32).NE.0) ITHA= ITHA .OR. MSKL32
- MT(JMT+1) = ITHA
- JMT = JMT + 1
- 229 JMS = JMS + 1
- GO TO 801
-#endif
-* use default CALL IE3TOS for input single prec.
-#ifndef CERNLIB_FQIE3TSC
-#endif
-* use default CALL IE3TOD for input double prec.
-#ifndef CERNLIB_FQIE3TDC
-#endif
diff --git a/src/packlib/zebra/fq/fzicvjf.inc b/src/packlib/zebra/fq/fzicvjf.inc
deleted file mode 100644
index 7f80d2e..0000000
--- a/src/packlib/zebra/fq/fzicvjf.inc
+++ /dev/null
@@ -1,15 +0,0 @@
-*
-* $Id: fzicvjf.inc,v 1.1.1.1 1996/03/06 10:47:12 mclareni Exp $
-*
-* $Log: fzicvjf.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:12 mclareni
-* Zebra
-*
-*
-*
-* fzicvjf.inc
-*
-#if defined(CERNLIB_FQCVDFF)||defined(CERNLIB_FQIE3TSC)
-#else
- 301 CONTINUE
-#endif
diff --git a/src/packlib/zebra/fq/fzicvji.inc b/src/packlib/zebra/fq/fzicvji.inc
deleted file mode 100644
index 06cb7fd..0000000
--- a/src/packlib/zebra/fq/fzicvji.inc
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: fzicvji.inc,v 1.1.1.1 1996/03/06 10:47:09 mclareni Exp $
-*
-* $Log: fzicvji.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:09 mclareni
-* Zebra
-*
-*
-*
-* fzicvji.inc
-*
-#if defined(CERNLIB_QMCDC)
-#elif defined(CERNLIB_QMCRY)
-#elif (defined(CERNLIB_QMCV64))&&(!defined(CERNLIB_QIEEE))
-#elif 1
- 201 CONTINUE
-#endif
diff --git a/src/packlib/zebra/fq/fzicxd1.inc b/src/packlib/zebra/fq/fzicxd1.inc
deleted file mode 100644
index abc7ce8..0000000
--- a/src/packlib/zebra/fq/fzicxd1.inc
+++ /dev/null
@@ -1,82 +0,0 @@
-*
-* $Id: fzicxd1.inc,v 1.1.1.1 1996/03/06 10:47:09 mclareni Exp $
-*
-* $Log: fzicxd1.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:09 mclareni
-* Zebra
-*
-*
-* no longer needed
-*
-* fzicxd1.inc
-*
-#if defined(CERNLIB_QMCDC)
- PARAMETER (JEXMIN = -975, JEXMAX=1023)
- PARAMETER (IBADMS = O"17770000000000000000")
- PARAMETER (IOVPMS = O"37774000000000000000")
- PARAMETER (IOVNMS = O"40003777777777777777")
- PARAMETER (IBADMD = IBADMS, IBADME = 0)
- PARAMETER (IOVPMD = IOVPMS, IOVNMD = IOVNMS)
-#endif
-* no longer needed
-*
-* fzicxd1.inc
-*
-#if defined(CERNLIB_QMIBM)
- PARAMETER (JEXMIN = -259, JEXMAX=251)
-C PARAMETER (IOVPMS = Z 7FFFFFF0)
- PARAMETER (IOVPMS = 2147 483 632)
-C PARAMETER (IOVNMS = Z FFFFFFF0)
- PARAMETER (IOVNMS = -16)
- PARAMETER (IBADMD = IBADMS, IBADME = 0)
- PARAMETER (IOVPMD = IOVPMS, IOVNMD = IOVNMS)
-#endif
-* no longer needed
-*
-* fzicxd1.inc
-*
-#if defined(CERNLIB_QMIBMD)
- PARAMETER (JEXMIN = -259, JEXMAX=251)
-C PARAMETER (IOVPMS = Z 7FFFFFF0)
- PARAMETER (IOVPMS = 2147 483 632)
-C PARAMETER (IOVNMS = Z FFFFFFF0)
- PARAMETER (IOVNMS = -16)
- PARAMETER (IBADMD = IBADMS, IBADME = 0)
- PARAMETER (IOVPMD = IOVPMS, IOVNMD = IOVNMS)
-#endif
-* no longer needed
-*
-* fzicxd1.inc
-*
-#if defined(CERNLIB_QMND3)
- PARAMETER (JEXMIN = -255, JEXMAX=253)
- PARAMETER (IOVPMS = 17777777770 B)
- PARAMETER (IOVNMS = 37777777770 B)
- PARAMETER (IBADMD = IBADMS, IBADME = 0)
- PARAMETER (IOVPMD = IOVPMS, IOVNMD = IOVNMS)
-#endif
-* use default CALL IE3TOS for input single prec.
-#ifndef CERNLIB_FQIE3TSC
-#endif
-* use default CALL IE3TOD for input double prec.
-#ifndef CERNLIB_FQIE3TDC
-#endif
-* -------------- sequences for FZMACH ---------------------
-* no longer needed
-*
-* fzicxd1.inc
-*
-#if defined(CERNLIB_QMVAX)
- PARAMETER (JEXMIN = -127, JEXMAX=125)
- PARAMETER (IOVPMS = '00007F81'X)
- PARAMETER (IOVNMS = '0000FF81'X)
- PARAMETER (IBADMS = '00008001'X)
- PARAMETER (IBADMD = IBADMS, IBADME = 0)
- PARAMETER (IOVPMD = IOVPMS, IOVNMD = IOVNMS)
-#endif
-* use default CALL IE3TOS for input single prec.
-#ifndef CERNLIB_FQIE3TSC
-#endif
-* use default CALL IE3TOD for input double prec.
-#ifndef CERNLIB_FQIE3TDC
-#endif
diff --git a/src/packlib/zebra/fq/fzidat.F b/src/packlib/zebra/fq/fzidat.F
deleted file mode 100644
index 8bb13da..0000000
--- a/src/packlib/zebra/fq/fzidat.F
+++ /dev/null
@@ -1,221 +0,0 @@
-*
-* $Id: fzidat.F,v 1.3 1999/06/18 13:28:48 couet Exp $
-*
-* $Log: fzidat.F,v $
-* Revision 1.3 1999/06/18 13:28:48 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.2 1996/04/18 16:10:30 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:12 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
-#if defined(CERNLIB_FZDACC)
- SUBROUTINE FZIDAT (LUNP,IXDIVP,LSUPP,JBIASP)
-
-C- Find and read the Direct Access Table
-
-#include "zebra/zunit.inc"
-#include "zebra/mqsys.inc"
-#include "zebra/eqlqf.inc"
-#include "zebra/fzci.inc"
-*
- DIMENSION LUNP(9),IXDIVP(9),LSUPP(9),JBIASP(9)
- DIMENSION MDSADR(4)
- CHARACTER CHOPT*2
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HFZID, 4HAT /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HFZIDAT /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'FZIDAT ')
-#endif
-
-#include "zebra/q_jbit.inc"
-
-#include "zebra/qtrace.inc"
-
- LUNNI = LUNP(1)
- CALL FZLOC (LUNNI,1)
-#if defined(CERNLIB_QDEBPRI)
- IF (LOGLVI.GE.2) WRITE (IQLOG,9002) LUNI
- 9002 FORMAT (' FZIDAT- called for LUN=',I4)
-#endif
-
- IFLUPD = 7
- IFLNOR = 0
- LBPARI = LQFI + INCBPI
- NWPREC = IQ(KQSP+LBPARI+1)
-
-C---- Read the first logical record
-
- CHOPT = 'SF'
- ITER = 0
- MDSADR(1) = 1
- MDSADR(2) = 0
-
- 24 CALL FZINXT (LUNI,MDSADR(1),MDSADR(2))
-
- 26 NUH = 2
- CALL FZIN (LUNI, IXDIVP, LSUPP, JBIASP, CHOPT, NUH, MDSADR)
- MDSADR(NUH+1) = 0
- MDSADR(NUH+2) = 0
-
-C-- ITER = 0 read first LR of the file, is it DAT forward ref.?
-C- 1 read the last LR of the file, is it Zebra EoF ?
-C- 2 hunt for DAT record
-C- 3 select DAT record
-C- 4 read the data of the DAT record
-
- IF (ITER.EQ.4) GO TO 67
- IF (ITER.EQ.3) GO TO 64
- IF (ITER.EQ.2) GO TO 54
- IF (ITER.EQ.1) GO TO 44
-
-C-- look at the first record
- IF (IQUEST(1).GE.4) GO TO 802
- IF (IQUEST(1).NE.0) GO TO 34
- IF (IPILI(3) .NE.2) GO TO 34
- IF (MDSADR(1).NE.0) GO TO 61
-
-#if defined(CERNLIB_QDEBPRI)
- IF (LOGLVI.GE.0) WRITE (IQLOG,9032) LUNI
- 9032 FORMAT (' FZIDAT. LUN=',I4,' DaT forward ref. record not filled')
-#endif
- GO TO 41
-
- 34 IFLUPD = 0
-#if defined(CERNLIB_QDEBPRI)
- IF (LOGLVI.GE.0) WRITE (IQLOG,9034) LUNI
- 9034 FORMAT (' FZIDAT. LUN=',I4,
- F' does not start with DaT forward ref. record')
-#endif
-
-C------ Get the last logical record
-
- 41 ITER = 1
-#if defined(CERNLIB_QDEBPRI)
- IF (LOGLVI.GE.0) WRITE (IQLOG,9041)
- 9041 FORMAT (19X,'try direct read of last record')
-#endif
-#if defined(CERNLIB_FZDACCL)
- IF (IACMOI.EQ.2) THEN
- CALL CFSIZE (IADOPI, MEDIUI,NWPREC,JRECLL,ISTAT)
- GO TO 42
- ENDIF
-#endif
- CALL FFSIZE (LUNI,NWPREC,JRECLL,ISTAT)
-
- 42 IF (ISTAT.NE.0) JRECLL = 0
- IF (JRECLL.LE.0) GO TO 51
- MDSADR(1) = JRECLL
- MDSADR(2) = 0
- GO TO 24
-
-C-- look at the last logical record
- 44 IF (IQUEST(1).GE.4) GO TO 51
- IF (IQUEST(1).LT.0) GO TO 51
- IF (IQUEST(1).NE.3) GO TO 26
- IF (MDSADR(1).NE.0) GO TO 62
-
-#if defined(CERNLIB_QDEBPRI)
- IF (LOGLVI.GE.0) WRITE (IQLOG,9046) LUNI
- 9046 FORMAT (' FZIDAT. LUN=',I4,' Zebra EoF does not point to DaT')
-#endif
- IF (MDSADR(2).EQ.0) GO TO 801
-
-C------ Hunt for the DAT bank or Zebra EoF
-
- 51 ITER = 2
- CHOPT = 'SH'
- JRECLL = MAX (JRECLL-25,1)
- LDSADR = -1
- NFTOL = 4
- IF (JRECLL.GE.11) NFTOL = 12
- MDSADR(1) = JRECLL
- MDSADR(2) = 0
-#if defined(CERNLIB_QDEBPRI)
- IF (LOGLVI.GE.0) WRITE (IQLOG,9051) LUNI,JRECLL
- 9051 FORMAT (' FZIDAT. LUN=',I4,' cannot get DaT adr from Zebra EoF'
- F/19X,'hunt for it starting at record',I9)
-#endif
- GO TO 24
-
- 54 IF (IQUEST(1).EQ.0) GO TO 65
- IF (IQUEST(1).EQ.3) GO TO 55
- IF (IQUEST(1).GE.4) GO TO 57
- IF (IQUEST(1).LT.0) THEN
- NFTOL = NFTOL - 1
- IF (NFTOL.LT.0) GO TO 801
- ELSE
- LDSADR = -1
- ENDIF
- GO TO 26
-
- 55 IF (MDSADR(1).NE.0) GO TO 62
- LDSADR = MDSADR(2)
- GO TO 26
-
- 57 IF (JRECLL.LE.1) GO TO 801
- IF (LDSADR.EQ.0) GO TO 801
- JRECLL = 0
- GO TO 51
-
-C------ Read the DAT bank
-
- 61 IFLUPD = 0
- IFLNOR = -2
- 62 ITER = 3
- GO TO 24
-
- 64 IF (IQUEST(1).NE.0) GO TO 801
- IF (IPILI(3).NE.1) GO TO 801
- 65 IQ(KQSP+LQFI+34) = IQUEST(5)
- IQ(KQSP+LQFI+35) = IQUEST(6)
- CHOPT = 'A '
- ITER = 4
- GO TO 26
-
- 67 IF (IQUEST(1).NE.0) GO TO 801
- IF (IQUEST(13).EQ.0) GO TO 801
-
-C-- update the DAT forward reference record
- IF (IFLUPD.EQ.0) GO TO 71
- IF (JBIT(MSTATI,12).EQ.0) GO TO 71
- IQ(KQSP+LQFI+2) = 0
- CALL FZUDAT (LUNP,1)
-
- 71 IQ(KQSP+LQFI+2) = 2
-#if defined(CERNLIB_QDEBPRI)
- IF (LOGLVI+IFLNOR.GE.0) WRITE (IQLOG,9072) LUNI
- 9072 FORMAT (' FZIDAT. LUN=',I4,' rewind')
-#endif
- CALL FZENDI (LUNP,'IQ')
-#include "zebra/qtrace99.inc"
- RETURN
-
-C---- Errors
-
- 801 IQUEST(1) = -1
-#if defined(CERNLIB_QDEBPRI)
- IF (LOGLVI.GE.-2) WRITE (IQLOG,9098) LUNI
- 9098 FORMAT (' FZIDAT. LUN=',I4,' DaT not found !!!')
-#endif
- GO TO 71
-
- 802 IQUEST(1) = -2
-#if defined(CERNLIB_QDEBPRI)
- IF (LOGLVI.GE.-2) WRITE (IQLOG,9099) LUNI
- 9099 FORMAT (' FZIDAT. LUN=',I4,' file is empty !!!')
-#endif
- GO TO 999
- END
-#endif
diff --git a/src/packlib/zebra/fq/fzidat36.inc b/src/packlib/zebra/fq/fzidat36.inc
deleted file mode 100644
index 704408a..0000000
--- a/src/packlib/zebra/fq/fzidat36.inc
+++ /dev/null
@@ -1,15 +0,0 @@
-*
-* $Id: fzidat36.inc,v 1.1.1.1 1996/03/06 10:47:09 mclareni Exp $
-*
-* $Log: fzidat36.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:09 mclareni
-* Zebra
-*
-*
-*
-* fzidat36.inc
-*
-#if defined(CERNLIB_QMCDC)
- IF (IUPAKI.NE.0) NBPREC = (60*MAXREI) / 8
-* -------------- conversions for input -------------------
-#endif
diff --git a/src/packlib/zebra/fq/fzidia.F b/src/packlib/zebra/fq/fzidia.F
deleted file mode 100644
index a288618..0000000
--- a/src/packlib/zebra/fq/fzidia.F
+++ /dev/null
@@ -1,241 +0,0 @@
-*
-* $Id: fzidia.F,v 1.2 1999/06/18 13:28:51 couet Exp $
-*
-* $Log: fzidia.F,v $
-* Revision 1.2 1999/06/18 13:28:51 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:13 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE FZIDIA
-
-C- Diagnostic handling routine for FZIN and FZCOPY
-
-C- The error return code JRETCD is now set :
-
-C- -4 all segments to be skipped : FZIMTB
-C- -3 trying to read beyond EoD
-C- -2 normal start/end of run : FZIFFN, FZIFFX
-C- -1 normal EoF : FZIFFN, FZIREC
-C- 1 unexpected EoF : FZIFFN, FZIPHR, FZIPHA
-C- 2 unexpected start/end of run : FZIFFN
-C- 3 not enough memory : FZIMTB
-C- 4 Bad User Handling : FZIN, FZIFFX, FZIMTB
-C- 5 Bad Data : FZIFFN, FZIFFX, FZIPHR, FZIPHA, FZIASC, FZIREL
-C- 6 Bad Construction : FZIFFN, .FFX, .REC, .PHR, .PHM, .PHA
-C- 7 Read Error : FZIFFN, FZIPHR, FZIASC
-C- 8 Emergency Stop
-
-C- The old scheme was :
-
-C- 1 unexpected EoF : FZIFFN, FZIPHR, FZIPHA
-C- -4 also : all segments to be skipped in FZIMTB
-C- 5 bad data in FZIREL
-C- -1 2 normal EoF : FZIFFN, FZIREC
-C- 4 also : user error handling the segment table in FZIMTB
-C- 2 3 unexpected start/end of run : FZIFFN
-C- 3 also : not enough memory in FZIMTB
-C- -2 4 normal start/end of run : FZIFFN, FZIFFX
-C- 5 Bad Data : FZIFFN, FZIFFX, FZIPHR, FZIPHA, FZIASC
-C- 6 Bad Construction : FZIFFN, .FFX, .REC, .PHR, .PHM, .PHA
-C- 7 Read Error : FZIFFN, FZIPHR, FZIASC
-C- 4 8 user routine / memory not connected : FZIFFX
-C- 8 - Emergency Stop
-
-#include "zebra/zunit.inc"
-#include "zebra/mqsys.inc"
-#include "zebra/eqlqf.inc"
-#include "zebra/fzci.inc"
-*
- EQUIVALENCE (LRTYP,IDI(2))
- CHARACTER ERRMSG*16
- CHARACTER TEXT*4
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HFZID, 4HIA /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HFZIDIA /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'FZIDIA ')
-#endif
-
-#include "zebra/q_jbit.inc"
-
-#include "zebra/qtrace.inc"
-
- IF (JRETCD.GE.0) GO TO 40
-
-C-----------------------------------------------------
-C- Normal end-of-file / end-of-run
-C-----------------------------------------------------
-
- J = -JRETCD
- GO TO ( 24, 31, 21), J
-
-C-- Reading beyond end-of-data
-
- 21 CONTINUE
-#if defined(CERNLIB_QPRINT)
- IF (LOGLVI.GE.-2) WRITE (IQLOG,9021) LUNI
- 9021 FORMAT (1X/' FZIDIA. LUN=',I4,' Attempt to read beyond E-o-D')
-#endif
- IF (IACTVI.EQ.7) CALL ZFATAM ('FZIDIA - reading beyond EOD')
- IACTVI = 7
- GO TO 27
-
-C-- Normal EOF
-
- 24 N = IQ(KQSP+LQFI+11) + 1
- IQ(KQSP+LQFI+11) = N
- IACTVI = MAX (IACTVI,4) + 1
- IF (JBIT(MSTATI,13).EQ.0) IACTVI=6
-#if defined(CERNLIB_QPRINT)
- IF (LOGLVI.LT.0) GO TO 27
- TEXT = 'File'
- IF (IACTVI.EQ.6) TEXT='Data'
- WRITE (IQLOG,9024) LUNI,N,TEXT
- 9024 FORMAT (1X/' FZIN. LUN=',I4,' System EOF #',I4,
- F' seen as End-of-',A)
-#endif
- 27 LRTYP = 0
- IQUEST(1) = IACTVI - 1
- GO TO 91
-
-C---- Normal S/E-OF-RUN
-
- 31 JRUNCR = LQ(LUHEAI)
- IF (JRUNCR.GT.0) GO TO 34
-
-C-- End of run
-
- IACTVI = MIN (4, MAX(IACTVI,2)+1)
- IF (JRUNCR.EQ.-1) IACTVI = 4
- JRUNCR = IQ(KQSP+LQFI+29)
- IQUEST(1) = IACTVI - 1
- IQUEST(11) = JRUNCR
- IQ(KQSP+LQFI+16-IACTVI) = IQ(KQSP+LQFI+16-IACTVI) + 1
-#if defined(CERNLIB_QPRINT)
- IF (LOGLVI.LT.0) GO TO 91
- IF (IACTVI.EQ.3) THEN
- WRITE (IQLOG,9031) LUNI,JRUNCR
- ELSE
- WRITE (IQLOG,9032) LUNI
- ENDIF
- 9031 FORMAT (1X/' FZIN. LUN=',I4,' End of Run ',I8)
- 9032 FORMAT ( ' FZIN. LUN=',I4,' Zebra EoF')
-#endif
- GO TO 91
-
-C-- Start of run
-
- 34 IQ(KQSP+LQFI+14) = IQ(KQSP+LQFI+14) + 1
- IQ(KQSP+LQFI+29) = JRUNCR
- IQUEST(1) = 1
- IQUEST(11) = JRUNCR
- IACTVI = 1
-#if defined(CERNLIB_QPRINT)
- IF (LOGLVI.GE.0) WRITE (IQLOG,9034) LUNI,JRUNCR
- 9034 FORMAT (1X/' FZIN. LUN=',I4,' Start of Run ',I6)
-#endif
- GO TO 91
-
-C-----------------------------------------------------
-C- Other error conditions
-C-----------------------------------------------------
-
- 40 GO TO ( 41, 44, 64, 61, 71, 74, 77, 67), JRETCD
-
-C-- Unexpected end-of-file
-
- 41 IQ(KQSP+LQFI+30) = 1
-#if defined(CERNLIB_QPRINT)
- IF (LOGLVI.GE.-2) WRITE (IQLOG,9041) LUNI
- 9041 FORMAT (1X/' FZIDIA. LUN=',I4,' Unexpected EoF')
-#endif
- GO TO 71
-
-C------ Unexpected start/end of run
-
- 44 IQ(KQSP+LQFI+30) = 2
-#if defined(CERNLIB_QPRINT)
- IF (LOGLVI.GE.-2) WRITE (IQLOG,9044) LUNI
- 9044 FORMAT (1X/' FZIDIA. LUN=',I4,' Unexpected Start/End-of-Run.')
-#endif
- GO TO 71
-
-C---- User error
-
- 61 IQUEST(11)= -1
- ERRMSG = 'BAD CALLING'
- GO TO 81
-
-C---- NOT ENOUGH SPACE
-
- 64 IQUEST(11)= -2
- ERRMSG = 'NOT ENOUGH SPACE'
- GO TO 80
-
-C---- EMERGENCY STOP
-
- 67 IQUEST(11)= -3
- ERRMSG = 'EMERGENCY STOP'
- GO TO 80
-
-C---- BAD DATA
-
- 71 IQUEST(11)= -3
- ERRMSG = 'BAD DATA'
- GO TO 80
-
-C---- BAD CONSTRUCTION
-
- 74 IQUEST(11)= -4
- ERRMSG = 'BAD CONSTRUCTION'
- GO TO 80
-
-C---- READ ERROR
-
- 77 IQUEST(11)= -5
- ERRMSG = 'READ ERROR'
-
-C------ Print error message
-
- 80 IQ(KQSP+LQFI+18) = IQ(KQSP+LQFI+18) + 1
- 81 IQUEST(1) = IQUEST(11)
- IQUEST(3) = IQ(KQSP+LQFI+22)
- IQUEST(12)= JERROR
- IQUEST(13)= LRTYP
- LRTYP = 0
- LAST = IQ(KQSP+LQFI+26)
- IF (LAST.LT.0) IQUEST(1)=MIN(-6,LAST-1)
-#if defined(CERNLIB_QPRINT)
- IF (LOGLVI.GE.-2)
- + WRITE (IQLOG,9081,ERR=82) LUNI,ERRMSG
- +, IQUEST(1),NRECAI,IQUEST(3)
- +, (IQUEST(J+10),J=1,NWERR+3)
- 82 CONTINUE
-
- 9081 FORMAT (1X/' FZIDIA. LUN=',I4,1X,A/
- F 10X,'IQUEST(1/2/3)=',I4,2I8/
- F 10X,'IQUEST(11-) = ',3I4,2I9,
-#endif
-#if (defined(CERNLIB_QPRINT))&&(!defined(CERNLIB_HEX))
- F 2O23)
-#endif
-#if (defined(CERNLIB_QPRINT))&&(defined(CERNLIB_HEX))
- F 2Z17)
-#endif
- IF (LAST.LT.-50)
- + CALL ZFATAM ('FZIDIA - too many consecutive errors.')
-
- 91 CONTINUE
-#include "zebra/qtrace99.inc"
- RETURN
- END
diff --git a/src/packlib/zebra/fq/fzidum.F b/src/packlib/zebra/fq/fzidum.F
deleted file mode 100644
index 78b2350..0000000
--- a/src/packlib/zebra/fq/fzidum.F
+++ /dev/null
@@ -1,52 +0,0 @@
-*
-* $Id: fzidum.F,v 1.2 1999/06/18 13:28:52 couet Exp $
-*
-* $Log: fzidum.F,v $
-* Revision 1.2 1999/06/18 13:28:52 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:13 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
-#if defined(CERNLIB_QDEBPRI)
- SUBROUTINE FZIDUM (MREC,NW4USE)
-
-C- Dump start of or full physical record read
-
-#include "zebra/zunit.inc"
-#include "zebra/fzci.inc"
-*
- DIMENSION MREC(3600)
-#if defined(CERNLIB_HEX)
- PARAMETER (NWPLIN=8)
-#endif
-#if !defined(CERNLIB_HEX)
- PARAMETER (NWPLIN=10)
-#endif
-
- N = NW4USE
- IF (LOGLVI.LT.4) N=16
-
- WRITE (IQLOG,9047) N
- 9047 FORMAT (1X/' FZIPHx- Dump first',I6,' words of block:')
-
- JE = 0
- 48 JA = JE + 1
- JE = MIN (N,JA+NWPLIN-1)
- WRITE (IQLOG,9048) JA,(MREC(J),J=JA,JE)
- IF (JE.LT.N) GO TO 48
- RETURN
-#if (defined(CERNLIB_HEX))&&(defined(CERNLIB_B32))
- 9048 FORMAT (7X,I7,8(2X,Z8))
-#endif
-#if (defined(CERNLIB_HEX))&&(!defined(CERNLIB_B32))
- 9048 FORMAT (7X,I7,8(1X,Z9))
-#endif
-#if !defined(CERNLIB_HEX)
- 9048 FORMAT (7X,I7,5(2X,O12)/14X,5(2X,O12))
-#endif
- END
-#endif
diff --git a/src/packlib/zebra/fq/fziffn.F b/src/packlib/zebra/fq/fziffn.F
deleted file mode 100644
index 2e70e43..0000000
--- a/src/packlib/zebra/fq/fziffn.F
+++ /dev/null
@@ -1,481 +0,0 @@
-*
-* $Id: fziffn.F,v 1.3 1999/06/18 13:28:54 couet Exp $
-*
-* $Log: fziffn.F,v $
-* Revision 1.3 1999/06/18 13:28:54 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.2 1996/04/18 16:10:31 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:13 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
-#if defined(CERNLIB_FZFFNAT)
- SUBROUTINE FZIFFN (JSTAGE)
-
-C- Read operations for file format native
-C- subsidiary to FZIN
-
-C- Controlling parameter : JSTAGE
-C-
-C- JSTAGE = 1 : read the first pilot record
-C- 2 : read the tables into memory
-C- 3 : read the bank material
-
-#include "zebra/zbcd.inc"
-#include "zebra/zmach.inc"
-#include "zebra/zunit.inc"
-#include "zebra/mqsys.inc"
-#include "zebra/eqlqf.inc"
-#include "zebra/mzcn.inc"
-#include "zebra/mzct.inc"
-#include "zebra/mzcwk.inc"
-#include "zebra/fzci.inc"
-#include "zebra/fzcseg.inc"
-#include "zebra/fzcocc.inc"
-*
- DIMENSION MPILOT(10)
- REAL CHDATA
-#if defined(CERNLIB_QMVDS)
- SAVE CHDATA
-#endif
- EQUIVALENCE (MPILOT(1),IPILI(1))
- EQUIVALENCE (LRTYP,IDI(2)), (ICHDAT,CHDATA)
-#if defined(CERNLIB_QREADFULL)
- COMMON /SLATE/ NRSLAT, DUMMY(39)
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HFZIF, 4HFN /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HFZIFFN /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'FZIFFN ')
-#endif
- DATA CHDATA / 12345.0 /
-
-#include "zebra/q_jbyt.inc"
-
-#include "zebra/qtrace.inc"
-
- GO TO (101,201,301), JSTAGE
-
-C-----------------------------------------------------
-C- obtain and digest next pilot record
-C-----------------------------------------------------
-
- 101 LIN = LQWKFZ
-
- 102 NWR = NQWKTT
- CALL XINBS (LUNI,LRTYP,1,LQ(LIN),NWR)
-#if defined(CERNLIB_QDEBPRI)
- IF (LOGLVI.GE.3) WRITE (IQLOG,9102) NRECAI+1,NWR,LRTYP
- 9102 FORMAT (' FZIFFN- hunt for pilot, seen LR #',I7,
- F' with NWRL/LRTYP=',I7,I3)
-#endif
- IF (NWR.EQ.0) GO TO 412
- IF (NWR.LT.0) GO TO 751
- NRECAI = NRECAI + 1
- NWRDAI = NWRDAI + NWR + 3
- IF (LRTYP.LE.0) GO TO 741
- IF (LRTYP.GT.9) GO TO 741
- IF (LRTYP.GE.4) GO TO 102
- IF (LRTYP.EQ.1) GO TO 427
-
- IACTVI = 2
- IEVFLI = 3 - LRTYP
- IQ(KQSP+LQFI+15) = IQ(KQSP+LQFI+15) + 1
- IF (IOPTIR.NE.0) GO TO 102
- IF (IEVFLI.LT.IOPTIE) GO TO 102
-
- CALL UCOPY (LQ(LIN),IPILI,26)
-#if defined(CERNLIB_QDEBPRI)
- IF (LOGLVI.GE.3) WRITE (IQLOG,9107,ERR=107) MPILOT,MPILOT
- 107 CONTINUE
- 9107 FORMAT (10X,'the 10 pilot control words : ',
-#endif
-#if (defined(CERNLIB_QDEBPRI))&&(!defined(CERNLIB_HEX))
- F/1X,4O23/1X,4O23/1X,2O23
- F/1H0,9X,F13.1,3(9X,I14)/1X,4(9X,I14)/1X,2(9X,I14))
-#endif
-#if (defined(CERNLIB_QDEBPRI))&&(defined(CERNLIB_HEX))
- F/10X,4Z17/10X,4Z17/10X,2Z17
- F/1H0,9X,F17.1,3I17/10X,4I17/10X,2I17)
-#endif
- IF (IPILI(1).NE.ICHDAT) GO TO 742
-
-C-- Copy user header
-
- NWDONE = NWUHCI + 10
- NWIOI = 0
- NWUHI = 0
- LFIIOC = LQFI + JAUIOC
- IQ(KQSP+LFIIOC) = 0
- IF (NWUMXI.LE.0) GO TO 121
-
- IF (NWUHCI.EQ.0) THEN
- NWUHI = 0
- GO TO 121
- ENDIF
-
- NWIOI = JBYT (IOCHI(1),7,5)
- IF (NWIOI.EQ.0) THEN
- NWIOI = 1
- IF (IOCHI(1).GE.8) GO TO 743
- IF (IOCHI(1).LT.0) GO TO 743
- IF (IOCHI(1).EQ.0) IOCHI(1)=1
- ELSE
- J = JBYT (IOCHI(1),12,5)
- IF (J+1.NE.NWIOI) GO TO 743
- ENDIF
- IQ(KQSP+LFIIOC) = NWIOI
- CALL UCOPY (IOCHI,IQ(KQSP+LFIIOC+1),NWIOI)
-
- NWUHI = NWUHCI - NWIOI
- LUHEAI = LIN + 10 + NWIOI
-#if defined(CERNLIB_QDEBPRI)
- IF (LOGLVI.GE.3) THEN
- N = MIN (8,NWUHI)
- IF (LOGLVI.GE.4) THEN
- WRITE (IQLOG,9113) NWIOI
- WRITE (IQLOG,9115) (IOCHI(J),J=1,NWIOI)
- N = NWUHI
- ENDIF
- WRITE (IQLOG,9114) NWUHI,N
- WRITE (IQLOG,9115) (LQ(LUHEAI+J),J=0,N-1)
- ENDIF
- 9113 FORMAT (10X,I2,' words I/O characteristic for UHV =')
- 9114 FORMAT (10X,I4,' words of User Header accepted, dump the first'
- F,I5)
-#endif
-#if (defined(CERNLIB_QDEBPRI))&&(!defined(CERNLIB_HEX))
- 9115 FORMAT (1X,4O23)
-#endif
-#if (defined(CERNLIB_QDEBPRI))&&(defined(CERNLIB_HEX))
- 9115 FORMAT (10X,4Z17)
-#endif
-
-C---- Save the segment table
-
- 121 LFISEG = LQFI + JAUSEG
- IF (NWSEGI.EQ.0) GO TO 124
- IF (NWSEGI.GE.61) GO TO 744
- IF (NWSEGI.LT.0) GO TO 744
- IF (NWTABI.EQ.0) THEN
- NWDONE = NWDONE + NWSEGI
- NWSEGI = 0
- ELSE
- CALL UCOPY (LQ(LIN+NWDONE),IQ(KQSP+LFISEG+1),NWSEGI)
- NWDONE = NWDONE + NWSEGI
- ENDIF
- 124 IQ(KQSP+LFISEG) = NWSEGI
-
-C---- Save the text vector
-
- LTEXT = LQ(KQSP+LQFI-2)
- IF (LTEXT.NE.0) IQ(KQSP+LTEXT+1)=0
- IF (NWTXI.EQ.0) GO TO 141
-
-C-- Increase the size of the text buffer if necessary
-
- IF (LTEXT.EQ.0) GO TO 131
- NINC = NWTXI + 4 - IQ(KQSP+LTEXT-1)
- IF (NINC.LE.0) GO TO 131
-
- NQWKTB = NQWKTT
- CALL MZPUSH (JQPDVS,LTEXT,0,NINC,'.')
-
-C-- Read the text vector
-
- 131 IF (NWDONE.LT.NWR) GO TO 136
- 132 LIN = LQWKTB
- NWR = NQWKTT
- CALL XINBS (LUNI,MRTYP,1,LQ(LIN),NWR)
-#if defined(CERNLIB_QDEBPRI)
- IF (LOGLVI.GE.3) WRITE (IQLOG,9132) NRECAI+1,NWR,MRTYP
- 9132 FORMAT (10X,'expect pilot continuation, seen LR #',I7,
- F' with NWRL/LRTYP=',I7,I3)
-#endif
- IF (NWR.EQ.0) GO TO 411
- IF (NWR.LT.0) GO TO 751
- NRECAI = NRECAI + 1
- NWRDAI = NWRDAI + NWR + 3
-
- IF (MRTYP-4) 134, 135, 133
- 133 IF (MRTYP.LT.7) GO TO 132
- 134 LRTYP = MRTYP
- IF (LRTYP.EQ.1) GO TO 424
- GO TO 731
-
- 135 NWDONE = 0
-
-C-- Store into the text buffer
-
- 136 IF (NWR-NWDONE.LT.NWTXI) GO TO 745
- IF (LTEXT.NE.0) THEN
- IQ(KQSP+LTEXT+1) = NWTXI
- CALL UCOPY (LQ(LIN+NWDONE),IQ(KQSP+LTEXT+5),NWTXI)
- ENDIF
- NWDONE = NWDONE + NWTXI
-
-C---- Save early table words
-
- 141 NTBE = NWR - NWDONE
- LFIEAR = LQFI + JAUEAR
- IQ(KQSP+LFIEAR) = NTBE
-
- IF (NTBE.NE.0) THEN
- IF (NTBE.NE.NWTABI) GO TO 746
- IF (NTBE.GE.41) GO TO 746
- CALL UCOPY (LQ(LIN+NWDONE),IQ(KQSP+LFIEAR+1),NTBE)
- ENDIF
- GO TO 999
-
-C-------------------------------------------------
-C- read table
-C-------------------------------------------------
-
- 201 LIN = LQTA + NWTABI
- 204 NWR = LQTE - LIN
- CALL XINBS (LUNI,LRTYP,1,LQ(LIN),NWR)
-#if defined(CERNLIB_QDEBPRI)
- IF (LOGLVI.GE.3) WRITE (IQLOG,9204) NRECAI+1,NWR,LRTYP
- 9204 FORMAT (' FZIFFN- expect table, seen LR #',I7,
- F' with NWRL/LRTYP=',I7,I3)
-#endif
- IF (NWR.EQ.0) GO TO 411
- IF (NWR.LT.0) GO TO 751
- NRECAI = NRECAI + 1
- NWRDAI = NWRDAI + NWR + 3
- IF (LRTYP.EQ.1) GO TO 424
- IF (LRTYP.LT.4) GO TO 732
- IF (LRTYP.GE.7) GO TO 732
- IF (LRTYP.GE.5) GO TO 204
- LIN = LIN + NWR
- IF (LIN-LQTE) 204, 999, 747
-
-C-------------------------------------------------
-C- read the data
-C-------------------------------------------------
-
- 301 LMT = LQMTA
- 302 IF (LQ(LMT+1).NE.0) GO TO 311
-
-C-- Skip segment to be ignored
-
- NWSK = LQ(LMT+3)
- LIN = LQWKFZ
-#if defined(CERNLIB_QREADFULL)
- 304 NWR = NQWKTT
- CALL XINBS (LUNI,LRTYP,1,LQ(LIN+2),NWR)
- IDI(1) = NWR
- NWRU = NWR
-#endif
-#if !defined(CERNLIB_QREADFULL)
- 304 NWR = 3
- CALL XINBF (LUNI,LQ(LIN),NWR)
- IDI(1) = LQ(LIN)
- IDI(2) = LQ(LIN+1)
- NWRU = 1
-#endif
-#if defined(CERNLIB_QDEBPRI)
- IF (LOGLVI.GE.3) WRITE (IQLOG,9314) NRECAI+1,IDI
-#endif
- IF (NWR.EQ.0) GO TO 411
- IF (NWR.LT.0) GO TO 751
- NRECAI = NRECAI + 1
- NWRDAI = NWRDAI + IDI(1) + 3
- IF (LRTYP.EQ.1) GO TO 421
- IF (LRTYP.LT.5) GO TO 733
- IF (LRTYP.LT.7) GO TO 304
- IF (LRTYP.GE.9) GO TO 733
- NWSK = NWSK + IDI(1)
- IF (NWSK.GE.0) GO TO 307
- IF (LRTYP.EQ.7) GO TO 304
- GO TO 734
-
- 307 IF (NWSK.EQ.0) GO TO 318
- GO TO 734
-
-C-- Read segment to accept
-
- 311 LSTA = LQ(LMT+3)
- LEND = LQ(LMT+4)
-
- LIN = LSTA
- 314 NWR = LEND - LIN
- CALL XINBS (LUNI,LRTYP,1,LQ(KQS+LIN),NWR)
-#if defined(CERNLIB_QDEBPRI)
- IF (LOGLVI.GE.3) WRITE (IQLOG,9314) NRECAI+1,NWR,LRTYP
- 9314 FORMAT (' FZIFFN- expect bank material, seen LR #',I7,
- F' with NWRL/LRTYP=',I7,I3)
-#endif
- IF (NWR.EQ.0) GO TO 411
- IF (NWR.LT.0) GO TO 751
- NRECAI = NRECAI + 1
- NWRDAI = NWRDAI + NWR + 3
- IF (LRTYP.EQ.1) GO TO 424
- IF (LRTYP.LT.5) GO TO 733
- IF (LRTYP.LT.7) GO TO 314
- IF (LRTYP.GE.9) GO TO 733
- LIN = LIN + NWR
- IF (LIN.GE.LEND) GO TO 317
- IF (LRTYP.EQ.7) GO TO 314
- GO TO 735
-
- 317 IF (LIN.GT.LEND) GO TO 735
- 318 LMT = LMT + 8
- IF (LMT.LT.LQMTE) GO TO 302
- IF (LRTYP.NE.8) GO TO 736
- GO TO 999
-
-C-------------------------------------------------
-C- end-of-file / end-of-run
-C-------------------------------------------------
-
-C-- Unexpected end-of-file
-
- 411 JRETCD = 1
- GO TO 999
-
-C-- Normal EOF
-
- 412 JRETCD = -1
- GO TO 999
-
-C------ Unexpected start/end of run
-
- 421 LIN = LIN + 2
- NWR = NWRU - 2
-
- 424 JRETCD = 2
- NWRU = MIN (78, NWR)
- LFIIOC = LQFI + JAUIOC
- IQ(KQSP+LFIIOC) = NWRU
- CALL UCOPY (LQ(LIN),IQ(KQSP+LFIIOC+1),NWRU)
- GO TO 999
-
-C---- Normal S/E-OF-RUN
-
- 427 JRETCD = -2
- NWUHI = NWR
- LUHEAI = LIN
- GO TO 999
-
-C-------------------------------------------------
-C- ERROR CONDITIONS
-C-------------------------------------------------
-
-C-- BAD DATA
-
-C- JERROR = 137 emergency stop record seen
- 737 JERROR = 137
- JRETCD = 8
- GO TO 780
-
-C- JERROR = 136 last bank material record needed is not type 8
- 736 JERROR = 136
- GO TO 739
-
-C- JERROR = 135 end of segm read does not coincide with LR
- 735 JERROR = 135
- IQUEST(14)= (LMT-LQMTA)/8 + 1
- IQUEST(15)= LEND - LSTA
- IQUEST(16)= LIN - LEND
- NWERR = 3
- GO TO 739
-
-C- JERROR = 134 end of segm skipped does not coincide with LR
- 734 JERROR = 134
- IQUEST(14)= (LMT-LQMTA)/8 + 1
- IQUEST(15)= -LQ(LMT+3)
- IQUEST(16)= NWSK
- NWERR = 3
- GO TO 739
-
-C- record of unexpected record type read
-C- JERROR = 133 expect bank material
- 733 JERROR = 1
-
-C- JERROR = 132 expect pilot continuation for table
- 732 JERROR = JERROR + 1
-
-C- JERROR = 131 expect pilot continuation for text vector
- 731 JERROR = 131 + JERROR
- IF (LRTYP.EQ.9) GO TO 737
-
- 739 JRETCD = 5
- GO TO 780
-
-C-- BAD CONSTRUCTION
-
-C- JERROR = 147 table end does not coincide with LR
- 747 JERROR = 147
- IQUEST(14)= NWTABI
- IQUEST(15)= LIN - LQTE
- NWERR = 2
- GO TO 749
-
-C- JERROR = 146 number of early table words wrong
- 746 JERROR = 146
- IQUEST(14)= NWTABI
- IQUEST(15)= NTBE
- NWERR = 2
- GO TO 749
-
-C- JERROR = 145 text vector NWTXI words longer than its record
- 745 JERROR = 145
- IQUEST(14)= NWTXI
- IQUEST(15)= NWR - NWDONE
- IQUEST(16)= NWDONE
- NWERR = 3
- GO TO 749
-
-C- JERROR = 144 NWSEGI wrong
- 744 JERROR = 144
- IQUEST(14)= NWSEGI
- NWERR = 1
- GO TO 749
-
-C- JERROR = 143 control wd of I/O char. for user header invalid
- 743 JERROR = 143
- IQUEST(14)= NWUHCI
- IQUEST(15)= 0
- IQUEST(16)= IOCHI(1)
- NWERR = 3
- GO TO 749
-
-C- JERROR = 142 check-word which should be 12345.0 is wrong
- 742 JERROR = 142
- IQUEST(14)= 0
- IQUEST(15)= 0
- IQUEST(16)= IPILI(1)
- IQUEST(17)= ICHDAT
- NWERR = 4
- GO TO 749
-
-C- JERROR = 141 LRTYP invalid when hunting for pilot
- 741 JERROR = 141
-
- 749 JRETCD = 6
- GO TO 780
-
-C-- READ ERROR
-
- 751 JERROR = 151
- IQUEST(14) = -NWR
- NWERR = 1
- JRETCD = 7
-
- 780 CONTINUE
-#include "zebra/qtrace99.inc"
- RETURN
- END
-#endif
diff --git a/src/packlib/zebra/fq/fziffx.F b/src/packlib/zebra/fq/fziffx.F
deleted file mode 100644
index 453ea74..0000000
--- a/src/packlib/zebra/fq/fziffx.F
+++ /dev/null
@@ -1,625 +0,0 @@
-*
-* $Id: fziffx.F,v 1.3 1999/06/18 13:28:56 couet Exp $
-*
-* $Log: fziffx.F,v $
-* Revision 1.3 1999/06/18 13:28:56 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.2 1996/04/18 16:10:33 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:13 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE FZIFFX (JSTAGE)
-
-C- Service routine to FZIN for exchange mode
-
-#include "zebra/zbcd.inc"
-#include "zebra/zmach.inc"
-#include "zebra/zunit.inc"
-#include "zebra/mqsys.inc"
-#include "zebra/eqlqf.inc"
-#include "zebra/mzcn.inc"
-#include "zebra/mzct.inc"
-#include "zebra/mzioc.inc"
-#include "zebra/mzcwk.inc"
-#include "zebra/fzci.inc"
-#include "zebra/fzcseg.inc"
-#include "zebra/fzcocc.inc"
-*
- DIMENSION MPILOT(10)
- REAL CHDATA
-#if defined(CERNLIB_QMVDS)
- SAVE CHDATA
-#endif
- EQUIVALENCE (MPILOT(1),IPILI(1))
- EQUIVALENCE (LRTYP,IDI(2)), (ICHDAT,CHDATA)
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HFZIF, 4HFX /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HFZIFFX /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'FZIFFX ')
-#endif
- DATA CHDATA / 12345.0 /
-
-#include "zebra/q_jbyt.inc"
-
-#include "zebra/qtrace.inc"
-
- GO TO (101,201,301), JSTAGE
-
-C-----------------------------------------------------
-C- OBTAIN AND DIGEST NEXT PILOT RECORD
-C-----------------------------------------------------
-
- 100 CONTINUE
- 101 ISTENI = 1
- LBPARI = LQFI + INCBPI
-#if defined(CERNLIB_FZCHANNEL)
- IF (IACMOI.EQ.3) THEN
- IF (IADOPI.EQ.0) GO TO 740
- ENDIF
-#endif
-#if defined(CERNLIB_FZMEMORY)
- IF (IFIFOI.EQ.3) THEN
- IADOPI = IQ(KQSP+LQFI+8)
- IQ(KQSP+LQFI+1) = IADOPI
- IF (IADOPI.EQ.0) GO TO 740
- CALL VZERO (IQ(KQSP+LBPARI-9),9)
-#endif
-#if (defined(CERNLIB_QDEVZE))&&(defined(CERNLIB_FZMEMORY))
- IF (LOGLVI.GE.3) WRITE (IQLOG,9142) IADOPI
- 9142 FORMAT (' DEVZE FZIN, relative buffer adr =',I9)
-#endif
-#if defined(CERNLIB_FZMEMORY)
- ENDIF
-#endif
-#if defined(CERNLIB_QDEBPRI)
- IF (LOGLVI.GE.3) WRITE (IQLOG,9101) IOPTIR,IOPTIE
- 9101 FORMAT (' FZIFFX- Hunt for pilot, options RUN/EVENT =',2I2)
-#endif
-
- IFLAGI = 1
- CALL FZIREC
- IF (IFLAGI.NE.0) GO TO 999
-#if defined(CERNLIB_QDEBPRI)
- IF (LOGLVI.GE.3) WRITE (IQLOG,9102) NRECAI,IDI
- 9102 FORMAT (' FZIFFX- Seen LR #',I7,' with NWRL/LRTYP=',I7,I3)
-#endif
- ISTENI = 0
- IF (LRTYP.GE.4) GO TO 100
- IF (LRTYP.EQ.1) GO TO 422
-
-#if defined(CERNLIB_FQXISN)
- CALL FZITRN (IPILI,10)
-#endif
-#if !defined(CERNLIB_FQXISN)
- IF (IDAFOI.EQ.0) THEN
- CALL FZITRN (IPILI,10)
- ELSE
- MFO(1) = 3
- MFO(2) = 1
- MFO(3) = 1
- MFO(4) = -1
- JFOEND = 4
- CALL FZITRX (IPILI,10)
- ENDIF
-#endif
- IF (IFLAGI.NE.0) GO TO 999
-
- IACTVI = 2
- IEVFLI = 3 - LRTYP
- IQ(KQSP+LQFI+15) = IQ(KQSP+LQFI+15) + 1
-
-C-- check values in pilot head
-
- IF (IPILI(1).NE.ICHDAT) GO TO 741
- IF (NWTXI .LT.0) GO TO 743
- IF (NWSEGI.GE.61) GO TO 743
- IF (NWSEGI.LT.0) GO TO 743
- IF (NWTABI.LT.0) GO TO 744
- IF (NWBKI .LT.0) GO TO 744
- IF (NWUHCI.LT.0) GO TO 745
-
-C-- skip to start/end of run
- IF (IOPTIR.NE.0) THEN
- IQ(KQSP+LQFI+26) = 0
- GO TO 100
- ENDIF
-
- IF (IEVFLI.LT.IOPTIE) GO TO 100
-
-#if defined(CERNLIB_QDEBPRI)
- IF (LOGLVI.GE.3) WRITE (IQLOG,9107,ERR=107) MPILOT,MPILOT
- 107 CONTINUE
- 9107 FORMAT (10X,'The 10 pilot control words : ',
-#endif
-#if (defined(CERNLIB_QDEBPRI))&&(!defined(CERNLIB_HEX))
- F/1X,4O23/1X,4O23/1X,2O23
- F/1H0,9X,F13.1,3(9X,I14)/1X,4(9X,I14)/1X,2(9X,I14))
-#endif
-#if (defined(CERNLIB_QDEBPRI))&&(defined(CERNLIB_HEX))
- F/10X,4Z17/10X,4Z17/10X,2Z17
- F/1H0,9X,F17.1,3I17/10X,4I17/10X,2I17)
-#endif
-
-C-- Read I/O char. for User Header Vector
-
- NWIOI = 0
- NWUHI = 0
- LFIIOC = LQFI + JAUIOC
- IQ(KQSP+LFIIOC) = 0
- IF (NWUHCI.EQ.0) GO TO 121
-
-#if defined(CERNLIB_FQXISN)
- CALL FZITRN (IOCHI,1)
-#endif
-#if !defined(CERNLIB_FQXISN)
- IF (IDAFOI.EQ.0) THEN
- CALL FZITRN (IOCHI,1)
- ELSE
- MFO(1) = 1
- MFO(2) = -1
- JFOEND = 2
- CALL FZITRX (IOCHI,1)
- ENDIF
-#endif
- IF (IFLAGI.NE.0) GO TO 999
-
- NWIOI = JBYT (IOCHI(1),7,5)
- IF (NWIOI.EQ.0) THEN
- NWIOI = 1
- IF (IOCHI(1).GE.8) GO TO 742
- IF (IOCHI(1).LT.0) GO TO 742
- IF (IOCHI(1).EQ.0) IOCHI(1)=1
- ELSE
- J = JBYT (IOCHI(1),12,5)
- IF (J+1.NE.NWIOI) GO TO 742
- ENDIF
- IF (NWIOI.LT.2) GO TO 116
-
-#if defined(CERNLIB_FQXISN)
- CALL FZITRN (IQ(KQSP+LFIIOC+2),NWIOI-1)
-#endif
-#if !defined(CERNLIB_FQXISN)
- IF (IDAFOI.EQ.0) THEN
- CALL FZITRN (IQ(KQSP+LFIIOC+2),NWIOI-1)
- ELSE
- MFO(1) = 1
- MFO(2) = -1
- JFOEND = 2
- CALL FZITRX (IOCHI(2),NWIOI-1)
- CALL UCOPY (IOCHI(2),IQ(KQSP+LFIIOC+2),NWIOI-1)
- ENDIF
-#endif
- IF (IFLAGI.NE.0) GO TO 999
-
- 116 IQ(KQSP+LFIIOC) = NWIOI
- IQ(KQSP+LFIIOC+1) = IOCHI(1)
-
-C-- Read User Header Vector
-
- LUHEAI = LQWKFZ
- NWUHA = NWUHCI - NWIOI
- NWUHI = MIN (NWUHA,NWUMXI)
-#if defined(CERNLIB_FQXISN)
- CALL FZITRN (LQ(LUHEAI),NWUHI)
-#endif
-#if !defined(CERNLIB_FQXISN)
- IF (IDAFOI.EQ.0) THEN
- CALL FZITRN (LQ(LUHEAI),NWUHI)
- ELSE
- CALL MZIOCR (IOCHI)
- CALL FZITRX (LQ(LUHEAI),NWUHI)
- ENDIF
-#endif
- IF (IFLAGI.NE.0) GO TO 999
- N4SKII = NWUHA - NWUHI
-
-#if defined(CERNLIB_QDEBPRI)
- IF (LOGLVI.GE.3) THEN
- N = MIN (8,NWUHI)
- IF (LOGLVI.GE.4) THEN
- WRITE (IQLOG,9113) NWIOI
- WRITE (IQLOG,9115) (IOCHI(J),J=1,NWIOI)
- N = NWUHI
- ENDIF
- WRITE (IQLOG,9114) NWUHI,N
- WRITE (IQLOG,9115) (LQ(LUHEAI+J),J=0,N-1)
- ENDIF
- 9113 FORMAT (10X,I2,' words I/O characteristic for UHV =')
- 9114 FORMAT (10X,I4,' words of User Header accepted, dump the first'
- F,I5)
-#endif
-#if (defined(CERNLIB_QDEBPRI))&&(!defined(CERNLIB_HEX))
- 9115 FORMAT (1X,4O23)
-#endif
-#if (defined(CERNLIB_QDEBPRI))&&(defined(CERNLIB_HEX))
- 9115 FORMAT (10X,4Z17)
-#endif
-
-
-C---- Read the Segment Table
-
- 121 LFISEG = LQFI + JAUSEG
- IF (NWSEGI.EQ.0) GO TO 124
-
-#if defined(CERNLIB_FQXISN)
- CALL FZITRN (IQ(KQSP+LFISEG+1),NWSEGI)
-#endif
-#if !defined(CERNLIB_FQXISN)
- IF (IDAFOI.EQ.0) THEN
- CALL FZITRN (IQ(KQSP+LFISEG+1),NWSEGI)
- ELSE
- NSEG = NWSEGI / 3
- MFO(1) = 5
- MFO(2) = -1
- JFOEND = 2
- CALL FZITRX (IQ(KQSP+LFISEG+1),2*NSEG)
- IF (IFLAGI.NE.0) GO TO 999
- MFO(1) = 1
- MFO(2) = -1
- CALL FZITRX (IQ(KQSP+LFISEG+1+2*NSEG),NSEG)
- ENDIF
-#endif
- IF (IFLAGI.NE.0) GO TO 999
-
- 124 IQ(KQSP+LFISEG) = NWSEGI
-
-C---- Read the Text Vector
-
- LTEXT = LQ(KQSP+LQFI-2)
- IF (LTEXT.NE.0) IQ(KQSP+LTEXT+1)=0
- IF (NWTXI.EQ.0) GO TO 141
-
- IF (LTEXT.EQ.0) THEN
- N4SKII = N4SKII + NWTXI
- GO TO 141
- ENDIF
-
-C-- increase the size of the text buffer if necessary
-
- NINC = NWTXI + 4 - IQ(KQSP+LTEXT-1)
- IF (NINC.GT.0) THEN
- CALL FZIREC
- CALL MZPUSH (JQPDVS,LTEXT,0,NINC,'.')
- L4STAI = 0
- CALL FZIREC
- ENDIF
-
-C-- transmit to text buffer
-
-#if defined(CERNLIB_FQXISN)
- CALL FZITRN (IQ(KQSP+LTEXT+5),NWTXI)
-#endif
-#if !defined(CERNLIB_FQXISN)
- IF (IDAFOI.EQ.0) THEN
- CALL FZITRN (IQ(KQSP+LTEXT+5),NWTXI)
- ELSE
- MFO(1) = 5
- MFO(2) = 0
- JFOEND = 2
- JFOREP = 0
- CALL FZITRX (IQ(KQSP+LTEXT+5),NWTXI)
- ENDIF
-#endif
- IF (IFLAGI.NE.0) GO TO 999
- IQ(KQSP+LTEXT+1) = NWTXI
-
-C---- No early table words
-
- 141 LFIEAR = LQFI + JAUEAR
- IQ(KQSP+LFIEAR) = 0
-
- CALL FZIREC
- GO TO 999
-
-C-------------------------------------------------
-C- READ TABLE
-C-------------------------------------------------
-
- 201 L4STAI = 0
- IFLAGI = 0
- CALL FZIREC
- LIN = LQTA + NWTABI
-#if defined(CERNLIB_FQXISN)
- CALL FZITRN (LQ(LIN),NWTABI)
-#endif
-#if !defined(CERNLIB_FQXISN)
- IF (IDAFOI.EQ.0) THEN
- CALL FZITRN (LQ(LIN),NWTABI)
- ELSE
- MFO(1) = 1
- MFO(2) = -1
- JFOEND = 2
- CALL FZITRX (LQ(LIN),NWTABI)
- ENDIF
-#endif
- IF (IFLAGI.NE.0) GO TO 999
- CALL FZIREC
- GO TO 999
-
-C-------------------------------------------------
-C- READ THE DATA
-C-------------------------------------------------
-
- 301 L4STAI = 0
- IFLAGI = 0
- CALL FZIREC
- LMT = LQMTA
- 302 IF (LQ(LMT+1).NE.0) GO TO 311
-
-C---- Skip segment to be ignored
-
- N4SKII = N4SKII - LQ(LMT+3)
- GO TO 348
-
-C-------- Read segment to accept
-
- 311 LSTA = LQ(LMT+3)
- LEND = LQ(LMT+4)
-#if !defined(CERNLIB_FQXISN)
- IF (IDAFOI.EQ.0) GO TO 341
-
-C------ Read segment in exchange mode, bank-by-bank
-
- LIN = LSTA
-
-C- Next bank : first word
- 322 MFO(1) = 1
- MFO(2) = -1
- JFOEND = 2
- CALL FZITRX (LQ(KQS+LIN),1)
- IF (IFLAGI.NE.0) GO TO 999
- IWD = LQ(KQS+LIN)
- NST = JBYT (IWD,1,16) - 12
-#endif
-#if (!defined(CERNLIB_FQXISN))&&(defined(CERNLIB_QDEBPRI))
- IF (LOGLVI.GE.4) WRITE (IQLOG,9322) LIN,L4CURI-L4STAI-1,NST
- 9322 FORMAT (' FZIFFX- Next bank : Lst, NWdone, NIO+NL =',I9,2I6)
-#endif
-#if !defined(CERNLIB_FQXISN)
- IF (NST.LT.0) GO TO 326
-
-C-- True bank
-
- IQLN = LIN
- IQLS = LIN + NST + 1
- IF (IQLS+8.GE.LEND) GO TO 752
-
-C- I/O words, links, next-link, up-link
- MFO(1) = 1
- MFO(2) = NST + 2
-
-C- origin, numeric ID
- MFO(3) = 2
- MFO(4) = 2
-
-C- Hollerith ID
- MFO(5) = 5
- MFO(6) = 1
-
-C- NL, NS, ND, status
- MFO(7) = 1
- MFO(8) = -1
- JFOEND = 8
- CALL FZITRX (LQ(KQS+LIN+1), NST+9)
- IF (IFLAGI.NE.0) GO TO 999
- IQNIO = JBYT (IQ(KQS+IQLS),19,4)
- IQNL = IQ(KQS+IQLS-3)
- IQND = IQ(KQS+IQLS-1)
-#endif
-#if (!defined(CERNLIB_FQXISN))&&(defined(CERNLIB_QDEBPRI))
- IF (LOGLVI.GE.4) THEN
- IQID = IQ(KQS+IQLS-4)
- WRITE (IQLOG,9323) IQID,IQNL,IQND,IQNIO
- ENDIF
- 9323 FORMAT (' FZIFFX- ID,NL,ND,NIO = ',A4,2I8,I4)
-#endif
-#if !defined(CERNLIB_FQXISN)
- IF (IQNIO+IQNL.NE.NST) GO TO 751
- IF (IQND.LT.0) GO TO 751
-
-C- data words
- LIN = IQLS + IQND + 9
- IF (IQND.EQ.0) GO TO 324
- IF (LIN.GT.LEND) GO TO 753
-
- CALL MZIOCR (LQ(KQS+IQLN))
- CALL FZITRX (IQ(KQS+IQLS+1), IQND)
- IF (IFLAGI.NE.0) GO TO 999
- 324 IF (LIN.LT.LEND) GO TO 322
- GO TO 348
-
-C-- Short dead region
-
- 326 NWD = JBYT (IWD,17,IQDROP-17)
- IF (NWD.EQ.0) GO TO 751
- IF (NWD.NE.NST+12) GO TO 751
- IF (JBYT(IWD,IQDROP,IQBITW-IQDROP).NE.1) GO TO 751
- IF (NWD.GT.1) THEN
- IF (LIN+NWD.GT.LEND) GO TO 754
- MFO(1) = 0
- MFO(2) = -1
- JFOEND = 2
- CALL FZITRX (LQ(KQS+LIN+1), NWD-1)
- IF (IFLAGI.NE.0) GO TO 999
- ENDIF
- LIN = LIN + NWD
- IF (LIN.LT.LEND) GO TO 322
- GO TO 348
-#endif
-
-C------ Read segment in native mode
-
- 341 CALL FZITRN (LQ(KQS+LSTA),LEND-LSTA)
- IF (IFLAGI.NE.0) GO TO 999
-
-C-- Verify bank chaining
-
- LIN = LSTA
- 344 IWD = LQ(KQS+LIN)
- NST = JBYT (IWD,1,16) - 12
- IF (NST.LT.0) GO TO 346
-
-C-- True bank
-
- IQLN = LIN
- IQLS = LIN + NST + 1
- IF (IQLS+8.GE.LEND) GO TO 752
-
- IQNIO = JBYT (IQ(KQS+IQLS),19,4)
- IQNL = IQ(KQS+IQLS-3)
- IQND = IQ(KQS+IQLS-1)
- IF (IQNIO+IQNL.NE.NST) GO TO 751
- IF (IQND.LT.0) GO TO 751
-
- LIN = IQLS + IQND + 9
- IF (LEND-LIN) 753, 348, 344
-
-C-- Short dead region
-
- 346 NWD = JBYT (IWD,17,IQDROP-17)
- IF (NWD.EQ.0) GO TO 751
- IF (NWD.NE.NST+12) GO TO 751
- IF (JBYT(IWD,IQDROP,IQBITW-IQDROP).NE.1) GO TO 751
- LIN = LIN + NWD
- IF (LEND-LIN) 754, 348, 344
-
-C---- End of segment
-
- 348 LMT = LMT + 8
- IF (LMT.LT.LQMTE) GO TO 302
-
- IF (N4SKII.NE.0) THEN
-#if defined(CERNLIB_FQXISN)
- CALL FZITRN (IPILI,0)
-#endif
-#if !defined(CERNLIB_FQXISN)
- IF (IDAFOI.EQ.0) THEN
- CALL FZITRN (IPILI,0)
- ELSE
- CALL FZITRX (IPILI,0)
- ENDIF
-#endif
- IF (IFLAGI.NE.0) GO TO 999
- ENDIF
- CALL FZIREC
- IF (N4RESI.NE.0) GO TO 755
- GO TO 999
-
-C-------------------------------------------------
-C- START / END-OF-RUN
-C-------------------------------------------------
-
- 422 LUHEAI = LQWKFZ
- NWUHI = MIN (IDI(1), NQWKTT)
-#if defined(CERNLIB_FQXISN)
- CALL FZITRN (LQ(LUHEAI),NWUHI)
-#endif
-#if !defined(CERNLIB_FQXISN)
- IF (IDAFOI.EQ.0) THEN
- CALL FZITRN (LQ(LUHEAI),NWUHI)
- ELSE
- MFO(1) = 2
- MFO(2) = -1
- JFOEND = 2
- CALL FZITRX (LQ(LUHEAI),NWUHI)
- ENDIF
-#endif
- IF (IFLAGI.NE.0) GO TO 999
-
- CALL FZIREC
- JRETCD = -2
- IQ(KQSP+LBPARI-7) = 0
- GO TO 999
-
-C-------------------------------------------------
-C- ERROR CONDITIONS
-C-------------------------------------------------
-
-#if defined(CERNLIB_FZMEMORY)||defined(CERNLIB_FZCHANNEL)
-C- JERROR = 240 user routine or buffer not connected for C/M mode
- 740 JERROR = 240
- JRETCD = 4
- GO TO 999
-#endif
-
-C-- Bad construction
-
-C- JERROR = 241 check-word which should be 12345.0 is wrong
- 741 JERROR = 241
- IQUEST(14)= 0
- IQUEST(15)= 0
- IQUEST(16)= IPILI(1)
- IQUEST(17)= ICHDAT
- NWERR = 4
- GO TO 749
-
-C- JERROR = 242 control wd of I/O char. for user header invalid
- 742 JERROR = 242
- IQUEST(14)= NWUHCI
- IQUEST(15)= 0
- IQUEST(16)= IOCHI(1)
- NWERR = 3
- GO TO 749
-
-C- JERROR = 243 NWSEGI or NWTXI wrong
- 743 JERROR = 243
- IQUEST(14)= NWSEGI
- IQUEST(15)= NWTXI
- NWERR = 2
- GO TO 749
-
-C- JERROR = 244 NWTABI or NWBKI wrong
- 744 JERROR = 244
- IQUEST(14)= NWTABI
- IQUEST(15)= NWBKI
- NWERR = 2
- GO TO 749
-
-C- JERROR = 245 NWUHCI wrong
- 745 JERROR = 245
- IQUEST(14)= NWUHCI
- NWERR = 2
-
- 749 JRETCD = 6
- GO TO 780
-
-C-- Bad data
-
-C- JERROR = 251 inconsistent bank parameters
- 751 JERROR = 251
- GO TO 759
-
-C- JERROR = 252 link part of bank overshoots segment end
- 752 JERROR = 252
- GO TO 759
-
-C- JERROR = 253 data part of bank overshoots segment end
- 753 JERROR = 253
- GO TO 759
-
-C- JERROR = 254 short dead region overshoots segment end
- 754 JERROR = 254
- GO TO 759
-
-C- JERROR = 255 bank material does not end exactly with LR
- 755 JERROR = 255
-
- 759 JRETCD = 5
-
- 780 IQ(KQSP+LBPARI-9) = -3
- IQ(KQSP+LBPARI-1) = 0
-#include "zebra/qtrace99.inc"
- RETURN
- END
diff --git a/src/packlib/zebra/fq/fzilin.F b/src/packlib/zebra/fq/fzilin.F
deleted file mode 100644
index ff3084c..0000000
--- a/src/packlib/zebra/fq/fzilin.F
+++ /dev/null
@@ -1,57 +0,0 @@
-*
-* $Id: fzilin.F,v 1.2 1999/06/18 13:28:58 couet Exp $
-*
-* $Log: fzilin.F,v $
-* Revision 1.2 1999/06/18 13:28:58 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:13 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE FZILIN
-
-C- Chain banks into one linear structure, clear all links
-
-#include "zebra/mqsys.inc"
-#include "zebra/mzcn.inc"
-#include "zebra/mzct.inc"
-*
-
-
- IQFOUL = 0
- LENTRI = 0
-
- K = 0
- LMT = LQMTA
- 22 IF (LQ(LMT+1).LE.0) GO TO 29
- IQNX = LQ(LMT+3)
- LEND = LQ(LMT+4)
-
- 24 CALL MZCHLN (-7,IQNX)
- IF (IQFOUL.NE.0) GO TO 91
- IF (IQND.LT.0) GO TO 27
- IF (K.EQ.0) THEN
- LENTRI = IQLS
- ELSE
- LQ(KQS+K) = IQLS
- ENDIF
-
- L = IQLS - IQNL - 1
- DO 26 J=1, IQNL+2
- 26 LQ(KQS+L+J) = 0
- LQ(KQS+IQLS+2) = K
- K = IQLS
- 27 IF (IQNX.LT.LEND) GO TO 24
- IF (IQNX.NE.LEND) GO TO 91
-
- 29 LMT = LMT + 8
- IF (LMT.LT.LQMTE) GO TO 22
- IQUEST(1) = LENTRI
- RETURN
-
- 91 IQFOUL = 7
- RETURN
- END
diff --git a/src/packlib/zebra/fq/fzimtb.F b/src/packlib/zebra/fq/fzimtb.F
deleted file mode 100644
index 8ea3506..0000000
--- a/src/packlib/zebra/fq/fzimtb.F
+++ /dev/null
@@ -1,399 +0,0 @@
-*
-* $Id: fzimtb.F,v 1.3 1999/06/18 13:29:00 couet Exp $
-*
-* $Log: fzimtb.F,v $
-* Revision 1.3 1999/06/18 13:29:00 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.2 1996/04/18 16:10:34 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:14 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE FZIMTB
-
-C- ready memory occupation table for input
-C- ready space for the relocation table
-C- called from FZIN
-
-#include "zebra/zbcd.inc"
-#include "zebra/zmach.inc"
-#include "zebra/zunit.inc"
-#include "zebra/mqsys.inc"
-#include "zebra/eqlqf.inc"
-#include "zebra/mzcn.inc"
-#include "zebra/mzct.inc"
-#include "zebra/fzci.inc"
-#include "zebra/fzcseg.inc"
-#include "zebra/fzcocc.inc"
-*
-
- DIMENSION ITOSOR(20), ISORDV(20), ISORSP(20)
- DIMENSION LSTAV(20), LENDV(20)
- EQUIVALENCE (LSTAV(1),IQUEST(60)), (LENDV(1),IQUEST(80))
-
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HFZIM, 4HTB /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HFZIMTB /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'FZIMTB ')
-#endif
-
-#include "zebra/q_shiftl.inc"
-#include "zebra/q_jbyt.inc"
-
-C---- Input information
-
-C- if NQSEG = 0 : read non-segmented
-
-C- if NQSEG > 0 : read segmented according to :
-C- IQSEGD segment selection table set by the user
-C- IQ(LFISEG+1) copy of the segmentation table from the pilot
-
-C---- Output information
-
-C- The memory occupation table at LQ(LQMTA) ready for the material
-C- to be accepted :
-C- skip : LQ(LMT) = 0
-C- LQ(LMT+1) = 0
-C- LQ(LMT+3) = -NW words to be skipped
-
-C- read : LQ(LMT) = JDIV
-C- LQ(LMT+1) = 1
-C- LQ(LMT+3) = LSTA
-C- LQ(LMT+4) = LEND
-
-C- The space at LQ(LQTA) ready (and big enough) to receive
-C- the relocation table.
-
-C- The common /FZOCC/ indicates the amount of space IQOCSP(J)
-C- reserved at the end/start of division IQOCDV(J) for J=1,NQOCC
-C- and blocked by a dummy bank.
-
-
-#include "zebra/qtrace.inc"
-
- IFLGAR = 0
- IF (NQSEG.LE.0) THEN
-
-C-- Single segment
-
- NQSEG = 1
- NSOR = 1
- NOCC = 1
- ITOSOR(1) = 1
- IQSEGD(1) = JQDIVI
- ISORDV(1) = JQDIVI
- IQOCDV(1) = JQDIVI
- ISORSP(1) = NWBKI
- IQOCSP(1) = NWBKI
- GO TO 41
- ENDIF
-
-C-- Multiple segments, tidy division numbers
-
-#if defined(CERNLIB_QDEBPRI)
- IF (LOGLVI.GE.3) WRITE (IQLOG,9016) (J,
- + IQSEGH(1,J),IQSEGH(2,J),IQSEGD(J),J=1,NQSEG)
- 9016 FORMAT (1X/' FZIMTB- Segment Selection Table as set by the user'
-#endif
-#if (defined(CERNLIB_QDEBPRI))&&(!defined(CERNLIB_HEX))
- F/(10X,I2,1X,2A4,O23))
-#endif
-#if (defined(CERNLIB_QDEBPRI))&&(defined(CERNLIB_HEX))
- F/(10X,I2,1X,2A4,Z17))
-#endif
-
- LFISEG = LQFI + JAUSEG
- IF (3*NQSEG.NE.IQ(KQSP+LFISEG)) GO TO 715
- LSPACE = KQSP + LFISEG + 2*NQSEG
-
- DO 27 JS=1,NQSEG
- IXDIV = IQSEGD(JS)
- IF (IXDIV) 22, 23, 24
- 22 IF (IXDIV.LT.-7) GO TO 714
- ITOSOR(JS) = -IQ(LSPACE+JS)
- GO TO 27
-
- 23 JDIV = JQDIVI
- GO TO 25
-
- 24 JDIV = JBYT (IXDIV,1,26)
- IF (JDIV.GT.20) GO TO 714
- JSTO = JBYT (IXDIV,27,4)
- IF (JSTO.NE.0) THEN
- IF (JSTO.NE.JQSTOR) GO TO 714
- ENDIF
-
- IF (JDIV.EQ.0) GO TO 23
- IF (JDIV.GT.JQDVLL) THEN
- IF (JDIV.LT.JQDVSY) GO TO 714
- ENDIF
-
- 25 IQSEGD(JS) = JDIV
- ITOSOR(JS) = 0
- 27 CONTINUE
-
-C---- Construct tables sorted by division number
-
-C- ISOR table : one entry per segment
-C- IQOC table : one entry per target division
-
- NSOR = 0
- NOCC = 0
- JANX = 1
- JENX = NQSEG
-
-C-- Find largest division number not yet done
-
- 31 JDVBIG = 0
- JA = JANX
- JANX = 0
- JE = JENX
- JENX = 0
- DO 35 JS=JA,JE
- IF (ITOSOR(JS).NE.0) GO TO 35
- JENX = JS
- IF (JANX.EQ.0) JANX=JS
- JDIV = IQSEGD(JS)
- IF (JDIV.LE.JDVBIG) GO TO 35
- JDVBIG = JDIV
- JSBIG = JS
- 35 CONTINUE
- IF (JDVBIG.EQ.0) GO TO 41
-
- NSOR = NSOR + 1
- ITOSOR(JSBIG) = NSOR
- ISORDV(NSOR) = JDVBIG
- ISORSP(NSOR) = IQ(LSPACE+JSBIG)
-
- NOCC = NOCC + 1
- IQOCDV(NOCC) = JDVBIG
- IQOCSP(NOCC) = IQ(LSPACE+JSBIG)
-
-C-- Find further segments for the same division
-
- IF (JSBIG.EQ.JENX) GO TO 31
- DO 37 JS=JSBIG+1,JENX
- IF (ITOSOR(JS).NE.0) GO TO 37
- IF (IQSEGD(JS).NE.JDVBIG) GO TO 37
- NSOR = NSOR + 1
- ITOSOR(JS) = NSOR
- ISORDV(NSOR) = JDVBIG
- ISORSP(NSOR) = IQ(LSPACE+JS)
- IQOCSP(NOCC) = IQOCSP(NOCC) + IQ(LSPACE+JS)
- 37 CONTINUE
- GO TO 31
-
-C---- Reserve space in divisions
-
- 41 IF (NOCC.EQ.0) GO TO 81
- JOCC = 0
- 42 JOCC = JOCC + 1
- JQDIVI = IQOCDV(JOCC)
- NW = IQOCSP(JOCC)
- CALL MZRESV
- NQRESV = NQRESV - NW
- IF (NQRESV.LT.0) CALL MZGAR1
-
-C-- Forward division
-
- IF (JQMODE.EQ.0) THEN
- IQLN = LQEND(KQT+JQDIVI)
- IQNX = IQLN + NW
- LQEND(KQT+JQDIVI) = IQNX
-
-C-- Reverse division
-
- ELSE
- IQNX = LQSTA(KQT+JQDIVI)
- IQLN = IQNX - NW
- LQSTA(KQT+JQDIVI) = IQLN
- ENDIF
- NQOCC = JOCC
-
-C-- Fill space reserved with dummy bank
-
- LQ(KQS+IQLN) = 12
- LQ(KQS+IQLN+1) = 0
- LQ(KQS+IQLN+2) = 0
- LQ(KQS+IQLN+3) = 0
- LQ(KQS+IQLN+5) = IQLETT(1)
- LQ(KQS+IQLN+6) = 0
- LQ(KQS+IQLN+7) = 0
- LQ(KQS+IQLN+8) = NW - 10
- LQ(KQS+IQLN+9) = 0
- IF (JOCC.NE.NOCC) GO TO 42
-
-C---- Allocate space for the relocation tables
-
- 46 NWTR = 2*NWTABI + 2
- NWTM = 8*NQSEG
- IF (NWTR+NWTM.LT.NQWKTB) THEN
-C-- Both tables in the normal work area
- LQMTA = LQWKTB
- LQRTA = LQMTA + NWTM
- ELSE
- JQSTMV = -1
- CALL MZFGAP
- IF (NQGAPN.EQ.0) GO TO 61
- IF (IQGAP(1,1).LT.NWTR) THEN
-C-- MO table in the (smaller) gap, LR table in area
- IF (NQWKTB.LT.NWTR) GO TO 61
- LQMTA = IQGAP(2,1)
- LQRTA = LQWKTB
- ELSE
-C-- MO table in area, LR table in (bigger) gap
- LQMTA = LQWKTB
- LQRTA = IQGAP(2,1)
- ENDIF
- ENDIF
-
- LQMTE = LQMTA + NWTM
- LQTA = LQRTA + 1
- LQTE = LQTA + 2*NWTABI
- LQRTE = LQTE
-#if defined(CERNLIB_QDEVZE)
- IF (LOGLVI.GE.4) WRITE (IQLOG,9141) LQMTA,LQMTE,LQTA,LQTE
- 9141 FORMAT (' FZIMTB- Tables : LQMTA,LQMTE,LQTA,LQTE=',4I9)
-#endif
-
-C---- Calculate start adrs on the sorted table
-
- JSOR = 1
- JOCC = 1
- 52 JQDIVI = ISORDV(JSOR)
-
- IF (IQMODE(KQT+JQDIVI).EQ.0) THEN
- LSTA = LQEND(KQT+JQDIVI) - IQOCSP(JOCC)
- ELSE
- LSTA = LQSTA(KQT+JQDIVI)
- ENDIF
-
- LEND = LSTA + ISORSP(JSOR)
-
- LENDV(JSOR) = LEND
- LSTAV(JSOR) = LSTA
- JOCC = JOCC + 1
-
- 54 IF (JSOR.EQ.NSOR) GO TO 55
- JSOR = JSOR + 1
- IF (ISORDV(JSOR).NE.JQDIVI) GO TO 52
- LSTA = LEND
- LEND = LSTA + ISORSP(JSOR)
- LENDV(JSOR) = LEND
- LSTAV(JSOR) = LSTA
- GO TO 54
-
-C---- Transfer the information from the sorted table
-C- to the memory occupation table
-
- 55 LMT = LQMTA
-
- DO 59 JS=1,NQSEG
- JSOR = ITOSOR(JS)
- IF (JSOR.GE.0) GO TO 57
- LQ(LMT) = 0
- LQ(LMT+1) = 0
- LQ(LMT+2) = 0
- LQ(LMT+3) = JSOR
- LQ(LMT+4) = JSOR
- LQ(LMT+5) = 0
- LQ(LMT+6) = 0
- LQ(LMT+7) = 0
-#if defined(CERNLIB_QDEBPRI)
- IF (LOGLVI.GE.3) WRITE (IQLOG,9055) JS, -JSOR
- 9055 FORMAT (' FZIMTB- skip segment',I3,I9,' WORDS')
-#endif
- GO TO 59
-
- 57 LQ(LMT) = ISORDV(JSOR)
- LQ(LMT+1) = 1
- LQ(LMT+2) = 0
- LQ(LMT+3) = LSTAV(JSOR)
- LQ(LMT+4) = LENDV(JSOR)
- LQ(LMT+5) = 0
- LQ(LMT+6) = 0
- LQ(LMT+7) = 0
-#if defined(CERNLIB_QDEBPRI)
- IF (LOGLVI.GE.3) THEN
- WRITE (IQLOG,9058) JS,LQ(LMT),LQ(LMT+3),LQ(LMT+4)
- ENDIF
- 9058 FORMAT (' FZIMTB- read segment',I3,' into division/from/to'
- F,I3,2I9)
-#endif
- 59 LMT = LMT + 8
-#include "zebra/qtrace99.inc"
- RETURN
-
-C------ Garbage collection to make room for the table
-
- 61 IF (IFLGAR.GE.2) GO TO 721
- IXSTOR = ISHFTL (JQSTOR,26)
- IF (IFLGAR.NE.0) GO TO 63
-
- IXSTOR = MZIXCO (IXSTOR+21,22,23,24)
- CALL MZGARB (IXSTOR, 0)
- IFLGAR = 1
- IF (JQSTOR.NE.0) GO TO 46
- IFLGAR = 2
- GO TO 46
-
-C-- Collect also the primary store
-
- 63 IFLGAR = 2
- J = MZIXCO (21,22,23,24)
- CALL MZGARB (J, 0)
- CALL MZSDIV (IXSTOR,-7)
- GO TO 46
-
-C---- All segments to be skipped
-
- 81 NWBKI = 0
- JRETCD = -4
-#if defined(CERNLIB_QDEBPRI)
- IF (LOGLVI.GE.3) WRITE (IQLOG,9081)
- 9081 FORMAT (' FZIMTB- skip all segments')
-#endif
- GO TO 999
-
-C-------------------------------------------------
-C- ERROR CONDITIONS
-C-------------------------------------------------
-
-C---- User error
-
-C- JERROR = 15 NQSEG has been changed by the user
- 715 JERROR = 15
- IQUEST(14)= NQSEG
- IQUEST(15)= IQ(KQSP+LFISEG)
- NWERR = 2
- GO TO 719
-
-C- JERROR = 14 invalid division number in segment table
- 714 JERROR = 14
- IQUEST(14)= JS
- IQUEST(15)= 0
- IQUEST(16)= IXDIV
- NWERR = 3
-
- 719 JRETCD = 4
- GO TO 999
-
-C---- Not enough space
-
-C- JERROR = 21 not enough space
- 721 JERROR = 21
-
- JRETCD = 3
- GO TO 999
- END
diff --git a/src/packlib/zebra/fq/fzin.F b/src/packlib/zebra/fq/fzin.F
deleted file mode 100644
index 17d59e9..0000000
--- a/src/packlib/zebra/fq/fzin.F
+++ /dev/null
@@ -1,398 +0,0 @@
-*
-* $Id: fzin.F,v 1.3 1999/06/18 13:29:02 couet Exp $
-*
-* $Log: fzin.F,v $
-* Revision 1.3 1999/06/18 13:29:02 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.2 1996/04/18 16:10:36 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:14 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE FZIN (LUNP,IXDIVP,LSUPP,JBIASP,CHOPT,NUHP,IUHEAD)
-
-C- MAIN SEQUENTIAL INPUT ROUTINE, USER CALLED
-
-#include "zebra/zbcd.inc"
-#include "zebra/zmach.inc"
-#include "zebra/zunit.inc"
-#include "zebra/zvfaut.inc"
-#include "zebra/mqsys.inc"
-#include "zebra/eqlqf.inc"
-#include "zebra/mzcn.inc"
-#include "zebra/mzct.inc"
-#include "zebra/fzci.inc"
-#include "zebra/fzcseg.inc"
-#include "zebra/fzcocc.inc"
-*
- DIMENSION LUNP(9),IXDIVP(9),LSUPP(9),JBIASP(9)
- DIMENSION NUHP(9),IUHEAD(99)
- DIMENSION MOPTV(6)
- EQUIVALENCE (MOPTV(1),IOPTIE)
- EQUIVALENCE (LRTYP,IDI(2))
- CHARACTER CHOPT*(*)
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HFZIN, 4H /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HFZIN /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'FZIN ')
-#endif
-
-
-#include "zebra/qtrace.inc"
-
- LUNNI = LUNP(1)
- IXDIVI = IXDIVP(1)
- CALL UOPTC (CHOPT,'ERSATDFGH234',IOPTIE)
- IOPTIF = IOPTIF + IOPTIG + IOPTIH
- IF (IOPTI2(1).NE.0) IOPTIR = 2
- IF (IOPTI2(2).NE.0) IOPTIR = 3
- IF (IOPTI2(3).NE.0) IOPTIR = 4
-
-C-- Set current input unit
-
- IF (LUNNI.NE.LUNI) CALL FZLOC (LUNNI,1)
-#if defined(CERNLIB_QDEBPRI)
- IF (LOGLVI.GE.2) THEN
- IF (LOGLVI.GE.3) WRITE (IQLOG,9110)
- WRITE (IQLOG,9111) LUNNI,NUHP(1),MOPTV
- ENDIF
- 9110 FORMAT (1X)
- 9111 FORMAT (' FZIN- Entered for LUN=',I4,' NUH=',I5,
- F' E/R/S/A/T/D= ',6I1)
-#endif
-
- NWRDAI = IQ(KQSP+LQFI+20)
- NRECAI = IQ(KQSP+LQFI+21)
- JRETCD = 0
- JERROR = 0
- NWERR = 0
- NQOCC = 0
- JOPT = IOPTIT + IOPTIA + IOPTID
- IF (JOPT.EQ.0) GO TO 141
-
-C-- Re-entry for pending d/s
-
- IF (IOPTIR.NE.0) GO TO 714
- LRTYP = IQ(KQSP+LQFI+27)
- NWTABI = IQ(KQSP+LQFI+41)
- NWBKI = IQ(KQSP+LQFI+42)
- LENTRI = IQ(KQSP+LQFI+43)
- IF (JOPT.GE.2) GO TO 711
- IF (LRTYP.GE.5) GO TO 712
- IF (LRTYP.LE.1) GO TO 712
- IF (IOPTIT.NE.0) GO TO 121
- IEVFLI = 3 - LRTYP
- NWUMXI = 0
- IF (IOPTIA.NE.0) GO TO 154
- GO TO 151
-
-C---- Ready segment table for the user
-
- 121 LFISEG = LQFI + JAUSEG
- NQSEG = IQ(KQSP+LFISEG) / 3
- IF (NQSEG.NE.0) THEN
- N = 2*NQSEG
- CALL UCOPY (IQ(KQSP+LFISEG+1),IQSEGH,N)
- CALL VZERO (IQSEGD,NQSEG)
- ENDIF
- IQSGLU = LUNI
- IQUEST(1) = 0
- GO TO 999
-
-C-----------------------------------------------------
-C- obtain and digest next pilot record
-C-----------------------------------------------------
-
- 141 IF (IACTVI.GE.6) GO TO 701
-#if defined(CERNLIB_QDEBUG)
- IF (IQVSTA.NE.0) THEN
- ISV = IQVID(2)
- CALL ZVAUTX
- IF (IQVID(2).NE.ISV) THEN
- IQVREM(1,3) = IQVID(1)
- IQVREM(2,3) = IQVID(2)
- ENDIF
- ENDIF
-#endif
- 142 NWUMXI = NUHP(1)
- NWUHI = 0
-
- JPENDG = IQ(KQSP+LQFI+30)
- IQ(KQSP+LQFI+30) = 0
- IF (JPENDG.EQ.1) GO TO 301
- IF (JPENDG.EQ.2) GO TO 311
-
-#if defined(CERNLIB_FZFFNAT)
- IF (IFIFOI.EQ.0) THEN
- CALL FZIFFN (1)
- GO TO 144
- ENDIF
-#endif
- CALL FZIFFX (1)
- 144 IF (JRETCD.NE.0) GO TO 391
-
- IF (NWBKI.EQ.0) IQ(KQSP+LQFI+17) = IQ(KQSP+LQFI+17) + 1
-
-C-- check DAT record wanted / needed
-
- IF (IOPTIF+IPILI(3).EQ.0) GO TO 145
-
- IF (IOPTIH.NE.0) THEN
- IF (IPILI(3).NE.1) GO TO 142
- GO TO 145
- ENDIF
-
- IF (IPILI(3).NE.0) THEN
- IF (IOPTIF.EQ.0) GO TO 142
- ENDIF
-
-C-- Copy header vector to user
-
- 145 IF (NWUMXI.LE.0) GO TO 146
- NWUHI = MIN (NWUHI, NWUMXI)
- NUHP(1) = NWUHI
- IF (NWUHI.GT.0) CALL UCOPY (LQ(LUHEAI),IUHEAD,NWUHI)
-
-C-- Return if selective call
-
- 146 IF (IOPTIS.EQ.0) GO TO 154
- IQ(KQSP+LQFI+41) = NWTABI
- IQ(KQSP+LQFI+42) = NWBKI
- IQ(KQSP+LQFI+43) = LENTRI
-#if defined(CERNLIB_QDEBPRI)
- IF (LOGLVI.GE.3) WRITE (IQLOG,9146)
- 9146 FORMAT (' FZIN- Exit for S option.')
-#endif
- GO TO 991
-
-C-------------------------------------------------
-C- read table and d/s, relocate
-C-------------------------------------------------
-
-C-- Re-entry with D-option
-
- 151 IF (IQSGLU.NE.LUNI) GO TO 713
- GO TO 155
-
-C-- Re-entry with A-option
-
- 154 NQSEG = 0
- 155 IF (NWBKI.NE.0) GO TO 157
-
-C-- Empty d/s
-
- LRTYP = 0
- LENTRI = 0
- GO TO 189
-
-C-- Get store / division
-
- 157 CALL MZSDIV (IXDIVI,7)
- IF (JQDIVI.EQ.0) JQDIVI=2
- LQSYSR(KQT+1) = LSUPP(1)
-
-#if defined(CERNLIB_QDEBPRI)
- IF (LOGLVI.GE.3)
- + WRITE (IQLOG,9157) JQSTOR,JQDIVI,NWTABI,NWBKI
- 9157 FORMAT (' FZIN- accept d/s into STORE/def.DIV.=',2I4,
- F' need memory for NWTB/NWBK=',I5,I7)
-#endif
-
-C-- Ready memory occupation table, reserve space
-
- CALL FZIMTB
- IF (JRETCD.NE.0) GO TO 390
-
-C-- Early table
-
- LFIEAR = LQFI + JAUEAR
- NTBE = IQ(KQSP+LFIEAR)
- IF (NTBE.NE.0) THEN
- LTBR = LQTA + NWTABI
- CALL UCOPY (IQ(KQSP+LFIEAR+1),LQ(LTBR),NWTABI)
- GO TO 159
- ENDIF
-
-C-- Read the long table
-
- IF (NWTABI.EQ.0) GO TO 159
-#if defined(CERNLIB_FZFFNAT)
- IF (IFIFOI.EQ.0) THEN
- CALL FZIFFN (2)
- GO TO 158
- ENDIF
-#endif
- CALL FZIFFX (2)
- 158 IF (JRETCD.NE.0) GO TO 391
-
-C-- Read the data
-
- 159 CONTINUE
-#if defined(CERNLIB_FZFFNAT)
- IF (IFIFOI.EQ.0) THEN
- CALL FZIFFN (3)
- GO TO 160
- ENDIF
-#endif
- CALL FZIFFX (3)
- 160 IF (JRETCD.NE.0) GO TO 391
-
-C-- Relocation
-
- CALL FZIREL
- IF (JRETCD.NE.0) GO TO 391
-
-C-------------------------------------------------------------
-C- done : link and return
-C-------------------------------------------------------------
-
- 181 JB = JBIASP(1)
- IF (JB.GE.2) THEN
- LSUPP(1) = LENTRI
- ELSE
- LSUPP(1) = LQSYSR(KQT+1)
- CALL ZSHUNT (IXDIVI,LENTRI,LSUPP,JB,1)
- ENDIF
-
- IQ(KQSP+LQFI+16) = IQ(KQSP+LQFI+16) + 1
-
- 189 LRTYP = 8
-#if defined(CERNLIB_QDEBPRI)
- IF (LOGLVI.GE.3) WRITE (IQLOG,9189) NWTABI,NWBKI,IEVFLI
- 9189 FORMAT (' FZIN- exit for d/s with NWTB,NWBK,IEVENT=',
- F 2I6,I9,I2)
-#endif
- GO TO 991
-
-C-------------------------------------------------------------
-C- Exit to exceptions
-C-------------------------------------------------------------
-
-C-- Pending EoF
-
- 301 JRETCD = -1
- GO TO 781
-
-C-- Pending start/end of run
-
- 311 LFIIOC = LQFI + JAUIOC
- NWUHI = IQ(KQSP+LFIIOC)
- LUHEAI = LQWKFZ
- CALL UCOPY (IQ(KQSP+LFIIOC+1),LQ(LUHEAI),NWUHI)
- JRETCD = -2
- GO TO 421
-
-C-- Side exceptions
-
- 390 IF (JRETCD.LT.0) GO TO 155
- 391 IF (JRETCD.NE.-2) GO TO 781
-
-C-------------------------------------------------
-C- end-of-file / end-of-run
-C-------------------------------------------------
-
-C---- Normal S/E-OF-RUN
-
- 421 CALL FZIDIA
- IF (LQ(LUHEAI).GT.0) GO TO 424
-
-C-- End of run
-
- IF (IOPTIR.EQ.1) GO TO 142
- IF (IOPTIR.GE.IACTVI) GO TO 142
- GO TO 427
-
-C-- Start of run
-
- 424 IF (IOPTIR.GE.2) GO TO 142
- 427 IF (NWUMXI.LE.0) GO TO 997
- NWUHI = MIN (NWUHI-1, NWUMXI)
- NUHP(1) = NWUHI
- IF (NWUHI.GT.0) CALL UCOPY (LQ(LUHEAI+1),IUHEAD(1),NWUHI)
- GO TO 997
-
-C-------------------------------------------------
-C- ERROR CONDITIONS
-C-------------------------------------------------
-
-C-- Reading beyond end-of-data
-
- 701 IF (IACTVI.EQ.8) GO TO 142
- IF (IACTVI.EQ.18) GO TO 142
- JRETCD = -3
- GO TO 781
-
-C---- User error
-
-C- JERROR = 14 options (R,2,3,4) not allowed with (T,A,D)
- 714 JERROR = 1
-
-C- JERROR = 13 no segment table for entry with D option
- 713 JERROR = JERROR + 1
-
-C- JERROR = 12 no pending d/s for entry with T A D options
- 712 JERROR = JERROR + 1
-
-C- JERROR = 11 multiple options T A D not allowed
- 711 JERROR = 11 + JERROR
- JRETCD = 4
-
-C------ Print error message
-
- 781 CALL FZIDIA
-
-C-- Abandon reserved space, if any
-
- IF (NQOCC.EQ.0) GO TO 997
- DO 784 J=1,NQOCC
- JDIV = IQOCDV(J)
- NW = IQOCSP(J)
- IF (IQMODE(KQT+JDIV).EQ.0) THEN
- LQEND(KQT+JDIV) = LQEND(KQT+JDIV) - NW
- ELSE
- LQSTA(KQT+JDIV) = LQSTA(KQT+JDIV) + NW
- ENDIF
- 784 CONTINUE
- GO TO 997
-
-C-- Common exit
-
- 991 IQUEST(1) = 0
- IQUEST(5) = IQ(KQSP+LQFI+31)
- IQUEST(6) = IQ(KQSP+LQFI+32)
- IQUEST(11) = IEVFLI
- IQUEST(12) = IPILI(3)
- IQUEST(13) = LENTRI
- IQUEST(14) = NWBKI
- LFIIOC = LQFI + JAUIOC
- NWIOI = IQ(KQSP+LFIIOC)
- CALL UCOPY (IQ(KQSP+LFIIOC),IQUEST(20),NWIOI+1)
-
- IF (NWRDAI.GE.1000000) THEN
- IQ(KQSP+LQFI+19) = IQ(KQSP+LQFI+19) + 1
- NWRDAI = NWRDAI - 1000000
- ENDIF
-
- 997 IQ(KQSP+LQFI+26) = IQUEST(1)
- IQ(KQSP+LQFI+27) = LRTYP
- IQ(KQSP+LQFI+2) = IACTVI
- IQ(KQSP+LQFI+20) = NWRDAI
- IQ(KQSP+LQFI+21) = NRECAI
- IQUEST(2) = NRECAI
- IQUEST(3) = IQ(KQSP+LQFI+22)
- IQSGLU = 0
-
-#include "zebra/qtrace99.inc"
- RETURN
- END
diff --git a/src/packlib/zebra/fq/fzinfo.F b/src/packlib/zebra/fq/fzinfo.F
deleted file mode 100644
index 0b74a2b..0000000
--- a/src/packlib/zebra/fq/fzinfo.F
+++ /dev/null
@@ -1,45 +0,0 @@
-*
-* $Id: fzinfo.F,v 1.2 1999/06/18 13:29:04 couet Exp $
-*
-* $Log: fzinfo.F,v $
-* Revision 1.2 1999/06/18 13:29:04 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:14 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE FZINFO (LUNP)
-
-C- Locate FZ control-bank for unit LUN,
-C- copy control bank information to /FZSTAT/,
-C- signal failure by setting INFLUN = 0
-
-#include "zebra/mqsys.inc"
-#include "zebra/eqlqf.inc"
-#include "zebra/fzstat.inc"
-*
- DIMENSION LUNP(9)
-
-
- LUN = LUNP(1)
-
- LQFF = LQFS
- 14 IF (LQFF.NE.0) THEN
- IF (IQ(KQSP+LQFF-5).EQ.LUN) GO TO 21
- LQFF = LQ(KQSP+LQFF)
- GO TO 14
- ELSE
- INFLUN = 0
- RETURN
- ENDIF
-
-C-- Bank for LUN found
-
- 21 INFLUN = LUN
- INFSTA = IQ(KQSP+LQFF)
- CALL UCOPY (IQ(KQSP+LQFF+1), INFOFZ, 40)
- RETURN
- END
diff --git a/src/packlib/zebra/fq/fzinxt.F b/src/packlib/zebra/fq/fzinxt.F
deleted file mode 100644
index 1ed46bd..0000000
--- a/src/packlib/zebra/fq/fzinxt.F
+++ /dev/null
@@ -1,67 +0,0 @@
-*
-* $Id: fzinxt.F,v 1.2 1999/06/18 13:29:06 couet Exp $
-*
-* $Log: fzinxt.F,v $
-* Revision 1.2 1999/06/18 13:29:06 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:15 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
-#if defined(CERNLIB_FZDACC)
- SUBROUTINE FZINXT (LUNP,MDSA1,MDSA2)
-
-C- Set next d/s to be read in direct access mode, user called
-
-#include "zebra/zunit.inc"
-#include "zebra/mqsys.inc"
-#include "zebra/eqlqf.inc"
-#include "zebra/fzci.inc"
-*
- DIMENSION LUNP(9), MDSADR(2)
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HFZIN, 4HXT /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HFZINXT /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'FZINXT ')
-#endif
-
-#include "zebra/qtrace.inc"
-
- LUNNI = LUNP(1)
- MDSADR(1) = MDSA1
- MDSADR(2) = MDSA2
- IF (LUNNI.NE.LUNI) CALL FZLOC (LUNNI,1)
-#if defined(CERNLIB_QDEBPRI)
- IF (LOGLVI.GE.2) WRITE (IQLOG,9111) LUNNI,MDSADR
- 9111 FORMAT (' FZINXT- called for LUN=',I4,' d/s adr=',2I7)
-#endif
- IF (IFIFOI.NE.2) GO TO 801
-
- IACTVI = 2
- IQ(KQSP+LQFI+2) = IACTVI
- IQ(KQSP+LQFI+27) = 0
- IQ(KQSP+LQFI+31) = MDSADR(1)
- IQ(KQSP+LQFI+32) = MDSADR(2)
- IQ(KQSP+LQFI+33) = -7
-
- LBPARI = LQFI + INCBPI
- CALL VZERO (IQ(KQSP+LBPARI-9), 9)
-#include "zebra/qtrace99.inc"
- RETURN
-
- 801 CONTINUE
-#if defined(CERNLIB_QDEBPRI)
- WRITE (IQLOG,9111) LUNNI,MDSADR
-#endif
- CALL ZFATAM ('FZINXT - file not ready for direct access.')
- END
-#endif
diff --git a/src/packlib/zebra/fq/fzipha.F b/src/packlib/zebra/fq/fzipha.F
deleted file mode 100644
index 4c3c041..0000000
--- a/src/packlib/zebra/fq/fzipha.F
+++ /dev/null
@@ -1,235 +0,0 @@
-*
-* $Id: fzipha.F,v 1.3 1999/06/18 13:29:08 couet Exp $
-*
-* $Log: fzipha.F,v $
-* Revision 1.3 1999/06/18 13:29:08 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.2 1996/04/18 16:10:38 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:11 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
-#if defined(CERNLIB_FZALFA)
- SUBROUTINE FZIPHA
-
-C- Read next physical record image in ALFA exchange mode
-C- Service routine to FZIN, called only via FZIREC
-
-C- Input : IFLAGI = 0 normal read
-C- -1 recover to next steering block
-
-C- N4SKII is used for rapid skip of fast blocks
-
-C- Output : IFLAGI = 0 all is well
-C- otherwise : ready for re-start
-
-#include "zebra/zbcd.inc"
-#include "zebra/zmach.inc"
-#include "zebra/zstate.inc"
-#include "zebra/zunit.inc"
-#include "zebra/mqsys.inc"
-#include "zebra/eqlqf.inc"
-#include "zebra/fzci.inc"
-#include "fzhci.inc"
-*
-
-* Declaratives, DIMENSION etc.
-#include "fzstamp.inc"
-
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HFZIP, 4HHA /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HFZIPHA /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'FZIPHA ')
-#endif
-
-
-#include "zebra/qtrace.inc"
-
-C---- Skip to next steering block
-
- IF (IFLAGI.LT.0) THEN
- NFASTI = 0
- NRSKIP = 1
- GO TO 20
- ENDIF
-
-C---- Dedide skip of fast records
-
- N4SKIP = MIN (N4SKII,N4RESI)
- NFASTI = IQ(KQSP+LBPARI-5)
- NRSKIP = 0
- IF (N4SKIP.LT.MAXREI) GO TO 20
- IF (NFASTI.EQ.0) GO TO 20
- NRSKIP = MIN (NFASTI, N4SKIP / MAXREI)
-
- 20 NW4IN = MAXREI
- IQ(KQSP+LBPARI-6) = NFASTI
-
-
-C---- Read one physical record
-
- 31 NBLK = IQ(KQSP+LQFI+22) + 1
-#if defined(CERNLIB_QDEBPRI)
- IF (LOGLVI.GE.3)
- + WRITE (IQLOG,9031) NBLK,NW4IN,NFASTI,NRSKIP
- 9031 FORMAT (1X/' FZIPHA- Reading Block',I7,
- F', NW32,NRfast,NRskip=',4I6)
-#endif
-
- CALL FZIASC (NRSKIP)
- IF (IQUEST(1)) 841, 33, 818
- 33 JFASTR = IQUEST(92)
-
- IQ(KQSP+LQFI+22) = NBLK
- NWRDAI = NWRDAI + MAXREI
-
- IF (JFASTR.EQ.0) THEN
- LQ(L4STAI) = MCCW1
- LQ(L4STAI+1) = MCCW2
- LQ(L4STAI+2) = MCCW3
- LQ(L4STAI+3) = MCCW4
- ENDIF
-
-C-- Short/full dump of record read
-
-#if defined(CERNLIB_QDEBPRI)
- IF (LOGLVI.LT.3) GO TO 51
- IF (JFASTR.NE.0) THEN
- IF (NRSKIP.NE.0) GO TO 51
- ENDIF
-
- CALL FZIDUM (LQ(L4STAI),NW4IN)
-#endif
-
-C-----------------------------------------------------------
-C---- Fast record expected
-C-----------------------------------------------------------
-
- 51 IF (NFASTI.EQ.0) GO TO 61
- IF (JFASTR.EQ.0) GO TO 54
- NFASTI = NFASTI - 1
- IQ(KQSP+LBPARI-5) = NFASTI
- IF (NRSKIP.EQ.0) GO TO 53
-
-C-- skip record
- N4SKII = N4SKII - MAXREI
- N4RESI = N4RESI - MAXREI
- NRSKIP = NRSKIP - 1
- GO TO 20
-
-C-- deliver record
- 53 N4DONI = 0
- N4ENDI = MIN (N4RESI,MAXREI)
- IFLAGI = 0
-#include "zebra/qtrace99.inc"
- RETURN
-
-C-- Unexpected steering record
-
- 54 CALL FZICHH (0, LQ(L4STAI),0)
- IF (IQUEST(1).NE.0) GO TO 807
-
- N4ENDI = NTLRI
- IQ(KQSP+LQFI+23) = IQ(KQSP+LQFI+23) + 1
- GO TO 808
-
-C-----------------------------------------------------------
-C---- Steering record expected
-C-----------------------------------------------------------
-
- 61 IF (JFASTR.NE.0) GO TO 71
- CALL FZICHH (0, LQ(L4STAI),IFLAGI)
- IF (IQUEST(1).NE.0) GO TO 72
- N4ENDI = NTLRI
-
- IF (IFLAGI.LT.0) GO TO 73
-
- N4DONI = 8
- IF (N4ENDI.EQ.0) N4ENDI=MAXREI
-
- 62 IQ(KQSP+LQFI+23) = IQ(KQSP+LQFI+23) + 1
- IF (JRECI.NE.0) JRECI = JRECI + 1
- IQ(KQSP+LBPARI-7) = JRECI
- IQ(KQSP+LBPARI-5) = NFSTI
- IFLAGI = 0
- GO TO 999
-
-C-- Recover to next steering record
-
- 71 IF (IFLAGI.EQ.-1) GO TO 20
- GO TO 803
-
- 72 IF (IQUEST(1).EQ.3) GO TO 802
- IF (IFLAGI.EQ.-1) GO TO 20
- GO TO 801
-
-C-- Recovery to this steering record
-
- 73 IF (NTLRI.EQ.0) GO TO 20
- N4DONI = NTLRI
- GO TO 62
-
-C-----------------------------------------------------------
-C- ERROR CONDITIONS
-C-----------------------------------------------------------
-
-
-C- JERROR = 301 Block header faulty
- 801 JERROR = 301
- GO TO 817
-
-C- JERROR = 302 Block size does not match expectation
- 802 JERROR = 302
- IQUEST(14) = MAXREI
- IQUEST(15) = NWRI
- NWERR = 2
- GO TO 817
-
-C- JERROR = 303 Unexpected fast record
- 803 JERROR = 303
- GO TO 817
-
-C- JERROR = 307 Unexpected and faulty steering block
- 807 JERROR = 307
- GO TO 817
-
-C- JERROR = 308 Unexpected but valid steering block
- 808 JERROR = 308
- IQUEST(14) = NTLRI
- IQUEST(15) = LQ(L4STAI+8)
- IQUEST(16) = LQ(L4STAI+9)
- NWERR = 3
- JRETCD = 5
-
- IQ(KQSP+LBPARI-7) = 0
- IQ(KQSP+LBPARI-6) = 0
- IQ(KQSP+LBPARI-5) = NFSTI
- IQ(KQSP+LBPARI-1) = N4ENDI
- GO TO 819
-
- 817 JRETCD = 6
- 818 IQ(KQSP+LBPARI-1) = 0
- 819 IQ(KQSP+LBPARI-9)= -1
- 820 IFLAGI = 1
- GO TO 999
-
-C-- EoF seen
-
- 841 JRETCD = 1
- IQ(KQSP+LBPARI-7) = 0
- IQ(KQSP+LBPARI-5) = 0
- IQ(KQSP+LBPARI-1) = 0
- GO TO 820
- END
-#endif
diff --git a/src/packlib/zebra/fq/fziphd.F b/src/packlib/zebra/fq/fziphd.F
deleted file mode 100644
index 668c273..0000000
--- a/src/packlib/zebra/fq/fziphd.F
+++ /dev/null
@@ -1,367 +0,0 @@
-*
-* $Id: fziphd.F,v 1.3 1999/06/18 13:29:10 couet Exp $
-*
-* $Log: fziphd.F,v $
-* Revision 1.3 1999/06/18 13:29:10 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.2 1996/04/18 16:10:38 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:15 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
-#if defined(CERNLIB_FZDACC)
- SUBROUTINE FZIPHD
-
-C- Read next physical record in direct-access mode
-C- Service routine to FZIN, called only via FZIREC
-
-C- Input : IFLAGI = 0 normal read
-C- -1 recover to next steering block
-C- -2 start
-
-C- N4SKII is used for rapid skip of fast blocks
-
-C- Output : IFLAGI = 0 all is well
-C- otherwise : ready for re-start
-
-#include "zebra/zbcd.inc"
-#include "zebra/zmach.inc"
-#include "zebra/zunit.inc"
-#include "zebra/mqsys.inc"
-#include "zebra/eqlqf.inc"
-#include "zebra/fzci.inc"
-#include "fzhci.inc"
-*
-
-* Declaratives, DIMENSION etc.
-#include "fziphrd1.inc"
-* Ignoring t=pass
-
-#include "fzstamp.inc"
-#include "fzdaeof.inc"
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HFZIP, 4HHD /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HFZIPHD /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'FZIPHD ')
-#endif
-
-* Declaratives, DATA
-#include "fziphrd2.inc"
-
-
-#include "zebra/qtrace.inc"
-
- NWMREC = IQ(KQSP+LBPARI+1)
- NRSKIP = 0
-
- JRECGO = IQ(KQSP+LQFI+33)
- JRECLL = JRECGO
- IF (JRECGO.GE.0) GO TO 22
-
-C-- Random access
-
- JRECNO = IQ(KQSP+LQFI+31)
- NFASTI = 0
- GO TO 27
-
-C-- Sequential access
-
- 22 NFASTI = IQ(KQSP+LBPARI-5)
- JRECNO = JRECGO + 1
- N4SKIP = MIN (N4SKII,N4RESI)
- IF (JRECGO.EQ.0) JRECLL = -7
-
- IF (N4SKIP.GE.MAXREI) THEN
- IF (NFASTI.GT.0) THEN
- NRSKIP = MIN (NFASTI, N4SKIP / MAXREI)
- JRECNO = JRECNO + NRSKIP
- NFASTI = NFASTI - NRSKIP
- ENDIF
- ENDIF
-
- IQ(KQSP+LBPARI-6) = NFASTI
-
- 27 LIN = L4STAI
-#if defined(CERNLIB_FQNEEDPK)
- IF (IUPAKI.NE.0) GO TO 31
-
-C-- Exchange Data Format needing to be unpacked
-
- LIN = LIN + IQ(KQSP+LBPARI+3)
-#endif
-
-C---- READ ONE PHYSICAL RECORD
-
- 31 NBLK = IQ(KQSP+LQFI+22) + 1
- IQ(KQSP+LQFI+33) = JRECNO
-#if defined(CERNLIB_QDEBPRI)
- IF (LOGLVI.GE.3)
- + WRITE (IQLOG,9031) JRECNO,MAXREI,NWMREC,NFASTI,NRSKIP
- 9031 FORMAT (1X/' FZIPHD- Reading Block #',I7,
- F', NW32,NWmach,NRfast,NRskip=',4I6)
-#endif
-#if defined(CERNLIB_FZDACCL)
- IF (IACMOI.EQ.2) THEN
- IF (JRECNO.NE.JRECLL+1) THEN
- CALL CFSEEK (IADOPI, MEDIUI, NWMREC, JRECNO-1, ISW)
- IF (ISW.NE.0) GO TO 847
- ENDIF
-
- NWR = NWMREC
- CALL CFGET (IADOPI, MEDIUI, NWMREC, NWR, LQ(LIN), ISW)
- IF (ISW.NE.0) GO TO 842
- JRECLL = JRECNO
- GO TO 39
- ENDIF
-
-#endif
-#if defined(CERNLIB_FZDACCH)
- IF (IACMOI.EQ.3) THEN
- CALL JUMPST (IADOPI)
- ICODE = 0
- IQUEST(1) = LUNI
- IQUEST(2) = NWMREC
- IQUEST(3) = ISTENI
- IQUEST(4) = JRECNO
- IQUEST(5) = MEDIUI - 4
- IQUEST(6) = NWMREC
- CALL JUMPX2 (LQ(LIN),ICODE)
- ISW = IQUEST(1)
- IF (ISW.LT.0) GO TO 841
- IF (ISW.NE.0) GO TO 843
- NWR = IQUEST(2)
- GO TO 39
- ENDIF
-
-#endif
-#if defined(CERNLIB_FZDACCF)
-#include "fziphd37.inc"
-#endif
- 39 IQ(KQSP+LQFI+22) = NBLK
- NWRDAI = NWRDAI + MAXREI
- NW4USE = MAXREI
-
-C---- UNPACK / BYTE-SWOP
-
-#if defined(CERNLIB_FQNEEDCV)
- IF (IUPAKI.NE.0) GO TO 47
-
-#endif
-#if defined(CERNLIB_FQNEEDCV)
-#include "fziphd42.inc"
-#endif
-
-C-- Short/full dump of record read
-
- 47 CONTINUE
-#if defined(CERNLIB_QDEBPRI)
- IF (LOGLVI.GE.3) CALL FZIDUM (LQ(L4STAI),NW4USE)
-#endif
-
-C-----------------------------------------------------------
-C---- FAST RECORD EXPECTED
-C-----------------------------------------------------------
-
- IF (NFASTI.LT.0) GO TO 84
- IF (NFASTI.EQ.0) GO TO 61
- IF (LQ(L4STAI).EQ.MCCW1) GO TO 57
- 52 NFASTI = NFASTI - 1
- IQ(KQSP+LBPARI-5) = NFASTI
- IF (NRSKIP.NE.0) THEN
-C-- skip records
- N4SKII = N4SKII - MAXREI*NRSKIP
- N4RESI = N4RESI - MAXREI*NRSKIP
- ENDIF
-
-C-- deliver record
- N4DONI = 0
- N4ENDI = MIN (N4RESI,MAXREI)
-
- IFLAGI = 0
-#include "zebra/qtrace99.inc"
- RETURN
-
-C---- Unexpected steering record
-
- 57 CALL FZICHH (0, LQ(L4STAI),1)
- IF (IQUEST(1).EQ.0) GO TO 52
- GO TO 81
-
-C-----------------------------------------------------------
-C---- STEERING RECORD EXPECTED
-C-----------------------------------------------------------
-
- 61 CALL FZICHH (0, LQ(L4STAI),IFLAGI)
- IF (IQUEST(1).NE.0) GO TO 71
- IQ(KQSP+LQFI+23) = IQ(KQSP+LQFI+23) + 1
- N4DONI = 8
-
-C-- random access
- IF (JRECGO.LT.0) THEN
- N4ENDI = IQ(KQSP+LQFI+32)
- IF (N4ENDI.EQ.0) N4ENDI = NTLRI
- IF (JRECI.NE.0) JRECI = JRECI + 1
- GO TO 67
- ENDIF
-
-C-- Sequental access
-
- N4ENDI = NTLRI
- IF (N4ENDI.EQ.0) N4ENDI= MAXREI
-
- IF (IFLAGI.EQ.-1) GO TO 73
-
-C-- skip records
- IF (NRSKIP.NE.0) THEN
- N4SKIP = N4SKIP - MAXREI*NRSKIP
- N4RESI = N4RESI - MAXREI*NRSKIP
- ENDIF
-
- JREX = IQ(KQSP+LBPARI-7)
- IF (JRECI.NE.0) THEN
- IF (JREX.NE.0) THEN
- IF (JREX.NE.JRECI) GO TO 804
- ENDIF
- JRECI = JRECI + 1
- ENDIF
-
- 67 IQ(KQSP+LBPARI-7) = JRECI
- IQ(KQSP+LBPARI-5) = NFSTI
- IFLAGI = 0
- GO TO 999
-
-C---- Recover to next steering record
-
- 71 IF (IQUEST(1).EQ.3) GO TO 802
- IF (IQUEST(1).EQ.4) GO TO 841
- IF (IFLAGI.NE.-1) GO TO 82
- 72 JRECNO = JRECNO + 1
- GO TO 27
-
-C-- Recovery to this steering record
-
- 73 IF (NTLRI.EQ.0) GO TO 72
- N4DONI = NTLRI
- GO TO 67
-
-C-----------------------------------------------------------
-C---- Check skipping passed over a steering record
-C-----------------------------------------------------------
-
- 81 IF (NRSKIP.EQ.0) GO TO 87
- GO TO 83
-
- 82 IF (NRSKIP.EQ.0) GO TO 801
- 83 JRECE = JRECNO
- JRECNO = JRECGO + 1
- NFASTI = -1
- GO TO 27
-
- 84 CALL FZICHH (0, LQ(L4STAI),-1)
- IF (IQUEST(1).EQ.0) GO TO 87
- IF (JRECNO.EQ.JRECE) GO TO 801
- JRECNO = JRECNO + 1
- GO TO 27
-
- 87 N4ENDI = NTLRI
- IF (JMODI.EQ.4) GO TO 809
- IQ(KQSP+LQFI+23) = IQ(KQSP+LQFI+23) + 1
- GO TO 808
-
-C-----------------------------------------------------------
-C---- ERROR CONDITIONS
-C-----------------------------------------------------------
-
-C- JERROR = 501 Block header faulty
- 801 JERROR = 501
- GO TO 817
-
-C- JERROR = 502 Block size does not match expectation
- 802 JERROR = 502
- IQUEST(14) = MAXREI
- IQUEST(15) = NWRI
- NWERR = 2
- GO TO 817
-
-C- JERROR = 504 Break in block sequence number
- 804 JERROR = 504
- JRETCD = 5
- IQUEST(14) = JREX
- IQUEST(15) = JRECI
- NWERR = 2
- GO TO 811
-
-C- JERROR = 508 Fast burst stopped by usable steering block
- 808 JERROR = 508
- IQUEST(14) = NTLRI
- IQUEST(15) = LQ(L4STAI+8)
- IQUEST(16) = LQ(L4STAI+9)
- NWERR = 3
- JRETCD = 5
- GO TO 811
-
-C- JERROR = 509 Emergency stop block
- 809 JERROR = 509
- JRETCD = 8
- N4ENDI = 0
-
- 811 IQ(KQSP+LBPARI-7) = 0
- IQ(KQSP+LBPARI-6) = 0
- IQ(KQSP+LBPARI-5) = NFSTI
- IQ(KQSP+LBPARI-1) = N4ENDI
- GO TO 819
-
- 817 JRETCD = 6
- 818 IQ(KQSP+LBPARI-1) = 0
- 819 IQ(KQSP+LBPARI-9)= -1
- 820 IFLAGI = 1
- GO TO 999
-
-C-- EoF seen
-
- 840 IF (ISW.EQ.-1) GO TO 841
-* Extra EOF test
-#include "fzdaeofx.inc"
-* Ignoring t=pass
- IF (ISW.NE.IOSEOF) GO TO 843
- 841 JRETCD = 1
- IQ(KQSP+LBPARI-7) = 0
- IQ(KQSP+LBPARI-5) = 0
- IQ(KQSP+LBPARI-1) = 0
- GO TO 820
-
-C-- Read error
-
-#if defined(CERNLIB_FZDACCL)
- 842 IF (ISW.EQ.-1) GO TO 841
-#endif
- 843 JRETCD = 7
-C- JERROR = 515 Read error
- JERROR = 515
- NWERR = 1
- IQUEST(14) = ISW
- GO TO 818
-
-C-- Seek error
-
-#if defined(CERNLIB_FZDACCL)
- 847 JRETCD = 7
-C- JERROR = 514 Seek error
- JERROR = 514
- NWERR = 1
- IQUEST(14) = ISW
- GO TO 818
-#endif
- END
-#endif
diff --git a/src/packlib/zebra/fq/fziphd37.inc b/src/packlib/zebra/fq/fziphd37.inc
deleted file mode 100644
index 29b417c..0000000
--- a/src/packlib/zebra/fq/fziphd37.inc
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: fziphd37.inc,v 1.1.1.1 1996/03/06 10:47:11 mclareni Exp $
-*
-* $Log: fziphd37.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:11 mclareni
-* Zebra
-*
-*
-*
-* fziphd37.inc
-*
-#if defined(CERNLIB_QMIBMD)
- CALL ADREDKD (LUNI,LQ(LIN),NWMREC,JRECNO,ISW)
- IF (ISW.NE.0) GO TO 840
-#elif defined(CERNLIB_QMIRTD)
- CALL ADREDKD (LUNI,LQ(LIN),NWMREC,JRECNO,ISW)
- IF (ISW.NE.0) GO TO 840
-#elif 1
- READ (LUNI,REC=JRECNO,IOSTAT=ISW) (LQ(LIN+J-1),J=1,NWMREC)
- IF (ISW.NE.0) GO TO 840
-#endif
diff --git a/src/packlib/zebra/fq/fziphd42.inc b/src/packlib/zebra/fq/fziphd42.inc
deleted file mode 100644
index 40a4c84..0000000
--- a/src/packlib/zebra/fq/fziphd42.inc
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: fziphd42.inc,v 1.1.1.1 1996/03/06 10:47:09 mclareni Exp $
-*
-* $Log: fziphd42.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:09 mclareni
-* Zebra
-*
-*
-* unpack 60-bit words to 32-bit
-*
-* fziphd42.inc
-*
-#if defined(CERNLIB_QMCDC)
- CALL UPKCH (LQ(LIN),LQ(L4STAI),NW4USE,IPKVEC)
-* unpack 64-bit words to 32-bit
-*
-* fziphd42.inc
-*
-#elif defined(CERNLIB_QMCRY)
- CALL UNPACK (LQ(LIN),32,LQ(L4STAI),NW4USE)
-* unpack 64-bit words to 32-bit
-*
-* fziphd42.inc
-*
-#elif (defined(CERNLIB_QMCV64))&&(!defined(CERNLIB_QIEEE))
- CALL UPAK32 (LQ(LIN),LQ(L4STAI),NW4USE)
-* unpack 64-bit words to 32-bit
-*
-* fziphd42.inc
-*
-#elif defined(CERNLIB_QMIBMD)
- CALL UPACK (LQ(LIN),LQ(L4STAI),NW4USE)
-* unpack 64-bit words to 32-bit
-*
-* fziphd42.inc
-*
-#elif defined(CERNLIB_QMIRTD)
- CALL UPACK (LQ(LIN),LQ(L4STAI),NW4USE)
-#elif 1
- CALL VXINVB (LQ(LIN),NW4USE)
-#endif
diff --git a/src/packlib/zebra/fq/fziphm.F b/src/packlib/zebra/fq/fziphm.F
deleted file mode 100644
index e617c91..0000000
--- a/src/packlib/zebra/fq/fziphm.F
+++ /dev/null
@@ -1,183 +0,0 @@
-*
-* $Id: fziphm.F,v 1.3 1999/06/18 13:29:12 couet Exp $
-*
-* $Log: fziphm.F,v $
-* Revision 1.3 1999/06/18 13:29:12 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.2 1996/04/18 16:10:40 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:11 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
-#if defined(CERNLIB_FZMEMORY)
- SUBROUTINE FZIPHM
-
-C- Read next physical record from memory .
-C- Service routine to FZIN, called only via FZIREC
-
-C- Input : IFLAGI = 0 normal read
-C- -1 recover to next steering block
-
-C- N4SKII is used for rapid skip of fast blocks
-
-C- Output : IFLAGI = 0 all is well
-C- otherwise : ready for re-start
-
-#include "zebra/zbcd.inc"
-#include "zebra/zmach.inc"
-#include "zebra/zunit.inc"
-#include "zebra/mqsys.inc"
-#include "zebra/eqlqf.inc"
-#include "zebra/fzci.inc"
-#include "fzhci.inc"
-*
- EQUIVALENCE (LRTYP,IDI(2))
-* Declaratives, DIMENSION etc.
-#include "fziphrd1.inc"
-* Ignoring t=pass
-
-#include "fzstamp.inc"
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HFZIP, 4HHM /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HFZIPHM /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'FZIPHM ')
-#endif
-
-* Declaratives, DATA
-#include "fziphrd2.inc"
-
-
-#include "zebra/qtrace.inc"
-
-C---- Prepare to transfer next record
-
- LBUF = IQ(KQSP+LQFI+1)
- NWMREC = IQ(KQSP+LBPARI+1)
- NFASTI = IQ(KQSP+LBPARI-5)
- NRSKIP = 0
- NBLK = IQ(KQSP+LQFI+22)
-
-C-- Skip complete records
-
- N4SKIP = MIN (N4SKII,N4RESI)
- IF (N4SKIP.LT.MAXREI) GO TO 20
- IF (NFASTI.EQ.0) GO TO 20
- NRSKIP = MIN (NFASTI, N4SKIP / MAXREI)
- NW4S = NRSKIP * MAXREI
- NWMS = NRSKIP * NWMREC
- LBUF = LBUF + NWMS
- N4SKII = N4SKII - NW4S
- N4RESI = N4RESI - NW4S
- NWRDAI = NWRDAI + NW4S
- NFASTI = NFASTI - NRSKIP
- NBLK = NBLK + NRSKIP
-
- 20 NW4IN = MAXREI
- NWMIN = NWMREC
-
- IQ(KQSP+LBPARI-6) = NFASTI
-
-C---- READ ONE PHYSICAL RECORD
-
-#if defined(CERNLIB_QDEBPRI)
- IF (LOGLVI.GE.3)
- + WRITE (IQLOG,9031) NBLK+1,NW4IN,NWMIN,NFASTI,NRSKIP
- 9031 FORMAT (1X/' FZIPHM- Reading Block',I7,
- F', NW32,NWmach,NRfast,NRskip=',4I6)
-#endif
-
-C-- Copy, with unpacking or byte-swop if nec.
-
-#if defined(CERNLIB_FQNEEDCV)
-#include "fziphm42.inc"
-#endif
- 44 CALL UCOPY (LQ(LBUF),LQ(L4STAI),NW4IN)
- 46 CONTINUE
-
-C-- Short/full dump of record read
-
-#if defined(CERNLIB_QDEBPRI)
- IF (LOGLVI.GE.3) CALL FZIDUM (LQ(L4STAI),NW4IN)
-#endif
-
-C-----------------------------------------------------------
-C---- FAST RECORD EXPECTED
-C-----------------------------------------------------------
-
- 51 IF (NFASTI.EQ.0) GO TO 61
- NFASTI = NFASTI - 1
- N4DONI = 0
- N4ENDI = MIN (N4RESI,MAXREI)
-
- 58 NWRDAI = NWRDAI + MAXREI
- IQ(KQSP+LBPARI-5) = NFASTI
- IQ(KQSP+LQFI+22) = NBLK + 1
- IQ(KQSP+LQFI+1) = LBUF + NWMIN
- IFLAGI = 0
-#include "zebra/qtrace99.inc"
- RETURN
-
-C-----------------------------------------------------------
-C---- STEERING RECORD EXPECTED
-C-----------------------------------------------------------
-
- 61 CALL FZICHH (0, LQ(L4STAI),0)
- IF (IQUEST(1).NE.0) GO TO 64
-
- N4DONI = 8
- N4ENDI = NTLRI
- IF (N4ENDI.EQ.0) N4ENDI=MAXREI
- IQ(KQSP+LQFI+23) = IQ(KQSP+LQFI+23) + 1
- NFASTI = NFSTI
- GO TO 58
-
-C---- Physical record length mis-match
-C-- Reset if possible
-
- 64 IF (IQUEST(1).NE.3) GO TO 801
- IF (LBUF.NE.IQ(KQSP+LQFI+8)) GO TO 802
- CALL FZIPRL (0)
- IF (IQUEST(1).EQ.2) GO TO 803
- IF (IQUEST(1).NE.0) GO TO 802
- NWMREC = IQ(KQSP+LBPARI+1)
- GO TO 20
-
-
-C-----------------------------------------------------------
-C- ERROR CONDITIONS
-C-----------------------------------------------------------
-
-C- JERROR = 521 Block header faulty
- 801 JERROR = 521
- GO TO 817
-
-C- JERROR = 522 Block size does not match expectation
- 802 JERROR = -1
-
-C- JERROR = 523 Block size larger than buffer
- 803 JERROR = JERROR + 523
- IQUEST(14) = MAXREI
- IQUEST(15) = NWRI
- NWERR = 2
-
- 817 IQ(KQSP+LBPARI-9) = -1
- IQ(KQSP+LBPARI-6) = 0
- IQ(KQSP+LBPARI-5) = 0
- IQ(KQSP+LBPARI-1) = 0
-
- JRETCD = 6
- IFLAGI = 1
- GO TO 999
- END
-#endif
diff --git a/src/packlib/zebra/fq/fziphm42.inc b/src/packlib/zebra/fq/fziphm42.inc
deleted file mode 100644
index 59356ae..0000000
--- a/src/packlib/zebra/fq/fziphm42.inc
+++ /dev/null
@@ -1,37 +0,0 @@
-*
-* $Id: fziphm42.inc,v 1.1.1.1 1996/03/06 10:47:09 mclareni Exp $
-*
-* $Log: fziphm42.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:09 mclareni
-* Zebra
-*
-*
-* unpack n-bit words to 32-bit
-*
-* fziphm42.inc
-*
-#if defined(CERNLIB_QMCDC)
- IF (IUPAKI.NE.0) GO TO 44
- CALL UPKCH (LQ(LBUF),LQ(L4STAI),NW4IN,IPKVEC)
- GO TO 46
-#elif defined(CERNLIB_QMCRY)
- IF (IUPAKI.NE.0) GO TO 44
- CALL UNPACK (LQ(LBUF),32,LQ(L4STAI),NW4IN)
- GO TO 46
-#elif (defined(CERNLIB_QMCV64))&&(!defined(CERNLIB_QIEEE))
- IF (IUPAKI.NE.0) GO TO 44
- CALL UPAK32 (LQ(LBUF),LQ(L4STAI),NW4IN)
- GO TO 46
-#elif defined(CERNLIB_QMIBMD)
- IF (IUPAKI.NE.0) GO TO 44
- CALL UPACK (LQ(LBUF),LQ(L4STAI),NW4IN)
- GO TO 46
-#elif defined(CERNLIB_QMIRTD)
- IF (IUPAKI.NE.0) GO TO 44
- CALL UPACK (LQ(LBUF),LQ(L4STAI),NW4IN)
- GO TO 46
-#elif 1
- IF (IUPAKI.NE.0) GO TO 44
- CALL VXINVC (LQ(LBUF),LQ(L4STAI),NW4IN)
- GO TO 46
-#endif
diff --git a/src/packlib/zebra/fq/fziphr.F b/src/packlib/zebra/fq/fziphr.F
deleted file mode 100644
index 9f68216..0000000
--- a/src/packlib/zebra/fq/fziphr.F
+++ /dev/null
@@ -1,356 +0,0 @@
-*
-* $Id: fziphr.F,v 1.3 1999/06/18 13:29:13 couet Exp $
-*
-* $Log: fziphr.F,v $
-* Revision 1.3 1999/06/18 13:29:13 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.2 1996/04/18 16:10:41 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:15 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE FZIPHR
-
-C- Read next physical record in sequential mode
-C- Service routine to FZIN, called only via FZIREC
-
-C- Input : IFLAGI = 0 normal read
-C- -1 recover to next steering block
-C- -2 start
-
-C- N4SKII is used for rapid skip of fast blocks
-
-C- Output : IFLAGI = 0 all is well
-C- otherwise : ready for re-start
-
-#include "zebra/zbcd.inc"
-#include "zebra/zmach.inc"
-#include "zebra/zunit.inc"
-#include "zebra/mqsys.inc"
-#include "zebra/eqlqf.inc"
-#include "zebra/fzci.inc"
-#include "fzhci.inc"
-*
-
-* Declaratives, DIMENSION etc.
-#include "fziphrd1.inc"
-* Ignoring t=pass
-
-#include "fzstamp.inc"
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HFZIP, 4HHR /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HFZIPHR /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'FZIPHR ')
-#endif
-
-* Declaratives, DATA
-#include "fziphrd2.inc"
-* Ignoring t=pass
-
-
-#include "zebra/qtrace.inc"
-
-C---- DECIDE START ADR AND LENGTH FOR READ
-
- NWMREC = IQ(KQSP+LBPARI+1)
- NFASTI = IQ(KQSP+LBPARI-5)
- N4SKIP = MIN (N4SKII,N4RESI)
- NRSKIP = 0
- IF (N4SKIP.GE.MAXREI) THEN
- IF (NFASTI.NE.0) NRSKIP = MIN (NFASTI, N4SKIP / MAXREI)
- ENDIF
-
- 20 NW4IN = MAXREI
- NWMIN = NWMREC
-
- IQ(KQSP+LBPARI-6) = NFASTI
-
- LIN = L4STAI
-#if !defined(CERNLIB_QREADFULL)
- IF (NRSKIP.GE.2) THEN
- NW4IN = 90
- NWMIN = NW4IN
- ENDIF
-#endif
-#if defined(CERNLIB_FQNEEDPK)
- IF (IUPAKI.NE.0) GO TO 31
-
-C-- Exchange Data Format needing to be unpacked
-
- LIN = LIN + IQ(KQSP+LBPARI+3)
-#endif
-#if (!defined(CERNLIB_QREADFULL))&&(defined(CERNLIB_FQNEEDPK))
- IF (NW4IN.EQ.MAXREI) GO TO 31
-#include "fznwmach.inc"
-* Ignoring t=pass
-#endif
-
-C---- READ ONE PHYSICAL RECORD
-
- 31 IQ(KQSP+LQFI+33) = IQ(KQSP+LQFI+33) + 1
- NBLK = IQ(KQSP+LQFI+22) + 1
-#if defined(CERNLIB_QDEBPRI)
- IF (LOGLVI.GE.3)
- + WRITE (IQLOG,9031) NBLK,NW4IN,NWMIN,NFASTI,NRSKIP
- 9031 FORMAT (1X/' FZIPHR- Reading Block',I7,
- F', NW32,NWmach,NRfast,NRskip=',4I6)
-
-#endif
-#if defined(CERNLIB_FZLIBC)
- IF (IACMOI.EQ.2) THEN
- NWR = NWMREC
- CALL CFGET (IADOPI, MEDIUI, NWMREC, NWR, LQ(LIN), ISW)
- IF (ISW.EQ.-1) GO TO 841
- IF (ISW.NE.0) GO TO 843
- IF (NWR.EQ.NWMREC) NW4IN = MAXREI
- GO TO 39
- ENDIF
-
-#endif
-#if defined(CERNLIB_FZCHANNEL)
- IF (IACMOI.EQ.3) THEN
- CALL JUMPST (IADOPI)
- ICODE = 0
- IQUEST(1) = LUNI
- IQUEST(2) = NWMREC
- IQUEST(3) = ISTENI
- IQUEST(4) = 0
- IQUEST(5) = MEDIUI - 4
- IQUEST(6) = NWMREC
- CALL JUMPX2 (LQ(LIN),ICODE)
- ISW = IQUEST(1)
- IF (ISW.LT.0) GO TO 841
- IF (ISW.NE.0) GO TO 843
- NWR = IQUEST(2)
- IF (NWR.EQ.NWMREC) NW4IN = MAXREI
- GO TO 39
- ENDIF
-
-#endif
-#if defined(CERNLIB_FZFORTRAN)
-#include "fziphr32.inc"
- 36 NWR = NWMIN
- CALL XINBF (LUNI,LQ(LIN),NWR)
- IF (NWR.EQ.0) GO TO 841
- ISW = -NWR
- IF (NWR.LT.0) GO TO 843
- NWR = MIN (NWR,NWMIN)
-#endif
- 39 IQ(KQSP+LQFI+22) = NBLK
- NWRDAI = NWRDAI + MAXREI
- NW4USE = NW4IN
-
-C---- UNPACK / BYTE-SWOP
-
-#if defined(CERNLIB_FQNEEDCV)
- IF (IUPAKI.NE.0) GO TO 47
- IF (NRSKIP.NE.0) NW4USE = 8
- IF (IFLAGI.EQ.-1) NW4USE = 8
-
-#endif
-#if defined(CERNLIB_FQNEEDCV)
-#include "fziphr42.inc"
-#endif
-
-C-- Short/full dump of record read
-
- 47 CONTINUE
-#if defined(CERNLIB_QDEBPRI)
- IF (LOGLVI.GE.3) CALL FZIDUM (LQ(L4STAI),NW4USE)
-#endif
-
-C-----------------------------------------------------------
-C---- FAST RECORD EXPECTED
-C-----------------------------------------------------------
-
- IF (NFASTI.EQ.0) GO TO 61
- IF (LQ(L4STAI).EQ.MCCW1) GO TO 54
- 52 NFASTI = NFASTI - 1
- IQ(KQSP+LBPARI-5) = NFASTI
- IF (NRSKIP.EQ.0) GO TO 53
-
-C-- skip record
- N4SKII = N4SKII - MAXREI
- N4RESI = N4RESI - MAXREI
- NRSKIP = NRSKIP - 1
- GO TO 20
-
-C-- deliver record
- 53 N4DONI = 0
- N4ENDI = MIN (N4RESI,MAXREI)
- IFLAGI = 0
-#include "zebra/qtrace99.inc"
- RETURN
-
-C---- Unexpected steering record
-
- 54 CALL FZICHH (0, LQ(L4STAI),1)
- IF (IQUEST(1).EQ.0) GO TO 52
-#if defined(CERNLIB_FQNEEDCV)
-C-- Unpack all words read
- IF (NW4USE.LT.NW4IN) THEN
- NW4USE = NW4IN
- GO TO 42
- ENDIF
-#endif
-
- IQ(KQSP+LQFI+23) = IQ(KQSP+LQFI+23) + 1
- N4ENDI = NTLRI
- IF (JMODI.EQ.4) GO TO 809
- IF (NW4IN.EQ.MAXREI) GO TO 808
-
-C-- recover start/end-of-run in partially read record
-
- IF (JMODI.EQ.0) GO TO 806
- IF (JMODI.GT.2) GO TO 806
- IF (NTLRI+3.GT.NW4IN) GO TO 805
-
- LRCUR = L4STAI + NTLRI + 1
- LRLG = LQ(LRCUR-1)
- LRTP = LQ(LRCUR)
- IF (LRLG.LT.1) GO TO 806
- IF (LRLG.GT.401) GO TO 806
- IF (LRTP.NE.1) GO TO 806
- IF (LQ(LRCUR+1).LT.0) GO TO 806
- LRLG = MIN (LRLG, NW4IN-NTLRI-2)
- NUSED = NTLRI + LRLG + 2
- LQ(LRCUR-1) = LRLG
- LRCUR = LRCUR + LRLG + 1
- LQ(LRCUR) = MAXREI - NUSED - 1
- LQ(LRCUR+1) = 5
- NFSTI = 0
- GO TO 807
-
-C-----------------------------------------------------------
-C---- STEERING RECORD EXPECTED
-C-----------------------------------------------------------
-
- 61 CALL FZICHH (0, LQ(L4STAI),IFLAGI)
- IF (IQUEST(1).NE.0) GO TO 71
- N4ENDI = NTLRI
-
- IF (IFLAGI.LT.0) GO TO 73
-
- JREX = IQ(KQSP+LBPARI-7)
- IF (JREX.NE.0) THEN
- IF (JRECI.NE.0) THEN
- IF (JRECI.NE.JREX) GO TO 804
- ENDIF
- ENDIF
-
- N4DONI = 8
- IF (N4ENDI.EQ.0) N4ENDI= MAXREI
-
- 62 IQ(KQSP+LQFI+23) = IQ(KQSP+LQFI+23) + 1
- IF (JRECI.NE.0) JRECI = JRECI + 1
- IQ(KQSP+LBPARI-7) = JRECI
- IQ(KQSP+LBPARI-5) = NFSTI
- IFLAGI = 0
- GO TO 999
-
-C---- Recover to next steering record
-
- 71 IF (IQUEST(1).EQ.3) GO TO 802
- IF (IFLAGI.EQ.-1) GO TO 20
- GO TO 801
-
-C-- Recovery to this steering record
-
- 73 IF (NTLRI.EQ.0) GO TO 20
-#if defined(CERNLIB_FQNEEDCV)
- IF (NW4USE.LT.NW4IN) THEN
- NW4USE = NW4IN
- GO TO 42
- ENDIF
-#endif
- N4DONI = NTLRI
- GO TO 62
-
-C-----------------------------------------------------------
-C- ERROR CONDITIONS
-C-----------------------------------------------------------
-
-
-C- JERROR = 201 Block header faulty
- 801 JERROR = 201
- GO TO 817
-
-C- JERROR = 202 Block size does not match expectation
- 802 JERROR = 202
- IQUEST(14) = MAXREI
- IQUEST(15) = NWRI
- NWERR = 2
- GO TO 817
-
-C- JERROR = 204 Break in block sequence number
- 804 JERROR = 204
- JRETCD = 5
- IQUEST(14) = JREX
- IQUEST(15) = JRECI
- NWERR = 2
- GO TO 811
-
-C- JERROR = 205 Fast burst stopped by unusable start/end-of-run
- 805 JERROR = -1
-
-C- JERROR = 206 Fast burst stopped by unusable steering block
- 806 JERROR = JERROR - 1
- N4ENDI = 0
-
-C- JERROR = 207 Fast burst stopped by usable start/end-of-run
-C- in unusable steering block
- 807 JERROR = JERROR - 1
-
-C- JERROR = 208 Fast burst stopped by usable steering block
- 808 JERROR = 208 + JERROR
- IQUEST(14) = NTLRI
- IQUEST(15) = LQ(L4STAI+8)
- IQUEST(16) = LQ(L4STAI+9)
- NWERR = 3
- JRETCD = 5
- GO TO 811
-
-C- JERROR = 209 Emergency stop block
- 809 JERROR = 209
- JRETCD = 8
- N4ENDI = 0
-
- 811 IQ(KQSP+LBPARI-7) = 0
- IQ(KQSP+LBPARI-6) = 0
- IQ(KQSP+LBPARI-5) = NFSTI
- IQ(KQSP+LBPARI-1) = N4ENDI
- GO TO 819
-
- 817 JRETCD = 6
- 818 IQ(KQSP+LBPARI-1) = 0
- 819 IQ(KQSP+LBPARI-9)= -1
- 820 IFLAGI = 1
- GO TO 999
-
-C-- EoF seen
-
- 841 JRETCD = 1
- IQ(KQSP+LBPARI-7) = 0
- IQ(KQSP+LBPARI-5) = 0
- IQ(KQSP+LBPARI-1) = 0
- GO TO 820
-
-C-- Read error
-
- 843 JRETCD = 7
- JERROR = 215
- NWERR = 1
- IQUEST(14) = ISW
- GO TO 818
- END
diff --git a/src/packlib/zebra/fq/fziphr32.inc b/src/packlib/zebra/fq/fziphr32.inc
deleted file mode 100644
index e5a14c8..0000000
--- a/src/packlib/zebra/fq/fziphr32.inc
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: fziphr32.inc,v 1.1.1.1 1996/03/06 10:47:10 mclareni Exp $
-*
-* $Log: fziphr32.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:10 mclareni
-* Zebra
-*
-*
-*
-* fziphr32.inc
-*
-#if (defined(CERNLIB_QMIBM))&&(defined(CERNLIB_IOPACK))
- IF (IACMOI.EQ.0) GO TO 36
- NWR = 4*NWMIN
- CALL IOREAD (LUNI,LQ(LIN),NWR,ISW)
- IF (ISW.EQ.0) GO TO 39
- IF (ISW.EQ.1) GO TO 843
- IF (ISW.EQ.2) GO TO 841
- IF (ISW.EQ.3) GO TO 843
- GO TO 841
-#endif
-*
-* fziphr32.inc
-*
-#if defined(CERNLIB_QMND3)
- IF (IACMOI.EQ.0) GO TO 36
- ISW = MAGTP (0,LQ(LIN),LUNI,NWMIN,NWR)
- IF (ISW.EQ.0) GO TO 39
- IF (ISW.EQ.3) GO TO 841
- GO TO 843
-* -------------- conversions for input -------------------
-#endif
diff --git a/src/packlib/zebra/fq/fziphr42.inc b/src/packlib/zebra/fq/fziphr42.inc
deleted file mode 100644
index 24a8ce8..0000000
--- a/src/packlib/zebra/fq/fziphr42.inc
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: fziphr42.inc,v 1.1.1.1 1996/03/06 10:47:09 mclareni Exp $
-*
-* $Log: fziphr42.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:09 mclareni
-* Zebra
-*
-*
-* unpack n-bit words to 32-bit
-*
-* fziphr42.inc
-*
-#if defined(CERNLIB_QMCDC)
- 42 CALL UPKCH (LQ(LIN),LQ(L4STAI),NW4USE,IPKVEC)
-#elif defined(CERNLIB_QMCRY)
- 42 CALL UNPACK (LQ(LIN),32,LQ(L4STAI),NW4USE)
-#elif (defined(CERNLIB_QMCV64))&&(!defined(CERNLIB_QIEEE))
- 42 CALL UPAK32 (LQ(LIN),LQ(L4STAI),NW4USE)
-#elif defined(CERNLIB_QMIBMD)
- 42 CALL UPACK (LQ(LIN),LQ(L4STAI),NW4USE)
-#elif defined(CERNLIB_QMIRTD)
- 42 CALL UPACK (LQ(LIN),LQ(L4STAI),NW4USE)
-#elif 1
- NSWDON = 0
- 42 CALL VXINVB (LQ(LIN+NSWDON),NW4USE-NSWDON)
- NSWDON = NW4USE
-#endif
diff --git a/src/packlib/zebra/fq/fziphrd1.inc b/src/packlib/zebra/fq/fziphrd1.inc
deleted file mode 100644
index 8de0c19..0000000
--- a/src/packlib/zebra/fq/fziphrd1.inc
+++ /dev/null
@@ -1,14 +0,0 @@
-*
-* $Id: fziphrd1.inc,v 1.1.1.1 1996/03/06 10:47:09 mclareni Exp $
-*
-* $Log: fziphrd1.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:09 mclareni
-* Zebra
-*
-*
-*
-* fziphrd1.inc
-*
-#if defined(CERNLIB_QMCDC)
- DIMENSION IPKVEC(5)
-#endif
diff --git a/src/packlib/zebra/fq/fziphrd2.inc b/src/packlib/zebra/fq/fziphrd2.inc
deleted file mode 100644
index c8f4884..0000000
--- a/src/packlib/zebra/fq/fziphrd2.inc
+++ /dev/null
@@ -1,14 +0,0 @@
-*
-* $Id: fziphrd2.inc,v 1.1.1.1 1996/03/06 10:47:09 mclareni Exp $
-*
-* $Log: fziphrd2.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:09 mclareni
-* Zebra
-*
-*
-*
-* fziphrd2.inc
-*
-#if defined(CERNLIB_QMCDC)
- DATA IPKVEC / 32, 0, 600000, 0, 0 /
-#endif
diff --git a/src/packlib/zebra/fq/fziprl.F b/src/packlib/zebra/fq/fziprl.F
deleted file mode 100644
index e0bc95c..0000000
--- a/src/packlib/zebra/fq/fziprl.F
+++ /dev/null
@@ -1,64 +0,0 @@
-*
-* $Id: fziprl.F,v 1.2 1999/06/18 13:29:14 couet Exp $
-*
-* $Log: fziprl.F,v $
-* Revision 1.2 1999/06/18 13:29:14 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:15 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE FZIPRL (IHOW)
-
-C- Physical record length mis-match, reset if possible
-
-C- in : IHOW = 0 reset if possible
-C- 1 reset only if start-of-run
-
-C- out : IRETN = 0 reset done
-C- 1 reset fails, not start-of-run
-C- 2 reset fails, record larger than buffer
-
-#include "zebra/zmach.inc"
-#include "zebra/zunit.inc"
-#include "zebra/mqsys.inc"
-#include "zebra/eqlqf.inc"
-#include "zebra/fzci.inc"
-#include "fzhci.inc"
-*
-
-
- IF (NWRI.GT.IQ(KQSP+LBPARI)) GO TO 42
- IRETN = 0
- IF (IHOW.NE.0) THEN
- IF (JMODI.NE.1) GO TO 41
- IF (NTLRI.NE.8) GO TO 41
- L4CURI = L4STAI + 8
- IF (LQ(L4CURI+1).NE.1) GO TO 41
- IF (LQ(L4CURI+2).LE.0) GO TO 41
- ENDIF
-
-#if defined(CERNLIB_QPRINT)
- IF (LOGLVI.GE.-1) WRITE (IQLOG,9066) LUNI, NWRI
- 9066 FORMAT (1X/' FZIPHR. LUN=',I3,', Reset block size to',I6)
-#endif
-
- MAXREI = NWRI
- NWMIN = NWRI
-#if defined(CERNLIB_FQNEEDPK)
- IF (IUPAKI.NE.0) GO TO 38
-#include "fznwmach.inc"
-* Ignoring t=pass
-#endif
- 38 IQ(KQSP+LQFI+5) = MAXREI
- IQ(KQSP+LBPARI+1) = NWMIN
- GO TO 48
-
- 42 IRETN = 1
- 41 IRETN = IRETN + 1
- 48 IQUEST(1) = IRETN
- RETURN
- END
diff --git a/src/packlib/zebra/fq/fzirec.F b/src/packlib/zebra/fq/fzirec.F
deleted file mode 100644
index 5d81296..0000000
--- a/src/packlib/zebra/fq/fzirec.F
+++ /dev/null
@@ -1,403 +0,0 @@
-*
-* $Id: fzirec.F,v 1.2 1999/06/18 13:29:16 couet Exp $
-*
-* $Log: fzirec.F,v $
-* Revision 1.2 1999/06/18 13:29:16 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:11 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE FZIREC
-
-C- Logical record controls, exchange file format
-C- service routine to FZIFFX of FZIN
-
-C- This routine is called with
-C- IFLAGI > 0 from FZIFFX to initiate the next d/s making sure
-C- that the block containing its beginning is
-C- in the buffer, skipping if nec. trailing records
-C- of the previous d/s
-C- = 0 from FZIFFX to copy the buffer control params.
-C- between the control-bank and /FZCI/ (for speed)
-C- < 0 from FZITR to read continuation blocks (phR)
-C- into the buffer
-
-#include "zebra/zunit.inc"
-#include "zebra/mqsys.inc"
-#include "zebra/eqlqf.inc"
-#include "zebra/fzci.inc"
-*
-#include "fzntolds.inc"
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HFZIR, 4HEC /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HFZIREC /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'FZIREC ')
-#endif
-
-
-#include "zebra/qtrace.inc"
-
-
-C- buffer parameters :
-C-
-C- -9 non-zero : last LR abended
-C- -7 expected next Ph record number
-C- -6 =0 if current block is steering
-C- =1 if current block is last in burst
-C- =2 if cur. block is last-but-one in burst, etc
-C- -5 # of fast records still pending
-C-
-C- -4 N4SKII, # of words to be skipped
-C- before next transmission
-C- -3 N4RESI, # of words in LR still to be done
-C- -2 N4DONI, # of words already out of buffer
-C- -1 N4ENDI, # of words in buffer before start of next LR
-C- if =0 : buffer empty
-C- if =MAXREI : LR continues in next block
-C- LBPARI +0 maximum size of buffer, words
-C- +1 expected size of PhR, local machine words
-C- +2 INCBUF step to buffer
-C- +3 off-set from start-of-buffer for reading
-C- the packed record
-C- +4 (off-set for output)
-C- -1 space for left double-precision word saved
-C- L4STAI +0 first word of normal buffer
-
- IFLIN = IFLAGI
- IFLAGI = 0
- LBPARI = LQFI + INCBPI
- IF (IFLIN) 61, 71, 21
-
-C-----------------------------------------------------------
-C------ IFLAGI > 0 : start new d/s
-C-----------------------------------------------------------
-
- 21 ICARRL = 0
- IFLRST = IQ(KQSP+LBPARI-9)
- INCBUF = IQ(KQSP+LBPARI+2)
- L4STAI = KQSP+8 + LBPARI + INCBUF
-
- NLRPAD = 0
- JFAST = IQ(KQSP+LBPARI-6)
- N4SKII = 0
- N4ENDI = IQ(KQSP+LBPARI-1)
-#if defined(CERNLIB_QDEBPRI)
- IF (LOGLVI.GE.3)
- + WRITE (IQLOG,9022) IFLIN,IFLRST,JFAST,N4ENDI,MAXREI
- 9022 FORMAT (1X/' FZIREC- Going for next LR, Buffer Status :'
- F/10X,'IFLAGI, Restart?, Fast?, NWtoLR, NWbuf =',6I6)
-#endif
-
-C-- Re-start LR after error
-
- IF (IFLRST.NE.0) THEN
- IQ(KQSP+LBPARI-9) = 0
- IF (N4ENDI.GT.0) THEN
- IF (N4ENDI.LT.MAXREI-1) GO TO 51
- ENDIF
- IFLAGI = -1
- GO TO 27
- ENDIF
-
-C-- Start afresh
-
- IF (N4ENDI.NE.0) GO TO 31
- IFLAGI = -2
- 27 CALL VZERO (IQ(KQSP+LBPARI-8),8)
- N4RESI = 0
- N4DONI = 0
- GO TO 46
-
-C---- Normal continuation on current buffer
-
- 31 N4RESI = IQ(KQSP+LBPARI-3)
- N4DONI = IQ(KQSP+LBPARI-2)
-#if defined(CERNLIB_QDEBPRI)
- IF (LOGLVI.GE.3) WRITE (IQLOG,9031) N4RESI,N4DONI,N4ENDI
- 9031 FORMAT (10X,'Status of last LR : NWrest, NWdone, NWend ='
- F,3I5)
-#endif
-
-C-- Skip trailing words of last LR
-
- IF (N4RESI.EQ.0) GO TO 41
- 34 NWNEW = MIN (N4ENDI-N4DONI, N4RESI)
- N4DONI = N4DONI + NWNEW
- N4RESI = N4RESI - NWNEW
- IF (N4RESI.EQ.0) GO TO 41
- IF (N4ENDI.NE.MAXREI) GO TO 821
- N4SKII = N4RESI
- NWFAST = IQ(KQSP+LBPARI-5) * MAXREI
- IF (NWFAST.LE.N4SKII) GO TO 46
- N4SKII = NWFAST
- N4RESI = NWFAST
- IFLAGI = -2
- GO TO 46
-
-C-- New Ph record if buffer exhausted
-
- 41 IF (N4DONI.NE.N4ENDI) GO TO 822
- ICARRL = 0
- IF (N4ENDI.LT.MAXREI-1) GO TO 51
- IF (N4ENDI.GT.MAXREI-1) GO TO 46
- MCARRL = LQ(L4STAI+MAXREI-1)
- IF (MCARRL.EQ.0) GO TO 46
- ICARRL = 1
- JRECNO = IQ(KQSP+LQFI+33)
- JDSADR = N4ENDI
- JFAST = IQ(KQSP+LBPARI-6)
-#if defined(CERNLIB_QDEBPRI)
- IF (LOGLVI.GE.3) WRITE (IQLOG,9043) MCARRL
- 9043 FORMAT (' FZIREC- Saved LR length',I6,' across to next PhR')
-#endif
-
- 46 IF (IFIFOI.LE.1) THEN
- CALL FZIPHR
-#if defined(CERNLIB_FZDACC)
- ELSEIF (IFIFOI.EQ.2) THEN
- CALL FZIPHD
-#endif
-#if defined(CERNLIB_FZMEMORY)
- ELSEIF (IFIFOI.EQ.3) THEN
- CALL FZIPHM
-#endif
-#if defined(CERNLIB_FZALFA)
- ELSEIF (IFIFOI.EQ.4) THEN
- CALL FZIPHA
-#endif
- ENDIF
-
-C-- read failure ?
- IF (IFLAGI.NE.0) THEN
- IF (IFLIN.GT.0) THEN
- IF (JRETCD.EQ.1) JRETCD=-1
- ENDIF
- GO TO 999
- ENDIF
-
-C-- LR length last word of previous block ?
- IF (ICARRL.NE.0) THEN
- N4ENDI = N4DONI - 1
- LQ(L4STAI+N4ENDI) = MCARRL
- ENDIF
-
-C-- still discarding previous d/s ?
- IF (IFLIN.GT.0) THEN
- IF (N4RESI.GT.0) GO TO 34
- ENDIF
-
-C---- Start new logical record
-
- 51 N4DONI = N4ENDI
- N4SKII = 0
- IF (N4ENDI.EQ.MAXREI-1) GO TO 41
- IF (ICARRL.EQ.0) THEN
- JRECNO = IQ(KQSP+LQFI+33)
- JDSADR = N4DONI
- JFAST = IQ(KQSP+LBPARI-6)
- ENDIF
- ICARRL = 0
- L4CURI = L4STAI + N4DONI + 2
- IDI(1) = LQ(L4CURI-2)
- IDI(2) = LQ(L4CURI-1)
- IF (IDI(1).EQ.0) IDI(2)=5
-#if defined(CERNLIB_QDEBPRI)
- IF (LOGLVI.GE.3) WRITE (IQLOG,9053) JFAST,N4DONI,IDI
- 9053 FORMAT (' FZIREC- Start LR : Fast?, NWdone, Length, Type='
- F,I5,I6,I8,I3)
-#endif
- N4RESI = IDI(1)
- IF (N4RESI.LT.0) GO TO 826
- IF (N4RESI.GT.NTOLDS) GO TO 826
- IF (IDI(2).GE.5) GO TO 57
- IF (IDI(2).EQ.4) GO TO 53
-
-C-- LR type 1, 2, 3
-
- IF (IDI(2).LE.0) GO TO 825
- IF (IFLIN.LT.0) GO TO 824
- IF (JFAST.NE.0) GO TO 827
- IQ(KQSP+LQFI+31) = JRECNO
- IQ(KQSP+LQFI+32) = JDSADR
-
- 53 N4DONI = N4DONI + 2
- N4ENDI = MIN (MAXREI, N4DONI+N4RESI)
- L4ENDI = L4STAI + N4ENDI
- NRECAI = NRECAI + 1
- IF (IFLIN.GE.0) GO TO 77
- N4SKII = NSKISV
- GO TO 77
-
-C-- Skip padding records
-
- 57 IF (IDI(2).GE.7) GO TO 825
- IF (N4RESI.GT.MAXREI) GO TO 828
- NLRPAD = NLRPAD + 1
- IF (NLRPAD.GE.5) GO TO 829
- N4DONI = N4DONI + 1
- N4ENDI = MIN (MAXREI, N4DONI+N4RESI)
-
- NWNEW = MIN (N4ENDI-N4DONI, N4RESI)
- N4DONI = N4DONI + NWNEW
- N4RESI = N4RESI - NWNEW
- GO TO 41
-
-C-----------------------------------------------------------
-C------ IFLAGI = -1 : ready continuation Ph / L record
-C-----------------------------------------------------------
-
- 61 ICARRY = 0
- N4DONI = L4CURI - L4STAI
- NWNEW = N4DONI - IQ(KQSP+LBPARI-2)
- N4RESI = N4RESI - NWNEW
-
- IF (N4DONI.EQ.MAXREI+1) THEN
- ICARRY = 1
- MCARRY = LQ(L4CURI-2)
- N4RESI = N4RESI + 1
- ENDIF
-
-#if defined(CERNLIB_QDEBPRI)
- IF (LOGLVI.GE.3) WRITE (IQLOG,9061) N4RESI,N4DONI,MAXREI,ICARRY
- 9061 FORMAT (1X/' FZIREC- Need continuation PhR/LR, Buffer Status :'
- F/10X,'Rest LR, NWdone, NWbuf, NWcarry =',3I7,I4)
-#endif
-
-C-- Start continuation LR
-
- IF (N4RESI.EQ.0) THEN
- NLRPAD = 0
- NSKISV = N4SKII
- N4SKII = 0
- GO TO 41
- ENDIF
-
-C-- Get continuation PhR
-
- IF (IFIFOI.LE.1) THEN
- CALL FZIPHR
-#if defined(CERNLIB_FZDACC)
- ELSEIF (IFIFOI.EQ.2) THEN
- CALL FZIPHD
-#endif
-#if defined(CERNLIB_FZMEMORY)
- ELSEIF (IFIFOI.EQ.3) THEN
- CALL FZIPHM
-#endif
-#if defined(CERNLIB_FZALFA)
- ELSEIF (IFIFOI.EQ.4) THEN
- CALL FZIPHA
-#endif
- ENDIF
- IF (IFLAGI.NE.0) GO TO 999
-
- L4CURI = L4STAI + N4DONI
- L4ENDI = L4STAI + N4ENDI
-
- IF (ICARRY.NE.0) THEN
- N4RESI = N4RESI + 1
- N4DONI = N4DONI - 1
- L4CURI = L4CURI - 1
- LQ(L4CURI) = MCARRY
- ENDIF
- GO TO 77
-
-C-----------------------------------------------------------
-C------ IFLAGI = 0 : set buffer parameters
-C-----------------------------------------------------------
-
- 71 IF (L4STAI.NE.0) GO TO 74
-
-C-- Copy parameters from control bank to COMMON
-
- N4SKII = IQ(KQSP+LBPARI-4)
- N4RESI = IQ(KQSP+LBPARI-3)
- N4DONI = IQ(KQSP+LBPARI-2)
- N4ENDI = IQ(KQSP+LBPARI-1)
- INCBUF = IQ(KQSP+LBPARI+2)
- L4STAI = KQSP+8 + LBPARI + INCBUF
- L4CURI = L4STAI + N4DONI
- L4ENDI = L4STAI + N4ENDI
- GO TO 999
-
-C-- Up-date parameters in control bank
-
- 74 N4DONI = L4CURI - L4STAI
- NWNEW = N4DONI - IQ(KQSP+LBPARI-2)
- N4RESI = N4RESI - NWNEW
-
- 77 IQ(KQSP+LBPARI-4) = N4SKII
- IQ(KQSP+LBPARI-3) = N4RESI
- IQ(KQSP+LBPARI-2) = N4DONI
- IQ(KQSP+LBPARI-1) = N4ENDI
-
-#include "zebra/qtrace99.inc"
- RETURN
-
-C-----------------------------------------------------------
-C- ERROR CONDITIONS
-C-----------------------------------------------------------
-
-C- JERROR = 221 LR overshoots physical record control
- 821 JERROR = 221
- IQUEST(14) = N4DONI
- IQUEST(15) = N4RESI
- NWERR = 2
- GO TO 871
-
-C- JERROR = 222 LR undershoots physical record control
- 822 JERROR = 222
- IQUEST(14) = N4DONI
- IQUEST(15) = N4ENDI
- NWERR = 2
- GO TO 871
-
-C- JERROR = 223 LR expected to start at start of new PhR
-C!823 JERROR = 223
-C! IQUEST(14) = N4ENDI
-C! NWERR = 1
-C! GO TO 871
-
-C- JERROR = 224 LR type 1,2,3 seen when 4 expected
- 824 JERROR = 224
- IQUEST(14) = N4ENDI
- NWERR = 1
- GO TO 871
-
-
-C- JERROR = 225 Faulty LR type
- 825 JERROR = -1
-
-C- JERROR = 226 Faulty LR length
- 826 JERROR = JERROR - 1
-
-C- JERROR = 227 LR of type 1,2,3 must start on steering block
- 827 JERROR = JERROR - 1
-
-C- JERROR = 228 Padding record longer than one physical record
- 828 JERROR = JERROR - 1
-
-C- JERROR = 229 More than 4 padding records in a row
- 829 JERROR = 229 + JERROR
-
- IQUEST(14) = N4DONI
- IQUEST(15) = N4RESI
- IQUEST(16) = IDI(2)
- NWERR = 3
- N4ENDI = 0
-
- 871 IQ(KQSP+LBPARI-9) = -2
- IFLAGI = -2
- JRETCD = 6
- GO TO 77
- END
diff --git a/src/packlib/zebra/fq/fzirel.F b/src/packlib/zebra/fq/fzirel.F
deleted file mode 100644
index eab7724..0000000
--- a/src/packlib/zebra/fq/fzirel.F
+++ /dev/null
@@ -1,169 +0,0 @@
-*
-* $Id: fzirel.F,v 1.3 1999/06/18 13:29:16 couet Exp $
-*
-* $Log: fzirel.F,v $
-* Revision 1.3 1999/06/18 13:29:16 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.2 1996/04/18 16:10:43 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:15 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE FZIREL
-
-C- RELOCATE DATA-STRUCTURE READ
-C- USE THE MEMORY OCCUPATION TABLE READY
-C- AND THE RELOCATION VECTOR READ INTO LQ(LQTA+NWTABI)
-C- CALLED FROM FZIN
-
-#include "zebra/zbcd.inc"
-#include "zebra/zmach.inc"
-#include "zebra/zunit.inc"
-#include "zebra/mqsys.inc"
-#include "zebra/eqlqf.inc"
-#include "zebra/mzcn.inc"
-#include "zebra/mzct.inc"
-#include "zebra/fzci.inc"
-*
- DIMENSION LADESV(6)
-#if defined(CERNLIB_QMVDS)
- SAVE LADESV
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HFZIR, 4HEL /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HFZIREL /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'FZIREL ')
-#endif
- DATA LADESV / 6, 5*0 /
-
-
-#include "zebra/qtrace.inc"
-
- IF (NWTABI.EQ.0) GO TO 61
-
-C------ Ready the relocation table
-
- LPUT = LQTA
- LTAKE = LQTA + NWTABI
-
-C-- Loop for all segments in the memory occupation tb.
-
- LMT = LQMTA
- 22 IF (LQ(LMT+1).NE.0) GO TO 24
-
-C-- Skipped segment
-
- NWSG = LQ(LMT+3)
- 23 IF (NWSG.GE.0) GO TO 29
- IF (LTAKE.GE.LQTE) GO TO 731
- NWSG = NWSG + (LQ(LTAKE+1)-LQ(LTAKE))
- LTAKE = LTAKE + 2
- GO TO 23
-
-C-- Accepted segment
-
- 24 LSTA = LQ(LMT+3)
- LEND = LQ(LMT+4)
- NWSG = LSTA - LEND
- NREL = 0
- LE = LSTA
- 25 IF (LTAKE.GE.LQTE) GO TO 731
- LA = LQ(LTAKE)
- NREL = NREL - (LA-LE)
- LE = LQ(LTAKE+1)
-
- LQ(LPUT) = LA
- LQ(LPUT+1) = LE
- LQ(LPUT+2) = NREL
- LQ(LPUT+3) = 0
- LTAKE = LTAKE + 2
- LPUT = LPUT + 4
- NWSG = NWSG + (LE-LA)
- IF (NWSG.LT.0) GO TO 25
- 29 IF (NWSG.NE.0) GO TO 732
- LMT = LMT + 8
- IF (LMT.LT.LQMTE) GO TO 22
- IF (LTAKE.NE.LQTE) GO TO 733
- LQTE = LPUT
-
- LQ(LQTE) = LQ(LQTE-3)
- LQ(LQTA-1) = LQ(LQTA)
-#if defined(CERNLIB_QDEVZE)
- IF (LOGLVI.GE.4)
- + WRITE (IQLOG,9167) LENTRI,(LQ(J),J=LQTA,LQTE-1)
- 9167 FORMAT (' FZIREL- Relocation Table, LENTRY before=',I10/
- F (15X,3I9,I4))
-#endif
-
-C---- Relocate the bank links
-
- IQFLIO = 7
- CALL MZRELB
- IF (IQFLIO.LT.0) GO TO 734
-
-C-- Relocate the entry link
-
- LADESV(2) = LOCF(LENTRI) - LQSTOR
- LADESV(3) = LADESV(2) + 1
- LADESV(5) = IQLETT(9)
- LADESV(6) = IQLETT(15)
- CALL MZRELL (LADESV)
-#if defined(CERNLIB_QDEVZE)
- IF (LOGLVI.GE.4) WRITE (IQLOG,9037) LENTRI
- 9037 FORMAT (10X,'LENTRY after=',I10)
-#endif
- LQ(KQS+LENTRI+1) = 0
- LQ(KQS+LENTRI+2) = 0
- GO TO 999
-
-C------ Chain banks into one linear structure
-
- 61 CALL FZILIN
- IF (IQFOUL.NE.0) GO TO 734
- LENTRI = IQUEST(1)
-#include "zebra/qtrace99.inc"
- RETURN
-
-C-------------------------------------------------
-C- ERROR CONDITIONS
-C-------------------------------------------------
-
-C---- BAD DATA
-
-C- JERROR = 34 bank chaining clobbered in the input data
- 734 JERROR = 34
- IQUEST(14)= IQLN
- NWERR = 1
- GO TO 739
-
-C- JERROR = 33 ends of segment and rel. tables do not match
- 733 JERROR = 33
- IQUEST(14)= LTAKE
- IQUEST(15)= LQTE
- NWERR = 2
- GO TO 739
-
-C- JERROR = 32 segment limit does not match a rel. table entry
- 732 JERROR = 32
- IQUEST(14)= NWSG
- NWERR = 1
- GO TO 739
-
-C- JERROR = 31 segment table tries to overshoot rel. table
- 731 JERROR = 31
- IQUEST(14)= NWSG
- NWERR = 1
- 739 JRETCD = 5
- GO TO 999
- END
diff --git a/src/packlib/zebra/fq/fzitrn.F b/src/packlib/zebra/fq/fzitrn.F
deleted file mode 100644
index 927d23f..0000000
--- a/src/packlib/zebra/fq/fzitrn.F
+++ /dev/null
@@ -1,72 +0,0 @@
-*
-* $Id: fzitrn.F,v 1.2 1999/06/18 13:29:18 couet Exp $
-*
-* $Log: fzitrn.F,v $
-* Revision 1.2 1999/06/18 13:29:18 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:15 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE FZITRN (MBAT,NWBAT)
-
-C- Transmit one batch of data from the input buffer,
-C- exchange file format, native data format
-C- service routine to FZIN
-C- careful : must not be called with N4SKII=0 .AND. NWBAT=0
-
-#include "zebra/zunit.inc"
-#include "zebra/zebq.inc"
-#include "zebra/mzca.inc"
-#include "zebra/fzci.inc"
-*
- DIMENSION MBAT(99), NWBAT(9)
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HFZIT, 4HRN /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HFZITRN /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'FZITRN ')
-#endif
-
-
-* quick trace without test on capacity
-#include "zebra/qtraceq.inc"
-
- NWDO = NWBAT(1)
- NDONE = 0
-
- 24 NWAV = L4ENDI - L4CURI
- IF (NWAV.EQ.0) GO TO 41
- IF (N4SKII.NE.0) GO TO 31
-
- NW = MIN (NWDO-NDONE, NWAV)
- CALL UCOPY (LQ(L4CURI), MBAT(NDONE+1), NW)
- NDONE = NDONE + NW
- L4CURI = L4CURI + NW
- IF (NDONE.LT.NWDO) GO TO 41
-#include "zebra/qtrace99.inc"
- RETURN
-
-C-- Skip over N4SKII leading data words
-
- 31 NSK = MIN (N4SKII,NWAV)
- L4CURI = L4CURI + NSK
- N4SKII = N4SKII - NSK
- IF (N4SKII.EQ.0) GO TO 46
-
-C---- Read next PhR / LR for batch continued
-
- 41 IFLAGI = -1
- CALL FZIREC
- IF (IFLAGI.NE.0) GO TO 999
- 46 IF (NWDO+N4SKII.NE.0) GO TO 24
- GO TO 999
- END
diff --git a/src/packlib/zebra/fq/fzitrx.F b/src/packlib/zebra/fq/fzitrx.F
deleted file mode 100644
index 8bac93d..0000000
--- a/src/packlib/zebra/fq/fzitrx.F
+++ /dev/null
@@ -1,94 +0,0 @@
-*
-* $Id: fzitrx.F,v 1.2 1999/06/18 13:29:18 couet Exp $
-*
-* $Log: fzitrx.F,v $
-* Revision 1.2 1999/06/18 13:29:18 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:15 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
-#if !defined(CERNLIB_FQXISN)
- SUBROUTINE FZITRX (MBAT,NWBAT)
-
-C- Transmit one batch of data from the input buffer,
-C- exchange file format, exchange data format
-C- service routine to FZIN
-C- careful : must not be called with N4SKII=0 .AND. NWBAT=0
-
-#include "zebra/zunit.inc"
-#include "zebra/mqsys.inc"
-#include "zebra/eqlqf.inc"
-#include "zebra/mzioc.inc"
-#include "zebra/fzci.inc"
-*
- DIMENSION MBAT(99), NWBAT(9)
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HFZIT, 4HRX /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HFZITRX /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'FZITRX ')
-#endif
-
-
-* quick trace without test on capacity
-#include "zebra/qtraceq.inc"
-
- NWFOTT = NWBAT(1)
- NWFODN = 0
-
- 24 NWFOAV = L4ENDI - L4CURI
- IF (NWFOAV.EQ.0) GO TO 41
- IF (N4SKII.NE.0) GO TO 31
-
- CALL FZICV (LQ(L4CURI),MBAT)
- L4CURI = L4CURI + IQUEST(1)
-
- IF (IFOCON(1).NE.0) GO TO 71
- 27 IF (NWFORE.NE.0) GO TO 41
-#include "zebra/qtrace99.inc"
- RETURN
-
-C-- Skip over N4SKII leading data words
-
- 31 NSK = MIN (N4SKII,NWFOAV)
- L4CURI = L4CURI + NSK
- N4SKII = N4SKII - NSK
- IF (N4SKII.EQ.0) GO TO 46
-
-C---- Read next PhR / LR for batch continued
-
- 41 IFLAGI = -1
- CALL FZIREC
- IF (IFLAGI.NE.0) GO TO 999
- 46 IF (NWFOTT+N4SKII.NE.0) GO TO 24
- GO TO 999
-
-C------ Conversion Problems
-
- 71 IQ(KQSP+LQFI+24) = IQ(KQSP+LQFI+24) + 1
-#if defined(CERNLIB_QPRINT)
- IF (LOGLVI.GE.1) WRITE (IQLOG,9071) LUNI,IFOCON
- 9071 FORMAT (1X/' FZITRX. LUN=',I4,', Conversion problem: ',
-#endif
-#if (defined(CERNLIB_QPRINT))&&(!defined(CERNLIB_HEX))&&(defined(CERNLIB_B60M))
- F 4O23)
-#endif
-#if (defined(CERNLIB_QPRINT))&&(!defined(CERNLIB_HEX))&&(!defined(CERNLIB_B60M))
- F 4O17)
-#endif
-#if (defined(CERNLIB_QPRINT))&&(defined(CERNLIB_HEX))
- F 4Z17)
-#endif
- IFOCON(1) = 0
- GO TO 27
- END
-#endif
diff --git a/src/packlib/zebra/fq/fzlimi.F b/src/packlib/zebra/fq/fzlimi.F
deleted file mode 100644
index 56e48ef..0000000
--- a/src/packlib/zebra/fq/fzlimi.F
+++ /dev/null
@@ -1,61 +0,0 @@
-*
-* $Id: fzlimi.F,v 1.2 1999/06/18 13:29:19 couet Exp $
-*
-* $Log: fzlimi.F,v $
-* Revision 1.2 1999/06/18 13:29:19 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:13 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE FZLIMI (LUNPAR,ALIMIP)
-
-C- SET END-OF-TAPE LIMIT
-
-#include "zebra/zunit.inc"
-#include "zebra/mqsys.inc"
-#include "zebra/eqlqf.inc"
-#include "zebra/fzcf.inc"
-*
- DIMENSION LUNPAR(9), ALIMIP(9)
-
-
- LUN = LUNPAR(1)
- ALIMIT = ALIMIP(1)
-
- CALL FZLOC (LUN,0)
- IF (LQFF.EQ.0) GO TO 99
-
- IF (ALIMIT) 21, 24, 31
- 21 Q(KQSP+LQFF+39) = 0.
- IQ(KQSP+LQFF+37) = 0
- IQ(KQSP+LQFF+38) = 0
-#if defined(CERNLIB_QPRINT)
- IF (LOGLVF.GE.0)
- +WRITE (IQLOG,9022) LUN
- 9022 FORMAT ('0FZLIMI. File at LUN=',I3,' has no output limit.')
-#endif
- GO TO 99
-
- 24 ALIMIT = REAL (IQ(KQSP+LQFF+20)) / 1000000.
- ALIMIT = ALIMIT + REAL (IQ(KQSP+LQFF+19)) + Q(KQSP+LQFF+39)
- GO TO 34
-
- 31 Q(KQSP+LQFF+39) = ALIMIT
- 34 NUM1 = ALIMIT
- FRAC = ALIMIT - REAL(NUM1)
- NUM2 = 1000000. * FRAC
- IQ(KQSP+LQFF+37) = NUM1
- IQ(KQSP+LQFF+38) = NUM2
-
-#if defined(CERNLIB_QPRINT)
- IF (LOGLVF.GE.0)
- +WRITE (IQLOG,9036) LUN,NUM1,NUM2
- 9036 FORMAT ('0FZLIMI. Output limit for file at LUN=',I3,
- F' IS',I7,' Mwords +',I6,' Words.')
-#endif
- 99 RETURN
- END
diff --git a/src/packlib/zebra/fq/fzloc.F b/src/packlib/zebra/fq/fzloc.F
deleted file mode 100644
index 6e81c3b..0000000
--- a/src/packlib/zebra/fq/fzloc.F
+++ /dev/null
@@ -1,207 +0,0 @@
-*
-* $Id: fzloc.F,v 1.3 1999/06/18 13:29:22 couet Exp $
-*
-* $Log: fzloc.F,v $
-* Revision 1.3 1999/06/18 13:29:22 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.2 1996/04/18 16:10:44 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:15 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE FZLOC (LUNP,MODEP)
-
-C- Locate FZ control-bank for unit LUN
-C- Unpack control information
-
-C- MODE = -2 or +2 : connect as output unit
-C- -1 or +1 : connect as input unit
-C- 0 : no connection (for FZFILE, FZHOOK, FZLIMI, etc)
-C- if > 0 : unit is required for the given I/O mode
-C- if < 0 : wanting to 'end' the unit (for FZENDx)
-C- if IQUEST(1) < 0 : connect only if active
-C- (loop for all units)
-C- = 0 : connect if possible
-C- (for the particular unit)
-
-#include "zebra/zstate.inc"
-#include "zebra/mqsys.inc"
-#include "zebra/eqlqf.inc"
-#include "zebra/fzcf.inc"
-#include "zebra/fzci.inc"
-#include "zebra/fzcx.inc"
-*
- DIMENSION LUNP(9), MODEP(9)
- DIMENSION PILX(4)
- EQUIVALENCE (PILX(1),IPILX(1))
-#if defined(CERNLIB_QMVDS)
- SAVE CHDATA
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HFZLO, 4HC /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HFZLOC /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'FZLOC ')
-#endif
- DATA CHDATA / 12345.0 /
-
-#include "zebra/q_jbit.inc"
-#include "zebra/q_jbyt.inc"
-
- LUN = LUNP(1)
- MODE = MODEP(1)
- MODA = IABS(MODE)
- MODS = IQUEST(1)
-
- LQFF = LQFS
- 14 IF (LQFF.NE.0) THEN
- IF (IQ(KQSP+LQFF-5).EQ.LUN) GO TO 21
- LQFF = LQ(KQSP+LQFF)
- GO TO 14
- ELSE
- LUNF = 0
- IACTVF= 0
- IF (MODE.GT.0) GO TO 94
- RETURN
- ENDIF
-
-C-- Bank for LUN found
-
- 21 MSTATF = IQ(KQSP+LQFF)
- MEDIUF = JBYT (MSTATF,1,3)
- IFIFOF = JBYT (MSTATF,4,3)
- IDAFOF = JBIT (MSTATF,7)
- IACMOF = JBYT (MSTATF,8,3)
- IUPAKF = JBIT (MSTATF,16)
- IADOPF = IQ(KQSP+LQFF+1)
- IACTVF = IQ(KQSP+LQFF+2)
- INCBPF = IQ(KQSP+LQFF+3)
- LOGLVF = IQ(KQSP+LQFF+4)
- MAXREF = IQ(KQSP+LQFF+5)
- LUNF = LUN
- IF (MODA-1) 79, 31, 51
-
-C-- Connect as input unit
-
- 31 IF (IACTVF.LT.1) GO TO 34
- IF (IACTVF.GE.8) GO TO 34
- 32 MSTATI = MSTATF
- MEDIUI = MEDIUF
- IFIFOI = IFIFOF
- IDAFOI = IDAFOF
- IACMOI = IACMOF
- IUPAKI = IUPAKF
- IADOPI = IADOPF
- IACTVI = IACTVF
- INCBPI = INCBPF
- LOGLVI = LOGLVF
- MAXREI = MAXREF
- LUNI = LUNF
- LQFI = LQFF
- GO TO 79
-
-C-- connection required
- 34 IF (MODE.LT.0) GO TO 36
- IF (JBIT(MSTATF,11).EQ.0) GO TO 93
- IF (IACTVF.EQ.0) GO TO 37
- IF (IACTVF.EQ.8) GO TO 37
- IF (IACTVF.NE.18) GO TO 92
- IACTVF = 0
- GO TO 37
-
-C-- connect if possible
- 36 IF (MODS.LT.0) GO TO 79
- IF (JBIT(MSTATF,11).EQ.0) GO TO 79
- IF (IACTVF.EQ.0) GO TO 37
- IF (IACTVF.EQ.8) GO TO 37
- IF (IACTVF.NE.18) GO TO 79
-
-C-- clear buffer parameters
- 37 IF (IFIFOF.EQ.0) GO TO 32
- CALL VZERO (IQ(KQSP+LQFF+40),INCBPF-40)
- GO TO 32
-
-
-C-- Connect as output unit
-
- 51 IF (IACTVF.LT.11) GO TO 54
- IF (IACTVF.EQ.18) GO TO 54
- 52 MSTATX = MSTATF
- MEDIUX = MEDIUF
- IFIFOX = IFIFOF
- IDAFOX = IDAFOF
- IACMOX = IACMOF
- IUPAKX = IUPAKF
- IADOPX = IADOPF
- IACTVX = IACTVF
- INCBPX = INCBPF
- LOGLVX = LOGLVF
- MAXREX = MAXREF
- LUNX = LUNF
- LQFX = LQFF
- GO TO 79
-
-C-- connection required
- 54 IF (MODE.LT.0) GO TO 56
- IF (JBIT(MSTATF,12).EQ.0) GO TO 93
- IF (IACTVF.EQ.10) GO TO 57
- IF (IACTVF.NE.0) GO TO 91
- GO TO 57
-
-C-- connect if possible
- 56 IF (MODS.LT.0) GO TO 79
- IF (JBIT(MSTATF,12).EQ.0) GO TO 79
- IF (IACTVF.EQ.10) GO TO 57
- IF (IACTVF.NE.0) GO TO 79
-
-C-- clear buffer parameters
- 57 IF (IFIFOF.NE.0) CALL VZERO (IQ(KQSP+LQFF+40),INCBPF-40)
- PILX(1) = CHDATA
- IPILX(2) = 10000.0 * QVERSN + .2
- IPILX(3) = 0
- IPILX(4) = 0
- GO TO 52
-
- 79 RETURN
-
-C-------------------------------------------------
-C- trouble
-C-------------------------------------------------
-
-C-- Write after read without FZEND
-
- 91 NQCASE = -1
-
-C-- Read after write without REWIND
-
- 92 NQCASE = NQCASE + 2
- NQFATA = 3
- IQUEST(13) = IACTVF
- GO TO 90
-
-C-- Permission fault
-
- 93 NQCASE = 3
- NQFATA = 3
- IQUEST(13) = JBYT (MSTATF,11,2)
- GO TO 90
-
-C-- File not opened
-
- 94 NQCASE = 4
- NQFATA = 2
- 90 IQUEST(11) = LUN
- IQUEST(12) = MODE
-#include "zebra/qtrace.inc"
-#include "zebra/qtofatal.inc"
- END
diff --git a/src/packlib/zebra/fq/fzlogl.F b/src/packlib/zebra/fq/fzlogl.F
deleted file mode 100644
index 71a153e..0000000
--- a/src/packlib/zebra/fq/fzlogl.F
+++ /dev/null
@@ -1,46 +0,0 @@
-*
-* $Id: fzlogl.F,v 1.2 1999/06/18 13:29:24 couet Exp $
-*
-* $Log: fzlogl.F,v $
-* Revision 1.2 1999/06/18 13:29:24 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:13 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE FZLOGL (LUNPAR,LOGLP)
-
-C- SET DIAGNOSTIC LOGGING LEVEL
-
-#include "zebra/zunit.inc"
-#include "zebra/mqsys.inc"
-#include "zebra/eqlqf.inc"
-#include "zebra/fzcf.inc"
-#include "zebra/fzci.inc"
-#include "zebra/fzcx.inc"
-*
- DIMENSION LUNPAR(9), LOGLP(9)
-
-
- LUN = LUNPAR(1)
- LOGL = LOGLP(1)
-#if !defined(CERNLIB_QDEVZE)
- LOGL = MIN (LOGL,4)
-#endif
- CALL FZLOC (LUN,0)
- IF (LQFF.EQ.0) RETURN
-
-#if defined(CERNLIB_QPRINT)
- IF (LOGL.GE.0) WRITE (IQLOG,9022) LUN,LOGL
- 9022 FORMAT (1X/' FZLOGL. File at LUN=',I3,
- F', Diagnostic log level=',I2)
-#endif
-
- IQ(KQSP+LQFF+4) = LOGL
- IF (LUNF.EQ.LUNI) LOGLVI=LOGL
- IF (LUNF.EQ.LUNX) LOGLVX=LOGL
- RETURN
- END
diff --git a/src/packlib/zebra/fq/fzmach.F b/src/packlib/zebra/fq/fzmach.F
deleted file mode 100644
index d59ad6a..0000000
--- a/src/packlib/zebra/fq/fzmach.F
+++ /dev/null
@@ -1,78 +0,0 @@
-*
-* $Id: fzmach.F,v 1.2 1999/06/18 13:29:25 couet Exp $
-*
-* $Log: fzmach.F,v $
-* Revision 1.2 1999/06/18 13:29:25 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:15 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE FZMACH (JOPP)
-
-C- System operations 0 : REWIND 1 : UNLOAD, 2 : CLOSE
-
-#include "zebra/zunit.inc"
-#include "zebra/fzcf.inc"
-*
-
-
- IF (MEDIUF.GE.4) GO TO 99
- IF (JOPP.GE.2) GO TO 41
-
-C---- Rewind
-
- IF (IFIFOF.EQ.2) GO TO 99
-#if defined(CERNLIB_FZLIBC)
- IF (IACMOF.EQ.2) THEN
- IF (IADOPF.LT.0) GO TO 99
- CALL CFREW (IADOPF, MEDIUF)
- GO TO 29
- ENDIF
-#endif
-
-C-- Non-Fortran REWIND
-
-#include "fzrewex.inc"
-* Ignoring t=pass
-
-C-- Fortran REWIND
-
- 28 REWIND LUNF
- 29 CONTINUE
-#if defined(CERNLIB_QPRINT)
- IF (LOGLVF.GE.0) WRITE (IQLOG,9029) LUNF
- 9029 FORMAT (10X,'LUN=',I4,' Rewind')
-#endif
- GO TO 99
-
-C---- Close
-
- 41 CONTINUE
-#if defined(CERNLIB_FZLIBC)
- IF (IACMOF.EQ.2) THEN
- IF (IADOPF.LT.0) GO TO 99
- CALL CFCLOS (IADOPF, MEDIUF)
- IADOPF = -1
- GO TO 49
- ENDIF
-#endif
-
-C-- Non-Fortran CLOSE
-
-#include "fzclosex.inc"
-* Ignoring t=pass
-
-C-- Fortran CLOSE
-
- 48 CLOSE (LUNF)
- 49 CONTINUE
-#if defined(CERNLIB_QPRINT)
- IF (LOGLVF.GE.0) WRITE (IQLOG,9049) LUNF
- 9049 FORMAT (10X,'LUN=',I4,' Close')
-#endif
- 99 RETURN
- END
diff --git a/src/packlib/zebra/fq/fzmemo.F b/src/packlib/zebra/fq/fzmemo.F
deleted file mode 100644
index aeb8f96..0000000
--- a/src/packlib/zebra/fq/fzmemo.F
+++ /dev/null
@@ -1,100 +0,0 @@
-*
-* $Id: fzmemo.F,v 1.2 1999/06/18 13:29:26 couet Exp $
-*
-* $Log: fzmemo.F,v $
-* Revision 1.2 1999/06/18 13:29:26 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:13 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
-#if defined(CERNLIB_FZMEMORY)
- SUBROUTINE FZMEMO (LUNP,MBUF,NWBUF)
-
-C- Connect user buffer for M mode, User called
-
-#include "zebra/zmach.inc"
-#include "zebra/zunit.inc"
-#include "zebra/mqsys.inc"
-#include "zebra/eqlqf.inc"
-#include "zebra/fzcf.inc"
-*
- DIMENSION LUNP(9), MBUF(99)
-
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HFZME, 4HMO /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HFZMEMO /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'FZMEMO ')
-#endif
-
-#include "zebra/q_locf.inc"
-
-* quick trace without test on capacity
-#include "zebra/qtraceq.inc"
-
- LUN = LUNP(1)
-
- CALL FZLOC (LUN,0)
- IF (LUNF.EQ.0) LOGLVF=1
- IF (IFIFOF.NE.3) LOGLVF=1
-
- IQUEST(2) = LOCF (MBUF(1))
- IQUEST(3) = IQUEST(2) - LQASTO
- IQUEST(7) = NWBUF
- IQUEST(8) = IQUEST(7)
-#if !defined(CERNLIB_B32)
- IF (IUPAKF.EQ.0) THEN
-#endif
-#if !defined(CERNLIB_B32)
- IQUEST(8) = (IQBITW*IQUEST(8)) / 32
-#endif
-#if !defined(CERNLIB_B32)
- ENDIF
-#endif
-#if defined(CERNLIB_QPRINT)
- IF (LOGLVF.GE.1) WRITE (IQLOG,9024) LUN
- 9024 FORMAT (1X/' FZMEMO. Connect user buffer for LUN=',I3)
-
-#endif
-#if defined(CERNLIB_QDEVZE)
- IF (LOGLVF.GE.1) THEN
- IQUEST(4) = LOCF (LQ(IQUEST(3)))
- WRITE (IQLOG,9824) IQUEST(2),IQUEST(3),IQUEST(4)
- WRITE (IQLOG,9825) IQUEST(7),IQUEST(8)
- ENDIF
- 9824 FORMAT (1X/' DEVZE FZMEMO, LOCF(BUF) / LBUF /'
- F,' LOCF(LQ(LBUF)) = ',3I9)
- 9825 FORMAT (16X,'NW machine / 32-bit =',2I6)
-
-#endif
- IF (LUNF.EQ.0) GO TO 91
- IF (IFIFOF.NE.3) GO TO 92
-
- IQ(KQSP+LQFF+1) = IQUEST(3)
- IQ(KQSP+LQFF+8) = IQUEST(3)
- IQ(KQSP+LQFF+9) = IQUEST(8)
- GO TO 999
-
-C-------------------------------------------------
-C- Error handling
-C-------------------------------------------------
-
- 91 IQUEST(1) = 1
- CALL ZFATAM ('FZMEMO - Stream not existing.')
-
- 92 IQUEST(1) = 2
- CALL ZFATAM ('FZMEMO - Stream not ready for Memory mode.')
-
-#include "zebra/qtrace99.inc"
- RETURN
- END
-#endif
diff --git a/src/packlib/zebra/fq/fzntolds.inc b/src/packlib/zebra/fq/fzntolds.inc
deleted file mode 100644
index 94c14b1..0000000
--- a/src/packlib/zebra/fq/fzntolds.inc
+++ /dev/null
@@ -1,13 +0,0 @@
-*
-* $Id: fzntolds.inc,v 1.1.1.1 1996/03/06 10:47:08 mclareni Exp $
-*
-* $Log: fzntolds.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:08 mclareni
-* Zebra
-*
-*
-* Installation param.: max size of any data-struct.
-*
-* fzntolds.inc
-*
- PARAMETER (NTOLDS = 16000000)
diff --git a/src/packlib/zebra/fq/fznwmach.inc b/src/packlib/zebra/fq/fznwmach.inc
deleted file mode 100644
index e99f57c..0000000
--- a/src/packlib/zebra/fq/fznwmach.inc
+++ /dev/null
@@ -1,38 +0,0 @@
-*
-* $Id: fznwmach.inc,v 1.1.1.1 1996/03/06 10:47:09 mclareni Exp $
-*
-* $Log: fznwmach.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:09 mclareni
-* Zebra
-*
-*
-*
-* fznwmach.inc
-*
-#if defined(CERNLIB_QMCDC)
- NWMIN = (32*NWMIN) / 60
-#endif
-*
-* fznwmach.inc
-*
-#if defined(CERNLIB_QMCRY)
- NWMIN = NWMIN / 2
-#endif
-*
-* fznwmach.inc
-*
-#if (defined(CERNLIB_QMCV64))&&(!defined(CERNLIB_QIEEE))
- NWMIN = NWMIN / 2
-#endif
-*
-* fznwmach.inc
-*
-#if defined(CERNLIB_QMIBMD)
- NWMIN = NWMIN / 2
-#endif
-*
-* fznwmach.inc
-*
-#if defined(CERNLIB_QMIRTD)
- NWMIN = NWMIN / 2
-#endif
diff --git a/src/packlib/zebra/fq/fzoaln.F b/src/packlib/zebra/fq/fzoaln.F
deleted file mode 100644
index c8e541a..0000000
--- a/src/packlib/zebra/fq/fzoaln.F
+++ /dev/null
@@ -1,84 +0,0 @@
-*
-* $Id: fzoaln.F,v 1.2 1999/06/18 13:29:26 couet Exp $
-*
-* $Log: fzoaln.F,v $
-* Revision 1.2 1999/06/18 13:29:26 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:14 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
-#if defined(CERNLIB_FZALFA)
- SUBROUTINE FZOALN
-
-C- Write 80 characters from the card buffer, left-adjust rest
-C- service routine to FZOASC
-
-C- Flush the buffer if IFLEND .GT. 0
-
-#include "zebra/zbcd.inc"
-#include "zebra/zkrakcc.inc"
-#include "zebra/zstate.inc"
-#include "zebra/zunit.inc"
-#include "zebra/mqsysh.inc"
-*
-
- CHARACTER LINEW*80
- EQUIVALENCE (LINEW,CQHOLK)
-
- EQUIVALENCE (LUN ,IQUEST(90))
- EQUIVALENCE (JPUT,IQUEST(91)), (IFLEND,IQUEST(92))
-
-
- NU = 80
- IF (IFLEND.NE.0) GO TO 41
-
-C-- Translate to characters
-
- 12 DO 14 J=2,NU
- 14 IQCETK(J) = IQLETT(IQCETK(J)+1)
-
- CALL UH1TOC (IQCETK,LINEW,80)
-
- WRITE (LUN,'(A)',IOSTAT=ISW) LINEW
- IF (ISW.NE.0) THEN
- IQUEST(1) = 19
- IQUEST(2) = 41
- IQUEST(3) = ISW
- IQUEST(4) = LUN
- CALL ZFATAL
- ENDIF
-#if defined(CERNLIB_QDEVZE)
- IF (NQDEVZ.NE.0) WRITE (IQLOG,9817) LINEW
- 9817 FORMAT (' DEVZE FZOALN, send line=',A)
-#endif
-
-C-- Copy excess numbers to start of line
-
- IQCETK(1) = IQBLAN
-
- JPUT = JPUT - 80
- IF (JPUT.LE.0) THEN
- JPUT = 1
- RETURN
- ELSE
- DO 24 J=1,JPUT
- 24 IQCETK(J+1) = IQCETK(J+80)
- JPUT = JPUT + 1
- IF (IFLEND.EQ.0) RETURN
- ENDIF
-
-C---- End-of-record, flush buffer
-
- 41 IF (JPUT.GT.80) GO TO 12
- IF (IFLEND.LT.0) RETURN
- IQCETK(1) = IQLESS
- IF (JPUT.EQ.80) GO TO 12
- CALL VBLANK (IQCETK(JPUT+1),80-JPUT)
- NU = JPUT
- GO TO 12
- END
-#endif
diff --git a/src/packlib/zebra/fq/fzoapk.F b/src/packlib/zebra/fq/fzoapk.F
deleted file mode 100644
index 2be8a64..0000000
--- a/src/packlib/zebra/fq/fzoapk.F
+++ /dev/null
@@ -1,134 +0,0 @@
-*
-* $Id: fzoapk.F,v 1.3 1999/06/18 13:29:27 couet Exp $
-*
-* $Log: fzoapk.F,v $
-* Revision 1.3 1999/06/18 13:29:27 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.2 1996/04/18 16:10:44 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:14 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
-#if defined(CERNLIB_FZALFA)
- SUBROUTINE FZOAPK (LBUFCP,LBUFEP)
-
-C- Unpack the set of words LQ(LBUFC) to LQ(LBUFE-1) at most
-C- into LQ(LUPKA) to LQ(LUPKE-1) at most;
-C- service routine to FZOASC.
-
-C- Return LUPKE the adr of the first word after the unpack vector.
-C- For each word unpacked recognise the type and store 8 numbers:
-C-
-C- normal number repetition N+1 times
-C- L + 0 type L + 0 -43 to signal repeat
-C- + 1 sub-type + 1 N for N+2 numbers in all
-C- + 2 bits 26-30
-C- + 3 bits 21-25
-C- ...
-C- + 7 bits 1- 5
-
-#include "zebra/zstate.inc"
-#include "zebra/mqsysh.inc"
-*
- DIMENSION LBUFCP(9), LBUFEP(9)
-
- EQUIVALENCE (LUPKA,IQUEST(93)), (LUPKE, IQUEST(94))
-
-
-#include "zebra/q_jbyt.inc"
-
-
- LBUFC = LBUFCP(1)
- LBUFE = LBUFEP(1)
- LUPK = LUPKA
- LUPKE = LUPKE - 10
-#if defined(CERNLIB_QDEVZE)
- IF (NQDEVZ.NE.0) CALL VZERO (LQ(LUPK),LUPKE+8-LUPK)
-#endif
-
- 11 IWORD = LQ(LBUFC)
- LBUFC = LBUFC + 1
- JTYPS = 0
- M31 = JBYT (IWORD,31,2)
-
-C-- Short cut if integer 0->9
-
- IF (M31.NE.0) GO TO 14
- IF (IWORD.GE.10) GO TO 14
- JTYPE = 0
- JTYPS = IWORD + 26
- LQ(LUPK+7) = IWORD
- GO TO 38
- 14 CONTINUE
-
-C-- Unpack all bytes
-
- LQ(LUPK+2) = JBYT (IWORD,26,5)
- LQ(LUPK+3) = JBYT (IWORD,21,5)
- LQ(LUPK+4) = JBYT (IWORD,16,5)
- LQ(LUPK+5) = JBYT (IWORD,11,5)
- LQ(LUPK+6) = JBYT (IWORD, 6,5)
- LQ(LUPK+7) = JBYT (IWORD, 1,5)
-
-C-- Type : small +ve integer
-
- IF (M31.NE.0) GO TO 21
- IF (LQ(LUPK+2).NE.0) GO TO 31
- JTYPE = 5
- DO 16 J=3,6
- IF (LQ(LUPK+J).NE.0) GO TO 38
- 16 JTYPS = JTYPS + 1
- GO TO 38
-
-C-- Type : small negative integer
-
- 21 IF (M31.NE.3) GO TO 31
- IF (LQ(LUPK+2).NE.31) GO TO 31
- JTYPE = 6
- DO 24 J=3,6
- IF (LQ(LUPK+J).NE.31) GO TO 38
- 24 JTYPS = JTYPS + 1
- GO TO 38
-
-C-- Type : normal words, check short mantissa
-
- 31 JTYPE = M31 + 1
- DO 36 J=7,4,-1
- IF (LQ(LUPK+J).NE.0) GO TO 38
- 36 JTYPS = JTYPS + 1
-
-C-- Store Main type and sub-type, check repeat
-
- 38 LQ(LUPK) = JTYPE
- LQ(LUPK+1) = JTYPS
- LUPK = LUPK + 8
- IF (LBUFC.EQ.LBUFE) GO TO 49
- IF (LQ(LBUFC).EQ.IWORD) GO TO 61
- 39 IF (LUPK.LT.LUPKE) GO TO 11
-
- 49 LQ(LUPK) = -1
- LUPKE = LUPK
- RETURN
-
-C---- Check set of identical words
-
- 61 NL = LBUFE - LBUFC - 1
- NC = 0
- DO 63 J=1,NL
- IF (LQ(LBUFC+J).NE.IWORD) GO TO 64
- 63 NC = NC + 1
-
- 64 IF (NC.LT.2) THEN
- IF (JTYPE.EQ.0) GO TO 39
- ENDIF
- LQ(LUPK) = -43
- LQ(LUPK+1) = NC
- LUPKE = LUPK + 2
- RETURN
- END
-#endif
diff --git a/src/packlib/zebra/fq/fzoasc.F b/src/packlib/zebra/fq/fzoasc.F
deleted file mode 100644
index b83083c..0000000
--- a/src/packlib/zebra/fq/fzoasc.F
+++ /dev/null
@@ -1,289 +0,0 @@
-*
-* $Id: fzoasc.F,v 1.3 1999/06/18 13:29:28 couet Exp $
-*
-* $Log: fzoasc.F,v $
-* Revision 1.3 1999/06/18 13:29:28 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.2 1996/04/18 16:10:45 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:14 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
-#if defined(CERNLIB_FZALFA)
- SUBROUTINE FZOASC (LUNP,LBUFAP,LBUFEP,JFAST,LWORKA,LWORKE)
-
-C- Dump one physical record to cards in ALFA mode,
-C- service routine to FZOUT.
-
-C- The record is stored in words LQ(LBUFA) to LQ(LBUFE-1)
-C- It is a 'fast' record if JFAST .NE. 0
-C- The working space available to FZOASC
-C- is LQ(LWORKA) to LQ(LWORKE) if LWORKE .NE. 0
-C- or LQ(LWORKA) to LQ(LBUFC) if LWORKE .EQ. 0
-
-#include "zebra/zbcd.inc"
-#include "zebra/zkrakc.inc"
-#include "zebra/zstate.inc"
-#include "zebra/zunit.inc"
-#include "zebra/mqsysh.inc"
-*
- DIMENSION LUNP(9), LBUFAP(9), LBUFEP(9)
-
- DIMENSION MTYPTR(7), ICHSUM(2)
- EQUIVALENCE (LUN ,IQUEST(90))
- EQUIVALENCE (JPUT,IQUEST(91)), (IFLEND,IQUEST(92))
- EQUIVALENCE (LUPKA,IQUEST(93)), (LUPKE, IQUEST(94))
-
-#if defined(CERNLIB_QMVDS)
- SAVE MTYPTR
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HFZOA, 4HSC /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HFZOASC /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'FZOASC ')
-#endif
- DATA MTYPTR / 0, 0, 5, 10, 15, 20, 36 /
-
-#include "zebra/q_jbyt.inc"
-
-#include "zebra/qtraceq.inc"
-
- LUN = LUNP(1)
- LBUFA = LBUFAP(1)
- LBUFE = LBUFEP(1)
- LWKA = LWORKA
- LWKE = LWORKE
-
- LUPKA = LWKA
- LUPKE = LWKE
- NWWKU = LWKE - LWKA
- IF (LUPKE.EQ.0) THEN
- LUPKE = LBUFA
- NWWKU = 0
- ENDIF
-
- IQCETK(1) = IQGREA
- IQCETK(2) = 58
- IF (JFAST.EQ.0) THEN
- IQCETK(3) = 27
- LBUFC = LBUFA + 4
- ELSE
- IQCETK(3) = 26
- LBUFC = LBUFA
- ENDIF
- JPUT = 3
- IFLEND = 0
- ITYPE = 0
- ITYPC = -1
-
- ICHSUM(1) = 0
- ICHSUM(2) = 0
- GO TO 40
-
-C-------- Do next word
-
- 31 IWORD = LQ(LBUFC)
- 32 JTYPE = LQ(LUPK)
- IF (JTYPE.LT.0) GO TO 61
-#if defined(CERNLIB_QDEVZE)
- IF (NQDEVZ.GE.9) THEN
- WRITE (IQLOG,9832) LBUFC+1-LBUFA,IWORD,(LQ(LUPK+J),J=0,9)
- DO 33 J=0,7
- IF (IABS(LQ(LUPK+J)).GT.99) WRITE (IQLOG,9833) LQ(LUPK+J)
- 33 CONTINUE
- ENDIF
-
-#endif
-#if (defined(CERNLIB_QDEVZE))&&(defined(CERNLIB_B32))
- 9832 FORMAT (' DEVZE FZOASC, do word',I4,Z9,' Upk=',8I3,' Next',2I5)
- 9833 FORMAT (22X,Z9)
-#endif
-#if (defined(CERNLIB_QDEVZE))&&(!defined(CERNLIB_B32))
- 9832 FORMAT (' DEVZE FZOASC, do word',I4,Z17,' Upk=',8I3,' Next',2I5)
- 9833 FORMAT (22X,Z17)
-
-#endif
- JTYPS = LQ(LUPK+1)
- JTYPC = MTYPTR(JTYPE+1) + JTYPS
-
-C-- same type running
- IF (JTYPC.EQ.ITYPC) GO TO 36
-
-C-- M-type 0 : integers 0 -> 9
-
- IF (JTYPE.NE.0) GO TO 41
- IF (ITYPC.EQ.24) GO TO 36
- JBA = 0
-
-C------ Store next word
-
-C-- terminate running type by ']', if any
- 34 IF (ITYPE.NE.0) THEN
- JPUT = JPUT + 1
- IQCETK(JPUT) = 53
- ITYPE = 0
- ITYPC = -1
- ENDIF
-
-C-- place type-code
- 35 JPUT = JPUT + 1
- IQCETK(JPUT) = JTYPC
- IF (JBA.EQ.0) GO TO 38
-
-C-- place significant bytes
- 36 DO 37 J=JBA,JBE
- JPUT = JPUT + 1
- 37 IQCETK(JPUT) = LQ(LUPK+J)
- 38 LUPK = LUPK + 8
-
-C-- put blank separator for tests
-#if defined(CERNLIB_FQABLANK)
- JPUT = JPUT + 1
- IQCETK(JPUT) = 44
-#endif
-
-C-- Cumulate check-sum
-
- ICHSUM(1) = ICHSUM(1) + JBYT (IWORD,17,16)
- ICHSUM(2) = ICHSUM(2) + JBYT (IWORD, 1,16)
-
-C-- Write line if full
-
- IF (JPUT.GE.80) CALL FZOALN
-
-C-- End-of-record ?
-
- LBUFC = LBUFC + 1
- IF (LBUFC.EQ.LBUFE) GO TO 81
-
-C-- Unpack the next lot, if necc.
-
- IF (LUPK.LT.LUPKE) GO TO 31
-
- IF (NWWKU.NE.0) THEN
- IF (NWWKU.GE.LBUFC-LBUFA) THEN
- LUPKE = LWKE
- ELSE
- LUPKA = LBUFA
- LUPKE = LBUFC
- ENDIF
- ELSE
- LUPKE = LBUFC
- ENDIF
-
- 40 LUPKEL = LUPKE
- CALL FZOAPK (LBUFC,LBUFE)
- LUPK = LUPKA
- GO TO 31
-
-C------ Type analysis
-C- come to here if the type of the current word
-C- is not the one of the running set, and if
-C- the current M-type is not zero
-
-
- 41 NTYPE = LQ(LUPK+8)
- NTYPS = LQ(LUPK+9)
- NTYPC = -2
- IF (NTYPE.GE.0) NTYPC = MTYPTR(NTYPE+1) + NTYPS
-
-C-- Check next word after current has again ITYPC
-C- and ITYPC covers JTYPC with 1 or 2 zero bytes
-
- IF (JTYPE.NE.ITYPE) GO TO 51
- IF (NTYPC.NE.ITYPC) GO TO 51
- N = JTYPC - ITYPC
- IF (N.LT.0) GO TO 51
- IF (N.LT.3) GO TO 36
-
-C---- The running set is definitely not continued
-
- 51 IF (JTYPE.LT.5) THEN
- JBA = 2
- JBE = 7 - JTYPS
- ELSE
- JBA = 3 + JTYPS
- JBE = 7
- ENDIF
-
-C---- Start of a new set if this and the next
-C- two numbers are of the same type
-
- IF (NTYPC.NE.JTYPC) GO TO 34
- IF (LUPK+16.GE.LUPKE) GO TO 34
- IF (LQ(LUPK+16).NE.JTYPE) GO TO 34
- IF (LQ(LUPK+17).NE.JTYPS) GO TO 34
-
- ITYPE = JTYPE
- ITYPC = JTYPC
- JPUT = JPUT + 1
- IQCETK(JPUT) = 57
- GO TO 35
-
-C------ Repeat last number N+1 times
-
- 61 CONTINUE
-#if defined(CERNLIB_QDEVZE)
- IF (JTYPE.NE.-43) CALL ZFATAM ('FZOASC - trouble.')
-#endif
- JPUT = JPUT + 1
- IQCETK(JPUT) = 43
-
- LUPK = LUPK + 1
- IWORD = LQ(LUPK)
- LBUFC = LBUFC + IWORD
-#if defined(CERNLIB_QDEVZE)
- LUPKEL = LUPKEL - 4
- LUPK = LUPKEL
- LQ(LUPK) = IWORD
-#endif
-
- LUPKE = LUPKEL
- CALL FZOAPK (LUPK,LUPK+1)
- 68 LUPK = LUPKA
- ITYPE = 0
- ITYPC = -1
- GO TO 32
-
-C-------- End of record
-
- 81 IF (IFLEND.NE.0) GO TO 84
- JPUT = JPUT + 1
- IQCETK(JPUT) = 59
- LST = LUPKA
- LUPKA = LUPKA + 2
- LUPKE = LUPKEL
-
- LQ(LST) = ICHSUM(1)
- LQ(LST+1) = ICHSUM(2)
- CALL FZOAPK (LST,LST+2)
-
- IFLEND = -1
- LBUFC = LBUFE - 1
- IWORD = ICHSUM(1)
- GO TO 68
-
- 84 IF (IFLEND.NE.-1) GO TO 86
- IFLEND = -2
- LBUFC = LBUFE - 1
- IWORD = LQ(LST+1)
- GO TO 32
-
- 86 IFLEND = 7
- CALL FZOALN
-
-#include "zebra/qtrace99.inc"
- RETURN
- END
-#endif
diff --git a/src/packlib/zebra/fq/fzocv.F b/src/packlib/zebra/fq/fzocv.F
deleted file mode 100644
index 9c7d47c..0000000
--- a/src/packlib/zebra/fq/fzocv.F
+++ /dev/null
@@ -1,229 +0,0 @@
-*
-* $Id: fzocv.F,v 1.3 1999/06/18 13:29:30 couet Exp $
-*
-* $Log: fzocv.F,v $
-* Revision 1.3 1999/06/18 13:29:30 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.2 1996/04/18 16:10:46 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:11 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
-#if !defined(CERNLIB_FQXISN)
- SUBROUTINE FZOCV (MS,MT)
-
-C- Convert for output with copy
-C- from source in native to target in exchange data format
-
-#include "zebra/quest.inc"
-#include "zebra/mzioc.inc"
-*
- DIMENSION MS(99), MT(99)
-
- DOUBLE PRECISION THDB
- DIMENSION THIS(2)
- EQUIVALENCE (THDB,THIS)
- EQUIVALENCE (ITHA,THA,THIS(1)), (ITHB,THB,THIS(2))
-
-C---- Conversion Control in /MZIOC/ :
-
-C- for a given call translation source MS -> target MT is done
-C- either for a complete batch of NWFOTT words
-C- if NWFODN.EQ.0 and NWFOAV.GE.NWFOTT
-
-C- or for the first instalment of a batch of NWFOTT words
-C- if NWFODN.EQ.0 and NWFOAV.LT.NWFOTT
-
-C- or for a new instalment of N=MIN(NWFOAV,NWFOTT-NWFODN)
-C- words, if NWFODN.NE.0
-
-C- * marks words to be initialized by the caller
-C- only for the call at the beginning of a new batch
-C-
-C- NWFOAV number of words available in the buffer to receive
-C- the result
-C- set by the caller whenever a new lot of data
-C- becomes available for conversion (new buffer)
-C- counted down by FZOCV
-C- * NWFOTT total number of words in the batch to be done,
-C- maybe in several instalments
-C- * NWFODN number of words in the batch already done
-C- set to zero by the caller at start of batch
-C- (in fact MZIOCR sets it to zero)
-C- NWFORE n.w. remaining to be done for the pending batch
-C- set by FZOCV, zero if end of batch
-C-
-C- IFOCON remembers the last conversion problem
-C- (1) error code if -ve, expected type if +ve
-C- (2) location of the word
-C- (3) content of the word
-
-C- MFOSAV
-C- (1+2) saves type and word-count for re-entry
-
-C- * JFOEND position of last sector plus 1
-C- * JFOREP position of repeat sector descr.
-C- JFOCUR position of current sector description
-
-C- * MFO(JFO+1) t= sector type as in format
-C- * +2) c= word count as in format
-C- c > 0 : no. of words
-C- c = 0 : dynamic sector
-C- c < 0 : indefinite sector, rest of the bank
-
-C- JMT # of words done so far for the current call
-C- JMS # of words done so far for the current batch
-
-#include "fzocvd1.inc"
-#include "fzocvd2.inc"
-
-
- JMT = 0
- IF (NWFODN.NE.0) GO TO 30
-
- NWFORE = NWFOTT
- JMTEX = MIN (NWFORE,NWFOAV)
-
- JMS = 0
- JFOCUR = 0
- IFOCON(1) = 0
-
-C------ Start next sector
-
- 21 ITYPE = MFO(JFOCUR+1)
- IF (ITYPE.EQ.7) GO TO 24
- NWSEC = MFO(JFOCUR+2)
- IF (NWSEC) 22, 23, 31
-
-C-- Rest of the bank
-
- 22 NWSEC = NWFORE
- GO TO 31
-
-C-- Dynamic sector
-
- 23 IWORD = MS(JMS+1)
- NWSEC = IWORD
- GO TO 25
-
-C-- Self-describing sector
-
- 24 IWORD = MS(JMS+1)
- ITYPE = MOD (IWORD,16)
- NWSEC = IWORD/16
-
- 25 MT(JMT+1) = IWORD
- JMT = JMT + 1
- JMS = JMS + 1
- NWFORE = NWFORE - 1
-
- IF (ITYPE.GE.8) GO TO 27
- IF (NWSEC.EQ.0) GO TO 29
- IF (NWSEC.GT.0) GO TO 31
-
-C-- Faulty sector control word
-
- 27 IFOCON(1) = -1
- IFOCON(2) = JMS
- IFOCON(3) = IWORD
-
-C-- Rest of the bank is unused
-
- 29 ITYPE = 0
- NWSEC = NWFORE
- GO TO 31
-
-C-- RE-ENTRY TO CONTINUE
-
- 30 JMTEX = MIN (NWFORE,NWFOAV)
- JMS = NWFODN
- ITYPE = MFOSAV(1)
- NWSEC = MFOSAV(2)
-
-C------ CONVERSION LOOPS
-
- 31 NWDO = MIN (NWSEC,JMTEX-JMT)
- IF (NWDO.EQ.0) GO TO 801
- IF (ITYPE.LE.0) GO TO 91
- GO TO (101,201,301,401,501,101,101), ITYPE
-
-C-- Rest of the bank unused
-
- 91 CALL VZERO (MT(JMT+1),NWDO)
- JMS = JMS + NWDO
- JMT = JMT + NWDO
- GO TO 801
-
-C-- B - bit strings
-
-C-- I - integers
-
-#include "fzocvfi.inc"
-* Ignoring t=pass
-
-C-- F - floating
-
-#include "fzocvff.inc"
-* Ignoring t=pass
-
-C-- D - double precision
-
- 401 NDPN = (NWDO+1) / 2
- NWDODB = NDPN * 2
-#include "fzocvfd.inc"
- IF (NWDODB.EQ.NWDO) GO TO 801
- IF (NWDODB.GT.NWSEC) GO TO 471
- IF (NWDODB.GT.NWFORE) GO TO 471
- NWDO = NWDODB
- GO TO 801
-
-C-- Error : odd number of double-precision words
-
- 471 JMS = JMS - 1
- JMT = JMT - 1
- IFOCON(1) = -2
- IFOCON(2) = JMS
- IFOCON(3) = NWDO
- GO TO 801
-
-C-- H - hollerith
-
- 501 CONTINUE
-#include "fzocvfh.inc"
-* Ignoring t=pass
-
-C---- COPY AS IS
-
-#include "fzocvjf.inc"
- 201 CONTINUE
- 101 CONTINUE
-#include "fzocvfai.inc"
-
-C------ END OF SECTOR
-
- 801 NWFORE = NWFOTT - JMS
- IF (JMT.GE.JMTEX) GO TO 804
- JFOCUR = JFOCUR + 2
- IF (JFOCUR.LT.JFOEND) GO TO 21
- JFOCUR = JFOREP
- GO TO 21
-
-C-- Data or buffer exhausted
-
- 804 IQUEST(1) = JMT
- NWFOAV = NWFOAV - JMT
- IF (NWFORE.EQ.0) RETURN
-
-C-- Ready for re-entry
-
- NWFODN = JMS
- MFOSAV(1) = ITYPE
- MFOSAV(2) = NWSEC - NWDO
- RETURN
- END
-#endif
diff --git a/src/packlib/zebra/fq/fzocvd1.inc b/src/packlib/zebra/fq/fzocvd1.inc
deleted file mode 100644
index 69efb63..0000000
--- a/src/packlib/zebra/fq/fzocvd1.inc
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: fzocvd1.inc,v 1.1.1.1 1996/03/06 10:47:08 mclareni Exp $
-*
-* $Log: fzocvd1.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:08 mclareni
-* Zebra
-*
-*
-*
-* fzocvd1.inc
-*
-#if defined(CERNLIB_QMCDC)
- DIMENSION IPKVU(5), IPKVP(5), MTAB(64)
-#endif
-*
-* fzocvd1.inc
-*
-#if defined(CERNLIB_QMIBM)
- PARAMETER (JCHMIN = 63, JCHMAX = 187)
- DIMENSION IPKVEC(5), MTAB(188)
-#endif
-*
-* fzocvd1.inc
-*
-#if defined(CERNLIB_QMIBMD)
- PARAMETER (JCHMIN = 63, JCHMAX = 187)
- DIMENSION IPKVEC(5), MTAB(188)
-#endif
diff --git a/src/packlib/zebra/fq/fzocvd2.inc b/src/packlib/zebra/fq/fzocvd2.inc
deleted file mode 100644
index 27d08a3..0000000
--- a/src/packlib/zebra/fq/fzocvd2.inc
+++ /dev/null
@@ -1,111 +0,0 @@
-*
-* $Id: fzocvd2.inc,v 1.1.1.1 1996/03/06 10:47:08 mclareni Exp $
-*
-* $Log: fzocvd2.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:08 mclareni
-* Zebra
-*
-*
-*
-* fzocvd2.inc
-*
-#if defined(CERNLIB_QMCDC)
- DATA IPKVU / 6, 4, 0, 0, 0 /
- DATA IPKVP / 8, 4, 0,28, 0 /
- DATA MTAB /58, 65, 66, 67, 68, 69, 70, 71, 72, 73
- +, 74, 75, 76, 77, 78, 79, 80, 81, 82, 83
- +, 84, 85, 86, 87, 88, 89, 90, 48, 49, 50
- +, 51, 52, 53, 54, 55, 56, 57, 43, 45, 42
- +, 47, 40, 41, 36, 61, 32, 44, 46, 35, 91
- +, 93, 58, 34, 95, 33, 38, 39, 63, 60, 62
- +, 64, 92, 94, 59 /
-
-C- : A B C D E F G H I J K L M N O P Q R S
-C- T U V W X Y Z 0 1 2 3 4 5 6 7 8 9 + - *
-C- / ( ) $ = , . # [ ] : " _ ! & ' ? < >
-C- @ \ ^ ;
-#endif
-*
-* fzocvd2.inc
-*
-#if defined(CERNLIB_QMIBM)
- DATA IPKVEC / 8, 0, 0, 0, 0 /
- DATA MTAB /63, 32, 63, 63, 63, 63, 63, 63, 63, 63
- +, 63, 63, 46, 60, 40, 43,124, 38, 63, 63
- +, 63, 63, 63, 63, 63, 63, 63, 33, 36, 42
- +, 41, 59,126, 45, 47, 63, 63, 63, 63, 63
- +, 63, 63, 63, 94, 44, 37, 95, 62, 63, 63
- +, 63, 63, 63, 63, 63, 63, 63, 63, 96, 58
- +, 35, 64, 39, 61, 34, 63, 97, 98, 99,100
- +, 101,102,103,104,105, 63,123, 63, 63, 63
- +, 63, 63,106,107,108,109,110,111,112,113
- +, 114, 63,125, 63, 63, 63, 63, 63, 63,115
- +, 116,117,118,119,120,121,122, 63, 63, 63
- +, 91, 63, 63, 63, 63, 63, 63, 63, 63, 63
- +, 63, 63, 63, 63, 63, 63, 93, 63, 63,123
- +, 65, 66, 67, 68, 69, 70, 71, 72, 73, 63
- +, 63, 63, 63, 63, 63,125, 74, 75, 76, 77
- +, 78, 79, 80, 81, 82, 63, 63, 63, 63, 63
- +, 63, 92, 63, 83, 84, 85, 86, 87, 88, 89
- +, 90, 63, 63, 63, 63, 63, 63, 48, 49, 50
- +, 51, 52, 53, 54, 55, 56, 57, 63 /
-C-
-C- ? ? ? ? ? ? ? ? ? ? ? . < ( + | & ? ?
-C- ? ? ? ? ? ? ? ! $ * ) ; ~ - / ? ? ? ? ?
-C- ? ? ? ^ , % _ > ? ? ? ? ? ? ? ? ? ? ` :
-C- # @ ' = " ? a b c d e f g h i ? { ? ? ?
-C- ? ? j k l m n o p q r ? } ? ? ? ? ? ? s
-C- t u v w x y z ? ? ? [ ? ? ? ? ? ? ? ? ?
-C- ? ? ? ? ? ? ] ? ? >{ A B C D E F G H I ?
-C- ? ? ? ? ? >} J K L M N O P Q R ? ? ? ? ?
-C- ? \ ? S T U V W X Y Z ? ? ? ? ? ? 0 1 2
-C- 3 4 5 6 7 8 9 ?
-#endif
-* use default CALL IE3FOS for output single prec.
-#ifndef CERNLIB_FQIE3FSC
-#endif
-* use default CALL IE3FOD for output double prec.
-#ifndef CERNLIB_FQIE3FDC
-#endif
-*
-* fzocvd2.inc
-*
-#if defined(CERNLIB_QMIBMD)
- DATA IPKVEC / 8, 0, 0, 0, 0 /
- DATA MTAB /63, 32, 63, 63, 63, 63, 63, 63, 63, 63
- +, 63, 63, 46, 60, 40, 43,124, 38, 63, 63
- +, 63, 63, 63, 63, 63, 63, 63, 33, 36, 42
- +, 41, 59,126, 45, 47, 63, 63, 63, 63, 63
- +, 63, 63, 63, 94, 44, 37, 95, 62, 63, 63
- +, 63, 63, 63, 63, 63, 63, 63, 63, 96, 58
- +, 35, 64, 39, 61, 34, 63, 97, 98, 99,100
- +, 101,102,103,104,105, 63,123, 63, 63, 63
- +, 63, 63,106,107,108,109,110,111,112,113
- +, 114, 63,125, 63, 63, 63, 63, 63, 63,115
- +, 116,117,118,119,120,121,122, 63, 63, 63
- +, 91, 63, 63, 63, 63, 63, 63, 63, 63, 63
- +, 63, 63, 63, 63, 63, 63, 93, 63, 63,123
- +, 65, 66, 67, 68, 69, 70, 71, 72, 73, 63
- +, 63, 63, 63, 63, 63,125, 74, 75, 76, 77
- +, 78, 79, 80, 81, 82, 63, 63, 63, 63, 63
- +, 63, 92, 63, 83, 84, 85, 86, 87, 88, 89
- +, 90, 63, 63, 63, 63, 63, 63, 48, 49, 50
- +, 51, 52, 53, 54, 55, 56, 57, 63 /
-C-
-C- ? ? ? ? ? ? ? ? ? ? ? . < ( + | & ? ?
-C- ? ? ? ? ? ? ? ! $ * ) ; ~ - / ? ? ? ? ?
-C- ? ? ? ^ , % _ > ? ? ? ? ? ? ? ? ? ? ` :
-C- # @ ' = " ? a b c d e f g h i ? { ? ? ?
-C- ? ? j k l m n o p q r ? } ? ? ? ? ? ? s
-C- t u v w x y z ? ? ? [ ? ? ? ? ? ? ? ? ?
-C- ? ? ? ? ? ? ] ? ? >{ A B C D E F G H I ?
-C- ? ? ? ? ? >} J K L M N O P Q R ? ? ? ? ?
-C- ? \ ? S T U V W X Y Z ? ? ? ? ? ? 0 1 2
-C- 3 4 5 6 7 8 9 ?
-#endif
-* use default CALL IE3FOS for output single prec.
-#ifndef CERNLIB_FQIE3FSC
-#endif
-* use default CALL IE3FOD for output double prec.
-#ifndef CERNLIB_FQIE3FDC
-#endif
diff --git a/src/packlib/zebra/fq/fzocvfai.inc b/src/packlib/zebra/fq/fzocvfai.inc
deleted file mode 100644
index 8fc46a4..0000000
--- a/src/packlib/zebra/fq/fzocvfai.inc
+++ /dev/null
@@ -1,40 +0,0 @@
-*
-* $Id: fzocvfai.inc,v 1.1.1.1 1996/03/06 10:47:10 mclareni Exp $
-*
-* $Log: fzocvfai.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:10 mclareni
-* Zebra
-*
-*
-*
-* fzocvfai.inc
-*
-#if defined(CERNLIB_QMCRY)
-C-- Cray B + F : copy as is, clear left half-word
-C- First, check bits lost
-C DO 104 J=1,NWDO
-C IF (SHIFTR(MS(JMS+J),32).NE.0) GO TO 105
-C 104 CONTINUE
-C GO TO 106
-C
-C- Conversion problem
-C 105 IFOCON(1) = ITYPE
-C IFOCON(2) = JMS + J
-C IFOCON(3) = MS(JMS+J)
-
-C- Copy right halves only
- 106 DO 107 J=1,NWDO
- 107 MT(JMT+J) = MS(JMS+J) .AND. 37777777777B
- JMT = JMT + NWDO
- JMS = JMS + NWDO
-#elif (defined(CERNLIB_QMCV64))&&(!defined(CERNLIB_QIEEE))
-C- Copy right halves only
- 106 DO 107 J=1,NWDO
- 107 MT(JMT+J) = MS(JMS+J) .AND. 'FFFFFFFF'X
- JMT = JMT + NWDO
- JMS = JMS + NWDO
-#elif 1
- CALL UCOPY (MS(JMS+1),MT(JMT+1),NWDO)
- JMT = JMT + NWDO
- JMS = JMS + NWDO
-#endif
diff --git a/src/packlib/zebra/fq/fzocvfd.inc b/src/packlib/zebra/fq/fzocvfd.inc
deleted file mode 100644
index 2445f90..0000000
--- a/src/packlib/zebra/fq/fzocvfd.inc
+++ /dev/null
@@ -1,44 +0,0 @@
-*
-* $Id: fzocvfd.inc,v 1.3 1998/09/25 09:33:04 mclareni Exp $
-*
-* $Log: fzocvfd.inc,v $
-* Revision 1.3 1998/09/25 09:33:04 mclareni
-* Modifications for the Mklinux port flagged by CERNLIB_PPC
-*
-* Revision 1.2 1997/03/14 17:19:51 mclareni
-* WNT mods
-*
-* Revision 1.1.1.1.2.1 1997/01/21 11:33:42 mclareni
-* All mods for Winnt 96a on winnt branch
-*
-* Revision 1.1.1.1 1996/03/06 10:47:10 mclareni
-* Zebra
-*
-*
-* cv IEEE <- double
-*
-* fzocvfd.inc
-*
-#if defined(CERNLIB_QMDOS)||(defined(CERNLIB_QMLNX) && !defined(CERNLIB_PPC))||defined(CERNLIB_QMTMO)||defined(CERNLIB_QMVMI) || defined(CERNLIB_WINNT)
-C-- : exchange left and right half of each d/p number
- DO 449 JL=1,NDPN
- MT(JMT+1) = MS(JMS+2)
- MT(JMT+2) = MS(JMS+1)
- JMT = JMT + 2
- 449 JMS = JMS + 2
-#elif defined(CERNLIB_FQIE3FDC)
-C-- Default conversion from internal to double IEEE
- CALL IE3FOD (MS(JMS+1),MT(JMT+1),NDPN,JBAD)
- IF (JBAD.NE.0) THEN
- JBAD = 2*JBAD-2 + JMS
- IFOCON(1) = 4
- IFOCON(2) = JBAD
- IFOCON(3) = MS(JBAD+1)
- ENDIF
- JMT = JMT + NWDODB
- JMS = JMS + NWDODB
-#elif 1
- CALL UCOPY (MS(JMS+1),MT(JMT+1),NWDODB)
- JMS = JMS + NWDODB
- JMT = JMT + NWDODB
-#endif
diff --git a/src/packlib/zebra/fq/fzocvff.inc b/src/packlib/zebra/fq/fzocvff.inc
deleted file mode 100644
index c3dd50c..0000000
--- a/src/packlib/zebra/fq/fzocvff.inc
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: fzocvff.inc,v 1.1.1.1 1996/03/06 10:47:12 mclareni Exp $
-*
-* $Log: fzocvff.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:12 mclareni
-* Zebra
-*
-*
-* cv IEEE <- single
-*
-* fzocvff.inc
-*
-#if defined(CERNLIB_FQIE3FSC)
-C-- Default conversion from internal to single IEEE
- 301 CALL IE3FOS (MS(JMS+1),MT(JMT+1),NWDO,JBAD)
- IF (JBAD.NE.0) GO TO 331
- 304 JMT = JMT + NWDO
- JMS = JMS + NWDO
- GO TO 801
-
- 331 JBAD = JBAD-1 + JMS
- IFOCON(1) = 3
- IFOCON(2) = JBAD
- IFOCON(3) = MS(JBAD+1)
- GO TO 304
-#endif
diff --git a/src/packlib/zebra/fq/fzocvfh.inc b/src/packlib/zebra/fq/fzocvfh.inc
deleted file mode 100644
index b7adee4..0000000
--- a/src/packlib/zebra/fq/fzocvfh.inc
+++ /dev/null
@@ -1,118 +0,0 @@
-*
-* $Id: fzocvfh.inc,v 1.2 1997/03/14 17:19:52 mclareni Exp $
-*
-* $Log: fzocvfh.inc,v $
-* Revision 1.2 1997/03/14 17:19:52 mclareni
-* WNT mods
-*
-* Revision 1.1.1.1.2.1 1997/01/21 11:33:42 mclareni
-* All mods for Winnt 96a on winnt branch
-*
-* Revision 1.1.1.1 1996/03/06 10:47:08 mclareni
-* Zebra
-*
-*
-* convert Display Code -> ASCII
-*
-* fzocvfh.inc
-*
-#if defined(CERNLIB_QMCDC)
-C-- CDC Display code -> ASCII
- NTHR = NWDO
- 522 NTH = MIN (NTHR,24)
- NCH = 4*NTH
- CALL UPKCH (MS(JMS+1),IQUEST,NCH,IPKVU)
- DO 529 JCH=1,NCH
- J = IQUEST(JCH)
- 529 IQUEST(JCH) = MTAB(J+1)
- CALL PKCHAR (IQUEST,MT(JMT+1),NCH,IPKVP)
- JMT = JMT + NTH
- JMS = JMS + NTH
- NTHR = NTHR - NTH
- IF (NTHR.NE.0) GO TO 522
- GO TO 801
-
-* -------------- sequences for input ---------------------
-#endif
-* right adjust 4 ASCII characters
-*
-* fzocvfh.inc
-*
-#if defined(CERNLIB_QMCRY)
-C-- Cray ASCII : keep only the first 4 characters
- DO 519 JL=1,NWDO
- MT(JMT+1) = SHIFTR (MS(JMS+1), 32)
- JMT = JMT + 1
- 519 JMS = JMS + 1
- GO TO 801
-#endif
-* right adjust 4 ASCII characters
-*
-* fzocvfh.inc
-*
-#if (defined(CERNLIB_QMCV64))&&(!defined(CERNLIB_QIEEE))
-C-- Convex ASCII : keep only the first 4 characters
- DO 519 JL=1,NWDO
- MT(JMT+1) = ISHFT (MS(JMS+1), -32)
- JMT = JMT + 1
- 519 JMS = JMS + 1
- GO TO 801
-#endif
-* invert ASCII characters
-*
-* fzocvfh.inc
-*
-#if defined(CERNLIB_QMDOS) || defined(CERNLIB_WINNT)
-#include "fzcvhpc.inc"
-* -------------- sequences for input ---------------------
-#endif
-* -------------- conversions for input -------------------
-* convert EBCDIC -> ASCII
-*
-* fzocvfh.inc
-*
-#if defined(CERNLIB_QMIBM)
-#include "fzcvhibm.inc"
-* -------------- conversions for input -------------------
-#endif
-* convert EBCDIC -> ASCII
-*
-* fzocvfh.inc
-*
-#if defined(CERNLIB_QMIBMD)
-#include "fzcvhibm.inc"
-* -------------- Added by MRO ------------------
-#endif
-* invert ASCII characters
-*
-* fzocvfh.inc
-*
-#if defined(CERNLIB_QMLNX)
-#include "fzcvhlnx.inc"
-* -------------- sequences for input ---------------------
-#endif
-* invert ASCII characters
-*
-* fzocvfh.inc
-*
-#if defined(CERNLIB_QMTMO)
-#include "fzcvhtmo.inc"
-* -------------- sequences for input ---------------------
-#endif
-* -------------- conversions for input -------------------
-* invert ASCII characters
-*
-* fzocvfh.inc
-*
-#if defined(CERNLIB_QMVAX)
-#include "fzcvhvax.inc"
-* -------------- sequences for input ---------------------
-#endif
-* invert ASCII characters
-*
-* fzocvfh.inc
-*
-#if defined(CERNLIB_QMVMI)
-#include "fzcvhvmi.inc"
-* -------------- sequences for input ---------------------
-#endif
diff --git a/src/packlib/zebra/fq/fzocvfi.inc b/src/packlib/zebra/fq/fzocvfi.inc
deleted file mode 100644
index 8d064c8..0000000
--- a/src/packlib/zebra/fq/fzocvfi.inc
+++ /dev/null
@@ -1,38 +0,0 @@
-*
-* $Id: fzocvfi.inc,v 1.1.1.1 1996/03/06 10:47:08 mclareni Exp $
-*
-* $Log: fzocvfi.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:08 mclareni
-* Zebra
-*
-*
-*
-* fzocvfi.inc
-*
-#if defined(CERNLIB_QMCDC)
-C-- CDC : two's complement for integer output
- 201 JPRO = 0
- DO 229 J=1,NWDO
- ITHA = MS(JMS+1)
- ITHB = MASK(28) .AND. ITHA
- IF (ITHB.EQ.0) GO TO 227
- IF ((ITHB.XOR.MASK(28)).EQ.0) GO TO 226
- JPRO = JMS
- GO TO 227
-
- 226 ITHA = ((.NOT.MASK(28)).AND.ITHA) + 1
- 227 MT(JMT+1) = ITHA
- JMT = JMT + 1
- 229 JMS = JMS + 1
- IF (JPRO.EQ.0) GO TO 801
- IFOCON(1) = 2
- IFOCON(2) = JPRO
- IFOCON(3) = MS(JPRO+1)
- GO TO 801
-#endif
-* use default CALL IE3FOS for output single prec.
-#ifndef CERNLIB_FQIE3FSC
-#endif
-* use default CALL IE3FOD for output double prec.
-#ifndef CERNLIB_FQIE3FDC
-#endif
diff --git a/src/packlib/zebra/fq/fzocvjf.inc b/src/packlib/zebra/fq/fzocvjf.inc
deleted file mode 100644
index eda5100..0000000
--- a/src/packlib/zebra/fq/fzocvjf.inc
+++ /dev/null
@@ -1,15 +0,0 @@
-*
-* $Id: fzocvjf.inc,v 1.1.1.1 1996/03/06 10:47:12 mclareni Exp $
-*
-* $Log: fzocvjf.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:12 mclareni
-* Zebra
-*
-*
-*
-* fzocvjf.inc
-*
-#if defined(CERNLIB_FQIE3FSC)
-#else
- 301 CONTINUE
-#endif
diff --git a/src/packlib/zebra/fq/fzocvji.inc b/src/packlib/zebra/fq/fzocvji.inc
deleted file mode 100644
index 9198b5d..0000000
--- a/src/packlib/zebra/fq/fzocvji.inc
+++ /dev/null
@@ -1,13 +0,0 @@
-*
-* $Id: fzocvji.inc,v 1.1.1.1 1996/03/06 10:47:08 mclareni Exp $
-*
-* $Log: fzocvji.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:08 mclareni
-* Zebra
-*
-*
-*
-* fzocvji.inc
-*
-#if defined(CERNLIB_QMCDC)
-#endif
diff --git a/src/packlib/zebra/fq/fzocxfd.inc b/src/packlib/zebra/fq/fzocxfd.inc
deleted file mode 100644
index cb1efb1..0000000
--- a/src/packlib/zebra/fq/fzocxfd.inc
+++ /dev/null
@@ -1,133 +0,0 @@
-*
-* $Id: fzocxfd.inc,v 1.1.1.1 1996/03/06 10:47:10 mclareni Exp $
-*
-* $Log: fzocxfd.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:10 mclareni
-* Zebra
-*
-*
-* cv double-pr. F from CRAY -> IEEE
-*
-* fzocxfd.inc
-*
-#if defined(CERNLIB_QMCRY)
-C-- Cray single-pr. to IEEE double, ignoring 2nd word
-C- for the moment (loss of 5 bits)
- DO 449 JL=1,NWDODB,2
- ITHA = MS(JMS+1)
- IF (ITHA.EQ.0) GO TO 442
- JSIGN = SHIFTR (MASK(1).AND.ITHA, 32)
- JEXP = SHIFTR (SHIFTL(ITHA,1), 49)
- JEXP = JEXP - 40000B + 1022
- IF (JEXP.LE.0) GO TO 441
- IF (JEXP.GE.2047) GO TO 433
- JMANT = MASK(128-20) .AND. SHIFTR (ITHA,27)
- ITHB = SHIFTL (ITHA, 5) .AND. 37777777777B
- ITHA = JSIGN .OR. SHIFTL(JEXP,20) .OR. JMANT
- GO TO 447
-
-C-- overflow
- 433 IFOCON(1) = 4
- IFOCON(2) = JMS
- IFOCON(3) = ITHA
- IF (JSIGN.EQ.0) THEN
- ITHA = IOVPCD
- ELSE
- ITHA = IOVNCD
- ENDIF
- GO TO 442
-
- 441 ITHA = 0
- 442 ITHB = 0
- 447 MT(JMT+1) = ITHA
- MT(JMT+2) = ITHB
- JMT = JMT + 2
- 449 JMS = JMS + 2
-#endif
-* cv double-pr. F from ND -> IEEE
-*
-* fzocxfd.inc
-*
-#if defined(CERNLIB_QMND3)
-C-- NORD double-precision to IEEE double
- DO 449 JL=1,NWDODB,2
- ITHA = MS(JMS+1)
- IF (ITHA.EQ.0) GO TO 442
- ITHB = MS(JMS+2)
- JSIGN = ISHFT (ITHA,-31)
- JEXP = ISHFT (ISHFT(ITHA,1), -23)
- IF (JEXP.EQ.0) GO TO 441
- IF (JEXP.EQ.511) GO TO 433
- JMANT = ISHFT (ISHFT(ITHA,10), -12)
- ITHB = ISHFT (ITHA,30) .OR. ISHFT (ITHB,-2)
- ITHA = ISHFT(JSIGN,31) .OR. ISHFT(JEXP+766,20) .OR. JMANT
- GO TO 447
-
-C-- overflow / NaN
- 433 IFOCON(1) = 4
- IFOCON(2) = JMS
- IFOCON(3) = ITHA
- IF (ITHA.NE.IBADMS) THEN
- IF (JSIGN.EQ.0) THEN
- ITHA = IOVPCD
- ELSE
- ITHA = IOVNCD
- ENDIF
- ELSE
- ITHA = IBADCD
- ENDIF
- GO TO 442
-
- 441 ITHA = 0
- 442 ITHB = 0
- 447 MT(JMT+1) = ITHA
- MT(JMT+2) = ITHB
- JMT = JMT + 2
- 449 JMS = JMS + 2
-* -------------- sequences for input ---------------------
-#endif
-* cv double-pr. F from VAX -> IEEE
-*
-* fzocxfd.inc
-*
-#if defined(CERNLIB_QMVAX)
-C-- VAX double-precision to IEEE double
- DO 449 JL=1,NWDODB,2
- ITHA = MS(JMS+1)
- IF (ITHA.EQ.0) GO TO 442
- ITHB = MS(JMS+2)
- JSIGN = ITHA .AND. MSKB16
- JEXP = JIBITS (ITHA,7,8)
- IF (JEXP.EQ.0) GO TO 431
- IF (JEXP.EQ.255) GO TO 433
- JMANT = JISHFT (JIBITS(ITHA, 0, 7), 13) .OR. JIBITS(ITHA,19,13)
- ITHB = JISHFT (JIBITS(ITHA,16, 3), 29) .OR.
- + JISHFT (JIBITS(ITHB, 0,16), 13) .OR.
- + JIBITS(ITHB,19,13)
- ITHA = JISHFT(JSIGN,16) .OR. JISHFT(JEXP+894,20) .OR. JMANT
- GO TO 447
-
-C-- zero / NaN
- 431 IF (JSIGN.EQ.0) GO TO 441
- ITHB = IBADCD
- GO TO 436
-
-C-- overflow
- 433 IF (JSIGN.EQ.0) THEN
- ITHB = IOVPCD
- ELSE
- ITHB = IOVNCD
- ENDIF
- 436 IFOCON(1) = 4
- IFOCON(2) = JMS
- IFOCON(3) = ITHA
- ITHA = ITHB
- GO TO 442
-
- 441 ITHA = 0
- 442 ITHB = 0
- 447 MT(JMT+1) = ITHA
- MT(JMT+2) = ITHB
- JMT = JMT + 2
- 449 JMS = JMS + 2
-#endif
diff --git a/src/packlib/zebra/fq/fzocxff.inc b/src/packlib/zebra/fq/fzocxff.inc
deleted file mode 100644
index 2beec25..0000000
--- a/src/packlib/zebra/fq/fzocxff.inc
+++ /dev/null
@@ -1,101 +0,0 @@
-*
-* $Id: fzocxff.inc,v 1.1.1.1 1996/03/06 10:47:10 mclareni Exp $
-*
-* $Log: fzocxff.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:10 mclareni
-* Zebra
-*
-*
-* cv single-pr. F from CRAY -> IEEE
-*
-* fzocxff.inc
-*
-#if defined(CERNLIB_QMCRY)
-C-- Cray single-pr. to IEEE single
- 301 DO 349 JL=1,NWDO
- ITHA = MS(JMS+1)
- IF (ITHA.EQ.0) GO TO 347
- JSIGN = SHIFTR (MASK(1).AND.ITHA, 32)
- JEXP = SHIFTR (SHIFTL(ITHA,1), 49)
- JEXP = JEXP - 40000B + 126
- JMANT = MASK(128-24) .AND. SHIFTR(ITHA,23)
- IF (JMANT.EQ.MASK(128-24)) THEN
- JMANT = 0
- JEXP = JEXP + 1
- ELSE
- JMANT = SHIFTR(JMANT+1,1)
- ENDIF
- IF (JEXP.LE.0) GO TO 331
- IF (JEXP.GE.255) GO TO 333
- ITHA = JSIGN .OR. SHIFTL(JEXP,23) .OR. JMANT
- GO TO 347
-
-C-- make de-normalized number
- 331 IF (JEXP.LT.-23) GO TO 341
- JMANT = SHIFTR (JMANT+40000000B,1-JEXP)
- ITHA = JSIGN .OR. JMANT
- GO TO 347
-
-C-- overflow
- 333 IFOCON(1) = 3
- IFOCON(2) = JMS
- IFOCON(3) = ITHA
- IF (JSIGN.EQ.0) THEN
- ITHA = IOVPCS
- ELSE
- ITHA = IOVNCS
- ENDIF
- GO TO 347
-
- 341 ITHA = 0
- 347 MT(JMT+1) = ITHA
- JMT = JMT + 1
- 349 JMS = JMS + 1
- GO TO 801
-#endif
-* cv single-pr. F from ND -> IEEE
-*
-* fzocxff.inc
-*
-#if defined(CERNLIB_QMND3)
-C-- NORD single-precision to IEEE single
- 301 DO 349 JL=1,NWDO
- ITHA = MS(JMS+1)
- IF (ITHA.EQ.0) GO TO 347
- JSIGN = ISHFT (ITHA,-31)
- JEXP = ISHFT (ISHFT(ITHA,1), -23)
- JEXP = JEXP - 130
- IF (JEXP.LE.0) GO TO 331
- IF (JEXP.GE.255) GO TO 333
- JMANT = ISHFT (ISHFT(ITHA,10), -9)
- ITHA = ISHFT(JSIGN,31) .OR. ISHFT(JEXP,23) .OR. JMANT
- GO TO 347
-
-C-- make de-normalized number
- 331 IF (JEXP.LE.-23) GO TO 341
- ITHA = ITHA .OR. 20000000 B
- ITHA = ISHFT (ISHFT(ITHA,9),JEXP-9)
- ITHA = ITHA .OR. ISHFT(JSIGN,31)
- GO TO 347
-
-C-- overflow
- 333 IFOCON(1) = 3
- IFOCON(2) = JMS
- IFOCON(3) = ITHA
- IF (ITHA.NE.IBADMS) THEN
- IF (JSIGN.EQ.0) THEN
- ITHA = IOVPCS
- ELSE
- ITHA = IOVNCS
- ENDIF
- ELSE
- ITHA = IBADCS
- ENDIF
- GO TO 347
-
- 341 ITHA = 0
- 347 MT(JMT+1) = ITHA
- JMT = JMT + 1
- 349 JMS = JMS + 1
- GO TO 801
-#endif
diff --git a/src/packlib/zebra/fq/fzodat.F b/src/packlib/zebra/fq/fzodat.F
deleted file mode 100644
index c61b3f6..0000000
--- a/src/packlib/zebra/fq/fzodat.F
+++ /dev/null
@@ -1,78 +0,0 @@
-*
-* $Id: fzodat.F,v 1.2 1999/06/18 13:29:31 couet Exp $
-*
-* $Log: fzodat.F,v $
-* Revision 1.2 1999/06/18 13:29:31 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:13 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE FZODAT (LUNP,IXDIVP,LENTP)
-
-C- Write Direct Access Table
-
-#include "zebra/zunit.inc"
-#include "zebra/mqsys.inc"
-#include "zebra/eqlqf.inc"
-#include "zebra/fzcx.inc"
-*
- DIMENSION LUNP(9), IXDIVP(9), LENTP(9), IUHEAD(8)
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HFZOD, 4HAT /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HFZODAT /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'FZODAT ')
-#endif
- DATA IUHEAD / 8*0 /
-
-
-#include "zebra/qtrace.inc"
-
- LUNNX = LUNP(1)
- CALL FZLOC (LUNNX,2)
-#if defined(CERNLIB_QDEBPRI)
- IF (LOGLVX.GE.2) WRITE (IQLOG,9002) LUNX
- 9002 FORMAT (' FZODAT- called for LUN=',I4)
-#endif
-
-C---- Write the DAT forward reference record
-
- IF (LENTP(1).NE.0) GO TO 24
- IPILX(3) = 2
- CALL FZOUT (LUNX, 0,0, 1, 'Z', 1,8,IUHEAD)
- IPILX(3) = 0
- IACTVX = 14
- IQ(KQSP+LQFX+2) = IACTVX
- GO TO 999
-
-C---- Write the d/a table record
-
- 24 IPILX(3) = 1
- CALL FZOUT (LUNX, IXDIVP,LENTP, 1, 'S', 0,0,0)
- IPILX(3) = 0
- IQ(KQSP+LQFX+34) = IQUEST(5)
- IQ(KQSP+LQFX+35) = IQUEST(6)
-
-C-- Try to update the DAT forward reference record
-
-#if defined(CERNLIB_FZDACC)
- IF (IFIFOX.NE.2) GO TO 999
-C-- flush the buffer
- CALL FZOUT (LUNX, -7,0, 13, 'FZEND', 0,0,0)
-C-- update
- CALL FZUDAT (LUNP,0)
- LUNX = -1
-#endif
-
-#include "zebra/qtrace99.inc"
- RETURN
- END
diff --git a/src/packlib/zebra/fq/fzoffn.F b/src/packlib/zebra/fq/fzoffn.F
deleted file mode 100644
index d108f51..0000000
--- a/src/packlib/zebra/fq/fzoffn.F
+++ /dev/null
@@ -1,349 +0,0 @@
-*
-* $Id: fzoffn.F,v 1.3 1999/06/18 13:29:32 couet Exp $
-*
-* $Log: fzoffn.F,v $
-* Revision 1.3 1999/06/18 13:29:32 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.2 1996/04/18 16:10:47 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:11 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
-#if defined(CERNLIB_FZFFNAT)
- SUBROUTINE FZOFFN (IUHEAD)
-
-C- Write operations for file format native,
-C- subsidiary to FZOUT
-
-C- Controlling parameter : IDX(2)
-C-
-C- IDX(2) = 1 write start/end-of-run
-C- > 1 write pilot for d/s
-C- = 0 write bank material for d/s
-C- (= -1 flush the buffer in exchange mode)
-C- = -2 End-of-File
-C- = -3 End-of-Data
-
-#include "zebra/zunit.inc"
-#include "zebra/mqsys.inc"
-#include "zebra/eqlqf.inc"
-#include "zebra/mzct.inc"
-#include "zebra/mzcwk.inc"
-#include "zebra/fzcx.inc"
-#include "zebra/fzcseg.inc"
-*
- DIMENSION IUHEAD(99)
- DIMENSION LV(6), NV(6)
- EQUIVALENCE (L1,LV(1)), (L2,LV(2)), (L3,LV(3))
- +, (L4,LV(4)), (L5,LV(5)), (L6,LV(6))
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HFZOF, 4HFN /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HFZOFFN /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'FZOFFN ')
-#endif
-
-
-#include "zebra/qtrace.inc"
-
- IF (IDX(2)) 401, 201, 101
- 101 IF (IDX(2).EQ.1) GO TO 301
-
-C-----------------------------------------------------------
-C------ WRITE PILOT INFORMATION, STARTING LR AND D/S
-C-----------------------------------------------------------
-
- NWMAX = MIN (MAXREX,1020)
- NWPILA = 10 + NWIOX
- NW = NWPILA
- JSEND = 0
- JDONE = -1
-
-C-- Do user header
-
- NW = NW + NWUHX
-
-C-- Do segment table
-
- IF (NWSEGX.NE.0) THEN
- NW = NW + NWSEGX
- JSEND = 2
- LV(1) = LOCF (IQSEGH(1,1)) - LQASTO
- LV(2) = LV(1) + 40
- NV(1) = 2*NQSEG
- NV(2) = NQSEG
- ENDIF
-
-C-- Do text vector
-
- IF (NWTXX.NE.0) THEN
- LTX = LTEXTX
- NW = NW + NWTXX
- IF (NW.GT.NWMAX) GO TO 127
- JSEND = JSEND + 1
- LV(JSEND) = KQSP+8 + LTX + 5
- NV(JSEND) = NWTXX
- ENDIF
- JDONE = 0
-
-C-- Do early table
-
- IF (NWTABX.GE.41) GO TO 127
- NW = NW + NWTABX
- IF (NW.GT.NWMAX) GO TO 127
-
- IF (NWTABX.NE.0) THEN
- JSEND = JSEND + 1
- LV(JSEND) = LQTA
- NV(JSEND) = NWTABX
- ENDIF
- JDONE = 1
-
-C-- Transmit pilot record
-
- 127 N = NWPILA
- NU = NWUHX
- JSEND = JSEND + 1
- IF (NU.NE.0) GO TO ( 140, 141, 142, 143, 144), JSEND
- GO TO ( 130, 131, 132, 133, 134), JSEND
-
- 130 CALL FZON1 (IPILX,N)
- GO TO 149
-
- 131 CALL FZON2 (IPILX,N,LQ(L1),NV(1))
- GO TO 149
-
- 132 CALL FZON3 (IPILX,N,LQ(L1),NV(1),LQ(L2),NV(2))
- GO TO 149
-
- 133 CALL FZON4 (IPILX,N,LQ(L1),NV(1),LQ(L2),NV(2),LQ(L3),NV(3))
- GO TO 149
-
- 134 CALL FZON5 (IPILX,N,LQ(L1),NV(1),LQ(L2),NV(2),LQ(L3),NV(3)
- +, LQ(L4),NV(4))
- GO TO 149
-
- 140 CALL FZON2 (IPILX,N,IUHEAD,NU)
- GO TO 149
-
- 141 CALL FZON3 (IPILX,N,IUHEAD,NU,LQ(L1),NV(1))
- GO TO 149
-
- 142 CALL FZON4 (IPILX,N,IUHEAD,NU,LQ(L1),NV(1),LQ(L2),NV(2))
- GO TO 149
-
- 143 CALL FZON5 (IPILX,N,IUHEAD,NU,LQ(L1),NV(1),LQ(L2),NV(2)
- +, LQ(L3),NV(3))
- GO TO 149
-
- 144 CALL FZON6 (IPILX,N,IUHEAD,NU,LQ(L1),NV(1),LQ(L2),NV(2)
- +, LQ(L3),NV(3),LQ(L4),NV(4))
-
- 149 IDX(2) = 4
- IQUEST(7) = JDONE
- IF (JDONE) 171, 181, 999
-
-C---- Pilot continuation: text/table
-
- 171 IF (NWTABX.GE.41) GO TO 174
- IF (NWTABX.EQ.0) GO TO 174
- IF (NWTXX+NWTABX.GT.MAXREX) GO TO 174
- CALL FZON2 (IQ(KQSP+LTX+5),NWTXX,LQ(LQTA),NWTABX)
- IQUEST(7) = 1
- GO TO 999
-
- 174 CALL FZON1 (IQ(KQSP+LTX+5),NWTXX)
-
-C-- Pilot continuation: table only (only FZOUT)
-
- 181 IF (NWTABX.EQ.0) GO TO 999
- IF (ICOPYX.NE.0) GO TO 999
- NT = NWTABX
- L = LQTA
- 182 N = MIN (NT,MAXREX)
- CALL FZON1 (LQ(L),N)
- L = L + N
- NT = NT - N
- IF (NT.NE.0) GO TO 182
-
-#include "zebra/qtrace99.inc"
- RETURN
-
-C-----------------------------------------------------------
-C-- WRITE BANK MATERIAL
-C-----------------------------------------------------------
-
- 201 MINREC = MAXREX/2
- LTEMPX = 0
- LTB = LQTA
- JSEG = 0
- NDOSG = 0
- IF (NQSEG.EQ.0) NDOSG=NWBKX
- IDX(2) = 7
-#if defined(CERNLIB_QDEVZE)
- IF (LOGLVX.GE.5) WRITE (IQLOG,9801)
- 9801 FORMAT (' FZOFFN- Entered for bank material.')
-#endif
-
- 242 JSEND = 0
- NWS = 0
-
-C-- Load next sector
-
- 243 L = LQ(LTB)
- LE = LQ(LTB+1)
- N = LE - L
- JSEND = JSEND + 1
- LV(JSEND) = L
- NV(JSEND) = N
-
- NWS = NWS + N
- NOV = NWS - MAXREX
- LTB = LTB + 2
-
-C-- Next segment ?
-
- IF (NDOSG.EQ.0) THEN
- JSEG = JSEG + 1
- NDOSG = IQSEGD(JSEG)
- ENDIF
- NDOSG = NDOSG - N
-
-C-- Send ?
-
- IF (NOV.GT.0) GO TO 261
- IF (LTB.EQ.LQTE) GO TO 268
- IF (NDOSG.EQ.0) GO TO 270
- IF (NOV.GE.-10) GO TO 270
- IF (JSEND.LT.6) GO TO 243
- IF (NWS.GE.MINREC) GO TO 270
-
-C-- 6 sectors have less than MINREC words
-C-- Compact to TEMP buffer
-
- IF (LTEMPX.EQ.0) LTEMPX = LQWKFZ - KQS
-
- LOV = LTEMPX
- NOV = 0
- JGO = 1
- IF (LV(1).EQ.LTEMPX) THEN
- NOV = NV(1)
- JGO = 2
- ENDIF
-
- DO 256 J=JGO,6
- L = LV(J)
- N = NV(J)
- CALL UCOPY (LQ(KQS+L),LQ(KQS+LOV+NOV),N)
- 256 NOV = NOV + N
- LV(1) = LOV
- NV(1) = NOV
-
- 257 JSEND = 1
- NWS = NV(1)
- GO TO 243
-
-C-- Last sector overflows MAXREX words
-
- 261 N = N - NOV
- LOV = L + N
- NV(JSEND) = N
- GO TO 270
-
-C-- End of material, with overflow on last sector
-
- 267 JSEND = 1
-
-C-- End of material reached, send last record
-
- 268 IDX(2) = 8
-
-C------ Write 1 record
-
- 270 GO TO ( 271, 272, 273, 274, 275, 276), JSEND
-
- 271 CALL FZON1 (LQ(KQS+L1),NV(1))
- GO TO 279
- 272 CALL FZON2 (LQ(KQS+L1),NV(1),LQ(KQS+L2),NV(2))
- GO TO 279
- 273 CALL FZON3 (LQ(KQS+L1),NV(1),LQ(KQS+L2),NV(2),LQ(KQS+L3),NV(3))
- GO TO 279
- 274 CALL FZON4 (LQ(KQS+L1),NV(1),LQ(KQS+L2),NV(2),LQ(KQS+L3),NV(3),
- + LQ(KQS+L4),NV(4))
- GO TO 279
- 275 CALL FZON5 (LQ(KQS+L1),NV(1),LQ(KQS+L2),NV(2),LQ(KQS+L3),NV(3),
- + LQ(KQS+L4),NV(4),LQ(KQS+L5),NV(5))
- GO TO 279
- 276 CALL FZON6 (LQ(KQS+L1),NV(1),LQ(KQS+L2),NV(2),LQ(KQS+L3),NV(3),
- + LQ(KQS+L4),NV(4),LQ(KQS+L5),NV(5),LQ(KQS+L6),NV(6))
-
-C---- Overflow material pending ?
-
- 279 IF (IDX(2).EQ.8) GO TO 999
- IF (NOV.LE.0) GO TO 242
- LV(1) = LOV
- NV(1) = NOV
- NOV = NOV - MAXREX
- IF (NOV.GT.0) GO TO 282
-
-C-- End of all material ?
-
- IF (LTB.EQ.LQTE) GO TO 267
- IF (NOV.EQ.0) GO TO 271
-
-C-- End of segment ?
-
- IF (NDOSG.NE.0) GO TO 257
- GO TO 271
-
-C-- Overflow on overflow
-
- 282 NV(1) = MAXREX
- LOV = LOV + MAXREX
- GO TO 271
-
-C-----------------------------------------------------------
-C-- WRITE START/END-OF-RUN
-C-----------------------------------------------------------
-
- 301 JRUN = IQUEST(11)
- NWUHU = IDX(1) - 1
- IF (NWUHU.NE.0) THEN
- CALL FZON2 (JRUN,1,IUHEAD,NWUHU)
- ELSE
- CALL FZON1 (JRUN,1)
- ENDIF
- GO TO 999
-
-C-----------------------------------------------------------
-C-- ENDFILE
-C-----------------------------------------------------------
-
-C- NEOF = 1 EoF 1 only IDX(1) = -2 EoF
-C- 2 EOF 2 only -3 EoD
-C- 3 EOF 1 + 2
-
- 401 NEOFU = IQUEST(11)
- NEOF = IQUEST(12)
- IQUEST(11) = NEOFU
- NEOF = NEOFU
- 412 ENDFILE LUNX
- NEOF = NEOF - 1
- IF (NEOF.GT.0) GO TO 412
-#if defined(CERNLIB_QPRINT)
- IF (LOGLVX.GE.0) WRITE (IQLOG,9414) LUNX,IQUEST(11)
- 9414 FORMAT (' FZOFFN. LUN=',I4,' Write',I2,' System EOF')
-#endif
- GO TO 999
- END
-#endif
diff --git a/src/packlib/zebra/fq/fzoffx.F b/src/packlib/zebra/fq/fzoffx.F
deleted file mode 100644
index 61388e2..0000000
--- a/src/packlib/zebra/fq/fzoffx.F
+++ /dev/null
@@ -1,265 +0,0 @@
-*
-* $Id: fzoffx.F,v 1.4 1999/06/18 13:29:32 couet Exp $
-*
-* $Log: fzoffx.F,v $
-* Revision 1.4 1999/06/18 13:29:32 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.3 1996/04/24 17:26:27 mclareni
-* Extend the include file cleanup to dzebra, rz and tq, and also add
-* dependencies in some cases.
-*
-* Revision 1.2 1996/04/18 16:10:48 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:14 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE FZOFFX (IUHEAD)
-
-C- Write to buffer operations for file format Exchange,
-C- subsidiary to FZOUT
-
-C- Controlling parameter : IDX(2)
-C-
-C- IDX(2) = 1 write start/end-of-run
-C- > 1 write pilot for d/s
-C- = 0 write bank material for d/s
-C- = -1 flush the buffer
-C- = -2 End-of-File
-C- = -3 End-of-Data
-
-#include "zebra/zunit.inc"
-#include "zebra/mqsys.inc"
-#include "zebra/eqlqf.inc"
-#include "zebra/mzct.inc"
-#include "zebra/mzcn.inc"
-#include "zebra/mzioc.inc"
-#include "zebra/fzcx.inc"
-#include "zebra/fzcseg.inc"
-*
- DIMENSION IUHEAD(99)
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HFZOF, 4HFX /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HFZOFFX /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'FZOFFX ')
-#endif
-#if !defined(CERNLIB_FQXISN)
-#include "zebra/q_jbyt.inc"
-#endif
-
-#include "zebra/qtraceq.inc"
-
- IF (IDX(2)) 71, 41, 11
- 11 IF (IDX(2).EQ.1) GO TO 61
-
-C-----------------------------------------------------------
-C------ WRITE PILOT INFORMATION, STARTING LR AND D/S
-C-----------------------------------------------------------
-
- IDX(1) = 10 + NWUHCX + NWSEGX + NWTXX + NWTABX + NWBKX
-#if !defined(CERNLIB_FQXISN)
- IF (IDAFOX.EQ.0) GO TO 31
-
-C-----------------------------------------------------------
-C-- Pilot in exchange data format
-C-----------------------------------------------------------
-
- MFO(1) = 3
- MFO(2) = 1
- MFO(3) = 1
- MFO(4) = -1
- JFOEND = 4
- CALL FZOTRX (IPILX, 10+NWIOX)
-
-C-- User header
-
- IF (NWUHCX.NE.0) THEN
- CALL MZIOCR (IOCHX)
- CALL FZOTRX (IUHEAD, NWUHX)
- ENDIF
-
-C-- Segment table
-
- IF (NWSEGX.NE.0) THEN
- MFO(1) = 5
- MFO(2) = -1
- JFOEND = 2
- CALL FZOTRX (IQSEGH, 2*NQSEG)
- MFO(1) = 1
- MFO(2) = -1
- CALL FZOTRX (IQSEGD, NQSEG)
- ENDIF
-
-C-- Text vector
-
- IF (NWTXX.NE.0) THEN
- MFO(1) = 5
- MFO(2) = 0
- JFOEND = 2
- JFOREP = 0
- CALL FZOTRX (IQ(KQSP+LTEXTX+5), NWTXX)
- ENDIF
-
-C-- Relocation table, only FZOUT, not FZCOPY
-
- IF (ICOPYX.NE.0) GO TO 39
- IF (NWTABX.NE.0) THEN
- MFO(1) = 1
- MFO(2) = -1
- JFOEND = 2
- CALL FZOTRX (LQ(LQTA), NWTABX)
- ENDIF
- GO TO 39
-#endif
-
-C-----------------------------------------------------------
-C-- Pilot in native data format
-C-----------------------------------------------------------
-
- 31 CALL FZOTRN (IPILX,10+NWIOX)
-
-C-- User header
-
- IF (NWUHCX.NE.0) CALL FZOTRN (IUHEAD, NWUHX)
-
-C-- Segment table
-
- IF (NWSEGX.NE.0) THEN
- CALL FZOTRN (IQSEGH, 2*NQSEG)
- CALL FZOTRN (IQSEGD, NQSEG)
- ENDIF
-
-C-- Text vector
-
- IF (NWTXX.NE.0) THEN
- CALL FZOTRN (IQ(KQSP+LTEXTX+5), NWTXX)
- ENDIF
-
-C-- Relocation table, only FZOUT, not FZCOPY
-
- IF (ICOPYX.NE.0) GO TO 39
- IF (NWTABX.NE.0) CALL FZOTRN (LQ(LQTA), NWTABX)
- 39 IF (NWBKX.NE.0) GO TO 999
- GO TO 991
-
-C-----------------------------------------------------------
-C-- WRITE BANK MATERIAL
-C-----------------------------------------------------------
-
- 41 LTB = LQTA
-#if !defined(CERNLIB_FQXISN)
- IF (IDAFOX.EQ.0) GO TO 51
-
-C-----------------------------------------------------------
-C-- Bank groups in exchange data format
-C-----------------------------------------------------------
-
- 42 L = LQ(LTB)
- LE = LQ(LTB+1)
-
-C-- Next bank
-
- 44 IQLN = L
- IWD = LQ(KQS+L)
- NST = JBYT (IWD,1,16) - 12
- IF (NST.LT.0) GO TO 48
-
-C-- True bank
-
- IQLS = L + NST + 1
- IQNIO = JBYT (IQ(KQS+IQLS),19,4)
- IQNL = IQ(KQS+IQLS-3)
- IQND = IQ(KQS+IQLS-1)
- IQNX = IQLS + IQND + 9
-
-C- first word, I/O words, links, next-link, up-link
- N = IQNIO + IQNL
- MFO(1) = 1
- MFO(2) = N + 3
-
-C- origin, numeric ID
- MFO(3) = 2
- MFO(4) = 2
-
-C- Hollerith ID
- MFO(5) = 5
- MFO(6) = 1
-
-C- NL, NS, ND, status
- MFO(7) = 1
- MFO(8) = -1
- JFOEND = 8
- CALL FZOTRX (LQ(KQS+L), N+10)
-
-C- data words
- IF (IQND.EQ.0) GO TO 46
- CALL MZIOCR (LQ(KQS+IQLN))
- CALL FZOTRX (IQ(KQS+IQLS+1), IQND)
-
- 46 L = IQNX
- IF (L.LT.LE) GO TO 44
- LTB = LTB + 2
- IF (LTB.LT.LQTE) GO TO 42
- GO TO 991
-
-C-- Short dead region
-
- 48 NWD = NST + 12
- IQNX = L + NWD
- MFO(1) = 1
- MFO(2) = -1
- JFOEND = 2
- CALL FZOTRX (LQ(KQS+L), NWD)
- GO TO 46
-#endif
-
-C-----------------------------------------------------------
-C-- Bank-groups in native data format
-C-----------------------------------------------------------
-
- 51 L = LQ(LTB)
- LE = LQ(LTB+1)
- CALL FZOTRN (LQ(KQS+L), LE-L)
- LTB = LTB + 2
- IF (LTB.LT.LQTE) GO TO 51
-
- 991 CALL FZOREC
-#include "zebra/qtrace99.inc"
- RETURN
-
-C-----------------------------------------------------------
-C-- WRITE START/END-OF-RUN
-C-----------------------------------------------------------
-
- 61 JRUN = IQUEST(11)
- NWUHU = IDX(1) - 1
-#if !defined(CERNLIB_FQXISN)
- IF (IDAFOX.EQ.0) GO TO 64
- MFO(1) = 2
- MFO(2) = -1
- JFOEND = 2
- CALL FZOTRX (JRUN,1)
- IF (NWUHU.EQ.0) GO TO 991
- CALL FZOTRX (IUHEAD,NWUHU)
- GO TO 991
-#endif
- 64 CALL FZOTRN (JRUN,1)
- IF (NWUHU.NE.0) CALL FZOTRN (IUHEAD,NWUHU)
- GO TO 991
-
-C-----------------------------------------------------------
-C-- FLUSH BUFFER / ENDFILE
-C-----------------------------------------------------------
-
- 71 GO TO 991
- END
diff --git a/src/packlib/zebra/fq/fzon1.F b/src/packlib/zebra/fq/fzon1.F
deleted file mode 100644
index 84ef9d2..0000000
--- a/src/packlib/zebra/fq/fzon1.F
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: fzon1.F,v 1.2 1999/06/18 13:29:33 couet Exp $
-*
-* $Log: fzon1.F,v $
-* Revision 1.2 1999/06/18 13:29:33 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:13 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
-#if defined(CERNLIB_FZFFNAT)
- SUBROUTINE FZON1 (V1,N1)
-
-#include "zebra/mqsys.inc"
-#include "zebra/eqlqf.inc"
-#include "zebra/fzcx.inc"
-*
-#if !defined(CERNLIB_AUTODBL)
- INTEGER V1(N1)
-#endif
-#if defined(CERNLIB_AUTODBL)
- REAL V1(N1),RELIDX(2)
- EQUIVALENCE (RELIDX(1),IDX(1))
-#endif
-
- IDX(1) = N1
-
-#if !defined(CERNLIB_AUTODBL)
- WRITE (LUNX) IDX,V1
-#endif
-#if defined(CERNLIB_AUTODBL)
- WRITE (LUNX) RELIDX,V1
-#endif
- IQ(KQSP+LQFX+20) = IQ(KQSP+LQFX+20) + IDX(1) + 3
- IQ(KQSP+LQFX+21) = IQ(KQSP+LQFX+21) + 1
- RETURN
- END
-#endif
diff --git a/src/packlib/zebra/fq/fzon2.F b/src/packlib/zebra/fq/fzon2.F
deleted file mode 100644
index d96a8f4..0000000
--- a/src/packlib/zebra/fq/fzon2.F
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: fzon2.F,v 1.2 1999/06/18 13:29:34 couet Exp $
-*
-* $Log: fzon2.F,v $
-* Revision 1.2 1999/06/18 13:29:34 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:13 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
-#if defined(CERNLIB_FZFFNAT)
- SUBROUTINE FZON2 (V1,N1,V2,N2)
-
-#include "zebra/mqsys.inc"
-#include "zebra/eqlqf.inc"
-#include "zebra/fzcx.inc"
-*
-#if !defined(CERNLIB_AUTODBL)
- INTEGER V1(N1),V2(N2)
-#endif
-#if defined(CERNLIB_AUTODBL)
- REAL V1(N1),V2(N2),RELIDX(2)
- EQUIVALENCE (RELIDX(1),IDX(1))
-#endif
-
- IDX(1) = N1 + N2
-
-#if !defined(CERNLIB_AUTODBL)
- WRITE (LUNX) IDX,V1,V2
-#endif
-#if defined(CERNLIB_AUTODBL)
- WRITE (LUNX) RELIDX,V1,V2
-#endif
- IQ(KQSP+LQFX+20) = IQ(KQSP+LQFX+20) + IDX(1) + 3
- IQ(KQSP+LQFX+21) = IQ(KQSP+LQFX+21) + 1
- RETURN
- END
-#endif
diff --git a/src/packlib/zebra/fq/fzon3.F b/src/packlib/zebra/fq/fzon3.F
deleted file mode 100644
index e04d096..0000000
--- a/src/packlib/zebra/fq/fzon3.F
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: fzon3.F,v 1.2 1999/06/18 13:29:35 couet Exp $
-*
-* $Log: fzon3.F,v $
-* Revision 1.2 1999/06/18 13:29:35 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:13 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
-#if defined(CERNLIB_FZFFNAT)
- SUBROUTINE FZON3 (V1,N1,V2,N2,V3,N3)
-
-#include "zebra/mqsys.inc"
-#include "zebra/eqlqf.inc"
-#include "zebra/fzcx.inc"
-*
-#if !defined(CERNLIB_AUTODBL)
- INTEGER V1(N1),V2(N2),V3(N3)
-#endif
-#if defined(CERNLIB_AUTODBL)
- REAL V1(N1),V2(N2),V3(N3),RELIDX(2)
- EQUIVALENCE (RELIDX(1),IDX(1))
-#endif
-
- IDX(1) = N1 + N2 + N3
-
-#if !defined(CERNLIB_AUTODBL)
- WRITE (LUNX) IDX,V1,V2,V3
-#endif
-#if defined(CERNLIB_AUTODBL)
- WRITE (LUNX) RELIDX, V1,V2,V3
-#endif
- IQ(KQSP+LQFX+20) = IQ(KQSP+LQFX+20) + IDX(1) + 3
- IQ(KQSP+LQFX+21) = IQ(KQSP+LQFX+21) + 1
- RETURN
- END
-#endif
diff --git a/src/packlib/zebra/fq/fzon4.F b/src/packlib/zebra/fq/fzon4.F
deleted file mode 100644
index 05e395a..0000000
--- a/src/packlib/zebra/fq/fzon4.F
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: fzon4.F,v 1.2 1999/06/18 13:29:36 couet Exp $
-*
-* $Log: fzon4.F,v $
-* Revision 1.2 1999/06/18 13:29:36 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:13 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
-#if defined(CERNLIB_FZFFNAT)
- SUBROUTINE FZON4 (V1,N1,V2,N2,V3,N3,V4,N4)
-
-#include "zebra/mqsys.inc"
-#include "zebra/eqlqf.inc"
-#include "zebra/fzcx.inc"
-*
-#if !defined(CERNLIB_AUTODBL)
- INTEGER V1(N1),V2(N2),V3(N3),V4(N4)
-#endif
-#if defined(CERNLIB_AUTODBL)
- REAL V1(N1),V2(N2),V3(N3),V4(N4),RELIDX(2)
- EQUIVALENCE (RELIDX(1),IDX(1))
-#endif
-
- IDX(1) = N1 + N2 + N3 + N4
-
-#if !defined(CERNLIB_AUTODBL)
- WRITE (LUNX) IDX,V1,V2,V3,V4
-#endif
-#if defined(CERNLIB_AUTODBL)
- WRITE (LUNX) RELIDX,V1,V2,V3,V4
-#endif
- IQ(KQSP+LQFX+20) = IQ(KQSP+LQFX+20) + IDX(1) + 3
- IQ(KQSP+LQFX+21) = IQ(KQSP+LQFX+21) + 1
- RETURN
- END
-#endif
diff --git a/src/packlib/zebra/fq/fzon5.F b/src/packlib/zebra/fq/fzon5.F
deleted file mode 100644
index 3c5205f..0000000
--- a/src/packlib/zebra/fq/fzon5.F
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: fzon5.F,v 1.2 1999/06/18 13:29:37 couet Exp $
-*
-* $Log: fzon5.F,v $
-* Revision 1.2 1999/06/18 13:29:37 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:14 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
-#if defined(CERNLIB_FZFFNAT)
- SUBROUTINE FZON5 (V1,N1,V2,N2,V3,N3,V4,N4,V5,N5)
-
-#include "zebra/mqsys.inc"
-#include "zebra/eqlqf.inc"
-#include "zebra/fzcx.inc"
-*
-#if !defined(CERNLIB_AUTODBL)
- INTEGER V1(N1),V2(N2),V3(N3),V4(N4),V5(N5)
-#endif
-#if defined(CERNLIB_AUTODBL)
- REAL V1(N1),V2(N2),V3(N3),V4(N4),V5(N5),RELIDX(2)
- EQUIVALENCE (RELIDX(1),IDX(1))
-#endif
-
- IDX(1) = N1 + N2 + N3 + N4 + N5
-
-#if !defined(CERNLIB_AUTODBL)
- WRITE (LUNX) IDX,V1,V2,V3,V4,V5
-#endif
-#if defined(CERNLIB_AUTODBL)
- WRITE (LUNX) RELIDX, V1,V2,V3,V4,V5
-#endif
- IQ(KQSP+LQFX+20) = IQ(KQSP+LQFX+20) + IDX(1) + 3
- IQ(KQSP+LQFX+21) = IQ(KQSP+LQFX+21) + 1
- RETURN
- END
-#endif
diff --git a/src/packlib/zebra/fq/fzon6.F b/src/packlib/zebra/fq/fzon6.F
deleted file mode 100644
index cd2ff01..0000000
--- a/src/packlib/zebra/fq/fzon6.F
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: fzon6.F,v 1.2 1999/06/18 13:29:38 couet Exp $
-*
-* $Log: fzon6.F,v $
-* Revision 1.2 1999/06/18 13:29:38 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:14 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
-#if defined(CERNLIB_FZFFNAT)
- SUBROUTINE FZON6 (V1,N1,V2,N2,V3,N3,V4,N4,V5,N5,V6,N6)
-
-#include "zebra/mqsys.inc"
-#include "zebra/eqlqf.inc"
-#include "zebra/fzcx.inc"
-*
-#if !defined(CERNLIB_AUTODBL)
- INTEGER V1(N1),V2(N2),V3(N3),V4(N4),V5(N5),V6(N6)
-#endif
-#if defined(CERNLIB_AUTODBL)
- REAL V1(N1),V2(N2),V3(N3),V4(N4),V5(N5),V6(N6),RELIDX(2)
- EQUIVALENCE (RELIDX(1),IDX(1))
-#endif
-
- IDX(1) = N1 + N2 + N3 + N4 + N5 + N6
-
-#if !defined(CERNLIB_AUTODBL)
- WRITE (LUNX) IDX,V1,V2,V3,V4,V5,V6
-#endif
-#if defined(CERNLIB_AUTODBL)
- WRITE (LUNX) RELIDX, V1,V2,V3,V4,V5,V6
-#endif
- IQ(KQSP+LQFX+20) = IQ(KQSP+LQFX+20) + IDX(1) + 3
- IQ(KQSP+LQFX+21) = IQ(KQSP+LQFX+21) + 1
- RETURN
- END
-#endif
diff --git a/src/packlib/zebra/fq/fzophr.F b/src/packlib/zebra/fq/fzophr.F
deleted file mode 100644
index d9cb3c6..0000000
--- a/src/packlib/zebra/fq/fzophr.F
+++ /dev/null
@@ -1,271 +0,0 @@
-*
-* $Id: fzophr.F,v 1.3 1999/06/18 13:29:39 couet Exp $
-*
-* $Log: fzophr.F,v $
-* Revision 1.3 1999/06/18 13:29:39 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.2 1996/04/18 16:10:48 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:11 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE FZOPHR
-
-C- Write one physical record
-C- service routine to FZOUT
-
-#include "zebra/zunit.inc"
-#include "zebra/mqsys.inc"
-#include "zebra/eqlqf.inc"
-#include "zebra/mzcn.inc"
-#include "zebra/mzioc.inc"
-#include "zebra/fzcx.inc"
-*
-
-#include "fzstamp.inc"
-
-* Declaratives, DIMENSION etc.
-#include "fzophrd1.inc"
-* Ignoring t=pass
-
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HFZOP, 4HHR /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HFZOPHR /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'FZOPHR ')
-#endif
-
-* Declaratives, DATA
-#include "fzophrd2.inc"
-
-
-#include "zebra/qtrace.inc"
-
-C------ Book-keeping
-
- JOP = IDX(2)
- IF (JOP.LT.-1) GO TO 81
- IQ(KQSP+LQFX+22) = IQ(KQSP+LQFX+22) + 1
- IQ(KQSP+LQFX+33) = IQ(KQSP+LQFX+33) + 1
-
- JFAST = IQ(KQSP+LBPARX-6)
- NFASTX = IQ(KQSP+LBPARX-5)
- IF (JFAST.NE.0) GO TO 17
-
-C-- Steering record
-
- LQ(L4STAX) = MCCW1
- LQ(L4STAX+1) = MCCW2
- LQ(L4STAX+2) = MCCW3
- LQ(L4STAX+3) = MCCW4
- LQ(L4STAX+7) = NFASTX
- IQ(KQSP+LQFX+23)= IQ(KQSP+LQFX+23) + 1
-#if defined(CERNLIB_QDEVZE)
- J = LQ(L4STAX+5)
- IF (LOGLVX.GE.3) WRITE (IQLOG,9716) J,NFASTX
- 9716 FORMAT (' FZOPHR- write steering record #',I5,' NFASTX=',2I4)
-#endif
- GO TO 19
-
-C-- Fast record
-
- 17 NFASTX = NFASTX - 1
- IQ(KQSP+LBPARX-5) = NFASTX
-#if defined(CERNLIB_QDEVZE)
- IF (LOGLVX.GE.3) WRITE (IQLOG,9717)
- 9717 FORMAT (' FZOPHR- write fast record')
-#endif
- 19 IQ(KQSP+LBPARX-6) = NFASTX
-
-C----------- Output of the record ----------------------
-
- LWR = L4STAX
- NWR = IQ(KQSP+LBPARX+1)
- NWU = NWR - NWFILX
-
-#if defined(CERNLIB_FZALFA)
- IF (IFIFOX.EQ.4) GO TO 78
-#endif
-#if defined(CERNLIB_FQNEEDCV)
-
-C-- Pack the record, if needed
-
- IF (IUPAKX.NE.0) GO TO 24
- NWPK = MAXREX - NWFILX
-
-#endif
-#if defined(CERNLIB_FQNEEDCV)
-#include "fzophr22.inc"
-#endif
-#if defined(CERNLIB_FQNEEDCV)
- 24 CONTINUE
-
-#endif
-#if defined(CERNLIB_FZDACC)
- IF (IFIFOX.EQ.2) GO TO 51
-#endif
-#if defined(CERNLIB_FZMEMORY)
- IF (IFIFOX.EQ.3) GO TO 71
-#endif
-
-C-----------------------------------------------------------
-C---- Output Sequential
-C-----------------------------------------------------------
-
- IQ(KQSP+LQFX+20) = IQ(KQSP+LQFX+20) + NWR
-
-#if defined(CERNLIB_FZCHANNEL)
-C-- Output sequential channel
-
- IF (IACMOX.EQ.3) THEN
- CALL JUMPST (IADOPX)
- ICODE = 1
- IQUEST(1) = LUNX
- IQUEST(2) = NWR
- IQUEST(3) = ISTENX
- IQUEST(4) = 0
- IQUEST(5) = MEDIUX - 4
- CALL JUMPX2 (LQ(LWR),ICODE)
- GO TO 999
- ENDIF
-
-#endif
-#if defined(CERNLIB_FZLIBC)
-C-- Output sequential with calls to the C library
-
- IF (IACMOX.EQ.2) THEN
- CALL CFPUT (IADOPX, MEDIUX, NWR, LQ(LWR), ISW)
- IF (ISW.NE.0) THEN
- IQUEST(1) = 19
- IQUEST(2) = 21
- IQUEST(3) = ISW
- IQUEST(4) = LUNX
- IQUEST(5) = IADOPX
- CALL ZTELL (19,0)
- ENDIF
- GO TO 999
- ENDIF
-
-#endif
-#if defined(CERNLIB_FZFORTRAN)
-C-- Output sequential with Fortran calls
-
-#include "fzophr44.inc"
-* Ignoring t=pass
-#endif
-#if defined(CERNLIB_FZFORTRAN)
-#include "fzophr45.inc"
-
-#endif
-#if defined(CERNLIB_FZDACC)
-C-----------------------------------------------------------
-C---- Output Direct Access
-C-----------------------------------------------------------
-
- 51 JREC = IQ(KQSP+LQFX+33)
- IQ(KQSP+LQFX+20) = IQ(KQSP+LQFX+20) + NWR
-
-#endif
-#if defined(CERNLIB_FZDACCH)
-C-- Output random channel
-
- IF (IACMOX.EQ.3) THEN
- CALL JUMPST (IADOPX)
- ICODE = 1
- IQUEST(1) = LUNX
- IQUEST(2) = NWR
- IQUEST(3) = ISTENX
- IQUEST(4) = JREC
- IQUEST(5) = MEDIUX - 4
- CALL JUMPX2 (LQ(LWR),ICODE)
- GO TO 999
- ENDIF
-
-#endif
-#if defined(CERNLIB_FZDACCL)
-C-- Output random with calls to the C library
-
- IF (IACMOX.EQ.2) THEN
- CALL CFPUT (IADOPX, MEDIUX, NWR, LQ(LWR), ISW)
- IF (ISW.NE.0) THEN
- IQUEST(1) = 19
- IQUEST(2) = 22
- IQUEST(3) = ISW
- IQUEST(4) = LUNX
- IQUEST(5) = IADOPX
- CALL ZTELL (19,0)
- ENDIF
- GO TO 999
- ENDIF
-
-#endif
-#if defined(CERNLIB_FZDACCF)
-#include "fzophr55.inc"
-
-#endif
-#if defined(CERNLIB_FZMEMORY)
-C-----------------------------------------------------------
-C---- Output in memory mode
-C-----------------------------------------------------------
-
- 71 LBUF = IQ(KQSP+LQFX+1)
- CALL UCOPY (LQ(LWR),LQ(LBUF),NWU)
- IQ(KQSP+LQFX+1) = IQ(KQSP+LQFX+1) + NWU
- IQ(KQSP+LQFX+20) = IQ(KQSP+LQFX+20) + NWU
- GO TO 999
-
-#endif
-#if defined(CERNLIB_FZALFA)
-C-----------------------------------------------------------
-C---- Output ALFA format
-C-----------------------------------------------------------
-
- 78 CALL FZOASC (LUNX,L4STAX,L4ENDX,JFAST,L4STOX,0)
- IQ(KQSP+LQFX+20) = IQ(KQSP+LQFX+20) + MAXREX
- GO TO 999
-
-#endif
-C-----------------------------------------------------------
-C-- ENDFILE
-C-----------------------------------------------------------
-
-C- NEOFM = 1 EoF 1 only IDX(1) = -2 EoF
-C- 2 EOF 2 only -3 EoD
-C- 3 EOF 1 + 2
-
- 81 IF (IFIFOX.GE.2) GO TO 999
- IF (IACMOX.GE.3) GO TO 999
- NEOFU = IQUEST(11)
- NEOFM = IQUEST(12)
-#if defined(CERNLIB_FZLIBC)
- IF (IACMOX.EQ.2) THEN
- CALL CFWEOF (IADOPX, MEDIUX, IQUEST(11))
- GO TO 89
- ENDIF
-#endif
-
-#include "fzophre1.inc"
-* Ignoring t=pass
-
- 87 DO 88 J=1,NEOFU
- ENDFILE LUNX
- 88 CONTINUE
- 89 CONTINUE
-#if defined(CERNLIB_QPRINT)
- IF (LOGLVX.GE.0) WRITE (IQLOG,9089) LUNX,IQUEST(11)
- 9089 FORMAT (' FZOPHR. LUN=',I4,' Write',I2,' System EOF')
-#endif
-
-#include "zebra/qtrace99.inc"
- RETURN
- END
diff --git a/src/packlib/zebra/fq/fzophr22.inc b/src/packlib/zebra/fq/fzophr22.inc
deleted file mode 100644
index 5e23278..0000000
--- a/src/packlib/zebra/fq/fzophr22.inc
+++ /dev/null
@@ -1,59 +0,0 @@
-*
-* $Id: fzophr22.inc,v 1.1.1.1 1996/03/06 10:47:08 mclareni Exp $
-*
-* $Log: fzophr22.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:08 mclareni
-* Zebra
-*
-*
-* pack 32-bit words to 60-bit
-*
-* fzophr22.inc
-*
-#if defined(CERNLIB_QMCDC)
- IF (NWFILX.NE.0) NWU = NWR - (32*NWFILX)/60
- CALL PKCHAR (LQ(LWR),LQ(LWR-1),NWPK,IPKVEC)
- LWR = LWR - 1
-* pack 32-bit words to 64-bits
-*
-* fzophr22.inc
-*
-#elif defined(CERNLIB_QMCRY)
- IF (NWFILX.NE.0) THEN
- NWU = (NWPK+1) / 2
- NWPK = NWU * 2
- ENDIF
- CALL PACK (LQ(LWR),32,LQ(LWR),NWPK)
-* pack 32-bit words to 64-bits
-*
-* fzophr22.inc
-*
-#elif (defined(CERNLIB_QMCV64))&&(!defined(CERNLIB_QIEEE))
- IF (NWFILX.NE.0) THEN
- NWU = (NWPK+1) / 2
- NWPK = NWU * 2
- ENDIF
- CALL PACK32 (LQ(LWR),LQ(LWR),NWPK)
-* pack 32-bit words to 64-bits
-*
-* fzophr22.inc
-*
-#elif defined(CERNLIB_QMIBMD)
- IF (NWFILX.NE.0) THEN
- NWU = (NWPK+1) / 2
- NWPK = NWU * 2
- ENDIF
- CALL PACK (LQ(LWR),LQ(LWR),NWPK)
-* pack 32-bit words to 64-bits
-*
-* fzophr22.inc
-*
-#elif defined(CERNLIB_QMIRTD)
- IF (NWFILX.NE.0) THEN
- NWU = (NWPK+1) / 2
- NWPK = NWU * 2
- ENDIF
- CALL PACK (LQ(LWR),LQ(LWR),NWPK)
-#elif 1
- CALL VXINVB (LQ(LWR),NWPK)
-#endif
diff --git a/src/packlib/zebra/fq/fzophr44.inc b/src/packlib/zebra/fq/fzophr44.inc
deleted file mode 100644
index 6504b30..0000000
--- a/src/packlib/zebra/fq/fzophr44.inc
+++ /dev/null
@@ -1,42 +0,0 @@
-*
-* $Id: fzophr44.inc,v 1.1.1.1 1996/03/06 10:47:10 mclareni Exp $
-*
-* $Log: fzophr44.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:10 mclareni
-* Zebra
-*
-*
-*
-* fzophr44.inc
-*
-#if (defined(CERNLIB_QMIBM))&&(defined(CERNLIB_IOPACK))
- IF (IACMOX.EQ.0) GO TO 48
- CALL IORITE (LUNX,LQ(LWR),4*NWR,ISW)
- IF (ISW.EQ.0) GO TO 999
- IF (ISW.NE.2) GO TO 45
- IF (IQ(KQSP+LQFX+37)+IQ(KQSP+LQFX+38).EQ.0) GO TO 45
- IQ(KQSP+LQFX+37) = IQ(KQSP+LQFX+19)
- IQ(KQSP+LQFX+38) = IQ(KQSP+LQFX+20)
- GO TO 999
-
- 45 IQUEST(11) = ISW
- CALL ZFATAM ('FZOPHR - error from IORITE.')
-#endif
-*
-* fzophr44.inc
-*
-#if defined(CERNLIB_QMND3)
- IF (IACMOX.EQ.0) GO TO 48
- NIL = 0
- ISW = MAGTP (1,LQ(LWR),LUNX,NWR,NIL)
- IF (ISW.EQ.0) GO TO 999
- IQUEST(12) = MAGTP (20B,NIL,LUNX,NIL,NIL)
- IF (JBIT(IQUEST(12),10).EQ.0) GO TO 45
- IF (IQ(KQSP+LQFX+37)+IQ(KQSP+LQFX+38).EQ.0) GO TO 45
- IQ(KQSP+LQFX+37) = IQ(KQSP+LQFX+19)
- IQ(KQSP+LQFX+38) = IQ(KQSP+LQFX+20)
- GO TO 999
-
- 45 IQUEST(11) = ISW
- CALL ZFATAM ('FZOPHR - error from MAGTP.')
-#endif
diff --git a/src/packlib/zebra/fq/fzophr45.inc b/src/packlib/zebra/fq/fzophr45.inc
deleted file mode 100644
index 1c71caf..0000000
--- a/src/packlib/zebra/fq/fzophr45.inc
+++ /dev/null
@@ -1,47 +0,0 @@
-*
-* $Id: fzophr45.inc,v 1.1.1.1 1996/03/06 10:47:10 mclareni Exp $
-*
-* $Log: fzophr45.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:10 mclareni
-* Zebra
-*
-*
-*
-* fzophr45.inc
-*
-#if defined(CERNLIB_QMIBMD)
-C-- Output sequential with Fortran calls
-C-- For AUTODBL machines
- IF (IACMOX.EQ.0) GO TO 48
- CALL ADWRTK (LUNX, LQ(LWR), NWR, ISW)
- IF (ISW.NE.0) THEN
- IQUEST(1) = 19
- IQUEST(2) = 1
- IQUEST(3) = ISW
- IQUEST(4) = LUNX
- CALL ZTELL (19,0)
- ENDIF
- GO TO 999
-#elif defined(CERNLIB_QMIRTD)
-C-- Output sequential with Fortran calls
-C-- For AUTODBL machines
- 48 CALL ADWRTK (LUNX, LQ(LWR), NWR, ISW)
- IF (ISW.NE.0) THEN
- IQUEST(1) = 19
- IQUEST(2) = 1
- IQUEST(3) = ISW
- IQUEST(4) = LUNX
- CALL ZTELL (19,0)
- ENDIF
- GO TO 999
-#elif 1
- 48 WRITE (LUNX,IOSTAT=ISW) (LQ(LWR+J-1),J=1,NWR)
- IF (ISW.NE.0) THEN
- IQUEST(1) = 19
- IQUEST(2) = 1
- IQUEST(3) = ISW
- IQUEST(4) = LUNX
- CALL ZTELL (19,0)
- ENDIF
- GO TO 999
-#endif
diff --git a/src/packlib/zebra/fq/fzophr55.inc b/src/packlib/zebra/fq/fzophr55.inc
deleted file mode 100644
index 4020f5d..0000000
--- a/src/packlib/zebra/fq/fzophr55.inc
+++ /dev/null
@@ -1,49 +0,0 @@
-*
-* $Id: fzophr55.inc,v 1.1.1.1 1996/03/06 10:47:10 mclareni Exp $
-*
-* $Log: fzophr55.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:10 mclareni
-* Zebra
-*
-*
-*
-* fzophr55.inc
-*
-#if defined(CERNLIB_QMIBMD)
-C-- Output random with Fortran calls
-
- CALL ADWRTKD (LUNX,LQ(LWR),NWR,JREC,ISW)
- IF (ISW.NE.0) THEN
- IQUEST(1) = 19
- IQUEST(2) = 2
- IQUEST(3) = ISW
- IQUEST(4) = LUNX
- CALL ZTELL (19,0)
- ENDIF
- GO TO 999
-#elif defined(CERNLIB_QMIRTD)
-C-- Output random with Fortran calls
-
- CALL ADWRTKD (LUNX,LQ(LWR),NWR,JREC,ISW)
- IF (ISW.NE.0) THEN
- IQUEST(1) = 19
- IQUEST(2) = 2
- IQUEST(3) = ISW
- IQUEST(4) = LUNX
- CALL ZTELL (19,0)
- ENDIF
- GO TO 999
-#elif 1
-C-- Output random with Fortran calls
-
- WRITE (LUNX,REC=JREC,IOSTAT=ISW) (LQ(LWR+J-1),J=1,NWR)
- IF (ISW.NE.0) THEN
- IQUEST(1) = 19
- IQUEST(2) = 2
- IQUEST(3) = ISW
- IQUEST(4) = LUNX
- CALL ZTELL (19,0)
- ENDIF
- GO TO 999
-
-#endif
diff --git a/src/packlib/zebra/fq/fzophrd1.inc b/src/packlib/zebra/fq/fzophrd1.inc
deleted file mode 100644
index 9d411c4..0000000
--- a/src/packlib/zebra/fq/fzophrd1.inc
+++ /dev/null
@@ -1,14 +0,0 @@
-*
-* $Id: fzophrd1.inc,v 1.1.1.1 1996/03/06 10:47:08 mclareni Exp $
-*
-* $Log: fzophrd1.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:08 mclareni
-* Zebra
-*
-*
-*
-* fzophrd1.inc
-*
-#if defined(CERNLIB_QMCDC)
- DIMENSION IPKVEC(5)
-#endif
diff --git a/src/packlib/zebra/fq/fzophrd2.inc b/src/packlib/zebra/fq/fzophrd2.inc
deleted file mode 100644
index c18fef0..0000000
--- a/src/packlib/zebra/fq/fzophrd2.inc
+++ /dev/null
@@ -1,14 +0,0 @@
-*
-* $Id: fzophrd2.inc,v 1.1.1.1 1996/03/06 10:47:08 mclareni Exp $
-*
-* $Log: fzophrd2.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:08 mclareni
-* Zebra
-*
-*
-*
-* fzophrd2.inc
-*
-#if defined(CERNLIB_QMCDC)
- DATA IPKVEC / 32, 0, 600000, 0, 0 /
-#endif
diff --git a/src/packlib/zebra/fq/fzophre1.inc b/src/packlib/zebra/fq/fzophre1.inc
deleted file mode 100644
index b356c4c..0000000
--- a/src/packlib/zebra/fq/fzophre1.inc
+++ /dev/null
@@ -1,38 +0,0 @@
-*
-* $Id: fzophre1.inc,v 1.1.1.1 1996/03/06 10:47:10 mclareni Exp $
-*
-* $Log: fzophre1.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:10 mclareni
-* Zebra
-*
-*
-*
-* fzophre1.inc
-*
-#if (defined(CERNLIB_QMIBM))&&(defined(CERNLIB_IOPACK))
-#if !defined(CERNLIB_QIBM_VM)
- IF (IACMOX.EQ.0) GO TO 87
- CALL IODD (LUNX,ISW)
- IQUEST(11) = 1
- GO TO 89
-#endif
-#endif
-#if (defined(CERNLIB_QMIBM))&&(defined(CERNLIB_IOPACK))
- IF (IACMOX.EQ.0) GO TO 87
- CALL IOMOVE (LUNX,-1,ISW)
- IQUEST(11) = 1
- GO TO 89
-* -------------- sequences for input ---------------------
-#endif
-*
-* fzophre1.inc
-*
-#if defined(CERNLIB_QMND3)
- IF (IACMOX.EQ.0) GO TO 87
- DO 84 J=1,NEOFU
- NIL = 1
- CALL MAGTP (12B,NIL,LUNX,NIL,NIL)
- 84 CONTINUE
- GO TO 89
-* -------------- conversions for output -------------------
-#endif
diff --git a/src/packlib/zebra/fq/fzorec.F b/src/packlib/zebra/fq/fzorec.F
deleted file mode 100644
index bee52f9..0000000
--- a/src/packlib/zebra/fq/fzorec.F
+++ /dev/null
@@ -1,316 +0,0 @@
-*
-* $Id: fzorec.F,v 1.3 1999/06/18 13:29:39 couet Exp $
-*
-* $Log: fzorec.F,v $
-* Revision 1.3 1999/06/18 13:29:39 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.2 1996/04/18 16:10:49 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:14 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE FZOREC
-
-C- Record controls, exchange file format
-C- service routine to FZOUT
-
-C- Controlling parameter : IDX(2)
-C-
-C- IDX(2) > 0 start new logical record,
-C- IDX(1) = length
-C- IDX(2) = type : 1 start/end of run
-C- 2 new d/s of new event
-C- 3 new d/s of same event
-C- 9 write emergency stop
-C-
-C- = 0 up-date buffer parameters from L4CURX
-C- write PhR if buffer completed :
-C- either : buffer full and LR continues
-C- or : LR ended on fast block
-C-
-C- = -1 flush the buffer
-C- = -2 End-of-File
-C- = -3 End-of-Data
-
-C- Note : for each LR there is a final call with IDX(2)=0
-C- to save the buffer parameters; at this moment the buffer
-C- is flushed if the record is fast or almost full
-
-#include "zebra/zmach.inc"
-#include "zebra/zunit.inc"
-#include "zebra/mqsys.inc"
-#include "zebra/eqlqf.inc"
-#include "zebra/fzcx.inc"
-*
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HFZOT, 4HRX /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HFZOREC /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'FZOREC ')
-#endif
-
-#include "zebra/q_or.inc"
-#include "zebra/q_jbit.inc"
-#include "zebra/q_sbit1.inc"
-
-#include "zebra/qtrace.inc"
-
-
-C- buffer parameters :
-C- -6 JFAST = 0 : current buffer is steering rec
-C- .NE. 0 : current buffer is fast record
-C- -5 NFASTX, # of fast records still to be written
-C- -4
-C- -3 N4RESX, # of words in LR still to be done
-C- -2 N4DONX, # of words stored in buffer
-C- -1
-C- LBPARX +0 maximum size of buffer
-C- +1 size of PhR, local machine words
-C- +2 INCBUF : step to buffer
-C- +3 (off-set for reading)
-C- +4 off-set for writing
-C- ( =0 normal, =128 ALFA)
-C- -1 free to allow packing
-C- L4STOX +0 start of buffer
-C- L4STAX +0 start of buffer accumulation
-
- LBPARX = LQFX + INCBPX
- JFAST = IQ(KQSP+LBPARX-6)
- NFASTX = IQ(KQSP+LBPARX-5)
-#if defined(CERNLIB_QDEVZE)
- IF (LOGLVX.GE.3) WRITE (IQLOG,9701) IDX(2),JFAST,NFASTX
- 9701 FORMAT (' FZOREC- entered with IDX(2)=',I3,
- F' JFAST,NFASTX=',2I4)
-#endif
-
- IF (IDX(2).EQ.0) GO TO 41
-
- N4RESX = IQ(KQSP+LBPARX-3)
- N4DONX = IQ(KQSP+LBPARX-2)
- INCBUF = IQ(KQSP+LBPARX+2)
- JOFFSO = IQ(KQSP+LBPARX+4)
- L4STOX = KQSP+8 + LBPARX + INCBUF
- L4STAX = L4STOX + JOFFSO
- L4ENDX = L4STAX + MAXREX
-#if defined(CERNLIB_QDEVZE)
- IF (LOGLVX.GE.3) WRITE (IQLOG,9703) N4RESX,N4DONX
- 9703 FORMAT (12X,'N4RESX,N4DONX=',2I7)
-#endif
- IF (IDX(2).LT.0) GO TO 51
- IF (IDX(2).EQ.9) GO TO 30
-
-C-----------------------------------------------------------
-C------ IDX(2) > 0 : start new logical record
-C-----------------------------------------------------------
-
- IQ(KQSP+LQFX+21) = IQ(KQSP+LQFX+21) + 1
-
-#if defined(CERNLIB_FZMEMORY)
- IF (IFIFOX.EQ.3) GO TO 23
-#endif
- IF (N4RESX.NE.0) GO TO 31
- IF (N4DONX.NE.0) GO TO 24
-
-C-- LR starts new physical record
-
- 23 LQ(L4STAX+4) = MAXREX
- IF (MEDIUX.LT.4) THEN
- LQ(L4STAX+5) = IQ(KQSP+LQFX+23)
- ELSE
- LQ(L4STAX+5) = 0
- ENDIF
- LQ(L4STAX+6) = 8
-
- IQ(KQSP+LBPARX-6)= 0
- IQ(KQSP+LBPARX-5)= 0
- N4DONX = 8
- GO TO 25
-
- 24 IF (LQ(L4STAX+6).EQ.0) LQ(L4STAX+6)=N4DONX
- 25 IQ(KQSP+LQFX+31) = IQ(KQSP+LQFX+33) + 1
- IQ(KQSP+LQFX+32) = N4DONX
- N4DONX = N4DONX + 2
- L4CURX = L4STAX + N4DONX
- LQ(L4CURX-2) = IDX(1)
- LQ(L4CURX-1) = IDX(2)
- ISTENX = 1
-
- IF (IDX(2).EQ.1) THEN
- LQ(L4STAX+4) = MSBIT1(LQ(L4STAX+4),31-JRUNX)
- LQ(L4STAX+5) = 0
- ENDIF
-
- IQ(KQSP+LBPARX-3) = IDX(1)
- IQ(KQSP+LBPARX-2) = N4DONX
-
- NWOVFL = N4DONX + IDX(1) - MAXREX
- IF (NWOVFL.LE.0) GO TO 991
-
- NFASTX = (NWOVFL-1)/MAXREX + 1
- IF (JBIT(MSTATX,15).EQ.0) THEN
- NWUNUS = NFASTX*MAXREX - NWOVFL
- IF (NWUNUS .GE. 12) NFASTX=NFASTX-1
- ENDIF
- IQ(KQSP+LBPARX-5) = NFASTX
- GO TO 991
-
-C---- EMERGENCY STOP
-
- 30 IDX(2) = 0
- 31 IF (JFAST.NE.0) GO TO 36
- IF (NFASTX.NE.0) GO TO 33
- IF (N4RESX+N4DONX.GT.MAXREX) GO TO 33
- NWTOLR = LQ(L4STAX+6)
- IF (NWTOLR.EQ.0) GO TO 36
- LQ(L4STAX+NWTOLR) = MAXREX - NWTOLR
-
- 33 NWCL = MAXREX - N4DONX
- IF (NWCL.GT.0) CALL VZERO (LQ(L4STAX+N4DONX),NWCL)
- CALL FZOPHR
-
- 36 LQ(L4STAX+4) = MAXREX
- IF (MEDIUX.LT.4) THEN
- LQ(L4STAX+5) = IQ(KQSP+LQFX+23)
- ELSE
- LQ(L4STAX+5) = 0
- ENDIF
- LQ(L4STAX+6) = 8
- LQ(L4STAX+4) = MSBIT1 (LQ(L4STAX+4),32)
-
- IQ(KQSP+LBPARX-6)= 0
- IQ(KQSP+LBPARX-5)= 0
- IQ(KQSP+LBPARX-3)= 0
- IQ(KQSP+LBPARX-2)= 0
-
- NWCL = MAXREX - 10
- LQ(L4STAX+8) = NWCL
- LQ(L4STAX+9) = 5
- CALL VZERO (LQ(L4STAX+10),NWCL)
- CALL FZOPHR
- IF (IDX(2).GT.0) GO TO 23
- GO TO 991
-
-C-----------------------------------------------------------
-C------ IDX(2) = 0 : up-date buffer parameters
-C-- write the buffer if complete
-C-----------------------------------------------------------
-
-C- Note : L4CURX=L4ENDX+1 if a double-precision number spans
-C- two physical records, giving NWFREE = -1
-
- 41 N4DONX = L4CURX - L4STAX
- NWNEW = N4DONX - IQ(KQSP+LBPARX-2)
- N4RESX = IQ(KQSP+LBPARX-3) - NWNEW
- IQ(KQSP+LBPARX-3) = N4RESX
- IQ(KQSP+LBPARX-2) = N4DONX
-
- 42 NWFREE = L4ENDX - L4CURX
-#if defined(CERNLIB_QDEVZE)
- IF (LOGLVX.GE.3) WRITE (IQLOG,9743) N4RESX,N4DONX,NWFREE
- 9743 FORMAT (12X,'N4RESX,N4DONX,NWFREE=',3I7)
-#endif
- IF (NWFREE.LT.0) GO TO 55
- IF (N4RESX.NE.0) THEN
- IF (NWFREE.EQ.0) GO TO 55
- GO TO 999
- ENDIF
-
-C-- End of LR reached
-
- IF (N4DONX.EQ.0) GO TO 999
- ISTENX = IOR(ISTENX,2)
- IF (NWFREE.LT.4) GO TO 54
- IF (JFAST.NE.0) GO TO 54
- IF (JBIT(MSTATX,15).NE.0) GO TO 54
- GO TO 999
-
-C-----------------------------------------------------------
-C------ IDX(2) = -1 : flush the buffer
-C-----------------------------------------------------------
-
- 51 IF (IDX(2).LT.-1) GO TO 71
- IF (N4RESX.NE.0) GO TO 31
- IF (N4DONX.EQ.0) GO TO 991
- ISTENX = IOR(ISTENX,2)
- NWFREE = MAXREX - N4DONX
-
-C-- construct dummy LR to complete the buffer
- 54 IF (NWFREE.LE.0) GO TO 55
- IF (JFAST.EQ.0) THEN
- IF (LQ(L4STAX+6).EQ.0) LQ(L4STAX+6)=N4DONX
- ENDIF
-
- L4CURX = L4STAX + N4DONX
- LQ(L4CURX) = NWFREE - 1
- IF (NWFREE.LT.2) GO TO 55
- LQ(L4CURX+1) = 5
- NWFILX = NWFREE - 2
- IF (NWFILX.EQ.0) GO TO 55
-#if !defined(CERNLIB_FZMEMORY)
- CALL VZERO (LQ(L4CURX+2),NWFILX)
-#endif
-#if defined(CERNLIB_FZMEMORY)
- IF (IFIFOX.NE.3) CALL VZERO (LQ(L4CURX+2),NWFILX)
-#endif
-
-C-- Write the physical record
-
- 55 MWOVSV = LQ(L4ENDX)
- CALL FZOPHR
-
-C-- Ready buffer for next physical record
-
- ISTENX = 0
- IF (N4RESX.GT.0) GO TO 57
- IF (NWFREE.LT.0) GO TO 57
-C-- no pending data for current logical record
- IQ(KQSP+LBPARX-2) = 0
- L4CURX = L4STAX
- GO TO 991
-
-C-- current logical record continues
- 57 IF (IQ(KQSP+LBPARX-6).EQ.0) THEN
- LQ(L4STAX+4) = MAXREX
- IF (MEDIUX.LT.4) THEN
- LQ(L4STAX+5) = IQ(KQSP+LQFX+23)
- ELSE
- LQ(L4STAX+5) = 0
- ENDIF
- LQ(L4STAX+6) = 0
- N4DONX = 8
- ELSE
- N4DONX = 0
- ENDIF
- L4CURX = L4STAX + N4DONX
- IQ(KQSP+LBPARX-2) = N4DONX
- IF (NWFREE.GE.0) GO TO 991
-
-C-- double-precision number spannning the physical records
- LQ(L4CURX) = MWOVSV
- N4DONX = N4DONX + 1
- L4CURX = L4CURX + 1
- IQ(KQSP+LBPARX-2) = N4DONX
- IF (N4RESX.GT.0) GO TO 991
- GO TO 42
-
-C-----------------------------------------------------------
-C------ IDX(2) < -1 : ENDFILE
-C-----------------------------------------------------------
-
- 71 CALL FZOPHR
-
- 991 IDX(2) = 0
-
-#include "zebra/qtrace99.inc"
- RETURN
- END
diff --git a/src/packlib/zebra/fq/fzotab.F b/src/packlib/zebra/fq/fzotab.F
deleted file mode 100644
index cb67978..0000000
--- a/src/packlib/zebra/fq/fzotab.F
+++ /dev/null
@@ -1,365 +0,0 @@
-*
-* $Id: fzotab.F,v 1.3 1999/06/18 13:29:40 couet Exp $
-*
-* $Log: fzotab.F,v $
-* Revision 1.3 1999/06/18 13:29:40 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.2 1996/04/18 16:10:50 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:14 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE FZOTAB
-
-C- Construct table of material to be output,
-C- called from FZOUT, RZOUT, MZCOPY
-
-#include "zebra/zlimit.inc"
-#include "zebra/mqsys.inc"
-#include "zebra/eqlqf.inc"
-#include "zebra/mzcn.inc"
-#include "zebra/mzct.inc"
-#include "zebra/fzcx.inc"
-#include "zebra/fzcseg.inc"
-*
- EQUIVALENCE (LMT,LQMTB), (LS,IQLS), (LNX,IQNX)
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HFZOT, 4HAB /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HFZOTAB /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'FZOTAB ')
-#endif
-
-#include "zebra/q_jbit.inc"
-#include "zebra/q_jbyt.inc"
-#include "zebra/q_sbit0.inc"
-
-
-#include "zebra/qtrace.inc"
-
- 101 MQDVGA = 0
- MQDVWI = 0
- NWBKX = 0
- NQSEG = 0
-
- IF (MODTBX.NE.0) THEN
- NSTEP = 4
- ELSE
- NSTEP = 2
- ENDIF
-
- CALL MZCHLS (-7,LENTRX)
- IF (IQFOUL.NE.0) GO TO 911
- IF (JBIT(IQ(KQS+LENTRX),IQDROP).NE.0) GO TO 911
-
- IF (IOPTXD.NE.0) GO TO 301
- IF (IOPTXS.EQ.0) GO TO 201
-
-C---- Single bank output
-
- CALL MZTABM
- LQTE = LQTA + NSTEP
-
- LQ(LQTA) = IQLN
- LQ(LQTA+1) = IQNX
- NWBKX = IQNX - IQLN
-
- IOPTXL = 0
- IOPTXD = 0
- GO TO 361
-
-C-------------------------------------------------
-C- d/s defined by LENTRX
-C-------------------------------------------------
-
- 201 IF (IOPTXM.EQ.0) THEN
- IF (IOPTXL.EQ.0) THEN
- CALL MZMARK (IXDIVX,LENTRX,'.',0,0)
- ELSE
- CALL MZMARK (IXDIVX,LENTRX,'L',0,0)
- ENDIF
- ENDIF
-
- LIMLOW = LQLIML - IQ(KQS+LQLIML-3) - JBYT(IQ(KQS+LQLIML),19,4) - 1
- LIMHI = LQLIMH + IQ(KQS+LQLIMH-1) + 9
-
-C---- Memory occupation table
-
- CALL MZTABM
-
-C-- First division concerned
-
- 226 IF (LIMLOW.LT.LQ(LQMTA+4)) GO TO 227
- LQMTA = LQMTA + 8
- GO TO 226
-
-C-- Last division concerned
-
- 227 LMT = LQMTA
- LQ(LMT+3) = LIMLOW
- 228 IF (LIMHI.LE.LQ(LMT+4)) GO TO 229
- LMT = LMT + 8
- GO TO 228
-
- 229 LQ(LMT+4) = LIMHI
- LQMTE = LMT + 8
-
-C---- Relocation table
-
- LMT = LQMTA
-
-C-- Next division
-
- 232 IF (LQ(LMT+1).LT.0) GO TO 249
- NWDIV = 0
- JDIV = LQ(LMT)
- LNX = LQ(LMT+3)
- LQMTC2 = LQ(LMT+4)
- NEW = 0
-
-C-- Next bank
-
- 234 MODE = NEW
- 235 LN = LNX
- IF (LN.GE.LQMTC2) GO TO 247
-#if defined(CERNLIB_QDEBUG)
- CALL MZCHLN (-7,LN)
- IF (IQFOUL.NE.0) GO TO 912
-#endif
-#if !defined(CERNLIB_QDEBUG)
- NST = JBYT(LQ(KQS+LN),1,16) - 11
- IF (NST.GT.0) THEN
- LS = LN + NST
- LNX = LS + IQ(KQS+LS-1) + 9
- ELSE
- LS = LN - 8
- LNX = LN + NST + 11
- ENDIF
-#endif
- NEW = JBIT(IQ(KQS+LS),IQMARK)
- IF (NEW.EQ.1) IQ(KQS+LS)= MSBIT0 (IQ(KQS+LS),IQMARK)
- IF (NEW.EQ.MODE) GO TO 235
- IF (NEW.EQ.0) GO TO 244
-
-C-- Start of a live group
-
- LQ(LQTE) = LN
- IF (LQTE.LT.LQRTE) GO TO 234
- CALL MZTABH
- IF (IQPART.LE.0) GO TO 234
- GO TO 261
-
-C-- Start of a dead group
-
- 244 NWDIV = NWDIV + (LN - LQ(LQTE))
- LQ(LQTE+1) = LN
- LQTE = LQTE + NSTEP
- GO TO 234
-
-C-- End of division
-
- 247 IF (MODE.EQ.0) GO TO 248
- NWDIV = NWDIV + (LN - LQ(LQTE))
- LQ(LQTE+1) = LN
- LQTE = LQTE + NSTEP
-
-C-- Add to segment table
-
- 248 IF (NWDIV.EQ.0) GO TO 249
- NWBKX = NWBKX + NWDIV
- NQSEG = NQSEG + 1
- IQSEGH(1,NQSEG) = IQDN1(KQT+JDIV)
- IQSEGH(2,NQSEG) = IQDN2(KQT+JDIV)
- IQSEGD(NQSEG) = NWDIV
-
-C-- Step to next division
-
- 249 LMT = LMT + 8
- IF (LMT.LT.LQMTE) GO TO 232
- GO TO 361
-
-C------ Not enough space, garbage collection
-
- 261 IF (JFLGAX.NE.0) GO TO 264
- JFLGAX = 1
- LQSYSR(KQT+1) = LENTRX
- IXGARB = MZIXCO (IXDIVX,21,22,23)
- IXGARB = MZIXCO (IXGARB,24,0,0)
- CALL MZGARB (IXGARB,0)
- LENTRX = LQSYSR(KQT+1)
- GO TO 269
-
- 264 IF (JFLGAX.GE.2) GO TO 913
- JFLGAX = 2
- IF (JQSTOR.EQ.0) GO TO 913
- IXGARB = MZIXCO (21,22,23,24)
- CALL MZGARB (IXGARB,0)
- CALL MZSDIV (IXDIVX,0)
- 269 IF (MODTBX.EQ.0) GO TO 101
- IQUEST(1) = 1
- GO TO 101
-
-C-------------------------------------------------
-C- complete divisions
-C-------------------------------------------------
-
- 301 MQDVGA = MZDVAC (IXDIVX)
- CALL MZTABM
- IOPTXL = 1
-
- IF (IOPTXI.EQ.0) GO TO 321
-
-C---- Immediate dump of divisions
-
- 305 IF (LQ(LMT+1).NE.3) GO TO 307
- NWDIV = LQ(LMT+4) - LQ(LMT+3)
- NWBKX = NWBKX + NWDIV
- LQ(LQTE) = LQ(LMT+3)
- LQ(LQTE+1) = LQ(LMT+4)
- LQTE = LQTE + NSTEP
-
-C-- Add to segment table
-
- JDIV = LQ(LMT)
- NQSEG = NQSEG + 1
- IQSEGH(1,NQSEG) = IQDN1(KQT+JDIV)
- IQSEGH(2,NQSEG) = IQDN2(KQT+JDIV)
- IQSEGD(NQSEG) = NWDIV
- 307 LMT = LMT + 8
- IF (LMT.LT.LQMTE) GO TO 305
- GO TO 361
-
-C---- Filtered dump of divisions
-
- 321 CONTINUE
-
-C-- Next division
-
- 332 IF (LQ(LMT+1).NE.3) GO TO 349
- NWDIV = 0
- JDIV = LQ(LMT)
- LNX = LQ(LMT+3)
- LQMTC2 = LQ(LMT+4)
- NEW = 1
-
-C-- Next bank
-
- 334 MODE = NEW
- 335 LN = LNX
- IF (LN.GE.LQMTC2) GO TO 347
-#if defined(CERNLIB_QDEBUG)
- CALL MZCHLN (-7,LN)
- IF (IQFOUL.NE.0) GO TO 912
-#endif
-#if !defined(CERNLIB_QDEBUG)
- NST = JBYT(LQ(KQS+LN),1,16) - 11
- IF (NST.GT.0) THEN
- LS = LN + NST
- LNX = LS + IQ(KQS+LS-1) + 9
- ELSE
- LS = LN - 8
- LNX = LN + NST + 11
- ENDIF
-#endif
- NEW = JBIT(IQ(KQS+LS),IQDROP)
- IF (NEW.EQ.0) GO TO 336
- IF (MODE.NE.0) GO TO 335
- GO TO 344
-
-C-- Inspect structural links of live bank
-
- 336 K = LS - IQ(KQS+LS-2) - 1
- 337 K = K + 1
- IF (K.GT.LS) GO TO 340
- L = LQ(KQS+K)
- IF (L.EQ.0) GO TO 337
- IF (JBIT(IQ(KQS+L),IQDROP).EQ.0) GO TO 337
- KD = LQ(KQS+L+2)
- 338 L = LQ(KQS+L)
- IF (L.EQ.0) GO TO 339
- IF (JBIT(IQ(KQS+L),IQDROP).NE.0) GO TO 338
- LQ(KQS+K) = L
- IF (KD.NE.K) GO TO 337
- LQ(KQS+L+2) = K
- GO TO 337
-
- 339 LQ(KQS+K) = 0
- GO TO 337
-
- 340 IF (MODE.EQ.0) GO TO 335
-
-C-- Start of a live group
-
- LQ(LQTE) = LN
- IF (LQTE.LT.LQRTE) GO TO 334
- CALL MZTABH
- IF (IQPART.LE.0) GO TO 334
- GO TO 261
-
-C-- Start of a dead group
-
- 344 NWDIV = NWDIV + (LN - LQ(LQTE))
- LQ(LQTE+1) = LN
- LQTE = LQTE + NSTEP
- GO TO 334
-
-C-- End of division
-
- 347 IF (MODE.NE.0) GO TO 348
- NWDIV = NWDIV + (LN - LQ(LQTE))
- LQ(LQTE+1) = LN
- LQTE = LQTE + NSTEP
-
-C-- Add to segment table
-
- 348 IF (NWDIV.EQ.0) GO TO 349
- NWBKX = NWBKX + NWDIV
- NQSEG = NQSEG + 1
- IQSEGH(1,NQSEG) = IQDN1(KQT+JDIV)
- IQSEGH(2,NQSEG) = IQDN2(KQT+JDIV)
- IQSEGD(NQSEG) = NWDIV
-
-C-- Step to next division
-
- 349 LMT = LMT + 8
- IF (LMT.LT.LQMTE) GO TO 332
-
- 361 IQUEST(1) = 0
- NWTABX = LQTE - LQTA
- IF (NQSEG.EQ.1) NQSEG=0
- NWSEGX = 3*NQSEG
- GO TO 999
-
-C-------------------------------------------------
-C- ERROR HANDLING
-C-------------------------------------------------
-
- 911 IQUEST(2) = 11
- IQUEST(11) = LENTRX
- GO TO 971
-
- 912 IQUEST(2) = 12
- IQUEST(11) = JQSTOR
- IQUEST(12) = JDIV
- GO TO 971
-
- 913 IQUEST(2) = 13
-
- 971 IF (MODTBX.EQ.0) THEN
- IF (IOPTXP.EQ.0) CALL ZTELL (IQUEST(2),1)
- ENDIF
- IQUEST(1) = -2
-
-#include "zebra/qtrace99.inc"
- RETURN
- END
diff --git a/src/packlib/zebra/fq/fzotrn.F b/src/packlib/zebra/fq/fzotrn.F
deleted file mode 100644
index 1a62fa6..0000000
--- a/src/packlib/zebra/fq/fzotrn.F
+++ /dev/null
@@ -1,64 +0,0 @@
-*
-* $Id: fzotrn.F,v 1.2 1999/06/18 13:29:41 couet Exp $
-*
-* $Log: fzotrn.F,v $
-* Revision 1.2 1999/06/18 13:29:41 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:14 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE FZOTRN (MBAT,NWBAT)
-
-C- Transmit one batch of data to the output buffer,
-C- exchange file format, native data format
-C- service routine to FZOUT
-C- careful : must not be called with NWBAT=0
-
-#include "zebra/zunit.inc"
-#include "zebra/zebq.inc"
-#include "zebra/mzca.inc"
-#include "zebra/fzcx.inc"
-*
- DIMENSION MBAT(99), NWBAT(9)
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HFZOT, 4HRN /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HFZOTRN /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'FZOTRN ')
-#endif
-
-
-* quick trace without test on capacity
-#include "zebra/qtraceq.inc"
-
- NWDO = NWBAT(1)
- NDONE = 0
- IF (IDX(2).NE.0) GO TO 44
-
- 24 NWAV = L4ENDX - L4CURX
- NW = MIN (NWDO-NDONE, NWAV)
- CALL UCOPY (MBAT(NDONE+1), LQ(L4CURX), NW)
- L4CURX = L4CURX + NW
- IF (L4CURX.EQ.L4ENDX) GO TO 41
-#include "zebra/qtrace99.inc"
- RETURN
-
-C-- Batch continued
-
- 41 NDONE = NDONE + NW
-
-C-- Start new logical record
-
- 44 CALL FZOREC
- IF (NDONE.LT.NWDO) GO TO 24
- GO TO 999
- END
diff --git a/src/packlib/zebra/fq/fzotrx.F b/src/packlib/zebra/fq/fzotrx.F
deleted file mode 100644
index 7bde0c0..0000000
--- a/src/packlib/zebra/fq/fzotrx.F
+++ /dev/null
@@ -1,89 +0,0 @@
-*
-* $Id: fzotrx.F,v 1.2 1999/06/18 13:29:42 couet Exp $
-*
-* $Log: fzotrx.F,v $
-* Revision 1.2 1999/06/18 13:29:42 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:14 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
-#if !defined(CERNLIB_FQXISN)
- SUBROUTINE FZOTRX (MBAT,NWBAT)
-
-C- Transmit one batch of data to the output buffer,
-C- exchange file format, exchange data format
-C- service routine to FZOUT
-C- careful : must not be called with NWBAT=0
-
-#include "zebra/zunit.inc"
-#include "zebra/mqsys.inc"
-#include "zebra/eqlqf.inc"
-#include "zebra/mzioc.inc"
-#include "zebra/fzcx.inc"
-*
- DIMENSION MBAT(99), NWBAT(9)
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HFZOT, 4HRX /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HFZOTRX /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'FZOTRX ')
-#endif
-
-
-* quick trace without test on capacity
-#include "zebra/qtraceq.inc"
-
- NWFOTT = NWBAT(1)
- NWFORE = NWFOTT
- NWFODN = 0
- IF (IDX(2).NE.0) GO TO 44
-
- 24 CALL FZOCV (MBAT,LQ(L4CURX))
- L4CURX = L4CURX + IQUEST(1)
-
- 27 IF (NWFOAV.LE.0) GO TO 41
- 991 IF (IFOCON(1).NE.0) GO TO 71
-#include "zebra/qtrace99.inc"
- RETURN
-
-C-- Batch continued
-
- 41 CONTINUE
-
-C-- Start new logical record
-
- 44 CALL FZOREC
- NWFOAV = L4ENDX - L4CURX
- IF (NWFORE.NE.0) GO TO 24
- GO TO 991
-
-C------ Conversion Problems
-
- 71 IQ(KQSP+LQFX+24) = IQ(KQSP+LQFX+24) + 1
- IF (IFOCON(1).GT.0) IFOCON(2) = IFOCON(2)
- + + (LOCF(MBAT(1)) - LQSTOR)
-#if defined(CERNLIB_QPRINT)
- IF (LOGLVX.GE.1) WRITE (IQLOG,9071) LUNX,IFOCON
- 9071 FORMAT (1X/' FZOTRX. LUN=',I4,', Conversion problem: ',
-#endif
-#if (defined(CERNLIB_QPRINT))&&(!defined(CERNLIB_HEX))&&(defined(CERNLIB_B60M))
- F 4O23)
-#endif
-#if (defined(CERNLIB_QPRINT))&&(!defined(CERNLIB_HEX))&&(!defined(CERNLIB_B60M))
- F 4O17)
-#endif
-#if (defined(CERNLIB_QPRINT))&&(defined(CERNLIB_HEX))
- F 4Z17)
-#endif
- GO TO 999
- END
-#endif
diff --git a/src/packlib/zebra/fq/fzotxt.F b/src/packlib/zebra/fq/fzotxt.F
deleted file mode 100644
index 0905fab..0000000
--- a/src/packlib/zebra/fq/fzotxt.F
+++ /dev/null
@@ -1,43 +0,0 @@
-*
-* $Id: fzotxt.F,v 1.2 1999/06/18 13:29:43 couet Exp $
-*
-* $Log: fzotxt.F,v $
-* Revision 1.2 1999/06/18 13:29:43 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:13 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE FZOTXT
-
-C- Ready the text vector for output
-
-#include "zebra/zebq.inc"
-#include "zebra/mzca.inc"
-#include "zebra/fzcx.inc"
-*
- EQUIVALENCE (LTX,LTEXTX)
-
-
- IF (LTX.EQ.0) GO TO 49
- ND = IQ(KQSP+LTX+1)
- IF (ND.LT.2) GO TO 49
- NWTXX = ND
- IF (IFIFOX.NE.0) GO TO 49
- IF (NWTXX.LE.MAXREX) GO TO 49
-
-C-- Text vector too large, truncate
-
- NWTXX = 0
- L = LTX + 5
- 24 N = IQ(KQSP+L)
- IF (NWTXX+N+1.GT.MAXREX) GO TO 49
- NWTXX = NWTXX + N + 1
- L = L + N + 1
- GO TO 24
-
- 49 RETURN
- END
diff --git a/src/packlib/zebra/fq/fzout.F b/src/packlib/zebra/fq/fzout.F
deleted file mode 100644
index a161f89..0000000
--- a/src/packlib/zebra/fq/fzout.F
+++ /dev/null
@@ -1,437 +0,0 @@
-*
-* $Id: fzout.F,v 1.3 1999/06/18 13:29:43 couet Exp $
-*
-* $Log: fzout.F,v $
-* Revision 1.3 1999/06/18 13:29:43 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.2 1996/04/18 16:10:51 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:13 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE FZOUT (LUNP,IXDIVP,LENTP,IEVP,CHOPT,NIOP,NUHP,IUHEAD)
-
-C- MAIN SEQUENTIAL OUTPUT ROUTINE, USER CALLED
-
-#include "zebra/zstate.inc"
-#include "zebra/zunit.inc"
-#include "zebra/zvfaut.inc"
-#include "zebra/mqsys.inc"
-#include "zebra/eqlqf.inc"
-#include "zebra/mzct.inc"
-#include "zebra/fzcx.inc"
-*
- DIMENSION LUNP(9),IXDIVP(9),LENTP(9),IEVP(9)
- DIMENSION NIOP(9),NUHP(9),IUHEAD(99)
- CHARACTER CHOPT*(*)
- DIMENSION IUHDAT(3)
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HFZOU, 4HT /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HFZOUT /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'FZOUT ')
-#endif
-
-#include "zebra/q_jbit.inc"
-#include "zebra/q_jbyt.inc"
-
-#include "zebra/qtrace.inc"
-
- LUNNX = LUNP(1)
- IXDIVX = IXDIVP(1)
- LENTRX = LENTP(1)
- IEVFLX = IEVP(1)
- IOCHX(1)= NIOP(1)
- NWUHOR = MAX (NUHP(1),0)
- NWUHX = MIN (NWUHOR,400)
- NWFILX = 0
- NWMEMT = 0
- ICOPYX = 0
-
-C-- Set current output unit
-
- IF (LUNNX.NE.LUNX) CALL FZLOC (LUNNX,2)
-#if defined(CERNLIB_QDEBPRI)
- IF (LOGLVX.GE.3)
- + WRITE (IQLOG,9111) LUNNX,LENTRX,IEVFLX,IACTVX,CHOPT
- 9111 FORMAT (1X/' FZOUT- Enter for LUN=',I3,
- F' LENTRY,IEVFL,IACTV,OPT=',I8,2I3,1X,A)
-
-#endif
-#if defined(CERNLIB_QDEBUG)
- IF (IQVSTA.NE.0) CALL ZVAUTX
-#endif
-#if defined(CERNLIB_QPRINT)
- IF (NWUHOR.GT.NWUHX) THEN
- IF (LOGLVX.GE.-2) WRITE (IQLOG,9112) LUNX,NWUHOR
- ENDIF
- 9112 FORMAT (1X/' FZOUT. LUN=',I4,' Of ',I4,' user header words',
- F' only 400 are taken !!!')
-#endif
-#if defined(CERNLIB_FZCHANNEL)
- IF (IACMOX.EQ.3) THEN
- IF (IADOPX.EQ.0) GO TO 907
- ENDIF
-
-#endif
-#if defined(CERNLIB_FZMEMORY)
- IF (IFIFOX.EQ.3) THEN
- IADOPX = IQ(KQSP+LQFX+8)
- IF (IADOPX.EQ.0) GO TO 907
- IQ(KQSP+LQFX+1) = IADOPX
- ENDIF
-
-#endif
-C- from FZRUN to 401
- IF (IEVFLX.LT.0) GO TO 401
-C- from FZENDO to 411
- IF (IEVFLX.GE.2) GO TO 411
- IF (IACTVX.GE.16) GO TO 901
-
- 21 NWTXX = 0
- NWSEGX = 0
- NWTABX = 0
- NWBKX = 0
- NWUHCX = 0
- NWIOX = 0
-
-C-- Ready I/O characteristic
-
- IF (NWUHX.EQ.0) GO TO 39
-
- IF (IOCHX(1)) 34, 32, 33
- 32 IOCHX(1) = 3
- 33 NWIOX = 1
- IF (IOCHX(1).LT.8) GO TO 38
- 34 NWIOX = JBYT (IOCHX(1), 7,5)
- J = JBYT (IOCHX(1),12,5)
- IF (JBYT (IOCHX(1), 1,6).NE.1) GO TO 903
- IF (NWIOX.GT.16) GO TO 903
- IF (NWIOX.NE.J+1) GO TO 903
-
- IF (NWIOX.GT.1) CALL UCOPY (NIOP,IOCHX,NWIOX)
- 38 NWUHCX = NWUHX + NWIOX
- 39 CONTINUE
-
-C---- Ready text vector
-
- LTEXTX = LQ(KQSP+LQFX-2)
- IF (LTEXTX.NE.0) CALL FZOTXT
-
-C---- Construct table of material to be written
-
- CALL UOPTC (CHOPT,'DISZMLNP',IOPTXD)
- IOPTXN = IOPTXN + IOPTXS + IOPTXZ
-
- IF (IOPTXZ.NE.0) GO TO 121
-
- CALL MZSDIV (IXDIVX,0)
- JQSTMV = -1
- MODTBX = 0
- JFLGAX = 0
- CALL FZOTAB
- IF (IQUEST(1).NE.0) GO TO 999
- IF (IOPTXN.NE.0) NWTABX=0
-
-C------ Output of pilot records
-
- 121 IDX(2) = 3
- IF (IEVFLX.NE.0) IDX(2)=2
- NWMEMT = 20 + NWUHCX + NWSEGX + NWTXX + NWTABX + NWBKX
-
-#if defined(CERNLIB_QDEBPRI)
- IF (LOGLVX.EQ.2)
- +WRITE (IQLOG,9121) LUNX,JQSTOR,LENTRX,NWTABX,NWBKX,IEVFLX,CHOPT
- 9121 FORMAT (' FZOUT- LUN=',I4,' Store/LENTRY=',I3,I9,
- F' NWTAB,NWBANK=',I5,I7,' Evfl/Opt=',I3,1X,A)
-
-#endif
-#if defined(CERNLIB_FZFFNAT)
- IF (IFIFOX.EQ.0) THEN
- CALL FZOFFN (IUHEAD)
- GO TO 124
- ENDIF
-#endif
-#if defined(CERNLIB_FZMEMORY)
- IF (IFIFOX.EQ.3) THEN
- IF (NWMEMT.GT.IQ(KQSP+LQFX+9)) GO TO 909
- ENDIF
-#endif
- CALL FZOFFX (IUHEAD)
- 124 IQ(KQSP+LQFX+15) = IQ(KQSP+LQFX+15) + 1
-
- IACTVX = 12
- IF (NWBKX.EQ.0) GO TO 190
-
-C------ Write out material according to table
-
-#if defined(CERNLIB_QDEBPRI)
- IF (LOGLVX.GE.3) WRITE (IQLOG,9140) NWTABX,NWBKX
- 9140 FORMAT (10X,'NWTAB/NWBK =',2I9)
-#endif
- IQ(KQSP+LQFX+16) = IQ(KQSP+LQFX+16) + 1
-
- IDX(2) = 0
-#if defined(CERNLIB_FZFFNAT)
- IF (IFIFOX.EQ.0) THEN
- CALL FZOFFN (0)
- GO TO 191
- ENDIF
-#endif
- CALL FZOFFX (0)
- GO TO 191
-
-C---- Test for pseudo end-of-tape
-
- 190 IQ(KQSP+LQFX+17) = IQ(KQSP+LQFX+17) + 1
- 191 NUM1 = IQ(KQSP+LQFX+19)
- NUM2 = IQ(KQSP+LQFX+20)
- 192 IF (NUM2.GE.1000000) THEN
- NUM1 = NUM1 + 1
- NUM2 = NUM2 - 1000000
- IQ(KQSP+LQFX+19) = NUM1
- IQ(KQSP+LQFX+20) = NUM2
- GO TO 192
- ENDIF
-
- LIM1 = IQ(KQSP+LQFX+37)
- LIM2 = IQ(KQSP+LQFX+38)
-
- IF (LIM1+LIM2.EQ.0) GO TO 991
- IF (NUM1-LIM1) 991, 196, 197
- 196 IF (NUM2.LT.LIM2) GO TO 991
-
- 197 IQUEST(1) = 1
- GO TO 992
-
-C-------------------------------------------------
-C- Write start-of-run
-C- Write end-of-run, end-of-file
-C-------------------------------------------------
-
-C- from FZRUN to 401
- 401 JRUN = LENTRX
- JRUNCR = IQ(KQSP+LQFX+29)
- IF (JRUN.LT.0) GO TO 410
- IF (IACTVX.LT.11) GO TO 406
- IF (IACTVX.GE.14) GO TO 406
- JTRA = 1
- NWUHU = 0
-C- precede start-of-run by end-of-run
- GO TO 422
-
-C-- Write start-of-run
-
- 406 IACTVX = 11
- JRUNX = 1
- JRUN = LENTRX
- IF (JRUN.EQ.0) JRUN=JRUNCR+1
- IQ(KQSP+LQFX+29) = JRUN
- IQ(KQSP+LQFX+14) = IQ(KQSP+LQFX+14) + 1
-#if defined(CERNLIB_QPRINT)
- IF (LOGLVX.GE.0) WRITE (IQLOG,9406) LUNX,JRUN
- 9406 FORMAT (1X/' FZOUT. LUN=',I4,' Write Start-of-Run ',I6)
-#endif
- JTRA = 2
- NWUHU = NWUHX
- GO TO 424
-
-C- IACTV : last action IEVFL : action requested
-C-
-C- 11 StoR written
-C- 12 d/s written
-C- 13 buffer flushed 13 flush buffer
-C- 14 EOR written 14 write EOR
-C- 15 first EOF written 15 write EoF
-C- 16 second EOF written 16 write EoD
-C- 17 attempted write after eod
-
- 410 IEVFLX = 14
-C- from FZENDO to 411
- 411 IF (IEVFLX.LT.13) GO TO 902
- IF (IEVFLX.GE.17) GO TO 902
- IF (IACTVX.LT.11) GO TO 991
- IF (IEVFLX.LE.IACTVX) GO TO 991
-
- IF (IEVFLX.GE.14) GO TO 421
- IACTVX = 13
- JTRA = 3
- GO TO 441
-
-C---- Write end-of-run
-
- 421 IF (IACTVX.GE.14) GO TO 461
- JRUNCR = IQ(KQSP+LQFX+29)
- JTRA = 4
- NWUHU = NWUHX
-
- 422 IQ(KQSP+LQFX+13) = IQ(KQSP+LQFX+13) + 1
-#if defined(CERNLIB_QPRINT)
- IF (LOGLVX.GE.0) WRITE (IQLOG,9421) LUNX,JRUNCR
- 9421 FORMAT (' FZOUT. LUN=',I4,' Write End-of-Run ',I8)
-#endif
-C-- flush the buffer before EoR
- IF (IACTVX.LT.13) THEN
- IF (IFIFOX.NE.0) THEN
- IDX(2) = -1
- CALL FZOFFX (IUHEAD)
- ENDIF
- ENDIF
- IACTVX = 14
- JRUNX = 0
- JRUN = 0
-
-C-- Write StoR/EoR record
-
- 424 IDX(1) = 1 + NWUHU
- IDX(2) = 1
- IQUEST(11) = JRUN
-#if defined(CERNLIB_FZFFNAT)
- IF (IFIFOX.EQ.0) THEN
- CALL FZOFFN (IUHEAD)
- GO TO 426
- ENDIF
-#endif
- CALL FZOFFX (IUHEAD)
- 426 CONTINUE
-
- IF (JBIT(MSTATX,15).NE.0) GO TO 441
- IF (JTRA.EQ.2) GO TO 991
-
-C-- Flush the buffer after operation
-
- 441 IF (IFIFOX.NE.0) THEN
- IDX(2) = -1
- CALL FZOFFX (0)
- ENDIF
-
- GO TO ( 406, 991, 991, 461, 471), JTRA
-
-C---- Write end-of-file / end-of-data
-
- 461 IF (IEVFLX.LT.15) GO TO 991
- IF (IACTVX.EQ.15) GO TO 471
- NWUHU = 0
- JTRA = 5
- IQ(KQSP+LQFX+12) = IQ(KQSP+LQFX+12) + 1
-#if defined(CERNLIB_QPRINT)
- IF (LOGLVX.GE.0) WRITE (IQLOG,9464) LUNX
- 9464 FORMAT (' FZOUT. LUN=',I4,' Write Zebra EoF')
-#endif
-
- JRUNX = 0
- IDX(1) = 4
- IDX(2) = 1
- IUHDAT(1) = IQ(KQSP+LQFX+34)
- IUHDAT(2) = IQ(KQSP+LQFX+35)
- IUHDAT(3) = IQ(KQSP+LQFX+33) + 1
- IQUEST(11) = -1
-#if defined(CERNLIB_FZFFNAT)
- IF (IFIFOX.EQ.0) THEN
- CALL FZOFFN (IUHDAT)
- GO TO 426
- ENDIF
-#endif
- CALL FZOFFX (IUHDAT)
- GO TO 426
-
-C-- Write true EOF
-
- 471 NEOF = JBYT (MSTATX,13,2)
- IF (IEVFLX.EQ.15) THEN
- NEOFU = MOD (NEOF,2)
- ELSE
- NEOFU = MAX (0,NEOF-1)
- ENDIF
- IF (NEOFU.EQ.0) GO TO 474
-
- IQUEST(11) = NEOFU
- IQUEST(12) = NEOF
- IDX(2) = 13 - IEVFLX
-#if defined(CERNLIB_FZFFNAT)
- IF (IFIFOX.EQ.0) THEN
- CALL FZOFFN (0)
- GO TO 473
- ENDIF
-#endif
- CALL FZOFFX (0)
- 473 IQ(KQSP+LQFX+11) = IQ(KQSP+LQFX+11) + IQUEST(11)
-
- 474 IACTVX = IEVFLX
-#if defined(CERNLIB_QPRINT)
- IF (LOGLVX.GE.0) THEN
- IF (IEVFLX.NE.16) THEN
- WRITE (IQLOG,9474) LUNX
- ELSE
- WRITE (IQLOG,9475) LUNX
- ENDIF
- ENDIF
- 9474 FORMAT (' FZOUT. LUN=',I4,' End-of-File')
- 9475 FORMAT (' FZOUT. LUN=',I4,' End-of-Data')
-#endif
- GO TO 991
-
-C-------------------------------------------------
-C- ERROR HANDLING
-C-------------------------------------------------
-
- 901 IF (IACTVX.EQ.18) GO TO 21
- IF (IACTVX.EQ.17) CALL ZFATAM ('FZOUT - Going beyond EoD.')
- IACTVX = 17
- IQUEST(1) = -1
- GO TO 992
-
- 902 IQUEST(11) = IEVFLX
- CALL ZFATAM ('FZOUT - Faulty parameter IEVENT.')
-
- 903 IQUEST(11) = IOCHX(1)
- CALL ZFATAM ('FZOUT - IOCH invalid.')
-
-#if defined(CERNLIB_FZCHANNEL)||defined(CERNLIB_FZMEMORY)
- 907 IQUEST(1) = -2
- IQUEST(11) = LUNX
- IF (IEVFLX.GE.2) GO TO 992
- CALL ZFATAM ('FZOUT - User routine / buffer not connected.')
-#endif
-#if defined(CERNLIB_FZMEMORY)
- 909 IQUEST(1) = -2
- IQUEST(2) = 14
- IQUEST(8) = IQ(KQSP+LQFX+9)
- IQUEST(9) = NWMEMT
- IF (IOPTXP.EQ.0) CALL ZTELL (14,1)
- GO TO 999
-#endif
-C-------------------------------------------------
-C- COMMON EXIT
-C-------------------------------------------------
-
- 991 IQUEST(1) = 0
- 992 IQUEST(2) = 0
- IQUEST(5) = IQ(KQSP+LQFX+31)
- IQUEST(6) = IQ(KQSP+LQFX+32)
- IQ(KQSP+LQFX+2) = IACTVX
-#if defined(CERNLIB_FZMEMORY)
- IF (IFIFOX.EQ.3)
- +IQUEST(9) = IQ(KQSP+LQFX+1) - IQ(KQSP+LQFX+8)
-#endif
- IQUEST(10) = NWMEMT
- IQUEST(11) = NWBKX
- IQUEST(12) = NWTABX
- IQUEST(13) = IQ(KQSP+LQFX+15)
- IQUEST(14) = IQ(KQSP+LQFX+19)
- IQUEST(15) = IQ(KQSP+LQFX+20)
- IQUEST(16) = IQ(KQSP+LQFX+21)
- IQUEST(17) = IQ(KQSP+LQFX+22)
-#include "zebra/qtrace99.inc"
- RETURN
- END
diff --git a/src/packlib/zebra/fq/fzrewex.inc b/src/packlib/zebra/fq/fzrewex.inc
deleted file mode 100644
index 191afc5..0000000
--- a/src/packlib/zebra/fq/fzrewex.inc
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: fzrewex.inc,v 1.1.1.1 1996/03/06 10:47:10 mclareni Exp $
-*
-* $Log: fzrewex.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:10 mclareni
-* Zebra
-*
-*
-*
-* fzrewex.inc
-*
-#if (defined(CERNLIB_QMIBM))&&(defined(CERNLIB_IOPACK))
- IF (IACMOF.EQ.0) GO TO 28
- CALL IORWND (LUNF,ISW)
- GO TO 29
-#endif
-*
-* fzrewex.inc
-*
-#if defined(CERNLIB_QMND3)
- IF (IACMOF.EQ.0) GO TO 28
- NIL = 0
- CALL MAGTP (13B,NIL,LUNF,NIL,NIL)
- GO TO 29
-#endif
diff --git a/src/packlib/zebra/fq/fzrun.F b/src/packlib/zebra/fq/fzrun.F
deleted file mode 100644
index 000e670..0000000
--- a/src/packlib/zebra/fq/fzrun.F
+++ /dev/null
@@ -1,46 +0,0 @@
-*
-* $Id: fzrun.F,v 1.2 1999/06/18 13:29:44 couet Exp $
-*
-* $Log: fzrun.F,v $
-* Revision 1.2 1999/06/18 13:29:44 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:13 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE FZRUN (LUNPAR,JRUNP,NUHP,IUHEAD)
-
-C- Write start/end of run
-C- JRUN > 0 start this run
-C- = 0 bump current run number by 1
-C- < 0 end of run
-
-#include "zebra/mqsysh.inc"
-*
- DIMENSION LUNPAR(9), JRUNP(9), NUHP(9), IUHEAD(9)
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HFZRU, 4HN /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HFZRUN /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'FZRUN ')
-#endif
-
-
-* quick trace without test on capacity
-#include "zebra/qtraceq.inc"
-
- JRUN = JRUNP(1)
-
- CALL FZOUT (LUNPAR,0,JRUN,-1,'FZRUN',1,NUHP,IUHEAD)
-
-#include "zebra/qtrace99.inc"
- RETURN
- END
diff --git a/src/packlib/zebra/fq/fzstamp.inc b/src/packlib/zebra/fq/fzstamp.inc
deleted file mode 100644
index 4494127..0000000
--- a/src/packlib/zebra/fq/fzstamp.inc
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: fzstamp.inc,v 1.1.1.1 1996/03/06 10:47:11 mclareni Exp $
-*
-* $Log: fzstamp.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:11 mclareni
-* Zebra
-*
-*
-*
-* fzstamp.inc
-*
-#if defined(CERNLIB_B36M)
- PARAMETER (MCCW1= 19123695, MCCW3= 1126280141)
- PARAMETER (MCCW2= 2154856560, MCCW4= 2153873505)
-#endif
- PARAMETER (MCCW1= 19123695, MCCW3= 1126280141)
- PARAMETER (MCCW2= -2140110736, MCCW4= -2141093791)
diff --git a/src/packlib/zebra/fq/fzstamph.inc b/src/packlib/zebra/fq/fzstamph.inc
deleted file mode 100644
index bdd12a9..0000000
--- a/src/packlib/zebra/fq/fzstamph.inc
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: fzstamph.inc,v 1.1.1.1 1996/03/06 10:47:12 mclareni Exp $
-*
-* $Log: fzstamph.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:12 mclareni
-* Zebra
-*
-*
-*
-* fzstamph.inc
-*
-#if defined(CERNLIB_B32)
- PARAMETER (MCCW1L= 291, MCCW1R= 52719)
- PARAMETER (MCCW2L= 32880, MCCW2R= 32880)
- PARAMETER (MCCW3L= 17185, MCCW3R= 43981)
- PARAMETER (MCCW4L= 32865, MCCW4R= 32865)
-* -------- Default conversions for output ---------------
-#endif
diff --git a/src/packlib/zebra/fq/fzudat.F b/src/packlib/zebra/fq/fzudat.F
deleted file mode 100644
index 0643318..0000000
--- a/src/packlib/zebra/fq/fzudat.F
+++ /dev/null
@@ -1,152 +0,0 @@
-*
-* $Id: fzudat.F,v 1.2 1999/06/18 13:29:44 couet Exp $
-*
-* $Log: fzudat.F,v $
-* Revision 1.2 1999/06/18 13:29:44 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:12 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
-#if defined(CERNLIB_FZDACC)
- SUBROUTINE FZUDAT (LUNP,IFROM)
-
-C- Update the forward reference DAT record
-
-#include "zebra/zunit.inc"
-#include "zebra/mqsys.inc"
-#include "zebra/eqlqf.inc"
-#include "zebra/fzcx.inc"
-#include "fzhci.inc"
-*
- DIMENSION LUNP(9)
-
-* Declaratives, DIMENSION etc.
-#include "fzudatd1.inc"
-* Ignoring t=pass
-
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HFZUD, 4HAT /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HFZUDAT /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'FZUDAT ')
-#endif
-
-* Declaratives, DATA
-#include "fzudatd2.inc"
-* Ignoring t=pass
-
-
-#include "zebra/qtrace.inc"
-
- LUNNX = LUNP(1)
- CALL FZLOC (LUNNX,2)
-
- IF (IFIFOX.NE.2) GO TO 999
- IF (IACMOX.GE.3) GO TO 999
-#if defined(CERNLIB_QDEBPRI)
- IF (LOGLVX.GE.2) WRITE (IQLOG,9002) LUNX
- 9002 FORMAT (' FZUDAT- called for LUN=',I4)
-#endif
-
- LBPARX = LQFX + INCBPX
- NWMIN = IQ(KQSP+LBPARX+1)
- INCBUF = IQ(KQSP+LBPARX+2)
- L4STOX = KQSP+8 + LBPARX + INCBUF
-
-C-- read the first record of the file
- LIN = L4STOX
-#if defined(CERNLIB_FQNEEDPK)
- IF (IUPAKX.EQ.0) LIN = LIN + IQ(KQSP+LBPARX+3)
-
-#endif
-#if defined(CERNLIB_FZLIBC)
- IF (IACMOX.EQ.2) THEN
- CALL CFTELL (IADOPX, MEDIUX, NWMIN, IPOSCR, ISW)
- IF (ISW.NE.0) GO TO 999
- CALL CFREW (IADOPX, MEDIUX)
- NWR = NWMIN
- CALL CFGET (IADOPX, MEDIUX, NWMIN, NWR, LQ(LIN), ISW)
- CALL CFSEEK (IADOPX, MEDIUX, NWMIN, IPOSCR, ISTAT)
- GO TO 37
- ENDIF
-
-#endif
-#if defined(CERNLIB_FZFORTRAN)
-#if defined(CERNLIB_QMIBMD)||defined(CERNLIB_QMIRTD)
- CALL ADREDKD (LUNX, LQ(LIN),NWMIN,1,ISW)
-#else
- READ (LUNX,REC=1,IOSTAT=ISW) (LQ(LIN+J-1),J=1,NWMIN)
-#endif
-#endif
- 37 IF (ISW.NE.0) GO TO 999
-
-#if defined(CERNLIB_FQNEEDCV)
- IF (IUPAKX.NE.0) GO TO 41
-#endif
-#if defined(CERNLIB_FQNEEDCV)
-#include "fzudat31.inc"
-#endif
-
-C-- check the very first logical record is DAT
- 41 CALL FZICHH (1, LQ(L4STOX),-1)
- IF (IQUEST(1).NE.0) GO TO 999
- IF (NTLRI.NE.8) GO TO 999
- L = L4STOX + 9
- IF (LQ(L).NE.2) GO TO 999
- IF (LQ(L+3).NE.2) GO TO 999
-
-C-- insert the forward reference
- LQ(L+12) = IQ(KQSP+LQFX+34)
- LQ(L+13) = IQ(KQSP+LQFX+35)
-
-C-- over-write the updated record
- LWR = L4STOX
-#if defined(CERNLIB_FQNEEDCV)
- IF (IUPAKX.NE.0) GO TO 47
-#endif
-#if defined(CERNLIB_FQNEEDCV)
-#include "fzudat44.inc"
-#endif
-#if defined(CERNLIB_FQNEEDCV)
- 47 CONTINUE
-
-#endif
-#if defined(CERNLIB_FZLIBC)
- IF (IACMOX.EQ.2) THEN
- CALL CFREW (IADOPX, MEDIUX)
- CALL CFPUT (IADOPX, MEDIUX, NWMIN, LQ(LWR), ISW)
- CALL CFSEEK (IADOPX, MEDIUX, NWMIN, IPOSCR, ISTAT)
- GO TO 87
- ENDIF
-
-#endif
-#if defined(CERNLIB_FZFORTRAN)
-#if defined(CERNLIB_QMIBMD)||defined(CERNLIB_QMIRTD)
- CALL ADWRTKD (LUNX, LQ(LWR),NWMIN,1,ISW)
- WRITE (LUNX,REC=1,IOSTAT=ISW) (LQ(LWR+J-1),J=1,NWMIN)
-#endif
-#endif
- 87 IF (ISW.NE.0) GO TO 999
-#if defined(CERNLIB_QDEBPRI)
- IF (IFROM.EQ.0) THEN
- IF (LOGLVX.GE.2) WRITE (IQLOG,9087) LUNX
- ELSE
- IF (LOGLVX.GE.-1) WRITE (IQLOG,9088) LUNX
- ENDIF
- 9087 FORMAT (' FZODAT. LUN=',I4,' DAT forward ref. record updated')
- 9088 FORMAT (' FZIDAT. LUN=',I4,' DAT forward ref. record updated')
-#endif
-
-#include "zebra/qtrace99.inc"
- RETURN
- END
-#endif
diff --git a/src/packlib/zebra/fq/fzudat29.inc b/src/packlib/zebra/fq/fzudat29.inc
deleted file mode 100644
index 30707e4..0000000
--- a/src/packlib/zebra/fq/fzudat29.inc
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: fzudat29.inc,v 1.1.1.1 1996/03/06 10:47:10 mclareni Exp $
-*
-* $Log: fzudat29.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:10 mclareni
-* Zebra
-*
-*
-*
-* fzudat29.inc
-*
-#if defined(CERNLIB_QMIBMD)
- CALL ADREDKD (LUNX, LQ(LIN),NWMIN,1,ISW)
-#endif
-*
-* fzudat29.inc
-*
-#if defined(CERNLIB_QMIRTD)
- CALL ADREDKD (LUNX, LQ(LIN),NWMIN,1,ISW)
-#endif
diff --git a/src/packlib/zebra/fq/fzudat31.inc b/src/packlib/zebra/fq/fzudat31.inc
deleted file mode 100644
index ae52449..0000000
--- a/src/packlib/zebra/fq/fzudat31.inc
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: fzudat31.inc,v 1.1.1.1 1996/03/06 10:47:08 mclareni Exp $
-*
-* $Log: fzudat31.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:08 mclareni
-* Zebra
-*
-*
-* unpack 32-bit words to 60-bit
-*
-* fzudat31.inc
-*
-#if defined(CERNLIB_QMCDC)
- CALL UPKCH (LQ(LIN),LQ(L4STOX),MAXREX,IPKVEC)
-#elif defined(CERNLIB_QMCRY)
- CALL UNPACK (LQ(LIN),32,LQ(L4STOX),MAXREX)
-#elif (defined(CERNLIB_QMCV64))&&(!defined(CERNLIB_QIEEE))
- CALL UPAK32 (LQ(LIN),LQ(L4STOX),MAXREX)
-#elif defined(CERNLIB_QMIBMD)
- CALL UPACK (LQ(LIN),LQ(L4STOX),MAXREX)
-#elif defined(CERNLIB_QMIRTD)
- CALL UPACK (LQ(LIN),LQ(L4STOX),MAXREX)
-#elif 1
- CALL VXINVB (LQ(LIN),24)
-#endif
diff --git a/src/packlib/zebra/fq/fzudat44.inc b/src/packlib/zebra/fq/fzudat44.inc
deleted file mode 100644
index eaa1af3..0000000
--- a/src/packlib/zebra/fq/fzudat44.inc
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: fzudat44.inc,v 1.1.1.1 1996/03/06 10:47:08 mclareni Exp $
-*
-* $Log: fzudat44.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:08 mclareni
-* Zebra
-*
-*
-* pack 32-bit words to 60-bit
-*
-* fzudat44.inc
-*
-#if defined(CERNLIB_QMCDC)
- CALL PKCHAR (LQ(LWR),LQ(LWR-1),MAXREX,IPKVEC)
- LWR = LWR - 1
-#elif defined(CERNLIB_QMCRY)
- CALL PACK (LQ(LWR),32,LQ(LWR),MAXREX)
-#elif (defined(CERNLIB_QMCV64))&&(!defined(CERNLIB_QIEEE))
- CALL PACK32 (LQ(LWR),LQ(LWR),MAXREX)
-#elif defined(CERNLIB_QMIBMD)
- CALL PACK (LQ(LWR),LQ(LWR),MAXREX)
-#elif defined(CERNLIB_QMIRTD)
- CALL PACK (LQ(LWR),LQ(LWR),MAXREX)
-#elif 1
- CALL VXINVB (LQ(LWR),24)
-#endif
diff --git a/src/packlib/zebra/fq/fzudat49.inc b/src/packlib/zebra/fq/fzudat49.inc
deleted file mode 100644
index adce6e8..0000000
--- a/src/packlib/zebra/fq/fzudat49.inc
+++ /dev/null
@@ -1,30 +0,0 @@
-*
-* $Id: fzudat49.inc,v 1.1.1.1 1996/03/06 10:47:11 mclareni Exp $
-*
-* $Log: fzudat49.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:11 mclareni
-* Zebra
-*
-*
-*
-* fzudat49.inc
-*
-#if defined(CERNLIB_QMIBMD)
- CALL ADWRTKD (LUNX, LQ(LWR),NWMIN,1,ISW)
-* -------------- Here we are , MRo ------------------
-#endif
-* -------------- conversions for input -------------------
-*
-* fzudat49.inc
-*
-#if defined(CERNLIB_QMIRTD)
- CALL ADWRTKD (LUNX, LQ(LWR),NWMIN,1,ISW)
-* -------------- conversions for output -------------------
-#endif
-* use default CALL IE3FOS for output single prec.
-#ifndef CERNLIB_FQIE3FSC
-#endif
-* use default CALL IE3FOD for output double prec.
-#ifndef CERNLIB_FQIE3FDC
-#endif
-* -------------- sequences for input ---------------------
diff --git a/src/packlib/zebra/fq/fzudatd1.inc b/src/packlib/zebra/fq/fzudatd1.inc
deleted file mode 100644
index 877d643..0000000
--- a/src/packlib/zebra/fq/fzudatd1.inc
+++ /dev/null
@@ -1,14 +0,0 @@
-*
-* $Id: fzudatd1.inc,v 1.1.1.1 1996/03/06 10:47:08 mclareni Exp $
-*
-* $Log: fzudatd1.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:08 mclareni
-* Zebra
-*
-*
-*
-* fzudatd1.inc
-*
-#if defined(CERNLIB_QMCDC)
- DIMENSION IPKVEC(5)
-#endif
diff --git a/src/packlib/zebra/fq/fzudatd2.inc b/src/packlib/zebra/fq/fzudatd2.inc
deleted file mode 100644
index c0bc116..0000000
--- a/src/packlib/zebra/fq/fzudatd2.inc
+++ /dev/null
@@ -1,14 +0,0 @@
-*
-* $Id: fzudatd2.inc,v 1.1.1.1 1996/03/06 10:47:08 mclareni Exp $
-*
-* $Log: fzudatd2.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:08 mclareni
-* Zebra
-*
-*
-*
-* fzudatd2.inc
-*
-#if defined(CERNLIB_QMCDC)
- DATA IPKVEC / 32, 0, 600000, 0, 0 /
-#endif
diff --git a/src/packlib/zebra/history/dz b/src/packlib/zebra/history/dz
deleted file mode 100644
index 3b94018..0000000
--- a/src/packlib/zebra/history/dz
+++ /dev/null
@@ -1,387 +0,0 @@
-*
-* $Id: dz,v 1.1.1.1 1996/03/06 10:47:15 mclareni Exp $
-*
-* $Log: dz,v $
-* Revision 1.1.1.1 1996/03/06 10:47:15 mclareni
-* Zebra
-*
-*
-* This directory was created from zebra.car patch dzhist
-V 3.72/1 30 Nov 1993
- - Change ERR= to IOSTAT= in DZBKHD to avoid problems when
- edit descriptor is not large enough (e.g. large numeric IDN)
- if=qmvax.
-V 3.62/2 19 Sep 1989
- - Introduce routine DZZERO
- - DZDATA - Hexidecimal printing Z16.16 not OK for Cray
- - DZSTLA - QUESTPARQ added (bug)
- - DZTYP - QUEST corrected to IQUEST in UBLOW (bug)
- - DZARE1, DZCHBK, DZCHST, DZDATA, DZFORP, DZIOPD, DZIOPH
- DZSTDV, DZSTLA, DZSURF, DZTYP , DZSWAP data variables SAVEd
- - DZBKUP, DZBKXR protect variables by SAVE statement
-V 3.61/1 04 Aug 1989
- - FZHYLN: Correct problem in HYDRA/ZEBRA conversion routine
- by specifying that default data type is floating point
- Precedence should be: bit, integer, float (says J.Zoll)
-V 3.60/1 8 Mar 89
- - Put in compilation directive in DVCHV1 (QMCRY)
- - Change all C to * in column 1 (for Cray CDIR directive)
- - DZAREA Entry statement moved
- - DZFORM Equivalence statement moved
- - DZMAP and DZSNAP now print for E, F or M option (HYDRA-like)
-V 3.59/3 14 Dec 88
- - Eliminate reference to IQCUR and use NQSNAM instead
- DZARE1, DZBKUP, DZSHOW, DZSNAP, DZSTOR
- - Do not call DZTEXT in DZBKHD, DZIOPD and DZIOPH for
- quiet option in DZSHOW (Q instead of S option) (bug)!!!
- Only CQLINE output buffe filled (used by DZDOC for
- for writing interactively with bank documentation)
-V 3.59/2 08 Nov 88
- - Change explicit use of HEXMAP to -OCTMAP (default hex)
- DZARE1, DZMAP, DZSHOW, DZSNAP, DZSTLA and DZSTOR
- - Change explicit use of BYTEMAP to -WORDMAP (default bytes)
- DZARE1, DZMAP, DZSHOW, DZSNAP, DZSTLA and DZSTOR
- - Eliminate +USE sequences for machines w/o WORDMAP or OCTMAP
-V 3.59/1 10 Aug 88
- - Do not call DZTEXT in DZBKHD, DZIOPD and DZIOPH for
- quiet option in DZSHOW
-V 3.57/4 1 Jul 88
- - Replace call from ZFATAL to ZFATAM in DZVERI
-V 3.57/3 8 May 88
- - Eliminate tests for DEBUF with JFORT option
- - Eliminate routine identification in DZOPT
-V 3.57/2 2 May 88
- - Zero IQUEST(1) in all user callable routines
-V 3.57/1 1 May 88
- - Eliminate alternative returns and put return code
- different from 0 in IQUEST(1)
- - Get rid of concatenation operator using dummy
- character argument (problems on IBM VS compiler)
-V 3.56/2 7 Apr 88
- - DZMAP make calling sequence DZSHPR compatible with
- definition of routine (nb. of parameters)
-V 3.56/1 21 Mar 88
- - Change 999 END to 999 RETURN and END
- - Introduce condition code for ALLIANT
-V 3.55 10 Nov 87
- DZARE1 : - Put in protection against invalid addresses in loops
- IQTABV(KQT+13) contains lowest possible address and
- IQTABV(KQT+14) contains highest possible address for store
- - For LUP=0 still test OR link
- - Save ID of mother bank into variable ID
- DZBKHD : - Put in protection against invalid addresses (SEE DZARE1)
- - If invalid address in origin link --> print '_'
- DZBKUP : - Eliminate test on Division for UP bank
- - Correct address of bank to LBANK
- DZTEXT : - Adapt message printed to mod in DZBKUP
-V 3.54 /1 6 Nov 87
- DZARE1 : - Do not print SYSTEM and WS data areas in 'ALL' mode
- - Up links of banks in LA can be 0 or ANY valid bank address
- - OR links of banks in LA can be pointing to any bank or a LA
- DZBKHD : - Only test consistency for non-dropped banks (DZBKDV/UP/XR)
- - Do not use the error return to prevent map entry from
- being printed (DZBKUP/XR)
- DZMAP : - Only allow 7 entries for links in MAP entry with a
- field width of 15 characters per link
- DZTEXT : - Change text for error 3 in DZARE3
-V 3.53 /4 24 Sep 87
- DZSHOW, DZSURV : Correct bug (call MZSDIV before test on dropped bank)
- DZSTOR : Eliminate reference to 998 (no error return)
-V 3.53 /3 28 Jul 87
- Introduce test for pseudo-stores in various routines
- - Test on empty system division introduced in DZARE1, DZBKUP,
- DZSTLA and DZSWAP
-V 3.53 /2 4 Jul 87
- DZBKUP interference with ZEBRA stack LQWKTB in DZBKUP and DZSHPR
- eliminated by introducing separate stack LASTAK
- DZCHBK generalized to DZCHST (old DZCHBK kept for compatibility)
- DZCHV1 changed (internal routine, parameter IXQUES added)
- DZMAP E and F options print banks 'D'ownwards
- DZSHOW
- - Correction to interrupt structure scan at LEVEL 1 (if not option 'L')
- - Introduce test for dropped top bank or zero entry address
- DZSURV
- - Introduce test for dropped top bank or zero entry address
-V 3.53 /1 13 Feb 87
- - Change MIN0 and MAX0 to generic MIN and MAX function calls
- DZBKHD
- - Call DZBKUP only for non-dropped banks
- DZSNAP
- - When store clobbered - Output corrupted area as data (JDFD = 1)
- - Maximum nb. of words printed < NQWCUT
- - Take out test on NQERR ( not 0) for print
-V 3.52 /1 26 Nov 86
- - Update routine stack information
- - Put more information into CQINFO for undocumented cases
- - Better treatment of error conditions in DZSNAP
- DZARE1
- - Test on validity addresses in link area addresses (structural part)
- - Mark banks as critical (T option of DZSNAP)
- DZSHPR
- - Correct treatment of print limits of DZSHOW
- DZMAP
- - Complete rewrite of DZMAP (using CQLINE)
- SEVERAL
- - Working space used is IQWKTB (pointed by LQWKTB)
-V 3.51 /4 19 Nov 86
- - Introduce new trace back in DZSWAP
- - Protection for small (<4 charactes) bank names in LZLOC
- - Introduce check on links in structural part of link area
- to see that the ORIG link of the bank pointed = address in the LA
- (DZSNAP, DZTEXT, DZVERI)
- - Put more information in message 'TOO MANY LA' in DZBKUP
-V 3.51 /3 26 Sep 86
- - Correct call to ZPAGE in DZDATA (wrong number of arguments).
- - Correct I80 (for I8) typing mistake in DZSNAP.
-V 3.51 /2 7 Aug 86
- - Transmit CHOPT between DZAREA and DZARE1 (printing)
- - Introduce double precision printing
-V 3.51 /1 30 Jul 86
- - On WRITEs with ERR, put a IF=-QMIBM flag (JFORT bug)
- - Complete rewrite of the I/O part.
- All IO is performed in DZTEXT via CQMAP
- - Options can be upper or lower case. They are treated in DZOPT
- - Put the heading part of each routine in the correct DZDOC format
- - Introduce sequence QUESTPARQ, describing error flag passing among
- the various DZEBRA routines
- - Eliminate USE flags HEXPRINT for Hexadecimal printing of binary info
- OCTPRINT for Octal printing of binary info
- - All bit information is now printed in hexadecimal
- - All IO goes via variable CQLINE in /DZC1CH/
- - DZAREA : - Now calling DZARE1
- - DZARE1 : - New routine at lower level (from DZAREA and DZSNAP to
- print link areas
- - DZCHBK : - Now calling DZCHC1
- - DZBKDV : - New routine to determine the division where a bank is
- - DZBKHD : - Call DZBKUP for checking correctness of OR and UP links
- - If OR or UP link incorrect, output a second line
- explaining problem
- - DZBKUP : - New routine to check the correctness of OR and UP links
- - DZBKXR : - New routine to check the division cross-reference matrix
- - DZCHVC : - Now calls DZCHV1 (low level)
- - DZCHV1 : - New routine at lower level (from DZCHVC and DZCHBK) to
- calculate the checksum of a vector
- - DZDATA : - Change in Hexadecimal printout (force leading zeores)
- - All hex is now printed full range (16 columns)
- - DZMAP : - Banks are now printed horizontally
- - D option protection moved to beginning of routine
- - DZSHOW : - 'L' option only applies to zeroeth level
- (at other levels next's are always printed)
- - Introduce call to DZBKUP to initialize link area
- information and recode reserved space management part
- - Introduce call to DZBKDV to calculate division of bank
- The latter is now correct, since before the primary bank
- at LBANK was always used instead of current bank at LCUR
- - Calls to MZCHLS eliminated, since made in DZSHPR
- - DZSHPR : - Include calls to DZBKDV and DZBKXR to set up Xref in
- IQUEST(31+..) to be used in checks in DZBKHD
- - DZSNAP : - Include call to DZBKUP to calculate LA limits
- - Include call to DZBKXR to set up XREF matrix in IQUEST
- - introduce call to DZARE1 (lower level than DZAREA)
- - DZTEXT : - Routine for printing error messages and text (new)
- - It is actually the ONLY routine which prints anything
- - DZTYP : - All hexadecimal is full range (type1-type0 abolished)
- - DZVERI : - Introduce call to DZBKUP to initialize link area
- information and recode reserved space management part
- - Call DZBKUP for checking correctness of OR and UP links
- - Call DZBKXR for checking correctness XREF matrix
- - Reorganize error handling with IQUEST
- - Separate option 'U' eliminated (includes in 'L')
-V 3.50 /1 11 Jun 86
- - DZMAP : - Define reserved area variable NDZRSV=0 before call
- to DZSHPR ('C','D' and 'F' options)
- - DZSNAP : - Some cleaning up of code
- - DZSURV : - Eliminate reference to CHOPT
-V 3.41 /7 22 May 86
- - DZC1 : - NOFLIQ parameter was wrong (5 instead ot 8)
- - DZCHBK : - New routine calculating checksum for bank parts
- - DZCHVC : - New routine calculating checksum of array
- - DZSNAP : - Add test on MAP option for printing banks in division
- - DZTYP : - Introduce protection for indefinite operands
-V 3.41 /6 12 May 86
- - DZAREA : - Introduce Q option which returns information via IQUEST
- - DZSURV : - Return information in IQUEST only if CHTEXT='-'
-V 3.41 /5 6 May 86
- - DZSNAP : - Protect options before call to DZAREA which resets them
-V 3.41 /4 30 Apr 86
- - DZMAP : - Protect 'D' option (IQMARK bit set) between DZSHOW
- series of routines and DZSNAP (variable IDOPT)
- - FZZBOOK ZBOOK and HYDRA to ZEBRA conversion
- - FZHYDRA patches reintroduced and made compatible with 3.40
-V 3.41 /3 24 Mar 86
- - BKFOPARQ : - Introduce new parameter JFOSEQ in IO format definition
- - Correct error in parameter definition
- - ALL : - Make consistent with DZDOC program for writeup
- - DZFORM : - Indroduce code for correct line line numbering (NQUSED)
- - DZFORP : idem
- - DZMAP : - Protect 'D' option (IQMARK bit set) between DZSHOW
- series of routines and DZSNAP (variable IDOPT)
- - DZSHOW : - Small correction in layout of LEVEL line
- - DZSNAP : - Print line for empty division
-V 3.41 /2 5 Feb 86
- - DZSTDV : - Count holes correctly as dropped banks
- - DZVERI : - Put in protection for holes in test on bank links
-V 3.41 /1 3 Feb 86
- Include several improvements suggested by J.Zoll
- - DZAREA : - Replaces DZLINK, whose functionality is supplemented
- by allowing the address of a link
- - DZLINK : - Dummy === replaced by DZAREA
- - DZMAP : - Format of LINK part of map line changed
- Align output with ID on header line (right shift 2 chars)
- - Shift . + and F at beginning of MAP line
- - DZSHOW : - Rename option 'H' (horizontal) to 'S' (sideways)
- No actual FORTRAN code changed (since default option)
- - At each level the store and division id's are printed
- (and not anymore in DZSHPR for each bank)
- - Add store and division number to title
- - DZSHPR - Move output of levels to DZSHOW
- - DZSNAP : - Default divisions is 21+22 (user)
- - Add store and division number to title
- - DZVERI : - Default divisions is 21+22 (user)
-V 3.40 /6 24 Jan 86
- - DZSNAP : - Print actual length of divisions and stores
- - Verify the two words at end of store for IQNIL content
- - Include code for flagging of 'critical banks' inline
- recoding algorithm to cure indefinite loop (IQFOUL < 0)
- (routine DZCRIT eliminated)
- - DZSTDV : - Print actual length of division
- - DZSTOR : - Print actual number of links
- - DZTYP : - Dummy out statement numbers 500 and 998 (not referenced)
- - DZVERI : - Verify the two words at end of store for IQNIL content
-V 3.40 /5 22 Jan 86
- - DZSHPR : - Bug corrected (LWORK off by 1 word -->
- overwrote last word of division 1)
-V 3.40 /4 19 Dec 85
- - DZFORM : - Include the printing of NWIO (nb. of IO words)
- - DZFORP : - Change variable IPOS at beginning of routine (see above)
- - DZIOPD : - Dynamic sector of length 0 stops the printout of a bank
- - DZIOPH : - idem
-V 3.40 /3 10 Dec 85
- - ALL : - Change DEBUG output unit to IQPRNT
- - DZFORM : - Introduce code for printing of all formats known to ZEBRA
-V 3.40 /2 5 Dec 85
- - DZIOPD : - Fix bug for uninitialized variable
- - harmonize printing of headings data part and link part
- - DZIOPH : - Harmonize printing of headings with DZIOPD
- - DZSHPR : - Harmonize printing of headings with DZIOPD and DZIOPH
-V 3.40 /1 30 Nov 85
- - ALL : Changes reflecting new bank format
- a) EQUIVALENCE for central part of bank
- b) bank format IO characteristic completely different
- use of MZIOCR in DZSHPR and DZTYP
- - BKFOPARQ is a new sequence definition containing the format
- descriptor for the IO characteristic
- - DZBANK : eliminated (is replaced by DZSHOW)
- - DZFORM : new routine to dump an IO descriptor in readable form
- - DZIOPR : new routine to print the data part of banks according
- to the IO descriptor
- - DZTREE : eliminated (is replaced by DZSHOW)
- - DZVERI : correct error in -calculation end of structural part of LA
- -loop over division cross-references
- increase information content of error messages
- - MZF : PATCH eliminated (replaced by MZ routines of JZ)
- - LZLOC : New name for DZLOC and declare as function
- - NZLEFT : Complete rewrite calling system routine MZRESV
-V 3.31.3/ 4 Oct 85
- - DZSURV : Print total number of banks present
- - DZVERI : -IQUEST working area for inter-division references
- starts at 30 (interference with error return eliminated)
- -Skip dead banks in structural checks
-V 3.31.2/ 13 Sep 85
- - DZBANK : Now calls routine DZSHOW
- - DZMAP : Now calls routine DZSHPR and tune 'D' option interference
- between DZSNAP and DZSHOW
- - DZTREE : Now calls routine DZSHOW
-V 3.31.1/ 30 Aug 85
- - ZBLOC : Entry (alias) to DZLOC
- - ZDLEFT : Entry (alias) to DZLEFT
-V 3.30/ 25 Aug 85
- - DZBANK : Put entry number before its contents
- Bug fixed for case when VB option selected --> stack was
- not treated properly.
- - DZSHOW : Combines the DZTREE and DZBANK options
- Suite of routines comprises DZSHFM, DZSHOW and DZSHPR
- - DZVERI : Check that links comply to inter-division cross-reference
- matrix (IQRTO) constraints
- - Mask DEBUG options for JFORT and the VS compiler separate
- JFORT is using DEBUGJF1 and DEBUGJF2 masked with JFORT flag
- VFORT is using DEBUGVF1 and DEBUGVF2 masked with VFORT flag
- - Introduce DZI USE flag to also include the ZI3DIT package
- (ZEBRA Interactive Debug/Display/Documentation/Interrogation Tools)
- - DZLEFT and DZLOC added
-V 3.22/ 11 Jul 85
- - DZSURV Output store and address of bank as title
- - DZTREE Take out dead code
- Print level again (invalid reference to IFLOPT eliminated)
- - DZTRFM Cosmetics in index printout of data part
- - DZTRPR Cosmetics in index printout of link part
- - DZVERI Return error information in IQUEST(11..)
-V 3.21/ 22 Jun 85
- - DZLINK Bug corrected in addressing link area --> LQ(LQS + address
- - DZSTLA Bug corrected in addressing link area --> LQ(LQS + address
- - DZSTDV Initialize IQFOUL to zero for each division (empty included)
- - DZTREE Series of routines introduced (more dense printing of banks)
- - KEEPs Make DEBROUT KEEP sequence dependent on QMIBM flag
- - ZPAGE Decrease page limit count by 2 (IBM) for C printer
-V 3.20/ 7 Jun 85
- - Use of CDE sequence MQSYS thoughout
- - Change routines treating LA for new MZ conventions (MQ 3.20)
- - Change of JQSTOR --> JQSTOR+1
-V 3.12/ 3 Jun 85
- - Define MSYSFQ, MSYSKQ and MSYSPQ in DZC1 KEEP sequence
- (to include ZBOOK EPIO reading)
- - Define IFORMA inside DZCKIO (DZBKPR, DZCKIO, DZSNAP)
- - Optimization in DZTYP for out of bound index in ext. format case
-V 3.11/29 May 85
- - Introduce flag IF=HISTORY for +PATCH,DZHIST.
- Introduce flag IF=(-)TEXT for +KEEP sequences in +PATCH,PARADQ
- with and w/o explanations (text) respectively.
- - Uniformize use of reserve area in all routines
- DZBANK, DZBKPR, DZMAP, DZSURV, DZVERI
- When several routines in a sequence use the reserve area, the higher
- level routine fences its space by setting NDZRSV in /DZC1/
- - Eliminate redundant code in DZSTLA
- - Include KEEP sequences DEBUGJF1 and DEBUGJF2 which have to be placed
- at the beginning and end of a routine which has to be traced by the
- TRACE dump package of the SIEMENS compiler
- - Change of /DZC1/ common to treat extended bank descriptor
- Inclusion of IFINDX, IFLEV0, LFORMA
- Extension of NFBUFF
- - Introduce USE flags HEXPRINT for Hexadecimal printing of binary info
- OCTPRINT for Octal printing of binary info
- HEXMAP for Hexidecimal load map
- OCTMAP for Octal load map
- BYTEMAP for map addresses expressed in bytes
- - DZCKIO :1) Add /ZUNIT/ IN DZCKIO to print message
- when NFBUFF wrong (IQPRNT was undefined)
- 2) Introduce code to treat external bank descriptor
- - DZDATA : Uniform printing alignment introduced
- - DZTYP :1) Correct small bug in DZTYP (floating test)
- 2) Introduce code to treat external bank descriptor
- - BANKPARQ Introduce the NIO codes used by MZLIFT/MZBOOK
- Introduce maximum number of fields for types in NIO
- i.e. IIONBQ,IIONHQ,IIONIQ and IIONFQ in function of
- the respective field lengths NION.Q
-
-V 3.10/15 April 85
- - Change in ZPAGE (2 instead of 3 parameters)
- Eliminate change of IQUEST(1) in ZPAGE (interference with DZSURV)
- - Global change in all routines calling ZPAGE to bring number of
- parameters in line with change above
-V 3.09/11 April 85
- - Print a message when DZBANK detects an faulty bank
- - Fix bug in DZBANK
-V 3.08/9 April 85
- - Change to new CQLETT/CQNUM conventions
-V 3.07/21 March 85
-
- Start from 3.04
-
- - Make internal working compatible with MZ routines
- - Options are 1 character modes.
- - DZBANK: 'Z' print data part in hexadecimal
- - DZLINK: ' ' option means all link areas
- - DZSNAP: 'L' option means all link areas
- - 'Z' print information in Hexadecimal
- - DZTYP : Introduce forced HEX dump
- - DZVERI: 'U' option checks up and sup links
diff --git a/src/packlib/zebra/history/zebra b/src/packlib/zebra/history/zebra
deleted file mode 100644
index 25215d6..0000000
--- a/src/packlib/zebra/history/zebra
+++ /dev/null
@@ -1,186 +0,0 @@
-*
-* $Id: zebra,v 1.1.1.1 1996/03/06 10:47:15 mclareni Exp $
-*
-* $Log: zebra,v $
-* Revision 1.1.1.1 1996/03/06 10:47:15 mclareni
-* Zebra
-*
-*
-* This directory was created from zebra.car patch history
-Version 3.02=For import into CVS
-Version 3.01=RZFILE: return RZ file format in IQUEST(13)
- RZOPEN: use STATF in case of C I/O
- RZSTAT: set iquest(13-14)
- RZCOP1, RZCOPY, RZDELK, RZINK, RZOUT, RZTOF1, RZVOUT: change
- key/cycle check from key number to KEY(1)
- RZCDES: remove duplicate Z=RZCOUNT.
- RZOUT: move definition of logl, improve warning message
- for large directories
- RZOPEN: increase filename length to 255
- RZVER1: cater for new RZ file format
- RZMAKE,RZQUOT: permit quote>65000 for new RZ format
-Version 3.00=RZVIN: add option O
- RZIN: correct fix for vectors (below).
- RZTOF: remove option N from call to RZMAKE.
- RZWRT: (again) EOR problems when data is not converted
- RZOPEN: retry in exchange mode of auto-RECL determination fails
- issue warning when LRECL>safe_max (8191 words)
- (MZEBRA: zero Z=RZCSTR/nstrip)
- RZOUT: add option Q, as S for RZVOUT
- RZFILE: call RZVCYC
- RZOPEN, RZTOFRZ: mods for Convex from Victor Balashov
- RZVOUT: correct option S
- RZOPEN: mods from RDM (see deck)
- RZVOUT: add option S
- RZWRT: more problems at EOR
- Bug fix in RZIN for vectors
- Remove check on RZ version in RZFILE
- Temporarily disable N option in RZMAKE
- Mods in RZOPEN and RZIODO to support PIAF file striping
- New routines RZSTRIP and RZSTRIR added
- WARNING!!!!! New sequence RZCSTR in patch QCDE
- Removal of 64K limitations (Sunanda Banerjee) 20/06/94
-Version 2.00=RZVER1: set ISTAT2
- RZWRT: better handling of record boundaries
- RZFILE: check version of RZFILE - ZFATAM if new format
- Flags change: QMCVX = Convex, QMCV32/64 for 32/64 bit versions
- RFCONV: mods from FNAL to avoid modifying DCLTABLES (VMS)
- RZFILE: bug fix in PWD handling
- RZFRF: QUOTA=MIN(65000,QUOTA) for historic DBL3 files
- BTEST2: QMNXT flag for BSLASH
- RZWRT: change FORMAT to indicate RZWRT called from RZOUT/RZVOUT
- RZWRT: bug fix for exchange mode case
- More changes for LINUX: exchange mode no longer compulsory,
- QMLNX flags also in P=RZTOFRFZ and BRZTEST (Anatoli Lomov)
- RZOUT: protections against directories>64K
- Changes for CONVEX (from balashov)
- RZMAKE: word 16 of top directory used to indicate version
- of RZ structure
- RZOPEN: return IQUEST(12).ne.0 if exchange mode
- RZWRT: protect against continued event when last bank
- finishes on a record boundary
- RZOPEN: protect against non-RZ files
- RZCDIR: protect against no files open
- Bug fix in RZFDIR
- LINUX support (QMLNX) from Balashov V.K.
- Mods to RZREAD/WRT to continue in case of conversion problems
- Add RZCHCY to check cycles block and reset pointers if needed
- RZIODO: error messages printed unconditionally
- QMDOS flags in RZFILE, RZIODO, RZOPEN and BLANKDEK from V. Fine
- Add QMNXT flag for NeXT machine
- RZFDIR: include Z=RZCLUN unconditionally, set IMODEC/X/H
- RZOPEN: set IMODEH to zero (flag for user I/O routine)
- RZKEYS: always return NK and NWK in IQUEST(11-12)
- Bug fixed in RZINS in replace mode when calling MZIOCR
- RZIODO: byte swap in channel mode for QMVAX, QMVMI.
- RZVOUT,RZOBKN,RZWRT: mods to avoid FZOCV calls for bit patterns
- RZWRT: bug fix in IQUEST(1)=0 resetting after FZOCV
- RZVOUT: missing sequence, RZEND: logl manipulation
- RZREAD: do not call FZICV for bit patterns
- RZDELK: protection against cycles structure containing
- previously deleted objects (should not occur)
- RZLDIR: default is now 'short' listing intended for terminals.
- Use option X to get extended (line printer output) listing
- Add RZHOOK to connect to user I/O routine. This facility
- is for *existing* files only. Address of user I/O routine
- is stored as numeric id of RZ control bank. User LUN is
- stored in bits 7-13 of status word. (Leaving one spare bit)
- !!! ============> N.B. Z=RZCLUN modified <============== !!!
- Limit loglevel to documented range (-3<=LOGL<=4) and
- store in bits 15-17 of control bank status word
- Tidy printout in RZLDI1
- Option R also in RZVOUT
- Option R (replace) in RZOUT. Mods to RZOUT & RZWRT & Z=RZCOUT
- Bug fix in RZINS for option R and exchange mode
- Add routines RZHFRA/RZHTOA from RB
- Bug fixes in RZFILE, RZVERI for option B
- Bug fix in RZCOP1 (from Dave Morrison, MIT)
- Bug fix in RZFRF1 - option L on RZOUT
-Version 1.99=Support for MSDOS (IF=QMDOS).
- New flag QCFIO,IF=QMCRY,QMVAX,QMCVX,QMAPO,QMAPO9,QMUIX,QMDOS
- Translate filename to uppercase in RZOPEN before call to VMQFIL
- Bug fixes in RZWRT, RZPAFF etc.
- Protection in RZMDIR against blank or unseen characters
- Handle > 20 keys in RZLDI1 correctly.
- Correct C I/O options in RZOPEN for write
- Add option Q to RZCDIR - do not print name of directory
- if not found (mods to RZFDIR, RZCOPY)
- Copy vector format in RZCOP1
- Return type of vector read in IQUEST(13) (RZVIN)
- Add routines RZVERI/1/2 to verify an RZ file (check bit map
- of records allocated against actual usage, look for overwriting)
- Add generic key printing routine RZPRNK.
-Version 1.98=Add routine RZVERS(CHTITL,CHCOMP,CHOPT) to print or return
- the pam file title and compilation date/time
- Include RZOPEN mods from GSI for MVS
- Print directory name in RZMODS if write permission denied
- New fix in RZFDIR (fquota) RB, mod for DESY in RZOPEN
-Version 1.97=November 21 1991
- Bug fix in RZFDIR - check against bank at LT not LTOP. JDS
-Version 1.96=November 11 1991
- Add C I/O option (Mods to RZOPEN, RZMAKE, RZFILE, RZIODO, RZCDIR.
- Add routine RZCLOS, Modify sequences RZCLUN, RZCH.). J. Shiers
- Add support for .. in RZCDIR, e.g. CALL RZCDIR('..',' ')
- CALL RZCDIR('../../DSTS',' ') JDS. 15-NOV-91
-Version 1.95=October 21 1991
- Correction in RZFRFZ. RZEXPD is called with the right value
- in case of RZVOUT structures (bug reported by G.Poulard)
-Version 1.94=September 03 1991
- Integrate MVS version of RZOPEN
- Change VMCMS calls to use SYSTEMF.
- Change RZ conversion programs on VM/CMS to use FORTRAN I/O
- Implement Alliant version of RZ programs
- Keep directory dates in RZFRFZ (mods in RZSAVE)
- Protections in RZFDIR (directory overwritten protections)
- New routine RZSCAN
- Check IQUEST(1)<0 after calls to MZIOCR (Nobu Katayama)
- Save IQUEST(1) in RZTOFZ and RZFRFZ (For ZFTP)
- Protection in RZPAFF (M.Marquina)
-Version 1.93=April 22 1991
- Reset LUN in RZFILE in case of failure
- Changes in RZOPEN and PATCH,RTOA
- Do garbage collection in RZTOFZ
- Changes in RZRTOP in case LTOP=0
- Bug corrected in RZDELK (C.Lane MIT)
-Version 1.92=March 23 1991
- RZ eXchange mode implemented (B.Holl)
- Error printing now on logical unit IQLOG and
- LOG level dependent (B.Holl)
- QMHPX (HPUX version introduced)
- Corrections for MVS version
- Corrections for AIX version 370 (QMIBX by R.Howard)
- Changes in RZLOCK/RZFREE (IQUEST(1)=4 if no write permission)
- Changes in RZFILE/RZOPEN for exchange mode files on Vax and VMI
- Changes in RZOPEN for READONLY open on QMAPO
- Changes in LTOP data words, in order to reserve to two words for
- C file pointer (words 5 and 6). The eXchange mode flag is now
- bit 12 in the 9th word of LTOP (B.Holl) ??? Is this a good idea ???
- New option 'C' in RZOPEN (Do not convert filename to lower case)
- (Changed to option P, 11/11/91 JDS)
-Version 1.91=November 22 1990
- RZOUT/RZVOUT returns key number in IQUEST(20) (L.Levinson)
- Protections in RZFILE in case of problems in RZIODO
-Version 1.90=October 31 1990
- Mods in RTOX/RFRX,etc for QMVMI (A.Nathaniel)
- RZEXPD,RZQUOT: bug corrected (B.Holl)
- Alliant version introduced in RZOPEN
- bug corrected in RZPURF
- bug corrected in RZDELK (2, G.Grosdidier)
- Additional protections in RZFILE,RZMAKE,RZLOCK,RZFREE
- Bug corrected in RZIN (RZVOUT case) (O.Schaile)
- Many protections introduced by B.Holl
- RZCOPY can now copy a tree
- New option 'F' in RZMAKE to preformat the file
- New version of RZOPEN with logic to find LRECL
- Changes in RTOX,etc
- Keep original creation date in RFRX,FFRA and RZFRFZ
-Version 1.89=May 22 1990
- Maximum number of directories changed from 20 to 100.
- COMMON /RZDIR/ in QCDE has been changed.
-Version 1.88=April 18 1990
- Bug corrected in RZOUT/RZVOUT when logical record
- terminates at the end of a physical record then followed
- by a directory change (Nobu Katayama, CLEO)
-Version 1.86=January 31 1990
- New routine RZOPEN
- Change 16 bits to 20 bits for 3rd word of cycle
diff --git a/src/packlib/zebra/jz91/Imakefile b/src/packlib/zebra/jz91/Imakefile
deleted file mode 100644
index 1e3758f..0000000
--- a/src/packlib/zebra/jz91/Imakefile
+++ /dev/null
@@ -1,4 +0,0 @@
-SRCS_F= jzend.F jzin.F jzinit.F jzlift.F jzlog.F jzonly.F \ @@\
- jzout.F jzroot.F jzsetf.F jztell.F jztrac.F jzwind.F jzzero.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/zebra/jz91/jzend.F b/src/packlib/zebra/jz91/jzend.F
deleted file mode 100644
index b67db9e..0000000
--- a/src/packlib/zebra/jz91/jzend.F
+++ /dev/null
@@ -1,113 +0,0 @@
-*
-* $Id: jzend.F,v 1.3 1999/06/18 13:29:55 couet Exp $
-*
-* $Log: jzend.F,v $
-* Revision 1.3 1999/06/18 13:29:55 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.2 1996/04/18 16:11:04 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:16 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE JZEND
-
-C- PRINT PROCESSOR SUMMARY
-
-#include "zebra/mzcn.inc"
-#include "zebra/zbcd.inc"
-#include "zebra/zunit.inc"
-#include "zebra/mqsys.inc"
-#include "zebra/jzuc.inc"
-#include "zebra/jzc.inc"
-*
- DIMENSION IDV(5), IDSHV(2), TIMEV(3)
- EQUIVALENCE (IDV(1), IQUEST(1))
- EQUIVALENCE (IDSHV(1),IQUEST(1))
- EQUIVALENCE (TIMEV(1), IQUEST(6))
-
- DIMENSION NUMS(10)
- EQUIVALENCE (NUMS(1),IQNUM2(2))
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HJZEN, 4HD /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HJZEND /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'JZEND ')
-#endif
-
-#include "zebra/q_jbit.inc"
-#include "zebra/q_jbyt.inc"
-
- DATA MYES / 4H T /
-
- IF (LQJZ.EQ.0) RETURN
-
-#include "zebra/qtraceq.inc"
-#include "zebra/qstorjz.inc"
-
- CALL MZCHLS (-7,LQJZ)
- IF (IQFOUL.EQ.0) GO TO 12
- WRITE (IQLOG,9000) LQJZ
-#include "zebra/qtrace99.inc"
- RETURN
-
- 12 CALL JZROOT
-
- WRITE (IQLOG,9001)
- WRITE (IQLOG,9002) NUMS
-
- IFLAG = 0
- 21 LSV = LQJZ - 3
- 22 LSV = LQ(KQS+LSV)
- IF (LSV.EQ.0) THEN
- IF (JQTIME.EQ.0) GO TO 999
- IF (IFLAG .NE.0) GO TO 999
- WRITE (IQLOG,9003)
- IFLAG = 7
- GO TO 21
- ENDIF
-
- LCR = LSV + JQNACC
- NCR = IULAST (0,IQ(KQS+LCR+1),IQ(KQS+LCR)) + 1
- LLC = LCR + IQ(KQS+LCR)
-
- IQUEST(1) = IQ(KQS+LLC+1)
- IQUEST(2) = IQBLAN
- IF (JBIT(IQ(KQS+LSV),17).NE.0) IQUEST(2)=MYES
- IQUEST(3) = JBYT(IQ(KQS+LSV),1,8)
- IQUEST(4) = IQ(KQS+LSV+1)
- IQUEST(5) = IQ(KQS+LSV+2)
- IF (IFLAG .NE.0) GO TO 24
- WRITE (IQLOG,9008) IDV,(IQ(KQS+J+LCR-1),J=1,NCR)
- GO TO 22
-
- 24 IQUEST(1) = IQUEST(4)
- IQUEST(2) = IQUEST(5)
- IF (IQUEST(2).LE.0) GO TO 22
- Q(KQS+LSV+8) = Q(KQS+LSV+8) + Q(KQS+LSV+5)
- Q(KQS+LSV+7) = Q(KQS+LSV+7) + Q(KQS+LSV+8)
- Q(KQS+LSV+5) = 0.
- Q(KQS+LSV+8) = 0.
- TIMEV(1) = Q(KQS+LSV+7)
- TIMEV(2) = Q(KQS+LSV+6)
- TIMEV(3) = TIMEV(1)/FLOAT(IQUEST(2))
- WRITE (IQLOG,9009) IDSHV,TIMEV
- GO TO 22
-
- 9000 FORMAT (/' JZEND. Bad address LQJZ = ',I6)
- 9001 FORMAT (/' JZEND. Summary of processor usage'/1X)
- 9002 FORMAT (' NAN T LV Name Calls Conditions'
- F/7X,1HT,20X,1HN,10(6X,A1))
- 9003 FORMAT (/12X,'Name Calls Total Maximum Mean time')
- 9008 FORMAT (/1X,I5,A2,I3,1X,A4,I7,I6,10I7,:/(29X,10I7))
- 9009 FORMAT (/12X,A4,I7,F9.1,2F9.4)
- END
diff --git a/src/packlib/zebra/jz91/jzin.F b/src/packlib/zebra/jz91/jzin.F
deleted file mode 100644
index 6bb762b..0000000
--- a/src/packlib/zebra/jz91/jzin.F
+++ /dev/null
@@ -1,226 +0,0 @@
-*
-* $Id: jzin.F,v 1.4 1999/06/18 13:29:55 couet Exp $
-*
-* $Log: jzin.F,v $
-* Revision 1.4 1999/06/18 13:29:55 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.3 1996/04/24 17:26:30 mclareni
-* Extend the include file cleanup to dzebra, rz and tq, and also add
-* dependencies in some cases.
-*
-* Revision 1.2 1996/04/18 16:11:05 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:17 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE JZIN (CHPA1,IPA2,IPA3,IPA4)
-
-C- Processor down transfer
-
-C- CHPA1 processor ID in A4
-C- IPA2 = 0 no further down transfer
-C- = 1 yes further down transfer
-C- IPA3 NAN = number of processor constants
-C- IPA4 extra features
-C- IPA4(2) NCR = number of conditions to be recorded
-C- IPA4(3) NLS = number of wsp links to be saved
-C- IPA4(4) NDS = number of wsp data words to be saved
-
-#include "zebra/zstate.inc"
-#include "zebra/zunit.inc"
-#include "zebra/zvfaut.inc"
-#include "zebra/mqsys.inc"
-#include "zebra/jzuc.inc"
-#include "zebra/jzc.inc"
-*
- DIMENSION IPA2(7),IPA3(7),IPA4(7)
- CHARACTER CHPA1*4
-#if defined(CERNLIB_A4)
- CHARACTER CHIAM*4
-#endif
-#if defined(CERNLIB_A8)
- CHARACTER CHIAM*8
-#endif
-#if defined(CERNLIB_EQUHOLCH)
- EQUIVALENCE (CHIAM, IAMID)
-#endif
-
- DIMENSION MMJZFO(5)
- PARAMETER (MXREOD = 2097152)
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HJZIN, 4H /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HJZIN /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'JZIN ')
-#endif
- DATA MMJZFO / 4HJZFO, 0, 0, 1, 2 /
-
-#include "zebra/q_jbit.inc"
-
-#include "zebra/qtraceq.inc"
-#include "zebra/qstorjz.inc"
-#if defined(CERNLIB_QDEBUG)
- IF (IQVSTA.NE.0) CALL ZVAUTX
-#endif
-
- CHIAM = CHPA1
-#if !defined(CERNLIB_EQUHOLCH)
- CALL UCTOH (CHIAM, IAMID,4,4)
-#endif
- IAFLDW = IPA2(1)
- MINIT = 7
- IF (LQSV.EQ.0) GO TO 21
-
-C---- Remember present state
-
- IQ(KQS+LQJZ+2*JQLEV+2) = NQLINK
- IQ(KQS+LQJZ+2*JQLEV+3) = LQSTA(KQT+1)
-
- N = IQ(KQS+LQSV+3)
- IF (N.NE.0) CALL UCOPY (LQ(KQS+NQREF+1),LQ(KQS+LQSV-N-3),N)
- N = IQ(KQS+LQSV+4)
- IF (N.NE.0) THEN
- L = LQAN + IQ(KQS+LQAN)
- CALL UCOPY (LQ(KQS+NQLINK+1),IQ(KQS+L+1),N)
- ENDIF
-
-#if defined(CERNLIB_JZTIME)
-#include "zebra/jztimin.inc"
-#endif
-
-C---- Find SV bank
-
- 21 L = LQ(KQS+LQJZ-4)
- IF (L.EQ.0) GO TO 24
- J = IUCOMP (IAMID,IQ(KQS+L+2),IQ(KQS+L+1))
- IF (J.EQ.0) GO TO 24
- LQSV = LQ(KQS+L-J)
- GO TO 25
-
- 24 LQSV = LZFIND (IXSTJZ,LQ(KQS+LQJZ-3), IAMID,1)
- IF (LQSV.EQ.0) GO TO 81
- 25 IQ(KQS+LQSV+2) = IQ(KQS+LQSV+2) + 1
- LCD = LQSV + JQNACC
- LQAN = LCD + IQ(KQS+LCD) + 1
-
-C-- Copy flags
-
-#if defined(CERNLIB_QDEBUG)
- CALL VZERO (JQFLAG,JQMFLW)
- L = LQAN + IQ(KQS+LQAN) + 1 + IQ(KQS+LQSV+4)
- N = IQ(KQS+L)
- IF (N.NE.0) CALL UCOPY (IQ(KQS+L+1),JQFLAG,N)
-
- IF (JBIT(JQLLEV,9).NE.0) WRITE (IQLOG,9024) JQLEV,NQME(1),
- + IQ(KQS+LQSV+1),IQ(KQS+LQSV+2)
-
- 9024 FORMAT (/' ======= JZIN level',I2,', "',A4,' down to "',A4,
- FI8,'th entry')
-#endif
-
- JQEALL = JQEALL + 1
- IF (JQEALL.EQ.0) GO TO 71
-
-C---- Step level
-
- 31 NQME(1) = IQ(KQS+LQSV+1)
- JQLEV = JQLEV + 1
- IF (JQLEV.GT.JQMLEV) GO TO 91
- J = LQJZ - JQLEV - 6
- LQDW = LQ(KQS+J)
- LQUP = LQ(KQS+J+1)
- J = J - JQMLEV
- LQ(KQS+J) = LQSV
- IQUEST(1) = MINIT
- IF (IAFLDW.NE.0) GO TO 37
- LQDW = 0
-#include "zebra/qtrace99.inc"
- RETURN
-
-C-- Clear the down call bank
-
- 37 IF (JQLEV.EQ.JQMLEV) GO TO 92
- CALL VZERO (LQ(KQS+LQDW-JQCBNL),JQCBNL)
- CALL VZERO (IQ(KQS+LQDW+1), JQCBND)
- IQ(KQS+LQDW) = MSBYT (0, IQ(KQS+LQDW),1,18)
- GO TO 999
-
-C---- Re-order SV structure every now and then
-
- 71 JQREOD = MIN (4*JQREOD,MXREOD)
- JQEALL = -JQREOD
- IF (JQREOD.GE.MXREOD) GO TO 31
- L = LQ(KQS+LQJZ-3)
- CALL ZTOPSY (IXSTJZ,L)
- CALL ZSORTI (IXSTJZ,L,2)
- CALL ZTOPSY (IXSTJZ,L)
- NPR = NZBANK (IXSTJZ,L)
- INC = 10
-
- LFO = LQ(KQS+LQJZ-4)
- IF (LFO.EQ.0) GO TO 72
- IF (NPR.LE.IQ(KQS+LFO-1)) GO TO 74
- CALL MZDROP (IXSTJZ,IQ(KQS+LFO), '.')
- INC = 4
-
- 72 MMJZFO(2) = NPR + INC
- MMJZFO(4) = MMJZFO(2) + 1
- CALL MZLIFT (IXDVJZ,LFO,LQJZ,-4,MMJZFO,0)
- JQREOD = 512
- JQEALL = -JQREOD
-
- 74 IQ(KQS+LFO+1) = NPR
- J = 0
- L = LQJZ - 3
- 75 L = LQ(KQS+L)
- IF (L.EQ.0) GO TO 31
- J = J + 1
- LQ(KQS+LFO-J) = L
- IQ(KQS+LFO+J+1) = IQ(KQS+L+1)
- GO TO 75
-
-C---- Processor not yet initialized
-
- 81 IANAN = IPA3(1)
- IANCR = 10
- IANLSV = 0
- IANDSV = 0
-
- N = IPA4(1)
- IF (N.GE.0) THEN
- N = MIN (N,3)
- CALL UCOPY (IPA4(2),IANCR,N)
- ENDIF
- CALL JZLIFT
- MINIT = IQUEST(1)
- LQSV = IQUEST(2)
-
- LFO = LQ(KQS+LQJZ-4)
- IF (LFO.EQ.0) GO TO 25
- NFO = IQ(KQS+LFO+1) + 1
- IF (NFO.GE.IQ(KQS+LFO-1)) GO TO 25
- LQ(KQS+LFO-NFO) = LQSV
- IQ(KQS+LFO+NFO+1) = IAMID
- IQ(KQS+LFO+1) = NFO
- GO TO 25
-
-C---- JQMLEV exeeded
-
- 92 NQCASE = 1
- 91 NQCASE = NQCASE + 1
- NQFATA = 3
- IQUEST(11) = IAMID
- IQUEST(12) = IAFLDW
- IQUEST(13) = JQLEV
-#include "zebra/qtofatal.inc"
- END
diff --git a/src/packlib/zebra/jz91/jzinit.F b/src/packlib/zebra/jz91/jzinit.F
deleted file mode 100644
index 4319e48..0000000
--- a/src/packlib/zebra/jz91/jzinit.F
+++ /dev/null
@@ -1,209 +0,0 @@
-*
-* $Id: jzinit.F,v 1.3 1999/06/18 13:29:56 couet Exp $
-*
-* $Log: jzinit.F,v $
-* Revision 1.3 1999/06/18 13:29:56 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.2 1996/04/18 16:11:06 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:16 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE JZINIT (IXPARA,CHPA1,CHPA2,IPA3,IPA4,IPA5,IPA6)
-
-C- Initialize JZ91 package
-
-
-#include "zebra/zstate.inc"
-#include "zebra/zunit.inc"
-#include "zebra/mqsys.inc"
-#include "zebra/eqlqt.inc"
-#include "zebra/jzuc.inc"
-#include "zebra/jzc.inc"
-*
- DIMENSION IPA3(7),IPA4(7),IPA5(7),IPA6(7)
- CHARACTER CHPA1*(*), CHPA2*(*)
-#if defined(CERNLIB_A4)
- CHARACTER CHIAM*4
-#endif
-#if defined(CERNLIB_A8)
- CHARACTER CHIAM*8
-#endif
-#if defined(CERNLIB_EQUHOLCH)
- EQUIVALENCE (CHIAM, NQME(1))
-#endif
-
- DIMENSION INIT(4), MEXTR(4)
- EQUIVALENCE (INIT(1),JQTIME), (NACCE,NQME(6))
- DIMENSION MMJZ91(5), MMCALL(5)
-#if defined(CERNLIB_QDEBUG)
- DIMENSION MMFL(5)
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HJZIN, 4HIT /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HJZINIT /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'JZINIT ')
-#endif
-#if defined(CERNLIB_QDEBUG)
-
- DATA MEND /4HEND /
- DATA MMFL /4HJZFL, 0, 0, -7, 2 /
-#endif
- DATA MMJZ91 /4HJZ91, -7, -7, -7, 2 /
- DATA MMCALL /4HJZCA, -7, 0, -7, 0 /
-
- DATA MJQAN/4HJZAN/, MJQFL/4HJZFL/
-
-#include "zebra/q_shiftl.inc"
-
-#include "zebra/qtraceq.inc"
-
- IF (JQLEV.NE.-1) CALL ZFATAM ('re-init of JZ91.')
- CALL VZERO (JQTIME,16)
-
- CALL MZSDIV (IXPARA,-7)
- JQSTJZ = JQSTOR
- IXSTJZ = ISHFTL(JQSTJZ,26)
-
- JQMLEV = IPA3(1)
- JQCBNL = IPA4(1)
- JQCBND = IPA5(1)
-
- CALL UOPTC (CHPA2,'TQE',IQUEST)
- JQTIME = IQUEST(1)
- JQLLEV = 2
- IF (IQUEST(2).NE.0) JQLLEV = 0
- IF (IQUEST(3).NE.0) JQLLEV = 1
-
- CHIAM = CHPA1
-#if !defined(CERNLIB_EQUHOLCH)
- CALL UCTOH (CHIAM, NQME(1),4,4)
-#endif
- NQME(2) = 10
- NQME(3) = 10
-
- N = IPA6(1)
- IF (N.GE.0) THEN
- N = MIN (N,5)
- CALL UCOPY (IPA6(2),NQME(2),N)
- ENDIF
-
- IF (JQLLEV.GE.2) WRITE (IQLOG,9001) JQSTJZ,INIT
- 9001 FORMAT (/' JZINIT. JZ91 in store',I2,
- F', IFTIME,MAXLEV,NL,ND =',7I6)
-
- MMCALL(2) = JQCBNL
- MMCALL(4) = JQCBND
- JQNACC = 9 + NACCE
- MEXTR(1) = 3
- MEXTR(2) = NQME(3)
- MEXTR(3) = NQME(4)
- MEXTR(4) = NQME(5)
-
-C-- Lift division JZ91
-
- NWINT = 1000
- NWMAX = LQSTA(KQT+21) / 2
- CALL MZDIV (IXSTJZ,IXDVJZ,'JZ91',NWINT,NWMAX,'ML')
- CALL MZLINK (IXSTJZ,'JZ91',LQJZ,LQUP,LQAN)
-
-C---- Lift main bank
-
- MMJZ91(2) = 2*JQMLEV + 6
- MMJZ91(3) = JQMLEV + 5
- MMJZ91(4) = 2*JQMLEV + 2
- CALL MZLIFT (IXDVJZ,L,LQJZ,1,MMJZ91,0)
- IQ(KQS+LQJZ+1) = NACCE
-
-C---- Lift the call banks
-
- DO 24 J=1,JQMLEV
- CALL MZLIFT (IXDVJZ,L,LQJZ,-J-5,MMCALL,0)
- 24 CONTINUE
-
-C---- Collect all JQAN titles
-
- CALL TZINQ (IXSTJZ,IXDVTT,LQAN,1)
- IF (LQAN.EQ.0) GO TO 49
- CALL MZXREF (IXDVJZ,IXDVTT,'A')
- GO TO 33
-
- 32 LQAN = LQ(KQS+LQAN)
- 33 IF (LQAN.EQ.0) GO TO 39
- IF (IQ(KQS+LQAN-4).NE.MJQAN) GO TO 32
-
- L = LZFIND (IXSTJZ,LQ(KQS+LQJZ-1), IQ(KQS+LQAN+1),1)
- IF (L.NE.0) GO TO 34
- L = LQAN
- LQAN = LQ(KQS+LQAN)
- CALL ZSHUNT (IXSTJZ,L,LQJZ,-1,0)
- GO TO 33
-
- 34 CALL MZDROP (IXSTJZ,LQAN, '.')
- GO TO 32
-
- 39 CALL ZTOPSY (IXSTJZ,LQ(KQS+LQJZ-1))
-
-C---- Digest all JQFL titles
-
- LQAN = LQT(KQT+1)
- GO TO 43
-
- 42 LQAN = LQ(KQS+LQAN)
- 43 IF (LQAN.EQ.0) GO TO 49
- IF (IQ(KQS+LQAN-4).NE.MJQFL) GO TO 42
-
-#if defined(CERNLIB_QDEBUG)
- JNEXT = 1
- JMAX = IQ(KQS+LQAN-1)
-
- 44 IF (JNEXT.GT.JMAX) GO TO 47
- JID = JNEXT
- JEND = IUFIND (MEND,IQ(KQS+LQAN+1),JID+1,JMAX)
- JNEXT = JEND + 1
- ID = IQ(KQS+LQAN+JID)
- IF (LZFIND(IXSTJZ,LQ(KQS+LQJZ-2),ID,1).NE.0) GO TO 44
-
- IF (JID .NE.1) GO TO 45
- IF (JEND.LE.JMAX) GO TO 45
- L = LQAN
- LQAN = LQ(KQS+LQAN)
- CALL ZSHUNT (IXSTJZ,L, LQJZ,-2,0)
- GO TO 33
-
- 45 MMFL(4) = MIN (JEND-JID,JQMFLW+1)
- CALL MZLIFT (IXDVTT,L,LQJZ,-2,MMFL,-1)
- CALL UCOPY (IQ(KQS+LQAN+JID),IQ(KQS+L+1),MMFL(4))
- GO TO 44
-
-#endif
- 47 CALL MZDROP (IXSTJZ,LQAN, '.')
- GO TO 42
-
- 49 CONTINUE
-
-C---- Lift the root level
-
-#if defined(CERNLIB_JZTIME)
-#include "zebra/jztimed.inc"
-#endif
-
- JQREOD = 512
- JQEALL = -JQREOD
-
- CALL JZIN (CHIAM,1,NQME(2),MEXTR)
-
-#include "zebra/qtrace99.inc"
- RETURN
- END
diff --git a/src/packlib/zebra/jz91/jzlift.F b/src/packlib/zebra/jz91/jzlift.F
deleted file mode 100644
index 01ff303..0000000
--- a/src/packlib/zebra/jz91/jzlift.F
+++ /dev/null
@@ -1,128 +0,0 @@
-*
-* $Id: jzlift.F,v 1.2 1999/06/18 13:29:56 couet Exp $
-*
-* $Log: jzlift.F,v $
-* Revision 1.2 1999/06/18 13:29:56 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:17 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE JZLIFT
-
-C- Initialize processor SV bank for support variables
-
-C- Parameters in /JZC/ :
-C- IAM(1) IAMID = processor ID in A4
-C- 2 IAFLDW = down-call flag
-C- 0 no further down transfer
-C- 1 with down transfer, level JQMLEV must not be reached
-C- 3 IANAN = number of processor constants
-C- 4 IANCR = number of conditions to be recorded
-C- 5 IANLSV = number of wsp links to be saved
-C- 6 IANDSV = number of wsp data words to be saved
-
-#include "zebra/zstate.inc"
-#include "zebra/zunit.inc"
-#include "zebra/mqsysh.inc"
-#include "zebra/jzuc.inc"
-#include "zebra/jzc.inc"
-*
- DIMENSION IDPR(7)
- EQUIVALENCE (IDPR(1),IAMID)
-
- DIMENSION MMSV(5)
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HJZLI, 4HFT /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HJZLIFT /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'JZLIFT ')
-#endif
- DATA MMSV / 4HJZSV, -7, 0, -7, 0 /
-
-#include "zebra/q_jbit.inc"
-
-#include "zebra/qtraceq.inc"
-
-C---- Create SV bank
-
- IANCR = MAX (IANCR,1)
- MMSV(4) = JQNACC + IANCR + IANAN + IANDSV + 2
- IANFL = 0
-#if defined(CERNLIB_QDEBUG)
- LTFL = LZFIND (IXSTJZ,LQ(KQS+LQJZ-2), IAMID,1)
- IF (LTFL.NE.0) IANFL = IQ(KQS+LTFL-1) - 1
- MMSV(4) = MMSV(4) + IANFL
-#endif
- MMSV(2) = IANLSV + 3
- CALL MZLIFT (IXDVJZ,LSV,LQJZ,-3,MMSV,0)
- LCR = LSV + JQNACC
- LAN = LCR + IANCR + 1
-#if defined(CERNLIB_QDEBUG)
- LFL = LAN + IANAN + 1 + IANDSV
-#endif
- CALL SBYT (JQLEV+1, IQ(KQS+LSV),1,8)
- IQ(KQS+LSV+1) = IAMID
- IQ(KQS+LSV+3) = IANLSV
- IQ(KQS+LSV+4) = IANDSV
-
- IQ(KQS+LCR) = IANCR
- IQ(KQS+LAN) = IANAN
- NANTL = IANAN
-
-C---- Find and copy JQAN title, if any
-
- LTAN = LZFIND (IXSTJZ,LQ(KQS+LQJZ-1), IAMID,1)
- IF (LTAN.NE.0) THEN
- NANTL = IQ(KQS+LTAN-1) - 1
- N = MIN (NANTL,IANAN)
- CALL UCOPY (IQ(KQS+LTAN+2),IQ(KQS+LAN+1),N)
- CALL SBIT1 (IQ(KQS+LSV),17)
- CALL MZDROP (IXSTJZ,LTAN, '.')
- ENDIF
-
-C---- Find and copy JQFL flag titles, if any
-
-#if defined(CERNLIB_QDEBUG)
- IF (LTFL.NE.0) THEN
- LTFL = LZFIND (IXSTJZ,LQ(KQS+LQJZ-2), IAMID,1)
- IF (IANFL.NE.0)
- + CALL UCOPY (IQ(KQS+LTFL+2),IQ(KQS+LFL+1),IANFL)
- IQ(KQS+LFL) = IANFL
- CALL MZDROP (IXSTJZ,LTFL, '.')
- ENDIF
-#endif
-
-C---- Print and check discrepancies
-
- LEV = JQLLEV
- IF (IANAN.NE.NANTL) LEV = LEV + 1
-
- IF (LEV.GE.2) WRITE (IQLOG,9042) IDPR
- 9042 FORMAT (/' JZLIFT. Init of "',A4,
- F ' with IFDW,NAN,NCD,NLSV,NDSV,NFL =',6I4)
-
- IF (IANAN.EQ.NANTL) GO TO 47
-
- IF (LEV.GE.2) WRITE (IQLOG,9043) NANTL
- 9043 FORMAT (10X,'!!! NAN from title =',I8,' !!!')
-
-C---- Exit
-
- 47 IQUEST(1) = -7
- IQUEST(2) = LSV
- IF (JBIT(IQ(KQS+LSV),17).EQ.0) GO TO 999
- IF (JQLLEV.GE.2) WRITE (IQLOG,9048)
- 9048 FORMAT (10X,'with title.')
- IQUEST(1) = 0
-#include "zebra/qtrace99.inc"
- RETURN
- END
diff --git a/src/packlib/zebra/jz91/jzlog.F b/src/packlib/zebra/jz91/jzlog.F
deleted file mode 100644
index 2b97eb3..0000000
--- a/src/packlib/zebra/jz91/jzlog.F
+++ /dev/null
@@ -1,75 +0,0 @@
-*
-* $Id: jzlog.F,v 1.3 1999/06/18 13:29:57 couet Exp $
-*
-* $Log: jzlog.F,v $
-* Revision 1.3 1999/06/18 13:29:57 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.2 1996/04/18 16:11:07 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:17 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE JZLOG (CHOPT)
-
-C- Set log options
-
-C- Structure of JQLLEV :
-C- bits 1-4 = 0 Q, suppress all messages
-C- 1 E, error messages only
-C- 2 normal logging
-
-C- bits 5-8 = 1 T, JZTELL printing
-
-C- bits 9-12 : bit 1 A, JZIN logging
-C 2 B, and dump call bank
-C- 3 C, and dump AN parameters
-
-C- bits 13-16 : bit 1 X, JZOUT logging
-C- 2 Y, and dump call bank
-
-#include "zebra/zunit.inc"
-#include "zebra/quest.inc"
-#include "zebra/jzuc.inc"
-#include "zebra/jzc.inc"
-*
- CHARACTER CHOPT*(*)
-
-#include "zebra/q_or.inc"
-#include "zebra/q_shiftl.inc"
-
-#if defined(CERNLIB_QPRINT)
- IF (JQLLEV.GE.2) WRITE (IQLOG,9007) CHOPT
- 9007 FORMAT (' JZLOG. option = ',A)
-#endif
-
- CALL UOPTC (CHOPT,'QETABCXY',IQUEST)
-C- _:.=+=.:
- JQLLEV = 2
- IF (IQUEST(1).NE.0) JQLLEV = 0
- IF (IQUEST(2).NE.0) JQLLEV = 1
- IF (JQLLEV.LT.2) RETURN
-
- IF (IQUEST(3).NE.0) JQLLEV = 18
-
- J = IQUEST(5) + 2*IQUEST(6)
- IF (J.EQ.0) THEN
- J = IQUEST(4)
- ELSE
- J = 2*J + 1
- ENDIF
- IF (J.NE.0) JQLLEV = IOR (JQLLEV, ISHFTL(J,8))
-
- J = IQUEST(8)
- IF (J.EQ.0) THEN
- J = IQUEST(7)
- ELSE
- J = 2*J + 1
- ENDIF
- IF (J.NE.0) JQLLEV = IOR (JQLLEV, ISHFTL(J,12))
- RETURN
- END
diff --git a/src/packlib/zebra/jz91/jzonly.F b/src/packlib/zebra/jz91/jzonly.F
deleted file mode 100644
index b2fe8bd..0000000
--- a/src/packlib/zebra/jz91/jzonly.F
+++ /dev/null
@@ -1,45 +0,0 @@
-*
-* $Id: jzonly.F,v 1.2 1999/06/18 13:29:58 couet Exp $
-*
-* $Log: jzonly.F,v $
-* Revision 1.2 1999/06/18 13:29:58 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:17 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE JZONLY (IDV)
-
-C- PURGE REDUNDANT PROCESSORS TITLES
-
-#include "zebra/mqsysh.inc"
-#include "zebra/jzuc.inc"
-#include "zebra/jzc.inc"
-*
- DIMENSION IDV(99)
-
-#include "zebra/qstorjz.inc"
-
- NID = IDV(1)
- IFL = 0
- L = LQJZ - 1
-
- 21 L = LQ(KQS+L)
- IF (L.NE.0) THEN
- IF (IUCOMP(IQ(KQS+L+1),IDV(2),NID).NE.0) GO TO 21
- CALL MZDROP (IXSTJZ,L, '.')
- GO TO 21
- ENDIF
-
-#if defined(CERNLIB_QDEBUG)
- IF (IFL.EQ.0) THEN
- IFL = 1
- L = LQJZ - 2
- GO TO 21
- ENDIF
-#endif
- RETURN
- END
diff --git a/src/packlib/zebra/jz91/jzout.F b/src/packlib/zebra/jz91/jzout.F
deleted file mode 100644
index fbb7146..0000000
--- a/src/packlib/zebra/jz91/jzout.F
+++ /dev/null
@@ -1,126 +0,0 @@
-*
-* $Id: jzout.F,v 1.2 1999/06/18 13:29:58 couet Exp $
-*
-* $Log: jzout.F,v $
-* Revision 1.2 1999/06/18 13:29:58 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:16 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE JZOUT (CHPA1)
-
-C- Processor up transfer
-
-C CHPA1 processor ID in A4
-
-#include "zebra/zstate.inc"
-#include "zebra/zunit.inc"
-#include "zebra/mqsys.inc"
-#include "zebra/jzuc.inc"
-#include "zebra/jzc.inc"
-*
- CHARACTER CHPA1*4
-#if defined(CERNLIB_A4)
- CHARACTER CHIAM*4
-#endif
-#if defined(CERNLIB_A8)
- CHARACTER CHIAM*8
-#endif
-#if defined(CERNLIB_EQUHOLCH)
- EQUIVALENCE (CHIAM, IAMID)
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HJZOU, 4HT /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HJZOUT /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'JZOUT ')
-#endif
-
-#include "zebra/q_jbit.inc"
-
-#include "zebra/qtraceq.inc"
-#include "zebra/qstorjz.inc"
-
-C---- Check matching ID's
-
- CHIAM = CHPA1
- IF (CHIAM.NE.'??? ') THEN
-#if !defined(CERNLIB_EQUHOLCH)
- CALL UCTOH (CHIAM, IAMID,4,4)
-#endif
- IF (NQME(1).NE.IAMID) GO TO 91
- ENDIF
-
-C-- Account time
-
-#if defined(CERNLIB_JZTIME)
-#include "zebra/jztimout.inc"
-#endif
-
-C---- Step level back
-
- IF (JQLEV.EQ.0) GO TO 92
- LEVDW = JQLEV
- JQLEV = JQLEV - 1
-
- J = LQJZ - JQLEV - 6
- LQDW = LQ(KQS+J)
- LQUP = LQ(KQS+J+1)
- J = J - JQMLEV
- LQSV = LQ(KQS+J)
- LCD = LQSV + JQNACC
- LQAN = LCD + IQ(KQS+LCD) + 1
-
-C-- Copy flags
-
-#if defined(CERNLIB_QDEBUG)
- CALL VZERO (JQFLAG,JQMFLW)
- L = LQAN + IQ(KQS+LQAN) + 1 + IQ(KQS+LQSV+4)
- N = IQ(KQS+L)
- IF (N.NE.0) CALL UCOPY (IQ(KQS+L+1),JQFLAG,N)
-
- IF (JBIT(JQLLEV,13).NE.0)
- + WRITE (IQLOG,9024) LEVDW,NQME(1),IQ(KQS+LQSV+1)
- 9024 FORMAT ( ' ======= JZOUT level',I2,', "',A4,' up to "',A4)
-#endif
-
-C--- Work space for upper proc
-
- NQME(1) = IQ(KQS+LQSV+1)
- IF (JBIT(IQ(KQS+LQDW),15).NE.0) THEN
- CALL SBIT0 (IQ(KQS+LQDW),15)
- GO TO 999
- ENDIF
- NLINK = IQ(KQS+LQJZ+2*JQLEV+2)
- NDATA = IQ(KQS+LQJZ+2*JQLEV+3)
- CALL MZWORK (IXSTJZ,LQ(KQS+NLINK+1),LQ(KQS+NDATA-1),0)
-
- N = IQ(KQS+LQSV+3)
- IF (N.NE.0) CALL UCOPY (LQ(KQS+LQSV-N-3),LQ(KQS+NQREF+1),N)
- N = IQ(KQS+LQSV+4)
- IF (N.EQ.0) GO TO 999
- L = LQAN + IQ(KQS+LQAN)
- CALL UCOPY (IQ(KQS+L+1),LQ(KQS+NQLINK+1),N)
-
-#include "zebra/qtrace99.inc"
- RETURN
-
-C---- ID mismatch
-
- 92 NQCASE = 1
- 91 NQCASE = NQCASE + 1
- NQFATA = 3
- IQUEST(11) = NQME(1)
- IQUEST(12) = IAMID
- IQUEST(13) = JQLEV
-#include "zebra/qtofatal.inc"
- END
diff --git a/src/packlib/zebra/jz91/jzroot.F b/src/packlib/zebra/jz91/jzroot.F
deleted file mode 100644
index a0306e8..0000000
--- a/src/packlib/zebra/jz91/jzroot.F
+++ /dev/null
@@ -1,59 +0,0 @@
-*
-* $Id: jzroot.F,v 1.2 1999/06/18 13:29:59 couet Exp $
-*
-* $Log: jzroot.F,v $
-* Revision 1.2 1999/06/18 13:29:59 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:16 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE JZROOT
-
-C- RESET TO ROOT LEVEL FOR QNEXT
-
-#include "zebra/zunit.inc"
-#include "zebra/mqsysh.inc"
-#include "zebra/jzuc.inc"
-#include "zebra/jzc.inc"
-*
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HJZRO, 4HOT /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HJZROOT /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'JZROOT ')
-#endif
-
-#include "zebra/q_jbit.inc"
-
- IF (JQLEV.LT.0) RETURN
-
-#include "zebra/qtraceq.inc"
-#include "zebra/qstorjz.inc"
-
- IF (JQLEV.EQ.0) GO TO 31
- 21 CALL JZOUT ('??? ')
- IF (JQLEV.GT.0) GO TO 21
-
- IQ(KQS+LQSV+2) = IQ(KQS+LQSV+2) + 1
-
-#if defined(CERNLIB_QDEBUG)
- IF (JBIT(JQLLEV,13).NE.0) WRITE (IQLOG,9024)
- 9024 FORMAT (/' ======= JZROOT done.')
-#endif
-
- 31 CONTINUE
-#if defined(CERNLIB_JZTIME)
-#include "zebra/jztimout.inc"
-#endif
-#include "zebra/qtrace99.inc"
- RETURN
- END
diff --git a/src/packlib/zebra/jz91/jzsetf.F b/src/packlib/zebra/jz91/jzsetf.F
deleted file mode 100644
index b8e05ac..0000000
--- a/src/packlib/zebra/jz91/jzsetf.F
+++ /dev/null
@@ -1,111 +0,0 @@
-*
-* $Id: jzsetf.F,v 1.3 1999/06/18 13:30:00 couet Exp $
-*
-* $Log: jzsetf.F,v $
-* Revision 1.3 1999/06/18 13:30:00 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.2 1996/04/18 16:11:08 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:17 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE JZSETF (CHPA1,IPA2,IPA3)
-
-C- Set flag word JFL for processor IAM
-
-#include "zebra/mqsysh.inc"
-#include "zebra/jzuc.inc"
-#include "zebra/jzc.inc"
-*
- DIMENSION IPA2(7),IPA3(7)
- CHARACTER CHPA1*4
-#if defined(CERNLIB_A4)
- CHARACTER CHIAM*4
-#endif
-#if defined(CERNLIB_A8)
- CHARACTER CHIAM*8
-#endif
-#if defined(CERNLIB_EQUHOLCH)
- EQUIVALENCE (CHIAM, IAMID)
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HJZSE, 4HTF /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HJZSETF /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'JZSETF ')
-#endif
-
-
-#include "zebra/qtraceq.inc"
-
-#if defined(CERNLIB_QDEBUG)
-#include "zebra/qstorjz.inc"
- CHIAM = CHPA1
-#endif
-#if (defined(CERNLIB_QDEBUG))&&(!defined(CERNLIB_EQUHOLCH))
- CALL UCTOH (CHIAM, IAMID,4,4)
-#endif
-#if defined(CERNLIB_QDEBUG)
- JFL = IPA2(1)
- IVAL = IPA3(1)
-
-C---- Find SV bank
-
- 21 L = LQ(KQS+LQJZ-4)
- IF (L.EQ.0) GO TO 24
- J = IUCOMP (IAMID,IQ(KQS+L+2),IQ(KQS+L+1))
- IF (J.EQ.0) GO TO 24
- LSV = LQ(KQS+L-J)
- GO TO 25
-
- 24 LSV = LZFIND (IXSTJZ,LQ(KQS+LQJZ-3), IAMID,1)
- IF (LSV.EQ.0) GO TO 41
- 25 LFL = LSV + JQNACC
- LFL = LFL + IQ(KQS+LFL) + 1
- LFL = LFL + IQ(KQS+LFL) + 1 + IQ(KQS+LSV+4)
- NFL = IQ(KQS+LFL)
-
-C---- Set flag value
-
- 31 IF (JFL.GT.NFL) GO TO 81
- IF (JFL.LE.0) GO TO 91
- IQUEST(3) = IQ(KQS+LFL+JFL)
- IQ(KQS+LFL+JFL) = IVAL
- GO TO 82
-
-C---- Find flag bank if processor not yet init.
-
- 41 LFL = LZFIND (IXSTJZ,LQ(KQS+LQJZ-2), IAMID,1)
- IF (LFL.EQ.0) GO TO 81
- NFL = IQ(KQS+LFL-1) - 1
- LFL = LFL + 1
- GO TO 31
-
-#endif
-C---- Flag not available
-
- 81 LFL = 0
- 82 IQUEST(1) = LFL
- IQUEST(2) = NFL
-#include "zebra/qtrace99.inc"
- RETURN
-
-C---- Negative flag number
-
- 91 NQCASE = 1
- NQFATA = 3
- IQUEST(11) = NQME(1)
- IQUEST(12) = IAMID
- IQUEST(13) = JFL
-#include "zebra/qtofatal.inc"
- END
diff --git a/src/packlib/zebra/jz91/jztell.F b/src/packlib/zebra/jz91/jztell.F
deleted file mode 100644
index 8d0a0b2..0000000
--- a/src/packlib/zebra/jz91/jztell.F
+++ /dev/null
@@ -1,46 +0,0 @@
-*
-* $Id: jztell.F,v 1.2 1999/06/18 13:30:00 couet Exp $
-*
-* $Log: jztell.F,v $
-* Revision 1.2 1999/06/18 13:30:00 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:17 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE JZTELL (IDV)
-
-C- Processor condition recording
-
-C IDV(1) condition number
-
-#include "zebra/zunit.inc"
-#include "zebra/mqsysh.inc"
-#include "zebra/jzuc.inc"
-#include "zebra/jzc.inc"
-*
- DIMENSION IDV(7)
-
-#if defined(CERNLIB_QDEBUG)
-#include "zebra/q_jbit.inc"
-#endif
-
-#include "zebra/qstorjz.inc"
-
- ID = IDV(1)
-
-#if defined(CERNLIB_QDEBUG)
- IF (JBIT(JQLLEV,5).NE.0) WRITE (IQLOG,9024) JQLEV,NQME(1),ID
- 9024 FORMAT ( ' ======= JZTELL level',I2,', "',A4,I4)
-#endif
-
- IF (LQSV.EQ.0) RETURN
- L = LQSV + JQNACC
- J = MIN (ID,IQ(KQS+L))
- J = MAX (J,1)
- IQ(KQS+L+J) = IQ(KQS+L+J) + 1
- RETURN
- END
diff --git a/src/packlib/zebra/jz91/jztrac.F b/src/packlib/zebra/jz91/jztrac.F
deleted file mode 100644
index 8543fa5..0000000
--- a/src/packlib/zebra/jz91/jztrac.F
+++ /dev/null
@@ -1,119 +0,0 @@
-*
-* $Id: jztrac.F,v 1.3 1999/06/18 13:30:00 couet Exp $
-*
-* $Log: jztrac.F,v $
-* Revision 1.3 1999/06/18 13:30:00 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.2 1996/04/18 16:11:08 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:17 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE JZTRAC (MODEP)
-
-C- Dump processor trace for JZ91
-
-#include "zebra/mzcn.inc"
-#include "zebra/zbcd.inc"
-#include "zebra/zstate.inc"
-#include "zebra/zunit.inc"
-#include "zebra/mqsys.inc"
-#include "zebra/jzuc.inc"
-#include "zebra/jzc.inc"
-*
- DIMENSION MODEP(9)
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HJZTR, 4HAC /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HJZTRAC /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'JZTRAC ')
-#endif
-
-#include "zebra/q_jbit.inc"
-#include "zebra/q_jbyt.inc"
-#include "zebra/q_sbit1.inc"
-
-C For bits in MODE - mark critical
-C bit 1 SV banks
-C 2 Call banks
-C 3 Banks pointed to by links
-C in current LQDW and LQUP
-
- IF (LQJZ.EQ.0) RETURN
-
-#include "zebra/qtraceq.inc"
-#include "zebra/qstorjz.inc"
- MODE = MODEP(1)
- WRITE (IQLOG,9000) JQLEV
- NQUSED = NQUSED + 4
-
- LEV = MIN (JQLEV,JQMLEV)
- KHI = LQJZ - 6
- KLO = KHI - LEV
-
- LDW = LQ(KQS+KLO)
- IF (LQDW.EQ.0) LDW=0
-
- DO 49 K=KLO,KHI
- LSV = LQ(KQS+K-JQMLEV)
-
-C-- Check LSV valid
-
- CALL MZCHLS (-7,LSV)
- IF (IQFOUL.EQ.0) GO TO 23
- ID = IQBLAN
- GO TO 24
-
- 23 ID = IQ(KQS+LSV+1)
- IF (JBIT(MODE,1).EQ.0) GO TO 24
- IQ(KQS+LSV) = MSBIT1 (IQ(KQS+LSV),IQCRIT)
-
-C---- Print 1 line for this level
-
- 24 WRITE (IQLOG,9024) LEV,ID,LSV,LDW
- NQUSED = NQUSED + 2
- IF (IQFOUL.NE.0) WRITE (IQLOG,9025)
-
-C---- Check down bank
-
- IF (LDW.EQ.0) GO TO 36
- CALL MZCHLS (-7,LDW)
- IF (IQFOUL.EQ.0) GO TO 31
- WRITE (IQLOG,9026)
- GO TO 36
-
- 31 J = JBYT (MODE,2,2)
- IF (J.EQ.0) GO TO 36
- IQ(KQS+LDW) = MSBIT1 (IQ(KQS+LDW),IQCRIT)
- IF (J.LT.2) GO TO 36
- IF (LEV.LT.JQLEV-1) GO TO 36
-
- DO 34 J=1,IQNL
- L = LQ(KQS+LDW-J)
- IF (L.EQ.0) GO TO 34
- CALL MZCHLS (-7,L)
- IF (IQFOUL.NE.0) GO TO 34
- IQ(KQS+L) = MSBIT1 (IQ(KQS+L),IQCRIT)
- 34 CONTINUE
- 36 CONTINUE
- LDW = LQ(KQS+K+1)
- 49 LEV = LEV - 1
-#include "zebra/qtrace99.inc"
- RETURN
-
- 9000 FORMAT (/' JZTRAC. Processor trace at level',I3
- F/10X,'Depth Name LQSV LQDW')
- 9024 FORMAT (/10X,I5,1X,A4,2I7)
- 9025 FORMAT (' !!!',32X,'*** bank SV bad !!!')
- 9026 FORMAT (' !!!',32X,'*** bank DW bad !!!')
- END
diff --git a/src/packlib/zebra/jz91/jzwind.F b/src/packlib/zebra/jz91/jzwind.F
deleted file mode 100644
index 76af270..0000000
--- a/src/packlib/zebra/jz91/jzwind.F
+++ /dev/null
@@ -1,81 +0,0 @@
-*
-* $Id: jzwind.F,v 1.2 1999/06/18 13:30:01 couet Exp $
-*
-* $Log: jzwind.F,v $
-* Revision 1.2 1999/06/18 13:30:01 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:16 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE JZWIND (CHPA1)
-
-C- Reset processor for trap transfer
-
-#include "zebra/zunit.inc"
-#include "zebra/mqsysh.inc"
-#include "zebra/jzuc.inc"
-#include "zebra/jzc.inc"
-*
- CHARACTER CHPA1*4
-#if defined(CERNLIB_A4)
- CHARACTER CHNMTO*4, CHIAM*4
-#endif
-#if defined(CERNLIB_A8)
- CHARACTER CHNMTO*8, CHIAM*8
-#endif
-#if defined(CERNLIB_EQUHOLCH)
- INTEGER IAMTO
- EQUIVALENCE (CHNMTO, IAMTO), (CHIAM, NQME(1))
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HJZWI, 4HND /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HJZWIND /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'JZWIND ')
-#endif
-
-#if defined(CERNLIB_QDEBUG)
-#include "zebra/q_jbit.inc"
-#endif
-
- IF (JQLEV.LE.0) RETURN
-
-#include "zebra/qtraceq.inc"
-
- CHNMTO = CHPA1
-#if defined(CERNLIB_EQUHOLCH)
- 21 IF (NQME(1).NE.IAMTO) THEN
- IF (JQLEV.EQ.0) GO TO 91
- CALL JZOUT ('??? ')
- GO TO 21
- ENDIF
-#endif
-#if !defined(CERNLIB_EQUHOLCH)
- 21 CALL UHTOC (NQME(1),4,CHIAM,4)
- IF (CHIAM(1:4).NE.CHNMTO(1:4)) THEN
- IF (JQLEV.EQ.0) GO TO 91
- CALL JZOUT ('??? ')
- GO TO 21
- ENDIF
-#endif
-
-#if defined(CERNLIB_QDEBUG)
- IF (JBIT(JQLLEV,13).NE.0) WRITE (IQLOG,9016) CHNMTO(1:4)
- 9016 FORMAT (/' ======= JZWIND to "',A,' done.')
-#endif
- IQUEST(1) = 0
-#include "zebra/qtrace99.inc"
- RETURN
-
- 91 IQUEST(1) = 7
- GO TO 999
- END
diff --git a/src/packlib/zebra/jz91/jzzero.F b/src/packlib/zebra/jz91/jzzero.F
deleted file mode 100644
index 6b196a6..0000000
--- a/src/packlib/zebra/jz91/jzzero.F
+++ /dev/null
@@ -1,61 +0,0 @@
-*
-* $Id: jzzero.F,v 1.2 1999/06/18 13:30:02 couet Exp $
-*
-* $Log: jzzero.F,v $
-* Revision 1.2 1999/06/18 13:30:02 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:17 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE JZZERO (NLK,NDK)
-
-C- Clear unused part of call bank
-
-#include "zebra/mqsysh.inc"
-#include "zebra/jzuc.inc"
-#include "zebra/jzc.inc"
-*
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HJZZE, 4HRO /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HJZZERO /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'JZZERO ')
-#endif
-
-
-#include "zebra/qtraceq.inc"
-#include "zebra/qstorjz.inc"
-
- IF (LQDW.EQ.0) GO TO 91
- IF (NLK.LT.0) GO TO 92
- IF (NDK.LT.0) GO TO 93
-
- DO 24 J=NLK+1,JQCBNL
- 24 LQ(KQS+LQDW-J) = 0
-
- DO 27 J=NDK+1,JQCBND
- 27 IQ(KQS+LQDW+J) = 0
-
-#include "zebra/qtrace99.inc"
- RETURN
-
-C---- Trouble
-
- 93 NQCASE = 1
- 92 NQCASE = NQCASE + 1
- 91 NQCASE = NQCASE + 1
- NQFATA = 3
- IQUEST(11) = LQDW
- IQUEST(12) = NLK
- IQUEST(13) = NDK
-#include "zebra/qtofatal.inc"
- END
diff --git a/src/packlib/zebra/mq/Imakefile b/src/packlib/zebra/mq/Imakefile
deleted file mode 100644
index 21f3b3b..0000000
--- a/src/packlib/zebra/mq/Imakefile
+++ /dev/null
@@ -1,6 +0,0 @@
-SRCS_F= mzattm.F mzbook.F mzcopy.F mzdiv.F mzdred.F mzdrop.F \ @@\
- mzebra.F mzend.F mzflag.F mzinco.F mzinqd.F mzinqs.F mzlift.F \ @@\
- mzlink.F mzlint.F mzlogl.F mzmaps.F mzmark.F mzneed.F mzpaw.F \ @@\
- mzpudx.F mzpush.F mzrepl.F mzstor.F mzvers.F mzvolm.F mzwork.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/zebra/mq/mzattm.F b/src/packlib/zebra/mq/mzattm.F
deleted file mode 100644
index fb81986..0000000
--- a/src/packlib/zebra/mq/mzattm.F
+++ /dev/null
@@ -1,183 +0,0 @@
-*
-* $Id: mzattm.F,v 1.3 1999/06/18 13:30:10 couet Exp $
-*
-* $Log: mzattm.F,v $
-* Revision 1.3 1999/06/18 13:30:10 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.2 1996/04/18 16:11:16 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:20 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE MZATTM (IXSTOP,CHNAME
- +, MEMOR,LSTAP,NWMP,NWEXP,CHOPT,ITABLE)
-
-C- Attach flat memory as a Zebra store region, user called
-
-#include "zebra/zbcd.inc"
-#include "zebra/zstate.inc"
-#include "zebra/zunit.inc"
-#include "zebra/mqsys.inc"
-*
- DIMENSION IXSTOP(9),MEMOR(99),LSTAP(9),NWMP(9),NWEXP(9)
- DIMENSION ITABLE(400)
- CHARACTER *(*) CHNAME,CHOPT
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HMZAT, 4HTM /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HMZATTM /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'MZATTM ')
-#endif
-
-#include "zebra/q_sbit1.inc"
-#include "zebra/q_shiftl.inc"
-#include "zebra/q_locf.inc"
-
-
-#include "zebra/qtrace.inc"
-
- IXSTOR = IXSTOP(1)
- LSTA = LSTAP(1)
- NWMEM = NWMP(1)
- NWEX = NWEXP(1)
- CALL UOPTC (CHOPT,'QIR',IQUEST)
- LOGQ = IQUEST(1)
- IREI = IQUEST(2)
- IONL = IQUEST(3)
-
- LASTOR = LOCF(MEMOR(1)) - 1
- LEND20 = 0
-
-C------ Reset size of an existing read-only store
-
- IF (IXSTOR.EQ.0) GO TO 21
- CALL MZSDIV (IXSTOR,0)
- IF (NQALLO(JQSTOR).GE.0) GO TO 91
- IF (NQALLO(JQSTOR).LT.-3) GO TO 92
- IF (IREI.NE.0) GO TO 24
- IF (NQALLO(JQSTOR).EQ.-1) GO TO 92
- GO TO 61
-
-C------ Initialize an new read-only store
-
- 21 JQSTOR = NQSTOR + 1
- IF (NQSTOR) 93, 24, 22
- 22 JQSTOR = IUFIND (-1,NQALLO(2),1,NQSTOR)
- 24 CALL VZERO (KQT,25)
-
-C-- Printing name of store
-
- NQSNAM(1) = IQBLAN
- NQSNAM(2) = IQBLAN
- N = MIN (8, LEN(CHNAME))
- IF (N.NE.0) CALL UCTOH (CHNAME,NQSNAM,4,N)
-
-C-- Set log level
-
- NQLOGL = NQLOGD
- IF (LOGQ.NE.0) NQLOGL=-2
-
-C-- Calculate table off-set
-
- LOCT = LOCF (ITABLE(1)) - 1
- KQT = LOCT - LQATAB
-
-#if defined(CERNLIB_QPRINT)
- IF (NQLOGL.GE.0) THEN
- KQS = LASTOR - LQASTO
- WRITE (IQLOG,9021) JQSTOR,NQSNAM(1),NQSNAM(2)
- +, LASTOR,LOCT,LASTOR,LOCT,KQS,KQT,KQS,KQT
- ENDIF
- 9021 FORMAT (1X/' MZATTM. Attach Memory as Store',I3,' in ',2A4,
- F/10X,'with Store/Table at absolute adrs',2I12
-#endif
-#if (defined(CERNLIB_QPRINT))&&(!defined(CERNLIB_HEX))
- F/40X,'OCT',2(1X,O11)/40X,'OCT',2(1X,O11)
-#endif
-#if (defined(CERNLIB_QPRINT))&&(defined(CERNLIB_HEX))
- F/40X,'HEX',2(1X,Z11)/40X,'HEX',2(1X,Z11)
-#endif
-#if defined(CERNLIB_QPRINT)
- F/30X,'relative adrs',2I12)
-#endif
-
- IF (JQSTOR.GE.16) GO TO 94
-
-C---- Initialize divisions 1 + 2 + system
-
- NQOFFT(JQSTOR+1) = KQT
- CALL VZERO (IQTABV(KQT+1),NQTSYS)
- CALL VBLANK (IQDN1(KQT+1), 40)
-
- JQDVLL = 2
- JQDVSY = 20
- IQDN1(KQT+20) = IQLETT(19)
- IQDN1(KQT+2) = IQLETT(4)
-
- IQKIND(KQT+1) = MSBIT1 (1,21)
- IQDN1(KQT+1) = NQSNAM(1)
- IQDN2(KQT+1) = NQSNAM(2)
-
- CALL UCOPY (IQCUR,IQTABV(KQT+1),16)
-
-C-- Return IXSTOR
- IF (IXSTOR.EQ.0) THEN
- IXSTOP(1) = ISHFTL (JQSTOR,26)
- ENDIF
-
- IF (JQSTOR.GT.NQSTOR) NQSTOR = JQSTOR
- NQALLO(JQSTOR) = -3 + IONL
-
-C------ Set size of the store
-
- 61 LQSTOR = LASTOR
- KQS = LQSTOR - LQASTO
- NQOFFS(JQSTOR+1) = KQS
- IQTABV(KQT+1) = LQSTOR
-
- LEND1 = LSTA + NWMEM
- LEND20 = LEND1 + NWEX
-
- NQDMAX(KQT+1) = NWMEM + NWEX
- LQSTA(KQT+1) = LSTA
- LQEND(KQT+1) = LEND1
- LQSTA(KQT+2) = LEND20
- LQEND(KQT+2) = LEND20
- LQSTA(KQT+20) = LEND20
- LQEND(KQT+20) = LEND20
- LQSTA(KQT+21) = LEND20
-#if defined(CERNLIB_QDEBPRI)
- IF (NQLOGL.GE.2)
- + WRITE (IQLOG,9089) JQSTOR,NQSNAM(1),NQSNAM(2),LASTOR
- +, LSTA,NWMEM,NWEX
- 9089 FORMAT (' MZATTM- Store',I3,' in ',2A4,' at adr',I12
- F/10X,'Memory starting at LSTA=',I8,' with',2I8,' words.')
-#endif
-
-#include "zebra/qtrace99.inc"
- RETURN
-
-C------ Error conditions
-
- 94 NQCASE = NQCASE + 1
- 93 NQCASE = NQCASE + 1
- 92 NQCASE = NQCASE + 1
- 91 NQCASE = NQCASE + 1
- NQFATA = 4
- IQUEST(11) = NQSNAM(1)
- IQUEST(12) = NQSNAM(2)
- IQUEST(13) = LEND20
- IQUEST(14) = IXSTOR
- JQSTOR = -1
-#include "zebra/qtofatal.inc"
- END
diff --git a/src/packlib/zebra/mq/mzbook.F b/src/packlib/zebra/mq/mzbook.F
deleted file mode 100644
index b0b474c..0000000
--- a/src/packlib/zebra/mq/mzbook.F
+++ /dev/null
@@ -1,65 +0,0 @@
-*
-* $Id: mzbook.F,v 1.3 1999/06/18 13:30:11 couet Exp $
-*
-* $Log: mzbook.F,v $
-* Revision 1.3 1999/06/18 13:30:11 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.2 1996/04/18 16:11:17 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:18 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE MZBOOK (IXP,LP,LSUPP,JBP, CHIDH,NL,NS,ND,NIOP,NZP)
-
-C- Book a bank, user called
-
-#include "zebra/zbcd.inc"
-#include "zebra/mqsys.inc"
-#include "zebra/mzcl.inc"
-*
- DIMENSION IXP(9),LP(9),LSUPP(9),JBP(9),NIOP(9),NZP(9)
- CHARACTER CHIDH*(*)
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HMZBO, 4HOK /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HMZBOOK /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'MZBOOK ')
-#endif
-
-#include "zebra/q_jbyt.inc"
-
-#include "zebra/qtrace.inc"
-
- NQID = IQQUES
- NIO = MIN (4, LEN(CHIDH))
- IF (NIO.NE.0) CALL UCTOH (CHIDH,NQID,4,NIO)
- NQNL = NL
- NQNS = NS
- NQND = ND
- NQBIA = JBP(1)
-
- IODORG = NIOP(1)
- NIO = JBYT (IODORG,12,4)
-
- IF (NIO.EQ.0) THEN
- NQIOCH(1) = IODORG
- ELSE
- CALL UCOPY (NIOP,NQIOCH,NIO+1)
- NQIOSV(1) = 0
- ENDIF
-
- CALL MZLIFT (IXP,LP,LSUPP,63, NQID, NZP)
-
-#include "zebra/qtrace99.inc"
- RETURN
- END
diff --git a/src/packlib/zebra/mq/mzcopy.F b/src/packlib/zebra/mq/mzcopy.F
deleted file mode 100644
index 0379325..0000000
--- a/src/packlib/zebra/mq/mzcopy.F
+++ /dev/null
@@ -1,403 +0,0 @@
-*
-* $Id: mzcopy.F,v 1.3 1999/06/18 13:30:11 couet Exp $
-*
-* $Log: mzcopy.F,v $
-* Revision 1.3 1999/06/18 13:30:11 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.2 1996/04/18 16:11:19 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:19 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE MZCOPY (IXDVFR,LENTP,IXDVTO,LSUPP,JBIASP,CHOPT)
-
-C- Copy a data-structure, User called
-
-#include "zebra/zbcd.inc"
-#include "zebra/zstate.inc"
-#include "zebra/zunit.inc"
-#include "zebra/zvfaut.inc"
-#include "zebra/mqsys.inc"
-#include "zebra/mzct.inc"
-#include "zebra/mzcn.inc"
-#include "zebra/fzcx.inc"
-*
- DIMENSION IXDVFR(9),LENTP(9),IXDVTO(9),LSUPP(9),JBIASP(9)
- CHARACTER CHOPT*(*)
- DIMENSION LADESV(6)
-#if defined(CERNLIB_QMVDS)
- SAVE LADESV
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HMZCO, 4HPY /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HMZCOPY /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'MZCOPY ')
-#endif
- DATA LADESV / 6, 5*0 /
-
-#include "zebra/q_locf.inc"
-
-#include "zebra/qtrace.inc"
-#if defined(CERNLIB_QDEBUG)
- IF (IQVSTA.NE.0) CALL ZVAUTX
-#endif
-
- LENTRX = LENTP(1)
- LSUP = LSUPP(1)
- NWBKFR = IQUEST(1)
- NOFFFR = IQUEST(2)
- NWBKMX = IQUEST(3)
- NOFFTO = IQUEST(4)
- CALL UOPTC (CHOPT,'DISZMLNPFT',IOPTXD)
- JFLGAX = 0
- IHANDL = 0
- NWBKU = -7
- LOGLEV = NQLOGD
-
-C---- TO option yes / no
-
- IF (IOPTXT.NE.0) THEN
- LOCTO = LOCF(IXDVTO(1)) - 1 - NOFFTO
- KSQTO = LOCTO - LQASTO
- JSTOTO = -2
- ELSE
- IXDIVI = IXDVTO(1)
- CALL MZSDIV (IXDIVI,7)
- IF (JQDIVI.EQ.0) GO TO 97
- KSQTO = KQS
- JSTOTO = JQSTOR
- JDIVTO = JQDIVI
- JDMODE = IQMODE(KQT+JQDIVI)
- NWBKMX = NQDMAX(KQT+JQDIVI)
- LOGLEV = MAX (LOGLEV,NQLOGL)
- LQSYSR(KQT+2) = LSUP
- ENDIF
-
-C---- FROM option yes / no
-
- IF (IOPTXF.NE.0) THEN
- LOCFR = LOCF(IXDVFR(1)) - 1 - NOFFFR
- KSQFR = LOCFR - LQASTO
- JSTOFR = -1
- NWBKX = NWBKFR
- IOPTXD = 1
- IOPTXL = 1
- ELSE
- IXDIVX = IXDVFR(1)
- CALL MZSDIV (IXDIVX,0)
- KSQFR = KQS
- JSTOFR = JQSTOR
- LOGLEV = MAX (LOGLEV,NQLOGL)
- LQSYSR(KQT+1) = LENTRX
- IF ((JSTOFR.EQ.JSTOTO).AND.(IOPTXZ.EQ.0)) IHANDL=-1
- ENDIF
-#if defined(CERNLIB_QDEBPRI)
- IF (LOGLEV.GE.2)
- + WRITE (IQLOG,9009) JSTOFR,JSTOTO,CHOPT
- 9009 FORMAT (' MZCOPY- Store From/To =',2I3,' Options = ',A)
-#endif
-
-C---------- Table building ----------------------
-
- 11 MODTBX = 1
- IQPART = 0
-
-C---- TO option yes / no
-
- JQSTMV = -1
- IF (IOPTXT.NE.0) GO TO 21
-
-C-- TO option no
-
- IF (NWBKU.GE.0) GO TO 21
- JQSTMV = JSTOTO
- JQDVM1 = JDIVTO
- JQDVM2 = JDIVTO
- NQDVMV = 1 - 2*JDMODE
- IQTNMV = -7
-
-C---- FROM option yes / no
-
- 21 IF (IOPTXF.EQ.0) GO TO 24
-
- JQGAPM = 0
- JQGAPR = 0
- LQRTA = LQWKTB
- LQTA = LQRTA + 2
- LQTE = LQTA + 4
- LQRTE = LQTE + 1
- LQMTA = LQRTE + 2
-
- LQ(LQTA) = NOFFFR + 1
- LQ(LQTA+1) = LQ(LQTA) + NWBKX
- GO TO 33
-
-C-- FROM option no
-
- 24 IF (JQSTOR.NE.JSTOFR) CALL MZSDIV (IXDIVX,0)
-
- CALL FZOTAB
- IF (IQUEST(1).EQ.0) GO TO 31
- IF (IQUEST(1).EQ.1) GO TO 11
- IF (IQUEST(2).NE.13) GO TO 91
- IF (JFLGAX.GE.3) GO TO 93
-
-C-- Collect garbage in the TO space, if no room
-
- JFLGAX = 3
- IF (JSTOTO.EQ.JQSTOR) GO TO 93
- IF (JSTOTO.LE.0) GO TO 93
-
- IXGARB = MZIXCO (IXDIVI,21,22,23)
- IXGARB = MZIXCO (IXGARB,24,0,0)
- CALL MZGARB (IXGARB,0)
- GO TO 11
-
-C---------- Reserve target space --------------------
-
- 31 CONTINUE
-#if defined(CERNLIB_QDEVZE)
- IF (NQDEVZ.LT.7) GO TO 33
- WRITE (IQLOG,9831) LQMTA,LQMTE
- 9831 FORMAT (1X/' DEVZE MZCOPY, Memory Occupation Table,'
- F,' LQMTA,LQMTE= ',2I8/16X,
- F' DIV ACT NWS LFBK LLBK+1 JFE JLE FREE')
-
- WRITE (IQLOG,9832) (LQ(J),J=LQMTA,LQMTE-1)
- 9832 FORMAT (16X,2I4,6I8)
-#endif
- 33 IF (NWBKX.GT.NWBKMX) GO TO 94
- IF (NWBKX.EQ.0) GO TO 95
- IF (IOPTXT.NE.0) GO TO 41
- IF (JQSTOR.NE.JSTOTO) CALL MZSDIV (IXDIVI,0)
- IF (NWBKU.GE.0) GO TO 37
-
- JQDIVI = JDIVTO
- CALL MZRESV
- NQRESV = NQRESV - NWBKX
- IF (NQRESV.LT.0) THEN
- CALL MZGAR1
- IQPART = -7
- IF (JSTOTO.EQ.JSTOFR) LENTRX=LQSYSR(KQT+1)
- ENDIF
-
- IF (JDMODE.EQ.0) THEN
- LTO = LQEND(KQT+JDIVTO)
- LTOE = LTO + NWBKX
- LQEND(KQT+JDIVTO) = LTOE
- ELSE
- LTOE = LQSTA(KQT+JDIVTO)
- LTO = LTOE - NWBKX
- LQSTA(KQT+JDIVTO) = LTO
- ENDIF
- IF (IQPART.EQ.0) GO TO 42
-
- LQ(KQS+LTO) = 12
- LQ(KQS+LTO+1) = 0
- LQ(KQS+LTO+2) = 0
- LQ(KQS+LTO+3) = 0
- LQ(KQS+LTO+4) = 0
- LQ(KQS+LTO+5) = IQLETT(1)
- LQ(KQS+LTO+6) = 0
- LQ(KQS+LTO+7) = 0
- LQ(KQS+LTO+8) = NWBKX - 10
- LQ(KQS+LTO+9) = 0
- NWBKU = NWBKX
- GO TO 11
-
-C---- Target space already reserved, get it
-
- 37 NDIF = NWBKX - NWBKU
- IF (JDMODE.EQ.0) THEN
- LTOE = LQEND(KQT+JDIVTO)
- LTO = LTOE - NWBKU
- IF (NDIF.EQ.0) GO TO 42
- LTOE = LTOE + NDIF
- LQEND(KQT+JDIVTO) = LTOE
- ELSE
- LTO = LQSTA(KQT+JDIVTO)
- LTOE = LTO + NWBKU
- IF (NDIF.EQ.0) GO TO 42
- LTO = LTO - NDIF
- LQSTA(KQT+JDIVTO) = LTO
- ENDIF
- GO TO 42
-
-C---------- Move material to destination -------------
-
-C-- TO option yes
-
- 41 LTO = NOFFTO + 1
- LTOE = LTO + NWBKX
- JQSTOR = -1
- LQSTOR = LOCTO
- KQS = KSQTO
- KQT = KQFT
-
- LQFSTA(1) = LTO
- LQFSTA(21) = LTOE
- GO TO 44
-
-C-- TO option no
-
- 42 NWBKU = NWBKX
- LSUP = LQSYSR(KQT+2)
-
- 44 LTOA = LTO
- NREL = LTO
- LFRE = 0
- LTB = LQTA
-
- 46 LFR = LQ(LTB)
- NREL = NREL - (LFR-LFRE)
- LFRE = LQ(LTB+1)
-
- LQ(LTB+2) = NREL
- LQ(LTB+3) = IHANDL
-
- NW = LFRE - LFR
- CALL UCOPY (LQ(KSQFR+LFR), LQ(KSQTO+LTO), NW)
- LTO = LTO + NW
- LTB = LTB + 4
- IF (LTB.LT.LQTE) GO TO 46
-
-C---------- Relocation ---------------------------
-
- LQ(LQMTA+1) = 1
- LQ(LQMTA+3) = LTOA
- LQ(LQMTA+4) = LTOE
- LQMTE = LQMTA + 8
- IF (IOPTXN.NE.0) GO TO 61
-
- LQ(LQTE) = LQ(LQTE-3)
- LQ(LQTA-1) = LQ(LQTA)
-
- IF (IHANDL.LT.0) THEN
-C-- retain links pointing outside the d/s
- IQFLIO = 0
- ELSE
-C-- zero links pointing outside
- IQFLIO = 7
- ENDIF
-#if defined(CERNLIB_QDEVZE)
- IF (NQDEVZ.LT.7) GO TO 56
- LQ(LQMTA) = 0
- LQ(LQMTA+2) = 0
- LQ(LQMTA+5) = 0
- LQ(LQMTA+6) = 0
- LQ(LQMTA+7) = 0
-
- WRITE (IQLOG,9853) LQRTA,LQTA,LQTE,LQ(LQTA-1)
- 9853 FORMAT (1X/' DEVZE MZCOPY, Link Relocation Table,'
- F,' LQRTA,LQTA,LQTE= ',3I8
- F/16X,' LOC L LE NREL BG'
- F/28X,I10)
-
- IF (LQTE.LE.LQTA) GO TO 55
- I = LQRTA
- JA = LQTA - I
- JE = LQTE - I - 1
- WRITE (IQLOG,9854) (J,LQ(I+J),LQ(I+J+1),LQ(I+J+2),LQ(I+J+3),
- + J=JA,JE,4)
- 9854 FORMAT (16X,I6,3I8,I4)
-
- 55 WRITE (IQLOG,9855) LQ(LQTE)
- 9855 FORMAT (20X,I10)
- 56 CONTINUE
-#endif
- CALL MZRELB
- IF (IQFLIO.LT.0) GO TO 96
-
-C-- Relocate the entry link
-
- LADESV(2) = LOCF(LENTRX) - LQSTOR
- LADESV(3) = LADESV(2) + 1
- LADESV(5) = IQLETT(9)
- LADESV(6) = IQLETT(15)
- CALL MZRELL (LADESV)
-
- IF (IOPTXL.EQ.0) LQ(KQS+LENTRX)=0
- LQ(KQS+LENTRX+1) = 0
- LQ(KQS+LENTRX+2) = 0
- GO TO 64
-
-C-- No-link option
-
- 61 CALL FZILIN
- IF (IQFOUL.NE.0) GO TO 96
- LENTRX = IQUEST(1)
-
-C---- Connect d/s
-
- 64 IF (IOPTXT.NE.0) THEN
- LSUPP(1) = LENTRX
- JBIASP(1) = NWBKX
- ELSE
- JB = JBIASP(1)
- LSUPP(1) = LQSYSR(KQT+2)
- CALL ZSHUNT (IXDIVI,LENTRX,LSUPP,JB,1)
- ENDIF
-
- IQUEST(1) = 0
- IQUEST(2) = NWBKX
-#include "zebra/qtrace99.inc"
- RETURN
-
-C---------- Error conditions -----------------------
-
-C-- LENTRX invalid / Bank chaning clobbered in FZOTAB
-
- 91 IQUEST(2) = IQUEST(2) - 10
- GO TO 98
-
-C-- Not enough table space
-
- 93 IQUEST(2) = 3
- GO TO 98
-
-C-- D/s larger than the target space
-
- 94 IQUEST(2) = 4
- IQUEST(11) = NWBKX
- IQUEST(12)= NWBKMX
- GO TO 98
-
-C-- D/s empty
-
- 95 IQUEST(2) = 5
- GO TO 98
-
-C-- MZRELB or FZILIN find bank chaining clobbered
-
- 96 IQUEST(2) = 6
- GO TO 98
-
-C-- Target division not specified
-
- 97 IQUEST(2) = 7
-
- 98 CONTINUE
- IF (NWBKU.GE.0) THEN
- IF (JQSTOR.NE.JSTOTO) CALL MZSDIV (IXDIVI,0)
- IF (JDMODE.EQ.0) THEN
- LQEND(KQT+JDIVTO) = LQEND(KQT+JDIVTO) - NWBKU
- ELSE
- LQSTA(KQT+JDIVTO) = LQSTA(KQT+JDIVTO) + NWBKU
- ENDIF
- ENDIF
-
- IF (IOPTXP.EQ.0) CALL ZTELL (15,1)
- IQUEST(1) = IQUEST(2)
- GO TO 999
- END
diff --git a/src/packlib/zebra/mq/mzdiv.F b/src/packlib/zebra/mq/mzdiv.F
deleted file mode 100644
index 35fc1d1..0000000
--- a/src/packlib/zebra/mq/mzdiv.F
+++ /dev/null
@@ -1,236 +0,0 @@
-*
-* $Id: mzdiv.F,v 1.3 1999/06/18 13:30:11 couet Exp $
-*
-* $Log: mzdiv.F,v $
-* Revision 1.3 1999/06/18 13:30:11 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.2 1996/04/18 16:11:22 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:18 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE MZDIV (IXSTOR,IXDIV,CHNAME,NWAP,NWMP,CHOPT)
-
-C- Create new division, user called
-
-#include "zebra/zbcd.inc"
-#include "zebra/zstate.inc"
-#include "zebra/zunit.inc"
-#include "zebra/zvfaut.inc"
-#include "zebra/mqsys.inc"
-#include "zebra/mzct.inc"
-*
- DIMENSION IXDIV(9),NWAP(9),NWMP(9)
- CHARACTER *(*) CHNAME, CHOPT
- DIMENSION NAME(2)
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HMZDI, 4HV /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HMZDIV /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'MZDIV ')
-#endif
-
-#include "zebra/q_jbit.inc"
-#include "zebra/q_jbyt.inc"
-#include "zebra/q_sbit1.inc"
-#include "zebra/q_sbyt.inc"
-#include "zebra/q_shiftl.inc"
-
-
-#include "zebra/qtrace.inc"
-
- NWALLO = NWAP(1)
- NWMAX = NWMP(1)
- CALL UOPTC (CHOPT,'RMLPC',IQUEST)
- MODE = IQUEST(1) + 2*IQUEST(2)
- KIND = MIN (2, IQUEST(3)+2*IQUEST(4)) + 1
- IOPTC = IQUEST(5)
-
-C-- Printing name of division
-
- NAME(1) = IQBLAN
- NAME(2) = IQBLAN
- N = MIN (8, LEN(CHNAME))
- IF (N.NE.0) CALL UCTOH (CHNAME,NAME,4,N)
-
-#include "zebra/qstore.inc"
-
-C-- option M, match mode of new division to neighbour
-
- IF (MODE.LT.2) GO TO 29
- MODE = 0
- IF (KIND.GE.2) GO TO 24
- IF (JQDVLL.EQ.2) GO TO 29
- IF (IQMODE(KQT+JQDVLL).NE.0) GO TO 29
- GO TO 28
-
- 24 IF (JQDVSY.EQ.20) GO TO 28
- IF (IQMODE(KQT+JQDVSY+1).NE.0) GO TO 29
- 28 MODE = 1
- 29 CONTINUE
-
-#if defined(CERNLIB_QPRINT)
- IF (NQLOGL.GE.0)
- +WRITE (IQLOG,9029) NAME,JQSTOR,NWALLO,NWMAX,MODE,KIND
- 9029 FORMAT (1X/' MZDIV. Initialize Division ',2A4,' in Store',I3
- F/10X,'NW/NWMAX=',2I7,', MODE/KIND=',2I3)
-#endif
-#if defined(CERNLIB_QDEBUG)
- IF (IQVSTA.NE.0) CALL ZVAUTX
-#endif
-
-C-- Check parameters
-
- IF (NWALLO.LT.100) GO TO 91
- IF (NWMAX .LT.NWALLO) GO TO 91
- IF (MODE .LT.0) GO TO 91
- IF (MODE .GE.2) GO TO 91
- IF (KIND .LT.0) GO TO 91
- IF (KIND .GE.4) GO TO 91
- IF (JQDVLL+1.EQ.JQDVSY) GO TO 92
-
-C---- Push down low divisions, and maybe system division
-
- MQDVGA = 0
- MQDVWI = 0
- NQDVMV = -NWALLO
- IQTNMV = 0
- JQSTMV = JQSTOR
- JQDVM1 = 2
- IF (KIND.LT.2) THEN
- KIND = 1
- JQDVM2 = JQDVLL
- ELSE
- JQDVM2 = JQDVSY
- MQDVGA = MSBIT1 (MQDVGA,JQDVSY)
- ENDIF
- JQDIVI = JQDVM2
- NRESV1 = LQSTA(KQT+2) - LQEND(KQT+1) - NQMINR
- NRESV2 = LQEND(KQT+2) - LQ2END
- NQRESV = MIN (NRESV1,NRESV2) + NQDVMV
- IF (NQRESV.LT.0) GO TO 93
-
- CALL MZTABM
- CALL MZTABS
- CALL MZTABR
- CALL MZTABX
- CALL MZTABF
- CALL MZRELX
- CALL MZMOVE
-
-C-- Create high division, re-number system division
-
- IF (JQDIVI.NE.JQDVSY) GO TO 61
- JQDVSY = JQDVSY - 1
-
- LQSTA(KQT+JQDVSY) = LQSTA(KQT+JQDVSY+1)
- LQEND(KQT+JQDVSY) = LQEND(KQT+JQDVSY+1)
- NQDMAX(KQT+JQDVSY) = NQDMAX(KQT+JQDVSY+1)
- IQMODE(KQT+JQDVSY) = IQMODE(KQT+JQDVSY+1)
- IQKIND(KQT+JQDVSY) = IQKIND(KQT+JQDVSY+1)
- IQRTO(KQT+JQDVSY) = IQRTO(KQT+JQDVSY+1)
- IQRNO(KQT+JQDVSY) = IQRNO(KQT+JQDVSY+1)
- NQDINI(KQT+JQDVSY) = NQDINI(KQT+JQDVSY+1)
- NQDWIP(KQT+JQDVSY) = NQDWIP(KQT+JQDVSY+1)
- NQDGAU(KQT+JQDVSY) = NQDGAU(KQT+JQDVSY+1)
- NQDGAF(KQT+JQDVSY) = NQDGAF(KQT+JQDVSY+1)
- NQDPSH(KQT+JQDVSY) = NQDPSH(KQT+JQDVSY+1)
- NQDRED(KQT+JQDVSY) = NQDRED(KQT+JQDVSY+1)
- NQDSIZ(KQT+JQDVSY) = NQDSIZ(KQT+JQDVSY+1)
- IQDN1(KQT+JQDVSY) = IQDN1(KQT+JQDVSY+1)
- IQDN2(KQT+JQDVSY) = IQDN2(KQT+JQDVSY+1)
-
- NQDWIP(KQT+JQDIVI) = 0
- NQDGAU(KQT+JQDIVI) = 0
- NQDGAF(KQT+JQDIVI) = 0
- NQDPSH(KQT+JQDIVI) = 0
- NQDRED(KQT+JQDIVI) = 0
- NQDSIZ(KQT+JQDIVI) = 0
-
- LSTA = LQEND(KQT+JQDVSY)
- GO TO 64
-
-C-- Create low division JQDVLL
-
- 61 LSTA = LQEND(KQT+JQDVLL)
- MOLL = JBIT (IQMODE(KQT+JQDVLL),1)
-
- JQDVLL = JQDVLL + 1
- JQDIVI = JQDVLL
- IF (MOLL.EQ.0) THEN
- LSTA = MAX (LSTA, LQSTA(KQT+JQDVLL-1)+IQTABV(KQT+15))
- LSTA = MIN (LSTA, LQSTA(KQT+JQDVSY)-NWALLO)
- ENDIF
- IQTABV(KQT+15) = NWALLO
-
-C-- Update store tables
-
- 64 IF (MODE.NE.0) LSTA=LSTA+NWALLO
-
- MKIND = MSBIT1 (0,JQDIVI)
- MKIND = MSBIT1 (MKIND,20+KIND)
-
- MREF = 0
- IF (KIND.GE.3) GO TO 65
- IF (IOPTC.NE.0) GO TO 65
- MREF = ISHFTL (3, 20)
-
- 65 LQSTA(KQT+JQDIVI) = LSTA
- LQEND(KQT+JQDIVI) = LSTA
- NQDMAX(KQT+JQDIVI) = NWMAX
- IQMODE(KQT+JQDIVI) = MODE
- IQKIND(KQT+JQDIVI) = MKIND
- IQRTO(KQT+JQDIVI) = MREF
- IQRNO(KQT+JQDIVI) = 9437183
- NQDINI(KQT+JQDIVI) = NWALLO
- IQDN1(KQT+JQDIVI) = NAME(1)
- IQDN2(KQT+JQDIVI) = NAME(2)
-
- IQTABV(KQT+8) = JQDVLL
- IQTABV(KQT+9) = JQDVSY
- CALL MZXRUP
-
-
-C-- Return IXDIV
-
-#if defined(CERNLIB_QPRINT)
- IF (NQLOGL.GE.0)
- +WRITE (IQLOG,9079) JQDIVI
- 9079 FORMAT (10X,'Division',I3,' initialized.')
-#endif
-
- IXDIV(1) = MSBYT (JQSTOR,JQDIVI,27,4)
-#include "zebra/qtrace99.inc"
- RETURN
-
-C------ Error conditions
-
- 93 NQCASE = 1
- NQFATA = 4
- IQUEST(18) = NQRESV
- IQUEST(19) = -NQDVMV
- IQUEST(20) = NRESV1
- IQUEST(21) = NRESV2
-
- 92 NQCASE = NQCASE + 1
- 91 NQCASE = NQCASE + 1
- NQFATA = NQFATA + 7
- IQUEST(11) = NAME(1)
- IQUEST(12) = NAME(2)
- IQUEST(13) = NWALLO
- IQUEST(14) = NWMAX
- IQUEST(15) = MODE
- IQUEST(16) = KIND
- IQUEST(17) = IOPTC
-#include "zebra/qtofatal.inc"
- END
diff --git a/src/packlib/zebra/mq/mzdred.F b/src/packlib/zebra/mq/mzdred.F
deleted file mode 100644
index 60fe110..0000000
--- a/src/packlib/zebra/mq/mzdred.F
+++ /dev/null
@@ -1,109 +0,0 @@
-*
-* $Id: mzdred.F,v 1.2 1999/06/18 13:30:12 couet Exp $
-*
-* $Log: mzdred.F,v $
-* Revision 1.2 1999/06/18 13:30:12 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:19 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE MZDRED (IXDIVP)
-
-C- Reduce space reserved for division to initial size,
-C- but not smaller than current occupation
-
-#include "zebra/zstate.inc"
-#include "zebra/zunit.inc"
-#include "zebra/zvfaut.inc"
-#include "zebra/mqsys.inc"
-#include "zebra/mzct.inc"
-*
- DIMENSION IXDIVP(9)
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HMZDR, 4HED /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HMZDRED /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'MZDRED ')
-#endif
-
-
-#include "zebra/qtrace.inc"
-
- CALL MZSDIV (IXDIVP,4)
- IF (JQDIVI.LT.3) GO TO 999
- CALL MZRESV
-
-#if defined(CERNLIB_QDEBPRI)
- IF (NQLOGL.GE.1) WRITE (IQLOG,9028) JQSTOR,JQDIVI,NQRESV
- 9028 FORMAT (' MZDRED- called for Store/Div',2I3,' Free',I7)
-#endif
-#if defined(CERNLIB_QDEVZE)
- IF (NQDEVZ.NE.0) WRITE (IQLOG,9829) JQDIVI,JQSHAR,NQRESV
- 9829 FORMAT (1X/' DEVZE MZDRED entered, JQDIVI,JQSHAR,NQRESV= ',3I8)
-#endif
-#if defined(CERNLIB_QDEBUG)
- IF (IQVSTA.NE.0) CALL ZVAUTX
-#endif
-C---- Construct Memory Occupation table
-
- MQDVGA = 0
- MQDVWI = 0
- JQSTMV = -1
- CALL MZTABM
-
-C---- Shift divisions
-
- IF (JQSHAR.NE.0) THEN
- NFREE = MIN (NQRESV,
- + LQEND(KQT+JQSHR2)-LQSTA(KQT+JQSHR1)
- + - (NQDINI(KQT+JQDIVI)+NQDINI(KQT+JQDIVN)) )
- ELSE
- NFREE = NQRESV - MAX (0, NQDINI(KQT+JQDIVI) -
- + (LQEND(KQT+JQDIVI)-LQSTA(KQT+JQDIVI)) )
- ENDIF
-
- IF (NFREE.LE.24) GO TO 999
-
-C-- Forward division
-
- IF (JQMODE.EQ.0) THEN
- JQDVM2 = JQDIVI
- ELSE
-
-C-- Reverse division
-
- JQDVM2 = JQDIVN
- ENDIF
-
- JQDVM1 = 2
- JQSTMV = JQSTOR
- NQDVMV = NFREE
-
-#if defined(CERNLIB_QDEVZE)
- IF (NQDEVZ.NE.0) WRITE (IQLOG,9836) JQDVM1,JQDVM2,NQDVMV
- 9836 FORMAT (' DEVZE MZDRED, JQDVM1,JQDVM2,NQDVMV= ',3I8)
-#endif
-C-- Construct Link Relocation table
-
- CALL MZTABR
- CALL MZTABS
-
-C---- Relocate + memory move
-
- CALL MZTABX
- CALL MZTABF
- CALL MZRELX
- CALL MZMOVE
- NQDRED(KQT+JQDIVI) = NQDRED(KQT+JQDIVI) + 1
-#include "zebra/qtrace99.inc"
- RETURN
- END
diff --git a/src/packlib/zebra/mq/mzdrop.F b/src/packlib/zebra/mq/mzdrop.F
deleted file mode 100644
index 00039cb..0000000
--- a/src/packlib/zebra/mq/mzdrop.F
+++ /dev/null
@@ -1,114 +0,0 @@
-*
-* $Id: mzdrop.F,v 1.3 1999/06/18 13:30:12 couet Exp $
-*
-* $Log: mzdrop.F,v $
-* Revision 1.3 1999/06/18 13:30:12 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.2 1996/04/18 16:11:24 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:18 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE MZDROP (IXSTOR,LHEADP,CHOPT)
-
-C- Drop d/s supported by bank at LHEAD, user called
-
-#include "zebra/zstate.inc"
-#include "zebra/zunit.inc"
-#include "zebra/zvfaut.inc"
-#include "zebra/mqsys.inc"
-#include "zebra/mzcn.inc"
-*
- DIMENSION LHEADP(9)
- CHARACTER *(*) CHOPT
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HMZDR, 4HOP /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HMZDROP /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'MZDROP ')
-#endif
-
-#include "zebra/q_jbyt.inc"
-
-
- LHEAD = LHEADP(1)
- IF (LHEAD.EQ.0) RETURN
-
-#include "zebra/qtrace.inc"
-#include "zebra/qstore.inc"
-#if defined(CERNLIB_QDEBUG)
- IF (IQVSTA.NE.0) CALL ZVAUTX
-#endif
-
- CALL UOPTC (CHOPT,'LV',IQUEST)
- IFLAG = IQUEST(1)
- IF (IQUEST(2).NE.0) IFLAG=-1
-
-#if defined(CERNLIB_QDEBUG)
- CALL MZCHLS (-7,LHEAD)
- IF (IQFOUL.NE.0) GO TO 91
-#endif
-#if !defined(CERNLIB_QDEBUG)
- IQNS = IQ(KQS+LHEAD-2)
-#endif
-#if defined(CERNLIB_QDEBPRI)
- IF (NQLOGL.LT.2) GO TO 19
- WRITE (IQLOG,9018) JQSTOR,LHEAD,IQID,CHOPT
- 9018 FORMAT (' MZDROP- Store',I3,' L/ID=',I9,1X,A4,' Opt=',A)
-#endif
-
- 19 KHEAD = LQ(KQS+LHEAD+2)
-
-C-- Drop dependents only, not bank itself
-
- 21 IF (IFLAG) 22, 31, 41
- 22 NS = IQNS
- CALL MZFLAG (IXSTOR,LHEAD,IQDROP,'V')
- CALL VZERO (LQ(KQS+LHEAD-NS),NS)
- GO TO 999
-
-C-- Drop bank + dependents, but not successors
-
- 31 CALL MZFLAG (IXSTOR,LHEAD,IQDROP,'.')
- LN = LQ(KQS+LHEAD)
- IF (LN.EQ.0) GO TO 88
- IF (LN.EQ.LHEAD) GO TO 88
-#if defined(CERNLIB_QDEBUG)
- CALL MZCHLS (-7,LN)
- IF (IQFOUL.NE.0) GO TO 92
-#endif
- IF (KHEAD.NE.0) LQ(KQS+KHEAD)=LN
- LQ(KQS+LN+2) = KHEAD
- GO TO 999
-
-C-- Drop whole linear structure with all dependents
-
- 41 CALL MZFLAG (IXSTOR,LHEAD,IQDROP,'L')
-
- 88 IF (KHEAD.NE.0) LQ(KQS+KHEAD)=0
-
-#include "zebra/qtrace99.inc"
- RETURN
-
-C------ Error conditions
-
-#if defined(CERNLIB_QDEBUG)
- 92 NQCASE = 1
- NQFATA = 1
- IQUEST(12) = LN
- 91 NQCASE = NQCASE + 1
- NQFATA = NQFATA + 1
- IQUEST(11) = LHEAD
-#include "zebra/qtofatal.inc"
-#endif
- END
diff --git a/src/packlib/zebra/mq/mzebcd1.inc b/src/packlib/zebra/mq/mzebcd1.inc
deleted file mode 100644
index 3561ed9..0000000
--- a/src/packlib/zebra/mq/mzebcd1.inc
+++ /dev/null
@@ -1,82 +0,0 @@
-*
-* $Id: mzebcd1.inc,v 1.2 1997/03/14 17:20:19 mclareni Exp $
-*
-* $Log: mzebcd1.inc,v $
-* Revision 1.2 1997/03/14 17:20:19 mclareni
-* WNT mods
-*
-* Revision 1.1.1.1.2.1 1997/01/21 11:33:46 mclareni
-* All mods for Winnt 96a on winnt branch
-*
-* Revision 1.1.1.1 1996/03/06 10:47:17 mclareni
-* Zebra
-*
-*
-*
-* mzebcd1.inc
-*
-#if defined(CERNLIB_ALLIANT)
- CQALLC(48:64) = '#''!:"_]&@?[>< ^;%'
- CQALLC(61:61) = CHAR(92)
-
-#elif defined(CERNLIB_CDC)
- CQALLC(48:64) = '#''!:"_]&@?[>< ^;:'
-
-#elif defined(CERNLIB_MSDOS) || defined(CERNLIB_WINNT)
- CQALLC(48:64) = '#''!:"_]&@?[>< ^;%'
- CQALLC(61:61) = CHAR(92)
-
-#elif defined(CERNLIB_HPUX)
- CQALLC(48:64) = '#''!:"_]&@?[>< ^;%'
- CQALLC(61:61) = CHAR(92)
-
-#elif defined(CERNLIB_IBMAIX)
- CQALLC(48:64) = '#''!:"_]&@?[>< ^;%'
- CQALLC(61:61) = CHAR(92)
-
-#elif defined(CERNLIB_IBMRT)
- CQALLC(48:64) = '#''!:"_]&@?[>< ^;%'
-
-#elif defined(CERNLIB_IBMRTD)
- CQALLC(48:64) = '#''!:"_]&@?[>< ^;%'
-
-#elif defined(CERNLIB_LINUX)
- CQALLC(48:64) = '#''!:"_]&@?[>< ^;%'
- CQALLC(61:61) = CHAR(92)
-
-#elif defined(CERNLIB_MACMPW)
- CQALLC(48:64) = '#''!:"_]&@?[>< ^;%'
- CQALLC(61:61) = CHAR(92)
-
-#elif defined(CERNLIB_NEXT)
- CQALLC(48:64) = '#''!:"_]&@?[>< ^;%'
- CQALLC(61:61) = CHAR(92)
-
-#elif defined(CERNLIB_OS9)
- CQALLC(48:64) = '#''!:"_]&@?[>< ^;%'
- CQALLC(61:61) = CHAR(92)
-
-#elif defined(CERNLIB_SGI)
- CQALLC(48:64) = '#''!:"_]&@?[>< ^;%'
- CQALLC(61:61) = CHAR(92)
-
-#elif defined(CERNLIB_SUN)
- CQALLC(48:64) = '#''!:"_]&@?[>< ^;%'
- CQALLC(61:61) = CHAR(92)
-
-#elif defined(CERNLIB_TMO)
- CQALLC(48:64) = '#''!:"_]&@?[>< ^;%'
- CQALLC(61:61) = CHAR(92)
-
-#elif defined(CERNLIB_DECS)
- CQALLC(48:64) = '#''!:"_]&@?[>< ^;%'
- CQALLC(61:61) = CHAR(92)
-
-#elif defined(CERNLIB_QMVDS)
- CQALLC(48:64) = '#''!:"_]&@?[>< ^;%'
- CQALLC(61:61) = CHAR(92)
-
-#elif 1
- CQALLC(48:64) = '#''!:"_]&@?[>< ^;%'
-
-#endif
diff --git a/src/packlib/zebra/mq/mzebra.F b/src/packlib/zebra/mq/mzebra.F
deleted file mode 100644
index aa267a8..0000000
--- a/src/packlib/zebra/mq/mzebra.F
+++ /dev/null
@@ -1,102 +0,0 @@
-*
-* $Id: mzebra.F,v 1.4 1999/06/18 13:30:12 couet Exp $
-*
-* $Log: mzebra.F,v $
-* Revision 1.4 1999/06/18 13:30:12 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.3 1999/06/18 12:04:45 couet
-* - The version is now defined in one central place
-*
-* Revision 1.2 1996/04/18 16:11:25 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:17 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE MZEBRA (LIST)
-
-C- Initialise memory manager, user called
-
-#include "zebra/zbcd.inc"
-#include "zebra/zbcdch.inc"
-#include "zebra/zceta.inc"
-#include "zebra/zheadp.inc"
-#include "zebra/zmach.inc"
-#include "zebra/znatur.inc"
-#include "zebra/zstate.inc"
-#include "zebra/zunit.inc"
-#include "zebra/mqsysh.inc"
-#include "zebra/mzcl.inc"
-#include "zebra/jzuc.inc"
-#include "zebra/rzcount.inc"
-#include "zebra/rzclun.inc"
-#include "zebra/rzcstr.inc"
-*
- CHARACTER*4 CVERSN
- DIMENSION LIST(9), INKEYS(3)
- CHARACTER VIDQQ*20
-
-#if defined(CERNLIB_QMVDS)
- SAVE INIT, INKEYS
-#endif
-#include "zebra/zfatalch.inc"
-#if defined(CERNLIB_QHOLL)
- DATA INKEYS / 4HEBRA, 4HINIT, 4HDONE /
-#endif
-#if !defined(CERNLIB_QHOLL)
- DATA INKEYS / 2345432, 3456543, 4567654 /
-#endif
-*
-#include "zebra/qversion.inc"
- WRITE(CVERSN,'(F4.2)') QVERSN
- VIDQQ = '@(#)ZEMQ '//CVERSN//'>'
-*
-C-- Check re-entry to MZEBRA
-C
-C DO 11 J=1,3
-C IF (MQKEYS(J).NE.INKEYS(J)) GO TO 12
-C 11 CONTINUE
-C RETURN
- CALL CLEFT (VIDQQ,1,0)
-
- 12 NQSTOR = -1
- JQSTOR = -99
- CALL VZERO (NQOFFT,66)
-
-C-- Initialize all passive COMMONs
-
- CALL MZINCO (LIST)
- NQDCUT = 201
- NQWCUT = 500
-
- CALL UCOPY (INKEYS,MQKEYS,3)
-
-C---- Clear /MZCL/, /JZUC/, /RZCOUNT/, /RZCSTR/
-
- CALL VZERO (NQLN, 28)
- CALL VZERO (LQJZ, 16)
- CALL VZERO (NSTRIP, MAXFILES)
- JQLEV = -1
-
- RZXIO(1) = 0.
- RZXIO(2) = 0.
-
- IMODEH = 0
-
- CALL VFILL (IQFENC,4,IQNIL)
-
-
-C---- Test validity of ZFATAL
-
- NQINIT = INIT
- CALL ZFATAL
- CALL ZFATAM ('.')
- NQINIT = -1
-C- force loading for "what"
- IF (NQSTOR.EQ.99) CALL MZVERS
- RETURN
- END
diff --git a/src/packlib/zebra/mq/mzend.F b/src/packlib/zebra/mq/mzend.F
deleted file mode 100644
index fd06807..0000000
--- a/src/packlib/zebra/mq/mzend.F
+++ /dev/null
@@ -1,46 +0,0 @@
-*
-* $Id: mzend.F,v 1.3 1999/06/18 13:30:13 couet Exp $
-*
-* $Log: mzend.F,v $
-* Revision 1.3 1999/06/18 13:30:13 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.2 1996/04/18 16:11:27 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:17 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE MZEND
-
-C- Memory manager termination, user called
-
-#include "zebra/zbcd.inc"
-#include "zebra/zmach.inc"
-#include "zebra/zstate.inc"
-#include "zebra/zunit.inc"
-#include "zebra/mqsys.inc"
-*
-
-#include "zebra/q_shiftl.inc"
-
- NSTORS = NQSTOR + 1
- IF (NQSTOR.LT.0) RETURN
- IF (NQSTOR.GE.16) RETURN
-
- WRITE (IQLOG,9001) NSTORS
- 9001 FORMAT (1X/' MZEND. Usage statistics for',I3,' dynamic stores.')
-
- JSTO = 0
- 21 JDIV = ISHFTL (JSTO,26)
-
- CALL MZSDIV (JDIV,-7)
- CALL MZMAPS
-
- JSTO = JSTO + 1
- IF (JSTO.LE.NQSTOR) GO TO 21
- RETURN
- END
diff --git a/src/packlib/zebra/mq/mzeunit.inc b/src/packlib/zebra/mq/mzeunit.inc
deleted file mode 100644
index 9b1e6a8..0000000
--- a/src/packlib/zebra/mq/mzeunit.inc
+++ /dev/null
@@ -1,130 +0,0 @@
-*
-* $Id: mzeunit.inc,v 1.2 1997/03/14 17:20:20 mclareni Exp $
-*
-* $Log: mzeunit.inc,v $
-* Revision 1.2 1997/03/14 17:20:20 mclareni
-* WNT mods
-*
-* Revision 1.1.1.1.2.1 1997/01/21 11:33:46 mclareni
-* All mods for Winnt 96a on winnt branch
-*
-* Revision 1.1.1.1 1996/03/06 10:47:17 mclareni
-* Zebra
-*
-*
-*
-* mzeunit.inc
-*
-#if defined(CERNLIB_ALLIANT)
- IQREAD = 2
- IQPRNT = 3
- IQPNCH = 4
-
-#elif defined(CERNLIB_APOLLO)
- IQREAD = 5
- IQPRNT = 6
- IQPNCH = 3
-
-#elif defined(CERNLIB_CDC)
- IQREAD = L"INPUT"
- IQPRNT = L"OUTPUT"
- IQPNCH = L"PUNCH"
-
-#elif (defined(CERNLIB_CRAY))&&!defined(CERNLIB_QMCRU)
- IQREAD = 3L$IN
- IQPRNT = 4L$OUT
- IQPNCH = 6L$PUNCH
-
-#elif defined(CERNLIB_DGE)
- IQREAD = 1
- IQPRNT = 2
- IQPNCH = 3
-
-#elif defined(CERNLIB_MSDOS) || defined(CERNLIB_WINNT)
- IQREAD = 2
- IQPRNT = 3
- IQPNCH = 4
-
-#elif defined(CERNLIB_HPUX)
- IQREAD = 2
- IQPRNT = 3
- IQPNCH = 4
-
-#elif defined(CERNLIB_IBMAIX)
- IQREAD = 2
- IQPRNT = 3
- IQPNCH = 4
-
-#elif defined(CERNLIB_IBMRT)
- IQREAD = 2
- IQPRNT = 3
- IQPNCH = 4
-
-#elif defined(CERNLIB_IBMRTD)
- IQREAD = 2
- IQPRNT = 3
- IQPNCH = 4
-
-#elif defined(CERNLIB_LINUX)
- IQREAD = 2
- IQPRNT = 3
- IQPNCH = 4
-
-
-#elif defined(CERNLIB_MACMPW)
- IQREAD = 2
- IQPRNT = 3
- IQPNCH = 4
-
-
-#elif defined(CERNLIB_NEXT)
- IQREAD = 2
- IQPRNT = 3
- IQPNCH = 4
-
-#elif defined(CERNLIB_OS9)
- IQREAD = 2
- IQPRNT = 3
- IQPNCH = 4
-
-#elif defined(CERNLIB_PDP)
- IQREAD = 1
- IQPRNT = 3
- IQPNCH = 20
-
-#elif defined(CERNLIB_SGI)
- IQREAD = 2
- IQPRNT = 3
- IQPNCH = 4
-
-#elif defined(CERNLIB_SUN)
- IQREAD = 2
- IQPRNT = 3
- IQPNCH = 4
-
-#elif defined(CERNLIB_TMO)
- IQREAD = 2
- IQPRNT = 3
- IQPNCH = 4
-
-#elif defined(CERNLIB_VAXVMS)
- IQREAD = 2
- IQPRNT = 3
- IQPNCH = 4
-
-#elif defined(CERNLIB_DECS)
- IQREAD = 2
- IQPRNT = 3
- IQPNCH = 4
-
-#elif defined(CERNLIB_QMVDS)
- IQREAD = 5
- IQPRNT = 6
- IQPNCH = 3
-
-#elif 1
- IQREAD = 5
- IQPRNT = 6
- IQPNCH = 7
-
-#endif
diff --git a/src/packlib/zebra/mq/mzeunit2.inc b/src/packlib/zebra/mq/mzeunit2.inc
deleted file mode 100644
index 7caa6b7..0000000
--- a/src/packlib/zebra/mq/mzeunit2.inc
+++ /dev/null
@@ -1,106 +0,0 @@
-*
-* $Id: mzeunit2.inc,v 1.2 1997/03/14 17:20:20 mclareni Exp $
-*
-* $Log: mzeunit2.inc,v $
-* Revision 1.2 1997/03/14 17:20:20 mclareni
-* WNT mods
-*
-* Revision 1.1.1.1.2.1 1997/01/21 11:33:47 mclareni
-* All mods for Winnt 96a on winnt branch
-*
-* Revision 1.1.1.1 1996/03/06 10:47:17 mclareni
-* Zebra
-*
-*
-*
-* mzeunit2.inc
-*
-#if defined(CERNLIB_ALLIANT)
- IQTTIN = 5
- IQTYPE = 6
-
-#elif defined(CERNLIB_APOLLO)
- IQTTIN = 5
- IQTYPE = 6
-
-#elif defined(CERNLIB_CONVEX)
- IQTTIN = 5
- IQTYPE = 6
-
-#elif defined(CERNLIB_DGE)
- IQTTIN = 5
- IQTYPE = 6
-
-#elif defined(CERNLIB_MSDOS) || defined(CERNLIB_WINNT)
- IQTTIN = 5
- IQTYPE = 6
-
-#elif defined(CERNLIB_HPUX)
- IQTTIN = 5
- IQTYPE = 6
-
-#elif defined(CERNLIB_IBMAIX)
- IQTTIN = 5
- IQTYPE = 6
-
-#elif defined(CERNLIB_IBMRT)
- IQTTIN = 5
- IQTYPE = 6
-
-#elif defined(CERNLIB_IBMRTD)
- IQTTIN = 5
- IQTYPE = 6
-
-#elif defined(CERNLIB_LINUX)
- IQTTIN = 5
- IQTYPE = 6
-
-#elif defined(CERNLIB_MACMPW)
- IQTTIN = 5
- IQTYPE = 6
-
-#elif defined(CERNLIB_NEXT)
- IQTTIN = 5
- IQTYPE = 6
-
-#elif defined(CERNLIB_NORD)
- IQTTIN = 1
- IQTYPE = 1
-
-#elif defined(CERNLIB_OS9)
- IQTTIN = 5
- IQTYPE = 6
-
-#elif defined(CERNLIB_PDP)
- IQTTIN = 5
- IQTYPE = 5
-
-#elif defined(CERNLIB_SGI)
- IQTTIN = 5
- IQTYPE = 6
-
-#elif defined(CERNLIB_SUN)
- IQTTIN = 5
- IQTYPE = 6
-
-#elif defined(CERNLIB_TMO)
- IQTTIN = 5
- IQTYPE = 6
-
-#elif defined(CERNLIB_VAXVMS)
- IQTTIN = 5
- IQTYPE = 6
-
-#elif defined(CERNLIB_DECS)
- IQTTIN = 5
- IQTYPE = 6
-
-#elif defined(CERNLIB_QMVDS)
- IQTTIN = 1
- IQTYPE = 1
-
-#elif 1
- IQTTIN = 0
- IQTYPE = 0
-
-#endif
diff --git a/src/packlib/zebra/mq/mzflag.F b/src/packlib/zebra/mq/mzflag.F
deleted file mode 100644
index 0b7f6de..0000000
--- a/src/packlib/zebra/mq/mzflag.F
+++ /dev/null
@@ -1,212 +0,0 @@
-*
-* $Id: mzflag.F,v 1.3 1999/06/18 13:30:13 couet Exp $
-*
-* $Log: mzflag.F,v $
-* Revision 1.3 1999/06/18 13:30:13 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.2 1996/04/18 16:11:32 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:19 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE MZFLAG (IXSTOR,LHEADP,KBITP,CHOPT)
-
-C- Run through d/s to set status-bit, user called
-
-#include "zebra/zlimit.inc"
-#include "zebra/zstate.inc"
-#include "zebra/zunit.inc"
-#include "zebra/zvfaut.inc"
-#include "zebra/mqsys.inc"
-#include "zebra/mzcn.inc"
-#include "zebra/mzcwk.inc"
-*
- DIMENSION KBITP(9),LHEADP(9)
- CHARACTER *(*) CHOPT
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HMZFL, 4HAG /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HMZFLAG /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'MZFLAG ')
-#endif
-
-#include "zebra/q_jbit.inc"
-#include "zebra/q_jbyt.inc"
-#include "zebra/q_sbit0.inc"
-#include "zebra/q_sbit1.inc"
-#include "zebra/q_sbit.inc"
-
-
- LHEAD = LHEADP(1)
- IF (LHEAD.EQ.0) RETURN
-
-#include "zebra/qtrace.inc"
-#include "zebra/qstore.inc"
-
-#if defined(CERNLIB_QDEBUG)
- IF (IQVSTA.NE.0) CALL ZVAUTX
- CALL MZCHLS (-7,LHEAD)
- IF (IQFOUL.NE.0) GO TO 92
-#endif
-#if !defined(CERNLIB_QDEBUG)
- IQNS = IQ(KQS+LHEAD-2)
-#endif
- LQLIML = LQSTA(KQT+21)
- LQLIMH = 0
-
- IQTBIT = KBITP(1)
- CALL UOPTC (CHOPT,'ZLV',IQUEST)
- IQTVAL = 1 - IQUEST(1)
- IOPTS = 1 - IQUEST(3)
- IOPTH = IQUEST(2)
-#if defined(CERNLIB_QDEVZE)
- IF (NQDEVZ.NE.0)
- +WRITE (IQLOG,9814) LHEAD,IQTBIT,IQTVAL,IOPTS,IOPTH
- 9814 FORMAT (1X/' DEVZE MZFLAG. LHEAD,IQTBIT,IQTVAL,IOPTS,IOPTH='
- F,I6,6I4)
-#endif
-
- LEV = LQWKTB + 3
- LEVE = LEV + NQWKTB - 10
- LQ(LEV-2) = 0
- LQ(LEV-1) = 0
- LQ(LEV) = LHEAD
-
- LCUR = LHEAD
- LX = LHEAD - 1 + IOPTH
- LAST = LHEAD - IQNS
- IQ(KQS+LCUR) = MSBIT1 (IQ(KQS+LCUR),IQSYSX)
- GO TO 24
-
-C-- Mark bank
-
- 20 LAST = LCUR - IQ(KQS+LCUR-2)
- IQ(KQS+LNEW) = MSBIT0 (IQ(KQS+LNEW),IQSYSX)
- IQ(KQS+LNEW) = MSBIT (IQTVAL,IQ(KQS+LNEW),IQTBIT)
- LQLIML = MIN (LQLIML,LNEW)
- LQLIMH = MAX (LQLIMH,LNEW)
-
-C---- Look at next link
-
- 24 IF (LX.LT.LAST) GO TO 41
- LNEW = LQ(KQS+LX)
- LX = LX - 1
- IF (LNEW.EQ.0) GO TO 24
-
-#if defined(CERNLIB_QDEBUG)
- CALL MZCHLS (-7,LNEW)
- IF (IQFOUL.NE.0) GO TO 94
-#endif
- IF (JBIT(IQ(KQS+LNEW),IQSYSX).NE.0) GO TO 24
-
-C---- New bank LNEW, push down
-
- LQ(LEV+1) = LX
- LQ(LEV+2) = LCUR
-
- LEV = LEV + 3
- IF (LEV.GE.LEVE) GO TO 91
- LQ(LEV) = LNEW
-#if defined(CERNLIB_QDEVZE)
- IF (NQDEVZ.GE.7)
- +WRITE (IQLOG,9831) LEV,LCUR,LX+1,LNEW
- 9831 FORMAT (' DEVZE MZFLAG, Down: LEV,LCUR,LX+1,LNEW=',6I8)
-#endif
-
-C-- Move to end of linear structure
-
- 32 LCUR = LNEW
- IQ(KQS+LCUR) = MSBIT1 (IQ(KQS+LCUR),IQSYSX)
- LNEW = LQ(KQS+LCUR)
- IF (LNEW.EQ.0) GO TO 36
-#if defined(CERNLIB_QDEVZE)
- IF (NQDEVZ.GE.7)
- +WRITE (IQLOG,9833) LCUR,LNEW
- 9833 FORMAT (' DEVZE MZFLAG, Along: LCUR,LNEW=',6I8)
-#endif
-#if defined(CERNLIB_QDEBUG)
- CALL MZCHLS (-7,LNEW)
- IF (IQFOUL.NE.0) GO TO 93
- IF (JBIT(IQ(KQS+LNEW),IQSYSX).NE.0) GO TO 36
- IF (LQ(KQS+LNEW+2).NE.LCUR) GO TO 95
- GO TO 32
-
- 36 CONTINUE
-#endif
-#if !defined(CERNLIB_QDEBUG)
- IF (JBIT(IQ(KQS+LNEW),IQSYSX).EQ.0) GO TO 32
-
- 36 IQNS = IQ(KQS+LCUR-2)
-#endif
- LAST = LCUR - IQNS
- LX = LCUR - 1
- GO TO 24
-
-C---- Bank at LCUR has no further secondaries
-C-- step back in the linear structure
-
- 41 LNEW = LCUR
- IF (LCUR.EQ.LQ(LEV)) GO TO 46
- LCUR = LQ(KQS+LCUR+2)
- LX = LCUR - 1
-#if defined(CERNLIB_QDEVZE)
- IF (NQDEVZ.GE.7)
- +WRITE (IQLOG,9841) LCUR,LNEW
- 9841 FORMAT (' DEVZE MZFLAG, Back: LCUR,LNEW=',6I8)
-#endif
- GO TO 20
-
-C-- Start of linear structure reached, pop up
-
- 46 LEV = LEV - 3
- LX = LQ(LEV+1)
- LCUR = LQ(LEV+2)
-#if defined(CERNLIB_QDEVZE)
- IF (NQDEVZ.GE.7)
- +WRITE (IQLOG,9846) LEV,LCUR,LX
- 9846 FORMAT (' DEVZE MZFLAG, Up: LEV,LCUR,LX=',6I8)
-#endif
- IF (LCUR.NE.0) GO TO 20
-
-C---- Done, mark header bank
-
- 61 IQ(KQS+LHEAD) = MSBIT0 (IQ(KQS+LHEAD),IQSYSX)
- IF (IOPTS.EQ.0) GO TO 999
- IQ(KQS+LHEAD) = MSBIT (IQTVAL,IQ(KQS+LHEAD),IQTBIT)
- LQLIML = MIN (LQLIML,LHEAD)
- LQLIMH = MAX (LQLIMH,LHEAD)
-#include "zebra/qtrace99.inc"
- RETURN
-
-C------ Error conditions
-
-#if defined(CERNLIB_QDEBUG)
- 95 NQCASE = 2
- NQFATA = 1
- IQUEST(14) = LQ(KQS+LNEW+2)
- GO TO 93
-
- 94 NQCASE = 1
- NQFATA = 1
- IQUEST(14) = LX+1 - LCUR
- 93 NQCASE = NQCASE + 1
- NQFATA = NQFATA + 2
- IQUEST(12) = LNEW
- IQUEST(13) = LCUR
- 92 NQCASE = NQCASE + 1
-#endif
- 91 NQCASE = NQCASE + 1
- NQFATA = NQFATA + 1
- IQUEST(11) = LHEAD
-#include "zebra/qtofatal.inc"
- END
diff --git a/src/packlib/zebra/mq/mzinco.F b/src/packlib/zebra/mq/mzinco.F
deleted file mode 100644
index d6f1396..0000000
--- a/src/packlib/zebra/mq/mzinco.F
+++ /dev/null
@@ -1,201 +0,0 @@
-*
-* $Id: mzinco.F,v 1.2 1999/06/18 13:30:13 couet Exp $
-*
-* $Log: mzinco.F,v $
-* Revision 1.2 1999/06/18 13:30:13 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:17 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE MZINCO (LIST)
-
-C- Initialise all passive COMMONs, normally called from MZEBRA
-C- but it may be user called for non-ZEBRA applications
-
-#include "zebra/zbcd.inc"
-#include "zebra/zbcdch.inc"
-#include "zebra/zceta.inc"
-#include "zebra/zheadp.inc"
-#include "zebra/zmach.inc"
-#include "zebra/znatur.inc"
-#include "zebra/zstate.inc"
-#include "zebra/zunit.inc"
-#include "zebra/zvfaut.inc"
-#include "zebra/quest.inc"
-*
- DIMENSION LIST(9)
-
-#include "zebra/q_jbit.inc"
-
-
-C-- Clear /ZSTATE/
-
- CALL VZERO (IQUEST,100)
- CALL VZERO (IQVID,18)
- CALL VZERO (NQPHAS,15)
-#include "zebra/qversion.inc"
-
-C---- Ready /ZMACH/
-
- NQBITW = IQBITW
- NQBITC = IQBITC
- NQCHAW = IQCHAW
- NQLNOR = 58
- NQLMAX = 58
- NQLPTH = 0
- NQRMAX = 132
- IQLPCT = IQBLAN
- IQNIL = 16744448
-#if defined(CERNLIB_CRAY)
- IQNIL = 0777770516040020000000B
-#elif defined(CERNLIB_CDC)
- IQNIL = O"17770516040000200000"
-#endif
-
-
-C---- Ready /ZBCD/ and /ZBCDCH/
-
- CQALLC = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789+-*/()$= ,.'
- CQALLC(65:90) = 'abcdefghijklmnopqrstuvwxyz'
- CQALLC(48:64) = '#''!:"_]&@?[>< ^;%'
- CQALLC(91:96) = '{|}~`?'
-#if defined(CERNLIB_CDC)
- CQALLC(91:96) = '??????'
-#endif
-#if defined(CERNLIB_QEBCDIC)
- CQALLC(61:61) = CHAR(224)
-#endif
-#if !defined(CERNLIB_QEBCDIC)
- CQALLC(61:61) = CHAR(92)
-#endif
- CALL UCTOH1 (CQALLC, IQLETT, 96)
- CALL UCTOH1 (' 1234567890', IQNUM2, 11)
-
- CALL IZHNUM (IQLETT,NQHOLL,95)
- NQHOL0 = NQHOLL(45)
-
-C---- READY /ZCETA/
-C-- Table entry IQCETA(JH+1) contains the CETA value for
-C- the character of internal representation JH
-
- CALL VFILL (IQCETA,NQTCET,96)
-
- DO 24 JC=95,1,-1
- JH = NQHOLL(JC)
- 24 IQCETA(JH+1) = JC
-
-#if (defined(CERNLIB_QEBCDIC))&&(!defined(CERNLIB_CERNWYL))
- IQCETA(1+ 64) = 45
- IQCETA(1+189) = 54
- IQCETA(1+173) = 58
- IQCETA(1+224) = 61
- IQCETA(1+139) = 91
- IQCETA(1+192) = 91
- IQCETA(1+155) = 93
- IQCETA(1+208) = 93
-#endif
-#if (defined(CERNLIB_QEBCDIC))&&(defined(CERNLIB_CERNWYL))
- IQCETA(1+ 64) = 45
- IQCETA(1+189) = 54
- IQCETA(1+173) = 58
- IQCETA(1+224) = 61
- IQCETA(1+139) = 91
- IQCETA(1+192) = 91
- IQCETA(1+155) = 93
- IQCETA(1+208) = 93
- IQCETA(1+ 95) = 94
- IQCETA(1+161) = 94
-#endif
-#if defined(CERNLIB_QCDCODE)
- IQCETA(1) = 51
-#endif
-C-- Table IQTCET(JH+1) is like IQCETA but for 6-bit packing
-
- DO 26 JL=1,NQTCET
- J = IQCETA(JL)
- IF (J.GE.64) THEN
- IF (J.GE.94) THEN
- J = 57
- ELSEIF (J.EQ.93) THEN
- J = 42
- ELSEIF (J.EQ.92) THEN
- J = 40
- ELSEIF (J.EQ.91) THEN
- J = 41
- ELSEIF (J.EQ.64) THEN
- J = 51
- ELSE
-C-- lower case mapped to upper case
- J = J - 64
- ENDIF
- ENDIF
- 26 IQTCET(JL) = J
-
-C---- Ready /ZNATUR/
-
- QPI = 4.*ATAN(1.)
- QPI2 = 2.*QPI
- QPIBY2 = QPI/2.
- QPBYHR = .0002998
-
-C---- Ready COMMON /ZUNIT/
-
-#include "mzeunit.inc"
- IQLOG = IQPRNT
-#include "mzeunit2.inc"
- ITYPE = IQTYPE
- IF (ITYPE.EQ.0) ITYPE = IQLOG
- NLIST = LIST(1)
- IF (NLIST) 32, 38, 33
- 32 NLIST = -NLIST
- IF (JBIT(NLIST,2).NE.0) NQLOGD = -2
- IF (JBIT(NLIST,1).NE.0) IQLOG = ITYPE
- IQPRNT = IQLOG
- GO TO 38
-
- 33 NQLOGD = LIST(2)
-
- IF (NLIST.EQ.1) GO TO 38
- IF (LIST(3).NE.0) THEN
- IF (LIST(3).LT.0) THEN
- IQLOG = ITYPE
- ELSE
- IQLOG = LIST(3)
- ENDIF
- ENDIF
- IQPRNT = IQLOG
-
- IF (NLIST.EQ.2) GO TO 38
- IF (LIST(4).NE.0) THEN
- IF (LIST(4).LT.0) THEN
- IQPRNT = ITYPE
- ELSE
- IQPRNT = LIST(4)
- ENDIF
- ENDIF
-
- 38 IQPR2 = IQPRNT
- NQLOGM = NQLOGD
-
-
- IQDLUN = IQPRNT
- IQFLUN = IQPRNT
- IQHLUN = IQPRNT
- NQUSED = 0
-
-C---- Ready COMMON /ZHEADP/
-
- CALL VBLANK (IQHEAD,20)
- CALL VZERO (IQDATE,7)
- CALL DATIME (IQDATE,IQTIME)
-
-#if defined(CERNLIB_CDC)
- CALL XSETIO
-#endif
-
- RETURN
- END
diff --git a/src/packlib/zebra/mq/mzinqd.F b/src/packlib/zebra/mq/mzinqd.F
deleted file mode 100644
index 2955cbf..0000000
--- a/src/packlib/zebra/mq/mzinqd.F
+++ /dev/null
@@ -1,140 +0,0 @@
-*
-* $Id: mzinqd.F,v 1.3 1999/06/18 13:30:14 couet Exp $
-*
-* $Log: mzinqd.F,v $
-* Revision 1.3 1999/06/18 13:30:14 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.2 1996/04/18 16:11:35 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:20 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE MZINQD (IXDIV)
-
-C- Return the attributes of division IXDIV :
-C- IQUEST(1) mode = 0 forward, 1 reverse division
-C- IQUEST(2) kind = 1 short range, 2 long, 4 package, 8 system
-C- IQUEST(3) start adr LSTA
-C- IQUEST(4) end adr LEND
-C- IQUEST(5) if mode=0 : LEMAX highest possible value of LEND
-C- if mode=1 : LSMIN lowest possible value of LSTA
-C- IQUEST(6) initial size
-C- IQUEST(7) declared maximum size
-C- IQUEST(8) char 1:4 of BCD name of division
-C- IQUEST(9) char 5:8
-C- IQUEST(10) JDVSH, if non-zero: sharing neighbour division
-
-C- ie.: memory currently occupied = LEND - LSTA
-C-
-C- immediate free space = LEMAX - LEND if MODE = 0
-C- = LSTA - LSMIN if MODE = 1
-
-#include "zebra/zunit.inc"
-#include "zebra/zvfaut.inc"
-#include "zebra/mqsys.inc"
-*
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HMZIN, 4HQD /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HMZINQD /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'MZINQD ')
-#endif
-
-#include "zebra/q_jbit.inc"
-#include "zebra/q_jbyt.inc"
-
-
-#include "zebra/qtrace.inc"
-#if defined(CERNLIB_QDEBUG)
- IF (IQVSTA.NE.0) CALL ZVAUTX
-#endif
-
- CALL MZSDIV (IXDIV,4)
-
- MODE = JBIT (IQMODE(KQT+JQDIVI), 1)
- KIND = JBYT (IQKIND(KQT+JQDIVI),21,4)
- LSTA = LQSTA(KQT+JQDIVI)
- LEND = LQEND(KQT+JQDIVI)
- NMAX = NQDMAX(KQT+JQDIVI)
- IF (JQDIVI.LT.3) GO TO 41
- IF (MODE.NE.0) GO TO 31
-
-C-- FORWARD DIVISION
-
- JDVNE = JQDIVI + 1
- IF (JQDIVI.EQ.JQDVLL) GO TO 24
- IF (JQDIVI.EQ.20) GO TO 25
-
- IF (JBYT(IQKIND(KQT+JDVNE),21,4).NE.KIND) GO TO 25
- IF (JBIT(IQMODE(KQT+JDVNE),1) .EQ.MODE) GO TO 25
- JDVSH = JDVNE
- LMAX = LQSTA(KQT+JDVNE)
- GO TO 78
-
- 24 JDVNE = JQDVSY
- 25 LMAX = MIN (LSTA+NMAX, LQSTA(KQT+JDVNE) )
- JDVSH = 0
- GO TO 78
-
-C-- REVERSE DIVISION
-
- 31 JDVNE = JQDIVI - 1
- IF (JQDIVI.EQ.JQDVSY) GO TO 34
- IF (JBYT(IQKIND(KQT+JDVNE),21,4).NE.KIND) GO TO 35
- IF (JBIT(IQMODE(KQT+JDVNE),1) .EQ.MODE) GO TO 35
- JDVSH = JDVNE
- LMAX = LQEND(KQT+JDVNE)
- GO TO 78
-
- 34 JDVNE = JQDVLL
- 35 LMAX = MAX (LEND-NMAX, LQEND(KQT+JDVNE) )
- JDVSH = 0
- GO TO 78
-
-C---- DIVISIONS 2 + 1
-
- 41 IF (JQDIVI.EQ.1) GO TO 44
- LMAX = LQEND(KQT+1) + NQMINR
- JDVSH = 1
- GO TO 78
-
- 44 LMAX = LQSTA(KQT+2) - NQMINR
- JDVSH = 2
-
-C---- Store vector
-
- 78 IQUEST(1) = MODE
- IQUEST(2) = KIND
- IQUEST(3) = LSTA
- IQUEST(4) = LEND
- IQUEST(5) = LMAX
- IQUEST(6) = NQDINI(KQT+JQDIVI)
- IQUEST(7) = NMAX
- IQUEST(8) = IQDN1(KQT+JQDIVI)
- IQUEST(9) = IQDN2(KQT+JQDIVI)
- IQUEST(10) = JDVSH
- IQUEST(11) = 0
- IQUEST(12) = 0
-#if defined(CERNLIB_QPRINT)
- IF (NQLOGL.GE.2)
- + WRITE (IQLOG,9071) JQDIVI,JQSTOR,(IQUEST(J),J=1,10)
-
- 9071 FORMAT (/' MZINQD. Inquiry for division',I3,' in store',I3,
- F' returns :'
- F/10X,'mode kind LSTA LEND LEXTR inisize maxsize'
- F,' name1/2 JDVSH'
- F/9X,2I5,5I9, 2X,2A4,I5)
-#endif
-#include "zebra/qtrace99.inc"
- RETURN
- END
diff --git a/src/packlib/zebra/mq/mzinqs.F b/src/packlib/zebra/mq/mzinqs.F
deleted file mode 100644
index 11febf8..0000000
--- a/src/packlib/zebra/mq/mzinqs.F
+++ /dev/null
@@ -1,103 +0,0 @@
-*
-* $Id: mzinqs.F,v 1.3 1999/06/18 13:30:14 couet Exp $
-*
-* $Log: mzinqs.F,v $
-* Revision 1.3 1999/06/18 13:30:14 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.2 1996/04/18 16:11:36 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:20 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE MZINQS (IXSTOR)
-
-C- Return the attributes of division IXSTOR :
-C- IQUEST(1) opmode operation mode from NQALLO
-C- IQUEST(2) NQSTRU number of structural permanent links
-C- IQUEST(3) NQREF number of permanent links
-C- IQUEST(4) NQLINK number of permanent + working space links
-C- IQUEST(5) LQSTA(1) first word after the working space
-C- IQUEST(6) LQSTA(21) first word after the store
-C- IQUEST(7) NQMINR minimum size of the reserve area after div. 1
-C- IQUEST(8) LQ2END minimum value of LQEND(2)
-C- IQUEST(9) JQDVLL last low division
-C- IQUEST(10) JQDVSY system division, also : first high division
-C- IQUEST(11) NQLOGL log level for this store
-C- IQUEST(12) NQSNAM chars 1:4 of the printing name of the store
-C- IQUEST(13) chars 5:8
-C- IQUEST(14) LOWORG lowest possible origin-adr for the store
-C- IQUEST(15) HIGORG highest possible origin-adr for the store
-C- IQUEST(16) INALC initial allocation to last division created
-C- IQUEST(17) ITOFF table-offset J of the table,
-C- if contained at the end of the store
-
-#include "zebra/zunit.inc"
-#include "zebra/zvfaut.inc"
-#include "zebra/mqsys.inc"
-*
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HMZIN, 4HQS /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HMZINQS /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'MZINQS ')
-#endif
-
-#include "zebra/q_jbyt.inc"
-
-
-#include "zebra/qtrace.inc"
-#if defined(CERNLIB_QDEBUG)
- IF (IQVSTA.NE.0) CALL ZVAUTX
-#endif
-
-#include "zebra/qstore.inc"
-
- CALL UCOPY (IQTABV(KQT+1), IQUEST(2), 16)
- IQUEST(1) = NQALLO(JQSTOR+1)
- IQUEST(2) = IQUEST(4)
- IQUEST(3) = IQUEST(5)
- IQUEST(4) = IQUEST(6)
-
- IQUEST(5) = LQSTA(KQT+1)
- IQUEST(6) = LQSTA(KQT+21)
-#if defined(CERNLIB_QPRINT)
- IF (NQLOGL.GE.2) WRITE (IQLOG,9071) JQSTOR,(IQUEST(J),J=1,17)
-
- 9071 FORMAT (/' MZINQS. Inquiry for store',I3,' returns :'
- F/10X,'opmode NQSTRU NQREF'
- F,' NQLINK LSTA1 LSTA21 NQMINR LQ2END'
- F/9X,3I7,5I9
- F/10X,'JQDVLL JQDVSY NQLOGL'
- F,' name1/2 lowORG highORG initalc toffset'
- F/9X,3I7,1X,2A4,4I9)
-#endif
-#include "zebra/qtrace99.inc"
- RETURN
-
-C- (3) NQSTRU number of structural permanent links
-C- (4) NQREF number of permanent links
-C- (5) NQLINK number of permanent + working space links
-C- LQSTA(1) first word after the working space
-C- LQSTA(21) first word after the store
-C- (6) NQMINR minimum size of the reserve area after div. 1
-C- (7) LQ2END minimum value of LQEND(2)
-C- (8) JQDVLL last low division
-C- (9) JQDVSY system division, also : first high division
-C- (10) NQLOGL log level for this store
-C- (11) NQSNAM chars 1:4 of the printing name of the store
-C- (12) chars 5:8
-C- (13) LOWORG lowest possible origin-adr for the store
-C- (14) HIGORG highest possible origin-adr for the store
-C- (15) INALC initial allocation to last division created
-C- (16) ITOFF table-offset J of the table, if contained in store
- END
diff --git a/src/packlib/zebra/mq/mzlift.F b/src/packlib/zebra/mq/mzlift.F
deleted file mode 100644
index 9d1ba0c..0000000
--- a/src/packlib/zebra/mq/mzlift.F
+++ /dev/null
@@ -1,399 +0,0 @@
-*
-* $Id: mzlift.F,v 1.3 1999/06/18 13:30:15 couet Exp $
-*
-* $Log: mzlift.F,v $
-* Revision 1.3 1999/06/18 13:30:15 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.2 1996/04/18 16:11:37 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:18 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE MZLIFT (IXDIV,LP,LSUPP,JBIAS,NAME,NZERO)
-
-C- Lift a bank, user called
-
-#include "zebra/zmach.inc"
-#include "zebra/zstate.inc"
-#include "zebra/zunit.inc"
-#include "zebra/zvfaut.inc"
-#include "zebra/mqsys.inc"
-#include "zebra/eqlqmst.inc"
-#include "zebra/eqlqform.inc"
-#include "zebra/mzcl.inc"
-#include "zebra/mzcn.inc"
-#include "zebra/mzct.inc"
-*
- DIMENSION IXDIV(9), LP(9), LSUPP(9), NAME(9)
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HMZLI, 4HFT /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HMZLIFT /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'MZLIFT ')
-#endif
-
-#include "zebra/q_jbit.inc"
-#include "zebra/q_jbyt.inc"
-#include "zebra/q_sbyt.inc"
-#include "zebra/q_shiftl.inc"
-#include "zebra/q_locf.inc"
-
-
-#include "zebra/qtrace.inc"
-#if defined(CERNLIB_QDEBUG)
- IF (IQVSTA.NE.0) CALL ZVAUTX
-#endif
-
-C-- Copy parameters
-
- IF (JBIAS.NE.63) THEN
- NQBIA = JBIAS
- NIO = JBYT (NAME(5),12,4)
- CALL UCOPY (NAME,NQID,NIO+5)
- IF (NIO.NE.0) NQIOSV(1)=0
- ENDIF
-
- JDV = IXDIV(1)
- LQSUP = LSUPP(1)
- IF (NQBIA.GE.2) LQSUP = 0
- ICHORG = NQIOCH(1)
- NTOT = NQNL + NQND + 10
-
- IF (JDV.EQ.-7) GO TO 24
- IF (JBYT(JDV,27,6).NE.JQSTOR) GO TO 22
- JQDIVI = JBYT (JDV,1,26)
- IF (JQDIVI.LT.21) GO TO 23
- 22 CALL MZSDIV (JDV,0)
- 23 CALL MZCHNB (LP)
- 24 CONTINUE
-
-C-- Check bank parameters
-
-#if defined(CERNLIB_QDEBUG)
- J = JBYT (NQID,IQBITW-7,8)
- IF (J.EQ.0) GO TO 91
- IF (J.EQ.255) GO TO 91
- IF (NTOT.GE.LQSTA(KQT+21)) GO TO 91
- IF (NQNS.GT.NQNL) GO TO 91
- IF (NQNS.LT.0) GO TO 91
- IF (NQNL.GT.64000) GO TO 91
- IF (NQND.LT.0) GO TO 91
- IF (NQBIA.GE.3) GO TO 91
-
- IF (LQSUP.EQ.0) GO TO 25
- CALL MZCHLS (-7,LQSUP)
- IF (IQFOUL.NE.0) GO TO 92
- IF (NQBIA.EQ.1) GO TO 26
- IF (JBIT(IQ(KQS+LQSUP),IQDROP).NE.0) GO TO 92
- IF (IQNS+NQBIA.LT.0) GO TO 93
- GO TO 26
-
- 25 IF (NQBIA.LE.0) GO TO 92
- 26 CONTINUE
-#endif
-
-C---- Find LNEXT, future 'next' bank
-C- LSAME, a bank in the same linear structure
-C- LS, division selecting bank
-C- IDN, numeric ID
-
- IDN = 1
- LS = LQSUP
- LSAME = LQSUP
- LNEXT = LQSUP
- IF (NQBIA.GT.0) GO TO 38
- LNEXT = LQ(KQS+LNEXT+NQBIA)
- IF (LNEXT.EQ.0) GO TO 36
- LSAME = LNEXT
- LS = LNEXT
-#if defined(CERNLIB_QDEBUG)
- CALL MZCHLS (-7,LNEXT)
- IF (IQFOUL.NE.0) GO TO 94
-#endif
- IDN = IQ(KQS+LNEXT-5) + 1
- GO TO 39
-
- 36 IF (NQBIA.EQ.0) GO TO 37
- LSAME = 0
- IDN = -NQBIA
- GO TO 39
-
- 37 IDN = IQ(KQS+LSAME-5) + 1
- GO TO 39
-
- 38 IF (LNEXT.NE.0) IDN=IQ(KQS+LNEXT-5)+1
- 39 CONTINUE
-
-C---- Ready I/O characteristic
-
- IF (ICHORG.LT.0) GO TO 47
-
-C-- Immediate
-
- IF (ICHORG.LT.8) THEN
- NQNIO = 0
- NQIOCH(1) = ISHFTL (ICHORG, 16)
- GO TO 49
- ENDIF
-
-C-- Copy characteristic from sister bank
-
- IF (ICHORG-11) 45, 43, 47
- 43 IF (LSAME.EQ.0) GO TO 45
-#if !defined(CERNLIB_QDEBUG)
- NQNIO = JBYT (IQ(KQS+LSAME),19,4)
- IQLN = LSAME - (NQNIO+IQ(KQS+LSAME-3)+1)
-#endif
-#if defined(CERNLIB_QDEBUG)
- NQNIO = IQNIO
-#endif
- IF (NQNIO.EQ.0) THEN
- NQIOCH(1) = LQ(KQS+IQLN)
- GO TO 49
- ELSE
- CALL UCOPY (LQ(KQS+IQLN),NQIOCH,NQNIO+1)
- NQIOSV(1) = 0
- GO TO 49
- ENDIF
-
-C-- Find index to characteristic according to IDH
-
- 45 LID = LQFORM
- IF (LID.EQ.0) GO TO 95
- LIOD = LQ(KQSP+LID-2)
- IF (NQID.LT.0) LID=LQ(KQSP+LID)
-
-C-- Same as last
-
- IF (NQID.EQ.IQ(KQSP+LID+3)) THEN
- IXIO = IQ(KQSP+LID+2)
- ELSE
-
-C-- Search
-
- N = IQ(KQSP+LID+1)
- IF (N.EQ.0) GO TO 95
- J = IUCOMP (NQID,IQ(KQSP+LID+4),N)
- IF (J.EQ.0) GO TO 95
-
- LIX = LQ(KQSP+LID-1)
- IXIO = IQ(KQSP+LIX+J)
- IQ(KQSP+LID+2) = IXIO
- IQ(KQSP+LID+3) = NQID
- ENDIF
-
- NQNIO = JBYT (IQ(KQSP+LIOD+IXIO+1),7,5) - 1
- GO TO 48
-
-C-- Parameter is characteristic or index
-
- 47 J = JBYT (ICHORG,1,6)
- NQNIO = JBYT (ICHORG,7,5) - 1
- IOTH = JBYT (ICHORG,12,5)
- IF (J.EQ.1) THEN
- IF (NQNIO.NE.IOTH) GO TO 96
- GO TO 49
- ENDIF
-
-C-- Index
-
- IF (J.NE.2) GO TO 96
- IF (IOTH.NE.0) GO TO 96
- IXIO = JBYT (ICHORG,17,16)
- IF (IXIO.EQ.0) GO TO 96
-
- LIOD = LQ(KQSP+LQFORM-2)
- IF (IXIO.GE.IQ(KQSP+LIOD+1)) GO TO 96
-
-C-- Same characteristic as previously lifted bank
-
- 48 IF (IXIO.EQ.NQIOSV(1)) THEN
- NQIOCH(1) = NQIOSV(2)
- GO TO 49
- ENDIF
-
-C-- Copy characteristic
-
- NQIOSV(1) = 0
- IF (NQNIO.GE.16) GO TO 96
- CALL UCOPY (IQ(KQSP+LIOD+IXIO+1),NQIOCH,NQNIO+1)
- IOTH = JBYT (NQIOCH(1),12,5)
- IF (NQNIO.NE.IOTH) GO TO 96
- NQIOSV(1) = IXIO
- NQIOSV(2) = NQIOCH(1)
-
- 49 NTOT = NTOT + NQNIO
-
-C------ Select division
-
- IF (JQDIVI.NE.0) GO TO 59
- IF (LS.LT.LQSTA(KQT+1)) GO TO 58
- IF (LS.GE.LQEND(KQT+20)) GO TO 58
- IF (LS.GE.LQEND(KQT+JQDVLL)) GO TO 54
- IF (LS.LT.LQEND(KQT+2)) GO TO 57
- JQDIVI = 3
- GO TO 55
-
- 54 JQDIVI = JQDVSY
- 55 IF (LS.LT.LQEND(KQT+JQDIVI)) GO TO 61
- JQDIVI = JQDIVI + 1
- GO TO 55
-
- 57 JQDIVI = 1
- IF (LS.LT.LQSTA(KQT+2)) GO TO 61
- 58 JQDIVI = 2
- GO TO 61
-
- 59 IF (LSAME.EQ.0) GO TO 61
- IF (LSAME.LT.LQSTA(KQT+JQDIVI)) GO TO 97
- IF (LSAME.GE.LQEND(KQT+JQDIVI)) GO TO 97
-
-C------ Allocate space
-
- 61 CALL MZRESV
- NQRESV = NQRESV - NTOT
- IF (NQRESV.LT.0) GO TO 81
- IF (JQMODE.NE.0) GO TO 63
-
-C-- Division is mode forward
-
- NQLN = LQEND(KQT+JQDIVI)
- LE = NQLN + NTOT
- LQEND(KQT+JQDIVI) = LE
- GO TO 65
-
-C-- Division is mode reverse
-
- 63 LE = LQSTA(KQT+JQDIVI)
- NQLN = LE - NTOT
- LQSTA(KQT+JQDIVI) = NQLN
-
-C---- Construct bank
-
- 65 NZ = MIN (NZERO,NQND)
- IF (NZ.EQ.0) NZ=NQND
- IF (NZ.LT.0) NZ=0
-
- NST = NQNIO + NQNL
- NQLS = NQLN + NST + 1
- CALL VZERO (LQ(KQS+NQLN+NQNIO+1),NQNL+NZ+9)
-
- NQIOCH(1) = MSBYT (NST+12,NQIOCH(1),1,16)
- DO 67 J=0,NQNIO
- 67 LQ(KQS+NQLN+J) = NQIOCH(J+1)
-
- IQ(KQS+NQLS-5) = IDN
- IQ(KQS+NQLS-4) = NQID
- IQ(KQS+NQLS-3) = NQNL
- IQ(KQS+NQLS-2) = NQNS
- IQ(KQS+NQLS-1) = NQND
- IQ(KQS+NQLS) = ISHFTL (NQNIO,18)
-
-C------ Set up how to link
-
- IF (NQBIA-1) 72, 73, 79
-
-C-- JBIAS -ve, insert into tree
-
- 72 LUP = LQSUP
- KADR = LQSUP + NQBIA
- LNEXT = LQ(KQS+KADR)
- IF (NQBIA.NE.0) GO TO 77
- LUP = LQ(KQS+LUP+1)
- GO TO 77
-
-C-- JBIAS = +1, add to linear structure
-
- 73 LNEXT = LQSUP
- IF (LNEXT.NE.0) GO TO 74
- LUP = 0
- KADR = LOCF (LSUPP(1)) - LQSTOR
-#if defined(CERNLIB_APOLLO)
- KADR = RSHFT (IADDR(LSUPP(1)),2) - LQSTOR
-#endif
- IF (KADR.LT.LQSTA(KQT+1)) GO TO 78
- IF (KADR.LT.LQSTA(KQT+21)) GO TO 98
- GO TO 78
-
- 74 LUP = LQ(KQS+LNEXT+1)
- KADR = LQ(KQS+LNEXT+2)
-
-C---- Link bank into structure
-
- 77 IF (LNEXT.EQ.0) GO TO 78
- LQ(KQS+NQLS) = LNEXT
- LQ(KQS+LNEXT+2) = NQLS
-
- 78 LQ(KQS+NQLS+1) = LUP
- LQ(KQS+NQLS+2) = KADR
-
- LQ(KQS+KADR) = NQLS
-
- 79 LP(1) = NQLS
-#if defined(CERNLIB_QDEBPRI)
- IF (NQLOGL.GE.2)
- + WRITE (IQLOG,9079) JQSTOR,JQDIVI,NQLS,LQSUP,NQBIA,
- + NQID,NQNL,NQNS,NQND
- 9079 FORMAT (' MZLIFT- Store/Div',2I3,' L/LSUP/JBIAS=',2I9,I6,
- F' ID,NL,NS,ND= ',A4,2I6,I9)
-#endif
-#include "zebra/qtrace99.inc"
- RETURN
-
-C---- Garbage collection
-
- 81 LQMST(KQT+1) = LQSUP
- CALL MZGAR1
- LQSUP = LQMST(KQT+1)
- IF (NQBIA.GE.1) GO TO 61
- KADR = LOCF (LSUPP(1)) - LQSTOR
-#if defined(CERNLIB_APOLLO)
- KADR = RSHFT (IADDR(LSUPP(1)),2) - LQSTOR
-#endif
- IF (KADR.LT.LQSTA(KQT+1)) GO TO 83
- IF (KADR.LT.LQSTA(KQT+21)) GO TO 61
- 83 LSUPP(1) = LQSUP
- GO TO 61
-
-C---- Error conditions
-
- 98 NQCASE = 8
- NQFATA = 1
- IQUEST(18) = KADR
- GO TO 90
-
- 97 NQCASE = 7
- NQFATA = 1
- IQUEST(18) = LSAME
- GO TO 90
-
- 94 NQCASE = 4
- NQFATA = 1
- IQUEST(18) = LNEXT
- GO TO 90
-
- 96 NQCASE = 1
- 95 NQCASE = NQCASE + 2
- 93 NQCASE = NQCASE + 1
- 92 NQCASE = NQCASE + 1
- 91 NQCASE = NQCASE + 1
- 90 NQFATA = NQFATA + 7
- IQUEST(11) = LQSUP
- IQUEST(12) = NQBIA
- IQUEST(13) = NQID
- IQUEST(14) = NQNL
- IQUEST(15) = NQNS
- IQUEST(16) = NQND
- IQUEST(17) = ICHORG
-#include "zebra/qtofatal.inc"
- END
diff --git a/src/packlib/zebra/mq/mzlink.F b/src/packlib/zebra/mq/mzlink.F
deleted file mode 100644
index 0774213..0000000
--- a/src/packlib/zebra/mq/mzlink.F
+++ /dev/null
@@ -1,211 +0,0 @@
-*
-* $Id: mzlink.F,v 1.3 1999/06/18 13:30:15 couet Exp $
-*
-* $Log: mzlink.F,v $
-* Revision 1.3 1999/06/18 13:30:15 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.2 1996/04/18 16:11:38 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:18 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE MZLINK (IXSTOR,CHNAME,LAREA,LREF,LREFL)
-
-C- Set permanent link area, user called
-
-#include "zebra/zbcd.inc"
-#include "zebra/zstate.inc"
-#include "zebra/zunit.inc"
-#include "zebra/zvfaut.inc"
-#include "zebra/mqsys.inc"
-*
- DIMENSION LAREA(9),LREF(9),LREFL(9),NAME(2)
- CHARACTER *(*) CHNAME
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HMZLI, 4HNK /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HMZLINK /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'MZLINK ')
-#endif
-
-#include "zebra/q_jbyt.inc"
-#include "zebra/q_locf.inc"
-
-
-#include "zebra/qtrace.inc"
-
-#include "zebra/qstore.inc"
-#if defined(CERNLIB_QDEBUG)
- IF (IQVSTA.NE.0) CALL ZVAUTX
-#endif
-
-C-- Check enough space in system link-area table
-
- LSYS = LQSYSS(KQT+1)
- NWTAB = IQ(KQS+LSYS+1)
- IF (NWTAB+5.GT.IQ(KQS+LSYS-1)) THEN
- JQDIVI = JQDVSY
- CALL MZPUSH (-7,LSYS,0,100,'I')
- LQSYSS(KQT+1) = LSYS
- ENDIF
-
-C-- Construct table entry
-
- LSTO = LSYS + NWTAB
- LOCAR = LOCF (LAREA(1)) - LQSTOR
- LOCR = LOCF (LREF(1)) - LQSTOR
- LOCRL = LOCF (LREFL(1)) - LQSTOR
-#if defined(CERNLIB_APOLLO)
- LOCAR = RSHFT (IADDR(LAREA(1)),2) - LQSTOR
- LOCR = RSHFT (IADDR(LREF(1)),2) - LQSTOR
- LOCRL = RSHFT (IADDR(LREFL(1)),2) - LQSTOR
-#endif
- NS = LOCR - LOCAR
- NL = LOCRL+1 - LOCAR
- IF (NL.EQ.1) THEN
- NS = NS + 1
- NL = NS
- ENDIF
-
- LOCARE = LOCAR + NL
- MODAR = NS
-
- NAME(1) = IQBLAN
- NAME(2) = IQBLAN
- N = MIN (8, LEN(CHNAME))
- IF (N.NE.0) CALL UCTOH (CHNAME,NAME,4,N)
-
- IQ(KQS+LSTO+1) = LOCAR
- IQ(KQS+LSTO+2) = LOCARE
- IQ(KQS+LSTO+3) = MODAR
- IQ(KQS+LSTO+4) = NAME(1)
- IQ(KQS+LSTO+5) = NAME(2)
-
-C-- Range of possible values for an origin-link
-
- IQTABV(KQT+13) = MIN (IQTABV(KQT+13), LOCAR)
- IQTABV(KQT+14) = MAX (IQTABV(KQT+14), LOCARE)
-
-#if defined(CERNLIB_QPRINT)
- IF (NQLOGL.GE.0)
- +WRITE (IQLOG,9039) NAME,JQSTOR,NL,NS
- 9039 FORMAT (1X/' MZLINK. Initialize Link Area ',2A4,' for Store'
- F,I3,' NL/NS=',2I6)
-
-#endif
-#if defined(CERNLIB_QDEBUG)
-
-C---- Check valid parameters
-
- IF (LOCR .LT.LOCAR) GO TO 91
- IF (LOCRL.LT.LOCAR) GO TO 91
- IF (NL.LT.NS) GO TO 91
-
-C------ Check overlap with existing stores
-
- KLA = KQS + LOCAR
- KLE = KQS + LOCARE
-
-#endif
-#if defined(CERNLIB_QDEVZE)
- IF (NQDEVZ.GE.7)
- +WRITE (IQLOG,9841) 4*LQSTOR, 4*LQATAB, 4*LQBTIS, 4*KLA
- +, LQSTOR,LQATAB, LQBTIS,KLA
- +, LQSTOR,LQATAB, LQBTIS,KLA
- 9841 FORMAT (1X/' DEVZE MZLINK. ',17X,'LQSTOR',17X,'LQATAB',
- F17X,'LQBTIS',20X,'KLA'
-#endif
-#if (defined(CERNLIB_QDEVZE))&&(!defined(CERNLIB_HEX))
- F/10X,'4* OCT',4O23/13X,'OCT',4O23/13X,'DEC',4I23)
-#endif
-#if (defined(CERNLIB_QDEVZE))&&(defined(CERNLIB_HEX))
- F/10X,'4* HEX',4Z23/13X,'HEX',4Z23/13X,'DEC',4I23)
-#endif
-#if defined(CERNLIB_QDEVZE)
- IF (NQDEVZ.GE.7) WRITE (IQLOG,9842) KLA,KLE
- 9842 FORMAT (16X,' KLA/KLE=',2I10)
-#endif
-#if defined(CERNLIB_QDEBUG)
-
- DO 47 JSTO=1,NQSTOR+1
- IF (NQALLO(JSTO).NE.0) GO TO 47
- JT = NQOFFT(JSTO)
- JS = NQOFFS(JSTO)
- JSA = JS - IQTABV(JT+2) + 1
- JSE = JS + LQSTA(JT+21) + 1
- JTA = JT + LQBTIS + 1
- JTE = JTA + NQTSYS
-
-#endif
-#if defined(CERNLIB_QDEVZE)
- IF (NQDEVZ.GE.7) WRITE (IQLOG,9843) JTA,JTE, JSA,JSE
- 9843 FORMAT (16X,' JTA/JTE=',2I10,' JSA/JSE=',2I10)
-#endif
-#if defined(CERNLIB_QDEBUG)
-
- IF (KLE.GT.JTA .AND. KLA.LT.JTE) GO TO 92
- IF (KLE.GT.JSA .AND. KLA.LT.JSE) GO TO 93
-
-C-- Check overlap with existing link areas
-
- L = JS+ LQSYSS(JT+1)
- N = IQ(L+1)
- IF (N.LT.12) GO TO 47
-
- DO 44 J=12,N,5
- JLA = JS + IQ(L+J)
- JLE = JS + IQ(L+J+1)
-
-#endif
-#if defined(CERNLIB_QDEVZE)
- IF (NQDEVZ.GE.7) WRITE (IQLOG,9844) JLA,JLE
- 9844 FORMAT (16X,' JLA/JLE=',2I10)
-#endif
-#if defined(CERNLIB_QDEBUG)
-
- IF (KLE.GT.JLA .AND. KLA.LT.JLE) GO TO 94
- 44 CONTINUE
- 47 CONTINUE
-#endif
-
- 61 IQ(KQS+LSYS+1) = NWTAB + 5
- CALL VZERO (LAREA,NL)
-#include "zebra/qtrace99.inc"
- RETURN
-
-C------ Error conditions
-
- 94 NQCASE = 1
- NQFATA = 3
- IQUEST(21) = IQ(L+J+3)
- IQUEST(22) = IQ(L+J+4)
- IQUEST(23) = JLA + LQSTOR
-
- 93 NQCASE = NQCASE + 1
- 92 NQCASE = NQCASE + 1
- NQFATA = NQFATA + 3
- IQUEST(18) = JSTO - 1
- IQUEST(19) = NQPNAM(JT+1)
- IQUEST(20) = NQPNAM(JT+2)
-
- 91 NQCASE = NQCASE + 1
- NQFATA = NQFATA + 7
- IQUEST(11) = NAME(1)
- IQUEST(12) = NAME(2)
- IQUEST(13) = LOCAR + LQSTOR
- IQUEST(14) = LOCR + LQSTOR
- IQUEST(15) = LOCRL + LQSTOR
- IQUEST(16) = NS
- IQUEST(17) = NL
-#include "zebra/qtofatal.inc"
- END
diff --git a/src/packlib/zebra/mq/mzlint.F b/src/packlib/zebra/mq/mzlint.F
deleted file mode 100644
index 04dcfba..0000000
--- a/src/packlib/zebra/mq/mzlint.F
+++ /dev/null
@@ -1,235 +0,0 @@
-*
-* $Id: mzlint.F,v 1.3 1999/06/18 13:30:15 couet Exp $
-*
-* $Log: mzlint.F,v $
-* Revision 1.3 1999/06/18 13:30:15 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.2 1996/04/18 16:11:40 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:18 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE MZLINT (IXSTOR,CHNAME,LAREA,LREF,LREFL)
-
-C- Set permanent link area, user called
-
-#include "zebra/zbcd.inc"
-#include "zebra/zstate.inc"
-#include "zebra/zunit.inc"
-#include "zebra/zvfaut.inc"
-#include "zebra/mqsys.inc"
-*
- DIMENSION LAREA(9),LREF(9),LREFL(9),NAME(2)
- CHARACTER *(*) CHNAME
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HMZLI, 4HNT /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HMZLINT /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'MZLINT ')
-#endif
-
-#include "zebra/q_jbyt.inc"
-#include "zebra/q_sbit1.inc"
-#include "zebra/q_locf.inc"
-
-
-#include "zebra/qtrace.inc"
-
-#include "zebra/qstore.inc"
-#if defined(CERNLIB_QDEBUG)
- IF (IQVSTA.NE.0) CALL ZVAUTX
-#endif
-
- LSYS = LQSYSS(KQT+1)
- NWTAB = IQ(KQS+LSYS+1)
- LOCAR = LOCF (LAREA(1)) - LQSTOR
-#if defined(CERNLIB_APOLLO)
- LOCAR = RSHFT (IADDR(LAREA(1)),2) - LQSTOR
-#endif
- JDES = LAREA(2)
- IF (JDES.LT.11) GO TO 21
- IF (JDES.GE.NWTAB) GO TO 21
- LSTO = LSYS + JDES
- IF (IQ(KQS+LSTO+1).NE.LOCAR) GO TO 21
- NL = IQ(KQS+LSTO+2) - LOCAR
-#if defined(CERNLIB_QDEBPRI)
- IF (NQLOGL.LT.2) GO TO 19
- WRITE (IQLOG,9018) IQ(KQS+LSTO+4),IQ(KQS+LSTO+5),JQSTOR
- 9018 FORMAT (1X/' MZLINT- Re-Init of Link Area ',2A4,' for Store',I3)
-#endif
-
-C-- Set link area active
-
- 19 LAREA(1) = 7
- CALL VZERO (LAREA(3),NL-2)
-#include "zebra/qtrace99.inc"
- RETURN
-
-C------ Initialize for the first time
-
- 21 IF (NWTAB+5.GT.IQ(KQS+LSYS-1)) THEN
- JQDIVI = JQDVSY
- CALL MZPUSH (-7,LSYS,0,100,'I')
- LQSYSS(KQT+1) = LSYS
- ENDIF
-
- LSTO = LSYS + NWTAB
- LOCR = LOCF (LREF(1)) - LQSTOR
- LOCRL = LOCF (LREFL(1)) - LQSTOR
-#if defined(CERNLIB_APOLLO)
- LOCR = RSHFT (IADDR(LREF(1)),2) - LQSTOR
- LOCRL = RSHFT (IADDR(LREFL(1)),2) - LQSTOR
-#endif
- NS = LOCR - LOCAR
- NL = LOCRL+1 - LOCAR
- IF (NL.EQ.1) THEN
- NS = NS + 1
- NL = NS
- ENDIF
-
- LOCARE = LOCAR + NL
- MODAR = MSBIT1 (NS,31)
-
- NAME(1) = IQBLAN
- NAME(2) = IQBLAN
- N = MIN (8, LEN(CHNAME))
- IF (N.NE.0) CALL UCTOH (CHNAME,NAME,4,N)
-
- IQ(KQS+LSTO+1) = LOCAR
- IQ(KQS+LSTO+2) = LOCARE
- IQ(KQS+LSTO+3) = MODAR
- IQ(KQS+LSTO+4) = NAME(1)
- IQ(KQS+LSTO+5) = NAME(2)
-
-C-- Range of possible values for an origin-link
-
- IQTABV(KQT+13) = MIN (IQTABV(KQT+13), LOCAR+2)
- IQTABV(KQT+14) = MAX (IQTABV(KQT+14), LOCARE)
-
- NSM2 = NS - 2
- NLM2 = NL - 2
-#if defined(CERNLIB_QPRINT)
- IF (NQLOGL.GE.1)
- +WRITE (IQLOG,9039) NAME,JQSTOR,NLM2,NSM2
- 9039 FORMAT (1X/' MZLINT. Initialize Link Area ',2A4,' for Store'
- F,I3,' NL/NS=',2I6)
-
-#endif
-#if defined(CERNLIB_QDEBUG)
-
-C---- Check valid parameters
-
- IF (LOCR .LT.LOCAR) GO TO 91
- IF (LOCRL.LT.LOCAR) GO TO 91
- IF (NL.LT.NS) GO TO 91
-
-C------ Check overlap with existing stores
-
- KLA = KQS + LOCAR
- KLE = KQS + LOCARE
-
-#endif
-#if defined(CERNLIB_QDEVZE)
- IF (NQDEVZ.GE.7)
- +WRITE (IQLOG,9841) 4*LQSTOR, 4*LQATAB, 4*LQBTIS, 4*KLA
- +, LQSTOR,LQATAB, LQBTIS,KLA
- +, LQSTOR,LQATAB, LQBTIS,KLA
- 9841 FORMAT (1X/' DEVZE MZLINT. ',17X,'LQSTOR',17X,'LQATAB',
- F17X,'LQBTIS',20X,'KLA'
-#endif
-#if (defined(CERNLIB_QDEVZE))&&(!defined(CERNLIB_HEX))
- F/10X,'4* OCT',4O23/13X,'OCT',4O23/13X,'DEC',4I23)
-#endif
-#if (defined(CERNLIB_QDEVZE))&&(defined(CERNLIB_HEX))
- F/10X,'4* HEX',4Z23/13X,'HEX',4Z23/13X,'DEC',4I23)
-#endif
-#if defined(CERNLIB_QDEVZE)
- IF (NQDEVZ.GE.7) WRITE (IQLOG,9842) KLA,KLE
- 9842 FORMAT (16X,' KLA/KLE=',2I10)
-#endif
-#if defined(CERNLIB_QDEBUG)
-
- DO 47 JSTO=1,NQSTOR+1
- IF (NQALLO(JSTO).NE.0) GO TO 47
- JT = NQOFFT(JSTO)
- JS = NQOFFS(JSTO)
- JSA = JS - IQTABV(JT+2) + 1
- JSE = JS + LQSTA(JT+21) + 1
- JTA = JT + LQBTIS + 1
- JTE = JTA + NQTSYS
-
-#endif
-#if defined(CERNLIB_QDEVZE)
- IF (NQDEVZ.GE.7) WRITE (IQLOG,9843) JTA,JTE, JSA,JSE
- 9843 FORMAT (16X,' JTA/JTE=',2I10,' JSA/JSE=',2I10)
-#endif
-#if defined(CERNLIB_QDEBUG)
-
- IF (KLE.GT.JTA .AND. KLA.LT.JTE) GO TO 92
- IF (KLE.GT.JSA .AND. KLA.LT.JSE) GO TO 93
-
-C-- Check overlap with existing link areas
-
- L = JS+ LQSYSS(JT+1)
- N = IQ(L+1)
- IF (N.LT.12) GO TO 47
-
- DO 44 J=12,N,5
- JLA = JS + IQ(L+J)
- JLE = JS + IQ(L+J+1)
-
-#endif
-#if defined(CERNLIB_QDEVZE)
- IF (NQDEVZ.GE.7) WRITE (IQLOG,9844) JLA,JLE
- 9844 FORMAT (16X,' JLA/JLE=',2I10)
-#endif
-#if defined(CERNLIB_QDEBUG)
-
- IF (KLE.GT.JLA .AND. KLA.LT.JLE) GO TO 94
- 44 CONTINUE
- 47 CONTINUE
-#endif
-
-C-- Success, register new link area
-
- LAREA(2) = NWTAB
- IQ(KQS+LSYS+1) = NWTAB + 5
- GO TO 19
-
-C------ Error conditions
-
- 94 NQCASE = 1
- NQFATA = 4
- IQUEST(21) = IQ(L+J+3)
- IQUEST(22) = IQ(L+J+4)
- IQUEST(23) = JLA + LQSTOR
- IQUEST(24) = LAREA(2)
-
- 93 NQCASE = NQCASE + 1
- 92 NQCASE = NQCASE + 1
- NQFATA = NQFATA + 3
- IQUEST(18) = JSTO - 1
- IQUEST(19) = NQPNAM(JT+1)
- IQUEST(20) = NQPNAM(JT+2)
-
- 91 NQCASE = NQCASE + 1
- NQFATA = NQFATA + 7
- IQUEST(11) = NAME(1)
- IQUEST(12) = NAME(2)
- IQUEST(13) = LOCAR + LQSTOR
- IQUEST(14) = LOCR + LQSTOR
- IQUEST(15) = LOCRL + LQSTOR
- IQUEST(16) = NSM2
- IQUEST(17) = NLM2
-#include "zebra/qtofatal.inc"
- END
diff --git a/src/packlib/zebra/mq/mzlogl.F b/src/packlib/zebra/mq/mzlogl.F
deleted file mode 100644
index b20618c..0000000
--- a/src/packlib/zebra/mq/mzlogl.F
+++ /dev/null
@@ -1,54 +0,0 @@
-*
-* $Id: mzlogl.F,v 1.3 1999/06/18 13:30:16 couet Exp $
-*
-* $Log: mzlogl.F,v $
-* Revision 1.3 1999/06/18 13:30:16 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.2 1996/04/18 16:11:41 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:17 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE MZLOGL (IXSTOR,LEVP)
-
-C- Set MZ logging level, user called
-
-#include "zebra/zstate.inc"
-#include "zebra/zunit.inc"
-#include "zebra/mqsys.inc"
-*
- DIMENSION LEVP(9)
-
-#include "zebra/q_jbyt.inc"
-
- LEV = LEVP(1)
- IF (LEV.GE.100) GO TO 21
-
-#include "zebra/qstore.inc"
-
- LEV = MAX (-3,LEV)
- LEV = MIN (4,LEV)
- LEP = MAX (LEV,NQLOGL)
-
- NQLOGM = LEV
- NQLOGL = LEV
- IQTABV(KQT+10) = LEV
-#if defined(CERNLIB_QDEBPRI)
- IF (LEP.GE.0) WRITE (IQLOG,9019) LEV,JQSTOR
- 9019 FORMAT (1X/' MZLOGL. Set Log Level',I2,' for store',I3)
-#endif
- RETURN
-
- 21 CONTINUE
-#if defined(CERNLIB_QDEVZE)
- NQDEVZ = LEV - 100
- NQLOGM = MIN(NQDEVZ,2)
- NQLOGL = MIN(NQDEVZ,2)
-#endif
- RETURN
- END
diff --git a/src/packlib/zebra/mq/mzmaps.F b/src/packlib/zebra/mq/mzmaps.F
deleted file mode 100644
index 17b4183..0000000
--- a/src/packlib/zebra/mq/mzmaps.F
+++ /dev/null
@@ -1,78 +0,0 @@
-*
-* $Id: mzmaps.F,v 1.3 1999/06/18 13:30:16 couet Exp $
-*
-* $Log: mzmaps.F,v $
-* Revision 1.3 1999/06/18 13:30:16 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.2 1996/04/18 16:11:42 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:20 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE MZMAPS
-
-C- Print the map of divisions in the current store
-
-#include "zebra/zunit.inc"
-#include "zebra/mqsys.inc"
-*
-
-#include "zebra/q_jbit.inc"
-#include "zebra/q_jbyt.inc"
-
-
- IF (JQSTOR.LT.0) RETURN
- IF (JQSTOR.GT.NQSTOR) RETURN
-
- WRITE (IQLOG,9021) JQSTOR,NQSNAM(1),NQSNAM(2)
- 9021 FORMAT (1X/' Map of store',I3,1X,2A4/3X,24('-')/
- F1X/3X,'Division',40X,'Number of times'
- F/14X,'Kind',16X,'Max-size',16X,'Garb-coll.'
- F/12X,'Mode Position used allowed',
- F3X,'Wiped user auto Pushd Redcd'/1X)
-
- JDIV = 1
- 32 IF (JDIV.EQ.JQDVLL+1) JDIV=JQDVSY
-
- MODE = JBIT (IQMODE(KQT+JDIV), 1)
- KIND = JBYT (IQKIND(KQT+JDIV),21,4)
- LSTA = LQSTA(KQT+JDIV)
- LEND = LQEND(KQT+JDIV)
- NINI = NQDINI(KQT+JDIV)
- NMAX = NQDMAX(KQT+JDIV)
- NAM1 = IQDN1(KQT+JDIV)
- NAM2 = IQDN2(KQT+JDIV)
-
- NSIZ = NQDSIZ(KQT+JDIV)
- NWIP = NQDWIP(KQT+JDIV)
- NGAU = NQDGAU(KQT+JDIV)
- NGAF = NQDGAF(KQT+JDIV)
- NPSH = NQDPSH(KQT+JDIV)
- NRED = NQDRED(KQT+JDIV)
-
- NWIP = MIN(NWIP,9999999)
- NGAU = MIN(NGAU,99999)
- NGAF = MIN(NGAF,99999)
- NPSH = MIN(NPSH,99999)
- NRED = MIN(NRED,99999)
-
- NSIZ = MAX (NSIZ,LEND-LSTA)
- NQDSIZ(KQT+JDIV) = NSIZ
-
- JPOS = LSTA
- IF (MODE.NE.0) JPOS=LEND
-
- WRITE (IQLOG,9032) JDIV,NAM1,NAM2,MODE,KIND
- +, JPOS,NSIZ,NMAX
- +, NWIP,NGAU,NGAF,NPSH,NRED
- 9032 FORMAT (3X,I2,1X,2A4,2I2,3I10,I8,4I6)
-
- JDIV = JDIV + 1
- IF (JDIV.LE.20) GO TO 32
- RETURN
- END
diff --git a/src/packlib/zebra/mq/mzmark.F b/src/packlib/zebra/mq/mzmark.F
deleted file mode 100644
index 3e02906..0000000
--- a/src/packlib/zebra/mq/mzmark.F
+++ /dev/null
@@ -1,230 +0,0 @@
-*
-* $Id: mzmark.F,v 1.3 1999/06/18 13:30:16 couet Exp $
-*
-* $Log: mzmark.F,v $
-* Revision 1.3 1999/06/18 13:30:16 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.2 1996/04/18 16:11:43 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:19 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE MZMARK (IXSTOR,LHEADP,CHOPT,NIDP,IDLIST)
-
-C- Run through d/s to set status-bit IQMARK into all banks
-C- of the sub-structures that start with a bank having
-C- an IDH present (or not present) in IDLIST, user called
-
-#include "zebra/zlimit.inc"
-#include "zebra/zstate.inc"
-#include "zebra/zunit.inc"
-#include "zebra/zvfaut.inc"
-#include "zebra/mqsys.inc"
-#include "zebra/mzcn.inc"
-#include "zebra/mzcwk.inc"
-*
- DIMENSION LHEADP(9),NIDP(9),IDLIST(99)
- CHARACTER *(*) CHOPT
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HMZMA, 4HRK /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HMZMARK /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'MZMARK ')
-#endif
-
-#include "zebra/q_jbit.inc"
-#include "zebra/q_jbyt.inc"
-#include "zebra/q_sbit0.inc"
-#include "zebra/q_sbit1.inc"
-
-
- LHEAD = LHEADP(1)
- NID = NIDP(1)
- IF (LHEAD.EQ.0) RETURN
-
-#include "zebra/qtrace.inc"
-#include "zebra/qstore.inc"
-
-#if defined(CERNLIB_QDEBUG)
- IF (IQVSTA.NE.0) CALL ZVAUTX
- CALL MZCHLS (-7,LHEAD)
- IF (IQFOUL.NE.0) GO TO 92
-#endif
-#if !defined(CERNLIB_QDEBUG)
- IQNS = IQ(KQS+LHEAD-2)
-#endif
- LQLIML = LQSTA(KQT+21)
- LQLIMH = 0
- NWVOL = 0
-
- CALL UOPTC (CHOPT,'-LV',IQUEST)
- IOPTN = IQUEST(1)
- IOPTS = 1 - IQUEST(3)
- IOPTH = IQUEST(2)
-#if defined(CERNLIB_QDEVZE)
- IF (NQDEVZ.NE.0)
- +WRITE (IQLOG,9814) LHEAD,NID,IOPTS,IOPTH,IOPTN
- 9814 FORMAT (1X/' DEVZE MZMARK. LHEAD,NID,IOPTS,IOPTH,IOPTN='
- F,I6,6I4)
-#endif
-
- LEV = LQWKTB + 3
- LEVE = LEV + NQWKTB - 10
- LQ(LEV-2) = 0
- LQ(LEV-1) = 0
- LQ(LEV) = LHEAD
-
- LCUR = LHEAD
- LX = LHEAD - 1 + IOPTH
- LAST = LHEAD - IQNS
- IQ(KQS+LCUR) = MSBIT1 (IQ(KQS+LCUR),IQSYSX)
- GO TO 24
-
-C-- Mark bank
-
- 20 LAST = LCUR - IQ(KQS+LCUR-2)
- ITEMP = MSBIT0 (IQ(KQS+LNEW),IQSYSX)
- IQ(KQS+LNEW) = MSBIT1 (ITEMP, IQMARK)
- LQLIML = MIN (LQLIML,LNEW)
- LQLIMH = MAX (LQLIMH,LNEW)
- NWVOL = NWVOL + 10 + JBYT (IQ(KQS+LNEW),19,4) +
- + IQ(KQS+LNEW-1) + IQ(KQS+LNEW-3)
-
-C---- Look at next down link
-
- 24 IF (LX.LT.LAST) GO TO 41
- LNEW = LQ(KQS+LX)
- LX = LX - 1
- IF (LNEW.EQ.0) GO TO 24
-
-#if defined(CERNLIB_QDEBUG)
- CALL MZCHLS (-7,LNEW)
- IF (IQFOUL.NE.0) GO TO 94
-#endif
- IF (JBIT(IQ(KQS+LNEW),IQSYSX).NE.0) GO TO 24
- IF (NID.EQ.0) GO TO 29
- IDNEW = IQ(KQS+LNEW-4)
- INLIST = IUCOMP (IDNEW,IDLIST,NID)
-#if defined(CERNLIB_QDEVZE)
- IF (NQDEVZ.GE.7)
- +WRITE (IQLOG,9826) LEV,LCUR,LX+1,LNEW,IDNEW,INLIST
- 9826 FORMAT (' DEVZE MZMARK, Fresh: LEV,LCUR,LX+1,LNEW=',4I8,
- F' ID,JID=',A4,I4)
-#endif
- IF (MIN(INLIST,1)-IOPTN.EQ.0) GO TO 24
- 29 CONTINUE
-
-C---- New bank LNEW, push down
-
- LQ(LEV+1) = LX
- LQ(LEV+2) = LCUR
-
- LEV = LEV + 3
- IF (LEV.GE.LEVE) GO TO 91
- LQ(LEV) = LNEW
-#if defined(CERNLIB_QDEVZE)
- IF (NQDEVZ.GE.7)
- +WRITE (IQLOG,9831) LEV,LCUR,LX+1,LNEW
- 9831 FORMAT (' DEVZE MZMARK, Down: LEV,LCUR,LX+1,LNEW=',6I8)
-#endif
-
-C-- Move to end of linear structure
-
- 32 LCUR = LNEW
- IQ(KQS+LCUR) = MSBIT1 (IQ(KQS+LCUR),IQSYSX)
- LNEW = LQ(KQS+LCUR)
- IF (LNEW.EQ.0) GO TO 36
-#if defined(CERNLIB_QDEVZE)
- IF (NQDEVZ.GE.7)
- +WRITE (IQLOG,9833) LCUR,LNEW
- 9833 FORMAT (' DEVZE MZMARK, Along: LCUR,LNEW=',6I8)
-#endif
-#if defined(CERNLIB_QDEBUG)
- CALL MZCHLS (-7,LNEW)
- IF (IQFOUL.NE.0) GO TO 93
- IF (JBIT(IQ(KQS+LNEW),IQSYSX).NE.0) GO TO 36
- IF (LQ(KQS+LNEW+2).NE.LCUR) GO TO 95
- GO TO 32
-
- 36 CONTINUE
-#endif
-#if !defined(CERNLIB_QDEBUG)
- IF (JBIT(IQ(KQS+LNEW),IQSYSX).EQ.0) GO TO 32
-
- 36 IQNS = IQ(KQS+LCUR-2)
-#endif
- LAST = LCUR - IQNS
- LX = LCUR - 1
- GO TO 24
-
-C---- Bank at LCUR has no further secondaries
-C-- step back in the linear structure
-
- 41 LNEW = LCUR
- IF (LCUR.EQ.LQ(LEV)) GO TO 46
- LCUR = LQ(KQS+LCUR+2)
- LX = LCUR - 1
-#if defined(CERNLIB_QDEVZE)
- IF (NQDEVZ.GE.7)
- +WRITE (IQLOG,9841) LCUR,LNEW
- 9841 FORMAT (' DEVZE MZMARK, Back: LCUR,LNEW=',6I8)
-#endif
- GO TO 20
-
-C-- Start of linear structure reached, pop up
-
- 46 LEV = LEV - 3
- LX = LQ(LEV+1)
- LCUR = LQ(LEV+2)
-#if defined(CERNLIB_QDEVZE)
- IF (NQDEVZ.GE.7)
- +WRITE (IQLOG,9846) LEV,LCUR,LX
- 9846 FORMAT (' DEVZE MZMARK, Up: LEV,LCUR,LX=',6I8)
-#endif
- IF (LCUR.NE.0) GO TO 20
-
-C---- Done, mark header bank
-
- 61 IQ(KQS+LHEAD) = MSBIT0 (IQ(KQS+LHEAD),IQSYSX)
- IF (IOPTS.EQ.0) GO TO 999
- IQ(KQS+LHEAD) = MSBIT1 (IQ(KQS+LHEAD),IQMARK)
- LQLIML = MIN (LQLIML,LHEAD)
- LQLIMH = MAX (LQLIMH,LHEAD)
- NWVOL = NWVOL + 10 + JBYT (IQ(KQS+LHEAD),19,4) +
- + IQ(KQS+LHEAD-1) + IQ(KQS+LHEAD-3)
-#include "zebra/qtrace99.inc"
- IQUEST(2) = NWVOL
- RETURN
-
-C------ Error conditions
-
-#if defined(CERNLIB_QDEBUG)
- 95 NQCASE = 2
- NQFATA = 1
- IQUEST(14) = LQ(KQS+LNEW+2)
- GO TO 93
-
- 94 NQCASE = 1
- NQFATA = 1
- IQUEST(14) = LX+1 - LCUR
- 93 NQCASE = NQCASE + 1
- NQFATA = NQFATA + 2
- IQUEST(12) = LNEW
- IQUEST(13) = LCUR
- 92 NQCASE = NQCASE + 1
-#endif
- 91 NQCASE = NQCASE + 1
- NQFATA = NQFATA + 1
- IQUEST(11) = LHEAD
-#include "zebra/qtofatal.inc"
- END
diff --git a/src/packlib/zebra/mq/mzneed.F b/src/packlib/zebra/mq/mzneed.F
deleted file mode 100644
index 1cfa04e..0000000
--- a/src/packlib/zebra/mq/mzneed.F
+++ /dev/null
@@ -1,88 +0,0 @@
-*
-* $Id: mzneed.F,v 1.3 1999/06/18 13:30:17 couet Exp $
-*
-* $Log: mzneed.F,v $
-* Revision 1.3 1999/06/18 13:30:17 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.2 1996/04/18 16:11:55 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:20 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE MZNEED (IXDIV,NEEDP,CHOPT)
-
-C- Check that NEEDP words are available in the specified division,
-C- without garbage collection, unless option G is given;
-C- return in IQUEST(11) the space available beyond this,
-C- i.e. IQUEST(11) negative if not enough space;
-C- return IQUEST(12/13) = current/maximum size of division;
-C- user called
-
-#include "zebra/zunit.inc"
-#include "zebra/zvfaut.inc"
-#include "zebra/mqsys.inc"
-#include "zebra/mzct.inc"
-*
- DIMENSION IXDIV(9),NEEDP(9)
- CHARACTER *(*) CHOPT
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HMZNE, 4HED /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HMZNEED /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'MZNEED ')
-#endif
-
-#include "zebra/q_jbyt.inc"
-
-
-#include "zebra/qtrace.inc"
-#if defined(CERNLIB_QDEBUG)
- IF (IQVSTA.NE.0) CALL ZVAUTX
-#endif
-
- JDV = IXDIV(1)
- NEED = NEEDP(1)
- IF (JBYT(JDV,27,6).NE.JQSTOR) GO TO 22
- JQDIVI = JBYT (JDV,1,26)
- IF (JQDIVI.EQ.0) GO TO 22
- IF (JQDIVI.LT.21) GO TO 23
- 22 CALL MZSDIV (JDV,4)
- 23 CONTINUE
-
-C-- Allocate space
-
- CALL MZRESV
- NQRESV = NQRESV - NEED
- IF (NQRESV.LT.0) GO TO 41
-
- 28 IQUEST(11) = NQRESV
- IQUEST(12) = LQEND(KQT+JQDIVI) - LQSTA(KQT+JQDIVI)
- IQUEST(13) = NQDMAX(KQT+JQDIVI)
-#if defined(CERNLIB_QDEBPRI)
- IF (NQLOGL.GE.2)
- + WRITE (IQLOG,9029) JQSTOR,JQDIVI,NEED,NQRESV,CHOPT
- 9029 FORMAT (' MZNEED- Store/Div',2I3,' NEED/Excess=',2I8
- F,' Opt=',A)
-#endif
-#include "zebra/qtrace99.inc"
- RETURN
-
-C---- Garbage collection
-
- 41 CALL UOPTC (CHOPT,'G',IQUEST)
- IF (IQUEST(1).EQ.0) GO TO 28
- NQPERM = 1
- CALL MZGAR1
- NQPERM = 0
- GO TO 28
- END
diff --git a/src/packlib/zebra/mq/mzpaw.F b/src/packlib/zebra/mq/mzpaw.F
deleted file mode 100644
index ce42505..0000000
--- a/src/packlib/zebra/mq/mzpaw.F
+++ /dev/null
@@ -1,39 +0,0 @@
-*
-* $Id: mzpaw.F,v 1.2 1999/06/18 13:30:18 couet Exp $
-*
-* $Log: mzpaw.F,v $
-* Revision 1.2 1999/06/18 13:30:18 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:17 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE MZPAW (NWORDS,CHOPT)
-
-C- Initialize the store /PAWC/ of at least 10000 words;
-C- if NWORDS > 10000 it is assumed by MZPAW that the user
-C- has dimensioned it with COMMON/PAWC/PAW(NWORDS)
-C- The M options causes a CALL MZEBRA (-1).
-C- Called by <USER> ,HBOOK,KU,HIGZ
-
- COMMON /PAWC/ NWPAW,IXPAWC,IHBOOK,IXHIGZ,IXKU,IFENCE(5)
- +, LMAIN, IPAW(9989)
-C--------------------------------------------------------------------
- CHARACTER *(*) CHOPT
-
- CALL UOPTC (CHOPT,'M',IPAW)
-
- IF (IPAW(1).NE.0) CALL MZEBRA(-1)
-
- NW = MAX (NWORDS,10000)
- CALL MZSTOR (IXPAWC,'/PAWC/',' ',IFENCE,LMAIN,IPAW(1),IPAW(1),
- + IPAW(5000),IPAW(NW-11))
- NWPAW = NW
- IHBOOK = 0
- IXHIGZ = 0
- IXKU = 0
- RETURN
- END
diff --git a/src/packlib/zebra/mq/mzpudx.F b/src/packlib/zebra/mq/mzpudx.F
deleted file mode 100644
index e841253..0000000
--- a/src/packlib/zebra/mq/mzpudx.F
+++ /dev/null
@@ -1,50 +0,0 @@
-*
-* $Id: mzpudx.F,v 1.3 1999/06/18 13:30:18 couet Exp $
-*
-* $Log: mzpudx.F,v $
-* Revision 1.3 1999/06/18 13:30:18 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.2 1996/04/18 16:11:57 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:19 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE MZPUDX (LP,NWP)
-
-C- Mark a dead area of NW words in the current store at adr L
-C- (slave to MZPUSH)
-
-#include "zebra/zbcd.inc"
-#include "zebra/mqsysh.inc"
-*
- DIMENSION LP(9),NWP(9)
-
-#include "zebra/q_sbit1.inc"
-#include "zebra/q_sbyt.inc"
-
- L = LP(1)
- NW = NWP(1)
- ND = NW - 10
- N = MIN (10,NW)
-
- DO 12 J=0,N-1
- 12 LQ(KQS+L+J) = 0
-
- IF (ND.GE.0) THEN
- LQ(KQS+L) = 12
- L = L + 9
- LQ(KQS+L-4) = IQLETT(4)
- LQ(KQS+L-1) = ND
- ELSE
- N = MSBYT (NW,N,17,6)
- LQ(KQS+L) = N
- ENDIF
-
- LQ(KQS+L) = MSBIT1 (LQ(KQS+L),IQDROP)
- RETURN
- END
diff --git a/src/packlib/zebra/mq/mzpush.F b/src/packlib/zebra/mq/mzpush.F
deleted file mode 100644
index f6c7714..0000000
--- a/src/packlib/zebra/mq/mzpush.F
+++ /dev/null
@@ -1,437 +0,0 @@
-*
-* $Id: mzpush.F,v 1.3 1999/06/18 13:30:18 couet Exp $
-*
-* $Log: mzpush.F,v $
-* Revision 1.3 1999/06/18 13:30:18 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.2 1996/04/18 16:11:58 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:19 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE MZPUSH (IXDIV,LORGP,INCNLP,INCNDP,CHOPT)
-
-C- Change the size of a bank, user called
-
-#include "zebra/zbcd.inc"
-#include "zebra/zstate.inc"
-#include "zebra/zunit.inc"
-#include "zebra/zvfaut.inc"
-#include "zebra/mqsys.inc"
-#include "zebra/mzcl.inc"
-#include "zebra/mzcn.inc"
-#include "zebra/mzct.inc"
-*
- DIMENSION IXDIV(9),LORGP(9),INCNLP(9),INCNDP(9)
- CHARACTER *(*) CHOPT
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HMZPU, 4HSH /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HMZPUSH /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'MZPUSH ')
-#endif
-
-#include "zebra/q_jbit.inc"
-#include "zebra/q_jbyt.inc"
-#include "zebra/q_sbit1.inc"
-#include "zebra/q_sbyt.inc"
-
-#include "zebra/qtrace.inc"
-
- IF (IXDIV(1).EQ.-7) GO TO 12
- CALL MZSDIV (IXDIV,0)
-
- 12 CALL MZCHNB (LORGP)
- LORG = LORGP(1)
- INCNL = INCNLP(1)
- INCND = INCNDP(1)
-
- CALL UOPTC (CHOPT,'RI',IQUEST)
- IFLAG = MIN (2, IQUEST(1)+2*IQUEST(2))
-
-C- IFLAG = 0 general
-C- 1 R-educe
-C- 2 I-solated
-
-#if defined(CERNLIB_QDEVZE)
- IF (NQDEVZ.NE.0)
- +WRITE (IQLOG,9809) LORG,INCNL,INCND,IFLAG
- 9809 FORMAT (1X/' DEVZE MZPUSH, Entry for LORG,INCNL,INCND,IFLAG= '
- F,5I8)
-#endif
-#if defined(CERNLIB_QDEBUG)
- IF (IQVSTA.NE.0) CALL ZVAUTX
-#endif
- IF ((INCNL.EQ.0) .AND. (INCND.EQ.0)) GO TO 999
- LQSYSR(KQT+1) = LORG
-
-C-- Find division
-
- JQDIVI = MZFDIV (-7, LORG)
- IF (JQDIVI.EQ.0) GO TO 91
-
-C-- Set bank parameters
-
-#if defined(CERNLIB_QDEBUG)
- CALL MZCHLS (-7,LORG)
- IF (IQFOUL.NE.0) GO TO 91
- NL = IQNL
- NS = IQNS
- ND = IQND
- NQNIO = IQNIO
- NQID = IQID
-#endif
-#if defined(CERNLIB_QDEVZE)
- IF (NQDEVZ.GE.7)
- +WRITE (IQLOG,9831) JQDIVI,IQLS,IQID,IQNL,IQNS,IQND
- 9831 FORMAT (16X,'JQDIVI,IQLS,IQID,IQNL,IQNS,IQND=',I3,I7,1X,A4,4I8)
-#endif
-#if !defined(CERNLIB_QDEBUG)
- NQID = IQ(KQS+LORG-4)
- NL = IQ(KQS+LORG-3)
- NS = IQ(KQS+LORG-2)
- ND = IQ(KQS+LORG-1)
- NQNIO = JBYT (IQ(KQS+LORG),19,4)
-#endif
- NQNL = NL + INCNL
- NQNS = MIN (NS,NQNL)
- NQND = ND + INCND
- IF (NS.EQ.NL) NQNS = NQNL
-#if defined(CERNLIB_QDEBPRI)
- IF (NQLOGL.GE.2)
- + WRITE (IQLOG,9032) JQSTOR,JQDIVI,LORG,NQID,INCNL,INCND,CHOPT
- 9032 FORMAT (' MZPUSH- Store/Div',2I3,' L/ID/INCNL/INCND/OPT=',
- FI9,1X,A4,2I7,1X,A)
-#endif
- IF (JBIT(IQ(KQS+LORG),IQDROP).NE.0) GO TO 92
-
-C-- Check for bad parameters
-
- IF (NQND+NQNL.GE.LQSTA(KQT+21)) GO TO 93
- IF (NQND.LT.0) GO TO 93
- IF (NQNL.GT.64000) GO TO 93
- IF (NQNS.LT.0) GO TO 93
-
- NLC = MIN (NL,NQNL)
- NSC = MIN (NS,NQNS)
- NDC = MIN (ND,NQND)
-
-C-- Check giving up non-zero structural links
-
- IF (NQNS.GE.NS) GO TO 36
- L = LORG - NS - 1
- LD = LORG - NQNS
- 34 L = L + 1
- IF (L.GE.LD) GO TO 36
- LNZ = LQ(KQS+L)
- 35 IF (LNZ.EQ.0) GO TO 34
- IF (LQ(KQS+LNZ+2).NE.L) GO TO 34
- IF (JBIT(IQ(KQS+LNZ),IQDROP).EQ.0) GO TO 94
- LNZ = LQ(KQS+LNZ)
- GO TO 35
-
-C-- Ready I/O characteristic
-
- 36 LN = LORG - NL - NQNIO - 1
- CALL UCOPY (LQ(KQS+LN),NQIOCH,NQNIO+1)
- IF (NQNIO.NE.0) NQIOSV(1)=0
- NQIOCH(1) = MSBYT (NQNL+NQNIO+12,NQIOCH(1),1,16)
-
-C-- Re-enter after garbage collection, if any
-
- 41 LE = LORG + ND + 9
-
-C------ Check for short-cuts
-
- INCTT = INCNL + INCND
- INCMX = MAX (INCNL,INCND)
- INCMI = MIN (INCNL,INCND)
- CALL MZRESV
- IF (JQMODE.NE.0) GO TO 45
-
-C-- Last bank in forward division
-
- IF (LE.NE.LQEND(KQT+JQDIVI)) GO TO 51
- IF (INCNL.GE.0) GO TO 42
- IF (IFLAG.NE.1) GO TO 42
- IF ((NQRESV.GE.INCTT).AND.(NQRESV.LT.INCND)) GO TO 42
-
- LNN = LN - INCNL
- CALL UCOPY (NQIOCH,LQ(KQS+LNN),NQNIO+1)
- IQ(KQS+LORG-3) = NQNL
- IQ(KQS+LORG-2) = NQNS
-
- NWD = -INCNL
- CALL MZPUDX (LN,NWD)
- INCNL = 0
- INCTT = INCND
- LN = LNN
- NL = NQNL
-
- 42 NQRESV = NQRESV - INCTT
- IF (NQRESV.LT.0) GO TO 49
- NDELTA = INCNL
- LNEW = LORG + NDELTA
- LQEND(KQT+JQDIVI) = LQEND(KQT+JQDIVI) + INCTT
-#if defined(CERNLIB_QDEVZE)
- IF (NQDEVZ.GE.7) WRITE (IQLOG,9848) NDELTA,LNEW
-#endif
- IF (NDELTA.EQ.0) THEN
- IQ(KQS+LNEW-1) = NQND
- IF (IFLAG.NE.0) GO TO 81
- IF (INCMI.GE.0) GO TO 81
- GO TO 71
- ELSE
- CALL UCOPY2 (LQ(KQS+LORG-NLC),LQ(KQS+LNEW-NLC),NLC+NDC+9)
- IF (INCNL.GT.0) CALL VZERO (LQ(KQS+LNEW-NQNL),INCNL)
- LQ(KQS+LN) = NQIOCH(1)
- IQ(KQS+LNEW-3) = NQNL
- IQ(KQS+LNEW-2) = NQNS
- IQ(KQS+LNEW-1) = NQND
- GO TO 61
- ENDIF
-
-C-- First bank in reverse division
-
- 45 IF (LN.NE.LQSTA(KQT+JQDIVI)) GO TO 51
- IF (INCND.GE.0) GO TO 47
- IF (IFLAG.NE.1) GO TO 47
- IF ((NQRESV.GE.INCTT).AND.(NQRESV.LT.INCNL)) GO TO 47
- IQ(KQS+LORG-1) = NQND
-
- L = LE + INCND
- NWD = -INCND
- CALL MZPUDX (L,NWD)
- INCND = 0
- INCTT = INCNL
- ND = NQND
-
- 47 NQRESV = NQRESV - INCTT
- IF (NQRESV.LT.0) GO TO 49
- LNN = LN - INCTT
- NDELTA = -INCND
- LQSTA(KQT+JQDIVI) = LNN
-
- LNEW = LORG + NDELTA
-
- IF (NDELTA.NE.0) CALL UCOPY2 (LQ(KQS+LORG-NLC)
- +, LQ(KQS+LNEW-NLC), NLC+NDC+9)
-
- IF (INCNL.GT.0) CALL VZERO (LQ(KQS+LNEW-NQNL),INCNL)
- CALL UCOPY (NQIOCH,LQ(KQS+LNN),NQNIO+1)
-
- IQ(KQS+LNEW-3) = NQNL
- IQ(KQS+LNEW-2) = NQNS
- IQ(KQS+LNEW-1) = NQND
-#if defined(CERNLIB_QDEVZE)
- IF (NQDEVZ.GE.7) WRITE (IQLOG,9848) NDELTA,LNEW
- 9848 FORMAT (' DEVZE MZPUSH, Edge bank with NDELTA,LNEW=',2I8)
-#endif
-
- IF (NDELTA.NE.0) GO TO 61
- IF (IFLAG.NE.0) GO TO 81
- IF (INCMI.GE.0) GO TO 81
- GO TO 71
-
-C-- Garbage collection
-
- 49 CALL MZGAR1
- LORG = LQSYSR(KQT+1)
- LN = LORG - NL - NQNIO - 1
-#if defined(CERNLIB_QDEVZE)
- IF (NQDEVZ.GE.7)
- +WRITE (IQLOG,9849)
- 9849 FORMAT (1X/' DEVZE MZPUSH, Garbage collected for edge bank')
-#endif
- GO TO 41
-
-C---- Reduction only
-
- 51 IF (INCMX.GT.0) GO TO 56
- IF (INCNL.EQ.0) GO TO 52
-
-C-- Link part
-
- LNN = LN - INCNL
- CALL UCOPY (NQIOCH,LQ(KQS+LNN),NQNIO+1)
- IQ(KQS+LORG-3)= NQNL
- IQ(KQS+LORG-2)= NQNS
-
- CALL MZPUDX (LN,-INCNL)
-
-#if defined(CERNLIB_QDEVZE)
- IF (NQDEVZ.GE.7)
- +WRITE (IQLOG,9851) INCNL
- 9851 FORMAT (' DEVZE MZPUSH, In-situ links with INCNL=',I8)
-#endif
- IF (INCND.EQ.0) GO TO 54
-
-C-- Data part
-
- 52 IQ(KQS+LORG-1) = NQND
- LD = LE + INCND
- NWD = -INCND
- CALL MZPUDX (LD,NWD)
-#if defined(CERNLIB_QDEVZE)
- IF (NQDEVZ.GE.7)
- +WRITE (IQLOG,9852) INCND
- 9852 FORMAT (' DEVZE MZPUSH, In-situ data with INCND=',I8)
-#endif
-
- 54 LNEW = LORG
- NDELTA = 0
- IF (IFLAG.NE.0) GO TO 999
- GO TO 71
-
-C------ Lift replacement bank
-
- 56 J = 64*(32*NQNIO + NQNIO + 1) + 1
- NQIOCH(1) = MSBYT (J,NQIOCH(1),1,16)
-
- NQBIA = 2
- CALL MZLIFT (-7,LNEW,0,63,NQID,-1)
- LORG = LQSYSR(KQT+1)
- NDELTA = LNEW - LORG
-
- CALL UCOPY (LQ(KQS+LORG-NLC),LQ(KQS+LNEW-NLC),NLC+4)
- CALL UCOPY (IQ(KQS+LORG), IQ(KQS+LNEW), NDC+1)
- IQ(KQS+LORG) = MSBIT1 (IQ(KQS+LORG),IQDROP)
-#if defined(CERNLIB_QDEVZE)
- IF (NQDEVZ.GE.7)
- +WRITE (IQLOG,9857) LORG,LNEW
- 9857 FORMAT (' DEVZE MZPUSH, Push by copy LORG -> LNEW=',2I8)
-#endif
-
-C------ Up-date immediate links only
-
- 61 IF (IFLAG.LT.2) GO TO 71
-#if defined(CERNLIB_QDEVZE)
- IF (NQDEVZ.GE.7)
- +WRITE (IQLOG,9861)
- 9861 FORMAT (' DEVZE MZPUSH, Update immediate links only')
-#endif
-
-C---- Update according to k-link in pushed bank
-
- K = LQ(KQS+LNEW+2)
- IF (K.EQ.0) GO TO 62
- IF (LQ(KQS+K).NE.LORG) GO TO 95
- LQ(KQS+K) = LNEW
-
-C---- Update according to link 0
-
- 62 K = LNEW
- L = LQ(KQS+K)
- IF (L.EQ.0) GO TO 65
- IF (L.EQ.LORG) GO TO 64
- LQ(KQS+L+2) = K
- 63 K = L
- L = LQ(KQS+K)
- IF (L.EQ.0) GO TO 65
- IF (L.NE.LORG) GO TO 63
- 64 LQ(KQS+K) = LNEW
-
-C---- Update k- and up-link in vertically dependent banks
-
- 65 K = LNEW - NSC - 1
-
-C-- each link
- 66 K = K + 1
- IF (K.GE.LNEW) GO TO 81
- L = LQ(KQS+K)
- IF (L.EQ.0) GO TO 66
- IF (LQ(KQS+L+2).NE.K-NDELTA) GO TO 66
- LQ(KQS+L+2) = K
-
-C-- and its linear structure
-
- LF = L
- 68 LQ(KQS+L+1) = LNEW
- L = LQ(KQS+L)
- IF (L.EQ.LF) GO TO 66
- IF (L.NE.0) GO TO 68
- GO TO 66
-
-C------ Global update of links
-
- 71 MQDVGA = 0
- MQDVWI = 0
- JQSTMV = -1
-#if defined(CERNLIB_QDEBPRI)
- IF (NQLOGL.GE.1)
- + WRITE (IQLOG,9071) JQSTOR,JQDIVI,LORG,NQID
- 9071 FORMAT (' MZPUSH- Store/Div',2I3,' Relocation pass for L/ID ='
- F,I9,1X,A4)
-#endif
-#if defined(CERNLIB_QDEVZE)
- IF (NQDEVZ.GE.7)
- +WRITE (IQLOG,9871)
- 9871 FORMAT (' DEVZE MZPUSH, Update by relocation pass')
-#endif
-
- CALL MZTABM
-
- LMT = LQMTA - 8
- 74 LMT = LMT + 8
- IF (LQ(LMT).NE.JQDIVI) GO TO 74
- LQ(LMT+1) = 2
-
- CALL MZTABX
- LQMTE = LQMTLU
-
- LQ(LQTA-1) = LORG - NL - NQNIO - 1
- LQ(LQTA) = LORG - NLC
- LQ(LQTA+1) = LORG + NDC + 9
- LQ(LQTA+2) = NDELTA
- LQ(LQTA+3) = 0
- LQ(LQTA+4) = LORG + ND + 9
-
- LQTE = LQTA + 4
-
- CALL MZRELX
-
- NQDPSH(KQT+JQDIVI) = NQDPSH(KQT+JQDIVI) + 1
-
-C------ Finished, reset LORG, clear new data words
-
- 81 LORGP(1) = LNEW
- IF (INCND.GT.0) CALL VZERO (IQ(KQS+LNEW+ND+1),INCND)
-#include "zebra/qtrace99.inc"
- RETURN
-
-C---- Error conditions
-
- 95 NQCASE = 3
- NQFATA = 1
- IQUEST(19) = K
- GO TO 92
-
- 94 NQCASE = 1
- NQFATA = 2
- IQUEST(19) = L - LORG
- IQUEST(20) = LQ(KQS+L)
- 93 NQCASE = NQCASE + 1
- 92 NQCASE = NQCASE + 1
- NQFATA = NQFATA + 7
- IQUEST(12) = NQID
- IQUEST(13) = NS
- IQUEST(14) = NL
- IQUEST(15) = ND
- IQUEST(16) = NQNIO
- IQUEST(17) = INCNL
- IQUEST(18) = INCND
- 91 NQCASE = NQCASE + 1
- NQFATA = NQFATA + 1
- IQUEST(11) = LORG
-#include "zebra/qtofatal.inc"
- END
diff --git a/src/packlib/zebra/mq/mzrepl.F b/src/packlib/zebra/mq/mzrepl.F
deleted file mode 100644
index 95f3cda..0000000
--- a/src/packlib/zebra/mq/mzrepl.F
+++ /dev/null
@@ -1,405 +0,0 @@
-*
-* $Id: mzrepl.F,v 1.3 1999/06/18 13:30:19 couet Exp $
-*
-* $Log: mzrepl.F,v $
-* Revision 1.3 1999/06/18 13:30:19 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.2 1996/04/18 16:12:04 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:19 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE MZREPL (IXDIV,LIXP,CHOPT)
-
-C- Link replacement banks and relocate, user called
-
-#include "zebra/zstate.inc"
-#include "zebra/zunit.inc"
-#include "zebra/zvfaut.inc"
-#include "zebra/mqsys.inc"
-#include "zebra/eqlqmst.inc"
-#include "zebra/mzcl.inc"
-#include "zebra/mzcn.inc"
-#include "zebra/mzct.inc"
-*
- DIMENSION IXDIV(9),LIXP(9)
- CHARACTER CHOPT*(*)
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HMZRE, 4HPL /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HMZREPL /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'MZREPL ')
-#endif
-
-#include "zebra/q_sbit1.inc"
-#include "zebra/q_locf.inc"
-
-#include "zebra/qtrace.inc"
-
- CALL MZSDIV (IXDIV,7)
-
- CALL UOPTC (CHOPT,'KI',IQUEST)
- IFLAG = IQUEST(1)
- ISOLA = IQUEST(2)
-
-C- IFLAG = 0 drop old and index
-C- 1 keep old and index
-
- IXGARB = 0
- LIXO = LIXP(1)
-#if defined(CERNLIB_QDEBPRI)
- IF (NQLOGL.LT.2) GO TO 12
- WRITE (IQLOG,9001) JQSTOR,JQDIVI,LIXO,CHOPT
- 9001 FORMAT (1X/' MZREPL- Store/Div/Lix/CHOPT :',2I3,I8,1X,A)
-
-#endif
-#if defined(CERNLIB_QDEBUG)
- IF (IQVSTA.NE.0) CALL ZVAUTX
-#endif
-#if defined(CERNLIB_QDEVZE)
- IF (NQDEVZ.LT.3) GO TO 12
- WRITE (IQLOG,9811)
- 9811 FORMAT (1X/20X,'Lix link 1 link 2')
- 9824 FORMAT (5X,3I9,1X,A4,I9,1X,A4)
-#endif
-
- 12 IF (LIXO.EQ.0) GO TO 999
-
-C-- Find division
-
- IF (JQDIVI.EQ.0) THEN
- JQDIVI = MZFDIV (-7, LQ(KQS+LIXO-1))
- IF (JQDIVI.EQ.0) GO TO 91
- ENDIF
-
- LIMDLO = LQSTA(KQT+JQDIVI)
- LIMDUP = LQEND(KQT+JQDIVI)
-
-C-- Get the number of index banks
-
- LIX = LIXO
- NIX = 0
- 24 NIX = NIX + 1
-#if defined(CERNLIB_QDEBUG)
-
-C-- check index bank valid
- CALL MZCHLS (-7,LIX)
- IF (IQFOUL.NE.0) GO TO 93
- LOLD = LQ(KQS+LIX-1)
- LNEW = LQ(KQS+LIX-2)
-
- IF (IQ(KQS+LIX-3).LT.2) GO TO 94
- IF (IFLAG.NE.0) THEN
- IF (IQ(KQS+LIX-1).EQ.0) GO TO 94
- ENDIF
-
-C-- check old/new all in same division
- IF (LOLD.LT.LIMDLO) GO TO 95
- IF (LOLD.GE.LIMDUP) GO TO 95
- IF (LNEW.LT.LIMDLO) GO TO 95
- IF (LNEW.GE.LIMDUP) GO TO 95
-
-C-- check old/new valid banks
- CALL MZCHLS (-7,LOLD)
- IF (IQFOUL.NE.0) GO TO 96
-
- CALL MZCHLS (-7,LNEW)
- IF (IQFOUL.NE.0) GO TO 97
-
-C-- check origin-link consistent
- K = LQ(KQS+LOLD+2)
- IF (K.NE.0) THEN
- IF (LQ(KQS+K).NE.LOLD) GO TO 98
- ENDIF
-
-C-- check next-link consistent
- L = LQ(KQS+LOLD)
- IF (L.NE.0) THEN
- IF (LQ(KQS+L+2).NE.LOLD) GO TO 99
- ENDIF
-
-#endif
-#if defined(CERNLIB_QDEVZE)
- IF (NQDEVZ.GE.3) WRITE (IQLOG,9824) NIX,LIX,
- + LOLD,IQ(KQS+LOLD-4),LNEW,IQ(KQS+LNEW-4)
-#endif
- LIX = LQ(KQS+LIX)
- IF (LIX.NE.0) GO TO 24
- IF (ISOLA.NE.0) GO TO 61
-
-C-- Re-link the index structure to MZ working link
-
- CALL MZCHNB (LIXP)
- LQSYSR(KQT+1) = LQ(KQS+LIXO+1)
- LQSYSR(KQT+2) = LQ(KQS+LIXO+2)
- LQMST(KQT+1) = LIXO
- LQ(KQS+LIXO+2) = LOCF (LQMST(KQT+1)) - LQSTOR
- IF (NIX.EQ.1) GO TO 31
-
-C-- Sort the index banks for increasing LOLD
-
- LIXN = LQ(KQS+LIXO)
- IF (LQ(KQS+LIXN-1).LT.LQ(KQS+LIXO-1)) THEN
- CALL ZTOPSY (IXDIV,LIXO)
- LIXO = LQMST(KQT+1)
- ENDIF
-
- CALL ZSORTI (IXDIV,LIXO,-9)
- LIXO = LQMST(KQT+1)
-#if defined(CERNLIB_QDEVZE)
- IF (NQDEVZ.LT.3) GO TO 31
- WRITE (IQLOG,9811)
- LIX = LIXO
- JIX = 1
- 27 LOLD = LQ(KQS+LIX-1)
- LNEW = LQ(KQS+LIX-2)
- WRITE (IQLOG,9824) JIX,LIX,
- + LOLD,IQ(KQS+LOLD-4),LNEW,IQ(KQS+LNEW-4)
- LIX = LQ(KQS+LIX)
- JIX = JIX + 1
- IF (LIX.NE.0) GO TO 27
-#endif
-
-C------ Relocation
-
- 31 MQDVGA = 0
- MQDVWI = 0
- JQSTMV = -1
-
- CALL MZTABM
-
- LMT = LQMTA - 8
- 34 LMT = LMT + 8
- IF (LQ(LMT).NE.JQDIVI) GO TO 34
- LQ(LMT+1) = 2
-
- CALL MZTABX
- LQMTE = LQMTLU
-
-C-- construct the link relocation table
-
- IFIRST = 7
- LIX = LIXO
- 37 LOLD = LQ(KQS+LIX-1)
- LNEW = LQ(KQS+LIX-2)
-
-#if !defined(CERNLIB_QDEBUG)
- IF (LOLD.LT.LIMDLO) GO TO 95
- IF (LOLD.GE.LIMDUP) GO TO 95
- IF (LNEW.LT.LIMDLO) GO TO 95
- IF (LNEW.GE.LIMDUP) GO TO 95
-#endif
- NL = IQ(KQS+LOLD-3)
- ND = IQ(KQS+LOLD-1)
- NLC = MIN (IQ(KQS+LNEW-3), NL)
- NDC = MIN (IQ(KQS+LNEW-1), ND)
-
- IF (IFIRST.NE.0) THEN
- LQ(LQTA-1) = LOLD - NLC
- LQTE = LQTA
- IFIRST = 0
- ELSE
- LQ(LQTE) = LQ(LQTE-3)
- LQ(LQTE+1) = LOLD - NLC
- LQ(LQTE+2) = 0
- LQ(LQTE+3) = 0
- LQTE = LQTE + 4
- ENDIF
-
- LQ(LQTE) = LOLD - NLC
- LQ(LQTE+1) = LOLD + NDC + 9
- LQ(LQTE+2) = LNEW - LOLD
- LQ(LQTE+3) = 0
-
- LQTE = LQTE + 4
- IF (LQTE.GE.LQRTE) THEN
- CALL MZTABH
- IF (IQPART.NE.0) GO TO 51
- ENDIF
- LIX = LQ(KQS+LIX)
- IF (LIX.NE.0) GO TO 37
-
- LQ(LQTE) = LQ(LQTE-3)
-
-C-- Structural replacement of old by new
-
- LIX = LIXO
- 42 LOLD = LQ(KQS+LIX-1)
- LNEW = LQ(KQS+LIX-2)
- LQ(KQS+LNEW) = LQ(KQS+LOLD)
- LQ(KQS+LNEW+1) = LQ(KQS+LOLD+1)
- LQ(KQS+LNEW+2) = LQ(KQS+LOLD+2)
- LQ(KQS+LOLD) = 0
- LQ(KQS+LOLD+1) = LIX
- LQ(KQS+LOLD+2) = LIX - 1
- IQ(KQS+LOLD-2) = 0
- IQ(KQS+LIX-2) = 1
- IF (IFLAG.NE.0) THEN
-C-- the old banks to remain accessible
- IQ(KQS+LIX+1) = LQ(KQS+LIX-1)
- ELSE
- IQ(KQS+LOLD) = MSBIT1(IQ(KQS+LOLD),IQDROP)
- ENDIF
- LQ(KQS+LIX-1) = 0
- LIX = LQ(KQS+LIX)
- IF (LIX.NE.0) GO TO 42
-
-C-- Relocate
-
- CALL MZRELX
-
-C------ Finished, reset LIX
-
- LIXP(1) = LIXO
- LQ(KQS+LIXO+1) = LQSYSR(KQT+1)
- LQ(KQS+LIXO+2) = LQSYSR(KQT+2)
- LQMST(KQT+1) = 0
-
- IF (IFLAG.EQ.0) THEN
- CALL MZDROP (IXDIV, LIXO, 'L')
- GO TO 999
- ENDIF
-
-C-- restore LOLD's in the index structure
-
-#if defined(CERNLIB_QDEVZE)
- IF (NQDEVZ.GE.3) THEN
- WRITE (IQLOG,9811)
- JIX = 1
- ENDIF
-#endif
- LIX = LIXO
- 47 LOLD = IQ(KQS+LIX+1)
- LQ(KQS+LIX-1) = LOLD
-#if defined(CERNLIB_QDEVZE)
- IF (NQDEVZ.GE.3) THEN
- LNEW = LQ(KQS+LIX-2)
- WRITE (IQLOG,9824) JIX,LIX,
- + LOLD,IQ(KQS+LOLD-4),LNEW,IQ(KQS+LNEW-4)
- JIX = JIX + 1
- ENDIF
-#endif
- LIX = LQ(KQS+LIX)
- IF (LIX.NE.0) GO TO 47
-#include "zebra/qtrace99.inc"
- RETURN
-
-C---- Not enough table space, collect garbage
-
- 51 IF (IXGARB.NE.0) GO TO 92
-
- JDIVSV = JQDIVI
-
- IXGARB = MZIXCO (IXDIV, 21, 22, 24)
- CALL MZGARB (IXGARB, 0)
-
- LIXO = LQMST(KQT+1)
- JQDIVI = JDIVSV
-#if !defined(CERNLIB_QDEBUG)
- LIMDLO = LQSTA(KQT+JQDIVI)
- LIMDUP = LQEND(KQT+JQDIVI)
-#endif
- GO TO 31
-
-C-------- Isolated case, update structural links ---------
-
- 61 LIX = LIXO
- 62 LOLD = LQ(KQS+LIX-1)
- LNEW = LQ(KQS+LIX-2)
- LQ(KQS+LNEW) = LQ(KQS+LOLD)
- LQ(KQS+LNEW+1) = LQ(KQS+LOLD+1)
- LQ(KQS+LNEW+2) = LQ(KQS+LOLD+2)
-
-C---- Update according to origin-link
-
- K = LQ(KQS+LNEW+2)
- IF (K.NE.0) LQ(KQS+K) = LNEW
-
-C---- Update according to next-link
-
- L = LQ(KQS+LNEW)
- IF (L.NE.0) LQ(KQS+L+2) = LNEW
-
-C---- Update k- and up-link in vertically dependent banks
-
- JBIAS = IQ(KQS+LNEW-2) + 1
- 64 JBIAS = JBIAS - 1
- IF (JBIAS.LE.0) GO TO 68
- KO = LOLD - JBIAS
- KN = LNEW - JBIAS
- L = LQ(KQS+KN)
- IF (L.EQ.0) GO TO 64
- IF (LQ(KQS+L+2).NE.KO) GO TO 64
- LQ(KQS+L+2) = KN
-
-C-- and its linear structure
-
- LF = L
- 67 LQ(KQS+L+1) = LNEW
- L = LQ(KQS+L)
- IF (L.EQ.LF) GO TO 64
- IF (L.NE.0) GO TO 67
- GO TO 64
-
- 68 LQ(KQS+LOLD) = 0
- IQ(KQS+LOLD-2) = 0
- IQ(KQS+LIX-2) = 1
- IF (IFLAG.NE.0) THEN
- LQ(KQS+LOLD+1) = LIX
- LQ(KQS+LOLD+2) = LIX - 1
- ELSE
- LQ(KQS+LOLD+1) = 0
- LQ(KQS+LOLD+2) = 0
- IQ(KQS+LOLD) = MSBIT1(IQ(KQS+LOLD),IQDROP)
- LQ(KQS+LIX-1) = 0
- ENDIF
- LIX = LQ(KQS+LIX)
- IF (LIX.NE.0) GO TO 62
-
- IF (IFLAG.EQ.0) CALL MZDROP (IXDIV, LIXO, 'L')
- GO TO 999
-
-C----------- Error conditions
-
- 99 NQCASE = 1
- 98 NQCASE = NQCASE + 5
- NQFATA = 4
- IQUEST(15) = LNEW
- IQUEST(16) = LOLD
- IQUEST(17) = LQ(KQS+LOLD+2)
- IQUEST(18) = LQ(KQS+LOLD)
- GO TO 93
-
- 97 NQCASE = 1
- 96 NQCASE = NQCASE + 1
- 95 NQCASE = NQCASE + 1
- 94 NQCASE = NQCASE + 1
- NQFATA = NQFATA + 5
- IQUEST(15) = IQ(KQS+LIX-3)
- IQUEST(16) = IQ(KQS+LIX-2)
- IQUEST(17) = IQ(KQS+LIX-1)
- IQUEST(18) = LOLD
- IQUEST(19) = LNEW
-
- 93 NQCASE = NQCASE + 1
- NQFATA = NQFATA + 3
- IQUEST(12) = LIMDLO
- IQUEST(13) = LIMDUP
- IQUEST(14) = LIX
-
- 92 NQCASE = NQCASE + 1
- 91 NQCASE = NQCASE + 1
- NQFATA = NQFATA + 1
- IQUEST(11) = JQDIVI
-#include "zebra/qtofatal.inc"
- END
diff --git a/src/packlib/zebra/mq/mzstor.F b/src/packlib/zebra/mq/mzstor.F
deleted file mode 100644
index e111f9b..0000000
--- a/src/packlib/zebra/mq/mzstor.F
+++ /dev/null
@@ -1,337 +0,0 @@
-*
-* $Id: mzstor.F,v 1.3 1999/06/18 13:30:19 couet Exp $
-*
-* $Log: mzstor.F,v $
-* Revision 1.3 1999/06/18 13:30:19 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.2 1996/04/18 16:12:06 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:17 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE MZSTOR (IXSTOR,CHNAME,CHOPT
- +, IFENCE,LV,LLR,LLD,LIMIT,LAST)
-
-C- Initialize new Zebra store region, user called
-
-#include "zebra/zbcd.inc"
-#include "zebra/zmach.inc"
-#include "zebra/zstate.inc"
-#include "zebra/zunit.inc"
-#include "zebra/mqsys.inc"
-#include "zebra/mzcwk.inc"
-*
- DIMENSION IXSTOR(9),IFENCE(9)
- DIMENSION LV(9),LLR(9),LLD(9),LIMIT(9),LAST(9)
- DIMENSION MMSYSL(5), NAMELA(2), NAMESY(2)
- CHARACTER *(*) CHNAME,CHOPT
-#if defined(CERNLIB_QMVDS)
- SAVE MMSYSL, NAMELA, NAMESY, NAMWSP, NAMEDV
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HMZST, 4HOR /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HMZSTOR /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'MZSTOR ')
-#endif
-#if defined(CERNLIB_QHOLL)
- DATA MMSYSL / 4HSYSL,0,0,101,2/
- DATA NAMELA / 4Hsyst, 4Hem /
- DATA NAMESY / 4Hsyst, 4Hem /
- DATA NAMWSP / 4Hqwsp /
- DATA NAMEDV / 4HQDIV /
-#endif
-#if !defined(CERNLIB_QHOLL)
- DATA MMSYSL / 0,0,0,101,2/
-#endif
-
-#include "zebra/q_sbit1.inc"
-#include "zebra/q_shiftl.inc"
-#include "zebra/q_locf.inc"
-
-
-C-- Clear Zebra tables on first entry
-
- IF (NQSTOR.NE.-1) GO TO 13
- CALL VZERO (NQOFFT,32)
- LQATAB = LOCF (IQTABV(1)) - 1
- LQASTO = LOCF (LQ(1)) - 1
- LQBTIS = LQATAB - LQASTO
- LQWKTB = LOCF(IQWKTB(1)) - LQASTO
- LQWKFZ = LOCF(IQWKFZ(1)) - LQASTO
- NQTSYS = LOCF(IQDN2(20)) - LQATAB
- NQWKTB = NQWKTT
-
-C- KQFT=342 relies on LQFSTA(1) to be LQSTA(1+342) in /MZCC/
- KQFT = 342
-#if defined(CERNLIB_QPRINT)
- IF (NQLOGD.GE.-1)
- +WRITE (IQLOG,9011) LQATAB,LQATAB
- 9011 FORMAT (1X/' MZSTOR. ZEBRA table base TAB(0) in /MZCC/ at adr'
-#endif
-#if (defined(CERNLIB_QPRINT))&&(!defined(CERNLIB_HEX))
- F,I12,1X,O11,' OCT')
-#endif
-#if (defined(CERNLIB_QPRINT))&&(defined(CERNLIB_HEX))&&(!defined(CERNLIB_B64))
- F,I12,1X,Z11,' HEX')
-#endif
-#if (defined(CERNLIB_QPRINT))&&(defined(CERNLIB_HEX))&&(defined(CERNLIB_B64))
- F,I12,1X,Z16,' HEX')
-#endif
- 13 CONTINUE
-#if !defined(CERNLIB_QHOLL)
- CALL UCTOH ('SYSL', MMSYSL, 4,4)
- CALL UCTOH ('system ',NAMELA, 4,8)
- CALL UCTOH ('system ',NAMESY, 4,8)
- CALL UCTOH ('qwsp' ,NAMWSP, 4,4)
- CALL UCTOH ('QDIV' ,NAMEDV, 4,4)
-#endif
-
-#include "zebra/qtrace.inc"
-
- CALL UOPTC (CHOPT,'Q:',IQUEST)
- LOGQ = IQUEST(1)
- IFLSPL = IQUEST(2)
-
- JQSTOR = NQSTOR + 1
- CALL VZERO (KQT,27)
-
-C-- Calculate store off-set
-
- LQSTOR = LOCF(LV(1)) - 1
- KQS = LQSTOR - LQASTO
-
- NFEND = (LQSTOR+1) - LOCF(IFENCE(1))
- NQFEND = NFEND
-
-C-- Printing name of store
-
- NQSNAM(1) = IQBLAN
- NQSNAM(2) = IQBLAN
- N = MIN (8, LEN(CHNAME))
- IF (N.NE.0) CALL UCTOH (CHNAME,NQSNAM,4,N)
-
-C-- Set log level
-
- NQLOGL = NQLOGD
- IF (LOGQ.NE.0) NQLOGL=-2
-
-C-- Permanent links et al.
-
- NQSTRU = LOCF(LLR(1)) - (LQSTOR+1)
- NQREF = LOCF(LLD(1)) - (LQSTOR+1)
- NQLINK = NQREF
- LQ2END = LOCF(LIMIT(1)) - LQSTOR
- NDATAT = LOCF(LAST(1)) - LQSTOR
-
-C-- Calculate table off-set
-
- NDATA = NDATAT
- LOCT = LQATAB
- IF (JQSTOR.NE.0) THEN
- NDATA = NDATA - NQTSYS
- NQSNAM(6) = NDATA
- LOCT = LQSTOR + NDATA
- KQT = LOCT - LQATAB
- NDATA = NDATA - 4
- CALL VFILL (LQ(KQS+NDATA),10,IQNIL)
- ENDIF
-
-#if defined(CERNLIB_QPRINT)
- IF (NQLOGL.GE.-1)
- +WRITE (IQLOG,9021) JQSTOR,NQSNAM(1),NQSNAM(2)
- +, LQSTOR,LOCT,LQSTOR,LOCT,KQS,KQT,KQS,KQT
- +, NQSTRU,NQREF,LQ2END,NDATAT,NFEND
- 9021 FORMAT (1X/' MZSTOR. Initialize Store',I3,' in ',2A4,
- F/10X,'with Store/Table at absolute adrs',2I12
-#endif
-#if (defined(CERNLIB_QPRINT))&&(!defined(CERNLIB_HEX))
- F/40X,'OCT',2(1X,O11)/40X,'OCT',2(1X,O11)
-#endif
-#if (defined(CERNLIB_QPRINT))&&(defined(CERNLIB_HEX))&&(!defined(CERNLIB_B64))
- F/40X,'HEX',2(1X,Z11)/40X,'HEX',2(1X,Z11)
-#endif
-#if (defined(CERNLIB_QPRINT))&&(defined(CERNLIB_HEX))&&(defined(CERNLIB_B64))
- F/30X,'HEX',2(1X,Z16)/30X,'HEX',2(1X,Z16)
-#endif
-#if defined(CERNLIB_QPRINT)
- F/30X,'relative adrs',2I12
- F/10X,'with',I6,' Str. in',I6,' Links in',I7,' Low words in'
- F,I8,' words.'
- F/10X,'This store has a fence of',I5,' words.')
-#endif
-
-C-- Set minimum sizes
-
- NSYS = 400
- NQMINR = 40
- NWF = 2000
- IF (JQSTOR.EQ.0) NQMINR=164
-
-C-- Check parameters valid
-
- IF (NQSTRU.LT.0) GO TO 91
- IF (NQREF .LT.NQSTRU) GO TO 91
- IF (NDATAT.LT.NQLINK+NWF) GO TO 91
- IF (LQ2END.LT.NQLINK+NQMINR) GO TO 91
- IF (NFEND .LT.1) GO TO 92
- IF (NFEND .GE.1001) GO TO 92
- IF (IFLSPL.EQ.1) THEN
- IF (JQSTOR.EQ.0) GO TO 96
- GO TO 39
- ENDIF
-
-#if (!defined(CERNLIB_QSINGLST))&&(defined(CERNLIB_QDEBUG))
-C-- Check overlapping stores
-
- IF (JQSTOR.EQ.0) GO TO 41
- KSA = KQS - NQFEND
- KSE = KQS + NDATAT
-
- DO 36 JSTO=1,JQSTOR
- JT = NQOFFT(JSTO)
- JS = NQOFFS(JSTO)
- JSA = JS - IQTABV(JT+2)
- JSE = JS + LQSTA(JT+21)
- JTA = JT + LQBTIS
- JTE = JTA + NQTSYS
-
- IF (KSE.GT.JTA .AND. KSA.LT.JTE) GO TO 94
- IF (KSE.GT.JSA .AND. KSA.LT.JSE) GO TO 95
- 36 CONTINUE
-#endif
- 39 IF (JQSTOR.GE.16) GO TO 93
-
-C---- Initialize divisions 1 + 2 + system
-
- 41 NQOFFT(JQSTOR+1) = KQT
- NQOFFS(JQSTOR+1) = KQS
- NQALLO(JQSTOR+1) = IFLSPL
- CALL VZERO (IQTABV(KQT+1),NQTSYS)
- CALL VBLANK (IQDN1(KQT+1), 40)
- NQSTOR = NQSTOR + 1
-
- LQ(KQS+NDATA-1) = IQNIL
- LQ(KQS+NDATA) = IQNIL
-
- NDATA = NDATA - 2
- LQSTA(KQT+21) = NDATA
-
- JQDVLL = 2
- JQDVSY = 20
- LQSTA(KQT+20) = NDATA
- LQEND(KQT+20) = NDATA
- NQDMAX(KQT+20) = NDATA
- IQMODE(KQT+20) = 1
- IQKIND(KQT+20) = ISHFTL (1, 23)
- IQRNO(KQT+20) = 9437183
- IQDN1(KQT+20) = NAMESY(1)
- IQDN2(KQT+20) = NAMESY(2)
-
- LQSTA(KQT+2) = NDATA - NSYS
- LQEND(KQT+2) = LQSTA(KQT+2)
- NQDMAX(KQT+2) = NDATA
- IQMODE(KQT+2) = 1
- IQKIND(KQT+2) = MSBIT1 (2, 21)
- IQRCU(KQT+2) = 3
- IQRTO(KQT+2) = ISHFTL (3,20)
- IQRNO(KQT+2) = 9437183
- IQDN1(KQT+2) = NAMEDV
- IQDN2(KQT+2) = IQNUM(3)
-
- LQSTA(KQT+1) = NQLINK + 1
- LQEND(KQT+1) = LQSTA(KQT+1)
- NQDMAX(KQT+1) = NDATA
- IQKIND(KQT+1) = MSBIT1 (1, 21)
- IQRCU(KQT+1) = 3
- IQRTO(KQT+1) = ISHFTL (3,20)
- IQRNO(KQT+1) = 9437183
- IQDN1(KQT+1) = NAMEDV
- IQDN2(KQT+1) = IQNUM(2)
-
- CALL UCOPY (IQCUR,IQTABV(KQT+1),16)
- CALL VFILL (IFENCE,NFEND,IQNIL)
- IF (NQLINK.NE.0) CALL VZERO (LV,NQLINK)
-
-C-- Return IXSTOR
-
- IF (JQSTOR.EQ.0) THEN
- IF (IXSTOR(1).EQ.0) GO TO 71
- ENDIF
- IDN = ISHFTL (JQSTOR,26)
- IXSTOR(1) = IDN
-
-C---- Create system link table bank
-
- 71 JQDIVI = JQDVSY
- CALL MZLIFT (-7,LSYS,0,2,MMSYSL,0)
- LQSYSS(KQT+1) = LSYS
-
- NALL = LOCF(IQTDUM(1)) - LOCF(LQSYSS(1))
- NSTR = LOCF(LQSYSR(1)) - LOCF(LQSYSS(1))
-
- LOCAR = LOCF (LQSYSS(KQT+1)) - LQSTOR
- LOCARE = LOCAR + NALL
-
-C-- Working space
-
- IQ(KQS+LSYS+1) = 11
- IQ(KQS+LSYS+2) = 1
- IQ(KQS+LSYS+3) = 1 + NQLINK
- IQ(KQS+LSYS+4) = NQSTRU
- IQ(KQS+LSYS+5) = NAMWSP
- IQ(KQS+LSYS+6) = IQBLAN
-
-C-- System link area
-
- IQ(KQS+LSYS+7) = LOCAR
- IQ(KQS+LSYS+8) = LOCARE
- IQ(KQS+LSYS+9) = NSTR
- IQ(KQS+LSYS+10)= NAMELA(1)
- IQ(KQS+LSYS+11)= NAMELA(2)
-
-C-- Range of possible values for an origin-link
-
- IQTABV(KQT+13) = MIN (1, LOCAR)
- IQTABV(KQT+14) = MAX (LQSTA(KQT+21), LOCARE)
-
-#include "zebra/qtrace99.inc"
- RETURN
-
-C------ Error conditions
-
-#if (!defined(CERNLIB_QSINGLST))&&(defined(CERNLIB_QDEBUG))
- 95 NQCASE = 1
- 94 NQCASE = NQCASE - 2
- NQFATA = 3
- IQUEST(20) = JSTO - 1
- IQUEST(21) = NQPNAM(JT+1)
- IQUEST(22) = NQPNAM(JT+2)
-#endif
-
- 96 NQCASE = NQCASE + 3
- 93 NQCASE = NQCASE + 1
- 92 NQCASE = NQCASE + 1
- 91 NQCASE = NQCASE + 1
- NQFATA = NQFATA + 9
- IQUEST(11) = NQSNAM(1)
- IQUEST(12) = NQSNAM(2)
- IQUEST(13) = NFEND
- IQUEST(14) = NQSTRU
- IQUEST(15) = NQLINK
- IQUEST(16) = LQ2END
- IQUEST(17) = NDATAT
- IQUEST(18) = NQMINR
- IQUEST(19) = NWF
-#include "zebra/qtofatal.inc"
- END
diff --git a/src/packlib/zebra/mq/mzvers.F b/src/packlib/zebra/mq/mzvers.F
deleted file mode 100644
index a5c7f7c..0000000
--- a/src/packlib/zebra/mq/mzvers.F
+++ /dev/null
@@ -1,56 +0,0 @@
-*
-* $Id: mzvers.F,v 1.5 1999/06/18 13:30:20 couet Exp $
-*
-* $Log: mzvers.F,v $
-* Revision 1.5 1999/06/18 13:30:20 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.4 1999/06/18 12:04:45 couet
-* - The version is now defined in one central place
-*
-* Revision 1.3 1999/06/14 13:59:23 couet
-* - Mods for Y2K in the date/time output
-*
-* Revision 1.2 1996/04/18 16:12:07 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:17 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE MZVERS
-
-C- Print Zebra / Kernlib version on IQLOG, user called
-
-#include "zebra/zheadp.inc"
-#include "zebra/zstate.inc"
-#include "zebra/zunit.inc"
-#include "zebra/mqsysh.inc"
-#include "zebra/q_locf.inc"
-
-#include "zebra/qversion.inc"
-
- IF (NQLOGD.LT.-1) GO TO 79
-
- WRITE (IQLOG,9002) QVERSN,IQDATE,IQTIME
- 9002 FORMAT (1X/' ZEBRA SYSTEM',F8.4,' executing, Date/Time',
- +I7.6,1H/,I4)
-
- WRITE (IQLOG,9003) QVERSN
- 9003 FORMAT (1X/1X,'ZEMQ ',F4.2,' ')
-
- LQASTO = LOCF (LQ(1)) - 1
- WRITE (IQLOG,9004) LQASTO,LQASTO
- 9004 FORMAT (1X/10X,'ZEBRA store base LQ(0) in /ZEBQ/ at adr',I12,
-#if !defined(CERNLIB_HEX)
- F1X,O11,' OCT')
-#endif
-#if defined(CERNLIB_HEX)
- F1X,Z11,' HEX')
-#endif
- CALL KERNGT (IQLOG)
- 79 IQUEST(1) = QVERSN * 10000.
- RETURN
- END
diff --git a/src/packlib/zebra/mq/mzvolm.F b/src/packlib/zebra/mq/mzvolm.F
deleted file mode 100644
index 9c6a3c9..0000000
--- a/src/packlib/zebra/mq/mzvolm.F
+++ /dev/null
@@ -1,205 +0,0 @@
-*
-* $Id: mzvolm.F,v 1.3 1999/06/18 13:30:20 couet Exp $
-*
-* $Log: mzvolm.F,v $
-* Revision 1.3 1999/06/18 13:30:20 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.2 1996/04/18 16:12:08 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:19 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- FUNCTION MZVOLM (IXSTOR,LHEADP,CHOPT)
-
-C- Run through d/s to calculate space occupied, user called
-
-#include "zebra/zstate.inc"
-#include "zebra/zunit.inc"
-#include "zebra/zvfaut.inc"
-#include "zebra/mqsys.inc"
-#include "zebra/mzcn.inc"
-#include "zebra/mzcwk.inc"
-*
- DIMENSION LHEADP(9)
- CHARACTER *(*) CHOPT
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HMZVO, 4HLM /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HMZVOLM /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'MZVOLM ')
-#endif
-
-#include "zebra/q_jbit.inc"
-#include "zebra/q_jbyt.inc"
-#include "zebra/q_sbit0.inc"
-#include "zebra/q_sbit1.inc"
-
-
-#include "zebra/qtrace.inc"
- NWVOL = 0
- LHEAD = LHEADP(1)
- IF (LHEAD.EQ.0) GO TO 999
-
-#include "zebra/qstore.inc"
-
-#if defined(CERNLIB_QDEBUG)
- IF (IQVSTA.NE.0) CALL ZVAUTX
- CALL MZCHLS (-7,LHEAD)
- IF (IQFOUL.NE.0) GO TO 92
-#endif
-#if !defined(CERNLIB_QDEBUG)
- IQNS = IQ(KQS+LHEAD-2)
-#endif
-
- CALL UOPTC (CHOPT,'L',IQUEST)
- IOPTH = IQUEST(1)
-#if defined(CERNLIB_QDEVZE)
- IF (NQDEVZ.NE.0)
- +WRITE (IQLOG,9814) LHEAD,IOPTH
- 9814 FORMAT (1X/' DEVZE MZVOLM. LHEAD,IOPTH='
- F,I6,6I4)
-#endif
-
- LEV = LQWKTB + 3
- LEVE = LEV + NQWKTB - 10
- LQ(LEV-2) = 0
- LQ(LEV-1) = 0
- LQ(LEV) = LHEAD
-
- LCUR = LHEAD
- LX = LHEAD - 1 + IOPTH
- LAST = LHEAD - IQNS
- IQ(KQS+LCUR) = MSBIT1 (IQ(KQS+LCUR),IQSYSX)
- GO TO 24
-
-C-- Mark bank
-
- 20 LAST = LCUR - IQ(KQS+LCUR-2)
- IQ(KQS+LNEW) = MSBIT0 (IQ(KQS+LNEW),IQSYSX)
- NWVOL = NWVOL + 10 + JBYT (IQ(KQS+LNEW),19,4) +
- + IQ(KQS+LNEW-1) + IQ(KQS+LNEW-3)
-
-C---- Look at next link
-
- 24 IF (LX.LT.LAST) GO TO 41
- LNEW = LQ(KQS+LX)
- LX = LX - 1
- IF (LNEW.EQ.0) GO TO 24
-
-#if defined(CERNLIB_QDEBUG)
- CALL MZCHLS (-7,LNEW)
- IF (IQFOUL.NE.0) GO TO 94
-#endif
- IF (JBIT(IQ(KQS+LNEW),IQSYSX).NE.0) GO TO 24
-
-C---- New bank LNEW, push down
-
- LQ(LEV+1) = LX
- LQ(LEV+2) = LCUR
-
- LEV = LEV + 3
- IF (LEV.GE.LEVE) GO TO 91
- LQ(LEV) = LNEW
-#if defined(CERNLIB_QDEVZE)
- IF (NQDEVZ.GE.11)
- +WRITE (IQLOG,9831) LEV,LCUR,LX+1,LNEW
- 9831 FORMAT (' DEVZE MZVOLM, Down: LEV,LCUR,LX+1,LNEW=',6I8)
-#endif
-
-C-- Move to end of linear structure
-
- 32 LCUR = LNEW
- IQ(KQS+LCUR) = MSBIT1 (IQ(KQS+LCUR),IQSYSX)
- LNEW = LQ(KQS+LCUR)
- IF (LNEW.EQ.0) GO TO 36
-#if defined(CERNLIB_QDEVZE)
- IF (NQDEVZ.GE.11)
- +WRITE (IQLOG,9833) LCUR,LNEW
- 9833 FORMAT (' DEVZE MZVOLM, Along: LCUR,LNEW=',6I8)
-#endif
-#if defined(CERNLIB_QDEBUG)
- CALL MZCHLS (-7,LNEW)
- IF (IQFOUL.NE.0) GO TO 93
- IF (JBIT(IQ(KQS+LNEW),IQSYSX).NE.0) GO TO 36
- IF (LQ(KQS+LNEW+2).NE.LCUR) GO TO 95
- GO TO 32
-
- 36 CONTINUE
-#endif
-#if !defined(CERNLIB_QDEBUG)
- IF (JBIT(IQ(KQS+LNEW),IQSYSX).EQ.0) GO TO 32
-
- 36 IQNS = IQ(KQS+LCUR-2)
-#endif
- LAST = LCUR - IQNS
- LX = LCUR - 1
- GO TO 24
-
-C---- Bank at LCUR has no further secondaries
-C-- step back in the linear structure
-
- 41 LNEW = LCUR
- IF (LCUR.EQ.LQ(LEV)) GO TO 46
- LCUR = LQ(KQS+LCUR+2)
- LX = LCUR - 1
-#if defined(CERNLIB_QDEVZE)
- IF (NQDEVZ.GE.11)
- +WRITE (IQLOG,9841) LCUR,LNEW
- 9841 FORMAT (' DEVZE MZVOLM, Back: LCUR,LNEW=',6I8)
-#endif
- GO TO 20
-
-C-- Start of linear structure reached, pop up
-
- 46 LEV = LEV - 3
- LX = LQ(LEV+1)
- LCUR = LQ(LEV+2)
-#if defined(CERNLIB_QDEVZE)
- IF (NQDEVZ.GE.11)
- +WRITE (IQLOG,9846) LEV,LCUR,LX
- 9846 FORMAT (' DEVZE MZVOLM, Up: LEV,LCUR,LX=',6I8)
-#endif
- IF (LCUR.NE.0) GO TO 20
-
-C---- Done, mark header bank
-
- 61 IQ(KQS+LHEAD) = MSBIT0 (IQ(KQS+LHEAD),IQSYSX)
- NWVOL = NWVOL + 10 + JBYT (IQ(KQS+LHEAD),19,4) +
- + IQ(KQS+LHEAD-1) + IQ(KQS+LHEAD-3)
-#include "zebra/qtrace99.inc"
- MZVOLM = NWVOL
- RETURN
-
-C------ Error conditions
-
-#if defined(CERNLIB_QDEBUG)
- 95 NQCASE = 2
- NQFATA = 1
- IQUEST(14) = LQ(KQS+LNEW+2)
- GO TO 93
-
- 94 NQCASE = 1
- NQFATA = 1
- IQUEST(14) = LX+1 - LCUR
- 93 NQCASE = NQCASE + 1
- NQFATA = NQFATA + 2
- IQUEST(12) = LNEW
- IQUEST(13) = LCUR
- 92 NQCASE = NQCASE + 1
-#endif
- 91 NQCASE = NQCASE + 1
- NQFATA = NQFATA + 1
- IQUEST(11) = LHEAD
-#include "zebra/qtofatal.inc"
- MZVOLM = 0
- END
diff --git a/src/packlib/zebra/mq/mzwork.F b/src/packlib/zebra/mq/mzwork.F
deleted file mode 100644
index 84894b0..0000000
--- a/src/packlib/zebra/mq/mzwork.F
+++ /dev/null
@@ -1,154 +0,0 @@
-*
-* $Id: mzwork.F,v 1.3 1999/06/18 13:30:21 couet Exp $
-*
-* $Log: mzwork.F,v $
-* Revision 1.3 1999/06/18 13:30:21 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.2 1996/04/18 16:12:10 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:18 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE MZWORK (IXSTOR,DFIRST,DLAST,IFLAGP)
-
-C- Allocate working space, user called
-
-C- IFLAG = -1 reset wsp empty
-C- 0 new wsp
-C- 1 vary both limits, keep common links
-C- 2 vary only DLAST limit, keep links and common data
-C- 3 reset only DFIRST limit, zero all links
-C- 4 vary only DFIRST limit, keep common links
-
-#include "zebra/zmach.inc"
-#include "zebra/zstate.inc"
-#include "zebra/zunit.inc"
-#include "zebra/zvfaut.inc"
-#include "zebra/mqsys.inc"
-*
- INTEGER DFIRST(9), DLAST(9), IFLAGP(9)
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HMZWO, 4HRK /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HMZWORK /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'MZWORK ')
-#endif
-
-#include "zebra/q_jbit.inc"
-#include "zebra/q_jbyt.inc"
-#include "zebra/q_locf.inc"
-
- IFLAG = IFLAGP(1)
-
-#include "zebra/qtrace.inc"
-
-#include "zebra/qstore.inc"
-#if defined(CERNLIB_QDEBUG)
- IF (IQVSTA.NE.0) CALL ZVAUTX
-#endif
-
- IF (IFLAG.LT.0) GO TO 61
-
- NEWL = LOCF (DFIRST(1)) - (LQSTOR+1)
- NEWD = LOCF (DLAST(1)) - LQSTOR
-#if defined(CERNLIB_APOLLO)
- NEWL = RSHFT (IADDR(DFIRST(1)),2) - (LQSTOR+1)
- NEWD = RSHFT (IADDR(DLAST(1)),2) - LQSTOR
-#endif
- IF (IFLAG.GE.5) GO TO 91
- IF (IFLAG.GE.3) NEWD = LQSTA(1) - 1
- IF (IFLAG.EQ.2) NEWL = NQLINK
-
-C---- Check valid parameters
-
- IF (NEWL.LT.NQREF) GO TO 92
- IF (NEWD.LT.NEWL) GO TO 93
- IF (IFLAG.GE.3) GO TO 31
- IF (NEWD.GE.LQEND(KQT+2)) GO TO 94
-
-C-- Check garbage collection
-
- NQRESV = LQSTA(KQT+2) - NQMINR - NEWD
- IF (NQRESV.GT.0) GO TO 31
- LQEND(KQT+1) = LQSTA(KQT+1)
- JQDIVI = 2
- CALL MZRESV
- NQRESV = LQSTA(KQT+2) - NQMINR - NEWD
- CALL MZGAR1
-
-C-- Clear new links
-
- 31 LA = NQREF
- IF (IFLAG.EQ.1) LA = NQLINK
- IF (IFLAG.EQ.2) LA = NQLINK
- IF (IFLAG.EQ.4) LA = NQLINK
- N = NEWL - LA
- IF (N.GT.0) CALL VZERO (LQ(KQS+LA+1),N)
-
-C-- Clear new data words
-
-#if defined(CERNLIB_QDEBUG)
- IF (IFLAG.GE.3) GO TO 71
- IF (JBYT(IQDBUG,4,2).EQ.0) GO TO 71
- IF (IFLAG.LT.2) THEN
- LA = NEWL + 1
- ELSE
- LA = LQSTA(KQT+1)
- ENDIF
-
- LE = NEWD
- IF (JBIT(IQDBUG,5).NE.0) LE=LQSTA(KQT+2) - 1
- IF (LE.LT.LA) GO TO 71
-
- DO 38 L=LA,LE
- 38 LQ(KQS+L) = IQNIL + L
-#endif
- GO TO 71
-
-C---- Reset empty working space
-
- 61 NEWL = NQREF
- NEWD = NQREF
-#if defined(CERNLIB_QDEBUG)
- IF (IFLAG.LT.-1) GO TO 91
-#endif
-
-C---- Set new limits
-
- 71 NQLINK = NEWL
- IQTABV(KQT+5) = NQLINK
- IF (IFLAG.LT.3) THEN
- LQSTA(KQT+1) = NEWD + 1
- LQEND(KQT+1) = NEWD + 1
- ENDIF
-#if defined(CERNLIB_QDEBPRI)
- IF (NQLOGL.GE.2)
- + WRITE (IQLOG,9071) JQSTOR,IFLAG,NQLINK,NEWD
- 9071 FORMAT (' MZWORK- Store',I3,' Flag=',I2,' Last Link/Data',2I7)
-#endif
-#include "zebra/qtrace99.inc"
- RETURN
-
-C------ Error conditions
-
- 94 NQCASE = 1
- 93 NQCASE = NQCASE + 1
- 92 NQCASE = NQCASE + 1
- 91 NQCASE = NQCASE + 1
- NQFATA = 4
- IQUEST(11) = NQREF
- IQUEST(12) = NEWL
- IQUEST(13) = NEWD
- IQUEST(14) = IFLAG
-#include "zebra/qtofatal.inc"
- END
diff --git a/src/packlib/zebra/mqg/Imakefile b/src/packlib/zebra/mqg/Imakefile
deleted file mode 100644
index ad0d156..0000000
--- a/src/packlib/zebra/mqg/Imakefile
+++ /dev/null
@@ -1,5 +0,0 @@
-SRCS_F= mzfgap.F mzgar1.F mzgarb.F mzgsta.F mzmove.F mzrelb.F \ @@\
- mzrell.F mzrelx.F mztabc.F mztabf.F mztabh.F mztabm.F mztabr.F \ @@\
- mztabs.F mztabx.F mzwipe.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/zebra/mqg/mzfgap.F b/src/packlib/zebra/mqg/mzfgap.F
deleted file mode 100644
index a0030fc..0000000
--- a/src/packlib/zebra/mqg/mzfgap.F
+++ /dev/null
@@ -1,196 +0,0 @@
-*
-* $Id: mzfgap.F,v 1.3 1999/06/18 13:30:26 couet Exp $
-*
-* $Log: mzfgap.F,v $
-* Revision 1.3 1999/06/18 13:30:26 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.2 1996/04/18 16:12:30 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:20 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE MZFGAP
-
-C- Find the 4 largest gaps,
-C- gaps 3 + 4 may be inside the moving memory region
-C- defined by JQSTMV,JQDVM1+2,NQDVMV
-C- gaps 1 + 2 must be outside the moving memory region
-
-C- Entry 'J' in the table contains :
-C- IQGAP(1,J) = number of words available
-C- IQGAP(2,J) = abs. zebra adr of first word in the gap
-C- IQGAP(3,J) = division number
-C- IQGAP(4,J) = store number
-C- IQGAP(5,J) user flag
-
-C- Original meaning of JQSTMV,JQDVM1,JQDVM2,NQDVMV (cf. MZTABS):
-C- unless JQSTMV<0, the divisions JQDVM1 to JQDVM2 inclusive
-C- of the store JQSTMV may have to be shifted by NQDVMV words,
-C- to the left if -ve, to the right if +ve.
-C- NQDVMV=0 means to the left by a yet unknown amount.
-C- It follows that the gaps after divisions JDIV are not available
-C- for the relocation table because they may be over-written
-C- by the memory move, with :
-C- NQDVMV 0, -ve : JDIV = <JQDVM1-1,JQDVM2-1>
-C- +ve : JDIV = <JQDVM1, JQDVM2 >
-
-C- MZFGAP is also used for I/O to find a gap where to put the
-C- relocation table on input. In this case there is just one
-C- gap unavailable, namely the one which will receive the data.
-C- This is the gap before a reverse division (JQMODE=1) or after
-C- a forward division (JQMODE=0). To block this gap one can give
-C- JQDVM1=JQDVM2=JDIV and NQDVMV=1-2*JQMODE, setting JQSTMV also.
-
-#include "zebra/zstate.inc"
-#include "zebra/zunit.inc"
-#include "zebra/mqsys.inc"
-#include "zebra/mzct.inc"
-*
- DIMENSION NGAPV(7), JDIVV(7), JSTOV(7), JPV(7)
- EQUIVALENCE (NGAPV(1),IQUEST(11)), (JDIVV(1),IQUEST(21))
- EQUIVALENCE (JSTOV(1),IQUEST(31)), (JPV(1), IQUEST(41))
- DIMENSION NQGAPV(2)
- EQUIVALENCE (NQGAPV(1),NQGAPN)
-
-
- CALL VZERO (IQGAP,20)
-
- 15 DO 17 J=1,6
- 17 NGAPV(J) = 0
-
- IF (JQSTMV.LT.0) GO TO 19
- KT = NQOFFT(JQSTMV+1)
- JDVSH1 = JQDVM1
- JDVSH2 = JQDVM2
- IF (NQDVMV.GT.0) GO TO 19
- IF (JDVSH1.EQ.IQTABV(KT+9)) JDVSH1=IQTABV(KT+8)+1
- JDVSH1 = JDVSH1 - 1
- JDVSH2 = JDVSH2 - 1
- 19 MINGN = 0
- MINGV = 0
- JMINGN = 1
- JMINGV = 5
-
-C------ Loop all stores
-
- JSTO = -1
- 21 JSTO = JSTO + 1
- IF (JSTO.GT.NQSTOR) GO TO 61
- IF (NQALLO(JSTO+1).LT.0) GO TO 21
-
- KT = NQOFFT(JSTO+1)
- JDVN = 1
-
-C---- Loop all divisions
-
- 31 JDIV = JDVN
- IF (JDIV.EQ.21) GO TO 21
- JDVN = JDIV + 1
- IF (JDIV.EQ.IQTABV(KT+8)) JDVN=IQTABV(KT+9)
-
- NWGAP = LQSTA(KT+JDVN) - LQEND(KT+JDIV)
- IF (NWGAP.LT.164) GO TO 31
- IF (JSTO.NE.JQSTMV) GO TO 41
- IF (JDIV.LT.JDVSH1) GO TO 41
- IF (JDIV.GT.JDVSH2) GO TO 41
-
-C-- Gap in moving region
-
- IF (NWGAP.LE.MINGV) GO TO 31
- NGAPV(JMINGV) = NWGAP
- JDIVV(JMINGV) = JDIV
- JSTOV(JMINGV) = JSTO
- JMINGV = 5
- MINGV = NGAPV(5)
- IF (MINGV.LE.NGAPV(6)) GO TO 31
- JMINGV = 6
- MINGV = NGAPV(6)
- GO TO 31
-
-C-- Gap in non-moving region
-
- 41 IF (NWGAP.LE.MINGN) GO TO 31
- NGAPV(JMINGN) = NWGAP
- JDIVV(JMINGN) = JDIV
- JSTOV(JMINGN) = JSTO
- JMINGN = 1
- MINGN = NGAPV(1)
- DO 44 J=2,4
- IF (MINGN.LE.NGAPV(J)) GO TO 44
- JMINGN = J
- MINGN = NGAPV(J)
- 44 CONTINUE
- GO TO 31
-
-C------- Store the result
-
- 61 DO 62 J=1,6
- 62 JPV(J) = J
-
-C-- Sort non-moving gaps
-
- JG = 1
- 65 JF = JPV(JG)
- JN = JPV(JG+1)
- IF (NGAPV(JF).LT.NGAPV(JN)) GO TO 67
- IF (JG.EQ.3) GO TO 71
- 66 JG = JG + 1
- GO TO 65
-
- 67 JPV(JG) = JN
- JPV(JG+1) = JF
- IF (JG.EQ.1) GO TO 66
- JG = JG - 1
- GO TO 65
-
-C-- Sort moving gaps
-
- 71 JG = 4
- 75 JF = JPV(JG)
- JN = JPV(JG+1)
- IF (NGAPV(JF).LT.NGAPV(JN)) GO TO 77
- IF (JG.EQ.5) GO TO 81
- 76 JG = JG + 1
- GO TO 75
-
- 77 JPV(JG) = JN
- JPV(JG+1) = JF
- IF (JG.EQ.3) GO TO 76
- JG = JG - 1
- GO TO 75
-
-C-- Store 4 biggest gaps
-
- 81 NQGAPN = 0
- NQGAP = 0
- JSEL = 1
- DO 87 JG=1,4
- JU = JPV(JG)
- NWGAP= NGAPV(JU)
- IF (NWGAP.EQ.0) GO TO 87
- JDIV = JDIVV(JU)
- JSTO = JSTOV(JU)
- KT = NQOFFT(JSTO+1)
- KS = NQOFFS(JSTO+1)
- IQGAP(1,JG) = NWGAP
- IQGAP(2,JG) = KS+ LQEND(KT+JDIV)
- IQGAP(3,JG) = JDIV
- IQGAP(4,JG) = JSTO
- IF (JU.GE.5) JSEL=2
- NQGAPV(JSEL) = JG
- 87 CONTINUE
- NQGAP = MAX (NQGAPN,NQGAP)
-#if defined(CERNLIB_QDEVZE)
- IF (NQDEVZ.GE.11)
- +WRITE (IQLOG,9888) NQGAPV,(JG,(IQGAP(J,JG),J=1,5),JG=1,NQGAP)
- 9888 FORMAT (1X/' DEVZE MZFGAP, NQGAPN,NQGAP=',2I4
- F/16X,' JGAP SIZE LOC JDIV JSTO USED'
- F/(16X,I4,2I8,3I5))
-#endif
- RETURN
- END
diff --git a/src/packlib/zebra/mqg/mzgar1.F b/src/packlib/zebra/mqg/mzgar1.F
deleted file mode 100644
index 6782e81..0000000
--- a/src/packlib/zebra/mqg/mzgar1.F
+++ /dev/null
@@ -1,180 +0,0 @@
-*
-* $Id: mzgar1.F,v 1.3 1999/06/18 13:30:27 couet Exp $
-*
-* $Log: mzgar1.F,v $
-* Revision 1.3 1999/06/18 13:30:27 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.2 1996/04/18 16:12:32 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:20 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE MZGAR1
-
-C- Garbage collect division JQDIVI for not enough space
-C- System called
-
-#include "zebra/zstate.inc"
-#include "zebra/zunit.inc"
-#include "zebra/zvfaut.inc"
-#include "zebra/mqsys.inc"
-#include "zebra/mzcn.inc"
-#include "zebra/mzct.inc"
-*
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HMZGA, 4HR1 /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HMZGAR1 /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'MZGAR1 ')
-#endif
-
-#include "zebra/q_sbit1.inc"
-
-
-#include "zebra/qtrace.inc"
-#if defined(CERNLIB_QDEBUG)
- IQVREM(1,1) = IQVID(1)
- IQVREM(2,1) = IQVID(2)
-#endif
-
-C---- Construct Memory Occupation table
-
- MQDVGA = 0
- MQDVWI = 0
-
- IF (JQDIVI.LT.3) GO TO 24
- MQDVGA = MSBIT1 (0,JQDIVI)
- JQDVM2 = JQDIVI - JQMODE
- IF (JQDVM2.EQ.JQDVSY-1) JQDVM2=JQDVLL
- JQDVM1 = 2
- JQSTMV = JQSTOR
- IQTNMV = 0
- IF (JQSHAR.EQ.0) GO TO 29
- MQDVGA = MSBIT1 (MQDVGA,JQSHAR)
- GO TO 29
-
- 24 MQDVGA = 3
- JQSTMV = -1
- 29 NQDVMV = 0
- NRESAV = NQRESV
-#if (defined(CERNLIB_QDEBPRI))&&(!defined(CERNLIB_QTRHOLL)||defined(CERNLIB_A6M))
- IF (NQLOGL.GE.1) WRITE (IQLOG,9028) MQTRAC(NQTRAC-1),
- + JQSTOR,JQDIVI,NQRESV
- 9028 FORMAT (' MZGAR1- Auto Garbage Collection called from ',A6,
- F' for Store/Div',2I3,' Free',I7)
-#endif
-#if (defined(CERNLIB_QDEBPRI))&&(defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- IF (NQLOGL.GE.1) WRITE (IQLOG,9028) MQTRAC(NQTRAC-3),
- + MQTRAC(NQTRAC-2),JQSTOR,JQDIVI,NQRESV
- 9028 FORMAT (' MZGAR1- Auto Garbage Collection called from ',2A4,
- F' for Store/Div',2I3,' Free',I7)
-#endif
-#if defined(CERNLIB_QDEVZE)
- IF (NQDEVZ.GE.7)
- +WRITE (IQLOG,9829) JQDIVI,JQSHAR,NQRESV
- 9829 FORMAT (1X/' DEVZE MZGAR1 entered, JQDIVI,JQSHAR,NQRESV= ',3I8)
-#endif
- CALL MZTABM
-
-C-- Construct Link Relocation table
-
- CALL MZTABR
- NQRESV = NQRESV + NQFREE
- IF (NQRESV.GE.0) GO TO 51
- IF (IQPART.NE.0) GO TO 51
- IF (JQDIVI.LT.3) GO TO 72
-
-C---- Shift division if not enough space
-
- NRESV1 = LQSTA(KQT+2) - LQEND(KQT+1) - NQMINR
- NRESV1 = MIN (NRESV1,LQEND(KQT+2)-LQ2END)
-
-C-- Forward division
-
- IF (JQMODE.NE.0) GO TO 34
- IF (JQSHAR.NE.0) THEN
- NPOSSH = NQDMAX(KQT+JQDIVI) + NQDMAX(KQT+JQDIVN)
- + -(LQEND(KQT+JQDIVN) - LQSTA(KQT+JQDIVI))
- GO TO 36
- ELSE
- NPOSSH = LQSTA(KQT+JQDIVI) + NQDMAX(KQT+JQDIVI)
- + - LQSTA(KQT+JQDIVN)
- GO TO 36
- ENDIF
-
-C-- Reverse division
-
- 34 IF (JQSHAR.NE.0) THEN
- NPOSSH = NQDMAX(KQT+JQDIVI) + NQDMAX(KQT+JQDIVN)
- + -(LQEND(KQT+JQDIVI) - LQSTA(KQT+JQDIVN))
- ELSE
- NPOSSH = LQEND(KQT+JQDIVN)
- + - (LQEND(KQT+JQDIVI) - NQDMAX(KQT+JQDIVI))
- ENDIF
-
- 36 NSH = (LQEND(KQT+JQDIVI)-LQSTA(KQT+JQDIVI)) / 8
- NSH = MAX (NSH,24) - NQRESV
- NSH = MIN (NSH, NPOSSH, NRESV1)
-
- IF (NSH+NQRESV.LT.0) GO TO 72
-
-#if defined(CERNLIB_QDEVZE)
- IF (NQDEVZ.GE.7)
- +WRITE (IQLOG,9836) JQDIVI,JQSHAR,NQRESV
- +, NRESV1,NPOSSH,NSH
- +, JQGAPM,JQGAPR
- 9836 FORMAT (' DEVZE MZGAR1, JQDIVI,JQSHAR,NQRESV= ',3I8/
- F16X,'NRESV1,NPOSSH,NSH=',3I8/
- F16X,'JQGAPM,JQGAPR= ',2I8)
-#endif
- NQRESV = NQRESV + NSH
- NQDVMV = - NSH
- CALL MZTABS
-
-C---- Relocate + memory move
-
- 51 NWIN = NQRESV - NRESAV
-#if defined(CERNLIB_QDEBPRI)
- IF (NQLOGL.GE.1) WRITE (IQLOG,9051) NWIN,NQDVMV
- 9051 FORMAT (10X,'Wins',I7,' words, Shift by',I7)
-#endif
- CALL MZTABX
- CALL MZTABF
- IF (NQNOOP) 68, 53, 67
- 53 CALL MZGSTA (NQDGAF(KQT+1))
- CALL MZRELX
- 67 CALL MZMOVE
- 68 IF (NQRESV.LT.0) GO TO 71
-#include "zebra/qtrace99.inc"
- RETURN
-
-C-------- Not enough space
-
- 71 IF (IQPART.NE.0) GO TO 29
- 72 IQUEST(11) = NQRESV
- IQUEST(12) = JQSTOR
- IQUEST(13) = JQDIVI
-#if defined(CERNLIB_QDEBPRI)
- IF (NQLOGL.GE.1) WRITE (IQLOG,9072) NQRESV
- 9072 FORMAT (10X,'Not enough space, Free',I7)
-#endif
- IF (NQPERM.NE.0) GO TO 999
- IF (JQKIND.NE.1) GO TO 91
- CALL ZTELL (99,1)
-
-C------ Error conditions
-
- 91 NQCASE = 1
- NQFATA = 1
-#include "zebra/qtofatal.inc"
- END
diff --git a/src/packlib/zebra/mqg/mzgarb.F b/src/packlib/zebra/mqg/mzgarb.F
deleted file mode 100644
index f264f5b..0000000
--- a/src/packlib/zebra/mqg/mzgarb.F
+++ /dev/null
@@ -1,112 +0,0 @@
-*
-* $Id: mzgarb.F,v 1.3 1999/06/18 13:30:27 couet Exp $
-*
-* $Log: mzgarb.F,v $
-* Revision 1.3 1999/06/18 13:30:27 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.2 1996/04/18 16:12:32 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:20 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE MZGARB (IXGP,IXWP)
-
-C- Garbage collection + wiping, user called
-
-#include "zebra/zstate.inc"
-#include "zebra/zunit.inc"
-#include "zebra/zvfaut.inc"
-#include "zebra/mqsys.inc"
-#include "zebra/mzct.inc"
-*
- DIMENSION IXGP(1), IXWP(9)
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HMZGA, 4HRB /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HMZGARB /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'MZGARB ')
-#endif
-
-
- IXGARB = IXGP(1)
- IXWIPE = IXWP(1)
-#include "zebra/qtrace.inc"
-#if defined(CERNLIB_QDEBUG)
- IF (IQVSTA.NE.0) CALL ZVAUTX
- JVLEV = 2
-#endif
-
-C-- Construct Memory Occupation table
-
- MQDVGA = 0
- MQDVWI = 0
- IF (IXGARB.EQ.0) GO TO 16
-#if defined(CERNLIB_QDEBUG)
- JVLEV = 1
-#endif
-
- MQDVGA = MZDVAC (IXGARB)
- IF (IXWIPE.EQ.0) GO TO 19
- JSTO = JQSTOR
- MQDVWI = MZDVAC (IXWIPE)
- IF (JSTO.NE.JQSTOR) GO TO 91
- GO TO 19
-
- 16 MQDVWI = MZDVAC (IXWIPE)
- 19 IF (MQDVGA+MQDVWI.EQ.0) GO TO 999
-
- NQRESV = 0
- JQSTMV = -1
-#if defined(CERNLIB_QDEBPRI)
- IF (NQLOGL.LT.1) GO TO 24
- IF (MQDVGA.NE.0) GO TO 22
- IF (NQLOGL.LT.2) GO TO 24
- 22 WRITE (IQLOG,9022) JQSTOR,MQDVGA,MQDVWI
- 9022 FORMAT (' MZGARB- User Garb.C./Wipe for store',I3,', Divs',
-#endif
-#if !defined(CERNLIB_HEX)
- F2(2X,O8))
-#endif
-#if defined(CERNLIB_HEX)
- F2(2X,Z6))
-#endif
-#if defined(CERNLIB_QDEBUG)
- IQVREM(1,JVLEV) = IQVID(1)
- IQVREM(2,JVLEV) = IQVID(2)
-#endif
- 24 CALL MZTABM
-
-C-- Construct Link Relocation table
-
- CALL MZTABR
-
-C-- Relocate + memory move
-
- CALL MZTABX
- CALL MZTABF
- IF (NQNOOP.NE.0) GO TO 999
- CALL MZGSTA (NQDGAU(KQT+1))
- CALL MZRELX
- CALL MZMOVE
- IF (IQPART.NE.0) GO TO 24
-#include "zebra/qtrace99.inc"
- RETURN
-
-C------ Error conditions
-
- 91 NQCASE = 1
- NQFATA = 2
- IQUEST(11) = JSTO
- IQUEST(12) = JQSTOR
-#include "zebra/qtofatal.inc"
- END
diff --git a/src/packlib/zebra/mqg/mzgsta.F b/src/packlib/zebra/mqg/mzgsta.F
deleted file mode 100644
index 6fe27c0..0000000
--- a/src/packlib/zebra/mqg/mzgsta.F
+++ /dev/null
@@ -1,39 +0,0 @@
-*
-* $Id: mzgsta.F,v 1.3 1999/06/18 13:30:27 couet Exp $
-*
-* $Log: mzgsta.F,v $
-* Revision 1.3 1999/06/18 13:30:27 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.2 1996/04/18 16:12:36 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:20 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE MZGSTA (IGARB)
-
-C- Bump garbage collection statistic
-
-#include "zebra/mqsys.inc"
-#include "zebra/mzct.inc"
-*
- DIMENSION IGARB(20)
-
-
- LMT = LQMTA
- 22 IACT = LQ(LMT+1)
- IF (IACT.LT.3) GO TO 28
- JDIV = LQ(LMT)
- IF (IACT.EQ.3) GO TO 26
- NQDWIP(KQT+JDIV) = NQDWIP(KQT+JDIV) + 1
- GO TO 28
-
- 26 IGARB(JDIV) = IGARB(JDIV) + 1
- 28 LMT = LMT + 8
- IF (LMT.LT.LQMTE) GO TO 22
- RETURN
- END
diff --git a/src/packlib/zebra/mqg/mzmove.F b/src/packlib/zebra/mqg/mzmove.F
deleted file mode 100644
index 0c818e5..0000000
--- a/src/packlib/zebra/mqg/mzmove.F
+++ /dev/null
@@ -1,154 +0,0 @@
-*
-* $Id: mzmove.F,v 1.2 1999/06/18 13:30:27 couet Exp $
-*
-* $Log: mzmove.F,v $
-* Revision 1.2 1999/06/18 13:30:27 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:20 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE MZMOVE
-
-C- Garbage collector - memory move
-
-#include "zebra/zstate.inc"
-#include "zebra/zunit.inc"
-#include "zebra/mqsys.inc"
-#include "zebra/mzct.inc"
-*
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HMZMO, 4HVE /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HMZMOVE /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'MZMOVE ')
-#endif
-
-#include "zebra/q_jbit.inc"
-
-
-#include "zebra/qtrace.inc"
-
-C--------------- UPDATE DIVISION TABLES
-#if defined(CERNLIB_QDEVZE)
- IF (NQDEVZ.GE.11) WRITE (IQLOG,9821) LQMTA,LQMTE
- 9821 FORMAT (1X/' DEVZE MZMOVE, Update division tables, LQMTA/LQMTE='
- F,2I12)
-#endif
-
- LMT = LQMTA
-
- 23 JDIV = LQ(LMT)
- IACT = LQ(LMT+1)
- NSHF = LQ(LMT+2)
- IF (IACT.EQ.4) GO TO 26
- IF (IACT.NE.3) GO TO 31
-
-C---- Division with garbage collection
-C-- New start adr
-
- L = LQ(LMT+3)
- LT = LQ(LMT+5) + LQRTA
- N = LQ(LT+2)
- LQSTA(KQT+JDIV) = L + N
-
-C-- New end adr
-
- L = LQ(LMT+4)
- LT = LQ(LMT+6) + LQRTA - 4
- N = LQ(LT+2)
- LQEND(KQT+JDIV) = L + N
- GO TO 36
-
-C---- Wiped division
-
- 26 MODE = JBIT (IQMODE(KQT+JDIV),1)
- IF (MODE.NE.0) GO TO 28
-
-C-- Division mode forward
-
- LQSTA(KQT+JDIV) = LQSTA(KQT+JDIV) + NSHF
- GO TO 29
-
-C-- Division mode reverse
-
- 28 LQSTA(KQT+JDIV) = LQEND(KQT+JDIV) + NSHF
- 29 LQEND(KQT+JDIV) = LQSTA(KQT+JDIV)
- GO TO 36
-
-C---- Inactive division
-
- 31 IF (NSHF.EQ.0) GO TO 37
- LQSTA(KQT+JDIV) = LQSTA(KQT+JDIV) + NSHF
- LQEND(KQT+JDIV) = LQEND(KQT+JDIV) + NSHF
- 36 CONTINUE
-#if defined(CERNLIB_QDEVZE)
- IF (NQDEVZ.GE.11)
- +WRITE (IQLOG,9836) JDIV,LQSTA(KQT+JDIV),LQEND(KQT+JDIV)
- 9836 FORMAT (16X,'JDIV / LQSTA / LQEND =',I4,2I8)
-#endif
- 37 LMT = LMT + 8
- IF (LMT.LT.LQMTE) GO TO 23
- IF (NQNOOP.NE.0) GO TO 999
-
-C--------------- MEMORY MOVE
-#if defined(CERNLIB_QDEVZE)
- IF (NQDEVZ.GE.11) WRITE (IQLOG,9861) LQTA,LQTE
- 9861 FORMAT (1X/' DEVZE MZMOVE, Execute memory move, LQTA/LQTE=',2I12)
-#endif
- IF (LQTE.LE.LQTA) GO TO 999
-
- LTF = LQTA
-
- 61 NREL = LQ(LTF+2)
- IF (NREL) 64, 68, 71
-
-C-- Left squeeze
-
- 64 LOLD = LQ(LTF)
- LNEW = LOLD + NREL
- NW = LQ(LTF+1) - LOLD
- IF (NW.EQ.0) GO TO 68
- CALL UCOPY (LQ(KQS+LOLD),LQ(KQS+LNEW),NW)
-#if defined(CERNLIB_QDEVZE)
- IF (NQDEVZ.GE.11) WRITE (IQLOG,9865) LOLD, LNEW, NW
- 9865 FORMAT (16X,'Copy From / To / N=',3I8)
-#endif
- 68 LTF = LTF + 4
- IF (LTF.NE.LQTE) GO TO 61
- GO TO 999
-
-C---- Right squeeze
-
- 71 LTFN = LTF
- 72 LTFN = LTFN + 4
- IF (LTFN.EQ.LQTE) GO TO 76
- IF (LQ(LTFN+2).GT.0) GO TO 72
- 76 LTR = LTFN
-
-C-- Execute in reverse
-
- 81 LTR = LTR - 4
- LOLD = LQ(LTR)
- NW = LQ(LTR+1) - LOLD
- IF (NW.EQ.0) GO TO 88
- LNEW = LOLD + LQ(LTR+2)
- CALL UCOPY2 (LQ(KQS+LOLD),LQ(KQS+LNEW),NW)
-#if defined(CERNLIB_QDEVZE)
- IF (NQDEVZ.GE.11) WRITE (IQLOG,9887) LOLD, LNEW, NW
- 9887 FORMAT (16X,'Copy2 From / To / N=',3I8)
-#endif
- 88 IF (LTR.NE.LTF) GO TO 81
- LTF = LTFN
- IF (LTF.NE.LQTE) GO TO 61
-#include "zebra/qtrace99.inc"
- RETURN
- END
diff --git a/src/packlib/zebra/mqg/mzrelb.F b/src/packlib/zebra/mqg/mzrelb.F
deleted file mode 100644
index a7c9df1..0000000
--- a/src/packlib/zebra/mqg/mzrelb.F
+++ /dev/null
@@ -1,300 +0,0 @@
-*
-* $Id: mzrelb.F,v 1.4 1999/06/18 13:30:28 couet Exp $
-*
-* $Log: mzrelb.F,v $
-* Revision 1.4 1999/06/18 13:30:28 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.3 1996/04/24 17:26:32 mclareni
-* Extend the include file cleanup to dzebra, rz and tq, and also add
-* dependencies in some cases.
-*
-* Revision 1.2 1996/04/18 16:12:37 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:20 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE MZRELB
-
-C- Relocator for links in banks
-
-#include "zebra/zstate.inc"
-#include "zebra/zunit.inc"
-#include "zebra/mqsys.inc"
-#include "zebra/mzcn.inc"
-#include "zebra/mzct.inc"
-*
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HMZRE, 4HLB /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HMZRELB /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'MZRELB ')
-#endif
-
-#if !defined(CERNLIB_QDEBUG)
-#include "zebra/q_jbyt.inc"
-#endif
-
-
-#include "zebra/qtrace.inc"
-
- LFIXLO = LQ(LQTA-1)
- LFIXRE = LQ(LQTA)
- LFIXHI = LQ(LQTE)
- JHIGO = (LQTE-LQTA) / 4
- NENTR = JHIGO - 1
-
- IF (NENTR.EQ.0) THEN
- LADTB1 = LQ(LQTA+1)
- NRLTB2 = LQ(LQTA+2)
- IFLTB3 = LQ(LQTA+3)
- ENDIF
-
- LMRNX = LQMTA
- 12 LMR = LMRNX
- IF (LMR.GE.LQMTE) GO TO 999
- LMRNX = LMRNX + 8
-
-#if defined(CERNLIB_QDEVZE)
- IF (NQDEVZ.GE.11)
- +WRITE (IQLOG,9813) (LQ(J+LMR-1),J=1,8)
- 9813 FORMAT (1X/' DEVZE MZRELB. DIV, ACT, NSH, LF, LL, LTA, LTB'
- F,', NFREE'/14X,2I5,6I7)
-#endif
-
- IACT = LQ(LMR+1)
- IF (IACT.LE.0) GO TO 12
- IF (IACT.EQ.4) GO TO 12
- LSTOP = LQ(LMR+4)
- IF (IACT.EQ.3) GO TO 14
- LN = LQ(LMR+3)
- LDEAD = LSTOP
- GO TO 19
-
- 14 LSEC = LQRTA + LQ(LMR+5) - 4
-
-C------ Next bank, check if dead group
-
- 16 LSEC = LSEC + 4
- LNX = LQ(LSEC)
- LDEAD = LQ(LSEC+1)
-
- 17 LN = LNX
- IF (LN.GE.LSTOP) GO TO 12
- IF (LN.EQ.LDEAD) GO TO 16
-
-C-- Next bank, alive
-
- 19 CONTINUE
-
-#if defined(CERNLIB_QDEBUG)
- CALL MZCHLN (-7,LN)
- IF (IQFOUL.NE.0) GO TO 91
- LNX = IQNX
- IF (IQND.LT.0) GO TO 17
- LS = IQLS
- LX = LS + 3
- L2 = LS - IQNS
- L1 = LS - IQNL
-#endif
-#if defined(CERNLIB_QDEVZE)
- IF (NQDEVZ.GE.11) WRITE (IQLOG,9819) LN, IQID,IQNL,IQNS,IQND
- 9819 FORMAT (1X/' DEVZE MZRELB. Do bank at LN =',I7
- F,' ID,NL,NS,ND= ',A4,3I7)
-#endif
-#if !defined(CERNLIB_QDEBUG)
- NST = JBYT (LQ(KQS+LN),1,16) - 11
- IF (NST.LT.0) THEN
- LNX = LN + NST + 11
- GO TO 17
- ELSE
- LS = LN + NST
- LX = LS + 3
- L2 = LS - IQ(KQS+LS-2)
- L1 = LS - IQ(KQS+LS-3)
- LNX = LS + IQ(KQS+LS-1) + 9
- ENDIF
-#endif
- IF (NENTR) 66, 46, 26
-
-C-------------- 2 OR MORE RELOCATION INTERVALS -------------
-
-C---- Next link
-
- 24 LQ(KQS+L1)= 0
-
- 25 L1 = L1 + 1
- IF (L1.EQ.LX) GO TO 17
- 26 LFIRST= LQ(KQS+L1)
- 27 LINK = LQ(KQS+L1)
- IF (LINK.EQ.0) GO TO 25
-
-#if defined(CERNLIB_QDEVZE)
- IF (NQDEVZ.GE.11) WRITE (IQLOG,9827) LINK,L1
- 9827 FORMAT (16X,'Link =',I7,' from L1 =',I7)
-#endif
- IF (IQFLIO.EQ.0) THEN
- IF (LINK.LT.LFIXLO) GO TO 25
- IF (LINK.GE.LFIXHI) GO TO 25
- IF (LINK.LT.LFIXRE) GO TO 24
- ELSE
- IF (LINK.LT.LFIXRE) GO TO 24
- IF (LINK.GE.LFIXHI) GO TO 24
- ENDIF
-
-C-- Binary search in relocator table
-
- JLOW = 0
- JHI = JHIGO
-
- 29 JEX = (JHI+JLOW) / 2
- IF (JEX.EQ.JLOW) GO TO 31
- IF (LINK.GE.LQ(LQTA+4*JEX)) GO TO 30
- JHI = JEX
- GO TO 29
-
- 30 JLOW = JEX
- GO TO 29
-
-C-- Relocate
-
- 31 JTB = LQTA + 4*JLOW
-
-#if defined(CERNLIB_QDEVZE)
- IF (NQDEVZ.GE.11)
- +WRITE (IQLOG,9831) JLOW, (LQ(JTB+J-1),J=1,4)
- 9831 FORMAT (50X,'Entry',I5,',',4I7)
-#endif
- IF (LINK.GE.LQ(JTB+1)) GO TO 33
- LQ(KQS+L1) = LINK + LQ(JTB+2)
- GO TO 25
-
-C---- Link into dead area
-
- 33 IF (LQ(JTB+3)) 25, 24, 34
-
-C-- Bridge structural link
-
- 34 IF (L1.LT.L2) GO TO 24
- IF (LS+1-L1) 36, 24, 35
- 35 CONTINUE
-
-#if defined(CERNLIB_QDEBUG)
- CALL MZCHLS (-7,LINK)
- IF (IQFOUL.NE.0) GO TO 92
-#endif
- LINK = LQ(KQS+LINK)
- LQ(KQS+L1) = LINK
- IF (LINK.NE.LFIRST) GO TO 27
- GO TO 24
-
-C-- Reverse bridging of s-link
-
- 36 LINK = LQ(KQS+LINK+2)
- LQ(KQS+L1) = LINK
- GO TO 27
-
-C-------------- 1 RELOCATION INTERVAL ONLY -------------
-
-C---- Next link
-
- 44 LQ(KQS+L1)= 0
-
- 45 L1 = L1 + 1
- IF (L1.EQ.LX) GO TO 17
- 46 LFIRST= LQ(KQS+L1)
- 47 LINK = LQ(KQS+L1)
- IF (LINK.EQ.0) GO TO 45
-
-#if defined(CERNLIB_QDEVZE)
- IF (NQDEVZ.GE.11) WRITE (IQLOG,9827) LINK,L1
-#endif
- IF (IQFLIO.EQ.0) THEN
- IF (LINK.LT.LFIXLO) GO TO 45
- IF (LINK.GE.LFIXHI) GO TO 45
- IF (LINK.LT.LFIXRE) GO TO 44
- IF (LINK.GE.LADTB1) GO TO 53
- ELSE
- IF (LINK.LT.LFIXRE) GO TO 44
- IF (LINK.GE.LADTB1) GO TO 44
- ENDIF
-
-C-- Relocate
-
- LQ(KQS+L1) = LINK + NRLTB2
- GO TO 45
-
-C---- Link into dead area
-
- 53 IF (IFLTB3) 45, 44, 54
-
-C-- Bridge structural link
-
- 54 IF (L1.LT.L2) GO TO 44
- IF (LS+1-L1) 56, 44, 55
- 55 CONTINUE
-
-#if defined(CERNLIB_QDEBUG)
- CALL MZCHLS (-7,LINK)
- IF (IQFOUL.NE.0) GO TO 92
-#endif
- LINK = LQ(KQS+LINK)
- LQ(KQS+L1) = LINK
- IF (LINK.NE.LFIRST) GO TO 47
- GO TO 44
-
-C-- Reverse bridging of s-link
-
- 56 LINK = LQ(KQS+LINK+2)
- LQ(KQS+L1) = LINK
- GO TO 47
-
-C-------------- NO RELOCATION INTERVAL -------------
-
-C---- Next link
-
- 64 LQ(KQS+L1)= 0
-
- 65 L1 = L1 + 1
- IF (L1.EQ.LX) GO TO 17
- 66 LINK = LQ(KQS+L1)
- IF (LINK.EQ.0) GO TO 65
-
-#if defined(CERNLIB_QDEVZE)
- IF (NQDEVZ.GE.11) WRITE (IQLOG,9827) LINK,L1
-#endif
- IF (LINK.LT.LFIXLO) GO TO 65
- IF (LINK.GE.LFIXHI) GO TO 65
- GO TO 64
-
-C------ Error conditions
-#if defined(CERNLIB_QDEBUG)
- 92 NQCASE = 1
- NQFATA = 2
- LN = LS
- IQUEST(12) = L1
- IQUEST(13) = LINK
- 91 NQCASE = NQCASE + 1
- NQFATA = NQFATA + 1
- IQUEST(11) = LN
- IF (IQFLIO.NE.0) GO TO 98
-#include "zebra/qtofatal.inc"
-
- 98 IQUEST(9) = NQCASE
- IQUEST(10)= NQFATA
- NQCASE = 0
- NQFATA = 0
- IQFLIO = -7
-#endif
-#include "zebra/qtrace99.inc"
- RETURN
- END
diff --git a/src/packlib/zebra/mqg/mzrell.F b/src/packlib/zebra/mqg/mzrell.F
deleted file mode 100644
index 8a836a6..0000000
--- a/src/packlib/zebra/mqg/mzrell.F
+++ /dev/null
@@ -1,244 +0,0 @@
-*
-* $Id: mzrell.F,v 1.3 1999/06/18 13:30:28 couet Exp $
-*
-* $Log: mzrell.F,v $
-* Revision 1.3 1999/06/18 13:30:28 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.2 1996/04/18 16:12:38 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:20 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE MZRELL (MDESV)
-
-C- Relocator for links in link areas
-
-#include "zebra/zstate.inc"
-#include "zebra/zunit.inc"
-#include "zebra/mqsys.inc"
-#include "zebra/mzcn.inc"
-#include "zebra/mzct.inc"
-*
- DIMENSION MDESV(99)
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HMZRE, 4HLL /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HMZRELL /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'MZRELL ')
-#endif
-
-#include "zebra/q_jbit.inc"
-#include "zebra/q_jbyt.inc"
-
-
-#include "zebra/qtrace.inc"
-#if defined(CERNLIB_QDEVZE)
- LABS = LOCF (MDESV)
- LZEB = LABS - LQASTO
- LPRI = LABS - LQPSTO
- N = MIN(MDESV(1),11)
- IF (NQDEVZ.GE.11)
- +WRITE (IQLOG,9812) LABS,LZEB,LPRI,(MDESV(J),J=1,N)
- 9812 FORMAT (1X/' DEVZE MZRELL. Table of Link Areas, LABS,LZEB,LPRI='
- F,3I10/16X,'First 2 entries, First word=',I10,
-#endif
-#if (defined(CERNLIB_QDEVZE))&&(!defined(CERNLIB_HEX))
- F2(/16X,2I10,2X,O11,2X,2A4))
-#endif
-#if (defined(CERNLIB_QDEVZE))&&(defined(CERNLIB_HEX))
- F2(/16X,2I10,2X,Z8,2X,2A4))
-#endif
-
- LFIXLO = LQ(LQTA-1)
- LFIXRE = LQ(LQTA)
- LFIXHI = LQ(LQTE)
- JHIGO = (LQTE-LQTA) / 4
- NENTR = JHIGO - 1
-
- IF (NENTR.EQ.0) THEN
- LADTB1 = LQ(LQTA+1)
- NRLTB2 = LQ(LQTA+2)
- IFLTB3 = LQ(LQTA+3)
- ENDIF
-
- JDESMX = MDESV(1) - 4
- JDES = -4
- IF (MDESV(2).GE.MDESV(3)) JDES =1
-
-C------ Next link area, check if dead group
-
- 17 JDES = JDES + 5
- IF (JDES.GE.JDESMX) GO TO 999
-#if defined(CERNLIB_QDEVZE)
- IF (NQDEVZ.GE.11)
- +WRITE (IQLOG,9818) JDES,(MDESV(J+JDES),J=1,5)
- 9818 FORMAT (1X/' DEVZE MZRELL. Do area at',I5,' with',
-#endif
-#if (defined(CERNLIB_QDEVZE))&&(!defined(CERNLIB_HEX))
- F2I10,2X,O11,2X,2A4)
-#endif
-#if (defined(CERNLIB_QDEVZE))&&(defined(CERNLIB_HEX))
- F2I10,2X,Z8,2X,2A4)
-#endif
- LOCAR = MDESV(JDES+1)
- LIX = LOCAR
- LOCARE = MDESV(JDES+2)
- MODAR = MDESV(JDES+3)
- IF (JBIT(MODAR,31).NE.0) THEN
- IF (LQ(KQS+LOCAR).EQ.0) GO TO 17
- LIX = LIX + 2
- ENDIF
-
-C-- Next link area, alive
-
- LIR = LOCAR + JBYT (MODAR,1,15)
- IF (NENTR) 66, 46, 26
-
-C-------------- 2 OR MORE RELOCATION INTERVALS -------------
-
-C---- Next link
-
- 24 LQ(KQS+LIX)= 0
-
- 25 LIX = LIX + 1
- IF (LIX.EQ.LOCARE) GO TO 17
- 26 LFIRST= LQ(KQS+LIX)
- 27 LINK = LQ(KQS+LIX)
- IF (LINK.EQ.0) GO TO 25
-#if defined(CERNLIB_QDEVZE)
- IF (NQDEVZ.GE.11)
- +WRITE (IQLOG,9827) LINK,LIX
- 9827 FORMAT (16X,'Link =',I7,' from LIX =',I7)
-#endif
- IF (LINK.LT.LFIXLO) GO TO 25
- IF (LINK.GE.LFIXHI) GO TO 25
- IF (LINK.LT.LFIXRE) GO TO 24
-
-C-- Binary search in relocator table
-
- JLOW = 0
- JHI = JHIGO
-
- 29 JEX = (JHI+JLOW) / 2
- IF (JEX.EQ.JLOW) GO TO 31
- IF (LINK.GE.LQ(LQTA+4*JEX)) GO TO 30
- JHI = JEX
- GO TO 29
-
- 30 JLOW = JEX
- GO TO 29
-
-C-- Relocate
-
- 31 JTB = LQTA + 4*JLOW
-#if defined(CERNLIB_QDEVZE)
- IF (NQDEVZ.GE.11)
- +WRITE (IQLOG,9831) JLOW, (LQ(JTB+J-1),J=1,4)
- 9831 FORMAT (50X,'Entry',I5,',',4I7)
-#endif
- IF (LINK.GE.LQ(JTB+1)) GO TO 33
- LQ(KQS+LIX) = LINK + LQ(JTB+2)
- GO TO 25
-
-C---- Link into dead area
-
- 33 IF (LIX.GE.LIR) GO TO 24
-
-C-- Bridge structural link
-
- IF (LQ(JTB+3).LE.0) GO TO 24
-
-#if defined(CERNLIB_QDEBUG)
- CALL MZCHLS (-7,LINK)
- IF (IQFOUL.NE.0) GO TO 91
-#endif
- LINK = LQ(KQS+LINK)
- LQ(KQS+LIX) = LINK
- IF (LINK.NE.LFIRST) GO TO 27
- GO TO 24
-
-C-------------- 1 RELOCATION INTERVAL ONLY -------------
-
-C---- Next link
-
- 44 LQ(KQS+LIX)= 0
-
- 45 LIX = LIX + 1
- IF (LIX.EQ.LOCARE) GO TO 17
- 46 LFIRST= LQ(KQS+LIX)
- 47 LINK = LQ(KQS+LIX)
- IF (LINK.EQ.0) GO TO 45
-#if defined(CERNLIB_QDEVZE)
- IF (NQDEVZ.GE.11)
- +WRITE (IQLOG,9827) LINK,LIX
-#endif
- IF (LINK.LT.LFIXLO) GO TO 45
- IF (LINK.GE.LFIXHI) GO TO 45
- IF (LINK.LT.LFIXRE) GO TO 44
-
-C-- Relocate
-
- IF (LINK.GE.LADTB1) GO TO 53
- LQ(KQS+LIX) = LINK + NRLTB2
- GO TO 45
-
-C---- Link into dead area
-
- 53 IF (LIX.GE.LIR) GO TO 44
-
-C-- Bridge structural link
-
- IF (IFLTB3.LE.0) GO TO 44
-
-#if defined(CERNLIB_QDEBUG)
- CALL MZCHLS (-7,LINK)
- IF (IQFOUL.NE.0) GO TO 91
-#endif
- LINK = LQ(KQS+LINK)
- LQ(KQS+LIX) = LINK
- IF (LINK.NE.LFIRST) GO TO 47
- GO TO 44
-
-C-------------- NO RELOCATION INTERVAL -------------
-
-C---- Next link
-
- 64 LQ(KQS+LIX)= 0
-
- 65 LIX = LIX + 1
- IF (LIX.EQ.LOCARE) GO TO 17
- 66 LINK = LQ(KQS+LIX)
- IF (LINK.EQ.0) GO TO 65
-#if defined(CERNLIB_QDEVZE)
- IF (NQDEVZ.GE.11)
- +WRITE (IQLOG,9827) LINK,LIX
-#endif
- IF (LINK.LT.LFIXLO) GO TO 65
- IF (LINK.GE.LFIXHI) GO TO 65
- GO TO 64
-
-C------ Error conditions
-
-#if defined(CERNLIB_QDEBUG)
- 91 NQCASE = 1
- NQFATA = 5
- IQUEST(11) = LOCAR + LQSTOR
- IQUEST(12) = LIX - LOCAR + 1
- IQUEST(13) = LINK
- IQUEST(14) = MDESV(JDES+4)
- IQUEST(15) = MDESV(JDES+5)
-#include "zebra/qtofatal.inc"
-#endif
-#include "zebra/qtrace99.inc"
- RETURN
- END
diff --git a/src/packlib/zebra/mqg/mzrelx.F b/src/packlib/zebra/mqg/mzrelx.F
deleted file mode 100644
index 19c747d..0000000
--- a/src/packlib/zebra/mqg/mzrelx.F
+++ /dev/null
@@ -1,79 +0,0 @@
-*
-* $Id: mzrelx.F,v 1.3 1999/06/18 13:30:28 couet Exp $
-*
-* $Log: mzrelx.F,v $
-* Revision 1.3 1999/06/18 13:30:28 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.2 1996/04/18 16:12:42 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:20 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE MZRELX
-
-C- Execute normal relocation of links in banks and in link areas
-
-#include "zebra/zstate.inc"
-#include "zebra/zunit.inc"
-#include "zebra/mqsys.inc"
-#include "zebra/mzct.inc"
-*
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HMZRE, 4HLX /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HMZRELX /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'MZRELX ')
-#endif
-
-
-#include "zebra/qtrace.inc"
-
-#if defined(CERNLIB_QDEVZE)
- IF (NQDEVZ.LT.11) GO TO 29
- WRITE (IQLOG,9821) LQMTA,LQMTE
- 9821 FORMAT (1X/' DEVZE MZRELX, Memory Occupation Table,'
- F,' LQMTA,LQMTE= ',2I8/16X,
- F' DIV ACT NWS LFBK LLBK+1 JFE JLE FREE')
-
- WRITE (IQLOG,9822) (LQ(J),J=LQMTA,LQMTE-1)
- 9822 FORMAT (16X,2I4,6I8)
-
- WRITE (IQLOG,9823) LQRTA,LQTA,LQTE,LQ(LQTA-1)
- 9823 FORMAT (1H0,15X,'Link Relocation Table,'
- F,' LQRTA,LQTA,LQTE= ',3I8
- F/16X,' LOC L LE NREL BG'
- F/30X,I8)
-
- IF (LQTE.LE.LQTA) GO TO 25
- I = LQRTA
- JA = LQTA - I
- JE = LQTE - I - 1
- WRITE (IQLOG,9824) (J,LQ(I+J),LQ(I+J+1),LQ(I+J+2),LQ(I+J+3),
- + J=JA,JE,4)
- 9824 FORMAT (16X,I6,3I8,I4)
-
- 25 WRITE (IQLOG,9825) LQ(LQTE)
- 9825 FORMAT (22X,I8)
- 29 CONTINUE
-#endif
-
- L = LQSYSS(KQT+1)
- IF (L.NE.0) THEN
- IQ(KQS+L+3) = IQ(KQS+L+2) + NQLINK
- CALL MZRELL (IQ(KQS+L+1))
- ENDIF
-
- CALL MZRELB
-#include "zebra/qtrace99.inc"
- RETURN
- END
diff --git a/src/packlib/zebra/mqg/mztabc.F b/src/packlib/zebra/mqg/mztabc.F
deleted file mode 100644
index b820c7b..0000000
--- a/src/packlib/zebra/mqg/mztabc.F
+++ /dev/null
@@ -1,142 +0,0 @@
-*
-* $Id: mztabc.F,v 1.4 1999/06/18 13:30:29 couet Exp $
-*
-* $Log: mztabc.F,v $
-* Revision 1.4 1999/06/18 13:30:29 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.3 1996/04/24 17:26:33 mclareni
-* Extend the include file cleanup to dzebra, rz and tq, and also add
-* dependencies in some cases.
-*
-* Revision 1.2 1996/04/18 16:12:44 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:20 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE MZTABC
-
-C- Construct table of banks with value IQTVAL in status bit IQTBIT
-C-
-C- LQMTC1 start adr of first bank
-C- LQMTC2 end+1 adr of last bank
-C- LQTC1 first table word available
-C- LQTC2 last table word available
-
-C- Return IQPART if table incomplete
-C- NQFRTC number of words occupied by the holes
-C- NQLIVE number of live banks
-
-#include "zebra/mzcn.inc"
-#include "zebra/mqsys.inc"
-#include "zebra/mzct.inc"
-*
- EQUIVALENCE (LS,IQLS), (LNX,IQNX)
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HMZTA, 4HBC /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HMZTABC /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'MZTABC ')
-#endif
-
-#include "zebra/q_jbit.inc"
-#if !defined(CERNLIB_QDEBUG)
-#include "zebra/q_jbyt.inc"
-#endif
-
-
-#include "zebra/qtrace.inc"
-
- NQFRTC = 0
- NQLIVE = 0
- N = 0
-
- LNX = LQMTC1
- LQTE = LQTC1
- NEW = IQTVAL
-
- LQ(LQTE) = LNX
- LQ(LQTE+2) = 0
-
-C---- Next bank
-
- 21 MODE = NEW
- 22 LN = LNX
- IF (LN.GE.LQMTC2) GO TO 41
- N = N + 1
-#if defined(CERNLIB_QDEBUG)
- CALL MZCHLN (-7,LN)
- IF (IQFOUL.NE.0) GO TO 91
-#endif
-#if !defined(CERNLIB_QDEBUG)
- NST = JBYT (LQ(KQS+LN),1,16) - 11
- IF (NST.GE.0) THEN
- LS = LN + NST
- LNX = LS + IQ(KQS+LS-1) + 9
- ELSE
- LS = LN - 8
- LNX = LN + NST + 11
- ENDIF
-#endif
- NEW = JBIT (IQ(KQS+LS),IQTBIT)
- IF (NEW.EQ.MODE) GO TO 22
- IF (NEW.EQ.IQTVAL) GO TO 36
-
-C-- Start of a dead group
-
- NQLIVE = NQLIVE + N - 1
- LQ(LQTE+1) = LN
- LQ(LQTE+3) = 1
- LQTE = LQTE + 4
- GO TO 21
-
-C-- Start of a live group
-
- 36 NQFRTC = NQFRTC + (LN - LQ(LQTE-3))
- LQ(LQTE) = LN
- LQ(LQTE+2) = 0
- N = 1
- IF (LQTE.LT.LQTC2) GO TO 21
- CALL MZTABH
- IF (IQPART.EQ.0) GO TO 21
- IQPART = 1
- LN = LQMTC2
-
-C---- Close live end group
-
- 41 IF (NEW.NE.IQTVAL) GO TO 43
- NQLIVE = NQLIVE + N
- LQ(LQTE+1) = LN
- LQ(LQTE+3) = 0
- GO TO 45
-
-C-- Close dead end group
-
- 43 NQFRTC = NQFRTC + (LN-LQ(LQTE-3))
- LQ(LQTE) = LN
- LQ(LQTE+1) = LN
- LQ(LQTE+2) = 0
- LQ(LQTE+3) = 0
-
- 45 LQTE = LQTE + 4
-#include "zebra/qtrace99.inc"
- RETURN
-
-C------ Error conditions
-
- 91 NQCASE = 1
- NQFATA = 3
- IQUEST(11) = LN
- IQUEST(12) = LQMTC1
- IQUEST(13) = LQMTC2
-#include "zebra/qtofatal.inc"
- END
diff --git a/src/packlib/zebra/mqg/mztabf.F b/src/packlib/zebra/mqg/mztabf.F
deleted file mode 100644
index 66cad8e..0000000
--- a/src/packlib/zebra/mqg/mztabf.F
+++ /dev/null
@@ -1,179 +0,0 @@
-*
-* $Id: mztabf.F,v 1.2 1999/06/18 13:30:30 couet Exp $
-*
-* $Log: mztabf.F,v $
-* Revision 1.2 1999/06/18 13:30:30 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:20 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE MZTABF
-
-C- Finalize Link Relocation table
-
-#include "zebra/zstate.inc"
-#include "zebra/zunit.inc"
-#include "zebra/mqsys.inc"
-#include "zebra/mzct.inc"
-*
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HMZTA, 4HBF /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HMZTABF /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'MZTABF ')
-#endif
-
-#include "zebra/q_jbit.inc"
-
-
-#include "zebra/qtrace.inc"
-
- LMT = LQMTA
- NCOLL = 0
- NGARB = 0
- NQNOOP = 0
- LFIXLO = NQLINK + 1
-
-C---- Truncate initial inactive division entries
-
- 21 JDIV = LQ(LMT)
- IACT = LQ(LMT+1)
- IF (IACT.EQ.4) GO TO 26
- IF (IACT.GE.2) GO TO 28
-
- IF (IACT.GE.0) LFIXLO=LQEND(KQT+JDIV)
-
- LMT = LMT + 8
- IF (LMT.LT.LQMTE) GO TO 21
- NQNOOP = -7
- IF (NQDVMV.EQ.0) GO TO 81
- NQNOOP = 7
- GO TO 81
-
-C-- First active division is wipe
-
- 26 IF (LQ(LMT+9).NE.4) GO TO 28
- IF (LMT+8.GE.LQMTE) GO TO 28
- LMT = LMT + 8
- GO TO 26
-
-C-- First active division has garb. coll. or shift
-
- 28 LFIR = LMT
- LQTA = LQRTA + LQ(LMT+5)
-
-C-------- Loop remaining divisions
-
- 31 IACT = LQ(LMT+1)
- NSHF = LQ(LMT+2)
- LTU = LQRTA + LQ(LMT+5)
- IF (IACT.EQ.4) GO TO 71
- IF (IACT.EQ.3) GO TO 61
- IF (IACT.EQ.2) GO TO 41
- IF (IACT.LT.0) GO TO 79
- NCOLL = NCOLL + 1
- IF (NCOLL.NE.1) GO TO 79
- LCOLL = LMT
- GO TO 79
-
-C------ Inactive division with shift
-
- 41 IF (NCOLL+NGARB.LT.2) GO TO 49
-
-C---- Squeeze out useless entries
-
- 43 LCOLE = LMT - 8
- LT = LQ(LCOLE+5)
- LTF = LQ(LCOLL+5)
- N = LT - LTF
-
-C-- Shift active start of the table
-
- NW = LQRTA + LTF+1 - LQTA
- CALL UCOPY2 (LQ(LQTA),LQ(LQTA+N),NW)
- LQTA = LQTA + N
- NCOLL = 0
- IF (IACT.EQ.4) GO TO 71
- IF (IACT.EQ.3) GO TO 61
-
- 49 LQ(LTU+2) = NSHF
- GO TO 77
-
-C---- Garbage collection division
-
- 61 IF (NCOLL+NGARB.GE.2) GO TO 43
- JDIV = LQ(LMT)
- LT = LTU
- LTE = LQRTA + LQ(LMT+6)
- MODE = JBIT (IQMODE(KQT+JDIV),1)
- IF (MODE.NE.0) GO TO 65
-
-C-- Calculate relocation constants for forward mode
-
- NCUM = NSHF
- GO TO 66
-
-C-- Calculate relocation constants for reverse mode
-
- 65 NCUM = LQ(LMT+7) + NSHF
- 66 LQ(LT+2) = NCUM
- NCUM = NCUM - (LQ(LT+4)-LQ(LT+1))
- LT = LT + 4
- IF (LT.LT.LTE) GO TO 66
- NGARB = -64
- GO TO 77
-
-C-- Wipe division
-
- 71 IF (NCOLL+NGARB.GE.2) GO TO 43
- 77 NCOLL = 0
-
-C-- End of loop, set table termination
-
- 79 LMT = LMT + 8
- IF (LMT.LT.LQMTE) GO TO 31
- LQ(LQTA-1) = LFIXLO
-
- IF (NCOLL.EQ.0) GO TO 81
- LQTE = LQRTA + LQ(LCOLL+5)
-
- 81 CONTINUE
-#if defined(CERNLIB_QDEVZE)
- IF (NQDEVZ.LT.11) GO TO 999
- WRITE (IQLOG,9881) LQMTA,LQMTE
- 9881 FORMAT (1X/' DEVZE MZTABF, Memory Occupation Table,'
- F,' LQMTA,LQMTE= ',2I8/16X,
- F' DIV ACT NWS LFBK LLBK+1 JFE JLE FREE')
-
- WRITE (IQLOG,9882) (LQ(J),J=LQMTA,LQMTE-1)
- 9882 FORMAT (16X,2I4,6I8)
-
- WRITE (IQLOG,9883) LQRTA,LQTA,LQTE,LFIXLO
- 9883 FORMAT (1H0,15X,'Link Relocation Table,'
- F,' LQRTA,LQTA,LQTE= ',3I8
- F/16X,' LOC L LE NREL BG'
- F/30X,I8)
-
- IF (LQTE.LE.LQTA) GO TO 85
- I = LQRTA
- JA = LQTA - I
- JE = LQTE - I - 1
- WRITE (IQLOG,9884) (J,LQ(I+J),LQ(I+J+1),LQ(I+J+2),LQ(I+J+3),
- + J=JA,JE,4)
- 9884 FORMAT (16X,I6,3I8,I4)
-
- 85 WRITE (IQLOG,9885) LQ(LQTE)
- 9885 FORMAT (22X,I8)
-#endif
-#include "zebra/qtrace99.inc"
- RETURN
- END
diff --git a/src/packlib/zebra/mqg/mztabh.F b/src/packlib/zebra/mqg/mztabh.F
deleted file mode 100644
index 47d7827..0000000
--- a/src/packlib/zebra/mqg/mztabh.F
+++ /dev/null
@@ -1,136 +0,0 @@
-*
-* $Id: mztabh.F,v 1.3 1999/06/18 13:30:31 couet Exp $
-*
-* $Log: mztabh.F,v $
-* Revision 1.3 1999/06/18 13:30:31 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.2 1996/04/18 16:12:46 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:20 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE MZTABH
-
-C- Help : the standard table working space is too small;
-C- shift tables to free gaps of reserve areas in dynamic stores
-
-#include "zebra/zstate.inc"
-#include "zebra/zunit.inc"
-#include "zebra/mqsys.inc"
-#include "zebra/mzct.inc"
-*
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HMZTA, 4HBH /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HMZTABH /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'MZTABH ')
-#endif
-
-
-#include "zebra/qtrace.inc"
-
- IF (JQGAPM.NE.0) GO TO 41
-
-C---- On first entry : move Memory Occupation table
-
- CALL MZFGAP
- NW = LQMTE+1 - LQMTA
- JQGAPM = NQGAPN
- IF (JQGAPM.LT.2) GO TO 26
- 23 LNEW = IQGAP(2,JQGAPM)
- NSH = LNEW - LQMTA
- CALL UCOPY (LQ(LQMTA),LQ(LNEW),NW)
-
- LQMTA = LNEW
- LQMTB = LQMTB + NSH
- LQMTE = LQMTE + NSH
-
- LQTC2 = LQTC2 + 161
- LQRTE = LQRTE + 161
- IQGAP(1,JQGAPM) = IQGAP(1,JQGAPM) - NW
- IQGAP(2,JQGAPM) = IQGAP(2,JQGAPM) + NW
-
-#if defined(CERNLIB_QDEVZE)
- IF (NQDEVZ.GE.11) THEN
- JDIV = IQGAP(3,JQGAPM)
- JSTO = IQGAP(4,JQGAPM)
- WRITE (IQLOG,9824) JQGAPM,JDIV,JSTO,NQOFFS(JSTO+1)
- +, LQMTA,LQMTB,LQMTE,LQRTA,LQTC1,LQTC2,LQRTE
- ENDIF
- 9824 FORMAT (1X/' DEVZE MZTABH, Gap,Div,Store,Off-set =',3I4,I10
- F/16X,'LQMTA,LQMTB,LQMTE = ',3I10
- F/16X,'LQRTA,LQTC1,LQTC2,LQRTE=',5I10)
-#endif
-#include "zebra/qtrace99.inc"
- RETURN
-
-C-- Less than 2 gaps available
-
- 26 IF (IQTNMV.EQ.0) JQGAPM=NQGAP
- IF (JQGAPM.NE.0) GO TO 23
- IF (IQTNMV.LT.0) GO TO 31
- 29 IQPART = 7
-#if defined(CERNLIB_QDEVZE)
- IF (NQDEVZ.GE.11) WRITE (IQLOG,9828)
- 9828 FORMAT (1X/' DEVZE MZTABH, no space.')
-#endif
- GO TO 999
-
-C---- Move table to forbidden gap, if IQTNMV < 0
-
- 31 JQGAPM = NQGAP
- IF (JQGAPM.EQ.0) GO TO 29
- IQPART = -7
- GO TO 23
-
- 36 IF (IQTNMV.GE.0) GO TO 29
- IF (JQGAPR.GT.NQGAPN) GO TO 29
- JQGAPR = NQGAP
- IF (JQGAPR.EQ.0) GO TO 29
- IF (IQGAP(1,NQGAP-1).GT.IQGAP(1,NQGAP)) JQGAPR=NQGAP-1
- NNEW = IQGAP(1,JQGAPR) - (LQRTE-LQRTA) - 10
- IF (NNEW.LT.16) GO TO 29
- IQPART = -7
- GO TO 44
-
-C---- Re-entry : move the Link Relocation table
-
- 41 IF (JQGAPR.NE.0) GO TO 36
- IF (NQGAPN.EQ.0) GO TO 36
- NNEW = IQGAP(1,1) - NQWKTB
- IF (NNEW.LT.16) GO TO 36
- JQGAPR = 1
-
- 44 LNEW = IQGAP(2,JQGAPR)
- NSH = LNEW - LQRTA
- NW = LQTE+4 - LQRTA
- CALL UCOPY (LQ(LQRTA),LQ(LNEW),NW)
-
-#if defined(CERNLIB_QDEVZE)
- IF (NQDEVZ.GE.11) WRITE (IQLOG,9842) LQRTA,LQTE,LQTC2,LQRTE
- 9842 FORMAT (1X/' DEVZE MZTABH, LQRTA,LQTE,LQTC2,LQRTE=',4I10)
-#endif
- LQTA = LQTA + NSH
- LQTE = LQTE + NSH
- LQTC1 = LQTC1 + NSH
- LQTC2 = LNEW + (LQTC2-LQRTA) + NNEW
- LQRTE = LNEW + (LQRTE-LQRTA) + NNEW
- LQRTA = LNEW
-
-#if defined(CERNLIB_QDEVZE)
- IF (NQDEVZ.GE.11)
- + WRITE (IQLOG,9844) LQRTA,LQTE,LQTC2,LQRTE,NNEW
- 9844 FORMAT (16X,'LQRTA,LQTE,LQTC2,LQRTE=',4I10,' NEW=',I10)
-#endif
- GO TO 999
- END
diff --git a/src/packlib/zebra/mqg/mztabm.F b/src/packlib/zebra/mqg/mztabm.F
deleted file mode 100644
index c517fba..0000000
--- a/src/packlib/zebra/mqg/mztabm.F
+++ /dev/null
@@ -1,142 +0,0 @@
-*
-* $Id: mztabm.F,v 1.3 1999/06/18 13:30:31 couet Exp $
-*
-* $Log: mztabm.F,v $
-* Revision 1.3 1999/06/18 13:30:31 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.2 1996/04/18 16:12:47 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:20 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE MZTABM
-
-C- Construct Memory Occupation table with one entry for
-C- each division, setting actions according to :
-C- MQDVGA division bits for garbage collection
-C- MQDVWI for wipe
-C-
-C- Return division bits for all active divisions in MQDVAC
-
-#include "zebra/zstate.inc"
-#include "zebra/zunit.inc"
-#include "zebra/mqsys.inc"
-#include "zebra/mzct.inc"
-*
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HMZTA, 4HBM /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HMZTABM /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'MZTABM ')
-#endif
-
-#include "zebra/q_jbit.inc"
-#include "zebra/q_sbit1.inc"
-
-
-#include "zebra/qtrace.inc"
-
- LQMTBR = 0
- IQTBIT = IQDROP
- IQTVAL = 0
- NQFREE = 0
- IQPART = 0
- MQDVAC = 0
- IQFLIO = 0
-
- IF (JQSTMV.LT.0) THEN
- IQTNMV = 0
- JQDVM1 = 0
- JQDVM2 = 0
- NQDVMV = 0
- ENDIF
-
- JQGAPM = 0
- JQGAPR = 0
- LQMTE = LQWKTB + NQWKTB - 1
- LQMTA = LQMTE - 160
- LQMTB = LQMTA
- LQRTE = LQMTA - 10
- LQTC2 = LQRTE
- LQRTA = LQWKTB
- LQTA = LQRTA + 1
- LQTE = LQTA
- LQTC1 = LQTA
-
-#if defined(CERNLIB_QDEVZE)
- IF (NQDEVZ.GE.11) WRITE (IQLOG,9828) LQRTA,LQRTE,LQMTA,LQMTE
- 9828 FORMAT (1X/' DEVZE MZTABM, LQRTA,LQRTE,LQMTA,LQMTE=',4I9)
-#endif
-
-C---- Loop all divisions
-
- LMT = LQMTA
- JDIV = 1
-
- 32 LQ(LMT) = JDIV
- LQ(LMT+1) = 0
- LQ(LMT+2) = 0
- LQ(LMT+3) = LQSTA(KQT+JDIV)
- LQ(LMT+4) = LQEND(KQT+JDIV)
- LQ(LMT+5) = 0
- LQ(LMT+6) = 0
- LQ(LMT+7) = 0
- NW = LQ(LMT+4) - LQ(LMT+3)
- IF (NW.EQ.0) GO TO 37
- NQDSIZ(KQT+JDIV) = MAX (NQDSIZ(KQT+JDIV),NW)
- IF (JBIT(MQDVWI,JDIV).NE.0) GO TO 41
- IF (JBIT(MQDVGA,JDIV).NE.0) GO TO 44
- GO TO 48
-
-C-- Division is empty
-
- 37 LQ(LMT+1) = -1
- GO TO 48
-
-C-- Division for wipe
-
- 41 IF (JDIV.EQ.JQDVSY) GO TO 48
- LQ(LMT+1) = 4
- GO TO 45
-
-C-- Division with garbage collection
-
- 44 LQ(LMT+1) = 3
- 45 MQDVAC = MSBIT1 (MQDVAC,JDIV)
-
- 48 LMT = LMT + 8
- JDIV = JDIV + 1
- IF (JDIV.EQ.JQDVLL+1) JDIV=JQDVSY
- IF (JDIV.LT.21) GO TO 32
- LQMTE = LMT
- LQMTLU = LMT
- LQ(LQMTE) = 21
-#if defined(CERNLIB_QDEVZE)
- IF (NQDEVZ.LT.11) GO TO 999
- WRITE (IQLOG,9849) LQMTE,MQDVGA,MQDVWI,MQDVAC
- WRITE (IQLOG,9850)
- WRITE (IQLOG,9851) (LQ(J),J=LQMTA,LQMTE-1)
- 9850 FORMAT (16X,' DIV ACT NWS LF LE+1')
- 9851 FORMAT (16X,3I4,2I8,3I4)
-#endif
-#if (defined(CERNLIB_QDEVZE))&&(defined(CERNLIB_HEX))
- 9849 FORMAT (1X/' DEVZE MZTABM, LQMTE,MQDVGA,MQDVWI,MQDVAC='
- F,5X,I8,3(2X,Z8))
-#endif
-#if (defined(CERNLIB_QDEVZE))&&(!defined(CERNLIB_HEX))
- 9849 FORMAT (1X/' DEVZE MZTABM, LQMTE,MQDVGA,MQDVWI,MQDVAC='
- F,5X,I8,3(2X,O11))
-#endif
-#include "zebra/qtrace99.inc"
- RETURN
- END
diff --git a/src/packlib/zebra/mqg/mztabr.F b/src/packlib/zebra/mqg/mztabr.F
deleted file mode 100644
index 787fa07..0000000
--- a/src/packlib/zebra/mqg/mztabr.F
+++ /dev/null
@@ -1,165 +0,0 @@
-*
-* $Id: mztabr.F,v 1.3 1999/06/18 13:30:32 couet Exp $
-*
-* $Log: mztabr.F,v $
-* Revision 1.3 1999/06/18 13:30:32 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.2 1996/04/18 16:12:48 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:20 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE MZTABR
-
-C- Create link reloctation table,
-C- driven by the Memory Occupation table
-
-#include "zebra/zstate.inc"
-#include "zebra/zunit.inc"
-#include "zebra/mqsys.inc"
-#include "zebra/mzct.inc"
-*
- EQUIVALENCE (LMT,LQMTB)
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HMZTA, 4HBR /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HMZTABR /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'MZTABR ')
-#endif
-
-#include "zebra/q_sbit0.inc"
-#include "zebra/q_sbit1.inc"
-
-
-#include "zebra/qtrace.inc"
-
-
- IF (LQMTBR.NE.0) GO TO 81
- LQTA = LQRTA + 2
- LQTE = LQTA
- LMT = LQMTA
-
-C------- Loop for division in the Mem. Occ. table
-
- LQ(LQTA-1) = NQLINK + 1
-
- 41 JDIV = LQ(LMT)
- LQ(LMT+5) = LQTE - LQRTA
-
- 42 LQ(LQTE) = LQ(LMT+3)
- LQ(LQTE+1) = LQ(LMT+4)
- LQ(LQTE+2) = 0
- LQ(LQTE+3) = 0
-
- IACT = LQ(LMT+1)
- IF (IACT.EQ.3) GO TO 61
- IF (IACT.EQ.-1) GO TO 78
- IF (IACT.EQ.4) GO TO 56
- IF (LQ(LMT+6).EQ.-3) GO TO 45
- LQTE = LQTE + 4
- GO TO 78
-
- 45 LQ(LMT+6) = 0
- LQ(LMT+1) = 3
- MQDVAC = MSBIT1 (MQDVAC,JDIV)
- GO TO 42
-
-C---- Division for wipe
-
- 56 LQ(LMT+7) = LQ(LMT+4) - LQ(LMT+3)
- GO TO 78
-
-C---- Division with garbage collection
-
- 61 IF (IQPART.NE.0) GO TO 66
- LQTC1 = LQTE
- LQTC2 = LQRTE - (LQMTE-LMT)/2
- IF (LQTC1.GE.LQTC2) GO TO 65
-
- LQMTC1 = LQ(LMT+3)
- LQMTC2 = LQ(LMT+4)
-
- CALL MZTABC
- NQFREE = NQFREE + NQFRTC
- IF (NQLIVE.EQ.0) GO TO 64
- IF (IQPART.NE.0) LQMTBR=LMT
- IF (NQFRTC.EQ.0) GO TO 67
-
- LQ(LMT+6) = LQTE - LQRTA
- LQ(LMT+7) = NQFRTC
- GO TO 78
-
-C-- Division is all dead
-
- 64 LQTE = LQTC1
- LQ(LMT+1) = 4
- GO TO 42
-
-C-- Division has no dead banks
-
- 65 LQMTBR = LMT
- IQPART = 7
- 66 LQ(LMT+6) = -3
- LQTE = LQTE + 4
- 67 LQ(LMT+1) = 2
- IF (LQ(LMT+2).EQ.0) THEN
- LQ(LMT+1) = 0
- MQDVAC = MSBIT0 (MQDVAC,JDIV)
- ENDIF
-
- 78 LMT = LMT + 8
- IF (LMT.LT.LQMTE) GO TO 41
- JDIV = LQ(LMT)
- LQ(LQTE) = LQSTA(KQT+JDIV)
-
-#if defined(CERNLIB_QDEVZE)
- IF (NQDEVZ.GE.11)
- +WRITE (IQLOG,9879) LQMTA,LQMTE,LQRTA,LQTA,LQTE,LQRTE
- 9879 FORMAT (' DEVZE MZTABR, LQMTA,LQMTE,LQRTA,LQTA,LQTE,LQRTE= '
- F,6I8)
-#endif
-
-#include "zebra/qtrace99.inc"
- RETURN
-
-C------ Re-start table building
-
- 81 LMT = LQMTBR
- LQMTBR = 0
- IQPART = 0
- JDIV = LQ(LMT)
- MQDVAC = MSBIT1 (MQDVAC,JDIV)
-
-#if defined(CERNLIB_QPRINT)
- WRITE (IQLOG, 9882)
- 9882 FORMAT (1X/' MZTABR!! !!!!**** re-entry with LQMTBR non-zero',
- F'****!!!!'/1X)
-#endif
-
- JWAY = LQ(LMT+6)
- IF (JWAY.EQ.-3) THEN
- LQTE = LQ(LMT+5)
- GO TO 45
- ENDIF
-
- LQTE = JWAY - 4
- LQMTC1 = LQ(LQTE)
- LQMTC2 = LQ(LQTE+1)
- LQTC1 = LQTE
- LQTC2 = LQRTE - (LQMTE-LMT)/2
-
- CALL MZTABC
- LQ(LMT+6) = LQTE - LQRTA
- LQ(LMT+7) = LQ(LMT+7) + NQFRTC
- GO TO 78
- END
diff --git a/src/packlib/zebra/mqg/mztabs.F b/src/packlib/zebra/mqg/mztabs.F
deleted file mode 100644
index 689b9ab..0000000
--- a/src/packlib/zebra/mqg/mztabs.F
+++ /dev/null
@@ -1,41 +0,0 @@
-*
-* $Id: mztabs.F,v 1.3 1999/06/18 13:30:32 couet Exp $
-*
-* $Log: mztabs.F,v $
-* Revision 1.3 1999/06/18 13:30:32 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.2 1996/04/18 16:12:49 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:20 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE MZTABS
-
-C- Update Memory Occupation table and MQDVAC for shifting
-C- divisions JQDVM1 to JQDVM2 by NQDVMV words
-
-#include "zebra/mqsys.inc"
-#include "zebra/mzct.inc"
-*
-
-#include "zebra/q_sbit1.inc"
-
- LMT = LQMTA
- 21 LMT = LMT + 8
- JDIV = LQ(LMT)
- IF (JDIV.LT.JQDVM1) GO TO 21
- IF (JDIV.GT.JQDVM2) RETURN
-
- LQ(LMT+2) = LQ(LMT+2) + NQDVMV
-
- IF (LQ(LMT+1).LT.0) GO TO 21
- IF (LQ(LMT+1).GE.2) GO TO 21
- LQ(LMT+1) = 2
- MQDVAC = MSBIT1 (MQDVAC,JDIV)
- GO TO 21
- END
diff --git a/src/packlib/zebra/mqg/mztabx.F b/src/packlib/zebra/mqg/mztabx.F
deleted file mode 100644
index 9b59cc2..0000000
--- a/src/packlib/zebra/mqg/mztabx.F
+++ /dev/null
@@ -1,54 +0,0 @@
-*
-* $Id: mztabx.F,v 1.3 1999/06/18 13:30:32 couet Exp $
-*
-* $Log: mztabx.F,v $
-* Revision 1.3 1999/06/18 13:30:32 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.2 1996/04/18 16:12:49 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:20 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE MZTABX
-
-C- Find all involved divisions, ie. all divisions which
-C- point into the moving divisions
-
-#include "zebra/mqsys.inc"
-#include "zebra/mzct.inc"
-*
-
-
-#include "zebra/q_or.inc"
-#include "zebra/q_jbytet.inc"
-
-C-- Merge kinds of active divisions
-
- MERGE = 0
- LMT = LQMTA
-
- 22 IF (LQ(LMT+1).LT.2) GO TO 27
- JDIV = LQ(LMT)
- MERGE = IOR (MERGE, IQKIND(KQT+JDIV))
- 27 LMT = LMT + 8
- IF (LMT.LT.LQMTE) GO TO 22
-
-C-- Pick divisions pointing
-
- LMT = LQMTA
- 32 IF (LQ(LMT+1)) 38, 33, 37
- 33 JDIV = LQ(LMT)
- IF (JBYTET(IQRTO(KQT+JDIV),MERGE,1,26).EQ.0) GO TO 38
- IF (JBYTET(IQRNO(KQT+JDIV),MERGE,1,26).EQ.0) GO TO 38
- LQ(LMT+1) = 1
-
- 37 LQMTLU = LMT + 8
- 38 LMT = LMT + 8
- IF (LMT.LT.LQMTE) GO TO 32
- RETURN
- END
diff --git a/src/packlib/zebra/mqg/mzwipe.F b/src/packlib/zebra/mqg/mzwipe.F
deleted file mode 100644
index b936a6f..0000000
--- a/src/packlib/zebra/mqg/mzwipe.F
+++ /dev/null
@@ -1,46 +0,0 @@
-*
-* $Id: mzwipe.F,v 1.2 1999/06/18 13:30:33 couet Exp $
-*
-* $Log: mzwipe.F,v $
-* Revision 1.2 1999/06/18 13:30:33 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:20 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE MZWIPE (IXWP)
-
-C- Wiping, user called
-
-#include "zebra/mqsysh.inc"
-#include "zebra/zvfaut.inc"
-*
- DIMENSION IXWP(9)
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HMZWI, 4HPE /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HMZWIPE /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'MZWIPE ')
-#endif
-
-#include "zebra/qtrace.inc"
-#if defined(CERNLIB_QDEBUG)
- IF (IQVSTA.NE.0) CALL ZVAUTX
-#endif
-
- IXWIPE = IXWP(1)
- IF (IXWIPE.EQ.0) IXWIPE=21
-
- CALL MZGARB (0,IXWIPE)
-
-#include "zebra/qtrace99.inc"
- RETURN
- END
diff --git a/src/packlib/zebra/mqs/Imakefile b/src/packlib/zebra/mqs/Imakefile
deleted file mode 100644
index 4129fc3..0000000
--- a/src/packlib/zebra/mqs/Imakefile
+++ /dev/null
@@ -1,6 +0,0 @@
-SRCS_F= lzfid.F lzfidh.F lzhead.F lzscan.F mzchln.F mzchls.F \ @@\
- mzchnb.F mzdvac.F mzfdiv.F mzform.F mziobk.F mziocf.F mzioch.F \ @@\
- mziocr.F mziotc.F mzixco.F mzneig.F mzresv.F mzsdiv.F mzxref.F \ @@\
- mzxrpr.F mzxrup.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/zebra/mqs/lzfid.F b/src/packlib/zebra/mqs/lzfid.F
deleted file mode 100644
index c775189..0000000
--- a/src/packlib/zebra/mqs/lzfid.F
+++ /dev/null
@@ -1,86 +0,0 @@
-*
-* $Id: lzfid.F,v 1.2 1999/06/18 13:30:40 couet Exp $
-*
-* $Log: lzfid.F,v $
-* Revision 1.2 1999/06/18 13:30:40 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:22 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- FUNCTION LZFID (IXDIVP,IDHP,IDNP,LGOP)
-
-C- Find first bank with IDH/IDN in div. IXDIV after bank at LGO
-C- user called
-
-#include "zebra/mqsys.inc"
-#include "zebra/mzcn.inc"
-*
- DIMENSION IXDIVP(9), IDHP(9), IDNP(9), LGOP(9)
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HLZFI, 4HD /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HLZFID /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'LZFID ')
-#endif
-
-#include "zebra/q_jbit.inc"
-
- IXIN = IXDIVP(1)
- IDH = IDHP(1)
- IDN = IDNP(1)
- LGO = LGOP(1)
-
- CALL MZSDIV (IXIN,4)
- LSTA = LQSTA(KQT+JQDIVI)
- IQNX = LSTA
- LEND = LQEND(KQT+JQDIVI)
-
- IF (LGO.EQ.0) GO TO 31
-
- IF (LGO.LT.LSTA) GO TO 91
- IF (LGO.GE.LEND) GO TO 91
-
- CALL MZCHLS (-7,LGO)
- IF (IQFOUL.NE.0) GO TO 92
-
- 31 LN = IQNX
- IF (LN.GE.LEND) GO TO 39
- CALL MZCHLN (-7,LN)
- IF (IQFOUL.NE.0) GO TO 93
- IF (IQND.LT.0) GO TO 31
- IF (IQ(KQS+IQLS-5).NE.IDN) GO TO 31
- IF (IQID.NE.IDH) GO TO 31
- IF (JBIT(IQ(KQS+IQLS),IQDROP).NE.0) GO TO 31
- LZFID = IQLS
- RETURN
-
- 39 LZFID = 0
- RETURN
-
-C------ ERROR CONDITIONS
-
- 93 NQCASE = 1
- NQFATA = 1
- IQUEST(17) = LN
- 92 NQCASE = NQCASE + 1
- 91 NQCASE = NQCASE + 1
- NQFATA = NQFATA + 6
- IQUEST(11) = IXIN
- IQUEST(12) = IDH
- IQUEST(13) = IDN
- IQUEST(14) = LGO
- IQUEST(15) = LSTA
- IQUEST(16) = LEND
-#include "zebra/qtrace.inc"
-#include "zebra/qtofatal.inc"
- LZFID = 0
- END
diff --git a/src/packlib/zebra/mqs/lzfidh.F b/src/packlib/zebra/mqs/lzfidh.F
deleted file mode 100644
index 6e85a3e..0000000
--- a/src/packlib/zebra/mqs/lzfidh.F
+++ /dev/null
@@ -1,84 +0,0 @@
-*
-* $Id: lzfidh.F,v 1.2 1999/06/18 13:30:40 couet Exp $
-*
-* $Log: lzfidh.F,v $
-* Revision 1.2 1999/06/18 13:30:40 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:22 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- FUNCTION LZFIDH (IXDIVP,IDHP,LGOP)
-
-C- Find first bank with IDH in division IXDIV after bank at LGO
-C- user called
-
-#include "zebra/mqsys.inc"
-#include "zebra/mzcn.inc"
-*
- DIMENSION IXDIVP(9), IDHP(9), LGOP(9)
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HLZFI, 4HDH /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HLZFIDH /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'LZFIDH ')
-#endif
-
-#include "zebra/q_jbit.inc"
-
- IXIN = IXDIVP(1)
- IDH = IDHP(1)
- LGO = LGOP(1)
-
- CALL MZSDIV (IXIN,4)
- LSTA = LQSTA(KQT+JQDIVI)
- IQNX = LSTA
- LEND = LQEND(KQT+JQDIVI)
-
- IF (LGO.EQ.0) GO TO 31
-
- IF (LGO.LT.LSTA) GO TO 91
- IF (LGO.GE.LEND) GO TO 91
-
- CALL MZCHLS (-7,LGO)
- IF (IQFOUL.NE.0) GO TO 92
-
- 31 LN = IQNX
- IF (LN.GE.LEND) GO TO 39
- CALL MZCHLN (-7,LN)
- IF (IQFOUL.NE.0) GO TO 93
- IF (IQND.LT.0) GO TO 31
- IF (IQID.NE.IDH) GO TO 31
- IF (JBIT(IQ(KQS+IQLS),IQDROP).NE.0) GO TO 31
- LZFIDH = IQLS
- RETURN
-
- 39 LZFIDH = 0
- RETURN
-
-C------ ERROR CONDITIONS
-
- 93 NQCASE = 1
- NQFATA = 1
- IQUEST(17) = LN
- 92 NQCASE = NQCASE + 1
- 91 NQCASE = NQCASE + 1
- NQFATA = NQFATA + 6
- IQUEST(11) = IXIN
- IQUEST(12) = IDH
- IQUEST(13) = 0
- IQUEST(14) = LGO
- IQUEST(15) = LSTA
- IQUEST(16) = LEND
-#include "zebra/qtrace.inc"
-#include "zebra/qtofatal.inc"
- LZFIDH = 0
- END
diff --git a/src/packlib/zebra/mqs/lzhead.F b/src/packlib/zebra/mqs/lzhead.F
deleted file mode 100644
index f08c616..0000000
--- a/src/packlib/zebra/mqs/lzhead.F
+++ /dev/null
@@ -1,90 +0,0 @@
-*
-* $Id: lzhead.F,v 1.3 1999/06/18 13:30:41 couet Exp $
-*
-* $Log: lzhead.F,v $
-* Revision 1.3 1999/06/18 13:30:41 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.2 1996/04/18 16:12:57 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:12 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- FUNCTION LZHEAD (IXSTOR, LGO)
-
-C- Find start of the linear structure containing bank at LGO
-C- Returns : LZHEAD L of the first bank,
-C- = zero if trouble
-C- IQUEST(1) JBIAS : -ve for normal dependent
-C- 1 for top structure
-C- 2 for stand-alone
-C- IQUEST(2) adr of the supporting link if JBIAS=1
-C- IQUEST(3) error indication if trouble
-
-#include "zebra/mqsys.inc"
-*
-
-#include "zebra/q_jbyt.inc"
-
-#include "zebra/qstore.inc"
-
- LH = LGO
- IQUEST(1) = 0
- IQUEST(2) = 0
- IQUEST(3) = 0
- IF (LH.EQ.0) GO TO 91
- LIML = LQSTA(KQT+1)
- LIMU = LQSTA(KQT+21)
- LUP = LQ(KQS+LH+1)
- IF (LUP.EQ.0) GO TO 41
-
-C---- L/s normal dependent : LUP .NE. 0
-
- NS = IQ(KQS+LUP-2)
- LOW = LUP - NS
- 22 LNX = LQ(KQS+LH+2)
- IF (LNX.LT.LIML) GO TO 92
- IF (LNX.GE.LIMU) GO TO 92
- IF (LNX.LT.LOW.OR.LNX.GE.LUP) THEN
- LH = LNX
- GO TO 22
- ENDIF
-
- JBIAS = LNX - LUP
- IF (LQ(KQS+LUP+JBIAS).NE.LH) GO TO 93
-
- IQUEST(1) = JBIAS
- LZHEAD = LH
- GO TO 999
-
-C---- L/s is a top structure : LUP = 0
-
- 41 LNX = LQ(KQS+LH+2)
- IF (LNX.EQ.0) GO TO 43
- IF (LNX.GE.LIML .AND. LNX.LT.LIMU) THEN
- LH = LNX
- GO TO 41
- ENDIF
-
- IQUEST(1) = 1
- IF (LQ(KQS+LNX).NE.LH) GO TO 94
- GO TO 44
-
- 43 IQUEST(1) = 2
- 44 IQUEST(2) = LNX
- LZHEAD = LH
- GO TO 999
-
-C---- Errors
-
- 94 IQUEST(3) = 1
- 93 IQUEST(3) = IQUEST(3) + 1
- 92 IQUEST(3) = IQUEST(3) + 1
- 91 IQUEST(3) = IQUEST(3) + 1
- LZHEAD = 0
- 999 RETURN
- END
diff --git a/src/packlib/zebra/mqs/lzscan.F b/src/packlib/zebra/mqs/lzscan.F
deleted file mode 100644
index a7ea623..0000000
--- a/src/packlib/zebra/mqs/lzscan.F
+++ /dev/null
@@ -1,82 +0,0 @@
-*
-* $Id: lzscan.F,v 1.2 1999/06/18 13:30:41 couet Exp $
-*
-* $Log: lzscan.F,v $
-* Revision 1.2 1999/06/18 13:30:41 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:12 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- FUNCTION LZSCAN (IXDIVP,LGOP)
-
-C- Find first bank in division IXDIV after bank at LGO
-C- user called
-
-#include "zebra/mqsys.inc"
-#include "zebra/mzcn.inc"
-*
- DIMENSION IXDIVP(9), LGOP(9)
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HLZSC, 4HAN /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HLZSCAN /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'LZSCAN ')
-#endif
-
-#include "zebra/q_jbit.inc"
-
- IXIN = IXDIVP(1)
- LGO = LGOP(1)
-
- CALL MZSDIV (IXIN,4)
- LSTA = LQSTA(KQT+JQDIVI)
- IQNX = LSTA
- LEND = LQEND(KQT+JQDIVI)
-
- IF (LGO.EQ.0) GO TO 31
-
- IF (LGO.LT.LSTA) GO TO 91
- IF (LGO.GE.LEND) GO TO 91
-
- CALL MZCHLS (-7,LGO)
- IF (IQFOUL.NE.0) GO TO 92
-
- 31 LN = IQNX
- IF (LN.GE.LEND) GO TO 39
- CALL MZCHLN (-7,LN)
- IF (IQFOUL.NE.0) GO TO 93
- IF (IQND.LT.0) GO TO 31
- IQUEST(1) = JBIT(IQ(KQS+IQLS),IQDROP)
- LZSCAN = IQLS
- RETURN
-
- 39 LZSCAN = 0
- RETURN
-
-C------ ERROR CONDITIONS
-
- 93 NQCASE = 1
- NQFATA = 1
- IQUEST(17) = LN
- 92 NQCASE = NQCASE + 1
- 91 NQCASE = NQCASE + 1
- NQFATA = NQFATA + 6
- IQUEST(11) = IXIN
- IQUEST(12) = 0
- IQUEST(13) = 0
- IQUEST(14) = LGO
- IQUEST(15) = LSTA
- IQUEST(16) = LEND
-#include "zebra/qtrace.inc"
-#include "zebra/qtofatal.inc"
- LZSCAN = 0
- END
diff --git a/src/packlib/zebra/mqs/mzchln.F b/src/packlib/zebra/mqs/mzchln.F
deleted file mode 100644
index 8388a1d..0000000
--- a/src/packlib/zebra/mqs/mzchln.F
+++ /dev/null
@@ -1,81 +0,0 @@
-*
-* $Id: mzchln.F,v 1.3 1999/06/18 13:30:41 couet Exp $
-*
-* $Log: mzchln.F,v $
-* Revision 1.3 1999/06/18 13:30:41 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.2 1996/04/18 16:12:58 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:21 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE MZCHLN (IXST,LP)
-
-C- Check LN is a valid start-of-bank address, system called
-
-#include "zebra/zmach.inc"
-#include "zebra/mqsys.inc"
-#include "zebra/mzcn.inc"
-*
- DIMENSION IXST(9), LP(9)
-
-#include "zebra/q_jbyt.inc"
-
-
- IXSTOR = IXST(1)
- IQLN = LP(1)
-
- IF (IXSTOR.EQ.-7) GO TO 21
-#include "zebra/qstore.inc"
-
- 21 IF (IQLN.LT.LQSTA(KQT+1)) GO TO 98
- IF (IQLN.GE.LQSTA(KQT+21)) GO TO 98
-
- IWD = LQ(KQS+IQLN)
- NST = JBYT (IWD,1,16) - 12
- IF (NST.LT.0) GO TO 41
-
-C-- TRUE BANK
-
- IQLS = IQLN + NST + 1
- IF (IQLS.GE.LQSTA(KQT+21)) GO TO 91
-
- IQNIO = JBYT (IQ(KQS+IQLS),19,4)
- IQID = IQ(KQS+IQLS-4)
- IQNL = IQ(KQS+IQLS-3)
- IQNS = IQ(KQS+IQLS-2)
- IQND = IQ(KQS+IQLS-1)
- IF ( JBYT(IQNL,IQBITW-3,4)
- + + JBYT(IQNS,IQBITW-3,4)
- + + JBYT(IQND,IQBITW-3,4) .NE.0) GO TO 91
- IQNX = IQLS + IQND + 9
- IF (IQNX.GT.LQSTA(KQT+21)) GO TO 91
- IF (IQNS.GT.IQNL) GO TO 91
- IF (NST.NE.IQNIO+IQNL) GO TO 91
- IQFOUL = 0
- RETURN
-
-C-- SHORT DEAD REGION
-
- 41 NWD = JBYT (IWD,17,IQDROP-17)
- IQLS = IQLN - 8
- IQNX = IQLN + NWD
- IQND = -NWD
- IF (NWD.EQ.0) GO TO 91
- IF (NWD.NE.NST+12) GO TO 91
-
- NST = JBYT (IWD,IQDROP,IQBITW-IQDROP)
- IF (NST.NE.1) GO TO 91
- IQFOUL= 0
- RETURN
-
- 91 IQFOUL = 7
- RETURN
- 98 IQFOUL = -7
- RETURN
- END
diff --git a/src/packlib/zebra/mqs/mzchls.F b/src/packlib/zebra/mqs/mzchls.F
deleted file mode 100644
index 4a7f3d8..0000000
--- a/src/packlib/zebra/mqs/mzchls.F
+++ /dev/null
@@ -1,63 +0,0 @@
-*
-* $Id: mzchls.F,v 1.3 1999/06/18 13:30:42 couet Exp $
-*
-* $Log: mzchls.F,v $
-* Revision 1.3 1999/06/18 13:30:42 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.2 1996/04/18 16:12:59 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:21 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE MZCHLS (IXST,LP)
-
-C- Check LS is a valid bank status-word address, can be user called
-
-#include "zebra/zmach.inc"
-#include "zebra/mqsys.inc"
-#include "zebra/mzcn.inc"
-*
- DIMENSION IXST(9), LP(9)
-
-#include "zebra/q_jbyt.inc"
-
-
- IXSTOR = IXST(1)
- IQLS = LP(1)
-
- IF (IXSTOR.EQ.-7) GO TO 21
-#include "zebra/qstore.inc"
-
- 21 IF (IQLS.LT.LQSTA(KQT+1)) GO TO 98
- IF (IQLS.GE.LQSTA(KQT+21)) GO TO 98
-
- IQNIO = JBYT (IQ(KQS+IQLS),19,4)
- IQID = IQ(KQS+IQLS-4)
- IQNL = IQ(KQS+IQLS-3)
- IQNS = IQ(KQS+IQLS-2)
- IQND = IQ(KQS+IQLS-1)
- IF ( JBYT(IQNL,IQBITW-3,4)
- + + JBYT(IQNS,IQBITW-3,4)
- + + JBYT(IQND,IQBITW-3,4) .NE.0) GO TO 91
- IQNX = IQLS + IQND + 9
- IF (IQNX.GT.LQSTA(KQT+21)) GO TO 91
-
- IQLN = IQLS - IQNL - IQNIO - 1
- IF (IQLN.LT.LQSTA(KQT+1)) GO TO 91
-
- NST = JBYT (LQ(KQS+IQLN),1,16) - 12
- IF (NST.NE.IQNIO+IQNL) GO TO 91
- IF (IQNS.GT.IQNL) GO TO 91
- IQFOUL = 0
- RETURN
-
- 91 IQFOUL = 7
- RETURN
- 98 IQFOUL = -7
- RETURN
- END
diff --git a/src/packlib/zebra/mqs/mzchnb.F b/src/packlib/zebra/mqs/mzchnb.F
deleted file mode 100644
index 624e7c4..0000000
--- a/src/packlib/zebra/mqs/mzchnb.F
+++ /dev/null
@@ -1,50 +0,0 @@
-*
-* $Id: mzchnb.F,v 1.2 1999/06/18 13:30:43 couet Exp $
-*
-* $Log: mzchnb.F,v $
-* Revision 1.2 1999/06/18 13:30:43 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:21 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE MZCHNB (LIX)
-
-C- Check that LIX is a link in the working space, in a link area,
-C- or even on a local variable, but not a link in a bank.
-C- This is used by routines which restore the input link
-C- from the user back to him, and which could therefor
-C- destroy bank material if a garbage collection happened
-
-#include "zebra/mqsys.inc"
-*
- DIMENSION LIX(9)
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HMZCH, 4HNB /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HMZCHNB /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'MZCHNB ')
-#endif
-
-
- K = LOCF (LIX(1)) - LQSTOR
-
- IF (K.LT.LQSTA(KQT+1)) RETURN
- IF (K.GE.LQEND(KQT+20)) RETURN
-
-#include "zebra/qtrace.inc"
-
- NQCASE = 1
- NQFATA = 2
- IQUEST(11) = K
- IQUEST(12) = LIX(1)
-#include "zebra/qtofatal.inc"
- END
diff --git a/src/packlib/zebra/mqs/mzdvac.F b/src/packlib/zebra/mqs/mzdvac.F
deleted file mode 100644
index 4e468a3..0000000
--- a/src/packlib/zebra/mqs/mzdvac.F
+++ /dev/null
@@ -1,98 +0,0 @@
-*
-* $Id: mzdvac.F,v 1.3 1999/06/18 13:30:43 couet Exp $
-*
-* $Log: mzdvac.F,v $
-* Revision 1.3 1999/06/18 13:30:43 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.2 1996/04/18 16:13:00 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:21 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- FUNCTION MZDVAC (IXDIVP)
-
-C- collect and return bits of divisions requested by IXDIVP,
-C- system called
-
-#include "zebra/zstate.inc"
-#include "zebra/zunit.inc"
-#include "zebra/mqsys.inc"
-*
- DIMENSION IXDIVP(9)
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HMZDV, 4HAC /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HMZDVAC /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'MZDVAC ')
-#endif
-
-#include "zebra/q_jbyt.inc"
-#include "zebra/q_sbit1.inc"
-#include "zebra/q_jbytet.inc"
-
-
- IXIN = IXDIVP(1)
-
-#include "zebra/qtrace.inc"
-
- JST = JBYT (IXIN,27,6)
- IF (JST.EQ.JQSTOR) GO TO 31
- IF (JST-16.EQ.JQSTOR) GO TO 21
- CALL MZSDIV (IXIN,-7)
- IF (JST.LT.16) GO TO 31
-
-C-- COMPOSITE INDEX
-
- 21 IXAC = JBYT (IXIN,1,20)
- IXGE = JBYT (IXIN,21,6)
- IF (IXGE.EQ.0) GO TO 59
- IF (IXGE.LT.16) GO TO 41
-
-C-- ERROR TERMINATION
-
- 29 CALL MZSDIV (IXIN,0)
-
-C-- SINGLE DIVISION INDEX
-
- 31 JDIV = JBYT (IXIN,1,26)
- IF (JDIV.GE.25) GO TO 29
- IXAC = 0
- IF (JDIV.GE.21) GO TO 33
- IXAC = MSBIT1 (IXAC,JDIV)
- GO TO 59
-
- 33 IXGE = MSBIT1 (0, JDIV-20)
-
-C---- COLLECT BITS FOR GENERIC INDEX
-
- 41 JDIV = 1
- 42 IF (JDIV.EQ.JQDVLL+1) JDIV=JQDVSY
- IF (JBYTET(IXGE,IQKIND(KQT+JDIV),21,4).EQ.0) GO TO 47
- IXAC = MSBIT1 (IXAC,JDIV)
- 47 JDIV = JDIV + 1
- IF (JDIV.LT.21) GO TO 42
-
- 59 MZDVAC = IXAC
-#if defined(CERNLIB_QDEVZE)
- IF (NQDEVZ.LT.11) GO TO 999
- WRITE (IQLOG,9859) IXIN, IXAC
-#endif
-#if (defined(CERNLIB_QDEVZE))&&(defined(CERNLIB_HEX))
- 9859 FORMAT (1X/' DEVZE MZDVAC, IXDIVP,MZDVAC=',2(2X,Z8))
-#endif
-#if (defined(CERNLIB_QDEVZE))&&(!defined(CERNLIB_HEX))
- 9859 FORMAT (1X/' DEVZE MZDVAC, IXDIVP,MZDVAC=',2(2X,O11))
-#endif
-#include "zebra/qtrace99.inc"
- RETURN
- END
diff --git a/src/packlib/zebra/mqs/mzfdiv.F b/src/packlib/zebra/mqs/mzfdiv.F
deleted file mode 100644
index 815e3dd..0000000
--- a/src/packlib/zebra/mqs/mzfdiv.F
+++ /dev/null
@@ -1,58 +0,0 @@
-*
-* $Id: mzfdiv.F,v 1.3 1999/06/18 13:30:43 couet Exp $
-*
-* $Log: mzfdiv.F,v $
-* Revision 1.3 1999/06/18 13:30:43 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.2 1996/04/18 16:13:01 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:22 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- FUNCTION MZFDIV (IXST,LIXP)
-
-C- Find the division into which LIX points, in the current store;
-C- return its number, not pointing into any : return zero
-
-#include "zebra/mqsys.inc"
-*
- DIMENSION IXST(9), LIXP(9)
-
-#include "zebra/q_jbyt.inc"
-
- IXSTOR = IXST(1)
- LIX = LIXP(1)
- IF (IXSTOR.NE.-7) THEN
-#include "zebra/qstore.inc"
- JDIVI = 2
- ELSE
- JDIVI = JQDIVI
- ENDIF
-
- IF (JDIVI.EQ.0) GO TO 21
-
- IF (LIX.LT.LQSTA(KQT+JDIVI)) GO TO 21
- IF (LIX.LT.LQEND(KQT+JDIVI)) GO TO 99
-
-C-- Find division
-
- 21 JDIVI = 1
- IF (LIX.LT.LQEND(KQT+JQDVLL)) GO TO 24
- IF (LIX.GE.LQEND(KQT+20)) GO TO 91
- JDIVI = JQDVSY
-
- 24 IF (LIX.LT.LQEND(KQT+JDIVI)) GO TO 26
- JDIVI = JDIVI + 1
- GO TO 24
-
- 26 IF (LIX.GE.LQSTA(KQT+JDIVI)) GO TO 99
-
- 91 JDIVI = 0
- 99 MZFDIV = JDIVI
- RETURN
- END
diff --git a/src/packlib/zebra/mqs/mzform.F b/src/packlib/zebra/mqs/mzform.F
deleted file mode 100644
index c7d9759..0000000
--- a/src/packlib/zebra/mqs/mzform.F
+++ /dev/null
@@ -1,126 +0,0 @@
-*
-* $Id: mzform.F,v 1.2 1999/06/18 13:30:44 couet Exp $
-*
-* $Log: mzform.F,v $
-* Revision 1.2 1999/06/18 13:30:44 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:21 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE MZFORM (CHID,CHFORM,IXIOP)
-
-C- Analyse I/O descriptor, user called
-C- save resulting I/O characteristic tagged by CHID,
-C- return in IXIOP the index to the characteristic
-
-#include "zebra/zvfaut.inc"
-#include "zebra/zkrakc.inc"
-#include "zebra/mqsys.inc"
-#include "zebra/eqlqform.inc"
-*
- EQUIVALENCE (NW,IQUEST(1))
-
- DIMENSION IXIOP(99)
- CHARACTER CHID*(*), CHFORM*(*)
- DIMENSION MMID(5), MMIX(5), MMIO(5)
-
-#if defined(CERNLIB_QMVDS)
- SAVE MMID, MMIX, MMIO
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HMZFO, 4HRM /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HMZFORM /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'MZFORM ')
-#endif
-#if defined(CERNLIB_QHOLL)
- DATA MMID / 4HQID , 2, 2, 10, 5 /
- DATA MMIX / 4HQIOX, 0, 0, 7, 2 /
- DATA MMIO / 4HQIOD, 0, 0, 50, 1 /
-#endif
-#if !defined(CERNLIB_QHOLL)
- DATA MMID / 0, 2, 2, 10, 5 /
- DATA MMIX / 0, 0, 0, 7, 2 /
- DATA MMIO / 0, 0, 0, 50, 1 /
-#endif
-
-#include "zebra/q_sbyt.inc"
-
-#include "zebra/qtrace.inc"
-#if defined(CERNLIB_QDEBUG)
- IF (IQVSTA.NE.0) CALL ZVAUTX
-#endif
-
- N = MIN (4, LEN(CHID))
- CALL UCTOH (CHID,IDH,4,N)
- IF (LQFORM.EQ.0) GO TO 75
-
- 12 IQCETK(121) = IDH
- LIOD = LQ(KQSP+LQFORM-2)
- IXIOD = IQ(KQSP+LIOD+1)
- CALL MZIOCH (IQ(KQSP+LIOD+IXIOD+1),16,CHFORM)
- NW = NW + 1
- NWIO = IXIOD + NW
- IQ(KQSP+LIOD+1) = NWIO
- NFRIO = IQ(KQSP+LIOD-1) - NWIO
-
- LID = LQFORM
- IF (IDH.LT.0) LID=LQ(KQSP+LID)
- LIX = LQ(KQSP+LID-1)
-
- NWID = IQ(KQSP+LID+1) + 1
- IQ(KQSP+LID+1) = NWID
- IQ(KQSP+LID+NWID+3) = IDH
- IQ(KQSP+LIX+NWID) = IXIOD
- NFRID = IQ(KQSP+LID-1) - NWID - 3
-
- IQUEST(2) = 64*NW + 2
- IQUEST(2) = MSBYT (IXIOD,IQUEST(2),17,15)
- IXIOP(1) = IQUEST(2)
- IF (NFRID.EQ.0) GO TO 71
- 28 IF (NFRIO.LT.16) GO TO 73
- 29 CONTINUE
-#include "zebra/qtrace99.inc"
- RETURN
-
-C------ MAKE ROOM IN THE CONTROL BANKS
-
-C-- INCREASE ID/IX BANKS
-
- 71 CALL MZPUSH (JQPDVS,LID,0,20,'I')
- LIX = LQ(KQSP+LID-1)
- CALL MZPUSH (JQPDVS,LIX,0,20,'I')
- GO TO 28
-
-C-- INCREASE IOD BANK
-
- 73 LIOD = LQ(KQSP+LQFORM-2)
- CALL MZPUSH (JQPDVS,LIOD,0,60,'I')
- GO TO 29
-
-C-- CREATE I/O DESCRIPTOR DATA STRUCTURE
-
- 75 CONTINUE
-#if !defined(CERNLIB_QHOLL)
- CALL UCTOH ('QID ', MMID, 4,4)
- CALL UCTOH ('QIOX', MMIX, 4,4)
- CALL UCTOH ('QIOD', MMIO, 4,4)
-#endif
- DO 76 J=1,2
- CALL MZLIFT (JQPDVS,L,LQFORM,1,MMID,0)
- CALL MZLIFT (JQPDVS,LIX,L,-1,MMIX,0)
- 76 CONTINUE
-
- CALL MZLIFT (JQPDVS,L,LQFORM,-2,MMIO,0)
- IQ(KQSP+L+1) = 1
- GO TO 12
- END
diff --git a/src/packlib/zebra/mqs/mziobk.F b/src/packlib/zebra/mqs/mziobk.F
deleted file mode 100644
index 7d0c149..0000000
--- a/src/packlib/zebra/mqs/mziobk.F
+++ /dev/null
@@ -1,30 +0,0 @@
-*
-* $Id: mziobk.F,v 1.2 1999/06/18 13:30:44 couet Exp $
-*
-* $Log: mziobk.F,v $
-* Revision 1.2 1999/06/18 13:30:44 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:21 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE MZIOBK (MMBK,NWBK,CHFORM)
-
-C- Analyse I/O descriptor, user called
-C- store the resulting I/O characteristic into the user's
-C- bank description vector MMBK of length NWBK, starting at word 5
-
-#include "zebra/zkrakc.inc"
-*
- DIMENSION MMBK(99), NWBK(9)
- CHARACTER CHFORM*(*)
-
-
- NW = NWBK(1) - 4
- IQCETK(121) = MMBK(1)
- CALL MZIOCH (MMBK(5),NW,CHFORM)
- RETURN
- END
diff --git a/src/packlib/zebra/mqs/mziocf.F b/src/packlib/zebra/mqs/mziocf.F
deleted file mode 100644
index d9e2867..0000000
--- a/src/packlib/zebra/mqs/mziocf.F
+++ /dev/null
@@ -1,42 +0,0 @@
-*
-* $Id: mziocf.F,v 1.2 1999/06/18 13:30:45 couet Exp $
-*
-* $Log: mziocf.F,v $
-* Revision 1.2 1999/06/18 13:30:45 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:21 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE MZIOCF (JUP,MXVAL)
-
-C- Find largest possible size of next group, slave to MZIOCH
-
-#include "zebra/zkrakc.inc"
-#include "zebra/quest.inc"
-*
- DIMENSION MU(99)
- EQUIVALENCE (MU(1),IQHOLK(1))
-
- EQUIVALENCE (NGR,IQUEST(1)), (NGRU,IQUEST(2))
-
- DIMENSION JUP(9), MXVAL(9)
-
-
- JU = JUP(1)
- MXC = MU(JU+2)
-
- DO 24 JL=2,NGR
- JU = JU + 2
- MXC = MAX (MU(JU+2),MXC)
- IF (MXC.GE.MXVAL(JL)) GO TO 29
- 24 CONTINUE
- NGRU = NGR
- RETURN
-
- 29 NGRU = JL - 1
- RETURN
- END
diff --git a/src/packlib/zebra/mqs/mzioch.F b/src/packlib/zebra/mqs/mzioch.F
deleted file mode 100644
index 260a9b9..0000000
--- a/src/packlib/zebra/mqs/mzioch.F
+++ /dev/null
@@ -1,457 +0,0 @@
-*
-* $Id: mzioch.F,v 1.3 1999/06/18 13:30:46 couet Exp $
-*
-* $Log: mzioch.F,v $
-* Revision 1.3 1999/06/18 13:30:46 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.2 1996/04/18 16:13:03 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:21 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE MZIOCH (IODVEC,NWIOMP,CHFORM)
-
-C- Analyse I/O descriptor, user called, also from MZFORM / MZIOBK
-C- convert the descriptor CHFORM into the I/O characteristic
-C- stored into IODVEC of length NWIOMX
-
-#include "zebra/zkrakc.inc"
-#include "zebra/zstate.inc"
-#include "zebra/zunit.inc"
-#include "zebra/quest.inc"
-#include "zebra/mzca.inc"
-#include "zebra/zbcd.inc"
-*
- DIMENSION IODVEC(99), NWIOMP(9)
- CHARACTER CHFORM*(*)
-
- EQUIVALENCE (NGR,IQUEST(1)), (NGRU,IQUEST(2))
-
- DIMENSION MU(99), MCE(99)
- EQUIVALENCE (MU(1),IQHOLK(1)), (MCE(1),IQCETK(1))
-
- DIMENSION NBITVA(4), NBITVB(4), NBITVC(7)
- DIMENSION MXVALA(4), MXVALB(4), MXVALC(7)
-
- DIMENSION ITAB(48), INV(10)
-
-#if defined(CERNLIB_QMVDS)
- SAVE NBITVA, NBITVB, NBITVC
- SAVE MXVALA, MXVALB, MXVALC
- SAVE ITAB, INV
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HMZIO, 4HCH /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HMZIOCH /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'MZIOCH ')
-#endif
-
-C- A B C D E F G H I J K L M
-C- N O P Q R S T U V W X Y Z
-C- 0 1 2 3 4 5 6 7 8 9 + - *
-C- / ( ) $ = b , .
- DATA ITAB / 47
- +, -1, 12, -1, 15, -1, 14, -1, 16, 13, -1, -1, -1, -1
- +, -1, -1, -1, -1, -1, 18, -1, -1, -1, -1, -1, -1, -1
- +, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, -1, 11, 10
- +, 19, -1, -1, -1, -1, -2, -2, -2 /
-
- DATA INV / 39, 38, 2, 9, 6, 4, 8, 24, 19, 40 /
-C- * - B I F D H X S /
-
- DATA NBITVA / 32, 16, 10, 8 /
- DATA NBITVB / 29, 14, 9, 7 /
- DATA NBITVC / 26, 11, 6, 4, 2, 1, 1 /
- DATA MXVALA / 0, 65536, 1024, 256 /
- DATA MXVALB / 0, 16384, 512, 128 /
- DATA MXVALC / 0, 2048, 64, 16, 4, 2, 2 /
-
-#include "zebra/q_sbit1.inc"
-#include "zebra/q_sbyt.inc"
-
-#include "zebra/qtrace.inc"
-
- NWIOMX = NWIOMP(1)
- NCH = LEN (CHFORM)
- IF (NCH.GE.121) GO TO 90
- CALL UCTOH1 (CHFORM,IQHOLK,NCH)
-
- CALL IZBCDT (NCH,ITAB)
- NCH = IQUEST(1)
- IF (IQUEST(2).NE.0) GO TO 91
- IF (IQUEST(1).EQ.0) GO TO 91
-
-C-------- SCAN CHARACTER BY CHARACTER
-
-C- NUMERIC 0 ... 9 10 11 12 13 14 15 16 17 18 19
-C- FOR 0 ... 9 * - B I F D H S /
-
- JPOSR = -1
- JPOSIN = -1
- IVAL = 0
- JCH = 0
- JU = 0
- 21 NVAL = 0
- 22 JCH = JCH + 1
- NUM = MCE(JCH)
- IF (NUM.GE.10) GO TO 24
-
-C-- NUMERIC
-
- NVAL = 10*NVAL + NUM
- IF (JCH.LT.NCH) GO TO 22
- GO TO 92
-
-C-- COUNT = * OR -
-
- 24 IF (NUM.GE.12) GO TO 26
- IF (NVAL.NE.0) GO TO 92
- IF (NUM.EQ.11) THEN
- NVAL = -1
- JPOSIN = JU
- IF (JPOSR.GE.0) GO TO 93
- ENDIF
- IF (JCH.EQ.NCH) GO TO 92
- JCH = JCH + 1
- NUM = MCE(JCH)
- IF (NUM.LT.12) GO TO 92
- IF (NUM.GE.19) GO TO 92
- GO TO 27
-
-C-- TYPE LETTER
-
- 26 IF (NUM.EQ.19) GO TO 29
- IF (NUM.EQ.18) GO TO 92
- IF (NVAL.EQ.0) GO TO 92
- IF (NUM.EQ.15) THEN
- IF (NVAL.NE.2*(NVAL/2)) GO TO 92
- ENDIF
- IVAL = 7
- 27 MU(JU+1) = NUM - 11
- MU(JU+2) = NVAL
- JU = JU + 2
- IF (JCH.EQ.NCH) GO TO 31
- IF (JPOSIN.LT.0) GO TO 21
- GO TO 94
-
-C-- REPEAT MARK
-
- 29 IF (NVAL.NE.0) GO TO 92
- IF (JPOSR.GE.0) GO TO 95
- IF (JCH.EQ.NCH) GO TO 92
- JPOSR = JU
- GO TO 21
-
-C-------- NO TRAILING REGIONS
-
- 31 NU = JU
- NSECA = NU/2
- JU = 2
- IOWD = 65
- NWIO = 0
- JFL12 = 1
- IF (JPOSR.GE.0) THEN
- IF (JPOSR+2.NE.NU) GO TO 41
- IF (MU(NU-1).NE.7) GO TO 41
-C- continue if 'CT ... CT / *S'
- ELSE
- IF (MU(NU).EQ.0) JFL12=2
- ENDIF
-
-C-- FORMATS TO BE HANDLED IN CLASSES 1 AND 2 (OR 0)
-C- JFL12 = 2 : '... *T'
-C- 1 : '... -T'
-C- '... NT' AS '... -T'
-C- '... / *S' AS '... -S'
-C- '/ NT' AS '-T'
-
- 32 NSECA = NSECA - 1
-
-C---- CLASS 0 : '-T' OR '*T'
-
- IQUEST(12) = MU(NU-1)
- IF (NSECA.EQ.0) THEN
- IF (JFL12.EQ.1) GO TO 82
- IQUEST(12) = MSBIT1 (IQUEST(12),4)
- GO TO 82
- ENDIF
-
-C---- CLASS 0 : 'CT -T' OR 'CT *T'
-
- IF (NSECA.GE.2) GO TO 33
- IF (MU(2).GE.64) GO TO 34
- IF (JFL12.EQ.2) IQUEST(12)= MSBIT1(IQUEST(12),4)
- IQUEST(12) = MSBYT (MU(1),IQUEST(12),5,3)
- IQUEST(12) = MSBYT (MU(2),IQUEST(12),8,6)
- GO TO 82
-
-C---- CLASS 1 : 'CT CT CT -T'
-C- CLASS 2 : 'CT CT CT *T'
-
- 33 IF (IVAL+NSECA.EQ.2) GO TO 38
- 34 IQUEST(12) = MSBYT (JFL12,IQUEST(12),14,2)
- IQUEST(12) = MSBYT (MU(1),IQUEST(12),5,3)
- IQUEST(13) = MU(2)
- JBTF = 8
- IF (NSECA.GE.4) GO TO 36
- IOWD = 2177
- NWIO = 1
- IF (NSECA.EQ.1) GO TO 82
-
- NGR = NSECA
- CALL MZIOCF (0,MXVALA)
- IF (NGR.NE.NGRU) GO TO 36
- NBT = NBITVA(NGRU)
- GO TO 71
-
-C---- CLASS 1 : 'CT ... CT -T'
-C- CLASS 2 : 'CT ... CT *T'
-
- 36 IQUEST(12) = MSBIT1 (IQUEST(12),4)
- NGR = MIN (NSECA,3)
- CALL MZIOCF (0,MXVALB)
- NBT = NBITVB(NGRU)
- GO TO 70
-
-C---- CLASS 1 : '*T *T -T'
-C- CLASS 2 : '*T *T *T'
-
- 38 IQUEST(12) = 16*IQUEST(12)
- IQUEST(12) = MSBYT (MU(1),IQUEST(12), 8,3)
- IQUEST(12) = MSBYT (MU(3),IQUEST(12),11,3)
- IQUEST(12) = MSBYT (JFL12,IQUEST(12),14,2)
- GO TO 82
-
-C-------- WITH TRAILING REGIONS
-
- 41 NSECL = JPOSR/2
- IF (NSECA.GE.3) GO TO 44
-
-C---- CLASS 3 : '/ *T'
-
- IQUEST(12) = MU(NU-1)
- IQUEST(12) = MSBYT (3,IQUEST(12),14,2)
- IF (NSECA.EQ.2) GO TO 42
- IF (MU(2).EQ.0) GO TO 82
- GO TO 32
-
-C---- CLASS 3 : 'CT / *T' OR '/ CT *T'
-
- 42 IF (MU(4).NE.0) GO TO 44
- IF (MU(2).GE.64) GO TO 44
- IQUEST(12) = MSBYT (MU(1),IQUEST(12),5,3)
- IQUEST(12) = MSBYT (MU(2),IQUEST(12),8,6)
- IF (NSECL.EQ.1) GO TO 82
- IQUEST(12) = MSBIT1 (IQUEST(12),4)
- GO TO 82
-
-C---- CLASS 4 : 'CT / CT CT CT' OR 'CT CT / CT CT'
-
- 44 IF (NSECL.EQ.0) GO TO 51
- IF (NSECL.GE.3) GO TO 61
- IF (NSECA.GE.5) GO TO 61
- IF (IVAL+NSECA.EQ.3) GO TO 48
-
- NGR = NSECA
- CALL MZIOCF (0,MXVALA)
- IF (NGR.NE.NGRU) GO TO 61
-
- IQUEST(12) = MU(1)
- IQUEST(13) = MU(2)
- IF (NSECL.EQ.2) IQUEST(12)=IQUEST(12)+8
- IQUEST(12) = MSBIT1 (IQUEST(12),16)
-
- JBTF = 5
- NBT = NBITVA(NGRU)
- IOWD = 2177
- NWIO = 1
- GO TO 71
-
-C---- CLASS 4 : '*T / *T *T' OR '*T *T / *T'
-
- 48 IQUEST(12) = 8*(2*MU(1)+NSECL-1)
- IQUEST(12) = MSBYT (MU(3),IQUEST(12), 8,3)
- IQUEST(12) = MSBYT (MU(5),IQUEST(12),11,3)
- IQUEST(12) = MSBIT1 (IQUEST(12),16)
- GO TO 82
-
-C-------- NO LEADING REGIONS
-
-C---- CLASS 5 : '/ CT CT CT CT'
-
- 51 IF (IVAL+NSECA.EQ.3) GO TO 58
- IQUEST(12) = MU(1)
- IQUEST(13) = MU(2)
- IQUEST(12) = MSBYT (5,IQUEST(12),14,3)
- JBTF = 5
- IF (NSECA.GE.5) GO TO 55
-
- NGR = NSECA
- CALL MZIOCF (0,MXVALA)
- IF (NGR.NE.NGRU) GO TO 55
- NBT = NBITVA(NGRU)
- IOWD = 2177
- NWIO = 1
- GO TO 71
-
-C---- CLASS 5 : '/ CT ... CT'
-
- 55 IQUEST(12) = MSBIT1 (IQUEST(12),4)
- NGR = MIN (NSECA,4)
- CALL MZIOCF (0,MXVALB)
- NBT = NBITVB(NGRU)
- GO TO 70
-
-C---- CLASS 5 : '/ *T *T *T'
-
- 58 IQUEST(12) = 16*MU(1)
- IQUEST(12) = MSBYT (MU(3),IQUEST(12), 8,3)
- IQUEST(12) = MSBYT (MU(5),IQUEST(12),11,3)
- IQUEST(12) = MSBYT (5,IQUEST(12),14,3)
- GO TO 82
-
-C-------- CLASS 6 : 'CT ... CT / CT ... CT'
-
- 61 IQUEST(12) = NSECL
- IQUEST(13) = MU(2)
- IF (NSECL.GE.16) GO TO 96
- IQUEST(12) = MSBYT (MU(1),IQUEST(12),5,3)
- IQUEST(12) = MSBYT (6,IQUEST(12),14,3)
-
- JBTF = 8
- NGR = 3
- CALL MZIOCF (0,MXVALB)
- NBT = NBITVB(NGRU)
-
-C------ LONG PACKING
-
-C-- PACK FIRST I/O WORD
-
- 70 IF (NGRU.EQ.1) GO TO 73
-
- 71 JBTC = 1
- DO 72 JL=2,NGRU
- IQUEST(12) = MSBYT (MU(JU+1),IQUEST(12),JBTF,3)
- JBTF = JBTF + 3
- JBTC = JBTC + NBT
- IQUEST(13) = MSBYT (MU(JU+2),IQUEST(13),JBTC,NBT)
- 72 JU = JU + 2
-
- IF (NGRU.EQ.NSECA) GO TO 82
- 73 NSECD = NGRU
- JWIO = 13
-
-C---- PACK NEXT I/O WORD
-
- 74 JWIO = JWIO + 1
- IQUEST(JWIO) = MU(JU+1)
- JBT = 4
- NGRU = 1
- NGR = MIN (7,NSECA-NSECD)
- IF (NGR.EQ.1) GO TO 77
-
- CALL MZIOCF (JU,MXVALC)
- IF (NGRU.EQ.1) GO TO 77
- JUST = JU
- DO 76 JL=2,NGRU
- JU = JU + 2
- IQUEST(JWIO) = MSBYT (MU(JU+1),IQUEST(JWIO),JBT,3)
- 76 JBT = JBT + 3
- JU = JUST
-
- 77 IQUEST(JWIO-1) = MSBYT (NGRU,IQUEST(JWIO-1),30,3)
- NBT = NBITVC(NGRU)
-
- DO 79 JL=1,NGRU
- IQUEST(JWIO) = MSBYT (MU(JU+2),IQUEST(JWIO),JBT,NBT)
- JBT = JBT + NBT
- 79 JU = JU + 2
-
- NSECD = NSECD + NGRU
- IF (NSECD.LT.NSECA) GO TO 74
- NWIO = JWIO - 12
-
- IF (NWIO.GE.NWIOMX) GO TO 97
- IF (NWIO.GE.16) GO TO 97
- IOWD = 64*(32*NWIO+NWIO+1) + 1
-
- 82 IOWD = MSBYT (IQUEST(12),IOWD,17,16)
- IQUEST(12) = IOWD
- IQUEST(1) = NWIO
-
- CALL UCOPY (IQUEST(12),IODVEC,NWIO+1)
- IQCETK(121) = IQBLAN
-#if defined(CERNLIB_QDEBPRI)
- IF (NQLOGM.GE.1) WRITE (IQLOG,9088) NWIO,CHFORM
- 9088 FORMAT (' MZIOCH-',I5,' extra I/O words for Format ',A)
-#endif
-#include "zebra/qtrace99.inc"
- RETURN
-
-C------ ERROR CONDITIONS
-
-C-- CHARACTER STRING TOO LONG
- 90 NQFATA = 2
- IQUEST(12) = NCH
- GO TO 99
-
-C-- STRING INVALID
- 91 NQCASE = 1
- NQFATA = 3
- IQUEST(12) = IQUEST(1)
- IQUEST(13) = IQUEST(2)
- IF (IQUEST(1).EQ.0) GO TO 99
- GO TO 98
-
-C-- I/O DESCRIPTOR TOO LONG
- 97 NQCASE = 7
- IQUEST(12) = NWIOMX
- IQUEST(13) = NWIO + 1
- GO TO 98
-
-C-- TOO MANY SECTORS
- 96 NQCASE = 6
- IQUEST(12) = NSECA
- IQUEST(13) = NSECL
- GO TO 98
-
-C-- / OCCURS TWICE
- 95 NQCASE = 1
-
-C-- -T NOT LAST SECTOR IN THE STRING
- 94 NQCASE = NQCASE + 1
-
-C-- -T NOT ALLOWED IN REPEAT
- 93 NQCASE = NQCASE + 1
-
-C-- BAD SYNTAX
- 92 NQCASE = NQCASE + 2
- IQUEST(12) = JCH
- IQUEST(13) = 0
-
- 98 DO 88 JCH=1,NCH
- JCET = MCE(JCH)
- IF (JCET.LT.10) THEN
- MCE(JCH)=IQNUM(JCET+1)
- ELSE
- JCET = INV(JCET-9)
- MCE(JCH) = IQLETT(JCET)
- ENDIF
- 88 CONTINUE
- CALL UTRANS (MCE,IQUEST(14),NCH,1,4)
- NQFATA = (NCH-1)/4 + 4
-
- 99 IQUEST(11) = IQCETK(121)
-#include "zebra/qtofatal.inc"
- END
diff --git a/src/packlib/zebra/mqs/mziocr.F b/src/packlib/zebra/mqs/mziocr.F
deleted file mode 100644
index 9690d51..0000000
--- a/src/packlib/zebra/mqs/mziocr.F
+++ /dev/null
@@ -1,196 +0,0 @@
-*
-* $Id: mziocr.F,v 1.3 1999/06/18 13:30:46 couet Exp $
-*
-* $Log: mziocr.F,v $
-* Revision 1.3 1999/06/18 13:30:46 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.2 1996/04/18 16:13:05 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:22 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE MZIOCR (IOW)
-
-C- Crack I/O characteristic ready for use, system called
-
-#include "zebra/quest.inc"
-#include "zebra/mzioc.inc"
-*
- EQUIVALENCE (JIO,IQUEST(1))
- DIMENSION IOW(9)
- DIMENSION NBITVA(4), NBITVB(4), NBITVC(7)
-#if defined(CERNLIB_QMVDS)
- SAVE NBITVA, NBITVB, NBITVC
-#endif
- DATA NBITVA / 32, 16, 10, 8 /
- DATA NBITVB / 29, 14, 9, 7 /
- DATA NBITVC / 26, 11, 6, 4, 2, 1, 1 /
-
-#include "zebra/q_jbit.inc"
-#include "zebra/q_jbyt.inc"
-
-
- NWFODN = 0
- JFOCUR = 0
-
- JTYPR = IOW(1)
- IOW1 = JBYT (JTYPR,17,16)
-
-C-- IMMEDIATE CHARACTERISTIC
-
- IF (IOW1.NE.0) GO TO 21
- IF (JTYPR.GE.8) GO TO 21
- MFO(1) = JTYPR
- MFO(2) = -1
- JFOEND = 2
- JFOREP = 2
- RETURN
-
-C---- GENERAL
-
- 21 JFOEND = 0
- JFOREP = 0
- JIO = 1
- JTYPR = JBYT (IOW1,1,3)
- JFLAG = JBIT (IOW1,4)
- JCLASS = JBYT (IOW1,14,3)
- JFL12 = 0
-
- GO TO ( 101, 201, 301, 401, 501, 601, 991), JCLASS
-
-C-- CLASS 0 : 'CT -T'
-
- JFL12 = JFLAG + 1
- JTYP = JBYT (IOW1,5,3)
- IF (JTYP.NE.0) THEN
- MFO(1) = JTYP
- MFO(2) = JBYT (IOW1,8,6)
- JFOEND = 2
- ENDIF
-
- 24 IF (JTYPR.EQ.7) GO TO 28
- MFO(JFOEND+1) = JTYPR
- MFO(JFOEND+2) = JFL12 - 2
- JFOEND = JFOEND + 2
- JFOREP = JFOEND
- RETURN
-
- 28 JFOREP = JFOEND
- MFO(JFOEND+1) = 7
- MFO(JFOEND+2) = 0
- JFOEND = JFOEND + 2
- RETURN
-
-C-- CLASS 1 OR 2 : 'CT ... CT -T' OR 'CT ... CT *CT'
-
- 101 CONTINUE
- 201 JFL12 = JCLASS
- IF (JTYPR.NE.0) GO TO 821
- JTYPR = JBYT (IOW1,5,3)
- JBT = 8
- GO TO 831
-
-C-- CLASS 3 : 'CT / *T' OR '/ CT *T'
-
- 301 JTYP = JBYT (IOW1,5,3)
- IF (JTYP.NE.0) THEN
- MFO(1) = JTYP
- MFO(2) = JBYT (IOW1,8,6)
- JFOEND = 2
- IF (JFLAG.EQ.0) JFOREP = 2
- ENDIF
-
- MFO(JFOEND+1) = JTYPR
- MFO(JFOEND+2) = 0
- JFOEND = JFOEND + 2
- RETURN
-
-C-- CLASS 4 : 'CT / CT CT CT' OR 'CT CT / CT CT'
-
- 401 JFOREP = 2*(JFLAG+1)
- JFLAG = 0
-
-C-- CLASS 5 : '/ CT ... CT'
-
- 501 IF (JTYPR.EQ.0) GO TO 830
- MFO(1) = JTYPR
- JFOEND = 2
- GO TO 821
-
-C-- CLASS 6 : 'CT ... CT / CT ... CT'
-
- 601 JFOREP = 2*JBYT(IOW1,1,4)
- JFLAG = 1
-
-C---- COMMON UNPACKING FOR CLASSES 1, 2, 4, 5, 6
-
- 821 JIO = 2
- DO 822 JBT=5,11,3
- JTYP = JBYT (IOW1,JBT,3)
- IF (JTYP.EQ.0) GO TO 823
- MFO(JFOEND+1) = JTYP
- 822 JFOEND = JFOEND + 2
- 823 NGRU = JFOEND/2
-
-C-- UNPACK I/O WORD 2
-
- IF (JFLAG.EQ.0) THEN
- NBT = NBITVA(NGRU)
- ELSE
- NBT = NBITVB(NGRU)
- ENDIF
-
- JFOEND = 0
- JBT = 1
- IOWN = IOW(2)
- DO 824 JL=1,NGRU
- MFO(JFOEND+2) = JBYT(IOWN,JBT,NBT)
- JFOEND = JFOEND + 2
- 824 JBT = JBT + NBT
- IF (JFLAG.EQ.0) GO TO 839
-
-C-- UNPACK I/O WORDS 3, 4, ...
-
- 825 NGRU = JBYT(IOWN,30,3)
- IF (NGRU.EQ.0) GO TO 839
- JIO = JIO + 1
- IF (JIO.EQ.17) GO TO 991
- IOWN = IOW(JIO)
- JBTT = 1
- JBTC = 3*NGRU + 1
- NBT = NBITVC(NGRU)
-
- DO 826 JL=1,NGRU
- MFO(JFOEND+1) = JBYT (IOWN,JBTT,3)
- MFO(JFOEND+2) = JBYT (IOWN,JBTC,NBT)
- JBTT = JBTT + 3
- JBTC = JBTC + NBT
- 826 JFOEND = JFOEND + 2
- GO TO 825
-
-C---- SUB-CLASSES ZERO
-
- 830 JBT = 5
- 831 DO 834 JL=JBT,11,3
- JTYP = JBYT (IOW1,JL,3)
- IF (JTYP.EQ.0) GO TO 839
- MFO(JFOEND+1) = JTYP
- MFO(JFOEND+2) = 0
- 834 JFOEND = JFOEND + 2
-
- 839 IF (JFL12.NE.0) GO TO 24
- RETURN
-
-C------- TROUBLE
-
- 991 IQUEST(1) = -1
- MFO(1) = 0
- MFO(2) = -1
- JFOEND = 2
- RETURN
- END
diff --git a/src/packlib/zebra/mqs/mziotc.F b/src/packlib/zebra/mqs/mziotc.F
deleted file mode 100644
index 8999267..0000000
--- a/src/packlib/zebra/mqs/mziotc.F
+++ /dev/null
@@ -1,115 +0,0 @@
-*
-* $Id: mziotc.F,v 1.2 1999/06/18 13:30:47 couet Exp $
-*
-* $Log: mziotc.F,v $
-* Revision 1.2 1999/06/18 13:30:47 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:22 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE MZIOTC (IXVECT,LBANK,NCHTR,CHTR)
-
-C- Reconstruct CHTR from the I/O decriptor :
-C- CALL MZIOTC (IXSTOR,L, NCHTR*, CHTR*) for bank at L
-C- CALL MZIOTC (IODESC,0, NCHTR*, CHTR*) for descriptor vector
-C- Return :
-C- NCHTR = useful length of CHTR, -ve if trouble
-C- CHTR = the text string
-
-#include "zebra/mqsys.inc"
-#include "zebra/mzcn.inc"
-#include "zebra/mzioc.inc"
-*
- COMMON /SLATE/ NDSLAT,DUMMY(39)
- DIMENSION IXVECT(9)
- CHARACTER CHTR*(*), CHINV*(8)
- DATA CHINV / 'UBIFDHXS' /
-
-
-C---- Crack the I/O desciptor
-
- IF (LBANK.EQ.0) THEN
- CALL MZIOCR (IXVECT)
- ELSE
- CALL MZCHLS (IXVECT,LBANK)
- NT = 0
- IF (IQFOUL.NE.0) GO TO 91
- CALL MZIOCR (LQ(KQS+IQLN))
- ENDIF
-
-C---- Loop to convert cracked to printable
-C-- (mark wanted blanks with !)
-
- NCHMX = LEN(CHTR) - 2
- CHTR = ' '
- JFOCUR = 0
-
- JT = 1
- 21 IF (JFOCUR.EQ.JFOREP) THEN
- CHTR(JT:JT+1) = '/!'
- JT = JT + 2
- ENDIF
-
- JF = MFO(JFOCUR+1)
- JC = MFO(JFOCUR+2)
-
- IF (JC.GT.0) THEN
- NEED = 8
- ELSE
- NEED = 3
- ENDIF
- IF (JT-1+NEED.GT.NCHMX) GO TO 61
-
-C-- Store next sector code
-
- 41 IF (JC) 44, 45, 46
- 44 CHTR(JT:JT) = '-'
- JT = JT + 1
- GO TO 48
-
- 45 CHTR(JT:JT) = '*'
- JT = JT + 1
- GO TO 48
-
- 46 CALL CSETDI (JC,CHTR,JT,JT+5)
- JT = JT + 6
-
- 48 CHTR(JT:JT)= CHINV(JF+1:JF+1)
- CHTR(JT+1:JT+1) = '!'
- JT = JT + 2
-
- JFOCUR = JFOCUR + 2
- IF (JFOCUR.LT.JFOEND) GO TO 21
- NEED = -1
-
-C-- Squeeze unwanted blanks
-
- 61 CALL CLEFT (CHTR,1,JT-1)
- NT = NDSLAT
-
- IF (NEED.GE.0) THEN
- JT = NT + 1
- IF (NT+NEED.LE.NCHMX) GO TO 41
- ENDIF
-
-C-- Change to blank
-
- DO 63 JX=1,NT
- IF (CHTR(JX:JX).EQ.'!') CHTR(JX:JX) = ' '
- 63 CONTINUE
-
- IF (NEED.GE.0) THEN
- CALL CLEFT (CHTR,1,NT)
- NT = NDSLAT
- JT = NT + 1
- IF (NT+NEED.LE.NCHMX) GO TO 41
- NT = 0
- ENDIF
-
- 91 NCHTR = NT
- RETURN
- END
diff --git a/src/packlib/zebra/mqs/mzixco.F b/src/packlib/zebra/mqs/mzixco.F
deleted file mode 100644
index b0e3694..0000000
--- a/src/packlib/zebra/mqs/mzixco.F
+++ /dev/null
@@ -1,104 +0,0 @@
-*
-* $Id: mzixco.F,v 1.3 1999/06/18 13:30:48 couet Exp $
-*
-* $Log: mzixco.F,v $
-* Revision 1.3 1999/06/18 13:30:48 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.2 1996/04/18 16:13:07 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:22 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- FUNCTION MZIXCO (IXAA,IXBB,IXCC,IXDD)
-
-C- join IXAA, IXBB, ... into composite division index
-C- ignore zero, user called
-
-#include "zebra/mqsys.inc"
-*
- DIMENSION IXAA(9), IXBB(9), IXCC(9), IXDD(9), IXV(4)
- EQUIVALENCE (IXV(1),IQUEST(11))
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HMZIX, 4HCO /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HMZIXCO /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'MZIXCO ')
-#endif
-
-#include "zebra/q_jbyt.inc"
-#include "zebra/q_sbit1.inc"
-#include "zebra/q_sbyt.inc"
-#include "zebra/q_mbytor.inc"
-
-
- IXV(1) = IXAA(1)
- IXV(2) = IXBB(1)
- IXV(3) = IXCC(1)
- IXV(4) = IXDD(1)
- IXCOMP = 0
-
- DO 49 JL=1,4
- IXIN = IXV(JL)
- IF (IXIN.EQ.0) GO TO 49
- JDV = JBYT (IXIN,1,26)
- JST = JBYT (IXIN,27,6)
- IF (JST.LT.16) GO TO 31
-
-C-- COMPOSITE INDEX
-
- JST = JST - 16
- IF (JST.GT.NQSTOR) GO TO 91
- IF (JDV.GE.16777216) GO TO 92
- IF (JL.NE.1) GO TO 24
- IXCOMP = IXIN
- JSTORU = JST
- GO TO 49
-
- 24 IF (JST.NE.JSTORU) GO TO 93
- IXCOMP = MBYTOR (JDV,IXCOMP,1,26)
- GO TO 49
-
-C-- SINGLE DIVISION INDEX
-
- 31 IF (JST.GT.NQSTOR) GO TO 91
- IF (JDV.GE.25) GO TO 92
- IF (JDV.EQ.0) GO TO 92
- IF (JL.NE.1) GO TO 34
- IXCOMP = MSBYT (JST+16,IXCOMP,27,5)
- JSTORU = JST
- GO TO 47
-
- 34 IF (JST.EQ.JSTORU) GO TO 47
- IF (JST.NE.0) GO TO 93
- IF (JDV.LT.3) GO TO 47
- IF (JDV.LT.21) GO TO 93
-
- 47 IXCOMP = MSBIT1 (IXCOMP,JDV)
- 49 CONTINUE
-
- 59 MZIXCO = IXCOMP
- RETURN
-
-C------ ERROR CONDITIONS
-
- 93 NQCASE = 1
- 92 NQCASE = NQCASE + 1
- 91 NQCASE = NQCASE + 1
- NQFATA = 7
- IQUEST(15) = JL
- IQUEST(16) = JST
- IQUEST(17) = JDV
-#include "zebra/qtrace.inc"
-#include "zebra/qtofatal.inc"
- MZIXCO = 0
- END
diff --git a/src/packlib/zebra/mqs/mzneig.F b/src/packlib/zebra/mqs/mzneig.F
deleted file mode 100644
index e647508..0000000
--- a/src/packlib/zebra/mqs/mzneig.F
+++ /dev/null
@@ -1,47 +0,0 @@
-*
-* $Id: mzneig.F,v 1.2 1999/06/18 13:30:49 couet Exp $
-*
-* $Log: mzneig.F,v $
-* Revision 1.2 1999/06/18 13:30:49 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:22 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- FUNCTION MZNEIG (JDIV)
-
-C- Find the neighbour to division JDIV :
-C- the division MZNEIG shares the reserve area with JDIV
-
-#include "zebra/mqsys.inc"
-*
-
-
-#include "zebra/q_jbit.inc"
-
- IF (JDIV.GE.3) GO TO 21
- MZNEIG = 3 - JDIV
- RETURN
-
- 21 MODE = JBIT (IQMODE(KQT+JDIV),1)
- NEIG = 1 - 2*MODE
- JN = JDIV + NEIG
- IF (JN.GE.21) GO TO 29
- IF (JN.EQ.JQDVSY-1) GO TO 26
- IF (JN.NE.JQDVLL+1) GO TO 27
- JN = JQDVSY
- GO TO 27
-
- 26 JN = JQDVLL
- 27 IF (JBIT(IQMODE(KQT+JN),1).EQ.MODE) GO TO 29
- MZNEIG = JN
- RETURN
-
-C-- No neighbour
-
- 29 MZNEIG = JDIV
- RETURN
- END
diff --git a/src/packlib/zebra/mqs/mzresv.F b/src/packlib/zebra/mqs/mzresv.F
deleted file mode 100644
index ee1acac..0000000
--- a/src/packlib/zebra/mqs/mzresv.F
+++ /dev/null
@@ -1,91 +0,0 @@
-*
-* $Id: mzresv.F,v 1.3 1999/06/18 13:30:50 couet Exp $
-*
-* $Log: mzresv.F,v $
-* Revision 1.3 1999/06/18 13:30:50 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.2 1996/04/18 16:13:08 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:22 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE MZRESV
-
-C- Calculate free space for current division, system called
-C- setting JQMODE, JQKIND, JQSHAR, NQRESV
-
-#include "zebra/mqsys.inc"
-*
-
-#include "zebra/q_jbit.inc"
-#include "zebra/q_jbyt.inc"
-
-
- JQDIVR = JQDIVI
- IF (JQDIVR.LT.3) GO TO 41
- JQMODE = JBIT (IQMODE(KQT+JQDIVR), 1)
- JQKIND = JBYT (IQKIND(KQT+JQDIVR),21,4)
- IF (JQMODE.NE.0) GO TO 31
-
-C-- FORWARD DIVISION
-
- JQDIVN = JQDIVR + 1
- IF (JQDIVR.EQ.JQDVLL) GO TO 24
- IF (JQDIVR.EQ.20) GO TO 25
-
- IF (JBYT(IQKIND(KQT+JQDIVN),21,4).NE.JQKIND) GO TO 25
- IF (JBIT(IQMODE(KQT+JQDIVN),1) .EQ.JQMODE) GO TO 25
- JQSHAR = JQDIVN
- JQSHR1 = JQDIVR
- JQSHR2 = JQDIVN
- NQRESV = LQSTA(KQT+JQDIVN) - LQEND(KQT+JQDIVR)
- RETURN
-
- 24 JQDIVN = JQDVSY
- 25 L = MIN (LQSTA(KQT+JQDIVR)+NQDMAX(KQT+JQDIVR),
- + LQSTA(KQT+JQDIVN) )
- NQRESV = L - LQEND(KQT+JQDIVR)
- JQSHAR = 0
- RETURN
-
-C-- REVERSE DIVISION
-
- 31 JQDIVN = JQDIVR - 1
- IF (JQDIVR.EQ.JQDVSY) GO TO 34
- IF (JBYT(IQKIND(KQT+JQDIVN),21,4).NE.JQKIND) GO TO 35
- IF (JBIT(IQMODE(KQT+JQDIVN),1) .EQ.JQMODE) GO TO 35
- JQSHAR = JQDIVN
- JQSHR1 = JQDIVN
- JQSHR2 = JQDIVR
- NQRESV = LQSTA(KQT+JQDIVR) - LQEND(KQT+JQDIVN)
- RETURN
-
- 34 JQDIVN = JQDVLL
- 35 L = MAX (LQEND(KQT+JQDIVR)-NQDMAX(KQT+JQDIVR),
- + LQEND(KQT+JQDIVN) )
- NQRESV = LQSTA(KQT+JQDIVR) - L
- JQSHAR = 0
- RETURN
-
-C---- DIVISIONS 2 + 1
-
- 41 JQKIND = 1
- JQSHR1 = 1
- JQSHR2 = 2
- NQRESV = LQSTA(KQT+2) - LQEND(KQT+1) - NQMINR
- IF (JQDIVR.EQ.1) GO TO 44
- JQMODE = 1
- JQDIVN = 1
- JQSHAR = 1
- RETURN
-
- 44 JQMODE = 0
- JQDIVN = 2
- JQSHAR = 2
- RETURN
- END
diff --git a/src/packlib/zebra/mqs/mzsdiv.F b/src/packlib/zebra/mqs/mzsdiv.F
deleted file mode 100644
index 6c32719..0000000
--- a/src/packlib/zebra/mqs/mzsdiv.F
+++ /dev/null
@@ -1,129 +0,0 @@
-*
-* $Id: mzsdiv.F,v 1.3 1999/06/18 13:30:53 couet Exp $
-*
-* $Log: mzsdiv.F,v $
-* Revision 1.3 1999/06/18 13:30:53 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.2 1996/04/18 16:13:09 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:22 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE MZSDIV (IXDIVP,IFLAGP)
-
-C- Set current store JQSTOR and maybe division JQDIVI from IXDIVP
-C- IFLAG = -ve : store only
-C- else : set also JQDIVI:
-C- to the division if a specific single division,
-C- or JQDIVI = 0 if no such given,
-C- with these restrictions:
-C- > 0 : IXDIVP may not be a compound or generic index
-C- = 4 : specific single division required, =0 not allowed
-C- system called, could be user called
-
-#include "zebra/zstate.inc"
-#include "zebra/mqsys.inc"
-*
- DIMENSION IXDIVP(9), IFLAGP(9)
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HMZSD, 4HIV /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HMZSDIV /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'MZSDIV ')
-#endif
-
-#include "zebra/q_jbyt.inc"
-
-
- IXIN = IXDIVP(1)
- IFLAG = IFLAGP(1)
- JSTO = JBYT (IXIN,27,4)
- IF (JSTO.NE.JQSTOR) GO TO 41
- IF (IFLAG.LT.0) GO TO 48
-
- 21 JDIV = JBYT (IXIN,1,26)
-#if defined(CERNLIB_B32)
- JCOM = JBYT (IXIN,31,2)
-#endif
-#if defined(CERNLIB_B36)
- JCOM = JBYT (IXIN,31,6)
-#endif
-#if defined(CERNLIB_B48)
- JCOM = JBYT (IXIN,31,18)
-#endif
-#if defined(CERNLIB_B60)
- JCOM = JBYT (IXIN,31,30)
-#endif
-#if defined(CERNLIB_B64)
- JCOM = JBYT (IXIN,31,34)
-#endif
- IF (JCOM-1) 22, 31, 91
-
-C-- SINGLE DIVISION INDEX
-
- 22 IF (JDIV.GE.25) GO TO 92
- IF (JDIV.GE.21) GO TO 24
- IF (JDIV.GT.JQDVLL) THEN
- IF (JDIV.LT.JQDVSY) GO TO 92
- ENDIF
- IF (JDIV.EQ.0) THEN
- IF (IFLAG.EQ.4) GO TO 94
- ENDIF
- JQDIVI = JDIV
- RETURN
-
- 24 IF (JDIV.EQ.24) GO TO 26
- IF (IFLAG.GT.0) GO TO 93
- JQDIVI = 0
- RETURN
-
- 26 JQDIVI = JQDVSY
- RETURN
-
-C-- COMPOUND INDEX
-
- 31 IF (IFLAG.GT.0) GO TO 93
- IF (JDIV.GE.16777216) GO TO 92
- JQDIVI = 0
- RETURN
-
-C---- SWITCH ZEBRA STORE
-
- 41 IF (JSTO.GT.NQSTOR) GO TO 91
- JQSTOR = JSTO
- JQDIVR = 0
- KQT = NQOFFT(JQSTOR+1)
- KQS = NQOFFS(JQSTOR+1)
-
- DO 44 J=1,12
- 44 IQCUR(J) = IQTABV(KQT+J)
- NQLOGM = NQLOGL
- IF (IFLAG.GE.0) GO TO 21
- 48 JQDIVI = 0
- RETURN
-
-C------ ERROR CONDITIONS
-
- 94 NQCASE = 1
- 93 NQCASE = NQCASE + 1
- 92 NQCASE = NQCASE + 1
- NQFATA = 1
- IQUEST(14) = JDIV
- 91 NQCASE = NQCASE + 1
- NQFATA = NQFATA + 3
- IQUEST(11) = IXIN
- IQUEST(12) = IFLAG
- IQUEST(13) = JSTO
-#include "zebra/qtrace.inc"
-#include "zebra/qtofatal.inc"
- END
diff --git a/src/packlib/zebra/mqs/mzxref.F b/src/packlib/zebra/mqs/mzxref.F
deleted file mode 100644
index c0a2b45..0000000
--- a/src/packlib/zebra/mqs/mzxref.F
+++ /dev/null
@@ -1,117 +0,0 @@
-*
-* $Id: mzxref.F,v 1.3 1999/06/18 13:30:53 couet Exp $
-*
-* $Log: mzxref.F,v $
-* Revision 1.3 1999/06/18 13:30:53 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.2 1996/04/18 16:13:12 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:22 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE MZXREF (IXFRP,IXTOP,CHOPT)
-
-C- Set cross-reference division IXFR pointing to IXTO
-
-#include "zebra/mqsys.inc"
-*
- DIMENSION IXFRP(9), IXTOP(9)
- CHARACTER *(*) CHOPT
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HMZXR, 4HEF /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HMZXREF /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'MZXREF ')
-#endif
-
-#include "zebra/q_jbyt.inc"
-#include "zebra/q_sbit0.inc"
-#include "zebra/q_sbit1.inc"
-
-
- IXFR = IXFRP(1)
- IXTO = IXTOP(1)
-
-#include "zebra/qtrace.inc"
-
- CALL UOPTC (CHOPT,'ARC',IQUEST)
- MODE = IQUEST(1)
- IF (IQUEST(2).NE.0) MODE=-1
- IF (IQUEST(3).NE.0) MODE=-2
-
-C- MODE +1 Add, 0 set, -1 Remove, -2 Contained
-
- CALL MZSDIV (IXFR,0)
- IF (JQDIVI.EQ.0) GO TO 91
- IF (MODE.EQ.-2) GO TO 27
-
- JST = JBYT (IXTO,27,6)
- IF (JST-16.EQ.JQSTOR) GO TO 31
- IF (JST.NE.JQSTOR) GO TO 92
-
-C-- SINGLE DIVISION INDEX
-
- JDV = JBYT (IXTO,1,26)
- IF (JDV.GE.25) GO TO 93
- IF (JDV.EQ.0) GO TO 93
- IQUEST(1) = JDV
- NBI = 1
- GO TO 34
-
-C-- CONTAINED DIVISION
-
- 27 IQRCU(KQT+JQDIVI) = 0
- IQRTO(KQT+JQDIVI) = 0
- IQRNO(KQT+JQDIVI) = 0
- GO TO 999
-
-C-- COMPOSITE INDEX
-
- 31 CALL UBITS (IXTO,26,IQUEST,NBI)
-
- IF (NBI.EQ.0) GO TO 93
- IF (IQUEST(NBI).GE.25) GO TO 93
-
- 34 IF (MODE.NE.0) GO TO 41
- IQRTO(KQT+JQDIVI) = 0
- IQRNO(KQT+JQDIVI) = 9437183
-
- 41 DO 49 JBI=1,NBI
- JDV = IQUEST(JBI)
- IF (MODE.LT.0) GO TO 47
-
-C-- add
- IQRTO(KQT+JQDIVI) = MSBIT1 (IQRTO(KQT+JQDIVI),JDV)
- IF (JDV.GE.21 .AND. JDV.LT.24) GO TO 49
- IQRNO(KQT+JQDIVI) = MSBIT1 (IQRNO(KQT+JQDIVI),JDV)
- GO TO 49
-
-C-- remove
- 47 IQRTO(KQT+JQDIVI) = MSBIT0 (IQRTO(KQT+JQDIVI),JDV)
- IQRNO(KQT+JQDIVI) = MSBIT0 (IQRNO(KQT+JQDIVI),JDV)
- 49 CONTINUE
- CALL MZXRUP
-#include "zebra/qtrace99.inc"
- RETURN
-
-C------ ERROR CONDITIONS
-
- 93 NQCASE = 1
- 92 NQCASE = NQCASE + 1
- 91 NQCASE = NQCASE + 1
- NQFATA = 3
- IQUEST(11) = IXFR
- IQUEST(12) = IXTO
- IQUEST(13) = MODE
-#include "zebra/qtofatal.inc"
- END
diff --git a/src/packlib/zebra/mqs/mzxrpr.F b/src/packlib/zebra/mqs/mzxrpr.F
deleted file mode 100644
index 5b3eba5..0000000
--- a/src/packlib/zebra/mqs/mzxrpr.F
+++ /dev/null
@@ -1,102 +0,0 @@
-*
-* $Id: mzxrpr.F,v 1.2 1999/06/18 13:30:55 couet Exp $
-*
-* $Log: mzxrpr.F,v $
-* Revision 1.2 1999/06/18 13:30:55 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:22 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE MZXRPR (IXSTOR)
-
-C- Print cross-reference table for store IXSTOR
-
-#include "zebra/zunit.inc"
-#include "zebra/mqsys.inc"
-*
- CHARACTER CHWK*24, CHYN(6)*1
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HMZXR, 4HPR /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HMZXRPR /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'MZXRPR ')
-#endif
- DATA CHYN / 'n', 'y', '.', 's', 'u', '.' /
-
-#include "zebra/q_jbit.inc"
-
-#include "zebra/qtrace.inc"
-
- JSTINI = JQSTOR
- JDVINI = JQDIVI
- IF (IXSTOR.EQ.-7) THEN
- IF (JQDIVI.EQ.0) RETURN
- JDV = JQDIVI
- IFLS = 7
- GO TO 22
- ENDIF
-
- IFLS = 0
- CALL MZSDIV (IXSTOR,0)
- MASKDV = MZDVAC (IXSTOR)
- IF (MASKDV.EQ.0) MASKDV = 1048575
-
- WRITE (IQLOG,9001) JQSTOR
- 9001 FORMAT (1X/' MZXRPR. Cross reference table for store',I3)
-
-C---- Loop all divisions, if not specific
-
- JDV = 1
- 21 IF (JDV.EQ.JQDVLL+1) JDV = JQDVSY
- IF (JBIT(MASKDV,JDV).EQ.0) GO TO 49
-
- WRITE (IQLOG,9007)
- 9007 FORMAT (1X)
-
-C-- Do next division
-
- 22 WRITE (IQLOG,9022) JDV
- 9022 FORMAT (10X,'Table entries for division',I3)
-
- CALL UPKBYT (IQRCU(KQT+JDV),1,IQUEST(1),24,0)
- DO 42 J=1,24
- I = IQUEST(25-J)
- 42 CHWK(J:J) = CHYN(I+1)
- WRITE (IQLOG,9042) CHWK(5:9),
- + CHWK(10:14),CHWK(15:19),CHWK(20:24)
-
- CALL UPKBYT (IQRTO(KQT+JDV),1,IQUEST(1),24,0)
- DO 43 J=1,24
- I = IQUEST(25-J)
- 43 CHWK(J:J) = CHYN(I+3)
- WRITE (IQLOG,9043) CHWK(1:4),CHWK(5:9),
- + CHWK(10:14),CHWK(15:19),CHWK(20:24)
-
- CALL UPKBYT (IQRNO(KQT+JDV),1,IQUEST(1),24,0)
- DO 44 J=1,24
- I = IQUEST(25-J)
- 44 CHWK(J:J) = CHYN(I+5)
- WRITE (IQLOG,9044) CHWK(5:9),
- + CHWK(10:14),CHWK(15:19),CHWK(20:24)
-
- 9042 FORMAT (12X,'active: ',5X,4(1X,A))
- 9043 FORMAT (12X,' set: ', 5(1X,A))
- 9044 FORMAT (12X,' unset: ',5X,4(1X,A))
-
- IF (IFLS.NE.0) GO TO 999
- 49 JDV = JDV + 1
- IF (JDV.LE.20) GO TO 21
- IF (JQSTOR.EQ.JSTINI) JQDIVI = JDVINI
-
-#include "zebra/qtrace99.inc"
- RETURN
- END
diff --git a/src/packlib/zebra/mqs/mzxrup.F b/src/packlib/zebra/mqs/mzxrup.F
deleted file mode 100644
index a7a1173..0000000
--- a/src/packlib/zebra/mqs/mzxrup.F
+++ /dev/null
@@ -1,58 +0,0 @@
-*
-* $Id: mzxrup.F,v 1.3 1999/06/18 13:30:56 couet Exp $
-*
-* $Log: mzxrup.F,v $
-* Revision 1.3 1999/06/18 13:30:56 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.2 1996/04/18 16:13:14 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:22 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE MZXRUP
-
-C- Derive IQRCU from IQRTO and IQRNO for current store
-
-#include "zebra/mqsys.inc"
-*
-
-#include "zebra/q_jbit.inc"
-#include "zebra/q_jbyt.inc"
-#include "zebra/q_sbit1.inc"
-#include "zebra/q_jbytet.inc"
-
-C---- Loop all divisions
-
- JDVFR = 1
- 21 IF (JDVFR.EQ.JQDVLL+1) JDVFR = JQDVSY
- MASKTO = IQRTO(KQT+JDVFR)
- MASKNO = IQRNO(KQT+JDVFR)
- MASKCU = JBYT (MASKTO,1,20)
-
- IF (JBIT(MASKTO,24).EQ.1) MASKCU = MSBIT1(MASKCU,JQDVSY)
-
- IF (JBYT(MASKTO,21,3).EQ.0) GO TO 47
-
-C-- Find divisions for generic
-
- JDVTO = 1
- 31 IF (JDVTO.EQ.JQDVLL+1) JDVTO = JQDVSY
-
- IF (JBIT(MASKNO,JDVTO).EQ.0) GO TO 37
- IF (JBYTET(IQKIND(KQT+JDVTO),MASKTO,1,23).EQ.0) GO TO 37
- MASKCU = MSBIT1 (MASKCU,JDVTO)
- 37 JDVTO = JDVTO + 1
- IF (JDVTO.LE.20) GO TO 31
-
- 47 IQRCU(KQT+JDVFR) = MASKCU
- JDVFR = JDVFR + 1
- IF (JDVFR.LE.20) GO TO 21
-C! IX = MSBYT (0,JQSTOR,27,4)
-C! CALL MZXRPR (IX)
- RETURN
- END
diff --git a/src/packlib/zebra/mqv/Imakefile b/src/packlib/zebra/mqv/Imakefile
deleted file mode 100644
index ef82dcf..0000000
--- a/src/packlib/zebra/mqv/Imakefile
+++ /dev/null
@@ -1,4 +0,0 @@
-SRCS_F= zvauto.F zvautu.F zvautx.F zvauty.F zvdo1.F zvdo2.F \ @@\
- zvdobk.F zvdola.F zverif.F zvfpri.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/zebra/mqv/zvauto.F b/src/packlib/zebra/mqv/zvauto.F
deleted file mode 100644
index 0504c0b..0000000
--- a/src/packlib/zebra/mqv/zvauto.F
+++ /dev/null
@@ -1,51 +0,0 @@
-*
-* $Id: zvauto.F,v 1.3 1999/06/18 13:31:01 couet Exp $
-*
-* $Log: zvauto.F,v $
-* Revision 1.3 1999/06/18 13:31:01 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.2 1996/04/18 16:13:23 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:13 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE ZVAUTO (MSTORE,IDVTH1,IDVTH2,LOGLEV)
-
-C- Initiate automatic verification
-
-#include "zebra/zunit.inc"
-#include "zebra/mqsysh.inc"
-#include "zebra/zvfaut.inc"
-#include "zebra/zvfwkc.inc"
-*
-
-#include "zebra/q_jbyt.inc"
-
- IF (IQVID(2).NE.0) RETURN
-
- IQVSTA = -1
- MASKST = MSTORE
- IQVLOG = LOGLEV
- IQVTHR(1) = IDVTH1
- IQVTHR(2) = IDVTH2
-
- IF (IQVTHR(1).LT.0) IQVSTA = 1
- IF (IQVTHR(2).LT.0) IQVSTA = 1
-
- IF (MSTORE.LE.0) THEN
- IQUEST(1) = -1
- MASKST = JBYT (IQUEST(1),2,16)
- ENDIF
-
- WRITE (IQLOG,9001) MASKST,IQVTHR,IQVLOG
- 9001 FORMAT (1X/' ZVAUTO. Automatic verification initiated',
- F' with stores mask= ',Z4,','
- F/10X,'Threshold VID=',I5,I10,', Log level=',I3)
-
- RETURN
- END
diff --git a/src/packlib/zebra/mqv/zvautu.F b/src/packlib/zebra/mqv/zvautu.F
deleted file mode 100644
index 4ffa62c..0000000
--- a/src/packlib/zebra/mqv/zvautu.F
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: zvautu.F,v 1.2 1999/06/18 13:31:01 couet Exp $
-*
-* $Log: zvautu.F,v $
-* Revision 1.2 1999/06/18 13:31:01 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:13 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE ZVAUTU
-
-C- Push the user VID stack
-
-#include "zebra/zvfaut.inc"
-*
-
- IF (IQVSTA.EQ.0) RETURN
-
- IQVREM(1,6) = IQVREM(1,5)
- IQVREM(2,6) = IQVREM(2,5)
-
- IQVREM(1,5) = IQVREM(1,4)
- IQVREM(2,5) = IQVREM(2,4)
-
- IQVREM(1,4) = IQVID(1)
- IQVREM(2,4) = IQVID(2)
- RETURN
- END
diff --git a/src/packlib/zebra/mqv/zvautx.F b/src/packlib/zebra/mqv/zvautx.F
deleted file mode 100644
index d25bad5..0000000
--- a/src/packlib/zebra/mqv/zvautx.F
+++ /dev/null
@@ -1,13 +0,0 @@
-*
-* $Id: zvautx.F,v 1.1.1.1 1996/03/06 10:47:13 mclareni Exp $
-*
-* $Log: zvautx.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:13 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE ZVAUTX
-C- Dummy, not connecting ZVAUTY
- RETURN
- END
diff --git a/src/packlib/zebra/mqv/zvauty.F b/src/packlib/zebra/mqv/zvauty.F
deleted file mode 100644
index eb45bf4..0000000
--- a/src/packlib/zebra/mqv/zvauty.F
+++ /dev/null
@@ -1,92 +0,0 @@
-*
-* $Id: zvauty.F,v 1.2 1999/06/18 13:31:02 couet Exp $
-*
-* $Log: zvauty.F,v $
-* Revision 1.2 1999/06/18 13:31:02 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:13 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE ZVAUTY
-
-C- Execute automatic verification
-
-#include "zebra/zunit.inc"
-#include "zebra/mqsys.inc"
-#include "zebra/zvfaut.inc"
-#include "zebra/zvfwkc.inc"
-*
-#if !defined(CERNLIB_QTRHOLL)||defined(CERNLIB_A6M)
- PARAMETER (LEVSEC = 2)
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- PARAMETER (LEVSEC = 4)
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HZVAU, 4HTY /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HZVAUTY /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'ZVAUTY ')
-#endif
-
- IF (IQVSTA.EQ.0) RETURN
-
-C-- Check this system call is a primary call
-
- IF (NQTRAC.GE.LEVSEC) RETURN
-
-C-- Check primary store exists
-
- IF (NQSTOR.EQ.-1) RETURN
-
-C-- Step the Verify ID
-
- IF (IQVID(2).EQ.2147483647) THEN
- IQVID(1) = IQVID(1) + 1
- IQVID(2) = 0
- ENDIF
-
- IQVID(2) = IQVID(2) + 1
-
- IF (IQVSTA.GE.0) GO TO 41
-
-C-- Running in dummy mode
-
- IF (IQVID(1).NE.IQVTHR(1)) RETURN
- IF (IQVID(2).NE.IQVTHR(2)) RETURN
-
-C-- Switch to active mode
-
- IQVSTA = 1
- IF (IQVLOG.EQ.0) GO TO 41
-
- DO 24 JST=1,NQSTOR+1
- K = NQOFFT(JST)
- 24 IQTABV(K+10) = IQVLOG
-
-C-- Running in active mode
-
- 41 JSTO = JQSTOR
- JDIV = JQDIVI
-
-#include "zebra/qtraceq.inc"
- CALL ZVERIF (-2, 0, 'Automatic verification')
-#include "zebra/qtrace99.inc"
-
- IF (JQSTOR.NE.JSTO) THEN
- IXSTOR = 0
- CALL SBYT (JSTO,IXSTOR,27,4)
- CALL MZSDIV (IXSTOR,-7)
- ENDIF
- JQDIVI = JDIV
- RETURN
- END
diff --git a/src/packlib/zebra/mqv/zvdo1.F b/src/packlib/zebra/mqv/zvdo1.F
deleted file mode 100644
index a85e170..0000000
--- a/src/packlib/zebra/mqv/zvdo1.F
+++ /dev/null
@@ -1,94 +0,0 @@
-*
-* $Id: zvdo1.F,v 1.2 1999/06/18 13:31:03 couet Exp $
-*
-* $Log: zvdo1.F,v $
-* Revision 1.2 1999/06/18 13:31:03 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:13 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE ZVDO1
-
-C- Subsidiary to ZVERIF, check process table
-
-#include "zebra/zstate.inc"
-#include "zebra/zunit.inc"
-#include "zebra/mqsys.inc"
-#include "zebra/mzcwk.inc"
-#include "zebra/zvfwkc.inc"
-*
- PARAMETER (NVECPR=61)
- DIMENSION MVECPR(NVECPR)
- EQUIVALENCE (MVECPR,NQSTOR)
- CHARACTER TEXT*8
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HZVDO, 4H1 /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HZVDO1 /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'ZVDO1 ')
-#endif
-
- IQUEST(1) = LOCF (IQTABV(1)) - 1
- IQUEST(2) = LOCF (LQ(1)) - 1
- IQUEST(3) = LOCF(IQWKTB(1)) - LQASTO
- IQUEST(4) = LOCF(IQWKFZ(1)) - LQASTO
- IQUEST(5) = LOCF(IQDN2(20)) - LQATAB
-
- NQCASE = 0
- IF (NQSTOR.EQ.-1) GO TO 71
- IF (NQSTOR.LT.0) GO TO 81
- IF (IQUEST(1).NE.LQATAB) GO TO 82
- IF (IQUEST(2).NE.LQASTO) GO TO 83
- IF (LQBTIS.NE.LQATAB-LQASTO) GO TO 84
- IF (IQUEST(3).NE.LQWKTB) GO TO 85
- IF (IQUEST(4).NE.LQWKFZ) GO TO 86
- IF (IQUEST(5).NE.NQTSYS) GO TO 87
- RETURN
-
- 71 WRITE (IQLOG,9071)
- GO TO 98
-
- 87 NQCASE = 1
- 86 NQCASE = NQCASE + 1
- 85 NQCASE = NQCASE + 1
- 84 NQCASE = NQCASE + 1
- 83 NQCASE = NQCASE + 1
- 82 NQCASE = NQCASE + 1
- 81 NQCASE = NQCASE + 1
- NQFATA = 5
-
- WRITE (IQLOG,9091)
- TEXT = 'NQSTOR'
- WRITE (IQLOG,9099) TEXT,NQSTOR
- TEXT = 'NQOFFT'
- WRITE (IQLOG,9099) TEXT,NQOFFT
- TEXT = 'NQOFFS'
- WRITE (IQLOG,9099) TEXT,NQOFFS
- TEXT = 'NQALLO'
- WRITE (IQLOG,9099) TEXT,NQALLO
- TEXT = '50->end'
- WRITE (IQLOG,9099) TEXT,(MVECPR(J),J=50,NVECPR)
-
- 98 CONTINUE
-#include "zebra/qtraceq.inc"
-#include "zebra/qtofatal.inc"
-
- 9091 FORMAT (1X/' ZVDO1. Process parameters overwritten'
- F/10X,'dump common /MZCA/'/1X)
- 9071 FORMAT (1X/' ZVDO1. No Zebra store initialized.')
-#if defined(CERNLIB_B32)
- 9099 FORMAT (3X,A,1X,5Z10/(12X,5Z10))
-#endif
-#if !defined(CERNLIB_B32)
- 9099 FORMAT (3X,A,1X,4Z18/(12X,4Z18))
-#endif
- END
diff --git a/src/packlib/zebra/mqv/zvdo2.F b/src/packlib/zebra/mqv/zvdo2.F
deleted file mode 100644
index 79f7607..0000000
--- a/src/packlib/zebra/mqv/zvdo2.F
+++ /dev/null
@@ -1,133 +0,0 @@
-*
-* $Id: zvdo2.F,v 1.3 1999/06/18 13:31:04 couet Exp $
-*
-* $Log: zvdo2.F,v $
-* Revision 1.3 1999/06/18 13:31:04 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.2 1996/04/18 16:13:24 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:13 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE ZVDO2
-
-C- Subsidiary to ZVERIF, check store table
-
-#include "zebra/zmach.inc"
-#include "zebra/zstate.inc"
-#include "zebra/zunit.inc"
-#include "zebra/mqsys.inc"
-#include "zebra/zvfwkc.inc"
-*
- PARAMETER (NVECPR=342)
- DIMENSION MVECPR(NVECPR)
- EQUIVALENCE (MVECPR,NQSTOR)
- CHARACTER TEXT*8
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HZVDO, 4H2 /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HZVDO2 /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'ZVDO2 ')
-#endif
-
-
- NQCASE = 0
- JDV = 0
- IF (LQSTOR.NE.LQASTO+KQS) GO TO 81
- IF (NQFEND.LE.0) GO TO 82
-
-C-- check monotony of store parameters
-
- IF (NQSTRU.GT.NQREF) GO TO 83
- IF (NQREF.GT.NQLINK) GO TO 84
- LAST = NQLINK
-
- JDV = 1
- 22 IF (JDV.EQ.JQDVLL+1) JDV = JQDVSY
-
- IF (LQSTA(KQT+JDV).LT.LAST) GO TO 85
- LAST = LQSTA(KQT+JDV)
- IF (LQEND(KQT+JDV).LT.LAST) GO TO 86
- LAST = LQEND(KQT+JDV)
- JDV = JDV + 1
- IF (JDV.LE.20) GO TO 22
-
-C-- check the fence is intact
-
- DO 24 J=1,NQFEND
- IF (LQ(KQS+J-NQFEND).NE.IQNIL) GO TO 61
- 24 CONTINUE
- RETURN
-
-C---- Fence overwritten
-
- 61 WRITE (IQLOG,9061)
- TEXT = 'FENCE'
- WRITE (IQLOG,9099) TEXT, (LQ(KQS+J-NQFEND),J=1,NQFEND)
- GO TO 98
-
-C-- Non-monotony
-
- 86 NQCASE = 1
- 85 NQCASE = NQCASE + 1
- 84 NQCASE = NQCASE + 1
- 83 NQCASE = NQCASE + 1
- 82 NQCASE = NQCASE + 1
- 81 NQCASE = NQCASE + 1
- NQFATA = 1
- IQUEST(1) = JDV
-
- WRITE (IQLOG,9091)
- TEXT = 'IQTABV'
- WRITE (IQLOG,9099) TEXT,(IQTABV(KQT+J),J=1,16)
- TEXT = 'LQSYSS'
- WRITE (IQLOG,9099) TEXT,(LQSYSS(KQT+J),J=1,10)
- TEXT = 'LQSYSR'
- WRITE (IQLOG,9099) TEXT,(LQSYSR(KQT+J),J=1,10)
- TEXT = 'IQTDUM'
- WRITE (IQLOG,9099) TEXT,(IQTDUM(KQT+J),J=1,22)
- TEXT = 'LQSTA'
- WRITE (IQLOG,9099) TEXT,(LQSTA(KQT+J),J=1,21)
- TEXT = 'LQEND'
- WRITE (IQLOG,9099) TEXT,(LQEND(KQT+J),J=1,20)
- TEXT = 'NQDMAX'
- WRITE (IQLOG,9099) TEXT,(NQDMAX(KQT+J),J=1,20)
- TEXT = 'IQMODE'
- WRITE (IQLOG,9099) TEXT,(IQMODE(KQT+J),J=1,20)
- TEXT = 'IQKIND'
- WRITE (IQLOG,9099) TEXT,(IQKIND(KQT+J),J=1,20)
- TEXT = 'IQRCU'
- WRITE (IQLOG,9099) TEXT,(IQRCU(KQT+J),J=1,20)
- TEXT = 'IQRTO'
- WRITE (IQLOG,9099) TEXT,(IQRTO(KQT+J),J=1,20)
- TEXT = 'IQRNO'
- WRITE (IQLOG,9099) TEXT,(IQRNO(KQT+J),J=1,20)
- TEXT = 'NQDINI'
- WRITE (IQLOG,9099) TEXT,(NQDINI(KQT+J),J=1,20)
- TEXT = 'NQDSIZ'
- WRITE (IQLOG,9099) TEXT,(NQDSIZ(KQT+J),J=1,20)
-
- 98 CONTINUE
-#include "zebra/qtraceq.inc"
-#include "zebra/qtofatal.inc"
-
- 9061 FORMAT (1X/' ZVDO2. Fence overwritten, dump follows'/1X)
- 9091 FORMAT (1X/' ZVDO2. Store parameter table overwritten'
- F/10X,'dump the /MZCC/ equivalent for the current store'/1X)
-#if defined(CERNLIB_B32)
- 9099 FORMAT (3X,A,1X,5Z10/(12X,5Z10))
-#endif
-#if !defined(CERNLIB_B32)
- 9099 FORMAT (3X,A,1X,4Z18/(12X,4Z18))
-#endif
- END
diff --git a/src/packlib/zebra/mqv/zvdobk.F b/src/packlib/zebra/mqv/zvdobk.F
deleted file mode 100644
index b3792f2..0000000
--- a/src/packlib/zebra/mqv/zvdobk.F
+++ /dev/null
@@ -1,159 +0,0 @@
-*
-* $Id: zvdobk.F,v 1.2 1999/06/18 13:31:04 couet Exp $
-*
-* $Log: zvdobk.F,v $
-* Revision 1.2 1999/06/18 13:31:04 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:13 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE ZVDOBK
-
-C- Subsidiary to ZVERIF, check the links of one bank
-
-#include "zebra/zstate.inc"
-#include "zebra/zunit.inc"
-#include "zebra/mqsys.inc"
-#include "zebra/mzcn.inc"
-#include "zebra/zvfwkc.inc"
-*
- EQUIVALENCE (NL,NBKNN(2)), (NS,NBKNN(3))
- CHARACTER CHWK*24, CHYN(4)*1
-
-#include "zebra/q_jbit.inc"
- DATA CHYN / 'n', 'y', 'i', '.' /
-
-#if defined(CERNLIB_QDEVZE)
- IF (NQDEVZ.GE.11) CALL ZVFPRI
-#endif
-
-C---- Check all links
-
- JLNK = -2
- 22 JLNK = JLNK + 1
- IF (JLNK.GT.NL) GO TO 61
- LINK = LQ(KQS+LBKLS-JLNK)
- IF (LINK.EQ.0) GO TO 22
-#if defined(CERNLIB_QDEVZE)
- IF (NQDEVZ.GE.11) WRITE (IQLOG,9823) JLNK,LINK
- 9823 FORMAT (16X,'Link number',I6,' is=',I10)
-#endif
- IF (LINK.LT.LSTOLO) GO TO 37
- IF (LINK.GE.LSTOHI) GO TO 37
-
- IF (LINK.GE.LDIVLO .AND. LINK.LT.LDIVHI) GO TO 24
- JDV = MZFDIV (-7,LINK)
- IF (JDV.EQ.0) GO TO 31
- IF (JLNK.EQ.0) GO TO 33
- IF (JBIT(MASKTO,JDV).EQ.0) GO TO 41
-
- 24 IF (JLNK.GT.NS) GO TO 22
-
-C-- Check structural link
-
- CALL MZCHLS (-7,LINK)
- IF (IQFOUL.EQ.0) GO TO 22
-
- NFATAL = NFATAL + 1
- CALL ZVFPRI
- IF (JLNK.NE.-1) THEN
- WRITE (IQLOG,9027) CHWARN,JLNK,LINK
- ELSE
- WRITE (IQLOG,9028) CHWARN,LINK
- ENDIF
- GO TO 22
-
- 9027 FORMAT (A,'Structural link',I6,' of value',I10,
- F' does not point to a bank')
- 9028 FORMAT (A,'The "up" link of value',I10,
- F' does not point to a bank')
-
-C-- Link points into a reserve area
-
- 31 NFATAL = NFATAL + 1
- CALL ZVFPRI
- WRITE (IQLOG,9031) CHWARN,JLNK,LINK
- 9031 FORMAT (A,'Link',I6,' of value',I10,
- F' does not point into a division')
- GO TO 22
-
-C-- 'next' link points to a different division
-
- 33 NFATAL = NFATAL + 1
- CALL ZVFPRI
- WRITE (IQLOG,9033) CHWARN,LINK
- 9033 FORMAT (A,'The "next" link of value',I10,
- F' points out of the division')
- GO TO 22
-
-C-- Link points outside the bank region
-
- 37 IF (NQOPTS(1).GE.2) GO TO 22
- CALL ZVFPRI
- WRITE (IQLOG,9037) CHWARN,JLNK,LINK
- 9037 FORMAT (A,'Link',I6,' of value',I10,
- F' does not point into the bank region')
-
- IF (NQOPTS(1).EQ.0) THEN
- NFATAL = NFATAL + 1
- ELSE
- NWARN = NWARN + 1
- ENDIF
- GO TO 22
-
-C-- Link points into non-reference division
-
- 41 NFATAL = NFATAL + 1
- CALL ZVFPRI
- WRITE (IQLOG,9041) CHWARN,JLNK,LINK,JDV
- 9041 FORMAT (A,'Link',I6,' of value',I10,' points to division',I3
- F/10X,'which is not declared in the cross-reference table,')
-
- CALL MZXRPR (-7)
- GO TO 22
-
-C------ Check "up" and "origin" of a live bank
-
- 61 IF (IBKXX.NE.0) RETURN
- LUP = LQ(KQS+LBKLS+1)
- LORG = LQ(KQS+LBKLS+2)
- IF (LORG.EQ.0) GO TO 71
- IF (LORG.LT.IQTABV(KQT+13)) GO TO 64
- IF (LORG.GT.IQTABV(KQT+14)) GO TO 64
- IF (LQ(KQS+LORG).NE.LBKLS) GO TO 67
- RETURN
-
-C-- Origin link illegal
-
- 64 NFATAL = NFATAL + 1
- CALL ZVFPRI
- WRITE (IQLOG,9064) CHWARN,LORG
- RETURN
-
- 9064 FORMAT (A,'Origin link adr=',Z10,'x is out-of-bounds')
-
-C-- LQ(LORG) does not point to the bank
-
- 67 NFATAL = NFATAL + 1
- CALL ZVFPRI
- J = LQ(KQS+LORG)
- WRITE (IQLOG,9067) CHWARN,LORG,J,LBKLS
- RETURN
-
- 9067 FORMAT (A,'Origin link adr=',Z10 ,'x'
- F/10X,'value LQ(LORG) =',Z10,'x is not LBK=',Z10,'x')
-
-C-- LORG is zero
-
- 71 IF (LUP.EQ.0) RETURN
- NWARN = NWARN + 1
- CALL ZVFPRI
- WRITE (IQLOG,9071) CHWARN,LUP
- RETURN
-
- 9071 FORMAT (A,'The "origin" link is zero, but the "up" link is',I10)
- END
diff --git a/src/packlib/zebra/mqv/zvdola.F b/src/packlib/zebra/mqv/zvdola.F
deleted file mode 100644
index e9140ed..0000000
--- a/src/packlib/zebra/mqv/zvdola.F
+++ /dev/null
@@ -1,131 +0,0 @@
-*
-* $Id: zvdola.F,v 1.3 1999/06/18 13:31:05 couet Exp $
-*
-* $Log: zvdola.F,v $
-* Revision 1.3 1999/06/18 13:31:05 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.2 1996/04/18 16:13:26 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:13 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE ZVDOLA (MDESV)
-
-C- Subsidiary to ZVERIF, check all link areas
-
-#include "zebra/zstate.inc"
-#include "zebra/zunit.inc"
-#include "zebra/mqsys.inc"
-#include "zebra/mzcn.inc"
-#include "zebra/zvfwkc.inc"
-*
- DIMENSION MDESV(99)
-
-#include "zebra/q_jbit.inc"
-#include "zebra/q_jbyt.inc"
-
-
- JDESMX = MDESV(1) - 4
- JDESLA = -4
- IF (MDESV(2).GE.MDESV(3)) JDESLA =1
-
-C------ Next link area
-
- 17 JDESLA = JDESLA + 5
- IF (JDESLA.GE.JDESMX) RETURN
- IF (JDESLA.EQ.6) GO TO 17
- LOCAR = MDESV(JDESLA+1)
- LOCARE = MDESV(JDESLA+2)
- MODAR = MDESV(JDESLA+3)
- LATMP = JBIT(MODAR,31)
- LOCARR = LOCAR + JBYT (MODAR,1,15)
- NAMEPR(1) = MDESV(JDESLA+4)
- NAMEPR(2) = MDESV(JDESLA+5)
-
- IFLLA = 0
-#if defined(CERNLIB_QDEVZE)
- IF (NQDEVZ.GE.11) THEN
- CALL ZVFPRI
- WRITE (IQLOG,9818) JDESLA,LOCAR,LOCARR,LOCARE,LATMP
- ENDIF
- 9818 FORMAT (10X,'Area at',I5,' LA,LR,LE,temp=',3I10,I2)
-#endif
- LIX = LOCAR
- IF (LATMP.EQ.0) GO TO 21
-
-C-- temporary link area
-
- LIX = LIX + 2
- JDMUST = LQ(KQS+LOCAR+1)
- IF (JDMUST.EQ.JDESLA) GO TO 18
- NFATAL = NFATAL + 1
- CALL ZVFPRI
- WRITE (IQLOG,9018) CHWARN,JDMUST,JDESLA
- 9018 FORMAT (A,'Word 2 destroyed, is= ',Z8,'x, should be= ',Z8)
-
- 18 IF (LQ(KQS+LOCAR).EQ.0) GO TO 17
-
-C---- Check all links
-
- 21 LIX = LIX - 1
- JLNK = 0
-
-C-- Next link
-
- 22 LIX = LIX + 1
- IF (LIX.EQ.LOCARE) GO TO 17
- JLNK = JLNK + 1
- LINK = LQ(KQS+LIX)
- IF (LINK.EQ.0) GO TO 22
-#if defined(CERNLIB_QDEVZE)
- IF (NQDEVZ.GE.11) WRITE (IQLOG,9823) LINK,LIX
- 9823 FORMAT (16X,'Link =',I9,' from LIX =',I9)
-#endif
- IF (LINK.LT.LSTOLO) GO TO 37
- IF (LINK.GE.LSTOHI) GO TO 37
-
- JDV = MZFDIV (-7,LINK)
- IF (JDV.EQ.0) GO TO 31
- IF (LIX.GE.LOCARR) GO TO 22
-
-C-- Check structural link
-
- CALL MZCHLS (-7,LINK)
- IF (IQFOUL.EQ.0) GO TO 22
-
- NFATAL = NFATAL + 1
- CALL ZVFPRI
- WRITE (IQLOG,9027) CHWARN,JLNK,LINK
- 9027 FORMAT (A,'Structural link number',I6,' of value',I10,
- F' does not point to a bank')
- GO TO 22
-
-C-- Link points into a reserve area
-
- 31 NFATAL = NFATAL + 1
- CALL ZVFPRI
- WRITE (IQLOG,9031) CHWARN,JLNK,LINK
- 9031 FORMAT (A,'Link number',I6,' of value',I10,
- F' does not point into a division')
- GO TO 22
-
-C-- Link points outside the bank region
-
- 37 IF (NQOPTS(1).GE.2) GO TO 22
- CALL ZVFPRI
- WRITE (IQLOG,9037) CHWARN,JLNK,LINK
- 9037 FORMAT (A,'Link number',I6,' of value',I10,
- F' does not point into the bank region')
-
- IF (NQOPTS(1).EQ.0) THEN
- NFATAL = NFATAL + 1
- ELSE
- NWARN = NWARN + 1
- ENDIF
- GO TO 22
- END
diff --git a/src/packlib/zebra/mqv/zverif.F b/src/packlib/zebra/mqv/zverif.F
deleted file mode 100644
index fb23ad6..0000000
--- a/src/packlib/zebra/mqv/zverif.F
+++ /dev/null
@@ -1,216 +0,0 @@
-*
-* $Id: zverif.F,v 1.2 1999/06/18 13:31:06 couet Exp $
-*
-* $Log: zverif.F,v $
-* Revision 1.2 1999/06/18 13:31:06 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:13 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE ZVERIF (IXSTP,IFRETN,TEXTID)
-
-C- Verify integrity of store IXVSTO
-C- IXVSTO = -1 : verify all stores
-C- -2 : verify stores selected in the ZVAUTO mask
-
-#include "zebra/zmach.inc"
-#include "zebra/zstate.inc"
-#include "zebra/zunit.inc"
-#include "zebra/mqsys.inc"
-#include "zebra/mzcn.inc"
-#include "zebra/zvfaut.inc"
-#include "zebra/zvfwkc.inc"
-*
- CHARACTER TEXTID*(*)
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HZVER, 4HFY /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HZVERIF /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'ZVERIF ')
-#endif
-
-#include "zebra/q_jbit.inc"
-
-#include "zebra/qtraceq.inc"
-
- TEXTHD = TEXTID
- CHWARN = ' !!!! '
- CALL VZERO (IFLHD,8)
- JVMODE = -1
-
-C-- Check the process parameters
-
- CALL ZVDO1
-
-C---- Select the store to be verified
-
- IXVSTO = IXSTP
- IF (IXVSTO.LT.0) GO TO 12
- NLOOP = 0
- CALL MZSDIV (IXVSTO,0)
- JDVINI = JQDIVI
- JST = JQSTOR
- GO TO 19
-
- 12 NLOOP = 7
- JDVINI = 0
- JST = 0
- IF (IXVSTO.EQ.-1) GO TO 19
-
- IF (IXVSTO.NE.-2) CALL ZFATAM ('not a valid store index.')
-
- NLOOP = -7
- JST = -1
- GO TO 17
-
- 16 IF (NLOOP.EQ.0) GO TO 71
- JST = JQSTOR
- 17 JST = JST + 1
- IF (JST.GT.NQSTOR) GO TO 71
- IF (NLOOP.GE.0) GO TO 19
- IF (JBIT(MASKST,JST+1).EQ.0) GO TO 17
-
- 19 IXVSTO = 0
- CALL SBYT (JST,IXVSTO,27,4)
- IF (NQALLO(JST+1).LT.0) GO TO 16
-
-C------ Do the next store
-
- CALL MZSDIV (IXVSTO,-1)
-
- CALL VZERO (JVMODE,7)
- IF (NQLOGL.GE.2) CALL ZVFPRI
-
-C-- Check the store parameters
-
- CALL ZVDO2
-
- LSTOLO = LQSTA(KQT+1)
- LSTOHI = LQEND(KQT+20)
-
-C-- If check of single division
-
- JQDIVI = JDVINI
- IF (JDVINI.NE.0) GO TO 22
-
-C---- Check all link areas
-
- JVMODE = 1
- L = LQSYSS(KQT+1)
- IF (L.NE.0) THEN
- IQ(KQS+L+3) = IQ(KQS+L+2) + NQLINK
- CALL ZVDOLA (IQ(KQS+L+1))
- ENDIF
-
-C------ Check all divisions
-
- JQDIVI = 0
- 21 IF (JQDIVI.EQ.20) GO TO 16
- IF (JDVINI.NE.0) GO TO 71
- IF (JQDIVI.EQ.JQDVLL) THEN
- JQDIVI = JQDVSY
- ELSE
- JQDIVI = JQDIVI + 1
- ENDIF
-
-C---- Do next division
-
- 22 JVMODE = 2
- LDIVLO = LQSTA(KQT+JQDIVI)
- LDIVHI = LQEND(KQT+JQDIVI)
- MASKTO = IQRCU(KQT+JQDIVI)
- IF (LDIVLO.GE.LDIVHI) GO TO 21
-
- NAMEPR(1) = IQDN1(KQT+JQDIVI)
- NAMEPR(2) = IQDN2(KQT+JQDIVI)
- IFLDV = 0
- LBKNX = LDIVLO
- IFLBK = 7
-
-C-- Next bank
-
- 24 IF (LBKNX.GE.LDIVHI) GO TO 21
-
- CALL MZCHLN (-7,LBKNX)
- IF (IQFOUL.NE.0) GO TO 41
-
- LBKNX = IQNX
- IF (IQND.LT.0) GO TO 24
-
- LBKLN = IQLN
- LBKLS = IQLS
- IBKXX = JBIT(IQ(KQS+LBKLS),IQDROP)
- IDBK(1) = IQ(KQS+IQLS-4)
- IDBK(2) = IQ(KQS+IQLS-5)
- NBKNN(1) = IQNIO
- NBKNN(2) = IQNL
- NBKNN(3) = IQNS
- NBKNN(4) = IQND
-
- IFLBK = 0
- CALL ZVDOBK
- IF (LBKNX.LE.LDIVHI) GO TO 24
-
- NFATAL = NFATAL + 1
- CALL ZVFPRI
- N = LDIVHI - LBKNX
- WRITE (IQLOG,9027) CHWARN,N
- 9027 FORMAT (A,'Bank overshoots the division end by',I7,' words')
- GO TO 21
-
-C---- bank chaining clobbered
-
- 41 NFATAL = NFATAL + 1
- CALL ZVFPRI
- WRITE (IQLOG,9041) CHWARN,LBKNX
- 9041 FORMAT (A,'Bank chaining clobbered at adr',I10)
-
- L = LBKNX
- 44 L = L + 1
- IF (L.GE.LDIVHI) GO TO 47
-
- CALL MZCHLN (-7,L)
- IF (IQFOUL.NE.0) GO TO 44
- LR = L
-
- 46 CALL MZCHLN (-7,IQNX)
- IF (IQFOUL.NE.0) GO TO 44
- IF (IQND.LT.0) GO TO 46
- L = LR
-
- 47 WRITE (IQLOG,9047) L
- 9047 FORMAT (10X,'recover at adr',I10)
-
- LBKNX = L
- GO TO 24
-
-C------ Finished
-
- 71 IQUEST(1) = NFATAL
- IF (NFATAL+NWARN.EQ.0) GO TO 999
-
- WRITE (IQLOG,9071) CHWARN, NFATAL,NWARN
- 9071 FORMAT (A,'ZVERIF found',I5,' fatal and',I5,' warning conditions')
-
- IF (NFATAL.EQ.0) GO TO 999
- IF (JDVINI.NE.0) THEN
- IF (IFRETN.NE.0) GO TO 999
- ENDIF
-
- CALL SBYT (LFAILS,IXVSTO,27,4)
- CALL MZSDIV (IXVSTO,-1)
- JQDIVI = LFAILD
- IQVSTA = 0
- CALL ZFATAM ('trouble in ZVERIF.')
-#include "zebra/qtrace99.inc"
- RETURN
- END
diff --git a/src/packlib/zebra/mqv/zvfpri.F b/src/packlib/zebra/mqv/zvfpri.F
deleted file mode 100644
index c0ac5d4..0000000
--- a/src/packlib/zebra/mqv/zvfpri.F
+++ /dev/null
@@ -1,97 +0,0 @@
-*
-* $Id: zvfpri.F,v 1.2 1999/06/18 13:31:06 couet Exp $
-*
-* $Log: zvfpri.F,v $
-* Revision 1.2 1999/06/18 13:31:06 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:13 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE ZVFPRI
-
-C- Print pending header lines for ZVERIF
-
-#include "zebra/zmach.inc"
-#include "zebra/zstate.inc"
-#include "zebra/zunit.inc"
-#include "zebra/mqsys.inc"
-#include "zebra/mzcn.inc"
-#include "zebra/zvfaut.inc"
-#include "zebra/zvfwkc.inc"
-*
- DIMENSION MBKDES(9)
- EQUIVALENCE (MBKDES(1),LBKLS)
- CHARACTER CHWK*12
-
-C-- Print main header line
-
- IF (IFLHD.EQ.0) THEN
- IFLHD = 7
- N = LNBLNK (TEXTHD)
- WRITE (IQLOG,9011) TEXTHD(1:N)
- IF (IQVSTA.NE.0) WRITE (IQLOG,9012) IQVID
- ENDIF
-
- 9011 FORMAT (1X/' ZVERIF. called, ',A)
- 9012 FORMAT (10X,'Verify ID =',I4,I10)
-
- IF (JVMODE.LT.0) RETURN
-
-C-- Print store header line
-
- IF (IFLST.EQ.0) THEN
- IFLST = 7
- WRITE (IQLOG,9014) JQSTOR,(NQSNAM(J),J=1,2)
- ENDIF
-
- 9014 FORMAT (1X/' ZVERIF. Doing store',I3,', id= ',2A4)
-
- IF (JVMODE.EQ.0) RETURN
-
-C---- Link areas / banks
-
- LFAILS = JQSTOR
- LFAILD = JQDIVI
- IF (JVMODE.GE.2) GO TO 31
-
-C-- Doing link area
-
- IF (IFLLA.NE.0) RETURN
- IFLLA = 7
- IF (LATMP.EQ.0) THEN
- CHWK = ', permanent '
- ELSE
- CHWK = ', temporary '
- ENDIF
- WRITE (IQLOG,9024) JQSTOR,CHWK,NAMEPR,JDESLA
- RETURN
-
- 9024 FORMAT (' ZVERIF. Store',I3,A,'link-area ',2A4,' J=',I6)
-
-C-- Doing banks
-
- 31 IF (IFLDV.EQ.0) THEN
- IFLDV = 7
- WRITE (IQLOG,9031) JQSTOR,JQDIVI,NAMEPR,LDIVLO,LDIVHI
- ENDIF
-
- 9031 FORMAT (' ZVERIF. Store',I3,', doing division',I3,1X,2A4,
- F' from/to =',2I10)
-
- IF (IFLBK.NE.0) RETURN
- IFLBK = 7
- IF (IBKXX.EQ.0) THEN
- CHWK(1:6) = ' live '
- ELSE
- CHWK(1:6) = ' dead '
- ENDIF
- WRITE (IQLOG,9034) CHWK(1:6),MBKDES
- RETURN
-
- 9034 FORMAT (' ZVERIF. Doing',A,'bank at',I9,' IDH/IDN= ',A4,I5,
- F' NIO=',I3/10X,'NL/NS/ND=',2I6,I8,' LA/LE=',2I10)
- END
diff --git a/src/packlib/zebra/qend/Imakefile b/src/packlib/zebra/qend/Imakefile
deleted file mode 100644
index d644a43..0000000
--- a/src/packlib/zebra/qend/Imakefile
+++ /dev/null
@@ -1,9 +0,0 @@
-SRCS_F= zabend.F zend.F zfatal.F zfatam.F zphase.F zpostm.F \ @@\
- ztell.F ztelus.F
-
-#ifdef CERNLIB_HPUX
-SpecialFortranLibObjectRule(zpostm,zpostm,'-WF,-P',NullParameter)
-#endif
-
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/zebra/qend/zabend.F b/src/packlib/zebra/qend/zabend.F
deleted file mode 100644
index 39916c7..0000000
--- a/src/packlib/zebra/qend/zabend.F
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: zabend.F,v 1.2 1999/06/18 13:31:11 couet Exp $
-*
-* $Log: zabend.F,v $
-* Revision 1.2 1999/06/18 13:31:11 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:14 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE ZABEND
-
-C- DEFAULT FOR THE USER ROUTINE TO HANDLE ABNORMAL PROGRAM END
-
-#include "zebra/zstate.inc"
-#include "zebra/zunit.inc"
-
- CALL ZPOSTM ('TCWM.')
- IF (NQPHAS.GT.0) GO TO 12
- CALL ABEND
- 12 NQPHAS = -2
- CALL ZEND
- RETURN
- END
diff --git a/src/packlib/zebra/qend/zend.F b/src/packlib/zebra/qend/zend.F
deleted file mode 100644
index eaa3ab9..0000000
--- a/src/packlib/zebra/qend/zend.F
+++ /dev/null
@@ -1,30 +0,0 @@
-*
-* $Id: zend.F,v 1.2 1999/06/18 13:31:11 couet Exp $
-*
-* $Log: zend.F,v $
-* Revision 1.2 1999/06/18 13:31:11 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:14 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE ZEND
-
-C- DEFAULT FOR THE USER ROUTINE FOR PROGRAM STOP
-
-#include "zebra/zstate.inc"
-#include "zebra/zunit.inc"
-*
-
-
- CALL ZPHASE (-1)
- CALL MZEND
-
- IF (NQERR.EQ.0) GO TO 99
- CALL ABEND
- 99 CONTINUE
- STOP
- END
diff --git a/src/packlib/zebra/qend/zfatal.F b/src/packlib/zebra/qend/zfatal.F
deleted file mode 100644
index 4656717..0000000
--- a/src/packlib/zebra/qend/zfatal.F
+++ /dev/null
@@ -1,144 +0,0 @@
-*
-* $Id: zfatal.F,v 1.2 1999/06/18 13:31:11 couet Exp $
-*
-* $Log: zfatal.F,v $
-* Revision 1.2 1999/06/18 13:31:11 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:14 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE ZFATAL
-
-C- FATAL PROGRAM TERMINATION
-
-#include "zebra/zmach.inc"
-#include "zebra/zstate.inc"
-#include "zebra/zunit.inc"
-#include "zebra/zvfaut.inc"
-#include "zebra/mqsys.inc"
-*
-#if defined(CERNLIB_QMVDS)
- SAVE INIT
-#endif
-#include "zebra/zfatalch.inc"
-
-#include "zebra/zfatalre.inc"
-
- IF (NQERR.NE.0) GO TO 71
- NQERR = NQERR+1
- LUN = IQTYPE
- IF (LUN.NE.0) GO TO 22
-
- 21 LUN = IQLOG
- 22 IF (NQTRAC.EQ.0) GO TO 31
-
-C---- PRINT ZEBRA TRACE-BACK
-
-#if (defined(CERNLIB_QPRINT))&&(!defined(CERNLIB_QTRHOLL)||defined(CERNLIB_A6M))
- JT = NQTRAC - 1
- WRITE (LUN,9024) MQTRAC(JT+1)
- 9024 FORMAT (1X/' !!!!! ZFATAL called from ',A6)
- GO TO 28
-
- 25 WRITE (LUN,9025) MQTRAC(JT+1)
- 9025 FORMAT (14X,'called from ',A6)
- 28 JT = JT - 1
-#endif
-#if (defined(CERNLIB_QPRINT))&&(defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- JT = NQTRAC - 2
- WRITE (LUN,9024) MQTRAC(JT+1),MQTRAC(JT+2)
- 9024 FORMAT (1X/' !!!!! ZFATAL called from ',2A4)
- GO TO 28
-
- 25 WRITE (LUN,9025) MQTRAC(JT+1),MQTRAC(JT+2)
- 9025 FORMAT (14X,'called from ',2A4)
- 28 JT = JT - 2
-#endif
-#if defined(CERNLIB_QPRINT)
- IF (JT.GE.0) GO TO 25
- IF (NQFATA.EQ.0) GO TO 49
- GO TO 41
-#endif
-
-C-- EXTERNAL CALL TO ZFATAL
-
- 31 IF (NQFATA.NE.0) GO TO 41
-#if defined(CERNLIB_QPRINT)
- WRITE (LUN,9031)
- 9031 FORMAT (1X/' !!!!! ZFATAL reached.')
-#endif
- GO TO 49
-
-C-- ZEBRA INTERNAL CALL TO ZFATAL
-
- 41 CONTINUE
-#if (defined(CERNLIB_QPRINT))&&(defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- WRITE (LUN,9041) IQUEST(10),NQCASE
- 9041 FORMAT (1X/' !!!!! ZFATAL reached from ',A6,' for Case=',I3/1X)
-#endif
-#if (defined(CERNLIB_QPRINT))&&(defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- WRITE (LUN,9041) IQUEST(9),IQUEST(10),NQCASE
- 9041 FORMAT (1X/' !!!!! ZFATAL reached from ',2A4,' for Case=',I3/1X)
-#endif
-#if (defined(CERNLIB_QPRINT))&&(!defined(CERNLIB_QTRHOLL))
- WRITE (LUN,9041) IQUEST(9),IQUEST(10),NQCASE
- 9041 FORMAT (1X/' !!!!! ZFATAL reached from ',2A4,' for Case=',I3/1X)
-#endif
-#if defined(CERNLIB_QPRINT)
-
- JPOS = IQBITW - 7
-
- DO 47 JW=11,10+NQFATA
- IT = IQUEST(JW)
- J = JBYT (IT,JPOS,8)
- IF (J.EQ.0) GO TO 44
- IF (J.EQ.255) GO TO 44
-
- WRITE (LUN,9043,ERR=47) JW,IT,IT,IT
- GO TO 47
-
- 44 WRITE (LUN,9044,ERR=47) JW,IT,IT
-#endif
-#if (defined(CERNLIB_QPRINT))&&(!defined(CERNLIB_HEX))
- 9043 FORMAT (10X,'IQUEST(',I2,') = ',I9,1X,O22,1X,A6)
- 9044 FORMAT (10X,'IQUEST(',I2,') = ',I9,1X,O22)
-#endif
-#if (defined(CERNLIB_QPRINT))&&(defined(CERNLIB_HEX))
- 9043 FORMAT (10X,'IQUEST(',I2,') = ',I9,1X,Z16,1X,A6)
- 9044 FORMAT (10X,'IQUEST(',I2,') = ',I9,1X,Z16)
-#endif
- 47 CONTINUE
-
- 49 WRITE (LUN,9049) JQSTOR,JQDIVI
- 9049 FORMAT (1X/10X,'Current Store number =',I3,' (JQDIVI=',I2,')')
-
- IF (IQVID(2).EQ.0) GO TO 59
-
- WRITE (LUN,9051) IQVID
- WRITE (LUN,9052) (J,IQVREM(1,J),IQVREM(2,J),J=1,6)
-
- 9051 FORMAT (1X/10X,'Automatic Verification Identifiers :'
- F/10X,'Current :',2X,2I11)
- 9052 FORMAT (10X,'Stacked, J =',I2,' :',I6,I11,5(/22X,I2,' :',I6,I11))
-
- 59 IF (LUN.NE.IQLOG) GO TO 21
- NQCASE = 0
- NQFATA = 0
- CALL ZABEND
-
-C---- RECOVERY LOOP
-
- 71 NQERR = NQERR + 1
- IF (NQERR.GE.4) GO TO 79
- WRITE (IQLOG,9071)
- IF (IQTYPE.EQ.0) GO TO 79
- IF (IQTYPE.EQ.IQLOG) GO TO 79
- WRITE (IQTYPE,9071)
- 9071 FORMAT (1X/' !!!!! Stop for re-entry to ZFATAL.')
- 79 CONTINUE
- CALL ABEND
- END
diff --git a/src/packlib/zebra/qend/zfatam.F b/src/packlib/zebra/qend/zfatam.F
deleted file mode 100644
index af35759..0000000
--- a/src/packlib/zebra/qend/zfatam.F
+++ /dev/null
@@ -1,45 +0,0 @@
-*
-* $Id: zfatam.F,v 1.2 1999/06/18 13:31:12 couet Exp $
-*
-* $Log: zfatam.F,v $
-* Revision 1.2 1999/06/18 13:31:12 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:14 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE ZFATAM (MESSAG)
-
-C- FATAL PROGRAM TERMINATION WITH MESSAGE
-
-#include "zebra/mzca.inc"
-#include "zebra/zstate.inc"
-#include "zebra/zunit.inc"
-*
- CHARACTER MESSAG*(*)
-#if defined(CERNLIB_QMVDS)
- SAVE INIT
-#endif
-#include "zebra/zfatalch.inc"
-
-#include "zebra/zfatalre.inc"
-
-#if defined(CERNLIB_QPRINT)
- IF (NQERR.GE.3) GO TO 19
- NQERR = NQERR+1
-
- WRITE (IQLOG,9001) MESSAG
-
- IF (IQTYPE.EQ.0) GO TO 18
- IF (IQTYPE.EQ.IQLOG) GO TO 18
- WRITE (IQTYPE,9001) MESSAG
- 9001 FORMAT (1X/' ZFATAM. !!!!! Going to ZFATAL for ',A)
-
- 18 NQERR = NQERR - 1
-#endif
- 19 CALL ZFATAL
-
- END
diff --git a/src/packlib/zebra/qend/zphase.F b/src/packlib/zebra/qend/zphase.F
deleted file mode 100644
index 413cdbd..0000000
--- a/src/packlib/zebra/qend/zphase.F
+++ /dev/null
@@ -1,104 +0,0 @@
-*
-* $Id: zphase.F,v 1.2 1999/06/18 13:31:12 couet Exp $
-*
-* $Log: zphase.F,v $
-* Revision 1.2 1999/06/18 13:31:12 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:14 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE ZPHASE (NPHP)
-
-C- CHANGE PROGRAM PHASE, USER CALLED
-
-#include "zebra/zstate.inc"
-#include "zebra/zunit.inc"
-#include "zebra/mqsys.inc"
-*
- DIMENSION NPHP(9)
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HZPHA, 4HSE /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HZPHASE /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'ZPHASE ')
-#endif
-
-
- NPH = NPHP(1)
- IF (NPH.EQ.0) NPH=1
- IF (NQPHAS) 41,31,21
-
-C-- CURRENT STATE IS OPERATION
-
- 21 IF (NPH.LT.0) GO TO 51
- NQPHAS = NPH
- RETURN
-
-C-- CURRENT STATE IS INIT
-
- 31 IF (NPH.LT.0) GO TO 51
- NQPHAS = NPH
-#if defined(CERNLIB_QPRINT)
- IF (NQLOGD.LT.-1) RETURN
- WRITE (IQLOG,9032) NPH
- 9032 FORMAT (1X/' ZPHASE. Start Operation Phase',I5)
-#endif
- RETURN
-
-C-- CURRENT STATE IS TERM
-
- 41 IF (NPH.LT.0) GO TO 52
-#if defined(CERNLIB_QPRINT)
- IF (NQLOGD.LT.-2) RETURN
- WRITE (IQLOG,9042) NPH
- 9042 FORMAT (1X/' !!!!! ZPHASE refuses to go back from Termination'
- F,' to Operation Phase',I5)
-#endif
- RETURN
-
-C---- START TERMINATION PHASE
-
-#if !defined(CERNLIB_QPRINT)
- 51 CONTINUE
- 52 CONTINUE
-#endif
-#if defined(CERNLIB_QPRINT)
- 51 IF (NQLOGD.GE.-1) WRITE (IQLOG,9051)
- 9051 FORMAT (1X/' ZPHASE. Start Termination Phase.')
-
- 52 IF (NQLOGD.GE.-1) WRITE (IQLOG,9052) NPH
- 9052 FORMAT (1X/' ZPHASE. Termination mode',I5)
-#endif
- NQPHAS = -1
-
-#include "zebra/qtrace.inc"
-
- CALL MZWORK (0,0,0,-1)
- IF (NPH.GE.-1) GO TO 999
-
- CALL MZGARB (JQDVSY,21)
- IF (NPH.GE.-2) GO TO 999
-
- LA = LQSTA(JQDVSY)
-
- JDIV = 1
- 56 JDIV = JDIV + 1
- LQSTA(JDIV) = LA
- LQEND(JDIV) = LA
- NQDRED(JDIV) = NQDRED(JDIV) + 1
- IF (JDIV.LT.JQDVLL) GO TO 56
-
- IX = MZIXCO (22,23,0,0)
- CALL MZGARB (IX,0)
-#include "zebra/qtrace99.inc"
- RETURN
- END
diff --git a/src/packlib/zebra/qend/zpostm.F b/src/packlib/zebra/qend/zpostm.F
deleted file mode 100644
index fb7b7c0..0000000
--- a/src/packlib/zebra/qend/zpostm.F
+++ /dev/null
@@ -1,95 +0,0 @@
-*
-* $Id: zpostm.F,v 1.2 1999/06/18 13:31:12 couet Exp $
-*
-* $Log: zpostm.F,v $
-* Revision 1.2 1999/06/18 13:31:12 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:13 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE ZPOSTM (CHDUMP)
-
-C-- POST-MORTEM OF ZEBRA SYSTEM
-
-#include "zebra/zstate.inc"
-#include "zebra/zunit.inc"
-#include "zebra/mqsys.inc"
-#include "zebra/mzcl.inc"
-#include "zebra/mzcn.inc"
-*
- CHARACTER CHDUMP*(*)
- DIMENSION IVQCL(8), IVQCN(7)
- EQUIVALENCE (IVQCL(1),NQLN), (IVQCN(1),IQLN)
-
-
- WRITE (IQLOG,9001)
- WRITE (IQLOG,9031) (IQUEST(J),J=1,40)
- WRITE (IQLOG,9011) (IQUEST(J),J=1,40)
- WRITE (IQLOG,9035) IVQCL
- WRITE (IQLOG,9011) IVQCL
- WRITE (IQLOG,9036) IVQCN
- WRITE (IQLOG,9011) IVQCN
- CALL MZMAPS
-
-#if defined(CERNLIB_CDC)
- CALL TRACEQR (IQLOG,12)
-#elif defined (CERNLIB_CRAY)
- CALL TRBK (IQLOG)
-#elif defined (CERNLIB_CONVEX)
- CALL TRACEBACK
-#elif defined (CERNLIB_IBM)
- CALL ERRTRA
-#elif defined (CERNLIB_IBMD)
- CALL ERRTRA
-#else
- CALL TRACEQ (IQLOG,12)
-#endif
- IQDLUN = IQLOG
- IXSTOR = 0
- CALL SBYT (JQSTOR,IXSTOR,27,4)
- CALL DZSNAP ('ZPOSTM',IXSTOR,CHDUMP)
-
- IF (NQERR.LT.100) RETURN
- CALL MZEND
- CALL ABEND
-
- 9001 FORMAT ('1ZEBRA SYSTEM Post-Mortem from ZPOSTM.'/1X)
-#if (!defined(CERNLIB_HEX))&&(defined(CERNLIB_B60M))
- 9011 FORMAT (2X,5O23)
- 9031 FORMAT (' /QUEST/'/(2X,5I23))
-#endif
-#if (!defined(CERNLIB_HEX))&&(!defined(CERNLIB_B60M))
- 9011 FORMAT (2X,5O18)
- 9031 FORMAT (' /QUEST/'/(2X,5I18))
-#endif
-#if (defined(CERNLIB_HEX))&&(defined(CERNLIB_B60M))
- 9011 FORMAT (2X,5Z18)
- 9031 FORMAT (' /QUEST/'/(2X,5I18))
-#endif
-#if (defined(CERNLIB_HEX))&&(!defined(CERNLIB_B60M))
- 9011 FORMAT (2X,8Z13)
- 9031 FORMAT (' /QUEST/'/(2X,8I13))
-#endif
- 9035 FORMAT (1X/' Last Bank Lifted - '
- F,'COMMON /MZCL/LFW,LS,NIO,ID,NL,NS,ND,IOCH(1)'
- F/2X,2(1X,I9),1X,I3,1X,A5,3(1X,I7),
-#if (!defined(CERNLIB_HEX))&&(defined(CERNLIB_B60M))
- FO22,' oct')
-#endif
-#if (!defined(CERNLIB_HEX))&&(!defined(CERNLIB_B60M))
- FO17,' oct')
-#endif
-#if (defined(CERNLIB_HEX))&&(defined(CERNLIB_B60M))
- FZ17,' hex')
-#endif
-#if (defined(CERNLIB_HEX))&&(!defined(CERNLIB_B60M))
- FZ13,' hex')
-#endif
- 9036 FORMAT (1X/' Last Bank analysed - '
- F,'COMMON /MZCN/LFW,LS,NIO,ID,NL,NS,ND'
- F/2X,2(1X,I9),1X,I3,1X,A5,3(1X,I7))
- END
diff --git a/src/packlib/zebra/qend/ztell.F b/src/packlib/zebra/qend/ztell.F
deleted file mode 100644
index ad8a91c..0000000
--- a/src/packlib/zebra/qend/ztell.F
+++ /dev/null
@@ -1,95 +0,0 @@
-*
-* $Id: ztell.F,v 1.2 1999/06/18 13:31:13 couet Exp $
-*
-* $Log: ztell.F,v $
-* Revision 1.2 1999/06/18 13:31:13 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:14 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE ZTELL (IDP,JFLP)
-
-C- Signal trouble situation,
-C- called from the garbage collector if not enough space
-C- may be user called with IDP > 100
-
-#include "zebra/zstate.inc"
-#include "zebra/zunit.inc"
-#include "zebra/quest.inc"
-#include "zebra/mzca.inc"
-#include "zebra/mzcb.inc"
-#include "zebra/fzcx.inc"
-*
- COMMON /ZTELLC/ ID,JFLUS
-
- DIMENSION IDP(9), JFLP(9)
-
- PARAMETER (NLIST = 3 )
- DIMENSION LIST(NLIST), JFLDEF(NLIST)
-#if defined(CERNLIB_QMVDS)
- SAVE LIST, JFLDEF
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HZTEL, 4HL /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HZTELL /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'ZTELL ')
-#endif
- DATA LIST / 19, 61, 62 /
- DATA JFLDEF / 2, 2, 2 /
-
-C- Return code: 0 return, 1 QNEXT, 2 ZFATAL, 3 ZEND
-
-
- ID = IDP(1)
- JFLUS = JFLP(1)
- JFLSV = MAX (JFLUS,0)
- IQUEST(1) = ID
-#if defined(CERNLIB_QPRINT)
- LOGLEV = NQLOGD
- IF (ID.GE.11) THEN
- IF (ID.LE.19) LOGLEV = MAX (LOGLEV,LOGLVX)
- IF (ID.EQ.15) LOGLEV = MAX (LOGLEV,NQLOGL)
- IF (ID.EQ.99) LOGLEV = MAX (LOGLEV,NQLOGL)
- ENDIF
- IF (LOGLEV.GE.1) WRITE (IQLOG,9001) ID,JFLUS
- 9001 FORMAT (' ZTELL. ---- Called for Condition',I5,',',I4)
-#endif
-
-C-- System conditions
-
- IF (ID.GE.100) GO TO 31
- J = IUCOMP (ID,LIST,NLIST)
- IF (J.NE.0) THEN
- JFLUS = JFLDEF(J)
- ENDIF
-
-C-- CALL ZTELUS
-
- 31 CALL ZTELUS
- JFLUS = MAX (JFLUS,JFLSV)
- JFLUS = MIN (JFLUS,3) + 1
- GO TO (40,41,42,43), JFLUS
-
- 41 IF (NQPHAS.LE.0) GO TO 42
- NQTRAC = 0
- CALL QNEXTE
-
- 43 NQPHAS = -2
- CALL ZEND
-
- 42 CONTINUE
-#include "zebra/qtrace.inc"
- CALL ZFATAM ('EXIT VIA ZTELL.')
-
- 40 RETURN
- END
diff --git a/src/packlib/zebra/qend/ztelus.F b/src/packlib/zebra/qend/ztelus.F
deleted file mode 100644
index 4087461..0000000
--- a/src/packlib/zebra/qend/ztelus.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: ztelus.F,v 1.2 1999/06/18 13:31:14 couet Exp $
-*
-* $Log: ztelus.F,v $
-* Revision 1.2 1999/06/18 13:31:14 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:14 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
-#if !defined(CERNLIB_NODUMMY)
- SUBROUTINE ZTELUS
-
-C- DUMMY VERSION OF THE USER ROUTINE ZTELUS
-
- RETURN
- END
-#endif
diff --git a/src/packlib/zebra/qutil/Imakefile b/src/packlib/zebra/qutil/Imakefile
deleted file mode 100644
index 9f99c85..0000000
--- a/src/packlib/zebra/qutil/Imakefile
+++ /dev/null
@@ -1,7 +0,0 @@
-SRCS_F= izbcd.F izbcdt.F izbcdv.F izchav.F izhnum.F lzbyt.F \ @@\
- lzfind.F lzfval.F lzlast.F lzlong.F nzbank.F nzfind.F nzlong.F \ @@\
- qnext.F zhtoi.F zitoh.F zkrak.F zkrakn.F znumid.F zpress.F \ @@\
- zshunt.F zsort.F zsorth.F zsorti.F zsorv.F zsorvh.F zsorvi.F \ @@\
- ztopsy.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/zebra/qutil/izbcd.F b/src/packlib/zebra/qutil/izbcd.F
deleted file mode 100644
index 4df2701..0000000
--- a/src/packlib/zebra/qutil/izbcd.F
+++ /dev/null
@@ -1,48 +0,0 @@
-*
-* $Id: izbcd.F,v 1.4 1999/06/18 13:31:18 couet Exp $
-*
-* $Log: izbcd.F,v $
-* Revision 1.4 1999/06/18 13:31:18 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.3 1998/09/25 09:33:20 mclareni
-* Modifications for the Mklinux port flagged by CERNLIB_PPC
-*
-* Revision 1.2 1996/09/23 12:10:20 cernlib
-* add linux
-*
-* Revision 1.1.1.1 1996/03/06 10:47:14 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
-#if defined(CERNLIB_Z32)
-#include "qutyz32/izbcd.F"
-#elif (defined(CERNLIB_VAXVMS))||(defined(CERNLIB_QMVMI)) \
- ||(defined(CERNLIB_QMDOS))||(defined(CERNLIB_TMO)) \
- ||((defined(CERNLIB_QMLNX) && !defined(CERNLIB_PPC)))
-#include "qutyinv/izbcd.F"
-#elif (defined(CERNLIB_CONVEX))&&(defined(CERNLIB_SINGLE))
-#include "not_cern/qutycvx/izbcd.F"
-#elif defined(CERNLIB_CRAY)
-#include "not_cern/qutycry/izbcd.F"
-#elif defined(CERNLIB_CDC)
-#include "not_cern/qutycdc/izbcd.F"
-#elif defined(CERNLIB_PDP)
-#include "not_cern/qutypdp/izbcd.F"
-#else
- FUNCTION IZBCD (CHAR)
-
-C- This is a very slow stop-gap solution only !!!
-
-#include "zebra/zbcd.inc"
-*
- INTEGER CHAR(9)
-
-
- IZBCD = IUCOMP (CHAR(1),IQLETT(1),63)
- IF (IZBCD.EQ.0) IZBCD=57
- RETURN
- END
-#endif
diff --git a/src/packlib/zebra/qutil/izbcdt.F b/src/packlib/zebra/qutil/izbcdt.F
deleted file mode 100644
index 89edfc4..0000000
--- a/src/packlib/zebra/qutil/izbcdt.F
+++ /dev/null
@@ -1,67 +0,0 @@
-*
-* $Id: izbcdt.F,v 1.4 1999/06/18 13:31:19 couet Exp $
-*
-* $Log: izbcdt.F,v $
-* Revision 1.4 1999/06/18 13:31:19 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.3 1998/09/25 09:33:21 mclareni
-* Modifications for the Mklinux port flagged by CERNLIB_PPC
-*
-* Revision 1.2 1996/09/23 12:20:34 cernlib
-* add Linux
-*
-* Revision 1.1.1.1 1996/03/06 10:47:14 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
-#if defined(CERNLIB_Z32)
-#include "qutyz32/izbcdt.F"
-#elif (defined(CERNLIB_VAXVMS))||(defined(CERNLIB_QMVMI)) \
- ||(defined(CERNLIB_QMDOS))||(defined(CERNLIB_TMO)) \
- ||((defined(CERNLIB_QMLNX) && !defined(CERNLIB_PPC)))
-#include "qutyinv/izbcdt.F"
-#elif (defined(CERNLIB_CONVEX))&&(defined(CERNLIB_SINGLE))
-#include "not_cern/qutycvx/izbcdt.F"
-#elif defined(CERNLIB_CRAY)
-#include "not_cern/qutycry/izbcdt.F"
-#elif defined(CERNLIB_CDC)
-#include "not_cern/qutycdc/izbcdt.F"
-#elif defined(CERNLIB_PDP)
-#include "not_cern/qutypdp/izbcdt.F"
-#else
- SUBROUTINE IZBCDT (NP,ITABT)
-
-C- This is a very slow stop-gap solution only !!!
-
-#include "zebra/quest.inc"
-#include "zebra/zkrakc.inc"
-#include "zebra/zbcd.inc"
-*
- DIMENSION NP(9), ITABT(99)
-
-
- N = NP(1)
- LIM = ITABT(1)
- JGOOD = 0
- JBAD = 0
-
- DO 29 JWH=1,N
- JV = IUCOMP (IQHOLK(JWH),IQLETT(1),LIM)
-
- IF (JV.EQ.0) GO TO 27
- JV = ITABT(JV+1)
- IF (JV+1) 29, 27, 24
- 24 JGOOD = JGOOD + 1
- IQCETK(JGOOD) = JV
- GO TO 29
-
- 27 JBAD = JBAD + 1
- 29 CONTINUE
- IQUEST(1) = JGOOD
- IQUEST(2) = JBAD
- RETURN
- END
-#endif
diff --git a/src/packlib/zebra/qutil/izbcdv.F b/src/packlib/zebra/qutil/izbcdv.F
deleted file mode 100644
index e031ebf..0000000
--- a/src/packlib/zebra/qutil/izbcdv.F
+++ /dev/null
@@ -1,54 +0,0 @@
-*
-* $Id: izbcdv.F,v 1.4 1999/06/18 13:31:19 couet Exp $
-*
-* $Log: izbcdv.F,v $
-* Revision 1.4 1999/06/18 13:31:19 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.3 1998/09/25 09:33:22 mclareni
-* Modifications for the Mklinux port flagged by CERNLIB_PPC
-*
-* Revision 1.2 1996/09/23 12:20:35 cernlib
-* add Linux
-*
-* Revision 1.1.1.1 1996/03/06 10:47:14 mclareni
-* Zebra
-*
-*
-* .
-#include "zebra/pilot.h"
-#if defined(CERNLIB_Z32)
-#include "qutyz32/izbcdv.F"
-#elif (defined(CERNLIB_VAXVMS))||(defined(CERNLIB_QMVMI)) \
- ||(defined(CERNLIB_QMDOS))||(defined(CERNLIB_TMO)) \
- ||((defined(CERNLIB_QMLNX) && !defined(CERNLIB_PPC)))
-#include "qutyinv/izbcdv.F"
-#elif (defined(CERNLIB_CONVEX))&&(defined(CERNLIB_SINGLE))
-#include "not_cern/qutycvx/izbcdv.F"
-#elif defined(CERNLIB_CRAY)
-#include "not_cern/qutycry/izbcdv.F"
-#elif defined(CERNLIB_CDC)
-#include "not_cern/qutycdc/izbcdv.F"
-#elif defined(CERNLIB_PDP)
-#include "not_cern/qutypdp/izbcdv.F"
-#else
- SUBROUTINE IZBCDV (NP)
-
-C- This is a very slow stop-gap solution only !!!
-
-#include "zebra/zkrakc.inc"
-#include "zebra/zbcd.inc"
-*
- DIMENSION NP(9)
-
-
- N = NP(1)
-
- DO 29 JWH=1,N
- JV = IUCOMP (IQHOLK(JWH),IQLETT(1),63)
- IF (JV.EQ.0) JV=57
- 29 IQCETK(JWH) = JV
- RETURN
- END
-#endif
diff --git a/src/packlib/zebra/qutil/izchav.F b/src/packlib/zebra/qutil/izchav.F
deleted file mode 100644
index deb40f6..0000000
--- a/src/packlib/zebra/qutil/izchav.F
+++ /dev/null
@@ -1,37 +0,0 @@
-*
-* $Id: izchav.F,v 1.2 1999/06/18 13:31:20 couet Exp $
-*
-* $Log: izchav.F,v $
-* Revision 1.2 1999/06/18 13:31:20 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:14 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
-#if (defined(CERNLIB_Z32))&&(defined(CERNLIB_EQUHOLCH))
-#include "qutyz32/izchav.F"
-#elif (defined(CERNLIB_CONVEX))&&(defined(CERNLIB_SINGLE))
-#include "not_cern/qutycvx/izchav.F"
-#elif defined(CERNLIB_CRAY)
-#include "not_cern/qutycry/izchav.F"
-#elif defined(CERNLIB_CDC)
-#include "not_cern/qutycdc/izchav.F"
-#else
- SUBROUTINE IZCHAV (NP)
-
-#include "zebra/zceta.inc"
-#include "zebra/zkrakcc.inc"
-*
- DIMENSION NP(9)
-
- N = NP(1)
-
- DO 29 JCE=1,N
- JV = ICHAR (CQHOLK(JCE:JCE))
- 29 IQCETK(JCE) = IQCETA(JV+1)
- RETURN
- END
-#endif
diff --git a/src/packlib/zebra/qutil/izhnum.F b/src/packlib/zebra/qutil/izhnum.F
deleted file mode 100644
index d7bceda..0000000
--- a/src/packlib/zebra/qutil/izhnum.F
+++ /dev/null
@@ -1,37 +0,0 @@
-*
-* $Id: izhnum.F,v 1.4 1998/09/25 09:33:23 mclareni Exp $
-*
-* $Log: izhnum.F,v $
-* Revision 1.4 1998/09/25 09:33:23 mclareni
-* Modifications for the Mklinux port flagged by CERNLIB_PPC
-*
-* Revision 1.3 1997/03/14 17:20:41 mclareni
-* WNT mods
-*
-* Revision 1.2 1996/09/23 12:20:36 cernlib
-* add Linux
-*
-* Revision 1.1.1.1.2.1 1997/01/21 11:33:49 mclareni
-* All mods for Winnt 96a on winnt branch
-*
-* Revision 1.1.1.1 1996/03/06 10:47:14 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
-#if defined(CERNLIB_Z32)
-#include "qutyz32/izhnum.F"
-#elif (defined(CERNLIB_VAXVMS))||(defined(CERNLIB_DECS)) \
- ||(defined(CERNLIB_DECOSF))||(defined(CERNLIB_MSDOS)) \
- ||(defined(CERNLIB_TMO)) ||((defined(CERNLIB_QMLNX) && !defined(CERNLIB_PPC))) \
- ||(defined(CERNLIB_WINNT))
-#include "qutyinv/izhnum.F"
-#elif (defined(CERNLIB_CONVEX))||(defined(CERNLIB_SINGLE))
-#include "not_cern/qutycvx/izhnum.F"
-#elif defined(CERNLIB_CRAY)
-#include "not_cern/qutycry/izhnum.F"
-#elif defined(CERNLIB_CDC)
-#include "not_cern/qutycdc/izhnum.F"
-#elif defined(CERNLIB_PDP)
-#include "not_cern/qutypdp/izhnum.F"
-#endif
diff --git a/src/packlib/zebra/qutil/lzbyt.F b/src/packlib/zebra/qutil/lzbyt.F
deleted file mode 100644
index 8515565..0000000
--- a/src/packlib/zebra/qutil/lzbyt.F
+++ /dev/null
@@ -1,38 +0,0 @@
-*
-* $Id: lzbyt.F,v 1.3 1999/06/18 13:31:20 couet Exp $
-*
-* $Log: lzbyt.F,v $
-* Revision 1.3 1999/06/18 13:31:20 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.2 1996/04/18 16:13:31 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:14 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- FUNCTION LZBYT (IXSTOR,LGO,ITEXT,JTH,NBITS)
-
-C- FIND BANK CONTAINING ITEXT IN STATUS-BYTE (JTH,NBITS)
-C- SEARCH LINEAR STRUCTURE STARTING WITH BANK AT LGO
-C- RETURN BANK-ADR AS VALUE
-
-#include "zebra/q.inc"
-*
-
-#include "zebra/q_jbyt.inc"
-
-#include "zebra/qstore.inc"
-
- L = LGO
- 21 IF (L.EQ.0) GO TO 29
- IF (JBYT(IQ(KQS+L),JTH,NBITS).EQ.ITEXT) GO TO 29
- L = LQ(KQS+L)
- GO TO 21
-
- 29 LZBYT = L
- RETURN
- END
diff --git a/src/packlib/zebra/qutil/lzfind.F b/src/packlib/zebra/qutil/lzfind.F
deleted file mode 100644
index a25b521..0000000
--- a/src/packlib/zebra/qutil/lzfind.F
+++ /dev/null
@@ -1,38 +0,0 @@
-*
-* $Id: lzfind.F,v 1.3 1999/06/18 13:31:20 couet Exp $
-*
-* $Log: lzfind.F,v $
-* Revision 1.3 1999/06/18 13:31:20 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.2 1996/04/18 16:13:33 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:14 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- FUNCTION LZFIND (IXSTOR,LGO,ITEXT,JWORD)
-
-C- FIND BANK CONTAINING ITEXT IN WORD JWORD
-C- SEARCH LINEAR STRUCTURE STARTING WITH BANK AT LGO
-C- RETURN BANK-ADR AS VALUE
-
-#include "zebra/q.inc"
-*
-
-#include "zebra/q_jbyt.inc"
-
-#include "zebra/qstore.inc"
-
- L = LGO
- 21 IF (L.EQ.0) GO TO 29
- IF (IQ(KQS+L+JWORD).EQ.ITEXT) GO TO 29
- L = LQ(KQS+L)
- GO TO 21
-
- 29 LZFIND= L
- RETURN
- END
diff --git a/src/packlib/zebra/qutil/lzfval.F b/src/packlib/zebra/qutil/lzfval.F
deleted file mode 100644
index d135011..0000000
--- a/src/packlib/zebra/qutil/lzfval.F
+++ /dev/null
@@ -1,46 +0,0 @@
-*
-* $Id: lzfval.F,v 1.3 1999/06/18 13:31:21 couet Exp $
-*
-* $Log: lzfval.F,v $
-* Revision 1.3 1999/06/18 13:31:21 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.2 1996/04/18 16:13:34 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:14 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
-#if defined(CERNLIB_VAXVMS)
-#include "qutyvax/lzfval.F"
-#else
- FUNCTION LZFVAL (IXSTOR,LGO,VAL,TOL,JWORD)
-
-C- FIND BANK CONTAINING IN WORD JWORD FL.P. VAL WITHIN TOL
-C- SEARCH LINEAR STRUCTURE STARTING WITH BANK AT LGO
-C- RETURN BANK-ADR AS VALUE
-
-#include "zebra/q.inc"
-*
-
-#include "zebra/q_jbyt.inc"
-
-#include "zebra/qstore.inc"
-
- VLOW = VAL - TOL
- VHI = VAL + TOL
-
- L = LGO
- 21 IF (L.EQ.0) GO TO 29
- IF (Q(KQS+L+JWORD).LT.VLOW) GO TO 22
- IF (Q(KQS+L+JWORD).LE.VHI) GO TO 29
- 22 L = LQ(KQS+L)
- GO TO 21
-
- 29 LZFVAL= L
- RETURN
- END
-#endif
diff --git a/src/packlib/zebra/qutil/lzlast.F b/src/packlib/zebra/qutil/lzlast.F
deleted file mode 100644
index c21406b..0000000
--- a/src/packlib/zebra/qutil/lzlast.F
+++ /dev/null
@@ -1,39 +0,0 @@
-*
-* $Id: lzlast.F,v 1.3 1999/06/18 13:31:21 couet Exp $
-*
-* $Log: lzlast.F,v $
-* Revision 1.3 1999/06/18 13:31:21 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.2 1996/04/18 16:13:37 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:14 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- FUNCTION LZLAST (IXSTOR,LGO)
-
-C- FIND LAST BANK IN THE LINEAR STRUCTURE STARTING WITH BANK AT LGO
-C- RETURN BANK-ADR AS VALUE
-
-#include "zebra/q.inc"
-*
-
-#include "zebra/q_jbyt.inc"
-
-#include "zebra/qstore.inc"
-
- LF = LGO
- IF (LF.EQ.0) GO TO 29
-
- 21 L = LQ(KQS+LF)
- IF (L.EQ.0) GO TO 29
- LF = L
- GO TO 21
-
- 29 LZLAST = LF
- RETURN
- END
diff --git a/src/packlib/zebra/qutil/lzlong.F b/src/packlib/zebra/qutil/lzlong.F
deleted file mode 100644
index 55c5d39..0000000
--- a/src/packlib/zebra/qutil/lzlong.F
+++ /dev/null
@@ -1,51 +0,0 @@
-*
-* $Id: lzlong.F,v 1.3 1999/06/18 13:31:21 couet Exp $
-*
-* $Log: lzlong.F,v $
-* Revision 1.3 1999/06/18 13:31:21 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.2 1996/04/18 16:13:39 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:14 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- FUNCTION LZLONG (IXSTOR,LGO,NTEXT,ITEXT,JWORD)
-
-C- FIND BANK WITH ITEXT(1-NTEXT) IN WORDS JWORD,..,JWORD+NTEXT-1
-C- SEARCH LINEAR STRUCTURE STARTING WITH BANK AT LGO
-C- RETURN BANK-ADR AS VALUE
-
-#include "zebra/q.inc"
-*
- DIMENSION ITEXT(9)
-
-#include "zebra/q_jbyt.inc"
-
-#include "zebra/qstore.inc"
-
- N2 = NTEXT - 2
- L = LGO
- IF (L.EQ.0) GO TO 39
- IF (IQ(KQS+L+JWORD).EQ.ITEXT(1)) GO TO 24
-
- 21 L = LQ(KQS+L)
- IF (L.EQ.0) GO TO 39
- IF (IQ(KQS+L+JWORD).NE.ITEXT(1)) GO TO 21
-
- 24 IF (N2) 39, 28, 26
-
- 26 LB = L + JWORD - 1
- DO 27 J=2,NTEXT
- IF (IQ(KQS+LB+J).NE.ITEXT(J)) GO TO 21
- 27 CONTINUE
- GO TO 39
-
- 28 IF (IQ(KQS+L+JWORD+1).NE.ITEXT(2)) GO TO 21
- 39 LZLONG = L
- RETURN
- END
diff --git a/src/packlib/zebra/qutil/not_cern/apollo/ffsizeapo.F b/src/packlib/zebra/qutil/not_cern/apollo/ffsizeapo.F
deleted file mode 100644
index 5a43e9e..0000000
--- a/src/packlib/zebra/qutil/not_cern/apollo/ffsizeapo.F
+++ /dev/null
@@ -1,44 +0,0 @@
-*
-* $Id: ffsizeapo.F,v 1.1.1.1 1996/03/06 10:47:16 mclareni Exp $
-*
-* $Log: ffsizeapo.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:16 mclareni
-* Zebra
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_zebra/pilot.h"
-#if defined(CERNLIB_QMAPO)
- SUBROUTINE FFSIZE (LUN,NWREC,JREC,ISTAT)
-
-C- Get the size of a disk file connected to Fortran unit LUN
-
-%include '/sys/ins/base.ins.ftn'
-%include '/sys/ins/ios.ins.ftn'
-
- INTEGER*2 IDSTRM
-
- INQUIRE (LUN, STRID=IDFOR, ERR=99)
-
- IDSTRM = IDFOR
-
-C-- byte inquiry
-
- NBYTES = IOS_$INQ_BYTE_POS (IDSTRM,IOS_$EOF,ISTAT)
- IF (ISTAT.NE.0) GO TO 41
-
- NWORDS = NBYTES / 4
- JREC = NWORDS / NWREC
- RETURN
-
-C-- record inquiry
-
- 41 NBYTES = IOS_$INQ_REC_POS (IDSTRM,IOS_$EOF,ISTAT)
- IF (ISTAT.NE.0) RETURN
- JREC = NBYTES
- RETURN
-
- 99 ISTAT = -1
- RETURN
- END
-#endif
diff --git a/src/packlib/zebra/qutil/not_cern/fzhydra/fzhyln.F b/src/packlib/zebra/qutil/not_cern/fzhydra/fzhyln.F
deleted file mode 100644
index 8d6f6fe..0000000
--- a/src/packlib/zebra/qutil/not_cern/fzhydra/fzhyln.F
+++ /dev/null
@@ -1,97 +0,0 @@
-*
-* $Id: fzhyln.F,v 1.1.1.1 1996/03/06 10:47:21 mclareni Exp $
-*
-* $Log: fzhyln.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:21 mclareni
-* Zebra
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_zebra/pilot.h"
- SUBROUTINE FZHYLN (LBEGIN,NWORDS,IOFLAG,*)
-
-#include "bankparq.inc"
-#include "bkfoparq.inc"
-#include "dzc1.inc"
-#include "mqsys.inc"
-#include "qequ.inc"
-#include "zmach.inc"
-#include "zunit.inc"
- CHARACTER CHROUT*(*)
- PARAMETER (CHROUT = 'FZHYLN')
-C Bits 17 means integer and bit 18 bit data
- PARAMETER (MBINTS = 17 , MBBITS = 18)
-
-
-
-#include "q_jbit.inc"
-
- IF (LBEGIN.EQ.0.OR.NWORDS.EQ.0) GO TO 999
-
-
- LN = KQS + LBEGIN
- LE = LN + NWORDS
-
- 100 IF (LN.GE.LE) GO TO 999
-
-
- IF (LQ(LN+1).GT.0) GO TO 998
-
- ID = LQ(LN)
- ND = JBYT(LQ(LN+1),1,15)
- NS = JBYT(LQ(LN+1),16,6)
- NL = JBYT(LQ(LN+1),22,9)
-
- DO 110 I=1,NL
- 110 LQ(LN+I) = LQ(LN+I+1)
-
-
- LQ(LN+MBKIOQ) = NL + NBKJMQ
-
- LS = LN + NL + NBKHDQ
- IQWIDH(LS) = ID
- IQWNL(LS) = NL
- IQWNS(LS) = NS
- IQWND(LS) = ND
-
-
- LQLUP(LS) = IQNIL
- LQLORG(LS) = IQNIL
-
-
- IF (NS.GT.0) THEN
- LQ (LS) = LQ(LS-1)
- LQ(LS-1) = 0
- CALL SBYT(0,IQ(LS),19,6)
- ELSE
- LQ(LS) = 0
- ENDIF
-
-
-
-
- IF ((JBIT(IOFLAG,MBBITS).EQ.1).AND.
- X (JBIT(IQ(LS),MBBITS).EQ.1) ) THEN
-C Bit string data
- CALL SBYT(IFOBIQ,LQ(LN+MBKIOQ),JBKIOQ,NBKIOQ)
- ELSEIF ((JBIT(IOFLAG,MBINTS).EQ.1).AND.
- X (JBIT(IQ(LS),MBINTS).EQ.1) ) THEN
-C Integer data
- CALL SBYT(IFOINQ,LQ(LN+MBKIOQ),JBKIOQ,NBKIOQ)
- ELSE
-C Default is floating point data
- CALL SBYT(IFOFLQ,LQ(LN+MBKIOQ),JBKIOQ,NBKIOQ)
- ENDIF
-
-
- LN = LS + ND + NBKCTQ
-
- GO TO 100
-
- 998 WRITE(IQPRNT,
- + '(''0+++ HYDRA banks word 2 ND/NS/NL not negative '',Z8)')
- + LQ(LN+1)
- RETURN 1
-
- 999 RETURN
- END
diff --git a/src/packlib/zebra/qutil/not_cern/fzhydra/fzhyls.F b/src/packlib/zebra/qutil/not_cern/fzhydra/fzhyls.F
deleted file mode 100644
index b333a6c..0000000
--- a/src/packlib/zebra/qutil/not_cern/fzhydra/fzhyls.F
+++ /dev/null
@@ -1,127 +0,0 @@
-*
-* $Id: fzhyls.F,v 1.1.1.1 1996/03/06 10:47:21 mclareni Exp $
-*
-* $Log: fzhyls.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:21 mclareni
-* Zebra
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_zebra/pilot.h"
- SUBROUTINE FZHYLS (LHEAD,*)
-#include "bankparq.inc"
-#include "dzc1.inc"
-#include "zmach.inc"
-#include "zstate.inc"
-#include "zunit.inc"
-#include "mqsys.inc"
-#include "mzcn.inc"
-#include "qequ.inc"
- CHARACTER CHROUT*(*)
- PARAMETER (CHROUT = 'FZHYLS')
-
-#include "q_jbit.inc"
- IF (LHEAD.EQ.0) GO TO 999
-
- LEV = NQOFFS(1) + LQEND(1) + 3
- LEVE = LEV + 1590
- LQ(LEV-2) = 0
- LQ(LEV-1) = 0
- LQ(LEV) = LHEAD
-
- LCUR = LHEAD
- LX = LHEAD
-
- IQWIDN(KQS+LHEAD) = 0
- LQLUP(KQS+LHEAD) = 0
- LQLORG(KQS+LHEAD) = 0
-
-
- 20 LAST = LCUR - IQWNS(KQS+LCUR)
-
-
- 24 IF (LX.LT.LAST) GO TO 41
- LNEW = LQ(KQS+LX)
- LX = LX - 1
- IF (LNEW.EQ.0) GO TO 24
-
- IF (LQLUP(KQS+LNEW).NE.IQNIL) GO TO 24
-
-
- LQ(LEV+1) = LX
- LQ(LEV+2) = LCUR
-
- LEV = LEV + 3
-
- IF (LEV.GT.LEVE) THEN
- WRITE(IQPRNT,
- W '(''0FZHYLS -- ????? '',T40,'' Stack overflow'')')
- NQUSED = NQUSED + 2
- GO TO 998
- ENDIF
-
- LQ(LEV) = LNEW
-
- IF (LCUR.EQ.LX+1) THEN
- IQWIDN(KQS+LNEW) = IQWIDN(KQS+LCUR) + 1
- LQLUP(KQS+LNEW) = LQLUP(KQS+LCUR)
- ELSE
- IQWIDN(KQS+LNEW) = LCUR - LX - 1
- LQLUP(KQS+LNEW) = LCUR
- ENDIF
- LQLORG(KQS+LNEW) = LX+1
-#if defined(CERNLIB_QDEVZE)
- IF (NQDEVZ.NE.0)
- +PRINT 9831, LEV,LCUR,LX+1,LNEW
- 9831 FORMAT (' DEVZE FZHYLS, DOWN. LEV,LCUR,LX+1,LNEW=',6I8)
-#endif
-
-
- 32 LCUR = LNEW
- LNEW = LQ(KQS+LCUR)
- IF (LNEW.EQ.0) GO TO 36
-#if defined(CERNLIB_QDEVZE)
- IF (NQDEVZ.NE.0)
- +PRINT 9833, LCUR,LNEW
- 9833 FORMAT (' DEVZE FZHYLS, ALONG. LCUR,LNEW=',6I8)
-#endif
- IF (LQLUP(KQS+LNEW).NE.IQNIL) GO TO 36
-
- IQWIDN(KQS+LNEW) = IQWIDN(KQS+LCUR) + 1
- LQLUP(KQS+LNEW) = LQLUP(KQS+LCUR)
- LQLORG(KQS+LNEW) = LCUR
- GO TO 32
-
- 36 CONTINUE
- LAST = LCUR - IQWNS(KQS+LCUR)
- LX = LCUR - 1
- GO TO 24
-
-
- 41 LNEW = LCUR
- IF (LCUR.EQ.LQ(LEV)) GO TO 46
- LCUR = LQLORG(KQS+LCUR)
- LX = LCUR - 1
-#if defined(CERNLIB_QDEVZE)
- IF (NQDEVZ.NE.0)
- +PRINT 9841, LCUR,LNEW
- 9841 FORMAT (' DEVZE FZHYLS, BACK. LCUR,LNEW=',6I8)
-#endif
- GO TO 20
-
-
- 46 LEV = LEV - 3
- LX = LQ(LEV+1)
- LCUR = LQ(LEV+2)
-#if defined(CERNLIB_QDEVZE)
- IF (NQDEVZ.NE.0)
- +PRINT 9846, LEV,LCUR,LX
- 9846 FORMAT (' DEVZE FZHYLS, UP. LEV,LCUR,LX=',6I8)
-#endif
- IF (LCUR.NE.0) GO TO 20
-
-
- GO TO 999
- 998 RETURN 1
- 999 RETURN
- END
diff --git a/src/packlib/zebra/qutil/not_cern/fzhydra/qtozeb.F b/src/packlib/zebra/qutil/not_cern/fzhydra/qtozeb.F
deleted file mode 100644
index 619c606..0000000
--- a/src/packlib/zebra/qutil/not_cern/fzhydra/qtozeb.F
+++ /dev/null
@@ -1,203 +0,0 @@
-*
-* $Id: qtozeb.F,v 1.1.1.1 1996/03/06 10:47:21 mclareni Exp $
-*
-* $Log: qtozeb.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:21 mclareni
-* Zebra
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_zebra/pilot.h"
- SUBROUTINE QTOZEB (VECT,LNSTA,MODE)
-
-
-
-
-
-
-
-
-
- COMMON /MQCF/ NQNAME,NQNAMD,NQNAMU, IQSTRU,NQSTRU, IQSYSB,NQSYSB MQCF
- COMMON /MQCMOV/NQSYSS MQCM
- COMMON /MQCM/ NQSYSR,NQSYSL,NQLINK,LQWORG,LQWORK,LQTOL +MQCM
- +, LQSTA,LQEND,LQFIX,NQMAX, NQRESV,NQMEM,LQADR,LQADR2 +MQCM
- COMMON /MQCT/ IQTBIT,IQTVAL,LQTA,LQTB,LQTE,LQMTB,LQMTE,LQMTH MQCT
- +, IQPART,NQFREE +MQCT
- COMMON /QCN/ IQLS,IQID,IQNL,IQNS,IQND,IQFOUL QCN
- COMMON /QBITS/ IQDROP,IQMARK,IQCRIT,IQZIM,IQZIP,IQSYS SQ
- DIMENSION IQUEST(30) +SQ
- DIMENSION LQ(99), IQ(99), Q(99)
- EQUIVALENCE (QUEST(1),IQUEST(1)), (LQUSER(1),LQ(1),IQ(1),Q(1)) +SQ
- COMMON /SQK/ KQMAIN,KQT,KQR,KQJ,KQF,KQZ,KQH(4),KQS(8) +SQ
- COMMON // QUEST(30),LQUSER(7),LQMAIN,LQT,LQR,LQJ,LQF,LQZ +SQ
- +, LQH(4),LQS(6), LQWM,LQWF,LQWZ,LQWSYS(6),LQPRIV(7) +SQ
- +, LQ1,LQ2,LQ3,LQ4,LQ5,LQ6,LQ7,LQSV,LQAN,LQDW,LQUP +SQ
- COMMON /QUEST/ IRET(100)
-
- PARAMETER (NHTOZQ = 7)
-
- DIMENSION VECT(*)
-
-
- 900 CONTINUE
-
- IF (MODE) 98, 11, 41
- 11 LQWORK = LQWORG
- IGARB = 0
-
-
- 12 IF (LQSTA.GE.LQEND) GO TO 93
- LQMTB = LQWORK + 3
- LMO = LQWORK - 3
-
- NDEADW = 0
- NBKLIV = 0
- LAST = 7
- LAT = LQSTA
- LNX = LQSTA
-
-
- 21 LBK = LNX
- CALL QBLOWX (LBK)
- IF (IQFOUL.NE.0) GO TO 91
- LNX = IQLS + IQND + 1
- IF (JBIT(LQ(IQLS),IQDROP).NE.0) GO TO 25
-
-
- IF (LAST.EQ.0) GO TO 22
- LAST = 0
- LMO = LMO + 3
- LQ(LMO) = LBK
-
- 22 NBKLIV = NBKLIV + 1
- LQ(LAT-1) = LBK
- LQ(LAT-2) = LNX
- LQ(LAT-3) = IQNL + 2
- LAT = LAT - 3
- IF (LAT.LT.LMO) GO TO 37
- IF (LNX.LT.LQEND) GO TO 21
- GO TO 31
-
-
- 25 IF (LAST.NE.0) GO TO 26
- LAST = 7
- LQ(LMO+1) = LBK
-
- 26 NDEADW = NDEADW + (LNX-LBK)
- IF (LNX.LT.LQEND) GO TO 21
-
-
- 31 IF (NBKLIV.EQ.0) GO TO 93
-
- IF (LAST.EQ.0) LQ(LMO+1)=LQEND
- LQMTE = LMO - 3
-
- LQ(LAT-1) = LQ(LAT+1) - 7
- LQTB = LAT - 1
-
- LQTA = LMO + 3
- IF (LQTA+3.GE.LQTB) GO TO 37
-
- IRET(1) = 0
- IRET(2) = (LQEND-LQSTA) - NDEADW + NHTOZQ*NBKLIV
- RETURN
-
-
- 37 IF (IGARB.NE.0) GO TO 92
- IGARB = 7
- LSTASV = LQSTA
- CALL MQGARB
- IF (LQSTA.EQ.LSTASV) GO TO 92
- GO TO 12
-
-
- 41 LAT1 = LQTB
- LAT2 = LQSTA - 1
- NWAT = LQSTA - LAT1
- CALL UCOPIV (LQ(LAT1),VECT,NWAT)
- CALL UCOPY (VECT,LQ(LAT1),NWAT)
-
-
- LQTB = LQTA + 3
- LTB = LQTB
- LAT = LAT1
- NREL = LNSTA - LQ(LAT1) - 1
-
-
- 51 LBK = LQ(LAT)
- LNX = LQ(LAT+1)
-
- LQ(LTB) = LBK
- LQ(LTB+1) = LNX
- LQ(LTB+2) = NREL
-
- LTB = LTB + 3
- LAT = LAT + 3
- NREL = NREL + NHTOZQ - (LQ(LAT)-LNX)
- IF (LAT.LT.LAT2) GO TO 51
-
- LQ(LTB) = LQEND
- LQTE = LTB - 3
-
- LQ(LQTB-1) = 7
- LQ(LQTB-2) = LQSTA
-
- CALL MQRELC
-
-
- NW = LQTE+4 - LAT1
- IF (NW.GT.0) CALL UCOPY (VECT,LQ(LAT1),NW)
-
- LTARG = LOCF(VECT(1)) - (LOCF(Q(1)) - 1)
- NREL = LTARG - LQ(LAT1)
-
- LAT = LAT1
-
-
- 61 LBK = LQ(LAT)
- LNX = LQ(LAT+1)
- NW = LQ(LAT+2)
- LST = LBK + NW
- CALL UCOPY (LQ(LBK),LQ(LBK+NREL),NW)
- 64 NREL = NREL + NHTOZQ
-
- NDEADW = LQ(LAT+3) - LNX
- IF (NDEADW.NE.0) GO TO 66
-
-
- NW = (LNX-LST) + LQ(LAT+5)
- CALL UCOPY (LQ(LST),LQ(LST+NREL),NW)
-
- LAT = LAT + 3
- LBK = LQ(LAT)
- LNX = LQ(LAT+1)
- LST = LQ(LAT+2) + LBK
- GO TO 64
-
-
- 66 NW = LNX - LST
- CALL UCOPY (LQ(LST),LQ(LST+NREL),NW)
-
- NREL = NREL - NDEADW
- LAT = LAT + 3
- IF (NDEADW.GE.0) GO TO 61
-
- IRET(1) = 0
- IRET(2) = LQMAIN
- IRET(3) = IQ(LQF)
- GO TO 98
-
-
- 91 IRET(1) = 1
- GO TO 98
-
- 92 IRET(2) = 2
- GO TO 98
-
- 93 IRET(2) = 3
-
- 98 LQSTA = LQEND
- LQMAIN = 0
- 999 RETURN
- END
diff --git a/src/packlib/zebra/qutil/not_cern/fzhydra/zhytoz.F b/src/packlib/zebra/qutil/not_cern/fzhydra/zhytoz.F
deleted file mode 100644
index 52b6edf..0000000
--- a/src/packlib/zebra/qutil/not_cern/fzhydra/zhytoz.F
+++ /dev/null
@@ -1,90 +0,0 @@
-*
-* $Id: zhytoz.F,v 1.1.1.1 1996/03/06 10:47:21 mclareni Exp $
-*
-* $Log: zhytoz.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:21 mclareni
-* Zebra
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_zebra/pilot.h"
- SUBROUTINE ZHYTOZ(IXDIV,IOFLAG,LSTR,*)
-#include "bankparq.inc"
-#include "mqsys.inc"
-#include "qequ.inc"
-#include "zstate.inc"
-#include "zunit.inc"
- CHARACTER CHROUT*(*)
- PARAMETER (CHROUT = 'ZHYTOZ')
-
- CALL MZSDIV(IXDIV,1)
-
- IF (JQDIVI.LE.1.OR.JQDIVI.GT.20) GO TO 998
-
- CALL QTOZEB(0,0,0)
-
- IF (IQUEST(1).NE.0) THEN
- PRINT '('' QTOZEB PROBLEMS IN HYDRA '')'
- GO TO 998
- ENDIF
-
- NHYDRA = IQUEST(2)
-
-
- CALL MZRESV
-
- NQRESV = NQRESV - NHYDRA
-
- IF (NQRESV.LT.0) CALL MZGAR1
-
- MODEDV = IQMODE(KQT+JQDIVI)
-
- IF (MODEDV.EQ.0) THEN
- LBEGIN = LQEND(KQT+JQDIVI)
- ELSE
- LBEGIN = LQSTA(KQT+JQDIVI)-NHYDRA
- ENDIF
-
- CALL QTOZEB(LQ(KQS+LBEGIN),LBEGIN,1)
-
-#if defined(CERNLIB_QDEVZE)
- IF (NQDEVZ.NE.0) WRITE(IQLOG,'(100(6(2X,I7,''/'',I10),/))',ERR=11)
- + (L,LQ(KQS+L),L=LBEGIN,LBEGIN+NHYDRA-1)
- 11 CONTINUE
-#endif
-
- IF (IQUEST(1).NE.0) THEN
- PRINT '('' QTOZEB PROBLEMS IN COPY '')'
- GO TO 998
- ENDIF
-
- LSTR = IQUEST(2)
- IFORM = IQUEST(3)
-
- CALL FZHYLN(LBEGIN,NHYDRA,IOFLAG,*998)
-
- CALL FZHYLS(LSTR,*998)
-
-
- KLSTR = LOCF(LSTR) - LQSTOR
- LQLORG (KQS+LSTR) = KLSTR
-
- IF (MODEDV.EQ.0) THEN
- LQEND(KQT+JQDIVI) = LQEND(KQT+JQDIVI)+NHYDRA
- ELSE
- LQSTA(KQT+JQDIVI) = LBEGIN
- ENDIF
-
-#if defined(CERNLIB_QDEVZE)
- IF(NQDEVZ.NE.0) WRITE(IQLOG,'(100(6(2X,I7,''/'',I10),/))',ERR=12)
- + (L,LQ(KQS+L),L=LBEGIN,LBEGIN+NHYDRA-1)
- 12 CONTINUE
-#endif
- CALL QTOZEB(0,0,-1)
- GO TO 999
-
- 998 CALL QTOZEB(0,0,-1)
- RETURN 1
-
- 999 RETURN
- END
diff --git a/src/packlib/zebra/qutil/not_cern/fzzbook/fzpcat.F b/src/packlib/zebra/qutil/not_cern/fzzbook/fzpcat.F
deleted file mode 100644
index 14aa691..0000000
--- a/src/packlib/zebra/qutil/not_cern/fzzbook/fzpcat.F
+++ /dev/null
@@ -1,87 +0,0 @@
-*
-* $Id: fzpcat.F,v 1.1.1.1 1996/03/06 10:47:21 mclareni Exp $
-*
-* $Log: fzpcat.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:21 mclareni
-* Zebra
-*
-*
-* ----------------------------------------------------------
-#include "sys/CERNLIB_machine.h"
-#include "_zebra/pilot.h"
- SUBROUTINE FZPCAT (IXDIV,LUN,LCAT,IDCAT,IERR)
-#include "dzc1.inc"
-#include "mqsys.inc"
-#include "qequ.inc"
-#include "mzcn.inc"
-#include "bankparq.inc"
-#include "bkfoparq.inc"
-
- CHARACTER CHROUT*(*)
- PARAMETER (CHROUT = 'FZPCAT')
-
-#include "q_jbit.inc"
-
-#if (defined(CERNLIB_DEBUGON))&&(defined(CERNLIB_VFORT))
-#include "debugvf2.inc"
-#endif
- IERR = 0
-
- CALL MZSDIV(IXDIV,NCHEKQ)
- LBUF = LQSYSS(KQT+MSYSPQ)
- IF (LBUF.NE.0) THEN
-
- CALL MZCHLS(NCHEKQ,LBUF)
- IF (IQFOUL.NE.0) THEN
- IERR = 1000*IQFOUL
- GO TO 999
- ENDIF
- NUNIT = IQWND(KQS+LBUF)
- IBUF = IUCOMP (LUN,IQ(KQS+LBUF+1),NUNIT)
- IF (IBUF.NE.0) THEN
- LBUF = LQ(KQS+LBUF-IBUF)+1
- IF (IQ(KQS+LBUF).EQ.1) THEN
- IDCAT = IQ(KQS+LBUF+1)
- GO TO 100
- ENDIF
- ENDIF
- ENDIF
-
-
- CALL FZPNXT (IXDIV,LUN,IDCAT,IERR)
- IF (IERR.NE.0.AND.IERR.NE.6) GO TO 999
-
-
- 100 CALL EPGETW (LUN,20,IW20,IERR)
- IF (IERR.NE.0) GO TO 999
-
- CALL EPGETW (LUN,21,IW21,IERR)
- IF (IERR.NE.0) GO TO 999
-
- NKEY = (IW20 - IW21) / 2
-
-
- CALL MZCHLS(NCHEKQ,LCAT)
- IF (IQFOUL.EQ.0) THEN
- NPUSH = NKEY - IQWND(KQS+LCAT)
- CALL MZPUSH(IXDIV,LCAT,0,NPUSH,'I')
- ELSE
- CALL MZBOOK(IXDIV,LCAT,LCAT,1,'*CAT',0,0,NKEY,IFOINQ,0)
- ENDIF
-
-
- LBUF = LQSYSS(KQT+MSYSPQ)
- NUNIT = IQWND(KQS+LBUF)
- IBUF = IUCOMP (LUN,IQ(KQS+LBUF+1),NUNIT)
- LBUF = LQ(KQS+LBUF-IBUF)+3
-
-
- CALL EPFRD (LUN,13,NW,IQ(KQS+LCAT+1),IQ(KQS+LBUF),IERR)
- IF (IERR.NE.0) GO TO 999
- LF = LBUF - 2
- IQ(KQS+LF) = 2
- CALL ZFRIBM (IQ(KQS+LCAT+1),NKEY,2)
-
- 998 CONTINUE
- 999 RETURN
- END
diff --git a/src/packlib/zebra/qutil/not_cern/fzzbook/fzpdef.F b/src/packlib/zebra/qutil/not_cern/fzzbook/fzpdef.F
deleted file mode 100644
index 5af681c..0000000
--- a/src/packlib/zebra/qutil/not_cern/fzzbook/fzpdef.F
+++ /dev/null
@@ -1,77 +0,0 @@
-*
-* $Id: fzpdef.F,v 1.1.1.1 1996/03/06 10:47:21 mclareni Exp $
-*
-* $Log: fzpdef.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:21 mclareni
-* Zebra
-*
-*
-* ----------------------------------------------------------
-#include "sys/CERNLIB_machine.h"
-#include "_zebra/pilot.h"
- SUBROUTINE FZPDEF(IXSTOR,LUN,NREC,IERR)
-#include "dzc1.inc"
-#include "mqsys.inc"
-#include "qequ.inc"
-#include "mzcn.inc"
-#include "zmach.inc"
-#include "bankparq.inc"
-#include "bkfoparq.inc"
-
- CHARACTER CHROUT*(*)
- PARAMETER (CHROUT = 'FZPDEF')
-
-#include "q_jbit.inc"
-
-#if (defined(CERNLIB_DEBUGON))&&(defined(CERNLIB_VFORT))
-#include "debugvf2.inc"
-#endif
- IERR = 0
-
- CALL MZSDIV(IXSTOR,NCHEKQ)
-
-
-
- LBUF = LQSYSS(KQT+MSYSPQ)
- IF (LBUF.NE.0) THEN
- CALL MZCHLS(NCHEKQ,LBUF)
- IF (IQFOUL.NE.0) THEN
- IERR = 1000*IQFOUL
- GO TO 999
- ENDIF
- ELSE
- CALL EPINIT
- CALL MZBOOK(IXSTOR+JQDVSY,LBUF,LQSYSS(KQT+MSYSPQ),1,
- + '*FZP',1,1,1,IFOINQ,0 )
- ENDIF
-
- NUNIT = IQWND(KQS+LBUF)
- IBUF = IUCOMP (LUN,IQ(KQS+LBUF+1),NUNIT)
- IF (IBUF.NE.0) THEN
- CALL MZDROP(IXSTOR,LBUF,' ')
- ILUN = IBUF
- ELSE
- DO 100 ILUN=1,NUNIT
- IF (LQ(KQS+LBUF-ILUN).EQ.0) GO TO 200
- 100 CONTINUE
- CALL MZPUSH(IXSTOR,LBUF,1,1,'I')
- ILUN = NUNIT+1
- ENDIF
-
-
- 200 NR = NREC
- IF (NR.LE.0) NR = 1800
- NW = (16 * NR - 1) / NQBITW + 3
- IF(NREC.GT.0) CALL EPSETW(LUN,1,LR,IERR)
- IF (IERR.NE.0) GO TO 999
- CALL EPSETW(LUN,5,-1,IERR)
- IF (IERR.NE.0) GO TO 999
- CALL EPSETW(LUN,6,-1,IERR)
- IF (IERR.NE.0) GO TO 999
- IQ(KQS+LBUF+ILUN) = LUN
-
- CALL MZBOOK(IXSTOR+JQDVSY,LBUF,LBUF,-ILUN,'*LUN',0,0,NW,IFOBIQ,0)
-
- 998 CONTINUE
- 999 RETURN
- END
diff --git a/src/packlib/zebra/qutil/not_cern/fzzbook/fzpend.F b/src/packlib/zebra/qutil/not_cern/fzzbook/fzpend.F
deleted file mode 100644
index ab1e699..0000000
--- a/src/packlib/zebra/qutil/not_cern/fzzbook/fzpend.F
+++ /dev/null
@@ -1,49 +0,0 @@
-*
-* $Id: fzpend.F,v 1.1.1.1 1996/03/06 10:47:21 mclareni Exp $
-*
-* $Log: fzpend.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:21 mclareni
-* Zebra
-*
-*
-* ----------------------------------------------------------
-#include "sys/CERNLIB_machine.h"
-#include "_zebra/pilot.h"
- SUBROUTINE FZPEND(IXSTOR,LUN,IERR)
-#include "dzc1.inc"
-#include "mqsys.inc"
-#include "qequ.inc"
-#include "mzcn.inc"
-#include "bankparq.inc"
-
- CHARACTER CHROUT*(*)
- PARAMETER (CHROUT = 'FZPEND')
-
-#if (defined(CERNLIB_DEBUGON))&&(defined(CERNLIB_VFORT))
-#include "debugvf2.inc"
-#endif
- IERR = 0
-
- CALL MZSDIV(IXSTOR,NCHEKQ)
-
-
- LBUF = LQSYSS(KQT+MSYSPQ)
-
- CALL MZCHLS(NCHEKQ,LBUF)
- IF (IQFOUL.NE.0) THEN
- IERR = 1000*IQFOUL
- GO TO 999
- ENDIF
-
- NUNIT = IQWND(KQS+LBUF)
-
- DO 100 ILUN = 1,NUNIT
- IF (LUN.EQ.0.OR.LUN.EQ.IQ(KQS+LBUF+ILUN)) THEN
- CALL MZDROP(IXSTOR,LQ(KQS+LBUF-ILUN),' ')
- IQ(KQS+LBUF+ILUN) = 0
- ENDIF
- 100 CONTINUE
-
- 998 CONTINUE
- 999 RETURN
- END
diff --git a/src/packlib/zebra/qutil/not_cern/fzzbook/fzpfor.F b/src/packlib/zebra/qutil/not_cern/fzzbook/fzpfor.F
deleted file mode 100644
index e3283f6..0000000
--- a/src/packlib/zebra/qutil/not_cern/fzzbook/fzpfor.F
+++ /dev/null
@@ -1,79 +0,0 @@
-*
-* $Id: fzpfor.F,v 1.1.1.1 1996/03/06 10:47:21 mclareni Exp $
-*
-* $Log: fzpfor.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:21 mclareni
-* Zebra
-*
-*
-* ----------------------------------------------------------
-#include "sys/CERNLIB_machine.h"
-#include "_zebra/pilot.h"
- SUBROUTINE FZPFOR(IOFORM,NOFORM,ICFORM,NCFORM)
-#include "dzc1.inc"
-#include "zunit.inc"
-#include "bkfoparq.inc"
-
- CHARACTER CHROUT*(*)
- INTEGER ICFORM(*),IOFORM(*)
- PARAMETER (LENLOC=200)
- CHARACTER CLOC*(LENLOC),CTYP(4)*1
- PARAMETER (CHROUT = 'FZPFOR')
-
- DATA CTYP/'B','I','F','H'/
-#if (defined(CERNLIB_DEBUGON))&&(defined(CERNLIB_VFORT))
-#include "debugvf2.inc"
-#endif
-
- CLOC = ' '
- NCH = 0
- NREP = 0
-
- DO 100 I=1,NOFORM
- NF = IOFORM(I)/10000
- N = IOFORM(I)-10000*NF
- IF (NF.EQ.0) THEN
- IF (N.GT.0) THEN
- NREP = N
- IREP = NCH + 1
- ELSE
- NCH=NCH+1
- CLOC(NCH:) = '/'
- NREP = 0
- NCH=NCH+1
- ENDIF
- ELSEIF (NF.GT.0.AND.NF.LT.5) THEN
- WRITE (CLOC(NCH+1:),'(I4,A)') N,CTYP(NF)
- NCH=NCH+5
- ELSE
- IEND = NCH
- DO 10 J=1,NREP-1
- CLOC(NCH+1:) = CLOC(IREP:IEND)
- NCH = NCH + IEND - IREP + 1
- IF (NCH.GE.LENLOC) THEN
- WRITE(IQPRNT,'(''0FZPFOR Format too long '',/,
- X 1X,A,/,'' Bank treated as bit string'')')
- X ' '//CLOC(1:NCH)
- ICFORM(1) = IFOBIQ
- NCFORM = 1
- GO TO 999
- ENDIF
- 10 CONTINUE
- ENDIF
- 100 CONTINUE
-
-
- I = 1
- 20 IF (I.GT.NCH) GO TO 30
- IF (CLOC(I:I).EQ.' ') THEN
- CLOC(I:NCH-1) = CLOC(I+1:NCH)
- NCH = NCH - 1
- ENDIF
- I = I + 1
- GO TO 20
-
-
- 30 CALL MZIOCH(ICFORM,NCFORM,CLOC(1:NCH))
-
- 999 RETURN
- END
diff --git a/src/packlib/zebra/qutil/not_cern/fzzbook/fzpin.F b/src/packlib/zebra/qutil/not_cern/fzzbook/fzpin.F
deleted file mode 100644
index 32ab930..0000000
--- a/src/packlib/zebra/qutil/not_cern/fzzbook/fzpin.F
+++ /dev/null
@@ -1,241 +0,0 @@
-*
-* $Id: fzpin.F,v 1.1.1.1 1996/03/06 10:47:21 mclareni Exp $
-*
-* $Log: fzpin.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:21 mclareni
-* Zebra
-*
-*
-* -----------------------------------------------------------
-#include "sys/CERNLIB_machine.h"
-#include "_zebra/pilot.h"
- SUBROUTINE FZPIN (IXDIV,LUN,KEYS,NKEY,IDCAT,IERR)
-#include "dzc1.inc"
-#include "mqsys.inc"
-#include "qequ.inc"
-#include "mzcn.inc"
-#include "zmach.inc"
-#include "bankparq.inc"
-
- COMMON/ZCFORM/NLFORM,NLSYST,LD(10),L
-
- CHARACTER CHROUT*(*)
- PARAMETER (CHROUT = 'FZPIN ')
- CHARACTER CNUM*40,CNAME*4,CNAMEL*4,CMISS*4,CBLANK*4
-
- PARAMETER (MXFORQ = 16)
- INTEGER KEYS(*),ICFORM(MXFORQ),IFORM(50)
- INTEGER IH(60) , IL(10) , IM(10) , MODSEP(8)
-
- DATA MODSEP/11,12,13,13,13,12,13,13/
- DATA CMISS /'****'/,CBLANK/' '/
- DATA CNUM/' 1234567890ABCDEFGHIJKLMNOPQRSTUVWXYZ*+-'/
-
- IERR = 0
- CNAMEL = CBLANK
- NWFORL = 0
-
- CALL MZSDIV(IXDIV,1)
- JDIVI = JQDIVI
-
- CALL MZLINT(IXDIV,'/ZCFORM/',NLFORM,LD(1),L)
-
-
- LBUF = LQSYSS(KQT+MSYSPQ)
-
- CALL MZCHLS(NCHEKQ,LBUF)
- IF (IQFOUL.NE.0) GO TO 10
-
- NUNIT = IQWND(KQS+LBUF)
- IBUF = IUCOMP (LUN,IQ(KQS+LBUF+1),NUNIT)
-
- IF (IBUF.EQ.0) THEN
- IERR = 900
- GO TO 180
- ENDIF
-
-
- LBUF = LQ(KQS+LBUF-IBUF) + 3
- LASOPD = IQ(KQS+LBUF-2)
-
- IF (LASOPD.EQ.0) GO TO 10
- IF (LASOPD.EQ.3) GO TO 10
-
- IDCAT = IQ(KQS+LBUF-1)
- GO TO 20
-
-
- 10 CALL FZPNXT (IXDIV,LUN,IDCAT,IERR)
- IF (IERR.NE.0.AND.IERR.NE.6) GO TO 180
-
-
- 20 IF(JDIVI.NE.0) THEN
- CALL MZGARB(IXDIV,0)
- ELSE
- CALL MZGARB(IXDIV+2,0)
- ENDIF
-
-
- 50 LBUF = LQSYSS(KQT+MSYSPQ)
- LBUF = LQ(KQS+LBUF-IBUF) + 3
-
- CALL EPFHDR (LUN,7,IH,IQ(KQS+LBUF),IERR)
- IF (IERR.NE.0.AND.IERR.NE.6) GO TO 180
-
- 60 IF (IH(2).EQ.4) GO TO 170
- IF (IH(2).NE.2) GO TO 50
- IF (NKEY.LE.0) GO TO 50
-
-
- CALL EPFRD (LUN,13,NW,IH,IQ(KQS+LBUF),IERR)
- IF (IERR.NE.0) GO TO 180
- CALL ZFRIBM(IH,NW,2)
-
- KEY = IH(1)
- IKEY = IUCOMP (KEY,KEYS,NKEY)
- IF(IKEY.EQ.0) GO TO 50
-
- CALL FZPLOC (IXDIV,KEY,NID,NMEMB,ICODE)
- IF (NID.EQ.0) GO TO 50
- IF (NMEMB.EQ.0) GO TO 50
-
- ICODE = MOD (IH(2),10)
- MODEP = MODSEP(ICODE + 1)
- NMB = 0
-
- 70 NST = 1
- LD(1) = NID + NMB
- IL(1) = 2
- IM(1) = 1
-
-
- 80 LBUF = LQSYSS(KQT+MSYSPQ)
- LBUF = LQ(KQS+LBUF-IBUF) + 3
-
- CALL EPFHDR (LUN,60,IH,IQ(KQS+LBUF),IERR)
- IF (IERR.NE.0.AND.IERR.NE.6) GO TO 180
- IF (IH(2).NE.5) GO TO 83
-
-
- NMSS = IH(4)
- IF (NST.NE.1) GO TO 82
- NMB = NMB + NMSS
- IF (NMB.GE.NMEMB) GO TO 50
- GO TO 70
- 82 IL(NST) = IL(NST) - NMSS
- IF (IL(NST).GT.0) GO TO 80
- NST = NST - 1
- GO TO 80
- 83 IF (IH(2).NE.3) GO TO 60
-
-
- NWH = IH(3)
- NDATA = IH(1) - IH(3)
-
- NWFOR = 0
- IF (NWH.GT.7) THEN
- NWFOR = IH(NWH)
- NWH = NWH-NWFOR-1
-
- ENDIF
-
- ISIT = NWH - 2
- IF (ISIT.GT.2) ISIT = ISIT - 1
-
- GO TO (84,85,86,87), ISIT
-
- 84 NLINKS = 0
- CNAME = CBLANK
- NUMB = 0
- GO TO 89
-
- 85 NLINKS = IH(4)
- CNAME = CBLANK
- NUMB = 0
- GO TO 89
-
- 86 NLINKS = 0
- NUMB = IH(6)
- INDEX = 4
- GO TO 88
-
- 87 NLINKS = IH(4)
- NUMB = IH(7)
- INDEX = 5
- 88 J1 = MOD(IH(INDEX),256)
- J2 = MOD(IH(INDEX)/256,256)
- J3 = MOD(IH(INDEX+1),256)
- J4 = MOD(IH(INDEX+1)/256,256)
- CNAME = CNUM(J1:J1)//CNUM(J2:J2)//CNUM(J3:J3)//CNUM(J4:J4)
-
- IF (CNAME.EQ.CMISS) GO TO 130
-
- 89 IF(NWFOR.NE.0) THEN
- NCFORM = MXFORQ
- CALL UCOPY(IH(NWH+1),IFORM,NWFOR)
- CALL FZPFOR(IFORM,NWFOR,ICFORM,NCFORM)
- NWFORL = NWFOR
- ELSEIF(CNAME.NE.CNAMEL) THEN
- NWFORL = 0
- ENDIF
-
- IF (ICODE.EQ.1) GO TO 100
- IF (ICODE.EQ.5) GO TO 100
- IF (ICODE.EQ.0) GO TO 90
-
- NDATA = NDATA / 2
- GO TO 100
-
- 90 NDATA = (NDATA*16-1) / NQBITW + 1
-
- 100 JB = - IM(NST) + IL(NST) - 1
- IF (JB.EQ.0) THEN
- IF (NST.NE.1) CALL ZFATAM('FZPIN tree error. ')
- CALL MZBOOK
- X (IXDIV,L,LQ(LD(1)+KQS),1,CNAME,NLINKS,NLINKS,NDATA,ICFORM,0)
- LD(1) = L
- ELSE
- CALL MZBOOK
- X (IXDIV,L,LD(NST),JB,CNAME,NLINKS,NLINKS,NDATA,ICFORM,0)
- ENDIF
- LBUF = LQSYSS(KQT+MSYSPQ)
- LBUF = LQ(KQS+LBUF-IBUF) + 3
- CALL EPFRD (LUN,MODEP,NW,IQ(KQS+L+1),IQ(KQS+LBUF),IERR)
- IF (IERR.NE.0) GO TO 180
- IF (ICODE.EQ.0) GO TO 130
-
- IF (NDATA.GT.0) THEN
- IF(NWFORL.EQ.0) THEN
- IF (ICODE.NE.5) CALL ZFRIBM (IQ(KQS+L+1),NDATA,ICODE)
- ELSE
- CALL ZFCONV(IFORM,NWFOR,IQ(KQS+L+1),NDATA,0)
- ENDIF
- ENDIF
-
- 130 CNAMEL = CNAME
- IL(NST) = IL(NST) - 1
- IF (IL(NST).NE.0) GO TO 140
-
- NST = NST - 1
-
- 140 IF (NLINKS.NE.0) GO TO 150
- IF (NST.NE.1) GO TO 80
- GO TO 160
-
- 150 NST = NST + 1
- LD(NST) = L
- IL(NST) = NLINKS
- IM(NST) = NLINKS
- GO TO 80
-
- 160 NMB = NMB + 1
- IF (NMB.GE.NMEMB) GO TO 50
- GO TO 70
- 170 JF = LBUF - 2
- IQ(KQS+JF) = 3
-
- 180 NLFORM = 0
-
- 998 CONTINUE
- 999 RETURN
- END
diff --git a/src/packlib/zebra/qutil/not_cern/fzzbook/fzpkey.F b/src/packlib/zebra/qutil/not_cern/fzzbook/fzpkey.F
deleted file mode 100644
index 1045578..0000000
--- a/src/packlib/zebra/qutil/not_cern/fzzbook/fzpkey.F
+++ /dev/null
@@ -1,131 +0,0 @@
-*
-* $Id: fzpkey.F,v 1.1.1.1 1996/03/06 10:47:21 mclareni Exp $
-*
-* $Log: fzpkey.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:21 mclareni
-* Zebra
-*
-*
-* ----------------------------------------------------------
-#include "sys/CERNLIB_machine.h"
-#include "_zebra/pilot.h"
- SUBROUTINE FZPKEY(IXSTOR,LBANK,KEYI,NELEM,MODE,IERR)
-#include "dzc1.inc"
-#include "mqsys.inc"
-#include "qequ.inc"
-#include "mzcn.inc"
-#include "zmach.inc"
-#include "bankparq.inc"
-#include "bkfoparq.inc"
-
- COMMON/LZPKEY/NZPKEY,NZPSYS,LEPK,LKEY,LNID,LNEL,LCOD
-
- INTEGER LBANK(*)
- CHARACTER CHROUT*(*)
- PARAMETER (CHROUT = 'FZPKEY')
- DATA IFIRST/0/
-
-#if (defined(CERNLIB_DEBUGON))&&(defined(CERNLIB_VFORT))
-#include "debugvf2.inc"
-#endif
- IERR = 0
- KEY = KEYI
-
- CALL MZSDIV(IXSTOR,0)
-
- CALL MZLINT(IXSTOR,'/LZPKEY/',NZPKEY,LEPK,LCOD)
-
- IF (IFIRST.NE.0) THEN
- LEPK = LQSYSS(KQT+MSYSKQ)
- CALL MZCHLS(NCHEKQ,LEPK)
- IF (IQFOUL.NE.0) THEN
- IERR = 1000*IQFOUL
- GO TO 990
- ENDIF
- LKEY = LQ(KQS+LEPK-1)
- LNID = LQ(KQS+LEPK-2)
- LNEL = LQ(KQS+LEPK-3)
- LCOD = LQ(KQS+LEPK-4)
- LOC = 0
- ELSE
- CALL MZBOOK(IXSTOR+JQDVSY,LEPK,LQSYSS(KQT+MSYSKQ),1,
- + '*EPK',4,4,0,0,0 )
- CALL MZBOOK(IXSTOR+JQDVSY,LKEY,LEPK,-1,'*KEY',0,0,1,IFOINQ,0)
- CALL MZBOOK(IXSTOR+JQDVSY,LNID,LEPK,-2,'*NID',0,0,1,IFOINQ,0)
- CALL MZBOOK(IXSTOR+JQDVSY,LNEL,LEPK,-3,'*NEL',0,0,1,IFOINQ,0)
- CALL MZBOOK(IXSTOR+JQDVSY,LCOD,LEPK,-4,'*COD',0,0,1,IFOINQ,0)
- IFIRST = 1
- LOC = 1
- ENDIF
- NKEY = IQWND(KQS+LKEY)
-
- IF (NKEY.EQ.0) GO TO 20
- IF (LOC.NE.0) GO TO 20
-
-
- IUP = NKEY + 1
- IDOWN = 0
-
- 11 IF (IUP-IDOWN.LE.1) GO TO 14
- IMEAN = (IUP+IDOWN) / 2
- LOC = IMEAN
- IF (KEY-IQ(KQS+LKEY+LOC)) 12,20,13
- 12 IUP = IMEAN
- GO TO 11
- 13 IDOWN = IMEAN
- LOC = LOC + 1
- GO TO 11
- 14 LOC = -LOC
-
-
- 20 IF (NELEM.LT.0) GO TO 50
- IF (LOC.GT.0) GO TO 40
-
-
- LOC = -LOC
- CALL MZPUSH(IXSTOR,LKEY,0,1,'I')
- CALL MZPUSH(IXSTOR,LNID,0,1,'I')
- CALL MZPUSH(IXSTOR,LNEL,0,1,'I')
- CALL MZPUSH(IXSTOR,LCOD,0,1,'I')
- NCOPY = NKEY - LOC + 1
- IF (NCOPY.LE.0) GO TO 40
-
-
- DO 30 I=1,NCOPY
- J = LOC+NCOPY-I
- IQ(KQS+LKEY+J+1) = IQ(KQS+LKEY+J)
- IQ(KQS+LNID+J+1) = IQ(KQS+LNID+J)
- IQ(KQS+LNEL+J+1) = IQ(KQS+LNEL+J)
- IQ(KQS+LCOD+J+1) = IQ(KQS+LCOD+J)
- 30 CONTINUE
-
-
- 40 IQ(KQS+LKEY+LOC) = KEY
- IQ(KQS+LNID+LOC) = LOCF(LBANK(1)) - LQSTOR
- IQ(KQS+LNEL+LOC) = NELEM
- IQ(KQS+LCOD+LOC) = MODE
- GO TO 990
-
-
- 50 IF (NKEY.EQ.0) GO TO 990
- IF (LOC.LE.0) GO TO 990
-
- NCOPY = NKEY - LOC
- IF (NCOPY.LE.0) GO TO 60
-
- DO 55 I=1,NCOPY
- J = LOC+I
- IQ(KQS+LKEY+J-1) = IQ(KQS+LKEY+J)
- IQ(KQS+LNID+J-1) = IQ(KQS+LNID+J)
- IQ(KQS+LNEL+J-1) = IQ(KQS+LNEL+J)
- IQ(KQS+LCOD+J-1) = IQ(KQS+LCOD+J)
- 55 CONTINUE
-
- 60 CALL MZPUSH(IXSTOR,LKEY,0,-1,'I')
- CALL MZPUSH(IXSTOR,LNID,0,-1,'I')
- CALL MZPUSH(IXSTOR,LNEL,0,-1,'I')
- CALL MZPUSH(IXSTOR,LCOD,0,-1,'I')
-
- 990 NZPKEY = 0
- 999 RETURN
- END
diff --git a/src/packlib/zebra/qutil/not_cern/fzzbook/fzploc.F b/src/packlib/zebra/qutil/not_cern/fzzbook/fzploc.F
deleted file mode 100644
index 8361ad7..0000000
--- a/src/packlib/zebra/qutil/not_cern/fzzbook/fzploc.F
+++ /dev/null
@@ -1,64 +0,0 @@
-*
-* $Id: fzploc.F,v 1.1.1.1 1996/03/06 10:47:21 mclareni Exp $
-*
-* $Log: fzploc.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:21 mclareni
-* Zebra
-*
-*
-* ----------------------------------------------------------
-#include "sys/CERNLIB_machine.h"
-#include "_zebra/pilot.h"
- SUBROUTINE FZPLOC (IXSTOR,KEY,LOCID,NMEMBS,MODE)
-#include "dzc1.inc"
-#include "mqsys.inc"
-#include "qequ.inc"
-#include "mzcn.inc"
-#include "bankparq.inc"
-
- CHARACTER CHROUT*(*)
- PARAMETER (CHROUT = 'FZPLOC')
-
-#if (defined(CERNLIB_DEBUGON))&&(defined(CERNLIB_VFORT))
-#include "debugvf2.inc"
-#endif
-
- CALL MZSDIV(IXSTOR,0)
-
- LEPK = LQSYSS(KQT+MSYSKQ)
- CALL MZCHLS(NCHEKQ,LEPK)
- IF (IQFOUL.NE.0) THEN
- IERR = 1000*IQFOUL
- GO TO 999
- ENDIF
-
- LOCID = 0
- LOCID = 0
-
- LKEY = LQ(KQS+LEPK-1)
- NKEY = IQWND(KQS+LKEY)
-
-
- IKEY = 0
- IUP = NKEY + 1
- IDOWN = 0
-
- 10 IF (IUP-IDOWN.LE.1) GO TO 999
- IMEAN = (IUP+IDOWN) / 2
- IKEY = IMEAN
- IF (KEY-IQ(KQS+LKEY+IKEY)) 20,40,30
- 20 IUP = IMEAN
- GO TO 10
- 30 IDOWN = IMEAN
- IKEY = IKEY+ 1
- GO TO 10
- 40 LNID = LQ(KQS+LEPK-2)
- LNEL = LQ(KQS+LEPK-3)
- LCOD = LQ(KQS+LEPK-4)
- LOCID = IQ(KQS+LNID+IKEY)
- NMEMBS = IQ(KQS+LNEL+IKEY)
- MODE = IQ(KQS+LCOD+IKEY)
-
- 998 CONTINUE
- 999 RETURN
- END
diff --git a/src/packlib/zebra/qutil/not_cern/fzzbook/fzpnxt.F b/src/packlib/zebra/qutil/not_cern/fzzbook/fzpnxt.F
deleted file mode 100644
index 97a13cb..0000000
--- a/src/packlib/zebra/qutil/not_cern/fzzbook/fzpnxt.F
+++ /dev/null
@@ -1,66 +0,0 @@
-*
-* $Id: fzpnxt.F,v 1.1.1.1 1996/03/06 10:47:21 mclareni Exp $
-*
-* $Log: fzpnxt.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:21 mclareni
-* Zebra
-*
-*
-* ----------------------------------------------------------
-#include "sys/CERNLIB_machine.h"
-#include "_zebra/pilot.h"
- SUBROUTINE FZPNXT (IXSTOR,LUN,IDCAT,IERR)
-#include "dzc1.inc"
-#include "mqsys.inc"
-#include "qequ.inc"
-#include "mzcn.inc"
-#include "bankparq.inc"
-
- INTEGER IH(4)
- CHARACTER CHROUT*(*)
- PARAMETER (CHROUT = 'FZPNXT')
-
-#include "q_jbit.inc"
-
-#if (defined(CERNLIB_DEBUGON))&&(defined(CERNLIB_VFORT))
-#include "debugvf2.inc"
-#endif
- IERR = 0
-
- CALL MZSDIV(IXSTOR,NCHEKQ)
-
-
- LBUF = LQSYSS(KQT+MSYSPQ)
-
- CALL MZCHLS(NCHEKQ,LBUF)
- IF (IQFOUL.NE.0) THEN
- IERR = 1000*IQFOUL
- GO TO 999
- ENDIF
- NUNIT = IQWND(KQS+LBUF)
- IBUF = IUCOMP (LUN,IQ(KQS+LBUF+1),NUNIT)
- IF (IBUF.EQ.0) THEN
- IERR = 900
- GO TO 999
- ELSE
- LBUF = LQ(KQS+LBUF-IBUF)
- CALL MZCHLS(NCHEKQ,LBUF)
- IF (IQFOUL.NE.0) THEN
- IERR = 1000*IQFOUL
- GO TO 999
- ENDIF
- ENDIF
-
-
- 100 CALL EPFHDR (LUN,4,IH,IQ(KQS+LBUF+3),IERR)
- IF (IERR.NE.0.AND.IERR.NE.6) GO TO 999
- IF (IH(2).NE.1) GO TO 100
-
- IDCAT = IH(4)
- LF = KQS+LBUF+1
- IQ(LF) = 1
- IQ(LF+1) = IDCAT
-
- 998 CONTINUE
- 999 RETURN
- END
diff --git a/src/packlib/zebra/qutil/not_cern/os9/fcomm b/src/packlib/zebra/qutil/not_cern/os9/fcomm
deleted file mode 100644
index c6af520..0000000
--- a/src/packlib/zebra/qutil/not_cern/os9/fcomm
+++ /dev/null
@@ -1,145 +0,0 @@
-*
-* $Id: fcomm,v 1.1.1.1 1996/03/06 10:47:16 mclareni Exp $
-*
-* $Log: fcomm,v $
-* Revision 1.1.1.1 1996/03/06 10:47:16 mclareni
-* Zebra
-*
-*
-* Fortran COMMONs for OS9
-* This directory was created from zebra.car patch fcomm
- SUBROUTINE ZBCD_NOOP
-#include "zbcd.inc"
- END
- SUBROUTINE ZBCDCH_NOOP
-#include "zbcdch.inc"
- END
- SUBROUTINE ZCETA_NOOP
-#include "zceta.inc"
- END
- SUBROUTINE ZHEADP_NOOP
-#include "zheadp.inc"
- END
- SUBROUTINE ZKRAKCC_NOOP
-#include "zkrakcc.inc"
- END
- SUBROUTINE ZLIMIT_NOOP
-#include "zlimit.inc"
- END
- SUBROUTINE ZMACH_NOOP
-#include "zmach.inc"
- END
- SUBROUTINE ZNATUR_NOOP
-#include "znatur.inc"
- END
- SUBROUTINE ZSTATE_NOOP
-#include "zstate.inc"
- END
- SUBROUTINE ZUNIT_NOOP
-#include "zunit.inc"
- END
- SUBROUTINE ZVFAUT_NOOP
-#include "zvfaut.inc"
- END
- SUBROUTINE QUEST_NOOP
-#include "quest.inc"
- END
- SUBROUTINE MZCA_NOOP
-#include "mzca.inc"
- END
- SUBROUTINE MZCB_NOOP
-#include "mzcb.inc"
- END
- SUBROUTINE MZCC_NOOP
-#include "mzcc.inc"
- END
- SUBROUTINE MZCL_NOOP
-#include "mzcl.inc"
- END
- SUBROUTINE MZCN_NOOP
-#include "mzcn.inc"
- END
- SUBROUTINE MZCT_NOOP
-#include "mzct.inc"
- END
- SUBROUTINE MZCWK_NOOP
-#include "mzcwk.inc"
- END
- SUBROUTINE MZIOC_NOOP
-#include "mzioc.inc"
- END
- SUBROUTINE ZVFWKC_NOOP
-#include "zvfwkc.inc"
- END
- SUBROUTINE ZEBQ_NOOP
-#include "zebq.inc"
- END
- SUBROUTINE FZSTAT_NOOP
-#include "fzstat.inc"
- END
- SUBROUTINE FZCF_NOOP
-#include "fzcf.inc"
- END
- SUBROUTINE FZCI_NOOP
-#include "fzci.inc"
- END
- SUBROUTINE FZCX_NOOP
-#include "fzcx.inc"
- END
- SUBROUTINE FZCSEG_NOOP
-#include "fzcseg.inc"
- END
- SUBROUTINE FZCOCC_NOOP
-#include "fzcocc.inc"
- END
- SUBROUTINE FZHCI_NOOP
-#include "fzhci.inc"
- END
- SUBROUTINE JZUC_NOOP
-#include "jzuc.inc"
- END
- SUBROUTINE JZC_NOOP
-#include "jzc.inc"
- END
- SUBROUTINE TZUC_NOOP
-#include "tzuc.inc"
- END
- SUBROUTINE TZC1_NOOP
-#include "tzc1.inc"
- END
- SUBROUTINE RZBUFF_NOOP
-#include "rzbuff.inc"
- END
- SUBROUTINE RZCLUN_NOOP
-#include "rzclun.inc"
- END
- SUBROUTINE RZCH_NOOP
-#include "rzch.inc"
- END
- SUBROUTINE RZDIR_NOOP
-#include "rzdir.inc"
- END
- SUBROUTINE RZCKEY_NOOP
-#include "rzckey.inc"
- END
- SUBROUTINE RZCOUT_NOOP
-#include "rzcout.inc"
- END
- SUBROUTINE RZCOUNT_NOOP
-#include "rzcount.inc"
- END
- SUBROUTINE RZCSTR_NOOP
-#include "rzcstr.inc"
- END
- SUBROUTINE RZCLXX_NOOP
-#include "rzclxx.inc"
- END
- SUBROUTINE CQC_NOOP
-#include "cqc.inc"
- END
- SUBROUTINE CQBKC_NOOP
-#include "cqbkc.inc"
- END
- SUBROUTINE ZTELLC_NOOP
-#include "ztellc.inc"
- END
diff --git a/src/packlib/zebra/qutil/not_cern/os9/fcommte b/src/packlib/zebra/qutil/not_cern/os9/fcommte
deleted file mode 100644
index ee51f8d..0000000
--- a/src/packlib/zebra/qutil/not_cern/os9/fcommte
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: fcommte,v 1.1.1.1 1996/03/06 10:47:16 mclareni Exp $
-*
-* $Log: fcommte,v $
-* Revision 1.1.1.1 1996/03/06 10:47:16 mclareni
-* Zebra
-*
-*
-* Fortran Test COMMONs for OS9
-* This directory was created from zebra.car patch fcommte
- SUBROUTINE CQC1_NOOP
-#include "cqc1.inc"
- END
- SUBROUTINE TESTLA_NOOP
-#include "testla.inc"
- END
- SUBROUTINE FQTLUN_NOOP
-#include "fqtlun.inc"
- END
- SUBROUTINE FQMBUF_NOOP
-#include "fqmbuf.inc"
- END
diff --git a/src/packlib/zebra/qutil/not_cern/qend_zfatalch.inc b/src/packlib/zebra/qutil/not_cern/qend_zfatalch.inc
deleted file mode 100644
index 440d113..0000000
--- a/src/packlib/zebra/qutil/not_cern/qend_zfatalch.inc
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: qend_zfatalch.inc,v 1.1.1.1 1996/03/06 10:47:15 mclareni Exp $
-*
-* $Log: qend_zfatalch.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:15 mclareni
-* Zebra
-*
-*
-*
-* zfatalch.inc
-*
- DATA INIT /4HINIT /
diff --git a/src/packlib/zebra/qutil/not_cern/qutycdc/Imakefile b/src/packlib/zebra/qutil/not_cern/qutycdc/Imakefile
deleted file mode 100644
index e160ee4..0000000
--- a/src/packlib/zebra/qutil/not_cern/qutycdc/Imakefile
+++ /dev/null
@@ -1,4 +0,0 @@
-SRCS_F= izbcd.F izbcdt.F izbcdv.F izchav.F izhnum.F zhtoi.F \ @@\
- zitoh.F zrecapl.F zrecov.F zrecpr.F zsetrec.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/zebra/qutil/not_cern/qutycdc/izbcd.F b/src/packlib/zebra/qutil/not_cern/qutycdc/izbcd.F
deleted file mode 100644
index 2eb1e7c..0000000
--- a/src/packlib/zebra/qutil/not_cern/qutycdc/izbcd.F
+++ /dev/null
@@ -1,9 +0,0 @@
- FUNCTION IZBCD (MCHAR)
-
-#include "zebra/zceta.inc"
-
-
- JV = SHIFT(MCHAR,6) .AND. 63
- IZBCD = IQCETA(JV+1)
- RETURN
- END
diff --git a/src/packlib/zebra/qutil/not_cern/qutycdc/izbcdt.F b/src/packlib/zebra/qutil/not_cern/qutycdc/izbcdt.F
deleted file mode 100644
index 5ff9109..0000000
--- a/src/packlib/zebra/qutil/not_cern/qutycdc/izbcdt.F
+++ /dev/null
@@ -1,31 +0,0 @@
- SUBROUTINE IZBCDT (NP,ITABT)
-
-#include "zebra/quest.inc"
-#include "zebra/zceta.inc"
-#include "zebra/zkrakc.inc"
-C-------------- END CDE --------------
- DIMENSION NP(9), ITABT(99)
-
-
- N = NP(1)
- LIM = ITABT(1)
- JGOOD = 0
- JBAD = 0
-
- DO 29 JWH=1,N
- JV = SHIFT (IQHOLK(JWH),6) .AND. 63
- JV = IQTCET(JV+1)
-
- IF (JV.GT.LIM) GO TO 27
- JV = ITABT(JV+1)
- IF (JV+1) 29, 27, 24
- 24 JGOOD = JGOOD + 1
- IQCETK(JGOOD) = JV
- GO TO 29
-
- 27 JBAD = JBAD + 1
- 29 CONTINUE
- IQUEST(1) = JGOOD
- IQUEST(2) = JBAD
- RETURN
- END
diff --git a/src/packlib/zebra/qutil/not_cern/qutycdc/izbcdv.F b/src/packlib/zebra/qutil/not_cern/qutycdc/izbcdv.F
deleted file mode 100644
index 6d6dea7..0000000
--- a/src/packlib/zebra/qutil/not_cern/qutycdc/izbcdv.F
+++ /dev/null
@@ -1,11 +0,0 @@
- SUBROUTINE IZBCDV (NP)
-
-#include "zebra/zceta.inc"
-#include "zebra/zkrakc.inc"
-
-
- DO 29 JWH=1,NP
- JV = SHIFT (IQHOLK(JWH),6) .AND. 63
- 29 IQCETK(JWH) = IQCETA(JV+1)
- RETURN
- END
diff --git a/src/packlib/zebra/qutil/not_cern/qutycdc/izchav.F b/src/packlib/zebra/qutil/not_cern/qutycdc/izchav.F
deleted file mode 100644
index 3872706..0000000
--- a/src/packlib/zebra/qutil/not_cern/qutycdc/izchav.F
+++ /dev/null
@@ -1,21 +0,0 @@
- SUBROUTINE IZCHAV (NP)
-
-#include "zebra/zceta.inc"
-#include "zebra/zkrakc.inc"
-C-------------- END CDE --------------
-
-
- JCE = 0
- JWH = 0
-
- 11 JWH = JWH + 1
- MWH = IQHOLK(JWH)
-
- DO 24 JCH=1,10
- MWH = SHIFT (MWH,6)
- JV = MWH .AND. 63
- IQCETK(JCE+1) = IQCETA(JV+1)
- 24 JCE = JCE + 1
- IF (JCE.LT.NP) GO TO 11
- RETURN
- END
diff --git a/src/packlib/zebra/qutil/not_cern/qutycdc/izhnum.F b/src/packlib/zebra/qutil/not_cern/qutycdc/izhnum.F
deleted file mode 100644
index 1a995bb..0000000
--- a/src/packlib/zebra/qutil/not_cern/qutycdc/izhnum.F
+++ /dev/null
@@ -1,9 +0,0 @@
- SUBROUTINE IZHNUM (HOLL,INTV,NP)
-
- INTEGER INTV(99), HOLL(99)
-
-
- DO 39 JWH=1,NP
- 39 INTV(JWH) = SHIFT (HOLL(JWH), 6) .AND. 63
- RETURN
- END
diff --git a/src/packlib/zebra/qutil/not_cern/qutycdc/zhtoi.F b/src/packlib/zebra/qutil/not_cern/qutycdc/zhtoi.F
deleted file mode 100644
index 12464d1..0000000
--- a/src/packlib/zebra/qutil/not_cern/qutycdc/zhtoi.F
+++ /dev/null
@@ -1,23 +0,0 @@
- SUBROUTINE ZHTOI (HOLL,INTV,NP)
-
-#include "zebra/zceta.inc"
-C-------------- END CDE --------------
- INTEGER INTV(99), HOLL(99)
-
-
- DO 39 JWH=1,NP
- MWH = SHIFT (HOLL(JWH), 24)
- INTW = 0
-
- DO 29 JL=1,4
- INTW = SHIFT (INTW,6)
- JV = MWH .AND. 63
- IF (JV.EQ.45) THEN
- IF (JL.NE.4) GO TO 29
- ENDIF
- INTW = INTW .OR. IQTCET(JV+1)
- 29 MWH = SHIFT (MWH,54)
-
- 39 INTV(JWH) = INTW
- RETURN
- END
diff --git a/src/packlib/zebra/qutil/not_cern/qutycdc/zitoh.F b/src/packlib/zebra/qutil/not_cern/qutycdc/zitoh.F
deleted file mode 100644
index 6af2262..0000000
--- a/src/packlib/zebra/qutil/not_cern/qutycdc/zitoh.F
+++ /dev/null
@@ -1,21 +0,0 @@
- SUBROUTINE ZITOH (INTV,HOLL,NP)
-
-#include "zebra/zbcd.inc"
-C-------------- END CDE --------------
- INTEGER INTV(99), HOLL(99)
-
- PARAMETER (IBL36 = 0"555555555555")
-
- DO 39 JWH=1,NP
- INTW = INTV(JWH)
- MWH = IBL36
-
- DO 29 JL=1,4
- MWH = SHIFT (MWH,6)
- JV = INTW .AND. 63
- MWH = MWH .OR. NQHOLL(JV)
- 29 INTW = SHIFT (INTW,54)
-
- 39 HOLL(JWH) = SHIFT (MWH,36)
- RETURN
- END
diff --git a/src/packlib/zebra/qutil/not_cern/qutycdc/zrecapl.F b/src/packlib/zebra/qutil/not_cern/qutycdc/zrecapl.F
deleted file mode 100644
index 4c41893..0000000
--- a/src/packlib/zebra/qutil/not_cern/qutycdc/zrecapl.F
+++ /dev/null
@@ -1,26 +0,0 @@
- SUBROUTINE ZRECAPL
-
-C- SELECT RECOVERY OPTIONS, REPLACABLE BY AN APPLICATION ROUTINE
-
-#include "zebra/quest.inc"
-
-C--- QUEST COMMUNICATES BETWEEN ZRECOV AND ZRECAPL
-C-
-C- 1 NCOUNT'TH ERROR (INPUT)
-C- DIRECT QFATAL IF .GE.0 (OUTPUT)
-C- 2 JCONDT, SYSTEM CONDITION NUMBER
-C- 3 RQ CONDITION NUMBER (OUTPUT) PRESET TO JCDID, NORMALLY 8
-C- 4 (OUTPUT) NO/YES FLAG 'DUMP', PRESET TO .NE.0 = YES
-C- 5 (OUTPUT) IF'DUMP' SELECTED, DETAILS ON HOW? FOR 900 ERRORS
-C- +VE EXCH PACK + PROGRAM, =N WORDS EITHER SIDE OF P-COUNTER
-C- 0 EXCHANGE PACK ONLY TO BE DUMPED
-C- -VE NO DUMP (EXCEPT TRACE-BACK SELECTED BY IQUEST(4) )
-C- 6 (OUTPUT) FLAG: CALL ZEND/ZFATAL AFTER CALL ZTELL
-C- PRESET TO .NE.0 = QFATAL
-
-#if !defined(CERNLIB_QDEBUG)
- IF (IQUEST(3).EQ.9) CALL ZEND
- IQUEST(1) = IQUEST(1) - 24
-#endif
- RETURN
- END
diff --git a/src/packlib/zebra/qutil/not_cern/qutycdc/zrecov.F b/src/packlib/zebra/qutil/not_cern/qutycdc/zrecov.F
deleted file mode 100644
index 8141d2e..0000000
--- a/src/packlib/zebra/qutil/not_cern/qutycdc/zrecov.F
+++ /dev/null
@@ -1,35 +0,0 @@
- SUBROUTINE ZRECOV
-
-C- RECOVERY ROUTINE RECEIVING CONTROL ON ERROR
-
-#include "zebra/zunit.inc"
-#include "zebra/quest.inc"
- COMMON /EXCHPAK/JCONDT,JCODE,LREP,AB(8),X(8),PARITY,JCDID
- DATA JCDID /8/, NCOUNT/0/
-
- NCOUNT= NCOUNT+1
- IQUEST(1) = NCOUNT
- IQUEST(2) = JCONDT
- IQUEST(3) = JCDID
- IQUEST(4) = 77
- IQUEST(5) = 20
- IQUEST(6) = 77
- IF (JCONDT.NE.915) GO TO 21
-
-C- TIME LIMIT
- IQUEST(3) = 9
-
- 21 IF (NCOUNT.LT.4095) CALL ZRECAPL
- IF (IQUEST(4).NE.0) CALL ZRECPR
- JCODE = 0
- IF (IQUEST(1).GE.0) GO TO 49
- CALL REPOK
- ID = IQUEST(3)
- ISW = IQUEST(6)
- CALL ZTELL (ID,0)
- IF (ISW.EQ.0) CALL ZEND
- 49 WRITE (IQLOG,9049) NCOUNT
- CALL ZFATAL
-
- 9049 FORMAT (24H0ZRECOV. CALL ZFATAL ON,I6,13H-TH RECOVERY.)
- END
diff --git a/src/packlib/zebra/qutil/not_cern/qutycdc/zrecpr.F b/src/packlib/zebra/qutil/not_cern/qutycdc/zrecpr.F
deleted file mode 100644
index 93ad6ca..0000000
--- a/src/packlib/zebra/qutil/not_cern/qutycdc/zrecpr.F
+++ /dev/null
@@ -1,26 +0,0 @@
- SUBROUTINE ZRECPR
-
-C- PRINT DUMP + TRACE-BACK
-
-#include "zebra/zunit.inc"
-#include "zebra/quest.inc"
- COMMON /EXCHPAK/JCONDT,JCODE,LREP,AB(8),X(8),PARITY,JCDID
-
- IF (JCODE.EQ.0) GO TO 31
-
-C-- REPRIEVE CONDITION
-
- WRITE (IQLOG,9000) JCONDT,JCODE
- IF (IQUEST(5).LT.0) GO TO 32
- NTOT = 2*IQUEST(5)
- CALL REPDUMP (IQLOG,IQUEST(5),NTOT)
- GO TO 32
-
-C-- FORTRAN LIBRARY CONDITION
-
- 31 WRITE (IQLOG,9000) JCONDT,(AB(J),J=1,6)
- 32 CALL TRACEQR (IQLOG,7)
- RETURN
-
- 9000 FORMAT (10H0ZRECOV. ,20(1H-),21H SYSTEM ERROR NUMBER,I4,3X,6A10)
- END
diff --git a/src/packlib/zebra/qutil/not_cern/qutycdc/zsetrec.F b/src/packlib/zebra/qutil/not_cern/qutycdc/zsetrec.F
deleted file mode 100644
index 47acfd2..0000000
--- a/src/packlib/zebra/qutil/not_cern/qutycdc/zsetrec.F
+++ /dev/null
@@ -1,17 +0,0 @@
- SUBROUTINE ZSETREC (IPARAM)
-
-C- INITIALISE RECOVERY TO ZRECOV
-
- COMMON /EXCHPAK/JCONDT,JCODE,LREP,AB(8),X(8),PARITY,JCDID
- EXTERNAL ZRECOV, REPFL
- DIMENSION LIST(6)
- DATA LIST /1,0,0,0,2H**,-1/
-
- CALL REPINIT (ZRECOV)
-
- LIST(5) = LOCF (REPFL)
- DO 9 J=1,49
- CALL SYSTEMC (J,LIST)
- 9 CONTINUE
- RETURN
- END
diff --git a/src/packlib/zebra/qutil/not_cern/qutycry/Imakefile b/src/packlib/zebra/qutil/not_cern/qutycry/Imakefile
deleted file mode 100644
index 2834520..0000000
--- a/src/packlib/zebra/qutil/not_cern/qutycry/Imakefile
+++ /dev/null
@@ -1,4 +0,0 @@
-SRCS_F= izbcd.F izbcdt.F izbcdv.F izchav.F izhnum.F zhtoi.F \ @@\
- zitoh.F zrecapl.F zrecok.F zrecov.F zrecpr.F zsetrec.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/zebra/qutil/not_cern/qutycry/izbcd.F b/src/packlib/zebra/qutil/not_cern/qutycry/izbcd.F
deleted file mode 100644
index b88955b..0000000
--- a/src/packlib/zebra/qutil/not_cern/qutycry/izbcd.F
+++ /dev/null
@@ -1,9 +0,0 @@
- FUNCTION IZBCD (MCHAR)
-
-#include "zebra/zceta.inc"
-
-
- JV = SHIFTR (MCHAR,56)
- IZBCD = IQCETA(JV+1)
- RETURN
- END
diff --git a/src/packlib/zebra/qutil/not_cern/qutycry/izbcdt.F b/src/packlib/zebra/qutil/not_cern/qutycry/izbcdt.F
deleted file mode 100644
index 7f667f2..0000000
--- a/src/packlib/zebra/qutil/not_cern/qutycry/izbcdt.F
+++ /dev/null
@@ -1,31 +0,0 @@
- SUBROUTINE IZBCDT (NP,ITABT)
-
-#include "zebra/quest.inc"
-#include "zebra/zceta.inc"
-#include "zebra/zkrakc.inc"
-C-------------- END CDE --------------
- DIMENSION NP(9), ITABT(99)
-
-
- N = NP(1)
- LIM = ITABT(1)
- JGOOD = 0
- JBAD = 0
-
- DO 29 JWH=1,N
- JV = SHIFTR (IQHOLK(JWH),56)
- JV = IQTCET(JV+1)
-
- IF (JV.GT.LIM) GO TO 27
- JV = ITABT(JV+1)
- IF (JV+1) 29, 27, 24
- 24 JGOOD = JGOOD + 1
- IQCETK(JGOOD) = JV
- GO TO 29
-
- 27 JBAD = JBAD + 1
- 29 CONTINUE
- IQUEST(1) = JGOOD
- IQUEST(2) = JBAD
- RETURN
- END
diff --git a/src/packlib/zebra/qutil/not_cern/qutycry/izbcdv.F b/src/packlib/zebra/qutil/not_cern/qutycry/izbcdv.F
deleted file mode 100644
index 5b546a2..0000000
--- a/src/packlib/zebra/qutil/not_cern/qutycry/izbcdv.F
+++ /dev/null
@@ -1,11 +0,0 @@
- SUBROUTINE IZBCDV (NP)
-
-#include "zebra/zceta.inc"
-#include "zebra/zkrakc.inc"
-
-
- DO 29 JWH=1,NP
- JV = SHIFTR (IQHOLK(JWH),56)
- 29 IQCETK(JWH) = IQCETA(JV+1)
- RETURN
- END
diff --git a/src/packlib/zebra/qutil/not_cern/qutycry/izchav.F b/src/packlib/zebra/qutil/not_cern/qutycry/izchav.F
deleted file mode 100644
index b697de2..0000000
--- a/src/packlib/zebra/qutil/not_cern/qutycry/izchav.F
+++ /dev/null
@@ -1,26 +0,0 @@
- SUBROUTINE IZCHAV (NP)
-
-#include "zebra/zceta.inc"
-#include "zebra/zkrakc.inc"
-C-------------- END CDE --------------
- DIMENSION ICHTR(120)
- EQUIVALENCE (ICHTR,IQHOLK)
-#endif
-#if !defined(CERNLIB_EQUHOLCH)
- COMMON /ZCRAKC/ ICHTR(15)
-#endif
-
- JCE = 0
- JWH = 0
-
- 11 JWH = JWH + 1
- MWH = ICHTR(JWH)
-
- DO 24 JCH=1,8
- MWH = SHIFT (MWH,8)
- JV = MWH .AND. 255
- IQCETK(JCE+1) = IQCETA(JV+1)
- 24 JCE = JCE + 1
- IF (JCE.LT.NP) GO TO 11
- RETURN
- END
diff --git a/src/packlib/zebra/qutil/not_cern/qutycry/izhnum.F b/src/packlib/zebra/qutil/not_cern/qutycry/izhnum.F
deleted file mode 100644
index ebdea85..0000000
--- a/src/packlib/zebra/qutil/not_cern/qutycry/izhnum.F
+++ /dev/null
@@ -1,9 +0,0 @@
- SUBROUTINE IZHNUM (HOLL,INTV,NP)
-
- INTEGER INTV(99), HOLL(99)
-
-
- DO 39 JWH=1,NP
- 39 INTV(JWH) = SHIFTR (HOLL(JWH), 56)
- RETURN
- END
diff --git a/src/packlib/zebra/qutil/not_cern/qutycry/qexchcry.inc b/src/packlib/zebra/qutil/not_cern/qutycry/qexchcry.inc
deleted file mode 100644
index 44f1e84..0000000
--- a/src/packlib/zebra/qutil/not_cern/qutycry/qexchcry.inc
+++ /dev/null
@@ -1,13 +0,0 @@
-*
-* $Id: qexchcry.inc,v 1.1.1.1 1996/03/06 10:47:17 mclareni Exp $
-*
-* $Log: qexchcry.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:17 mclareni
-* Zebra
-*
-*
-*
-* qexchcry.inc
-*
- COMMON /EXCHPAK/JCONDT,JCODE,JCDID,JREPCD
- +, IXP(16),IVMR,IESW,ISEC,IRESW(21)
diff --git a/src/packlib/zebra/qutil/not_cern/qutycry/zhtoi.F b/src/packlib/zebra/qutil/not_cern/qutycry/zhtoi.F
deleted file mode 100644
index dfb34c0..0000000
--- a/src/packlib/zebra/qutil/not_cern/qutycry/zhtoi.F
+++ /dev/null
@@ -1,23 +0,0 @@
- SUBROUTINE ZHTOI (HOLL,INTV,NP)
-
-#include "zebra/zceta.inc"
-C-------------- END CDE --------------
- INTEGER INTV(99), HOLL(99)
-
-
- DO 39 JWH=1,NP
- MWH = SHIFT (HOLL(JWH),32)
- INTW = 0
-
- DO 29 JL=1,4
- INTW = SHIFT (INTW,6)
- JV = MWH .AND. 255
- IF (JV.EQ.32) THEN
- IF (JL.NE.4) GO TO 29
- ENDIF
- INTW = INTW .OR. IQTCET(JV+1)
- 29 MWH = SHIFTR (MWH,8)
-
- 39 INTV(JWH) = INTW
- RETURN
- END
diff --git a/src/packlib/zebra/qutil/not_cern/qutycry/zitoh.F b/src/packlib/zebra/qutil/not_cern/qutycry/zitoh.F
deleted file mode 100644
index becdc0d..0000000
--- a/src/packlib/zebra/qutil/not_cern/qutycry/zitoh.F
+++ /dev/null
@@ -1,21 +0,0 @@
- SUBROUTINE ZITOH (INTV,HOLL,NP)
-
-#include "zebra/zbcd.inc"
-C-------------- END CDE --------------
- INTEGER INTV(99), HOLL(99)
-
- PARAMETER (IBL32 = 4010020040 B)
-
- DO 39 JWH=1,NP
- INTW = INTV(JWH)
- MWH = IBL32
-
- DO 29 JL=1,4
- MWH = SHIFT (MWH,8)
- JV = INTW .AND. 63
- MWH = MWH .OR. NQHOLL(JV)
- 29 INTW = SHIFTR (INTW,6)
-
- 39 HOLL(JWH) = SHIFT (MWH,32)
- RETURN
- END
diff --git a/src/packlib/zebra/qutil/not_cern/qutycry/zrecapl.F b/src/packlib/zebra/qutil/not_cern/qutycry/zrecapl.F
deleted file mode 100644
index 4c41893..0000000
--- a/src/packlib/zebra/qutil/not_cern/qutycry/zrecapl.F
+++ /dev/null
@@ -1,26 +0,0 @@
- SUBROUTINE ZRECAPL
-
-C- SELECT RECOVERY OPTIONS, REPLACABLE BY AN APPLICATION ROUTINE
-
-#include "zebra/quest.inc"
-
-C--- QUEST COMMUNICATES BETWEEN ZRECOV AND ZRECAPL
-C-
-C- 1 NCOUNT'TH ERROR (INPUT)
-C- DIRECT QFATAL IF .GE.0 (OUTPUT)
-C- 2 JCONDT, SYSTEM CONDITION NUMBER
-C- 3 RQ CONDITION NUMBER (OUTPUT) PRESET TO JCDID, NORMALLY 8
-C- 4 (OUTPUT) NO/YES FLAG 'DUMP', PRESET TO .NE.0 = YES
-C- 5 (OUTPUT) IF'DUMP' SELECTED, DETAILS ON HOW? FOR 900 ERRORS
-C- +VE EXCH PACK + PROGRAM, =N WORDS EITHER SIDE OF P-COUNTER
-C- 0 EXCHANGE PACK ONLY TO BE DUMPED
-C- -VE NO DUMP (EXCEPT TRACE-BACK SELECTED BY IQUEST(4) )
-C- 6 (OUTPUT) FLAG: CALL ZEND/ZFATAL AFTER CALL ZTELL
-C- PRESET TO .NE.0 = QFATAL
-
-#if !defined(CERNLIB_QDEBUG)
- IF (IQUEST(3).EQ.9) CALL ZEND
- IQUEST(1) = IQUEST(1) - 24
-#endif
- RETURN
- END
diff --git a/src/packlib/zebra/qutil/not_cern/qutycry/zrecok.F b/src/packlib/zebra/qutil/not_cern/qutycry/zrecok.F
deleted file mode 100644
index d2c39c5..0000000
--- a/src/packlib/zebra/qutil/not_cern/qutycry/zrecok.F
+++ /dev/null
@@ -1,11 +0,0 @@
- SUBROUTINE ZRECOK
-
-C- CALL SETRPRV
-
-#include "zebra/qexchcry.inc"
-
- EXTERNAL ZRECOV
-
- CALL SETRPV (ZRECOV,IXP,JREPCD)
- RETURN
- END
diff --git a/src/packlib/zebra/qutil/not_cern/qutycry/zrecov.F b/src/packlib/zebra/qutil/not_cern/qutycry/zrecov.F
deleted file mode 100644
index 4b53e7b..0000000
--- a/src/packlib/zebra/qutil/not_cern/qutycry/zrecov.F
+++ /dev/null
@@ -1,39 +0,0 @@
- SUBROUTINE ZRECOV
-
-C- RECOVERY ROUTINE RECEIVING CONTROL ON ERROR
-
-#include "zebra/zunit.inc"
-#include "zebra/quest.inc"
-#include "zebra/qexchcry.inc"
-
- DATA JCDID /8/, NCOUNT/0/
-
-
- JCONDT = ISEC
- NCOUNT = NCOUNT+1
-
- IQUEST(1) = NCOUNT
- IQUEST(2) = JCONDT
- IQUEST(3) = JCDID
- IQUEST(4) = 77
- IQUEST(5) = 20
- IQUEST(6) = 77
- IF (JCONDT.NE.23) GO TO 21
-
-C- TIME LIMIT
- IQUEST(3) = 9
-
- 21 IF (NCOUNT.LT.4095) CALL ZRECAPL
- IF (IQUEST(4).NE.0) CALL ZRECPR
- JCODE = 0
- IF (IQUEST(1).GE.0) GO TO 49
- ID = IQUEST(3)
- ISW = IQUEST(6)
- CALL ZRECOK
- CALL ZTELL (ID,0)
- IF (ISW.EQ.0) CALL ZEND
- 49 WRITE (IQLOG,9049) NCOUNT
- CALL ZFATAL
-
- 9049 FORMAT (24H0ZRECOV. CALL ZFATAL ON,I6,13H-TH RECOVERY.)
- END
diff --git a/src/packlib/zebra/qutil/not_cern/qutycry/zrecpr.F b/src/packlib/zebra/qutil/not_cern/qutycry/zrecpr.F
deleted file mode 100644
index 84cb6fb..0000000
--- a/src/packlib/zebra/qutil/not_cern/qutycry/zrecpr.F
+++ /dev/null
@@ -1,49 +0,0 @@
- SUBROUTINE ZRECPR
-
-C- PRINT DUMP + TRACE-BACK
-
-#include "zebra/zbcd.inc"
-#include "zebra/zunit.inc"
-#include "zebra/quest.inc"
-#include "zebra/qexchcry.inc"
-
- POINTER (LCODE,CODE(99))
-
-#include "zebra/q_jbyt.inc"
-
-
- LPADR = JBYT (IXP(1),27,22)
- JPPAR = JBYT (IXP(1),25, 2)
- JPLET = IQLETT(JPPAR+1)
-
- WRITE (IQLOG,9000) ISEC,LPADR,JPLET,LPADR,JPLET
- 9000 FORMAT (10H0ZRECOV. ,10(1H-),
- F 10H JCONDT =,I4,6H P = ,O8,A1,' OCT = HEX ',Z6,1X,A1/1X)
-
- IF (IQUEST(5).LT.0) GO TO 32
-
- WRITE (IQLOG,9011)
- 9011 FORMAT (20X,6H-----A,25X,1HS/1X)
-
- WRITE (IQLOG,9012) (IXP(J),IXP(J+8), J=1,8)
- 9012 FORMAT (10X,Z16,10X,Z16)
-
- WRITE (IQLOG,9013) IVMR,IESW,ISEC
- 9013 FORMAT (1H0,4X,5HVMR= ,Z16,5X,5HESW= ,Z16,5X,5HSEC= ,Z16/1X)
- IF (IQUEST(5).EQ.0) GO TO 32
-
- LGO = LPADR - IQUEST(5)
- LEND = LPADR + IQUEST(5)
-
- DO 27 LL=LGO,LEND,4
- LCODE = LL
- WRITE (IQLOG,9024) LL,(CODE(J),J=1,4)
- 9024 FORMAT (4X,Z6,4Z20)
- 27 CONTINUE
-
- WRITE (IQLOG,9027)
- 9027 FORMAT (1X)
-
- 32 CALL TRBK (IQLOG)
- RETURN
- END
diff --git a/src/packlib/zebra/qutil/not_cern/qutycry/zsetrec.F b/src/packlib/zebra/qutil/not_cern/qutycry/zsetrec.F
deleted file mode 100644
index a4fcb9d..0000000
--- a/src/packlib/zebra/qutil/not_cern/qutycry/zsetrec.F
+++ /dev/null
@@ -1,15 +0,0 @@
- SUBROUTINE ZSETREC (IPARAM)
-
-C- INITIALISE RECOVERY IN THE HYDRA CONTEXT
-
-#include "zebra/qexchcry.inc"
-
- DATA JCDID /8/
-
- JREPCD = IPARAM
- IF (JREPCD.EQ.0) JREPCD= 7776B
-
- CALL ZRECOK
- JCODE = 0
- RETURN
- END
diff --git a/src/packlib/zebra/qutil/not_cern/qutycvx/Imakefile b/src/packlib/zebra/qutil/not_cern/qutycvx/Imakefile
deleted file mode 100644
index 7dabd00..0000000
--- a/src/packlib/zebra/qutil/not_cern/qutycvx/Imakefile
+++ /dev/null
@@ -1,4 +0,0 @@
-SRCS_F= izbcd.F izbcdt.F izbcdv.F izchav.F izhnum.F zhtoi.F \ @@\
- zitoh.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/zebra/qutil/not_cern/qutycvx/izbcd.F b/src/packlib/zebra/qutil/not_cern/qutycvx/izbcd.F
deleted file mode 100644
index 9447fde..0000000
--- a/src/packlib/zebra/qutil/not_cern/qutycvx/izbcd.F
+++ /dev/null
@@ -1,9 +0,0 @@
- FUNCTION IZBCD (MCHAR)
-
-#include "zebra/zceta.inc"
-
-
- JV = ishft (MCHAR,-56)
- IZBCD = IQCETA(JV+1)
- RETURN
- END
diff --git a/src/packlib/zebra/qutil/not_cern/qutycvx/izbcdt.F b/src/packlib/zebra/qutil/not_cern/qutycvx/izbcdt.F
deleted file mode 100644
index 2185377..0000000
--- a/src/packlib/zebra/qutil/not_cern/qutycvx/izbcdt.F
+++ /dev/null
@@ -1,31 +0,0 @@
- SUBROUTINE IZBCDT (NP,ITABT)
-
-#include "zebra/quest.inc"
-#include "zebra/zceta.inc"
-#include "zebra/zkrakc.inc"
-C-------------- END CDE --------------
- DIMENSION NP(9), ITABT(99)
-
-
- N = NP(1)
- LIM = ITABT(1)
- JGOOD = 0
- JBAD = 0
-
- DO 29 JWH=1,N
- JV = ishft (IQHOLK(JWH),-56)
- JV = IQTCET(JV+1)
-
- IF (JV.GT.LIM) GO TO 27
- JV = ITABT(JV+1)
- IF (JV+1) 29, 27, 24
- 24 JGOOD = JGOOD + 1
- IQCETK(JGOOD) = JV
- GO TO 29
-
- 27 JBAD = JBAD + 1
- 29 CONTINUE
- IQUEST(1) = JGOOD
- IQUEST(2) = JBAD
- RETURN
- END
diff --git a/src/packlib/zebra/qutil/not_cern/qutycvx/izbcdv.F b/src/packlib/zebra/qutil/not_cern/qutycvx/izbcdv.F
deleted file mode 100644
index cc51d9f..0000000
--- a/src/packlib/zebra/qutil/not_cern/qutycvx/izbcdv.F
+++ /dev/null
@@ -1,11 +0,0 @@
- SUBROUTINE IZBCDV (NP)
-
-#include "zebra/zceta.inc"
-#include "zebra/zkrakc.inc"
-
-
- DO 29 JWH=1,NP
- JV = ishft (IQHOLK(JWH),-56)
- 29 IQCETK(JWH) = IQCETA(JV+1)
- RETURN
- END
diff --git a/src/packlib/zebra/qutil/not_cern/qutycvx/izchav.F b/src/packlib/zebra/qutil/not_cern/qutycvx/izchav.F
deleted file mode 100644
index 701486f..0000000
--- a/src/packlib/zebra/qutil/not_cern/qutycvx/izchav.F
+++ /dev/null
@@ -1,26 +0,0 @@
- SUBROUTINE IZCHAV (NP)
-
-#include "zebra/zceta.inc"
-#include "zebra/zkrakc.inc"
-C-------------- END CDE --------------
- DIMENSION ICHTR(120)
- EQUIVALENCE (ICHTR,IQHOLK)
-#endif
-#if !defined(CERNLIB_EQUHOLCH)
- COMMON /ZCRAKC/ ICHTR(15)
-#endif
-
- JCE = 0
- JWH = 0
-
- 11 JWH = JWH + 1
- MWH = ICHTR(JWH)
-
- DO 24 JCH=1,8
- MWH = ISHFTC (MWH,8,64)
- JV = MWH .AND. 255
- IQCETK(JCE+1) = IQCETA(JV+1)
- 24 JCE = JCE + 1
- IF (JCE.LT.NP) GO TO 11
- RETURN
- END
diff --git a/src/packlib/zebra/qutil/not_cern/qutycvx/izhnum.F b/src/packlib/zebra/qutil/not_cern/qutycvx/izhnum.F
deleted file mode 100644
index 313e2a0..0000000
--- a/src/packlib/zebra/qutil/not_cern/qutycvx/izhnum.F
+++ /dev/null
@@ -1,9 +0,0 @@
- SUBROUTINE IZHNUM (HOLL,INTV,NP)
-
- INTEGER INTV(99), HOLL(99)
-
-
- DO 39 JWH=1,NP
- 39 INTV(JWH) = ishft (HOLL(JWH),-56)
- RETURN
- END
diff --git a/src/packlib/zebra/qutil/not_cern/qutycvx/zhtoi.F b/src/packlib/zebra/qutil/not_cern/qutycvx/zhtoi.F
deleted file mode 100644
index 1e4500e..0000000
--- a/src/packlib/zebra/qutil/not_cern/qutycvx/zhtoi.F
+++ /dev/null
@@ -1,23 +0,0 @@
- SUBROUTINE ZHTOI (HOLL,INTV,NP)
-
-#include "zebra/zceta.inc"
-C-------------- END CDE --------------
- INTEGER INTV(99), HOLL(99)
-
-
- DO 39 JWH=1,NP
- MWH = ISHFT (HOLL(JWH),-32)
- INTW = 0
-
- DO 29 JL=1,4
- INTW = ISHFT (INTW,6)
- JV = MWH .AND. 255
- IF (JV.EQ.32) THEN
- IF (JL.NE.4) GO TO 29
- ENDIF
- INTW = INTW .OR. IQTCET(JV+1)
- 29 MWH = ishft (MWH,-8)
-
- 39 INTV(JWH) = INTW
- RETURN
- END
diff --git a/src/packlib/zebra/qutil/not_cern/qutycvx/zitoh.F b/src/packlib/zebra/qutil/not_cern/qutycvx/zitoh.F
deleted file mode 100644
index bf6fdb5..0000000
--- a/src/packlib/zebra/qutil/not_cern/qutycvx/zitoh.F
+++ /dev/null
@@ -1,21 +0,0 @@
- SUBROUTINE ZITOH (INTV,HOLL,NP)
-
-#include "zebra/zbcd.inc"
-C-------------- END CDE --------------
- INTEGER INTV(99), HOLL(99)
-
- PARAMETER (IBL32 = '20202020'X)
-
- DO 39 JWH=1,NP
- INTW = INTV(JWH)
- MWH = 0
-
- DO 29 JL=1,4
- MWH = ISHFT (MWH,8)
- JV = INTW .AND. 63
- MWH = MWH .OR. NQHOLL(JV)
- 29 INTW = ishft (INTW,-6)
-
- 39 HOLL(JWH) = ISHFT(MWH,32) .OR. IBL32
- RETURN
- END
diff --git a/src/packlib/zebra/qutil/not_cern/qutypdp/Imakefile b/src/packlib/zebra/qutil/not_cern/qutypdp/Imakefile
deleted file mode 100644
index f11511d..0000000
--- a/src/packlib/zebra/qutil/not_cern/qutypdp/Imakefile
+++ /dev/null
@@ -1,3 +0,0 @@
-SRCS_F= izbcd.F izbcdt.F izbcdv.F izhnum.F zhtoi.F zitoh.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/zebra/qutil/not_cern/qutypdp/izbcd.F b/src/packlib/zebra/qutil/not_cern/qutypdp/izbcd.F
deleted file mode 100644
index bd0b12b..0000000
--- a/src/packlib/zebra/qutil/not_cern/qutypdp/izbcd.F
+++ /dev/null
@@ -1,9 +0,0 @@
- FUNCTION IZBCD (MCHAR)
-
-#include "zebra/zceta.inc"
-
-
- JV = ISHFT (MCHAR,-29)
- IZBCD = IQCETA(JV+1)
- RETURN
- END
diff --git a/src/packlib/zebra/qutil/not_cern/qutypdp/izbcdt.F b/src/packlib/zebra/qutil/not_cern/qutypdp/izbcdt.F
deleted file mode 100644
index 4b0155e..0000000
--- a/src/packlib/zebra/qutil/not_cern/qutypdp/izbcdt.F
+++ /dev/null
@@ -1,31 +0,0 @@
- SUBROUTINE IZBCDT (NP,ITABT)
-
-#include "zebra/quest.inc"
-#include "zebra/zceta.inc"
-#include "zebra/zkrakc.inc"
-C-------------- END CDE --------------
- DIMENSION NP(9), ITABT(99)
-
-
- N = NP(1)
- LIM = ITABT(1)
- JGOOD = 0
- JBAD = 0
-
- DO 29 JWH=1,N
- JV = ISHFT (IQHOLK(JWH),-29)
- JV = IQTCET(JV+1)
-
- IF (JV.GT.LIM) GO TO 27
- JV = ITABT(JV+1)
- IF (JV+1) 29, 27, 24
- 24 JGOOD = JGOOD + 1
- IQCETK(JGOOD) = JV
- GO TO 29
-
- 27 JBAD = JBAD + 1
- 29 CONTINUE
- IQUEST(1) = JGOOD
- IQUEST(2) = JBAD
- RETURN
- END
diff --git a/src/packlib/zebra/qutil/not_cern/qutypdp/izbcdv.F b/src/packlib/zebra/qutil/not_cern/qutypdp/izbcdv.F
deleted file mode 100644
index a043bd6..0000000
--- a/src/packlib/zebra/qutil/not_cern/qutypdp/izbcdv.F
+++ /dev/null
@@ -1,11 +0,0 @@
- SUBROUTINE IZBCDV (NP)
-
-#include "zebra/zceta.inc"
-#include "zebra/zkrakc.inc"
-
-
- DO 29 JWH=1,NP
- JV = ISHFT (IQHOLK(JWH),-29)
- 29 IQCETK(JWH) = IQCETA(JV+1)
- RETURN
- END
diff --git a/src/packlib/zebra/qutil/not_cern/qutypdp/izhnum.F b/src/packlib/zebra/qutil/not_cern/qutypdp/izhnum.F
deleted file mode 100644
index 535ac5d..0000000
--- a/src/packlib/zebra/qutil/not_cern/qutypdp/izhnum.F
+++ /dev/null
@@ -1,10 +0,0 @@
- SUBROUTINE IZHNUM (HOLL,INTV,NP)
-
- INTEGER INTV(99), HOLL(99)
-
-#include "zebra/q_shift.inc"
-
- DO 39 JWH=1,NP
- 39 INTV(JWH) = ISHFTR (HOLL(JWH), 29)
- RETURN
- END
diff --git a/src/packlib/zebra/qutil/not_cern/qutypdp/reent.s b/src/packlib/zebra/qutil/not_cern/qutypdp/reent.s
deleted file mode 100644
index 439c45c..0000000
--- a/src/packlib/zebra/qutil/not_cern/qutypdp/reent.s
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: reent.s,v 1.1.1.1 1996/03/06 10:47:19 mclareni Exp $
-*
-* $Log: reent.s,v $
-* Revision 1.1.1.1 1996/03/06 10:47:19 mclareni
-* Zebra
-*
-*
- TITLE REENT (ROUT)
- ENTRY REENT
- SIXBIT /REENT/
-REENT:
-#include "qhelopdp.inc"
-* Ignoring t=pass
- MOVEI 0,@(16)
- MOVEM 0,124
- POPJ 17,0
-PRGEND
diff --git a/src/packlib/zebra/qutil/not_cern/qutypdp/zhtoi.F b/src/packlib/zebra/qutil/not_cern/qutypdp/zhtoi.F
deleted file mode 100644
index fbe7e47..0000000
--- a/src/packlib/zebra/qutil/not_cern/qutypdp/zhtoi.F
+++ /dev/null
@@ -1,23 +0,0 @@
- SUBROUTINE ZHTOI (HOLL,INTV,NP)
-
-#include "zebra/zceta.inc"
-C-------------- END CDE --------------
- INTEGER INTV(99), HOLL(99)
-
-
- DO 39 JWH=1,NP
- MWH = ISHFT (HOLL(JWH), -8)
- INTW = 0
-
- DO 29 JL=1,4
- INTW = ISHFT (INTW,6)
- JV = IAND (MWH,127)
- IF (JV.EQ.32) THEN
- IF (JL.NE.4) GO TO 29
- ENDIF
- INTW = IOR (INTW, IQTCET(JV+1))
- 29 MWH = ISHFT (MWH,-7)
-
- 39 INTV(JWH) = INTW
- RETURN
- END
diff --git a/src/packlib/zebra/qutil/not_cern/qutypdp/zitoh.F b/src/packlib/zebra/qutil/not_cern/qutypdp/zitoh.F
deleted file mode 100644
index 52fef2f..0000000
--- a/src/packlib/zebra/qutil/not_cern/qutypdp/zitoh.F
+++ /dev/null
@@ -1,23 +0,0 @@
- SUBROUTINE ZITOH (INTV,HOLL,NP)
-
-#include "zebra/zbcd.inc"
-C-------------- END CDE --------------
- INTEGER INTV(99), HOLL(99)
-
-#include "zebra/q_andor.inc"
-#include "zebra/q_shift.inc"
-
-
- DO 39 JWH=1,NP
- INTW = INTV(JWH)
- MWH = 0
-
- DO 29 JL=1,4
- MWH = ISHFTL (MWH,7)
- JV = IAND (INTW,63)
- MWH = IOR (MWH, NQHOLL(JV))
- 29 INTW = ISHFTR (INTW,6)
-
- 39 HOLL(JWH) = IOR (ISHFTL(MWH,8), 64)
- RETURN
- END
diff --git a/src/packlib/zebra/qutil/not_cern/rztofrfz/clierr.F b/src/packlib/zebra/qutil/not_cern/rztofrfz/clierr.F
deleted file mode 100644
index 0d4f19b..0000000
--- a/src/packlib/zebra/qutil/not_cern/rztofrfz/clierr.F
+++ /dev/null
@@ -1,45 +0,0 @@
-*
-* $Id: clierr.F,v 1.1.1.1 1996/03/06 10:47:20 mclareni Exp $
-*
-* $Log: clierr.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:20 mclareni
-* Zebra
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_zebra/pilot.h"
-#if defined(CERNLIB_VAX)
-c ***********************************************************
- integer*4 function cli_error_handler( sigargs, mechargs )
-c ***********************************************************
-c Purpose : Modify the SEVERITY of the CLI$ errors so that
-c they will not cause a TRACEBACK/dump of the
-c code segment. The SEVERITY bit is set to
-c INFORMATIONAL.
-
- implicit none
-c See the VAX/VMS description of error handlers for details
-c on the calling protocols!
- integer*4 sigargs(*)
- integer*4 mechargs(*)
-
-c Define the SS$_RESIGNAL parameter to resignal the error
-c at its modified severity level:
- include '($ssdef)/list'
-
-c Define the STS$K_INFO parameter so that the severity level
-c may be modified:
- include '($stsdef)/list'
-
-c Modify the SIGARGS(2) severity bit so that it is
-c informational only:
- call mvbits( sts$k_info, 0, 3, sigargs(2), 0 )
-
-c And resignal with this INFORMATIONAL (rather than WARNING)
-c severity level. This will therefore NOT cause a stack dump
-c and TRACEBACK.
- cli_error_handler= ss$_resignal
- return
- end
-
-#endif
diff --git a/src/packlib/zebra/qutil/not_cern/rztofrfz/getcom.F b/src/packlib/zebra/qutil/not_cern/rztofrfz/getcom.F
deleted file mode 100644
index 272cf06..0000000
--- a/src/packlib/zebra/qutil/not_cern/rztofrfz/getcom.F
+++ /dev/null
@@ -1,86 +0,0 @@
-*
-* $Id: getcom.F,v 1.1.1.1 1996/03/06 10:47:20 mclareni Exp $
-*
-* $Log: getcom.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:20 mclareni
-* Zebra
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_zebra/pilot.h"
-#if defined(CERNLIB_VAX)
-c *****************************************************************
- logical*4 function get_command_line(command_tables, command_verb)
-c *****************************************************************
-c Purpose : A general, all-purpose routine to get the
-c command line and submit it for CLI-parsing,
-c which checks for COMPLETENESS and VALIDITY
-c Arguments :
-c command_tables= read only. This is the name of the
-c command table being linked with the
-c program of interest. It must be declared
-c EXTERNAL in the calling program.
-c command_verb= read only. This is the command prefix which
-c is pre-appended to the qualifiers/parameters
-c so that it will be recognized in the above
-c command table.
-c Notes: Uses the routine CLI_ERROR_HANDLER to handle any
-c errors encountered, so that the stack will not be unwound
-c and there will not be a TRACEBACK on errors.
-
- implicit none
- integer*4 command_tables ! Tables which define the ``grammar''
- character*(*) command_verb ! VERB which is defined
- external lib$get_input ! Prompt routine, used by CLI$DCL_PARSE
- integer*4 lib$get_foreign ! Get entered command line
- integer*4 cli$dcl_parse ! Parse for COMPLETENESS and VALIDITY
- character*255 cmd_line ! Store command line
- integer*2 len ! Character count (Note: Integer*2)
- integer*4 status ! Store status returns
-
-c The call to CLI$DCL_PARSE by default will unwind the stack and
-c give a TRACEBACK for any illegal qualifiers or parameters. We
-c do NOT want this traceback, so we will establish our own error
-c handler for this code segment. It must be declared as EXTERNAL.
- integer*4 cli_error_handler
- external cli_error_handler
- integer*4 old_handler ! Store old handler address
- integer*4 lib$establish ! Establish new error handler
-
-cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-c Execution begins:
-#if !defined(CERNLIB_QMALPH)
-c Temporarily establish the alternate error handler. The value
-c returned by LIB$ESTABLISH is the address of the error handler
-c currently in effect.
- old_handler= lib$establish(cli_error_handler)
-#endif
-
-c Get the input command line, using LIB$GET_FOREIGN. If the status
-c is NOT good, then signal an error.
- status= lib$get_foreign(cmd_line,,len)
- if ( .not.status ) then
- call lib$signal( %val(status) )
- else
-c Preappend the appropriate command verb to the command line.
-c Make entirely certain that there is a blank separating the
-c verb from the parameters and qualifiers so that it is
-c interpreted correctly.
- cmd_line= command_verb//' '//cmd_line
-
-c Submit to CLI$DCL_PARSE to make sure it is a valid,
-c complete command line. LIB$GET_INPUT will be used
-c to prompt for any missing required parameters or
-c qualifier values.
- status= cli$dcl_parse( cmd_line,command_tables,lib$get_input )
- end if
-
-#if !defined(CERNLIB_QMALPH)
-c Re-establish the original error handler:
- call lib$establish(old_handler)
-#endif
-c And exit with status determined by the CLI$DCL_PARSE call:
- get_command_line= status
- return
- end
-#endif
diff --git a/src/packlib/zebra/qutil/not_cern/rztofrfz/getf.F b/src/packlib/zebra/qutil/not_cern/rztofrfz/getf.F
deleted file mode 100644
index 9e2b55e..0000000
--- a/src/packlib/zebra/qutil/not_cern/rztofrfz/getf.F
+++ /dev/null
@@ -1,174 +0,0 @@
-*
-* $Id: getf.F,v 1.1.1.1 1996/03/06 10:47:20 mclareni Exp $
-*
-* $Log: getf.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:20 mclareni
-* Zebra
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_zebra/pilot.h"
- SUBROUTINE GETF(FIN,FOUT,CHIN,CHOU)
-#if defined(CERNLIB_QMVAX)
- IMPLICIT INTEGER(A-Z)
- EXTERNAL CLI$_ABSENT,CLI$_DEFAULTED,CLI$_NEGATED,CLI$_PRESENT
-#include "rzclun.inc"
-#endif
-#if defined(CERNLIB_QMIBM)
- CHARACTER*80 PARM
- CHARACTER*(*) SPACES
-#endif
-#if defined(CERNLIB_QMCV64)
- INTEGER*4 IARGC,NARG,IV1,IV2
-#endif
- CHARACTER*(*) FIN, FOUT
- CHARACTER*2 CHIN, CHOU
- DATA IV1/1/, IV2/2/
- FIN = ' '
- FOUT = ' '
-#if defined(CERNLIB_QMVAX)
- RECODE = CLI$GET_VALUE('FIN',FIN,)
- IF(.NOT.RECODE) RECODE=LIB$SIGNAL(%VAL(RECODE))
- RECODE = CLI$GET_VALUE('FOUT',FOUT,)
- IF(.NOT.RECODE) RECODE=LIB$SIGNAL(%VAL(RECODE))
-#endif
-#if (defined(CERNLIB_QMVAX))&&(defined(CERNLIB_RFRX)||defined(CERNLIB_RFRA))
-*
-* Allow for relative organisation files
-*
- IRELAT = 1
- IF((CLI$PRESENT('RELATIVE') .EQ. %LOC(CLI$_NEGATED)) .OR.
- + (CLI$PRESENT('RELATIVE') .EQ. %LOC(CLI$_ABSENT))) IRELAT = 0
-#endif
-#if defined(CERNLIB_QMCRY)
- NARG = IARGC()
- IF(NARG.LT.1) THEN
- WRITE(6,1001) CHIN
- READ (5,1000) FIN
- ELSE
- LPAR = IARGV(1,FIN)
- END IF
- IF(NARG.LT.2) THEN
- WRITE(6,1001) CHOU
- READ (5,1000) FOUT
- ELSE
- LPAR = IARGV(2,FOUT)
- END IF
-#endif
-#if defined(CERNLIB_QMCVX)||defined(CERNLIB_QMHPX)||defined(CERNLIB_QMIBX)||defined(CERNLIB_QMIRT)||defined(CERNLIB_QMSGI)||defined(CERNLIB_QMSUN)||defined(CERNLIB_QMVMI)||defined(CERNLIB_QMALT)||defined(CERNLIB_QMDOS)||defined(CERNLIB_QMLNX)||defined(CERNLIB_QMNXT)
- NARG = IARGC()
- IF(NARG.LT.IV1) THEN
- WRITE(6,1001) CHIN
- READ (5,1000) FIN
- ELSE
- CALL GETARG(IV1,FIN)
- LPAR = LENOCC(FIN)
- END IF
- IF(NARG.LT.IV2) THEN
- WRITE(6,1001) CHOU
- READ (5,1000) FOUT
- ELSE
- CALL GETARG(IV2,FOUT)
- LPAR = LENOCC(FOUT)
- END IF
-#endif
-#if defined(CERNLIB_QMIBM)
- PARM = ' '
- CALL GOPARM(LENGTH,PARM)
- PARM = SPACES(PARM,1)
- CALL CLTOU(PARM)
- DO 10 J=1,LENOCC(PARM)
- IF(PARM(J:J).EQ.'.') PARM(J:J) = ' '
- 10 CONTINUE
- INIT = 1
- IEND = INIT + INDEX(PARM(INIT:80),' ')-2
- IF(INIT.GT.IEND) THEN
- WRITE(6,1001) CHIN
- READ (5,1000,END=100,ERR=100) PARM
- PARM = SPACES(PARM,1)
- CALL CLTOU(PARM)
- DO 20 J=1,LENOCC(PARM)
- IF(PARM(J:J).EQ.'.') PARM(J:J)=' '
- 20 CONTINUE
- INIT = 1
- IEND = INIT + INDEX(PARM(INIT:80),' ')-2
- IF(INIT.GT.IEND) GO TO 100
- END IF
- IF(IEND-INIT+1.GT.8) GO TO 100
- FIN(2:9) = PARM(INIT:IEND)
- INIT = IEND + 2
- IEND = INIT + INDEX(PARM(INIT:80),' ')-2
- IF(INIT.GT.IEND.OR.IEND-INIT+1.GT.8) GO TO 100
- FIN(11:18) = PARM(INIT:IEND)
- INIT = IEND + 2
- IEND = INIT + INDEX(PARM(INIT:80),' ')-2
- ILEN = IEND-INIT+1
- IF(ILEN.EQ.1) THEN
- FIN(20:21) = PARM(INIT:IEND)
- INIT = IEND + 2
- IEND = INIT + INDEX(PARM(INIT:80),' ')-2
- ELSE IF(ILEN.EQ.2) THEN
- IF(INDEXA(PARM(INIT:IEND)).EQ.1.AND.
- + INDEXN(PARM(INIT:IEND)).EQ.2) THEN
- FIN(20:21) = PARM(INIT:IEND)
- INIT = IEND + 2
- IEND = INIT + INDEX(PARM(INIT:80),' ')-2
- ELSE
- FIN(20:21) = '*'
- END IF
- ELSE
- FIN(20:21) = '*'
- END IF
-C
- IF(INIT.GT.IEND) THEN
- WRITE(6,1001) CHOU
- READ(5,1000,END=100,ERR=100) PARM
- PARM = SPACES(PARM,1)
- CALL CLTOU(PARM)
- DO 30 J=1,LENOCC(PARM)
- IF(PARM(J:J).EQ.'.') PARM(J:J)=' '
- 30 CONTINUE
- INIT = 1
- IEND = INIT + INDEX(PARM(INIT:80),' ')-2
- IF(INIT.GT.IEND) GO TO 100
- END IF
- IF(IEND-INIT+1.GT.8) GO TO 100
- FOUT(2:9) = PARM(INIT:IEND)
- INIT = IEND + 2
- IEND = INIT + INDEX(PARM(INIT:80),' ')-2
- IF(INIT.GT.IEND.OR.IEND-INIT+1.GT.8) GO TO 100
- FOUT(11:18) = PARM(INIT:IEND)
- INIT = IEND + 2
- IEND = INIT + INDEX(PARM(INIT:80),' ')-2
- IF(INIT.GT.IEND) THEN
- FOUT(20:21) = 'A'
- ELSE IF(IEND-INIT+1.GT.2) THEN
- GO TO 100
- ELSE
- FOUT(20:21) = PARM(INIT:IEND)
- END IF
- RETURN
-C
- 100 WRITE(6,'('' Invalid file name'')')
- STOP
-#endif
-#if defined(CERNLIB_QMAPO)
- LPAR = PGM_$GET_ARG(INT2(1),FIN,ISTAT,INT2(LEN(FIN)))
- IF(ISTAT.NE.0) THEN
- CALL VFMT_$WRITE2(CHIN//'_file: %$',0,0)
- READ(5,1000) FIN
- END IF
- LPAR = PGM_$GET_ARG(INT2(2),FOUT,ISTAT,INT2(LEN(FOUT)))
- IF(ISTAT.NE.0) THEN
- CALL VFMT_$WRITE2(CHOU//'_file: %$',0,0)
- READ(5,1000) FOUT
- END IF
-#endif
-1000 FORMAT(A)
-#if defined(CERNLIB_QMCVX)||defined(CERNLIB_QMCRY)||defined(CERNLIB_QMHPX)||defined(CERNLIB_QMIRT)||defined(CERNLIB_QMSGI)||defined(CERNLIB_QMVMI)||defined(CERNLIB_QMSUN)||defined(CERNLIB_QMALT)||defined(CERNLIB_QMDOS)||defined(CERNLIB_QMLNX)||defined(CERNLIB_QMNXT)
-1001 FORMAT(A,'_file: ',$)
-#endif
-#if defined(CERNLIB_QMIBX)||defined(CERNLIB_QMIBM)
-1001 FORMAT(1X,A,'_file: ')
-#endif
- END
diff --git a/src/packlib/zebra/qutil/not_cern/rztofrfz/rfracld.dat b/src/packlib/zebra/qutil/not_cern/rztofrfz/rfracld.dat
deleted file mode 100644
index 550c942..0000000
--- a/src/packlib/zebra/qutil/not_cern/rztofrfz/rfracld.dat
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: rfracld.dat,v 1.1.1.1 1996/03/06 10:47:20 mclareni Exp $
-*
-* $Log: rfracld.dat,v $
-* Revision 1.1.1.1 1996/03/06 10:47:20 mclareni
-* Zebra
-*
-*
-#if !defined(CERNLIB_DCLTABLES)
-MODULE RFRA_CLD
-#endif
-define verb RFRA
-#if defined(CERNLIB_DCLTABLES)
- image "CERN_ROOT:[EXE]RFRA"
-#endif
- parameter P1,LABEL=FIN,PROMPT="FA_File",
- VALUE(NOCONCATENATE,REQUIRED,TYPE=$FILE)
- parameter P2,LABEL=FOUT,PROMPT="RZ_File",
- VALUE(NOCONCATENATE,REQUIRED,TYPE=$FILE)
- qualifier RELATIVE
diff --git a/src/packlib/zebra/qutil/not_cern/rztofrfz/rfrxcld.dat b/src/packlib/zebra/qutil/not_cern/rztofrfz/rfrxcld.dat
deleted file mode 100644
index 2d83869..0000000
--- a/src/packlib/zebra/qutil/not_cern/rztofrfz/rfrxcld.dat
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: rfrxcld.dat,v 1.1.1.1 1996/03/06 10:47:20 mclareni Exp $
-*
-* $Log: rfrxcld.dat,v $
-* Revision 1.1.1.1 1996/03/06 10:47:20 mclareni
-* Zebra
-*
-*
-#if !defined(CERNLIB_DCLTABLES)
-MODULE RFRX_CLD
-#endif
-define verb RFRX
-#if defined(CERNLIB_DCLTABLES)
- image "CERN_ROOT:[EXE]RFRX"
-#endif
- parameter P1,LABEL=FIN,PROMPT="FX_File",
- VALUE(NOCONCATENATE,REQUIRED,TYPE=$FILE)
- parameter P2,LABEL=FOUT,PROMPT="RZ_File",
- VALUE(NOCONCATENATE,REQUIRED,TYPE=$FILE)
- qualifier RELATIVE
diff --git a/src/packlib/zebra/qutil/not_cern/rztofrfz/rtoacld.dat b/src/packlib/zebra/qutil/not_cern/rztofrfz/rtoacld.dat
deleted file mode 100644
index a5e5d91..0000000
--- a/src/packlib/zebra/qutil/not_cern/rztofrfz/rtoacld.dat
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: rtoacld.dat,v 1.1.1.1 1996/03/06 10:47:20 mclareni Exp $
-*
-* $Log: rtoacld.dat,v $
-* Revision 1.1.1.1 1996/03/06 10:47:20 mclareni
-* Zebra
-*
-*
-#if !defined(CERNLIB_DCLTABLES)
-MODULE RTOA_CLD
-#endif
-define verb RTOA
-#if defined(CERNLIB_DCLTABLES)
- image "CERN_ROOT:[EXE]RTOA"
-#endif
- parameter P1,LABEL=FIN,PROMPT="RZ_File",
- VALUE(NOCONCATENATE,REQUIRED,TYPE=$FILE)
- parameter P2,LABEL=FOUT,PROMPT="FA_File",
- VALUE(NOCONCATENATE,REQUIRED,TYPE=$FILE)
diff --git a/src/packlib/zebra/qutil/not_cern/rztofrfz/rtoxcld.dat b/src/packlib/zebra/qutil/not_cern/rztofrfz/rtoxcld.dat
deleted file mode 100644
index d40c83a..0000000
--- a/src/packlib/zebra/qutil/not_cern/rztofrfz/rtoxcld.dat
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: rtoxcld.dat,v 1.1.1.1 1996/03/06 10:47:20 mclareni Exp $
-*
-* $Log: rtoxcld.dat,v $
-* Revision 1.1.1.1 1996/03/06 10:47:20 mclareni
-* Zebra
-*
-*
-#if !defined(CERNLIB_DCLTABLES)
-MODULE RTOX_CLD
-#endif
-define verb RTOX
-#if defined(CERNLIB_DCLTABLES)
- image "CERN_ROOT:[EXE]RTOX"
-#endif
- parameter P1,LABEL=FIN,PROMPT="RZ_File",
- VALUE(NOCONCATENATE,REQUIRED,TYPE=$FILE)
- parameter P2,LABEL=FOUT,PROMPT="FX_File",
- VALUE(NOCONCATENATE,REQUIRED,TYPE=$FILE)
diff --git a/src/packlib/zebra/qutil/not_cern/rztofrfz/rzfrf.F b/src/packlib/zebra/qutil/not_cern/rztofrfz/rzfrf.F
deleted file mode 100644
index 60c123f..0000000
--- a/src/packlib/zebra/qutil/not_cern/rztofrfz/rzfrf.F
+++ /dev/null
@@ -1,285 +0,0 @@
-*
-* $Id: rzfrf.F,v 1.1.1.1 1996/03/06 10:47:19 mclareni Exp $
-*
-* $Log: rzfrf.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:19 mclareni
-* Zebra
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_zebra/pilot.h"
-#if defined(CERNLIB_RFRX)
- PROGRAM RFRX
-#endif
-#if defined(CERNLIB_RFRA)
- PROGRAM RFRA
-#endif
-C
-C
-#include "rzpawc.inc"
-#include "rzlenf.inc"
- COMMON / QUEST / IQUEST(100)
- COMMON/PAWC/NWPAW,IXPAWC,IHDIV,IXHIGZ,IXKU,FENC(5),LMAIN,
- + HCV(MEMOR)
- DIMENSION IQ(2),Q(2),LQ(8000)
- EQUIVALENCE (LQ(1),LMAIN),(IQ(1),LQ(9)),(Q(1),IQ(1))
- COMMON /RZCL/ LTOP,LRZ0,LCDIR,LRIN,LROUT,LFREE,LUSED,LPURG
- +, LTEMP,LCORD,LFROM
- PARAMETER (KUP=5,KPW1=7,KNCH=9,KDATEC=10,KDATEM=11,KQUOTA=12,
- + KRUSED=13,KWUSED=14,KMEGA=15,KIRIN=17,KIROUT=18,
- + KRLOUT=19,KIP1=20,KNFREE=22,KNSD=23,KLD=24,KLB=25,
- + KLS=26,KLK=27,KLF=28,KLC=29,KLE=30,KNKEYS=31,
- + KNWKEY=32,KKDES=33,KNSIZE=253,KEX=6,KNMAX=100)
- CHARACTER*2 CHOPT
- CHARACTER*8 CHTAG(100)
- CHARACTER*99 CHFORM
- CHARACTER*12 CHORG
-#include "rzclun.inc"
- CHARACTER*(LENF) FIN, FOUT
-#if (defined(CERNLIB_QMVAX))&&(defined(CERNLIB_RFRX))
- CHARACTER*10 RECORDTYPE
-#endif
-#if defined(CERNLIB_QMIBM)
- INTEGER SYSTEMF
-#endif
-#if (defined(CERNLIB_QMIBM))&&(defined(CERNLIB_RFRX))
- CHARACTER*6 CHRECL
-#endif
- INTEGER OURECL
- DIMENSION IHTAG(2),ICDIR(400),IHEAD(500)
- EQUIVALENCE (ICDIR(1),IHEAD(4))
-#if (defined(CERNLIB_QMVAX))&&(!defined(CERNLIB_DCLTABLES))
- LOGICAL GET_COMMAND_LINE
- CHARACTER*4 CHVERB
-#endif
-#if (defined(CERNLIB_QMVAX))&&(!defined(CERNLIB_DCLTABLES))&&(defined(CERNLIB_RFRX))
- EXTERNAL RFRX_CLD
-#endif
-#if (defined(CERNLIB_QMVAX))&&(!defined(CERNLIB_DCLTABLES))&&(defined(CERNLIB_RFRA))
- EXTERNAL RFRA_CLD
-#endif
-#include "rzmode.inc"
-C
-#if defined(CERNLIB_QMIBM)
- CALL ERRSET(151,0,-1,1,1)
-#endif
- CHOPT='F'//MODE
-#if (defined(CERNLIB_QMVAX))&&(!defined(CERNLIB_DCLTABLES))&&(defined(CERNLIB_RFRA))
- CHVERB = 'RFRA'
- IF ( .NOT. GET_COMMAND_LINE( RFRA_CLD , CHVERB ) ) THEN
-#endif
-#if (defined(CERNLIB_QMVAX))&&(!defined(CERNLIB_DCLTABLES))&&(defined(CERNLIB_RFRX))
- CHVERB = 'RFRX'
- IF ( .NOT. GET_COMMAND_LINE( RFRX_CLD , CHVERB ) ) THEN
-#endif
-#if (defined(CERNLIB_QMVAX))&&(!defined(CERNLIB_DCLTABLES))
- PRINT 9001,CHVERB
-9001 FORMAT(1X,A,'. invalid command line')
- CALL EXIT
- ENDIF
-#endif
-
- CALL GETF(FIN,FOUT,CHOPT,'RZ')
-C
-#if (defined(CERNLIB_QMIBM))&&(!defined(CERNLIB_IOPACK)||defined(CERNLIB_RFRA))
- IRET=SYSTEMF('FILEDEF 1 CLEAR')
-#endif
-#if (defined(CERNLIB_QMIBM))&&(defined(CERNLIB_IOPACK))&&(defined(CERNLIB_RFRX))
- IRET=SYSTEMF('FILEDEF IOFILE01 CLEAR')
-#endif
-#if defined(CERNLIB_QMIBM)
- IRET=SYSTEMF('FILEDEF 2 CLEAR')
-#endif
-*
-* Figure out the record length of the input file
-*
-#if (defined(CERNLIB_RFRX))&&(defined(CERNLIB_QMALT))
- INRECL = 3600
-#endif
-#if (defined(CERNLIB_RFRX))&&(defined(CERNLIB_QMIBM)||defined(CERNLIB_QMCRY)||defined(CERNLIB_QMCVX))
- INRECL = 32760
-#endif
-#if (defined(CERNLIB_RFRX))&&(defined(CERNLIB_QMAPO))
- OPEN(1,FILE=FIN,FORM=FORM,STATUS='READONLY')
- INQUIRE(1,RECL=INRECL)
-#endif
-#if (defined(CERNLIB_RFRX))&&(defined(CERNLIB_QMVMI)||defined(CERNLIB_QMSGI))
- INQUIRE(1,RECL=INRECL)
-#endif
-#if (defined(CERNLIB_RFRX))&&(defined(CERNLIB_QMVAX))
- OPEN(1,FILE=FIN,FORM=FORM,STATUS='OLD',SHARED,READONLY)
- INQUIRE(1,RECL=INRECL,RECORDTYPE=RECORDTYPE)
- CLOSE(1)
-#endif
-#if (defined(CERNLIB_RFRA))&&(defined(CERNLIB_QMCRY)||defined(CERNLIB_QMCVX))
- INRECL = 80
-#endif
-*
-* Open the input file
-*
-#if (defined(CERNLIB_QMCRY)||defined(CERNLIB_QMCVX)||defined(CERNLIB_QMUIX)||defined(CERNLIB_QMDOS)||defined(CERNLIB_QMLNX))&&(!defined(CERNLIB_QMALT))
- OPEN(1,FILE=FIN,FORM=FORM,STATUS='OLD')
-#endif
-#if defined(CERNLIB_QMALT)
- OPEN(1,FILE=FIN,FORM=FORM,STATUS='OLD',READONLY
-#endif
-#if defined(CERNLIB_QMAPO)
- OPEN(1,FILE=FIN,FORM=FORM,STATUS='READONLY'
-#endif
-#if defined(CERNLIB_QMVAX)
- OPEN(1,FILE=FIN,FORM=FORM,STATUS='OLD',SHARED,READONLY
-#endif
-#if (defined(CERNLIB_QMALT)||defined(CERNLIB_QMAPO)||defined(CERNLIB_QMVAX))&&(defined(CERNLIB_RFRX))
- + ,RECL=INRECL
-#endif
-#if (defined(CERNLIB_QMVAX))&&(defined(CERNLIB_RFRX))
- + ,RECORDTYPE=RECORDTYPE
-#endif
-#if defined(CERNLIB_QMALT)||defined(CERNLIB_QMAPO)||defined(CERNLIB_QMVAX)
- + )
-#endif
-#if (defined(CERNLIB_QMIBM))&&(defined(CERNLIB_RFRX))&&(defined(CERNLIB_IOPACK))
- WRITE(CHRECL,'(I6)') INRECL
- IRC=SYSTEMF('FILEDEF IOFILE01 DISK '//FIN//
- + ' (RECFM U BLOCK '//CHRECL)
-#endif
-#if (defined(CERNLIB_QMIBM))&&(defined(CERNLIB_RFRX))&&(!defined(CERNLIB_IOPACK))
- CALL FILEINF(ISTAT,'RECFM','U','BLKSIZE',INRECL)
-#endif
-#if (defined(CERNLIB_QMIBM))&&(!defined(CERNLIB_IOPACK)||defined(CERNLIB_RFRA))
- OPEN(1,FILE='/'//FIN,FORM=FORM,STATUS='OLD')
-#endif
-C
- CALL MZEBRA(-3)
- CALL MZPAW(MEMOR,' ')
- CHOPT='I'//MODE
-#if (defined(CERNLIB_RFRX))&&(defined(CERNLIB_QMVAX)||defined(CERNLIB_QMSGI)||defined(CERNLIB_QMVMI))
- CALL FZFILE(1,INRECL,CHOPT)
-#endif
-#if (defined(CERNLIB_RFRX))&&(defined(CERNLIB_QMALT)||defined(CERNLIB_QMAPO))
- CALL FZFILE(1,INRECL/4,CHOPT)
-#endif
-#if (defined(CERNLIB_RFRX))&&(defined(CERNLIB_QMIBM)||defined(CERNLIB_QMCRY)||defined(CERNLIB_QMCVX)||defined(CERNLIB_QMIRT)||defined(CERNLIB_QMHPX)||defined(CERNLIB_QMIBX)||defined(CERNLIB_QMNXT)||defined(CERNLIB_QMLNX))
- CALL FZFILE(1,0,CHOPT)
-#endif
-#if defined(CERNLIB_RFRA)
-* Defaults ok on all machines for RFRA
- CALL FZFILE(1,0,CHOPT)
-#endif
-C
- 5 NH=KNSIZE
- CALL FZIN(1,0,0,0,'S',NH,IHEAD)
- IF(IQUEST(1).NE.0) THEN
- WRITE(6,'('' Error in reading the file'')')
- GO TO 99
- END IF
- IF(NH.NE.2) GO TO 5
- IF(IHEAD(1).NE.12345) GO TO 5
- 7 NH=KNSIZE
- CALL FZIN(1,0,0,0,'S',NH,IHEAD)
- IF(IQUEST(1).NE.0) THEN
- WRITE(6,'('' Error in reading the file'')')
- GO TO 99
- END IF
- IF(NH.NE.KNSIZE) GO TO 7
- IF(IHEAD(1).NE.1) GO TO 7
-C
- NREC = ICDIR(KQUOTA)
- NWKEY = ICDIR(KNWKEY)
- KTAGS = KKDES+(NWKEY-1)/10+1
- CHFORM = ' '
- LB = ICDIR(KLB)
- OURECL = ICDIR(LB+1)
-C
-#if defined(CERNLIB_QMIBM)
- CALL FILEINF(ISTAT,'MAXREC',20)
- IF(ISTAT.NE.0) THEN
- WRITE(6,'('' Error in FILEINF 20'')')
- GO TO 99
- END IF
-C
- FOUT(1:1) = '/'
- OPEN(2,FILE=FOUT,
- + ACCESS='DIRECT',
- + FORM='UNFORMATTED',
- + STATUS='UNKNOWN',
- + RECL=4*OURECL)
- CLOSE(2)
-C
- CALL FILEINF(ISTAT,'MAXREC',2**24-1)
- IF(ISTAT.NE.0) THEN
- WRITE(6,'('' Error in FILEINF 2**24-1'')')
- GO TO 99
- END IF
-#endif
-#if defined(CERNLIB_QMVAX)
- CHORG = 'SEQUENTIAL'
- IF(IRELAT.NE.0) CHORG = 'RELATIVE'
-#endif
- OPEN(2,FILE=FOUT,
- + ACCESS='DIRECT',
- + FORM='UNFORMATTED',
-#if defined(CERNLIB_QMVAX)
- + STATUS='NEW',ORGANIZATION=CHORG,
-#endif
-#if defined(CERNLIB_QMIBM)||defined(CERNLIB_QMAPO)||defined(CERNLIB_QMCRY)||defined(CERNLIB_QMCVX)||defined(CERNLIB_QMUIX)||defined(CERNLIB_QMDOS)||defined(CERNLIB_QMLNX)
- + STATUS='UNKNOWN',
-#endif
-#if defined(CERNLIB_QMVAX)||defined(CERNLIB_QMSGI)||defined(CERNLIB_QMVMI)
- + RECL=OURECL
-#endif
-#if defined(CERNLIB_QMAPO)||defined(CERNLIB_QMIBM)||defined(CERNLIB_QMIRT)||defined(CERNLIB_QMSUN)||defined(CERNLIB_QMHPX)||defined(CERNLIB_QMIBX)||defined(CERNLIB_QMALT)||defined(CERNLIB_QMDOS)||defined(CERNLIB_QMLNX)||defined(CERNLIB_QMNXT)
- + RECL=4*OURECL
-#endif
-#if defined(CERNLIB_QMCRY)||defined(CERNLIB_QMCV64)
- + RECL=8*OURECL
-#endif
-#if defined(CERNLIB_QMCV32)
- + RECL=4*OURECL
-#endif
- + )
-C
- DO 10 I=1,NWKEY
- CALL ZITOH(ICDIR(KTAGS+2*I-2),IHTAG,2)
- CALL UHTOC(IHTAG,4,CHTAG(I),8)
- IKDES=(I-1)/10
- IKBIT1=3*I-30*IKDES-2
- IFORM=JBYT(ICDIR(KKDES+IKDES),IKBIT1,3)
- IF(IFORM.EQ.3)THEN
- CHFORM(I:I)='H'
- ELSEIF(IFORM.EQ.4)THEN
- CHFORM(I:I)='A'
- ELSEIF(IFORM.EQ.1)THEN
- CHFORM(I:I)='B'
- ELSE
- CHFORM(I:I)='I'
- ENDIF
- 10 CONTINUE
-C
- CALL FZENDI(1,'IQ')
-C
-* N option did not exist prior to 94B, but now means
-* NEW RZ format
-*
- CALL RZMAKE(2,'RZ',NWKEY,CHFORM,CHTAG,NREC,' ')
-* CALL RZMAKE(2,'RZ',NWKEY,CHFORM,CHTAG,NREC,'N')
- IQ(LTOP+KDATEC)=ICDIR(KDATEC)
- IQ(LTOP+KDATEM)=ICDIR(KDATEM)
- CALL RZFRFZ(1,' ')
- CALL RZLDIR(' ',' ')
- CALL FZENDI(1,' ')
- CALL RZEND('RZ')
-C
- 99 CONTINUE
-#if defined(CERNLIB_QMAPO)||defined(CERNLIB_QMVAX)||defined(CERNLIB_QMCRY)||defined(CERNLIB_QMCVX)||defined(CERNLIB_QMUIX)||defined(CERNLIB_QMDOS)||defined(CERNLIB_QMLNX)
- CLOSE(1)
-#endif
-#if (defined(CERNLIB_QMIBM))&&(defined(CERNLIB_IOPACK))&&(defined(CERNLIB_RFRX))
- IRET=SYSTEMF('FILEDEF IOFILE01 CLEAR')
-#endif
-#if (defined(CERNLIB_QMIBM))&&(!defined(CERNLIB_IOPACK)||defined(CERNLIB_RFRA))
- CLOSE(1)
-#endif
- CLOSE(2)
-C
- END
diff --git a/src/packlib/zebra/qutil/not_cern/rztofrfz/rzlenf.inc b/src/packlib/zebra/qutil/not_cern/rztofrfz/rzlenf.inc
deleted file mode 100644
index 2ef6856..0000000
--- a/src/packlib/zebra/qutil/not_cern/rztofrfz/rzlenf.inc
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: rzlenf.inc,v 1.1.1.1 1996/03/06 10:47:19 mclareni Exp $
-*
-* $Log: rzlenf.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:19 mclareni
-* Zebra
-*
-*
-*
-* rzlenf.inc
-*
-#if defined(CERNLIB_QMIBM)
- PARAMETER(LENF= 21)
-#endif
-#if defined(CERNLIB_QMAPO)||defined(CERNLIB_QMALT)||defined(CERNLIB_QMDOS)
- PARAMETER(LENF=128)
-#endif
-#if (defined(CERNLIB_QMCRY)||defined(CERNLIB_QMVAX)||defined(CERNLIB_QMCVX)||defined(CERNLIB_QMUIX)||defined(CERNLIB_QMLNX))&&(!defined(CERNLIB_QMALT))
- PARAMETER(LENF=255)
-#endif
diff --git a/src/packlib/zebra/qutil/not_cern/rztofrfz/rzmode.inc b/src/packlib/zebra/qutil/not_cern/rztofrfz/rzmode.inc
deleted file mode 100644
index 38d2cca..0000000
--- a/src/packlib/zebra/qutil/not_cern/rztofrfz/rzmode.inc
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: rzmode.inc,v 1.1.1.1 1996/03/06 10:47:19 mclareni Exp $
-*
-* $Log: rzmode.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:19 mclareni
-* Zebra
-*
-*
-*
-* rzmode.inc
-*
-#if defined(CERNLIB_RTOX)||defined(CERNLIB_RFRX)
- CHARACTER*11 FORM
- CHARACTER*1 MODE
- DATA FORM/'UNFORMATTED'/,MODE/'X'/
-#endif
-#if defined(CERNLIB_RTOA)||defined(CERNLIB_RFRA)
- CHARACTER*11 FORM
- CHARACTER*1 MODE
- DATA FORM/'FORMATTED' /,MODE/'A'/
-#endif
diff --git a/src/packlib/zebra/qutil/not_cern/rztofrfz/rzpawc.inc b/src/packlib/zebra/qutil/not_cern/rztofrfz/rzpawc.inc
deleted file mode 100644
index 01123b1..0000000
--- a/src/packlib/zebra/qutil/not_cern/rztofrfz/rzpawc.inc
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: rzpawc.inc,v 1.1.1.1 1996/03/06 10:47:19 mclareni Exp $
-*
-* $Log: rzpawc.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:19 mclareni
-* Zebra
-*
-*
-*
-* rzpawc.inc
-*
- PARAMETER(MEMOR=600000)
diff --git a/src/packlib/zebra/qutil/not_cern/rztofrfz/rztfdo.F b/src/packlib/zebra/qutil/not_cern/rztofrfz/rztfdo.F
deleted file mode 100644
index a477248..0000000
--- a/src/packlib/zebra/qutil/not_cern/rztofrfz/rztfdo.F
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: rztfdo.F,v 1.1.1.1 1996/03/06 10:47:20 mclareni Exp $
-*
-* $Log: rztfdo.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:20 mclareni
-* Zebra
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_zebra/pilot.h"
- SUBROUTINE RZTFDO(CH)
-#include "rzpawc.inc"
- CHARACTER*1 CH
-C
- CALL MZEBRA(-3)
- CALL MZPAW(MEMOR,' ')
- CALL FZFILE(2,900,'O'//CH)
- CALL RZFILE(1,'RZ',' ')
- CALL RZSTAT('//RZ',99,' ')
- CALL RZTOFZ(2,'C')
- CALL FZENDO(2,'TE')
- CALL RZEND('RZ')
-C
- END
diff --git a/src/packlib/zebra/qutil/not_cern/rztofrfz/rztof.F b/src/packlib/zebra/qutil/not_cern/rztofrfz/rztof.F
deleted file mode 100644
index 6be679c..0000000
--- a/src/packlib/zebra/qutil/not_cern/rztofrfz/rztof.F
+++ /dev/null
@@ -1,130 +0,0 @@
-*
-* $Id: rztof.F,v 1.1.1.1 1996/03/06 10:47:19 mclareni Exp $
-*
-* $Log: rztof.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:19 mclareni
-* Zebra
-*
-*
-#include "sys/CERNLIB_machine.h"
-#include "_zebra/pilot.h"
-*
-* Fix call to RZOPEN for IBM systems - remove trailing blank
-* left over from pre-RZOPEN days
-*
-#if defined(CERNLIB_RTOX)
- PROGRAM RTOX
-#endif
-#if defined(CERNLIB_RTOA)
- PROGRAM RTOA
-#endif
-C
-C
-#include "rzpawc.inc"
-#include "rzlenf.inc"
- COMMON / QUEST / IQUEST(100)
- COMMON / PAWC / HMEMOR(MEMOR)
- COMMON /RZCKEY / IHEAD(3),KEY(100),KEY2(100),KEYDUM(50)
-#include "zunit.inc"
-C
- CHARACTER*(LENF) FIN, FOUT
- INTEGER OURECL
-#if defined(CERNLIB_QMIBM)
- INTEGER SYSTEMF
-#endif
-#if (defined(CERNLIB_QMVAX))&&(!defined(CERNLIB_DCLTABLES))
- LOGICAL GET_COMMAND_LINE
- CHARACTER*4 CHVERB
-#endif
-#if (defined(CERNLIB_QMVAX))&&(!defined(CERNLIB_DCLTABLES))&&(defined(CERNLIB_RTOX))
- EXTERNAL RTOX_CLD
-#endif
-#if (defined(CERNLIB_QMVAX))&&(!defined(CERNLIB_DCLTABLES))&&(defined(CERNLIB_RTOA))
- EXTERNAL RTOA_CLD
-#endif
-#include "rzmode.inc"
-C
-#if defined(CERNLIB_QMIBM)
- CALL ERRSET(151,0,-1,1,1)
-#endif
- IQPRNT = 6
-#if (defined(CERNLIB_QMVAX))&&(!defined(CERNLIB_DCLTABLES))&&(defined(CERNLIB_RTOX))
- CHVERB = 'RTOX'
- IF ( .NOT. GET_COMMAND_LINE( RTOX_CLD , CHVERB ) ) THEN
-#endif
-#if (defined(CERNLIB_QMVAX))&&(!defined(CERNLIB_DCLTABLES))&&(defined(CERNLIB_RTOA))
- CHVERB = 'RTOA'
- IF ( .NOT. GET_COMMAND_LINE( RTOA_CLD , CHVERB ) ) THEN
-#endif
-#if (defined(CERNLIB_QMVAX))&&(!defined(CERNLIB_DCLTABLES))
- PRINT 9001,CHVERB
-9001 FORMAT(1X,A,'. invalid command line')
- CALL EXIT
- ENDIF
-#endif
- CALL GETF(FIN,FOUT,'RZ','F'//MODE)
-C
-#if (defined(CERNLIB_RTOX))&&(defined(CERNLIB_QMDOS)||defined(CERNLIB_QMLNX)||defined(CERNLIB_QMNXT))
- OURECL = 3600
-#endif
-#if (defined(CERNLIB_RTOX))&&(defined(CERNLIB_QMIBM)||defined(CERNLIB_QMAPO)||defined(CERNLIB_QMCRY)||defined(CERNLIB_QMCVX)||defined(CERNLIB_QMALT)||defined(CERNLIB_QMIRT)||defined(CERNLIB_QMSUN)||defined(CERNLIB_QMHPX)||defined(CERNLIB_QMIBX))
- OURECL = 3600
-#endif
-#if (defined(CERNLIB_RTOX))&&(defined(CERNLIB_QMVAX)||defined(CERNLIB_QMSGI)||defined(CERNLIB_QMVMI))
- OURECL = 900
-#endif
-#if (defined(CERNLIB_RTOA))&&(defined(CERNLIB_QMIBM)||defined(CERNLIB_QMVAX)||defined(CERNLIB_QMCRY)||defined(CERNLIB_QMCVX)||defined(CERNLIB_QMAPO)||defined(CERNLIB_QMUIX)||defined(CERNLIB_QMDOS)||defined(CERNLIB_QMLNX)||defined(CERNLIB_QMNXT))
- OURECL = 80
-#endif
- 10 LRECL = 0
-#if defined(CERNLIB_QMIBM)
- CALL RZOPEN(1,'//RZ',FIN(2:),' ',LRECL,ISTAT)
-#endif
-#if !defined(CERNLIB_QMIBM)
- CALL RZOPEN(1,'//RZ',FIN,' ',LRECL,ISTAT)
-#endif
- IF(ISTAT.NE.0) STOP
-#if (defined(CERNLIB_RTOX))&&(defined(CERNLIB_QMIBM))&&(defined(CERNLIB_IOPACK))
- IRET=SYSTEMF('FILEDEF IOFILE02 DISK '//FOUT//
- + ' (RECFM U BLOCK 3600')
-#endif
-#if (defined(CERNLIB_RTOX))&&(defined(CERNLIB_QMIBM))&&(!defined(CERNLIB_IOPACK))
- CALL FILEINF (IRET,'RECFM','U','LRECL',3600)
- FOUT(1:1)='/'
-#endif
-#if (defined(CERNLIB_RTOA))&&(defined(CERNLIB_QMIBM))
- CALL FILEINF (IRET,'RECFM','F','LRECL', 80)
- FOUT(1:1)='/'
-#endif
-#if (defined(CERNLIB_QMIBM)||defined(CERNLIB_QMCRY)||defined(CERNLIB_QMCVX)||defined(CERNLIB_QMUIX)||defined(CERNLIB_QMDOS)||defined(CERNLIB_QMLNX))&&(!defined(CERNLIB_QMALT))
- OPEN(2,FILE=FOUT,FORM=FORM, STATUS='UNKNOWN')
-#endif
-#if defined(CERNLIB_QMALT)||defined(CERNLIB_QMAPO)
- OPEN(2,FILE=FOUT,FORM=FORM,RECL=OURECL,STATUS='UNKNOWN')
-#endif
-#if defined(CERNLIB_QMVAX)
- OPEN(2,FILE=FOUT,FORM=FORM,RECL=OURECL,STATUS='NEW',
- + RECORDTYPE='FIXED',
-#endif
-#if (defined(CERNLIB_QMVAX))&&(defined(CERNLIB_RTOX))
- + BLOCKSIZE=OURECL*4,
- + CARRIAGECONTROL='NONE')
-#endif
-#if (defined(CERNLIB_QMVAX))&&(defined(CERNLIB_RTOA))
- + CARRIAGECONTROL='LIST')
-#endif
-C
- CALL RZTFDO(MODE)
-C
- CLOSE(1)
-#if defined(CERNLIB_QMAPO)||defined(CERNLIB_QMVAX)||defined(CERNLIB_QMCRY)||defined(CERNLIB_QMCVX)||defined(CERNLIB_QMUIX)||defined(CERNLIB_QMDOS)||defined(CERNLIB_QMLNX)
- CLOSE(2)
-#endif
-#if (defined(CERNLIB_QMIBM))&&(!defined(CERNLIB_IOPACK)||defined(CERNLIB_RTOA))
- CLOSE(2)
-#endif
-#if (defined(CERNLIB_QMIBM))&&(defined(CERNLIB_IOPACK))&&(defined(CERNLIB_RTOX))
- IRET=SYSTEMF('FILEDEF IOFILE02 CLEAR')
-#endif
-C
- END
diff --git a/src/packlib/zebra/qutil/nzbank.F b/src/packlib/zebra/qutil/nzbank.F
deleted file mode 100644
index 3ebaa7a..0000000
--- a/src/packlib/zebra/qutil/nzbank.F
+++ /dev/null
@@ -1,39 +0,0 @@
-*
-* $Id: nzbank.F,v 1.3 1999/06/18 13:31:21 couet Exp $
-*
-* $Log: nzbank.F,v $
-* Revision 1.3 1999/06/18 13:31:21 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.2 1996/04/18 16:13:39 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:14 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- FUNCTION NZBANK (IXSTOR,LGO)
-
-C- COUNT NUMBER OF BANKS
-
-#include "zebra/q.inc"
-*
-
-#include "zebra/q_jbyt.inc"
-
-#include "zebra/qstore.inc"
-
- NCOUNT = 0
-
- L = LGO
-
- 21 IF (L.EQ.0) GO TO 29
- L = LQ(KQS+L)
- NCOUNT = NCOUNT + 1
- GO TO 21
-
- 29 NZBANK = NCOUNT
- RETURN
- END
diff --git a/src/packlib/zebra/qutil/nzfind.F b/src/packlib/zebra/qutil/nzfind.F
deleted file mode 100644
index fc1edf7..0000000
--- a/src/packlib/zebra/qutil/nzfind.F
+++ /dev/null
@@ -1,47 +0,0 @@
-*
-* $Id: nzfind.F,v 1.3 1999/06/18 13:31:22 couet Exp $
-*
-* $Log: nzfind.F,v $
-* Revision 1.3 1999/06/18 13:31:22 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.2 1996/04/18 16:13:40 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:15 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- FUNCTION NZFIND (IXSTOR,LGO,ITEXT,JWORD)
-
-C- FIND AND COUNT ALL BANKS CONTAINING ITEXT IN WORD JWORD
-C- SEARCH LINEAR STRUCTURE STARTING WITH BANK AT LGO
-C- RETURN COUNT AS VALUE, BANK ADRS IN IQUEST
-
-#include "zebra/q.inc"
-#include "zebra/quest.inc"
-*
-
-#include "zebra/q_jbyt.inc"
-
-#include "zebra/qstore.inc"
-
- NCOUNT = 0
- L = LGO
- IF (L.EQ.0) GO TO 39
- IF (IQ(KQS+L+JWORD).EQ.ITEXT) GO TO 24
-
- 21 L = LQ(KQS+L)
- IF (L.EQ.0) GO TO 39
- IF (IQ(KQS+L+JWORD).NE.ITEXT) GO TO 21
-
- 24 NCOUNT = NCOUNT + 1
- IF (NCOUNT.GE.101) GO TO 21
- IQUEST(NCOUNT) = L
- GO TO 21
-
- 39 NZFIND = NCOUNT
- RETURN
- END
diff --git a/src/packlib/zebra/qutil/nzlong.F b/src/packlib/zebra/qutil/nzlong.F
deleted file mode 100644
index 30030d7..0000000
--- a/src/packlib/zebra/qutil/nzlong.F
+++ /dev/null
@@ -1,60 +0,0 @@
-*
-* $Id: nzlong.F,v 1.3 1999/06/18 13:31:22 couet Exp $
-*
-* $Log: nzlong.F,v $
-* Revision 1.3 1999/06/18 13:31:22 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.2 1996/04/18 16:13:41 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:15 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- FUNCTION NZLONG (IXSTOR,LGO,NTEXT,ITEXT,JWORD)
-
-C- FIND AND COUNT ALL BANKS CONTAINING ITEXT(1-NTEXT)
-C- IN WORDS JWORD, .., JWORD+NTEXT-1
-C- SEARCH LINEAR STRUCTURE STARTING WITH BANK AT LGO
-C- RETURN COUNT AS VALUE, BANK ADRS IN IQUEST
-
-#include "zebra/q.inc"
-#include "zebra/quest.inc"
-*
- DIMENSION ITEXT(9)
-
-#include "zebra/q_jbyt.inc"
-
-#include "zebra/qstore.inc"
-
- NCOUNT = 0
- N2 = NTEXT - 2
- L = LGO
- IF (L.EQ.0) GO TO 39
- IF (IQ(KQS+L+JWORD).EQ.ITEXT(1)) GO TO 24
-
- 21 L = LQ(KQS+L)
- IF (L.EQ.0) GO TO 39
- IF (IQ(KQS+L+JWORD).NE.ITEXT(1)) GO TO 21
-
- 24 IF (N2) 29, 28, 26
-
- 26 LB = L + JWORD - 1
- DO 27 J=2,NTEXT
- IF (IQ(KQS+LB+J).NE.ITEXT(J)) GO TO 21
- 27 CONTINUE
- GO TO 29
-
- 28 IF (IQ(KQS+L+JWORD+1).NE.ITEXT(2)) GO TO 21
-
- 29 NCOUNT = NCOUNT + 1
- IF (NCOUNT.GE.101) GO TO 21
- IQUEST(NCOUNT) = L
- GO TO 21
-
- 39 NZLONG = NCOUNT
- RETURN
- END
diff --git a/src/packlib/zebra/qutil/qnext.F b/src/packlib/zebra/qutil/qnext.F
deleted file mode 100644
index 2c2a573..0000000
--- a/src/packlib/zebra/qutil/qnext.F
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: qnext.F,v 1.2 1999/06/18 13:31:22 couet Exp $
-*
-* $Log: qnext.F,v $
-* Revision 1.2 1999/06/18 13:31:22 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:15 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
-#if !defined(CERNLIB_NODUMMY)
- SUBROUTINE QNEXT
-
-C- DUMMY VERSION OF THE USER ROUTINE QNEXT
-
-#include "zebra/zunit.inc"
-*
-
-
- LUN = IQTYPE
- IF (LUN.NE.0) GO TO 12
- 11 LUN = IQLOG
- 12 WRITE (LUN,9001)
- IF (LUN.NE.IQLOG) GO TO 11
- STOP
-
- 9001 FORMAT ('0!!!!! DUMMY ROUTINE QNEXT REACHED.')
- END
-#endif
diff --git a/src/packlib/zebra/qutil/qutyinv/Imakefile b/src/packlib/zebra/qutil/qutyinv/Imakefile
deleted file mode 100644
index f11511d..0000000
--- a/src/packlib/zebra/qutil/qutyinv/Imakefile
+++ /dev/null
@@ -1,3 +0,0 @@
-SRCS_F= izbcd.F izbcdt.F izbcdv.F izhnum.F zhtoi.F zitoh.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/zebra/qutil/qutyinv/izbcd.F b/src/packlib/zebra/qutil/qutyinv/izbcd.F
deleted file mode 100644
index 9d9260a..0000000
--- a/src/packlib/zebra/qutil/qutyinv/izbcd.F
+++ /dev/null
@@ -1,10 +0,0 @@
- FUNCTION IZBCD (MCHAR)
-
-#include "zebra/zceta.inc"
-
-#include "zebra/q_and.inc"
-
- JV = IAND (MCHAR,255)
- IZBCD = IQCETA(JV+1)
- RETURN
- END
diff --git a/src/packlib/zebra/qutil/qutyinv/izbcdt.F b/src/packlib/zebra/qutil/qutyinv/izbcdt.F
deleted file mode 100644
index e0e379e..0000000
--- a/src/packlib/zebra/qutil/qutyinv/izbcdt.F
+++ /dev/null
@@ -1,32 +0,0 @@
- SUBROUTINE IZBCDT (NP,ITABT)
-
-#include "zebra/quest.inc"
-#include "zebra/zceta.inc"
-#include "zebra/zkrakc.inc"
-C-------------- END CDE --------------
- DIMENSION NP(9), ITABT(99)
-
-#include "zebra/q_and.inc"
-
- N = NP(1)
- LIM = ITABT(1)
- JGOOD = 0
- JBAD = 0
-
- DO 29 JWH=1,N
- JV = IAND (IQHOLK(JWH),255)
- JV = IQTCET(JV+1)
-
- IF (JV.GT.LIM) GO TO 27
- JV = ITABT(JV+1)
- IF (JV+1) 29, 27, 24
- 24 JGOOD = JGOOD + 1
- IQCETK(JGOOD) = JV
- GO TO 29
-
- 27 JBAD = JBAD + 1
- 29 CONTINUE
- IQUEST(1) = JGOOD
- IQUEST(2) = JBAD
- RETURN
- END
diff --git a/src/packlib/zebra/qutil/qutyinv/izbcdv.F b/src/packlib/zebra/qutil/qutyinv/izbcdv.F
deleted file mode 100644
index 987e0ec..0000000
--- a/src/packlib/zebra/qutil/qutyinv/izbcdv.F
+++ /dev/null
@@ -1,12 +0,0 @@
- SUBROUTINE IZBCDV (NP)
-
-#include "zebra/zceta.inc"
-#include "zebra/zkrakc.inc"
-
-#include "zebra/q_and.inc"
-
- DO 29 JWH=1,NP
- JV = IAND (IQHOLK(JWH),255)
- 29 IQCETK(JWH) = IQCETA(JV+1)
- RETURN
- END
diff --git a/src/packlib/zebra/qutil/qutyinv/izhnum.F b/src/packlib/zebra/qutil/qutyinv/izhnum.F
deleted file mode 100644
index fceef6b..0000000
--- a/src/packlib/zebra/qutil/qutyinv/izhnum.F
+++ /dev/null
@@ -1,10 +0,0 @@
- SUBROUTINE IZHNUM (HOLL,INTV,NP)
-
- INTEGER INTV(99), HOLL(99)
-
-#include "zebra/q_and.inc"
-
- DO 39 JWH=1,NP
- 39 INTV(JWH) = IAND (HOLL(JWH), 255)
- RETURN
- END
diff --git a/src/packlib/zebra/qutil/qutyinv/zhtoi.F b/src/packlib/zebra/qutil/qutyinv/zhtoi.F
deleted file mode 100644
index 2aebc01..0000000
--- a/src/packlib/zebra/qutil/qutyinv/zhtoi.F
+++ /dev/null
@@ -1,26 +0,0 @@
- SUBROUTINE ZHTOI (HOLL,INTV,NP)
-
-#include "zebra/zceta.inc"
-C-------------- END CDE --------------
- INTEGER INTV(99), HOLL(99)
-
-#include "zebra/q_and.inc"
-#include "zebra/q_or.inc"
-
- DO 39 JWH=1,NP
- MWH = HOLL(JWH)
- INTW = 0
-
- DO 29 JL=1,4
- INTW = ISHFT (INTW,-6)
- JV = IAND (MWH,255)
- IF (JV.EQ.32) THEN
- IF (JL.NE.1) GO TO 29
- ENDIF
- JV = IQTCET(JV+1)
- INTW = IOR (INTW,ISHFT(JV,18))
- 29 MWH = ISHFT (MWH,-8)
-
- 39 INTV(JWH) = INTW
- RETURN
- END
diff --git a/src/packlib/zebra/qutil/qutyinv/zitoh.F b/src/packlib/zebra/qutil/qutyinv/zitoh.F
deleted file mode 100644
index 9b026d1..0000000
--- a/src/packlib/zebra/qutil/qutyinv/zitoh.F
+++ /dev/null
@@ -1,22 +0,0 @@
- SUBROUTINE ZITOH (INTV,HOLL,NP)
-
-#include "zebra/zbcd.inc"
-C-------------- END CDE --------------
- INTEGER INTV(99), HOLL(99)
-
-#include "zebra/q_and.inc"
-#include "zebra/q_or.inc"
-
- DO 39 JWH=1,NP
- INTW = INTV(JWH)
- MWH = 0
-
- DO 29 JL=1,4
- MWH = ISHFT (MWH,-8)
- JV = IAND (INTW,63)
- MWH = IOR (MWH, ISHFT(NQHOLL(JV),24))
- 29 INTW = ISHFT (INTW,-6)
-
- 39 HOLL(JWH) = MWH
- RETURN
- END
diff --git a/src/packlib/zebra/qutil/qutyvax/Imakefile b/src/packlib/zebra/qutil/qutyvax/Imakefile
deleted file mode 100644
index a9b3e97..0000000
--- a/src/packlib/zebra/qutil/qutyvax/Imakefile
+++ /dev/null
@@ -1,3 +0,0 @@
-SRCS_F= lzfval.F zsorth.F zsorvh.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/zebra/qutil/qutyvax/lzfval.F b/src/packlib/zebra/qutil/qutyvax/lzfval.F
deleted file mode 100644
index 31e8ac8..0000000
--- a/src/packlib/zebra/qutil/qutyvax/lzfval.F
+++ /dev/null
@@ -1,33 +0,0 @@
- FUNCTION LZFVAL (IXSTOR,LGO,VAL,TOL,JWORD)
-
-C- FIND BANK CONTAINING IN WORD JWORD FL.P. VAL WITHIN TOL
-C- SEARCH LINEAR STRUCTURE STARTING WITH BANK AT LGO
-C- RETURN BANK-ADR AS VALUE
-
-#include "zebra/q.inc"
-C-------------- END CDE --------------
- EQUIVALENCE (IA,AA)
-
-#include "zebra/q_jbyt.inc"
-
-#include "zebra/qstore.inc"
-
- VLOW = VAL - TOL
- VHI = VAL + TOL
-
- L = LGO
- 21 IF (L.EQ.0) GO TO 29
- IA = IQ(KQS+L+JWORD)
- IF (IA.EQ.0) GO TO 22
- JEXP = JBYT (IA,8,8)
- IF (JEXP.EQ.0) GO TO 27
- IF (JEXP.EQ.255) GO TO 27
-
- 22 IF (AA.LT.VLOW) GO TO 27
- IF (AA.LE.VHI) GO TO 29
- 27 L = LQ(KQS+L)
- GO TO 21
-
- 29 LZFVAL= L
- RETURN
- END
diff --git a/src/packlib/zebra/qutil/qutyvax/zsorth.F b/src/packlib/zebra/qutil/qutyvax/zsorth.F
deleted file mode 100644
index 68815b5..0000000
--- a/src/packlib/zebra/qutil/qutyvax/zsorth.F
+++ /dev/null
@@ -1,76 +0,0 @@
- SUBROUTINE ZSORTH (IXSTOR,LGOP,JWORD)
-
-C- SORT BANKS AT LGO FOR WORDS IQ(L+JWORD) TO BE IN INCREASING ORDER
-
-#include "zebra/mqsys.inc"
-C-------------- END CDE --------------
- DIMENSION JWORD(9), LGOP(9)
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HZSOR, 4HTH /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HZSORTH /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'ZSORTH ')
-#endif
-
-#include "zebra/q_jbyt.inc"
-
-
- LGO = LGOP(1)
- IF (LGO.EQ.0) RETURN
-
-#include "zebra/qtraceq.inc"
-#include "zebra/qstore.inc"
-
- JW = JWORD(1)
- KGO = LQSTA(KQT+2) - 1
- LQ(KQS+KGO) = LGO
- LL = LGO
- IFL = 0
-
- 11 LN = LQ(KQS+LL)
- IF (LN.EQ.0) GO TO 81
- IF (IUCOMH(IQ(KQS+LN+JW),IQ(KQS+LL+JW),4).LT.0) GO TO 21
- LL = LN
- GO TO 11
-
-C-- BANK LN OUT OF SEQUENCE
-
- 21 LQ(KQS+LL) = LQ(KQS+LN)
- IFL = 7
- K = KGO
-
- 24 L = LQ(KQS+K)
- IF (IUCOMH(IQ(KQS+LN+JW),IQ(KQS+L+JW),4).LT.0) GO TO 29
- K = L
- GO TO 24
-
-C-- PLACE FOR BANK LN FOUND
-
- 29 LQ(KQS+LN) = L
- LQ(KQS+K) = LN
- GO TO 11
-
-C---- FINISHED, CHAIN K-LINKS
-
- 81 IF (IFL.EQ.0) GO TO 999
- K = LQ(KQS+LGO+2)
- L = LQ(KQS+KGO)
- LQ(KQS+L+2) = K
- IF (K.NE.0) LQ(KQS+K)=L
- LGOP(1) = L
-
- 84 K = L
- L = LQ(KQS+K)
- IF (L.EQ.0) GO TO 999
- LQ(KQS+L+2) = K
- K = L
- GO TO 84
-
-#include "zebra/qtrace99.inc"
- RETURN
- END
diff --git a/src/packlib/zebra/qutil/qutyvax/zsorvh.F b/src/packlib/zebra/qutil/qutyvax/zsorvh.F
deleted file mode 100644
index cbeae76..0000000
--- a/src/packlib/zebra/qutil/qutyvax/zsorvh.F
+++ /dev/null
@@ -1,78 +0,0 @@
- SUBROUTINE ZSORVH (IXSTOR,LGOP,JWORD,NWORDS)
-
-C- SORT BANKS AT LGO SUCH THAT THE 'NWORDS' LONG KEY STRINGS
-C- STARTING AT Q(L+JWORD) ARE IN INCREASING ORDER
-
-#include "zebra/mqsys.inc"
-C-------------- END CDE --------------
- DIMENSION JWORD(9), NWORDS(9), LGOP(9)
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HZSOR, 4HVH /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HZSORVH /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'ZSORVH ')
-#endif
-
-#include "zebra/q_jbyt.inc"
-
-
- LGO = LGOP(1)
- IF (LGO.EQ.0) RETURN
-
-#include "zebra/qtraceq.inc"
-#include "zebra/qstore.inc"
-
- JW = JWORD(1)
- NCH = 4*NWORDS(1)
- KGO = LQSTA(KQT+2) - 1
- LQ(KQS+KGO) = LGO
- LL = LGO
- IFL = 0
-
- 11 LN = LQ(KQS+LL)
- IF (LN.EQ.0) GO TO 81
- IF (IUCOMH(IQ(KQS+LN+JW),IQ(KQS+LL+JW),NCH).LT.0) GO TO 21
- LL = LN
- GO TO 11
-
-C-- BANK LN OUT OF SEQUENCE
-
- 21 LQ(KQS+LL) = LQ(KQS+LN)
- IFL = 7
- K = KGO
-
- 24 L = LQ(KQS+K)
- IF (IUCOMH(IQ(KQS+LN+JW),IQ(KQS+L+JW),NCH).LT.0) GO TO 29
- K = L
- GO TO 24
-
-C-- PLACE FOR BANK LN FOUND
-
- 29 LQ(KQS+LN) = L
- LQ(KQS+K) = LN
- GO TO 11
-
-C---- FINISHED, CHAIN K-LINKS
-
- 81 IF (IFL.EQ.0) GO TO 999
- K = LQ(KQS+LGO+2)
- L = LQ(KQS+KGO)
- LQ(KQS+L+2) = K
- IF (K.NE.0) LQ(KQS+K)=L
- LGOP(1) = L
-
- 84 K = L
- L = LQ(KQS+K)
- IF (L.EQ.0) GO TO 999
- LQ(KQS+L+2) = K
- K = L
- GO TO 84
-
-#include "zebra/qtrace99.inc"
- RETURN
- END
diff --git a/src/packlib/zebra/qutil/qutyz32/Imakefile b/src/packlib/zebra/qutil/qutyz32/Imakefile
deleted file mode 100644
index 7dabd00..0000000
--- a/src/packlib/zebra/qutil/qutyz32/Imakefile
+++ /dev/null
@@ -1,4 +0,0 @@
-SRCS_F= izbcd.F izbcdt.F izbcdv.F izchav.F izhnum.F zhtoi.F \ @@\
- zitoh.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/zebra/qutil/qutyz32/izbcd.F b/src/packlib/zebra/qutil/qutyz32/izbcd.F
deleted file mode 100644
index b8bb8d4..0000000
--- a/src/packlib/zebra/qutil/qutyz32/izbcd.F
+++ /dev/null
@@ -1,10 +0,0 @@
- FUNCTION IZBCD (MCHAR)
-
-#include "zebra/zceta.inc"
-
-#include "zebra/q_shiftr.inc"
-
- JV = ISHFTR (MCHAR,24)
- IZBCD = IQCETA(JV+1)
- RETURN
- END
diff --git a/src/packlib/zebra/qutil/qutyz32/izbcdt.F b/src/packlib/zebra/qutil/qutyz32/izbcdt.F
deleted file mode 100644
index 479e308..0000000
--- a/src/packlib/zebra/qutil/qutyz32/izbcdt.F
+++ /dev/null
@@ -1,31 +0,0 @@
- SUBROUTINE IZBCDT (NP,ITABT)
-
-#include "zebra/quest.inc"
-#include "zebra/zceta.inc"
-#include "zebra/zkrakc.inc"
-C-------------- END CDE --------------
- DIMENSION NP(9), ITABT(99)
-
-#include "zebra/q_shiftr.inc"
-
- N = NP(1)
- LIM = ITABT(1)
- JGOOD = 0
- JBAD = 0
-
- DO 29 JWH=1,N
- JV = ISHFTR (IQHOLK(JWH),24)
- JV = IQTCET(JV+1)
- IF (JV.GT.LIM) GO TO 27
- JV = ITABT(JV+1)
- IF (JV+1) 29, 27, 24
- 24 JGOOD = JGOOD + 1
- IQCETK(JGOOD) = JV
- GO TO 29
-
- 27 JBAD = JBAD + 1
- 29 CONTINUE
- IQUEST(1) = JGOOD
- IQUEST(2) = JBAD
- RETURN
- END
diff --git a/src/packlib/zebra/qutil/qutyz32/izbcdv.F b/src/packlib/zebra/qutil/qutyz32/izbcdv.F
deleted file mode 100644
index 3f77b91..0000000
--- a/src/packlib/zebra/qutil/qutyz32/izbcdv.F
+++ /dev/null
@@ -1,16 +0,0 @@
- SUBROUTINE IZBCDV (NP)
-
-#include "zebra/zceta.inc"
-#include "zebra/zkrakc.inc"
-
- DIMENSION NP(9)
-
-#include "zebra/q_shiftr.inc"
-
- N = NP(1)
-
- DO 29 JWH=1,N
- JV = ISHFTR (IQHOLK(JWH),24)
- 29 IQCETK(JWH) = IQCETA(JV+1)
- RETURN
- END
diff --git a/src/packlib/zebra/qutil/qutyz32/izchav.F b/src/packlib/zebra/qutil/qutyz32/izchav.F
deleted file mode 100644
index 129fb58..0000000
--- a/src/packlib/zebra/qutil/qutyz32/izchav.F
+++ /dev/null
@@ -1,30 +0,0 @@
- SUBROUTINE IZCHAV (NP)
-
-#include "zebra/zceta.inc"
-#include "zebra/zkrakc.inc"
-C-------------- END CDE --------------
- DIMENSION NP(9)
-
-#include "zebra/q_and.inc"
-#include "zebra/q_shiftr.inc"
-
- N = ISHFTR (NP(1)+3, 2)
- JCE = 0
-
- DO 29 JWH=1,N
- MWH = IQHOLK(JWH)
-
- JV = ISHFTR (MWH,24)
- IQCETK(JCE+1) = IQCETA(JV+1)
-
- JV = IAND (ISHFTR(MWH,16), 255)
- IQCETK(JCE+2) = IQCETA(JV+1)
-
- JV = IAND (ISHFTR(MWH,8), 255)
- IQCETK(JCE+3) = IQCETA(JV+1)
-
- JV = IAND (MWH, 255)
- IQCETK(JCE+4) = IQCETA(JV+1)
- 29 JCE = JCE + 4
- RETURN
- END
diff --git a/src/packlib/zebra/qutil/qutyz32/izhnum.F b/src/packlib/zebra/qutil/qutyz32/izhnum.F
deleted file mode 100644
index 026f52a..0000000
--- a/src/packlib/zebra/qutil/qutyz32/izhnum.F
+++ /dev/null
@@ -1,12 +0,0 @@
- SUBROUTINE IZHNUM (HOLL,INTV,NP)
-
- INTEGER INTV(99), HOLL(99), NP(9)
-
-#include "zebra/q_shiftr.inc"
-
- N = NP(1)
-
- DO 39 JWH=1,N
- 39 INTV(JWH) = ISHFTR (HOLL(JWH), 24)
- RETURN
- END
diff --git a/src/packlib/zebra/qutil/qutyz32/zhtoi.F b/src/packlib/zebra/qutil/qutyz32/zhtoi.F
deleted file mode 100644
index 5b6d42c..0000000
--- a/src/packlib/zebra/qutil/qutyz32/zhtoi.F
+++ /dev/null
@@ -1,35 +0,0 @@
- SUBROUTINE ZHTOI (HOLL,INTV,NP)
-
-#include "zebra/zceta.inc"
-C-------------- END CDE --------------
- INTEGER INTV(99), HOLL(99), NP(9)
-#if defined(CERNLIB_QASCII)
- PARAMETER (IBLANK=32)
-#endif
-#if defined(CERNLIB_QEBCDIC)
- PARAMETER (IBLANK=64)
-#endif
-
-#include "zebra/q_and.inc"
-#include "zebra/q_or.inc"
-#include "zebra/q_shiftl.inc"
-#include "zebra/q_shiftr.inc"
-
- N = NP(1)
-
- DO 39 JWH=1,N
- MWH = HOLL(JWH)
- INTW = 0
-
- DO 29 JL=1,4
- INTW = ISHFTL (INTW,6)
- JV = IAND (MWH,255)
- IF (JV.EQ.IBLANK) THEN
- IF (JL.NE.4) GO TO 29
- ENDIF
- INTW = IOR (INTW, IQTCET(JV+1))
- 29 MWH = ISHFTR (MWH,8)
-
- 39 INTV(JWH) = INTW
- RETURN
- END
diff --git a/src/packlib/zebra/qutil/qutyz32/zitoh.F b/src/packlib/zebra/qutil/qutyz32/zitoh.F
deleted file mode 100644
index 944defa..0000000
--- a/src/packlib/zebra/qutil/qutyz32/zitoh.F
+++ /dev/null
@@ -1,26 +0,0 @@
- SUBROUTINE ZITOH (INTV,HOLL,NP)
-
-#include "zebra/zbcd.inc"
-C-------------- END CDE --------------
- INTEGER INTV(99), HOLL(99), NP(9)
-
-#include "zebra/q_and.inc"
-#include "zebra/q_or.inc"
-#include "zebra/q_shiftl.inc"
-#include "zebra/q_shiftr.inc"
-
- N = NP(1)
-
- DO 39 JWH=1,N
- INTW = INTV(JWH)
- MWH = 0
-
- DO 29 JL=1,4
- MWH = ISHFTL (MWH,8)
- JV = IAND (INTW,63)
- MWH = IOR (MWH, NQHOLL(JV))
- 29 INTW = ISHFTR (INTW,6)
-
- 39 HOLL(JWH) = MWH
- RETURN
- END
diff --git a/src/packlib/zebra/qutil/zhtoi.F b/src/packlib/zebra/qutil/zhtoi.F
deleted file mode 100644
index 2bb42d5..0000000
--- a/src/packlib/zebra/qutil/zhtoi.F
+++ /dev/null
@@ -1,66 +0,0 @@
-*
-* $Id: zhtoi.F,v 1.4 1999/06/18 13:31:22 couet Exp $
-*
-* $Log: zhtoi.F,v $
-* Revision 1.4 1999/06/18 13:31:22 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.3 1998/09/25 09:33:24 mclareni
-* Modifications for the Mklinux port flagged by CERNLIB_PPC
-*
-* Revision 1.2 1996/09/23 12:20:37 cernlib
-* add Linux
-*
-* Revision 1.1.1.1 1996/03/06 10:47:15 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
-#if defined(CERNLIB_Z32)
-#include "qutyz32/zhtoi.F"
-#elif (defined(CERNLIB_VAXVMS))||(defined(CERNLIB_QMVMI)) \
- ||(defined(CERNLIB_QMDOS))||(defined(CERNLIB_TMO)) \
- ||((defined(CERNLIB_QMLNX) && !defined(CERNLIB_PPC)))
-#include "qutyinv/zhtoi.F"
-#elif (defined(CERNLIB_CONVEX))&&(defined(CERNLIB_SINGLE))
-#include "not_cern/qutycvx/zhtoi.F"
-#elif defined(CERNLIB_CRAY)
-#include "not_cern/qutycry/zhtoi.F"
-#elif defined(CERNLIB_CDC)
-#include "not_cern/qutycdc/zhtoi.F"
-#elif defined(CERNLIB_PDP)
-#include "not_cern/qutypdp/zhtoi.F"
-#else
- SUBROUTINE ZHTOI (HOLL,INTV,NP)
-
-C- This is a slow stop-gap solution only !!!
-
-#include "zebra/zceta.inc"
-*
- COMMON /SLATE/ DUMMY(8), MM(4), MIM(4), DUMB(24)
-
- DIMENSION HOLL(99), INTV(99), NP(9)
- DIMENSION MPAK(2)
- DATA MPAK /6,4/
-
-
- N = NP(1)
-
- DO 39 JW=1,N
- CALL UBLOW (HOLL(JW),MM(1),4)
- CALL IZHNUM (MM,MIM,4)
- INTW = 0
-
- MM(1) = IQTCET(MIM(1))
-
- DO 16 J=2,4
- MM(J) = IQTCET(MIM(J))
- IF (MM(J).EQ.45) MM(J) = 0
- 16 CONTINUE
-
- CALL PKBYT (MM(1),INTW,1,4,MPAK(1))
- 39 INTV(JW) = INTW
- RETURN
- END
-#endif
diff --git a/src/packlib/zebra/qutil/zitoh.F b/src/packlib/zebra/qutil/zitoh.F
deleted file mode 100644
index d8731f8..0000000
--- a/src/packlib/zebra/qutil/zitoh.F
+++ /dev/null
@@ -1,62 +0,0 @@
-*
-* $Id: zitoh.F,v 1.4 1999/06/18 13:31:22 couet Exp $
-*
-* $Log: zitoh.F,v $
-* Revision 1.4 1999/06/18 13:31:22 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.3 1998/09/25 09:33:25 mclareni
-* Modifications for the Mklinux port flagged by CERNLIB_PPC
-*
-* Revision 1.2 1996/09/23 12:20:38 cernlib
-* add Linux
-*
-* Revision 1.1.1.1 1996/03/06 10:47:15 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
-#if defined(CERNLIB_Z32)
-#include "qutyz32/zitoh.F"
-#elif (defined(CERNLIB_VAXVMS))||(defined(CERNLIB_QMVMI)) \
- ||(defined(CERNLIB_QMDOS))||(defined(CERNLIB_TMO)) \
- ||((defined(CERNLIB_QMLNX) && !defined(CERNLIB_PPC)))
-#include "qutyinv/zitoh.F"
-#elif (defined(CERNLIB_CONVEX))&&(defined(CERNLIB_SINGLE))
-#include "not_cern/qutycvx/zitoh.F"
-#elif defined(CERNLIB_CRAY)
-#include "not_cern/qutycry/zitoh.F"
-#elif defined(CERNLIB_CDC)
-#include "not_cern/qutycdc/zitoh.F"
-#elif defined(CERNLIB_PDP)
-#include "not_cern/qutypdp/zitoh.F"
-#else
- SUBROUTINE ZITOH (INTV,HOLL,NP)
-
-C- This is a rather slow stop-gap solution only !!!
-
-#include "zebra/zbcd.inc"
-*
- COMMON /SLATE/ DUMMY(8), MM(4), DUMB(28)
-
- DIMENSION INTV(99), HOLL(99), NP(9)
- DIMENSION MPAK(2)
- DATA MPAK /6,4/
-
-
- N = NP(1)
-
- DO 39 JW=1,N
- CALL UPKBYT (INTV(JW),1,MM(1),4,MPAK(1))
-
- DO 16 J=1,4
- JV = MM(J)
- IF (JV.EQ.0) JV=45
- 16 MM(J) = IQLETT(JV)
-
- CALL UBUNCH (MM(1),HOLL(JW),4)
- 39 CONTINUE
- RETURN
- END
-#endif
diff --git a/src/packlib/zebra/qutil/zkrak.F b/src/packlib/zebra/qutil/zkrak.F
deleted file mode 100644
index 393551b..0000000
--- a/src/packlib/zebra/qutil/zkrak.F
+++ /dev/null
@@ -1,240 +0,0 @@
-*
-* $Id: zkrak.F,v 1.3 1999/06/18 13:31:23 couet Exp $
-*
-* $Log: zkrak.F,v $
-* Revision 1.3 1999/06/18 13:31:23 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.2 1996/04/18 16:13:42 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:15 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE ZKRAK (MFLAGP,JLP,JRP,VALP)
-
-#include "zebra/zbcd.inc"
-#include "zebra/zmach.inc"
-#include "zebra/zkrakc.inc"
-#include "zebra/zkrakqu.inc"
-*
-
- COMMON /SLATE/ NDIG, JNEXT, DUMMY(2), NUMOCT(36)
-
- DIMENSION MFLAGP(9), JLP(9), JRP(9), VALP(9)
- INTEGER IVAL
- EQUIVALENCE (VAL,IVAL)
-
-
-#include "zebra/q_jbit.inc"
-#include "zebra/q_jbyt.inc"
-#include "zebra/q_sbyt.inc"
-
-
- CALL ZKRAKN (MFLAGP,JLP,JRP,VALP)
- IF (MFMT+1) 21, 40, 99
-
-
-C- MODE = 3 BCD
-C- 2 NUMERIC
-C- 1 EMPTY FIELD
-C- 0 FAULT
-C- -1 SEPARATOR IS FIRST CHAR. IN FIELD
-C- -2 $A, $Q CONTROL ITEM
-C- -3 $. COMMENT $
-
-C- MFMT= 3 HEX
-C- 2 OCTAL
-C- 1 INTEGER
-C- 0 FLOATING
-C- -1 BCD IN A-FORMAT
-C- -2 BCD IN Q-FORMAT
-
-C--- SIGNIFICANCE OF BITS IN MFLAG
-
-C- BIT 1 - 9 LEGAL SEPARATORS
-C- 10 MULTIPLIER LEGAL
-C- 11 NON-DELIMITED BCD STRING LEGAL
-C- 12 $A, $Q CONTROL ITEMS LEGAL
-C- 15 Q-FORMAT (ELSE A-FORMAT)
-C- 16-20 'N' FOR AN/QN
-
-
-C---- NON-DELIMITED BCD STRING
-
- 21 IF (JBIT(MFLAG,11).EQ.0) GO TO 94
- JR = JDO
- 22 JR = JR + 1
- IF (JR.GT.JRRAN) GO TO 23
- NSEP = IQCETK(JR)
- IF (NSEP.LT.40) GO TO 22
- 23 NCH = JR - JDO
- JGOTO = 1
- GO TO 41
-
-C---- $H'----', DELIMITED BCD STRING
-
- 25 IT = IQCETK(JDO)
- JR = JDO
- 26 JR = JR + 1
- IF (JR.GT.JRRAN) GO TO 94
- IF (IQCETK(JR).NE.IT) GO TO 26
-
- JDO = JDO + 1
- NCH = JR - JDO
- IF (NCH.EQ.0) GO TO 94
- JGOTO = 1
- GO TO 69
-
- 28 MODE = 3
- MFMT = -1 - JBIT(MFLAG,15)
- J = JBYT (MFLAG,16,5)
- IF (J.EQ.0) J=31
- IF (MFMT.EQ.-2) J=MIN (J,4)
- CALL UTRANS (IQHOLK(JDO),VALP(1),NCH, 1,J)
- NWORDS = JNEXT
- IF (MFMT.NE.-2) RETURN
- CALL ZHTOI (VALP(1),VALP(1),NWORDS)
- 99 RETURN
-
-C---- SEPARATOR IS THE FIRST CHARACTER
-
- 40 IF (NSEP.EQ.43) GO TO 51
- MODE = -1
- JR = JDO
- JGOTO = 2
-
-C---- LOCALISE + VALIDATE TERMINATOR NSEP IN IQHOLK(JR)
-
- 41 IF (JR.GT.JRRAN) GO TO 48
- IF (NSEP.NE.45) GO TO 44
- IF (IFLBLT.NE.0) GO TO 45
-
-C-- IF NSEP IS NON-TERMINATING BLANK, STEP TO TERMINATOR
-
- 43 NSEP = IQCETK(JR)
- IF (NSEP.NE.45) GO TO 44
- JR = JR + 1
- IF (JR.GT.JRRAN) GO TO 48
- GO TO 43
-
-C-- CHECK VALID NSEP
-
- 44 NSEP = MIN (NSEP,47)
- IF (NSEP.LT.40) GO TO 94
- IF (JBIT(MFLAG,NSEP-39).EQ.0) GO TO 94
- IF (NSEP.EQ.43) JR=JR-1
-
- 45 JNXGO = JR
- 46 JNXGO = JNXGO + 1
- IF (JNXGO.GT.JRRAN) GO TO 49
- IF (IQCETK(JNXGO).EQ.45) GO TO 46
- GO TO 49
-
- 48 NSEP = 0
- 49 GO TO (28,99,58,89), JGOTO
-
-C---- SEPARATOR 'DOLLAR', SPECIAL ITEMS
-
- 51 IF (JDO+1.GE.JRRAN) GO TO 94
- JDO = JDO + 2
- J = IQCETK(JDO-1)
- IF (J.EQ.8) GO TO 25
- IF (J.EQ.47) GO TO 66
- IF (J.EQ.15) GO TO 71
- IF (J.EQ.27) GO TO 71
-
- IF (IFLBLT.EQ.0) GO TO 54
- JTERM = JDO - 1
- 53 JTERM = JTERM + 1
- IF (JTERM.GT.JRRAN) GO TO 54
- IF (IQCETK(JTERM).EQ.45) GO TO 53
-
- 54 JR = JTERM - 1
- NCH = 2*IUFORW (IQHOLK,JDO,JR)
- JR = JNEXT
-
-C-- HANDLE $A, $A7, $Q, $Q2
-
- IF (J.EQ.1) GO TO 57
- IF (J.NE.17) GO TO 94
- NCH = NCH + 1
- 57 IF (JBIT(MFLAG,12).EQ.0) GO TO 94
- JGOTO = 3
- NSEP = IQCETK(JR)
- GO TO 41
-
- 58 MFLAGP(1) = MSBYT (NCH,MFLAGP(1),15,6)
- MODE = -2
- RETURN
-
-C-- $. COMMENT $
-
- 66 JR = JDO - 1
- 67 JR = JR + 1
- IF (JR.GT.JRRAN) GO TO 68
- IF (IQCETK(JR).NE.43) GO TO 67
-
- 68 MODE = -3
- JGOTO = 2
- 69 NSEP = 0
- IF (JR.GT.JRRAN) RETURN
- GO TO 45
-
-C---- $O OCTAL
-
- 71 JDO = JDO - 1
- 72 JDO = JDO + 1
- IF (JDO.GT.JRRAN) GO TO 94
- IF (IQCETK(JDO).EQ.45) GO TO 72
-
- IF (IFLBLT.EQ.0) GO TO 76
- JTERM = JDO
- 74 JTERM = JTERM + 1
- IF (JTERM.GT.JRRAN) GO TO 76
- IF (IQCETK(JTERM).NE.45) GO TO 74
-
- 76 NOCT = 0
- JR = JDO - 1
- 77 JR = JR + 1
- NSEP = IQCETK(JR)
- IF (JR.EQ.JTERM) GO TO 81
- IF (NSEP.EQ.45) GO TO 77
- J = NSEP - 27
- IF (J+NOCT.EQ.0) GO TO 77
- IF (J.LT.0) GO TO 94
- IF (J.GE.8) GO TO 81
- IF (NOCT.EQ.36) GO TO 94
- NOCT = NOCT + 1
- NUMOCT(NOCT) = J
- GO TO 77
-
- 81 JGOTO = 4
- IVAL = 0
- IF (NOCT.EQ.0) GO TO 41
- NDOK = (IQBITW-1) / 3
- N = MIN (NDOK,NOCT)
- JDF = 1 + NOCT - N
-
- DO 86 J=JDF,NOCT
- 86 IVAL = 8*IVAL + NUMOCT(J)
- IF (N.EQ.NOCT) GO TO 41
- J = 3*NDOK
- N = IQBITW - J
- IVAL = MSBYT (NUMOCT(JDF-1),IVAL,J+1,N)
- GO TO 41
-
- 89 VALP(1) = VAL
- MODE = 2
- NWORDS = 1
- MFMT = 2
- RETURN
-
-C---- EXITS
-
- 94 MODE = 0
- RETURN
- END
diff --git a/src/packlib/zebra/qutil/zkrakn.F b/src/packlib/zebra/qutil/zkrakn.F
deleted file mode 100644
index 4ae319c..0000000
--- a/src/packlib/zebra/qutil/zkrakn.F
+++ /dev/null
@@ -1,220 +0,0 @@
-*
-* $Id: zkrakn.F,v 1.2 1999/06/18 13:31:23 couet Exp $
-*
-* $Log: zkrakn.F,v $
-* Revision 1.2 1999/06/18 13:31:23 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:15 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE ZKRAKN (MFLAGP,JLP,JRP,VALP)
-
-#include "zebra/zbcd.inc"
-#include "zebra/zkrakc.inc"
-#include "zebra/zkrakqu.inc"
-*
-
- COMMON /SLATE/ NDIG, JNEXT, DUMMY(38)
-
- DIMENSION MFLAGP(9), JLP(9), JRP(9), VALP(9)
- INTEGER IVAL
- EQUIVALENCE (VAL,IVAL)
-
-
-#include "zebra/q_jbit.inc"
-
-
- MFLAG = MFLAGP(1)
- JLRAN = JLP(1)
- JRRAN = JRP(1)
- MODE = 0
- NWORDS = 0
- MFMT = 0
- MULT = JBIT(MFLAG,10) - 1
- IFLBLT = JBIT(MFLAG,6)
- 12 NSEP = 0
- JR = JRRAN
- JTERM = JRRAN + 1
- JNXGO = JTERM
-
-C- IZBCD VAL. 1 27 36 37 38 39 40 41 42 43 44 45 46 47
-C- CHARACTER A 0 9 + - * / ( ) $ = BL , .
-C- BIT J IN MFLAG IF SEPARATOR LEGAL, J= 1 2 3 4 5 6 7
-C- J=10 MULTIPLIER LEGAL
-
-C-- IGNORE LEADING BLANKS
-
- JDO = JLRAN - 1
- 13 JDO = JDO + 1
- IF (JDO.GT.JRRAN) GO TO 93
- IFIRST = IQCETK(JDO)
- IF (IFIRST.EQ.45) GO TO 13
-
- IF (IFIRST.LT.27) GO TO 91
- IF (IFIRST.LT.39) GO TO 14
- IF (IFIRST.NE.47) GO TO 92
-
-C-- FIND BLANK TERMINATOR, IF SELECTED
-
- 14 IF (IFLBLT.EQ.0) GO TO 17
- JTERM = JDO
- 15 JTERM = JTERM + 1
- IF (JTERM.GT.JRRAN) GO TO 16
- IF (IQCETK(JTERM).NE.45) GO TO 15
- 16 JR = JTERM - 1
-
-C-- STEP OVER SIGN-BIT
-
- 17 IF (IFIRST.EQ.37) GO TO 18
- IF (IFIRST.NE.38) GO TO 21
- 18 JDO = JDO +1
- IF (JDO.EQ.JTERM) GO TO 94
-
-C-- READ INITIAL INTEGER
-
- 21 NDALL = 0
- IVAL = 0
- JDO = JDO - 1
- 22 JDO = JDO + 1
- IF (JDO.EQ.JTERM) GO TO 28
- J = IQCETK(JDO) - 27
- IF (J.LT.0) GO TO 24
- IF (J.EQ.18) GO TO 22
- IF (J.GE.10) GO TO 24
- IVAL = IVAL*10 + J
- NDALL = NDALL + 1
- GO TO 22
-
- 24 JEXP = 0
- JEXF = 0
- FRAC = 0.
- NSEP = IQCETK(JDO)
- IF (NSEP-39) 41, 81, 26
- 26 IF (NSEP.EQ.47) GO TO 31
-
- 28 IF (IFIRST.EQ.38) IVAL=-IVAL
- MFMT = 1
- GO TO 71
-
-C-- READ FRACTION
-
- 31 JEXW = 0
- 32 JDO = JDO + 1
- IF (JDO.EQ.JTERM) GO TO 50
-
- NSEP = IQCETK(JDO)
- IF (NSEP-27) 41, 33, 34
- 33 NDALL = NDALL + 1
- JEXW = JEXW + 1
- GO TO 32
-
- 34 IF (NSEP.GE.37) GO TO 38
- 35 IF (JEXW.EQ.0) GO TO 36
- JEXW = JEXW - 1
- JEXF = JEXF - 1
- FRAC = FRAC * 10.
- GO TO 35
-
- 36 NDALL = NDALL + 1
- JEXF = JEXF - 1
- FRAC = FRAC*10. + REAL(NSEP-27)
- GO TO 32
-
- 38 IF (NSEP.EQ.45) GO TO 32
- IF (NSEP-39) 44, 94, 51
-
-C-- READ EXPONENT
-
- 41 IF (NSEP.NE.5) GO TO 44
- 42 JDO = JDO + 1
- IF (JDO.EQ.JTERM) GO TO 50
- NSEP = IQCETK(JDO)
- IF (NSEP.EQ.45) GO TO 42
- IF (NSEP-39) 44, 94, 51
-
- 44 IF (NSEP.LT.27) GO TO 94
- IF (NSEP.LT.37) GO TO 46
- JDO = JDO + 1
- IF (JDO.EQ.JTERM) GO TO 94
-
- 46 JEXP = IUFORW (IQHOLK,JDO,JR)
- IF (JEXP.EQ.0) GO TO 47
- IF (NSEP.EQ.38) JEXP=-JEXP
- JEXF = JEXF + JEXP
- 47 JDO = JNEXT
- IF (JDO.EQ.JTERM) GO TO 50
- NSEP = IQCETK(JDO)
- IF (NSEP.GE.40) GO TO 51
- GO TO 94
-
-C-- SET FLOATING RESULT
-
- 50 NSEP = 0
- 51 VAL = REAL (IVAL)
- IF (VAL.EQ.0.) GO TO 61
- IF (JEXP) 58, 61, 52
- 52 IF (JEXP.GE.9) GO TO 58
- DO 54 J=1,JEXP
- 54 VAL = VAL * 10.
- GO TO 61
-
- 58 VAL = VAL * 10.**JEXP
-
-C-- SET FLOATING RESULT, FRACTIONAL PART
-
- 61 IF (FRAC.EQ.0.) GO TO 66
- IF (JEXF) 64, 65, 62
- 62 IF (JEXF.GE.9) GO TO 64
- DO 63 J=1,JEXF
- 63 FRAC = FRAC * 10.
- GO TO 65
-
- 64 FRAC = FRAC * 10.**JEXF
-
- 65 VAL = VAL + FRAC
- 66 IF (IFIRST.NE.38) GO TO 71
- VAL = -VAL
-
-C-- STORE RESULT
-
- 71 IF (NDALL.EQ.0) GO TO 94
- IF (NSEP.EQ.0) GO TO 72
- NSEP = MIN (NSEP,47)
- IF (JBIT(MFLAG,NSEP-39).EQ.0) GO TO 94
- IF (NSEP.EQ.43) GO TO 72
- JDO = JDO + 1
-
- 72 JNXGO = JDO
- 73 IF (JNXGO.GT.JRRAN) GO TO 75
- IF (IQCETK(JNXGO).NE.45) GO TO 75
- JNXGO = JNXGO + 1
- GO TO 73
-
- 75 MODE = 2
- NWORDS = 1
- VALP(1) = VAL
- GO TO 94
-
-C---- MULTIPLIER
-
- 81 IF (IVAL.LE.0) GO TO 94
- IF (MULT.NE.0) GO TO 94
- MULT = IVAL
- JLRAN = JDO + 1
- GO TO 12
-
-C---- NON-NUMERIC
-
- 91 MFMT = -1
- 92 MFMT = MFMT - 1
- NSEP = IFIRST
- GO TO 94
-
- 93 MODE = 1
- 94 MULT = MAX (0,MULT-1)
- RETURN
- END
diff --git a/src/packlib/zebra/qutil/znumid.F b/src/packlib/zebra/qutil/znumid.F
deleted file mode 100644
index 916d87c..0000000
--- a/src/packlib/zebra/qutil/znumid.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: znumid.F,v 1.2 1999/06/18 13:31:24 couet Exp $
-*
-* $Log: znumid.F,v $
-* Revision 1.2 1999/06/18 13:31:24 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:15 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE ZNUMID (ID,NID)
-
-#include "zebra/quest.inc"
-*
- DIMENSION ID(9), NID(9)
-
-
- NAME = ID(1)
- IF (IABS(NAME).GE.10000) GO TO 22
- CALL VBLANK (IQUEST(26),4)
- CALL USET (NAME,IQUEST(26),1,4)
- CALL UBUNCH (IQUEST(26),NAME,4)
- 22 NID(1) = NAME
- RETURN
- END
diff --git a/src/packlib/zebra/qutil/zpress.F b/src/packlib/zebra/qutil/zpress.F
deleted file mode 100644
index 3cba55d..0000000
--- a/src/packlib/zebra/qutil/zpress.F
+++ /dev/null
@@ -1,75 +0,0 @@
-*
-* $Id: zpress.F,v 1.3 1999/06/18 13:31:24 couet Exp $
-*
-* $Log: zpress.F,v $
-* Revision 1.3 1999/06/18 13:31:24 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.2 1996/04/18 16:13:43 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:15 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE ZPRESS (IXSTOR,LGOP)
-
-C- REMOVE DEAD BANKS FROM (CIRCULAR) LINEAR STRUCTURE
-
-#include "zebra/mqsysh.inc"
-*
- DIMENSION LGOP(9)
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HZPRE, 4HSS /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HZPRESS /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'ZPRESS ')
-#endif
-
-#include "zebra/q_jbit.inc"
-#include "zebra/q_jbyt.inc"
-
- LGO = LGOP(1)
- IF (LGO.EQ.0) RETURN
-
-#include "zebra/qtraceq.inc"
-#include "zebra/qstore.inc"
-
- L = LGO
- KGO = LQ(KQS+L+2)
- K = KGO
-
- 11 IF (JBIT(IQ(KQS+L),IQDROP).NE.0) GO TO 21
- 12 K = L
- L = LQ(KQS+K)
- IF (L.EQ.0) GO TO 999
- IF (L.NE.LGO) GO TO 11
- LQ(KQS+K) = LQ(KQS+KGO)
-#include "zebra/qtrace99.inc"
- RETURN
-
-C-- SERIES OF DEAD BANKS
-
- 21 L = LQ(KQS+L)
- IF (L.EQ.0) GO TO 24
- IF (L.EQ.LGO) GO TO 25
- IF (JBIT(IQ(KQS+L),IQDROP).NE.0) GO TO 21
- LQ(KQS+K) = L
- LQ(KQS+L+2) = K
- GO TO 12
-
- 24 LQ(KQS+K) = 0
- GO TO 999
-
- 25 LQ(KQS+K) = LQ(KQS+KGO)
- IF (K.NE.KGO) GO TO 999
- LQ(KQS+KGO) = 0
- GO TO 999
- END
diff --git a/src/packlib/zebra/qutil/zshunt.F b/src/packlib/zebra/qutil/zshunt.F
deleted file mode 100644
index 6b80aae..0000000
--- a/src/packlib/zebra/qutil/zshunt.F
+++ /dev/null
@@ -1,205 +0,0 @@
-*
-* $Id: zshunt.F,v 1.3 1999/06/18 13:31:24 couet Exp $
-*
-* $Log: zshunt.F,v $
-* Revision 1.3 1999/06/18 13:31:24 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.2 1996/04/18 16:13:43 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:15 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE ZSHUNT (IXSTOR,LSHP,LSUPP,JBIASP,IFLAGP)
-
-C- RE-CONNECT BANK OR LINEAR D/S, USER CALLED
-
-#include "zebra/zunit.inc"
-#include "zebra/mqsys.inc"
-#include "zebra/mzcn.inc"
-*
- DIMENSION LSHP(9),LSUPP(9),JBIASP(9),IFLAGP(9)
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HZSHU, 4HNT /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HZSHUNT /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'ZSHUNT ')
-#endif
-
-#include "zebra/q_jbyt.inc"
-#include "zebra/q_locf.inc"
-
-#include "zebra/qtraceq.inc"
-
- LSH = LSHP(1)
- IF (LSH.EQ.0) GO TO 999
- LSUP = LSUPP(1)
- JBIAS = JBIASP(1)
- IFLAG = IFLAGP(1)
-
-#include "zebra/qstore.inc"
-
-#if defined(CERNLIB_QDEBUG)
- CALL MZCHLS (-7,LSH)
- IF (IQFOUL.NE.0) GO TO 91
-#endif
-#if defined(CERNLIB_QDEBPRI)
- IF (NQLOGL.GE.2) THEN
- IF (JBIAS.GE.2) LSUP=0
- WRITE (IQLOG,9011) JQSTOR,LSH,LSUP,JBIAS,IFLAG,IQID
- ENDIF
- 9011 FORMAT (' ZSHUNT- Store',I3,' LSH/LSUP/JBIAS/IFLAG='
- F,2I9,1X,I6,1X,I3,' IDH= ',A4)
-#endif
-
-C---- LINKS AT EXIT POINT
-
- KEX = LQ(KQS+LSH+2)
- LNEX = LQ(KQS+LSH)
-
-C---- LINKS AT INSERTION POINT
-
- LPRE = 0
- IF (JBIAS-1) 21, 25, 28
- 21 CONTINUE
-#if defined(CERNLIB_QDEBUG)
- CALL MZCHLS (-7,LSUP)
- IF (IQFOUL.NE.0) GO TO 92
- IF (IQNS+JBIAS.LT.0) GO TO 93
-#endif
- KIN = LSUP + JBIAS
- LNIN = LQ(KQS+KIN)
- LUP = LSUP
- IF (JBIAS.NE.0) GO TO 29
- LPRE = LUP
- LUP = LQ(KQS+LUP+1)
- GO TO 29
-
- 25 LNIN = LSUP
- IF (LNIN.EQ.0) GO TO 26
-#if defined(CERNLIB_QDEBUG)
- CALL MZCHLS (-7,LSUP)
- IF (IQFOUL.NE.0) GO TO 92
-#endif
- KIN = LQ(KQS+LNIN+2)
- LUP = LQ(KQS+LNIN+1)
- GO TO 29
-
- 26 KIN = LOCF(LSUPP(1)) - LQSTOR
- LUP = 0
- GO TO 29
-
- 28 KIN = 0
- LNIN = 0
- LUP = 0
- IF (KEX.EQ.0) GO TO 51
-
-C-- CHECK INSERT POINT = EXIT POINT
-
- 29 IF (KIN.EQ.KEX) GO TO 999
-
-C-- CHECK LINEAR STRUCTURE CONTAINED
-
-#if defined(CERNLIB_QDEBUG)
- L = MAX (LNIN,LPRE)
- IF (L.EQ.0) GO TO 51
-
- IF (L.GE.LQEND(KQT+20)) GO TO 94
- IF (L.GE.LQEND(KQT+JQDVLL)) GO TO 43
- JQDIVI = 2
- IF (L.GE.LQEND(KQT+2)) GO TO 44
- IF (L.GE.LQSTA(KQT+2)) GO TO 45
- JQDIVI = 1
- GO TO 45
-
- 43 JQDIVI = JQDVSY - 1
- 44 JQDIVI = JQDIVI + 1
- IF (L.GE.LQEND(KQT+JQDIVI)) GO TO 44
-
- 45 IF (LSH.LT.LQSTA(KQT+JQDIVI)) GO TO 94
- IF (LSH.GE.LQEND(KQT+JQDIVI)) GO TO 94
-#endif
-
-C---- SHUNT LINEAR STRUCTURE
-
- 51 IF (LNEX.EQ.0) GO TO 58
- IF (IFLAG.EQ.0) GO TO 57
-#if defined(CERNLIB_QDEBUG)
- L = LSH
- 53 CALL MZCHLS (-7,LNEX)
- IF (IQFOUL.NE.0) GO TO 95
- L = LNEX
- LNEX = LQ(KQS+LNEX)
- IF (LNEX.NE.0) GO TO 53
-#endif
- LNEX = LSH
- 55 LEND = LNEX
- LQ(KQS+LEND+1) = LUP
- LNEX = LQ(KQS+LEND)
- IF (LNEX.NE.0) GO TO 55
- GO TO 71
-
-C---- SHUNT SINGLE BANK
-
- 57 CONTINUE
-#if defined(CERNLIB_QDEBUG)
- L = LSH
- CALL MZCHLS (-7,LNEX)
- IF (IQFOUL.NE.0) GO TO 95
-#endif
- 58 LEND = LSH
- LQ(KQS+LSH+1) = LUP
-
-C---- CONNECTIONS
-
-C-- BRIDGE OLD POSITION
-
- 71 IF (KEX .NE.0) LQ(KQS+KEX) = LNEX
- IF (LNEX.NE.0) LQ(KQS+LNEX+2) = KEX
-
-C-- CONNECT START
-
- IF (KIN.NE.0) THEN
- LQ(KQS+KIN) = LSH
- ELSE
- LSUPP(1) = LSH
- ENDIF
- LQ(KQS+LSH+2) = KIN
-
-C-- CONNECT END
-
- LQ(KQS+LEND) = LNIN
- IF (LNIN.NE.0) LQ(KQS+LNIN+2) = LEND
-
-#include "zebra/qtrace99.inc"
- RETURN
-
-C------ ERROR CONDITIONS
-
-#if defined(CERNLIB_QDEBUG)
- 95 NQCASE = 1
- NQFATA = 1
- IQUEST(16) = LNEX
- 94 NQCASE = NQCASE + 1
- NQFATA = NQFATA + 1
- IQUEST(15) = L
- 93 NQCASE = NQCASE + 1
- 92 NQCASE = NQCASE + 1
-#endif
- 91 NQCASE = NQCASE + 1
- NQFATA = NQFATA + 4
- IQUEST(11) = LSH
- IQUEST(12) = LSUP
- IQUEST(13) = JBIAS
- IQUEST(14) = IFLAG
-#include "zebra/qtofatal.inc"
- END
diff --git a/src/packlib/zebra/qutil/zsort.F b/src/packlib/zebra/qutil/zsort.F
deleted file mode 100644
index b75dffa..0000000
--- a/src/packlib/zebra/qutil/zsort.F
+++ /dev/null
@@ -1,126 +0,0 @@
-*
-* $Id: zsort.F,v 1.3 1999/06/18 13:31:24 couet Exp $
-*
-* $Log: zsort.F,v $
-* Revision 1.3 1999/06/18 13:31:24 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.2 1996/04/18 16:13:44 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:15 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE ZSORT (IXSTOR,LGOP,JWORD)
-
-C- SORT BANKS AT LGO FOR WORDS Q(L+JWORD) TO BE IN INCREASING ORDER
-
-#include "zebra/mqsys.inc"
-*
- DIMENSION JWORD(9), LGOP(9)
- REAL KEYN, KEYPL, KEYNG
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HZSOR, 4HT /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HZSORT /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'ZSORT ')
-#endif
-
-#include "zebra/q_jbyt.inc"
-
- LGO = LGOP(1)
- IF (LGO.EQ.0) RETURN
-
-#include "zebra/qtraceq.inc"
-#include "zebra/qstore.inc"
-
- JW = JWORD(1)
- KGONG = LQSTA(KQT+2) - 1
- LLNG = KGONG
- KGOPL = KGONG - 1
- LLPL = KGOPL
- KEYPL = -1.
- KEYNG = 0.
- IFL = 0
-
- LN = LGO
- KEYN = Q(KQS+LN+JW)
- IF (KEYN.LT.0.) GO TO 62
-
-C-------- +VE IN-SEQUENCE LOOP FOR BANKS WITH +VE KEY
-C-- KEEP GOING FOR INCREASING KEYS
-
- 21 LQ(KQS+LLPL) = LN
- GO TO 24
-
- 23 KEYPL = KEYN
- LLPL = LN
- LN = LQ(KQS+LN)
- IF (LN.EQ.0) GO TO 81
- KEYN = Q(KQS+LN+JW)
- IF (KEYN.LT.0.) GO TO 61
- 24 IF (KEYN-KEYPL) 28, 23, 23
-
- 28 LS = KGOPL
-
-C-------- OUT-SEQUENCE LOOP, FIND PLACE FOR BANK IN THE CHAIN
-C-- OF BANKS ALREADY SORTED, +VE OR -VE CHAIN
-
- 41 LNX = LQ(KQS+LN)
- IFL = 7
- 43 KS = LS
- LS = LQ(KQS+LS)
- IF (KEYN- Q(KQS+LS+JW)) 48, 43, 43
-
- 48 LQ(KQS+LN) = LS
- LQ(KQS+KS) = LN
- IF (LNX.EQ.0) GO TO 81
- LN = LNX
- KEYN = Q(KQS+LN+JW)
- IF (KEYN.GE.0.) GO TO 21
-
-C-------- -VE IN-SEQUENCE LOOP FOR BANKS WITH -VE KEY
-C-- KEEP GOING FOR INCREASING KEYS
-
- 61 IFL = 7
- 62 LS = KGONG
- LQ(KQS+LLNG) = LN
- IF (KEYNG.NE.0.) GO TO 64
-
- 63 KEYNG = KEYN
- LLNG = LN
- LN = LQ(KQS+LN)
- IF (LN.EQ.0) GO TO 81
- KEYN = Q(KQS+LN+JW)
- IF (KEYN.GE.0.) GO TO 21
- 64 IF (KEYN-KEYNG) 41, 63, 63
-
-C---- FINISHED, LINK +VE AND -VE STREAMS, CHAIN K-LINKS
-
- 81 IF (IFL.EQ.0) GO TO 999
- LQ(KQS+LLPL) = 0
- LQ(KQS+LLNG) = LQ(KQS+KGOPL)
-
- K = LQ(KQS+LGO+2)
- L = LQ(KQS+KGONG)
- LQ(KQS+L+2) = K
- IF (K.NE.0) LQ(KQS+K)=L
- LGOP(1) = L
-
- 84 K = L
- L = LQ(KQS+K)
- IF (L.EQ.0) GO TO 999
- LQ(KQS+L+2) = K
- GO TO 84
-
-#include "zebra/qtrace99.inc"
- RETURN
- END
diff --git a/src/packlib/zebra/qutil/zsorth.F b/src/packlib/zebra/qutil/zsorth.F
deleted file mode 100644
index 72e7c8d..0000000
--- a/src/packlib/zebra/qutil/zsorth.F
+++ /dev/null
@@ -1,137 +0,0 @@
-*
-* $Id: zsorth.F,v 1.4 1999/06/18 13:31:25 couet Exp $
-*
-* $Log: zsorth.F,v $
-* Revision 1.4 1999/06/18 13:31:25 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.3 1998/09/25 09:33:27 mclareni
-* Modifications for the Mklinux port flagged by CERNLIB_PPC
-*
-* Revision 1.2 1996/04/18 16:13:45 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:15 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
-#if (defined(CERNLIB_VAX))||((defined(CERNLIB_LINUX) && !defined(CERNLIB_PPC)))||(defined(CERNLIB_QMVMI))||(defined(CERNLIB_QMDOS))
-#include "qutyvax/zsorth.F"
-#else
- SUBROUTINE ZSORTH (IXSTOR,LGOP,JWORD)
-
-C- SORT BANKS AT LGO FOR WORDS Q(L+JWORD) TO BE IN INCREASING ORDER
-
-C- ALPHABETIC SORT DONE WITH INTEGER COMPARISON
-C- THE SIGN-BIT IS CONSIDERED AS AN ORDINARY BIT, FOR CONSISTENCY
-C- ON ANY GIVEN MACHINE THIS MAY NOT BE VERY SATISFACTORY
-
-#include "zebra/mqsys.inc"
-*
- DIMENSION JWORD(9), LGOP(9)
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HZSOR, 4HTH /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HZSORTH /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'ZSORTH ')
-#endif
-
-#include "zebra/q_jbyt.inc"
-
- LGO = LGOP(1)
- IF (LGO.EQ.0) RETURN
-
-#include "zebra/qtraceq.inc"
-#include "zebra/qstore.inc"
-
- JW = JWORD(1)
- KGONG = LQSTA(KQT+2) - 1
- LLNG = KGONG
- KGOPL = KGONG - 1
- LLPL = KGOPL
- KEYPL = -1
- KEYNG = 0
- IFL = 0
-
- LN = LGO
- KEYN = IQ(KQS+LN+JW)
- IF (KEYN.GE.0 ) GO TO 22
- GO TO 62
-
-C-------- +VE IN-SEQUENCE LOOP FOR BANKS WITH +VE KEY
-C-- KEEP GOING FOR INCREASING KEYS
-
- 21 IFL = 7
- 22 LQ(KQS+LLPL) = LN
- GO TO 24
-
- 23 KEYPL = KEYN
- LLPL = LN
- LN = LQ(KQS+LN)
- IF (LN.EQ.0) GO TO 81
- KEYN = IQ(KQS+LN+JW)
- IF (KEYN.LT.0 ) GO TO 62
- 24 IF (KEYN-KEYPL) 28, 23, 23
-
- 28 LS = KGOPL
-
-C-------- OUT-SEQUENCE LOOP, FIND PLACE FOR BANK IN THE CHAIN
-C-- OF BANKS ALREADY SORTED, +VE OR -VE CHAIN
-
- 41 LNX = LQ(KQS+LN)
- IFL = 7
- 43 KS = LS
- LS = LQ(KQS+LS)
- IF (KEYN-IQ(KQS+LS+JW)) 48, 43, 43
-
- 48 LQ(KQS+LN) = LS
- LQ(KQS+KS) = LN
- IF (LNX.EQ.0) GO TO 81
- LN = LNX
- KEYN = IQ(KQS+LN+JW)
- IF (KEYN.GE.0 ) GO TO 22
-
-C-------- -VE IN-SEQUENCE LOOP FOR BANKS WITH -VE KEY
-C-- KEEP GOING FOR INCREASING KEYS
-
- 62 LS = KGONG
- LQ(KQS+LLNG) = LN
- IF (KEYNG.NE.0 ) GO TO 64
-
- 63 KEYNG = KEYN
- LLNG = LN
- LN = LQ(KQS+LN)
- IF (LN.EQ.0) GO TO 81
- KEYN = IQ(KQS+LN+JW)
- IF (KEYN.GE.0 ) GO TO 21
- 64 IF (KEYN-KEYNG) 41, 63, 63
-
-C---- FINISHED, LINK +VE AND -VE STREAMS, CHAIN K-LINKS
-
- 81 IF (IFL.EQ.0) GO TO 999
- LQ(KQS+LLNG) = 0
- LQ(KQS+LLPL) = LQ(KQS+KGONG)
-
- K = LQ(KQS+LGO+2)
- L = LQ(KQS+KGOPL)
- LQ(KQS+L+2) = K
- IF (K.NE.0) LQ(KQS+K)=L
- LGOP(1) = L
-
- 84 K = L
- L = LQ(KQS+K)
- IF (L.EQ.0) GO TO 999
- LQ(KQS+L+2) = K
- GO TO 84
-
-#include "zebra/qtrace99.inc"
- RETURN
- END
-#endif
diff --git a/src/packlib/zebra/qutil/zsorti.F b/src/packlib/zebra/qutil/zsorti.F
deleted file mode 100644
index 83c8fed..0000000
--- a/src/packlib/zebra/qutil/zsorti.F
+++ /dev/null
@@ -1,126 +0,0 @@
-*
-* $Id: zsorti.F,v 1.3 1999/06/18 13:31:25 couet Exp $
-*
-* $Log: zsorti.F,v $
-* Revision 1.3 1999/06/18 13:31:25 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.2 1996/04/18 16:13:46 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:15 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE ZSORTI (IXSTOR,LGOP,JWORD)
-
-C- SORT BANKS AT LGO FOR WORDS IQ(L+JWORD) TO BE IN INCREASING ORDER
-
-#include "zebra/mqsys.inc"
-*
- DIMENSION JWORD(9), LGOP(9)
-
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HZSOR, 4HTI /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HZSORTI /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'ZSORTI ')
-#endif
-
-#include "zebra/q_jbyt.inc"
-
- LGO = LGOP(1)
- IF (LGO.EQ.0) RETURN
-
-#include "zebra/qtraceq.inc"
-#include "zebra/qstore.inc"
-
- JW = JWORD(1)
- KGONG = LQSTA(KQT+2) - 1
- LLNG = KGONG
- KGOPL = KGONG - 1
- LLPL = KGOPL
- KEYPL = -1
- KEYNG = 0
- IFL = 0
-
- LN = LGO
- KEYN = IQ(KQS+LN+JW)
- IF (KEYN.LT.0 ) GO TO 62
-
-C-------- +VE IN-SEQUENCE LOOP FOR BANKS WITH +VE KEY
-C-- KEEP GOING FOR INCREASING KEYS
-
- 21 LQ(KQS+LLPL) = LN
- GO TO 24
-
- 23 KEYPL = KEYN
- LLPL = LN
- LN = LQ(KQS+LN)
- IF (LN.EQ.0) GO TO 81
- KEYN = IQ(KQS+LN+JW)
- IF (KEYN.LT.0 ) GO TO 61
- 24 IF (KEYN-KEYPL) 28, 23, 23
-
- 28 LS = KGOPL
-
-C-------- OUT-SEQUENCE LOOP, FIND PLACE FOR BANK IN THE CHAIN
-C-- OF BANKS ALREADY SORTED, +VE OR -VE CHAIN
-
- 41 LNX = LQ(KQS+LN)
- IFL = 7
- 43 KS = LS
- LS = LQ(KQS+LS)
- IF (KEYN-IQ(KQS+LS+JW)) 48, 43, 43
-
- 48 LQ(KQS+LN) = LS
- LQ(KQS+KS) = LN
- IF (LNX.EQ.0) GO TO 81
- LN = LNX
- KEYN = IQ(KQS+LN+JW)
- IF (KEYN.GE.0 ) GO TO 21
-
-C-------- -VE IN-SEQUENCE LOOP FOR BANKS WITH -VE KEY
-C-- KEEP GOING FOR INCREASING KEYS
-
- 61 IFL = 7
- 62 LS = KGONG
- LQ(KQS+LLNG) = LN
- IF (KEYNG.NE.0 ) GO TO 64
-
- 63 KEYNG = KEYN
- LLNG = LN
- LN = LQ(KQS+LN)
- IF (LN.EQ.0) GO TO 81
- KEYN = IQ(KQS+LN+JW)
- IF (KEYN.GE.0 ) GO TO 21
- 64 IF (KEYN-KEYNG) 41, 63, 63
-
-C---- FINISHED, LINK +VE AND -VE STREAMS, CHAIN K-LINKS
-
- 81 IF (IFL.EQ.0) GO TO 999
- LQ(KQS+LLPL) = 0
- LQ(KQS+LLNG) = LQ(KQS+KGOPL)
-
- K = LQ(KQS+LGO+2)
- L = LQ(KQS+KGONG)
- LQ(KQS+L+2) = K
- IF (K.NE.0) LQ(KQS+K)=L
- LGOP(1) = L
-
- 84 K = L
- L = LQ(KQS+K)
- IF (L.EQ.0) GO TO 999
- LQ(KQS+L+2) = K
- GO TO 84
-
-#include "zebra/qtrace99.inc"
- RETURN
- END
diff --git a/src/packlib/zebra/qutil/zsorv.F b/src/packlib/zebra/qutil/zsorv.F
deleted file mode 100644
index 6ac0a69..0000000
--- a/src/packlib/zebra/qutil/zsorv.F
+++ /dev/null
@@ -1,170 +0,0 @@
-*
-* $Id: zsorv.F,v 1.3 1999/06/18 13:31:25 couet Exp $
-*
-* $Log: zsorv.F,v $
-* Revision 1.3 1999/06/18 13:31:25 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.2 1996/04/18 16:13:46 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:15 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE ZSORV (IXSTOR,LGOP,JWORD,NWORDS)
-
-C- SORT BANKS AT LGO SUCH THAT THE 'NWORDS' LONG KEY STRINGS
-C- STARTING AT Q(L+JWORD) ARE IN INCREASING ORDER
-
-#include "zebra/mqsys.inc"
-*
- DIMENSION JWORD(9), NWORDS(9), LGOP(9)
- REAL KEYN, KEYPL, KEYNG, KYN, KYC
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HZSOR, 4HV /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HZSORV /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'ZSORV ')
-#endif
-
-#include "zebra/q_jbyt.inc"
-
- LGO = LGOP(1)
- IF (LGO.EQ.0) RETURN
-
-#include "zebra/qtraceq.inc"
-#include "zebra/qstore.inc"
-
- JW = JWORD(1)
- JWN = JW-1 + NWORDS(1)
- IF (JWN.LE.JW) GO TO 88
- KGONG = LQSTA(KQT+2) - 1
- LLNG = KGONG
- KGOPL = KGONG - 1
- LLPL = KGOPL
- KEYPL = -1.
- KEYNG = 0.
- IFL = 0
-
- LN = LGO
- KEYN = Q(KQS+LN+JW)
- IF (KEYN.LT.0.) GO TO 62
-
-C-------- +VE IN-SEQUENCE LOOP FOR BANKS WITH +VE KEY
-C-- KEEP GOING FOR INCREASING KEYS
-
- 21 LQ(KQS+LLPL) = LN
- GO TO 24
-
- 23 KEYPL = KEYN
- LLPL = LN
- LN = LQ(KQS+LN)
- IF (LN.EQ.0) GO TO 81
- KEYN = Q(KQS+LN+JW)
- IF (KEYN.LT.0.) GO TO 61
- 24 IF (KEYN-KEYPL) 28, 25, 23
-
- 25 JSW = 7
- LC = LLPL
- GO TO 71
-
- 28 LS = KGOPL
-
-C-------- OUT-SEQUENCE LOOP, FIND PLACE FOR BANK IN THE CHAIN
-C-- OF BANKS ALREADY SORTED, +VE OR -VE CHAIN
-
- 41 LNX = LQ(KQS+LN)
- IFL = 7
- 43 KS = LS
- LS = LQ(KQS+LS)
- IF (KEYN- Q(KQS+LS+JW)) 48, 45, 43
-
- 45 JSW = 0
- LC = LS
- GO TO 71
-
- 48 LQ(KQS+LN) = LS
- LQ(KQS+KS) = LN
- IF (LNX.EQ.0) GO TO 81
- LN = LNX
- KEYN = Q(KQS+LN+JW)
- IF (KEYN.GE.0.) GO TO 21
-
-C-------- -VE IN-SEQUENCE LOOP FOR BANKS WITH -VE KEY
-C-- KEEP GOING FOR INCREASING KEYS
-
- 61 IFL = 7
- 62 LS = KGONG
- LQ(KQS+LLNG) = LN
- IF (KEYNG.NE.0.) GO TO 64
-
- 63 KEYNG = KEYN
- LLNG = LN
- LN = LQ(KQS+LN)
- IF (LN.EQ.0) GO TO 81
- KEYN = Q(KQS+LN+JW)
- IF (KEYN.GE.0.) GO TO 21
- 64 IF (KEYN-KEYNG) 41, 65, 63
-
- 65 JSW = -7
- LC = LLNG
-
-C-------- COMPARE 2 STRINGS STARTING WITH THE SAME WORD
-
- 71 J = JW
- 72 J = J+1
- KYC = Q(KQS+LC+J)
- KYN = Q(KQS+LN+J)
-
-C-- KYN < KYC
- IF (KYN.GE.0.) GO TO 74
- IF (KYC.GE.0.) GO TO 79
- GO TO 75
-
-C-- KYN > KYC
- 74 IF (KYC.LT.0.) GO TO 78
-
- 75 IF (KYN-KYC) 79, 76, 78
- 76 IF (J.LT.JWN) GO TO 72
-
-C-- KEYS/N .GE. KEYS/C
-
- 78 IF (JSW) 63, 43, 23
-
-C-- KEYS/N .LT. KEYS/C
-
- 79 IF (JSW) 41, 48, 28
-
-C---- FINISHED, LINK +VE AND -VE STREAMS, CHAIN K-LINKS
-
- 81 IF (IFL.EQ.0) GO TO 999
- LQ(KQS+LLPL) = 0
- LQ(KQS+LLNG) = LQ(KQS+KGOPL)
-
- K = LQ(KQS+LGO+2)
- L = LQ(KQS+KGONG)
- LQ(KQS+L+2) = K
- IF (K.NE.0) LQ(KQS+K)=L
- LGOP(1) = L
-
- 84 K = L
- L = LQ(KQS+K)
- IF (L.EQ.0) GO TO 999
- LQ(KQS+L+2) = K
- GO TO 84
-
-C---- SPECIAL CASE NWORDS=1
-
- 88 CALL ZSORT (IXSTOR,LGOP,JW)
-
-#include "zebra/qtrace99.inc"
- RETURN
- END
diff --git a/src/packlib/zebra/qutil/zsorvh.F b/src/packlib/zebra/qutil/zsorvh.F
deleted file mode 100644
index 8f187e3..0000000
--- a/src/packlib/zebra/qutil/zsorvh.F
+++ /dev/null
@@ -1,181 +0,0 @@
-*
-* $Id: zsorvh.F,v 1.4 1999/06/18 13:31:25 couet Exp $
-*
-* $Log: zsorvh.F,v $
-* Revision 1.4 1999/06/18 13:31:25 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.3 1998/09/25 09:33:27 mclareni
-* Modifications for the Mklinux port flagged by CERNLIB_PPC
-*
-* Revision 1.2 1996/04/18 16:13:47 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:15 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
-#if (defined(CERNLIB_VAX))||((defined(CERNLIB_LINUX) && !defined(CERNLIB_PPC)))||(defined(CERNLIB_QMVMI))||(defined(CERNLIB_QMDOS))
-#include "qutyvax/zsorvh.F"
-#else
- SUBROUTINE ZSORVH (IXSTOR,LGOP,JWORD,NWORDS)
-
-C- SORT BANKS AT LGO SUCH THAT THE 'NWORDS' LONG HOLLERITH STRINGS
-C- STARTING AT Q(L+JWORD) ARE IN INCREASING ORDER
-
-C- ALPHABETIC SORT DONE WITH INTEGER COMPARISON
-C- THE SIGN-BIT IS CONSIDERED AS AN ORDINARY BIT, FOR CONSISTENCY
-C- ON ANY GIVEN MACHINE THIS MAY NOT BE VERY SATISFACTORY
-
-#include "zebra/mqsys.inc"
-*
- DIMENSION JWORD(9), NWORDS(9), LGOP(9)
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HZSOR, 4HVH /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HZSORVH /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'ZSORVH ')
-#endif
-
-#include "zebra/q_jbyt.inc"
-
- LGO = LGOP(1)
- IF (LGO.EQ.0) RETURN
-
-#include "zebra/qtraceq.inc"
-#include "zebra/qstore.inc"
-
- JW = JWORD(1)
- JWN = JW-1 + NWORDS(1)
- IF (JWN.LE.JW) GO TO 88
- KGONG = LQSTA(KQT+2) - 1
- LLNG = KGONG
- KGOPL = KGONG - 1
- LLPL = KGOPL
- KEYPL = -1
- KEYNG = 0
- IFL = 0
-
- LN = LGO
- KEYN = IQ(KQS+LN+JW)
- IF (KEYN.GE.0 ) GO TO 22
- GO TO 62
-
-C-------- +VE IN-SEQUENCE LOOP FOR BANKS WITH +VE KEY
-C-- KEEP GOING FOR INCREASING KEYS
-
- 21 IFL = 7
- 22 LQ(KQS+LLPL) = LN
- GO TO 24
-
- 23 KEYPL = KEYN
- LLPL = LN
- LN = LQ(KQS+LN)
- IF (LN.EQ.0) GO TO 81
- KEYN = IQ(KQS+LN+JW)
- IF (KEYN.LT.0 ) GO TO 62
- 24 IF (KEYN-KEYPL) 28, 25, 23
-
- 25 JSW = 7
- LC = LLPL
- GO TO 71
-
- 28 LS = KGOPL
-
-C-------- OUT-SEQUENCE LOOP, FIND PLACE FOR BANK IN THE CHAIN
-C-- OF BANKS ALREADY SORTED, +VE OR -VE CHAIN
-
- 41 LNX = LQ(KQS+LN)
- IFL = 7
- 43 KS = LS
- LS = LQ(KQS+LS)
- IF (KEYN-IQ(KQS+LS+JW)) 48, 45, 43
-
- 45 JSW = 0
- LC = LS
- GO TO 71
-
- 48 LQ(KQS+LN) = LS
- LQ(KQS+KS) = LN
- IF (LNX.EQ.0) GO TO 81
- LN = LNX
- KEYN = IQ(KQS+LN+JW)
- IF (KEYN.GE.0 ) GO TO 22
-
-C-------- -VE IN-SEQUENCE LOOP FOR BANKS WITH -VE KEY
-C-- KEEP GOING FOR INCREASING KEYS
-
- 62 LS = KGONG
- LQ(KQS+LLNG) = LN
- IF (KEYNG.NE.0 ) GO TO 64
-
- 63 KEYNG = KEYN
- LLNG = LN
- LN = LQ(KQS+LN)
- IF (LN.EQ.0) GO TO 81
- KEYN = IQ(KQS+LN+JW)
- IF (KEYN.GE.0 ) GO TO 21
- 64 IF (KEYN-KEYNG) 41, 65, 63
-
- 65 JSW = -7
- LC = LLNG
-
-C-------- COMPARE 2 STRINGS STARTING WITH THE SAME WORD
-
- 71 J = JW
- 72 J = J+1
- KYC = IQ(KQS+LC+J)
- KYN = IQ(KQS+LN+J)
-
-C-- KYN < KYC
- IF (KYN.GE.0 ) GO TO 74
- IF (KYC.GE.0 ) GO TO 79
- GO TO 75
-
-C-- KYN > KYC
- 74 IF (KYC.LT.0 ) GO TO 78
-
- 75 IF (KYN-KYC) 79, 76, 78
- 76 IF (J.LT.JWN) GO TO 72
-
-C-- KEYS/N .GE. KEYS/C
-
- 78 IF (JSW) 63, 43, 23
-
-C-- KEYS/N .LT. KEYS/C
-
- 79 IF (JSW) 41, 48, 28
-
-C---- FINISHED, LINK +VE AND -VE STREAMS, CHAIN K-LINKS
-
- 81 IF (IFL.EQ.0) GO TO 999
- LQ(KQS+LLNG) = 0
- LQ(KQS+LLPL) = LQ(KQS+KGONG)
-
- K = LQ(KQS+LGO+2)
- L = LQ(KQS+KGOPL)
- LQ(KQS+L+2) = K
- IF (K.NE.0) LQ(KQS+K)=L
- LGOP(1) = L
-
- 84 K = L
- L = LQ(KQS+K)
- IF (L.EQ.0) GO TO 999
- LQ(KQS+L+2) = K
- GO TO 84
-
-C---- SPECIAL CASE NWORDS=1
-
- 88 CALL ZSORTH (IXSTOR,LGOP,JW)
-
-#include "zebra/qtrace99.inc"
- RETURN
- END
-#endif
diff --git a/src/packlib/zebra/qutil/zsorvi.F b/src/packlib/zebra/qutil/zsorvi.F
deleted file mode 100644
index 3b42690..0000000
--- a/src/packlib/zebra/qutil/zsorvi.F
+++ /dev/null
@@ -1,170 +0,0 @@
-*
-* $Id: zsorvi.F,v 1.3 1999/06/18 13:31:26 couet Exp $
-*
-* $Log: zsorvi.F,v $
-* Revision 1.3 1999/06/18 13:31:26 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.2 1996/04/18 16:13:48 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:15 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE ZSORVI (IXSTOR,LGOP,JWORD,NWORDS)
-
-C- SORT BANKS AT LGO SUCH THAT THE 'NWORDS' LONG KEY STRINGS
-C- STARTING AT Q(L+JWORD) ARE IN INCREASING ORDER
-
-#include "zebra/mqsys.inc"
-*
- DIMENSION JWORD(9), NWORDS(9), LGOP(9)
-
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HZSOR, 4HVI /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HZSORVI /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'ZSORVI ')
-#endif
-
-#include "zebra/q_jbyt.inc"
-
- LGO = LGOP(1)
- IF (LGO.EQ.0) RETURN
-
-#include "zebra/qtraceq.inc"
-#include "zebra/qstore.inc"
-
- JW = JWORD(1)
- JWN = JW-1 + NWORDS(1)
- IF (JWN.LE.JW) GO TO 88
- KGONG = LQSTA(KQT+2) - 1
- LLNG = KGONG
- KGOPL = KGONG - 1
- LLPL = KGOPL
- KEYPL = -1
- KEYNG = 0
- IFL = 0
-
- LN = LGO
- KEYN = IQ(KQS+LN+JW)
- IF (KEYN.LT.0 ) GO TO 62
-
-C-------- +VE IN-SEQUENCE LOOP FOR BANKS WITH +VE KEY
-C-- KEEP GOING FOR INCREASING KEYS
-
- 21 LQ(KQS+LLPL) = LN
- GO TO 24
-
- 23 KEYPL = KEYN
- LLPL = LN
- LN = LQ(KQS+LN)
- IF (LN.EQ.0) GO TO 81
- KEYN = IQ(KQS+LN+JW)
- IF (KEYN.LT.0 ) GO TO 61
- 24 IF (KEYN-KEYPL) 28, 25, 23
-
- 25 JSW = 7
- LC = LLPL
- GO TO 71
-
- 28 LS = KGOPL
-
-C-------- OUT-SEQUENCE LOOP, FIND PLACE FOR BANK IN THE CHAIN
-C-- OF BANKS ALREADY SORTED, +VE OR -VE CHAIN
-
- 41 LNX = LQ(KQS+LN)
- IFL = 7
- 43 KS = LS
- LS = LQ(KQS+LS)
- IF (KEYN-IQ(KQS+LS+JW)) 48, 45, 43
-
- 45 JSW = 0
- LC = LS
- GO TO 71
-
- 48 LQ(KQS+LN) = LS
- LQ(KQS+KS) = LN
- IF (LNX.EQ.0) GO TO 81
- LN = LNX
- KEYN = IQ(KQS+LN+JW)
- IF (KEYN.GE.0 ) GO TO 21
-
-C-------- -VE IN-SEQUENCE LOOP FOR BANKS WITH -VE KEY
-C-- KEEP GOING FOR INCREASING KEYS
-
- 61 IFL = 7
- 62 LS = KGONG
- LQ(KQS+LLNG) = LN
- IF (KEYNG.NE.0 ) GO TO 64
-
- 63 KEYNG = KEYN
- LLNG = LN
- LN = LQ(KQS+LN)
- IF (LN.EQ.0) GO TO 81
- KEYN = IQ(KQS+LN+JW)
- IF (KEYN.GE.0 ) GO TO 21
- 64 IF (KEYN-KEYNG) 41, 65, 63
-
- 65 JSW = -7
- LC = LLNG
-
-C-------- COMPARE 2 STRINGS STARTING WITH THE SAME WORD
-
- 71 J = JW
- 72 J = J+1
- KYC = IQ(KQS+LC+J)
- KYN = IQ(KQS+LN+J)
-
-C-- KYN < KYC
- IF (KYN.GE.0 ) GO TO 74
- IF (KYC.GE.0 ) GO TO 79
- GO TO 75
-
-C-- KYN > KYC
- 74 IF (KYC.LT.0 ) GO TO 78
-
- 75 IF (KYN-KYC) 79, 76, 78
- 76 IF (J.LT.JWN) GO TO 72
-
-C-- KEYS/N .GE. KEYS/C
-
- 78 IF (JSW) 63, 43, 23
-
-C-- KEYS/N .LT. KEYS/C
-
- 79 IF (JSW) 41, 48, 28
-
-C---- FINISHED, LINK +VE AND -VE STREAMS, CHAIN K-LINKS
-
- 81 IF (IFL.EQ.0) GO TO 999
- LQ(KQS+LLPL) = 0
- LQ(KQS+LLNG) = LQ(KQS+KGOPL)
-
- K = LQ(KQS+LGO+2)
- L = LQ(KQS+KGONG)
- LQ(KQS+L+2) = K
- IF (K.NE.0) LQ(KQS+K)=L
- LGOP(1) = L
-
- 84 K = L
- L = LQ(KQS+K)
- IF (L.EQ.0) GO TO 999
- LQ(KQS+L+2) = K
- GO TO 84
-
-C---- SPECIAL CASE NWORDS=1
-
- 88 CALL ZSORTI (IXSTOR,LGOP,JW)
-
-#include "zebra/qtrace99.inc"
- RETURN
- END
diff --git a/src/packlib/zebra/qutil/ztopsy.F b/src/packlib/zebra/qutil/ztopsy.F
deleted file mode 100644
index 9387233..0000000
--- a/src/packlib/zebra/qutil/ztopsy.F
+++ /dev/null
@@ -1,46 +0,0 @@
-*
-* $Id: ztopsy.F,v 1.3 1999/06/18 13:31:26 couet Exp $
-*
-* $Log: ztopsy.F,v $
-* Revision 1.3 1999/06/18 13:31:26 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.2 1996/04/18 16:13:49 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:15 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE ZTOPSY (IXSTOR,LGOP)
-
-C- Invert order of banks in a linear stucture
-
-#include "zebra/q.inc"
-*
- DIMENSION LGOP(9)
-
-#include "zebra/q_jbyt.inc"
-
- LN = LGOP(1)
- IF (LN.EQ.0) RETURN
-
-#include "zebra/qstore.inc"
-
- KGO = LQ(KQS+LN+2)
- LC = 0
-
- 21 LP = LC
- LC = LN
- LN = LQ(KQS+LN)
- LQ(KQS+LC) = LP
- LQ(KQS+LC+2) = LN
- IF (LN.NE.0) GO TO 21
-
- IF (KGO.NE.0) LQ(KQS+KGO) = LC
- LQ(KQS+LC+2) = KGO
- LGOP(1) = LC
- RETURN
- END
diff --git a/src/packlib/zebra/rz/Imakefile b/src/packlib/zebra/rz/Imakefile
deleted file mode 100644
index e9f8a23..0000000
--- a/src/packlib/zebra/rz/Imakefile
+++ /dev/null
@@ -1,13 +0,0 @@
-SRCS_F= rzallo.F rzcdir.F rzchcy.F rzclos.F rzcop1.F \ @@\
- rzcopy.F rzdate.F rzdelk.F rzdelt.F rzdlok.F rzend.F rzexpd.F \ @@\
- rzfdir.F rzfile.F rzfree.F rzfrf1.F rzfrfz.F rzhfra.F rzhook.F \ @@\
- rzhtoa.F rzin.F rzink.F rzinpa.F rzins.F rziodo.F rziphd.F \ @@\
- rzkeep.F rzkeyd.F rzkeys.F rzldi1.F rzldir.F rzlinc.F rzlind.F \ @@\
- rzllok.F rzlock.F rzlogl.F rzmake.F rzmdir.F rzmods.F rzndir.F \ @@\
- rzobkn.F rzopen.F rzophd.F rzout.F rzpaff.F rzpass.F rzpath.F \ @@\
- rzprnk.F rzpurf.F rzpurg.F rzquot.F rzrdir.F rzread.F rzrenk.F \ @@\
- rzrtop.F rzsame.F rzsave.F rzscan.F rzstat.F rzstrip.F \ @@\
- rzstrir.F rztof1.F rztofz.F rzused.F rzvcyc.F rzver1.F \ @@\
- rzver2.F rzveri.F rzvers.F rzvin.F rzvout.F rzwrt.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/zebra/rz/rzallo.F b/src/packlib/zebra/rz/rzallo.F
deleted file mode 100644
index 54c0b07..0000000
--- a/src/packlib/zebra/rz/rzallo.F
+++ /dev/null
@@ -1,83 +0,0 @@
-*
-* $Id: rzallo.F,v 1.2 1996/04/24 17:26:38 mclareni Exp $
-*
-* $Log: rzallo.F,v $
-* Revision 1.2 1996/04/24 17:26:38 mclareni
-* Extend the include file cleanup to dzebra, rz and tq, and also add
-* dependencies in some cases.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:22 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE RZALLO(CHROUT,N,IALLOC)
-*
-***********************************************************************
-*
-* Returns the first N consecutive records free starting at IALLOC
-* Input:
-* CHROUT Name of the calling routine
-* N Number of consecutive records requested
-* Output:
-* IALLOC first of the N records available
-*
-* Called by RZOUT,RZVOUT,RZMDIR,RZEXPD
-*
-* Author : R.Brun DD/US/PD
-* Written : 01.04.86
-* Last mod: 26.10.93 JDS. Unique IQUEST(1) codes
-*
-* IQUEST(1) = 1 : request exceeds quota
-* = 2 : cannot find the requested number of free records
-*
-***********************************************************************
-#include "zebra/zunit.inc"
-#include "zebra/rzcl.inc"
-#include "zebra/rzk.inc"
- CHARACTER*6 CHROUT
-*
-*-----------------------------------------------------------------------
-*
-
-#include "zebra/q_jbyt.inc"
-
- LOGLV=JBYT(IQ(KQSP+LTOP),15,3)-3
- IF(LFREE.EQ.0)GO TO 90
- NFREE=IQ(KQSP+LFREE+1)
- IF(NFREE.EQ.0)GO TO 90
-*
- DO 10 I=1,NFREE
- IR1=IQ(KQSP+LFREE+2*I)
- IRL=IQ(KQSP+LFREE+2*I+1)
- IF(IR1+N-1.LE.IRL)THEN
- IALLOC=IR1
- GO TO 20
- ENDIF
- 10 CONTINUE
- GO TO 90
-*
-* Check if allocation is not above quota
-*
- 20 IF((IQ(KQSP+LCDIR+KRUSED)+N.GT.IQ(KQSP+LCDIR+KQUOTA)-3).OR.
- + (IALLOC.GT.IQ(KQSP+LFREE+2*NFREE+1)-3))THEN
- IF(LOGLV.GE.-2) WRITE(IQLOG,1000)CHROUT
- 1000 FORMAT(1X,A,'. Request exceeds quota')
- IALLOC=0
- IQUEST(1)=1
- IQUEST(10)=IQ(KQSP+LCDIR+KQUOTA)-3
- IQUEST(11)=IQ(KQSP+LFREE+2*NFREE+1)-3
- IQUEST(12)=N
- ENDIF
- GO TO 99
-*
-* Error
-*
- 90 IF(LOGLV.GE.-2) WRITE(IQLOG,2000)CHROUT,N
- 2000 FORMAT(1X,A,'. Cannot find the ',I3,' records requested')
- IALLOC =0
- IQUEST(1) =2
- IQUEST(10)=N
-*
- 99 RETURN
- END
diff --git a/src/packlib/zebra/rz/rzcdir.F b/src/packlib/zebra/rz/rzcdir.F
deleted file mode 100644
index 00d8e87..0000000
--- a/src/packlib/zebra/rz/rzcdir.F
+++ /dev/null
@@ -1,219 +0,0 @@
-*
-* $Id: rzcdir.F,v 1.2 1996/04/24 17:26:40 mclareni Exp $
-*
-* $Log: rzcdir.F,v $
-* Revision 1.2 1996/04/24 17:26:40 mclareni
-* Extend the include file cleanup to dzebra, rz and tq, and also add
-* dependencies in some cases.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:23 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE RZCDIR(CHPATH,CHOPT)
-*
-************************************************************************
-*
-* To set,read or print the Current Working Directory
-* Input:
-* *CHPATH* Character variable specifying the pathname of the CWD
-* (default option).
-* Unless several RZ files are open at the same time, the path
-* name can be specified either as a path starting with the
-* character '/', in which case an absolute pathname is
-* intended for the given top directory. When several RZ files
-* are open, an absolute pathname must start with a double
-* slash '//' and the top directory. When the pathname does
-* not start with a '/', the pathname is prefixed with the path
-* of the CWD.
-* CHPATH = ' ' means the CWD (useful with the 'U' option)
-* CHOPT Character variable specifying the option
-* 'R' Read the CWD pathname into CHPATH
-* 'P' Print the CWD
-* ' ' Set the CWD
-* 'U' The same as the default but the time stamp in the
-* directory in memory is checked against the one on the
-* file and if needed the directory in memory is brought
-* up to date. This option should be used when the user
-* expects that directories can be changed concurrently
-* by another user and he wants to use the latest version
-* 'Q' quiet - do not print message if directory does not exist
-* 'K' Keep current directory in memory. Do not drop
-* Output:
-* *CHPATH* Character variable containing the complete pathname of the
-* current working directory (with 'R' option only).
-*
-* Called by <USER>,RZINPA,RZLDIR
-*
-* Author : R.Brun DD/US/PD
-* Written : 02.04.86
-* Last mod: 09.06.93 JDS. Protection against no RZ files open
-*
-* IQUEST(1) = 1 : RZIODO error
-* 2 : unknown directory
-* 3 : directory overwritten
-* 4 : no control bank - RZFILE/RZMAKE not called
-* 5 : no open files (RZEND called for all)
-*
-************************************************************************
-#include "zebra/zunit.inc"
-#include "zebra/rzcl.inc"
-#include "zebra/rzdir.inc"
-#include "zebra/rzch.inc"
-#include "zebra/rzclun.inc"
-#include "zebra/rzk.inc"
- DIMENSION IOPTV(5)
- EQUIVALENCE (IOPTR,IOPTV(1)), (IOPTP,IOPTV(2)), (IOPTU,IOPTV(3))
- EQUIVALENCE (IOPTK,IOPTV(4)), (IOPTQ,IOPTV(5))
- CHARACTER*(*) CHPATH,CHOPT
- CHARACTER*1 COPTQ
-*
-*-----------------------------------------------------------------------
-*
-#include "zebra/q_jbit.inc"
-#include "zebra/q_jbyt.inc"
-
- IQUEST(1)=0
-
- CALL UOPTC (CHOPT,'RPUKQ',IOPTV)
- IF(IOPTK.NE.0) IOPTU=0
- IF(IOPTR.NE.0) CHPATH = ' '
-*
-* Check for RZ control bank (i.e. did we call RZFILE/MAKE yet)
-*
- IF(LQRS.EQ.0) THEN
- IQUEST(1) = 4
- GOTO 999
- ENDIF
-*
-* Check that we have at least one RZ file still open
-*
- LRZ=LQRS
- 10 IF(LRZ.EQ.0) GOTO 20
- IF(IQ(KQSP+LRZ-5).NE.0) GOTO 30
- LRZ=LQ(KQSP+LRZ)
- GO TO 10
- 20 CONTINUE
- IQUEST(1) = 5
- GOTO 999
- 30 CONTINUE
-*
-* Read Working directory
-*
- IF(IOPTR.NE.0)THEN
- CALL RZPAFF(CHCDIR,NLCDIR,CHPATH)
- GO TO 999
- ENDIF
-*
-* Print Working directory
-*
- IF(IOPTP.NE.0)THEN
- CALL RZPAFF(CHCDIR,NLCDIR,CHL)
- WRITE(IQPRNT,10000)CHL(1:LENOCC(CHL))
-10000 FORMAT(' Current Working Directory = ',A)
- GO TO 999
- ENDIF
-*
-* Set Working directory
-* Mark old working directory to be dropped
-* Write current directory if modified
-*
- COPTQ = ' '
- IF(IOPTQ.NE.0) COPTQ = 'Q'
- IF(LCDIR.NE.0.AND.ISAVE.NE.0.AND.IOPTK.EQ.0)THEN
- LBANK=LCDIR
- 40 IF(LBANK.NE.LTOP)THEN
- LUP=LQ(KQSP+LBANK+1)
- IF(IOPTU.EQ.0)THEN
- CALL SBIT1(IQ(KQSP+LBANK),IQDROP)
- ELSE
- CALL MZDROP(JQPDVS,LBANK,' ')
- IQ(KQSP+LTOP+KIRIN)=0
- ENDIF
- LBANK=LUP
- IF(LBANK.NE.0)GO TO 40
- ENDIF
- ENDIF
-*
-* Read Top Dir In Case Of U Option
-*
- IF(IOPTU.NE.0)CALL RZRTOP
-*
- IF(ISAVE.NE.0)THEN
- CALL RZSAVE
- ENDIF
-*
-* Set new directory
-*
- CALL RZPATH(CHPATH)
- CALL RZFDIR('RZCDIR',LT,LDIR,COPTQ)
- IF(LDIR.NE.0)THEN
- NLCDIR= NLPAT
- LCDIR = LDIR
- LTOP = LT
- DO 50 I=1,NLPAT
- CHCDIR(I)=CHPAT(I)
- 50 CONTINUE
- ELSE
-* Already set by RZFDIR
-* IQUEST(1)=1
- IF(LCDIR.NE.0)CALL SBIT0(IQ(KQSP+LCDIR),IQDROP)
- GO TO 999
- ENDIF
-
- LFREE = LQ(KQSP+LTOP-2)
- LUSED = LQ(KQSP+LTOP-3)
- LPURG = LQ(KQSP+LTOP-5)
- LROUT = LQ(KQSP+LTOP-6)
- LRIN = LQ(KQSP+LTOP-7)
- LB = IQ(KQSP+LTOP+KLB)
- LREC = IQ(KQSP+LTOP+LB+1)
- LUN = IQ(KQSP+LTOP-5)
- IZRECL = IQ(KQSP+LTOP+LB+1)
- IMODEC = JBIT(IQ(KQSP+LTOP),5)
- IMODEH = JBIT(IQ(KQSP+LTOP),6)
-#if defined(CERNLIB_FQXISN)
-*
-* Set exchange mode bit
-*
- CALL SBIT1(IQ(KQSP+LTOP+KPW1+2),12)
- IMODEX = 1
-#endif
-#if !defined(CERNLIB_FQXISN)
- IMODEX = JBIT(IQ(KQSP+LTOP+KPW1+2),12)
-#endif
-#if defined(CERNLIB_QMVAX)
- IRELAT = JBIT(IQ(KQSP+LTOP),4)
-#endif
- IQUEST(7)=IQ(KQSP+LCDIR+KNKEYS)
- IQUEST(8)=IQ(KQSP+LCDIR+KNWKEY)
- IQUEST(9)=IQ(KQSP+LCDIR+KNSD)
- IQUEST(10)=IQ(KQSP+LCDIR+KQUOTA)
- IQUEST(11)=LCDIR
- IQUEST(12)=LTOP
- IQUEST(13)=IQ(KQSP+LCDIR+KLK)
- CALL RZDATE(IQ(KQSP+LCDIR+KDATEC),IDATEC,ITIMEC,1)
- CALL RZDATE(IQ(KQSP+LCDIR+KDATEM),IDATEM,ITIMEM,1)
- IQUEST(14)=IDATEC
- IQUEST(15)=ITIMEC
- IQUEST(16)=IDATEM
- IQUEST(17)=ITIMEM
- IQUEST(18)=IQ(KQSP+LCDIR+KRUSED)
- IQUEST(19)=IQ(KQSP+LCDIR+KMEGA)
- IQUEST(20)=IQ(KQSP+LCDIR+KWUSED)
- IQUEST(21)=IQ(KQSP+LCDIR+IQ(KQSP+LCDIR+KLD))
-*
-* Check password
-*
- IF(JBYT(IQ(KQSP+LCDIR+KPW1+2),6,5).NE.0)THEN
- IF(IQ(KQSP+LCDIR+KPW1).NE.IHPWD(1).OR.
- + IQ(KQSP+LCDIR+KPW1+1).NE.IHPWD(2))THEN
- CALL SBIT1(IQ(KQSP+LCDIR),1)
- ELSE
- CALL SBIT0(IQ(KQSP+LCDIR),1)
- ENDIF
- ENDIF
- IF(JBIT(IQ(KQSP+LTOP),1).NE.0)CALL SBIT1(IQ(KQSP+LCDIR),1)
-*
- 999 END
diff --git a/src/packlib/zebra/rz/rzchcy.F b/src/packlib/zebra/rz/rzchcy.F
deleted file mode 100644
index 3ded4d0..0000000
--- a/src/packlib/zebra/rz/rzchcy.F
+++ /dev/null
@@ -1,72 +0,0 @@
-*
-* $Id: rzchcy.F,v 1.2 1996/04/24 17:26:41 mclareni Exp $
-*
-* $Log: rzchcy.F,v $
-* Revision 1.2 1996/04/24 17:26:41 mclareni
-* Extend the include file cleanup to dzebra, rz and tq, and also add
-* dependencies in some cases.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:23 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE RZCHCY
-*
-************************************************************************
-*
-* To check cycles block and reset pointers if needed
-*
-* Called by <USER>,RZINPA,RZLDIR
-*
-* Author :
-* Written :
-* Last mod: 04.03.94 S.Banerjee (Change in cycle structure)
-*
-************************************************************************
-#include "zebra/zunit.inc"
-#include "zebra/rzcl.inc"
-#include "zebra/rzclun.inc"
-#include "zebra/rzk.inc"
-#include "zebra/rzckey.inc"
-#include "zebra/rzcycle.inc"
-*
-*-----------------------------------------------------------------------
-*
-*
- IQUEST(1) = 0
- LD=IQ(KQSP+LCDIR+KLD)
- LK=IQ(KQSP+LCDIR+KLK)
- LF=IQ(KQSP+LCDIR+KLF)
- LC=IQ(KQSP+LCDIR+KLC)
- LE=IQ(KQSP+LCDIR+KLE)
- NKEYS =IQ(KQSP+LCDIR+KNKEYS)
- NWKEY =IQ(KQSP+LCDIR+KNWKEY)
- LC0 = LE-NKEYS*KLCYCL+1
- IF(LC.EQ.LC0) RETURN
-*
-* Check consistancy of cycles block
-*
- NGOOD = 0
- NBAD = 0
- DO 10 LKC=LC,LE-KLCYCL+1,KLCYCL
- IF(IQ(KQSP+LCDIR+LKC).EQ.-1)THEN
- NBAD = NBAD + 1
- ELSE
- NGOOD = NGOOD + 1
- IF(NGOOD.EQ.1) LC1 = LKC
- ENDIF
- 10 CONTINUE
- LC2 = NBAD*KLCYCL+LC
- IF(LC0.EQ.LC1.AND.LC0.EQ.LC2.AND.NGOOD.EQ.NKEYS) THEN
- IQ(KQSP+LCDIR+KLC) = LC0
-*
-* Mark directory as modified
-*
- CALL SBIT1(IQ(KQSP+LCDIR),2)
- CALL SBIT1(IQ(KQSP+LTOP),2)
- ELSE
- IQUEST(1) = 1
- ENDIF
-
- END
diff --git a/src/packlib/zebra/rz/rzclos.F b/src/packlib/zebra/rz/rzclos.F
deleted file mode 100644
index e0d0fce..0000000
--- a/src/packlib/zebra/rz/rzclos.F
+++ /dev/null
@@ -1,98 +0,0 @@
-*
-* $Id: rzclos.F,v 1.5 1998/08/06 17:17:06 mclareni Exp $
-*
-* $Log: rzclos.F,v $
-* Revision 1.5 1998/08/06 17:17:06 mclareni
-* For multiple files, LUN has to be set in the common RZCLUN before it is used by RZFREE
-*
-* Revision 1.4 1997/07/04 15:26:01 couet
-* - the error message printing previously added was wrong
-*
-* Revision 1.3 1997/07/03 09:21:15 couet
-* - CHPATH is converted is uppercase before being compared to CHNAME
-*
-* Revision 1.2 1996/04/24 17:26:42 mclareni
-* Extend the include file cleanup to dzebra, rz and tq, and also add
-* dependencies in some cases.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:23 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE RZCLOS(CHPATH,CHOPT)
-*
-************************************************************************
-*
-* To close all transactions with file CHPATH
-* Corresponding directories are dropped
-* A FORTRAN or CFCLOS is also issued for all associated files
-* Input:
-* CHPATH Character variable specifying the name of the top directory
-* CHOPT Character variable specifying the options required
-* 'A' Close all files currently open
-*
-* Called by <USER>
-*
-* Author : J. Shiers
-* Written : 11.11.91
-* Last mod: 11.11.91
-*
-************************************************************************
- CHARACTER*(*) CHPATH,CHOPT
- CHARACTER*16 CHNAME,CHPATU
- DIMENSION IHDIR(4)
-#include "zebra/rzcl.inc"
-#include "zebra/rzclun.inc"
-#include "zebra/zunit.inc"
-#include "zebra/q_jbit.inc"
-#include "zebra/q_jbyt.inc"
-
- LP = LENOCC(CHPATH)
- LC = LENOCC(CHOPT)
- IOPTA = 0
- IF(LC.GT.0) IOPTA = INDEX(CHOPT(1:LC),'A')
-
- IF(LQRS.EQ.0) RETURN
- LRZ=LQRS
- 10 IF(LRZ.EQ.0) RETURN
- LUN = IQ(KQSP+LRZ-5)
- IF(LUN.NE.0) THEN
- LOGLV = JBYT(IQ(KQSP+LRZ),15,3)-3
- CALL ZITOH(IQ(KQSP+LRZ+1),IHDIR,4)
- CALL UHTOC(IHDIR,4,CHNAME,16)
- LN = LENOCC(CHNAME)
-*
-* Check top directory name unless IOPTA
-*
- IF(IOPTA.EQ.0) THEN
- CHPATU = CHPATH(1:LP)
- CALL CLTOU(CHPATU)
- IF(CHPATU(1:LP).NE.CHNAME(1:LN)) GOTO 20
- ENDIF
- CALL RZEND(CHNAME(1:LN))
-*
-* Close
-*
- IF(LUN.GT.0) THEN
- IF(JBIT(IQ(KQSP+LRZ),5).EQ.0) THEN
- IF(LOGLV.GT.0) WRITE(IQLOG,*) 'RZCLOS. close unit ',LUN,
- + ' (FORTRAN)'
- CLOSE(LUN)
- ELSE
-#if defined(CERNLIB_QMIBM)
- IF(LOGLV.GT.0) WRITE(IQLOG,*) 'RZCLOS. C I/O not ',
- + 'supported on this system'
-#endif
-#if !defined(CERNLIB_QMIBM)
- IF(LOGLV.GT.0) WRITE(IQLOG,*) 'RZCLOS. close unit ',LUN,
- + ' (C)'
- CALL CFCLOS(LUN-1000,0)
-#endif
- ENDIF
- ENDIF
- ENDIF
- 20 CONTINUE
- LRZ=LQ(KQSP+LRZ)
- GO TO 10
- END
diff --git a/src/packlib/zebra/rz/rzcop1.F b/src/packlib/zebra/rz/rzcop1.F
deleted file mode 100644
index 7984edc..0000000
--- a/src/packlib/zebra/rz/rzcop1.F
+++ /dev/null
@@ -1,305 +0,0 @@
-*
-* $Id: rzcop1.F,v 1.2 1996/04/24 17:26:43 mclareni Exp $
-*
-* $Log: rzcop1.F,v $
-* Revision 1.2 1996/04/24 17:26:43 mclareni
-* Extend the include file cleanup to dzebra, rz and tq, and also add
-* dependencies in some cases.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:23 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE RZCOP1(LUNOLD,LROLD,KEY,IOLD)
-*
-************************************************************************
-*
-* Copy one (KEY,CYCLE) from LFROM to the CWD
-* Input:
-* LUNOLD Logical unit number of the file from which the copy is made
-* LROLD Record size of LUNOLD
-* KEY Identification (array) of the key to created in the CWD
-* IOLD Array of 4 words describing the cycle which is copied
-*
-* Called by RZCOPY
-*
-* Author : R.Brun DD/US/PD
-* Written : 07.05.86
-* Last mod: 01.09.92 Dave Morrison (MIT) handle append mode bit
-* : 04.03.94 S.Banerjee (Change in cycle structure)
-* : 23.03.95 J.Shiers - key # in cycles block is KEY(1)
-*
-************************************************************************
-#include "zebra/rzcl.inc"
-#include "zebra/rzclun.inc"
-#include "zebra/rzk.inc"
-#include "zebra/rzcycle.inc"
- DIMENSION KEY(*),IOLD(4)
-*
-*-----------------------------------------------------------------------
-*
-#include "zebra/q_jbit.inc"
-#include "zebra/q_jbyt.inc"
-
-*
-* Get last record written in that directory
-* Create buffer bank
-*
- IF (KVSCYC.EQ.0) THEN
- IR1OLD = JBYT(IOLD(KFRCYC),17,16)
- IP1OLD = JBYT(IOLD(KORCYC), 1,16)
- IR2OLD = JBYT(IOLD(KSRCYC),17,16)
- NDATA = JBYT(IOLD(KNWCYC), 1,20)
- IFORM = JBYT(IOLD(KFLCYC), 1, 3)
- ELSE
- IR1OLD = IOLD(KFRCYC)
- IP1OLD = JBYT(IOLD(KORCYC), 1,20)
- IR2OLD = IOLD(KSRCYC)
- NDATA = IOLD(KNWCYC)
- IFORM = JBYT(IOLD(KFLCYC), 1, 3)
- ENDIF
- LROUT = LQ(KQSP+LTOP-6)
- IROUT = IQ(KQSP+LTOP+KIROUT)
- IRLOUT = IQ(KQSP+LCDIR+KRLOUT)
- IP1 = IQ(KQSP+LCDIR+KIP1)
- IF(LROUT.EQ.0)THEN
- CALL MZBOOK(JQPDVS,LROUT,LTOP,-6,'RZOU',0,0,LREC+1,2,-1)
- IQ(KQSP+LROUT-5)=LUN
- IROUT=0
- IP1=1
- ENDIF
- IF(IROUT.NE.IRLOUT.AND.IRLOUT.NE.0)THEN
- CALL RZIODO(LUN,LREC,IRLOUT,IQ(KQSP+LROUT+1),1)
- IF(IQUEST(1).NE.0)GO TO 999
-#if defined(CERNLIB_QMVAX)
- IF(IRELAT.NE.0)UNLOCK(UNIT=LUN)
-#endif
- IROUT=IRLOUT
- IQ(KQSP+LTOP+KIROUT)=IROUT
- IP1=IQ(KQSP+LCDIR+KIP1)
- IF(IQ(KQSP+LTOP+KIRIN).EQ.IROUT)IQ(KQSP+LTOP+KIRIN) = 0
- ENDIF
-*
-* Is directory big enough to accomodate new cycle ?
-*
- IF(IQ(KQSP+LCDIR+KNFREE).LT.IQ(KQSP+LCDIR+KNWKEY)+4*KLCYCL+1)THEN
- CALL RZEXPD('RZCOPY',10*(IQ(KQSP+LCDIR+KNWKEY)+KLCYCL+1))
- IF(IQUEST(1).NE.0) GO TO 999
- ENDIF
- LK = IQ(KQSP+LCDIR+KLK)
- LF = IQ(KQSP+LCDIR+KLF)
- LC = IQ(KQSP+LCDIR+KLC)
- NWFREE=IQ(KQSP+LCDIR+KNFREE)
-*
-* Compute how many records
-* are necessary to write data structure.
-*
- NLEFT=LREC-IP1+1
- IF(NDATA.LE.NLEFT)THEN
- N1=NDATA
- NR=0
- ELSE
- N1=NLEFT
- NR=(NDATA-NLEFT-1)/LREC + 1
- ENDIF
- IF(IRLOUT.EQ.0)NR=NR+1
- IF(NR.GT.0)THEN
- CALL RZALLO('RZCOPY',NR,IALLOC)
- IF(IALLOC.EQ.0) GO TO 999
- IF(IRLOUT.EQ.0)IRLOUT=IALLOC
- ENDIF
-*
-* Search if KEY is already entered
-*
- NKEYS = IQ(KQSP+LCDIR+KNKEYS)
- NWKEY = IQ(KQSP+LCDIR+KNWKEY)
- IQUEST(7)=NKEYS
- IQUEST(8)=NWKEY
-*
- IF(NKEYS.GT.0)THEN
- DO 20 I=1,NKEYS
- LKC=LK+(NWKEY+1)*(I-1)
- DO 10 K=1,NWKEY
- IF(IQ(KQSP+LCDIR+LKC+K).NE.KEY(K))GO TO 20
- 10 CONTINUE
- LCOLD = IQ(KQSP+LCDIR+LKC)
- IF (KVSCYC.NE.0) THEN
-* IF (IQ(KQSP+LCDIR+LCOLD+KKYCYC).NE.I) THEN
- IF (IQ(KQSP+LCDIR+LCOLD+KKYCYC).NE.
- + IQ(KQSP+LCDIR+LKC+1)) THEN
- IQUEST(1) = 11
- GO TO 999
- ENDIF
- ENDIF
- ICOLD = JBYT(IQ(KQSP+LCDIR+LCOLD+KCNCYC),21,12)
- ICYCLE = ICOLD+1
-* IKYV = I
- IKYV = IQ(KQSP+LCDIR+LKC+1)
- GO TO 50
- 20 CONTINUE
- ENDIF
-*
-* New KEY, append to the list
-*
- NWFREE=NWFREE-NWKEY-1
- IQ(KQSP+LCDIR+KNKEYS)=IQ(KQSP+LCDIR+KNKEYS)+1
- LCOLD=0
- LKC=LF
- LF=LF+NWKEY+1
- DO 30 I=1,NWKEY
- IQ(KQSP+LCDIR+LKC+I)=KEY(I)
- 30 CONTINUE
- ICYCLE = 1
-* IKYV = IQ(KQSP+LCDIR+KNKEYS)
- IKYV = IQ(KQSP+LCDIR+LKC+1)
-*
-* Create a new cycle
-*
- 50 LKCSV = IQ(KQSP+LCDIR+LKC)
- LC = LC-KLCYCL
- NWFREE= NWFREE-KLCYCL
- IQ(KQSP+LCDIR+LKC) = LC
- IQ(KQSP+LCDIR+LC+KPPCYC) = LCOLD
- IQ(KQSP+LCDIR+LC+KFLCYC)=0
- CALL RZDATE (IQ(KQSP+LCDIR+LC+KFLCYC),IDATE,ITIME,2)
-c
-c DPM: Added this to handle append mode.
-c
- IBIT4 = JBIT(IOLD(KFLCYC),4)
- IF(IBIT4.EQ.1)CALL SBIT1(IQ(KQSP+LCDIR+LC+KFLCYC),4)
-c
-c DPM: End of changes.
-c
- CALL SBYT (IFORM,IQ(KQSP+LCDIR+LC+KFLCYC),1,3)
- IQ(KQSP+LCDIR+LC+KORCYC) = IP1
- IQ(KQSP+LCDIR+LC+KNWCYC) = NDATA
- CALL SBYT(ICYCLE,IQ(KQSP+LCDIR+LC+KCNCYC),21,12)
- IF (KVSCYC.EQ.0) THEN
- IF(N1.LT.NDATA)CALL SBYT(IALLOC,IQ(KQSP+LCDIR+LC+KSRCYC),17,16)
- CALL SBYT(IRLOUT,IQ(KQSP+LCDIR+LC+KFRCYC),17,16)
- ELSE
- IF (N1.LT.NDATA) THEN
- IQ(KQSP+LCDIR+LC+KSRCYC) = IALLOC
- ELSE
- IQ(KQSP+LCDIR+LC+KSRCYC) = 0
- ENDIF
- IQ(KQSP+LCDIR+LC+KFRCYC) = IRLOUT
- IQ(KQSP+LCDIR+LC+KKYCYC) = IKYV
- ENDIF
- IQUEST(3)=IRLOUT
- IQUEST(4)=IP1
- IQUEST(5)=0
- IQUEST(6)=ICYCLE
- IQUEST(11)=NDATA
-*
-* Copy records
-* Start filling current block
-*
- IF(LRIN.EQ.0)THEN
- CALL MZBOOK(JQPDVS,LRIN,LTOP,-7,'RZIN',0,0,LROLD+1,2,-1)
- IQ(KQSP+LRIN-5)=IQ(KQSP+LTOP-5)
- ELSE
- NOLD=IQ(KQSP+LRIN-1)
- IF(NOLD.LT.LROLD)THEN
- CALL MZPUSH(JQPDVS,LRIN,0,LROLD-NOLD,'I')
- ENDIF
- ENDIF
- CALL RZIODO(LUNOLD,LROLD,IR1OLD,IQ(KQSP+LRIN+1),1)
- IF(IQUEST(1).NE.0) GO TO 900
- NWC=N1
- IRN=IR2OLD-1
- 55 IF(NWC.GT.LROLD-IP1OLD+1)THEN
- NWC=LROLD-IP1OLD+1
- CALL UCOPY(IQ(KQSP+LRIN+IP1OLD),IQ(KQSP+LROUT+IP1),NWC)
- IP1OLD=1
- IF(NWC.LT.N1)THEN
- IRN=IRN+1
- CALL RZIODO(LUNOLD,LROLD,IRN,IQ(KQSP+LRIN+1),1)
- IF(IQUEST(1).NE.0) GO TO 900
- NWC=N1-NWC
- GO TO 55
- ENDIF
- ELSE
- CALL UCOPY(IQ(KQSP+LRIN+IP1OLD),IQ(KQSP+LROUT+IP1),NWC)
- IP1OLD=IP1OLD+NWC
- ENDIF
- IF(IP1.EQ.1)THEN
- IRLOUT=IALLOC
- IROUT=IRLOUT
- ENDIF
- IP1=IP1+N1
- IF(IP1.GT.LREC)THEN
- CALL RZIODO(LUN,LREC,IRLOUT,IQ(KQSP+LROUT+1),2)
- IF(IQUEST(1).NE.0) GO TO 900
- IF(IP1.GT.NDATA)IRLOUT=0
- IP1=1
- ENDIF
- IF(N1.LT.NDATA)THEN
- IQUEST(5)=IALLOC
- IQUEST(2)=NR+1
- DO 60 I=1,NR
- IP1=1
- NW=NDATA-N1
- IF(NW.GT.LREC)NW=LREC
- NWC=NW
- 57 IF(NWC.GT.LROLD-IP1OLD+1)THEN
- NWC=LROLD-IP1OLD+1
- CALL UCOPY(IQ(KQSP+LRIN+IP1OLD),IQ(KQSP+LROUT+IP1),NWC)
- IP1OLD=1
- IF(NWC.LT.N1)THEN
- IRN=IRN+1
- CALL RZIODO(LUNOLD,LROLD,IRN,IQ(KQSP+LRIN+1),1)
- IF(IQUEST(1).NE.0) GO TO 900
- NWC=NW-NWC
- GO TO 57
- ENDIF
- ELSE
- CALL UCOPY(IQ(KQSP+LRIN+IP1OLD),IQ(KQSP+LROUT+IP1),NWC)
- IP1OLD=IP1OLD+NWC
- ENDIF
- IF(NW.EQ.LREC)THEN
- CALL RZIODO(LUN,LREC,IROUT,IQ(KQSP+LROUT+1),2)
- IF(IQUEST(1).NE.0) GO TO 900
- ELSE
- IRLOUT=IALLOC+I-1
- IROUT=IRLOUT
- ENDIF
- IP1=IP1+NW
- N1=N1+NW
- 60 CONTINUE
- ENDIF
-*
-* Update internal pointers in the directory
-*
- IQ(KQSP+LTOP+KIROUT)=IROUT
- IQUEST(9)=IQ(KQSP+LCDIR+KQUOTA)-IQ(KQSP+LCDIR+KRUSED)
- IQ(KQSP+LCDIR+KRUSED)=IQ(KQSP+LCDIR+KRUSED)+NR
- NWUSED=IQ(KQSP+LCDIR+KWUSED)+NDATA
- IF(NWUSED.GT.1000000)THEN
- IQ(KQSP+LCDIR+KMEGA)=IQ(KQSP+LCDIR+KMEGA)+1
- IQ(KQSP+LCDIR+KWUSED)=NWUSED-1000000
- ELSE
- IQ(KQSP+LCDIR+KWUSED)=NWUSED
- ENDIF
- IQ(KQSP+LCDIR+KRLOUT)=IRLOUT
- IQ(KQSP+LCDIR+KIP1)=IP1
- IQ(KQSP+LCDIR+KNFREE)=NWFREE
- IQ(KQSP+LCDIR+KLF)=LF
- IQ(KQSP+LCDIR+KLC)=LC
-*
-* Mark used records
-*
- IF(NR.GT.0)THEN
- CALL RZUSED(NR,IALLOC)
- ENDIF
- GO TO 999
-* Reset internal pointers in case of I/O problem
-*
- 900 IF(ICYCLE.EQ.1)THEN
- IQ(KQSP+LCDIR+KNKEYS)=IQ(KQSP+LCDIR+KNKEYS)-1
- ENDIF
- IQ(KQSP+LCDIR+LKC)=LKCSV
-*
- 999 RETURN
- END
diff --git a/src/packlib/zebra/rz/rzcopy.F b/src/packlib/zebra/rz/rzcopy.F
deleted file mode 100644
index cf04b65..0000000
--- a/src/packlib/zebra/rz/rzcopy.F
+++ /dev/null
@@ -1,301 +0,0 @@
-*
-* $Id: rzcopy.F,v 1.2 1996/04/24 17:26:44 mclareni Exp $
-*
-* $Log: rzcopy.F,v $
-* Revision 1.2 1996/04/24 17:26:44 mclareni
-* Extend the include file cleanup to dzebra, rz and tq, and also add
-* dependencies in some cases.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:23 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE RZCOPY(CHPATH,KEYU,ICYCLE,KEYUN,CHOPT)
-*
-************************************************************************
-*
-* Routine to copy an object from CHPATH or the whole tree to the CWD
-* Input:
-* CHPATH The pathname of the directory tree which has to be copied to
-* the CWD
-* KEYU KEY of the object to be copied from CHPATH
-* ICYCLE Cycle number of the key to be copied
-* KEYUN New value of the key in CWD (may be the same as KEYU)
-* CHOPT Character string to specify various options
-* default ' ' copy the object with (KEYU,ICYCLE) from CHPATH to the CWD
-* If KEYUN already exists, a new cycle is created
-* 'C' copy all cycles for the specified key
-* 'K' copy all keys (If 'C' option is given, copy all cycles)
-* 'T' copy the complete tree CHPATH
-* When the option 'T' is given, by default only the highest
-* cycle of each key is copied
-* To copy all cycles use 'TC' option
-*
-* Called by <USER>
-*
-* Author : R.Brun DD/US/PD
-* Written : 07.05.86
-* Last mod: 14.05.92 Add CHOPT on call to RZFDIR
-* : 04.03.94 S.Banerjee (Change in cycle structure)
-* : 23.03.95 J.Shiers - key # in cycles block is KEY(1)
-*
-************************************************************************
-#include "zebra/zunit.inc"
-#include "zebra/rzcl.inc"
-#include "zebra/rzk.inc"
-#include "zebra/rzckey.inc"
-#include "zebra/rzdir.inc"
-#include "zebra/rzch.inc"
-#include "zebra/rzcycle.inc"
-#if defined(CERNLIB_QMVAX)
-#include "zebra/rzclun.inc"
-#endif
- CHARACTER*(*) CHPATH,CHOPT
- DIMENSION KEYU(*),KEYUN(*)
- DIMENSION IOPTV(3),ISD(NLPATM),NSD(NLPATM),IHDIR(4)
- CHARACTER*16 CHFPAT(NLPATM)
- EQUIVALENCE (IOPTC,IOPTV(1)),(IOPTK,IOPTV(2))
- + ,(IOPTT,IOPTV(3))
- LOGICAL COPY,RZSAME
-*
-*-----------------------------------------------------------------------
-*
-#if defined(CERNLIB_QMVAX)
-#include "zebra/q_jbit.inc"
-#endif
-#include "zebra/q_jbyt.inc"
-
- IQUEST(1)=0
- LOGLV=JBYT(IQ(KQSP+LTOP),15,3)-3
-*
-* Save existing material (if any)
-*
- CALL RZSAVE
-*
- CALL UOPTC(CHOPT,'CKT',IOPTV)
-*
-* Check if WRITE permission on file and directory
-*
- IF(LQRS.EQ.0)GO TO 999
- IFLAG=0
- CALL RZMODS('RZCOPY',IFLAG)
- IF(IFLAG.NE.0)GO TO 999
-*
-* Save CWD name
-*
- CALL RZCDIR(CHWOLD,'R')
-*
-* Load directory CHPATH
-*
- CALL RZPATH(CHPATH)
- NLPAT0=NLPAT
- NLPAT1=NLPAT
- DO 1 I=1,NLPAT
- 1 CHFPAT(I)=CHPAT(I)
- CALL RZFDIR('RZCOPY',LT,LFROM,' ')
- IF(LFROM.EQ.0)THEN
- IQUEST(1)=4
- GO TO 999
- ENDIF
- ISD(NLPAT1)=0
- NSD(NLPAT1)=IQ(KQSP+LFROM+KNSD)
- CALL SBIT0(IQ(KQSP+LFROM),IQDROP)
- LB =IQ(KQSP+LT+KLB)
- LROLD =IQ(KQSP+LT+LB+1)
- LUNOLD=IQ(KQSP+LT-5)
- NKEYS=IQ(KQSP+LFROM+KNKEYS)
- NWKEY=IQ(KQSP+LFROM+KNWKEY)
-*
-* Check if KEY descriptors matches
-*
- IF(NWKEY.NE.IQ(KQSP+LCDIR+KNWKEY).OR.
- + IQ(KQSP+LFROM+KKDES).NE.IQ(KQSP+LCDIR+KKDES))THEN
- IQUEST(1)=4
- IF(LOGLV.GE.-2) WRITE(IQLOG,1000)
- 1000 FORMAT(' RZCOPY. Key descriptors do not match')
- GO TO 900
- ENDIF
-*
- IF(IOPTT.NE.0)THEN
- LBANK=LCDIR
- 5 IF(LBANK.NE.LTOP)THEN
- LBANK=LQ(KQSP+LBANK+1)
- IF(LBANK.EQ.LFROM)THEN
- IF(LOGLV.GE.-2) WRITE(IQLOG,3000)
- 3000 FORMAT(' RZCOPY. Cannot copy mother tree in daughter')
- IQUEST(1)=4
- GO TO 900
- ENDIF
- GO TO 5
- ENDIF
- ENDIF
-*
- IF(NKEYS.EQ.0)THEN
- IF(IOPTK.EQ.0.AND.IOPTT.EQ.0)GO TO 999
- GO TO 100
- ENDIF
-*
-* Convert KEYU,KEYUN (If only one key to be copied)
-*
- IF(IOPTK.EQ.0.AND.IOPTT.EQ.0)THEN
- DO 10 I=1,NWKEY
- IKDES=(I-1)/10
- IKBIT1=3*I-30*IKDES-2
- IF(JBYT(IQ(KQSP+LFROM+KKDES+IKDES),IKBIT1,3).LT.3)THEN
- KEY(I)=KEYU(I)
- KEY2(I)=KEYUN(I)
- ELSE
- CALL ZHTOI(KEYU(I),KEY(I),1)
- CALL ZHTOI(KEYUN(I),KEY2(I),1)
- ENDIF
- 10 CONTINUE
- ENDIF
- 15 IF(IOPTT.NE.0)THEN
- ISD(NLPAT1)=0
- NSD(NLPAT1)=IQ(KQSP+LFROM+KNSD)
- ENDIF
-*
-* Loop on all keys of level 0
-*
- DO 80 I=1,NKEYS
- LK=IQ(KQSP+LFROM+KLK)
- LKC=LK+(NWKEY+1)*(I-1)
- IF(IOPTK.EQ.0.AND.IOPTT.EQ.0)THEN
- DO 20 K=1,NWKEY
- IF(IQ(KQSP+LFROM+LKC+K).NE.KEY(K))GO TO 80
- 20 CONTINUE
- ELSE
- DO 25 K=1,NWKEY
- KEY2(K)=IQ(KQSP+LFROM+LKC+K)
- 25 CONTINUE
- ENDIF
- LCYC =IQ(KQSP+LFROM+LKC)
- IF (KVSCYC.NE.0) THEN
-* IF (IQ(KQSP+LCDIR+LCYC+KKYCYC).NE.I) THEN
- IF (IQ(KQSP+LCDIR+LCYC+KKYCYC).NE.IQ(KQSP+LFROM+LKC+1)) THEN
- IQUEST(1) = 11
- GO TO 900
- ENDIF
- ENDIF
-*
-* Store cycles in reverse order for 'C' option
-*
- IF(IOPTC.NE.0)THEN
- IF(LCORD.EQ.0)THEN
- CALL MZBOOK(JQPDVS,LCORD,LTOP,-4,'RZCO',0,0,50,2,-1)
- ENDIF
- IQ(KQSP+LCORD+1)=0
- 30 NORD=IQ(KQSP+LCORD+1)+1
- IF (KVSCYC.NE.0) THEN
- LCOLD = JBYT(IQ(KQSP+LFROM+LCYC+KPPCYC), 1,16)
- ELSE
- LCOLD = IQ(KQSP+LFROM+LCYC+KPPCYC)
- ENDIF
- IF(NORD.GT.IQ(KQSP+LCORD-1))THEN
- CALL MZPUSH(JQPDVS,LCORD,0,50,'I')
- ENDIF
- IQ(KQSP+LCORD+1)=NORD
- IQ(KQSP+LCORD+NORD+1)=LCYC
- IF(LCOLD.NE.0.AND.LCOLD.NE.LCYC)THEN
- LCYC=LCOLD
- GO TO 30
- ENDIF
- DO 40 IC=NORD,1,-1
- LCYC=IQ(KQSP+LCORD+IC+1)
- CALL RZCOP1(LUNOLD,LROLD,KEY2,IQ(KQSP+LFROM+LCYC+1))
- IF(IQUEST(1).NE.0) GO TO 900
- 40 CONTINUE
- ELSE
- 50 IF (KVSCYC.NE.0) THEN
- LCOLD = JBYT(IQ(KQSP+LFROM+LCYC+KPPCYC), 1,16)
- ELSE
- LCOLD = IQ(KQSP+LFROM+LCYC+KPPCYC)
- ENDIF
- ICY = JBYT(IQ(KQSP+LFROM+LCYC+KCNCYC),21,12)
- COPY=ICYCLE.GE.ICY.OR.(ICYCLE.LE.0.AND.LCOLD.EQ.0).OR.
- + IOPTT.NE.0.OR.IOPTK.NE.0
- IF(COPY)THEN
- CALL RZCOP1(LUNOLD,LROLD,KEY2,IQ(KQSP+LFROM+LCYC+1))
- IF(IQUEST(1).NE.0) GO TO 900
- ELSE
- IF(LCOLD.NE.0.AND.LCOLD.NE.LCYC)THEN
- LCYC=LCOLD
- GO TO 50
- ENDIF
- ENDIF
- ENDIF
- IF(IOPTK.EQ.0.AND.IOPTT.EQ.0)GO TO 900
-*
- 80 CONTINUE
-*
- 100 IF(IOPTT.EQ.0)GO TO 900
-*
-* Copy subdirectories
-*
- 110 ISD(NLPAT1)=ISD(NLPAT1)+1
- IF(ISD(NLPAT1).LE.NSD(NLPAT1))THEN
- NLPAT1=NLPAT1+1
- LSF=IQ(KQSP+LFROM+KLS)
- IH=LSF+7*(ISD(NLPAT1-1)-1)
- CALL ZITOH(IQ(KQSP+LFROM+IH),IHDIR,4)
- CALL UHTOC(IHDIR,4,CHFPAT(NLPAT1),16)
- DO 120 I=1,NLPAT1
- 120 CHPAT(I)=CHFPAT(I)
- NLPAT=NLPAT1
- CALL RZFDIR('RZCOPY',LT,LFROM,' ')
- IF(LFROM.EQ.0)THEN
- IQUEST(1)=4
- GO TO 900
- ENDIF
- NKEYS=IQ(KQSP+LFROM+KNKEYS)
- NWKEY=IQ(KQSP+LFROM+KNWKEY)
- KTAGS=KKDES+(NWKEY-1)/10+1
- DO 130 I=2,NLPAT1
- 130 CHCDIR(I)=CHFPAT(I)
- CALL RZPAFF(CHCDIR,NLPAT1-1,CHL)
- CALL RZCDIR(CHL,' ')
- CALL RZMDIR(CHFPAT(NLPAT1),NWKEY,'?',' ')
- IF(IQUEST(1).NE.0)GO TO 900
- CALL RZPAFF(CHCDIR,NLPAT1,CHL)
- CALL RZCDIR(CHL,' ')
- IF(IQ(KQSP+LCDIR-1).LT.2*NWKEY+KTAGS+20)THEN
- CALL RZEXPD('RZCOPY',100)
- IF(IQUEST(1).NE.0)GO TO 900
- ENDIF
- CALL UCOPY(IQ(KQSP+LFROM+KKDES),IQ(KQSP+LCDIR+KKDES),
- + 2*NWKEY+KTAGS-KKDES)
- CALL SBIT1(IQ(KQSP+LTOP),2)
- CALL SBIT1(IQ(KQSP+LCDIR),2)
- GO TO 15
- ELSE
- NLPAT1=NLPAT1-1
- IF(NLPAT1.GE.NLPAT0)THEN
- LUP=LQ(KQSP+LFROM+1)
- CALL MZDROP(JQPDVS,LFROM,' ')
- LFROM=LUP
- GO TO 110
- ENDIF
- ENDIF
-*
- 900 IRCOD = IQUEST(1)
- IF(LCORD.NE.0)THEN
- CALL MZDROP(JQPDVS,LCORD,' ')
- LCORD=0
- ENDIF
- IF(LRIN.NE.0)THEN
- CALL MZDROP(JQPDVS,LRIN ,' ')
- LRIN=0
- ENDIF
- CALL RZCDIR(CHWOLD,' ')
- IF(LFROM.NE.LCDIR)CALL SBIT1(IQ(KQSP+LFROM),IQDROP)
- IQUEST(1) = IRCOD
-#if defined(CERNLIB_QMVAX)
- IF(IRELAT.NE.0)UNLOCK(UNIT=LUN)
- IF(LUNOLD.NE.LUN)THEN
- IF(JBIT(IQ(KQSP+LFROM),4).NE.0)UNLOCK(UNIT=LUNOLD)
- ENDIF
-#endif
-*
- 999 RETURN
- END
diff --git a/src/packlib/zebra/rz/rzdate.F b/src/packlib/zebra/rz/rzdate.F
deleted file mode 100644
index ecaa4ee..0000000
--- a/src/packlib/zebra/rz/rzdate.F
+++ /dev/null
@@ -1,82 +0,0 @@
-*
-* $Id: rzdate.F,v 1.3 1997/08/22 08:40:50 jamie Exp $
-*
-* $Log: rzdate.F,v $
-* Revision 1.3 1997/08/22 08:40:50 jamie
-* fix rzdate for 2000-2016. Will FAIL in 2017
-*
-* Revision 1.2 1996/04/24 17:26:44 mclareni
-* Extend the include file cleanup to dzebra, rz and tq, and also add
-* dependencies in some cases.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:23 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE RZDATE(IWORD,IDATE,ITIME,ICASE)
-*
-***********************************************************************
-*
-* If ICASE=1 returns IDATE and ITIME as stored in IWORD
-* If ICASE=2 pack current time and date into IWORD
-* If ICASE=3 same as ICASE=2 but take IDATE,ITIME from
-* input parameters instead of calling DATIME
-*
-* Called by RZCOP1,RZLDIR,RZLLOK,RZLOCK,RZMAKE,RZMDIR,RZOUT,
-* RZSAVE,RZVOUT
-*
-* Author : R.Brun DD/US/PD
-* Written : 01.04.86
-* Last mod: 01.12.86
-* 22.08.97 JDS - fix for 2000-2016. RZDATE will FAIL in 2017
-*
-*
-***********************************************************************
-#include "zebra/q_jbyt.inc"
-*
- IF(ICASE.EQ.1)THEN
- ICONT = JBYT(IWORD,9,24)
- IMINUT= MOD(ICONT,60)
- IM1 = ICONT-IMINUT
- IHOUR = MOD(IM1/60,24)
- ITIME = 100*IHOUR+IMINUT
- IM2 = IM1-60*IHOUR
- IDAY = MOD(IM2/1440,31)
- IF(IDAY.EQ.0)IDAY=31
- IM3 = IM2-1440*IDAY
- IMONTH= MOD(IM3/44640,12)
- IF(IMONTH.EQ.0)IMONTH=12
- IYEAR = (IM3-44640*IMONTH)/535680
-*
-* IYEAR = 14 is the year 2000
-*
- IF(IYEAR.GE.14) THEN
- IDATE = 10000*(IYEAR-14)+100*IMONTH+IDAY
- ELSE
- IDATE = 860000+10000*IYEAR+100*IMONTH+IDAY
- ENDIF
-*
- ELSE
- IF(ICASE.NE.3)CALL DATIME(IDATE,ITIME)
-*
-* Handle dates > 2000 (IDATE=00MMDD)
-* Note: /SLATE/ is ignored. 000101 is assumed to be 1st January 2000
-*
- IF(IDATE.GE.860000) THEN
- IDAT2 = IDATE - 860000
- ELSE
- IDAT2 = IDATE + 140000
- ENDIF
-
- IYEAR = IDAT2/10000
- IMONTH= (IDAT2-10000*IYEAR)/100
- IDAY = MOD(IDAT2,100)
- IHOUR = ITIME/100
- IMINUT= MOD(ITIME,100)
- ICONT2= IDAY+31*(IMONTH+12*IYEAR)
- ICONT = IMINUT+60*(IHOUR+24*ICONT2)
- CALL SBYT(ICONT,IWORD,9,24)
- ENDIF
-*
- END
diff --git a/src/packlib/zebra/rz/rzdelk.F b/src/packlib/zebra/rz/rzdelk.F
deleted file mode 100644
index 8b55bfb..0000000
--- a/src/packlib/zebra/rz/rzdelk.F
+++ /dev/null
@@ -1,495 +0,0 @@
-*
-* $Id: rzdelk.F,v 1.2 1996/04/24 17:26:45 mclareni Exp $
-*
-* $Log: rzdelk.F,v $
-* Revision 1.2 1996/04/24 17:26:45 mclareni
-* Extend the include file cleanup to dzebra, rz and tq, and also add
-* dependencies in some cases.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:23 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE RZDELK(KEYU,ICYCLE,CHOPT)
-*
-************************************************************************
-*
-* To delete one or all keys in the CWD
-* Input:
-* KEYU Key array of dimension NWKEY (see RZMDIR)
-* ICYCLE Cycle number of the key to be deleted
-* ICYCLE > highest cycle number means delete the highest cycle
-* ICYCLE = 0 means delete the lowest cycle
-* ICYCLE = -1, -2,... means delete the highest cycle -1, -2,...
-* CHOPT Character variable specifying the options selected.
-* default
-* Delete the explicitly specified cycle ICYCLE only.
-* If cycle ICYCLE does not exist, no action is taken.
-* 'C' Delete ALL cycles corresponding to key (ICYCLE not used)
-* 'S' Delete all cycles smaller then cycle ICYCLE.
-* 'K' Delete ALL cycles for all Keys (KEYU,ICYCLE not used )
-*
-* Called by <USER>
-*
-* Author : R.Brun DD/US/PD
-* Written : 20.04.86
-* Last mod: 16.04.93 JDS. Return codes, deletion of objects at beginning
-* of cycles structure
-* : 04.03.94 S.Banerjee (Change in cycle structure)
-* : 23.03.95 J.Shiers - key # in cycles block is KEY(1)
-* IQUEST(1) = 0: ok
-* IQUEST(1) = 1: specified object not found
-* IQUEST(1) = 2: directory is empty
-* IQUEST(1) = 3: no RZ control bank (LQRS=0)
-* IQUEST(1) = 4: no write permission
-* IQUEST(1) =11: key/cycle discrepency
-*
-************************************************************************
-#include "zebra/zunit.inc"
-#include "zebra/rzcl.inc"
-#include "zebra/rzclun.inc"
-#include "zebra/rzk.inc"
-#include "zebra/rzckey.inc"
-#include "zebra/rzcycle.inc"
- CHARACTER*(*) CHOPT
- DIMENSION KEYU(*)
- DIMENSION IOPTV(3)
- EQUIVALENCE (IOPTC,IOPTV(1)), (IOPTS,IOPTV(2))
- EQUIVALENCE (IOPTK,IOPTV(3))
-*
-*-----------------------------------------------------------------------
-*
-#include "zebra/q_jbyt.inc"
-*
- IQUEST(1) = 0
- IQWARN = 0
- CALL UOPTC(CHOPT,'CSK',IOPTV)
-*
-* Check if write permission
-*
- IF(LQRS.EQ.0) THEN
- IQUEST(1) = 3
- GOTO 230
- ENDIF
-
- IFLAG=1
- CALL RZMODS('RZDELK',IFLAG)
- IF(IFLAG.NE.0) THEN
- IQUEST(1) = 4
- GOTO 230
- ENDIF
-*
- LD=IQ(KQSP+LCDIR+KLD)
- LK=IQ(KQSP+LCDIR+KLK)
- LF=IQ(KQSP+LCDIR+KLF)
- LC=IQ(KQSP+LCDIR+KLC)
- LE=IQ(KQSP+LCDIR+KLE)
- NKEYS =IQ(KQSP+LCDIR+KNKEYS)
- NWKEY =IQ(KQSP+LCDIR+KNWKEY)
- IF(NKEYS.EQ.0)GOTO 220
-*
-* Look for cycles marked for deletion by a previous call
-* Set IQUEST(2) to warn application to rebuild bit map
-*
- DO 10 LKC=LC,LE-KLCYCL+1,KLCYCL
- IF(IQ(KQSP+LCDIR+LKC).EQ.-1)GOTO 20
- 10 CONTINUE
- GOTO 30
- 20 IQWARN = 1
- 30 CONTINUE
-*
- NPUOLD=0
- IF(LPURG.NE.0)THEN
- NPURG=IQ(KQSP+LPURG+1)
- DO 40 I=1,NPURG
- NPUOLD=NPUOLD+IQ(KQSP+LPURG+2*I+1)-IQ(KQSP+LPURG+2*I)+1
- 40 CONTINUE
- ENDIF
-*
-* Option K. delete all keys
-*
- IF(IOPTK.NE.0)THEN
- DO 50 LKC=LC,LE-KLCYCL+1,KLCYCL
- IF (KVSCYC.EQ.0) THEN
- IR1 = JBYT(IQ(KQSP+LCDIR+LKC+KFRCYC),17,16)
- IP1 = JBYT(IQ(KQSP+LCDIR+LKC+KORCYC), 1,16)
- NW = JBYT(IQ(KQSP+LCDIR+LKC+KNWCYC), 1,20)
- IR2 = JBYT(IQ(KQSP+LCDIR+LKC+KSRCYC),17,16)
- ELSE
- IR1 = IQ(KQSP+LCDIR+LKC+KFRCYC)
- IP1 = JBYT(IQ(KQSP+LCDIR+LKC+KORCYC), 1,20)
- NW = IQ(KQSP+LCDIR+LKC+KNWCYC)
- IR2 = IQ(KQSP+LCDIR+LKC+KSRCYC)
- ENDIF
- NLEFT=LREC-IP1+1
- IF(NW.LE.NLEFT)THEN
- NR=0
- ELSE
- NR=(NW-NLEFT-1)/LREC+1
- ENDIF
- IF(IR2.EQ.IR1+1)THEN
- CALL RZPURF(NR+1,IR1)
- ELSE
- CALL RZPURF(1,IR1)
- IF(NR.NE.0)CALL RZPURF(NR,IR2)
- ENDIF
- 50 CONTINUE
- LF=LK
- LC=LE+1
- NRD=IQ(KQSP+LCDIR+LD)
- IQ(KQSP+LCDIR+KRUSED) =NRD
- IQ(KQSP+LCDIR+KWUSED) =NRD*LREC
- IQ(KQSP+LCDIR+KMEGA) =0
- IQ(KQSP+LCDIR+KIP1) =1
- IQ(KQSP+LCDIR+KNFREE) =LC-LF
- IQ(KQSP+LCDIR+KLF) =LF
- IQ(KQSP+LCDIR+KLC) =LC
- IQ(KQSP+LCDIR+KNKEYS) =0
- GOTO 240
- ENDIF
-*
-* Search KEY and CYCLE
-*
- DO 60 I=1,NWKEY
- IKDES=(I-1)/10
- IKBIT1=3*I-30*IKDES-2
- IF(JBYT(IQ(KQSP+LCDIR+KKDES+IKDES),IKBIT1,3).LT.3)THEN
- KEY(I)=KEYU(I)
- ELSE
- CALL ZHTOI(KEYU(I),KEY(I),1)
- ENDIF
- 60 CONTINUE
- DO 80 I=1,NKEYS
- DO 70 K=1,NWKEY
- LKC=LK+(NWKEY+1)*(I-1)
- IF(IQ(KQSP+LCDIR+LKC+K).NE.KEY(K))GOTO 80
- 70 CONTINUE
- LCYC =IQ(KQSP+LCDIR+LKC)
- LCPRE =LCYC
- LKK =LKC
- IF (KVSCYC.NE.0) THEN
-* IF (IQ(KQSP+LCDIR+LCYC+KKYCYC).NE.I) GO TO 250
- IF (IQ(KQSP+LCDIR+LCYC+KKYCYC).NE.
- + IQ(KQSP+LCDIR+LKC+1)) GO TO 250
- ENDIF
- ICTOP =JBYT(IQ(KQSP+LCDIR+LCYC+KCNCYC),21,12)
- KCYCLE=ICYCLE
- IF(KCYCLE.GT.ICTOP)KCYCLE=ICTOP
- GOTO 90
- 80 CONTINUE
- GOTO 210
-*
-* Do we keep this cycle ?
-*
- 90 IF (KVSCYC.EQ.0) THEN
- LCOLD = JBYT(IQ(KQSP+LCDIR+LCYC+KPPCYC), 1,16)
- ELSE
- LCOLD = IQ(KQSP+LCDIR+LCYC+KPPCYC)
- ENDIF
- IDEL=0
- ICY =JBYT(IQ(KQSP+LCDIR+LCYC+KCNCYC),21,12)
- IF(KCYCLE.EQ.ICY.AND.IOPTS.EQ.0)IDEL=1
- IF(IOPTC.NE.0)IDEL=1
- IF(IOPTK.NE.0)IDEL=1
- IF(IOPTS.NE.0)THEN
- IF(ICY.LT.ICYCLE)IDEL=1
- ENDIF
- IF(ICYCLE.EQ.0.AND.LCOLD.EQ.0)IDEL=1
- IF(ICYCLE.LT.0)THEN
- IF(ICY.EQ.ICTOP-ICYCLE)IDEL=1
- ENDIF
-*
-* Mark all records that can be purged in first pass
-*
- IF(IDEL.NE.0)THEN
- IF(ICY.EQ.ICTOP)THEN
- IQ(KQSP+LCDIR+LKK)=LCOLD
- ELSE
- IF(LCOLD.EQ.0.AND.IOPTC.NE.0)THEN
- IQ(KQSP+LCDIR+LKK)=0
- IQ(KQSP+LCDIR+LCPRE)=-1
- ELSE
- CALL SBYT(LCOLD,IQ(KQSP+LCDIR+LCPRE),1,16)
- ENDIF
- ENDIF
- IF (KVSCYC.EQ.0) THEN
- IR1 = JBYT(IQ(KQSP+LCDIR+LCYC+KFRCYC),17,16)
- IP1 = JBYT(IQ(KQSP+LCDIR+LCYC+KORCYC), 1,16)
- NW = JBYT(IQ(KQSP+LCDIR+LCYC+KNWCYC), 1,20)
- IR2 = JBYT(IQ(KQSP+LCDIR+LCYC+KSRCYC),17,16)
- ELSE
- IR1 = IQ(KQSP+LCDIR+LCYC+KFRCYC)
- IP1 = JBYT(IQ(KQSP+LCDIR+LCYC+KORCYC), 1,20)
- NW = IQ(KQSP+LCDIR+LCYC+KNWCYC)
- IR2 = IQ(KQSP+LCDIR+LCYC+KSRCYC)
- ENDIF
- IRL =0
- NWL =0
- NLEFT=LREC-IP1+1
- NW1=NW
- IF(NW1.GE.NLEFT)NW1=NLEFT
- IF(IR2.NE.0)THEN
- NR=(NW-NW1-1)/LREC+1
- IF(NR.GT.1) CALL RZPURF(NR-1,IR2)
- IRL=IR2+NR-1
- NWL=NW-NW1-(NR-1)*LREC
- ENDIF
- IF(NW1.EQ.LREC)THEN
- CALL RZPURF(1,IR1)
- IR1=0
- ENDIF
- IF(NWL.EQ.LREC)THEN
- CALL RZPURF(1,IRL)
- IRL=0
- ENDIF
- IRLOUT=IQ(KQSP+LCDIR+KRLOUT)
- IF(IRL.EQ.IRLOUT.AND.NWL+1.EQ.IQ(KQSP+LCDIR+KIP1))THEN
- CALL RZPURF(1,IRL)
- IRL=0
- ENDIF
- IQ(KQSP+LCDIR+LCYC)=-1
- IQ(KQSP+LCDIR+LCYC+1)=IR1
- IQ(KQSP+LCDIR+LCYC+2)=IRL
- IQ(KQSP+LCDIR+LCYC+3)=NWL
- IF(IR1.NE.0)CALL SBYT(NW1,IQ(KQSP+LCDIR+LCYC+3),21,12)
- ELSE
- LCPRE=LCYC
- ENDIF
-*
- IF(LCOLD.NE.0.AND.LCOLD.NE.LCYC)THEN
- IF(KCYCLE.LT.ICY.OR.IOPTS.NE.0.OR.IOPTK.NE.0.OR.IOPTC.NE.0)THEN
- LCYC=LCOLD
- GOTO 90
- ENDIF
- ENDIF
-*
-* Now loop on all purged cycles to find complete records
-* purged
-*
- DO 130 LKC=LC,LE-KLCYCL+1,KLCYCL
- IF(IQ(KQSP+LCDIR+LKC).NE.-1)GOTO 130
- IR1=IQ(KQSP+LCDIR+LKC+1)
- IRL=IQ(KQSP+LCDIR+LKC+2)
- IF(IR1.NE.0)THEN
- DO 100 LKC1=LC,LE-KLCYCL+1,KLCYCL
- IF(IQ(KQSP+LCDIR+LKC1).EQ.-1)GOTO 100
- IF (KVSCYC.EQ.0) THEN
- KR1 = JBYT(IQ(KQSP+LCDIR+LKC1+KFRCYC),17,16)
- KP1 = JBYT(IQ(KQSP+LCDIR+LKC1+KORCYC), 1,16)
- NW = JBYT(IQ(KQSP+LCDIR+LKC1+KNWCYC), 1,20)
- KR2 = JBYT(IQ(KQSP+LCDIR+LKC1+KSRCYC),17,16)
- ELSE
- KR1 = IQ(KQSP+LCDIR+LKC1+KFRCYC)
- KP1 = JBYT(IQ(KQSP+LCDIR+LKC1+KORCYC), 1,20)
- NW = IQ(KQSP+LCDIR+LKC1+KNWCYC)
- KR2 = IQ(KQSP+LCDIR+LKC1+KSRCYC)
- ENDIF
- KRL =0
- NLEFT=LREC-KP1+1
- NW1=NW
- IF(NW1.GE.NLEFT)NW1=NLEFT
- IF(KR2.NE.0)THEN
- NR=(NW-NW1-1)/LREC+1
- KRL=KR2+NR-1
- ENDIF
- IF(KR1.EQ.IR1.OR.KRL.EQ.IR1)GOTO 110
- 100 CONTINUE
- CALL RZPURF(1,IR1)
- ENDIF
-*
- 110 IF(IRL.NE.0)THEN
- DO 120 LKC1=LC,LE-KLCYCL+1,KLCYCL
- IF(IQ(KQSP+LCDIR+LKC1).EQ.-1)GOTO 120
- IF (KVSCYC.EQ.0) THEN
- KR1 = JBYT(IQ(KQSP+LCDIR+LKC1+KFRCYC),17,16)
- KP1 = JBYT(IQ(KQSP+LCDIR+LKC1+KORCYC), 1,16)
- NW = JBYT(IQ(KQSP+LCDIR+LKC1+KNWCYC), 1,20)
- KR2 = JBYT(IQ(KQSP+LCDIR+LKC1+KSRCYC),17,16)
- ELSE
- KR1 = IQ(KQSP+LCDIR+LKC1+KFRCYC)
- KP1 = JBYT(IQ(KQSP+LCDIR+LKC1+KORCYC), 1,20)
- NW = IQ(KQSP+LCDIR+LKC1+KNWCYC)
- KR2 = IQ(KQSP+LCDIR+LKC1+KSRCYC)
- ENDIF
- KRL =0
- NLEFT=LREC-KP1+1
- NW1=NW
- IF(NW1.GE.NLEFT)NW1=NLEFT
- IF(KR2.NE.0)THEN
- NR=(NW-NW1-1)/LREC+1
- KRL=KR2+NR-1
- ENDIF
- IF(KR1.EQ.IRL.OR.KRL.EQ.IRL)GOTO 130
- 120 CONTINUE
- CALL RZPURF(1,IRL)
- ENDIF
- 130 CONTINUE
-*
-* Garbage collection on cycles area + relocation
-*
- LKC3=LE-KLCYCL+1
- 140 IF(LKC3.LT.LC)GOTO 190
-*
-* Found a deleted object. Now look for previous undeleted object
-*
- IF(IQ(KQSP+LCDIR+LKC3).EQ.-1)THEN
-
- LKC3=LKC3+KLCYCL
- LKC2=LKC3-2*KLCYCL
-*
-* First object?
-*
- IF(LKC2.LT.LC) THEN
- LC = LKC3
- GOTO 190
- ENDIF
-
- 150 IF(IQ(KQSP+LCDIR+LKC2).NE.-1)THEN
- LKC2=LKC2+KLCYCL
- LKC1=LKC2-2*KLCYCL
- IF(LKC1.LT.LC)LKC1=LC
- 160 IF(IQ(KQSP+LCDIR+LKC1).EQ.-1)THEN
- IF(LKC1.GT.LC .OR.
- + (LKC1.EQ.LC.AND.LKC2.NE.LC))LKC1=LKC1+KLCYCL
- ELSE
- IF(LKC1.GT.LC)THEN
- LKC1=LKC1-KLCYCL
- GOTO 160
- ENDIF
- ENDIF
-*
- NPUSH=LKC3-LKC2
-*
-* Update pointers in cycles block
-*
- DO 170 LKC=LC,LKC2-KLCYCL,KLCYCL
- IF(IQ(KQSP+LCDIR+LKC).NE.-1)THEN
- IF (KVSCYC.EQ.0) THEN
- LCOLD = JBYT(IQ(KQSP+LCDIR+LKC+KPPCYC),1,16)
- ELSE
- LCOLD = IQ(KQSP+LCDIR+LKC+KPPCYC)
- ENDIF
- IF(LCOLD.GE.LKC1.AND.LCOLD.LT.LKC2)THEN
- LCOLD=LCOLD+NPUSH
- IF (KVSCYC.EQ.0) THEN
- CALL SBYT(LCOLD,IQ(KQSP+LCDIR+LKC+KPPCYC),1,16)
- ELSE
- IQ(KQSP+LCDIR+LKC+KPPCYC) = LCOLD
- ENDIF
- ENDIF
- ENDIF
- 170 CONTINUE
-*
-* Update pointers from KEYS block to CYCLES block
-*
- DO 180 IK=1,NKEYS
- LCYC=IQ(KQSP+LCDIR+LK+(NWKEY+1)*(IK-1))
- IF(LCYC.GE.LKC1.AND.LCYC.LT.LKC2)THEN
- IQ(KQSP+LCDIR+LK+(NWKEY+1)*(IK-1))=
- + IQ(KQSP+LCDIR+LK+(NWKEY+1)*(IK-1))+NPUSH
- ENDIF
- 180 CONTINUE
-*
-* Squeeze out deleted cycles
-*
- CALL UCOPY2(IQ(KQSP+LCDIR+LKC1),IQ(KQSP+LCDIR+LKC1+NPUSH),
- + LKC2-LKC1)
- LKC3=LKC1+NPUSH
- LKC2=LKC1-KLCYCL
-*
-* Only deleted objects before this block?
-*
- IF(IQ(KQSP+LCDIR+LKC2).EQ.-1.AND.LKC2.EQ.LC) THEN
- LC = LKC3
- GOTO 190
- ENDIF
-
- IF(LKC1.NE.LC)GOTO 150
- LC=LC+NPUSH
- GOTO 190
-*
- ELSE
- LKC2=LKC2-KLCYCL
-*
-* Only deleted objects before this block?
-*
- IF(IQ(KQSP+LCDIR+LKC2).EQ.-1.AND.LKC2.EQ.LC) THEN
- LC = LKC3
- GOTO 190
- ENDIF
-
- IF(LKC2.GE.LC)GOTO 150
-
- ENDIF
- ELSE
- LKC3=LKC3-KLCYCL
- GOTO 140
- ENDIF
-*
-* Remove KEY from K area if only one cycle
-*
- 190 CONTINUE
- IF(IQ(KQSP+LCDIR+LKK).EQ.0)THEN
- IF(LKK+NWKEY+1.LT.LF)THEN
- CALL UCOPY2(IQ(KQSP+LCDIR+LKK+NWKEY+1),
- + IQ(KQSP+LCDIR+LKK),LF-LKK)
- ENDIF
- LF=LF-NWKEY-1
- IQ(KQSP+LCDIR+KNFREE)=IQ(KQSP+LCDIR+KNFREE)+NWKEY+1
- IQ(KQSP+LCDIR+KLF)=LF
- IQ(KQSP+LCDIR+KNKEYS)=IQ(KQSP+LCDIR+KNKEYS)-1
- IF(IQ(KQSP+LCDIR+KNKEYS).EQ.0)LC=LE+1
- ENDIF
-*
-* Reset internal pointers
-*
- NPUNEW=0
- IF(LPURG.NE.0)THEN
- NPURG=IQ(KQSP+LPURG+1)
- DO 200 I=1,NPURG
- NPUNEW=NPUNEW+IQ(KQSP+LPURG+2*I+1)-IQ(KQSP+LPURG+2*I)+1
- 200 CONTINUE
- ENDIF
- NPU=NPUNEW-NPUOLD
- IQUEST( 9)=IQ(KQSP+LCDIR+KQUOTA)-IQ(KQSP+LCDIR+KRUSED)+NPU
- IQUEST(11)=(LC-IQ(KQSP+LCDIR+KLC))/KLCYCL
- IQUEST(12)=NPU*LREC
- IQUEST(13)=NPU
-*
- IQ(KQSP+LCDIR+KRUSED)=IQ(KQSP+LCDIR+KRUSED)-NPU
- NWP=NPU*LREC
- NMEGA=NWP/1000000
- IQ(KQSP+LCDIR+KMEGA)=IQ(KQSP+LCDIR+KMEGA)-NMEGA
- NWP=NWP-1000000*NMEGA
- IQ(KQSP+LCDIR+KWUSED)=IQ(KQSP+LCDIR+KWUSED)-NWP
- IQ(KQSP+LCDIR+KNFREE)=IQ(KQSP+LCDIR+KNFREE)+LC-IQ(KQSP+LCDIR+KLC)
- IQ(KQSP+LCDIR+KLC)=LC
- GOTO 240
-*
-* KEY not found
-*
- 210 IF(JBYT(IQ(KQSP+LTOP),15,3)-3.GE.-2) WRITE(IQLOG,10000)
-10000 FORMAT(' RZDELK. Key not found')
- IQUEST(1)=1
- IQUEST(2)=IQWARN
- RETURN
-
- 220 IF(JBYT(IQ(KQSP+LTOP),15,3)-3.GE.-2) WRITE(IQLOG,10100)
-10100 FORMAT(' RZDELK. directory is empty')
- IQUEST(1)=2
- IQUEST(2)=IQWARN
- RETURN
-*
- 230 IQUEST(2)=IQWARN
- RETURN
-
- 240 IQUEST(2)=IQWARN
- RETURN
-
- 250 IF(JBYT(IQ(KQSP+LTOP),15,3)-3.GE.-2) WRITE(IQLOG,10100)
-10200 FORMAT(' RZDELK. mismatch in key/cycle pointing')
- IQUEST(1)=11
- IQUEST(2)=IQWARN
- RETURN
- END
diff --git a/src/packlib/zebra/rz/rzdelt.F b/src/packlib/zebra/rz/rzdelt.F
deleted file mode 100644
index db145cf..0000000
--- a/src/packlib/zebra/rz/rzdelt.F
+++ /dev/null
@@ -1,204 +0,0 @@
-*
-* $Id: rzdelt.F,v 1.2 1996/04/24 17:26:46 mclareni Exp $
-*
-* $Log: rzdelt.F,v $
-* Revision 1.2 1996/04/24 17:26:46 mclareni
-* Extend the include file cleanup to dzebra, rz and tq, and also add
-* dependencies in some cases.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:23 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE RZDELT(CHDIR)
-*
-************************************************************************
-*
-* To delete the tree CHDIR in the CWD
-* Input:
-* CHDIR Character variable specifying the directory name of the
-* subtree of the CWD.
-* ' ' means delete the complete CWD tree
-*
-* Called by <USER>
-*
-* Author : R.Brun DD/US/PD
-* Written : 22.04.86
-* LAST MOD: 09.01.91
-* : 04.03.94 S.Banerjee (Change in cycle structure)
-*
-************************************************************************
-#include "zebra/zunit.inc"
-#include "zebra/rzcl.inc"
-#include "zebra/rzclun.inc"
-#include "zebra/rzk.inc"
-#include "zebra/rzdir.inc"
-#include "zebra/rzcycle.inc"
- CHARACTER*(*) CHDIR
- DIMENSION IHDIR(4),ISD(NLPATM),IRD(NLPATM),NSD(NLPATM)
- LOGICAL RZSAME
-*
-*-----------------------------------------------------------------------
-*
-#include "zebra/q_jbyt.inc"
- IQUEST(1)=0
- IF(LQRS.EQ.0)GO TO 99
- NCD=LEN(CHDIR)
- IF(NCD.GT.16)NCD=16
- CALL VBLANK(IHDIR,4)
- CALL UCTOH(CHDIR,IHDIR,4,NCD)
- CALL ZHTOI(IHDIR,IHDIR,4)
-*
- LS = IQ(KQSP+LCDIR+KLS)
- LK = IQ(KQSP+LCDIR+KLK)
- LF = IQ(KQSP+LCDIR+KLF)
-*
-* Check permission
-*
- IFLAG=1
- CALL RZMODS('RZDELT',IFLAG)
- IF(IFLAG.NE.0)GO TO 99
-*
-* Check if subdirectory exists
-*
- NSDIR=IQ(KQSP+LCDIR+KNSD)
- IF(NSDIR.GT.0)THEN
- LRZ=LQ(KQSP+LCDIR-1)
- DO 20 I=1,NSDIR
- IF(RZSAME(IHDIR,IQ(KQSP+LCDIR+LS+7*(I-1)),4))THEN
- IOLD=LS+7*(I-1)
- IF (KVSCYC.EQ.0) THEN
- IR1 = JBYT(IQ(KQSP+LCDIR+IOLD+5),1,18)
- ELSE
- IR1 = IQ(KQSP+LCDIR+IOLD+5)
- ENDIF
- GO TO 25
- ENDIF
- 20 CONTINUE
- ENDIF
- IF(JBYT(IQ(KQSP+LTOP),15,3)-3.GE.-2) WRITE(IQLOG,1000)CHDIR
- 1000 FORMAT(' RZDELT. Non existing directory, ',A)
- IQUEST(1)=1
- GO TO 99
-*
-* If directory to be deleted is in memory, then
-* delete the corresponding tree
-*
- 25 IF(LRZ.NE.0)THEN
- IF(.NOT.RZSAME(IHDIR,IQ(KQSP+LRZ+1),4))THEN
- LRZ=LQ(KQSP+LRZ)
- GO TO 25
- ELSE
- CALL MZDROP(JQPDVS,LRZ,' ')
- ENDIF
- ENDIF
-*
-* Remove directory name from D
-* Move K
-*
- NWFREE=IQ(KQSP+LCDIR+KNFREE)+7
- CALL UCOPY2(IQ(KQSP+LCDIR+IOLD+7),IQ(KQSP+LCDIR+IOLD),LF-IOLD-7)
- LK=LK-7
- LF=LF-7
- NSDIR=NSDIR-1
- IQ(KQSP+LCDIR+KNFREE)=NWFREE
- IQ(KQSP+LCDIR+KNSD)=NSDIR
- IQ(KQSP+LCDIR+KLK)=LK
- IQ(KQSP+LCDIR+KLF)=LF
-*
-* LRIN will be used as delete buffer.
-* Make sure it exists.
-*
- IF(LRIN.EQ.0)THEN
- CALL MZBOOK(JQPDVS,LRIN,LTOP,-7,'RZIN',0,0,LREC+1,2,-1)
- ENDIF
- IQ(KQSP+LTOP+KIRIN)=0
-*
- CALL VZERO(ISD(2),19)
- NLEVEL=1
- ISD(1)=1
- IRD(1)=IR1
- NSD(1)=1
-*
-* Read directory into buffer
-*
- 30 CALL RZIODO(LUN,LREC,IRD(NLEVEL),IQ(KQSP+LRIN+1),1)
- IF(IQUEST(1).NE.0)GO TO 90
- NSD(NLEVEL+1)=IQ(KQSP+LRIN+23)
- LDC=IQ(KQSP+LRIN+KLD)
- LCC=IQ(KQSP+LRIN+KLC)
- LEC=IQ(KQSP+LRIN+KLE)
- NRD=IQ(KQSP+LRIN+LDC)
- NPUSH=NRD*LREC-IQ(KQSP+LRIN-1)
- IF(NPUSH.GT.0)CALL MZPUSH(JQPDVS,LRIN,0,NPUSH,'I')
- IF(NRD.GT.1)THEN
- DO 40 I=1,NRD
- L1=KQSP+LRIN+(I-1)*LREC+1
- CALL RZIODO(LUN,LREC,IQ(KQSP+LRIN+LDC+I),IQ(L1),1)
- IF(IQUEST(1).NE.0)GO TO 90
- 40 CONTINUE
- ENDIF
-*
-* Delete all KEYS for this directory
-*
- DO 50 LKC=LCC,LEC-KLCYCL+1,KLCYCL
- IF (KVSCYC.EQ.0) THEN
- IR1 = JBYT(IQ(KQSP+LRIN+LKC+KFRCYC),17,16)
- IP1 = JBYT(IQ(KQSP+LRIN+LKC+KORCYC), 1,16)
- NW = JBYT(IQ(KQSP+LRIN+LKC+KNWCYC), 1,20)
- IR2 = JBYT(IQ(KQSP+LRIN+LKC+KSRCYC),17,16)
- ELSE
- IR1 = IQ(KQSP+LRIN+LKC+KFRCYC)
- IP1 = JBYT(IQ(KQSP+LRIN+LKC+KORCYC), 1,20)
- NW = IQ(KQSP+LRIN+LKC+KNWCYC)
- IR2 = IQ(KQSP+LRIN+LKC+KSRCYC)
- ENDIF
- NLEFT=LREC-IP1+1
- IF(NW.LE.NLEFT)THEN
- NR=0
- ELSE
- NR=(NW-NLEFT-1)/LREC+1
- ENDIF
- IF(IR2.EQ.IR1+1)THEN
- CALL RZPURF(NR+1,IR1)
- ELSE
- CALL RZPURF(1,IR1)
- IF(NR.NE.0)CALL RZPURF(NR,IR2)
- ENDIF
- 50 CONTINUE
- DO 60 I=1,NRD
- CALL RZPURF(1,IQ(KQSP+LRIN+LDC+I))
- 60 CONTINUE
-*
-* Now look levels down
-*
- NLEVEL=NLEVEL+1
- 70 ISD(NLEVEL)=ISD(NLEVEL)+1
- IF(ISD(NLEVEL).LE.NSD(NLEVEL))THEN
- IS=ISD(NLEVEL)
- LSC=IQ(KQSP+LRIN+KLS)
- IF (KVSCYC.EQ.0) THEN
- IRD(NLEVEL) = JBYT(IQ(KQSP+LRIN+LSC+7*(IS-1)+5),1,18)
- ELSE
- IRD(NLEVEL) = IQ(KQSP+LRIN+LSC+7*(IS-1)+5)
- ENDIF
- GO TO 30
- ELSE
- ISD(NLEVEL)=0
- NLEVEL=NLEVEL-1
- IF(NLEVEL.GT.1)THEN
- CALL RZIODO(LUN,LREC,IRD(NLEVEL-1),IQ(KQSP+LRIN+1),1)
- IF(IQUEST(1).NE.0)GO TO 90
- GO TO 70
- ENDIF
- ENDIF
-*
- 90 CALL MZDROP(JQPDVS,LRIN,' ')
- LRIN=0
-#if defined(CERNLIB_QMVAX)
- IF(IRELAT.NE.0)UNLOCK(UNIT=LUN)
-#endif
-*
- 99 RETURN
- END
diff --git a/src/packlib/zebra/rz/rzdlok.F b/src/packlib/zebra/rz/rzdlok.F
deleted file mode 100644
index d1513de..0000000
--- a/src/packlib/zebra/rz/rzdlok.F
+++ /dev/null
@@ -1,51 +0,0 @@
-*
-* $Id: rzdlok.F,v 1.1.1.1 1996/03/06 10:47:23 mclareni Exp $
-*
-* $Log: rzdlok.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:23 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE RZDLOK
-*
-************************************************************************
-*
-* To reset the LOCKing word in first record.
-* This is usefull, in case a previous job could not finish
-* in a clean way (time limit, system crash,CRTL/Y,etc
-*
-* Called by <USER>,RZFILE
-*
-* Author : R.Brun DD/US/PD
-* Written : 03.10.86
-* Last mod: 02.04.90
-*
-************************************************************************
-#include "zebra/rzcl.inc"
-#include "zebra/rzclun.inc"
-#include "zebra/rzk.inc"
-*
-*-----------------------------------------------------------------------
-*
- IQUEST(1)=0
- IF(LQRS.EQ.0)GO TO 99
- IF(LTOP.EQ.0)GO TO 99
-*
- IF(LRIN.EQ.0)THEN
- CALL MZBOOK(JQPDVS,LRIN,LTOP,-7,'RZIN',0,0,LREC+1,2,-1)
- IQ(KQSP+LRIN-5)=IQ(KQSP+LTOP-5)
- ENDIF
- NWL =50
- 10 CALL RZIODO(LUN,NWL,1,IQ(KQSP+LRIN+1),1)
- IF(IQ(KQSP+LRIN+2).GT.NWL.AND.IQUEST(1).EQ.0)THEN
- NWL=IQ(KQSP+LRIN+2)
- GO TO 10
- ENDIF
- NWL=IQ(KQSP+LRIN+2)
- IF(LCDIR.NE.0)IQ(KQSP+LTOP+KIRIN)=0
- IQ(KQSP+LRIN+3)=0
- CALL RZIODO(LUN,MAX(NWL,50),1,IQ(KQSP+LRIN+1),2)
-*
- 99 RETURN
- END
diff --git a/src/packlib/zebra/rz/rzend.F b/src/packlib/zebra/rz/rzend.F
deleted file mode 100644
index a6e4652..0000000
--- a/src/packlib/zebra/rz/rzend.F
+++ /dev/null
@@ -1,89 +0,0 @@
-*
-* $Id: rzend.F,v 1.2 1996/04/24 17:26:47 mclareni Exp $
-*
-* $Log: rzend.F,v $
-* Revision 1.2 1996/04/24 17:26:47 mclareni
-* Extend the include file cleanup to dzebra, rz and tq, and also add
-* dependencies in some cases.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:23 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE RZEND(CHDIR)
-*
-************************************************************************
-*
-* To close all transactions with file CHDIR.
-* Corresponding directories are dropped
-* Input:
-* CHDIR Character variable specifying the name of the top directory
-* to be associated with unit LUN.
-*
-* Called by <USER>
-*
-* Author : R.Brun DD/US/PD
-* Written : 01.04.86
-* Last mod: 07.12.92 Loglevel manipulation
-*
-************************************************************************
-#include "zebra/zunit.inc"
-#include "zebra/zstate.inc"
-#include "zebra/rzcl.inc"
- CHARACTER CHDIR*(*)
- DIMENSION IHDIR(4)
- LOGICAL RZSAME
-*
-*-----------------------------------------------------------------------
-*
-#include "zebra/q_jbit.inc"
-#include "zebra/q_jbyt.inc"
-
- IQUEST(1)=0
- IF(LQRS.EQ.0)GO TO 99
-*
-* Save current directory
-*
- CALL RZSAVE
-*
- NCHD=LEN(CHDIR)
- IF(NCHD.GT.16)NCHD=16
- CALL VBLANK(IHDIR,4)
- CALL UCTOH(CHDIR,IHDIR,4,NCHD)
- CALL ZHTOI(IHDIR,IHDIR,4)
-*
- LRZ=LQRS
- 10 IF(LRZ.NE.0)THEN
- IF(.NOT.RZSAME(IHDIR,IQ(KQSP+LRZ+1),4))THEN
- LRZ=LQ(KQSP+LRZ)
- GO TO 10
- ENDIF
-*
- LTOP=LRZ
- LOGLV = JBYT(IQ(KQSP+LTOP),15,3)-3
- IF(LOGLV.GE.0) WRITE(IQLOG,9019) CHDIR
- 9019 FORMAT(' RZEND. called for ',A)
-*
-* Release lock if update mode
-*
- IF(JBIT(IQ(KQSP+LTOP),3).NE.0)THEN
- LCDIR=LTOP
- CALL RZFREE('RZFILE')
- ENDIF
-*
-* Drop control bank
-*
- CALL MZDROP(JQPDVS,LTOP,' ')
- LTOP = 0
- LCDIR= 0
-*
-* Error
-*
- ELSEIF(NQLOGD.GE.-2)THEN
- WRITE(IQLOG,1000) CHDIR
- 1000 FORMAT(' RZEND. Unknown directory ',A)
- ENDIF
-*
- 99 RETURN
- END
diff --git a/src/packlib/zebra/rz/rzexpd.F b/src/packlib/zebra/rz/rzexpd.F
deleted file mode 100644
index 98c4f06..0000000
--- a/src/packlib/zebra/rz/rzexpd.F
+++ /dev/null
@@ -1,107 +0,0 @@
-*
-* $Id: rzexpd.F,v 1.2 1996/04/24 17:26:48 mclareni Exp $
-*
-* $Log: rzexpd.F,v $
-* Revision 1.2 1996/04/24 17:26:48 mclareni
-* Extend the include file cleanup to dzebra, rz and tq, and also add
-* dependencies in some cases.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:23 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE RZEXPD(CHROUT,NMORE)
-*
-************************************************************************
-*
-* Routine to expand one directory by NMORE words
-*
-* Called by RZCOP1,RZMDIR,RZOUT,RZQUOT,RZVOUT
-*
-* Author : R.Brun DD/US/PD
-* Written : 05.04.86
-* Last mod: 18.06.92 - bug fix for the case when >1 record is allocated
-* : 04.03.94 S.Banerjee (Change in cycle structure)
-*
-************************************************************************
-#include "zebra/rzcl.inc"
-#include "zebra/rzclun.inc"
-#include "zebra/rzk.inc"
-#include "zebra/rzcycle.inc"
- CHARACTER*6 CHROUT
-*
-*-----------------------------------------------------------------------
-*
-#include "zebra/q_jbyt.inc"
-*
- LD = IQ(KQSP+LCDIR+KLD)
- LB = IQ(KQSP+LCDIR+KLB)
- LS = IQ(KQSP+LCDIR+KLS)
- LK = IQ(KQSP+LCDIR+KLK)
- LF = IQ(KQSP+LCDIR+KLF)
- LC = IQ(KQSP+LCDIR+KLC)
- LE = IQ(KQSP+LCDIR+KLE)
- NPR= (NMORE-1)/LREC +1
- NPUSH=NPR*LREC
- CALL RZALLO(CHROUT,NPR,IALLOC)
- IF(IALLOC.EQ.0) GO TO 99
- CALL MZPUSH(JQPDVS,LCDIR,0,NPUSH,' ')
- NWFREE=IQ(KQSP+LCDIR+KNFREE)+NPUSH-NPR
- IQ(KQSP+LCDIR+KNFREE)=NWFREE
-*
-* Move cycles
-*
- IF(LC.LT.LE)THEN
- NKEYS=IQ(KQSP+LCDIR+KNKEYS)
- NWKEY=IQ(KQSP+LCDIR+KNWKEY)
- DO 20 I=1,NKEYS
- LKC=LK+(NWKEY+1)*(I-1)
- IQ(KQSP+LCDIR+LKC)=IQ(KQSP+LCDIR+LKC)+NPUSH
- 20 CONTINUE
- DO 30 LKC=LC,LE-KLCYCL+1,KLCYCL
- IF (KVSCYC.EQ.0) THEN
- LCOLD = JBYT(IQ(KQSP+LCDIR+LKC+KPPCYC),1,16)
- ELSE
- LCOLD = IQ(KQSP+LCDIR+LKC+KPPCYC)
- ENDIF
- IF(LCOLD.NE.0)THEN
- LCOLD=LCOLD+NPUSH
- IF (KVSCYC.EQ.0) THEN
- CALL SBYT(LCOLD,IQ(KQSP+LCDIR+LKC+KPPCYC),1,16)
- ELSE
- IQ(KQSP+LCDIR+LKC+KPPCYC) = LCOLD
- ENDIF
- ENDIF
- 30 CONTINUE
- CALL UCOPY2(IQ(KQSP+LCDIR+LC),
- + IQ(KQSP+LCDIR+LC+NPUSH),LE-LC+1)
- ENDIF
- LC=LC+NPUSH
- LE=LE+NPUSH
-*
-* Insert new record in the list of records for the CWD
-* Move B S and K blocks
-*
- CALL UCOPY2(IQ(KQSP+LCDIR+LB),IQ(KQSP+LCDIR+LB+NPR),LF-LB)
- LB=LB+NPR
- LS=LS+NPR
- LK=LK+NPR
- LF=LF+NPR
- NRD=IQ(KQSP+LCDIR+LD)
- IQ(KQSP+LCDIR+LD)=NRD+NPR
- DO 40 I=1,NPR
- IQ(KQSP+LCDIR+LD+NRD+I)=IALLOC+I-1
- 40 CONTINUE
- IQ(KQSP+LCDIR+KRUSED)=IQ(KQSP+LCDIR+KRUSED)+NPR
- IQ(KQSP+LCDIR+KWUSED)=IQ(KQSP+LCDIR+KWUSED)+NPUSH
- CALL RZUSED(NPR,IALLOC)
- IQ(KQSP+LCDIR+KLB)=LB
- IQ(KQSP+LCDIR+KLS)=LS
- IQ(KQSP+LCDIR+KLK)=LK
- IQ(KQSP+LCDIR+KLF)=LF
- IQ(KQSP+LCDIR+KLC)=LC
- IQ(KQSP+LCDIR+KLE)=LE
-*
- 99 RETURN
- END
diff --git a/src/packlib/zebra/rz/rzfdir.F b/src/packlib/zebra/rz/rzfdir.F
deleted file mode 100644
index 7d96f0b..0000000
--- a/src/packlib/zebra/rz/rzfdir.F
+++ /dev/null
@@ -1,204 +0,0 @@
-*
-* $Id: rzfdir.F,v 1.3 1997/05/14 08:33:37 couet Exp $
-*
-* $Log: rzfdir.F,v $
-* Revision 1.3 1997/05/14 08:33:37 couet
-* - Bug fixed by S.O'Neale. atlas problems with cernlib 97a, with rfio/cio
-* the record was not correct in rziodo. Now rzfdir.F rest the correct one.
-*
-* Revision 1.2 1996/04/24 17:26:48 mclareni
-* Extend the include file cleanup to dzebra, rz and tq, and also add
-* dependencies in some cases.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:22 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE RZFDIR(CHROUT,LT,LDIR,CHOPT)
-*
-************************************************************************
-*
-* Check if Pathname stored in CHPAT is a valid directory
-* If YES then LT points to the TOP directory
-* LDIR points to the directory
-*
-* Called by RZCDIR,RZCOPY
-*
-* Author : R.Brun DD/US/PD
-* Written : 03.04.86
-* Last mod: 13.05.97 S.O'Neale Store IZRECL, bug fixes for messages
-* : 02.06.93 JDS. Bug fix in 'unknown directory' warning
-* : 04.03.94 S.Banerjee (Change in cycle structure)
-*
-************************************************************************
-#include "zebra/zunit.inc"
-#include "zebra/rzcl.inc"
-#include "zebra/rzdir.inc"
-#include "zebra/rzch.inc"
-#include "zebra/rzk.inc"
-#include "zebra/rzcycle.inc"
-#include "zebra/rzclun.inc"
- CHARACTER*(*) CHROUT
- CHARACTER*(*) CHOPT
- DIMENSION IHDIR(4)
- LOGICAL RZSAME
- INTEGER FQUOTA
-*
-*-----------------------------------------------------------------------
-*
-#include "zebra/q_jbit.inc"
-#include "zebra/q_jbyt.inc"
-
- IOPTQ = INDEX(CHOPT,'Q')
- LT=0
- LDIR=0
- IF(LQRS.EQ.0) GOTO 110
- IF(NLPAT.LE.0)THEN
- CHL='??? '
- GOTO 90
- ENDIF
-*
-* Find LT
-*
- CALL VBLANK(IHDIR,4)
- CALL UCTOH(CHPAT(1),IHDIR,4,16)
- CALL ZHTOI(IHDIR,IHDIR,4)
- LRZ=LQRS
- 10 IF(.NOT.RZSAME(IHDIR,IQ(KQSP+LRZ+1),4))THEN
- LRZ = LQ(KQSP+LRZ)
- IF(LRZ.GT.0)GOTO 10
- GOTO 80
- ENDIF
- LTEMP = LRZ
- LT = LRZ
- LDIR = LRZ
- CALL RZVCYC(LT)
- IF(NLPAT.LT.2)GOTO 110
- LBT = IQ(KQSP+LRZ+KLB)
- LREF = IQ(KQSP+LRZ+LBT+1)
- LUNF = IQ(KQSP+LRZ-5)
- FQUOTA = IQ(KQSP+LRZ+KQUOTA)
- LOGLV = JBYT(IQ(KQSP+LT),15,3)-3
- IZRECL = IQ(KQSP+LT+LBT+1) ! SWON: Needed by CFSEEK in RZIODO
- IMODEX = JBIT(IQ(KQSP+LT+KPW1+2),12)
- IMODEC = JBIT(IQ(KQSP+LT),5)
- IMODEH = JBIT(IQ(KQSP+LT),6)
-*
-* Search levels down
-*
- DO 60 IL=2,NLPAT
- CALL VBLANK(IHDIR,4)
- CALL UCTOH(CHPAT(IL),IHDIR,4,16)
- CALL ZHTOI(IHDIR,IHDIR,4)
- CALL SBIT0(IQ(KQSP+LRZ),IQDROP)
- NSDIR=IQ(KQSP+LRZ+KNSD)
- LS =IQ(KQSP+LRZ+KLS)
- IF(NSDIR.LE.0)GOTO 80
-*
-* Check if element in list of subdirectories
-*
- DO 50 I=1,NSDIR
- IH=LS+7*(I-1)
- IF(RZSAME(IHDIR,IQ(KQSP+LRZ+IH),4))THEN
- IF (KVSCYC.EQ.0) THEN
- IRS = JBYT(IQ(KQSP+LRZ+IH+5),1,18)
- ELSE
- IRS = IQ(KQSP+LRZ+IH+5)
- ENDIF
-*
-* Record number of this subdirectory < 0 or > file quota
-*
- IQUEST(20) = 0
- IF(IRS.LE.0.OR.IRS.GT.FQUOTA) GOTO 100
- LRN = LQ(KQSP+LRZ-1)
- 20 IF(LRN.EQ.0)THEN
- CALL MZBOOK(JQPDVS,LDIR,LRZ,-1,'RZ ',6,6,LREF,2,-1)
- LRZ=LDIR
- CALL RZIODO(LUNF,LREF,IRS,IQ(KQSP+LRZ+1),1)
- IF(IQUEST(1).NE.0) GOTO 70
- LDS=IQ(KQSP+LRZ+KLD)
- IF(LDS.GT.IQ(KQSP+LRZ-1)) GOTO 100
- IF(LDS.LE.0) GOTO 100
- NRDS=IQ(KQSP+LRZ+LDS)
- IF(NRDS.GT.1)THEN
- CALL MZPUSH(JQPDVS,LRZ,0,LREF*(NRDS-1),' ')
- LDIR=LRZ
-*
-* Number of records, record numbers
-*
- IQUEST(20) = NRDS
- IQUEST(21) = IRS
- DO 30 IR=2,NRDS
- IRS=IQ(KQSP+LRZ+LDS+IR)
- JR = 20 + IR
- IF(JR.LE.100) IQUEST(JR) = IRS
- IF(IRS.LE.0.OR.IRS.GT.FQUOTA) GOTO 100
- CALL RZIODO(LUNF,LREF,IRS,
- + IQ(KQSP+LRZ+(IR-1)*LREF+1),1)
- IF(IQUEST(1).NE.0)GOTO 70
- 30 CONTINUE
- ENDIF
- ELSE
- 40 IF(RZSAME(IHDIR,IQ(KQSP+LRN+1),4))THEN
- LRZ = LRN
- LDIR= LRN
- GOTO 60
- ELSE
- LRN=LQ(KQSP+LRN)
- GOTO 20
- ENDIF
- ENDIF
- GOTO 60
- ENDIF
- 50 CONTINUE
- GOTO 80
- 60 CONTINUE
- CALL SBIT0(IQ(KQSP+LDIR),IQDROP)
- LT=LTEMP
-#if defined(CERNLIB_QMVAX)
- IF(IRELAT.NE.0)UNLOCK(UNIT=LUNF)
-#endif
- GOTO 110
-*
-* Errors
-*
- 70 CONTINUE
-*
-* RZIODO error
-*
- LDIR = 0
- IQUEST(1) = 1
-#if defined(CERNLIB_QMVAX)
- IF(IRELAT.NE.0)UNLOCK(UNIT=LUNF)
-#endif
- GOTO 110
- 80 CALL RZPAFF(CHPAT,NLPAT,CHL)
-#if defined(CERNLIB_QMVAX)
- IF(IRELAT.NE.0)UNLOCK(UNIT=LUNF)
-#endif
- 90 LDIR=0
- IQUEST(1) = 2 ! SWON: Write a message if "Unknown directory"
-* IF(LOGLV.GE.-2.AND.
-* + IQUEST(1).EQ.0.AND.IOPTQ.EQ.0)THEN (retain original code )
- IF(LOGLV.GE.-2.AND.IOPTQ.EQ.0)THEN
- WRITE(IQLOG,10000)CHROUT,CHL(1:LENOCC(CHL))
-10000 FORMAT(1X,A,'. Unknown directory ',A)
- ENDIF
- GOTO 110
-*
-* Directory overwritten
-*
- 100 CALL RZPAFF(CHPAT,NLPAT,CHL)
- IQUEST(1) = 3
-#if defined(CERNLIB_QMVAX)
- IF(IRELAT.NE.0)UNLOCK(UNIT=LUNF)
-#endif
- LDIR=0
- IF(LOGLV.GE.-2)THEN ! SWON: Write a message if RZ is in trouble
- WRITE(IQLOG,10100)CHROUT,CHL(1:LENOCC(CHL))
-10100 FORMAT(1X,A,'. Directory overwritten ',A)
- ENDIF
-*
- 110 RETURN
- END
diff --git a/src/packlib/zebra/rz/rzfile.F b/src/packlib/zebra/rz/rzfile.F
deleted file mode 100644
index af9eee1..0000000
--- a/src/packlib/zebra/rz/rzfile.F
+++ /dev/null
@@ -1,399 +0,0 @@
-*
-* $Id: rzfile.F,v 1.5 1998/09/25 09:33:35 mclareni Exp $
-*
-* $Log: rzfile.F,v $
-* Revision 1.5 1998/09/25 09:33:35 mclareni
-* Modifications for the Mklinux port flagged by CERNLIB_PPC
-*
-* Revision 1.4 1997/09/02 15:16:11 mclareni
-* WINNT corrections
-*
-* Revision 1.3 1997/03/14 17:21:19 mclareni
-* WNT mods
-*
-* Revision 1.2 1996/04/24 17:26:50 mclareni
-* Extend the include file cleanup to dzebra, rz and tq, and also add
-* dependencies in some cases.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:23 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE RZFILE(LUNIN,CHDIR,CHOPT)
-*
-************************************************************************
-*
-* Routine to access an already existing RZ file
-* To create a new RZ file routine RZMAKE should be used
-* Input:
-* LUNP Logical unit number associated with the RZ file. A FORTRAN
-* OPEN statement must precede the call to RZFILE.
-* Starting address of the memory area which will contain the RZ
-* information ('M' option)
-* CHDIR Character variable specifying the name of the top directory
-* to be associated with unit LUN.
-* CHOPT Character variable specifying the selected options.
-* medium
-* default
-* Disk
-* 'M' Memory mode
-* In this case space has already been allocated starting
-* at address LUNP.
-* other
-* 'U' UPDATE mode default is READ mode only
-* 'S' SHARED mode default is exclusive access
-* '1' UPDATE mode with only one user (no LOCKs required)
-* 'L' Show all locked directories and lock-ids
-* 'D' Reset LOCKing word in first record
-* 'C' C I/O
-* 'H' Hook user routine to RZIODO
-* 'X' Exchange mode file
-*
-* 'B' Rebuild bit map of file occupancy from file itself
-*
-* Called by <USER>
-*
-* Author : R.Brun DD/US/PD
-* Written : 07.04.86
-* Last mod: 22.09.94 JDS - include Z=RZCYCLE and call to RZVCYC
-* 06.07.95 JDS - return RZ file version in IQUEST(13)
-*
-************************************************************************
-*
-#include "zebra/zunit.inc"
-#include "zebra/zstate.inc"
-#include "zebra/rzcl.inc"
-#include "zebra/rzdir.inc"
-#include "zebra/rzclun.inc"
-#include "zebra/rzk.inc"
-#include "zebra/rzckey.inc"
-#include "zebra/rzcycle.inc"
-#include "zebra/rzbuff.inc"
-#if defined(CERNLIB_QMVAX)
- CHARACTER*16 CHORG
-#endif
- CHARACTER CHOPT*(*),CHDIR*(*)
- CHARACTER*16 CHTOP
- DIMENSION IOPTV(10)
- EQUIVALENCE (IOPTM,IOPTV(1)), (IOPTU,IOPTV(2))
- EQUIVALENCE (IOPTS,IOPTV(3)), (IOPTL,IOPTV(4))
- EQUIVALENCE (IOPT1,IOPTV(5)), (IOPTD,IOPTV(6))
- EQUIVALENCE (IOPTC,IOPTV(7)), (IOPTX,IOPTV(8))
- EQUIVALENCE (IOPTB,IOPTV(9)), (IOPTH,IOPTV(10))
-*
-*-----------------------------------------------------------------------
-*
-#include "zebra/q_jbit.inc"
-#include "zebra/q_jbyt.inc"
-
- IQUEST(1)=0
- LOGLV = MIN(NQLOGD,4)
- LOGLV = MAX(LOGLV,-3)
- LUNSA = LUN
- LUNP = LUNIN
-*
-* Save existing material (if any)
-*
- CALL RZSAVE
-*
- CALL UOPTC (CHOPT,'MUSL1DCXBH',IOPTV)
-#if !defined(CERNLIB_QCFIO)
-*SELF,IF=-QMCRY,IF=-QMVAX,IF=-QMCV64,IF=-QMAPO,IF=-QMAPO9,IF=-QMUIX,IF=-QMDOS.
- IF(IOPTC.NE.0) THEN
- WRITE(IQPRNT,*) 'RZFILE. option C ignored - valid only ',
- + 'for MSDOS, Unix and VMS systems'
- IOPTC = 0
- ENDIF
-#endif
- IRELAT=0
- IMODEC=IOPTC
- IMODEH=IOPTH
- IMODEX=IOPTX
-#if (defined(CERNLIB_QMLNX) && !defined(CERNLIB_PPC))
-C RZfile with Exchange mode for NonPPC-LINUX
-* IMODEX=1
-#endif
-*
-* Take LRECL and LUNP from IQUEST(10-11) in case of C I/O
-*
- IF(IOPTC.NE.0) THEN
- LRECP = IQUEST(10)
- LUNP = IQUEST(11)
- ENDIF
-*
-* Take LRECL and address of user routine from IQUEST(10-11)
-* in case of user I/O routine
-*
- IF(IOPTH.NE.0) THEN
- LRECP = IQUEST(10)
- LUN = IQUEST(11)
- LUSER = LUNIN
- ENDIF
-*
-* Find record length (as specified in the OPEN statement)
-*
-* A, Memory option. LUN contains the buffer address
-* and the value of LUNP is the block length
-*
- IF(IOPTM.NE.0)THEN
- LRECP=1024
- LUN=-99
- ELSEIF(IOPTH.EQ.0) THEN
-*
-* B, Standard option DISK. Use information as specified
-* in the Fortran OPEN statement
-*
-#if defined(CERNLIB_QMVAX)
- IF(IOPTC.EQ.0) THEN
- INQUIRE(UNIT=LUNP,ORGANIZATION=CHORG)
- IF(CHORG.EQ.'RELATIVE')IRELAT=1
- ENDIF
-#endif
-*
- IZRECL=LRECP
- CALL RZIODO(LUNP,50,2,ITEST,1)
-*
-* If option X not specified, determine mode (eXchange, native)
-* from file
-*
- IF(IOPTX.EQ.0) THEN
-#if defined(CERNLIB_QMVAX)||defined(CERNLIB_QMVMI)||defined(CERNLIB_QMDOS)||(defined(CERNLIB_QMLNX) && !defined(CERNLIB_PPC))||defined(CERNLIB_WINNT)
- CALL VXINVB(ITEST(9),1)
-#endif
- IF(JBIT(ITEST(9),12).NE.0)THEN
- IMODEX=1
-#if defined(CERNLIB_QMVAX)||defined(CERNLIB_QMVMI)||defined(CERNLIB_QMDOS)||(defined(CERNLIB_QMLNX) && !defined(CERNLIB_PPC))||defined(CERNLIB_WINNT)
- CALL RZIODO(LUNP,50,2,ITEST,1)
- ELSE
- CALL VXINVB(ITEST(9),1)
-#endif
- ENDIF
- ENDIF
-
- IF(IQUEST(1).NE.0)GO TO 30
- LB=ITEST(KLB)
- IF(LB.GT.48)CALL RZIODO(LUNP,LB+6,2,ITEST,1)
- IF(LB.GT.100)THEN
- IF(LOGLV.GE.-1) WRITE(IQLOG,10000)
-10000 FORMAT(' RZFILE. WARNING!! Top directory is big')
- ENDIF
- LRECP=ITEST(LB+1)
-#if defined(CERNLIB_QMALT)||defined(CERNLIB_QMAPO)||defined(CERNLIB_QMDOS)||defined(CERNLIB_WINNT)
- IF(IOPTC.EQ.0.AND.IOPTH.EQ.0) THEN
- INQUIRE(UNIT=LUNP,RECL=LRECL)
-* DEC Fortran takes "longword" units
-#endif
-#if (defined(CERNLIB_QFDEC))&&(defined(CERNLIB_QMDOS))
- IF(LRECP.NE.LRECL)THEN
-#endif
-#if (defined(CERNLIB_QMALT)||defined(CERNLIB_QMAPO)||defined(CERNLIB_QMDOS)||defined(CERNLIB_WINNT))&&(!defined(CERNLIB_QFDEC))
- IF(LRECP.NE.LRECL/4)THEN
-#endif
-#if defined(CERNLIB_QMALT)||defined(CERNLIB_QMAPO)||defined(CERNLIB_QMDOS)||defined(CERNLIB_WINNT)
- IQUEST(1)=1
- IF(LOGLV.GE.-2) WRITE(IQLOG,10100)LUNP,LRECP,LRECL/4
-10100 FORMAT(' RZFILE. Unit ',I6,'RECL on file ',I5,
- + ' incompatible with RECL in OPEN =',I5)
- GO TO 30
- ENDIF
- ENDIF
-#endif
- LUN=LUNP
- IQUEST(1)=0
- ENDIF
-*
- IF(LOGLV.GE.0) WRITE(IQLOG,10200) LUN,LRECP,CHOPT
-10200 FORMAT(' RZFILE. UNIT ',I6,' Initializing with LREC=',I6,
- +', OPT= ',A)
- CALL MZSDIV (0,-7)
-*
-* Check if LUN not already defined
-*
- LRZ=LQRS
- 10 IF(LRZ.NE.0)THEN
- IF(IQ(KQSP+LRZ-5).EQ.LUN)THEN
- IQUEST(1)=1
- IF(LOGLV.GE.-2) WRITE(IQLOG,10300)
-10300 FORMAT(' RZFILE. Unit is already in use')
- LUN=LUNSA
- GO TO 30
- ELSE
- LRZ=LQ(KQSP+LRZ)
- GO TO 10
- ENDIF
- ENDIF
-*
-* First call to RZFILE, create link area
-*
- IF(LQRS.EQ.0)THEN
- CALL MZLINK(JQPDVS,'RZCL',LTOP,LTOP,LFROM)
- CALL MZBOOK (JQPDVS,LRZ0,LQRS,1,'RZ0 ',2,2,36,2,0)
- IQ(KQSP+LRZ0-5)=0
- ISAVE = 1
- NHPWD = 0
- CALL VBLANK(IHPWD,2)
- ENDIF
- NCHD = LEN(CHDIR)
- IF(NCHD.GT.16)NCHD=16
- CHTOP = CHDIR(1:NCHD)
-*
-* Create control bank
-*
- CALL MZBOOK(JQPDVS,LTOP,LQRS,1,'RZ ',10,9,LRECP,2,0)
-*
-* Disk or memory
-*
- IF(IOPTM.EQ.0)THEN
- IQ(KQSP+LTOP-5) = LUN
-*
-* C I/O?
-*
- IF(IOPTC.NE.0) CALL SBIT1(IQ(KQSP+LTOP),5)
-*
-* user I/O?
-*
- IF(IOPTH.NE.0) THEN
- CALL SBIT1(IQ(KQSP+LTOP),6)
- CALL SBYT(LUSER,IQ(KQSP+LTOP),7,7)
- ENDIF
- ELSE
- NMEM=IQ(KQSP+LRZ0)+1
- IQ(KQSP+LRZ0)=NMEM
- IQ(KQSP+LTOP-5)=-NMEM
- IF(2*NMEM.GT.IQ(KQSP+LRZ0-1))THEN
- CALL MZPUSH(JQPDVS,LRZ0,0,10,' ')
- ENDIF
- IQ(KQSP+LRZ0+2*NMEM-1)=LOCF(LUNP)-LOCF(IQ(1))+1
- IQ(KQSP+LRZ0+2*NMEM )=LRECP
- LUN=-NMEM
- ENDIF
-*
-* Read 1st record of directory
-*
- CALL RZIODO(LUN,LRECP,2,IQ(KQSP+LTOP+1),1)
- IF(IQUEST(1).NE.0)GO TO 30
- LD = IQ(KQSP+LTOP+KLD)
- LB = IQ(KQSP+LTOP+KLB)
- LREC = IQ(KQSP+LTOP+LB+1)
- NRD = IQ(KQSP+LTOP+LD)
-#if defined(CERNLIB_FQXISN)
-*
-* Set exchange mode bit
-*
- CALL SBIT1(IQ(KQSP+LTOP+KPW1+2),12)
-#endif
- IMODEX=JBIT(IQ(KQSP+LTOP+KPW1+2),12)
-*
-* Increase size of control bank if required
-* and read all records for top directory
-*
- NPUSH=NRD*LREC-LRECP
- IF(NPUSH.NE.0)CALL MZPUSH(JQPDVS,LTOP,0,NPUSH,'I')
- DO 20 I=2,NRD
- CALL RZIODO(LUN,LREC,IQ(KQSP+LTOP+LD+I),
- + IQ(KQSP+LTOP+(I-1)*LREC+1),1)
- IF(IQUEST(1).NE.0)GO TO 30
- 20 CONTINUE
- CALL VBLANK(IQ(KQSP+LTOP+1),4)
- CALL UCTOH(CHDIR,IQ(KQSP+LTOP+1),4,NCHD)
- CALL ZHTOI(IQ(KQSP+LTOP+1),IQ(KQSP+LTOP+1),4)
- CALL SBYT(NCHD,IQ(KQSP+LTOP+KPW1+2),1,5)
- CALL UCOPY(IQ(KQSP+LTOP+KPW1),IHPWD,2)
- NHPWD=JBYT(IQ(KQSP+LTOP+KPW1+2),6,5)
- IQ(KQSP+LTOP+KIRIN)=0
- IQ(KQSP+LTOP+KIROUT)=0
-#if defined(CERNLIB_NOTNEW)
-*
-* Check that the file is not in the NEW format
-*
- IF (IQ(KQSP+LTOP+KRZVER).NE.0) THEN
- CALL ZFATAM
- + (' RZFILE. file cannot be processed by this version of RZ')
- ENDIF
-#endif
-
- LFREE = 0
- LUSED = 0
- LRIN = 0
- LPURG = 0
- LROUT = 0
- LCDIR = LTOP
- NLCDIR= 1
- NLNDIR= 1
- NLPAT = 1
- CHCDIR(1)=CHTOP
- CHNDIR(1)=CHTOP
-*
-* Reset LOCKing word in record 1
-*
- IF(IOPTD.NE.0)THEN
- CALL RZDLOK
- ENDIF
-*
-* Show locks
-*
- IF(IOPTL.NE.0)THEN
- CALL RZLLOK
- ENDIF
-#if defined(CERNLIB_QMVAX)
-*
-* Set ORGANIZATION type
-*
- IF(IRELAT.NE.0)THEN
- UNLOCK(UNIT=LUN)
- CALL SBIT1(IQ(KQSP+LTOP),4)
- ENDIF
-#endif
-*
-* Store default LOG level
-*
- LOGL = LOGLV + 3
- CALL SBYT(LOGL,IQ(KQSP+LTOP),15,3)
-*
-* RZ version
-*
- CALL RZVCYC(LTOP)
- IQUEST(13) = IQ(KQSP+LTOP+KRZVER)
-*
-* Rebuild bit map?
-*
- IF(IOPTB.NE.0) CALL RZVERI('//'//CHTOP(1:NCHD),'B')
-*
-* UPDATE mode only
-*
- CALL SBIT1(IQ(KQSP+LTOP),1)
- IF(IOPTU.NE.0.OR.IOPT1.NE.0)THEN
-*
-* Allocate free records
-*
- CALL SBIT0(IQ(KQSP+LTOP),1)
- CALL MZBOOK(JQPDVS,LFREE,LTOP,-2,'RZFR',0,0,21,2,0)
- IQ(KQSP+LFREE-5)=LUN
-*
-* IF(IOPTU.EQ.0.AND.IOPT1.EQ.0)THEN
- IF(IOPTS.EQ.0)THEN
- CALL SBIT1(IQ(KQSP+LTOP),3)
- CALL RZLOCK('RZFILE')
- IF(IQUEST(1).NE.0)THEN
- CALL SBIT1(IQ(KQSP+LTOP),1)
- IQ1=IQUEST(1)
- CALL MZDROP(JQPDVS,LFREE,' ')
- LFREE=0
- IQUEST(1)=2+IQ1
- GO TO 30
- ENDIF
- ELSE
- CALL SBIT0(IQ(KQSP+LTOP),3)
- ENDIF
-*
-* Allocate space for used records
-*
- CALL MZBOOK(JQPDVS,LUSED,LTOP,-3,'RZUS',0,0,21,2,0)
- IQ(KQSP+LUSED-5)=LUN
- ENDIF
- IQUEST(7)=IQ(KQSP+LCDIR+KNKEYS)
- IQUEST(8)=IQ(KQSP+LCDIR+KNWKEY)
-*
- 30 RETURN
- END
diff --git a/src/packlib/zebra/rz/rzfree.F b/src/packlib/zebra/rz/rzfree.F
deleted file mode 100644
index c8ac051..0000000
--- a/src/packlib/zebra/rz/rzfree.F
+++ /dev/null
@@ -1,141 +0,0 @@
-*
-* $Id: rzfree.F,v 1.2 1996/04/24 17:26:50 mclareni Exp $
-*
-* $Log: rzfree.F,v $
-* Revision 1.2 1996/04/24 17:26:50 mclareni
-* Extend the include file cleanup to dzebra, rz and tq, and also add
-* dependencies in some cases.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:23 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE RZFREE(CHLOCK)
-*
-************************************************************************
-*
-* To free a directory previously locked by RZLOCK
-* Input:
-* CHLOCK Character variable identifying the owner of the lock.
-*
-* Called by <USER>
-*
-* Author : R.Brun DD/US/PD
-* Written : 02.05.86
-* Last mod: 09.01.91
-*
-************************************************************************
-#include "zebra/zunit.inc"
-#include "zebra/rzcl.inc"
-#include "zebra/rzclun.inc"
-#include "zebra/rzk.inc"
- CHARACTER*(*) CHLOCK
- DIMENSION IHL(2)
-*
-*-----------------------------------------------------------------------
-*
-#include "zebra/q_jbyt.inc"
-
- IQUEST(1)=0
- IF(LQRS.EQ.0)GO TO 99
- IF(LTOP.EQ.0)GO TO 99
-*
- LOGLV=JBYT(IQ(KQSP+LTOP),15,3)-3
- NCH=LEN(CHLOCK)
- IF(NCH.GT.8)NCH=8
- CALL UCTOH(CHLOCK,IHL,4,NCH)
- IF(NCH.LT.5)CALL VBLANK(IHL(2),1)
- CALL ZHTOI(IHL,IHL,2)
-*
-* Check write permission
-*
-*** IF(JBIT(IQ(KQSP+LCDIR),1).NE.0)THEN
-*** IQUEST(1)=4
-*** IF(LOGLV.GE.-2) WRITE(IQLOG,9010)
-*** 9010 FORMAT(' RZFREE. No authorisation to write in that directory')
-*** GO TO 99
-*** ENDIF
-*
-* Lock first record
-*
- LRIN = LQ(KQSP+LTOP-7)
- LPURG = LQ(KQSP+LTOP-5)
- LROUT = LQ(KQSP+LTOP-6)
- IF(LRIN.EQ.0)THEN
- CALL MZBOOK(JQPDVS,LRIN,LTOP,-7,'RZIN',0,0,LREC+1,2,-1)
- IQ(KQSP+LRIN-5)=IQ(KQSP+LTOP-5)
- ENDIF
- NWL =50
- NTRY=0
- 10 CALL RZIODO(LUN,NWL,1,IQ(KQSP+LRIN+1),1)
- IF(IQUEST(1).NE.0)GO TO 99
- IF(IQ(KQSP+LRIN+2).GT.NWL)THEN
- NWL=IQ(KQSP+LRIN+2)
- GO TO 10
- ENDIF
- NWL=IQ(KQSP+LRIN+2)
- IQ(KQSP+LTOP+KIRIN)=0
- IF(IQ(KQSP+LRIN+3).NE.0)THEN
- NWL=50
- NTRY=NTRY+1
-#if defined(CERNLIB_QMVAX)
- IF(IRELAT.NE.0)UNLOCK(UNIT=LUN)
- CALL LIB$WAIT(0.1)
-#endif
- IF(NTRY.LT.100)GO TO 10
- IF(LOGLV.GE.-2) WRITE(IQLOG,1000)
- 1000 FORMAT(' RZFREE. Cannot lock that directory')
- IQUEST(1)=1
- GO TO 99
- ENDIF
- IQ(KQSP+LRIN+3)=1
- CALL RZIODO(LUN,MAX(NWL,50),1,IQ(KQSP+LRIN+1),2)
-*
-* Read fresh Top directory
-*
- IF(LTOP.NE.LCDIR)CALL RZRTOP
-*
-* Save directories
-*
- CALL RZSAVE
-*
- IQ(KQSP+LRIN+3)=0
- NLOCK=IQ(KQSP+LRIN+1)
- LDC=IQ(KQSP+LCDIR+KLD)
- IRD=IQ(KQSP+LCDIR+LDC+1)
-*
-* Search lock-id
-*
- IF(NLOCK.GT.0)THEN
- LL=4
- 20 NLESS=IQ(KQSP+LRIN+LL)
- IF(NLESS.NE.0)THEN
- IF(IQ(KQSP+LRIN+LL+1).EQ.IHL(1).AND.
- + IQ(KQSP+LRIN+LL+2).EQ.IHL(2).AND.
- + IQ(KQSP+LRIN+LL+4).EQ.IRD)THEN
- CALL UCOPY2(IQ(KQSP+LRIN+LL+NLESS),
- + IQ(KQSP+LRIN+LL),NWL-LL+1)
- NWL=NWL-NLESS
- IQ(KQSP+LRIN+1)=IQ(KQSP+LRIN+1)-1
- IQ(KQSP+LRIN+2)=NWL
- ELSE
- LL=LL+NLESS
- GO TO 20
- ENDIF
- ENDIF
- ENDIF
-*
-* Delete list of allocated records
-*
- IF(LFREE.NE.0)THEN
- CALL VZERO(IQ(KQSP+LFREE+1),IQ(KQSP+LFREE-1))
- ENDIF
-*
-* Write back record 1
-*
- CALL RZIODO(LUN,MAX(NWL,50),1,IQ(KQSP+LRIN+1),2)
- IQUEST(10)=IQ(KQSP+LRIN+1)
-*
- 99 RETURN
- END
diff --git a/src/packlib/zebra/rz/rzfrf1.F b/src/packlib/zebra/rz/rzfrf1.F
deleted file mode 100644
index 4496820..0000000
--- a/src/packlib/zebra/rz/rzfrf1.F
+++ /dev/null
@@ -1,105 +0,0 @@
-*
-* $Id: rzfrf1.F,v 1.2 1996/04/24 17:26:51 mclareni Exp $
-*
-* $Log: rzfrf1.F,v $
-* Revision 1.2 1996/04/24 17:26:51 mclareni
-* Extend the include file cleanup to dzebra, rz and tq, and also add
-* dependencies in some cases.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:23 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE RZFRF1(LUNFZ,IOPTH)
-*
-************************************************************************
-*
-* Copy into current directory from a sequential FZ file
-* Input:
-* LUNFZ Logical unit number of the FZ sequential access file
-* IOPTH 1 read only the highest cycle from LUNFZ
-* 0 read all cycles
-*
-* Called by <RZFRFZ>
-*
-* Author : R.Brun DD/US/PD
-* Written : 14.05.86
-* Last mod: 08.12.92 JDS. Change chopt to char*3
-* : 04.03.94 S.Banerjee (Change in cycle structure)
-*
-************************************************************************
-#include "zebra/rzcl.inc"
-#include "zebra/rzk.inc"
-#include "zebra/rzckey.inc"
-#include "zebra/rzcycle.inc"
- CHARACTER*1 CHOPTA
- CHARACTER*3 CHOPT
-*
-*-----------------------------------------------------------------------
-*
-#include "zebra/q_jbit.inc"
-#include "zebra/q_jbyt.inc"
-
-*
-* Read next key
-*
- 10 NH=KNSIZE
- CALL FZIN(LUNFZ,JQPDVS,LRZ0,-1,' ',NH,IHEAD)
- IF(IQUEST(1).NE.0)GO TO 99
- IF(NH.EQ.1.AND.IHEAD(1).EQ.77)GO TO 99
- IF(IOPTH.NE.0.AND.IHEAD(2).NE.1)GO TO 10
- LFROM=LQ(KQSP+LRZ0-1)
- IBIT4=JBIT(IHEAD(3),4)
- IFORM=JBYT(IHEAD(3),1,3)
- NWKEY=IQ(KQSP+LCDIR+KNWKEY)
- DO 20 I=1,NWKEY
- IKDES=(I-1)/10
- IKBIT1=3*I-30*IKDES-2
- IF(JBYT(IQ(KQSP+LCDIR+KKDES+IKDES),IKBIT1,3).GE.3)THEN
- CALL ZITOH(KEY(I),KEY(I),1)
- ENDIF
- 20 CONTINUE
-*
-* Data structure
-*
- IF(IBIT4.NE.0)THEN
- CHOPTA='A'
- ELSE
- CHOPTA=' '
- ENDIF
- IF(IFORM.EQ.0)THEN
- CHOPT='LW'//CHOPTA
- CALL RZOUT(JQPDVS,LFROM,KEY,ICY,CHOPT)
- ELSE
-*
-* Vector
-*
- CHOPT=CHOPTA
- IF(IFORM.EQ.1)CHOPT='B'//CHOPTA
- IF(IFORM.EQ.2)CHOPT='I'//CHOPTA
- IF(IFORM.EQ.5)CHOPT='H'//CHOPTA
- NDATA=IQ(KQSP+LFROM-1)
- LTEMP=LQ(KQSP+LFROM)
- IF(LTEMP.NE.0)THEN
- NTOT=0
- NEW=1
- 55 IF(NTOT.LT.NDATA)THEN
- CALL RZLINC(IQ(KQSP+LFROM+1),NTOT,IQ(KQSP+LTEMP+1),NEW)
- NEW=NEW+1
- GO TO 55
- ENDIF
- ENDIF
- CALL RZVOUT(IQ(KQSP+LFROM+1),NDATA,KEY,ICY,CHOPT)
- ENDIF
- IF(IQUEST(1).NE.0)THEN
- CALL MZDROP(JQPDVS,LFROM,'L')
- GO TO 99
- ENDIF
- LC=IQ(KQSP+LCDIR+KLC)
- IQ(KQSP+LCDIR+LC+KFLCYC)=IHEAD(3)
- CALL MZDROP(JQPDVS,LFROM,'L')
- GO TO 10
-*
- 99 RETURN
- END
diff --git a/src/packlib/zebra/rz/rzfrfz.F b/src/packlib/zebra/rz/rzfrfz.F
deleted file mode 100644
index d300d68..0000000
--- a/src/packlib/zebra/rz/rzfrfz.F
+++ /dev/null
@@ -1,148 +0,0 @@
-*
-* $Id: rzfrfz.F,v 1.2 1996/04/24 17:26:52 mclareni Exp $
-*
-* $Log: rzfrfz.F,v $
-* Revision 1.2 1996/04/24 17:26:52 mclareni
-* Extend the include file cleanup to dzebra, rz and tq, and also add
-* dependencies in some cases.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:23 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE RZFRFZ(LUNFZ,CHOPT)
-*
-************************************************************************
-*
-* To read the sequential file LUNFZ into the CWD
-* NB. A call to FZOPEN must preceede this call
-* Input:
-* LUNFZ Logical unit number of the FZ sequential access file
-* CHOPT default, read all cycles for path CHPATH
-* 'H' read only the highest cycle
-*
-* Called by <USER>
-*
-* Author : R.Brun DD/US/PD
-* Written : 14.05.86
-* Last mod: 21.10.91
-*
-************************************************************************
-#include "zebra/zbcdch.inc"
-#include "zebra/rzcl.inc"
-#include "zebra/rzch.inc"
-#include "zebra/rzk.inc"
-#include "zebra/rzckey.inc"
-#include "zebra/rzclun.inc"
- CHARACTER*(*) CHOPT
- CHARACTER*128 CHFORM
- CHARACTER*1 BSLASH
- DIMENSION IHDIR(4),ICDIR(KNMAX)
- EQUIVALENCE (ICDIR(1),KEY(1))
- LOGICAL RZSAME
-*
-*-----------------------------------------------------------------------
-*
- BSLASH=CQALLC(61:61)
- IQUEST(1)=0
- IF(LQRS.EQ.0)GO TO 99
-*
-* Check permission
-*
- IFLAG=0
- CALL RZMODS('RZFRFZ',IFLAG)
- IF(IFLAG.NE.0)GO TO 99
- CALL UOPTC(CHOPT,'H',IOPTH)
-*
-* Save CWD name
-*
-*
- CALL RZCDIR(CHWOLD,'R')
- ITIME=0
-*
-* Read general header and find next RZ construct
-*
- 10 NH=KNSIZE
- CALL FZIN(LUNFZ,JQPDVS,0,0,'S',NH,IHEAD)
- IF(IQUEST(1).NE.0)GO TO 99
- IF(NH.NE.2)GO TO 10
- IF(IHEAD(1).NE.12345)GO TO 10
- NLPI0=IHEAD(2)
- NLPI=NLPI0
-*
-* Read next directory
-*
- 20 CONTINUE
- ITIME=ITIME+1
- NH=KNSIZE
- CALL FZIN(LUNFZ,JQPDVS,0,0,'S',NH,IHEAD)
- IF(IQUEST(1).NE.0)GO TO 90
- IF(NH.EQ.1.AND.IHEAD(1).EQ.99.AND.ITIME.NE.0)GO TO 90
- IF(NH.NE.KNSIZE)GO TO 20
- IF(IHEAD(1).NE.1)GO TO 20
- IF(IHEAD(2).EQ.NLPI0)GO TO 70
-*
-* Go back levels
-*
- IF(IHEAD(2).LE.NLPI)THEN
- CALL MZDROP(JQPDVS,LCDIR,' ')
- CHL=BSLASH
- ICHL=1
- DO 30 I=NLPI-1,IHEAD(2),-1
- CHFORM=CHL(1:ICHL)//BSLASH
- CHL=CHFORM
- ICHL=ICHL+1
- 30 CONTINUE
- CALL RZCDIR(CHL,' ')
- ENDIF
-*
-* New subdirectory. Check if directory does not exist already
-*
- LS=IQ(KQSP+LCDIR+KLS)
- NSDIR=IQ(KQSP+LCDIR+KNSD)
- CALL ZITOH(ICDIR,IHDIR,4)
- CALL UHTOC(IHDIR,4,CHL,16)
- NWKEY=ICDIR(KNWKEY)
- KTAGS=KKDES+(NWKEY-1)/10+1
- DO 40 I=1,NSDIR
- IF(RZSAME(ICDIR,IQ(KQSP+LCDIR+LS+7*(I-1)),4))GO TO 60
- 40 CONTINUE
-*
-* Create subdirectory
-*
- CALL RZMDIR(CHL,NWKEY,'?',' ')
- IF(IQUEST(1).NE.0)GO TO 90
-*
-* Set CWD to new branch
-*
- 60 CALL RZCDIR(CHL,' ')
-*
-* Is directory big enough ?
-*
- IF(IQ(KQSP+LCDIR-1).LT.ICDIR(KLE))THEN
- NM=ICDIR(KLE)-IQ(KQSP+LCDIR-1)
- CALL RZEXPD('RZFRFZ',NM)
- IF(IQUEST(1).NE.0) GO TO 90
- ENDIF
- CALL UCOPY(ICDIR(KKDES),IQ(KQSP+LCDIR+KKDES),2*NWKEY+KTAGS-KKDES)
- CALL UCOPY(ICDIR(KDATEC),IQ(KQSP+LCDIR+KDATEC),2)
-*
- 70 NLPI=IHEAD(2)
-*
-* Copy keys from sequential file to CWD
-*
- CALL SBIT1(IQ(KQSP+LTOP),2)
- CALL RZFRF1(LUNFZ,IOPTH)
- IF(IQUEST(1).EQ.0) GO TO 20
-*
-* Set CWD to original value
-*
- 90 ISAVE = 2
- IQ1=IQUEST(1)
- CALL RZSAVE
- CALL RZCDIR(CHWOLD,' ')
- IQUEST(1)=IQ1
-*
- 99 RETURN
- END
diff --git a/src/packlib/zebra/rz/rzhfra.F b/src/packlib/zebra/rz/rzhfra.F
deleted file mode 100644
index f6d26dc..0000000
--- a/src/packlib/zebra/rz/rzhfra.F
+++ /dev/null
@@ -1,49 +0,0 @@
-*
-* $Id: rzhfra.F,v 1.2 1996/04/24 17:26:52 mclareni Exp $
-*
-* $Log: rzhfra.F,v $
-* Revision 1.2 1996/04/24 17:26:52 mclareni
-* Extend the include file cleanup to dzebra, rz and tq, and also add
-* dependencies in some cases.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:24 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE RZHFRA(IH,NW)
-*
-***********************************************************************
-*
-* Converts array of NW ASCII words into EBCDIC hollerith
-*
-* Author : R.Brun CN/AS
-* Written : 17/10/92
-* Last mod: 17/10/92
-*
-***********************************************************************
-#if defined(CERNLIB_QMIBM)
- DIMENSION IH(1)
- PARAMETER (NCHAR = 126)
- DIMENSION IEB(NCHAR)
- DATA IEB /8*0,5,22*0,
- + 64, 90,127,123, 91,108, 80,125, 77, 93, 92, 78,107, 96, 75, 97,
- +240,241,242,243,244,245,246,247,248,249,122, 94, 76,126,110,111,
- +124,193,194,195,196,197,198,199,200,201,209,210,211,212,213,214,
- +215,216,217,226,227,228,229,230,231,232,233,173,224,189, 95,109,
- +121,129,130,131,132,133,134,135,136,137,145,146,147,148,149,150,
- +151,152,153,162,163,164,165,166,167,168,169,192, 79,208,161/
-*-----------------------------------
-*
-
-#include "zebra/q_jbyt.inc"
-
- DO 20 IW=1,NW
- DO 10 I=1,25,8
- IBYTE=JBYT(IH(IW),I,8)
- IF(IBYTE.GT.126)IBYTE=32
- CALL SBYT(IEB(IBYTE),IH(IW),I,8)
- 10 CONTINUE
- 20 CONTINUE
-#endif
- END
diff --git a/src/packlib/zebra/rz/rzhook.F b/src/packlib/zebra/rz/rzhook.F
deleted file mode 100644
index c3b4c3d..0000000
--- a/src/packlib/zebra/rz/rzhook.F
+++ /dev/null
@@ -1,44 +0,0 @@
-*
-* $Id: rzhook.F,v 1.1.1.1 1996/03/06 10:47:24 mclareni Exp $
-*
-* $Log: rzhook.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:24 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE RZHOOK(LUNIN,CHDIR,TARGET,LRECL,CHOPT)
-*
-* Connect user routine for RZFILE on unit LUNIN
-*
- CHARACTER*(*) CHOPT,CHDIR
- CHARACTER*20 CHOP
-
- EXTERNAL TARGET
-#include "zebra/quest.inc"
-
- IQUEST(10) = LRECL
- IQUEST(11) = JUMPAD(TARGET)
-
- LCH = LENOCC(CHOPT)
- CHOP = CHOPT(1:LCH)
- IF(INDEX(CHOP(1:LCH),'H').EQ.0) THEN
- LCH = LCH + 1
- CHOP(LCH:) = 'H'
- ENDIF
-
- CALL RZFILE(LUNIN,CHDIR,CHOP(1:LCH))
-*
-* RZIODO calls user routine via
-* call jumpst(iquest(11))
-* call jumpx2(ibuf,ioway)
-*
-* where IOWAY = 0: read buffer
-* IOWAY = 1: write buffer
-*
-* and IQUEST(1) = LUN; on exit: status flag (0 = success)
-* IQUEST(2) = number of machine words for transmission/transmitted
-* IQUEST(4) = record number
-*
-
- END
diff --git a/src/packlib/zebra/rz/rzhtoa.F b/src/packlib/zebra/rz/rzhtoa.F
deleted file mode 100644
index d5068fa..0000000
--- a/src/packlib/zebra/rz/rzhtoa.F
+++ /dev/null
@@ -1,49 +0,0 @@
-*
-* $Id: rzhtoa.F,v 1.2 1996/04/24 17:26:53 mclareni Exp $
-*
-* $Log: rzhtoa.F,v $
-* Revision 1.2 1996/04/24 17:26:53 mclareni
-* Extend the include file cleanup to dzebra, rz and tq, and also add
-* dependencies in some cases.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:24 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE RZHTOA(IH,NW)
-*
-***********************************************************************
-*
-* Converts array of NW EBCDIC hollerith words into ASCII
-*
-* Author : R.Brun CN/AS
-* Written : 17/10/92
-* Last mod: 17/10/92
-*
-***********************************************************************
-#if defined(CERNLIB_QMIBM)
- DIMENSION IH(1)
- PARAMETER (NCHAR = 256)
- DIMENSION IASCI(NCHAR)
- DATA IASCI/
- +4*32,9,58*32,32,10*32,46,60,40,43,124,38,9*32,33,36,42,41,59,94,
- +45,47,9*32,44,37,95,62,63,9*32,96,58,35,64,39,61,34,32,97,98,99,
- +100,101,102,103,104,105,7*32,106,107,108,109,110,111,112,113,114,
- +7*32,126,115,116,117,118,119,120,121,122,3*32,91,15*32,93,32,32,
- +123,65,66,67,68,69,70,71,72,73,6*32,125,74,75,76,77,78,79,80,81,
- +82,6*32,92,32,83,84,85,86,87,88,89,90,6*32,48,49,50,51,52,53,54,
- +55,56,57,7*32/
-*-----------------------------------
-*
-
-#include "zebra/q_jbyt.inc"
-
- DO 20 IW=1,NW
- DO 10 I=1,25,8
- IBYTE=JBYT(IH(IW),I,8)
- CALL SBYT(IASCI(IBYTE),IH(IW),I,8)
- 10 CONTINUE
- 20 CONTINUE
-#endif
- END
diff --git a/src/packlib/zebra/rz/rzin.F b/src/packlib/zebra/rz/rzin.F
deleted file mode 100644
index 881a50f..0000000
--- a/src/packlib/zebra/rz/rzin.F
+++ /dev/null
@@ -1,147 +0,0 @@
-*
-* $Id: rzin.F,v 1.2 1996/04/24 17:26:54 mclareni Exp $
-*
-* $Log: rzin.F,v $
-* Revision 1.2 1996/04/24 17:26:54 mclareni
-* Extend the include file cleanup to dzebra, rz and tq, and also add
-* dependencies in some cases.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:24 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE RZIN(IXDIV,LSUP,JBIAS,KEYU,ICYCLE,CHOPT)
-*
-************************************************************************
-*
-* To read one record and create the corresponding data structure
-* which will be pointed by (LSUP,JBIAS) in division IXDIV
-* Input:
-* IXDIV Index of the division to receive the data structure
-* IXDIV = 0 means division 2 of the primary store
-* *LSUP*
-* JBIAS JBIAS < 1 : LSUP is the supporting bank and JBIAS is the link
-* bias specifying where the data structure has to be introduced
-* into this bank, i.e. the data structure will be connected to
-* LQ(LSUP+JBIAS).
-* JBIAS = 1 : LSUP is the supporting link, i.e. the data
-* structure is connected to LSUP (top level data structure)
-* JBIAS = 2 : Stand alone data structure, no connection.
-* KEYU Keyword vector of the information to be read
-* ICYCLE Cycle number of the key to be read
-* ICYCLE > highest cycle number means read the highest cycle
-* ICYCLE = 0 means read the lowest cycle
-* CHOPT Character variable specifying the options selected.
-* data structure
-* default
-* Same as 'D' below
-* 'A' Read continuation of the previously read data structure
-* with identifier KEYU,ICYCLE
-* Given that option implies that the record was written with
-* the same option by a call to RZOUT.
-* 'C' Provide information about the cycle numbers
-* associated with KEY.
-* The total number of cycles and the cycle number
-* identifiers of the 19 highest cycles are returned in
-* IQUEST(50) and IQUEST(51..89) respectively
-* 'D' Read the Data structure with the (key,cycle) pair
-* specified.
-* 'N' Read the neighbouring. keys (i.e. those preceding and
-* following KEY).
-* The key-vectors of the previous and next key are
-* available respectively as IQUEST(31..35) and
-* IQUEST(41..45), see below.
-* 'R' Read data into existing bank at LSUP,JBIAS
-* 'S' KEYU(1) contains the key serial number
-* Output:
-* *LSUP* For JBIAS = 1 or 2, LSUP contains the entry address to the
-* data structure
-* In any case IQUEST(11) returns the entry address
-*
-* Called by <USER>
-*
-* Author : R.Brun DD/US/PD
-* Written : 12.04.86
-* Last mod: 20.12.90
-* : 12.07.94 Return bank address when the input address is 0
-* and the data was written with RZVOUT.
-* Return IQUEST(11) correctly.
-*
-************************************************************************
-#include "zebra/rzcl.inc"
-#include "zebra/rzclun.inc"
-#include "zebra/rzk.inc"
- CHARACTER*(*) CHOPT
- DIMENSION KEYU(*)
- DIMENSION LSUP(1),JBIAS(1),IQK(10),IQKS(10)
- EQUIVALENCE (IOPTA,IQUEST(91)), (IOPTC,IQUEST(92))
- +, (IOPTD,IQUEST(93)), (IOPTN,IQUEST(94)), (IOPTR,IQUEST(95))
- +, (IOPTS,IQUEST(96))
-*
-*-----------------------------------------------------------------------
-*
-#include "zebra/q_jbyt.inc"
-*
-* Make sure input buffer exists
-*
- LRIN=LQ(KQSP+LTOP-7)
- IF(LRIN.EQ.0)THEN
- CALL MZBOOK(JQPDVS,LRIN,LTOP,-7,'RZIN',0,0,LREC+1,2,-1)
- IQ(KQSP+LRIN-5)=IQ(KQSP+LTOP-5)
- IQ(KQSP+LTOP+KIRIN)=0
- ENDIF
-*
-* Find KEY,CYCLE
-*
- CALL RZINK(KEYU,ICYCLE,CHOPT)
- IF(IQUEST(1).NE.0)GO TO 99
- IF(IOPTC.NE.0.AND.IOPTD.EQ.0)GO TO 99
- IDTIME=IQUEST(14)
- IDNW =IQUEST(12)
- IF(IOPTS.NE.0)CALL UCOPY(IQUEST(20),IQKS,10)
- IF(IOPTN.NE.0)THEN
- IF(IOPTD.EQ.0)GO TO 99
- CALL UCOPY(IQUEST(41),IQK,10)
- ENDIF
-*
- LBANK=0
- IF(LSUP(1).NE.0)THEN
- CALL MZSDIV(IXDIV,1)
- IF(JBIAS(1).LE.0)LBANK=LQ(KQS+LSUP(1)+JBIAS(1))
- IF(JBIAS(1).GT.0)LBANK=LSUP(1)
- ENDIF
-*
- IFORM=JBYT(IQUEST(14),1,3)
- IF(IFORM.EQ.0)THEN
-*
-* Read data structure into LBANK
-*
- CALL RZINS(IXDIV,LSUP,JBIAS,LBANK)
-*
- ELSE
-*
-* Case when record has been written with RZVOUT
-*
- NDATA=IQUEST(12)
- IF(LBANK.NE.0)THEN
- IF(NDATA.LE.IQ(KQS+LBANK-1))THEN
- CALL RZREAD(IQ(KQS+LBANK+1),NDATA,1,IFORM)
- IQUEST(11) = LBANK
- ELSE
- IQUEST(1)=3
- ENDIF
- ELSE
- CALL MZBOOK(IXDIV,LFROM,LSUP,JBIAS,'RZIN',0,0,NDATA,
- + IFORM,-1)
- CALL RZREAD(IQ(KQS+LFROM+1),NDATA,1,IFORM)
- IQUEST(11) = LFROM
- ENDIF
- ENDIF
- IQUEST(14)=IDTIME
- IQUEST(12)=IDNW
- IF(IOPTN.NE.0)CALL UCOPY(IQK ,IQUEST(41),10)
- IF(IOPTS.NE.0)CALL UCOPY(IQKS,IQUEST(20),10)
-*
- 99 RETURN
- END
diff --git a/src/packlib/zebra/rz/rzink.F b/src/packlib/zebra/rz/rzink.F
deleted file mode 100644
index d759368..0000000
--- a/src/packlib/zebra/rz/rzink.F
+++ /dev/null
@@ -1,263 +0,0 @@
-*
-* $Id: rzink.F,v 1.2 1996/04/24 17:26:55 mclareni Exp $
-*
-* $Log: rzink.F,v $
-* Revision 1.2 1996/04/24 17:26:55 mclareni
-* Extend the include file cleanup to dzebra, rz and tq, and also add
-* dependencies in some cases.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:24 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE RZINK(KEYU,ICYCLE,CHOPT)
-*
-************************************************************************
-*
-* To find and decode KEYU,ICYCLE
-* Input:
-* KEYU Keyword vector of the information to be read
-* ICYCLE Cycle number of the key to be read
-* ICYCLE > highest cycle number means read the highest cycle
-* ICYCLE = 0 means read the lowest cycle
-* CHOPT Character variable specifying the options selected.
-* data structure
-* default
-* Same as 'D' below
-* 'A' Read continuation of the previously read data structure
-* with identifier KEYU,ICYCLE
-* Given that option implies that the record was written with
-* the same option by a call to RZOUT.
-* 'C' Provide information about the cycle numbers
-* associated with KEY.
-* The total number of cycles and the cycle number
-* identifiers of the 19 highest cycles are returned in
-* IQUEST(50) and IQUEST(51..89) respectively
-* 'D' Read the Data structure with the (key,cycle) pair
-* specified.
-* 'N' Read the neighbouring. keys (i.e. those preceding and
-* following KEY).
-* The key-vectors of the previous and next key are
-* available respectively as IQUEST(31..35) and
-* IQUEST(41..45), see below.
-* 'R' Read data into existing bank at LSUP,JBIAS
-* 'S' KEYU(1) contains the key serial number
-* IQUEST(20)= serial number of the key in directory
-* IQUEST(21..20+NWKEY)=KEY(1....NWKEY)
-*
-* Called by RZIN,RZVIN
-*
-* Author : R.Brun DD/US/PD
-* Written : 09.05.86
-* Last mod: 11.09.89
-* : 04.03.94 S.Banerjee (Change in cycle structure)
-* : 23.03.95 J.Shiers - check on K/C blocks is on KEY(1)
-*
-************************************************************************
-#include "zebra/rzcl.inc"
-#include "zebra/rzclun.inc"
-#include "zebra/rzcout.inc"
-#include "zebra/rzk.inc"
-#include "zebra/rzckey.inc"
-#include "zebra/rzcycle.inc"
- CHARACTER*(*) CHOPT
- DIMENSION KEYU(*)
- EQUIVALENCE (IOPTA,IQUEST(91)), (IOPTC,IQUEST(92))
- +, (IOPTD,IQUEST(93)), (IOPTN,IQUEST(94)), (IOPTR,IQUEST(95))
- +, (IOPTS,IQUEST(96))
-*
-*-----------------------------------------------------------------------
-*
-#include "zebra/q_jbyt.inc"
-*
- IQUEST(1)=0
- CALL UOPTC(CHOPT,'ACDNRS',IQUEST(91))
-*
-* Search KEY and CYCLE
-*
- LK=IQ(KQSP+LCDIR+KLK)
- NKEYS=IQ(KQSP+LCDIR+KNKEYS)
- NWKEY=IQ(KQSP+LCDIR+KNWKEY)
- IQUEST(7)=NKEYS
- IQUEST(8)=NWKEY
- IF(NKEYS.EQ.0)GO TO 90
-*
- IF(IOPTS.NE.0)THEN
- IK1=KEYU(1)
- IK2=IK1
- IF(IK1.GT.NKEYS.OR.IK1.LE.0)THEN
- IQUEST(1)=1
- IQUEST(2)=IK1
- RETURN
- ENDIF
- ELSE
- IK1=1
- IK2=NKEYS
- DO 5 I=1,NWKEY
- IKDES=(I-1)/10
- IKBIT1=3*I-30*IKDES-2
- IF(JBYT(IQ(KQSP+LCDIR+KKDES+IKDES),IKBIT1,3).LT.3)THEN
- KEY(I)=KEYU(I)
- ELSE
- CALL ZHTOI(KEYU(I),KEY(I),1)
- ENDIF
- 5 CONTINUE
- ENDIF
- DO 30 I=IK1,IK2
- LKC=LK+(NWKEY+1)*(I-1)
- IF(IOPTS.EQ.0)THEN
- DO 10 K=1,NWKEY
- IF(IQ(KQSP+LCDIR+LKC+K).NE.KEY(K))GO TO 30
- 10 CONTINUE
- ELSE
- DO 15 K=1,NWKEY
- IF(K.LT.10)THEN
- IKDES=(K-1)/10
- IKBIT1=3*K-30*IKDES-2
- IF(JBYT(IQ(KQSP+LCDIR+KKDES+IKDES),IKBIT1,3).LT.3)THEN
- IQUEST(20+K)=IQ(KQSP+LCDIR+LKC+K)
- ELSE
- CALL ZITOH(IQ(KQSP+LCDIR+LKC+K),IQUEST(20+K),1)
- ENDIF
- ENDIF
- 15 CONTINUE
- ENDIF
- IQUEST(20)=I
- LCYC=IQ(KQSP+LCDIR+LKC)
- IF (KVSCYC.NE.0) THEN
-* IF (IQ(KQSP+LCDIR+LCYC+KKYCYC).NE.I) THEN
-*
-* Check should be on content of KEY(1)
-*
- IF (IQ(KQSP+LCDIR+LCYC+KKYCYC).NE.IQ(KQSP+LCDIR+LKC+1)) THEN
- IQUEST(1) = 11
- GO TO 99
- ENDIF
- ENDIF
- NC=0
- 20 NC=NC+1
- ICY = JBYT(IQ(KQSP+LCDIR+LCYC+KCNCYC),21,12)
- IF(ICY.EQ.ICYCLE)GO TO 50
- IF(NC.EQ.1.AND.ICYCLE.GT.ICY)GO TO 50
- IF (KVSCYC.EQ.0) THEN
- LCOLD = JBYT(IQ(KQSP+LCDIR+LCYC+KPPCYC),1,16)
- ELSE
- LCOLD = IQ(KQSP+LCDIR+LCYC+KPPCYC)
- ENDIF
- IF(LCOLD.EQ.0.AND.LCOLD.NE.LCYC.AND.ICYCLE.EQ.0)GO TO 50
- LCYC=LCOLD
- IF(LCYC.NE.0)GO TO 20
- GO TO 90
- 30 CONTINUE
- GO TO 90
-*
-* Cycle has been found
-* Read record descriptor
-*
- 50 IF (KVSCYC.EQ.0) THEN
- IR1 = JBYT(IQ(KQSP+LCDIR+LCYC+KFRCYC),17,16)
- IR2 = JBYT(IQ(KQSP+LCDIR+LCYC+KSRCYC),17,16)
- IP1 = JBYT(IQ(KQSP+LCDIR+LCYC+KORCYC), 1,16)
- NW = JBYT(IQ(KQSP+LCDIR+LCYC+KNWCYC), 1,20)
- ELSE
- IR1 = IQ(KQSP+LCDIR+LCYC+KFRCYC)
- IR2 = IQ(KQSP+LCDIR+LCYC+KSRCYC)
- IP1 = JBYT(IQ(KQSP+LCDIR+LCYC+KORCYC), 1,20)
- NW = IQ(KQSP+LCDIR+LCYC+KNWCYC)
- ENDIF
- N1 = NW
- IQUEST(2)=1
- IF(IR2.NE.0)IQUEST(2)=(NW-N1-1)/LREC+2
- IQUEST(3)=IR1
- IQUEST(4)=IP1
- IQUEST(5)=IR2
- IQUEST(6)=ICY
- IQUEST(12)=NW
- IQUEST(14)=IQ(KQSP+LCDIR+LCYC+1)
- IQUEST(15)=LCYC
-C
-C C option given
-C
- IF(IOPTC.NE.0)THEN
- IQUEST(50)=0
- LC1=LCYC
- 51 IQUEST(50)=IQUEST(50)+1
- IF (KVSCYC.EQ.0) THEN
- LCOLD = JBYT(IQ(KQSP+LCDIR+LC1+KPPCYC),1,16)
- ELSE
- LCOLD = IQ(KQSP+LCDIR+LC1+KPPCYC)
- ENDIF
- IF(IQUEST(50).LE.19)THEN
- NC=IQUEST(50)
- IQUEST(50+NC)=JBYT(IQ(KQSP+LCDIR+LC1+KCNCYC),21,12)
- IQUEST(70+NC)=IQ(KQSP+LCDIR+LC1+KFLCYC)
- ENDIF
- IF(LCOLD.NE.0.AND.LCOLD.NE.LC1)THEN
- LC1=LCOLD
- GO TO 51
- ENDIF
- ENDIF
-C
-C N option given. return neighbours
-C
- IF(IOPTN.NE.0)THEN
- IF(I.EQ.1)THEN
- IQUEST(30)=0
- ELSE
- IQUEST(30)=NWKEY
- DO 52 J=1,NWKEY
- IF(J.LT.10)THEN
- LKCJ=LK+(NWKEY+1)*(I-2)
- IQUEST(30+J)=IQ(KQSP+LCDIR+LKCJ+J)
- IKDES=(J-1)/10
- IKBIT1=3*J-30*IKDES-2
- IF(JBYT(IQ(KQSP+LCDIR+KKDES+IKDES),IKBIT1,3).GE.3)THEN
- CALL ZITOH(IQUEST(30+J),IQUEST(30+J),1)
- ENDIF
- ENDIF
- 52 CONTINUE
- ENDIF
- IF(I.EQ.NKEYS)THEN
- IQUEST(40)=0
- ELSE
- IQUEST(40)=NWKEY
- DO 53 J=1,NWKEY
- IF(J.LT.10)THEN
- LKCJ=LK+(NWKEY+1)*I
- IQUEST(40+J)=IQ(KQSP+LCDIR+LKCJ+J)
- IKDES=(J-1)/10
- IKBIT1=3*J-30*IKDES-2
- IF(JBYT(IQ(KQSP+LCDIR+KKDES+IKDES),IKBIT1,3).GE.3)THEN
- CALL ZITOH(IQUEST(40+J),IQUEST(40+J),1)
- ENDIF
- ENDIF
- 53 CONTINUE
- ENDIF
- ENDIF
- GO TO 99
-*
-* Error
-*
- 90 IQUEST(1)=1
- IF(IOPTN.NE.0)THEN
- IF(NKEYS.GT.0)THEN
- IQUEST(30)=NWKEY
- IQUEST(40)=NWKEY
- DO 91 J=1,NWKEY
- IF(J.GE.10)GO TO 91
- LKCJ=LK+(NWKEY+1)*(NKEYS-1)
- IQUEST(30+J)=IQ(KQSP+LCDIR+LK+J)
- IQUEST(40+J)=IQ(KQSP+LCDIR+LKCJ+J)
- IKDES=(J-1)/10
- IKBIT1=3*J-30*IKDES-2
- IF(JBYT(IQ(KQSP+LCDIR+KKDES+IKDES),IKBIT1,3).GE.3)THEN
- CALL ZITOH(IQUEST(30+J),IQUEST(30+J),1)
- CALL ZITOH(IQUEST(40+J),IQUEST(40+J),1)
- ENDIF
- 91 CONTINUE
- ENDIF
- ENDIF
-*
- 99 RETURN
- END
diff --git a/src/packlib/zebra/rz/rzinpa.F b/src/packlib/zebra/rz/rzinpa.F
deleted file mode 100644
index b2f78d9..0000000
--- a/src/packlib/zebra/rz/rzinpa.F
+++ /dev/null
@@ -1,86 +0,0 @@
-*
-* $Id: rzinpa.F,v 1.1.1.1 1996/03/06 10:47:24 mclareni Exp $
-*
-* $Log: rzinpa.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:24 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE RZINPA(CHPATH,IXDIV,LSUP,JBIAS,KEY,ICYCLE,CHOPT)
-*
-************************************************************************
-*
-* Same as RZIN. In addition a pathname may be specified
-* Input:
-* CHPATH Pathname of the directory where the information has
-* to be read
-* IXDIV Index of the division to receive the data structure
-* IXDIV = 0 means division 2 of the primary store
-* *LSUP*
-* JBIAS JBIAS < 1 : LSUP is the supporting bank and JBIAS is the link
-* bias specifying where the data structure has to be introduced
-* into this bank, i.e. the data structure will be connected to
-* LQ(LSUP+JBIAS).
-* JBIAS = 1 : LSUP is the supporting link, i.e. the data
-* structure is connected to LSUP (top level data structure)
-* JBIAS = 2 : Stand alone data structure, no connection.
-* KEY Keyword vector of the information to be read
-* ICYCLE Cycle number of the key to be read
-* ICYCLE > highest cycle number means read the highest cycle
-* ICYCLE = 0 means read the lowest cycle
-* ICYCLE = -1,-2,... means read the highest cycle minus 1,
-* 2,...
-* CHOPT Character variable specifying the options selected.
-* data structure
-* default
-* Same as 'D' below
-* 'A' Read continuation of the previously read data structure
-* with identifier KEYU,ICYCLE
-* Given that option implies that the record was written with
-* the same option by a call to RZOUT.
-* 'C' Provide information about the cycle numbers
-* associated with KEY.
-* The total number of cycles and the cycle number
-* identifiers of the 19 highest cycles are returned in
-* IQUEST(50) and IQUEST(51..89) respectively
-* 'D' Read the Data structure with the (key,cycle) pair
-* specified.
-* 'N' Read the neighbouring. keys (i.e. those preceding and
-* following KEY).
-* The key-vectors of the previous and next key are
-* available respectively as IQUEST(31..35) and
-* IQUEST(41..45), see below.
-* Output:
-* *LSUP* For JBIAS = 1 or 2, LSUP contains the entry address to the
-* data structure
-* In any case IQUEST(11) returns the entry address
-*
-* Called by <USER>
-*
-* Author : R.Brun DD/US/PD
-* Written : 12.04.86
-* Last mod: 12.04.86
-*
-************************************************************************
-#include "zebra/rzcl.inc"
-#include "zebra/rzclun.inc"
-#include "zebra/rzch.inc"
- CHARACTER*(*) CHOPT,CHPATH
- DIMENSION KEY(*)
-*
-*-----------------------------------------------------------------------
-*
-*
- CALL RZCDIR(CHWOLD,'R')
- ISAVE=0
- CALL RZCDIR(CHPATH,' ')
- IF(IQUEST(1).NE.0)GO TO 99
- CALL RZIN(IXDIV,LSUP,JBIAS,KEY,ICYCLE,CHOPT)
- IQSAVE=IQUEST(1)
- CALL RZCDIR(CHWOLD,' ')
- IQUEST(1)=IQSAVE
- ISAVE=1
-*
- 99 RETURN
- END
diff --git a/src/packlib/zebra/rz/rzins.F b/src/packlib/zebra/rz/rzins.F
deleted file mode 100644
index 0563e04..0000000
--- a/src/packlib/zebra/rz/rzins.F
+++ /dev/null
@@ -1,206 +0,0 @@
-*
-* $Id: rzins.F,v 1.2 1996/04/24 17:26:55 mclareni Exp $
-*
-* $Log: rzins.F,v $
-* Revision 1.2 1996/04/24 17:26:55 mclareni
-* Extend the include file cleanup to dzebra, rz and tq, and also add
-* dependencies in some cases.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:24 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE RZINS(IXDIVP,LSUPP,JBIASP,LBANK)
-*
-************************************************************************
-*
-* To read a data structure and make relocation
-*
-* Called by RZIN
-*
-* Author : J.Zoll/R.Brun/B.Holl
-* Written : 09.05.86
-* Last mod: 20.01.93 RB bug fix in call to MZIOCR
-*
-************************************************************************
-#include "zebra/zmach.inc"
-#include "zebra/mqsys.inc"
-#include "zebra/mzct.inc"
-#include "zebra/mzioc.inc"
-#include "zebra/mzcn.inc"
-#include "zebra/fzci.inc"
-#include "zebra/fzcseg.inc"
-#include "zebra/fzcocc.inc"
-#include "zebra/rzclun.inc"
- DIMENSION IXDIVP(9),LSUPP(9),JBIASP(9),IDUM(3)
- EQUIVALENCE (IOPTR,IQUEST(95))
-*
-*-----------------------------------------------------------------------
-*
-
-#if !defined(CERNLIB_FQXISN)
-#include "zebra/q_jbyt.inc"
-#endif
-
- IXDIVI = IXDIVP(1)
- JRETCD = 0
- JERROR = 0
- NQOCC = 0
- NQSEG = 0
-*
-* Read header
-*
- CALL RZREAD(NWTABI,3,1,1)
- IF(IQUEST(1).NE.0) GO TO 99
- NWIOI = 0
- NWUHI = 0
- NWUHCI = 0
- NWUMXI = 0
- NWTXI = 0
- NWSEGI = 0
-*
-* Get store / divison
-*
- CALL MZSDIV(IXDIVI,7)
- IF(JQDIVI.EQ.0) JQDIVI=2
-*
- IF(LBANK.NE.0.AND.IOPTR.NE.0)THEN
- NLINK=IQ(KQS+LBANK-3)
- NWK =NWBKI-10-NLINK
- IF(IQ(KQS+LBANK-1).LT.NWK)GO TO 91
-#if !defined(CERNLIB_FQXISN)
- IF(IMODEX.GT.0)THEN
- CALL MZIOCR(LQ(KQS+LBANK-NLINK-1))
- IF(IQUEST(1).LT.0)GO TO 99
- IQUEST(1)=0
- ENDIF
-#endif
- CALL RZREAD(IQ(KQS+LBANK+1),NWK,NWTABI+14+NLINK,0)
- GO TO 99
- ENDIF
-*
-* Read memory occupation table
-*
- LQSYSR(KQT+1)=LSUPP(1)
- CALL FZIMTB
- IF(JRETCD.EQ.3)GO TO 91
- CALL RZREAD(LQ(LQTA+NWTABI),NWTABI,4,1)
- IF(IQUEST(1).NE.0) GO TO 99
-*
-* Read the data
-*
- LSTA = LQ(LQMTA+3)
- LEND = LQ(LQMTA+4)
-#if !defined(CERNLIB_FQXISN)
- IF(IMODEX.LE.0)GO TO 30
-*
-* in eXchange mode
-*
- LIN = LSTA
- NWR = NWTABI+4
- 10 CONTINUE
- CALL RZREAD(LQ(KQS+LIN),1,NWR,1)
- IF(IQUEST(1).NE.0)GO TO 99
- NWR = NWR+1
- IWD = LQ(KQS+LIN)
- NST = JBYT(IWD,1,16)-12
- IF(NST.LT.0)GO TO 20
-*
-* True bank
-*
- IQLN = LIN
- IQLS = LIN + NST + 1
- IF(IQLS+8.GE.LEND)GO TO 92
- MFO(1) = 1
- MFO(2) = NST + 2
- MFO(3) = 2
- MFO(4) = 2
- MFO(5) = 5
- MFO(6) = 1
- MFO(7) = 1
- MFO(8) = -1
- JFOEND = 8
- NWFOTT = NST+9
- NWFODN = 0
- CALL RZREAD(LQ(KQS+LIN+1),NST+9,NWR,0)
- IF(IQUEST(1).NE.0)GO TO 99
- NWR = NWR+NST+9
- IQNIO = JBYT(IQ(KQS+IQLS),19,4)
- IQNL = IQ(KQS+IQLS-3)
- IQND = IQ(KQS+IQLS-1)
- IF(IQNIO+IQNL.NE.NST)GO TO 92
- LIN = IQLS + IQND + 9
- IF(IQND.GT.0)THEN
- IF(LIN.GT.LEND)GO TO 92
- CALL MZIOCR(LQ(KQS+IQLN))
- IF(IQUEST(1).LT.0)GO TO 99
- IQUEST(1)=0
- CALL RZREAD(IQ(KQS+IQLS+1),IQND,NWR,0)
- IF(IQUEST(1).NE.0)GO TO 99
- NWR = NWR+IQND
- ENDIF
- IF(LIN.LT.LEND)GO TO 10
- GO TO 40
-*
-* Short dead region
-*
- 20 NWD = JBYT(IWD,17,IQDROP-17)
- IF(NWD.EQ.0.OR.NWD.NE.NST+12)GO TO 92
- IF(JBYT(IWD,IQDROP,IQBITW-IQDROP).NE.1)GO TO 92
- LIN = LIN + NWD
- IF(LIN.LT.LEND)GO TO 10
- GO TO 40
-#endif
-*
-* in native mode
-*
- 30 NWR = LEND - LSTA
- CALL RZREAD(LQ(KQS+LSTA),NWR,NWTABI+4,0)
- IF(IQUEST(1).NE.0) GO TO 99
-
-*
-* Relocation
-*
- 40 CONTINUE
- CALL FZIREL
- IF(JRETCD.NE.0)GO TO 93
-*
-* Link structure and return
-*
- JB=JBIASP(1)
- IF(JB.GE.2)THEN
- LSUPP(1)=LENTRI
- ELSE
- LSUPP(1)=LQSYSR(KQT+1)
- CALL ZSHUNT(IXDIVI,LENTRI,LSUPP,JB,1)
- ENDIF
-*
- IQUEST(1) = 0
- IQUEST(11) = IEVFLI
- IQUEST(12) = 0
- IQUEST(13) = LENTRI
- IQUEST(14) = NWBKI
- GO TO 99
-*
-* Not enough space
-*
-
- 91 IQUEST(11)= -2
- IQUEST(1) = 1
- GO TO 99
-*
-* Inconsistent bank material
-*
- 92 IQUEST(11)= -3
- IQUEST(1) = 1
- GO TO 99
-*
-* Bad data
-*
-
- 93 IQUEST(11)= -3
- IQUEST(1) = 1
-
- 99 RETURN
- END
diff --git a/src/packlib/zebra/rz/rziodo.F b/src/packlib/zebra/rz/rziodo.F
deleted file mode 100644
index fc0f57f..0000000
--- a/src/packlib/zebra/rz/rziodo.F
+++ /dev/null
@@ -1,329 +0,0 @@
-*
-* $Id: rziodo.F,v 1.6 1998/09/25 09:33:38 mclareni Exp $
-*
-* $Log: rziodo.F,v $
-* Revision 1.6 1998/09/25 09:33:38 mclareni
-* Modifications for the Mklinux port flagged by CERNLIB_PPC
-*
-* Revision 1.5 1998/03/13 16:51:18 mclareni
-* Put the record length warning behind a CERNLIB_DEBUG flag to avoid spurious warnings
-*
-* Revision 1.4 1997/09/02 15:16:12 mclareni
-* WINNT corrections
-*
-* Revision 1.3 1997/05/14 08:33:39 couet
-* - Bug fixed by S.O'Neale. atlas problems with cernlib 97a, with rfio/cio
-* the record was not correct in rziodo. Now rzfdir.F rest the correct one.
-*
-* Revision 1.2 1996/04/24 17:26:56 mclareni
-* Extend the include file cleanup to dzebra, rz and tq, and also add
-* dependencies in some cases.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:24 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE RZIODO(LUNRZ,JREC,IREC1,IBUF,IRW)
-*
-**********************************************************************
-*
-* To read/write a block from disk or memory
-*
-* LUNRZ Logical unit number for disk (LUN>0)
-* JREC Record length
-* IREC RECORD NUMBER
-* IBUF ADDRESS OF BUFFER TO BE READ/WRITTEN ON IREC
-* IRW =1 TO READ
-* IRW =2 TO WRITE
-*
-* Called by RZCOP1,RZDELT,RZDFIR,RZFILE,RZFREE,RZLLOK,RZLOCK
-* RZMAKE,RZMDIR,RZOUT,RZREAD,RZSAVE,RZOPEN
-*
-* Author : R.Brun DD/US/PD
-* Written : 01.04.86
-* Last mod: 10.06.94 Implement File striping for PIAF (R.Brun)
-* New routine RZSTRIR called
-* Last mod: 26.10.93 IQUEST(1) = 101 in case of READ error,
-* 102 in case of WRITE error
-*
-************************************************************************
-*
-#include "zebra/zunit.inc"
-#include "zebra/rzcl.inc"
-#include "zebra/rzclun.inc"
-#include "zebra/rzbuff.inc"
-#include "zebra/rzcount.inc"
-#if defined(CERNLIB_QMUIX)
-#include "zebra/rzcstr.inc"
-#endif
- DIMENSION IBUF(JREC)
- PARAMETER (MEDIUM=0)
-*
-*-----------------------------------------------------------------------
-*
-
-#include "zebra/q_jbyt.inc"
-
-*
-* I/O statistics
-*
- RZXIO(IRW) = RZXIO(IRW) + JREC
-
- IREC=IREC1
- IF(LUNRZ.GT.0)THEN
- NERR=0
-#if defined(CERNLIB_DEBUG)
-C Too many false alarms occur if we leave this in production code.
- IF ( IREC.GT.2 .AND. IZRECL.NE.JREC ) THEN
- WRITE(IQLOG,10010) LUNRZ,IREC,IZRECL,JREC
-10010 FORMAT(' RZIODO. Potential Record Length Problem LUN =',I6,
- + ' IREC =',I6,' IZRECL =',I6,' JREC =',I6)
- END IF
-#endif
- IF(IMODEH.NE.0) THEN
-*
- IQUEST(1) = JBYT(IQ(KQSP+LTOP),7,7)
- IQUEST(2) = JREC
- IQUEST(4) = IREC
- IOWAY = IRW - 1
-*
-#if defined(CERNLIB_QMVAX)||defined(CERNLIB_QMVMI)||defined(CERNLIB_QMDOS)||(defined(CERNLIB_QMLNX) && !defined(CERNLIB_PPC))||defined(CERNLIB_WINNT)
-*
-* Byte swap
-*
- IF(IRW.EQ.2.AND.IMODEX.NE.0) CALL VXINVB(IBUF,JREC)
-#endif
- CALL JUMPST(LUNRZ)
- CALL JUMPX2(IBUF,IOWAY)
-
- IF(IQUEST(1).NE.0) IQUEST(1) = 100 + IRW
-#if defined(CERNLIB_QMVAX)||defined(CERNLIB_QMVMI)||defined(CERNLIB_QMDOS)||(defined(CERNLIB_QMLNX) && !defined(CERNLIB_PPC))||defined(CERNLIB_WINNT)
-*
-* Byte swap
-*
- IF(IMODEX.NE.0) CALL VXINVB(IBUF,JREC)
-#endif
- ELSE
-*
-* Read a record
-*
- 10 IF (IRW.EQ.1)THEN
-*
-* Fortran I/O
-*
- IF(IMODEC.EQ.0) THEN
-#if defined(CERNLIB_QMUIX)
-*-* Case of File striping
-*
- if(nstrip(lunrz).gt.0)then
- call rzstrir(lunrz,irec)
- endif
-*
-#endif
-#if defined(CERNLIB_QMVDS)
- CALL READ_ASS(LUNRZ,IREC,ISTAT,IBUF)
- IF(ISTAT.EQ.1)GO TO 20
-#endif
-#if (!defined(CERNLIB_QMVDS))&&(!defined(CERNLIB_QMCRY))&&(!defined(CERNLIB_QMCV64))
- READ (UNIT=LUNRZ,REC=IREC,ERR=20,IOSTAT=ISTAT)IBUF
-#endif
-#if defined(CERNLIB_QMCRY)||defined(CERNLIB_QMCV64)
-*
-* Exchange mode on Cray and Convex - read JREC/2 64 bit
-* words (=JREC 32 bit words)
-*
- IF(IMODEX.NE.0) THEN
- CALL RZIPHD(LUNRZ,JREC/2,IREC,ITEST,ISTAT)
- IF(ISTAT.NE.0) GOTO 20
-#endif
-#if defined(CERNLIB_QMCV64)
-*
-* Unpack 32 bit words to 64 bit words
-*
- CALL UPAK32(ITEST,IBUF,JREC)
-#endif
-#if defined(CERNLIB_QMCRY)
-*
-* Unpack 32 bit words to 64 bit words
-*
- CALL UNPACK(ITEST,32,IBUF,JREC)
-#endif
-#if defined(CERNLIB_QMCRY)||defined(CERNLIB_QMCV64)
-*
-* Native mode
-*
- ELSE
- READ(UNIT=LUNRZ,REC=IREC,ERR=20,IOSTAT=ISTAT)IBUF
- ENDIF
-#endif
-*
-* C I/O
-*
- ELSE
-#if defined(CERNLIB_QMCRY)||defined(CERNLIB_QMCV64)
- IF(IMODEX.NE.0) THEN
-*
-* Exchange mode?
-*
- CALL CFSEEK(LUNRZ-1000,MEDIUM,IZRECL/2,IREC-1,
- + ISTAT)
- NWTAK = JREC / 2
- CALL CFGET(LUNRZ-1000,MEDIUM,JREC,NWTAK,ITEST,
- + ISTAT)
- IF(ISTAT.NE.0) GOTO 20
-#endif
-#if defined(CERNLIB_QMCRY)||defined(CERNLIB_QMCV64)
-*
-* Unpack
-*
-#endif
-#if defined(CERNLIB_QMCRY)
- CALL UNPACK(ITEST,32,IBUF,JREC)
-#endif
-#if defined(CERNLIB_QMCV64)
- CALL UPAK32(ITEST,IBUF,JREC)
-#endif
-#if defined(CERNLIB_QMCRY)||defined(CERNLIB_QMCV64)
- ELSE
-#endif
-#if defined(CERNLIB_QMIBM)||defined(CERNLIB_QMVDS)
-*
-* C I/O not supported
-*
- ISTAT = 99
-#endif
-#if defined(CERNLIB_QMUIX)
-*-* Case of File striping
-*
- if(nstrip(lunrz-1000).gt.0)then
- call rzstrir(lunrz-1000,irec)
- endif
-*
-#endif
-#if (!defined(CERNLIB_QMVDS))&&(!defined(CERNLIB_QMIBM))
- CALL CFSEEK(LUNRZ-1000,MEDIUM,IZRECL,IREC-1,ISTAT)
- NWTAK = JREC
- CALL CFGET(LUNRZ-1000,MEDIUM,JREC,NWTAK,IBUF,
- + ISTAT)
- IF(ISTAT.NE.0) GOTO 20
-#endif
-#if defined(CERNLIB_QMCRY)||defined(CERNLIB_QMCV64)
- ENDIF
-#endif
- ENDIF
-#if defined(CERNLIB_QMVAX)||defined(CERNLIB_QMVMI)||defined(CERNLIB_QMDOS)||(defined(CERNLIB_QMLNX) && !defined(CERNLIB_PPC))||defined(CERNLIB_WINNT)
-*
-* Byte swap if exchange mode
-*
- IF(IMODEX.NE.0) CALL VXINVB(IBUF,JREC)
-#endif
-*
-* Write
-*
- ELSE
-#if defined(CERNLIB_QMVAX)||defined(CERNLIB_QMVMI)||defined(CERNLIB_QMDOS)||(defined(CERNLIB_QMLNX) && !defined(CERNLIB_PPC))||defined(CERNLIB_WINNT)
-*
-* Byte swap if exchange mode
-*
- IF(IMODEX.NE.0) CALL VXINVB(IBUF,JREC)
-#endif
- IF(IMODEC.EQ.0) THEN
-#if defined(CERNLIB_QMVDS)
- CALL WRITE_ASS(LUNRZ,IREC,ISTAT,IBUF)
- IF(ISTAT.EQ.1)GO TO 20
-#endif
-#if (!defined(CERNLIB_QMVDS))&&(!defined(CERNLIB_QMCRY))&&(!defined(CERNLIB_QMCV64))
- WRITE(UNIT=LUNRZ,REC=IREC,ERR=20,IOSTAT=ISTAT)IBUF
-#endif
-#if defined(CERNLIB_QMCRY)||defined(CERNLIB_QMCV64)
- IF(IMODEX.NE.0) THEN
-*
-* Pack
-*
-#endif
-#if defined(CERNLIB_QMCRY)
- CALL PACK(IBUF,32,ITEST,JREC)
-#endif
-#if defined(CERNLIB_QMCV64)
- CALL PACK32(IBUF,ITEST,JREC)
-#endif
-#if defined(CERNLIB_QMCRY)||defined(CERNLIB_QMCV64)
- CALL RZOPHD(LUNRZ,IZRECL/2,IREC,ITEST,ISTAT)
- IF(ISTAT.NE.0) GOTO 20
- ELSE
- WRITE(UNIT=LUNRZ,REC=IREC,ERR=20,IOSTAT=ISTAT)
- + IBUF
- ENDIF
-#endif
- ELSE
-#if defined(CERNLIB_QMCRY)||defined(CERNLIB_QMCV64)
- IF(IMODEX.NE.0) THEN
-*
-* Pack
-*
-#endif
-#if defined(CERNLIB_QMCRY)
- CALL PACK(IBUF,32,ITEST,JREC)
-#endif
-#if defined(CERNLIB_QMCV64)
- CALL PACK32(IBUF,ITEST,JREC)
-#endif
-#if defined(CERNLIB_QMCRY)||defined(CERNLIB_QMCV64)
- JREC = JREC / 2
- CALL CFSEEK(LUNRZ-1000,MEDIUM,IZRECL/2,IREC-1,
- + ISTAT)
- IF(ISTAT.NE.0) GOTO 20
- CALL CFPUT(LUNRZ-1000,MEDIUM,JREC/2,ITEST,ISTAT)
- IF(ISTAT.NE.0) GOTO 20
- ELSE
- CALL CFSEEK(LUNRZ-1000,MEDIUM,IZRECL,IREC-1,ISTAT)
- IF(ISTAT.NE.0) GOTO 20
- CALL CFPUT(LUNRZ-1000,MEDIUM,JREC,IBUF,ISTAT)
- IF(ISTAT.NE.0) GOTO 20
- ENDIF
-#endif
-#if defined(CERNLIB_QMIBM)||defined(CERNLIB_QMVDS)
-*
-* C I/O not supported
-*
- ISTAT = 99
-#endif
-#if (!defined(CERNLIB_QMVDS))&&(!defined(CERNLIB_QMCRY))&&(!defined(CERNLIB_QMCV64))&&(!defined(CERNLIB_QMIBM))
- CALL CFSEEK(LUNRZ-1000,MEDIUM,IZRECL,IREC-1,ISTAT)
- IF(ISTAT.NE.0) GOTO 20
- CALL CFPUT(LUNRZ-1000,MEDIUM,JREC,IBUF,ISTAT)
- IF(ISTAT.NE.0) GOTO 20
-#endif
- ENDIF
-#if defined(CERNLIB_QMVAX)||defined(CERNLIB_QMVMI)||defined(CERNLIB_QMDOS)||(defined(CERNLIB_QMLNX) && !defined(CERNLIB_PPC))||defined(CERNLIB_WINNT)
-*
-* Byte swap back
-*
- IF(IMODEX.NE.0) CALL VXINVB(IBUF,JREC)
-#endif
- ENDIF
- RETURN
- 20 NERR=NERR+1
-#if defined(CERNLIB_QMVAX)
- CALL LIB$WAIT(0.1)
-#endif
-#if defined(CERNLIB_QMCRY)
- IC = SLEEPF(1)
-#endif
- IF(NERR.LT.100)GO TO 10
- IQUEST(1)=100+IRW
- WRITE(IQLOG,1000)IREC,LUNRZ,ISTAT
- 1000 FORMAT(' RZIODO. Error at record =',I5,' LUN =',I6,
- + ' IOSTAT =',I6)
- ENDIF
- ELSE
- KOF=IQ(KQSP+LRZ0-2*LUNRZ-1)+IQ(KQSP+LRZ0-2*LUNRZ)*(IREC-1)
- IF (IRW.EQ.1)THEN
- CALL UCOPY(IQ(KOF),IBUF,JREC)
- ELSE
- CALL UCOPY(IBUF,IQ(KOF),JREC)
- ENDIF
- ENDIF
-*
- END
diff --git a/src/packlib/zebra/rz/rziphd.F b/src/packlib/zebra/rz/rziphd.F
deleted file mode 100644
index ad4e282..0000000
--- a/src/packlib/zebra/rz/rziphd.F
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: rziphd.F,v 1.1.1.1 1996/03/06 10:47:24 mclareni Exp $
-*
-* $Log: rziphd.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:24 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE RZIPHD(LUN,JREC,IREC,IBUF,IRC)
- DIMENSION IBUF(JREC)
- IRC = 0
- READ(LUN,REC=IREC,ERR=99,IOSTAT=ISTAT) IBUF
- RETURN
- 99 IRC = ISTAT
- END
diff --git a/src/packlib/zebra/rz/rzkeep.F b/src/packlib/zebra/rz/rzkeep.F
deleted file mode 100644
index d1172a9..0000000
--- a/src/packlib/zebra/rz/rzkeep.F
+++ /dev/null
@@ -1,58 +0,0 @@
-*
-* $Id: rzkeep.F,v 1.1.1.1 1996/03/06 10:47:24 mclareni Exp $
-*
-* $Log: rzkeep.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:24 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE RZKEEP(KEYU,ICYCLE,CHOPT)
-*
-************************************************************************
-*
-* To mark KEYU,ICYCLE to be kept in a PURGE operation
-* Input:
-* KEYU Keyword vector
-* ICYCLE Cycle number of the key
-* ICYCLE > highest cycle number means the highest cycle
-* ICYCLE = 0 means read the lowest cycle
-* CHOPT =' ' Keep this cycle
-* ='U' Unkeep
-*
-* Called by USER
-*
-* Author : R.Brun DD/US/PD
-* Written : 19.11.88
-* Last mod: 08.12.88
-* : 04.03.94 S.Banerjee (Change in cycle structure)
-*
-************************************************************************
-#include "zebra/rzcl.inc"
-#include "zebra/rzcycle.inc"
- DIMENSION KEYU(*)
- CHARACTER*(*) CHOPT
-*
-*-----------------------------------------------------------------------
-*
-* Check permission
-*
- IFLAG=1
- CALL RZMODS('RZKEEP',IFLAG)
- IF(IFLAG.NE.0)GO TO 99
-*
-* Find KEY,CYCLE
-*
- CALL RZINK(KEYU,ICYCLE,' ')
-*
- IF(IQUEST(1).NE.0)GO TO 99
-*
- LCYC=IQUEST(15)
- IF(CHOPT(1:1).NE.'U')THEN
- CALL SBIT1(IQ(KQSP+LCDIR+LCYC+KFLCYC),5)
- ELSE
- CALL SBIT0(IQ(KQSP+LCDIR+LCYC+KFLCYC),5)
- ENDIF
-*
- 99 RETURN
- END
diff --git a/src/packlib/zebra/rz/rzkeyd.F b/src/packlib/zebra/rz/rzkeyd.F
deleted file mode 100644
index 1233444..0000000
--- a/src/packlib/zebra/rz/rzkeyd.F
+++ /dev/null
@@ -1,65 +0,0 @@
-*
-* $Id: rzkeyd.F,v 1.2 1996/04/24 17:26:57 mclareni Exp $
-*
-* $Log: rzkeyd.F,v $
-* Revision 1.2 1996/04/24 17:26:57 mclareni
-* Extend the include file cleanup to dzebra, rz and tq, and also add
-* dependencies in some cases.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:24 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE RZKEYD(NWKEY,CHFORM,CHTAG)
-*
-************************************************************************
-*
-* Returns the key definition for the CWD
-* Output:
-* NWKEY* Number of words for each key
-* CHFORM* Format of each key .Ex 'IIH' character variable
-* CHTAG* Name of each key. Character array
-*
-* Called by <USER>
-*
-* Author : R.Brun DD/US/PD
-* Written : 27.04.86
-* Last mod: 09.10.86
-*
-************************************************************************
-#include "zebra/rzcl.inc"
-#include "zebra/rzch.inc"
-#include "zebra/rzk.inc"
- DIMENSION IHTAG(2)
- CHARACTER*8 CHTAG(*)
- CHARACTER*(*) CHFORM
-*
-*-----------------------------------------------------------------------
-*
-#include "zebra/q_jbyt.inc"
- NWKEY=0
- IF(LQRS.EQ.0)GO TO 99
- NWKEY=IQ(KQSP+LCDIR+KNWKEY)
- KTAGS=KKDES+(NWKEY-1)/10+1
-*
- DO 10 I=1,NWKEY
- CALL ZITOH(IQ(KQSP+LCDIR+KTAGS+2*I-2),IHTAG,2)
- CALL UHTOC(IHTAG,4,CHTAG(I),8)
- IKDES=(I-1)/10
- IKBIT1=3*I-30*IKDES-2
- IFORM=JBYT(IQ(KQSP+LCDIR+KKDES+IKDES),IKBIT1,3)
- IF(IFORM.EQ.3)THEN
- CHL(I:I)='H'
- ELSEIF(IFORM.EQ.4)THEN
- CHL(I:I)='A'
- ELSEIF(IFORM.EQ.1)THEN
- CHL(I:I)='B'
- ELSE
- CHL(I:I)='I'
- ENDIF
- 10 CONTINUE
- CHFORM=CHL(1:NWKEY)
-*
- 99 RETURN
- END
diff --git a/src/packlib/zebra/rz/rzkeys.F b/src/packlib/zebra/rz/rzkeys.F
deleted file mode 100644
index e54f02e..0000000
--- a/src/packlib/zebra/rz/rzkeys.F
+++ /dev/null
@@ -1,84 +0,0 @@
-*
-* $Id: rzkeys.F,v 1.2 1996/04/24 17:26:58 mclareni Exp $
-*
-* $Log: rzkeys.F,v $
-* Revision 1.2 1996/04/24 17:26:58 mclareni
-* Extend the include file cleanup to dzebra, rz and tq, and also add
-* dependencies in some cases.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:25 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE RZKEYS(MAXDIM,MAXKEY,KEYS,NKEYS)
-*
-************************************************************************
-*
-* Returns the list of keys currently in the CWD
-* Input:
-* MAXDIM The actual first dimension of output array KEYS. It should
-* in principle be at least equal to the number of key elements
-* NWKEY as declared to RZMDIR.
-* MAXKEY The actual second dimension of output array KEYS
-* Output:
-* KEYS* A 2-dimensional array dimensioned KEYS(MAXDIM,MAXKEY). It
-* will contain the key vectors associated with the CWD.
-* Its first index runs over the key elements for a given key,
-* while its second index runs over the different keys.
-* NKEYS* Actual number of keys present for the CWD.
-*
-* Called by <USER>
-*
-* Author : R.Brun DD/US/PD
-* Written : 05.04.86
-* Last mod: 09.02.93 JDS. Return NK and NWK in IQUEST in all cases
-*
-************************************************************************
-#include "zebra/rzcl.inc"
-#include "zebra/rzk.inc"
- DIMENSION KEYS(MAXDIM,MAXKEY)
-*
-*-----------------------------------------------------------------------
-*
-
-#include "zebra/q_jbyt.inc"
-
- IQUEST(1)=0
- NKEYS=0
- IF(LQRS.EQ.0)GO TO 99
- IF(LCDIR.EQ.0)GO TO 99
- LK = IQ(KQSP+LCDIR+KLK)
- NK = IQ(KQSP+LCDIR+KNKEYS)
- NWK= IQ(KQSP+LCDIR+KNWKEY)
- IF(NK.LE.MAXKEY)THEN
- NKEYS=NK
- IQUEST(11)=NK
- IQUEST(12)=NWK
- ELSE
- NKEYS=MAXKEY
- IQUEST(1)=1
- IQUEST(11)=NK
- IQUEST(12)=NWK
- ENDIF
- IF(NWK.GT.MAXDIM)THEN
- IQUEST(1)=1
- IQUEST(11)=NKEYS
- IQUEST(12)=NWK
- ENDIF
-*
- DO 20 I=1,NKEYS
- K=LK+(NWK+1)*(I-1)
- DO 10 J=1,NWK
- IKDES=(J-1)/10
- IKBIT1=3*J-30*IKDES-2
- IF(JBYT(IQ(KQSP+LCDIR+KKDES+IKDES),IKBIT1,3).LT.3)THEN
- KEYS(J,I)=IQ(KQSP+LCDIR+K+J)
- ELSE
- CALL ZITOH(IQ(KQSP+LCDIR+K+J),KEYS(J,I),1)
- ENDIF
- 10 CONTINUE
- 20 CONTINUE
-*
- 99 RETURN
- END
diff --git a/src/packlib/zebra/rz/rzldi1.F b/src/packlib/zebra/rz/rzldi1.F
deleted file mode 100644
index db81a8a..0000000
--- a/src/packlib/zebra/rz/rzldi1.F
+++ /dev/null
@@ -1,266 +0,0 @@
-*
-* $Id: rzldi1.F,v 1.3 1999/06/14 13:59:27 couet Exp $
-*
-* $Log: rzldi1.F,v $
-* Revision 1.3 1999/06/14 13:59:27 couet
-* - Mods for Y2K in the date/time output
-*
-* Revision 1.2 1996/04/24 17:26:58 mclareni
-* Extend the include file cleanup to dzebra, rz and tq, and also add
-* dependencies in some cases.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:25 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE RZLDI1(IOPTA,IOPTX)
-*
-************************************************************************
-*
-* List current directory
-* Input:
-* IOPTA =1 to list All objects
-* IOPTX =1 for eXtended listing (default 80 columns)
-*
-* Called by <RZLDIR>
-*
-* Author : R.Brun DD/US/PD
-* Written : 19.01.89
-* Last mod: 02.12.92 JDS. Increase IOFF2 to 50
-* : 04.03.94 S.Banerjee (Change in cycle structure)
-* : 27.09.95 JDS. Increase width in format 10200
-*
-************************************************************************
-#include "zebra/zunit.inc"
-#include "zebra/rzcl.inc"
-#include "zebra/rzdir.inc"
-#include "zebra/rzch.inc"
-#include "zebra/rzclun.inc"
-#include "zebra/rzk.inc"
-#include "zebra/rzckey.inc"
-#include "zebra/rzcycle.inc"
- CHARACTER*160 CHLD
- CHARACTER*1 CK
- DIMENSION IHTAG(40),IHDIR(4)
-#include "zebra/q_jbit.inc"
-#include "zebra/q_jbyt.inc"
-
-*
-*-----------------------------------------------------------------------
-*
-
- IOFF1 = 6
- IF(IOPTX.EQ.0) THEN
- IOFF2 = 50
- IOFF3 = 70
- IOFF4 = 79
- ELSE
- IOFF2 = 57
- IOFF3 = 120
- IOFF4 = 132
- ENDIF
-*
-* General case
-*
-*
- LS=IQ(KQSP+LCDIR+KLS)
- IF(IQUEST(1).EQ.0)THEN
- CALL RZDATE(IQ(KQSP+LCDIR+KDATEC),IDATEC,ITIMEC,1)
- CALL RZDATE(IQ(KQSP+LCDIR+KDATEM),IDATEM,ITIMEM,1)
- DO 10 I=LEN(CHL),1,-1
- IF(CHL(I:I).NE.' ')GO TO 20
- 10 CONTINUE
- 20 WRITE(IQPRNT,10000)CHL(1:I),IDATEC,ITIMEC,IDATEM,ITIMEM
-*
- NSDIR=IQ(KQSP+LCDIR+KNSD)
- IF(NSDIR.GT.0)THEN
- WRITE(IQPRNT,10100)
- DO 30 I=1,NSDIR
- IH=LS+7*(I-1)
- IF (KVSCYC.EQ.0) THEN
- IRECS = JBYT(IQ(KQSP+LCDIR+IH+5), 1,18)
- ELSE
- IRECS = IQ(KQSP+LCDIR+IH+5)
- ENDIF
- CALL RZDATE(IQ(KQSP+LCDIR+IH+6),IDATE,ITIME,1)
- CALL ZITOH(IQ(KQSP+LCDIR+IH),IHDIR,4)
- WRITE(IQPRNT,10200)IHDIR,IDATE,ITIME,IRECS
- 30 CONTINUE
- ENDIF
-*
- XNUS = 0.
- NKEYS= IQ(KQSP+LCDIR+KNKEYS)
- NWKEY= IQ(KQSP+LCDIR+KNWKEY)
- LK = IQ(KQSP+LCDIR+KLK)
- NWK1 = NWKEY
- IF(NWKEY.GT.20)THEN
- WRITE(IQPRNT,11400) NWKEY
- NWKEY = 20
- ENDIF
- NWK2 = 2*NWKEY
- KTAGS= KKDES+(NWK1-1)/10+1
- CALL ZITOH(IQ(KQSP+LCDIR+KTAGS),IHTAG,NWK2)
- WRITE(IQPRNT,10300)
- CHLD=' '
- IF( NWKEY .LE. 10 ) THEN
- WRITE(CHLD,10400)(IHTAG(I),I=1,NWK2)
- ELSE
- WRITE(CHLD,10400)(IHTAG(I),I=1,NWKEY)
- WRITE(IQPRNT,'(A)')CHLD(1:106)
- CHLD = ' '
- WRITE(CHLD,10400)(IHTAG(I),I=NWKEY+1,NWK2)
- ENDIF
- IC1 = LENOCC(CHLD) + 2
- IF(IC1.GT.IOFF2) THEN
- WRITE(IQPRNT,'(A)') CHLD(1:IC1)
- CHLD = ' '
- ENDIF
- IC1 = IOFF2
- IF(IOPTX.EQ.0) THEN
- WRITE(CHLD(IC1:IOFF4),10500)
- ELSE
- WRITE(CHLD(IC1:IOFF4),10600)
- ENDIF
- WRITE(IQPRNT,'(A)') CHLD(1:IOFF4)
- CHLD=' '
- IF(NKEYS.GT.0)THEN
- DO 60 I=1,NKEYS
- LKC=LK+(NWK1+1)*(I-1)
- LCYC=IQ(KQSP+LCDIR+LKC)
- 40 IF (KVSCYC.EQ.0) THEN
- LCOLD = JBYT(IQ(KQSP+LCDIR+LCYC+KPPCYC), 1,16)
- IR1 = JBYT(IQ(KQSP+LCDIR+LCYC+KFRCYC),17,16)
- IR2 = JBYT(IQ(KQSP+LCDIR+LCYC+KSRCYC),17,16)
- IP1 = JBYT(IQ(KQSP+LCDIR+LCYC+KORCYC), 1,16)
- NW = JBYT(IQ(KQSP+LCDIR+LCYC+KNWCYC), 1,20)
- ELSE
- LCOLD = IQ(KQSP+LCDIR+LCYC+KPPCYC)
- IR1 = IQ(KQSP+LCDIR+LCYC+KFRCYC)
- IR2 = IQ(KQSP+LCDIR+LCYC+KSRCYC)
- IP1 = JBYT(IQ(KQSP+LCDIR+LCYC+KORCYC), 1,20)
- NW = IQ(KQSP+LCDIR+LCYC+KNWCYC)
- ENDIF
- CALL RZDATE( IQ(KQSP+LCDIR+LCYC+KFLCYC),IDATE,ITIME,1)
- IBIT4 = JBIT(IQ(KQSP+LCDIR+LCYC+KFLCYC),4)
- IBIT5 = JBIT(IQ(KQSP+LCDIR+LCYC+KFLCYC),5)
- IC = JBYT(IQ(KQSP+LCDIR+LCYC+KCNCYC),21,12)
- IF(IBIT5.EQ.0)THEN
- CK=' '
- ELSE
- CK='*'
- ENDIF
- XNUS = XNUS+NW
- NLEFT=LREC-IP1+1
- IF(NW.LE.NLEFT)THEN
- NR=0
- ELSE
- NR=(NW-NLEFT-1)/LREC+1
- ENDIF
- CHLD=' '
- IC1=IOFF1
- IFMOLD=0
- DO 50 J=1,NWKEY
- IF(IC1.GT.IOFF3) THEN
- WRITE(IQPRNT,'(A)')CHLD(1:IC1)
- CHLD=' '
- IC1=IOFF1
- IFMOLD=0
- ENDIF
- IKDES=(J-1)/10
- IKBIT1=3*J-30*IKDES-2
- IFORM=JBYT(IQ(KQSP+LCDIR+KKDES+IKDES),IKBIT1,3)
- IF(IFORM.LT.3)THEN
- KEY(J)=IQ(KQSP+LCDIR+LKC+J)
- IF(IFMOLD.NE.0)IC1=IC1+10
- IF(IFMOLD.EQ.4)IC1=IC1+6
- IF(IABS(KEY(J)).LT.100000)THEN
- WRITE(CHLD(IC1:),'(I6)')KEY(J)
- ELSE
- WRITE(CHLD(IC1-4:),'(I10)')KEY(J)
- ENDIF
- ELSE
- CALL ZITOH(IQ(KQSP+LCDIR+LKC+J),KEY(J),1)
- IF(IFORM.EQ.3)THEN
- IF(IFMOLD.NE.0)IC1=IC1+10
- IF(IFMOLD.EQ.4)IC1=IC1+6
- WRITE(CHLD(IC1:),10700)KEY(J)
- ELSE
- IF(IFMOLD.EQ.4)IC1=IC1+4
- IF(IFMOLD.NE.4.AND.IFMOLD.NE.0)IC1=IC1+10
- WRITE(CHLD(IC1:),'(A4)')KEY(J)
- ENDIF
- ENDIF
- IFMOLD=IFORM
- 50 CONTINUE
- IC1=LENOCC(CHLD) + 2
- IF(IC1.GT.IOFF2) THEN
- WRITE(IQPRNT,'(A)') CHLD(1:IC1)
- CHLD = ' '
- ENDIF
- IC1 = IOFF2
- IF(IOPTX.EQ.0) THEN
- WRITE(CHLD(IC1:),10800)IC,CK,IDATE,ITIME,NW
- ELSE
- IF(IR2.EQ.0)THEN
- WRITE(CHLD(IC1:),10900)IC,CK,IDATE,ITIME,NW,IP1,
- + IR1
- ENDIF
- IF(NR.EQ.1)THEN
- WRITE(CHLD(IC1:),11000)IC,CK,IDATE,ITIME,NW,IP1,
- + IR1, IR2
- ENDIF
- IF(NR.GT.1)THEN
- IRL=IR2+NR-1
- WRITE(CHLD(IC1:),11100)IC,CK,IDATE,ITIME,NW,IP1,
- + IR1, IR2,IRL
- ENDIF
- ENDIF
- IF(IOPTA.NE.0.OR.IBIT4.EQ.0)
- + WRITE(IQPRNT,'(A)')CHLD(1:IOFF4)
- IF(LCOLD.NE.0.AND.LCOLD.NE.LCYC)THEN
- LCYC=LCOLD
- GO TO 40
- ENDIF
- 60 CONTINUE
- ENDIF
-*
-* Print statistics
-*
- 70 WRITE(IQPRNT,11200)IQ(KQSP+LCDIR+KRUSED),IQ(KQSP+LCDIR+KMEGA),
- + IQ(KQSP+LCDIR+KWUSED)
- XTOT =IQ(KQSP+LCDIR+KRUSED)*LREC
- IF(XTOT.GT.0.)THEN
- PERB =100.*XNUS/XTOT
- ELSE
- PERB=0.
- ENDIF
- PERD =100.*(FLOAT(IQ(KQSP+LCDIR+KRUSED)))/
- + FLOAT(IQ(KQSP+LCDIR+KQUOTA))
- PERF =100.*(FLOAT(IQ(KQSP+LCDIR+KRUSED)))/
- + FLOAT(IQ(KQSP+LTOP +KQUOTA))
- WRITE(IQPRNT,11300)PERD,PERF,PERB
- ENDIF
-*
-10000 FORMAT(///,' ************** Directory ===> ',A,' <===',//,
- +17X,' Created ',I6.6,'/',I4.4,' Modified ',I6.6,'/',I4.4,/)
-10100 FORMAT(/,' ===> List of subdirectories ')
-10200 FORMAT(1X,4A4,' Created ',I6.6,'/',I4.4,' at record ',I10)
-10300 FORMAT(/,' ===> List of objects ')
-10400 FORMAT(5X,10(A4,A4,2X))
-10500 FORMAT(' CYCLE DATE/TIME NDATA')
-10600 FORMAT(' CYCLE DATE/TIME NDATA OFFSET REC1 REC2')
-10700 FORMAT(2X,A4)
-10800 FORMAT(4X,I4,A,2X,I6.6,'/',I4.4,1X,I6)
-10900 FORMAT(4X,I4,A,2X,I6.6,'/',I4.4,1X,I6,2X,I6,2X,I6)
-11000 FORMAT(4X,I4,A,2X,I6.6,'/',I4.4,1X,I6,2X,I6,2X,I6,2X,I6)
-11100 FORMAT(4X,I4,A,2X,I6.6,'/',I4.4,1X,I6,2X,I6,2X,I6,2X,I6,' ==>',I6)
-11200 FORMAT(/,' Number of records =',I5,' Number of megawords =',
- + I3,' +',I6,' words')
-11300 FORMAT(' Per cent of directory quota used =',F8.3,/
- + ' Per cent of file used =',F8.3,/
- + ' Blocking factor =',F8.3)
-11400 FORMAT(' RZLDI1. Cannot list more than 20 keys',/
- + ' Number of keys found:',I10)
- 80 RETURN
- END
diff --git a/src/packlib/zebra/rz/rzldir.F b/src/packlib/zebra/rz/rzldir.F
deleted file mode 100644
index 6d8355a..0000000
--- a/src/packlib/zebra/rz/rzldir.F
+++ /dev/null
@@ -1,130 +0,0 @@
-*
-* $Id: rzldir.F,v 1.2 1999/06/14 13:59:28 couet Exp $
-*
-* $Log: rzldir.F,v $
-* Revision 1.2 1999/06/14 13:59:28 couet
-* - Mods for Y2K in the date/time output
-*
-* Revision 1.1.1.1 1996/03/06 10:47:25 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE RZLDIR(CHPATH,CHOPT)
-*
-************************************************************************
-*
-* List directory CHPATH
-* Input:
-* CHPATH Character variable specifying the directory pathname.
-* ' ' means list information for the CWD.
-* CHOPT Character variable specifying the options:
-* default
-* 'A' List also Keys entered with option 'A'
-* 'T' List also subdirectory tree
-* 'X' eXtended listing - show also OFFSET,REC1,REC2
-*
-* Called by <USER>
-*
-* Author : R.Brun DD/US/PD
-* Written : 06.04.86
-* Last mod: 18.11.92 JDS - add option X
-*
-************************************************************************
-#include "zebra/zunit.inc"
-#include "zebra/rzcl.inc"
-#include "zebra/rzdir.inc"
-#include "zebra/rzch.inc"
-#include "zebra/rzk.inc"
- CHARACTER *(*) CHPATH,CHOPT
- DIMENSION IOPTV(3)
- EQUIVALENCE (IOPTA,IOPTV(1)), (IOPTT,IOPTV(2)), (IOPTX,IOPTV(3))
- DIMENSION ISD(NLPATM),NSD(NLPATM),IHDIR(4)
-*
-*-----------------------------------------------------------------------
-*
- IQUEST(1)=0
- IF(LQRS.EQ.0)GO TO 99
-*
-* List TOP directory only
-*
- IF(CHPATH.EQ.'//')THEN
- WRITE(IQPRNT,7000)
- LRZ=LQRS
- 2 IF(LRZ.NE.0)THEN
- LUNT = IQ(KQSP+LRZ-5)
- IF(LUNT.EQ.0)GO TO 99
- CALL RZDATE(IQ(KQSP+LRZ+KDATEC),IDATEC,ITIMEC,1)
- CALL RZDATE(IQ(KQSP+LRZ+KDATEM),IDATEM,ITIMEM,1)
- CALL ZITOH(IQ(KQSP+LRZ+1),IHDIR,4)
- WRITE(IQPRNT,8000)IHDIR,LUNT,IDATEC,ITIMEC,IDATEM,ITIMEM
- LRZ=LQ(KQSP+LRZ)
- GO TO 2
- ENDIF
- GO TO 99
- ENDIF
-*
-* General case
-*
- IF(LCDIR.EQ.0)GO TO 99
- CALL UOPTC (CHOPT,'ATX',IOPTV)
- CALL RZCDIR(CHWOLD,'R')
- CALL RZCDIR(CHPATH,' ')
- CALL RZPAFF(CHPAT,NLPAT,CHL)
- NLPAT0=NLPAT
- ITIME=0
-*
-*
-* Set CWD to the current level
-*
- 10 CONTINUE
- IF(ITIME.NE.0)THEN
- CALL RZPAFF(CHPAT,NLPAT,CHL)
- IF(IQUEST(1).NE.0)THEN
- NLPAT=NLPAT-1
- GO TO 20
- ENDIF
- CALL RZCDIR(CHL,' ')
- ENDIF
- IF(IQUEST(1).NE.0)THEN
- NLPAT=NLPAT-1
- GO TO 20
- ENDIF
- ISD(NLPAT)=0
- NSD(NLPAT)=IQ(KQSP+LCDIR+KNSD)
-*
-* List current directory
-*
- CALL RZLDI1(IOPTA,IOPTX)
- IF(IOPTT.EQ.0)GO TO 90
-*
-* Process possible down directories
-*
- 20 ISD(NLPAT)=ISD(NLPAT)+1
- IF(ISD(NLPAT).LE.NSD(NLPAT))THEN
- NLPAT=NLPAT+1
- LS=IQ(KQSP+LCDIR+KLS)
- IH=LS+7*(ISD(NLPAT-1)-1)
- CALL ZITOH(IQ(KQSP+LCDIR+IH),IHDIR,4)
- CALL UHTOC(IHDIR,4,CHPAT(NLPAT),16)
- ITIME=ITIME+1
- GO TO 10
- ELSE
- NLPAT=NLPAT-1
- IF(NLPAT.GE.NLPAT0)THEN
- LUP=LQ(KQSP+LCDIR+1)
- CALL MZDROP(JQPDVS,LCDIR,' ')
- LCDIR=LUP
- GO TO 20
- ENDIF
- ENDIF
-*
-* Reset CWD
-*
- 90 CALL RZCDIR(CHWOLD,' ')
-*
- 7000 FORMAT(///,' ************** List of TOP directories',/)
- 8000 FORMAT(' //',4A4,' LUN=',I6,
- +' Created ',I6.6,'/',I4.4,' Modified ',I6.6,'/',I4.4)
- 99 RETURN
- END
diff --git a/src/packlib/zebra/rz/rzlinc.F b/src/packlib/zebra/rz/rzlinc.F
deleted file mode 100644
index 29acae4..0000000
--- a/src/packlib/zebra/rz/rzlinc.F
+++ /dev/null
@@ -1,153 +0,0 @@
-*
-* $Id: rzlinc.F,v 1.2 1996/04/24 17:26:59 mclareni Exp $
-*
-* $Log: rzlinc.F,v $
-* Revision 1.2 1996/04/24 17:26:59 mclareni
-* Extend the include file cleanup to dzebra, rz and tq, and also add
-* dependencies in some cases.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:25 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE RZLINC(IDATA,NTOT,INEW,NEW)
-*
-************************************************************************
-*
-* To convert portable packed vectors into a local format.
-* Merges the IDATA and INEW modified by RZLIND into IDATA
-*
-* Called by RZFRF1
-*
-* Author : R.Brun DD/US/PD
-* Written : 08.09.89
-* Last mod: 08.09.89
-*
-************************************************************************
-*
-*
- DIMENSION IDATA(*),INEW(*)
- CHARACTER*4 KWORD
-*
-
-#include "zebra/q_jbit.inc"
-#include "zebra/q_jbyt.inc"
-
- NTOLD=NTOT
- IWORD=INEW(NEW)
- CALL UHTOC(IDATA(NTOT+1),4,KWORD,4)
- IDATA(NTOT+1)=IWORD
- IF(IWORD.EQ.0)THEN
- NTOT=NTOT+1
- GO TO 90
- ENDIF
-*
- IBIT31=JBIT(IWORD,31)
- IBIT32=JBIT(IWORD,32)
- IF(IBIT31.NE.0)THEN
- NWI=2
- ELSE
- NWI=1
- ENDIF
- KCODE=JBYT(IWORD,1,8)
- IF(IBIT32.NE.0)THEN
-*
-* Comment lines
-*
- ICODE=KCODE
- ICADRE=MOD(ICODE,2)
-*
-* Is there a frame ?
-*
- IF(ICADRE.NE.0)THEN
- NWI=NWI+1
- NEW=NEW+1
- IDATA(NTOT+NWI)=INEW(NEW)
- IK1=ICHAR(KWORD(1:1))
- CALL SBYT(IK1,IDATA(NTOT+NWI),1,8)
- IPOS1=JBYT(IDATA(NTOT+NWI),25,8)
- IF(IPOS1.NE.0)THEN
- IK2=ICHAR(KWORD(2:2))
- CALL SBYT(IK2,IDATA(NTOT+NWI),17,8)
- ENDIF
- ENDIF
-*
-* Is there a character to repeat?
-*
- ICAR=JBYT(IWORD,9,8)
- IF(ICAR.EQ.0)THEN
-*
-* No character to repeat.
-*
- IFWORD=JBYT(IWORD,17,7)
- ILASTW=JBYT(IWORD,24,7)
- IF(ILASTW.EQ.1) THEN
- NTOT=NTOT+NWI
- GO TO 90
- ENDIF
-*
- IF (ILASTW.GT.20 .OR. IFWORD.GT.ILASTW)GO TO 100
-*
- NTOT=NTOT+NWI+ILASTW-IFWORD+1
- GO TO 90
- ELSE
-*
-* Character must be repeated.
-*
- IK3=ICHAR(KWORD(3:3))
- CALL SBYT(IK3,IDATA(NTOT+1),9,8)
- NTOT =NTOT+NWI
- GO TO 90
- ENDIF
- ELSE
-*
-* Other particular cases
-*
- ICODE = JBYT(IWORD,24,7)
- ICOD = ICODE-114
-*
- IF(ICOD.LE.0)GO TO 40
- IF (ICOD.LT.6 .OR. ICOD.GT.11) THEN
- IF (ICOD.EQ.1 .OR. ICOD.EQ.3 .OR. ICOD.EQ.5) THEN
- KCODE=ICHAR(KWORD(1:1))
- IK2=ICHAR(KWORD(2:2))
- CALL SBYT(KCODE,IDATA(NTOT+1),1,8)
- CALL SBYT(IK2,IDATA(NTOT+1),9,8)
- ENDIF
- NTOT=NTOT+NWI
- GO TO 90
- ENDIF
-*
- IF (ICOD .EQ. 6) THEN
- NTOT=NTOT+1
- GO TO 90
- ENDIF
-*
- ILASTW=JBYT(IWORD,17,7)
- NTOT=NTOT+ILASTW
- GO TO 90
- ENDIF
-*
- 40 CONTINUE
-*
-* Normal instruction case
-*
- KCODE=ICHAR(KWORD(1:1))
- CALL SBYT(KCODE,IDATA(NTOLD+1),1,8)
- ILASTW=ICODE
- IF(ILASTW.LT.2) THEN
- NTOT=NTOT+NWI
- GO TO 90
- ENDIF
- IFWORD=JBYT(IWORD,17,7)
-*
- IF (ILASTW.GT.20 .OR. IFWORD.GT.ILASTW)GO TO 100
-*
- NTOT=NTOT+NWI+ILASTW-IFWORD+1
-*
- 90 CONTINUE
- RETURN
-*
- 100 NTOT=1000000
- 999 END
diff --git a/src/packlib/zebra/rz/rzlind.F b/src/packlib/zebra/rz/rzlind.F
deleted file mode 100644
index f756977..0000000
--- a/src/packlib/zebra/rz/rzlind.F
+++ /dev/null
@@ -1,153 +0,0 @@
-*
-* $Id: rzlind.F,v 1.2 1996/04/24 17:26:59 mclareni Exp $
-*
-* $Log: rzlind.F,v $
-* Revision 1.2 1996/04/24 17:26:59 mclareni
-* Extend the include file cleanup to dzebra, rz and tq, and also add
-* dependencies in some cases.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:25 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE RZLIND(IDATA,NTOT,INEW,NEW)
-*
-************************************************************************
-*
-* To convert packed vectors into a portable format.
-* To extract integers from IDATA into bit pattern array INEW
-* The original IDATA are modified into characters.
-*
-* Called by RZTOF1
-*
-* Author : R.Brun DD/US/PD
-* Written : 08.09.89
-* Last mod: 08.09.89
-*
-************************************************************************
-*
- DIMENSION IDATA(*),INEW(*)
- CHARACTER*4 KWORD
-*
-
-#include "zebra/q_jbit.inc"
-#include "zebra/q_jbyt.inc"
-
- NTOLD=NTOT
- KWORD=' '
- IWORD=IDATA(NTOT+1)
- INEW(NEW)=IWORD
- IF(IWORD.EQ.0)THEN
- NTOT=NTOT+1
- GO TO 90
- ENDIF
-*
- IBIT31=JBIT(IWORD,31)
- IBIT32=JBIT(IWORD,32)
- IF(IBIT31.NE.0)THEN
- NWI=2
- ELSE
- NWI=1
- ENDIF
- KCODE=JBYT(IWORD,1,8)
- IF(IBIT32.NE.0)THEN
-*
-* Comment cards
-*
- ICODE=KCODE
- ICADRE=MOD(ICODE,2)
-*
-* Is there a frame ?
-*
- IF(ICADRE.NE.0)THEN
- NWI=NWI+1
- NEW=NEW+1
- INEW(NEW)=IDATA(NTOT+NWI)
- KWORD(1:1)=CHAR(JBYT(IDATA(NTOT+NWI),1,8))
- IPOS1=JBYT(IDATA(NTOT+NWI),25,8)
- IF(IPOS1.NE.0)THEN
- KWORD(2:2)=CHAR(JBYT(IDATA(NTOT+NWI),17,8))
- ENDIF
- ENDIF
-*
-* Is there a character to repeat?
-*
- ICAR=JBYT(IWORD,9,8)
- IF(ICAR.EQ.0)THEN
-*
-* No character to repeat.
-*
- IFWORD=JBYT(IWORD,17,7)
- ILASTW=JBYT(IWORD,24,7)
- IF(ILASTW.EQ.1) THEN
- NTOT=NTOT+NWI
- GO TO 90
- ENDIF
-*
- IF (ILASTW.GT.20 .OR. IFWORD.GT.ILASTW)GO TO 100
-*
- NTOT=NTOT+NWI+ILASTW-IFWORD+1
- GO TO 90
- ELSE
-*
-* Character must be repeated.
-*
- KWORD(3:3)=CHAR(ICAR)
- IFIRST=JBYT(IWORD,17,7)
- ILAST =JBYT(IWORD,24,7)
-*
- IF (ILAST.GT.80 .OR. IFIRST.GT.ILAST)GO TO 100
-*
- NTOT =NTOT+NWI
- GO TO 90
- ENDIF
- ELSE
-*
-* Other particular cases
-*
- ICODE = JBYT(IWORD,24,7)
- ICOD = ICODE-114
-*
- IF(ICOD.LE.0)GO TO 40
- IF (ICOD.LT.6 .OR. ICOD.GT.11) THEN
- IF (ICOD.EQ.1 .OR. ICOD.EQ.3 .OR. ICOD.EQ.5) THEN
- KWORD(1:1)=CHAR(KCODE)
- KWORD(2:2)=CHAR(JBYT(IWORD,9,8))
- ENDIF
- NTOT=NTOT+NWI
- GO TO 90
- ENDIF
-*
- IF (ICOD .EQ. 6) THEN
- NTOT=NTOT+1
- GO TO 90
- ENDIF
-*
- ILASTW=JBYT(IWORD,17,7)
- NTOT=NTOT+ILASTW
- GO TO 90
- ENDIF
-*
- 40 CONTINUE
-*
-* Case of a normal line
-*
- KWORD(1:1)=CHAR(KCODE)
- ILASTW=ICODE
- IF(ILASTW.LT.2) THEN
- NTOT=NTOT+NWI
- GO TO 90
- ENDIF
- IFWORD=JBYT(IWORD,17,7)
-*
- IF (ILASTW.GT.20 .OR. IFWORD.GT.ILASTW)GO TO 100
-*
- NTOT=NTOT+NWI+ILASTW-IFWORD+1
-*
- 90 CONTINUE
- CALL UCTOH(KWORD,IDATA(NTOLD+1),4,4)
- RETURN
-*
- 100 NTOT=1000000
- 999 END
diff --git a/src/packlib/zebra/rz/rzllok.F b/src/packlib/zebra/rz/rzllok.F
deleted file mode 100644
index 15aebac..0000000
--- a/src/packlib/zebra/rz/rzllok.F
+++ /dev/null
@@ -1,113 +0,0 @@
-*
-* $Id: rzllok.F,v 1.3 1999/06/14 13:59:29 couet Exp $
-*
-* $Log: rzllok.F,v $
-* Revision 1.3 1999/06/14 13:59:29 couet
-* - Mods for Y2K in the date/time output
-*
-* Revision 1.2 1996/04/24 17:27:00 mclareni
-* Extend the include file cleanup to dzebra, rz and tq, and also add
-* dependencies in some cases.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:25 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE RZLLOK
-*
-************************************************************************
-*
-* Routine to print current active locks
-*
-*
-* Called by RZFILE
-*
-* Author : R.Brun DD/US/PD
-* Written : 08.09.89
-* Last mod: 08.09.89
-*
-************************************************************************
-*
-#include "zebra/zunit.inc"
-#include "zebra/rzcl.inc"
-#include "zebra/rzclun.inc"
-#include "zebra/rzdir.inc"
-#include "zebra/rzch.inc"
-#include "zebra/rzk.inc"
- DIMENSION IDIR(5,10),KHL(2)
-*
-*-----------------------------------------------------------------------
-*
-
-#include "zebra/q_jbyt.inc"
-
- IQUEST(1)=0
- IF(LQRS.EQ.0)GO TO 99
- IF(LTOP.EQ.0)GO TO 99
-*
-* Read locking record
-*
- IF(LRIN.EQ.0)THEN
- CALL MZBOOK(JQPDVS,LRIN,LTOP,-7,'RZIN',0,0,LREC+1,2,-1)
- IQ(KQSP+LRIN-5)=IQ(KQSP+LTOP-5)
- ENDIF
- NWL =50
- NTRY=0
- 10 CALL RZIODO(LUN,NWL,1,IQ(KQSP+LRIN+1),1)
- IF(IQUEST(1).NE.0)GO TO 90
- IF(IQ(KQSP+LRIN+2).GT.NWL)THEN
- NWL=IQ(KQSP+LRIN+2)
- GO TO 10
- ENDIF
- IQ(KQSP+LTOP+KIRIN)=0
- IF(IQ(KQSP+LRIN+3).NE.0)THEN
- NWL=50
- NTRY=NTRY+1
-#if defined(CERNLIB_QMVAX)
- IF(IRELAT.NE.0)UNLOCK(UNIT=LUN)
- CALL LIB$WAIT(0.1)
-#endif
- IF(NTRY.LT.100)GO TO 10
- IF(JBYT(IQ(KQSP+LTOP),15,3)-3.GE.-2) WRITE(IQLOG,1000)
- 1000 FORMAT(' RZLLOK. Cannot get locking record')
- IQUEST(1)=1
- GO TO 90
- ENDIF
-*
- NLOCK=IQ(KQSP+LRIN+1)
- IF(NLOCK.LE.0)GO TO 99
- LL=4
- 20 IF(IQ(KQSP+LRIN+LL).NE.0)THEN
- IRD=IQ(KQSP+LRIN+LL+4)
- CALL ZITOH(IQ(KQSP+LRIN+LL+1),KHL,2)
- IDTIME=IQ(KQSP+LRIN+LL+3)
- CALL RZDATE(IDTIME,IDATE,ITIME,1)
- NLEVEL=11
- 30 NLEVEL=NLEVEL-1
- CALL RZIODO(LUN,5,IRD,IDIR(1,NLEVEL),1)
- IF(IQUEST(1).NE.0)GO TO 90
- CALL ZITOH(IDIR(1,NLEVEL),IDIR(1,NLEVEL),4)
- IRD=IDIR(5,NLEVEL)
- IF(IRD.GT.0)GO TO 30
-*
- NL=11-NLEVEL
- CALL UCOPY2(IDIR(1,NLEVEL),IDIR(1,1),NL*5)
- DO 40 I=1,NL
- CALL UHTOC(IDIR(1,I),4,CHPAT(I),16)
- 40 CONTINUE
- CALL RZPAFF(CHPAT,NL,CHL)
- WRITE(IQPRNT,2000)KHL,IDATE,ITIME,CHL(1:70)
- 2000 FORMAT(' LOCK-ID < ',2A4,'> on ',
- + I6.6,'/',I4.4,' for directory ',A)
-*
- LL=LL+IQ(KQSP+LRIN+LL)
- GO TO 20
- ENDIF
- 90 CONTINUE
-#if defined(CERNLIB_QMVAX)
- IF(IRELAT.NE.0)UNLOCK(UNIT=LUN)
-#endif
-*
- 99 RETURN
- END
diff --git a/src/packlib/zebra/rz/rzlock.F b/src/packlib/zebra/rz/rzlock.F
deleted file mode 100644
index 08e7194..0000000
--- a/src/packlib/zebra/rz/rzlock.F
+++ /dev/null
@@ -1,233 +0,0 @@
-*
-* $Id: rzlock.F,v 1.2 1996/04/24 17:27:01 mclareni Exp $
-*
-* $Log: rzlock.F,v $
-* Revision 1.2 1996/04/24 17:27:01 mclareni
-* Extend the include file cleanup to dzebra, rz and tq, and also add
-* dependencies in some cases.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:25 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE RZLOCK(CHLOCK)
-*
-************************************************************************
-*
-* To lock the CWD
-* Input:
-* CHLOCK Character variable identifying the owner of the lock (e.g.
-* specifying the name of the user, his computer identifier,...)
-* This parameter is used to avoid two users, who have both the
-* write password for a directory, trying to change it at the
-* same time. CHLOCK is also useful in the case of a system
-* crash while a directory was locked.
-*
-* Called by <USER>
-*
-* Author : R.Brun DD/US/PD
-* Written : 02.05.86
-* Last mod: 04.10.90
-*
-************************************************************************
-#include "zebra/zunit.inc"
-#include "zebra/rzcl.inc"
-#include "zebra/rzclun.inc"
-#include "zebra/rzk.inc"
- CHARACTER*(*) CHLOCK
- DIMENSION IHL(2),KHL(2)
-*
-*-----------------------------------------------------------------------
-*
-#include "zebra/q_jbit.inc"
-#include "zebra/q_jbyt.inc"
-
- IQUEST(1)=0
- IF(LQRS.EQ.0)GO TO 99
- IF(LTOP.EQ.0)GO TO 99
- LOGLV=JBYT(IQ(KQSP+LTOP),15,3)-3
- NCH=LEN(CHLOCK)
- IF(NCH.GT.8)NCH=8
- CALL UCTOH(CHLOCK,IHL,4,NCH)
- IF(NCH.LT.5)CALL VBLANK(IHL(2),1)
- CALL ZHTOI(IHL,IHL,2)
-*
-* Check write permission
-*
-*** IF(JBIT(IQ(KQSP+LCDIR),1).NE.0)THEN
-*** IQUEST(1)=4
-*** IF(LOGLV.GE.-2) WRITE(IQLOG,9010)
-*** 9010 FORMAT(' RZLOCK. No authorisation to write in that directory')
-*** GO TO 99
-*** ENDIF
-*
-* Lock first record
-*
- LRIN = LQ(KQSP+LTOP-7)
- LPURG = LQ(KQSP+LTOP-5)
- LROUT = LQ(KQSP+LTOP-6)
- IF(LRIN.EQ.0)THEN
- CALL MZBOOK(JQPDVS,LRIN,LTOP,-7,'RZIN',0,0,LREC+1,2,-1)
- IQ(KQSP+LRIN-5)=IQ(KQSP+LTOP-5)
- ENDIF
- NWL =50
- NTRY=0
- 10 CALL RZIODO(LUN,NWL,1,IQ(KQSP+LRIN+1),1)
- IF(IQUEST(1).NE.0)GO TO 99
- IF(IQ(KQSP+LRIN+2).GT.NWL)THEN
- NWL=IQ(KQSP+LRIN+2)
- GO TO 10
- ENDIF
- NWL=IQ(KQSP+LRIN+2)
- IQ(KQSP+LTOP+KIRIN)=0
- IF(IQ(KQSP+LRIN+3).NE.0)THEN
- NWL=50
- NTRY=NTRY+1
-#if defined(CERNLIB_QMVAX)
- IF(IRELAT.NE.0)UNLOCK(UNIT=LUN)
- CALL LIB$WAIT(0.1)
-#endif
- IF(NTRY.LT.100.AND.IQUEST(1).EQ.0)GO TO 10
- IF(LOGLV.GE.-2) WRITE(IQLOG,1000)
- 1000 FORMAT(' RZLOCK. Cannot lock that directory')
- IQUEST(1)=1
- GO TO 99
- ENDIF
- IQ(KQSP+LRIN+3)=1
- CALL RZIODO(LUN,MAX(NWL,50),1,IQ(KQSP+LRIN+1),2)
-*
- IQ(KQSP+LRIN+3)=0
- NLOCK=IQ(KQSP+LRIN+1)
- NREC=IQ(KQSP+LTOP+KQUOTA)
- LDC=IQ(KQSP+LCDIR+KLD)
- IRD=IQ(KQSP+LCDIR+LDC+1)
-*
-* Read fresh Top directory
-*
- IF(LTOP.NE.LCDIR)CALL RZRTOP
-*
-* Check that directory is not already locked
-*
- IF(NLOCK.GT.0)THEN
- LL=4
- 20 IF(IQ(KQSP+LRIN+LL).NE.0)THEN
-*
-* Check mother directories
-*
- IMOT=0
- IRCUR=IQ(KQSP+LRIN+LL+4)
- IF(IRCUR.EQ.2.OR.IRCUR.EQ.IRD)IMOT=1
- IF(IMOT.NE.0)THEN
- CALL ZITOH(IQ(KQSP+LRIN+LL+1),KHL,2)
- IF(LOGLV.GE.-2) WRITE(IQLOG,3000)KHL
- 3000 FORMAT(' RZLOCK. Directory already locked by ',2A4)
- IQUEST(1)=2
- GO TO 90
- ELSE
- LL=LL+IQ(KQSP+LRIN+LL)
- GO TO 20
- ENDIF
- ENDIF
- ENDIF
-*
-* Fill 'free' bank with allocated records as a function
-* of quota
-*
- NFREE=0
- NRUSED=IQ(KQSP+LCDIR+KRUSED)
- NDATA=IQ(KQSP+LFREE-1)
- LB=IQ(KQSP+LTOP+KLB)
- IFR=2
- DO 50 I=3,NREC
- LL=4
- 30 NMORE=IQ(KQSP+LRIN+LL)
- IF(NMORE.NE.0)THEN
- ND=IQ(KQSP+LRIN+LL+5)
- DO 40 J=1,ND
- IR1=IQ(KQSP+LRIN+LL+2*J+4)
- IRL=IQ(KQSP+LRIN+LL+2*J+5)
- IF(I.GE.IR1.AND.I.LE.IRL)GO TO 50
- 40 CONTINUE
- LL=LL+NMORE
- GO TO 30
- ENDIF
-*
- IWORD=(I-1)/32+1
- IBIT=I-32*(IWORD-1)
- IF(JBIT(IQ(KQSP+LTOP+LB+2+IWORD),IBIT).EQ.0)THEN
- NRUSED=NRUSED+1
- IF(NRUSED.GT.IQ(KQSP+LCDIR+KQUOTA))GO TO 60
- IF(IQ(KQSP+LFREE+IFR).EQ.0)THEN
- NFREE=NFREE+1
- IQ(KQSP+LFREE+1)=NFREE
- IQ(KQSP+LFREE+IFR)=I
- IQ(KQSP+LFREE+IFR+1)=I
- ELSE
- IF(I.EQ.IQ(KQSP+LFREE+IFR+1)+1)THEN
- NFREE=IQ(KQSP+LFREE+1)
- IF(NFREE.EQ.0)NFREE=1
- IQ(KQSP+LFREE+IFR+1)=I
- ELSE
- NFREE=NFREE+1
- IQ(KQSP+LFREE+1)=NFREE
- IF(2*NFREE+3.GT.NDATA)THEN
- CALL MZPUSH(JQPDVS,LFREE,0,20,'I')
- NDATA=NDATA+20
- ENDIF
- IFR=IFR+2
- IQ(KQSP+LFREE+IFR)=I
- IQ(KQSP+LFREE+IFR+1)=I
- ENDIF
- ENDIF
- ENDIF
- 50 CONTINUE
-*
-* Build new lock
-*
- 60 NMORE=2*NFREE+6
- IF(NFREE.LE.0)THEN
- IF(LOGLV.GE.-2) WRITE(IQLOG,3100)
- 3100 FORMAT(' RZLOCK. Cannot allocate free records -',
- + ' RZ quota for this file has been reached.')
- IQUEST(1)=3
- GO TO 90
- ENDIF
- IF(NWL.EQ.0)NWL=4
- IF(NWL+NMORE.GT.LREC)THEN
- NF=NFREE
- NFREE=(LREC-NWL-6)/2
- IQ(KQSP+LFREE+1)=NFREE
- IF(NFREE.GT.0)THEN
- CALL UCOPY(IQ(KQSP+LFREE+2*NF),IQ(KQSP+LFREE+2*NFREE),2)
- IQ(KQSP+LFREE+2*NFREE+2)=0
- NMORE=2*NFREE+6
- IF(LOGLV.GE.-2) WRITE(IQLOG,4000)
- 4000 FORMAT(' RZLOCK. Cannot allocate all free records')
- ELSE
- IF(LOGLV.GE.-2) WRITE(IQLOG,4100)
- 4100 FORMAT(' RZLOCK. Data base is too fragmented')
- IQUEST(1)=1
- IQ(KQSP+LFREE+1)=0
- GO TO 90
- ENDIF
- ENDIF
- IQ(KQSP+LRIN+NWL)=NMORE
- IQ(KQSP+LRIN+NWL+1)=IHL(1)
- IQ(KQSP+LRIN+NWL+2)=IHL(2)
- IQ(KQSP+LRIN+NWL+3)=0
- CALL RZDATE(IQ(KQSP+LRIN+NWL+3),IDATE,ITIME,2)
- IQ(KQSP+LRIN+NWL+4)=IQ(KQSP+LCDIR+LDC+1)
- CALL UCOPY(IQ(KQSP+LFREE+1),IQ(KQSP+LRIN+NWL+5),2*NFREE+1)
- NWL=NWL+NMORE
- IQ(KQSP+LRIN+NWL)=0
- IQ(KQSP+LRIN+1)=IQ(KQSP+LRIN+1)+1
- IQ(KQSP+LRIN+2)=NWL
-*
-* Reset the lock and write record 1
-*
- 90 CALL RZIODO(LUN,MAX(NWL,50),1,IQ(KQSP+LRIN+1),2)
- IQUEST(10)=IQ(KQSP+LRIN+1)
-*
- 99 RETURN
- END
diff --git a/src/packlib/zebra/rz/rzlogl.F b/src/packlib/zebra/rz/rzlogl.F
deleted file mode 100644
index 48d221e..0000000
--- a/src/packlib/zebra/rz/rzlogl.F
+++ /dev/null
@@ -1,58 +0,0 @@
-*
-* $Id: rzlogl.F,v 1.1.1.1 1996/03/06 10:47:25 mclareni Exp $
-*
-* $Log: rzlogl.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:25 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE RZLOGL(LUN,LOGLEV)
-*
-************************************************************************
-*
-* To set the LOG level
-* Input:
-* LUN Logical unit number for which the logging level has to be set
-* LOGLEV Logging level
-* -3 Suppress all messages
-* -2 Error messages only
-* -1 Terse logging
-* 0 Normal logging: RZFILE, RZEND
-* 1 Log to watch rare events
-* 2 Log to monitor calls
-* 3 Short diagnostics
-* Short dumps to debug user-written output routines
-* 4 Full diagnostics
-* Full dumps to debug user-written output routines
-*
-* Called by <USER>
-*
-* Author : R.Brun DD/US/PD
-* Written : 01.04.86
-* Last mod: 17.11.92 JDS - restrict loglevel to documented range
-* so that only 3 bits are required to store it (15-17)
-*
-************************************************************************
-#include "zebra/zunit.inc"
-#include "zebra/rzcl.inc"
-*
-*-----------------------------------------------------------------------
-*
- IQUEST(1)=0
- IF(LQRS.EQ.0)GO TO 99
- LRZ=LQRS
- 10 IF(LRZ.EQ.0)GO TO 99
- IF(IQ(KQSP+LRZ-5).NE.LUN)THEN
- LRZ=LQ(KQSP+LRZ)
- GO TO 10
- ENDIF
-*
- LOGL = MIN(LOGLEV,4)
- LOGL = MAX(LOGL, -3) + 3
- CALL SBYT(LOGL,IQ(KQSP+LRZ),15,3)
- IF(LOGLEV.GE.0)WRITE(IQLOG,9022)LUN,LOGLEV
- 9022 FORMAT(' RZLOGL. File at LUN=',I6,', Diagnostic log level=',I2)
-*
- 99 RETURN
- END
diff --git a/src/packlib/zebra/rz/rzmake.F b/src/packlib/zebra/rz/rzmake.F
deleted file mode 100644
index 83cb205..0000000
--- a/src/packlib/zebra/rz/rzmake.F
+++ /dev/null
@@ -1,387 +0,0 @@
-*
-* $Id: rzmake.F,v 1.2 1996/04/24 17:27:01 mclareni Exp $
-*
-* $Log: rzmake.F,v $
-* Revision 1.2 1996/04/24 17:27:01 mclareni
-* Extend the include file cleanup to dzebra, rz and tq, and also add
-* dependencies in some cases.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:25 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE RZMAKE(LUNIN,CHDIR,NWKEY,CHFORM,CHTAG,NRECP,CHOPT)
-*
-************************************************************************
-*
-* Routine to create a new RZ file
-* To use an already existing file CALL RZFILE
-* Input:
-* LUNP Logical unit number associated with the RZ file. A FORTRAN
-* OPEN statement must precede the call to RZFILE.
-* Starting address of the memory area which will contain the RZ
-* information ('M' option)
-* CHDIR Character variable specifying the name of the top directory
-* to be associated with unit LUN.
-* NWKEY Number of words associated to a key (maximum 5)
-* CHFORM Character variable describing each element of the key vector
-* 'B' Bit string but not zero
-* 'H' Hollerith (4 characters)
-* 'I' Integer (nonzero)
-* Ex: CHFORM='IIH' for NWKEY=3 and the 2 first keys are integer
-* and the third one is Hollerith
-* CHTAG Character array defined as CHARACTER*8 CHTAG(NWKEY).
-* Each element of the array allows the description of the
-* corresponding element in the key vector with a tag of up to 8
-* characters.
-* NRECP Number of physical records for primary allocation
-* CHOPT Character variable specifying the selected options.
-* medium
-* default
-* Disk
-* 'M' Memory
-* In this case the user must have allocated at least
-* NRECP*LUNP words of memory starting at address LUN.
-* mode
-* default
-* Native mode
-* 'X' Exchange mode
-* other
-* 'F' Format NRECP records (unless 'M')
-* 'C' C I/O (unless 'M')
-* LRECL (words) taken from IQUEST(10)
-* 'N' New format for Cycle information (default is old)
-*
-* Called by <USER>
-*
-* Author : R.Brun DD/US/PD
-* Written : 01.04.86
-* Last mod: 14.09.93 No longer force exchange mode for LINUX
-* : 09.03.94 S.Banerjee (Change in cycle structure)
-* : 30.01.95 J.Shiers. Permit nrecp>65000 for new format
-*
-************************************************************************
-*
-#include "zebra/zunit.inc"
-#include "zebra/zstate.inc"
-#include "zebra/rzcl.inc"
-#include "zebra/rzdir.inc"
-#include "zebra/rzclun.inc"
-#include "zebra/rzk.inc"
-#include "zebra/rzcycle.inc"
-#if defined(CERNLIB_QMVAX)
- CHARACTER*16 CHORG
-#endif
- CHARACTER CHOPT*(*),CHDIR*(*),CHFORM*(*)
- CHARACTER*16 CHTOP
- CHARACTER*(*) CHTAG(*)
- DIMENSION IOPTV(5),IHDIR(2)
- EQUIVALENCE (IOPTM,IOPTV(1)), (IOPTX,IOPTV(2))
- +, (IOPTF,IOPTV(3)), (IOPTC,IOPTV(4))
- +, (IOPTN,IOPTV(5))
-*
-*-----------------------------------------------------------------------
-*
- IQUEST(1)=0
- LOGLV = MIN(NQLOGD,4)
- LOGLV = MAX(LOGLV,-3)
- LUNP = LUNIN
-*
- CALL UOPTC(CHOPT,'MXFCN',IOPTV)
-#if !defined(CERNLIB_QCFIO)
- IF(IOPTC.NE.0) THEN
- WRITE(IQPRNT,*) 'RZMAKE. option C ignored - valid only ',
- + 'for MSDOS, Unix and VMS systems'
- IOPTC = 0
- ENDIF
-#endif
- IMODEX=IOPTX
- IMODEC=IOPTC
- IF(IOPTC.NE.0) LUNP = IQUEST(11)
-#if defined(CERNLIB_FQXISN)
- IMODEX=1
-#endif
-#if defined(CERNLIB_QMLNX)
-C RZfile maked always with Exchange mode for LINUX
-* IMODEX=1
-#endif
- IRELAT=0
-*
-* Check NWKEY and NRECP
-*
- IF(NWKEY.LE.0.OR.NWKEY.GT.KNMAX)THEN
- IF(LOGLV.GE.-2) WRITE(IQLOG,9010)
- 9010 FORMAT(' RZMAKE. NWKEY input value is invalid')
- IQUEST(1) =1
- IQUEST(11)=NWKEY
- GO TO 99
- ENDIF
- IF(NRECP.LT.2.OR.(NRECP.GT.65000.AND.IOPTN.EQ.0))THEN
- IF(LOGLV.GE.-2) WRITE(IQLOG,9011)
- 9011 FORMAT(' RZMAKE. NRECP input value is invalid')
- IQUEST(1) =1
- IQUEST(11)=NRECP
- GO TO 99
- ENDIF
-*
-* Save existing material (if any)
-*
- CALL RZSAVE
-*
-* Find record length (as specified in the OPEN statement)
-*
-* A, Memory option. LUN contains the buffer address
-* and the value of LUNP is the block length
-*
- IF(IOPTM.NE.0)THEN
- LRECP=LUNP
- IF(LRECP.LT.100.OR.LRECP.GT.10000)LRECP=1024
- ELSE
-*
-* B, Standard option DISK. Use information as specified
-* in the Fortran OPEN statement
-*
- IF(IOPTC.EQ.0) THEN
-#if (!defined(CERNLIB_QMVAX))&&(!defined(CERNLIB_QMVDS))
- INQUIRE(UNIT=LUNP,RECL=LRECB)
-#endif
-#if defined(CERNLIB_QMVDS)
- LRECB=4096
-#endif
-#if defined(CERNLIB_QMVAX)
- INQUIRE(UNIT=LUNP,RECL=LRECB,ORGANIZATION=CHORG)
- IF(CHORG.EQ.'RELATIVE')IRELAT=1
-#endif
-*
-#if defined(CERNLIB_RZBYTES)
- LRECP=LRECB/4
-#endif
-#if !defined(CERNLIB_RZBYTES)
- LRECP=LRECB
-#endif
-#if defined(CERNLIB_QMCRY)||defined(CERNLIB_QMCV64)
- IF(IOPTX.EQ.0) THEN
- LRECP=LRECB/8
- ELSE
- LRECP=LRECB/4
- ENDIF
-#endif
- ELSE
-*
-* Take LRECL from IQUEST(10) in case of C I/O option
-*
- LRECP = IQUEST(10)
- ENDIF
- ENDIF
-*
- LUN = LUNP
- IZRECL = LRECP
- IF(LUN.LE.0.AND.IOPTM.EQ.0)THEN
- IF(LOGLV.GE.-2) WRITE(IQLOG,9012)
- 9012 FORMAT(' RZMAKE. LUN input value is invalid')
- IQUEST(1) =1
- IQUEST(11)=LUN
- GO TO 99
- ENDIF
- IF(LRECP.LT.50)THEN
- IF(LOGLV.GE.-2) WRITE(IQLOG,9013)
- 9013 FORMAT(' RZMAKE. LRECP input value less than 50')
- IQUEST(1) =1
- IQUEST(11)=LRECP
- GO TO 99
- ENDIF
- IF(LOGLV.GE.0) WRITE(IQLOG,9014) LUNP,LRECP,CHOPT
- 9014 FORMAT(' RZMAKE. Unit ',I6,' Initializing with LREC=',I6,
- +', OPT= ',A)
- CALL MZSDIV (0,-7)
-*
-* Check if LUN not already defined
-*
- LRZ=LQRS
- 10 IF(LRZ.NE.0)THEN
- IF(IQ(KQSP+LRZ-5).EQ.LUN)THEN
- IF(LOGLV.GE.-2) WRITE(IQLOG,9015)
- 9015 FORMAT(' RZMAKE. Logical unit number already in use')
- IQUEST(1) =1
- IQUEST(11)=LUN
- GO TO 99
- ELSE
- LRZ=LQ(KQSP+LRZ)
- GO TO 10
- ENDIF
- ENDIF
-*
-* First call to RZMAKE, create link area
-*
- IF(LQRS.EQ.0)THEN
- CALL MZLINK(JQPDVS,'RZCL',LTOP,LTOP,LFROM)
- CALL MZBOOK(JQPDVS,LRZ0,LQRS,1,'RZ0 ',2,2,36,2,0)
- IQ(KQSP+LRZ0-5)=0
- ISAVE = 1
- NHPWD = 0
- CALL VBLANK(IHPWD,2)
- ENDIF
- NCHD = LEN(CHDIR)
- IF(NCHD.GT.16)NCHD=16
- CHTOP = CHDIR(1:NCHD)
-*
-* Create control bank
-*
- IDTIME=0
- CALL RZDATE(IDTIME,IDATE,ITIME,2)
- KTAGS = KKDES+(NWKEY-1)/10+1
- NREC = NRECP
- LREC = LRECP
- NWREC = (NREC-1)/32 +1
- NW = 50+NWREC
- NRD = (NW-1)/LREC +1
- NWL = NRD*LREC
- LD = KTAGS+2*NWKEY
- LB = LD+NRD+1
- LS = LB+3+NWREC
- LK = LS
- LF = LS
-*
- CALL MZBOOK (JQPDVS,LTOP,LQRS,1,'RZ ',10,9,NWL,2,0)
-*
-* Disk or memory
-*
- IF(IOPTM.EQ.0)THEN
- IQ(KQSP+LTOP-5) = LUN
-*
-* C I/O?
- IF(IOPTC.NE.0) CALL SBIT1(IQ(KQSP+LTOP),5)
- ELSE
- NMEM=IQ(KQSP+LRZ0)+1
- IQ(KQSP+LRZ0)=NMEM
- IQ(KQSP+LTOP-5)=-NMEM
- IF(2*NMEM.GT.IQ(KQSP+LRZ0-1))THEN
- CALL MZPUSH(JQPDVS,LRZ0,0,10,'I')
- ENDIF
- IQ(KQSP+LRZ0+2*NMEM-1)=LOCF(LUNP)-LOCF(IQ(1))+1
- IQ(KQSP+LRZ0+2*NMEM )=LRECP
- LUN=-NMEM
- ENDIF
-*
-* Pre-format file
-*
- IF((IOPTF.NE.0).AND.(IOPTM.EQ.0))THEN
- DO 100 I=2,NRECP
- 100 CALL RZIODO(LUN,LREC,I,IQ(KQSP+LTOP+1),2)
- IF(IQUEST(1).NE.0)THEN
- IF(LOGLV.GE.-1) WRITE(IQLOG,1000) I-1
- 1000 FORMAT(' RZMAKE. Could only pre-format',I6,' records')
- IQUEST(1)=0
- ENDIF
- ENDIF
-*
-* Write empty record for locks
-*
- CALL RZIODO(LUN,LREC,1,IQ(KQSP+LTOP+1),2)
- IF(IQUEST(1).NE.0) GO TO 99
-*
-* Build top-directory parameters
-*
- CALL SBIT1(IQ(KQSP+LTOP),2)
- CALL VBLANK(IQ(KQSP+LTOP+1),4)
- CALL UCTOH(CHDIR,IQ(KQSP+LTOP+1),4,NCHD)
- CALL ZHTOI(IQ(KQSP+LTOP+1),IQ(KQSP+LTOP+1),4)
-#if defined(CERNLIB_QMVAX)
-*
-* Set ORGANIZATION type
-*
- IF(IRELAT.NE.0)CALL SBIT1(IQ(KQSP+LTOP),4)
-#endif
-*
- NHPWD = 0
- CALL VBLANK(IHPWD,2)
- CALL UCOPY(IHPWD,IQ(KQSP+LTOP+KPW1),2)
- IQ(KQSP+LTOP+KPW1+2) = NCHD
- IF(IMODEX.GT.0)THEN
- CALL SBIT1(IQ(KQSP+LTOP+KPW1+2),12)
- ENDIF
- IQ(KQSP+LTOP+KDATEC) = IDTIME
- IQ(KQSP+LTOP+KDATEM) = IDTIME
- IQ(KQSP+LTOP+KQUOTA) = NREC
- IQ(KQSP+LTOP+KRUSED) = NRD
- IQ(KQSP+LTOP+KWUSED) = NWL
- IF (IOPTN.NE.0) THEN
- WRITE(IQLOG,7001)
- 7001 FORMAT(' RZMAKE. new RZ format selected.',/,
- + ' This file will not be readable with versions',
- + ' of RZ prior to release 94B')
- IQ(KQSP+LTOP+KRZVER) = 1
- ELSE
- IQ(KQSP+LTOP+KRZVER) = 0
- ENDIF
- IQ(KQSP+LTOP+KIP1) = 2
- IQ(KQSP+LTOP+KNFREE) = NWL-LF
- IQ(KQSP+LTOP+KLD) = LD
- IQ(KQSP+LTOP+KLB) = LB
- IQ(KQSP+LTOP+KLS) = LS
- IQ(KQSP+LTOP+KLK) = LK
- IQ(KQSP+LTOP+KLF) = LF
- IQ(KQSP+LTOP+KLC) = NWL+1
- IQ(KQSP+LTOP+KLE) = NWL
- IQ(KQSP+LTOP+KNWKEY) = NWKEY
- IQ(KQSP+LTOP+LD) = NRD
- IQ(KQSP+LTOP+LB) = NWREC
- IQ(KQSP+LTOP+LB+1) = LREC
- IQ(KQSP+LTOP+LB+2) = IDTIME
-*
- NCHF=LEN(CHFORM)
- NCH =LEN(CHTAG(1))
- IF(NCH.GT.8)NCH=8
- DO 20 I=1,NWKEY
- IF(NCH.LT.8)CALL VBLANK(IHDIR,2)
- CALL UCTOH(CHTAG(I),IHDIR,4,NCH)
- CALL UCOPY(IHDIR,IQ(KQSP+LTOP+KTAGS+2*(I-1)),2)
- IFORM=2
- IF(I.LE.NCHF)THEN
- IF(CHFORM(I:I).EQ.'B')IFORM=1
- IF(CHFORM(I:I).EQ.'H')IFORM=3
- IF(CHFORM(I:I).EQ.'A')IFORM=4
- ENDIF
- IKDES=(I-1)/10
- IKBIT1=3*I-30*IKDES-2
- CALL SBYT(IFORM,IQ(KQSP+LTOP+KKDES+IKDES),IKBIT1,3)
- 20 CONTINUE
- CALL ZHTOI(IQ(KQSP+LTOP+KTAGS),IQ(KQSP+LTOP+KTAGS),2*NWKEY)
- DO 30 I=1,NRD
- IQ(KQSP+LTOP+LD+I)=I+1
- CALL SBIT1(IQ(KQSP+LTOP+LB+3),I+1)
- 30 CONTINUE
-*
-* Store default LOG level
-*
- LOGL = LOGLV + 3
- CALL SBYT(LOGL,IQ(KQSP+LTOP),15,3)
- CALL RZVCYC(LTOP)
-*
-* Allocate free records
-*
- CALL MZBOOK(JQPDVS,LFREE,LTOP,-2,'RZFR',0,0,3,2,0)
- IQ(KQSP+LFREE-5)=LUN
- IQ(KQSP+LFREE+1)=1
- IQ(KQSP+LFREE+2)=NRD+2
- IQ(KQSP+LFREE+3)=NREC
-*
-* Allocate space for used records
-*
- CALL MZBOOK(JQPDVS,LUSED,LTOP,-3,'RZUS',0,0,21,2,0)
-*
- IQ(KQSP+LUSED-5)=LUN
- LRIN = 0
- LPURG = 0
- LROUT = 0
- LCDIR = LTOP
- NLCDIR= 1
- NLNDIR= 1
- NLPAT = 1
- CHCDIR(1)=CHTOP
- CHNDIR(1)=CHTOP
- IQUEST(1)=0
-*
- 99 RETURN
- END
diff --git a/src/packlib/zebra/rz/rzmdir.F b/src/packlib/zebra/rz/rzmdir.F
deleted file mode 100644
index b279795..0000000
--- a/src/packlib/zebra/rz/rzmdir.F
+++ /dev/null
@@ -1,223 +0,0 @@
-*
-* $Id: rzmdir.F,v 1.2 1996/04/24 17:27:02 mclareni Exp $
-*
-* $Log: rzmdir.F,v $
-* Revision 1.2 1996/04/24 17:27:02 mclareni
-* Extend the include file cleanup to dzebra, rz and tq, and also add
-* dependencies in some cases.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:25 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE RZMDIR(CHDIR,NWKEY,CHFORM,CHTAG)
-*
-************************************************************************
-*
-* To create a subdirectory of the CWD
-* Input:
-* CHDIR Character variable specifying the name of the directory to be
-* created. All characters, but / \ * ~ ? are allowed in a
-* directory name.
-* NWKEY Number of words associated to a key (maximum 5)
-* CHFORM Character variable describing each element of the key vector
-* 'B' Bit string but not zero
-* 'H' Hollerith (4 characters)
-* 'A' same as 'H' but RZLDIR
-* 'I' Integer (nonzero)
-* Ex: CHFORM='IIH' for NWKEY=3 and the 2 first keys are integer
-* and the third one is Hollerith
-* CHTAG Character array defined as CHARACTER*8 CHTAG(NWKEY).
-* Each element of the array allows the description of the
-* corresponding element in the key vector with a tag of up to 8
-* characters.
-*
-* Called by <USER>
-*
-* Author : R.Brun DD/US/PD
-* Written : 03.04.86
-* Last mod: 24.06.92 JDS - protection against invalid directory names
-* : 04.03.94 S.Banerjee (Change in cycle structure)
-*
-************************************************************************
-#include "zebra/zunit.inc"
-#include "zebra/rzcl.inc"
-#include "zebra/rzclun.inc"
-#include "zebra/rzk.inc"
-#include "zebra/rzcycle.inc"
- CHARACTER*(*) CHDIR,CHFORM,CHTAG(*)
- DIMENSION IHDIR(4)
- LOGICAL RZSAME
-*
-*-----------------------------------------------------------------------
-*
-#include "zebra/q_jbyt.inc"
- IQUEST(1)=0
- IF(LQRS.EQ.0)GO TO 99
-*
- NCD=LENOCC(CHDIR)
- IF(NCD.GT.16)NCD=16
-*
-* Check directory name
-*
- IF(NCD.EQ.0) THEN
- IQUEST(1) = 2
- GOTO 99
- ENDIF
-
- JX = ICLUNS(CHDIR,1,NCD)
- IF(JX.GT.0) THEN
- IQUEST(1) = 3
- GOTO 99
- ENDIF
-
- CALL VBLANK(IHDIR,4)
- CALL UCTOH(CHDIR,IHDIR,4,NCD)
- CALL ZHTOI(IHDIR,IHDIR,4)
- LOGLV=JBYT(IQ(KQSP+LTOP),15,3)-3
-*
-* Check NWKEY.LE.KNMAX
-*
- IF(NWKEY.LE.0.OR.NWKEY.GT.KNMAX)THEN
- IF(LOGLV.GE.-2) WRITE(IQLOG,1000)
- 1000 FORMAT(' RZMDIR. NWKEY input value is invalid')
- IQUEST(1) =1
- IQUEST(11)=NWKEY
- GO TO 99
- ENDIF
-*
-* Check if subdirectory already exists
-*
- LS = IQ(KQSP+LCDIR+KLS)
- NSDIR=IQ(KQSP+LCDIR+KNSD)
- IF(NSDIR.GT.0)THEN
- DO 5 I=1,NSDIR
- IF(RZSAME(IHDIR,IQ(KQSP+LCDIR+LS+7*(I-1)),4))THEN
- IF(LOGLV.GE.-2) WRITE(IQLOG,2000) CHDIR
- 2000 FORMAT(' RZMDIR. Already existing directory ',A)
- IQUEST(1)=4
- GO TO 99
- ENDIF
- 5 CONTINUE
- ENDIF
-*
-* Check if WRITE permission
-*
- IFLAG=0
- CALL RZMODS('RZMDIR',IFLAG)
- IF(IFLAG.NE.0)GO TO 99
-*
-* Check if enough space. Increase directory size by LREC
-* if required.
-*
- NWFREE=IQ(KQSP+LCDIR+KNFREE)
- IF(NWFREE.LT.8)THEN
- CALL RZEXPD('RZMDIR',40)
- ENDIF
-*
-* Allocate record for new directory
-*
- CALL RZALLO('RZMDIR',1,IRNEXT)
- IF(IRNEXT.LE.0)GO TO 99
-*
-* Insert new directory name into S, Move K
-*
- LD = IQ(KQSP+LCDIR+KLD)
- LK = IQ(KQSP+LCDIR+KLK)
- LF = IQ(KQSP+LCDIR+KLF)
- CALL UCOPY2(IQ(KQSP+LCDIR+LK),IQ(KQSP+LCDIR+LK+7),LF-LK)
- CALL UCOPY(IHDIR,IQ(KQSP+LCDIR+LK),4)
- IQ(KQSP+LCDIR+LK+4)=NCD
- IF (KVSCYC.EQ.0) THEN
- IQ(KQSP+LCDIR+LK+5)=IRNEXT+2**18
- ELSE
- IQ(KQSP+LCDIR+LK+5)=IRNEXT
- ENDIF
- IDTIME=0
- CALL RZDATE(IDTIME,IDATE,ITIME,2)
- IQ(KQSP+LCDIR+LK+6)=IDTIME
- LK=LK+7
- LF=LF+7
-*
- NSDIR=NSDIR+1
- IQ(KQSP+LCDIR+KNFREE)=IQ(KQSP+LCDIR+KNFREE)-7
- IQ(KQSP+LCDIR+KNSD)=NSDIR
- IQ(KQSP+LCDIR+KLK)=LK
- IQ(KQSP+LCDIR+KLF)=LF
-*
-* Create the subdirectory bank
-*
- CALL MZBOOK(JQPDVS,LSDIR,LCDIR,-1,'RZ ',2,1,LREC,2,0)
-*
- CALL UCOPY(IHDIR,IQ(KQSP+LSDIR+1),4)
- KTAGS=KKDES+(NWKEY-1)/10+1
- LDS=KTAGS+2*NWKEY
- LBS=LDS+2
- IQ(KQSP+LSDIR+KUP) = IQ(KQSP+LCDIR+LD+1)
- IQ(KQSP+LSDIR+KPW1) = IHPWD(1)
- IQ(KQSP+LSDIR+KPW1+1) = IHPWD(2)
- IQ(KQSP+LSDIR+KPW1+2) = NCD
- CALL SBYT(NHPWD,IQ(KQSP+LSDIR+KPW1+2),6,5)
- IF(IMODEX.GT.0)THEN
- CALL SBIT1(IQ(KQSP+LSDIR+KPW1+2),12)
- ENDIF
- IQ(KQSP+LSDIR+KDATEC) = IDTIME
- IQ(KQSP+LSDIR+KDATEM) = IDTIME
- IQ(KQSP+LSDIR+KQUOTA) = IQ(KQSP+LCDIR+KQUOTA)-5
- IQ(KQSP+LSDIR+KRUSED) = IQ(KQSP+LSDIR+13)+1
- IQ(KQSP+LSDIR+KWUSED) = IQ(KQSP+LSDIR+14)+LREC
- IQ(KQSP+LSDIR+KRZVER) = KVSCYC
- IQ(KQSP+LSDIR+KIP1) = 1
- IQ(KQSP+LSDIR+KNFREE) = LREC-LBS
- IQ(KQSP+LSDIR+KLD) = LDS
- IQ(KQSP+LSDIR+KLB) = LBS
- IQ(KQSP+LSDIR+KLS) = LBS
- IQ(KQSP+LSDIR+KLK) = LBS
- IQ(KQSP+LSDIR+KLF) = LBS
- IQ(KQSP+LSDIR+KLC) = LREC+1
- IQ(KQSP+LSDIR+KLE) = LREC
- IQ(KQSP+LSDIR+KNWKEY) = NWKEY
- IQ(KQSP+LSDIR+LDS) = 1
- IQ(KQSP+LSDIR+LDS+1) = IRNEXT
-*
- IF(CHFORM(1:1).NE.'?')THEN
- NCHF=LEN(CHFORM)
- NCH =LEN(CHTAG(1))
- IF(NCH.GT.8)NCH=8
- DO 30 I=1,NWKEY
- IF(NCH.LT.8)CALL VBLANK(IHDIR,2)
- CALL UCTOH(CHTAG(I),IHDIR,4,NCH)
- CALL UCOPY(IHDIR,IQ(KQSP+LSDIR+KTAGS+2*(I-1)),2)
- IF(I.LE.NCHF)THEN
- IF(CHFORM(I:I).EQ.'B')IFORM=1
- IF(CHFORM(I:I).EQ.'I')IFORM=2
- IF(CHFORM(I:I).EQ.' ')IFORM=2
- IF(CHFORM(I:I).EQ.'H')IFORM=3
- IF(CHFORM(I:I).EQ.'A')IFORM=4
- ENDIF
- IKDES=(I-1)/10
- IKBIT1=3*I-30*IKDES-2
- CALL SBYT(IFORM,IQ(KQSP+LSDIR+KKDES+IKDES),IKBIT1,3)
- 30 CONTINUE
- CALL ZHTOI(IQ(KQSP+LSDIR+KTAGS),IQ(KQSP+LSDIR+KTAGS),2*NWKEY)
- ENDIF
-*
-* Write new directory on file
-*
- CALL RZIODO(LUN,LREC,IRNEXT,IQ(KQSP+LSDIR+1),2)
- IF(IQUEST(1).NE.0)THEN
- CALL SBIT0(IQ(KQSP+LCDIR),2)
- CALL MZDROP(JQPDVS,LSDIR,' ')
- GO TO 99
- ENDIF
-*
- CALL SBIT1(IQ(KQSP+LSDIR),2)
- CALL SBIT1(IQ(KQSP+LSDIR),IQDROP)
-*
-* Mark records effectively used
-*
- CALL RZUSED(1,IRNEXT)
-*
- 99 RETURN
- END
diff --git a/src/packlib/zebra/rz/rzmods.F b/src/packlib/zebra/rz/rzmods.F
deleted file mode 100644
index 7230fb6..0000000
--- a/src/packlib/zebra/rz/rzmods.F
+++ /dev/null
@@ -1,73 +0,0 @@
-*
-* $Id: rzmods.F,v 1.2 1996/04/24 17:27:03 mclareni Exp $
-*
-* $Log: rzmods.F,v $
-* Revision 1.2 1996/04/24 17:27:03 mclareni
-* Extend the include file cleanup to dzebra, rz and tq, and also add
-* dependencies in some cases.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:25 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE RZMODS(CHROUT,IFLAG)
-*
-************************************************************************
-*
-* Check if directory can be modified
-* Enter directory in the list of modified directories
-* Input:
-* CHROUT Name of the calling routine
-* Output:
-* IFLAG Status flag =0 if OK 1 otherwise
-*
-* Called by RZCOPY,RZDELK,RZDELT,RZMDIR,RZOUT,RZPASS,RZPURG,RZQUOT,RZVOUT
-*
-* Author : R.Brun DD/US/PD
-* Written : 02.04.86
-* Last mod: 04.10.90
-*
-************************************************************************
-#include "zebra/zunit.inc"
-#include "zebra/rzcl.inc"
-#include "zebra/rzdir.inc"
- CHARACTER*255 CHPATH
- CHARACTER*6 CHROUT
-*
-*-----------------------------------------------------------------------
-*
-#include "zebra/q_jbit.inc"
-#include "zebra/q_jbyt.inc"
-
-*
-* Check permission
-*
- IF(JBIT(IQ(KQSP+LCDIR),1).NE.0)GO TO 90
- IF(IFLAG.EQ.0)THEN
- IF(LFREE.EQ.0)GO TO 90
- IF(IQ(KQSP+LFREE+1).EQ.0)GO TO 90
- ELSE
- IFLAG=0
- ENDIF
-*
- CALL SBIT1(IQ(KQSP+LCDIR),2)
- CALL SBIT1(IQ(KQSP+LTOP),2)
- GO TO 99
-*
- 90 CONTINUE
-*
-* Get current directory name
-*
- CALL RZPAFF(CHPAT,NLPAT,CHPATH)
- LPATH = LENOCC(CHPATH)
- IF(JBYT(IQ(KQSP+LTOP),15,3)-3.GE.-2) THEN
- WRITE(IQLOG,1000)CHROUT
- WRITE(IQLOG,*) '(',CHPATH(1:LPATH),')'
- ENDIF
- IFLAG=1
- IQUEST(1)=3
- 1000 FORMAT(1X,A,'. No authorisation to write in that directory')
-*
- 99 RETURN
- END
diff --git a/src/packlib/zebra/rz/rzndir.F b/src/packlib/zebra/rz/rzndir.F
deleted file mode 100644
index 3bcde38..0000000
--- a/src/packlib/zebra/rz/rzndir.F
+++ /dev/null
@@ -1,73 +0,0 @@
-*
-* $Id: rzndir.F,v 1.1.1.1 1996/03/06 10:47:25 mclareni Exp $
-*
-* $Log: rzndir.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:25 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE RZNDIR(CHPATH,CHOPT)
-*
-************************************************************************
-*
-* To set,read or print the naming directory
-* Input:
-* *CHPATH* Character variable specifying the complete pathname of the
-* naming directory ('S' option)
-* CHOPT Character variable specifying the option
-* 'R' Read the naming directory pathname into CHPATH
-* 'P' Print the naming directory
-* ' ' Set the naming directory to the path specified in
-* CHPATH
-* Output:
-* *CHPATH* Character variable containing the complete pathname of the
-* naming directory (default option).
-*
-* Called by <USER>
-*
-* Author : R.Brun DD/US/PD
-* Written : 01.04.86
-* Last mod: 01.04.86
-*
-************************************************************************
-#include "zebra/zunit.inc"
-#include "zebra/rzcl.inc"
-#include "zebra/rzdir.inc"
-#include "zebra/rzch.inc"
- DIMENSION IOPTV(2)
- EQUIVALENCE (IOPTR,IOPTV(1)), (IOPTP,IOPTV(2))
- CHARACTER*(*) CHPATH,CHOPT
-*
-*-----------------------------------------------------------------------
-*
- IQUEST(1)=0
- IF(LQRS.EQ.0)GO TO 99
- CALL UOPTC (CHOPT,'RP',IOPTV)
-*
-* Read Naming directory
-*
- IF(IOPTR.NE.0)THEN
- CALL RZPAFF(CHNDIR,NLNDIR,CHPATH)
- GO TO 99
- ENDIF
-*
-* Print Naming directory
-*
- IF(IOPTP.NE.0)THEN
- CALL RZPAFF(CHNDIR,NLNDIR,CHL)
- WRITE(IQPRNT,1000)CHL(1:90)
- 1000 FORMAT(' Naming Directory = ',A)
- GO TO 99
- ENDIF
-*
-* Set Naming directory
-*
- CALL RZPATH(CHPATH)
- NLNDIR= NLPAT
- DO 10 I=1,NLPAT
- CHNDIR(I)=CHPAT(I)
- 10 CONTINUE
-*
- 99 RETURN
- END
diff --git a/src/packlib/zebra/rz/rzobkn.F b/src/packlib/zebra/rz/rzobkn.F
deleted file mode 100644
index 565fdfd..0000000
--- a/src/packlib/zebra/rz/rzobkn.F
+++ /dev/null
@@ -1,131 +0,0 @@
-*
-* $Id: rzobkn.F,v 1.1.1.1 1996/03/06 10:47:25 mclareni Exp $
-*
-* $Log: rzobkn.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:25 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE RZOBKN
-*
-************************************************************************
-*
-* RZ internal routine to write data according to internal table
-* previously built by FZOTAB
-*
-* Called by RZOUT
-*
-* Author : J.Zoll,R.Brun,B.Holl
-* Written : 03.05.86
-* Last mod: 25.06.93 JDS Add IEVENT to RZWRT calls
-*
-************************************************************************
-#include "zebra/mqsys.inc"
-#include "zebra/mzct.inc"
-#include "zebra/mzcn.inc"
-#include "zebra/mzioc.inc"
-#include "zebra/fzcx.inc"
-#include "zebra/rzclun.inc"
-*
-*-----------------------------------------------------------------------
-*
-* New event
-*
- IEVENT = 0
-*
-* Write NWTABX,NWBKX,LENTRX
-*
-#if !defined(CERNLIB_FQXISN)
- IF(IMODEX.GT.0)THEN
- MFO(1) = 1
- MFO(2) = -1
- JFOEND = 2
- ENDIF
-#endif
- CALL RZWRT(NWTABX,3,0,IEVENT)
- IF(IQUEST(1).NE.0) GO TO 99
-*
-* Event continued
-*
- IEVENT = 1
-*
-* Write memory description table
-*
- IF(NWTABX.GT.0)THEN
- CALL RZWRT(LQ(LQTA),NWTABX,0,IEVENT)
- IF(IQUEST(1).NE.0) GO TO 99
- ENDIF
-*
-* Write bank material
-*
- LTB = LQTA
- 10 L = LQ(LTB)
- LE = LQ(LTB+1)
-#if !defined(CERNLIB_FQXISN)
- IF(IMODEX.LE.0)GO TO 50
-*
-* in eXchange format
-*
- 20 IQLN= L
- IWD = LQ(KQS+L)
- NST = JBYT(IWD,1,16) - 12
- IF(NST.LT.0)GO TO 40
-*
-* True bank
-*
- IQLS = L + NST + 1
- IQNIO = JBYT(IQ(KQS+IQLS),19,4)
- IQNL = IQ(KQS+IQLS-3)
- IQND = IQ(KQS+IQLS-1)
- IQNX = IQLS + IQND + 9
-*
-* First word, I/O words, links, next-link, up-link
-*
- N = IQNIO + IQNL
- MFO(1) = 1
- MFO(2) = N + 3
- MFO(3) = 2
- MFO(4) = 2
- MFO(5) = 5
- MFO(6) = 1
- MFO(7) = 1
- MFO(8) = -1
- JFOEND = 8
- CALL RZWRT(LQ(KQS+L),N+10,0,IEVENT)
- IF(IQUEST(1).NE.0) GO TO 99
-*
-* Data words
-*
- IF( IQND .NE. 0 ) THEN
- CALL MZIOCR(LQ(KQS+IQLN))
- IF(IQUEST(1).LT.0)GO TO 99
- IQUEST(1)=0
- CALL RZWRT(IQ(KQS+IQLS+1),IQND,0,IEVENT)
- IF(IQUEST(1).NE.0) GO TO 99
- ENDIF
- 30 L = IQNX
- IF(L.LT.LE) GO TO 20
- LTB = LTB + 2
- IF(LTB.LT.LQTE) GO TO 10
- GO TO 99
-*
-* Short dead region
-*
- 40 NWD = NST + 12
- IQNX= L + NWD
- GO TO 30
-#endif
-*
-* in Native mode
-*
- 50 N = LE - L
- IF(N.GT.0)THEN
- CALL RZWRT(LQ(KQS+L),N,0,IEVENT)
- IF(IQUEST(1).NE.0) GO TO 99
- ENDIF
- LTB = LTB + 2
- IF(LTB.LT.LQTE)GO TO 10
-*
- 99 RETURN
- END
diff --git a/src/packlib/zebra/rz/rzopen.F b/src/packlib/zebra/rz/rzopen.F
deleted file mode 100644
index 8f1916d..0000000
--- a/src/packlib/zebra/rz/rzopen.F
+++ /dev/null
@@ -1,867 +0,0 @@
-*
-* $Id: rzopen.F,v 1.10 2003/05/05 16:01:25 cernsoft Exp $
-*
-* $Log: rzopen.F,v $
-* Revision 1.10 2003/05/05 16:01:25 cernsoft
-* Prevent fetch from out of bounds in scan record length
-*
-* Revision 1.9 1999/10/05 14:24:55 couet
-* - new error message
-*
-* Revision 1.8 1999/05/07 15:26:30 mclareni
-* Enable the call to CFSTAT for WNT also, thus allowing rfio
-*
-* Revision 1.7 1998/09/25 09:33:41 mclareni
-* Modifications for the Mklinux port flagged by CERNLIB_PPC
-*
-* Revision 1.6 1997/09/02 15:16:13 mclareni
-* WINNT corrections
-*
-* Revision 1.5 1997/03/14 17:21:20 mclareni
-* WNT mods
-*
-* Revision 1.4 1997/01/15 17:41:16 cernlib
-* disable section calling rzstrip
-*
-* Revision 1.3 1996/10/17 09:35:04 cernlib
-* make cfstat an integer function
-*
-* Revision 1.2 1996/10/16 13:02:53 cernlib
-* Use CFSTAT with CFIO instead of STATF (for RFIO)
-*
-* Revision 1.1.1.1 1996/03/06 10:47:25 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE RZOPEN(LUNIN,CHDIR,CFNAME,CHOPTT,LRECL,ISTAT)
-*
-************************************************************************
-*
-* Open a ZEBRA/RZ file.
-*
-* Input:
-* LUNIT Logical unit number
-* CFNAME File name
-* CHOPT Character variable specifying the option
-* ' ' default, open file in readonly mode
-* 'L' create file with relative organization (VAX only)
-* 'N' open a new file
-* 'S' open file in shared readonly mode
-* 'U' open file in update mode
-* 'SU' open file in shared update mode
-* '1' open file read/write assume single user
-* 'V' open new RZ file on VSAM file
-* 'W' return in CHDIR directory name include
-* logical unit number
-* 'Y' suppress LRECL consistency check
-* 'P' Preserve case of file name (Unix)
-* 'C' Use C I/O (Unix, VMS)
-* 'X' Exchange mode file
-*
-* *LRECL* Record length, if zero determine LRECL from input file
-*
-* Output:
-* CHDIR Character string containing decoded logical unit number
-* *LRECL* Determined record length
-* ISTAT Status return code
-* IQUEST(10) LRECL
-* IQUEST(11) LUNPTR - C I/O pointer
-* IQUEST(12) Exchange mode flag - set if IOPTX.ne.0
-* or if exchange mode bit is set in file
-*
-*
-* Called by <USER>
-*
-* Author : R.Brun,J.Shiers
-* Written : 03.05.86
-* Last mod: See below
-*
-* Changes Date Comments
-* G.Folger 96/10/16 Use CFSTAT with CFIO instead of STATF (for RFIO)
-* V.Fine 96/07/30 Disable using C I/O to check Fortran I/O under Windows NT
-* J.Shiers 95/06/20 Warning for auto-recl determination only for >8192
-* J.Shiers 95/05/24 Use STATF instead of INQUIRE in case of IOPTC
-* J.Shiers 94/09/21 Increase chopt, correct LUN string
-* F.Rademakers 94/08/29 Added protection in case CFOPEN fails (no read perm).
-* Return correct LUN string in case of option W and
-* C I/O. Print correct error message in case user
-* opens file with wrong LRECL.
-* J.Shiers 94/08/18 Increase buffer from 8192 to 8192+512
-* to permit record length determination upto 8192
-* R.Brun 94/06/10 Introduce file striping for PIAF
-* New routine RZSTRIP called
-* J.Shiers 94/05/18 Add QMDOS flag for parameter NWORD
-* V.Fine 94/02/07 DEC flag to use DEC Fortran and Windows/NT
-* A.Lomov 93/09/14 No longer force exchange mode for LINUX
-* J.Shiers 93/06/30 Set IQUEST(12) to IMODEX
-* J.Shiers 93/02/15 Set IMODEH to 0
-* J.Shiers 92/10/19 Alpha compatible record length determination
-* J.Shiers 92/07/13 QMDOS, QCFIO flags
-* J.Shiers 92/07/07 Translate filename to uppercase before VMQFIL
-* J.Shiers 92/03/03 Incorporate MVS mods as follows:
-* J.Shiers 92/02/26 Use VMQFIL on VM systems to determine record length
-* J.Shiers 92/02/21 Mods for DESY (length of prefix)
-* J.Shiers 91/11/27 Add ACTION=READ/READWRITE in VM open statements
-* J.Shiers 91/11/11 Add C I/O support
-* M.Marquina 91/06/26 Integrate MVS version
-#if defined(CERNLIB_IBMMVS)
-* IBMMVS changes:
-* - IUNIT auf 33XX fuer GSI
-* - VSAM Option fuer MVS (OPT V) (VSAM Relative record dataset)
-* To use this option, a dataclass RZFILE must be defined via
-* SMS with appropriate parameters for default size and extends.
-* at GSI we use also a dataclass RZDATA for larger files. These
-* files contain a .RZDATA in their name.
-* At GSI we use the following definitions for SMS :
-*
-* DATACLAS STORCLAS MGMTCLAS STORGRP RECORG SPACE
-*
-* RZFILE(def) STANDARD USERDATA NORMALx VSAM RR 128,128
-* RZDATA RAWDATA RAWDATA RAWDATA VSAM RR 512,512
-*
-*
-#endif
-************************************************************************
-#include "zebra/zunit.inc"
-#include "zebra/rzckey.inc"
-#include "zebra/rzclun.inc"
-#include "zebra/quest.inc"
-#include "zebra/rzbuff.inc"
-#if defined(CERNLIB_QMUIX)
-#include "zebra/rzcstr.inc"
-#endif
-#if defined(CERNLIB_QMCRY)||defined(CERNLIB_QMCV64)||defined(CERNLIB_QMAPO)||defined(CERNLIB_QMAPO9)||defined(CERNLIB_QMUIX)||defined(CERNLIB_WINNT)
- integer cfstat,statf,info(12)
-#endif
- CHARACTER*(*) CFNAME,CHDIR,CHOPTT
- CHARACTER*9 SPACES
- CHARACTER*8 STAT
- CHARACTER*36 CHOPT
- CHARACTER*255 CHFILE
- LOGICAL IEXIST
- CHARACTER*4 CHOPE
-#if defined(CERNLIB_IBMVM)
- CHARACTER*13 CHTIME
- CHARACTER*1 RECFM
-#endif
-#if defined(CERNLIB_QMVAX)
- CHARACTER*10 CHORG
-#endif
-#if defined(CERNLIB_QMCRY)||defined(CERNLIB_QMCVX)||defined(CERNLIB_QMIRT)||defined(CERNLIB_QMIBM)||defined(CERNLIB_QMSGI)||defined(CERNLIB_QMVMI)||defined(CERNLIB_QMSUN)||defined(CERNLIB_QMALT)||defined(CERNLIB_QMHPX)||defined(CERNLIB_QMIBX)
- PARAMETER (NWORD = 8704)
-#endif
-#if (defined(CERNLIB_QMAPO)||defined(CERNLIB_QMVAX)||defined(CERNLIB_QMNXT)||defined(CERNLIB_QMLNX))&&(!defined(CERNLIB_QMAPO9))
- PARAMETER (NWORD = 8704)
-#endif
-#if defined(CERNLIB_QMDOS) || defined(CERNLIB_WINNT)
- PARAMETER (NWORD = 8704)
-#endif
-#if defined(CERNLIB_QMCRY)||defined(CERNLIB_QMCV64)
- PARAMETER (IBYTES=8)
-#endif
-#if defined(CERNLIB_QMCRY)
- DIMENSION IBUFF(8704)
-#endif
-#if defined(CERNLIB_QMVAX)||defined(CERNLIB_QMSGI)||defined(CERNLIB_QMVMI)||(defined(CERNLIB_QFDEC))
- PARAMETER (IBYTES=1)
-#endif
-#if (!defined(CERNLIB_QMCRY))&&(!defined(CERNLIB_QMCV64))&&(!defined(CERNLIB_QMVAX))&&(!defined(CERNLIB_QMSGI))&&(!defined(CERNLIB_QMVMI))&&(!defined(CERNLIB_QFDEC))
- PARAMETER (IBYTES=4)
-#endif
-#if defined(CERNLIB_QMIBM)
- CHARACTER*9 CHACT
-#endif
-#if defined(CERNLIB_QMIBMFVS)
- CHARACTER*5 CHREC
- CHARACTER*3 CHLUN
-#endif
-#if defined(CERNLIB_IBMMVS)
- CHARACTER*20 PREFIX
- CHARACTER*4 IUNIT, ITRK, IRECFM
- CHARACTER*8 cRecl
- CHARACTER*256 cTSO
- CHARACTER*20 cDataClas
-* dummy record for VSAM
- INTEGER RECORD(2048) /2048*0/
- INTEGER mvsams, kdffil
- LOGICAL*4 EXS, OPN
- INTEGER*4 ISPACE(3), IDCB(2)
-*
- DATA ISPACE / 30, 0, 0 /
- DATA IDCB / 4096, 0 /
- DATA ITRK / 'TRK' /, IRECFM / 'F' /
-#endif
-#if (defined(CERNLIB_IBMMVS))&&(!defined(CERNLIB_NEWLIB))&&(!defined(CERNLIB_GSI))
- DATA IUNIT / 'HSM' /
-#endif
-#if (defined(CERNLIB_IBMMVS))&&(!defined(CERNLIB_NEWLIB))&&(defined(CERNLIB_GSI))
- DATA IUNIT / '33XX' /
-#endif
-#if (defined(CERNLIB_IBMMVS))&&(defined(CERNLIB_NEWLIB))
- DATA IUNIT / 'FAST' /
-#endif
-*
-*-----------------------------------------------------------------------
-*
- CHOPT=CHOPTT
- CALL CLTOU(CHOPT)
-
- IOPT1=INDEX(CHOPT,'1')
- IOPTC=INDEX(CHOPT,'C')
- IOPTL=INDEX(CHOPT,'L')
- IOPTN=INDEX(CHOPT,'N')
- IOPTS=INDEX(CHOPT,'S')
- IOPTP=INDEX(CHOPT,'P')
- IOPTU=INDEX(CHOPT,'U')
- IOPTV=INDEX(CHOPT,'V')
- IOPTW=INDEX(CHOPT,'W')
- IOPTX=INDEX(CHOPT,'X')
- IOPTY=INDEX(CHOPT,'Y')
-
- LUNIT=LUNIN
- IQUEST(10) = 0
- IQUEST(11) = 0
- IQUEST(12) = 0
- IMODEC = IOPTC
- IMODEX = IOPTX
-
- LRECI = LRECL
- LRECL2 = 0
-#if (defined(CERNLIB_QMLNX) && !defined(CERNLIB_PPC))
-C RZfile with Exchange mode for NonPPC-LINUX
-* IMODEX = 1
-#endif
- IMODEH = 0
-#if !defined(CERNLIB_QCFIO)
-*SELF,IF=-QMCRY,IF=-QMVAX,IF=-QMCV64,IF=-QMAPO,IF=-QMAPO9,IF=-QMUIX,IF=-QMDOS.
- IF(IOPTC.NE.0) THEN
- WRITE(IQPRNT,*) 'RZOPEN. option C ignored - valid only ',
- + 'for MSDOS, Unix and VMS systems'
- IOPTC = 0
- ENDIF
-#endif
-#if !defined(CERNLIB_QMIBMFVS)
- CHFILE=CFNAME
-#endif
-#if (defined(CERNLIB_QMIBMFVS))&&(!defined(CERNLIB_IBMMVS))
- CHFILE='/'//CFNAME
-*
-* Search all disks if filemode not specified
-*
- LCHF = LENOCC(CHFILE)
- CALL CTRANS('.',' ',CHFILE,1,LCHF)
- IF(INDEX(CHFILE(1:LCHF),' ').EQ.INDEXB(CHFILE(1:LCHF),' '))
- + CHFILE = CHFILE(1:LCHF) // ' *'
-#endif
-#if (defined(CERNLIB_QMIBMFVS))&&(defined(CERNLIB_IBMMVS))
-*-- Construct MVS file name
-*-- Don't add prefix if the first character of file name is a dot
- CALL KPREFI (PREFIX, NCHPRE)
- IF ( CFNAME(1:1) .EQ. '.' ) THEN
- NCH = LEN(CFNAME)
- CHFILE = '/'//CFNAME(2:NCH)
- ELSE
- CHFILE = '/'//PREFIX(1:NCHPRE)//CFNAME
- ENDIF
-#endif
-#if defined(CERNLIB_QMCRY)||defined(CERNLIB_QMCVX)||defined(CERNLIB_QMAPO)||defined(CERNLIB_QMAPO9)||defined(CERNLIB_QMUIX)||defined(CERNLIB_QMDOS)||defined(CERNLIB_QMLNX)||defined(CERNLIB_WINNT)
- IF(IOPTP.EQ.0)CALL CUTOL(CHFILE)
-#endif
-#if defined(CERNLIB_QMVAX)
- IF(IOPTL.NE.0) THEN
- CHORG = 'RELATIVE'
- ELSE
- CHORG = 'SEQUENTIAL'
- ENDIF
-#endif
- IPASS=0
- kstrip=0
- 10 CONTINUE
- IF(IOPTN.NE.0)THEN
-#if !defined(CERNLIB_QMVAX)
- STAT='UNKNOWN'
-#endif
-#if defined(CERNLIB_QMVAX)
- STAT='NEW'
-#endif
- IF(LRECI.LE.0) THEN
- WRITE(IQPRNT,10000) LRECI
-10000 FORMAT(' RZOPEN. - invalid record length: ',I6)
- ISTAT = 1
- GOTO 70
- ELSEIF(LRECI.GE.8191) THEN
- WRITE(IQPRNT,10100) LRECI
-10100 FORMAT(' RZOPEN. record length:',I6,
- + ' > maximum safe value (8191 words).')
- IF(LRECI.GT.8192) WRITE(IQPRNT,10200)
-10200 FORMAT(' RZOPEN. Automatic record length determination will not',
- + ' work with this file.')
- WRITE(IQPRNT,10300)
-10300 FORMAT(' RZOPEN. You may have problems transferring your',
- + ' file to other systems ',/,
- + ' or writing it to tape.')
- ENDIF
- ELSE
-#if defined(CERNLIB_QMAPO)
- IF(IOPT1.EQ.0.AND.IOPTU.EQ.0)THEN
- STAT='READONLY'
- ELSE
- STAT='OLD'
- ENDIF
-#endif
-#if !defined(CERNLIB_QMAPO)
- STAT='OLD'
-#endif
-*
-* File should already exist. Issue inquire even if IOPTC
-*
- LENF = LENOCC(CHFILE)
-
-#if defined(CERNLIB_QMCRY)||defined(CERNLIB_QMCV64)||defined(CERNLIB_QMAPO)||defined(CERNLIB_QMAPO9)||defined(CERNLIB_QMUIX)||defined(CERNLIB_WINNT)
- IF(IOPTC.EQ.0) THEN
-#endif
- INQUIRE(FILE=CHFILE,EXIST=IEXIST)
- ISTATF = 0
-
-#if defined(CERNLIB_QMCRY)||defined(CERNLIB_QMCV64)||defined(CERNLIB_QMAPO)||defined(CERNLIB_QMAPO9)||defined(CERNLIB_QMUIX)||defined(CERNLIB_WINNT)
- ELSE
- IEXIST = CFSTAT(CHFILE(1:LENF),INFO).EQ.0
- ISTATF = 1
- ENDIF
-#endif
-
- IF(.NOT.IEXIST) THEN
- WRITE(IQPRNT,*) 'RZOPEN. Error - input file ',
-#if defined(CERNLIB_IBM)
- + CHFILE(2:LENF),' does not exist'
-#endif
-#if !defined(CERNLIB_IBM)
- + CHFILE(1:LENF),' does not exist'
-#endif
- ISTAT = 2
- GOTO 70
- ENDIF
-#if defined(CERNLIB_QMVAX)
- IF(IOPTC.EQ.0) INQUIRE(FILE=CHFILE,ORGANIZATION=CHORG)
-#endif
- IF(LRECL.EQ.0) THEN
-*
-* LRECL=0 was specified, try to determine correct record length
-* from the file itself.
-*
-#if defined(CERNLIB_QMCRY)||defined(CERNLIB_QMCV64)||defined(CERNLIB_RZFRECL)
- ICOUNT = NWORD
- IF(IOPTC.EQ.0) THEN
-#endif
-#if defined(CERNLIB_QMAPO9)
- OPEN(UNIT=LUNIT,FILE=CHFILE,FORM='UNFORMATTED',
- + STATUS='READONLY')
-#endif
-#if defined(CERNLIB_QMVAX)
- INQUIRE(FILE=CHFILE,RECL=LRECL)
- LRECL = LRECL / 4
- GOTO 40
-#endif
-#if defined(CERNLIB_QMAPO9)
- INQUIRE(UNIT=LUNIT,RECL=LRECL)
- CLOSE(UNIT=LUNIT)
- GOTO 40
-#endif
-#if (defined(CERNLIB_QMIBM))&&(defined(CERNLIB_IBMVM))
-*
-* Use KERNLIB routine VMQFIL to obtain record length
-* Previous method (below) does not work for VMSTAGEd files
-*
- CALL CLTOU(CHFILE(1:LCHF))
- CALL VMQFIL(CHFILE(2:),RECFM,LRECL,NRECS,NBLOCKS,CHTIME,
- + ISTAT,IRC)
- LRECL = LRECL/4
- GOTO 40
-#endif
-#if (defined(CERNLIB_QMIBMFVS))&&(!defined(CERNLIB_IBMVM))
-*
-* Open file for READ to determine record length. JDS
-*
- OPEN(UNIT=LUNIT,FILE=CHFILE,FORM='UNFORMATTED',
- + ACTION='READ',
- + STATUS=STAT)
- READ(UNIT=LUNIT,NUM=LRECL) ITEST
- LRECL = LRECL/4
-* Close...
- CLOSE(LUNIT)
- GOTO 40
-#endif
-*
-* Record length is stored in file but in record # 2
-* (rec # 1 is used for locks)
-*
-#if defined(CERNLIB_QMCRY)||defined(CERNLIB_QMCV64)
- IF(IMODEX.NE.0) ICOUNT = ICOUNT / 2
-#endif
-#if defined(CERNLIB_QMCRY)
- OPEN(LUNIT,FILE=CHFILE,FORM='UNFORMATTED',STATUS='OLD',
- + RECL=IBYTES*ICOUNT,ACCESS='DIRECT')
-#endif
-#if defined(CERNLIB_QMCRY)||defined(CERNLIB_QMCV64)||defined(CERNLIB_RZFRECL)
- ENDIF
-#endif
-#if defined(CERNLIB_QMCRY)||defined(CERNLIB_QMCV64)||defined(CERNLIB_RZFRECL)
- 20 NREAD = ICOUNT
-#endif
-#if defined(CERNLIB_QMCRY)||defined(CERNLIB_QMCV64)||defined(CERNLIB_RZFRECL)
- IF(IOPTC.EQ.0) THEN
-#endif
-#if (defined(CERNLIB_QMCV64)||defined(CERNLIB_RZFRECL))&&(!defined(CERNLIB_QMAPO))
- OPEN(LUNIT,FILE=CHFILE,FORM='UNFORMATTED',STATUS='OLD',
- + RECL=IBYTES*NREAD,ACCESS='DIRECT',IOSTAT=ISTAT)
- IF(ISTAT.NE.0)GOTO 60
-#endif
-#if defined(CERNLIB_QMAPO)
- OPEN(LUNIT,FILE=CHFILE,FORM='UNFORMATTED',
- + STATUS='READONLY',RECL=IBYTES*NREAD,ACCESS='DIRECT'
- + ,IOSTAT=ISTAT)
- IF(ISTAT.NE.0)GOTO 60
-#endif
-#if defined(CERNLIB_QMCRY)
- IF(IOPTX.EQ.0) THEN
- CALL READ(LUNIT,ITEST,NREAD,IOS,NUS)
- ELSE
- CALL READ(LUNIT,IBUFF,NREAD,IOS,NUS)
- ENDIF
- IF(IOS.EQ.2) THEN
-#endif
-#if defined(CERNLIB_QMCV64)||defined(CERNLIB_RZFRECL)
- READ(LUNIT,REC=1,IOSTAT=IOS) (ITEST(JW),JW=1,NREAD)
- IF(IOS.NE.0) THEN
- CLOSE(LUNIT)
-#endif
-#if defined(CERNLIB_QMCRY)||defined(CERNLIB_QMCV64)||defined(CERNLIB_RZFRECL)
- ICOUNT = ICOUNT * .75
- GOTO 20
- ENDIF
-#endif
-#if defined(CERNLIB_QMCRY)||defined(CERNLIB_QMCV64)||defined(CERNLIB_RZFRECL)
- ELSE
- CALL CFOPEN(LUNPTR,0,NREAD,'r',0,CHFILE,IOS)
- IF (IOS .NE. 0) THEN
- ISTAT = -1
- GOTO 70
- ENDIF
- NWTAK = NREAD
-#endif
-#if defined(CERNLIB_QMCRY)
- IF(IOPTX.NE.0) THEN
- CALL CFGET(LUNPTR,0,NREAD,NWTAK,IBUFF,IOS)
- ELSE
- CALL CFGET(LUNPTR,0,NREAD,NWTAK,ITEST,IOS)
- ENDIF
-#endif
-#if defined(CERNLIB_QMCV64)||defined(CERNLIB_RZFRECL)
- CALL CFGET(LUNPTR,0,NREAD,NWTAK,ITEST,IOS)
-#endif
-#if defined(CERNLIB_QMCRY)||defined(CERNLIB_QMCV64)||defined(CERNLIB_RZFRECL)
- IF(IOS.NE.0) THEN
- CALL CFCLOS(LUNPTR,0)
- ICOUNT = ICOUNT * .75
- GOTO 20
- ENDIF
- ENDIF
-#endif
-#if defined(CERNLIB_QMVAX)||defined(CERNLIB_QMVMI)||defined(CERNLIB_QMDOS)||(defined(CERNLIB_QMLNX) && !defined(CERNLIB_PPC))||defined(CERNLIB_WINNT)
- IF(IOPTX.NE.0) CALL VXINVB(ITEST(1),NREAD)
-#endif
-#if defined(CERNLIB_QMCRY)
- IF(IOPTX.NE.0) THEN
- CALL UNPACK(IBUFF(1),32,ITEST(1),NREAD)
- ENDIF
-#endif
-#if defined(CERNLIB_QMCV64)
- IF(IOPTX.NE.0) THEN
- CALL UNPAK32(ITEST(1),ITEST(1),100)
-#endif
-#if defined(CERNLIB_QMCRY)||defined(CERNLIB_QMCV64)||defined(CERNLIB_RZFRECL)
-*
-* Work out record length
-*
- DO 30 J=1, NWORD
-*
-* ITEST(J+25) is the pointer in the 2nd record to the
-* file descriptor block, which by definition must be
-* in the same record
-*
- IF(ITEST(J+25).GT.0.AND.ITEST(J+25).LE.J) THEN
-*
-* Possible record length
-*
- IF((J+ITEST(J+25)).GT.8703) GOTO 30
- LRC = ITEST(J+ITEST(J+25)+1)
- IF(LRC.EQ.J) THEN
- LE = ITEST(J+30)
- LD = ITEST(J+24)
- NRD = ITEST(J+LD)
-* Does directory size match (record length)*(number of records)?
- IF(NRD*LRC.NE.LE) GOTO 30
- LRECL = J
- IF(IOPTC.EQ.0) THEN
- CLOSE(LUNIT)
- ELSE
- CALL CFCLOS(LUNPTR,0)
- ENDIF
- GOTO 40
- ENDIF
- ENDIF
- 30 CONTINUE
- IF(IOPTC.EQ.0) THEN
- CLOSE(LUNIT)
- ELSE
- CALL CFCLOS(LUNPTR,0)
- ENDIF
-
-#endif
-#if (defined(CERNLIB_QMCRY)||defined(CERNLIB_QMCV64)||defined(CERNLIB_RZFRECL))&&(!defined(CERNLIB_FQXISN))
- IF(IOPTX.EQ.0.AND.IPASS.EQ.0) THEN
- WRITE(IQPRNT,10400)
-10400 FORMAT(' RZOPEN. Cannot determine record length - ',
- + ' EXCHANGE mode is used.')
- IOPTX = 1
- IMODEX = 1
- IPASS = 1
- GOTO 10
- ENDIF
-#endif
-#if defined(CERNLIB_QMCRY)||defined(CERNLIB_QMCV64)||defined(CERNLIB_RZFRECL)
- WRITE(IQPRNT,*) ' RZOPEN. Error in the input file'
- ISTAT = 3
- GOTO 70
-#endif
- ENDIF
- ENDIF
- 40 CONTINUE
-*
-#if defined(CERNLIB_QMCV64)||defined(CERNLIB_QMCRY)||defined(CERNLIB_RZFRECL)
- IF(IOPTC.EQ.0) THEN
- NBYTES = IBYTES
-#endif
-#if defined(CERNLIB_QMCV64)||defined(CERNLIB_QMCRY)
- IF(IMODEX.NE.0) NBYTES = NBYTES / 2
-#endif
-#if (!defined(CERNLIB_QMIBMFVS))&&(!defined(CERNLIB_QMVAX))
- OPEN(UNIT=LUNIT,FILE=CHFILE,FORM='UNFORMATTED',
- + RECL=NBYTES*LRECL,ACCESS='DIRECT',STATUS=STAT,IOSTAT=ISTAT)
-#endif
-#if (defined(CERNLIB_QMIBMFVS))&&(!defined(CERNLIB_IBMMVS))
-*
-* CHOPT: SU = shared,update
-* S = shared,readonly
-* U = update
-* ' ' = readonly
-* 1 = single user read/write
-*
- CHACT = 'READ'
- IF(IOPTN.NE.0.OR.IOPTU.NE.0.OR.IOPT1.NE.0) CHACT = 'READWRITE'
- IF(IOPTN.EQ.0)THEN
- INQUIRE(FILE=CHFILE,EXIST=IEXIST)
- IF(.NOT.IEXIST) GOTO 60
- ENDIF
-*
- CALL FILEINF(ISTAT,'MAXREC',2)
- IF(ISTAT.NE.0)GOTO 60
- IF(IOPTN.NE.0)THEN
- OPEN(UNIT=LUNIT,FILE=CHFILE,FORM='UNFORMATTED',RECL=4*LRECL,
- + ACTION=CHACT,
- + ACCESS='DIRECT',STATUS=STAT,IOSTAT=ISTAT)
- IF(ISTAT.NE.0)GOTO 60
- CLOSE(LUNIT)
- ENDIF
- CALL FILEINF(ISTAT,'MAXREC',16777215)
- IF(ISTAT.NE.0)GOTO 60
- OPEN(UNIT=LUNIT,FILE=CHFILE,FORM='UNFORMATTED',RECL=4*LRECL,
- + ACTION=CHACT,
- + ACCESS='DIRECT',STATUS=STAT,IOSTAT=ISTAT)
-#endif
-#if (defined(CERNLIB_QMIBMFVS))&&(defined(CERNLIB_IBMMVS))
-*
-* CHOPT: SU = shared,update
-* S = shared,readonly
-* U = update
-* ' ' = readonly
-* 1 = single user read/write
-*
- CHACT = 'READ'
- IF(IOPTN.NE.0.OR.IOPTU.NE.0.OR.IOPT1.NE.0) CHACT = 'READWRITE'
- IRECL = LRECL * 4
- IF(IRECL.LE.0) IRECL=IDCB(1)
-
- IF(IOPTN.EQ.0)THEN
-
-#endif
-#if (defined(CERNLIB_QMIBMFVS))&&(defined(CERNLIB_IBMMVS))&&(!defined(CERNLIB_GSI))
-*
-*-- open file in read/write mode, read mode only if file
-*-- name start with a dot (file belonging to an other userid
-*-- from an other group - racf protection)
-#endif
-#if (defined(CERNLIB_QMIBMFVS))&&(defined(CERNLIB_IBMMVS))&&(!defined(CERNLIB_NEWLIB))
- IF ( CFNAME(1:1) .EQ. '.' .AND.
-#endif
-#if (defined(CERNLIB_QMIBMFVS))&&(defined(CERNLIB_IBMMVS))&&(defined(CERNLIB_NEWLIB))
- IF ( CFNAME(1:1) .EQ. '.') THEN
-#endif
-#if (defined(CERNLIB_QMIBMFVS))&&(defined(CERNLIB_IBMMVS))&&(!defined(CERNLIB_NEWLIB))
- + CFNAME(2:5) .NE. PREFIX(1:4))THEN
-*SELF,IF=QMIBMFVS,IF=IBMMVS,IF=NEWLIB.
-* + CFNAME(2:7) .NE. PREFIX(1:6))THEN
-#endif
-#if (defined(CERNLIB_QMIBMFVS))&&(defined(CERNLIB_IBMMVS))
- CHACT = 'READ'
- ELSE
- CHACT = 'READWRITE'
- ENDIF
-#endif
-#if (defined(CERNLIB_QMIBMFVS))&&(defined(CERNLIB_IBMMVS))
-
- OPEN ( UNIT=LUNIT, STATUS='OLD', FILE=CHFILE, ACCESS='DIRECT'
- +, FORM='UNFORMATTED', IOSTAT=ISTAT
- +, RECL=IRECL, ACTION=CHACT)
- IF (ISTAT.NE.0) THEN
- WRITE(IQPRNT,*) 'RZOPEN: OPEN Error file ',CHFILE,
- + ' IOSTAT= ', ISTAT
- GOTO 60
- ENDIF
- ENDIF
-*
- IF(IOPTN.NE.0)THEN
-* detect, whether file really does not exist if opt N given:
- INQUIRE(FILE=CHFILE,EXIST=IEXIST)
- IF(IEXIST) THEN
- WRITE(IQPRNT,*) 'RZOPEN. Warning,input file ',CHFILE
- + (2:LENOCC(CHFILE)),' already exists !'
- STAT='UNKNOWN'
- ELSE
- STAT='NEW'
-*-- define file parameters
- IF( INDEX(CHFILE,'(') .NE. 0 ) THEN
- IF(IOPTV.EQ.0) THEN
- ISPACE(3) = 28
- ELSE
- WRITE(IQPRNT,*)
- + 'RZOPEN: No PDS allowed for VSAM files !'
- ISTAT = -1
- GOTO 60
- ENDIF
- ENDIF
- CALL FILEINF ( ISTAT, 'DEVICE', IUNIT, ITRK, ISPACE(1)
- +, 'SECOND', ISPACE(2), 'DIR', ISPACE(3)
- +, 'RECFM', IRECFM, 'LRECL', IRECL
- +, 'BLKSIZE', IDCB(2) )
- IF (ISTAT.NE.0) THEN
- WRITE(IQPRNT,*) 'RZOPEN: FILEINF Error, ISTAT = ',ISTAT
- GOTO 60
- ENDIF
-*-- If VSAM, define Cluster
- IF(IOPTV.NE.0) THEN
- WRITE(cRecl,'(I6)') iRecl
- cDataClas = 'DATACLAS(RZFILE)'
- IF ( INDEX( CHFILE, '.RZDATA' ) .GT. 0 )
- + cDataClas = 'DATACLAS(RZDATA)'
- cTSO = 'DEFINE CLUSTER(NAME('''//
- + CHFILE(2:lenocc(CHFILE)) //
- + ''') '//cDataClas// ' recordsize(' // cRecl // cRecl //
- + ') shareoptions(2) NUMBERED UNIQUE NONSPANNED recovery)'
- iStat = mvsams( cTSO )
- IF ( iStat .NE. 0 ) THEN
- WRITE(IQPRNT,*)
- + 'RZOPEN: Define Cluster Error, ISTAT = ', ISTAT
- GOTO 60
- ENDIF
- ENDIF
- ENDIF
-*-- OPEN FILE
- OPEN ( UNIT=LUNIT, STATUS=STAT
- +, FILE=CHFILE, ACCESS='DIRECT'
- +, FORM='UNFORMATTED', IOSTAT=ISTAT
- +, RECL=IRECL, ACTION='READWRITE' )
- ENDIF
-#endif
-#if defined(CERNLIB_QMVAX)
-*
-* CHOPT: SU = shared,update
-* S = shared,readonly
-* U = update
-* ' ' = readonly
-* 1 = single user read/write
-*
- IF(IOPTS.NE.0.AND.IOPTU.NE.0)THEN
- OPEN(UNIT=LUNIT,FILE=CFNAME,FORM='UNFORMATTED',RECL=LRECL,
- + ORGANIZATION=CHORG,
- + ACCESS='DIRECT',SHARED,STATUS=STAT,IOSTAT=ISTAT)
- ELSEIF(IOPTS.NE.0.AND.IOPTU.EQ.0)THEN
- OPEN(UNIT=LUNIT,FILE=CFNAME,FORM='UNFORMATTED',RECL=LRECL,
- + ORGANIZATION=CHORG,
- + ACCESS='DIRECT',SHARED,READONLY,STATUS=STAT,IOSTAT=ISTAT)
- ELSEIF(IOPTS.EQ.0.AND.IOPTU.NE.0)THEN
- OPEN(UNIT=LUNIT,FILE=CFNAME,FORM='UNFORMATTED',RECL=LRECL,
- + ORGANIZATION=CHORG,
- + ACCESS='DIRECT',SHARED,STATUS=STAT,IOSTAT=ISTAT)
- ELSEIF(IOPT1.NE.0)THEN
- OPEN(UNIT=LUNIT,FILE=CFNAME,FORM='UNFORMATTED',RECL=LRECL,
- + ORGANIZATION=CHORG,
- + ACCESS='DIRECT',STATUS=STAT,IOSTAT=ISTAT)
- ELSEIF(IOPTS.EQ.0.AND.IOPTU.EQ.0.AND.IOPTN.EQ.0)THEN
- OPEN(UNIT=LUNIT,FILE=CFNAME,FORM='UNFORMATTED',RECL=LRECL,
- + ORGANIZATION=CHORG,
- + ACCESS='DIRECT',READONLY,STATUS=STAT,IOSTAT=ISTAT)
- ELSEIF(IOPTN.NE.0)THEN
- OPEN(UNIT=LUNIT,FILE=CFNAME,FORM='UNFORMATTED',RECL=LRECL,
- + ORGANIZATION=CHORG,
- + ACCESS='DIRECT',SHARED,STATUS=STAT,IOSTAT=ISTAT)
- ENDIF
-#endif
-#if (defined(CERNLIB_QMIBMFVS))&&(defined(CERNLIB_IBMMVS))
-*
-* --- for new datasets, do a dummy initial load
-*
- IF ((IOPTV.NE.0).AND.(STAT.EQ.'NEW')) THEN
- CALL RZIODO(LUNIT, irecl/4, 1, record, 2 ) ! dummy write
- CALL RZIODO(LUNIT, irecl/4, 1, record, 1 ) ! dummy read
- WRITE(IQPRNT,*) 'RZOPEN: VSAM FILE ', CHFILE(2:LENOCC(CHFILE))
- +, ' succesfully created'
- ENDIF
-#endif
-#if defined(CERNLIB_QMCRY)||defined(CERNLIB_QMCV64)||defined(CERNLIB_RZFRECL)
- ELSE
-* CHOPT: SU = shared,update
-* S = shared,readonly
-* U = update
-* ' ' = readonly
-* 1 = single user read/write
- CHOPE = 'r'
- IF(IOPTU.NE.0.OR.IOPT1.NE.0) CHOPE = 'r+'
- IF(IOPTN.NE.0) CHOPE = 'w+'
- JRECL = LRECL
-#endif
-#if defined(CERNLIB_QMCRY)||defined(CERNLIB_QMCV64)
- IF(IMODEX.NE.0) JRECL = LRECL / 2
-#endif
-#if defined(CERNLIB_QMCRY)||defined(CERNLIB_QMCV64)||defined(CERNLIB_RZFRECL)
- CALL CFOPEN(LUNPTR,0,JRECL,CHOPE,0,CHFILE,ISTAT)
- LUNIT = 1000 + LUNPTR
- ENDIF
-#endif
- IF(ISTAT.NE.0)GOTO 60
- IF(IOPTY.NE.0)GOTO 50
- if(kstrip.ne.0)go to 50
-*
-* Check consistency of LRECL
-*
- IF(IOPTN.EQ.0.AND.IPASS.EQ.0.AND.ISTAT.EQ.0)THEN
- IMODEX=IOPTX
- IZRECL=LRECL
- CALL RZIODO(LUNIT,50,2,ITEST,1)
-#if defined(CERNLIB_QMVAX)||defined(CERNLIB_QMVMI)||defined(CERNLIB_QMDOS)||(defined(CERNLIB_QMLNX) && !defined(CERNLIB_PPC))||defined(CERNLIB_WINNT)
- CALL VXINVB(ITEST(9),1)
- IF(JBIT(ITEST(9),12).NE.0)THEN
- IMODEX=1
- CALL RZIODO(LUNIT,50,2,ITEST,1)
- ELSE
- CALL VXINVB(ITEST(9),1)
- ENDIF
-#endif
- LB=ITEST(25)
-*
-* Protection against bad files
-*
- IF(LB.GT.8187) THEN
- WRITE(IQPRNT,10500) CHFILE(1:LENOCC(CHFILE))
-10500 FORMAT(' RZOPEN: cannot determine record length.',
- + ' File ',A,' probably not in RZ format')
- LRECP=-1
- ISTAT=2
-#if defined(CERNLIB_IBM)
- CLOSE(LUNIT)
-#endif
-#if defined(CERNLIB_QMCRY)||defined(CERNLIB_QMCV64)||defined(CERNLIB_RZFRECL)
- IF(IOPTC.EQ.0) THEN
- CLOSE(LUNIT)
- ELSE
- CALL CFCLOS(LUNIT-1000,0)
- ENDIF
-#endif
- GOTO 70
- ENDIF
- IF(LB.GT.48) CALL RZIODO(LUNIT,LB+6,2,ITEST,1)
- LRECP=ITEST(LB+1)
- IQUEST(1)=0
- IF(LRECP.NE.LRECL)THEN
- LRECL2=LRECL
- LRECL=0
-#if defined(CERNLIB_IBM)
- CLOSE(LUNIT)
-#endif
-#if defined(CERNLIB_QMCRY)||defined(CERNLIB_QMCV64)||defined(CERNLIB_RZFRECL)
- IF(IOPTC.EQ.0) THEN
- CLOSE(LUNIT)
- ELSE
- CALL CFCLOS(LUNIT-1000,0)
- ENDIF
-#endif
-
-#if defined(CERNLIB_IBMMVS)
- IF(IPASS.EQ.0.AND.LRECI.EQ.0) THEN
-#endif
-#if !defined(CERNLIB_IBMMVS)
- IF(IPASS.EQ.0) THEN
-#endif
- IPASS=1
- GOTO 10
- ELSE
- WRITE(IQPRNT,*) 'Cannot determine record length'
- ISTAT = 1
- GOTO 70
- ENDIF
- ENDIF
- ENDIF
-*
- IF (IPASS.NE.0 .AND. LRECL2.NE.0) THEN
- WRITE(IQPRNT,10600) LRECL2,LRECL
-10600 FORMAT(' RZOPEN: LRECL inconsistant - ',
- + ' file was opened with LRECL = ',I6,
- + ' should be LRECL = ',I6)
- ENDIF
-*
-* If option 'W' build CHDIR
-*
- 50 IF(IOPTW.NE.0)THEN
- IF (IOPTC .EQ. 0) THEN
- LUN = LUNIT
- ELSE
- LUN = LUNIT - 1000
- ENDIF
- IF(LUN.LT.10)WRITE(CHDIR,10700)LUN
- IF(LUN.GE.10)WRITE(CHDIR,10800)LUN
-10700 FORMAT('LUN',I1,' ')
-10800 FORMAT('LUN',I2,' ')
- ENDIF
-*
- 60 CONTINUE
- IQUEST(10) = LRECL
- IQUEST(11) = LUNIT
- IQUEST(12) = IMODEX
-#if defined(CERNLIB_QMUIX)
-*-* Fill structure if file is striped
- if(kstrip.ne.0.and.istat.eq.0)then
- if(ioptc.eq.0)then
- lun=lunit
- else
- lun=lunit-1000
- endif
- nstrip(lun)=nst
- nrstrip(lun)=nrs
- istrip(lun)=1
- islast=lun
- rznames(lun)=rzsfile(maxstrip)
- endif
-#endif
- 70 CONTINUE
- END
diff --git a/src/packlib/zebra/rz/rzophd.F b/src/packlib/zebra/rz/rzophd.F
deleted file mode 100644
index 3317938..0000000
--- a/src/packlib/zebra/rz/rzophd.F
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: rzophd.F,v 1.1.1.1 1996/03/06 10:47:26 mclareni Exp $
-*
-* $Log: rzophd.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:26 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE RZOPHD(LUN,JREC,IREC,IBUF,IRC)
- DIMENSION IBUF(JREC)
- IRC = 0
- WRITE(LUN,REC=IREC,ERR=99,IOSTAT=ISTAT) IBUF
- RETURN
- 99 IRC = ISTAT
- END
diff --git a/src/packlib/zebra/rz/rzout.F b/src/packlib/zebra/rz/rzout.F
deleted file mode 100644
index 99423bc..0000000
--- a/src/packlib/zebra/rz/rzout.F
+++ /dev/null
@@ -1,493 +0,0 @@
-*
-* $Id: rzout.F,v 1.3 1996/04/24 17:27:03 mclareni Exp $
-*
-* $Log: rzout.F,v $
-* Revision 1.3 1996/04/24 17:27:03 mclareni
-* Extend the include file cleanup to dzebra, rz and tq, and also add
-* dependencies in some cases.
-*
-* Revision 1.2 1996/03/08 08:08:04 jamie
-* Bug fixes for opt R handling in rz(v)out
-*
-* Revision 1.1.1.1 1996/03/06 10:47:26 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE RZOUT(IXDIV,LSUP,KEYU,ICYCLE,CHOPT)
-*
-************************************************************************
-*
-* To write data structure pointed by LSUP
-* Input:
-* IXDIV Index of the division(s)
-* May be zero if the 'D' option is not selected
-* May be a compound index (see MZIXCO on page 24) if the 'D'
-* option is selected
-* LSUP Supporting address of the data structure (may be zero if the
-* 'D' option is selected)
-* KEYU Keyword vector of length NWKEY as specified by RZMDIR.
-* ICYCLE only used as Input parameter if 'A' option is given (see below)
-* CHOPT Character variable specifying the selected options.
-* data structure
-* default
-* The data structure supported by the bank at LSUP is
-* written out (link 0 is not followed)
-* 'D' Complete division(s)
-* default: Dropped banks are squeezed out
-* (slower but maybe more economic than 'DI')
-* 'DI' Immediate dump of divisions with dropped banks
-* included
-* 'L' Write the data structure supported by the linear
-* structure at LSUP (link 0 is followed)
-* 'S' Single bank at LSUP
-* 'R' Replace option.
-* 'Q' seQuential mode - no check made to see if key already
-* exists (option S in RZVOUT etc.)
-* mode
-* default
-* Keep banks available after output
-* 'N' No links, i.e. linkless handling
-* 'W' Drop data structure or wipe division(s) after output
-* 'A' Key will not be visible by RZLDIR
-* Output:
-* ICYCLE Cycle number associated to the key entered
-* ICYCLE is 1 if KEY was not already present in the directory,
-* and one larger than the previous cycle associated to the key
-* otherwise.
-* ICYCLE is only Input parameter when option 'A' is given
-*
-* Called by <USER>
-*
-* Author : R.Brun DD/US/PD
-* Written : 04.04.86
-* Last mod: 14.09.93 - RB. Protect against directories > 64K
-* : 04.03.94 S.Banerjee (Change in cycle structure)
-* : 27.09.94 J.Shiers - add option Q (cf S in RZVOUT)
-* : 17.02.95 J.Shiers - move definition of logl
-* : 21.02.95 J.Shiers - improve warning message for
-* big directories (objects auto-deleted)
-* : 23.03.95 J.Shiers - key # in cycles block is KEY(1)
-* : 10.04.95 J.Shiers - move IKYV lines to after definition
-* : 08.03.96 J.Shiers - only delete previous cycle if opt R
-* not specified. If opt R is specified,
-* use previous cycle number (and not 1)
-*
-* In RZ file format version 0, RZ pointers are stored in 16 bits.
-* Thus, pointers to previous cycle etc. must not exceed 65536.
-* An attempt to save a new cycle under such conditions will result
-* in the previous cycle being deleted with a warning message.
-*
-* For files created with RZ version 1, this is not necessary as
-* pointers are 32 bit.
-*
-************************************************************************
-#include "zebra/zunit.inc"
-#include "zebra/rzcl.inc"
-#include "zebra/rzclun.inc"
-#include "zebra/eqlqrrf.inc"
-#include "zebra/rzcout.inc"
-#include "zebra/rzk.inc"
-#include "zebra/rzckey.inc"
-#include "zebra/rzcycle.inc"
-#include "zebra/mzct.inc"
-#include "zebra/fzcx.inc"
- CHARACTER*(*) CHOPT
- DIMENSION KEYU(*)
- DIMENSION LSUP(1)
- DIMENSION IOPTV(9)
-*
-*-----------------------------------------------------------------------
-*
-#include "zebra/q_jbyt.inc"
-*
- IQUEST(1)=0
- CALL MZSDIV(IXDIV,1)
- IXDIVX=IXDIV
- LQRRF(KQT+1)=LSUP(1)
- IEVFLX=1
- NWTXX =0
- NWSEGX=0
- NWTABX=0
- NWBKX =0
- NWUHCX=0
- CALL UOPTC(CHOPT,'ADILSNWRQ',IOPTV)
- IOPTXA=IOPTV(1)
- IOPTXD=IOPTV(2)
- IOPTXI=IOPTV(3)
- IOPTXL=IOPTV(4)
- IOPTXS=IOPTV(5)
- IOPTXN=IOPTV(6)
- IOPTXW=IOPTV(7)
- IOPTXR=IOPTV(8)
- IOPTRR=IOPTV(8)
- IOPTXQ=IOPTV(9)
- IOPTXN=IOPTXN+IOPTXS
- IOPTXM=0
-*
-* Loglevel
-*
- LOGLV = JBYT(IQ(KQSP+LTOP),15,3)-3
-*
-* Options R & Q are incompatible
-*
- IF(IOPTXR.NE.0.AND.IOPTXQ.NE.0) THEN
- IF(LOGLV.GE.3) WRITE(IQPRNT,10000)
-10000 FORMAT(' RZOUT. ERROR - options R and Q are incompatible')
- IQUEST(1)=5
- GOTO 999
- ENDIF
-*
-* Check if WRITE permission on file and directory
-*
- IF(LQRS.EQ.0)GOTO 999
- IFLAG=0
- CALL RZMODS('RZOUT ',IFLAG)
- IF(IFLAG.NE.0) GOTO 999
-*
-* Write current buffer if not same directory
-* Get last record written in that directory
-* Create buffer bank
-*
- 10 LROUT = LQ(KQSP+LTOP-6)
- IROUT = IQ(KQSP+LTOP+KIROUT)
- IRLOUT = IQ(KQSP+LCDIR+KRLOUT)
- IP1 = IQ(KQSP+LCDIR+KIP1)
- IF(LROUT.EQ.0)THEN
- CALL MZBOOK(JQPDVS,LROUT,LTOP,-6,'RZOU',0,0,LREC+1,2,-1)
- IQ(KQSP+LROUT-5)=LUN
- IROUT=0
- IP1=1
- ENDIF
- IF(IROUT.NE.IRLOUT.AND.IRLOUT.NE.0)THEN
- CALL RZIODO(LUN,LREC,IRLOUT,IQ(KQSP+LROUT+1),1)
- IF(IQUEST(1).NE.0)GOTO 999
-#if defined(CERNLIB_QMVAX)
- IF(IRELAT.NE.0)UNLOCK(UNIT=LUN)
-#endif
- IROUT=IRLOUT
- IQ(KQSP+LTOP+KIROUT)=IROUT
- IP1=IQ(KQSP+LCDIR+KIP1)
- IF(IQ(KQSP+LTOP+KIRIN).EQ.IROUT)IQ(KQSP+LTOP+KIRIN) = 0
- ENDIF
-*
-* Is directory big enough to accomodate new cycle ?
-*
- NKEYS = IQ(KQSP+LCDIR+KNKEYS)
- NWKEY = IQ(KQSP+LCDIR+KNWKEY)
-
- IF(IOPTXR.EQ.0) THEN
- IF(IQ(KQSP+LCDIR+KNFREE).LT.NWKEY+4*KLCYCL+1)THEN
- CALL RZEXPD('RZOUT ',10*(NWKEY+KLCYCL+1))
- IF(IQUEST(1).NE.0)GOTO 999
- ENDIF
- ENDIF
-
- LK = IQ(KQSP+LCDIR+KLK)
- LF = IQ(KQSP+LCDIR+KLF)
- LC = IQ(KQSP+LCDIR+KLC)
- LE = IQ(KQSP+LCDIR+KLE)
- NWFREE=IQ(KQSP+LCDIR+KNFREE)
-*
-* Convert input key vector to internal format
-*
- IQUEST(7)=NKEYS
- IQUEST(8)=NWKEY
-*
- DO 20 I=1,NWKEY
- IKDES=(I-1)/10
- IKBIT1=3*I-30*IKDES-2
- IF(JBYT(IQ(KQSP+LCDIR+KKDES+IKDES),IKBIT1,3).LT.3)THEN
- KEY(I)=KEYU(I)
- ELSE
- CALL ZHTOI(KEYU(I),KEY(I),1)
- ENDIF
- 20 CONTINUE
-*
-* Search if KEY is already entered
-*
- IF(IOPTXQ.EQ.0) THEN
- IF(NKEYS.GT.0)THEN
- DO 40 I=1,NKEYS
- DO 30 K=1,NWKEY
- LKC=LK+(NWKEY+1)*(I-1)
- IF(IQ(KQSP+LCDIR+LKC+K).NE.KEY(K))GOTO 40
- 30 CONTINUE
-*
-* Protect against directories > 65536
-*
- IF(IOPTXR.EQ.0.AND.KVSCYC.EQ.0.AND.LE.GT.65536)THEN
- CALL RZDELK(KEYU,0,'C')
- IF(LOGLV.GE.-2) THEN
- WRITE(IQPRNT,10100)
-10100 FORMAT(' RZOUT: current RZ file cannot support > 64K records ',/,
- + ' or individual directories > 64K')
- WRITE(IQPRNT,10200)KEY(1)
-10200 FORMAT(' RZOUT: previous cycle(s) for this key (',I8,')',
- + ' deleted')
- WRITE(IQPRNT,10300)
-10300 FORMAT(' RZOUT: please consult ZEBRA manual for further details')
- ENDIF
- GOTO 10
- ENDIF
-
- LCOLD=IQ(KQSP+LCDIR+LKC)
- IF (KVSCYC.NE.0) THEN
-* IF (IQ(KQSP+LCDIR+LCOLD+KKYCYC).NE.I) THEN
- LKC=LK+(NWKEY+1)*(I-1)
- IF (IQ(KQSP+LCDIR+LCOLD+KKYCYC).NE.
- + IQ(KQSP+LCDIR+LKC+1)) THEN
- IQUEST(1) = 11
- GO TO 999
- ENDIF
- ENDIF
- ICOLD = JBYT(IQ(KQSP+LCDIR+LCOLD+KCNCYC),21,12)
-* IKYV = I
- IKYV = IQ(KQSP+LCDIR+LKC+1)
- IF(IOPTXR.EQ.0) THEN
- ICYCLE=ICOLD+1
- ELSE
-* ICYCLE=1
- ICYCLE=ICOLD
- IF (KVSCYC.EQ.0) THEN
- IP1 = JBYT(IQ(KQSP+LCDIR+LCOLD+KORCYC), 1,16)
- IR1 = JBYT(IQ(KQSP+LCDIR+LCOLD+KFRCYC),17,16)
- IR2 = JBYT(IQ(KQSP+LCDIR+LCOLD+KSRCYC),17,16)
- NWORDS = JBYT(IQ(KQSP+LCDIR+LCOLD+KNWCYC), 1,20)
- ELSE
- IP1 = JBYT(IQ(KQSP+LCDIR+LCOLD+KORCYC), 1,20)
- IR1 = IQ(KQSP+LCDIR+LCOLD+KFRCYC)
- IR2 = IQ(KQSP+LCDIR+LCOLD+KSRCYC)
- NWORDS = IQ(KQSP+LCDIR+LCOLD+KNWCYC)
- ENDIF
- NLEFT=LREC-IP1+1
- IF(NWORDS.LE.NLEFT)THEN
- NR=0
- ELSE
- NR=(NWORDS-NLEFT-1)/LREC + 1
- ENDIF
- IF(LOGLV.GE.3) WRITE(IQPRNT,10400) IP1,IR1,NWORDS,NR
-10400 FORMAT(' RZOUT. object starts at word ',I6,
- + ' in record ',I6,' nwords = ',I6,' nrecs = ',I6)
- IF(LOGLV.GE.3.AND.IR2.NE.0) WRITE(IQPRNT,10500) IR2
-10500 FORMAT(' RZOUT. object continues in record ',I6)
- IRSAVE = IRLOUT
- IF(IR1.NE.IRLOUT) THEN
- CALL RZIODO(LUN,LREC,IR1,IQ(KQSP+LROUT+1),1)
- IF(IQUEST(1).NE.0)GOTO 999
- IROUT = IR1
- IRLOUT = IR1
- ENDIF
- ENDIF
- IQUEST(20)=I
- GOTO 60
- 40 CONTINUE
- ENDIF
-*
-* Object must already exist if R option is given
-*
- IF(IOPTXR.NE.0) THEN
- IQUEST(1) = 6
- IF(LOGLV.GE.-2) WRITE(IQLOG,10600)
-10600 FORMAT(' RZOUT. Error - object does not exist')
- GOTO 999
- ENDIF
- ENDIF
-*
-* New KEY, append to the list
-*
- IQUEST(20)=NWKEY+1
- NWFREE=NWFREE-NWKEY-1
- IQ(KQSP+LCDIR+KNKEYS)=IQ(KQSP+LCDIR+KNKEYS)+1
- LCOLD = 0
- LKC = LF
- LF = LF+NWKEY+1
- ICYCLE= 1
- DO 50 I=1,NWKEY
- IQ(KQSP+LCDIR+LKC+I)=KEY(I)
- 50 CONTINUE
-* IKYV = IQ(KQSP+LCDIR+KNKEYS)
- IKYV = IQ(KQSP+LCDIR+LKC+1)
-*
-* Construct table of material to be written
-*
- 60 CALL MZSDIV(IXDIVX,0)
- LENTRX = LQRRF(KQT+1)
- JQSTMV = -1
- MODTBX = 0
- JFLGAX = 0
- CALL FZOTAB
- IF(IQUEST(1).NE.0)THEN
- IF(LOGLV.GE.-2) WRITE(IQLOG,10700)
-10700 FORMAT(' RZOUT. Unable to construct table')
- GOTO 80
- ENDIF
- IF(IOPTXN.NE.0)NWTABX=0
- NDATA=NWTABX+NWBKX+3
-*
-* Replace option - record allocation not required
-*
- IF(IOPTXR.NE.0) THEN
-*
-* Check if exactly the same number of words are required
-*
- IF(NDATA.NE.NWORDS) THEN
- IQUEST(1) = 1
- IF(LOGLV.GE.-2) WRITE(IQLOG,10800) NWORDS,NDATA
-10800 FORMAT(' RZOUT. Error - existing object required ',I10,
- + ' words. New object requires ',I10)
- GOTO 90
- ENDIF
-
- ELSE
-*
-* Compute how many records and how many words
-* are necessary to write data structure.
-*
- IR1=IRLOUT
- IALLOC=0
- NLEFT=LREC-IP1+1
- IF(NDATA.LE.NLEFT)THEN
- NR=0
- ELSE
- NR=(NDATA-NLEFT-1)/LREC + 1
- ENDIF
- IF(IRLOUT.EQ.0)NR=NR+1
- IF(NR.GT.0)THEN
- CALL RZALLO('RZOUT ',NR,IALLOC)
- IF(IALLOC.EQ.0)GOTO 80
- ENDIF
- IF(IRLOUT.EQ.0.OR.IP1.GT.LREC)THEN
- IP1=1
- NLEFT=LREC
- IRLOUT=IALLOC
- IR1=IALLOC
- IR2=IALLOC+1
- IR3=IALLOC+NR-1
- IF(NR.EQ.1)THEN
- IR2=0
- IR3=0
- ENDIF
- ELSE
- IR2=IALLOC
- IR3=IALLOC+NR-1
- ENDIF
- ENDIF
- IQ3 =IRLOUT
- IQ4 =IP1
-*
-* Write data structure at LSUP according to table
-*
- CALL RZOBKN
- IF(IQUEST(1).NE.0)THEN
- IROUT=IQ(KQSP+LTOP+KIROUT)
- IF(IROUT.GT.0)THEN
- IQ1=IQUEST(1)
- CALL RZIODO(LUN,LREC,IROUT,IQ(KQSP+LROUT+1),1)
-#if defined(CERNLIB_QMVAX)
- IF(IRELAT.NE.0)UNLOCK(UNIT=LUN)
-#endif
- IQUEST(1)=IQ1
- ENDIF
- GOTO 80
- ENDIF
-
- IF(IOPTXR.EQ.0) THEN
-
- IF(IRLOUT.EQ.IR1) GOTO 70
- IF(IRLOUT.GE.IR2.AND.IRLOUT.LE.IR3) GOTO 70
- IF(IROUT.EQ.IRLOUT)IROUT=0
- IRLOUT = 0
- IP1 = 1
- 70 CONTINUE
-*
-* Create a new cycle
-*
- LC = LC-KLCYCL
- NWFREE = NWFREE-KLCYCL
- IQ(KQSP+LCDIR+LKC) = LC
- IQ(KQSP+LCDIR+LC+KPPCYC) = LCOLD
- IQ(KQSP+LCDIR+LC+KFLCYC) = 0
- CALL RZDATE (IQ(KQSP+LCDIR+LC+KFLCYC),IDATE,ITIME,2)
- IF(IOPTXA.NE.0)CALL SBIT1(IQ(KQSP+LCDIR+LC+KFLCYC),4)
- IQ(KQSP+LCDIR+LC+KORCYC) = IQ4
- IQ(KQSP+LCDIR+LC+KNWCYC) = NDATA
- CALL SBYT(ICYCLE,IQ(KQSP+LCDIR+LC+KCNCYC),21,12)
- IF (KVSCYC.EQ.0) THEN
- IF (NLEFT.LT.NDATA)
- + CALL SBYT(IR2,IQ(KQSP+LCDIR+LC+KSRCYC),17,16)
- CALL SBYT(IR1,IQ(KQSP+LCDIR+LC+KFRCYC),17,16)
- ELSE
- IF (NLEFT.LT.NDATA) THEN
- IQ(KQSP+LCDIR+LC+KSRCYC) = IR2
- ELSE
- IQ(KQSP+LCDIR+LC+KSRCYC) = 0
- ENDIF
- IQ(KQSP+LCDIR+LC+KFRCYC) = IR1
- IQ(KQSP+LCDIR+LC+KKYCYC) = IKYV
- ENDIF
- ENDIF
-*
-* Update internal pointers in the directory
-*
- IQUEST(3)=IQ3
- IQUEST(4)=IQ4
- IQUEST(5)=0
- IQUEST(6)=ICYCLE
- IQUEST(11)=NDATA
-
- IF(IOPTXR.EQ.0) THEN
-
- IQ(KQSP+LTOP+KIROUT)=IROUT
- IQ(KQSP+LCDIR+KRUSED)=IQ(KQSP+LCDIR+KRUSED)+NR
- NWUSED=IQ(KQSP+LCDIR+KWUSED)+NDATA
- IF(NWUSED.GT.1000000)THEN
- IQ(KQSP+LCDIR+KMEGA)=IQ(KQSP+LCDIR+KMEGA)+1
- IQ(KQSP+LCDIR+KWUSED)=NWUSED-1000000
- ELSE
- IQ(KQSP+LCDIR+KWUSED)=NWUSED
- ENDIF
- IQ(KQSP+LCDIR+KRLOUT)=IRLOUT
- IQ(KQSP+LCDIR+KIP1)=IP1
- IQ(KQSP+LCDIR+KNFREE)=NWFREE
- IQ(KQSP+LCDIR+KLF)=LF
- IQ(KQSP+LCDIR+KLC)=LC
-
- ENDIF
-
- IQUEST(9)=IQ(KQSP+LCDIR+KQUOTA)-IQ(KQSP+LCDIR+KRUSED)
-*
-* Drop data structure or wipe division (option W)
-*
- IF (IOPTXW.NE.0) THEN
- LSUP(1) = LQRRF(KQT+1)
- IF (LSUP(1).NE.0) THEN
- CALL MZDROP(IXDIV,LSUP,' ')
- LSUP(1)=0
- ENDIF
- ENDIF
-*
-* Mark used records
-*
- IF(IOPTXR.EQ.0.AND.NR.GT.0)THEN
- CALL RZUSED(NR,IALLOC)
- ENDIF
- GOTO 90
- 80 IF(ICYCLE.EQ.1.AND.IOPTXR.EQ.0)THEN
- IQ(KQSP+LCDIR+KNKEYS)=IQ(KQSP+LCDIR+KNKEYS)-1
- ENDIF
-
- 90 CONTINUE
-*
-* Restore last record written if required
-*
- IF(IOPTXR.NE.0.AND.IRSAVE.NE.IRLOUT) THEN
- CALL RZIODO(LUN,LREC,IRLOUT,IQ(KQSP+LROUT+1),2)
- IF(IQUEST(1).NE.0)GOTO 999
- IROUT = IRSAVE
- IRLOUT = IRSAVE
- CALL RZIODO(LUN,LREC,IRLOUT,IQ(KQSP+LROUT+1),1)
- IF(IQUEST(1).NE.0)GOTO 999
- ENDIF
-*
- 999 END
diff --git a/src/packlib/zebra/rz/rzpaff.F b/src/packlib/zebra/rz/rzpaff.F
deleted file mode 100644
index b3cb865..0000000
--- a/src/packlib/zebra/rz/rzpaff.F
+++ /dev/null
@@ -1,68 +0,0 @@
-*
-* $Id: rzpaff.F,v 1.1.1.1 1996/03/06 10:47:26 mclareni Exp $
-*
-* $Log: rzpaff.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:26 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE RZPAFF(CH,NL,CHPATH)
-************************************************************************
-*
-* RZPAFF reconstructs into CHPATH the path-name stored into the
-* character array CH.
-* where NL=number of levels starting from the root directory
-*
-* Input:
-* CH Character array of NL elements
-* Output:
-* *CHPATH* Character variable specifying the pathname
-*
-* Called by RZCDIR,RZFDIR,RZLDIR,RZLLOK,RZNDIR
-*
-* Author : R.Brun DD/US/PD
-* Written : 01.04.86
-* Last mod: 24.06.92 JDS - IQUEST(1) /= 0 in case of problems
-*
-************************************************************************
- CHARACTER*(*) CHPATH,CH(*)
-* CHARACTER*128 CHTEMP
- CHARACTER*255 CHTEMP
- CHARACTER*16 CHL
-#include "zebra/quest.inc"
-*
-*-----------------------------------------------------------------------
-*
- MAXLEN=LEN(CHPATH)
-* IF(MAXLEN.GT.110)MAXLEN=110
- IF(MAXLEN.GT.255)MAXLEN=255
- IQUEST(1) = 0
-*
- CHPATH='//'//CH(1)
- LENG=LENOCC(CHPATH)
- IF(LENG.EQ.2) THEN
- CHPATH='//HOME'
- LENG=6
- ENDIF
- IF(NL.EQ.1) GOTO 99
-*
- DO 20 I=2,NL
- CHL=CH(I)
- NMAX=LENOCC(CHL)
- IF(NMAX.EQ.0) THEN
- IQUEST(1) = 1
- GOTO 99
- ENDIF
- IF(LENG+NMAX.GT.MAXLEN)NMAX=MAXLEN-LENG
- CHTEMP=CHPATH(1:LENG)//'/'//CHL(1:NMAX)
- CHPATH=CHTEMP
- LENG=LENG+NMAX+1
- IF(LENG.EQ.MAXLEN) THEN
- IQUEST(1) = 2
- GOTO 99
- ENDIF
- 20 CONTINUE
-*
- 99 RETURN
- END
diff --git a/src/packlib/zebra/rz/rzpass.F b/src/packlib/zebra/rz/rzpass.F
deleted file mode 100644
index 41d7c5a..0000000
--- a/src/packlib/zebra/rz/rzpass.F
+++ /dev/null
@@ -1,75 +0,0 @@
-*
-* $Id: rzpass.F,v 1.2 1996/04/24 17:27:04 mclareni Exp $
-*
-* $Log: rzpass.F,v $
-* Revision 1.2 1996/04/24 17:27:04 mclareni
-* Extend the include file cleanup to dzebra, rz and tq, and also add
-* dependencies in some cases.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:26 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE RZPASS(CHPASS,CHOPT)
-*
-************************************************************************
-*
-* To declare or change the password
-* Input:
-* CHPASS Character string specifying the password.
-* CHOPT Character string specifying the options desired:
-* ' ' Specifies the password
-* 'S' Set or change the password (to change the password a
-* previous call to RZPASS specifying the old password
-* must have been made).
-*
-* Called by <USER>
-*
-* Author : R.Brun DD/US/PD
-* Written : 12.04.86
-* Last mod: 12.04.86
-*
-************************************************************************
-#include "zebra/rzcl.inc"
-#include "zebra/rzclun.inc"
-#include "zebra/rzk.inc"
- CHARACTER*(*) CHPASS,CHOPT
-*
-*-----------------------------------------------------------------------
-*
-
-#include "zebra/q_jbit.inc"
-#include "zebra/q_jbyt.inc"
-
- IQUEST(1)=0
- CALL UOPTC(CHOPT,'S',IOPTS)
-*
- NHPWD=LEN(CHPASS)
- IF(NHPWD.GT.8)NHPWD=8
- IF(CHPASS.EQ.' ')NHPWD=0
- CALL VBLANK(IHPWD,2)
- IF(NHPWD.GT.0)CALL UCTOH(CHPASS,IHPWD,4,NHPWD)
- CALL ZHTOI(IHPWD,IHPWD,2)
-*
- IF(IOPTS.NE.0)THEN
- IFLAG=0
- CALL RZMODS('RZPASS',IFLAG)
- IF(IFLAG.NE.0)GO TO 99
- IF(NHPWD.GT.0)CALL UCOPY(IHPWD,IQ(KQSP+LCDIR+KPW1),2)
- CALL SBYT(NHPWD,IQ(KQSP+LCDIR+KPW1+2),6,5)
- ENDIF
-*
-* Remove lock for CWD if passwork OK
-*
- IF(JBYT(IQ(KQSP+LCDIR+KPW1+2),6,5).NE.0)THEN
- IF(JBIT(IQ(KQSP+LTOP),1).EQ.0)THEN
- IF(IQ(KQSP+LCDIR+KPW1 ).EQ.IHPWD(1).AND.
- + IQ(KQSP+LCDIR+KPW1+1).EQ.IHPWD(2))THEN
- CALL SBIT0(IQ(KQSP+LCDIR),1)
- ENDIF
- ENDIF
- ENDIF
-*
- 99 RETURN
- END
diff --git a/src/packlib/zebra/rz/rzpath.F b/src/packlib/zebra/rz/rzpath.F
deleted file mode 100644
index 5a2a2e0..0000000
--- a/src/packlib/zebra/rz/rzpath.F
+++ /dev/null
@@ -1,182 +0,0 @@
-*
-* $Id: rzpath.F,v 1.1.1.1 1996/03/06 10:47:26 mclareni Exp $
-*
-* $Log: rzpath.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:26 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE RZPATH(CHPATH)
-************************************************************************
-*
-* RZPATH will decode the character string CHPATH into a character
-* array CHPAT(1),,CHPAT(NLPAT)
-* where NLPAT is the number of levels starting from the root directory
-*
-* Input:
-* *CHPATH* Character variable specifying the pathname
-*
-* Called by RZCDIR,RZCOPY,RZLDIR,RZNDIR
-*
-* Author : R.Brun DD/US/PD
-* Written : 01.04.86
-* Last mod: 15.11.91 J.Shiers Support Unix-style .. as well as \
-*
-************************************************************************
-#include "zebra/zbcdch.inc"
- CHARACTER*1 BSLASH,KTILDE
-#include "zebra/zunit.inc"
-#include "zebra/rzdir.inc"
- CHARACTER*(*) CHPATH
- CHARACTER*1 CH1
- CHARACTER*2 CH2
-*
-*-----------------------------------------------------------------------
-*
- BSLASH=CQALLC(61:61)
- KTILDE=CQALLC(94:94)
- NCHP=LEN(CHPATH)
- NLPAT=0
- 10 IF(CHPATH(NCHP:NCHP).EQ.' ')THEN
- NCHP=NCHP-1
- IF(NCHP.GT.0)GO TO 10
- NLPAT=NLCDIR
- DO 20 I=1,NLCDIR
- CHPAT(I)=CHCDIR(I)
- 20 CONTINUE
- GO TO 99
- ENDIF
-*
- IS1=1
- 30 IF(CHPATH(IS1:IS1).EQ.' ')THEN
- IS1=IS1+1
- GO TO 30
- ENDIF
-*
- CH1=CHPATH(IS1:IS1)
- CH2=CHPATH(IS1:IS1+1)
- IF(CH1.EQ.'/')THEN
- IF(CHPATH(IS1+1:IS1+1).EQ.'/')THEN
-*
-* Case where Path starts with //Topdirectory
-*
- IS=IS1+2
- IF(IS.GT.NCHP)GO TO 99
- 40 IF(CHPATH(IS:IS).EQ.'/')THEN
- IF(IS.EQ.IS1+2)GO TO 90
- NLPAT=1
- CHPAT(1)=CHPATH(IS1+2:IS-1)
- IS1=IS+1
- IS=IS1
- GO TO 50
- ELSE
- IS=IS+1
- IF(IS.LT.NCHP)GO TO 40
- NLPAT=1
- CHPAT(1)=CHPATH(IS1+2:IS)
- GO TO 99
- ENDIF
- ENDIF
-*
-* Case where Path starts just below topdirectory /a/b/c
-*
- IF(CHPATH(IS1+1:IS1+1).EQ.BSLASH)GO TO 90
- IF(CHPATH(IS1+1:IS1+1).EQ.KTILDE)GO TO 90
- NLPAT=1
- CHPAT(1)=CHCDIR(1)
- IS=IS1+1
- IS1=IS
-*
- 50 IF(IS.EQ.NCHP)THEN
- IF(CHPATH(IS1:IS).NE.'..'.AND.
- + CHPATH(IS1:IS).NE.BSLASH) THEN
- NLPAT=NLPAT+1
- IF(NLPAT.GT.NLPATM)GO TO 90
- CHPAT(NLPAT)=CHPATH(IS1:IS)
- ELSE
- NLPAT = NLPAT -1
- ENDIF
- GO TO 99
- ELSE
- IF(CHPATH(IS:IS).EQ.'/')THEN
- IF(NLPAT.GT.NLPATM)GO TO 90
- IF(CHPATH(IS1:IS-1).NE.'..'.AND.
- + CHPATH(IS1:IS-1).NE.BSLASH) THEN
- NLPAT=NLPAT+1
- CHPAT(NLPAT)=CHPATH(IS1:IS-1)
- ELSE
- NLPAT = NLPAT - 1
- ENDIF
- IS1=IS+1
- ENDIF
- IS=IS+1
- GO TO 50
- ENDIF
- ENDIF
-*
-* Case where Path is relative to the naming directory
-*
- IF(CH1.EQ.KTILDE)THEN
- NLPAT=NLNDIR
- DO 60 I=1,NLNDIR
- CHPAT(I)=CHNDIR(I)
- 60 CONTINUE
- IF(IS1.EQ.NCHP)GO TO 99
- IS1=IS1+1
- CH1=CHPATH(IS1:IS1)
- GO TO 75
- ENDIF
-*
-* Case where Path is relative to the working directory
-*
- DO 70 I=1,NLCDIR
- CHPAT(I)=CHCDIR(I)
- 70 CONTINUE
- NLPAT=NLCDIR
-*
- 75 IF(CH1.EQ.BSLASH)THEN
- NLPAT=NLPAT-1
- IF(NLPAT.EQ.0)NLPAT=1
- IF(IS1.EQ.NCHP)GO TO 99
- IS1=IS1+1
- CH1=CHPATH(IS1:IS1)
- GO TO 75
- ENDIF
-*
- IS=IS1
- 76 IF(CH2.EQ.'..')THEN
- NLPAT=NLPAT-1
- IF(NLPAT.EQ.0)NLPAT=1
- IF(IS1+1.EQ.NCHP)GO TO 99
- IF(CHPATH(IS1+2:IS1+2).NE.'/') GOTO 90
- IS =IS1
- IS1=IS1+3
- CH2=CHPATH(IS1:IS1+1)
- GO TO 76
- ENDIF
-*
- 80 IF(IS.EQ.NCHP)THEN
- NLPAT=NLPAT+1
- IF(NLPAT.GT.NLPATM)GO TO 90
- CHPAT(NLPAT)=CHPATH(IS1:IS)
- GO TO 99
- ELSE
- IF(CHPATH(IS:IS).EQ.'/')THEN
- IF(IS.GT.IS1)THEN
- NLPAT=NLPAT+1
- IF(NLPAT.GT.NLPATM)GO TO 90
- CHPAT(NLPAT)=CHPATH(IS1:IS-1)
- ENDIF
- IS1=IS+1
- ENDIF
- IS=IS+1
- GO TO 80
- ENDIF
-*
-* Error in Pathname
-*
- 90 NLPAT=0
-*
- 99 RETURN
- END
diff --git a/src/packlib/zebra/rz/rzprnk.F b/src/packlib/zebra/rz/rzprnk.F
deleted file mode 100644
index 383a7c8..0000000
--- a/src/packlib/zebra/rz/rzprnk.F
+++ /dev/null
@@ -1,96 +0,0 @@
-*
-* $Id: rzprnk.F,v 1.3 1999/06/14 13:59:30 couet Exp $
-*
-* $Log: rzprnk.F,v $
-* Revision 1.3 1999/06/14 13:59:30 couet
-* - Mods for Y2K in the date/time output
-*
-* Revision 1.2 1996/04/24 17:27:05 mclareni
-* Extend the include file cleanup to dzebra, rz and tq, and also add
-* dependencies in some cases.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:26 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE RZPRNK(CHPATH,IKEY,ICYC,CHOPT)
-*
-************************************************************************
-*
-* Generic printing routine for RZ keys
-*
-* Input:
-* CHPATH Character variable specifying the pathname
-* IKEY Key number
-* ICYC Cycle number
-* CHOPT Character option
-*
-* Called by RZVER1
-*
-* Author :
-* Written :
-* Last mod: 04.03.94 S.Banerjee (Change in cycle structure)
-*
-************************************************************************
- CHARACTER*(*) CHPATH,CHOPT
-#include "zebra/zunit.inc"
-#include "zebra/rzcl.inc"
-#include "zebra/rzk.inc"
-#include "zebra/rzclun.inc"
-#include "zebra/rzcycle.inc"
- CHARACTER*80 CHLINE
- DIMENSION IHTAG(2)
- DIMENSION KEYS(KNMAX)
-#include "zebra/q_jbyt.inc"
-*
-*-----------------------------------------------------------------------
-*
- IF(LQRS.EQ.0) GOTO 99
- IF(LCDIR.EQ.0) GOTO 99
-
- LK = IQ(KQSP+LCDIR+KLK)
- NK = IQ(KQSP+LCDIR+KNKEYS)
- NWK= IQ(KQSP+LCDIR+KNWKEY)
- KTAGS=KKDES+(NWK-1)/10+1
- LKC=LK+(NWK+1)*(IKEY-1)
- LCYC=IQ(KQSP+LCDIR+LKC)
- CALL RZDATE( IQ(KQSP+LCDIR+LCYC+KFLCYC),IDATE,ITIME,1)
-
- WRITE(IQPRNT,*)
- WRITE(IQPRNT,9001) CHPATH(1:LENOCC(CHPATH)),IKEY,ICYC,IDATE,ITIME
-9001 FORMAT(' Directory: ',A,/' Object : ',I10,1X,
- + ' Cycle : ',I10,1X,' Created : ',I6.6,1X,I4.4)
-*
-* Get keys vector and tag definitions
-*
- CHLINE = ' '
- ISTART = 1
-
- K=LK+(NWK+1)*(IKEY-1)
- DO 10 J=1,NWK
- IKDES=(J-1)/10
- IKBIT1=3*J-30*IKDES-2
- CALL ZITOH(IQ(KQSP+LCDIR+KTAGS+2*J-2),IHTAG,2)
- CALL UHTOC(IHTAG,4,CHLINE(ISTART:),8)
- CHLINE(ISTART+8:) = ': '
- ISTART=ISTART + 10
- IFORM=JBYT(IQ(KQSP+LCDIR+KKDES+IKDES),IKBIT1,3)
- IF(IFORM.LT.3)THEN
- WRITE(CHLINE(ISTART:ISTART+9),'(I10)') IQ(KQSP+LCDIR+K+J)
- ELSE
- CALL ZITOH(IQ(KQSP+LCDIR+K+J),KEYS,1)
- CALL UHTOC(KEYS,4,CHLINE(ISTART+6:),4)
- ENDIF
-
- ISTART = ISTART + 12
- IF(ISTART+20.GT.LEN(CHLINE).OR.J.EQ.NWK) THEN
- WRITE(IQPRNT,*) CHLINE(1:LENOCC(CHLINE))
- CHLINE = ' '
- ISTART = 1
- ENDIF
-
- 10 CONTINUE
-*
- 99 RETURN
- END
diff --git a/src/packlib/zebra/rz/rzpurf.F b/src/packlib/zebra/rz/rzpurf.F
deleted file mode 100644
index ea07c6f..0000000
--- a/src/packlib/zebra/rz/rzpurf.F
+++ /dev/null
@@ -1,116 +0,0 @@
-*
-* $Id: rzpurf.F,v 1.1.1.1 1996/03/06 10:47:26 mclareni Exp $
-*
-* $Log: rzpurf.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:26 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE RZPURF(N,KPURG)
-*
-************************************************************************
-*
-* Update list of purged records
-* Input:
-* N Number of consecutive records purged
-* KPURG First of the N records purged
-*
-* Called by RZPURG
-*
-* Author : R.Brun DD/US/PD
-* Written : 06.04.86
-* Last mod: 22.08.90
-*
-************************************************************************
-*
-#include "zebra/rzcl.inc"
-#include "zebra/rzclun.inc"
-#include "zebra/rzk.inc"
-*
-*-----------------------------------------------------------------------
-*
- IF(LQ(KQSP+LTOP-5).EQ.0)THEN
- CALL MZBOOK(JQPDVS,LPURG,LTOP,-5,'RZPU',0,0,21,2,0)
- IQ(KQSP+LPURG-5)=LUN
- ENDIF
-*
- IF(KPURG.EQ.0)GO TO 99
- IPURG=KPURG
- IPURL=IPURG+N-1
- DO 2 I=IPURG,IPURL
- IF(I.EQ.IQ(KQSP+LCDIR+KRLOUT))THEN
- IQ(KQSP+LCDIR+KRLOUT)=0
- IQ(KQSP+LCDIR+KIP1)=1
- ENDIF
- 2 CONTINUE
- NPURG=IQ(KQSP+LPURG+1)
- IF(NPURG.EQ.0)THEN
- IQ(KQSP+LPURG+1)=1
- IQ(KQSP+LPURG+2)=IPURG
- IQ(KQSP+LPURG+3)=IPURL
- GO TO 99
- ENDIF
-*
- DO 5 I=1,NPURG
- IRF=IQ(KQSP+LPURG+2*I)
- IRL=IQ(KQSP+LPURG+2*I+1)
- IF(IPURG.GE.IRF.AND.IPURG.LE.IRL)IPURG=IRL+1
- IF(IPURL.GE.IRF.AND.IPURL.LE.IRL)IPURL=IRF-1
- IF(IPURG.GT.IPURL)GO TO 99
- 5 CONTINUE
-*
- IPU=2
- 10 IF(IPURL.LT.IQ(KQSP+LPURG+IPU))THEN
- IF(IPURL.EQ.IQ(KQSP+LPURG+IPU)-1)THEN
- IQ(KQSP+LPURG+IPU)=IPURG
- ELSE
- IF(IPU.GT.2.AND.IPURG.LE.IQ(KQSP+LPURG+IPU-1))GO TO 99
- NDATA=IQ(KQSP+LPURG-1)
- IF(NDATA.LT.2*NPURG+3)THEN
- CALL MZPUSH(JQPDVS,LPURG,0,10,'I')
- ENDIF
- NLEFT=2*NPURG-IPU+2
- IF(NLEFT.GT.0)THEN
- CALL UCOPY2(IQ(KQSP+LPURG+IPU),
- + IQ(KQSP+LPURG+IPU+2),NLEFT)
- ENDIF
- NPURG=NPURG+1
- IQ(KQSP+LPURG+1)=NPURG
- IQ(KQSP+LPURG+IPU)=IPURG
- IQ(KQSP+LPURG+IPU+1)=IPURL
- ENDIF
- GO TO 99
- ENDIF
-*
- IF(IPURG.EQ.IQ(KQSP+LPURG+IPU+1)+1)THEN
- IQ(KQSP+LPURG+IPU+1)=IPURL
- IF(IPU+2.LT.2*NPURG)THEN
- IF(IQ(KQSP+LPURG+IPU+1).EQ.IQ(KQSP+LPURG+IPU+2))THEN
- IQ(KQSP+LPURG+IPU+1)=IQ(KQSP+LPURG+IPU+3)
- NLEFT=2*NPURG-IPU-2
- IF(NLEFT.GT.0)THEN
- CALL UCOPY2(IQ(KQSP+LPURG+IPU+4),
- + IQ(KQSP+LPURG+IPU+2),NLEFT)
- ENDIF
- NPURG=NPURG-1
- IQ(KQSP+LPURG+1)=NPURG
- ENDIF
- ENDIF
- GO TO 99
- ENDIF
-*
- IPU=IPU+2
- IF(IPU.LE.2*NPURG)GO TO 10
-*
- NDATA=IQ(KQSP+LPURG-1)
- IF(NDATA.LT.2*NPURG+3)THEN
- CALL MZPUSH(JQPDVS,LPURG,0,2,'I')
- ENDIF
- IQ(KQSP+LPURG+IPU)=IPURG
- IQ(KQSP+LPURG+IPU+1)=IPURL
- NPURG=NPURG+1
- IQ(KQSP+LPURG+1)=NPURG
-*
- 99 RETURN
- END
diff --git a/src/packlib/zebra/rz/rzpurg.F b/src/packlib/zebra/rz/rzpurg.F
deleted file mode 100644
index 6f526d9..0000000
--- a/src/packlib/zebra/rz/rzpurg.F
+++ /dev/null
@@ -1,311 +0,0 @@
-*
-* $Id: rzpurg.F,v 1.2 1996/04/24 17:27:05 mclareni Exp $
-*
-* $Log: rzpurg.F,v $
-* Revision 1.2 1996/04/24 17:27:05 mclareni
-* Extend the include file cleanup to dzebra, rz and tq, and also add
-* dependencies in some cases.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:26 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE RZPURG(NKEEP)
-*
-************************************************************************
-*
-* Purge cycles in the CWD
-* Input:
-* NKEEP Number of cycles which must be kept for the given key
-* If NKEEP < 1 then NKEEP is taken to be 1 and only the highest
-* cycle is kept
-*
-* Called by <USER>
-*
-* Author : R.Brun DD/US/PD
-* Written : 06.04.86
-* Last mod: 11.12.88
-* : 04.03.94 S.Banerjee (Change in cycle structure)
-*
-************************************************************************
-#include "zebra/rzcl.inc"
-#include "zebra/rzclun.inc"
-#include "zebra/rzk.inc"
-#include "zebra/rzcycle.inc"
-*
-*-----------------------------------------------------------------------
-*
-#include "zebra/q_jbit.inc"
-#include "zebra/q_jbyt.inc"
-
- IQUEST(1)=0
- NK=NKEEP
- IF(NK.LT.1)NK=1
-*
-* Check if write permission
-*
- IF(LQRS.EQ.0)GO TO 999
- IFLAG=1
- CALL RZMODS('RZPURG',IFLAG)
- IF(IFLAG.NE.0)GO TO 999
-*
- LK=IQ(KQSP+LCDIR+KLK)
- LC=IQ(KQSP+LCDIR+KLC)
- LE=IQ(KQSP+LCDIR+KLE)
- NKEYS =IQ(KQSP+LCDIR+KNKEYS)
- NWKEY =IQ(KQSP+LCDIR+KNWKEY)
- IF(NKEYS.EQ.0)GO TO 999
-*
- NPUOLD=0
- IF(LPURG.NE.0)THEN
- NPURG=IQ(KQSP+LPURG+1)
- DO 5 I=1,NPURG
- NPUOLD=NPUOLD+IQ(KQSP+LPURG+2*I+1)-IQ(KQSP+LPURG+2*I)+1
- 5 CONTINUE
- ENDIF
-*
- DO 20 IK=1,NKEYS
- LKC=LK+(NWKEY+1)*(IK-1)
- LCYC=IQ(KQSP+LCDIR+LKC)
- NC=0
- 10 NC=NC+1
- IF (KVSCYC.EQ.0) THEN
- LCOLD = JBYT(IQ(KQSP+LCDIR+LCYC+KPPCYC), 1,16)
- ELSE
- LCOLD = IQ(KQSP+LCDIR+LCYC+KPPCYC)
- ENDIF
-*
-* Check for first cycle to be kept
-*
- LKEEP=LCOLD
- IF(LKEEP.NE.0)THEN
- 12 IF(JBIT(IQ(KQSP+LCDIR+LKEEP+KFLCYC),5).EQ.0)THEN
- IF (KVSCYC.EQ.0) THEN
- LKEEP = JBYT(IQ(KQSP+LCDIR+LKEEP+KPPCYC),1,16)
- ELSE
- LKEEP = IQ(KQSP+LCDIR+LKEEP+KPPCYC)
- ENDIF
- IF(LKEEP.NE.0)GO TO 12
- ENDIF
- ENDIF
- IF(NC.EQ.NK)THEN
- IF (KVSCYC.EQ.0) THEN
- CALL SBYT(LKEEP,IQ(KQSP+LCDIR+LCYC+KPPCYC),1,16)
- ELSE
- IQ(KQSP+LCDIR+LCYC+KPPCYC) = LKEEP
- ENDIF
- ENDIF
- IF(NC.GT.NK)THEN
- IF(JBIT(IQ(KQSP+LCDIR+LCYC+KFLCYC),5).NE.0)THEN
- IF (KVSCYC.EQ.0) THEN
- CALL SBYT(LKEEP,IQ(KQSP+LCDIR+LCYC+KPPCYC),1,16)
- ELSE
- IQ(KQSP+LCDIR+LCYC+KPPCYC) = LKEEP
- ENDIF
- GO TO 15
- ENDIF
- IF (KVSCYC.EQ.0) THEN
- IR1 = JBYT(IQ(KQSP+LCDIR+LCYC+KFRCYC),17,16)
- IP1 = JBYT(IQ(KQSP+LCDIR+LCYC+KORCYC), 1,16)
- NW = JBYT(IQ(KQSP+LCDIR+LCYC+KNWCYC), 1,20)
- IR2 = JBYT(IQ(KQSP+LCDIR+LCYC+KSRCYC),17,16)
- ELSE
- IR1 = IQ(KQSP+LCDIR+LCYC+KFRCYC)
- IP1 = JBYT(IQ(KQSP+LCDIR+LCYC+KORCYC), 1,20)
- NW = IQ(KQSP+LCDIR+LCYC+KNWCYC)
- IR2 = IQ(KQSP+LCDIR+LCYC+KSRCYC)
- ENDIF
- IRL =0
- NWL =0
-*
-* Mark all records that can be purged in first pass
-*
- NLEFT=LREC-IP1+1
- NW1=NW
- IF(NW1.GE.NLEFT)NW1=NLEFT
- IF(IR2.NE.0)THEN
- NR=(NW-NW1-1)/LREC+1
- IF(NR.GT.1)THEN
- CALL RZPURF(NR-1,IR2)
- ENDIF
- IRL=IR2+NR-1
- NWL=NW-NW1-(NR-1)*LREC
- ENDIF
- IF(NW1.EQ.LREC)THEN
- CALL RZPURF(1,IR1)
- IR1=0
- ENDIF
- IF(NWL.EQ.LREC)THEN
- CALL RZPURF(1,IRL)
- IRL=0
- ENDIF
- IRLOUT=IQ(KQSP+LCDIR+KRLOUT)
- IF(IRL.EQ.IRLOUT.AND.NWL+1.EQ.IQ(KQSP+LCDIR+KIP1))THEN
- CALL RZPURF(1,IRL)
- ENDIF
- IQ(KQSP+LCDIR+LCYC )=-1
- IQ(KQSP+LCDIR+LCYC+1)=IR1
- IQ(KQSP+LCDIR+LCYC+2)=IRL
- ENDIF
-*
- 15 IF(LCOLD.NE.0.AND.LCOLD.NE.LCYC)THEN
- LCYC=LCOLD
- GO TO 10
- ENDIF
- 20 CONTINUE
-*
-* Now loop on all purged cycles to find complete records
-* purged
-*
- DO 70 LKC=LC,LE-KLCYCL+1,KLCYCL
- IF(IQ(KQSP+LCDIR+LKC).NE.-1)GO TO 70
- IR1=IQ(KQSP+LCDIR+LKC+1)
- IRL=IQ(KQSP+LCDIR+LKC+2)
- IF(IR1.NE.0)THEN
- DO 30 LKC1=LC,LE-KLCYCL+1,KLCYCL
- IF(IQ(KQSP+LCDIR+LKC1).EQ.-1)GO TO 30
- IF (KVSCYC.EQ.0) THEN
- KR1 = JBYT(IQ(KQSP+LCDIR+LKC1+KFRCYC),17,16)
- KP1 = JBYT(IQ(KQSP+LCDIR+LKC1+KORCYC), 1,16)
- NW = JBYT(IQ(KQSP+LCDIR+LKC1+KNWCYC), 1,20)
- KR2 = JBYT(IQ(KQSP+LCDIR+LKC1+KSRCYC),17,16)
- ELSE
- KR1 = IQ(KQSP+LCDIR+LKC1+KFRCYC)
- KP1 = JBYT(IQ(KQSP+LCDIR+LKC1+KORCYC), 1,20)
- NW = IQ(KQSP+LCDIR+LKC1+KNWCYC)
- KR2 = IQ(KQSP+LCDIR+LKC1+KSRCYC)
- ENDIF
- KRL =0
- NLEFT=LREC-KP1+1
- NW1=NW
- IF(NW1.GE.NLEFT)NW1=NLEFT
- IF(KR2.NE.0)THEN
- NR=(NW-NW1-1)/LREC+1
- KRL=KR2+NR-1
- ENDIF
- IF(KR1.EQ.IR1.OR.KRL.EQ.IR1)GO TO 40
- 30 CONTINUE
- CALL RZPURF(1,IR1)
- ENDIF
-*
- 40 IF(IRL.NE.0)THEN
- DO 50 LKC1=LC,LE-KLCYCL+1,KLCYCL
- IF(IQ(KQSP+LCDIR+LKC1).EQ.-1)GO TO 50
- IF (KVSCYC.EQ.0) THEN
- KR1 = JBYT(IQ(KQSP+LCDIR+LKC1+KFRCYC),17,16)
- KP1 = JBYT(IQ(KQSP+LCDIR+LKC1+KORCYC), 1,16)
- NW = JBYT(IQ(KQSP+LCDIR+LKC1+KNWCYC), 1,20)
- KR2 = JBYT(IQ(KQSP+LCDIR+LKC1+KSRCYC),17,16)
- ELSE
- KR1 = IQ(KQSP+LCDIR+LKC1+KFRCYC)
- KP1 = JBYT(IQ(KQSP+LCDIR+LKC1+KORCYC), 1,20)
- NW = IQ(KQSP+LCDIR+LKC1+KNWCYC)
- KR2 = IQ(KQSP+LCDIR+LKC1+KSRCYC)
- ENDIF
- KRL =0
- NLEFT=LREC-KP1+1
- NW1=NW
- IF(NW1.GE.NLEFT)NW1=NLEFT
- IF(KR2.NE.0)THEN
- NR=(NW-NW1-1)/LREC+1
- KRL=KR2+NR-1
- ENDIF
- IF(KR1.EQ.IRL.OR.KRL.EQ.IRL)GO TO 70
- 50 CONTINUE
- CALL RZPURF(1,IRL)
- ENDIF
- 70 CONTINUE
-*
-* Garbage collection on cycles area + relocation
-*
- LKC3=LE-KLCYCL+1
- 80 IF(LKC3.LT.LC)GO TO 200
- IF(IQ(KQSP+LCDIR+LKC3).EQ.-1)THEN
- LKC3=LKC3+KLCYCL
- LKC2=LKC3-2*KLCYCL
- 90 IF(IQ(KQSP+LCDIR+LKC2).NE.-1)THEN
- LKC2=LKC2+KLCYCL
- LKC1=LKC2-2*KLCYCL
- IF(LKC1.LT.LC)LKC1=LC
- 100 IF(IQ(KQSP+LCDIR+LKC1).EQ.-1)THEN
- IF(LKC1.GT.LC)LKC1=LKC1+KLCYCL
- ELSE
- IF(LKC1.GT.LC)THEN
- LKC1=LKC1-KLCYCL
- GO TO 100
- ENDIF
- ENDIF
-*
- NPUSH=LKC3-LKC2
- DO 110 LKC=LC,LKC2-KLCYCL,KLCYCL
- IF(IQ(KQSP+LCDIR+LKC).NE.-1)THEN
- IF (KVSCYC.EQ.0) THEN
- LCOLD = JBYT(IQ(KQSP+LCDIR+LKC+KPPCYC),1,16)
- ELSE
- LCOLD = IQ(KQSP+LCDIR+LKC+KPPCYC)
- ENDIF
- IF(LCOLD.GE.LKC1.AND.LCOLD.LT.LKC2)THEN
- LCOLD=LCOLD+NPUSH
- IF (KVSCYC.EQ.0) THEN
- CALL SBYT(LCOLD,IQ(KQSP+LCDIR+LKC+KPPCYC),1,16)
- ELSE
- IQ(KQSP+LCDIR+LKC+KPPCYC) = LCOLD
- ENDIF
- ENDIF
- ENDIF
- 110 CONTINUE
-*
- DO 120 IK=1,NKEYS
- LCYC=IQ(KQSP+LCDIR+LK+(NWKEY+1)*(IK-1))
- IF(LCYC.GE.LKC1.AND.LCYC.LT.LKC2)THEN
- IQ(KQSP+LCDIR+LK+(NWKEY+1)*(IK-1))=
- + IQ(KQSP+LCDIR+LK+(NWKEY+1)*(IK-1))+NPUSH
- ENDIF
- 120 CONTINUE
-*
- CALL UCOPY2(IQ(KQSP+LCDIR+LKC1),IQ(KQSP+LCDIR+LKC1+NPUSH),
- + LKC2-LKC1)
- LKC3=LKC1+NPUSH
- LKC2=LKC1-KLCYCL
- IF(LKC1.NE.LC)GO TO 90
- LC=LC+NPUSH
- GO TO 200
-*
- ELSE
- LKC2=LKC2-KLCYCL
- IF(LKC2.GE.LC)GO TO 90
- ENDIF
- ELSE
- LKC3=LKC3-KLCYCL
- GO TO 80
- ENDIF
-*
-* Reset internal pointers
-*
- 200 CONTINUE
-*
- NPUNEW=0
- IF(LPURG.NE.0)THEN
- NPURG=IQ(KQSP+LPURG+1)
- DO 210 I=1,NPURG
- NPUNEW=NPUNEW+IQ(KQSP+LPURG+2*I+1)-IQ(KQSP+LPURG+2*I)+1
- 210 CONTINUE
- ENDIF
- NPU=NPUNEW-NPUOLD
- IQUEST( 9)=IQ(KQSP+LCDIR+KQUOTA)-IQ(KQSP+LCDIR+KRUSED)+NPU
- IQUEST(11)=(LC-IQ(KQSP+LCDIR+KLC))/KLCYCL
- IQUEST(12)=NPU*LREC
- IQUEST(13)=NPU
-*
- IQ(KQSP+LCDIR+KRUSED)=IQ(KQSP+LCDIR+KRUSED)-NPU
- NWP=NPU*LREC
- NMEGA=NWP/1000000
- IQ(KQSP+LCDIR+KMEGA)=IQ(KQSP+LCDIR+KMEGA)-NMEGA
- NWP=NWP-1000000*NMEGA
- IQ(KQSP+LCDIR+KWUSED)=IQ(KQSP+LCDIR+KWUSED)-NWP
- IQ(KQSP+LCDIR+KNFREE)=IQ(KQSP+LCDIR+KNFREE)+LC-IQ(KQSP+LCDIR+KLC)
- IQ(KQSP+LCDIR+KLC)=LC
-*
- 999 RETURN
- END
diff --git a/src/packlib/zebra/rz/rzquot.F b/src/packlib/zebra/rz/rzquot.F
deleted file mode 100644
index 1dffc9e..0000000
--- a/src/packlib/zebra/rz/rzquot.F
+++ /dev/null
@@ -1,126 +0,0 @@
-*
-* $Id: rzquot.F,v 1.2 1996/04/24 17:27:06 mclareni Exp $
-*
-* $Log: rzquot.F,v $
-* Revision 1.2 1996/04/24 17:27:06 mclareni
-* Extend the include file cleanup to dzebra, rz and tq, and also add
-* dependencies in some cases.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:26 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE RZQUOT(NQUOTA)
-*
-************************************************************************
-*
-* To set the quota (number of blocks) for the CWD
-* Input:
-* NQUOTA The maximum number of records which can be used by the CWD
-* and its subdirectories
-* By default NQUOTA is equal to the minimum of the total number
-* of records allowed for the complete file (parameter NREC in
-* RZFILE) and the quota of the parent directory.
-*
-* Called by <USER>
-*
-* Author : R.Brun DD/US/PD
-* Written : 03.04.86
-* Last mod: 09.01.91
-* : 30.01.95 J.Shiers. Permit NQUOTA>65000 for new RZ format
-*
-************************************************************************
-#include "zebra/zunit.inc"
-#include "zebra/rzcl.inc"
-#include "zebra/rzk.inc"
-*
-*-----------------------------------------------------------------------
-*
-
-#include "zebra/q_jbyt.inc"
-
- IQUEST(1)=0
- NQUOT=NQUOTA
- LOGLV=JBYT(IQ(KQSP+LTOP),15,3)-3
- IVERS=IQ(KQSP+LTOP+KRZVER)
-*
-* Limit quota to maximum for original RZ format
-*
- IF(IVERS.EQ.0.AND.NQUOT.GT.65000)THEN
- NQUOT=65000
- IF(LOGLV.GE.-1) WRITE(IQLOG,4000) NQUOT
- 4000 FORMAT(' RZQUOT. Quota set to maximum allowed value = ',I6)
- ENDIF
-*
-* Check permission
-*
- IFLAG=0
- CALL RZMODS('RZQUOT',IFLAG)
- IF(IFLAG.NE.0)GOTO 99
-*
-* Sub-directory case
-*
- IF(LCDIR.NE.LTOP)THEN
- LPAR=LQ(KQSP+LCDIR+1)
- IF(NQUOT.GE.IQ(KQSP+LPAR+KQUOTA))THEN
- IF(LOGLV.GE.-2) WRITE(IQLOG,1000)
- 1000 FORMAT(' RZQUOT. Quota exceeds parent directory quota')
- IQUEST(1)=1
- IQUEST(10)=NQUOT
- IQUEST(11)=IQ(KQSP+LPAR+KQUOTA)
- GOTO 99
- ENDIF
- IQ(KQSP+LCDIR+KQUOTA)=NQUOT
- IF(NQUOT.LT.IQ(KQSP+LCDIR+KRUSED))THEN
- IF(LOGLV.GE.-1) WRITE(IQLOG,2000)
- 2000 FORMAT(' RZQUOT. WARNING !! Records exceed new quota')
- IQUEST(10)=NQUOT
- IQUEST(11)=IQ(KQSP+LCDIR+KRUSED)
- ENDIF
- GOTO 99
- ENDIF
-*
-* Top-directory
-*
- IF(NQUOT.EQ.IQ(KQSP+LTOP+KQUOTA))GOTO 99
- IF(NQUOT.LT.IQ(KQSP+LTOP+KQUOTA))THEN
- IF(NQUOT.LT.IQ(KQSP+LTOP+KRUSED))THEN
- NQUOT=IQ(KQSP+LTOP+KRUSED)
- IF(LOGLV.GE.-1) WRITE(IQLOG,3000)NQUOT
- 3000 FORMAT(' RZQUOT. Cannot reduce quota below ',I5,' records')
- ENDIF
- GOTO 80
- ENDIF
-*
-* Increase quota for the file
-*
- LB=IQ(KQSP+LTOP+KLB)
- NWREC=IQ(KQSP+LTOP+LB)
- NWNEW=(NQUOT-1)/32 +1
- IF(NWNEW.EQ.NWREC)GOTO 80
- IQ(KQSP+LTOP+LB)=NWNEW
- NWFREE=IQ(KQSP+LTOP+KNFREE)
- NMORE=NWNEW-NWREC
- IF(NMORE.GT.NWFREE)THEN
- CALL RZEXPD('RZQUOT',NMORE+5)
- IF(IQUEST(1).NE.0)GOTO 99
- ENDIF
-*
-* Copy S and K blocks
-*
- LS=IQ(KQSP+LTOP+KLS)
- LK=IQ(KQSP+LTOP+KLK)
- LF=IQ(KQSP+LTOP+KLF)
- CALL UCOPY2(IQ(KQSP+LTOP+LS),IQ(KQSP+LTOP+LS+NMORE),LF-LS)
- CALL VZERO(IQ(KQSP+LTOP+LS),NMORE)
- IQ(KQSP+LTOP+KLS)=LS+NMORE
- IQ(KQSP+LTOP+KLK)=LK+NMORE
- IQ(KQSP+LTOP+KLF)=LF+NMORE
- IQ(KQSP+LTOP+KNFREE)=NWFREE-NMORE
-*
- 80 IQ(KQSP+LTOP+KQUOTA)=NQUOT
- NFREE=IQ(KQSP+LFREE+1)
- IQ(KQSP+LFREE+2*NFREE+1)=NQUOT
-*
- 99 END
diff --git a/src/packlib/zebra/rz/rzrdir.F b/src/packlib/zebra/rz/rzrdir.F
deleted file mode 100644
index 3e84bc5..0000000
--- a/src/packlib/zebra/rz/rzrdir.F
+++ /dev/null
@@ -1,64 +0,0 @@
-*
-* $Id: rzrdir.F,v 1.1.1.1 1996/03/06 10:47:26 mclareni Exp $
-*
-* $Log: rzrdir.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:26 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE RZRDIR(MAXDIR,CHDIR,NDIR)
-*
-************************************************************************
-*
-* Returns the list of subdirectories of the CWD
-* Input:
-* MAXDIR Length of the character array CHDIR
-* Output:
-* CHDIR* Character array which will contain the directory names
-* attached to the CWD. If the length of the directory name is
-* greater then the length of one element of CHDIR (as obtained
-* by the LEN function), only as many characters as will fit in
-* the array element are returned, and an error code will be set
-* in IQUEST(1).
-* NDIR* Actual number of subdirectories attached to the CWD
-* If this number is greater than MAXDIR, only the first MAXDIR
-* directory names will be returned in CHDIR (see IQUEST(12))
-*
-* Called by <USER>
-*
-* Author : R.Brun DD/US/PD
-* Written : 11.04.86
-* Last mod: 19.08.86
-*
-************************************************************************
-#include "zebra/rzcl.inc"
-#include "zebra/rzk.inc"
- DIMENSION IHDIR(4)
- CHARACTER*(*) CHDIR(*)
-*
-*-----------------------------------------------------------------------
-*
- IQUEST(1)=0
- NDIR=0
- IF(LQRS.EQ.0) GO TO 99
- IF(LCDIR.EQ.0)GO TO 99
- NCHMAX= LEN(CHDIR(1))
- NCH = MIN(NCHMAX,16)
- LS = IQ(KQSP+LCDIR+KLS)
- NSDIR = IQ(KQSP+LCDIR+KNSD)
- IF(NSDIR.LE.MAXDIR)THEN
- NDIR=NSDIR
- ELSE
- NDIR=MAXDIR
- IQUEST(1)=1
- ENDIF
- IQUEST(11)=NSDIR
-*
- DO 10 I=1,NDIR
- CALL ZITOH(IQ(KQSP+LCDIR+LS+7*(I-1)),IHDIR,4)
- CALL UHTOC(IHDIR,4,CHDIR(I),NCH)
- 10 CONTINUE
-*
- 99 RETURN
- END
diff --git a/src/packlib/zebra/rz/rzread.F b/src/packlib/zebra/rz/rzread.F
deleted file mode 100644
index 8845c81..0000000
--- a/src/packlib/zebra/rz/rzread.F
+++ /dev/null
@@ -1,232 +0,0 @@
-*
-* $Id: rzread.F,v 1.2 1997/01/28 10:43:18 jamie Exp $
-*
-* $Log: rzread.F,v $
-* Revision 1.2 1997/01/28 10:43:18 jamie
-* bug fix for dble precision on record boundary from Marthe Brun
-*
-* Revision 1.1.1.1 1996/03/06 10:47:26 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE RZREAD(V,N,IPC,IFORM)
-*
-************************************************************************
-*
-* Read N words from input buffer into V
-*
-* Called by RZIN,RZINS,RZVIN
-*
-* Author : R.Brun, B.Holl
-* Written : 07.05.86
-* Last mod: 17.05.93 Change test on IFOCON(1) to .LT.0
-* 28.01.97 Several changes (commented) regarding double
-* precision words falling on record boundaries
-*
-************************************************************************
-#if !defined(CERNLIB_FQXISN)
-#include "zebra/zunit.inc"
-#endif
-#include "zebra/rzcl.inc"
-#include "zebra/rzclun.inc"
-#include "zebra/rzcout.inc"
-#include "zebra/rzk.inc"
-#include "zebra/mzioc.inc"
- DIMENSION V(*)
-*
-*-----------------------------------------------------------------------
-*
-* Find first record
-*
- NL1=LREC-IP1+1
- IF(IPC.LE.NL1)THEN
- IRS=IR1
- IS1=IP1+IPC-1
- ELSE
- NBEF=(IPC-NL1-1)/LREC
- IRS=IR2+NBEF
- IS1 =IPC-NL1-NBEF*LREC
- ENDIF
-*
- LRIN=LQ(KQSP+LTOP-7)
- IF(LRIN.EQ.0)THEN
- CALL MZBOOK(JQPDVS,LRIN,LTOP,-7,'RZIN',0,0,LREC+1,2,-1)
- IQ(KQSP+LRIN-5)=IQ(KQSP+LTOP-5)
- IQ(KQSP+LTOP+KIRIN)=0
- IRIN=0
- ELSE
- IRIN=IQ(KQSP+LTOP+KIRIN)
- ENDIF
- LROUT=LQ(KQSP+LTOP-6)
- IF(LROUT.EQ.0)THEN
- IROUT=0
- ELSE
- IROUT=IQ(KQSP+LTOP+KIROUT)
- ENDIF
- IF(IRS.NE.IRIN)THEN
- IF(IRS.NE.IROUT)THEN
- CALL RZIODO(LUN,LREC,IRS,IQ(KQSP+LRIN+1),1)
- IF(IQUEST(1).NE.0)GO TO 90
- IRIN=IRS
- IQ(KQSP+LTOP+KIRIN)=IRIN
- ENDIF
- ENDIF
-*
-* Read record into array V
-*
-#if !defined(CERNLIB_FQXISN)
- IF(IMODEX.GT.0.AND.IFORM.NE.1)THEN
- NWFOTT = N
- NWFODN = 0
- IF(IFORM.GT.0)THEN
- MFO(1) = IFORM
- MFO(2) = -1
- JFOEND = 2
- ENDIF
- ENDIF
-#endif
- NLEFT=LREC-IS1+1
- IF(N.LE.NLEFT)THEN
- NP1=N
- ELSE
- NP1=NLEFT
- ENDIF
- IF(IRS.NE.IROUT)THEN
-#if !defined(CERNLIB_FQXISN)
- IF(IMODEX.GT.0.AND.IFORM.NE.1)THEN
- NWFOAV=NP1
- CALL FZICV(IQ(KQSP+LRIN+IS1),V)
- IF(NWFOAV.GT.0.OR.IFOCON(1).LT.0)GO TO 95
- IF(NWFOAV.LT.0)IDOUB1=IQ(KQSP+LRIN+IS1+NP1-1)
- IQUEST(1)=0
- ELSE
-#endif
- CALL UCOPY(IQ(KQSP+LRIN+IS1),V,NP1)
-#if !defined(CERNLIB_FQXISN)
- ENDIF
-#endif
- ELSE
-#if !defined(CERNLIB_FQXISN)
- IF(IMODEX.GT.0.AND.IFORM.NE.1)THEN
- NWFOAV=NP1
- CALL FZICV(IQ(KQSP+LROUT+IS1),V)
- IF(NWFOAV.GT.0.OR.IFOCON(1).LT.0)GO TO 95
- IF(NWFOAV.LT.0)IDOUB1=IQ(KQSP+LROUT+IS1+NP1-1)
- IQUEST(1)=0
- ELSE
-#endif
- CALL UCOPY(IQ(KQSP+LROUT+IS1),V,NP1)
-#if !defined(CERNLIB_FQXISN)
- ENDIF
-#endif
- ENDIF
- IF(NP1.LT.N)THEN
- NR=(N-NP1-1)/LREC+1
- IF(IRS.EQ.IR1)THEN
- IRS=IR2
- ELSE
- IRS=IRS+1
- ENDIF
- DO 60 I=1,NR
- IF(I.NE.NR)THEN
-#if !defined(CERNLIB_FQXISN)
- IF(IMODEX.GT.0.AND.IFORM.NE.1)THEN
- CALL RZIODO(LUN,LREC,IRS+I-1,IQ(KQSP+LRIN+1),1)
- IF(IQUEST(1).NE.0)GO TO 90
- IF(NWFOAV.LT.0)THEN
- CALL UCOPY2(IQ(KQSP+LRIN+1),IQ(KQSP+LRIN+2),LREC)
- IQ(KQSP+LRIN+1)=IDOUB1
-* need to convert one extra word if double falls on record boundary
- NWFOAV=LREC+1
- CALL FZICV(IQ(KQSP+LRIN+1),V)
- CALL UCOPY2(IQ(KQSP+LRIN+2),IQ(KQSP+LRIN+1),LREC)
- ELSE
- NWFOAV=LREC
- CALL FZICV(IQ(KQSP+LRIN+1),V)
- ENDIF
- IF(NWFOAV.GT.0.OR.IFOCON(1).LT.0)GO TO 95
-* IF(NWFOAV.LT.0)IDOUB1=IQ(KQSP+LROUT+LREC)
-* should be LRIN
- IF(NWFOAV.LT.0)IDOUB1=IQ(KQSP+LRIN+LREC)
- IQUEST(1)=0
- ELSE
-#endif
- CALL RZIODO(LUN,LREC,IRS+I-1,V(NP1+1),1)
- IF(IQUEST(1).NE.0)GO TO 90
-#if !defined(CERNLIB_FQXISN)
- ENDIF
-#endif
- NP1=NP1+LREC
- ELSE
- NL=N-NP1
- IRIN=IRS+I-1
- IF(IRIN.NE.IROUT)THEN
- CALL RZIODO(LUN,LREC,IRIN,IQ(KQSP+LRIN+1),1)
- IF(IQUEST(1).NE.0)GO TO 90
-#if !defined(CERNLIB_FQXISN)
- IF(IMODEX.GT.0.AND.IFORM.NE.1)THEN
- IF(NWFOAV.LT.0)THEN
- CALL UCOPY2(IQ(KQSP+LRIN+1),IQ(KQSP+LRIN+2),LREC)
- IQ(KQSP+LRIN+1)=IDOUB1
-* need to convert one extra word if double falls on record boundary
- NWFOAV=NL+1
- CALL FZICV(IQ(KQSP+LRIN+1),V)
- CALL UCOPY2(IQ(KQSP+LRIN+2),IQ(KQSP+LRIN+1),LREC)
- ELSE
- NWFOAV=NL
- CALL FZICV(IQ(KQSP+LRIN+1),V)
- ENDIF
- IF(NWFOAV.GT.0.OR.IFOCON(1).LT.0)GO TO 95
- IF(NWFOAV.LT.0)IDOUB1=IQ(KQSP+LRIN+NL)
- IQUEST(1)=0
- ELSE
-#endif
- CALL UCOPY(IQ(KQSP+LRIN+1),V(NP1+1),NL)
-#if !defined(CERNLIB_FQXISN)
- ENDIF
-#endif
- IQ(KQSP+LTOP+KIRIN)=IRIN
- ELSE
-#if !defined(CERNLIB_FQXISN)
- IF(IMODEX.GT.0.AND.IFORM.NE.1)THEN
- IF(NWFOAV.LT.0)THEN
- CALL UCOPY2(IQ(KQSP+LROUT+1),IQ(KQSP+LROUT+2),LREC)
- IQ(KQSP+LROUT+1)=IDOUB1
-* need to convert one extra word if double falls on record boundary
- NWFOAV=NL+1
- CALL FZICV(IQ(KQSP+LROUT+1),V)
- CALL UCOPY2(IQ(KQSP+LROUT+2),IQ(KQSP+LROUT+1),LREC)
- ELSE
- NWFOAV=NL
- CALL FZICV(IQ(KQSP+LROUT+1),V)
- ENDIF
- IF(NWFOAV.GT.0.OR.IFOCON(1).LT.0)GO TO 95
- IF(NWFOAV.LT.0)IDOUB1=IQ(KQSP+LROUT+NL)
- IQUEST(1)=0
- ELSE
-#endif
- CALL UCOPY(IQ(KQSP+LROUT+1),V(NP1+1),NL)
-#if !defined(CERNLIB_FQXISN)
- ENDIF
-#endif
- ENDIF
- ENDIF
- 60 CONTINUE
- ENDIF
- 90 CONTINUE
-#if defined(CERNLIB_QMVAX)
- IF(IRELAT.NE.0)UNLOCK(UNIT=LUN)
-#endif
-#if !defined(CERNLIB_FQXISN)
- GO TO 99
- 95 IQUEST(1) =4
- IQUEST(11)=NWFOTT
- IQUEST(12)=NWFORE
- IQUEST(13)=NWFOAV
- IQUEST(14)=NWFODN
- IF(JBYT(IQ(KQSP+LTOP),15,3)-3.GE.-2) WRITE(IQLOG,1000)
- 1000 FORMAT(' RZREAD. Error during conversion into native format')
-#endif
- 99 RETURN
- END
diff --git a/src/packlib/zebra/rz/rzrenk.F b/src/packlib/zebra/rz/rzrenk.F
deleted file mode 100644
index 7303e91..0000000
--- a/src/packlib/zebra/rz/rzrenk.F
+++ /dev/null
@@ -1,86 +0,0 @@
-*
-* $Id: rzrenk.F,v 1.2 1996/04/24 17:27:07 mclareni Exp $
-*
-* $Log: rzrenk.F,v $
-* Revision 1.2 1996/04/24 17:27:07 mclareni
-* Extend the include file cleanup to dzebra, rz and tq, and also add
-* dependencies in some cases.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:26 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE RZRENK(KEYOLD,KEYNEW)
-*
-************************************************************************
-*
-* To rename a key in the CWD
-* Input:
-* KEYOLD Key array of dimension NWKEY containing the old key vector
-* KEYNEW Key array of dimension NWKEY containing the new key vector
-*
-* Called by <USER>
-*
-* Author : R.Brun DD/US/PD
-* Written : 16.05.86
-* Last mod: 16.05.86
-*
-************************************************************************
-*
-#include "zebra/zunit.inc"
-#include "zebra/rzcl.inc"
-#include "zebra/rzk.inc"
-#include "zebra/rzckey.inc"
- DIMENSION KEYOLD(*),KEYNEW(*)
-*
-*-----------------------------------------------------------------------
-*
-
-#include "zebra/q_jbyt.inc"
-
- IQUEST(1)=0
- IF(LQRS.EQ.0)GO TO 99
-*
-* Check permission
-*
- IFLAG=1
- CALL RZMODS('RZRENK',IFLAG)
- IF(IFLAG.NE.0)GO TO 99
-*
- NKEYS=IQ(KQSP+LCDIR+KNKEYS)
- NWKEY=IQ(KQSP+LCDIR+KNWKEY)
- IF(NKEYS.LE.0)GO TO 90
-*
- DO 10 K=1,NWKEY
- IKDES=(K-1)/10
- IKBIT1=3*K-30*IKDES-2
- IF(JBYT(IQ(KQSP+LCDIR+KKDES+IKDES),IKBIT1,3).LT.3)THEN
- KEY(K)=KEYOLD(K)
- ELSE
- CALL ZHTOI(KEYOLD(K),KEY(K),1)
- ENDIF
- 10 CONTINUE
- DO 40 I=1,NKEYS
- DO 20 K=1,NWKEY
- LKC=IQ(KQSP+LCDIR+KLK)+(NWKEY+1)*(I-1)
- IF(IQ(KQSP+LCDIR+LKC+K).NE.KEY(K))GO TO 40
- 20 CONTINUE
- DO 30 K=1,NWKEY
- IKDES=(K-1)/10
- IKBIT1=3*K-30*IKDES-2
- IF(JBYT(IQ(KQSP+LCDIR+KKDES+IKDES),IKBIT1,3).LT.3)THEN
- IQ(KQSP+LCDIR+LKC+K)=KEYNEW(K)
- ELSE
- CALL ZHTOI(KEYNEW(K),IQ(KQSP+LCDIR+LKC+K),1)
- ENDIF
- 30 CONTINUE
- GO TO 99
- 40 CONTINUE
-*
- 90 IQUEST(1)=1
- IF(JBYT(IQ(KQSP+LTOP),15,3)-3.GE.-2) WRITE(IQLOG,1000)
- 1000 FORMAT(' RZRENK. Current directory contains no keys')
-*
- 99 RETURN
- END
diff --git a/src/packlib/zebra/rz/rzrtop.F b/src/packlib/zebra/rz/rzrtop.F
deleted file mode 100644
index 1797292..0000000
--- a/src/packlib/zebra/rz/rzrtop.F
+++ /dev/null
@@ -1,75 +0,0 @@
-*
-* $Id: rzrtop.F,v 1.2 1996/04/24 17:27:09 mclareni Exp $
-*
-* $Log: rzrtop.F,v $
-* Revision 1.2 1996/04/24 17:27:09 mclareni
-* Extend the include file cleanup to dzebra, rz and tq, and also add
-* dependencies in some cases.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:26 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE RZRTOP
-************************************************************************
-*
-* To read a fresh copy of the Top directory
-*
-* Called by RZFREE,RZLOCK,RZCDIR
-*
-* Author : R.Brun DD/US/PD
-* Written : 04.10.86
-* Last mod: 21.11.91 JDS. Set exchange mode bit if FQXISN
-*
-************************************************************************
-*
-#include "zebra/rzcl.inc"
-#include "zebra/rzclun.inc"
-#include "zebra/rzk.inc"
- DIMENSION NAME(4)
-*
-*-----------------------------------------------------------------------
-*
-
-#include "zebra/q_jbit.inc"
-
- IF(LTOP.LE.0)GO TO 99
- IROUT=IQ(KQSP+LTOP+KIROUT)
- IRIN =IQ(KQSP+LTOP+KIRIN)
- DO 10 I=1,4
- NAME(I)=IQ(KQSP+LTOP+I)
- 10 CONTINUE
-*
- LD=IQ(KQSP+LTOP+KLD)
- NRDOLD=IQ(KQSP+LTOP+LD)
-*
- CALL RZIODO(LUN,LREC,2,IQ(KQSP+LTOP+1),1)
- IF(IQUEST(1).NE.0)GO TO 99
- LD=IQ(KQSP+LTOP+KLD)
- NRD=IQ(KQSP+LTOP+LD)
- IF(NRDOLD.NE.NRD)THEN
- NPUSH=(NRD-NRDOLD)*LREC
- CALL MZPUSH(JQPDVS,LTOP,0,NPUSH,'I')
- ENDIF
-#if defined(CERNLIB_FQXISN)
-*
-* Set exchange mode bit
-*
- CALL SBIT1(IQ(KQSP+LTOP+KPW1+2),12)
-#endif
- IMODEX = JBIT(IQ(KQSP+LTOP+KPW1+2),12)
-*
- DO 20 I=2,NRD
- IREC=IQ(KQSP+LTOP+LD+I)
- CALL RZIODO(LUN,LREC,IREC,IQ(KQSP+LTOP+(I-1)*LREC+1),1)
- IF(IQUEST(1).NE.0)GO TO 99
- 20 CONTINUE
-*
- DO 30 I=1,4
- IQ(KQSP+LTOP+I)=NAME(I)
- 30 CONTINUE
- IQ(KQSP+LTOP+KIROUT)=IROUT
- IQ(KQSP+LTOP+KIRIN )=IRIN
- 99 RETURN
- END
diff --git a/src/packlib/zebra/rz/rzsame.F b/src/packlib/zebra/rz/rzsame.F
deleted file mode 100644
index e660e02..0000000
--- a/src/packlib/zebra/rz/rzsame.F
+++ /dev/null
@@ -1,39 +0,0 @@
-*
-* $Id: rzsame.F,v 1.1.1.1 1996/03/06 10:47:26 mclareni Exp $
-*
-* $Log: rzsame.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:26 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- LOGICAL FUNCTION RZSAME(IH1,IH2,N)
-************************************************************************
-*
-* To compare two hollerith strings
-* Input:
-* IH1,IH2 two arrays of length N to be compared
-*
-* Called by RZDELT,RZEND,RZFDIR,RZMDIR
-*
-* Author : R.Brun DD/US/PD
-* Written : 01.04.86
-* Last mod: 01.04.86
-*
-************************************************************************
- DIMENSION IH1(N),IH2(N)
-*
-*-----------------------------------------------------------------------
-*
- IF(N.LE.0)GO TO 20
-*
- DO 10 I=1,N
- IF(IH1(I).NE.IH2(I))GO TO 20
- 10 CONTINUE
- RZSAME=.TRUE.
- GO TO 99
-*
- 20 RZSAME=.FALSE.
-*
- 99 RETURN
- END
diff --git a/src/packlib/zebra/rz/rzsave.F b/src/packlib/zebra/rz/rzsave.F
deleted file mode 100644
index 7806bc8..0000000
--- a/src/packlib/zebra/rz/rzsave.F
+++ /dev/null
@@ -1,134 +0,0 @@
-*
-* $Id: rzsave.F,v 1.1.1.1 1996/03/06 10:47:26 mclareni Exp $
-*
-* $Log: rzsave.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:26 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE RZSAVE
-*
-************************************************************************
-*
-* Write all directories which have been modified in memory
-* Write current output buffer
-* Update list of used/unused records in top-directory
-*
-* Called by <USER>,RZCDIR,RZCOPY,RZEND,RZFILE,RZMAKE
-*
-* Author : R.Brun DD/US/PD
-* Written : 02.04.86
-* Last mod: 04.10.90
-*
-************************************************************************
-#include "zebra/rzcl.inc"
-#include "zebra/rzclun.inc"
-#include "zebra/rzk.inc"
-*
-*-----------------------------------------------------------------------
-*
-#include "zebra/q_jbit.inc"
- IF(LQRS.EQ.0)GO TO 99
- IF(LTOP.EQ.0)GO TO 99
-*
-* Mark used records in BITMAP
-*
- IF(JBIT(IQ(KQSP+LTOP),2).NE.0)THEN
- IF(ISAVE.NE.2)THEN
- IDTIME=0
- CALL RZDATE(IDTIME,IDATE,ITIME,2)
- IQ(KQSP+LTOP+KDATEM)=IDTIME
- ENDIF
- LUNC= IQ(KQSP+LTOP-5)
- LB = IQ(KQSP+LTOP+KLB)
- LREK= IQ(KQSP+LTOP+LB+1)
- LUS = LQ(KQSP+LTOP-3)
- IF(LUS.NE.0)THEN
- NUSED=IQ(KQSP+LUS+1)
- IF(NUSED.GT.0)THEN
- DO 40 I=1,NUSED
- IR1=IQ(KQSP+LUS+2*(I-1)+2)
- IRL=IQ(KQSP+LUS+2*(I-1)+3)
- DO 30 J=IR1,IRL
- IWORD = (J-1)/32 + 1
- IBIT = J-32*(IWORD-1)
- CALL SBIT1(IQ(KQSP+LTOP+LB+2+IWORD),IBIT)
- 30 CONTINUE
- 40 CONTINUE
- IQ(KQSP+LUS+1)=0
- ENDIF
- ENDIF
-*
-* Mark purged records in BITMAP
-*
- LPU = LQ(KQSP+LTOP-5)
- IF(LPU.NE.0)THEN
- NPURG=IQ(KQSP+LPU+1)
- IF(NPURG.GT.0)THEN
- DO 60 I=1,NPURG
- IR1=IQ(KQSP+LPU+2*(I-1)+2)
- IRL=IQ(KQSP+LPU+2*(I-1)+3)
- DO 50 J=IR1,IRL
- IWORD = (J-1)/32 + 1
- IBIT = J-32*(IWORD-1)
- CALL SBIT0(IQ(KQSP+LTOP+LB+2+IWORD),IBIT)
- 50 CONTINUE
- 60 CONTINUE
- IQ(KQSP+LPU+1)=0
- ENDIF
- ENDIF
-*
-* Write current buffer
-*
- LROUT=LQ(KQSP+LTOP-6)
- IF(LROUT.NE.0)THEN
- IROUT=IQ(KQSP+LTOP+KIROUT)
- IF(IROUT.NE.0)THEN
- CALL RZIODO(LUNC,LREK,IROUT,IQ(KQSP+LROUT+1),2)
- IF(IQUEST(1).NE.0)GO TO 99
- ENDIF
- ENDIF
-*
-* Write TOP directory
-*
- LDS =IQ(KQSP+LTOP+KLD)
- NRD =IQ(KQSP+LTOP+LDS)
- IF(ISAVE.NE.2)THEN
- IF(LTOP.EQ.LCDIR)IQ(KQSP+LTOP+KDATEM)=IDTIME
- ENDIF
- CALL SBIT0(IQ(KQSP+LTOP),2)
- DO 70 J=NRD,1,-1
- IREC=IQ(KQSP+LTOP+LDS+J)
- L=(J-1)*LREK+1
- CALL RZIODO(LUNC,LREK,IREC,IQ(KQSP+LTOP+L),2)
- IF(IQUEST(1).NE.0)THEN
- CALL SBIT1(IQ(KQSP+LTOP),2)
- GO TO 99
- ENDIF
- 70 CONTINUE
-*
-* Write current directory if modified
-*
- IF(LCDIR.EQ.0.OR.LTOP.EQ.LCDIR)GO TO 99
- IF(JBIT(IQ(KQSP+LCDIR),2).NE.0)THEN
- LDS =IQ(KQSP+LCDIR+KLD)
- NRD =IQ(KQSP+LCDIR+LDS)
- IF(ISAVE.NE.2)THEN
- IQ(KQSP+LCDIR+KDATEM)=IDTIME
- ENDIF
- CALL SBIT0(IQ(KQSP+LCDIR),2)
- DO 80 J=NRD,1,-1
- IREC=IQ(KQSP+LCDIR+LDS+J)
- L=(J-1)*LREK+1
- CALL RZIODO(LUNC,LREK,IREC,IQ(KQSP+LCDIR+L),2)
- IF(IQUEST(1).NE.0)THEN
- CALL SBIT1(IQ(KQSP+LCDIR),2)
- GO TO 99
- ENDIF
- 80 CONTINUE
- ENDIF
- ENDIF
-*
- 99 RETURN
- END
diff --git a/src/packlib/zebra/rz/rzscan.F b/src/packlib/zebra/rz/rzscan.F
deleted file mode 100644
index 76f49b7..0000000
--- a/src/packlib/zebra/rz/rzscan.F
+++ /dev/null
@@ -1,100 +0,0 @@
-*
-* $Id: rzscan.F,v 1.1.1.1 1996/03/06 10:47:26 mclareni Exp $
-*
-* $Log: rzscan.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:26 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE RZSCAN(CHPATH,UROUT)
-*
-************************************************************************
-*
-* Scan all directories from CHPATH and call user routine UROUT
-* for directory CHPATH and for every subdirectory.
-* Input:
-* CHPATH Character variable specifying the directory pathname.
-* ' ' means the CWD.
-* UROUT EXTERNAL user routine to be called for each directory
-*
-* Called by <USER>
-*
-* Author : R.Brun DD/US/PD
-* Written : 17.07.91
-* Last mod: 22.10.92 JDS - return immediately if cannot cd to CHPATH
-*
-************************************************************************
-#include "zebra/rzcl.inc"
-#include "zebra/rzdir.inc"
-#include "zebra/rzch.inc"
-#include "zebra/rzk.inc"
- CHARACTER *(*) CHPATH
- EXTERNAL UROUT
- DIMENSION ISD(NLPATM),NSD(NLPATM),IHDIR(4)
-*
-*-----------------------------------------------------------------------
-*
- IQUEST(1)=0
- IF(LQRS.EQ.0)GO TO 99
-*
-* General case
-*
- IF(LCDIR.EQ.0)GO TO 99
- CALL RZCDIR(CHWOLD,'R')
- CALL RZCDIR(CHPATH,' ')
- IF(IQUEST(1).NE.0) GOTO 99
- CALL RZPAFF(CHPAT,NLPAT,CHL)
- NLPAT0=NLPAT
- ITIME=0
-*
-*
-* Set CWD to the current level
-*
- 10 CONTINUE
- IF(ITIME.NE.0)THEN
- CALL RZPAFF(CHPAT,NLPAT,CHL)
- IF(IQUEST(1).NE.0)THEN
- NLPAT=NLPAT-1
- GO TO 20
- ENDIF
- CALL RZCDIR(CHL,' ')
- ENDIF
- IF(IQUEST(1).NE.0)THEN
- NLPAT=NLPAT-1
- GO TO 20
- ENDIF
- ISD(NLPAT)=0
- NSD(NLPAT)=IQ(KQSP+LCDIR+KNSD)
-*
-* List current directory
-*
- CALL UROUT(CHL)
-*
-* Process possible down directories
-*
- 20 ISD(NLPAT)=ISD(NLPAT)+1
- IF(ISD(NLPAT).LE.NSD(NLPAT))THEN
- NLPAT=NLPAT+1
- LS=IQ(KQSP+LCDIR+KLS)
- IH=LS+7*(ISD(NLPAT-1)-1)
- CALL ZITOH(IQ(KQSP+LCDIR+IH),IHDIR,4)
- CALL UHTOC(IHDIR,4,CHPAT(NLPAT),16)
- ITIME=ITIME+1
- GO TO 10
- ELSE
- NLPAT=NLPAT-1
- IF(NLPAT.GE.NLPAT0)THEN
- LUP=LQ(KQSP+LCDIR+1)
- CALL MZDROP(JQPDVS,LCDIR,' ')
- LCDIR=LUP
- GO TO 20
- ENDIF
- ENDIF
-*
-* Reset CWD
-*
- 90 CALL RZCDIR(CHWOLD,' ')
-*
- 99 RETURN
- END
diff --git a/src/packlib/zebra/rz/rzstat.F b/src/packlib/zebra/rz/rzstat.F
deleted file mode 100644
index 606f493..0000000
--- a/src/packlib/zebra/rz/rzstat.F
+++ /dev/null
@@ -1,142 +0,0 @@
-*
-* $Id: rzstat.F,v 1.1.1.1 1996/03/06 10:47:26 mclareni Exp $
-*
-* $Log: rzstat.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:26 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE RZSTAT(CHPATH,NLEVEL,CHOPT)
-*
-************************************************************************
-*
-* To print statistics for tree CHPATH
-* Input:
-* CHPATH The pathname of the directory about which information has to
-* be provided.
-* NLEVEL Number of levels below CHPATH about which space information
-* has to be accumulated.
-* CHOPT Character variable specifying the options desired
-* default
-* Print the statistics
-* 'Q' Return the statistics in the user communication vector
-* IQUEST
-*
-* Called by <USER>
-*
-* Author : R.Brun DD/US/PD
-* Written : 16.05.86
-* Last mod: 24.06.92 JDS - protect against RZPAFF problems
-* : 02.05.95 JMM - set iquest(13-14)
-*
-************************************************************************
-#include "zebra/zunit.inc"
-#include "zebra/rzcl.inc"
-#include "zebra/rzdir.inc"
-#include "zebra/rzch.inc"
-#include "zebra/rzk.inc"
- CHARACTER*(*) CHPATH,CHOPT
- DIMENSION ISD(NLPATM),NSD(NLPATM),IHDIR(4)
- DIMENSION NRUSED(NLPATM),NWUSED(NLPATM)
- DIMENSION IOPTV(2)
- EQUIVALENCE (IOPTQ,IOPTV(1)), (IOPTX,IOPTV(2))
-*
-*-----------------------------------------------------------------------
-*
-*
- IQUEST(1)=0
- IRUSED = 0
- IWUSED = 0
- CALL UOPTC(CHOPT,'Q',IOPTV)
- IF(LQRS.EQ.0)GO TO 99
-*
- ITIME=0
- NLEV=NLEVEL
- IF(NLEV.LE.0)NLEV=99
- CALL RZCDIR(CHWOLD,'R')
- IF(IOPTQ.EQ.0)WRITE(IQPRNT,1000)
- 1000 FORMAT(//' NREC NWORDS QUOTA(%) FILE(%) DIR. NAME')
-*
-* Set CWD to the current level
-*
- 10 CONTINUE
- IF(ITIME.NE.0)THEN
- CALL RZPAFF(CHPAT,NLPAT,CHL)
- IF(IQUEST(1).NE.0)THEN
- NLPAT=NLPAT-1
- GO TO 20
- ENDIF
- CALL RZCDIR(CHL,' ')
- ELSE
- CALL RZCDIR(CHPATH,' ')
- IF(IQUEST(1).NE.0)GO TO 99
- NLPAT0=NLPAT
- CALL VZERO(NRUSED,NLPATM)
- CALL VZERO(NWUSED,NLPATM)
- ENDIF
- IF(IQUEST(1).NE.0)THEN
- NLPAT=NLPAT-1
- GO TO 20
- ENDIF
- ISD(NLPAT)=0
- NSD(NLPAT)=IQ(KQSP+LCDIR+KNSD)
-*
-* Process possible down directories
-*
- 20 ISD(NLPAT)=ISD(NLPAT)+1
- IF(ISD(NLPAT).LE.NSD(NLPAT))THEN
- NLPAT=NLPAT+1
- LS=IQ(KQSP+LCDIR+KLS)
- IH=LS+7*(ISD(NLPAT-1)-1)
- CALL ZITOH(IQ(KQSP+LCDIR+IH),IHDIR,4)
- CALL UHTOC(IHDIR,4,CHPAT(NLPAT),16)
- ITIME=ITIME+1
- GO TO 10
- ELSE
-*
-* Write information on current directory
-*
- CALL RZPAFF(CHPAT,NLPAT,CHL)
- DO 30 I=100,1,-1
- IF(CHL(I:I).NE.' ')GO TO 40
- 30 CONTINUE
- 40 CONTINUE
- DO 50 K=NLPAT0,NLPAT
- NRUSED(K)=NRUSED(K)+IQ(KQSP+LCDIR+KRUSED)
- NWUSED(K)=NWUSED(K)+IQ(KQSP+LCDIR+KWUSED)
- + +1000000*IQ(KQSP+LCDIR+KMEGA)
- 50 CONTINUE
- PERD=100.*FLOAT(NRUSED(NLPAT))/FLOAT(IQ(KQSP+LCDIR+KQUOTA))
- PERF=100.*FLOAT(NRUSED(NLPAT))/FLOAT(IQ(KQSP+LTOP +KQUOTA))
- IF(NLPAT.LE.(NLPAT0+NLEV))THEN
- IF(IOPTQ.EQ.0) WRITE(IQPRNT,2000)NRUSED(NLPAT),
- + NWUSED(NLPAT),PERD,PERF,CHL(1:I)
- IRUSED=NRUSED(NLPAT)
- IWUSED=NWUSED(NLPAT)
- ENDIF
- 2000 FORMAT(I9,I11,2X,F8.2,1X,F8.2,3X,A)
- NRUSED(NLPAT)=0
- NWUSED(NLPAT)=0
- NLPAT=NLPAT-1
- IF(NLPAT.GE.NLPAT0)THEN
- LUP=LQ(KQSP+LCDIR+1)
- CALL MZDROP(JQPDVS,LCDIR,' ')
- LCDIR=LUP
- GO TO 20
- ENDIF
- ENDIF
-*
-* Reset CWD
-*
- 90 CALL RZCDIR(CHWOLD,' ')
-*
- 99 CONTINUE
- IQUEST(11)=IRUSED
- IQUEST(12)=IWUSED
-*--------- Next two lines added JMM 2 May 1995 ---------------------------
- iquest(13)=iq(kqsp+lcdir+kquota)
- iquest(14)=iq(kqsp+ltop +kquota)
-*-----------------------------------------------------------------------------
- RETURN
- END
diff --git a/src/packlib/zebra/rz/rzstrip.F b/src/packlib/zebra/rz/rzstrip.F
deleted file mode 100644
index c9ef404..0000000
--- a/src/packlib/zebra/rz/rzstrip.F
+++ /dev/null
@@ -1,78 +0,0 @@
-*
-* $Id: rzstrip.F,v 1.1.1.1 1996/03/06 10:47:26 mclareni Exp $
-*
-* $Log: rzstrip.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:26 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
-#if defined(CERNLIB_QMUIX)
- SUBROUTINE RZSTRIP(CHFILE,NST,NRS,LREC,ISTAT)
-*
-**********************************************************************
-*
-* Routine called by RZOPEN and RZIODO for striped files
-*
-* CHFILE Name of the header description file (Ascii)
-* NST* Number of striped files
-* NRS* Number of records in each file
-* LREC* Record length in words of the files
-* ISTAT* return sattus
-*
-* Description of the /RZCSTR/ structure
-* ISLAST File number currently described in the structure
-* ISTRIP Current striped file number for file ISLAST
-* NSTRIP Number of striped files for ISLAST
-* NRSTRIP Number of records in each file of file ISLAST
-*
-* Example of a descriptor file (starts in column 1)
-* ============================
-*
-* The first line after the ###FTRIPE line contains
-* nstrip, Total_number_of_records, Record_Length_in_words, File_size
-*
-* ###FSTRIPE-V001###
-* 5 3872 1024 15859712
-* 775 3174400 /user/brun/hbook/hart.hbook_1
-* 775 3174400 /user/brun/hbook/hart.hbook_2
-* 775 3174400 /user/brun/hbook/hart.hbook_3
-* 775 3174400 /user/brun/hbook/hart.hbook_4
-* 772 3162112 /user/brun/hbook/hart.hbook_5
-*
-*
-* Author : R.Brun CERN/CN
-* Written : 10.06.94
-*
-************************************************************************
-*
-#include "zebra/rzcstr.inc"
- character*(*) chfile
- character*128 file
- character*10 strip
- integer istat,nst,nrs
- parameter (lunhead=121)
-*
-*-----------------------------------------------------------------------
-*
- istat=1
- open(unit=lunhead,file=chfile,status='old')
- read(lunhead,'(a)',err=20,end=20)strip
- if(strip.ne.'###FSTRIPE')go to 20
- read(lunhead,*,err=20,end=20)nst,nrtot,lrec,nwords
- if(nst.le.0)go to 20
- nrs=(nrtot+nst-1)/nst
- if(nrs.le.1)go to 20
- if(nst.ge.maxstrip)go to 20
- do 10 i=1,nst
- read(lunhead,'(a)',err=20,end=20)file
- isl=index(file,'/')
- if(isl.eq.0)go to 20
- rzsfile(i)=file(isl:)
- 10 continue
- rzsfile(maxstrip)=chfile
- istat=0
- 20 close(lunhead)
-*
- end
-#endif
diff --git a/src/packlib/zebra/rz/rzstrir.F b/src/packlib/zebra/rz/rzstrir.F
deleted file mode 100644
index dc035cd..0000000
--- a/src/packlib/zebra/rz/rzstrir.F
+++ /dev/null
@@ -1,70 +0,0 @@
-*
-* $Id: rzstrir.F,v 1.1.1.1 1996/03/06 10:47:26 mclareni Exp $
-*
-* $Log: rzstrir.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:26 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
-#if defined(CERNLIB_QMUIX)
- SUBROUTINE RZSTRIR(LUNRZ,IREC)
-*
-**********************************************************************
-*
-* Routine called by RZIODO for striped files
-* This routine checks if the input value for IREC is on the
-* current striped file. If not, it closes the current file
-* and open the file corresponding to the input record IREC.
-* If LUNRZ does not correspond to ISLAST, the routine opens
-* the descriptor text file corresponding to LUNPTR and loads
-* the commons /RZCSTR./ with the corresponding file names
-* and attributes
-*
-* IREC* Record number in current striped file
-*
-* Author : R.Brun CERN/CN
-* Written : 10.06.94
-*
-************************************************************************
-*
-#include "zebra/rzclun.inc"
-#include "zebra/rzcstr.inc"
- integer istat,nst,nrs,irec
-*
-*-----------------------------------------------------------------------
-*
- lunc=lunrz
- nrs=nrstrip(lunc)
- irlow =(istrip(lunc)-1)*nrs+1
- irnext=irlow+nrs
- if(irec.ge.irlow.and.irec.lt.irnext)then
- irec=irec-irlow+1
- else
- if(imodec.eq.0)then
- close(lunc)
- else
- call cfclos(lunc,0)
- endif
- is=(irec+nrs-1)/nrs
- istrip(lunc)=is
- irec=irec-(is-1)*nrs
- if(islast.ne.lunc)then
- call rzstrip(rznames(lunc),nst,nrs,lrec,istat)
- endif
- if(imodec.ne.0)then
- call cfopen(lunc,0,izrecl,'r',0,rzsfile(is),istat)
- else
- OPEN(UNIT=LUNC,FILE=rzsfile(is),FORM='UNFORMATTED',
-#if defined(CERNLIB_RZBYTES)
- + RECL=4*lrec,ACCESS='DIRECT',STATUS='old',IOSTAT=ISTAT)
-#endif
-#if !defined(CERNLIB_RZBYTES)
- + RECL=lrec,ACCESS='DIRECT',STATUS='old',IOSTAT=ISTAT)
-#endif
- endif
- islast=lunc
- endif
-*
- end
-#endif
diff --git a/src/packlib/zebra/rz/rztof1.F b/src/packlib/zebra/rz/rztof1.F
deleted file mode 100644
index 1770ab4..0000000
--- a/src/packlib/zebra/rz/rztof1.F
+++ /dev/null
@@ -1,184 +0,0 @@
-*
-* $Id: rztof1.F,v 1.2 1996/04/24 17:27:10 mclareni Exp $
-*
-* $Log: rztof1.F,v $
-* Revision 1.2 1996/04/24 17:27:10 mclareni
-* Extend the include file cleanup to dzebra, rz and tq, and also add
-* dependencies in some cases.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:26 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE RZTOF1(LUNFZ,IOPTC)
-*
-************************************************************************
-*
-* Copy current directory to a sequential FZ file
-* Input:
-* LUNFZ Logical unit number of the FZ sequential access file
-* IOPTC 0 save only the highest cycle to LUNFZ
-* 1 save all cycles
-*
-* Called by <RZTOFZ>
-*
-* Author : R.Brun DD/US/PD
-* Written : 14.05.86
-* Last mod: 04.10.90
-* : 04.03.94 S.Banerjee (Change in cycle structure)
-* : 23.03.95 J.Shiers - key # in cycles block is KEY(1)
-*
-************************************************************************
-#include "zebra/rzcl.inc"
-#include "zebra/rzdir.inc"
-#include "zebra/rzk.inc"
-#include "zebra/rzckey.inc"
-#include "zebra/rzcycle.inc"
-*
-*-----------------------------------------------------------------------
-*
-#include "zebra/q_jbyt.inc"
-*
-* Fill header for directory
-*
- NKEYS=IQ(KQSP+LCDIR+KNKEYS)
- NWKEY=IQ(KQSP+LCDIR+KNWKEY)
- LB = IQ(KQSP+LTOP+KLB)
- LREC = IQ(KQSP+LTOP+LB+1)
- IDECK=0
- IF(NWKEY.EQ.2.AND.LREC.EQ.128)THEN
- KTAGS=KKDES+1
- CALL ZITOH(IQ(KQSP+LCDIR+KTAGS),KEY,2)
- CALL UCTOH('DECKNAME',KEY2,4,8)
- IF(KEY(1).EQ.KEY2(1).AND.KEY(2).EQ.KEY2(2))THEN
- IDECK=1
- ENDIF
- ENDIF
- NH =NWKEY+3
- IHEAD(1)=1
- IHEAD(2)=NLPAT
- IHEAD(3)=0
- CALL UCOPY(IQ(KQSP+LCDIR+1),KEY,KNSIZE-3)
-*
-* Write directory header
-*
- CALL FZOUT(LUNFZ,JQPDVS,0,1,'Z',1,KNSIZE,IHEAD)
- IF(IQUEST(1).NE.0)GO TO 99
-*
-* Loop on all keys of level 0
-*
- IHEAD(1)=0
- DO 80 I=1,NKEYS
- LK=IQ(KQSP+LCDIR+KLK)
- LKC=LK+(NWKEY+1)*(I-1)
- DO 25 K=1,NWKEY
- KEY(K)=IQ(KQSP+LCDIR+LKC+K)
- 25 CONTINUE
- LCYC =IQ(KQSP+LCDIR+LKC)
- IF (KVSCYC.NE.0) THEN
-* IF (IQ(KQSP+LCDIR+LCYC+KKYCYC).NE.I) THEN
- IF (IQ(KQSP+LCDIR+LCYC+KKYCYC).NE.IQ(KQSP+LCDIR+LKC+1)) THEN
- IQUEST(1) = 11
- GO TO 99
- ENDIF
- ENDIF
-*
-* Store cycles in reverse order for 'C' option
-*
- IF(IOPTC.NE.0)THEN
- IF(LCORD.EQ.0)THEN
- CALL MZBOOK(JQPDVS,LCORD,LTOP,-4,'RZCO',0,0,50,2,-1)
- ENDIF
- IQ(KQSP+LCORD+1)=0
- 30 NORD=IQ(KQSP+LCORD+1)+1
- IF (KVSCYC.EQ.0) THEN
- LCOLD = JBYT(IQ(KQSP+LCDIR+LCYC+KPPCYC), 1,16)
- ELSE
- LCOLD = IQ(KQSP+LCDIR+LCYC+KPPCYC)
- ENDIF
- IF(NORD.GT.IQ(KQSP+LCORD-1))THEN
- CALL MZPUSH(JQPDVS,LCORD,0,50,'I')
- ENDIF
- IQ(KQSP+LCORD+1)=NORD
- IQ(KQSP+LCORD+NORD+1)=LCYC
- IF(LCOLD.NE.0.AND.LCOLD.NE.LCYC)THEN
- LCYC=LCOLD
- GO TO 30
- ENDIF
- DO 40 IC=NORD,1,-1
- LCYC= IQ(KQSP+LCORD+IC+1)
- ICY = JBYT(IQ(KQSP+LCDIR+LCYC+KCNCYC),21,12)
- CALL RZIN(JQPDVS,LRZ0,-1,I,ICY,'S')
- IF(IQUEST(1).NE.0)GO TO 99
- LFROM=LQ(KQSP+LRZ0-1)
- IF(IDECK.NE.0)THEN
- NDATA=IQ(KQSP+LFROM-1)
- NT=NDATA/5 +40
- CALL MZBOOK(JQPDVS,LTEMP,LFROM,0,'TEMP',0,0,NT,1,-1)
- NTOT=0
- NEW=1
- 35 IF(NTOT.LT.NDATA)THEN
- IF(NEW.GT.NT-1)THEN
- CALL MZPUSH(JQPDVS,LTEMP,0,50,'I')
- NT=NT+50
- ENDIF
- CALL RZLIND(IQ(KQSP+LFROM+1),NTOT,
- + IQ(KQSP+LTEMP+1),NEW)
- NEW=NEW+1
- GO TO 35
- ENDIF
- ENDIF
- IHEAD(2)=IC
- IHEAD(3)=IQ(KQSP+LCDIR+LCYC+KFLCYC)
- IQUEST(1)=0
- CALL FZOUT(LUNFZ,JQPDVS,LFROM,1,'L',2,NH,IHEAD)
- IF(IQUEST(1).NE.0)GO TO 90
- CALL MZDROP(JQPDVS,LFROM,'L')
- LFROM=0
- 40 CONTINUE
- ELSE
- 50 ICY =JBYT(IQ(KQSP+LCDIR+LCYC+KCNCYC),21,12)
- CALL RZIN(JQPDVS,LRZ0,-1,I,ICY,'S')
- IF(IQUEST(1).NE.0)GO TO 99
- LFROM=LQ(KQSP+LRZ0-1)
- IF(IDECK.NE.0)THEN
- NDATA=IQ(KQSP+LFROM-1)
- NT=NDATA/5 +40
- CALL MZBOOK(JQPDVS,LTEMP,LFROM,0,'TEMP',0,0,NT,1,-1)
- NTOT=0
- NEW=1
- 55 IF(NTOT.LT.NDATA)THEN
- IF(NEW.GT.NT-1)THEN
- CALL MZPUSH(JQPDVS,LTEMP,0,50,'I')
- NT=NT+50
- ENDIF
- CALL RZLIND(IQ(KQSP+LFROM+1),NTOT,
- + IQ(KQSP+LTEMP+1),NEW)
- NEW=NEW+1
- GO TO 55
- ENDIF
- ENDIF
- IHEAD(2)=1
- IHEAD(3)=IQ(KQSP+LCDIR+LCYC+KFLCYC)
- IQUEST(1)=0
- CALL FZOUT(LUNFZ,JQPDVS,LFROM,1,'L',2,NH,IHEAD)
- IF(IQUEST(1).NE.0)GO TO 90
- CALL MZDROP(JQPDVS,LFROM,'L')
- LFROM=0
- ENDIF
-*
- 80 CONTINUE
-*
-* Write directory trailer
-*
- CALL FZOUT(LUNFZ,JQPDVS,0,0,'Z',1,1,77)
-*
- 90 IF(LFROM.GT.0)THEN
- IQ1=IQUEST(1)
- CALL MZDROP(JQPDVS,LFROM,'L')
- IQUEST(1)=IQ1
- ENDIF
-*
- 99 RETURN
- END
diff --git a/src/packlib/zebra/rz/rztofz.F b/src/packlib/zebra/rz/rztofz.F
deleted file mode 100644
index d21f3bf..0000000
--- a/src/packlib/zebra/rz/rztofz.F
+++ /dev/null
@@ -1,134 +0,0 @@
-*
-* $Id: rztofz.F,v 1.2 1996/04/24 17:27:14 mclareni Exp $
-*
-* $Log: rztofz.F,v $
-* Revision 1.2 1996/04/24 17:27:14 mclareni
-* Extend the include file cleanup to dzebra, rz and tq, and also add
-* dependencies in some cases.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:26 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE RZTOFZ(LUNFZ,CHOPT)
-*
-************************************************************************
-*
-* Copy the CWD tree to a sequential FZ file
-* The FZ file must have been declared with FZOPEN
-* Input:
-* LUNFZ Logical unit number of the FZ sequential access file
-* CHOPT default save only the highest cycle to LUNFZ
-* 'C' save all cycles
-*
-* Called by <USER>
-*
-* Author : R.Brun DD/US/PD
-* Written : 14.05.86
-* Last mod: 26.06.92 JDS - protect against RZPAFF problems
-*
-************************************************************************
-#include "zebra/rzcl.inc"
-#include "zebra/rzdir.inc"
-#include "zebra/rzch.inc"
-#include "zebra/rzk.inc"
- CHARACTER*(*) CHOPT
- DIMENSION ISD(NLPATM),NSD(NLPATM),IHDIR(4)
-*
-*-----------------------------------------------------------------------
-*
- IQUEST(1)=0
- IQ1=0
- IF(LQRS.EQ.0)GO TO 99
-*
- CALL UOPTC(CHOPT,'C',IOPTC)
- NLPAT0=NLPAT
- DO 5 I=1,NLPAT0
- CHPAT(I)=CHCDIR(I)
- 5 CONTINUE
- ITIME=0
- CALL RZCDIR(CHWOLD,'R')
-*
-* Garbage collection in user short range divisions
-* in primary store
-*
- CALL MZGARB(21,0)
-*
-* Write general header
-*
- IHDIR(1)=12345
- IHDIR(2)=NLPAT0
- CALL FZOUT(LUNFZ,JQPDVS,0,1,'Z',1,2,IHDIR)
- IF(IQUEST(1).NE.0)THEN
- IQ1=IQUEST(1)
- GO TO 90
- ENDIF
-*
-* Set CWD to the current level
-*
- 10 CONTINUE
- IF(ITIME.NE.0)THEN
- CALL RZPAFF(CHPAT,NLPAT,CHL)
- IF(IQUEST(1).NE.0)THEN
- IQ1=IQUEST(1)
- NLPAT=NLPAT-1
- GO TO 20
- ENDIF
- CALL RZCDIR(CHL,' ')
- ENDIF
- ISD(NLPAT)=0
- NSD(NLPAT)=IQ(KQSP+LCDIR+KNSD)
-*
-* Write current directory
-*
- CALL RZTOF1(LUNFZ,IOPTC)
- IF(IQUEST(1).NE.0)THEN
- IQ1=IQUEST(1)
- NLPAT=NLPAT-1
- GO TO 20
- ENDIF
-*
-* Process possible down directories
-*
- 20 ISD(NLPAT)=ISD(NLPAT)+1
- IF(ISD(NLPAT).LE.NSD(NLPAT))THEN
- NLPAT=NLPAT+1
- LS=IQ(KQSP+LCDIR+KLS)
- IH=LS+7*(ISD(NLPAT-1)-1)
- CALL ZITOH(IQ(KQSP+LCDIR+IH),IHDIR,4)
- CALL UHTOC(IHDIR,4,CHPAT(NLPAT),16)
- ITIME=ITIME+1
- GO TO 10
- ELSE
- NLPAT=NLPAT-1
- IF(NLPAT.GE.NLPAT0)THEN
- LUP=LQ(KQSP+LCDIR+1)
- CALL MZDROP(JQPDVS,LCDIR,' ')
- LCDIR=LUP
- GO TO 20
- ENDIF
- ENDIF
-*
-* Write final trailer
-*
- NLPAT=NLPAT0
- CALL FZOUT(LUNFZ,JQPDVS,0,1,'Z',1,1,99)
- IF(IQUEST(1).NE.0)THEN
- IQ1=IQUEST(1)
- GO TO 90
- ENDIF
- LCORD=LQ(KQSP+LTOP-4)
- IF(LCORD.NE.0)THEN
- CALL MZDROP(JQPDVS,LCORD,'L')
- LCORD=0
- ENDIF
-*
-* Reset CWD
-*
- 90 CONTINUE
- CALL RZCDIR(CHWOLD,' ')
- IF(IQ1.NE.0.AND.IQUEST(1).EQ.0)IQUEST(1)=1
-*
- 99 RETURN
- END
diff --git a/src/packlib/zebra/rz/rzused.F b/src/packlib/zebra/rz/rzused.F
deleted file mode 100644
index 6b501a5..0000000
--- a/src/packlib/zebra/rz/rzused.F
+++ /dev/null
@@ -1,119 +0,0 @@
-*
-* $Id: rzused.F,v 1.1.1.1 1996/03/06 10:47:27 mclareni Exp $
-*
-* $Log: rzused.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:27 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE RZUSED(N,IUSED)
-*
-************************************************************************
-*
-* To mark used records
-* Input:
-* N Number of consecutive records used
-* IUSED First of the N records used
-*
-* Called by RZCOP1,RZEXPD,RZMDIR,RZOUT,RZVOUT
-*
-* Author : R.Brun DD/US/PD
-* Written : 02.04.86
-* Last mod: 04.05.86
-*
-************************************************************************
-#include "zebra/rzcl.inc"
-*
-*-----------------------------------------------------------------------
-*
-* First. Remove used records from the list of available records
-*
- NFREE=IQ(KQSP+LFREE+1)
- IF(NFREE.EQ.0)GO TO 99
-*
- I=1
- 10 IF(I.LE.NFREE)THEN
- L1=LFREE+2*I
- IR1=IQ(KQSP+L1)
- IRL=IQ(KQSP+L1+1)
- IF(IUSED.EQ.IR1)THEN
- IF(IR1+N.LE.IRL)THEN
- IQ(KQSP+L1)=IR1+N
- ELSE
- NFREE=NFREE-1
- IQ(KQSP+LFREE+1)=NFREE
- IF(NFREE.GT.0)THEN
- CALL UCOPY2(IQ(KQSP+L1+2),IQ(KQSP+L1),2*(NFREE-I+1))
- ENDIF
- ENDIF
- GO TO 20
- ENDIF
- I=I+1
- GO TO 10
- ENDIF
-*
-* Second. Mark used records in list of used records
-*
- 20 NUSED=IQ(KQSP+LUSED+1)
- IUSEL=IUSED+N-1
- IUS=2
- IF(NUSED.EQ.0)THEN
- IQ(KQSP+LUSED+1)=1
- IQ(KQSP+LUSED+IUS)=IUSED
- IQ(KQSP+LUSED+IUS+1)=IUSEL
- GO TO 99
- ENDIF
- 30 IF(IUSEL.LT.IQ(KQSP+LUSED+IUS))THEN
- IF(IUSEL.EQ.IQ(KQSP+LUSED+IUS)-1)THEN
- IQ(KQSP+LUSED+IUS)=IUSED
- ELSE
- IF(IUS.GT.2.AND.IUSEL.LE.IQ(KQSP+LUSED+IUS-1))GO TO 99
- NDATA=IQ(KQSP+LUSED-1)
- IF(NDATA.LT.2*NUSED+3)THEN
- CALL MZPUSH(JQPDVS,LUSED,0,10,'I')
- ENDIF
- NLEFT=2*NUSED-IUS+2
- IF(NLEFT.GT.0)THEN
- CALL UCOPY2(IQ(KQSP+LUSED+IUS),
- + IQ(KQSP+LUSED+IUS+2),NLEFT)
- ENDIF
- NUSED=NUSED+1
- IQ(KQSP+LUSED+1)=NUSED
- IQ(KQSP+LUSED+IUS)=IUSED
- IQ(KQSP+LUSED+IUS+1)=IUSEL
- ENDIF
- GO TO 99
- ENDIF
-*
- IF(IUSED.EQ.IQ(KQSP+LUSED+IUS+1)+1)THEN
- IQ(KQSP+LUSED+IUS+1)=IUSEL
- IF(IUS+2.LT.2*NUSED)THEN
- IF(IQ(KQSP+LUSED+IUS+1).EQ.IQ(KQSP+LUSED+IUS+2))THEN
- IQ(KQSP+LUSED+IUS+1)=IQ(KQSP+LUSED+IUS+3)
- NLEFT=2*NUSED-IUS-2
- IF(NLEFT.GT.0)THEN
- CALL UCOPY2(IQ(KQSP+LUSED+IUS+4),
- + IQ(KQSP+LUSED+IUS+2),NLEFT)
- ENDIF
- NUSED=NUSED-1
- IQ(KQSP+LUSED+1)=NUSED
- ENDIF
- ENDIF
- GO TO 99
- ENDIF
-*
- IUS=IUS+2
- IF(IUS.LE.2*NUSED)GO TO 30
-*
- NDATA=IQ(KQSP+LUSED-1)
- IF(NDATA.LT.2*NUSED+3)THEN
- CALL MZPUSH(JQPDVS,LUSED,0,10,'I')
- ENDIF
- IQ(KQSP+LUSED+IUS)=IUSED
- IQ(KQSP+LUSED+IUS+1)=IUSEL
- NUSED=NUSED+1
- IQ(KQSP+LUSED+1)=NUSED
-*
- 99 RETURN
- END
diff --git a/src/packlib/zebra/rz/rzvcyc.F b/src/packlib/zebra/rz/rzvcyc.F
deleted file mode 100644
index 344e4dd..0000000
--- a/src/packlib/zebra/rz/rzvcyc.F
+++ /dev/null
@@ -1,54 +0,0 @@
-*
-* $Id: rzvcyc.F,v 1.1.1.1 1996/03/06 10:47:27 mclareni Exp $
-*
-* $Log: rzvcyc.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:27 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE RZVCYC(LTAD)
-*
-************************************************************************
-*
-* Fills up the offset parameters of cycle information
-* Input:
-* LTAD Address of the top directory
-*
-* Called by RZFDIR,RZFILE,RZMAKE
-*
-* Author : S.Banerjee
-* Written : 03.03.94
-* Last mod:
-*
-************************************************************************
-#include "zebra/rzcl.inc"
-#include "zebra/rzk.inc"
-#include "zebra/rzcycle.inc"
-*-----------------------------------------------------------------------
- IF (LTAD.EQ.0) GO TO 99
- IF (IQ(KQSP+LTAD+KRZVER).EQ.0) THEN
- KLCYCL = 4
- KPPCYC = 0
- KFRCYC = 2
- KSRCYC = 0
- KFLCYC = 1
- KORCYC = 2
- KCNCYC = 3
- KNWCYC = 3
- KKYCYC =-1
- KVSCYC = 0
- ELSE
- KLCYCL = 7
- KPPCYC = 0
- KFRCYC = 2
- KSRCYC = 5
- KFLCYC = 1
- KORCYC = 3
- KCNCYC = 3
- KNWCYC = 4
- KKYCYC = 6
- KVSCYC = 1
- ENDIF
- 99 RETURN
- END
diff --git a/src/packlib/zebra/rz/rzver1.F b/src/packlib/zebra/rz/rzver1.F
deleted file mode 100644
index 4375d5a..0000000
--- a/src/packlib/zebra/rz/rzver1.F
+++ /dev/null
@@ -1,250 +0,0 @@
-*
-* $Id: rzver1.F,v 1.2 1996/04/24 17:27:16 mclareni Exp $
-*
-* $Log: rzver1.F,v $
-* Revision 1.2 1996/04/24 17:27:16 mclareni
-* Extend the include file cleanup to dzebra, rz and tq, and also add
-* dependencies in some cases.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:27 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE RZVER1(CHL,CHOPT,IRET)
-************************************************************************
-*
-* Slave routine to RZVERI
-*
-*
-* Author : J.Shiers CN/AS/DL
-* Written : 23.03.92
-* Last mod: 18.04.94 - set ISTAT2
-* : 02.02.95 - cater for new RZ file format
-*
-************************************************************************
-*
-#include "zebra/zunit.inc"
-#include "zebra/rzcl.inc"
-#include "zebra/rzk.inc"
-#include "zebra/rzclun.inc"
-#include "zebra/rzbmap.inc"
-#include "zebra/rzover.inc"
-#include "zebra/rzcycle.inc"
- CHARACTER*(*) CHL,CHOPT
- CHARACTER*255 DIRNAM
- DIMENSION KEY(KNMAX)
-*...............................................................
-
-#include "zebra/q_jbit.inc"
-#include "zebra/q_jbyt.inc"
-
- NCHL = LENOCC(CHL)
- LOGLV = JBYT(IQ(KQSP+LTOP),15,3)-3
- IF(LOGLV.GE.1) WRITE(IQPRNT,*)
- + 'Processing directory: ',CHL(1:NCHL)
- DIRNAM = CHL
- IRET = 0
- JRET = 0
- NKEYS = IQ(KQSP+LCDIR+KNKEYS)
- NWKEY = IQ(KQSP+LCDIR+KNWKEY)
- LB = IQ(KQSP+LTOP+KLB)
- LK = IQ(KQSP+LCDIR+KLK)
- LDS = IQ(KQSP+LCDIR+KLD)
- LREC = IZRECL
- NCHO = LENOCC(CHOPT)
-
- IOPTB = INDEX(CHOPT(1:NCHO),'B')
- IOPTC = INDEX(CHOPT(1:NCHO),'C')
- IOPTO = INDEX(CHOPT(1:NCHO),'O')
- IOPTP = INDEX(CHOPT(1:NCHO),'P')
-*
-* Process all records of this directory
-*
- NRD = IQ(KQSP+LCDIR+LDS)
- DO 10 I = 1,NRD
-
- ISTAT = 0
- IREC = IQ(KQSP+LCDIR+LDS+I)
- IWORD = (IREC-1)/32 + 1
- IBIT = IREC-32*(IWORD-1)
-*
-* Print directory name and record number if rec. no in list
-* of bad records
-*
- IF(IOPTP.NE.0.AND.NBAD.GT.0) THEN
- IF(IUFIND(IREC,IBAD,1,NBAD).LE.NBAD) WRITE(IQPRNT,*)
- + 'Directory: ',CHL(1:LENOCC(CHL)),' uses record ',IREC
- ENDIF
-*
-* Is this record marked as free?
-*
- IF(IOPTC.NE.0.AND.
- + JBIT(IQ(KQSP+LTOP+LB+2+IWORD),IBIT).EQ.0) THEN
- WRITE(IQPRNT,*) 'RZVER1. warning - record ',IREC,
- + ' is in use but is marked as free in bit map'
- JRET = JRET + 1
- ENDIF
-*
-* Set bit to mark record as used
-*
- IF(IOPTB.NE.0) CALL SBIT1(IQ(KQSP+LTOP+LB+2+IWORD),IBIT)
- IW1=(IREC-1)*LREC+1
- IW2=IW1+LREC-1
-*
-* Check for overwriting at the directory level
-*
- IF(IOPTO.NE.0) CALL RZVER2(IW1,IW2,ISTAT)
- IRET=IRET+ISTAT
- 10 CONTINUE
- IF(IRET.NE.0)THEN
- DIRNAM=CHL
- NCHL=LENOCC(CHL)
- PRINT 10000, DIRNAM(1:NCHL),(IQ(KQSP+LCDIR+LDS+I),I=1,NRD)
-*
-* Store record numbers for second pass
-*
- IF(NBAD+NRD.LE.MAXBAD) THEN
- DO 20 I=1,NRD
- IBAD(NBAD+I) = IQ(KQSP+LCDIR+LDS+I)
- 20 CONTINUE
- NBAD = NBAD + NRD
- ENDIF
-
- ENDIF
-*
-* Check records used for objects in this directory
-*
- IF(NKEYS.GT.0)THEN
- DO 60 I=1,NKEYS
- ISTAT = 0
- LKC = LK+(NWKEY+1)*(I-1)
- LCYC = IQ(KQSP+LCDIR+LKC)
-
- 30 CONTINUE
-
- IF(KVSCYC.EQ.0) THEN
- LCOLD = JBYT(IQ(KQSP+LCDIR+LCYC), 1,16)
- IR1 = JBYT(IQ(KQSP+LCDIR+LCYC+2),17,16)
- IR2 = JBYT(IQ(KQSP+LCDIR+LCYC ),17,16)
- IP1 = JBYT(IQ(KQSP+LCDIR+LCYC+2), 1,16)
- NW = JBYT(IQ(KQSP+LCDIR+LCYC+3), 1,20)
- ELSE
- LCOLD = IQ(KQSP+LCDIR+LCYC)
- IR1 = IQ(KQSP+LCDIR+LCYC+2)
- IR2 = IQ(KQSP+LCDIR+LCYC+5)
- IP1 = JBYT(IQ(KQSP+LCDIR+LCYC+3),1,20)
- NW = IQ(KQSP+LCDIR+LCYC+4)
- ENDIF
-
- NLEFT=LREC-IP1+1
- IW1=(IR1-1)*LREC+IP1
- IW2=(IR1-1)*LREC+IP1+MIN(NLEFT,NW)-1
-*
-* Check for overwriting at the object level
-*
- IF(IOPTO.NE.0) THEN
- CALL RZVER2(IW1,IW2,ISTAT)
- IF(ISTAT.NE.0.AND.NBAD.LT.MAXBAD) THEN
- IBAD(NBAD+1) = IR1
- NBAD = NBAD + 1
- ENDIF
- ENDIF
-
- IWORD = (IR1-1)/32 + 1
- IBIT = IR1-32*(IWORD-1)
-*
-* Is this record marked as free?
-*
- IF(IOPTC.NE.0.AND.JBIT(IQ(KQSP+LTOP+LB+2+IWORD),IBIT)
- + .EQ.0) THEN
- WRITE(IQPRNT,*) 'RZVER1. warning - record ',IR1,' is in '
- + //'use but is marked as free in bit map'
- JRET = JRET + 1
- ENDIF
-*
-* Set bit to mark record as used
-*
- IF(IOPTB.NE.0) CALL SBIT1(IQ(KQSP+LTOP+LB+2+IWORD),IBIT)
-*
-* Is this record in the list of overwritten records?
-*
- IF(IOPTP.NE.0.AND.NBAD.GT.0) THEN
- IF(IUFIND(IR1,IBAD,1,NBAD).LE.NBAD) THEN
- NCHL = LENOCC(CHL)
- WRITE(IQPRNT,*) 'Directory: ',CHL(1:NCHL),
- + ' has objects in record ',IR1
- CALL RZPRNK(CHL(1:NCHL),I,LCYC,' ')
- ENDIF
- ENDIF
-*
-* Any more records for this object?
-*
- IF(NW.GT.NLEFT)THEN
- NR=(NW-NLEFT-1)/LREC
- IRN=IR2+NR
- DO 40 J=IR2,IRN
- IF(IOPTP.NE.0.AND.NBAD.GT.0) THEN
- IF(IUFIND(J,IBAD,1,NBAD).LE.NBAD) THEN
- NCHL = LENOCC(CHL)
- WRITE(IQPRNT,*) 'Directory: ',
- + CHL(1:NCHL),' has objects in record ',IR1
- CALL RZPRNK(CHL(1:NCHL),I,LCYC,' ')
- ENDIF
- ENDIF
-
- IWORD = (J-1)/32 + 1
- IBIT = J-32*(IWORD-1)
-*
-* Is this record marked as free?
-*
- IF(IOPTC.NE.0.AND.JBIT(IQ(KQSP+LTOP+LB+2+IWORD),
- + IBIT).EQ.0) THEN
- WRITE(IQPRNT,*) 'RZVER1. warning - record ',J,
- + ' is in use but is marked as free in bit map'
- JRET = JRET + 1
- ENDIF
-*
-* Set bit to mark record as used
-*
- IF(IOPTB.NE.0) CALL SBIT1(IQ(KQSP+LTOP+LB+2+IWORD),
- + IBIT)
- 40 CONTINUE
- IW1=(IR2-1)*LREC+1
- IW2=IW1+NW-NLEFT-1
- ISTAT2=0
- IF(IOPTO.NE.0) CALL RZVER2(IW1,IW2,ISTAT2)
- ISTAT=ISTAT+ISTAT2
- ENDIF
- IF(ISTAT2.NE.0.AND.NW.GT.NLEFT)THEN
- DO 50 J=IR2,IRN
- IF(NBAD.LT.MAXBAD) THEN
- IBAD(NBAD+1) = J
- NBAD = NBAD + 1
- ENDIF
- 50 CONTINUE
- ICYC = JBYT(IQ(KQSP+LCDIR+LCYC+3),21,12)
- DIRNAM=CHL
- NCHL=LENOCC(CHL)
- IRET=IRET+1
-*
-* Get and print key of corrupted object
-*
- PRINT 10100, DIRNAM(1:NCHL),IR1,((NW-1)/LREC)+1
- CALL RZPRNK(DIRNAM(1:NCHL),I,LCYC,' ')
- ENDIF
- IF(LCOLD.NE.0.AND.LCOLD.NE.LCYC)THEN
- LCYC=LCOLD
- GO TO 30
- ENDIF
- 60 CONTINUE
- ENDIF
-
- IQUEST(2) = JRET
-*
-10000 FORMAT(' **** WARNING: Directory ',A,' possibly overwritten ****',
- + /,' records numbers: ',/10(1X,I6))
-10100 FORMAT(' **** WARNING: Object in directory ',A,' corrupted ****',
- + /,' start record: ',I6,' number of records: ',I6)
-*
- END
diff --git a/src/packlib/zebra/rz/rzver2.F b/src/packlib/zebra/rz/rzver2.F
deleted file mode 100644
index 8d579f0..0000000
--- a/src/packlib/zebra/rz/rzver2.F
+++ /dev/null
@@ -1,52 +0,0 @@
-*
-* $Id: rzver2.F,v 1.2 1996/04/24 17:27:17 mclareni Exp $
-*
-* $Log: rzver2.F,v $
-* Revision 1.2 1996/04/24 17:27:17 mclareni
-* Extend the include file cleanup to dzebra, rz and tq, and also add
-* dependencies in some cases.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:27 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE RZVER2(IW1,IW2,IRET)
-*
-* Check if words between IW1 and IW2 are already used
-*
-#include "zebra/rzbmap.inc"
-*...............................................................
-
-#include "zebra/q_jbyt.inc"
-
- IRET=0
- IF(IW2.GT.32*KDMAX)GO TO 999
- IWORD1=(IW1-1)/32+1
- IWORDL=(IW2-1)/32+1
- IBIT1=MOD(IW1,32)
- IBIT2=MOD(IW2,32)
- IF(IBIT1.EQ.0)IBIT1=32
- IF(IBIT2.EQ.0)IBIT2=32
- IF(IWORD1.EQ.IWORDL)THEN
- NB=IBIT2-IBIT1+1
- JB1=JBYT(IDATA(IWORD1),IBIT1,NB)
- IF(JB1.EQ.0)GO TO 20
- CALL SBYT(0,IDATA(IWORD1),IBIT1,NB)
- GO TO 999
- ELSE
- NB=33-IBIT1
- JB1=JBYT(IDATA(IWORD1),IBIT1,NB)
- IF(JB1.EQ.0)GO TO 20
- CALL SBYT(0,IDATA(IWORD1),IBIT1,NB)
- ENDIF
- JB2=JBYT(IDATA(IWORDL),1,IBIT2)
- IF(JB2.EQ.0)GO TO 20
- CALL SBYT(0,IDATA(IWORDL),1,IBIT2)
- DO 10 I=IWORD1+1,IWORDL-1
- IF(IDATA(I).EQ.0)GO TO 20
- IDATA(I)=0
- 10 CONTINUE
- GO TO 999
- 20 IRET=1
- 999 END
diff --git a/src/packlib/zebra/rz/rzveri.F b/src/packlib/zebra/rz/rzveri.F
deleted file mode 100644
index c2b614a..0000000
--- a/src/packlib/zebra/rz/rzveri.F
+++ /dev/null
@@ -1,195 +0,0 @@
-*
-* $Id: rzveri.F,v 1.2 1996/04/24 17:27:19 mclareni Exp $
-*
-* $Log: rzveri.F,v $
-* Revision 1.2 1996/04/24 17:27:19 mclareni
-* Extend the include file cleanup to dzebra, rz and tq, and also add
-* dependencies in some cases.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:27 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE RZVERI(CHPATH,CHOPT)
-*
-************************************************************************
-*
-* Routine to build bit map of records used in an RZ file
-* Input:
-* CHOPT Character variable specifying the selected options.
-*
-* 'B' - rebuild bit map in memory
-* 'C' - compare bit map in memory against file
-* 'O' - check for overwriting on a word by word basis
-* This requires a suitably dimensioned array
-* in sequence RZBMAP. KDMAX = NRECS * LRECL / 32
-* 'P' - print directories and objects pointing to overwritten
-* records. Implies O.
-*
-* Called by RZFILE, RZCLOS
-* Based on RZVERI program of Rene Brun
-*
-* Author : J.Shiers CN/AS/DL
-* Written : 23.03.92
-* Last mod: 05.11.92 - IQUEST(2) = number of records in use
-* but marked as free
-*
-************************************************************************
-*
- CHARACTER*(*) CHOPT
- CHARACTER*10 CHOPTT
-#include "zebra/zunit.inc"
-#include "zebra/rzcl.inc"
-#include "zebra/rzdir.inc"
-#include "zebra/rzch.inc"
-#include "zebra/rzk.inc"
-#include "zebra/rzbmap.inc"
-#include "zebra/rzover.inc"
- CHARACTER *(*) CHPATH
- DIMENSION ISD(NLPATM),NSD(NLPATM),IHDIR(4)
-*
-*-----------------------------------------------------------------------
-*
-#include "zebra/q_jbyt.inc"
-
- IQUEST(1)= 0
- IRET = 0
- JRET = 0
- NBAD = 0
- NPASS = 0
- LOGLV = JBYT(IQ(KQSP+LTOP),15,3)-3
- NCHO = LENOCC(CHOPT)
- IOPTB = INDEX(CHOPT(1:NCHO),'B')
- IOPTC = INDEX(CHOPT(1:NCHO),'C')
- IOPTO = INDEX(CHOPT(1:NCHO),'O')
- IOPTP = INDEX(CHOPT(1:NCHO),'P')
- IF(IOPTP.NE.0) IOPTO = 1
-*
-* Option B: clear existing bitmap
-*
- IF(IOPTB.NE.0) THEN
- LB=IQ(KQSP+LTOP+KLB)
- CALL VZERO(IQ(KQSP+LTOP+LB+3),IQ(KQSP+LTOP+LB))
- ENDIF
-
- NCHO = 0
- CHOPTT = ' '
-
- IF(IOPTB.NE.0) THEN
- NCHO = NCHO + 1
- CHOPTT(NCHO:NCHO) = 'B'
- ENDIF
-
- IF(IOPTC.NE.0) THEN
- NCHO = NCHO + 1
- CHOPTT(NCHO:NCHO) = 'C'
- ENDIF
-
- IF(IOPTO.NE.0) THEN
- NCHO = NCHO + 1
- CHOPTT(NCHO:NCHO) = 'O'
- ENDIF
-*
- IF(IOPTO.NE.0) THEN
- IWORD = 0
- DO 10 I=1,32
- CALL SBIT1(IWORD,I)
- 10 CONTINUE
- DO 20 I=1,KDMAX
- IDATA(I) = IWORD
- 20 CONTINUE
- ENDIF
- IF(LQRS.EQ.0)GOTO 70
-*
-* General case
-*
- IF(LCDIR.EQ.0)GOTO 70
- 30 CONTINUE
- NPASS = NPASS + 1
- CALL RZCDIR(CHWOLD,'R')
- CALL RZCDIR(CHPATH,' ')
- CALL RZPAFF(CHPAT,NLPAT,CHL)
- NLPAT0=NLPAT
- ITIME=0
-*
-*
-* Set CWD to the current level
-*
- 40 CONTINUE
- IF(ITIME.NE.0)THEN
- CALL RZPAFF(CHPAT,NLPAT,CHL)
- IF(IQUEST(1).NE.0)THEN
- IF(LOGLV.GE.1) THEN
- LCHL = LENOCC(CHL)
- WRITE(IQPRNT,*) 'RZVERI. error setting directory to ',
- + CHL(1:LCHL)
- ENDIF
- IRET = IRET + IQUEST(1)
- NLPAT=NLPAT-1
- GOTO 50
- ENDIF
- CALL RZCDIR(CHL,' ')
- ENDIF
- IF(IQUEST(1).NE.0)THEN
- IF(LOGLV.GE.1) THEN
- LCHL = LENOCC(CHL)
- WRITE(IQPRNT,*) 'RZVERI. error setting directory to ',
- + CHL(1:LCHL)
- ENDIF
- IRET = IRET + IQUEST(1)
- NLPAT=NLPAT-1
- GOTO 50
- ENDIF
- ISD(NLPAT)=0
- NSD(NLPAT)=IQ(KQSP+LCDIR+KNSD)
-*
-* Check current directory
-*
- CALL RZVER1(CHL,CHOPTT,ISTAT)
- IRET = IRET + ISTAT
- JRET = JRET + IQUEST(2)
-*
-* Process possible down directories
-*
- 50 ISD(NLPAT)=ISD(NLPAT)+1
- IF(ISD(NLPAT).LE.NSD(NLPAT))THEN
- NLPAT=NLPAT+1
- LS=IQ(KQSP+LCDIR+KLS)
- IH=LS+7*(ISD(NLPAT-1)-1)
- CALL ZITOH(IQ(KQSP+LCDIR+IH),IHDIR,4)
- CALL UHTOC(IHDIR,4,CHPAT(NLPAT),16)
- ITIME=ITIME+1
- GOTO 40
- ELSE
- NLPAT=NLPAT-1
- IF(NLPAT.GE.NLPAT0)THEN
- LUP=LQ(KQSP+LCDIR+1)
- CALL MZDROP(JQPDVS,LCDIR,' ')
- LCDIR=LUP
- GOTO 50
- ENDIF
- ENDIF
-
- 60 CONTINUE
-*
-* Print directories and objects using overwritten records
-*
- IF(IOPTP.NE.0.AND.NPASS.EQ.1.AND.IRET.NE.0) THEN
- CHOPTT = 'P'
- WRITE(IQPRNT,*)
- + 'RZVERI. List of suspect directories/objects'
- GOTO 30
- ENDIF
-*
-* Mark top directory as modified
-*
- IF(IOPTB.NE.0) CALL SBIT1(IQ(KQSP+LTOP),2)
-*
-* Reset CWD
-*
- CALL RZCDIR(CHWOLD,' ')
-*
- 70 IQUEST(1) = IRET
- IQUEST(2) = JRET
- END
diff --git a/src/packlib/zebra/rz/rzvers.F b/src/packlib/zebra/rz/rzvers.F
deleted file mode 100644
index c0be4ed..0000000
--- a/src/packlib/zebra/rz/rzvers.F
+++ /dev/null
@@ -1,50 +0,0 @@
-*
-* $Id: rzvers.F,v 1.2 1999/06/14 13:59:31 couet Exp $
-*
-* $Log: rzvers.F,v $
-* Revision 1.2 1999/06/14 13:59:31 couet
-* - Mods for Y2K in the date/time output
-*
-* Revision 1.1.1.1 1996/03/06 10:47:23 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE RZVERS(CHTITL,CHCOMP,CHOPT)
-*
-* Print or return RZ version number
-*
- CHARACTER*(*) CHTITL,CHCOMP,CHOPT
- CHARACTER*80 CTITLE,CCOMPL
-
-#include "zebra/zunit.inc"
-
- IDATQQ = 0
- ITIMQQ = 0
-*
-* Clear title and compilation date/time
-*
- CTITLE = ' '
- CCOMPL = ' '
-
- CTITLE =
- + 'RZEBRA 3.01/08'
- WRITE(CCOMPL,9001) IDATQQ,ITIMQQ
-9001 FORMAT(' This version created on ',I6.6,' at ',I4.4)
-
- LTITLE = LENOCC(CTITLE)
- LCOMPL = LENOCC(CCOMPL)
-
- IF(INDEX(CHOPT,'P').NE.0) THEN
-
- WRITE(IQPRNT,*) CTITLE(1:LTITLE)
- WRITE(IQPRNT,*) CCOMPL(1:LCOMPL)
-
- ELSE
-
- CHTITL = CTITLE(1:LTITLE)
- CHCOMP = CCOMPL(1:LCOMPL)
-
- ENDIF
-
- END
diff --git a/src/packlib/zebra/rz/rzvin.F b/src/packlib/zebra/rz/rzvin.F
deleted file mode 100644
index b0ba40e..0000000
--- a/src/packlib/zebra/rz/rzvin.F
+++ /dev/null
@@ -1,120 +0,0 @@
-*
-* $Id: rzvin.F,v 1.2 1996/04/24 17:27:20 mclareni Exp $
-*
-* $Log: rzvin.F,v $
-* Revision 1.2 1996/04/24 17:27:20 mclareni
-* Extend the include file cleanup to dzebra, rz and tq, and also add
-* dependencies in some cases.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:27 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE RZVIN(V,NDIM,N,KEYU,ICYCLE,CHOPT)
-*
-************************************************************************
-*
-* Read Fortran array V from a RZ file
-* Input:
-* NDIM* Declared dimension of array V
-* *N* With option O: N contains offset of first word to be read
-* KEYU Keyword vector of the information to be read
-* ICYCLE Cycle number of the key to be read
-* ICYCLE > highest cycle number means read the highest cycle
-* ICYCLE = 0 means read the lowest cycle
-* CHOPT Character variable specifying the options selected.
-* data structure
-* default
-* Same as 'D' below
-* 'A' Read continuation of the previously read data structure
-* with identifier KEYU,ICYCLE
-* Given that option implies that the record was written with
-* the same option by a call to RZOUT.
-* 'C' Provide information about the cycle numbers
-* associated with KEY.
-* The total number of cycles and the cycle number
-* identifiers of the 19 highest cycles are returned in
-* IQUEST(50) and IQUEST(51..89) respectively
-* 'D' Read the Data structure with the (key,cycle) pair
-* specified.
-* 'N' Read the neighbouring. keys (i.e. those preceding and
-* following KEY).
-* The key-vectors of the previous and next key are
-* available respectively as IQUEST(31..35) and
-* IQUEST(41..45), see below.
-* 'O' Argument N contains offset of first word of vector
-* to be read
-* Output:
-* V Array containing the contents of the record
-* N Actual length of array V
-* If the current length is greater than the declared dimension,then
-* only NDIM are returned in V.
-* In that case,IQUEST(11) contains the number of words in the record
-*
-* IQUEST(13)=IFORM
-*
-* Integer value CHOPT for RZVOUT Meaning
-* ------------- ---------------- -------
-* 3 Array V contains only floating points
-* 2 'I' Array V contains integers
-* 1 'B' Array V contains bit-patterns
-* 5 'H' Array V contains Holleriths
-*
-* Called by <USER>
-*
-* Author : R.Brun DD/US/PD
-* Written : 03.04.86
-* Last mod: 22.06.92 JDS - return IFORM in IQUEST(13)
-* : 04.11.94 JDS - option O - N contains offset of first
-* word of vector to be read
-*
-************************************************************************
-#include "zebra/rzcl.inc"
- CHARACTER*(*) CHOPT
- DIMENSION KEYU(*),V(*)
- EQUIVALENCE (IOPTA,IQUEST(91)), (IOPTC,IQUEST(92))
- +, (IOPTD,IQUEST(93)), (IOPTN,IQUEST(94))
- +, (IOPTO,IQUEST(95))
-*
-*-----------------------------------------------------------------------
-*
-
-#include "zebra/q_jbyt.inc"
-
-* Find KEY,CYCLE
-*
- CALL RZINK(KEYU,ICYCLE,CHOPT)
- IF(IQUEST(1).NE.0)GO TO 99
-*
-*!! options set by call to UOPTC in RZINK !!
-*
- IF(IOPTC.NE.0.AND.IOPTD.EQ.0)GO TO 99
- IF(IOPTN.NE.0.AND.IOPTD.EQ.0)GO TO 99
- ISTART = 1
- CALL UOPTC(CHOPT,'O',IOPTO)
- IF(IOPTO.NE.0) ISTART = N
-*
- NW = IQUEST(12)
- N = NW
- IF(NW.GT.NDIM)THEN
- IQUEST(11)=NW
- NW=NDIM
- ENDIF
-*
- IFORM=JBYT(IQUEST(14),1,3)
- IF(IFORM.LE.0)THEN
- IQUEST(1)=2
- GO TO 99
- ENDIF
-*
-* Read record into array V
-*
- CALL RZREAD(V,NW,ISTART,IFORM)
-*
-* Store I/O descriptor in IQUEST(13)
-*
- IQUEST(13) = IFORM
-*
- 99 RETURN
- END
diff --git a/src/packlib/zebra/rz/rzvout.F b/src/packlib/zebra/rz/rzvout.F
deleted file mode 100644
index 81d8f40..0000000
--- a/src/packlib/zebra/rz/rzvout.F
+++ /dev/null
@@ -1,415 +0,0 @@
-*
-* $Id: rzvout.F,v 1.4 1997/11/24 14:47:21 jamie Exp $
-*
-* $Log: rzvout.F,v $
-* Revision 1.4 1997/11/24 14:47:21 jamie
-* set IOPTRR in /RZCOUT/
-*
-* Revision 1.3 1996/04/24 17:27:21 mclareni
-* Extend the include file cleanup to dzebra, rz and tq, and also add
-* dependencies in some cases.
-*
-* Revision 1.2 1996/03/08 08:08:06 jamie
-* Bug fixes for opt R handling in rz(v)out
-*
-* Revision 1.1.1.1 1996/03/06 10:47:27 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE RZVOUT(V,N,KEYU,ICYCLE,CHOPT)
-*
-************************************************************************
-*
-* User FORTRAN array V of length N is output on a RZ file
-* Input:
-* V Fortran array of length N
-* KEYU Keyword vector of length NWKEY as specified by RZMDIR.
-* ICYCLE only used as Input parameter if 'A' option is given (see below)
-* CHOPT Character variable specifying the selected options.
-* mode
-* default
-* Array V contains only floating points
-* 'I' Array V contains integers
-* 'B' Array V contains bit-patterns
-* 'H' Array V contains Holleriths
-* 'D' Array V contains Double precision words
-* 'A' Key will not be visible by RZLDIR
-* 'R' Replace option.
-* 'S' Used for sequential operation. Application
-* guarantees that keys are unique and objects
-* are simply appended without checking all existing keys
-* Output:
-* ICYCLE Cycle number associated to the key entered
-* ICYCLE is 1 if KEY was not already present in the directory,
-* and one larger than the previous cycle associated to the key
-* otherwise.
-* ICYCLE is only Input parameter when option 'A' is given
-*
-* Called by <USER>
-*
-* Author : R.Brun DD/US/PD
-* Written : 03.04.86
-* Last mod: 25.06.93 - JDS Add IEVENT to RZWRT call (see RZWRT)
-* : 04.03.94 - S.Banerjee (Change in cycle structure)
-* : 05.09.94 - Add option S
-* : 23.03.95 J.Shiers - key # in cycles block is KEY(1)
-* : 10.04.95 J.Shiers - move IKYV lines to after definition
-* : 08.03.96 J.Shiers - use ICOLD (not 1) if opt R specified
-* : 24.11.97 M.Brun - set IOPTRR in /RZCOUT/
-*
-************************************************************************
-#include "zebra/zunit.inc"
-#include "zebra/rzcl.inc"
-#include "zebra/rzclun.inc"
-#include "zebra/rzcout.inc"
-#include "zebra/rzk.inc"
-#include "zebra/rzckey.inc"
-#include "zebra/rzcycle.inc"
-#include "zebra/mzioc.inc"
- CHARACTER*(*) CHOPT
- DIMENSION KEYU(*),V(*)
- DIMENSION IOPTV(7)
- EQUIVALENCE (IOPTA,IOPTV(1)), (IOPTD,IOPTV(2))
- +, (IOPTI,IOPTV(3)), (IOPTB,IOPTV(4))
- +, (IOPTH,IOPTV(5)), (IOPTR,IOPTV(6))
- +, (IOPTS,IOPTV(7))
-*
-*-----------------------------------------------------------------------
-*
-#include "zebra/q_jbyt.inc"
-*
- IQUEST(1)=0
- IEVENT =0
-*
-* Loglevel
-*
- LOGLV = JBYT(IQ(KQSP+LTOP),15,3)-3
-*
- CALL UOPTC(CHOPT,'ADIBHRS',IOPTV)
-*
-* Set also /RZCOUT/ common variable
-*
- IOPTRR = IOPTR
-*
-* Options R & S are incompatible
-*
- IF(IOPTR.NE.0.AND.IOPTS.NE.0) THEN
- IF(LOGLV.GE.3) WRITE(IQPRNT,10000)
-10000 FORMAT(' RZVOUT. ERROR - options R and S are incompatible')
- IQUEST(1)=5
- GOTO 999
- ENDIF
-*
-* Check if WRITE permission on file and directory
-*
- IF(LQRS.EQ.0)GOTO 999
- IF(N.LE.0)THEN
- IQUEST(1)=4
- GOTO 999
- ENDIF
- IFLAG=0
- CALL RZMODS('RZVOUT',IFLAG)
- IF(IFLAG.NE.0)GOTO 999
-*
-* Write current buffer if not same directory
-* Get last record written in that directory
-* Create buffer bank
-*
- LROUT = LQ(KQSP+LTOP-6)
- IROUT = IQ(KQSP+LTOP+KIROUT)
- IRLOUT = IQ(KQSP+LCDIR+KRLOUT)
- IP1 = IQ(KQSP+LCDIR+KIP1)
- IF(LROUT.EQ.0)THEN
- CALL MZBOOK(JQPDVS,LROUT,LTOP,-6,'RZOU',0,0,LREC+1,2,-1)
- IQ(KQSP+LROUT-5)=LUN
- IROUT=0
- IP1=1
- ENDIF
- IF(IROUT.NE.IRLOUT.AND.IRLOUT.NE.0)THEN
- CALL RZIODO(LUN,LREC,IRLOUT,IQ(KQSP+LROUT+1),1)
-#if defined(CERNLIB_QMVAX)
- IF(IRELAT.NE.0)UNLOCK(UNIT=LUN)
-#endif
- IROUT=IRLOUT
- IQ(KQSP+LTOP+KIROUT)=IROUT
- IP1=IQ(KQSP+LCDIR+KIP1)
- IF(IQ(KQSP+LTOP+KIRIN).EQ.IROUT)IQ(KQSP+LTOP+KIRIN) = 0
- ENDIF
-*
-* Is directory big enough to accomodate new cycle ?
-*
- IF(IOPTR.EQ.0) THEN
- IF(IQ(KQSP+LCDIR+KNFREE).LT.IQ(KQSP+LCDIR+KNWKEY)+4*KLCYCL+1)
- + THEN
- CALL RZEXPD('RZVOUT',10*(IQ(KQSP+LCDIR+KNWKEY)+KLCYCL+1))
- IF(IQUEST(1).NE.0)GOTO 999
- ENDIF
- ENDIF
-
- LK = IQ(KQSP+LCDIR+KLK)
- LF = IQ(KQSP+LCDIR+KLF)
- LC = IQ(KQSP+LCDIR+KLC)
- NWFREE=IQ(KQSP+LCDIR+KNFREE)
-
- IF(IOPTR.EQ.0) THEN
-*
-* Compute how many records and how many words
-* are necessary to write array V.
-*
- IR1=IRLOUT
- IALLOC=0
- NDATA=N
- NLEFT=LREC-IP1+1
- IF(NDATA.LE.NLEFT)THEN
- NR=0
- ELSE
- NR=(NDATA-NLEFT-1)/LREC + 1
- ENDIF
- IF(IRLOUT.EQ.0)NR=NR+1
- IF(NR.GT.0)THEN
- CALL RZALLO('RZVOUT',NR,IALLOC)
- IF(IALLOC.EQ.0)GOTO 999
- ENDIF
- IF(IRLOUT.EQ.0.OR.IP1.GT.LREC)THEN
- IP1=1
- NLEFT=LREC
- IRLOUT=IALLOC
- IR1=IALLOC
- IR2=IALLOC+1
- IR3=IALLOC+NR-1
- IF(NR.EQ.1)THEN
- IR2=0
- IR3=0
- ENDIF
- ELSE
- IR2=IALLOC
- IR3=IALLOC+NR-1
- ENDIF
-
- ENDIF
-
- NKEYS = IQ(KQSP+LCDIR+KNKEYS)
- NWKEY = IQ(KQSP+LCDIR+KNWKEY)
- IQUEST(7)=NKEYS
- IQUEST(8)=NWKEY
-*
-* Convert input key vector to internal format
-*
- DO 10 I=1,NWKEY
- IKDES=(I-1)/10
- IKBIT1=3*I-30*IKDES-2
- IF(JBYT(IQ(KQSP+LCDIR+KKDES+IKDES),IKBIT1,3).LT.3)THEN
- KEY(I)=KEYU(I)
- ELSE
- CALL ZHTOI(KEYU(I),KEY(I),1)
- ENDIF
- 10 CONTINUE
-*
-* Search if KEY is already entered
-*
- IF(IOPTS.EQ.0) THEN
- IF(NKEYS.GT.0)THEN
- DO 30 I=1,NKEYS
- DO 20 K=1,NWKEY
- LKC=LK+(NWKEY+1)*(I-1)
- IF(IQ(KQSP+LCDIR+LKC+K).NE.KEY(K))GOTO 30
- 20 CONTINUE
- LCOLD=IQ(KQSP+LCDIR+LKC)
- IF (KVSCYC.NE.0) THEN
-* IF (IQ(KQSP+LCDIR+LCOLD+KKYCYC).NE.I) THEN
- IF (IQ(KQSP+LCDIR+LCOLD+KKYCYC).NE.
- + IQ(KQSP+LCDIR+LKC+1)) THEN
- IQUEST(1) = 11
- GO TO 999
- ENDIF
- ENDIF
- ICOLD = JBYT(IQ(KQSP+LCDIR+LCOLD+KCNCYC),21,12)
-* IKYV = I
- IKYV = IQ(KQSP+LCDIR+LKC+1)
-
- IF(IOPTR.EQ.0) THEN
- ICYCLE=ICOLD+1
- ELSE
-* ICYCLE=1
- ICYCLE=ICOLD
- IF (KVSCYC.EQ.0) THEN
- IP1 = JBYT(IQ(KQSP+LCDIR+LCOLD+KORCYC), 1,16)
- IR1 = JBYT(IQ(KQSP+LCDIR+LCOLD+KFRCYC),17,16)
- IR2 = JBYT(IQ(KQSP+LCDIR+LCOLD+KSRCYC),17,16)
- NWORDS = JBYT(IQ(KQSP+LCDIR+LCOLD+KNWCYC), 1,20)
- ELSE
- IP1 = JBYT(IQ(KQSP+LCDIR+LCOLD+KORCYC), 1,20)
- IR1 = IQ(KQSP+LCDIR+LCOLD+KFRCYC)
- IR2 = IQ(KQSP+LCDIR+LCOLD+KSRCYC)
- NWORDS = IQ(KQSP+LCDIR+LCOLD+KNWCYC)
- ENDIF
- NLEFT=LREC-IP1+1
- IF(NWORDS.LE.NLEFT)THEN
- NR=0
- ELSE
- NR=(NWORDS-NLEFT-1)/LREC + 1
- ENDIF
- IF(LOGLV.GE.3) WRITE(IQPRNT,10100) IP1,IR1,NWORDS,NR
-10100 FORMAT(' RZVOUT. object starts at word ',I6,
- + ' in record ',I6,' nwords = ',I6,' nrecs = ',I6)
- IF(LOGLV.GE.3.AND.IR2.NE.0) WRITE(IQPRNT,10200) IR2
-10200 FORMAT(' RZVOUT. object continues in record ',I6)
- IRSAVE = IRLOUT
- IF(IR1.NE.IRLOUT) THEN
- CALL RZIODO(LUN,LREC,IR1,IQ(KQSP+LROUT+1),1)
- IF(IQUEST(1).NE.0)GOTO 999
- IROUT = IR1
- IRLOUT = IR1
- ENDIF
- ENDIF
-
- IQUEST(20)=I
- GOTO 50
- 30 CONTINUE
- ENDIF
-*
-* Object must already exist if R option is given
-*
- IF(IOPTR.NE.0) THEN
- IQUEST(1) = 6
- IF(LOGLV.GE.-2) WRITE(IQLOG,10300)
-10300 FORMAT(' RZVOUT. Error - object does not exist')
- GOTO 999
- ENDIF
-
- ENDIF
-*
-* New KEY, append to the list
-*
- IQUEST(20)=NWKEY+1
- NWFREE=NWFREE-NWKEY-1
- IQ(KQSP+LCDIR+KNKEYS)=IQ(KQSP+LCDIR+KNKEYS)+1
- LCOLD = 0
- LKC = LF
- LF = LF+NWKEY+1
- ICYCLE= 1
- DO 40 I=1,NWKEY
- IQ(KQSP+LCDIR+LKC+I)=KEY(I)
- 40 CONTINUE
-* IKYV = IQ(KQSP+LCDIR+KNKEYS)
- IKYV = IQ(KQSP+LCDIR+LKC+1)
-*
-* Write user array
-*
- 50 IQ3=IRLOUT
- IQ4=IP1
-
-#if !defined(CERNLIB_FQXISN)
- IF(IMODEX.GT.0)THEN
- MFO(1)= 3
- IF(IOPTI.NE.0)MFO(1)=2
- IF(IOPTB.NE.0)MFO(1)=1
- IF(IOPTH.NE.0)MFO(1)=5
- MFO(2)=-1
- JFOEND= 2
- ENDIF
-#endif
- CALL RZWRT(V,NDATA,IOPTB,IEVENT)
- IF(IQUEST(1).NE.0)THEN
- IF(ICYCLE.EQ.1.AND.IOPTR.EQ.0)THEN
- IQ(KQSP+LCDIR+KNKEYS)=IQ(KQSP+LCDIR+KNKEYS)-1
- ENDIF
- IROUT=IQ(KQSP+LTOP+KIROUT)
- IF(IROUT.GT.0)THEN
- IQ1=IQUEST(1)
- CALL RZIODO(LUN,LREC,IROUT,IQ(KQSP+LROUT+1),1)
-#if defined(CERNLIB_QMVAX)
- IF(IRELAT.NE.0)UNLOCK(UNIT=LUN)
-#endif
- IQUEST(1)=IQ1
- ENDIF
- GOTO 999
- ENDIF
-
- IF(IOPTR.EQ.0) THEN
- IF(IRLOUT.EQ.IR1) GOTO 60
- IF(IRLOUT.GE.IR2.AND.IRLOUT.LE.IR3) GOTO 60
- IF(IROUT.EQ.IRLOUT)IROUT=0
- IRLOUT = 0
- IP1 = 1
- 60 CONTINUE
-*
-* Create a new cycle
-*
- LC = LC-KLCYCL
- NWFREE= NWFREE-KLCYCL
- IFORM = 3
- IF(IOPTI.NE.0) IFORM = 2
- IF(IOPTB.NE.0) IFORM = 1
- IF(IOPTH.NE.0) IFORM = 5
- IQ(KQSP+LCDIR+LKC) = LC
- IQ(KQSP+LCDIR+LC+KPPCYC) = LCOLD
- IQ(KQSP+LCDIR+LC+KFLCYC) = IFORM
- CALL RZDATE(IQ(KQSP+LCDIR+LC+KFLCYC),IDATE,ITIME,2)
- IF(IOPTA.NE.0) CALL SBIT1(IQ(KQSP+LCDIR+LC+KFLCYC),4)
- IQ(KQSP+LCDIR+LC+KORCYC) = IQ4
- IQ(KQSP+LCDIR+LC+KNWCYC) = NDATA
- CALL SBYT(ICYCLE,IQ(KQSP+LCDIR+LC+KCNCYC),21,12)
- IF (KVSCYC.EQ.0) THEN
- IF (NLEFT.LT.NDATA)
- + CALL SBYT(IR2,IQ(KQSP+LCDIR+LC+KSRCYC),17,16)
- CALL SBYT(IR1,IQ(KQSP+LCDIR+LC+KFRCYC),17,16)
- ELSE
- IF (NLEFT.LT.NDATA) THEN
- IQ(KQSP+LCDIR+LC+KSRCYC) = IR2
- ELSE
- IQ(KQSP+LCDIR+LC+KSRCYC) = 0
- ENDIF
- IQ(KQSP+LCDIR+LC+KFRCYC) = IR1
- IQ(KQSP+LCDIR+LC+KKYCYC) = IKYV
- ENDIF
- ENDIF
-*
-* Update internal pointers in the directory
-*
- IQUEST(3)=IQ3
- IQUEST(4)=IQ4
- IQUEST(5)=0
- IQUEST(6)=ICYCLE
- IQUEST(11)=NDATA
-
- IF(IOPTR.EQ.0) THEN
-
- IQ(KQSP+LTOP+KIROUT)=IROUT
- IQ(KQSP+LCDIR+KRUSED)=IQ(KQSP+LCDIR+KRUSED)+NR
- NWUSED=IQ(KQSP+LCDIR+KWUSED)+NDATA
- IF(NWUSED.GT.1000000)THEN
- IQ(KQSP+LCDIR+KMEGA)=IQ(KQSP+LCDIR+KMEGA)+1
- IQ(KQSP+LCDIR+KWUSED)=NWUSED-1000000
- ELSE
- IQ(KQSP+LCDIR+KWUSED)=NWUSED
- ENDIF
- IQ(KQSP+LCDIR+KRLOUT)=IRLOUT
- IQ(KQSP+LCDIR+KIP1)=IP1
- IQ(KQSP+LCDIR+KNFREE)=NWFREE
- IQ(KQSP+LCDIR+KLF)=LF
- IQ(KQSP+LCDIR+KLC)=LC
-
- ENDIF
-
- IQUEST(9)=IQ(KQSP+LCDIR+KQUOTA)-IQ(KQSP+LCDIR+KRUSED)
-*
-* Mark used records
-*
- IF(IOPTR.EQ.0.AND.NR.GT.0)THEN
- CALL RZUSED(NR,IALLOC)
- ENDIF
-*
-* Restore last record written if required
-*
- IF(IOPTR.NE.0.AND.IRSAVE.NE.IRLOUT) THEN
- CALL RZIODO(LUN,LREC,IRLOUT,IQ(KQSP+LROUT+1),2)
- IF(IQUEST(1).NE.0)GOTO 999
- IROUT = IRSAVE
- IRLOUT = IRSAVE
- CALL RZIODO(LUN,LREC,IRLOUT,IQ(KQSP+LROUT+1),1)
- IF(IQUEST(1).NE.0)GOTO 999
- ENDIF
-*
- 999 END
diff --git a/src/packlib/zebra/rz/rzwrt.F b/src/packlib/zebra/rz/rzwrt.F
deleted file mode 100644
index b8e77e2..0000000
--- a/src/packlib/zebra/rz/rzwrt.F
+++ /dev/null
@@ -1,196 +0,0 @@
-*
-* $Id: rzwrt.F,v 1.1.1.1 1996/03/06 10:47:27 mclareni Exp $
-*
-* $Log: rzwrt.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:27 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE RZWRT(V,N,IOPTB,IEVENT)
-*
-************************************************************************
-*
-* To write array V of length N into the CWD
-* RZ internal routine called by RZVOUT,RZOHN,RZOBKN
-*
-* Called by RZOBKN,RZOHN,RZVOUT
-*
-* Author : R.Brun, B.Holl
-* Written : 26.04.86
-* Last mod: 14.04.94 JDS. Correct(?) handling of end of records
-* 29.07.94 JDS. In case of termination on EOR, last
-* fragment of buffer was converted/copied twice
-*
-************************************************************************
-#if !defined(CERNLIB_FQXISN)
-#include "zebra/zunit.inc"
-#endif
-#include "zebra/rzcl.inc"
-#include "zebra/rzclun.inc"
-#include "zebra/rzcout.inc"
-#include "zebra/rzk.inc"
-#include "zebra/mzioc.inc"
- DIMENSION V(N)
-*
-*-----------------------------------------------------------------------
-*
-*
-* Event continued?
-*
- IF(IEVENT.EQ.1.AND.IP1.GT.LREC) THEN
- IF(IRLOUT.EQ.IR1)THEN
- IR=IR2
- ELSE
- IR=IRLOUT+1
- ENDIF
- IP1 = 1
- IROUT = IR
- IRLOUT = IR
- ENDIF
-
- NREC = N + IP1 - 1
- NLEFT=LREC-IP1+1
- IF(N.LE.NLEFT)THEN
- NP1=N
- ELSE
- NP1=NLEFT
- ENDIF
-#if !defined(CERNLIB_FQXISN)
- IF(IMODEX.GT.0.AND.IOPTB.NE.1)THEN
- NWFOTT = N
- NWFODN = 0
- NWFOAV = NP1
- CALL FZOCV(V,IQ(KQSP+LROUT+IP1))
- IF(NWFOAV.GT.0.OR.IFOCON(1).LT.0)GO TO 95
- IQUEST(1)=0
- ELSE
-#endif
- CALL UCOPY(V,IQ(KQSP+LROUT+IP1),NP1)
-#if !defined(CERNLIB_FQXISN)
- ENDIF
-#endif
- IF(IP1.EQ.1)THEN
- IROUT =IRLOUT
- ENDIF
- IP1=IP1+NP1
- IF(IP1.GT.LREC)THEN
- CALL RZIODO(LUN,LREC,IRLOUT,IQ(KQSP+LROUT+1),2)
- IF(IQUEST(1).NE.0)GO TO 99
- IF(LRIN.NE.0)THEN
- IF(IQ(KQSP+LTOP+KIRIN).EQ.IRLOUT)THEN
- IQ(KQSP+LTOP+KIRIN)=0
- ENDIF
- ENDIF
- IF(IRLOUT.EQ.IR1)THEN
- IR=IR2
- ELSE
- IR=IRLOUT+1
- ENDIF
-* JDS 14/04/94
- IF(IR.EQ.0) GOTO 99
- 10 IP1=1
- NW=N-NP1
- IF(NW.GT.LREC)NW=LREC
- IF(NW.LT.LREC.AND.IOPTRR.NE.0)THEN
- CALL RZIODO(LUN,LREC,IR,IQ(KQSP+LROUT+1),1)
- IF(IQUEST(1).NE.0)GO TO 99
- ENDIF
-#if !defined(CERNLIB_FQXISN)
- IF(IMODEX.GT.0.AND.IOPTB.NE.1)THEN
-
- IF(NWFOAV.LT.0)THEN
-*
-* Case when output buffer overflowed (double precision conversion)
-*
- NWFOAV=NW-1
- IQ(KQSP+LROUT+1)=IQ(KQSP+LROUT+LREC+1)
- CALL FZOCV(V,IQ(KQSP+LROUT+2))
- ELSE
-*
-* Normal case
-*
- NWFOAV=NW
- CALL FZOCV(V,IQ(KQSP+LROUT+1))
- ENDIF
-
- IF(NWFOAV.GT.0.OR.IFOCON(1).LT.0)GO TO 95
- IQUEST(1)=0
- IF(NW.EQ.LREC) THEN
- CALL RZIODO(LUN,NW,IR,IQ(KQSP+LROUT+1),2)
- IF(IQUEST(1).NE.0)GO TO 99
- ENDIF
- ELSE
-#endif
- IF(NW.EQ.LREC) THEN
- CALL RZIODO(LUN,NW,IR,V(NP1+1),2)
- IF(IQUEST(1).NE.0)GO TO 99
- ELSE
- CALL UCOPY(V(NP1+1),IQ(KQSP+LROUT+IP1),NW)
- ENDIF
-#if !defined(CERNLIB_FQXISN)
- ENDIF
-#endif
- IRLOUT=IR
- IROUT =IR
- IP1=IP1+NW
- NP1=NP1+NW
-*
-* JDS 29/07/94
-*
-* IF(NP1.GE.N) GOTO 99
-*
-* JDS 31/10/94
-*
-* All data written - fill output buffer if on a record boundary
-*
- IF(NP1.GE.N) THEN
- IF(MOD(NREC,LREC).EQ.0)THEN
-#if !defined(CERNLIB_FQXISN)
- IF(IMODEX.GT.0.AND.IOPTB.NE.1)THEN
-* NWFODN = 0
-* IF(NWFOAV.LT.0)THEN
-* NWFOAV=NW-1-NP1
-* IQ(KQSP+LROUT+IP1-NW)=IQ(KQSP+LROUT+LREC+1)
-* CALL FZOCV(V,IQ(KQSP+LROUT+IP1-NW+1))
-* ELSE
-* NWFOAV=NW-NP1
-* CALL FZOCV(V,IQ(KQSP+LROUT+IP1-NW))
-* ENDIF
-* IF(NWFOAV.GT.0.OR.IFOCON(1).LT.0)GO TO 95
-* IQUEST(1)=0
- ELSE
-#endif
-*
-* Fill output buffer for the case when vector ends on
-* a record boundary (already filled if data conversion
-* performed).
-*
- CALL UCOPY(V(NP1-NW+1),IQ(KQSP+LROUT+IP1-NW),NW)
-#if !defined(CERNLIB_FQXISN)
- ENDIF
-#endif
- ENDIF
- GO TO 99
- ENDIF
- IR =IR+1
- GO TO 10
- ENDIF
-#if !defined(CERNLIB_FQXISN)
- GO TO 99
-*
-* Conversion problem
-*
- 95 IQUEST(1) =5
- IQUEST(11)=NWFOTT
- IQUEST(12)=NWFORE
- IQUEST(13)=NWFOAV
- IQUEST(14)=NWFODN
- IF(JBYT(IQ(KQSP+LTOP),15,3)-3.GE.-2) WRITE(IQLOG,1000)
- 1000 FORMAT(' RZOUT/RZVOUT. Error during conversion into',
- + ' exchange format detected by RZWRT')
-*1000 FORMAT(' RZWRT. Error during conversion into exchange format')
-#endif
-*
- 99 RETURN
- END
diff --git a/src/packlib/zebra/test/Imakefile b/src/packlib/zebra/test/Imakefile
deleted file mode 100644
index de1d7ec..0000000
--- a/src/packlib/zebra/test/Imakefile
+++ /dev/null
@@ -1,91 +0,0 @@
-
-#define IHaveSubdirs
-#define PassCDebugFlags
-
-LIBDIRS= cq cqaux cqhi fqtest jqtest mzcote tzebra
-SUBDIRS= $(LIBDIRS)
-
-#ifndef CERNLIB_VAX
-
-EXTRA_INCLUDES=-I$(TOP)$(CURRENT_DIR) -I$(VPATH)
-export EXTRA_INCLUDES
-
-#else
-
-/*export EXTRA_INCLUDES would easier, but VMS gmake does not understand this yet
- Also += is not understood by gmake
- Do not remove any of the \, unless you want to create trouble
- GF (12-Jan-96)
- */
-EXTRA_INCLUDES=-I$(TOP)$(CURRENT_DIR)]
-MAKEFLAGS:=EXTRA_INCLUDES\=\-I$(TOP)$(CURRENT_DIR)]
-#endif
-
-#ifdef CERNLIB_HPUX
-FORTRANOPTIONS += -WF,-P
-#endif
-
-DefinePackageLibrary(zebtlib)
-
-SubdirLibraryTarget(zebtlib,$(LIBDIRS))
-
-.PHONY: testmz testfz testfc testjz testrz
-
-testmz: zebmz1
-
-testfz: zebfz1 zebfz2 zebfz3 zebfz4 zebfz5 zebfz6 zebfz7 zebfz8 zebfz9
-
-testfc: zebfc1 zebfc2 zebfc3
-
-testjz: zebjz1
-
-testrz: zebrz1 zebrz2 zebrz3
-
-CernlibFortranProgramTarget(zebmz1,zebmz1.o,$(PACKAGE_LIB),$(PACKAGE_LIB),kernlib)
-
-CernlibFortranProgramTarget(zebfz1,zebfz1.o,$(PACKAGE_LIB),$(PACKAGE_LIB),kernlib)
-CernlibFortranProgramTarget(zebfz2,zebfz2.o,$(PACKAGE_LIB),$(PACKAGE_LIB),kernlib)
-CernlibFortranProgramTarget(zebfz3,zebfz3.o,$(PACKAGE_LIB),$(PACKAGE_LIB),kernlib)
-CernlibFortranProgramTarget(zebfz4,zebfz4.o,$(PACKAGE_LIB),$(PACKAGE_LIB),kernlib)
-CernlibFortranProgramTarget(zebfz5,zebfz5.o,$(PACKAGE_LIB),$(PACKAGE_LIB),kernlib)
-CernlibFortranProgramTarget(zebfz6,zebfz6.o,$(PACKAGE_LIB),$(PACKAGE_LIB),kernlib)
-CernlibFortranProgramTarget(zebfz7,zebfz7.o,$(PACKAGE_LIB),$(PACKAGE_LIB),kernlib)
-CernlibFortranProgramTarget(zebfz8,zebfz8.o,$(PACKAGE_LIB),$(PACKAGE_LIB),kernlib)
-CernlibFortranProgramTarget(zebfz9,zebfz9.o,$(PACKAGE_LIB),$(PACKAGE_LIB),kernlib)
-
-CernlibFortranProgramTarget(zebfc1,zebfc1.o,$(PACKAGE_LIB),$(PACKAGE_LIB),kernlib)
-CernlibFortranProgramTarget(zebfc2,zebfc2.o,$(PACKAGE_LIB),$(PACKAGE_LIB),kernlib)
-CernlibFortranProgramTarget(zebfc3,zebfc3.o,$(PACKAGE_LIB),$(PACKAGE_LIB),kernlib)
-
-CernlibFortranProgramTarget(zebjz1,zebjz1.o,$(PACKAGE_LIB),$(PACKAGE_LIB),kernlib)
-
-CernlibFortranProgramTarget(zebrz1,zebrz1.o,$(PACKAGE_LIB),$(PACKAGE_LIB),kernlib)
-CernlibFortranProgramTarget(zebrz2,zebrz2.o,$(PACKAGE_LIB),$(PACKAGE_LIB),kernlib)
-CernlibFortranProgramTarget(zebrz3,zebrz3.o,$(PACKAGE_LIB),$(PACKAGE_LIB),kernlib)
-
-TestTarget(zebmz1,zxtest.dat,NullParameter)
-
-TestTarget(zebfz1,NullParameter,NullParameter)
-TestTarget(zebfz2,NullParameter,NullParameter)
-TestTarget(zebfz3,NullParameter,NullParameter)
-TestTarget(zebfz4,NullParameter,NullParameter)
-TestTarget(zebfz5,NullParameter,NullParameter)
-TestTarget(zebfz6,NullParameter,NullParameter)
-TestTarget(zebfz7,NullParameter,NullParameter)
-TestTarget(zebfz8,NullParameter,NullParameter)
-TestTarget(zebfz9,NullParameter,NullParameter)
-
-TestTarget(zebfc1,NullParameter,NullParameter)
-TestTarget(zebfc2,NullParameter,NullParameter)
-TestTarget(zebfc3,NullParameter,NullParameter)
-
-TestTarget(zebjz1,jztest.dat,NullParameter)
-
-TestTarget(zebrz1,NullParameter,NullParameter)
-TestTarget(zebrz2,NullParameter,NullParameter)
-TestTarget(zebrz3,NullParameter,NullParameter)
-
-
-CopyFile(zxtest.data,zxtest.dat)
-CopyFile(jztest.data,jztest.dat)
-
diff --git a/src/packlib/zebra/test/brztest/Imakefile b/src/packlib/zebra/test/brztest/Imakefile
deleted file mode 100644
index 40023ea..0000000
--- a/src/packlib/zebra/test/brztest/Imakefile
+++ /dev/null
@@ -1,3 +0,0 @@
-SRCS_F= btest1.F btest2.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/zebra/test/brztest/btest1.F b/src/packlib/zebra/test/brztest/btest1.F
deleted file mode 100644
index 8d1daa6..0000000
--- a/src/packlib/zebra/test/brztest/btest1.F
+++ /dev/null
@@ -1,241 +0,0 @@
-*
-* $Id: btest1.F,v 1.4 1997/08/29 13:34:01 mclareni Exp $
-*
-* $Log: btest1.F,v $
-* Revision 1.4 1997/08/29 13:34:01 mclareni
-* Add new test, zebrz3 to test RZ exchange mode and CIO
-*
-* Revision 1.3 1997/07/04 16:54:16 mclareni
-* Change the Linux BACKSLASH to agree with the gcc default
-*
-* Revision 1.2 1996/09/23 12:27:40 cernlib
-* add Linux
-*
-* Revision 1.1.1.1 1996/03/06 10:46:59 mclareni
-* Zebra
-*
-*
-#include "test_include/pilot.h"
-#if defined(CERNLIB_QMCDC)
- PROGRAM BTEST1(INPUT,OUTPUT,TAPE1)
-#endif
-#if !defined(CERNLIB_QMCDC)
- PROGRAM BTEST1
-#endif
-*
-********************************************************************************
-* *
-* Batch test program number 1 for RZ *
-* *
-* Author : R.Brun *
-* Written : 16.04.86 *
-* Last mod: 07.05.86 *
-* *
-********************************************************************************
-*
- COMMON/CRZT/IXSTOR,IXDIV,IFENCE(2),LEV,LEVIN,BLVECT(50000)
- DIMENSION LQ(999),IQ(999),Q(999)
- EQUIVALENCE (IQ(1),Q(1),LQ(9)),(LQ(1),LEV)
-C
- DIMENSION KEY(10)
- CHARACTER*8 CHTAG(10),RTIME
-#if defined(CERNLIB_TESTCX)
- CHARACTER*16 CHDIR
-#endif
- CHARACTER*1 BSLSH
-#if defined(CERNLIB_QMIBM)||defined(CERNLIB_QMCRY) \
- ||defined(CERNLIB_QMNXT)||defined(CERNLIB_QMCV32)
- PARAMETER (BSLSH='\')
-#elif defined(CERNLIB_QMIRT)||defined(CERNLIB_QMLNX)
- PARAMETER (BSLSH='\\')
-#elif 1
- PARAMETER (BSLSH=CHAR(92))
-#endif
- DIMENSION IA(10000)
- DATA IA/10000*0/
-*
-* -----------------------------------------------------------------
-*
-#if !defined(CERNLIB_TESTCX)
-
-#if defined(CERNLIB_QMALT)||defined(CERNLIB_QMAPO)||defined(CERNLIB_QMSUN)||defined(CERNLIB_QMIRT)||defined(CERNLIB_QMMPW)||defined(CERNLIB_QMHPX)||defined(CERNLIB_QMIBX)||defined(CERNLIB_QMDOS)||defined(CERNLIB_QMLNX)||defined(CERNLIB_QMNXT)
- OPEN(UNIT=1,FILE='rzcomp.dat',ACCESS='DIRECT',RECL=6000,
- + STATUS='UNKNOWN')
-#endif
-#if defined(CERNLIB_QMCRY)||defined(CERNLIB_QMCV64)
- OPEN(UNIT=1,ACCESS='DIRECT',FORM='UNFORMATTED',RECL=12000)
-#endif
-#if defined(CERNLIB_QMVAX)||defined(CERNLIB_QMVMI)||defined(CERNLIB_QMSGI)
- OPEN(UNIT=1,FILE='RZCOMP.DAT',ACCESS='DIRECT',RECL=1500,
- + STATUS='UNKNOWN')
-#endif
-#if defined(CERNLIB_QMIBM)
- OPEN(UNIT=1,ACCESS='DIRECT',RECL=6000,STATUS='UNKNOWN')
- CALL TIMEST(9999.)
-#endif
-#if defined(CERNLIB_QMCDC)
- OPEN(UNIT=1,ACCESS='DIRECT',RECL=1500,STATUS='UNKNOWN')
-#endif
-#if defined(CERNLIB_QMCV32)
- OPEN(UNIT=1,ACCESS='DIRECT',FORM='UNFORMATTED',RECL=6000)
-#endif
-
-#endif
-C
- CALL MZEBRA(-1)
- CALL MZSTOR(IXSTOR,'/CRZT/',' ',IFENCE,LEV,BLVECT(1),BLVECT(1),
- + BLVECT(5000),BLVECT(50000))
- CALL TIMED(T0)
- CALL ETIMEC(RTIME)
-C
-C Create RZ file
-C
-#if defined(CERNLIB_TESTCX)
- CALL RZOPEN(LUN1,CHDIR,'RZTEST3.DAT','CNX',1500,ISTAT)
- if(ISTAT.NE.0)print*,' Error trying to create file'
- CALL RZMAKE(LUN1,'RZTEST',1,'I','TOPTAG ',1024,'CIX')
-#else
- CALL RZMAKE(1,'RZTEST',1,'I','TOPTAG ',1024,' ')
-#endif
-C
-C Create 2 subdirectories
-C
- CHTAG(1)='INDEX'
- CALL RZMDIR('DIR1',1,'I',CHTAG)
- CALL RZMDIR('DIR2',1,'I',CHTAG)
-C
- CALL RZCDIR('DIR1',' ')
-C
- CALL TIMED(T1)
- CALL ETIMEC(RTIME)
- PRINT 1000,RTIME,T1
- 1000 FORMAT(' STEP 1: REAL TIME ',A,' CP TIME',F10.5,' SECONDS')
-C
-C Add,Retrieve and verify some records
-C
- DO 10 J=1,100
- NWORDS=J
- IA(NWORDS)=NWORDS
- CALL RZVOUT(IA,NWORDS,J,ICYCLE,' ')
- CALL RZVIN (IA,10000,N,J,ICYCLE,' ')
- IF(IA(NWORDS).NE.NWORDS)GO TO 90
- 10 CONTINUE
-C
- CALL TIMED(T2)
- CALL ETIMEC(RTIME)
- PRINT 2000,RTIME,T2
- 2000 FORMAT(' STEP 2: REAL TIME ',A,' CP TIME',F10.5,' SECONDS')
-C
- CALL RZCDIR(BSLSH//'DIR2',' ')
-C
- DO 20 J=1,100
- NWORDS=J*J
- IA(NWORDS)=NWORDS
- CALL RZVOUT(IA,NWORDS,J,ICYCLE,' ')
- CALL RZVIN (IA,10000,N,J,ICYCLE,' ')
- IF(IA(NWORDS).NE.NWORDS)GO TO 90
- 20 CONTINUE
-C
- CALL TIMED(T3)
- CALL ETIMEC(RTIME)
- PRINT 3000,RTIME,T3
- 3000 FORMAT(' STEP 3: REAL TIME ',A,' CP TIME',F10.5,' SECONDS')
-C
-C List directories and then delete all objects
-C
- CALL RZCDIR(BSLSH,' ')
- CALL RZLDIR('DIR1',' ')
- CALL RZLDIR('DIR2',' ')
-C
- CALL TIMED(T3)
- CALL RZDELT('DIR1')
- CALL RZDELT('DIR2')
-C
- CALL TIMED(T4)
- CALL ETIMEC(RTIME)
- PRINT 4000,RTIME,T4
- 4000 FORMAT(' STEP 4: REAL TIME ',A,' CP TIME',F10.5,' SECONDS')
-C
- CALL RZEND('RZTEST')
-C
- STOP
-C
- 90 PRINT 9000,J,NWORDS
- 9000 FORMAT(' ERROR WHEN J=',I3, ' NWORDS =',I6)
- STOP
- END
- SUBROUTINE ETIMEC(ELAPSD)
-C***********************************************************************
-C *
-C ROUTINE FUNCTIONALLY EQUIVALENT TO TIMED, BUT FOR REAL TIME *
-C *
-C***********************************************************************
-C
- CHARACTER*(8) ELAPSD
- INTEGER ND(2),NT(2)
- CHARACTER*(8) CD,CT
- CHARACTER*(*) DIGIT
- PARAMETER (DIGIT='0123456789')
- INTEGER IOLDAY,IOLSEC,MONTH(0:12)
- DATA IOLDAY,IOLSEC /0,0/
- DATA MONTH /0,31,59,90,120,151,181,212,243,273,304,334,365/
-C
- CALL DATIMH(ND,NT)
- CALL UHTOC(ND,100,CD,8)
- CALL UHTOC(NT,100,CT,8)
-C
-C CONVERT DATE INTO NUMBER OF DAYS FROM START OF YEAR
-C
- NHIGH=INDEX(DIGIT,CD(1:1))-1
- NLOW=INDEX(DIGIT,CD(2:2))-1
- NDAY=NHIGH*10+NLOW
-C
- NHIGH=INDEX(DIGIT,CD(4:4))-1
- NLOW=INDEX(DIGIT,CD(5:5))-1
- NMONTH=NHIGH*10+NLOW
-C
- NHIGH=INDEX(DIGIT,CD(7:7))-1
- NLOW=INDEX(DIGIT,CD(8:8))-1
- NYEAR=NHIGH*10+NLOW
-C
- IDAY=NDAY-1+MONTH(NMONTH-1)
- IF ((NYEAR/4)*4.EQ.NYEAR.AND.NMONTH.GT.2) IDAY=IDAY+1
-C
-C CONVERT TIME INTO NUMBER OF SECONDS FROM START OF DAY
-C
- NHIGH=INDEX(DIGIT,CT(1:1))-1
- NLOW=INDEX(DIGIT,CT(2:2))-1
- NHOUR=NHIGH*10+NLOW
-C
- NHIGH=INDEX(DIGIT,CT(4:4))-1
- NLOW=INDEX(DIGIT,CT(5:5))-1
- NMINUT=NHIGH*10+NLOW
-C
- NHIGH=INDEX(DIGIT,CT(7:7))-1
- NLOW=INDEX(DIGIT,CT(8:8))-1
- NSECON=NHIGH*10+NLOW
-C
- ISEC=NSECON+NMINUT*60+NHOUR*3600
-C
-C COMPUTE THE ELAPSED TIME FROM PREVIOUS CALL
-C (IN HH:MM:SS FORMAT)
-C
- IDELAP=IDAY-IOLDAY
- ISELAP=ISEC-IOLSEC
- IOLSEC=ISEC
- IOLDAY=IDAY
- ISEC=MOD(ISELAP,60)
- IMINUT=(MOD(ISELAP,3600)-ISEC)/60
- IHOUR=ISELAP/3600+IDELAP*24
- IF (IHOUR.GT.99) THEN
- WRITE(ELAPSD,1100) IMINUT,ISEC
- ELSE
- WRITE(ELAPSD,1000) IHOUR,IMINUT,ISEC
- ENDIF
- RETURN
-1000 FORMAT(I2.2,':',I2.2,':',I2.2)
-1100 FORMAT('**:',I2.2,':',I2.2)
- END
- SUBROUTINE QNEXT
- WRITE(*,*) ' DUMMY QNEXT REACHED'
- END
diff --git a/src/packlib/zebra/test/brztest/btest2.F b/src/packlib/zebra/test/brztest/btest2.F
deleted file mode 100644
index 1fd9446..0000000
--- a/src/packlib/zebra/test/brztest/btest2.F
+++ /dev/null
@@ -1,164 +0,0 @@
-*
-* $Id: btest2.F,v 1.4 1997/09/02 15:16:16 mclareni Exp $
-*
-* $Log: btest2.F,v $
-* Revision 1.4 1997/09/02 15:16:16 mclareni
-* WINNT corrections
-*
-* Revision 1.3 1997/07/04 16:54:18 mclareni
-* Change the Linux BACKSLASH to agree with the gcc default
-*
-* Revision 1.2 1996/09/23 12:27:43 cernlib
-* add Linux
-*
-* Revision 1.1.1.1 1996/03/06 10:46:59 mclareni
-* Zebra
-*
-*
-#include "test_include/pilot.h"
- PROGRAM BTEST2
-*
-********************************************************************************
-* *
-* Batch test program number 2 for RZ *
-* *
-* Author : R.Brun *
-* Written : 05.04.86 *
-* Last mod: 07.05.86 *
-* *
-********************************************************************************
-*
- COMMON/CRZT/IXSTOR,IXDIV,IFENCE(2),LEV,LEVIN,BLVECT(30000)
- DIMENSION LQ(999),IQ(999),Q(999)
- EQUIVALENCE (IQ(1),Q(1),LQ(9)),(LQ(1),LEV)
-C
- DIMENSION KEY(10)
- CHARACTER*1 BSLSH
-#if defined(CERNLIB_QMIBM)||defined(CERNLIB_QMCRY) \
- ||defined(CERNLIB_QMNXT)||defined(CERNLIB_QMCV32)
- PARAMETER (BSLSH='\')
-#elif defined(CERNLIB_QMIRT)||defined(CERNLIB_QMLNX)
- PARAMETER (BSLSH='\\')
-#elif 1
- PARAMETER (BSLSH=CHAR(92))
-#endif
- CHARACTER*8 CHTAG(10)
-*
-* ---------------------------------------------------------------------
-*
-#if defined(CERNLIB_QMALT)||defined(CERNLIB_QMAPO)||defined(CERNLIB_QMSUN)||defined(CERNLIB_QMIRT)||defined(CERNLIB_QMMPW)||defined(CERNLIB_QMHPX)||defined(CERNLIB_QMIBX)||defined(CERNLIB_QMDOS)||defined(CERNLIB_QMLNX)||defined(CERNLIB_QMNXT)||defined(CERNLIB_WINNT)
- OPEN(UNIT=1,FILE='rztest.dat',ACCESS='DIRECT',RECL=4096,
- + STATUS='UNKNOWN')
-#endif
-#if defined(CERNLIB_QMCRY)||defined(CERNLIB_QMCV64)
- OPEN(UNIT=1,ACCESS='DIRECT',FORM='UNFORMATTED',RECL=8192)
-#endif
-#if defined(CERNLIB_QMVAX)||defined(CERNLIB_QMSGI)||defined(CERNLIB_QMVMI)
- OPEN(UNIT=1,FILE='RZTEST.DAT',ACCESS='DIRECT',RECL=1024,
- + STATUS='UNKNOWN')
-#endif
-#if defined(CERNLIB_QMIBM)
- OPEN(UNIT=1,ACCESS='DIRECT',RECL=4096,STATUS='UNKNOWN')
- CALL TIMEST(9999.)
-#endif
-#if defined(CERNLIB_QMCDC)
- OPEN(UNIT=1,ACCESS='DIRECT',RECL=1024,STATUS='UNKNOWN')
-#endif
-#if defined(CERNLIB_QMCV32)
- OPEN(UNIT=1,ACCESS='DIRECT',FORM='UNFORMATTED',RECL=4096)
-#endif
-C
- CALL MZEBRA(-1)
- CALL MZSTOR(IXSTOR,'/CRZT/',' ',IFENCE,LEV,BLVECT(1),BLVECT(1),
- + BLVECT(5000),BLVECT(30000))
- CALL TIMED(T0)
-C
-C Create RZ file
-C
- CALL RZMAKE(1,'RZTEST',1,'I','TOPTAG ',1000,' ')
-C
-C Create 2 subdirectories
-C
- CHTAG(1)='VOLUME'
- CHTAG(2)='NUMBER'
- CALL RZMDIR('CDET',1,'I',CHTAG)
- CALL RZMDIR('ECAP',2,'II',CHTAG)
-C
- CALL RZLDIR(' ',' ')
- CALL RZCDIR('CDET',' ')
-C
- CALL TIMED(T1)
- PRINT 1000,T1
- 1000 FORMAT(' TIME FOR STEP 1= ',F10.5,' SECONDS')
-C
-C Create objects in directory /CDET
-C
- NWW=0
- DO 10 I=1,50
- J=5*RNDM(I)
- NWORDS=5000*RNDM(J)
- CALL MZBOOK(IXSTOR,LBANK,LEV,1,'LEV ',0,0,NWORDS,2,0)
- KEY(1)=J
- CALL RZOUT(IXSTOR,LEV,KEY,ICYCLE,'W')
- NWW=NWW+NWORDS
- 10 CONTINUE
-C
- CALL RZLDIR('//RZTEST/CDET',' ')
-C
- CALL RZPURG(1)
-C
- CALL RZLDIR(' ',' ')
- PRINT 1500,NWW
- 1500 FORMAT(' Number of data words written in /CDET ',I7,/)
-C
- CALL TIMED(T2)
- PRINT 2000,T2
- 2000 FORMAT(' TIME FOR STEP 2= ',F10.5,' SECONDS')
-C
- CALL RZCDIR(BSLSH//'ECAP',' ')
-C
-C Create objects in directory /ECAP
-C
- NWW=0
- DO 20 I=1,100
- KEY(1)=I
- KEY(2)=1
- IF(I.GT.50)KEY(2)=2
- CALL MZBOOK(IXSTOR,LBANK,LEV,1,'LEV ',0,0,I,2,0)
- CALL RZOUT(IXSTOR,LBANK,KEY,ICYCLE,'W')
- NWW=NWW+I
- 20 CONTINUE
-C
- CALL RZLDIR(' ',' ')
- PRINT 2500,NWW
- 2500 FORMAT(' Number of data words written in /ECAP ',I7,/)
-C
- CALL TIMED(T3)
- PRINT 3000,T3
- 3000 FORMAT(' TIME FOR STEP 3= ',F10.5,' SECONDS')
-C
-C Read randomly objects from directory /ECAP
-C
- NWR=0
- DO 30 I=1,500
- KEY(1)=100*RNDM(I)+1
- KEY(2)=1
- IF(KEY(1).GT.50)KEY(2)=2
- CALL RZIN(IXSTOR,LEV,1,KEY,99,' ')
- IF(LEV.GT.0)NWR=NWR+IQ(LEV-1)
- CALL MZDROP(IXSTOR,LEV,' ')
- 30 CONTINUE
- PRINT 3500,NWR
- 3500 FORMAT(' Number of data words read from /ECAP ',I7,/)
-C
- CALL TIMED(T4)
- PRINT 4000,T4
- 4000 FORMAT(' TIME FOR STEP 4= ',F10.5,' SECONDS')
-C
- CALL RZEND('RZTEST')
-C
- STOP
- END
- SUBROUTINE QNEXT
- WRITE(*,*) ' DUMMY QNEXT REACHED'
- END
diff --git a/src/packlib/zebra/test/cq/Imakefile b/src/packlib/zebra/test/cq/Imakefile
deleted file mode 100644
index 955a4b8..0000000
--- a/src/packlib/zebra/test/cq/Imakefile
+++ /dev/null
@@ -1,4 +0,0 @@
-SRCS_F= cqcomp.F cqdata.F cqhead.F cqinit.F cqmust.F cqoct.F \ @@\
- cqpos.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/zebra/test/cq/cqcomp.F b/src/packlib/zebra/test/cq/cqcomp.F
deleted file mode 100644
index 7b21bc7..0000000
--- a/src/packlib/zebra/test/cq/cqcomp.F
+++ /dev/null
@@ -1,47 +0,0 @@
-*
-* $Id: cqcomp.F,v 1.1.1.1 1996/03/06 10:46:59 mclareni Exp $
-*
-* $Log: cqcomp.F,v $
-* Revision 1.1.1.1 1996/03/06 10:46:59 mclareni
-* Zebra
-*
-*
-#include "test_include/pilot.h"
- SUBROUTINE CQCOMP (IFAIL,NW,IDATA,ADATA)
-
-C- Execute comparison for 1 check-card, called from CQDATA
-
-#include "test_include/cqc.inc"
-#include "test_include/cqc1.inc"
-C-------------- End CDE --------------
- DIMENSION IDATA(9), ADATA(9), AMUST(9)
- EQUIVALENCE (AMUST(1),MUST(1))
-
-
- DO 29 I=1,NW
- IF (IDATA(I).EQ.MUST(I)) GO TO 29
- IF (MACHFL(I)) 29, 22, 21
- 21 IF (IQCOPT(7).EQ.0) GO TO 29
-#if !defined(CERNLIB_TOLER1)
- 22 IF (KODEFM(I).NE.2) GO TO 41
-#endif
-#if defined(CERNLIB_TOLER1)
- 22 IF (KODEFM(I).EQ.2) GO TO 24
- IF (IABS(IDATA(I)-MUST(I)).EQ.1) GO TO 29
- GO TO 41
- 24 CONTINUE
-#endif
- DIFF= ABS(ADATA(I)-AMUST(I))
- IF (AMUST(I).NE.0.0) GO TO 28
- IF (DIFF.LT.1.0E-10) GO TO 29
- GO TO 41
- 28 IF (ABS(DIFF/AMUST(I)).GE..0051) GO TO 41
- 29 CONTINUE
- IFAIL= 0
- RETURN
-
- 41 IFAIL= I
- RETURN
- END
-* ==================================================
-#include "zebra/qcardl.inc"
diff --git a/src/packlib/zebra/test/cq/cqdata.F b/src/packlib/zebra/test/cq/cqdata.F
deleted file mode 100644
index a930fe1..0000000
--- a/src/packlib/zebra/test/cq/cqdata.F
+++ /dev/null
@@ -1,106 +0,0 @@
-*
-* $Id: cqdata.F,v 1.1.1.1 1996/03/06 10:46:59 mclareni Exp $
-*
-* $Log: cqdata.F,v $
-* Revision 1.1.1.1 1996/03/06 10:46:59 mclareni
-* Zebra
-*
-*
-#include "test_include/pilot.h"
- SUBROUTINE CQDATA (IDATA,IDATAL)
-
-C- Check, punch, list a partial lot of check-data, user callled
-
-#include "zebra/zunit.inc"
-#include "test_include/cqc.inc"
-#include "test_include/cqc1.inc"
-C-------------- End CDE --------------
- DIMENSION IDATA(9),IDATAL(9)
- DIMENSION AM(100)
- EQUIVALENCE (AM(1),M(1))
-
-
- IF (IQCOPT(1).EQ.0) RETURN
-
-
- NDT = LOCF(IDATAL(2)) - LOCF(IDATA)
- IF (NDT.LT.1) GO TO 11
- IF (NDT.LT.1001) GO TO 13
- 11 WRITE (IQPRNT,9011) NDT
- CALL ZFATAL
-
- 13 IF (IQCOPT(8).EQ.0) GO TO 16
- ICHKSV = IQCHEK
- IQCHEK = 0
-
-
- 16 JE = 0
- 17 IF (JE.LT.NDT) GO TO 18
- IF (IQCOPT(8).NE.0) IQCHEK=ICHKSV
- RETURN
-
- 18 NW = MIN (NDT-JE,NENTR)
- JD = JE + 1
- JE = JE + NW
-
-C------- Comparing
-
- IOPTPR = IQCOPT(2)
- IF (IQCHEK.EQ.0) GO TO 41
- CALL CQMUST (NW)
- IF (IQCHEK.EQ.0) GO TO 41
- CALL CQCOMP (IFAIL,NW,IDATA(JD),IDATA(JD))
- IF (IFAIL.EQ.0) GO TO 41
- NQCF = NQCF + 1
- IOPTPR= 7
- IQCHEK= -7
-
-C------- Listing
-
- 41 IF (IOPTPR.EQ.0) GO TO 51
- IF (NAMEPR.NE.0) GO TO 42
- NAMEPR = 7
- WRITE (IQPRNT,9041) NAMEVC
- 42 CALL CQOCT (IDATA,JD,JE,NPRI)
- WRITE (IQPRNT,MFLP,ERR=44) JCRD, (M(J),J=1,NPRI)
- 44 CONTINUE
-
-C------- Punching
-
- 51 IF (IQCOPT(8).NE.0) GO TO 17
- IF (IQCOPT(3).EQ.0) GO TO 61
- WRITE (IQPNCH,MFPU,ERR=54) NAME,NUM,JCRD,(IDATA(J),J=JD,JE)
- 54 CONTINUE
-
-C------- Comparison Dump
-
- 61 IF (IQCHEK.GE.0) GO TO 69
- IQCHEK= 7
- CALL CQOCT (MUST,1,NW,NPRI)
- WRITE (IQPRNT,MFLP,ERR=64) JCRD, (M(J),J=1,NPRI)
- 64 CONTINUE
- WRITE (IQPRNT,9061)
- JF = JD + IFAIL-1
- WRITE (IQPRNT,9062) IFAIL,(IDATA(J), J=JF,JE)
- IF (IQCOPT(5).NE.0) CALL ZFATAL
- WRITE (IQPRNT,9071)
-
- 69 JCRD = JCRD + 1
- GO TO 17
-
- 9011 FORMAT (1X/' CQDATA. **** Illegal number of data-words =',I7)
- 9041 FORMAT (1X/' CQDATA. ',110A1)
- 9061 FORMAT (1X,' CQDATA. **** CHECK FAILURE above,',
- F' Have-vector printed before Must-vector.')
-#if !defined(CERNLIB_HEX)
- 9062 FORMAT (8H CQDATA.,8X,'Octal dump follows, starting at word',
- FI4/(10X,5O23))
-#endif
-#if defined(CERNLIB_HEX)
- 9062 FORMAT (8H CQDATA.,8X,'Hex dump follows, starting at word',
- FI4/(10X,5Z17))
-#endif
- 9071 FORMAT (1X)
- END
-* ==================================================
-#include "zebra/qcardl.inc"
diff --git a/src/packlib/zebra/test/cq/cqhead.F b/src/packlib/zebra/test/cq/cqhead.F
deleted file mode 100644
index 33a76e8..0000000
--- a/src/packlib/zebra/test/cq/cqhead.F
+++ /dev/null
@@ -1,233 +0,0 @@
-*
-* $Id: cqhead.F,v 1.1.1.1 1996/03/06 10:46:59 mclareni Exp $
-*
-* $Log: cqhead.F,v $
-* Revision 1.1.1.1 1996/03/06 10:46:59 mclareni
-* Zebra
-*
-*
-#include "test_include/pilot.h"
- SUBROUTINE CQHEAD (IFLAGH,IHEAD,IHEAD2,INFORM,NAMES)
-
-C- Starting a new lot of check-data, user called
-
-#include "zebra/zbcd.inc"
-#include "zebra/zunit.inc"
-#include "test_include/cqc.inc"
-#include "test_include/cqc1.inc"
-C-------------- End CDE --------------
-#if !defined(CERNLIB_F77TRARG)
- DIMENSION IHEAD(9), IHEAD2(9), INFORM(9), NAMES(9)
-#endif
-#if defined(CERNLIB_F77TRARG)
- CHARACTER*(*) IHEAD, IHEAD2, INFORM, NAMES
-#endif
- DIMENSION MLP(100), MPU(80)
- EQUIVALENCE (MLP(1),M(1)), (MPU(1),M(111))
-
- DIMENSION ISYMB(9)
- SAVE ISYMB
-#if defined(CERNLIB_QHOLL)
- DATA ISYMB /4HA , 4HF , 4HI , 4HO , 4HH ,
- + 4HL , 4HB , 4HJ , 4HP /
-#endif
-
-C- IQCOPT(1) Execution
-C- IQCOPT(2) Listing
-C- IQCOPT(3) Punching
-C- IQCOPT(4) Comparing
-C- IQCOPT(5) Stop on comparison failure
-C- IQCOPT(6) Maximum output
-C- IQCOPT(7) Check machine-dependent parameters also
-C- IQCOPT(8) Tempor. inhibition of checking,
-C- CQ is used for printing only
-
-C------- Digest header
-
-C- IFLAGH = -1 cancel
-C- 0 same lot continued, change format or naming
-C- 1 same lot cont., new sub-title, or format or naming
-C- 2 next lot, same name
-C- 3 new lot, new name
-
- IF (IQCOPT(1).EQ.0) RETURN
- IF (IFLAGH) 81, 19, 11
- 11 IF (IFLAGH-2) 12, 14, 13
- 12 IF (IQCOPT(2).EQ.0) GO TO 19
- GO TO 15
-
- 13 CALL UCTOH1 (IHEAD,M(11),4)
- CALL UBUNCH (M(11),M(1), 4)
-#if !defined(CERNLIB_QHOLL)
- CALL UCTOH ('A F I O H L B J P ',ISYMB,4,36)
-#endif
- IF (M(1).EQ.NAME) GO TO 14
- NAME = M(1)
- NUM = 0
- 14 NUM = NUM + 1
- M(1) = NAME
- M(2) = NUM
-
- 15 CALL UCTOH1 (IHEAD2,M(3),50)
- N = IUFIND (IQDOT,M,3,51)
- IF (IFLAGH.GE.2) GO TO 16
- WRITE (IQPRNT,9014) (M(J), J=3,N)
- GO TO 19
-
- 16 WRITE (IQPRNT,9015) (M(J), J=1,N)
- WRITE (IQPRNT,9016)
- IF (IQTYPE.NE.0 .AND. IQTYPE.NE.IQPRNT)
- + WRITE (IQTYPE,9015) (M(J),J=1,N)
- IF (IQCOPT(3).NE.0) WRITE (IQPNCH,9017) (M(J),J=1,N)
-
-C------ Position check-cards
-
- IQCHEK= IQCOPT(4)
- IF (IQCOPT(4).EQ.0) GO TO 18
- CALL CQPOS
- IF (IQCHEK.EQ.0) GO TO 18
- WRITE (IQPRNT,9018)
-
-C------- Digest format
-
- 18 JCRD = 1
- 19 CALL UCTOH1 (INFORM,MUST,7)
- IF (MUST(1).EQ.IQDOT) GO TO 41
- IF (MUST(1).EQ.IQMINS) GO TO 41
- NENTR= 0
- CALL UCTOH1 ('(5H CQD.,I7,3H- ', MLP(1), 17)
- CALL UCTOH1 ('(A4,2I3' ,MPU(1), 7)
- JLP = 18
- JPU = 8
-
- DO 38 J=1,7
- IT = IUCOMP (MUST(J),ISYMB,9)
- IF (IT.EQ.0) GO TO 39
- NENTR = NENTR + 1
- KODEFM(NENTR) = IT
- KODEFM(NENTR+1) = IT
- GO TO (21,22,23,24,25,26,27,28,29), IT
-
- 21 CALL UCTOH1 (',4X,A4,6X' ,MLP(JLP), 9)
- CALL UCTOH1 (',6X,A4' ,MPU(JPU), 6)
- JLP = JLP + 9
- JPU = JPU + 6
- GO TO 38
-
- 22 CALL UCTOH1 (',E14.3' ,MLP(JLP), 6)
- CALL UCTOH1 (',E10.3' ,MPU(JPU), 6)
- JLP = JLP + 6
- JPU = JPU + 6
- GO TO 38
-
- 23 CALL UCTOH1 (',4X,I10' ,MLP(JLP), 7)
- CALL UCTOH1 (',I10' ,MPU(JPU), 4)
- JLP = JLP + 7
- JPU = JPU + 4
- GO TO 38
-
- 24 CALL UCTOH1 (',4X,10I1' ,MLP(JLP), 8)
- CALL UCTOH1 (',I10' ,MPU(JPU), 4)
- JLP = JLP + 8
- JPU = JPU + 4
- GO TO 38
-
- 25 CALL UCTOH1 (',4X,2A4,2X' ,MLP(JLP),10)
- CALL UCTOH1 (',2X,2A4' ,MPU(JPU), 7)
- JLP = JLP + 10
- JPU = JPU + 7
- GO TO 37
-
- 26 CALL UCTOH1 (',I7,1X,A4,2X',MLP(JLP),12)
- CALL UCTOH1 (',I5,A4,1X' ,MPU(JPU), 9)
- JLP = JLP + 12
- JPU = JPU + 9
- KODEFM(NENTR) = 8
- GO TO 37
-
- 27 CALL UCTOH1 (',2(3X,A4)' ,MLP(JLP), 9)
- CALL UCTOH1 (',2(A4,1X)' ,MPU(JPU), 9)
- JLP = JLP + 9
- JPU = JPU + 9
- GO TO 37
-
- 28 CALL UCTOH1 (',2I7' ,MLP(JLP), 4)
- CALL UCTOH1 (',2I5' ,MPU(JPU), 4)
- JLP = JLP + 4
- JPU = JPU + 4
- GO TO 37
-
- 29 CALL UCTOH1 (',2(2X,5I1)' ,MLP(JLP), 10)
- CALL UCTOH1 (',2I5' ,MPU(JPU), 4)
- JLP = JLP + 10
- JPU = JPU + 4
-
- 37 NENTR = NENTR + 1
- 38 CONTINUE
-
- 39 MLP(JLP) = IQCLOS
- MPU(JPU) = IQCLOS
- CALL UH1TOC (MLP,MFLP,JLP)
- CALL UH1TOC (MPU,MFPU,JPU)
- IF (NENTR.EQ.0) CALL ZFATAM ('NENTR=0 IN CQHEAD.')
-
-C------- Digest naming
-
- 41 CALL UCTOH1 (NAMES,M(1),120)
- IF (M(1).EQ.IQDOT) GO TO 89
- IF (M(1).EQ.IQMINS) GO TO 89
- NAMEPR= 0
- CALL VZERO (MACHFL,14)
- CALL VBLANK (NAMEVC,104)
- LENM = IUFIND (IQDOT,M,1,120) - 1
- LPUT = 7
- LK = 0
- NH = 0
-
- 44 IF (NH.GE.NENTR) GO TO 89
- LT = LK
- 45 IF (LT.GE.LENM) GO TO 89
- LT = LT + 1
- IF (M(LT).EQ.IQBLAN) GO TO 45
- LK = IUFIND (IQCOMA,M,LT,LENM)
- NP = LK - LT
-
- NH = NH + 1
- JH = NH
- KOFM = KODEFM(NH)
- IF (KOFM-5) 52, 54, 53
- 52 IF (KOFM.EQ.1) GO TO 55
- LPUT = LPUT + 7
- 53 LPUT = LPUT + 7
- JP = MAX (1,LPUT-NP)
- NP = LPUT - JP
- GO TO 58
-
- 54 NH = NH + 1
- 55 JP = LPUT + 4
- LPUT = LPUT + 14
-
- 58 IF (NP.EQ.0) GO TO 44
- CALL UCOPY (M(LT),NAMEVC(JP),NP)
- IF (M(LT).EQ.IQSLAS) GO TO 62
- IF (M(LT).NE.IQSTAR) GO TO 44
- IFLM = 7
- GO TO 63
-
- 62 IFLM = -7
- 63 MACHFL(JH) = IFLM
- MACHFL(NH) = IFLM
- GO TO 44
-
- 81 NAME = 0
- 89 RETURN
-
-
- 9014 FORMAT (1X/10H CQHEAD. ,8X,4H--- ,60A1)
- 9015 FORMAT (1X/10H CQHEAD. ,A4,I3,5X,60A1)
- 9016 FORMAT (10X,7(10H----------))
- 9017 FORMAT (A4,I3,3H 0,70A1)
- 9018 FORMAT (' CQHEAD. Checked execution initiated.')
- END
-* ==================================================
-#include "zebra/qcardl.inc"
diff --git a/src/packlib/zebra/test/cq/cqinit.F b/src/packlib/zebra/test/cq/cqinit.F
deleted file mode 100644
index 9c1b35e..0000000
--- a/src/packlib/zebra/test/cq/cqinit.F
+++ /dev/null
@@ -1,89 +0,0 @@
-*
-* $Id: cqinit.F,v 1.1.1.1 1996/03/06 10:46:59 mclareni Exp $
-*
-* $Log: cqinit.F,v $
-* Revision 1.1.1.1 1996/03/06 10:46:59 mclareni
-* Zebra
-*
-*
-#include "test_include/pilot.h"
- SUBROUTINE CQINIT (IUNIT)
-
-C- Initialise CQ-package
-
-#include "zebra/zbcd.inc"
-#include "zebra/zunit.inc"
-#include "test_include/cqc.inc"
-#include "test_include/cqc1.inc"
-C-------------- End CDE --------------
-
-
- PARAMETER (MAXTAB = 100)
-
-
- IQCIN= IUNIT
- NQCF = 0
- NTAB = 0
- IQCOPT(8) = 0
- WRITE (IQPRNT,9000) IQCIN
- IF (IQCIN.EQ.0) RETURN
-
-C---- Tabulate check-card file
-
- NAML= 0
- REWIND IQCIN
- WRITE (IQPRNT,9020)
- 21 CONTINUE
- READ (IQCIN,8999,ERR=44,END=29) (M(J),J=1,10)
- JCRD= IUFORW (M,8,10)
- IF (JCRD.NE.0) GO TO 21
- NUM = IUFORW (M,5,7)
- IF (NUM.EQ.0) GO TO 21
- CALL UBUNCH (M,NAME,4)
- IF (NAME.EQ.IQBLAN) GO TO 21
- IF (NAME.NE.NAML) GO TO 31
- IF (NUM.NE.NUML+1) GO TO 31
- NUML= NUM
- GO TO 21
-
- 29 NAME= -1
-
-C---- New series, complete last entry
-
- 31 IF (NTAB.EQ.0) GO TO 41
- CALL SBYT (NUML,NUMTAB(NTAB),10,9)
- WRITE (IQPRNT,9031) NAML,NUMA,NUML
-
-C---- New series, open next entry
-
- 41 IF (NAME.EQ.-1) GO TO 46
- IF (NTAB.EQ.MAXTAB) GO TO 45
- NTAB= NTAB + 1
- NAMTAB(NTAB)= NAME
- NUMTAB(NTAB)= NUM
- NAML= NAME
- NUMA= NUM
- NUML= NUM
- GO TO 21
-
-C---- End reached
-
- 44 WRITE (IQPRNT,9044)
- GO TO 46
- 45 WRITE (IQPRNT,9045)
- 46 WRITE (IQPRNT,9046) NTAB
- REWIND IQCIN
- LTAB= 0
- NAML= 0
- RETURN
-
- 9000 FORMAT (1X/' CQINIT. Check-package starting, data on unit',I4)
- 8999 FORMAT (10A1)
- 9020 FORMAT (10X,'Check-card table building')
- 9031 FORMAT (10X,A4,I3,3H TO,I4)
- 9044 FORMAT (10X,'**** Read error on check-cards.')
- 9045 FORMAT (10X,30H**** TABLE-CAPACITY EXCEEDED.)
- 9046 FORMAT (10X,'Table built for',I5,' series.')
- END
-* ==================================================
-#include "zebra/qcardl.inc"
diff --git a/src/packlib/zebra/test/cq/cqmust.F b/src/packlib/zebra/test/cq/cqmust.F
deleted file mode 100644
index e7880e6..0000000
--- a/src/packlib/zebra/test/cq/cqmust.F
+++ /dev/null
@@ -1,89 +0,0 @@
-*
-* $Id: cqmust.F,v 1.1.1.1 1996/03/06 10:46:59 mclareni Exp $
-*
-* $Log: cqmust.F,v $
-* Revision 1.1.1.1 1996/03/06 10:46:59 mclareni
-* Zebra
-*
-*
-#include "test_include/pilot.h"
- SUBROUTINE CQMUST (NW)
-
-C- Called from CQDATA to read the next check-card (must-vector)
-
-
-#include "zebra/zbcd.inc"
-#include "zebra/zunit.inc"
-#include "test_include/cqc.inc"
-#include "test_include/cqc1.inc"
-#include "zebra/quest.inc"
-#include "zebra/zkrakc.inc"
-C-------------- End CDE --------------
-
-
- IF (JCRD.EQ.1) JCROFF=0
-
- READ (IQCIN,8001,ERR=76,END=77) NAMR,NUMR,JCRI,(IQHOLK(J),J=1,70)
- CALL IZBCDV (70)
-
- IF (NAMR.NE.NAME) GO TO 71
- IF (NUMR.NE.NUM) GO TO 71
- IF (JCRI.EQ.JCRD) GO TO 19
- IF (JCROFF.EQ.999) GO TO 19
- IF (JCRI.NE.999) GO TO 71
- JCROFF= 999
-
-C-- Krack into MUST(1/NW)
-
- 19 MFLAGK = 0
- JEND = 0
- JMU = 0
-
- 20 IF (JMU.GE.NW) RETURN
- JMU = JMU + 1
- JGO = JEND + 1
- JEND = JEND + 5
- KOFM = KODEFM(JMU)
-
- IF (KOFM-5) 22, 33, 23
- 22 IF (KOFM.EQ.1) GO TO 31
- JEND = JEND + 5
- 23 IF (KOFM.EQ.6) GO TO 37
- IF (KOFM.EQ.7) GO TO 37
- CALL ZKRAKN (MFLAGK,JGO,JEND,MUST(JMU))
- IF (IQUEST(1).EQ.2) GO TO 20
- MUST(JMU) = 0
- GO TO 20
-
- 31 JGO = JGO + 6
- GO TO 36
-
- 33 JGO = JGO + 2
- CALL UBUNCH (IQHOLK(JGO),MUST(JMU),4)
- JMU = JMU + 1
- JGO = JGO + 4
- 36 JEND = JEND + 5
- 37 CALL UBUNCH (IQHOLK(JGO),MUST(JMU),4)
- GO TO 20
-
-C---- Troubles
-
- 71 WRITE (IQPRNT,9071) NAMR,NUMR,JCRI
- GO TO 79
- 76 WRITE (IQPRNT,9076)
- GO TO 79
- 77 WRITE (IQPRNT,9077)
- 79 WRITE (IQPRNT,9079)
- IQCHEK= 0
- NQCF = NQCF + 1
- RETURN
-
- 8001 FORMAT (A4,2I3,70A1)
- 9071 FORMAT (1X/' CQMUST. **** Card out of sequence, card-id is '
- F,A4,2I3)
- 9076 FORMAT (1X/' CQMUST. **** Read error on check cards.')
- 9077 FORMAT (1X/' CQMUST. **** EOF out of sequence.')
- 9079 FORMAT ( ' CQMUST. **** Checking cancelled.')
- END
-* ==================================================
-#include "zebra/qcardl.inc"
diff --git a/src/packlib/zebra/test/cq/cqoct.F b/src/packlib/zebra/test/cq/cqoct.F
deleted file mode 100644
index 1c2827c..0000000
--- a/src/packlib/zebra/test/cq/cqoct.F
+++ /dev/null
@@ -1,55 +0,0 @@
-*
-* $Id: cqoct.F,v 1.1.1.1 1996/03/06 10:46:59 mclareni Exp $
-*
-* $Log: cqoct.F,v $
-* Revision 1.1.1.1 1996/03/06 10:46:59 mclareni
-* Zebra
-*
-*
-#include "test_include/pilot.h"
- SUBROUTINE CQOCT (IDATA,JD,JE,NPRI)
-
-C- Copy IDATA(JD/JE) to M for printing with conversion if necc.
-C- Codes O and P : convert to pseudo-octal (1-digit integers)
-
-#include "test_include/cqc1.inc"
-C-------------- End CDE --------------
- DIMENSION AM(100)
- EQUIVALENCE (AM(1),M(1))
- DIMENSION IDATA(9),MPACK(2),NOCT(9)
-#if defined(CERNLIB_QMVDS)
- SAVE MPACK, NOCT
-#endif
- DATA MPACK /3,10/
- DATA NOCT /-1,-1,0,10,-1,-1,-1,0,5/
-
-
- KD = 1
- KM = 1
- DO 18 JW=JD,JE
- I = KODEFM(KD)
- N = NOCT(I)
- IF (N) 16, 14, 12
- 12 CALL UPKBYT (IDATA(JW),1,M(101),N,MPACK)
-#if defined(CERNLIB_CQFLOAT)
- CALL VFLOAT (M(101),M(101),N)
-#endif
- CALL UCOPIV (M(101),M(KM),N)
- KM = KM + N
- GO TO 18
-
- 14 CONTINUE
-#if defined(CERNLIB_CQFLOAT)
- AM(KM) = IDATA(JW)
- KM = KM + 1
- GO TO 18
-#endif
-
- 16 M(KM) = IDATA(JW)
- KM = KM + 1
- 18 KD = KD + 1
- NPRI = KM - 1
- RETURN
- END
-* ==================================================
-#include "zebra/qcardl.inc"
diff --git a/src/packlib/zebra/test/cq/cqpos.F b/src/packlib/zebra/test/cq/cqpos.F
deleted file mode 100644
index 09b93f5..0000000
--- a/src/packlib/zebra/test/cq/cqpos.F
+++ /dev/null
@@ -1,80 +0,0 @@
-*
-* $Id: cqpos.F,v 1.1.1.1 1996/03/06 10:47:00 mclareni Exp $
-*
-* $Log: cqpos.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:00 mclareni
-* Zebra
-*
-*
-#include "test_include/pilot.h"
- SUBROUTINE CQPOS
-
-C- Called from CQHEAD to position check-card file for a new lot
-
-#include "zebra/zunit.inc"
-#include "test_include/cqc.inc"
-#include "test_include/cqc1.inc"
-C-------------- End CDE --------------
- DIMENSION MPACK(2)
-#if defined(CERNLIB_QMVDS)
- SAVE MPACK
-#endif
- DATA MPACK /9,3/
-
-
- IF (NTAB.EQ.0) GO TO 61
- IFLEOF= 0
- JTAB = LTAB
- IF (NAME.NE.NAML) GO TO 21
- IF (NUM.LT.NUML) GO TO 21
- IF (NUM.LE.NUME) GO TO 41
-
-C---- Locate table-entry for name/num
-
- 21 CONTINUE
- 22 JTAB= IUFIND (NAME,NAMTAB,JTAB+1,NTAB)
- IF (JTAB.LE.NTAB) GO TO 24
- IF (IFLEOF.NE.0) GO TO 61
- IFLEOF= 7
- JTAB = 0
- GO TO 22
-
- 24 CALL UPKBYT (NUMTAB(JTAB),1,NUMA,2,MPACK)
- IF (NUM.LT.NUMA) GO TO 22
- IF (NUM.GT.NUME) GO TO 22
- IF (JTAB.LE.LTAB) GO TO 48
-
-C---- Position to header card
-
- 41 LTAB = JTAB
- 42 CONTINUE
- READ (IQCIN,8999,ERR=59,END=47) (M(J),J=1,10)
- CALL UBUNCH (M,NAML,4)
- NUML= IUFORW (M,5,7)
- JCRD= IUFORW (M,8,10)
- IF (NUML.EQ.0) GO TO 42
- IF (JCRD.NE.0) GO TO 42
- IF (NAML.NE.NAME) GO TO 42
- IF (NUML.NE.NUM) GO TO 42
- RETURN
-
- 47 IF (IFLEOF.NE.0) GO TO 61
- 48 REWIND IQCIN
- WRITE (IQPRNT,9048)
- IFLEOF= 7
- GO TO 41
-
-C--- No check-cards
- 59 WRITE (IQPRNT,9059)
- 61 IQCHEK= 0
- NQCF = NQCF + 1
- WRITE (IQPRNT,9061)
- RETURN
-
- 8999 FORMAT (10A1)
- 9048 FORMAT (' CQPOS. **** Rewind when searching check-cards')
- 9059 FORMAT (' CQPOS. **** Read error on check-cards')
- 9061 FORMAT (' CQPOS. **** Checking cancelled.')
- END
-* ==================================================
-#include "zebra/qcardl.inc"
diff --git a/src/packlib/zebra/test/cqaux/Imakefile b/src/packlib/zebra/test/cqaux/Imakefile
deleted file mode 100644
index 5a7dc69..0000000
--- a/src/packlib/zebra/test/cqaux/Imakefile
+++ /dev/null
@@ -1,8 +0,0 @@
-SRCS_F= cqbkin.F cqhids.F cqlods.F
-
-#ifdef CERNLIB_HPUX
-SpecialFortranLibObjectRule(cqhids,cqhids,'-WF,-P',NullParameter)
-SpecialFortranLibObjectRule(cqlods,cqlods,'-WF,-P',NullParameter)
-#endif
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/zebra/test/cqaux/cqbkin.F b/src/packlib/zebra/test/cqaux/cqbkin.F
deleted file mode 100644
index 23a5d90..0000000
--- a/src/packlib/zebra/test/cqaux/cqbkin.F
+++ /dev/null
@@ -1,36 +0,0 @@
-*
-* $Id: cqbkin.F,v 1.1.1.1 1996/03/06 10:47:00 mclareni Exp $
-*
-* $Log: cqbkin.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:00 mclareni
-* Zebra
-*
-*
-#include "test_include/pilot.h"
- SUBROUTINE CQBKIN
-
-C- Initialize bank descriptors
-
-#include "zebra/zbcd.inc"
-#include "zebra/cqbkc.inc"
-#include "test_include/cqbkceq.inc"
-C-------------- End CDE --------------
-
-
- CALL VZERO (MMBANK,20)
- CALL UCTOH ('A1 A2 A3 A4 A5 A6 ', IDAV, 4, 24)
- CALL UCTOH ('B1 B2 B3 B4 ', IDBV, 4, 16)
- CALL UCTOH ('C4 C3 C2 C1 D1 ', IDCV, 4, 20)
- CALL UCTOH ('LOW1LOW2LOW3LOW4LOW5LOW6', IDLV, 4, 24)
-
- MMBKD(1) = IDCV(5)
- MMBKD(2) = 6
- MMBKD(3) = 0
- MMBKD(4) = 76
-
- CALL MZIOBK (MMBANK, 9, '*H *I -F')
- CALL MZIOBK (MMBKD, 9, '1I 2H 12I 35F 10D 10F / *S')
- RETURN
- END
-* ==================================================
-#include "zebra/qcardl.inc"
diff --git a/src/packlib/zebra/test/cqaux/cqhids.F b/src/packlib/zebra/test/cqaux/cqhids.F
deleted file mode 100644
index 37fa814..0000000
--- a/src/packlib/zebra/test/cqaux/cqhids.F
+++ /dev/null
@@ -1,61 +0,0 @@
-*
-* $Id: cqhids.F,v 1.1.1.1 1996/03/06 10:47:00 mclareni Exp $
-*
-* $Log: cqhids.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:00 mclareni
-* Zebra
-*
-*
-#include "test_include/pilot.h"
- SUBROUTINE CQHIDS (JMAKE,JFILL)
-
-C- Create complex high level test structure
-C- by repeated calls to CQLODS
-
-#include "test_include/testll.inc"
-#include "test_include/testdd.inc"
-#include "test_include/testiq.inc"
-#include "test_include/testee.inc"
-C-------------- End CDE --------------
-
-
- NINT = JMAKE
- M(10) = NINT
- NCODE = NINT / 4
- NSTR = NINT - 4*NCODE + 1
-
- CALL UPKBYT (NCODE,1,M(11),6,0)
- LQMAIN = 0
- LQUSER(7) = 0
-
- DO 69 JSTR=1,NSTR
-
-C-- Set a dead area
-
- IF (NSTR.NE.4) GO TO 32
- IF (JSTR.NE.3) GO TO 32
- IF (M(12)+M(13).NE.0) GO TO 32
- CALL ZSHUNT (IXSTOR,LQMAIN,LQUSER(7),1,1)
- CALL CQLODS (0,-1)
- CALL MZDROP (IXSTOR,LQMAIN,'L')
- CALL ZSHUNT (IXSTOR,LQUSER(7),LQMAIN,1,1)
- 32 CONTINUE
-
-C-- Create new set of banks
-
- JDIV = 2
- IF (JSTR.EQ.NSTR) JDIV=0
- CALL CQLODS (JDIV,JFILL)
-
-C-- Drop some banks according to code jmake
-
- DO 39 J=1,6
- IF (M(J+10).EQ.0) GO TO 39
- IF (JDIV.EQ.0) CALL MZDROP (IXSTOR,LLV(J),'.')
- CALL MZDROP (IXSTOR,LAV(J),'.')
- 39 CONTINUE
- 69 CONTINUE
- RETURN
- END
-* ==================================================
-#include "zebra/qcardl.inc"
diff --git a/src/packlib/zebra/test/cqaux/cqlods.F b/src/packlib/zebra/test/cqaux/cqlods.F
deleted file mode 100644
index b8a48c9..0000000
--- a/src/packlib/zebra/test/cqaux/cqlods.F
+++ /dev/null
@@ -1,167 +0,0 @@
-*
-* $Id: cqlods.F,v 1.1.1.1 1996/03/06 10:47:00 mclareni Exp $
-*
-* $Log: cqlods.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:00 mclareni
-* Zebra
-*
-*
-#include "test_include/pilot.h"
- SUBROUTINE CQLODS (JDIV,JFILL)
-
-C- Create standard low level test structure in division JDIV
-
-#include "zebra/zbcd.inc"
-#include "zebra/cqbkc.inc"
-#include "test_include/cqbkceq.inc"
-#include "test_include/testla.inc"
-#include "test_include/testll.inc"
-#include "test_include/testdd.inc"
-#include "test_include/testiq.inc"
-#include "test_include/testee.inc"
-C-------------- End CDE --------------
-
- DIMENSION FIXNUM(10)
-#if !defined(CERNLIB_QMVDS)
- DOUBLE PRECISION DPW(5)
-#endif
-#if defined(CERNLIB_QMVDS)
- DIMENSION DPW(10)
- SAVE FIXNUM
-#endif
- DATA FIXNUM /1., -1., 1.1E4, -1.1E4, 1.1E-4, -1.1E-4
- +, 1.1E20, -1.1E20, 1.1E-20, -1.1E-20 /
-
-C-- Lift chain A1 - A6
-
- MMBANK(4) = 46
- MMBANK(3) = 4
- MMBANK(2) = 9
- MMBANK(1) = IDAV(6)
- CALL MZLIFT (IXSTOR+JDIV, LA6, LQMAIN,1, MMBANK, 0)
-
- DO 22 J=1,4
- JW = 6-J
- MMBANK(4) = MMBANK(4) + 10
- MMBANK(1) = IDAV(JW)
- CALL MZLIFT (IXSTOR, LAV(JW), LQMAIN,1, MMBANK, 0)
- 22 CONTINUE
-
- MMBANK(1) = IDAV(1)
- CALL MZLIFT (IXSTOR+JDIV, LA1, LA2,1, MMBANK, 0)
-
-C-- Lift chain B1 - B4 at link -1 of A3
-
- MMBANK(4) = 46
-
- DO 24 J=1,4
- JW = 5-J
- MMBANK(1) = IDBV(JW)
- CALL MZLIFT (IXSTOR, LBV(JW), LA3, -1, MMBANK, 0)
- 24 CONTINUE
-
-C-- Lift chain C1 - C4 at link -2 of B2
-
- MMBANK(4) = MMBANK(4) + 10
- MMBANK(3) = 1
- MMBANK(1) = IDCV(1)
- CALL MZLIFT (IXSTOR,LC4, LB2,-2, MMBANK, 0)
-
- DO 26 J=2,4
- JW = 5-J
- MMBANK(1) = IDCV(J)
- CALL MZLIFT (IXSTOR+JDIV, LCV(JW), LCV(JW+1),0, MMBANK, 0)
- 26 CONTINUE
- L = LC4
- CALL ZTOPSY (IXSTOR,L)
- LQ(LC3-2) = LA1
-
-C-- Lift bank D1 (NS=0) at link -1 of C4
-
- CALL MZLIFT (IXSTOR,LD1,LC4,-1,MMBKD,0)
- NBANKS = 15
-
-C-- Lift chain LOW1 - LOW6 at link -2 of A3
-
- IF (JDIV.NE.0) GO TO 31
- NBANKS = 21
- MMBANK(2) = MMBANK(2) + 10
- MMBANK(3) = 4
- MMBANK(4) = 46
-
- MMBANK(1) = IDLV(1)
- CALL MZLIFT (IXSTOR+1, LL1, LA3, -2, MMBANK, 0)
-
- DO 28 J=2,6
- MMBANK(4) = MMBANK(4) + 10
- MMBANK(1) = IDLV(J)
- CALL MZLIFT (IXSTOR+1, LLV(J), LLV(J-1), 0, MMBANK, 0)
- 28 CONTINUE
-
-C---- Fill data parts
-
- 31 DO 49 JJ=1,NBANKS
- L = LV(JJ)
- ND = IQ(L-1)
- IQ(L-5) = JJ
- IQ(L+1) = 2
- IQ(L+2) = IDVV(JJ)
- IQ(L+3) = IQLETT(JJ)
- IQ(L+4) = MIN (ND,15) - 4
- IQ(L+5) = JJ
-
-C-- Dynamic sector *I, words (4), 5-15
-
- IF (JFILL.LT.0) GO TO 49
- N = MIN (ND,15)
- IF (N.LT.6) GO TO 49
- DO 34 J=6,N
- 34 IQ(L+J) = JJ + J - 21
-
-C-- Static sector 35F, words 16-50, fill floating integers
-
- IF (JFILL.EQ.0) GO TO 49
- N = MIN (ND,40)
- IF (N.LT.16) GO TO 49
- DO 36 J=16,N
- 36 Q(L+J) = FLOAT (JJ + J - 31)
-
-C-- Indefinite sector -F, filling words 61-70, fractional fl.
-
- IF (JFILL.EQ.1) GO TO 49
- N = MIN (ND,70)
- IF (N.LT.61) GO TO 49
- DO 37 J=61,N
- 37 Q(L+J) = FIXNUM(J-60) * Q(L+J-40)
-
- 49 CONTINUE
-
-C-- 4 Double prec. numbers in words 51-58 of bank D1 only
-
- IF (JFILL.LT.2) GO TO 55
- IF (IQ(LD1-1).LT.60) GO TO 55
- CALL VZERO (DPW,10)
-
-#if !defined(CERNLIB_QMVDS)
- DO 53 J=1,4
- DPW(J) = 1.
- DPW(J) = DPW(J) + 2.**(28+J)
- 53 DPW(J) = DPW(J) + 2.**(43+J)
- DPW(5) = 8448.
-#endif
-#if defined(CERNLIB_QMVDS)
- DO 53 J=1,8,2
- DPW(J) = 1.
- 53 DPW(J) = DPW(J) + 2.**(20+J)
- DPW(9) = 8448.
-#endif
- CALL UCOPY (DPW,IQ(LD1+51),10)
- 55 CONTINUE
-
-C-- Copy links to /LAREZ/
-
- CALL UCOPY (LA1,LAREZ,12)
- RETURN
- END
-* ==================================================
-#include "zebra/qcardl.inc"
diff --git a/src/packlib/zebra/test/cqhi/Imakefile b/src/packlib/zebra/test/cqhi/Imakefile
deleted file mode 100644
index 31d916d..0000000
--- a/src/packlib/zebra/test/cqhi/Imakefile
+++ /dev/null
@@ -1,11 +0,0 @@
-SRCS_F= cqdivi.F cqdlin.F cqdtab.F cqdwsp.F cqfixu.F cqlink.F \ @@\
- cqlrta.F cqmota.F cqstoc.F cqstom.F cqstor.F
-
-#ifdef CERNLIB_HPUX
-SpecialFortranLibObjectRule(cqdivi,cqdivi,'-WF,-P',NullParameter)
-SpecialFortranLibObjectRule(cqdlin,cqdlin,'-WF,-P',NullParameter)
-SpecialFortranLibObjectRule(cqdwsp,cqdwsp,'-WF,-P',NullParameter)
-SpecialFortranLibObjectRule(cqstor,cqstor,'-WF,-P',NullParameter)
-#endif
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/zebra/test/cqhi/cqdivi.F b/src/packlib/zebra/test/cqhi/cqdivi.F
deleted file mode 100644
index caecb7c..0000000
--- a/src/packlib/zebra/test/cqhi/cqdivi.F
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: cqdivi.F,v 1.1.1.1 1996/03/06 10:47:00 mclareni Exp $
-*
-* $Log: cqdivi.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:00 mclareni
-* Zebra
-*
-*
-#include "test_include/pilot.h"
- SUBROUTINE CQDIVI (NDIV)
-
-C- Create NDIV low and NDIV high divisions
-
-#include "test_include/testll.inc"
-#include "test_include/testdd.inc"
-#include "test_include/testiq.inc"
-C-------------- End CDE --------------
-
-
- CALL MZSDIV (0,-1)
- CALL MZDIV (IXSTOR,IXDV3,'TESTDIV3',1200,2000, '.')
- CALL MZDIV (IXSTOR,IXDV20,'TDIV20', 2000,4000, 'RP')
-
- IF (NDIV.LT.2) RETURN
- CALL MZSDIV (0,-1)
- CALL MZDIV (IXSTOR,IXDV19,'TDIV19', 1200,4000, 'L')
- CALL MZDIV (IXSTOR,IXDV4, 'TDIV04', 1200,4000, 'R')
-
- IF (NDIV.LT.3) RETURN
- CALL MZSDIV (0,-1)
- CALL MZDIV (IXSTOR,IXDV5, 'TDIV05', 1200,4000, '.')
- CALL MZDIV (IXSTOR,IXDV18,'TDIV18', 1200,4000, 'RL')
- RETURN
- END
diff --git a/src/packlib/zebra/test/cqhi/cqdlin.F b/src/packlib/zebra/test/cqhi/cqdlin.F
deleted file mode 100644
index 7a305a2..0000000
--- a/src/packlib/zebra/test/cqhi/cqdlin.F
+++ /dev/null
@@ -1,51 +0,0 @@
-*
-* $Id: cqdlin.F,v 1.1.1.1 1996/03/06 10:47:00 mclareni Exp $
-*
-* $Log: cqdlin.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:00 mclareni
-* Zebra
-*
-*
-#include "test_include/pilot.h"
- SUBROUTINE CQDLIN (LGO,JW,NW,MODE)
-
-C- Write banks of the linear structure starting at LGO
-C- with data words starting at word JW, NW words
-C- MODE = 0 Floating point data
-C- 1 Integer
-C- 2 Hollerith
-
-#include "test_include/testll.inc"
-#include "test_include/testdd.inc"
-#include "test_include/testiq.inc"
-C-------------- End CDE --------------
-
-
- CALL CQHEAD (1,'-','DUMP LINEAR STRUCTURE -----.'
- +, 'JABBBBB','KADR,LADR,NAME,DATA.')
-
- IF (MODE-1) 24, 26, 29
-
- 24 CALL CQHEAD (0,'-','-','JAFFFFF','-')
- GO TO 29
-
- 26 CALL CQHEAD (0,'-','-','JAJJJJJ','-')
- 29 LAST = NW + 3
-
- L = LGO
- 32 IF (L.EQ.0) RETURN
-
- M(1) = LQ(L+2)
- M(2) = L
- M(3) = IQ(L-4)
-
- DO 34 J=1,NW
- 34 M(J+3) = IQ(L+JW+J-1)
-
- CALL CQDATA (M(1),M(LAST))
-
- L = LQ(L)
- GO TO 32
- END
-* ==================================================
-#include "zebra/qcardl.inc"
diff --git a/src/packlib/zebra/test/cqhi/cqdtab.F b/src/packlib/zebra/test/cqhi/cqdtab.F
deleted file mode 100644
index 7df5f8c..0000000
--- a/src/packlib/zebra/test/cqhi/cqdtab.F
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: cqdtab.F,v 1.1.1.1 1996/03/06 10:47:00 mclareni Exp $
-*
-* $Log: cqdtab.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:00 mclareni
-* Zebra
-*
-*
-#include "test_include/pilot.h"
- SUBROUTINE CQDTAB (IFLAG)
-
-C- Print memory tables for debug printing only
-
-
-
- CALL CQMOTA (-7, IFLAG)
- CALL CQLRTA (-7, IFLAG)
- RETURN
- END
-* ==================================================
-#include "zebra/qcardl.inc"
diff --git a/src/packlib/zebra/test/cqhi/cqdwsp.F b/src/packlib/zebra/test/cqhi/cqdwsp.F
deleted file mode 100644
index 408fe53..0000000
--- a/src/packlib/zebra/test/cqhi/cqdwsp.F
+++ /dev/null
@@ -1,63 +0,0 @@
-*
-* $Id: cqdwsp.F,v 1.1.1.1 1996/03/06 10:47:00 mclareni Exp $
-*
-* $Log: cqdwsp.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:00 mclareni
-* Zebra
-*
-*
-#include "test_include/pilot.h"
- SUBROUTINE CQDWSP (NOCHK)
-
-C- Write working space links
-
-#include "test_include/cqc.inc"
-#include "test_include/testla.inc"
-#include "test_include/testll.inc"
-#include "test_include/testdd.inc"
-#include "test_include/testiq.inc"
-#include "test_include/testee.inc"
-C-------------- End CDE --------------
-
-
- IF (NOCHK.LT.0) IQCOPT(8)=-7
-
- CALL CQHEAD (1, '.', 'DUMP WSP LINKS -----.', 'LLLLLLL',
- + 'LQUSER.')
-
- CALL CQLINK (0, LQUSER,7)
-
- CALL CQHEAD (0, '-', '-', '-',
- + 'LQMAIN,,LA1,,LA2,,LA3,,LA4,,LA5,,LA6.')
-
- CALL CQLINK (0, LQMAIN,7)
-
- CALL CQHEAD (0, '-', '-', '-',
- + 'LB1,,LB2,,LB3,,LB4.')
-
- CALL CQLINK (0, LB1,4)
-
- CALL CQHEAD (0, '-', '-', '-',
- + 'LC1,,LC2,,LC3,,LC4,,LD1.')
-
- CALL CQLINK (0, LC1,5)
-
- CALL CQHEAD (0, '-', '-', '-',
- + 'LOW1,,LOW2,,LOW3,,LOW4,,LOW5,,LOW6.')
-
- CALL CQLINK (0, LL1,6)
-
- CALL CQHEAD (0, '-', '-', '-',
- + 'LAREN(1),,(2),,(3),,(4),,(5),,(6).')
-
- CALL CQLINK (0, LAREX,6)
- CALL CQLINK (0, LAREX(7),6)
- CALL CQLINK (0, LAREY,6)
- CALL CQLINK (0, LAREY(7),6)
- CALL CQLINK (0, LAREZ,6)
- CALL CQLINK (0, LAREZ(7),6)
- IF (NOCHK.NE.0) IQCOPT(8) = 0
- RETURN
- END
-* ==================================================
-#include "zebra/qcardl.inc"
diff --git a/src/packlib/zebra/test/cqhi/cqfixu.F b/src/packlib/zebra/test/cqhi/cqfixu.F
deleted file mode 100644
index 77433e2..0000000
--- a/src/packlib/zebra/test/cqhi/cqfixu.F
+++ /dev/null
@@ -1,51 +0,0 @@
-*
-* $Id: cqfixu.F,v 1.1.1.1 1996/03/06 10:47:00 mclareni Exp $
-*
-* $Log: cqfixu.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:00 mclareni
-* Zebra
-*
-*
-#include "test_include/pilot.h"
- SUBROUTINE CQFIXU (MSWIT, IPARAP)
-
-C- Fix-up operations for the standard test run
-
-#include "test_include/cqc.inc"
-#include "zebra/mqsys.inc"
-C-------------- End CDE --------------
- DIMENSION IPARAP(12)
-
-#include "zebra/q_jbit.inc"
-
-
- IPARA = IPARAP(1)
-
- GO TO (11,21,31), MSWIT
-
-C-- Place division 2 to fixed adr
-
- 11 LQEND(KQT+2) = IPARA
- LQSTA(KQT+2) = LQEND(KQT+2)
- RETURN
-
-C-- Calc. gap available to division
-
- 21 JDV = IPARA
- MODE = JBIT (IQMODE(KQT+JDV),1)
- IF (MODE.NE.0) GO TO 24
- JNX = JDV + 1
- IF (JDV.EQ.JQDVLL) JNX=JQDVSY
- GO TO 27
-
- 24 JNX = JDV
- JDV = JDV - 1
- IF (JNX.EQ.JQDVSY) JDV=JQDVLL
- 27 IPARAP(1) = LQSTA(KQT+JNX) - LQEND(KQT+JDV)
- RETURN
-
- 31 CONTINUE
- RETURN
- END
-* ==================================================
-#include "zebra/qcardl.inc"
diff --git a/src/packlib/zebra/test/cqhi/cqlink.F b/src/packlib/zebra/test/cqhi/cqlink.F
deleted file mode 100644
index 625fd89..0000000
--- a/src/packlib/zebra/test/cqhi/cqlink.F
+++ /dev/null
@@ -1,48 +0,0 @@
-*
-* $Id: cqlink.F,v 1.1.1.1 1996/03/06 10:47:00 mclareni Exp $
-*
-* $Log: cqlink.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:00 mclareni
-* Zebra
-*
-*
-#include "test_include/pilot.h"
- SUBROUTINE CQLINK (NOCHK,LINKV,NL)
-
-C- Dump vector of links whith names of pointed banks
-C- Requires format 'LLLLLLL' set to CQHEAD
-
-#include "test_include/cqc.inc"
-#include "zebra/zbcd.inc"
-#include "zebra/mqsys.inc"
-#include "zebra/mzcn.inc"
-C-------------- End CDE --------------
- DIMENSION LINKV(7), IV(14)
-
-
- IF (NOCHK.LT.0) IQCOPT(8)=-7
-
- N = 0
- J = 1
-
- 21 LINK = LINKV(J)
-
- IV(N+1) = LINK
- IF (LINK.EQ.0) GO TO 24
- CALL MZCHLS (-7,LINK)
- IF (IQFOUL.NE.0) GO TO 24
- IV(N+2) = IQ(KQS+LINK-4)
- GO TO 28
-
- 24 IV(N+2) = IQBLAN
- 28 N = N + 2
- J = J + 1
- IF (J.GE.8) GO TO 39
- IF (J.LE.NL) GO TO 21
-
- 39 CALL CQDATA (IV(1),IV(N))
- IF (NOCHK.NE.0) IQCOPT(8) = 0
- RETURN
- END
-* ==================================================
-#include "zebra/qcardl.inc"
diff --git a/src/packlib/zebra/test/cqhi/cqlrta.F b/src/packlib/zebra/test/cqhi/cqlrta.F
deleted file mode 100644
index 509c411..0000000
--- a/src/packlib/zebra/test/cqhi/cqlrta.F
+++ /dev/null
@@ -1,80 +0,0 @@
-*
-* $Id: cqlrta.F,v 1.1.1.1 1996/03/06 10:47:00 mclareni Exp $
-*
-* $Log: cqlrta.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:00 mclareni
-* Zebra
-*
-*
-#include "test_include/pilot.h"
- SUBROUTINE CQLRTA (NOCHK,IFLAG)
-
-C- Dump link relocation table
-
-#include "test_include/cqc.inc"
-#include "zebra/mqsys.inc"
-#include "zebra/mzct.inc"
-C-------------- End CDE --------------
- DIMENSION IV(12)
-
-
- IF (NOCHK.LT.0) IQCOPT(8)=-7
-
- CALL CQHEAD (1, '.', 'DUMP LINK RELOCATION TABLE -----.'
- +, 'IIIIJJJ'
- +, '/LQRTA,/LQTA,/LQTE,/LQRTE,JQGAPR,LFIXLO,LFIXHI.')
-
- IV(1) = LQRTA
- IV(2) = LQTA
- IV(3) = LQTE
- IV(4) = LQRTE
- IV(5) = JQGAPR
- IV(6) = LQ(LQTA-1)
- IV(7) = LQ(LQTE)
- CALL CQDATA (IV,IV(7))
-
- IF (LQRTA.GE.LQRTE) GO TO 99
-
- CALL CQHEAD (0, '.', '.', 'IJJIJJ. '
- +, 'LOC,START,END,RELOC,FLAG,LOC,START,END,RELOC,FLAG.')
-
- N = 10
- L = LQTA
-
- 31 IV(1) = L - LQRTA
- IV(2) = LQ(L)
- IV(3) = LQ(L+1)
- IV(4) = LQ(L+2)
- IV(5) = LQ(L+3)
- IF (L+4.GE.LQTE) GO TO 34
-
- IV(6) = IV(1) + 4
- IV(7) = LQ(L+4)
- IV(8) = LQ(L+5)
- IV(9) = LQ(L+6)
- IV(10)= LQ(L+7)
- L = L + 8
- IF (L.GE.LQTE) GO TO 35
- CALL CQDATA (IV,IV(10))
- GO TO 31
-
- 34 N = 5
- 35 CALL CQDATA (IV,IV(N))
-
- IF (IFLAG.LT.0) GO TO 99
-
- CALL CQHEAD (1, '.', 'LAST MZTABC PARAMETERS.', 'IIJJJJJ'
- +, '/LQTC1,/LQTC2,LQMTC1,LQMTC2,NQFRTC,NQLIVE.')
-
- IV(1) = LQTC1
- IV(2) = LQTC2
- IV(3) = LQMTC1
- IV(4) = LQMTC2
- IV(5) = NQFRTC
- IV(6) = NQLIVE
- CALL CQDATA (IV,IV(6))
- 99 IF (NOCHK.NE.0) IQCOPT(8) = 0
- RETURN
- END
-* ==================================================
-#include "zebra/qcardl.inc"
diff --git a/src/packlib/zebra/test/cqhi/cqmota.F b/src/packlib/zebra/test/cqhi/cqmota.F
deleted file mode 100644
index 840b09f..0000000
--- a/src/packlib/zebra/test/cqhi/cqmota.F
+++ /dev/null
@@ -1,68 +0,0 @@
-*
-* $Id: cqmota.F,v 1.1.1.1 1996/03/06 10:47:00 mclareni Exp $
-*
-* $Log: cqmota.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:00 mclareni
-* Zebra
-*
-*
-#include "test_include/pilot.h"
- SUBROUTINE CQMOTA (NOCHK,IFLAG)
-
-C- Dump memory occupation table
-
-#include "test_include/cqc.inc"
-#include "zebra/mqsys.inc"
-#include "zebra/mzct.inc"
-C-------------- End CDE --------------
- DIMENSION IV(12)
-
-
- IF (NOCHK.LT.0) IQCOPT(8)=-7
-
- CALL CQHEAD (1,'.', 'DUMP MEMORY OCCUPATION TABLE -----.'
- +, 'OOOJJJJ'
- +, 'MQDVGA,MQDVWI,MQDVAC,JQSTMV,JQDVM1,JQDVM2,NQDVMV.')
-
- IV(1) = MQDVGA
- IV(2) = MQDVWI
- IV(3) = MQDVAC
- IV(4) = JQSTMV
- IV(5) = JQDVM1
- IV(6) = JQDVM2
- IV(7) = NQDVMV
- CALL CQDATA (IV,IV(7))
-
- CALL CQHEAD (0, '.', '.', 'JIIIIII'
- +, 'IQTNMV,JQGAPM,/LQWKTB,NQWKTB,/LQMTA,/LQMTE.')
-
- IV(1) = IQTNMV
- IV(2) = JQGAPM
- IV(3) = LQWKTB
- IV(4) = NQWKTB
- IV(5) = LQMTA
- IV(6) = LQMTE
- CALL CQDATA (IV,IV(6))
-
- CALL CQHEAD (0, '.', '.', 'JJJJJJJ'
- +, 'ADR,DIV,ACTIV,SHIFT,FBANK,LBANK,FENTRY,LENTRY,FREE.')
-
- LMT = LQMTA
- 21 IV(1) = LMT - LQMTA
- IV(2) = LQ(LMT)
- IV(3) = LQ(LMT+1)
- IV(4) = LQ(LMT+2)
- IV(5) = LQ(LMT+3)
- IV(6) = LQ(LMT+4)
- IV(7) = LQ(LMT+5)
- IV(8) = LQ(LMT+6)
- IV(9) = LQ(LMT+7)
- CALL CQDATA (IV(1),IV(9))
-
- LMT = LMT + 8
- IF (LMT.LT.LQMTE) GO TO 21
- IF (NOCHK.NE.0) IQCOPT(8) = 0
- RETURN
- END
-* ==================================================
-#include "zebra/qcardl.inc"
diff --git a/src/packlib/zebra/test/cqhi/cqstoc.F b/src/packlib/zebra/test/cqhi/cqstoc.F
deleted file mode 100644
index 3c8e4ef..0000000
--- a/src/packlib/zebra/test/cqhi/cqstoc.F
+++ /dev/null
@@ -1,64 +0,0 @@
-*
-* $Id: cqstoc.F,v 1.1.1.1 1996/03/06 10:47:00 mclareni Exp $
-*
-* $Log: cqstoc.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:00 mclareni
-* Zebra
-*
-*
-#include "test_include/pilot.h"
- SUBROUTINE CQSTOC (NOCHK)
-
-C- Dump divisional occupation of the current store
-
-#include "test_include/cqc.inc"
-#include "zebra/mqsys.inc"
-C-------------- End CDE --------------
- DIMENSION IV(12)
-
-
- IF (NOCHK.LT.0) IQCOPT(8)=-7
-
- CALL UCOPY (NQPNAM(KQT+1),NQSNAM,5)
-
- CALL CQHEAD (1,'.','CURRENT STORE PARAMETERS -----.','HJIIIII'
- +, 'NAME,JQSTOR,/JQDIVI,/KQT,/KQS,/LQSTOR.')
-
- IV(1) = NQSNAM(1)
- IV(2) = NQSNAM(2)
- IV(3) = JQSTOR
- IV(4) = JQDIVI
- IV(5) = KQT
- IV(6) = KQS
- IV(7) = LQSTOR
- CALL CQDATA (IV(1),IV(7))
-
- CALL CQHEAD (0, '.', '.', 'JJJJJJJ'
- +, 'NQFEND,NQSTRU,NQREF,NQLINK,*NQMINR,*LQ2END,JQDVLL,JQDVSY.')
-
- CALL CQDATA (NQFEND,JQDVSY)
-
- CALL CQHEAD (1, '.', 'DIVISION OCCUPANCY.', 'JJOOOOH'
- +, 'JDIV,LQSTA,LQEND,NQDMAX,IQMODE,IQKIND,IQRTO,IQRNO,NAME.')
-
- JDV = 0
- 21 JDV = JDV + 1
- IV(1) = JDV
- IV(2) = LQSTA(KQT+JDV)
- IV(3) = LQEND(KQT+JDV)
- IV(4) = NQDMAX(KQT+JDV)
- IV(5) = IQMODE(KQT+JDV)
- IV(6) = IQKIND(KQT+JDV)
- IV(7) = IQRTO(KQT+JDV)
- IV(8) = IQRNO(KQT+JDV)
- IV(9) = IQDN1(KQT+JDV)
- IV(10)= IQDN2(KQT+JDV)
- CALL CQDATA (IV(1),IV(10))
-
- IF (JDV.EQ.JQDVLL) JDV=JQDVSY-1
- IF (JDV.LT.20) GO TO 21
- IF (NOCHK.NE.0) IQCOPT(8) = 0
- RETURN
- END
-* ==================================================
-#include "zebra/qcardl.inc"
diff --git a/src/packlib/zebra/test/cqhi/cqstom.F b/src/packlib/zebra/test/cqhi/cqstom.F
deleted file mode 100644
index 647d283..0000000
--- a/src/packlib/zebra/test/cqhi/cqstom.F
+++ /dev/null
@@ -1,114 +0,0 @@
-*
-* $Id: cqstom.F,v 1.2 1996/04/18 16:14:26 mclareni Exp $
-*
-* $Log: cqstom.F,v $
-* Revision 1.2 1996/04/18 16:14:26 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:00 mclareni
-* Zebra
-*
-*
-#include "test_include/pilot.h"
- SUBROUTINE CQSTOM (NOCHK)
-
-C- Map the current store
-
-#include "test_include/cqc.inc"
-#include "zebra/zbcd.inc"
-#include "zebra/mzcn.inc"
-#include "zebra/mqsys.inc"
-C-------------- End CDE --------------
- DIMENSION IV(16)
- EQUIVALENCE (LS,IQLS), (LNX,IQNX)
-
-#include "zebra/q_jbyt.inc"
-
-
- IF (NOCHK.LT.0) IQCOPT(8)=-7
-
- CALL UCOPY (NQPNAM(KQT+1),NQSNAM,5)
-
- CALL CQHEAD (1, '.', 'MAP CURRENT STORE -----.', 'HJIIIII'
- +, 'NAME,JQSTOR,/JQDIVI,/KQT,/KQS,/LQSTOR.')
-
- IV(1) = NQSNAM(1)
- IV(2) = NQSNAM(2)
- IV(3) = JQSTOR
- IV(4) = JQDIVI
- IV(5) = KQT
- IV(6) = KQS
- IV(7) = LQSTOR
- CALL CQDATA (IV(1),IV(7))
-
- CALL CQHEAD (0, '.', '.', 'JJJJJJJ'
- +, 'NQFEND,NQSTRU,NQREF,NQLINK,*NQMINR,*LQ2END,JQDVLL,JQDVSY.')
-
- CALL CQDATA (NQFEND,JQDVSY)
-
- JDV = 0
- 21 JDV = JDV + 1
-
- CALL CQHEAD (1, '.', 'NEXT DIVISION.', 'JJOOOOH'
- +, 'JDIV,LQSTA,LQEND,NQDMAX,IQMODE,IQKIND,IQRTO,IQRNO,NAME.')
-
- IV(1) = JDV
- IV(2) = LQSTA(KQT+JDV)
- IV(3) = LQEND(KQT+JDV)
- IV(4) = NQDMAX(KQT+JDV)
- IV(5) = IQMODE(KQT+JDV)
- IV(6) = IQKIND(KQT+JDV)
- IV(7) = IQRTO(KQT+JDV)
- IV(8) = IQRNO(KQT+JDV)
- IV(9) = IQDN1(KQT+JDV)
- IV(10)= IQDN2(KQT+JDV)
- CALL CQDATA (IV(1),IV(10))
-
- LSTA = IV(2)
- LEND = IV(3)
- IF (LSTA.GE.LEND) GO TO 69
-
- CALL CQHEAD (0, '.', '.', 'PJJBJJJ'
- +, 'STATS,STATU,KADR,LUP,LS,IDN,IDH,NEXT,NL,NS,ND,LINK0,LINK1,
- +LINK2.')
-
- LNX = LSTA
- 31 LN = LNX
- CALL MZCHLN (-7,LN)
- IF (IQFOUL.NE.0) GO TO 91
- IF (IQND.LT.0) GO TO 39
-
- IV(1) = JBYT (IQ(KQS+LS),IQDROP,8)
- IV(2) = JBYT (IQ(KQS+LS),1,15)
- IV(3) = LQ(KQS+LS+2)
- IV(4) = LQ(KQS+LS+1)
- IV(5) = LS
- IV(6) = IQ(KQS+LS-5)
- IV(7) = IQ(KQS+LS-4)
-
- IV(8) = IQBLAN
- L = LQ(KQS+LS)
- IF (L.EQ.0) GO TO 33
- IV(8) = IQ(KQS+L-4)
-
- 33 IV(9) = IQNL
- IV(10) = IQNS
- IV(11) = IQND
- IV(12) = LQ(KQS+LS)
- IV(13) = LQ(KQS+LS-1)
- IV(14) = LQ(KQS+LS-2)
- N = 12 + MIN(IQNL,2)
- CALL CQDATA (IV(1),IV(N))
- 39 IF (LNX.LT.LEND) GO TO 31
- 69 IF (JDV.EQ.JQDVLL) JDV=JQDVSY-1
- IF (JDV.LT.20) GO TO 21
- IF (NOCHK.NE.0) IQCOPT(8) = 0
- RETURN
-
-C---- Bank chaining clobbered
-
- 91 CONTINUE
- CALL ZFATAM ('CQSTOM, BANK CHAINING CLOBBERED.')
- END
-* ==================================================
-#include "zebra/qcardl.inc"
diff --git a/src/packlib/zebra/test/cqhi/cqstor.F b/src/packlib/zebra/test/cqhi/cqstor.F
deleted file mode 100644
index bec4d18..0000000
--- a/src/packlib/zebra/test/cqhi/cqstor.F
+++ /dev/null
@@ -1,49 +0,0 @@
-*
-* $Id: cqstor.F,v 1.1.1.1 1996/03/06 10:47:00 mclareni Exp $
-*
-* $Log: cqstor.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:00 mclareni
-* Zebra
-*
-*
-#include "test_include/pilot.h"
- SUBROUTINE CQSTOR (JSTOFL)
-
-C- Create Zebra store for the test-run
-C- JSTOFL = 0 : normally, just create it
-C- -1 : get rid of the store with the highest number
-C- and create it again from scratch
-
-#include "zebra/mzbits.inc"
-#include "zebra/quest.inc"
-#include "zebra/mzca.inc"
-#include "test_include/testla.inc"
-#include "test_include/testll.inc"
-#include "test_include/testdd.inc"
-#include "test_include/testiq.inc"
-C-------------- End CDE --------------
-
-
-C---- Initialize the test store
-
- IF (JSTOFL.NE.0) NQSTOR = NQSTOR - 1
- IF (NQSTOR.LT.0) THEN
- NDATA = 19997
- ELSE
- NDATA = 20057
- ENDIF
-
- CALL MZSTOR (IXSTOR,'//', '.', FENCE
- +, LQ,LA1,LX1,LQ(6000),IQ(NDATA))
- CALL CQFIXU (1,17000)
-
- CALL MZLOGL (IXSTOR,1)
-
- CALL MZWORK (IXSTOR,M,DLAST,0)
- CALL VZERO (LQUSER,150)
-
- CALL MZLINK (IXSTOR,'/LAREX/', LAREX, LAREX(12),LAREX)
- CALL MZLINK (IXSTOR,'/LAREY/', LAREY, LAREY, LAREY(12))
- CALL MZLINT (IXSTOR,'/LAREZ/',IFLREZ, LAREZ(7), LAREZ(12))
- RETURN
- END
diff --git a/src/packlib/zebra/test/fqtend/Imakefile b/src/packlib/zebra/test/fqtend/Imakefile
deleted file mode 100644
index 19a852a..0000000
--- a/src/packlib/zebra/test/fqtend/Imakefile
+++ /dev/null
@@ -1,3 +0,0 @@
-SRCS_F= zend.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/zebra/test/fqtend/zend.F b/src/packlib/zebra/test/fqtend/zend.F
deleted file mode 100644
index 2ac0fb4..0000000
--- a/src/packlib/zebra/test/fqtend/zend.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: zend.F,v 1.1.1.1 1996/03/06 10:47:02 mclareni Exp $
-*
-* $Log: zend.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:02 mclareni
-* Zebra
-*
-*
- SUBROUTINE ZEND
-
-#undef CERNLIB_ZEBRA_ZSTATE_INC
-#include "zebra/zstate.inc"
-#include "zebra/zunit.inc"
-C-------------- END CDE --------------
-
-
- CALL ZPHASE (-1)
- CALL FZENDI (0,'TX')
- CALL FZENDO (0,'TX')
- CALL MZEND
-
- IF (NQERR.EQ.0) GO TO 99
- CALL ABEND
- 99 CONTINUE
- STOP
- END
-* ==================================================
-#include "zebra/qcardl.inc"
diff --git a/src/packlib/zebra/test/fqtest/Imakefile b/src/packlib/zebra/test/fqtest/Imakefile
deleted file mode 100644
index e85eae5..0000000
--- a/src/packlib/zebra/test/fqtest/Imakefile
+++ /dev/null
@@ -1,21 +0,0 @@
-SRCS_F= fqback.F fqbkco.F fqbkfa.F fqbkfi.F fqbkra.F fqcget.F \ @@\
- fqcput.F fqmake.F fqmget.F fqmput.F fqread.F fqrset.F fqtest.F \ @@\
- fqtinf.F fqunus.F qcomds.F
-
-#ifdef CERNLIB_HPUX
-SpecialFortranLibObjectRule(fqback,fqback,'-WF,-P',NullParameter)
-SpecialFortranLibObjectRule(fqbkco,fqbkco,'-WF,-P',NullParameter)
-SpecialFortranLibObjectRule(fqbkfa,fqbkfa,'-WF,-P',NullParameter)
-SpecialFortranLibObjectRule(fqbkfi,fqbkfi,'-WF,-P',NullParameter)
-SpecialFortranLibObjectRule(fqbkra,fqbkra,'-WF,-P',NullParameter)
-SpecialFortranLibObjectRule(fqmake,fqmake,'-WF,-P',NullParameter)
-SpecialFortranLibObjectRule(fqtest,fqtest,'-WF,-P',NullParameter)
-SpecialFortranLibObjectRule(fqtinf,fqtinf,'-WF,-P',NullParameter)
-SpecialFortranLibObjectRule(qcomds,qcomds,'-WF,-P',NullParameter)
-#endif
-
-#if defined(CERNLIB_QMIRIX64)
-EXTRA_INCLUDES=-I$(CVSCOSRC)/packlib/zebra/test/fqtest
-#endif
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/zebra/test/fqtest/fqback.F b/src/packlib/zebra/test/fqtest/fqback.F
deleted file mode 100644
index 229aa74..0000000
--- a/src/packlib/zebra/test/fqtest/fqback.F
+++ /dev/null
@@ -1,146 +0,0 @@
-*
-* $Id: fqback.F,v 1.2 1996/04/18 16:14:29 mclareni Exp $
-*
-* $Log: fqback.F,v $
-* Revision 1.2 1996/04/18 16:14:29 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:01 mclareni
-* Zebra
-*
-*
-#include "test_include/pilot.h"
- SUBROUTINE FQBACK
-
-C- Sequential read-back
-
-#include "zebra/zstate.inc"
-#include "zebra/zunit.inc"
-#include "zebra/mzbits.inc"
-#include "zebra/quest.inc"
-C! +CDE, FZCI, FZCSEG.
-#include "zebra/fzcseg.inc"
-#include "test_include/testll.inc"
-#include "test_include/testdd.inc"
-#include "test_include/testiq.inc"
-#include "test_include/testee.inc"
-#include "test_include/fqtlun.inc"
-C-------------- END CDE --------------
- DIMENSION MHEA(10)
- EQUIVALENCE (MHEA(1),M(71))
-
-#include "zebra/q_jbit.inc"
-#include "zebra/q_jbyt.inc"
-
-
- CALL ZPHASE (3)
- IXWIPE = MZIXCO (IXSTOR+3,4,0,0)
-
- LUNIN = LUNT1
- MINPR = 19
- MAXPR = 1
- JGOOD = 0
- JMAKE = 0
-
-
- 41 MHEA(1) = 9
-
-
- CALL CQHIDS (JMAKE,3)
-
- JSNAP = 0
- IF ((JMAKE.GE.MINPR) .AND. (JMAKE.LT.MAXPR)) JSNAP = 7
-
- 42 MHEA(1) = 9
-#if defined(CERNLIB_QTESTLIB)||defined(CERNLIB_QFIMDANY)
- IF (IFLXQ(6).NE.0) THEN
- CALL FQMGET
- IF (IQUEST(1).NE.0) GO TO 91
- ENDIF
-#endif
- CALL FZIN (LUNIN,IXSTOR,0,0,'S',MHEA(1),MHEA(2))
- IF (IQUEST(1).NE.0) GO TO 91
- IF (MHEA(2).NE.901) GO TO 97
- IF (JBYT(JMAKE,2,3).EQ.7) GO TO 51
-
- CALL FZIN (LUNIN,IXSTOR,0,0,'T',0,0)
- IF (IQUEST(1).NE.0) GO TO 94
- MODCOM = 1
- IF (NQSEG.LT.2) GO TO 49
- IQSEGD(2) = 4
- IF (JBIT(JMAKE,3).NE.0) THEN
- IQSEGD(1) = -1
- ELSE
- MODCOM = 0
- ENDIF
-
- 49 CALL FZIN (LUNIN,IXSTOR+3,LQUSER,1,'D',0,0)
- IF (IQUEST(1).NE.0) GO TO 94
- M(62) = IQUEST(2)
- M(63) = IQUEST(3)
- M(64) = JMAKE
- IF (JSNAP.NE.0) CALL DZSNAP ('INLHIG',IXSTOR,'WM.')
- CALL QCOMDS (MODCOM,LOGLEV)
- JGOOD = JGOOD + 1
- CALL MZWIPE (IXWIPE)
-
- 51 MHEA(1) = 9
-#if defined(CERNLIB_QTESTLIB)||defined(CERNLIB_QFIMDANY)
- IF (IFLXQ(6).NE.0) THEN
- CALL FQMGET
- IF (IQUEST(1).NE.0) GO TO 91
- ENDIF
-#endif
- CALL FZIN (LUNIN,IXSTOR+3,LQUSER,1,'.',MHEA(1),MHEA(2))
- IF (IQUEST(1).NE.0) GO TO 94
- M(62) = IQUEST(2)
- M(63) = IQUEST(3)
- M(64) = JMAKE
- IF (JSNAP.NE.0) CALL DZSNAP ('INHIGH',IXSTOR,'WM.')
- CALL QCOMDS (1,LOGLEV)
- JGOOD = JGOOD + 1
- CALL MZWIPE (IXWIPE)
-
- IF (LL1.EQ.0) GO TO 69
- IF (JBIT(IQ(LL1),IQDROP).NE.0) GO TO 69
-
-#if defined(CERNLIB_QTESTLIB)||defined(CERNLIB_QFIMDANY)
- IF (IFLXQ(6).NE.0) THEN
- CALL FQMGET
- IF (IQUEST(1).NE.0) GO TO 91
- ENDIF
-#endif
- CALL FZIN (LUNIN,IXSTOR+3,LQUSER,1,'.',MHEA(1),MHEA(2))
- IF (IQUEST(1).NE.0) GO TO 94
- M(62) = IQUEST(2)
- M(63) = IQUEST(3)
- M(64) = JMAKE
- IF (JSNAP.NE.0) CALL DZSNAP ('INLOW ',IXSTOR,'WM.')
- CALL QCOMDS (2,LOGLEV)
- JGOOD = JGOOD + 1
-
- 69 CALL MZWIPE (IXSTOR+21)
- JMAKE = JMAKE + 1
- GO TO 41
-
-C---- END OR BAD DATA
-
- 91 IF (IQUEST(1).LT.0) CALL ZFATAM ('FQBACK - READ ERROR.')
- IF (IQUEST(1).GE.5) GO TO 98
- IF (IQUEST(1).LT.4) GO TO 42
- CALL FZENDI (LUNIN,'C')
- GO TO 42
-
- 94 CALL ZFATAM ('FQBACK - unexpected exit')
-
- 97 CALL ZFATAM ('FQBACK - first u/header word is not 901')
-
- 98 CALL FQTINF (LUNIN)
- CALL FZENDI (LUNIN,'TX')
-
- WRITE (IQLOG,9098) JGOOD
- 9098 FORMAT (1X/' *!!!!--',I7,' d/s compared successfully.')
- RETURN
- END
-* ==================================================
-#include "zebra/qcardl.inc"
diff --git a/src/packlib/zebra/test/fqtest/fqbkco.F b/src/packlib/zebra/test/fqtest/fqbkco.F
deleted file mode 100644
index dae2007..0000000
--- a/src/packlib/zebra/test/fqtest/fqbkco.F
+++ /dev/null
@@ -1,60 +0,0 @@
-*
-* $Id: fqbkco.F,v 1.1.1.1 1996/03/06 10:47:01 mclareni Exp $
-*
-* $Log: fqbkco.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:01 mclareni
-* Zebra
-*
-*
-#include "test_include/pilot.h"
- SUBROUTINE FQBKCO
-
-C- Read back with fan-out through FZCOPY
-
-#include "zebra/zstate.inc"
-#include "zebra/zunit.inc"
-#include "zebra/mzbits.inc"
-#include "zebra/quest.inc"
-C! +CDE, FZCI, FZCSEG.
-#include "zebra/fzcseg.inc"
-#include "test_include/testll.inc"
-#include "test_include/testdd.inc"
-#include "test_include/testiq.inc"
-#include "test_include/testee.inc"
-#include "test_include/fqtlun.inc"
-C-------------- END CDE --------------
- DIMENSION MHEA(10,3)
-
-
-C------- Copy types 902 + 903
-
- CALL ZPHASE (3)
- LUNIN = LUNT1
-
-
- 24 MHEA(1,1) = 9
- CALL FZIN (LUNIN,IXSTOR,0,0,'S',MHEA(1,1),MHEA(2,1))
- IF (IQUEST(1)) 24, 26, 29
- 26 IF (MHEA(2,1).EQ.901) GO TO 24
- LUNFZ = LUNT2
- IF (MHEA(2,1).EQ.903) LUNFZ=LUNT3
-
- CALL FZCOPY (LUNIN, LUNFZ, 0, '.', 2,MHEA(1,1),MHEA(2,1))
- IF (IQUEST(1).NE.0) GO TO 94
- GO TO 24
-
- 29 IF (IQUEST(1).LT.5) GO TO 24
-
- CALL FZENDI (LUNT1,'I')
- CALL FZENDO (LUNT2,'I')
- CALL FZENDO (LUNT3,'I')
-
-C------- Read back and compare
-
- CALL FQBKFI
- RETURN
-
- 94 CALL ZFATAM ('FQBKCO - unexpected exit')
- END
-* ==================================================
-#include "zebra/qcardl.inc"
diff --git a/src/packlib/zebra/test/fqtest/fqbkfa.F b/src/packlib/zebra/test/fqtest/fqbkfa.F
deleted file mode 100644
index e369db2..0000000
--- a/src/packlib/zebra/test/fqtest/fqbkfa.F
+++ /dev/null
@@ -1,72 +0,0 @@
-*
-* $Id: fqbkfa.F,v 1.1.1.1 1996/03/06 10:47:01 mclareni Exp $
-*
-* $Log: fqbkfa.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:01 mclareni
-* Zebra
-*
-*
-#include "test_include/pilot.h"
- SUBROUTINE FQBKFA
-
-C- Read back with fan-out through FZIN/FZOUT
-
-#include "zebra/zstate.inc"
-#include "zebra/zunit.inc"
-#include "zebra/mzbits.inc"
-#include "zebra/quest.inc"
-C! +CDE, FZCI, FZCSEG.
-#include "zebra/fzcseg.inc"
-#include "test_include/testll.inc"
-#include "test_include/testdd.inc"
-#include "test_include/testiq.inc"
-#include "test_include/testee.inc"
-#include "test_include/fqtlun.inc"
-C-------------- END CDE --------------
- DIMENSION MHEA(10,3)
-
-
-C------- Copy types 902 + 903
-
- CALL ZPHASE (3)
- LUNIN = LUNT1
-
-
- 24 MHEA(1,1) = 9
- CALL FZIN (LUNIN,IXSTOR,0,0,'S',MHEA(1,1),MHEA(2,1))
- IF (IQUEST(1)) 24, 26, 29
- 26 IF (MHEA(2,1).EQ.901) GO TO 24
- LUNFZ = LUNT2
- IF (MHEA(2,1).EQ.903) LUNFZ=LUNT3
-
- CALL FZIN (LUNIN,IXSTOR+2,LQUSER,1,'A',0,0)
- IF (IQUEST(1).NE.0) GO TO 94
-
- CALL FZOUT (LUNFZ,IXSTOR+2,LQUSER,0,'DI',2,MHEA(1,1),MHEA(2,1))
- CALL MZWIPE (IXSTOR+21)
- GO TO 24
-
- 29 IF (IQUEST(1).LT.5) THEN
- IF (IQUEST(1).EQ.1) GO TO 24
- CALL FZENDI (LUNIN,'.')
- GO TO 24
- ENDIF
-
- CALL FQTINF (LUNT1)
- CALL FQTINF (LUNT2)
- CALL FQTINF (LUNT3)
-
- CALL FZENDI (LUNT1,'I')
- CALL FZENDO (LUNT2,'I')
- CALL FZENDO (LUNT3,'I')
- CALL FQTINF (0)
-
-C------- Read back and compare
-
- CALL FQBKFI
- RETURN
-
- 94 CALL ZFATAM ('FQBKFA - unexpected exit')
- END
-* ==================================================
-#include "zebra/qcardl.inc"
diff --git a/src/packlib/zebra/test/fqtest/fqbkfi.F b/src/packlib/zebra/test/fqtest/fqbkfi.F
deleted file mode 100644
index 276bd31..0000000
--- a/src/packlib/zebra/test/fqtest/fqbkfi.F
+++ /dev/null
@@ -1,146 +0,0 @@
-*
-* $Id: fqbkfi.F,v 1.2 1996/04/18 16:14:30 mclareni Exp $
-*
-* $Log: fqbkfi.F,v $
-* Revision 1.2 1996/04/18 16:14:30 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:01 mclareni
-* Zebra
-*
-*
-#include "test_include/pilot.h"
- SUBROUTINE FQBKFI
-
-C- Read back after fan-out for FQBKFA or FQBKCO
-
-#include "zebra/zstate.inc"
-#include "zebra/zunit.inc"
-#include "zebra/mzbits.inc"
-#include "zebra/quest.inc"
-C! +CDE, FZCI, FZCSEG.
-#include "zebra/fzcseg.inc"
-#include "test_include/testll.inc"
-#include "test_include/testdd.inc"
-#include "test_include/testiq.inc"
-#include "test_include/testee.inc"
-#include "test_include/fqtlun.inc"
-C-------------- END CDE --------------
- DIMENSION MHEA(10,3)
-
-#include "zebra/q_jbit.inc"
-
- CALL VFILL (MHEA,30,-99)
- CALL ZPHASE (4)
- IXWIPE = MZIXCO (IXSTOR+3,4,0,0)
-
- MINPR = 19
- MAXPR = 1
- JMAKE = 0
- JGOOD = 0
-
-
-
-C-- POSITION PRECURSORS
-
- 41 DO 49 JL=1,3
- IF (MHEA(3,JL).EQ.77777) GO TO 49
- LUNIN = LUNTV(JL)
- 46 IF (MHEA(3,JL).LT.JMAKE) GO TO 47
- IF (MHEA(2,JL).EQ.JL+900) GO TO 49
- 47 MHEA(1,JL) = 9
- CALL FZIN (LUNIN,IXSTOR,0,0,'S',MHEA(1,JL),MHEA(2,JL))
-C WRITE (IQLOG,9847) JMAKE,LUNIN,(MHEA(J,JL),J=1,5)
-C9847 FORMAT (10X,'JMAKE=',I4,' LUN=',I3,' reads MHEA(1:5)=',5I5)
- IF (IQUEST(1)) 47,46,48
- 48 IF (IQUEST(1).LT.5) THEN
-C. IF (IQUEST(1).EQ.1) GO TO 47
-C. CALL FZENDI (LUNIN,'.')
- GO TO 47
- ELSE
- MHEA(3,JL) = 77777
- IF (JL.EQ.1) GO TO 98
- ENDIF
- 49 CONTINUE
-
-C-- LIFT EXPECTED STRUCTURE
-
- CALL CQHIDS (JMAKE,3)
-
- JSNAP = 0
- IF ((JMAKE.GE.MINPR) .AND. (JMAKE.LT.MAXPR)) JSNAP = 7
-
-C-- Do 901
-
- IF (MHEA(3,1).NE.JMAKE) GO TO 53
-
- LUNIN = LUNT1
- CALL FZIN (LUNIN,IXSTOR,0,0,'T',0,0)
- IF (IQUEST(1).NE.0) GO TO 94
- MODCOM = 1
- IF (NQSEG.GE.2) THEN
- IQSEGD(2) = 4
- MODCOM = 0
- ENDIF
-
- CALL FZIN (LUNIN,IXSTOR+3,LQUSER,1,'D',0,0)
- IF (IQUEST(1).NE.0) GO TO 94
- M(62) = IQUEST(2)
- M(63) = IQUEST(3)
- M(64) = JMAKE
- IF (JSNAP.NE.0) CALL DZSNAP ('INLHIG',IXSTOR,'WM.')
- CALL QCOMDS (MODCOM,LOGLEV)
- CALL MZWIPE (IXWIPE)
- JGOOD = JGOOD + 1
-
-C-- Do 902
-
- 53 IF (MHEA(3,2).NE.JMAKE) GO TO 56
-
- LUNIN = LUNT2
- CALL FZIN (LUNIN,IXSTOR+3,LQUSER,1,'A',0,0)
- IF (IQUEST(1).NE.0) GO TO 94
- M(62) = IQUEST(2)
- M(63) = IQUEST(3)
- M(64) = JMAKE
- IF (JSNAP.NE.0) CALL DZSNAP ('INHIGH',IXSTOR,'WM.')
- CALL QCOMDS (1,LOGLEV)
- CALL MZWIPE (IXWIPE)
- JGOOD = JGOOD + 1
-
-C-- Do 903
-
- 56 IF (MHEA(3,3).NE.JMAKE) GO TO 69
-
- IF (LL1.EQ.0) GO TO 69
- IF (JBIT(IQ(LL1),IQDROP).NE.0) GO TO 69
-
- LUNIN = LUNT3
- CALL FZIN (LUNIN,IXSTOR+3,LQUSER,1,'A',0,0)
- IF (IQUEST(1).NE.0) GO TO 94
- M(62) = IQUEST(2)
- M(63) = IQUEST(3)
- M(64) = JMAKE
- IF (JSNAP.NE.0) CALL DZSNAP ('INLOW ',IXSTOR,'WM.')
- CALL QCOMDS (2,LOGLEV)
- JGOOD = JGOOD + 1
-
- 69 CALL MZWIPE (IXSTOR+21)
- JMAKE = JMAKE + 1
- GO TO 41
-
-C---- END OR BAD DATA
-
- 94 CALL ZFATAM ('FQBKFI - unexpected exit')
-
- 98 CALL FQTINF (LUNT1)
- CALL FQTINF (LUNT2)
- CALL FQTINF (LUNT3)
- CALL FZENDI (0,'TX')
-
- WRITE (IQLOG,9098) JGOOD
- 9098 FORMAT (1X/' *!!!!--',I7,' d/s compared successfully.')
- RETURN
- END
-* ==================================================
-#include "zebra/qcardl.inc"
diff --git a/src/packlib/zebra/test/fqtest/fqbkra.F b/src/packlib/zebra/test/fqtest/fqbkra.F
deleted file mode 100644
index a2d5a61..0000000
--- a/src/packlib/zebra/test/fqtest/fqbkra.F
+++ /dev/null
@@ -1,110 +0,0 @@
-*
-* $Id: fqbkra.F,v 1.2 1996/04/18 16:14:30 mclareni Exp $
-*
-* $Log: fqbkra.F,v $
-* Revision 1.2 1996/04/18 16:14:30 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:01 mclareni
-* Zebra
-*
-*
-#include "test_include/pilot.h"
- SUBROUTINE FQBKRA
-
-C- Random read-back
-
-#include "zebra/zstate.inc"
-#include "zebra/zunit.inc"
-#include "zebra/mzbits.inc"
-#include "zebra/quest.inc"
-C! +CDE, FZCI, FZCSEG.
-#include "zebra/fzcseg.inc"
-#include "test_include/testll.inc"
-#include "test_include/testdd.inc"
-#include "test_include/testiq.inc"
-#include "test_include/testee.inc"
-#include "test_include/fqtlun.inc"
-C-------------- END CDE --------------
- EQUIVALENCE (LQDATB,LQUSER(4))
- DIMENSION MHEA(10)
- EQUIVALENCE (MHEA(1),M(71))
-
-#include "zebra/q_jbit.inc"
-
- CALL ZPHASE (3)
-
- LUNIN = LUNT1
-
-C-- get the Direct Access Table
- CALL FZIDAT (LUNIN,IXHOLD,LQDATB,1)
- IF (IQUEST(1).NE.0) GO TO 93
- NDOEND = IQ(LQDATB+1)
-
-C------ Read back of the data in 4 series taking every 4th d/s
-C-- starting with d/s "js", with js = 1, 2, 3, 4
-
- JSERIE = 0
- JDO = 2
- JGOOD = 0
-
-C---- Loop to read d/ss js, js+4, js+8, js+12, ...
-
- 41 JMAKE = IQ(LQDATB+JDO)
- CALL FZINXT (LUNIN, IQ(LQDATB+JDO+1), IQ(LQDATB+JDO+2))
-
- MHEA(1) = 9
- CALL CQHIDS (JMAKE,3)
-
- MHEA(1) = 9
- CALL FZIN (LUNIN,IXSTOR,0,0,'S',MHEA(1),MHEA(2))
- IF (IQUEST(1).NE.0) GO TO 91
- IF (MHEA(2).NE.901) GO TO 97
-
- CALL FZIN (LUNIN,IXSTOR,0,0,'T',0,0)
- IF (IQUEST(1).NE.0) GO TO 92
- MODCOM = 1
- IF (NQSEG.LT.2) GO TO 49
- IQSEGD(2) = 4
- IF (JBIT(JMAKE,3).NE.0) THEN
- IQSEGD(1) = -1
- ELSE
- MODCOM = 0
- ENDIF
-
- 49 CALL FZIN (LUNIN,IXSTOR+3,LQUSER,1,'D',0,0)
- IF (IQUEST(1).NE.0) GO TO 92
- M(62) = IQUEST(2)
- M(63) = IQUEST(3)
- M(64) = JMAKE
- CALL QCOMDS (MODCOM,LOGLEV)
- JGOOD = JGOOD + 1
- CALL MZWIPE (IXSTOR+21)
- JDO = JDO + 12
- IF (JDO.LT.NDOEND) GO TO 41
-
- JSERIE = JSERIE + 1
- IF (JSERIE.GE.4) GO TO 98
-
- JDO = 3*JSERIE + 2
- IF (JDO.GE.NDOEND) GO TO 98
- GO TO 41
-
-C---- END OR BAD DATA
-
- 91 IF (IQUEST(1).LT.0) CALL ZFATAM ('FQBKRA - READ ERROR.')
- 92 CALL ZFATAM ('FQBKRA - unexpected exit')
-
- 93 CALL ZFATAM ('FQBKRA - DAT not obtained')
-
- 97 CALL ZFATAM ('FQBKRA - first u/header word is not 901')
-
- 98 CALL FQTINF (LUNIN)
- CALL FZENDI (LUNIN,'TX')
- CALL FQTINF (0)
- WRITE (IQLOG,9098) JGOOD
- 9098 FORMAT (1X/' *!!!!--',I7,' d/s compared successfully.')
- RETURN
- END
-* ==================================================
-#include "zebra/qcardl.inc"
diff --git a/src/packlib/zebra/test/fqtest/fqcget.F b/src/packlib/zebra/test/fqtest/fqcget.F
deleted file mode 100644
index dab5274..0000000
--- a/src/packlib/zebra/test/fqtest/fqcget.F
+++ /dev/null
@@ -1,50 +0,0 @@
-*
-* $Id: fqcget.F,v 1.2 1996/04/18 16:14:31 mclareni Exp $
-*
-* $Log: fqcget.F,v $
-* Revision 1.2 1996/04/18 16:14:31 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:01 mclareni
-* Zebra
-*
-*
-#include "test_include/pilot.h"
- SUBROUTINE FQCGET (MEMBUF,ICODE)
-
-C- Read from file for channel mode
-
-#include "zebra/zunit.inc"
-#include "zebra/quest.inc"
-#include "test_include/fqtlun.inc"
-C-------------- END CDE --------------
- DIMENSION MEMBUF(999)
-
-
-#if defined(CERNLIB_QDEBPRI)
- IF (ICODE.NE.0) CALL ZFATAM ('FQCGET - ICODE not 0')
- IF (LOGLEV.GE.1)
- + WRITE (IQLOG,9821) JMAKE,IQUEST(2),IQUEST(3)
- 9821 FORMAT (' FTESTC- JMAKE=',I4,
- F', FQCGET called with IQUEST(2),(3)=',I4,I6)
-#endif
-
- NWRMX = IQUEST(2)
- NWR = NWRMX
- CALL XINBS (LUNT1,INFLAG,1,MEMBUF,NWR)
- IF (NWR.LE.0) GO TO 94
- IQUEST(1) = 0
- IQUEST(2) = NWR
- RETURN
-
-C---- Read error / End-of-file
-
- 94 IF (NWR.EQ.0) GO TO 98
- IQUEST(1) = -NWR
- RETURN
-
- 98 IQUEST(1) = -1
- RETURN
- END
-* ==================================================
-#include "zebra/qcardl.inc"
diff --git a/src/packlib/zebra/test/fqtest/fqcput.F b/src/packlib/zebra/test/fqtest/fqcput.F
deleted file mode 100644
index da1354a..0000000
--- a/src/packlib/zebra/test/fqtest/fqcput.F
+++ /dev/null
@@ -1,44 +0,0 @@
-*
-* $Id: fqcput.F,v 1.1.1.1 1996/03/06 10:47:01 mclareni Exp $
-*
-* $Log: fqcput.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:01 mclareni
-* Zebra
-*
-*
-#include "test_include/pilot.h"
- SUBROUTINE FQCPUT (MEMBUF,ICODE)
-
-C- Write to file for channel mode
-
-#include "zebra/zunit.inc"
-#include "zebra/quest.inc"
-#include "test_include/fqtlun.inc"
-C-------------- END CDE --------------
- DIMENSION MEMBUF(999)
-
-#include "zebra/q_jbit.inc"
-
-#if defined(CERNLIB_QDEBPRI)
- IF (ICODE.NE.1) CALL ZFATAM ('FQCPUT - ICODE not 1')
- IF (LOGLEV.GE.1)
- + WRITE (IQLOG,9821) JMAKE,IQUEST(2),IQUEST(3)
- IF (LOGLEV.GE.3) THEN
- IF (JBIT(IQUEST(3),1).NE.0)
- + WRITE (IQLOG,9822) (MEMBUF(J),J=1,10)
- ENDIF
- 9821 FORMAT (' FTESTC- JMAKE=',I4,
- F', FQCPUT called with IQUEST(2),(3)=',I4,I6)
-#endif
-#if (defined(CERNLIB_QDEBPRI))&&(!defined(CERNLIB_B60M))
- 9822 FORMAT (10X,'Header=',5Z13/17X,5Z13)
-#endif
-#if (defined(CERNLIB_QDEBPRI))&&(defined(CERNLIB_B60M))
- 9822 FORMAT (10X,'Header=',5Z17/17X,5Z17)
-#endif
- CALL XOUTBS (LUNT1,IQUEST(3),1,MEMBUF,IQUEST(2))
- IQUEST(1) = 0
- RETURN
- END
-* ==================================================
-#include "zebra/qcardl.inc"
diff --git a/src/packlib/zebra/test/fqtest/fqmake.F b/src/packlib/zebra/test/fqtest/fqmake.F
deleted file mode 100644
index d562bea..0000000
--- a/src/packlib/zebra/test/fqtest/fqmake.F
+++ /dev/null
@@ -1,155 +0,0 @@
-*
-* $Id: fqmake.F,v 1.2 1996/04/18 16:14:32 mclareni Exp $
-*
-* $Log: fqmake.F,v $
-* Revision 1.2 1996/04/18 16:14:32 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:01 mclareni
-* Zebra
-*
-*
-#include "test_include/pilot.h"
- SUBROUTINE FQMAKE
-
-#include "zebra/zstate.inc"
-#include "zebra/zunit.inc"
-#include "zebra/mzbits.inc"
-#include "zebra/quest.inc"
-#include "test_include/cqc.inc"
-#include "zebra/cqbkc.inc"
-#include "test_include/testla.inc"
-#include "test_include/testll.inc"
-#include "test_include/testdd.inc"
-#include "test_include/testiq.inc"
-#include "test_include/testee.inc"
-#include "test_include/fqtlun.inc"
-C-------------- END CDE --------------
- EQUIVALENCE (LQDATB,LQUSER(4))
-
- DIMENSION MMDATB(5)
- DATA MMDATB / 0 , 0, 0, 900, 2 /
-
-#include "zebra/q_jbit.inc"
-
-C---- Create the Direct Access Table bank
-
- CALL UCTOH ('DATB', MMDATB, 4,4)
- CALL MZLIFT (IXHOLD,L, LQDATB,1, MMDATB, 0)
- IQ(LQDATB+1) = 1
-
-C----- Ready
-
- LUNFZ = LUNT1
- LOGLEV = LEVOUT
- CALL FZLOGL (LUNFZ,LOGLEV)
-
- CALL ZPHASE (1)
- JMAKE = 0
-
-
-C-- write the DAT forward reference place-holder
- IF (IFLXQ(3).NE.0) CALL FZODAT (LUNFZ, 0, 0)
-
-C-- write start of run 11
- M(8) = 20
- M(11) = JMAKE
- M(12) = MAXMAK
- CALL FZRUN (LUNFZ,11,M(8),M(9))
-#if defined(CERNLIB_QTESTLIB)||defined(CERNLIB_QFIMDANY)
- IF (IFLXQ(6).NE.0) CALL FQMPUT
-#endif
-
-C-------- Loop over all d/ss -----------
-
- 21 IF (JMAKE.EQ.MKBREA) GO TO 25
- IF (JMAKE.EQ.MKBREA+10) GO TO 24
- IF (JMAKE.EQ.MKBREA+20) GO TO 24
- IF (JMAKE.NE.MKBREA+30) GO TO 26
-
-C-- test skip to StoR/EoR works
-
- IF (IFLXQ(2).EQ.0) GO TO 24
- CALL FZENDO (LUNFZ,'IO')
- 22 M(71) = 9
- CALL FZIN (LUNFZ,0,0,0,'R',M(71),M(72))
- IF (IQUEST(1).NE.1) CALL ZFATAM ('FQMAKE - not StoR')
- IF (IQUEST(11).NE.14) GO TO 22
- CALL FZIN (LUNFZ,0,0,0,'2',M(71),M(72))
- IF (IQUEST(1).NE.2) CALL ZFATAM ('FQMAKE - not EoR')
- CALL FZENDI (LUNFZ,'O')
-
- 24 CALL FZENDO (LUNFZ,'C')
-#if defined(CERNLIB_QTESTLIB)||defined(CERNLIB_QFIMDANY)
- IF (IFLXQ(6).NE.0) CALL FQMPUT
-#endif
- 25 CALL FZRUN (LUNFZ,0,M(8),M(9))
-#if defined(CERNLIB_QTESTLIB)||defined(CERNLIB_QFIMDANY)
- IF (IFLXQ(6).NE.0) CALL FQMPUT
-#endif
-
-C---- Next set of 2 or 3 d/ss
-
- 26 M(8) = 20
- M(11) = JMAKE
- M(12) = MAXMAK
- CALL CQHIDS (JMAKE,3)
-
- JSNAP = 0
- IF ((JMAKE.GE.MINPR) .AND. (JMAKE.LT.MAXPR)) JSNAP = 7
- IF (JSNAP.NE.0) CALL DZSNAP ('OUT',IXSTOR,'MW.')
-
- M(9) = 901
- CALL FZOUT (LUNFZ, IXSTOR, LQMAIN, 1, 'L', 2,M(8),M(9))
-#if defined(CERNLIB_QTESTLIB)||defined(CERNLIB_QFIMDANY)
- IF (IFLXQ(6).NE.0) CALL FQMPUT
-#endif
-
- N = IQ(LQDATB+1)
- IQ(LQDATB+N+1) = JMAKE
- IQ(LQDATB+N+2) = IQUEST(5)
- IQ(LQDATB+N+3) = IQUEST(6)
- IQ(LQDATB+1) = N + 3
-
- M(9) = 902
- CALL FZOUT (LUNFZ, IXSTOR+2,LQMAIN, 0, 'D', 2,M(8),M(9))
-#if defined(CERNLIB_QTESTLIB)||defined(CERNLIB_QFIMDANY)
- IF (IFLXQ(6).NE.0) CALL FQMPUT
-#endif
-
- IF (LL1.EQ.0) GO TO 28
- IF (JBIT(IQ(LL1),IQDROP).NE.0) GO TO 28
- M(9) = 903
- CALL FZOUT (LUNFZ, IXSTOR+1,LL1, 0, 'L', 2,M(8),M(9))
-#if defined(CERNLIB_QTESTLIB)||defined(CERNLIB_QFIMDANY)
- IF (IFLXQ(6).NE.0) CALL FQMPUT
-#endif
-
- 28 CALL MZWIPE (IXSTOR+21)
- JMAKE = JMAKE + 1
- IF (JMAKE.LT.MAXMAK) GO TO 21
-
-C-- Done, write the Direct Access Table
-
- NU = IQ(LQDATB+1)
- NT = IQ(LQDATB-1)
- INC = NU - NT
- CALL MZPUSH (IXHOLD,LQDATB, 0,INC, 'I')
- IF (IFLXQ(4).NE.0) CALL FZODAT (LUNFZ, IXHOLD, LQDATB)
- IF (IFLXQ(5).NE.0) CALL FQRSET (1, LUNFZ)
- CALL MZDROP (IXHOLD, LQDATB, 'L')
-
- CALL FQTINF (LUNFZ)
-
-C-- Write the EoR for memory mode
-
-#if defined(CERNLIB_QTESTLIB)||defined(CERNLIB_QFIMDANY)
- IF (IFLXQ(6).NE.0) THEN
- CALL FZRUN (LUNFZ,-1,0,0)
- CALL FQMPUT
- ENDIF
-#endif
- RETURN
- END
-* ==================================================
-#include "zebra/qcardl.inc"
diff --git a/src/packlib/zebra/test/fqtest/fqmbuf.inc b/src/packlib/zebra/test/fqtest/fqmbuf.inc
deleted file mode 100644
index 4c5d4fb..0000000
--- a/src/packlib/zebra/test/fqtest/fqmbuf.inc
+++ /dev/null
@@ -1,13 +0,0 @@
-*
-* $Id: fqmbuf.inc,v 1.1.1.1 1996/03/06 10:47:01 mclareni Exp $
-*
-* $Log: fqmbuf.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:01 mclareni
-* Zebra
-*
-*
-*
-* fqmbuf.inc
-*
- PARAMETER (NMEMOR=10000)
- COMMON /FQMBUF/ MEMBUF(NMEMOR)
diff --git a/src/packlib/zebra/test/fqtest/fqmget.F b/src/packlib/zebra/test/fqtest/fqmget.F
deleted file mode 100644
index 22f4a93..0000000
--- a/src/packlib/zebra/test/fqtest/fqmget.F
+++ /dev/null
@@ -1,35 +0,0 @@
-*
-* $Id: fqmget.F,v 1.1.1.1 1996/03/06 10:47:01 mclareni Exp $
-*
-* $Log: fqmget.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:01 mclareni
-* Zebra
-*
-*
-#include "test_include/pilot.h"
- SUBROUTINE FQMGET
-
-C- Read from file for memory mode
-
-#include "zebra/zunit.inc"
-#include "zebra/quest.inc"
-#include "test_include/fqtlun.inc"
-#include "fqmbuf.inc"
-C-------------- END CDE --------------
-
-
- NWR = NMEMOR
- CALL XINB (LUNT1,MEMBUF,NWR)
- IF (NWR.LE.0) GO TO 94
- IQUEST(1) = 0
- RETURN
-
- 94 IF (NWR.EQ.0) THEN
- IQUEST(1) = 5
- ELSE
- IQUEST(1) = -5
- ENDIF
- RETURN
- END
-* ==================================================
-#include "zebra/qcardl.inc"
diff --git a/src/packlib/zebra/test/fqtest/fqmput.F b/src/packlib/zebra/test/fqtest/fqmput.F
deleted file mode 100644
index 591da69..0000000
--- a/src/packlib/zebra/test/fqtest/fqmput.F
+++ /dev/null
@@ -1,40 +0,0 @@
-*
-* $Id: fqmput.F,v 1.1.1.1 1996/03/06 10:47:01 mclareni Exp $
-*
-* $Log: fqmput.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:01 mclareni
-* Zebra
-*
-*
-#include "test_include/pilot.h"
- SUBROUTINE FQMPUT
-
-C- Write to file for memory mode
-
-#include "zebra/zunit.inc"
-#include "zebra/quest.inc"
-#include "test_include/fqtlun.inc"
-#include "fqmbuf.inc"
-C-------------- END CDE --------------
-
-
-#if defined(CERNLIB_QDEBPRI)
- IF (LOGLEV.GE.1)
- + WRITE (IQLOG,9821) JMAKE,IQUEST(1),IQUEST(9)
- IF (LOGLEV.GE.3)
- + WRITE (IQLOG,9822) (MEMBUF(J),J=1,10)
- 9821 FORMAT (' FTESTM- JMAKE=',I4,
- F', FZOUT returns IQUEST(1),(9)=',I4,I6)
-#endif
-#if (defined(CERNLIB_QDEBPRI))&&(!defined(CERNLIB_B60M))
- 9822 FORMAT (10X,'Header=',5Z13/17X,5Z13)
-#endif
-#if (defined(CERNLIB_QDEBPRI))&&(defined(CERNLIB_B60M))
- 9822 FORMAT (10X,'Header=',5Z17/17X,5Z17)
-#endif
- IF (IQUEST(1).NE.0) RETURN
- CALL XOUTB (LUNT1,MEMBUF,IQUEST(9))
- RETURN
- END
-* ==================================================
-#include "zebra/qcardl.inc"
diff --git a/src/packlib/zebra/test/fqtest/fqnameda.inc b/src/packlib/zebra/test/fqtest/fqnameda.inc
deleted file mode 100644
index 022da36..0000000
--- a/src/packlib/zebra/test/fqtest/fqnameda.inc
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: fqnameda.inc,v 1.2 1996/04/24 17:19:50 mclareni Exp $
-*
-* $Log: fqnameda.inc,v $
-* Revision 1.2 1996/04/24 17:19:50 mclareni
-* Cleanup to allow tests to run together on all systems
-*
-* Revision 1.1.1.1 1996/03/06 10:47:01 mclareni
-* Zebra
-*
-*
-*
-* fqnameda.inc
-*
-#if defined(CERNLIB_QMIBM)
- DATA FQNAME / '/ZXTEST DAT1', '/ZXTEST DAT2', '/ZXTEST DAT3' /
-#elif defined(CERNLIB_QMIBMD)
- DATA FQNAME / '/ZXTEST DAT1', '/ZXTEST DAT2', '/ZXTEST DAT3' /
-#elif 1
- DATA FQNAME / 'zxtest1.dat ', 'zxtest2.dat ', 'zxtest3.dat ' /
-#endif
diff --git a/src/packlib/zebra/test/fqtest/fqnamrda.inc b/src/packlib/zebra/test/fqtest/fqnamrda.inc
deleted file mode 100644
index d723dd8..0000000
--- a/src/packlib/zebra/test/fqtest/fqnamrda.inc
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: fqnamrda.inc,v 1.1.1.1 1996/03/06 10:47:01 mclareni Exp $
-*
-* $Log: fqnamrda.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:01 mclareni
-* Zebra
-*
-*
-*
-* fqnamrda.inc
-*
-#if defined(CERNLIB_QMIBM)
- DATA FQNAME / '/FZREAD DAT ' /
-#elif defined(CERNLIB_QMIBMD)
- DATA FQNAME / '/FZREAD DAT ' /
-#elif 1
- DATA FQNAME / 'fzread.dat ' /
-#endif
diff --git a/src/packlib/zebra/test/fqtest/fqread.F b/src/packlib/zebra/test/fqtest/fqread.F
deleted file mode 100644
index 9fe568e..0000000
--- a/src/packlib/zebra/test/fqtest/fqread.F
+++ /dev/null
@@ -1,169 +0,0 @@
-*
-* $Id: fqread.F,v 1.1.1.1 1996/03/06 10:47:01 mclareni Exp $
-*
-* $Log: fqread.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:01 mclareni
-* Zebra
-*
-*
-#include "test_include/pilot.h"
- SUBROUTINE FQREAD
-
-#include "zebra/zstate.inc"
-#include "zebra/zunit.inc"
-#include "zebra/mzbits.inc"
-#include "zebra/quest.inc"
-#if defined(CERNLIB_QFIMDANY)
-#include "fqmbuf.inc"
-#endif
-#include "test_include/readiq.inc"
-#include "test_include/fqtlun.inc"
-C-------------- END CDE --------------
- PARAMETER (NHEA=40)
- DIMENSION MHEA(NHEA)
-
-
- CHARACTER CHFILE*8, CHCL*8, CHST*4, CHFM*(*)
-#if defined(CERNLIB_QFIASC)
- PARAMETER (CHFM='FORMATTED')
-#endif
-#if !defined(CERNLIB_QFIASC)
- PARAMETER (CHFM='UNFORMATTED')
-#endif
- CHARACTER FQNAME(1)*24
-#if defined(CERNLIB_QFICDANY)
- EXTERNAL FQCPUT, FQCGET
-#endif
-#include "fqtest/fqnamrda.inc"
-
-
-C NQDEVZ = 7
- CALL VZERO (IFLXQ,10)
-
-C---- Create the store and its divisions
-
- CALL MZSTOR (IXSTOR,'//', '.', FENCE
- +, LQ,LA1,LX1,LQ(NQLIM2),IQ(NQN))
-
-C CALL MZLOGL (IXSTOR,1)
- CALL MZWORK (IXSTOR,M,DLAST,0)
- CALL VZERO (LQUSER,150)
- CALL MZDIV (IXSTOR,IXHOLD,'HOLD',1000,2000, 'L')
-
-C---- Ready FZ test operation
-#if defined(CERNLIB_QFIASC)
- CHFILE = 'AI'
-#endif
-#if defined(CERNLIB_QFINDAN)
- CHFILE = 'I'
-#endif
-#if defined(CERNLIB_QFIXDAN)
- CHFILE = 'XNI'
-#endif
-#if defined(CERNLIB_QFIXDAX)
- CHFILE = 'XI'
-#endif
-#if defined(CERNLIB_QFIDDAN)
- CHFILE = 'DNI'
-#endif
-#if defined(CERNLIB_QFIDDAX)
- CHFILE = 'DI'
-#endif
-#if defined(CERNLIB_QFICDAN)
- CHFILE = 'CNI'
-#endif
-#if defined(CERNLIB_QFICDAX)
- CHFILE = 'CI'
-#endif
-#if defined(CERNLIB_QFILDAN)
- CHFILE = 'LNI'
-#endif
-#if defined(CERNLIB_QFILDAX)
- CHFILE = 'LI'
-#endif
-#if defined(CERNLIB_QFIRDAN)
- CHFILE = 'LDNI'
-#endif
-#if defined(CERNLIB_QFIRDAX)
- CHFILE = 'LDI'
-#endif
-#if defined(CERNLIB_QFIMDAN)
- CHFILE = 'MNI'
-#endif
-#if defined(CERNLIB_QFIMDAX)
- CHFILE = 'MI'
-#endif
-
- LUNT1 = 11
- LUNT2 = 12
- LUNT3 = 13
-
- NWREC = 0
- LEVOUT = 0
- LEVIN = 0
- MINPR = 19
- MAXPR = 1
- MAXMAK = 99
-
-#include "test_include/maxmak.inc"
-* Ignoring t=pass
-
- WRITE (IQLOG,9011) CHFILE, MAXMAK
- 9011 FORMAT (1X/' *!!!!!! FZ simple read-back with option ',A/
- F' *!!!!',I9,' used for MAXMAK')
-
-C---------- Read back --------------
-
- LOGLEV = LEVIN
-
- CHCL = 'r '
- CHST = 'OLD'
- LUNFZ = LUNT1
- JF = 1
-#include "fqtopmk.inc"
-* Ignoring t=pass
-#include "fqtest/fqtopen.inc"
-#if defined(CERNLIB_QFILDANY)||defined(CERNLIB_QFIRDANY)
- IQUEST(1) = LUNPTR(JF)
-#endif
- CALL FZFILE (LUNFZ, NWREC, CHFILE)
-#if defined(CERNLIB_QFICDANY)
- CALL FZHOOK (LUNFZ, FQCGET, NIL)
-#endif
-#if defined(CERNLIB_QFIMDANY)
- CALL FZMEMO (LUNFZ,MEMBUF,NMEMOR)
-#endif
- CALL FZLOGL (LUNFZ,LOGLEV)
-
-C---- Read back
-
- JGOOD = 0
-
- 41 NHEAD = NHEA
- CALL FZIN (LUNFZ,IXSTOR, LQMAIN,1, '.',NHEAD,MHEA)
- IF (IQUEST(1).NE.0) GO TO 91
- JGOOD = JGOOD + 1
-
- WRITE (IQLOG,9044) JGOOD
- 9044 FORMAT (' Read d/s number',I5)
-
- 69 CALL MZWIPE (IXSTOR+21)
- IF (JGOOD.GE.MAXMAK) GO TO 98
- GO TO 41
-
-C---- END OR BAD DATA
-
- 91 IF (IQUEST(1).LT.0) CALL ZFATAM ('FQREAD - Trouble.')
- IF (IQUEST(1).GE.5) GO TO 98
- IF (IQUEST(1).LT.4) GO TO 41
- CALL FZENDI (LUNFZ,'C')
- GO TO 41
-
- 98 CALL FZENDI (LUNFZ,'TX')
-
- WRITE (IQLOG,9098) JGOOD
- 9098 FORMAT (1X/' *!!!!--',I7,' d/s read successfully.')
- RETURN
- END
-* ==================================================
-#include "zebra/qcardl.inc"
diff --git a/src/packlib/zebra/test/fqtest/fqrset.F b/src/packlib/zebra/test/fqtest/fqrset.F
deleted file mode 100644
index 9cac9e5..0000000
--- a/src/packlib/zebra/test/fqtest/fqrset.F
+++ /dev/null
@@ -1,47 +0,0 @@
-*
-* $Id: fqrset.F,v 1.1.1.1 1996/03/06 10:47:01 mclareni Exp $
-*
-* $Log: fqrset.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:01 mclareni
-* Zebra
-*
-*
-#include "test_include/pilot.h"
- SUBROUTINE FQRSET (MODE,LUNP)
-
-C- MODE = 0 : break connection for input
-C- -ve : break connection for output
-C- +ve : reset DAT forward reference record to null
-C- careful : may only be called just after FZODAT
-
-#include "zebra/mqsys.inc"
-#include "zebra/eqlqf.inc"
-#include "zebra/fzci.inc"
-#include "zebra/fzcx.inc"
-C-------------- END CDE --------------
-
-
- IF (MODE.EQ.0) THEN
- LUNI = 0
- RETURN
- ENDIF
-
- IF (MODE.LT.0) THEN
- LUNX = 0
- RETURN
- ENDIF
-
- LUNNX = LUNP
- CALL FZLOC (LUNNX,2)
- IF (IFIFOX.NE.2) RETURN
- IF (IACMOX.GE.3) RETURN
-
- IQ(KQSP+LQFX+34) = 0
- IQ(KQSP+LQFX+35) = 7
-
- CALL FZUDAT (LUNNX,0)
- LUNX = -1
- RETURN
- END
-* ==================================================
-#include "zebra/qcardl.inc"
diff --git a/src/packlib/zebra/test/fqtest/fqtest.F b/src/packlib/zebra/test/fqtest/fqtest.F
deleted file mode 100644
index 0a4992a..0000000
--- a/src/packlib/zebra/test/fqtest/fqtest.F
+++ /dev/null
@@ -1,297 +0,0 @@
-*
-* $Id: fqtest.F,v 1.1.1.1 1996/03/06 10:47:01 mclareni Exp $
-*
-* $Log: fqtest.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:01 mclareni
-* Zebra
-*
-*
-#include "test_include/pilot.h"
- SUBROUTINE FQTEST
-
-#include "zebra/zstate.inc"
-#include "zebra/zunit.inc"
-#include "zebra/mzbits.inc"
-#include "zebra/quest.inc"
-#include "test_include/cqc.inc"
-#include "zebra/cqbkc.inc"
-#if defined(CERNLIB_QFIMDANY)
-#include "fqmbuf.inc"
-#endif
-#include "test_include/testla.inc"
-#include "test_include/testll.inc"
-#include "test_include/testdd.inc"
-#include "test_include/testiq.inc"
-#include "test_include/testee.inc"
-#include "test_include/fqtlun.inc"
-C-------------- END CDE --------------
-
-
- CHARACTER CHFILE*8, CHCL*8, CHST*4, CHFM*(*)
- LOGICAL THERE
-#if defined(CERNLIB_QFIASC)
- PARAMETER (CHFM='FORMATTED')
-#endif
-#if !defined(CERNLIB_QFIASC)
- PARAMETER (CHFM='UNFORMATTED')
-#endif
- CHARACTER FQNAME(3)*(12)
-#if defined(CERNLIB_QFICDANY)
- EXTERNAL FQCPUT, FQCGET
-#endif
-#include "fqtest/fqnameda.inc"
-
-
-C NQDEVZ = 7
- CALL VZERO (IFLXQ,10)
-
-C---- Create the store and its divisions
-
- CALL MZSTOR (IXSTOR,'//', '.', FENCE
- +, LQ,LA1,LX1,LQ(NQLIM2),IQ(NQN))
-
- CALL MZLOGL (IXSTOR,1)
- CALL MZWORK (IXSTOR,M,DLAST,0)
- CALL VZERO (LQUSER,150)
- CALL MZDIV (IXSTOR,IXHOLD,'HOLD',1000,2000, 'L')
- CALL MZDIV (IXSTOR,IXDV3, 'DIV3',4000,6000, '.')
- CALL MZDIV (IXSTOR,IXDV4, 'DIV4',4000,6000, 'R')
-
-C-- Initialize the d/s creation
-
- CALL CQBKIN
-#if !defined(CERNLIB_QFINDAN)
- MMBKD(5) = 9
- CALL MZFORM ('D1', '1I 2H 12I 35F 10D 10F / *S' , JJ)
-#endif
- CALL MZLOGL (IXSTOR,0)
-
-C---- Ready FZ test operation
-
-* file alfa
-#if defined(CERNLIB_QFIASC)
- CHFILE = 'AIO'
-* file native
-#endif
-#if defined(CERNLIB_QFINDAN)
- CHFILE = 'IO'
-* file exchange, data native
-#endif
-#if defined(CERNLIB_QFIXDAN)
- CHFILE = 'XNIO'
-#endif
-#if (defined(CERNLIB_QFIXDAN))&&(defined(CERNLIB_QMIBM)||defined(CERNLIB_QMIBMD))
- CHFILE = 'FXNIO'
-* file exchange, data exchange
-#endif
-#if defined(CERNLIB_QFIXDAX)
- CHFILE = 'XIO'
-#endif
-#if (defined(CERNLIB_QFIXDAX))&&(defined(CERNLIB_QMIBM)||defined(CERNLIB_QMIBMD))
- CHFILE = 'FXIO'
-* file direct, data native
-#endif
-#if defined(CERNLIB_QFIDDAN)
- CHFILE = 'DNIO'
-* file direct, data exchange
-#endif
-#if defined(CERNLIB_QFIDDAX)
- CHFILE = 'DIO'
-* file channel, data native
-#endif
-#if defined(CERNLIB_QFICDAN)
- CHFILE = 'CNIO'
-* file channel, data exchange
-#endif
-#if defined(CERNLIB_QFICDAX)
- CHFILE = 'CIO'
-* file library C, data native
-#endif
-#if defined(CERNLIB_QFILDAN)
- CHFILE = 'LNIO'
-* file library C, data exchange
-#endif
-#if defined(CERNLIB_QFILDAX)
- CHFILE = 'LIO'
-* file library C random, data native
-#endif
-#if defined(CERNLIB_QFIRDAN)
- CHFILE = 'LDNIO'
-* file library C random, data exchange
-#endif
-#if defined(CERNLIB_QFIRDAX)
- CHFILE = 'LDIO'
-* file memory, data native
-#endif
-#if defined(CERNLIB_QFIMDAN)
- CHFILE = 'MNIO'
-* file memory, data exchange
-#endif
-#if defined(CERNLIB_QFIMDAX)
- CHFILE = 'MIO'
-#endif
-
- LUNT1 = 11
- LUNT2 = 12
- LUNT3 = 13
-
- INTAPE = 0
- NWREC = 0
- LEVOUT = 0
- LEVIN = 0
- MINPR = 19
- MAXPR = 1
-C- MAXMAK = 255 is the maximum
- MAXMAK = 24
- MKBREA = 71
-
-C-- Execution options :
-C- IFLXQ(1) : print FZINFO results
-C- IFLXQ(2) : FQMAKE : rewind the file,
-C- skip to end-of-run and continue writing
-C- IFLXQ(3) : write place-holder for the Direct Access Table
-C- IFLXQ(4) : save the Direct Access Table
-C- IFLXQ(5) : reset DAT forward ref. record to null
-C- IFLXQ(6) : running in 'memory' mode
-
-#if defined(CERNLIB_QFIXDANY)
- IFLXQ(2) = 7
- IFLXQ(3) = 7
- IFLXQ(4) = 7
-#endif
-#if defined(CERNLIB_QFIDDANY)||defined(CERNLIB_QFIRDANY)
- IFLXQ(3) = 7
- IFLXQ(4) = 7
-#endif
-#if defined(CERNLIB_QFIMDANY)
- IFLXQ(6) = 7
-#endif
-
-#include "test_include/maxmak.inc"
-* Ignoring t=pass
-
- WRITE (IQLOG,9011) CHFILE, MAXMAK
- 9011 FORMAT (1X/' *!!!!!! Test of FZ with option ',A/
- F' *!!!!',I9,' used for MAXMAK')
-
-C---------- Create the FZ file --------------
-
- IF (INTAPE.NE.0) GO TO 41
-
-#if defined(CERNLIB_QFINDAN)
-C-- Test first closing of unused files
- CALL FQUNUS
-#endif
-
-C---- Delete the file if it exists
-
- LUNFZ = LUNT1
- INQUIRE (FILE=FQNAME(1), EXIST=THERE)
- IF (.NOT.THERE) GO TO 24
- OPEN (LUNFZ,FILE=FQNAME(1),STATUS='OLD',ERR=23,FORM=CHFM)
- 23 CLOSE (LUNFZ,STATUS='DELETE',ERR=24)
- 24 CONTINUE
-
-C---- Open the file
-
- CHCL = 'w+ '
- CHST = 'NEW'
- JF = 1
-#include "fqtopmk.inc"
-* Ignoring t=pass
-#include "fqtest/fqtopen.inc"
-#if defined(CERNLIB_QFILDANY)||defined(CERNLIB_QFIRDANY)
- IQUEST(1) = LUNPTR(JF)
-#endif
- CALL FZFILE (LUNFZ, NWREC, CHFILE)
-#if defined(CERNLIB_QFICDANY)
- CALL FZHOOK (LUNFZ, FQCPUT, NIL)
-#endif
-#if defined(CERNLIB_QFIMDANY)
- CALL FZMEMO (LUNFZ,MEMBUF,NMEMOR)
-#endif
-
-C---- Write the file
-
- CALL FQMAKE
-#if defined(CERNLIB_QFIXDANY)
- CALL FZRUN (LUNFZ,-1,0,0)
-#endif
-
-C---- Close the file
-
- CALL FQRSET (-1,0)
-#if defined(CERNLIB_QFIDDANY)||defined(CERNLIB_QFILDANY)
- CALL FZENDO (LUNFZ,'TX')
-#endif
- CALL FZENDO (0,'TX')
- CALL FQTINF (0)
-
-#if defined(CERNLIB_QFICDANY)||defined(CERNLIB_QFIMDANY)
- CLOSE (LUNFZ)
-#endif
-
-C---------- Read back --------------
-
- 41 LOGLEV = LEVIN
-#if (!defined(CERNLIB_QFANOUT))&&(!defined(CERNLIB_QFANCOP))
- NLUNT = 1
-#endif
-#if defined(CERNLIB_QFANOUT)||defined(CERNLIB_QFANCOP)
- NLUNT = 3
-#endif
-
-C---- Open the file(s) for read-back
-
- DO 49 JF=1,NLUNT
- LUNFZ = LUNTV(JF)
- IF (JF.NE.1) GO TO 43
- CHCL = 'r '
- CHST = 'OLD'
-#include "fqtopbk.inc"
-* Ignoring t=pass
- GO TO 47
-
- 43 CHCL = 'w+ '
- CHST = 'NEW'
- INQUIRE (FILE=FQNAME(JF), EXIST=THERE)
- IF (.NOT.THERE) GO TO 46
- OPEN (LUNFZ,FILE=FQNAME(JF),STATUS='OLD',ERR=45,FORM=CHFM)
- 45 CLOSE (LUNFZ,STATUS='DELETE',ERR=46)
- 46 CONTINUE
-#include "fqtopmk.inc"
-* Ignoring t=pass
-
- 47 CONTINUE
-#include "fqtest/fqtopen.inc"
-#if defined(CERNLIB_QFILDANY)||defined(CERNLIB_QFIRDANY)
- IQUEST(1) = LUNPTR(JF)
-#endif
- CALL FZFILE (LUNFZ, NWREC, CHFILE)
-#if defined(CERNLIB_QFICDANY)
- CALL FZHOOK (LUNFZ, FQCGET, NIL)
-#endif
-#if defined(CERNLIB_QFIMDANY)
- CALL FZMEMO (LUNFZ,MEMBUF,NMEMOR)
-#endif
- CALL FZLOGL (LUNFZ,LOGLEV)
- 49 CONTINUE
-
-C---- Read back
-
-#if (!defined(CERNLIB_QFANOUT))&&(!defined(CERNLIB_QFANCOP))&&(!defined(CERNLIB_QRANDOM))
- CALL FQBACK
-#endif
-#if defined(CERNLIB_QFANOUT)
- CALL FQBKFA
-#endif
-#if defined(CERNLIB_QFANCOP)
- CALL FQBKCO
-#endif
-#if defined(CERNLIB_QRANDOM)
- CALL FQBKRA
-#endif
- RETURN
- END
-* ==================================================
-#include "zebra/qcardl.inc"
diff --git a/src/packlib/zebra/test/fqtest/fqtinf.F b/src/packlib/zebra/test/fqtest/fqtinf.F
deleted file mode 100644
index f067a66..0000000
--- a/src/packlib/zebra/test/fqtest/fqtinf.F
+++ /dev/null
@@ -1,52 +0,0 @@
-*
-* $Id: fqtinf.F,v 1.1.1.1 1996/03/06 10:47:02 mclareni Exp $
-*
-* $Log: fqtinf.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:02 mclareni
-* Zebra
-*
-*
-#include "test_include/pilot.h"
- SUBROUTINE FQTINF (LUN)
-
-C- Call FZINFO for LUN, if not zero
-C- Dump the FZSTAT information
-C- FQTINF operates only if the IFLXQ(1) flag is set
-
-#include "zebra/zunit.inc"
-#include "test_include/testll.inc"
-#include "test_include/testdd.inc"
-#include "test_include/testiq.inc"
-#include "test_include/testee.inc"
-#include "zebra/fzstat.inc"
-C-------------- END CDE --------------
-
-
- IF (IFLXQ(1).EQ.0) RETURN
-
- WRITE (IQPRNT,9001) LUN
- 9001 FORMAT (1X/' FQTINF',I3,' :'/)
-
-C-- Call FZINFO only if LUN is not zero
-C- for dumping the status as left by FZENDO
-
- IF (LUN.NE.0) CALL FZINFO (LUN)
-
- WRITE (IQPRNT,9011) INFLUN
- 9011 FORMAT (10X,'INFLUN =',I4)
-
- IF (INFLUN.EQ.0) RETURN
-
- WRITE (IQPRNT,9012) INFSTA
- 9012 FORMAT (10X,'INFSTA =',Z17,' hex')
-
- WRITE (IQPRNT,9013)
- 9013 FORMAT (10X,'INFOFZ =')
-
- WRITE (IQPRNT,9014) (INFOFZ(J),J,J=1,24)
- 9014 FORMAT ((10X,5(I10,I3)))
-
- RETURN
- END
-* ==================================================
-#include "zebra/qcardl.inc"
diff --git a/src/packlib/zebra/test/fqtest/fqtopbk.inc b/src/packlib/zebra/test/fqtest/fqtopbk.inc
deleted file mode 100644
index dfc3369..0000000
--- a/src/packlib/zebra/test/fqtest/fqtopbk.inc
+++ /dev/null
@@ -1,40 +0,0 @@
-*
-* $Id: fqtopbk.inc,v 1.1.1.1 1996/03/06 10:47:01 mclareni Exp $
-*
-* $Log: fqtopbk.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:01 mclareni
-* Zebra
-*
-*
-*
-* fqtopbk.inc
-*
-#if defined(CERNLIB_QMIBM)
-#if defined(CERNLIB_QFIXDANY)
- CALL FILEINF (IBMRC, 'RECFM','F', 'LRECL',3600)
-#endif
-#endif
-*
-* fqtopbk.inc
-*
-#if defined(CERNLIB_QMIBM)
-#if defined(CERNLIB_QFIDDANY)
- CALL FILEINF (IBMRC, 'MAXREC', 600)
-#endif
-#endif
-*
-* fqtopbk.inc
-*
-#if defined(CERNLIB_QMIBMD)
-#if defined(CERNLIB_QFIXDANY)
- CALL FILEINF (IBMRC, 'RECFM','F', 'LRECL',3600)
-#endif
-#endif
-*
-* fqtopbk.inc
-*
-#if defined(CERNLIB_QMIBMD)
-#if defined(CERNLIB_QFIDDANY)
- CALL FILEINF (IBMRC, 'MAXREC', 600)
-#endif
-#endif
diff --git a/src/packlib/zebra/test/fqtest/fqtopen.inc b/src/packlib/zebra/test/fqtest/fqtopen.inc
deleted file mode 100644
index b8fda43..0000000
--- a/src/packlib/zebra/test/fqtest/fqtopen.inc
+++ /dev/null
@@ -1,126 +0,0 @@
-*
-* $Id: fqtopen.inc,v 1.3 1997/09/02 15:16:18 mclareni Exp $
-*
-* $Log: fqtopen.inc,v $
-* Revision 1.3 1997/09/02 15:16:18 mclareni
-* WINNT corrections
-*
-* Revision 1.2 1997/03/14 17:22:19 mclareni
-* WNT mods
-*
-* Revision 1.1.1.1.2.1 1997/01/21 11:34:08 mclareni
-* All mods for Winnt 96a on winnt branch
-*
-* Revision 1.1.1.1 1996/03/06 10:47:01 mclareni
-* Zebra
-*
-*
-*
-* fqtopen.inc
-*
-#if defined(CERNLIB_QMALT)
-# if defined(CERNLIB_QFIXDANY)
- OPEN (LUNFZ,FILE=FQNAME(JF),STATUS=CHST,FORM=CHFM,
- + RECORDTYPE='FIXED',BLOCKSIZE=3600,RECL=3600)
-# endif
-
-#elif defined(CERNLIB_QMAPO)
-# if defined(CERNLIB_QFIMDANY)
- OPEN (LUNFZ,FILE=FQNAME(JF),STATUS=CHST,FORM=CHFM,RECL=40000)
-# elif defined(CERNLIB_QFINDAN)||defined(CERNLIB_QFICDANY)
- OPEN (LUNFZ,FILE=FQNAME(JF),STATUS=CHST,FORM=CHFM,RECL=10000)
-# elif defined(CERNLIB_QFIXDANY)
- OPEN (LUNFZ,FILE=FQNAME(JF),STATUS=CHST,FORM=CHFM,RECL=3600)
-# endif
-
-#elif defined(CERNLIB_QMCRY)
-# if defined(CERNLIB_QFIDDAN)
- OPEN (LUNFZ,FILE=FQNAME(JF),STATUS=CHST,FORM=CHFM,
- + ACCESS='DIRECT',RECL=7200)
-# endif
-
-#elif defined(CERNLIB_QMCV64)
-# if defined(CERNLIB_QFIXDAN)
- OPEN (LUNFZ,FILE=FQNAME(JF),STATUS=CHST,FORM=CHFM,
- + RECORDTYPE='FIXED',BLOCKSIZE=7200,RECL=7200)
-# elif defined(CERNLIB_QFIXDAX)
- OPEN (LUNFZ,FILE=FQNAME(JF),STATUS=CHST,FORM=CHFM,
- + RECORDTYPE='FIXED',BLOCKSIZE=3600,RECL=3600)
-# elif defined(CERNLIB_QFIDDAN)
- OPEN (LUNFZ,FILE=FQNAME(JF),STATUS=CHST,FORM=CHFM,
- + ACCESS='DIRECT',RECL=7200)
-# endif
-
-#elif defined(CERNLIB_QMCV32)
-# if defined(CERNLIB_QFIXDAN)
- OPEN (LUNFZ,FILE=FQNAME(JF),STATUS=CHST,FORM=CHFM,
- + RECORDTYPE='FIXED',BLOCKSIZE=3600,RECL=3600)
-# elif defined(CERNLIB_QFIXDAX)
- OPEN (LUNFZ,FILE=FQNAME(JF),STATUS=CHST,FORM=CHFM,
- + RECORDTYPE='FIXED',BLOCKSIZE=3600,RECL=3600)
-# elif defined(CERNLIB_QFIDDAN)
- OPEN (LUNFZ,FILE=FQNAME(JF),STATUS=CHST,FORM=CHFM,
- + ACCESS='DIRECT',RECL=3600)
-# endif
-
-#elif defined(CERNLIB_QMDOS) || defined(CERNLIB_WINNT)
-# if (defined(CERNLIB_QFIXDANY))&&(defined(CERNLIB_QF2C) || (defined(CERNLIB_WINNT) && !defined(_ALPHA_)))
- OPEN (LUNFZ,FILE=FQNAME(JF),STATUS=CHST,FORM=CHFM,
- + BLOCKSIZE=3600,RECL=3600)
-# elif (defined(CERNLIB_QFIXDANY))&&(defined(CERNLIB_QFDEC))&&(defined(_ALPHA_))
- OPEN (LUNFZ,FILE=FQNAME(JF),STATUS=CHST,FORM=CHFM,
- + RECL=900)
-# elif (defined(CERNLIB_QFIMDAX))
-# if defined(CERNLIB_QFDEC) && defined(_ALPHA_)
- OPEN (LUNFZ,FILE=FQNAME(JF),STATUS=CHST,FORM=CHFM,
- + RECL=900)
-# else
- OPEN (LUNFZ,FILE=FQNAME(JF),STATUS=CHST,FORM=CHFM,
- + RECL=3600)
-# endif
-# elif (defined(CERNLIB_QFINDAN))
-# if defined(CERNLIB_QFDEC) && defined(_ALPHA_)
- OPEN (LUNFZ,FILE=FQNAME(JF),STATUS=CHST,FORM=CHFM,
- + RECL=900)
-# else
- OPEN (LUNFZ,FILE=FQNAME(JF),STATUS=CHST,FORM=CHFM,
- + RECL=3600)
-# endif
-# elif defined(CERNLIB_QFIDDANY)
- OPEN (LUNFZ,FILE=FQNAME(JF),STATUS=CHST,FORM=CHFM,
- + ACCESS='DIRECT',RECL=3600)
-# elif defined(CERNLIB_QFILDANY)||defined(CERNLIB_QFIRDANY)
- CALL CFOPEN (LUNPTR(JF), 0, 900, CHCL, 0, FQNAME(JF), ISTAT)
-# elif 1
-# if defined(CERNLIB_QFIDDANY)
- OPEN (LUNFZ,FILE=FQNAME(JF),STATUS=CHST,FORM=CHFM,
- + ACCESS='DIRECT',RECL=3600)
-# elif defined(CERNLIB_QFILDANY)||defined(CERNLIB_QFIRDANY)
- CALL CFOPEN (LUNPTR(JF), 0, 900, CHCL, 0, FQNAME(JF), ISTAT)
-# elif 1
- OPEN (LUNFZ,FILE=FQNAME(JF),STATUS=CHST,FORM=CHFM)
-# endif
-#endif
-
-#elif defined(CERNLIB_QMVAX)
-# if defined(CERNLIB_QFIXDANY)
- OPEN (LUNFZ,FILE=FQNAME(JF),STATUS=CHST,FORM=CHFM,
- + RECORDTYPE='FIXED',BLOCKSIZE=3600,RECL=900)
-# elif defined(CERNLIB_QFIDDANY)
- OPEN (LUNFZ,FILE=FQNAME(JF),STATUS=CHST,FORM=CHFM,
- + ACCESS='DIRECT',RECL=900)
-# elif defined(CERNLIB_QFILDANY)||defined(CERNLIB_QFIRDANY)
- CALL CFOPEN (LUNPTR(JF), 0, 900, CHCL, 0, FQNAME(JF), ISTAT)
-# elif 1
- OPEN (LUNFZ,FILE=FQNAME(JF),STATUS=CHST,FORM=CHFM)
-# endif
-#elif 1
-# if defined(CERNLIB_QFIDDANY)
- OPEN (LUNFZ,FILE=FQNAME(JF),STATUS=CHST,FORM=CHFM,
- + ACCESS='DIRECT',RECL=3600)
-# elif defined(CERNLIB_QFILDANY)||defined(CERNLIB_QFIRDANY)
- CALL CFOPEN (LUNPTR(JF), 0, 900, CHCL, 0, FQNAME(JF), ISTAT)
-# elif 1
- OPEN (LUNFZ,FILE=FQNAME(JF),STATUS=CHST,FORM=CHFM)
-# endif
-#endif
diff --git a/src/packlib/zebra/test/fqtest/fqtopmk.inc b/src/packlib/zebra/test/fqtest/fqtopmk.inc
deleted file mode 100644
index a485329..0000000
--- a/src/packlib/zebra/test/fqtest/fqtopmk.inc
+++ /dev/null
@@ -1,50 +0,0 @@
-*
-* $Id: fqtopmk.inc,v 1.1.1.1 1996/03/06 10:47:01 mclareni Exp $
-*
-* $Log: fqtopmk.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:01 mclareni
-* Zebra
-*
-*
-*
-* fqtopmk.inc
-*
-#if defined(CERNLIB_QMIBM)
-#if defined(CERNLIB_QFIASC)
- CALL FILEINF (IBMRC, 'RECFM','F', 'LRECL',80)
-#endif
-#endif
-#if defined(CERNLIB_QMIBM)
-#if defined(CERNLIB_QFIXDANY)
- CALL FILEINF (IBMRC, 'RECFM','F', 'LRECL',3600)
-#endif
-#endif
-*
-* fqtopmk.inc
-*
-#if defined(CERNLIB_QMIBM)
-#if defined(CERNLIB_QFIDDANY)
- CALL FILEINF (IBMRC, 'MAXREC', 600)
-#endif
-#endif
-*
-* fqtopmk.inc
-*
-#if defined(CERNLIB_QMIBMD)
-#if defined(CERNLIB_QFIASC)
- CALL FILEINF (IBMRC, 'RECFM','F', 'LRECL',80)
-#endif
-#endif
-#if defined(CERNLIB_QMIBMD)
-#if defined(CERNLIB_QFIXDANY)
- CALL FILEINF (IBMRC, 'RECFM','F', 'LRECL',3600)
-#endif
-#endif
-*
-* fqtopmk.inc
-*
-#if defined(CERNLIB_QMIBMD)
-#if defined(CERNLIB_QFIDDANY)
- CALL FILEINF (IBMRC, 'MAXREC', 600)
-#endif
-#endif
diff --git a/src/packlib/zebra/test/fqtest/fqunus.F b/src/packlib/zebra/test/fqtest/fqunus.F
deleted file mode 100644
index 1626858..0000000
--- a/src/packlib/zebra/test/fqtest/fqunus.F
+++ /dev/null
@@ -1,36 +0,0 @@
-*
-* $Id: fqunus.F,v 1.1.1.1 1996/03/06 10:47:02 mclareni Exp $
-*
-* $Log: fqunus.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:02 mclareni
-* Zebra
-*
-*
-#include "test_include/pilot.h"
- SUBROUTINE FQUNUS
-
-C- Test closing of unused files
-
-#include "zebra/zunit.inc"
-#include "test_include/fqtlun.inc"
-C-------------- END CDE ---------------
-
- WRITE (IQLOG,9001)
- 9001 FORMAT (1X/' FQUNUS. ------ Test closing of unused files ----')
-
- CALL FZFILE (LUNT2, 0, 'IO')
- CALL FZFILE (LUNT1, 0, 'IO')
-
- CALL FZENDI (LUNT2,'T')
- CALL FZENDO (LUNT1,'T')
-
- CALL FZFILE (LUNT2, 0, 'IO')
- CALL FZENDI (LUNT2,'T')
-
- WRITE (IQLOG,9004)
- 9004 FORMAT (1X/' FQUNUS. ---------------- End of test'/)
-
- RETURN
- END
-* ==================================================
-#include "zebra/qcardl.inc"
diff --git a/src/packlib/zebra/test/fqtest/qcomds.F b/src/packlib/zebra/test/fqtest/qcomds.F
deleted file mode 100644
index 81dddb7..0000000
--- a/src/packlib/zebra/test/fqtest/qcomds.F
+++ /dev/null
@@ -1,215 +0,0 @@
-*
-* $Id: qcomds.F,v 1.3 1997/03/14 17:22:20 mclareni Exp $
-*
-* $Log: qcomds.F,v $
-* Revision 1.3 1997/03/14 17:22:20 mclareni
-* WNT mods
-*
-* Revision 1.2.2.1 1997/01/21 11:34:09 mclareni
-* All mods for Winnt 96a on winnt branch
-*
-* Revision 1.2 1996/04/18 16:14:33 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:02 mclareni
-* Zebra
-*
-*
-#include "test_include/pilot.h"
- SUBROUTINE QCOMDS (JMODEP,LOGLEV)
-
-#include "zebra/zunit.inc"
-#include "zebra/mzcn.inc"
-#include "zebra/mzbits.inc"
-#include "zebra/quest.inc"
-#include "zebra/mzca.inc"
-#include "zebra/mzcb.inc"
-#include "zebra/mzcc.inc"
-#include "test_include/testll.inc"
-#include "test_include/testdd.inc"
-#include "test_include/testiq.inc"
-#include "test_include/testee.inc"
-C-------------- END CDE --------------
-
-#include "zebra/q_jbit.inc"
-
- JMODE = JMODEP
- NLREC = M(62)
- NPHREC = M(63)
- JMAKE = M(64)
-
- 10 NBANKS = 0
- LHNEX = LQSTA(KQT+3)
- LHEND = LQEND(KQT+3)
- LHSTA4= LQSTA(KQT+4)
- LHEND4= LQEND(KQT+4)
-
- LMNEX = LQSTA(KQT+1)
- LMEND = LQEND(KQT+1)
- LMSTA2= LQSTA(KQT+2)
- LMGO = 0
- IF (JMODE-1) 11,13,15
-
-C-- LOW + HIGH BANKS
-
- 11 LMGO = LQSTA(KQT+2)
- LMEND2= LQEND(KQT+2)
- GO TO 31
-
-C-- HIGH BANKS ONLY
-
- 13 LMNEX = LQSTA(KQT+2)
- LMEND = LQEND(KQT+2)
- GO TO 31
-
-C-- LOW BANKS ONLY
-
- 15 CONTINUE
-
-C------- POSITION NEXT BANK TO COMPARE
-
- 31 JSW = -777
- JL = 0
- LH = LHNEX
- IF (LH.GE.LHEND) THEN
- IF (LHEND.EQ.LHEND4) GO TO 32
- LHNEX = LHSTA4
- LHEND = LHEND4
- GO TO 31
- ENDIF
-
- CALL MZCHLN (-7,LH)
- IF (IQFOUL.NE.0) GO TO 93
- LSH = IQLS
- LHNEX = IQNX
- IF (JBIT(IQ(LSH),IQDROP).NE.0) GO TO 31
-
- 32 LM = LMNEX
- IF (LM.LT.LMEND) GO TO 33
- IF (LH.GE.LHEND) GO TO 81
- IF (LMGO.EQ.0) GO TO 92
- LM = LMGO
- LMEND = LMEND2
- LMGO = 0
-
- 33 CALL MZCHLN (-7,LM)
- IF (IQFOUL.NE.0) GO TO 93
- LSM = IQLS
- LMNEX = IQNX
- IF (JBIT(IQ(LSM),IQDROP).NE.0) GO TO 32
-
- IF (LH.GE.LHEND) GO TO 92
- NBANKS= NBANKS + 1
-
-C------- COMPARE HAVE-BANK TO MUST-BANK
-
-C-- CHECK SAME BANKS NAME
-
- IF (IQ(LSM-5).NE.IQ(LSH-5)) GO TO 93
- IF (IQ(LSM-4).NE.IQ(LSH-4)) GO TO 93
- IF (IQ(LSM-3).NE.IQ(LSH-3)) GO TO 93
- IF (IQ(LSM-2).NE.IQ(LSH-2)) GO TO 93
- IF (IQ(LSM-1).NE.IQ(LSH-1)) GO TO 93
-
-C-- CHECK LINKS POINT TO SAME BANKS
-
- JSW = 0
-
- DO 49 JL=0,IQNL
- LLM = LQ(LSM-JL)
- LLH = LQ(LSH-JL)
- IF (LLH.NE.0) GO TO 47
- IF (LLM.EQ.0) GO TO 49
- IF (JBIT(IQ(LLM),IQDROP).NE.0) GO TO 49
-
-C-- CHECK POINTING TO LOW BANK AND MODE=1
-
- IF (LLM.GE.LMSTA2) GO TO 44
- IF (JMODE.EQ.1) GO TO 49
- GO TO 92
-
-C-- CHECK POINTING TO HIGH BANK AND MODE = 2
-
- 44 IF (JMODE.EQ.2) GO TO 49
- GO TO 92
-
- 47 IF (IQ(LLM-5).NE.IQ(LLH-5)) GO TO 92
- 49 CONTINUE
-
-C---- COMPARE DATA-PARTS OF CURRENT BANK
-
- JSW = 7
-
-C-- compare integer/floating start region of the bank
-
- N = MIN (50,IQND)
-
- DO 52 JL=1,N
- IF (IQ(JL+LSM).NE.IQ(JL+LSH)) GO TO 93
- 52 CONTINUE
-
-C-- compare left half of double pre. numbers in bank D1 only
-
- IF (IQND.LT.60) GO TO 59
- IF (IQ(LSM-5).NE.15) GO TO 55
-
- DO 54 JL=51,60,2
- IF (IQ(JL+LSM).NE.IQ(JL+LSH)) GO TO 93
- 54 CONTINUE
-
-C---- compare fractional fl.p. numbers in words 61-70
-
- 55 IF (IQND.LT.61) GO TO 59
- N = MIN (70,IQND)
-
- DO 56 JL=61,N
- DIFF = Q(JL+LSM) - Q(JL+LSH)
- IF (DIFF.EQ.0.) GO TO 56
- SUM = Q(JL+LSM) + Q(JL+LSH)
- IF (DIFF/SUM.GT.1.0E-5) GO TO 93
- 56 CONTINUE
- 59 CONTINUE
- GO TO 31
-
-C------- EXIT OK
-
- 81 IF (LOGLEV.LE.0) RETURN
- WRITE (IQLOG,9081) NBANKS,NLREC,NPHREC,JMAKE
- 9081 FORMAT (5X,I5,' Banks compare ok after',2I6,' L/Ph records,'
- F,' JMAKE=',I4)
- RETURN
-
-C---- COMPARISON FAILS
-
- 92 IF (JBIT(IQ(LSH),IQDROP).EQ.0) GO TO 93
- CALL MZGARB (IXSTOR+21,0)
-* CALL MZGARB (IXSTOR+21) There was a bug here ??? V.Fine 10/05/96
- GO TO 10
-
- 93 CALL VZERO (IQUEST(1),50)
- IQUEST(1) = LH
- IQUEST(2) = LHNEX
- IQUEST(3) = LHEND
- IQUEST(4) = LM
- IQUEST(5) = LMNEX
- IQUEST(6) = LMEND
-
- IQUEST(11) = JMODE
- IQUEST(12) = LSH
- IQUEST(13) = LSM
- IQUEST(14) = IQ(LSH-5)
- IQUEST(15) = IQ(LSM-5)
- IQUEST(16) = IQ(LSH-4)
- IQUEST(17) = IQ(LSM-4)
- IQUEST(18) = JSW
- IQUEST(20) = JL
-
- IF (JSW.LT.0) GO TO 99
- IF (JSW.EQ.0) JL= -JL-8
- IQUEST(21) = IQ(LSH+JL)
- IQUEST(22) = IQ(LSM+JL)
-
- 99 CALL ZFATAM ('QCOMDS - BAD COMPARE.')
- END
-* ==================================================
-#include "zebra/qcardl.inc"
diff --git a/src/packlib/zebra/test/jqtest/Imakefile b/src/packlib/zebra/test/jqtest/Imakefile
deleted file mode 100644
index dfcf46d..0000000
--- a/src/packlib/zebra/test/jqtest/Imakefile
+++ /dev/null
@@ -1,22 +0,0 @@
-SRCS_F= jqtest.F taa1.F taaa.F tbb1.F tbb2.F tbbb.F tcc1.F \ @@\
- tccc.F tjidle.F tjmuan.F tjmufl.F tjwsp.F
-
-#ifdef CERNLIB_HPUX
-SpecialFortranLibObjectRule(jqtest,jqtest,'-WF,-P',NullParameter)
-SpecialFortranLibObjectRule(taa1,taa1,'-WF,-P',NullParameter)
-SpecialFortranLibObjectRule(taaa,taaa,'-WF,-P',NullParameter)
-SpecialFortranLibObjectRule(tbb1,tbb1,'-WF,-P',NullParameter)
-SpecialFortranLibObjectRule(tbb2,tbb2,'-WF,-P',NullParameter)
-SpecialFortranLibObjectRule(tbbb,tbbb,'-WF,-P',NullParameter)
-SpecialFortranLibObjectRule(tcc1,tcc1,'-WF,-P',NullParameter)
-SpecialFortranLibObjectRule(tccc,tccc,'-WF,-P',NullParameter)
-SpecialFortranLibObjectRule(tjmuan,tjmuan,'-WF,-P',NullParameter)
-SpecialFortranLibObjectRule(tjmufl,tjmufl,'-WF,-P',NullParameter)
-SpecialFortranLibObjectRule(tjwsp,tjwsp,'-WF,-P',NullParameter)
-#endif
-
-#if defined(CERNLIB_QMIRIX64)
-EXTRA_INCLUDES=-I$(CVSCOSRC)/packlib/zebra/test/jqtest
-#endif
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/zebra/test/jqtest/jqtest.F b/src/packlib/zebra/test/jqtest/jqtest.F
deleted file mode 100644
index af2dd8e..0000000
--- a/src/packlib/zebra/test/jqtest/jqtest.F
+++ /dev/null
@@ -1,94 +0,0 @@
-*
-* $Id: jqtest.F,v 1.1.1.1 1996/03/06 10:47:02 mclareni Exp $
-*
-* $Log: jqtest.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:02 mclareni
-* Zebra
-*
-*
-#include "test_include/pilot.h"
- SUBROUTINE JQTEST
-
-C- Test processors control routine, level 0
-
- CHARACTER CHNAME*4
- PARAMETER (CHNAME = 'ROOT')
-
-#include "zebra/quest.inc"
-#include "test_include/testla.inc"
-#include "test_include/testll.inc"
-#include "tejqdd.inc"
-#include "test_include/testiq.inc"
-#include "test_include/testee.inc"
-#include "zebra/jzuc.inc"
-C-------------- End CDE --------------
-
- PARAMETER ( NLOOP = 48 )
-
- DIMENSION MUSTAN(20), MUSTFL(10), LISTEX(6)
- DATA MUSTAN / 4, 1, 2, 3, 4, 15*0 /
- DATA MUSTFL / 0, 1, 2, 3, 4, 5, 4*0 /
- DATA LISTEX / 5, 4,8, 4,10, 0 /
-
-
-C---- Initialize the test store
-
- CALL CQSTOR (0)
- CALL CQDIVI (2)
- CALL MZLOGL (0,0)
-
-C-- Lift a structure
-
- CALL CQLODS (0,0)
- CALL UCOPY (LA1,LAREX,12)
- CALL UCOPY (LB4,LAREY,12)
- CALL MZWIPE (IXSTOR+1)
-
-C-- Read the titles
-
- CALL TZINIT (16,IXDV19)
-
- CALL JZINIT (IXSTOR, CHNAME, 'T', 2,4,10, LISTEX)
-
- IF (IQUEST(1).LT.0) CALL UCOPY (MUSTAN(2),IQ(LQAN+1),IQ(LQAN))
-
- CALL JZSETF ('TBBB', 3, 77)
-
- CALL MZWORK (IXSTOR, LIWSXX,MWSP(16), 0)
- CALL UCOPY (LC1,LX1,4)
- CALL UCOPY (MUSTFL,LIWSXX,4)
-
- DO 49 JLOOP=1,NLOOP
-
- CALL TAAA
- CALL TJMUAN (CHNAME,MUSTAN)
- CALL TJMUFL (CHNAME,MUSTFL)
- CALL TJWSP (CHNAME,LIWSXX,MWSP(16), LC1, MUSTFL)
-
- CALL TBBB
- CALL TJMUAN (CHNAME,MUSTAN)
- CALL TJMUFL (CHNAME,MUSTFL)
- CALL TJWSP (CHNAME,LIWSXX,MWSP(16), LC1, MUSTFL)
-
- CALL JZZERO (0,2)
-
- CALL TCCC
- CALL TJMUAN (CHNAME,MUSTAN)
- CALL TJMUFL (CHNAME,MUSTFL)
- CALL TJWSP (CHNAME,LIWSXX,MWSP(16), LC1, MUSTFL)
-
- CALL TBBB
- CALL TJMUAN (CHNAME,MUSTAN)
- CALL TJMUFL (CHNAME,MUSTFL)
- CALL TJWSP (CHNAME,LIWSXX,MWSP(16), LC1, MUSTFL)
-
- IF (JLOOP.EQ.24) CALL JZTRAC (0)
-
- 49 CONTINUE
- CALL TJIDLE (40)
-
- CALL JZEND
- RETURN
- END
-* ==================================================
-#include "zebra/qcardl.inc"
diff --git a/src/packlib/zebra/test/jqtest/taa1.F b/src/packlib/zebra/test/jqtest/taa1.F
deleted file mode 100644
index fc7f6df..0000000
--- a/src/packlib/zebra/test/jqtest/taa1.F
+++ /dev/null
@@ -1,48 +0,0 @@
-*
-* $Id: taa1.F,v 1.1.1.1 1996/03/06 10:47:02 mclareni Exp $
-*
-* $Log: taa1.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:02 mclareni
-* Zebra
-*
-*
-#include "test_include/pilot.h"
- SUBROUTINE TAA1
-
-C- Test processor level 2
-
- CHARACTER CHNAME*4
- PARAMETER (CHNAME = 'TAA1')
-
-#include "zebra/zunit.inc"
-#include "zebra/quest.inc"
-#include "test_include/testla.inc"
-#include "test_include/testll.inc"
-#include "tejqdd.inc"
-#include "test_include/testiq.inc"
-#include "test_include/testee.inc"
-#include "zebra/jzuc.inc"
-C-------------- End CDE --------------
- DIMENSION MUSTAN(20), MUSTFL(10)
-
- DATA MUSTAN / 3, 11, 12, 13, 16*0 /
- DATA MUSTFL / 111, 112, 113, 114, 115, 5*0 /
-
-
- CALL JZIN (CHNAME, 0, 3, 0)
-
- CALL MZWORK (IXSTOR, LIWSXX,MWSP(24), 0)
-
- CALL TJMUAN (CHNAME,MUSTAN)
- CALL TJMUFL (CHNAME,MUSTFL)
-
- NENT = IQ(LQSV+2)
- CALL JZTELL (NENT/4)
-
- CALL TJIDLE (4)
-
- CALL JZOUT (CHNAME)
- RETURN
- END
-* ==================================================
-#include "zebra/qcardl.inc"
diff --git a/src/packlib/zebra/test/jqtest/taaa.F b/src/packlib/zebra/test/jqtest/taaa.F
deleted file mode 100644
index 15e9d23..0000000
--- a/src/packlib/zebra/test/jqtest/taaa.F
+++ /dev/null
@@ -1,65 +0,0 @@
-*
-* $Id: taaa.F,v 1.1.1.1 1996/03/06 10:47:02 mclareni Exp $
-*
-* $Log: taaa.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:02 mclareni
-* Zebra
-*
-*
-#include "test_include/pilot.h"
- SUBROUTINE TAAA
-
-C- Test processor level 1
-
- CHARACTER CHNAME*4
- PARAMETER (CHNAME = 'TAAA')
-
-#include "zebra/zunit.inc"
-#include "zebra/quest.inc"
-#include "test_include/testla.inc"
-#include "test_include/testll.inc"
-#include "tejqdd.inc"
-#include "test_include/testiq.inc"
-#include "test_include/testee.inc"
-#include "zebra/jzuc.inc"
-C-------------- End CDE --------------
- DIMENSION MUSTAN(20), MUSTFL(10), LISTEX(4)
-
- DATA MUSTAN / 1, 10, 18*0 /
- DATA MUSTFL / 1, 2, 3, 4, 5, 5*0 /
- DATA LISTEX / 3, 12, 4,4 /
-
-
- CALL JZIN (CHNAME, 1, 1, LISTEX)
-
-#if defined(CERNLIB_TESTLOG)
- IF (IQUEST(1).EQ.0) CALL JZLOG ('A')
-#endif
-
- CALL MZWORK (IXSTOR, MWSP(3),MWSP(24), 0)
- CALL UCOPY (LA1,LX1,4)
- CALL UCOPY (MUSTFL,MWSP(3),4)
-
- CALL TJMUAN (CHNAME,MUSTAN)
- CALL TJMUFL (CHNAME,MUSTFL)
-
- NENT = IQ(LQSV+2)
- CALL JZTELL (NENT/4)
-
- CALL TJIDLE (4)
-
-#if defined(CERNLIB_TESTLOG)
- IF (NENT.EQ.3) CALL JZLOG ('TAX')
- IF (NENT.EQ.4) CALL JZLOG ('.')
-#endif
-
- CALL TAA1
- CALL TJMUAN (CHNAME,MUSTAN)
- CALL TJMUFL (CHNAME,MUSTFL)
- CALL TJWSP (CHNAME,MWSP(3),MWSP(24), LA1, MUSTFL)
-
- CALL JZOUT (CHNAME)
- RETURN
- END
-* ==================================================
-#include "zebra/qcardl.inc"
diff --git a/src/packlib/zebra/test/jqtest/tbb1.F b/src/packlib/zebra/test/jqtest/tbb1.F
deleted file mode 100644
index 89b62d3..0000000
--- a/src/packlib/zebra/test/jqtest/tbb1.F
+++ /dev/null
@@ -1,50 +0,0 @@
-*
-* $Id: tbb1.F,v 1.1.1.1 1996/03/06 10:47:02 mclareni Exp $
-*
-* $Log: tbb1.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:02 mclareni
-* Zebra
-*
-*
-#include "test_include/pilot.h"
- SUBROUTINE TBB1
-
-C- Test processor level 2
-
- CHARACTER CHNAME*4
- PARAMETER (CHNAME = 'TBB1')
-
-#include "zebra/zunit.inc"
-#include "zebra/quest.inc"
-#include "test_include/testla.inc"
-#include "test_include/testll.inc"
-#include "tejqdd.inc"
-#include "test_include/testiq.inc"
-#include "test_include/testee.inc"
-#include "zebra/jzuc.inc"
-C-------------- End CDE --------------
- DIMENSION MUSTAN(20), MUSTFL(10)
-
- DATA MUSTAN / 4, 21, 22, 23, 24, 15*0 /
- DATA MUSTFL / 211, 212, 213, 214, 215, 5*0 /
-
-
- CALL JZIN (CHNAME, 0, 4, 0)
-
- CALL MZWORK (IXSTOR, LIWSXX,MWSP(24), 0)
-
- CALL TJMUAN (CHNAME,MUSTAN)
- CALL TJMUFL (CHNAME,MUSTFL)
-
- NENT = IQ(LQSV+2)
- CALL JZTELL (NENT/4)
-
- CALL TJIDLE (1)
-
- IF (NENT.EQ.124) CALL JZTRAC (0)
-
- CALL JZOUT (CHNAME)
- RETURN
- END
-* ==================================================
-#include "zebra/qcardl.inc"
diff --git a/src/packlib/zebra/test/jqtest/tbb2.F b/src/packlib/zebra/test/jqtest/tbb2.F
deleted file mode 100644
index 340ce00..0000000
--- a/src/packlib/zebra/test/jqtest/tbb2.F
+++ /dev/null
@@ -1,54 +0,0 @@
-*
-* $Id: tbb2.F,v 1.1.1.1 1996/03/06 10:47:02 mclareni Exp $
-*
-* $Log: tbb2.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:02 mclareni
-* Zebra
-*
-*
-#include "test_include/pilot.h"
- SUBROUTINE TBB2
-
-C- Test processor level 2
-
- CHARACTER CHNAME*4
- PARAMETER (CHNAME = 'TBB2')
-
-#include "zebra/zunit.inc"
-#include "zebra/quest.inc"
-#include "test_include/testla.inc"
-#include "test_include/testll.inc"
-#include "tejqdd.inc"
-#include "test_include/testiq.inc"
-#include "test_include/testee.inc"
-#include "zebra/jzuc.inc"
-C-------------- End CDE --------------
- DIMENSION MUSTAN(20), MUSTFL(10)
-
- DATA MUSTAN / 3, 22, 23, 24, 16*0 /
- DATA MUSTFL / 221, 222, 223, 224, 225, 5*0 /
-
-
- CALL JZIN (CHNAME, 0, 3, 0)
- IF (IQUEST(1).LT.0) CALL UCOPY (MUSTAN(2),IQ(LQAN+1),IQ(LQAN))
-
- CALL MZWORK (IXSTOR, LIWSXX,MWSP(24), 0)
-
- CALL TJMUAN (CHNAME,MUSTAN)
- CALL TJMUFL (CHNAME,MUSTFL)
-
- NENT = IQ(LQSV+2)
- CALL JZTELL (NENT/4)
-
- IF (NENT.EQ.7) THEN
- CALL JZSETF ('TBBB', 3, 7)
- IQ(LQUP+1) = 7
- ENDIF
-
- CALL TJIDLE (4)
-
- CALL JZOUT (CHNAME)
- RETURN
- END
-* ==================================================
-#include "zebra/qcardl.inc"
diff --git a/src/packlib/zebra/test/jqtest/tbbb.F b/src/packlib/zebra/test/jqtest/tbbb.F
deleted file mode 100644
index 9da6ff2..0000000
--- a/src/packlib/zebra/test/jqtest/tbbb.F
+++ /dev/null
@@ -1,67 +0,0 @@
-*
-* $Id: tbbb.F,v 1.1.1.1 1996/03/06 10:47:02 mclareni Exp $
-*
-* $Log: tbbb.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:02 mclareni
-* Zebra
-*
-*
-#include "test_include/pilot.h"
- SUBROUTINE TBBB
-
-C- Test processor level 1
-
- CHARACTER CHNAME*4
- PARAMETER (CHNAME = 'TBBB')
-
-#include "zebra/zunit.inc"
-#include "zebra/quest.inc"
-#include "test_include/testla.inc"
-#include "test_include/testll.inc"
-#include "tejqdd.inc"
-#include "test_include/testiq.inc"
-#include "test_include/testee.inc"
-#include "zebra/jzuc.inc"
-C-------------- End CDE --------------
- DIMENSION MUSTAN(20), MUSTFL(10), LISTEX(4)
-
- DATA MUSTAN / 2, 20, 21, 17*0 /
- DATA MUSTFL / 2, 3, 77, 5, 6, 5*0 /
- DATA LISTEX / 3, 24, 4,4 /
-
-
- CALL JZIN (CHNAME, 1, 2, LISTEX)
-
- CALL MZWORK (IXSTOR, MWSP,MWSP(48), 0)
- CALL UCOPY (LB1,LX1,4)
- CALL UCOPY (MUSTAN,MWSP,4)
-
- CALL TJMUAN (CHNAME,MUSTAN)
- CALL TJMUFL (CHNAME,MUSTFL)
-
- NENT = IQ(LQSV+2)
- CALL JZTELL (NENT/4)
-
- CALL TJIDLE (4)
-
- CALL TBB1
- CALL TJMUAN (CHNAME,MUSTAN)
- CALL TJMUFL (CHNAME,MUSTFL)
- CALL TJWSP (CHNAME,MWSP,MWSP(48), LB1, MUSTAN)
-
- CALL TBB2
- IF (IQ(LQDW+1).EQ.7) MUSTFL(3) = 7
- CALL TJMUAN (CHNAME,MUSTAN)
- CALL TJMUFL (CHNAME,MUSTFL)
- CALL TJWSP (CHNAME,MWSP,MWSP(48), LB1, MUSTAN)
-
- CALL TBB1
- CALL TJMUAN (CHNAME,MUSTAN)
- CALL TJMUFL (CHNAME,MUSTFL)
- CALL TJWSP (CHNAME,MWSP,MWSP(48), LB1, MUSTAN)
-
- CALL JZOUT (CHNAME)
- RETURN
- END
-* ==================================================
-#include "zebra/qcardl.inc"
diff --git a/src/packlib/zebra/test/jqtest/tcc1.F b/src/packlib/zebra/test/jqtest/tcc1.F
deleted file mode 100644
index fbf07be..0000000
--- a/src/packlib/zebra/test/jqtest/tcc1.F
+++ /dev/null
@@ -1,48 +0,0 @@
-*
-* $Id: tcc1.F,v 1.1.1.1 1996/03/06 10:47:02 mclareni Exp $
-*
-* $Log: tcc1.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:02 mclareni
-* Zebra
-*
-*
-#include "test_include/pilot.h"
- SUBROUTINE TCC1
-
-C- Test processor level 2
-
- CHARACTER CHNAME*4
- PARAMETER (CHNAME = 'TCC1')
-
-#include "zebra/zunit.inc"
-#include "zebra/quest.inc"
-#include "test_include/testla.inc"
-#include "test_include/testll.inc"
-#include "tejqdd.inc"
-#include "test_include/testiq.inc"
-#include "test_include/testee.inc"
-#include "zebra/jzuc.inc"
-C-------------- End CDE --------------
- DIMENSION MUSTAN(20), MUSTFL(10)
-
- DATA MUSTAN / 5, 31, 32, 33, 34, 35, 14*0 /
- DATA MUSTFL / 311, 312, 313, 314, 315, 5*0 /
-
-
- CALL JZIN (CHNAME, 0, 5, 0)
-
- CALL MZWORK (IXSTOR, LIWSXX,MWSP(24), 0)
-
- CALL TJMUAN (CHNAME,MUSTAN)
- CALL TJMUFL (CHNAME,MUSTFL)
-
- NENT = IQ(LQSV+2)
- CALL JZTELL (NENT/4)
-
- CALL TJIDLE (4)
-
- CALL JZOUT (CHNAME)
- RETURN
- END
-* ==================================================
-#include "zebra/qcardl.inc"
diff --git a/src/packlib/zebra/test/jqtest/tccc.F b/src/packlib/zebra/test/jqtest/tccc.F
deleted file mode 100644
index 1632ae0..0000000
--- a/src/packlib/zebra/test/jqtest/tccc.F
+++ /dev/null
@@ -1,56 +0,0 @@
-*
-* $Id: tccc.F,v 1.1.1.1 1996/03/06 10:47:02 mclareni Exp $
-*
-* $Log: tccc.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:02 mclareni
-* Zebra
-*
-*
-#include "test_include/pilot.h"
- SUBROUTINE TCCC
-
-C- Test processor level 1
-
- CHARACTER CHNAME*4
- PARAMETER (CHNAME = 'TCCC')
-
-#include "zebra/zunit.inc"
-#include "zebra/quest.inc"
-#include "test_include/testla.inc"
-#include "test_include/testll.inc"
-#include "tejqdd.inc"
-#include "test_include/testiq.inc"
-#include "test_include/testee.inc"
-#include "zebra/jzuc.inc"
-C-------------- End CDE --------------
- DIMENSION MUSTAN(20), MUSTFL(10), LISTEX(4)
-
- DATA MUSTAN / 3, 30, 31, 32, 16*0 /
- DATA MUSTFL / 3, 4, 5, 6, 7, 5*0 /
- DATA LISTEX / 3, 7, 4,4 /
-
-
- CALL JZIN (CHNAME, 1, 3, LISTEX)
-
- CALL MZWORK (IXSTOR, MWSP(7),MWSP(24), 0)
- CALL UCOPY (LC1,LX1,4)
- CALL UCOPY (MUSTFL,MWSP(7),4)
-
- CALL TJMUAN (CHNAME,MUSTAN)
- CALL TJMUFL (CHNAME,MUSTFL)
-
- NENT = IQ(LQSV+2)
- CALL JZTELL (NENT/4)
-
- CALL TJIDLE (4)
-
- CALL TCC1
- CALL TJMUAN (CHNAME,MUSTAN)
- CALL TJMUFL (CHNAME,MUSTFL)
- CALL TJWSP (CHNAME,MWSP(7),MWSP(24), LC1, MUSTFL)
-
- CALL JZOUT (CHNAME)
- RETURN
- END
-* ==================================================
-#include "zebra/qcardl.inc"
diff --git a/src/packlib/zebra/test/jqtest/tejqdd.inc b/src/packlib/zebra/test/jqtest/tejqdd.inc
deleted file mode 100644
index f731386..0000000
--- a/src/packlib/zebra/test/jqtest/tejqdd.inc
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: tejqdd.inc,v 1.1.1.1 1996/03/06 10:47:02 mclareni Exp $
-*
-* $Log: tejqdd.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:02 mclareni
-* Zebra
-*
-*
-*
-* tejqdd.inc
-*
- +, LIWSXX(3), MWSP(88)
diff --git a/src/packlib/zebra/test/jqtest/tjidle.F b/src/packlib/zebra/test/jqtest/tjidle.F
deleted file mode 100644
index e1412be..0000000
--- a/src/packlib/zebra/test/jqtest/tjidle.F
+++ /dev/null
@@ -1,30 +0,0 @@
-*
-* $Id: tjidle.F,v 1.1.1.1 1996/03/06 10:47:02 mclareni Exp $
-*
-* $Log: tjidle.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:02 mclareni
-* Zebra
-*
-*
-#include "test_include/pilot.h"
- SUBROUTINE TJIDLE (NIDL)
-
-C- Idle time to make the timing figures sizeable
-
-#include "zebra/quest.inc"
-C-------------- End CDE --------------
- DIMENSION QUEST(100)
- EQUIVALENCE (QUEST(1), IQUEST(1))
-
-
- NL = 10 * NIDL
- DO 27 JL=1,NL
- DO 24 J=1,100
- QUEST(J) = SQRT (REAL(JL+J)) / 10.
- 24 CONTINUE
- CALL VBIAS (QUEST, 12., QUEST, 100)
- 27 CONTINUE
- RETURN
- END
-* ==================================================
-#include "zebra/qcardl.inc"
diff --git a/src/packlib/zebra/test/jqtest/tjmuan.F b/src/packlib/zebra/test/jqtest/tjmuan.F
deleted file mode 100644
index e290684..0000000
--- a/src/packlib/zebra/test/jqtest/tjmuan.F
+++ /dev/null
@@ -1,50 +0,0 @@
-*
-* $Id: tjmuan.F,v 1.1.1.1 1996/03/06 10:47:02 mclareni Exp $
-*
-* $Log: tjmuan.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:02 mclareni
-* Zebra
-*
-*
-#include "test_include/pilot.h"
- SUBROUTINE TJMUAN (CHNAME,MUSTAN)
-
-C- Check the AN parameters are what they should be
-
-#include "zebra/zunit.inc"
-#include "zebra/quest.inc"
-#include "test_include/testla.inc"
-#include "test_include/testll.inc"
-#include "tejqdd.inc"
-#include "test_include/testiq.inc"
-#include "test_include/testee.inc"
-#include "zebra/jzuc.inc"
-C-------------- End CDE --------------
- CHARACTER CHNAME*4
- DIMENSION MUSTAN(20)
-
-
- NAN = MUSTAN(1)
- IF (IQ(LQAN).NE.NAN) GO TO 91
-
- DO 24 JL=1,NAN
- IF (IQ(LQAN+JL).NE.MUSTAN(JL+1)) GO TO 92
- 24 CONTINUE
- RETURN
-
-C---- Faults
-
- 91 WRITE (IQLOG,9091) IQ(LQAN),NAN
- 9091 FORMAT (/' !!! ',5X,'# of parameters have/must =',2I4)
- GO TO 97
-
- 92 WRITE (IQLOG,9092) JL, IQ(LQAN+JL), MUSTAN(JL+1)
- 9092 FORMAT (/' !!! ',5X,'Faulty parameter',I3,
- F' value have/must =',2I4)
-
- 97 WRITE (IQLOG,9097) CHNAME
- 9097 FORMAT (10X,'Fault in processor "',A,' !!!')
- CALL ZFATAL
- END
-* ==================================================
-#include "zebra/qcardl.inc"
diff --git a/src/packlib/zebra/test/jqtest/tjmufl.F b/src/packlib/zebra/test/jqtest/tjmufl.F
deleted file mode 100644
index 7cf8be9..0000000
--- a/src/packlib/zebra/test/jqtest/tjmufl.F
+++ /dev/null
@@ -1,42 +0,0 @@
-*
-* $Id: tjmufl.F,v 1.1.1.1 1996/03/06 10:47:02 mclareni Exp $
-*
-* $Log: tjmufl.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:02 mclareni
-* Zebra
-*
-*
-#include "test_include/pilot.h"
- SUBROUTINE TJMUFL (CHNAME,MUSTFL)
-
-C- Check the FL parameters are what they should be
-
-#include "zebra/zunit.inc"
-#include "zebra/quest.inc"
-#include "test_include/testla.inc"
-#include "test_include/testll.inc"
-#include "tejqdd.inc"
-#include "test_include/testiq.inc"
-#include "test_include/testee.inc"
-#include "zebra/jzuc.inc"
-C-------------- End CDE --------------
- CHARACTER CHNAME*4
- DIMENSION MUSTFL(10)
-
-
- DO 24 JL=1,10
- IF (JQFLAG(JL).NE.MUSTFL(JL)) GO TO 92
- 24 CONTINUE
- RETURN
-
-C---- Faults
-
- 92 WRITE (IQLOG,9092) JL, JQFLAG(JL), MUSTFL(JL)
- 9092 FORMAT (/' !!! ',5X,'Faulty flag',I3,' value have/must =',2I4)
-
- 97 WRITE (IQLOG,9097) CHNAME
- 9097 FORMAT (10X,'Fault in processor "',A,' !!!')
- CALL ZFATAL
- END
-* ==================================================
-#include "zebra/qcardl.inc"
diff --git a/src/packlib/zebra/test/jqtest/tjwsp.F b/src/packlib/zebra/test/jqtest/tjwsp.F
deleted file mode 100644
index aca7563..0000000
--- a/src/packlib/zebra/test/jqtest/tjwsp.F
+++ /dev/null
@@ -1,71 +0,0 @@
-*
-* $Id: tjwsp.F,v 1.1.1.1 1996/03/06 10:47:02 mclareni Exp $
-*
-* $Log: tjwsp.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:02 mclareni
-* Zebra
-*
-*
-#include "test_include/pilot.h"
- SUBROUTINE TJWSP (CHNAME,MDATF,MDATL,MULI,MUDA)
-
-C- Check the working space parameters are what they should be
-
-#include "zebra/zunit.inc"
-#include "zebra/quest.inc"
-#include "zebra/mzca.inc"
-#include "zebra/mzcb.inc"
-#include "zebra/mzcc.inc"
-#include "test_include/testla.inc"
-#include "test_include/testll.inc"
-#include "tejqdd.inc"
-#include "test_include/testiq.inc"
-#include "test_include/testee.inc"
-#include "zebra/jzuc.inc"
-C-------------- End CDE --------------
- CHARACTER CHNAME*4
- DIMENSION MDATF(48),MDATL(48),MULI(24),MUDA(24)
- DIMENSION LINKWS(4)
- EQUIVALENCE (LINKWS(1), LX1)
-
-
- NLINK = LOCF (MDATF) - LQSTOR - 1
- NDATA = LOCF (MDATL) - LQSTOR + 1
- NDATX = LQSTA(KQT+1)
-
- IF (NLINK.NE.NQLINK) GO TO 91
- IF (NDATA.NE.NDATX) GO TO 92
-
- DO 24 JL=1,4
- IF (LINKWS(JL).NE.MULI(JL)) GO TO 93
- IF ( MDATF(JL).NE.MUDA(JL)) GO TO 94
- 24 CONTINUE
- RETURN
-
-C---- Faults
-
- 91 WRITE (IQLOG,9091) NQLINK,NLINK
- 9091 FORMAT (/' !!! ',5X,
- F'Faulty size of wsp links, value have/must =',2I4)
- GO TO 97
-
- 92 WRITE (IQLOG,9092) NDATX,NDATA
- 9092 FORMAT (/' !!! ',5X,
- F'Faulty size of wsp data, value have/must =',2I4)
- GO TO 97
-
- 93 WRITE (IQLOG,9093) JL, LINKWS(JL), MULI(JL)
- 9093 FORMAT (/' !!! ',5X,'Faulty wsp link',I2,' value have/must =',
- F2I7)
- GO TO 97
-
- 94 WRITE (IQLOG,9094) JL, MDATF(JL), MUDA(JL)
- 9094 FORMAT (/' !!! ',5X,'Faulty wsp data',I2,' value have/must =',
- F2I7)
-
- 97 WRITE (IQLOG,9097) CHNAME
- 9097 FORMAT (10X,'Fault in processor "',A,' !!!')
- CALL ZFATAL
- END
-* ==================================================
-#include "zebra/qcardl.inc"
diff --git a/src/packlib/zebra/test/jztest.data b/src/packlib/zebra/test/jztest.data
deleted file mode 100644
index 6e69a43..0000000
--- a/src/packlib/zebra/test/jztest.data
+++ /dev/null
@@ -1,33 +0,0 @@
-*DO JZAN
- :TAAA 10
-*DO JZAN
- :TBBB 20 21
-*DO JZAN
- :TCCC 30 31 32
-*DO JZAN
- :TAA1 11 12 13
-*DO JZAN
- :TBB1 21 22 23 24
-*DO JZAN
- :TCC1 31 32 33 34 35
-
-*DO JZFL
- :ROOT 0 1 2 3 4 5
-*DO JZFL
- :TAAA 1 2 3 4 5 :END
- :TBBB 2 3 4 5 6 :END
-*DO JZFL
- :TCCC 3 4 5 6 7
-*DO JZFL
- :TAA1 111 112 113 114 115 :END
- :TBB1 211 212 213 214 215 :END
- :TBB2 221 222 223 224 225 :END
-*DO JZFL
- :TCC1 311 312 313 314 315
-
-*DO JZAN #. test redundant title
- :TAA1 1 1 1 2 1 3
-*DO JZFL #. test redundant title
- :TAA1 71 72 73 74 75 :END
- :TBB1 81 82 83 84 85 :END
- :TBB2 91 92 93 94 95
diff --git a/src/packlib/zebra/test/mzcote/Imakefile b/src/packlib/zebra/test/mzcote/Imakefile
deleted file mode 100644
index 92333e5..0000000
--- a/src/packlib/zebra/test/mzcote/Imakefile
+++ /dev/null
@@ -1,8 +0,0 @@
-SRCS_F= mzcote.F
-
-#ifdef CERNLIB_HPUX
-SpecialFortranLibObjectRule(mzcote,mzcote,'-WF,-P',NullParameter)
-#endif
-
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/zebra/test/mzcote/mzcote.F b/src/packlib/zebra/test/mzcote/mzcote.F
deleted file mode 100644
index 2d7eb65..0000000
--- a/src/packlib/zebra/test/mzcote/mzcote.F
+++ /dev/null
@@ -1,233 +0,0 @@
-*
-* $Id: mzcote.F,v 1.1.1.1 1996/03/06 10:47:00 mclareni Exp $
-*
-* $Log: mzcote.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:00 mclareni
-* Zebra
-*
-*
- SUBROUTINE MZCOTE
-
-C- standard test of MZCOPY + MZATTM
-
-#include "zebra/zstate.inc"
-#include "zebra/zunit.inc"
-#include "zebra/mzbits.inc"
-#include "zebra/quest.inc"
-#include "test_include/testla.inc"
-#include "test_include/testll.inc"
-#include "test_include/testdd.inc"
-#include "test_include/testiq.inc"
-#include "test_include/testee.inc"
-C-------------- END CDE --------------
- COMMON /SECSTO/SECFEN(4),LSMAIN,SECST(6000)
- DIMENSION BUF(10000), TABLE(400)
-
-
-#include "zebra/q_jbit.inc"
-
-C NQDEVZ = 7
-
- CALL MZSTOR (IXSTOR,'//', '.', FENCE
- +, LQ,LA1,LX1,LQ(NQLIM2),IQ(NQN))
-
- CALL MZLOGL (IXSTOR,1)
- CALL MZWORK (IXSTOR,M,DLAST,0)
- CALL VZERO (LQUSER,150)
-
- CALL MZDIV (IXSTOR,IXDV3,'DIV3',4000,6000, '.')
- CALL MZDIV (IXSTOR,IXDV4,'DIV4', 100, 100, 'R')
- IXWIPE = IXDV3
-
- CALL MZSTOR (IXSTSE,'SECSTO', '.', SECFEN
- +, LSMAIN,SECST,SECST,SECST(2000),SECST(6000))
- IXDVSE = IXSTSE+2
-
- IXMEM = 0
-
- CALL CQBKIN
- LOGLEV = 0
- LOGCOM = 0
- CALL MZLOGL (IXSTOR,LOGLEV)
-
- CALL ZPHASE (1)
-
- NCOUNT = 0
- MINPR = 19
- MAXPR = 1
-C! MAXMAK = 255 maximum
- MAXMAK = 24
- M(8) = 8
-
-
- JMAKE = 0
-
-#include "test_include/maxmak.inc"
-* Ignoring t=pass
-
- 21 CONTINUE
- IF (LOGLEV.GT.0) CALL MZLOGL (IXSTOR,0)
-
- CALL CQHIDS (JMAKE,3)
-
- JSNAP = 0
- IF ((JMAKE.GE.MINPR) .AND. (JMAKE.LT.MAXPR)) JSNAP = 7
- IF (JSNAP.NE.0) CALL DZSNAP ('OUT',IXSTOR,'MW.')
-
- IF (LOGLEV.GT.0) CALL MZLOGL (IXSTOR,LOGLEV)
-
-C------ 'L' from div 1+2 -> 3 direct
-
-CD IF (JMAKE.LT.2) THEN
-CD NQLOGD = 2
-CD NQDEVZ = 7
-CD ENDIF
- M(9) = 900
- CALL MZCOPY (IXSTOR, LQMAIN, IXSTOR+3,LQUSER,1, 'L')
- IF (IQUEST(1).NE.0) GO TO 91
- M(62) = 1
- M(63) = 0
- M(64) = JMAKE
- IF (JSNAP.GT.0) CALL DZSNAP ('INLHIG',IXSTOR,'WM.')
- CALL QCOMDS (0,LOGCOM)
- NCOUNT = NCOUNT + 1
-CD NQLOGD = 0
-CD NQDEVZ = 0
- CALL MZWIPE (IXWIPE)
-
-C------ 'D' from div 2 -> 3 via secondary div 2
-
-CD IF (JMAKE.LT.2) THEN
-CD NQLOGD = 2
-CD NQDEVZ = 7
-CD ENDIF
- M(9) = 901
- CALL MZCOPY (IXSTOR+2,LQMAIN, IXDVSE, LSMAIN,1, 'D')
- IF (IQUEST(1).NE.0) GO TO 91
-
- CALL MZCOPY (IXDVSE, LSMAIN, IXSTOR+3,LQUSER,1, 'D')
- IF (IQUEST(1).NE.0) GO TO 91
- M(62) = 2
- M(63) = 0
- M(64) = JMAKE
- IF (JSNAP.GT.0) CALL DZSNAP ('INHIGH',IXSTOR,'WM.')
- CALL QCOMDS (1,LOGCOM)
- NCOUNT = NCOUNT + 1
-CD NQLOGD = 0
-CD NQDEVZ = 0
- CALL MZWIPE (IXDVSE)
- CALL MZWIPE (IXWIPE)
-
-C------ 'L' from div 1 -> 3 direct
-
- IF (LL1.EQ.0) GO TO 28
- IF (JBIT(IQ(LL1),IQDROP).NE.0) GO TO 28
-CD IF (JMAKE.LT.2) THEN
-CD NQLOGD = 2
-CD NQDEVZ = 7
-CD ENDIF
- M(9) = 902
- CALL MZCOPY (IXSTOR+1,LL1, IXSTOR+3,LQUSER,1, 'L')
- IF (IQUEST(1).NE.0) GO TO 91
- M(62) = 3
- M(63) = 0
- M(64) = JMAKE
- IF (JSNAP.GT.0) CALL DZSNAP ('INLOW ',IXSTOR,'WM.')
- CALL QCOMDS (2,LOGCOM)
- NCOUNT = NCOUNT + 1
-CD NQLOGD = 0
-CD NQDEVZ = 0
- CALL MZWIPE (IXWIPE)
-
-C------ 'LT' from div 1+2 -> 3 via BUF, off-set zero
-
- 28 CONTINUE
-CD IF (JMAKE.LT.2) THEN
-CD NQLOGD = 2
-CD NQDEVZ = 7
-CD ENDIF
- M(9) = 903
- IQUEST(3) = 10000
- IQUEST(4) = 0
- CALL MZCOPY (IXSTOR, LQMAIN, BUF,LENTRY,NWTO, 'LT')
- IF (IQUEST(1).NE.0) GO TO 91
-
- IQUEST(1) = NWTO
- IQUEST(2) = 0
- CALL MZCOPY (BUF, LENTRY, IXSTOR+3,LQUSER,1, 'F')
- IF (IQUEST(1).NE.0) GO TO 91
- M(62) = 4
- M(63) = 1
- M(64) = JMAKE
- IF (JSNAP.GT.0) CALL DZSNAP ('INLHIG',IXSTOR,'WM.')
- CALL QCOMDS (0,LOGCOM)
- NCOUNT = NCOUNT + 1
-CD NQLOGD = 0
-CD NQDEVZ = 0
- CALL MZWIPE (IXWIPE)
-
-C------ 'DT' from div 2 -> 3 via BUF, off-set 12
-
-CD IF (JMAKE.LT.2) THEN
-CD NQLOGD = 2
-CD NQDEVZ = 7
-CD ENDIF
- M(9) = 904
- IQUEST(3) = 10000
- IQUEST(4) = 12
- CALL MZCOPY (IXSTOR+2,LQMAIN, BUF,LENTRY,NWTO, 'DT')
- IF (IQUEST(1).NE.0) GO TO 91
-
- IQUEST(1) = NWTO
- IQUEST(2) = 12
- CALL MZCOPY (BUF, LENTRY, IXSTOR+3,LQUSER,1, 'F')
- IF (IQUEST(1).NE.0) GO TO 91
- M(62) = 5
- M(63) = 1
- M(64) = JMAKE
- IF (JSNAP.GT.0) CALL DZSNAP ('INHIGH',IXSTOR,'WM.')
- CALL QCOMDS (1,LOGCOM)
- NCOUNT = NCOUNT + 1
-CD NQLOGD = 0
-CD NQDEVZ = 0
- CALL MZWIPE (IXWIPE)
-
-C------ 'LT' from div 1+2 -> 3 via Attached store
-
-CD IF (JMAKE.LT.2) THEN
-CD NQLOGD = 2
-CD NQDEVZ = 7
-CD ENDIF
- M(9) = 905
- IQUEST(3) = 10000
- IQUEST(4) = 0
- CALL MZCOPY (IXSTOR, LQMAIN, BUF,LENTRY,NWTO, 'LT')
- IF (IQUEST(1).NE.0) GO TO 91
-
- CALL MZATTM (IXMEM,'ATTACH',BUF,1,NWTO,0,' ',TABLE)
- CALL MZCOPY (IXMEM+1, LENTRY, IXSTOR+3,LQUSER,1, 'DI')
- IF (IQUEST(1).NE.0) GO TO 91
- M(62) = 6
- M(63) = 2
- M(64) = JMAKE
- IF (JSNAP.GT.0) CALL DZSNAP ('INLHIG',IXSTOR,'WM.')
- CALL QCOMDS (0,LOGCOM)
- NCOUNT = NCOUNT + 1
-CD NQLOGD = 0
-CD NQDEVZ = 0
-
- CALL MZWIPE (IXSTOR+21)
- JMAKE = JMAKE + 1
- IF (JMAKE.LT.MAXMAK) GO TO 21
-
- WRITE (IQLOG,9081) NCOUNT
- 9081 FORMAT (1X/1X,I8,' data-structures copied and compared.')
- RETURN
-
-C---- Copy failed
-
- 91 CALL ZFATAM ('MZCOTE - failed.')
- RETURN
- END
-* ==================================================
-#include "zebra/qcardl.inc"
diff --git a/src/packlib/zebra/test/readmain/Imakefile b/src/packlib/zebra/test/readmain/Imakefile
deleted file mode 100644
index 2361be4..0000000
--- a/src/packlib/zebra/test/readmain/Imakefile
+++ /dev/null
@@ -1,3 +0,0 @@
-SRCS_F= rdmain.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/zebra/test/readmain/rdmain.F b/src/packlib/zebra/test/readmain/rdmain.F
deleted file mode 100644
index 4508d7b..0000000
--- a/src/packlib/zebra/test/readmain/rdmain.F
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: rdmain.F,v 1.1.1.1 1996/03/06 10:47:04 mclareni Exp $
-*
-* $Log: rdmain.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:04 mclareni
-* Zebra
-*
-*
- PROGRAM RDMAIN
-
-#include "zebra/zheadp.inc"
-#include "zebra/zmach.inc"
-#include "zebra/znatur.inc"
-#include "zebra/zstate.inc"
-#include "zebra/zunit.inc"
-C-------------- END CDE --------------
-
- DIMENSION LISTIN(4)
-
-
- DATA LISTIN / 3, 1,-1, 0 /
-
-
- CALL MZEBRA (LISTIN)
- CALL MZVERS
-
-
- CALL FQREAD
- CALL ZEND
- END
-* ==================================================
-#include "zebra/qcardl.inc"
diff --git a/src/packlib/zebra/test/rztest/Imakefile b/src/packlib/zebra/test/rztest/Imakefile
deleted file mode 100644
index 3af24ad..0000000
--- a/src/packlib/zebra/test/rztest/Imakefile
+++ /dev/null
@@ -1,3 +0,0 @@
-SRCS_F= dzrt.F main.F rzcget.F rzt.F rztin.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/zebra/test/rztest/dzrt.F b/src/packlib/zebra/test/rztest/dzrt.F
deleted file mode 100644
index 15aeae3..0000000
--- a/src/packlib/zebra/test/rztest/dzrt.F
+++ /dev/null
@@ -1,196 +0,0 @@
-*
-* $Id: dzrt.F,v 1.1.1.1 1996/03/06 10:47:04 mclareni Exp $
-*
-* $Log: dzrt.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:04 mclareni
-* Zebra
-*
-*
-#if defined(CERNLIB_INTER)
-#include "test_include/pilot.h"
- SUBROUTINE DZRT(NCOM,NPAR)
-*
-********************************************************************************
-* *
-* Dispatching routine for the RZ interactive test program *
-* Debug menu *
-* *
-* Author : R.Brun *
-* Written : 02.04.86 *
-* Last mod: 26.04.86 *
-* *
-********************************************************************************
-*
- COMMON/CRZT/IXSTOR,IXDIV,IFENCE(2),LEV,LEVIN,BLVECT(20000)
- DIMENSION LQ(999),IQ(999),Q(999)
- EQUIVALENCE (IQ(1),Q(1),LQ(9)),(LQ(1),LEV)
-C
-#include "zebra/rzclun.inc"
-* COMMON/RZCLUN/LUN,LREC,ISAVE,NHPWD,IHPWD(2)
-C
- CHARACTER*4 NAME
- CHARACTER*32 CHOPT
-*
-* ---------------------------------------------------------------------
-*
- CALL ZCBRON
-C
- GO TO (10,20,30,40,50,60,70,80,90,100,110,120,130,140
- + ,150),NCOM
-C
-C DZSURV
-C
- 10 CONTINUE
- IPRINT=2
- GO TO 41
-C
-C DZSNAP
-C
- 20 CONTINUE
- IDIV=2
- IF(NPAR.GT.0)CALL ZCGETI(' Give division number $ ',IDIV)
- CHOPT='M'
- IF(NPAR.GT.1)CALL ZCGETC('$',CHOPT,NCH)
- CALL DZSNAP('DZSNAP',IDIV,CHOPT)
- GO TO 99
-C
-C DZVERI
-C
- 30 CONTINUE
- IDIV=0
- IF(NPAR.GT.0)CALL ZCGETI('$',IDIV)
- CHOPT='CLSU'
- IF(NPAR.GT.1)CALL ZCGETC('$',CHOPT,NCH)
- CALL DZVERI('DZVERI',IDIV,CHOPT)
- GO TO 99
-C
-C DZSHOW
-C
- 40 CONTINUE
- IPRINT=1
- 41 NUMBER=0
- IXSTOR=0
- CALL UCTOH('U ',IFORM,4,4)
- CALL ZCGETC('BANK NAME $',NAME,NCH)
- IF(NPAR.GT.1)CALL ZCGETI('$',NUMBER)
- LOC=LZLOC(IXSTOR,NAME,NUMBER)
- IF(LOC.LE.0)GO TO 99
- IF(IPRINT.EQ.2)THEN
- CALL DZSURV('DZSURV',IXSTOR,LOC)
- ENDIF
- IF(IPRINT.EQ.1)THEN
- CHOPT='BHV'
- IF(NPAR.GT.2)CALL ZCGETC('$',CHOPT,NCH)
- CALL DZSHOW('DZBANK',IXSTOR,LOC,CHOPT,0,0,0,0)
- ENDIF
- GO TO 99
-C
-C DZLINK
-C
- 50 CONTINUE
- IXSTOR=0
- CHOPT=' '
- IF(NPAR.GT.0)CALL ZCGETC('$',CHOPT,NCH)
- CALL DZLINK('DZLINK',IXSTOR,CHOPT)
- GO TO 99
-C
-C DZSTOR
-C
- 60 CONTINUE
- IXSTOR=0
- CALL DZSTOR('DZSTOR',IXSTOR)
- GO TO 99
-C
-C MZLOGL
-C
- 70 CONTINUE
- IXSTOR=0
- LEVEL=0
- CALL ZCGETI(' GIVE LOG LEVEL ===> $',LEVEL)
- CALL MZLOGL(IXSTOR,LEVEL)
- GO TO 99
-C
-C MZBOOK
-C
- 80 IF(LEV.EQ.0)THEN
- CALL MZBOOK(IXSTOR,LEV,LEV,1,'LEV1',0,0,10,2,0)
- ENDIF
- NDATA=IQ(LEV-1)
- CALL ZCGETI(' Give number of data words $ ',ND)
- NPUSH=ND-NDATA
- IF(NPUSH.NE.0)CALL MZPUSH(IXSTOR,LEV,0,NPUSH,'I')
- DO 81 I=1,ND
- IQ(LEV+I)=I
- 81 CONTINUE
- GO TO 99
-C
-C PZIN
-C
- 90 CONTINUE
- CALL DZSHOW('PZIN',IXSTOR,LEVIN,'BHV',0,0,0,0)
- GO TO 99
-C
-C SDIVISION
-C
- 100 CONTINUE
- IF(NPAR.GT.0)CALL ZCGETI('$',IDIV)
- GO TO 99
-C
-C ZFREE
-C
- 110 CONTINUE
- LUNP=LUN
- IF(NPAR.GT.0)CALL ZCGETI('$',LUNP)
- LOC=LZLOC(20,'RZFR',LUNP)
- IF(LOC.NE.0)CALL DZSHOW('FREE RECORDS',20,LOC,'BHV',0,0,0,0)
- GO TO 99
-C
-C ZUSED
-C
- 120 CONTINUE
- LUNP=LUN
- IF(NPAR.GT.0)CALL ZCGETI('$',LUNP)
- LOC=LZLOC(20,'RZUS',LUNP)
- IF(LOC.NE.0)CALL DZSHOW('USED RECORDS',20,LOC,'BHV',0,0,0,0)
- GO TO 99
-C
-C ZPURG
-C
- 130 CONTINUE
- LUNP=LUN
- IF(NPAR.GT.0)CALL ZCGETI('$',LUNP)
- LOC=LZLOC(20,'RZPU',LUNP)
- IF(LOC.NE.0)CALL DZSHOW('PURGED RECORDS',20,LOC,'BHV',0,0,0,0)
- GO TO 99
-C
-C ZNEWD
-C
- 140 CONTINUE
- GO TO 99
-C
-C BTREE
-C
- 150 CONTINUE
- IF(LEV.NE.0)THEN
- CALL MZDROP(IXSTOR,LEV,' ')
- ENDIF
- NLEV=10
- IF(NPAR.GT.0)CALL ZCGETI('$',NLEV)
- IMODE=1
- IF(NPAR.GT.1)CALL ZCGETI('$',IMODE)
- IF(NLEV.GT.500)NLEV=500
- CALL MZBOOK(IXSTOR,LEV,LEV,1,'LEV1',NLEV+1,NLEV,10,2,0)
- DO 152 I=1,NLEV
- NWORDS=I
- IF(IMODE.NE.1)NWORDS=I*I
- CALL MZBOOK(IXSTOR,LBANK,LEV,-I,'LEV2',1,0,NWORDS,2,0)
- DO 151 J=1,I
- IQ(LBANK+J)=J
- 151 CONTINUE
- 152 CONTINUE
- LQ(LEV-NLEV-1)=LBANK
- GO TO 99
-C
- 99 CALL ZCBROF
- END
-#endif
diff --git a/src/packlib/zebra/test/rztest/main.F b/src/packlib/zebra/test/rztest/main.F
deleted file mode 100644
index ee8e939..0000000
--- a/src/packlib/zebra/test/rztest/main.F
+++ /dev/null
@@ -1,119 +0,0 @@
-*
-* $Id: main.F,v 1.1.1.1 1996/03/06 10:47:04 mclareni Exp $
-*
-* $Log: main.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:04 mclareni
-* Zebra
-*
-*
-#if defined(CERNLIB_INTER)
-#include "test_include/pilot.h"
- PROGRAM TEST
-*
-********************************************************************************
-* *
-* Interactive test program for RZ, based on ZCEDEX *
-* Runs on Apollo,VAX and VM *
-* *
-* Author : R.Brun *
-* Written : 02.04.86 *
-* Last mod: 12.04.86 *
-* *
-********************************************************************************
-*
-#if defined(CERNLIB_QMAPO)
- COMMON/CRZT/IXSTOR,IXDIV,IFENCE(2),LEV,LEVIN,BLVECT(500000)
-#endif
-#if defined(CERNLIB_QMVAX)
- COMMON/CRZT/IXSTOR,IXDIV,IFENCE(2),LEV,LEVIN,BLVECT(500000)
-#endif
-#if (!defined(CERNLIB_QMAPO))&&(!defined(CERNLIB_QMVAX))
- COMMON/CRZT/IXSTOR,IXDIV,IFENCE(2),LEV,LEVIN,BLVECT(100000)
-#endif
- DIMENSION LQ(999),IQ(999),Q(999)
- EQUIVALENCE (IQ(1),Q(1),LQ(9)),(LQ(1),LEV)
-C
- COMMON/ZCEDEX/ZZZZ(15000)
- COMMON /ZCTCOM/ IHANDL,ICLNUP(2),ICTPAR,BREAK
- COMMON/RZUSER/NVIN,NVOUT,IV(10000)
-*
-*-----------------------------------------------------------------------
-*
-#if defined(CERNLIB_QMALT)
- OPEN(UNIT=11,FILE='../LIBZC',ACCESS='DIRECT')
- OPEN(UNIT=1,FILE='RZTEST.DAT' ,ACCESS='DIRECT',RECL=4096)
- OPEN(UNIT=2,FILE='RZTEST2.DAT',ACCESS='DIRECT',RECL=2048)
- OPEN(UNIT=3,FILE='RZFZ.DAT',FORM='UNFORMATTED',RECL=10000)
- CALL MZEBRA(-1)
- CALL MZSTOR(IXSTOR,'/CRZT/',' ',IFENCE,LEV,BLVECT(1),BLVECT(1),
- + BLVECT(5000),BLVECT(500000))
-#endif
-#if defined(CERNLIB_QMAPO)
-%INCLUDE '/SYS/INS/PFM.INS.FTN'
- OPEN(UNIT=11,FILE='\LIBZC',ACCESS='DIRECT')
- OPEN(UNIT=1,FILE='RZTEST.DAT' ,ACCESS='DIRECT',RECL=4096)
- OPEN(UNIT=2,FILE='RZTEST2.DAT',ACCESS='DIRECT',RECL=2048)
- OPEN(UNIT=3,FILE='RZFZ.DAT',FORM='UNFORMATTED',RECL=10000)
- CALL MZEBRA(-1)
- CALL MZSTOR(IXSTOR,'/CRZT/',' ',IFENCE,LEV,BLVECT(1),BLVECT(1),
- + BLVECT(5000),BLVECT(500000))
-#endif
-#if defined(CERNLIB_QMVAX)
- OPEN(UNIT=1,FILE='RZTEST.DAT' ,ACCESS='DIRECT',RECL=1024,
- + STATUS='UNKNOWN',SHARED,ORGANIZATION='RELATIVE')
- OPEN(UNIT=2,FILE='RZTEST2.DAT',ACCESS='DIRECT',RECL=512,
- + STATUS='UNKNOWN',SHARED,ORGANIZATION='RELATIVE')
- CALL MZEBRA(-1)
- CALL MZSTOR(IXSTOR,'/CRZT/',' ',IFENCE,LEV,BLVECT(1),BLVECT(1),
- + BLVECT(5000),BLVECT(500000))
-#endif
-#if defined(CERNLIB_QMIBM)
- OPEN(UNIT=1,ACCESS='DIRECT',RECL=4096,STATUS='UNKNOWN')
- OPEN(UNIT=2,ACCESS='DIRECT',RECL=2048,STATUS='UNKNOWN')
- CALL TIMEST(9999.)
- CALL MZEBRA(-1)
- CALL MZSTOR(IXSTOR,'/CRZT/',' ',IFENCE,LEV,BLVECT(1),BLVECT(1),
- + BLVECT(5000),BLVECT(100000))
-#endif
-C
- CALL ZCINIT(15000)
-C=== THIS IS THE SECTION TO HANDLE BREAK, EFFECTIVE ON VAX & APOLLO
- CALL ZCENBR
-C=== END OF BREAK SECTION
-C
-C Creation of test commands
-C
- CALL RZTIN
- NVIN=0
- NVOUT=100
-C
-C AUTOMATIC LOGON ON FILE 11
-C
- CALL ZCLOGO(11)
-#if defined(CERNLIB_QMAPO)
-C
-C BREAK SECTION ONLY FOR APOLLO
-C
- ISTAT=PFM_$CLEANUP(ICLNUP)
-C
-C RECOGNIZE FAULTS, EFFECTIVE ONLY ON APOLLO
-C
- CALL ZCRECF(ISTAT)
-#endif
-C
-C COME BACK HERE FOR EACH NEW COMMAND
-C
- 1 CALL ZCGET(NMENU,NCOM,NPAR)
-C
-C
- IF(NMENU.EQ.1)THEN
- CALL RZT(NCOM,NPAR)
- GO TO 1
- ELSEIF(NMENU.EQ.2)THEN
- CALL DZRT(NCOM,NPAR)
- GO TO 1
- ENDIF
-C
- STOP
- END
-#endif
diff --git a/src/packlib/zebra/test/rztest/rzcget.F b/src/packlib/zebra/test/rztest/rzcget.F
deleted file mode 100644
index 98b2854..0000000
--- a/src/packlib/zebra/test/rztest/rzcget.F
+++ /dev/null
@@ -1,75 +0,0 @@
-*
-* $Id: rzcget.F,v 1.1.1.1 1996/03/06 10:47:04 mclareni Exp $
-*
-* $Log: rzcget.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:04 mclareni
-* Zebra
-*
-*
-#if defined(CERNLIB_INTER)
-#include "test_include/pilot.h"
- SUBROUTINE RZCGET(CHP,NWKEY,CHFORM,CHTAG,KEY)
-*
-********************************************************************************
-* *
-* Routine called by interactive test program to prompt for a key *
-* according to the format CHFORM and key name CHTAG *
-* CHP is the beginning of the prompt *
-* NWKEY the number of keys *
-* Output is returned in array KEY. *
-* Called by RZT *
-* *
-* Author : R.Brun *
-* Written : 25.05.86 *
-* Last mod: 25.05.86 *
-* *
-********************************************************************************
-*
- CHARACTER*(*) CHP,CHFORM
- CHARACTER*8 CHTAG(NWKEY)
- CHARACTER*64 CHPROM
- CHARACTER*64 CHCOPY
- DIMENSION IHPROM(16),KEY(*)
-*
-* ---------------------------------------------------------------------
-*
- I=0
- NCHP=LEN(CHP)
- NCHPL=NCHP
- DO 5 J=NCHPL,1,-1
- IF(CHP(J:J).NE.' ')GO TO 10
- NCHP=J
- 5 CONTINUE
- 10 I=I+1
- IF(I.GT.NWKEY)GO TO 99
- CHPROM=CHP(1:NCHP)//' '//CHTAG(I)//' $ '
- CALL UCTOH(CHPROM,IHPROM,4,64)
- IF(CHFORM(I:I).EQ.'I')THEN
- CALL ZCGETI(IHPROM,KEY(I))
- ELSEIF(CHFORM(I:I).EQ.'B')THEN
- CALL ZCGETI(IHPROM,KEY(I))
- ELSEIF(CHFORM(I:I).EQ.'H')THEN
- NCH=-4
- CALL ZCGETA(IHPROM,KEY(I),NCH)
- ELSE
- K=1
- L=NCHP+9
- CHPROM=CHP(1:NCHP)//' '//CHTAG(I)//' $ '
- DO 20 J=I+1,NWKEY
- IF(CHFORM(J:J).NE.'A')GO TO 30
- K=K+1
- CHCOPY=CHPROM(1:L)//CHTAG(J)//' $ '
- CHPROM=CHCOPY
- L=L+8
- 20 CONTINUE
- 30 NCH=-4*K
- CALL UCTOH(CHPROM,IHPROM,4,64)
- CALL VBLANK(KEY(I),K)
- CALL ZCGETA(IHPROM,KEY(I),NCH)
- I=I+K-1
- ENDIF
- GO TO 10
-*
- 99 RETURN
- END
-#endif
diff --git a/src/packlib/zebra/test/rztest/rzt.F b/src/packlib/zebra/test/rztest/rzt.F
deleted file mode 100644
index af7aa7a..0000000
--- a/src/packlib/zebra/test/rztest/rzt.F
+++ /dev/null
@@ -1,418 +0,0 @@
-*
-* $Id: rzt.F,v 1.1.1.1 1996/03/06 10:47:04 mclareni Exp $
-*
-* $Log: rzt.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:04 mclareni
-* Zebra
-*
-*
-#if defined(CERNLIB_INTER)
-#include "test_include/pilot.h"
- SUBROUTINE RZT(NCOM,NPAR)
-*
-********************************************************************************
-* *
-* Dispatching routine for the RZ interactive test program *
-* All RZ routines can be called interactively *
-* *
-* Author : R.Brun *
-* Written : 02.04.86 *
-* Last mod: 22.04.86 *
-* *
-********************************************************************************
-*
- COMMON/RZMEM/IRZMEM(400000)
-C
- COMMON/QUEST/IQUEST(100)
-C
- COMMON/CRZT/IXSTOR,IXDIV,IFENCE(2),LEV,LEVIN,BLVECT(20000)
- DIMENSION LQ(999),IQ(999),Q(999)
- EQUIVALENCE (IQ(1),Q(1),LQ(9)),(LQ(1),LEV)
-C
-C
- COMMON/RZDIR/NLCDIR,NLNDIR,NLPAT,CHCDIR(20),CHNDIR(20),CHPAT(20)
- CHARACTER*64 CHNDIR,CHCDIR,CHPAT
-C
- CHARACTER*64 CHTOP,CHDIR,CHPATH,CHOPT,CHFORM
- CHARACTER*20 CHPROM
- CHARACTER*8 CHLOCK, CHTAG(10),CHPASS
- DIMENSION KEY(10),KEYN(10),IHPROM(10)
- COMMON/RZUSER/NVIN,NVOUT,IV(10000)
-*
-* --------------------------------------------------------------------
-*
- CALL ZCBRON
-C
- GO TO (10,20,30,40,50,60,70,80,90,100,110,120,130,140,
- + 150,160,170,180,190,200,210,220,40,240,250,260,
- + 270,280,290,300,310,320,330,340),NCOM
-C
-C RZMAKE
-C
- 10 CONTINUE
- LUN=1
- CHTOP='RZTEST'
- NREC=1000
- CHOPT=' '
- NWKEY=1
- CALL ZCGETI(' Give logical unit $',LUN)
- CALL ZCGETC(' Give CHTOP $',CHTOP,NCH)
- CALL ZCGETI(' Give NWKEY $',NWKEY)
- IF(NWKEY.LE.0)GO TO 10
- IF(NWKEY.GT.5)GO TO 10
- CALL ZCGETC(' Give CHFORM $',CHFORM,NCH)
- DO 11 I=1,NWKEY
- NCH=-8
- CALL ZCGETC(' Give CHTAG $',CHTAG(I),NCH)
- 11 CONTINUE
- IF(NPAR.GT.NWKEY+4)CALL ZCGETI(' Give NREC $',NREC)
- IF(NPAR.GT.NWKEY+5)CALL ZCGETC(' Give CHOPT $',CHOPT,NCH)
- IF(CHOPT.NE.'M')THEN
- CALL RZMAKE(LUN,CHTOP,NWKEY,CHFORM,CHTAG,NREC,CHOPT)
- ELSE
- IRZMEM(1)=LUN
- CALL RZMAKE(IRZMEM,CHTOP,NWKEY,CHFORM,CHTAG,NREC,CHOPT)
- ENDIF
- GO TO 99
-C
-C RZFILE
-C
- 20 CONTINUE
- LUN=1
- CHTOP='RZTEST'
- CHOPT=' '
- IF(NPAR.GT.0)CALL ZCGETI(' Give logical unit $',LUN)
- IF(NPAR.GT.1)CALL ZCGETC(' Give CHTOP $',CHTOP,NCH)
- IF(NPAR.GT.2)CALL ZCGETC(' Give CHOPT $',CHOPT,NCH)
- IMEM=0
- DO 25 I=1,NCH
- IF(CHOPT(I:I).EQ.'M')IMEM=1
- 25 CONTINUE
- IF(IMEM.NE.0)THEN
- CALL RZFILE(IRZMEM,CHTOP,CHOPT)
- ELSE
- CALL RZFILE(LUN,CHTOP,CHOPT)
- ENDIF
- GO TO 99
-C
-C RZNDIR
-C
- 30 CONTINUE
- IF(NPAR.EQ.0)THEN
- CALL RZNDIR(' ','P')
- ELSE
- CALL ZCGETC(' Give CHPATH $',CHPATH,NCH)
- CALL RZNDIR(CHPATH,' ')
- ENDIF
- GO TO 99
-C
-C RZCDIR
-C
- 40 CONTINUE
- IF(NPAR.EQ.0)THEN
- CALL RZCDIR(' ','P')
- ELSE
- CHOPT=' '
- CALL ZCGETC(' Give CHPATH $',CHPATH,NCH)
- NCH=-4
- IF(NPAR.GT.1)CALL ZCGETC('$',CHOPT,NCH)
- CALL RZCDIR(CHPATH,CHOPT)
- ENDIF
- GO TO 99
-C
-C RZMDIR
-C
- 50 CONTINUE
- CALL ZCGETC(' Give CHDIR $',CHDIR,NCH)
- CALL ZCGETI(' Give NWKEY $',NWKEY)
- IF(NWKEY.LE.0)GO TO 50
- IF(NWKEY.GT.5)GO TO 50
- CALL ZCGETC(' Give CHFORM $',CHFORM,NCH)
- DO 51 I=1,NWKEY
- CALL ZCGETC(' Give CHTAG $',CHTAG(I),NCH)
- 51 CONTINUE
- CALL RZMDIR(CHDIR,NWKEY,CHFORM,CHTAG)
- GO TO 99
-C
-C RZDELT
-C
- 60 CONTINUE
- CALL ZCGETC(' Give CHDIR $',CHDIR,NCH)
- CALL RZDELT(CHDIR)
- GO TO 99
-C
-C RZQUOT
-C
- 70 CONTINUE
- CALL ZCGETI(' Give NQUOTA $',NQUOTA)
- CALL RZQUOT(NQUOTA)
- GO TO 99
-C
-C RZLOCK
-C
- 80 CONTINUE
- CALL ZCGETC(' Give CHLOCK $',CHLOCK,NCH)
- CALL RZLOCK(CHLOCK)
- GO TO 99
-C
-C RZFREE
-C
- 90 CONTINUE
- CALL ZCGETC(' Give CHLOCK $',CHLOCK,NCH)
- CALL RZFREE(CHLOCK)
- GO TO 99
-C
-C RZLDIR
-C
- 100 CONTINUE
- CHOPT=' '
- CHPATH=' '
- IF(NPAR.GT.0)CALL ZCGETC(' Give CHPATH $',CHPATH,NCH)
- IF(NPAR.GT.1)CALL ZCGETC(' Give CHOPT $',CHOPT,NCH)
- CALL RZLDIR(CHPATH,CHOPT)
- GO TO 99
-C
-C RZPURG
-C
- 110 CONTINUE
- NKEEP=1
- IF(NPAR.GT.0)CALL ZCGETI(' Give NKEEP $',NKEEP)
- CALL RZPURG(NKEEP)
- GO TO 99
-C
-C RZDELK
-C
- 120 CONTINUE
- CALL RZKEYD(NWKEY,CHFORM,CHTAG)
- CALL RZCGET('Give ',NWKEY,CHFORM,CHTAG,KEY)
- ICYCLE=9999
- IF(NPAR.GT.NWKEY)CALL ZCGETI('$',ICYCLE)
- CHOPT=' '
- IF(NPAR.GT.NWKEY+1)CALL ZCGETC(' Give CHOPT $ ',CHOPT,NCH)
- CALL RZDELK(KEY,ICYCLE,CHOPT)
- GO TO 99
-C
-C RZCOPY (COPY)
-C
- 130 CONTINUE
- CHPATH=' '
- CHOPT=' '
- CALL ZCGETC(' Give CHPATH $',CHPATH,NCH)
- CALL RZPATH(CHPATH)
- CALL RZFDIR('TEST',LT,LFROM)
- IF(LFROM.EQ.0)GO TO 99
- CALL RZKEYD(NWKEY,CHFORM,CHTAG)
- CALL RZCGET('Give ',NWKEY,CHFORM,CHTAG,KEY)
- CALL UCOPY(KEY,KEYN,NWKEY)
- ICYCLE=9999
- IF(NPAR.GT.NWKEY+1)CALL ZCGETI('$',ICYCLE)
- IF(NPAR.GE.2*NWKEY+2)THEN
- CALL RZCGET('Give ',NWKEY,CHFORM,CHTAG,KEYN)
- ENDIF
- IF(NPAR.GT.2*NWKEY+2)CALL ZCGETA('$',CHOPT,NCH)
- CALL RZCOPY(CHPATH,KEY,ICYCLE,KEYN,CHOPT)
- GO TO 99
-C
-C RZCOPY (CPT)
-C
- 140 CONTINUE
- CHPATH=' '
- CHOPT='TC'
- CALL ZCGETC(' Give CHPATH $ ',CHPATH,NCH)
- IF(NPAR.GT.1) CALL ZCGETC('$',CHOPT,NCH)
- CALL RZCOPY(CHPATH,0,0,0,CHOPT)
- GO TO 99
-C
-C RZEND
-C
- 150 CONTINUE
- CALL ZCGETC(' Give CHDIR $',CHDIR,NCH)
- CALL RZEND (CHDIR)
- GO TO 99
-C
-C RZPATH
-C
- 160 CONTINUE
- CALL ZCGETC(' Give path $ ',CHPATH,NCH)
- CALL RZPATH(CHPATH)
- PRINT 1000,NLPAT,CHPATH,(CHPAT(I),I=1,NLPAT)
- 1000 FORMAT(' NLPAT=',I3,' for Pathname, ',A,/,
- +(A))
- GO TO 99
-C
-C RZLOGL
-C
- 170 CONTINUE
- LUN=1
- LOGLEV=0
- CALL ZCGETI(' Give logical unit $',LUN)
- CALL ZCGETI(' Give LOGLEV $',LOGLEV)
- CALL RZLOGL(LUN,LOGLEV)
- GO TO 99
-C
-C RZOUT
-C
- 180 CONTINUE
- CALL RZKEYD(NWKEY,CHFORM,CHTAG)
- CALL RZCGET('Give ',NWKEY,CHFORM,CHTAG,KEY)
- CHOPT=' '
- IF(NPAR.GT.NWKEY)CALL ZCGETC(' Give CHOPT $ ',CHOPT,NCH)
- CALL RZOUT(IXSTOR,LEV,KEY,ICYCLE,CHOPT)
- GO TO 99
-C
-C RZIN
-C
- 190 CONTINUE
- IF(LEVIN.NE.0)CALL MZDROP(IXSTOR,LEVIN,' ')
- CALL RZKEYD(NWKEY,CHFORM,CHTAG)
- CALL RZCGET('Give ',NWKEY,CHFORM,CHTAG,KEY)
- ICYCLE=9999
- IF(NPAR.GT.NWKEY)CALL ZCGETI(' Give ICYCLE $ ',ICYCLE)
- CHOPT=' '
- IF(NPAR.GT.NWKEY+1)CALL ZCGETC(' Give CHOPT $ ',CHOPT,NCH)
- CALL RZIN(IXSTOR,LEVIN,1,KEY,ICYCLE,CHOPT)
- IF(LEVIN.NE.0)CALL UCTOH('LEVI',IQ(LEVIN-4),4,4)
- GO TO 99
-C
-C RZSAVE
-C
- 200 CALL RZSAVE
- GO TO 99
-C
-C PQUEST
-C
- 210 IQ1=1
- IQ2=20
- IF(NPAR.GT.0)THEN
- CALL ZCGETI('$',IQ1)
- IQ2=IQ1
- ENDIF
- IF(NPAR.GT.1)CALL ZCGETI('$',IQ2)
- DO 211 I=IQ1,IQ2
- PRINT 212,I,IQUEST(I),IQUEST(I)
- 211 CONTINUE
- 212 FORMAT(' IQUEST(',I2,')=',I10,2X,Z8)
- GO TO 99
-C
-C PASSWORD
-C
- 220 IF(NPAR.EQ.0)THEN
- CALL RZPASS(' ',' ')
- ELSE
- NCH=-8
- IF(NPAR.GT.0)CALL ZCGETC('$',CHPASS,NCH)
- CHOPT=' '
- IF(NPAR.GT.1)CALL ZCGETC('$',CHOPT,NCH)
- CALL RZPASS(CHPASS,CHOPT)
- ENDIF
- GO TO 99
-C
-C RZSTAT
-C
- 240 CONTINUE
- NLEVEL=0
- CHOPT=' '
- CHPATH=' '
- NCH=-16
- IF(NPAR.GT.0)CALL ZCGETC(' Give CHPATH $',CHPATH,NCH)
- IF(NPAR.GT.1)CALL ZCGETI(' Give NLEVEL $',NLEVEL)
- IF(NPAR.GT.2)CALL ZCGETC(' Give CHOPT $',CHOPT,NCH)
- CALL RZSTAT(CHPATH,NLEVEL,CHOPT)
- GO TO 99
-C
-C LLOK
-C
- 250 CONTINUE
- CALL RZLLOK
- GO TO 99
-C
-C VOUT
-C
- 260 CONTINUE
- CALL RZKEYD(NWKEY,CHFORM,CHTAG)
- CALL RZCGET('Give ',NWKEY,CHFORM,CHTAG,KEY)
- CHOPT=' '
- IF(NPAR.GT.NWKEY)CALL ZCGETC(' Give CHOPT $ ',CHOPT,NCH)
- CALL RZVOUT(IV,NVOUT,KEY,ICYCLE,CHOPT)
- GO TO 99
-C
-C VIN
-C
- 270 CONTINUE
- CALL RZKEYD(NWKEY,CHFORM,CHTAG)
- CALL RZCGET('Give ',NWKEY,CHFORM,CHTAG,KEY)
- ICYCLE=9999
- IF(NPAR.GT.NWKEY)CALL ZCGETI(' Give ICYCLE $ ',ICYCLE)
- CHOPT=' '
- IF(NPAR.GT.NWKEY+1)CALL ZCGETC(' Give CHOPT $ ',CHOPT,NCH)
- CALL RZVIN(IV,10000,NVIN,KEY,ICYCLE,CHOPT)
- GO TO 99
-C
-C VFILL
-C
- 280 CONTINUE
- NVOUT=100
- CALL ZCGETI(' Give number of words $ ',NVOUT)
- IF(NVOUT.GT.10000)NVOUT=10000
- DO 281 I=1,NVOUT
- IV(I)=I
- 281 CONTINUE
- NVIN=NVOUT
- GO TO 99
-C
-C PVECT
-C
- 290 CONTINUE
- DO 291 I=1,NVIN,10
- I2=I+9
- IF(I2.GT.NVIN)I2=NVIN
- PRINT 292,I,(IV(J),J=I,I2)
- 291 CONTINUE
- 292 FORMAT(I10,2X,10I10)
- GO TO 99
-C
-C TOFZ
-C
- 300 CONTINUE
- CHOPT =' '
- LUNFZ =3
- IF(NPAR.GT.0)CALL ZCGETC('$',CHOPT ,NCH)
- CALL RZTOFZ(LUNFZ,CHOPT)
- GO TO 99
-C
-C FRFZ
-C
- 310 CONTINUE
- CHOPT =' '
- LUNFZ =3
- IF(NPAR.GT.0)CALL ZCGETC('$',CHOPT ,NCH)
- CALL RZFRFZ(LUNFZ,CHOPT)
- GO TO 99
-C
-C FZOPEN
-C
- 320 CONTINUE
- CHOPT='O'
- IF(NPAR.GT.0)CALL ZCGETC('$',CHOPT,NCH)
- CALL FZOPEN(3,0,CHOPT)
- GO TO 99
-C
-C FZEND
-C
- 330 CONTINUE
- CALL FZENDT(3,'EI')
- GO TO 99
-C
-C RENK
-C
- 340 CONTINUE
- CALL RZKEYD(NWKEY,CHFORM,CHTAG)
- CALL RZCGET('Give old ',NWKEY,CHFORM,CHTAG,KEY)
- CALL RZCGET('Give new ',NWKEY,CHFORM,CHTAG,KEYN)
-C
- CALL RZRENK(KEY,KEYN)
- GO TO 99
-C
- 99 CALL ZCBROF
- END
-#endif
diff --git a/src/packlib/zebra/test/rztest/rztin.F b/src/packlib/zebra/test/rztest/rztin.F
deleted file mode 100644
index f0a496e..0000000
--- a/src/packlib/zebra/test/rztest/rztin.F
+++ /dev/null
@@ -1,79 +0,0 @@
-*
-* $Id: rztin.F,v 1.1.1.1 1996/03/06 10:47:04 mclareni Exp $
-*
-* $Log: rztin.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:04 mclareni
-* Zebra
-*
-*
-#if defined(CERNLIB_INTER)
-#include "test_include/pilot.h"
- SUBROUTINE RZTIN
-*
-********************************************************************************
-* *
-* To define menus and commands for the RZ interactive test program *
-* *
-* Author : R.Brun *
-* Written : 02.04.86 *
-* Last mod: 02.05.86 *
-* *
-********************************************************************************
-*
- CALL ZCMENU(1,'RZTEST$')
-C
- CALL ZCBOOK( 1,'RZMAKE$',1)
- CALL ZCBOOK( 2,'RZFILE$',1)
- CALL ZCBOOK( 3,'NDIR$',1)
- CALL ZCBOOK( 4,'CDIR$',1)
- CALL ZCBOOK( 5,'MDIR$',1)
- CALL ZCBOOK( 6,'DELT$',1)
- CALL ZCBOOK( 7,'RZQUOT$',1)
- CALL ZCBOOK( 8,'LOCK$',1)
- CALL ZCBOOK( 9,'FREE$',1)
- CALL ZCBOOK(10,'LDIR$',1)
- CALL ZCBOOK(11,'PURGE$',1)
- CALL ZCBOOK(12,'DELK$',1)
- CALL ZCBOOK(13,'COPY$',1)
- CALL ZCBOOK(14,'CPT$',1)
- CALL ZCBOOK(15,'RZEND$' ,1)
- CALL ZCBOOK(16,'PATH$',1)
- CALL ZCBOOK(17,'RZLOGL$',1)
- CALL ZCBOOK(18,'RZOUT$',1)
- CALL ZCBOOK(19,'RZIN$',1)
- CALL ZCBOOK(20,'SAVE$',1)
- CALL ZCBOOK(21,'PQUEST$',1)
- CALL ZCBOOK(22,'PASSWORD$',1)
- CALL ZCBOOK(23,'WDIR$',1)
- CALL ZCBOOK(24,'STAT$',1)
- CALL ZCBOOK(25,'LLOK$',1)
- CALL ZCBOOK(26,'VOUT$',1)
- CALL ZCBOOK(27,'VIN$',1)
- CALL ZCBOOK(28,'VFILL$',1)
- CALL ZCBOOK(29,'PVECT$',1)
- CALL ZCBOOK(30,'TOFZ$',1)
- CALL ZCBOOK(31,'FRFZ$',1)
- CALL ZCBOOK(32,'FZOPEN$',1)
- CALL ZCBOOK(33,'FZEND$',1)
- CALL ZCBOOK(34,'RENK$',1)
-C
- CALL ZCMENU(2,'MZCONTROL$')
-C
- CALL ZCBOOK(1,'SURV$',2)
- CALL ZCBOOK(2,'SNAP$',2)
- CALL ZCBOOK(3,'VERI$',2)
- CALL ZCBOOK(4,'DZSHOW$',2)
- CALL ZCBOOK(5,'LINK$',2)
- CALL ZCBOOK(6,'STOR$',2)
- CALL ZCBOOK(7,'MZLOGL$',2)
- CALL ZCBOOK(8,'MZBOOK$',2)
- CALL ZCBOOK(9,'PZIN$',2)
- CALL ZCBOOK(10,'SDIVISION$',2)
- CALL ZCBOOK(11,'ZFREE$',2)
- CALL ZCBOOK(12,'ZUSED$',2)
- CALL ZCBOOK(13,'ZPURG$',2)
- CALL ZCBOOK(14,'ZNEWD$',2)
- CALL ZCBOOK(15,'BTREE$',2)
-C
- END
-#endif
diff --git a/src/packlib/zebra/test/tdzdummy/Imakefile b/src/packlib/zebra/test/tdzdummy/Imakefile
deleted file mode 100644
index eb776cc..0000000
--- a/src/packlib/zebra/test/tdzdummy/Imakefile
+++ /dev/null
@@ -1,3 +0,0 @@
-SRCS_F= dzdummy.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/zebra/test/tdzdummy/dzdummy.F b/src/packlib/zebra/test/tdzdummy/dzdummy.F
deleted file mode 100644
index fababfe..0000000
--- a/src/packlib/zebra/test/tdzdummy/dzdummy.F
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: dzdummy.F,v 1.1.1.1 1996/03/06 10:47:04 mclareni Exp $
-*
-* $Log: dzdummy.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:04 mclareni
-* Zebra
-*
-*
- SUBROUTINE DZSNAP (CHTEXT,IXDIV,CHOPT)
- CHARACTER *(*) CHTEXT,CHOPT
- RETURN
- END
diff --git a/src/packlib/zebra/test/tefqmain/Imakefile b/src/packlib/zebra/test/tefqmain/Imakefile
deleted file mode 100644
index d74d2ff..0000000
--- a/src/packlib/zebra/test/tefqmain/Imakefile
+++ /dev/null
@@ -1,3 +0,0 @@
-SRCS_F= tfmain.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/zebra/test/tefqmain/tfmain.F b/src/packlib/zebra/test/tefqmain/tfmain.F
deleted file mode 100644
index 8be3f82..0000000
--- a/src/packlib/zebra/test/tefqmain/tfmain.F
+++ /dev/null
@@ -1,36 +0,0 @@
-*
-* $Id: tfmain.F,v 1.1.1.1 1996/03/06 10:47:04 mclareni Exp $
-*
-* $Log: tfmain.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:04 mclareni
-* Zebra
-*
-*
- PROGRAM TFMAIN
-
-#include "test_include/cqc.inc"
-C-------------- END CDE --------------
- DIMENSION PSEUDO(6200)
-
- DIMENSION LISTIN(4)
-
-#include "test_include/tfmaindc.inc"
-* Ignoring t=pass
-
- DATA LISTIN / 3, 1,-1, 0 /
-
-
- CALL MZEBRA (LISTIN)
- CALL MZVERS
-
-
- CALL VZERO (IQCOPT,8)
-
-* INIT OF RECOVERY
-* SET UP OPTIONS
-
- CALL FQTEST
- CALL ZEND
- END
-* ==================================================
-#include "zebra/qcardl.inc"
diff --git a/src/packlib/zebra/test/tefqmain/tfmain.inc b/src/packlib/zebra/test/tefqmain/tfmain.inc
deleted file mode 100644
index e8a893a..0000000
--- a/src/packlib/zebra/test/tefqmain/tfmain.inc
+++ /dev/null
@@ -1,14 +0,0 @@
-*
-* $Id: tfmain.inc,v 1.1.1.1 1996/03/06 10:47:04 mclareni Exp $
-*
-* $Log: tfmain.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:04 mclareni
-* Zebra
-*
-*
-*
-* tfmain.inc
-*
-#if defined(CERNLIB_QMCDC)
- PROGRAM TFMAIN (TAPE11, TAPE12, TAPE13, OUTPUT)
-#endif
diff --git a/src/packlib/zebra/test/tejqmain/Imakefile b/src/packlib/zebra/test/tejqmain/Imakefile
deleted file mode 100644
index b69226d..0000000
--- a/src/packlib/zebra/test/tejqmain/Imakefile
+++ /dev/null
@@ -1,3 +0,0 @@
-SRCS_F= tjmain.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/zebra/test/tejqmain/tjmain.F b/src/packlib/zebra/test/tejqmain/tjmain.F
deleted file mode 100644
index 2e9c45e..0000000
--- a/src/packlib/zebra/test/tejqmain/tjmain.F
+++ /dev/null
@@ -1,46 +0,0 @@
-*
-* $Id: tjmain.F,v 1.1.1.1 1996/03/06 10:47:05 mclareni Exp $
-*
-* $Log: tjmain.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:05 mclareni
-* Zebra
-*
-*
-#include "test_include/pilot.h"
- PROGRAM TJMAIN
-
-#include "zebra/zunit.inc"
-#undef CERNLIB_ZEBRA_ZUNIT_INC
-#include "test_include/testll.inc"
-#include "test_include/mainiq.inc"
-C-------------- End CDE --------------
-#include "test_include/tpseudo.inc"
-* Ignoring t=pass
- DIMENSION LISTIN(4)
-
-
- DATA LISTIN / 3, 0,-1, 0 /
-
- OPEN (16,FILE='jztest.dat',STATUS='OLD')
-
- CALL MZEBRA (LISTIN)
- CALL MZVERS
- CALL CQBKIN
-
- WRITE (IQLOG,9011)
- 9011 FORMAT (1X/' *!!!!!! Test JZ91 package')
-
- CALL ZVAUTO (0, 0,-1, 0)
- CALL JQTEST
-
- WRITE (IQLOG,9079)
- 9079 FORMAT (1X/' *!!!!-- End of test JZ91')
-
- CALL ZEND
- END
-
- SUBROUTINE ZVAUTX
- CALL ZVAUTY
- END
-* ==================================================
-#include "zebra/qcardl.inc"
diff --git a/src/packlib/zebra/test/tejqmain/tjmain1.inc b/src/packlib/zebra/test/tejqmain/tjmain1.inc
deleted file mode 100644
index 41c9a71..0000000
--- a/src/packlib/zebra/test/tejqmain/tjmain1.inc
+++ /dev/null
@@ -1,14 +0,0 @@
-*
-* $Id: tjmain1.inc,v 1.1.1.1 1996/03/06 10:47:04 mclareni Exp $
-*
-* $Log: tjmain1.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:04 mclareni
-* Zebra
-*
-*
-*
-* tjmain1.inc
-*
-#if defined(CERNLIB_QMIBM)||defined(CERNLIB_QMIBMD)
- OPEN (16,FILE='/ZXTEST DAT',FORM='UNFORMATTED',STATUS='OLD')
-#endif
diff --git a/src/packlib/zebra/test/temzcopy/Imakefile b/src/packlib/zebra/test/temzcopy/Imakefile
deleted file mode 100644
index 3041d67..0000000
--- a/src/packlib/zebra/test/temzcopy/Imakefile
+++ /dev/null
@@ -1,3 +0,0 @@
-SRCS_F= tcmain.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/zebra/test/temzcopy/tcmain.F b/src/packlib/zebra/test/temzcopy/tcmain.F
deleted file mode 100644
index f9fe183..0000000
--- a/src/packlib/zebra/test/temzcopy/tcmain.F
+++ /dev/null
@@ -1,45 +0,0 @@
-*
-* $Id: tcmain.F,v 1.1.1.1 1996/03/06 10:47:05 mclareni Exp $
-*
-* $Log: tcmain.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:05 mclareni
-* Zebra
-*
-*
-#include "test_include/pilot.h"
- PROGRAM TCMAIN
-
-#include "zebra/zheadp.inc"
-#include "zebra/zmach.inc"
-#include "zebra/znatur.inc"
-#include "zebra/zstate.inc"
-#include "zebra/zunit.inc"
-#include "test_include/cqc.inc"
-#include "zebra/cqbkc.inc"
-#include "zebra/mqsys.inc"
-#include "test_include/testll.inc"
-#include "test_include/mainiq.inc"
-C-------------- END CDE --------------
-
- DIMENSION LISTIN(4)
-
-#include "test_include/tcmaindc.inc"
-* Ignoring t=pass
-
- DATA LISTIN / 3, 1,-1, 0 /
-
-
- CALL MZEBRA (LISTIN)
- CALL MZVERS
-
-
- CALL VZERO (IQCOPT,8)
-
-* INIT OF RECOVERY
-* SET UP OPTIONS
-
- CALL MZCOTE
- CALL ZEND
- END
-* ==================================================
-#include "zebra/qcardl.inc"
diff --git a/src/packlib/zebra/test/temzcopy/tcmain.inc b/src/packlib/zebra/test/temzcopy/tcmain.inc
deleted file mode 100644
index 5eaefae..0000000
--- a/src/packlib/zebra/test/temzcopy/tcmain.inc
+++ /dev/null
@@ -1,14 +0,0 @@
-*
-* $Id: tcmain.inc,v 1.1.1.1 1996/03/06 10:47:05 mclareni Exp $
-*
-* $Log: tcmain.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:05 mclareni
-* Zebra
-*
-*
-*
-* tcmain.inc
-*
-#if defined(CERNLIB_QMCDC)
- PROGRAM TCMAIN (OUTPUT)
-#endif
diff --git a/src/packlib/zebra/test/test_include/bankparq.inc b/src/packlib/zebra/test/test_include/bankparq.inc
deleted file mode 100644
index b719b7e..0000000
--- a/src/packlib/zebra/test/test_include/bankparq.inc
+++ /dev/null
@@ -1,30 +0,0 @@
-*
-* $Id: bankparq.inc,v 1.1.1.1 1996/03/06 10:47:03 mclareni Exp $
-*
-* $Log: bankparq.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:03 mclareni
-* Zebra
-*
-*
-* BANK PARAMETERS + EXPLANATION
-*
-* bankparq.inc
-*
-
- PARAMETER ( NBKHDQ = 1 )
- PARAMETER ( NBKCTQ = 9 )
- PARAMETER ( NBKOHQ = NBKHDQ + NBKCTQ )
- PARAMETER ( MBKLNQ = 0 )
- PARAMETER ( JBKSKQ = 1 )
- PARAMETER ( NBKSKQ = 16 )
- PARAMETER ( NBKMXQ = 2**NBKSKQ-1 )
- PARAMETER ( MBKIOQ = 1 + MBKLNQ )
- PARAMETER ( JBKIOQ = NBKSKQ + 1 )
- PARAMETER ( NBKIOQ = 16 )
- PARAMETER ( NBKJMQ = 12 )
-
- PARAMETER ( JBKUSQ = 1 )
- PARAMETER ( NBKUSQ = 18 )
- PARAMETER ( JBKSYQ = NBKUSQ + 1 )
- PARAMETER ( NBKSYQ = 32 - NBKUSQ )
-
diff --git a/src/packlib/zebra/test/test_include/bkfoparq.inc b/src/packlib/zebra/test/test_include/bkfoparq.inc
deleted file mode 100644
index 0c54f68..0000000
--- a/src/packlib/zebra/test/test_include/bkfoparq.inc
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: bkfoparq.inc,v 1.1.1.1 1996/03/06 10:47:03 mclareni Exp $
-*
-* $Log: bkfoparq.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:03 mclareni
-* Zebra
-*
-*
-* Description of the bank IO characteristic codes
-*
-* bkfoparq.inc
-*
-
-
- CHARACTER*1 KFOTYP(0:11)
- PARAMETER ( IFOUNQ = 0 , KFOTYP(IFOUNQ)='U' )
- PARAMETER ( IFOBIQ = 1 , KFOTYP(IFOBIQ)='B' )
- PARAMETER ( IFOINQ = 2 , KFOTYP(IFOINQ)='I' )
- PARAMETER ( IFOFLQ = 3 , KFOTYP(IFOFLQ)='F' )
- PARAMETER ( IFODOQ = 4 , KFOTYP(IFODOQ)='D' )
- PARAMETER ( IFOHOQ = 5 , KFOTYP(IFOHOQ)='H' )
- PARAMETER ( IFOSEQ = 7 , KFOTYP( 6)='*' , KFOTYP(IFOSEQ)='S')
- PARAMETER ( IFONAQ = 9 , KFOTYP( 8)='D' , KFOTYP(IFONAQ)='N')
- PARAMETER ( IFOLIQ = 11, KFOTYP( 10)='*' , KFOTYP(IFOLIQ)='L')
- PARAMETER ( JFOSEQ = 16)
-
diff --git a/src/packlib/zebra/test/test_include/bknmparq.inc b/src/packlib/zebra/test/test_include/bknmparq.inc
deleted file mode 100644
index 626ad7a..0000000
--- a/src/packlib/zebra/test/test_include/bknmparq.inc
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: bknmparq.inc,v 1.1.1.1 1996/03/06 10:47:03 mclareni Exp $
-*
-* $Log: bknmparq.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:03 mclareni
-* Zebra
-*
-*
-* Description of bank name vector
-*
-* bknmparq.inc
-*
-
-
- PARAMETER ( NNMBKQ = 5 )
-
- PARAMETER ( MNMIDQ = 1 )
- PARAMETER ( MNMNLQ = MNMIDQ+1 )
- PARAMETER ( MNMNSQ = MNMNLQ+1 )
- PARAMETER ( MNMNDQ = MNMNSQ+1 )
- PARAMETER ( MNMIOQ = MNMNDQ+1 )
-
diff --git a/src/packlib/zebra/test/test_include/cqbkceq.inc b/src/packlib/zebra/test/test_include/cqbkceq.inc
deleted file mode 100644
index 45b58a0..0000000
--- a/src/packlib/zebra/test/test_include/cqbkceq.inc
+++ /dev/null
@@ -1,15 +0,0 @@
-*
-* $Id: cqbkceq.inc,v 1.1.1.1 1996/03/06 10:47:02 mclareni Exp $
-*
-* $Log: cqbkceq.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:02 mclareni
-* Zebra
-*
-*
-*
-* cqbkceq.inc
-*
- DIMENSION IDAV(6), IDBV(4), IDCV(5), IDLV(6)
- EQUIVALENCE (IDAV(1),IDVV(1)), (IDBV(1),IDVV(7))
- +, (IDCV(1),IDVV(11)), (IDLV(1),IDVV(16))
-* ------ for tests of FQ ---------------------------------
diff --git a/src/packlib/zebra/test/test_include/cqc.inc b/src/packlib/zebra/test/test_include/cqc.inc
deleted file mode 100644
index 4b7b7f0..0000000
--- a/src/packlib/zebra/test/test_include/cqc.inc
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: cqc.inc,v 1.1.1.1 1996/03/06 10:47:02 mclareni Exp $
-*
-* $Log: cqc.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:02 mclareni
-* Zebra
-*
-*
-#ifndef CERNLIB_ZEBRA_CQC_INC
-#define CERNLIB_ZEBRA_CQC_INC
-*
-*
-* cqc.inc
-*
- COMMON /CQC/ IQCIN,IQCOPT(8),NQCF,IQCHEK
-
-#endif
diff --git a/src/packlib/zebra/test/test_include/cqc1.inc b/src/packlib/zebra/test/test_include/cqc1.inc
deleted file mode 100644
index 5261d96..0000000
--- a/src/packlib/zebra/test/test_include/cqc1.inc
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: cqc1.inc,v 1.1.1.1 1996/03/06 10:47:04 mclareni Exp $
-*
-* $Log: cqc1.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:04 mclareni
-* Zebra
-*
-*
-*
-* cqc1.inc
-*
- COMMON /CQC1/ NAME,NUM,JCRD,NAML,NUML,NENTR,NAMEPR,NAMEVC(104)
- +, NUMA,NUME,JTAB,LTAB,NTAB,NAMTAB(100),NUMTAB(100)
- +, M(200),MUST(16),KODEFM(15),MACHFL(14),JCROFF
- COMMON /CQC2/ MFLP,MFPU
- CHARACTER MFLP*120,MFPU*80
diff --git a/src/packlib/zebra/test/test_include/debugjf1.inc b/src/packlib/zebra/test/test_include/debugjf1.inc
deleted file mode 100644
index 1e77e74..0000000
--- a/src/packlib/zebra/test/test_include/debugjf1.inc
+++ /dev/null
@@ -1,14 +0,0 @@
-*
-* $Id: debugjf1.inc,v 1.1.1.1 1996/03/06 10:47:03 mclareni Exp $
-*
-* $Log: debugjf1.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:03 mclareni
-* Zebra
-*
-*
-* Debug commands SIEMENS trace (place at beginning)
-*
-* debugjf1.inc
-*
- 900 CONTINUE
- PRINT '('' ====== Entry to routine '',A6)',CHROUT
diff --git a/src/packlib/zebra/test/test_include/debugjf2.inc b/src/packlib/zebra/test/test_include/debugjf2.inc
deleted file mode 100644
index 3baa288..0000000
--- a/src/packlib/zebra/test/test_include/debugjf2.inc
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: debugjf2.inc,v 1.1.1.1 1996/03/06 10:47:03 mclareni Exp $
-*
-* $Log: debugjf2.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:03 mclareni
-* Zebra
-*
-*
-* Debug commands SIEMENS trace (place just before END)
-*
-* debugjf2.inc
-*
- DEBUG INIT,TRACE
- AT 900
- INIT ON
- TRACE ON
- AT 998
- INIT OFF
- TRACE OFF
diff --git a/src/packlib/zebra/test/test_include/debugvf1.inc b/src/packlib/zebra/test/test_include/debugvf1.inc
deleted file mode 100644
index cd0c1d0..0000000
--- a/src/packlib/zebra/test/test_include/debugvf1.inc
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: debugvf1.inc,v 1.1.1.1 1996/03/06 10:47:03 mclareni Exp $
-*
-* $Log: debugvf1.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:03 mclareni
-* Zebra
-*
-*
-* VFORT (Put just in front of SUBROUTINE st.)
-*
-* debugvf1.inc
-*
-#if defined(CERNLIB_QMIBM)
- DEBUG TRACE,SUBTRACE,INIT
- AT 1001
- TRACE ON
- END DEBUG
-#endif
diff --git a/src/packlib/zebra/test/test_include/debugvf2.inc b/src/packlib/zebra/test/test_include/debugvf2.inc
deleted file mode 100644
index 708a1c4..0000000
--- a/src/packlib/zebra/test/test_include/debugvf2.inc
+++ /dev/null
@@ -1,15 +0,0 @@
-*
-* $Id: debugvf2.inc,v 1.1.1.1 1996/03/06 10:47:03 mclareni Exp $
-*
-* $Log: debugvf2.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:03 mclareni
-* Zebra
-*
-*
-* VFORT (Put as first executable statement)
-*
-* debugvf2.inc
-*
-#if defined(CERNLIB_QMIBM)
- 1001 CONTINUE
-#endif
diff --git a/src/packlib/zebra/test/test_include/divparq.inc b/src/packlib/zebra/test/test_include/divparq.inc
deleted file mode 100644
index de59f36..0000000
--- a/src/packlib/zebra/test/test_include/divparq.inc
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: divparq.inc,v 1.1.1.1 1996/03/06 10:47:03 mclareni Exp $
-*
-* $Log: divparq.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:03 mclareni
-* Zebra
-*
-*
-* DIVISION PARAMETERS + explanation
-*
-* divparq.inc
-*
-
- PARAMETER ( JDVBFQ = 1 )
- PARAMETER ( NDVBFQ = 1 )
- PARAMETER ( IDVFWQ = 0 )
- PARAMETER ( IDVBWQ = 1 )
- PARAMETER ( IDVUSQ = 1 )
- PARAMETER ( IDVLGQ = 2 )
- PARAMETER ( IDVPAQ = 3 )
- PARAMETER ( IDVSYQ = 4 )
- PARAMETER ( JDVIDQ = 1 )
- PARAMETER ( NDVIDQ = 20 )
- PARAMETER ( JDVUSQ = 21 )
- PARAMETER ( JDVLGQ = 22 )
- PARAMETER ( JDVPAQ = 23 )
- PARAMETER ( JDVSYQ = 24 )
-
- PARAMETER ( MDVLWQ = 1 )
- PARAMETER ( MDVHGQ = 2 )
-
diff --git a/src/packlib/zebra/test/test_include/dzc1.inc b/src/packlib/zebra/test/test_include/dzc1.inc
deleted file mode 100644
index f8f0239..0000000
--- a/src/packlib/zebra/test/test_include/dzc1.inc
+++ /dev/null
@@ -1,42 +0,0 @@
-*
-* $Id: dzc1.inc,v 1.1.1.1 1996/03/06 10:47:03 mclareni Exp $
-*
-* $Log: dzc1.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:03 mclareni
-* Zebra
-*
-*
-*
-* dzc1.inc
-*
-
- PARAMETER ( NOFMTQ = 0 )
-
- PARAMETER (MSYSFQ = 5)
- PARAMETER (MSYSDQ = 7)
- PARAMETER (MSYSKQ = 8)
- PARAMETER (MSYSPQ = 9)
-
- COMMON /DZC1/ IFLOPT(26),
- + JDROP,LN,LS,LX,IO,NL,NS,ND,
- + IBASE,LBASE,NDW,JDFD,JD,JTYP
-
- PARAMETER ( NSTMXQ = 16 )
- PARAMETER ( NDVMXQ = 20 )
- PARAMETER ( LNULL = 0 )
- PARAMETER ( NOFLIQ = 8 )
- PARAMETER ( NCHEKQ = -7 )
-
- PARAMETER (MCQSIQ=8)
-
- CHARACTER CQSTAK*13,CQINFO*40
- PARAMETER (MCQLSQ=2,MCQLGQ=15,MCQLTQ=19,MCQLIQ=87)
- PARAMETER (NLICHQ=130,NSTCHQ=8,NDVCHQ=8,NBKCHQ=4)
- CHARACTER*(NLICHQ) CQMAP(10),CQLINE
- CHARACTER CQSTOR*(NSTCHQ),CQDIV*(NDVCHQ),CQID*(NBKCHQ)
- COMMON /DZC1CH/ CQSTOR,CQDIV,CQID,CQMAP,CQSTAK,CQINFO
- EQUIVALENCE (CQLINE,CQMAP)
-
- CHARACTER CDUMMQ*(*)
- PARAMETER ( CDUMMQ = ' ' )
-
diff --git a/src/packlib/zebra/test/test_include/fqnamrda.inc b/src/packlib/zebra/test/test_include/fqnamrda.inc
deleted file mode 100644
index 1ff4d3f..0000000
--- a/src/packlib/zebra/test/test_include/fqnamrda.inc
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: fqnamrda.inc,v 1.1.1.1 1996/03/06 10:47:04 mclareni Exp $
-*
-* $Log: fqnamrda.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:04 mclareni
-* Zebra
-*
-*
-*
-* fqnamrda.inc
-*
-#if defined(CERNLIB_QMIBM)
- DATA FQNAME / '/FZREAD DAT ' /
-#elif defined(CERNLIB_QMIBMD)
- DATA FQNAME / '/FZREAD DAT ' /
-#elif 1
- DATA FQNAME / 'fzread.dat ' /
-#endif
diff --git a/src/packlib/zebra/test/test_include/fqtlun.inc b/src/packlib/zebra/test/test_include/fqtlun.inc
deleted file mode 100644
index 3e65103..0000000
--- a/src/packlib/zebra/test/test_include/fqtlun.inc
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: fqtlun.inc,v 1.1.1.1 1996/03/06 10:47:03 mclareni Exp $
-*
-* $Log: fqtlun.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:03 mclareni
-* Zebra
-*
-*
-*
-* fqtlun.inc
-*
- COMMON /FQTLUN/LUNT1,LUNT2,LUNT3,LUNPTR(3),NLUNT, LOGLEV,JMAKE
- +, LEVIN,LEVOUT,MAXMAK,MKBREA,MINPR,MAXPR
- DIMENSION LUNTV(3)
- EQUIVALENCE (LUNTV(1),LUNT1)
-* ------ for tests of MQ ---------------------------------
diff --git a/src/packlib/zebra/test/test_include/mainiq.inc b/src/packlib/zebra/test/test_include/mainiq.inc
deleted file mode 100644
index e548f12..0000000
--- a/src/packlib/zebra/test/test_include/mainiq.inc
+++ /dev/null
@@ -1,14 +0,0 @@
-*
-* $Id: mainiq.inc,v 1.1.1.1 1996/03/06 10:47:03 mclareni Exp $
-*
-* $Log: mainiq.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:03 mclareni
-* Zebra
-*
-*
-*
-* mainiq.inc
-*
- DIMENSION LQQ(NQN), IQQ(NQN)
- EQUIVALENCE (LQQ(1),LQUSER(1)), (IQQ(1),LQQ(9))
-* ------ for FQREAD ---------------------------------
diff --git a/src/packlib/zebra/test/test_include/maxmak.inc b/src/packlib/zebra/test/test_include/maxmak.inc
deleted file mode 100644
index b38c325..0000000
--- a/src/packlib/zebra/test/test_include/maxmak.inc
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: maxmak.inc,v 1.1.1.1 1996/03/06 10:47:04 mclareni Exp $
-*
-* $Log: maxmak.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:04 mclareni
-* Zebra
-*
-*
-*
-* maxmak.inc
-*
-#if defined(CERNLIB_MAXMAK124)
- MAXMAK = 124
-#elif defined(CERNLIB_MAXMAK48)
- MAXMAK = 48
-#elif 1
- MAXMAK = 24
-#endif
diff --git a/src/packlib/zebra/test/test_include/mzebrali.inc b/src/packlib/zebra/test/test_include/mzebrali.inc
deleted file mode 100644
index cebeb9d..0000000
--- a/src/packlib/zebra/test/test_include/mzebrali.inc
+++ /dev/null
@@ -1,14 +0,0 @@
-*
-* $Id: mzebrali.inc,v 1.1.1.1 1996/03/06 10:47:03 mclareni Exp $
-*
-* $Log: mzebrali.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:03 mclareni
-* Zebra
-*
-*
-*
-* mzebrali.inc
-*
-#if defined(CERNLIB_QMIBM)||defined(CERNLIB_QMIBMD)
- DATA LISTIN / 1, 1, 0, 0 /
-#endif
diff --git a/src/packlib/zebra/test/test_include/pilot.h b/src/packlib/zebra/test/test_include/pilot.h
deleted file mode 100644
index 519710d..0000000
--- a/src/packlib/zebra/test/test_include/pilot.h
+++ /dev/null
@@ -1,2 +0,0 @@
-#include "zebra/pilot.h"
-#define CERNLIB_QTESTLIB
diff --git a/src/packlib/zebra/test/test_include/questparq.inc b/src/packlib/zebra/test/test_include/questparq.inc
deleted file mode 100644
index 8220614..0000000
--- a/src/packlib/zebra/test/test_include/questparq.inc
+++ /dev/null
@@ -1,35 +0,0 @@
-*
-* $Id: questparq.inc,v 1.1.1.1 1996/03/06 10:47:03 mclareni Exp $
-*
-* $Log: questparq.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:03 mclareni
-* Zebra
-*
-*
-* Parameters defining the error handling in IQUEST
-*
-* questparq.inc
-*
-
-
-
- PARAMETER (MARE1Q=-1 ,MARE2Q=MARE1Q-1,MARE3Q=MARE2Q-1,
- X MARE4Q=MARE3Q-1,MARE5Q=MARE4Q-1,MARE6Q=MARE5Q-1,
- X MARE7Q=MARE6Q-1)
- PARAMETER (MBKD1Q=MARE7Q-1,MBKD2Q=MBKD1Q-1)
- PARAMETER (MBKU1Q=MBKD2Q-1,MBKU2Q=MBKU1Q-1,MBKU3Q=MBKU2Q-1,
- X MBKU4Q=MBKU3Q-1)
- PARAMETER (MBKX1Q=MBKU4Q-1,MBKX2Q=MBKX1Q-1,MBKX3Q=MBKX2Q-1)
- PARAMETER (MCHV1Q=MBKX3Q-1)
- PARAMETER (MFOR1Q=MCHV1Q-1,MFOR2Q=MFOR1Q-1,MFOR3Q=MFOR2Q-1)
- PARAMETER (MIOP1Q=MFOR3Q-1)
- PARAMETER (MSHO1Q=MFOR3Q-1,MSHO2Q=MSHO1Q-1)
- PARAMETER (MSHP1Q=MSHO2Q-1)
- PARAMETER( MSNA1Q=MSHP1Q-1,MSNA2Q=MSNA1Q-1,MSNA3Q=MSNA2Q-1,
- X MSNA4Q=MSNA3Q-1,MSNA5Q=MSNA4Q-1,MSNA6Q=MSNA5Q-1,
- X MSNA7Q=MSNA6Q-1,MSNA8Q=MSNA7Q-1)
- PARAMETER (MSUR1Q=MSNA8Q-1)
- PARAMETER( MVER1Q=MSUR1Q-1,MVER2Q=MVER1Q-1,MVER3Q=MVER2Q-1,
- X MVER4Q=MVER3Q-1,MVER5Q=MVER4Q-1,MVER6Q=MVER5Q-1,
- X MVER7Q=MVER6Q-1,MVER8Q=MVER7Q-1,MVER9Q=MVER8Q-1,
- X MVE10Q=MVER9Q-1)
diff --git a/src/packlib/zebra/test/test_include/readiq.inc b/src/packlib/zebra/test/test_include/readiq.inc
deleted file mode 100644
index 835ce1d..0000000
--- a/src/packlib/zebra/test/test_include/readiq.inc
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: readiq.inc,v 1.1.1.1 1996/03/06 10:47:03 mclareni Exp $
-*
-* $Log: readiq.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:03 mclareni
-* Zebra
-*
-*
-*
-* readiq.inc
-*
-#include "test_include/rspace.inc"
- COMMON // NO(40), IFLXQ(10), IXSTOR, IXHOLD
- +, FENCE(10), LQUSER(7), LQMAIN
- +, LA1, LA2, LA3, LA4, LA5, LA6
- +, LX1, LX2, LX3, LX4, LX5, LX6
- +, M(100), DLAST
- DIMENSION LQ(NQN), IQ(NQN), Q(NQN)
- EQUIVALENCE (LQ(1),LQUSER(1)),(IQ(1),Q(1),LQ(9))
diff --git a/src/packlib/zebra/test/test_include/rspace.inc b/src/packlib/zebra/test/test_include/rspace.inc
deleted file mode 100644
index 0be8712..0000000
--- a/src/packlib/zebra/test/test_include/rspace.inc
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: rspace.inc,v 1.1.1.1 1996/03/06 10:47:03 mclareni Exp $
-*
-* $Log: rspace.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:03 mclareni
-* Zebra
-*
-*
-*
-* rspace.inc
-*
- PARAMETER (NQN=100000, NQLIM2=50000)
diff --git a/src/packlib/zebra/test/test_include/storparq.inc b/src/packlib/zebra/test/test_include/storparq.inc
deleted file mode 100644
index 9ad18f4..0000000
--- a/src/packlib/zebra/test/test_include/storparq.inc
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: storparq.inc,v 1.1.1.1 1996/03/06 10:47:03 mclareni Exp $
-*
-* $Log: storparq.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:03 mclareni
-* Zebra
-*
-*
-* STORE PARAMETERS + explanation
-*
-* storparq.inc
-*
-
- PARAMETER ( JSTCOQ = 31 )
- PARAMETER ( JSTIDQ = 27 )
- PARAMETER ( NSTIDQ = 4 )
- PARAMETER ( NSTTBQ = 14 )
-
- PARAMETER ( MSYLAQ = 1 )
- PARAMETER ( MLAUSQ = 1 )
- PARAMETER ( NLAENQ = 5 )
- PARAMETER ( MLAADQ = 1 )
- PARAMETER ( MLALTQ = 2 )
- PARAMETER ( MLANSQ = 3 )
- PARAMETER ( JLANSQ = 1 , NLANSQ = 15 )
- PARAMETER ( JLATMQ = 31 )
- PARAMETER ( NLATMQ = 2 )
- PARAMETER ( MLACTQ = 1 )
- PARAMETER ( MLATBQ = 2 )
- PARAMETER ( MLAN1Q = 4 , MLAN2Q = 5 )
-
diff --git a/src/packlib/zebra/test/test_include/tcmaindc.inc b/src/packlib/zebra/test/test_include/tcmaindc.inc
deleted file mode 100644
index 641cc3b..0000000
--- a/src/packlib/zebra/test/test_include/tcmaindc.inc
+++ /dev/null
@@ -1,14 +0,0 @@
-*
-* $Id: tcmaindc.inc,v 1.1.1.1 1996/03/06 10:47:03 mclareni Exp $
-*
-* $Log: tcmaindc.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:03 mclareni
-* Zebra
-*
-*
-*
-* tcmaindc.inc
-*
-#if defined(CERNLIB_QMVDS)
- SAVE LISTIN
-#endif
diff --git a/src/packlib/zebra/test/test_include/testdd.inc b/src/packlib/zebra/test/test_include/testdd.inc
deleted file mode 100644
index 3a91c9b..0000000
--- a/src/packlib/zebra/test/test_include/testdd.inc
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: testdd.inc,v 1.1.1.1 1996/03/06 10:47:03 mclareni Exp $
-*
-* $Log: testdd.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:03 mclareni
-* Zebra
-*
-*
-*
-* testdd.inc
-*
-#if !defined(CERNLIB_QMVDS)
- +, M(100), DLAST
-#else
- +, M(100), DLAST, VDSPACE(NQN)
-#endif
diff --git a/src/packlib/zebra/test/test_include/testee.inc b/src/packlib/zebra/test/test_include/testee.inc
deleted file mode 100644
index ca6ff38..0000000
--- a/src/packlib/zebra/test/test_include/testee.inc
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: testee.inc,v 1.1.1.1 1996/03/06 10:47:03 mclareni Exp $
-*
-* $Log: testee.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:03 mclareni
-* Zebra
-*
-*
-*
-* testee.inc
-*
- DIMENSION LV(27),LAV(6),LBV(4),LCV(4)
- DIMENSION LLV(6),LXV(6)
- EQUIVALENCE (LV(1), LA1), (LAV(1),LA1)
- EQUIVALENCE (LBV(1),LB1), (LCV(1),LC1)
- EQUIVALENCE (LLV(1),LL1), (LXV(1),LX1)
diff --git a/src/packlib/zebra/test/test_include/testiq.inc b/src/packlib/zebra/test/test_include/testiq.inc
deleted file mode 100644
index b7705d3..0000000
--- a/src/packlib/zebra/test/test_include/testiq.inc
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: testiq.inc,v 1.1.1.1 1996/03/06 10:47:03 mclareni Exp $
-*
-* $Log: testiq.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:03 mclareni
-* Zebra
-*
-*
-*
-* testiq.inc
-*
-#if !defined(CERNLIB_QMVDS)
- DIMENSION LQ(NQN), IQ(NQN), Q(NQN)
- EQUIVALENCE (LQ(1),LQUSER(1)),(IQ(1),Q(1),LQ(9))
-#else
- DIMENSION LQ(NQN), IQ(NQN), Q(NQN)
- EQUIVALENCE (LQ(1),LQUSER(1))
- EQUIVALENCE (IQ(1),LQ(9)), (Q(1),IQ(1))
-* ------ to span // in the MAIN programs ---------------
-#endif
diff --git a/src/packlib/zebra/test/test_include/testla.inc b/src/packlib/zebra/test/test_include/testla.inc
deleted file mode 100644
index 3187770..0000000
--- a/src/packlib/zebra/test/test_include/testla.inc
+++ /dev/null
@@ -1,14 +0,0 @@
-*
-* $Id: testla.inc,v 1.1.1.1 1996/03/06 10:47:03 mclareni Exp $
-*
-* $Log: testla.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:03 mclareni
-* Zebra
-*
-*
-*
-* testla.inc
-*
- COMMON /LAREXC/ LAREX(12)
- COMMON /LAREYC/ LAREY(12)
- COMMON /LAREZC/IFLREZ(2),LAREZ(12)
diff --git a/src/packlib/zebra/test/test_include/testll.inc b/src/packlib/zebra/test/test_include/testll.inc
deleted file mode 100644
index 914a69a..0000000
--- a/src/packlib/zebra/test/test_include/testll.inc
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: testll.inc,v 1.1.1.1 1996/03/06 10:47:03 mclareni Exp $
-*
-* $Log: testll.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:03 mclareni
-* Zebra
-*
-*
-*
-* testll.inc
-*
-#include "test_include/tspace.inc"
- COMMON // NO(40), IFLXQ(10), IXSTOR, IXHOLD
- +, IXDV3,IXDV4,IXDV5, IXDV18,IXDV19,IXDV20
- +, FENCE(10), LQUSER(7), LQMAIN
- +, LA1, LA2, LA3, LA4, LA5, LA6
- +, LB1, LB2, LB3, LB4
- +, LC1, LC2, LC3, LC4, LD1
- +, LL1, LL2, LL3, LL4, LL5, LL6
- +, LX1, LX2, LX3, LX4, LX5, LX6
diff --git a/src/packlib/zebra/test/test_include/tfmaindc.inc b/src/packlib/zebra/test/test_include/tfmaindc.inc
deleted file mode 100644
index b81e385..0000000
--- a/src/packlib/zebra/test/test_include/tfmaindc.inc
+++ /dev/null
@@ -1,14 +0,0 @@
-*
-* $Id: tfmaindc.inc,v 1.1.1.1 1996/03/06 10:47:03 mclareni Exp $
-*
-* $Log: tfmaindc.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:03 mclareni
-* Zebra
-*
-*
-*
-* tfmaindc.inc
-*
-#if defined(CERNLIB_QMVDS)
- SAVE LISTIN
-#endif
diff --git a/src/packlib/zebra/test/test_include/tpseudin.inc b/src/packlib/zebra/test/test_include/tpseudin.inc
deleted file mode 100644
index 47cffb0..0000000
--- a/src/packlib/zebra/test/test_include/tpseudin.inc
+++ /dev/null
@@ -1,13 +0,0 @@
-*
-* $Id: tpseudin.inc,v 1.1.1.1 1996/03/06 10:47:02 mclareni Exp $
-*
-* $Log: tpseudin.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:02 mclareni
-* Zebra
-*
-*
-*
-* tpseudin.inc
-*
- CALL MZSTOR (0,'-PSEU-', '.', PSEU,PSEU(2),PSEU(2),PSEU(2)
- +, PSEU(2000),PSEU(6050))
diff --git a/src/packlib/zebra/test/test_include/tpseudo.inc b/src/packlib/zebra/test/test_include/tpseudo.inc
deleted file mode 100644
index b3467db..0000000
--- a/src/packlib/zebra/test/test_include/tpseudo.inc
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: tpseudo.inc,v 1.2 2004/07/29 13:57:31 mclareni Exp $
-*
-* $Log: tpseudo.inc,v $
-* Revision 1.2 2004/07/29 13:57:31 mclareni
-* For 64-bit pointer systems put local variables referenced by LOCF
-* in a dummy named common block to keep addresses in the program region.
-* Changed added by cpp define CERNLIB_QMLXIA64 but it should work in all
-* systems.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:02 mclareni
-* Zebra
-*
-*
-*
-* tpseudo.inc
-*
-#if defined(CERNLIB_QMLXIA64)
- COMMON /TEST64/ PSEU
-#endif
- DIMENSION PSEU(6200)
diff --git a/src/packlib/zebra/test/test_include/tspace.inc b/src/packlib/zebra/test/test_include/tspace.inc
deleted file mode 100644
index 9d00e7c..0000000
--- a/src/packlib/zebra/test/test_include/tspace.inc
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: tspace.inc,v 1.1.1.1 1996/03/06 10:47:03 mclareni Exp $
-*
-* $Log: tspace.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:03 mclareni
-* Zebra
-*
-*
-*
-* tspace.inc
-*
- PARAMETER (NQN=20060, NQLIM2=6000)
diff --git a/src/packlib/zebra/test/test_include/tzmaindc.inc b/src/packlib/zebra/test/test_include/tzmaindc.inc
deleted file mode 100644
index f7a2fa8..0000000
--- a/src/packlib/zebra/test/test_include/tzmaindc.inc
+++ /dev/null
@@ -1,14 +0,0 @@
-*
-* $Id: tzmaindc.inc,v 1.1.1.1 1996/03/06 10:47:03 mclareni Exp $
-*
-* $Log: tzmaindc.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:03 mclareni
-* Zebra
-*
-*
-*
-* tzmaindc.inc
-*
-#if defined(CERNLIB_QMVDS)
- SAVE LISTIN
-#endif
diff --git a/src/packlib/zebra/test/test_include/zbcdk.inc b/src/packlib/zebra/test/test_include/zbcdk.inc
deleted file mode 100644
index 4da4a77..0000000
--- a/src/packlib/zebra/test/test_include/zbcdk.inc
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: zbcdk.inc,v 1.1.1.1 1996/03/06 10:47:04 mclareni Exp $
-*
-* $Log: zbcdk.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:04 mclareni
-* Zebra
-*
-*
-* BCD symbols in CHARACTER representation
-*
-* zbcdk.inc
-*
- PARAMETER (MPOSAQ= 1 ,MPOSBQ= 2 ,MPOSCQ= 3 ,MPOSDQ= 4 ,MPOSEQ= 5
- X ,MPOSFQ= 6 ,MPOSGQ= 7 ,MPOSHQ= 8 ,MPOSIQ= 9 ,MPOSJQ=10
- X ,MPOSKQ=11, MPOSLQ=12 ,MPOSMQ=13 ,MPOSNQ=14 ,MPOSOQ=15
- X ,MPOSPQ=16, MPOSQQ=17 ,MPOSRQ=18 ,MPOSSQ=19 ,MPOSTQ=20
- X ,MPOSUQ=21, MPOSVQ=22 ,MPOSWQ=23 ,MPOSXQ=24 ,MPOSYQ=25
- X ,MPOSZQ=26 )
diff --git a/src/packlib/zebra/test/tzebend/Imakefile b/src/packlib/zebra/test/tzebend/Imakefile
deleted file mode 100644
index 6979766..0000000
--- a/src/packlib/zebra/test/tzebend/Imakefile
+++ /dev/null
@@ -1,3 +0,0 @@
-SRCS_F= qnext.F zend.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/zebra/test/tzebend/qnext.F b/src/packlib/zebra/test/tzebend/qnext.F
deleted file mode 100644
index d37ce28..0000000
--- a/src/packlib/zebra/test/tzebend/qnext.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: qnext.F,v 1.1.1.1 1996/03/06 10:47:05 mclareni Exp $
-*
-* $Log: qnext.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:05 mclareni
-* Zebra
-*
-*
-#include "test_include/pilot.h"
- SUBROUTINE QNEXT
-
-C- Dummy QNEXT for the test run
-
-#include "zebra/zunit.inc"
-
-
- WRITE (IQLOG,9001)
- 9001 FORMAT (1X/' ******* DUMMY QNEXT REACHED.')
-
- IF (IQTYPE.NE.0) WRITE (IQTYPE,9002)
- 9002 FORMAT (' STOP IN DUMMY QNEXT.')
-
- STOP
- END
-* ==================================================
-#include "zebra/qcardl.inc"
diff --git a/src/packlib/zebra/test/tzebend/zend.F b/src/packlib/zebra/test/tzebend/zend.F
deleted file mode 100644
index 1503103..0000000
--- a/src/packlib/zebra/test/tzebend/zend.F
+++ /dev/null
@@ -1,26 +0,0 @@
-*
-* $Id: zend.F,v 1.1.1.1 1996/03/06 10:47:05 mclareni Exp $
-*
-* $Log: zend.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:05 mclareni
-* Zebra
-*
-*
-#include "test_include/pilot.h"
- SUBROUTINE ZEND
-
-#include "zebra/zstate.inc"
-#include "zebra/zunit.inc"
-C-------------- END CDE --------------
-
-
- CALL ZPHASE (-3)
- CALL MZEND
-
- IF (NQERR.EQ.0) GO TO 99
- CALL ABEND
- 99 CONTINUE
- STOP
- END
-* ==================================================
-#include "zebra/qcardl.inc"
diff --git a/src/packlib/zebra/test/tzebmain/Imakefile b/src/packlib/zebra/test/tzebmain/Imakefile
deleted file mode 100644
index 485183c..0000000
--- a/src/packlib/zebra/test/tzebmain/Imakefile
+++ /dev/null
@@ -1,3 +0,0 @@
-SRCS_F= tzmain.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/zebra/test/tzebmain/tzmain.F b/src/packlib/zebra/test/tzebmain/tzmain.F
deleted file mode 100644
index 81739b1..0000000
--- a/src/packlib/zebra/test/tzebmain/tzmain.F
+++ /dev/null
@@ -1,87 +0,0 @@
-*
-* $Id: tzmain.F,v 1.1.1.1 1996/03/06 10:47:05 mclareni Exp $
-*
-* $Log: tzmain.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:05 mclareni
-* Zebra
-*
-*
-#include "test_include/pilot.h"
- PROGRAM TZMAIN
-
-#include "zebra/zstate.inc"
-#undef CERNLIB_ZEBRA_ZSTATE_INC
-#include "zebra/zunit.inc"
-#undef CERNLIB_ZEBRA_ZUNIT_INC
-#include "test_include/cqc.inc"
-C-------------- End CDE --------------
-#include "test_include/tpseudo.inc"
- DIMENSION LISTIN(4)
-
-#include "test_include/tzmaindc.inc"
-* Ignoring t=pass
-
- DATA LISTIN / 3, 1,-1, 0 /
-
-#if defined(CERNLIB_QMIBM)||defined(CERNLIB_QMIBMD)
- OPEN (16,FILE='/ZXTEST DAT',STATUS='OLD')
-#elif defined(CERNLIB_QMND3)
- OPEN (16,FILE='ZXTEST:DAT')
-#elif defined(CERNLIB_QMPDP)
-
-#else
- OPEN (16,FILE='zxtest.dat',STATUS='OLD')
-#endif
-
- CALL MZEBRA (LISTIN)
- CALL MZVERS
- CALL CQBKIN
-
-
-C------ Set CQ Options --------
-C-- Execution
- IQCOPT(1)= 7
-C-- CQ Output (Comparison Failure forces output)
- IQCOPT(2)= 7
- IQCOPT(2)= 0
-C-- Punch new Check Cards
- IQCOPT(3)= 7
- IQCOPT(3)= 0
-C-- Compare against old Check Cards
- IQCOPT(4)= 0
- IQCOPT(4)= 7
-C-- CALL QFATAL for Comparison Failure
- IQCOPT(5)= 7
- IQCOPT(5)= 0
-C-- Maximum output
- IQCOPT(6)= 107
- IQCOPT(6)= 7
- IQCOPT(6)= 0
-C-- Check machine dependent data
- IQCOPT(7)= 7
- IQCOPT(7)= 0
-
-
- CALL CQINIT (16)
-
- WRITE (IQLOG,9011)
- 9011 FORMAT (1X/' *!!!!!! Test of MZ memory management')
-
- CALL ZETEMQ
-
- CALL MZEND
-
- CALL MZEBRA (LISTIN)
- CALL MZVERS
-#include "test_include/tpseudin.inc"
- CALL ZETEMQ
-
- WRITE (IQLOG,9098) NQCF
- IF (IQTYPE.NE.0) THEN
- IF (IQTYPE.NE.IQLOG) WRITE (IQTYPE,9098) NQCF
- ENDIF
- IF (NQCF.NE.0) NQERR=MAX(NQERR,7)
- CALL ZEND
-
- 9098 FORMAT (1X/' *!!!!-- End of test :',I5,' comparison failures')
- END
diff --git a/src/packlib/zebra/test/tzebmain/tzmain1.inc b/src/packlib/zebra/test/tzebmain/tzmain1.inc
deleted file mode 100644
index 4431fc9..0000000
--- a/src/packlib/zebra/test/tzebmain/tzmain1.inc
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: tzmain1.inc,v 1.1.1.1 1996/03/06 10:47:05 mclareni Exp $
-*
-* $Log: tzmain1.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:47:05 mclareni
-* Zebra
-*
-*
-*
-* tzmain1.inc
-*
-#if defined(CERNLIB_QMIBM)||defined(CERNLIB_QMIBMD)
- OPEN (16,FILE='/ZXTEST DAT',STATUS='OLD')
-#endif
-*
-* tzmain1.inc
-*
-#if defined(CERNLIB_QMND3)
- OPEN (16,FILE='ZXTEST:DAT')
-#endif
-*
-* tzmain1.inc
-*
-#if defined(CERNLIB_QMPDP)
-#endif
diff --git a/src/packlib/zebra/test/tzebra/Imakefile b/src/packlib/zebra/test/tzebra/Imakefile
deleted file mode 100644
index 41ad92f..0000000
--- a/src/packlib/zebra/test/tzebra/Imakefile
+++ /dev/null
@@ -1,9 +0,0 @@
-SRCS_F= zetece.F zetemq.F zetere.F zeteut.F
-
-#ifdef CERNLIB_HPUX
-SpecialFortranLibObjectRule(zetemq,zetemq,'-WF,-P',NullParameter)
-SpecialFortranLibObjectRule(zetere,zetere,'-WF,-P',NullParameter)
-SpecialFortranLibObjectRule(zeteut,zeteut,'-WF,-P',NullParameter)
-#endif
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/zebra/test/tzebra/zetece.F b/src/packlib/zebra/test/tzebra/zetece.F
deleted file mode 100644
index 706dda5..0000000
--- a/src/packlib/zebra/test/tzebra/zetece.F
+++ /dev/null
@@ -1,154 +0,0 @@
-*
-* $Id: zetece.F,v 1.1.1.1 1996/03/06 10:47:05 mclareni Exp $
-*
-* $Log: zetece.F,v $
-* Revision 1.1.1.1 1996/03/06 10:47:05 mclareni
-* Zebra
-*
-*
-#include "test_include/pilot.h"
- SUBROUTINE ZETECE
-
-C- Check conversions of Hollerith to internal CETA code
-
-#include "zebra/zbcd.inc"
-#include "zebra/zceta.inc"
-#include "zebra/zunit.inc"
-#include "test_include/cqc.inc"
-#include "zebra/quest.inc"
-#include "zebra/zkrakcc.inc"
-C-------------- End CDE --------------
- DIMENSION ILETTV(64), IHOLL(80)
- EQUIVALENCE (ILETTV, IQLETT)
- DIMENSION MPAK(2)
-#if defined(CERNLIB_QMVDS)
- SAVE MPAK
-#endif
- DATA MPAK / 6, 4 /
-
-
- NFAIL = 0
-
-C---- Test IZBCD
-
- CALL UCOPY (IQLETT,IQHOLK,63)
-
- DO 23 J=1,63
- JV = IZBCD (IQHOLK(J))
- IQCETK(J) = JV
- 23 IHOLL(J) = IQLETT(JV)
-
- JFAIL = 0
- DO 24 JF=1,63
- IF (IHOLL(JF).EQ.IQHOLK(JF)) GO TO 24
- JFAIL = JF
- WRITE (IQPRNT,9024) JFAIL
- 9024 FORMAT (1X/' ZETECE. **** IZBCD FAILS at',I4/1X)
- 24 CONTINUE
-
- IF (JFAIL.EQ.0) GO TO 31
- NFAIL = JFAIL
- NQCF = NQCF + 1
- WRITE (IQPRNT,9028) (IQHOLK(J),IHOLL(J),IQCETK(J),J,J=1,63)
- 9028 FORMAT (10X,A4,1X,A4,2I4)
-
-C---- Test IZBCDV
-
- 31 CALL VZERO (IQCETK,64)
- CALL IZBCDV (63)
-
- DO 33 J=1,63
- JV = IQCETK(J)
- 33 IHOLL(J) = IQLETT(JV)
-
- JFAIL = 0
- DO 34 JF=1,63
- IF (IHOLL(JF).EQ.IQHOLK(JF)) GO TO 34
- JFAIL = JF
- WRITE (IQPRNT,9034) JFAIL
- 9034 FORMAT (1X/' ZETECE. **** IZBCDV FAILS at',I4/1X)
- 34 CONTINUE
-
- IF (JFAIL.EQ.0) GO TO 41
- NFAIL = JFAIL
- NQCF = NQCF + 1
- WRITE (IQPRNT,9028) (IQHOLK(J),IHOLL(J),IQCETK(J),J,J=1,63)
-
-C---- Test ZHTOI / ZITOH
-
- 41 CALL UTRANS (IQLETT,IQHOLK,63,1,4)
- CALL ZHTOI (IQHOLK,IQCETK,16)
- CALL ZITOH (IQCETK,IHOLL,16)
-
- JFAIL = 0
- DO 44 JF=1,16
- IF (IHOLL(JF).EQ.IQHOLK(JF)) GO TO 44
- JFAIL = JF
- WRITE (IQPRNT,9044) JFAIL
- 9044 FORMAT (1X/' ZETECE. **** ZHTOI/ZITOH FAIL at',I4/1X)
- 44 CONTINUE
-
- IF (JFAIL.EQ.0) GO TO 51
- NFAIL = JFAIL
- NQCF = NQCF + 1
-
- DO 49 JL=1,16
- CALL UPKBYT (IQCETK(JL),1,IQUEST,4,MPAK)
- WRITE (IQPRNT,9048) JL,IQHOLK(JL),IHOLL(JL)
- +, (IQUEST(J),J=1,4)
- 9048 FORMAT (10X,I3,2X,A4,1X,A4,4I4)
- 49 CONTINUE
-
-C---- Test IZCHAV
-
- 51 CALL VFILL (IQCETK,64,57)
- CALL VFILL (IQHOLK,64,IQQUES)
- CALL UH1TOC (IQLETT,CQHOLK,63)
- CALL IZCHAV (63)
-
- DO 53 J=1,63
- JV = IQCETK(J)
- 53 IHOLL(J) = IQLETT(JV)
-
- JFAIL = 0
- DO 54 JF=1,63
- IF (IHOLL(JF).EQ.ILETTV(JF)) GO TO 54
- JFAIL = JF
- WRITE (IQPRNT,9055) JFAIL
- 9055 FORMAT (1X/' ZETECE. **** IZCHAV FAILS at',I4/1X)
- 54 CONTINUE
-
- IF (JFAIL.EQ.0) GO TO 61
- NFAIL = JFAIL
- NQCF = NQCF + 1
- WRITE (IQPRNT,9056) (CQHOLK(J:J),IHOLL(J),IQCETK(J),J,J=1,63)
- 9056 FORMAT (10X,A1,3X,A4,2I4)
-
-C---- Dump translation table if errors
-
- 61 IF (NFAIL.EQ.0) RETURN
-
- WRITE (IQPRNT,9092)
- 9092 FORMAT (1X/' Dump translation table :')
-
- JLE = 0
- 93 JLA = JLE + 1
- IF (JLA.GT.NQTCET) RETURN
- JLE = MIN (NQTCET,JLE+10)
- N = JLE+1 - JLA
-
- CALL UCOPY (IQCETA(JLA),IQCETK,N)
-
- DO 94 J=1,N
- JV = IQCETK(J)
- 94 IQHOLK(J) = IQLETT(JV)
-
- WRITE (IQPRNT,9094) JLA,(IQCETK(J),J=1,N)
- WRITE (IQPRNT,9095) (IQHOLK(J),J=1,N)
- GO TO 93
-
- 9094 FORMAT (1X/8X,I5,5I3,2X,5I3)
- 9095 FORMAT (15X,5A3,2X,5A3)
- END
-* ==================================================
-#include "zebra/qcardl.inc"
diff --git a/src/packlib/zebra/test/tzebra/zetemq.F b/src/packlib/zebra/test/tzebra/zetemq.F
deleted file mode 100644
index 1d4a0dc..0000000
--- a/src/packlib/zebra/test/tzebra/zetemq.F
+++ /dev/null
@@ -1,360 +0,0 @@
-*
-* $Id: zetemq.F,v 1.2 1996/04/18 16:14:42 mclareni Exp $
-*
-* $Log: zetemq.F,v $
-* Revision 1.2 1996/04/18 16:14:42 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:05 mclareni
-* Zebra
-*
-*
-#include "test_include/pilot.h"
- SUBROUTINE ZETEMQ
-
-#include "zebra/zbcd.inc"
-#include "zebra/zstate.inc"
-#include "zebra/zunit.inc"
-#include "zebra/mzbits.inc"
-#include "zebra/quest.inc"
-#include "zebra/mzca.inc"
-#include "zebra/mzcb.inc"
-#include "zebra/mzcc.inc"
-#include "zebra/mzct.inc"
-#include "test_include/cqc.inc"
-#include "zebra/cqbkc.inc"
-#include "test_include/cqbkceq.inc"
-#include "test_include/testla.inc"
-#include "test_include/testll.inc"
-#include "test_include/testdd.inc"
-#include "test_include/testiq.inc"
-#include "test_include/testee.inc"
-C-------------- End CDE --------------
- CHARACTER ID*2
- DIMENSION MMFILL(5)
-#if defined(CERNLIB_QMVDS)
- SAVE MMFILL
-#endif
- DATA MMFILL / 4HFILL, 0, 0, 0, 0/
-
-#include "zebra/q_jbyt.inc"
-
-C IQCOPT(2)= 7
-C NQDEVZ = 7
-
-C---- Test Hollerith conversion first
-
- CALL ZETECE
-
-C---- Initialize the test store
-
- ID = ' '
- IF (JQSTOR.GE.0) ID = '* '
-
- CALL CQHEAD (3,'MQ'//ID, 'INITIALIZE TEST STORE.','.','.')
- CALL CQSTOR (0)
- CALL CQSTOC (0)
-
-C---- Lift the first structure
-
- CALL CQHEAD (2,'.', 'LIFT FIRST STRUCTURE.', '.','.')
- CALL MZSDIV (0,-1)
- CALL CQLODS (0,0)
- CALL UCOPY (LA1,LAREX,12)
- CALL UCOPY (LB4,LAREY,12)
- CALL CQSTOM (0)
- CALL CQDWSP (0)
-
-C---- Test MZFLAG
-
- CALL CQHEAD (2,'-', 'TEST MZFLAG.', 'PPPPPPP'
- +, 'A1,A2,A3,A4,A5,A6.')
-
- CALL MZSDIV (0,-1)
- CALL MZFLAG (IXSTOR,LQMAIN,1,'L')
- CALL MZFLAG (IXSTOR,LQMAIN,5,'LV')
- CALL MZFLAG (IXSTOR,LA3, 5,'Z')
- CALL MZFLAG (IXSTOR,LA3, 9,'V')
- CALL MZFLAG (IXSTOR,LD1, 2,'L')
- CALL MZFLAG (IXSTOR,LD1, 3,'V')
- CALL MZFLAG (IXSTOR,LL3, 2,'LV')
-
- DO 24 J=1,21
- L = LV(J)
- 24 M(J) = JBYT (IQ(L),1,15)
- CALL CQDATA (M,M(6))
-
- CALL CQHEAD (0,'-','-','.', 'B1,B2,B3,B4,C1,C2,C3,C4,D1.')
- CALL CQDATA (M(7),M(15))
-
- CALL CQHEAD (0,'-','-','.', 'LOW1,LOW2,LOW3,LOW4,LOW5,LOW6.')
- CALL CQDATA (M(16),M(21))
-
- CALL CQHEAD (2,'.', 'TEST MZDROP.', '.','.')
- CALL MZSDIV (0,-1)
- CALL MZDROP (IXSTOR,LA5, '.')
- CALL MZDROP (IXSTOR,LB2, '.')
- CALL MZDROP (IXSTOR,LL4, 'L')
- CALL CQSTOM (0)
- CALL CQDWSP (0)
-
-C---- Test table building
-
- CALL CQHEAD (2,'.', 'TEST TABLE BUILDING, PART 1.', '.','.')
- MQDVGA = 3
- MQDVWI = 0
- JQSTMV = -1
- CALL MZTABM
- CALL CQMOTA (0, 0)
-
- CALL MZTABR
- CALL CQLRTA (0, 0)
-
- CALL CQHEAD (1,'.','EXQ CALL MZTABX/MZTABF -----------------------
- +------.', '.', '.')
- CALL MZTABX
- CALL MZTABF
- CALL CQMOTA (0, -1)
- CALL CQLRTA (0, -1)
-
- CALL CQHEAD (1,'.','EXQ CALL MZRELX/MZMOVE -----------------------
- +------.', '.', '.')
- CALL MZRELX
- CALL MZMOVE
- CALL CQSTOM (0)
- CALL CQDWSP (0)
-
- CALL CQHEAD (2,'.', 'TEST TABLE BUILDING, PART 2.', '.','.')
-
- NGAP = 20
- CALL CQFIXU (2,NGAP)
- MMFILL(4) = NGAP - 12
- CALL MZLIFT (IXSTOR+20, LX1, 0, 2, MMFILL, 20)
-
- CALL SBIT1 (IQ(LX1),IQDROP)
- CALL SBIT1 (IQ(LL2),IQDROP)
- CALL SBIT1 (IQ(LA1),IQDROP)
-
- CALL CQSTOM (0)
- CALL CQDWSP (0)
-
- CALL CQHEAD (1,'.','EXQ CALL TABLE ROUTINES ---------------------
- +------.', '.', '.')
- MQDVGA = 3
- CALL SBIT1 (MQDVGA,20)
- MQDVWI = 0
- JQSTMV = JQSTOR
- JQDVM1 = 2
- JQDVM2 = 2
- CALL MZTABM
- CALL MZTABR
- CALL MZTABX
- CALL MZTABF
- CALL CQMOTA (0, 0)
- CALL CQLRTA (0, 0)
-
- CALL CQHEAD (1,'.','EXQ CALL MZRELX/MZMOVE -----------------------
- +------.', '.', '.')
- CALL MZRELX
- CALL MZMOVE
- CALL CQSTOM (0)
- CALL CQDWSP (0)
-
-C---- Lift extra divisions
-
- CALL CQHEAD (2,'.', 'CREATE DIVISIONS 3,20,19,4,5,18.', '.','.')
- CALL CQDIVI (3)
- CALL CQSTOC (0)
-
-C---- Test ZSHUNT
-
- CALL CQHEAD (2,'.', 'TEST ZSHUNT.', '.','.')
-
- CALL SBIT1 (IQ(LA4),IQDROP)
- CALL SBIT1 (IQ(LB1),IQDROP)
- CALL ZSHUNT (IXSTOR,LQMAIN,LQUSER,1,1)
- CALL MZSDIV (0,-1)
-
- CALL CQLODS (3,0)
- CALL MZSDIV (0,-1)
- CALL ZSHUNT (IXSTOR,LQMAIN,LQUSER,-1,1)
- CALL MZSDIV (0,-1)
- CALL MZDROP (IXSTOR,LC1, 'L')
- CALL SBIT1 (IQ(LA2),IQDROP)
-
- CALL CQLODS (4,0)
- CALL MZDROP (IXSTOR,LQMAIN, 'L')
-
- CALL CQLODS (5,0)
- CALL ZSHUNT (IXSTOR,LQMAIN,LQUSER(2),1,1)
- CALL ZSHUNT (IXSTOR,LD1,LA5,-2,0)
- CALL MZDROP (IXSTOR,LB1, 'L')
-
- CALL CQLODS (18,0)
- CALL ZSHUNT (IXSTOR,LQMAIN,LQUSER(6),1,1)
- CALL MZDROP (IXSTOR,LA4, 'L')
- CALL SBIT1 (IQ(LA2),IQDROP)
-
- CALL CQLODS (19,0)
- CALL ZSHUNT (IXSTOR,LQMAIN,LQUSER(6),-2,1)
-
- CALL CQLODS (20,0)
- CALL ZSHUNT (IXSTOR,LQMAIN,LQUSER(7),2,1)
- CALL ZSHUNT (IXSTOR,LA2,LA5,0,0)
- CALL ZSHUNT (IXSTOR,LB1,LB4,0,0)
- CALL ZSHUNT (IXSTOR,LB2,LA4,-2,1)
- CALL ZSHUNT (IXSTOR,LC1,LB2,-2,1)
- CALL ZSHUNT (IXSTOR,LD1,LC3,-1,1)
-
- CALL CQSTOM (0)
- CALL CQDWSP (0)
-
-C---- Test MZIXCO + MZXREF
-
- CALL CQHEAD (2,'.', 'TEST MZIXCO + MZXREF.', 'OOOOOOO','.')
-
- CALL MZSDIV (0,-1)
- M(1) = MZIXCO (IXSTOR+1, IXSTOR+2, 0,0)
- M(2) = MZIXCO (IXSTOR+21,IXSTOR+22, 0,0)
- M(3) = MZIXCO (IXSTOR+1, IXSTOR+2, IXSTOR+3, IXSTOR+4)
- M(4) = MZIXCO (M(1), IXSTOR+22, 0,0)
- M(5) = MZIXCO (M(1), M(2), IXSTOR+20, 0)
- M(6) = MZIXCO (M(4), M(2), 0,0)
- CALL CQDATA (M,M(6))
-
- DO 44 J=1,6
- 44 M(J) = JBYT (M(J),27,6)
- CALL CQDATA (M,M(6))
-
- IX1TO7 = MZIXCO (IXSTOR+1, IXSTOR+2, IXSTOR+3, IXSTOR+4)
- IX1TO7 = MZIXCO (IX1TO7, IXSTOR+5, IXSTOR+6, IXSTOR+7)
- IX1114 = MZIXCO (IXSTOR+11,IXSTOR+12,IXSTOR+13,IXSTOR+14)
- IX6A12 = MZIXCO (IXSTOR+6, IXSTOR+12, 0,0)
- M(1) = JBYT (IX1TO7,27,6)
- M(3) = JBYT (IX1114,27,6)
- M(5) = JBYT (IX6A12,27,6)
- M(2) = IX1TO7
- M(4) = IX1114
- M(6) = IX6A12
- CALL CQDATA (M,M(6))
-
- CALL MZXREF (IXDV3, IX1TO7, 'A')
- CALL MZXREF (IXDV4, IX1TO7, 'A')
- CALL MZXREF (IXDV5, IX1TO7, '.')
- CALL MZSDIV (0,-1)
-
- CALL MZXREF (IXDV4, IXSTOR+9, 'A')
- CALL MZXREF (IXDV5, IXSTOR+9, 'A')
-
- CALL MZXREF (IXDV3, IX1114, 'A')
- CALL MZXREF (IXDV4, IX1114, 'A')
-
- CALL MZXREF (IXDV5, IXSTOR+22, 'A')
- CALL CQSTOC (0)
-
- CALL MZXREF (IXDV3, IXSTOR+13, 'R')
- CALL MZXREF (IXDV4, IX6A12, 'R')
- CALL MZXREF (IXDV5, IX6A12, 'R')
- CALL MZXREF (IXDV4, IXSTOR+21, 'R')
- CALL CQSTOC (0)
-
-C---- Test MZPUSH
-
- CALL CQHEAD (2,'.', 'TEST MZPUSH.', '.','.')
-
- CALL CQSTOM (-7)
- CALL CQHEAD (1,'.','EXQ CALL MZPUSH WITHOUT RELOCATION ----------
- +------.', '.', '.')
-
- L = LZFIDH (IXDV19, IDCV(5), 0)
- IF (L.NE.0) CALL MZPUSH (IXDV19,L,0, 500, '.')
- IF (L.NE.0) CALL MZPUSH (IXDV19,L,0,-300, 'R')
-
- L = LZFIDH (IXDV20, IDCV(5), 0)
- IF (L.NE.0) CALL MZPUSH (IXDV20,L, 400,0, '.')
- IF (L.NE.0) CALL MZPUSH (IXDV20,L,-360,0, 'R')
-
- L = LZFIDH (IXDV5, IDAV(2), 0)
- IF (L.NE.0) THEN
- ND = IQ(L-1)
- CALL VZERO (IQ(L+ND-50),50)
- CALL MZPUSH (IXDV5,L,0,-50, 'R')
- ENDIF
-
- L = LZFIDH (IXDV19, IDAV(5), 0)
- L = LZFIDH (IXDV19, IDAV(3), L)
- IF (L.NE.0) CALL MZPUSH (IXSTOR,L, 140,200, 'I')
- IF (L.NE.0) CALL MZPUSH (IXDV19,L,-100, 0, 'R')
- CALL CQSTOC (0)
-
- CALL CQHEAD (1,'.','EXQ CALL MZPUSH WITH RELOCATION -------------
- +------.', '.', '.')
-
- L = LZFIDH (IXDV20, IDAV(4), 0)
- IF (L.NE.0) CALL MZPUSH (IXDV20,L, 20,100, '.')
-
- CALL CQSTOC (0)
- CALL CQSTOM (0)
-
-C---- Test Garbage collection
-
- CALL CQHEAD (2,'.', 'TEST GARBAGE COLLECTION WITHOUT MOVE.'
- +, '.','.')
-
- CALL CQSTOM (-7)
- CALL CQHEAD (1,'.','EXQ CALL MZGARB (DIV 22, 0) -----------------
- +------.', '.', '.')
- CALL MZGARB (IXSTOR+22,0)
- CALL CQSTOC (0)
- CALL CQSTOM (0)
- CALL CQDWSP (0)
-
- CALL CQHEAD (1,'.','EXQ CALL MZGARB (DIV 2, 18+19) --------------
- +------.', '.', '.')
- IXDVWI = MZIXCO (IXSTOR+18,IXSTOR+19,0,0)
- CALL MZGARB (IXSTOR+2,IXDVWI)
- CALL CQSTOC (0)
- CALL CQSTOM (0)
- CALL CQDWSP (0)
-
- CALL CQHEAD (2,'.', 'TEST GARBAGE COLLECTION WITH MOVE.'
- +, '.','.')
-
- NGAP = 20
- CALL CQFIXU (2,NGAP)
- MMFILL(4) = NGAP + 171
- CALL MZLIFT (IXSTOR+20, LX1, 0, 2, MMFILL, 0)
- CALL SBIT1 (IQ(LX1),IQDROP)
-
- CALL CQSTOC (0)
- CALL CQSTOM (0)
- CALL CQDWSP (0)
- CALL MZEND
-
-C---- Test inquiries
-
- CALL MZLOGL (IXSTOR,2)
- CALL MZINQS (IXSTOR)
- JDVLL = IQUEST(9)
- JDVSY = IQUEST(10)
-
- JDVA = 1
- JDVE = JDVLL
- 73 DO 74 JDV=JDVA,JDVE
- CALL MZINQD (IXSTOR+JDV)
- 74 CONTINUE
- IF (JDVA.EQ.1) THEN
- JDVA = JDVSY
- JDVE = 20
- GO TO 73
- ENDIF
- CALL MZLOGL (IXSTOR,2)
-
-C---- Test MZREPL
-
- CALL ZETERE (7)
-
- RETURN
- END
-* ==================================================
-#include "zebra/qcardl.inc"
diff --git a/src/packlib/zebra/test/tzebra/zetere.F b/src/packlib/zebra/test/tzebra/zetere.F
deleted file mode 100644
index dd1266d..0000000
--- a/src/packlib/zebra/test/tzebra/zetere.F
+++ /dev/null
@@ -1,162 +0,0 @@
-*
-* $Id: zetere.F,v 1.3 1996/04/18 16:14:44 mclareni Exp $
-*
-* $Log: zetere.F,v $
-* Revision 1.3 1996/04/18 16:14:44 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.2 1996/04/02 22:46:11 thakulin
-* Support for EPC Fortran: remove char-int equivalences and use F90
-* transfer facility.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:05 mclareni
-* Zebra
-*
-*
-#include "test_include/pilot.h"
- SUBROUTINE ZETERE (INLINE)
-
-C- Test MZREPL
-C- INLINE = zero for stand-alone test
-C- non-zero if called in-line from ZETEMQ
-
-#include "zebra/zstate.inc"
-#include "zebra/zunit.inc"
-#include "zebra/mzbits.inc"
-#include "zebra/quest.inc"
-#include "zebra/mzca.inc"
-#include "zebra/mzcb.inc"
-#include "zebra/mzcc.inc"
-#include "zebra/mzct.inc"
-#include "test_include/cqc.inc"
-#include "zebra/cqbkc.inc"
-#include "test_include/cqbkceq.inc"
-#include "test_include/testla.inc"
-#include "test_include/testll.inc"
-#include "test_include/testdd.inc"
-#include "test_include/testiq.inc"
-#include "test_include/testee.inc"
-C-------------- End CDE --------------
- CHARACTER ID*2
-
- EQUIVALENCE (LSUP,LQUSER(1))
- EQUIVALENCE (LIXO,LQUSER(3)), (LIX,LX1)
- EQUIVALENCE (LOLD,LX2), (LNEW,LX3)
-
- CHARACTER CHID*4, CHWK*4
-#if defined(CERNLIB_F90) || defined(CERNLIB_QFEPC)
- EQUIVALENCE (NNL,MMBANK(2))
-#else
- EQUIVALENCE (CHID,MMBANK(1)), (NNL,MMBANK(2))
-#endif
- +, (NNS,MMBANK(3)), (NND,MMBANK(4))
-
- DIMENSION MMSUP(5), MMIX(5)
- DATA MMSUP / 4HSUP , 2, 1, 0, 0 /
- DATA MMIX / 4HIX , 2, 2, 1, 1 /
-
-
-C---- Initialize the test store if stand-alone
-
- IF (INLINE.EQ.0) CALL CQSTOR (0)
-
-C---- Re-init the store and lift the test structure
-
- ID = ' '
- IF (NQSTOR.GT.0) ID = '* '
-
- CALL CQHEAD (3,'MR'//ID, 'TEST MZREPL WITH KEEP.', '.','.')
- CALL CQSTOR (-1)
-
-C! IQCOPT(2)= 7
-C! CALL MZLOGL (IXSTOR,2)
-C! CALL MZLOGL (IXSTOR,103)
-C---- Loop with ITER =0 and =1 for KEEP and DROP
-
- ITER = 0
-
-C-- Lift support bank, such that there is an 'up' link
-
- 42 CALL MZLIFT (IXSTOR, LSUP, LSUP,1, MMSUP, 0)
- IXIX = IXSTOR + 1
-
-C-- Create the test structure
-
- CALL MZSDIV (0,-1)
- IF (ITER.EQ.0) THEN
- CALL CQLODS (0,0)
- IXOLD = IXSTOR + 2
- ELSE
- CALL CQLODS (3,0)
- IXOLD = IXSTOR + 3
- ENDIF
- CALL ZSHUNT (IXSTOR,LQMAIN,LSUP,-1, 1)
- LQ(LSUP-2) = LA3
- LQ(LC1-2) = LA1
- LQ(LC2-2) = LA2
- LQ(LC3-2) = LA3
- LQ(LC4-2) = LA4
-
- CALL UCOPY (LA1,LAREX,12)
- CALL UCOPY (LB4,LAREY,12)
- CALL CQSTOM (-7)
- CALL CQDWSP (-7)
-
-C-- Create the new banks and the index banks
-
- LOLD = LA2
- LIXO = 0
- DO 44 JDO=1,4
-
- CALL MZLIFT (IXIX,LIX, LIXO,1, MMIX, 0)
- LQ(LIX-1) = LOLD
-
- MMBANK(1) = IQ(LOLD-4)
- MMBANK(2) = IQ(LOLD-3)
- MMBANK(3) = IQ(LOLD-2)
- MMBANK(4) = IQ(LOLD-1)
-#if defined(CERNLIB_F90) || defined(CERNLIB_QFEPC)
- CHID = transfer(MMBANK(1),'abcd');
-#endif
- CHWK = 'N' // CHID(1:3)
- CHID = CHWK
-#if defined(CERNLIB_F90) || defined(CERNLIB_QFEPC)
- MMBANK(1) = transfer(CHID,MMBANK(1));
-#endif
- CALL MZLIFT (IXOLD,LNEW, LIX,-2, MMBANK,-1)
- IF (NNL.GT.0) CALL UCOPY (LQ(LOLD-NNL),LQ(LNEW-NNL),NNL)
- IF (NND.GT.0) CALL UCOPY (IQ(LOLD+1), IQ(LNEW+1), NND)
- LOLD = LQ(LOLD)
- 44 CONTINUE
-
-C-- Execute replacement
-
- IF (ITER.EQ.0) THEN
- CALL MZREPL (IXSTOR, LIXO, 'K')
- ELSEIF (ITER.EQ.1) THEN
- CALL MZREPL (IXSTOR, LIXO, '.')
- CALL MZGARB (IXSTOR+21,0)
- ELSE
- CALL MZREPL (IXSTOR, LIXO, 'I')
- CALL MZGARB (IXSTOR+21,0)
- ENDIF
-
- CALL CQSTOM (0)
- CALL CQDWSP (0)
-
- IF (ITER.GE.2) RETURN
- ITER = ITER + 1
-
-C-- 2nd + 3rd iteration with ITER = 1 + 2
-
- IF (ITER.EQ.1) THEN
- CALL CQHEAD (2,'.', 'TEST MZREPL WITH DROP.', '.','.')
- CALL CQDIVI (1)
- ELSE
- CALL CQHEAD (2,'.', 'TEST MZREPL WITH I.', '.','.')
- ENDIF
- CALL MZWIPE (IXSTOR+21)
- GO TO 42
- END
-* ==================================================
-#include "zebra/qcardl.inc"
diff --git a/src/packlib/zebra/test/tzebra/zeteut.F b/src/packlib/zebra/test/tzebra/zeteut.F
deleted file mode 100644
index a1e1fa8..0000000
--- a/src/packlib/zebra/test/tzebra/zeteut.F
+++ /dev/null
@@ -1,269 +0,0 @@
-*
-* $Id: zeteut.F,v 1.2 1996/04/18 16:14:46 mclareni Exp $
-*
-* $Log: zeteut.F,v $
-* Revision 1.2 1996/04/18 16:14:46 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:05 mclareni
-* Zebra
-*
-*
-#include "test_include/pilot.h"
- SUBROUTINE ZETEUT
-
-#include "zebra/zbcd.inc"
-#include "zebra/zstate.inc"
-#include "zebra/zunit.inc"
-#include "zebra/mzbits.inc"
-#include "zebra/quest.inc"
-#include "zebra/mzca.inc"
-#include "zebra/mzcb.inc"
-#include "zebra/mzcc.inc"
-#include "zebra/mzct.inc"
-#include "test_include/cqc.inc"
-#include "test_include/testla.inc"
-#include "test_include/testll.inc"
-#include "test_include/testdd.inc"
-#include "test_include/testiq.inc"
-#include "test_include/testee.inc"
-C-------------- End CDE --------------
-
-
-C IQCOPT(2)= 7
-C NQDEVZ = 7
-
- CALL CQHEAD (3,'UTY ', 'TEST UTILITIES.','-','-')
-
- CALL MZSTOR (IXSTOR,'//', '.', FENCE
- +, LQ,LA1,LX1,LQ(NQLIM2),IQ(19997))
-
- CALL CQFIXU (1,17000)
- CALL MZWORK (IXSTOR,M,DLAST,0)
- CALL VZERO (LQUSER,150)
-
-C CALL MZLINK (IXSTOR,'/LAREX/', LAREX, LAREX(12),LAREX)
-C CALL MZLINK (IXSTOR,'/LAREY/', LAREY, LAREY, LAREY(12))
-C CALL MZLINT (IXSTOR,'/LAREZ/',IFLREZ, LAREZ(7), LAREZ(12))
-
-C- Lift structure
-
- CALL CQHEAD (1,'-', 'ORIGINAL STRUCTURE.', '-','-')
- CALL MZSDIV (0,-1)
- CALL CQLODS (0,0)
-
- CALL ZSHUNT (IXSTOR,LB1,LA6,0,1)
- CALL ZSHUNT (IXSTOR,LC1,LB4,0,1)
-
- DO 39 JBK=1,14
- J2 = (JBK-1)/2
- J4 = (JBK+1)/4
- L = LV(JBK)
-
- IQ(L+11) = J4
- IQ(L+12) = J2 - 3
- IQ(L+13) = JBK- 16
- IQ(L+14) = JBK
-
- IQ(L+15) = 1 - J4
- IQ(L+16) = 2 - J2
- IQ(L+17) = 16 - JBK
- IQ(L+18) = -JBK
-
- DO 36 JF=1,10
- I = IQ(L+JF+10)
- Q(L+JF+20) = I
-
- 34 IF (I.GT.0) GO TO 35
- I = I + 20
- GO TO 34
-
- 35 IF (I.GE.24) I=MOD(I,20) + 1
- CALL UBUNCH (IQLETT(I),IQ(L+JF+30),4)
- 36 CONTINUE
- 39 CONTINUE
-
- CALL CQDLIN (LA1,11,10,1)
- CALL CQDLIN (LA1,31,10,2)
-
-C---- Test ZSORTI
-
- CALL CQHEAD (2,'-', 'TEST ZSORTI.', '-','-')
-
-C-- Positive key only
-
- CALL ZSHUNT (IXSTOR,LC2,LC4,0,0)
- CALL ZSORTI (IXSTOR,LQ(LB4),14)
- CALL CQDLIN (LQ(LB4),14,1,1)
-
- CALL ZSHUNT (IXSTOR,LC2,LC4,0,0)
- CALL ZSORTI (IXSTOR,LQ(LB4),12)
- CALL CQDLIN (LQ(LB4),12,1,1)
-
-C-- Negative key only
-
- CALL ZSORTI (IXSTOR,LQ(LB4),16)
- CALL CQDLIN (LQ(LB4),16,1,1)
-
- CALL ZSORTI (IXSTOR,LQ(LA6),17)
- CALL CQDLIN (LQ(LA6),17,1,1)
-
-C-- Mixed keys
-
- CALL ZSHUNT (IXSTOR,LA2,LA3,0,0)
- CALL ZSORTI (IXSTOR,LQMAIN, 12)
- CALL CQDLIN (LQMAIN, 12,1,1)
- CALL ZSORTI (IXSTOR,LQMAIN, 14)
-
-C---- Test ZSORT
-
- CALL CQHEAD (2,'-', 'TEST ZSORT .', '-','-')
-
-C-- Positive key only
-
- CALL ZSHUNT (IXSTOR,LC2,LC4,0,0)
- CALL ZSORT (IXSTOR,LQ(LB4),24)
- CALL CQDLIN (LQ(LB4),24,1,0)
-
- CALL ZSHUNT (IXSTOR,LC2,LC4,0,0)
- CALL ZSORT (IXSTOR,LQ(LB4),22)
- CALL CQDLIN (LQ(LB4),22,1,0)
-
-C-- Negative key only
-
- CALL ZSORT (IXSTOR,LQ(LB4),26)
- CALL CQDLIN (LQ(LB4),26,1,0)
-
- CALL ZSORT (IXSTOR,LQ(LA6),27)
- CALL CQDLIN (LQ(LA6),27,1,0)
-
-C-- Mixed keys
-
- CALL ZSHUNT (IXSTOR,LA2,LA3,0,0)
- CALL ZSORT (IXSTOR,LQMAIN, 22)
- CALL CQDLIN (LQMAIN ,22,1,0)
- CALL ZSORTI (IXSTOR,LQMAIN, 14)
-
-C---- Test ZSORTH
-
- CALL CQHEAD (2,'-', 'TEST ZSORTH.', '-','-')
-
- CALL ZSHUNT (IXSTOR,LC2,LC4,0,0)
- CALL ZSORTH (IXSTOR,LQ(LB4),32)
- CALL CQDLIN (LQ(LB4),32,1,2)
-
- CALL ZSHUNT (IXSTOR,LC2,LC4,0,0)
- CALL ZSORTH (IXSTOR,LQ(LB4),33)
- CALL CQDLIN (LQ(LB4),33,1,2)
-
- CALL ZSORTH (IXSTOR,LQ(LB4),36)
- CALL CQDLIN (LQ(LB4),36,1,2)
-
- CALL ZSORTH (IXSTOR,LQ(LB4),37)
- CALL CQDLIN (LQ(LB4),37,1,2)
-
- CALL ZSORTH (IXSTOR,LQ(LA6),38)
- CALL CQDLIN (LQ(LA6),38,1,2)
-
- CALL ZSHUNT (IXSTOR,LA2,LA3,0,0)
- CALL ZSORTH (IXSTOR,LQMAIN, 34)
- CALL CQDLIN (LQMAIN, 34,1,2)
-
-C---- Test ZSORVI
-
- CALL CQHEAD (2,'-', 'TEST ZSORVI.', '-','-')
-
-C-- Positive first key only
-
- CALL ZSHUNT (IXSTOR,LC2,LC4,0,0)
- CALL ZSORVI (IXSTOR,LQ(LB4),14,2)
- CALL CQDLIN (LQ(LB4),14,2,1)
-
- CALL ZSHUNT (IXSTOR,LC2,LC4,0,0)
- CALL ZSORVI (IXSTOR,LQ(LB4),11,2)
- CALL CQDLIN (LQ(LB4),11,2,1)
-
- CALL ZSHUNT (IXSTOR,LC2,LC4,0,0)
- CALL ZSORVI (IXSTOR,LQ(LB4),11,3)
- CALL CQDLIN (LQ(LB4),11,3,1)
-
-C-- Negative first key only
-
- CALL ZSORVI (IXSTOR,LQ(LB4),15,2)
- CALL CQDLIN (LQ(LB4),15,2,1)
-
- CALL ZSORVI (IXSTOR,LQ(LB4),15,3)
- CALL CQDLIN (LQ(LB4),15,3,1)
-
- CALL ZSORVI (IXSTOR,LQ(LA6),16,2)
- CALL CQDLIN (LQ(LA6),16,2,1)
-
-C-- Mixed keys
-
- CALL ZSHUNT (IXSTOR,LA2,LA3,0,0)
- CALL ZSORVI (IXSTOR,LQMAIN, 12,2)
- CALL CQDLIN (LQMAIN,12,2,1)
-
-C---- Test ZSORV
-
- CALL CQHEAD (2,'-', 'TEST ZSORV .', '-','-')
-
-C-- Positive first key only
-
- CALL ZSHUNT (IXSTOR,LC2,LC4,0,0)
- CALL ZSORV (IXSTOR,LQ(LB4),24,2)
- CALL CQDLIN (LQ(LB4),24,2,0)
-
- CALL ZSHUNT (IXSTOR,LC2,LC4,0,0)
- CALL ZSORV (IXSTOR,LQ(LB4),21,2)
- CALL CQDLIN (LQ(LB4),21,2,0)
-
- CALL ZSHUNT (IXSTOR,LC2,LC4,0,0)
- CALL ZSORV (IXSTOR,LQ(LB4),21,3)
- CALL CQDLIN (LQ(LB4),21,3,0)
-
-C-- Negative first key only
-
- CALL ZSORV (IXSTOR,LQ(LB4),25,2)
- CALL CQDLIN (LQ(LB4),25,2,0)
-
- CALL ZSORV (IXSTOR,LQ(LB4),25,3)
- CALL CQDLIN (LQ(LB4),25,3,0)
-
- CALL ZSORV (IXSTOR,LQ(LA6),26,2)
- CALL CQDLIN (LQ(LA6),26,2,0)
-
-C-- Mixed keys
-
- CALL ZSHUNT (IXSTOR,LA2,LA3,0,0)
- CALL ZSORV (IXSTOR,LQMAIN, 22,2)
- CALL CQDLIN (LQMAIN,22,2,0)
-
-C---- Test ZSORVH
-
- CALL CQHEAD (2,'-', 'TEST ZSORVH.', '-','-')
-
- CALL ZSHUNT (IXSTOR,LC2,LC4,0,0)
- CALL ZSORVH (IXSTOR,LQ(LB4),31,2)
- CALL CQDLIN (LQ(LB4),31,2,2)
-
- CALL ZSHUNT (IXSTOR,LC2,LC4,0,0)
- CALL ZSORVH (IXSTOR,LQ(LB4),31,3)
- CALL CQDLIN (LQ(LB4),31,3,2)
-
- CALL ZSORVH (IXSTOR,LQ(LB4),35,2)
- CALL CQDLIN (LQ(LB4),35,2,2)
-
- CALL ZSORVH (IXSTOR,LQ(LB4),35,3)
- CALL CQDLIN (LQ(LB4),35,3,2)
-
- CALL ZSORVH (IXSTOR,LQ(LA6),36,2)
- CALL CQDLIN (LQ(LA6),36,2,2)
-
- CALL ZSHUNT (IXSTOR,LA2,LA3,0,0)
- CALL ZSORVH (IXSTOR,LQMAIN, 33,2)
- CALL CQDLIN (LQMAIN,33,2,2)
- RETURN
- END
-* ==================================================
-#include "zebra/qcardl.inc"
diff --git a/src/packlib/zebra/test/zebfc1.F b/src/packlib/zebra/test/zebfc1.F
deleted file mode 100644
index 087b0d8..0000000
--- a/src/packlib/zebra/test/zebfc1.F
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: zebfc1.F,v 1.1.1.1 1996/03/06 10:46:57 mclareni Exp $
-*
-* $Log: zebfc1.F,v $
-* Revision 1.1.1.1 1996/03/06 10:46:57 mclareni
-* Zebra
-*
-*
-#define CERNLIB_QFILDAX
-#define CERNLIB_QFILDANY
-#define CERNLIB_MAXMAK124
-#include "tefqmain/tfmain.F"
-#include "fqtest/fqtest.F"
-#include "fqtend/zend.F"
-#include "tzebend/qnext.F"
-#include "tdzdummy/dzdummy.F"
diff --git a/src/packlib/zebra/test/zebfc2.F b/src/packlib/zebra/test/zebfc2.F
deleted file mode 100644
index 87442d7..0000000
--- a/src/packlib/zebra/test/zebfc2.F
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: zebfc2.F,v 1.1.1.1 1996/03/06 10:46:58 mclareni Exp $
-*
-* $Log: zebfc2.F,v $
-* Revision 1.1.1.1 1996/03/06 10:46:58 mclareni
-* Zebra
-*
-*
-#define CERNLIB_QFIRDAX
-#define CERNLIB_QFIRDANY
-#define CERNLIB_MAXMAK124
-#include "tefqmain/tfmain.F"
-#include "fqtest/fqtest.F"
-#include "fqtend/zend.F"
-#include "tzebend/qnext.F"
-#include "tdzdummy/dzdummy.F"
diff --git a/src/packlib/zebra/test/zebfc3.F b/src/packlib/zebra/test/zebfc3.F
deleted file mode 100644
index 5c9c910..0000000
--- a/src/packlib/zebra/test/zebfc3.F
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: zebfc3.F,v 1.1.1.1 1996/03/06 10:46:58 mclareni Exp $
-*
-* $Log: zebfc3.F,v $
-* Revision 1.1.1.1 1996/03/06 10:46:58 mclareni
-* Zebra
-*
-*
-#define CERNLIB_QRANDOM
-#define CERNLIB_QFIRDAX
-#define CERNLIB_QFIRDANY
-#define CERNLIB_MAXMAK124
-#include "tefqmain/tfmain.F"
-#include "fqtest/fqtest.F"
-#include "fqtend/zend.F"
-#include "tzebend/qnext.F"
-#include "tdzdummy/dzdummy.F"
diff --git a/src/packlib/zebra/test/zebfz1.F b/src/packlib/zebra/test/zebfz1.F
deleted file mode 100644
index 4cbb35c..0000000
--- a/src/packlib/zebra/test/zebfz1.F
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: zebfz1.F,v 1.1.1.1 1996/03/06 10:46:58 mclareni Exp $
-*
-* $Log: zebfz1.F,v $
-* Revision 1.1.1.1 1996/03/06 10:46:58 mclareni
-* Zebra
-*
-*
-#define CERNLIB_QFIXDAX
-#define CERNLIB_QFIXDANY
-#define CERNLIB_MAXMAK124
-#include "tefqmain/tfmain.F"
-#include "fqtest/fqtest.F"
-#include "fqtend/zend.F"
-#include "tzebend/qnext.F"
-#include "tdzdummy/dzdummy.F"
diff --git a/src/packlib/zebra/test/zebfz2.F b/src/packlib/zebra/test/zebfz2.F
deleted file mode 100644
index b8c44b5..0000000
--- a/src/packlib/zebra/test/zebfz2.F
+++ /dev/null
@@ -1,15 +0,0 @@
-*
-* $Id: zebfz2.F,v 1.1.1.1 1996/03/06 10:46:58 mclareni Exp $
-*
-* $Log: zebfz2.F,v $
-* Revision 1.1.1.1 1996/03/06 10:46:58 mclareni
-* Zebra
-*
-*
-#define CERNLIB_QFINDAN
-#define CERNLIB_MAXMAK124
-#include "tefqmain/tfmain.F"
-#include "fqtest/fqtest.F"
-#include "fqtend/zend.F"
-#include "tzebend/qnext.F"
-#include "tdzdummy/dzdummy.F"
diff --git a/src/packlib/zebra/test/zebfz3.F b/src/packlib/zebra/test/zebfz3.F
deleted file mode 100644
index eedde98..0000000
--- a/src/packlib/zebra/test/zebfz3.F
+++ /dev/null
@@ -1,15 +0,0 @@
-*
-* $Id: zebfz3.F,v 1.1.1.1 1996/03/06 10:46:58 mclareni Exp $
-*
-* $Log: zebfz3.F,v $
-* Revision 1.1.1.1 1996/03/06 10:46:58 mclareni
-* Zebra
-*
-*
-#define CERNLIB_QFIASC
-#define CERNLIB_MAXMAK24
-#include "tefqmain/tfmain.F"
-#include "fqtest/fqtest.F"
-#include "fqtend/zend.F"
-#include "tzebend/qnext.F"
-#include "tdzdummy/dzdummy.F"
diff --git a/src/packlib/zebra/test/zebfz4.F b/src/packlib/zebra/test/zebfz4.F
deleted file mode 100644
index 0a0c0e6..0000000
--- a/src/packlib/zebra/test/zebfz4.F
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: zebfz4.F,v 1.1.1.1 1996/03/06 10:46:59 mclareni Exp $
-*
-* $Log: zebfz4.F,v $
-* Revision 1.1.1.1 1996/03/06 10:46:59 mclareni
-* Zebra
-*
-*
-#define CERNLIB_QFICDAX
-#define CERNLIB_QFICDANY
-#define CERNLIB_MAXMAK124
-#include "tefqmain/tfmain.F"
-#include "fqtest/fqtest.F"
-#include "fqtend/zend.F"
-#include "tzebend/qnext.F"
-#include "tdzdummy/dzdummy.F"
diff --git a/src/packlib/zebra/test/zebfz5.F b/src/packlib/zebra/test/zebfz5.F
deleted file mode 100644
index 92c1052..0000000
--- a/src/packlib/zebra/test/zebfz5.F
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: zebfz5.F,v 1.1.1.1 1996/03/06 10:46:59 mclareni Exp $
-*
-* $Log: zebfz5.F,v $
-* Revision 1.1.1.1 1996/03/06 10:46:59 mclareni
-* Zebra
-*
-*
-#define CERNLIB_QFIMDAX
-#define CERNLIB_QFIMDANY
-#define CERNLIB_MAXMAK24
-#include "tefqmain/tfmain.F"
-#include "fqtest/fqtest.F"
-#undef CERNLIB_ZEBRA_ZSTATE_INC
-#undef CERNLIB_ZEBRA_ZUNIT_INC
-#undef CERNLIB_ZEBRA_MZBITS_INC
-#undef CERNLIB_ZEBRA_QUEST_INC
-#undef CERNLIB_ZEBRA_CQBKC_INC
-#include "fqtest/fqmake.F"
-#undef CERNLIB_ZEBRA_ZSTATE_INC
-#undef CERNLIB_ZEBRA_ZUNIT_INC
-#undef CERNLIB_ZEBRA_MZBITS_INC
-#undef CERNLIB_ZEBRA_QUEST_INC
-#undef CERNLIB_ZEBRA_CQBKC_INC
-#include "fqtest/fqback.F"
-#include "fqtend/zend.F"
-#include "tzebend/qnext.F"
-#include "tdzdummy/dzdummy.F"
diff --git a/src/packlib/zebra/test/zebfz6.F b/src/packlib/zebra/test/zebfz6.F
deleted file mode 100644
index 3237735..0000000
--- a/src/packlib/zebra/test/zebfz6.F
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: zebfz6.F,v 1.1.1.1 1996/03/06 10:46:59 mclareni Exp $
-*
-* $Log: zebfz6.F,v $
-* Revision 1.1.1.1 1996/03/06 10:46:59 mclareni
-* Zebra
-*
-*
-#define CERNLIB_QFANCOP
-#define CERNLIB_QFIXDAN
-#define CERNLIB_QFIXDANY
-#define CERNLIB_MAXMAK48
-#include "tefqmain/tfmain.F"
-#include "fqtest/fqtest.F"
-#include "fqtend/zend.F"
-#include "tzebend/qnext.F"
-#include "tdzdummy/dzdummy.F"
diff --git a/src/packlib/zebra/test/zebfz7.F b/src/packlib/zebra/test/zebfz7.F
deleted file mode 100644
index a35d357..0000000
--- a/src/packlib/zebra/test/zebfz7.F
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: zebfz7.F,v 1.1.1.1 1996/03/06 10:46:59 mclareni Exp $
-*
-* $Log: zebfz7.F,v $
-* Revision 1.1.1.1 1996/03/06 10:46:59 mclareni
-* Zebra
-*
-*
-#define CERNLIB_QFANOUT
-#define CERNLIB_QFIXDAN
-#define CERNLIB_QFIXDANY
-#define CERNLIB_MAXMAK48
-#include "tefqmain/tfmain.F"
-#include "fqtest/fqtest.F"
-#include "fqtend/zend.F"
-#include "tzebend/qnext.F"
-#include "tdzdummy/dzdummy.F"
diff --git a/src/packlib/zebra/test/zebfz8.F b/src/packlib/zebra/test/zebfz8.F
deleted file mode 100644
index 76ecb2a..0000000
--- a/src/packlib/zebra/test/zebfz8.F
+++ /dev/null
@@ -1,16 +0,0 @@
-*
-* $Id: zebfz8.F,v 1.1.1.1 1996/03/06 10:46:59 mclareni Exp $
-*
-* $Log: zebfz8.F,v $
-* Revision 1.1.1.1 1996/03/06 10:46:59 mclareni
-* Zebra
-*
-*
-#define CERNLIB_QFIDDAX
-#define CERNLIB_QFIDDANY
-#define CERNLIB_MAXMAK124
-#include "tefqmain/tfmain.F"
-#include "fqtest/fqtest.F"
-#include "fqtend/zend.F"
-#include "tzebend/qnext.F"
-#include "tdzdummy/dzdummy.F"
diff --git a/src/packlib/zebra/test/zebfz9.F b/src/packlib/zebra/test/zebfz9.F
deleted file mode 100644
index e135b70..0000000
--- a/src/packlib/zebra/test/zebfz9.F
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: zebfz9.F,v 1.1.1.1 1996/03/06 10:46:59 mclareni Exp $
-*
-* $Log: zebfz9.F,v $
-* Revision 1.1.1.1 1996/03/06 10:46:59 mclareni
-* Zebra
-*
-*
-#define CERNLIB_QRANDOM
-#define CERNLIB_QFIDDAX
-#define CERNLIB_QFIDDANY
-#define CERNLIB_MAXMAK124
-#include "tefqmain/tfmain.F"
-#include "fqtest/fqtest.F"
-#include "fqtend/zend.F"
-#include "tzebend/qnext.F"
-#include "tdzdummy/dzdummy.F"
diff --git a/src/packlib/zebra/test/zebjz1.F b/src/packlib/zebra/test/zebjz1.F
deleted file mode 100644
index 737a908..0000000
--- a/src/packlib/zebra/test/zebjz1.F
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: zebjz1.F,v 1.1.1.1 1996/03/06 10:46:59 mclareni Exp $
-*
-* $Log: zebjz1.F,v $
-* Revision 1.1.1.1 1996/03/06 10:46:59 mclareni
-* Zebra
-*
-*
-#include "tejqmain/tjmain.F"
-#include "tzebend/qnext.F"
-#include "tzebend/zend.F"
-#include "tdzdummy/dzdummy.F"
diff --git a/src/packlib/zebra/test/zebmz1.F b/src/packlib/zebra/test/zebmz1.F
deleted file mode 100644
index 94bf76e..0000000
--- a/src/packlib/zebra/test/zebmz1.F
+++ /dev/null
@@ -1,12 +0,0 @@
-*
-* $Id: zebmz1.F,v 1.1.1.1 1996/03/06 10:46:59 mclareni Exp $
-*
-* $Log: zebmz1.F,v $
-* Revision 1.1.1.1 1996/03/06 10:46:59 mclareni
-* Zebra
-*
-*
-#include "tzebmain/tzmain.F"
-#include "tzebend/qnext.F"
-#include "tzebend/zend.F"
-#include "tdzdummy/dzdummy.F"
diff --git a/src/packlib/zebra/test/zebrz1.F b/src/packlib/zebra/test/zebrz1.F
deleted file mode 100644
index 371cb9e..0000000
--- a/src/packlib/zebra/test/zebrz1.F
+++ /dev/null
@@ -1,9 +0,0 @@
-*
-* $Id: zebrz1.F,v 1.1.1.1 1996/03/06 10:46:59 mclareni Exp $
-*
-* $Log: zebrz1.F,v $
-* Revision 1.1.1.1 1996/03/06 10:46:59 mclareni
-* Zebra
-*
-*
-#include "brztest/btest1.F"
diff --git a/src/packlib/zebra/test/zebrz2.F b/src/packlib/zebra/test/zebrz2.F
deleted file mode 100644
index cdec2b0..0000000
--- a/src/packlib/zebra/test/zebrz2.F
+++ /dev/null
@@ -1,9 +0,0 @@
-*
-* $Id: zebrz2.F,v 1.1.1.1 1996/03/06 10:46:59 mclareni Exp $
-*
-* $Log: zebrz2.F,v $
-* Revision 1.1.1.1 1996/03/06 10:46:59 mclareni
-* Zebra
-*
-*
-#include "brztest/btest2.F"
diff --git a/src/packlib/zebra/test/zebrz3.F b/src/packlib/zebra/test/zebrz3.F
deleted file mode 100644
index 93ab357..0000000
--- a/src/packlib/zebra/test/zebrz3.F
+++ /dev/null
@@ -1,13 +0,0 @@
-*
-* $Id: zebrz3.F,v 1.1 1997/08/29 13:33:58 mclareni Exp $
-*
-* $Log: zebrz3.F,v $
-* Revision 1.1 1997/08/29 13:33:58 mclareni
-* Add new test, zebrz3 to test RZ exchange mode and CIO
-*
-* Revision 1.1.1.1 1996/03/06 10:46:59 mclareni
-* Zebra
-*
-*
-#define CERNLIB_TESTCX
-#include "brztest/btest1.F"
diff --git a/src/packlib/zebra/test/zxtest.data b/src/packlib/zebra/test/zxtest.data
deleted file mode 100644
index de8707e..0000000
--- a/src/packlib/zebra/test/zxtest.data
+++ /dev/null
@@ -1,1922 +0,0 @@
-MQ 1 0INITIALIZE TEST STORE.
-MQ 1 1 // 0 20 0 -20510 137755
-MQ 1 2 10 8 29 35 164 6000 2 20
-MQ 1 3 1 137 13720003 0 1048577 3145728 9437183 QDIV1
-MQ 1 4 2170001700020003 1 1048578 3145728 9437183 QDIV2
-MQ 1 5 20198922000320003 1 8388608 0 9437183 system
-MQ 2 0LIFT FIRST STRUCTURE.
-MQ 2 1 // 0 1 0 -20510 137755
-MQ 2 2 10 8 29 35 164 6000 2 20
-MQ 2 3 1 137 73720003 0 1048577 3145728 9437183 QDIV1
-MQ 2 4 0 01668816690 157 16LOW1 LOW2 19 4 46 232 0 0
-MQ 2 5 0 0 15716690 232 17LOW2 LOW3 19 4 56 317 0 0
-MQ 2 6 0 0 23216690 317 18LOW3 LOW4 19 4 66 412 0 0
-MQ 2 7 0 0 31716690 412 19LOW4 LOW5 19 4 76 517 0 0
-MQ 2 8 0 0 41216690 517 20LOW5 LOW6 19 4 86 632 0 0
-MQ 2 9 0 0 51716690 632 21LOW6 19 4 96 0 0 0
-MQ 2 10 2158161700020003 1 1048578 3145728 9437183 QDIV2
-MQ 2 11 0 0161441614515825 15D1 6 0 76 0 0 0
-MQ 2 12 0 0162831628515920 11C1 C2 9 1 5615995 0 0
-MQ 2 13 0 0159201628515995 12C2 C3 9 1 5616070 0 0
-MQ 2 14 0 0159951628516070 13C3 C4 9 1 5616145 016480
-MQ 2 15 0 0160701628516145 14C4 9 1 56 015825 0
-MQ 2 16 0 0166891669016220 7B1 B2 9 4 4616285 0 0
-MQ 2 17 0 0162201669016285 8B2 B3 9 4 4616350 015920
-MQ 2 18 0 0162851669016350 9B3 B4 9 4 4616415 0 0
-MQ 2 19 0 0163501669016415 10B4 9 4 46 0 0 0
-MQ 2 20 0 0 8 016480 1A1 A2 9 4 8616585 0 0
-MQ 2 21 0 016480 016585 2A2 A3 9 4 8616690 0 0
-MQ 2 22 0 016585 016690 3A3 A4 9 4 761678516220 157
-MQ 2 23 0 016690 016785 4A4 A5 9 4 6616870 0 0
-MQ 2 24 0 016785 016870 5A5 A6 9 4 5616945 0 0
-MQ 2 25 0 016870 016945 6A6 9 4 46 0 0 0
-MQ 2 26 20198922000320003 1 8388608 0 9437183 system
-MQ 2 27 0 0 0 019893 1SYSL 0 0 101 0
-MQ 2 28 0 0 0 0 0 0 0
-MQ 2 2916480A1 16480A1 16585A2 16690A3 16785A4 16870A5 16945A6
-MQ 2 3016220B1 16285B2 16350B3 16415B4
-MQ 2 3115920C1 15995C2 16070C3 16145C4 15825D1
-MQ 2 32 157LOW1 232LOW2 317LOW3 412LOW4 517LOW5 632LOW6
-MQ 2 3316480A1 16585A2 16690A3 16785A4 16870A5 16945A6
-MQ 2 3416220B1 16285B2 16350B3 16415B4 15920C1 15995C2
-MQ 2 3516415B4 15920C1 15995C2 16070C3 16145C4 15825D1
-MQ 2 36 157LOW1 232LOW2 317LOW3 412LOW4 517LOW5 632LOW6
-MQ 2 3716480A1 16585A2 16690A3 16785A4 16870A5 16945A6
-MQ 2 3816220B1 16285B2 16350B3 16415B4 15920C1 15995C2
-MQ 3 0TEST MZFLAG.
-MQ 3 1 1 17 1 17 17 17
-MQ 3 2 257 257 257 257 257 257 257 257 259
-MQ 3 3 257 257 257 259 259 259
-MQ 4 0TEST MZDROP.
-MQ 4 1 // 0 1 0 -20510 137755
-MQ 4 2 10 8 29 35 164 6000 2 20
-MQ 4 3 1 137 73720003 0 1048577 3145728 9437183 QDIV1
-MQ 4 4 0 2571668816690 157 16LOW1 LOW2 19 4 46 232 0 0
-MQ 4 5 0 257 15716690 232 17LOW2 LOW3 19 4 56 317 0 0
-MQ 4 6 0 257 23216690 317 18LOW3 19 4 66 0 0 0
-MQ 4 7 1 259 31716690 412 19LOW4 LOW5 19 4 76 517 0 0
-MQ 4 8 1 259 41216690 517 20LOW5 LOW6 19 4 86 632 0 0
-MQ 4 9 1 259 51716690 632 21LOW6 19 4 96 0 0 0
-MQ 4 10 2158161700020003 1 1048578 3145728 9437183 QDIV2
-MQ 4 11 1 259161441614515825 15D1 6 0 76 0 0 0
-MQ 4 12 1 257162831628515920 11C1 C2 9 1 5615995 0 0
-MQ 4 13 1 257159201628515995 12C2 C3 9 1 5616070 0 0
-MQ 4 14 1 257159951628516070 13C3 C4 9 1 5616145 016480
-MQ 4 15 1 257160701628516145 14C4 9 1 56 015825 0
-MQ 4 16 0 257166891669016220 7B1 B3 9 4 4616350 0 0
-MQ 4 17 1 257162201669016285 8B2 B3 9 4 4616350 015920
-MQ 4 18 0 257162201669016350 9B3 B4 9 4 4616415 0 0
-MQ 4 19 0 257163501669016415 10B4 9 4 46 0 0 0
-MQ 4 20 0 1 8 016480 1A1 A2 9 4 8616585 0 0
-MQ 4 21 0 1716480 016585 2A2 A3 9 4 8616690 0 0
-MQ 4 22 0 116585 016690 3A3 A4 9 4 761678516220 157
-MQ 4 23 0 1716690 016785 4A4 A6 9 4 6616945 0 0
-MQ 4 24 1 1716785 016870 5A5 A6 9 4 5616945 0 0
-MQ 4 25 0 1716785 016945 6A6 9 4 46 0 0 0
-MQ 4 26 20198922000320003 1 8388608 0 9437183 system
-MQ 4 27 0 0 0 019893 1SYSL 0 0 101 0
-MQ 4 28 0 0 0 0 0 0 0
-MQ 4 2916480A1 16480A1 16585A2 16690A3 16785A4 16870A5 16945A6
-MQ 4 3016220B1 16285B2 16350B3 16415B4
-MQ 4 3115920C1 15995C2 16070C3 16145C4 15825D1
-MQ 4 32 157LOW1 232LOW2 317LOW3 412LOW4 517LOW5 632LOW6
-MQ 4 3316480A1 16585A2 16690A3 16785A4 16870A5 16945A6
-MQ 4 3416220B1 16285B2 16350B3 16415B4 15920C1 15995C2
-MQ 4 3516415B4 15920C1 15995C2 16070C3 16145C4 15825D1
-MQ 4 36 157LOW1 232LOW2 317LOW3 412LOW4 517LOW5 632LOW6
-MQ 4 3716480A1 16585A2 16690A3 16785A4 16870A5 16945A6
-MQ 4 3816220B1 16285B2 16350B3 16415B4 15920C1 15995C2
-MQ 5 0TEST TABLE BUILDING, PART 1.
-MQ 5 1 3 0 3 -1 0 0 0
-MQ 5 2 0 0 2189 2560 4588 4612
-MQ 5 3 0 1 3 0 137 737 0 0 0
-MQ 5 4 8 2 3 01581617000 0 0 0
-MQ 5 5 16 20 0 01989220003 0 0 0
-MQ 5 6 2189 2191 2219 4578 0 3620003
-MQ 5 7 2 137 392 0 1 6 737 737 0 0
-MQ 5 8 101581615816 0 1 141621016275 0 1
-MQ 5 9 181634016860 0 1 221693517000 0 0
-MQ 5 10 261989220003 0 0
-MQ 5 11 2199 45701581617000 534 8
-MQ 5 12 3 0 3 -1 0 0 0
-MQ 5 13 0 0 2189 2560 4588 4612
-MQ 5 14 0 1 3 0 137 737 2 10 345
-MQ 5 15 8 2 3 01581617000 10 26 534
-MQ 5 16 16 20 0 01989220003 26 0 0
-MQ 5 17 2189 2191 2215 4578 0 3619892
-MQ 5 18 2 137 392 0 1 6 737 737 -345 0
-MQ 5 19 101581615816 534 1 141621016275 140 1
-MQ 5 20 181634016860 75 1 221693517000 0 0
-MQ 5 21 // 0 1 0 -20510 137755
-MQ 5 22 10 8 29 35 164 6000 2 20
-MQ 5 23 1 137 39220003 0 1048577 3145728 9437183 QDIV1
-MQ 5 24 0 2571676316765 157 16LOW1 LOW2 19 4 46 232 0 0
-MQ 5 25 0 257 15716765 232 17LOW2 LOW3 19 4 56 317 0 0
-MQ 5 26 0 257 23216765 317 18LOW3 19 4 66 0 0 0
-MQ 5 27 2163501700020003 1 1048578 3145728 9437183 QDIV2
-MQ 5 28 0 257167641676516360 7B1 B3 9 4 4616425 0 0
-MQ 5 29 0 257163601676516425 9B3 B4 9 4 4616490 0 0
-MQ 5 30 0 257164251676516490 10B4 9 4 46 0 0 0
-MQ 5 31 0 1 8 016555 1A1 A2 9 4 8616660 0 0
-MQ 5 32 0 1716555 016660 2A2 A3 9 4 8616765 0 0
-MQ 5 33 0 116660 016765 3A3 A4 9 4 761686016360 157
-MQ 5 34 0 1716765 016860 4A4 A6 9 4 6616945 0 0
-MQ 5 35 0 1716860 016945 6A6 9 4 46 0 0 0
-MQ 5 36 20198922000320003 1 8388608 0 9437183 system
-MQ 5 37 0 0 0 019893 1SYSL 0 0 101 0
-MQ 5 38 0 0 0 0 0 0 0
-MQ 5 3916555A1 16555A1 16660A2 16765A3 16860A4 0 16945A6
-MQ 5 4016360B1 0 16425B3 16490B4
-MQ 5 41 0 0 0 0 0
-MQ 5 42 157LOW1 232LOW2 317LOW3 0 0 0
-MQ 5 4316555A1 16660A2 16765A3 16860A4 16945A6 16945A6
-MQ 5 4416360B1 16425B3 16425B3 16490B4 0 0
-MQ 5 4516490B4 0 0 0 0 0
-MQ 5 46 157LOW1 232LOW2 317LOW3 0 0 0
-MQ 5 4716555A1 16660A2 16765A3 16860A4 16945A6 16945A6
-MQ 5 4816360B1 0 16425B3 16490B4 0 0
-MQ 6 0TEST TABLE BUILDING, PART 2.
-MQ 6 1 // 0 20 0 -20510 137755
-MQ 6 2 10 8 29 35 164 6000 2 20
-MQ 6 3 1 137 39220003 0 1048577 3145728 9437183 QDIV1
-MQ 6 4 0 2571676316765 157 16LOW1 LOW2 19 4 46 232 0 0
-MQ 6 5 1 257 15716765 232 17LOW2 LOW3 19 4 56 317 0 0
-MQ 6 6 0 257 23216765 317 18LOW3 19 4 66 0 0 0
-MQ 6 7 2163501700020003 1 1048578 3145728 9437183 QDIV2
-MQ 6 8 0 257167641676516360 7B1 B3 9 4 4616425 0 0
-MQ 6 9 0 257163601676516425 9B3 B4 9 4 4616490 0 0
-MQ 6 10 0 257164251676516490 10B4 9 4 46 0 0 0
-MQ 6 11 1 1 8 016555 1A1 A2 9 4 8616660 0 0
-MQ 6 12 0 1716555 016660 2A2 A3 9 4 8616765 0 0
-MQ 6 13 0 116660 016765 3A3 A4 9 4 761686016360 157
-MQ 6 14 0 1716765 016860 4A4 A6 9 4 6616945 0 0
-MQ 6 15 0 1716860 016945 6A6 9 4 46 0 0 0
-MQ 6 16 20170022000320003 1 8388608 0 9437183 system
-MQ 6 17 1 0 0 017003 1FILL 0 0 2880 0
-MQ 6 18 0 0 0 019893 1SYSL 0 0 101 0
-MQ 6 19 0 0 0 0 0 0 0
-MQ 6 2016555A1 16555A1 16660A2 16765A3 16860A4 0 16945A6
-MQ 6 2116360B1 0 16425B3 16490B4
-MQ 6 22 0 0 0 0 0
-MQ 6 23 157LOW1 232LOW2 317LOW3 0 0 0
-MQ 6 2416555A1 16660A2 16765A3 16860A4 16945A6 16945A6
-MQ 6 2516360B1 16425B3 16425B3 16490B4 0 0
-MQ 6 2616490B4 0 0 0 0 0
-MQ 6 27 157LOW1 232LOW2 317LOW3 0 0 0
-MQ 6 2816555A1 16660A2 16765A3 16860A4 16945A6 16945A6
-MQ 6 2916360B1 0 16425B3 16490B4 0 0
-MQ 6 30 524291 0 524291 0 2 2 0
-MQ 6 31 0 0 2189 2560 4588 4612
-MQ 6 32 0 1 3 0 137 392 2 10 85
-MQ 6 33 8 2 3 01635017000 10 18 105
-MQ 6 34 16 20 3 01700220003 18 26 2890
-MQ 6 35 2189 2191 2215 4578 0 3620003
-MQ 6 36 2 137 212 0 1 6 297 392 -85 0
-MQ 6 37 101635016545 105 1 141665017000 0 0
-MQ 6 38 181700217002 2890 1 221989220003 0 0
-MQ 6 39 2207 45741700220003 2890 1
-MQ 6 40 // 0 20 0 -20510 137755
-MQ 6 41 10 8 29 35 164 6000 2 20
-MQ 6 42 1 137 30720003 0 1048577 3145728 9437183 QDIV1
-MQ 6 43 0 2571676316765 157 16LOW1 LOW3 19 4 46 232 0 0
-MQ 6 44 0 257 15716765 232 18LOW3 19 4 66 0 0 0
-MQ 6 45 2164551700020003 1 1048578 3145728 9437183 QDIV2
-MQ 6 46 0 257167641676516465 7B1 B3 9 4 4616530 0 0
-MQ 6 47 0 257164651676516530 9B3 B4 9 4 4616595 0 0
-MQ 6 48 0 257165301676516595 10B4 9 4 46 0 0 0
-MQ 6 49 0 17 8 016660 2A2 A3 9 4 8616765 0 0
-MQ 6 50 0 116660 016765 3A3 A4 9 4 761686016465 157
-MQ 6 51 0 1716765 016860 4A4 A6 9 4 6616945 0 0
-MQ 6 52 0 1716860 016945 6A6 9 4 46 0 0 0
-MQ 6 53 20198922000320003 1 8388608 0 9437183 system
-MQ 6 54 0 0 0 019893 1SYSL 0 0 101 0
-MQ 6 55 0 0 0 0 0 0 0
-MQ 6 5616660A2 0 16660A2 16765A3 16860A4 0 16945A6
-MQ 6 5716465B1 0 16530B3 16595B4
-MQ 6 58 0 0 0 0 0
-MQ 6 59 157LOW1 0 232LOW3 0 0 0
-MQ 6 6016660A2 16660A2 16765A3 16860A4 16945A6 16945A6
-MQ 6 6116465B1 16530B3 16530B3 16595B4 0 0
-MQ 6 6216595B4 0 0 0 0 0
-MQ 6 63 157LOW1 0 232LOW3 0 0 0
-MQ 6 6416660A2 16660A2 16765A3 16860A4 16945A6 16945A6
-MQ 6 6516465B1 0 16530B3 16595B4 0 0
-MQ 7 0CREATE DIVISIONS 3,20,19,4,5,18.
-MQ 7 1 // 0 18 0 -20510 137755
-MQ 7 2 10 8 29 35 164 6000 5 17
-MQ 7 3 1 137 30720003 0 1048577 3145728 9437183 QDIV1
-MQ 7 4 2 8455 900020003 1 1048578 3145728 9437183 QDIV2
-MQ 7 5 3 9000 9000 2000 0 1048580 3145728 9437183 TESTDIV3
-MQ 7 6 41140011400 4000 1 1048584 3145728 9437183 TDIV04
-MQ 7 7 51140011400 4000 0 1048592 3145728 9437183 TDIV05
-MQ 7 8 17154921560320003 1 8388608 0 9437183 system
-MQ 7 9 181680316803 4000 1 2228224 3145728 9437183 TDIV18
-MQ 7 10 191680316803 4000 0 2359296 3145728 9437183 TDIV19
-MQ 7 11 202000320003 4000 1 4718592 0 9437183 TDIV20
-MQ 8 0TEST ZSHUNT.
-MQ 8 1 // 0 20 0 -20510 137755
-MQ 8 2 10 8 29 35 164 6000 5 17
-MQ 8 3 1 137 30720003 0 1048577 3145728 9437183 QDIV1
-MQ 8 4 0 257 8763 8765 157 16LOW1 LOW3 19 4 46 232 0 0
-MQ 8 5 0 257 157 8765 232 18LOW3 19 4 66 0 0 0
-MQ 8 6 2 8455 900020003 1 1048578 3145728 9437183 QDIV2
-MQ 8 7 1 257 8764 8765 8465 7B1 B3 9 4 46 8530 0 0
-MQ 8 8 0 257 8465 8765 8530 9B3 B4 9 4 46 8595 0 0
-MQ 8 9 0 257 8530 8765 8595 10B4 9 4 46 0 0 0
-MQ 8 10 0 17 1 0 8660 2A2 A3 9 4 86 8765 9435 0
-MQ 8 11 0 1 8660 0 8765 3A3 A4 9 4 76 8860 8465 157
-MQ 8 12 1 17 8765 0 8860 4A4 A6 9 4 66 8945 0 0
-MQ 8 13 0 17 8860 0 8945 6A6 9 4 46 0 0 0
-MQ 8 14 3 900010184 2000 0 1048580 3145728 9437183 TESTDIV3
-MQ 8 15 0 0 9075 8660 9010 6A6 9 4 46 0 0 0
-MQ 8 16 0 0 9150 8660 9075 5A5 A6 9 4 56 9010 0 0
-MQ 8 17 0 0 9235 8660 9150 4A4 A5 9 4 66 9075 0 0
-MQ 8 18 0 0 9330 8660 9235 3A3 A4 9 4 76 9150 9735 0
-MQ 8 19 1 0 9435 8660 9330 2A2 A3 9 4 86 9235 0 0
-MQ 8 20 0 0 8659 8660 9435 1A1 A2 9 4 86 9330 0 0
-MQ 8 21 0 0 9605 9235 9540 10B4 9 4 46 0 0 0
-MQ 8 22 0 0 9670 9235 9605 9B3 B4 9 4 46 9540 0 0
-MQ 8 23 0 0 9735 9235 9670 8B2 B3 9 4 46 9605 0 0
-MQ 8 24 0 0 9234 9235 9735 7B1 B2 9 4 46 9670 0 0
-MQ 8 25 1 0 9875 9670 9800 14C4 9 1 56 010099 0
-MQ 8 26 1 0 9950 9670 9875 13C3 C4 9 1 56 9800 0 9435
-MQ 8 27 1 010025 9670 9950 12C2 C3 9 1 56 9875 0 0
-MQ 8 28 1 0 9668 967010025 11C1 C2 9 1 56 9950 0 0
-MQ 8 29 1 0 9799 980010099 15D1 6 0 76 0 0 0
-MQ 8 30 41021611400 4000 1 1048584 3145728 9437183 TDIV04
-MQ 8 31 1 0105441054510225 15D1 6 0 76 0 0 0
-MQ 8 32 1 0106831068510320 11C1 C2 9 1 5610395 0 0
-MQ 8 33 1 0103201068510395 12C2 C3 9 1 5610470 0 0
-MQ 8 34 1 0103951068510470 13C3 C4 9 1 5610545 010880
-MQ 8 35 1 0104701068510545 14C4 9 1 56 010225 0
-MQ 8 36 1 0110891109010620 7B1 B2 9 4 4610685 0 0
-MQ 8 37 1 0106201109010685 8B2 B3 9 4 4610750 010320
-MQ 8 38 1 0106851109010750 9B3 B4 9 4 4610815 0 0
-MQ 8 39 1 0107501109010815 10B4 9 4 46 0 0 0
-MQ 8 40 1 0 8 010880 1A1 A2 9 4 8610985 0 0
-MQ 8 41 1 010880 010985 2A2 A3 9 4 8611090 0 0
-MQ 8 42 1 010985 011090 3A3 A4 9 4 761118510620 0
-MQ 8 43 1 011090 011185 4A4 A5 9 4 6611270 0 0
-MQ 8 44 1 011185 011270 5A5 A6 9 4 5611345 0 0
-MQ 8 45 1 011270 011345 6A6 9 4 46 0 0 0
-MQ 8 46 51140012584 4000 0 1048592 3145728 9437183 TDIV05
-MQ 8 47 0 011475 011410 6A6 9 4 46 0 0 0
-MQ 8 48 0 011550 011475 5A5 A6 9 4 5611410 012499
-MQ 8 49 0 011635 011550 4A4 A5 9 4 6611475 0 0
-MQ 8 50 0 011730 011635 3A3 A4 9 4 7611550 0 0
-MQ 8 51 0 011835 011730 2A2 A3 9 4 8611635 0 0
-MQ 8 52 0 0 2 011835 1A1 A2 9 4 8611730 0 0
-MQ 8 53 1 0120051163511940 10B4 9 4 46 0 0 0
-MQ 8 54 1 0120701163512005 9B3 B4 9 4 4611940 0 0
-MQ 8 55 1 0121351163512070 8B2 B3 9 4 4612005 012425
-MQ 8 56 1 0116341163512135 7B1 B2 9 4 4612070 0 0
-MQ 8 57 1 0122751207012200 14C4 9 1 56 0 0 0
-MQ 8 58 1 0123501207012275 13C3 C4 9 1 5612200 011835
-MQ 8 59 1 0124251207012350 12C2 C3 9 1 5612275 0 0
-MQ 8 60 1 0120681207012425 11C1 C2 9 1 5612350 0 0
-MQ 8 61 0 0114731147512499 15D1 6 0 76 0 0 0
-MQ 8 62 17154921560320003 1 8388608 0 9437183 system
-MQ 8 63 0 0 0 015493 1SYSL 0 0 101 0
-MQ 8 64 181561916803 4000 1 2228224 3145728 9437183 TDIV18
-MQ 8 65 0 0159471594815628 15D1 6 0 76 0 0 0
-MQ 8 66 0 0160861608815723 11C1 C2 9 1 5615798 0 0
-MQ 8 67 0 0157231608815798 12C2 C3 9 1 5615873 0 0
-MQ 8 68 0 0157981608815873 13C3 C4 9 1 5615948 016283
-MQ 8 69 0 0158731608815948 14C4 9 1 56 015628 0
-MQ 8 70 0 0164921649316023 7B1 B2 9 4 4616088 0 0
-MQ 8 71 0 0160231649316088 8B2 B3 9 4 4616153 015723
-MQ 8 72 0 0160881649316153 9B3 B4 9 4 4616218 0 0
-MQ 8 73 0 0161531649316218 10B4 9 4 46 0 0 0
-MQ 8 74 0 0 6 016283 1A1 A2 9 4 8616388 017238
-MQ 8 75 1 016283 016388 2A2 A3 9 4 8616493 0 0
-MQ 8 76 0 016388 016493 3A3 9 4 76 016023 0
-MQ 8 77 1 016493 016588 4A4 A5 9 4 6616673 0 0
-MQ 8 78 1 016588 016673 5A5 A6 9 4 5616748 0 0
-MQ 8 79 1 016673 016748 6A6 9 4 46 0 0 0
-MQ 8 80 191680317987 4000 0 2359296 3145728 9437183 TDIV19
-MQ 8 81 0 0168781628316813 6A6 9 4 46 0 0 0
-MQ 8 82 0 0169531628316878 5A5 A6 9 4 5616813 0 0
-MQ 8 83 0 0170381628316953 4A4 A5 9 4 6616878 0 0
-MQ 8 84 0 0171331628317038 3A3 A4 9 4 761695317538 0
-MQ 8 85 0 0172381628317133 2A2 A3 9 4 8617038 0 0
-MQ 8 86 0 0162811628317238 1A1 A2 9 4 8617133 0 0
-MQ 8 87 0 0174081703817343 10B4 9 4 46 0 0 0
-MQ 8 88 0 0174731703817408 9B3 B4 9 4 4617343 0 0
-MQ 8 89 0 0175381703817473 8B2 B3 9 4 4617408 017828
-MQ 8 90 0 0170371703817538 7B1 B2 9 4 4617473 0 0
-MQ 8 91 0 0176781747317603 14C4 9 1 56 017902 0
-MQ 8 92 0 0177531747317678 13C3 C4 9 1 5617603 017238
-MQ 8 93 0 0178281747317753 12C2 C3 9 1 5617678 0 0
-MQ 8 94 0 0174711747317828 11C1 C2 9 1 5617753 0 0
-MQ 8 95 0 0176021760317902 15D1 6 0 76 0 0 0
-MQ 8 96 201881920003 4000 1 4718592 0 9437183 TDIV20
-MQ 8 97 0 0190721907318828 15D1 6 0 76 0 0 0
-MQ 8 98 0 0192861928818923 11C1 C2 9 1 5618998 0 0
-MQ 8 99 0 0189231928818998 12C2 C3 9 1 5619073 0 0
-MQ 8100 0 0189981928819073 13C3 C4 9 1 56191481882819483
-MQ 8101 0 0190731928819148 14C4 9 1 56 0 0 0
-MQ 8102 0 0194181978819223 7B1 9 4 46 0 0 0
-MQ 8103 0 0197861978819288 8B2 B3 9 4 4619353 018923
-MQ 8104 0 0192881978819353 9B3 B4 9 4 4619418 0 0
-MQ 8105 0 0193531978819418 10B4 B1 9 4 4619223 0 0
-MQ 8106 0 0 0 019483 1A1 A3 9 4 8619693 0 0
-MQ 8107 0 019873 019588 2A2 A6 9 4 8619948 0 0
-MQ 8108 0 019483 019693 3A3 A4 9 4 7619788 0 0
-MQ 8109 0 019693 019788 4A4 A5 9 4 6619873 019288
-MQ 8110 0 019788 019873 5A5 A2 9 4 5619588 0 0
-MQ 8111 0 019588 019948 6A6 9 4 46 0 0 0
-MQ 8112 8660A2 11835A1 0 0 0 16283A1 19483A1
-MQ 8113 0 19483A1 19588A2 19693A3 19788A4 19873A5 19948A6
-MQ 811419223B1 19288B2 19353B3 19418B4
-MQ 811518923C1 18998C2 19073C3 19148C4 18828D1
-MQ 8116 157LOW1 0 232LOW3 0 0 0
-MQ 8117 8660A2 8660A2 8765A3 8860A4 8945A6 8945A6
-MQ 8118 8465B1 8530B3 8530B3 8595B4 0 0
-MQ 8119 8595B4 0 0 0 0 0
-MQ 8120 157LOW1 0 232LOW3 0 0 0
-MQ 812119483A1 19588A2 19693A3 19788A4 19873A5 19948A6
-MQ 812219223B1 19288B2 19353B3 19418B4 18923C1 18998C2
-MQ 9 0TEST MZIXCO + MZXREF.
-MQ 9 1107374182710768875521073741839107583897910774118431076887555
-MQ 9 2 16 16 16 16 16 16
-MQ 9 3 161073741951 161073757184 161073743904
-MQ 9 4 // 0 5 0 -20510 137755
-MQ 9 5 10 8 29 35 164 6000 5 17
-MQ 9 6 1 137 30720003 0 1048577 3145728 9437183 QDIV1
-MQ 9 7 2 8455 900020003 1 1048578 3145728 9437183 QDIV2
-MQ 9 8 3 900010184 2000 0 1048580 3161215 9437183 TESTDIV3
-MQ 9 9 41021611400 4000 1 1048584 3161471 9437183 TDIV04
-MQ 9 10 51140012584 4000 0 1048592 2097535 9437183 TDIV05
-MQ 9 11 17154921560320003 1 8388608 0 9437183 system
-MQ 9 12 181561916803 4000 1 2228224 3145728 9437183 TDIV18
-MQ 9 13 191680317987 4000 0 2359296 3145728 9437183 TDIV19
-MQ 9 14 201881920003 4000 1 4718592 0 9437183 TDIV20
-MQ 9 15 // 0 4 0 -20510 137755
-MQ 9 16 10 8 29 35 164 6000 5 17
-MQ 9 17 1 137 30720003 0 1048577 3145728 9437183 QDIV1
-MQ 9 18 2 8455 900020003 1 1048578 3145728 9437183 QDIV2
-MQ 9 19 3 900010184 2000 0 1048580 3157119 9433087 TESTDIV3
-MQ 9 20 41021611400 4000 1 1048584 2110815 9435103 TDIV04
-MQ 9 21 51140012584 4000 0 1048592 2097503 9435103 TDIV05
-MQ 9 22 17154921560320003 1 8388608 0 9437183 system
-MQ 9 23 181561916803 4000 1 2228224 3145728 9437183 TDIV18
-MQ 9 24 191680317987 4000 0 2359296 3145728 9437183 TDIV19
-MQ 9 25 201881920003 4000 1 4718592 0 9437183 TDIV20
-MQ 10 0TEST MZPUSH.
-MQ 10 1 // 0 19 0 -20510 137755
-MQ 10 2 10 8 29 35 164 6000 5 17
-MQ 10 3 1 137 30720003 0 1048577 3145728 9437183 QDIV1
-MQ 10 4 2 8455 900020003 1 1048578 3145728 9437183 QDIV2
-MQ 10 5 3 900010184 2000 0 1048580 3157119 9433087 TESTDIV3
-MQ 10 6 41021611400 4000 1 1048584 2110815 9435103 TDIV04
-MQ 10 7 51140012584 4000 0 1048592 2097503 9435103 TDIV05
-MQ 10 8 17154921560320003 1 8388608 0 9437183 system
-MQ 10 9 181561916803 4000 1 2228224 3145728 9437183 TDIV18
-MQ 10 10 191680318622 4000 0 2359296 3145728 9437183 TDIV19
-MQ 10 11 201877920003 4000 1 4718592 0 9437183 TDIV20
-MQ 10 12 // 0 20 0 -20510 137755
-MQ 10 13 10 8 29 35 164 6000 5 17
-MQ 10 14 1 137 30720003 0 1048577 3145728 9437183 QDIV1
-MQ 10 15 2 8254 879920003 1 1048578 3145728 9437183 QDIV2
-MQ 10 16 3 8799 9983 2000 0 1048580 3157119 9433087 TESTDIV3
-MQ 10 17 41001511199 4000 1 1048584 2110815 9435103 TDIV04
-MQ 10 18 51119912383 4000 0 1048592 2097503 9435103 TDIV05
-MQ 10 19 17152911540220003 1 8388608 0 9437183 system
-MQ 10 20 181541816602 4000 1 2228224 3145728 9437183 TDIV18
-MQ 10 21 191660218421 4000 0 2359296 3145728 9437183 TDIV19
-MQ 10 22 201857420003 4000 1 4718592 0 9437183 TDIV20
-MQ 10 23 // 0 20 0 -20510 137755
-MQ 10 24 10 8 29 35 164 6000 5 17
-MQ 10 25 1 137 30720003 0 1048577 3145728 9437183 QDIV1
-MQ 10 26 0 257 8562 8564 157 16LOW1 LOW3 19 4 46 232 0 0
-MQ 10 27 0 257 157 8564 232 18LOW3 19 4 66 0 0 0
-MQ 10 28 2 8254 879920003 1 1048578 3145728 9437183 QDIV2
-MQ 10 29 1 257 8563 8564 8264 7B1 B3 9 4 46 8329 0 0
-MQ 10 30 0 257 8264 8564 8329 9B3 B4 9 4 46 8394 0 0
-MQ 10 31 0 257 8329 8564 8394 10B4 9 4 46 0 0 0
-MQ 10 32 0 17 1 0 8459 2A2 A3 9 4 86 8564 9234 0
-MQ 10 33 0 1 8459 0 8564 3A3 A4 9 4 76 8659 8264 157
-MQ 10 34 1 17 8564 0 8659 4A4 A6 9 4 66 8744 0 0
-MQ 10 35 0 17 8659 0 8744 6A6 9 4 46 0 0 0
-MQ 10 36 3 8799 9983 2000 0 1048580 3157119 9433087 TESTDIV3
-MQ 10 37 0 0 8874 8459 8809 6A6 9 4 46 0 0 0
-MQ 10 38 0 0 8949 8459 8874 5A5 A6 9 4 56 8809 0 0
-MQ 10 39 0 0 9034 8459 8949 4A4 A5 9 4 66 8874 0 0
-MQ 10 40 0 0 9129 8459 9034 3A3 A4 9 4 76 8949 9534 0
-MQ 10 41 1 0 9234 8459 9129 2A2 A3 9 4 86 9034 0 0
-MQ 10 42 0 0 8458 8459 9234 1A1 A2 9 4 86 9129 0 0
-MQ 10 43 0 0 9404 9034 9339 10B4 9 4 46 0 0 0
-MQ 10 44 0 0 9469 9034 9404 9B3 B4 9 4 46 9339 0 0
-MQ 10 45 0 0 9534 9034 9469 8B2 B3 9 4 46 9404 0 0
-MQ 10 46 0 0 9033 9034 9534 7B1 B2 9 4 46 9469 0 0
-MQ 10 47 1 0 9674 9469 9599 14C4 9 1 56 0 9898 0
-MQ 10 48 1 0 9749 9469 9674 13C3 C4 9 1 56 9599 0 9234
-MQ 10 49 1 0 9824 9469 9749 12C2 C3 9 1 56 9674 0 0
-MQ 10 50 1 0 9467 9469 9824 11C1 C2 9 1 56 9749 0 0
-MQ 10 51 1 0 9598 9599 9898 15D1 6 0 76 0 0 0
-MQ 10 52 41001511199 4000 1 1048584 2110815 9435103 TDIV04
-MQ 10 53 1 0103431034410024 15D1 6 0 76 0 0 0
-MQ 10 54 1 0104821048410119 11C1 C2 9 1 5610194 0 0
-MQ 10 55 1 0101191048410194 12C2 C3 9 1 5610269 0 0
-MQ 10 56 1 0101941048410269 13C3 C4 9 1 5610344 010679
-MQ 10 57 1 0102691048410344 14C4 9 1 56 010024 0
-MQ 10 58 1 0108881088910419 7B1 B2 9 4 4610484 0 0
-MQ 10 59 1 0104191088910484 8B2 B3 9 4 4610549 010119
-MQ 10 60 1 0104841088910549 9B3 B4 9 4 4610614 0 0
-MQ 10 61 1 0105491088910614 10B4 9 4 46 0 0 0
-MQ 10 62 1 0 8 010679 1A1 A2 9 4 8610784 0 0
-MQ 10 63 1 010679 010784 2A2 A3 9 4 8610889 0 0
-MQ 10 64 1 010784 010889 3A3 A4 9 4 761098410419 0
-MQ 10 65 1 010889 010984 4A4 A5 9 4 6611069 0 0
-MQ 10 66 1 010984 011069 5A5 A6 9 4 5611144 0 0
-MQ 10 67 1 011069 011144 6A6 9 4 46 0 0 0
-MQ 10 68 51119912383 4000 0 1048592 2097503 9435103 TDIV05
-MQ 10 69 0 011274 011209 6A6 9 4 46 0 0 0
-MQ 10 70 0 011349 011274 5A5 A6 9 4 5611209 012298
-MQ 10 71 0 011434 011349 4A4 A5 9 4 6611274 0 0
-MQ 10 72 0 011529 011434 3A3 A4 9 4 7611349 0 0
-MQ 10 73 0 011634 011529 2A2 A3 9 4 3611434 0 0
-MQ 10 74 1 0 0 011575 0D 0 0 40 0
-MQ 10 75 0 0 2 011634 1A1 A2 9 4 8611529 0 0
-MQ 10 76 1 0118041143411739 10B4 9 4 46 0 0 0
-MQ 10 77 1 0118691143411804 9B3 B4 9 4 4611739 0 0
-MQ 10 78 1 0119341143411869 8B2 B3 9 4 4611804 012224
-MQ 10 79 1 0114331143411934 7B1 B2 9 4 4611869 0 0
-MQ 10 80 1 0120741186911999 14C4 9 1 56 0 0 0
-MQ 10 81 1 0121491186912074 13C3 C4 9 1 5611999 011634
-MQ 10 82 1 0122241186912149 12C2 C3 9 1 5612074 0 0
-MQ 10 83 1 0118671186912224 11C1 C2 9 1 5612149 0 0
-MQ 10 84 0 0112721127412298 15D1 6 0 76 0 0 0
-MQ 10 85 17152911540220003 1 8388608 0 9437183 system
-MQ 10 86 0 0 0 015292 1SYSL 0 0 101 0
-MQ 10 87 181541816602 4000 1 2228224 3145728 9437183 TDIV18
-MQ 10 88 0 0157461574715427 15D1 6 0 76 0 0 0
-MQ 10 89 0 0158851588715522 11C1 C2 9 1 5615597 0 0
-MQ 10 90 0 0155221588715597 12C2 C3 9 1 5615672 0 0
-MQ 10 91 0 0155971588715672 13C3 C4 9 1 5615747 016082
-MQ 10 92 0 0156721588715747 14C4 9 1 56 015427 0
-MQ 10 93 0 0162911629215822 7B1 B2 9 4 4615887 0 0
-MQ 10 94 0 0158221629215887 8B2 B3 9 4 4615952 015522
-MQ 10 95 0 0158871629215952 9B3 B4 9 4 4616017 0 0
-MQ 10 96 0 0159521629216017 10B4 9 4 46 0 0 0
-MQ 10 97 0 0 6 016082 1A1 A2 9 4 8616187 017037
-MQ 10 98 1 016082 016187 2A2 A3 9 4 8616292 0 0
-MQ 10 99 0 016187 016292 3A3 9 4 76 015822 0
-MQ 10100 1 016292 016387 4A4 A5 9 4 6616472 0 0
-MQ 10101 1 016387 016472 5A5 A6 9 4 5616547 0 0
-MQ 10102 1 016472 016547 6A6 9 4 46 0 0 0
-MQ 10103 191660218421 4000 0 2359296 3145728 9437183 TDIV19
-MQ 10104 0 0166771608216612 6A6 9 4 46 0 0 0
-MQ 10105 0 0167521608216677 5A5 A6 9 4 5616612 0 0
-MQ 10106 0 0181361608216752 4A4 A5 9 4 6616677 0 0
-MQ 10107 1 0169321608216837 3A3 A4 9 4 761675217337 0
-MQ 10108 0 0170371608216932 2A2 A3 9 4 8618136 0 0
-MQ 10109 0 0160801608217037 1A1 A2 9 4 8616932 0 0
-MQ 10110 0 0172071813617142 10B4 9 4 46 0 0 0
-MQ 10111 0 0172721813617207 9B3 B4 9 4 4617142 0 0
-MQ 10112 0 0173371813617272 8B2 B3 9 4 4617207 017627
-MQ 10113 0 0181351813617337 7B1 B2 9 4 4617272 0 0
-MQ 10114 0 0174771727217402 14C4 9 1 56 017701 0
-MQ 10115 0 0175521727217477 13C3 C4 9 1 5617402 017037
-MQ 10116 0 0176271727217552 12C2 C3 9 1 5617477 0 0
-MQ 10117 0 0172701727217627 11C1 C2 9 1 5617552 0 0
-MQ 10118 0 0174011740217701 15D1 6 0 276 0 0 0
-MQ 10119 1 0 0 017987 0D 0 0 90 0
-MQ 10120 0 0169321608218136 3A3 A4 49 4 2761675217337 0
-MQ 10121 201857420003 4000 1 4718592 0 9437183 TDIV20
-MQ 10122 0 019693 018604 4A4 A5 29 4 16619873 019288
-MQ 10123 0 0190721907318828 15D1 46 0 76 0 0 0
-MQ 10124 0 0192861928818923 11C1 C2 9 1 5618998 0 0
-MQ 10125 0 0189231928818998 12C2 C3 9 1 5619073 0 0
-MQ 10126 0 0189981928819073 13C3 C4 9 1 56191481882819483
-MQ 10127 0 0190731928819148 14C4 9 1 56 0 0 0
-MQ 10128 0 0194181860419223 7B1 9 4 46 0 0 0
-MQ 10129 0 0186021860419288 8B2 B3 9 4 4619353 018923
-MQ 10130 0 0192881860419353 9B3 B4 9 4 4619418 0 0
-MQ 10131 0 0193531860419418 10B4 B1 9 4 4619223 0 0
-MQ 10132 0 0 0 019483 1A1 A3 9 4 8619693 0 0
-MQ 10133 0 019873 019588 2A2 A6 9 4 8619948 0 0
-MQ 10134 0 019483 019693 3A3 A4 9 4 7618604 0 0
-MQ 10135 1 019693 019788 4A4 A5 9 4 6619873 019288
-MQ 10136 0 018604 019873 5A5 A2 9 4 5619588 0 0
-MQ 10137 0 019588 019948 6A6 9 4 46 0 0 0
-MQ 11 0TEST GARBAGE COLLECTION WITHOUT MOVE.
-MQ 11 1 // 0 20 0 -20510 137755
-MQ 11 2 10 8 29 35 164 6000 5 17
-MQ 11 3 1 137 30720003 0 1048577 3145728 9437183 QDIV1
-MQ 11 4 2 8254 879920003 1 1048578 3145728 9437183 QDIV2
-MQ 11 5 3 8799 9983 2000 0 1048580 3157119 9433087 TESTDIV3
-MQ 11 6 41001511199 4000 1 1048584 2110815 9435103 TDIV04
-MQ 11 7 51119912383 4000 0 1048592 2097503 9435103 TDIV05
-MQ 11 8 17152911540220003 1 8388608 0 9437183 system
-MQ 11 9 181574816602 4000 1 2228224 3145728 9437183 TDIV18
-MQ 11 10 191660218226 4000 0 2359296 3145728 9437183 TDIV19
-MQ 11 11 201857420003 4000 1 4718592 0 9437183 TDIV20
-MQ 11 12 // 0 20 0 -20510 137755
-MQ 11 13 10 8 29 35 164 6000 5 17
-MQ 11 14 1 137 30720003 0 1048577 3145728 9437183 QDIV1
-MQ 11 15 0 257 8562 8564 157 16LOW1 LOW3 19 4 46 232 0 0
-MQ 11 16 0 257 157 8564 232 18LOW3 19 4 66 0 0 0
-MQ 11 17 2 8254 879920003 1 1048578 3145728 9437183 QDIV2
-MQ 11 18 1 257 8563 8564 8264 7B1 B3 9 4 46 8329 0 0
-MQ 11 19 0 257 8264 8564 8329 9B3 B4 9 4 46 8394 0 0
-MQ 11 20 0 257 8329 8564 8394 10B4 9 4 46 0 0 0
-MQ 11 21 0 17 1 0 8459 2A2 A3 9 4 86 8564 9234 0
-MQ 11 22 0 1 8459 0 8564 3A3 A4 9 4 76 8659 8264 157
-MQ 11 23 1 17 8564 0 8659 4A4 A6 9 4 66 8744 0 0
-MQ 11 24 0 17 8659 0 8744 6A6 9 4 46 0 0 0
-MQ 11 25 3 8799 9983 2000 0 1048580 3157119 9433087 TESTDIV3
-MQ 11 26 0 0 8874 8459 8809 6A6 9 4 46 0 0 0
-MQ 11 27 0 0 8949 8459 8874 5A5 A6 9 4 56 8809 0 0
-MQ 11 28 0 0 9034 8459 8949 4A4 A5 9 4 66 8874 0 0
-MQ 11 29 0 0 9129 8459 9034 3A3 A4 9 4 76 8949 9534 0
-MQ 11 30 1 0 9234 8459 9129 2A2 A3 9 4 86 9034 0 0
-MQ 11 31 0 0 8458 8459 9234 1A1 A2 9 4 86 9129 0 0
-MQ 11 32 0 0 9404 9034 9339 10B4 9 4 46 0 0 0
-MQ 11 33 0 0 9469 9034 9404 9B3 B4 9 4 46 9339 0 0
-MQ 11 34 0 0 9534 9034 9469 8B2 B3 9 4 46 9404 0 0
-MQ 11 35 0 0 9033 9034 9534 7B1 B2 9 4 46 9469 0 0
-MQ 11 36 1 0 9674 9469 9599 14C4 9 1 56 0 9898 0
-MQ 11 37 1 0 9749 9469 9674 13C3 C4 9 1 56 9599 0 9234
-MQ 11 38 1 0 9824 9469 9749 12C2 C3 9 1 56 9674 0 0
-MQ 11 39 1 0 9467 9469 9824 11C1 C2 9 1 56 9749 0 0
-MQ 11 40 1 0 9598 9599 9898 15D1 6 0 76 0 0 0
-MQ 11 41 41001511199 4000 1 1048584 2110815 9435103 TDIV04
-MQ 11 42 1 0103431034410024 15D1 6 0 76 0 0 0
-MQ 11 43 1 0104821048410119 11C1 C2 9 1 5610194 0 0
-MQ 11 44 1 0101191048410194 12C2 C3 9 1 5610269 0 0
-MQ 11 45 1 0101941048410269 13C3 C4 9 1 5610344 010679
-MQ 11 46 1 0102691048410344 14C4 9 1 56 010024 0
-MQ 11 47 1 0108881088910419 7B1 B2 9 4 4610484 0 0
-MQ 11 48 1 0104191088910484 8B2 B3 9 4 4610549 010119
-MQ 11 49 1 0104841088910549 9B3 B4 9 4 4610614 0 0
-MQ 11 50 1 0105491088910614 10B4 9 4 46 0 0 0
-MQ 11 51 1 0 8 010679 1A1 A2 9 4 8610784 0 0
-MQ 11 52 1 010679 010784 2A2 A3 9 4 8610889 0 0
-MQ 11 53 1 010784 010889 3A3 A4 9 4 761098410419 0
-MQ 11 54 1 010889 010984 4A4 A5 9 4 6611069 0 0
-MQ 11 55 1 010984 011069 5A5 A6 9 4 5611144 0 0
-MQ 11 56 1 011069 011144 6A6 9 4 46 0 0 0
-MQ 11 57 51119912383 4000 0 1048592 2097503 9435103 TDIV05
-MQ 11 58 0 011274 011209 6A6 9 4 46 0 0 0
-MQ 11 59 0 011349 011274 5A5 A6 9 4 5611209 012298
-MQ 11 60 0 011434 011349 4A4 A5 9 4 6611274 0 0
-MQ 11 61 0 011529 011434 3A3 A4 9 4 7611349 0 0
-MQ 11 62 0 011634 011529 2A2 A3 9 4 3611434 0 0
-MQ 11 63 1 0 0 011575 0D 0 0 40 0
-MQ 11 64 0 0 2 011634 1A1 A2 9 4 8611529 0 0
-MQ 11 65 1 0118041143411739 10B4 9 4 46 0 0 0
-MQ 11 66 1 0118691143411804 9B3 B4 9 4 4611739 0 0
-MQ 11 67 1 0119341143411869 8B2 B3 9 4 4611804 012224
-MQ 11 68 1 0114331143411934 7B1 B2 9 4 4611869 0 0
-MQ 11 69 1 0120741186911999 14C4 9 1 56 0 0 0
-MQ 11 70 1 0121491186912074 13C3 C4 9 1 5611999 011634
-MQ 11 71 1 0122241186912149 12C2 C3 9 1 5612074 0 0
-MQ 11 72 1 0118671186912224 11C1 C2 9 1 5612149 0 0
-MQ 11 73 0 0112721127412298 15D1 6 0 76 0 0 0
-MQ 11 74 17152911540220003 1 8388608 0 9437183 system
-MQ 11 75 0 0 0 015292 1SYSL 0 0 101 0
-MQ 11 76 181574816602 4000 1 2228224 3145728 9437183 TDIV18
-MQ 11 77 0 0160761607715757 15D1 6 0 76 0 0 0
-MQ 11 78 0 0162151621715852 11C1 C2 9 1 5615927 0 0
-MQ 11 79 0 0158521621715927 12C2 C3 9 1 5616002 0 0
-MQ 11 80 0 0159271621716002 13C3 C4 9 1 5616077 016412
-MQ 11 81 0 0160021621716077 14C4 9 1 56 015757 0
-MQ 11 82 0 0165161651716152 7B1 B2 9 4 4616217 0 0
-MQ 11 83 0 0161521651716217 8B2 B3 9 4 4616282 015852
-MQ 11 84 0 0162171651716282 9B3 B4 9 4 4616347 0 0
-MQ 11 85 0 0162821651716347 10B4 9 4 46 0 0 0
-MQ 11 86 0 0 6 016412 1A1 A3 9 4 8616517 016942
-MQ 11 87 0 016412 016517 3A3 9 4 76 016152 0
-MQ 11 88 191660218226 4000 0 2359296 3145728 9437183 TDIV19
-MQ 11 89 0 0166771641216612 6A6 9 4 46 0 0 0
-MQ 11 90 0 0167521641216677 5A5 A6 9 4 5616612 0 0
-MQ 11 91 0 0179411641216752 4A4 A5 9 4 6616677 0 0
-MQ 11 92 0 0169421641216837 2A2 A3 9 4 8617941 0 0
-MQ 11 93 0 0164101641216942 1A1 A2 9 4 8616837 0 0
-MQ 11 94 0 0171121794117047 10B4 9 4 46 0 0 0
-MQ 11 95 0 0171771794117112 9B3 B4 9 4 4617047 0 0
-MQ 11 96 0 0172421794117177 8B2 B3 9 4 4617112 017532
-MQ 11 97 0 0179401794117242 7B1 B2 9 4 4617177 0 0
-MQ 11 98 0 0173821717717307 14C4 9 1 56 017606 0
-MQ 11 99 0 0174571717717382 13C3 C4 9 1 5617307 016942
-MQ 11100 0 0175321717717457 12C2 C3 9 1 5617382 0 0
-MQ 11101 0 0171751717717532 11C1 C2 9 1 5617457 0 0
-MQ 11102 0 0173061730717606 15D1 6 0 276 0 0 0
-MQ 11103 0 0168371641217941 3A3 A4 49 4 2761675217242 0
-MQ 11104 201857420003 4000 1 4718592 0 9437183 TDIV20
-MQ 11105 0 019693 018604 4A4 A5 29 4 16619873 019288
-MQ 11106 0 0190721907318828 15D1 46 0 76 0 0 0
-MQ 11107 0 0192861928818923 11C1 C2 9 1 5618998 0 0
-MQ 11108 0 0189231928818998 12C2 C3 9 1 5619073 0 0
-MQ 11109 0 0189981928819073 13C3 C4 9 1 56191481882819483
-MQ 11110 0 0190731928819148 14C4 9 1 56 0 0 0
-MQ 11111 0 0194181860419223 7B1 9 4 46 0 0 0
-MQ 11112 0 0186021860419288 8B2 B3 9 4 4619353 018923
-MQ 11113 0 0192881860419353 9B3 B4 9 4 4619418 0 0
-MQ 11114 0 0193531860419418 10B4 B1 9 4 4619223 0 0
-MQ 11115 0 0 0 019483 1A1 A3 9 4 8619693 0 0
-MQ 11116 0 019873 019588 2A2 A6 9 4 8619948 0 0
-MQ 11117 0 019483 019693 3A3 A4 9 4 7618604 0 0
-MQ 11118 1 019693 019788 4A4 A5 9 4 6619873 019288
-MQ 11119 0 018604 019873 5A5 A2 9 4 5619588 0 0
-MQ 11120 0 019588 019948 6A6 9 4 46 0 0 0
-MQ 11121 8459A2 11634A1 0 0 0 16412A1 19483A1
-MQ 11122 0 19483A1 19588A2 19693A3 18604A4 19873A5 19948A6
-MQ 1112319223B1 19288B2 19353B3 19418B4
-MQ 1112418923C1 18998C2 19073C3 19148C4 18828D1
-MQ 11125 157LOW1 0 232LOW3 0 0 0
-MQ 11126 8459A2 8459A2 8564A3 8659A4 8744A6 8744A6
-MQ 11127 8264B1 8329B3 8329B3 8394B4 0 0
-MQ 11128 8394B4 0 0 0 0 0
-MQ 11129 157LOW1 0 232LOW3 0 0 0
-MQ 1113019483A1 19588A2 19693A3 18604A4 19873A5 19948A6
-MQ 1113119223B1 19288B2 19353B3 19418B4 18923C1 18998C2
-MQ 11132 // 0 20 0 -20510 137755
-MQ 11133 10 8 29 35 164 6000 5 17
-MQ 11134 1 137 30720003 0 1048577 3145728 9437183 QDIV1
-MQ 11135 2 8404 879920003 1 1048578 3145728 9437183 QDIV2
-MQ 11136 3 8799 9983 2000 0 1048580 3157119 9433087 TESTDIV3
-MQ 11137 41001511199 4000 1 1048584 2110815 9435103 TDIV04
-MQ 11138 51119912383 4000 0 1048592 2097503 9435103 TDIV05
-MQ 11139 17152911540220003 1 8388608 0 9437183 system
-MQ 11140 181660216602 4000 1 2228224 3145728 9437183 TDIV18
-MQ 11141 191660216602 4000 0 2359296 3145728 9437183 TDIV19
-MQ 11142 201857420003 4000 1 4718592 0 9437183 TDIV20
-MQ 11143 // 0 20 0 -20510 137755
-MQ 11144 10 8 29 35 164 6000 5 17
-MQ 11145 1 137 30720003 0 1048577 3145728 9437183 QDIV1
-MQ 11146 0 257 8647 8649 157 16LOW1 LOW3 19 4 46 232 0 0
-MQ 11147 0 257 157 8649 232 18LOW3 19 4 66 0 0 0
-MQ 11148 2 8404 879920003 1 1048578 3145728 9437183 QDIV2
-MQ 11149 0 257 8648 8649 8414 9B3 B4 9 4 46 8479 0 0
-MQ 11150 0 257 8414 8649 8479 10B4 9 4 46 0 0 0
-MQ 11151 0 17 1 0 8544 2A2 A3 9 4 86 8649 9234 0
-MQ 11152 0 1 8544 0 8649 3A3 A6 9 4 76 8744 8414 157
-MQ 11153 0 17 8649 0 8744 6A6 9 4 46 0 0 0
-MQ 11154 3 8799 9983 2000 0 1048580 3157119 9433087 TESTDIV3
-MQ 11155 0 0 8874 8544 8809 6A6 9 4 46 0 0 0
-MQ 11156 0 0 8949 8544 8874 5A5 A6 9 4 56 8809 0 0
-MQ 11157 0 0 9034 8544 8949 4A4 A5 9 4 66 8874 0 0
-MQ 11158 0 0 9129 8544 9034 3A3 A4 9 4 76 8949 9534 0
-MQ 11159 1 0 9234 8544 9129 2A2 A3 9 4 86 9034 0 0
-MQ 11160 0 0 8543 8544 9234 1A1 A2 9 4 86 9129 0 0
-MQ 11161 0 0 9404 9034 9339 10B4 9 4 46 0 0 0
-MQ 11162 0 0 9469 9034 9404 9B3 B4 9 4 46 9339 0 0
-MQ 11163 0 0 9534 9034 9469 8B2 B3 9 4 46 9404 0 0
-MQ 11164 0 0 9033 9034 9534 7B1 B2 9 4 46 9469 0 0
-MQ 11165 1 0 9674 9469 9599 14C4 9 1 56 0 9898 0
-MQ 11166 1 0 9749 9469 9674 13C3 C4 9 1 56 9599 0 9234
-MQ 11167 1 0 9824 9469 9749 12C2 C3 9 1 56 9674 0 0
-MQ 11168 1 0 9467 9469 9824 11C1 C2 9 1 56 9749 0 0
-MQ 11169 1 0 9598 9599 9898 15D1 6 0 76 0 0 0
-MQ 11170 41001511199 4000 1 1048584 2110815 9435103 TDIV04
-MQ 11171 1 0103431034410024 15D1 6 0 76 0 0 0
-MQ 11172 1 0104821048410119 11C1 C2 9 1 5610194 0 0
-MQ 11173 1 0101191048410194 12C2 C3 9 1 5610269 0 0
-MQ 11174 1 0101941048410269 13C3 C4 9 1 5610344 010679
-MQ 11175 1 0102691048410344 14C4 9 1 56 010024 0
-MQ 11176 1 0108881088910419 7B1 B2 9 4 4610484 0 0
-MQ 11177 1 0104191088910484 8B2 B3 9 4 4610549 010119
-MQ 11178 1 0104841088910549 9B3 B4 9 4 4610614 0 0
-MQ 11179 1 0105491088910614 10B4 9 4 46 0 0 0
-MQ 11180 1 0 8 010679 1A1 A2 9 4 8610784 0 0
-MQ 11181 1 010679 010784 2A2 A3 9 4 8610889 0 0
-MQ 11182 1 010784 010889 3A3 A4 9 4 761098410419 0
-MQ 11183 1 010889 010984 4A4 A5 9 4 6611069 0 0
-MQ 11184 1 010984 011069 5A5 A6 9 4 5611144 0 0
-MQ 11185 1 011069 011144 6A6 9 4 46 0 0 0
-MQ 11186 51119912383 4000 0 1048592 2097503 9435103 TDIV05
-MQ 11187 0 011274 011209 6A6 9 4 46 0 0 0
-MQ 11188 0 011349 011274 5A5 A6 9 4 5611209 012298
-MQ 11189 0 011434 011349 4A4 A5 9 4 6611274 0 0
-MQ 11190 0 011529 011434 3A3 A4 9 4 7611349 0 0
-MQ 11191 0 011634 011529 2A2 A3 9 4 3611434 0 0
-MQ 11192 1 0 0 011575 0D 0 0 40 0
-MQ 11193 0 0 2 011634 1A1 A2 9 4 8611529 0 0
-MQ 11194 1 0118041143411739 10B4 9 4 46 0 0 0
-MQ 11195 1 0118691143411804 9B3 B4 9 4 4611739 0 0
-MQ 11196 1 0119341143411869 8B2 B3 9 4 4611804 012224
-MQ 11197 1 0114331143411934 7B1 B2 9 4 4611869 0 0
-MQ 11198 1 0120741186911999 14C4 9 1 56 0 0 0
-MQ 11199 1 0121491186912074 13C3 C4 9 1 5611999 011634
-MQ 11200 1 0122241186912149 12C2 C3 9 1 5612074 0 0
-MQ 11201 1 0118671186912224 11C1 C2 9 1 5612149 0 0
-MQ 11202 0 0112721127412298 15D1 6 0 76 0 0 0
-MQ 11203 17152911540220003 1 8388608 0 9437183 system
-MQ 11204 0 0 0 015292 1SYSL 0 0 101 0
-MQ 11205 181660216602 4000 1 2228224 3145728 9437183 TDIV18
-MQ 11206 191660216602 4000 0 2359296 3145728 9437183 TDIV19
-MQ 11207 201857420003 4000 1 4718592 0 9437183 TDIV20
-MQ 11208 0 019693 018604 4A4 A5 29 4 16619873 019288
-MQ 11209 0 0190721907318828 15D1 46 0 76 0 0 0
-MQ 11210 0 0192861928818923 11C1 C2 9 1 5618998 0 0
-MQ 11211 0 0189231928818998 12C2 C3 9 1 5619073 0 0
-MQ 11212 0 0189981928819073 13C3 C4 9 1 56191481882819483
-MQ 11213 0 0190731928819148 14C4 9 1 56 0 0 0
-MQ 11214 0 0194181860419223 7B1 9 4 46 0 0 0
-MQ 11215 0 0186021860419288 8B2 B3 9 4 4619353 018923
-MQ 11216 0 0192881860419353 9B3 B4 9 4 4619418 0 0
-MQ 11217 0 0193531860419418 10B4 B1 9 4 4619223 0 0
-MQ 11218 0 0 0 019483 1A1 A3 9 4 8619693 0 0
-MQ 11219 0 019873 019588 2A2 A6 9 4 8619948 0 0
-MQ 11220 0 019483 019693 3A3 A4 9 4 7618604 0 0
-MQ 11221 1 019693 019788 4A4 A5 9 4 6619873 019288
-MQ 11222 0 018604 019873 5A5 A2 9 4 5619588 0 0
-MQ 11223 0 019588 019948 6A6 9 4 46 0 0 0
-MQ 11224 8544A2 11634A1 0 0 0 0 19483A1
-MQ 11225 0 19483A1 19588A2 19693A3 18604A4 19873A5 19948A6
-MQ 1122619223B1 19288B2 19353B3 19418B4
-MQ 1122718923C1 18998C2 19073C3 19148C4 18828D1
-MQ 11228 157LOW1 0 232LOW3 0 0 0
-MQ 11229 8544A2 8544A2 8649A3 8744A6 8744A6 8744A6
-MQ 11230 8414B3 8414B3 8414B3 8479B4 0 0
-MQ 11231 8479B4 0 0 0 0 0
-MQ 11232 157LOW1 0 232LOW3 0 0 0
-MQ 1123319483A1 19588A2 19693A3 18604A4 19873A5 19948A6
-MQ 1123419223B1 19288B2 19353B3 19418B4 18923C1 18998C2
-MQ 12 0TEST GARBAGE COLLECTION WITH MOVE.
-MQ 12 1 // 0 20 0 -20510 137755
-MQ 12 2 10 8 29 35 164 6000 5 17
-MQ 12 3 1 137 30720003 0 1048577 3145728 9437183 QDIV1
-MQ 12 4 2 8130 852520003 1 1048578 3145728 9437183 QDIV2
-MQ 12 5 3 8525 9709 2000 0 1048580 3157119 9433087 TESTDIV3
-MQ 12 6 4 974110925 4000 1 1048584 2110815 9435103 TDIV04
-MQ 12 7 51092512109 4000 0 1048592 2097503 9435103 TDIV05
-MQ 12 8 17150171512820003 1 8388608 0 9437183 system
-MQ 12 9 181632816328 4000 1 2228224 3145728 9437183 TDIV18
-MQ 12 10 191632816328 4000 0 2359296 3145728 9437183 TDIV19
-MQ 12 11 201650620003 4000 1 4718592 0 9437183 TDIV20
-MQ 12 12 // 0 20 0 -20510 137755
-MQ 12 13 10 8 29 35 164 6000 5 17
-MQ 12 14 1 137 30720003 0 1048577 3145728 9437183 QDIV1
-MQ 12 15 0 257 8373 8375 157 16LOW1 LOW3 19 4 46 232 0 0
-MQ 12 16 0 257 157 8375 232 18LOW3 19 4 66 0 0 0
-MQ 12 17 2 8130 852520003 1 1048578 3145728 9437183 QDIV2
-MQ 12 18 0 257 8374 8375 8140 9B3 B4 9 4 46 8205 0 0
-MQ 12 19 0 257 8140 8375 8205 10B4 9 4 46 0 0 0
-MQ 12 20 0 17 1 0 8270 2A2 A3 9 4 86 8375 8960 0
-MQ 12 21 0 1 8270 0 8375 3A3 A6 9 4 76 8470 8140 157
-MQ 12 22 0 17 8375 0 8470 6A6 9 4 46 0 0 0
-MQ 12 23 3 8525 9709 2000 0 1048580 3157119 9433087 TESTDIV3
-MQ 12 24 0 0 8600 8270 8535 6A6 9 4 46 0 0 0
-MQ 12 25 0 0 8675 8270 8600 5A5 A6 9 4 56 8535 0 0
-MQ 12 26 0 0 8760 8270 8675 4A4 A5 9 4 66 8600 0 0
-MQ 12 27 0 0 8855 8270 8760 3A3 A4 9 4 76 8675 9260 0
-MQ 12 28 1 0 8960 8270 8855 2A2 A3 9 4 86 8760 0 0
-MQ 12 29 0 0 8269 8270 8960 1A1 A2 9 4 86 8855 0 0
-MQ 12 30 0 0 9130 8760 9065 10B4 9 4 46 0 0 0
-MQ 12 31 0 0 9195 8760 9130 9B3 B4 9 4 46 9065 0 0
-MQ 12 32 0 0 9260 8760 9195 8B2 B3 9 4 46 9130 0 0
-MQ 12 33 0 0 8759 8760 9260 7B1 B2 9 4 46 9195 0 0
-MQ 12 34 1 0 9400 9195 9325 14C4 9 1 56 0 9624 0
-MQ 12 35 1 0 9475 9195 9400 13C3 C4 9 1 56 9325 0 8960
-MQ 12 36 1 0 9550 9195 9475 12C2 C3 9 1 56 9400 0 0
-MQ 12 37 1 0 9193 9195 9550 11C1 C2 9 1 56 9475 0 0
-MQ 12 38 1 0 9324 9325 9624 15D1 6 0 76 0 0 0
-MQ 12 39 4 974110925 4000 1 1048584 2110815 9435103 TDIV04
-MQ 12 40 1 01006910070 9750 15D1 6 0 76 0 0 0
-MQ 12 41 1 01020810210 9845 11C1 C2 9 1 56 9920 0 0
-MQ 12 42 1 0 984510210 9920 12C2 C3 9 1 56 9995 0 0
-MQ 12 43 1 0 992010210 9995 13C3 C4 9 1 5610070 010405
-MQ 12 44 1 0 99951021010070 14C4 9 1 56 0 9750 0
-MQ 12 45 1 0106141061510145 7B1 B2 9 4 4610210 0 0
-MQ 12 46 1 0101451061510210 8B2 B3 9 4 4610275 0 9845
-MQ 12 47 1 0102101061510275 9B3 B4 9 4 4610340 0 0
-MQ 12 48 1 0102751061510340 10B4 9 4 46 0 0 0
-MQ 12 49 1 0 8 010405 1A1 A2 9 4 8610510 0 0
-MQ 12 50 1 010405 010510 2A2 A3 9 4 8610615 0 0
-MQ 12 51 1 010510 010615 3A3 A4 9 4 761071010145 0
-MQ 12 52 1 010615 010710 4A4 A5 9 4 6610795 0 0
-MQ 12 53 1 010710 010795 5A5 A6 9 4 5610870 0 0
-MQ 12 54 1 010795 010870 6A6 9 4 46 0 0 0
-MQ 12 55 51092512109 4000 0 1048592 2097503 9435103 TDIV05
-MQ 12 56 0 011000 010935 6A6 9 4 46 0 0 0
-MQ 12 57 0 011075 011000 5A5 A6 9 4 5610935 012024
-MQ 12 58 0 011160 011075 4A4 A5 9 4 6611000 0 0
-MQ 12 59 0 011255 011160 3A3 A4 9 4 7611075 0 0
-MQ 12 60 0 011360 011255 2A2 A3 9 4 3611160 0 0
-MQ 12 61 1 0 0 011301 0D 0 0 40 0
-MQ 12 62 0 0 2 011360 1A1 A2 9 4 8611255 0 0
-MQ 12 63 1 0115301116011465 10B4 9 4 46 0 0 0
-MQ 12 64 1 0115951116011530 9B3 B4 9 4 4611465 0 0
-MQ 12 65 1 0116601116011595 8B2 B3 9 4 4611530 011950
-MQ 12 66 1 0111591116011660 7B1 B2 9 4 4611595 0 0
-MQ 12 67 1 0118001159511725 14C4 9 1 56 0 0 0
-MQ 12 68 1 0118751159511800 13C3 C4 9 1 5611725 011360
-MQ 12 69 1 0119501159511875 12C2 C3 9 1 5611800 0 0
-MQ 12 70 1 0115931159511950 11C1 C2 9 1 5611875 0 0
-MQ 12 71 0 0109981100012024 15D1 6 0 76 0 0 0
-MQ 12 72 17150171512820003 1 8388608 0 9437183 system
-MQ 12 73 0 0 0 015018 1SYSL 0 0 101 0
-MQ 12 74 181632816328 4000 1 2228224 3145728 9437183 TDIV18
-MQ 12 75 191632816328 4000 0 2359296 3145728 9437183 TDIV19
-MQ 12 76 201650620003 4000 1 4718592 0 9437183 TDIV20
-MQ 12 77 1 0 0 016507 1FILL 0 0 2143 0
-MQ 12 78 0 019778 018689 4A4 A5 29 4 16619873 019373
-MQ 12 79 0 0191571915818913 15D1 46 0 76 0 0 0
-MQ 12 80 0 0193711937319008 11C1 C2 9 1 5619083 0 0
-MQ 12 81 0 0190081937319083 12C2 C3 9 1 5619158 0 0
-MQ 12 82 0 0190831937319158 13C3 C4 9 1 56192331891319568
-MQ 12 83 0 0191581937319233 14C4 9 1 56 0 0 0
-MQ 12 84 0 0195031868919308 7B1 9 4 46 0 0 0
-MQ 12 85 0 0186871868919373 8B2 B3 9 4 4619438 019008
-MQ 12 86 0 0193731868919438 9B3 B4 9 4 4619503 0 0
-MQ 12 87 0 0194381868919503 10B4 B1 9 4 4619308 0 0
-MQ 12 88 0 0 0 019568 1A1 A3 9 4 8619778 0 0
-MQ 12 89 0 019873 019673 2A2 A6 9 4 8619948 0 0
-MQ 12 90 0 019568 019778 3A3 A4 9 4 7618689 0 0
-MQ 12 91 0 018689 019873 5A5 A2 9 4 5619673 0 0
-MQ 12 92 0 019673 019948 6A6 9 4 46 0 0 0
-MQ 12 93 8270A2 11360A1 0 0 0 0 19568A1
-MQ 12 94 0 19568A1 19673A2 19778A3 18689A4 19873A5 19948A6
-MQ 12 9519308B1 19373B2 19438B3 19503B4
-MQ 12 9619008C1 19083C2 19158C3 19233C4 18913D1
-MQ 12 97 157LOW1 0 232LOW3 0 0 0
-MQ 12 98 8270A2 8270A2 8375A3 8470A6 8470A6 8470A6
-MQ 12 99 8140B3 8140B3 8140B3 8205B4 0 0
-MQ 12100 8205B4 0 0 0 0 0
-MQ 12101 157LOW1 0 232LOW3 0 0 0
-MQ 1210219568A1 19673A2 19778A3 18689A4 19873A5 19948A6
-MQ 1210319308B1 19373B2 19438B3 19503B4 19008C1 19083C2
-MR 1 0TEST MZREPL WITH KEEP.
-MR 1 1 // 0 2 0 -20483 137776
-MR 1 2 10 8 29 35 164 6000 2 20
-MR 1 3 1 137 78920003 0 1048577 3145728 9437183 QDIV1
-MR 1 4 0 01561215614 157 16LOW1 LOW2 19 4 46 232 0 0
-MR 1 5 0 0 15715614 232 17LOW2 LOW3 19 4 56 317 0 0
-MR 1 6 0 0 23215614 317 18LOW3 LOW4 19 4 66 412 0 0
-MR 1 7 0 0 31715614 412 19LOW4 LOW5 19 4 76 517 0 0
-MR 1 8 0 0 41215614 517 20LOW5 LOW6 19 4 86 632 0 0
-MR 1 9 0 0 51715614 632 21LOW6 19 4 96 0 0 0
-MR 1 10 0 0 3 0 740 1IX IX 2 1 1 7531657315709
-MR 1 11 0 0 740 0 753 2IX IX 2 1 1 7661667815614
-MR 1 12 0 0 753 0 766 3IX IX 2 1 1 7791677315529
-MR 1 13 0 0 766 0 779 4IX 2 1 1 01685815454
-MR 1 14 2154441700020003 1 1048578 3145728 9437183 QDIV2
-MR 1 15 0 0155291699115454 2NA5 A6 9 4 5616933 0 0
-MR 1 16 0 0156141699115529 2NA4 NA5 9 4 6615454 0 0
-MR 1 17 0 0157091699115614 2NA3 NA4 9 4 761552916208 157
-MR 1 18 0 0164681699115709 2NA2 NA3 9 4 8615614 0 0
-MR 1 19 0 0161321613315813 15D1 6 0 76 0 0 0
-MR 1 20 0 0162711627315908 11C1 C2 9 1 5615983 016468
-MR 1 21 0 0159081627315983 12C2 C3 9 1 5616058 015709
-MR 1 22 0 0159831627316058 13C3 C4 9 1 5616133 015614
-MR 1 23 0 0160581627316133 14C4 9 1 56 01581315529
-MR 1 24 0 0156131561416208 7B1 B2 9 4 4616273 0 0
-MR 1 25 0 0162081561416273 8B2 B3 9 4 4616338 015908
-MR 1 26 0 0162731561416338 9B3 B4 9 4 4616403 0 0
-MR 1 27 0 0163381561416403 10B4 9 4 46 0 0 0
-MR 1 28 0 0169901699116468 1A1 NA2 9 4 8615709 0 0
-MR 1 29 0 0 739 74016573 2A2 9 0 86 0 0 0
-MR 1 30 0 0 752 75316678 3A3 9 0 76 016208 157
-MR 1 31 0 0 765 76616773 4A4 9 0 66 0 0 0
-MR 1 32 0 0 778 77916858 5A5 9 0 56 0 0 0
-MR 1 33 0 0154541699116933 6A6 9 4 46 0 0 0
-MR 1 34 0 0 1 016991 1SUP 2 1 0 01646815614
-MR 1 35 20198922000320003 1 8388608 0 9437183 system
-MR 1 36 0 0 0 019893 1SYSL 0 0 101 0
-MR 1 3716991SUP 0 740IX 0 0 0 0
-MR 1 38 0 16468A1 15709NA2 15614NA3 15529NA4 15454NA5 16933A6
-MR 1 3916208B1 16273B2 16338B3 16403B4
-MR 1 4015908C1 15983C2 16058C3 16133C4 15813D1
-MR 1 41 157LOW1 232LOW2 317LOW3 412LOW4 517LOW5 632LOW6
-MR 1 4216468A1 15709NA2 15614NA3 15529NA4 15454NA5 16933A6
-MR 1 4316208B1 16273B2 16338B3 16403B4 15908C1 15983C2
-MR 1 4416403B4 15908C1 15983C2 16058C3 16133C4 15813D1
-MR 1 45 157LOW1 232LOW2 317LOW3 412LOW4 517LOW5 632LOW6
-MR 1 4616468A1 15709NA2 15614NA3 15529NA4 15454NA5 16933A6
-MR 1 4716208B1 16273B2 16338B3 16403B4 15908C1 15983C2
-MR 2 0TEST MZREPL WITH DROP.
-MR 2 1 // 0 3 0 -20483 137776
-MR 2 2 10 8 29 35 164 6000 3 19
-MR 2 3 1 137 13720003 0 1048577 3145728 9437183 QDIV1
-MR 2 4 2137881380020003 1 1048578 3145728 9437183 QDIV2
-MR 2 5 0 0 1 013791 1SUP 2 1 0 01387514739
-MR 2 6 31380014984 2000 0 1048580 3145728 9437183 TESTDIV3
-MR 2 7 0 0149191379113810 6A6 9 4 46 0 0 0
-MR 2 8 0 0137901379113875 1A1 NA2 9 4 8614634 0 0
-MR 2 9 0 0140451473913980 10B4 9 4 46 0 0 0
-MR 2 10 0 0141101473914045 9B3 B4 9 4 4613980 0 0
-MR 2 11 0 0141751473914110 8B2 B3 9 4 4614045 014465
-MR 2 12 0 0147381473914175 7B1 B2 9 4 4614110 0 0
-MR 2 13 0 0143151411014240 14C4 9 1 56 01453914834
-MR 2 14 0 0143901411014315 13C3 C4 9 1 5614240 014739
-MR 2 15 0 0144651411014390 12C2 C3 9 1 5614315 014634
-MR 2 16 0 0141081411014465 11C1 C2 9 1 5614390 013875
-MR 2 17 0 0142391424014539 15D1 6 0 76 0 0 0
-MR 2 18 0 0138751379114634 2NA2 NA3 9 4 8614739 0 0
-MR 2 19 0 0146341379114739 2NA3 NA4 9 4 761483414175 0
-MR 2 20 0 0147391379114834 2NA4 NA5 9 4 6614919 0 0
-MR 2 21 0 0148341379114919 2NA5 A6 9 4 5613810 0 0
-MR 2 22 19178921800320003 1 8388608 0 9437183 system
-MR 2 23 0 0 0 017893 1SYSL 0 0 101 0
-MR 2 24 202000320003 4000 1 4718592 0 9437183 TDIV20
-MR 2 2513791SUP 0 0 0 0 0 0
-MR 2 26 0 13875A1 14634NA2 14739NA3 14834NA4 14919NA5 13810A6
-MR 2 2714175B1 14110B2 14045B3 13980B4
-MR 2 2814465C1 14390C2 14315C3 14240C4 14539D1
-MR 2 29 0 0 0 0 0 0
-MR 2 3013875A1 14634NA2 14739NA3 14834NA4 14919NA5 13810A6
-MR 2 3114175B1 14110B2 14045B3 13980B4 14465C1 14390C2
-MR 2 3213980B4 14465C1 14390C2 14315C3 14240C4 14539D1
-MR 2 33 0 0 0 0 0 0
-MR 2 3413875A1 14634NA2 14739NA3 14834NA4 14919NA5 13810A6
-MR 2 3514175B1 14110B2 14045B3 13980B4 14465C1 14390C2
-MR 3 0TEST MZREPL WITH I.
-MR 3 1 // 0 3 0 -20483 137776
-MR 3 2 10 8 29 35 164 6000 3 19
-MR 3 3 1 137 13720003 0 1048577 3145728 9437183 QDIV1
-MR 3 4 2137881380020003 1 1048578 3145728 9437183 QDIV2
-MR 3 5 0 0 1 013791 1SUP 2 1 0 013875 0
-MR 3 6 31380014984 2000 0 1048580 3145728 9437183 TESTDIV3
-MR 3 7 0 0149191379113810 6A6 9 4 46 0 0 0
-MR 3 8 0 0137901379113875 1A1 NA2 9 4 8614634 0 0
-MR 3 9 0 0140451473913980 10B4 9 4 46 0 0 0
-MR 3 10 0 0141101473914045 9B3 B4 9 4 4613980 0 0
-MR 3 11 0 0141751473914110 8B2 B3 9 4 4614045 014465
-MR 3 12 0 0147381473914175 7B1 B2 9 4 4614110 0 0
-MR 3 13 0 0143151411014240 14C4 9 1 56 014539 0
-MR 3 14 0 0143901411014315 13C3 C4 9 1 5614240 0 0
-MR 3 15 0 0144651411014390 12C2 C3 9 1 5614315 0 0
-MR 3 16 0 0141081411014465 11C1 C2 9 1 5614390 013875
-MR 3 17 0 0142391424014539 15D1 6 0 76 0 0 0
-MR 3 18 0 0138751379114634 2NA2 NA3 9 4 8614739 0 0
-MR 3 19 0 0146341379114739 2NA3 NA4 9 4 761483414175 0
-MR 3 20 0 0147391379114834 2NA4 NA5 9 4 6614919 0 0
-MR 3 21 0 0148341379114919 2NA5 A6 9 4 5613810 0 0
-MR 3 22 19178921800320003 1 8388608 0 9437183 system
-MR 3 23 0 0 0 017893 1SYSL 0 0 101 0
-MR 3 24 202000320003 4000 1 4718592 0 9437183 TDIV20
-MR 3 2513791SUP 0 0 0 0 0 0
-MR 3 26 0 13875A1 0 0 0 0 13810A6
-MR 3 2714175B1 14110B2 14045B3 13980B4
-MR 3 2814465C1 14390C2 14315C3 14240C4 14539D1
-MR 3 29 0 0 0 0 0 0
-MR 3 3013875A1 0 0 0 0 13810A6
-MR 3 3114175B1 14110B2 14045B3 13980B4 14465C1 14390C2
-MR 3 3213980B4 14465C1 14390C2 14315C3 14240C4 14539D1
-MR 3 33 0 0 0 0 0 0
-MR 3 3413875A1 0 0 0 0 13810A6
-MR 3 3514175B1 14110B2 14045B3 13980B4 14465C1 14390C2
-MQ* 1 0INITIALIZE TEST STORE.
-MQ* 1 1 // 1 20 -1086 -20510 137755
-MQ* 1 2 10 8 29 35 40 6000 2 20
-MQ* 1 3 1 137 13719660 0 1048577 3145728 9437183 QDIV1
-MQ* 1 4 2170001700019660 1 1048578 3145728 9437183 QDIV2
-MQ* 1 5 20195491966019660 1 8388608 0 9437183 system
-MQ* 2 0LIFT FIRST STRUCTURE.
-MQ* 2 1 // 1 1 -1086 -20510 137755
-MQ* 2 2 10 8 29 35 40 6000 2 20
-MQ* 2 3 1 137 73719660 0 1048577 3145728 9437183 QDIV1
-MQ* 2 4 0 01668816690 157 16LOW1 LOW2 19 4 46 232 0 0
-MQ* 2 5 0 0 15716690 232 17LOW2 LOW3 19 4 56 317 0 0
-MQ* 2 6 0 0 23216690 317 18LOW3 LOW4 19 4 66 412 0 0
-MQ* 2 7 0 0 31716690 412 19LOW4 LOW5 19 4 76 517 0 0
-MQ* 2 8 0 0 41216690 517 20LOW5 LOW6 19 4 86 632 0 0
-MQ* 2 9 0 0 51716690 632 21LOW6 19 4 96 0 0 0
-MQ* 2 10 2158161700019660 1 1048578 3145728 9437183 QDIV2
-MQ* 2 11 0 0161441614515825 15D1 6 0 76 0 0 0
-MQ* 2 12 0 0162831628515920 11C1 C2 9 1 5615995 0 0
-MQ* 2 13 0 0159201628515995 12C2 C3 9 1 5616070 0 0
-MQ* 2 14 0 0159951628516070 13C3 C4 9 1 5616145 016480
-MQ* 2 15 0 0160701628516145 14C4 9 1 56 015825 0
-MQ* 2 16 0 0166891669016220 7B1 B2 9 4 4616285 0 0
-MQ* 2 17 0 0162201669016285 8B2 B3 9 4 4616350 015920
-MQ* 2 18 0 0162851669016350 9B3 B4 9 4 4616415 0 0
-MQ* 2 19 0 0163501669016415 10B4 9 4 46 0 0 0
-MQ* 2 20 0 0 8 016480 1A1 A2 9 4 8616585 0 0
-MQ* 2 21 0 016480 016585 2A2 A3 9 4 8616690 0 0
-MQ* 2 22 0 016585 016690 3A3 A4 9 4 761678516220 157
-MQ* 2 23 0 016690 016785 4A4 A5 9 4 6616870 0 0
-MQ* 2 24 0 016785 016870 5A5 A6 9 4 5616945 0 0
-MQ* 2 25 0 016870 016945 6A6 9 4 46 0 0 0
-MQ* 2 26 20195491966019660 1 8388608 0 9437183 system
-MQ* 2 27 0 0 0 019550 1SYSL 0 0 101 0
-MQ* 2 28 0 0 0 0 0 0 0
-MQ* 2 2916480A1 16480A1 16585A2 16690A3 16785A4 16870A5 16945A6
-MQ* 2 3016220B1 16285B2 16350B3 16415B4
-MQ* 2 3115920C1 15995C2 16070C3 16145C4 15825D1
-MQ* 2 32 157LOW1 232LOW2 317LOW3 412LOW4 517LOW5 632LOW6
-MQ* 2 3316480A1 16585A2 16690A3 16785A4 16870A5 16945A6
-MQ* 2 3416220B1 16285B2 16350B3 16415B4 15920C1 15995C2
-MQ* 2 3516415B4 15920C1 15995C2 16070C3 16145C4 15825D1
-MQ* 2 36 157LOW1 232LOW2 317LOW3 412LOW4 517LOW5 632LOW6
-MQ* 2 3716480A1 16585A2 16690A3 16785A4 16870A5 16945A6
-MQ* 2 3816220B1 16285B2 16350B3 16415B4 15920C1 15995C2
-MQ* 3 0TEST MZFLAG.
-MQ* 3 1 1 17 1 17 17 17
-MQ* 3 2 257 257 257 257 257 257 257 257 259
-MQ* 3 3 257 257 257 259 259 259
-MQ* 4 0TEST MZDROP.
-MQ* 4 1 // 1 0 -1086 -20510 137755
-MQ* 4 2 10 8 29 35 40 6000 2 20
-MQ* 4 3 1 137 73719660 0 1048577 3145728 9437183 QDIV1
-MQ* 4 4 0 2571668816690 157 16LOW1 LOW2 19 4 46 232 0 0
-MQ* 4 5 0 257 15716690 232 17LOW2 LOW3 19 4 56 317 0 0
-MQ* 4 6 0 257 23216690 317 18LOW3 19 4 66 0 0 0
-MQ* 4 7 1 259 31716690 412 19LOW4 LOW5 19 4 76 517 0 0
-MQ* 4 8 1 259 41216690 517 20LOW5 LOW6 19 4 86 632 0 0
-MQ* 4 9 1 259 51716690 632 21LOW6 19 4 96 0 0 0
-MQ* 4 10 2158161700019660 1 1048578 3145728 9437183 QDIV2
-MQ* 4 11 1 259161441614515825 15D1 6 0 76 0 0 0
-MQ* 4 12 1 257162831628515920 11C1 C2 9 1 5615995 0 0
-MQ* 4 13 1 257159201628515995 12C2 C3 9 1 5616070 0 0
-MQ* 4 14 1 257159951628516070 13C3 C4 9 1 5616145 016480
-MQ* 4 15 1 257160701628516145 14C4 9 1 56 015825 0
-MQ* 4 16 0 257166891669016220 7B1 B3 9 4 4616350 0 0
-MQ* 4 17 1 257162201669016285 8B2 B3 9 4 4616350 015920
-MQ* 4 18 0 257162201669016350 9B3 B4 9 4 4616415 0 0
-MQ* 4 19 0 257163501669016415 10B4 9 4 46 0 0 0
-MQ* 4 20 0 1 8 016480 1A1 A2 9 4 8616585 0 0
-MQ* 4 21 0 1716480 016585 2A2 A3 9 4 8616690 0 0
-MQ* 4 22 0 116585 016690 3A3 A4 9 4 761678516220 157
-MQ* 4 23 0 1716690 016785 4A4 A6 9 4 6616945 0 0
-MQ* 4 24 1 1716785 016870 5A5 A6 9 4 5616945 0 0
-MQ* 4 25 0 1716785 016945 6A6 9 4 46 0 0 0
-MQ* 4 26 20195491966019660 1 8388608 0 9437183 system
-MQ* 4 27 0 0 0 019550 1SYSL 0 0 101 0
-MQ* 4 28 0 0 0 0 0 0 0
-MQ* 4 2916480A1 16480A1 16585A2 16690A3 16785A4 16870A5 16945A6
-MQ* 4 3016220B1 16285B2 16350B3 16415B4
-MQ* 4 3115920C1 15995C2 16070C3 16145C4 15825D1
-MQ* 4 32 157LOW1 232LOW2 317LOW3 412LOW4 517LOW5 632LOW6
-MQ* 4 3316480A1 16585A2 16690A3 16785A4 16870A5 16945A6
-MQ* 4 3416220B1 16285B2 16350B3 16415B4 15920C1 15995C2
-MQ* 4 3516415B4 15920C1 15995C2 16070C3 16145C4 15825D1
-MQ* 4 36 157LOW1 232LOW2 317LOW3 412LOW4 517LOW5 632LOW6
-MQ* 4 3716480A1 16585A2 16690A3 16785A4 16870A5 16945A6
-MQ* 4 3816220B1 16285B2 16350B3 16415B4 15920C1 15995C2
-MQ* 5 0TEST TABLE BUILDING, PART 1.
-MQ* 5 1 3 0 3 -1 0 0 0
-MQ* 5 2 0 0 2189 2560 4588 4612
-MQ* 5 3 0 1 3 0 137 737 0 0 0
-MQ* 5 4 8 2 3 01581617000 0 0 0
-MQ* 5 5 16 20 0 01954919660 0 0 0
-MQ* 5 6 2189 2191 2219 4578 0 3619660
-MQ* 5 7 2 137 392 0 1 6 737 737 0 0
-MQ* 5 8 101581615816 0 1 141621016275 0 1
-MQ* 5 9 181634016860 0 1 221693517000 0 0
-MQ* 5 10 261954919660 0 0
-MQ* 5 11 2199 45701581617000 534 8
-MQ* 5 12 3 0 3 -1 0 0 0
-MQ* 5 13 0 0 2189 2560 4588 4612
-MQ* 5 14 0 1 3 0 137 737 2 10 345
-MQ* 5 15 8 2 3 01581617000 10 26 534
-MQ* 5 16 16 20 0 01954919660 26 0 0
-MQ* 5 17 2189 2191 2215 4578 0 3619549
-MQ* 5 18 2 137 392 0 1 6 737 737 -345 0
-MQ* 5 19 101581615816 534 1 141621016275 140 1
-MQ* 5 20 181634016860 75 1 221693517000 0 0
-MQ* 5 21 // 1 0 -1086 -20510 137755
-MQ* 5 22 10 8 29 35 40 6000 2 20
-MQ* 5 23 1 137 39219660 0 1048577 3145728 9437183 QDIV1
-MQ* 5 24 0 2571676316765 157 16LOW1 LOW2 19 4 46 232 0 0
-MQ* 5 25 0 257 15716765 232 17LOW2 LOW3 19 4 56 317 0 0
-MQ* 5 26 0 257 23216765 317 18LOW3 19 4 66 0 0 0
-MQ* 5 27 2163501700019660 1 1048578 3145728 9437183 QDIV2
-MQ* 5 28 0 257167641676516360 7B1 B3 9 4 4616425 0 0
-MQ* 5 29 0 257163601676516425 9B3 B4 9 4 4616490 0 0
-MQ* 5 30 0 257164251676516490 10B4 9 4 46 0 0 0
-MQ* 5 31 0 1 8 016555 1A1 A2 9 4 8616660 0 0
-MQ* 5 32 0 1716555 016660 2A2 A3 9 4 8616765 0 0
-MQ* 5 33 0 116660 016765 3A3 A4 9 4 761686016360 157
-MQ* 5 34 0 1716765 016860 4A4 A6 9 4 6616945 0 0
-MQ* 5 35 0 1716860 016945 6A6 9 4 46 0 0 0
-MQ* 5 36 20195491966019660 1 8388608 0 9437183 system
-MQ* 5 37 0 0 0 019550 1SYSL 0 0 101 0
-MQ* 5 38 0 0 0 0 0 0 0
-MQ* 5 3916555A1 16555A1 16660A2 16765A3 16860A4 0 16945A6
-MQ* 5 4016360B1 0 16425B3 16490B4
-MQ* 5 41 0 0 0 0 0
-MQ* 5 42 157LOW1 232LOW2 317LOW3 0 0 0
-MQ* 5 4316555A1 16660A2 16765A3 16860A4 16945A6 16945A6
-MQ* 5 4416360B1 16425B3 16425B3 16490B4 0 0
-MQ* 5 4516490B4 0 0 0 0 0
-MQ* 5 46 157LOW1 232LOW2 317LOW3 0 0 0
-MQ* 5 4716555A1 16660A2 16765A3 16860A4 16945A6 16945A6
-MQ* 5 4816360B1 0 16425B3 16490B4 0 0
-MQ* 6 0TEST TABLE BUILDING, PART 2.
-MQ* 6 1 // 1 20 -1086 -20510 137755
-MQ* 6 2 10 8 29 35 40 6000 2 20
-MQ* 6 3 1 137 39219660 0 1048577 3145728 9437183 QDIV1
-MQ* 6 4 0 2571676316765 157 16LOW1 LOW2 19 4 46 232 0 0
-MQ* 6 5 1 257 15716765 232 17LOW2 LOW3 19 4 56 317 0 0
-MQ* 6 6 0 257 23216765 317 18LOW3 19 4 66 0 0 0
-MQ* 6 7 2163501700019660 1 1048578 3145728 9437183 QDIV2
-MQ* 6 8 0 257167641676516360 7B1 B3 9 4 4616425 0 0
-MQ* 6 9 0 257163601676516425 9B3 B4 9 4 4616490 0 0
-MQ* 6 10 0 257164251676516490 10B4 9 4 46 0 0 0
-MQ* 6 11 1 1 8 016555 1A1 A2 9 4 8616660 0 0
-MQ* 6 12 0 1716555 016660 2A2 A3 9 4 8616765 0 0
-MQ* 6 13 0 116660 016765 3A3 A4 9 4 761686016360 157
-MQ* 6 14 0 1716765 016860 4A4 A6 9 4 6616945 0 0
-MQ* 6 15 0 1716860 016945 6A6 9 4 46 0 0 0
-MQ* 6 16 20170021966019660 1 8388608 0 9437183 system
-MQ* 6 17 1 0 0 017003 1FILL 0 0 2537 0
-MQ* 6 18 0 0 0 019550 1SYSL 0 0 101 0
-MQ* 6 19 0 0 0 0 0 0 0
-MQ* 6 2016555A1 16555A1 16660A2 16765A3 16860A4 0 16945A6
-MQ* 6 2116360B1 0 16425B3 16490B4
-MQ* 6 22 0 0 0 0 0
-MQ* 6 23 157LOW1 232LOW2 317LOW3 0 0 0
-MQ* 6 2416555A1 16660A2 16765A3 16860A4 16945A6 16945A6
-MQ* 6 2516360B1 16425B3 16425B3 16490B4 0 0
-MQ* 6 2616490B4 0 0 0 0 0
-MQ* 6 27 157LOW1 232LOW2 317LOW3 0 0 0
-MQ* 6 2816555A1 16660A2 16765A3 16860A4 16945A6 16945A6
-MQ* 6 2916360B1 0 16425B3 16490B4 0 0
-MQ* 6 30 524291 0 524291 1 2 2 0
-MQ* 6 31 0 0 2189 2560 4588 4612
-MQ* 6 32 0 1 3 0 137 392 2 10 85
-MQ* 6 33 8 2 3 01635017000 10 18 105
-MQ* 6 34 16 20 3 01700219660 18 26 2547
-MQ* 6 35 2189 2191 2215 4578 0 3619660
-MQ* 6 36 2 137 212 0 1 6 297 392 -85 0
-MQ* 6 37 101635016545 105 1 141665017000 0 0
-MQ* 6 38 181700217002 2547 1 221954919660 0 0
-MQ* 6 39 2207 45741700219660 2547 1
-MQ* 6 40 // 1 20 -1086 -20510 137755
-MQ* 6 41 10 8 29 35 40 6000 2 20
-MQ* 6 42 1 137 30719660 0 1048577 3145728 9437183 QDIV1
-MQ* 6 43 0 2571676316765 157 16LOW1 LOW3 19 4 46 232 0 0
-MQ* 6 44 0 257 15716765 232 18LOW3 19 4 66 0 0 0
-MQ* 6 45 2164551700019660 1 1048578 3145728 9437183 QDIV2
-MQ* 6 46 0 257167641676516465 7B1 B3 9 4 4616530 0 0
-MQ* 6 47 0 257164651676516530 9B3 B4 9 4 4616595 0 0
-MQ* 6 48 0 257165301676516595 10B4 9 4 46 0 0 0
-MQ* 6 49 0 17 8 016660 2A2 A3 9 4 8616765 0 0
-MQ* 6 50 0 116660 016765 3A3 A4 9 4 761686016465 157
-MQ* 6 51 0 1716765 016860 4A4 A6 9 4 6616945 0 0
-MQ* 6 52 0 1716860 016945 6A6 9 4 46 0 0 0
-MQ* 6 53 20195491966019660 1 8388608 0 9437183 system
-MQ* 6 54 0 0 0 019550 1SYSL 0 0 101 0
-MQ* 6 55 0 0 0 0 0 0 0
-MQ* 6 5616660A2 0 16660A2 16765A3 16860A4 0 16945A6
-MQ* 6 5716465B1 0 16530B3 16595B4
-MQ* 6 58 0 0 0 0 0
-MQ* 6 59 157LOW1 0 232LOW3 0 0 0
-MQ* 6 6016660A2 16660A2 16765A3 16860A4 16945A6 16945A6
-MQ* 6 6116465B1 16530B3 16530B3 16595B4 0 0
-MQ* 6 6216595B4 0 0 0 0 0
-MQ* 6 63 157LOW1 0 232LOW3 0 0 0
-MQ* 6 6416660A2 16660A2 16765A3 16860A4 16945A6 16945A6
-MQ* 6 6516465B1 0 16530B3 16595B4 0 0
-MQ* 7 0CREATE DIVISIONS 3,20,19,4,5,18.
-MQ* 7 1 // 1 18 -1086 -20510 137755
-MQ* 7 2 10 8 29 35 40 6000 5 17
-MQ* 7 3 1 137 30719660 0 1048577 3145728 9437183 QDIV1
-MQ* 7 4 2 8455 900019660 1 1048578 3145728 9437183 QDIV2
-MQ* 7 5 3 9000 9000 2000 0 1048580 3145728 9437183 TESTDIV3
-MQ* 7 6 41140011400 4000 1 1048584 3145728 9437183 TDIV04
-MQ* 7 7 51140011400 4000 0 1048592 3145728 9437183 TDIV05
-MQ* 7 8 17151491526019660 1 8388608 0 9437183 system
-MQ* 7 9 181646016460 4000 1 2228224 3145728 9437183 TDIV18
-MQ* 7 10 191646016460 4000 0 2359296 3145728 9437183 TDIV19
-MQ* 7 11 201966019660 4000 1 4718592 0 9437183 TDIV20
-MQ* 8 0TEST ZSHUNT.
-MQ* 8 1 // 1 20 -1086 -20510 137755
-MQ* 8 2 10 8 29 35 40 6000 5 17
-MQ* 8 3 1 137 30719660 0 1048577 3145728 9437183 QDIV1
-MQ* 8 4 0 257 8763 8765 157 16LOW1 LOW3 19 4 46 232 0 0
-MQ* 8 5 0 257 157 8765 232 18LOW3 19 4 66 0 0 0
-MQ* 8 6 2 8455 900019660 1 1048578 3145728 9437183 QDIV2
-MQ* 8 7 1 257 8764 8765 8465 7B1 B3 9 4 46 8530 0 0
-MQ* 8 8 0 257 8465 8765 8530 9B3 B4 9 4 46 8595 0 0
-MQ* 8 9 0 257 8530 8765 8595 10B4 9 4 46 0 0 0
-MQ* 8 10 0 17 1 0 8660 2A2 A3 9 4 86 8765 9435 0
-MQ* 8 11 0 1 8660 0 8765 3A3 A4 9 4 76 8860 8465 157
-MQ* 8 12 1 17 8765 0 8860 4A4 A6 9 4 66 8945 0 0
-MQ* 8 13 0 17 8860 0 8945 6A6 9 4 46 0 0 0
-MQ* 8 14 3 900010184 2000 0 1048580 3145728 9437183 TESTDIV3
-MQ* 8 15 0 0 9075 8660 9010 6A6 9 4 46 0 0 0
-MQ* 8 16 0 0 9150 8660 9075 5A5 A6 9 4 56 9010 0 0
-MQ* 8 17 0 0 9235 8660 9150 4A4 A5 9 4 66 9075 0 0
-MQ* 8 18 0 0 9330 8660 9235 3A3 A4 9 4 76 9150 9735 0
-MQ* 8 19 1 0 9435 8660 9330 2A2 A3 9 4 86 9235 0 0
-MQ* 8 20 0 0 8659 8660 9435 1A1 A2 9 4 86 9330 0 0
-MQ* 8 21 0 0 9605 9235 9540 10B4 9 4 46 0 0 0
-MQ* 8 22 0 0 9670 9235 9605 9B3 B4 9 4 46 9540 0 0
-MQ* 8 23 0 0 9735 9235 9670 8B2 B3 9 4 46 9605 0 0
-MQ* 8 24 0 0 9234 9235 9735 7B1 B2 9 4 46 9670 0 0
-MQ* 8 25 1 0 9875 9670 9800 14C4 9 1 56 010099 0
-MQ* 8 26 1 0 9950 9670 9875 13C3 C4 9 1 56 9800 0 9435
-MQ* 8 27 1 010025 9670 9950 12C2 C3 9 1 56 9875 0 0
-MQ* 8 28 1 0 9668 967010025 11C1 C2 9 1 56 9950 0 0
-MQ* 8 29 1 0 9799 980010099 15D1 6 0 76 0 0 0
-MQ* 8 30 41021611400 4000 1 1048584 3145728 9437183 TDIV04
-MQ* 8 31 1 0105441054510225 15D1 6 0 76 0 0 0
-MQ* 8 32 1 0106831068510320 11C1 C2 9 1 5610395 0 0
-MQ* 8 33 1 0103201068510395 12C2 C3 9 1 5610470 0 0
-MQ* 8 34 1 0103951068510470 13C3 C4 9 1 5610545 010880
-MQ* 8 35 1 0104701068510545 14C4 9 1 56 010225 0
-MQ* 8 36 1 0110891109010620 7B1 B2 9 4 4610685 0 0
-MQ* 8 37 1 0106201109010685 8B2 B3 9 4 4610750 010320
-MQ* 8 38 1 0106851109010750 9B3 B4 9 4 4610815 0 0
-MQ* 8 39 1 0107501109010815 10B4 9 4 46 0 0 0
-MQ* 8 40 1 0 8 010880 1A1 A2 9 4 8610985 0 0
-MQ* 8 41 1 010880 010985 2A2 A3 9 4 8611090 0 0
-MQ* 8 42 1 010985 011090 3A3 A4 9 4 761118510620 0
-MQ* 8 43 1 011090 011185 4A4 A5 9 4 6611270 0 0
-MQ* 8 44 1 011185 011270 5A5 A6 9 4 5611345 0 0
-MQ* 8 45 1 011270 011345 6A6 9 4 46 0 0 0
-MQ* 8 46 51140012584 4000 0 1048592 3145728 9437183 TDIV05
-MQ* 8 47 0 011475 011410 6A6 9 4 46 0 0 0
-MQ* 8 48 0 011550 011475 5A5 A6 9 4 5611410 012499
-MQ* 8 49 0 011635 011550 4A4 A5 9 4 6611475 0 0
-MQ* 8 50 0 011730 011635 3A3 A4 9 4 7611550 0 0
-MQ* 8 51 0 011835 011730 2A2 A3 9 4 8611635 0 0
-MQ* 8 52 0 0 2 011835 1A1 A2 9 4 8611730 0 0
-MQ* 8 53 1 0120051163511940 10B4 9 4 46 0 0 0
-MQ* 8 54 1 0120701163512005 9B3 B4 9 4 4611940 0 0
-MQ* 8 55 1 0121351163512070 8B2 B3 9 4 4612005 012425
-MQ* 8 56 1 0116341163512135 7B1 B2 9 4 4612070 0 0
-MQ* 8 57 1 0122751207012200 14C4 9 1 56 0 0 0
-MQ* 8 58 1 0123501207012275 13C3 C4 9 1 5612200 011835
-MQ* 8 59 1 0124251207012350 12C2 C3 9 1 5612275 0 0
-MQ* 8 60 1 0120681207012425 11C1 C2 9 1 5612350 0 0
-MQ* 8 61 0 0114731147512499 15D1 6 0 76 0 0 0
-MQ* 8 62 17151491526019660 1 8388608 0 9437183 system
-MQ* 8 63 0 0 0 015150 1SYSL 0 0 101 0
-MQ* 8 64 181527616460 4000 1 2228224 3145728 9437183 TDIV18
-MQ* 8 65 0 0156041560515285 15D1 6 0 76 0 0 0
-MQ* 8 66 0 0157431574515380 11C1 C2 9 1 5615455 0 0
-MQ* 8 67 0 0153801574515455 12C2 C3 9 1 5615530 0 0
-MQ* 8 68 0 0154551574515530 13C3 C4 9 1 5615605 015940
-MQ* 8 69 0 0155301574515605 14C4 9 1 56 015285 0
-MQ* 8 70 0 0161491615015680 7B1 B2 9 4 4615745 0 0
-MQ* 8 71 0 0156801615015745 8B2 B3 9 4 4615810 015380
-MQ* 8 72 0 0157451615015810 9B3 B4 9 4 4615875 0 0
-MQ* 8 73 0 0158101615015875 10B4 9 4 46 0 0 0
-MQ* 8 74 0 0 6 015940 1A1 A2 9 4 8616045 016895
-MQ* 8 75 1 015940 016045 2A2 A3 9 4 8616150 0 0
-MQ* 8 76 0 016045 016150 3A3 9 4 76 015680 0
-MQ* 8 77 1 016150 016245 4A4 A5 9 4 6616330 0 0
-MQ* 8 78 1 016245 016330 5A5 A6 9 4 5616405 0 0
-MQ* 8 79 1 016330 016405 6A6 9 4 46 0 0 0
-MQ* 8 80 191646017644 4000 0 2359296 3145728 9437183 TDIV19
-MQ* 8 81 0 0165351594016470 6A6 9 4 46 0 0 0
-MQ* 8 82 0 0166101594016535 5A5 A6 9 4 5616470 0 0
-MQ* 8 83 0 0166951594016610 4A4 A5 9 4 6616535 0 0
-MQ* 8 84 0 0167901594016695 3A3 A4 9 4 761661017195 0
-MQ* 8 85 0 0168951594016790 2A2 A3 9 4 8616695 0 0
-MQ* 8 86 0 0159381594016895 1A1 A2 9 4 8616790 0 0
-MQ* 8 87 0 0170651669517000 10B4 9 4 46 0 0 0
-MQ* 8 88 0 0171301669517065 9B3 B4 9 4 4617000 0 0
-MQ* 8 89 0 0171951669517130 8B2 B3 9 4 4617065 017485
-MQ* 8 90 0 0166941669517195 7B1 B2 9 4 4617130 0 0
-MQ* 8 91 0 0173351713017260 14C4 9 1 56 017559 0
-MQ* 8 92 0 0174101713017335 13C3 C4 9 1 5617260 016895
-MQ* 8 93 0 0174851713017410 12C2 C3 9 1 5617335 0 0
-MQ* 8 94 0 0171281713017485 11C1 C2 9 1 5617410 0 0
-MQ* 8 95 0 0172591726017559 15D1 6 0 76 0 0 0
-MQ* 8 96 201847619660 4000 1 4718592 0 9437183 TDIV20
-MQ* 8 97 0 0187291873018485 15D1 6 0 76 0 0 0
-MQ* 8 98 0 0189431894518580 11C1 C2 9 1 5618655 0 0
-MQ* 8 99 0 0185801894518655 12C2 C3 9 1 5618730 0 0
-MQ* 8100 0 0186551894518730 13C3 C4 9 1 56188051848519140
-MQ* 8101 0 0187301894518805 14C4 9 1 56 0 0 0
-MQ* 8102 0 0190751944518880 7B1 9 4 46 0 0 0
-MQ* 8103 0 0194431944518945 8B2 B3 9 4 4619010 018580
-MQ* 8104 0 0189451944519010 9B3 B4 9 4 4619075 0 0
-MQ* 8105 0 0190101944519075 10B4 B1 9 4 4618880 0 0
-MQ* 8106 0 0 0 019140 1A1 A3 9 4 8619350 0 0
-MQ* 8107 0 019530 019245 2A2 A6 9 4 8619605 0 0
-MQ* 8108 0 019140 019350 3A3 A4 9 4 7619445 0 0
-MQ* 8109 0 019350 019445 4A4 A5 9 4 6619530 018945
-MQ* 8110 0 019445 019530 5A5 A2 9 4 5619245 0 0
-MQ* 8111 0 019245 019605 6A6 9 4 46 0 0 0
-MQ* 8112 8660A2 11835A1 0 0 0 15940A1 19140A1
-MQ* 8113 0 19140A1 19245A2 19350A3 19445A4 19530A5 19605A6
-MQ* 811418880B1 18945B2 19010B3 19075B4
-MQ* 811518580C1 18655C2 18730C3 18805C4 18485D1
-MQ* 8116 157LOW1 0 232LOW3 0 0 0
-MQ* 8117 8660A2 8660A2 8765A3 8860A4 8945A6 8945A6
-MQ* 8118 8465B1 8530B3 8530B3 8595B4 0 0
-MQ* 8119 8595B4 0 0 0 0 0
-MQ* 8120 157LOW1 0 232LOW3 0 0 0
-MQ* 812119140A1 19245A2 19350A3 19445A4 19530A5 19605A6
-MQ* 812218880B1 18945B2 19010B3 19075B4 18580C1 18655C2
-MQ* 9 0TEST MZIXCO + MZXREF.
-MQ* 9 1114085069111439964161140850703114294784311445207071143996419
-MQ* 9 2 17 17 17 17 17 17
-MQ* 9 3 171140850815 171140866048 171140852768
-MQ* 9 4 // 1 5 -1086 -20510 137755
-MQ* 9 5 10 8 29 35 40 6000 5 17
-MQ* 9 6 1 137 30719660 0 1048577 3145728 9437183 QDIV1
-MQ* 9 7 2 8455 900019660 1 1048578 3145728 9437183 QDIV2
-MQ* 9 8 3 900010184 2000 0 1048580 3161215 9437183 TESTDIV3
-MQ* 9 9 41021611400 4000 1 1048584 3161471 9437183 TDIV04
-MQ* 9 10 51140012584 4000 0 1048592 2097535 9437183 TDIV05
-MQ* 9 11 17151491526019660 1 8388608 0 9437183 system
-MQ* 9 12 181527616460 4000 1 2228224 3145728 9437183 TDIV18
-MQ* 9 13 191646017644 4000 0 2359296 3145728 9437183 TDIV19
-MQ* 9 14 201847619660 4000 1 4718592 0 9437183 TDIV20
-MQ* 9 15 // 1 4 -1086 -20510 137755
-MQ* 9 16 10 8 29 35 40 6000 5 17
-MQ* 9 17 1 137 30719660 0 1048577 3145728 9437183 QDIV1
-MQ* 9 18 2 8455 900019660 1 1048578 3145728 9437183 QDIV2
-MQ* 9 19 3 900010184 2000 0 1048580 3157119 9433087 TESTDIV3
-MQ* 9 20 41021611400 4000 1 1048584 2110815 9435103 TDIV04
-MQ* 9 21 51140012584 4000 0 1048592 2097503 9435103 TDIV05
-MQ* 9 22 17151491526019660 1 8388608 0 9437183 system
-MQ* 9 23 181527616460 4000 1 2228224 3145728 9437183 TDIV18
-MQ* 9 24 191646017644 4000 0 2359296 3145728 9437183 TDIV19
-MQ* 9 25 201847619660 4000 1 4718592 0 9437183 TDIV20
-MQ* 10 0TEST MZPUSH.
-MQ* 10 1 // 1 19 -1086 -20510 137755
-MQ* 10 2 10 8 29 35 40 6000 5 17
-MQ* 10 3 1 137 30719660 0 1048577 3145728 9437183 QDIV1
-MQ* 10 4 2 8455 900019660 1 1048578 3145728 9437183 QDIV2
-MQ* 10 5 3 900010184 2000 0 1048580 3157119 9433087 TESTDIV3
-MQ* 10 6 41021611400 4000 1 1048584 2110815 9435103 TDIV04
-MQ* 10 7 51140012584 4000 0 1048592 2097503 9435103 TDIV05
-MQ* 10 8 17151491526019660 1 8388608 0 9437183 system
-MQ* 10 9 181527616460 4000 1 2228224 3145728 9437183 TDIV18
-MQ* 10 10 191646018279 4000 0 2359296 3145728 9437183 TDIV19
-MQ* 10 11 201843619660 4000 1 4718592 0 9437183 TDIV20
-MQ* 10 12 // 1 20 -1086 -20510 137755
-MQ* 10 13 10 8 29 35 40 6000 5 17
-MQ* 10 14 1 137 30719660 0 1048577 3145728 9437183 QDIV1
-MQ* 10 15 2 8254 879919660 1 1048578 3145728 9437183 QDIV2
-MQ* 10 16 3 8799 9983 2000 0 1048580 3157119 9433087 TESTDIV3
-MQ* 10 17 41001511199 4000 1 1048584 2110815 9435103 TDIV04
-MQ* 10 18 51119912383 4000 0 1048592 2097503 9435103 TDIV05
-MQ* 10 19 17149481505919660 1 8388608 0 9437183 system
-MQ* 10 20 181507516259 4000 1 2228224 3145728 9437183 TDIV18
-MQ* 10 21 191625918078 4000 0 2359296 3145728 9437183 TDIV19
-MQ* 10 22 201823119660 4000 1 4718592 0 9437183 TDIV20
-MQ* 10 23 // 1 20 -1086 -20510 137755
-MQ* 10 24 10 8 29 35 40 6000 5 17
-MQ* 10 25 1 137 30719660 0 1048577 3145728 9437183 QDIV1
-MQ* 10 26 0 257 8562 8564 157 16LOW1 LOW3 19 4 46 232 0 0
-MQ* 10 27 0 257 157 8564 232 18LOW3 19 4 66 0 0 0
-MQ* 10 28 2 8254 879919660 1 1048578 3145728 9437183 QDIV2
-MQ* 10 29 1 257 8563 8564 8264 7B1 B3 9 4 46 8329 0 0
-MQ* 10 30 0 257 8264 8564 8329 9B3 B4 9 4 46 8394 0 0
-MQ* 10 31 0 257 8329 8564 8394 10B4 9 4 46 0 0 0
-MQ* 10 32 0 17 1 0 8459 2A2 A3 9 4 86 8564 9234 0
-MQ* 10 33 0 1 8459 0 8564 3A3 A4 9 4 76 8659 8264 157
-MQ* 10 34 1 17 8564 0 8659 4A4 A6 9 4 66 8744 0 0
-MQ* 10 35 0 17 8659 0 8744 6A6 9 4 46 0 0 0
-MQ* 10 36 3 8799 9983 2000 0 1048580 3157119 9433087 TESTDIV3
-MQ* 10 37 0 0 8874 8459 8809 6A6 9 4 46 0 0 0
-MQ* 10 38 0 0 8949 8459 8874 5A5 A6 9 4 56 8809 0 0
-MQ* 10 39 0 0 9034 8459 8949 4A4 A5 9 4 66 8874 0 0
-MQ* 10 40 0 0 9129 8459 9034 3A3 A4 9 4 76 8949 9534 0
-MQ* 10 41 1 0 9234 8459 9129 2A2 A3 9 4 86 9034 0 0
-MQ* 10 42 0 0 8458 8459 9234 1A1 A2 9 4 86 9129 0 0
-MQ* 10 43 0 0 9404 9034 9339 10B4 9 4 46 0 0 0
-MQ* 10 44 0 0 9469 9034 9404 9B3 B4 9 4 46 9339 0 0
-MQ* 10 45 0 0 9534 9034 9469 8B2 B3 9 4 46 9404 0 0
-MQ* 10 46 0 0 9033 9034 9534 7B1 B2 9 4 46 9469 0 0
-MQ* 10 47 1 0 9674 9469 9599 14C4 9 1 56 0 9898 0
-MQ* 10 48 1 0 9749 9469 9674 13C3 C4 9 1 56 9599 0 9234
-MQ* 10 49 1 0 9824 9469 9749 12C2 C3 9 1 56 9674 0 0
-MQ* 10 50 1 0 9467 9469 9824 11C1 C2 9 1 56 9749 0 0
-MQ* 10 51 1 0 9598 9599 9898 15D1 6 0 76 0 0 0
-MQ* 10 52 41001511199 4000 1 1048584 2110815 9435103 TDIV04
-MQ* 10 53 1 0103431034410024 15D1 6 0 76 0 0 0
-MQ* 10 54 1 0104821048410119 11C1 C2 9 1 5610194 0 0
-MQ* 10 55 1 0101191048410194 12C2 C3 9 1 5610269 0 0
-MQ* 10 56 1 0101941048410269 13C3 C4 9 1 5610344 010679
-MQ* 10 57 1 0102691048410344 14C4 9 1 56 010024 0
-MQ* 10 58 1 0108881088910419 7B1 B2 9 4 4610484 0 0
-MQ* 10 59 1 0104191088910484 8B2 B3 9 4 4610549 010119
-MQ* 10 60 1 0104841088910549 9B3 B4 9 4 4610614 0 0
-MQ* 10 61 1 0105491088910614 10B4 9 4 46 0 0 0
-MQ* 10 62 1 0 8 010679 1A1 A2 9 4 8610784 0 0
-MQ* 10 63 1 010679 010784 2A2 A3 9 4 8610889 0 0
-MQ* 10 64 1 010784 010889 3A3 A4 9 4 761098410419 0
-MQ* 10 65 1 010889 010984 4A4 A5 9 4 6611069 0 0
-MQ* 10 66 1 010984 011069 5A5 A6 9 4 5611144 0 0
-MQ* 10 67 1 011069 011144 6A6 9 4 46 0 0 0
-MQ* 10 68 51119912383 4000 0 1048592 2097503 9435103 TDIV05
-MQ* 10 69 0 011274 011209 6A6 9 4 46 0 0 0
-MQ* 10 70 0 011349 011274 5A5 A6 9 4 5611209 012298
-MQ* 10 71 0 011434 011349 4A4 A5 9 4 6611274 0 0
-MQ* 10 72 0 011529 011434 3A3 A4 9 4 7611349 0 0
-MQ* 10 73 0 011634 011529 2A2 A3 9 4 3611434 0 0
-MQ* 10 74 1 0 0 011575 0D 0 0 40 0
-MQ* 10 75 0 0 2 011634 1A1 A2 9 4 8611529 0 0
-MQ* 10 76 1 0118041143411739 10B4 9 4 46 0 0 0
-MQ* 10 77 1 0118691143411804 9B3 B4 9 4 4611739 0 0
-MQ* 10 78 1 0119341143411869 8B2 B3 9 4 4611804 012224
-MQ* 10 79 1 0114331143411934 7B1 B2 9 4 4611869 0 0
-MQ* 10 80 1 0120741186911999 14C4 9 1 56 0 0 0
-MQ* 10 81 1 0121491186912074 13C3 C4 9 1 5611999 011634
-MQ* 10 82 1 0122241186912149 12C2 C3 9 1 5612074 0 0
-MQ* 10 83 1 0118671186912224 11C1 C2 9 1 5612149 0 0
-MQ* 10 84 0 0112721127412298 15D1 6 0 76 0 0 0
-MQ* 10 85 17149481505919660 1 8388608 0 9437183 system
-MQ* 10 86 0 0 0 014949 1SYSL 0 0 101 0
-MQ* 10 87 181507516259 4000 1 2228224 3145728 9437183 TDIV18
-MQ* 10 88 0 0154031540415084 15D1 6 0 76 0 0 0
-MQ* 10 89 0 0155421554415179 11C1 C2 9 1 5615254 0 0
-MQ* 10 90 0 0151791554415254 12C2 C3 9 1 5615329 0 0
-MQ* 10 91 0 0152541554415329 13C3 C4 9 1 5615404 015739
-MQ* 10 92 0 0153291554415404 14C4 9 1 56 015084 0
-MQ* 10 93 0 0159481594915479 7B1 B2 9 4 4615544 0 0
-MQ* 10 94 0 0154791594915544 8B2 B3 9 4 4615609 015179
-MQ* 10 95 0 0155441594915609 9B3 B4 9 4 4615674 0 0
-MQ* 10 96 0 0156091594915674 10B4 9 4 46 0 0 0
-MQ* 10 97 0 0 6 015739 1A1 A2 9 4 8615844 016694
-MQ* 10 98 1 015739 015844 2A2 A3 9 4 8615949 0 0
-MQ* 10 99 0 015844 015949 3A3 9 4 76 015479 0
-MQ* 10100 1 015949 016044 4A4 A5 9 4 6616129 0 0
-MQ* 10101 1 016044 016129 5A5 A6 9 4 5616204 0 0
-MQ* 10102 1 016129 016204 6A6 9 4 46 0 0 0
-MQ* 10103 191625918078 4000 0 2359296 3145728 9437183 TDIV19
-MQ* 10104 0 0163341573916269 6A6 9 4 46 0 0 0
-MQ* 10105 0 0164091573916334 5A5 A6 9 4 5616269 0 0
-MQ* 10106 0 0177931573916409 4A4 A5 9 4 6616334 0 0
-MQ* 10107 1 0165891573916494 3A3 A4 9 4 761640916994 0
-MQ* 10108 0 0166941573916589 2A2 A3 9 4 8617793 0 0
-MQ* 10109 0 0157371573916694 1A1 A2 9 4 8616589 0 0
-MQ* 10110 0 0168641779316799 10B4 9 4 46 0 0 0
-MQ* 10111 0 0169291779316864 9B3 B4 9 4 4616799 0 0
-MQ* 10112 0 0169941779316929 8B2 B3 9 4 4616864 017284
-MQ* 10113 0 0177921779316994 7B1 B2 9 4 4616929 0 0
-MQ* 10114 0 0171341692917059 14C4 9 1 56 017358 0
-MQ* 10115 0 0172091692917134 13C3 C4 9 1 5617059 016694
-MQ* 10116 0 0172841692917209 12C2 C3 9 1 5617134 0 0
-MQ* 10117 0 0169271692917284 11C1 C2 9 1 5617209 0 0
-MQ* 10118 0 0170581705917358 15D1 6 0 276 0 0 0
-MQ* 10119 1 0 0 017644 0D 0 0 90 0
-MQ* 10120 0 0165891573917793 3A3 A4 49 4 2761640916994 0
-MQ* 10121 201823119660 4000 1 4718592 0 9437183 TDIV20
-MQ* 10122 0 019350 018261 4A4 A5 29 4 16619530 018945
-MQ* 10123 0 0187291873018485 15D1 46 0 76 0 0 0
-MQ* 10124 0 0189431894518580 11C1 C2 9 1 5618655 0 0
-MQ* 10125 0 0185801894518655 12C2 C3 9 1 5618730 0 0
-MQ* 10126 0 0186551894518730 13C3 C4 9 1 56188051848519140
-MQ* 10127 0 0187301894518805 14C4 9 1 56 0 0 0
-MQ* 10128 0 0190751826118880 7B1 9 4 46 0 0 0
-MQ* 10129 0 0182591826118945 8B2 B3 9 4 4619010 018580
-MQ* 10130 0 0189451826119010 9B3 B4 9 4 4619075 0 0
-MQ* 10131 0 0190101826119075 10B4 B1 9 4 4618880 0 0
-MQ* 10132 0 0 0 019140 1A1 A3 9 4 8619350 0 0
-MQ* 10133 0 019530 019245 2A2 A6 9 4 8619605 0 0
-MQ* 10134 0 019140 019350 3A3 A4 9 4 7618261 0 0
-MQ* 10135 1 019350 019445 4A4 A5 9 4 6619530 018945
-MQ* 10136 0 018261 019530 5A5 A2 9 4 5619245 0 0
-MQ* 10137 0 019245 019605 6A6 9 4 46 0 0 0
-MQ* 11 0TEST GARBAGE COLLECTION WITHOUT MOVE.
-MQ* 11 1 // 1 20 -1086 -20510 137755
-MQ* 11 2 10 8 29 35 40 6000 5 17
-MQ* 11 3 1 137 30719660 0 1048577 3145728 9437183 QDIV1
-MQ* 11 4 2 8254 879919660 1 1048578 3145728 9437183 QDIV2
-MQ* 11 5 3 8799 9983 2000 0 1048580 3157119 9433087 TESTDIV3
-MQ* 11 6 41001511199 4000 1 1048584 2110815 9435103 TDIV04
-MQ* 11 7 51119912383 4000 0 1048592 2097503 9435103 TDIV05
-MQ* 11 8 17149481505919660 1 8388608 0 9437183 system
-MQ* 11 9 181540516259 4000 1 2228224 3145728 9437183 TDIV18
-MQ* 11 10 191625917883 4000 0 2359296 3145728 9437183 TDIV19
-MQ* 11 11 201823119660 4000 1 4718592 0 9437183 TDIV20
-MQ* 11 12 // 1 20 -1086 -20510 137755
-MQ* 11 13 10 8 29 35 40 6000 5 17
-MQ* 11 14 1 137 30719660 0 1048577 3145728 9437183 QDIV1
-MQ* 11 15 0 257 8562 8564 157 16LOW1 LOW3 19 4 46 232 0 0
-MQ* 11 16 0 257 157 8564 232 18LOW3 19 4 66 0 0 0
-MQ* 11 17 2 8254 879919660 1 1048578 3145728 9437183 QDIV2
-MQ* 11 18 1 257 8563 8564 8264 7B1 B3 9 4 46 8329 0 0
-MQ* 11 19 0 257 8264 8564 8329 9B3 B4 9 4 46 8394 0 0
-MQ* 11 20 0 257 8329 8564 8394 10B4 9 4 46 0 0 0
-MQ* 11 21 0 17 1 0 8459 2A2 A3 9 4 86 8564 9234 0
-MQ* 11 22 0 1 8459 0 8564 3A3 A4 9 4 76 8659 8264 157
-MQ* 11 23 1 17 8564 0 8659 4A4 A6 9 4 66 8744 0 0
-MQ* 11 24 0 17 8659 0 8744 6A6 9 4 46 0 0 0
-MQ* 11 25 3 8799 9983 2000 0 1048580 3157119 9433087 TESTDIV3
-MQ* 11 26 0 0 8874 8459 8809 6A6 9 4 46 0 0 0
-MQ* 11 27 0 0 8949 8459 8874 5A5 A6 9 4 56 8809 0 0
-MQ* 11 28 0 0 9034 8459 8949 4A4 A5 9 4 66 8874 0 0
-MQ* 11 29 0 0 9129 8459 9034 3A3 A4 9 4 76 8949 9534 0
-MQ* 11 30 1 0 9234 8459 9129 2A2 A3 9 4 86 9034 0 0
-MQ* 11 31 0 0 8458 8459 9234 1A1 A2 9 4 86 9129 0 0
-MQ* 11 32 0 0 9404 9034 9339 10B4 9 4 46 0 0 0
-MQ* 11 33 0 0 9469 9034 9404 9B3 B4 9 4 46 9339 0 0
-MQ* 11 34 0 0 9534 9034 9469 8B2 B3 9 4 46 9404 0 0
-MQ* 11 35 0 0 9033 9034 9534 7B1 B2 9 4 46 9469 0 0
-MQ* 11 36 1 0 9674 9469 9599 14C4 9 1 56 0 9898 0
-MQ* 11 37 1 0 9749 9469 9674 13C3 C4 9 1 56 9599 0 9234
-MQ* 11 38 1 0 9824 9469 9749 12C2 C3 9 1 56 9674 0 0
-MQ* 11 39 1 0 9467 9469 9824 11C1 C2 9 1 56 9749 0 0
-MQ* 11 40 1 0 9598 9599 9898 15D1 6 0 76 0 0 0
-MQ* 11 41 41001511199 4000 1 1048584 2110815 9435103 TDIV04
-MQ* 11 42 1 0103431034410024 15D1 6 0 76 0 0 0
-MQ* 11 43 1 0104821048410119 11C1 C2 9 1 5610194 0 0
-MQ* 11 44 1 0101191048410194 12C2 C3 9 1 5610269 0 0
-MQ* 11 45 1 0101941048410269 13C3 C4 9 1 5610344 010679
-MQ* 11 46 1 0102691048410344 14C4 9 1 56 010024 0
-MQ* 11 47 1 0108881088910419 7B1 B2 9 4 4610484 0 0
-MQ* 11 48 1 0104191088910484 8B2 B3 9 4 4610549 010119
-MQ* 11 49 1 0104841088910549 9B3 B4 9 4 4610614 0 0
-MQ* 11 50 1 0105491088910614 10B4 9 4 46 0 0 0
-MQ* 11 51 1 0 8 010679 1A1 A2 9 4 8610784 0 0
-MQ* 11 52 1 010679 010784 2A2 A3 9 4 8610889 0 0
-MQ* 11 53 1 010784 010889 3A3 A4 9 4 761098410419 0
-MQ* 11 54 1 010889 010984 4A4 A5 9 4 6611069 0 0
-MQ* 11 55 1 010984 011069 5A5 A6 9 4 5611144 0 0
-MQ* 11 56 1 011069 011144 6A6 9 4 46 0 0 0
-MQ* 11 57 51119912383 4000 0 1048592 2097503 9435103 TDIV05
-MQ* 11 58 0 011274 011209 6A6 9 4 46 0 0 0
-MQ* 11 59 0 011349 011274 5A5 A6 9 4 5611209 012298
-MQ* 11 60 0 011434 011349 4A4 A5 9 4 6611274 0 0
-MQ* 11 61 0 011529 011434 3A3 A4 9 4 7611349 0 0
-MQ* 11 62 0 011634 011529 2A2 A3 9 4 3611434 0 0
-MQ* 11 63 1 0 0 011575 0D 0 0 40 0
-MQ* 11 64 0 0 2 011634 1A1 A2 9 4 8611529 0 0
-MQ* 11 65 1 0118041143411739 10B4 9 4 46 0 0 0
-MQ* 11 66 1 0118691143411804 9B3 B4 9 4 4611739 0 0
-MQ* 11 67 1 0119341143411869 8B2 B3 9 4 4611804 012224
-MQ* 11 68 1 0114331143411934 7B1 B2 9 4 4611869 0 0
-MQ* 11 69 1 0120741186911999 14C4 9 1 56 0 0 0
-MQ* 11 70 1 0121491186912074 13C3 C4 9 1 5611999 011634
-MQ* 11 71 1 0122241186912149 12C2 C3 9 1 5612074 0 0
-MQ* 11 72 1 0118671186912224 11C1 C2 9 1 5612149 0 0
-MQ* 11 73 0 0112721127412298 15D1 6 0 76 0 0 0
-MQ* 11 74 17149481505919660 1 8388608 0 9437183 system
-MQ* 11 75 0 0 0 014949 1SYSL 0 0 101 0
-MQ* 11 76 181540516259 4000 1 2228224 3145728 9437183 TDIV18
-MQ* 11 77 0 0157331573415414 15D1 6 0 76 0 0 0
-MQ* 11 78 0 0158721587415509 11C1 C2 9 1 5615584 0 0
-MQ* 11 79 0 0155091587415584 12C2 C3 9 1 5615659 0 0
-MQ* 11 80 0 0155841587415659 13C3 C4 9 1 5615734 016069
-MQ* 11 81 0 0156591587415734 14C4 9 1 56 015414 0
-MQ* 11 82 0 0161731617415809 7B1 B2 9 4 4615874 0 0
-MQ* 11 83 0 0158091617415874 8B2 B3 9 4 4615939 015509
-MQ* 11 84 0 0158741617415939 9B3 B4 9 4 4616004 0 0
-MQ* 11 85 0 0159391617416004 10B4 9 4 46 0 0 0
-MQ* 11 86 0 0 6 016069 1A1 A3 9 4 8616174 016599
-MQ* 11 87 0 016069 016174 3A3 9 4 76 015809 0
-MQ* 11 88 191625917883 4000 0 2359296 3145728 9437183 TDIV19
-MQ* 11 89 0 0163341606916269 6A6 9 4 46 0 0 0
-MQ* 11 90 0 0164091606916334 5A5 A6 9 4 5616269 0 0
-MQ* 11 91 0 0175981606916409 4A4 A5 9 4 6616334 0 0
-MQ* 11 92 0 0165991606916494 2A2 A3 9 4 8617598 0 0
-MQ* 11 93 0 0160671606916599 1A1 A2 9 4 8616494 0 0
-MQ* 11 94 0 0167691759816704 10B4 9 4 46 0 0 0
-MQ* 11 95 0 0168341759816769 9B3 B4 9 4 4616704 0 0
-MQ* 11 96 0 0168991759816834 8B2 B3 9 4 4616769 017189
-MQ* 11 97 0 0175971759816899 7B1 B2 9 4 4616834 0 0
-MQ* 11 98 0 0170391683416964 14C4 9 1 56 017263 0
-MQ* 11 99 0 0171141683417039 13C3 C4 9 1 5616964 016599
-MQ* 11100 0 0171891683417114 12C2 C3 9 1 5617039 0 0
-MQ* 11101 0 0168321683417189 11C1 C2 9 1 5617114 0 0
-MQ* 11102 0 0169631696417263 15D1 6 0 276 0 0 0
-MQ* 11103 0 0164941606917598 3A3 A4 49 4 2761640916899 0
-MQ* 11104 201823119660 4000 1 4718592 0 9437183 TDIV20
-MQ* 11105 0 019350 018261 4A4 A5 29 4 16619530 018945
-MQ* 11106 0 0187291873018485 15D1 46 0 76 0 0 0
-MQ* 11107 0 0189431894518580 11C1 C2 9 1 5618655 0 0
-MQ* 11108 0 0185801894518655 12C2 C3 9 1 5618730 0 0
-MQ* 11109 0 0186551894518730 13C3 C4 9 1 56188051848519140
-MQ* 11110 0 0187301894518805 14C4 9 1 56 0 0 0
-MQ* 11111 0 0190751826118880 7B1 9 4 46 0 0 0
-MQ* 11112 0 0182591826118945 8B2 B3 9 4 4619010 018580
-MQ* 11113 0 0189451826119010 9B3 B4 9 4 4619075 0 0
-MQ* 11114 0 0190101826119075 10B4 B1 9 4 4618880 0 0
-MQ* 11115 0 0 0 019140 1A1 A3 9 4 8619350 0 0
-MQ* 11116 0 019530 019245 2A2 A6 9 4 8619605 0 0
-MQ* 11117 0 019140 019350 3A3 A4 9 4 7618261 0 0
-MQ* 11118 1 019350 019445 4A4 A5 9 4 6619530 018945
-MQ* 11119 0 018261 019530 5A5 A2 9 4 5619245 0 0
-MQ* 11120 0 019245 019605 6A6 9 4 46 0 0 0
-MQ* 11121 8459A2 11634A1 0 0 0 16069A1 19140A1
-MQ* 11122 0 19140A1 19245A2 19350A3 18261A4 19530A5 19605A6
-MQ* 1112318880B1 18945B2 19010B3 19075B4
-MQ* 1112418580C1 18655C2 18730C3 18805C4 18485D1
-MQ* 11125 157LOW1 0 232LOW3 0 0 0
-MQ* 11126 8459A2 8459A2 8564A3 8659A4 8744A6 8744A6
-MQ* 11127 8264B1 8329B3 8329B3 8394B4 0 0
-MQ* 11128 8394B4 0 0 0 0 0
-MQ* 11129 157LOW1 0 232LOW3 0 0 0
-MQ* 1113019140A1 19245A2 19350A3 18261A4 19530A5 19605A6
-MQ* 1113118880B1 18945B2 19010B3 19075B4 18580C1 18655C2
-MQ* 11132 // 1 20 -1086 -20510 137755
-MQ* 11133 10 8 29 35 40 6000 5 17
-MQ* 11134 1 137 30719660 0 1048577 3145728 9437183 QDIV1
-MQ* 11135 2 8404 879919660 1 1048578 3145728 9437183 QDIV2
-MQ* 11136 3 8799 9983 2000 0 1048580 3157119 9433087 TESTDIV3
-MQ* 11137 41001511199 4000 1 1048584 2110815 9435103 TDIV04
-MQ* 11138 51119912383 4000 0 1048592 2097503 9435103 TDIV05
-MQ* 11139 17149481505919660 1 8388608 0 9437183 system
-MQ* 11140 181625916259 4000 1 2228224 3145728 9437183 TDIV18
-MQ* 11141 191625916259 4000 0 2359296 3145728 9437183 TDIV19
-MQ* 11142 201823119660 4000 1 4718592 0 9437183 TDIV20
-MQ* 11143 // 1 20 -1086 -20510 137755
-MQ* 11144 10 8 29 35 40 6000 5 17
-MQ* 11145 1 137 30719660 0 1048577 3145728 9437183 QDIV1
-MQ* 11146 0 257 8647 8649 157 16LOW1 LOW3 19 4 46 232 0 0
-MQ* 11147 0 257 157 8649 232 18LOW3 19 4 66 0 0 0
-MQ* 11148 2 8404 879919660 1 1048578 3145728 9437183 QDIV2
-MQ* 11149 0 257 8648 8649 8414 9B3 B4 9 4 46 8479 0 0
-MQ* 11150 0 257 8414 8649 8479 10B4 9 4 46 0 0 0
-MQ* 11151 0 17 1 0 8544 2A2 A3 9 4 86 8649 9234 0
-MQ* 11152 0 1 8544 0 8649 3A3 A6 9 4 76 8744 8414 157
-MQ* 11153 0 17 8649 0 8744 6A6 9 4 46 0 0 0
-MQ* 11154 3 8799 9983 2000 0 1048580 3157119 9433087 TESTDIV3
-MQ* 11155 0 0 8874 8544 8809 6A6 9 4 46 0 0 0
-MQ* 11156 0 0 8949 8544 8874 5A5 A6 9 4 56 8809 0 0
-MQ* 11157 0 0 9034 8544 8949 4A4 A5 9 4 66 8874 0 0
-MQ* 11158 0 0 9129 8544 9034 3A3 A4 9 4 76 8949 9534 0
-MQ* 11159 1 0 9234 8544 9129 2A2 A3 9 4 86 9034 0 0
-MQ* 11160 0 0 8543 8544 9234 1A1 A2 9 4 86 9129 0 0
-MQ* 11161 0 0 9404 9034 9339 10B4 9 4 46 0 0 0
-MQ* 11162 0 0 9469 9034 9404 9B3 B4 9 4 46 9339 0 0
-MQ* 11163 0 0 9534 9034 9469 8B2 B3 9 4 46 9404 0 0
-MQ* 11164 0 0 9033 9034 9534 7B1 B2 9 4 46 9469 0 0
-MQ* 11165 1 0 9674 9469 9599 14C4 9 1 56 0 9898 0
-MQ* 11166 1 0 9749 9469 9674 13C3 C4 9 1 56 9599 0 9234
-MQ* 11167 1 0 9824 9469 9749 12C2 C3 9 1 56 9674 0 0
-MQ* 11168 1 0 9467 9469 9824 11C1 C2 9 1 56 9749 0 0
-MQ* 11169 1 0 9598 9599 9898 15D1 6 0 76 0 0 0
-MQ* 11170 41001511199 4000 1 1048584 2110815 9435103 TDIV04
-MQ* 11171 1 0103431034410024 15D1 6 0 76 0 0 0
-MQ* 11172 1 0104821048410119 11C1 C2 9 1 5610194 0 0
-MQ* 11173 1 0101191048410194 12C2 C3 9 1 5610269 0 0
-MQ* 11174 1 0101941048410269 13C3 C4 9 1 5610344 010679
-MQ* 11175 1 0102691048410344 14C4 9 1 56 010024 0
-MQ* 11176 1 0108881088910419 7B1 B2 9 4 4610484 0 0
-MQ* 11177 1 0104191088910484 8B2 B3 9 4 4610549 010119
-MQ* 11178 1 0104841088910549 9B3 B4 9 4 4610614 0 0
-MQ* 11179 1 0105491088910614 10B4 9 4 46 0 0 0
-MQ* 11180 1 0 8 010679 1A1 A2 9 4 8610784 0 0
-MQ* 11181 1 010679 010784 2A2 A3 9 4 8610889 0 0
-MQ* 11182 1 010784 010889 3A3 A4 9 4 761098410419 0
-MQ* 11183 1 010889 010984 4A4 A5 9 4 6611069 0 0
-MQ* 11184 1 010984 011069 5A5 A6 9 4 5611144 0 0
-MQ* 11185 1 011069 011144 6A6 9 4 46 0 0 0
-MQ* 11186 51119912383 4000 0 1048592 2097503 9435103 TDIV05
-MQ* 11187 0 011274 011209 6A6 9 4 46 0 0 0
-MQ* 11188 0 011349 011274 5A5 A6 9 4 5611209 012298
-MQ* 11189 0 011434 011349 4A4 A5 9 4 6611274 0 0
-MQ* 11190 0 011529 011434 3A3 A4 9 4 7611349 0 0
-MQ* 11191 0 011634 011529 2A2 A3 9 4 3611434 0 0
-MQ* 11192 1 0 0 011575 0D 0 0 40 0
-MQ* 11193 0 0 2 011634 1A1 A2 9 4 8611529 0 0
-MQ* 11194 1 0118041143411739 10B4 9 4 46 0 0 0
-MQ* 11195 1 0118691143411804 9B3 B4 9 4 4611739 0 0
-MQ* 11196 1 0119341143411869 8B2 B3 9 4 4611804 012224
-MQ* 11197 1 0114331143411934 7B1 B2 9 4 4611869 0 0
-MQ* 11198 1 0120741186911999 14C4 9 1 56 0 0 0
-MQ* 11199 1 0121491186912074 13C3 C4 9 1 5611999 011634
-MQ* 11200 1 0122241186912149 12C2 C3 9 1 5612074 0 0
-MQ* 11201 1 0118671186912224 11C1 C2 9 1 5612149 0 0
-MQ* 11202 0 0112721127412298 15D1 6 0 76 0 0 0
-MQ* 11203 17149481505919660 1 8388608 0 9437183 system
-MQ* 11204 0 0 0 014949 1SYSL 0 0 101 0
-MQ* 11205 181625916259 4000 1 2228224 3145728 9437183 TDIV18
-MQ* 11206 191625916259 4000 0 2359296 3145728 9437183 TDIV19
-MQ* 11207 201823119660 4000 1 4718592 0 9437183 TDIV20
-MQ* 11208 0 019350 018261 4A4 A5 29 4 16619530 018945
-MQ* 11209 0 0187291873018485 15D1 46 0 76 0 0 0
-MQ* 11210 0 0189431894518580 11C1 C2 9 1 5618655 0 0
-MQ* 11211 0 0185801894518655 12C2 C3 9 1 5618730 0 0
-MQ* 11212 0 0186551894518730 13C3 C4 9 1 56188051848519140
-MQ* 11213 0 0187301894518805 14C4 9 1 56 0 0 0
-MQ* 11214 0 0190751826118880 7B1 9 4 46 0 0 0
-MQ* 11215 0 0182591826118945 8B2 B3 9 4 4619010 018580
-MQ* 11216 0 0189451826119010 9B3 B4 9 4 4619075 0 0
-MQ* 11217 0 0190101826119075 10B4 B1 9 4 4618880 0 0
-MQ* 11218 0 0 0 019140 1A1 A3 9 4 8619350 0 0
-MQ* 11219 0 019530 019245 2A2 A6 9 4 8619605 0 0
-MQ* 11220 0 019140 019350 3A3 A4 9 4 7618261 0 0
-MQ* 11221 1 019350 019445 4A4 A5 9 4 6619530 018945
-MQ* 11222 0 018261 019530 5A5 A2 9 4 5619245 0 0
-MQ* 11223 0 019245 019605 6A6 9 4 46 0 0 0
-MQ* 11224 8544A2 11634A1 0 0 0 0 19140A1
-MQ* 11225 0 19140A1 19245A2 19350A3 18261A4 19530A5 19605A6
-MQ* 1122618880B1 18945B2 19010B3 19075B4
-MQ* 1122718580C1 18655C2 18730C3 18805C4 18485D1
-MQ* 11228 157LOW1 0 232LOW3 0 0 0
-MQ* 11229 8544A2 8544A2 8649A3 8744A6 8744A6 8744A6
-MQ* 11230 8414B3 8414B3 8414B3 8479B4 0 0
-MQ* 11231 8479B4 0 0 0 0 0
-MQ* 11232 157LOW1 0 232LOW3 0 0 0
-MQ* 1123319140A1 19245A2 19350A3 18261A4 19530A5 19605A6
-MQ* 1123418880B1 18945B2 19010B3 19075B4 18580C1 18655C2
-MQ* 12 0TEST GARBAGE COLLECTION WITH MOVE.
-MQ* 12 1 // 1 20 -1086 -20510 137755
-MQ* 12 2 10 8 29 35 40 6000 5 17
-MQ* 12 3 1 137 30719660 0 1048577 3145728 9437183 QDIV1
-MQ* 12 4 2 8130 852519660 1 1048578 3145728 9437183 QDIV2
-MQ* 12 5 3 8525 9709 2000 0 1048580 3157119 9433087 TESTDIV3
-MQ* 12 6 4 974110925 4000 1 1048584 2110815 9435103 TDIV04
-MQ* 12 7 51092512109 4000 0 1048592 2097503 9435103 TDIV05
-MQ* 12 8 17146741478519660 1 8388608 0 9437183 system
-MQ* 12 9 181598515985 4000 1 2228224 3145728 9437183 TDIV18
-MQ* 12 10 191598515985 4000 0 2359296 3145728 9437183 TDIV19
-MQ* 12 11 201616319660 4000 1 4718592 0 9437183 TDIV20
-MQ* 12 12 // 1 20 -1086 -20510 137755
-MQ* 12 13 10 8 29 35 40 6000 5 17
-MQ* 12 14 1 137 30719660 0 1048577 3145728 9437183 QDIV1
-MQ* 12 15 0 257 8373 8375 157 16LOW1 LOW3 19 4 46 232 0 0
-MQ* 12 16 0 257 157 8375 232 18LOW3 19 4 66 0 0 0
-MQ* 12 17 2 8130 852519660 1 1048578 3145728 9437183 QDIV2
-MQ* 12 18 0 257 8374 8375 8140 9B3 B4 9 4 46 8205 0 0
-MQ* 12 19 0 257 8140 8375 8205 10B4 9 4 46 0 0 0
-MQ* 12 20 0 17 1 0 8270 2A2 A3 9 4 86 8375 8960 0
-MQ* 12 21 0 1 8270 0 8375 3A3 A6 9 4 76 8470 8140 157
-MQ* 12 22 0 17 8375 0 8470 6A6 9 4 46 0 0 0
-MQ* 12 23 3 8525 9709 2000 0 1048580 3157119 9433087 TESTDIV3
-MQ* 12 24 0 0 8600 8270 8535 6A6 9 4 46 0 0 0
-MQ* 12 25 0 0 8675 8270 8600 5A5 A6 9 4 56 8535 0 0
-MQ* 12 26 0 0 8760 8270 8675 4A4 A5 9 4 66 8600 0 0
-MQ* 12 27 0 0 8855 8270 8760 3A3 A4 9 4 76 8675 9260 0
-MQ* 12 28 1 0 8960 8270 8855 2A2 A3 9 4 86 8760 0 0
-MQ* 12 29 0 0 8269 8270 8960 1A1 A2 9 4 86 8855 0 0
-MQ* 12 30 0 0 9130 8760 9065 10B4 9 4 46 0 0 0
-MQ* 12 31 0 0 9195 8760 9130 9B3 B4 9 4 46 9065 0 0
-MQ* 12 32 0 0 9260 8760 9195 8B2 B3 9 4 46 9130 0 0
-MQ* 12 33 0 0 8759 8760 9260 7B1 B2 9 4 46 9195 0 0
-MQ* 12 34 1 0 9400 9195 9325 14C4 9 1 56 0 9624 0
-MQ* 12 35 1 0 9475 9195 9400 13C3 C4 9 1 56 9325 0 8960
-MQ* 12 36 1 0 9550 9195 9475 12C2 C3 9 1 56 9400 0 0
-MQ* 12 37 1 0 9193 9195 9550 11C1 C2 9 1 56 9475 0 0
-MQ* 12 38 1 0 9324 9325 9624 15D1 6 0 76 0 0 0
-MQ* 12 39 4 974110925 4000 1 1048584 2110815 9435103 TDIV04
-MQ* 12 40 1 01006910070 9750 15D1 6 0 76 0 0 0
-MQ* 12 41 1 01020810210 9845 11C1 C2 9 1 56 9920 0 0
-MQ* 12 42 1 0 984510210 9920 12C2 C3 9 1 56 9995 0 0
-MQ* 12 43 1 0 992010210 9995 13C3 C4 9 1 5610070 010405
-MQ* 12 44 1 0 99951021010070 14C4 9 1 56 0 9750 0
-MQ* 12 45 1 0106141061510145 7B1 B2 9 4 4610210 0 0
-MQ* 12 46 1 0101451061510210 8B2 B3 9 4 4610275 0 9845
-MQ* 12 47 1 0102101061510275 9B3 B4 9 4 4610340 0 0
-MQ* 12 48 1 0102751061510340 10B4 9 4 46 0 0 0
-MQ* 12 49 1 0 8 010405 1A1 A2 9 4 8610510 0 0
-MQ* 12 50 1 010405 010510 2A2 A3 9 4 8610615 0 0
-MQ* 12 51 1 010510 010615 3A3 A4 9 4 761071010145 0
-MQ* 12 52 1 010615 010710 4A4 A5 9 4 6610795 0 0
-MQ* 12 53 1 010710 010795 5A5 A6 9 4 5610870 0 0
-MQ* 12 54 1 010795 010870 6A6 9 4 46 0 0 0
-MQ* 12 55 51092512109 4000 0 1048592 2097503 9435103 TDIV05
-MQ* 12 56 0 011000 010935 6A6 9 4 46 0 0 0
-MQ* 12 57 0 011075 011000 5A5 A6 9 4 5610935 012024
-MQ* 12 58 0 011160 011075 4A4 A5 9 4 6611000 0 0
-MQ* 12 59 0 011255 011160 3A3 A4 9 4 7611075 0 0
-MQ* 12 60 0 011360 011255 2A2 A3 9 4 3611160 0 0
-MQ* 12 61 1 0 0 011301 0D 0 0 40 0
-MQ* 12 62 0 0 2 011360 1A1 A2 9 4 8611255 0 0
-MQ* 12 63 1 0115301116011465 10B4 9 4 46 0 0 0
-MQ* 12 64 1 0115951116011530 9B3 B4 9 4 4611465 0 0
-MQ* 12 65 1 0116601116011595 8B2 B3 9 4 4611530 011950
-MQ* 12 66 1 0111591116011660 7B1 B2 9 4 4611595 0 0
-MQ* 12 67 1 0118001159511725 14C4 9 1 56 0 0 0
-MQ* 12 68 1 0118751159511800 13C3 C4 9 1 5611725 011360
-MQ* 12 69 1 0119501159511875 12C2 C3 9 1 5611800 0 0
-MQ* 12 70 1 0115931159511950 11C1 C2 9 1 5611875 0 0
-MQ* 12 71 0 0109981100012024 15D1 6 0 76 0 0 0
-MQ* 12 72 17146741478519660 1 8388608 0 9437183 system
-MQ* 12 73 0 0 0 014675 1SYSL 0 0 101 0
-MQ* 12 74 181598515985 4000 1 2228224 3145728 9437183 TDIV18
-MQ* 12 75 191598515985 4000 0 2359296 3145728 9437183 TDIV19
-MQ* 12 76 201616319660 4000 1 4718592 0 9437183 TDIV20
-MQ* 12 77 1 0 0 016164 1FILL 0 0 2143 0
-MQ* 12 78 0 019435 018346 4A4 A5 29 4 16619530 019030
-MQ* 12 79 0 0188141881518570 15D1 46 0 76 0 0 0
-MQ* 12 80 0 0190281903018665 11C1 C2 9 1 5618740 0 0
-MQ* 12 81 0 0186651903018740 12C2 C3 9 1 5618815 0 0
-MQ* 12 82 0 0187401903018815 13C3 C4 9 1 56188901857019225
-MQ* 12 83 0 0188151903018890 14C4 9 1 56 0 0 0
-MQ* 12 84 0 0191601834618965 7B1 9 4 46 0 0 0
-MQ* 12 85 0 0183441834619030 8B2 B3 9 4 4619095 018665
-MQ* 12 86 0 0190301834619095 9B3 B4 9 4 4619160 0 0
-MQ* 12 87 0 0190951834619160 10B4 B1 9 4 4618965 0 0
-MQ* 12 88 0 0 0 019225 1A1 A3 9 4 8619435 0 0
-MQ* 12 89 0 019530 019330 2A2 A6 9 4 8619605 0 0
-MQ* 12 90 0 019225 019435 3A3 A4 9 4 7618346 0 0
-MQ* 12 91 0 018346 019530 5A5 A2 9 4 5619330 0 0
-MQ* 12 92 0 019330 019605 6A6 9 4 46 0 0 0
-MQ* 12 93 8270A2 11360A1 0 0 0 0 19225A1
-MQ* 12 94 0 19225A1 19330A2 19435A3 18346A4 19530A5 19605A6
-MQ* 12 9518965B1 19030B2 19095B3 19160B4
-MQ* 12 9618665C1 18740C2 18815C3 18890C4 18570D1
-MQ* 12 97 157LOW1 0 232LOW3 0 0 0
-MQ* 12 98 8270A2 8270A2 8375A3 8470A6 8470A6 8470A6
-MQ* 12 99 8140B3 8140B3 8140B3 8205B4 0 0
-MQ* 12100 8205B4 0 0 0 0 0
-MQ* 12101 157LOW1 0 232LOW3 0 0 0
-MQ* 1210219225A1 19330A2 19435A3 18346A4 19530A5 19605A6
-MQ* 1210318965B1 19030B2 19095B3 19160B4 18665C1 18740C2
-MR* 1 0TEST MZREPL WITH KEEP.
-MR* 1 1 // 1 2 -1059 -20483 137776
-MR* 1 2 10 8 29 35 40 6000 2 20
-MR* 1 3 1 137 78919660 0 1048577 3145728 9437183 QDIV1
-MR* 1 4 0 01561215614 157 16LOW1 LOW2 19 4 46 232 0 0
-MR* 1 5 0 0 15715614 232 17LOW2 LOW3 19 4 56 317 0 0
-MR* 1 6 0 0 23215614 317 18LOW3 LOW4 19 4 66 412 0 0
-MR* 1 7 0 0 31715614 412 19LOW4 LOW5 19 4 76 517 0 0
-MR* 1 8 0 0 41215614 517 20LOW5 LOW6 19 4 86 632 0 0
-MR* 1 9 0 0 51715614 632 21LOW6 19 4 96 0 0 0
-MR* 1 10 0 0 3 0 740 1IX IX 2 1 1 7531657315709
-MR* 1 11 0 0 740 0 753 2IX IX 2 1 1 7661667815614
-MR* 1 12 0 0 753 0 766 3IX IX 2 1 1 7791677315529
-MR* 1 13 0 0 766 0 779 4IX 2 1 1 01685815454
-MR* 1 14 2154441700019660 1 1048578 3145728 9437183 QDIV2
-MR* 1 15 0 0155291699115454 2NA5 A6 9 4 5616933 0 0
-MR* 1 16 0 0156141699115529 2NA4 NA5 9 4 6615454 0 0
-MR* 1 17 0 0157091699115614 2NA3 NA4 9 4 761552916208 157
-MR* 1 18 0 0164681699115709 2NA2 NA3 9 4 8615614 0 0
-MR* 1 19 0 0161321613315813 15D1 6 0 76 0 0 0
-MR* 1 20 0 0162711627315908 11C1 C2 9 1 5615983 016468
-MR* 1 21 0 0159081627315983 12C2 C3 9 1 5616058 015709
-MR* 1 22 0 0159831627316058 13C3 C4 9 1 5616133 015614
-MR* 1 23 0 0160581627316133 14C4 9 1 56 01581315529
-MR* 1 24 0 0156131561416208 7B1 B2 9 4 4616273 0 0
-MR* 1 25 0 0162081561416273 8B2 B3 9 4 4616338 015908
-MR* 1 26 0 0162731561416338 9B3 B4 9 4 4616403 0 0
-MR* 1 27 0 0163381561416403 10B4 9 4 46 0 0 0
-MR* 1 28 0 0169901699116468 1A1 NA2 9 4 8615709 0 0
-MR* 1 29 0 0 739 74016573 2A2 9 0 86 0 0 0
-MR* 1 30 0 0 752 75316678 3A3 9 0 76 016208 157
-MR* 1 31 0 0 765 76616773 4A4 9 0 66 0 0 0
-MR* 1 32 0 0 778 77916858 5A5 9 0 56 0 0 0
-MR* 1 33 0 0154541699116933 6A6 9 4 46 0 0 0
-MR* 1 34 0 0 1 016991 1SUP 2 1 0 01646815614
-MR* 1 35 20195491966019660 1 8388608 0 9437183 system
-MR* 1 36 0 0 0 019550 1SYSL 0 0 101 0
-MR* 1 3716991SUP 0 740IX 0 0 0 0
-MR* 1 38 0 16468A1 15709NA2 15614NA3 15529NA4 15454NA5 16933A6
-MR* 1 3916208B1 16273B2 16338B3 16403B4
-MR* 1 4015908C1 15983C2 16058C3 16133C4 15813D1
-MR* 1 41 157LOW1 232LOW2 317LOW3 412LOW4 517LOW5 632LOW6
-MR* 1 4216468A1 15709NA2 15614NA3 15529NA4 15454NA5 16933A6
-MR* 1 4316208B1 16273B2 16338B3 16403B4 15908C1 15983C2
-MR* 1 4416403B4 15908C1 15983C2 16058C3 16133C4 15813D1
-MR* 1 45 157LOW1 232LOW2 317LOW3 412LOW4 517LOW5 632LOW6
-MR* 1 4616468A1 15709NA2 15614NA3 15529NA4 15454NA5 16933A6
-MR* 1 4716208B1 16273B2 16338B3 16403B4 15908C1 15983C2
-MR* 2 0TEST MZREPL WITH DROP.
-MR* 2 1 // 1 3 -1059 -20483 137776
-MR* 2 2 10 8 29 35 40 6000 3 19
-MR* 2 3 1 137 13719660 0 1048577 3145728 9437183 QDIV1
-MR* 2 4 2137881380019660 1 1048578 3145728 9437183 QDIV2
-MR* 2 5 0 0 1 013791 1SUP 2 1 0 01387514739
-MR* 2 6 31380014984 2000 0 1048580 3145728 9437183 TESTDIV3
-MR* 2 7 0 0149191379113810 6A6 9 4 46 0 0 0
-MR* 2 8 0 0137901379113875 1A1 NA2 9 4 8614634 0 0
-MR* 2 9 0 0140451473913980 10B4 9 4 46 0 0 0
-MR* 2 10 0 0141101473914045 9B3 B4 9 4 4613980 0 0
-MR* 2 11 0 0141751473914110 8B2 B3 9 4 4614045 014465
-MR* 2 12 0 0147381473914175 7B1 B2 9 4 4614110 0 0
-MR* 2 13 0 0143151411014240 14C4 9 1 56 01453914834
-MR* 2 14 0 0143901411014315 13C3 C4 9 1 5614240 014739
-MR* 2 15 0 0144651411014390 12C2 C3 9 1 5614315 014634
-MR* 2 16 0 0141081411014465 11C1 C2 9 1 5614390 013875
-MR* 2 17 0 0142391424014539 15D1 6 0 76 0 0 0
-MR* 2 18 0 0138751379114634 2NA2 NA3 9 4 8614739 0 0
-MR* 2 19 0 0146341379114739 2NA3 NA4 9 4 761483414175 0
-MR* 2 20 0 0147391379114834 2NA4 NA5 9 4 6614919 0 0
-MR* 2 21 0 0148341379114919 2NA5 A6 9 4 5613810 0 0
-MR* 2 22 19175491766019660 1 8388608 0 9437183 system
-MR* 2 23 0 0 0 017550 1SYSL 0 0 101 0
-MR* 2 24 201966019660 4000 1 4718592 0 9437183 TDIV20
-MR* 2 2513791SUP 0 0 0 0 0 0
-MR* 2 26 0 13875A1 14634NA2 14739NA3 14834NA4 14919NA5 13810A6
-MR* 2 2714175B1 14110B2 14045B3 13980B4
-MR* 2 2814465C1 14390C2 14315C3 14240C4 14539D1
-MR* 2 29 0 0 0 0 0 0
-MR* 2 3013875A1 14634NA2 14739NA3 14834NA4 14919NA5 13810A6
-MR* 2 3114175B1 14110B2 14045B3 13980B4 14465C1 14390C2
-MR* 2 3213980B4 14465C1 14390C2 14315C3 14240C4 14539D1
-MR* 2 33 0 0 0 0 0 0
-MR* 2 3413875A1 14634NA2 14739NA3 14834NA4 14919NA5 13810A6
-MR* 2 3514175B1 14110B2 14045B3 13980B4 14465C1 14390C2
-MR* 3 0TEST MZREPL WITH I.
-MR* 3 1 // 1 3 -1059 -20483 137776
-MR* 3 2 10 8 29 35 40 6000 3 19
-MR* 3 3 1 137 13719660 0 1048577 3145728 9437183 QDIV1
-MR* 3 4 2137881380019660 1 1048578 3145728 9437183 QDIV2
-MR* 3 5 0 0 1 013791 1SUP 2 1 0 013875 0
-MR* 3 6 31380014984 2000 0 1048580 3145728 9437183 TESTDIV3
-MR* 3 7 0 0149191379113810 6A6 9 4 46 0 0 0
-MR* 3 8 0 0137901379113875 1A1 NA2 9 4 8614634 0 0
-MR* 3 9 0 0140451473913980 10B4 9 4 46 0 0 0
-MR* 3 10 0 0141101473914045 9B3 B4 9 4 4613980 0 0
-MR* 3 11 0 0141751473914110 8B2 B3 9 4 4614045 014465
-MR* 3 12 0 0147381473914175 7B1 B2 9 4 4614110 0 0
-MR* 3 13 0 0143151411014240 14C4 9 1 56 014539 0
-MR* 3 14 0 0143901411014315 13C3 C4 9 1 5614240 0 0
-MR* 3 15 0 0144651411014390 12C2 C3 9 1 5614315 0 0
-MR* 3 16 0 0141081411014465 11C1 C2 9 1 5614390 013875
-MR* 3 17 0 0142391424014539 15D1 6 0 76 0 0 0
-MR* 3 18 0 0138751379114634 2NA2 NA3 9 4 8614739 0 0
-MR* 3 19 0 0146341379114739 2NA3 NA4 9 4 761483414175 0
-MR* 3 20 0 0147391379114834 2NA4 NA5 9 4 6614919 0 0
-MR* 3 21 0 0148341379114919 2NA5 A6 9 4 5613810 0 0
-MR* 3 22 19175491766019660 1 8388608 0 9437183 system
-MR* 3 23 0 0 0 017550 1SYSL 0 0 101 0
-MR* 3 24 201966019660 4000 1 4718592 0 9437183 TDIV20
-MR* 3 2513791SUP 0 0 0 0 0 0
-MR* 3 26 0 13875A1 0 0 0 0 13810A6
-MR* 3 2714175B1 14110B2 14045B3 13980B4
-MR* 3 2814465C1 14390C2 14315C3 14240C4 14539D1
-MR* 3 29 0 0 0 0 0 0
-MR* 3 3013875A1 0 0 0 0 13810A6
-MR* 3 3114175B1 14110B2 14045B3 13980B4 14465C1 14390C2
-MR* 3 3213980B4 14465C1 14390C2 14315C3 14240C4 14539D1
-MR* 3 33 0 0 0 0 0 0
-MR* 3 3413875A1 0 0 0 0 13810A6
-MR* 3 3514175B1 14110B2 14045B3 13980B4 14465C1 14390C2
diff --git a/src/packlib/zebra/tq/Imakefile b/src/packlib/zebra/tq/Imakefile
deleted file mode 100644
index 9e7d85d..0000000
--- a/src/packlib/zebra/tq/Imakefile
+++ /dev/null
@@ -1,4 +0,0 @@
-SRCS_F= tzacw.F tzfind.F tzfree.F tzinit.F tzinq.F tzshun.F \ @@\
- tzuser.F tzvers.F
-
-SubdirLibraryTarget(NullParameter,NullParameter)
diff --git a/src/packlib/zebra/tq/tzacw.F b/src/packlib/zebra/tq/tzacw.F
deleted file mode 100644
index 9a7f18a..0000000
--- a/src/packlib/zebra/tq/tzacw.F
+++ /dev/null
@@ -1,51 +0,0 @@
-*
-* $Id: tzacw.F,v 1.2 1999/06/18 13:31:32 couet Exp $
-*
-* $Log: tzacw.F,v $
-* Revision 1.2 1999/06/18 13:31:32 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.1.1.1 1996/03/06 10:47:27 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE TZACW (TEXT)
-
-C- Krack A[n][C][W] for TZINIT and TZFREE
-
-#include "zebra/zmach.inc"
-#include "zebra/tzc1.inc"
-*
- COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT,DUMMY(36)
- CHARACTER TEXT*(*)
- DIMENSION IFLHOL(2)
- EQUIVALENCE (IFLHOL(1),IFLHC)
-
-
- JE = LEN (TEXT)
- IF (JE.EQ.1) THEN
- NCHPW = IQCHAW
- RETURN
- ENDIF
-
- NCHPW = ICDECI (TEXT,2,JE)
- JA = NESLAT
- IF (NCHPW.EQ.0) NCHPW = IQCHAW
- NCHPW = MIN (NCHPW,IQCHAW)
- IF (JA.GT.JE) RETURN
- CALL CLTOU (TEXT)
-
- 24 J = INDEX('CW',TEXT(JA:JA))
- IF (J.EQ.0) GO TO 92
- IFLHOL(J) = 1
- JA = JA + 1
- IF (JA.GT.JE) RETURN
- GO TO 24
-
-C-- Trouble
-
- 92 NCHPW = -JA
- RETURN
- END
diff --git a/src/packlib/zebra/tq/tzfind.F b/src/packlib/zebra/tq/tzfind.F
deleted file mode 100644
index 0e19821..0000000
--- a/src/packlib/zebra/tq/tzfind.F
+++ /dev/null
@@ -1,84 +0,0 @@
-*
-* $Id: tzfind.F,v 1.4 1999/06/18 13:31:32 couet Exp $
-*
-* $Log: tzfind.F,v $
-* Revision 1.4 1999/06/18 13:31:32 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.3 1997/03/14 17:22:21 mclareni
-* WNT mods
-*
-* Revision 1.2.2.1 1997/01/21 11:34:12 mclareni
-* All mods for Winnt 96a on winnt branch
-*
-* Revision 1.2 1996/04/18 16:14:51 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:27 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE TZFIND (IXSTOR,LBK,IDHP,IDNP,IFLAG)
-
-C- Find title bank with IDH (and IDN if non-zero)
-
-#include "zebra/mqsys.inc"
-#include "zebra/eqlqt.inc"
-*
- INTEGER IDHP(9), IDNP(9), IDH
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HTZFI, 4HND /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HTZFIND /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'TZFIND ')
-#endif
-
-#include "zebra/q_jbyt.inc"
-
-#include "zebra/qstore.inc"
-
-#ifndef CERNLIB_WINNT
- CALL UCTOH (IDHP,IDH,4,4)
-#else
- CALL UCOPY (IDHP,IDH,1)
-#endif
- IDN = IDNP(1)
-
- L = LQT(KQT+1)
- GO TO 12
-
- 11 L = LQ(KQS+L)
- 12 IF (L.EQ.0) GO TO 21
- IF (IQ(KQS+L-4).NE.IDH) GO TO 11
-
- IF (IDN.NE.0) THEN
- IF (IDN.NE.IQ(KQS+L-5)) GO TO 11
- ENDIF
-
- LBK = L
- RETURN
-
-C-- bank not found
-
- 21 IF (IFLAG.EQ.0) THEN
- LBK = 0
- RETURN
- ENDIF
-
-#include "zebra/qtrace.inc"
-
- IQUEST(2)= IDH
- IQUEST(3)= IDN
- IQUEST(4)= 0
- IQUEST(5)= LQT(KQT+1)
- K = IFLAG
- IF (K.LT.100) K=61
- CALL ZTELL (K,1)
- END
diff --git a/src/packlib/zebra/tq/tzfree.F b/src/packlib/zebra/tq/tzfree.F
deleted file mode 100644
index 1475eb7..0000000
--- a/src/packlib/zebra/tq/tzfree.F
+++ /dev/null
@@ -1,256 +0,0 @@
-*
-* $Id: tzfree.F,v 1.3 1999/06/18 13:31:33 couet Exp $
-*
-* $Log: tzfree.F,v $
-* Revision 1.3 1999/06/18 13:31:33 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.2 1996/04/18 16:14:52 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:27 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE TZFREE
-
-C-- Read 1 title bank in free field format for TZINIT
-
-#include "zebra/zmach.inc"
-#include "zebra/zstate.inc"
-#include "zebra/zunit.inc"
-#include "zebra/mqsys.inc"
-#include "zebra/eqlqt.inc"
-#include "zebra/tzuc.inc"
-#include "zebra/tzc1.inc"
-*
- COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT,NUM(2),DUMMY(34)
- CHARACTER COL(LGL)*1
- EQUIVALENCE (COL(1), LINE(1:1))
-
- CHARACTER CHTYP*(*), FAULT*20
- PARAMETER (CHTYP = '#''":')
-
-
- IF (JCOLA.EQ.0) JCOLA = 1
- IF (JCOLE.EQ.0) JCOLE = LGL
- IF (NCHPW.EQ.0) NCHPW = 4
- IPRHEA = IFLLOG
- NREADY = 7
- MULT = 0
- LPUTX = LPUTA
-
-C-- Print delimitation, unless full line
-
- IF (IFLPRI.EQ.0) GO TO 21
- IF (JCOLE.EQ.LGL) THEN
- IF (JCOLA.EQ.1) GO TO 21
- WRITE (IQLOG,9016) BLANK(1:JCOLA)
- ELSE
- NB = JCOLE-1 - JCOLA
- IF (NB.GE.3) THEN
- WRITE (IQLOG,9016) BLANK(1:JCOLA), BLANK(1:NB-2)
- ELSE
- WRITE (IQLOG,9017) BLANK(1:JCOLA), BLANK(1:NB)
- ENDIF
- ENDIF
-
- 9016 FORMAT (5X,A,'<-',A,'->')
- 9017 FORMAT (5X,A,'<',A,'>')
-
-C---- Read line by line
-
- 21 CONTINUE
-#include "zebra/tzread1.inc"
-
- IF (COL(1).EQ.'*') RETURN
-
- IF (IFLPRI.NE.0) WRITE (IQLOG,9001) LINE(1:NCHORG)
- 9001 FORMAT (6X,A)
-
-
-C------ Crack field by field
-
- JSTATE = 0
- JTKEND = MIN (NCHORG,JCOLE)
- JTKE = JCOLA - 1
- 24 J = ICNEXT (LINE,JTKE+1,JTKEND)
- IF (J.GT.JTKEND) THEN
- IF (MULT.NE.0) GO TO 82
- GO TO 21
- ENDIF
-
- JTKA = J
- JTKE = NESLAT - 1
- NTK = NDSLAT
-
- JTYP = INDEX (CHTYP,COL(JTKA)) + 1
- GO TO (61, 31, 41, 41, 43), JTYP
-C- 1 2 3 4 5
-C- numeric # ' " :
-
-C---- # item
-
- 31 IF (NTK.LT.2) GO TO 81
- JIT = INDEX ('.ADNadnOo0Xx', COL(JTKA+1))
-C- 123456789012
- IF (JIT.EQ.0) GO TO 81
- IF (JIT.GE.8) GO TO 61
- IF (JIT.GE.5) JIT = JIT - 3
- IF (MULT.NE.0) GO TO 82
-
-C-- #. comment #
- IF (JIT.EQ.1) THEN
- JTKE = ICFIND ('#', LINE,JTKA+2,JTKEND)
- GO TO 24
- ENDIF
-
-C-- #AnCW control item
- IF (JIT.EQ.2) THEN
- CALL TZACW (LINE(JTKA+1:JTKE))
- IF (NCHPW.GE.0) GO TO 24
- NCHPW = 4
- GO TO 81
- ENDIF
-
-C-- #Double control item
- IF (JIT.EQ.3) THEN
- IFLDBL = 1
- GO TO 24
- ENDIF
-
-C-- #Normal control item
- IFLDBL = 0
- GO TO 24
-
-C---- Handling Hollerith
-
- 41 JTKE = ICFIND (COL(JTKA), LINE,JTKA+1,JTKEND)
- IF (JTKE.GT.JTKEND) GO TO 83
- NTK = JTKE - JTKA
-
- 43 JTKA = JTKA + 1
- NTK = NTK - 1
-
- NWDH = (NTK-1) / NCHPW + 1
- NWDS = NWDH + IFLHC + IFLHW
- NWDT = NWDS
- IF (MULT.NE.0) NWDT = NWDT * MULT
- IF (LPUTX+NWDT.GT.LPUTE) GO TO 84
-
- JST = LPUTX
- IF (IFLHC.NE.0) THEN
- LQ(JST) = NTK
- JST = JST + 1
- ENDIF
-
- IF (IFLHW.NE.0) THEN
- LQ(JST) = NWDH
- JST = JST + 1
- ENDIF
-
- CALL UCTOH (LINE(JTKA:JTKE), LQ(JST),NCHPW, NTK)
-
- JST = LPUTX
- LPUTX = LPUTX + NWDT
- IF (MULT.EQ.0) GO TO 24
-
- MULT = MULT - 1
- CALL UCOCOP (LQ(JST),LQ(JST+NWDS),MULT,NWDS,0,NWDS)
- MULT = 0
- GO TO 24
-
-C---- Handle numeric
-
- 61 CALL CKRACK (LINE,JTKA,JTKE,IFLDBL)
- IF (NFSLAT.LE.0) GO TO 86
- IF (NGSLAT.NE.0) GO TO 67
- NWDS = MAX (1, NFSLAT-2)
- NWDT = NWDS
- IF (MULT.NE.0) NWDT = NWDT * MULT
- IF (LPUTX+NWDT.GT.LPUTE) GO TO 84
-
- JST = LPUTX
- LPUTX = LPUTX + NWDT
- IF (MULT.NE.0) GO TO 64
-
- LQ(JST) = NUM(1)
- IF (NWDS.EQ.1) GO TO 24
- LQ(JST+1) = NUM(2)
- GO TO 24
-
- 64 IF (NWDS.EQ.1) THEN
- CALL VFILL (LQ(JST),MULT,NUM(1))
- ELSE
- CALL UCOCOP (NUM,LQ(JST),MULT,NWDS,0,NWDS)
- ENDIF
- MULT = 0
- GO TO 24
-
-C-- handle repeat*
-
- 67 JE = NESLAT
- IF (COL(JE).NE.'*') GO TO 86
- IF (NFSLAT.GE.3) GO TO 81
- IF (MULT.NE.0) GO TO 82
- IF (NUM(1).LE.1) GO TO 85
- MULT = NUM(1)
- JTKE = JE
- GO TO 24
-
-C---- EoF seen
-
- 78 NREADY = -7
- RETURN
-
-C---- Error handling
-
-C- 81 : nothing special
-C- 82 : pending repeat not allowed
-C- 83 : missing terminator " or '
-C- 84 : more data than expected
-C- 85 : invalid repeat count
-C- 86 : invalid numeric
-
- 86 JSTATE = 1
- JTKA = NESLAT
- 85 JSTATE = JSTATE + 1
- 84 JSTATE = JSTATE + 1
- 83 JSTATE = JSTATE + 1
- 82 JSTATE = JSTATE + 1
- 81 JSTATE = JSTATE + 1
-
- IF (IFLPRI.EQ.0) THEN
- IF (IPRHEA.EQ.0) THEN
- WRITE (IQLOG,9012) LHEAD(1:NHEAD)
- IPRHEA = 7
- ENDIF
- WRITE (IQLOG,9001) LINE(1:JTKEND)
- ENDIF
-
- IF (JSTATE.EQ.1) THEN
- FAULT = 'fault'
- ELSEIF (JSTATE.EQ.2) THEN
- FAULT = 'pending repeat'
- ELSEIF (JSTATE.EQ.3) THEN
- FAULT = 'missing terminator'
- ELSEIF (JSTATE.EQ.4) THEN
- FAULT = 'too much data'
- ELSEIF (JSTATE.EQ.5) THEN
- FAULT = 'invalid repeat count'
- ELSEIF (JSTATE.EQ.6) THEN
- FAULT = 'invalid'
- ENDIF
-
- WRITE (IQLOG,9091) BLANK(1:JTKA),FAULT
- NFAULT = NFAULT + 1
- MULT = 0
- IF (JSTATE.NE.4) GO TO 21
- NREADY = 0
- RETURN
-
- 9012 FORMAT (3X,' > ',A)
- 9091 FORMAT (' !!f',A,'^-> !!! ',A)
- END
diff --git a/src/packlib/zebra/tq/tzinit.F b/src/packlib/zebra/tq/tzinit.F
deleted file mode 100644
index 55d15ec..0000000
--- a/src/packlib/zebra/tq/tzinit.F
+++ /dev/null
@@ -1,428 +0,0 @@
-*
-* $Id: tzinit.F,v 1.4 1999/06/18 13:31:33 couet Exp $
-*
-* $Log: tzinit.F,v $
-* Revision 1.4 1999/06/18 13:31:33 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.3 1996/04/24 17:27:35 mclareni
-* Extend the include file cleanup to dzebra, rz and tq, and also add
-* dependencies in some cases.
-*
-* Revision 1.2 1996/04/18 16:14:53 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:27 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE TZINIT (LUNP,IXDIV)
-
-C-- Master routine for title input
-
-#include "zebra/zmach.inc"
-#include "zebra/zstate.inc"
-#include "zebra/zunit.inc"
-#include "zebra/mqsys.inc"
-#include "zebra/eqlqt.inc"
-#include "zebra/mzcwk.inc"
-#include "zebra/tzuc.inc"
-#include "zebra/tzc1.inc"
-*
- COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT,DUMMY(36)
- CHARACTER COL(LGL)*1
- EQUIVALENCE (COL(1), LINE(1:1))
- CHARACTER CHWORK*8
-#if defined(CERNLIB_EQUHOLCH)
- INTEGER IWORK(2)
- EQUIVALENCE (CHWORK,IWORK)
-#endif
-
- DIMENSION LUNP(1)
- DIMENSION IFLAGS(5)
- EQUIVALENCE (IFLAGS(1),IFLLOG)
-
- PARAMETER (NCC = 7)
- CHARACTER CCTEXT(NCC)*6
-
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HTZIN, 4HIT /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HTZINIT /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'TZINIT ')
-#endif
- DATA CCTEXT / 'LOG ', 'PR*INT', 'US*ER ', 'KI*LL '
- +, 'ANY*WA', 'DO ', 'FIN*IS' /
-
-#include "zebra/q_sbyt.inc"
-
-
-#include "zebra/qtraceq.inc"
-
-C-- decide division
-
- CALL MZSDIV (IXDIV,7)
- L = LQT(KQT+1)
- IF (L.NE.0) JQDIVI = MZFDIV (-7, L)
- IF (JQDIVI.EQ.0) JQDIVI = 2
- JSTOR = JQSTOR
- IXTITL = MSBYT (JQSTOR,JQDIVI,27,4)
-
-C-- invert the order of the title banks,
-C- so that the new ones can be created at the beginning
-
- IF (L.NE.0) CALL ZTOPSY (IXTITL,L)
-
- CALL VZERO (NPARA,23)
- CALL VZERO (NREADY,12)
- IF (NQLOGL.GE.-1) IFLLOG = 1
- BLANK = ' '
-
-C-- get the input unit
-
- LUNTQ = LUNP(1)
- IF (LUNTQ.LT.0) LUNTQ = IQTTIN
- IF (LUNTQ.EQ.0) LUNTQ = IQREAD
-#if defined(CERNLIB_QPRINT)
- IF (IFLLOG.NE.0) THEN
- JDV = JQDIVI
- IF (JDV.EQ.JQDVSY) JDV = 24
- WRITE (IQLOG,9000) LUNTQ,JQSTOR,JDV
- ENDIF
- 9000 FORMAT (1X/' TZINIT. Read title banks from LUNTQ = ',I3/
- F10X,'for store',I3,' into division',I3/1X)
-#endif
-
-C---- Look for next control line
-
- 12 IF (NREADY.NE.0) GO TO 14
-
-#include "zebra/tzread1.inc"
-
- 14 NREADY = 0
- IF (NCHORG.EQ.0) GO TO 12
- IF (LINE(1:2).EQ.'*.') GO TO 12
- IF (LINE(1:4).EQ.'*CMZ') GO TO 12
-
- NCHLN = NCHORG
- J = INDEX (LINE(1:NCHLN),' #.')
- IF (J.NE.0) NCHLN = LNBLNK (LINE(1:J))
- IF (NCHLN.EQ.0) GO TO 12
-
- IF (COL(1).NE.'*') GO TO 91
- IF (IFLLOG.NE.0) WRITE (IQLOG,9012) LINE(1:NCHORG)
- 9012 FORMAT (' > ',A)
-
- IF (LINE(1:2).EQ.'*-') GO TO 12
-
- NHEAD = MIN (NCHORG,80)
- LHEAD(1:NHEAD) = LINE(1:NHEAD)
- CALL CLTOU (LINE(1:NCHLN))
- IGNORE = 0
-
-C---- Analyse control line
-
- JA = ICNEXT (LINE,1,NCHLN) + 1
- JE = NESLAT - 1
- NN = NDSLAT
-
- IF (NN.LT.3) GO TO 92
- JCC = ICNTH (LINE(2:NN),CCTEXT,NCC)
-
-C- log print user kill anyw do finis
-C- 1 2 3 4 5 6 7
-
- IF (JCC.EQ.0) GO TO 92
- IF (JCC.EQ.NCC) GO TO 78
-
- JA = ICNEXT (LINE,JE+1,NCHLN)
- JE = NESLAT - 1
- NN = NDSLAT
- IF (JCC.EQ.NCC-1) GO TO 21
-
-C-- *LOG, *PRINT, *USER, *KILL, *ANYWAY (OFF)
-
- IF (NN.EQ.0) THEN
- IFLAGS(JCC) = 1
- IF (JCC.EQ.2) IFLLOG = 1
- GO TO 12
- ENDIF
-
- IF (NN.NE.3) GO TO 92
- CHWORK = LINE(JA:JA+2)
- IF (CHWORK(1:3).NE.'OFF') GO TO 92
- IFLAGS(JCC) = 0
- IF (JCC.EQ.1) IFLPRI = 0
- GO TO 12
-
-C-------- Analyse *DO idh idn -opt x --------
-
- 21 IF (NN.EQ.0) GO TO 92
- NN = MIN(NN,4)
- CHWORK = ' '
- CHWORK(1:NN) = LINE(JA:JA+NN-1)
- CALL VZERO (NAME,5)
- CALL VZERO (IFLEXA,16)
-#if defined(CERNLIB_EQUHOLCH)
- NAME(1) = IWORK(1)
-#endif
-#if !defined(CERNLIB_EQUHOLCH)
- CALL UCTOH (CHWORK,NAME,4,4)
-#endif
- IDNUM = -1
-
- 24 JA = ICNEXT (LINE,JE+1,NCHLN)
- IF (JA.GT.NCHLN) GO TO 61
- JE = NESLAT - 1
- NN = NDSLAT
-
- IF (COL(JA).NE.'-') THEN
- IF (IDNUM.GE.0) GO TO 92
- IDNUM = ICDECI (LINE,JA,JE)
- IF (IDNUM.LT.0) GO TO 92
- IF (NGSLAT.NE.0) GO TO 92
- GO TO 24
- ENDIF
-
- IDNUM = MAX (IDNUM,0)
- IF (NN.EQ.1) GO TO 92
-
- JA = JA + 1
- JOPT = INDEX ('FISENUCA',COL(JA))
- IF (JOPT.EQ.0) GO TO 92
-
- JA = JA + 1
- NN = NN - 2
- GO TO (31, 34, 36, 37, 39, 41, 44, 47), JOPT
-C- F I S E N U C A
-C- 1 2 3 4 5 6 7 8
-
-C-- option -F(format), Fortran FORMAT
-
- 31 IF (COL(JA).NE.'(') GO TO 92
- IF (COL(JE).NE.')') GO TO 92
- JFMTC1 = JA
- JFMTC2 = JE
- GO TO 24
-
-C-- option -Ii or -If ... or -I(text), I/O characteristic
-
- 34 JOPT = INDEX ('(BIFD', COL(JA))
-C- 12345
- IF (JOPT.EQ.0) GO TO 92
- IF (JOPT.NE.1) THEN
- IF (NN.NE.1) GO TO 92
- NAME(5) = JOPT - 1
- GO TO 24
- ENDIF
-
- JE = ICFIND (')', LINE,JA,NCHLN)
- IF (NGSLAT.EQ.0) GO TO 92
-
- CALL MZIOBK (NAME,20, LINE(JA+1:JE-1))
- GO TO 24
-
-C-- option -S[n], true size of the bank
-
- 36 IFLSIZ = 1
- IF (NN.EQ.0) GO TO 24
- GO TO 39
-
-C-- option -E[n], exact number of data words
-
- 37 IFLEXA = 1
- IF (NN.EQ.0) GO TO 24
-
-C-- option -Nn, bank size
-
- 39 N = ICDECI (LINE,JA,JE)
- IF (NGSLAT.NE.0) GO TO 92
- IF (N.LE.0) GO TO 92
- IF (NAME(4).NE.0) THEN
- IF (NAME(4).NE.N) GO TO 94
- ENDIF
- NAME(4) = N
- GO TO 24
-
-C-- option -U[n], call TZUSER
-
- 41 IFLTZU = 1
- IF (NN.EQ.0) GO TO 24
- IVALUS = ICDECI (LINE,JA,JE)
- IF (NGSLAT.NE.0) GO TO 92
- GO TO 24
-
-C-- option -C[a][/e], column usage
-
- 44 JCOLA = 1
- IF (COL(JA).EQ.'/') GO TO 45
- JCOLA = ICDECI (LINE,JA,JE)
- IF (JCOLA.LE.0) GO TO 92
- IF (JCOLA.GE.LGL-3) GO TO 92
- IF (NGSLAT.EQ.0) GO TO 24
- JA = NESLAT
- IF (COL(JA).NE.'/') GO TO 92
- 45 JCOLE = ICDECI (LINE,JA+1,JE)
- IF (NGSLAT.NE.0) GO TO 92
- JCOLE = MIN (JCOLE,LGL)
- IF (JCOLE.LT.JCOLA+2) GO TO 92
- GO TO 24
-
-C-- option -A[n][C][W]
-
- 47 CALL TZACW (LINE(JA-1:JE))
- IF (NCHPW.GE.0) GO TO 24
- NCHPW = 0
- GO TO 92
-
-C-------- Read data of next title bank --------
-
- 61 IDNUM = MAX (IDNUM,0)
- IF (NAME(4).NE.0) GO TO 63
-
-C-- read the data through the scratch area
-
- IF (JFMTC1.NE.0) GO TO 93
- LPUTA = LQWKFZ
- LPUTE = LPUTA + NQWKTT
- GO TO 66
-
-C-- pre-lift the bank for filling
-
- 63 IFLPRE = 7
- CALL MZLIFT (IXTITL,LOLD,LQT(KQT+1),1,NAME,-1)
- LPUTA = KQS + LOLD + 9
- LPUTE = LPUTA + NAME(4)
- IF (JFMTC1.EQ.0) GO TO 66
-
-C-- Read data en block with Fortran FORMAT
-
- NWOCC = NAME(4)
-#include "zebra/tzread2.inc"
- GO TO 68
-
-C-- Read data in free-field format
-
- 66 CALL TZFREE
- IF (NFAULT.NE.0) THEN
- NFATAL = NFATAL + NFAULT
- IF (IFLPRE.EQ.0) GO TO 77
- LNEW = -1
- GO TO 69
- ENDIF
- NWOCC = LPUTX - LPUTA
-
-C-- lift the bank and copy the data
-
- IF (IFLPRE.EQ.0) THEN
- NAME(4) = NWOCC
- CALL MZLIFT (IXTITL,LOLD,LQT(KQT+1),1,NAME,-1)
- CALL UCOPY (LQ(LPUTA),IQ(KQS+LOLD+1),NAME(4))
- ENDIF
-
-C-- handle 'exact' or 'size'
-
- IF (IFLEXA.NE.0) THEN
- IF (NWOCC.NE.NAME(4)) GO TO 97
- ENDIF
-
- IF (IFLSIZ.EQ.0) GO TO 68
- N = NAME(4) - NWOCC
- IF (N.NE.0) CALL VZERO (IQ(KQS+LOLD+1+NWOCC),N)
- NWOCC = NAME(4)
-
-C-- calling TZUSER
-
- 68 IQ(KQS+LOLD-5) = IDNUM
- IF (IFLTZU+IFLUSE.EQ.0) GO TO 71
- NPARA = IVALUS
-
- LNEW = 0
- CALL TZUSER (LQT(KQT+1))
- IF (LNEW.LT.-1) GO TO 98
- IF (LNEW.EQ.0) GO TO 71
- NWOCC = NAME(4)
- 69 CALL MZDROP (IXTITL, LQT(KQT+1), '.')
- IF (LNEW.EQ.-1) GO TO 77
-
-C-- possibly reduce the bank
-
- 71 N = NAME(4) - NWOCC
- IF (N.GT.0) THEN
- L = LQT(KQT+1)
- CALL MZPUSH (IXTITL,L,0,-N,'I')
- ENDIF
-
- 77 IF (NREADY.GE.0) GO TO 12
-
-C------- Finished
-
- 78 L = LQT(KQT+1)
- CALL ZTOPSY (IXTITL,L)
- IQUEST(1) = NFATAL
- IF (NFATAL.NE.0) THEN
- IF (IFLANY.EQ.0) CALL ZFATAM ('TZINIT fails.')
- ENDIF
-#include "zebra/qtrace99.inc"
- RETURN
-
-C---- Error handling
-
-C-- unheaded data line
- 91 IF (IGNORE.NE.0) GO TO 12
- WRITE (IQLOG,9091) LINE(1:NCHORG)
- 9091 FORMAT (' !!i> ',A)
- IF (IFLKIL.GT.0) NFATAL = NFATAL + 1
- GO TO 12
-
-C-- faulty control line *xxx
- 92 IF (IFLLOG.EQ.0) WRITE (IQLOG,9012) LHEAD(1:NHEAD)
- WRITE (IQLOG,9092) BLANK(1:JA)
- 9092 FORMAT (' !!f ',A,'^-> !!! fault')
- IGNORE = 7
- NFATAL = NFATAL + 1
- GO TO 12
-
-C-- faults with *DO
- 93 IF (IFLLOG.EQ.0) WRITE (IQLOG,9012) LHEAD(1:NHEAD)
- WRITE (IQLOG,9093)
- 9093 FORMAT (' !!f fault : -F(...) requires -Nn')
- IGNORE = 7
- NFATAL = NFATAL + 1
- GO TO 12
-
- 94 IF (IFLLOG.EQ.0) WRITE (IQLOG,9012) LHEAD(1:NHEAD)
- WRITE (IQLOG,9094)
- 9094 FORMAT (' !!f fault : contradictory bank sizes')
- IGNORE = 7
- NFATAL = NFATAL + 1
- GO TO 12
-
-C-- premature EoF
- 96 IF (IFLLOG.EQ.0) WRITE (IQLOG,9012) LHEAD(1:NHEAD)
- WRITE (IQLOG,9096)
- 9096 FORMAT (' !!f fault : premature EoF')
- NFATAL = NFATAL + 1
- GO TO 78
-
-C-- exact fault
- 97 IF (IFLLOG.EQ.0) WRITE (IQLOG,9012) LHEAD(1:NHEAD)
- WRITE (IQLOG,9097) NAME(4),NWOCC
- 9097 FORMAT (' !!f fault : # of words expected / read=',2I6)
- NFATAL = NFATAL + 1
- GO TO 77
-
-C-- user kill
- 98 IF (IFLLOG.EQ.0) WRITE (IQLOG,9012) LHEAD(1:NHEAD)
- WRITE (IQLOG,9098)
- 9098 FORMAT (' !!f fault : kill requested by TZUSER')
- NFATAL = NFATAL + 1
- GO TO 77
- END
diff --git a/src/packlib/zebra/tq/tzinq.F b/src/packlib/zebra/tq/tzinq.F
deleted file mode 100644
index 6ae36dc..0000000
--- a/src/packlib/zebra/tq/tzinq.F
+++ /dev/null
@@ -1,65 +0,0 @@
-*
-* $Id: tzinq.F,v 1.3 1999/06/18 13:31:33 couet Exp $
-*
-* $Log: tzinq.F,v $
-* Revision 1.3 1999/06/18 13:31:33 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.2 1996/04/18 16:14:54 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:27 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE TZINQ (IXSTOR,IXTITL,LTT,IFLAG)
-
-C- Inquire about the title structure in store IXSTOR
-C- return: the index of the title division
-C- the adr of the last (IFLAG=0) or the first bank
-
-#include "zebra/mqsys.inc"
-#include "zebra/eqlqt.inc"
-*
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HTZIN, 4HQ /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HTZINQ /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'TZINQ ')
-#endif
-
-#include "zebra/q_jbyt.inc"
-#include "zebra/q_sbyt.inc"
-
-#include "zebra/qtraceq.inc"
-
-#include "zebra/qstore.inc"
-
- L = LQT(KQT+1)
- IF (L.EQ.0) GO TO 70
-
- JDV = MZFDIV (-7, L)
- IF (JDV.EQ.JQDVSY) JDV = 24
- IXDV = MSBYT (JQSTOR,JDV,27,4)
- IF (IFLAG.NE.0) GO TO 71
-
-C-- go to the end
-
- 24 IF (LQ(KQS+L).EQ.0) GO TO 71
- L = LQ(KQS+L)
- GO TO 24
-
- 70 IXDV = MSBYT (JQSTOR,0,27,4)
- 71 IXTITL = IXDV
- LTT = L
-
-#include "zebra/qtrace99.inc"
- RETURN
- END
diff --git a/src/packlib/zebra/tq/tzshun.F b/src/packlib/zebra/tq/tzshun.F
deleted file mode 100644
index f2fad1e..0000000
--- a/src/packlib/zebra/tq/tzshun.F
+++ /dev/null
@@ -1,62 +0,0 @@
-*
-* $Id: tzshun.F,v 1.3 1999/06/18 13:31:33 couet Exp $
-*
-* $Log: tzshun.F,v $
-* Revision 1.3 1999/06/18 13:31:33 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.2 1996/04/18 16:14:55 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:27 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE TZSHUN (IXSTOR,LBK,IFLAG)
-
-C- Shunt new banks(s) into the title structure
-
-#include "zebra/mqsys.inc"
-#include "zebra/eqlqt.inc"
-*
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HTZSH, 4HUN /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HTZSHUN /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'TZSHUN ')
-#endif
-
-#include "zebra/q_jbyt.inc"
-
-#include "zebra/qtraceq.inc"
-
-#include "zebra/qstore.inc"
-
- L = LQT(KQT+1)
- IF (L.EQ.0) GO TO 31
- IF (IFLAG.NE.0) GO TO 31
-
-C-- go to the end
-
- 24 IF (LQ(KQS+L).NE.0) THEN
- L = LQ(KQS+L)
- GO TO 24
- ENDIF
-
- CALL ZSHUNT (IXSTOR,LBK,L,0,1)
- GO TO 999
-
-C-- connect at the start
-
- 31 CALL ZSHUNT (IXSTOR,LBK,LQT(KQT+1),1,1)
-
-#include "zebra/qtrace99.inc"
- RETURN
- END
diff --git a/src/packlib/zebra/tq/tzuser.F b/src/packlib/zebra/tq/tzuser.F
deleted file mode 100644
index 5a414d2..0000000
--- a/src/packlib/zebra/tq/tzuser.F
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: tzuser.F,v 1.2 1997/03/14 17:22:22 mclareni Exp $
-*
-* $Log: tzuser.F,v $
-* Revision 1.2 1997/03/14 17:22:22 mclareni
-* WNT mods
-*
-* Revision 1.1.1.1.2.1 1997/01/21 11:34:13 mclareni
-* All mods for Winnt 96a on winnt branch
-*
-* Revision 1.1.1.1 1996/03/06 10:47:27 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE TZUSER(IDUMMY)
-
-C-- dummy TZUSER
-
-
- CALL ZFATAM (' dummy TZUSER reached.')
- END
diff --git a/src/packlib/zebra/tq/tzvers.F b/src/packlib/zebra/tq/tzvers.F
deleted file mode 100644
index f6f0ead..0000000
--- a/src/packlib/zebra/tq/tzvers.F
+++ /dev/null
@@ -1,79 +0,0 @@
-*
-* $Id: tzvers.F,v 1.3 1999/06/18 13:31:34 couet Exp $
-*
-* $Log: tzvers.F,v $
-* Revision 1.3 1999/06/18 13:31:34 couet
-* - qcardl.inc was empty: It is now removed and not used.
-* Comment END CDE removed.
-*
-* Revision 1.2 1996/04/18 16:14:56 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:47:28 mclareni
-* Zebra
-*
-*
-#include "zebra/pilot.h"
- SUBROUTINE TZVERS (IXSTOR,LBK,CHIDH,IDNP,ISELP,IFLAG)
-
-C- Find title bank with IDH (and IDN if non-zero)
-C- and a validity range spanning ISELP
-
-#include "zebra/mqsys.inc"
-#include "zebra/eqlqt.inc"
-*
- INTEGER CHIDH(9), IDNP(9), ISELP(9)
-#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
- DIMENSION NAMESR(2)
- DATA NAMESR / 4HTZVE, 4HRS /
-#endif
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- DATA NAMESR / 6HTZVERS /
-#endif
-#if !defined(CERNLIB_QTRHOLL)
- CHARACTER NAMESR*8
- PARAMETER (NAMESR = 'TZVERS ')
-#endif
-
-#include "zebra/q_jbyt.inc"
-
-#include "zebra/qstore.inc"
-
- ISEL = ISELP(1)
- IDN = IDNP(1)
- CALL UCTOH (CHIDH,IDH,4,4)
-
- L = LQT(KQT+1)
- GO TO 12
-
- 11 L = LQ(KQS+L)
- 12 IF (L.EQ.0) GO TO 21
- IF (IQ(KQS+L-4).NE.IDH) GO TO 11
-
- IF (IDN.NE.0) THEN
- IF (IDN.NE.IQ(KQS+L-5)) GO TO 11
- ENDIF
-
- IF (ISEL.LT.IQ(KQS+L+1)) GO TO 11
- IF (ISEL.GT.IQ(KQS+L+2)) GO TO 11
-
- LBK = L
- RETURN
-
-C-- bank not found
-
- 21 IF (IFLAG.EQ.0) THEN
- LBK = 0
- RETURN
- ENDIF
-
-#include "zebra/qtrace.inc"
-
- IQUEST(2)= IDH
- IQUEST(3)= IDN
- IQUEST(4)= ISEL
- IQUEST(5)= LQT(KQT+1)
- K = IFLAG
- IF (K.LT.100) K=62
- CALL ZTELL (K,1)
- END
diff --git a/src/packlib/zebra/zebra/Imakefile b/src/packlib/zebra/zebra/Imakefile
deleted file mode 100644
index 6c68260..0000000
--- a/src/packlib/zebra/zebra/Imakefile
+++ /dev/null
@@ -1,23 +0,0 @@
-INCLUDES= bankparq.inc bkfoparq.inc bknmparq.inc cqbkc.inc \ @@\
- debugvf1.inc debugvf2.inc divparq.inc dzc1.inc eqlqf.inc \ @@\
- eqlqform.inc eqlqmrf.inc eqlqmst.inc eqlqr.inc eqlqrrf.inc \ @@\
- eqlqt.inc eqlqzep.inc fzcf.inc fzci.inc fzcocc.inc fzcseg.inc \ @@\
- fzcx.inc fzstat.inc hzc.inc jzc.inc jztimed.inc jztimin.inc \ @@\
- jztimout.inc jzuc.inc mqsys.inc mqsysh.inc mzbits.inc mzca.inc \ @@\
- mzcb.inc mzcc.inc mzcl.inc mzcn.inc mzct.inc mzcwk.inc \ @@\
- mzioc.inc q.inc q_and.inc q_andor.inc q_jbit.inc q_jbyt.inc \ @@\
- q_jbytet.inc q_jbytor.inc q_locf.inc q_mbytet.inc q_mbytor.inc \ @@\
- q_not.inc q_or.inc q_sbit.inc q_sbit0.inc q_sbit1.inc \ @@\
- q_sbyt.inc q_shift.inc q_shiftl.inc q_shiftr.inc q_xor.inc \ @@\
- qcardl.inc qequ.inc qstore.inc qstorjz.inc qtoabend.inc \ @@\
- qtofatal.inc qtrace.inc qtrace99.inc qtraceq.inc quest.inc \ @@\
- questparq.inc qversion.inc rzbmap.inc rzbuff.inc rzch.inc \ @@\
- rzckey.inc rzcl.inc rzclun.inc rzclxx.inc rzcount.inc \ @@\
- rzcout.inc rzcstr.inc rzcycle.inc rzdir.inc rzk.inc rzover.inc \ @@\
- storparq.inc tzc1.inc tzread1.inc tzread2.inc tzuc.inc \ @@\
- zbcd.inc zbcdch.inc zbcdk.inc zceta.inc zebq.inc zfatalch.inc \ @@\
- zfatalre.inc zheadp.inc zkrakc.inc zkrakcc.inc zkrakqu.inc \ @@\
- zlimit.inc zmach.inc zmachfix.inc znatur.inc zstate.inc \ @@\
- zunit.inc zvfaut.inc zvfwkc.inc pilot.h
-
-InstallIncludes($(INCLUDES),$(CERN_INCLUDEDIR),zebra)
diff --git a/src/packlib/zebra/zebra/bankparq.inc b/src/packlib/zebra/zebra/bankparq.inc
deleted file mode 100644
index 1c436ca..0000000
--- a/src/packlib/zebra/zebra/bankparq.inc
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: bankparq.inc,v 1.1.1.1 1996/03/06 10:46:56 mclareni Exp $
-*
-* $Log: bankparq.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:46:56 mclareni
-* Zebra
-*
-*
-#ifndef CERNLIB_ZEBRA_BANKPARQ_INC
-#define CERNLIB_ZEBRA_BANKPARQ_INC
-*
-* BANK PARAMETERS
-*
-* bankparq.inc
-*
- PARAMETER(NBKHDQ=1,NBKCTQ=9,NBKOHQ=NBKHDQ+NBKCTQ,NBKJMQ=12)
- PARAMETER(MBKLNQ=0,JBKSKQ=1,NBKSKQ=16)
- PARAMETER(MBKIOQ=MBKLNQ,JBKIOQ=NBKSKQ+1,NBKIOQ=16)
- PARAMETER(JBKUSQ=1,NBKUSQ=18,JBKSYQ=NBKUSQ+1,NBKSYQ=32-NBKUSQ)
-
-#endif
diff --git a/src/packlib/zebra/zebra/bkfoparq.inc b/src/packlib/zebra/zebra/bkfoparq.inc
deleted file mode 100644
index 7a0b521..0000000
--- a/src/packlib/zebra/zebra/bkfoparq.inc
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: bkfoparq.inc,v 1.1.1.1 1996/03/06 10:46:56 mclareni Exp $
-*
-* $Log: bkfoparq.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:46:56 mclareni
-* Zebra
-*
-*
-#ifndef CERNLIB_ZEBRA_BKFOPARQ_INC
-#define CERNLIB_ZEBRA_BKFOPARQ_INC
-*
-* BANK FORMAT PARAMETERS (IO CHARACERISTIC)
-*
-* bkfoparq.inc
-*
- PARAMETER(IFOUNQ=0,IFOBIQ=1,IFOINQ=2,IFOFLQ=3,IFODOQ=4)
- PARAMETER(IFOHOQ=5,IFOSEQ=7,IFONAQ=9,IFOLIQ=11,JFOSEQ=16)
-
-#endif
diff --git a/src/packlib/zebra/zebra/bknmparq.inc b/src/packlib/zebra/zebra/bknmparq.inc
deleted file mode 100644
index 9e638a7..0000000
--- a/src/packlib/zebra/zebra/bknmparq.inc
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: bknmparq.inc,v 1.1.1.1 1996/03/06 10:46:56 mclareni Exp $
-*
-* $Log: bknmparq.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:46:56 mclareni
-* Zebra
-*
-*
-#ifndef CERNLIB_ZEBRA_BKNMPARQ_INC
-#define CERNLIB_ZEBRA_BKNMPARQ_INC
-*
-* BANK NAME PARAMETERS (MZLIFT)
-*
-* bknmparq.inc
-*
- PARAMETER(NNMBKQ=5,MNMIDQ=1,MNMNLQ=MNMIDQ+1)
- PARAMETER(MNMNSQ=MNMNLQ+1,MNMNDQ=MNMNSQ+1,MNMIOQ=MNMNDQ+1)
-
-#endif
diff --git a/src/packlib/zebra/zebra/cqbkc.inc b/src/packlib/zebra/zebra/cqbkc.inc
deleted file mode 100644
index a2678f0..0000000
--- a/src/packlib/zebra/zebra/cqbkc.inc
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: cqbkc.inc,v 1.1.1.1 1996/03/06 10:46:55 mclareni Exp $
-*
-* $Log: cqbkc.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:46:55 mclareni
-* Zebra
-*
-*
-#ifndef CERNLIB_ZEBRA_CQBKC_INC
-#define CERNLIB_ZEBRA_CQBKC_INC
-*
-*
-* cqbkc.inc
-*
- COMMON /CQBKC/ MMBANK(9), MMBKD(9), IDVV(21)
-* ------------- for memory ------------------------------
-
-#endif
diff --git a/src/packlib/zebra/zebra/debugvf1.inc b/src/packlib/zebra/zebra/debugvf1.inc
deleted file mode 100644
index e6be1ef..0000000
--- a/src/packlib/zebra/zebra/debugvf1.inc
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: debugvf1.inc,v 1.1.1.1 1996/03/06 10:46:56 mclareni Exp $
-*
-* $Log: debugvf1.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:46:56 mclareni
-* Zebra
-*
-*
-#ifndef CERNLIB_ZEBRA_DEBUGVF1_INC
-#define CERNLIB_ZEBRA_DEBUGVF1_INC
-*
-* VFORT (Put just in front of SUBROUTINE st.)
-*
-* debugvf1.inc
-*
-#if defined(CERNLIB_QMIBM)
- DEBUG TRACE,SUBTRACE,INIT
- AT 1001
- TRACE ON
- END DEBUG
-#endif
-
-#endif
diff --git a/src/packlib/zebra/zebra/debugvf2.inc b/src/packlib/zebra/zebra/debugvf2.inc
deleted file mode 100644
index 258a104..0000000
--- a/src/packlib/zebra/zebra/debugvf2.inc
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: debugvf2.inc,v 1.1.1.1 1996/03/06 10:46:57 mclareni Exp $
-*
-* $Log: debugvf2.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:46:57 mclareni
-* Zebra
-*
-*
-#ifndef CERNLIB_ZEBRA_DEBUGVF2_INC
-#define CERNLIB_ZEBRA_DEBUGVF2_INC
-*
-* VFORT (Put as first executable statement)
-*
-* debugvf2.inc
-*
-#if defined(CERNLIB_QMIBM)
- 1001 CONTINUE
-#endif
-
-#endif
diff --git a/src/packlib/zebra/zebra/divparq.inc b/src/packlib/zebra/zebra/divparq.inc
deleted file mode 100644
index 59d6240..0000000
--- a/src/packlib/zebra/zebra/divparq.inc
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: divparq.inc,v 1.1.1.1 1996/03/06 10:46:57 mclareni Exp $
-*
-* $Log: divparq.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:46:57 mclareni
-* Zebra
-*
-*
-#ifndef CERNLIB_ZEBRA_DIVPARQ_INC
-#define CERNLIB_ZEBRA_DIVPARQ_INC
-*
-*DIVISION PARAMETERS
-*
-* divparq.inc
-*
- PARAMETER(JDVBFQ=1,NDVBFQ=1,IDVFWQ=0,IDVBWQ=1)
- PARAMETER(IDVUSQ=1,IDVLGQ=2,IDVPAQ=3,IDVSYQ=4)
- PARAMETER(JDVIDQ=1,NDVIDQ=20)
- PARAMETER(JDVUSQ=21,JDVLGQ=22,JDVPAQ=23,JDVSYQ=24)
- PARAMETER(MDVLWQ=1,MDVHGQ=2)
-
-#endif
diff --git a/src/packlib/zebra/zebra/dzc1.inc b/src/packlib/zebra/zebra/dzc1.inc
deleted file mode 100644
index 5847475..0000000
--- a/src/packlib/zebra/zebra/dzc1.inc
+++ /dev/null
@@ -1,35 +0,0 @@
-*
-* $Id: dzc1.inc,v 1.1.1.1 1996/03/06 10:46:57 mclareni Exp $
-*
-* $Log: dzc1.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:46:57 mclareni
-* Zebra
-*
-*
-#ifndef CERNLIB_ZEBRA_DZC1_INC
-#define CERNLIB_ZEBRA_DZC1_INC
-*
-*
-* dzc1.inc
-*
- PARAMETER(NOFMTQ=0)
- PARAMETER(MSYSFQ=5,MSYSDQ=7,MSYSKQ=8,MSYSPQ=9)
-
- COMMON /DZC1/ IFLOPT(26),
- + JDROP,LN,LS,LX,IO,NL,NS,ND,
- + IBASE,LBASE,NDW,JDFD,JD,JTYP
-
- PARAMETER (NSTMXQ=16,NDVMXQ=20,LNULL=0,NOFLIQ=8,NCHEKQ=-7)
-
- PARAMETER (MCQSIQ=8,MCQLSQ=2,MCQLGQ=15,MCQLTQ=19,MCQLIQ=87)
- CHARACTER CQSTAK*13,CQINFO*40
- PARAMETER (NLICHQ=130,NSTCHQ=8,NDVCHQ=8,NBKCHQ=4 )
- CHARACTER CQLINE*(NLICHQ),CQMAP(10)*(NLICHQ)
- CHARACTER CQSTOR*(NSTCHQ),CQDIV*(NDVCHQ),CQID*(NBKCHQ)
- COMMON /DZC1CH/ CQSTOR,CQDIV,CQID,CQMAP,CQSTAK,CQINFO
- EQUIVALENCE (CQLINE,CQMAP)
-
- CHARACTER CDUMMQ*(*)
- PARAMETER ( CDUMMQ = ' ' )
-
-#endif
diff --git a/src/packlib/zebra/zebra/eqlqf.inc b/src/packlib/zebra/zebra/eqlqf.inc
deleted file mode 100644
index 5ac11a1..0000000
--- a/src/packlib/zebra/zebra/eqlqf.inc
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: eqlqf.inc,v 1.1.1.1 1996/03/06 10:46:53 mclareni Exp $
-*
-* $Log: eqlqf.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:46:53 mclareni
-* Zebra
-*
-*
-#ifndef CERNLIB_ZEBRA_EQLQF_INC
-#define CERNLIB_ZEBRA_EQLQF_INC
-*
-* FZ - 1 structural, 3 reference links
-*
-* eqlqf.inc
-*
- EQUIVALENCE (LQFS,LQSYSS(4)), (LQFF,LQSYSR(4))
- +, (LQFI,LQSYSR(5)), (LQFX,LQSYSR(6))
-
-#endif
diff --git a/src/packlib/zebra/zebra/eqlqform.inc b/src/packlib/zebra/zebra/eqlqform.inc
deleted file mode 100644
index 7f7308b..0000000
--- a/src/packlib/zebra/zebra/eqlqform.inc
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: eqlqform.inc,v 1.1.1.1 1996/03/06 10:46:53 mclareni Exp $
-*
-* $Log: eqlqform.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:46:53 mclareni
-* Zebra
-*
-*
-#ifndef CERNLIB_ZEBRA_EQLQFORM_INC
-#define CERNLIB_ZEBRA_EQLQFORM_INC
-*
-* MZFORM - 1 structural link
-*
-* eqlqform.inc
-*
- EQUIVALENCE (LQFORM,LQSYSS(5))
-
-#endif
diff --git a/src/packlib/zebra/zebra/eqlqmrf.inc b/src/packlib/zebra/zebra/eqlqmrf.inc
deleted file mode 100644
index 4547d75..0000000
--- a/src/packlib/zebra/zebra/eqlqmrf.inc
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: eqlqmrf.inc,v 1.1.1.1 1996/03/06 10:46:53 mclareni Exp $
-*
-* $Log: eqlqmrf.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:46:53 mclareni
-* Zebra
-*
-*
-#ifndef CERNLIB_ZEBRA_EQLQMRF_INC
-#define CERNLIB_ZEBRA_EQLQMRF_INC
-*
-* MZ - 2 reference links
-*
-* eqlqmrf.inc
-*
-C Links LQSYSR(1) and LQSYSR(2) are working links of MZ
-
-#endif
diff --git a/src/packlib/zebra/zebra/eqlqmst.inc b/src/packlib/zebra/zebra/eqlqmst.inc
deleted file mode 100644
index 06c28d5..0000000
--- a/src/packlib/zebra/zebra/eqlqmst.inc
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: eqlqmst.inc,v 1.1.1.1 1996/03/06 10:46:53 mclareni Exp $
-*
-* $Log: eqlqmst.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:46:53 mclareni
-* Zebra
-*
-*
-#ifndef CERNLIB_ZEBRA_EQLQMST_INC
-#define CERNLIB_ZEBRA_EQLQMST_INC
-*
-* MZ - 1 structural link (only)
-*
-* eqlqmst.inc
-*
- DIMENSION LQMST(9)
- EQUIVALENCE (LQMST(1),LQSYSS(2))
-
-#endif
diff --git a/src/packlib/zebra/zebra/eqlqr.inc b/src/packlib/zebra/zebra/eqlqr.inc
deleted file mode 100644
index 5afc334..0000000
--- a/src/packlib/zebra/zebra/eqlqr.inc
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: eqlqr.inc,v 1.1.1.1 1996/03/06 10:46:53 mclareni Exp $
-*
-* $Log: eqlqr.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:46:53 mclareni
-* Zebra
-*
-*
-#ifndef CERNLIB_ZEBRA_EQLQR_INC
-#define CERNLIB_ZEBRA_EQLQR_INC
-*
-* RZ - 1 structural link
-*
-* eqlqr.inc
-*
- EQUIVALENCE (LQRS,LQSYSS(7))
-
-#endif
diff --git a/src/packlib/zebra/zebra/eqlqrrf.inc b/src/packlib/zebra/zebra/eqlqrrf.inc
deleted file mode 100644
index 4bc37e0..0000000
--- a/src/packlib/zebra/zebra/eqlqrrf.inc
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: eqlqrrf.inc,v 1.1.1.1 1996/03/06 10:46:53 mclareni Exp $
-*
-* $Log: eqlqrrf.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:46:53 mclareni
-* Zebra
-*
-*
-#ifndef CERNLIB_ZEBRA_EQLQRRF_INC
-#define CERNLIB_ZEBRA_EQLQRRF_INC
-*
-* RZ - 1 reference link (only)
-*
-* eqlqrrf.inc
-*
- DIMENSION LQRRF(9)
- EQUIVALENCE (LQRRF(1),LQSYSR(7))
-
-#endif
diff --git a/src/packlib/zebra/zebra/eqlqt.inc b/src/packlib/zebra/zebra/eqlqt.inc
deleted file mode 100644
index d859d15..0000000
--- a/src/packlib/zebra/zebra/eqlqt.inc
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: eqlqt.inc,v 1.1.1.1 1996/03/06 10:46:53 mclareni Exp $
-*
-* $Log: eqlqt.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:46:53 mclareni
-* Zebra
-*
-*
-#ifndef CERNLIB_ZEBRA_EQLQT_INC
-#define CERNLIB_ZEBRA_EQLQT_INC
-*
-* TZ - 1 structural link (only)
-*
-* eqlqt.inc
-*
- DIMENSION LQT(9)
- EQUIVALENCE (LQT(1),LQSYSS(3))
-
-#endif
diff --git a/src/packlib/zebra/zebra/eqlqzep.inc b/src/packlib/zebra/zebra/eqlqzep.inc
deleted file mode 100644
index 6ed8733..0000000
--- a/src/packlib/zebra/zebra/eqlqzep.inc
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: eqlqzep.inc,v 1.1.1.1 1996/03/06 10:46:53 mclareni Exp $
-*
-* $Log: eqlqzep.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:46:53 mclareni
-* Zebra
-*
-*
-#ifndef CERNLIB_ZEBRA_EQLQZEP_INC
-#define CERNLIB_ZEBRA_EQLQZEP_INC
-*
-*
-* eqlqzep.inc
-*
- EQUIVALENCE (LQZEP,LQSYSS(10))
-
-#endif
diff --git a/src/packlib/zebra/zebra/fzcf.inc b/src/packlib/zebra/zebra/fzcf.inc
deleted file mode 100644
index 429d805..0000000
--- a/src/packlib/zebra/zebra/fzcf.inc
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: fzcf.inc,v 1.1.1.1 1996/03/06 10:46:54 mclareni Exp $
-*
-* $Log: fzcf.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:46:54 mclareni
-* Zebra
-*
-*
-#ifndef CERNLIB_ZEBRA_FZCF_INC
-#define CERNLIB_ZEBRA_FZCF_INC
-*
-*
-* fzcf.inc
-*
- COMMON /FZCF/ LUNF, MSTATF,MEDIUF,IFIFOF,IDAFOF,IACMOF,IUPAKF
- +, IADOPF,IACTVF,INCBPF,LOGLVF,MAXREF, IOPTVF(24)
-
-#endif
diff --git a/src/packlib/zebra/zebra/fzci.inc b/src/packlib/zebra/zebra/fzci.inc
deleted file mode 100644
index 726945b..0000000
--- a/src/packlib/zebra/zebra/fzci.inc
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: fzci.inc,v 1.1.1.1 1996/03/06 10:46:54 mclareni Exp $
-*
-* $Log: fzci.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:46:54 mclareni
-* Zebra
-*
-*
-#ifndef CERNLIB_ZEBRA_FZCI_INC
-#define CERNLIB_ZEBRA_FZCI_INC
-*
-*
-* fzci.inc
-*
- COMMON /FZCI/ LUNI,LUNNI,IXDIVI,LTEMPI,IEVFLI
- +, MSTATI,MEDIUI,IFIFOI,IDAFOI,IACMOI,IUPAKI
- +, IADOPI,IACTVI,INCBPI,LOGLVI,MAXREI, ISTENI
- +, LBPARI, L4STOI,L4STAI,L4CURI,L4ENDI
- +, IFLAGI,NFASTI,N4SKII,N4RESI,N4DONI,N4ENDI
- +, IOPTIE,IOPTIR,IOPTIS,IOPTIA,IOPTIT,IOPTID
- +, IOPTIF,IOPTIG,IOPTIH,IOPTI2(4)
- +, IDI(2),IPILI(4),NWTXI,NWSEGI,NWTABI,NWBKI,LENTRI
- +, NWUHCI,IOCHI(16),NWUMXI,NWUHI,NWIOI
- +, NWRDAI,NRECAI,LUHEAI,JRETCD,JERROR,NWERR
- PARAMETER (JAUIOC=50, JAUSEG=68, JAUEAR=130)
-
-#endif
diff --git a/src/packlib/zebra/zebra/fzcocc.inc b/src/packlib/zebra/zebra/fzcocc.inc
deleted file mode 100644
index 4289f34..0000000
--- a/src/packlib/zebra/zebra/fzcocc.inc
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: fzcocc.inc,v 1.1.1.1 1996/03/06 10:46:54 mclareni Exp $
-*
-* $Log: fzcocc.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:46:54 mclareni
-* Zebra
-*
-*
-#ifndef CERNLIB_ZEBRA_FZCOCC_INC
-#define CERNLIB_ZEBRA_FZCOCC_INC
-*
-*
-* fzcocc.inc
-*
- COMMON /FZCOCC/NQOCC,IQOCDV(20),IQOCSP(20)
-* ------------- for ZEBRA JZ91 ------------------------------
-
-#endif
diff --git a/src/packlib/zebra/zebra/fzcseg.inc b/src/packlib/zebra/zebra/fzcseg.inc
deleted file mode 100644
index 984df72..0000000
--- a/src/packlib/zebra/zebra/fzcseg.inc
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: fzcseg.inc,v 1.1.1.1 1996/03/06 10:46:54 mclareni Exp $
-*
-* $Log: fzcseg.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:46:54 mclareni
-* Zebra
-*
-*
-#ifndef CERNLIB_ZEBRA_FZCSEG_INC
-#define CERNLIB_ZEBRA_FZCSEG_INC
-*
-*
-* fzcseg.inc
-*
- COMMON /FZCSEG/NQSEG,IQSEGH(2,20),IQSEGD(20),IQSGLU,IQSGWK
-
-#endif
diff --git a/src/packlib/zebra/zebra/fzcx.inc b/src/packlib/zebra/zebra/fzcx.inc
deleted file mode 100644
index b22f47f..0000000
--- a/src/packlib/zebra/zebra/fzcx.inc
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: fzcx.inc,v 1.1.1.1 1996/03/06 10:46:54 mclareni Exp $
-*
-* $Log: fzcx.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:46:54 mclareni
-* Zebra
-*
-*
-#ifndef CERNLIB_ZEBRA_FZCX_INC
-#define CERNLIB_ZEBRA_FZCX_INC
-*
-*
-* fzcx.inc
-*
- COMMON /FZCX/ LUNX,LUNNX,IXDIVX,LTEMPX,IEVFLX
- +, MSTATX,MEDIUX,IFIFOX,IDAFOX,IACMOX,IUPAKX
- +, IADOPX,IACTVX,INCBPX,LOGLVX,MAXREX
- +, NWFILX,ISTENX,LTEXTX,ICOPYX
- +, LBPARX,L4STOX,L4STAX,L4CURX,L4ENDX
- +, MODTBX,JFLGAX,IOPTXD,IOPTXI,IOPTXS,IOPTXZ,IOPTXM
- +, IOPTXL,IOPTXN,IOPTXP,IOPTXF,IOPTXT,IOPTXV(2)
- +, IDX(2),IPILX(4),NWTXX,NWSEGX,NWTABX,NWBKX,LENTRX
- +, NWUHCX,IOCHX(16),NWUHX,NWIOX,LUHEAX,JRUNX
-
-#endif
diff --git a/src/packlib/zebra/zebra/fzstat.inc b/src/packlib/zebra/zebra/fzstat.inc
deleted file mode 100644
index b0e32fc..0000000
--- a/src/packlib/zebra/zebra/fzstat.inc
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: fzstat.inc,v 1.1.1.1 1996/03/06 10:46:54 mclareni Exp $
-*
-* $Log: fzstat.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:46:54 mclareni
-* Zebra
-*
-*
-#ifndef CERNLIB_ZEBRA_FZSTAT_INC
-#define CERNLIB_ZEBRA_FZSTAT_INC
-*
-*
-* fzstat.inc
-*
- COMMON /FZSTAT/INFLUN, INFSTA, INFOFZ(40)
-
-#endif
diff --git a/src/packlib/zebra/zebra/hzc.inc b/src/packlib/zebra/zebra/hzc.inc
deleted file mode 100644
index 82ddfcb..0000000
--- a/src/packlib/zebra/zebra/hzc.inc
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: hzc.inc,v 1.1.1.1 1996/03/06 10:46:55 mclareni Exp $
-*
-* $Log: hzc.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:46:55 mclareni
-* Zebra
-*
-*
-#ifndef CERNLIB_ZEBRA_HZC_INC
-#define CERNLIB_ZEBRA_HZC_INC
-*
-* HISTOGRAM MANIPULATION
-*
-* hzc.inc
-*
-#if !defined(CERNLIB_QCDE)
- COMMON /HZC/ NQHNH,NQHPAK(3),NQHGW,NQHNX,QHDX,QHXL,QHSTEP,NQHAND
- +, LQHH,LQHE,LQHC,LQHL,LQHLB,LQHLC,LQHD,LQHX,LQHT,LQHW
- +, IQHCUT,IQHXXX,IQHINT,NQHLAB,IQHFMT,IQHW(8)
- +, QHSMA,QHBIG,QHTOT,NQHNX2
- +, LQHCUT,NQHEXP,IQHOPT(7)
-* ------------- for defaults ------------------------------
-#endif
-
-#endif
diff --git a/src/packlib/zebra/zebra/jzc.inc b/src/packlib/zebra/zebra/jzc.inc
deleted file mode 100644
index f2633ea..0000000
--- a/src/packlib/zebra/zebra/jzc.inc
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: jzc.inc,v 1.1.1.1 1996/03/06 10:46:55 mclareni Exp $
-*
-* $Log: jzc.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:46:55 mclareni
-* Zebra
-*
-*
-#ifndef CERNLIB_ZEBRA_JZC_INC
-#define CERNLIB_ZEBRA_JZC_INC
-*
-*
-* jzc.inc
-*
- PARAMETER (JQMFLW=10)
- COMMON /JZC/ JQTIME,JQMLEV,JQCBNL,JQCBND,JQNACC,JQEALL,JQREOD
- +, NQME(6), JQSTJZ,IXSTJZ,IXDVJZ,JQLLEV
- +, IAMID,IAFLDW,IANAN,IANCR,IANLSV,IANDSV,IANFL
-
-#endif
diff --git a/src/packlib/zebra/zebra/jztimed.inc b/src/packlib/zebra/zebra/jztimed.inc
deleted file mode 100644
index b4be970..0000000
--- a/src/packlib/zebra/zebra/jztimed.inc
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: jztimed.inc,v 1.1.1.1 1996/03/06 10:46:55 mclareni Exp $
-*
-* $Log: jztimed.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:46:55 mclareni
-* Zebra
-*
-*
-#ifndef CERNLIB_ZEBRA_JZTIMED_INC
-#define CERNLIB_ZEBRA_JZTIMED_INC
-*
-*
-* jztimed.inc
-*
-#if defined(CERNLIB_JZTIME)
- IF (JQTIME.NE.0) CALL TIMED (DELTAT)
-#endif
-
-#endif
diff --git a/src/packlib/zebra/zebra/jztimin.inc b/src/packlib/zebra/zebra/jztimin.inc
deleted file mode 100644
index 0165c82..0000000
--- a/src/packlib/zebra/zebra/jztimin.inc
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: jztimin.inc,v 1.1.1.1 1996/03/06 10:46:55 mclareni Exp $
-*
-* $Log: jztimin.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:46:55 mclareni
-* Zebra
-*
-*
-#ifndef CERNLIB_ZEBRA_JZTIMIN_INC
-#define CERNLIB_ZEBRA_JZTIMIN_INC
-*
-*
-* jztimin.inc
-*
-#if defined(CERNLIB_JZTIME)
- IF (JQTIME.NE.0) THEN
- CALL TIMED (DELTAT)
- Q(KQS+LQSV+5) = Q(KQS+LQSV+5) + DELTAT
- ENDIF
-#endif
-
-#endif
diff --git a/src/packlib/zebra/zebra/jztimout.inc b/src/packlib/zebra/zebra/jztimout.inc
deleted file mode 100644
index 17f81af..0000000
--- a/src/packlib/zebra/zebra/jztimout.inc
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: jztimout.inc,v 1.1.1.1 1996/03/06 10:46:55 mclareni Exp $
-*
-* $Log: jztimout.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:46:55 mclareni
-* Zebra
-*
-*
-#ifndef CERNLIB_ZEBRA_JZTIMOUT_INC
-#define CERNLIB_ZEBRA_JZTIMOUT_INC
-*
-*
-* jztimout.inc
-*
-#if defined(CERNLIB_JZTIME)
- IF (JQTIME.NE.0) THEN
- IF (LQSV.NE.0) THEN
- CALL TIMED (DELTAT)
- Q(KQS+LQSV+5) = Q(KQS+LQSV+5) + DELTAT
- Q(KQS+LQSV+6) = MAX (Q(KQS+LQSV+6),Q(KQS+LQSV+5))
- Q(KQS+LQSV+8) = Q(KQS+LQSV+8) + Q(KQS+LQSV+5)
- Q(KQS+LQSV+5) = 0.
- IF (32*Q(KQS+LQSV+8) .GT. Q(KQS+LQSV+7)) THEN
- Q(KQS+LQSV+7) = Q(KQS+LQSV+7) + Q(KQS+LQSV+8)
- Q(KQS+LQSV+8) = 0.
- ENDIF
- ENDIF
- ENDIF
-#endif
-
-#endif
diff --git a/src/packlib/zebra/zebra/jzuc.inc b/src/packlib/zebra/zebra/jzuc.inc
deleted file mode 100644
index 5a76c27..0000000
--- a/src/packlib/zebra/zebra/jzuc.inc
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: jzuc.inc,v 1.1.1.1 1996/03/06 10:46:54 mclareni Exp $
-*
-* $Log: jzuc.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:46:54 mclareni
-* Zebra
-*
-*
-#ifndef CERNLIB_ZEBRA_JZUC_INC
-#define CERNLIB_ZEBRA_JZUC_INC
-*
-*
-* jzuc.inc
-*
- COMMON /JZUC/ LQJZ,LQUP,LQDW,LQSV,LQAN, JQLEV,JQFLAG(10)
-* ------------- for ZEBRA RZ ------------------------------
-
-#endif
diff --git a/src/packlib/zebra/zebra/mqsys.inc b/src/packlib/zebra/zebra/mqsys.inc
deleted file mode 100644
index f5a159a..0000000
--- a/src/packlib/zebra/zebra/mqsys.inc
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: mqsys.inc,v 1.1.1.1 1996/03/06 10:46:54 mclareni Exp $
-*
-* $Log: mqsys.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:46:54 mclareni
-* Zebra
-*
-*
-#ifndef CERNLIB_ZEBRA_MQSYS_INC
-#define CERNLIB_ZEBRA_MQSYS_INC
-*
-*
-* mqsys.inc
-*
-#include "zebra/mzbits.inc"
-#include "zebra/quest.inc"
-#include "zebra/zebq.inc"
-#include "zebra/mzca.inc"
-#include "zebra/mzcb.inc"
-#include "zebra/mzcc.inc"
-
-#endif
diff --git a/src/packlib/zebra/zebra/mqsysh.inc b/src/packlib/zebra/zebra/mqsysh.inc
deleted file mode 100644
index 9743860..0000000
--- a/src/packlib/zebra/zebra/mqsysh.inc
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: mqsysh.inc,v 1.1.1.1 1996/03/06 10:46:54 mclareni Exp $
-*
-* $Log: mqsysh.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:46:54 mclareni
-* Zebra
-*
-*
-#ifndef CERNLIB_ZEBRA_MQSYSH_INC
-#define CERNLIB_ZEBRA_MQSYSH_INC
-*
-*
-* mqsysh.inc
-*
-#include "zebra/mzbits.inc"
-#include "zebra/quest.inc"
-#include "zebra/zebq.inc"
-#include "zebra/mzca.inc"
-#include "zebra/mzcb.inc"
-
-#endif
diff --git a/src/packlib/zebra/zebra/mzbits.inc b/src/packlib/zebra/zebra/mzbits.inc
deleted file mode 100644
index d877c2b..0000000
--- a/src/packlib/zebra/zebra/mzbits.inc
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: mzbits.inc,v 1.1.1.1 1996/03/06 10:46:53 mclareni Exp $
-*
-* $Log: mzbits.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:46:53 mclareni
-* Zebra
-*
-*
-#ifndef CERNLIB_ZEBRA_MZBITS_INC
-#define CERNLIB_ZEBRA_MZBITS_INC
-*
-*
-* mzbits.inc
-*
- PARAMETER (IQDROP=25, IQMARK=26, IQCRIT=27, IQSYSX=28)
-
-#endif
diff --git a/src/packlib/zebra/zebra/mzca.inc b/src/packlib/zebra/zebra/mzca.inc
deleted file mode 100644
index 9a71c3f..0000000
--- a/src/packlib/zebra/zebra/mzca.inc
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: mzca.inc,v 1.1.1.1 1996/03/06 10:46:53 mclareni Exp $
-*
-* $Log: mzca.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:46:53 mclareni
-* Zebra
-*
-*
-#ifndef CERNLIB_ZEBRA_MZCA_INC
-#define CERNLIB_ZEBRA_MZCA_INC
-*
-* Process Master parameters
-*
-* mzca.inc
-*
-#if defined(CERNLIB_QTRHOLL)
- COMMON /MZCA/ NQSTOR,NQOFFT(16),NQOFFS(16),NQALLO(16), NQIAM
- +, LQATAB,LQASTO,LQBTIS, LQWKTB,NQWKTB,LQWKFZ
- +, MQKEYS(3),NQINIT,NQTSYS,NQM99,NQPERM,NQFATA,NQCASE
- +, NQTRAC,MQTRAC(48)
- EQUIVALENCE (KQSP,NQOFFS(1))
-#endif
-* Process Master parameters
-#if !defined(CERNLIB_QTRHOLL)
- COMMON /MZCA/ NQSTOR,NQOFFT(16),NQOFFS(16),NQALLO(16), NQIAM
- +, LQATAB,LQASTO,LQBTIS, LQWKTB,NQWKTB,LQWKFZ
- +, MQKEYS(3),NQINIT,NQTSYS,NQM99,NQPERM
- +, NQFATA,NQCASE,NQTRAC
- EQUIVALENCE (KQSP,NQOFFS(1))
- COMMON /MZCA2/ MQTRAC(44)
- CHARACTER MQTRAC*8
-#endif
-
-#endif
diff --git a/src/packlib/zebra/zebra/mzcb.inc b/src/packlib/zebra/zebra/mzcb.inc
deleted file mode 100644
index dda33bf..0000000
--- a/src/packlib/zebra/zebra/mzcb.inc
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: mzcb.inc,v 1.1.1.1 1996/03/06 10:46:53 mclareni Exp $
-*
-* $Log: mzcb.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:46:53 mclareni
-* Zebra
-*
-*
-#ifndef CERNLIB_ZEBRA_MZCB_INC
-#define CERNLIB_ZEBRA_MZCB_INC
-*
-* Current Store and Division
-*
-* mzcb.inc
-*
- COMMON /MZCB/ JQSTOR,KQT,KQS, JQDIVI,JQDIVR
- +, JQKIND,JQMODE,JQDIVN,JQSHAR,JQSHR1,JQSHR2,NQRESV
- +, LQSTOR,NQFEND,NQSTRU,NQREF,NQLINK,NQMINR,LQ2END
- +, JQDVLL,JQDVSY,NQLOGL,NQSNAM(6)
- DIMENSION IQCUR(16)
- EQUIVALENCE (IQCUR(1),LQSTOR)
-
-#endif
diff --git a/src/packlib/zebra/zebra/mzcc.inc b/src/packlib/zebra/zebra/mzcc.inc
deleted file mode 100644
index 5871342..0000000
--- a/src/packlib/zebra/zebra/mzcc.inc
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: mzcc.inc,v 1.1.1.1 1996/03/06 10:46:53 mclareni Exp $
-*
-* $Log: mzcc.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:46:53 mclareni
-* Zebra
-*
-*
-#ifndef CERNLIB_ZEBRA_MZCC_INC
-#define CERNLIB_ZEBRA_MZCC_INC
-*
-* Store Control Table (matrix)
-*
-* mzcc.inc
-*
- COMMON /MZCC/ LQPSTO,NQPFEN,NQPSTR,NQPREF,NQPLK,NQPMIN,LQP2E
- +, JQPDVL,JQPDVS,NQPLOG,NQPNAM(6)
- +, LQSYSS(10), LQSYSR(10), IQTDUM(22)
- +, LQSTA(21), LQEND(20), NQDMAX(20),IQMODE(20)
- +, IQKIND(20),IQRCU(20), IQRTO(20), IQRNO(20)
- +, NQDINI(20),NQDWIP(20),NQDGAU(20),NQDGAF(20)
- +, NQDPSH(20),NQDRED(20),NQDSIZ(20)
- +, IQDN1(20), IQDN2(20), KQFT, LQFSTA(21)
- DIMENSION IQTABV(16)
- EQUIVALENCE (IQTABV(1),LQPSTO)
-
-#endif
diff --git a/src/packlib/zebra/zebra/mzcl.inc b/src/packlib/zebra/zebra/mzcl.inc
deleted file mode 100644
index 521bf76..0000000
--- a/src/packlib/zebra/zebra/mzcl.inc
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: mzcl.inc,v 1.1.1.1 1996/03/06 10:46:53 mclareni Exp $
-*
-* $Log: mzcl.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:46:53 mclareni
-* Zebra
-*
-*
-#ifndef CERNLIB_ZEBRA_MZCL_INC
-#define CERNLIB_ZEBRA_MZCL_INC
-*
-* Lift Name parameters
-*
-* mzcl.inc
-*
- COMMON /MZCL/ NQLN,NQLS,NQNIO,NQID,NQNL,NQNS,NQND,NQIOCH(16)
- +, LQSUP,NQBIA, NQIOSV(3)
-
-#endif
diff --git a/src/packlib/zebra/zebra/mzcn.inc b/src/packlib/zebra/zebra/mzcn.inc
deleted file mode 100644
index 8924a55..0000000
--- a/src/packlib/zebra/zebra/mzcn.inc
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: mzcn.inc,v 1.1.1.1 1996/03/06 10:46:53 mclareni Exp $
-*
-* $Log: mzcn.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:46:53 mclareni
-* Zebra
-*
-*
-#ifndef CERNLIB_ZEBRA_MZCN_INC
-#define CERNLIB_ZEBRA_MZCN_INC
-*
-* Verify Name parameters
-*
-* mzcn.inc
-*
- COMMON /MZCN/ IQLN,IQLS,IQNIO,IQID,IQNL,IQNS,IQND, IQNX,IQFOUL
-
-#endif
diff --git a/src/packlib/zebra/zebra/mzct.inc b/src/packlib/zebra/zebra/mzct.inc
deleted file mode 100644
index e502832..0000000
--- a/src/packlib/zebra/zebra/mzct.inc
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: mzct.inc,v 1.1.1.1 1996/03/06 10:46:53 mclareni Exp $
-*
-* $Log: mzct.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:46:53 mclareni
-* Zebra
-*
-*
-#ifndef CERNLIB_ZEBRA_MZCT_INC
-#define CERNLIB_ZEBRA_MZCT_INC
-*
-* Memory Table parameters
-*
-* mzct.inc
-*
- COMMON /MZCT/ MQDVGA,MQDVWI,JQSTMV,JQDVM1,JQDVM2,NQDVMV,IQFLIO
- +, MQDVAC,NQNOOP,IQPART,NQFREE, IQTBIT,IQTVAL
- +, IQTNMV,JQGAPM,JQGAPR,NQGAPN,NQGAP,IQGAP(5,4)
- +, LQTA,LQTE, LQRTA,LQTC1,LQTC2,LQRTE
- +, LQMTA,LQMTB,LQMTE,LQMTLU,LQMTBR
- +, LQMTC1,LQMTC2, NQFRTC,NQLIVE
-
-#endif
diff --git a/src/packlib/zebra/zebra/mzcwk.inc b/src/packlib/zebra/zebra/mzcwk.inc
deleted file mode 100644
index e328a8f..0000000
--- a/src/packlib/zebra/zebra/mzcwk.inc
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: mzcwk.inc,v 1.1.1.1 1996/03/06 10:46:53 mclareni Exp $
-*
-* $Log: mzcwk.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:46:53 mclareni
-* Zebra
-*
-*
-#ifndef CERNLIB_ZEBRA_MZCWK_INC
-#define CERNLIB_ZEBRA_MZCWK_INC
-*
-* MQ Working area
-*
-* mzcwk.inc
-*
- PARAMETER (NQWKTT=2560)
- COMMON /MZCWK/ IQWKTB(NQWKTT), IQWKFZ(NQWKTT)
-
-#endif
diff --git a/src/packlib/zebra/zebra/mzioc.inc b/src/packlib/zebra/zebra/mzioc.inc
deleted file mode 100644
index 1c463f5..0000000
--- a/src/packlib/zebra/zebra/mzioc.inc
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: mzioc.inc,v 1.1.1.1 1996/03/06 10:46:53 mclareni Exp $
-*
-* $Log: mzioc.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:46:53 mclareni
-* Zebra
-*
-*
-#ifndef CERNLIB_ZEBRA_MZIOC_INC
-#define CERNLIB_ZEBRA_MZIOC_INC
-*
-*
-* mzioc.inc
-*
- COMMON /MZIOC/ NWFOAV,NWFOTT,NWFODN,NWFORE,IFOCON(3)
- +, MFOSAV(2), JFOEND,JFOREP,JFOCUR,MFO(200)
-
-#endif
diff --git a/src/packlib/zebra/zebra/pilot.h b/src/packlib/zebra/zebra/pilot.h
deleted file mode 100644
index 79dda49..0000000
--- a/src/packlib/zebra/zebra/pilot.h
+++ /dev/null
@@ -1,129 +0,0 @@
-#if defined(CERNLIB_UNIX)
-#define CERNLIB_Z32
-#define CERNLIB_QMUIX
-#define CERNLIB_A4
-#define CERNLIB_B32
-#define CERNLIB_HEX
-#define CERNLIB_QHOLL
-# ifndef CERNLIB_QFEPC
-#define CERNLIB_EQUHOLCH
-# endif
-#define CERNLIB_QTRHOLL
-#define CERNLIB_QASCII
-#define CERNLIB_QCFIO
-#define CERNLIB_QIEEE
-#define CERNLIB_FQXISN
-#define CERNLIB_QPRINT
-#define CERNLIB_QDEBUG
-#define CERNLIB_QDEBPRI
-#define CERNLIB_QISASTD
-#define CERNLIB_QMILSTD
-#define CERNLIB_FZALFA
-#define CERNLIB_FZCHANNEL
-#define CERNLIB_FZDACC
-#define CERNLIB_FZDACCF
-#define CERNLIB_FZDACCH
-#define CERNLIB_FZDACCL
-#define CERNLIB_FZFFNAT
-#define CERNLIB_FZFORTRAN
-#define CERNLIB_FZLIBC
-#define CERNLIB_FZMEMORY
-#define CERNLIB_JZTIME
-#define CERNLIB_RZBYTES
-#define CERNLIB_RZFRECL
-#endif
-
-#if defined(CERNLIB_IBMRT)
-#define CERNLIB_QMIRT
-#undef CERNLIB_QMILSTD
-#endif
-
-#if defined(CERNLIB_HPUX)
-#define CERNLIB_QMHPX
-#endif
-
-#if defined(CERNLIB_SUN)
-#define CERNLIB_QMSUN
-#if 0
-* CERNLIB_BUGLRSHFT to get round the lrshft bug in Sun f77 3.0.x
-* At CERN a patch was applied for Solaris only
-*
-#endif
-#ifndef CERNLIB_SOLARIS
-#define CERNLIB_BUGLRSHFT
-#endif
-
-#undef CERNLIB_QMILSTD
-#undef CERNLIB_QISASTD
-#endif
-
-#if defined(CERNLIB_SGI)
-#define CERNLIB_QMSGI
-#undef CERNLIB_RZBYTES
-#endif
-
-#if (defined(CERNLIB_DECS))||(defined(CERNLIB_DECOSF))
-#define CERNLIB_QMVMI
-#define CERNLIB_FQNEEDCV
-#undef CERNLIB_Z32
-#undef CERNLIB_FQXISN
-#undef CERNLIB_RZBYTES
-#undef CERNLIB_QMILSTD
-#endif
-
-#if defined(CERNLIB_WINNT)
-#define CERNLIB_QMDOS
-#define CERNLIB_QS_WNT
-#ifndef _X86_
-# define CERNLIB_QFDEC
-#endif
-#define CERNLIB_FQNEEDCV
-#define CERNLIB_F77TRARG
-#undef CERNLIB_Z32
-#undef CERNLIB_FQXISN
-#ifdef CERNLIB_QFDEC
-# undef CERNLIB_RZBYTES
-#endif
-#endif
-
-#if defined(CERNLIB_LINUX)
-#define CERNLIB_QMLNX
-#if !defined(CERNLIB_PPC)
-# define CERNLIB_FQNEEDCV
-# undef CERNLIB_Z32
-# undef CERNLIB_FQXISN
-#endif
-#endif
-
-#if defined(CERNLIB_VAXVMS)
-#define CERNLIB_QMVAX
-#define CERNLIB_A4
-#define CERNLIB_B32
-#define CERNLIB_HEX
-#define CERNLIB_QHOLL
-#define CERNLIB_EQUHOLCH
-#define CERNLIB_QTRHOLL
-#define CERNLIB_QASCII
-#define CERNLIB_QCFIO
-#define CERNLIB_QMILSTD
-#define CERNLIB_QPRINT
-#define CERNLIB_QDEBUG
-#define CERNLIB_QDEBPRI
-#define CERNLIB_FZALFA
-#define CERNLIB_FZCHANNEL
-#define CERNLIB_FZDACC
-#define CERNLIB_FZDACCF
-#define CERNLIB_FZDACCH
-#define CERNLIB_FZDACCL
-#define CERNLIB_FZFFNAT
-#define CERNLIB_FZFORTRAN
-#define CERNLIB_FZLIBC
-#define CERNLIB_FZMEMORY
-#define CERNLIB_JZTIME
-#define CERNLIB_RZFRECL
-#define CERNLIB_FQIE3FDC
-#define CERNLIB_FQIE3FSC
-#define CERNLIB_FQIE3TDC
-#define CERNLIB_FQIE3TSC
-#define CERNLIB_FQNEEDCV
-#endif
diff --git a/src/packlib/zebra/zebra/q.inc b/src/packlib/zebra/zebra/q.inc
deleted file mode 100644
index c46e520..0000000
--- a/src/packlib/zebra/zebra/q.inc
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: q.inc,v 1.1.1.1 1996/03/06 10:46:54 mclareni Exp $
-*
-* $Log: q.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:46:54 mclareni
-* Zebra
-*
-*
-#ifndef CERNLIB_ZEBRA_Q_INC
-#define CERNLIB_ZEBRA_Q_INC
-*
-*
-* q.inc
-*
-#include "zebra/zebq.inc"
-#include "zebra/mzca.inc"
-#include "zebra/mzcb.inc"
-* ------------- for ZEBRA trace-back ----------------------
-
-#endif
diff --git a/src/packlib/zebra/zebra/q_and.inc b/src/packlib/zebra/zebra/q_and.inc
deleted file mode 100644
index e5213ee..0000000
--- a/src/packlib/zebra/zebra/q_and.inc
+++ /dev/null
@@ -1,40 +0,0 @@
-*
-* $Id: q_and.inc,v 1.2 2006/09/15 09:35:33 mclareni Exp $
-*
-* $Log: q_and.inc,v $
-* Revision 1.2 2006/09/15 09:35:33 mclareni
-* Submitted mods for gcc4/gfortran and MacOSX, corrected to work also on slc4 with gcc3.4 and 4.1
-*
-* Revision 1.1 1996/04/18 16:15:05 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-*
-*
-#ifndef CERNLIB_ZEBRA_Q_AND_INC
-#define CERNLIB_ZEBRA_Q_AND_INC
-*
-* q_and.inc
-*
-#if defined(CERNLIB_APOLLO)
- IAND (IZV,IZW) = AND (IZV, IZW)
-
-#elif defined(CERNLIB_CDC)
- IAND (IZV,IZW) = IZV .AND. IZW
-
-#elif defined(CERNLIB_MSDOS)&&defined(CERNLIB_QF_F2C)
- IAND(IZV,IZW) = AND(IZV,IZW)
-
-#elif defined(CERNLIB_QMIBMSI)
- IAND (IZV,IZW) = LAND (IZV, IZW)
-
-#elif defined(CERNLIB_LNX) && !defined(CERNLIB_GFORTRAN)
- IAND(IZV,IZW) = AND(IZV,IZW)
-
-#elif defined(CERNLIB_SUN)
- IAND (IZV,IZW) = AND (IZV, IZW)
-
-#elif 1
-
-#endif
-
-#endif
diff --git a/src/packlib/zebra/zebra/q_andor.inc b/src/packlib/zebra/zebra/q_andor.inc
deleted file mode 100644
index 4b5ecfa..0000000
--- a/src/packlib/zebra/zebra/q_andor.inc
+++ /dev/null
@@ -1,58 +0,0 @@
-*
-* $Id: q_andor.inc,v 1.2 2006/09/15 09:35:33 mclareni Exp $
-*
-* $Log: q_andor.inc,v $
-* Revision 1.2 2006/09/15 09:35:33 mclareni
-* Submitted mods for gcc4/gfortran and MacOSX, corrected to work also on slc4 with gcc3.4 and 4.1
-*
-* Revision 1.1.1.1 1996/03/06 10:46:52 mclareni
-* Zebra
-*
-*
-#ifndef CERNLIB_ZEBRA_Q_ANDOR_INC
-#define CERNLIB_ZEBRA_Q_ANDOR_INC
-*
-* IAND / IOR / IEOR / NOT standard
-*
-* q_andor.inc
-*
-#if defined(CERNLIB_APOLLO)
- IAND (IZV,IZW) = AND (IZV, IZW)
- IOR (IZV,IZW) = OR (IZV, IZW)
- IEOR (IZV,IZW) = XOR (IZV, IZW)
-* NOT is standard on APOLLO
-
-#elif defined(CERNLIB_CDC)
- IAND (IZV,IZW) = IZV .AND. IZW
- IOR (IZV,IZW) = IZV .OR. IZW
- IEOR (IZV,IZW) = IZV .XOR. IZW
- NOT (IZW) = .NOT. IZW
-
-#elif defined(CERNLIB_MSDOS)&&defined(CERNLIB_QF_F2C)
- IAND(IZV,IZW) = AND(IZV,IZW)
- IOR(IZV,IZW) = OR(IZV,IZW)
- IEOR(IZV,IZW) = XOR(IZV,IZW)
-
-#elif defined(CERNLIB_QMIBMSI)
- IAND (IZV,IZW) = LAND (IZV, IZW)
- IOR (IZV,IZW) = LOR (IZV, IZW)
- IEOR (IZV,IZW) = LXOR (IZV, IZW)
- NOT (IZW) = LCOMPL (IZW)
-
-#elif defined(CERNLIB_LNX) && !defined(CERNLIB_GFORTRAN)
- IAND(IZV,IZW) = AND(IZV,IZW)
- IOR(IZV,IZW) = OR(IZV,IZW)
- IEOR(IZV,IZW) = XOR(IZV,IZW)
-
-#elif defined(CERNLIB_SUN)
- IAND (IZV,IZW) = AND (IZV, IZW)
- IOR (IZV,IZW) = OR (IZV, IZW)
- IEOR (IZV,IZW) = XOR (IZV, IZW)
-* NOT is standard on SUN
-
-#elif 1
-* IAND / IOR / IEOR / NOT standard
-
-#endif
-
-#endif
diff --git a/src/packlib/zebra/zebra/q_jbit.inc b/src/packlib/zebra/zebra/q_jbit.inc
deleted file mode 100644
index a6f97ad..0000000
--- a/src/packlib/zebra/zebra/q_jbit.inc
+++ /dev/null
@@ -1,78 +0,0 @@
-*
-* $Id: q_jbit.inc,v 1.3 2006/09/15 09:35:33 mclareni Exp $
-*
-* $Log: q_jbit.inc,v $
-* Revision 1.3 2006/09/15 09:35:33 mclareni
-* Submitted mods for gcc4/gfortran and MacOSX, corrected to work also on slc4 with gcc3.4 and 4.1
-*
-* Revision 1.2 1996/04/18 16:15:06 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:46:52 mclareni
-* Zebra
-*
-*
-#ifndef CERNLIB_ZEBRA_Q_JBIT_INC
-#define CERNLIB_ZEBRA_Q_JBIT_INC
-*
-*
-* q_jbit.inc
-*
-#if defined(CERNLIB_ALLIANT)
- JBIT (IZW,IZP) = IBITS (IZW,IZP-1,1)
-
-#elif defined(CERNLIB_APOLLO)
- JBIT (IZW,IZP) = AND (RSHFT(IZW,IZP-1), 1)
-
-#elif defined(CERNLIB_CDC)
- JBIT (IZW,IZP) = SHIFT(IZW,61-IZP) .AND. .NOT.MASK(59)
-
-#elif defined(CERNLIB_CRAY)
- JBIT (IZW,IZP) = SHIFTR(IZW,IZP-1) .AND. MASK(127)
-
-#elif (defined(CERNLIB_CONVEX))&&(!defined(CERNLIB_DOUBLE))
- JBIT (IZW,IZP) = IBITS (IZW,IZP-1,1)
-
-#elif (defined(CERNLIB_CONVEX))&&(defined(CERNLIB_DOUBLE))
- JBIT (IZW,IZP) = IBITS (IZW,IZP-1,1)
-
-#elif defined(CERNLIB_MSDOS)
-
-#if defined(CERNLIB_QF_NDP)
- JBIT (IZZW,IZZP) = IBITS (IZZW,IZZP-1,1)
-#elif defined(CERNLIB_QF_F2C)
- JBIT (IZW,IZP) = AND(RSHIFT(IZW,IZP-1),1)
-#endif
-
-#elif defined(CERNLIB_HPUX)
- JBIT (IZW,IZP) = IBITS (IZW,IZP-1,1)
-
-#elif defined(CERNLIB_QF_SIEM)
- JBIT (IZW,IZP) = SHFTR (SHFTL(IZW,32-IZP), 31)
-
-#elif defined(CERNLIB_LINUX) && !defined(CERNLIB_GFORTRAN)
- JBIT(IZW,IZP) = AND(ISHFTR(IZW,IZP-1),1)
-
-#elif defined(CERNLIB_OS9)
- JBIT (IZW,IZP) = IBITS (IZW,IZP-1,1)
-
-#elif defined(CERNLIB_PDP)
- JBIT (IZW,IZP) = IBITS (IZW,IZP-1,1)
-
-#elif (defined(CERNLIB_SUN))&&(!defined(CERNLIB_BUGLRSHFT))
- JBIT (IZW,IZP) = AND (lrshft(IZW,IZP-1), 1)
-
-#elif defined(CERNLIB_QMUNO)
- JBIT (IZW,IZP) = BITS (IZW,37-IZP,1)
-
-#elif defined(CERNLIB_QMVDS)
- JBIT (IZW,IZP) = JBYT (IZW,IZP,1)
-
-#elif defined(CERNLIB_VAXVMS)
-
-#elif 1
- JBIT (IZW,IZP) = IAND (ISHFT(IZW,1-IZP), 1)
-
-#endif
-
-#endif
diff --git a/src/packlib/zebra/zebra/q_jbyt.inc b/src/packlib/zebra/zebra/q_jbyt.inc
deleted file mode 100644
index 792635e..0000000
--- a/src/packlib/zebra/zebra/q_jbyt.inc
+++ /dev/null
@@ -1,75 +0,0 @@
-*
-* $Id: q_jbyt.inc,v 1.2 2006/09/15 09:35:33 mclareni Exp $
-*
-* $Log: q_jbyt.inc,v $
-* Revision 1.2 2006/09/15 09:35:33 mclareni
-* Submitted mods for gcc4/gfortran and MacOSX, corrected to work also on slc4 with gcc3.4 and 4.1
-*
-* Revision 1.1 1996/04/18 16:15:07 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-*
-*
-#ifndef CERNLIB_ZEBRA_Q_JBYT_INC
-#define CERNLIB_ZEBRA_Q_JBYT_INC
-*
-*
-* q_jbyt.inc
-*
-#if defined(CERNLIB_ALLIANT)
- JBYT (IZW,IZP,NZB) = IBITS (IZW,IZP-1,NZB)
-
-#elif defined(CERNLIB_APOLLO)
- JBYT (IZW,IZP,NZB)= RSHFT (LSHFT(IZW,33-IZP-NZB), 32-NZB)
-
-#elif defined(CERNLIB_CDC)
- JBYT (IZW,IZP,NZB) = SHIFT(IZW,61-IZP) .AND. .NOT.MASK(60-NZB)
-
-#elif defined(CERNLIB_CRAY)
- JBYT (IZW,IZP,NZB) = SHIFTR(IZW,IZP-1) .AND. MASK(128-NZB)
-
-#elif (defined(CERNLIB_CONVEX))&&(!defined(CERNLIB_DOUBLE))
- JBYT (IZW,IZP,NZB) = IBITS (IZW,IZP-1,NZB)
-
-#elif (defined(CERNLIB_CONVEX))&&(defined(CERNLIB_DOUBLE))
- JBYT (IZW,IZP,NZB) = IBITS (IZW,IZP-1,NZB)
-
-#elif defined(CERNLIB_MSDOS)
-
-#if defined(CERNLIB_QF_NDP)
- JBYT (IZZW,IZZP,NZZB) = IBITS (IZZW,IZZP-1,NZZB)
-#elif defined(CERNLIB_QF_F2C) && !defined(CERNLIB_GFORTRAN)
- JBYT (IZW,IZP,NZB) = ISHFTR(LSHIFT(IZW,33-IZP-NZB),32-NZB)
-#endif
-
-#elif defined(CERNLIB_HPUX)
- JBYT (IZW,IZP,NZB) = IBITS (IZW,IZP-1,NZB)
-
-#elif defined(CERNLIB_QF_SIEM)
- JBYT (IZW,IZP,NZB)= SHFTR (SHFTL(IZW,33-IZP-NZB), 32-NZB)
-
-#elif defined(CERNLIB_LINUX)
- JBYT(IZW,IZP,NZB) = ISHFTR(LSHIFT(IZW,33-IZP-NZB),32-NZB)
-
-#elif defined(CERNLIB_OS9)
- JBYT (IZW,IZP,NZB) = IBITS (IZW,IZP-1,NZB)
-
-#elif defined(CERNLIB_PDP)
- JBYT (IZW,IZP,NZB) = IBITS (IZW,IZP-1,NZB)
-
-#elif (defined(CERNLIB_SUN))&&(!defined(CERNLIB_BUGLRSHFT))
- JBYT (IZW,IZP,NZB)= lrshft (LSHIFT(IZW,33-IZP-NZB),32-NZB)
-
-#elif defined(CERNLIB_QMUNO)
- JBYT (IZW,IZP,NZB) = BITS (IZW,38-IZP-NZB,NZB)
-
-#elif defined(CERNLIB_QMVDS)
-
-#elif defined(CERNLIB_VAXVMS)
-
-#elif 1
- JBYT (IZW,IZP,NZB) = ISHFT (ISHFT(IZW,33-IZP-NZB), -32+NZB)
-
-#endif
-
-#endif
diff --git a/src/packlib/zebra/zebra/q_jbytet.inc b/src/packlib/zebra/zebra/q_jbytet.inc
deleted file mode 100644
index 04735e6..0000000
--- a/src/packlib/zebra/zebra/q_jbytet.inc
+++ /dev/null
@@ -1,80 +0,0 @@
-*
-* $Id: q_jbytet.inc,v 1.3 2006/09/15 09:35:33 mclareni Exp $
-*
-* $Log: q_jbytet.inc,v $
-* Revision 1.3 2006/09/15 09:35:33 mclareni
-* Submitted mods for gcc4/gfortran and MacOSX, corrected to work also on slc4 with gcc3.4 and 4.1
-*
-* Revision 1.2 1996/04/18 16:15:07 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:46:52 mclareni
-* Zebra
-*
-*
-#ifndef CERNLIB_ZEBRA_Q_JBYTET_INC
-#define CERNLIB_ZEBRA_Q_JBYTET_INC
-*
-*
-* q_jbytet.inc
-*
-#if defined(CERNLIB_ALLIANT)
- JBYTET (MZ,IZW,IZP,NZB) = IAND (MZ, IBITS(IZW,IZP-1,NZB))
-
-#elif defined(CERNLIB_APOLLO)
- JBYTET (MZ,IZW,IZP,NZB) = AND (MZ,
- + RSHFT (LSHFT(IZW,33-IZP-NZB), 32-NZB) )
-
-#elif defined(CERNLIB_CDC)
- JBYTET (MZ,IZW,IZP,NZB) = MZ .AND. SHIFT(IZW,61-IZP)
- + .AND. .NOT.MASK(60-NZB)
-
-#elif defined(CERNLIB_CRAY)
- JBYTET (MZ,IZW,IZP,NZB) = MZ .AND. SHIFTR(IZW,IZP-1)
- + .AND. MASK(128-NZB)
-
-#elif (defined(CERNLIB_CONVEX))&&(!defined(CERNLIB_DOUBLE))
- JBYTET (MZ,IZW,IZP,NZB) = MZ .AND. IBITS(IZW,IZP-1,NZB)
-
-#elif (defined(CERNLIB_CONVEX))&&(defined(CERNLIB_DOUBLE))
- JBYTET (MZ,IZW,IZP,NZB) = MZ .AND. IBITS(IZW,IZP-1,NZB)
-
-#elif defined(CERNLIB_MSDOS)
-
-#if defined(CERNLIB_QF_NDP)
- JBYTET (MZZ,IZZW,IZZP,NZZB) = IAND (MZZ, IBITS(IZZW,IZZP-1,NZZB))
-#elif defined(CERNLIB_QF_F2C)
- JBYTET (MZ,IZW,IZP,NZB) = AND (MZ,
- + ishftr (LSHIFT(IZW,33-IZP-NZB),32-NZB) )
-#endif
-
-#elif defined(CERNLIB_HPUX)
- JBYTET (MZ,IZW,IZP,NZB) = IAND (MZ, IBITS(IZW,IZP-1,NZB))
-
-#elif defined(CERNLIB_QF_SIEM)
- JBYTET (MZ,IZW,IZP,NZB) = LAND (MZ,
- + SHFTR (SHFTL(IZW,33-IZP-NZB), 32-NZB) )
-
-#elif defined(CERNLIB_LINUX) && !defined(CERNLIB_GFORTRAN)
- JBYTET (MZ,IZW,IZP,NZB) = AND (MZ,
- + ISHFTR (LSHIFT(IZW,33-IZP-NZB),32-NZB) )
-
-#elif defined(CERNLIB_OS9)
- JBYTET (MZ,IZW,IZP,NZB) = IAND (MZ, IBITS(IZW,IZP-1,NZB))
-
-#elif defined(CERNLIB_PDP)
- JBYTET (MZ,IZW,IZP,NZB) = IAND (MZ, IBITS(IZW,IZP-1,NZB))
-
-#elif (defined(CERNLIB_SUN))&&(!defined(CERNLIB_BUGLRSHFT))
- JBYTET (MZ,IZW,IZP,NZB) = AND (MZ,
- + lrshft (LSHIFT(IZW,33-IZP-NZB), 32-NZB))
-
-#elif defined(CERNLIB_QMVDS)
- JBYTET (MZ,IZW,IZP,NZB) = AND (MZ, JBYT(IZW,IZP,NZB))
-
-#elif 1
- JBYTET (MZ,IZW,IZP,NZB) = IAND (MZ,
- + ISHFT (ISHFT(IZW,33-IZP-NZB),-32+NZB) )
-#endif
-
-#endif
diff --git a/src/packlib/zebra/zebra/q_jbytor.inc b/src/packlib/zebra/zebra/q_jbytor.inc
deleted file mode 100644
index 45d768b..0000000
--- a/src/packlib/zebra/zebra/q_jbytor.inc
+++ /dev/null
@@ -1,78 +0,0 @@
-*
-* $Id: q_jbytor.inc,v 1.2 2006/09/15 09:35:33 mclareni Exp $
-*
-* $Log: q_jbytor.inc,v $
-* Revision 1.2 2006/09/15 09:35:33 mclareni
-* Submitted mods for gcc4/gfortran and MacOSX, corrected to work also on slc4 with gcc3.4 and 4.1
-*
-* Revision 1.1 1996/04/18 16:15:10 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-*
-*
-#ifndef CERNLIB_ZEBRA_Q_JBYTOR_INC
-#define CERNLIB_ZEBRA_Q_JBYTOR_INC
-*
-*
-* q_jbytor.inc
-*
-#if defined(CERNLIB_ALLIANT)
- JBYTOR (MZ,IZW,IZP,NZB) = IOR (MZ, IBITS(IZW,IZP-1,NZB))
-
-#elif defined(CERNLIB_APOLLO)
- JBYTOR (MZ,IZW,IZP,NZB) = OR (MZ,
- + RSHFT (LSHFT(IZW,33-IZP-NZB), 32-NZB) )
-
-#elif defined(CERNLIB_CDC)
- JBYTOR (MZ,IZW,IZP,NZB) = MZ .OR. (SHIFT(IZW,61-IZP)
- + .AND. .NOT.MASK(60-NZB) )
-
-#elif defined(CERNLIB_CRAY)
- JBYTOR (MZ,IZW,IZP,NZB) = MZ .OR. (SHIFTR(IZW,IZP-1)
- + .AND. MASK(128-NZB) )
-
-#elif (defined(CERNLIB_CONVEX))&&(!defined(CERNLIB_DOUBLE))
- JBYTOR (MZ,IZW,IZP,NZB) = MZ .OR. IBITS(IZW,IZP-1,NZB)
-
-#elif (defined(CERNLIB_CONVEX))&&(defined(CERNLIB_DOUBLE))
- JBYTOR (MZ,IZW,IZP,NZB) = MZ .OR. IBITS(IZW,IZP-1,NZB)
-
-#elif defined(CERNLIB_MSDOS)
-
-#if defined(CERNLIB_QF_NDP)
- JBYTOR (MZZ,IZZW,IZZP,NZZB) = IOR (MZZ, IBITS(IZZW,IZZP-1,NZZB))
-#elif defined(CERNLIB_QF_F2C)
- JBYTOR (MZ,IZW,IZP,NZB) = OR (MZ,
- + ishftr (LSHIFT(IZW,33-IZP-NZB),32-NZB) )
-#endif
-
-#elif defined(CERNLIB_HPUX)
- JBYTOR (MZ,IZW,IZP,NZB) = IOR (MZ, IBITS(IZW,IZP-1,NZB))
-
-#elif defined(CERNLIB_QF_SIEM)
- JBYTOR (MZ,IZW,IZP,NZB) = LOR (MZ,
- + SHFTR (SHFTL(IZW,33-IZP-NZB), 32-NZB) )
-
-#elif defined(CERNLIB_LINUX) && !defined(CERNLIB_GFORTRAN)
- JBYTOR (MZ,IZW,IZP,NZB) = OR (MZ,
- + ISHFTR (LSHIFT(IZW,33-IZP-NZB),32-NZB) )
-
-#elif defined(CERNLIB_OS9)
- JBYTOR (MZ,IZW,IZP,NZB) = IOR (MZ, IBITS(IZW,IZP-1,NZB))
-
-#elif defined(CERNLIB_PDP)
- JBYTOR (MZ,IZW,IZP,NZB) = IOR (MZ, IBITS(IZW,IZP-1,NZB))
-
-#elif (defined(CERNLIB_SUN))&&(!defined(CERNLIB_BUGLRSHFT))
- JBYTOR (MZ,IZW,IZP,NZB) = OR (MZ,
- + lrshft (LSHIFT(IZW,33-IZP-NZB), 32-NZB))
-
-#elif defined(CERNLIB_QMVDS)
- JBYTOR (MZ,IZW,IZP,NZB) = OR (MZ, JBYT(IZW,IZP,NZB))
-
-#elif 1
- JBYTOR (MZ,IZW,IZP,NZB) = IOR (MZ,
- + ISHFT (ISHFT(IZW,33-IZP-NZB),-32+NZB) )
-#endif
-
-#endif
diff --git a/src/packlib/zebra/zebra/q_locf.inc b/src/packlib/zebra/zebra/q_locf.inc
deleted file mode 100644
index 6275f21..0000000
--- a/src/packlib/zebra/zebra/q_locf.inc
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: q_locf.inc,v 1.2 1997/03/14 17:22:25 mclareni Exp $
-*
-* $Log: q_locf.inc,v $
-* Revision 1.2 1997/03/14 17:22:25 mclareni
-* WNT mods
-*
-* Revision 1.1.1.1.2.1 1997/01/21 11:34:16 mclareni
-* All mods for Winnt 96a on winnt branch
-*
-* Revision 1.1.1.1 1996/03/06 10:46:52 mclareni
-* Zebra
-*
-*
-#ifndef CERNLIB_ZEBRA_Q_LOCF_INC
-#define CERNLIB_ZEBRA_Q_LOCF_INC
-*
-*
-* q_locf.inc
-*
-#if defined(CERNLIB_CRAY)
- LOCF (IZLOC) = LOC (IZLOC)
-#elif defined(CERNLIB_QFMSOFT_TEST)
-* This is very dangerous since the DWORD address may be odd too !!!
- LOCF (IZLOC) = LOC (IZLOC)/4
-#endif
-
-#endif
diff --git a/src/packlib/zebra/zebra/q_mbytet.inc b/src/packlib/zebra/zebra/q_mbytet.inc
deleted file mode 100644
index 0749958..0000000
--- a/src/packlib/zebra/zebra/q_mbytet.inc
+++ /dev/null
@@ -1,82 +0,0 @@
-*
-* $Id: q_mbytet.inc,v 1.2 2006/09/15 09:35:33 mclareni Exp $
-*
-* $Log: q_mbytet.inc,v $
-* Revision 1.2 2006/09/15 09:35:33 mclareni
-* Submitted mods for gcc4/gfortran and MacOSX, corrected to work also on slc4 with gcc3.4 and 4.1
-*
-* Revision 1.1 1996/04/18 16:15:11 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-*
-*
-#ifndef CERNLIB_ZEBRA_Q_MBYTET_INC
-#define CERNLIB_ZEBRA_Q_MBYTET_INC
-*
-*
-* q_mbytet.inc
-*
-#if defined(CERNLIB_ALLIANT)
- MBYTET (MZ,IZW,IZP,NZB) = IAND (IZW,
- + NOT(ishft (ISHFT(NOT(MZ),32-NZB),-33+IZP+NZB)) )
-
-#elif defined(CERNLIB_APOLLO)
- MBYTET (MZ,IZW,IZP,NZB) = AND (IZW, NOT(RSHFT (
- + LSHFT(NOT(MZ),32-NZB), 33-IZP-NZB)) )
-
-#elif defined(CERNLIB_CDC)
- MBYTET (MZ,IZW,IZP,NZB) = IZW .AND.
- + SHIFT (MZ .OR. MASK(60-NZB),IZP-1)
-
-#elif defined(CERNLIB_CRAY)
- MBYTET (MZ,IZW,IZP,NZB) = IZW .AND.
- + SHIFT (MZ.OR. MASK(64-NZB), IZP-1)
-
-#elif (defined(CERNLIB_CONVEX))&&(!defined(CERNLIB_DOUBLE))
-
-#elif (defined(CERNLIB_CONVEX))&&(defined(CERNLIB_DOUBLE))
-
-#elif defined(CERNLIB_MSDOS)
-
-#if defined(CERNLIB_QF_NDP)
- MBYTET (MZZ,IZZW,IZZP,NZZB) = IAND (IZZW,
- + NOT(ishft (ISHFT(NOT(MZZ),32-NZZB),-33+IZZP+NZZB)) )
-#elif defined(CERNLIB_QF_F2C)
- MBYTET (MZ,IZW,IZP,NZB) = AND (IZW,
- + NOT(ishftr (LSHIFT(NOT(MZ),32-NZB),33-IZP-NZB)) )
-#endif
-
-#elif defined(CERNLIB_HPUX)
- MBYTET (MZ,IZW,IZP,NZB) = IAND (IZW,
- + NOT(ishft (ISHFT(NOT(MZ),32-NZB),-33+IZP+NZB)) )
-
-#elif defined(CERNLIB_QF_SIEM)
- MBYTET (MZ,IZW,IZP,NZB) = LAND (IZW, LCOMPL(SHFTR (
- + SHFTL(LCOMPL(MZ),32-NZB), 33-IZP-NZB)) )
-
-#elif defined(CERNLIB_LINUX) && !defined(CERNLIB_GFORTRAN)
- MBYTET (MZ,IZW,IZP,NZB) = AND (IZW,
- + NOT(ISHFTR (LSHIFT(NOT(MZ),32-NZB),33-IZP-NZB)) )
-
-#elif defined(CERNLIB_OS9)
- MBYTET (MZ,IZW,IZP,NZB) = IAND (IZW,
- + NOT(ishft (ISHFT(NOT(MZ),32-NZB),-33+IZP+NZB)) )
-
-#elif defined(CERNLIB_PDP)
- MBYTET (MZ,IZW,IZP,NZB) = IAND (IZW, NOT(ISHFT (
- + ISHFT(NOT(MZ),36-NZB),-37+IZP+NZB)) )
-
-#elif (defined(CERNLIB_SUN))&&(!defined(CERNLIB_BUGLRSHFT))
- MBYTET (MZ,IZW,IZP,NZB) = AND (IZW, NOT(lrshft (
- + LSHIFT(NOT(MZ),32-NZB), 33-IZP-NZB)))
-
-#elif defined(CERNLIB_QMVDS)
- MBYTET (MZ,IZW,IZP,NZB) = AND (IZW, NOT(RSHFT (
- + LSHFT(NOT(MZ),32-NZB), 33-IZP-NZB)) )
-
-#elif 1
- MBYTET (MZ,IZW,IZP,NZB) = IAND (IZW,
- + NOT(ISHFT (ISHFT(NOT(MZ),32-NZB),-33+IZP+NZB)) )
-#endif
-
-#endif
diff --git a/src/packlib/zebra/zebra/q_mbytor.inc b/src/packlib/zebra/zebra/q_mbytor.inc
deleted file mode 100644
index e09c8c7..0000000
--- a/src/packlib/zebra/zebra/q_mbytor.inc
+++ /dev/null
@@ -1,82 +0,0 @@
-*
-* $Id: q_mbytor.inc,v 1.2 2006/09/15 09:35:33 mclareni Exp $
-*
-* $Log: q_mbytor.inc,v $
-* Revision 1.2 2006/09/15 09:35:33 mclareni
-* Submitted mods for gcc4/gfortran and MacOSX, corrected to work also on slc4 with gcc3.4 and 4.1
-*
-* Revision 1.1 1996/04/18 16:15:12 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-*
-*
-#ifndef CERNLIB_ZEBRA_Q_MBYTOR_INC
-#define CERNLIB_ZEBRA_Q_MBYTOR_INC
-*
-*
-* q_mbytor.inc
-*
-#if defined(CERNLIB_ALLIANT)
- MBYTOR (MZ,IZW,IZP,NZB) = IOR (IZW,
- + ishft (ISHFT(MZ,32-NZB),-33+IZP+NZB) )
-
-#elif defined(CERNLIB_APOLLO)
- MBYTOR (MZ,IZW,IZP,NZB) = OR (IZW, RSHFT (
- + LSHFT(MZ,32-NZB), 33-IZP-NZB) )
-
-#elif defined(CERNLIB_CDC)
- MBYTOR (MZ,IZW,IZP,NZB) = IZW .OR.
- + SHIFT (MZ .AND. .NOT.MASK(60-NZB),IZP-1)
-
-#elif defined(CERNLIB_CRAY)
- MBYTOR (MZ,IZW,IZP,NZB) = IZW .OR.
- + SHIFT (MZ.AND.MASK(128-NZB),IZP-1)
-
-#elif (defined(CERNLIB_CONVEX))&&(!defined(CERNLIB_DOUBLE))
-
-#elif (defined(CERNLIB_CONVEX))&&(defined(CERNLIB_DOUBLE))
-
-#elif defined(CERNLIB_MSDOS)
-
-#if defined(CERNLIB_QF_NDP)
- MBYTOR (MZZ,IZZW,IZZP,NZZB) = IOR (IZZW,
- + ishft (ISHFT(MZZ,32-NZZB),-33+IZZP+NZZB) )
-#elif defined(CERNLIB_QF_F2C)
- MBYTOR (MZ,IZW,IZP,NZB) = OR (IZW,
- + ishftr (LSHIFT(MZ,32-NZB),33-IZP-NZB) )
-#endif
-
-#elif defined(CERNLIB_HPUX)
- MBYTOR (MZ,IZW,IZP,NZB) = IOR (IZW,
- + ishft (ISHFT(MZ,32-NZB),-33+IZP+NZB) )
-
-#elif defined(CERNLIB_QF_SIEM)
- MBYTOR (MZ,IZW,IZP,NZB) = LOR (IZW, SHFTR (
- + SHFTL(MZ,32-NZB), 33-IZP-NZB) )
-
-#elif defined(CERNLIB_LINUX) && !defined(CERNLIB_GFORTRAN)
- MBYTOR (MZ,IZW,IZP,NZB) = OR (IZW,
- + ISHFTR (LSHIFT(MZ,32-NZB),33-IZP-NZB))
-
-#elif defined(CERNLIB_OS9)
- MBYTOR (MZ,IZW,IZP,NZB) = IOR (IZW,
- + ishft (ISHFT(MZ,32-NZB),-33+IZP+NZB) )
-
-#elif defined(CERNLIB_PDP)
- MBYTOR (MZ,IZW,IZP,NZB) = IOR (IZW, ISHFT (
- + ISHFT(MZ,36-NZB),-37+IZP+NZB) )
-
-#elif (defined(CERNLIB_SUN))&&(!defined(CERNLIB_BUGLRSHFT))
- MBYTOR (MZ,IZW,IZP,NZB) = OR (IZW, lrshft (
- + LSHIFT(MZ,32-NZB), 33-IZP-NZB))
-
-#elif defined(CERNLIB_QMVDS)
- MBYTOR (MZ,IZW,IZP,NZB) = OR (IZW, RSHFT (
- + LSHFT(MZ,32-NZB), 33-IZP-NZB) )
-
-#elif 1
- MBYTOR (MZ,IZW,IZP,NZB) = IOR (IZW,
- + ISHFT (ISHFT(MZ,32-NZB),-33+IZP+NZB) )
-#endif
-
-#endif
diff --git a/src/packlib/zebra/zebra/q_not.inc b/src/packlib/zebra/zebra/q_not.inc
deleted file mode 100644
index 0f463d7..0000000
--- a/src/packlib/zebra/zebra/q_not.inc
+++ /dev/null
@@ -1,35 +0,0 @@
-*
-* $Id: q_not.inc,v 1.1 1996/04/18 16:15:12 mclareni Exp $
-*
-* $Log: q_not.inc,v $
-* Revision 1.1 1996/04/18 16:15:12 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-*
-*
-#ifndef CERNLIB_ZEBRA_Q_NOT_INC
-#define CERNLIB_ZEBRA_Q_NOT_INC
-*
-* q_not.inc
-*
-#if defined(CERNLIB_APOLLO)
-* NOT is standard on APOLLO
-
-#elif defined(CERNLIB_CDC)
- NOT (IZW) = .NOT. IZW
-
-#elif defined(CERNLIB_MSDOS)&&defined(CERNLIB_QF_F2C)
-
-#elif defined(CERNLIB_QMIBMSI)
- NOT (IZW) = LCOMPL (IZW)
-
-#elif defined(CERNLIB_LNX)
-
-#elif defined(CERNLIB_SUN)
-* NOT is standard on SUN
-
-#elif 1
-
-#endif
-
-#endif
diff --git a/src/packlib/zebra/zebra/q_or.inc b/src/packlib/zebra/zebra/q_or.inc
deleted file mode 100644
index a68aaf5..0000000
--- a/src/packlib/zebra/zebra/q_or.inc
+++ /dev/null
@@ -1,40 +0,0 @@
-*
-* $Id: q_or.inc,v 1.2 2006/09/15 09:35:33 mclareni Exp $
-*
-* $Log: q_or.inc,v $
-* Revision 1.2 2006/09/15 09:35:33 mclareni
-* Submitted mods for gcc4/gfortran and MacOSX, corrected to work also on slc4 with gcc3.4 and 4.1
-*
-* Revision 1.1 1996/04/18 16:15:13 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-*
-*
-#ifndef CERNLIB_ZEBRA_Q_OR_INC
-#define CERNLIB_ZEBRA_Q_OR_INC
-*
-* q_or.inc
-*
-#if defined(CERNLIB_APOLLO)
- IOR (IZV,IZW) = OR (IZV, IZW)
-
-#elif defined(CERNLIB_CDC)
- IOR (IZV,IZW) = IZV .OR. IZW
-
-#elif defined(CERNLIB_MSDOS)&&defined(CERNLIB_QF_F2C)
- IOR(IZV,IZW) = OR(IZV,IZW)
-
-#elif defined(CERNLIB_QMIBMSI)
- IOR (IZV,IZW) = LOR (IZV, IZW)
-
-#elif defined(CERNLIB_LNX) && !defined(CERNLIB_GFORTRAN)
- IOR(IZV,IZW) = OR(IZV,IZW)
-
-#elif defined(CERNLIB_SUN)
- IOR (IZV,IZW) = OR (IZV, IZW)
-
-#elif 1
-
-#endif
-
-#endif
diff --git a/src/packlib/zebra/zebra/q_sbit.inc b/src/packlib/zebra/zebra/q_sbit.inc
deleted file mode 100644
index 23dd048..0000000
--- a/src/packlib/zebra/zebra/q_sbit.inc
+++ /dev/null
@@ -1,75 +0,0 @@
-*
-* $Id: q_sbit.inc,v 1.3 2006/09/15 09:35:34 mclareni Exp $
-*
-* $Log: q_sbit.inc,v $
-* Revision 1.3 2006/09/15 09:35:34 mclareni
-* Submitted mods for gcc4/gfortran and MacOSX, corrected to work also on slc4 with gcc3.4 and 4.1
-*
-* Revision 1.2 1996/04/18 16:15:23 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:46:52 mclareni
-* Zebra
-*
-*
-#ifndef CERNLIB_ZEBRA_Q_SBIT_INC
-#define CERNLIB_ZEBRA_Q_SBIT_INC
-*
-*
-* q_sbit.inc
-*
-
-#if defined(CERNLIB_APOLLO)
- MSBIT (MZ,IZW,IZP) = OR (AND (IZW, NOT(LSHFT(1,IZP-1)) )
- + , LSHFT(AND(MZ,1),IZP-1) )
-
-#elif defined(CERNLIB_CDC)
- MSBIT (MZ,IZW,IZP) =(IZW .AND. .NOT.SHIFT(MASK(1),IZP))
- + .OR. SHIFT(MZ .AND. .NOT.MASK(59),IZP-1)
-
-#elif defined(CERNLIB_CRAY)
- MSBIT (MZ,IZW,IZP) = (IZW .AND. SHIFT(MASK(65),IZP))
- + .OR. SHIFT(MZ.AND.MASK(127),IZP-1)
-
-#elif (defined(CERNLIB_CONVEX))&&(!defined(CERNLIB_DOUBLE))
-
-#elif (defined(CERNLIB_CONVEX))&&(defined(CERNLIB_DOUBLE))
-
-#elif defined(CERNLIB_MSDOS)
-
-#if defined(CERNLIB_QF_NDP)
- MSBIT (MZZ,IZZW,IZZP) = IOR (IAND (IZZW, NOT(ISHFT(1,IZZP-1)) )
- + , ISHFT(IAND(MZZ,1),IZZP-1))
-#elif defined(CERNLIB_QF_F2C)
- MSBIT (MZ,IZW,IZP) = OR (AND (IZW, NOT(LSHIFT(1,IZP-1)) )
- + , LSHIFT(AND(MZ,1),IZP-1))
-#endif
-
-#elif defined(CERNLIB_QF_SIEM)
- MSBIT (MZ,IZW,IZP) = LOR (LAND (IZW, LCOMPL(SHFTL(1,IZP-1)) )
- + , SHFTL(LAND(MZ,1),IZP-1) )
-
-#elif defined(CERNLIB_LINUX) && !defined(CERNLIB_GFORTRAN)
- MSBIT (MZ,IZW,IZP) = OR (AND (IZW, NOT(LSHIFT(1,IZP-1)))
- + ,LSHIFT(AND(MZ,1),IZP-1))
-
-#elif defined(CERNLIB_PDP)
- MSBIT (MZ,IZW,IZP) = IOR (IAND (IZW, NOT(ISHFT(1,IZP-1)) )
- + , ISHFT (IAND(MZ,1),IZP-1) )
-
-#elif defined(CERNLIB_SUN)
- MSBIT (MZ,IZW,IZP) = OR (AND (IZW, NOT(LSHIFT(1,IZP-1)) )
- + , LSHIFT(AND(MZ,1),IZP-1) )
-
-#elif defined(CERNLIB_VAXVMS)
-
-#elif defined(CERNLIB_QMVDS)
- MSBIT (MZ,IZW,IZP) = OR (AND (IZW, NOT(LSHFT(1,IZP-1)) )
- + , LSHFT(AND(MZ,1),IZP-1) )
-
-#elif 1
- MSBIT (MZ,IZW,IZP) = IOR (IAND (IZW, NOT(ISHFT(1,IZP-1)) )
- + , ISHFT(IAND(MZ,1),IZP-1))
-#endif
-
-#endif
diff --git a/src/packlib/zebra/zebra/q_sbit0.inc b/src/packlib/zebra/zebra/q_sbit0.inc
deleted file mode 100644
index 3fd05e8..0000000
--- a/src/packlib/zebra/zebra/q_sbit0.inc
+++ /dev/null
@@ -1,65 +0,0 @@
-*
-* $Id: q_sbit0.inc,v 1.2 2006/09/15 09:35:34 mclareni Exp $
-*
-* $Log: q_sbit0.inc,v $
-* Revision 1.2 2006/09/15 09:35:34 mclareni
-* Submitted mods for gcc4/gfortran and MacOSX, corrected to work also on slc4 with gcc3.4 and 4.1
-*
-* Revision 1.1 1996/04/18 16:15:24 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-*
-*
-#ifndef CERNLIB_ZEBRA_Q_SBIT0_INC
-#define CERNLIB_ZEBRA_Q_SBIT0_INC
-*
-*
-* q_sbit0.inc
-*
-
-#if defined(CERNLIB_APOLLO)
- MSBIT0 (IZW,IZP) = AND (IZW, NOT(LSHFT(1,IZP-1)) )
-
-#elif defined(CERNLIB_CDC)
- MSBIT0 (IZW,IZP) = IZW .AND. .NOT.SHIFT(MASK(1),IZP)
-
-#elif defined(CERNLIB_CRAY)
- MSBIT0 (IZW,IZP) = IZW .AND. SHIFT(MASK(65),IZP)
-
-#elif (defined(CERNLIB_CONVEX))&&(!defined(CERNLIB_DOUBLE))
- MSBIT0 (IZW,IZP) = IBCLR (IZW,IZP-1)
-
-#elif (defined(CERNLIB_CONVEX))&&(defined(CERNLIB_DOUBLE))
- MSBIT0 (IZW,IZP) = IBCLR (IZW,IZP-1)
-
-#elif defined(CERNLIB_MSDOS)
-
-#if defined(CERNLIB_QF_NDP)
- MSBIT0 (IZZW,IZZP) = IAND (IZZW, NOT(ISHFT(1,IZZP-1)) )
-
-#elif defined(CERNLIB_QF_F2C)
- MSBIT0 (IZW,IZP) = AND (IZW, NOT(LSHIFT(1,IZP-1)) )
-#endif
-
-#elif defined(CERNLIB_QF_SIEM)
- MSBIT0 (IZW,IZP) = LAND (IZW, LCOMPL(SHFTL(1,IZP-1)) )
-
-#elif defined(CERNLIB_LINUX) && !defined(CERNLIB_GFORTRAN)
- MSBIT0 (IZW,IZP) = AND (IZW, NOT(LSHIFT(1,IZP-1)))
-
-#elif defined(CERNLIB_PDP)
- MSBIT0 (IZW,IZP) = IAND (IZW, NOT(ISHFT(1,IZP-1)) )
-
-#elif defined(CERNLIB_SUN)
- MSBIT0 (IZW,IZP) = AND (IZW, NOT(LSHIFT(1,IZP-1)) )
-
-#elif defined(CERNLIB_VAXVMS)
-
-#elif defined(CERNLIB_QMVDS)
- MSBIT0 (IZW,IZP) = AND (IZW, NOT(LSHFT(1,IZP-1)) )
-
-#elif 1
- MSBIT0 (IZW,IZP) = IAND (IZW, NOT(ISHFT(1,IZP-1)) )
-#endif
-
-#endif
diff --git a/src/packlib/zebra/zebra/q_sbit1.inc b/src/packlib/zebra/zebra/q_sbit1.inc
deleted file mode 100644
index 1502404..0000000
--- a/src/packlib/zebra/zebra/q_sbit1.inc
+++ /dev/null
@@ -1,64 +0,0 @@
-*
-* $Id: q_sbit1.inc,v 1.2 2006/09/15 09:35:34 mclareni Exp $
-*
-* $Log: q_sbit1.inc,v $
-* Revision 1.2 2006/09/15 09:35:34 mclareni
-* Submitted mods for gcc4/gfortran and MacOSX, corrected to work also on slc4 with gcc3.4 and 4.1
-*
-* Revision 1.1 1996/04/18 16:15:24 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-*
-*
-#ifndef CERNLIB_ZEBRA_Q_SBIT1_INC
-#define CERNLIB_ZEBRA_Q_SBIT1_INC
-*
-*
-* q_sbit1.inc
-*
-
-#if defined(CERNLIB_APOLLO)
- MSBIT1 (IZW,IZP) = OR (IZW, LSHFT(1,IZP-1) )
-
-#elif defined(CERNLIB_CDC)
- MSBIT1 (IZW,IZP) = IZW .OR. SHIFT(MASK(1),IZP)
-
-#elif defined(CERNLIB_CRAY)
- MSBIT1 (IZW,IZP) = IZW .OR. SHIFT(MASK(1), IZP)
-
-#elif (defined(CERNLIB_CONVEX))&&(!defined(CERNLIB_DOUBLE))
- MSBIT1 (IZW,IZP) = IBSET (IZW,IZP-1)
-
-#elif (defined(CERNLIB_CONVEX))&&(defined(CERNLIB_DOUBLE))
- MSBIT1 (IZW,IZP) = IBSET (IZW,IZP-1)
-
-#elif defined(CERNLIB_MSDOS)
-
-#if defined(CERNLIB_QF_NDP)
- MSBIT1 (IZZW,IZZP) = IOR (IZZW, ISHFT(1,IZZP-1) )
-#elif defined(CERNLIB_QF_F2C)
- MSBIT1 (IZW,IZP) = OR (IZW, LSHIFT(1,IZP-1) )
-#endif
-
-#elif defined(CERNLIB_QF_SIEM)
- MSBIT1 (IZW,IZP) = LOR (IZW, SHFTL(1,IZP-1) )
-
-#elif defined(CERNLIB_LINUX) && !defined(CERNLIB_GFORTRAN)
- MSBIT1 (IZW,IZP) = OR (IZW, LSHIFT(1,IZP-1))
-
-#elif defined(CERNLIB_PDP)
- MSBIT1 (IZW,IZP) = IOR (IZW, ISHFT(1,IZP-1) )
-
-#elif defined(CERNLIB_SUN)
- MSBIT1 (IZW,IZP) = OR (IZW, LSHIFT(1,IZP-1) )
-
-#elif defined(CERNLIB_VAXVMS)
-
-#elif defined(CERNLIB_QMVDS)
- MSBIT1 (IZW,IZP) = OR (IZW, LSHFT(1,IZP-1) )
-
-#elif 1
- MSBIT1 (IZW,IZP) = IOR (IZW, ISHFT(1,IZP-1) )
-#endif
-
-#endif
diff --git a/src/packlib/zebra/zebra/q_sbyt.inc b/src/packlib/zebra/zebra/q_sbyt.inc
deleted file mode 100644
index 70030be..0000000
--- a/src/packlib/zebra/zebra/q_sbyt.inc
+++ /dev/null
@@ -1,72 +0,0 @@
-*
-* $Id: q_sbyt.inc,v 1.2 2006/09/15 09:35:34 mclareni Exp $
-*
-* $Log: q_sbyt.inc,v $
-* Revision 1.2 2006/09/15 09:35:34 mclareni
-* Submitted mods for gcc4/gfortran and MacOSX, corrected to work also on slc4 with gcc3.4 and 4.1
-*
-* Revision 1.1.1.1 1996/03/06 10:46:52 mclareni
-* Zebra
-*
-*
-#ifndef CERNLIB_ZEBRA_Q_SBYT_INC
-#define CERNLIB_ZEBRA_Q_SBYT_INC
-*
-*
-* q_sbyt.inc
-*
-#if defined(CERNLIB_APOLLO)
- MSBYT (MZ,IZW,IZP,NZB) = OR (
- + AND (IZW, NOT(LSHFT (RSHFT(NOT(INT4(0)),32-NZB), IZP-1)))
- + , RSHFT (LSHFT(MZ,32-NZB), 33-IZP-NZB) )
-
-#elif defined(CERNLIB_CDC)
- MSBYT (MZ,IZW,IZP,NZB) = SHIFT (
- + (SHIFT(IZW,61-IZP-NZB) .AND. .NOT.MASK(NZB))
- + .OR. (SHIFT (MZ,60-NZB) .AND. MASK(NZB)), IZP+NZB-1)
-
-#elif defined(CERNLIB_CRAY)
- MSBYT (MZ,IZW,IZP,NZB) = (IZW .AND. SHIFT(MASK(64-NZB),IZP-1))
- + .OR. SHIFT(MZ.AND.MASK(128-NZB),IZP-1)
-
-#elif defined(CERNLIB_MSDOS)
-
-#if defined(CERNLIB_QF_NDP)
- MSBYT (MZZ,IZZW,IZZP,NZZB) = IOR (
- + IAND (IZZW, NOT(ISHFT (ISHFT(NOT(0),-32+NZZB), IZZP-1)))
- + , ISHFT (ISHFT(MZZ,32-NZZB), -33+IZZP+NZZB) )
-#elif defined(CERNLIB_QF_F2C)
-C MSBYT (MZ,IZW,IZP,NZB) = OR (
-C + AND (IZW, NOT(LSHIFT (ISHFTR(NOT(0),32-NZB), IZP-1)))
-C + , ISHFTR (LSHIFT(MZ,32-NZB), 33-IZP-NZB) )
-#endif
-
-#elif defined(CERNLIB_QF_SIEM)
- MSBYT (MZ,IZW,IZP,NZB) = LOR (
- + LAND (IZW, LCOMPL(SHFTL (SHFTR(-1,32-NZB), IZP-1)))
- + , SHFTR (SHFTL(MZ,32-NZB), 33-IZP-NZB) )
-
-#elif defined(CERNLIB_LINUX) && !defined(CERNLIB_GFORTRAN)
- MSBYT (MZ,IZW,IZP,NZB) = OR (
- + AND (IZW, NOT(LSHIFT (ISHFTR(NOT(0),32-NZB),IZP-1)))
- + ,ISHFTR (LSHIFT(MZ,32-NZB), 33-IZP-NZB) )
-
-#elif defined(CERNLIB_PDP)
- MSBYT (MZ,IZW,IZP,NZB) = IOR (
- + IAND (IZW, NOT(ISHFT (ISHFT(NOT(0),-36+NZB), IZP-1)))
- + , ISHFT (ISHFT(MZ, 36-NZB), -37+IZP+NZB) )
-
-#elif defined(CERNLIB_VAXVMS)
-
-#elif defined(CERNLIB_QMVDS)
- MSBYT (MZ,IZW,IZP,NZB) = OR (
- + AND (IZW, NOT(LSHFT (RSHFT(NOT(0),32-NZB), IZP-1)))
- + , RSHFT (LSHFT(MZ,32-NZB), 33-IZP-NZB) )
-
-#elif 1
- MSBYT (MZ,IZW,IZP,NZB) = IOR (
- + IAND (IZW, NOT(ISHFT (ISHFT(NOT(0),-32+NZB), IZP-1)))
- + , ISHFT (ISHFT(MZ,32-NZB), -33+IZP+NZB) )
-#endif
-
-#endif
diff --git a/src/packlib/zebra/zebra/q_shift.inc b/src/packlib/zebra/zebra/q_shift.inc
deleted file mode 100644
index ee7fb1b..0000000
--- a/src/packlib/zebra/zebra/q_shift.inc
+++ /dev/null
@@ -1,61 +0,0 @@
-*
-* $Id: q_shift.inc,v 1.2 2006/09/15 09:35:34 mclareni Exp $
-*
-* $Log: q_shift.inc,v $
-* Revision 1.2 2006/09/15 09:35:34 mclareni
-* Submitted mods for gcc4/gfortran and MacOSX, corrected to work also on slc4 with gcc3.4 and 4.1
-*
-* Revision 1.1.1.1 1996/03/06 10:46:52 mclareni
-* Zebra
-*
-*
-#ifndef CERNLIB_ZEBRA_Q_SHIFT_INC
-#define CERNLIB_ZEBRA_Q_SHIFT_INC
-*
-*
-* q_shift.inc
-*
-#if defined(CERNLIB_APOLLO)
- ISHFTL (IZW,NZB) = LSHFT (IZW, NZB)
- ISHFTR (IZW,NZB) = RSHFT (IZW, NZB)
-
-#elif defined(CERNLIB_CDC)
- ISHFTL (IZW,NZB) = SHIFT (IZW,NZB) .AND. MASK(60-NZB)
- ISHFTR (IZW,NZB) = SHIFT (IZW.AND.MASK(60-NZB), 60-NZB)
-
-#elif defined(CERNLIB_CRAY)
- ISHFTL (IZW,NZB) = SHIFTL (IZW, NZB)
- ISHFTR (IZW,NZB) = SHIFTR (IZW, NZB)
-
-#elif (defined(CERNLIB_MSDOS))&&(defined(CERNLIB_QF_F2C))
-C--
-C-- Note: RSHIFT is arithmetic with F2C, it cannot be used
-C
- ISHFTL(IZW,NZB) = LSHIFT(IZW,NZB)
-C ISHFTR(IZW,NZB) = RSHIFT(IZW,NZB)
-C ISHFT(IZW,NZB) = LSHIFT(IZW,NZB)
-
-#elif defined(CERNLIB_QF_SIEM)
- ISHFTL (IZW,NZB) = SHFTL (IZW, NZB)
- ISHFTR (IZW,NZB) = SHFTR (IZW, NZB)
-
-#elif defined(CERNLIB_LINUX) && !defined(CERNLIB_GFORTRAN)
- ISHFTL (IZW,NZB) = LSHIFT (IZW,NZB)
-
-#elif (defined(CERNLIB_SUN))&&(!defined(CERNLIB_BUGLRSHFT))
- ISHFTL (IZW,NZB) = LSHIFT (IZW, NZB)
- ISHFTR (IZW,NZB) = lrshft (IZW, NZB)
-#elif (defined(CERNLIB_SUN))&&(defined(CERNLIB_BUGLRSHFT))
- ISHFTL (IZW,NZB) = LSHIFT (IZW, NZB)
- ISHFTR (IZW,NZB) = ishft (IZW,-NZB)
-
-#elif defined(CERNLIB_QMVDS)
-C ISHFTL / ISHFTR are intrinsics of vdS
-
-#elif 1
- ISHFTL (IZW,NZB) = ISHFT (IZW, NZB)
- ISHFTR (IZW,NZB) = ISHFT (IZW,-NZB)
-
-#endif
-
-#endif
diff --git a/src/packlib/zebra/zebra/q_shiftl.inc b/src/packlib/zebra/zebra/q_shiftl.inc
deleted file mode 100644
index 56dd94c..0000000
--- a/src/packlib/zebra/zebra/q_shiftl.inc
+++ /dev/null
@@ -1,50 +0,0 @@
-*
-* $Id: q_shiftl.inc,v 1.2 2006/09/15 09:35:34 mclareni Exp $
-*
-* $Log: q_shiftl.inc,v $
-* Revision 1.2 2006/09/15 09:35:34 mclareni
-* Submitted mods for gcc4/gfortran and MacOSX, corrected to work also on slc4 with gcc3.4 and 4.1
-*
-* Revision 1.1 1996/04/18 16:15:25 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-*
-*
-#ifndef CERNLIB_ZEBRA_Q_SHIFTL_INC
-#define CERNLIB_ZEBRA_Q_SHIFTL_INC
-*
-*
-* q_shiftl.inc
-*
-#if defined(CERNLIB_APOLLO)
- ISHFTL (IZW,NZB) = LSHFT (IZW, NZB)
-
-#elif defined(CERNLIB_CDC)
- ISHFTL (IZW,NZB) = SHIFT (IZW,NZB) .AND. MASK(60-NZB)
-
-#elif defined(CERNLIB_CRAY)
- ISHFTL (IZW,NZB) = SHIFTL (IZW, NZB)
-
-#elif (defined(CERNLIB_MSDOS))&&(defined(CERNLIB_QF_F2C))
- ISHFTL(IZW,NZB) = LSHIFT(IZW,NZB)
-
-#elif defined(CERNLIB_QF_SIEM)
- ISHFTL (IZW,NZB) = SHFTL (IZW, NZB)
-
-#elif defined(CERNLIB_LINUX) && !defined(CERNLIB_GFORTRAN)
- ISHFTL (IZW,NZB) = LSHIFT (IZW,NZB)
-
-#elif (defined(CERNLIB_SUN))&&(!defined(CERNLIB_BUGLRSHFT))
- ISHFTL (IZW,NZB) = LSHIFT (IZW, NZB)
-#elif (defined(CERNLIB_SUN))&&(defined(CERNLIB_BUGLRSHFT))
- ISHFTL (IZW,NZB) = LSHIFT (IZW, NZB)
-
-#elif defined(CERNLIB_QMVDS)
-C ISHFTL / ISHFTR are intrinsics of vdS
-
-#elif 1
- ISHFTL (IZW,NZB) = ISHFT (IZW, NZB)
-
-#endif
-
-#endif
diff --git a/src/packlib/zebra/zebra/q_shiftr.inc b/src/packlib/zebra/zebra/q_shiftr.inc
deleted file mode 100644
index 4bb433c..0000000
--- a/src/packlib/zebra/zebra/q_shiftr.inc
+++ /dev/null
@@ -1,53 +0,0 @@
-*
-* $Id: q_shiftr.inc,v 1.2 2006/09/15 09:35:34 mclareni Exp $
-*
-* $Log: q_shiftr.inc,v $
-* Revision 1.2 2006/09/15 09:35:34 mclareni
-* Submitted mods for gcc4/gfortran and MacOSX, corrected to work also on slc4 with gcc3.4 and 4.1
-*
-* Revision 1.1 1996/04/18 16:15:25 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-*
-*
-#ifndef CERNLIB_ZEBRA_Q_SHIFTR_INC
-#define CERNLIB_ZEBRA_Q_SHIFTR_INC
-*
-*
-* q_shiftr.inc
-*
-#if defined(CERNLIB_APOLLO)
- ISHFTR (IZW,NZB) = RSHFT (IZW, NZB)
-
-#elif defined(CERNLIB_CDC)
- ISHFTR (IZW,NZB) = SHIFT (IZW.AND.MASK(60-NZB), 60-NZB)
-
-#elif defined(CERNLIB_CRAY)
- ISHFTR (IZW,NZB) = SHIFTR (IZW, NZB)
-
-#elif (defined(CERNLIB_MSDOS))&&(defined(CERNLIB_QF_F2C))
-C--
-C-- Note: RSHIFT is arithmetic with F2C, it cannot be used
-C
-C ISHFTR(IZW,NZB) = RSHIFT(IZW,NZB)
-C ISHFT(IZW,NZB) = LSHIFT(IZW,NZB)
-
-#elif defined(CERNLIB_QF_SIEM)
- ISHFTR (IZW,NZB) = SHFTR (IZW, NZB)
-
-#elif defined(CERNLIB_LINUX) && !defined(CERNLIB_GFORTRAN)
-
-#elif (defined(CERNLIB_SUN))&&(!defined(CERNLIB_BUGLRSHFT))
- ISHFTR (IZW,NZB) = lrshft (IZW, NZB)
-#elif (defined(CERNLIB_SUN))&&(defined(CERNLIB_BUGLRSHFT))
- ISHFTR (IZW,NZB) = ishft (IZW,-NZB)
-
-#elif defined(CERNLIB_QMVDS)
-C ISHFTL / ISHFTR are intrinsics of vdS
-
-#elif 1
- ISHFTR (IZW,NZB) = ISHFT (IZW,-NZB)
-
-#endif
-
-#endif
diff --git a/src/packlib/zebra/zebra/q_xor.inc b/src/packlib/zebra/zebra/q_xor.inc
deleted file mode 100644
index 2ac3cb8..0000000
--- a/src/packlib/zebra/zebra/q_xor.inc
+++ /dev/null
@@ -1,40 +0,0 @@
-*
-* $Id: q_xor.inc,v 1.2 2006/09/15 09:35:34 mclareni Exp $
-*
-* $Log: q_xor.inc,v $
-* Revision 1.2 2006/09/15 09:35:34 mclareni
-* Submitted mods for gcc4/gfortran and MacOSX, corrected to work also on slc4 with gcc3.4 and 4.1
-*
-* Revision 1.1 1996/04/18 16:15:26 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-*
-*
-#ifndef CERNLIB_ZEBRA_Q_XOR_INC
-#define CERNLIB_ZEBRA_Q_XOR_INC
-*
-* q_xor.inc
-*
-#if defined(CERNLIB_APOLLO)
- IEOR (IZV,IZW) = XOR (IZV, IZW)
-
-#elif defined(CERNLIB_CDC)
- IEOR (IZV,IZW) = IZV .XOR. IZW
-
-#elif defined(CERNLIB_MSDOS)&&defined(CERNLIB_QF_F2C)
- IEOR(IZV,IZW) = XOR(IZV,IZW)
-
-#elif defined(CERNLIB_QMIBMSI)
- IEOR (IZV,IZW) = LXOR (IZV, IZW)
-
-#elif defined(CERNLIB_LNX) && !defined(CERNLIB_GFORTRAN)
- IEOR(IZV,IZW) = XOR(IZV,IZW)
-
-#elif defined(CERNLIB_SUN)
- IEOR (IZV,IZW) = XOR (IZV, IZW)
-
-#elif 1
-
-#endif
-
-#endif
diff --git a/src/packlib/zebra/zebra/qcardl.inc b/src/packlib/zebra/zebra/qcardl.inc
deleted file mode 100644
index 4c4af5a..0000000
--- a/src/packlib/zebra/zebra/qcardl.inc
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: qcardl.inc,v 1.1.1.1 1996/03/06 10:46:55 mclareni Exp $
-*
-* $Log: qcardl.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:46:55 mclareni
-* Zebra
-*
-*
-#ifndef CERNLIB_ZEBRA_QCARDL_INC
-#define CERNLIB_ZEBRA_QCARDL_INC
-*
-*
-* qcardl.inc
-*
-#if (defined(CERNLIB_A4)||defined(CERNLIB_A5)||defined(CERNLIB_A6)||defined(CERNLIB_A8)||defined(CERNLIB_A10))&&(defined(CERNLIB_A10)||defined(CERNLIB_A8)||defined(CERNLIB_A6)||defined(CERNLIB_A5))
-#endif
-#if (defined(CERNLIB_A5M)||defined(CERNLIB_A6M)||defined(CERNLIB_A8M))&&(defined(CERNLIB_A6M)||defined(CERNLIB_A8M))&&(defined(CERNLIB_A8M))
-#endif
-#if (defined(CERNLIB_B32)||defined(CERNLIB_B36)||defined(CERNLIB_B48)||defined(CERNLIB_B60)||defined(CERNLIB_B64))&&(defined(CERNLIB_B64)||defined(CERNLIB_B60)||defined(CERNLIB_B48)||defined(CERNLIB_B36))
-#endif
-#if (defined(CERNLIB_B36M)||defined(CERNLIB_B48M)||defined(CERNLIB_B60M))&&(defined(CERNLIB_B48M)||defined(CERNLIB_B60M))&&(defined(CERNLIB_B60M))
-#endif
-
-#endif
diff --git a/src/packlib/zebra/zebra/qequ.inc b/src/packlib/zebra/zebra/qequ.inc
deleted file mode 100644
index 6160da2..0000000
--- a/src/packlib/zebra/zebra/qequ.inc
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: qequ.inc,v 1.1.1.1 1996/03/06 10:46:53 mclareni Exp $
-*
-* $Log: qequ.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:46:53 mclareni
-* Zebra
-*
-*
-#ifndef CERNLIB_ZEBRA_QEQU_INC
-#define CERNLIB_ZEBRA_QEQU_INC
-*
-*
-* qequ.inc
-*
- DIMENSION LQLUP(99), LQLORG(98),IQWIDN(97),IQWIDH(96)
- +, IQWNL(95), IQWNS(94), IQWND(93)
- EQUIVALENCE (LQLUP(8), LQLORG(7), IQWIDN(6), IQWIDH(5)
- +, IQWNL(4), IQWNS(3), IQWND(2), IQ(1))
-
-#endif
diff --git a/src/packlib/zebra/zebra/qstore.inc b/src/packlib/zebra/zebra/qstore.inc
deleted file mode 100644
index 1c04d18..0000000
--- a/src/packlib/zebra/zebra/qstore.inc
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: qstore.inc,v 1.1.1.1 1996/03/06 10:46:53 mclareni Exp $
-*
-* $Log: qstore.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:46:53 mclareni
-* Zebra
-*
-*
-#ifndef CERNLIB_ZEBRA_QSTORE_INC
-#define CERNLIB_ZEBRA_QSTORE_INC
-*
-*
-* qstore.inc
-*
- IF (JBYT(IXSTOR,27,6).NE.JQSTOR) CALL MZSDIV (IXSTOR,-7)
-* ------------- for ZEBRA MZ ------------------------------
-
-#endif
diff --git a/src/packlib/zebra/zebra/qstorjz.inc b/src/packlib/zebra/zebra/qstorjz.inc
deleted file mode 100644
index 803cd3b..0000000
--- a/src/packlib/zebra/zebra/qstorjz.inc
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: qstorjz.inc,v 1.1.1.1 1996/03/06 10:46:55 mclareni Exp $
-*
-* $Log: qstorjz.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:46:55 mclareni
-* Zebra
-*
-*
-#ifndef CERNLIB_ZEBRA_QSTORJZ_INC
-#define CERNLIB_ZEBRA_QSTORJZ_INC
-*
-*
-* qstorjz.inc
-*
- IF (JQSTOR.NE.JQSTJZ) CALL MZSDIV (IXSTJZ,-7)
-
-#endif
diff --git a/src/packlib/zebra/zebra/qtoabend.inc b/src/packlib/zebra/zebra/qtoabend.inc
deleted file mode 100644
index cb76b0f..0000000
--- a/src/packlib/zebra/zebra/qtoabend.inc
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: qtoabend.inc,v 1.1.1.1 1996/03/06 10:46:57 mclareni Exp $
-*
-* $Log: qtoabend.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:46:57 mclareni
-* Zebra
-*
-*
-#ifndef CERNLIB_ZEBRA_QTOABEND_INC
-#define CERNLIB_ZEBRA_QTOABEND_INC
-*
-* qtoabend.inc
-*
-#if defined(CERNLIB_IBM)||defined(CERNLIB_IBMD)
-* FORCE LAST LINE TO BE OUT OF THE BUFFER
-*
- WRITE (IQLOG,9701)
- 9701 FORMAT ('0GOING TO ABEND.'/ 20(1X,20(1H*)/) )
- CALL ABEND
-#elif defined(CERNLIB_PDP)
- WRITE (IQLOG, 9701)
- 9701 FORMAT ('0GOING TO ABEND.', 4X, 20('*'))
- STOP '********************'
-#elif 1
- CALL ABEND
-#endif
-
-#endif
diff --git a/src/packlib/zebra/zebra/qtofatal.inc b/src/packlib/zebra/zebra/qtofatal.inc
deleted file mode 100644
index ced7f27..0000000
--- a/src/packlib/zebra/zebra/qtofatal.inc
+++ /dev/null
@@ -1,31 +0,0 @@
-*
-* $Id: qtofatal.inc,v 1.1.1.1 1996/03/06 10:46:54 mclareni Exp $
-*
-* $Log: qtofatal.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:46:54 mclareni
-* Zebra
-*
-*
-#ifndef CERNLIB_ZEBRA_QTOFATAL_INC
-#define CERNLIB_ZEBRA_QTOFATAL_INC
-*
-*
-* qtofatal.inc
-*
-#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
- IQUEST(10)= NAMESR
- CALL ZFATAL
-#elif defined(CERNLIB_QTRHOLL)
- IQUEST(9) = NAMESR(1)
- IQUEST(10)= NAMESR(2)
- CALL ZFATAL
-#elif defined(CERNLIB_A6M)
- CALL UCTOH (NAMESR,IQUEST(10),6,6)
- CALL ZFATAL
-#elif 1
- CALL UCTOH (NAMESR,IQUEST(9),4,8)
- CALL ZFATAL
-* ------------- for ZEBRA FZ ------------------------------
-
-#endif
-#endif
diff --git a/src/packlib/zebra/zebra/qtrace.inc b/src/packlib/zebra/zebra/qtrace.inc
deleted file mode 100644
index 5327114..0000000
--- a/src/packlib/zebra/zebra/qtrace.inc
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: qtrace.inc,v 1.1.1.1 1996/03/06 10:46:54 mclareni Exp $
-*
-* $Log: qtrace.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:46:54 mclareni
-* Zebra
-*
-*
-#ifndef CERNLIB_ZEBRA_QTRACE_INC
-#define CERNLIB_ZEBRA_QTRACE_INC
-*
-* with check on capacity MQTRAC
-*
-* qtrace.inc
-*
-#if !defined(CERNLIB_QTRHOLL)||defined(CERNLIB_A6M)
- MQTRAC(NQTRAC+1) = NAMESR
- NQTRAC = NQTRAC + 1
- IF (NQTRAC.GE.41) CALL ZFATAL
-#else
- MQTRAC(NQTRAC+1) = NAMESR(1)
- MQTRAC(NQTRAC+2) = NAMESR(2)
- NQTRAC = NQTRAC + 2
- IF (NQTRAC.GE.41) CALL ZFATAL
-#endif
-
-#endif
diff --git a/src/packlib/zebra/zebra/qtrace99.inc b/src/packlib/zebra/zebra/qtrace99.inc
deleted file mode 100644
index 174e535..0000000
--- a/src/packlib/zebra/zebra/qtrace99.inc
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: qtrace99.inc,v 1.1.1.1 1996/03/06 10:46:54 mclareni Exp $
-*
-* $Log: qtrace99.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:46:54 mclareni
-* Zebra
-*
-*
-#ifndef CERNLIB_ZEBRA_QTRACE99_INC
-#define CERNLIB_ZEBRA_QTRACE99_INC
-*
-*
-* qtrace99.inc
-*
-#if !defined(CERNLIB_QTRHOLL)||defined(CERNLIB_A6M)
- 999 NQTRAC = NQTRAC - 1
-#else
- 999 NQTRAC = NQTRAC - 2
-#endif
-
-#endif
diff --git a/src/packlib/zebra/zebra/qtraceq.inc b/src/packlib/zebra/zebra/qtraceq.inc
deleted file mode 100644
index 202bbf9..0000000
--- a/src/packlib/zebra/zebra/qtraceq.inc
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: qtraceq.inc,v 1.1.1.1 1996/03/06 10:46:54 mclareni Exp $
-*
-* $Log: qtraceq.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:46:54 mclareni
-* Zebra
-*
-*
-#ifndef CERNLIB_ZEBRA_QTRACEQ_INC
-#define CERNLIB_ZEBRA_QTRACEQ_INC
-*
-* without check on capacity
-*
-* qtraceq.inc
-*
-#if !defined(CERNLIB_QTRHOLL)||defined(CERNLIB_A6M)
- MQTRAC(NQTRAC+1) = NAMESR
- NQTRAC = NQTRAC + 1
-#else
- MQTRAC(NQTRAC+1) = NAMESR(1)
- MQTRAC(NQTRAC+2) = NAMESR(2)
- NQTRAC = NQTRAC + 2
-#endif
-
-#endif
diff --git a/src/packlib/zebra/zebra/quest.inc b/src/packlib/zebra/zebra/quest.inc
deleted file mode 100644
index 558fadb..0000000
--- a/src/packlib/zebra/zebra/quest.inc
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: quest.inc,v 1.1.1.1 1996/03/06 10:46:52 mclareni Exp $
-*
-* $Log: quest.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:46:52 mclareni
-* Zebra
-*
-*
-#ifndef CERNLIB_ZEBRA_QUEST_INC
-#define CERNLIB_ZEBRA_QUEST_INC
-*
-*
-* quest.inc
-*
- COMMON /QUEST/ IQUEST(100)
-
-#endif
diff --git a/src/packlib/zebra/zebra/questparq.inc b/src/packlib/zebra/zebra/questparq.inc
deleted file mode 100644
index 9db1d36..0000000
--- a/src/packlib/zebra/zebra/questparq.inc
+++ /dev/null
@@ -1,32 +0,0 @@
-*
-* $Id: questparq.inc,v 1.1.1.1 1996/03/06 10:46:57 mclareni Exp $
-*
-* $Log: questparq.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:46:57 mclareni
-* Zebra
-*
-*
-#ifndef CERNLIB_ZEBRA_QUESTPARQ_INC
-#define CERNLIB_ZEBRA_QUESTPARQ_INC
-*
-* Parameters defining the error handling in IQUEST
-*
-* questparq.inc
-*
- PARAMETER (MARE1Q=-1 ,MARE2Q=MARE1Q-1,MARE3Q=MARE2Q-1,
- X MARE4Q=MARE3Q-1,MARE5Q=MARE4Q-1,MARE6Q=MARE5Q-1,
- X MARE7Q=MARE6Q-1,MBKD1Q=MARE7Q-1,MBKD2Q=MBKD1Q-1,
- X MBKU1Q=MBKD2Q-1,MBKU2Q=MBKU1Q-1,MBKU3Q=MBKU2Q-1,
- X MBKU4Q=MBKU3Q-1,MBKX1Q=MBKU4Q-1,MBKX2Q=MBKX1Q-1,
- X MBKX3Q=MBKX2Q-1,MCHV1Q=MBKX3Q-1,MFOR1Q=MCHV1Q-1,
- X MFOR2Q=MFOR1Q-1,MFOR3Q=MFOR2Q-1,MIOP1Q=MFOR3Q-1,
- X MSHO1Q=MIOP1Q-1,MSHO2Q=MSHO1Q-1,MSHP1Q=MSHO2Q-1,
- X MSNA1Q=MSHP1Q-1,MSNA2Q=MSNA1Q-1,MSNA3Q=MSNA2Q-1,
- X MSNA4Q=MSNA3Q-1,MSNA5Q=MSNA4Q-1,MSNA6Q=MSNA5Q-1,
- X MSNA7Q=MSNA6Q-1,MSNA8Q=MSNA7Q-1,
- X MSUR1Q=MSNA8Q-1,MVER1Q=MSUR1Q-1,MVER2Q=MVER1Q-1,
- X MVER3Q=MVER2Q-1,MVER4Q=MVER3Q-1,MVER5Q=MVER4Q-1,
- X MVER6Q=MVER5Q-1,MVER7Q=MVER6Q-1,MVER8Q=MVER7Q-1,
- X MVER9Q=MVER8Q-1,MVE10Q=MVER9Q-1)
-
-#endif
diff --git a/src/packlib/zebra/zebra/qversion.inc b/src/packlib/zebra/zebra/qversion.inc
deleted file mode 100644
index 09394c2..0000000
--- a/src/packlib/zebra/zebra/qversion.inc
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: qversion.inc,v 1.4 2003/08/15 15:19:12 mclareni Exp $
-*
-* $Log: qversion.inc,v $
-* Revision 1.4 2003/08/15 15:19:12 mclareni
-* Version 3.79
-*
-* Revision 1.3 1999/06/18 12:04:48 couet
-* - The version is now defined in one central place
-*
-* Revision 1.2 1996/04/18 16:15:27 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:46:55 mclareni
-* Zebra
-*
-*
-#ifndef CERNLIB_ZEBRA_QVERSION_INC
-#define CERNLIB_ZEBRA_QVERSION_INC
-*
-* Version number
-*
- QVERSN = 3.79
-#endif
diff --git a/src/packlib/zebra/zebra/rzbmap.inc b/src/packlib/zebra/zebra/rzbmap.inc
deleted file mode 100644
index cc8e786..0000000
--- a/src/packlib/zebra/zebra/rzbmap.inc
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: rzbmap.inc,v 1.1.1.1 1996/03/06 10:46:55 mclareni Exp $
-*
-* $Log: rzbmap.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:46:55 mclareni
-* Zebra
-*
-*
-#ifndef CERNLIB_ZEBRA_RZBMAP_INC
-#define CERNLIB_ZEBRA_RZBMAP_INC
-*
-*
-* rzbmap.inc
-*
-*
-* Dummy RZBMAP sequence. To be overridden from cradle
-*
- PARAMETER(KDMAX=9)
- COMMON/RZBMAP/IDATA(KDMAX)
-
-#endif
diff --git a/src/packlib/zebra/zebra/rzbuff.inc b/src/packlib/zebra/zebra/rzbuff.inc
deleted file mode 100644
index 906327a..0000000
--- a/src/packlib/zebra/zebra/rzbuff.inc
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: rzbuff.inc,v 1.1.1.1 1996/03/06 10:46:54 mclareni Exp $
-*
-* $Log: rzbuff.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:46:54 mclareni
-* Zebra
-*
-*
-#ifndef CERNLIB_ZEBRA_RZBUFF_INC
-#define CERNLIB_ZEBRA_RZBUFF_INC
-*
-*
-* rzbuff.inc
-*
- COMMON /RZBUFF/ ITEST(8704)
-C
-
-#endif
diff --git a/src/packlib/zebra/zebra/rzch.inc b/src/packlib/zebra/zebra/rzch.inc
deleted file mode 100644
index 74676ab..0000000
--- a/src/packlib/zebra/zebra/rzch.inc
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: rzch.inc,v 1.1.1.1 1996/03/06 10:46:54 mclareni Exp $
-*
-* $Log: rzch.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:46:54 mclareni
-* Zebra
-*
-*
-#ifndef CERNLIB_ZEBRA_RZCH_INC
-#define CERNLIB_ZEBRA_RZCH_INC
-*
-*
-* rzch.inc
-*
- COMMON /RZCH/ CHWOLD,CHL
- CHARACTER*255 CHWOLD,CHL
-C
-
-#endif
diff --git a/src/packlib/zebra/zebra/rzckey.inc b/src/packlib/zebra/zebra/rzckey.inc
deleted file mode 100644
index f7301ad..0000000
--- a/src/packlib/zebra/zebra/rzckey.inc
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: rzckey.inc,v 1.1.1.1 1996/03/06 10:46:55 mclareni Exp $
-*
-* $Log: rzckey.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:46:55 mclareni
-* Zebra
-*
-*
-#ifndef CERNLIB_ZEBRA_RZCKEY_INC
-#define CERNLIB_ZEBRA_RZCKEY_INC
-*
-*
-* rzckey.inc
-*
- COMMON/RZCKEY/IHEAD(3),KEY(100),KEY2(100),KEYDUM(50)
-C
-
-#endif
diff --git a/src/packlib/zebra/zebra/rzcl.inc b/src/packlib/zebra/zebra/rzcl.inc
deleted file mode 100644
index 24d13ed..0000000
--- a/src/packlib/zebra/zebra/rzcl.inc
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: rzcl.inc,v 1.1.1.1 1996/03/06 10:46:55 mclareni Exp $
-*
-* $Log: rzcl.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:46:55 mclareni
-* Zebra
-*
-*
-#ifndef CERNLIB_ZEBRA_RZCL_INC
-#define CERNLIB_ZEBRA_RZCL_INC
-*
-*
-* rzcl.inc
-*
-#include "zebra/mqsys.inc"
-C
-#include "zebra/rzclxx.inc"
-#include "zebra/eqlqr.inc"
-C
-* ------------- for ZEBRA CQ ------------------------------
-
-#endif
diff --git a/src/packlib/zebra/zebra/rzclun.inc b/src/packlib/zebra/zebra/rzclun.inc
deleted file mode 100644
index 5dc25ef..0000000
--- a/src/packlib/zebra/zebra/rzclun.inc
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: rzclun.inc,v 1.1.1.1 1996/03/06 10:46:54 mclareni Exp $
-*
-* $Log: rzclun.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:46:54 mclareni
-* Zebra
-*
-*
-#ifndef CERNLIB_ZEBRA_RZCLUN_INC
-#define CERNLIB_ZEBRA_RZCLUN_INC
-*
-*
-* rzclun.inc
-*
- COMMON /RZCLUN/LUN,LREC,ISAVE,IMODEX,IRELAT,NHPWD,IHPWD(2)
- +, IZRECL,IMODEC,IMODEH
-C
-
-#endif
diff --git a/src/packlib/zebra/zebra/rzclxx.inc b/src/packlib/zebra/zebra/rzclxx.inc
deleted file mode 100644
index 26e07de..0000000
--- a/src/packlib/zebra/zebra/rzclxx.inc
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: rzclxx.inc,v 1.1.1.1 1996/03/06 10:46:55 mclareni Exp $
-*
-* $Log: rzclxx.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:46:55 mclareni
-* Zebra
-*
-*
-#ifndef CERNLIB_ZEBRA_RZCLXX_INC
-#define CERNLIB_ZEBRA_RZCLXX_INC
-*
-*
-* rzclxx.inc
-*
- COMMON /RZCL/ LTOP,LRZ0,LCDIR,LRIN,LROUT,LFREE,LUSED,LPURG
- +, LTEMP,LCORD,LFROM
-
-#endif
diff --git a/src/packlib/zebra/zebra/rzcount.inc b/src/packlib/zebra/zebra/rzcount.inc
deleted file mode 100644
index 682a00d..0000000
--- a/src/packlib/zebra/zebra/rzcount.inc
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: rzcount.inc,v 1.1.1.1 1996/03/06 10:46:55 mclareni Exp $
-*
-* $Log: rzcount.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:46:55 mclareni
-* Zebra
-*
-*
-#ifndef CERNLIB_ZEBRA_RZCOUNT_INC
-#define CERNLIB_ZEBRA_RZCOUNT_INC
-*
-* I/O counters
-*
-* rzcount.inc
-*
- COMMON/RZCOUNT/RZXIO(2)
-C
-
-#endif
diff --git a/src/packlib/zebra/zebra/rzcout.inc b/src/packlib/zebra/zebra/rzcout.inc
deleted file mode 100644
index 022182f..0000000
--- a/src/packlib/zebra/zebra/rzcout.inc
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: rzcout.inc,v 1.1.1.1 1996/03/06 10:46:55 mclareni Exp $
-*
-* $Log: rzcout.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:46:55 mclareni
-* Zebra
-*
-*
-#ifndef CERNLIB_ZEBRA_RZCOUT_INC
-#define CERNLIB_ZEBRA_RZCOUT_INC
-*
-*
-* rzcout.inc
-*
- COMMON /RZCOUT/IP1,IR1,IR2,IROUT,IRLOUT,IOPTRR
-C
-
-#endif
diff --git a/src/packlib/zebra/zebra/rzcstr.inc b/src/packlib/zebra/zebra/rzcstr.inc
deleted file mode 100644
index 19a00bc..0000000
--- a/src/packlib/zebra/zebra/rzcstr.inc
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: rzcstr.inc,v 1.1.1.1 1996/03/06 10:46:55 mclareni Exp $
-*
-* $Log: rzcstr.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:46:55 mclareni
-* Zebra
-*
-*
-#ifndef CERNLIB_ZEBRA_RZCSTR_INC
-#define CERNLIB_ZEBRA_RZCSTR_INC
-*
-*
-* rzcstr.inc
-*
- PARAMETER (MAXFILES=128, MAXSTRIP=21)
- CHARACTER*128 RZNAMES(MAXFILES),RZSFILE(MAXSTRIP)
- COMMON/RZCSTRC/RZNAMES,RZSFILE
- COMMON/RZCSTRI/ISLAST,ISTRIP(MAXFILES),NSTRIP(MAXFILES),
- + NRSTRIP(MAXFILES)
-C
-
-#endif
diff --git a/src/packlib/zebra/zebra/rzcycle.inc b/src/packlib/zebra/zebra/rzcycle.inc
deleted file mode 100644
index 7c44330..0000000
--- a/src/packlib/zebra/zebra/rzcycle.inc
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: rzcycle.inc,v 1.1.1.1 1996/03/06 10:46:55 mclareni Exp $
-*
-* $Log: rzcycle.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:46:55 mclareni
-* Zebra
-*
-*
-#ifndef CERNLIB_ZEBRA_RZCYCLE_INC
-#define CERNLIB_ZEBRA_RZCYCLE_INC
-*
-*
-* rzcycle.inc
-*
-*
-* Pointers to cycle content
-*
-* KLCYCL : length of cycle block (4,7)
-* KPPCYC : pointer to previous cycle
-* KFRCYC : first record number
-* KSRCYC : secord record number
-* KFLCYC : creation date/time and other stuff
-* KORCYC : offset in first record to data
-* KCNCYC : cycle number
-* KNWCYC : number of words in d/s
-* KKYCYC : key number to which this cycle belongs (only for version 1)
-* KVSCYC : version of RZ cycles structure (0, 1)
-*
- INTEGER KLCYCL, KPPCYC, KFRCYC, KSRCYC, KFLCYC, KORCYC,
- + KCNCYC, KNWCYC, KKYCYC, KVSCYC
- COMMON/RZCYCLE/KLCYCL, KPPCYC, KFRCYC, KSRCYC, KFLCYC, KORCYC,
- + KCNCYC, KNWCYC, KKYCYC, KVSCYC
-
-#endif
diff --git a/src/packlib/zebra/zebra/rzdir.inc b/src/packlib/zebra/zebra/rzdir.inc
deleted file mode 100644
index e075378..0000000
--- a/src/packlib/zebra/zebra/rzdir.inc
+++ /dev/null
@@ -1,21 +0,0 @@
-*
-* $Id: rzdir.inc,v 1.1.1.1 1996/03/06 10:46:54 mclareni Exp $
-*
-* $Log: rzdir.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:46:54 mclareni
-* Zebra
-*
-*
-#ifndef CERNLIB_ZEBRA_RZDIR_INC
-#define CERNLIB_ZEBRA_RZDIR_INC
-*
-*
-* rzdir.inc
-*
- PARAMETER (NLPATM=100)
- COMMON /RZDIRN/NLCDIR,NLNDIR,NLPAT
- COMMON /RZDIRC/CHCDIR(NLPATM),CHNDIR(NLPATM),CHPAT(NLPATM)
- CHARACTER*16 CHNDIR, CHCDIR, CHPAT
-C
-
-#endif
diff --git a/src/packlib/zebra/zebra/rzk.inc b/src/packlib/zebra/zebra/rzk.inc
deleted file mode 100644
index 7ee4ed1..0000000
--- a/src/packlib/zebra/zebra/rzk.inc
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: rzk.inc,v 1.1.1.1 1996/03/06 10:46:54 mclareni Exp $
-*
-* $Log: rzk.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:46:54 mclareni
-* Zebra
-*
-*
-#ifndef CERNLIB_ZEBRA_RZK_INC
-#define CERNLIB_ZEBRA_RZK_INC
-*
-*
-* rzk.inc
-*
- PARAMETER (KUP=5,KPW1=7,KNCH=9,KDATEC=10,KDATEM=11,KQUOTA=12,
- + KRUSED=13,KWUSED=14,KMEGA=15,KRZVER=16,KIRIN=17,
- + KIROUT=18,KRLOUT=19,KIP1=20,KNFREE=22,KNSD=23,KLD=24,
- + KLB=25,KLS=26,KLK=27,KLF=28,KLC=29,KLE=30,KNKEYS=31,
- + KNWKEY=32,KKDES=33,KNSIZE=253,KEX=6,KNMAX=100)
-C
-
-#endif
diff --git a/src/packlib/zebra/zebra/rzover.inc b/src/packlib/zebra/zebra/rzover.inc
deleted file mode 100644
index 8231bf8..0000000
--- a/src/packlib/zebra/zebra/rzover.inc
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: rzover.inc,v 1.1.1.1 1996/03/06 10:46:55 mclareni Exp $
-*
-* $Log: rzover.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:46:55 mclareni
-* Zebra
-*
-*
-#ifndef CERNLIB_ZEBRA_RZOVER_INC
-#define CERNLIB_ZEBRA_RZOVER_INC
-*
-*
-* rzover.inc
-*
-*
-* List of overwritten records
-*
- PARAMETER(MAXBAD=100)
- COMMON/RZOVER/NBAD,IBAD(MAXBAD)
-*
-
-#endif
diff --git a/src/packlib/zebra/zebra/storparq.inc b/src/packlib/zebra/zebra/storparq.inc
deleted file mode 100644
index 01bd2f3..0000000
--- a/src/packlib/zebra/zebra/storparq.inc
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: storparq.inc,v 1.1.1.1 1996/03/06 10:46:57 mclareni Exp $
-*
-* $Log: storparq.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:46:57 mclareni
-* Zebra
-*
-*
-#ifndef CERNLIB_ZEBRA_STORPARQ_INC
-#define CERNLIB_ZEBRA_STORPARQ_INC
-*
-* STORE PARAMETERS
-*
-* storparq.inc
-*
- PARAMETER(JSTCOQ=31,JSTIDQ=27,NSTIDQ=4,NSTTBQ=14)
- PARAMETER(MSYLAQ=1,MLAUSQ=1)
- PARAMETER(NLAENQ=5,MLAADQ=1,MLALTQ=MLAADQ+1)
- PARAMETER(MLANSQ=MLALTQ+1,MLAN1Q=MLANSQ+1,MLAN2Q=MLAN1Q+1)
- PARAMETER(JLANSQ=1,NLANSQ=15)
- PARAMETER(JLATMQ=31,NLATMQ=2,MLACTQ=1,MLATBQ=MLACTQ+1)
-
-#endif
diff --git a/src/packlib/zebra/zebra/tzc1.inc b/src/packlib/zebra/zebra/tzc1.inc
deleted file mode 100644
index 3d131a1..0000000
--- a/src/packlib/zebra/zebra/tzc1.inc
+++ /dev/null
@@ -1,27 +0,0 @@
-*
-* $Id: tzc1.inc,v 1.2 1996/04/18 16:15:28 mclareni Exp $
-*
-* $Log: tzc1.inc,v $
-* Revision 1.2 1996/04/18 16:15:28 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:46:56 mclareni
-* Zebra
-*
-*
-#ifndef CERNLIB_ZEBRA_TZC1_INC
-#define CERNLIB_ZEBRA_TZC1_INC
-*
-*
-* tzc1.inc
-*
- PARAMETER (LGL=240)
- CHARACTER LINE*(LGL), LHEAD*80, BLANK*(LGL)
- COMMON /TZC1/ LUNTQ, NREADY, NFATAL, IGNORE
- +, IFLLOG, IFLPRI, IFLUSE, IFLKIL, IFLANY
- +, IFLEXA, IFLSIZ, IFLTZU, IVALUS, JFMTC1, JFMTC2
- +, JCOLA, JCOLE, NCHPW, IFLHC, IFLHW, IFLDBL
- +, IFLPRE, NFAULT, LPUTA, LPUTX, LPUTE
- +, NCHORG, NHEAD, LINE, LHEAD, BLANK
-
-#endif
diff --git a/src/packlib/zebra/zebra/tzread1.inc b/src/packlib/zebra/zebra/tzread1.inc
deleted file mode 100644
index 6e2cd4f..0000000
--- a/src/packlib/zebra/zebra/tzread1.inc
+++ /dev/null
@@ -1,36 +0,0 @@
-*
-* $Id: tzread1.inc,v 1.2 1996/04/18 16:15:29 mclareni Exp $
-*
-* $Log: tzread1.inc,v $
-* Revision 1.2 1996/04/18 16:15:29 mclareni
-* Incorporate changes from J.Zoll for version 3.77
-*
-* Revision 1.1.1.1 1996/03/06 10:46:56 mclareni
-* Zebra
-*
-*
-#ifndef CERNLIB_ZEBRA_TZREAD1_INC
-#define CERNLIB_ZEBRA_TZREAD1_INC
-*
-*
-* tzread1.inc
-*
-#if defined(CERNLIB_QMIBM)
- READ (LUNTQ,NUM=NCH,END=78) LINE
- NCH = MIN (NCH,LGL)
- NCHORG = LNBLNK (LINE(1:NCH))
-#elif defined(CERNLIB_QMIBMD)
- READ (LUNTQ,NUM=NCH,END=78) LINE
- NCH = MIN (NCH,LGL)
- NCHORG = LNBLNK (LINE(1:NCH))
-#elif defined(CERNLIB_QMVAX)
- READ (LUNTQ,8000,END=78) NCH,LINE(1:MIN(NCH,LGL))
- NCH = MIN (NCH,LGL)
- NCHORG = LNBLNK (LINE(1:NCH))
- 8000 FORMAT (Q,A)
-#elif 1
- READ (LUNTQ,'(A)',END=78) LINE
- NCHORG = LENOCC (LINE)
-#endif
-
-#endif
diff --git a/src/packlib/zebra/zebra/tzread2.inc b/src/packlib/zebra/zebra/tzread2.inc
deleted file mode 100644
index 56290a6..0000000
--- a/src/packlib/zebra/zebra/tzread2.inc
+++ /dev/null
@@ -1,28 +0,0 @@
-*
-* $Id: tzread2.inc,v 1.1.1.1 1996/03/06 10:46:56 mclareni Exp $
-*
-* $Log: tzread2.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:46:56 mclareni
-* Zebra
-*
-*
-#ifndef CERNLIB_ZEBRA_TZREAD2_INC
-#define CERNLIB_ZEBRA_TZREAD2_INC
-*
-*
-* tzread2.inc
-*
-#if !defined(CERNLIB_CRAZYERR)
- READ (LUNTQ,LINE(JFMTC1:JFMTC2),END=96) (LQ(J),J=LPUTA,LPUTE-1)
-#else
- IF (NAME(5).NE.3) THEN
- READ (LUNTQ,LINE(JFMTC1:JFMTC2),ERR=64,END=96)
- + (LQ(J),J=LPUTA,LPUTE-1)
- ELSE
- READ (LUNTQ,LINE(JFMTC1:JFMTC2),ERR=64,END=96)
- + (Q(J),J=LPUTA-8,LPUTE-9)
- ENDIF
- 64 CONTINUE
-#endif
-
-#endif
diff --git a/src/packlib/zebra/zebra/tzuc.inc b/src/packlib/zebra/zebra/tzuc.inc
deleted file mode 100644
index 9880d4f..0000000
--- a/src/packlib/zebra/zebra/tzuc.inc
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: tzuc.inc,v 1.1.1.1 1996/03/06 10:46:56 mclareni Exp $
-*
-* $Log: tzuc.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:46:56 mclareni
-* Zebra
-*
-*
-#ifndef CERNLIB_ZEBRA_TZUC_INC
-#define CERNLIB_ZEBRA_TZUC_INC
-*
-*
-* tzuc.inc
-*
- COMMON /TZUC/ JSTOR,IXTITL, NPARA,LNEW,NWOCC,NAME(20)
-
-#endif
diff --git a/src/packlib/zebra/zebra/zbcd.inc b/src/packlib/zebra/zebra/zbcd.inc
deleted file mode 100644
index 508e3f8..0000000
--- a/src/packlib/zebra/zebra/zbcd.inc
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: zbcd.inc,v 1.1.1.1 1996/03/06 10:46:52 mclareni Exp $
-*
-* $Log: zbcd.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:46:52 mclareni
-* Zebra
-*
-*
-#ifndef CERNLIB_ZEBRA_ZBCD_INC
-#define CERNLIB_ZEBRA_ZBCD_INC
-*
-* BCD char. in CETA order with A1 format
-*
-* zbcd.inc
-*
- COMMON /ZBCD/ IQNUM2(11),IQLETT(26),IQNUM(10), IQPLUS,IQMINS
- +, IQSTAR,IQSLAS,IQOPEN,IQCLOS,IQDOLL,IQEQU, IQBLAN
- +, IQCOMA,IQDOT, IQNUMB,IQAPO, IQEXCL,IQCOLO,IQQUOT
- +, IQUNDE,IQCLSQ,IQAND, IQAT, IQQUES,IQOPSQ,IQGREA
- +, IQLESS,IQREVE,IQCIRC,IQSEMI,IQPERC, IQLOWL(26)
- +, IQCROP,IQVERT,IQCRCL,IQNOT, IQGRAV, IQILEG
- +, NQHOL0,NQHOLL(95)
-
-#endif
diff --git a/src/packlib/zebra/zebra/zbcdch.inc b/src/packlib/zebra/zebra/zbcdch.inc
deleted file mode 100644
index 2664d03..0000000
--- a/src/packlib/zebra/zebra/zbcdch.inc
+++ /dev/null
@@ -1,22 +0,0 @@
-*
-* $Id: zbcdch.inc,v 1.1.1.1 1996/03/06 10:46:52 mclareni Exp $
-*
-* $Log: zbcdch.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:46:52 mclareni
-* Zebra
-*
-*
-#ifndef CERNLIB_ZEBRA_ZBCDCH_INC
-#define CERNLIB_ZEBRA_ZBCDCH_INC
-*
-* BCD char. in CETA order as CHARACTER
-*
-* zbcdch.inc
-*
- CHARACTER CQALLC*96
- COMMON /ZBCDCH/ CQALLC
- CHARACTER*1 CQLETT(96), CQNUM(10)
- EQUIVALENCE (CQLETT(1),CQALLC(1:1))
- EQUIVALENCE (CQNUM(1), CQALLC(27:27))
-
-#endif
diff --git a/src/packlib/zebra/zebra/zbcdk.inc b/src/packlib/zebra/zebra/zbcdk.inc
deleted file mode 100644
index e6b846a..0000000
--- a/src/packlib/zebra/zebra/zbcdk.inc
+++ /dev/null
@@ -1,23 +0,0 @@
-*
-* $Id: zbcdk.inc,v 1.1.1.1 1996/03/06 10:46:57 mclareni Exp $
-*
-* $Log: zbcdk.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:46:57 mclareni
-* Zebra
-*
-*
-#ifndef CERNLIB_ZEBRA_ZBCDK_INC
-#define CERNLIB_ZEBRA_ZBCDK_INC
-*
-* BCD symbols in CHARACTER representation
-*
-* zbcdk.inc
-*
- PARAMETER (MPOSAQ= 1 ,MPOSBQ= 2 ,MPOSCQ= 3 ,MPOSDQ= 4 ,MPOSEQ= 5
- X ,MPOSFQ= 6 ,MPOSGQ= 7 ,MPOSHQ= 8 ,MPOSIQ= 9 ,MPOSJQ=10
- X ,MPOSKQ=11, MPOSLQ=12 ,MPOSMQ=13 ,MPOSNQ=14 ,MPOSOQ=15
- X ,MPOSPQ=16, MPOSQQ=17 ,MPOSRQ=18 ,MPOSSQ=19 ,MPOSTQ=20
- X ,MPOSUQ=21, MPOSVQ=22 ,MPOSWQ=23 ,MPOSXQ=24 ,MPOSYQ=25
- X ,MPOSZQ=26 )
-
-#endif
diff --git a/src/packlib/zebra/zebra/zceta.inc b/src/packlib/zebra/zebra/zceta.inc
deleted file mode 100644
index 6594655..0000000
--- a/src/packlib/zebra/zebra/zceta.inc
+++ /dev/null
@@ -1,34 +0,0 @@
-*
-* $Id: zceta.inc,v 1.1.1.1 1996/03/06 10:46:52 mclareni Exp $
-*
-* $Log: zceta.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:46:52 mclareni
-* Zebra
-*
-*
-#ifndef CERNLIB_ZEBRA_ZCETA_INC
-#define CERNLIB_ZEBRA_ZCETA_INC
-*
-* CETA values in internal order
-*
-* zceta.inc
-*
-#if defined (CERNLIB_CDC)
- PARAMETER (NQTCET=64)
- COMMON /ZCETA/ IQCETA(64), IQTCET(64)
-
-#elif defined (CERNLIB_PDP)
- PARAMETER (NQTCET=128)
- COMMON /ZCETA/ IQCETA(128),IQTCET(128)
-
-#elif defined (CERNLIB_QMUNO)
- PARAMETER (NQTCET=512)
- COMMON /ZCETA/ IQCETA(512),IQTCET(512)
-
-#elif 1
- PARAMETER (NQTCET=256)
- COMMON /ZCETA/ IQCETA(256),IQTCET(256)
-
-#endif
-
-#endif
diff --git a/src/packlib/zebra/zebra/zebq.inc b/src/packlib/zebra/zebra/zebq.inc
deleted file mode 100644
index 3967e8b..0000000
--- a/src/packlib/zebra/zebra/zebq.inc
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: zebq.inc,v 1.1.1.1 1996/03/06 10:46:53 mclareni Exp $
-*
-* $Log: zebq.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:46:53 mclareni
-* Zebra
-*
-*
-#ifndef CERNLIB_ZEBRA_ZEBQ_INC
-#define CERNLIB_ZEBRA_ZEBQ_INC
-*
-*
-* zebq.inc
-*
- COMMON /ZEBQ/ IQFENC(4), LQ(100)
- DIMENSION IQ(92), Q(92)
- EQUIVALENCE (IQ(1),LQ(9)), (Q(1),IQ(1))
-
-#endif
diff --git a/src/packlib/zebra/zebra/zfatalch.inc b/src/packlib/zebra/zebra/zfatalch.inc
deleted file mode 100644
index 3bf8357..0000000
--- a/src/packlib/zebra/zebra/zfatalch.inc
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: zfatalch.inc,v 1.1.1.1 1996/03/06 10:46:55 mclareni Exp $
-*
-* $Log: zfatalch.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:46:55 mclareni
-* Zebra
-*
-*
-#ifndef CERNLIB_ZEBRA_ZFATALCH_INC
-#define CERNLIB_ZEBRA_ZFATALCH_INC
-*
-*
-* zfatalch.inc
-*
- DATA INIT / 1234321 /
-
-#endif
diff --git a/src/packlib/zebra/zebra/zfatalre.inc b/src/packlib/zebra/zebra/zfatalre.inc
deleted file mode 100644
index b9375f7..0000000
--- a/src/packlib/zebra/zebra/zfatalre.inc
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: zfatalre.inc,v 1.1.1.1 1996/03/06 10:46:57 mclareni Exp $
-*
-* $Log: zfatalre.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:46:57 mclareni
-* Zebra
-*
-*
-#ifndef CERNLIB_ZEBRA_ZFATALRE_INC
-#define CERNLIB_ZEBRA_ZFATALRE_INC
-*
-*
-* zfatalre.inc
-*
- IF (NQINIT.EQ.INIT) RETURN
-
-#endif
diff --git a/src/packlib/zebra/zebra/zheadp.inc b/src/packlib/zebra/zebra/zheadp.inc
deleted file mode 100644
index 0ce0675..0000000
--- a/src/packlib/zebra/zebra/zheadp.inc
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: zheadp.inc,v 1.1.1.1 1996/03/06 10:46:52 mclareni Exp $
-*
-* $Log: zheadp.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:46:52 mclareni
-* Zebra
-*
-*
-#ifndef CERNLIB_ZEBRA_ZHEADP_INC
-#define CERNLIB_ZEBRA_ZHEADP_INC
-*
-* Page heading parameters
-*
-* zheadp.inc
-*
- COMMON /ZHEADP/IQHEAD(20),IQDATE,IQTIME,IQPAGE,NQPAGE(4)
-
-#endif
diff --git a/src/packlib/zebra/zebra/zkrakc.inc b/src/packlib/zebra/zebra/zkrakc.inc
deleted file mode 100644
index f1ad5b8..0000000
--- a/src/packlib/zebra/zebra/zkrakc.inc
+++ /dev/null
@@ -1,17 +0,0 @@
-*
-* $Id: zkrakc.inc,v 1.1.1.1 1996/03/06 10:46:52 mclareni Exp $
-*
-* $Log: zkrakc.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:46:52 mclareni
-* Zebra
-*
-*
-#ifndef CERNLIB_ZEBRA_ZKRAKC_INC
-#define CERNLIB_ZEBRA_ZKRAKC_INC
-*
-*
-* zkrakc.inc
-*
- COMMON /ZKRAKC/IQHOLK(120), IQKRAK(80), IQCETK(122)
-
-#endif
diff --git a/src/packlib/zebra/zebra/zkrakcc.inc b/src/packlib/zebra/zebra/zkrakcc.inc
deleted file mode 100644
index 5d6b11f..0000000
--- a/src/packlib/zebra/zebra/zkrakcc.inc
+++ /dev/null
@@ -1,25 +0,0 @@
-*
-* $Id: zkrakcc.inc,v 1.1.1.1 1996/03/06 10:46:52 mclareni Exp $
-*
-* $Log: zkrakcc.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:46:52 mclareni
-* Zebra
-*
-*
-#ifndef CERNLIB_ZEBRA_ZKRAKCC_INC
-#define CERNLIB_ZEBRA_ZKRAKCC_INC
-*
-*
-* zkrakcc.inc
-*
-#if defined(CERNLIB_EQUHOLCH)
- COMMON /ZKRAKC/IQHOLK(120), IQKRAK(80), IQCETK(122)
- CHARACTER CQHOLK*120
- EQUIVALENCE (CQHOLK,IQHOLK)
-#else
- COMMON /ZKRAKC/IQHOLK(120), IQKRAK(80), IQCETK(122)
- COMMON /ZCRAKC/CQHOLK
- CHARACTER CQHOLK*120
-#endif
-
-#endif
diff --git a/src/packlib/zebra/zebra/zkrakqu.inc b/src/packlib/zebra/zebra/zkrakqu.inc
deleted file mode 100644
index df51122..0000000
--- a/src/packlib/zebra/zebra/zkrakqu.inc
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: zkrakqu.inc,v 1.1.1.1 1996/03/06 10:46:57 mclareni Exp $
-*
-* $Log: zkrakqu.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:46:57 mclareni
-* Zebra
-*
-*
-#ifndef CERNLIB_ZEBRA_ZKRAKQU_INC
-#define CERNLIB_ZEBRA_ZKRAKQU_INC
-*
-*
-* zkrakqu.inc
-*
- COMMON /QUEST/ MODE, NWORDS, MFMT, MULT, NSEP, JNXGO
- +, JDO, JR, JTERM,MFLAG,JLRAN, JRRAN
- +, IFLBLT, FILL(87)
-
-#endif
diff --git a/src/packlib/zebra/zebra/zlimit.inc b/src/packlib/zebra/zebra/zlimit.inc
deleted file mode 100644
index 853348b..0000000
--- a/src/packlib/zebra/zebra/zlimit.inc
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: zlimit.inc,v 1.1.1.1 1996/03/06 10:46:52 mclareni Exp $
-*
-* $Log: zlimit.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:46:52 mclareni
-* Zebra
-*
-*
-#ifndef CERNLIB_ZEBRA_ZLIMIT_INC
-#define CERNLIB_ZEBRA_ZLIMIT_INC
-*
-* MZFLAG Limit parameters
-*
-* zlimit.inc
-*
- COMMON /ZLIMIT/LQLIML,LQLIMH
-
-#endif
diff --git a/src/packlib/zebra/zebra/zmach.inc b/src/packlib/zebra/zebra/zmach.inc
deleted file mode 100644
index 4ec58b1..0000000
--- a/src/packlib/zebra/zebra/zmach.inc
+++ /dev/null
@@ -1,20 +0,0 @@
-*
-* $Id: zmach.inc,v 1.1.1.1 1996/03/06 10:46:52 mclareni Exp $
-*
-* $Log: zmach.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:46:52 mclareni
-* Zebra
-*
-*
-#ifndef CERNLIB_ZEBRA_ZMACH_INC
-#define CERNLIB_ZEBRA_ZMACH_INC
-*
-* Machine parameters
-*
-* zmach.inc
-*
-#include "zebra/zmachfix.inc"
- COMMON /ZMACH/ NQBITW,NQBITC,NQCHAW
- +, NQLNOR,NQLMAX,NQLPTH,NQRMAX,IQLPCT,IQNIL
-
-#endif
diff --git a/src/packlib/zebra/zebra/zmachfix.inc b/src/packlib/zebra/zebra/zmachfix.inc
deleted file mode 100644
index c22b64d..0000000
--- a/src/packlib/zebra/zebra/zmachfix.inc
+++ /dev/null
@@ -1,38 +0,0 @@
-*
-* $Id: zmachfix.inc,v 1.1.1.1 1996/03/06 10:46:52 mclareni Exp $
-*
-* $Log: zmachfix.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:46:52 mclareni
-* Zebra
-*
-*
-#ifndef CERNLIB_ZEBRA_ZMACHFIX_INC
-#define CERNLIB_ZEBRA_ZMACHFIX_INC
-*
-*
-* zmachfix.inc
-*
-#if defined (CERNLIB_UNIX)
- PARAMETER (IQBITW=32, IQBITC=8, IQCHAW=4)
-
-#elif defined (CERNLIB_CDC)
- PARAMETER (IQBITW=60, IQBITC=6, IQCHAW=10)
-
-#elif defined (CERNLIB_CRAY)
- PARAMETER (IQBITW=64, IQBITC=8, IQCHAW=8)
-
-#elif (defined (CERNLIB_CONVEX))&&(!defined(CERNLIB_DOUBLE))
- PARAMETER (IQBITW=64, IQBITC=8, IQCHAW=8)
-
-#elif defined (CERNLIB_PDP)
- PARAMETER (IQBITW=36, IQBITC=7, IQCHAW=5)
-
-#elif defined (CERNLIB_QMUNO)
- PARAMETER (IQBITW=36, IQBITC=9, IQCHAW=4)
-
-#elif 1
- PARAMETER (IQBITW=32, IQBITC=8, IQCHAW=4)
-
-#endif
-
-#endif
diff --git a/src/packlib/zebra/zebra/znatur.inc b/src/packlib/zebra/zebra/znatur.inc
deleted file mode 100644
index 3c3881e..0000000
--- a/src/packlib/zebra/zebra/znatur.inc
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: znatur.inc,v 1.1.1.1 1996/03/06 10:46:52 mclareni Exp $
-*
-* $Log: znatur.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:46:52 mclareni
-* Zebra
-*
-*
-#ifndef CERNLIB_ZEBRA_ZNATUR_INC
-#define CERNLIB_ZEBRA_ZNATUR_INC
-*
-* Constants of Nature
-*
-* znatur.inc
-*
- COMMON /ZNATUR/QPI2,QPI,QPIBY2,QPBYHR
-
-#endif
diff --git a/src/packlib/zebra/zebra/zstate.inc b/src/packlib/zebra/zebra/zstate.inc
deleted file mode 100644
index 1dfe504..0000000
--- a/src/packlib/zebra/zebra/zstate.inc
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: zstate.inc,v 1.1.1.1 1996/03/06 10:46:52 mclareni Exp $
-*
-* $Log: zstate.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:46:52 mclareni
-* Zebra
-*
-*
-#ifndef CERNLIB_ZEBRA_ZSTATE_INC
-#define CERNLIB_ZEBRA_ZSTATE_INC
-*
-* Program Status parameters
-*
-* zstate.inc
-*
- COMMON /ZSTATE/QVERSN,NQPHAS,IQDBUG,NQDCUT,NQWCUT,NQERR
- +, NQLOGD,NQLOGM,NQLOCK,NQDEVZ,NQOPTS(6)
-
-#endif
diff --git a/src/packlib/zebra/zebra/zunit.inc b/src/packlib/zebra/zebra/zunit.inc
deleted file mode 100644
index c0a1cb0..0000000
--- a/src/packlib/zebra/zebra/zunit.inc
+++ /dev/null
@@ -1,19 +0,0 @@
-*
-* $Id: zunit.inc,v 1.1.1.1 1996/03/06 10:46:52 mclareni Exp $
-*
-* $Log: zunit.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:46:52 mclareni
-* Zebra
-*
-*
-#ifndef CERNLIB_ZEBRA_ZUNIT_INC
-#define CERNLIB_ZEBRA_ZUNIT_INC
-*
-* Logical Unit Numbers
-*
-* zunit.inc
-*
- COMMON /ZUNIT/ IQREAD,IQPRNT,IQPR2,IQLOG,IQPNCH,IQTTIN,IQTYPE
- COMMON /ZUNITZ/IQDLUN,IQFLUN,IQHLUN, NQUSED
-
-#endif
diff --git a/src/packlib/zebra/zebra/zvfaut.inc b/src/packlib/zebra/zebra/zvfaut.inc
deleted file mode 100644
index 5fb1a27..0000000
--- a/src/packlib/zebra/zebra/zvfaut.inc
+++ /dev/null
@@ -1,18 +0,0 @@
-*
-* $Id: zvfaut.inc,v 1.1.1.1 1996/03/06 10:46:52 mclareni Exp $
-*
-* $Log: zvfaut.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:46:52 mclareni
-* Zebra
-*
-*
-#ifndef CERNLIB_ZEBRA_ZVFAUT_INC
-#define CERNLIB_ZEBRA_ZVFAUT_INC
-*
-* Automatic verify parameters
-*
-* zvfaut.inc
-*
- COMMON /ZVFAUT/IQVID(2),IQVSTA,IQVLOG,IQVTHR(2),IQVREM(2,6)
-
-#endif
diff --git a/src/packlib/zebra/zebra/zvfwkc.inc b/src/packlib/zebra/zebra/zvfwkc.inc
deleted file mode 100644
index f1de917..0000000
--- a/src/packlib/zebra/zebra/zvfwkc.inc
+++ /dev/null
@@ -1,24 +0,0 @@
-*
-* $Id: zvfwkc.inc,v 1.1.1.1 1996/03/06 10:46:53 mclareni Exp $
-*
-* $Log: zvfwkc.inc,v $
-* Revision 1.1.1.1 1996/03/06 10:46:53 mclareni
-* Zebra
-*
-*
-#ifndef CERNLIB_ZEBRA_ZVFWKC_INC
-#define CERNLIB_ZEBRA_ZVFWKC_INC
-*
-* ZVERIF working area
-*
-* zvfwkc.inc
-*
- CHARACTER CHWARN*10, TEXTHD*50
- COMMON /ZVFWKC/MASKST,IFLHD,NFATAL,NWARN, LFAILS,LFAILD,IXVSTO
- +, JVMODE,IFLST,IFLLA,IFLDV,IFLBK
- +, LSTOLO,LSTOHI, JDESLA,LOCAR,LOCARR,LOCARE,LATMP
- +, LDIVLO,LDIVHI,MASKTO
- +, LBKLS,IDBK(2),NBKNN(4),LBKLN,LBKNX,IBKXX
- +, NAMEPR(2), CHWARN,TEXTHD
-
-#endif
diff --git a/src/patchy/Imakefile b/src/patchy/Imakefile
deleted file mode 100644
index bee379b..0000000
--- a/src/patchy/Imakefile
+++ /dev/null
@@ -1,132 +0,0 @@
-
-
-
-/*
- * Special Imakefile building patchy modules
- *
- */
-all:: ProgramTargetName(nypatchy)
-all:: ProgramTargetName(nycheck)
-all:: ProgramTargetName(nydiff)
-all:: ProgramTargetName(nyindex)
-all:: ProgramTargetName(nylist)
-all:: ProgramTargetName(nymerge)
-all:: ProgramTargetName(nyshell)
-all:: ProgramTargetName(nysynopt)
-all:: ProgramTargetName(nytidy)
-
-#ifdef CERNLIB_UNIX
-.PHONY: P4LINKS
-install.bin:: P4LINKS
-InstallProgram(fcasplit,$(CERN_BINDIR))
-#endif
-
-InstallScript(yexpand,$(CERN_BINDIR))
-InstallProgram(nypatchy,$(CERN_BINDIR))
-InstallProgram(nycheck,$(CERN_BINDIR))
-InstallProgram(nydiff,$(CERN_BINDIR))
-InstallProgram(nyindex,$(CERN_BINDIR))
-InstallProgram(nylist,$(CERN_BINDIR))
-InstallProgram(nymerge,$(CERN_BINDIR))
-InstallProgram(nyshell,$(CERN_BINDIR))
-InstallProgram(nysynopt,$(CERN_BINDIR))
-InstallProgram(nytidy,$(CERN_BINDIR))
-
-P5LIB=LibraryTargetName(p5lib)
-
-CernlibFortranProgramTarget(nypatchy,nypatchy.o,$(P5LIB),$(P5LIB),kernlib)
-CernlibFortranProgramTarget(nycheck,nycheck.o,$(P5LIB),$(P5LIB),kernlib)
-CernlibFortranProgramTarget(nydiff,nydiff.o,$(P5LIB),$(P5LIB),kernlib)
-CernlibFortranProgramTarget(nyindex,nyindex.o,$(P5LIB),$(P5LIB),kernlib)
-CernlibFortranProgramTarget(nylist,nylist.o,$(P5LIB),$(P5LIB),kernlib)
-CernlibFortranProgramTarget(nymerge,nymerge.o,$(P5LIB),$(P5LIB),kernlib)
-CernlibFortranProgramTarget(nyshell,nyshell.o,$(P5LIB),$(P5LIB),kernlib)
-CernlibFortranProgramTarget(nysynopt,nysynopt.o,$(P5LIB),$(P5LIB),kernlib)
-CernlibFortranProgramTarget(nytidy,nytidy.o,$(P5LIB),$(P5LIB),kernlib)
-
-#ifdef CERNLIB_UNIX
-
-comma:= ,
-empty:=
-space:= $(empty) $(empty)
-PLINAME=$(subst $(space),$(comma),$(strip $(subst -DCERNLIB_,,CernlibSystem)))
-LDIR=$(TOP)$(CURRENT_DIR)/
-
-$(P5LIB): $(LDIR)patchy.car $(LDIR)p5lib.cra p5lib.libmake fcasplit Makefile
- ypatchy - p5lib p5lib TTY .go
- fcasplit p5lib.f
- RemoveFile(p5lib.f)
- cat p5lib.libmake >> p5lib.mkfca
-#if defined(CERNLIB_GFORTRAN)
- sed -e 's;f77;gfortran;' -e 's;g77;gfortran;' -e 's;-Nx800;;' \
- -e 's;-Nc200;;' -e 's;+ppu;;' p5lib.mkfca > p5lib.mkfca.mod
- sed -e 's;f77;gfortran;' -e 's;g77;gfortran;' -e 's;-Nx800;;' \
- -e 's;-Nc200;;' -e 's;+ppu;;' p5lib.shfca > p5lib.shfca.mod
- mv p5lib.mkfca.mod p5lib.mkfca
- mv p5lib.shfca.mod p5lib.shfca
-#endif
- $(MAKE) -f p5lib.mkfca $@
- RemoveFile(p5lib.mkfca)
- RemoveFile(p5lib.shfca)
-
-p5lib.libmake: Makefile
- RemoveFile($@)
- echo "libp5lib.a: \$$(ROUTINES)" > $@
- echo " ar cr \$$(@) \$$(ROUTINES)" >> $@
- echo " [ -x /usr/bin/ranlib ] && /usr/bin/ranlib \$$(@) || true" >>$@
- echo " rm -f \$$(ROUTINES)" >> $@
- echo " rm -f \$$(subst .o,.f,\$$(ROUTINES))" >> $@
-
-fcasplit: fcasplit.o
- $(F77) $< -o $@
-
-$(LDIR)%.cra: %.cra $(LDIR)yexpand
- PLINAME=$(PLINAME);export PLINAME;$(LDIR)yexpand $< $@
-
-$(LDIR)patchy.car: patchy.car
- @ ln -s $< $@
-
-%.f: $(LDIR)%.cra $(LDIR)patchy.car
- ypatchy - $@ $< TTY .go
-
-.f.o:
- $(FC) -c $(FORTRANOPTIONS) $(FDEBUGFLAGS) $<
-
-$(LDIR)yexpand: yexpand.script
- @cp $< $@
- @chmod +x $@
-
-/* Links to patchy 4.15 */
-YMODULES=ycompar yedit yfrceta yindex yindexb ylist ypatchy \
- ysearch yshift ytobcd ytobin ytoceta
-
-P4LINKS: $(foreach yp,$(YMODULES),$(CERN_BINDIR)$(yp))
-
-$(foreach yp,$(YMODULES),$(CERN_BINDIR)$(yp)):
- cd $(dir $@); \ @@\
- if [ -f ../../patchy/4.15/bin/$(notdir $@) ] ; then \ @@\
- ln -s ../../patchy/4.15/bin/$(notdir $@) $(notdir $@); \ @@\
- else \ @@\
- echo "$(notdir $@) not linked, not existing";\ @@\
- fi
-
-#endif
-
-#ifdef CERNLIB_VAXVMS
-
-PLINAME=$(subst $(space),$(comma),$(strip $(subst -DCERNLIB_,,CernlibSystem)))
-LDIR=$(TOP)$(CURRENT_DIR)]
-
-%.for: %.cra patchy.car yyexpand.com
- \@yyexpand "$(PLINAME)" $< tmp.cra
- ypatchy - $@ tmp TTY .go
- del /nolog/noconf tmp.cra;*
-
-/*.for.obj:
- * for $<
- */
-
-$(P5LIB): p5lib.obj
- del/noconf/nolog $@;*
- Library/create $@ $<
-#endif
diff --git a/src/patchy/fcasplit.F b/src/patchy/fcasplit.F
deleted file mode 100644
index 0b12754..0000000
--- a/src/patchy/fcasplit.F
+++ /dev/null
@@ -1,1203 +0,0 @@
-*
-* $Id: fcasplit.F,v 1.3 1999/11/30 17:37:25 cernsoft Exp $
-*
-* $Log: fcasplit.F,v $
-* Revision 1.3 1999/11/30 17:37:25 cernsoft
-* generate compiler option +DA1.1 for HP architecture
-*
-* Revision 1.2 1999/03/25 09:58:07 cernlib
-* Use g77 and gcc as compilers for Linux
-*
-* Revision 1.1 1996/05/21 10:04:39 cernlib
-* copy from kernlib, remove need for pilot.h
-*
-* Revision 1.1.1.1 1996/02/15 17:54:16 mclareni
-*
-* Stolen from kerngen/obsolete
-
-#ifdef CERNLIB_HPUX
-#define CERNLIB_QMHPX
-#endif
-
-#ifdef CERNLIB_SUN
-#define CERNLIB_QMSUN
-#endif
-
-#ifdef CERNLIB_DECS
-#define CERNLIB_QMVMI
-#endif
-
-#ifdef CERNLIB_QMVAOS
-#ifdef CERNLIB_QMVMI
-#undef CERNLIB_QMVMI
-#endif
-#define CERNLIB_QMVAO
-#endif
-
-#ifdef CERNLIB_IBMRT
-#define CERNLIB_QMIRT
-#endif
-
-#ifdef CERNLIB_LINUX
-#define CERNLIB_QMLNX
-#endif
-
-#ifdef CERNLIB_SGI
-#define CERNLIB_QMSGI
-#endif
-
-#if defined(CERNLIB_VAXVMS)
-#define CERNLIB_QMVAX
-#endif
-
-
-
-
- PROGRAM FCASPLIT
-
-C CERN PROGLIB# FCASPLIT .VERSION KERNFOR 4.40 940929
-C ORIG. 01/10/88 JZ
-
-#if defined(CERNLIB_QF_APO)
- INTEGER*2 JARGA2, NARGSA2, PGM_$GET_ARG
-#endif
-#if !defined(CERNLIB_QMAMX)
- PARAMETER (NARADD = 0)
-#endif
- CHARACTER CHIDF*8, CHIDC*8, CHIDA*8, CHIDD*4
- CHARACTER CHIDX*7, CHIDY*6, CHOVER*(*)
- CHARACTER CHPOF*(*), CHPOC*(*), CHPOA*(*)
- CHARACTER CHEXFOR*(*), CHEXCC*(*), CHEXAS*(*)
- CHARACTER CHWHF*(*), CHWHC*(*), CHWHA*(*)
- CHARACTER CHEXOBJ*(*)
-
- PARAMETER (CHIDF = 'CDECK I' )
- PARAMETER (CHIDC = '/*DECK I' )
- PARAMETER (CHIDX = 'DECK I' )
- PARAMETER (CHIDY = 'DECK I' )
- PARAMETER (CHIDD = 'D>, ' )
-
-#if (!defined(CERNLIB_QMAPO10))&&(defined(CERNLIB_QF_APO))
- PARAMETER (CHIDA = ';DECK I' )
- PARAMETER (CHOVER= 'OVERWRITE')
-
- PARAMETER (CHPOF =
- + '-bounds_violation -info 1 -indexl -opt 3 -cpu mathlib_sr10')
- PARAMETER (CHPOC = '-c -O')
- PARAMETER (CHPOA = ' ')
-
- PARAMETER (CHEXFOR = '.ftn')
- PARAMETER (CHEXCC = '.c')
- PARAMETER (CHEXAS = '.s')
- PARAMETER (CHEXOBJ = '.bin')
-
- PARAMETER (CHWHF = '/com/ftn ')
- PARAMETER (CHWHC = 'cc ')
- PARAMETER (CHWHA = 'as ')
-#endif
-#if (defined(CERNLIB_QMAPO10))&&(defined(CERNLIB_QF_APO))
- PARAMETER (CHIDA = ';DECK I' )
- PARAMETER (CHOVER= 'OVERWRITE')
-
- PARAMETER (CHPOF =
- + '-bounds_violation -info 1 -indexl -opt 2 -cpu a88k')
- PARAMETER (CHPOC = '-c -O')
- PARAMETER (CHPOA = ' ')
-
- PARAMETER (CHEXFOR = '.ftn')
- PARAMETER (CHEXCC = '.c')
- PARAMETER (CHEXAS = '.s')
- PARAMETER (CHEXOBJ = '.bin')
-
- PARAMETER (CHWHF = '/com/ftn ')
- PARAMETER (CHWHC = 'cc ')
- PARAMETER (CHWHA = 'as ')
-#endif
-#if (!defined(CERNLIB_QMAPO10))&&(defined(CERNLIB_QF_APO77))
- PARAMETER (CHIDA = ';DECK I' )
- PARAMETER (CHOVER= 'OVERWRITE')
-
- PARAMETER (CHPOF = '-c -O3 -A cpu,mathlib_sr10' //
- + ' -W0,-bounds_violation -W0,-info,1 -W0,-indexl')
- PARAMETER (CHPOC = '-c -O')
- PARAMETER (CHPOA = ' ')
-
- PARAMETER (CHEXFOR = '.f')
- PARAMETER (CHEXCC = '.c')
- PARAMETER (CHEXAS = '.s')
- PARAMETER (CHEXOBJ = '.o')
-
- PARAMETER (CHWHF = 'f77 ')
- PARAMETER (CHWHC = 'cc ')
- PARAMETER (CHWHA = 'as ')
-#endif
-#if (defined(CERNLIB_QMAPO10))&&(defined(CERNLIB_QF_APO77))
- PARAMETER (CHIDA = ';DECK I' )
- PARAMETER (CHOVER= 'OVERWRITE')
-
- PARAMETER (CHPOF = '-c -O2 -A cpu,a88k' //
- + ' -W0,-bounds_violation -W0,-info,1 -W0,-indexl')
- PARAMETER (CHPOC = '-c -O')
- PARAMETER (CHPOA = ' ')
-
- PARAMETER (CHEXFOR = '.f')
- PARAMETER (CHEXCC = '.c')
- PARAMETER (CHEXAS = '.s')
- PARAMETER (CHEXOBJ = '.o')
-
- PARAMETER (CHWHF = 'f77 ')
- PARAMETER (CHWHC = 'cc ')
- PARAMETER (CHWHA = 'as ')
-#endif
-#if defined(CERNLIB_QMALT)
- PARAMETER (CHIDA = '|DECK I' )
- PARAMETER (CHOVER= 'UNKNOWN')
-
- PARAMETER (CHPOF = '-c -Og -w')
- PARAMETER (CHPOC = '-c -Og')
- PARAMETER (CHPOA = ' ')
-
- PARAMETER (CHEXFOR = '.f')
- PARAMETER (CHEXCC = '.c')
- PARAMETER (CHEXAS = '.s')
- PARAMETER (CHEXOBJ = '.o')
-
- PARAMETER (CHWHF = 'fortran ')
- PARAMETER (CHWHC = 'fxc ')
- PARAMETER (CHWHA = 'as ')
-#endif
-#if defined(CERNLIB_QMAMX)
- PARAMETER (NARADD = -1)
- PARAMETER (CHIDA = '|DECK I' )
- PARAMETER (CHOVER= 'UNKNOWN')
-
- PARAMETER (CHPOF = '-c -q -O')
- PARAMETER (CHPOC = '-c')
- PARAMETER (CHPOA = ' ')
-
- PARAMETER (CHEXFOR = '.f')
- PARAMETER (CHEXCC = '.c')
- PARAMETER (CHEXAS = '.s')
- PARAMETER (CHEXOBJ = '.o')
-
- PARAMETER (CHWHF = 'ftn ')
- PARAMETER (CHWHC = 'cc ')
- PARAMETER (CHWHA = 'as ')
-#endif
-#if defined(CERNLIB_QMCRY)
- PARAMETER (CHIDA = '*DECK I' )
- PARAMETER (CHOVER= 'UNKNOWN')
-
- PARAMETER (CHPOF = ' ')
- PARAMETER (CHPOC = '-c')
- PARAMETER (CHPOA = ' ')
-
- PARAMETER (CHEXFOR = '.f')
- PARAMETER (CHEXCC = '.c')
- PARAMETER (CHEXAS = '.s')
- PARAMETER (CHEXOBJ = '.o')
-
- PARAMETER (CHWHF = 'cft77 ')
- PARAMETER (CHWHC = 'scc ')
- PARAMETER (CHWHA = 'as ')
-#endif
-#if defined(CERNLIB_QMCV64)
- PARAMETER (CHIDA = ';DECK I' )
- PARAMETER (CHOVER= 'UNKNOWN')
-
- PARAMETER (CHPOF = '-c -O -p8 -72')
- PARAMETER (CHPOC = '-c -O')
- PARAMETER (CHPOA = ' ')
-
- PARAMETER (CHEXFOR = '.f')
- PARAMETER (CHEXCC = '.c')
- PARAMETER (CHEXAS = '.s')
- PARAMETER (CHEXOBJ = '.o')
-
- PARAMETER (CHWHF = 'fc ')
- PARAMETER (CHWHC = 'cc ')
- PARAMETER (CHWHA = 'as ')
-#endif
-#if defined(CERNLIB_QMCV32)
- PARAMETER (CHIDA = ';DECK I' )
- PARAMETER (CHOVER= 'UNKNOWN')
-
- PARAMETER (CHPOF = '-c -O -fi -72')
- PARAMETER (CHPOC = '-c -O')
- PARAMETER (CHPOA = ' ')
-
- PARAMETER (CHEXFOR = '.f')
- PARAMETER (CHEXCC = '.c')
- PARAMETER (CHEXAS = '.s')
- PARAMETER (CHEXOBJ = '.o')
-
- PARAMETER (CHWHF = 'fc ')
- PARAMETER (CHWHC = 'cc ')
- PARAMETER (CHWHA = 'as ')
-#endif
-#if (defined(CERNLIB_QMDOS))&&(defined(CERNLIB_QF_NDP))
- PARAMETER (CHIDA = ';DECK I' )
- PARAMETER (CHOVER= 'UNKNOWN')
-
- PARAMETER (CHPOF = '-c -vm')
- PARAMETER (CHPOC = '-c -n2 -n3 -OLM')
- PARAMETER (CHPOA = '-c')
-
- PARAMETER (CHEXFOR = '.f')
- PARAMETER (CHEXCC = '.c')
- PARAMETER (CHEXAS = '.s')
- PARAMETER (CHEXOBJ = '.obj')
-
- PARAMETER (CHWHF = 'mf486 ')
- PARAMETER (CHWHC = 'cc ')
- PARAMETER (CHWHA = '386ASM ')
-#endif
-#if (defined(CERNLIB_QMDOS))&&(defined(CERNLIB_QF_F2C))
- PARAMETER (CHIDA = ';DECK I' )
- PARAMETER (CHOVER= 'UNKNOWN')
-
- PARAMETER (CHPOF = '-w -Nn802 -Nx802 -NC802')
- PARAMETER (CHPOC = '-c ')
- PARAMETER (CHPOA = '-c')
-
- PARAMETER (CHEXFOR = '.f')
- PARAMETER (CHEXCC = '.c')
- PARAMETER (CHEXAS = '.s')
- PARAMETER (CHEXOBJ = '.o')
-
- PARAMETER (CHWHF = 'f2c ')
- PARAMETER (CHWHC = 'gcc ')
- PARAMETER (CHWHA = 'as ')
-#endif
-#if (defined(CERNLIB_QMDOS))&&(defined(CERNLIB_QF_DEC))
- PARAMETER (CHIDA = ';DECK I' )
- PARAMETER (CHOVER= 'UNKNOWN')
-
- PARAMETER (CHPOF = '-nolink')
- PARAMETER (CHPOC = '-c -DWIN32')
- PARAMETER (CHPOA = '-c')
-
- PARAMETER (CHEXFOR = '.f')
- PARAMETER (CHEXCC = '.c')
- PARAMETER (CHEXAS = '.s')
- PARAMETER (CHEXOBJ = '.obj')
-
- PARAMETER (CHWHF = 'f77 ')
- PARAMETER (CHWHC = 'claxp ')
- PARAMETER (CHWHA = 'ASM ')
-#endif
-#if defined(CERNLIB_QMHPX)
- PARAMETER (CHIDA = '|DECK I' )
- PARAMETER (CHOVER= 'UNKNOWN')
-
- PARAMETER (CHPOF = '-c -O -w +DA1.1 +ppu')
- PARAMETER (CHPOC = '-c -O')
- PARAMETER (CHPOA = ' ')
-
- PARAMETER (CHEXFOR = '.f')
- PARAMETER (CHEXCC = '.c')
- PARAMETER (CHEXAS = '.s')
- PARAMETER (CHEXOBJ = '.o')
-
- PARAMETER (CHWHF = 'f77 ')
- PARAMETER (CHWHC = 'cc ')
- PARAMETER (CHWHA = 'as ')
-#endif
-#if defined(CERNLIB_QMIBX)
- PARAMETER (CHIDA = '*DECK I' )
- PARAMETER (CHOVER= 'UNKNOWN')
-
- PARAMETER (CHPOF = '-c -f''opt(3)'' -f''CL(8192)'' ')
- PARAMETER (CHPOC = '-c -O')
- PARAMETER (CHPOA = ' ')
-
- PARAMETER (CHEXFOR = '.f')
- PARAMETER (CHEXCC = '.c')
- PARAMETER (CHEXAS = '.s')
- PARAMETER (CHEXOBJ = '.o')
-
- PARAMETER (CHWHF = 'fvs ')
- PARAMETER (CHWHC = 'cc ')
- PARAMETER (CHWHA = 'as ')
-#endif
-#if defined(CERNLIB_QMIRT)
- PARAMETER (CHIDA = ';DECK I' )
- PARAMETER (CHOVER= 'UNKNOWN')
-
- PARAMETER (CHPOF = '-c -O -qextname -qcharlen=8192')
- PARAMETER (CHPOC = '-c -O')
- PARAMETER (CHPOA = ' ')
-
- PARAMETER (CHEXFOR = '.f')
- PARAMETER (CHEXCC = '.c')
- PARAMETER (CHEXAS = '.s')
- PARAMETER (CHEXOBJ = '.o')
-
- PARAMETER (CHWHF = 'xlf ')
- PARAMETER (CHWHC = 'cc ')
- PARAMETER (CHWHA = 'as ')
-#endif
-#if defined(CERNLIB_QMLNX)
- CHARACTER CHIDA2*8
- PARAMETER (CHIDA2= ' #DECK I' )
- PARAMETER (CHIDA = ';DECK I' )
- PARAMETER (CHOVER= 'UNKNOWN')
-
- PARAMETER (CHPOF = '-c -O -fno-automatic')
- PARAMETER (CHPOC = '-c -O2 -m486')
- PARAMETER (CHPOA = ' ')
-
- PARAMETER (CHEXFOR = '.f')
- PARAMETER (CHEXCC = '.c')
- PARAMETER (CHEXAS = '.s')
- PARAMETER (CHEXOBJ = '.o')
-
- PARAMETER (CHWHF = 'g77 ')
- PARAMETER (CHWHC = 'gcc ')
- PARAMETER (CHWHA = 'as ')
-#endif
-#if defined(CERNLIB_QMNXT)
- PARAMETER (CHIDA = '|DECK I' )
- PARAMETER (CHOVER= 'UNKNOWN')
-
-
- PARAMETER (CHPOF = '-c -O')
- PARAMETER (CHPOC = '-c -O')
- PARAMETER (CHPOA = ' ')
-
-
- PARAMETER (CHEXFOR = '.f')
- PARAMETER (CHEXCC = '.c')
- PARAMETER (CHEXAS = '.s')
- PARAMETER (CHEXOBJ = '.o')
-
-
- PARAMETER (CHWHF = 'f77 ')
- PARAMETER (CHWHC = 'cc ')
- PARAMETER (CHWHA = 'as ')
-#endif
-#if defined(CERNLIB_QMOS9)
- PARAMETER (CHIDA = '|DECK I' )
- PARAMETER (CHOVER= 'UNKNOWN')
-
- PARAMETER (CHPOF = '-R -E -!it -A -h')
- PARAMETER (CHPOC = '-c -O')
- PARAMETER (CHPOA = ' ')
-
- PARAMETER (CHEXFOR = '.f')
- PARAMETER (CHEXCC = '.c')
- PARAMETER (CHEXAS = '.s')
- PARAMETER (CHEXOBJ = '.o')
-
- PARAMETER (CHWHF = 'f77 ')
- PARAMETER (CHWHC = 'xcc ')
- PARAMETER (CHWHA = 'as ')
-#endif
-#if defined(CERNLIB_QMSGI)
- PARAMETER (CHIDA = '|DECK I' )
- PARAMETER (CHOVER= 'UNKNOWN')
-
- PARAMETER (CHPOF = '-c -O')
- PARAMETER (CHPOC = '-c -O')
- PARAMETER (CHPOA = ' ')
-
- PARAMETER (CHEXFOR = '.f')
- PARAMETER (CHEXCC = '.c')
- PARAMETER (CHEXAS = '.s')
- PARAMETER (CHEXOBJ = '.o')
-
- PARAMETER (CHWHF = 'f77 ')
- PARAMETER (CHWHC = 'cc ')
- PARAMETER (CHWHA = 'as ')
-#endif
-#if defined(CERNLIB_QMSUN)
- PARAMETER (CHIDA = '|DECK I' )
- PARAMETER (CHOVER= 'UNKNOWN')
-
- PARAMETER (CHPOF = '-c -O -w66')
- PARAMETER (CHPOC = '-c -O')
- PARAMETER (CHPOA = ' ')
-
- PARAMETER (CHEXFOR = '.f')
- PARAMETER (CHEXCC = '.c')
- PARAMETER (CHEXAS = '.s')
- PARAMETER (CHEXOBJ = '.o')
-
- PARAMETER (CHWHF = 'f77 ')
- PARAMETER (CHWHC = 'cc ')
- PARAMETER (CHWHA = 'as ')
-#endif
-#if defined(CERNLIB_QMTMO)
- PARAMETER (CHIDA = '|DECK I' )
- PARAMETER (CHOVER= 'UNKNOWN')
-
- PARAMETER (CHPOF = '-c')
- PARAMETER (CHPOC = '-c')
- PARAMETER (CHPOA = ' ')
-
- PARAMETER (CHEXFOR = '.f')
- PARAMETER (CHEXCC = '.c')
- PARAMETER (CHEXAS = '.s')
- PARAMETER (CHEXOBJ = '.o')
-
- PARAMETER (CHWHF = 'f77 ')
- PARAMETER (CHWHC = 'cc ')
- PARAMETER (CHWHA = 'as ')
-#endif
-#if defined(CERNLIB_QMVAX)
- PARAMETER (CHIDA = ';DECK I' )
- PARAMETER (CHOVER= 'UNKNOWN')
-
- PARAMETER (CHPOF = '/nolist/check=noover')
- PARAMETER (CHPOC = ' ')
-
- PARAMETER (CHEXFOR = '.for')
- PARAMETER (CHEXCC = '.c')
- PARAMETER (CHEXOBJ = '.obj')
-
- PARAMETER (CHWHF = 'fortran')
- PARAMETER (CHWHC = 'cc')
-#endif
-#if defined(CERNLIB_QMVAX)
- PARAMETER (CHPOA = '/nolist')
- PARAMETER (CHEXAS = '.mar')
- PARAMETER (CHWHA = 'macro')
-
- CHARACTER BEGRUT*9, ENDLINE*12
- PARAMETER (BEGRUT = ' .TITLE ')
- PARAMETER (ENDLINE= ' .END')
-#endif
-#if defined(CERNLIB_QMVMI)
- CHARACTER CHIDA2*8
- PARAMETER (CHIDA2= ' #DECK I' )
- PARAMETER (CHIDA = ';DECK I' )
- PARAMETER (CHOVER= 'UNKNOWN')
-
- PARAMETER (CHPOF = '-c -O')
- PARAMETER (CHPOC = '-c -O')
- PARAMETER (CHPOA = ' ')
-
- PARAMETER (CHEXFOR = '.f')
- PARAMETER (CHEXCC = '.c')
- PARAMETER (CHEXAS = '.s')
- PARAMETER (CHEXOBJ = '.o')
-
- PARAMETER (CHWHF = 'f77 ')
- PARAMETER (CHWHC = 'f77 ')
- PARAMETER (CHWHA = 'as ')
-#endif
-#if defined(CERNLIB_QMVAO)
- CHARACTER CHIDA2*8
- PARAMETER (CHIDA2= ' #DECK I' )
- PARAMETER (CHIDA = ';DECK I' )
- PARAMETER (CHOVER= 'UNKNOWN')
-
- PARAMETER (CHPOF = '-c -O')
- PARAMETER (CHPOC = '-c -O')
- PARAMETER (CHPOA = ' ')
-
- PARAMETER (CHEXFOR = '.f')
- PARAMETER (CHEXCC = '.c')
- PARAMETER (CHEXAS = '.s')
- PARAMETER (CHEXOBJ = '.o')
-
- PARAMETER (CHWHF = 'f77 ')
- PARAMETER (CHWHC = 'cc ')
- PARAMETER (CHWHA = 'as ')
-#endif
-
- PARAMETER (MLMKLN=100)
- PARAMETER (MXLENG=128, MXMKLN=64)
- CHARACTER CHHOLD*(MXLENG)
- CHARACTER CHOPT(7)*(MXLENG)
- DIMENSION NCHOPT(7)
- EQUIVALENCE (NOPF,NCHOPT(1))
- EQUIVALENCE (NOPC,NCHOPT(2))
- EQUIVALENCE (NOPA,NCHOPT(3))
-
- CHARACTER CHCMP(3)*(MXLENG)
- DIMENSION NCHCMP(3)
- EQUIVALENCE (CHCMP(1),CHOPT(4)), (NCHCMP(1),NCHOPT(4))
- EQUIVALENCE (NNF,NCHCMP(1))
- EQUIVALENCE (NNC,NCHCMP(2))
- EQUIVALENCE (NNA,NCHCMP(3))
-
- CHARACTER CHFIN*(MXLENG)
- EQUIVALENCE (CHFIN,CHOPT(7)), (NCHFIN,NCHOPT(7))
-
- CHARACTER CHFSH*(MXLENG), CHFMK*(MXLENG)
- CHARACTER CHMKLN*(MXMKLN+4)
-
- PARAMETER (MXCBUF=100)
- DIMENSION LXCBUF(MXCBUF)
- CHARACTER*80 CHCBUF(MXCBUF)
-
- CHARACTER CHLINE*80, CHNAME*80, CHTEXT*511
- CHARACTER CHUSE*1
-
- PARAMETER (NKEYS=11)
- CHARACTER CHKEYS(NKEYS)*4
- DATA CHKEYS / '-noh', '-log'
- +, '-fo ', '-co ', '-ao '
- +, '-f ', '-c ', '-a '
- +, '+fo ', '+co ', '+ao ' /
-
- LUNPR = 6
-#if defined(CERNLIB_QMVAX)
- OPEN (LUNPR,FILE='SYS$OUTPUT',RECL=512,STATUS='OLD')
-#endif
-
- WRITE (LUNPR,9001)
- 9001 FORMAT (' FCASPLIT executing.')
-
-#if defined(CERNLIB_QMIBX)
- CALL ERRSET (212, 300,-1,1,1)
-#endif
-
- 9002 FORMAT (
- F ' FCASPLIT [-f nmft] [-c nmcc] [-a nmas] [-noh] [-log]'
- F/' [+fo incf] [+co incc] [+ao incs]'
- F/' [-fo optf] [-co optc] [-ao opts]'
- F/' f.e [fca_n] [optf [optc [opts]]]'/
- F/' splits file f.e having a mixture of Fortran / C / assembler'
- F/' routines into separate files n.f or n.c or n.s, "n" being the'
- F/' name of each routine, creating at the same time a Shell script'
- F/' y.shfca and a Make file y.mkfca either of which can be used'
- F/' to compile all routines individually.'/
- F/' Defaults are defined in fcasplit for the names by which the'
- F/' compilers are called; with the -f, -c, -a options they could'
- F/' be changed.'/
- F/' Defaults are also defined for the options with which they are'
- F/' called; with the -fo, -co, -ao options they can be re-defined;'
- F/' with the +fo, +co, +ao options they can be incremented.'/
- F/' To be backward compatible the options can also be specified by'
- F/' the positional parameters after the file-name.')
- 9003 FORMAT (1X
- F/' If the -noh option is given (or if the first parameter after'
- F/' the file-name is "fca_n") the identifying header line of each'
- F/' routine is not written out. If the -log option is given'
- F/' the name of each routine is printed on standard output.')
- 9004 FORMAT (1X
- F/' Each routine must start with an identifying line :'
- F/' "', A, 'D>, " in cols. 1-12 for Fortran'
- F/' "', A, 'D>, " in cols. 1-12 for C'
- F/' "', A, 'D>, " in cols. 1-12 for assembler'
- F/' "DECK ID>, " in cols. 2-12 or'
- F/' "DECK ID>, " in cols. 3-12 for anything else'
- F/' "name" in cols. 13-40 gives the name'/
- F/' In the last two cases, or if "name" contains an'
- F/' extension, the file created will be "name"'
- F/' without extension .f, .c or .s added to it'
- F/' and without an entry into the script.'/
- F/' A trailing blank terminates the name,'
- F/' symbol . followed by blank also terminates,'
- F/' symbols ; < # ! all terminate,'
- F/' symbol */ also terminates.'
- F/1X)
-
-C------ Acquire the parameters
-
-#if !defined(CERNLIB_QF_APO)
- NARGS = IARGC() + NARADD
-#endif
-#if defined(CERNLIB_QF_APO)
- CALL PGM_$GET_ARGS (NARGSA2,LPOIARG)
- NARGS = NARGSA2 - 1
-#endif
-
- CHOPT(1) = CHPOF
- CHOPT(2) = CHPOC
- CHOPT(3) = CHPOA
-
- CHCMP(1) = CHWHF
- CHCMP(2) = CHWHC
- CHCMP(3) = CHWHA
- CHFIN = 'f.e'
-
- IFINFI = 0
- IFLNH = 0
- IFLLOG = 0
-
-C-- Get the keyed options, until the input file name
-
- JARG = 0
- 11 JOPT = 0
- 12 IF (JARG.GE.NARGS) GO TO 21
- JARG = JARG + 1
-#if (!defined(CERNLIB_QF_APO))&&(!defined(CERNLIB_QMHPX))
- CALL GETARG (JARG, CHHOLD)
-#endif
-#if defined(CERNLIB_QMHPX)
- N = IGETARG (JARG, CHHOLD, MXLENG)
-#endif
-#if defined(CERNLIB_QF_APO)
- JARGA2 = JARG
- N = PGM_$GET_ARG (JARGA2,CHHOLD,ISTAT)
- CHHOLD(N+1:) = ' '
-#endif
-#if defined(CERNLIB_QMVAX)
- CALL CUTOL(CHHOLD)
-#endif
-
- IF (JOPT.EQ.0) GO TO 13
-
-C---- Store option values read
-
-C-- positional trailing options
- IF (JOPT.LT.0) THEN
- IF (JOPT.EQ.-1) THEN
- IF (CHHOLD(1:5).EQ.'fca_n') THEN
- IFLNH = 7
- GO TO 12
- ENDIF
- ENDIF
- CHOPT(-JOPT) = CHHOLD
- JOPT = JOPT - 1
- GO TO 12
- ENDIF
-
-C-- keyed options
- IF (JOPT.LE.6) THEN
- CHOPT(JOPT) = CHHOLD
- ELSE
-#if !defined(CERNLIB_QMVAX)
- IF (JOPT.EQ.7) CHOPT(1) = CHPOF // ' ' // CHHOLD
- IF (JOPT.EQ.8) CHOPT(2) = CHPOC // ' ' // CHHOLD
- IF (JOPT.EQ.9) CHOPT(3) = CHPOA // ' ' // CHHOLD
-#endif
-#if defined(CERNLIB_QMVAX)
- IF (JOPT.EQ.7) CHOPT(1) = CHPOF // CHHOLD
- IF (JOPT.EQ.8) CHOPT(2) = CHPOC // CHHOLD
- IF (JOPT.EQ.9) CHOPT(3) = CHPOA // CHHOLD
-#endif
- ENDIF
- GO TO 11
-
-C---- Analyse key, if any
-
-C- -noh -log -fo -co -ao -f -c -a +fo +co +ao
-C- 1 2 3 4 5 6 7 8 9 10 11
-C- 1 2 3 4 5 6 7 8 9
-
- 13 DO 14 JKEY=1,NKEYS
- IF (CHHOLD(1:4).EQ.CHKEYS(JKEY)) THEN
- IF (JKEY.EQ.1) THEN
- IFLNH = 7
- GO TO 11
- ENDIF
- IF (JKEY.EQ.2) THEN
- IFLLOG = 7
- GO TO 11
- ENDIF
- JOPT = JKEY - 2
- GO TO 12
- ENDIF
- 14 CONTINUE
-
-C---- File-name read
-
- CHFIN = CHHOLD
- IFINFI = 7
-
-C---- Get the positional options if given
-
- JOPT = -1
- GO TO 12
-
-C------ Parameters have all been read
-
-C-- Length of the option strings = true length + 2 (blanks)
-
- 21 DO 24 JJ=1,7
- DO 23 J=MXLENG,1,-1
- IF (CHOPT(JJ)(J:J).NE.' ') GO TO 24
- 23 CONTINUE
- J = 0
- 24 NCHOPT(JJ) = J + 2
- NCHFIN = NCHFIN - 2
-#if defined(CERNLIB_QMVAX)
- NCHOPT(4) = NCHOPT(4) - 2
- NCHOPT(5) = NCHOPT(5) - 2
- NCHOPT(6) = NCHOPT(6) - 2
-#endif
-
-C-- Derive the name of the script yyy.shfca
-C- from the input file, say dir/yyy.ext
-
- N = NCHFIN
- JA = 1
- JE = N
- J = N
- 26 IF (CHFIN(J:J).EQ.'/') THEN
- JA = J + 1
- GO TO 27
-#if defined(CERNLIB_QMDOS)
- ELSEIF (CHFIN(J:J).EQ.CHAR(92)) THEN
- JA = J + 1
- GO TO 27
-#endif
- ELSEIF (CHFIN(J:J).EQ.'.') THEN
- IF (JE.EQ.N) JE = J - 1
- ENDIF
- J = J - 1
- IF (J.NE.0) GO TO 26
- 27 CHFSH = CHFIN(JA:JE) // '.shfca'
- CHFMK = CHFIN(JA:JE) // '.mkfca'
- NCHFSH = JE+7 - JA
-
- IF (IFINFI.EQ.0) THEN
- WRITE (LUNPR,9002)
- WRITE (LUNPR,9003)
- WRITE (LUNPR,9004) CHIDF, CHIDC, CHIDA
- ENDIF
-
- WRITE (LUNPR,9026) CHFIN(1:NCHFIN), CHFSH(1:NCHFSH)
- +, CHFMK(1:NCHFSH)
- WRITE (LUNPR,9027) CHCMP(1)(1:NNF),CHOPT(1)(1:NOPF)
- WRITE (LUNPR,9028) CHCMP(2)(1:NNC),CHOPT(2)(1:NOPC)
- WRITE (LUNPR,9029) CHCMP(3)(1:NNA),CHOPT(3)(1:NOPA)
- 9026 FORMAT (5X,' Input file : ',A/
- F 5X,' Shell script : ',A/
- F 5X,' Make file : ',A)
- 9027 FORMAT (5X,' Fortran name : ',A/
- F 5X,' Fortran options : ',A)
- 9028 FORMAT (5X,' CC name : ',A/
- F 5X,' CC options : ',A)
- 9029 FORMAT (5X,' Assembler name : ',A/
- F 5X,' Assembler options : ',A)
-
-C---- Stop if no file-name, help information printed
-
- IF (IFINFI.EQ.0) THEN
- WRITE (LUNPR,9030)
- STOP
- ENDIF
-
- 9030 FORMAT (' !!! No file-name given, no execution !!!')
-
-C------------ Process the input file ------------------
-
-C-- Open input and .shfca file
-
- OPEN (11, FILE=CHFIN(1:NCHFIN),STATUS='OLD')
- REWIND 11
-
- OPEN (21, FILE=CHFSH(1:NCHFSH),STATUS='OLD',ERR=301)
- CLOSE (21, STATUS='DELETE')
- 301 OPEN (22, FILE=CHFMK(1:NCHFSH),STATUS='OLD',ERR=302)
- CLOSE (22, STATUS='DELETE')
-#if defined(CERNLIB_QMVAX)
- 302 OPEN (21, FILE=CHFSH(1:NCHFSH),RECL=512,STATUS=CHOVER)
- OPEN (22, FILE=CHFMK(1:NCHFSH),RECL=512,STATUS=CHOVER)
-#endif
-#if !defined(CERNLIB_QMVAX)
- 302 OPEN (21, FILE=CHFSH(1:NCHFSH),STATUS=CHOVER)
- OPEN (22, FILE=CHFMK(1:NCHFSH),STATUS=CHOVER)
-#endif
-
-#if defined(CERNLIB_WINNT)
- write(22,8000) "# Some nmake macros for Win32 apps development"
-#endif
-#if (defined(CERNLIB_WINNT))&&(defined(CERNLIB_QF_DEC))
- write(22,8000) ".SUFFIXES : .f"
- write(22,8000) "!include <f77.mak>"
-#endif
-#if defined(CERNLIB_WINNT)
- write(22,8000) "!include <ntwin32.mak>"
-#endif
-
- CHMKLN = 'ROUTINES = '
- NXMKLN = 11
-
- NTEXT = -12
- NIGNOR = 0
- NROUT = 0
- NLINES = 0
- NTCBUF = 0
- NXCBUF = 0
-
- NLMKLN = 0
- NPCSMK = 0
-#if defined(CERNLIB_QMVAX)
-C- Write SHFCA header
- WRITE(21,8000) '$! Command file to compile fortran,c,macro source'
- WRITE(21,8000) '$ PROC_VER = F$ENVIRONMENT("VERIFY_PROCEDURE")'
- WRITE(21,8000) '$ IMAG_VER = F$ENVIRONMENT("VERIFY_IMAGE")'
- WRITE(21,8000) '$ SET VERIFY=(PROCEDURE,NOIMAGE)'
- JTYLA = 0
-#endif
-
-C------- Read next line -------------------------
-
- 31 CONTINUE
-#if (!defined(CERNLIB_QMVAX))&&(!defined(CERNLIB_QMVMI))&&(!defined(CERNLIB_QMVAO))
- READ (11,8000,END=83) CHLINE
- N = LEN(CHLINE)
-#endif
-#if defined(CERNLIB_QMVAX)||defined(CERNLIB_QMVMI)||defined(CERNLIB_QMVAO)
- READ (11,8031,END=83) N,CHLINE(1:MIN(80,N+1))
- 8031 FORMAT (Q,A)
-#endif
-
- DO 33 NCHLN=N,1,-1
- IF (CHLINE(NCHLN:NCHLN).NE.' ') GO TO 34
- 33 CONTINUE
- NCHLN = 0
-
- 34 IF (NCHLN.GE.13) THEN
- IF (CHLINE(9:12).EQ.CHIDD) GO TO 59
- ENDIF
- 35 IF (NTEXT.LT.0) GO TO 58
- 36 IF (JTYPE.NE.1) GO TO 41
-
-C-- Check new line is a Fortran comment line
-
- IF (NCHLN.EQ.0) GO TO 38
- IF (CHLINE(1:1).EQ.'C') GO TO 38
- IF (CHLINE(1:1).EQ.'c') GO TO 38
- IF (CHLINE(1:1).NE.'*') GO TO 41
-
- 38 IF (NXCBUF.EQ.MXCBUF) GO TO 41
- NXCBUF = NXCBUF + 1
- IF (NCHLN.GT.0) CHCBUF(NXCBUF)(1:NCHLN) = CHLINE(1:NCHLN)
- LXCBUF(NXCBUF) = NCHLN
- GO TO 31
-
-C------- Write next line -------------------------
-
-C-- NTEXT = <0 idle unheaded lines (not coming here)
-C- 0 normal running
-C- >0 about to write the first line of new routine
-C- if =1 : no entry to script and make file
-
-C- start a new routine only when the first true line is ready
-
- 41 IF (NTEXT.EQ.0) GO TO 46
- IF (NTEXT.NE.1) GO TO 81
-
-C-- Open the output file if first line ready
-
- 44 OPEN (27, FILE=CHNAME(1:NCUM),STATUS='OLD',ERR=441)
- CLOSE (27, STATUS='DELETE')
- 441 OPEN (27, FILE=CHNAME(1:NCUM),STATUS=CHOVER)
-
- NTEXT = 0
- NROUT = NROUT + 1
- IF (IFLLOG.NE.0) WRITE (LUNPR,9044) NROUT,CHNAME(1:NCUM)
- 9044 FORMAT (' make',I4,1X,A)
-
-#if defined(CERNLIB_QMVAX)
-C-- Create .TITLE line for assembler
- JTYLA = JTYPE
- IF (JTYPE.EQ.3) WRITE (27,9045) BEGRUT,CHNAME(1:NNAM)
- 9045 FORMAT (A,A)
-#endif
-
-C-- Transfer the comment lines from the buffer
-
- 46 IF (NXCBUF.EQ.0) GO TO 48
- DO 47 J=1,NXCBUF
- N = LXCBUF(J)
- IF (N.EQ.0) THEN
- WRITE (27,8000)
- ELSE
- WRITE (27,8000) CHCBUF(J)(1:LXCBUF(J))
- ENDIF
- 47 CONTINUE
- NLINES = NLINES + NXCBUF
- NXCBUF = 0
-
-C-- Transfer the current line
-
- 48 IF (NCHLN.EQ.0) THEN
- WRITE (27,8000)
- ELSE
- WRITE (27,8000) CHLINE(1:NCHLN)
- ENDIF
- NLINES = NLINES + 1
- GO TO 31
-
-C-- Ignore leading unheaded lines
-
- 58 NIGNOR = NIGNOR + 1
- IF (NTEXT.EQ.-1) GO TO 31
- WRITE (LUNPR,9058) CHLINE(1:NCHLN)
- NTEXT = NTEXT + 1
- IF (NTEXT.NE.-1) GO TO 31
- WRITE (LUNPR,9059)
- GO TO 31
- 9058 FORMAT (' ignored: ',A)
- 9059 FORMAT (10X,'...')
-
-C------- Start new routine ? -------------------------
-
- 59 JTYNX = 0
- IF (CHLINE(1:8).EQ.CHIDF) GO TO 61
- IF (CHLINE(1:8).EQ.CHIDC) GO TO 62
- IF (CHLINE(1:8).EQ.CHIDA) GO TO 63
- IF (CHLINE(2:8).EQ.CHIDX) GO TO 60
- IF (CHLINE(3:8).EQ.CHIDY) GO TO 60
-#if defined(CERNLIB_QMVMI)||defined(CERNLIB_QMVAO)
- IF (CHLINE(1:8).EQ.CHIDA2) GO TO 63
-#endif
- GO TO 35
-
-C-- Yes, start new routine
-
- 63 JTYNX = 1
- 62 JTYNX = JTYNX + 1
- 61 JTYNX = JTYNX + 1
- 60 JPUT = 0
- JDOT = 0
- JDOP = 0
- NUS = MIN(NCHLN,40)
-
-C-- skip leading blanks before the name
-
- JGO = 13
- 65 IF (CHLINE(JGO:JGO).EQ.' ') THEN
- JGO = JGO + 1
- GO TO 65
- ENDIF
-
- IF (JGO.GT.NUS) GO TO 35
-
-C-- Convert name to lower case and find termination
-
- DO 66 JTK=JGO,NUS
- CHUSE = CHLINE(JTK:JTK)
- JV = ICHAR(CHUSE)
- IF (CHUSE.EQ.' ') GO TO 67
- IF (CHUSE.EQ.'.') THEN
- IF (CHLINE(JTK+1:JTK+1).EQ.' ') GO TO 67
- JDOP = JDOT
- JDOT = JPUT+1
- ENDIF
- IF (CHUSE.EQ.';') GO TO 67
- IF (CHUSE.EQ.'<') GO TO 67
- IF (CHUSE.EQ.'#') GO TO 67
- IF (CHUSE.EQ.'!') GO TO 67
- IF (CHUSE.EQ.'*') THEN
- IF (CHLINE(JTK+1:JTK+1).EQ.'/') GO TO 67
- ENDIF
- IF (JV.LT.91) THEN
- IF (JV.GE.65) CHUSE = CHAR(JV+32)
- ENDIF
- JPUT = JPUT + 1
- CHNAME(JPUT:JPUT) = CHUSE
- 66 CONTINUE
-
-C-- Handle explicit extension
-
- 67 JTYPE = JTYNX
- IF (JDOT.EQ.JPUT) THEN
- JDOT = JDOP
- JPUT = JPUT - 1
- ENDIF
-
- NTEXT = 1
- NPUT = JPUT
- NCUM = NPUT
- NNAM = NPUT
- IF (JDOT.NE.0) THEN
- NNAM = JDOT - 1
- JTYPE = -JTYPE
- ENDIF
-
-C---- Handle normal case with standard extensions
-
- IF (JTYPE.LE.0) GO TO 80
-
-C-- Fortran
-
- IF (JTYPE.NE.1) GO TO 74
- N = LEN(CHEXFOR)
- CHNAME(NPUT+1:NPUT+N) = CHEXFOR
- NCUM = NPUT + N
-#if (!defined(CERNLIB_QF_APO))&&(!defined(CERNLIB_QMVAX))
- CHTEXT = CHCMP(1)(1:NNF) // CHOPT(1)(1:NOPF) // CHNAME(1:NCUM)
- NTEXT = NNF + NOPF + NCUM
-#endif
-#if defined(CERNLIB_QF_APO)
- CHTEXT = CHCMP(1)(1:NNF) // CHNAME(1:NCUM) // ' ' //
- + CHOPT(1)(1:NOPF)
- NTEXT = NNF + NCUM + NOPF
-#endif
-#if defined(CERNLIB_QMVAX)
- CHTEXT ='$ '//CHCMP(1)(1:NNF)//CHOPT(1)(1:NOPF)//CHNAME(1:NCUM)
- NTEXT = NNF + NOPF + NCUM +2
-#endif
- GO TO 80
-
-C-- CC
-
- 74 IF (JTYPE.NE.2) GO TO 77
- N = LEN(CHEXCC)
- CHNAME(NPUT+1:NPUT+N) = CHEXCC
- NCUM = NPUT + N
-#if !defined(CERNLIB_QMVAX)
- CHTEXT = CHCMP(2)(1:NNC) // CHOPT(2)(1:NOPC) // CHNAME(1:NCUM)
- NTEXT = NNC + NOPC + NCUM
-#endif
-#if defined(CERNLIB_QMVAX)
- CHTEXT ='$ '//CHCMP(2)(1:NNC)//CHOPT(2)(1:NOPC)//CHNAME(1:NCUM)
- NTEXT = NNC + NOPC + NCUM + 2
-#endif
- GO TO 80
-
-C-- Assembler
-
- 77 IF (JTYPE.NE.3) GO TO 80
- N = LEN(CHEXAS)
- CHNAME(NPUT+1:NPUT+N) = CHEXAS
- NCUM = NPUT + N
-#if (!defined(CERNLIB_QMSUN))&&(!defined(CERNLIB_QMVAX))&&(!defined(CERNLIB_QMVMI))&&(!defined(CERNLIB_QMVAO))
- CHTEXT = CHCMP(3)(1:NNA) // CHOPT(3)(1:NOPA) // CHNAME(1:NCUM)
- NTEXT = NNA + NOPA + NCUM
-#endif
-#if defined(CERNLIB_QMSUN)||defined(CERNLIB_QMVMI)||defined(CERNLIB_QMVAO)
- CHTEXT = CHCMP(3)(1:NNA) // '-o ' // CHNAME(1:NPUT) // '.o ' //
- + CHOPT(3)(1:NOPA) // CHNAME(1:NCUM)
- NTEXT = NNA + NPUT+7 + NOPA + NCUM
-#endif
-#if defined(CERNLIB_QMVAX)
- CHTEXT ='$ '//CHCMP(3)(1:NNA)//CHOPT(3)(1:NOPA)//CHNAME(1:NCUM)
- NTEXT = NNA + NOPA + NCUM + 2
-#endif
-
- 80 CONTINUE
-#if defined(CERNLIB_QMVAX)
-C-- write .END line for assembler
- IF (JTYLA.EQ.3) WRITE (27,8000) ENDLINE
-#endif
- CLOSE (27)
- NTCBUF = NTCBUF + NXCBUF
- NXCBUF = 0
-#if defined(CERNLIB_QMVAX)||defined(CERNLIB_QMVMI)||defined(CERNLIB_QMVAO)
- IF (JTYPE.EQ.3) GO TO 31
-#endif
- IF (JTYPE.LT.1) GO TO 31
- IF (IFLNH.NE.0) GO TO 31
- GO TO 36
-
-C------ Output of the new deck is just starting
-
-C-- compilation command for this routine to the shell script
-
- 81 WRITE (21,8000) CHTEXT(1:NTEXT)
-
-C-- register the routine name for the Make file
-
- CHTEXT = CHNAME(1:NPUT) // CHEXOBJ // ' '
- NTEXT = NPUT + LEN(CHEXOBJ) + 1
- IF (NXMKLN+NTEXT.GT.MXMKLN) THEN
- NLMKLN = NLMKLN + 1
- IF (NLMKLN.LT.MLMKLN) THEN
- NXMKLN = NXMKLN + 1
- CHMKLN(NXMKLN:NXMKLN) = CHAR(92)
- WRITE (22,8000) CHMKLN(1:NXMKLN)
- NXMKLN = 0
- ELSE
- WRITE (22,8000) CHMKLN(1:NXMKLN)
- NXMKLN = 0
- NLMKLN = 0
- WRITE (22,9042)
- NPCSMK = NPCSMK + 1
- WRITE (CHMKLN,9043) NPCSMK
- NXMKLN = 11
- ENDIF
- ENDIF
-
- 9042 FORMAT('#')
- 9043 FORMAT('ROUTINE',I1,' = ')
-
- CHMKLN(NXMKLN+1:NXMKLN+NTEXT) = CHTEXT(1:NTEXT)
- NXMKLN = NXMKLN + NTEXT
- GO TO 44
-
-C------- Done -------------------------
-
-C---- Complete the Make file
-
- 83 WRITE (22,8000) CHMKLN(1:NXMKLN-1)
-
-C-- Fortran inference
-
- CHNAME = CHEXFOR // CHEXOBJ // ':'
- NPUT = LEN(CHEXFOR) + LEN(CHEXOBJ) + 1
-#if !defined(CERNLIB_QF_APO)
- CHTEXT = CHAR(9) // CHCMP(1)(1:NNF) // CHOPT(1)(1:NOPF) //
- + '$*' // CHEXFOR
- NTEXT = 3 + NNF + NOPF + LEN(CHEXFOR)
-#endif
-#if defined(CERNLIB_QF_APO)
- CHTEXT = CHAR(9) // CHCMP(1)(1:NNF) // '$*' // CHEXFOR //
- + ' ' // CHOPT(1)(1:NOPF)
- NTEXT = 2 + NNF + LEN(CHEXFOR) + NOPF
-#endif
-#if (defined(CERNLIB_QMDOS))&&(defined(CERNLIB_QF_F2C))
-C
-C-- For F2C Fortran to C conversion is followed by gcc compilation
-C
- WRITE (22,8000) CHTEXT(1:NTEXT)
-#endif
- WRITE (22,9083) CHNAME(1:NPUT), CHTEXT(1:NTEXT)
-
-C-- CC inference
-
- CHNAME = CHEXCC // CHEXOBJ // ':'
- NPUT = LEN(CHEXCC) + LEN(CHEXOBJ) + 1
- CHTEXT = CHAR(9) // CHCMP(2)(1:NNC) // CHOPT(2)(1:NOPC) //
- + '$*' // CHEXCC
- NTEXT = 3 + NNC + NOPC + LEN(CHEXCC)
-#if defined(CERNLIB_QF_APO)
- CHTEXT(NTEXT+1:NTEXT+16) = '; mv $*.o $*.bin'
- NTEXT = NTEXT + 16
-#endif
- WRITE (22,9083) CHNAME(1:NPUT), CHTEXT(1:NTEXT)
-
-C-- Assembler inference
-
- CHNAME = CHEXAS // CHEXOBJ // ':'
- NPUT = LEN(CHEXAS) + LEN(CHEXOBJ) + 1
-#if (!defined(CERNLIB_QMSUN))&&(!defined(CERNLIB_QMVAX))&&(!defined(CERNLIB_QMVMI))&&(!defined(CERNLIB_QMVAO))
- CHTEXT = CHAR(9) // CHCMP(3)(1:NNA) // CHOPT(3)(1:NOPA) //
- + '$*' // CHEXAS
- NTEXT = 3 + NNA + NOPA + LEN(CHEXAS)
-#endif
-#if defined(CERNLIB_QMSUN)||defined(CERNLIB_QMVAX)||defined(CERNLIB_QMVMI)||defined(CERNLIB_QMVAO)
- CHTEXT = CHAR(9) // CHCMP(3)(1:NNA) // CHOPT(3)(1:NOPA) //
- + '-o $*.o $*' // CHEXAS
- NTEXT = 12 + NNA + NOPA + LEN(CHEXAS)
-#endif
- WRITE (22,9083) CHNAME(1:NPUT), CHTEXT(1:NTEXT)
-
- IF (NPCSMK.EQ.0) THEN
- WRITE (22,9084) CHFIN(JA:JE)
- ELSE
- WRITE (22,9085) CHFIN(JA:JE),(I,I=1,NPCSMK)
- WRITE (22,9086) (I,I,I=1,NPCSMK)
- ENDIF
-
-C-- Print summary
-
- WRITE (LUNPR,9087) NLINES,NROUT
- IF (NIGNOR.NE.0) WRITE (LUNPR,9088) NIGNOR
- IF (NTCBUF.NE.0) WRITE (LUNPR,9089) NTCBUF
-#if defined(CERNLIB_QMVAX)
- WRITE(21,8000) '$!Restore original user settings '
- WRITE(21,8000) '$ TEMP=F$VERIFY(PROC_VER,IMAG_VER)'
-#endif
-#if defined(CERNLIB_QMAPO)
- CALL PGM_$EXIT
-#endif
- 8000 FORMAT (A)
- 9083 FORMAT (/A/A)
- 9084 FORMAT(/A,'_all: $(ROUTINES)',/)
- 9085 FORMAT(/A,'_all:',10(' rout',I1))
- 9086 FORMAT(/,'rout: $(ROUTINES)',/,
- + ('rout',I1,': $(ROUTINE',I1,')',/))
- 9087 FORMAT (1X,I6,' lines written for',I6,' decks')
- 9088 FORMAT (1X,I6,' leading unheaded lines ignored.')
- 9089 FORMAT (1X,I6,' trailing comment lines ignored.')
- END
diff --git a/src/patchy/nycheck.cra b/src/patchy/nycheck.cra
deleted file mode 100644
index e16f2c4..0000000
--- a/src/patchy/nycheck.cra
+++ /dev/null
@@ -1,4 +0,0 @@
-+USE, ${PLINAME}.
-+EXE, YCHECK, D=NCHECK.
-+USE, *PATCHY.
-+PAM, 11, T=C,ATT .patchy
diff --git a/src/patchy/nydiff.cra b/src/patchy/nydiff.cra
deleted file mode 100644
index a7ec862..0000000
--- a/src/patchy/nydiff.cra
+++ /dev/null
@@ -1,4 +0,0 @@
-+USE, ${PLINAME}.
-+EXE, YDIFF, D=NDIFF.
-+USE, *PATCHY.
-+PAM, 11, T=C,ATT .patchy
diff --git a/src/patchy/nyindex.cra b/src/patchy/nyindex.cra
deleted file mode 100644
index acb7b93..0000000
--- a/src/patchy/nyindex.cra
+++ /dev/null
@@ -1,4 +0,0 @@
-+USE, ${PLINAME}.
-+EXE, YINDEX, D=NINDEX.
-+USE, *PATCHY.
-+PAM, 11, T=C,ATT .patchy
diff --git a/src/patchy/nylist.cra b/src/patchy/nylist.cra
deleted file mode 100644
index bd927c3..0000000
--- a/src/patchy/nylist.cra
+++ /dev/null
@@ -1,4 +0,0 @@
-+USE, ${PLINAME}.
-+EXE, YLIST, D=NLIST.
-+USE, *PATCHY.
-+PAM, 11, T=C,ATT .patchy
diff --git a/src/patchy/nymerge.cra b/src/patchy/nymerge.cra
deleted file mode 100644
index ba2ba39..0000000
--- a/src/patchy/nymerge.cra
+++ /dev/null
@@ -1,4 +0,0 @@
-+USE, ${PLINAME}.
-+EXE, YMERGE, D=NMERGE.
-+USE, *PATCHY.
-+PAM, 11, T=C,ATT .patchy
diff --git a/src/patchy/nypatchy.cra b/src/patchy/nypatchy.cra
deleted file mode 100644
index 7bd5469..0000000
--- a/src/patchy/nypatchy.cra
+++ /dev/null
@@ -1,4 +0,0 @@
-+USE, ${PLINAME}.
-+EXE, RUN, D=NPATCH.
-+USE, *PATCHY.
-+PAM, 11, T=C,ATT .patchy
diff --git a/src/patchy/nyshell.cra b/src/patchy/nyshell.cra
deleted file mode 100644
index 932ffa8..0000000
--- a/src/patchy/nyshell.cra
+++ /dev/null
@@ -1,4 +0,0 @@
-+USE, ${PLINAME}.
-+EXE, YSHELL, D=NSHELL.
-+USE, *PATCHY.
-+PAM, 11, T=C,ATT .patchy
diff --git a/src/patchy/nysynopt.cra b/src/patchy/nysynopt.cra
deleted file mode 100644
index 7cb9f53..0000000
--- a/src/patchy/nysynopt.cra
+++ /dev/null
@@ -1,4 +0,0 @@
-+USE, ${PLINAME}.
-+EXE, YSYNOPT, D=NSYNOPT.
-+USE, *PATCHY.
-+PAM, 11, T=C,ATT .patchy
diff --git a/src/patchy/nytidy.cra b/src/patchy/nytidy.cra
deleted file mode 100644
index de4f114..0000000
--- a/src/patchy/nytidy.cra
+++ /dev/null
@@ -1,4 +0,0 @@
-+USE, ${PLINAME}.
-+EXE, YTIDY, D=NTIDY.
-+USE, *PATCHY.
-+PAM, 11, T=C,ATT .patchy
diff --git a/src/patchy/p5lib.cra b/src/patchy/p5lib.cra
deleted file mode 100644
index cc88b45..0000000
--- a/src/patchy/p5lib.cra
+++ /dev/null
@@ -1,9 +0,0 @@
-+USE, ${PLINAME}.
-+ASM, 21.
-+EXE.
-+USE, *PATCHY.
-+USE, PATCHY_LIB.
-+USE, QDEBUG.
-+USE, BUGLRSHFT,IF=SUN. Sun's F77 Version 3.0 has bad lrshft.
-+DIVERT, NOOPT.
-+PAM, 11, T=C,ATT .patchy
diff --git a/src/patchy/p5verify.car b/src/patchy/p5verify.car
deleted file mode 100755
index a1e3c6d..0000000
--- a/src/patchy/p5verify.car
+++ /dev/null
@@ -1,1671 +0,0 @@
-P5VERIFY 1.04 1995/11/02 17.00 Reference test PAM
-
-x Test PAM to verify the operation of NYPATCHY
-
- line 5 of title deck @p5verify
- line 6 of title deck @p5verify
- line 7 of title deck @p5verify
- line 8 of title deck @p5verify
- line 9 of title deck @p5verify
- line 10 of title deck @p5verify
- line 11 of title deck @p5verify
- line 12 of title deck @p5verify
-+PATCH, *VERIFY.
-+USE, EXPECT.
-+USE, *TEST.
-+PATCH, *TEST, T=JOIN. Pilot
-+USE, VCDE, ALPHA. ${HOME} ${USER} ${XXX}
-+USE, NEWF. output from new features to be diverted
-+USE, NOCHECK. output of un-checkable material extra diverted
-+USE, ACTX, ACTY, ACTZ.
-+USE, QMAPO.
-+USE, NOSUCH, T=INH.
-+PATCH, ACTZ. 3rd level actions
-+USE, ACTY.
-+DECK, ZZZ_1, T=JOIN.
-+SELF, IF=NIL.
- z line 2 of D=ZZZ_1 of P=ACTZ
- z line 3 of D=ZZZ_1 of P=ACTZ
- z line 4 of D=ZZZ_1 of P=ACTZ
- z line 5 of D=ZZZ_1 of P=ACTZ
- z line 6 of D=ZZZ_1 of P=ACTZ
- z line 7 of D=ZZZ_1 of P=ACTZ
- z line 8 of D=ZZZ_1 of P=ACTZ
- z line 9 of D=ZZZ_1 of P=ACTZ
- z line 10 of D=ZZZ_1 of P=ACTZ
- z line 11 of D=ZZZ_1 of P=ACTZ
- z line 12 of D=ZZZ_1 of P=ACTZ
- z line 13 of D=ZZZ_1 of P=ACTZ
- z line 14 of D=ZZZ_1 of P=ACTZ
- z line 15 of D=ZZZ_1 of P=ACTZ
- z line 16 of D=ZZZ_1 of P=ACTZ
- z line 17 of D=ZZZ_1 of P=ACTZ
- z line 18 of D=ZZZ_1 of P=ACTZ
- z line 19 of D=ZZZ_1 of P=ACTZ
- z line 20 of D=ZZZ_1 of P=ACTZ
- z line 21 of D=ZZZ_1 of P=ACTZ
- z line 22 of D=ZZZ_1 of P=ACTZ
- z line 23 of D=ZZZ_1 of P=ACTZ
- z line 24 of D=ZZZ_1 of P=ACTZ
-+DECK, ZZZ_2, T=JOIN.
-+SELF, IF=NIL.
- z line 2 of D=ZZZ_2 of P=ACTZ
- z line 3 of D=ZZZ_2 of P=ACTZ
- z line 4 of D=ZZZ_2 of P=ACTZ
- z line 5 of D=ZZZ_2 of P=ACTZ
- z line 6 of D=ZZZ_2 of P=ACTZ
- z line 7 of D=ZZZ_2 of P=ACTZ
- z line 8 of D=ZZZ_2 of P=ACTZ
- z line 9 of D=ZZZ_2 of P=ACTZ
- z line 10 of D=ZZZ_2 of P=ACTZ
- z line 11 of D=ZZZ_2 of P=ACTZ
- z line 12 of D=ZZZ_2 of P=ACTZ
- z line 13 of D=ZZZ_2 of P=ACTZ
- z line 14 of D=ZZZ_2 of P=ACTZ
- z line 15 of D=ZZZ_2 of P=ACTZ
- z line 16 of D=ZZZ_2 of P=ACTZ
- z line 17 of D=ZZZ_2 of P=ACTZ
- z line 18 of D=ZZZ_2 of P=ACTZ
- z line 19 of D=ZZZ_2 of P=ACTZ
- z line 20 of D=ZZZ_2 of P=ACTZ
- z line 21 of D=ZZZ_2 of P=ACTZ
- z line 22 of D=ZZZ_2 of P=ACTZ
- z line 23 of D=ZZZ_2 of P=ACTZ
- z line 24 of D=ZZZ_2 of P=ACTZ
-+DECK, ZZZ_3, T=JOIN, IF=NEWF. new features
-+SELF, IF=NIL.
- z line 2 of D=ZZZ_3 of P=ACTZ
- z line 3 of D=ZZZ_3 of P=ACTZ
- z line 4 of D=ZZZ_3 of P=ACTZ
- z line 5 of D=ZZZ_3 of P=ACTZ
- z line 6 of D=ZZZ_3 of P=ACTZ
- z line 7 of D=ZZZ_3 of P=ACTZ
- z line 8 of D=ZZZ_3 of P=ACTZ
- z line 9 of D=ZZZ_3 of P=ACTZ
- z line 10 of D=ZZZ_3 of P=ACTZ
- z line 11 of D=ZZZ_3 of P=ACTZ
- z line 12 of D=ZZZ_3 of P=ACTZ
- z line 13 of D=ZZZ_3 of P=ACTZ
- z line 14 of D=ZZZ_3 of P=ACTZ
- z line 15 of D=ZZZ_3 of P=ACTZ
- z line 16 of D=ZZZ_3 of P=ACTZ
- z line 17 of D=ZZZ_3 of P=ACTZ
- z line 18 of D=ZZZ_3 of P=ACTZ
- z line 19 of D=ZZZ_3 of P=ACTZ
- z line 20 of D=ZZZ_3 of P=ACTZ
- z line 21 of D=ZZZ_3 of P=ACTZ
- z line 22 of D=ZZZ_3 of P=ACTZ
- z line 23 of D=ZZZ_3 of P=ACTZ
- z line 24 of D=ZZZ_3 of P=ACTZ
-+PATCH, ACTY. 2nd level actions
-+USE, ACTX.
-+DECK, YYY_1, T=JOIN.
-+REPL, ACTX, XXX_2, 18.
- y line 2 of D=YYY_1 of P=ACTY
- y line 3 of D=YYY_1 of P=ACTY
- y line 4 of D=YYY_1 of P=ACTY
-+REPL, ACTX, XXX_2, 22.
- y line 6 of D=YYY_1 of P=ACTY
-+ADB, ACTX, XXX_2, 27.
- y line 8 of D=YYY_1 of P=ACTY
- y line 9 of D=YYY_1 of P=ACTY
- y line 10 of D=YYY_1 of P=ACTY
-+ADB, ACTX, XXX_2, 36.
- y line 12 of D=YYY_1 of P=ACTY
- y line 13 of D=YYY_1 of P=ACTY
-+DEL,,, 52-54.
-+ADD,,, 68.
- y line 16 of D=YYY_1 of P=ACTY
- y line 17 of D=YYY_1 of P=ACTY
-+ADD,,, 70.
- y line 19 of D=YYY_1 of P=ACTY
- y line 20 of D=YYY_1 of P=ACTY
-+SELF, IF=NIL.
- y line 22 of D=YYY_1 of P=ACTY
- y line 23 of D=YYY_1 of P=ACTY
- y line 24 of D=YYY_1 of P=ACTY
-+DECK, YYY_2, T=JOIN.
-+SELF, IF=NIL.
- y line 2 of D=YYY_2 of P=ACTY
- y line 3 of D=YYY_2 of P=ACTY
- y line 4 of D=YYY_2 of P=ACTY
- y line 5 of D=YYY_2 of P=ACTY
- y line 6 of D=YYY_2 of P=ACTY
- y line 7 of D=YYY_2 of P=ACTY
- y line 8 of D=YYY_2 of P=ACTY
- y line 9 of D=YYY_2 of P=ACTY
- y line 10 of D=YYY_2 of P=ACTY
- y line 11 of D=YYY_2 of P=ACTY
- y line 12 of D=YYY_2 of P=ACTY
- y line 13 of D=YYY_2 of P=ACTY
- y line 14 of D=YYY_2 of P=ACTY
- y line 15 of D=YYY_2 of P=ACTY
- y line 16 of D=YYY_2 of P=ACTY
- y line 17 of D=YYY_2 of P=ACTY
- y line 18 of D=YYY_2 of P=ACTY
- y line 19 of D=YYY_2 of P=ACTY
- y line 20 of D=YYY_2 of P=ACTY
- y line 21 of D=YYY_2 of P=ACTY
- y line 22 of D=YYY_2 of P=ACTY
- y line 23 of D=YYY_2 of P=ACTY
- y line 24 of D=YYY_2 of P=ACTY
-+DECK, YYY_3, T=JOIN, IF=NEWF. new features
-+SELF, IF=NIL.
- y line 2 of D=YYY_3 of P=ACTY
- y line 3 of D=YYY_3 of P=ACTY
- y line 4 of D=YYY_3 of P=ACTY
- y line 5 of D=YYY_3 of P=ACTY
- y line 6 of D=YYY_3 of P=ACTY
- y line 7 of D=YYY_3 of P=ACTY
- y line 8 of D=YYY_3 of P=ACTY
- y line 9 of D=YYY_3 of P=ACTY
- y line 10 of D=YYY_3 of P=ACTY
- y line 11 of D=YYY_3 of P=ACTY
- y line 12 of D=YYY_3 of P=ACTY
- y line 13 of D=YYY_3 of P=ACTY
- y line 14 of D=YYY_3 of P=ACTY
- y line 15 of D=YYY_3 of P=ACTY
- y line 16 of D=YYY_3 of P=ACTY
- y line 17 of D=YYY_3 of P=ACTY
- y line 18 of D=YYY_3 of P=ACTY
- y line 19 of D=YYY_3 of P=ACTY
- y line 20 of D=YYY_3 of P=ACTY
- y line 21 of D=YYY_3 of P=ACTY
- y line 22 of D=YYY_3 of P=ACTY
- y line 23 of D=YYY_3 of P=ACTY
- y line 24 of D=YYY_3 of P=ACTY
-+PATCH, ACTX. simple actions
-+DECK, XXX_1, T=JOIN.
-+ADB, ALPHA, ALP_2, 11. simple ADB
- x line 2 of D=XXX_1 of P=ACTX
-+ADD, ALPHA, ALP_2, L=12. simple ADD
- x line 4 of D=XXX_1 of P=ACTX
- x line 5 of D=XXX_1 of P=ACTX
-+REPL, ALPHA, D=ALP_2, L=13-16. simple REPL of several lines
- x line 7 of D=XXX_1 of P=ACTX
- x line 8 of D=XXX_1 of P=ACTX
- x line 9 of D=XXX_1 of P=ACTX
-+REPL,, ALP_2, 18. simple REPL of a single line
- x line 11 of D=XXX_1 of P=ACTX
- x line 12 of D=XXX_1 of P=ACTX
-+REPL, P=ALPHA, D=ALP_2, L=20. REPL with zero lines
-+DEL, ALPHA, ALP_2, 24-29. simple DEL of several lines
-+ADD, VCDE, CDK, 1. add right at the start of a KEEP
- x line 16 of D=XXX_1 of P=ACTX
-+DEL,,, 19. delete the last line of a KEEP
-+ADD, VCDE, CDK, 4. add into the middle of a KEEP
- x line 19 of D=XXX_1 of P=ACTX
- x line 20 of D=XXX_1 of P=ACTX
-+ADD, VCDE, CDK, 37. add again into the middle
- x line 22 of D=XXX_1 of P=ACTX
- x line 23 of D=XXX_1 of P=ACTX
- x line 24 of D=XXX_1 of P=ACTX
-+DEL, BETA, BET_1, 26. delete conditional +self
-+ADB, ALPHA, ALP_2, 35, Z=SEQ1. test Z= on action lines
-+ADD,,, 36, Z=SEQ2.
- x line 28 of D=XXX_1 of P=ACTX
-+REPL,,,, 41-44, Z=SEQ3.
- x line 30 of D=XXX_1 of P=ACTX
- x line 31 of D=XXX_1 of P=ACTX
-+DECK, XXX_2.
-+ADB, BETA, BET_2, 11.
- x line 2 of D=XXX_2 of P=ACTX
- x line 3 of D=XXX_2 of P=ACTX
- x line 4 of D=XXX_2 of P=ACTX
- x line 5 of D=XXX_2 of P=ACTX
-+REPL, BETA, BET_2, 11-13.
- x line 7 of D=XXX_2 of P=ACTX
- x line 8 of D=XXX_2 of P=ACTX
- x line 9 of D=XXX_2 of P=ACTX
- x line 10 of D=XXX_2 of P=ACTX
-+ADD, BETA, BET_2, 13.
- x line 12 of D=XXX_2 of P=ACTX
- x line 13 of D=XXX_2 of P=ACTX
- x line 14 of D=XXX_2 of P=ACTX
- x line 15 of D=XXX_2 of P=ACTX
-+REPL, BETA, BET_2, 19-21.
- x line 17 of D=XXX_2 of P=ACTX
- x line 18 of D=XXX_2 of P=ACTX
- x line 19 of D=XXX_2 of P=ACTX
- x line 20 of D=XXX_2 of P=ACTX
-+REPL, BETA, BET_2, 24.
- x line 22 of D=XXX_2 of P=ACTX
-+ADB, BETA, BET_2, 27.
- x line 24 of D=XXX_2 of P=ACTX
- x line 25 of D=XXX_2 of P=ACTX
-+ADD, BETA, BET_2, 30.
- x line 27 of D=XXX_2 of P=ACTX
- x line 28 of D=XXX_2 of P=ACTX
- x line 29 of D=XXX_2 of P=ACTX
-+ADB, BETA, BET_2, 27.
- x line 31 of D=XXX_2 of P=ACTX
- x line 32 of D=XXX_2 of P=ACTX
-+REPL, BETA, BET_2, 34-37.
- x line 34 of D=XXX_2 of P=ACTX
- x line 35 of D=XXX_2 of P=ACTX
- x line 36 of D=XXX_2 of P=ACTX
-+ADD, BETA, BET_2, 42.
- x line 38 of D=XXX_2 of P=ACTX
- x line 39 of D=XXX_2 of P=ACTX
- x line 40 of D=XXX_2 of P=ACTX
- x line 41 of D=XXX_2 of P=ACTX
- x line 42 of D=XXX_2 of P=ACTX
- x line 43 of D=XXX_2 of P=ACTX
-+ADB, BETA, BET_2, 48.
- x line 45 of D=XXX_2 of P=ACTX
- x line 46 of D=XXX_2 of P=ACTX
-+ADD, BETA, BET_2, 48.
- x line 48 of D=XXX_2 of P=ACTX
- x line 49 of D=XXX_2 of P=ACTX
-+ADD, BETA, BET_2, 50.
- x line 51 of D=XXX_2 of P=ACTX
-+ADB, BETA, BET_2, 51.
- x line 53 of D=XXX_2 of P=ACTX
- x line 54 of D=XXX_2 of P=ACTX
- x expect this difference between Patchy 4 and 5
- x line 56 of D=XXX_2 of P=ACTX
-+DEL,,, 56, IF=-PY_VS5.
-+REPL,,, 56, IF=PY_VS5.
--SELF.
-+REPL, BETA, BET_2, 62.
-+SEQ, PLOCAL, DLOCAL.
-+REPL, BETA, BET_2, 65-67.
- x line 63 of D=XXX_2 of P=ACTX
-+SEQ, COLOCAL.
- x line 65 of D=XXX_2 of P=ACTX
- x line 66 of D=XXX_2 of P=ACTX
-+REPL, BETA, BET_2, 74-77.
- x line 68 of D=XXX_2 of P=ACTX
- x line 69 of D=XXX_2 of P=ACTX
- x line 70 of D=XXX_2 of P=ACTX
-+SEQ, MULTI.
-+DECK, XXX_3, IF=NEWF. new features
-+REPL, BETA, BET_3, 4.
-+_IF, QMAPO.
- x line 3 of D=XXX_3 of P=ACTX
-+ADD,,, 6.
-+__IF, QMSUN.
--___IF, BETA.
- x line 7 of D=XXX_3 of P=ACTX
- x line 8 of D=XXX_3 of P=ACTX
-+___ELSE.
- x line 10 of D=XXX_3 of P=ACTX
- x line 11 of D=XXX_3 of P=ACTX
-+___ENDIF.
--__ELSE.
- x line 14 of D=XXX_3 of P=ACTX
- x line 15 of D=XXX_3 of P=ACTX
-+REPL,,, 9-11.
-+___IF, BETA.
- x line 18 of D=XXX_3 of P=ACTX
- x line 19 of D=XXX_3 of P=ACTX
- x line 20 of D=XXX_3 of P=ACTX
-+___ELSE.
- x line 22 of D=XXX_3 of P=ACTX
--___ENDIF.
-+__ENDIF.
-+_ELSE.
-+ADB,,, 14.
--_ENDIF.
-+SKIP.
- x line 29 of D=XXX_3 of P=ACTX
- x line 30 of D=XXX_3 of P=ACTX
-+ADD, BETA, BET_3, 16.
- x line 32 of D=XXX_3 of P=ACTX
- x line 33 of D=XXX_3 of P=ACTX
--SELF, IF=QMAPO.
- x line 35 of D=XXX_3 of P=ACTX
-+REPL,,, 19-20.
--SELF.
-+SKIP.
- x line 39 of D=XXX_3 of P=ACTX
- x line 40 of D=XXX_3 of P=ACTX
- x line 41 of D=XXX_3 of P=ACTX
- x line 42 of D=XXX_3 of P=ACTX
- x line 43 of D=XXX_3 of P=ACTX
- x line 44 of D=XXX_3 of P=ACTX
- x line 45 of D=XXX_3 of P=ACTX
- x line 46 of D=XXX_3 of P=ACTX
- x line 47 of D=XXX_3 of P=ACTX
- x line 48 of D=XXX_3 of P=ACTX
- x line 49 of D=XXX_3 of P=ACTX
- x line 50 of D=XXX_3 of P=ACTX
- x line 51 of D=XXX_3 of P=ACTX
- x line 52 of D=XXX_3 of P=ACTX
- x line 53 of D=XXX_3 of P=ACTX
- x line 54 of D=XXX_3 of P=ACTX
- x line 55 of D=XXX_3 of P=ACTX
- x line 56 of D=XXX_3 of P=ACTX
- x line 57 of D=XXX_3 of P=ACTX
- x line 58 of D=XXX_3 of P=ACTX
- x line 59 of D=XXX_3 of P=ACTX
- x line 60 of D=XXX_3 of P=ACTX
-+PATCH, ACTXwait.
-+DECK, XXX_4. errors
-+ADB, GAMMA, GAM_2, 11.
- x line 2 of D=XXX_4 of P=ACTX
- x line 3 of D=XXX_4 of P=ACTX
- x line 4 of D=XXX_4 of P=ACTX
- x line 5 of D=XXX_4 of P=ACTX
-+REPL, GAMMA, GAM_2, 11-13.
- x line 7 of D=XXX_4 of P=ACTX
- x line 8 of D=XXX_4 of P=ACTX
- x line 9 of D=XXX_4 of P=ACTX
- x line 10 of D=XXX_4 of P=ACTX
-+ADD, GAMMA, GAM_2, 13.
- x line 12 of D=XXX_4 of P=ACTX
- x line 13 of D=XXX_4 of P=ACTX
- x line 14 of D=XXX_4 of P=ACTX
- x line 15 of D=XXX_4 of P=ACTX
-+REPL, GAMMA, GAM_2, 19-21.
- x line 17 of D=XXX_4 of P=ACTX
- x line 18 of D=XXX_4 of P=ACTX
- x line 19 of D=XXX_4 of P=ACTX
- x line 20 of D=XXX_4 of P=ACTX
-+REPL, GAMMA, GAM_2, 24.
- x line 22 of D=XXX_4 of P=ACTX
-+ADB, GAMMA, GAM_2, 27.
- x line 24 of D=XXX_4 of P=ACTX
- x line 25 of D=XXX_4 of P=ACTX
-+ADD, GAMMA, GAM_2, 30.
- x line 27 of D=XXX_4 of P=ACTX
- x line 28 of D=XXX_4 of P=ACTX
- x line 29 of D=XXX_4 of P=ACTX
-+ADB, GAMMA, GAM_2, 27.
- x line 31 of D=XXX_4 of P=ACTX
- x line 32 of D=XXX_4 of P=ACTX
-+REPL, GAMMA, GAM_2, 34-37.
- x line 34 of D=XXX_4 of P=ACTX
- x line 35 of D=XXX_4 of P=ACTX
- x line 36 of D=XXX_4 of P=ACTX
-+ADD, GAMMA, GAM_2, 42.
- x line 38 of D=XXX_4 of P=ACTX
- x line 39 of D=XXX_4 of P=ACTX
- x line 40 of D=XXX_4 of P=ACTX
- x line 41 of D=XXX_4 of P=ACTX
- x line 42 of D=XXX_4 of P=ACTX
- x line 43 of D=XXX_4 of P=ACTX
-+ADB, GAMMA, GAM_2, 48.
- x line 45 of D=XXX_4 of P=ACTX
- x line 46 of D=XXX_4 of P=ACTX
-+ADD, GAMMA, GAM_2, 48.
- x line 48 of D=XXX_4 of P=ACTX
- x line 49 of D=XXX_4 of P=ACTX
-+PATCH, VCDE. sequence definitions
-+KEEP, ELEM1.
- s line 2 of D= of P=VCDE
-+KEEP, ELEM2.
- s line 4 of D= of P=VCDE
-+KEEP, ELEM3.
- s line 6 of D= of P=VCDE
-+KEEP, SEQ1.
- s line 8 of D= of P=VCDE
- s line 9 of D= of P=VCDE
-+KEEP, SEQ2.
- s line 11 of D= of P=VCDE
- s line 12 of D= of P=VCDE
-+KEEP, SEQ3, P=ALPHA.
- s line 14 of D= of P=VCDE local -> P=alpha
-+KEEP, SEQ4.
- s line 16 of D= of P=VCDE
- s line 17 of D= of P=VCDE
-+KEEP, SEQ5, P=ALPHA.
- s line 19 of D= of P=VCDE local -> P=alpha, but overruled
- s line 20 of D= of P=VCDE
-+KEEP, SEQ5.
- s line 22 of D= of P=VCDE
- s line 23 of D= of P=VCDE
- s line 24 of D= of P=VCDE
-+KEEP, SEQSUB1.
-+CDE, ELEM1.
-+CDE, ELEM2.
- s line 28 of D= of P=VCDE
-+CDE, ELEM3.
- s line 30 of D= of P=VCDE
- s line 31 of D= of P=VCDE
-+KEEP, SEQSUB2.
- s line 33 of D= of P=VCDE
-+CDE, ELEM1.
-+CDE, ELEM2.
-+KEEP, QCARDL, T=NOLIST.
-+KEEP, NOLIST, T=NOLIST.
- s line 38 of D= of P=VCDE
- s line 39 of D= of P=VCDE
- s line 40 of D= of P=VCDE
-+KEEP, SEQ2.
- s line 42 of D= of P=VCDE second definition of SEQ2
-+KEEP, SEQ5.
- s line 44 of D= of P=VCDE second definition of SEQ5
-+KEEP, SEQ6.
-+KEEP, SEQ7.
- s line 47 of D= of P=VCDE
-+KEEP, SEQ2.
- s line 49 of D= of P=VCDE third definition of SEQ2
- s line 50 of D= of P=VCDE
- s line 51 of D= of P=VCDE
-+KEEP, SEQ2.
-+KEEP, SEQ2.
- s line 54 of D= of P=VCDE fifth definition of SEQ2
- s line 55 of D= of P=VCDE
-+KEEP, SEQ5.
-+KEEP, SEQ8.
-+DECK, CDK.
-+KEEP, COMP1.
-+CDE, SEQ1.
-+CDE, SEQ4.
- s line 4 of D=CDK of P=VCDE
- s line 5 of D=CDK of P=VCDE
-+KEEP, COLOCAL.
-+CDE, PLOCAL, DLOCAL.
-+KEEP, SEQ3, P=BETA.
- s line 9 of D=CDK of P=VCDE local -> to P=beta
- s line 10 of D=CDK of P=VCDE
-+KEEP, PLOCAL, P=ALPHA.
- s line 12 of D=CDK of P=VCDE local -> to P=alpha
- s line 13 of D=CDK of P=VCDE
-+KEEP, PLOCAL, P=BETA.
- s line 15 of D=CDK of P=VCDE local -> to P=beta
- s line 16 of D=CDK of P=VCDE
-+KEEP, DLOCAL, P=ALPHA, D= ALP_1.
- s line 18 of D=CDK of P=VCDE local -> to P=alpha.alp_1
- s line 19 of D=CDK of P=VCDE
-+KEEP, DLOCAL, P=ALPHA, D= ALP_2.
- s line 21 of D=CDK of P=VCDE local -> to P=alpha.alp_2
- s line 22 of D=CDK of P=VCDE
-+KEEP, DLOCAL, P=ALPHA, D= ALP_3.
- s line 24 of D=CDK of P=VCDE local -> to P=alpha.alp_3
- s line 25 of D=CDK of P=VCDE
-+KEEP, DLOCAL, P=BETA, D=BET_1.
- s line 27 of D=CDK of P=VCDE local -> to P=beta.bet_1
- s line 28 of D=CDK of P=VCDE
-+KEEP, DLOCAL, P=BETA, D=BET_2.
- s line 30 of D=CDK of P=VCDE local -> to P=beta.bet_2
- s line 31 of D=CDK of P=VCDE
-+KEEP, PLOCAL, P=ALPHA.
- s line 33 of D=CDK of P=VCDE local to be over-ruled
- s line 34 of D=CDK of P=VCDE
- s line 35 of D=CDK of P=VCDE
-+KEEP, MULTI.
- s line 37 of D=CDK of P=VCDE
- s line 38 of D=CDK of P=VCDE
-+CDE, COMP1.
- s line 40 of D=CDK of P=VCDE
- s line 41 of D=CDK of P=VCDE
-+CDE, COLOCAL.
- s line 43 of D=CDK of P=VCDE
- s line 44 of D=CDK of P=VCDE
-+SELF, IF=-VCDE.
- s line 46 of D=CDK of P=VCDE
- s line 47 of D=CDK of P=VCDE
- s line 48 of D=CDK of P=VCDE
- s line 49 of D=CDK of P=VCDE
- s line 50 of D=CDK of P=VCDE
- s line 51 of D=CDK of P=VCDE
- s line 52 of D=CDK of P=VCDE
- s line 53 of D=CDK of P=VCDE
- s line 54 of D=CDK of P=VCDE
- s line 55 of D=CDK of P=VCDE
-+DECK, CDK_3. new features
-+KEEP, NEWF1.
-+_IF, QMAPO.
- s line 3 of D=CDK_3 of P=VCDE
- s line 4 of D=CDK_3 of P=VCDE
-+_ENDIF
-+KEEP, NEWF2.
-+INCLUDE, MQCOMM, DQCOMM.
-+_IFNOT, QMAPO.
- s line 9 of D=CDK_3 of P=VCDE
- s line 10 of D=CDK_3 of P=VCDE
- s line 11 of D=CDK_3 of P=VCDE
-+_ENDIF
-+KEEP, NEWF3.
-+_IF, QMAPO.
- s line 15 of D=CDK_3 of P=VCDE
- s line 16 of D=CDK_3 of P=VCDE
-+_ELSE.
- s line 18 of D=CDK_3 of P=VCDE
-+_ENDIF
-+KEEP, NEWF4.
-+_IF, QMAPO.
-+__IF, QMSUN.
- s line 23 of D=CDK_3 of P=VCDE
- s line 24 of D=CDK_3 of P=VCDE
-+__ELSE.
- s line 26 of D=CDK_3 of P=VCDE
-+__ENDIF
- s line 28 of D=CDK_3 of P=VCDE
- s line 29 of D=CDK_3 of P=VCDE
-+_ELSE.
- s line 31 of D=CDK_3 of P=VCDE
-+_ENDIF
-+NIL. comment in sequence
-+nil. and more
- s line 35 of D=CDK_3 of P=VCDE
-+SELF, IF=-VCDE.
- s line 37 of D=CDK_3 of P=VCDE
- s line 38 of D=CDK_3 of P=VCDE
- s line 39 of D=CDK_3 of P=VCDE
- s line 40 of D=CDK_3 of P=VCDE
- s line 41 of D=CDK_3 of P=VCDE
- s line 42 of D=CDK_3 of P=VCDE
- s line 43 of D=CDK_3 of P=VCDE
- s line 44 of D=CDK_3 of P=VCDE
- s line 45 of D=CDK_3 of P=VCDE
- s line 46 of D=CDK_3 of P=VCDE
- s line 47 of D=CDK_3 of P=VCDE
- s line 48 of D=CDK_3 of P=VCDE
- s line 49 of D=CDK_3 of P=VCDE
- s line 50 of D=CDK_3 of P=VCDE
-+TITLE: P5VERIFY 1.04 part 2
-+PATCH, ALPHA. simple
-+USE, BETA.
-+USE, KAPPA.
-+IMITATE, LAMBDA.
-+DECK, ALP_1. simple, self material only
- SUBROUTINE ALP_1
-+CDE, ELEM1.
-a line 3 of D=ALP_1 of P=ALPHA
-+CDE, SEQ1, SEQ2, SEQ8, SEQ4, SEQ6.
-a line 5 of D=ALP_1 of P=ALPHA
-+SEQ, SEQSUB1, SEQSUB2.
-a line 7 of D=ALP_1 of P=ALPHA
-a line 8 of D=ALP_1 of P=ALPHA
-a line 9 of D=ALP_1 of P=ALPHA
-+SELF, IF=QMAPO.
-a line 11 of D=ALP_1 of P=ALPHA
-a line 12 of D=ALP_1 of P=ALPHA
-+SELF, IF=QMSUN.
-a line 14 of D=ALP_1 of P=ALPHA
-a line 15 of D=ALP_1 of P=ALPHA
-+SELF, SEQ1.
-a line 17 of D=ALP_1 of P=ALPHA
-a line 18 of D=ALP_1 of P=ALPHA
-+SELF, NOSUCH.
-a line 20 of D=ALP_1 of P=ALPHA
-a line 21 of D=ALP_1 of P=ALPHA
-+SELF.
-a line 23 of D=ALP_1 of P=ALPHA
-a line 24 of D=ALP_1 of P=ALPHA
-+SEQ, NOSUCH, T=PASS.
-a line 26 of D=ALP_1 of P=ALPHA
-a line 27 of D=ALP_1 of P=ALPHA
-+SEQ, NOLIST.
-a line 29 of D=ALP_1 of P=ALPHA
-a line 30 of D=ALP_1 of P=ALPHA
-+SEQ, QFTITLE, N=72.
-+SEQ, QFTITLCH, N=72.
-a line 33 of D=ALP_1 of P=ALPHA
-a line 34 of D=ALP_1 of P=ALPHA
-a line 35 of D=ALP_1 of P=ALPHA
-a line 36 of D=ALP_1 of P=ALPHA
-+SEQ, PLOCAL.
-a line 38 of D=ALP_1 of P=ALPHA
-+SEQ, DLOCAL.
-a line 40 of D=ALP_1 of P=ALPHA
-+SEQ, CRASEQ.
-a line 42 of D=ALP_1 of P=ALPHA
-a line 43 of D=ALP_1 of P=ALPHA
-+SEQ, NOSUCH, IF=QMSUN.
-a line 45 of D=ALP_1 of P=ALPHA
-a line 46 of D=ALP_1 of P=ALPHA
-a line 47 of D=ALP_1 of P=ALPHA
-a line 48 of D=ALP_1 of P=ALPHA
-a line 49 of D=ALP_1 of P=ALPHA
-a line 50 of D=ALP_1 of P=ALPHA
-a line 51 of D=ALP_1 of P=ALPHA
-a line 52 of D=ALP_1 of P=ALPHA
-+SEQ, QCARDL. =====================================================
-+SEQ, bkYDIFF, IF=DOC_INL.
-+DECK, ALP_2. simple, foreign material into here
- SUBROUTINE ALP_2
-+SEQ, PLOCAL, DLOCAL.
-a line 3 of D=ALP_2 of P=ALPHA
-+SEQ, COLOCAL.
-a line 5 of D=ALP_2 of P=ALPHA
-+SEQ, COMP1.
-a line 7 of D=ALP_2 of P=ALPHA
-+SEQ, MULTI.
-a line 9 of D=ALP_2 of P=ALPHA
-a line 10 of D=ALP_2 of P=ALPHA
-a line 11 of D=ALP_2 of P=ALPHA
-a line 12 of D=ALP_2 of P=ALPHA
-a line 13 of D=ALP_2 of P=ALPHA
-a line 14 of D=ALP_2 of P=ALPHA
-a line 15 of D=ALP_2 of P=ALPHA
-a line 16 of D=ALP_2 of P=ALPHA
-a line 17 of D=ALP_2 of P=ALPHA
-a line 18 of D=ALP_2 of P=ALPHA
-a line 19 of D=ALP_2 of P=ALPHA
-a line 20 of D=ALP_2 of P=ALPHA
-a line 21 of D=ALP_2 of P=ALPHA
-a line 22 of D=ALP_2 of P=ALPHA
-a line 23 of D=ALP_2 of P=ALPHA
-a line 24 of D=ALP_2 of P=ALPHA
-a line 25 of D=ALP_2 of P=ALPHA
-a line 26 of D=ALP_2 of P=ALPHA
-a line 27 of D=ALP_2 of P=ALPHA
-a line 28 of D=ALP_2 of P=ALPHA
-a line 29 of D=ALP_2 of P=ALPHA
-a line 30 of D=ALP_2 of P=ALPHA
-a line 31 of D=ALP_2 of P=ALPHA
-+SEQ, SEQ5.
-a line 33 of D=ALP_2 of P=ALPHA
-a line 34 of D=ALP_2 of P=ALPHA
-a line 35 of D=ALP_2 of P=ALPHA
-a line 36 of D=ALP_2 of P=ALPHA
-a line 37 of D=ALP_2 of P=ALPHA
-a line 38 of D=ALP_2 of P=ALPHA
-a line 39 of D=ALP_2 of P=ALPHA
-a line 40 of D=ALP_2 of P=ALPHA
-a line 41 of D=ALP_2 of P=ALPHA
-a line 42 of D=ALP_2 of P=ALPHA
-a line 43 of D=ALP_2 of P=ALPHA
-a line 44 of D=ALP_2 of P=ALPHA
-a line 45 of D=ALP_2 of P=ALPHA
-a line 46 of D=ALP_2 of P=ALPHA
-a line 47 of D=ALP_2 of P=ALPHA
-a line 48 of D=ALP_2 of P=ALPHA
-+DECK, ALP_3, IF=NEWF. simple, new features
- SUBROUTINE ALP_3
-a line 2 of D=ALP_3 of P=ALPHA
-a line 3 of D=ALP_3 of P=ALPHA
-+INCLUDE, MQCOMM.
-a line 5 of D=ALP_3 of P=ALPHA
-a line 6 of D=ALP_3 of P=ALPHA
-+SEQ, QFHEAD, LIM=32. title: ?
-+SEQ, QFNAME . name: ?
-+SEQ, QFVERS . version: ?
-+SEQ, QFVPRIM . primary: ?
-+SEQ, QFVSEC . secondary: ?
-a line 12 of D=ALP_3 of P=ALPHA
-a line 13 of D=ALP_3 of P=ALPHA
-a line 14 of D=ALP_3 of P=ALPHA
-+NIL. line 15 of D=ALP_3 of P=ALPHA
-a line 16 of D=ALP_3 of P=ALPHA
-a line 17 of D=ALP_3 of P=ALPHA
-+_IF, QMAPO.
-a line 19 of D=ALP_3 of P=ALPHA
-a line 20 of D=ALP_3 of P=ALPHA
-+_ENDIF.
-a line 22 of D=ALP_3 of P=ALPHA
-+_IF, QMSUN.
-a line 24 of D=ALP_3 of P=ALPHA
-a line 25 of D=ALP_3 of P=ALPHA
-+_ENDIF.
-a line 27 of D=ALP_3 of P=ALPHA
-a line 28 of D=ALP_3 of P=ALPHA
-a line 29 of D=ALP_3 of P=ALPHA
-+_IF, QMAPO.
-a line 31 of D=ALP_3 of P=ALPHA
-a line 32 of D=ALP_3 of P=ALPHA
-+_ELSE.
-a line 34 of D=ALP_3 of P=ALPHA
-a line 35 of D=ALP_3 of P=ALPHA
-+_ENDIF.
-a line 37 of D=ALP_3 of P=ALPHA
-+_IF, QMSUN.
-a line 39 of D=ALP_3 of P=ALPHA
-a line 40 of D=ALP_3 of P=ALPHA
-+_ELSE.
-a line 42 of D=ALP_3 of P=ALPHA
-a line 43 of D=ALP_3 of P=ALPHA
-+_ENDIF.
-a line 45 of D=ALP_3 of P=ALPHA
-a line 46 of D=ALP_3 of P=ALPHA
-a line 47 of D=ALP_3 of P=ALPHA
-+_IF, QMAPO.
-a line 49 of D=ALP_3 of P=ALPHA
-a line 50 of D=ALP_3 of P=ALPHA
-+_ELSE, QMSUN.
-a line 52 of D=ALP_3 of P=ALPHA
-a line 53 of D=ALP_3 of P=ALPHA
-+_ELSE, ALPHA.
-a line 55 of D=ALP_3 of P=ALPHA
-a line 56 of D=ALP_3 of P=ALPHA
-+_ENDIF.
-a line 58 of D=ALP_3 of P=ALPHA
-a line 59 of D=ALP_3 of P=ALPHA
-a line 60 of D=ALP_3 of P=ALPHA
-+_IF, QMSUN.
-a line 62 of D=ALP_3 of P=ALPHA
-a line 63 of D=ALP_3 of P=ALPHA
-+_ELSE, QMAPO.
-a line 65 of D=ALP_3 of P=ALPHA
-a line 66 of D=ALP_3 of P=ALPHA
-+_ELSE, ALPHA.
-a line 68 of D=ALP_3 of P=ALPHA
-a line 69 of D=ALP_3 of P=ALPHA
-+_ELSE.
-a line 71 of D=ALP_3 of P=ALPHA
-a line 72 of D=ALP_3 of P=ALPHA
-+_ENDIF.
-a line 74 of D=ALP_3 of P=ALPHA
-a line 75 of D=ALP_3 of P=ALPHA
-a line 76 of D=ALP_3 of P=ALPHA
-+_IF, QMSUN.
-+SEQ, SEQ1.
-a line 79 of D=ALP_3 of P=ALPHA
-+_ELSE, -ALPHA.
-+SEQ, MISSSQ, MISSSQ2.
-a line 82 of D=ALP_3 of P=ALPHA
-+_ELSE.
-a line 84 of D=ALP_3 of P=ALPHA
-+SEQ, COLOCAL.
-+_ENDIF.
-a line 87 of D=ALP_3 of P=ALPHA
-a line 88 of D=ALP_3 of P=ALPHA
-a line 89 of D=ALP_3 of P=ALPHA
-a line 90 of D=ALP_3 of P=ALPHA
-+_IF, LAMBDA.
-a line 92 of D=ALP_3 of P=ALPHA
-+__IF, QMAPO.
-a line 94 of D=ALP_3 of P=ALPHA
-a line 95 of D=ALP_3 of P=ALPHA
-+__ENDIF.
-a line 97 of D=ALP_3 of P=ALPHA
-+_ENDIF.
-a line 99 of D=ALP_3 of P=ALPHA
-a line 100 of D=ALP_3 of P=ALPHA
-a line 101 of D=ALP_3 of P=ALPHA
-a line 102 of D=ALP_3 of P=ALPHA
-+_IF, ALPHA.
-a line 104 of D=ALP_3 of P=ALPHA
-+__IF, QMSUN.
-a line 106 of D=ALP_3 of P=ALPHA
-a line 107 of D=ALP_3 of P=ALPHA
-+__ENDIF.
-a line 109 of D=ALP_3 of P=ALPHA
-+_ENDIF.
-a line 111 of D=ALP_3 of P=ALPHA
-a line 112 of D=ALP_3 of P=ALPHA
-a line 113 of D=ALP_3 of P=ALPHA
-+_IF, -ALPHA.
-a line 115 of D=ALP_3 of P=ALPHA
-+__IF, QMAPO.
-a line 117 of D=ALP_3 of P=ALPHA
-a line 118 of D=ALP_3 of P=ALPHA
-+__ENDIF.
-a line 120 of D=ALP_3 of P=ALPHA
-+_ENDIF.
-a line 122 of D=ALP_3 of P=ALPHA
-+_IFNOT, ALPHA, BETA.
-a line 124 of D=ALP_3 of P=ALPHA
-+__IF, QMSUN.
-a line 126 of D=ALP_3 of P=ALPHA
-a line 127 of D=ALP_3 of P=ALPHA
-+__ENDIF.
-a line 129 of D=ALP_3 of P=ALPHA
-+_ENDIF.
-a line 131 of D=ALP_3 of P=ALPHA
-a line 132 of D=ALP_3 of P=ALPHA
-a line 133 of D=ALP_3 of P=ALPHA
-+_IF, QMAPO.
-+NIL. line 135 of D=ALP_3 of P=ALPHA
-a line 136 of D=ALP_3 of P=ALPHA
-a line 137 of D=ALP_3 of P=ALPHA
-a line 138 of D=ALP_3 of P=ALPHA
-a line 139 of D=ALP_3 of P=ALPHA
-+__IF, QMSUN.
-a line 141 of D=ALP_3 of P=ALPHA
-a line 142 of D=ALP_3 of P=ALPHA
-a line 143 of D=ALP_3 of P=ALPHA
-+NIL. line 144 of D=ALP_3 of P=ALPHA
-a line 145 of D=ALP_3 of P=ALPHA
-a line 146 of D=ALP_3 of P=ALPHA
-+__ENDIF.
-a line 148 of D=ALP_3 of P=ALPHA
-a line 149 of D=ALP_3 of P=ALPHA
-a line 150 of D=ALP_3 of P=ALPHA
-a line 151 of D=ALP_3 of P=ALPHA
-+NIL. line 152 of D=ALP_3 of P=ALPHA
-+_ENDIF.
-a line 154 of D=ALP_3 of P=ALPHA
-a line 155 of D=ALP_3 of P=ALPHA
-+SEQ, NEWF1.
-a line 157 of D=ALP_3 of P=ALPHA
-+SEQ, NEWF2.
-a line 159 of D=ALP_3 of P=ALPHA
-+SEQ, NEWF3.
-a line 161 of D=ALP_3 of P=ALPHA
-+SEQ, NEWF4.
-a line 163 of D=ALP_3 of P=ALPHA
-a line 164 of D=ALP_3 of P=ALPHA
-+SELF, QFHEAD, S=!, LIM=32, N=1. title: !
-a line 166 of D=ALP_3 of P=ALPHA
-a line 167 of D=ALP_3 of P=ALPHA
-+SELF.
-a line 169 of D=ALP_3 of P=ALPHA
-a line 170 of D=ALP_3 of P=ALPHA
-a line 171 of D=ALP_3 of P=ALPHA
-a line 172 of D=ALP_3 of P=ALPHA
-a line 173 of D=ALP_3 of P=ALPHA
-a line 174 of D=ALP_3 of P=ALPHA
-a line 175 of D=ALP_3 of P=ALPHA
-a line 176 of D=ALP_3 of P=ALPHA
-+DECK, ALP_4, IF=NOCHECK. simple, not checked
- SUBROUTINE ALP_4
-a line 2 of D=ALP_4 of P=ALPHA
-a line 3 of D=ALP_4 of P=ALPHA
-a line 4 of D=ALP_4 of P=ALPHA
-+SEQ, DATEQQ.
-+SEQ, TIMEQQ.
-a line 7 of D=ALP_4 of P=ALPHA
-a line 8 of D=ALP_4 of P=ALPHA a rather long line continue 1 beta continue 2 continue 3
-a line 9 of D=ALP_4 of P=ALPHA
-a line 10 of D=ALP_4 of P=ALPHA
-a line 11 of D=ALP_4 of P=ALPHA
-a line 12 of D=ALP_4 of P=ALPHA
-+DECK, ALP_5, T=JOIN, IF=NEWF. simple, new features, not checked
-+SELF, IF=NOCHECK.
- SUBROUTINE ALP_5
-a line 3 of D=ALP_5 of P=ALPHA
-a line 4 of D=ALP_5 of P=ALPHA
-+SEQ, QDATE .C date of the run is ?, this changes and would spoil the check
-+SEQ, QTIME .C time of the run is ?
-a line 7 of D=ALP_5 of P=ALPHA
-a line 8 of D=ALP_5 of P=ALPHA
-a line 9 of D=ALP_5 of P=ALPHA
-a line 10 of D=ALP_5 of P=ALPHA
-a line 11 of D=ALP_5 of P=ALPHA
-a line 12 of D=ALP_5 of P=ALPHA
-+PATCH, BETA, T=DATA. complicated
-+DECK, BET_1, T=JOIN. complicated, self material only
- SUBROUTINE BET_1
-+SEQ, PLOCAL, DLOCAL.
-b line 3 of D=BET_1 of P=BETA
-+SEQ, COLOCAL.
-b line 5 of D=BET_1 of P=BETA
-+SEQ, MULTI.
-b line 7 of D=BET_1 of P=BETA
-b line 8 of D=BET_1 of P=BETA
-+KEEP, HERE1.
-b line 10 of D=BET_1 of P=BETA
-+SEQ, SEQ4.
-+KEEP, HERE2.
-+SEQ, HERE1, SEQ5, SEQ6.
-b line 14 of D=BET_1 of P=BETA
-+SELF.
-b line 16 of D=BET_1 of P=BETA
-b line 17 of D=BET_1 of P=BETA
-b line 18 of D=BET_1 of P=BETA
-b line 19 of D=BET_1 of P=BETA
-b line 20 of D=BET_1 of P=BETA
-+SEQ, HERE2.
-b line 22 of D=BET_1 of P=BETA
-+SEQ, HERE1.
-b line 24 of D=BET_1 of P=BETA
-b line 25 of D=BET_1 of P=BETA
-+SELF, IF=NOSUCH.
-b line 27 of D=BET_1 of P=BETA
-b line 28 of D=BET_1 of P=BETA
-+SELF.
-b line 30 of D=BET_1 of P=BETA
-b line 31 of D=BET_1 of P=BETA
-b line 32 of D=BET_1 of P=BETA
-b line 33 of D=BET_1 of P=BETA
-b line 34 of D=BET_1 of P=BETA
-b line 35 of D=BET_1 of P=BETA
-b line 36 of D=BET_1 of P=BETA
-+DECK, BET_2, t=newtype. complicated, multi level foreign
- SUBROUTINE BET_2
-b line 2 of D=BET_2 of P=BETA
-b line 3 of D=BET_2 of P=BETA
-b line 4 of D=BET_2 of P=BETA
-b line 5 of D=BET_2 of P=BETA
-b line 6 of D=BET_2 of P=BETA
-b line 7 of D=BET_2 of P=BETA
-b line 8 of D=BET_2 of P=BETA
-b line 9 of D=BET_2 of P=BETA
-b line 10 of D=BET_2 of P=BETA
-b line 11 of D=BET_2 of P=BETA
-b line 12 of D=BET_2 of P=BETA
-b line 13 of D=BET_2 of P=BETA
-b line 14 of D=BET_2 of P=BETA
-b line 15 of D=BET_2 of P=BETA
-b line 16 of D=BET_2 of P=BETA
-b line 17 of D=BET_2 of P=BETA
-b line 18 of D=BET_2 of P=BETA
-b line 19 of D=BET_2 of P=BETA
-b line 20 of D=BET_2 of P=BETA
-b line 21 of D=BET_2 of P=BETA
-b line 22 of D=BET_2 of P=BETA
-b line 23 of D=BET_2 of P=BETA
-b line 24 of D=BET_2 of P=BETA
-b line 25 of D=BET_2 of P=BETA
-b line 26 of D=BET_2 of P=BETA
-b line 27 of D=BET_2 of P=BETA
-b line 28 of D=BET_2 of P=BETA
-b line 29 of D=BET_2 of P=BETA
-b line 30 of D=BET_2 of P=BETA
-b line 31 of D=BET_2 of P=BETA
-b line 32 of D=BET_2 of P=BETA
-b line 33 of D=BET_2 of P=BETA
-b line 34 of D=BET_2 of P=BETA
-b line 35 of D=BET_2 of P=BETA
-b line 36 of D=BET_2 of P=BETA
-b line 37 of D=BET_2 of P=BETA
-b line 38 of D=BET_2 of P=BETA
-b line 39 of D=BET_2 of P=BETA
-b line 40 of D=BET_2 of P=BETA
-b line 41 of D=BET_2 of P=BETA
-b line 42 of D=BET_2 of P=BETA
-b line 43 of D=BET_2 of P=BETA
-b line 44 of D=BET_2 of P=BETA
-b line 45 of D=BET_2 of P=BETA
-b line 46 of D=BET_2 of P=BETA
-b line 47 of D=BET_2 of P=BETA
-b line 48 of D=BET_2 of P=BETA
-b line 49 of D=BET_2 of P=BETA
-b line 50 of D=BET_2 of P=BETA
-b line 51 of D=BET_2 of P=BETA
-b line 52 of D=BET_2 of P=BETA
-+SELF, IF=QMSUN.
-b line 54 of D=BET_2 of P=BETA
-b line 55 of D=BET_2 of P=BETA
-+SELF, IF=NOSUCH.
-b line 57 of D=BET_2 of P=BETA
-b line 58 of D=BET_2 of P=BETA
-+SELF.
-b line 60 of D=BET_2 of P=BETA
-b line 61 of D=BET_2 of P=BETA
-b line 62 of D=BET_2 of P=BETA
-b line 63 of D=BET_2 of P=BETA
-b line 64 of D=BET_2 of P=BETA
-b line 65 of D=BET_2 of P=BETA
-b line 66 of D=BET_2 of P=BETA
-b line 67 of D=BET_2 of P=BETA
-b line 68 of D=BET_2 of P=BETA
-b line 69 of D=BET_2 of P=BETA
-b line 70 of D=BET_2 of P=BETA
-b line 71 of D=BET_2 of P=BETA
-b line 72 of D=BET_2 of P=BETA
-b line 73 of D=BET_2 of P=BETA
-b line 74 of D=BET_2 of P=BETA
-b line 75 of D=BET_2 of P=BETA
-b line 76 of D=BET_2 of P=BETA
-b line 77 of D=BET_2 of P=BETA
-b line 78 of D=BET_2 of P=BETA
-b line 79 of D=BET_2 of P=BETA
-b line 80 of D=BET_2 of P=BETA
-+DECK, BET_3, IF=NEWF. complicated, new features
- SUBROUTINE BET_3
-b line 2 of D=BET_3 of P=BETA
-b line 3 of D=BET_3 of P=BETA
-b line 4 of D=BET_3 of P=BETA
-b line 5 of D=BET_3 of P=BETA
-b line 6 of D=BET_3 of P=BETA
-b line 7 of D=BET_3 of P=BETA
-b line 8 of D=BET_3 of P=BETA
-b line 9 of D=BET_3 of P=BETA
-b line 10 of D=BET_3 of P=BETA
-b line 11 of D=BET_3 of P=BETA
-b line 12 of D=BET_3 of P=BETA
-b line 13 of D=BET_3 of P=BETA
-b line 14 of D=BET_3 of P=BETA
-b line 15 of D=BET_3 of P=BETA
-b line 16 of D=BET_3 of P=BETA
-b line 17 of D=BET_3 of P=BETA
-b line 18 of D=BET_3 of P=BETA
-b line 19 of D=BET_3 of P=BETA
-+NIL. line 20 of D=BET_3 of P=BETA
-b line 21 of D=BET_3 of P=BETA
-b line 22 of D=BET_3 of P=BETA
-b line 23 of D=BET_3 of P=BETA
-b line 24 of D=BET_3 of P=BETA
-b line 25 of D=BET_3 of P=BETA
-b line 26 of D=BET_3 of P=BETA
-b line 27 of D=BET_3 of P=BETA
-b line 28 of D=BET_3 of P=BETA
-b line 29 of D=BET_3 of P=BETA
-b line 30 of D=BET_3 of P=BETA
-b line 31 of D=BET_3 of P=BETA
-b line 32 of D=BET_3 of P=BETA
-b line 33 of D=BET_3 of P=BETA
-b line 34 of D=BET_3 of P=BETA
-b line 35 of D=BET_3 of P=BETA
-b line 36 of D=BET_3 of P=BETA
-b line 37 of D=BET_3 of P=BETA
-b line 38 of D=BET_3 of P=BETA
-b line 39 of D=BET_3 of P=BETA
-b line 40 of D=BET_3 of P=BETA
-b line 41 of D=BET_3 of P=BETA
-b line 42 of D=BET_3 of P=BETA
-b line 43 of D=BET_3 of P=BETA
-b line 44 of D=BET_3 of P=BETA
-b line 45 of D=BET_3 of P=BETA
-b line 46 of D=BET_3 of P=BETA
-b line 47 of D=BET_3 of P=BETA
-b line 48 of D=BET_3 of P=BETA
-+PATCH, GAMMA. errors
-+DECK, GAM_1, T=JOIN.
- SUBROUTINE GAM_1
-c line 2 of D=GAM_1 of P=GAMMA
-+SEQ, MISSSQ, MISSSQ2.
-c line 4 of D=GAM_1 of P=GAMMA
-c line 5 of D=GAM_1 of P=GAMMA
-c line 6 of D=GAM_1 of P=GAMMA
-c line 7 of D=GAM_1 of P=GAMMA
-c line 8 of D=GAM_1 of P=GAMMA
-c line 9 of D=GAM_1 of P=GAMMA
-c line 10 of D=GAM_1 of P=GAMMA
-c line 11 of D=GAM_1 of P=GAMMA
-c line 12 of D=GAM_1 of P=GAMMA
-c line 13 of D=GAM_1 of P=GAMMA
-c line 14 of D=GAM_1 of P=GAMMA
-c line 15 of D=GAM_1 of P=GAMMA
-c line 16 of D=GAM_1 of P=GAMMA
-c line 17 of D=GAM_1 of P=GAMMA
-c line 18 of D=GAM_1 of P=GAMMA
-c line 19 of D=GAM_1 of P=GAMMA
-c line 20 of D=GAM_1 of P=GAMMA
-c line 21 of D=GAM_1 of P=GAMMA
-c line 22 of D=GAM_1 of P=GAMMA
-c line 23 of D=GAM_1 of P=GAMMA
-c line 24 of D=GAM_1 of P=GAMMA
-+DECK, GAM_2.
- SUBROUTINE GAM_2
-c line 2 of D=GAM_2 of P=GAMMA
-c line 3 of D=GAM_2 of P=GAMMA
-c line 4 of D=GAM_2 of P=GAMMA
-c line 5 of D=GAM_2 of P=GAMMA
-c line 6 of D=GAM_2 of P=GAMMA
-c line 7 of D=GAM_2 of P=GAMMA
-c line 8 of D=GAM_2 of P=GAMMA
-c line 9 of D=GAM_2 of P=GAMMA
-c line 10 of D=GAM_2 of P=GAMMA
-c line 11 of D=GAM_2 of P=GAMMA
-c line 12 of D=GAM_2 of P=GAMMA
-c line 13 of D=GAM_2 of P=GAMMA
-c line 14 of D=GAM_2 of P=GAMMA
-c line 15 of D=GAM_2 of P=GAMMA
-c line 16 of D=GAM_2 of P=GAMMA
-c line 17 of D=GAM_2 of P=GAMMA
-c line 18 of D=GAM_2 of P=GAMMA
-c line 19 of D=GAM_2 of P=GAMMA
-c line 20 of D=GAM_2 of P=GAMMA
-c line 21 of D=GAM_2 of P=GAMMA
-c line 22 of D=GAM_2 of P=GAMMA
-c line 23 of D=GAM_2 of P=GAMMA
-c line 24 of D=GAM_2 of P=GAMMA
-c line 25 of D=GAM_2 of P=GAMMA
-c line 26 of D=GAM_2 of P=GAMMA
-c line 27 of D=GAM_2 of P=GAMMA
-c line 28 of D=GAM_2 of P=GAMMA
-c line 29 of D=GAM_2 of P=GAMMA
-c line 30 of D=GAM_2 of P=GAMMA
-c line 31 of D=GAM_2 of P=GAMMA
-c line 32 of D=GAM_2 of P=GAMMA
-c line 33 of D=GAM_2 of P=GAMMA
-c line 34 of D=GAM_2 of P=GAMMA
-c line 35 of D=GAM_2 of P=GAMMA
-c line 36 of D=GAM_2 of P=GAMMA
-c line 37 of D=GAM_2 of P=GAMMA
-c line 38 of D=GAM_2 of P=GAMMA
-c line 39 of D=GAM_2 of P=GAMMA
-c line 40 of D=GAM_2 of P=GAMMA
-c line 41 of D=GAM_2 of P=GAMMA
-c line 42 of D=GAM_2 of P=GAMMA
-c line 43 of D=GAM_2 of P=GAMMA
-c line 44 of D=GAM_2 of P=GAMMA
-c line 45 of D=GAM_2 of P=GAMMA
-c line 46 of D=GAM_2 of P=GAMMA
-c line 47 of D=GAM_2 of P=GAMMA
-c line 48 of D=GAM_2 of P=GAMMA
-+DECK, GAM_3, IF=NEWF. new features
- SUBROUTINE GAM_3
-c line 2 of D=GAM_3 of P=GAMMA
-c line 3 of D=GAM_3 of P=GAMMA
-c line 4 of D=GAM_3 of P=GAMMA
-c line 5 of D=GAM_3 of P=GAMMA
-c line 6 of D=GAM_3 of P=GAMMA
-c line 7 of D=GAM_3 of P=GAMMA
-c line 8 of D=GAM_3 of P=GAMMA
-c line 9 of D=GAM_3 of P=GAMMA
-c line 10 of D=GAM_3 of P=GAMMA
-c line 11 of D=GAM_3 of P=GAMMA
-c line 12 of D=GAM_3 of P=GAMMA
-c line 13 of D=GAM_3 of P=GAMMA
-c line 14 of D=GAM_3 of P=GAMMA
-c line 15 of D=GAM_3 of P=GAMMA
-c line 16 of D=GAM_3 of P=GAMMA
-c line 17 of D=GAM_3 of P=GAMMA
-c line 18 of D=GAM_3 of P=GAMMA
-c line 19 of D=GAM_3 of P=GAMMA
-c line 20 of D=GAM_3 of P=GAMMA
-c line 21 of D=GAM_3 of P=GAMMA
-c line 22 of D=GAM_3 of P=GAMMA
-c line 23 of D=GAM_3 of P=GAMMA
-c line 24 of D=GAM_3 of P=GAMMA
-+PATCH, KAPPA, IF=-ALPHA. IF-deselected
-k line 1 of P=KAPPA
-k line 2 of P=KAPPA
-k line 3 of P=KAPPA
-k line 4 of P=KAPPA
-k line 5 of P=KAPPA
-k line 6 of P=KAPPA
-k line 7 of P=KAPPA
-+PATCH, LAMBDA, T=JOIN. deselected by +IMITATE
-k line 1 of P=KAPPA
-k line 2 of P=KAPPA
-k line 3 of P=KAPPA
-k line 4 of P=KAPPA
-k line 5 of P=KAPPA
-k line 6 of P=KAPPA
-k line 7 of P=KAPPA
-+PATCH, EXPECT, T=EXPECT.
-CDECK ID>, INIT.
- line 1 of d=init of p=cra*
- line 2 of d=init of p=cra*
- line 3 of d=init of p=cra*
- line 4 of d=init of p=cra*
- line 5 of d=init of p=cra*
- line 6 of d=init of p=cra*
- line 7 of d=init of p=cra*
-CDECK ID>, ALP_1.
- SUBROUTINE ALP_1
- s line 2 of D= of P=VCDE
-a line 3 of D=ALP_1 of P=ALPHA
- s line 8 of D= of P=VCDE
- s line 9 of D= of P=VCDE
- s line 11 of D= of P=VCDE
- s line 12 of D= of P=VCDE
- s line 16 of D= of P=VCDE
- s line 17 of D= of P=VCDE
-a line 5 of D=ALP_1 of P=ALPHA
- s line 2 of D= of P=VCDE
- s line 4 of D= of P=VCDE
- s line 28 of D= of P=VCDE
- s line 6 of D= of P=VCDE
- s line 30 of D= of P=VCDE
- s line 31 of D= of P=VCDE
- s line 33 of D= of P=VCDE
- s line 2 of D= of P=VCDE
- s line 4 of D= of P=VCDE
-a line 7 of D=ALP_1 of P=ALPHA
-a line 8 of D=ALP_1 of P=ALPHA
-a line 9 of D=ALP_1 of P=ALPHA
-a line 11 of D=ALP_1 of P=ALPHA
-a line 12 of D=ALP_1 of P=ALPHA
- s line 8 of D= of P=VCDE
- s line 9 of D= of P=VCDE
-a line 20 of D=ALP_1 of P=ALPHA
-a line 21 of D=ALP_1 of P=ALPHA
-a line 23 of D=ALP_1 of P=ALPHA
-a line 24 of D=ALP_1 of P=ALPHA
-a line 26 of D=ALP_1 of P=ALPHA
-a line 27 of D=ALP_1 of P=ALPHA
- s line 38 of D= of P=VCDE
- s line 39 of D= of P=VCDE
- s line 40 of D= of P=VCDE
-a line 29 of D=ALP_1 of P=ALPHA
-a line 30 of D=ALP_1 of P=ALPHA
- + 62HP5VERIFY 1.04 part 2 HOLD
- + 'P5VERIFY 1.04 part 2 '
-a line 33 of D=ALP_1 of P=ALPHA
-a line 34 of D=ALP_1 of P=ALPHA
-a line 35 of D=ALP_1 of P=ALPHA
-a line 36 of D=ALP_1 of P=ALPHA
- s line 12 of D=CDK of P=VCDE local -> to P=alpha
- s line 13 of D=CDK of P=VCDE
-a line 38 of D=ALP_1 of P=ALPHA
- s line 18 of D=CDK of P=VCDE local -> to P=alpha.alp_1
-a line 40 of D=ALP_1 of P=ALPHA
-seq material from the cradle 1
-seq material from the cradle 2
-a line 42 of D=ALP_1 of P=ALPHA
-a line 43 of D=ALP_1 of P=ALPHA
-a line 45 of D=ALP_1 of P=ALPHA
-a line 46 of D=ALP_1 of P=ALPHA
-a line 47 of D=ALP_1 of P=ALPHA
-a line 48 of D=ALP_1 of P=ALPHA
-a line 49 of D=ALP_1 of P=ALPHA
-a line 50 of D=ALP_1 of P=ALPHA
-a line 51 of D=ALP_1 of P=ALPHA
-a line 52 of D=ALP_1 of P=ALPHA
-CDECK ID>, ALP_2.
- SUBROUTINE ALP_2
- s line 12 of D=CDK of P=VCDE local -> to P=alpha
- s line 13 of D=CDK of P=VCDE
- s line 21 of D=CDK of P=VCDE local -> to P=alpha.alp_2
- s line 22 of D=CDK of P=VCDE
-a line 3 of D=ALP_2 of P=ALPHA
- s line 12 of D=CDK of P=VCDE local -> to P=alpha
- s line 13 of D=CDK of P=VCDE
- s line 21 of D=CDK of P=VCDE local -> to P=alpha.alp_2
- s line 22 of D=CDK of P=VCDE
-a line 5 of D=ALP_2 of P=ALPHA
- x line 16 of D=XXX_1 of P=ACTX
- s line 8 of D= of P=VCDE
- s line 9 of D= of P=VCDE
- s line 16 of D= of P=VCDE
- s line 17 of D= of P=VCDE
- s line 4 of D=CDK of P=VCDE
- x line 19 of D=XXX_1 of P=ACTX
- x line 20 of D=XXX_1 of P=ACTX
- s line 5 of D=CDK of P=VCDE
-a line 7 of D=ALP_2 of P=ALPHA
- s line 37 of D=CDK of P=VCDE
- x line 22 of D=XXX_1 of P=ACTX
- x line 23 of D=XXX_1 of P=ACTX
- x line 24 of D=XXX_1 of P=ACTX
- s line 38 of D=CDK of P=VCDE
- x line 16 of D=XXX_1 of P=ACTX
- s line 8 of D= of P=VCDE
- s line 9 of D= of P=VCDE
- s line 16 of D= of P=VCDE
- s line 17 of D= of P=VCDE
- s line 4 of D=CDK of P=VCDE
- x line 19 of D=XXX_1 of P=ACTX
- x line 20 of D=XXX_1 of P=ACTX
- s line 5 of D=CDK of P=VCDE
- s line 40 of D=CDK of P=VCDE
- s line 41 of D=CDK of P=VCDE
- s line 12 of D=CDK of P=VCDE local -> to P=alpha
- s line 13 of D=CDK of P=VCDE
- s line 21 of D=CDK of P=VCDE local -> to P=alpha.alp_2
- s line 22 of D=CDK of P=VCDE
- s line 43 of D=CDK of P=VCDE
- s line 44 of D=CDK of P=VCDE
-a line 9 of D=ALP_2 of P=ALPHA
-a line 10 of D=ALP_2 of P=ALPHA
- x line 2 of D=XXX_1 of P=ACTX
-a line 11 of D=ALP_2 of P=ALPHA
-a line 12 of D=ALP_2 of P=ALPHA
- x line 4 of D=XXX_1 of P=ACTX
- x line 5 of D=XXX_1 of P=ACTX
- x line 7 of D=XXX_1 of P=ACTX
- x line 8 of D=XXX_1 of P=ACTX
- x line 9 of D=XXX_1 of P=ACTX
-a line 17 of D=ALP_2 of P=ALPHA
- x line 11 of D=XXX_1 of P=ACTX
- x line 12 of D=XXX_1 of P=ACTX
-a line 19 of D=ALP_2 of P=ALPHA
-a line 21 of D=ALP_2 of P=ALPHA
-a line 22 of D=ALP_2 of P=ALPHA
-a line 23 of D=ALP_2 of P=ALPHA
-a line 30 of D=ALP_2 of P=ALPHA
-a line 31 of D=ALP_2 of P=ALPHA
- s line 22 of D= of P=VCDE
- s line 23 of D= of P=VCDE
- s line 24 of D= of P=VCDE
-a line 33 of D=ALP_2 of P=ALPHA
-a line 34 of D=ALP_2 of P=ALPHA
- s line 8 of D= of P=VCDE
- s line 9 of D= of P=VCDE
-a line 35 of D=ALP_2 of P=ALPHA
-a line 36 of D=ALP_2 of P=ALPHA
- s line 11 of D= of P=VCDE
- s line 12 of D= of P=VCDE
- x line 28 of D=XXX_1 of P=ACTX
-a line 37 of D=ALP_2 of P=ALPHA
-a line 38 of D=ALP_2 of P=ALPHA
-a line 39 of D=ALP_2 of P=ALPHA
-a line 40 of D=ALP_2 of P=ALPHA
- s line 14 of D= of P=VCDE local -> P=alpha
- x line 30 of D=XXX_1 of P=ACTX
- x line 31 of D=XXX_1 of P=ACTX
-a line 45 of D=ALP_2 of P=ALPHA
-a line 46 of D=ALP_2 of P=ALPHA
-a line 47 of D=ALP_2 of P=ALPHA
-a line 48 of D=ALP_2 of P=ALPHA
-CDECK ID>, ALP_3.
- SUBROUTINE ALP_3
-a line 2 of D=ALP_3 of P=ALPHA
-a line 3 of D=ALP_3 of P=ALPHA
-#include "mqcomm.h"
-a line 5 of D=ALP_3 of P=ALPHA
-a line 6 of D=ALP_3 of P=ALPHA
- title: P5VERIFY 1.04 part 2
- name: P5VERIFY
- version: 1.04
- primary: 1.04
- secondary: 0
-a line 12 of D=ALP_3 of P=ALPHA
-a line 13 of D=ALP_3 of P=ALPHA
-a line 14 of D=ALP_3 of P=ALPHA
-a line 16 of D=ALP_3 of P=ALPHA
-a line 17 of D=ALP_3 of P=ALPHA
-a line 19 of D=ALP_3 of P=ALPHA
-a line 20 of D=ALP_3 of P=ALPHA
-a line 22 of D=ALP_3 of P=ALPHA
-a line 27 of D=ALP_3 of P=ALPHA
-a line 28 of D=ALP_3 of P=ALPHA
-a line 29 of D=ALP_3 of P=ALPHA
-a line 31 of D=ALP_3 of P=ALPHA
-a line 32 of D=ALP_3 of P=ALPHA
-a line 37 of D=ALP_3 of P=ALPHA
-a line 42 of D=ALP_3 of P=ALPHA
-a line 43 of D=ALP_3 of P=ALPHA
-a line 45 of D=ALP_3 of P=ALPHA
-a line 46 of D=ALP_3 of P=ALPHA
-a line 47 of D=ALP_3 of P=ALPHA
-a line 49 of D=ALP_3 of P=ALPHA
-a line 50 of D=ALP_3 of P=ALPHA
-a line 58 of D=ALP_3 of P=ALPHA
-a line 59 of D=ALP_3 of P=ALPHA
-a line 60 of D=ALP_3 of P=ALPHA
-a line 65 of D=ALP_3 of P=ALPHA
-a line 66 of D=ALP_3 of P=ALPHA
-a line 74 of D=ALP_3 of P=ALPHA
-a line 75 of D=ALP_3 of P=ALPHA
-a line 76 of D=ALP_3 of P=ALPHA
-a line 84 of D=ALP_3 of P=ALPHA
- s line 12 of D=CDK of P=VCDE local -> to P=alpha
- s line 13 of D=CDK of P=VCDE
- s line 24 of D=CDK of P=VCDE local -> to P=alpha.alp_3
- s line 25 of D=CDK of P=VCDE
-a line 87 of D=ALP_3 of P=ALPHA
-a line 88 of D=ALP_3 of P=ALPHA
-a line 89 of D=ALP_3 of P=ALPHA
-a line 90 of D=ALP_3 of P=ALPHA
-a line 92 of D=ALP_3 of P=ALPHA
-a line 94 of D=ALP_3 of P=ALPHA
-a line 95 of D=ALP_3 of P=ALPHA
-a line 97 of D=ALP_3 of P=ALPHA
-a line 99 of D=ALP_3 of P=ALPHA
-a line 100 of D=ALP_3 of P=ALPHA
-a line 101 of D=ALP_3 of P=ALPHA
-a line 102 of D=ALP_3 of P=ALPHA
-a line 104 of D=ALP_3 of P=ALPHA
-a line 109 of D=ALP_3 of P=ALPHA
-a line 111 of D=ALP_3 of P=ALPHA
-a line 112 of D=ALP_3 of P=ALPHA
-a line 113 of D=ALP_3 of P=ALPHA
-a line 122 of D=ALP_3 of P=ALPHA
-a line 131 of D=ALP_3 of P=ALPHA
-a line 132 of D=ALP_3 of P=ALPHA
-a line 133 of D=ALP_3 of P=ALPHA
-a line 136 of D=ALP_3 of P=ALPHA
-a line 137 of D=ALP_3 of P=ALPHA
-a line 138 of D=ALP_3 of P=ALPHA
-a line 139 of D=ALP_3 of P=ALPHA
-a line 148 of D=ALP_3 of P=ALPHA
-a line 149 of D=ALP_3 of P=ALPHA
-a line 150 of D=ALP_3 of P=ALPHA
-a line 151 of D=ALP_3 of P=ALPHA
-a line 154 of D=ALP_3 of P=ALPHA
-a line 155 of D=ALP_3 of P=ALPHA
- s line 3 of D=CDK_3 of P=VCDE
- s line 4 of D=CDK_3 of P=VCDE
-a line 157 of D=ALP_3 of P=ALPHA
-#include "mqcomm.h"
-#include "dqcomm.h"
-a line 159 of D=ALP_3 of P=ALPHA
- s line 15 of D=CDK_3 of P=VCDE
- s line 16 of D=CDK_3 of P=VCDE
-a line 161 of D=ALP_3 of P=ALPHA
- s line 26 of D=CDK_3 of P=VCDE
- s line 28 of D=CDK_3 of P=VCDE
- s line 29 of D=CDK_3 of P=VCDE
- s line 35 of D=CDK_3 of P=VCDE
-a line 163 of D=ALP_3 of P=ALPHA
-a line 164 of D=ALP_3 of P=ALPHA
- title: P5VERIFY 1.04 1995/11/02 17.0
-a line 169 of D=ALP_3 of P=ALPHA
-a line 170 of D=ALP_3 of P=ALPHA
-a line 171 of D=ALP_3 of P=ALPHA
-a line 172 of D=ALP_3 of P=ALPHA
-a line 173 of D=ALP_3 of P=ALPHA
-a line 174 of D=ALP_3 of P=ALPHA
-a line 175 of D=ALP_3 of P=ALPHA
-a line 176 of D=ALP_3 of P=ALPHA
- SUBROUTINE BET_1
- s line 15 of D=CDK of P=VCDE local -> to P=beta
- s line 16 of D=CDK of P=VCDE
- s line 27 of D=CDK of P=VCDE local -> to P=beta.bet_1
- s line 28 of D=CDK of P=VCDE
-b line 3 of D=BET_1 of P=BETA
- s line 15 of D=CDK of P=VCDE local -> to P=beta
- s line 16 of D=CDK of P=VCDE
- s line 27 of D=CDK of P=VCDE local -> to P=beta.bet_1
- s line 28 of D=CDK of P=VCDE
-b line 5 of D=BET_1 of P=BETA
- s line 37 of D=CDK of P=VCDE
- x line 22 of D=XXX_1 of P=ACTX
- x line 23 of D=XXX_1 of P=ACTX
- x line 24 of D=XXX_1 of P=ACTX
- s line 38 of D=CDK of P=VCDE
- x line 16 of D=XXX_1 of P=ACTX
- s line 8 of D= of P=VCDE
- s line 9 of D= of P=VCDE
- s line 16 of D= of P=VCDE
- s line 17 of D= of P=VCDE
- s line 4 of D=CDK of P=VCDE
- x line 19 of D=XXX_1 of P=ACTX
- x line 20 of D=XXX_1 of P=ACTX
- s line 5 of D=CDK of P=VCDE
- s line 40 of D=CDK of P=VCDE
- s line 41 of D=CDK of P=VCDE
- s line 15 of D=CDK of P=VCDE local -> to P=beta
- s line 16 of D=CDK of P=VCDE
- s line 27 of D=CDK of P=VCDE local -> to P=beta.bet_1
- s line 28 of D=CDK of P=VCDE
- s line 43 of D=CDK of P=VCDE
- s line 44 of D=CDK of P=VCDE
-b line 7 of D=BET_1 of P=BETA
-b line 8 of D=BET_1 of P=BETA
-b line 16 of D=BET_1 of P=BETA
-b line 17 of D=BET_1 of P=BETA
-b line 18 of D=BET_1 of P=BETA
-b line 19 of D=BET_1 of P=BETA
-b line 20 of D=BET_1 of P=BETA
-b line 10 of D=BET_1 of P=BETA
- s line 16 of D= of P=VCDE
- s line 17 of D= of P=VCDE
- s line 22 of D= of P=VCDE
- s line 23 of D= of P=VCDE
- s line 24 of D= of P=VCDE
-b line 14 of D=BET_1 of P=BETA
-b line 22 of D=BET_1 of P=BETA
-b line 10 of D=BET_1 of P=BETA
- s line 16 of D= of P=VCDE
- s line 17 of D= of P=VCDE
-b line 24 of D=BET_1 of P=BETA
-b line 25 of D=BET_1 of P=BETA
-b line 27 of D=BET_1 of P=BETA
-b line 28 of D=BET_1 of P=BETA
-b line 30 of D=BET_1 of P=BETA
-b line 31 of D=BET_1 of P=BETA
-b line 32 of D=BET_1 of P=BETA
-b line 33 of D=BET_1 of P=BETA
-b line 34 of D=BET_1 of P=BETA
-b line 35 of D=BET_1 of P=BETA
-b line 36 of D=BET_1 of P=BETA
- SUBROUTINE BET_2
-b line 2 of D=BET_2 of P=BETA
-b line 3 of D=BET_2 of P=BETA
-b line 4 of D=BET_2 of P=BETA
-b line 5 of D=BET_2 of P=BETA
-b line 6 of D=BET_2 of P=BETA
-b line 7 of D=BET_2 of P=BETA
-b line 8 of D=BET_2 of P=BETA
-b line 9 of D=BET_2 of P=BETA
-b line 10 of D=BET_2 of P=BETA
- x line 2 of D=XXX_2 of P=ACTX
- x line 3 of D=XXX_2 of P=ACTX
- x line 4 of D=XXX_2 of P=ACTX
- x line 5 of D=XXX_2 of P=ACTX
- x line 7 of D=XXX_2 of P=ACTX
- x line 8 of D=XXX_2 of P=ACTX
- x line 9 of D=XXX_2 of P=ACTX
- x line 10 of D=XXX_2 of P=ACTX
- x line 12 of D=XXX_2 of P=ACTX
- x line 13 of D=XXX_2 of P=ACTX
- x line 14 of D=XXX_2 of P=ACTX
- x line 15 of D=XXX_2 of P=ACTX
-b line 14 of D=BET_2 of P=BETA
-b line 15 of D=BET_2 of P=BETA
-b line 16 of D=BET_2 of P=BETA
-b line 17 of D=BET_2 of P=BETA
-b line 18 of D=BET_2 of P=BETA
- x line 17 of D=XXX_2 of P=ACTX
- y line 2 of D=YYY_1 of P=ACTY
- y line 3 of D=YYY_1 of P=ACTY
- y line 4 of D=YYY_1 of P=ACTY
- x line 19 of D=XXX_2 of P=ACTX
- x line 20 of D=XXX_2 of P=ACTX
-b line 22 of D=BET_2 of P=BETA
-b line 23 of D=BET_2 of P=BETA
- y line 6 of D=YYY_1 of P=ACTY
-b line 25 of D=BET_2 of P=BETA
-b line 26 of D=BET_2 of P=BETA
- x line 24 of D=XXX_2 of P=ACTX
- x line 25 of D=XXX_2 of P=ACTX
- x line 31 of D=XXX_2 of P=ACTX
- x line 32 of D=XXX_2 of P=ACTX
-b line 27 of D=BET_2 of P=BETA
-b line 28 of D=BET_2 of P=BETA
-b line 29 of D=BET_2 of P=BETA
-b line 30 of D=BET_2 of P=BETA
- y line 8 of D=YYY_1 of P=ACTY
- y line 9 of D=YYY_1 of P=ACTY
- y line 10 of D=YYY_1 of P=ACTY
- x line 27 of D=XXX_2 of P=ACTX
- x line 28 of D=XXX_2 of P=ACTX
- x line 29 of D=XXX_2 of P=ACTX
-b line 31 of D=BET_2 of P=BETA
-b line 32 of D=BET_2 of P=BETA
-b line 33 of D=BET_2 of P=BETA
- x line 34 of D=XXX_2 of P=ACTX
- x line 35 of D=XXX_2 of P=ACTX
- y line 12 of D=YYY_1 of P=ACTY
- y line 13 of D=YYY_1 of P=ACTY
- x line 36 of D=XXX_2 of P=ACTX
-b line 38 of D=BET_2 of P=BETA
-b line 39 of D=BET_2 of P=BETA
-b line 40 of D=BET_2 of P=BETA
-b line 41 of D=BET_2 of P=BETA
-b line 42 of D=BET_2 of P=BETA
- x line 38 of D=XXX_2 of P=ACTX
- x line 39 of D=XXX_2 of P=ACTX
- x line 40 of D=XXX_2 of P=ACTX
- x line 41 of D=XXX_2 of P=ACTX
- x line 42 of D=XXX_2 of P=ACTX
- x line 43 of D=XXX_2 of P=ACTX
-b line 43 of D=BET_2 of P=BETA
-b line 44 of D=BET_2 of P=BETA
-b line 45 of D=BET_2 of P=BETA
-b line 46 of D=BET_2 of P=BETA
-b line 47 of D=BET_2 of P=BETA
- x line 45 of D=XXX_2 of P=ACTX
- x line 46 of D=XXX_2 of P=ACTX
-b line 48 of D=BET_2 of P=BETA
- x line 48 of D=XXX_2 of P=ACTX
- x line 49 of D=XXX_2 of P=ACTX
-b line 49 of D=BET_2 of P=BETA
-b line 50 of D=BET_2 of P=BETA
- x line 51 of D=XXX_2 of P=ACTX
- x expect this difference between Patchy 4 and 5
- x line 56 of D=XXX_2 of P=ACTX
-b line 51 of D=BET_2 of P=BETA
-b line 52 of D=BET_2 of P=BETA
-b line 57 of D=BET_2 of P=BETA
-b line 58 of D=BET_2 of P=BETA
-b line 60 of D=BET_2 of P=BETA
-b line 61 of D=BET_2 of P=BETA
- s line 15 of D=CDK of P=VCDE local -> to P=beta
- s line 16 of D=CDK of P=VCDE
- s line 30 of D=CDK of P=VCDE local -> to P=beta.bet_2
- s line 31 of D=CDK of P=VCDE
-b line 63 of D=BET_2 of P=BETA
-b line 64 of D=BET_2 of P=BETA
- x line 63 of D=XXX_2 of P=ACTX
- s line 15 of D=CDK of P=VCDE local -> to P=beta
- s line 16 of D=CDK of P=VCDE
- s line 30 of D=CDK of P=VCDE local -> to P=beta.bet_2
- s line 31 of D=CDK of P=VCDE
- x line 65 of D=XXX_2 of P=ACTX
- x line 66 of D=XXX_2 of P=ACTX
-b line 68 of D=BET_2 of P=BETA
-b line 69 of D=BET_2 of P=BETA
-b line 70 of D=BET_2 of P=BETA
-b line 71 of D=BET_2 of P=BETA
-b line 72 of D=BET_2 of P=BETA
-b line 73 of D=BET_2 of P=BETA
- x line 68 of D=XXX_2 of P=ACTX
- y line 16 of D=YYY_1 of P=ACTY
- y line 17 of D=YYY_1 of P=ACTY
- x line 69 of D=XXX_2 of P=ACTX
- x line 70 of D=XXX_2 of P=ACTX
- y line 19 of D=YYY_1 of P=ACTY
- y line 20 of D=YYY_1 of P=ACTY
- s line 37 of D=CDK of P=VCDE
- x line 22 of D=XXX_1 of P=ACTX
- x line 23 of D=XXX_1 of P=ACTX
- x line 24 of D=XXX_1 of P=ACTX
- s line 38 of D=CDK of P=VCDE
- x line 16 of D=XXX_1 of P=ACTX
- s line 8 of D= of P=VCDE
- s line 9 of D= of P=VCDE
- s line 16 of D= of P=VCDE
- s line 17 of D= of P=VCDE
- s line 4 of D=CDK of P=VCDE
- x line 19 of D=XXX_1 of P=ACTX
- x line 20 of D=XXX_1 of P=ACTX
- s line 5 of D=CDK of P=VCDE
- s line 40 of D=CDK of P=VCDE
- s line 41 of D=CDK of P=VCDE
- s line 15 of D=CDK of P=VCDE local -> to P=beta
- s line 16 of D=CDK of P=VCDE
- s line 30 of D=CDK of P=VCDE local -> to P=beta.bet_2
- s line 31 of D=CDK of P=VCDE
- s line 43 of D=CDK of P=VCDE
- s line 44 of D=CDK of P=VCDE
-b line 78 of D=BET_2 of P=BETA
-b line 79 of D=BET_2 of P=BETA
-b line 80 of D=BET_2 of P=BETA
- SUBROUTINE BET_3
-b line 2 of D=BET_3 of P=BETA
-b line 3 of D=BET_3 of P=BETA
- x line 3 of D=XXX_3 of P=ACTX
-b line 5 of D=BET_3 of P=BETA
-b line 6 of D=BET_3 of P=BETA
- x line 14 of D=XXX_3 of P=ACTX
- x line 15 of D=XXX_3 of P=ACTX
-b line 7 of D=BET_3 of P=BETA
-b line 8 of D=BET_3 of P=BETA
- x line 18 of D=XXX_3 of P=ACTX
- x line 19 of D=XXX_3 of P=ACTX
- x line 20 of D=XXX_3 of P=ACTX
-b line 14 of D=BET_3 of P=BETA
-b line 15 of D=BET_3 of P=BETA
-b line 16 of D=BET_3 of P=BETA
- x line 32 of D=XXX_3 of P=ACTX
- x line 33 of D=XXX_3 of P=ACTX
- x line 35 of D=XXX_3 of P=ACTX
-b line 17 of D=BET_3 of P=BETA
-b line 18 of D=BET_3 of P=BETA
-b line 21 of D=BET_3 of P=BETA
-b line 22 of D=BET_3 of P=BETA
-b line 23 of D=BET_3 of P=BETA
-b line 24 of D=BET_3 of P=BETA
-b line 25 of D=BET_3 of P=BETA
-b line 26 of D=BET_3 of P=BETA
-b line 27 of D=BET_3 of P=BETA
-b line 28 of D=BET_3 of P=BETA
-b line 29 of D=BET_3 of P=BETA
-b line 30 of D=BET_3 of P=BETA
-b line 31 of D=BET_3 of P=BETA
-b line 32 of D=BET_3 of P=BETA
-b line 33 of D=BET_3 of P=BETA
-b line 34 of D=BET_3 of P=BETA
-b line 35 of D=BET_3 of P=BETA
-b line 36 of D=BET_3 of P=BETA
-b line 37 of D=BET_3 of P=BETA
-b line 38 of D=BET_3 of P=BETA
-b line 39 of D=BET_3 of P=BETA
-b line 40 of D=BET_3 of P=BETA
-b line 41 of D=BET_3 of P=BETA
-b line 42 of D=BET_3 of P=BETA
-b line 43 of D=BET_3 of P=BETA
-b line 44 of D=BET_3 of P=BETA
-b line 45 of D=BET_3 of P=BETA
-b line 46 of D=BET_3 of P=BETA
-b line 47 of D=BET_3 of P=BETA
-b line 48 of D=BET_3 of P=BETA
-CDECK ID>, LILI.
- line 1 of p=cra* d=lili
- line 2 of p=cra* d=lili
- line 3 of p=cra* d=lili
-+PATCH, PAMEND.
-last line of p5verify.car
diff --git a/src/patchy/p5verify.cra b/src/patchy/p5verify.cra
deleted file mode 100755
index b187249..0000000
--- a/src/patchy/p5verify.cra
+++ /dev/null
@@ -1,78 +0,0 @@
-+asm, expect, t=att .p5verx.expect
-+asm, fort:2, t=att .p5verx.away
-+use, *verify.
-+divert, nocheck.
- asm test only
-+asm, as:3, cc:3, t=bind.
-+asm, xsplit, t=split, log .a/${USER}.split
-+asm, xsplit, t=prefix .a/
-+names, 24, 2400, 12000.
-+gap, 6400, 800, 8000, 44.
-+exe
-+use, *test.
-+use, newf, t=inh, if=-py_vs5.
- alpha
- beta
- gamma
-+list, cra*, t=only.
- iota
- kappa
- lambda
-+PAM, T=ATT, IF=NOSUCH .nopam
-+PAM, T=ATT, IF=NOSUCH .nopam_again
- rho
- sigma
- tau
-+KEEP, CRASEQ.
-seq material from the cradle 1
-seq material from the cradle 2
-+param, lines, n=110.
-+option, all, mapasm.
-+DECK, INIT.
- line 1 of d=init of p=cra*
- line 2 of d=init of p=cra*
- line 3 of d=init of p=cra*
- line 4 of d=init of p=cra*
- line 5 of d=init of p=cra*
- line 6 of d=init of p=cra*
- line 7 of d=init of p=cra*
-+PAM, T=CARDS, IF=-PY_VS5.
-+PAM, IF=PY_VS5.
-+PAM, T=ATT, IF=NOSUCH .nopam
- line 1 of p=cra* d=cra*
- line 2 of p=cra* d=cra*
- line 3 of p=cra* d=cra*
- line 4 of p=cra* d=cra*
-+use, zlongname012, t=inhibit.
-+use, zlongname012andmore, t=inhibit.
-+DECK, LILI.
- line 1 of p=cra* d=lili
- line 2 of p=cra* d=lili
- line 3 of p=cra* d=lili
-+PAM, T=ATT, IF=NOSUCH .nopam
- line 1 of P=CRA* D=CRA*
- line 2 of P=CRA* D=CRA*
-+quit, if=nosuch
- line 4 of P=CRA* D=CRA*
- line 5 of P=CRA* D=CRA*
-+SHOW, MEMORY.
-+PATCH, UNUSED.
- line 1 of P=UNUSED D=
- line 2 of P=UNUSED D=
- line 3 of P=UNUSED D=
- line 4 of P=UNUSED D=
- line 5 of P=UNUSED D=
-+DECK, XYZ.
- line 1 of P=UNUSED D=XYZ
- line 2 of P=UNUSED D=XYZ
- line 3 of P=UNUSED D=XYZ
- line 4 of P=UNUSED D=XYZ
- line 5 of P=UNUSED D=XYZ
-+quit
-trail 1
-trail 2
-+DECK, FCRA.
- line 1 of P=CRA* D=FCRA
- line 2 of P=CRA* D=FCRA
- line 3 of P=CRA* D=FCRA
- line 4 of P=CRA* D=FCRA
diff --git a/src/patchy/patchy.car b/src/patchy/patchy.car
deleted file mode 100755
index 9606642..0000000
--- a/src/patchy/patchy.car
+++ /dev/null
@@ -1,28185 +0,0 @@
-PATCHY 5.05 /3 1996/06/29 17.00
-+PATCH, *PATCHY. Pilot for Patchy version 5
-+USE, MACHINE.
-+USE, PATCHY_GO.
-+USE, AUXIL_GO.
-+USE, NOOPT.
-+PATCH, *INSTAL, T=JOIN. Pilot to get the installation job
-+USE, MACHINE.
-+USE, INSTAL.
-+SELF, IF=-*INSTAL.
-To extract the installation job for a given machine:
-
- #!/bin/csh -f -v
- nypatchy patchy.car job.sh .go <</
- +EXE.
- +USE, *INSTAL.
- +USE, APOLLO. (for example)
- +PAM.
- +QUIT.
- /
-
-or if nypatchy is not yet operational, but Patchy 4 is available:
-
- #!/bin/csh -f -v
- ypatchy patchy.car =job.sh :go <</
- +EXE.
- +USE, *INSTAL.
- +USE, APOLLO. (for example)
- +PAM, T=CARDS.
- +QUIT.
- /
- ytobin job.sh =job.pam :go
- ytobcd job.pam =job.sh q &+ :go
- rm job.pam
-+PATCH, MACHINE. Configuration pre-selection
-+USE, OK, QMALT, QS_UNIX, IF=ALLIANT.
-+USE, OK, QMAPO, QF_APO77, IF=APOF77, IF=-OK.
-+USE, OK, QMAPO, IF=APOLLO, IF=-OK.
-+USE, OK, QMCRY, QS_UNIX, IF=CRAY, IF=-OK.
-+USE, OK, QMCVY, QS_UNIX, IF=CONVEX, IF=-OK.
-+USE, OK, QMHPX, QS_UNIX, IF=HPUX, IF=-OK.
-+USE, OK, QMIBM, IF=IBMVM, IF=-OK.
-+USE, OK, QMIBX, IF=IBMAIX, IF=-OK.
-+USE, OK, QMIRT, QS_UNIX, IF=IBMRT, IF=-OK.
-+USE, OK, QMLNX, IF=LINUX, IF=-OK.
-+USE, OK, QMMPW, IF=MACMPW, IF=-OK.
-+USE, OK, QMSGI, QS_UNIX, IF=SGI, IF=-OK.
-+USE, OK, QMSUN, QS_UNIX, IF=SOLARIS, IF=-OK.
-+USE, OK, QMSUN, QS_UNIX, IF=SUN, IF=-OK.
-+USE, OK, QMVAX, IF=VAX, VAXVMS, IF=-OK.
-+USE, OK, QMVAO, IF=QMVAOS, IF=-OK.
-+USE, OK, QMVMI, IF=DECS, IF=-OK.
-+USE, OK, QMUUX, QS_UNIX, IF=UNKNOWN, IF=-OK.
-+USE, PATCHY_GO, T=INH, IF=-OK.
-+SELF, IF=-OK.
-+KILL, IF=-OK. Machine pilot selection for Patchy has failed
-+DECK, MC_APO, T=JOIN, IF=QMAPO. for APOLLO
-+USE, QS_UNIX. running under UNIX
-+USE, QF_APO, IF=-QF_APO77. use FTN compiler, not F77
-+DECK, MC_IBM, T=JOIN, IF=QMIBM. for IBM/VM
-+USE, QS_IBMVM. system IBM VM
-+USE, QF_IBM. IBM VS Fortran
-+USE, QEBCDIC. Character set is EBCDIC
-+DECK, MC_IBX, T=JOIN, IF=QMIBX. for IBM 3090 with AIX
-+USE, QS_UNIX. running under UNIX
-+USE, QF_IBM. IBM VS Fortran
-+DECK, MC_LNX, T=JOIN, IF=QMLNX. for LINUX
-+USE, QS_UNIX. running under UNIX
-+USE, QF_F2C. Fortran-to-C compiler
-+DECK, MC_MPW, T=JOIN, IF=QMMPW. for MPW (under development)
-+USE, QS_MPW. running under Mac Prog. Workbench
-+USE, QF_LSC. Language Systems Corp. Fortran
-+SELF, IF=-QMMPW.
-+DECK, MC_NXT, T=JOIN, IF=QMNXT. for NEXT (not implemented)
-+USE, QS_UNIX. running under UNIX
-+USE, QF_MSOFT. Microsoft Fortran
-+DECK, MC_VAX, T=JOIN, IF=QMVAX. for VAX
-+USE, QS_VMS. system VMS
-+USE, QF_DEC. DEC Fortran
-+DECK, MC_VAO, T=JOIN, IF=QMVAO. for Alpha with OSF
-+USE, QS_UNIX. running under UNIX
-+USE, QF_DEC. DEC Fortran
-+DECK, MC_VMI, T=JOIN, IF=QMVMI. for DECstation MIPS
-+USE, QS_UNIX. running under UNIX
-+USE, QF_DEC. DEC Fortran
-+DECK, MC_ALL, T=JOIN.
-+USE, QASCII, IF=-QEBCDIC. Character set is ASCII
-+PATCH, NOOPT, T=JOIN. Compile without optimisation where nec.
-+SELF. For example: +DIVERT, patch, D=deck, IF=QMSUN.
-+PATCH, INSTAL, T=DATA, SHELL. Installation job
-+USE, WITHVS4, IF=-PY_VS5. create for Patchy 4 if this is running
-+DECK, IN_UNIX, IF=QS_UNIX. install on a machine running Unix
-#!/bin/csh -f -v
-# Create Patchy 5 modules
-
- set PRO = ~/bin/
- set PAM = ~/p5/patchy.car
- set KERNLIB = ~/kern/libkernsh.a
-
-# set PRO = ' '
-# set PAM = /cern/new/src/car/patchy.car
-# set KERNLIB = /cern/new/lib/libkernlib.a
-
- set NEW = ~/uty/new
- set LOAD = f77
- set EXTRA = ' '
-
- setenv ACTION MODIFY
-
-+SELF, IF=APOLLO, IF=-APOF77.
- setenv MACHINE APOLLO
- set LOAD = ld
-+SELF, IF=APOF77.
- setenv MACHINE APOF77
-+SELF, IF=CRAY.
- setenv MACHINE CRAY
-+SELF, IF=CONVEX.
- setenv MACHINE CONVEX
-+SELF, IF=HPUX.
- setenv MACHINE HPUX
- set LOAD = 'f77 +ppu'
-+SELF, IF=IBMRT.
- setenv MACHINE IBMRT
- set LOAD = 'xlf -qextname'
- set EXTRA = '-lc'
-+SELF, IF=LINUX.
- setenv MACHINE LINUX
-+SELF, IF=NEXT.
- setenv MACHINE NEXT
-+SELF, IF=SGI.
- setenv MACHINE SGI
-+SELF, IF=SUN.
- setenv MACHINE SUN
- set LOAD = 'f77 -Bstatic'
-+SELF, IF=QMVAOS.
- setenv MACHINE QMVAOS
-+SELF, IF=DECS, IF=-QMVAOS.
- setenv MACHINE DECS
-+SELF, IF=UUX.
- setenv MACHINE UNKNOWN
-+SELF.
-
- cd $NEW
-+DECK, IN_UNIX4, T=JOIN, IF=QS_UNIX, IF=WITHVS4. using Patchy 4
-
- if (-d wk_patchy) rm -r wk_patchy
- mkdir wk_patchy
- cd wk_patchy
-
- ypatchy $PAM =source.fca :go <</
-&EXE.
-&USE, *PATCHY, $MACHINE.
-&USE, QDEBUG.
-&PAM, T=CARDS.
-/
-
- fcasplit -noh source.fca
- rm source.fca
- csh -f -v source.shfca
-+SELF, IF=APOLLO.
- /com/chn '{?*}.bin' '@1.o'
-+SELF.
-+DECK, IN_UNIX5, IF=QS_UNIX, IF=-WITHVS4. using Patchy 5
-
- if (-d wk_patchy == 0) mkdir wk_patchy
- cd wk_patchy
-
- ${PRO}nypatchy $PAM .go <</
-&ASM, FORT, T=${ACTION}, LOG .source.log
-&EXE.
-&USE, *PATCHY, ${MACHINE}.
-&USE, QDEBUG.
-&OPT, MAP.
-&PAM.
-/
- set rc = $status
- if ($rc != 0) exit
-
- ${PRO}nyshell source u .go <</
-+SELF, IF=QMHPX.
- fo:1
-+SELF.
-
-/
- set rc = $status
- if ($rc != 0) exit
-
- csh -f -v source.shfca
-+DECK, IN_UNIXE, T=JOIN, IF=QS_UNIX.
-
- if (-f p5lib.a) rm p5lib.a
- ar rc p5lib.a *.o
-+SELF, IF=QMCVY, QMIBX, QMLNX, QMSUN, QMVMI, QMVAO.
- ranlib p5lib.a
-+SELF.
-
- $LOAD -o $NEW/nypatchy npatch.o p5lib.a $KERNLIB $EXTRA
- $LOAD -o $NEW/nyindex nindex.o p5lib.a $KERNLIB $EXTRA
- $LOAD -o $NEW/nylist nlist.o p5lib.a $KERNLIB $EXTRA
- $LOAD -o $NEW/nysynopt nsynopt.o p5lib.a $KERNLIB $EXTRA
- $LOAD -o $NEW/nydiff ndiff.o p5lib.a $KERNLIB $EXTRA
- $LOAD -o $NEW/nyshell nshell.o p5lib.a $KERNLIB $EXTRA
- $LOAD -o $NEW/nycheck ncheck.o p5lib.a $KERNLIB $EXTRA
- $LOAD -o $NEW/nymerge nmerge.o p5lib.a $KERNLIB $EXTRA
- $LOAD -o $NEW/nytidy ntidy.o p5lib.a $KERNLIB $EXTRA
-
- chmod 755 $NEW/ny*
-+DECK, IN_VAX, IF=QS_VMS. instal on a machine running VMS (VAX)
-$ set verify = procedure
-$ set verify = noimage
-$ on error then $ goto exit
-$ on control_y then $ goto exit
-$!
-$! COM-file to create the Patchy 5 modules
-$!
-$ assign [zoll.p5.dev] OPDIR
-$ assign [zoll.p5.wyl] SRCDIR
-$ assign [zoll.vaxlib] LIB
-$ assign [zoll.vaxnew] NEW
-$ assign lib:kernlib KERNLIB
-$ assign lib:p5lib P5LIB
-$ uselib :== KERNLIB/LIB,SYS$LIBRARY:VAXCRTL/LIB
-$ ACTION :== SPLIT
-$!
-$ set default OPDIR
-$ set default [.wk_patchy]
-+DECK, IN_VAX4, T=JOIN, IF=QS_VMS, IF=WITHVS4. using Patchy 4
-$ ypatchy SRCDIR:patchy.car =source.fca tty tty .go
-&EXE.
-&USE, *PATCHY, VAX.
-&PAM, T=CARDS.
-&QUIT.
-$ fcasplit -noh source.fca
-+DECK, IN_VAX5, T=JOIN, IF=QS_VMS, IF=-WITHVS4. using Patchy 5
-$ nypatchy SRCDIR:patchy.car .go
-&ASM, FORT, T=${ACTION}, LOG .source.log
-&EXE.
-&USE, *PATCHY, VAX.
-&OPTION, MAPASM.
-&PAM.
-&QUIT.
-$ if $status .ne. 1 then goto exit
-$ nyshell source.log u eof .go
-$ if $status .ne. 1 then goto exit
-+DECK, IN_VAXE, T=JOIN, IF=QS_VMS.
-$ @source.shfca
-$ purge/nolog/noconfirm
-$ lib/create P5LIB *.obj
-$ link/nomap/exe=NEW:nypatchy P5LIB/INC=npatch/LIB,'uselib
-$ link/nomap/exe=NEW:nyindex P5LIB/INC=nindex/LIB,'uselib
-$ link/nomap/exe=NEW:nylist P5LIB/INC=nlist/LIB,'uselib
-$ link/nomap/exe=NEW:nysynopt P5LIB/INC=nsynopt/LIB,'uselib
-$ link/nomap/exe=NEW:nydiff P5LIB/INC=ndiff/LIB,'uselib
-$ link/nomap/exe=NEW:nyshell P5LIB/INC=nshell/LIB,'uselib
-$ link/nomap/exe=NEW:nycheck P5LIB/INC=ncheck/LIB,'uselib
-$ link/nomap/exe=NEW:nymerge P5LIB/INC=nmerge/LIB,'uselib
-$ link/nomap/exe=NEW:nytidy P5LIB/INC=ntidy/LIB,'uselib
-$exit:
-$ set default OPDIR
-$ set noverify
-$ exit
-+DECK, IN_IBMVM, IF=QS_IBMVM. instal on IBM/VM
-/*BATCH TIME 15:00 */
-/*BATCH PUNCH 200K */
-/*BATCH PRINT 100K */
-/*BATCH STORAGE 48M */
-/*BATCH NORETURN "LOAD MAP" */
-Trace C
-fortlev = 4 /* accepted error level*/
-FORTMOD = 'FORTVS2' /* Fortran Compiler */
-FORTLIBS = 'CMSLIB VSF2LINK VSF2FORT' /* Fortran Libraries */
-MACLIBS = 'CMSLIB DMSSP' /* Macro Libraries */
-
-+SELF, IF=WITHVS4.
-/** run YPATCHY to make the compilable file **/
-
-'EXEC YPATCHY PAM="PATCHY CAR A"
- ASM="P5ASM FORTRAN A"
- CRADLE="P5CRA CRADLE A"
- LISTING="P5WK LISTING A"'
-
-+SELF, IF=-WITHVS4.
-/** run NYPATCHY to make the compilable file **/
-
-'nypatchy a/patchy a/p5asm a/p5cra .go'
-if RC /= 0 then Exit 9
-
-+SELF.
-/** compile to make P5ASM TEXT **/
-
-'EXEC VFORT P5ASM (NOLIST'
-+SELF, IF=WITHVS4.
- rcc=RC
- If rcc<=fortlev
- Then Do
- 'ERASE P5WK LISTING A (T'
- Say ' . . . erased'
- End
-+SELF.
-
-/** run EDITLIB + TXTLIB to make P5LIB TEXTLIB **/
-
-'FILEDEF FT06F001 DISK P5WK LISTING A'
-'EDITLIB P5ASM'
-'TXTLIB GEN P5LIB P5ASM'
-
-/* create a dummy routine ENDMODU to be used to mark the end */
-
-line.1=" BLOCK DATA ENDMODU"
-line.2=" END"
-line.3=""
-'EXECIO * DISKW ENDMODU FORTRAN A ( STEM LINE. FINIS'
-fortmod 'ENDMODU (NOPRINT'
-
-/** create the modules of Patchy 5 **/
-
-'GLOBAL TXTLIB P5LIB KERNLIB 'FORTLIBS
-
-'LOAD NPATCH ( CLEAR NOAUTO' ; 'INCLUDE ENDMODU'
-'GENMOD NYPATCHY MODULE A ( FROM NPATCH TO ENDMODU'
-say 'GENMOD creation of NYPATCHY returned RC='RC
-
-'LOAD NINDEX ( CLEAR NOAUTO' ; 'INCLUDE ENDMODU'
-'GENMOD NYINDEX MODULE A ( FROM NINDEX TO ENDMODU'
-say 'GENMOD creation of NYINDEX returned RC='RC
-
-'LOAD NLIST ( CLEAR NOAUTO' ; 'INCLUDE ENDMODU'
-'GENMOD NYLIST MODULE A ( FROM NLIST TO ENDMODU'
-say 'GENMOD creation of NYLIST returned RC='RC
-
-'LOAD NSYNOPT ( CLEAR NOAUTO' ; 'INCLUDE ENDMODU'
-'GENMOD NYSYNOPT MODULE A ( FROM NSYNOPT TO ENDMODU'
-say 'GENMOD creation of NYSYNOPT returned RC='RC
-
-'LOAD NDIFF ( CLEAR NOAUTO' ; 'INCLUDE ENDMODU'
-'GENMOD NYDIFF MODULE A ( FROM NDIFF TO ENDMODU'
-say 'GENMOD creation of NYDIFF returned RC='RC
-
-'LOAD NCHECK ( CLEAR NOAUTO' ; 'INCLUDE ENDMODU'
-'GENMOD NYCHECK MODULE A ( FROM NCHECK TO ENDMODU'
-say 'GENMOD creation of NYCHECK returned RC='RC
-
-'LOAD NMERGE ( CLEAR NOAUTO' ; 'INCLUDE ENDMODU'
-'GENMOD NYMERGE MODULE A ( FROM NMERGE TO ENDMODU'
-say 'GENMOD creation of NYMERGE returned RC='RC
-
-'LOAD NTIDY ( CLEAR NOAUTO' ; 'INCLUDE ENDMODU'
-'GENMOD NYTIDY MODULE A ( FROM NTIDY TO ENDMODU'
-say 'GENMOD creation of NYTIDY returned RC='RC
-
-/*BEGIN P5CRA CRADLE RECFM F LRECL 80 ---------------*/
-&EXE.
-&USE, *PATCHY, IBMVM.
-&USE, QDEBUG.
-+SELF, IF=WITHVS4.
-&PAM, 11, T=CARDS.
-+SELF, IF=-WITHVS4.
-&PAM.
-+SELF.
-&QUIT.
-+PATCH, P5BOOT, T=DATA. Material for the bootstrap export
-+DECK, README.
-+SELF, IF=QS_UNIX.
-Here are the instructions to bootstrap Patchy version 5 on a machine
-which has neither Patchy version 4 nor version 5 operational.
-
- 1) Ask people at CERN to ready the Patchy 5 boot-strap file for
- your machine, a compressed tar file.
-
- 2) Set the current working directory, make sure that it does not
- contain residual .o files, and that it has a subdirectory
- wk_kern existing and empty:
-
- rm *.o
- if (-d wk_kern) rm -r wk_kern
- mkdir wk_kern
-
- 3) Get the compressed tar file containing the bootstrap material,
- on asis (asis01.cern.ch IP address 128.141.201.136)
- its name will be p5bootsun.tar.Z for the SUN, for example.
-
- Split this file with (say)
-
- uncompress p5boot.tar
- tar xf p5boot.tar
-
- The routines and shell-scripts for Patchy will be delivered into
- the current working directory. Patchy relies on some routines
- from Kernlib; their source is also contained on this tar file.
- The Kernlib routines and scripts go into the subdirectory wk_kern.
-
- 4) Compile all Patchy routines by running the shell-script:
-
- csh -f -v p5boot.shfca
-
- Note that everything is compiled initially without optimization.
-
- 5) Compile all Kernlib routines by running:
-
- cd wk_kern
- csh -f -v p5kern.shfca
- cd ../
-
- 6) Make the Patchy modules with the script:
-
- csh -f -v p5create.sh
-
-To be sure not to have problems with the compilers the code is
-non-optimized. To improve on this you can either play with the
-compiler options in the scripts, or you can get the Patchy PAM
-file /cern/new/src/car/patchy.car from asis and run the
-installation shell-script p5instal.sh. You would also want
-to get the Kernlib PAM files and make a complete installation
-of Kernlib; what comes with the bootstrap are only the routines
-needed by Patchy.
-
-For help with the installation mail to cernlib at cernvm.cern.ch
-For help in running Patchy mail to zoll at cern.ch
-
-+DECK, EXPORT, T=CRAD.
-# Nyshell cradle for bootstrap export generation
- fo:1
- fort:2 =fort:1
-
- co:1
- cc:2 =cc:1
-
- ao:1
- as:2 =as:1
-
-+SELF, IF=QS_UNIX.
- fopt -c
- copt -c
- aopt
-+_IF, QF_APO, IF=-QMAPO10.
- fopt -opt 0 -bounds_violation -info 1 -indexl -cpu mathlib_sr10
-+_ELSE, QF_APO, IF=QMAPO10.
- fopt -opt 0 -bounds_violation -info 1 -indexl -cpu a88k
-+_ELSE, QF_APO77, IF=-QMAPO10.
- fopt -c -O0 -A cpu,mathlib_sr10 -W0,-bounds_violation -W0,-info,1 -W0,-indexl
-+_ELSE, QF_APO77, IF=QMAPO10.
- fopt -c -O0 -A cpu,a88k -W0,-bounds_violation -W0,-info,1 -W0,-indexl
-+_ELSE, QMAMX.
- fopt -c -q
-+_ELSE, QMCRY.
- fopt
-+_ELSE, QMCVX.
- fopt -c -72
-+_ELSE, QMDOS.
- fopt -c -vm
- copt -n2 -n3 -OLM
- aopt -c
-+_ELSE, QMHPX.
- fopt -c -w +ppu
-+_ELSE, QMIBX.
- fopt -c -qextname -qcharlen=8192
-+_ELSE, QMIRT.
- fopt -c -qextname -qcharlen=8192
-+_ELSE, QMLNX.
- fopt -c -Nx800 -Nc200 -O2
- copt -c -posix -O2
-+_ELSE, QMSUN.
- fopt -c -w66
-+_ELSE, QMVMI.
- fopt -c -w1
-+_ELSE, QMVAO.
- fopt -c -O0 -w1 -warn nouncalled
- copt -c -O0
-+_ENDIF.
-
- fc f77
- cc cc
- as as
-+_IF, QF_APO.
- fc /com/ftn
-+_ELSE, QMAMX.
- fc ftn
-+_ELSE, QMCRY.
- fc cft77
- cc scc
-+_ELSE, QMCVX.
- fc fc
-+_ELSE, QMDOS.
- fc mf486
- as 386ASM
-+_ELSE, QMIRT.
- fc xlf
-+_ELSE, QMVMI.
- cc f77
-+_ENDIF.
-
- fort:1 ${FC} ${FO_1} ${s}$*.f
- cc:1 ${CC} ${CO_1} ${s}$*.c
- as:1 ${AS} ${AO_1} ${s}$*.s
-+_IF, QF_APO.
- fort:1 ${FC} ${s}$*.ftn ${FO_1}; mv $*.bin $*.o
-+_ELSE, QMSUN.
- as:1 ${AS} -o $*.o ${s}$*.s
-+_ELSE, QMVMI.
- as:1 ${AS} -o $*.o ${s}$*.s
-+_ELSE, QMVAO.
- as:1 ${AS} -o $*.o ${s}$*.s
-+_ENDIF.
-+SELF, IF=QS_VMS.
- fopt /nolist/check=noover
- copt /warn=noinfo
- aopt /nolist
-
- fc fortran
- cc cc
- as macro
-
- fort:1 $ ${FC} ${FO_1} ${s}$*.for
- cc:1 $ ${CC} ${CO_1} ${s}$*.c
- as:1 $ ${AS} ${AO_1} ${s}$*.mar
-+DECK, P5CREATX, T=SHELL, IF=QS_UNIX.
-#!/bin/csh -f -v
-# Create libraries and modules in the Patchy 5 bootstrap
-
- set NEW = "."
- set KERNLIB = wk_kern/p5kernlib.a
- set LOAD = f77
- set EXTRA = ' '
-
-+SELF, IF=APOLLO, IF=-APOF77.
- setenv MACHINE APOLLO
- set LOAD = ld
-+SELF, IF=APOF77.
- setenv MACHINE APOF77
-+SELF, IF=CRAY.
- setenv MACHINE CRAY
-+SELF, IF=CONVEX.
- setenv MACHINE CONVEX
-+SELF, IF=HPUX.
- setenv MACHINE HPUX
- set LOAD = 'f77 +ppu'
-+SELF, IF=IBMRT.
- setenv MACHINE IBMRT
- set LOAD = 'xlf -qextname'
- set EXTRA = '-lc'
-+SELF, IF=LINUX.
- setenv MACHINE LINUX
-+SELF, IF=NEXT.
- setenv MACHINE NEXT
-+SELF, IF=SGI.
- setenv MACHINE SGI
-+SELF, IF=SUN.
- setenv MACHINE SUN
- set LOAD = 'f77 -Bstatic'
-+SELF, IF=QMVAOS.
- setenv MACHINE QMVAOS
-+SELF, IF=DECS, IF=-QMVAOS.
- setenv MACHINE DECS
-+SELF, IF=UUX.
- setenv MACHINE UNKNOWN
-+SELF.
-
- cd wk_kern
- if (-f p5kernlib.a) rm p5kernlib.a
- ar rc p5kernlib.a *.o
-+SELF, IF=QMCVY, QMIBX, QMLNX, QMSUN, QMVMI, QMVAO.
- ranlib p5kernlib.a
-+SELF.
- cd ../
-
- if (-f p5lib.a) rm p5lib.a
- ar rc p5lib.a *.o
-+SELF, IF=QMCVY, QMIBX, QMLNX, QMSUN, QMVMI, QMVAO.
- ranlib p5lib.a
-+SELF.
-
- $LOAD -o $NEW/nypatchy npatch.o p5lib.a $KERNLIB $EXTRA
- $LOAD -o $NEW/nyindex nindex.o p5lib.a $KERNLIB $EXTRA
- $LOAD -o $NEW/nylist nlist.o p5lib.a $KERNLIB $EXTRA
- $LOAD -o $NEW/nysynopt nsynopt.o p5lib.a $KERNLIB $EXTRA
- $LOAD -o $NEW/nydiff ndiff.o p5lib.a $KERNLIB $EXTRA
- $LOAD -o $NEW/nytidy ntidy.o p5lib.a $KERNLIB $EXTRA
- $LOAD -o $NEW/nyshell nshell.o p5lib.a $KERNLIB $EXTRA
- $LOAD -o $NEW/nycheck ncheck.o p5lib.a $KERNLIB $EXTRA
- $LOAD -o $NEW/nymerge nmerge.o p5lib.a $KERNLIB $EXTRA
-
- chmod 755 $NEW/ny*
-+DECK, P5CREATE, T=JOIN, SHELL, IF=QS_VMS.
-+PATCH, JEXPORT, T=SHELL. Bootstrap export job model
-#!/bin/csh -f -v
-# Generate the export of the bootstrap for Patchy 5, to be run at CERN
-
- setenv P5PAM ~/p5/wyl/patchy.car
- setenv KERN ~/kern/wyl
-
-# setenv MACHINE APOLLO
-# setenv MACHINE APOF77
-# setenv MACHINE CONVEX
-# setenv MACHINE HPUX
-# setenv MACHINE IBMRT
-# setenv MACHINE LINUX
-# setenv MACHINE NEXT
-# setenv MACHINE SGI
-# setenv MACHINE SUN
-# setenv MACHINE 'ALPHA,OSF'
-# setenv MACHINE DECS
-# setenv MACHINE UUX
-
- if ( $MACHINE == APOLLO ) set code = apo
- if ( $MACHINE == APOF77 ) set code = apo77
- if ( $MACHINE == CONVEX ) set code = cvx
- if ( $MACHINE == HPUX ) set code = hpx
- if ( $MACHINE == IBMRT ) set code = irt
- if ( $MACHINE == LINUX ) set code = lnx
- if ( $MACHINE == NEXT ) set code = nxt
- if ( $MACHINE == SGI ) set code = sgi
- if ( $MACHINE == SUN ) set code = sun
- if ( $MACHINE == 'ALPHA,OSF' ) set code = vao
- if ( $MACHINE == DECS ) set code = vmi
- if ( $MACHINE == UUX ) set code = uux
-
- if (-f p5boot$code.tar.Z) rm p5boot$code.tar.Z
-
- if (-d wk_p5boot) rm -r wk_p5boot
- mkdir wk_p5boot
- cd wk_p5boot
-
-#------------- doing Patchy
-
- nypatchy $P5PAM .go <<\\
-&USE, ${MACHINE}.
-&ASM, FORT, T=SPLIT, LOG .p5boot.log
-&ASM, CRAD, T=EXT ..cra
-&ASM, SHELL:2, T=ATT .p5instal.sh
-&ASM, FORT, T=EXT, IF=APOLLO ..ftn
-&EXE.
-&USE, *PATCHY, P5BOOT.
-&USE, AUXIL_GO, T=INH.
-&USE, QDEBUG.
-&USE, INSTAL, T=DIVERT.
-.OPTION, VERBOSE.
-&PAM.
-\\
- set rc = $status
- if ($rc != 0) exit
-
- nyshell p5boot.log a export.cra .go
- set rcpatchy = $status
- if ($rcpatchy >= 2) exit
- chmod 755 *.sh*
- rm p5boot.log
-
-#------------- doing Kernlib
-
- if (-d wk_kern) rm -r wk_kern
- mkdir wk_kern
- cd wk_kern
-
- nypatchy $P5PAM .go <<\\
-&USE, ${MACHINE}.
-&ASM, FORT, T=SPLIT, LOG .p5kern.log
-&ASM, FORT, T=EXT, IF=APOLLO ..ftn
-&EXE.
-&USE, MACHINE.
-&PAM, RETURN=MACHINE.
-&USE, P5BOOT.
-&USE, *KAMX, IF=AMIGAUX.
-&USE, *KAPO, IF=QF_APO
-&USE, *KAPOF77, IF=QF_APOF77.
-&USE, *KCRU, IF=QMCRY.
-&USE, *KCVY, IF=QMCVY.
-&USE, *KDOS, IF=MSDOS.
-&USE, *KHPX, IF=QMHPX.
-&USE, *KIBX, IF=QMIBX.
-&USE, *KIRT, IF=QMIRT.
-&USE, *KLNX, IF=LINUX.
-&USE, *KMPW, IF=MACMPW.
-&USE, *KNSX, IF=NECSX.
-&USE, *KNXT, IF=NEXT.
-&USE, *KSGI, IF=QMSGI.
-&USE, *KSUN, IF=QMSUN.
-&USE, *KTMO, IF=TMO.
-&USE, *KVAOS, IF=QMVAO.
-&USE, *KVMI, IF=QMVMI.
-&USE, *KVAX, IF=QMVAX,IF=-QMALPH.
-&USE, *KALPH, IF=QMVAX,IF= QMALPH.
-&USE, *KUUX, IF=QMUUX.
-.OPTION, VERBOSE.
-&PAM, T=ATT, IF=QMAPO .${KERN}/kernapo
-&PAM, T=ATT, IF=QMCRY .${KERN}/kerncry
-&PAM, T=ATT, IF=QMCVY .${KERN}/kerncvx
-&PAM, T=ATT, IF=QMHPX .${KERN}/kernhpx
-&PAM, T=ATT, IF=QMIBX .${KERN}/kernibx
-&PAM, T=ATT, IF=QMIRT .${KERN}/kernirt
-&PAM, T=ATT, IF=QMLNX .${KERN}/kernlnx
-&PAM, T=ATT, IF=QMSGI .${KERN}/kernsgi
-&PAM, T=ATT, IF=QMSUN .${KERN}/kernsun
-&PAM, T=ATT, IF=QMVAX .${KERN}/kernvax
-&PAM, T=ATT, IF=QMVMI .${KERN}/kernvmi
-&PAM, T=ATT .${KERN}/kernfor
-&QUIT.
-\\
- set rc = $status
- if ($rc != 0) exit
-
- nyshell p5kern.log a ../export.cra .go
- set rckern = $status
- if ($rckern >= 2) exit 7
- chmod 755 *.sh*
- rm p5kern.log
- cd ../
- rm export.cra
-
-#------------- make the tar file
-
- tar -cf ../p5boot$code.tar *
- cd ../
- compress p5boot$code.tar
-
-#--- remove everything except the tar file
-
- rm -r wk_p5boot
- exit
-
-#------------- if one wanted to check the result:
-#- but only on the target machine
-
- mkdir wk_p5boot
- cd wk_p5boot
- cp ../p5boot$code.tar.Z p5boot.tar.Z
- uncompress p5boot.tar
- tar -xf p5boot.tar
-
- csh -f -v p5boot.shfca
- cd wk_kern
- csh -f -v p5kern.shfca
- cd ../
- csh -f -v p5create.sh
- cd ../
- rm -r wk_p5boot
-+PATCH, PATCHY_GO. Select Patchy and the Auxiliaries
-+USE, BACKCOMP.
-+USE, PCDE, FLDIALG.
-+USE, RUN, ACSORT, DOMAP, DOXQT, DOFORG.
-+USE, ARRIVE, DEPART, PUTIL.
-+USE, SERVICE, NAMING.
-+USE, *HYDRA.
-+USE, QDEBUG, TESTR, IF=QDIAG.
-+USE, YINDEX, IF=AUXIL_GO.
-+USE, YLIST, IF=AUXIL_GO.
-+USE, YSYNOPT, IF=AUXIL_GO.
-+USE, YCHECK, IF=AUXIL_GO.
-+USE, YTIDY, IF=AUXIL_GO.
-+USE, YMERGE, IF=AUXIL_GO.
-+USE, YDIFF, IF=AUXIL_GO.
-+USE, YSHELL, IF=AUXIL_GO.
-+USE, AUXIL, IF=AUXIL_GO.
-+DECK, APO, T=JOIN, IF=QMAPO. version for APOLLO
-+SELF. +USE, QFIO. !!! to try
-+USE, QNEWLINE. newlines are in memory
-+USE, INITRH. create routine header lines
-c>>>>>>
-C+KEEP, Q_AND.
-C IAND (IZV,IZW) = AND (IZV, IZW)
-C+KEEP, Q_OR.
-C IOR (IZV,IZW) = OR (IZV, IZW)
-c>>>>>>
-+KEEP, Q_XOR.
- IEOR (IZV,IZW) = XOR (IZV, IZW)
-+KEEP, Q_SHIFTL.
- ISHFTL (IZW,NZB) = LSHFT (IZW, NZB)
-+KEEP, Q_SHIFTR.
- ISHFTR (IZW,NZB) = RSHFT (IZW, NZB)
-c>>>>>>
-C+KEEP, Q_JBIT.
-C JBIT (IZW,IZP) = AND (RSHFT(IZW,IZP-1), 1)
-c>>>>>>
-+KEEP, Q_JBYT.
- JBYT (IZW,IZP,NZB)= RSHFT (LSHFT(IZW,33-IZP-NZB), 32-NZB)
-+KEEP, PGMSTOP.
- CALL PGM_$EXIT
-+DECK, HPX, T=JOIN, IF=QMHPX. version for HP Unix
-+USE, QNEWLINE. newlines are in memory
-+USE, INITRH. create routine header lines
-+KEEP, Q_JBIT.
- JBIT (IZW,IZP) = IBITS (IZW,IZP-1,1)
-+KEEP, Q_JBYT.
- JBYT (IZW,IZP,NZB) = IBITS (IZW,IZP-1,NZB)
-+DECK, IBM, T=JOIN, IF=QMIBM. version for IBM
-+USE, QFIO. Fortran I/O
-+USE, INITRH. create routine header lines
-+USE, YSHELL, T=INH. for the time being
-+DECK, IRT, T=JOIN, IF=QMIRT. version for IBM RS 6000
-+USE, QNEWLINE. newlines are in memory
-+USE, INITRH. create routine header lines
-+DECK, LNX, T=JOIN, IF=QMLNX. version for LINUX
-+USE, QNEWLINE. newlines are in memory
-+USE, INITRH. create routine header lines
-+DECK, MPW, T=JOIN, IF=QMMPW. version for Mac with MPW
-+USE, QNEWLINE. newlines are in memory
-+USE, INITRH. create routine header lines
-+KEEP, Q_JBIT.
- JBIT (IZW,IZP) = IBITS (IZW,IZP-1,1)
-+KEEP, Q_JBYT.
- JBYT (IZW,IZP,NZB) = IBITS (IZW,IZP-1,NZB)
-+SELF, IF=-QMMPW.
-
-
-
-
-
-
-
-
-
-
-
-+DECK, NXT, T=JOIN, IF=QMNXT. version for NEXT
-+USE, QNEWLINE. newlines are in memory
-+USE, INITRH. create routine header lines
-+DECK, SGI, T=JOIN, IF=QMSGI. version for Silicon Graphics
-+USE, QNEWLINE. newlines are in memory
-+USE, INITRH. create routine header lines
-+KEEP, Q_SHIFTL.
- ISHFTL (IZW,NZB) = LSHIFT (IZW, NZB)
-+KEEP, Q_SHIFTR.
- ISHFTR (IZW,NZB) = RSHIFT (IZW, NZB)
-+KEEP, Q_JBIT.
- JBIT (IZW,IZP) = IAND (RSHIFT(IZW,IZP-1), 1)
-+KEEP, Q_JBYT.
- JBYT (IZW,IZP,NZB)= RSHIFT (LSHIFT(IZW,33-IZP-NZB), 32-NZB)
-+DECK, SUN, T=JOIN, IF=QMSUN. version for SUN
-+USE, QNEWLINE. newlines are in memory
-+USE, INITRH. create routine header lines
-c>>>>>>
-C+KEEP, Q_AND.
-C IAND (IZV,IZW) = AND (IZV, IZW)
-C+KEEP, Q_OR.
-C IOR (IZV,IZW) = OR (IZV, IZW)
-c>>>>>>
-+KEEP, Q_XOR.
- IEOR (IZV,IZW) = XOR (IZV, IZW)
-+KEEP, Q_SHIFTL.
- ISHFTL (IZW,NZB) = LSHIFT (IZW, NZB)
-+KEEP, Q_SHIFTR, IF=-BUGLRSHFT. not usable with f77 3.0
- ISHFTR (IZW,NZB) = lrshft (IZW, NZB)
-c>>>>>
-C+KEEP, Q_JBIT, IF=-BUGLRSHFT.
-C JBIT (IZW,IZP) = AND (lrshft(IZW,IZP-1), 1)
-c>>>>>
-+KEEP, Q_JBYT, IF=-BUGLRSHFT.
- JBYT (IZW,IZP,NZB)= lrshft (LSHIFT(IZW,33-IZP-NZB),32-NZB)
-+DECK, VAX, T=JOIN, IF=QMVAX. version for VAX
-+USE, QFIO. Fortran I/O
-+USE, INITRH. create routine header lines
-+DECK, VAO, T=JOIN, IF=QMVAO. version for Alpha with OSF
-+USE, QNEWLINE. newlines are in memory
-+USE, INITRH. create routine header lines
-+DECK, VMI, T=JOIN, IF=QMVMI. version for DECstation MIPS
-+USE, QNEWLINE. newlines are in memory
-+USE, INITRH. create routine header lines
-+DECK, UUX, T=JOIN, IF=QMUUX. version for an Unknown UniX machine
-+USE, QNEWLINE. newlines are in memory
-+USE, INITRH. create routine header lines
-+DECK, F2C, T=JOIN, IF=QF_F2C. code for f2c
-c>>>>>>
-C+KEEP, Q_AND.
-C IAND(IZV,IZW) = AND(IZV,IZW)
-C+KEEP, Q_OR.
-C IOR(IZV,IZW) = OR(IZV,IZW)
-c>>>>>>
-+KEEP, Q_XOR.
- IEOR(IZV,IZW) = XOR(IZV,IZW)
-+KEEP, Q_SHIFTL.
- ISHFTL (IZW,NZB) = LSHIFT (IZW,NZB)
-+KEEP, Q_SHIFTR.
-c>>>>>>
-C+KEEP, Q_JBIT.
-C JBIT(IZW,IZP) = AND(ISHFTR(IZW,IZP-1),1)
-c>>>>>>
-+KEEP, Q_JBYT.
- JBYT(IZW,IZP,NZB) = ISHFTR(LSHIFT(IZW,33-IZP-NZB),32-NZB)
-+DECK, ALL, T=JOIN.
-+USE, QCIO, IF=-QFIO. Use C for I/O
-+KEEP, Q_SHIFTL.
- ISHFTL (IZW,NZB) = ISHFT (IZW, NZB)
-+KEEP, Q_SHIFTR.
- ISHFTR (IZW,NZB) = ISHFT (IZW, -NZB)
-+KEEP, Q_AND, T=NOLIST.
-+KEEP, Q_OR, T=NOLIST.
-+KEEP, Q_NOT, T=NOLIST.
-+KEEP, Q_XOR, T=NOLIST.
-+KEEP, Q_JBIT, T=NOLIST.
-+KEEP, Q_JBYT, T=NOLIST.
-+KEEP, QCARDL, T=NOLIST.
-+PATCH, PATCHY_LIB. to make the library without main programs
-+USE, RUN, D=NPATCH, T=INH.
-+USE, YINDEX, D=NINDEX, T=INH.
-+USE, YLIST, D=NLIST, T=INH.
-+USE, YSYNOPT, D=NLIST, T=INH.
-+USE, YCHECK, D=NCHECK, T=INH.
-+USE, YMERGE, D=NMERGE, T=INH.
-+USE, YTIDY, D=NTIDY, T=INH.
-+USE, YDIFF, D=NDIFF, T=INH.
-+USE, YSHELL, D=NSHELL, T=INH.
-+PATCH, *HYDRA, T=JOIN. Hydra pilot
-+USE, QCDE, MQ, QUTIL, KERN.
-+USE, DQ, IF=QDEBUG.
-+PATCH, PCDE. Patchy CDE's
-+DECK, PCDE.
-+KEEP, NAMEC.
- COMMON /NAMEC/ NA_OCC, NA_CUT, NA_MXSL, NA_MXTX
-+KEEP, JSPSEQ.
- PARAMETER (JSPSEQ1=3, JSPDATE=9, JSPSEQL=15)
-+KEEP, ARRCOM.
- COMMON /ARRCOM/IN_LUN, IN_FD, IN_FIO, IN_EOF
- +, IN_DOX, IN_DO1, IN_DO2
-+KEEP, CCTYPE.
- PARAMETER (MCCNIL=1, MCCKIL=2, MCCINC=3, MCCCDE=4, MCCSEQ=5,
- + MCCXSQ=6, MCCTRU=7, MCCFAL=8, MCCELS=9, MCCEND=10,
- + MCCSEL=11, MCCSES=12, MCCFAU=13, MCCSKI=14,
- + MCCKEE=15, MCCDEL=16, MCCREP=17, MCCADB=18, MCCADD=19,
- + MCCUSE=20, MCCXDI=21, MCCDIV=22, MCCLIS=23, MCCEXE=24, MCCIMI=25,
- + MCCASM=26, MCCUPD=27, MCCNAM=28, MCCGAP=29, MCCMOR=30, MCCONL=31,
- + MCCFOR=32, MCCSUS=33, MCCOPT=34, MCCOP2=35, MCCSHO=36, MCCPAM=37,
- + MCCQUI=38, MCCEOD=39, MCCDEC=40, MCCPAT=41, MCCTIT=42)
-+KEEP, CCPARA.
- CHARACTER CCKORG*256, CCKARD*256, CCCOMF*256
- COMMON /CCPARA/NCHCCD,NCHCCT, JCCTYP,JCCLEV,JCCSL,MCCPAR(240)
- +, NCCPAR,MXCCIF,JCCIFV,JCCBAD,JCCWAR,ICCSUB,JCCWK(4)
- +, JCCPP,JCCPD,JCCPZ,JCCPT,JCCPIF,JCCPC,JCCPN
- +, NCCPP,NCCPD,NCCPZ,NCCPT,NCCPIF,NCCPC,NCCPN
- +, JCCEND, NCHCCC,IXCCC, CCKORG, CCKARD, CCCOMF
-+KEEP, CHEXC.
- CHARACTER CHEXPD*68
- COMMON /CHEXC/ IXEXPAM, IXEXPAT,IXEXDEC,IXEXID, NCHEPD, CHEXPD
-+KEEP, CM_TYP.
- PARAMETER (JFO_TYP=1, JCC_TYP=2, JAS_TYP=3, JDA_TYP=4,
- + JSH_TYP=5, JCR_TYP=6, JIN_TYP=7, MAX_TYP=100)
- CHARACTER*16 CH_TYP(MAX_TYP), ACT_TYP
- COMMON /CM_TYP/ LUN_TYP, N_TYP, NAL_TYP, NDV_TYP, JBK_TYP
- +, JU_TYP(MAX_TYP), CH_TYP, ACT_TYP
-+KEEP, DEPCOM.
- COMMON /DEPCOM/JD_NEW, JD_DTN, JD_DTP, JD_DTD, JD_DIV
- +, JD_SML, JD_SMP, JD_SMX, JDP_DT, JDP_DV
- +, JD_SPL, JD_MOD, JD_LUN, JD_LOG, JD_NLI, JD_MULT
- +, IX_EXT, IX_RH, IX_SUB
-+KEEP, DEPMOD.
- COMMON /DEPMOD/MO_JSA, MO_JSL, MO_JSE
-+KEEP, DEPSUB.
- CHARACTER*8 CH_SUBS, CH_SUBT
- COMMON /DEPSUB/NCH_SUB, CH_SUBS, CH_SUBT
-+KEEP, DIFFC.
- COMMON /DIFFC/ NFAID, JFAIDA, JFAIDE
-+KEEP, FTNLUN, IF=QFIO. Active Fortran logical input units
- PARAMETER (NSFTN=20)
- COMMON /FTNLUN/LUNFRS(NSFTN)
-+KEEP, FLINKC.
- PARAMETER (NSLIFI=128)
- CHARACTER CHLIFI*(NSLIFI), CHLIEX*8
- COMMON /FLINKC/LUNOP,LUNFD,LUNOLD,LUNSIZ
- +, IXFLUN, NLIFI,CHLIFI,CHLIEX
-+KEEP, INCLC.
- COMMON /INCLC/ N_INCL, IX_INCL(100)
-+KEEP, LUNSLN.
- COMMON /LUNSLN/IFLAUX, IXLUN(12)
-+KEEP, NCNAME.
- PARAMETER (NCNAME=32)
-+KEEP, TAGC.
- CHARACTER CHTAG*80, CHWYL*16
- COMMON /TAGC/ LLORG,LNORG,LLACT,LNACT, LALTN,LMODE,NCHTAG
- +, CHTAG,CHWYL
-+KEEP, TITLEC.
- PARAMETER (NFIMAX=100)
- COMMON /TITLEC/ NFILET, JTIPAM(NFIMAX)
-+KEEP, USETTC.
- CHARACTER CHTTNA*10, CHTTDT*20
- COMMON /USETTC/ JTTNAM,JTTVER,JTTSLA,JTTDAT,JTTCOM
- +, NTTNA(5), NTTDT, NTTNORM, NTTALL
- +, CHTTNA(5), CHTTDT
-+KEEP, M_ANAC.
- COMMON /M_ANAC/LOWAN,KDOAN,LDOAN,LUPAN,MODEAN,MEXAN,LEVAN,KKM5AN
- +, NEWDEC,NEWCTL,NEWFOR,NEWNIL,NEWINC
-+KEEP, KQADR.
- PARAMETER (KQGARB=1,KQARRV=3,KQKEEP=4,KQPREP=5,KQMAIN=6,KQPAST=8)
-+KEEP, KQUSER.
- PARAMETER (KQUSER=9)
-+KEEP, PY.
- +, LEXP,LLPAST,LQPAST, LQUSER(4), LHASM,LRPAM,LPAM, LQINCL
- +, LACRAD,LARRV, LPCRA,LDCRAB, LEXD,LDECO, LCRP,LCRD, LSERV
- +, INCRAD, IFLGAR, JANSW, IFMODIF, IFALTN
- +, JDKNEX,JDKTYP, JSLZER,NSLORG,JSLORG
- +, MOPTIO(34), MOPUPD, NCLASH, IFLMERG,IFLDISP, NSLFRE,NTXFRE
- +, NVGAP(4), NVGARB(6), NVIMAT(4), NVUTY(4), LASTWK
-+KEEP, MUSEBC.
- COMMON /MUSEBC/ MX_FORC, MU_GLOB, MU_PAT, MU_DECK, MU_INH, MU_FORG
- +, MX_TRAN, MX_FORG, MX_SINH, MX_SELF, NVEXDK(6)
-+KEEP, SLATLN.
- CHARACTER SLLINE*512, SLERRM*256
- COMMON /SLATLN/ SLLINE, SLERRM
-+DECK, PEXPL, IF=DOCUMENT, DOC_INL. explain the COMMON variables
-+KEEP, xARRCOM.
-C-- ARRIVE parameters:
-
-C- IN_LUN LUN of currently arriving material
-C- IN_FD C file descriptor of currently arriving material
-C- IN_FIO 0/1 if no/yes Fortran input
-C- IN_EOF 0/1 if EoF seen
-
-C- IN_DOX action request to ARRINC
-C- = -1 close
-C- 0 rewind
-C- +1 reposition file such that line in slot IN_DO1
-C- is the next line to be read
-C- +2 read starting at slot LQLEND(2),
-C- at most IN_DO1 lines, IN_DO2 characters
-C- IN_DO1 auxiliary parameters
-C- IN_DO2
-
-+KEEP, xCCTYPE. c/line type codes
-
-C- PARAMETER (MCCxxx see: D=CCKRAK
-
-+KEEP, xCCPARA.
-C-- Control-line kracking parameters:
-
-C- NCHCCD number of char. in c/l up to incl. terminating "."
-C- NCHCCT total number of char. in current c/l
-C- JCCTYP c/l type of current c/line
-C- JCCLEV number of underscores in current +_IF etc
-C- JCCSL slot number of the current control line
-
-C: MCCPAR(240) the c/l parameter vector
-
-C- the following words are pre-zeroed with VZERO:
-C- NCCPAR number of entries
-C- MXCCIF EXE bits of all patches referenced with IF=
-C- JCCIFV 0/1 true/false result of IF= (done in CCPROC)
-C- JCCBAD non-zero if syntax error
-C- JCCWAR = zero if no warning,
-C- = 1 obscured terminating dot
-C- = 2 trailing comma
-C- ICCSUB non-zero if envir. var. substitution done and result
-C- not yet printed
-C- JCCWK(4) pre-zeroed local variables of CCKRAK
-
-C- JCCPP access to the first parameter of type X, = 0 if none
-C- JCCPD
-C- JCCPZ
-C- JCCPT
-C- JCCPIF
-C- JCCPC
-C- JCCPN
-
-C- NCCPP number of parameters of type X
-C- NCCPD
-C- NCCPZ
-C- NCCPT
-C- NCCPIF
-C- NCCPC
-C- NCCPN
-
-C- JCCEND first unused word in MCCPAR, set to zero
-C- NCHCCC number of characters ready in CCCOMF
-C- IXCCC the name-index of the comment-field in CCCOMF
-C- stored into the name-stack
-
-C- CCKORG*256 the original of the current c/l, unchanged
-C- CCKARD*256 the current c/l, blank squeezed,
-C- converted to upper case
-C- CCCOMF*256 the comment-field of the current c/c copied
-C- to here by CALL CCCOMG
-
-C- each entry in the MCCPAR() parameter vector has 3 words,
-C- the N'th parameter of key x is accessed via:
-
-C- J = JCCPx + 3*(N-1) [but for T= : J=JCCPT + 3*N ]
-
-C- as: MCCPAR(J) = jtyp
-C- MCCPAR(J+1)= jval1
-C- MCCPAR(J+2)= jval2
-
-C: special preset : MCCPAR (1)= zero, (2)= -1, (3)= (zero)
-C- for J = 0: J+1 J+2
-
-C: "jtyp" indicates the separator type just preceding,
-C- set -ve if parameter starts with "-"
-
-C- 1 comma only 5 ,T= or ,X=
-C- 2 ,P= or ,S= 6 ,IF= or ,&=
-C- 3 ,D= or ,R= 7 ,C= or ,L=
-C- 4 ,Z= or ,F= 8 ,N=
-
-C: "jval1" and "jval2" indicate the parameter value,
-C- depending on the parameter type:
-
-C- P=,D=,Z=,IF= : jval1 = name index of the name
-C- jval2 = jval1
-
-C- C=, N= : jval1 = first integer value
-C- jval2 = second, of N1-N2
-
-C- T= : for J=JCCPT, summary of all parameter values:
-C- jval1= bit set for each value occuring
-C- jval2= jval1 initially, reset by CCOPT in
-C- the order of the argument list
-
-C- for J=JCCPT + 3*N, whereabouts of the parameter:
-C- jval1= JPOS, CCOL(JPOS) first character
-C- jval2= NCH, length of the parameter string
-
-C: The values for C= are changed for
-
-C- +DEL, or +REPL,..., C=x: jval1 = x, jval2 = x
-C- +ADB, pname, dname, C=x: jval1 = x, jval2 = x
-C- +ADD, pname, dname, C=x: jval1 = x+1, jval2 = x
-
-C: Note for defaults, for example if JCCPD is zero:
-
-C- JVAL = MCCPAR(JCCPD+1)
-C- gives zero for "no D=" and for D=,
-C- index for D=name
-
-C- JVAL = MCCPAR(JCCPD+2)
-C- gives -1 for "no D="
-C- zero for D=,
-C- index for D=name
-
-+KEEP, xCHEXC.
-C-- Current deck / patch / PAM:
-
-C- IXEXPAM current PAM name index
-C- IXEXPAT current patch name index
-C- IXEXDEC current deck name index
-C- IXEXID current thing name index: deck, or patch if blank deck
-C- NCHEPD number of characters in the current P/D identifier
-C- CHEXPD*68 current P/D identifier constructed by DPHEAD
-
-+KEEP, xCM_TYP. data-type handling
-
-C- MAX_TYP maximum number of data types
-C- LUN_TYP highest LUN used for ASM, = 32, 33, 34,...
-
-C- N_TYP number of data types established
-C- NAL_TYP number of aliases defined (including REPEAT + JOIN)
-C- NDV_TYP = i from ASMNAME cracking of type:i
-C- JBK_TYP > 0 if ASMNAME did back-compatibility data-type conversion
-C- JU_TYP(j) = i: alias j referes to ASM stream i
-C- CH_TYP(n)*16 table of data type codes
-C- ACT_TYP*16 = type from ASMNAME cracking of type:i
-
-C: preset: CH_TYP(1) = 'FORT '
-C- CH_TYP(2) = 'CC '
-C- CH_TYP(3) = 'AS '
-C- CH_TYP(4) = 'DATA '
-C- CH_TYP(5) = 'SHELL '
-C- CH_TYP(6) = 'CRAD '
-C- CH_TYP(7) = 'INCL '
- JU_TYP
-C- CH_TYP(n-5) = 'CO*MPILE' 1
-C- CH_TYP(n-4) = 'XCC ' 2
-C- CH_TYP(n-3) = 'AS** ' 3
-C- CH_TYP(n-2) = 'DA*TA ' 4
-C- CH_TYP(n-1) = 'R*EPEAT ' -1
-C- CH_TYP(n-0) = 'J*OIN ' -2
-
-+KEEP, xDEPCOM.
-C-- Depart parameters
-
-C- JD_NEW flag: 0 output for current deck running
-C- +1 output for new deck has to be started
-C- -1 output for new routine has to be started
-
-C- JD_DTN data type of the deck about to be processed
-C- JD_DTP data type of the current patch
-C- JD_DTD data type of the current deck
-C- 1 FORT, 2 CC, 3 AS, 4 DATA, 5 SHELL, 6 INCL
-C- 7 user data type 1, 8 ...
-
-C- JD_DIV diversion status of current deck
-C- 1 normal, 2 divert, 3 xdiv/normal, 4 xdiv/divert
-
-C- JD_SML adr of the ASML bank for the current logical stream
-C- JD_SMP adr of the ASML bank for the current physical stream
-C- JD_SMX adr of the ASMX bank for the current physical stream
-
-C- JDP_DT stream number of the ASML for the physical stream
-C- JDP_DV and its diversion number
-
-C- JD_SPL departure mode:
-C- 0 bypass
-C- 1 normal sequential output
-C- 2 split mode
-C- 3 modify mode
-C- JD_MOD not zero if MODIFY is running,
-C- set or reset to zero for normal output
-
-C- JD_LUN Fortran logical unit / C file descriptor for the ASM file
-C- JD_LOG Fortran logical unit / C file descriptor for the log file
-C- JD_NLI number of lines written for current deck/routine
-C- JD_MULT number of files written for this deck
-
-C- IX_EXT name index for default extension
-C- IX_RH name index to the routine-header line mask
-C- IX_SUB name index to the control-character substitution string
-
-+KEEP, xDEPMOD.
-C-- Depart parameter for T=MODIFY
-
-C- MO_JSA slot number of first line in store
-C- MO_JSL slot number of current line
-C- MO_JSE slot number of last line in store
-
-+KEEP, xDEPSUB.
-C-- Control-character substitution for Depart
-
-C- NCH_SUB number of possible c/ch
-C- CH_SUBS*8 source c/ch's
-C- CH_SUBT*8 target c/ch's
-
-+KEEP, xDIFFC.
-C-- Difference processing, result from DIF_XQT
-
-C- NFAID number of entries in the failure list
-C- JFAIDA start adr of the failure list produced by DIF_XQT
-C- JFAIDE end+1 adr of this list
-
-C- one entry in this list is :
-
-C- MFAID(J + 0 : code -1 pure delete
-C- 0 delete / insert
-C- +1 pure insert
-C- + 1 : n of failure-start line for "old"
-C- + 2 : n of failure-start line for "new"
-C- + 3 : no. of lines deleted
-C- + 4 : no. of lines inserted
-
-+KEEP, xFLINKC. file linking parameters
-
-C- PARAMETER (NSLIFI=128) length of CHLIFI
-
-C- LUNOP Fortran logical unit number
-C- LUNFD C file descriptor, returned from FLINK
-C- LUNOLD = 0/1 returned from FLINK: file did not/did pre-exist
-C- LUNSIZ file size measured by FLINK, =0 if not poss.
-C- IXFLUN name index of the file name, as returned by FLKRAK
-C- if non-zero on entry to FLINK: get the name into CHLIFI
-C- NLIFI number of significant characters in CHLIFI
-C- CHLIFI*() the file name, may be preloaded before entry to FLINK
-C- CHLIEX*8 the default extension, may be preloaded before
-C- entry to FLKRAK
-
-+KEEP, xJSPSEQ.
-C---- Special sequence calls (see D=NA_INPY and D=INISEQ):
-C- JSPSEQ1+
-C-- special actions
-C-. +0 -1 QCARD1, R=name. start new sub-deck
-C-. +1 0 QEJECT, N=n. conditional page eject
-
-C-- generate for each call
-C-. +2 1 QFTITLE, N=n. gives: +nHtitle
-C-. +3 2 QFTITLCH, N=n. gives: + 'title'
-C-. +4 3 QFHEAD, S=symb, L=lim, N=n .txb?txa
-C-. +5 4 QFNAME, S=symb, L=lim, N=n .txb?txa
-C-. +6 5 QFVERS, S=symb, L=lim, N=n .txb?txa
-C-. +7 6 QFVSNUM, S=symb, L=lim, N=n .txb?txa
-C-. +8 7 QFVPRIM, S=symb, L=lim, N=n .txb?txa
-C-. +9 8 QFVSEC, S=symb, L=lim, N=n .txb?txa
-C-. +10 9 QDATE, S=symb .txb?txa
-C-. +11 10 QTIME, S=symb .txb?txa
-C-. +12 11 QENVIR .text
-
-C-- constants of the run
-C-. +13 QTERMHD gives: \\ or \
-C-. +14 DATEQQ gives: IDATQQ = yymmdd
-C-. +15 TIMEQQ gives: ITIMQQ = hhmm
-
-+KEEP, xLUNSLN. MAIN connection
-C-- Passing the command-line/dialog parameters to MAIN:
-
-C- IFLAUX non-zero if an Auxiliary is executing
-C- IXLUN(J) name index to file-name / opt string for J'th param.
-
-+KEEP, xM_ANAC.
-C-- DOMAP communication:
-
-C- LDOAN L of current PREP/MAT bank
-C- KDOAN K-adr of LDOAN
-
-C- LOWAN L of PREP bank sending to LUPAN
-C- LUPAN L of current ACT bank if doing foreign material
-C- into current deck
-C- = zero: doing PREP banks
-
-C- MODEAN material type being currently processed:
-C- = 0 ordinary self 1 IF-conditional self
-C- 2 +SELF,sname 3 +KEEP 4 +REPL,+ADB,+ADD
-
-C- MEXAN cumulating EXE bits for self material of current deck
-C- LEVAN IF level indication offset = (level) - (no of underscores)
-C- KKM5AN zero if bit 5 not set set in current PREP bank at LDOAN
-C- NEWDEC number of +DECK etc seen in current deck
-C- NEWCTL current deck has hard c/lines
-C- NEWFOR current deck generates foreign material
-C- NEWNIL current deck has f/material killed from outside
-C- NEWINC current deck calls a modified include file
-
-+KEEP, xMUSEBC.
-C-- USE and EXE bits:
-
-C- MX_FORC EXE bits for +FORCE/+SUSP (6-9 SUSP, 15-18 FORCE)
-C- MU_GLOB USE bits global
-C- MU_PAT USE bits for current patch, taken from IQ(LEXP)
-C- MU_DECK USE bits for current deck
-
-C- bits 5-1: USE bits for foreign + self
-C- 5 USE, 4 XDIV, 3 DIV, 2 LIST, 1 EXE
-C- 10-6: INHIBIT bits, =0 inhibited, =1 allowed
-C- 14-11: TRANS bits
-C- 18-15: EXE bits for self only
-
-C- blowing MU_DECK into 4 words right-justified:
-
-C- MX_FORG EXE-bits for FOREIGN+SELF material, copy of bits 1-4
-C- MU_FORG USE-bits for FOREIGN+SELF material, copy of bits 1-5
-C- MU_INH USE-bits for INHIBIT copy of bits 6-10
-C- MX_TRAN EXE-bits for TRANSmission by +USE copy of bits 11-14
-
-C- MX_SINH INHIBIT bits for self: logical AND of MU_DECK + MX_FORC
-C- MX_SELF EXE-bits for SELF-material collected from all sources
-
-C- NVEXDK() operation mode for SELF of current deck
-C- = 0/1 no/yes for processing mode :
-
-C- NVEXDK(1) EXE for self material of current deck
-C- NVEXDK(2) LIST for self material of current deck
-C- NVEXDK(3) DIVERT for self material of current deck
-C- NVEXDK(4) XDIV for self material of current deck
-C- NVEXDK(5) EXE or LIST: = NVEXDK(1) + NVEXDK(2)
-C- NVEXDK(6) FULL-list for control lines: NVEXDK(2) && option F
-
-+KEEP, xNAMEC.
-C-- Name handler controls, see doc: the name handler
-
-C- NA_OCC slot JSL of the last name in the table
-C- NA_CUT number of significant char. in P/D/Z names
-C- NA_MXSL maximum number of name slots available
-C- NA_MXTX max. number of characters for all names
-C- ie. the size of text division 5
-
-C- access to the text of the name with index IXNAME is:
-C- slot: JSL = LQLSTA(5) + IXNAME
-C- start: JTX = MLIAD(JSL)
-C- length: NCH = MLIAD(JSL+1) - JTX
-
-+KEEP, xTAGC.
-C-- Tag for next line to be printed
-
-C- LLORG the LNORG of the previous call to DPTAG
-C- LNORG the LORG of the current P/D tag to be made
-C- LLACT the LNACT of the previous call to DPTAG
-C- LNACT the ACT bank active, if not zero
-C- LALTN the value of IFALTN at the previous call to DPTAG
-C- LMODE the MODE parameter of the previous call to DPTAG
-C- NCHTAG length of the tag, = zero if none pending
-C- CHTAG the tag text
-C- CHWYL Wylbur tag printed in DPLINE if NQWYLDO non-zero:
-C- if NQWYLDO > 0: line-number constructed to here
-C- = -1: text preset by calling program,
-C- stepped to -2 after the line is printed
-C- = -2: text cleared by DPLINE before printing,
-C- stepped to -3 after the line is printed
-C- < -2: text used as is
-
-+KEEP, xTITLEC.
-C-- PAM file titles saved:
-
-C- PARAMETER (NFIMAX=100)
-
-C- NFILET number of files seen so far
-C- JTIPAM(J) slot number of the file title of PAM-file J
-
-+KEEP, xUSETTC.
-C-- PAM file title analysed into components and stored into SLERRM
-
-C- PATCHY 5.00 /72 1994/05/24 21.00 text
-C- _:.=+=.: 1_:.=+=.: 2_:.=+=.: 3_:.=+=.: 4_:.=+=.: 5_:.=
-
-C- CHTTNA(1) = name PATCHY
-C- CHTTNA(2) = version 5.00 /72
-C- CHTTNA(3) = numeric vs 50072
-C- CHTTNA(4) = primary vs 5.00
-C- CHTTNA(5) = secondary vs 72
-C- CHTTDT = date/time 1994/05/24 21.00
-
-C- NTTNA(J) number of characters in CHTTNA(J)
-C- NTTNORM standard name/vs/date/time is in SLERRM(1:NTTNORM)
-C- NTTALL complete title is in SLERRM(1:NTTALL)
-
-C- start column of fields:
-C- JTTNAM name
-C- JTTVER primary version
-C- JTTSLA the / of the secondary version
-C- JTTDAT date + time
-C- JTTCOM free comment
-
-+KEEP, xKQADR. K-adr of data structures
-
-C- PARAMETER (KQGARB=1,KQARRV=3,KQKEEP=4,KQPREP=5,KQMAIN=6,KQPAST=8)
-
-+KEEP, xPY. Hydra links and wsp
-
-C- LQGARB garbage d/s, banks in division 1 to be collected
-C- LQHOLD adr of the HOLD bank, see storage
-C- LQARRV d/s of ARRV banks, the first is the active PAM
-C- LQKEEP d/s of global sequences
-C- LQPREP d/s PREP in division 2 for doing the current deck
-
-C- LEXP the main d/s "future" PAT / DECK / ACT
-C- also: adr of the PAT bank of the current patch
-
-C- LLPAST adr of the link-bank between "future" and "past"
-
-C- LQPAST d/s "past" PAT / DECK
-C- LQUSER support links for 4 data structures for the Auxilliaries
-C- LHASM master bank for all ASM streams
-C- LRPAM last RPAM bank created: current PAM file
-C- LPAM bank to receive the parameters from c/line +PAM, ...
-C- holds also the statistics of cradle and PAM input
-C- LQINCL linear structure of INCL banks, remembering
-C- the include files generated
-C- LACRAD the ARRV bank controlling cradle input
-C- LARRV the currently active input stream, points
-C- to LACRAD during cradle input, and
-C- to LQARRV during PAM input
-
-C- LPCRA L of PAT of the last P=CRA*
-C- LDCRAB L of DECK of the blank deck of CRA*
-
-C- LEXD L of DECK of the current deck
-C- LDECO L of the ORG bank for the current deck,
-C- = 0 if not yet lifted
-
-C- LCRP L of PAT used in CREAPD
-C- LCRD L of DECK used in CREAPD
-C- LSERV L of the permanent MAT bank for temporary service
-
-C- INCRAD 0/>0 for no/yes cradle processing
-C- = 3 processing the blank deck of P=CRA*
-C- 2 processing deck CRA* of P=CRA*
-C- 1 other cradle material
-C- IFLGAR if zero: garbage collection has not yet been
-C- done for the current deck
-C- JANSW status answer between some routines
-C- IFMODIF 0/1 if no/yes +ASM, T=MODIF present in this run
-C- IFALTN non-zero only if further alternative sequence expansions
-C are being listed by Nysynopt
-C- JDKNEX DK-type of pending unit header :
-C- JDKTYP DK-type of current unit header:
-C- = 0 not a unit header
-C- 1 +DECK
-C- 2 +PATCH
-C- 3 +TITLE
-C- 4 +PAM
-C- 5 +QUIT
-C- 6 End-of-File
-C- -1 +MORE
-
-C- JSLZER slot number of the first line of the current lot
-C- of the current deck (normally there is only one
-C- lot in each deck, except after IF deselected +PAM)
-C- NSLORG = 0 normally, if not: offset for JSLORG
-C- JSLORG = JSLZER-NSLORG, slot number of the first line of
-C- the current deck for line-number printing only
-
-C- MOPTIO (1) 0/1 if A option no/yes set
-C- (2) B
-C- ...
-C- (26) Z
-C- (27) 0
-C- (28) 1
-C- (29) 2
-C- (30) 3
-C- (31) 4
-
-C- MOPTIO(33) options 1-31 packed
-C- MOPTIO(34) option code translated for the Auxiliaries
-
-C- MOPUPD = 0 not running update
-C- > 0 update mode, but not under +PAM, T=UPD.
-C- < 0 update for +PAM, T=UPDATE
-
-C- NCLASH print warnings at or above this clash level
-C- default = zero (meaning 1 in fact)
-
-C- IFLMERG != 0 if T=MERGE on the last +PAM c/l
-C- IFLDISP != 0 if T=DISPLAY on the last +PAM c/l
-
-C- NSLFRE number of free line slots
-C- NTXFRE number of TEXT characters free
-
- trigger garbage collection if not available:
-C- NVGAP(1) number of words in control division 2
-C- NVGAP(2) number of lines in text divisions 3+4
-
- parameters to control the look-ahead:
-C- NVGAP(3) maximum number of lines expected in any deck
-C- NVGAP(4) mean number of characters per line
-
-C- NVGARB(6) - unused -
-
-C- NVIMAT(1) L of the target PAT bank of the last +ADD etc
-C- if zero: implied P/D not allowed for next +ADD etc
-C- (2) L of the target DECK bank
-
-C- NVUTY(1) K-adr of PAT bank returned by CREAPD
-C- (2) K-adr of DECK bank
-
-C- LASTWK last word of working-space for MQWORK
-
-+DECK, BANK_DESC, IF=DOCUMENT, DOC_INL. Patchy bank descriptions
-+KEEP, bkYINDEX.
-C- .NYINDEX special usage of some banks
-C- ----------------------------------
-C-
-C- PAT bank linear structure supported by LQUSER(1)
-C-
-C- link 1: next
-C- status: bit 6 set if patch name quoted in IF=
-C- word 1: deck-number of the blank deck
-C- = -1 if patch not physically present
-C- 2: patch name index
-C-
-C- DECK bank linear structure supported by LQUSER(2)
-C-
-C- 2: zero (for DOMAPA)
-C- link 1: next
-C- status:
-C- word 1: deck name index
-C- 2: patch name index
-C- 3: deck-number
-C-
-C- KEEP bank linear structure supported by LQKEEP
-C-
-C- link 2: PAT or DECK bank of origin
-C- 1: next
-C- status: bit 1 set if link 2 points to a PAT bank
-C- word 1: sequence name index
-C-
-+SELF, NEWPG.
-+KEEP, bkYDIFF.
-C- .NYDIFF special usage of some banks
-C- ----------------------------------
-C-
-C- FILE bank 2 linear structures supported
-C- by LQUSER(1) for "old", LQUSER(2) for "new"
-C-
-C- 4: linear structure of PAT banks belonging
-C- 3: next !
-C- 2: matching bank in the other structure
-C- link 1: zero !
-C- status:
-C- rest like PAT bank
-C-
-C- PAT bank linear structure supported by LQ(LFILE-4)
-C-
-C- 4: linear structure of DECK banks belonging
-C- 3: FILE origin
-C- 2: matching bank in the other structure
-C- link 1: next
-C- status: bit 1 set if the DECK structure is an exact match
-C- 2 set if there are no unmatched decks left
-C- 3 set if no re-ordering needed
-C- 4 set if a deck from some other patch
-C- to be moved into this patch
-C- rest like DECK bank
-C-
-C- DECK bank linear structure supported by LQ(PAT-4)
-C-
-C- 3: PAT origin
-C- 2: matching bank in the other structure
-C- link 1: next
-C- status:
-C- word 1: JSL of the first line in memory, zero if out-of-memory
-C- 2: NSL number of lines in this deck/patch/file
-C- 3: NCH number of characters in this d/p/f
-C- 4: deck/patch/file name index
-C- 5: "old": ordinal number of the bank in its structure
-C- "new": ordinal number of the matching "old" bank
-C- 6: matching status:
-C- = 0 normal
-C- 1 new deck / patch
-C- old: 4 deck is done for DICRAD
-C- new: 4+IXP deck to be moved to here from patch IXP
-C-
-C- 7: JSL of the first line on the file, =0 is first
-C- 8: JTX of the first character on the file, =0 is first
-C-
-C- 9: normally zero
-C- "new" only: =N in the first bank of a string of N+1 banks
-C- with a contiguous match (N further banks)
-C- "old" only: -ve if the bank is a proxy for a new patch
-C-
-C- 10: = 0 normally if no duplicates, = n if n'th duplicate
-+SELF, NEWPG.
-+KEEP, bkKEEP.
-C- .KEEP bank : sequence material
-C- -----------------------------
-C-
-C- 4 : Nysynopt only: further variants of same sequence
-C- link 3 : origin pointer to ORG, deck-patch origin of this material.
-C- link 2 : linear chain of associated MAT banks
-C- link 1 : next KEEP bank
-C- status : bits 1-4: attached EXE-bits: XDIV DIV LIST EXE
-C- 5: usage processing done if set
-C- 6: all lower sequences are global and attached
-C- 7: =0 if new sequence pre-lifted not yet ready
-C- =1 completed by DOFORG
-C- 8:
-C- 9-11: ACT-type: zero
-C- 12: set if NIL sequence (i.e. deleted)
-C- Nysynopt: seq. not to be expanded
-C- 13: set if special sequence like QCARD1 etc
-C- 14: Nysynopt: seq. with T=SINGLE in the cradle
-C- 15: Nysynopt: first seq. stored for T=SINGLE
-C-
-C- 16: set if T=NOLIST
-C- 17: set if global and single line (direct substitution)
-C- 18: set if material from the cradle
-C- 19: set if APPEND done
-C-
-C- word 1 : slot-number of the first line (just after the +KEEP)
-C- 2 : number of lines supported by this bank
-C- 3 : origin line-count of first line
-C- 4 : sequence name index
-C-
-+KEEP, bkACT.
-C- .ACT bank : action control
-C- -------------------------
-C-
-C- link 3 : origin pointer to ORG, deck-patch origin of this material
-C- link 2 : linear chain of associated MAT banks
-C- link 1 : next ACT bank for this deck
-C- status : bits 1-4: attached EXE-bits: 4 XDIV 3 DIV 2 LIST 1 EXE
-C- 5-6:
-C- 7-8:
-C- 9-11: ACT-type: 0 DEL, 1 REP, 2 ADB, 3 ADD
-C- 12: set if NIL action (i.e. deleted)
-C- 13: set if clash-deselected
-C- 14-15: clash level
-C- 16:
-C- 17: (set if IF-conditional)
-C- 18: same target deck as previous action
-C- word 1 : slot-number of the control-line +REPL etc
-C- 2 : number of lines supported by this bank: =1
-C- 3 : origin line-count of the control-line
-C- 4 : action target line number:
-C- +DEL/+REPL start, +ADB it, +ADD it+1
-C- 5 : action target line number:
-C- +DEL/+REPL end, +ADB/+ADD it
-C-
-+KEEP, bkMAT.
-C- .MAT bank : foreign material continued
-C- -------------------------------------
-C-
-C- link 3 : present only if the first c/l is a delayed +KEEP, REPL, etc
-C- if present: significance as for PREP
-C- link 2 : origin pointer to ORG, deck-patch origin of this material
-C- link 1 : next MAT bank
-C- status : matching with PREP:
-C- bits 1-4: attached EXE bits
-C- 5-6: PREP status: 0 active, 1 deselected, 2 deleted
-C- 7:
-C- 8: if type is KEEP or action: set if NIL seq or action
-C- 9-14: JCTYPE of first line
-C- 15: the first line is a delayed control-line
-C- 16:
-C- 17: set if start of +IFx at basic level
-C- 18:
-C- 21-25: action level number
-C- word 1 : slot-number of first line
-C- 2 : number of lines supported by this bank
-C- 3 : origin line-count of first line of text
-C-
-+SELF, NEWPG.
-+KEEP, bkCSEQ.
-C- .XSQ bank : sequence calls ready for use
-C- ----------------------------------------
-C-
-C- link j : +ve: reference to KEEP-bank of global sequence called
-C- 0: unsatisfied sequence call
-C- -ve: reference to KEEP of non-global sequence
-C- link 2 : in MAT chain : origin pointer
-C- in PREP chain : = zero
-C- link 1 : next MAT or PREP bank
-C- status : bits 1-4: EXE bits of all ready global sequences attached
-C- 5-6: PREP status: 0 active, 1 deselected, 2 deleted
-C- 7: deleted by +DEL or +REPL action
-C- 9-14: JCTYPE: =MCCCDE or MCCSEQ if result of and
-C- containing +CDE +SEQ (in MAT and PREP)
-C- =MCCSES if result of and containing
-C- +SELF,sname (both in MAT and PREP)
-C- =MCCXSQ if follow on +ADD,Z=sname (MAT)
-C- 15: set if delayed control-line
-C- 16: set if T=PASS
-C- 17: set if all sequences attached and global
-C- 21-25: action level number
-C- word 1 : slot-number of original line +SEQ
-C- word 2 : number of lines supported, =0 if type MCCXSQ,
-C- =1 if type MCCDE or MCCSEQ
-C- =n if type MCCSES
-C- word 3 : line number of original +CDE or +SEQ or +SELF
-C- word 4 : n, number of sequences called
-C- word j : name index of sequence j-4 (j=5,...,n+4)
-C- link j-2 points to the corresponding KEEP bank
-C-
-+KEEP, bkPREP.
-C- .PREP bank : content analysis bank
-C- ----------------------------------
-C-
-C- link 3 : for +REPL etc: pointer to target deck
-C- for +KEEP: +ve: pointer to preliminary KEEP bank
-C- -ve: for T=APPEND, pointer to KEEP for the
-C- sequence to be appended to
-C- link 2 : pointer to foreign material to be inserted at this point
-C- link 1 : next
-C- status : matching with MAT
-C- bits 1-4: attached EXE bits
-C- 5-6: PREP status: 0 active, 1 deselected, 2 deleted
-C- 7: deleted by +DEL or +REPL action
-C- 8: if type is KEEP or action: set if NIL seq or action
-C- 9-14: JCTYPE of first line
-C- 15:
-C- 17: set if start of +IFx at basic level
-C- 18: if set: same target deck as previous action
-C- 21-26: data-type number if +DECK or +PATCH
-C- word 1 : slot-number of first line of text supported
-C- 2 : number of lines supported by this bank, zero if link 2 not zero
-C-
-+SELF, IF=-PCDE.
-C- Notes :
-C-
-C- For context see P=DOCUMENT
-C-
-C- About KEEP or ACT banks
-C- -----------------------
-C- NIL keep or action is a keep or an action which has been deleted either
-C- by a +DEL or +REPL action upstream, or which has been de-selected by IF=.
-C- Its bank carries the EXE-bits (processing mode selection bits) to
-C- the next true keep or to the deck addressed by the action.
-C- A NIL-bank is created only if its EXE-bits are different from those
-C- of the addressed deck; it does not support text material.
-C-
-C- About the PREP bank
-C- -------------------
-C- If link 2 is non-zero this PREP is only a sentinel pointing to the
-C- action to be inserted at this point. In this case it has no supported
-C- text, word 2 is zero, but word 1 gives the slot number of the next
-C- line for sequential search and JCTYPE on bits 9-14 of the status
-C- gives the c/c-type of this next line just after the insertion point.
-C-
-+SELF, NEWPG.
-+KEEP, bkHOLD.
-C- .HOLD bank: remaining material in memory to be done
-C- ----------------------------------------------------
-C- supporting link: LQHOLD in LQ
-C-
-C- status : bit 1 set if new instalment has been read
-C- from file to memory
-C- word 1 : slot-number of the first line of unprocessed material
-C- and of the first line of the current deck always
-C- 2 : number of lines of unprocessed material
-C- if zero: no material to be saved
-C- 3 : number of lines in current deck
-C-
-+SELF, IF=-PCDE.
-C- This bank serves also as a delimiter between the old and the new foreign
-C- material in division 1 :
-C-
-C- |----------------------------------|
-C- banks : | old banks | HOLD | new banks |
-C- |----------------------------------|
-C- |LQCSTA(1) |LQCEND(1)
-C-
-C- |----------------|--------------------------------------|
-C- text : | old material | new material | unprocessed material |
-C- |----------------|--------------------------------------|
-C- |LQLSTA(1) |LQLEND(1) |LQLEND(2)
-C- |LQLSTA(2)
-C-
-C- 'Old banks' have all their associated text material already shifted into
-C- text division 1; the text associated to 'new banks' is still resident
-C- in text division 2.
-C-
-C- Garbage collection, triggered either by 'space full' or when starting
-C- a new PAM file is initiated by calling MQSHIFT. This has these steps:
-C-
-C- 1) garbage collection (MQGARB) of material no longer needed
-C- in bank division 1, a linear structure supported by LQGARB;
-C- this will squeeze bank and text divisions 1.
-C-
-C- 2) left shift text material in text division 2 supported by 'new banks'
-C- by appending to text division 1. This requires the new banks
-C- to be in the same order as the new text material.
-C- Material in text division 2 not supported by new banks or by HOLD
-C- (normally self-material) disappears automatically.
-C-
-C- 3) reset LQLEND(1) and LQLSTA(2) to the new limit of division 1.
-C-
-C- 4) left shift the 'unprocessed material" to the start of
-C- text division 2, reset LQLEND(2).
-C-
-C- 5) drop the old HOLD bank and lift the new one at the end of
-C- bank division 1.
-C-
-+SELF, NEWPG.
-+KEEP, bkPAT.
-C- .PAT bank : support all material for this patch
-C- ----------------------------------------------
-C-
-C- link 4r: PAT, last USE or USE-inhibit for this patch from patch indicated
-C- link 3 : KEEP, patch-directed sequences for this patch
-C- link 2 : DECK, decks of this patch
-C- link 1 : PAT, next
-C-
-C- status : selection : 5 USE 4 XDIV 3 DIV 2 LIST 1 EXE
-C- bits 1-5 : for 'foreign + self', enabled if bit = 1;
-C- 6-10 : for 'inhibit', inhibited if bit = 0;
-C- 11-14 : for 'transmit via +USE', enabled if bit = 1
-C- 15-18 : for 'self only', enabled if bit = 1.
-C-
-C- word 1 : status-word extension, flags :
-C- bit 1 : patch de-selected by +PATCH,...,IF=...
-C- 2 : patch de-selected by +IMITATE,...
-C- 3 : at least 1 deck written to ASM-file
-C- (this is cleared in PEND if EXE-bit is on)
-C- 4 : partial USE by +USE,...,D=...
-C- 5 : scattered patch signalled by T=REPEAT
-C- 6 : patch quoted in IF=...
-C- 7 : set if @file patch, ie. new PAM file
-C- 8 : set if PAM file skipped
-C- 13-32 : deck-number of the blank deck
-C-
-C- word 2 : patch name index, zero if this is the bank at LLPAST
-C- -ve if this is an RPAM bank
-C-
-+KEEP, bkDECK.
-C- .DECK bank : support all material for this deck
-C- ----------------------------------------------
-C-
-C- link 4r: back-pointer to the PAT bank supporting this bank
-C- link 3 : KEEP, deck-directed sequences for this deck
-C- link 2 : ACT, actions into this deck
-C- link 1 : DECK, next
-C-
-C- status : bits 1-18 : processing-modes, U-selection, as for PAT bank
-C-
-C- word 1 : deck name index
-C-
-+KEEP, bkORG.
-C- .ORG bank : origin indication of foreign material
-C- -------------------------------------------------
-C-
-C- status : bits 1-18 : deck-number of origin deck
-C- word 1 : deck name index of origin deck
-C- word 2 : patch name index of origin patch
-C-
-+KEEP, bkINCL.
-C- .INCL bank : remember the name of one include file
-C- --------------------------------------------------
-C- linear structure supported by LQINCL
-C-
-C- status : bits 1-4 : attached EXE bits
-C- 5 : 0/1 file has not/yes been re-written
-C- word 1 : deck name index
-C-
-+SELF, NEWPG.
-+KEEP, bkARRV.
-C- .ARRV bank : currently arriving material
-C- ---------------------------------------
-C-
-C- One bank for each active multi-PAM file, and one bank for the cradle
-C-
-C- link 2 : ASAV bank, save pre-read material, = zero if none
-C- link 1 : next
-C-
-C- word 1 : LUN, logical unit number, set to = zero if the
-C- last file used through this bank has been closed
-C-
-C- word 2 : file descriptor for C input
-C- word 3 : label from +PAM, L=lab, = zero if unlabelled
-C- word 4 : name index of the path name of the attached file
-C- word 5 : Nysynopt: Wylbur line number remembered if file
-C- was halted because of call by +PAM,...,RETURN=pname
-C-
-C- word 6 : total size of the file in bytes, = zero if not known
-C-
-C- word 7 : NCHP : current file position from CITELL
-C- -ve if seek not possible (terminal, or VAX, IBM)
-C- = -1 : reading cradle from on-line user with prompt
-C- = -2 : otherwise
-C-
-C- word 8 : non-zero if EOF reached
-C-
-C- word 9 : deck position :
-C- = 0 file rewound or at EoF
-C- +ve deck-number of the last deck processed after processing
-C- was halted because of call by +PAM,...,RETURN=pname
-C- Nydiff: the file is positioned just after this line
-C-
-C- wd 10 : slot number of the current PAM file title
-C- wd 11 : name index of the current PAM file identifier
-C- wd 12 : number of lines read on this stream
-C-
-+KEEP, bkASAV.
-C- .ASAV bank : holding pre-read material of the cradle / PAM file
-C- ---------------------------------------------------------------
-C-
-C- word 1 : JSL - slot number of the first line, in text division 1
-C- word 2 : NSL - number of lines, zero if none
-C-
-+SELF, IF=-PCDE.
-C- The ARRV banks for PAM files form a linear structure supported
-C- by the link LQARRV = LQ(KQARRV); the bank for the active PAM stream
-C- is shunted to the beginning.
-C-
-C- The ARRV bank for the cradle is supported by the link LACRAD.
-C-
-C- Link LARRV points to the stream, cradle or PAM, currently under input.
-+SELF, NEWPG.
-+KEEP, bkPAM.
-C- .PAM bank : parameters from c/line +PAM and statistic
-C- ----------------------------------------------------
-C- supporting link: LPAM in LQ
-C-
-C- For: +PAM, LAB=lab, N=x,y, T=opt, RETURN=pname .fname
-C-
-C- word 1 : LUN, Fortran logical unit number
-C- if =zero: starting the very first PAM file
-C- 2 :
-C- 3 : label from L=lab
-C- 4 : number of Pam files to be skipped, default =zero
-C- 5 : number of PAM files to be read, default =999
-C- 6 : option bit mask from T=opt
-C- 7 : name index of pname from R=pname
-C- 8 : name index of fname
-C- 11 :
-C- 12 : count total no. of lines on all PAM-files
-C- 13 : count total no. of PAM files
-C- 14 : count total no. of +PAM,... lines
-C-
-+KEEP, bkRPAM.
-C- .RPAM bank : PAM-file parameters registered - 1 bank for each PAM-file
-C- ---------------------------------------------------------------------
-C-
-C- link 1 : next PAT bank
-C- status : bits 1-17 : file-number = 100*n + m
-C- n'th line +PAM,...; m'th PAM-file read
-C- word 1 : slot number of the PAM file title
-C- 2 : -ve of the name index of the PAM file ID
-C- 3 : deck number of the first deck
-C- 4 : is -1 if the PAM file has been skipped
-C-
-+SELF, IF=-PCDE.
-C- Notes :
-C-
-C- 1) The PAM-bank receives the parameters from the current c/l +PAM.
-C- It also keeps the cumulative global statistics about PAM + cradle input.
-C- There is one single stand-alone PAM-bank, supported by LPAM.
-C-
-C- 2) The RPAM bank is imbedded in the linear structure of past PAT-banks
-C- at the place where this PAM has been started reading,
-C- to allow printing of the PAM-file identifier in the final summary.
-C-
-C- 3) One RPAM bank is created for every PAM-file on a PAM big-file,
-C- even for PAMs which have been skipped.
-C- Common link LRPAM always points to the last RPAM bank created.
-C-
-+SELF, NEWPG.
-+KEEP, bkASM.
-C- .ASMH bank : support ASMT banks for all ASM streams
-C- --------------------------------------------------
-C- supporting link: LHASM in LQ
-C-
-C- link 1 : stream FORT JASM=1
-C- 2 : CC 2
-C- 3 : AS 3
-C- 4 : SHELL 4
-C- 5 : DATA 5
-C-
-C- 6 : u/type 6
-C- ...
-C- N : u/type N
-C-
-C- status : unused
-C- word 1 : = 30, LUN for output with SPLIT or MODIFY
-C-
-C-
-C- .ASMT bank : control ASM output for one data type
-C- ------------------------------------------------
-C-
-C- link 1 : ASMX bank if this logical stream is also physical
-C- 2 : ASML bank for stream :1 normal
-C- 3 : for stream :2 divert
-C- 4 : :3 extra/normal
-C- 5 : :4 extra/divert
-C-
-C- status : like ASML
-C-
-C- words 1-10: like ASML
-C-
-C-
-C- .ASML bank : control ASM output for one particular logical stream
-C- ----------------------------------------------------------------
-C-
-C- link 1 : ASMX bank if this logical stream is also physical
-C-
-C- status :
-C-
-C- word 1 : JUSE = 8*JASM + JSTR this stream is connected to (JASM,JSTR)
-C- the stream is independent only if JUSE= zero
-C- if -ve: use default connection, evaluated
-C- at the end of the blank deck of CRA*
-C-
-C- word 2 : output mode: 0 bypass
-C- 1 normal sequential
-C- 2 split mode
-C- 3 modify mode
-C-
-C- word 3 : name index of file name for T=ATTACH
-C- log file name for T=LOG
-C- 4 : name index of prefix for T=PREFIX
-C-
-C- 5 : name index of file-name extension, if non-zero
-C- 6 : name index for the routine header mask, zero if none
-C- 7 : name index of c/ch substitution string, if non-zero
-C-
-C- 8 : number of decks for this logical stream
-C- 9 : number of decks actually written for this logical stream
-C- 10 : number of lines written for this logical stream ?
-C- 11 : if non-zero: reassigned to log. stream JASM*8 + JDIV
-C-
-C-
-C- .ASMX bank : extra ASM parameters for one physical stream
-C- ----------------------------------------------------------------
-C-
-C- link 1 : unused
-C- status : unused
-C- word 1 : unused
-C- word 2 : Fortran logical unit / C file descriptor
-C- if <0: file not yet opened
-C-
-C- 3 : number of decks actually written to this physical stream
-C- 4 : number of lines written to this physical stream
-C-
-+PATCH, QCDE. Hydra CDE's
-+DECK, QCDE.
-+KEEP, QBANKS. Patchy bank parameters
- PARAMETER (NBANKS=19,JBKPAT=1, JBKDEC=2, JBKORG=3, JBKINC=4,
- + JBKHOL=5, JBKKEE=6, JBKACT=7, JBKMAT=8, JBKXSQ=9,
- + JBKPRE=10,JBKGAR=11,JBKSMH=12,JBKSMT=13,JBKSML=14,
- + JBKSMX=15,JBKARR=16,JBKASA=17,JBKPAM=18,JBKRPA=19)
- COMMON /QBANKS/MMBANK(5,NBANKS)
-+KEEP, MQCM. Memory occupation parameters
- COMMON /MQCM/ NQSYSS,NQLINK, LQCSTA(3),LQCEND(3), NQMAX
- +, LQLSTA(5),LQLEND(5), LQADR,LQADR0,NQOFFS
-+KEEP, MQCT. Memory table parameters
- COMMON /MQCT/ LQTA,LQTB,LQTE,LQMTB,LQMTE,LQMTH
- +, JQDIVG,NQRESV(3),IQPART,NQFREE(3)
-+KEEP, MQCL. NAME parameters to be packed for MQLIFT
- COMMON /MQCL/ NQLST,NQLNA,NQID,NQTY,NQLI,NQNL,NQNS,NQND
-+KEEP, MQCN. Unpacked NAME parameters
- COMMON /MQCN/ IQLST,IQLNA,IQID,IQTY,IQLI,IQNL,IQNS,IQND
- +, IQLNX,IQFOUL
-+KEEP, QCHAR. Character constants
- CHARACTER CQBLAN*128, CQEQS*128, CQCETA*32
- CHARACTER CQAPO*1, CQBSL*1, CQTAB*1
- COMMON /QCHAR/ CQBLAN, CQEQS, CQCETA, CQAPO, CQBSL, CQTAB
-+KEEP, QMACHFIX. Machine parameters
- PARAMETER (NQBITW=32, NQBITC=8, NQCHAW=4)
-+KEEP, QMACH.
-+CDE, QMACHFIX.
-+KEEP, QPAGE. Page control
- COMMON /QPAGE/ NQLMAX,NQLTOL,NQLTOK,NQCMAX,NQCPGH,NQPAGE
- +, NQWYLDO,NQWYL,NQNEWH,NQJOIN,NQDKNO,NQDKPG
-+KEEP, QSTATE. Program status parameters
- CHARACTER CQDATEM*10, CQDATE*8, CQTIME*5
- COMMON /QSTATE/NQERR,NQWARN,NQINFO,NQLOCK
- +, IQDATE,IQTIME, CQDATEM,CQDATE,CQTIME
-+KEEP, QSYSBITS.
- PARAMETER (IQDROP=31, IQMARK=30, KMDROP=1073741824)
-+KEEP, QUNIT. Logical unit numbers
- COMMON /QUNIT/ IQREAD,IQPRNT, IQTTIN,IQTYPE, IQOFFL,IQRTTY,IQRSAV
- +, IQRFD,IQRRD,IQRSIZ, NQLPAT,NQUSED,NQLLBL, NQINIT
-+KEEP, NEWLINE, IF=QNEWLINE.
- PARAMETER (NEWLN=10, NCHNEWL=1)
-+KEEP, NEWLINE.
- PARAMETER (NEWLN=10, NCHNEWL=0)
-+KEEP, NSIZEQ. Dimensions for the dynamic store
- PARAMETER (NSIZEQ=100000, NSIZELN=100000)
-+KEEP, Q. Dynamic store, full text
-+CDE, NEWLINE.
-+CDE, NSIZEQ.
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,IQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB,LQHOLD,LQARRV,LQKEEP,LQPREP
-+KEEP, QSH. Dynamic store, Hydra store only
-+CDE, NSIZEQ.
- DIMENSION LQ(NSIZEQ), IQ(NSIZEQ)
- EQUIVALENCE (LQ,IQ,LQGARB)
- COMMON // IQUEST(100),LQGARB
-+KEEP, QTX. Dynamic store, line-store only
-+CDE, NEWLINE.
-+CDE, NSIZEQ.
- PARAMETER (NSIZETX=40*NSIZELN)
- CHARACTER TEXT(NSIZETX)*1
- DIMENSION LQ(NSIZEQ), MLIAD(NSIZELN)
- EQUIVALENCE (LQ,LQGARB), (MLIAD(1),LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
- COMMON // IQUEST(100),LQGARB
-+KEEP, QUEST. Dynamic store, IQUEST only
- COMMON // IQUEST(100)
-+KEEP, SLATE.
- COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT,NUSLAT(2),DUMMY(34)
-+KEEP, MQCALL. All commons required by MQ
-+CDE, QBANKS, MQCM, MQCT, MQCN, QMACH, QSTATE, QUNIT.
-+KEEP, QBITS19. Masks for bits 1 to 19
- PARAMETER (KM1=1,KM2=2,KM3=4,KM4=8,KM5=16,KM6=32,KM7=64,KM8=128,
- + KM9=256, KM10=512, KM11=1024, KM12=2048, KM13=4096, KM14=8192,
- + KM15=16384, KM16=32768, KM17=65536, KM18=131072, KM19=262144)
-+KEEP, QBITA19. Masks for bits 1 to 19
- PARAMETER (KM1=1,KM2=2,KM3=4,KM4=8,KM5=16,KM6=32,KM7=64,KM8=128,
- + KM9=256, KM10=512, KM11=1024, KM12=2048, KM13=4096, KM14=8192,
- + KM15=16384, KM16=32768, KM17=65536, KM18=131072, KM19=262144)
- PARAMETER (KMA=1,KMB=2,KMC=4,KMD=8,KME=16,KMF=32,KMG=64,KMH=128,
- + KMI=256, KMJ=512, KMK=KM11, KML=KM12, KMM=KM13, KMN=KM14,
- + KMO=KM15, KMP=KM16, KMQ=KM17, KMR=KM18, KMS=KM19)
-+KEEP, QBITS31. Masks for bits 1 to 31
- PARAMETER (KM1=1,KM2=2,KM3=4,KM4=8,KM5=16,KM6=32,KM7=64,KM8=128,
- + KM9=256, KM10=512, KM11=1024, KM12=2048, KM13=4096, KM14=8192,
- + KM15=16384, KM16=32768, KM17=65536, KM18=131072, KM19=262144,
- + KM20=524288, KM21=1048576, KM22=2097152, KM23=4194304,
- + KM24=8388608, KM25=16777216, KM26=33554432, KM27=67108864,
- + KM28=134217728, KM29=268435456, KM30=536870912, KM31=1073741824)
-+KEEP, QBITA31. Masks for bits 1 to 31
- PARAMETER (KM1=1,KM2=2,KM3=4,KM4=8,KM5=16,KM6=32,KM7=64,KM8=128,
- + KM9=256, KM10=512, KM11=1024, KM12=2048, KM13=4096, KM14=8192,
- + KM15=16384, KM16=32768, KM17=65536, KM18=131072, KM19=262144,
- + KM20=524288, KM21=1048576, KM22=2097152, KM23=4194304,
- + KM24=8388608, KM25=16777216, KM26=33554432, KM27=67108864,
- + KM28=134217728, KM29=268435456, KM30=536870912, KM31=1073741824)
- PARAMETER (KMA=1,KMB=2,KMC=4,KMD=8,KME=16,KMF=32,KMG=64,KMH=128,
- + KMI=256, KMJ=512, KMK=KM11, KML=KM12, KMM=KM13, KMN=KM14,
- + KMO=KM15, KMP=KM16, KMQ=KM17, KMR=KM18, KMS=KM19, KMT=KM20,
- + KMU=KM21, KMV=KM22, KMW=KM23, KMX=KM24, KMY=KM25, KMZ=KM26)
-+DECK, QEXPL, IF=DOCUMENT, DOC_INL. explain the COMMON variables
-+KEEP, xQBANKS. Patchy bank parameters
-
- NBANKS=17 number of banks types known by PATCHY-HYDRA
- MMBANK(5,NBANKS) table of bank properties, look at D=MQINIT
- JBKxxx=nn index of type XXX into MMBANK
-
-+KEEP, xQCHAR. Character constants
-
- CQBLAN*128 string of all blanks
- CQEQS*128 string of all '='
- CQCETA*32 A -> Z, 0 -> 5, the CETA order
- CQAPO*1 character 'apostrophe'
- CQBSL*1 character 'back slash'
- CQTAB*1 character 'horizontal tab'
-
-+KEEP, xQMACH. Machine properties
-
- PARAMETER normally
- NQBITW=32 number of bits per word
- NQBITC=8 number of bits per character
- NQCHAW=4 number of characters per word
-
-+KEEP, xQPAGE. Page control
-
- NQLMAX number of lines per page, default = 110
- NQLTOL number of l/p/p to eject for new deck, = 103
- NQLTOK number of l/p/p to eject for new group, = 106
-
- NQCMAX number of columns accross the page, default = 120
- NQCPGH page-width to be used for the page header
- NQPAGE current global page number
- NQWYLDO Wylbur line numbers to be printed if non-zero
- if >/< 0: do yes/no print Wylbur number on current line
- NQWYL Wylbur line number of last line printed
- NQNEWH 0/1 deck header is no/yes still to be printed
- NQJOIN 0/1 no/yes T=JOIN parameter present on current +DECK
- < 0 force JOIN on next patch if on same page as current
- NQDKNO current deck number
- NQDKPG local page number for current deck
-
-+KEEP, xQSTATE. Program status parameters
-
- NQERR number of errors in current run
- NQWARN number of warnings printed
- NQINFO number of info warnings printed
- NQLOCK
- IQDATE date of start of run: integer yymmdd
- IQTIME time hhmm
- CQDATEM*10 date character yyyy/mm/dd
- CQDATE*8 date character yyyymmdd
- CQTIME*5 time hh.mm
-
-+KEEP, xQUNIT. Logical unit numbers
-
- IQREAD used Fortran LUN for cradle input
- IQPRNT used Fortran LUN for printed output
- IQTTIN Fortran LUN for what would be terminal input
- IQTYPE Fortran LUN for what would be terminal output
- IQOFFL = 0/1 the job is no/yes running off-line
- IQRTTY = 0/IQTTIN cradle input is no/yes the user's terminal
- IQRSAV Fortran LUN for what would be off-line cradle input
-
- IQRFD used C file-descriptor for cradle input (if QCIO)
- IQRRD number of lines already read by FLPARA from
- re-directed standard input (if QCIO)
- IQRSIZ if QCIO and cradle input off-line:
- = pre-known size of the cradle file, = 0 if not
-
- NQLPAT value of NQUSED after the last line +PATCH has printed
- reset to zero before start of deck, or on page eject
- NQUSED number of lines used on current page
- NQLLBL 0/1 last line printed (is not / is) a blank line
- NQINIT not zero whilst initializing, set to zero as soon
- as the ouput print file is established
-
-+KEEP, xMQCL. NAME parameters to be packed for MQLIFT
-
- NQLST status-word adr of the bank
- NQLNA name-word adr of the bank
- NQID the 4 char. bank name in Hollerith
- NQTY the bank-type id, < 64 different types of banks
- NQLI 0/1 the bank is no/yes supporting line-slots
- NQNL total number of links, < 64
- NQNS number of structural links, < 64
- NQND number of data words, < 2048
-
-+KEEP, xMQCN. Unpacked NAME parameters
-
- IQLST status-word adr of the bank
- IQLNA name-word adr of the bank
- IQID the 4 char. bank name in Hollerith
- IQTY the bank-type id, < 64 different types of banks
- IQLI 0/1 the bank is no/yes supporting line-slots
- IQNL total number of links, < 64
- IQNS number of structural links, < 64
- IQND number of data words, < 2048
- IQLNX next-word adr, = IQLST + IQND + 1
- IQFOUL = 0 bank is fine, != 0 bank chaining clobbered
-
-+KEEP, xMQCT. Memory table parameters
-
- LQTA
- LQTB
- LQTE
- LQMTB
- LQMTE
- LQMTH
- JQDIVG
- NQRESV(3)
- IQPART
- NQFREE(3)
-
-+KEEP, xMQCM. Memory occupation parameters
-
- NQSYSS number of permanent structural links
- NQLINK number of reference links
- LQCSTA(3) start adr of control divisions 1, 2, 3
- LQCEND(3) end adr of ...
- NQMAX size of the control store LQ, without MLIAD
- LQLSTA(5) start adr in MLIAD of text division 1, 2, ... 5
- LQLEND(5) end adr in ...
- LQADR = LOCF(LQ(1)
- LQADR0 = LQADR - 1
- NQOFFS = LOCF(MLIAD(1)) - LOCF(LQ(1))
-
-+KEEP, xQSYSBITS. Hydra system bits
-
- (IQDROP=31, KMDROP=1073741824) the drop bit
-
-+KEEP, xQ. Dynamic store, full text
-
- PARAMETER:
- NEWLN = 10 normally, = ICHAR(the newline character)
- NCHNEWL= 0/1 no/yes the newline is present in the TEXT store
-
- PARAMETER:
- NSIZEQ = like 100000 capacity words of store
- NSIZELN= like 100000 line slots
- NSIZETX= like 40*NSIZELN text store
-
- DIMENSION MLIAD(NSIZELN) the line-slot array
- CHARACTER TEXT(NSIZETX)*1 the text store
- DIMENSION LQ(NSIZEQ) the control store
- DIMENSION IQ(NSIZEQ)
-
- EQUIVALENCE (LQ, IQ, LQGARB)
- EQUIVALENCE (MLIAD(1), LQ(NSIZEQ))
- EQUIVALENCE (TEXT(1), MLIAD(NSIZELN))
-
- IQUEST(100) very temporary work area
- LQGARB d/s of banks to be garbage collected
- LQHOLD the current HOLD bank
- LQARRV d/s of ARRV banks
- LQKEEP d/s of global sequence definitions (KEEP banks)
- LQPREP d/s of PREP banks for the current deck
-
-+PATCH, DOCUMENT, T=DATA. Technical details
-+DECK, DU_STORE_TEXT.
-Patchy Version 5 27 July 93
-
-.Text storage
--------------
-
-All lines from cradles and Pam files go into the TEXT store:
-
- CHARACTER TEXT(sizeTX)*1
-
-The start position of each line is recorded in the line-address vector:
-
- DIMENSION MLIAD(sizeLN)
-
-Thus for the line in slot JSL the first and the last characters are:
-
- TEXT(JTXA) with JTXA = MLIAD(JSL)
- TEXT(JTXL) with JTXL = MLIAD(JSL+1) - 1
-
-This implies that line storage within one division must be dense;
-no holes are allowed between lines.
-It also implies that the end+1 address of the last line in a
-division must be recorded in MLIAD.
-
-On machines under Unix complete Pam files are transfered into TEXT
-with one single 'read' system-call, and many lines are transfered
-from TEXT to the ASM file with a single 'write'. Therefore the
-'newline' characters terminating each line are and have to be present
-in TEXT. On these machines the last true character of the line is in
-fact TEXT(JTXL-1), or more generally TEXT(JTXL-NCHNEWL), with the common
-parameter NCHNEWL being 0 or 1 depending on the machine. Similarly,
-
- +USE, QNEWLINE.
-
-selects the program version with newlines in the store.
-Since TEXT is a *1 array, handling of lines is not completely
-straightforward, access funtions GETLN and PUTLN are provided,
-and in time-critical parts of the program POINTER is used on
-those machines which have it.
-
-The MLIAD / TEXT store is divided into 5 divisions:
-
-
-| div 1 --> | div 2 -> | div 3 -> | <- div 4 | div 5 -> |
-| | | | | | |
-| | | | | | |
-| saved | PAM file | volatile | | perman. | naming |
-| foreign | being | made-up | | made-up | stack |
-| material | processed | material | | material | |
-|___________|___________|__________|____|___________|__________|
-| | | | | | |
-|LQLSTA(1) |LQLSTA(2) |LQLSTA(3) | |LQLSTA(4) |LQLSTA(5) |
- |LQLEND(1) |LQLEND(2) |LQLEND(3) |LQLEND(4) |
- LQLEND(5)
-
-Division 2 contains the PAM file (or cradle) currently being
-processed, either complete or by instalments.
-
-Division 1 contains the (foreign) material to be retained beyond
-the current PAM file, which is accumulated by a left squeeze of
-the material to be retained from division 2 just before reading
-the next PAM file (or the next instalment).
-
-Division 3 contains volatile constructed material, ie. material
-needed in the current deck which is not texto on the PAM file;
-this division is wiped clean for each new deck.
-
-Division 4 contains permanent foreign material which is not texto
-on the Pam file.
-
-Division 5 is the naming stack.
-
-The start and the end+1 addresses of the material in text division j
-is recorded in LQLSTA(j) and LQLEND(j), for example:
-
- slot JSL = LQLSTA(2) is the first line in division 2
-
- slot JSL = LQLEND(2) -1 is the last line in division 2
-
-For text division 5 this is slightly different in that LQLEND(5)
-is not the end of the occupied but of the available slots.
-
-+DECK, DU_STORE_CONTROL.
-Patchy Version 5 27 July 93
-
-.Storage of the controls
- -----------------------
-
-The significance of the information in TEXT is recorded as
-control-information in banks put into the control-store:
-
- DIMENSION LQ(sizeQ), IQ(sizeQ)
- EQUIVALENCE (LQ,IQ)
-
-This is a dynamic store managed by a tailored version of Hydra.
-It contains logical data-structures, and it is physically divided
-into 3 parts:
-
-
-| "wk. space" | division 1 --> | | div. 2 --> <-- div. 3 |
-| | | | | | |
-| | | | | | |
-| | saved | | mapping | | global |
-| links | data | material | | PREP | | material |
-| | collectable | | structure | | permanent |
-|_______________|_________________|__|_____________|__|______________|
-| | | | | | |
-| |LQCSTA(1) | |LQCSTA(2) | |LQCSTA(3) |
- |LQCEND(1) |LQCEND(2) |
- LQCEND(3)|
-
-The Hydra "working space", which is in fact fixed, has the link
-area with the links pointing into the data structures, and
-the data area with some control parameters.
-
-Division 1 contains the control-banks for patch/deck directed
-information which will be given up when used;
-garbage collection can operate only in division 1.
-
-Division 3 contains global information which has to stay in memory
-until the end of the run, but only banks without text pointers.
-
-Division 2 contains the temporary linear PREP structure into which
-the material of the current deck is mapped for processing.
-This division 2 is wiped clean without garbage collection for
-each deck.
-
-The start and the end+1 addresses of the material in division j
-is recorded in LQCSTA(j) and LQCEND(j) for the Hydra store LQ.
-
-+DECK, DU_BANKF, T=JOIN.
-Patchy Version 5 27 July 93
-
-.Patchy-HYDRA bank format
--------------------------
-
-The Hydra bank format has been changed to match the Patchy requirements.
-On the one hand all banks in Patchy are quite small, so we can save
-bits, on the other hand we need relocatable line-slot numbers.
-
-The bank at L contains the following words:
-
-
- LQ(L-NL-1) 'name' word, with controls like NL, NS, ND
- LQ(L-NL) link NL
- ... reference links (if any)
-
- LQ(L-NS) link NS
- ... structural links (if any)
- LQ(L-2) link 2
-
- LQ(L-1) link 1 'next' link
- IQ(L) status word, bits 27-32 contain NL again
- IQ(L+1) data word 1
- ...
- IQ(L+ND) data word ND
-
-
-The 'name' word contains the bank parameters packed:
-
- bits 1-6 6 bits: TY bank type, up to 63 different kinds of banks
- 7-7 1 bit: LI bank with line-slot number, =1 if yes
- 8-13 6 bits: NL total number of links, 0 < NL < 64
- 14-19 6 bits: NS number of structural links, 0 < NS < 64
- 20-30 11 bits: ND number of data words, ND < 2048
-
- 31 1 bit: bank is dead if =1
- 32 1 bit: always zero
-
-The routine QLUMP constructs the name word from its components
-given in /MQCL/;
-the routines QBLOW and QNAME unpack the name word into /MQCN/
-taking either the name-word or the status-word address.
-
-Comments
-
-1) The Patchy modification of Hydra saves one word of overhead
-by not having the Hollerith ID of the bank, and 10 bits overhead
-in the status word by reduceing the system bits.
-NS is not present, but NL is instead, the limits on the sizes
-of NL,NS,ND are much reduced.
-The drop bit is moved from the status word to the name word.
-
-2) To access the name word from the status word LST one could do
-
- LNA = LST - ISHFTR(IQ(LST),26)
-
-but calling QNAME is simpler and gives all information unpacked.
-
-3) All banks which may be dropped must have the next-link;
-banks to be dropped are shunted into the garbage data-structure
-supported by LQGARB, they must not be dropped by simply setting
-the drop bit. This limitation is imposed by the algorithm for
-garbage collection in the MLIAD and TEXT stores.
-
-4) A bank which points to material in TEXT must do so only with its
-data-word number 1 giving the line-slot number of the first line,
-data-word 2 must specify the number of lines. This is some kind
-of a link into TEXT, going via MLIAD; moreover this is a structural
-link in the sense that the material in TEXT and the associated
-slots in MLIAD are also collected if garbage collection removes
-the bank.
-Thus the relocation process has to update not only the normal
-Hydra links, but also the line-slot numbers.
-A bank so pointing to TEXT must have the LI flag
-in the name-word set to 1.
-
-+DECK, DU_RELOC, T=JOIN.
-Patchy Version 5 27 July 93
-
-.Patchy-HYDRA link relocation table
------------------------------------
-
-Garbage collection proper operates only for division 1, division 3
-has permanent material only, division 2 is only wiped.
-
-The table starts in LQ(LQTA), its last word is LQ(LQTE+2).
-Each entry of 3 words represents one group of live banks, giving the
-start and the end+1 adr of the group, as well as its relocation constant.
-The first entry at LQTA marks the non-moving material,
-the next entry at LQTB=LQTA+3 marks the first moving group.
-
- LQTA+0 start adr of non-moving group
- 1 end+1 adr
- 2 (not used)
-
- LQTB+0 start adr of group 2: first moving
- 1 end+1 adr
- 2 relocation constant
-
- LQTB+3j+0 start adr of group j+2
- 1 end+1 adr
- 2 relocation constant
-
- LQTE-3+0 start adr of last moving group
- 1 end+1 adr
- 2 relocation constant
-
- LQTE+0 start adr of the non-moving high banks
- 1 (not used)
- 2 relocation constant for LQCEND(1)
-
- Cases:
-
- 1) the first bank is dead: LQ(LQTA+1) = LQ(LQTA)
- 2) no moving group, i.e. all dead banks are together at the end:
- LQTE = LQTA +3
-
-.Patchy-HYDRA line-slot relocation table
-----------------------------------------
-
-Line-slot 1 is permanent, it belongs to nobody.
-
-
- LQTA+0 start adr of non-moving group
- 1 end+1 adr
- 2 (not used)
-
- LQTB+0 start adr of group 2: first moving
- 1 end+1 adr
- 2 relocation constant
-
- LQTB+3j+0 start adr of group j+2
- 1 end+1 adr
- 2 relocation constant
-
- LQTE-3+0 start adr of last moving group
- 1 end+1 adr
- 2 relocation constant
-
- LQTE+0 start adr of the non-moving high group
- 1 (not used)
- 2 relocation constant for LQLEND(1)
-
- Cases:
-
- 1) the first available line-slot is dead:
- LQ(LQTA) = 1
- LQ(LQTA+1) = 2
- 2) no moving group, i.e. all dead slots are together at the end:
- LQTE = LQTA +3
-
-
-+DECK, DU_MAINDS.
-Patchy version 5
-
- Patchy's main data-structure: PATch /DECK /KEEP
- ------------------------------------------------
-
-
- LEXP LQPAST
- KQMAIN LLPAST KQPAST
- | | |
- _|_______ ________ _|____ _|______
- | | | \ | | | \
- | PAT | | PAT \ | PAT | | PAT \
- | present | --> | future / --> | link | --> | past /
- |_________| |________/ |______| |_________/
- | | |
- | | R4-------> PAT USEd from
- | | __________________________
- | | | \
- | S3------> | KEEP patch-directed seqs \
- | |___________________________/
- | | |
- | | R3 ---> ORG p/d origin
- | S2 -----> MAT associated material
- S2
- |
- _|________
- | \
- | DECK \
- |___________/
- | | |
- | | R4------> back pointer to supporting PAT
- | | _________________________
- | | | \
- | S3------> | KEEP deck-directed seqs \
- | |__________________________/
- | | |
- | | R3 ---> ORG p/d origin
- | S2 -----> MAT associated material
- |
- | ____________________________
- | | \
- S2--> | ACT actions into this deck \
- |_____________________________/
-
-
- __________________________
- | \
- LQKEEP ------> | KEEP global sequences \
- KQKEEP |___________________________/
- | |
- | R3 ---> ORG p/d origin
- S2 -----> MAT associated material
-
-
-The linear structure of PAT banks is a concatenation of these separate
-parts:
-1) it starts with the PAT bank for the patch currently being processed;
- its adr is LEXP and its k-adr is KQMAIN, ie. LEXP is LQ(KQMAIN).
-2) this first bank points with link 1 to the linear structure of PAT
- banks for the patches which have been addressed in some way, but
- which have not yet been processed; its last bank is a linking
- pseudo PAT bank, adr LLPAST, whose only purpose is to connect to
- the linear structure of "past" PAT banks.
-3) the linear structure of PAT banks for the patches which have been
- processed, supported by the link LQPAST, whose k-adr is KQPAST.
- When the processing of the current patch is finished its PAT bank
- is shunted from LEXP to LQPAST, thus the order is time-reversed
- until QTOPSY is used in PEND to put it right.
-
-If a scan through the PAT structure is to look only at the "future"
-banks the program sets LQ(LLPAST-1)=0, for example when starting to
-process the next patch. If a scan has to go over all banks, past and
-future, it sets LQ(LLPAST-1)=LQPAST, for example for IF evaluation.
-+DECK, DU_NAMEH, T=JOIN.
-Patchy Version 5 26 July 93
-
-
- The Name Handler
- ----------------
-.Purpose
---------
-
-Because Patch/deck/seq etc identifiers no longer fit into 2 words
-it would be wasteful to reserve several words for the identifier
-in every Patch/Deck/Keep etc bank.
-
-Instead we accumulate a table of all names occurring during
-the run, and we store the index to the name in the table
-into 1 word in the bank which needs to hold the identifier.
-
-Having this facility we use it also to store text strings other
-than Patch/Deck/Seq names.
-
-.Storage
---------
-
-The name table resides in text division 5, starting at LQLSTA(5),
-ending on LQLEND(5).
-
-A given name is identified by its "name index" IXNAME; internal
-to the name handler the name is accessed as follows:
-
- slot: JSL = LQLSTA(5) + IXNAME
- start: JTXA = MLIAD(JSL)
- end: JTXE = MLIAD(JSL+1) - 1
-
-Thus IXNAME is in fact the ordinal number of the name in the table,
-the first name has IXNAME = 0. Code outside the name handler sees
-only the name index IXNAME, so we can relocate this division.
-
-.Occupation control
--------------------
-
-Apart from LQLSTA(5) and LQLEND(5), the name table is governed by
-the following parameters:
-
- COMMON /NAMECO/ NA_OCC, NA_CUT, NA_MXSL, NA_MXTX
-
- NA_OCC the slot number of the last name in the table
- NA_CUT the significant length of a P/D/K name
- NA_MXSL the maximum number of name slots available
- NA_MXTX the maximum number of characters available for all
- names together, ie. the size of the text division
-
-The last 3 parameters are under user control with +NAME, ... which
-can only be given in the blank deck of P=CRA*.
-
-.Name interface routines
-------------------------
-
- CALL NA_INIT first initialization
-
- CALL NA_INPY add standard names for ypatchy
-
- CALL NA_REIN relocate if and when c/l +NAME,... has been read
-
- IXNAME = NA_NEW (LINE,JL,JR) register the name
-
- given in LINE(JL:JR-1), squeezing blanks;
- only the first NA_CUT characters are significant;
- return the name index, and in NDSLAT the length
-
- IXNAME = NA_LONG (LINE) register the long text LINE
-
- like NA_NEW but without cutting the string and
- without squeezing, trailing blanks ignored
-
- IXNAME = NA_CHK (LINE,JL,JR) check existence of the name
-
- given in LINE(JL:JR-1); only the
- first NA_CUT characters are significant;
- return the name index in IXNAME,
- or IXNAME = -1 if not existing
-+SELF, NEWPG.
-
- CALL NA_GET (IXNAME, LINE, JCOL) get the name
-
- this copies the text of the name IXNAME into
- LINE starting at column JCOL, but not beyond
- the passed length of LINE; it returns:
- NDSLAT = N, the length of the text stored
- NESLAT = JE = JCOL + N, the first col. after
- NFSLAT the length of the text in the stack
-
- JTX = NA_JTX (IXNAME) returns the adr of the first char. of
-
- the name to allow direct analysis of the string
- without copying; JTX must not be remembered
- beyond the local code using it. The length
- of the string is returned in NDSLAT.
-
- JWAY = NA_DIF (IXNA,IXNB) lexically compare
-
- the names at IXNA and IXNB for sorting,
- return zero if NAMEA = NAMEB
- -1 if NAMEA < NAMEB
- +1 if NAMEA > NAMEB
-
- CALL NA_FULL error exit to be called if name-stack full
-
- CALL NA_PRIX (MSG,IXNAME) error-message printing for IXNAME
-
- CALL NA_DUMP dump the name stack, for debugging
-+PATCH, MAINPRGS, T=JOIN. dummy
-+PATCH, FLDIALG. Initial user dialog and file opening
-+KEEP, PAMPUBLIC, P=FLDIALG.
- CHARACTER MPUBLI*(*)
- PARAMETER (MPUBLI = '/cern/pro/src/car/')
-+KEEP, FLKRAC.
- PARAMETER (NSLINE=256, NSTXKR=192)
- CHARACTER IDPROG*8, LINECC*(NSLINE)
- CHARACTER CHTERM*4, TXKR*(NSTXKR), TXKEY*8, CHWORK*4
- COMMON /FLKRAC/NLCUM, JLINC,NLINT, IXHOME, JFAULT,IFLLIT
- +, IDPROG, LINECC, CHTERM, TXKR,TXKEY, CHWORK
-+DECK, FLPARA, T=JOIN.
- SUBROUTINE FLPARA (NFILEP,NAMEIP,CHTXOP)
-
-C- called from the Main programs to aquire the file names
-C. started 14-oct-91
-
-+CDE, SLATLN, SLATE, QCHAR, QSTATE, QUNIT.
-+CDE, CCPARA, LUNSLN.
-+CDE, FLINKC.
-+CDE, FLKRAC.
-
-+CDE, NCNAME.
- CHARACTER NAMEIN(14)*(NCNAME)
- CHARACTER KEYSTO(14)*8
- CHARACTER COMD*256, CHSTRM*6
-+CDE, QSH.
- +, MPROTE(1000)
- +, LUNUSE,LUNDES,LUNFLG, MUSE(200)
- +, NAMEIN, KEYSTO, COMD, CHSTRM
-C-------------- End CDE --------------------------------
- CHARACTER CHTXOP*(*), NAMEIP(NFILEP)*(NCNAME)
- PARAMETER (NWSTOR=3)
- LOGICAL DIALOG, ALSO, READY
-+SELF, IF=QS_IBMVM.
- PARAMETER (NCOST=8, NCOEX=16)
-+SELF, IF=-QS_IBMVM.
- PARAMETER (NCOST=6, NCOEX=14)
-+SELF, IF=-PY_VS5.
- CHARACTER VIDQQ*(*)
- PARAMETER (VIDQQ = '@(#)' //
-+SEQ, QFTITLCH, N=36.
- +)
-+SELF, IF=PY_VS5.
- CHARACTER VIDQQ*(48)
-+SEQ, QFHEAD . DATA VIDQQ /'@(#)?>'/
-+SELF.
-
-+SEQ, xLUNSLN, IF=DOC_INL.
-
-+SEQ, QEJECT.
-+SELF, IF=QMIBX.
- CALL ERRSET (212, 300, -1,1,1)
-+SELF.
-
- NFILE = NFILEP
- DO 12 J=1,NFILE
- NAMEIN(J) = NAMEIP(J)
- IXLUN(J) = 0
- 12 CONTINUE
- CALL CLEFT (VIDQQ,1,0)
-
- JEOP = LEN(CHTXOP)
- JA = ICNEXT (CHTXOP,1,JEOP)
- NPID = NDSLAT
- JA = NESLAT
- JAOP = ICNEXT (CHTXOP,JA,JEOP)
-
- IDPROG = CHTXOP(1:NPID)
-+SEQ, MAILME, T=PASS. Register usage at CERN
-
- COMD = IDPROG
- NCMD = NPID + 2
- COMD(NCMD:NCMD) = CQAPO
- CALL CUTOL (COMD(1:8))
- IF (COMD(1:8).NE.'nypatchy') IFLAUX= 1
-
- CCKARD = ' '
- READY = .FALSE.
- INIPRO = 0
- IFHELP = 0
- NOEJ = 0
- NREAD = 0
-
-C-- Get the home directory
-
- SLLINE = ' '
- CALL GETENVF ('HOME', SLLINE(1:128))
- N = NDSLAT
- IF (N.GT.0) THEN
- IF (SLLINE(N:N).NE.'/') THEN
- N = N + 1
- SLLINE(N:N) = '/'
- ENDIF
- ENDIF
- IXHOME = NA_LONG (SLLINE(1:N+1))
-
-C-- Is the user on-line ? Yes if IQOFFL = 0
-
- DIALOG = IQOFFL.EQ.0
-
-C-- No dialogue printing if .GO on program statement
-
- NARGS = IARGC()
- IF (NARGS.EQ.0) GO TO 17
- IF (NARGS.GE.NFILE) GO TO 16
-
- LINECC = ' '
- JARG = NARGS
- CALL GETARG (JARG,LINECC)
- NLINT = LENOCC (LINECC)
- IF (NLINT.LT.3) GO TO 17
- CHWORK = LINECC(NLINT-2:NLINT)
- IF (CHWORK(1:1).EQ.':') CHWORK(1:1)='.'
- CALL CUTOL (CHWORK)
- IF (CHWORK.NE.'.go ') GO TO 17
-
- 16 DIALOG = .FALSE.
- READY = .TRUE.
- 17 IF (DIALOG) THEN
- WRITE (IQTYPE,9001) IDPROG(1:NPID)
- IF (JAOP.LT.JEOP) WRITE (IQTYPE,9002) CHTXOP(JAOP:JEOP)
- WRITE (IQTYPE,9004) (NAMEIN(J)(9:NCOEX),J=1,NFILE)
-
- IF (NARGS.GT.0) THEN
-+SELF, IF=-QS_IBMVM.
- WRITE (IQTYPE,9006) (NAMEIN(J)(1:NCOST),J=1,NFILE)
-+SELF, IF=QS_IBMVM.
- N = MIN (7,NFILE)
- IF (N.EQ.NFILE) THEN
- WRITE (IQTYPE,9006) (NAMEIN(J)(1:NCOST),J=1,N)
- ELSE
- WRITE (IQTYPE,9007) (NAMEIN(J)(1:NCOST),J=1,N)
- ENDIF
-+SELF.
- ENDIF
- ENDIF
-
-+SELF, QFVERS . 9001 FORMAT (1X,A,' ? executing')
- 9001 FORMAT (1X,A,' executing')
-+SELF, IF=-QS_IBMVM.
- 9002 FORMAT (' Options : ',A)
- 9004 FORMAT (' Default ext. : ',12A)
- 9006 FORMAT (' Stream names : ',12A)
-+SELF, IF=QS_IBMVM.
- 9002 FORMAT (' Options : ',A)
- 9004 FORMAT (' Default ext. : ',7A,:/40X,4A)
- 9006 FORMAT (' Stream names : ',12A)
- 9007 FORMAT (' Stream names : ',7A,' ...')
-+SELF.
-+SEQ, QEJECT.
-C-------- Aquire the program parameters
-
- CHTERM = ' '
- NLCUM = 0
- IQRFD = 0
- JUREAD = 0
- JUPRNT = 0
- NFILEX = 0
- JFILE = 1
- JUSE = 1
-
-C---- Take parameters from the command line
-
- JARG = 1
- 31 IF (NLCUM.GT.0) THEN
- COMD(NCMD+1:NCMD+NLCUM) = LINECC(1:NLCUM)
- CALL CSQMBL (COMD,1,NCMD+NLCUM)
- NCMD = NDSLAT + 1
- NLCUM = 0
- ENDIF
-
- LINECC = ' '
- IF (JARG.GT.NARGS) GO TO 34
- CALL GETARG (JARG,LINECC)
- NLINT = LENOCC (LINECC)
- JARG = JARG + 1
- GO TO 38
-
-C---- Take parameters from next input line
-
- 34 IF (DIALOG) THEN
-+SELF, IF=-QS_IBMVM.
- WRITE (IQTYPE,9006) (NAMEIN(J)(1:NCOST),J=JFILE,NFILE)
-+SELF, IF=QS_IBMVM.
- N = MIN (JFILE+6,NFILE)
- IF (N.EQ.NFILE) THEN
- WRITE (IQTYPE,9006) (NAMEIN(J)(1:NCOST),J=JFILE,N)
- ELSE
- WRITE (IQTYPE,9007) (NAMEIN(J)(1:NCOST),J=JFILE,N)
- ENDIF
-+SELF.
- IF (INIPRO.EQ.0) CALL TMINIT (INIPRO)
- CALL TMPRO (' ny> ')
- ENDIF
-
- CALL TMREAD (NSLINE, LINECC, NLINT, ISTAT)
- NREAD = NREAD + 1
- IF (ISTAT.NE.0) GO TO 91
-
- 38 IF (NLINT.EQ.0) GO TO 31
-
- JLINC = 0
- IF (JFILE.GT.NFILE) GO TO 72
-
-C---- Next parameter
-
- 41 IF (JLINC.GT.NLINT) GO TO 31
- CHSTRM = NAMEIN(JFILE)(1:6)
- CHLIEX = NAMEIN(JFILE)(9:16)
- LUNUSE = ICDECI (NAMEIN(JFILE),18,19)
- LUNDES = ICDECI (NAMEIN(JFILE),22,23)
- LUNFLG = ICDECI (NAMEIN(JFILE),26,27)
- IFLSCR = 0
- IF (CHLIEX.EQ.'.scr ') IFLSCR = 7
-
- CALL FLKRAK (0,LUNDES)
- IF (JFAULT.NE.0) THEN
- WRITE (IQTYPE,9042) JFILE
- GO TO 49
- ENDIF
-
- 9042 FORMAT (' Faulty parameter',I3)
-
- IF (TXKEY(1:4).EQ.' ') GO TO 31
- IF (TXKEY(1:8).EQ.'help ') THEN
- CALL HELPPR
- GO TO 31
- ENDIF
-
- IF (LUNUSE.GE.5) GO TO 61
- GO TO (43,51,55,57), LUNUSE
-
-+SEQ, QEJECT.
-C-- Reader input
-
- 43 IF (IFHELP.NE.0) GO TO 64
- IF (TXKEY(1:4).EQ.'- ') GO TO 44
- IF (TXKEY(1:4).NE.'tty ') GO TO 45
-
- 44 TXKEY = '- '
- TXKR(1:8) = 'tty '
- IF (IQOFFL.EQ.0) THEN
- IF (INIPRO.EQ.0) CALL TMINIT (INIPRO)
- ENDIF
- IQREAD = IQTTIN
- LUNUSE = IQTTIN
- JUREAD = JUSE
- GO TO 64
-
- 45 LUNUSE = IQREAD
- IQRTTY = 0
- IF (TXKEY(1:4).EQ.'eof ') GO TO 47
- JUREAD = JUSE
- GO TO 64
-
- 47 IF (LUNFLG.EQ.0) GO TO 48
- IQREAD = 0
- LUNUSE = 0
- GO TO 64
-
- 48 WRITE (IQTYPE,9048) IDPROG(1:NPID)
- 9048 FORMAT (' ***!!! EOF not allowed with ',A)
- 49 IF (IQOFFL.NE.0) CALL EXITRC (2)
- DIALOG = .TRUE.
- JARG = NARGS + 1
- GO TO 31
-
-C-- Printer output
-
- 51 IF (TXKEY(1:4).EQ.'- ') GO TO 52
- IF (TXKEY(1:4).NE.'tty ') GO TO 54
-
- 52 TXKEY = '- '
- TXKR(1:8) = 'tty '
- IQPRNT = IQTYPE
- LUNUSE = IQTYPE
- GO TO 64
-
- 54 JUPRNT = JUSE
- JFPRNT = JFILE
- LUNUSE = IQPRNT
- GO TO 64
-
-C-- Option string
-
- 55 IF (IXFLUN.EQ.0) GO TO 57
- CALL NA_GET (IXFLUN, SLLINE,1)
- NOEJ = INDEX (SLLINE(1:NDSLAT),'+')
- IFHELP = INDEX (SLLINE(1:NDSLAT),'H')
- IF (IFHELP.EQ.0) GO TO 57
- CHTERM = '.go'
- IQREAD = 0
- JLINC = 1
- READY = .TRUE.
-
-C-- CCH - string
-
- 57 LUNUSE = 0
- GO TO 64
-
-+SEQ, QEJECT.
-C-- Normal streams
-
- 61 CONTINUE
-
-C-- set scratch file
- IF (IFLSCR.NE.0) TXKR = '-temp.scr'
-
-C-- Store usage for final processing
-
- 64 NLCUM = JLINC
- NTXT = LENOCC (TXKR)
- IXLUN(JFILE) = IXFLUN
-
- KEYSTO(JFILE) = TXKR(1:8)
- CALL UCOPY (LUNUSE,MUSE(JUSE),NWSTOR)
- JUSE = JUSE + NWSTOR
- IF (.NOT.DIALOG) GO TO 68
-
- IF (LUNUSE.EQ.0) THEN
- WRITE (IQTYPE,9085) CHSTRM,TXKR(1:NTXT)
- ELSE
- WRITE (IQTYPE,9087) JFILE,CHSTRM,TXKR(1:NTXT)
- ENDIF
-
- 68 JFILE = JFILE + 1
- IF (TXKEY(5:8).NE.' ...') NFILEX = JFILE
- IF (JFILE.LE.NFILE) GO TO 41
-
-C---- Start execution ?
-
- IF (READY) GO TO 83
- IF (NLCUM.GT.0) THEN
- COMD(NCMD+1:NCMD+NLCUM) = LINECC(1:NLCUM)
- CALL CSQMBL (COMD,1,NCMD+NLCUM)
- NCMD = NDSLAT + 1
- NLCUM = 0
- ENDIF
-
- IF (CHTERM.NE.' ') GO TO 73
- IF (JARG.LE.NARGS) THEN
- IF (JLINC.GE.NLINT) GO TO 31
- ENDIF
- 72 CALL FLKRAK (-1,11)
-
- 73 COMD(NCMD+1:NCMD+4) = '.go' // CQAPO
- NCMD = NCMD + 4
- IF (IQOFFL.EQ.0) WRITE (IQTYPE,9073) COMD(1:NCMD)
- 9073 FORMAT (/'. ',A/)
-
- IF (CHTERM(2:3).EQ.'go') GO TO 83
- CHTERM = ' '
- IF (INIPRO.EQ.0) CALL TMINIT (INIPRO)
- CALL TMPRO (' Type GO or stop ny> ')
- CALL TMREAD (4, CHTERM, NCH, ISTAT)
- IF (ISTAT.NE.0) GO TO 91
- NREAD = NREAD + 1
- CALL CUTOL (CHTERM)
- IF (CHTERM.EQ.'.go ') GO TO 83
- IF (CHTERM.NE.'go ') STOP
-
-+SEQ, QEJECT.
-C-------- Final processing, OPEN standard input/output
-
- 83 IF (JUPRNT.NE.0) THEN
- CALL UCOPY (MUSE(JUPRNT),LUNUSE,NWSTOR)
- CALL FLINK (LUNUSE, 4, IXLUN(JFPRNT), 0)
- ENDIF
-
- ALSO = .NOT.DIALOG
- IF (IQTYPE.EQ.IQPRNT) THEN
- ALSO = .FALSE.
- NOEJ = 7
- ENDIF
-
- IF (NOEJ.EQ.0) THEN
- WRITE (IQPRNT,9083) IDPROG(1:NPID)
- ELSE
- WRITE (IQPRNT,9084) IDPROG(1:NPID)
- ENDIF
- NQUSED = 3
-
- IF (ALSO) WRITE (IQTYPE,9084) IDPROG(1:NPID)
- IF (NFILEX.EQ.NFILE) NFILEX = NFILE + 1
-
- JUSE = 1
- JFILE = 1
- 84 CALL UCOPY (MUSE(JUSE),LUNUSE,NWSTOR)
- CHLIFI = ' '
- IXFLUN = IXLUN(JFILE)
- IF (IXFLUN.NE.0) THEN
- CALL NA_GET (IXFLUN, CHLIFI, 1)
- NLIFI = NDSLAT
- ELSE
- CHLIFI(1:8) = KEYSTO(JFILE)
- NLIFI = 8
- IF (JFILE.NE.NFILEX) THEN
- IF (CHLIFI(5:8).EQ.' ...') NLIFI = 4
- ENDIF
- NLIFI = LNBLNK(CHLIFI(1:NLIFI))
- ENDIF
- CHSTRM = NAMEIN(JFILE)(1:8)
- NQUSED = NQUSED + 1
-
- IF (LUNUSE.EQ.0) THEN
- WRITE (IQPRNT,9085) CHSTRM,CHLIFI(1:NLIFI)
- IF (ALSO) WRITE (IQTYPE,9085) CHSTRM,CHLIFI(1:NLIFI)
- GO TO 89
- ENDIF
-
- WRITE (IQPRNT,9087) JFILE,CHSTRM,CHLIFI(1:NLIFI)
- IF (ALSO) WRITE (IQTYPE,9087) JFILE,CHSTRM,CHLIFI(1:NLIFI)
-
-C-- handle the cradle input stream
-
- IF (JUSE.NE.JUREAD) GO TO 89
-+SELF, IF=XDEBUG, IF=XFLPARA, IF=QFIO.
- PRINT *, ' LUNUSE=',LUNUSE,' IQTTIN=',IQTTIN,' IQREAD=',IQREAD,
- + ' IQOFFL=',IQOFFL,' IQRTTY=',IQRTTY
-+SELF.
- IF (LUNUSE.NE.IQTTIN) GO TO 87
-+SELF, IF=QCIO.
-C-- get the size of the here-document
-
- IF (IQOFFL.EQ.0) GO TO 89
- CALL CITELL (IQRFD,JPOS,ISTAT)
- IF (ISTAT.NE.0) GO TO 89
- CALL CISIZE (IQRFD,IQRSIZ,ISTAT)
-
- CALL CIREW (IQRFD)
- IQRRD = NREAD
-+SELF.
- GO TO 89
-
-C-- open the file for stdin, if given
-
- 87 CALL FLINK (LUNUSE, 1, 0, LUNFLG)
- IF (IXFLUN.LT.0) THEN
- IQREAD = 0
- ELSE
- IQRFD = LUNFD
- IQRSIZ = LUNSIZ
- ENDIF
-
- 89 IF (JFILE.EQ.NFILEX) JFILE=NFILE
- JUSE = JUSE + NWSTOR
- JFILE = JFILE + 1
- IF (JFILE.LE.NFILE) GO TO 84
- IF (ALSO) WRITE (IQTYPE,9089)
- CHTERM = ' '
-
- WRITE (IQPRNT,9099) CQDATEM(3:),CQTIME
- NQUSED = NQUSED + 3
- NQLLBL = 1
- NQINIT = 0
-+SELF, IF=XDEBUG.
- PRINT *, ' IQREAD=',IQREAD, ' IQTTIN=',IQTTIN, ' IQTYPE=',IQTYPE,
- + ' IQOFFL=',IQOFFL
- PRINT *, ' IQRTTY=',IQRTTY, ' IQRSAV=',IQRSAV
- PRINT *, ' IQRFD =',IQRFD, ' NREAD =',NREAD, ' IQRSIZ=',IQRSIZ
-+SELF.
- RETURN
-
- 91 CALL P_KILLM ('FLPARA - Trouble reading stdin')
-
- 9083 FORMAT (1H1,A,' executing with files / options'/)
- 9084 FORMAT (/1X,A,' executing with files / options'/)
- 9085 FORMAT (6X,A,3X,A)
- 9087 FORMAT (I4,2X,A,3X,A)
- 9089 FORMAT (1X)
- 9099 FORMAT (/' Version: ',
-+SEQ, QFTITLCH, N=38.
- F,'.RJP, today: ',A,1X,A
-+SELF, IF=QFIO, IF=QS_UNIX.
- F/' Operating with Fortran I/O'
-+SELF.
- F/)
- END
-+SEQ, QCARDL. =====================================================
-+DECK, FLFIX, T=JOIN, IF=QS_IBMVM.
- SUBROUTINE FLFIX
-
-C- IBM: change "fn ft fm" into "fn.ft.fm" on +PAM or +ASM LINES
-C. started 26-oct-94
-
-+CDE, SLATE, CCPARA.
-C-------------- End CDE --------------------------------
-
-
- JG = ICNEXT (CCKARD,NCHCCD+1,NCHCCT)
- JE = NESLAT
- IF (JE.GE.NCHCCT) RETURN
- IF (INDEX(CCKARD(JG:JE),'.') .NE.0) RETURN
-
- CCKARD(JE:JE) = '.'
- JA = ICNEXT (CCKARD,JE+1,NCHCCT)
- JE = NESLAT
- IF (JE.GE.NCHCCT) GO TO 27
-
- CCKARD(JE:JE) = '.'
- JA = ICNEXT (CCKARD,JE+1,NCHCCT)
- JE = NESLAT
-
- 27 CALL CLEFT (CCKARD,JG,JE-1)
- NCHCCT = NESLAT -1
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, FLKRAK.
- SUBROUTINE FLKRAK (IPARA,LUNDES)
-
-C- Krack next parameter
-C- IPARA -ve : see whether .GO present
-C- 0 : called from FLPARA
-C- +ve : called from the running program
-
-C- LUNDES = 1 cradle input
-C- 2 PAM input
-C- 4 printed output
-C- 5 Fortran output
-C- 6 ASM output write-only (T=ATT)
-C- 7 ASM input-output (T=MODIF)
-C- 11 option parameter
-C- 12 control-character substitution parameter
-C. started 14-oct-91
-
-+CDE, SLATLN, SLATE, QUNIT.
-+CDE, CCPARA, FLINKC, FLKRAC.
-C-------------- End CDE --------------------------------
-
- CHARACTER TXDO*(NSTXKR)
- CHARACTER COLCC(NSLINE)*1, COLDO(NSTXKR)*1
- EQUIVALENCE (COLCC,LINECC), (COLDO,TXDO)
-
-+SEQ, PAMPUBLIC.
-
-
- TXKR = ' '
- JFAULT = 0
- IXFLUN = 0
- MODEFI = LUNDES
-
-C-- Entry from running program
-
- IF (IPARA.LE.0) GO TO 21
-+SELF, IF=QS_IBMVM.
- CALL FLFIX
-+SELF.
- LINECC = CCKARD
- JLINC = NCHCCD
- NLINT = NCHCCT
- IF (MODEFI.EQ.1) THEN
- CHLIEX = '.cra'
- ELSEIF (MODEFI.EQ.2) THEN
- CHLIEX = '.car'
- ENDIF
- GO TO 22
-
-C-- Entry from FLPARA
-
- 21 IF (CHTERM.NE.' ') GO TO 39
- NLCUM = JLINC
-
-C-- No more parameters
-
- 22 JLINC = ICNEXT (LINECC,JLINC+1,NLINT)
- IF (JLINC.GT.NLINT) GO TO 77
-
-C---- Do parameter substitution
-
- JENDU = NESLAT
- NCHU = NDSLAT
-
- CALL CENVIR (LINECC(JLINC:),NCHU, TXDO,1,NSTXKR, 1)
- NCHU = NDSLAT
- IF (NFSLAT.NE.0) GO TO 91
- TXDO(NCHU+1:NCHU+4) = ' '
-
-C---- '-' for Skip next parameter
-
- IF (COLDO(1).NE.'-') GO TO 35
- TXKR(1:1) = COLDO(1)
-
- IF (MODEFI.NE.12) GO TO 77
- IF (COLDO(2).EQ.'-') GO TO 77
- IF (COLDO(2).EQ.' ') GO TO 77
- GO TO 41
-
-+SEQ, QEJECT.
-C---- Skip Remaining parameters for ". ", ".go", ": ", ":go"
-C-- (but not "../name" or ":name")
-C-- exit for ".no"
-
-+SELF, IF=BACKCOMP.
- 35 IF (COLDO(1).NE.'.') THEN
- IF (COLDO(1).NE.':') GO TO 41
- ENDIF
-+SELF, IF=-BACKCOMP.
- 35 IF (COLDO(1).NE.'.') GO TO 41
-+SELF.
- CHWORK = TXDO(2:5)
- CALL CUTOL (CHWORK)
- IF (CHWORK.EQ.'go ') GO TO 38
- IF (CHWORK.EQ.'no ') STOP
- IF (COLDO(2).NE.' ') GO TO 41
-
- CHWORK = ' '
- 38 CHTERM = '.' // CHWORK(1:3)
- JLINC = NLCUM
- 39 TXKR(1:8) = '- ...'
- GO TO 77
-
-C------ Check special parameters
-
- 41 IFLLIT = 0
- IF (IPARA.EQ.-1) GO TO 77
- TXKR(1:NCHU) = TXDO(1:NCHU)
- TXKEY = TXKR(1:8)
- CALL CUTOL (TXKEY)
- IF (NCHU.LE.4) THEN
- IF (TXKEY(1:5).EQ.'help ') GO TO 78
- IF (TXKEY(1:5).EQ.'tty ') GO TO 78
- IF (TXKEY(1:5).EQ.'eof ') GO TO 78
- ENDIF
-
-C-- Handle literal option parameter opened by /:
-
- IF (MODEFI.LT.11) GO TO 42
- IF (TXDO(1:2).EQ.'/:') THEN
- IF (NCHU.LT.3) THEN
- TXKR(1:4) = '- '
- GO TO 76
- ENDIF
- TXKR(1:NCHU) = TXDO(3:NCHU) // ' '
- NCHU = NCHU - 2
- ENDIF
- IF (MODEFI.EQ.11) CALL CLTOU (TXKR(1:NCHU))
- NTXU = NCHU
- GO TO 69
-
-C------ Analyse file name
-
- 42 JDO = 1
- NTXU = 0
- TXKR(1:NCHU) = ' '
-
-+SELF, IF=BACKCOMP.
-C-- ignore prefix = :
-
- 43 IF (INDEX ('=:', COLDO(JDO)).NE.0) THEN
- JDO = JDO + 1
- GO TO 43
- ENDIF
-
-+SELF.
-C-- check prefix +
-
- IF (COLDO(JDO).EQ.'+') THEN
- TXKR(1:1) = COLDO(JDO)
- JDO = JDO + 1
- NTXU = 1
- ENDIF
-
-C-- check prefix /:
-
- IF (TXDO(JDO:JDO+1).EQ.'/:') THEN
- N = NCHU+1 - JDO
- IF (N.LE.2) GO TO 91
- TXKR(NTXU+1:NTXU+N) = TXDO(JDO:JDO+N-1)
- NTXU = NTXU+ N
- IFLLIT = 1
- GO TO 67
- ENDIF
-
- NTXU = MAX (NTXU,1)
-
-C-- is the file PUBLIC ?
-
- IF (TXDO(JDO:JDO+1).EQ.'_/') THEN
- N = LEN (MPUBLI)
- TXKR(NTXU+1:NTXU+N) = MPUBLI
- NTXU = NTXU + N
- JDO = JDO + 2
- GO TO 48
- ENDIF
-
-C-- does the file name start with '~/' ?
-
-C! IF (TXDO(JDO:JDO+1).EQ.'~/') THEN
-C! IF (IXHOME.GT.0) THEN
-C! CALL NA_GET (IXHOME, TXKR, NTXU+1)
-C! NTXU = NESLAT - 1
-C! JDO = JDO + 2
-C! GO TO 48
-C! ENDIF
-C! ENDIF
-
-C-- is the file-name of the old form (X)/fname ?
-
-+SELF, IF=BACKCOMP.
- IF (COLDO(JDO).NE.'(') GO TO 48
- JE = ICFIND (')', TXDO,JDO+2,NCHU)
- IF (NGSLAT.EQ.0) GO TO 48
- N = JE - JDO - 1
- SLLINE(1:N+3) = '${' // TXDO(JDO+1:JDO+N) // '}'
- N = N + 3
- CALL CENVIR (SLLINE,N, TXKR,NTXU+1,NSTXKR, 0)
- IF (NFSLAT.NE.0) GO TO 48
- NTXU = NTXU + NDSLAT
- JDO = JE + 1
-+SELF.
-C-- copy the tail
-
- 48 N = NCHU+1 - JDO
- IF (N.GT.0) THEN
- TXKR(NTXU+1:NTXU+N) = TXDO(JDO:JDO+N-1)
- NTXU = NTXU + N
- ENDIF
-
-+SELF, IF=QS_VMS.
-C-- convert VAX-style file name to Unix style
- NLIFI = NTXU - 1
- CHLIFI = TXKR(2:NTXU)
- CALL FFRVAX (CHLIFI,NLIFI)
- IF (NDSLAT.GT.0) THEN
- TXKR(2:NLIFI+1) = CHLIFI(1:NLIFI)
- NTXU = NLIFI + 1
- ELSEIF (NDSLAT.LT.0) THEN
- TXKR(2:NLIFI+3) = '/:' // CHLIFI(1:NLIFI)
- NTXU = NLIFI + 3
- IFLLIT = 1
- GO TO 67
- ENDIF
-+SELF.
-
-C---- Look for Directory and Extension
-
- JFILN = 2
- J = ICFILA ('/', TXKR,JFILN,NTXU)
- IF (NGSLAT.NE.0) THEN
- IF (J.EQ.NTXU) GO TO 66
- JFILN = J + 1
- ENDIF
-
- JEXT = ICFILA ('.', TXKR,JFILN,NTXU)
- LEXT = NTXU+1 - JEXT
- LFILN = JEXT - JFILN
-
-C-- do the File extension
-
- IF (LEXT.EQ.0) THEN
- N = LNBLNK (CHLIEX)
- IF (N.EQ.0) GO TO 66
- IF (CHLIEX(1:1).NE.'.') THEN
- NTXU = NTXU + 1
- TXKR(NTXU:NTXU) = '.'
- ENDIF
- TXKR(NTXU+1:NTXU+N) = CHLIEX(1:N)
- NTXU = NTXU + N
- ELSEIF (LEXT.EQ.1) THEN
- TXKR(NTXU:NTXU) = ' '
- NTXU = NTXU - 1
- ENDIF
-
- 66 CALL CLEFT (TXKR,2,NTXU)
- NTXU = NESLAT - 1
- 67 IF (NTXU.GE.NSLIFI-4) GO TO 91
- NLIFI = NTXU
- CHLIFI = TXKR(1:NTXU)
- 69 IXFLUN = NA_LONG (TXKR(1:NTXU))
-
-C---- Done
-
- 76 JLINC = JENDU
- 77 TXKEY = TXKR(1:8)
- RETURN
-
- 78 JLINC = JENDU
- RETURN
-
-C---- Trouble
-
- 91 JFAULT = 7
- IF (IPARA.LE.0) THEN
- IF (IQOFFL.EQ.0) RETURN
- ENDIF
-
- WRITE (IQPRNT,9092)
- IF (IQTYPE.NE.IQPRNT) WRITE (IQTYPE,9092)
- 9092 FORMAT (/' ***!!! Faulty file name syntax !!!***')
- CALL EXITRC (2)
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, FLINK.
- SUBROUTINE FLINK (LUNP, LUNDES, IXNAME, IFLMEX)
-
-C- Open file (for unit LUNP)
-C- LUNDES = 1 cradle input
-C- 2 PAM input
-C- 4 printed output
-C- 5 Fortran output
-C- 6 ASM output write-only (T=ATT)
-C- 7 ASM input-output (T=MODIF)
-C- -1 delete the file, only
-C-
-C- IXNAME = -1 use file name pointed to by IXFLUN
-C- 0 use file name as is in CHLIFI
-C- >0 use file name pointed to by IXNAME
-C-
-C- IFLMEX = 2 the input file does not need to exist
-C- 0 OPEN failure is fatal
-C-
-C- set LUNFD and the file name into /FLINKC/
-C. started 14-oct-91
-
-+CDE, SLATE, QUNIT, FLINKC.
-C-------------- End CDE --------------------------------
- EQUIVALENCE (LUN,LUNOP), (NN,NLIFI)
- DIMENSION INFO(40)
- EQUIVALENCE (INFO(1),NDSLAT)
-+SELF, IF=QS_UNIX.
- INTEGER STATF
-+SELF.
-C! LOGICAL ACCESSF
-
- CHARACTER UST*8
- CHARACTER*(*) CSOLD, CSNEW, CSAPP, CSRWR
- CHARACTER*(*) YFM, APX
- PARAMETER (YFM='FORMATTED')
- PARAMETER (APX='APPEND')
-+SELF, IF=QMAPO.
- PARAMETER (CSOLD='READONLY')
- PARAMETER (CSNEW='NEW')
- PARAMETER (CSAPP='APPEND')
- PARAMETER (CSRWR='UNKNOWN')
-+SELF, IF=QMCRU.
- PARAMETER (CSOLD='OLD')
- PARAMETER (CSNEW='NEW')
- PARAMETER (CSAPP='OLD')
- PARAMETER (CSRWR='UNKNOWN')
-+SELF, IF=QF_IBM.
- PARAMETER (CSOLD='OLD')
- PARAMETER (CSNEW='UNKNOWN')
- PARAMETER (CSAPP='UNKNOWN')
- PARAMETER (CSRWR='UNKNOWN')
-+SELF, IF=QS_IBMVM.
- CHARACTER CHEXT*8, CHDIR*8, ALTERN(4)*8, IBMLINE*(NSLIFI)
- EQUIVALENCE (CHEXT, CHLIFI(11:18)), (CHDIR, CHLIFI(20:27))
- DATA ALTERN / 'CAR', 'CRA', 'CARDS', 'CRADLE' /
-+SELF, IF=QF_DEC, QF_F2C.
- PARAMETER (CSOLD='OLD')
- PARAMETER (CSNEW='NEW')
- PARAMETER (CSAPP='UNKNOWN')
- PARAMETER (CSRWR='UNKNOWN')
-+SELF, IF=QMALT,QMCVX,QMHPX,QMIBX,QMIRT,QMSGI,QMSUN,QMUUX.
- PARAMETER (CSOLD='OLD')
- PARAMETER (CSNEW='NEW')
- PARAMETER (CSAPP='UNKNOWN')
- PARAMETER (CSRWR='UNKNOWN')
-+SELF.
- LOGICAL THERE
-
-
- LUN = LUNP
- LUNFD = LUN
- LUNSIZ = 0
- MODEFI = LUNDES
- IF (MODEFI.LT.0) MODEFI= 99
-
- CALL FLNAME (IXNAME,IFLAPP)
- IXFLUN = MAX (IXFLUN,0)
-
-+SELF, IF=-QS_UNIX.
- INQUIRE (FILE=CHLIFI(1:NN),EXIST=THERE)
-+SELF, IF=QS_UNIX.
- ISTAT = STATF (CHLIFI(1:NN),INFO)
- THERE = .FALSE.
- IF (ISTAT.EQ.0) THEN
- IF (INFO(7).NE.0) THERE = .TRUE.
- ENDIF
-+SELF.
- IF (THERE) THEN
- LUNOLD = 1
- ELSE
- LUNOLD = 0
- IFLAPP = 0
- ENDIF
-
- IF (MODEFI.GE.4) GO TO 41
-
-C----------- OPEN cradle / PAM file ------------
-
- 21 IF (LUNOLD.EQ.0) GO TO 36
-+SELF, IF=QCIO.
- CALL CIOPEN (LUNFD, 'r', CHLIFI(1:NN), ISTAT)
- IF (ISTAT.NE.0) GO TO 37
-
- CALL CISIZE (LUNFD, LUNSIZ, ISTAT)
- IF (ISTAT.NE.0) LUNSIZ= 0
- CALL CIREW (LUNFD)
-
-+SELF, IF=QFIO, IF=QMCVX.
- OPEN (LUN,FILE=CHLIFI(1:NN), STATUS=CSOLD,ERR=37,FORM=YFM,
- + READONLY)
-+SELF, IF=QFIO, IF=QS_IBMVM.
- CALL FILEINF (IRC, 'RECFM','U', 'BLKSIZE',512)
-+SELF, IF=QFIO, IF=QF_IBM.
- OPEN (LUN,FILE=CHLIFI(1:NN), STATUS=CSOLD,ERR=37,
- + ACTION='READ', FORM='UNFORMATTED')
-+SELF, IF=QFIO, IF=QMIBX.
- OPEN (LUN,FILE=CHLIFI(1:NN), STATUS=CSOLD,ERR=37,FORM=YFM,
- + ACTION='READ')
-+SELF, IF=QFIO, IF=QF_DEC.
- OPEN (LUN,FILE=CHLIFI(1:NN), STATUS=CSOLD,ERR=37,FORM=YFM,
- + RECL=512, READONLY)
-+SELF, IF=QFIO,IF=QMALT,QMAPO,QMCRU,QMHPX,QMIRT,QMSGI,QMSUN,QMUUX.
- OPEN (LUN,FILE=CHLIFI(1:NN), STATUS=CSOLD,ERR=37,FORM=YFM)
-+SELF.
- GO TO 99
-
-C---- OPEN failure
-
- 36 CONTINUE
-+SELF, IF=QS_IBMVM.
- JA = ICNTH (CHEXT,ALTERN,2)
- IF (JA.EQ.0) GO TO 37
- CHEXT = ALTERN(JA+2)
- INQUIRE (FILE=CHLIFI(1:NN),EXIST=THERE)
- IF (THERE) THEN
- LUNOLD = 1
- GO TO 21
- ENDIF
- WRITE (IQTYPE,9037) CHLIFI(1:NN)
- CHEXT = ALTERN(JA)
-+SELF.
- 37 IF (IFLMEX.EQ.2) THEN
- WRITE (IQTYPE,9037) CHLIFI(1:NN)
- GO TO 39
- ENDIF
-
- 38 WRITE (IQTYPE,9038) CHLIFI(1:NN)
-+SELF, IF=QS_UNIX.
- IF (LUNOLD.NE.0) CALL PERRORF (' System msg')
-+SELF.
- IF (NQINIT.EQ.0) THEN
- IF (IQPRNT.NE.IQTYPE) WRITE (IQPRNT,9038) CHLIFI(1:NN)
- ENDIF
- 39 IXFLUN = -1
- IF (IFLMEX.EQ.0) CALL P_KILLM ('OPEN failure')
- RETURN
-
- 9037 FORMAT (16X,'(file ',A,' does not exist)')
- 9038 FORMAT (/' ***!!! OPEN fails for file: ',A)
-
-+SEQ, QEJECT.
-C----------- OPEN output file ------------
-
-C-- MODEFI = 4 printer, 5 Fortran, 6 ASM write, 7 ASM read-write
-
- 41 IF (MODEFI.EQ.7) THEN
- IF (LUNOLD.EQ.0) MODEFI= 6
-+SELF, IF=-QS_IBMVM.
- ELSE
- IF (LUNOLD.NE.0) THEN
- IF (IFLAPP.EQ.0) CALL UNLINKF (CHLIFI(1:NN))
- ENDIF
-+SELF.
- ENDIF
- IF (MODEFI.GE.99) GO TO 99
-
-+SELF, IF=QCIO, QS_VMS.
- IF (MODEFI.EQ.7) GO TO 21
-+SELF, IF=QCIO.
- IF (MODEFI.LE.5) GO TO 51
- IF (MODEFI.EQ.7) THEN
- UST = 'r+'
- ELSEIF (IFLAPP.NE.0) THEN
- UST = 'a'
- ELSE
- UST = 'w'
- ENDIF
-
- CALL CIOPEN (LUNFD, UST(1:2), CHLIFI(1:NN), ISTAT)
- IF (ISTAT.NE.0) GO TO 37
-
- IF (MODEFI.NE.7) GO TO 99
- CALL CISIZE (LUNFD, LUNSIZ, ISTAT)
- IF (ISTAT.NE.0) LUNSIZ= 0
- CALL CIREW (LUNFD)
- GO TO 99
-+SELF.
-
-C---- Fortran OPEN for output file
-
- 51 IF (MODEFI.EQ.7) THEN
- UST = CSRWR
- ELSEIF (IFLAPP.NE.0) THEN
- UST = CSAPP
- ELSE
- UST = CSNEW
- ENDIF
-
-+SELF, IF=QMAPO.
- OPEN (LUN,FILE=CHLIFI(1:NN),STATUS=UST,ERR=38,FORM=YFM)
-+SELF, IF=QMCRU.
- IF (IFLAPP.NE.0) THEN
- OPEN (LUN,FILE=CHLIFI(1:NN),STATUS=UST,ERR=38,FORM=YFM
- +, POSITION=APX)
- ELSE
- OPEN (LUN,FILE=CHLIFI(1:NN),STATUS=UST,ERR=38,FORM=YFM)
- ENDIF
-+SELF, IF=QS_IBMVM.
- IF (IFLAPP.NE.0) GO TO 53
- CALL FILEINF (IRC, 'RECFM','U', 'BLKSIZE',512)
- OPEN (LUN,FILE=CHLIFI(1:NN),STATUS=UST,ERR=38,FORM=YFM
- +, ACTION='WRITE')
- GO TO 99
-
-C- _:.=+=.: 1_:.=+=.: 2_: 27 ch max
- 53 IBMLINE = 'FILEDEF FT00F001 DISK ' // CHLIFI(2:NN)
- + // ' (RECFM U BLKSIZE 512 DISP MOD'
-C- _:.=+=.: 1_:.=+=.: 2_:.=+=.: 3_
- CALL CSETDI (LUN,IBMLINE,11,12)
- CALL VMCMS (IBMLINE,IRC)
- IF (IRC.NE.0) GO TO 38
-
-C! OPEN (LUN,FILE=CHLIFI(1:NN),STATUS=UST,ERR=38,FORM=YFM
-C! +, ACTION='READWRITE')
-C! 54 READ (LUN,FMT='(A)',END=99)
-C! GO TO 54
- GO TO 99
-+SELF, IF=QMIRT.
- OPEN (LUN,FILE=CHLIFI(1:NN),STATUS=UST,ERR=38,FORM=YFM)
- IF (IFLAPP.EQ.0) REWIND LUN
-+SELF, IF=QF_DEC.
- IF (IFLAPP.NE.0) THEN
- OPEN (LUN,FILE=CHLIFI(1:NN),STATUS=UST,ERR=38,FORM=YFM
- +, RECL=512,ACCESS=APX)
- ELSE
- OPEN (LUN,FILE=CHLIFI(1:NN),STATUS=UST,ERR=38,FORM=YFM
- +, RECL=512)
- ENDIF
-+SELF, IF=QF_F2C.
- IF (IFLAPP.NE.0) THEN
- OPEN (LUN,FILE=CHLIFI(1:NN),STATUS=UST,ERR=38,FORM=YFM
- +, ACCESS=APX)
- ELSE
- OPEN (LUN,FILE=CHLIFI(1:NN),STATUS=UST,ERR=38,FORM=YFM)
- ENDIF
-+SELF, IF=QMALT, QMCVX, QMHPX, QMSGI, QMSUN, QMUUX.
- IF (IFLAPP.NE.0) THEN
- OPEN (LUN,FILE=CHLIFI(1:NN),STATUS=UST,ERR=38,FORM=YFM
- +, ACCESS=APX)
- ELSE
- OPEN (LUN,FILE=CHLIFI(1:NN),STATUS=UST,ERR=38,FORM=YFM)
- ENDIF
-+SELF.
- 99 RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, FLNAME.
- SUBROUTINE FLNAME (IXNAME, IFLAPP)
-
-C- Ready the file name for use in OPEN or UNLINKF
-C-
-C- IXNAME = -1 use file name pointed to by IXFLUN
-C- 0 use file name as is in CHLIFI
-C- >0 use file name pointed to by IXNAME
-C-
-C- return IFLAPP = 0/1 if no/yes append mode
-C. started 16-dec-93
-
-+CDE, SLATE, FLKRAC, FLINKC.
-C-------------- End CDE --------------------------------
-
-
- IF (IXNAME.GE.0) IXFLUN= IXNAME
- IF (IXFLUN.GT.0) THEN
- CHLIFI = ' '
- CALL NA_GET (IXFLUN, CHLIFI, 1)
- NLIFI = NDSLAT
- ENDIF
-
- IFLAG = 0
- IF (CHLIFI(1:1).EQ.' ') GO TO 23
- 21 IF (CHLIFI(1:1).EQ.'=') GO TO 22
- IF (CHLIFI(1:1).EQ.':') GO TO 22
- IF (CHLIFI(1:2).EQ.'/:') GO TO 31
- IF (CHLIFI(1:1).NE.'+') GO TO 41
- IFLAG = 1
-
- 22 CHLIFI(1:1) = ' '
- 23 CALL CLEFT (CHLIFI,1,NLIFI)
- NLIFI = NDSLAT
- GO TO 21
-
-C-- file name as is
-
- 31 CHLIFI(1:2) = ' '
- CALL CLEFT (CHLIFI,1,NLIFI)
- NLIFI = NDSLAT
-+SELF, IF=-QS_IBMVM
- GO TO 47
-
-+SELF, IF=QS_IBMVM.
- 41 CALL FTOIBM (CHLIFI,NLIFI)
-+SELF, IF=QS_UNIX.
- 41 IF (CHLIFI(1:2).EQ.'~/') THEN
- CALL NA_GET (IXHOME, TXKR, 1)
- N = NDSLAT
- TXKR(N+1:N+NLIFI-2) = CHLIFI(3:NLIFI)
- NLIFI = N + NLIFI - 2
- CHLIFI(1:NLIFI) = TXKR(1:NLIFI)
- ENDIF
-+SELF, IF=QS_VMS.
- 41 CALL FTOVAX (CHLIFI,NLIFI)
-+SELF.
- 47 IFLAPP = IFLAG
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, FLSPLIT, IF=-QS_IBMVM.
- SUBROUTINE FLSPLIT (IXFILE,IXDIR,IXFN,IXEXT)
-
-C- Split the input file name dir/fn.ext into its parts,
-C- return dir/ fn .ext as names with index IXDIR, IXFN, IXEXT
-C. started 17-apr-95
-
-+CDE, SLATE, FLINKC.
-C-------------- End CDE --------------------------------
-
-
- CALL FLNAME (IXFILE,JFN)
-+SELF, IF=QS_VMS.
- CALL FFRVAX (CHLIFI,NLIFI)
-+SELF.
-
- JSLA = ICFILA ('/', CHLIFI,1,NLIFI)
- JFN = NGSLAT + 1
-
- JDOT = ICFILA ('.', CHLIFI,JFN,NLIFI)
- IF (JDOT.LT.JFN) JDOT = NLIFI + 1
-
- IXD = 0
- IXF = 0
- IXX = 0
- IF (JFN.GE.3) IXD = NA_LONG (CHLIFI(1:JSLA))
- IF (JFN.LT.JDOT) IXF = NA_LONG (CHLIFI(JFN:JDOT-1))
- IF (JDOT.LT.NLIFI) IXX = NA_LONG (CHLIFI(JDOT:NLIFI))
- IXDIR = IXD
- IXFN = IXF
- IXEXT = IXX
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, FLJOIN, T=JOIN, IF=-QS_IBMVM.
- SUBROUTINE FLJOIN (IXDIR,IXFN,IXEXT,IXFILE)
-
-C- Compose a path name from the 3 parts, return its index
-C. started 17-may-95
-
-+CDE, SLATE, SLATLN.
-C-------------- End CDE --------------------------------
-
-
- N = 1
- IF (IXDIR.NE.0) THEN
- CALL NA_GET (IXDIR, SLLINE,1)
- N = NESLAT
- ENDIF
- IF (IXFN.NE.0) THEN
- CALL NA_GET (IXFN, SLLINE,N)
- N = NESLAT
- ENDIF
- IF (IXEXT.NE.0) THEN
- CALL NA_GET (IXEXT, SLLINE,N)
- N = NESLAT
- ENDIF
- IXFILE = NA_LONG (SLLINE(1:N-1))
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, FLSPLIT_IBM, IF=QS_IBMVM.
-+SEQ, QCARD1, R=FLSPLIT.
- SUBROUTINE FLSPLIT (IXFILE,IXDIR,IXFN,IXEXT)
-
-C- Return the parts of the input file name '/fn ext dir'
-C. started 26-apr-95
-
-+CDE, SLATE, FLINKC.
-C-------------- End CDE --------------------------------
- CHARACTER NAME*12
-
-
- CALL FLNAME (IXFILE,N)
- IXD = 0
- IXF = 0
- IXX = 0
-
- JA = ICNEXT (CHLIFI,1,NLIFI)
- NE = NESLAT
- N = NDSLAT - 1
- IF (N.LT.1) GO TO 49
- IXF = NA_LONG (CHLIFI(JA+1:JA+N))
-
- JA = ICNEXT (CHLIFI,NE,NLIFI)
- NE = NESLAT
- N = NDSLAT
- IF (N.LT.1) GO TO 49
- NAME = '.' // CHLIFI(JA:JA+N-1)
- IXX = NA_LONG (NAME(1:N+1))
-
- JA = ICNEXT (CHLIFI,NE,NLIFI)
- N = NDSLAT
- IF (N.LT.1) GO TO 49
- NAME = CHLIFI(JA:JA+N-1) // '/'
- IXD = NA_LONG (NAME(1:N+1))
-
- 49 IXDIR = IXD
- IXFN = IXF
- IXEXT = IXX
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, FLJOIN_IBM, T=JOIN, IF=QS_IBMVM.
-+SEQ, QCARD1, R=FLJOIN.
- SUBROUTINE FLJOIN (IXDIR,IXFN,IXEXT,IXFILE)
-
-C- Compose a path name from the 3 parts, return its index
-C. started 17-may-95
-
-+CDE, SLATE, SLATLN.
-C-------------- End CDE --------------------------------
-
-
- N = 1
- IF (IXDIR.NE.0) THEN
- CALL NA_GET (IXDIR, SLLINE,1)
- N = NESLAT
- ENDIF
- IF (IXFN.NE.0) THEN
- CALL NA_GET (IXFN, SLLINE,N)
- N = NESLAT
- ENDIF
- IF (IXEXT.NE.0) THEN
- CALL NA_GET (IXEXT, SLLINE,N)
- N = NESLAT
- ENDIF
- IXFILE = NA_LONG (SLLINE(1:N-1))
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, HELPPR.
- SUBROUTINE HELPPR
-
-C- Print file-name syntax
-
-+CDE, QUNIT.
-
-+SEQ, PAMPUBLIC.
-
-
- WRITE (IQTYPE,9001)
- WRITE (IQTYPE,9002) MPUBLI
- WRITE (IQTYPE,9003)
- RETURN
-
- 9001 FORMAT (/' To get program specific help you can give the H option'
- F/' in the calls to the Patchy Auxiliary programs.'
- F/' What follows concerns the parameter acquisition dialog.'/
- F/' For each remaining stream give the File-name/Option-string as'
- F/' parameter value in order. You may give 1 or more parameters'
- F/' on a line; the machine will keep displaying the remaining'
- F/' streams until its list is satisfied. The answer to the final'
- F/' confirmation query is GO, or NO to kill the run.'/
- F/' Parameters must be separated by 1 or more blanks,'
- F/' except: multiple "-" do not need imbedded blanks.' /
- F/' Special parameter values :'
- F/' - : this stream is not used / option string void,'
- F/' except READ or PRINT : assume "TTY"'
- F/' . or .go : use "-" for this and all remaining streams'
- F/' TTY : use standard input/output (only for READ+PRINT),'
- F/' EOF : void input (only for READ)'
- F/' HELP : as you guessed.' )
-
- 9002 FORMAT (/' Normal parameters values:'
- F/' File name (case-sensitive for UNIX):'
- F/' DIR/FN.EXT path name; DIR/ or .EXT may be omitted,'
- F/' a default extension is added to the'
- F/' path name unless it contains a dot.'
-+SELF, IF=-QS_IBMVM.
- F/' /:NAME use NAME exactly as typed'
-+SELF.
- F/' +DIR/FN.EXT open output file for Append'
- F/' =DIR/FN.EXT the = is ignored for back-compatibility'
- F/' :DIR/FN.EXT the : is ignored for back-compatibility'
-+SELF, IF=-QS_IBMVM.
- F/' ~/DIR/FN.EXT = $HOME/DIR/FN.EXT relative to the home dir.'
- F/' ../DIR/FN.EXT relative to the current wk directory'
- F/' _/DIR/FN.EXT = ',A,'DIR/FN.EXT public files'
-+SELF, IF=BACKCOMP.
- F/' (X)/FN.EXT = ${X}/FN.EXT env.variable for back-compat.'
-+SELF.
- F/' LNAME. Link name, no default extension added,'
- F/' terminating dot removed')
- 9003 FORMAT (
-+SELF, IF=QS_UNIX.
- F/' ${X} or $X occuring in a file name is replaced by the'
-+SELF, IF=-QS_UNIX.
- F/' ${X} occuring in a file name is replaced by the'
-+SELF.
- F/' contents of environment variable X'/
-+SELF, IF=QS_IBMVM.
- F/' for IBM VM: give Unix-like file names, like:'
- F/' X/ZEBRA.FORTRAN to mean "ZEBRA FORTRAN X"'
- F/' but ZEBRA.FORTRAN.X is also accepted'/
-+SELF, IF=QS_VMS.
- F/' on the VAX you may give Unix style file names:'
- F/' Unix: //node/log/dir/a/name.ext;v'
- F/' Vax: node::log:[dir.a]name.ext;v'/
- F/' Unix: /log/dir/a/name.ext;v also: /(dir/nm.e;v'
- F/' Vax: log:[dir.a]name.ext;v [dir]nm.e;v'/
- F/' forms like dir/name ../name ~/dir/name are also handled'/
- F/' unless given as a literal with /: Patchy will convert VAX'
- F/' names to UNIX style, be careful with unusal file names.'/
-+SELF.
- F/' Option string:'
- F/' OPT string of characters, maybe prefixed by /:'
- F/' each character selecting one option.'/)
- END
-+SEQ, QCARDL. =====================================================
-+PATCH, RUN. Running Nypatchy
-+DECK, NPATCH.
- PROGRAM NPATCH
-
-+SELF, IF=QDIAG, IF=QS_UNIX.
- EXTERNAL SEGVIOL
-+SELF.
-
-+SEQ, NCNAME.
- PARAMETER (NFILES=11)
- CHARACTER NAME(NFILES)*(NCNAME)
-
-
- DATA NAME/ 'PAM .car 9 2 0 !ff'
- +, 'FORT .f 9 6 0 !ff'
- +, 'read .cra 1 1 0 !ff'
- +, 'print .lis 2 4 0 !ff'
- +, 'CC .c 9 6 0 !ff'
- +, 'AS .s 9 6 0 !ff'
- +, 'DATA .dat 9 6 0 !ff'
- +, 'FO:2 .f 9 6 0 !ff'
- +, 'CC:2 .c 9 6 0 !ff'
- +, 'AS:2 .s 9 6 0 !ff'
- +, 'DA:2 .dat 9 6 0 !ff' /
-C- _:.=+=.:_1_:.=+=.:_2_:.=+=.:_3_:
-C- (1) (2) (3)
-
-C- (1) LUNUSE = 1 read, 2 print,
-C- 3 option, 4 cch subst, >4 file
-
-C- (2) LUNDES = 1 cradle input
-C- 2 PAM input
-C- 4 printed output
-C- 5 Fortran output
-C- 6 ASM output write-only (T=ATT)
-C- 7 ASM input-output (T=MODIF)
-C- 11 option parameter
-C- 12 control-character substitution parameter
-
-C- (3) LUNFLG = 0/>0 parameter value EOF not/yes allowed
-C- 2 the cradle file need not exist
-
-
-+SELF, IF=QMAPO.
- NAME(2)(9:12) = '.ftn'
- NAME(8)(9:12) = '.ftn'
-+SELF, IF=QS_IBMVM. for IBM VM
- NAME(2)(9:16) = '.fortran'
- NAME(4)(9:16) = '.listing'
- NAME(8)(9:16) = '.fortran'
- NAME(6)(9:16) = 'assemble'
- NAME(10)(9:16) = 'assemble'
-+SELF, IF=QS_VMS. for VAX + Alpha with VMS
- NAME(2)(9:12) = '.for'
- NAME(8)(9:12) = '.for'
- NAME(6)(9:12) = '.mar'
- NAME(10)(9:12) = '.mar'
-+SELF.
-
- CALL MQINIT
-
- CALL FLPARA (NFILES,NAME,
- + 'Nypatchy')
-
-+SELF, IF=QDIAG, IF=QS_UNIX.
- CALL SIGNALF (11, SEGVIOL, -1)
-+SELF.
- CALL PSTEER
-C! CALL NA_DUMP
-
-+SEQ, PGMSTOP, T=PASS.
- END
-+SEQ, QCARDL. =====================================================
-+DECK, PSTEER.
- SUBROUTINE PSTEER
-
-C- Running Patchy
-C. started 7-feb-92
-
-+CDE, QSTATE, Q, PY.
-C-------------- End CDE --------------------------------
-
-
- CALL PINIT (0)
-
-C-- Get the cradle into memory
-
- INCRAD = 3
- CALL ARRIVE (0)
-
-C-- Complete the initialization
-
- CALL PINIT (1)
-
-C-- Do the cradle initially
-
- CALL DOCRAD
- IF (JANSW.NE.0) GO TO 89
-
-C-- Do next PAM file
-
- 41 INCRAD = 0
- CALL DOPAM
-
-C-- Do cradle continuation
-
- INCRAD = 2
- CALL DOCRAD
- IF (JANSW.EQ.0) GO TO 41
-
- 89 IF (NQERR.NE.0) CALL PABEND
- CALL PEND
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, PINIT.
- SUBROUTINE PINIT (JSTAGE)
-
-C- Initialize PATCHY
-C. started 10-feb-92
-
-+CDE, QBANKS, QUNIT.
-+CDE, TITLEC, Q, PY.
-C-------------- End CDE --------------------------------
-
-
- IF (JSTAGE.NE.0) GO TO 31
-
-C-------- Start initialization before reading the cradle --------
-
- CALL MQWORK (LACRAD,INCRAD,LASTWK)
- NFILET = 0
-
- NVGAP(1) = 4000
- NVGAP(2) = 200
- NVGAP(3) = 5000
- NVGAP(4) = 40
-
-C-- Pre-lift the banks for I/O handling
-
- CALL MQLIFT (LACRAD, 0,7, JBKARR,3)
- CALL MQLIFT (LPAM, 0,7, JBKPAM,3)
- CALL MQLIFT (LQARRV, 0,7, JBKARR,3)
- CALL MQLIFT (LQHOLD, 0,7, JBKHOL,1)
- RETURN
-
-C-------- Finish initialization with the cradle in memory -------
-
-C-- preset options COMPACT FULL VERBOSE
-
- 31 MOPTIO(2) = 1
- MOPTIO(3) = 1
- MOPTIO(6) = 1
- IF (IQTYPE.NE.IQPRNT) MOPTIO(22)= 1
- CALL PKBYT (MOPTIO(1),MOPTIO(33),1,32,0)
-
- CALL PINIT2
-
-C-- Ready the ASM structure and connect pre-opened files
-
- CALL ASMINI
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, PINIT2.
- SUBROUTINE PINIT2
-
-C- Initialization for Nypatchy and Nysynopt
-C. split off from PINIT 19-july-95
-
-+CDE, QBITS19, QBANKS, CCTYPE, CCPARA, CHEXC.
-+CDE, MUSEBC, MQCM, Q, PY.
-C-------------- End CDE --------------------------------
- PARAMETER (IXCRA=2)
-
-+SEQ, Q_OR.
-
-
- JSLA = IQ(LQHOLD+1)
- NSLE = IQ(LQHOLD+3)
- JSLE = JSLA + NSLE
- IF (NSLE.LE.0) GO TO 41
-
-C---- +NAMES, length, slots, text
-
- CALL NEXTXX ('+NAM', JSLA,JSLE,JSLF)
- IF (JSLF.EQ.0) GO TO 34
-
- JCCTYP = MCCNAM
- CALL CCKRAK (JSLF)
- IF (JCCBAD.NE.0) CALL P_KILL ('faulty line +NAMES')
-
- CALL NA_REIN
-
-C---- +GAP, gap1, ...
-
- 34 CALL NEXTXX ('+GAP', JSLA,JSLE,JSLF)
- IF (JSLF.EQ.0) GO TO 36
-
- JCCTYP = MCCGAP
- CALL CCKRAK (JSLF)
- IF (JCCBAD.NE.0) CALL P_KILL ('faulty line +GAP')
-
- CALL VZERO (IQUEST,12)
- CALL UCOCOP (MCCPAR(JCCPN+1),IQUEST,NCCPN,1,3,1)
-
- IF (IQUEST(1).GT.0) IQUEST(1)= MAX (IQUEST(1), 1000)
- IF (IQUEST(2).GT.0) IQUEST(2)= MAX (IQUEST(2), 100)
- IF (IQUEST(3).GT.0) IQUEST(3)= MAX (IQUEST(3), 2000)
- IF (IQUEST(4).GT.0) IQUEST(4)= MAX (IQUEST(4), 20)
-
- IF (IQUEST(1).GT.0) NVGAP(1) = MIN (IQUEST(1), LQCEND(3)/10)
- IF (IQUEST(2).GT.0) NVGAP(2) = MIN (IQUEST(2), 400)
- IF (IQUEST(3).GT.0) NVGAP(3) = MIN (IQUEST(3), LQLSTA(5)/10)
- IF (IQUEST(4).GT.0) NVGAP(4) = MIN (IQUEST(4), 80)
-
-C---- +UPDATE
-
- 36 CALL NEXTXX ('+UPD', JSLA,JSLE,JSLF)
- IF (JSLF.EQ.0) GO TO 41
-
- JCCTYP = MCCUPD
- CALL CCKRAK (JSLF)
- IF (JCCBAD.NE.0) CALL P_KILL ('faulty line +UPDATE')
-
- MOPUPD = 1
-
-+SEQ, QEJECT.
-C-- USE bits for global and P=CRA* and D=blank
-
- 41 MX_FORC = KM6 + KM7 + KM8 + KM9
- MU_GLOB = MX_FORC + KM10
- MU_PAT = MU_GLOB + KM5
- MU_DECK = MU_PAT
-
- CALL MXOPER (0)
-
-C-- lift PAT and DECK banks for P=CRA*,D=blank
-
- CALL MQLIFT (LPCRA, LEXP,1, JBKPAT,3)
-
- LQ(LPCRA-4) = LPCRA
- IQ(LPCRA) = IOR (IQ(LPCRA),MU_PAT)
- IQ(LPCRA+1) = KM5
- IQ(LPCRA+2) = IXCRA
-
- CALL MQLIFT (LDCRAB, LPCRA,-2, JBKDEC,3)
- LEXD = LDCRAB
-
- LQ(LDCRAB-4) = LPCRA
- IQ(LDCRAB) = IOR (IQ(LDCRAB),MU_DECK)
-
- IXEXPAM = 0
- IXEXPAT = IXCRA
- IXEXDEC = 0
- IXEXID = IXCRA
-
-C-- lift the dummy PAT bank connecting the past to the future
-
- CALL MQLIFT (LLPAST,LEXP,-1,JBKPAT,3)
-
-C-- lift PAT bank for PY_VS5 used
-
- CALL MQLIFT (L,LEXP,-1,JBKPAT,3)
- LQ(L-4) = LPCRA
- IQ(L) = IOR (IQ(L), MU_PAT)
- IQ(L+2) = NA_LONG ('PY_VS5')
-
-C-- create the service MAT bank at LSERV
-
- CALL MQLIFT (LSERV, 0,7, JBKMAT,3)
-
-C-- Lift the preset sequence definitions
-
- CALL CRDECO
- CALL INISEQ
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, P_CRASH.
- SUBROUTINE P_CRASH (MSG)
-
-+CDE, QUNIT.
-C-------------- End CDE --------------------------------
- CHARACTER MSG*(*)
-
- IF (NQINIT.NE.0) IQPRNT= IQTYPE
- WRITE (IQTYPE,9000)
- IF (IQPRNT.NE.IQTYPE) WRITE (IQPRNT,9000)
-
- CALL P_KILL (MSG)
-
- 9000 FORMAT (/' ****!!!!! Patchy crashing on a bug !!!!!****'
- F/' please call for help: zoll at cern.ch')
- END
-+SEQ, QCARDL. =====================================================
-+DECK, P_KILLM, T=JOIN.
- SUBROUTINE P_KILLM (MSG)
-
- CHARACTER MSG*(*)
-
-+SELF, IF=QS_UNIX.
- CALL PERRORF (' Perror has')
-+SELF.
- CALL P_KILL (MSG)
- END
-+SEQ, QCARDL. =====================================================
-+DECK, P_KILL, T=JOIN.
- SUBROUTINE P_KILL (MSG)
-
-+CDE, QUNIT.
-C-------------- End CDE --------------------------------
- CHARACTER MSG*(*)
-
- IF (NQINIT.NE.0) IQPRNT= IQTYPE
- WRITE (IQTYPE,9011) MSG
- IF (IQPRNT.NE.IQTYPE) WRITE (IQPRNT,9011) MSG
-+SELF, IF=QDIAG.
- CALL TRACEQ (IQTYPE,12)
- WRITE (IQTYPE,*)
-+SELF.
- CALL EXITRC (2)
-
- 9011 FORMAT (/' ***!!! Kill the run for: ',A,' !!!***')
- END
-+SEQ, QCARDL. =====================================================
-+DECK, EXITRC, T=JOIN.
- SUBROUTINE EXITRC (INRC)
-
- JRC = INRC
-
-+SELF, IF=QS_IBMVM.
- IF (JRC.GE.2) JRC = 4
-+SELF, IF=QS_VMS.
- IF (JRC.EQ.1) THEN
- JRC = 9
- ELSEIF (JRC.GE.2) THEN
- JRC = 4
- ENDIF
-+SELF.
- CALL EXITF (JRC)
- END
-+SEQ, QCARDL. =====================================================
-+DECK, P_FATAM.
- SUBROUTINE P_FATAM (MSG)
-
- CHARACTER MSG*(*)
-
-+SELF, IF=QS_UNIX.
- CALL PERRORF ('Perror has')
-+SELF.
- CALL P_FATAL (MSG)
- END
-+SEQ, QCARDL. =====================================================
-+DECK, P_FATAL, T=JOIN.
- SUBROUTINE P_FATAL (MSG)
-
-+CDE, QUNIT.
-C-------------- End CDE --------------------------------
- CHARACTER MSG*(*)
-
- IF (NQINIT.NE.0) IQPRNT= IQTYPE
- WRITE (IQTYPE,9011) MSG
- IF (IQPRNT.NE.IQTYPE) WRITE (IQPRNT,9011) MSG
-+SELF, IF=QDIAG.
- CALL TRACEQ (IQTYPE,12)
- WRITE (IQTYPE,*)
-+SELF.
- CALL PABEND
-
- 9011 FORMAT (/' ***!!! Fatal error for ',A,' !!!***')
- END
-+SEQ, QCARDL. =====================================================
-+DECK, PABEND, T=JOIN.
- SUBROUTINE PABEND
-
-C- Nypatchy run termination with errors
-C. started 16-dec-93
-
-+CDE, QUNIT, QSTATE, LUNSLN.
-+CDE, Q, PY.
-C-------------- End CDE --------------------------------
-
-
- IF (NQINIT.NE.0) GO TO 28
- IF (IFLAUX.NE.0) GO TO 28
- IF (NQERR.EQ.0) NQERR= 1
- IF (INCRAD.NE.3) GO TO 49
-
- WRITE (IQPRNT,9011)
- IF (IQTYPE.NE.IQPRNT) WRITE (IQTYPE,9011)
- 9011 FORMAT (/' ***!!! No operation !!!***'/)
-
- 28 CALL EXITRC (2)
-
- 49 CALL PEND
- END
-+SEQ, QCARDL. =====================================================
-+DECK, PEND.
- SUBROUTINE PEND
-
-C- Print the run summary
-C. started 11-feb-92
-
-+CDE, SLATE, SLATLN, QBITS19, QPAGE, QUNIT, QSTATE.
-+CDE, MQCM, MQCN, KQADR, Q, PY.
-+CDE, CM_TYP, NAMEC.
-C-------------- End CDE --------------------------------
-
- CHARACTER LINE*128, COL(128)*1
- EQUIVALENCE (LINE,COL,SLLINE)
-
- PARAMETER (KI=21, KF=29, KT=36, KS=43, KO=51)
-
-+SEQ, Q_AND, Q_JBYT.
-
-C| Processing mode selections Other status bits for P=X
-C|
-C| U - use F - skipped by +PATCH,X,IF=...
-C| L - list M - skipped by +IMITATE,X
-C| E - exe X - at least 1 deck to ASM
-C| D - divert P - partial +USE,X,D=...
-C| X - xdivert Self + Self R - P=X,T=REPEAT
-C| Inhibit Foreign Trans only Q - quoted in IF=X
-C| ------- ------- ------ ------
-C|_:.=+=.: 1_:.=+=.: 2_:.=+=.: 3_:.=+=.: 4_:.=+=.: 5_:.=+=.: 6_:.=+=.: 7_
-C| Patch ULEDX ULEDX LEDX LEDX FMXPRQ Used from P=
-C|
-C| 0 CRA* . ULE . . LE . R CRA*
-C| P5MODEL /20 931111 21.50
-C| 0 @P5MODEL . LE . . LE .
-C| 1 *MO . ULE . . LE . CRA*
-C| 2 ACTZ . ULE . . LE . *MO
-C| 16 VCDE . ULE . . LE . Q *MO
-C| 19 ALPHA . ULE . . LE . Q *MO
-C| 23 BETA . ULE . . LE . Q ALPHA
-C| 30 CRA* . ULE . . LE . R CRA*
-C|
-C| Quoted patches not seen on the PAM files
-C|
-C| 0 NEWF . ULED . . LED . Q *MO
-C| 0 QMSUN . LE . . LE . Q
-C|
-C| Other patches not seen
-C|
-C| 0 ZLONGNAME012 U . LE . . LE . CRA*
-C| 0 ZLONGNAME01..U . LE . . LE . CRA*
-C|_:.=+=.: 1_:.=+=.: 2_:.=+=.: 3_:.=+=.: 4_:.=+=.: 5_:.=+=.: 6_:.=+=.: 7_
-+SELF, IF=QMVAX.
-C-- on the VAX: terminate the ASSEMBLE streams
-
- CALL VAXASMT
-+SELF.
-
- IF (NQERR.NE.0) MOPTIO(22)= 1
- IF (MOPTIO(22).EQ.0) GO TO 51
-
-+SEQ, QEJECT.
- IF (NQPAGE.EQ.1) THEN
- CALL DPBLAN (1)
- LINE(1:1) = ' '
- ELSE
- LINE(1:1) = '1'
- ENDIF
- WRITE (IQPRNT, 9001) LINE(1:1)
- 9001 FORMAT (A,'--------------------------------------'
- F/' Summary of patches in processing order'/
- F/' Processing mode selections',24X,'Other status bits for P=X'/
- F/' U - use ',42X,'F - skipped by +PATCH,X,IF=...'
- F/' L - list ',42X,'M - skipped by +IMITATE,X'
- F/' E - exe ',42X,'X - not +EXE but deck to ASM'
- F/' D - divert ',42X,'P - partial +USE,X,D=...'
- F/' X - xdivert',16X,'Self +',9X,'Self',8X,'R - P=X,T=REPEAT'
- F/19X,' Inhibit Foreign Trans only',7X,'Q - quoted in IF=X'
- F/19X,' ------- ------- ------ ------',
- F/8X,'Patch',6X,
- F ' ULEDX ULEDX LEDX LEDX FMXPRQ Used from P='/)
- 9000 FORMAT (A)
-
- CALL QSHUNT (KQMAIN,KQPAST)
- CALL QTOPSY (KQPAST)
- LQ(LLPAST-1) = 0
- LBK = LQPAST
- MODE = 0
-
-C------ Do one list of patch summary
-
- 21 MST = IQ(LBK)
- MW1 = IQ(LBK+1)
- IXNAME = IQ(LBK+2)
-
-+SELF, IF=QDEBUG.
- CALL QNAMEX (LBK)
- IF (IQFOUL.NE.0) THEN
- WRITE (IQPRNT,9822) LBK
- CALL P_CRASH ('trouble in PEND')
- ENDIF
- 9822 FORMAT (' ***!!! Trouble at LBK =',I9)
-+SELF.
-C-- check to be printed in secondary lists
-
- IF (MODE.NE.0) THEN
- IF (IXNAME.EQ.0) GO TO 29
- MM = IAND (MW1,KM6)
- IF (MODE.EQ.1) THEN
- IF (MM.EQ.0) THEN
- NOTHER = 7
- GO TO 29
- ENDIF
- ELSE
- IF (MM.NE.0) GO TO 29
- ENDIF
- GO TO 26
- ENDIF
-
-C---- doing the primary list
-
- IF (IXNAME.GE.0) GO TO 26
-
-C-- bank RPAM
-
- LINE(1:4) = ' '
- CALL LN_GET (MW1, LINE(2:), 40)
- N = NDSLAT + 1
- CALL CSQMBL (LINE,2,N)
- N = NESLAT - 1
- WRITE (IQPRNT,9000)
- GO TO 28
-
-C-- bank PAT
-
- 26 NDKNO = JBYT (MW1,13,20)
-
- LINE = ' '
- CALL CSETDI (NDKNO,LINE,2,7)
-
- CALL NA_GET (IXNAME,LINE(1:21),9)
- IF (NFSLAT.GT.12) LINE(20:21) = '..'
-
- LINE(28:50) = '. . . .'
-
- IF (IAND(MST,KM10) .EQ.0) COL(KI+1) = 'U'
- IF (IAND(MST,KM7) .EQ.0) COL(KI+2) = 'L'
- IF (IAND(MST,KM6) .EQ.0) COL(KI+3) = 'E'
- IF (IAND(MST,KM8) .EQ.0) COL(KI+4) = 'D'
- IF (IAND(MST,KM9) .EQ.0) COL(KI+5) = 'X'
-
- IF (IAND(MST,KM5) .NE.0) COL(KF+1) = 'U'
- IF (IAND(MST,KM2) .NE.0) COL(KF+2) = 'L'
- IF (IAND(MST,KM1) .NE.0) COL(KF+3) = 'E'
- IF (IAND(MST,KM3) .NE.0) COL(KF+4) = 'D'
- IF (IAND(MST,KM4) .NE.0) COL(KF+5) = 'X'
-
- IF (IAND(MST,KM12) .NE.0) COL(KT+2) = 'L'
- IF (IAND(MST,KM11) .NE.0) COL(KT+3) = 'E'
- IF (IAND(MST,KM13) .NE.0) COL(KT+4) = 'D'
- IF (IAND(MST,KM14) .NE.0) COL(KT+5) = 'X'
-
- IF (IAND(MST,KM16) .NE.0) COL(KS+2) = 'L'
- IF (IAND(MST,KM15) .NE.0) COL(KS+3) = 'E'
- IF (IAND(MST,KM17) .NE.0) COL(KS+4) = 'D'
- IF (IAND(MST,KM18) .NE.0) COL(KS+5) = 'X'
-
-+SEQ, QEJECT.
-
- IF (IAND(MW1,KM1) .NE.0) COL(KO+1) = 'F'
- IF (IAND(MW1,KM2) .NE.0) COL(KO+2) = 'M'
- IF (IAND(MW1,KM3) .NE.0) COL(KO+3) = 'X'
- IF (IAND(MW1,KM4) .NE.0) COL(KO+4) = 'P'
- IF (IAND(MW1,KM5) .NE.0) COL(KO+5) = 'R'
- IF (IAND(MW1,KM6) .NE.0) COL(KO+6) = 'Q'
-
-C-- add "used from"
-
- IX = LQ(LBK-4)
- IF (IX.NE.0) IX= IQ(IX+2)
- IF (IX.EQ.0) THEN
- N = LENOCC (LINE(1:60))
- ELSE
- CALL NA_GET (IX,LINE,60)
- N = NESLAT - 1
- ENDIF
-
-C-- print the line and loop
-
- 28 WRITE (IQPRNT,9000) LINE(1:N)
-
- 29 LBK = LQ(LBK-1)
- IF (LBK.NE.0) GO TO 21
-
-C-- End of the list
-
- IF (MODE.EQ.2) GO TO 39
- IF (MODE.EQ.1) GO TO 38
-
-C-- remove bank for p=PY_VS5 if not quoted
-
- IXU = NA_LONG ('PY_VS5')
- L = KQFIND (IXU,2, KQMAIN,K)
- IF (L.NE.0) THEN
- IF (IAND(IQ(L+1),KM6).EQ.0) LQ(K)= LQ(L-1)
- ENDIF
-
- IF (LEXP.EQ.LLPAST) GO TO 39
-
- WRITE (IQPRNT,9037)
- 9037 FORMAT (/' Quoted patches not seen on the PAM files'/)
-
- CALL QSORTN (2,KQMAIN)
- NOTHER = 0
- LBK = LEXP
- MODE = 1
- GO TO 21
-
- 38 IF (NOTHER.EQ.0) GO TO 39
-
- WRITE (IQPRNT,9038)
- 9038 FORMAT (/' Other patches not seen'/)
-
- LBK = LEXP
- MODE = 2
- GO TO 21
- 39 CONTINUE
-
-C------ Name stack occupation
-
- JSL = LQLSTA(5)
- JSLE = NA_OCC + 1
- JTX = MLIAD(JSL)
- JTXE = MLIAD(JSLE)
-
- NSLOCC = JSLE - JSL
- NTXOCC = JTXE - JTX
- NSLAV = LQLEND(5) - JSL
- NTXAV = NSIZETX - JTX
-
- NSLPRO = (100 * NSLOCC) / NSLAV
- NTXPRO = (100 * NTXOCC) / NTXAV
-
- WRITE (IQPRNT,9050) NA_CUT, NSLPRO,NSLAV, NTXPRO,NTXAV
- NQLLBL = 0
- 9050 FORMAT (/' Name stack:',7X,
- F 'significant name length is',I3,' characters'
- F/ 12X,I5,'% used of',I7,' name slots available'
- F/ 12X,I5,'% used of',I7,' bytes of text available')
-
-+SEQ, QEJECT.
-C------ Input summary
-
- 51 CALL DPBLAN (1)
- WRITE (IQPRNT,9051) IQ(LACRAD+12)
- 9051 FORMAT (' Read:',6X,I6,' lines from the cradle')
-
- WRITE (IQPRNT,9052) IQ(LPAM+12), IQ(LPAM+13), IQ(LPAM+14)
- 9052 FORMAT (10X,I8,' lines from',I4,' PAM files for',I3,
- F' lines +PAM')
-
-C------ ASM output summary
-
- WRITE (IQPRNT,9061)
- IF (IQTYPE.NE.IQPRNT) WRITE (IQTYPE,9061)
- 9061 FORMAT (/' Written:')
-
-C---- print all active physical streams
-
- JASM = 0
- 62 JASM = JASM + 1
- IF (JASM.GT.N_TYP) GO TO 71
- LASMT = LQ(LHASM-JASM)
- LASML = LASMT
- JDIV = 0
-
- 63 IF (IQ(LASML+1).NE.0) GO TO 69
- LXASM = LQ(LASML-1)
- MODE = IQ(LASML+2)
- NDK = IQ(LXASM+3)
- NLI = IQ(LXASM+4)
- IF (MODE.NE.3) THEN
- IF (NDK.EQ.0) GO TO 69
- ENDIF
-
- LINE = ' physical'
- CALL STRMID (JASM,JDIV,LINE,13)
- JP = MAX (NESLAT,24)
- CALL CSETDI (NDK, LINE,JP+1,JP+5)
- JP = JP + 6
- IF (MODE.EQ.0) THEN
- LINE(JP+1:JP+5) = 'decks'
- ELSEIF (MODE.EQ.1) THEN
- LINE(JP+1:JP+5) = 'units'
- ELSE
- LINE(JP+1:JP+5) = 'files'
- ENDIF
- JP = JP + 6
-
- IF (MODE.EQ.0) THEN
- LINE(JP+1:JP+8) = 'bypassed'
- JP = JP + 8
- GO TO 68
- ENDIF
-
- CALL CSETDI (NLI, LINE,JP+1,JP+6)
- JP = JP + 7
- LINE(JP+1:JP+5) = 'lines'
- JP = JP + 6
-
- IF (MODE.EQ.1) THEN
- LINE(JP+1:JP+7) = 'to file'
- JP = JP + 9
- CALL NA_GET (IQ(LASML+3), LINE,JP)
- JP = NESLAT - 1
- GO TO 68
- ENDIF
-
- IF (MODE.EQ.2) THEN
- LINE(JP+1:JP+22) = ' written in SPLIT mode'
- ELSE
- LINE(JP+1:JP+22) = 'written in MODIFY mode'
- ENDIF
- JP = JP + 22
-
- 68 WRITE (IQPRNT,9000)
- WRITE (IQPRNT,9000) LINE(1:JP)
- IF (IQTYPE.NE.IQPRNT) WRITE (IQTYPE,9000) LINE(1:JP)
-
- IF (MODE.LT.2) GO TO 69
- IXU = IQ(LASML+3)
- IF (IXU.NE.0) THEN
- CALL NA_GET (IXU,LINE,1)
- N = NDSLAT
- WRITE (IQPRNT,9067) LINE(1:N)
- ENDIF
-
- IXU = IQ(LASML+4)
- IF (IXU.NE.0) THEN
- CALL NA_GET (IXU,LINE,1)
- N = NDSLAT
- WRITE (IQPRNT,9068) LINE(1:N)
- ENDIF
-
- 9067 FORMAT (' log file name is ',A)
- 9068 FORMAT (' file name prefix: ',A)
-
- 69 IF (JDIV.EQ.4) GO TO 62
- JDIV = JDIV + 1
- LASML = LQ(LASMT-JDIV-1)
- GO TO 63
-
-+SEQ, QEJECT.
-C---- print all active logical streams
-
- 71 WRITE (IQPRNT,9000)
- JASM = 0
- 72 JASM = JASM + 1
- IF (JASM.GT.N_TYP) GO TO 81
- LASMT = LQ(LHASM-JASM)
- LASML = LASMT
- JDIV = 0
-
- 73 NDKG = IQ(LASML+8)
- NDKW = IQ(LASML+9)
- IF (NDKG.EQ.0) GO TO 79
- MUSE = IQ(LASML+1)
-
- LINE = ' logical'
- CALL STRMID (JASM,JDIV,LINE,13)
- JP = MAX (NESLAT,24)
- CALL CSETDI (NDKG, LINE,JP+1,JP+5)
- JP = JP + 6
- LINE(JP+1:JP+5) = 'decks'
- JP = JP + 6
- IF (NDKW.EQ.NDKG) GO TO 76
-
- LINE(JP+1:JP+5) = 'done,'
- JP = JP + 6
- CALL CSETDI (NDKW, LINE,JP+1,JP+5)
- JP = JP + 6
- LINE(JP+1:JP+5) = 'decks'
- JP = JP + 6
-
- 76 LINE(JP+1:JP+7) = 'written'
- JP = JP + 7
- IF (MUSE.EQ.0) GO TO 78
-
- LINE(JP+1:JP+4) = ' via'
- JP = JP + 6
-
- JASMP = MUSE / 8
- JDIVP = MOD (MUSE,8)
-
- LINE(JP:JP+15) = CH_TYP(JASMP)
- JP = LNBLNK (LINE(1:JP+15)) + 1
- LINE(JP:JP) = ':'
- JP = JP + 1
- CALL CSETDI (JDIVP, LINE,JP,JP)
-
- 78 WRITE (IQPRNT,9000) LINE(1:JP)
-
- 79 IF (JDIV.EQ.4) GO TO 72
- JDIV = JDIV + 1
- LASML = LQ(LASMT-JDIV-1)
- GO TO 73
-
-C---- Print number of warnings and errors
-
- 81 IF (NQERR+NQWARN.EQ.0) THEN
- WRITE (IQPRNT,9081)
- ELSE
- IF (NQERR.EQ.0) THEN
- WRITE (IQPRNT,9082) NQWARN
- IF (IQTYPE.NE.IQPRNT) WRITE (IQTYPE,9082) NQWARN
- ELSE
- WRITE (IQPRNT,9082) NQWARN,NQERR
- IF (IQTYPE.NE.IQPRNT) WRITE (IQTYPE,9082) NQWARN,NQERR
- ENDIF
- ENDIF
-
-+SELF, IF=XDEBUG, IF=XDDSNAP.
- CALL DDSNAP ('PEND',0,1)
- CALL DDSNAP ('PEND',0,3)
-+SELF, IF=XDEBUG, IF=XNAMES.
- CALL NA_DUMP
-+SELF.
-
- IF (NQERR.EQ.0) RETURN
-
- CALL EXITRC (2)
-
- 9081 FORMAT (/' No errors, no warnings.'/)
- 9082 FORMAT (/' **!!', I5,' warnings !!**'/
- F :,' ***!!!',I4,' errors !!!***'/)
- END
-+SEQ, QCARDL. =====================================================
-+DECK, DOCRAD.
- SUBROUTINE DOCRAD
-
-C- Process the cradle
-C. started 27-feb-92
-
-+CDE, QBITS19, QBANKS, QPAGE.
-+CDE, ARRCOM, CCTYPE, CCPARA, CHEXC, DEPCOM, MUSEBC.
-+CDE, MQCM, Q, PY.
-C-------------- End CDE --------------------------------
- PARAMETER (IXCRA=2)
- CHARACTER MARK*4
-
-+SEQ, Q_AND.
-
-
- LARRV = LACRAD
- JREADY = 1
- NSLORG = 1
- NDKOFF = 0
- JD_DTP = 1
- JD_DTN = 0
- JD_NEW = 1
- IFLMERG = 0
- IFLDISP = 0
- IXEXPAM = 0
- IF (INCRAD.EQ.3) GO TO 31
-
-C------ Restart the cradle after having read a PAM file
-
- CALL VZERO (IQ(LQHOLD+1),3)
- CALL ARRIVE (1)
- IF (JDKTYP.EQ.2) GO TO 27
-
-C-- lift PAT bank for P=CRA*
-
- 24 CALL CREAPD (IXCRA,-1,1)
- CALL SBYT (NQDKNO, IQ(LEXP+1),13,20)
- LPCRA = LEXP
- 25 LEXD = 0
- MU_PAT = IAND (IQ(LEXP), KM19-1)
- MU_DECK = MU_PAT
- CALL MXOPER (0)
-
- IXEXPAT = IXCRA
- IXEXDEC = IXCRA
- IXEXID = IXCRA
- LDECO = 0
- NQNEWH = 1
- NQJOIN = -1
- NSLORG = 1
- INCRAD = 2
-
-+SEQ, QEJECT.
-
- 27 IF (JDKTYP.GE.6) GO TO 79
- IF (JDKTYP.GE.4) GO TO 42
- IF (JDKTYP.EQ.0) GO TO 29
- INCRAD = 1
- JREADY = 0
- NSLORG = 0
- NDKOFF = 0
- IF (JDKTYP.GE.2) GO TO 34
- GO TO 31
-
-C-- Do next deck
-
- 29 NQDKNO = NQDKNO - NDKOFF
- JREADY = 1
-
- 31 JDKTYP = 1
- CALL DODECK (JREADY)
- GO TO 37
-
-C-- do next patch
-
- 34 INCRAD = 1
- IF (JDKTYP.EQ.2) THEN
- CALL DOPAT
- ELSE
-
-C-- skip for +TITLE
-
- JDKTYP = 2
- CALL ARRSKP
- ENDIF
-
- 37 IF (JDKTYP.GE.6) GO TO 79
- IF (JDKTYP.LE.3) GO TO 34
-
-C---- Handle +PAM or +QUIT
-
- NSLORG = IQ(LQHOLD+1) - JSLORG
- NDKOFF = 1
-
- 42 JSLCRA = IQ(LQHOLD+1)
- NSLCRA = IQ(LQHOLD+2)
- JTXCRA = MLIAD(JSLCRA)
- NTX = MLIAD(JSLCRA+1) - JTXCRA - NCHNEWL
- JCCTYP = JPTYPE (TEXT(JTXCRA))
-
- CALL CCKRAK (JSLCRA)
- IF (JCCBAD.NE.0) THEN
- MARK = ' *! '
- GO TO 44
- ENDIF
-
- CALL CCPROC
- IF (JCCIFV.EQ.0) THEN
- MARK = ' + '
- ELSE
- MARK = ' ( '
- ENDIF
-
-C-- print the c/line
-
- 44 IF (INCRAD.GE.2) THEN
- LINUM = NSLORG
- ELSE
- LINUM = 1
- ENDIF
-
- CALL DPBLAN (1)
- CALL DPLINE (LINUM,MARK,NTX,TEXT(JTXCRA))
-
-C-- exit if faulty c/line
-
- IF (JCCBAD.NE.0) GO TO 91
-
-C-- continue deck if IF deselected c/line
-
- IF (JCCIFV.EQ.0) GO TO 61
- IQ(LQHOLD+1) = IQ(LQHOLD+1) + 1
- IQ(LQHOLD+2) = IQ(LQHOLD+2) - 1
- NSLORG = NSLORG + 1
-
- IF (IQ(LQHOLD+2).EQ.0) THEN
- CALL ARRIVE (1)
- ELSE
- CALL ARRNXD (-1)
- ENDIF
-
- IF (INCRAD.GE.2) GO TO 27
- IF (JDKTYP.GE.1) GO TO 27
- NDKOFF = 0
- IF (IXEXPAT.NE.IXCRA) GO TO 24
- GO TO 25
-
-+SEQ, QEJECT.
-C------ Accepted control line +PAM or +QUIT
-
- 61 IF (JCCTYP.EQ.MCCQUI) GO TO 79
- NSLORG = 0
-
-C-- Digest the +PAM parameters to bank at LPAM
-
- CALL DOAPAM
- IF (JCCBAD.NE.0) GO TO 91
-
-C-- Save cradle material after +PAM, ...
-
- JSLCRA = JSLCRA + 1
- NSLCRA = NSLCRA - 1
- IF (NSLCRA.EQ.0) GO TO 77
-
-+SELF, IF=QCIO.
- IF (IQ(LARRV+7).LT.0) GO TO 76
- JSLE = JSLCRA + NSLCRA
- CALL NEXTDE (JSLCRA,JSLE,JSLF,JTYP,-2)
- IF (JTYP.EQ.0) GO TO 76
-
-C-- reposition the cradle file to the start of next deck
-
- IN_DOX = 1
- IN_DO1 = JSLF
- CALL ARRIN
-
- NSLCRA = JSLF - JSLCRA
- IF (NSLCRA.EQ.0) GO TO 77
-+SELF.
- 76 CALL MQLIFT (LASAV, LACRAD,-2, JBKASA,1)
- IQ(LASAV+1) = JSLCRA
- IQ(LASAV+2) = NSLCRA
-+SELF, IF=XDEBUG, IF=XSAVE.
- CALL DUMPSL (JSLCRA,NSLCRA,'being connected to ASAV bank')
-+SELF.
- 77 IQ(LQHOLD+2) = 0
- IQ(LPAM+14) = IQ(LPAM+14) + 1
- JANSW = 0
- RETURN
-
-C-- +QUIT or EOF reached
-
- 79 JANSW = 1
- RETURN
-
-C---- Trouble
-
- 91 IF (JCCTYP.EQ.MCCQUI) GO TO 79
- CALL P_FATAL ('faulty line +PAM,...')
- END
-+SEQ, QCARDL. =====================================================
-+DECK, DOAPAM.
- SUBROUTINE DOAPAM
-
-C- Gather the parameters of the c/line +PAM currently in CCKARD
-C- and store them into the PAM bank; position the wanted ARRV bank
-C- at LQARRV
-C. started 3-aug-93
-
-+CDE, QBITS19, QBANKS, ARRCOM, CCPARA.
-+CDE, KQADR, Q, PY.
-+CDE, LUNSLN, FLINKC.
-C-------------- End CDE --------------------------------
-
- PARAMETER (NPOSOP=10)
- CHARACTER POSOP(NPOSOP)*6
-
- DATA POSOP / 'A*TTAC'
- +, 'H*OLD '
- +, 'R*ESUM'
- +, 'U*PDAT'
- +, 'MER*GE'
- +, 'DIS*PL'
- +, 'LIS*T '
- +, 'IND*IV'
- +, 'C*AR* '
- +, 'D*ETAC' /
-
-+SEQ, Q_AND, Q_OR.
-
-
-C-- Analyse +PAM, LAB=lab, N=x,y, T=opt, RETURN=pname .fnname
-C-
-C- L=lab lab (integer) identify the file
-C- default: zero
-C- N=x do x files
-C- N=x,y skip x files, do y files
-C-
-C- T=ATTACH attach file fname
-C- HOLD do not release the file
-C- RESUME continue file "lab"
-C- UPDATE process this file in update mode
-C- (old: CARDS, DETACH)
-C-
-C- R=pname stop after P=pname complete
-
-+SEQ, bkPAM, IF=DOC_INL.
-+SEQ, QEJECT.
-
- CALL CCOPT (POSOP,NPOSOP)
- IF (JCCBAD.NE.0) RETURN
-
- LASTLU = IQ(LPAM+1)
- CALL VZERO (IQ(LPAM+1),8)
-
- LABEL = MCCPAR(JCCPC+1)
-
- IF (NCCPN.GE.2) THEN
- IQ(LPAM+4) = ABS(MCCPAR(JCCPN+1))
- IQ(LPAM+5) = MCCPAR(JCCPN+4)
- ELSEIF (NCCPN.EQ.1) THEN
- IQ(LPAM+5) = ABS(MCCPAR(JCCPN+1))
- ELSE
- IQ(LPAM+5) = 999
- ENDIF
-
- IF (NCCPT.GT.0) IQ(LPAM+6) = MCCPAR(JCCPT+2)
- IQ(LPAM+7) = MCCPAR(JCCPD+1)
-
-C-- find a free logical unit number
-
-+SELF, IF=QCIO.
- LUNX = 11
-+SELF, IF=QFIO.
- LUNX = LUNFREE (0)
-+SELF.
-
-C-- if labelled, find its ARRV bank
-
- IFLPRE = 1
- IF (LABEL.NE.0) THEN
- LXX = KQFIND (LABEL,3,KQARRV,KXX)
- IF (LXX.NE.0) GO TO 31
- ENDIF
-
-C-- get an empty ARRV bank
-
- IFLPRE = 0
- KXX = KQARRV
- 24 LXX = LQ(KXX)
- IF (LXX.EQ.0) GO TO 26
- IF (IQ(LXX+1)+IQ(LXX+3).EQ.0) GO TO 27
- KXX = LXX - 1
- GO TO 24
-
- 26 CALL MQLIFT (LXX, KXX,0, JBKARR,3)
- 27 CALL VZERO (IQ(LXX+1), 11)
-
-C------ New file to be opened --------------
-
- 31 IXFLUN = 0
- IF (IAND(IQ(LPAM+6),KM1).NE.0) GO TO 34
- IF (LASTLU.NE.0) GO TO 41
- IQ(LPAM+6) = IOR (IQ(LPAM+6),KM1)
- IXFLUN = IXLUN(1)
- GO TO 35
-
- 34 CALL FLKRAK (1,2)
- 35 IF (IXFLUN.EQ.0) GO TO 91
- IF (IQ(LXX+1).EQ.0) GO TO 47
-
-C-- the file connected is still active, close it
-
- LUNX = IQ(LXX+1)
- LSAVE = LARRV
- LARRV = LXX
- IN_DOX = -1
- CALL ARRIN
- LARRV = LSAVE
- GO TO 47
-
-C------ File to be resumed --------------
-
- 41 IF (LABEL.EQ.0) THEN
- KXX = KQARRV
- LXX = LQARRV
- ELSE
- IF (IFLPRE.EQ.0) GO TO 91
- ENDIF
-
- IF (IQ(LXX+1).NE.0) LUNX= IQ(LXX+1)
-
- 47 IF (KXX.NE.KQARRV) CALL QSHUNT (KXX,KQARRV)
- IQ(LPAM+1) = LUNX
- IQ(LPAM+3) = LABEL
- IQ(LPAM+8) = IXFLUN
- RETURN
-
-C-- Trouble
-
- 91 JCCBAD = 7
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, DOPAMCO.
- SUBROUTINE DOPAMCO
-
-C- Connect the next multi-PAM file
-C. started 19-July-95
-
-+CDE, SLATE, SLATLN, QBITS19, QPAGE, QUNIT.
-+CDE, ARRCOM, Q, PY.
-+CDE, FLINKC.
-C-------------- End CDE --------------------------------
-
-+SEQ, Q_AND.
-
-+SEQ, bkPAM, IF=DOC_INL.
-+SEQ, bkARRV, IF=DOC_INL.
-+SEQ, QEJECT.
-
-C---- Garbage collection
-
- CALL MQSHIFT
-
- JDKTYP = 3
- JDKNEX = 0
-
-C---- Connect the PAM file
-
- LARRV = LQARRV
-
- IN_LUN = IQ(LPAM+1)
- LABEL = IQ(LPAM+3)
- MOPT = IQ(LPAM+6)
- IXFLUN = IQ(LPAM+8)
-
- IFLATT = IAND (MOPT,KM1)
-C IFLHOL = IAND (MOPT,KM2)
- IFLRES = IAND (MOPT,KM3)
- IFLUPD = IAND (MOPT,KM4)
- IFLREW = 1
-
- IF (IFLATT.NE.0) GO TO 23
-
-C---- Use connected file
-
- LUNPRE = IQ(LARRV+1)
- IXFLUN = IQ(LARRV+4)
- IF (LUNPRE.EQ.0) GO TO 23
-
- IF (IFLRES.NE.0) THEN
- IFLREW = 0
- SLLINE(1:12) = ' ---> resume'
- J = 12
- ELSE
- SLLINE(1:13) = ' ---> restart'
- J = 13
- ENDIF
- GO TO 24
-
-C---- Attach the file
-
- 23 CALL FLINK (IN_LUN, 2, -1, 0)
- IQ(LARRV+2) = LUNFD
- IQ(LARRV+4) = IXFLUN
- IQ(LARRV+6) = LUNSIZ
- IQ(LARRV+7) = -2
-+SELF, IF=QCIO.
- IF (LUNSIZ.GT.0) IQ(LARRV+7)= 0
-+SELF, IF=QFIO.
- CALL LUNRESV (IN_LUN, IXFLUN)
-+SELF.
- SLLINE(1:11) = ' ---> start'
- J = 11
-
-C-- Print log of file reading
-
- 24 SLLINE(J+1:J+14) = ' reading file '
- J = J + 15
- CALL NA_GET (IXFLUN,SLLINE,J)
- NTXT = NESLAT - 1
- CALL DPBLAN (0)
- WRITE (IQPRNT,9027) SLLINE(1:NTXT)
- NQUSED = NQUSED + 2
- IF (IQTYPE.NE.IQPRNT) WRITE (IQTYPE,9027) SLLINE(1:NTXT)
- 9027 FORMAT (A/)
-
-C-- finalize the ARRV bank
-
- IQ(LARRV+1) = IN_LUN
- IQ(LARRV+3) = LABEL
- IQ(LARRV+12) = 0
-
-C-- rewind unless option T=RESUME
-
- IF (IFLREW.NE.0) THEN
- IN_DOX = 0
- CALL ARRIN
- NQWYL = 0
- ENDIF
-
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, DOPAM.
- SUBROUTINE DOPAM
-
-C- Process the next multi-PAM file
-C. started 27-feb-92
-
-+CDE, SLATE, SLATLN.
-+CDE, QBITS19, QBANKS, QPAGE, QUNIT.
-+CDE, ARRCOM, CCTYPE, CCPARA, CHEXC, DEPCOM, MUSEBC, TITLEC.
-+CDE, MQCM, KQADR, Q, PY.
-C-------------- End CDE --------------------------------
-
-+SEQ, Q_AND, Q_NOT.
-
-+SELF, IF=XDEBUG, IF=XLOGCALL.
- PRINT *, 'Xdebug: arriving in DOPAM'
-+SELF.
-
-+SEQ, QEJECT.
-C---- Connect the PAM file
-
- CALL DOPAMCO
-
- JDKSUB = 0
- MXFOSV = MX_FORC
- MOPT = IQ(LPAM+6)
-
- IFLHOL = IAND (MOPT,KM2)
- IFLUPD = IAND (MOPT,KM4)
- IFLMERG = IAND (MOPT,KM5)
- IFLDISP = IAND (MOPT,KM6)
-
-C-- Handle UPDATE mode
-
- IF (MOPUPD.NE.0) THEN
- IF (IFLUPD.NE.0) THEN
- MOPUPD = -1
- ELSE
-C- suspend EXE mode for self on this PAM file
- MX_FORC = IAND (MX_FORC, NOT(KM6))
- ENDIF
- ENDIF
-
- NHOLD = IQ(LARRV+9)
- IF (NHOLD.EQ.0) GO TO 31
-
-C---- Resume input of the PAM file
-
- IQ(LARRV+9) = 0
- CALL ARRIVE (1)
-
- JSLTTL = IQ(LARRV+10)
- IXEXPAM = IQ(LARRV+11)
- IF (IQ(LPAM+4).GT.0) GO TO 42
-
- NCENT = NQDKNO / 100
- NNUM = MOD (NHOLD,100)
- NNEW = 100*NCENT + NNUM
- IF (NNEW.LT.NQDKNO) NNEW= NNEW + 100
- NQDKNO = NNEW
- JDKTYP = 2
- GO TO 42
-
-C------ Load the title deck to memory ------------
-
- 31 IF (JDKNEX.EQ.0) CALL ARRIVE (2)
-
-C---- Handle the PAM-file title
-
- JCCTYP = 0
- JD_DTP = 1
- JD_DTN = 1
-
- CALL KRTITL
- IF (JCCTYP.EQ.MCCPAT) JDKSUB= 2
-
- JSLTTL = IQ(LARRV+10)
- IQ(LPAM+13) = IQ(LPAM+13) + 1
- IF (IQ(LPAM+4).GT.0) GO TO 42
-
- IF (NQDKNO.GE.2) THEN
- NQDKNO = ((NQDKNO-1)/100 + 1) *100
- ELSE
- NQDKNO = 0
- ENDIF
- JDKTYP = 3
-
-C-- create RPAM bank
-
- 42 CALL QSHUNT (KQMAIN,KQPAST)
- CALL MQLIFT (LRPAM, LEXP,1, JBKRPA,3)
- IQ(LRPAM+1) = JSLTTL
- IQ(LRPAM+2) = -IXEXPAM
- IQ(LRPAM+3) = NQDKNO
-
- CALL LN_GET (JSLTTL, SLLINE, 60)
- NTXT = NDSLAT
-
-C-- PAM file to be read, not skipped
-
- IF (IQ(LPAM+4).GT.0) GO TO 71
-
- CALL DPBLAN (0)
- WRITE (IQPRNT,9043) SLLINE(1:NTXT)
- NQUSED = NQUSED + 2
- IF (IQTYPE.NE.IQPRNT) WRITE (IQTYPE,9043) SLLINE(1:NTXT)
- 9043 FORMAT (' Read Pam file: ',A/)
-
- IF (NFILET.LT.NFIMAX) NFILET= NFILET + 1
- JTIPAM(NFILET) = JSLTTL
-
-+SEQ, QEJECT.
-C------ Loop over all patches
-
- IF (JDKSUB.NE.0) JDKTYP= 2
- JDKSUB = 0
- JD_DTP = 1
- JD_DTN = 1
-
- 44 CALL DOPAT
- IF (JDKTYP.EQ.6) GO TO 81
- IF (IQ(LEXP+2).EQ.IQ(LPAM+7)) GO TO 61
- IF (JDKTYP.EQ.2) GO TO 44
-
-C---- +TITLE seen, do next PAM file
-
- IQ(LPAM+5) = IQ(LPAM+5) - 1
- IF (IQ(LPAM+5).LE.0) GO TO 62
- GO TO 31
-
-C---- Stop input from PAM
-C- for RETURN=name reached
-C- for number of PAM files to be done exhausted
-
- 61 IF (JDKTYP.EQ.2) IQ(LARRV+9)= NQDKNO
- 62 JSLSAV = IQ(LQHOLD+1)
- NSLSAV = IQ(LQHOLD+2)
- IF (IFLHOL.EQ.0) THEN
- LQLEND(2) = JSLSAV
- LQLSTA(3) = LQLEND(2)
- LQLEND(3) = LQLSTA(3)
- GO TO 82
- ENDIF
-
- IF (NSLSAV.EQ.0) GO TO 88
-+SELF, IF=QCIO.
- IF (IQ(LARRV+7).GT.0) THEN
- IN_DOX = 1
- IN_DO1 = JSLSAV
- CALL ARRIN
- GO TO 88
- ENDIF
-+SELF.
-
- CALL MQLIFT (LASAV,LARRV,-2,JBKASA,1)
- IQ(LASAV+1) = JSLSAV
- IQ(LASAV+2) = NSLSAV
- GO TO 88
-
-C------ Skip the PAM file
-
- 71 IQ(LPAM+4) = IQ(LPAM+4) - 1
- IQ(LRPAM+4) = -1
-
- CALL DPBLAN (0)
- WRITE (IQPRNT,9072) SLLINE(1:NTXT)
- NQUSED = NQUSED + 2
- 9072 FORMAT (' Skip Pam file: ',A/)
-
- JDKTYP = 3
- CALL ARRSKP
- IF (JDKTYP.LT.6) GO TO 31
-
-C------ End of multi-PAM reached
-
- 81 CONTINUE
-
-C-- Detach or Rewind
-
- 82 IF (IFLHOL.EQ.0) THEN
- IN_DOX = -1
- ELSE
- IN_DOX = 0
- ENDIF
- CALL ARRIN
-
- 88 IQ(LQHOLD+2) = 0
- IQ(LPAM+12) = IQ(LPAM+12) + IQ(LARRV+12)
- IQ(LARRV+12) = 0
- MOPUPD = ABS(MOPUPD)
- MX_FORC = MXFOSV
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, DOPAT.
- SUBROUTINE DOPAT
-
-C- Process the current patch
-C. started 27-feb-92
-
-+CDE, QBITS19, QPAGE.
-+CDE, CCTYPE, CCPARA, CHEXC, MUSEBC.
-+CDE, Q, PY.
-C-------------- End CDE --------------------------------
-
-+SEQ, Q_AND, Q_NOT.
-
-+SEQ, QEJECT.
-
- IFLGAR = 0
- MUGLOB = MU_GLOB
- JCCBAD = 0
- IF (JDKTYP.EQ.3) GO TO 26
-
- JSLF = IQ(LQHOLD+1)
- JCCTYP = MCCPAT
-+SELF, IF=QDEBUG.
- JTX = MLIAD(JSLF)
- J = JPTYPE (TEXT(JTX))
- IF (J.NE.JCCTYP) THEN
- NTX = MLIAD(JSLF+1) - JTX
- CALL DPLMSG ('Trouble with:',NTX,TEXT(JTX))
- CALL P_CRASH ('trouble in DOPAT')
- ENDIF
-+SELF.
- CALL CCKRAK (JSLF)
-
-C-- get the name
-
- IXEXPAT = MCCPAR(JCCPP+1)
- IF (IXEXPAT.EQ.0) IXEXPAT= 1
-
-C-- check the patch is already kown, if not it
-C- cannot have been USE selected
-
- IF (JCCBAD.NE.0) GO TO 27
- IF (IAND(MU_GLOB,KM5).NE.0) GO TO 27
- IF (MOPTIO(1).NE.0) GO TO 27
- IF (LOCPAT(IXEXPAT).NE.0) GO TO 27
-
- JDKTYP = 2
- CALL ARRSKP
- RETURN
-
-C-- find/create the patch bank
-
- 26 IF (MOPUPD.GE.0) MU_GLOB= IAND (MU_GLOB,NOT(KM5))
- 27 CALL CREAPD (IXEXPAT,-1,7)
- MU_GLOB = MUGLOB
- IXEXDEC = 0
- IXEXID = IXEXPAT
- CALL SBYT (NQDKNO, IQ(LEXP+1),13,20)
- MU_PAT = IAND (IQ(LEXP),KM19-1)
- IF (JCCBAD.NE.0) GO TO 44
- IF (IAND(MU_PAT,KM10).EQ.0) GO TO 47
- IF (IAND(IQ(LEXP+1),KM2).NE.0) GO TO 47
- IF (IAND(IQ(LEXP+1),KM4).NE.0) GO TO 44
- IF (IAND(MU_PAT,KM5).EQ.0) GO TO 47
-
- 44 CALL DODECK (0)
- GO TO 48
-
- 47 JDKTYP = 2
- CALL ARRSKP
- 48 IF (IAND(IQ(LEXP+1),KM5).NE.0) RETURN
- IF (MOPUPD.LT.0) RETURN
-
- IF (LQ(LEXP-2).NE.0) CALL TOGARB (LEXP-2,7)
- IF (LQ(LEXP-3).NE.0) CALL TOGARB (LEXP-3,7)
-+SELF, IF=XDEBUG, IF=XCOLLECT.
-C! IXBR = NA_NEW ('ACTX',1,5)
-C! IF (IXBR.NE.IXEXPAT) RETURN
-+SELF, IF=XDEBUG, IF=XCOLLECT, IF=XDDSNAP.
- IXBR = NA_NEW ('ACTX',1,5)
- IF (IXBR.EQ.IXEXPAT) THEN
- CALL DDSNAP ('DOPAT before shift',0,1)
- CALL DDSNAP ('DOPAT before shift',0,3)
- ENDIF
-+SELF, IF=XDEBUG, IF=XCOLLECT.
-
- CALL MQSHIFT
-
-+SELF, IF=XDEBUG, IF=XCOLLECT, IF=XDDSNAP.
- IF (IXBR.EQ.IXEXPAT) THEN
- CALL DDSNAP ('DOPAT after shift',0,1)
- CALL DDSNAP ('DOPAT after shift',0,3)
- ENDIF
-+SELF.
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, DODECK.
- SUBROUTINE DODECK (JREADY)
-
-C- Process the next decks until end of patch
-C- JREADY = 0 c/l +DECK to be analysed
-C- 1 ready to run
-C. started 27-feb-92
-
-+CDE, SLATE, SLATLN, QBITS19, QPAGE, QSTATE.
-+CDE, CCTYPE, CCPARA, CHEXC, DEPCOM, MUSEBC, TAGC.
-+CDE, MQCM, Q, PY.
-C-------------- End CDE --------------------------------
-
-+SEQ, Q_AND.
-
-+SELF, IF=XDEBUG, IF=XLOGCALL.
- PRINT *, 'Xdebug: arriving in DODECK, JREADY= ',JREADY
- CALL PRHOLD
-+SELF.
-+SEQ, QEJECT.
-
- IFLRDY = JREADY
- NCHTAG = 0
- LLORG = 0
- LLACT = 0
- LMODE = 0
-
-C-- Check enough space
-
- 21 IFLGAR = 0
- CALL SETGAP
-
-C------ Ready the deck parameters
-
- IF (IFLRDY.NE.0) GO TO 62
- JD_NEW = 1
- JD_MULT = 0
- IF (JDKTYP.NE.1) GO TO 47
-
-C---- Deck header is +DECK, name
-
- 42 INCRAD = MIN (INCRAD,1)
- JSLF = IQ(LQHOLD+1)
- JCCTYP = MCCDEC
- CALL CCKRAK (JSLF)
-
-C-- get the name
-
- IXEXDEC = MCCPAR(JCCPD+1)
- IF (IXEXDEC.EQ.0) IXEXDEC= 1
- IXEXID = IXEXDEC
-
-C-- find the deck bank, set operation mode
-
- 47 LEXD = KQFIND (IXEXDEC,1, LEXP-2,KEXD)
- IF (LEXD.NE.0) THEN
- MU_DECK = IAND (IQ(LEXD),KM19-1)
- ELSE
- MU_DECK = MU_PAT
- ENDIF
-
- CALL MXOPER (0)
-
- IF (JDKTYP.NE.1) GO TO 61
- IF (IAND(MU_DECK,KM5).EQ.0) GO TO 85
-
-+SEQ, QEJECT.
-C------ Process the deck
-
- 61 NQNEWH = 7
- LDECO = 0
- NSLORG = 0
-
- 62 IFLRDY = 0
- IF (JDKNEX.EQ.0) CALL ARRIVE (2)
-+SELF, IF=XDEBUG, IF=XSHOWDK.
- IF (JDKTYP.EQ.1) THEN
- SLLINE(1:48) = 'd='
- IX = IXEXDEC
- ELSEIF (JDKTYP.EQ.2) THEN
- SLLINE(1:48) = 'p='
- IX = IXEXPAT
- ELSE
- SLLINE(1:48) = 'f='
- IX = IXEXPAM
- ENDIF
- CALL NA_GET (IX, SLLINE, 3)
- N = NESLAT - 1
- PRINT *, 'Xdebug: DODECK doing ', SLLINE(1:N)
-
-+SELF, IF=XDEBUG, IF=-XDEBUG.
-C! IXBR = NA_NEW ('TCGEN',1,6)
-C! IF (IXBR.EQ.IXEXPAT) CALL CATCH (0)
-C! IXBR = NA_NEW ('VCDE',1,5)
-C! IF (IXBR.EQ.IXEXPAT) CALL CATCH (0)
-+SELF.
-
-C-- ready the foreign material into this deck
-
- CALL ACSORT
-
-C-- analyse the contents
-
- CALL DOMAP
- IF (JANSW.LT.0) GO TO 84
-
-C-- process the contents
-
- IF (JANSW.NE.0) CALL DOXQT
- LQCEND(2) = LQCSTA(2)
-
-C------ Processing complete
-
- NQDKNO = NQDKNO + 1
-
-C-- send the DECK bank to garbage collection
-C- unless it is the blank deck of P=CRA*
-
- IF (LEXD.NE.0) THEN
- L = KQFIND (IXEXDEC,1, LEXP-2, KEXD)
- IF (L.NE.0) THEN
- IF (L.EQ.LDCRAB) GO TO 67
- CALL TOGARB (KEXD,0)
- ENDIF
- ENDIF
-
- IF (NVEXDK(1).EQ.0) GO TO 88
- IF (JD_NEW.EQ.0) CALL DPEXTM (1)
- GO TO 88
-
-C-- End of blank deck of P=CRA*
-
- 67 IF (NQERR.NE.0)
- + CALL P_KILL ('errors in the blank deck of the cradle')
-
- CALL ASMUSE
- LQ(KEXD) = LQ(LEXD-1)
- IF (NCLASH.EQ.0) THEN
- IF (MOPUPD.EQ.0) NCLASH= 2
- ENDIF
- GO TO 88
-
-C---- Skip patch or deck
-
- 84 JDKTYP = 2
- 85 CALL ARRSKP
- GO TO 89
-
-C-- step to the next deck
-
- 88 CALL ARRNXD (1)
- 89 CONTINUE
-+SELF, IF=XDEBUG, IF=XLOGCALL.
- PRINT *, 'Xdebug: end of deck, JDKTYP,JDKNEX=',JDKTYP,JDKNEX
- CALL PRHOLD
-+SELF.
- IF (JDKTYP.EQ.1) GO TO 21
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+PATCH, ACSORT. Sort the actions into the current deck
-+DECK, ACSORT.
- SUBROUTINE ACSORT
-
-C- Sort the action banks for current deck, mark clash levels
-C- Called from DODECK when processing of a new deck is started
-
-+CDE, QBITS19, Q, PY.
-C-------------- End CDE --------------------------------
- DIMENSION MBIAS(12)
-
-+SEQ, Q_JBYT, Q_OR, Q_SHIFTL, Q_SHIFTR.
-
- DATA MBIAS / 5, 5, 3, 1, 0, 0, 0, 0, 4, 4, 2, 0 /
-C- DEL REP ADB ADD DEL REP ADB ADD
-C- 0 1 2 3 4 5 6 7 8 9 10 11
-
- IF (LEXD.EQ.0) RETURN
- KACTEX = LEXD-2
- L = LQ(KACTEX)
- IF (L.EQ.0) RETURN
-
- CALL QTOPSY (KACTEX)
-
-C-- Construct new target line numbers: LIIN = 8*LI + bias
-
- L = LQ(KACTEX)
- 24 JACT = JBYT (IQ(L),9,4)
- IQ(L+4) = ISHFTL(IQ(L+4),3) + MBIAS(JACT+1)
- L = LQ(L-1)
- IF (L.NE.0) GO TO 24
-
-C-- Sort the list for starting target line numbers
-
- CALL QSORTI (4,KACTEX)
-
-C------ Scan for clash
-
- LBKF = KACTEX + 1
-
-C-- new first bank
-
- 32 LBKF = LQ(LBKF-1)
- IF (LBKF.EQ.0) GO TO 41
- JACTF = JBYT (IQ(LBKF),9,4)
- IF (JACTF.GE.8) GO TO 32
- LBKN = LQ(LBKF-1)
- IF (LBKN.EQ.0) GO TO 41
- IF (JACTF.LT.2) GO TO 34
-
- IF (IQ(LBKF+4).NE.IQ(LBKN+4)) GO TO 32
- IQ(LBKF) = IOR (IQ(LBKF), KM14)
- IQ(LBKN) = IOR (IQ(LBKN), KM14)
- GO TO 32
-
-C-- and its next banks
-
- 34 JTGFE = ISHFTL (IQ(LBKF+5),3) + 7
-
- 36 IF (IQ(LBKN+4).GT.JTGFE) GO TO 32
-
- JACTN = JBYT (IQ(LBKN),9,4)
- IF (JACTN.GE.8) GO TO 37
-
- IF (IFLMERG.EQ.0) THEN
- MSKF = KM14
- IF (LBKF.GT.LBKN) MSKF= KM15
- MSKN = KM13 + MSKF
- ELSE
- MSKF = KM15
- MSKN = KM15
- ENDIF
-
- IQ(LBKF) = IOR (IQ(LBKF), MSKF)
- IQ(LBKN) = IOR (IQ(LBKN), MSKN)
- 37 LBKN = LQ(LBKN-1)
- IF (LBKN.EQ.0) GO TO 32
- GO TO 36
-
-C------ Reset the line numbers
-
- 41 L = LQ(KACTEX)
- 44 IQ(L+4) = ISHFTR(IQ(L+4),3)
- L = LQ(L-1)
- IF (L.NE.0) GO TO 44
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+PATCH, DOMAP. Map the current deck into the PREP structure
-+DECK, DOMAP.
- SUBROUTINE DOMAP
-
-C- Content analysis of the next deck,
-C- map the description of this deck's material
-C- into the control-banks of the linear PREP structure.
-C. started 9-jan-92
-
-+CDE, QBANKS, Q, PY.
-+CDE, INCLC, M_ANAC.
-C-------------- End CDE --------------------------------
-
-
- NEWDEC = 0
- NEWCTL = 0
- NEWFOR = 0
- NEWNIL = 0
- NEWINC = 0
- MEXAN = 0
- N_INCL = 0
- JSLZER = IQ(LQHOLD+1)
- JSLORG = JSLZER - NSLORG
-
-C-- create the PREP seedling
-
- CALL MQLIFT (LQPREP, 0,7, JBKPRE,2)
-
- IQ(LQPREP+1) = JSLZER
- IQ(LQPREP+2) = IQ(LQHOLD+3)
-
-C---- stage 1 : delimit control lines, create PREP structure
-
- IF (MOPUPD.GE.0) CALL M_ANA1
-
-
-C---- stage 2 : connect actions into this deck
-
- IF (LEXD.EQ.0) GO TO 31
- IF (LQ(LEXD-2).EQ.0) GO TO 31
-
- CALL M_ANA2
-
-C-- create NIL sequences or actions
-
- IF (NEWNIL.NE.0) CALL MK_NIL
-
-
-C---- stage 3 : ready effective self-material and new foreign material
-C- return JANSW = -1 skip patch, 0 skip deck, 1 process
-
- 31 CALL M_HEAD
- IF (JANSW.GT.0) CALL M_ANA3
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, M_ANA1.
- SUBROUTINE M_ANA1
-
-C- Content analysis, stage 1:
-C- find all control lines present in the current deck;
-C- each control line starts a new PREP bank, unless it is
-C- a soft c/line covered by a +KEEP +REPL etc. in update mode;
-C- c/lines without associated text are held in a 1-line PREP bank.
-C- - this is not called if the deck is processed under +PAM, T=UPD
-C- and hence all c/l's in the deck are treated as ordinary lines
-C. started 11-dec-91
-
-+CDE, CCTYPE, CCPARA, Q, PY.
-C-------------- End CDE --------------------------------
-
-+SEQ, Q_OR, Q_SHIFTL.
-
-
- LDO = LQPREP
- JSLA = IQ(LDO+1)
- JSLE = JSLA + IQ(LDO+2)
- JSLG = JSLA
-
-C---- Find next control line, split on it
-
- 21 IF (JSLG.GE.JSLE) RETURN
- CALL NEXTCC ('+',JSLG,JSLE,JSLF,JCCTYP)
- IF (JCCTYP.EQ.0) RETURN
-
- 22 IF (JSLF.GT.JSLA) LDO= M_SPLIT (LDO,JSLF)
-
- IQ(LDO) = IOR (IQ(LDO), ISHFTL(JCCTYP,8))
- JSLA = IQ(LDO+1)
- JSLG = JSLA + 1
-
-C-- control-lines with associated material are:
-C-- +_xxx +SELF +SKIP +KEEP +REPL +ADB +ADD
-
- IF (JCCTYP.LT.MCCTRU) GO TO 27
- IF (JCCTYP.LE.MCCEND) GO TO 21
- IF (JCCTYP.GE.MCCUSE) GO TO 27
- IF (JCCTYP.GE.MCCKEE) GO TO 31
- IF (JCCTYP.NE.MCCSEL) GO TO 21
-
-C-- for +SELF, sname change the type to MCCSES
-
- CALL CCKRAK (JSLA)
- IF (NCCPZ.EQ.0) GO TO 21
- CALL SBYT (MCCSES, IQ(LDO),9,6)
- GO TO 21
-
-C-- stand-alone control-line
-
- 27 IF (JSLG.GE.JSLE) RETURN
- LDO = M_SPLIT (LDO,JSLG)
- JSLA = JSLG
- GO TO 21
-
-C---- Found the start of an action, if Update mode:
-C-- handle all soft c/lines inside as ordinary lines
-
- 31 IF (JCCTYP.EQ.MCCDEL) GO TO 27
- IF (MOPUPD.EQ.0) GO TO 21
- 37 CALL NEXTCC ('+',JSLG,JSLE,JSLF,JCCTYP)
- IF (JCCTYP.EQ.0) RETURN
- IF (JCCTYP.GE.MCCSEL) GO TO 22
- JSLG = JSLF + 1
- IF (JSLG.LT.JSLE) GO TO 37
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, M_ANA2.
- SUBROUTINE M_ANA2
-
-C- Content analysis stage 2:
-C- 1.1) for each action insert a zero-line PREP bank into the chain
-C- of PREP banks with a reference to the ACT bank acting into
-C- the current deck;
-C- 1.2) split the target PREP bank containing the end of
-C- a DELETE or REPLACE range;
-C- 2.1) transfer the action EXE bits into the new PREP bank;
-C- 2.2) for the PREP banks covered by a DEL or REPL transfer the
-C- EXE bits of the action, and mark as deleted (unless nil)
-C- 3) add one zero-line PREP bank for each trailing action;
-C- - called also if PAM update mode -
-C. started 11-nov-91
-
-+CDE, QBITS19, QBANKS, CCTYPE, Q, PY.
-+CDE, M_ANAC.
-C-------------- End CDE --------------------------------
-
-+SEQ, Q_JBYT, Q_AND, Q_OR.
-
-
-C---------- Split PREP banks on all action limits -----------
-
- LDO = LQPREP
- LACT = LEXD - 1
-
-C---- Next action
-
- 21 LACT = LQ(LACT-1)
- IF (LACT.EQ.0) GO TO 40
-
-C- JACT = 0 DEL, 1 REP, 2 ADB, 3 ADD
-
- JACT = JBYT (IQ(LACT),9,3)
- JSLX = IQ(LACT+4) + JSLZER
-
-C- break at the insertion point
-
- LDO = M_SPLIT (LDO,JSLX)
- IF (LDO.EQ.0) GO TO 40
-
-C- zero-line PREP bank with reference to ACT
-
- LX = LDO
- LDO = M_SPLIT (LDO,0)
- LQ(LX-2) = LACT
- IF (JACT.GE.2) GO TO 21
-
-C---- +DEL, +REPL: split at end of delete
-
- JSLD = IQ(LACT+5) + JSLZER + 1
- LNX = M_SPLIT (LDO,JSLD)
- GO TO 21
-
-+SEQ, QEJECT, N=40.
-C---------- Set EXE bits and mark deleted material ----------
-
- 40 KMDEL = KM6 + KM7
- IF (IFLDISP.NE.0) KMDEL= KM5 + KM7
-
- LDO = LQPREP
- LACT = LEXD - 1
-
-C---- Next action
-
- 41 LACT = LQ(LACT-1)
- IF (LACT.EQ.0) RETURN
-
-C- JACT = 0 DEL, 1 REP, 2 ADB, 3 ADD
-
- JACT = JBYT (IQ(LACT),9,3)
- NIL = IAND (IQ(LACT),KM12)
- NDEL = IAND (IQ(LACT),KM12+KM13)
- MEXE = IAND (IQ(LACT),15)
- MEXAN = IOR (MEXAN,MEXE)
-
-C-- Find the PREP bank for this action
-
- 43 IF (LQ(LDO-2).NE.LACT) THEN
- LSV = LDO
- LDO = LQ(LDO-1)
- IF (LDO.EQ.0) GO TO 61
- GO TO 43
- ENDIF
-
- MAB = MEXE
- IF (NDEL.NE.0) MAB = MAB + KM6
- IQ(LDO) = IOR (IQ(LDO),MAB)
- IF (JACT.GE.2) GO TO 41
-
-C---- +DEL, +REPL: mark deleted section
-
- JSLD = IQ(LACT+5) + JSLZER + 1
- LNX = LDO
- 47 LNX = LQ(LNX-1)
- IF (LNX.EQ.0) GO TO 41
- JSLA = IQ(LNX+1)
- IF (JSLA.GE.JSLD) GO TO 41
-
- IQ(LNX) = IOR (IQ(LNX),MEXE)
- IF (NIL.NE.0) GO TO 47
- IF (LQ(LNX-2).NE.0) GO TO 47
-
- IQ(LNX) = IOR (IQ(LNX),KMDEL)
-
-C-- deleted action?
-
- JTYP = JBYT (IQ(LNX),9,6)
- IF (JTYP.LT.MCCKEE) GO TO 47
- IF (JTYP.GE.MCCUSE) GO TO 47
- NEWNIL = NEWNIL + 1
- GO TO 47
-
-C---- Add trailing actions
-
- 61 JSLSV = IQ(LSV+1) + IQ(LSV+2)
-
- 62 MEXAN = IOR (MEXAN,MEXE)
- IF (NDEL.EQ.0) THEN
- IF (JACT.LT.2) GO TO 67
- ELSE
- MEXE = MEXE + KM6
- ENDIF
-
- CALL MQLIFT (LNEW,LSV,-1,JBKPRE,2)
- LSV = LNEW
- LQ(LSV-2) = LACT
- IQ(LSV) = IOR (IQ(LSV),MEXE)
- IQ(LSV+1) = JSLSV
-
- 64 LACT = LQ(LACT-1)
- IF (LACT.EQ.0) RETURN
-
- JACT = JBYT (IQ(LACT),9,3)
- MEXE = IAND (IQ(LACT),15)
- NDEL = IAND (IQ(LACT),KM12+KM13)
- GO TO 62
-
-C: DATA CHER( 1) /'illegal action after end-of-deck'/
-
- 67 CALL FAILLN (1,LQ(LACT-3),IQ(LACT+3),IQ(LACT+1),
- + 'Illegal action after end-of-deck')
- GO TO 64
- END
-+SEQ, QCARDL. =====================================================
-+DECK, M_HEAD.
- SUBROUTINE M_HEAD
-
-C- Content analysis between stages 2 and 3:
-C- check patch/deck is accepted or not,
-C- evaluate data type,
-C- return JANSW = -1 skip patch, 0 skip deck, 1 process
-C. started 11-july-94
-
-+CDE, QBITS19, QPAGE, CCTYPE, CCPARA, DEPCOM.
-+CDE, KQADR, Q, PY, MUSEBC.
-+CDE, M_ANAC.
-C-------------- End CDE --------------------------------
-
-+SEQ, Q_AND, Q_OR.
-
-+SEQ, QEJECT.
-
- JCCIFV = 0
- IFREP = 0
-
- JANSW = 1
- LUPAN = 0
- LDOAN = KQPREP + 1
-
- CALL M_A3NX
- IF (LDOAN.EQ.0) GO TO 24
- IF (JCCTYP.LT.MCCDEC) GO TO 24
- IF (JCCTYP.GT.MCCPAT) GO TO 24
-
- CALL CCKRAK (IQ(LDOAN+1))
- IF (JCCBAD.NE.0) THEN
- CALL M_FAIL ('Syntax error')
- ELSE
- IF (NCCPIF.NE.0) CALL CCPROC
- ENDIF
-
- IF (NCCPT.NE.0) THEN
- CALL CCDOPT (1, JD_DTN)
- IF (NQJOIN.GE.0) NQJOIN = IAND (MCCPAR(JCCPT+2),2)
- IFREP = IAND (MCCPAR(JCCPT+2),1)
- ELSE
- JD_DTN = 0
- NQJOIN = MIN(NQJOIN,0)
- ENDIF
-
-C-- line is +DECK, name, T=type, IF=...
-
- IF (JCCTYP.NE.MCCDEC) GO TO 31
- JDKTYP = 1
- IF (JD_DTN.EQ.0) JD_DTN= JD_DTP
- IF (JCCIFV.NE.0) GO TO 49
- GO TO 47
-
-C-- not a c/line to be looked at (mainly update mode)
-
- 24 JD_DTN = JD_DTP
- IF (JDKTYP.EQ.1) GO TO 47
- GO TO 34
-
-C-- line is +PATCH, name, T=type, IF=...
-
- 31 JD_DTN = MAX (JD_DTN,1)
- JD_DTP = JD_DTN
- IF (JDKTYP.EQ.1) GO TO 44
-
- IF (IFREP.NE.0) IQ(LEXP+1)= IOR (IQ(LEXP+1),KM5)
-
- 34 IF (IAND(MU_PAT,KM10).EQ.0) GO TO 39
- IF (JCCIFV.NE.0) GO TO 38
- IF (IAND(IQ(LEXP+1),KM4).NE.0) GO TO 47
- IF (IAND(MU_PAT,KM5).EQ.0) GO TO 39
- GO TO 47
-
- 38 IQ(LEXP+1) = IOR(IQ(LEXP+1),KM1)
- 39 JANSW = -1
- RETURN
-
-C-- but the original was +DECK, ...
-
- 44 IF (JCCIFV.NE.0) GO TO 49
-
- 47 IF (IAND(MU_DECK,KM5).NE.0) RETURN
- 49 JANSW = 0
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, M_ANA3.
- SUBROUTINE M_ANA3
-
-C- Content analysis stage 3:
-C- ready effective self-material for use
-C- activating delayed control lines
-C- evaluating IF selection
-C- resolving sequence calls
-C- collecting EXE bits from called sqs and IF= params
-C- ready new effective foreign material for use
-C- activating delayed control lines
-C- evaluating initial IF selection
-C- - called also if PAM update mode -
-C. started 25-nov-91
-
-+CDE, SLATE, QBITA19, QBANKS, QSTATE.
-+CDE, CCTYPE, CCPARA.
-+CDE, KQADR, Q, PY, MUSEBC.
-+CDE, M_ANAC.
-C-------------- End CDE --------------------------------
-
-+SEQ, Q_AND, Q_OR, Q_NOT, Q_SHIFTL.
-
-
- MUPASV = MU_PAT
- MUDKSV = MU_DECK
- LEVSK = MCCSEL
- NONACT = 7
- LEVAN = 7
- LUPAN = 0
-
- LDOAN = KQPREP + 1
- GO TO 21
-
-+SEQ, QEJECT, N=60.
-C---------- Scan ordinary self-material ---------
-
-C-- MODEAN = 0 ordinary self 1 IF-conditional self
-C-- 2 +SELF,sname 3 +KEEP 4 +REPL,+ADB,+ADD
-
- 21 CALL M_A3NX
- IF (LDOAN.EQ.0) GO TO 61
- 22 IF (JCCTYP.LE.MCCNIL) GO TO 21
- IF (JCCTYP.EQ.MCCTIT) GO TO 43
- IF (JCCTYP.EQ.MCCXSQ) GO TO 37
-
- CALL M_KRAK (1)
-
- JACT = 0
- MODEAN = 0
- IF (JCCTYP.GE.MCCUSE) GO TO 51
- IF (JCCTYP.GE.MCCDEL) GO TO 71
-
- NONACT = 7
- IF (JCCTYP.EQ.MCCKEE) GO TO 73
- IF (JCCTYP.EQ.MCCSKI) GO TO 40
- IF (JCCTYP.GE.MCCSEL) GO TO 41
- IF (JCCTYP.LT.MCCTRU) GO TO 31
-
-C---------- Handle +_IF etc
-
- IF (JCCBAD.NE.0) GO TO 45
- IFSTEP = 1
- CALL M_A3IF (IFSTEP)
- IF (JCCBAD.NE.0) GO TO 45
- IF (IFSTEP.NE.0) GO TO 21
- IF (LDOAN.NE.0) GO TO 22
- GO TO 61
-
-C---------- Handle +CDE or +SEQ
-
-C-- check +CDE, T=DUMMY
-
- 31 IF (JCCBAD.NE.0) GO TO 21
- MEXAN = IOR (MEXAN,MXCCIF)
- IF (IAND(MCCPAR(JCCPT+1),KMD).NE.0) JCCIFV= 1
-
- CALL M_A3SQ
- GO TO 21
-
-C-- link all seqences for XSQ bank
-
- 37 MX = LINKSQ (LDOAN,0)
- MEXAN = IOR (MEXAN,MX)
- GO TO 21
-
-C---------- +SELF c/c seen
-
- 40 IF (MOPUPD.EQ.0) JCCIFV= 1 - JCCIFV
- 41 MEXAN = IOR (MEXAN,MXCCIF)
- IF (JCCBAD.NE.0) GO TO 45
- IF (JCCIFV.NE.0) GO TO 45
- IF (JCCTYP.NE.MCCSES) GO TO 21
-
-C-- handle +SELF, seqname
-
- MODEAN = 2
- CALL M_A3SQ
- IF (JCCBAD.NE.0) GO TO 45
- IF (IQUEST(1).EQ.0) GO TO 21
- GO TO 46
-
-C-- deleted material
-
- 43 JCCTYP = MCCPAT
- 44 LEVSK = JCCTYP
- 45 IQ(LDOAN) = IOR (IQ(LDOAN), KM5)
- 46 CALL M_A3NX
- IF (LDOAN.EQ.0) GO TO 61
- IF (JCCTYP.LT.LEVSK) THEN
- IQ(LDOAN) = IOR (IQ(LDOAN), KM6)
- GO TO 46
- ENDIF
- JCCBAD = 0
- LEVSK = MCCSEL
- GO TO 22
-
- 48 IF (JACT.NE.1) GO TO 45
- 49 IQ(LDOAN) = IOR (IQ(LDOAN), KM5)
- GO TO 21
-
-+SEQ, QEJECT.
-C---------- Control lines +USE etc
-
- 51 NONACT = 7
- IF (JCCTYP.GE.MCCDEC) GO TO 56
- IF (JCCBAD.NE.0) GO TO 21
- IF (JCCTYP.GE.MCCASM) GO TO 52
- IF (JCCTYP.GT.MCCEXE) GO TO 53
- IF (JCCIFV.NE.0) GO TO 49
- CALL X_USE
- GO TO 21
-
-C-- c/l allowed only in the cradle
-
- 52 IF (JCCTYP.EQ.MCCEOD) GO TO 49
- IF (JCCTYP.EQ.MCCONL) GO TO 91
- IF (LEXD.NE.LDCRAB) THEN
- IF (JCCTYP.LE.MCCONL) GO TO 94
- IF (INCRAD.EQ.0) GO TO 94
- ENDIF
-
- IF (JCCTYP.GE.MCCPAM) GO TO 49
- 53 IF (JCCIFV.NE.0) GO TO 49
- NEWCTL = 7
- GO TO 21
-
-C---------- Control lines +DECK or +PATCH
-
- 56 IF (JCCBAD.NE.0) GO TO 44
- MEXAN = IOR (MEXAN,MXCCIF)
- LEVAN = 7
- NEWDEC = NEWDEC + 1
- IF (JCCIFV.NE.0) GO TO 44
-
- CALL CCDOPT (1, JASM)
- IF (NDSLAT.NE.0) THEN
- CALL M_FAIL ('Multiple data type')
- GO TO 44
- ENDIF
-
- CALL SBYT (JASM,IQ(LDOAN),21,6)
- GO TO 21
-
-C---------- End of processing
-
- 61 JANSW = 0
- MEXAN = IAND (MEXAN,15)
- IF (MEXAN.NE.0) CALL MXOPER (MEXAN)
-
- IF (NQERR.NE.0) THEN
- NVEXDK(1) = 0
- NVEXDK(5) = NVEXDK(2)
- ENDIF
-
- IF (NEWCTL+NEWFOR+NVEXDK(5).EQ.0) RETURN
-
- JANSW = 1
- IF (INCRAD.LT.2) RETURN
-
- CALL SBYT (MUPASV, IQ(LEXP),1,18)
- IF (LEXD.NE.0) CALL SBYT (MUDKSV, IQ(LEXD),1,18)
- CALL X_UDECK (0)
- RETURN
-
-+SEQ, QEJECT.
-C---------- New foreign material being defined ---------
-
-C- JACT = 0 KEEP 1 DEL 2 REPL 3 ADB 4 ADD
-
- 71 IF (JCCBAD.NE.0) GO TO 45
- JACT = JCCTYP - MCCKEE
- MODEAN = 4
- IQ(LDOAN) = IOR (IQ(LDOAN), MXCCIF)
-
- IF (NONACT.NE.0) THEN
- NVIMAT(1) = 0
- LASTDK = 0
- NONACT = 0
- ENDIF
-
- CALL CREACT
- IF (LCRD.EQ.0) GO TO 95
-
- IF (LCRD.EQ.LASTDK) IQ(LDOAN)= IOR (IQ(LDOAN),KM18)
- LQ(LDOAN-3) = LCRD
- LASTDK = LCRD
-
-C---- Create NIL action
-
- IF (JCCIFV.NE.0) THEN
- IF (IAND(MXCCIF,NOT(IQ(LCRD))).EQ.0) GO TO 48
- IQ(LDOAN) = IOR (IQ(LDOAN), KM8)
- NEWFOR = NEWFOR + 1
- GO TO 48
- ENDIF
-
-C---- Accepted action
-
-C- JACT = 0 KEEP 1 DEL 2 REPL 3 ADB 4 ADD
-
- NEWFOR = NEWFOR + 1
- IF (JACT.EQ.1) GO TO 21
- CALL M_A3AC
- IF (LDOAN.EQ.0) GO TO 61
- IF (JCCBAD.NE.0) GO TO 45
- GO TO 22
-
-C------ +KEEP definition
-
- 73 IF (JCCBAD.NE.0) GO TO 45
- MODEAN = 3
- IF (IAND(MCCPAR(JCCPT+1),KMD).NE.0) GO TO 45
- IQ(LDOAN) = IOR (IQ(LDOAN), MXCCIF)
-
-C-- check sequence existing
-
- CALL LOCKEEP (LACT)
- KACT = IQUEST(1)
-
-C-- T=APPEND?
- IF (LACT.NE.0) THEN
- IF (IAND(MCCPAR(JCCPT+1),KMA).EQ.0) GO TO 45
- IF (IAND(IQ(LACT+1),KM19).NE.0) GO TO 45
- IF (JCCIFV.NE.0) GO TO 45
-
- IQ(LACT+1) = IOR (IQ(LACT+1),KM19)
- LQ(LDOAN-3) = -LACT
- NEWFOR = NEWFOR + 1
- GO TO 76
- ENDIF
-
-C---- Create NIL sequence if IF deselected
-
- IFLNIL = 0
- IF (JCCIFV.EQ.0) GO TO 74
- IF (IAND(MXCCIF,NOT(MU_GLOB)).EQ.0) GO TO 45
-
- LPD = IQUEST(11)
- IF (LPD.NE.0) THEN
- IF (IAND(MXCCIF,NOT(IQ(LPD))).EQ.0) GO TO 45
- ENDIF
-
- IQ(LDOAN) = IOR (IQ(LDOAN), KM8)
- IFLNIL = KM12
-
-C---- Accepted sequence definition
-
- 74 NEWFOR = NEWFOR + 1
- IFLNOL = ISHFTL (IAND(MCCPAR(JCCPT+1),KMN),2)
- IXS = MCCPAR(JCCPZ+1)
-
-C-- we have to create the KEEP bank now to over-rule
-C- possible future re-definitions in the same deck
-
- CALL MQLIFT (LACT,KACT,0,JBKKEE,1)
-
- IQ(LACT) = IOR (IQ(LACT), IFLNIL+IFLNOL)
- IQ(LACT+4) = IXS
-
- LQ(LDOAN-3) = LACT
-
- IF (IFLNIL.NE.0) GO TO 45
- 76 CALL M_A3KE
- IF (LDOAN.EQ.0) GO TO 61
- IF (JCCBAD.NE.0) GO TO 45
- GO TO 22
-
-+SEQ, QEJECT.
-C----- Trouble
-
- 91 CALL FAILCC (0, 'Obsolete feature not implemented')
- GO TO 49
-
- 94 CALL FAILCC (0, 'Control line not allowed here')
- GO TO 49
-
- 95 CALL M_FAIL ('Implied target deck for action not defined')
- GO TO 48
- END
-+SEQ, QCARDL. =====================================================
-+DECK, M_A3IF.
- SUBROUTINE M_A3IF (IFSTEP)
-
-C- Content analysis stage 3:
-C- scan the PREP/MAT structure from the current +_IF to its
-C- terminating +_ENDIF and decide accept/reject.
-
-C- On entry LDOAN points to this +_IF, it has already been cracked;
-C- return LDOAN pointing to the end, and IFSTEP = 1 if LDOAN
-C- does point to the terminating +_ENDIF (preset =1 by M_ANA3),
-C- but for some error LDOAN points to some c/line which must still
-C- be analysed in M_ANA3, in this case set IFSTEP = 0;
-C- also: JCCBAD non-zero signals c/line with syntax error
-C. started 6-july-93
-
-+CDE, QBITA19, CCTYPE, CCPARA.
-+CDE, Q, PY.
-+CDE, M_ANAC.
-C-------------- End CDE --------------------------------
-
-+SEQ, Q_AND, Q_OR.
-
-
- IF (JCCTYP.GE.MCCELS) GO TO 93
- CALL CCIFLV
- IQ(LDOAN) = IOR (IQ(LDOAN), KM17)
- MODEAN = 1
- MAXLEV = 36
- LEVIF = 1
- INCLEV = LEVIF - JCCLEV
- IF (INCLEV.EQ.LEVAN) GO TO 25
- IF (LEVAN.EQ.7) THEN
- LEVAN = INCLEV
- GO TO 25
- ELSE
- CALL M_WNIF (LEVAN-INCLEV)
- ENDIF
- GO TO 25
-
-C------ accepted material
-
- 22 CALL M_A3NX
- IF (LDOAN.EQ.0) GO TO 94
- IF (JCCTYP.GE.MCCSEL) GO TO 94
- IF (JCCTYP.GE.MCCTRU) GO TO 24
- IF (JCCTYP.LT.MCCCDE) GO TO 22
-
-C-- handle accepted +CDE +SEQ
-
- IF (JCCTYP.NE.MCCXSQ) THEN
- CALL M_KRAK (1)
- IF (JCCBAD.NE.0) RETURN
- MEXAN = IOR (MEXAN,MXCCIF)
- IF (IAND(MCCPAR(JCCPT+1),KMD).NE.0) JCCIFV= 1
- ENDIF
-
- CALL M_A3SQ
- IF (JCCBAD.EQ.0) GO TO 22
- RETURN
-
-+SEQ, QEJECT.
-C-- new control
-
- 24 CALL M_KRAK (0)
- IF (JCCBAD.NE.0) RETURN
- CALL CCIFLV
-
- IF (JCCTYP.EQ.MCCELS) GO TO 26
- IF (JCCTYP.EQ.MCCEND) GO TO 28
-
-C-- handle +__IF
-
- CALL CCPROC
- LEVIF = LEVIF + 1
- N = JCCLEV+INCLEV - LEVIF
- IF (N.NE.0) CALL M_WNIF (N)
- IF (LEVIF.GE.MAXLEV) GO TO 92
- 25 MEXAN = IOR (MEXAN,MXCCIF)
- IF (JCCTYP.EQ.MCCFAL) JCCIFV= MAX(0, 1-JCCIFV)
- IF (JCCIFV.EQ.0) GO TO 22
- LVREND = LEVIF
- LVRELS = LEVIF + 1
- GO TO 41
-
-C-- handle +_ELSE, IF=xxx
-
- 26 N = JCCLEV+INCLEV - LEVIF
- IF (N.NE.0) CALL M_WNIF (N)
- LVREND = LEVIF
- LVRELS = LEVIF
- GO TO 41
-
-C-- handle +_ENDIF
-
- 28 N = JCCLEV+INCLEV - LEVIF
- IF (N.NE.0) CALL M_WNIF (N)
- LEVIF = LEVIF - 1
- IF (LEVIF.EQ.0) RETURN
- GO TO 22
-
-C------ rejected material
-
- 41 MBUSE = KM5
- 42 IQ(LDOAN) = IOR (IQ(LDOAN), MBUSE)
- MBUSE = KM6
- CALL M_A3NX
- IF (LDOAN.EQ.0) GO TO 94
- IF (JCCTYP.GE.MCCSEL) GO TO 94
- IF (JCCTYP.LT.MCCTRU) GO TO 42
-
-C-- new control
-
- CALL M_KRAK (0)
- IF (JCCBAD.NE.0) RETURN
- CALL CCIFLV
-
- IF (JCCTYP.EQ.MCCELS) GO TO 46
- IF (JCCTYP.EQ.MCCEND) GO TO 48
-
-C-- handle +__IF
-
- LEVIF = LEVIF + 1
- N = JCCLEV+INCLEV - LEVIF
- IF (N.NE.0) CALL M_WNIF (N)
- IF (LEVIF.GE.MAXLEV) GO TO 92
- GO TO 42
-
-C-- handle +_ELSE, IF=xxx
-
- 46 N = JCCLEV+INCLEV - LEVIF
- IF (N.NE.0) CALL M_WNIF (N)
- IF (LEVIF.GE.LVRELS) GO TO 42
- CALL CCPROC
- MEXAN = IOR (MEXAN,MXCCIF)
- IF (JCCIFV.NE.0) GO TO 41
- GO TO 22
-
-C-- handle +_ENDIF
-
- 48 N = JCCLEV+INCLEV - LEVIF
- IF (N.NE.0) CALL M_WNIF (N)
- LEVIF = LEVIF - 1
- IF (LEVIF.GE.LVREND) GO TO 42
- IF (LEVIF.EQ.0) RETURN
- GO TO 22
-
-C----- Trouble
-
- 94 CALL FAILCC (1, 'Non-terminated +_IF')
- IFSTEP = 0
- RETURN
-
- 93 IF (JCCTYP.EQ.MCCEND) THEN
- CALL FAILCC (0, 'Redundant +_ENDIF')
- RETURN
- ENDIF
-
- CALL M_FAIL ('Unmatched +_ELSE')
- RETURN
-
- 92 CALL M_FAIL ('Maximum +_IF nesting level exceeded')
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, M_A3SQ.
- SUBROUTINE M_A3SQ
-
-C- Service routine to M_ANA3, content analysis stage 3:
-C- ready sequence call bank for +CDE +SEQ or +SELF,sname
-C- connecting the called sequences ready for use.
-C- Return IQUEST(1) zero except for +SELF, sname with
-C- sequence sname existing, when the default self material
-C- has to be ignored.
-C. started 15-dec-91
-
-+CDE, QBITS19, CCTYPE, CCPARA, INCLC, Q, PY.
-+CDE, M_ANAC.
-C-------------- End CDE --------------------------------
-
-+SEQ, Q_AND, Q_OR.
-
-
-C-- MODEAN = 0 ordinary self 1 IF-conditional self
-C-- 2 +SELF,sname (3 +REPL,+ADB,+ADD)
-
- ICODE = 0
- IF (JCCTYP.EQ.MCCXSQ) GO TO 37
-
- IF (JCCIFV.NE.0) THEN
- IQ(LDOAN) = IOR (IQ(LDOAN), KM5)
- IQUEST(1) = 1
- RETURN
- ENDIF
- IF (JCCTYP.LE.MCCINC) GO TO 61
-
- LOSTNZ = 0
- IF (MODEAN.NE.2) GO TO 31
-
-C---- handle +SELF, sname
-
-C- - if self material of this deck:
-C- "sname" exists: replace PREP bank by a new XSQ bank
-C- not existing: change type of the PREP bank to MCCSEL
-C-
-C- - if material into this deck:
-C- the MAT bank is already a XSQ
-C- "sname" exists: use it
-C- not existing: change type of the PREP bank to MCCSEL
-
- IF (LUPAN.NE.0) THEN
- IXSQ = IQ(LDOAN+5)
- ELSE
- IXSQ = MCCPAR(JCCPZ+1)
- ENDIF
-
- KP = LEXP - 3
- KD = 0
- IF (LEXD.NE.0) KD= LEXD-3
-
- CALL LOCSEQ (L, IXSQ,KP,KD)
- IF (L.EQ.0) GO TO 49
-
-C-- sequence exists
-
- ICODE = 7
-
-+SEQ, QEJECT, N=17.
-C---- lift XSQ bank to replace the PREP bank
-
-C- LIFTSQ (kjoin, cc-type to be stored,
-C- JSL of line to be cracked if non-zero, division)
-
- 31 IF (LUPAN.NE.0) GO TO 37
- LSQ = LIFTSQ (KDOAN, JCCTYP, 0,2)
- LOSTNZ = IQUEST(1)
-
- LQ(LSQ-1) = LQ(LDOAN-1)
- IQ(LSQ) = IOR (IQ(LSQ), IAND(IQ(LDOAN),KM5-1))
- IQ(LSQ+1) = IQ(LDOAN+1)
- IQ(LSQ+2) = 1
- IQ(LSQ+3) = IQ(LDOAN+1) - JSLORG
-
- LDOAN = LSQ
- IF (LOSTNZ.NE.0) GO TO 39
-
-C-- connect all sequences called
-
- 37 MX = LINKSQ (LDOAN,0)
- MEXAN = IOR (MEXAN,MX)
- IQUEST(1) = ICODE
- RETURN
-
-C---- Trouble
-
- 39 CALL M_FAIL ('More than 61 sequence calls on this line')
- RETURN
-
-C---- sequence not defined, convert to ordinary +SELF
-
- 49 CALL SBYT (MCCSEL, IQ(LDOAN),9,6)
- IQUEST(1) = 0
- RETURN
-
-C------ Handle +INCLUDE, sname
-
- 61 IF (JCCTYP.EQ.MCCKIL) RETURN
- 62 IXSQ = MCCPAR(JCCPZ+1)
- IF (N_INCL.GE.100) GO TO 66
- N_INCL = N_INCL + 1
- IX_INCL(N_INCL) = IXSQ
-
- LINCL = LQFIND (IXSQ,1,LQINCL)
- IF (LINCL.EQ.0) GO TO 66
- MEXAN = IOR (MEXAN,IQ(LINCL))
- IF (IAND(IQ(LINCL),KM5).EQ.0) GO TO 67
-
- 66 NEWINC = 1
- 67 JCCPZ = JCCPZ + 3
- NCCPZ = NCCPZ - 1
- IF (NCCPZ.GT.0) GO TO 62
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, M_A3NX.
- SUBROUTINE M_A3NX
-
-C- Service routine to M_ANA3, content analysis stage 3:
-C- step to next non-deleted bank, set JCCTYP
-C- activating delayed control lines now used in self material.
-C. started 26-nov-91
-
-+CDE, QBITS19, CCTYPE, CCPARA, Q, PY.
-+CDE, M_ANAC.
-C-------------- End CDE --------------------------------
-
- PARAMETER (MASKTY=KM9+KM10+KM11+KM12+KM13+KM14)
-
-+SEQ, Q_JBYT, Q_AND, Q_OR, Q_NOT, Q_SHIFTL.
-
-
-+SEQ, xM_ANAC, IF=DOC_INL.
-
-C------ Next PREP bank
-
- IF (LUPAN.NE.0) GO TO 34
- 22 KDOAN = LDOAN - 1
- LDOAN = LQ(KDOAN)
- IF (LDOAN.EQ.0) RETURN
- IF (IAND(IQ(LDOAN),KM5+KM6).NE.0) GO TO 22
-
-C-- next live PREP bank
-
- L = LQ(LDOAN-2)
- IF (L.NE.0) GO TO 31
- JCCTYP = JBYT (IQ(LDOAN),9,6)
- RETURN
-
-+SEQ, QEJECT, N=56
-C---- Follow reference to foreign material
-
- 31 LOWAN = LDOAN
- LUPAN = L
- LDOAN = LUPAN - 1
-
-C------ Next MAT bank
-
- 34 KDOAN = LDOAN - 1
- LDOAN = LQ(KDOAN)
- IF (LDOAN.EQ.0) THEN
-C-- end of chain of MAT banks
- LDOAN = LOWAN
- LUPAN = 0
- GO TO 22
- ENDIF
-
- JCCTYP = JBYT (IQ(LDOAN),9,6)
- IF (MOPUPD.LT.0) GO TO 61
-C! IF (MODEAN.EQ.4) RETURN
-
-C-- activate delayed c/l now used in self or KEEP material
-
- IF (IAND(IQ(LDOAN),KM15).EQ.0) RETURN
- JSLA = IQ(LDOAN+1)
- JTX = MLIAD(JSLA)
- TEXT(JTX) = '+'
- JTYPE = JPTYPE(TEXT(JTX))
- IF (MOPUPD.NE.0) THEN
- IF (JTYPE.LT.MCCSEL) RETURN
- ENDIF
- JCCTYP = JTYPE
- IQ(LDOAN) = IOR (IQ(LDOAN),ISHFTL(JCCTYP,8))
- RETURN
-
-C-- +PAM, T=UP update mode
-
- 61 IF (JCCTYP.EQ.0) GO TO 62
- IF (JCCTYP.EQ.MCCXSQ) RETURN
- JCCTYP = 0
- IQ(LDOAN) = IAND (IQ(LDOAN),NOT(MASKTY))
-
- 62 JSLA = IQ(LDOAN+1)
- JSLE = IQ(LDOAN+2) + JSLA
- 64 CALL NEXTCC ('-',JSLA,JSLE,JSLF,JTYPE)
- IF (JTYPE.EQ.0) RETURN
- JTX = MLIAD(JSLF)
- TEXT(JTX) = '+'
- JSLA = JSLF + 1
- IF (JSLA.LT.JSLE) GO TO 64
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, M_A3KE.
- SUBROUTINE M_A3KE
-
-C- Content analysis stage 3:
-C- scan the material of the +KEEP being defined
-C- return JCCBAD non-zero to signal c/line with syntax error at LDOAN
-C. started 8-dec-93
-
-+CDE, CCTYPE, CCPARA.
-+CDE, Q, PY.
-+CDE, M_ANAC.
-C-------------- End CDE --------------------------------
-
-
- MAXLEV = 36
- LEVIF = 0
-
- 22 CALL M_A3NX
- IF (LDOAN.EQ.0) GO TO 49
- IF (JCCTYP.GE.MCCSEL) GO TO 49
- IF (JCCTYP.LT.MCCCDE) GO TO 22
- IF (JCCTYP.EQ.MCCXSQ) GO TO 22
-
- CALL M_KRAK (0)
- IF (JCCBAD.NE.0) RETURN
- IF (JCCTYP.LT.MCCTRU) GO TO 22
-
-C-- new control
-
- CALL CCIFLV
-
- IF (JCCTYP.EQ.MCCELS) GO TO 26
- IF (JCCTYP.EQ.MCCEND) GO TO 28
-
-C-- handle +__IF
-
- LEVIF = LEVIF + 1
- IF (LEVIF.GE.2) GO TO 24
- INCLEV = LEVIF - JCCLEV
- IF (INCLEV.EQ.LEVAN) GO TO 22
- IF (LEVAN.EQ.7) THEN
- LEVAN = INCLEV
- ELSE
- CALL M_WNIF (LEVAN-INCLEV)
- ENDIF
- GO TO 22
-
- 24 N = JCCLEV+INCLEV - LEVIF
- IF (N.NE.0) CALL M_WNIF (N)
- IF (LEVIF.GE.MAXLEV) GO TO 91
- GO TO 22
-
-C-- handle +_ELSE, IF=xxx
-
- 26 IF (LEVIF.EQ.0) GO TO 92
- N = JCCLEV+INCLEV - LEVIF
- IF (N.NE.0) CALL M_WNIF (N)
- GO TO 22
-
-C-- handle +_ENDIF
-
- 28 IF (LEVIF.EQ.0) GO TO 93
- N = JCCLEV+INCLEV - LEVIF
- IF (N.NE.0) CALL M_WNIF (N)
- LEVIF = LEVIF - 1
- GO TO 22
-
-+SEQ, QEJECT.
-C---- Done
-
- 49 IF (LEVIF.EQ.0) RETURN
-
-C----- Trouble
-
- CALL FAILCC (1, 'Non-terminated +_IF')
- RETURN
-
- 93 CALL FAILCC (0, 'Redundant +_ENDIF')
- GO TO 22
-
- 92 CALL M_FAIL ('Unmatched +_ELSE')
- RETURN
-
- 91 CALL M_FAIL ('Maximum +_IF nesting level exceeded')
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, M_A3AC.
- SUBROUTINE M_A3AC
-
-C- Content analysis stage 3:
-C- scan the material of the +REPL etc being defined
-C- return JCCBAD non-zero to signal c/line with syntax error at LDOAN
-C. started 8-dec-93
-
-+CDE, CCTYPE, CCPARA.
-+CDE, Q.
-+CDE, M_ANAC.
-C-------------- End CDE --------------------------------
-
-
- 22 CALL M_A3NX
- IF (LDOAN.EQ.0) RETURN
- IF (JCCTYP.GE.MCCSEL) RETURN
- IF (JCCTYP.LT.MCCKIL) GO TO 22
- IF (JCCTYP.EQ.MCCXSQ) GO TO 22
-
- CALL M_KRAK (0)
- IF (JCCBAD.NE.0) RETURN
- GO TO 22
-C!
-C!- check delayed control-cards for +REPL +ADB +ADD
-C!
-C! 78 JSLA = IQ(LDOAN+1)
-C! JSLE = JSLA + IQ(LDOAN+2)
-C! JSLG = JSLA
-C! 79 IF (JSLG.GE.JSLE) GO TO 77
-C! CALL NEXTCC ('-',JSLG,JSLE,JSLF,JCCTYP)
-C! IF (JCCTYP.EQ.0) GO TO 77
-C! JSLG = JSLF + 1
-C! IF (JCCTYP.EQ.MCCNIL) GO TO 79
-C! CALL CCKRAK (JSLF)
-C! IF (JCCBAD.EQ.0) GO TO 79
-C! IF (JSLF.NE.JSLA) LDOAN = M_SPLIT (LDOAN,JSLF)
-C! CALL FAILCC (1, 'Bad syntax for delayed c/l')
-C! GO TO 79
- END
-+SEQ, QCARDL. =====================================================
-+DECK, M_SPLIT.
- FUNCTION M_SPLIT (LDO,JSLN)
-
-C- Split PREP bank in division 2 into two:
-
-C- if JSLN not zero: scan the linear structure of PREP banks
-C- starting at LDO to find the bank which supports the line
-C- at slot JSLN; if this is not the first line split this
-C- bank into two to make JSLN the first line in the new bank;
-C- return the adr of the bank with JSLN, or zero if not found.
-
-C- if JSLN is zero: split the bank at LDO leaving zero lines
-C- in the old bank, transfer the properties of the old to the
-C- new bank; return the adr of the new bank.
-C# started 11-nov-91
-
-+CDE, QBITS19, QBANKS.
-+CDE, QSH.
-C-------------- End CDE --------------------------------
-
-
- L = LDO
- IF (JSLN.EQ.0) GO TO 41
- GO TO 22
-
- 21 L = LQ(L-1)
- IF (L.EQ.0) GO TO 49
- 22 JSLA = IQ(L+1)
- JSLE = IQ(L+2) + JSLA
- IF (JSLN.GE.JSLE) GO TO 21
- IF (JSLN.EQ.JSLA) GO TO 49
-+SELF, IF=QDEBUG.
- IF (JSLN.LT.JSLA) CALL P_CRASH ('trouble in M_SPLIT')
-+SELF.
- NSLA = JSLN - JSLA
- NSLN = JSLE - JSLN
-
- CALL MQLIFT (LX,L,-1,JBKPRE,2)
- IQ(L+2) = NSLA
- L = LX
- IQ(L+1) = JSLN
- IQ(L+2) = NSLN
- GO TO 49
-
-C-- split on first line with transfer of properties
-C- (to insert a zero-line PREP reference to ACT for +REPL etc)
-
- 41 CALL MQLIFT (LX,L,-1,JBKPRE,2)
-
- IQ(LX) = IQ(L)
- IQ(LX+1) = IQ(L+1)
- IQ(LX+2) = IQ(L+2)
- IQ(L+2) = 0
- L = LX
-
- 49 M_SPLIT = L
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, M_KRAK.
- SUBROUTINE M_KRAK (IFPROC)
-
-C- Crack control line at LDOAN for M_ANA3 and M_A3IF;
-C- do not/do the IF= evaluation if IFPROC = 0/1
-C- if faulty control found:
-C- change c/c type to FAULTY and print the line
-C. started 29-nov-93
-
-+CDE, CCPARA, Q, PY.
-+CDE, M_ANAC.
-C-------------- End CDE --------------------------------
-
-
- CALL CCKRAK (IQ(LDOAN+1))
- IF (JCCBAD.NE.0) GO TO 41
- IF (IFPROC.NE.0) THEN
- IF (NCCPIF.NE.0) CALL CCPROC
- ENDIF
- IF (JCCWAR.EQ.0) RETURN
-
-C: DATA CHWA( 1) /'obsured dot in control line'/
-C: DATA CHWA( 2) /'control line ends on comma'/
-
- IF (JCCWAR.EQ.1) THEN
- IF (MOPTIO(2).NE.0) RETURN
- CALL FAILCC (0, 'obsured dot in control line')
- ELSE
- CALL FAILCC (0, 'control line ends on comma')
- ENDIF
- RETURN
-
-C-- faulty c/line
-
- 41 CALL M_FAIL ('Syntax error')
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, M_FAIL.
- SUBROUTINE M_FAIL (MSG)
-
-C- Faulty control found with M_ANA3:
-C- print the line, change c/c type to FAULTY, set JCCBAD
-C. started 29-nov-93
-
-+CDE, QBITS19, CCTYPE, CCPARA, Q, PY.
-+CDE, M_ANAC.
-C-------------- End CDE --------------------------------
- CHARACTER MSG*(*)
-
-+SEQ, Q_OR.
-
-
- CALL FAILCC (1,MSG)
-
- CALL SBYT (MCCFAU, IQ(LDOAN),9,6)
- IQ(LDOAN) = IOR (IQ(LDOAN),KM5)
- JCCBAD = 7
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, M_WNIF, T=JOIN.
- SUBROUTINE M_WNIF (NU)
-
-C- Print warning for wrong number of underscores
-C. started 9-dec-91
-
- CHARACTER MSG*22
- DATA MSG /' 0 underscore too many'/
-C- DATA MSG /' 0 underscore missing '/
-C- _:.=+=.: 1_:.=+=.: 2_:.=
-
-
- CALL DPHEAD
-
- N = NU
- IF (N.LT.0) THEN
- N = -N
- MSG(15:22) = 'missing '
- ELSE
- MSG(15:22) = 'too many'
- ENDIF
-
- MSG(1:2) = ' '
- CALL CSETDI (N,MSG,1,2)
-
- CALL FAILCC (0,MSG)
- END
-+SEQ, QCARDL. =====================================================
-+DECK, MK_NIL.
- SUBROUTINE MK_NIL
-
-C- Store NIL sequences or actions into division 1 to carry the
-C- EXE bits of deleted material to the deck where it would have
-C- appeared. For this we have to scan the de-selected PREP banks.
-C. started 9-dec-91
-
-+CDE, QBITA19, QBANKS, CCTYPE, CCPARA, MUSEBC.
-+CDE, KQADR, Q, PY.
-+CDE, M_ANAC.
-C-------------- End CDE --------------------------------
-
-+SEQ, Q_JBYT, Q_AND, Q_OR, Q_NOT, Q_SHIFTL.
-
-
- LDO = KQPREP + 1
-
-C------ Find next deleted foreign material
-
- 21 LDO = LQ(LDO-1)
- IF (LDO.EQ.0) RETURN
- IF (IQ(LDO+2).EQ.0) GO TO 21
- IF (IAND(IQ(LDO),KM5+KM6).EQ.0) GO TO 21
-
- JCCTYP = JBYT (IQ(LDO),9,6)
- IF (JCCTYP.LT.MCCKEE) GO TO 21
- IF (JCCTYP.GE.MCCUSE) GO TO 21
-
- CALL CCKRAK (IQ(LDO+1))
- IF (JCCBAD.NE.0) GO TO 21
- MEXACT = IAND (IQ(LDO),15)
-
- IF (JCCTYP.NE.MCCKEE) GO TO 41
-
-+SEQ, QEJECT, N=32.
-C---------- Handle +KEEP --------------------
-
- IF (IAND(MCCPAR(JCCPT+1),KMD).NE.0) GO TO 21
- IF (IAND(MEXACT,NOT(MU_GLOB)).EQ.0) GO TO 21
-
-C-- inquire existence, get the attachment adr if not pre-existing
-
- 34 CALL LOCKEEP (LSQ)
- IF (LSQ.NE.0) GO TO 21
- KACT = IQUEST(1)
- LPD = IQUEST(11)
-
- IF (LPD.NE.0) THEN
- IF (IAND(MEXACT,NOT(IQ(LPD))).EQ.0) GO TO 21
- ENDIF
-
-C-- lift the KEEP bank
-
- IF (LDECO.EQ.0) CALL CRDECO
- CALL MQLIFT (LACT,KACT,0,JBKKEE,1)
-
- IQ(LACT) = IOR (IQ(LACT), MEXACT+KM12)
- LQ(LACT-3) = LDECO
- IQ(LACT+3) = IQ(LDO+1) - JSLORG
- IQ(LACT+4) = MCCPAR(JCCPZ+1)
- GO TO 21
-
-C---------- Handle +DEL +REPL +ADB +ADD --------------------
-
- 41 LPD = LQ(LDO-3)
- IF (LPD.EQ.0) GO TO 21
- IF (LPD.EQ.LEXD) GO TO 21
-
- IF (IAND(MEXACT,NOT(IQ(LPD))).EQ.0) GO TO 21
- JACT = JCCTYP - MCCDEL
-
-C-- lift the ACT bank
-
- IF (LDECO.EQ.0) CALL CRDECO
- 47 CALL MQLIFT (LACT,LPD,-2,JBKACT,1)
-
- IQ(LACT) = IOR (IQ(LACT), MEXACT+KM12)
- IQ(LACT) = IOR (IQ(LACT), ISHFTL(JACT,8))
-
- LQ(LACT-3) = LDECO
- IQ(LACT+3) = IQ(LDO+1) - JSLORG
- IQ(LACT+4) = MCCPAR(JCCPC+1)
- IQ(LACT+5) = MCCPAR(JCCPC+2)
- IF (JCCTYP.EQ.MCCDEL) GO TO 48
-
-C-- check whether the action starts with ordinary material
-
- JSLF = IQ(LDO+1) + 1
- JTXF = MLIAD(JSLF)
- IF (TEXT(JTXF).NE.'-') GO TO 21
- IF (JPTYPE(TEXT(JTXF)).LT.MCCSEL) GO TO 21
- IQ(LACT) = IOR (IQ(LACT), KM16)
- GO TO 21
-
-C-- handle multiple deletes
-
- 48 IQ(LACT) = IOR (IQ(LACT), KM16)
- NCCPC = NCCPC - 1
- IF (NCCPC.EQ.0) GO TO 21
- JCCPC = JCCPC + 3
- GO TO 47
- END
-+SEQ, QCARDL. =====================================================
-+PATCH, DOXQT. Output control for the current deck
-+DECK, DOXQT.
- SUBROUTINE DOXQT
-
-C- Execute the material according to the map
-C. started 16-jan-92
-
-+CDE, QBITS31, QUNIT.
-+CDE, CCTYPE, CCPARA, CHEXC, DEPCOM, MUSEBC.
-+CDE, KQADR, Q, PY.
-+CDE, M_ANAC.
-C-------------- End CDE --------------------------------
-
- PARAMETER (MASKCL=KM12+KM13+KM14+KM15)
-
-+SEQ, Q_JBYT, Q_AND.
-
-+SELF, IF=XDEBUG, IF=XLOGCALL.
- PRINT *, 'Xdebug: arriving in DOXQT'
-+SELF, IF=XDEBUG, IF=XDDSNAP.
- CALL DDSNAP ('start of DOXQT',0,2)
-+SELF.
-
-C! NDONE = -1
- LUPAN = 0
- LDOAN = KQPREP + 1
-
-C---- Next bank
-
- 20 MODEAN = 0
- 21 CALL X_NEXT
-C! NDONE = NDONE + 1
- 22 IF (LDOAN.EQ.0) GO TO 87
-
-+SEQ, QEJECT.
-C-- MODEAN = 0 self material
-C- 1 CDE expansion
-C- 2 comment line
-C- 3 +SELF header line
-C- 4 +CDE call line
-C- 5 foreign material
-C- 6 control line
-
- JCCTYP = JBYT (IQ(LDOAN),9,6)
- IF (JCCTYP.GE.MCCKEE) GO TO 51
- IF (JCCTYP.EQ.MCCKIL) GO TO 51
-
-C---------- Self material ----------------
-
- IF (NVEXDK(5).EQ.0) GO TO 21
-
- KKM5AN = IAND(IQ(LDOAN),KM5)
- IF (JCCTYP.EQ.0) GO TO 35
- IF (JCCTYP.EQ.MCCNIL) GO TO 39
- IF (JCCTYP.LE.MCCINC) GO TO 56
- IF (JCCTYP.LE.MCCXSQ) GO TO 36
- IF (JCCTYP.LT.MCCSEL) GO TO 35
-
-C-- to here +SELF, +SKIP and fault
-
- IF (JCCTYP.EQ.MCCSES) GO TO 37
- MODEAN = 3
-
-C-- to here +_IF etc
-
- 35 IF (NVEXDK(2).NE.0) THEN
- CALL DPLIST (MODEAN,LDOAN,LUPAN,0)
- ENDIF
-
- IF (NVEXDK(1).EQ.0) GO TO 20
- IF (KKM5AN.NE.0) GO TO 20
- CALL DPEXE (LDOAN)
- GO TO 20
-
-C-- sequence call
-
- 36 IF (JCCTYP.EQ.MCCXSQ) GO TO 38
- 37 IF (NVEXDK(6).NE.0) THEN
- MODEAN = 4
- CALL DPLIST (MODEAN,LDOAN,LUPAN,0)
- ENDIF
-
- 38 IF (KKM5AN.NE.0) GO TO 20
- MODEAN = 1
- CALL X_SEQ (LDOAN)
- GO TO 20
-
-C-- comment line
-
- 39 IF (NVEXDK(6).EQ.0) GO TO 21
- CALL DPLIST (2,LDOAN,LUPAN,1)
- GO TO 21
-
-C---------- New foreign material --------------
-
- 51 KKM5AN = IAND(IQ(LDOAN),KM5)
- IF (JCCTYP.GE.MCCUSE) GO TO 56
- IF (JCCTYP.LT.MCCKEE) GO TO 56
-
- MODEAN = 5
- IF (NVEXDK(2).NE.0) CALL DPLIST (MODEAN,LDOAN,LUPAN,1)
-
- CALL DOFORG (NSTEP)
- MODEAN = 0
- IF (NSTEP.EQ.0) GO TO 22
- GO TO 21
-
-C---------- Lines +DECK or +PATCH --------------
-
- 56 MODEAN = 6
- CALL CCKRAK (IQ(LDOAN+1))
- IF (NVEXDK(6).NE.0) THEN
- CALL DPLIST (MODEAN,LDOAN,LUPAN,1)
- IF (JCCTYP.GE.MCCPAT) NQLPAT = NQUSED
- ENDIF
-
- IF (KKM5AN.NE.0) GO TO 20
- IF (JCCTYP.LT.MCCDEC) GO TO 61
-C! IF (NDONE.EQ.0) GO TO 20
- IF (NVEXDK(1).EQ.0) GO TO 20
-
- IF (JD_NEW.EQ.0) CALL DPEXTM (1)
-
- JASM = JBYT (IQ(LDOAN),21,6)
-
- IF (JCCTYP.EQ.MCCPAT) THEN
- IXEXID = MCCPAR(JCCPP+1)
- JD_DTN = MAX (JASM,1)
- JD_DTP = JD_DTN
- ELSEIF (JCCTYP.EQ.MCCDEC) THEN
- IXEXID = MCCPAR(JCCPD+1)
- JD_DTN = JASM
- IF (JD_DTN.EQ.0) JD_DTN= JD_DTP
- ENDIF
- GO TO 20
-
-+SEQ, QEJECT.
-C---------- Control lines +USE etc ---------------
-
- 61 IF (JCCTYP.GE.MCCUSE) GO TO 64
-
-C-- Do : +INCLUDE
-
- IF (JCCTYP.EQ.MCCINC) THEN
- CALL X_INCL (0)
- GO TO 20
- ENDIF
-
-C-- Do : +KILL
-
- CALL P_FATAL (CCKORG(1:NCHCCT))
-
-C-- Done : +USE etc if not in CRA*
-
- 64 IF (JCCTYP.LE.MCCEXE) THEN
- IF (INCRAD.LT.2) GO TO 20
-
-C-- Do : +USE +EXE +LIST +DIVERT +XDIV
-
- CALL X_USE
- GO TO 20
- ENDIF
-
-C-- Do : +IMITATE
-
- IF (JCCTYP.EQ.MCCIMI) THEN
- CALL X_IMIT
- GO TO 20
- ENDIF
-
-C-- Do : +ASM
-
- IF (JCCTYP.EQ.MCCASM) THEN
- CALL X_ASM
- GO TO 20
- ENDIF
-
-C-- Done : +UPDATE +NAMES +GAPS +MORE
-
- IF (JCCTYP.LE.MCCMOR) GO TO 20
-
-C!- Do : +ONLY
-C!
-C! IF (JCCTYP.EQ.MCCONL) THEN
-C! CALL X_ONLY (LDOAN)
-C! GO TO 20
-C! ENDIF
-
-C-- Do : +FORCE +SUSPEND
-
- IF (JCCTYP.LE.MCCSUS) THEN
- CALL X_USE
- GO TO 20
- ENDIF
-
-C-- Do : +OPTION +PARAMETER +SHOW
-
- IF (JCCTYP.LE.MCCSHO) THEN
- CALL X_OPT
- GO TO 20
- ENDIF
-
-+SELF, IF=QDEBUG.
- CALL P_CRASH ('DOXQT should not reach this point')
-+SELF.
-
-C---- Done
-
- 87 CONTINUE
-+SELF, IF=XDEBUG, IF=XDDSNAP.
- PRINT *, 'Xdebug: deck processing complete, dump the result'
- IF (NEWFOR.EQ.0) RETURN
- CALL DDSNAP ('end of DOXQT',-1,1)
-C! CALL DDSNAP ('end of DOXQT',-1,3)
-+SELF.
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, X_NEXT.
- SUBROUTINE X_NEXT
-
-C- Step to next bank in the PREP chain for DOXQT
-C. started 18-nov-93
-
-+CDE, QBITS19, Q.
-+CDE, M_ANAC.
-C-------------- End CDE --------------------------------
-
-+SEQ, Q_AND.
-
-
- IF (LUPAN.NE.0) GO TO 34
- 22 LDOAN = LQ(LDOAN-1)
- IF (LDOAN.EQ.0) RETURN
-
-C-- next PREP bank
-
- L = LQ(LDOAN-2)
- IF (L.NE.0) GO TO 31
- IF (IAND(IQ(LDOAN),KM6).NE.0) GO TO 22
- RETURN
-
-C---- Follow reference to foreign material
-
- 31 LOWAN = LDOAN
- LUPAN = L
-
-C-- list what action
-
- CALL DPLACT
- IF (IAND(IQ(LDOAN),KM6).NE.0) GO TO 37
-
-C-- Next MAT bank
-
- LDOAN = LUPAN - 1
- 34 LDOAN = LQ(LDOAN-1)
- IF (LDOAN.EQ.0) GO TO 37
- IF (IAND(IQ(LDOAN),KM6).NE.0) GO TO 34
- RETURN
-
-C-- restart on the PREP chain
-
- 37 LDOAN = LOWAN
- LUPAN = 0
- GO TO 22
- END
-+SEQ, QCARDL. =====================================================
-+DECK, X_SEQ.
- SUBROUTINE X_SEQ (LXQT)
-
-C- Send the sequences called from bank LXQT to output.
-C. started 21-jan-92
-
-+CDE, QBITS19, CCTYPE, CCPARA, MUSEBC, TAGC.
-+CDE, Q, PY.
-C-------------- End CDE --------------------------------
- PARAMETER (NOFFLI=2, NOFFDA=4)
- PARAMETER (MAXLEV=36)
- COMMON /MSAVEC/ MSAVE(5,MAXLEV)
-
-+SEQ, Q_JBYT, Q_AND.
-
-
- IFLNHI = 0
- IFLNOL = 1 - NVEXDK(2)
-
- LEVK = 0
- LCSQ = LXQT
-
- LNACT = 0
- LLACT = 0
-
-C---- New XSQ bank
-
- 21 JSEQ = 0
- NSEQ = IQ(LCSQ+NOFFDA)
- IFLPAS = IAND (IQ(LCSQ),KM16)
- 22 JSEQ = JSEQ + 1
- IF (JSEQ.GT.NSEQ) GO TO 37
- IXSEQ = IQ(LCSQ+JSEQ+NOFFDA)
- LKEEP = IABS (LQ(LCSQ-JSEQ-NOFFLI))
- IF (LKEEP.NE.0) GO TO 24
-
-C-- missing sequence
- IF (IFLPAS.NE.0) GO TO 22
- CALL DPLMSQ (IXSEQ)
- GO TO 22
-
-+SEQ, QEJECT.
-
-C-- Output of the KEEP bank itself
-
- 24 IF (NVEXDK(2).NE.0) IFLNOL= MAX (IFLNHI, IAND (IQ(LKEEP),KM16))
-
-C-- ready special sequence
-
- IF (IAND(IQ(LKEEP),KM13).NE.0) THEN
- CALL X_SEQSP (IQ(LCSQ+1), IXSEQ, IFSEND)
- IF (IFSEND.EQ.0) GO TO 22
- GO TO 25
- ENDIF
-
-C-- be sure the sequence is ready for output
-
- IF (IAND(IQ(LKEEP),KM5).EQ.0) MX= LINKSQ (0,LKEEP)
-
- 25 JCCTYP = 0
- IF (IFLNOL.EQ.0) THEN
- LLORG = 0
- LNORG = LQ(LKEEP-3)
- CALL DPTAG (2,LEVK,IXSEQ)
-
- IF (IQ(LKEEP+2).NE.0) GO TO 27
- LNX = LQ(LKEEP-2)
- IF (LNX.EQ.0) THEN
- NCHTAG = 0
- GO TO 22
- ENDIF
-
- IF (LQ(LNX-2).EQ.LLORG) THEN
- IFLST = LEVK+1
- GO TO 28
- ENDIF
-
- 27 IFLST = 0
- CALL DPLIST (1,LKEEP,0,LEVK+1)
- ENDIF
-
- IF (NVEXDK(1).NE.0) CALL DPEXE (LKEEP)
-
-C-- Output of continuation MAT banks
-
- 28 LDO = LKEEP - 1
- 29 LDO = LQ(LDO-1)
- IF (LDO.EQ.0) GO TO 22
-
- IF (IFLNOL.EQ.0) THEN
- LNORG = LQ(LDO-2)
- LVINC = JBYT(IQ(LDO),21,5)
- IF (LVINC.EQ.0) THEN
- IF (IFLST.EQ.0) CALL DPTAG (2,LEVK,0)
- ELSE
- IF (LNORG.NE.LLORG) THEN
- CALL DPTAG (0,LEVK+LVINC,0)
- ENDIF
- ENDIF
- CALL DPLIST (1,LDO,0,IFLST)
- IFLST = 0
- ENDIF
-
- JCCTYP = JBYT (IQ(LDO),9,6)
- IF (JCCTYP.GE.MCCCDE) GO TO 31
- IF (NVEXDK(1).EQ.0) GO TO 29
- IF (JCCTYP.EQ.MCCINC) GO TO 30
- IF (JCCTYP.NE.0) GO TO 29
- CALL DPEXE (LDO)
- GO TO 29
-
- 30 CALL X_INCL (LDO)
- GO TO 29
-
-C---- new sequence call bank, step level up by one
-
- 31 LEVK = LEVK + 1
- MSAVE(1,LEVK) = LCSQ
- MSAVE(2,LEVK) = LDO
- MSAVE(3,LEVK) = JSEQ
- MSAVE(4,LEVK) = IFLNHI
- MSAVE(5,LEVK) = IFLNOL
- IFLNHI = IFLNOL
- LCSQ = LDO
- GO TO 21
-
-C---- end of doing this sequence call bank, step level down
-
- 37 IF (LEVK.EQ.0) GO TO 39
-
- LCSQ = MSAVE(1,LEVK)
- LDO = MSAVE(2,LEVK)
- JSEQ = MSAVE(3,LEVK)
- IFLNHI = MSAVE(4,LEVK)
- IFLNOL = MSAVE(5,LEVK)
- LEVK = LEVK - 1
-
- NSEQ = IQ(LCSQ+NOFFDA)
- IFLPAS = IAND (IQ(LCSQ),KM16)
- GO TO 29
-
- 39 NCHTAG = 0
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, X_SEQSP.
- SUBROUTINE X_SEQSP (JSL,IXSEQ,IFSEND)
-
-C- Ready special sequence called
-C- input: JSL slot number of the calling control-line
-C- IXSEQ sequence name index
-C- output: IFSEND = 0 no output to be sent
-C- > 0 output
-C. split off from X_SEQ 23-aug-95
-
-+CDE, SLATE, SLATLN, QCHAR, QPAGE, QUNIT, QSTATE.
-+CDE, CCPARA, CHEXC, DEPCOM, JSPSEQ, MUSEBC.
-+CDE, TITLEC, USETTC.
-+CDE, Q, PY.
-C-------------- End CDE --------------------------------
-
- CHARACTER LINE*128, LIMSK*128, LITIT*128, CHESC*1
- EQUIVALENCE (LINE,TEXT), (LIMSK,CCCOMF), (LITIT,SLERRM)
-
-+SEQ, xJSPSEQ, IF=DOC_INL.
-+SEQ, QEJECT.
-
- JTX = MLIAD(JSL)
- JCCTYP = JPTYPE (TEXT(JTX))
- CALL CCKRAK (JSL)
- NNN = MCCPAR(JCCPN+1)
- LLL = MCCPAR(JCCPC+1)
- JCASE = IXSEQ - JSPSEQ1 - 1
- IF (JCASE.GE.1) GO TO 51
- IF (JCASE.EQ.0) GO TO 44
-
-C-- handle +SEQ, QCARD1, R=name
-
- IF (JCCPD.EQ.0) GO TO 49
- IX = MCCPAR(JCCPD+1)
- IF (IX.LE.2) GO TO 49
- IF (NVEXDK(1).NE.0) THEN
- IF (JD_NEW.EQ.0) CALL DPEXTM (-1)
- ENDIF
- IXEXID = IX
- GO TO 49
-
-C-- handle +SEQ, QEJECT, N=n
-
- 44 IF (NVEXDK(2).EQ.0) GO TO 49
- IF (MOPTIO(5).EQ.0) GO TO 49
- IF (MOPTIO(3).NE.0) GO TO 49
- IF (NNN.LT.0) NNN = NQLMAX
- IF (NNN.EQ.0) NNN = NQLMAX - 6
- IF (NQUSED+NNN.LE.NQLMAX) GO TO 49
- NQUSED = NQLMAX
-
- 49 IFSEND = 0
- RETURN
-
-C------ handle +SEQ, QFxxx, QDATE, QTIME
-
- 51 CHESC = '?'
-
-C---- ready LIMSK, the mask line,
-C-- for QFTITLE and QFTITLCH
-
- IF (JCASE.GE.3) GO TO 53
- IF (JCASE.EQ.1) THEN
- LIMSK = ' + 8H'
- ELSE
- LIMSK = ' + ' // CQAPO
- ENDIF
- NMSK = LNBLNK (LIMSK(1:12))
- LLL = MAX (NNN,LLL)
- IF (LLL.LE.0) LLL= 8
- NNN = 0
- GO TO 54
-
-C-- for all others
-
- 53 CALL CCCOMG (0)
- NMSK = NCHCCC
- IF (NMSK.LE.0) GO TO 49
- IF (JCASE.EQ.11) GO TO 76
-
- IF (JCCPP.NE.0) THEN
- JTX = NA_JTX (MCCPAR(JCCPP+1))
- CHESC = TEXT(JTX)
- ENDIF
-
-C-- find the escape symbol
-
- 54 LINE = LIMSK(1:NMSK)
- JESC = ICFIND (CHESC,LIMSK,1,NMSK)
- NAFT = NMSK - JESC
-
- IF (JCASE.GE.JSPDATE) GO TO 81
-
-+SEQ, QEJECT.
-C---- ready the PAM file title
-
- JFILE = NFILET
- IF (NNN.GT.0) JFILE= NNN
- IF (NNN.LT.0) JFILE= MAX (1,NFILET+NNN)
- JFILE = MIN (JFILE,NFILET)
- JSL = 0
- IF (JFILE.GT.0) JSL = JTIPAM(JFILE)
- CALL USETT (JSL)
-
- IF (JCASE.GE.4) GO TO 71
- GO TO (61,63,65), JCASE
-
-C-- QFTITLE gives: +nnHWYLBUR 1.21 /77 930630 22.01
-
- 61 LLL = MIN (LLL,62)
- CALL CSETDI (LLL,LINE,8,9)
- LINE(11:10+LLL) = LITIT(1:LLL)
- LINE(77:80) = 'HOLD'
- NFIN = 80
- GO TO 89
-
-C-- QFTITLCH gives: + 'WYLBUR 1.21 /77 930630 22.01'
-
- 63 LLL = MIN (LLL,62)
- LINE(10:10+LLL) = LITIT(1:LLL) // CQAPO
- NFIN = 10+LLL
- GO TO 89
-
-C-- QFHEAD gives: txb"WYLBUR 1.21 /77 930630 22.01"txa
-
- 65 IF (LLL.LE.0) LLL= NTTNORM
- LLL = MIN (LLL,NTTALL)
- LINE(JESC:JESC+LLL-1) = LITIT(1:LLL)
- NFIN = JESC+LLL-1
- GO TO 88
-
-C-- 4 QFNAME gives: txb"WYLBUR"txa
-C-- 5 QFVERS gives: txb"1.21 /77"txa
-C-- 6 QFVSNUM gives: txb"12177"txa
-C-- 7 QFVPRIM gives: txb"1.21"txa
-C-- 8 QFVSEC gives: txb"77"txa
-
- 71 JNA = JCASE - 3
-
- IF (LLL.LE.0) LLL= NTTNA(JNA)
- LLL = MIN (LLL,NTTNA(JNA))
- LINE(JESC:JESC+LLL-1) = CHTTNA(JNA)(1:LLL)
- NFIN = JESC+LLL-1
- GO TO 88
-
-C---- QENVIR gives text with substitution
-
- 76 CALL CENVIR (LIMSK,NMSK, LINE,1,256, 1)
- NFIN = NDSLAT
- GO TO 89
-
-C---- QDATE gives: txb"19930802"txa
-
- 81 IF (JCASE.NE.JSPDATE) GO TO 83
- LLL = LEN(CQDATE)
- LINE(JESC:JESC+LLL-1) = CQDATE
- NFIN = JESC+LLL-1
- GO TO 88
-
-C-- QTIME gives: txb"1107"txa
-
- 83 LINE(JESC:JESC+3) = CQTIME(1:2) // CQTIME(4:5)
- NFIN = JESC+3
-
-C-- set the "after" text
-
- 88 IF (NAFT.GT.0) THEN
- LINE(NFIN+1:NFIN+NAFT)= LIMSK(JESC+1:JESC+NAFT)
- NFIN = NFIN + NAFT
- ENDIF
-
-C-- finalize the line in slot 1
-
- 89 JTX = NFIN + 1
-+SELF, IF=QNEWLINE.
- TEXT(JTX) = CHAR (NEWLN)
- JTX = JTX + 1
-+SELF.
- MLIAD(2) = JTX
- IFSEND = 7
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, X_ASM.
- SUBROUTINE X_ASM
-
-C- Analyse the current control line +ASM, ...
-C. started 23-jan-92
-
-+CDE, SLATE, SLATLN, QBITS19.
-+CDE, CCPARA, LUNSLN, FLINKC, CM_TYP.
-+CDE, Q, PY.
-C-------------- End CDE --------------------------------
- CHARACTER CCOL(256)*1, MSG*56, SLCOL(512)*1
- EQUIVALENCE (CCOL,CCKARD), (MSG,SLERRM), (SLCOL,SLLINE)
-
- PARAMETER (KXBY=KM1, KXAT=KM2, KXSP=KM3, KXMO=KM4, KXAL=KM5,
- + KXBI=KM6, KXUS=KM7, KXEX=KM8, KXSU=KM9, KXRH=KM10,
- + KXPR=KM11, KXLO=KM12, KXRE=KM13)
-
- PARAMETER (NPOSS = 13)
- CHARACTER POSS(NPOSS)*8
-
- DATA POSS / 'BY*PASS '
- +, 'A*TTACH '
- +, 'SPL*IT '
- +, 'MOD*IFY '
- +, 'ALI*AS '
- +, 'BIN*D '
- +, 'USE*D '
- +, 'EXT*EN* '
- +, 'CCH*SUBS'
- +, 'RH*EADER'
- +, 'PRE*FIX '
- +, 'LOG '
- +, 'REA*SSIG' /
-
-C- for +ASM, types, T=BYPASS
-C- +ASM, type, T=REASSIGN, S=type
-C- +ASM, types, T=ATTACH .fname
-C- +ASM, types, T=SPLIT
-C- +ASM, types, T=SPLIT, PREFIX .work/new_
-C- +ASM, types, T=SPLIT, LOG .fname
-C- +ASM, types, T=SPLIT, PREFIX, LOG .work/fname
-C- +ASM, types, T=MODIF
-C- +ASM, types, T=MODIF, PREFIX .work/new_
-C- +ASM, types, T=MODIF, LOG .fname
-C- +ASM, types, T=MODIF, PREFIX, LOG .work/fname
-C- +ASM, types, T=ALIAS
-C- +ASM, types, T=BIND
-C- +ASM, types, T=USED
-C- +ASM, types, T=EXTENSION .tex
-C- +ASM, types, T=CCHSUB .&+!+
-C- +ASM, types, T=RHEAD, .text
-
-+SEQ, Q_AND, Q_NOT, Q_SHIFTR.
-
-
-+SEQ, QEJECT.
- JBK_TYP = 0
-+SELF, IF=BACKCOMP.
- MASKOP = KXBI
- IF (NCCPT.EQ.0) GO TO 21
-+SELF, IF=-BACKCOMP.
- IF (NCCPT.EQ.0) GO TO 92
-+SELF.
- CALL CCOPT (POSS,NPOSS)
- IF (JCCBAD.NE.0) GO TO 91
- MASKOP = MCCPAR(JCCPT+2)
- IF (MASKOP.EQ.0) GO TO 92
-
-C---- handle T=ALIAS
-
- IF (IAND(MASKOP,KXAL).NE.0) THEN
- IF (IAND(MASKOP,NOT(KXAL)).NE.0) GO TO 92
- CALL ASMALIA
- RETURN
- ENDIF
-
-C-- ready all needed ASMH and ASML banks
-
- 21 CALL ASMALL
- IF (JCCBAD.NE.0) GO TO 91
-
-C- this routine analyses the NCCPD parameters at JCCPD
-C- it creates the needed ASMT & ASML banks
-C- it replaces:
-C- MCCPAR(JCCPD+1) = JASM
-C- +2) = JSTRM = 0 for type:0
-C- 1 type:1
-C- 2 type:2
-C- same for JCCPP 3 type:3
-C- 4 type:4
-+SELF, IF=BACKCOMP.
- IF (JBK_TYP.EQ.0) THEN
- IF (NCCPT.EQ.0) GO TO 92
- ENDIF
-+SELF.
-C---- handle T=REASSIGN, S=type
-
- IF (IAND(MASKOP,KXRE).EQ.0) GO TO 24
- IF (IAND(MASKOP,NOT(KXRE)).NE.0) GO TO 92
- IF (NCCPP.NE.1) GO TO 91
- IF (NCCPD.NE.1) GO TO 91
-
- JASMTG = MCCPAR(JCCPP+1)
- JSTRTG = MCCPAR(JCCPP+2)
- JASM = MCCPAR(JCCPD+1)
- JSTR = MCCPAR(JCCPD+2)
-
- LASMT = LQ(LHASM-JASM)
- IF (JSTR.EQ.0) THEN
- JA = 1
- JE = 4
- ELSE
- JA = JSTR
- JE = JSTR
- ENDIF
-
- DO 23 JL=JA,JE
- JS = JSTRTG
- IF (JS.EQ.0) JS= JL
- LASML = LQ(LASMT-JL-1)
- 23 IQ(LASML+11) = 8*JASMTG + JS
- RETURN
-
-C-- parameter S= illegal except for T=REASS
-
- 24 IF (NCCPP.NE.0) GO TO 91
-
-C---- handle T=BYPASS
-
- IF (IAND(MASKOP,KXBY).EQ.0) GO TO 27
- IF (IAND(MASKOP,NOT(KXBY)).NE.0) GO TO 92
-
- DO 26 J=1,NCCPD
- JASM = MCCPAR(JCCPD+1)
- JSTR = MCCPAR(JCCPD+2)
- LASML = LQ(LHASM-JASM)
- IF (JSTR.NE.0) LASML= LQ(LASML-JSTR-1)
- IQ(LASML+1) = 0
- IQ(LASML+2) = 0
- 26 JCCPD = JCCPD + 3
- RETURN
-
-C---- handle T=USED
-
- 27 IF (IAND(MASKOP,KXUS).EQ.0) GO TO 30
- IF (IAND(MASKOP,NOT(KXUS)).NE.0) GO TO 92
- RETURN
-
-+SEQ, QEJECT.
-
-C------ Do all but T=ALIAS, T=REASS, T=BY, T=USED
-
-C-- ready the free-field parameter in the comment field
- 30 CALL CCCOMG (1)
-
- 31 JASMF = MCCPAR(JCCPD+1)
- JSTRF = MCCPAR(JCCPD+2)
- LASMT = LQ(LHASM-JASMF)
- LASML = LASMT
- IF (JSTRF.NE.0) LASML= LQ(LASML-JSTRF-1)
-
-C---- handle T=ATTACH
-
- IF (IAND(MASKOP,KXAT).EQ.0) GO TO 34
- IF (IAND(MASKOP,NOT(KXAT)).NE.0) GO TO 92
-
- IF (NCHCCC.EQ.0) GO TO 93
-
- CHLIEX = ' '
- IXEXT = IQ(LASML+5)
- IF (IXEXT.LT.0) IXEXT= IQ(LASMT+5)
- IF (IXEXT.GT.0) CALL NA_GET (IXEXT,CHLIEX,1)
- CALL CCCRAK (6)
-
-C-- unlink the output file if it exists already
-
- IQ(LASML+1) = 0
- IQ(LASML+2) = 1
- IQ(LASML+3) = IXCCC
- CALL FLINK (LUN_TYP+1, -1, IXCCC, 0)
-
- IF (NCCPD.GE.2) GO TO 42
- RETURN
-
-C---- handle T=SPLIT and T=MODIFY
-
- 34 IF (IAND(MASKOP,KXSP).EQ.0) GO TO 36
- IF (IAND(MASKOP,NOT(KXSP+KXPR+KXLO)).NE.0) GO TO 92
- JMODE = 2
- GO TO 37
-
- 36 IF (IAND(MASKOP,KXMO).EQ.0) GO TO 41
- IF (IAND(MASKOP,NOT(KXMO+KXPR+KXLO)).NE.0) GO TO 92
- JMODE = 3
-
- 37 IQ(LASML+1) = 0
- IQ(LASML+2) = JMODE
-
- IF (NCCPD.GE.2) GO TO 42
- GO TO 49
-
-C---- handle T=BIND
-
- 41 IF (IAND(MASKOP,KXPR+KXLO).NE.0) GO TO 51
- IF (IAND(MASKOP,KXBI).EQ.0) GO TO 61
- IF (IAND(MASKOP,NOT(KXBI)).NE.0) GO TO 92
-
- 42 MBIND = 8*JASMF + JSTRF
-
- JC = JCCPD + 3
- NC = NCCPD - 1
- IF (NC.LE.0) RETURN
-
- DO 47 J=1,NC
- JASM = MCCPAR(JC+1)
- JSTR = MCCPAR(JC+2)
- LASM = LQ(LHASM-JASM)
- IF (JSTR.NE.0) LASM= LQ(LASM-JSTR-1)
- IF (IQ(LASM+1).EQ.0) GO TO 97
- IQ(LASM+1) = MBIND
- 47 JC = JC + 3
- 49 IF (IAND(MASKOP,KXPR+KXLO).NE.0) GO TO 52
- RETURN
-
-+SEQ, QEJECT.
-C---- handle T=PREFIX, LOG
-
- 51 IF (IAND(MASKOP,NOT(KXPR+KXLO)).NE.0) GO TO 92
- 52 MODE = IAND (ISHFTR(MASKOP,10), 3)
- IF (IQ(LASML+2).LT.2) GO TO 94
- IF (NCHCCC.EQ.0) GO TO 53
- CHLIEX = ' '
- CALL CCCRAK (6)
- GO TO 54
-
-C-- no file name on c/line, use command line parameter
-
- 53 IF (JSTRF.GE.3) GO TO 95
- IF (JASMF.GT.JDA_TYP) GO TO 95
-
-C- nypatchy pam fort read print cc as data f:2 c:2 a:2 d:2
-C- JP= 1 2 3 4 5 6 7 8 9 10 11
-C- JASMF= 1 2 3 4 1 2 3 4
-
- IF (JSTRF.LT.2) THEN
- JP = 2
- IF (JASMF.GE.2) JP= JASMF + 3
- ELSE
- JP = JASMF + 7
- ENDIF
- IXCCC = IXLUN(JP)
- IF (IXCCC.EQ.0) GO TO 95
- CALL NA_GET (IXCCC,CCCOMF,1)
- NCHCCC = NDSLAT
-
-C-- change the extension to be .log
-
- JD = ICFILA ('/', CCCOMF,1,NCHCCC)
- JD = NGSLAT + 1
- JD = ICFILA ('.', CCCOMF,JD,NCHCCC)
- CCCOMF(JD:JD+3) = '.log'
- NCHCCC = JD + 3
- IXCCC = NA_LONG (CCCOMF(1:NCHCCC))
-
-C-- for T=PREFIX (not LOG)
-
- 54 IF (MODE.GE.2) GO TO 57
- IQ(LASML+4) = IXCCC
- RETURN
-
-C-- for T=LOG
-
- 57 IQ(LASML+3) = IXCCC
- CALL FLINK (LUN_TYP+1, -1, IXCCC, 0)
- IF (MODE.EQ.2) RETURN
-
-C- for T=PREFIX, LOG
-
- NPRE = ICFILA ('/',CCCOMF,1,NCHCCC)
- IF (NPRE.GE.NCHCCC) GO TO 96
-
- IQ(LASML+4) = NA_LONG (CCCOMF(1:NPRE))
- RETURN
-
-C---- handle T=EXTENSION
-
- 61 IF (IAND(MASKOP,KXEX).EQ.0) GO TO 63
- IF (IAND(MASKOP,NOT(KXEX)).NE.0) GO TO 92
-
- CALL CCCOIX (IQ(LASML+5))
- GO TO 69
-
-C---- handle T=CCHSUB
-
- 63 IF (IAND(MASKOP,KXSU).EQ.0) GO TO 64
- IF (IAND(MASKOP,NOT(KXSU)).NE.0) GO TO 92
-
- CALL CCCOIX (IQ(LASML+7))
- GO TO 69
-
-C---- handle T=RHEAD
-
- 64 IF (IAND(MASKOP,KXRH).EQ.0) GO TO 92
-
- CALL CCCOIX (IQ(LASML+6))
-
- 69 JCCPD = JCCPD + 3
- NCCPD = NCCPD - 1
- IF (NCCPD.NE.0) GO TO 31
- RETURN
-
-C------ Trouble
-
- 91 MSG = 'Syntax error'
- GO TO 98
- 92 MSG = 'Illegal set of T= parameters'
- GO TO 98
- 93 MSG = 'Missing file name'
- GO TO 98
- 94 MSG = 'Only for streams in SPLIT or MODIFY mode'
- GO TO 98
- 95 MSG = 'The trailing free-field parameter is missing'
- GO TO 98
- 96 MSG = 'Illegal file name for T=PREFIX,LOG'
- GO TO 98
- 97 MSG = 'Trying to bind a stream which is already physical'
-
- 98 N = LNBLNK (MSG)
- CALL FAILCC (1, MSG(1:N))
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, X_IMIT.
- SUBROUTINE X_IMIT
-
-C- Process +IMITATE, P=...
-
-+CDE, QBITS19, CCPARA.
-+CDE, Q, PY.
-C-------------- End CDE --------------------------------
-
-+SEQ, Q_AND, Q_OR.
-
-
- 24 IF (NCCPP.EQ.0) RETURN
-
- CALL CREAPD (MCCPAR(JCCPP+1),-1, 0)
-
- IF (IAND(IQ(LCRP),KM10).NE.0) THEN
- IQ(LCRP) = IOR (IQ(LCRP),KM5)
- IQ(LCRP+1) = IOR (IQ(LCRP+1),KM2)
- LQ(LCRP-4) = LEXP
- ENDIF
-
- NCCPP = NCCPP - 1
- JCCPP = JCCPP + 3
- GO TO 24
- END
-+SEQ, QCARDL. =====================================================
-+DECK, X_INCL.
- SUBROUTINE X_INCL (LDOSEQ)
-
-C- Process +INCLUDE, sname1, ...
-C- if LDOSEQ is zero this is called from DOXQT;
-C- otherwise the call is from X_SEQ giving the bank
-C- with the c/c +INCL
-
-+CDE, SLATE, SLATLN, CCPARA.
-+CDE, MUSEBC, Q, PY.
-+CDE, M_ANAC.
-C-------------- End CDE --------------------------------
- CHARACTER LINE*80
- EQUIVALENCE (LINE,TEXT)
-
-
- IF (LDOSEQ.NE.0) THEN
- LDO = LDOSEQ
- CALL CCKRAK (IQ(LDO+1))
- ELSE
- LDO = LDOAN
- ENDIF
-
- JCCTYP = 0
-
- 22 IXNAME = MCCPAR(JCCPZ+1)
- LINE(1:10) = '#include "'
-C- _:.=+=.: 1_:
- CALL NA_GET (IXNAME,LINE,11)
- NTX = NESLAT
- CALL CUTOL (LINE(11:NTX))
- LINE(NTX:NTX+2) = '.h"'
- NTX = NTX + 2
-+SELF, IF=QNEWLINE.
- TEXT(NTX+1) = CHAR(NEWLN)
-+SELF.
- MLIAD(2) = NTX + 1 + NCHNEWL
-
- LQ(LSERV-2) = LQ(LDO-2)
- IQ(LSERV+1) = 1
- IQ(LSERV+2) = 1
- IQ(LSERV+3) = -99
-
- IF (NVEXDK(2).NE.0) THEN
- CALL DPLINE (-1, ' ', NTX,LINE)
- ENDIF
-
- IF (NVEXDK(1).NE.0) CALL DPEXE (LSERV)
-
- JCCPZ = JCCPZ + 3
- NCCPZ = NCCPZ - 1
- IF (NCCPZ.GT.0) GO TO 22
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, X_OPT.
- SUBROUTINE X_OPT
-
-C- Process +OPTION, +PARAM, +SHOW
-
-+CDE, SLATLN, QBITA19, QCHAR, QPAGE, QUNIT.
-+CDE, CCTYPE, CCPARA, LUNSLN, MUSEBC.
-+CDE, Q, PY.
-C-------------- End CDE --------------------------------
- CHARACTER LINE*30, COLS(30)*1
- EQUIVALENCE (LINE,SLLINE)
- EQUIVALENCE (COLS,LINE)
-
- PARAMETER (NPOSS = 10, NPARA = 3, NSHOW=2)
- CHARACTER POSS(NPOSS)*8, PARA(NPARA)*8, SHOW(NSHOW)*8
-
- PARAMETER (NPOSSX = 3)
- CHARACTER POSSX(NPOSSX)*8
-
- DATA POSSX / 'OFF '
- +, 'COM*PACT'
- +, 'EJE*CT ' /
-
- DATA POSS / 'OFF '
- +, 'ALL '
- +, 'BAC*KCOM'
- +, 'COM*PACT'
- +, 'EJE*CT '
- +, 'FUL*L '
- +, 'MAP*ASM '
- +, 'URE*F '
- +, 'VER*BOSE'
- +, 'XCR*OSS ' /
-
- DATA PARA / 'LIN*ES '
- +, 'COL*UMNS'
- +, 'CLA*SH ' /
-
- DATA SHOW / 'ASM '
- +, 'MEM*ORY ' /
-
-+SEQ, Q_AND, Q_OR, Q_NOT.
-
-+SEQ, QEJECT.
-C---- Do +OPTION
-
- IF (JCCTYP.NE.MCCOPT) GO TO 41
- IF (NCCPT.EQ.0) GO TO 31
- IF (IFLAUX.EQ.0) THEN
- CALL CCOPT (POSS,NPOSS)
- IF (JCCBAD.NE.0) GO TO 91
- ELSE
- CALL CCOPT (POSSX,NPOSSX)
- IF (JCCBAD.NE.0) RETURN
- ENDIF
- MASKOP = MCCPAR(JCCPT+1)
-
- IF (IAND(MASKOP,KMO).EQ.0) THEN
- MOPTIO(33) = IOR (MOPTIO(33),MASKOP)
- ELSE
- MOPTIO(33) = IAND (MOPTIO(33),NOT(MASKOP))
- ENDIF
-
- CALL UPKBYT (MOPTIO(33),1,MOPTIO(1),32,0)
-
-C-- print current state of options
-
- 31 DO 34 J=1,LEN(LINE)
- IF (MOPTIO(J).EQ.0) THEN
- COLS(J) = '.'
- ELSE
- COLS(J) = CQCETA(J:J)
- ENDIF
- 34 CONTINUE
-
- NQLLBL = 0
- NQUSED = NQUSED + 1
- WRITE (IQPRNT,9034) LINE
- 9034 FORMAT (10X,'Status of options: ',A)
- RETURN
-
-C---- Do +PARAM
-
- 41 IF (JCCTYP.NE.MCCOP2) GO TO 61
- IF (NCCPT.EQ.0) RETURN
- CALL CCOPT (PARA,NPARA)
- IF (JCCBAD.NE.0) GO TO 91
- MASKOP = MCCPAR(JCCPT+2)
- NVAL = MCCPAR(JCCPN+1)
-
-C-- +PARAM, LINES, N=n - n lines per page
-
- IF (IAND(MASKOP,KM1).EQ.0) GO TO 42
- NQLMAX = MAX (NVAL,24)
- CALL MQPAGE
- RETURN
-
-C-- +PARAM, COL, N=n - n columns per page
-
- 42 IF (IAND(MASKOP,KM2).EQ.0) GO TO 44
- NVAL = MIN (NVAL,140)
- IF (IFLAUX.NE.0) GO TO 43
- NQCMAX = MAX (NVAL,90)
- NQCPGH = NQCMAX
- IF (IAND(MU_GLOB,KM2).NE.0) RETURN
- IF (NQCMAX.LT.102) RETURN
- NQCPGH = 100 + (NQCMAX-100)/2
- RETURN
-
- 43 NQCMAX = MAX (NVAL,100)
- NQCPGH = NQCMAX
- IF (NQCMAX.LT.102) RETURN
- NQCPGH = 100 + (NQCMAX-100)/2
- RETURN
-
-C-- +PARAM, CLASH, N=n - print clash at or above n
-
- 44 NCLASH = MAX (1,NVAL)
- RETURN
-
-C---- Do +SHOW
-
- 61 IF (NCCPT.EQ.0) RETURN
- CALL CCOPT (SHOW,NSHOW)
- IF (JCCBAD.NE.0) GO TO 91
- MASKOP = MCCPAR(JCCPT+2)
-
-C-- +SHOW, ASM - display the ASM data structure
-
- IF (IAND(MASKOP,KM1).NE.0) THEN
- CALL ASMDUMP ('as requested')
- RETURN
- ENDIF
-
-C-- +SHOW, MEMORY - show memory occupation
-
- CALL MQSHOW
- RETURN
-
-C---- Trouble
-
- 91 CALL FAILCC (0, 'Unknown option')
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, X_USE.
- SUBROUTINE X_USE
-
-C- Process +USE, +XDIV, +DIV, +LIST, +EXE
-C- +SUSPEND, +FORCE
-
-+CDE, QBITS19, CCTYPE, CCPARA, MUSEBC.
-+CDE, Q, PY.
-+CDE, M_ANAC.
-C-------------- End CDE --------------------------------
- DIMENSION MV(2)
- EQUIVALENCE (MV(1),IQUEST(1))
-
- PARAMETER (NPOSS = 10)
- CHARACTER POSS(NPOSS)*8
-
- PARAMETER (KBOFF=KM8, KBREP=KM9)
-
-+SEQ, Q_AND, Q_OR, Q_SHIFTL, Q_SHIFTR.
-
- DATA POSS / 'E*XECUTE'
- +, 'L*IST '
- +, 'D*IVERT '
- +, 'X*DIVERT'
- +, 'ONL*Y '
- +, 'T*RANSMI'
- +, 'I*NHIBIT'
- +, 'OFF '
- +, 'R*EPEAT '
- +, 'ENV*IRON' /
-
-
- MASKOP = 0
- IF (NCCPT.NE.0) THEN
- CALL CCOPT (POSS,NPOSS)
- IF (JCCBAD.NE.0) GO TO 91
- MASKOP = MCCPAR(JCCPT+2)
- ENDIF
-
- MXNEW = IAND (MASKOP,KM5-1)
- IF (JCCTYP.GE.MCCFOR) GO TO 71
-
-+SEQ, QEJECT.
-C---------- Doing +USE, +EXE, etc ---------
-
-C-: MODE= 1 ONLY, 2 TRANS, 4 INHIBIT
-
- 31 MODE = ISHFTR (MASKOP,4)
- MODE = IAND (MODE,15)
- IF (MODE.EQ.3) GO TO 91
- IF (MODE.GT.4) GO TO 91
-
- J = MCCIMI - JCCTYP
- CALL SBIT1 (MXNEW,J)
-
-C-- Propagation permission filter
-
- IF (INCRAD.EQ.0) MXNEW= IAND (MXNEW, IOR(MU_DECK,KM3))
-
-C------ Process global activation ------
-
- IF (JCCPD.NE.0) GO TO 51
- IF (JCCPP.NE.0) GO TO 41
-
- IF (INCRAD.EQ.0) GO TO 92
- IF (MODE.EQ.4) THEN
- IF (MXNEW.GE.16) GO TO 91
- ENDIF
-
- IQUEST(11) = MXNEW
- IQUEST(12) = MODE
- IQUEST(13) = 0
- CALL X_UPUT (MU_GLOB)
-
-C-- propagate through all patches and decks
-
- LQ(LLPAST-1) = 0
- L = LEXP
- 34 CALL MXJOIN (MU_GLOB,IQ(L))
- CALL X_UDECK (L)
- L = LQ(L-1)
- IF (L.NE.0) GO TO 34
- RETURN
-
-C------ Process patch activation ------
-
- 41 IXUPAT = MCCPAR(JCCPP+1)
- IF (IXUPAT.EQ.0) GO TO 48
-
- CALL CREAPD (IXUPAT,-1, 0)
-
- IQUEST(11) = MXNEW
- IQUEST(12) = MODE
- IQUEST(13) = MX_TRAN
- CALL X_UPUT (IQ(LCRP))
- IF (IAND(MASKOP,KBREP).NE.0) IQ(LCRP+1)= IOR (IQ(LCRP+1),KM5)
-
-C-- set "used from"
-
- IF (MXNEW.LT.16) GO TO 45
- IF (MODE.EQ.4) GO TO 44
- IF (IAND(IQ(LCRP),KM5).EQ.0) GO TO 45
- 44 LQ(LCRP-4) = LEXP
-
-C-- propagate through all decks
-
- 45 CALL X_UDECK (LCRP)
- 48 NCCPP = NCCPP - 1
- IF (NCCPP.EQ.0) RETURN
- JCCPP = JCCPP + 3
- GO TO 41
-
-C------ Process deck activation ------
-
- 51 IF (NCCPP.NE.1) GO TO 91
- IXUPAT = MCCPAR(JCCPP+1)
- IF (IXUPAT.EQ.0) RETURN
-
- 54 IXUDEC = MCCPAR(JCCPD+1)
-
- CALL CREAPD (IXUPAT,IXUDEC, 0)
-
- IQUEST(11) = MXNEW
- IQUEST(12) = MODE
- IQUEST(13) = MX_TRAN
- CALL X_UPUT (IQ(LCRD))
-
-C-- blank deck and D=CRA* of P=CRA* can change their own status
-
- IF (INCRAD.GE.2) THEN
- IF (LCRP.EQ.LEXP) CALL X_UDECK (0)
- ENDIF
-
- 58 NCCPD = NCCPD - 1
- JCCPD = JCCPD + 3
- IF (NCCPD.NE.0) GO TO 54
-
-C-- set "used from"
-
- IF (MODE.EQ.4) RETURN
- IF (MXNEW.LT.16) RETURN
- IQ(LCRP+1) = IOR (IQ(LCRP+1),KM4)
- IF (LQ(LCRP-4).EQ.0) LQ(LCRP-4)=LEXP
- RETURN
-
-+SEQ, QEJECT.
-C---------- +FORCE, (OFF,) EXE, LIST, DIV, XDIV ---------
-C-- +SUSPEND, (OFF,) EXE, LIST, DIV, XDIV
-
- 71 MXNEG = KM5-1 - MXNEW
- MXOFF = IAND (MASKOP,KBOFF)
- MV(1) = IAND (ISHFTR(MX_FORC,5), KM5-1)
- MV(2) = IAND (ISHFTR(MX_FORC,14), KM5-1)
-
-+SELF, IF=XDEBUG, IF=XX_USE.
- PRINT *, ' X_USE: NEW=',MXNEW,' NEG=',MXNEG,' NO/YES=',MV
-+SELF.
-
- IF (JCCTYP.EQ.MCCFOR) THEN
- IF (MXOFF.EQ.0) MV(2) = IOR (MV(2),MXNEW)
- IF (MXOFF.NE.0) MV(2) = IAND (MV(2),MXNEG)
- ELSE
- IF (MXOFF.EQ.0) MV(1) = IAND (MV(1),MXNEG)
- IF (MXOFF.NE.0) MV(1) = IOR (MV(1),MXNEW)
- ENDIF
-
-+SELF, IF=XDEBUG, IF=XX_USE.
- PRINT *, ' NO/YES=',MV
-+SELF.
- MX_FORC = IOR (ISHFTL(MV(1),5), ISHFTL(MV(2),14))
- RETURN
-
-C----- Faulty control line
-
- 91 CALL M_FAIL ('Bad syntax')
- RETURN
-
- 92 CALL M_FAIL ('This is allowed only in the cradle')
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, X_UPUT.
- SUBROUTINE X_UPUT (MTARG)
-
-C- Update the activation bits in MTARG for X_USE
-
-+CDE, QBITS19, QUEST.
-C-------------- End CDE --------------------------------
- DIMENSION MTARG(9)
- DIMENSION MV(4)
- EQUIVALENCE (MV(1),IQUEST(1))
- EQUIVALENCE (MXNEW,IQUEST(11)), (MODE,IQUEST(12))
- +, (MXTRAN,IQUEST(13))
-
-+SEQ, Q_AND, Q_OR, Q_SHIFTL, Q_SHIFTR.
-
-C-- unpack MV( 1 self+forg 2 inhibit 3 trans 4 self only
-
- MXD = MTARG(1)
- MV(1) = IAND (MXD, KM6-1)
- MV(2) = IAND (ISHFTR(MXD,5), KM6-1)
- MV(3) = IAND (ISHFTR(MXD,10), KM5-1)
- MV(4) = IAND (ISHFTR(MXD,14), KM5-1)
-
-C- MODE: 1 ONLY, 2 TRANS, 4 INHIBIT
-
- IF (MODE.EQ.4) GO TO 28
-
-C---- Activation
-
- IF (MODE.NE.1) MV(1) = IOR (MV(1), MXNEW)
- IF (MODE.EQ.2) MV(3) = IOR (MV(3), MXNEW)
- MV(4) = IOR (MV(4), MXNEW)
-
-C-- "TRANS" attachment to USE
-
- IF (MXTRAN.NE.0) THEN
- IF (MXNEW.GE.16) THEN
- MV(1) = IOR (MV(1), MXTRAN)
- MV(3) = IOR (MV(3), MXTRAN)
- MV(4) = IOR (MV(4), MXTRAN)
- ENDIF
- ENDIF
-
-C-- mask against inhibition bits
-
- 24 MV(1) = IAND (MV(1), MV(2))
- MV(3) = IAND (MV(3), MV(2))
- MV(4) = IAND (MV(4), MV(2))
-
-C-- store
-
- MXWK = IOR (ISHFTL(MV(2),5), MV(1))
- MXWK = IOR (ISHFTL(MV(3),10), MXWK)
- MXWK = IOR (ISHFTL(MV(4),14), MXWK)
- CALL SBYT (MXWK,MTARG(1),1,18)
- RETURN
-
-C---- Inhibition
-
- 28 MXWK = 127 - MXNEW
- MV(2) = IAND (MV(2), MXWK)
- GO TO 24
- END
-+SEQ, QCARDL. =====================================================
-+DECK, X_UDECK.
- SUBROUTINE X_UDECK (LPAT)
-
-C- Merge new USE/EXE-status of patch into all dependent decks
-C! if LPAT = zero: blank deck and D=CRA* of P=CRA* change
-C! their own status
-
-+CDE, QBITS19.
-+CDE, Q, PY, MUSEBC.
-C-------------- End CDE --------------------------------
- PARAMETER (IXCRA=2)
-
-+SEQ, Q_AND.
-
- LP = LPAT
- IF (LP.EQ.0) GO TO 32
-
- LD = LQ(LP-2)
- IF (LD.EQ.0) RETURN
- MXP = IQ(LP)
-
- 21 CALL MXJOIN (MXP,IQ(LD))
- LD = LQ(LD-1)
- IF (LD.NE.0) GO TO 21
- IF (INCRAD.LT.2) RETURN
- IF (LP.NE.LEXP) RETURN
-
-C-- Currently processing P=CRA*, D=blank or CRA*, whose mode
-C- may have changed: update the variables in MUSEBC
-C- note: name index =0 for blank, =2 for CRA*
-
- 32 MU_PAT = IAND (IQ(LEXP), KM19-1)
- IF (LEXD.EQ.0) LEXD= KQFIND (IXCRA,1,LEXP-2,KF)
- IF (LEXD.NE.0) THEN
- MU_DECK = IAND (IQ(LEXD), KM19-1)
- ELSE
- MU_DECK = MU_PAT
- ENDIF
-
- CALL MXOPER (0)
- END
-+SEQ, QCARDL. =====================================================
-+PATCH, DOFORG. Foreign material from this deck to memory
-+DECK, DOFORG.
- SUBROUTINE DOFORG (IFTONX)
-
-C- Store new foreign material into division 1
-C- IF-selection has been done by M_ANA3
-C. started 1-dec-91
-
-+CDE, QBITA19, QBANKS, CCTYPE, CCPARA.
-+CDE, MQCM, Q, PY.
-+CDE, MUSEBC, M_ANAC.
-C-------------- End CDE --------------------------------
-
-+SEQ, Q_JBYT, Q_AND, Q_OR, Q_SHIFTL.
-
-+SELF, IF=XDEBUG, IF=XLOGCALL.
- PRINT *, 'Xdebug: arriving in DOFORG'
-+SELF.
-
- IFTON = 1
- IF (IAND(IQ(LDOAN),KM5).NE.0) THEN
- IFLNIL = IAND(IQ(LDOAN),KM8)
- IF (IFLNIL.EQ.0) GO TO 99
- ELSE
- IFLNIL = 0
- ENDIF
-
- IF (LDECO.EQ.0) CALL CRDECO
- CALL CCKRAK (IQ(LDOAN+1))
-
- MEXAN = MX_FORG
- IF (JCCTYP.NE.MCCKEE) GO TO 41
-
-+SEQ, QEJECT.
-C---------- Handle +KEEP --------------------
-
- IFLSGL = KM5+KM6+KM17
- IFLMSK = KM5+KM6
- NSTEP = 0
- LAST = 0
- IXS = MCCPAR(JCCPZ+1)
- LACT = LQ(LDOAN-3)
- IF (LACT.GT.0) GO TO 24
-
-C-- append to existing sequence
-
- LACT = -LACT
- IFLSGL = 0
- IFTON = 0
- KJOIN = KQLAST (LACT-2)
- JCCTYP = 0
- IF (IQ(LDOAN+1).EQ.1) GO TO 31
- NSTEP = 1
- GO TO 32
-
-C-- ready the KEEP bank
-
- 24 IF (NCCPP.NE.0) IFLSGL= 0
-
- IQ(LACT) = IOR (IQ(LACT), KM7)
- IQ(LACT+1) = IQ(LDOAN+1) + 1
- IQ(LACT+2) = IQ(LDOAN+2) - 1
-C! IQ(LACT+4) = IXS
- IQ(LDOAN+2) = 1
-
- IF (LUPAN.EQ.0) THEN
- LQ(LACT-3) = LDECO
- IQ(LACT+3) = IQ(LACT+1) - JSLORG
- LAST = LACT
- ELSE
- LQ(LACT-3) = LQ(LDOAN-2)
- IQ(LACT+3) = IQ(LDOAN+3) + 1
- ENDIF
-
-C-- NIL sequence
-
- IF (IFLNIL.NE.0) GO TO 99
-
-C------ create MAT continuation banks for KEEP
-
- IFTON = 0
- KJOIN = LACT - 2
- 31 CALL MK_FNX
- IF (LDOAN.EQ.0) GO TO 39
- IF (JCCTYP.GE.MCCSEL) GO TO 39
- NSTEP = 0
-
- 32 IF (LUPAN.NE.0) GO TO 38
- JSLNEW = IQ(LDOAN+1) + NSTEP
- NSLNEW = IQ(LDOAN+2) - NSTEP
- NUMNEW = JSLNEW - JSLORG
- IF (NSLNEW.EQ.0) GO TO 31
-
- IF (JCCTYP.LT.MCCCDE) GO TO 36
- IF (JCCTYP.GE.MCCXSQ) GO TO 35
-
-C-- handle +CDE or +SEQ
-
- CALL CCKRAK (JSLNEW)
-
-C-- check +SEQ,..., T=DUMMY
-
- IF (IAND(MCCPAR(JCCPT+1),KMD).NE.0) GO TO 31
-
-C---- try immediate substitution for +SEQ, single name
-
- IF (NCCPZ.NE.1) GO TO 34
- IF (NCCPIF.NE.0) GO TO 34
-
- IXC = MCCPAR(JCCPZ+1)
- CALL LOCSEQ (LSQF, IXC,0,0)
- IF (LSQF.EQ.0) GO TO 34
- IF (IAND(IQ(LSQF),KM17).EQ.0) GO TO 34
-
-C-- do the substitution
-
- JSLNEW = IQ(LSQF+1)
- IF (JSLNEW.LT.LQLSTA(4)) THEN
- JSLNEW = LN_COP4 (JSLNEW,1)
- IQ(LSQF+1) = JSLNEW
- ENDIF
-
- JCCTYP = 0
-
-C-- does the KEEP bank have zero lines?
- IF (LAST.NE.LACT) GO TO 36
- IF (IQ(LACT+3).NE.NUMNEW) GO TO 36
- IQ(LACT+1) = JSLNEW
- IQ(LACT+2) = 1
- GO TO 31
-
-+SEQ, QEJECT.
-C---- lift XSQ bank for +CDE or +SEQ
-
- 34 LMAT = LIFTSQ (KJOIN,JCCTYP,0,1)
- IFLMSK = 0
- GO TO 37
-
-C---- lift new MAT bank
-
- 35 IFLMSK = 0
- 36 CALL MQLIFT (LMAT,KJOIN,0,JBKMAT,1)
-
- IQ(LMAT) = IOR (IQ(LMAT), ISHFTL(JCCTYP,8))
- 37 LQ(LMAT-2) = LDECO
- IQ(LMAT+1) = JSLNEW
- IQ(LMAT+2) = NSLNEW
- IQ(LMAT+3) = NUMNEW
-
- LAST = LMAT
- KJOIN = LMAT - 1
- GO TO 31
-
-C---- shunt higher level MAT banks
-
- 38 LEV = JBYT (IQ(LDOAN),21,5)
- CALL SBYT (LEV+1,IQ(LDOAN),21,5)
-
- CALL QSHUNT (KDOAN,KJOIN)
- LAST = 0
- KJOIN = LDOAN - 1
- LDOAN = KDOAN + 1
- IFLMSK = 0
- GO TO 31
-
-C---- End of material for KEEP, finalize
-
- 39 IF (LQ(LACT-2).NE.0) IFLSGL= 0
- IF (IQ(LACT+2).NE.1) IFLSGL= 0
-
- IFLMSK = IOR (IFLMSK, MEXAN)
- IFLMSK = IOR (IFLMSK, IFLSGL)
- IQ(LACT) = IOR (IQ(LACT), IFLMSK)
- GO TO 99
-
-+SEQ, QEJECT.
-C---------- Handle +DEL +REPL +ADB +ADD -----------------
-
- 41 LCRD = LQ(LDOAN-3)
- JSLCL = IQ(LDOAN+1)
- JACTU = ISHFTL (JCCTYP-MCCDEL,8)
-
- IF (LUPAN.EQ.0) THEN
- LORG = LDECO
- NUMORG = JSLCL - JSLORG
- ELSE
- LORG = LQ(LDOAN-2)
- NUMORG = IQ(LDOAN+3)
- ENDIF
-
-C-- lift the ACT bank
-
- 45 CALL MQLIFT (LACT,LCRD,-2,JBKACT,1)
-
- IQ(LACT) = IOR (IQ(LACT), JACTU)
- IQ(LACT) = IOR (IQ(LACT), MEXAN)
- LQ(LACT-3) = LORG
- IQ(LACT+1) = JSLCL
- IQ(LACT+2) = 1
- IQ(LACT+3) = NUMORG
- IQ(LACT+4) = MCCPAR(JCCPC+1)
- IQ(LACT+5) = MCCPAR(JCCPC+2)
-
-C-- NIL action
-
- IF (IFLNIL.NE.0) THEN
- IQ(LACT) = IOR (IQ(LACT),KM12)
- IF (LUPAN.EQ.0) IQ(LACT+2) = 0
- IF (JCCTYP.NE.MCCDEL) GO TO 99
- JCCTYP = -1
- GO TO 79
- ENDIF
-
-C-- true action
-
- IF (JCCTYP.EQ.MCCDEL) THEN
- IF (NCCPC.GE.2) JSLCL= LN_COP4 (JSLCL,1)
- JCCTYP = -1
- ENDIF
- IF (JCCTYP.EQ.-1) GO TO 79
-
- IFTON = 0
- KJOIN = LACT - 2
-
-C-- handle +ADD, ..., Z=sname
-
- IF (NCCPZ.EQ.0) GO TO 47
- LMAT = LIFTSQ (KJOIN,MCCXSQ,0,1)
- LQ(LMAT-2) = LORG
- IQ(LMAT+1) = JSLCL
- IQ(LMAT+2) = 0
- IQ(LMAT+3) = NUMORG
- KJOIN = LMAT - 1
-
- 47 IF (LUPAN.NE.0) GO TO 51
- JCCTYP = 0
- NSTEP = 1
- GO TO 53
-
-C---- create MAT continuation banks for ACT
-
- 51 CALL MK_FNX
- IF (LDOAN.EQ.0) GO TO 79
- IF (JCCTYP.GE.MCCSEL) GO TO 79
- IF (IQ(LDOAN+2).EQ.0) GO TO 51
- IF (LUPAN.NE.0) GO TO 77
- NSTEP = 0
- 53 CALL MK_FRAG (KJOIN,NSTEP)
- GO TO 51
-
-C---- shunt higher level MAT banks
-
- 77 LEV = JBYT (IQ(LDOAN),21,5)
- CALL SBYT (LEV+1,IQ(LDOAN),21,5)
-
- CALL QSHUNT (KDOAN,KJOIN)
- KJOIN = LDOAN - 1
- LDOAN = KDOAN + 1
- GO TO 51
-
-C---- End of material for ACT, finalize
-
- 79 IQ(LACT) = IOR (IQ(LACT), MEXAN)
- IF (JCCTYP.NE.-1) GO TO 99
-
-C-- iterate if multiple +DEL
-
- JCCPC = JCCPC + 3
- NCCPC = NCCPC - 1
- IF (NCCPC.NE.0) GO TO 45
-
- 99 IFTONX = IFTON
-+SELF, IF=XDEBUG, IF=XDOFORG.
- CALL DDSNAP ('end of DOFORG',-1,1)
-+SELF.
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, MK_FRAG.
- SUBROUTINE MK_FRAG (KJOINX,NSTEP)
-
-C- Fragment the contents of the bank at LDOAN for DOFORG
-C- on the boundaries and according to the delayed control-lines
-C. started 15-jul-93
-
-+CDE, QBITS19, QBANKS, CCTYPE, CCPARA, Q, PY.
-+CDE, M_ANAC.
-C-------------- End CDE --------------------------------
-
-+SEQ, Q_OR, Q_SHIFTL.
-
-
- KJOIN = KJOINX
- JSLA = IQ(LDOAN+1)
- JSLE = JSLA + IQ(LDOAN+2)
- JSLA = JSLA + NSTEP
- JCPUT = JCCTYP
- IF (JCCTYP.LT.MCCCDE) GO TO 20
- IF (JCCTYP.GT.MCCSEQ) GO TO 20
-
-C-- starting with +CDE or +SEQ, lift a call bank
-
- CALL CCKRAK (JSLA)
- GO TO 37
-
-C-- Look for the next delayed c/line
-
- 20 JCLAST = 0
- JSLG = JSLA
-
- 21 CALL NEXTCC ('-',JSLG,JSLE,JSLF,JCCTYP)
-
- 22 NLDO = JSLF - JSLA
- IF (NLDO.EQ.0) GO TO 27
-
-C-- store the pending material
-
- CALL MQLIFT (LMAT,KJOIN,0,JBKMAT,1)
-
- MMBANK(3,JBKMAT) = 2
-
- LQ(LMAT-2) = LDECO
- IQ(LMAT) = IOR (IQ(LMAT), MEXAN)
- IQ(LMAT+1) = JSLA
- IQ(LMAT+2) = NLDO
- IQ(LMAT+3) = JSLA - JSLORG
-
- IF (JCPUT.NE.0) THEN
- IQ(LMAT) = IOR (IQ(LMAT), ISHFTL(JCPUT,8))
- ELSEIF (JCLAST.NE.0) THEN
- IQ(LMAT) = IOR (IQ(LMAT), KM15)
- ENDIF
- KJOIN = LMAT - 1
-
- 27 JCPUT = 0
- JSLA = JSLF
- IF (JCCTYP.LT.0) GO TO 20
- IF (JCCTYP.EQ.0) GO TO 99
-
-+SEQ, QEJECT.
-C---- handle the new c/line
-
- JCLAST = JCCTYP
- JSLG = JSLA + 1
- CALL CCKRAK (JSLA)
- IF (JCCBAD.NE.0) THEN
- NUM = JSLA - JSLORG
- CALL FAILLN (1, 0, NUM, JSLA, 'Bad syntax for delayed c/l')
- ENDIF
-
-
-C-- control-lines with associated material are:
-C-- +_xxx +SELF +SKIP +KEEP
-
-C-- soft c/lines
-
- IF (JCCTYP.GE.MCCSEL) GO TO 41
- JTX = MLIAD(JSLA)
- TEXT(JTX) = '+'
- JCPUT = JCCTYP
-
- IF (JCCTYP.GE.MCCTRU) GO TO 21
- IF (JCCTYP.LT.MCCCDE) GO TO 54
-
-C-- do +CDE, +SEQ, lift a call bank
-
- 37 LMAT = LIFTSQ (KJOIN,JCCTYP,0,1)
- LQ(LMAT-2) = LDECO
- IQ(LMAT) = IOR (IQ(LMAT), MEXAN)
- IQ(LMAT+1) = JSLA
- IQ(LMAT+2) = 1
- IQ(LMAT+3) = JSLA - JSLORG
- KJOIN = LMAT - 1
- JSLA = JSLA + 1
- JCPUT = 0
- GO TO 20
-
-C-- hard control lines
-
- 41 IF (JCCTYP.GE.MCCUSE) GO TO 54
- IF (JCCTYP.GE.MCCKEE) GO TO 51
- IF (JCCTYP.NE.MCCSEL) GO TO 21
-
-C-- +SELF, sname
-
- IF (NCCPZ.EQ.0) GO TO 21
- LMAT = LIFTSQ (KJOIN,MCCSES,0,1)
- LQ(LMAT-2) = LDECO
- IQ(LMAT) = IOR (IQ(LMAT), MEXAN)
- IQ(LMAT+1) = JSLA
- IQ(LMAT+3) = JSLA - JSLORG
-
- CALL NEXTCC ('-',JSLG,JSLE,JSLF,JCCTYP)
- IQ(LMAT+2) = JSLF - JSLA
- KJOIN = LMAT - 1
- GO TO 27
-
-C-- Action line +ADD etc, MAT bank needs 3 links
-
- 51 MMBANK(3,JBKMAT) = 3
- IF (JCCTYP.EQ.MCCKEE) GO TO 21
-
-C-- stand-alone control-line
-
- 54 JCCTYP = -1
- JSLF = JSLA + 1
- GO TO 22
-
-C---- done
-
- 99 KJOINX = KJOIN
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, MK_FNX.
- SUBROUTINE MK_FNX
-
-C- Step to next PREP / MAT bank for DOFORG
-C. started 1-dec-91
-
-+CDE, QBITS19, CCTYPE, CCPARA, Q, MUSEBC.
-+CDE, M_ANAC.
-C-------------- End CDE --------------------------------
-
-+SEQ, Q_JBYT, Q_AND, Q_OR.
-
-
- MEXSUS = 0
- IFLNEW = 0
- 21 IF (LUPAN.NE.0) GO TO 34
- 22 KDOAN = LDOAN - 1
- LDOAN = LQ(KDOAN)
- IF (LDOAN.EQ.0) GO TO 29
-
- L = LQ(LDOAN-2)
- IF (L.NE.0) GO TO 31
-
- 24 JCCTYP = JBYT (IQ(LDOAN),9,6)
- IF (IAND(IQ(LDOAN),KM5+KM6).EQ.0) GO TO 28
-
-C-- deleted PREP/MAT bank
-
- IF (JCCTYP.GE.MCCSEL) THEN
- IFLNEW= 7
- IF (IAND(IQ(LDOAN),KM6+KM7).EQ.0) GO TO 29
- ENDIF
-
- IF (IFLNEW.NE.0) THEN
- MEXSUS = IOR (MEXSUS, IQ(LDOAN))
- ELSE
- MEXAN = IOR (MEXAN, IQ(LDOAN))
- ENDIF
- GO TO 21
-
-C-- accepted PREP/MAT bank
-
- 28 IF (JCCTYP.LT.MCCSEL) THEN
- IF (NVEXDK(2).NE.0) CALL DPLIST (MODEAN,LDOAN,LUPAN,0)
- MEXAN = IOR (MEXAN, IQ(LDOAN))
- MEXAN = IOR (MEXAN, MEXSUS)
- ENDIF
-
- 29 MEXAN = IAND (MEXAN,15)
- RETURN
-
-C---- Follow reference to foreign material
-
- 31 LOWAN = LDOAN
- LUPAN = L
-
-C-- list what action
-
- CALL DPLACT
- IF (IAND(IQ(LOWAN),KM5+KM6).NE.0) GO TO 37
-
-C-- next MAT bank
-
- LDOAN = LUPAN - 1
- 34 KDOAN = LDOAN - 1
- LDOAN = LQ(KDOAN)
- IF (LDOAN.NE.0) GO TO 24
- 36 LDOAN = LOWAN
- LUPAN = 0
- GO TO 22
-
- 37 MEXSUS = IOR (MEXSUS, IQ(LOWAN))
- MEXSUS = IOR (MEXSUS, IQ(LUPAN))
- GO TO 36
- END
-+SEQ, QCARDL. =====================================================
-+PATCH, ARRIVE. Input routines
-+DECK, ARRSKPC, IF=QCIO.
-+SEQ, QCARD1, R=ARRSKP.
- SUBROUTINE ARRSKP
-
-C- Skip one PAM/Patch/Deck according to JDKTYP, using the C library
-C. started 16-mar-92
-
-+CDE, QPAGE, CHEXC, MQCM, Q, PY.
-C-------------- End CDE --------------------------------
-
-
- IXEXDEC = 0
- NSLORG = 0
- NDKSKP = 0
- LEVEL = JDKTYP
-
-C-- Make sure the current deck is complete in memory
-
- IF (JDKNEX.EQ.0) CALL ARRNXD (0)
- 24 IF (JDKNEX.EQ.0) CALL ARRIVE (2)
-
-C-- Skip one deck, next -> current
-
- CALL ARRNXD (1)
- NDKSKP = NDKSKP + 1
- IF (JDKTYP.LT.LEVEL) GO TO 24
-
-C-- The now current deck is at the right level
-
- IF (LEVEL.GE.3) RETURN
- IF (LEVEL.EQ.2) IXEXPAT= 0
- NQDKNO = NQDKNO + NDKSKP
- JSLZER = IQ(LQHOLD+1)
- JSLORG = JSLZER
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, ARRSKPF, IF=QFIO.
-+SEQ, QCARD1, R=ARRSKP.
- SUBROUTINE ARRSKP
-
-C- Skip one PAM/Patch/Deck according to JDKTYP, using Fortran
-C. started 16-mar-92
-
-+CDE, QPAGE, CHEXC, MQCM, Q, PY.
-+CDE, ARRCOM.
-C-------------- End CDE --------------------------------
-
-
- IXEXDEC = 0
- NSLORG = 0
- NDKSKP = 0
- NSLN = 0
- LEVEL = JDKTYP
- IFTERM = IQ(LARRV+7)
- JSLGO = IQ(LQHOLD+1)
-
-C-- Is the current deck complete in memory?
-
- 24 IF (JDKNEX.EQ.0) THEN
- IF (IQ(LQHOLD+2).LE.1) THEN
- IF (IFTERM.NE.-1) GO TO 41
- ELSE
- CALL ARRNXD (0)
- IF (JDKNEX.NE.0) GO TO 27
- IF (IFTERM.NE.-1) GO TO 41
- ENDIF
- CALL ARRIVE (2)
- ENDIF
-
-C-- Skip one deck, next -> current
-
- 27 CALL ARRNXD (1)
- NDKSKP = NDKSKP + 1
- IF (JDKTYP.LT.LEVEL) GO TO 24
- GO TO 67
-
-C---- Hunt for next deck header line
-
- 41 IF (IQ(LARRV+8).NE.0) GO TO 61
- IN_LUN = IQ(LARRV+1)
- IN_EOF = 0
- JTXGO = MLIAD(JSLGO)
-
- 44 CALL ARRLN (IN_LUN, TEXT(JTXGO),NTXR)
- IF (NTXR.LT.0) GO TO 60
- NSLN = NSLN + 1
-
- IF (NTXR.LT.4) GO TO 44
- IF (TEXT(JTXGO).NE.'+') GO TO 44
-
- JTXU = JTXGO + NTXR
-+SELF, IF=QNEWLINE.
- TEXT(JTXU) = CHAR(NEWLN)
- JTXU = JTXU + 1
-+SELF.
- MLIAD(JSLGO+1) = JTXU
- CALL NEXTSI (JSLGO,JDKTYP,INCRAD)
- IF (JDKTYP.EQ.0) GO TO 44
-
- NDKSKP = NDKSKP + 1
- IF (JDKTYP.LT.LEVEL) GO TO 44
-
- LQLEND(2) = JSLGO + 1
- LQLSTA(3) = LQLEND(2)
- LQLEND(3) = LQLSTA(3)
- IQ(LQHOLD+1) = JSLGO
- IQ(LQHOLD+2) = 1
- GO TO 67
-
-C-- end-of-file
-
- 60 IN_EOF = -1
- 61 IQ(LQHOLD+2) = 0
- JDKTYP = 6
- JDKNEX = 6
- 67 IQ(LARRV+12) = IQ(LARRV+12) + NSLN
- IF (LEVEL.GE.3) RETURN
- IF (LEVEL.EQ.2) IXEXPAT= 0
- NQDKNO = NQDKNO + NDKSKP
- JSLZER = IQ(LQHOLD+1)
- JSLORG = JSLZER
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, ARRIVE.
- SUBROUTINE ARRIVE (MODEIN)
-
-C- Read input material to memory
-C- MODE = 0 : read the blank deck of the cradle
-C- 1 : make sure the beginning of the next deck is in memory
-C- 2 : make sure the complete deck is in memory
-C- 3 : read as much as you can
-C. started 11-mar-92
-
-+CDE, QUNIT, CCTYPE, CCPARA, LUNSLN.
-+CDE, MQCM, Q, PY.
-+CDE, ARRCOM, FLINKC.
-C-------------- End CDE --------------------------------
-
-
- MODE = MODEIN
-+SELF, IF=XDEBUG, IF=XLOGCALL.
- PRINT *, 'Xdebug: arriving in ARRIVE, MODE= ',MODE
-+SELF, IF=QCIO.
-
-C-- collect garbage before reading next instalment from PAM
-
- IF (INCRAD.EQ.0) THEN
- IF (LQLEND(2).NE.LQLSTA(2)) GO TO 25
- ENDIF
-+SELF.
- IF (MODE.NE.0) GO TO 21
-
-C---- Start reading the blank deck of the cradle
-
- LARRV = LACRAD
- IQ(LARRV+1) = IQREAD
- IQ(LARRV+2) = IQRFD
- IQ(LARRV+6) = IQRSIZ
- JDKTYP = 0
-
-+SELF, IF=QCIO.
- IF (IQRFD .NE.0) GO TO 21
- IF (IQRSIZ.NE.0) GO TO 21
-+SELF.
- IQ(LARRV+7) = -2
- IF (IQRTTY.NE.0) IQ(LARRV+7)= -1
-
-+SEQ, QEJECT, N=40.
-C---- Check enough space
-
- 21 NWFREE = LQCSTA(3) - LQCEND(2)
- JSLOCC = LQLSTA(4)
- JSLFRE = LQLEND(2)
- NSLFRE = JSLOCC - JSLFRE - 8
- NTXFRE = MLIAD(JSLOCC) - MLIAD(JSLFRE) - 400
-
- NSLRSV = NVGAP(2)
- NTXRSV = NSLRSV * NVGAP(4)
-
- NSLEXP = NVGAP(3)
- NTXEXP = NSLEXP * NVGAP(4)
-
- NSLMIN = 40
- NTXMIN = NSLMIN * NVGAP(4)
-
-+SELF, IF=QCIO, QS_VMS.
- IF (IFMODIF.NE.0) THEN
- NSLRSV = NSLRSV + NSLEXP
- NTXRSV = NTXRSV + NTXEXP
- ENDIF
-+SELF.
-
- NSLWAN = NSLFRE - NSLRSV
- NTXWAN = NTXFRE - NTXRSV
-
- IF (NWFREE.LT.NVGAP(1)) GO TO 24
- IF (NSLFRE.LT.NSLRSV+NSLEXP) GO TO 24
- IF (NTXFRE.GE.NTXRSV+NTXEXP) GO TO 31
-
- 24 IF (IFLGAR.NE.0) GO TO 27
- 25 CALL MQSHIFT
- IFLGAR = 7
- GO TO 21
-
-C-- not plenty of space, try to do with half the reservation
-
- 27 IF (NSLFRE.GE.NSLRSV+NSLEXP) THEN
- IF (NTXFRE.GE.NTXRSV+NTXEXP) GO TO 31
- ENDIF
- NSLWAN = NSLFRE - NSLRSV/2
- NTXWAN = NTXFRE - NTXRSV/2
-
- IF (NSLWAN.LT.NSLMIN)
- + CALL NOSPACE ('no line slots left for reading')
- IF (NTXWAN.LT.NTXMIN)
- + CALL NOSPACE ('no text store left for reading')
-
-
-C---- Handle pending material from the ASAV bank
-C- Note: this can happen only at the moment
-C- when resuming the cradle or a Pam file
-
- 31 LASAV = LQ(LARRV-2)
- IF (LASAV.EQ.0) GO TO 41
-
- IQ(LQHOLD+1)= LQLEND(2)
-
- JSLTR = IQ(LASAV+1)
- NSLTR = IQ(LASAV+2)
- JSLE = JSLTR + NSLTR
- NTXTR = MLIAD(JSLE) - MLIAD(JSLTR)
-+SELF, IF=XDEBUG, IF=XSAVE.
- CALL DUMPSL (JSLTR,NSLTR,'are connected to ASAV bank')
-+SELF.
-
- IF (NSLTR.GT.NSLWAN)
- + CALL NOSPACE ('no line slots left for reading')
- IF (NTXTR.GT.NTXWAN)
- + CALL NOSPACE ('no text store left for reading')
-
-C-- transfer all pending material
-
- JSLTR = LN_COP2 (JSLTR,NSLTR)
- CALL TOGARB (LARRV-2,0)
-+SELF, IF=XDEBUG, IF=XSAVE.
- CALL DUMPSL (JSLTR,NSLTR,'stored into text division 2')
-+SELF.
-
- IQ(LQHOLD+2) = NSLTR
- CALL ARRNXD (-1)
-
- IF (JDKNEX.NE.0) RETURN
- IF (MODE.EQ.1) RETURN
- GO TO 21
-
-+SEQ, QEJECT, N=40.
-C------ Read from the file
-
- 41 IF (IQ(LQHOLD+2).EQ.0) THEN
- IQ(LQHOLD+1) = LQLEND(2)
- JDKTYP = 0
- ENDIF
-
- IN_DOX = 2
-+SELF, IF=QCIO.
-C-- if file not seekable, dont read too much
-
- IF (IQ(LARRV+7).LT.-1) THEN
- NSLWAN = NSLMIN
- NTXWAN = NTXMIN
- ENDIF
-+SELF.
- IN_DO1 = NSLWAN
- IN_DO2 = NTXWAN
- JDKNEX = 0
- IF (IQ(LARRV+7).EQ.-1) THEN
- CALL ARRTM
- ELSE
- CALL ARRIN
- ENDIF
-
- IF (JDKNEX.LT.0) GO TO 61
- IF (MODE.NE.1) THEN
- IF (JDKNEX.EQ.0) GO TO 21
- ENDIF
- IF (MODE.NE.0) RETURN
-
-C-- having read the blank deck of the cradle
-
- IF (IFLAUX.NE.0) RETURN
- IF (JDKTYP.LT.2) RETURN
- CALL P_KILL ('illegal start of the cradle')
-
-C---- Having read the start of the blank deck of the cradle
-C-- until a line +MORE : read the cradle continuation file
-
- 61 JDKNEX = 0
- JSLM = IQ(LQHOLD+1) + IQ(LQHOLD+3)
- JCCTYP = MCCMOR
- CALL CCKRAK (JSLM)
-
- IF (NCHCCD.GE.NCHCCT) JCCBAD= 7
- IF (JCCBAD.NE.0) CALL P_KILL ('faulty +MORE line')
-
-C-- close previous cradle file, if not terminal
-
- IF (IQ(LARRV+7).NE.-1) THEN
- IN_DOX = -1
- CALL ARRIN
- ENDIF
-
-C-- attach the +MORE file
-
- IQREAD = IQRSAV
- IQRTTY = 0
- CALL FLKRAK (1,1)
- CALL FLINK (IQREAD, 1, -1, 0)
- IQRFD = LUNFD
- IQRSIZ = LUNSIZ
-
- IQ(LARRV+1) = IQREAD
- IQ(LARRV+2) = IQRFD
- IQ(LARRV+4) = IXFLUN
- IQ(LARRV+6) = IQRSIZ
-+SELF, IF=QCIO.
- IQ(LARRV+7) = 0
-+SELF, IF=QFIO.
- IQ(LARRV+7) = -2
-+SELF.
- IQ(LARRV+8) = 0
-
- LQLEND(2) = JSLM + 1
- LQLSTA(3) = LQLEND(2)
- LQLEND(3) = LQLSTA(3)
- GO TO 21
- END
-+SEQ, QCARDL. =====================================================
-+DECK, ARRTM.
- SUBROUTINE ARRTM
-
-C- Read cradle lines from the on-line user
-C. started 10-feb-92
-
-+CDE, MQCM, Q, PY.
-+CDE, ARRCOM.
-C-------------- End CDE --------------------------------
-
-
- JSLGO = IQ(LQHOLD+1)
-
- JSLU = LQLEND(2)
- JTXU = MLIAD(JSLU)
- JSLE = JSLU + IN_DO1
- JTXE = JTXU + IN_DO2
-
- 24 JSLF = JSLU
- IF (JSLU.GE.JSLE) GO TO 37
- IF (JTXU.GE.JTXE) GO TO 37
- CALL TMPRO (' ny> ')
- CALL TMREAD (512,TEXT(JTXU),NTXR,IN_EOF)
-
- IF (IN_EOF.NE.0) GO TO 31
-
- JTXF = JTXU
- JTXU = JTXU + NTXR
-+SELF, IF=QNEWLINE.
- TEXT(JTXU) = CHAR(NEWLN)
- JTXU = JTXU + 1
-+SELF.
- JSLU = JSLU + 1
- MLIAD(JSLU) = JTXU
-
- IF (NTXR.LT.4) GO TO 24
- IF (TEXT(JTXF).NE.'+') GO TO 24
-
- CALL NEXTSI (JSLF,JDKNEX,INCRAD)
-
- IF (JDKNEX.EQ.0) GO TO 24
- IF (JSLF.NE.JSLGO) GO TO 37
- IF (JDKNEX.LT.0) GO TO 37
- JDKTYP = JDKNEX
- JDKNEX = 0
- JSLF = JSLU
- GO TO 37
-
-C---- EoF
-
- 31 IF (IN_EOF.GT.0) CALL P_KILLM ('terminal read fails')
-
- IQ(LARRV+8) = -1
- JDKNEX = 6
- IF (JSLU.EQ.JSLGO) JDKTYP = 6
-
-C-- Done
-
- 37 IQ(LARRV+12) = IQ(LARRV+12) + (JSLU-LQLEND(2))
- LQLEND(2) = JSLU
- LQLSTA(3) = LQLEND(2)
- LQLEND(3) = LQLSTA(3)
- IQ(LQHOLD+2) = JSLU - JSLGO
- IQ(LQHOLD+3) = JSLF - JSLGO
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, ARRINC, IF=QCIO.
-+SEQ, QCARD1, R=ARRIN.
- SUBROUTINE ARRIN
-
-C- Read / reposition current input file, using the C library,
-C- according to IN_DOX:
-C- = -1 close, 0 rewind, 1 reposition, 2 read
-C. started 10-feb-92
-
-+CDE, QUNIT, MQCM, Q, PY.
-+CDE, ARRCOM.
-C-------------- End CDE --------------------------------
-
-+SEQ, Q_OR.
-
-+SELF, IF=XDEBUG, IF=XLOGCALL.
- PRINT *, 'Xdebug: arriving in ARRINc, IN_DOX= ',IN_DOX
-+SELF.
-
- IN_FD = IQ(LARRV+2)
- IF (IN_DOX.LT.2) GO TO 61
-
-C---- Read
-
- JSLGO = IQ(LQHOLD+1)
- JSLNEW = LQLEND(2)
-
- JSLA = LQLEND(2)
- NSLN = IN_DO1
- NTXN = IN_DO2
- JTXA = MLIAD(JSLA)
-
- CALL CIGET (IN_FD,TEXT(JTXA),NTXN,NTXR,IN_EOF)
-
- IF (IN_EOF.NE.0) GO TO 41
-
-C-- reading successful, get the current file position
-
- CALL CITELL (IN_FD,NCHPOS,ISTAT)
-
- IF (ISTAT.NE.0) CALL P_KILLM ('CIO tell fails')
-
-C-- construct the line directory
-
- JTXE = JTXA + NTXR
- JSLE = JSLA
- LIMIT = JSLA + NSLN
-
- DO 26 JTXU=JTXA,JTXE-1
- IF (ICHAR(TEXT(JTXU)) .EQ. NEWLN) THEN
- JSLE = JSLE + 1
- MLIAD(JSLE) = JTXU + 1
- IF (JSLE.GT.LIMIT) GO TO 31
- ENDIF
- 26 CONTINUE
- IF (NTXR.EQ.NTXN) GO TO 31
-
-C-- file complete, make sure terminating NEWLINE present
-
- IF (MLIAD(JSLE).EQ.JTXE) GO TO 34
- TEXT(JTXE) = CHAR(NEWLN)
- JTXE = JTXE + 1
- JSLE = JSLE + 1
- MLIAD(JSLE) = JTXE
- NCHPOS = NCHPOS + 1
- GO TO 34
-
-+SEQ, QEJECT, N=40.
-C---- file too big, reposition to complete line
-
- 31 JTXU = MLIAD(JSLE)
- N = JTXE - JTXU
- IF (N.EQ.0) GO TO 34
-
- NCHPOS = NCHPOS - N
- CALL CISEEK (IN_FD,NCHPOS,ISTAT)
-
- IF (ISTAT.NE.0) CALL P_KILLM ('CIO seek fails')
-
-C-- is the end of the file in memory ?
-
- 34 NSIZE = IQ(LARRV+6)
- IF (NSIZE.GT.0) THEN
- IF (NCHPOS.GE.NSIZE) IN_EOF= 1
- ENDIF
-
-C-- if IQRRD lines have been read already by FLPARA
-
- IF (IQRRD.NE.0) THEN
- JSLGO = JSLGO + IQRRD
- JSLNEW = MAX (JSLGO,LQLEND(2))
- IQRRD = 0
- IQ(LQHOLD+1) = JSLGO
- IF (JSLGO.GE.JSLE) CALL P_CRASH ('bad start of cradle')
- ENDIF
-
-C-- Done
-
- IQ(LARRV+7) = NCHPOS
- IQ(LARRV+8) = IN_EOF
-
- 37 CALL NEXTDE (JSLNEW,JSLE,JSLF,JDKNEX,INCRAD)
-
- IF (JSLF.EQ.JSLGO) THEN
- IF (JDKNEX.GT.0) THEN
- JSLNEW = JSLF + 1
- JDKTYP = JDKNEX
- GO TO 37
- ENDIF
- ENDIF
-
- IF (JDKNEX.EQ.0) THEN
- IF (IN_EOF.NE.0) JDKNEX= 6
- ENDIF
-
- IQ(LQHOLD+2) = JSLE - JSLGO
- IQ(LQHOLD+3) = JSLF - JSLGO
- IQ(LQHOLD) = IOR (IQ(LQHOLD), 1)
-
- IQ(LARRV+12) = IQ(LARRV+12) + (JSLE-LQLEND(2))
- LQLEND(2) = JSLE
- LQLSTA(3) = LQLEND(2)
- LQLEND(3) = LQLSTA(3)
- RETURN
-
-C---- EoF read, no material has come to memory
-
- 41 IF (IN_EOF.NE.-1) CALL P_KILLM ('CIO read fails')
- IQ(LARRV+8) = -1
- JDKNEX = 6
- IF (JSLNEW.EQ.JSLGO) JDKTYP = 6
- RETURN
-
-C---- Reposition the file
-
- 61 IF (IN_DOX.NE.1) GO TO 71
- JSLN = IN_DO1
- JSLE = LQLEND(2)
- NSLOV = JSLE - JSLN
- NTKOV = MLIAD(JSLE) - MLIAD(JSLN)
- NCHPOS = IQ(LARRV+7)
-
- NCHPOS = NCHPOS - NTKOV
- CALL CISEEK (IN_FD,NCHPOS,ISTAT)
-
- IF (ISTAT.NE.0) CALL P_KILLM ('CIO seek fails')
-
- IQ(LARRV+7) = NCHPOS
- IQ(LARRV+8) = 0
- IQ(LARRV+12) = IQ(LARRV+12) - NSLOV
- LQLEND(2) = JSLN
- LQLSTA(3) = LQLEND(2)
- LQLEND(3) = LQLSTA(3)
- RETURN
-
-C---- REWIND / CLOSE
-
- 71 IF (IN_DOX.EQ.0) THEN
- CALL CIREW (IN_FD)
- ELSE
- CALL CICLOS (IN_FD)
- IQ(LARRV+1) = 0
- IQ(LARRV+2) = 0
- ENDIF
-
- IF (IQ(LARRV+7).GE.0) IQ(LARRV+7)= 0
- IQ(LARRV+5) = 0
- IQ(LARRV+8) = 0
- IQ(LARRV+9) = 0
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, ARRINF, IF=QFIO.
-+SEQ, QCARD1, R=ARRIN.
- SUBROUTINE ARRIN
-
-C- Read / reposition current input file, using Fortran,
-C- according to IN_DOX:
-C- = -1 close, 0 rewind, 1 reposition, 2 read
-C. started 16-mar-92
-
-+CDE, MQCM, Q, PY.
-+CDE, ARRCOM.
-C-------------- End CDE --------------------------------
-
-+SEQ, Q_OR.
-+SELF, IF=XDEBUG, IF=XLOGCALL.
- PRINT *, 'Xdebug: arriving in ARRINf, IN_DOX= ',IN_DOX
-+SELF.
-
- IN_LUN = IQ(LARRV+1)
- IF (IN_DOX.LT.2) GO TO 61
-
-C---- Read
-
- IN_EOF = 0
- JSLGO = IQ(LQHOLD+1)
-
- JSLU = LQLEND(2)
- JTXU = MLIAD(JSLU)
- JSLE = JSLU + IN_DO1
- JTXE = JTXU + IN_DO2
-
- 24 JSLF = JSLU
- IF (JSLU.GE.JSLE) GO TO 37
- IF (JTXU.GE.JTXE) GO TO 37
- CALL ARRLN (IN_LUN, TEXT(JTXU),NTXR)
- IF (NTXR.LT.0) GO TO 31
-
- JTXF = JTXU
- JTXU = JTXU + NTXR
-+SELF, IF=QNEWLINE.
- TEXT(JTXU) = CHAR(NEWLN)
- JTXU = JTXU + 1
-+SELF.
- JSLU = JSLU + 1
- MLIAD(JSLU) = JTXU
-
- IF (NTXR.LT.4) GO TO 24
- IF (TEXT(JTXF).NE.'+') GO TO 24
-
- CALL NEXTSI (JSLF,JDKNEX,INCRAD)
-
- IF (JDKNEX.EQ.0) GO TO 24
- IF (JSLF.NE.JSLGO) GO TO 37
- IF (JDKNEX.LT.0) GO TO 37
- JDKTYP = JDKNEX
- JDKNEX = 0
- JSLF = JSLU
- GO TO 37
-
-C-- Done
-
- 31 IN_EOF = -1
- IQ(LARRV+8) = -1
- JDKNEX = 6
- IF (JSLU.EQ.JSLGO) JDKTYP = 6
-
- 37 IQ(LARRV+12) = IQ(LARRV+12) + (JSLU-LQLEND(2))
- LQLEND(2) = JSLU
- LQLSTA(3) = LQLEND(2)
- LQLEND(3) = LQLSTA(3)
- IQ(LQHOLD+2) = JSLU - JSLGO
- IQ(LQHOLD+3) = JSLF - JSLGO
- IQ(LQHOLD) = IOR (IQ(LQHOLD), 1)
- RETURN
-
-+SEQ, QEJECT, N=22.
-C---- Reposition the file
-
- 61 IF (IN_DOX.EQ.1) CALL P_KILL ('ARRINF - seek not allowed')
-
-C---- REWIND
-
- IF (IN_DOX.EQ.0) THEN
- REWIND IN_LUN
- ELSE
- CLOSE (IN_LUN)
- CALL LUNRESV (IN_LUN,0)
- IQ(LARRV+1) = 0
- IQ(LARRV+2) = 0
- ENDIF
-
- IF (IQ(LARRV+7).GE.0) IQ(LARRV+7)= 0
- IQ(LARRV+5) = 0
- IQ(LARRV+8) = 0
- IQ(LARRV+9) = 0
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, ARRLNF, T=JOIN, IF=QFIO.
- SUBROUTINE ARRLN (LUN,LINE,NTXR)
-
-C- Read one line of text, using Fortran
-C. started 16-mar-92
-
- CHARACTER LINE*512
-
-
-+SELF, IF=XDEBUG, IF=XARRLN.
- PRINT *, 'ARRLN - trying to read 1 line from LUN=',LUN
-+SELF, IF=QF_DEC.
- READ (LUN,8000,END=41) NCH, LINE(1:NCH)
- 8000 FORMAT (Q,A)
-+SELF, IF=QF_IBM.
- READ (LUN,NUM=NCH,END=41) LINE
-+SELF, IF=-QF_IBM, IF=-QF_DEC.
- READ (LUN,8000,END=41) LINE
- 8000 FORMAT (A)
- NCH = LENOCC (LINE)
-+SELF.
-
- NTXR = NCH
- RETURN
-
-C-- EoF
-
- 41 NTXR = -1
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, ARRNXD.
- SUBROUTINE ARRNXD (JSTEP)
-
-C- Set the limit of the next deck, find type of the deck after
-C- JSTEP = 1 step to next deck
-C- 0 find the end of current deck only
-C- -1 determine also the type of the current deck
-C. started 5-mar-92
-
-+CDE, Q, PY.
-C-------------- End CDE --------------------------------
-
-
- JSLA = IQ(LQHOLD+1)
- JSLE = JSLA + IQ(LQHOLD+2)
-
-C-- JSTEP > 0: step to next deck
-
- IF (JSTEP.GT.0) THEN
- IF (JDKNEX.EQ.-13) CALL P_KILL ('Misplaced +MORE line')
-+SELF, IF=QDEBUG.
- IF (JDKNEX.LE.0) CALL P_CRASH ('trouble in ARRNXD')
-+SELF.
- JDKTYP = JDKNEX
- JSLA = JSLA + IQ(LQHOLD+3)
- IQ(LQHOLD+1) = JSLA
- IQ(LQHOLD+2) = JSLE - JSLA
- IF (JDKTYP.NE.6) GO TO 24
- RETURN
- ENDIF
-
-C-- JSTEP = <0: type of current deck
-
- IF (JSTEP.LT.0) THEN
- CALL NEXTSI (JSLA,JDKTYP,INCRAD)
- ENDIF
-
-C-- find end of current deck
-
- 24 CALL NEXTDE (JSLA+1,JSLE,JSLF,JDKNEX,INCRAD)
- IQ(LQHOLD+3) = JSLF - JSLA
-
- IF (JDKNEX.NE.0) RETURN
-
- IF (IQ(LARRV+8).NE.0) JDKNEX= 6
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+PATCH, DEPART. Output routines
-+DECK, DPEXGO.
- SUBROUTINE DPEXGO
-
-C- Ready to write first line of new routine,
-C- called from DPEXE.
-C. started 21-jan-92
-
-+CDE, SLATE, SLATLN, QBITS19, MQCM.
-+CDE, MUSEBC, Q, PY.
-+CDE, CHEXC, CM_TYP, DEPCOM, DEPMOD, DEPSUB, M_ANAC.
-+CDE, FLINKC.
-C-------------- End CDE --------------------------------
- EQUIVALENCE (LASML,JD_SML), (LASMP,JD_SMP), (LXASM,JD_SMX)
-
- CHARACTER CHMARK*1, LINE*256, COLS(256)*1
- EQUIVALENCE (LINE,SLLINE)
- EQUIVALENCE (COLS,LINE)
-
-
- IF (JD_NEW.LT.0) GO TO 29
-
-C-- Decide logical stream at the start of deck
-
- JD_DTD = JD_DTN
- IF (JD_DTD.EQ.0) JD_DTD= JD_DTP
-
- JD_DIV = NVEXDK(3) + 2*NVEXDK(4) + 1
-C- = 1 normal, 2 diverted, 3 xdiv/normal, 4 xdiv/diverted
-
-C-- Find the ASML bank for the logical stream
-
- LASMT = LQ(LHASM-JD_DTD)
- LASML = LQ(LASMT-JD_DIV-1)
-
-C-- do the re-assignment if requested
-
- J = IQ(LASML+11)
- IF (J.NE.0) THEN
- JD_DTD = J/8
- J = MOD (J,8)
- IF (J.NE.0) JD_DIV= J
- LASMT = LQ(LHASM-JD_DTD)
- LASML = LQ(LASMT-JD_DIV-1)
- ENDIF
-
-+SEQ, QEJECT.
-C-- Find the ASML bank for the physical stream
-
- MUSE = IQ(LASML+1)
- IF (MUSE.EQ.0) THEN
- LASMP = LASML
- JDP_DT = JD_DTD
- JDP_DV = JD_DIV
- GO TO 24
- ENDIF
-
- JDP_DT = MUSE / 8
- JDP_DV = MOD (MUSE,8)
- LASM = LQ(LHASM-JDP_DT)
- IF (JDP_DV.NE.0) THEN
- LASMP = LQ(LASM-JDP_DV-1)
- ELSE
- LASMP = LASM
- ENDIF
-
- 24 LXASM = LQ(LASMP-1)
-
-C---- Decide the processing mode
-
- IQ(LASML+8) = IQ(LASML+8) + 1
- JD_SPL = IQ(LASMP+2)
- JD_MOD = 0
-
-C-- exit for T=BYPASS
-
- IF (JD_SPL.EQ.0) THEN
- NVEXDK(1) = 0
- NVEXDK(5) = NVEXDK(2)
- IQ(LXASM+3) = IQ(LXASM+3) + 1
- RETURN
- ENDIF
-
- IX_EXT = IQ(LASML+5)
- IX_RH = IQ(LASML+6)
- IX_SUB = IQ(LASML+7)
-
- IF (IX_SUB.EQ.0) GO TO 29
-
-C-- prepare the control-character substitution ready for use
-
- CALL NA_GET (IX_SUB,LINE,1)
- NCH_SUB = MIN (8, NDSLAT/2)
-
- JJ = 0
- DO 27 J=1,NCH_SUB
- CH_SUBS(J:J) = COLS(JJ+1)
- CH_SUBT(J:J) = COLS(JJ+2)
- 27 JJ = JJ + 2
-
-C---- All mode parameters ready, start
-
- 29 JD_NEW = 0
- JD_NLI = 0
- JD_LUN = IQ(LXASM+2)
- JD_MOD = JD_SPL
- IF (NEWINC.NE.0) JD_MOD= 0
- IF (JD_MOD.LT.3) JD_MOD= 0
- IF (JD_SPL.GE.2) GO TO 41
-
-+SEQ, QEJECT.
-C------ Normal sequential mode ---------------
-
- IF (JD_LUN.GT.0) GO TO 34
-
-C-- open output file for first deck on this stream
-
- LUN_TYP = LUN_TYP + 1
- JD_LUN = LUN_TYP
- IXFLUN = IQ(LASMP+3)
-
- IF (IXFLUN.EQ.0)
- + CALL P_FATAL ('output file name missing')
-
- CALL FLINK (JD_LUN, 6, -1, 0)
- IF (IXFLUN.LT.0) CALL P_FATAL ('OPEN failure')
-+SELF, IF=QCIO.
- JD_LUN = LUNFD
-+SELF.
- IQ(LXASM+2) = JD_LUN
-
-C-- Write routine header card if needed
-
- 34 IF (IX_RH.EQ.0) RETURN
-
- JTX = NA_JTX (IX_RH)
- NTX = NDSLAT
-
- CHMARK = TEXT(JTX)
-
- JTX = JTX + 1
- NTX = NTX - 1
- NPUT = 0
-
- 37 JF = ICFILA (CHMARK,TEXT(JTX),1,NTX)
- N = JF - 1
- IF (N.GT.0) THEN
- CALL CCOPYL (TEXT(JTX),COLS(NPUT+1),N)
- NPUT = NPUT + N
- JTX = JTX + N
- NTX = NTX - N
- ENDIF
-
- IF (NTX.GT.0) THEN
- CALL NA_GET (IXEXID,LINE,NPUT+1)
- NPUT = NESLAT - 1
- JTX = JTX + 1
- NTX = NTX - 1
- IF (NTX.GT.0) GO TO 37
- ENDIF
-
-+SELF, IF=QCIO.
- NPUT = NPUT + 1
- LINE(NPUT:NPUT) = CHAR(NEWLN)
- CALL CIPUT (JD_LUN,LINE,NPUT,ISTAT)
- IF (ISTAT.NE.0) CALL P_FATAM ('CIO write fails')
-+SELF, IF=QFIO.
- WRITE (JD_LUN, '(A)') LINE(1:NPUT)
-+SELF.
- JD_NLI = 1
- RETURN
-
-+SEQ, QEJECT.
-C------ SPLIT mode ---------------
-
- 41 IF (JD_LUN.GE.0) GO TO 44
- IQ(LXASM+2) = 0
- IXFLUN = IQ(LASMP+3)
- IF (IXFLUN.EQ.0) GO TO 44
-
-C-- open the log file for first deck on this stream
-
- LUN_TYP = LUN_TYP + 1
- JD_LUN = LUN_TYP
- CALL FLINK (JD_LUN, 6, -1, 0)
- IF (IXFLUN.LT.0) CALL P_FATAL ('OPEN failure')
-+SELF, IF=QCIO.
- JD_LUN = LUNFD
-+SELF.
- IQ(LXASM+2) = JD_LUN
-
-C-- construct the file name for the split file
-
- 44 JD_LOG = JD_LUN
- JD_LUN = IQ(LHASM+1)
- CHLIFI = ' '
- JP = 1
-
- IX = IQ(LASMP+4)
- IF (IX.NE.0) THEN
- CALL NA_GET (IX, CHLIFI, JP)
- JP = NESLAT
- ENDIF
-
- CALL NA_GET (IXEXID, CHLIFI, JP)
- CALL CUTOL (CHLIFI(JP:NESLAT))
- JP = NESLAT
-
- IF (IX_EXT.NE.0) THEN
- CALL NA_GET (IX_EXT, CHLIFI, JP)
- JP = NESLAT
- ENDIF
- NLIFI = JP - 1
-
- MODEFI = 6
- IF (JD_MOD.NE.0) MODEFI= 7
-
- CALL FLINK (JD_LUN, MODEFI, 0, 0)
- IF (IXFLUN.LT.0) CALL P_FATAL ('OPEN failure')
- IF (LUNOLD.EQ.0) JD_MOD = 0
-+SELF, IF=QCIO.
- JD_LUN = LUNFD
-+SELF.
- IF (JD_MOD.EQ.0) RETURN
-
-C------ Initiate processing for MODIFY ---------------
-
- MO_JSA = LQLEND(3)
- MO_JSL = MO_JSA
- MO_JSE = LQLSTA(4)
-
-+SELF, IF=QCIO.
- JTXA = MLIAD(MO_JSA)
- JTXE = MLIAD(MO_JSE)
- NMAX = JTXE - JTXA - 2048
- IF (LUNSIZ.GE.NMAX) GO TO 79
-
- CALL CIGET (JD_LUN, TEXT(JTXA), NMAX, NTXR, ISTAT)
- IF (ISTAT.NE.0) GO TO 79
-
- JTXE = JTXA + NTXR
- JSLE = MO_JSL
- LIMIT = MO_JSE - 4
-
- DO 54 JTX=JTXA,JTXE-1
- IF (ICHAR(TEXT(JTX)).EQ.NEWLN) THEN
- JSLE = JSLE + 1
- MLIAD(JSLE) = JTX + 1
- IF (JSLE.GE.LIMIT) GO TO 79
- ENDIF
- 54 CONTINUE
-
- IF (MLIAD(JSLE).NE.JTXE) THEN
- TEXT(JTXE) = CHAR(NEWLN)
- JTXE = JTXE + 1
- JSLE = JSLE + 1
- MLIAD(JSLE) = JTXE
- ENDIF
-
- MO_JSE = JSLE
- LQLEND(3) = JSLE
- RETURN
-
- 79 JD_MOD = 0
-+SELF.
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, DPEXE.
- SUBROUTINE DPEXE (LDO)
-
-C- EXE output of next lot
-C. started 21-jan-92
-
-+CDE, CCPARA, MUSEBC, Q, PY.
-+CDE, DEPCOM, DEPSUB.
-C-------------- End CDE --------------------------------
-
-
- JSLX = IQ(LDO+1)
- NSLX = IQ(LDO+2)
- IF (JCCTYP.NE.0) THEN
- JSLX = JSLX + 1
- NSLX = NSLX - 1
- ENDIF
-
- IF (NSLX.LE.0) RETURN
- IF (JD_NEW.NE.0) THEN
- CALL DPEXGO
- IF (NVEXDK(1).EQ.0) RETURN
- ENDIF
-
- JD_NLI= JD_NLI + NSLX
-
-C-- Control character substitution
-
- IF (IX_SUB.EQ.0) GO TO 31
- JSL = JSLX
- N = NCH_SUB
-
- DO 24 JJ=1,NSLX
- JTX = MLIAD(JSL)
- NTX = MLIAD(JSL+1) - JTX - NCHNEWL
- IF (NTX.LT.4) GO TO 24
-
- J = INDEX (CH_SUBS(1:N),TEXT(JTX))
- IF (J.EQ.0) GO TO 24
- IF (JPTYPE(TEXT(JTX)).EQ.0) GO TO 24
-
- TEXT(JTX) = CH_SUBT(J:J)
- 24 JSL = JSL + 1
-
-C---- Normal output without MODIFY check
-
- 31 IF (JD_MOD.NE.0) GO TO 41
-+SELF, IF=QCIO.
- 32 JTX = MLIAD(JSLX)
- NTX = MLIAD(JSLX+NSLX) - JTX
- CALL CIPUT (JD_LUN,TEXT(JTX),NTX,ISTAT)
- IF (ISTAT.NE.0) CALL P_FATAM ('CIO write fails')
-+SELF, IF=QFIO.
- 32 JSL = JSLX
- DO 34 JJ=1,NSLX
- JTX = MLIAD(JSL)
- NTX = MLIAD(JSL+1) - JTX - NCHNEWL
- IF (NTX.NE.0) THEN
-+SELF, IF=QFIO, IF=QF_IBM.
- IF (JD_DTD.EQ.1) NTX= MIN(NTX,80)
-+SELF, IF=QFIO.
- CALL DPEXLN (TEXT(JTX), NTX)
- ELSE
- WRITE (JD_LUN, '(A)')
- ENDIF
- 34 JSL = JSL + 1
-+SELF.
- RETURN
-
-C---- Output for MODIFY
-
- 41 CALL DPEXMO (JSLX,NSLX)
- IF (JD_MOD.EQ.0) GO TO 32
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, DPEXLNF, T=JOIN, IF=QFIO.
- SUBROUTINE DPEXLN (LINE,NTX)
-
-C- Write one line, using Fortran
-C. started 7-oct-93
-
-+CDE, DEPCOM.
-C-------------- End CDE --------------------------------
- CHARACTER LINE*512
-
-
- WRITE (JD_LUN, '(A)') LINE(1:NTX)
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, DPEXMOC, IF=QCIO.
-+SEQ, QCARD1, R=DPEXMO.
- SUBROUTINE DPEXMO (JSLP,NSLP)
-
-C- MODIFY: check new lines against disk file
-C- if NSL zero: check we have actually reached the EoF
-C. started 7-OCT-93
-
-+CDE, FLINKC, DEPCOM, DEPMOD, Q.
-C-------------- End CDE --------------------------------
-
-
- JSLX = JSLP
- NSLX = NSLP
- IF (NSLX.EQ.0) GO TO 41
- IF (MO_JSL+NSLX.GT.MO_JSE) GO TO 44
-
- JTX = MLIAD(JSLX)
- JMO = MLIAD(MO_JSL)
-
- NTX = MLIAD(JSLX+NSLX) - JTX
- NMO = MLIAD(MO_JSL+NSLX) - JMO
- IF (NMO.NE.NTX) GO TO 44
-
- IF (ICEQU(TEXT(JTX),TEXT(JMO),NTX).NE.0) GO TO 44
- MO_JSL = MO_JSL + NSLX
- RETURN
-
-C-- Check Eof reached
-
- 41 IF (MO_JSL.EQ.MO_JSE) RETURN
-
-C-- Comparison failure, re-write the material up to now
-
- 44 JD_MOD = 0
- CALL CICLOS (JD_LUN)
- CALL CIOPEN (JD_LUN, 'w', CHLIFI(1:NLIFI), ISTAT)
- IF (ISTAT.NE.0) CALL P_FATAM ('CIO open for re-write fails')
-
- JMO = MLIAD(MO_JSA)
- NMO = MLIAD(MO_JSL) - JMO
- IF (NMO.EQ.0) RETURN
-
- CALL CIPUT (JD_LUN,TEXT(JMO),NMO,ISTAT)
- IF (ISTAT.NE.0) CALL P_FATAM ('CIO write fails')
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, DPEXMOF, IF=QFIO, IF=-QS_VMS.
-+SEQ, QCARD1, R=DPEXMO.
- SUBROUTINE DPEXMO (JSLP,NSLP)
-
-C- MODIFY: check new lines against disk file
-C- if NSL zero: check we have actually reached the EoF
-C. started 8-Nov-93
-
-+CDE, SLATLN, DEPCOM, DEPMOD, Q.
-C-------------- End CDE --------------------------------
-
-
- JSLX = JSLP
- NSLX = NSLP
- IF (NSLX.EQ.0) GO TO 61
-
- 21 JMO = MLIAD(MO_JSL)
- CALL ARRLN (JD_LUN, TEXT(JMO), NTX)
- IF (NTX.LT.0) GO TO 41
-
- JTX = MLIAD(JSLX)
- N = MLIAD(JSLX+1) - JTX - NCHNEWL
- IF (N.NE.NTX) GO TO 40
-
- IF (NTX.NE.0) THEN
- IF (ICEQU(TEXT(JTX),TEXT(JMO),NTX).NE.0) GO TO 40
- ENDIF
-
- MLIAD(MO_JSL+1) = JMO + NTX
- JSLX = JSLX + 1
- NSLX = NSLX - 1
- IF (NSLX.NE.0) GO TO 21
- RETURN
-
-C-- Comparison failure, reposition
-
- 40 BACKSPACE JD_LUN
- 41 JSLP = JSLX
- NSLP = NSLX
- JD_MOD = 0
- RETURN
-
-C-- Check EoF reached
-
- 61 CALL ARRLN (JD_LUN, SLLINE, NTX)
- IF (NTX.LT.0) RETURN
- BACKSPACE JD_LUN
- ENDFILE JD_LUN
- JD_MOD = 0
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, DPEXMOX, IF=QFIO, IF=QS_VMS.
- SUBROUTINE DPEXMO (JSLP,NSLP)
-
-C- MODIFY: check new lines against disk file
-C- if NSL zero: check we have actually reached the EoF
-C. started 8-Nov-93
-
-+CDE, SLATLN, DEPCOM, DEPMOD, Q.
-C-------------- End CDE --------------------------------
-
-
- JSLX = JSLP
- NSLX = NSLP
- IF (NSLX.EQ.0) GO TO 41
-
- JSLU = MO_JSL
- JMO = MLIAD(JSLU)
- 21 CALL ARRLN (JD_LUN, TEXT(JMO), NTX)
- IF (NTX.LT.0) GO TO 42
-
- JTX = MLIAD(JSLX)
- N = MLIAD(JSLX+1) - JTX - NCHNEWL
- IF (N.NE.NTX) GO TO 42
-
- IF (NTX.NE.0) THEN
- IF (ICEQU(TEXT(JTX),TEXT(JMO),NTX).NE.0) GO TO 42
- ENDIF
-
- JMO = JMO + NTX
-+SELF, IF=QNEWLINE.
- TEXT(JMO) = CHAR(NEWLN)
- JMO = JMO + 1
-+SELF.
- JSLU = JSLU + 1
- MLIAD(JSLU) = JMO
-
- JSLX = JSLX + 1
- NSLX = NSLX - 1
- IF (NSLX.NE.0) GO TO 21
- MO_JSL = JSLU
- RETURN
-
-C-- Check EoF reached
-
- 41 CALL ARRLN (JD_LUN, SLLINE, NTX)
- IF (NTX.LT.0) RETURN
-
-C-- Comparison failure, re-write the material up to now
-
- 42 JD_MOD = 0
- CLOSE (JD_LUN)
- CALL FLINK (JD_LUN, 6, 0, 0)
-
- JSL = MO_JSA - 1
- 44 JSL = JSL + 1
- IF (JSL.GE.MO_JSL) RETURN
- JTX = MLIAD(JSL)
- NTX = MLIAD(JSL+1) - JTX - NCHNEWL
- IF (NTX.NE.0) THEN
- CALL DPEXLN (TEXT(JTX), NTX)
- ELSE
- WRITE (JD_LUN, '(A)')
- ENDIF
- GO TO 44
- END
-+SEQ, QCARDL. =====================================================
-+DECK, DPEXTM.
- SUBROUTINE DPEXTM (JTERM)
-
-C- End of deck or routine
-C- JTERM = +1 end of deck
-C- -1 about to start a new routine in the same deck
-C. started 6-oct-93
-
-+CDE, SLATLN, SLATE, QBITS19, QBANKS, QPAGE, QUNIT.
-+CDE, CHEXC, CM_TYP, DEPCOM, FLINKC, INCLC, MUSEBC, Q, PY.
-C-------------- End CDE --------------------------------
- EQUIVALENCE (LASML,JD_SML), (LASMP,JD_SMP), (LXASM,JD_SMX)
- CHARACTER LINE*128
- EQUIVALENCE (LINE,SLLINE)
-
-+SEQ, Q_OR.
-
-
- IF (JD_SPL.LT.2) GO TO 41
-
-C------ SPLIT or MODIFY mode: close split file
-+SELF, IF=QMVAX.
-C-- if assembler: write .END line
- IF (JD_DTD.EQ.JAS_TYP) CALL DPEXVAX
-+SELF.
-C-- if MODIFY: check EoF reached
- IF (JD_MOD.NE.0) CALL DPEXMO (0,0)
-
-C-- register the name of the include file
- IF (JD_DTD.EQ.JIN_TYP) THEN
- CALL MQLIFT (L, LQINCL,1, JBKINC,3)
- IQ(L) = IOR (IQ(L), MX_SELF)
- IQ(L+1) = IXEXID
- IF (JD_MOD.EQ.0) IQ(L)= IOR (IQ(L),KM5)
- ENDIF
-
-+SELF, IF=QCIO.
- CALL CICLOS (JD_LUN)
-+SELF, IF=QFIO.
- CLOSE (JD_LUN)
-+SELF.
-+SEQ, QEJECT.
-C-- Write the entry into the log file
-
- IF (JD_LOG.LE.0) GO TO 37
- LINE = ' '
- CALL STRMID (JD_DTD, JD_DIV, LINE,2)
- N = MAX(NESLAT,12) + 1
-
- CALL NA_GET (IXEXID, LINE,N)
- N = NESLAT
-
- IF (IX_EXT.NE.0) THEN
- CALL NA_GET (IX_EXT, LINE,N)
- N = NESLAT
- ENDIF
-
-C-- add the names of the called include files
-
- IF (JD_MOD.EQ.0) GO TO 33
- LINE(N+3:N+6) = 'same'
- N = N + 6
-
- 33 JTK = 0
- IF (N_INCL.EQ.0) GO TO 36
- 34 JTK = JTK + 1
- CALL NA_GET (IX_INCL(JTK),LINE,N+2)
- N = NESLAT + 1
- LINE(N-1:N) = '.h'
- IF (JTK.EQ.N_INCL) GO TO 36
- IF (N.LT.72) GO TO 34
- N = N + 2
- LINE(N:N) = '+'
-
- 36 CALL CUTOL (LINE(1:N))
-+SELF, IF=QCIO.
- N = N + 1
- LINE(N:N) = CHAR(NEWLN)
- CALL CIPUT (JD_LOG, LINE,N, ISTAT)
- IF (ISTAT.NE.0) CALL P_FATAM ('CIO write fails')
-+SELF, IF=QFIO.
- WRITE (JD_LOG,9000) LINE(1:N)
-+SELF.
- IF (JTK.LT.N_INCL) THEN
- LINE = ' '
- N = 10
- GO TO 34
- ENDIF
-
- 37 IF (JD_MOD.NE.0) GO TO 79
-
-C------ Accounting
-
- 41 IQ(LXASM+4) = IQ(LXASM+4) + JD_NLI
- IQ(LASML+10) = IQ(LASML+10) + JD_NLI
-
- IQ(LXASM+3) = IQ(LXASM+3) + 1
- IF (JD_MULT.EQ.0) THEN
- IQ(LASML+9) = IQ(LASML+9) + 1
- ENDIF
-
-C-- Print the log line for option MAPASM
-
- IF (MOPTIO(13).EQ.0) GO TO 78
- LINE = ' Written'
- CALL CSETDI (NQDKNO, LINE,10,17)
- LINE(19:20) = 'p='
- CALL NA_GET (IXEXPAT,LINE,21)
- JP = MAX (NESLAT,29)
- LINE(JP+1:JP+2) = 'd='
- CALL NA_GET (IXEXDEC,LINE,JP+3)
- JP = MAX (NESLAT,44)
- CALL CSETDI (JD_NLI, LINE,JP+1,JP+5)
-
- LINE(JP+7:JP+14) = 'lines to'
- JP = JP + 15
- IF (JD_SPL.LT.2) THEN
- LINE(JP+1:JP+7) = 'logical'
- JP = JP + 9
- CALL STRMID (JD_DTD, JD_DIV, LINE,JP)
- N = NESLAT - 1
- ELSE
- LINE(JP+1:JP+4) = 'file'
- JP = JP + 5
- LINE(JP+1:JP+NLIFI) = CHLIFI(1:NLIFI)
- N = JP + NLIFI
- ENDIF
- WRITE (IQPRNT,9000) LINE(1:N)
- NQUSED = NQUSED + 1
- NQLLBL = 0
-
- 78 JD_MULT = JD_MULT + 1
- 79 JD_NLI = 0
- JD_NEW = JTERM
- RETURN
-
- 9000 FORMAT (A)
- END
-+SEQ, QCARDL. =====================================================
-+DECK, DPEXVAX, IF=QMVAX.
- SUBROUTINE DPEXVAX
-
-C- On the VAX at the end of an assembler routine in SPLIT mode:
-C- write a .END line to keep the assembler happy
-
-+CDE, CCPARA.
-+CDE, MUSEBC, Q, PY.
-C-------------- End CDE --------------------------------
- CHARACTER LINE*80
- EQUIVALENCE (LINE,TEXT)
-
-
- IF (MOPTIO(24).NE.0) RETURN
-C! IF (NVEXDK(5).EQ.0) RETURN
- IF (NVEXDK(1).EQ.0) RETURN
-
- LINE(1:10) = ' .END'
-C- _:.=+=.: 1
- JTX = 6
-+SELF, IF=QNEWLINE.
- TEXT(JTX) = CHAR(NEWLN)
- JTX = JTX + 1
-+SELF.
- MLIAD(2) = JTX
-
- LQ(LSERV-2) = 0
- IQ(LSERV+1) = 1
- IQ(LSERV+2) = 1
- IQ(LSERV+3) = -99
-
- JCCTYP = 0
-C! IF (NVEXDK(2).NE.0) THEN
-C! CALL DPLIST (0,LSERV,0,0)
-C! ENDIF
-C! IF (NVEXDK(1).EQ.0) RETURN
-
- CALL DPEXE (LSERV)
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, DPHEAD.
- SUBROUTINE DPHEAD
-
-C- LIST current deck/patch identifier if not yet done;
-C- if done but page almost full: page eject
-C. started 10-feb-92
-
-+CDE, SLATE, QPAGE, QUNIT.
-+CDE, CHEXC, MUSEBC, Q, PY.
-C-------------- End CDE --------------------------------
-
-
- IF (NQNEWH.NE.0) GO TO 21
- IF (NQUSED.GE.NQLTOK) GO TO 32
- RETURN
-
-C-- start ouput for new deck
-
- 21 NQDKPG = 0
-
- CHEXPD = 'p='
- CALL NA_GET (IXEXPAT,CHEXPD,3)
- IF (IXEXDEC.NE.0) THEN
- J = NESLAT + 3
- CHEXPD(J-2:J-1) = 'd='
- CALL NA_GET (IXEXDEC,CHEXPD,J)
- ENDIF
- NCHEPD = NESLAT - 1
-
- IF (NVEXDK(2).EQ.0) GO TO 24
- IF (MOPTIO(3).NE.0) GO TO 24
- IF (NQJOIN.NE.0) GO TO 24
- IF (NQUSED.LE.8) GO TO 32
-
-C-- first deck in a patch with a short blank deck?
-
- IF (NQLPAT.EQ.0) GO TO 31
- IF (IXEXDEC.EQ.0) GO TO 31
- IF (NQUSED-NQLPAT.GT.8) GO TO 31
-
- 24 IF (NQUSED.LT.NQLTOL) GO TO 32
-
- 31 NQUSED = NQLMAX
- 32 CALL DPPAGE
- NQNEWH = 0
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, DPPAGE.
- SUBROUTINE DPPAGE
-
-C- LIST current deck/patch identifier, with or without page eject
-C. started 10-sep-93
-
-+CDE, SLATE, SLATLN.
-+CDE, QCHAR, QPAGE, QUNIT, CHEXC.
-C-------------- End CDE --------------------------------
- CHARACTER TAIL*13
- EQUIVALENCE (TAIL, SLLINE(161:))
-
-
- NQJOIN = 0
- NQLPAT = 0
- IF (NQUSED.GT.NQLMAX) THEN
- NQUSED = NQUSED - NQLMAX
- RETURN
- ENDIF
-
- IF (NQUSED.LT.NQLTOL) THEN
- NEWPAG = 0
- ELSE
- NEWPAG = 1
- ENDIF
-
- NCOL = NQCPGH
- SLLINE(1:176) = ' '
-
-C-- construct left edge: 167 PATCHY
-
- CALL CSETDI (NQDKNO, SLLINE, 2,6)
- CALL CLEFT (SLLINE, 3,6)
- J = NESLAT + 1
- IF (IXEXPAM.NE.0) THEN
- CALL NA_GET (IXEXPAM, SLLINE(1:J+7), J)
- JEQ = NESLAT + 2
- ELSE
- SLLINE(J:J+5) ='cradle'
- JEQ = J + 8
- ENDIF
-
-C-- prepare right edge: P=pname dname 1 === pg 123
-C- _:.=+=.: 1_:.
- NQDKPG = NQDKPG + 1
- CALL CSETDI (NQDKPG, TAIL, 1,2)
-
- JID = NCOL - 13 - NCHEPD
- SLLINE(JID:JID+NCHEPD-1) = CHEXPD(1:NCHEPD)
-
- IF (NQNEWH.EQ.0) GO TO 27
-
-C-- starting a new deck
-
- NEQ = JID - JEQ - 2
- IF (NEQ.GT.0) SLLINE(JEQ:JEQ+NEQ-1)= CQEQS(1:NEQ)
-
- IF (NEWPAG.EQ.0) THEN
- TAIL(4:13)= CQEQS(1:10)
- ELSE
- TAIL(4:6)= CQEQS(1:3)
- ENDIF
-
-C-- page eject?
-
- 27 IF (NEWPAG.EQ.0) GO TO 31
- SLLINE(1:1) = '1'
- NQPAGE = NQPAGE + 1
-
- CALL CSETDI (NQPAGE, TAIL,11,13)
- J = NFSLAT - 2
- TAIL(J:J+1) = 'pg'
- SLLINE(NCOL-12:NCOL) = TAIL
- WRITE (IQPRNT,9028) SLLINE(1:NCOL)
- NQUSED = 2
- NQLLBL = 1
- RETURN
-
- 31 CALL DPBLAN (0)
- SLLINE(NCOL-12:NCOL) = TAIL
- WRITE (IQPRNT,9028) SLLINE(1:NCOL)
- NQUSED = NQUSED + 2
- RETURN
-
- 9028 FORMAT (A/)
- END
-+SEQ, QCARDL. =====================================================
-+DECK, DPLIST.
- SUBROUTINE DPLIST (MODE,LDO,LACT,IFLSTA)
-
-C- LIST output of next lot for DOXQT
-C- MODE = 0 self material
-C- 1 CDE expansion called from X_SEQ
-C- 2 comment line
-C- 3 +SELF header line
-C- 4 +CDE call line
-C- 5 foreign material to be stored
-C- 6 control line
-C- LDO bank holding the lines to be listed
-C- LACT if = zero: material of this deck
-C- if /=zero: ACT bank driving the material into this deck
-C- IFLSTA if = zero: material group continued
-C- if > zero: start of a material group
-C- = 1: basic level, > 1: higher levels
-C- (used only for MODEAN = 1 and 5)
-C- also: JCCTYP in /CCPARA/ is the type of the first line in LDO
-C. started 21-jan-92
-
-+CDE, QBITS19, QPAGE, QUNIT.
-+CDE, CCTYPE, CCPARA, MUSEBC, TAGC, MQCM, Q, PY.
-C-------------- End CDE --------------------------------
- CHARACTER MASKF*4, MASKL*4, MASKK(4)*4
- DATA MASKK / ' z ', ' .z ', ' y ', ' .y ' /
-
-+SEQ, Q_JBYT, Q_AND.
-
-
- IF (NQNEWH.NE.0) CALL DPHEAD
- IFLBL = 0
- IFLAFT = 0
- JSL = IQ(LDO+1)
- NSL = IQ(LDO+2)
- IF (NSL.LE.0) RETURN
- IF (MODE.EQ.1) GO TO 54
-
- IFLDEL = IAND (IQ(LDO),KM5+KM6)
- IFLCUT = IFLDEL
-
- LNACT = LACT
- IF (LNACT.EQ.0) GO TO 38
- LNORG = IQ(LDO-2)
- LINUM = IQ(LDO+3)
- LEVEL = JBYT (IQ(LDO),21,5)
- CALL DPTAG (0,LEVEL,0)
- GO TO 39
-
- 38 LLACT = 0
- LLORG = 0
- IF (JSL.LT.LQLEND(2)) THEN
- LINUM = JSL - JSLORG
- ELSE
- LINUM = -9999
- ENDIF
- 39 JUMP = MODE + 1
- GO TO (44, 54, 61, 41, 51, 71, 80), JUMP
-C- mode= 0 1 2 3 4 5 6
-
-+SELF, IF=QDEBUG.
- CALL P_CRASH (' DPLIST - invalid MODE')
-+SELF.
-+SEQ, QEJECT.
-C---- Self material
-
- 41 IFLBL = 1
- MASKF = ' + '
- MASKL = ' - '
- IF (JCCTYP.NE.MCCFAU) GO TO 81
- MASKF= '!!!!'
- IFLCUT = 7
- GO TO 81
-
- 44 MASKL = ' - '
- IF (JCCTYP.EQ.0) GO TO 84
- MASKF = ' -- '
- IF (JCCTYP.EQ.MCCEND) THEN
- IFLAFT = IAND (IQ(LDO),KM17)
- ELSE
- IFLBL = IAND (IQ(LDO),KM17)
- ENDIF
- GO TO 81
-
-C---- CDE expansion
-
- 51 MASKF = ' : '
- GO TO 81
-
- 54 IFLDEL = 0
- IFLCUT = 0
- LINUM = -9999
- MASKL = ' '
- IF (IFLSTA.EQ.0) GO TO 84
- J = MIN (IFLSTA,2)
- IF (IFALTN.NE.0) J= J+2
- MASKF = MASKK(J)
- GO TO 81
-
-C---- Comment
-
- 61 MASKF = ' c '
- GO TO 81
-
-C---- Foreign material out from this deck
-
- 71 MASKL = ' > '
- IF (IFLSTA.EQ.0) GO TO 84
-
- IFLBL = 1
- IF (JCCTYP.EQ.MCCKEE) GO TO 80
-
- IF (IAND(IQ(LDO),KM18).NE.0) GO TO 80
- MASKF = ' ++ '
- GO TO 81
-
-C---- Stand-alone control line
-
- 80 MASKF = ' + '
- IF (JCCTYP.GE.MCCDEC) IFLBL= 1
-
-C---- list the control-line first
-
- 81 IF (NVEXDK(6).EQ.0) GO TO 82
- IF (LNACT.NE.0) MASKF(1:1) = '<'
- IF (IFLDEL.NE.0) MASKF(3:3) = '('
- IF (IFLBL.NE.0) THEN
- IF (NQUSED.GE.NQLTOK) THEN
- CALL DPPAGE
- ELSE
- CALL DPBLAN (1)
- ENDIF
- ENDIF
-
- JTX = MLIAD(JSL)
- NTX = MLIAD(JSL+1) - JTX - NCHNEWL
- CALL DPLINE (LINUM, MASKF, NTX, TEXT(JTX))
-
-C-- print line with env. variable substituition
-
- IF (ICCSUB.NE.0) CALL DPLINE (-1, ' ', NCHCCT, CCKORG)
- ICCSUB = 0
-
- IF (IFLAFT.NE.0) CALL DPBLAN (-1)
- 82 JSL = JSL + 1
- IF (IFLCUT.NE.0) RETURN
- NSL = NSL - 1
- IF (NSL.LE.0) RETURN
- LINUM = LINUM + 1
-
-C---- list the body of the lines
-
- 84 IF (LNACT.NE.0) MASKL(1:1) = '<'
- IF (IFLDEL.NE.0) MASKL(2:2) = '('
- DO 87 JJ=1,NSL
- JTX = MLIAD(JSL)
- NTX = MLIAD(JSL+1) - JTX - NCHNEWL
- CALL DPLINE (LINUM, MASKL, NTX, TEXT(JTX))
- LINUM = LINUM + 1
- 87 JSL = JSL + 1
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, DPLINE.
- SUBROUTINE DPLINE (LINUM,MASK,NCHL,LINE)
-
-C- Print one line for LIST
-C- LINUM is the line-number, not printed if -ve,
-C- MASK is the line-type identifier
-C- LINE of length NCHL is the text, void if NCHL <= 0
-C. started 5-aug-93
-
-+CDE, QCHAR, QPAGE, QUNIT, TAGC.
-C-------------- End CDE --------------------------------
- CHARACTER CHNUM*6, MASK*4, LINE*512
-
-
- IF (NQUSED.GE.NQLMAX) CALL DPPAGE
- IF (NQWYLDO.NE.0) GO TO 41
-
-C------ Without Wylbur line-numbers
-
- IF (NCHTAG.NE.0) THEN
- IF (92+NCHTAG.GE.NQCMAX) GO TO 31
- ENDIF
- 21 NQUSED = NQUSED + 1
- NQLLBL = 0
-
-C- _:.=+=
- CHNUM = ' '
- IF (LINUM.GE.0) CALL CSETDI (LINUM,CHNUM,2,6)
-
-C-- LINE is void
-
- IF (NCHL .GT.0) GO TO 25
- IF (NCHTAG.EQ.0) THEN
- WRITE (IQPRNT,9021) CHNUM,MASK
- ELSE
- WRITE (IQPRNT,9022) CHNUM,MASK,CHTAG(1:NCHTAG)
- NCHTAG = 0
- ENDIF
- RETURN
-
-C-- LINE is present
-
- 25 JE = NCHL
- IF (JE.GT.80) JE= ICFILA(' ', LINE,60,80) - 1
- IF (NCHTAG.EQ.0) THEN
- WRITE (IQPRNT,9025) CHNUM,MASK,LINE(1:JE)
- ELSE
- WRITE (IQPRNT,9026) CHNUM,MASK,LINE(1:JE),CHTAG(1:NCHTAG)
- NCHTAG = 0
- ENDIF
- IF (JE.EQ.NCHL) RETURN
-
-C-- LINE is longer than 80 characters
-
- 28 JA = JE + 1
- JE = NCHL
- IF (JE-JA.GE.72) JE= ICFILA(' ', LINE,JA+51,JA+71) - 1
- WRITE (IQPRNT,9028) LINE(JA:JE)
- NQUSED = NQUSED + 1
- IF (JE.LT.NCHL) GO TO 28
- RETURN
-
-C-- Print the tag stand-alone, if too long
-
- 31 IF (NQUSED.GE.NQLTOK) CALL DPPAGE
- NBL = NQCMAX - NCHTAG
- WRITE (IQPRNT,9025) CQBLAN(1:NBL), CHTAG(1:NCHTAG)
- NQUSED = NQUSED + 1
- NCHTAG = 0
- IF (NQWYLDO.EQ.0) GO TO 21
-
-+SEQ, QEJECT.
-C------ With Wylbur line-numbers
-
- 41 IF (NCHTAG.NE.0) THEN
- IF (102+NCHTAG.GE.NQCMAX) GO TO 31
- ENDIF
- NQUSED = NQUSED + 1
- NQLLBL = 0
-
- IF (NQWYLDO.LT.0) THEN
- IF (NQWYLDO.LT.-2) GO TO 43
- IF (NQWYLDO.EQ.-2) CHWYL = ' '
- NQWYLDO = NQWYLDO - 1
- GO TO 43
- ENDIF
-
- IF (LINUM.LT.0) THEN
- CHWYL = ' '
- GO TO 43
- ENDIF
-
-C- _:.=+=.: 1_:.=+=.: 2
-C- 123456. 12345
- CHWYL = ' . '
- NQWYL = NQWYL + 1
- CALL CSETDI (NQWYL,CHWYL,2,9)
- CALL CSETDI (LINUM,CHWYL,11,16)
-
-C-- LINE is void
-
- 43 IF (NCHL .GT.0) GO TO 45
- IF (NCHTAG.EQ.0) THEN
- WRITE (IQPRNT,9021) CHWYL,MASK
- ELSE
- WRITE (IQPRNT,9023) CHWYL,MASK,CHTAG(1:NCHTAG)
- NCHTAG = 0
- ENDIF
- RETURN
-
-C-- LINE is present
-
- 45 JE = NCHL
- IF (JE.GT.80) JE= ICFILA(' ', LINE,60,80) - 1
- IF (NCHTAG.EQ.0) THEN
- WRITE (IQPRNT,9025) CHWYL,MASK,LINE(1:JE)
- ELSE
- WRITE (IQPRNT,9027) CHWYL,MASK,LINE(1:JE),CHTAG(1:NCHTAG)
- NCHTAG = 0
- ENDIF
- IF (JE.EQ.NCHL) RETURN
-
-C-- LINE is longer than 80 characters
-
- 48 JA = JE + 1
- JE = NCHL
- IF (JE-JA.GE.72) JE= ICFILA(' ', LINE,JA+51,JA+71) - 1
- WRITE (IQPRNT,9029) LINE(JA:JE)
- NQUSED = NQUSED + 1
- IF (JE.LT.NCHL) GO TO 48
- RETURN
-
- 9021 FORMAT (A,A)
- 9022 FORMAT (A,A,T92,A)
- 9023 FORMAT (A,A,T102,A)
- 9025 FORMAT (A,A,A)
- 9026 FORMAT (A,A,A,T92,A)
- 9027 FORMAT (A,A,A,T102,A)
- 9028 FORMAT (17X,'>',A)
- 9029 FORMAT (27X,'>',A)
- END
-+SEQ, QCARDL. =====================================================
-+DECK, DPTAG.
- SUBROUTINE DPTAG (MODE,LEVEL,IXKEEP)
-
-C- Construct the next tail
-C- MODE = zero: normal P/D tag
-C- 1: action line
-C- = 2: KEEP tag
-C-
-C- LEVEL = 0, 1, 2, 3 ... foreign-in-foreign level
-C-
-C- IXKEEP the name index of the sequence for MODE 2
-C- = 0 if material continued
-C. started 20-sept-93
-
-+CDE, SLATE, QBITS19, QCHAR, QPAGE, QUNIT.
-+CDE, TAGC, Q, PY.
-C-------------- End CDE --------------------------------
- CHARACTER MASK*4, MASKK(5)*4
- DATA MASKK / ' x- ', ' z- ', ' .z-', ' y- ', ' .y-' /
-
-+SEQ, Q_JBYT, Q_AND.
-
-
- MODEX = MODE
- LEV = LEVEL
- IF (NCHTAG.LE.0) GO TO 29
- IF (LMODE.LT.0) GO TO 29
-
-C-- Print pending tag
-
- J = 1
- IF (LMODE.GE.2) THEN
- J = MIN (LMODE,3)
- IF (LALTN.NE.0) J= J+2
- ENDIF
- MASK = MASKK(J)
-
- NBL = NQCMAX - NCHTAG - 10
- NBL = MIN (NBL,81)
-
- CALL DPHEAD
- NQUSED = NQUSED + 1
- NQLLBL = 0
- WRITE (IQPRNT,9024) MASK,CQBLAN(1:NBL),CHTAG(1:NCHTAG)
- 9024 FORMAT (6X,A,A,A)
-
- NCHTAG = 0
- 29 NUMORG = IAND (IQ(LNORG), KM19-1)
- CHTAG(1:10) = ' '
- IF (MODEX.EQ.2) GO TO 61
-
-C-- Check same tag again
-
- IF (LNORG.EQ.0) GO TO 49
- IF (LNORG.NE.LLORG) GO TO 41
- IF (LNACT.NE.LLACT) GO TO 41
- IF (LMODE.GE.2) GO TO 41
- RETURN
-
-C-- Ready new tag
-
-C-- normal P/D tag
- 41 IF (MODEX.EQ.0) CALL CSETDI (LEV+1,CHTAG,1,1)
-
- CALL CSETDI (NUMORG, CHTAG,4,9)
- CALL CLEFT (CHTAG,4,9)
- JP = NESLAT
-
-C-- P/D tag
-
- IXPAT = IQ(LNORG+1)
- IXDECK = IQ(LNORG+2)
-
- IF (LEV.NE.0) THEN
- CHTAG(2:2) = 'x'
- GO TO 47
- ENDIF
-
- JTYPE = JBYT (IQ(LNACT),9,3)
- IF (JTYPE.EQ.0) THEN
- CHTAG(2:2) = 'D'
- ELSEIF (JTYPE.EQ.1) THEN
- CHTAG(2:2) = 'R'
- ELSEIF (JTYPE.EQ.2) THEN
- CHTAG(2:2) = 'B'
- ELSE
- CHTAG(2:2) = 'A'
- ENDIF
-
- 47 CHTAG(JP:JP) = '='
- JP = JP + 1
- CALL NA_GET (IXPAT,CHTAG,JP)
- JP = NESLAT
- CHTAG(JP:JP) = '.'
- JP = JP + 1
- CALL NA_GET (IXDECK,CHTAG,JP)
- NCHTAG = NESLAT - 1
- 49 LLORG = LNORG
- LLACT = LNACT
- LMODE = MODEX
- RETURN
-
-C-- KEEP tag
-
- 61 IF (LEV.NE.0) CALL CSETDI (LEV+1,CHTAG,1,1)
- CHTAG(2:2) = 'Z'
- IF (IXKEEP.EQ.0) THEN
- IF (LNORG.EQ.LLORG) THEN
- IF (MODEX+LEV.EQ.LMODE) GO TO 69
- ENDIF
- CHTAG(4:12) = 'continued'
- NCHTAG = 12
- GO TO 69
- ENDIF
-
- CALL CSETDI (NUMORG, CHTAG,4,9)
- CALL CLEFT (CHTAG,4,9)
- JP = NESLAT
- CHTAG(JP:JP) = ':'
- JP = JP + 1
- CALL NA_GET (IXKEEP,CHTAG,JP)
- NCHTAG = NESLAT - 1
- 69 LLORG = LNORG
- LMODE = MODEX + LEV
- LALTN = IFALTN
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, DPLACT.
- SUBROUTINE DPLACT
-
-C- LIST what action at LUPAN
-C. started 10-feb-92
-
-+CDE, SLATLN, QBITS19.
-+CDE, TAGC, Q, PY, MUSEBC.
-+CDE, M_ANAC.
-C-------------- End CDE --------------------------------
- CHARACTER LINE*80, MARK*18, MSG*14
- EQUIVALENCE (LINE,SLLINE), (MSG,SLERRM)
- EQUIVALENCE (MARK,SLLINE(63:))
-
-+SEQ, Q_JBYT, Q_AND.
-
-C-- Print clash warning
-
- LEVCL = JBYT (IQ(LUPAN),14,2)
- IF (LEVCL.EQ.0) GO TO 31
- IF (LEVCL.LT.NCLASH) GO TO 31
-
- MSG = 'Clash level 2:'
-C- _:.=+=.: 1_:.=
-
- IF (LEVCL.EQ.1) THEN
- MSG(13:13) = '1'
- JSEV = -1
- ELSE
- JSEV = 0
- ENDIF
-
- CALL FAILMSG (JSEV,4, 20,MSG)
- GO TO 32
-
-C-- Ready the origin tag
-
- 31 IF (NVEXDK(2).EQ.0) RETURN
- CALL DPHEAD
- 32 NCHTAG = 0
- LNACT = LUPAN
- LNORG = LQ(LUPAN-3)
- CALL DPTAG (1,0,0)
-
- IFLNLO = IAND (IQ(LOWAN),KM5+KM6)
- JTYPE = JBYT (IQ(LUPAN),9,3)
- LINUM = IQ(LUPAN+3)
-
- LINE = ' '
-
- IF (IFLNLO.NE.0) THEN
- IF (IAND(IQ(LUPAN),KM12).NE.0) THEN
- LINE(1:6) = '<nil: '
- ELSE
- LINE(1:6) = '<skip:'
- ENDIF
- ELSE
- LINE(1:4) = '<do:'
- ENDIF
-
- JVAL1 = IQ(LUPAN+4)
- JVAL2 = IQ(LUPAN+5)
- IF (JTYPE.EQ.0) THEN
- MARK(1:4) = 'DEL,'
- ELSEIF (JTYPE.EQ.1) THEN
- MARK(1:4) = 'REP,'
- ELSEIF (JTYPE.EQ.2) THEN
- MARK(1:4) = 'ADB,'
- ELSE
- MARK(1:4) = 'ADD,'
- JVAL1 = JVAL2
- ENDIF
-
- MARK(6:7) = 'C='
- CALL CSETDI (JVAL1,MARK,8,12)
- IF (JVAL2.NE.JVAL1) THEN
- MARK(13:13) = '-'
- CALL CSETDI (JVAL2,MARK,14,18)
- ENDIF
- CALL CLEFT (MARK,8,18)
-
-C-- Print the acting control line
-
- JSL = IQ(LUPAN+1)
- JTX = MLIAD(JSL)
- NTX = MLIAD(JSL+1) - JTX - NCHNEWL
- NTX = MIN (NTX,74)
-
- CALL DPLINE (LINUM, ' ', LEN(LINE), LINE)
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, DPLMSQ.
- SUBROUTINE DPLMSQ (IXSEQ)
-
-C- LIST "missing sequence" warning for seq. IXSEQ
-C. started 10-feb-92
-
-+CDE, SLATLN, SLATE, MUSEBC.
-C-------------- End CDE --------------------------------
- CHARACTER MSG*56
- EQUIVALENCE (MSG,SLERRM)
-
-
- MSG = 'Missing sequence Z='
-C- _:.=+=.: 1_:.=+=.: 2
- CALL NA_GET (IXSEQ,MSG,20)
- N = NESLAT - 1
-
- JSEV = 0
- NSP = 1
- IF (NVEXDK(2).NE.0) NSP= -1
-
- CALL FAILMSG (JSEV,NSP, 0,MSG(1:N))
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, DPLMSG, T=JOIN.
- SUBROUTINE DPLMSG (MSG,NCHL,LINE)
-
-C- Print one line in trouble with a message
-C- LINE of length NCHL is the text, void if NCHL <= 0
-C. started 25-nov-93
-
-+CDE, QUNIT.
-C-------------- End CDE --------------------------------
- CHARACTER MSG*(*), LINE*512
-
-
- CALL DPBLAN (1)
- NQUSED = NQUSED + 1
-
-C-- LINE is void
-
- IF (NCHL.LE.0) THEN
- WRITE (IQPRNT,9024) MSG
- IF (NCHL.LT.0) GO TO 27
- RETURN
- ENDIF
-
-C-- LINE is present
-
- NCH = MIN (NCHL,80)
- WRITE (IQPRNT,9024) MSG,LINE(1:NCH)
-
- IF (NCHL.LE.80) RETURN
-
-C-- LINE is longer than 80 characters
-
- 27 WRITE (IQPRNT,9027) NCHL
- NQUSED = NQUSED + 1
- RETURN
-
- 9024 FORMAT (1X,A,1X,A)
- 9027 FORMAT (7X,'**!! line length is ',I7,' chars')
- END
-+SEQ, QCARDL. =====================================================
-+DECK, DPBLAN, T=JOIN.
- SUBROUTINE DPBLAN (MODE)
-
-C- MODE = -1: after text just printed, print a blank line
-C- 0: if NQLLBL=0, print a blank line
-C- 1: if NQLLBL=0, print a blank line before text about to print
-C- also 0: as 1, but assume the text to be printed ends
-C- with a blank line
-
-+CDE, QUNIT.
-C-------------- End CDE --------------------------------
-
- IF (MODE.LT.0) GO TO 27
- IF (MODE.EQ.0) THEN
- IF (NQLLBL.EQ.0) GO TO 27
- ELSE
- IF (NQLLBL.EQ.0) GO TO 28
- NQLLBL = 0
- ENDIF
- RETURN
-
- 27 NQLLBL = 1
- 28 WRITE (IQPRNT,'(A)')
- NQUSED = NQUSED + 1
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+PATCH, PUTIL. Utility routines
-+DECK, ASMINI.
- SUBROUTINE ASMINI
-
-C- Lift the initial ASM structure
-C. started 23-jan-92
-
-+CDE, QBANKS, LUNSLN, CM_TYP.
-+CDE, Q, PY.
-C-------------- End CDE --------------------------------
-
- CHARACTER*(*) CHRHF, CHRHC, CHRHI, CHRHA
-+SELF, IF=INITRH.
- PARAMETER (CHRHF= ':CDECK ID>, :. ')
- PARAMETER (CHRHC= ':/*DECK ID>, :. */')
- PARAMETER (CHRHI= ':/*DECK ID>, :.h */')
-+SELF, IF=INITRH, IF=QMALT,QMAPO,QMHPX,QMIRT,QMSGI,QMSUN.
- PARAMETER (CHRHA= ':|DECK ID>, :.')
-+SELF, IF=INITRH, IF=QMUUX.
- PARAMETER (CHRHA= ':|DECK ID>, :.')
-+SELF, IF=INITRH, IF=QMCVX, QMLNX, QF_DEC.
- PARAMETER (CHRHA= ':;DECK ID>, :.')
-+SELF, IF=INITRH, IF=QMCRU,QMIBM,QMIBX.
- PARAMETER (CHRHA= ':*DECK ID>, :.')
-+SELF.
-
-+SEQ, QEJECT.
- CHARACTER*(*) CHEXTF, CHEXTC, CHEXTI, CHEXTA, CHEXTD, CHEXTS
-+SELF, IF=QF_APO.
- PARAMETER (CHEXTF= '.ftn')
-+SELF, IF=QS_IBMVM.
- PARAMETER (CHEXTF= '.fortran')
-+SELF, IF=QS_VMS.
- PARAMETER (CHEXTF= '.for')
-+SELF, IF=-QF_APO, IF=-QS_IBMVM, IF=-QS_VMS.
- PARAMETER (CHEXTF= '.f')
-+SELF.
- PARAMETER (CHEXTC= '.c')
- PARAMETER (CHEXTI= '.h')
-+SELF, IF=QS_IBMVM.
- PARAMETER (CHEXTA= '.assemble')
-+SELF, IF=QS_VMS.
- PARAMETER (CHEXTA= '.mar')
-+SELF, IF=-QS_IBMVM, IF=-QS_VMS.
- PARAMETER (CHEXTA= '.s')
-+SELF, IF=QS_VMS.
- PARAMETER (CHEXTD= '.dat')
-+SELF, IF=-QS_VMS.
- PARAMETER (CHEXTD= ' ')
-+SELF, IF=QS_IBMVM.
- PARAMETER (CHEXTS= '.exec')
-+SELF, IF=QS_VMS.
- PARAMETER (CHEXTS= '.com')
-+SELF, IF=-QS_IBMVM, IF=-QS_VMS.
- PARAMETER (CHEXTS= '.sh')
-+SELF.
-
-
- N_TYP = 0
- NAL_TYP = 2
-
- JAL = MAX_TYP - NAL_TYP
-
- CH_TYP(JAL+1) = 'R*EPEAT'
- CH_TYP(JAL+2) = 'J*OIN'
- JU_TYP(JAL+1) = -1
- JU_TYP(JAL+2) = -2
-
-C-- register routine header masks
-+SELF, IF=INITRH.
- IXRHF = NA_LONG (CHRHF)
- IXRHC = NA_LONG (CHRHC)
- IXRHI = NA_LONG (CHRHI)
- IXRHA = NA_LONG (CHRHA)
-+SELF, IF=-INITRH.
- IXRHF = 0
- IXRHC = 0
- IXRHI = 0
- IXRHA = 0
-+SELF.
-
-C-- lift the support bank ASMH
-
- CALL MQLIFT (LHASM, 0,7, JBKSMH,3)
-
- IQ(LHASM+1) = 30
- LUN_TYP = 30
-
-+SEQ, QEJECT.
-C-- lift the ASM banks for "FORTRAN", JASM = JFO_TYP = 1
-
- CALL ASMCREA ('FORT', JASM, 0)
- LASMT = LQ(LHASM-JASM)
-
- IQ(LASMT+5) = NA_LONG (CHEXTF)
- IQ(LASMT+6) = IXRHF
-
- IF (IXLUN(2).NE.0) THEN
- IQ(LASMT+1) = 0
- IQ(LASMT+2) = 1
- IQ(LASMT+3) = IXLUN(2)
- CALL FLINK (LUN_TYP, -1, IXLUN(2), 0)
- ENDIF
-
- IF (IXLUN(8).NE.0) THEN
- LASML = LQ(LASMT-3)
- IQ(LASML+1) = 0
- IQ(LASML+2) = 1
- IQ(LASML+3) = IXLUN(8)
- CALL FLINK (LUN_TYP, -1, IXLUN(8), 0)
- ENDIF
-
-C-- lift the ASM banks for "CC", JASM = JCC_TYP = 2
-
- CALL ASMCREA ('CC', JASM, 0)
- LASMT = LQ(LHASM-JASM)
-
- IQ(LASMT+5) = NA_LONG (CHEXTC)
- IQ(LASMT+6) = IXRHC
-
- IF (IXLUN(5).NE.0) THEN
- IQ(LASMT+1) = 0
- IQ(LASMT+2) = 1
- IQ(LASMT+3) = IXLUN(5)
- CALL FLINK (LUN_TYP, -1, IXLUN(5), 0)
- ENDIF
-
- IF (IXLUN(9).NE.0) THEN
- LASML = LQ(LASMT-3)
- IQ(LASML+1) = 0
- IQ(LASML+2) = 1
- IQ(LASML+3) = IXLUN(9)
- CALL FLINK (LUN_TYP, -1, IXLUN(9), 0)
- ENDIF
-
-C-- lift the ASM banks for "AS", JASM = JAS_TYP = 3
-
- CALL ASMCREA ('AS', JASM, 0)
- LASMT = LQ(LHASM-JASM)
-
- IQ(LASMT+5) = NA_LONG (CHEXTA)
- IQ(LASMT+6) = IXRHA
-
- IF (IXLUN(6).NE.0) THEN
- IQ(LASMT+1) = 0
- IQ(LASMT+2) = 1
- IQ(LASMT+3) = IXLUN(6)
- CALL FLINK (LUN_TYP, -1, IXLUN(6), 0)
- ENDIF
-
- IF (IXLUN(10).NE.0) THEN
- LASML = LQ(LASMT-3)
- IQ(LASML+1) = 0
- IQ(LASML+2) = 1
- IQ(LASML+3) = IXLUN(10)
- CALL FLINK (LUN_TYP, -1, IXLUN(10), 0)
- ENDIF
-
-C-- lift the ASM banks for "DATA", JASM = JDA_TYP = 4
-
- CALL ASMCREA ('DATA', JASM, 0)
- LASMT = LQ(LHASM-JASM)
-
- IQ(LASMT+5) = NA_LONG (CHEXTD)
-
- IF (IXLUN(7).NE.0) THEN
- IQ(LASMT+1) = 0
- IQ(LASMT+2) = 1
- IQ(LASMT+3) = IXLUN(7)
- CALL FLINK (LUN_TYP, -1, IXLUN(7), 0)
- ENDIF
-
- IF (IXLUN(11).NE.0) THEN
- LASML = LQ(LASMT-3)
- IQ(LASML+1) = 0
- IQ(LASML+2) = 1
- IQ(LASML+3) = IXLUN(11)
- CALL FLINK (LUN_TYP, -1, IXLUN(11), 0)
- ENDIF
-
-+SEQ, QEJECT.
-C-- lift the ASM banks for "SHELL", JASM = JSH_TYP = 5
-
- CALL ASMCREA ('SHELL', JASM, 0)
- LASMT = LQ(LHASM-JASM)
-
- IQ(LASMT+5) = NA_LONG (CHEXTS)
- IQ(LASMT+7) = NA_LONG ('&+')
-
-C-- lift the ASM banks for "CRAD", JASM = JCR_TYP = 6
-
- CALL ASMCREA ('CRAD', JASM, 0)
- LASMT = LQ(LHASM-JASM)
-
- IQ(LASMT+5) = NA_LONG ('.cra')
- IQ(LASMT+7) = NA_LONG ('&+')
-
-C-- lift the ASM banks for "INCL", JASM = JIN_TYP = 7
-
- CALL ASMCREA ('INCL', JASM, 0)
- LASMT = LQ(LHASM-JASM)
-
- IQ(LASMT+5) = NA_LONG (CHEXTI)
- IQ(LASMT+6) = IXRHI
-
-C---- Create standard aliases
-
-+SELF, IF=BACKCOMP.
- JAL = JAL - 4
- CH_TYP(JAL+1) = 'CO*MPILE'
- CH_TYP(JAL+2) = 'X*CC'
- CH_TYP(JAL+3) = 'A*S*'
- CH_TYP(JAL+4) = 'D*ATA'
-
- JU_TYP(JAL+1) = JFO_TYP
- JU_TYP(JAL+2) = JCC_TYP
- JU_TYP(JAL+3) = JAS_TYP
- JU_TYP(JAL+4) = JDA_TYP
-
- NAL_TYP = MAX_TYP - JAL
-+SELF.
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, ASMUSE.
- SUBROUTINE ASMUSE
-
-C- End of blank deck of cradle, ready all ASM-streams for use
-C. started 23-jan-92
-
-+CDE, CM_TYP.
-+CDE, Q, PY.
-C-------------- End CDE --------------------------------
- CHARACTER MSG*56
- EQUIVALENCE (MSG,SLERRM)
-
-
-+SELF, IF=XDEBUG, IF=XDUMPASM.
- CALL ASMDUMP ('before link-up')
-+SELF.
-C---- Resolve first level default binding
-
- JASM = 0
- 22 JASM = JASM + 1
- IF (JASM.GT.N_TYP) GO TO 31
-
- LASMT = LQ(LHASM-JASM)
- LASML = LQ(LASMT-2)
-
-C-- check stream :0 or :1 is physical
-
- JPH = 0
- IF (IQ(LASMT+1).EQ.0) GO TO 24
- JPH = 1
- IF (IQ(LASML+1).EQ.0) GO TO 24
-
-C-- default binding for ASMT
-
- IF (IQ(LASMT+1).LT.0) THEN
- IF (JASM.EQ.JFO_TYP) THEN
- MBIND = 0
- ELSEIF (JASM.LE.JCR_TYP) THEN
- MBIND = 8*JFO_TYP
- ELSEIF (JASM.EQ.JIN_TYP) THEN
- MBIND = 8*JCC_TYP
- ELSE
- MBIND = 8*JDA_TYP
- ENDIF
- IQ(LASMT+1) = MBIND
- ENDIF
-
-C-- check stream :3 is physical
-
- JPH = 3
- LASML = LQ(LASMT-4)
- IF (IQ(LASML+1).NE.0) GO TO 22
-
-C-- if streams :0 or :1 or :3 are physical:
-C- bind subsidiary logical streams
-
- 24 MBIND = 8*JASM + JPH
- 25 JPH = JPH + 1
- IF (JPH.GT.4) GO TO 22
- LASML = LQ(LASMT-JPH-1)
- IF (IQ(LASML+1).LT.0) THEN
- IQ(LASML+1) = MBIND
- GO TO 25
- ENDIF
-
- IF (JPH.EQ.2) GO TO 25
- IF (IQ(LASML+1).EQ.0) GO TO 24
- MBIND = IQ(LASML+1)
- GO TO 25
-
-+SEQ, QEJECT.
-C---- Resolve threading of ASMT
-
- 31 JASM = 0
-+SELF, IF=XDEBUG, IF=XDUMPASM.
- CALL ASMDUMP ('after first level')
-+SELF.
- 32 JASM = JASM + 1
- IF (JASM.GT.N_TYP) GO TO 41
- LASMT = LQ(LHASM-JASM)
- MBIND = IQ(LASMT+1)
-C- = 0 if stream :0 is physical
-C- -1 if stream :1 is physical
-
- IF (MBIND.LT.0) GO TO 32
- IF (MBIND.EQ.0) THEN
- CALL ASMCRX (LASMT)
- IF (IQ(LASMT+2).EQ.3) IFMODIF= 1
- GO TO 32
- ENDIF
-
- NSTEP = 0
- 36 NSTEP = NSTEP + 1
- IF (NSTEP.GE.99) GO TO 91
- JASMU = MBIND / 8
- JDIVU = MOD (MBIND,8)
- LASMTU = LQ(LHASM-JASMU)
- IF (JDIVU.EQ.0) THEN
- LASMLU = LASMTU
- ELSE
- LASMLU = LQ(LASMTU-JDIVU-1)
- ENDIF
-
- IF (IQ(LASMLU+1).GT.0) THEN
- MBIND = IQ(LASMLU+1)
- GO TO 36
- ENDIF
-
- IQ(LASMT+1) = MBIND
- GO TO 32
-
-+SEQ, QEJECT.
-C---- Resolve threading of ASML
-
- 41 NUNRES = 999
-+SELF, IF=XDEBUG, IF=XDUMPASM.
- CALL ASMDUMP ('after second level')
-+SELF.
- 42 NUNPRE = NUNRES
- NUNRES = 0
- JASM = 0
- 43 JASM = JASM + 1
- IF (JASM.GT.N_TYP) GO TO 59
- LASMT = LQ(LHASM-JASM)
- JDIV = 0
- 44 JDIV = JDIV + 1
- IF (JDIV.GT.4) GO TO 43
-+SELF, IF=XDEBUG, IF=XDUMPASM.
- PRINT *, ' JASM=',JASM,' JDIV=',JDIV
-+SELF.
- LASML = LQ(LASMT-JDIV-1)
- IF (IQ(LASML+5).LT.0) IQ(LASML+5)= IQ(LASMT+5)
- IF (MOPUPD.NE.0) THEN
- IQ(LASML+6) = 0
- IQ(LASML+7) = 0
- ELSE
- IF (IQ(LASML+6).LT.0) IQ(LASML+6)= IQ(LASMT+6)
- IF (IQ(LASML+7).LT.0) IQ(LASML+7)= IQ(LASMT+7)
- ENDIF
-
-C-- stream is physical
-
- MBIND = IQ(LASML+1)
- IF (MBIND.EQ.0) THEN
- CALL ASMCRX (LASML)
- IF (IQ(LASML+2).EQ.3) IFMODIF= 1
- GO TO 44
- ENDIF
-
-C-- default binding
-
- IF (MBIND.LT.0) MBIND = 8*JASM
- JASMU = JASM
-
- NSTEP = 0
- 51 JASML = JASMU
- JASMU = MBIND / 8
- JDIVU = MOD (MBIND,8)
- NSTEP = NSTEP + 1
- IF (NSTEP.GE.99) GO TO 91
- LASMTU = LQ(LHASM-JASMU)
- IF (JDIVU.NE.0) GO TO 54
-
-C-- binding to stream N:0, try N:jdiv first
-
- IF (JASMU.NE.JASML) THEN
- JDIVU = JDIV
- GO TO 54
- ENDIF
-
- MBIND = IQ(LASMTU+1)
- IF (MBIND.EQ.0) GO TO 57
- GO TO 51
-
-C-- binding to stream N:i
-
- 54 LASMLU = LQ(LASMTU-JDIVU-1)
- MBIND = IQ(LASMLU+1)
- IF (MBIND.EQ.0) GO TO 57
- IF (MBIND.GT.0) GO TO 51
- NUNRES = NUNRES + 1
- GO TO 44
-
- 57 IQ(LASML+1) = 8*JASMU + JDIVU
- GO TO 44
-
- 59 IF (NUNRES.NE.0) THEN
- IF (NUNRES.LT.NUNPRE) GO TO 42
- GO TO 91
- ENDIF
-
-+SELF, IF=XDEBUG, IF=XDUMPASM.
- CALL ASMDUMP ('at the end of ASMUSE')
-+SELF.
- RETURN
-
-C------ Trouble
-
- 91 CALL ASMDUMP ('for loop in binding')
- CALL P_KILL ('loop in ASM binding')
- END
-+SEQ, QCARDL. =====================================================
-+DECK, ASMALL.
- SUBROUTINE ASMALL
-
-C- For c/l +ASM, D=typ1, typ2, ... analyse the parameters at JCCPD,
-C- create the needed ASMT & ASML banks,
-C- replace:
-C- MCCPAR(JCCPD+1) = JASM
-C- +2) = JSTR = 0 for type
-C- 1 2 3 type:0 :1 :2
-
-+CDE, SLATE, SLATLN, CCPARA, QBANKS, Q, PY.
-+CDE, CM_TYP.
-C-------------- End CDE --------------------------------
-
-C-- do the DT= parameters
-
- IFL = 0
- LOC = JCCPD
- NTH = NCCPD
- 24 JTX = NA_JTX (MCCPAR(LOC+1))
- NN = NDSLAT
- CALL ASMNAME (NN, TEXT(JTX))
- IF (NDV_TYP.LT.0) GO TO 91
-
- CALL ASMFIND (ACT_TYP, JASM)
- IFAL = NDSLAT
- IF (JASM.EQ.0) THEN
- CALL ASMCREA (ACT_TYP, JASM, 0)
- ENDIF
-
- MCCPAR(LOC) = IFAL
- MCCPAR(LOC+1) = JASM
- MCCPAR(LOC+2) = NDV_TYP
- LOC = LOC + 3
- NTH = NTH - 1
- IF (NTH.GT.0) GO TO 24
- IF (IFL.NE.0) RETURN
-
-C-- do also the S= parameter
-
- NTH = NCCPP
- IF (NTH.EQ.0) RETURN
- LOC = JCCPP
- IFL = 7
- GO TO 24
-
-C---- Fault
-
- 91 JCCBAD = 1
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, ASMALIA.
- SUBROUTINE ASMALIA
-
-C- Analyse +ASM, D=typ1, typ2, ..., T=ALIAS
-
-+CDE, SLATE, SLATLN, CCPARA, QBANKS, Q, PY.
-+CDE, CM_TYP.
-C-------------- End CDE --------------------------------
- CHARACTER MSG*60
- EQUIVALENCE (MSG,SLERRM)
-
-
- LOC = JCCPD
- NTH = NCCPD
- IF (NTH.LT.2) RETURN
-
-C-- get the aliasing target
-
- JTX = NA_JTX (MCCPAR(LOC+1))
- NN = NDSLAT
- CALL ASMNAME (NN, TEXT(JTX))
- IF (NDV_TYP.LT.0) RETURN
- CALL ASMFIND (ACT_TYP, JUSE)
- IF (JUSE.EQ.0) CALL ASMCREA (ACT_TYP, JUSE, 0)
-
-C-- get the alias names
-
- 24 LOC = LOC + 3
- NTH = NTH - 1
- IF (NTH.EQ.0) RETURN
- JTX = NA_JTX (MCCPAR(LOC+1))
- NN = NDSLAT
- CALL ASMNAME (NN, TEXT(JTX))
- IF (NDV_TYP.LT.0) GO TO 24
- CALL ASMFIND (ACT_TYP, JASM)
- IF (JASM.NE.0) GO TO 31
-
-C-- new name
-
- IF (N_TYP+NAL_TYP.EQ.MAX_TYP) GO TO 91
- JAL = MAX_TYP - NAL_TYP
- CH_TYP(JAL) = ACT_TYP
- JU_TYP(JAL) = JUSE
- NAL_TYP = NAL_TYP + 1
- GO TO 24
-
-C---- Alias name already known
-
- 31 JAL = NDSLAT
- IF (JAL.EQ.0) GO TO 92
- IF (JU_TYP(JAL).EQ.JUSE) GO TO 24
- GO TO 93
-
-C---- Errors
-
- 91 CALL FAILCC (2,'Data-type catalog full')
-
- 92 MSG = 'Stream ' // ACT_TYP // 'already established'
- GO TO 96
-
- 93 MSG = 'Trying to redefine alias ' // ACT_TYP
- 96 CALL CSQMBL (MSG,1,50)
- N = NDSLAT
- CALL FAILCC (1,MSG(1:N))
- END
-+SEQ, QCARDL. =====================================================
-+DECK, ASMFIND.
- SUBROUTINE ASMFIND (DTYPE,JASM)
-
-C- Find the ASM stream for data type DTYPE,
-C- return its number in JASMF, or =0 if it does not exist;
-
-+CDE, SLATE, CM_TYP.
-C-------------- End CDE --------------------------------
- CHARACTER DTYPE*(*)
-
-
- NXX = MIN (LEN(DTYPE), 16)
- NXX = LNBLNK (DTYPE(1:NXX))
-
-C-- check alias
-
- JAL = MAX_TYP - NAL_TYP
- J = ICNTH (DTYPE(1:NXX), CH_TYP(JAL+1), NAL_TYP)
- IF (J.NE.0) THEN
- J = J + JAL
- NDSLAT = J
- JASM = JU_TYP(J)
- RETURN
- ENDIF
-
- NDSLAT = 0
- JASM = ICNTH (DTYPE(1:NXX), CH_TYP, N_TYP)
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, ASMCREA.
- SUBROUTINE ASMCREA (DTYPE,JASMF,IFRUN)
-
-C- Lift the ASMT and ASML banks for data type DTYPE
-C- IFRUN = 0: create with default connections for +ASM
-C- 1: unkown data type seen when running,
-C create with connections for DATA
-
-+CDE, SLATLN, QBANKS, Q, PY.
-+CDE, LUNSLN, CM_TYP.
-C-------------- End CDE --------------------------------
- CHARACTER DTYPE*(*)
-
-
- IF (N_TYP+NAL_TYP.EQ.MAX_TYP) GO TO 91
- IF (N_TYP.EQ.63) GO TO 91
-
- N_TYP = N_TYP + 1
- JASM = N_TYP
- CH_TYP(JASM) = DTYPE
-
- CALL MQLIFT (LASMT, LHASM,-JASM, JBKSMT,3)
-
- IF (IFLAUX.NE.0) GO TO 39
- IQ(LASMT+1) = -1
- LDATA = LQ(LHASM-4)
-
-C-- create the ASML banks
-
- DO 37 JDIV=1,4
- CALL MQLIFT (LASML, LASMT,-JDIV-1, JBKSML,3)
- IF (IFRUN.EQ.0) THEN
- IQ(LASML+1) = -1
- IQ(LASML+5) = -1
- IQ(LASML+6) = -1
- IQ(LASML+7) = -1
- ELSE
- LASMLD = LQ(LDATA-JDIV-1)
- MUSE = IQ(LASMLD+1)
- IF (MUSE.EQ.0) MUSE = 32 + JDIV
- IQ(LASML+1) = MUSE
- IQ(LASML+5) = IQ(LASMLD+5)
- ENDIF
- 37 CONTINUE
- 39 JASMF = N_TYP
- IF (IFRUN.EQ.0) RETURN
- IF (IFLAUX.NE.0) RETURN
- SLERRM = 'Undeclared data-type: ' // DTYPE
- N = LENOCC (SLERRM)
- CALL FAILMSG (0,1, 0,SLERRM(1:N))
- RETURN
-
-C-- Fault, capacity exeeded
-
- 91 IF (IFLAUX.NE.0) GO TO 39
- IF (IFRUN.EQ.0) CALL P_KILL ('Too many ASM data types')
- JASMF = 4
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, ASMCRX.
- SUBROUTINE ASMCRX (LASML)
-
-C- Lift the ASMX bank for the physical stream at LASML
-C- LASML adr of the bank to be connected to
-C. started 22-nov-93
-
-+CDE, QBANKS, Q.
-C-------------- End CDE --------------------------------
-
-
- LXASM = LQ(LASML-1)
- IF (LXASM.NE.0) RETURN
-
- CALL MQLIFT (LXASM, LASML,-1, JBKSMX,3)
- IQ(LXASM+2) = -99
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, ASMNAME.
- SUBROUTINE ASMNAME (NNAME,NAME)
-
-C- Decompose NAME = type:0 into components ACT_TYP and NDV_TYP
-
-+CDE, SLATE, CM_TYP.
-C-------------- End CDE --------------------------------
- CHARACTER NAME*32
-+SELF, IF=BACKCOMP.
- DIMENSION NTRAN(4)
- DATA NTRAN / JFO_TYP, JAS_TYP, JDA_TYP, JCC_TYP /
-
-C-- Translate: 21 FORT:1 22 AS:1 23 DATA:1 24 CC:1
-C-- 31 FORT:2 32 AS:2 33 DATA:2 34 CC:2
-+SELF.
-
- NXY = NNAME
-+SELF, IF=BACKCOMP.
- JOLD = ICDECI (NAME,1,NXY)
- IF (NGSLAT.NE.0) GO TO 29
- IF (JOLD.LT.21) GO TO 91
- JSTR = 1
- IF (JOLD.GE.31) THEN
- JSTR = 2
- JOLD = JOLD - 10
- ENDIF
- JOLD = JOLD - 20
- IF (JOLD.GT.4) GO TO 91
- JASM = NTRAN(JOLD)
- ACT_TYP = CH_TYP(JASM)
- NDV_TYP = JSTR
- JBK_TYP = JBK_TYP + 1
- RETURN
-
- 29 CONTINUE
-+SELF.
- NXX = ICFIND(':', NAME,1,NXY) - 1
- IF (NXX.EQ.0) GO TO 91
- ACT_TYP = NAME(1:NXX)
-
-C-- check old format R=!
-
- IF (NXX.EQ.1) THEN
- IF (ICTYPE(ACT_TYP).LT.3) GO TO 91
- ENDIF
-
- IF (NXX.EQ.NXY) THEN
- JSTR = 0
- ELSE
- JSTR = ICDECI (NAME, NXX+2,NXY)
- IF (JSTR.GT.4) GO TO 91
- IF (NDSLAT.EQ.0) GO TO 91
- IF (NGSLAT.NE.0) GO TO 91
- ENDIF
-
- NDV_TYP = JSTR
- RETURN
-
-C-- Fault
-
- 91 CALL FAILCC (1,'Faulty logical stream name')
- NDV_TYP = -1
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, ASMDUMP.
- SUBROUTINE ASMDUMP (MSG)
-
-C- Dump the ASM d/s
-C. started 13-oct-93
-
-+CDE, SLATE, SLATLN, QUNIT.
-+CDE, CM_TYP.
-+CDE, Q, PY.
-C-------------- End CDE --------------------------------
- CHARACTER MSG*(*)
- CHARACTER SLCOL(512)*1
- EQUIVALENCE (SLCOL,SLLINE)
-
-
- WRITE (IQPRNT,9001) MSG
- 9001 FORMAT (/'1Dump the ASM data stucture ',A)
-
- JASM = 0
- 21 JASM = JASM + 1
- IF (JASM.GT.N_TYP) GO TO 89
- LASMT = LQ(LHASM-JASM)
- IF (LASMT.EQ.0) GO TO 89
-
- JNAME = JASM
- NN = LNBLNK (CH_TYP(JNAME))
- WRITE (IQPRNT,9021) CH_TYP(JNAME)(1:NN)
- 9021 FORMAT (/' for data type ',A)
-
- JSTR = 0
- LASML = LASMT
-
- 24 WRITE (IQPRNT,9024) JSTR
- 9024 FORMAT (/5X,'stream :',I1)
-
- MUSE = IQ(LASML+1)
- IF (MUSE.GT.0) GO TO 27
- IF (MUSE.LT.0) THEN
- WRITE (IQPRNT,9025) MUSE
- GO TO 34
- ENDIF
-
- WRITE (IQPRNT,9026) MUSE
- GO TO 31
-
- 9025 FORMAT (17X,'binding',I5,' to be resolved')
- 9026 FORMAT (17X,'binding',I5,' stream is physical')
-
- 27 JUA = MUSE / 8
- JUB = MOD (MUSE,8)
- SLLINE(1:20) = CH_TYP(JUA)
- IF (JUB.NE.0) THEN
- SLCOL(17) = ':'
- CALL CSETDI (JUB,SLLINE,18,20)
- ENDIF
- CALL CLEFT (SLLINE,1,20)
- NN = NDSLAT
- WRITE (IQPRNT,9027) SLLINE(1:NN)
- 9027 FORMAT (16X,'bound to ',A)
- GO TO 34
-
-+SEQ, QEJECT.
-
- 31 MODE = IQ(LASML+2)
- WRITE (IQPRNT,9031) MODE
- 9031 FORMAT (12X,' output mode',I5)
- 9032 FORMAT (12X,'IX file name',I5,:,1X,A)
- 9033 FORMAT (12X,'IX prefix',I5,:,1X,A)
- 9034 FORMAT (12X,'IX extension',I5,:,1X,A)
- 9035 FORMAT (12X,'IX r/header',I5,:,1X,A)
- 9036 FORMAT (12X,'IX c/ch sub',I5,:,1X,A)
-
- JUSE = IQ(LASML+3)
- IF (JUSE.LE.0) THEN
- WRITE (IQPRNT,9032) JUSE
- ELSE
- CALL NA_GET (JUSE,SLLINE,1)
- N = NDSLAT
- WRITE (IQPRNT,9032) JUSE, SLLINE(1:N)
- ENDIF
-
- IF (MODE.LT.2) GO TO 34
- JUSE = IQ(LASML+4)
- IF (JUSE.LE.0) THEN
- WRITE (IQPRNT,9033) JUSE
- ELSE
- CALL NA_GET (JUSE,SLLINE,1)
- N = NDSLAT
- WRITE (IQPRNT,9033) JUSE, SLLINE(1:N)
- ENDIF
-
- 34 JREA = IQ(LASML+11)
- IF (JREA.NE.0) GO TO 41
- JUSE = IQ(LASML+5)
- JUSX = JUSE
- IF (JUSX.LT.0) JUSX= IQ(LASMT+5)
- IF (JUSX.LE.0) THEN
- WRITE (IQPRNT,9034) JUSE
- ELSE
- CALL NA_GET (JUSX,SLLINE,1)
- N = NDSLAT
- WRITE (IQPRNT,9034) JUSE, SLLINE(1:N)
- ENDIF
-
- JUSE = IQ(LASML+6)
- JUSX = JUSE
- IF (JUSX.LT.0) JUSX= IQ(LASMT+6)
- IF (JUSX.LE.0) THEN
- WRITE (IQPRNT,9035) JUSE
- ELSE
- CALL NA_GET (JUSX,SLLINE,1)
- N = NDSLAT
- WRITE (IQPRNT,9035) JUSE, SLLINE(1:N)
- ENDIF
-
- JUSE = IQ(LASML+7)
- JUSX = JUSE
- IF (JUSX.LT.0) JUSX= IQ(LASMT+7)
- IF (JUSX.LE.0) THEN
- WRITE (IQPRNT,9036) JUSE
- ELSE
- CALL NA_GET (JUSX,SLLINE,1)
- N = NDSLAT
- WRITE (IQPRNT,9036) JUSE, SLLINE(1:N)
- ENDIF
- GO TO 49
-
-C-- logical stream re-assigned
-
- 41 JA = JREA/8
- JS = MOD (JREA,8)
- NN = LNBLNK (CH_TYP(JA))
-
- WRITE (IQPRNT,9044) CH_TYP(JA)(1:NN),JS
- 9044 FORMAT (12X,'data re-assigned to stream ',A,':',I1)
-
- 49 JSTR = JSTR + 1
- IF (JSTR.GT.4) GO TO 21
- LASML = LQ(LASMT-JSTR-1)
- GO TO 24
-
- 89 CONTINUE
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, CCKRAK.
- SUBROUTINE CCKRAK (JSLOT)
-
-C- Analyse control-card into parameter-list & index
-
-+CDE, SLATE, QBITS19, QCHAR, LUNSLN, JSPSEQ, Q, PY.
-+CDE, CCTYPE, CCPARA.
-C-------------- End CDE --------------------------------
- CHARACTER CCOL(256)*1
- EQUIVALENCE (CCOL,CCKARD)
-
- DIMENSION JVECT(7), NVECT(7)
- EQUIVALENCE (JVECT(1),JCCPP), (NVECT(1),NCCPP)
- EQUIVALENCE (LSEP,JCCWK(1)), (IFSEEN,JCCWK(2)), (MSEEN,JCCWK(3))
-
- CHARACTER*7 MSEPS, MSEP2
- PARAMETER (MSEP2 = 'SRFX&LN')
- PARAMETER (MSEPS = 'PDZTICN')
-C- 1234567
-C- 136
-C- 1248624
-
- PARAMETER (NTYPES=42)
- DIMENSION MCXDEF(NTYPES), MCXMUS(NTYPES)
- +, MCXMAY(NTYPES), MCXMUL(NTYPES)
-
-C. translated by table_cctype
-C. default key must may mult def must may mult
-C. 04 +NIL MCCNIL=01 - - - - 0 0 0 0
-C. 39 +KILL MCCKIL=02 I - - I 5 0 16 16
-C. 05 +INC MCCINC=03 Z Z T IZ 3 4 28 28
-C. 01 +CDE MCCCDE=04 Z Z T I 3 4 28 24
-C. 02 +SEQ MCCSEQ=05 Z Z T I 3 4 28 24
-C. \40 MCCXSQ=06 - - - - 0 0 0 0
-C. |06 +IF, MCCTRU=07 I I - I 5 16 16 16
-C. 07 +IFNOT MCCFAL=08 I I - I 5 16 16 16
-C. 08 +ELSE MCCELS=09 I - - I 5 0 16 16
-C. 09 +ENDIF MCCEND=10 - - - - 0 0 0 0
-C. 03 +SELF |MCCSEL=11 Z - T IZ 3 0 28 28
-C. 41 MCCSES=12 Z - T IZ 3 0 28 28
-C. 42 MCCFAU=13 - - - - 0 0 0 0
-C. 19 +SKIP MCCSKI=14 - - - I 0 0 16 16
-C. |10 +KEEP |MCCKEE=15 Z Z PDT I 3 4 31 24
-C. 14 +DEL MCCDEL=16 P C D IC 1 32 51 48
-C. 11 +REPL MCCREP=17 P C DZ IZ 1 32 55 20
-C. 13 +ADBEF MCCADB=18 P C DZ IZ 1 32 55 20
-C. 12 +ADD MCCADD=19 P C DZ IZ 1 32 55 20
-C. |20 +USE MCCUSE=20 P - T IPD 1 0 27 27
-C. 24 +XDIV MCCXDI=21 P - T IPD 1 0 27 27
-C. 23 +DIV MCCDIV=22 P - T IPD 1 0 27 27
-C. 22 +LIST MCCLIS=23 P - T IPD 1 0 27 27
-C. 21 +EXE MCCEXE=24 P - T IPD 1 0 27 27
-C. 25 +IMITAT MCCIMI=25 P P - IP 1 1 17 17
-C. |29 +ASM MCCASM=26 D D PTC ID 2 2 59 26
-C. 35 +UPDATE MCCUPD=27 - - - - 0 0 0 0
-C. |33 +NAMES MCCNAM=28 N N - N 7 64 64 64
-C. 34 +GAP MCCGAP=29 N N - N 7 64 64 64
-C. 36 +MORE MCCMOR=30 - - - - 0 0 0 0
-C. 30 +ONLY MCCONL=31 F F - IF 3 4 20 20
-C. 31 +FORCE MCCFOR=32 T T - I 4 8 24 24
-C. 32 +SUPEND MCCSUS=33 T T - I 4 8 24 24
-C. |26 +OPTION MCCOPT=34 T - - I 4 0 24 24
-C. 27 +PARAM MCCOP2=35 T TN - IN 4 72 88 88
-C. 28 +SHOW MCCSHO=36 T - - I 4 0 24 24
-C. |37 +PAM MCCPAM=37 L - RTN IN 6 0 122 88
-C. 38 +QUIT MCCQUI=38 - - - I 0 0 16 16
-C. 18 +EOD MCCEOD=39 - - - - 0 0 0 0
-C. |15 +DECK MCCDEC=40 D D PT I 2 2 27 24
-C. 16 +PATCH MCCPAT=41 P P T I 1 1 25 24
-C. 17 +TITLE MCCTIT=42 - - - - 0 0 0 0
-
-C- 1 2 3 4 5 6 7 8 9 10
-
- DATA MCXDEF / 0, 5, 3, 3, 3, 0, 5, 5, 5, 0
- +, 3, 3, 0, 0, 3, 1, 1, 1, 1, 1
- +, 1, 1, 1, 1, 1, 2, 0, 7, 7, 0
- +, 3, 4, 4, 4, 4, 4, 6, 0, 0, 2
- +, 1, 0 /
-
- DATA MCXMUS / 0, 0, 4, 4, 4, 0, 16, 16, 0, 0
- +, 0, 0, 0, 0, 4, 32, 32, 32, 32, 0
- +, 0, 0, 0, 0, 1, 2, 0, 64, 64, 0
- +, 4, 8, 8, 0, 72, 0, 0, 0, 0, 2
- +, 1, 0 /
-
- DATA MCXMAY / 0, 16, 28, 28, 28, 0, 16, 16, 16, 0
- +, 28, 28, 0, 16, 31, 51, 55, 55, 55, 27
- +, 27, 27, 27, 27, 17, 59, 0, 64, 64, 0
- +, 20, 24, 24, 24, 88, 24, 122, 16, 0, 27
- +, 25, 0 /
-
- DATA MCXMUL / 0, 16, 28, 24, 24, 0, 16, 16, 16, 0
- +, 28, 28, 0, 16, 24, 48, 20, 20, 20, 27
- +, 27, 27, 27, 27, 17, 26, 0, 64, 64, 0
- +, 20, 24, 24, 24, 88, 24, 88, 16, 0, 24
- +, 24, 0 /
-
-+SEQ, Q_AND, Q_OR, Q_NOT.
-
- CALL VZERO (NCCPAR,24)
- LOC = 4
-
-C---- Copy control-line and find useful length
-
- JCCSL = JSLOT
- JTX = MLIAD(JCCSL)
- NCHCCT = MLIAD(JCCSL+1) - JTX - NCHNEWL
- CALL CCOPYL (TEXT(JTX),CCKORG,NCHCCT)
-
-C-- environment variable substitution
-
- IF (INCRAD.EQ.0) GO TO 18
- IF (INDEX(CCKORG(1:NCHCCT),'${').EQ.0) GO TO 18
- CALL CENVIR (TEXT(JTX),NCHCCT, CCKORG,1,LEN(CCKORG), 7)
- NCHCCT = NESLAT - 1
- ICCSUB = NGSLAT
-
- 18 CCKORG(NCHCCT+1:NCHCCT+2) = ' '
- NCHCCT = LNBLNK (CCKORG(1:NCHCCT))
- CCKARD(1:NCHCCT+2) = CCKORG(1:NCHCCT+2)
- IF (JCCTYP.EQ.MCCTIT) RETURN
- IF (JCCTYP.EQ.MCCNIL) RETURN
-
-C-- check terminating dot is obscured
-
- NCHCCC = -1
- NCHCCD = ICFIND ('.',CCKARD,5,NCHCCT)
- IF (NCHCCD.LT.NCHCCT) THEN
- IF (CCKARD(NCHCCD+1:NCHCCD+2).NE.' ') THEN
- IF (CCKARD(NCHCCD-2:NCHCCD-1).NE.' ') THEN
- IF (CCKARD(NCHCCD-1:NCHCCD+1).NE.' . ') JCCWAR=1
- ENDIF
- ENDIF
- ENDIF
-
- CALL CLEFT (CCKARD,1,NCHCCD-1)
- NCHU = NDSLAT
- CALL CLTOU (CCKARD(1:NCHU))
-
- 19 IF (CCOL(NCHU).EQ.',') THEN
- JCCWAR = 2
- NCHU = NCHU - 1
- GO TO 19
- ENDIF
-
- IFLERR = 0
- IFLACT = 0
- IF (JCCTYP.GE.MCCDEL .AND. JCCTYP.LE.MCCADD) IFLACT= 1
-
-+SEQ, QEJECT.
-C----------- Read next parameter
-
- JCOM = ICFIND (',',CCKARD,4,NCHU)
- IF (JCOM.GE.NCHU) GO TO 51
-
- JEQU = ICFIND ('=',CCKARD,JCOM,NCHU)
- JMIN = ICFIND ('-',CCKARD,JCOM,NCHU)
-
- 21 JGO = JCOM + 1
- JCOM = ICFIND (',',CCKARD,JGO,NCHU)
- MCCPAR(LOC) = 1
-
- IF (JEQU.EQ.JGO) GO TO 96
- IF (JEQU.LT.JCOM) GO TO 24
-
- 22 NEGAT = 0
- IF (JGO.GT.NCHU) GO TO 30
- IF (JGO.EQ.JMIN) THEN
- JGO = JGO + 1
- JMIN = ICFIND ('-',CCKARD,JGO,NCHU)
- IF (JMIN.LT.JCOM) GO TO 96
- NEGAT = -1
- ENDIF
-
- JEND = MIN (JCOM,JMIN)
- NCU = JEND - JGO
- GO TO 31
-
-C---- Parameter key seen
-
- 24 JSEP = INDEX (MSEPS,CCOL(JGO))
- IF (JSEP.EQ.0) JSEP= INDEX (MSEP2,CCOL(JGO))
- IF (JSEP.EQ.0) GO TO 96
-
- JGO = JEQU + 1
- JEQU = ICFIND ('=',CCKARD,JGO,NCHU)
- IF (JEQU.LT.JCOM) GO TO 96
-
- IF (JVECT(JSEP).NE.0) GO TO 27
- IF (IFSEEN.NE.0) GO TO 96
- IF (JSEP.EQ.5) IFSEEN= 7
- LSEP = JSEP
- JVECT(JSEP) = LOC
- IF (JSEP.EQ.4) THEN
- MCCPAR(LOC) = 5
- MCCPAR(LOC+1) = 0
- MCCPAR(LOC+2) = 0
- LOC = LOC + 3
- ENDIF
- 26 MCCPAR(LOC) = JSEP + 1
- GO TO 22
-
-C-- Same key again
-
- 27 IF (JSEP.NE.LSEP) THEN
- IFLERR = 7
- GO TO 22
- ENDIF
- IF (JSEP.NE.5) GO TO 22
- GO TO 26
-
-C----------- Digest current parameter
-
- 30 JEND = JGO
- NCU = 0
-
- 31 IF (LSEP.NE.0) GO TO 41
-
-C-- First parameter without parameter-key
-
- IF (IFLACT.NE.0) GO TO 33
- IF (NCU.EQ.0) GO TO 96
- JSEP = MCXDEF(JCCTYP)
- IF (JSEP.EQ.0) THEN
- IFLERR = 7
- JSEP = 1
- ENDIF
- IF (JSEP.NE.5) GO TO 36
- IFSEEN = 7
- GO TO 36
-
-C-- Action card with implicite parameter-key
-
- 33 JSEP = IFLACT
- IF (JSEP.EQ.3) GO TO 35
- IFLACT = IFLACT + 1
- IF (NCU.EQ.0) GO TO 49
- GO TO 37
-
- 35 IF (NCU.EQ.0) GO TO 49
- JSEP = 6
-
- 36 LSEP = JSEP
- 37 JVECT(JSEP) = LOC
- IF (JSEP.EQ.4) THEN
- MCCPAR(LOC) = 5
- MCCPAR(LOC+1) = 0
- MCCPAR(LOC+2) = 0
- LOC = LOC + 3
- ENDIF
- MCCPAR(LOC) = JSEP + 1
- GO TO 42
-
-+SEQ, QEJECT.
-C----- Normal parameter processing
-
- 41 JSEP = LSEP
- 42 IF (JSEP.LT.6) GO TO 46
-
-C-- Store numeric parameter value
-
- IF (NCU.EQ.0) GO TO 96
- NUM = ICDECI (CCKARD,JGO,JEND-1)
- IF (NGSLAT.NE.0) GO TO 96
- IF (NEGAT.NE.0) THEN
- IF (JSEP.NE.7) GO TO 96
- NUM = -NUM
- ENDIF
-
- MCCPAR(LOC+1) = NUM
- MCCPAR(LOC+2) = NUM
- IF (JEND.NE.JMIN) GO TO 48
- IF (JMIN.GT.NCHU) GO TO 48
-
- JGO = JEND + 1
- JMIN = ICFIND ('-',CCKARD,JGO,NCHU)
- IF (JMIN.LT.JCOM) GO TO 96
-
- NUM2 = ICDECI (CCKARD,JGO,JCOM-1)
- IF (NGSLAT.NE.0) GO TO 96
- MCCPAR(LOC+2) = NUM2
- IF (NUM2.LT.NUM) GO TO 96
- GO TO 48
-
-C-- Store text parameter value
-
- 46 IF (NCU.NE.0) GO TO 47
- IF (JSEP.EQ.1) THEN
- IF (JCCTYP.EQ.MCCASM) GO TO 47
- IF (JCCTYP.EQ.MCCUSE) GO TO 47
- ELSEIF (JSEP.EQ.2) THEN
- IF (JCCTYP.NE.MCCDEC) GO TO 47
- ENDIF
- GO TO 96
-
- 47 IF (JSEP.NE.4) THEN
- IXNAME = NA_NEW (CCKARD,JGO,JEND)
- MCCPAR(LOC+1) = IXNAME
- MCCPAR(LOC+2) = IXNAME
- ELSE
- MCCPAR(LOC+1) = JGO
- MCCPAR(LOC+2) = NCU
- ENDIF
-
- IF (NEGAT.NE.0) THEN
- IF (JSEP.NE.5) GO TO 96
- MCCPAR(LOC) = -MCCPAR(LOC)
- ENDIF
-
- 48 NCCPAR = NCCPAR + 1
- NVECT(JSEP) = NVECT(JSEP) + 1
- LOC = LOC + 3
- 49 IF (JCOM.LT.NCHU) GO TO 21
-
-C------ Analysis finished
-
- 51 JGO = NCHU + 1
- MCCPAR(LOC) = 0
- JCCEND = LOC
- IF (IFLERR.NE.0) GO TO 94
-
-C-- Compress values for TYPE=...
-
- MVALT = 0
- IF (NCCPT.EQ.0) GO TO 56
- IF (JCCTYP.EQ.MCCPAT) GO TO 56
- IF (JCCTYP.EQ.MCCDEC) GO TO 56
- LOC = JCCPT
- NTH = NCCPT
- 52 IF (NTH.GT.0) THEN
- LOC = LOC + 3
- JXX = MCCPAR(LOC+1)
- J = INDEX (CQCETA(1:32),CCOL(JXX))
- IF (J.NE.0) CALL SBIT1 (MVALT,J)
- NTH = NTH - 1
- GO TO 52
- ENDIF
- MCCPAR(JCCPT+1)= MVALT
- MCCPAR(JCCPT+2)= MVALT
-
-C-- Check parameters which may or must be present, may be multiple
-
- 56 MUST = MCXMUS(JCCTYP)
- MMAY = MCXMAY(JCCTYP)
- MULT = MCXMUL(JCCTYP)
-
- MSEEN = 0
- MSEMU = 0
- IONE = 1
-
- DO 57 J=1,7
- IF (NVECT(J).NE.0) THEN
- MSEEN = MSEEN + IONE
- IF (NVECT(J).GE.2) MSEMU = MSEMU + IONE
- ENDIF
- 57 IONE = 2*IONE
-
- IF (IAND(MSEEN, MUST) .NE.MUST) GO TO 91
- IF (IAND(MSEEN, NOT(MMAY)).NE.0) GO TO 63
- IF (IAND(MSEMU, NOT(MULT)).NE.0) GO TO 63
-
-+SEQ, QEJECT, N=12.
-C-- Check for Action lines, fix for +ADD
-
- IF (IFLACT.EQ.0) GO TO 59
- NUM = MCCPAR(JCCPC+1)
-
- IF (JCCTYP.EQ.MCCADD) THEN
- MCCPAR(JCCPC+1) = NUM + 1
- ELSEIF (JCCTYP.EQ.MCCADB) THEN
- IF (NUM.EQ.0) GO TO 96
- ENDIF
-
- 59 RETURN
-
-C-- check legal parameters on special +CDE, +SEQ or +SELF
-
-+SEQ, xJSPSEQ, IF=DOC_INL.
-C- PARAMETER (MSEP2 = 'SRFX&LN')
-C- PARAMETER (MSEPS = 'PDZTICN')
-C- 1234567
-
- 63 IF (JCCTYP.LT.MCCCDE) GO TO 94
- IF (JCCTYP.GT.MCCSEQ) THEN
- IF (JCCTYP.LT.MCCSEL) GO TO 94
- IF (JCCTYP.GT.MCCSES) GO TO 94
- IF (NCCPZ.EQ.0) GO TO 94
- ENDIF
- JC = JCCPZ
- DO 67 JL=1,NCCPZ
- JREL = MCCPAR(JC+1) - JSPSEQ1
- IF (JREL.LT.0) JREL= 99
- MMAYX = MMAY
- MULTX = MULT
-
- IF (JREL.GE.12) THEN
- MULTX= IOR (MULTX, KM3)
- ELSEIF (JREL.GE.10) THEN
- MMAYX= IOR (MMAYX, KM1)
- ELSEIF (JREL.GE.4) THEN
- MMAYX= IOR (MMAYX, KM1+KM6+KM7)
- ELSEIF (JREL.GE.1) THEN
- MMAYX= IOR (MMAYX, KM7)
- ELSE
- MMAYX= IOR (MMAYX, KM2)
- ENDIF
-
- IF (IAND(MSEEN, NOT(MMAYX)).NE.0) GO TO 94
- IF (IAND(MSEMU, NOT(MULTX)).NE.0) GO TO 94
- 67 JC = JC + 3
- GO TO 59
-
-C---- Missing parameter, allowed only on +SEQ, T=DUMMY
-
- 91 IF (JCCTYP.LT.MCCCDE) GO TO 94
- IF (JCCTYP.GT.MCCSEQ) THEN
- IF (JCCTYP.NE.MCCKEE) GO TO 94
- ENDIF
- IF (IAND(MVALT,KM4).NE.0) GO TO 59
-
-C---- Faulty c/line, for good syntax but unexpected
-C-- or missing parameter give no error in c/line
-C-- is IF de-selected
-
- 94 IF (IFLAUX.EQ.0) THEN
- CALL CCPROC
- IF (JCCIFV.NE.0) RETURN
- ENDIF
-
- 96 JCCBAD = JGO
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, CCIFLV.
- SUBROUTINE CCIFLV
-
-C-- Count the underscores of +___IF, IFNOT, ELSE, ENDIF
-C- of the last line handled by CCKRAK
-
-+CDE, CCPARA, Q.
-C-------------- End CDE --------------------------------
-
-
- JTX = MLIAD(JCCSL)
- JNU = JTX
- 24 JNU = JNU + 1
- IF (TEXT(JNU).EQ.'_') GO TO 24
- JCCLEV = JNU - JTX - 1
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, CCCOMG.
- SUBROUTINE CCCOMG (MODE)
-
-C- Get the comment field of the current c/line stored into CCCOMF
-C- MODE = 0 : as is
-C- 1 : ignore leading blanks
-
-+CDE, CCPARA.
-C-------------- End CDE --------------------------------
-
-
- CCCOMF = ' '
- IXCCC = 0
- JTK = NCHCCD + 1
- IF (MODE.NE.0) JTK = ICFNBL (CCKARD,JTK,NCHCCT)
-
- NCHCCC = NCHCCT+1 - JTK
- NCHCCC = MAX (NCHCCC,0)
- IF (NCHCCC.EQ.0) RETURN
-
- CCCOMF(1:NCHCCC)= CCKARD(JTK:JTK+NCHCCC-1)
- NCHCCC = LNBLNK(CCCOMF(1:NCHCCC))
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, CCCRAK, T=JOIN.
- SUBROUTINE CCCRAK (LUNDES)
-
-C- The comment field of the current c/line is a file-name,
-C- krack it and store its name index into IXCCC
-C- LUNDES is the file type for FLKRAK
-C- = 1 cradle, 2 PAM, 4 print, 5 Fortran, 6 ASM write, 7 ASM read-write
-
-C- CCCOMG must have been called first
-
-+CDE, SLATE, CCPARA, FLINKC.
-C-------------- End CDE --------------------------------
-
-
- IF (NCHCCC.EQ.0) RETURN
-
- CALL FLKRAK (1,LUNDES)
- IXCCC = IXFLUN
-
- CALL NA_GET (IXFLUN,CCCOMF,1)
- NCHCCC = NDSLAT
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, CCCOIX, T=JOIN.
- SUBROUTINE CCCOIX (IXPARM)
-
-C- Put the comment field of the current c/line alrady stored
-C- into CCCOMF into the name-stack and return its index
-
-+CDE, CCPARA.
-C-------------- End CDE --------------------------------
-
-
-+SELF, IF=QDEBUG.
- IF (NCHCCC.LT.0) CALL P_CRASH ('CCCOIX - comment field not ready')
-+SELF.
- IF (NCHCCC.LE.0) GO TO 96
-
- IF (IXCCC.EQ.0) IXCCC= NA_LONG (CCCOMF(1:NCHCCC))
- IXPARM = IXCCC
- RETURN
-
-C-- Empty string
-
- 96 IXPARM = 0
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, CCPROC.
- SUBROUTINE CCPROC
-
-C- Finish control-card processing of CCKRAK for PATCHY
-
-+CDE, QBITS19, KQADR, Q, PY.
-+CDE, CCPARA.
-C-------------- End CDE --------------------------------
-
-+SEQ, Q_AND, Q_OR, Q_NOT.
-
-C---- Evaluate truth-value and EXE-bits for IF-parameters
-
- IF (NCCPIF.EQ.0) RETURN
- IF (MOPUPD.NE.0) RETURN
- LQ(LLPAST-1) = LQPAST
- MEXEB = 0
- MTRUE = KM5
- LS = JCCPIF
- JSEP = MCCPAR(LS)
-
-C-- Start new AND-group
-
- 21 MLTRU = 0
-
-C-- Next parameter
-
- 22 LPU = KQFIND (MCCPAR(LS+1),2,KQMAIN,NVUTY(1))
- IF (LPU.EQ.0) THEN
- CALL CREAPD (MCCPAR(LS+1),-1,-1)
- LPU = LCRP
- ENDIF
-
- IQ(LPU+1) = IOR (IQ(LPU+1), KM6)
- MXUS = IQ(LPU)
- MEXEB = IOR (MEXEB, MXUS)
-
- IF (JSEP.LT.0) MXUS= NOT(MXUS)
- MLTRU = IOR(MLTRU, MXUS)
-
- LS = LS + 3
- JSEP = MCCPAR(LS)
- IF (IABS(JSEP).EQ.1) GO TO 22
- MTRUE = IAND(MTRUE, MLTRU)
- IF (JSEP.NE.0) GO TO 21
-
-C-- Finished
-
- MXCCIF = IAND (MEXEB,15)
- IF (IAND(MTRUE,KM5).EQ.0) JCCIFV= 1
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, CCOPT.
- SUBROUTINE CCOPT (POSS,NPOSS)
-
-C- Check T=opt parameters on current control line
-
-+CDE, CCPARA.
-C-------------- End CDE --------------------------------
- CHARACTER POSS(NPOSS)*(*)
-
-
- IF (NCCPT.EQ.0) RETURN
- MM = 0
- LOC = JCCPT
- NTH = NCCPT
- 24 LOC = LOC + 3
- JXX = MCCPAR(LOC+1)
- NXX = MCCPAR(LOC+2)
- J = ICNTH (CCKARD(JXX:JXX+NXX-1),POSS,NPOSS)
- IF (J.EQ.0) GO TO 96
- CALL SBIT1 (MM,J)
- NTH = NTH - 1
- IF (NTH.GT.0) GO TO 24
-
- 27 MCCPAR(JCCPT+2)= MM
- RETURN
-
-C-- Fault
-
- 96 JCCBAD = JXX
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, CCDOPT.
- SUBROUTINE CCDOPT (LOOK, JTYPE)
-
-C- Handle T= parameters on current +PATCH or +DECK c/l
-C- on entry: LOOK = 0 do not create new data-types
-C- 1 normal operation
-C- return: JTYPE = data type 1,2,3,... FORT, CC, ASL, ...
-C- zero if not specified
-C- MCCPAR(JCCPT+2): bit 1 if T=REPEAT
-C- 2 if T=JOIN
-C- NDSLAT = zero if no error
-
-+CDE, SLATE, CCPARA.
-+CDE, CM_TYP.
-C-------------- End CDE --------------------------------
-
-+SEQ, Q_OR.
-+SEQ, xCM_TYP, IF=DOC_INL.
-
-
- NFAI = 0
- JASM = 0
- IF (NCCPT.EQ.0) GO TO 99
- MSK = 0
- LOC = JCCPT
- NTH = NCCPT
- 24 LOC = LOC + 3
- JXX = MCCPAR(LOC+1)
- NXX = MCCPAR(LOC+2)
- NXX = MIN (NXX, 16)
- CALL ASMFIND (CCKARD(JXX:JXX+NXX-1), JF)
-
- J = JF
- IF (J.EQ.0) THEN
- IF (LOOK.EQ.0) GO TO 27
- CALL ASMCREA (CCKARD(JXX:JXX+NXX-1), J, 1)
- ENDIF
-
- IF (J.LT.0) THEN
- MSK = IOR (MSK, -J)
- GO TO 27
- ENDIF
-
- IF (JASM.EQ.0) GO TO 26
-+SELF, IF=BACKCOMP.
-
-C-- accept: T=DATA, INCL (DATA for p4, INCL for p5 if declared)
-
- IF (JF .EQ.0) GO TO 25
- IF (JASM.GT.4) GO TO 25
- IF (J .GT.4) GO TO 26
-+SELF.
- 25 NFAI = NFAI + 1
- GO TO 27
-
- 26 JASM = J
- 27 NTH = NTH - 1
- IF (NTH.GT.0) GO TO 24
-
- MCCPAR(JCCPT+2) = MSK
- 99 NDSLAT = NFAI
- JTYPE = JASM
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, CREACT.
- SUBROUTINE CREACT
-
-C- Create P/D target banks for the current action control-line.
-C- For omitted P/D parameters use NVIMAT(1+2) if non-zero.
-C- Return common variables LCRP and LCRD pointing to
-C- the PAT and DECK banks used, or zero if not defined;
-C- set NVIMAT if success.
-C. started 14-jan-92
-
-+CDE, QBITS19, CCPARA, Q, PY.
-C-------------- End CDE --------------------------------
-
-
- IXP = MCCPAR(JCCPP+1)
- IXD = MCCPAR(JCCPD+1)
-
- IF (IXP.NE.0) GO TO 24
- LCRP = NVIMAT(1)
- LCRD = 0
- IF (LCRP.EQ.0) RETURN
- IF (NCCPD.NE.0) GO TO 24
- LCRD = NVIMAT(2)
- RETURN
-
- 24 CALL CREAPD (IXP, IXD, 0)
- NVIMAT(1) = LCRP
- NVIMAT(2) = LCRD
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, CREAPD.
- SUBROUTINE CREAPD (IXPAX,IXDEX,MODELK)
-
-C- Locate or create for name index (IXPAT,IXDEC)
-
-C- banks 'PAT' and 'DECK'
-C- at LCRP and LCRD
-
-C- if IXPAT= 0 use PAT bank existing at LCRP
-C- if IXDEC= -ve no DECK please, return LCRD=0
-
-C- Linkage control :
-C- MODELK -ve create without search
-C- 0 normal search and creation
-C- +ve LEXP is to point to the resultant PAT bank
-C- shunt the bank currently at LEXP to LQPAST
-
-C- Returns LCRP and LCRD of PAT / DECK banks found or created
-
-C- NVUTY(1) K-adr of PAT bank
-C- NVUTY(2) K-adr of DECK bank
-
-+CDE, QBANKS, MUSEBC, KQADR, Q, PY.
-C-------------- End CDE --------------------------------
- DIMENSION IXPAX(9), IXDEX(9)
-
-+SEQ, Q_OR.
-
-
- IXPAT = IXPAX(1)
- IXDEC = IXDEX(1)
- MODE = MODELK
-
-+SEQ, QEJECT.
-C------ Find or create PAT-bank
-
- IF (IXPAT.EQ.0) GO TO 41
- LORG = 0
- KP = LEXP-1
- IF (MODE.LT.0) GO TO 32
- IF (MODE.GT.0) THEN
- CALL QSHUNT (KQMAIN,KQPAST)
- KP = KQMAIN
- ENDIF
-
-C-- Find 'Future PAT'-bank pre-existing
-
- LQ(LLPAST-1) = 0
- LCRP = KQFIND (IXPAT,2,KQMAIN,NVUTY(1))
- IF (LCRP.EQ.0) GO TO 31
- IF (MODE.EQ.0) GO TO 41
- CALL QSHUNT (NVUTY(1),KP)
- GO TO 38
-
-C-- Find pre-existing 'Past PAT'-bank
-
- 31 LORG = LQFIND (IXPAT,2,LQPAST)
-
-C-- Create new PAT-bank
-
- 32 CALL MQLIFT (LCRP,KP,0,JBKPAT,3)
- IQ(LCRP) = IOR (IQ(LCRP), MU_GLOB)
- IQ(LCRP+2) = IXPAT
- IF (LORG.EQ.0) GO TO 38
- CALL MXJOIN (IQ(LORG),IQ(LCRP))
- IQ(LCRP+1) = IQ(LORG+1)
- LQ(LCRP-2) = LQ(LORG-2)
- LQ(LCRP-3) = LQ(LORG-3)
- LQ(LCRP-4) = LQ(LORG-4)
- LQ(LORG-2) = 0
- LQ(LORG-3) = 0
- CALL SBIT0 (IQ(LCRP+1),1)
-
-C-- set reverse pointers in DECK banks
-
- L = LCRP - 1
- 34 L = LQ(L-1)
- IF (L.EQ.0) GO TO 38
- LQ(L-4) = LCRP
- GO TO 34
-
- 38 NVUTY(1) = KP
-
-C---- Locate DEC-bank, unless IXDEC=-1
-
- 41 IF (IXDEC.LT.0) GO TO 57
- LCRD = KQFIND (IXDEC,1,LCRP-2,NVUTY(2))
- IF (LCRD.NE.0) RETURN
-
- CALL MQLIFT (LCRD,NVUTY(2),0,JBKDEC,1)
- CALL SBYT (IQ(LCRP),IQ(LCRD),1,18)
- IQ(LCRD+1) = IXDEC
- LQ(LCRD-4) = LCRP
- RETURN
-
- 57 LCRD = 0
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, CRDECO.
- SUBROUTINE CRDECO
-
-C-- Create origin deck bank ODEC in division 3
-
-+CDE, QPAGE, QBANKS, CHEXC.
-+CDE, Q, PY.
-C-------------- End CDE --------------------------------
-
-+SEQ, Q_OR.
-
-
- CALL MQLIFT (LDECO,0,7,JBKORG,3)
-
- IQ(LDECO) = IOR (IQ(LDECO), NQDKNO)
- IQ(LDECO+1) = IXEXDEC
- IQ(LDECO+2) = IXEXPAT
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, FAILCC.
- SUBROUTINE FAILCC (JSEVER,MSG)
-
-C- Print faulty control line pointed to by bank at LDOAN
-C. started 29-jan-92
-
-+CDE, Q, PY.
-+CDE, M_ANAC.
-C-------------- End CDE --------------------------------
- CHARACTER MSG*(*)
-
-
- IF (LDOAN.EQ.0) GO TO 24
- JSL = IQ(LDOAN+1)
- IF (LUPAN.EQ.0) THEN
- NUM = JSL - JSLORG
- LORG = 0
- ELSE
- NUM = IQ(LDOAN+3)
- LORG = LQ(LDOAN-2)
- ENDIF
- CALL FAILLN (JSEVER,LORG,NUM,JSL,MSG)
- RETURN
-
-C-- At end of deck
-
- 24 CALL FAILLN (JSEVER,0,0,0,MSG)
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, FAILLN.
- SUBROUTINE FAILLN (JSEVER,LORGP,NUMORG,JSLFAU,MSG)
-
-C- Print faulty control-line, where
-C- JSEVER 0 warning, 1 error, 2 fatal
-C- LORG adr of the origin deck, if zero: current
-C- NUMORG Patchy line-number
-C- JSLFAU slot number of the line
-C- MSG text of the message to be printed
-
-+CDE, SLATE, SLATLN, QUNIT, Q.
-C-------------- End CDE --------------------------------
- CHARACTER MSG*(*)
- CHARACTER LINE*80, TAIL*64
- EQUIVALENCE (LINE, SLLINE), (TAIL, SLLINE(51:))
-
-+SEQ, Q_JBYT.
-
-
- LORG = LORGP
- NUM = NUMORG
- JSL = JSLFAU
-
- CALL FAILMSG (JSEVER,3, 0,MSG)
- IF (NDSLAT.EQ.0) RETURN
-
-C-- foreign material
-
- IF (LORG.EQ.0) GO TO 41
- LINE = ' !!'
- NDK = JBYT (IQ(LORG),1,16)
- CALL CSETDI (NDK,TAIL,1,12)
- CALL CLEFT (TAIL,4,12)
- J = NESLAT
-
- TAIL(J:J) = '='
- J = J + 1
- CALL NA_GET (IQ(LORG+1),TAIL,J)
- J = NESLAT
-
- TAIL(J:J) = '.'
- J = J + 1
- CALL NA_GET (IQ(LORG+2),TAIL,J)
- NN = NESLAT - 1
- NOV = NN - 30
- IF (NOV.GT.0) THEN
- CALL CCOPYL (TAIL,LINE(51-NOV:),NN)
- NN = NN - NOV
- ENDIF
- NN = NN + 50
- WRITE (IQPRNT,9036) LINE(1:NN)
- NQUSED = NQUSED + 1
-
- 41 NQUSED = NQUSED + 2
- IF (JSL.EQ.0) GO TO 44
- JTX = MLIAD(JSL)
- NTX = MLIAD(JSL+1) - JTX - NCHNEWL
- NTX = MIN (80, NTX)
- CALL CCOPYL (TEXT(JTX),LINE,NTX)
- WRITE (IQPRNT,9041) NUM,LINE(1:NTX)
- GO TO 49
-
- 44 WRITE (IQPRNT,9044)
- 49 IF (JSEVER.GE.2) CALL P_FATAL ('this')
- NQLLBL = 1
- RETURN
-
- 9036 FORMAT (A)
- 9041 FORMAT (1X,I5,' ! ',A/)
- 9044 FORMAT (8X,'! at end-of-deck'/)
- END
-+SEQ, QCARDL. =====================================================
-+DECK, FAILMSG.
- SUBROUTINE FAILMSG (JSEVER,NSPACE,NBLANK,MSG)
-
-C- Print warning/error message, where
-C- JSEVER severity: -1 info, 0 warning, 1 error, 2 fatal
-C- NSPACE = -1 no page-eject to glue to last line printed
-C- 0 no blank line before
-C- >0 number of lines needed together
-C-
-C- return NDSLAT >0 normal printing
-C- 0 suppress printing, maximum number passed
-
-+CDE, SLATE, QCHAR, QPAGE, QSTATE, QUNIT, LUNSLN.
-C-------------- End CDE --------------------------------
- CHARACTER MSG*(*)
-
-
- NN = NSPACE
- NB = MAX (NBLANK, 1)
- NDSLAT = 0
- IF (JSEVER.LT.0) THEN
- NQINFO = MIN (NQINFO+1, 999)
- IF (NQINFO.GE.199) RETURN
- ELSEIF (JSEVER.EQ.0) THEN
- NQWARN = MIN (NQWARN+1, 999)
- IF (NQWARN.GE.199) RETURN
- ELSE
- NQERR = MIN (NQERR+1, 999)
- IF (NQERR.GE.199) THEN
- IF (JSEVER.EQ.1) RETURN
- ENDIF
- ENDIF
-
- IF (NN.LT.0) GO TO 41
- IF (NQNEWH.NE.0) GO TO 31
- IF (NN+1.LT.NQLTOK) GO TO 40
- NQUSED = NQLTOK
-
- 31 CALL DPHEAD
- GO TO 41
-
- 40 IF (NN.NE.0) CALL DPBLAN (1)
-
- 41 IF (JSEVER.LT.0) THEN
- WRITE (IQPRNT,9041) CQBLAN(1:NB), NQINFO,MSG
- ELSEIF (JSEVER.EQ.0) THEN
- WRITE (IQPRNT,9042) CQBLAN(1:NB), NQWARN,MSG
- ELSE
- WRITE (IQPRNT,9043) CQBLAN(1:NB), NQERR,MSG
- ENDIF
- NQUSED = NQUSED + 1
- NQLLBL = 0
- NDSLAT = 7
- IF (JSEVER.NE.1) RETURN
- IF (NQERR.NE.1) RETURN
- IF (IFLAUX.NE.0) RETURN
- WRITE (IQPRNT,9049) CQBLAN(1:NB)
- NQUSED = NQUSED + 1
- RETURN
-
- 9041 FORMAT (A,'! Inform',I4,' *! ',A,' !*')
- 9042 FORMAT (A,'!! Warning',I4,' **!! ',A,' !!**')
- 9043 FORMAT (A,'!!! Error',I4,' ***!!! ',A,' !!!*** !!!!!!!!')
- 9049 FORMAT (A,'!!! EXE processing is inhibited from now on !!!')
- END
-+SEQ, QCARDL. =====================================================
-+DECK, JPTYPE.
- FUNCTION JPTYPE (LINE)
-
-C- Find control-card type of line in LINE(1:N)
-C- without looking at the control-character in LINE(1:1)
-
-+CDE, CCTYPE.
-C-------------- End CDE --------------------------------
- CHARACTER LINE(64)*1, CHWK*4, CHWK1*1, CHWK2*1, CHWK3*1
- EQUIVALENCE (CHWK1,CHWK(1:1)),(CHWK2,CHWK(2:2)),(CHWK3,CHWK(3:3))
-
- PARAMETER (NPOSSA = 39)
- CHARACTER POSS(NPOSSA)*4
- DIMENSION MTYPE(NPOSSA)
-
- DATA POSS / '+CDE' , '+SEQ' , '+SEL' , '+NIL' , '+INC'
- +, '+IF,' , '+IFN' , '+ELS' , '+END'
- +, '+KEE' , '+REP' , '+ADD' , '+ADB' , '+DEL'
- +, '+DEC' , '+PAT' , '+TIT' , '+EOD' , '+SKI'
- +, '+USE' , '+EXE' , '+LIS' , '+DIV' , '+XDI' , '+IMI'
- +, '+OPT' , '+PAR' , '+SHO'
- +, '+ASM' , '+ONL' , '+FOR' , '+SUP'
- +, '+NAM' , '+GAP' , '+UPD' , '+MOR'
- +, '+PAM' , '+QUI' , '+KIL' /
-
- DATA MTYPE / MCCCDE , MCCSEQ , MCCSEL , MCCNIL , MCCINC
- +, MCCTRU , MCCFAL , MCCELS , MCCEND
- +, MCCKEE , MCCREP , MCCADD , MCCADB , MCCDEL
- +, MCCDEC , MCCPAT , MCCTIT , MCCEOD , MCCSKI
- +, MCCUSE , MCCEXE , MCCLIS , MCCDIV , MCCXDI , MCCIMI
- +, MCCOPT , MCCOP2 , MCCSHO
- +, MCCASM , MCCONL , MCCFOR , MCCSUS
- +, MCCNAM , MCCGAP , MCCUPD , MCCMOR
- +, MCCPAM , MCCQUI , MCCKIL /
-
-
- IF (LINE(2).EQ.'_') GO TO 61
-
-C-- scan normal possibilities
-
- JPOSS = 0
- 22 JPOSS = JPOSS + 1
- IF (JPOSS.GT.NPOSSA) GO TO 29
- JC = 2
- IVP = ICHAR(POSS(JPOSS)(2:2))
- IVT = ICHAR(LINE(2))
- 24 IF (IVT.NE.IVP) THEN
-+SELF, IF=QASCII.
- IF (IVT-IVP.NE.32) GO TO 22
-+SELF, IF=QEBCDIC.
- IF (IVP-IVT.NE.64) GO TO 22
-+SELF.
- ENDIF
- IF (JC.EQ.4) GO TO 41
- JC = JC + 1
- IVP = ICHAR(POSS(JPOSS)(JC:JC))
- IVT = ICHAR(LINE(JC))
- GO TO 24
-
-C-- not a Patchy key
-
- 29 JTYPE = 0
- GO TO 42
-
-C---- return
-
- 41 JTYPE = MTYPE(JPOSS)
- 42 JPTYPE = JTYPE
- RETURN
-
-C-- handle +___IF, IFNOT, ELSE, ENDIF
-
- 61 JF = 2
- 62 JF = JF + 1
- IF (LINE(JF).EQ.'_') GO TO 62
-
- CHWK(1:1) = LINE(JF)
- CHWK(2:2) = LINE(JF+1)
- CHWK(3:3) = LINE(JF+2)
- IF (CHWK1.EQ.'I') GO TO 71
- IF (CHWK1.EQ.'i') GO TO 71
- IF (CHWK1.NE.'E') THEN
- IF (CHWK1.NE.'e') GO TO 29
- ENDIF
-
-C-- ELSE or ENDIF
-
- IF (CHWK2.EQ.'L') GO TO 64
- IF (CHWK2.EQ.'l') GO TO 64
- IF (CHWK2.NE.'N') THEN
- IF (CHWK2.NE.'n') GO TO 29
- ENDIF
- IF (CHWK3.NE.'D') THEN
- IF (CHWK3.NE.'d') GO TO 29
- ENDIF
- JTYPE = MCCEND
- GO TO 42
-
-C-- ELSE
-
- 64 IF (CHWK3.NE.'S') THEN
- IF (CHWK3.NE.'s') GO TO 29
- ENDIF
- JTYPE = MCCELS
- GO TO 42
-
-C-- IF or IFNOT
-
- 71 IF (CHWK2.NE.'F') THEN
- IF (CHWK2.NE.'f') GO TO 29
- ENDIF
- IF (CHWK3.NE.'N') THEN
- IF (CHWK3.NE.'n') GO TO 74
- ENDIF
- JTYPE = MCCFAL
- GO TO 42
-
-C-- IF,
-
- 74 JF = JF + 1
- 75 JF = JF + 1
- IF (LINE(JF).EQ.' ') GO TO 75
- IF (LINE(JF).NE.',') GO TO 29
- JTYPE = MCCTRU
- GO TO 42
- END
-+SEQ, QCARDL. =====================================================
-+DECK, KRTITL.
- SUBROUTINE KRTITL
-
-C- Krack the current title
-C. started 12-jan-94
-
-+CDE, SLATE, CCTYPE, CCPARA, CHEXC.
-+CDE, Q, PY.
-C-------------- End CDE --------------------------------
-
-
- JSLT = IQ(LQHOLD+1)
- JSLE = IQ(LQHOLD+3) + JSLT
- JTXT = MLIAD(JSLT)
- NTXT = MLIAD(JSLT+1) - JTXT - NCHNEWL
-
-C-- do +TITLE: name version /sub text
-
- JCCTYP = 0
- IF (TEXT(JTXT).NE.'+') GO TO 33
- JCCTYP = JPTYPE (TEXT(JTXT))
- IF (JCCTYP.EQ.0) GO TO 33
- IF (JCCTYP.NE.MCCTIT) GO TO 37
- N = MIN (12,NTXT)
- JF = ICFIND (':',TEXT(JTXT),1,N)
- IF (JF.GT.N) GO TO 32
- IF (JF.EQ.NTXT) GO TO 32
- JF = ICNEXT (TEXT(JTXT),JF+1,NTXT)
- NCHNAM = NDSLAT
- IF (JF.LT.NTXT) GO TO 36
-
-C-- take the title from the first non-blank line in the deck
-
- 32 JSLT = JSLT + 1
- IF (JSLT.GE.JSLE) GO TO 37
- JTXT = MLIAD(JSLT)
- NTXT = MLIAD(JSLT+1) - JTXT - NCHNEWL
- IF (TEXT(JTXT).NE.'+') GO TO 33
- JCCTYP = JPTYPE (TEXT(JTXT))
- IF (JCCTYP.NE.0) GO TO 37
- 33 JF = 0
- 34 JF = ICNEXT (TEXT(JTXT),JF+1,NTXT)
- IF (JF.GT.NTXT) GO TO 32
- NCHNAM = NDSLAT
- IF (NCHNAM.EQ.1) THEN
- IF (TEXT(JTXT+JF-1).EQ.'C') GO TO 34
- IF (TEXT(JTXT+JF-1).EQ.'*') GO TO 34
- ENDIF
-
-C-- got the title
-
- 36 JTXT = JTXT + JF - 1
- NTXT = NTXT - JF + 1
- NTXT = MIN (NTXT, 80)
- CCKARD(1:1) = '@'
- CALL CCOPYL (TEXT(JTXT),CCKARD(2:NTXT+1),NTXT)
- CALL CLTOU (CCKARD(1:NCHNAM+1))
- GO TO 38
-
-C-- fake title for file starting with +PATCH or +DECK
-
- 37 CCKARD(1:8) = '@unknown'
- NCHNAM = 7
- NTXT = 7
-
- 38 JSLTTL = LN_TO4 (CCKARD(2:), NTXT)
- IXEXPAM = NA_NEW (CCKARD,2,NCHNAM+2)
- IXEXPAT = NA_NEW (CCKARD,1,NCHNAM+2)
- IXEXID = IXEXPAT
-
- IQ(LARRV+10) = JSLTTL
- IQ(LARRV+11) = IXEXPAM
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, LIFTSQ.
- FUNCTION LIFTSQ (KJOIN,JTYPE,JSLCL,JDIV)
-
-C- Lift a sequence call bank
-C- KJOIN K-adr of the bank to be lifted
-C- JTYPE CC type to be stored
-C- JSLCL slot number of the control-line
-C- if this is non-zero the line will be cracked
-C- but in this case it must be +SEQ
-C- JDIV division number for lifting
-C-
-C- Return adr of the bank lifted as function value
-C- and IQUEST(1) the number of sequence calls lost:
-C- Note that no bank may have more than 63 links!
-C# started 18-dec-91
-
-+CDE, QBITA19, QBANKS, CCTYPE, CCPARA.
-+CDE, QSH.
-C-------------- End CDE --------------------------------
-+SEQ, Q_AND, Q_OR, Q_SHIFTL.
-
-
- IF (JSLCL.NE.0) THEN
- JCCTYP = MCCSEQ
- CALL CCKRAK (JSLCL)
- ENDIF
-
- NPZORG = NCCPZ
- NCCPZ = MIN (NCCPZ,61)
-
- MMBANK(3,JBKXSQ) = NCCPZ + 2
- MMBANK(5,JBKXSQ) = NCCPZ + 4
- CALL MQLIFT (LX,KJOIN,0,JBKXSQ,JDIV)
-
- IQ(LX) = IOR (IQ(LX), ISHFTL(JTYPE,8))
- IQ(LX) = IOR (IQ(LX), IAND(MCCPAR(JCCPT+1),KMP))
-
- IQ(LX+4) = NCCPZ
- CALL UCOCOP (MCCPAR(JCCPZ+1),IQ(LX+5),NCCPZ,1,3,1)
-
- IQUEST(1) = NPZORG - NCCPZ
- LIFTSQ = LX
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, LINKSQ.
- FUNCTION LINKSQ (LXX,LYY)
-
-C- if LXX not zero:
-C- connect all KEEP banks of the sequences called by
-C- the call bank at LXX;
-C- if LXX is zero:
-C- finalize only the sequence whose KEEP bank is LYYY;
-C- finalizing all global KEEPs called directly or indirectly,
-C- collect EXE bits and return them as function value
-C. started 28-nov-91
-
-+CDE, QBITS19, CCTYPE, CCPARA, Q, PY.
-C-------------- End CDE --------------------------------
- PARAMETER (NOFFLI=2, NOFFDA=4)
- PARAMETER (MAXLEV=36)
- DIMENSION MSAVE(8,MAXLEV)
-
-+SEQ, Q_JBYT, Q_AND, Q_OR.
-
-
- LDO = LXX
- KP = LEXP - 3
- KD = 0
- IF (LEXD.NE.0) KD= LEXD - 3
-
- MEXL = 0
- MEXG = 0
- IFL6 = 0
- LKEEP = 0
- LEVK = 0
- IF (LDO.NE.0) GO TO 31
- LKEEP = LYY
-
-C- MEXi are the cumulated EXE bits of:
-C- MEXL just all patch/deck directed sequences called
-C- MEXG all global seq called from the current KEEP
-C- MEXH all global seq called from the current call bank
-
-C----- Start new KEEP bank, is it ready for use?
-
- 21 IF (IAND(IQ(LKEEP),KM5).EQ.0) CALL LINKSU (LKEEP)
- IF (IAND(IQ(LKEEP),KM6).NE.0) GO TO 72
-
-C---- the KEEP bank is not ready, scan its associated
-C-- structure for unsatisfied sequence call banks
-
- MEXG = IQ(LKEEP)
- IFL6 = KM6
- LDO = LKEEP - 1
- 23 LDO = LQ(LDO-1)
- IF (LDO.EQ.0) GO TO 71
- JCCTYP = JBYT (IQ(LDO),9,6)
- IF (JCCTYP.LT.MCCCDE) GO TO 23
- IF (JCCTYP.GT.MCCXSQ) GO TO 23
-
-+SEQ, QEJECT.
-C---- call bank reached, connect all sequences called
-
- 31 MEXH = IQ(LDO)
- IF (IAND(IQ(LDO),KM17).NE.0) GO TO 48
- NSEQ = IQ(LDO+NOFFDA)
- IFL17 = KM17
-C- bit 17 : all sequences are definitly connected
-
-C-- next call
-
- JSEQ = 1
- 34 LNEW = LQ(LDO-JSEQ-NOFFLI)
- IF (LNEW.GT.0) GO TO 47
-
-C-- locate the KEEP bank
-
- IXSEQ = IQ(LDO+NOFFDA+JSEQ)
- CALL LOCSEQ (LNEW, IXSEQ, KP,KD)
- MEXH = IOR (MEXH,IQUEST(3))
- MEXL = IOR (MEXL,IQUEST(4))
- IF (LNEW.EQ.0) GO TO 45
- IFLPDD = IQUEST(2)
-
- IF (JBYT(IQ(LNEW),5,2).NE.3) GO TO 61
-
-C-- store the adr of the KEEP bank into XSQ
-
- 41 IF (IFLPDD.EQ.0) GO TO 46
- LNEW = -LNEW
- 45 IFL17 = 0
- IFL6 = 0
- 46 LQ(LDO-JSEQ-NOFFLI) = LNEW
- 47 JSEQ = JSEQ + 1
- IF (JSEQ.LE.NSEQ) GO TO 34
-
- IQ(LDO) = IOR (IQ(LDO), IAND(MEXH,15))
- IQ(LDO) = IOR (IQ(LDO), IFL17)
- 48 MEXG = IOR (MEXG,MEXH)
- IF (LEVK.NE.0) GO TO 23
- 49 LINKSQ = IAND (IOR(MEXL,MEXG), 15)
- RETURN
-
-C------ new unready KEEP, go down one level
-
- 61 IF (IAND(IQ(LNEW),KM7).EQ.0) GO TO 67
- LEVK = LEVK + 1
- IF (LEVK.GT.MAXLEV) GO TO 91
- MSAVE (1,LEVK) = LKEEP
- MSAVE (2,LEVK) = MEXG
- MSAVE (3,LEVK) = LDO
- MSAVE (4,LEVK) = MEXH
- MSAVE (5,LEVK) = IFL17
- MSAVE (6,LEVK) = JSEQ
- MSAVE (7,LEVK) = IFLPDD
- MSAVE (8,LEVK) = IFL6
- LKEEP = LNEW
- GO TO 21
-
-C-- sequence definition not yet filled in
-
- 67 IFL17 = 0
- IFL6 = 0
- GO TO 41
-
-C------ end of processing this KEEP, come back up one level
-
- 71 IQ(LKEEP) = IOR (IQ(LKEEP),IAND(MEXG,15))
- IQ(LKEEP) = IOR (IQ(LKEEP),IFL6)
- 72 IF (LEVK.EQ.0) GO TO 49
- LNEW = LKEEP
- LKEEP = MSAVE (1,LEVK)
- MEXG = MSAVE (2,LEVK)
- LDO = MSAVE (3,LEVK)
- MEXH = MSAVE (4,LEVK)
- IFL17 = MSAVE (5,LEVK)
- JSEQ = MSAVE (6,LEVK)
- IFLPDD = MSAVE (7,LEVK)
- IFL6 = MSAVE (8,LEVK)
- LEVK = LEVK -1
-
- NSEQ = LQ(LDO+NOFFDA)
- IF (IAND(IQ(LNEW),KM6).EQ.0) IFLPDD= -1
-
- IF (IFLPDD.EQ.0) THEN
- MEXH = IOR (MEXH,IQ(LNEW))
- ELSE
- MEXL = IOR (MEXL,IQ(LNEW))
- ENDIF
- GO TO 41
-
-C----- Sequence call loop
-
- 91 CONTINUE
- CALL P_FATAL ('sequence call loop')
- LINKSQ = 0
- END
-+SEQ, QCARDL. =====================================================
-+DECK, LINKSU.
- SUBROUTINE LINKSU (LKEEPX)
-
-C- Initial processing of the sequence kept at LKEEP:
-C- evaluate all IF conditions, delink all deselected material
-C. started 14-july-93
-
-+CDE, QBITS19, CCTYPE, CCPARA.
-+CDE, Q.
-C-------------- End CDE --------------------------------
-
-+SEQ, Q_JBYT, Q_AND, Q_OR.
-
-
- LKEEP = LKEEPX
- LEVIF = 0
- MEXCUM = 0
- IFLKM6 = KM6
- KDO = LKEEP - 2
- GO TO 23
-
-C------ accepted material
-
- 21 IFLKM6 = 0
- 22 KDO = LDO - 1
- 23 LDO = LQ(KDO)
- IF (LDO.EQ.0) GO TO 71
- MEXCUM = IOR (MEXCUM,IQ(LDO))
- JCCTYP = JBYT (IQ(LDO),9,6)
- IF (JCCTYP.LE.MCCNIL) GO TO 22
- IF (JCCTYP.GE.MCCTRU) GO TO 25
-
-C-- +CDE +SEQ: check IF condition is true
-
- IF (JCCTYP.EQ.MCCXSQ) GO TO 21
- CALL CCKRAK (IQ(LDO+1))
- CALL CCPROC
- MEXCUM = IOR (MEXCUM,MXCCIF)
- IF (JCCIFV.EQ.0) GO TO 21
- 24 CALL TOGARB (KDO,0)
- GO TO 23
-
-C-- new control
-
- 25 IF (JCCTYP.EQ.MCCELS) GO TO 26
- IF (JCCTYP.EQ.MCCEND) GO TO 28
-
-C-- handle +__IF
-
- CALL CCKRAK (IQ(LDO+1))
- CALL CCPROC
- MEXCUM = IOR (MEXCUM,MXCCIF)
- LEVIF = LEVIF + 1
- IF (JCCTYP.EQ.MCCFAL) JCCIFV= MAX(0, 1-JCCIFV)
- IF (JCCIFV.EQ.0) GO TO 29
- LVREND = LEVIF
- LVRELS = LEVIF + 1
- GO TO 41
-
-C-- handle +_ELSE, IF=xxx
-
- 26 LVREND = LEVIF
- LVRELS = LEVIF
- GO TO 41
-
-C-- handle +_ENDIF
-
- 28 LEVIF = LEVIF - 1
- 29 IF (IQ(LDO+2).LT.2) GO TO 24
- IQ(LDO+1) = IQ(LDO+1) + 1
- IQ(LDO+2) = IQ(LDO+2) - 1
- IQ(LDO+3) = IQ(LDO+3) + 1
- CALL SBYT (0, IQ(LDO),9,6)
- GO TO 22
-
-+SEQ, QEJECT, N=34.
-C------ rejected material
-
- 41 CALL TOGARB (KDO,0)
- LDO = LQ(KDO)
- IF (LDO.EQ.0) GO TO 71
- JCCTYP = JBYT (IQ(LDO),9,6)
- IF (JCCTYP.LT.MCCTRU) GO TO 41
-
-C-- new control
-
- IF (JCCTYP.EQ.MCCELS) GO TO 46
- IF (JCCTYP.EQ.MCCEND) GO TO 48
-
-C-- handle +__IF
-
- LEVIF = LEVIF + 1
- GO TO 41
-
-C-- handle +_ELSE, IF=xxx
-
- 46 IF (LEVIF.GE.LVRELS) GO TO 41
- CALL CCKRAK (IQ(LDO+1))
- CALL CCPROC
- MEXCUM = IOR (MEXCUM,MXCCIF)
- IF (JCCIFV.NE.0) GO TO 41
- GO TO 29
-
-C-- handle +_ENDIF
-
- 48 LEVIF = LEVIF - 1
- IF (LEVIF.GE.LVREND) GO TO 41
- GO TO 29
-
-C------ done
-
- 71 MEXCUM = IAND (MEXCUM,15)
- MEXCUM = MEXCUM + KM5 + IFLKM6
- IQ(LKEEP) = IOR (IQ(LKEEP),MEXCUM)
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, LOCPAT.
- FUNCTION LOCPAT (IXPAT)
-
-C- Locate the PAT bank for patch IXPAT
-
-C- return the adr of the bank found as function value,
-C- or zero if not found
-
-C- if the bank has been found in the 'future' chain
-C- relink it to be just after LEXP
-
-+CDE, KQADR, Q, PY.
-C-------------- End CDE --------------------------------
-
-
-C-- look in the 'future' chain
-
- LQ(LLPAST-1) = 0
- LF = KQFIND (IXPAT,2,KQMAIN,KP)
- IF (LF.NE.0) THEN
- IF (LF.EQ.LEXP) GO TO 27
- CALL QSHUNT (KP,LEXP-1)
- GO TO 27
- ENDIF
-
-C-- look in the 'past' chain
-
- LF = LQFIND (IXPAT,2,LQPAST)
-
- 27 LOCPAT = LF
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, LOCKEEP.
- SUBROUTINE LOCKEEP (LSEQ)
-
-C- Find the KEEP bank for the sequence decribed by
-C- the current +KEEP control line;
-C- create target PAT/DECK banks if local sequence.
-
-C- return LSEQ L-adr of the sequence found, or LSEQ=0
-C- IQUEST(1) K-adr of the seq found, if found
-C- else: K-adr for attachment at end
-C- IQUEST(2) zero: sequence is global
-C- -ve: sequence is local
-C- IQUEST(3) EXE bits of global sequence
-C- IQUEST(4) EXE bits of sequence
-C- IQUEST(11) adr of P/D to which the sequence would have
-C- to be attached, if local and not existing
-C- (to have access to the EXE bits)
-C. started 7-jan-92
-
-+CDE, CCPARA.
-+CDE, Q, PY.
-C-------------- End CDE --------------------------------
-
-
- IXS = MCCPAR(JCCPZ+1)
- KP = 0
- KD = 0
- LPD = 0
- IF (NCCPP.EQ.0) GO TO 24
-
- IXP = MCCPAR(JCCPP+1)
- IXD = MCCPAR(JCCPD+2)
-
- CALL CREAPD (IXP, IXD, 0)
- KP = LCRP - 3
- LPD = LCRP
- IF (LCRD.NE.0) THEN
- KD = LCRD - 3
- LPD = LCRD
- ENDIF
-
- 24 CALL LOCSEQ (LSEQ, IXS,KP,KD)
- IQUEST(11) = LPD
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, LOCSEQ.
- SUBROUTINE LOCSEQ (LSEQ, IXSEQ,KP,KD)
-
-C- Find KEEP bank for the sequence with the name index IXSEQ
-C- KP gives the patch-directed, KD the deck-directed sequences
-
-C- return LSEQ L-adr of the sequence found, or LSEQ=0
-C- IQUEST(1) K-adr of the seq found, if found
-C- else: K-adr for attachment at end
-C- IQUEST(2) zero: sequence is global
-C- -ve: sequence is local
-C- IQUEST(3) EXE bits of global sequence
-C- IQUEST(4) EXE bits of sequence
-
-C- if the sequence has been found as global, it is re-linked
-C- to the start of the global structure
-
-+CDE, KQADR, Q, PY.
-C-------------- End CDE --------------------------------
- EQUIVALENCE (KSQLOC,IQUEST(1)), (L,IQUEST(12))
- DIMENSION IXSEQ(9)
-
-
- IQUEST(11) = IXSEQ(1)
- IQUEST(2) = 0
- IQUEST(3) = 0
- IQUEST(4) = 0
-
-C-- Global set
-
- CALL LOCSQ2 (KQKEEP)
- IQUEST(3) = IQUEST(4)
- IF (L.EQ.0) GO TO 21
- LQ(KSQLOC) = LQ(L-1)
- LQ(L-1) = LQKEEP
- LQKEEP = L
- KSQLOC = KQKEEP
- 19 LSEQ = L
- RETURN
-
-C-- Patch-directed set: if KP not zero
-
- 21 IF (KP.EQ.0) GO TO 19
- IQUEST(2) = -1
- CALL LOCSQ2 (KP)
- IF (L.NE.0) GO TO 19
-
-C-- Deck-directed set: if KD not zero
-
- IF (KD.EQ.0) GO TO 19
- CALL LOCSQ2 (KD)
- GO TO 19
- END
-+SEQ, QCARDL. =====================================================
-+DECK, LOCSQ2.
- SUBROUTINE LOCSQ2 (KPAR)
-
-C- Slave to LOCSEQ, search one particular linear structure
-C- Input: KPAR search the linear structure attached at LQ(KPAR)
-C- IQUEST(11) name index of sequence to be found
-C- Output: IQUEST(1) K-adr of sequence found, if found, or
-C- K-adr in last bank searched, if not found
-C- IQUEST(4) cummulated EXE bits
-C- IQUEST(12) L-adr of sequence found
-
-+CDE, QBITS19, Q.
-C-------------- End CDE --------------------------------
- EQUIVALENCE (KSQLOC,IQUEST(1)), (L,IQUEST(12))
-
- PARAMETER (LOCID=4)
-
-+SEQ, Q_AND, Q_OR.
-
-
- 21 KNIL = 0
- K = KPAR
- 22 L = KQFIND (IQUEST(11),LOCID,K,KSQLOC)
- IF (L.EQ.0) RETURN
- IF (KNIL.NE.0) GO TO 27
- IQUEST(4) = IOR (IQUEST(4),IQ(L))
- IF (IAND(IQ(L),KM12).EQ.0) RETURN
-
-C-- NIL-sequence found, find true sequence
-
- KNIL = KSQLOC
- K = L-1
- GO TO 22
-
-C-- Found sequence covered by NIL, transmit EXE bits and de-link
-
- 27 IQ(L) = IOR (IQ(L), IAND(IQUEST(4),15))
- CALL TOGARB (KNIL,0)
- GO TO 21
- END
-+SEQ, QCARDL. =====================================================
-+DECK, MXJOIN.
- SUBROUTINE MXJOIN (MPAT,MDEC)
-
-C- Join EXE bits from MPAT and MDEC into MDEC
-
-+SEQ, Q_SHIFTL, Q_SHIFTR, Q_AND, Q_OR.
-
- MOR = IOR (MPAT, MDEC)
- MAND = IAND (MPAT, MDEC)
- MINH = IAND (ISHFTR(MAND,5), 31)
-
- NEW = IAND (MINH, MOR)
- MUSE = IAND (MINH, ISHFTR(MOR,10))
- MSEL = IAND (MINH, ISHFTR(MOR,14))
-
- NEW = IOR (NEW, ISHFTL(MINH, 5))
- NEW = IOR (NEW, ISHFTL(MUSE,10))
- NEW = IOR (NEW, ISHFTL(MSEL,14))
- CALL SBYT (NEW, MDEC,1,18)
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, MXOPER.
- SUBROUTINE MXOPER (MERACT)
-
-C- Unpack the USE bits in MU_DECK ready for use
-C- MERACT = EXE bits from actions into the deck
-C- if zero: initial unpack, if not: merge MERACT
-C. started 3-mar-92
-
-+CDE, QBITS19, QSTATE, Q, PY, MUSEBC.
-C-------------- End CDE --------------------------------
-+SEQ, Q_AND, Q_OR, Q_SHIFTR.
-+SEQ, xMUSEBC, IF=DOC_INL.
-
-C-- MERACT = O : initial split of MU_DECK
-
- IF (MERACT.NE.0) GO TO 21
-
- MU_FORG = IAND (MU_DECK, KM6-1)
- MU_INH = IAND (ISHFTR(MU_DECK,5), KM6-1)
- MX_TRAN = IAND (ISHFTR(MU_DECK,10), KM5-1)
- MX_FORG = IAND (MU_FORG, KM5-1)
-
- MXOR = IOR (MX_FORC,MU_DECK)
- MXAND = IAND (MX_FORC,MU_DECK)
-
- MX_SINH = IAND (ISHFTR(MXAND,5), KM5-1)
- MX_SELF = IOR (ISHFTR(MXOR,14), MX_FORG)
- GO TO 22
-
-C-- MERACT not zero, join it
-
- 21 MX_SELF = IOR (MX_SELF, MERACT)
- 22 MX_SELF = IAND (MX_SELF, MX_SINH)
-
- CALL UPKBYT (MX_SELF,1,NVEXDK,4,0)
- IF (NQERR.NE.0) NVEXDK(1)= 0
- NVEXDK(5) = NVEXDK(1) + NVEXDK(2)
- NVEXDK(6) = IAND (NVEXDK(2), MOPTIO(6))
- IF (INCRAD.LT.2) RETURN
-
-C-- ready for P=CRA*, D=blank or CRA*
- NVEXDK(1) = 0
- NVEXDK(2) = 1
- NVEXDK(5) = 1
- NVEXDK(6) = 1
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, NEXTDE.
- SUBROUTINE NEXTDE (JSLA,JSLE,JSLF,JTYPEF,NHOW)
-
-C- Find next line +DECK, etc. in line-range JSLA to JSLE-1
-C- NHOW = 0 scanning for PAM, look at first 3 keys
-C- >0 scanning for cradle, look at all keys, ignore +TITle
-C- =3 blank deck of the cradle, recognize +MORE
-C- <0 look at first -NHOW keys
-
-C- return JTYPEF 1,2,3(,4,5) and JSLF if found
-C- return JTYPEF -13 if line +MORE in the blank deck of the cradle
-C- return JTYPEF zero if not found
-
-+CDE, QTX.
-C-------------- End CDE --------------------------------
- PARAMETER (NPOSSA=6)
- CHARACTER POSS(NPOSSA)*4
- DATA POSS / '+DEC', '+PAT', '+TIT', '+PAM', '+QUI', '+MOR' /
-
-
- IF (NHOW.EQ.0) THEN
- NPOSX = 3
- ELSEIF (NHOW.EQ.3) THEN
- NPOSX = 6
- ELSEIF (NHOW.GT.0) THEN
- NPOSX = 5
- ELSE
- NPOSX = -NHOW
- ENDIF
-
-C-- next line
-
- JSL = JSLA - 1
- 11 JSL = JSL + 1
- IF (JSL.GE.JSLE) GO TO 98
- JTGO = MLIAD(JSL)
- IF (TEXT(JTGO).NE.'+') GO TO 11
- NTX = MLIAD(JSL+1) - JTGO - NCHNEWL
- IF (NTX.LT.4) GO TO 11
-
-C-- next possibility
-
- JPOSS = 0
- 21 JPOSS = JPOSS + 1
- IF (JPOSS.GT.NPOSX) GO TO 11
- JTX = JTGO + 1
- JC = 2
- IVP = ICHAR(POSS(JPOSS)(2:2))
- 22 IVT = ICHAR(TEXT(JTX))
- IF (IVT.NE.IVP) THEN
-+SELF, IF=QASCII.
- IF (IVT-IVP.NE.32) GO TO 21
-+SELF, IF=QEBCDIC.
- IF (IVP-IVT.NE.64) GO TO 21
-+SELF.
- ENDIF
- IF (JC.EQ.4) GO TO 28
- JTX = JTX + 1
- JC = JC + 1
- IVP = ICHAR(POSS(JPOSS)(JC:JC))
- GO TO 22
-
-C---- return
-
- 28 IF (NPOSX.GE.5) GO TO 29
- JSLF = JSL
- JTYPEF = JPOSS
- RETURN
-
-C-- cradle
-
- 29 IF (JPOSS.EQ.3) GO TO 11
- IF (JPOSS.EQ.6) JPOSS= -13
- JSLF = JSL
- JTYPEF = JPOSS
- RETURN
-
- 98 JSLF = JSLE
- JTYPEF = 0
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, NEXTSI.
- SUBROUTINE NEXTSI (JSLA,JTYPEF,NHOW)
-
-C- Check single line at JSLA is a header +DECK, etc.
-C- NHOW = 0 scanning for PAM, look at first 3 keys
-C- >0 scanning for cradle, look at all keys, ignore +TITle
-C- =3: blank deck of cradle, +MORE allowed
-
-C- return JTYPEF 1,2,3(,4,5) if found
-C- return JTYPEF -13 if line +MORE in the blank deck of the cradle
-C- return JTYPEF zero if not found
-
-+CDE, QTX.
-C-------------- End CDE --------------------------------
- PARAMETER (NPOSSA=6)
- CHARACTER POSS(NPOSSA)*4
- DATA POSS / '+DEC', '+PAT', '+TIT', '+PAM', '+QUI', '+MOR' /
-
-
- IF (NHOW.EQ.0) THEN
- NPOSX = 3
- ELSEIF (NHOW.EQ.3) THEN
- NPOSX = 6
- ELSE
- NPOSX = 5
- ENDIF
-
- JSL = JSLA
- JTGO = MLIAD(JSL)
- IF (TEXT(JTGO).NE.'+') GO TO 98
-
-C-- next possibility
-
- JPOSS = 0
- 21 JPOSS = JPOSS + 1
- IF (JPOSS.GT.NPOSX) GO TO 98
- JTX = JTGO + 1
- JC = 2
- IVP = ICHAR(POSS(JPOSS)(2:2))
- 22 IVT = ICHAR(TEXT(JTX))
- IF (IVT.NE.IVP) THEN
-+SELF, IF=QASCII.
- IF (IVT-IVP.NE.32) GO TO 21
-+SELF, IF=QEBCDIC.
- IF (IVP-IVT.NE.64) GO TO 21
-+SELF.
- ENDIF
- IF (JC.EQ.4) GO TO 28
- JTX = JTX + 1
- JC = JC + 1
- IVP = ICHAR(POSS(JPOSS)(JC:JC))
- GO TO 22
-
-C---- return
-
- 28 IF (NPOSX.GE.5) GO TO 29
- JTYPEF = JPOSS
- RETURN
-
-C-- cradle
-
- 29 IF (JPOSS.EQ.3) GO TO 98
- IF (JPOSS.EQ.6) JPOSS= -13
- JTYPEF = JPOSS
- RETURN
-
- 98 JTYPEF = 0
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, NEXTXX.
- SUBROUTINE NEXTXX (KEY,JSLA,JSLE,JSLF)
-
-C- Find next line with key= +XXX in line-range JSLA to JSLE-1
-C- return JSLF if found, JSLF =zero if not found
-
-+CDE, QTX.
-C-------------- End CDE --------------------------------
- CHARACTER KEY*4, UKEY*4
-
-
- UKEY = KEY
- JSL = JSLA - 1
-
-C-- next line
-
- 11 JSL = JSL + 1
- IF (JSL.GE.JSLE) GO TO 98
- JTX = MLIAD(JSL)
- IF (TEXT(JTX).NE.'+') GO TO 11
- NTX = MLIAD(JSL+1) - JTX - NCHNEWL
- IF (NTX.LT.4) GO TO 11
-
- JTX = JTX + 1
- JKY = 2
- IVK = ICHAR(UKEY(2:2))
- 22 IVT = ICHAR(TEXT(JTX))
- IF (IVT.NE.IVK) THEN
-+SELF, IF=QASCII.
- IF (IVT-IVK.NE.32) GO TO 11
-+SELF, IF=QEBCDIC.
- IF (IVK-IVT.NE.64) GO TO 11
-+SELF.
- ENDIF
- IF (JKY.EQ.4) GO TO 29
- JTX = JTX + 1
- JKY = JKY + 1
- IVK = ICHAR(UKEY(JKY:JKY))
- GO TO 22
-
-C---- return
-
- 29 JSLF = JSL
- RETURN
-
- 98 JSLF = 0
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, NEXTCC.
- SUBROUTINE NEXTCC (CHCC,JSLA,JSLE,JSLF,JTYPEF)
-
-C- Find next Patchy c/c line in line-range JSLA to JSLE-1
-C- having control-character CHCC in column 1
-
-C- return type number JTYPEF and JSLF if found
-C- return JTYPEF=zero and JSLF=JSLE if not found
-
-+CDE, QTX.
-C-------------- End CDE --------------------------------
- CHARACTER CHCC*1, CHCCU*1
-
-
- CHCCU = CHCC
- JSL = JSLA -1
-
-C-- next line
-
- 11 JSL = JSL + 1
- IF (JSL.GE.JSLE) GO TO 98
- JTX = MLIAD(JSL)
- IF (TEXT(JTX).NE.CHCCU) GO TO 11
- NTX = MLIAD(JSL+1) - JTX - NCHNEWL
- IF (NTX.LT.4) GO TO 11
-
- JTYPE = JPTYPE (TEXT(JTX))
- IF (JTYPE.EQ.0) GO TO 11
-
-C---- return
-
- JTYPEF = JTYPE
- JSLF = JSL
- RETURN
-
- 98 JTYPEF = 0
- JSLF = JSLE
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, SETGAP.
- SUBROUTINE SETGAP
-
-C- Ready the gap for the next deck
-C. started 19-july-95
-
-+CDE, MQCM, Q, PY.
-C-------------- End CDE --------------------------------
-
-
-C-- Check enough space
-
- NWFREE = LQCSTA(3) - LQCEND(1)
- IF (NWFREE.LE.NVGAP(1)) GO TO 24
-
- JSLOCC = LQLSTA(4)
- JSLFRE = LQLEND(2)
- NSLFRE = JSLOCC - JSLFRE
- NTXFRE = MLIAD(JSLOCC) - MLIAD(JSLFRE)
-
- NTXWAN = NVGAP(2) * NVGAP(4)
- IF (NSLFRE.LT.NVGAP(2)) GO TO 24
- IF (NTXFRE.GE.NTXWAN) GO TO 29
-
- 24 IF (IFLGAR.EQ.0) CALL MQSHIFT
- IFLGAR = 7
- NWFREE = LQCSTA(3) - LQCEND(1)
-
-C-- set limits of control division 2
-
- 29 LQCSTA(2) = LQCEND(1) + 5*(NWFREE/8)
- LQCEND(2) = LQCSTA(2)
-
-C-- clear text division 3
-
- LQLSTA(3) = LQLEND(2)
- LQLEND(3) = LQLSTA(3)
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, STRMID, T=JOIN.
- SUBROUTINE STRMID (JASM,JDIV,LINE,JPUT)
-
-C- Construct stream ID like FORT:0 into LINE(JPUT:)
-C. started 13-nov-93
-
-+CDE, SLATE, CM_TYP.
-C-------------- End CDE --------------------------------
- CHARACTER LINE*128
-
-
- JP = JPUT
- LINE(JP:JP+15) = CH_TYP(JASM)
- JP = LNBLNK (LINE(1:JP+15)) + 1
- LINE(JP:JP) = ':'
- CALL CSETDI (JDIV, LINE,JP+1,JP+1)
- NESLAT = JP + 2
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, USETT.
- SUBROUTINE USETT (JSL)
-
-C- Ready a title line for usage
-C. started 26-may-94
-
-+CDE, SLATE, SLATLN.
-+CDE, USETTC.
-+CDE, Q.
-C-------------- End CDE --------------------------------
- CHARACTER LINE*128, KARD*128
- EQUIVALENCE (LINE,SLERRM), (KARD,SLLINE)
-
-C- PATCHY 5.00 /72 1994/05/24 21.00 text
-C- _:.=+=.: 1_:.=+=.: 2_:.=+=.: 3_:.=+=.: 4_:.=+=.: 5_:.=
-C-
-C- start at col:
-C- JTTNAM CHTTNA(1) = name PATCHY
-C- JTTVER CHTTNA(2) = version 5.00 /72
-C- CHTTNA(3) = numeric vs 50072
-C-
-C- CHTTNA(4) = primary vs 5.00
-C- JTTSLA CHTTNA(5) = secondary vs 72
-C-
-C- JTTDAT CHTTDT = date/time 1994/05/24 21.00
-C- JTTCOM comment
-C-
-
- CALL VZERO (JTTNAM,12)
- CHTTNA(2) = '1.00'
- CHTTNA(3) = '10000'
- CHTTNA(4) = '1.00'
- CHTTNA(5) = '0'
- CHTTDT = ' '
-
- NTTNA(2) = 4
- NTTNA(3) = 5
- NTTNA(4) = 4
- NTTNA(5) = 1
- NTTDT = 0
-
- NVPRIM = 100
- NVSEC = 0
-
- IF (JSL.GT.0) THEN
- LINE = ' '
- CALL LN_GET (JSL, LINE, LEN(LINE))
- NTIT = NDSLAT
- CALL CLTOU (LINE(1:NTIT))
- ELSE
- LINE = 'unknown /1'
- NTIT = LNBLNK (LINE(1:16))
- ENDIF
-
-C-- check start with +TITLE: or C
-
- JTK = 1
- IF (LINE(1:4).EQ.'+TIT') THEN
- J = ICFIND (':', LINE,5,NTIT)
- IF (NGSLAT.NE.0) JTK= J + 1
- ELSEIF (LINE(1:2).EQ.'C ') THEN
- JTK = 3
- ENDIF
-
-C-- name
-
- JTK = ICNEXT (LINE,JTK,NTIT)
- N = MIN (10,NDSLAT)
- JNX = NESLAT
- NTTNA(1) = N
- CHTTNA(1) = LINE(JTK:JTK+N-1)
- JTTNAM = JTK
- IF (JSL.GT.0) CALL LN_GET (JSL, LINE, LEN(LINE))
-
-+SEQ, QEJECT.
-C-- does the version start with "/" ?
-
- JTK = ICNEXT (LINE,JNX,NTIT)
- IF (JTK.GE.NTIT) RETURN
-
- N = NDSLAT
- JNX = NESLAT
- IF (LINE(JTK:JTK).NE.'/') GO TO 26
- JTTSLA = JTK
-
- N = MIN (4,N)
- KARD(1:N) = LINE(JTK:JTK+N-1)
- IF (N.EQ.1) THEN
- KARD(2:2) = '1'
- N = 2
- ENDIF
-
- NTTNA(2) = N
- NTTNA(5) = N - 1
- CHTTNA(2) = KARD(1:N)
- CHTTNA(5) = KARD(2:N)
- NVSEC = ICDECI (KARD,2,N)
- GO TO 31
-
-C-- primary version
-
- 26 JTTVER = JTK
- JMK = ICFIND ('/', LINE,JTK,JNX)
- IF (JMK.LT.JNX) THEN
- JNX = JMK
- N = JNX - JTK
- ENDIF
-
- N = MIN (6,N)
- NTTNA(2) = N
- NTTNA(4) = N
-
- KARD(1:N) = LINE(JTK:JTK+N-1)
- CHTTNA(2) = KARD(1:N)
- CHTTNA(4) = KARD(1:N)
-
- NVPRIM = ICDECI (KARD,1,N) * 100
- JM = NESLAT + 1
- IF (JM.LE.N) NVPRIM = NVPRIM + ICDECI(KARD,JM,N)
-
-C-- secondary version
-
- JTK = ICNEXT (LINE,JNX,NTIT)
- N = NDSLAT - 1
- JNX = NESLAT
- IF (LINE(JTK:JTK).NE.'/') GO TO 34
- JTTSLA = JTK
- IF (N.LE.0) GO TO 31
-
- NTTNA(5) = N
- CHTTNA(5) = LINE(JTK+1:JTK+N)
- NSEC = ICDECI (CHTTNA(5),1,N)
-
- NP = NTTNA(4)
- CHTTNA(2) = CHTTNA(4)(1:NP) // ' /' // CHTTNA(5)(1:N)
- NTTNA(2) = LNBLNK (CHTTNA(2))
-
-C-- PAM creation date + time
-
- 31 JTK = ICNEXT (LINE,JNX,NTIT)
- JNX = NESLAT
-
- 34 IF (JTK.GT.NTIT) GO TO 41
- IF (ICTYPE(LINE(JTK:JTK)).NE.2) GO TO 41
- JTM = ICNEXT (LINE,JNX,NTIT)
- IF (JTM.LE.NTIT) THEN
- IF (ICTYPE(LINE(JTM:JTM)).EQ.2) THEN
- JNX = NESLAT
- ENDIF
- ENDIF
-
- N = JNX - JTK
- KARD(1:N) = LINE(JTK:JTK+N-1)
- CALL CSQMBL (KARD,1,N)
- N = MIN (N,20)
- N = LNBLNK (KARD(1:N))
- CHTTDT(1:N) = KARD(1:N)
- NTTDT = N
- JTK = ICFNBL (LINE,JNX,NTIT)
-
-C-- done
-
- 41 NTTALL = NTIT
- NTTNORM = NTIT
- IF (JTK.LE.NTIT) THEN
- NTTNORM = LNBLNK (LINE(1:JTK-1))
- JTTCOM = JTK
- ENDIF
-
- KARD(1:6) = ' '
- CALL CSETDI (100*NVPRIM+NVSEC, KARD,1,6)
- CALL CLEFT (KARD,1,6)
- NTTNA(3) = NDSLAT
- CHTTNA(3) = KARD(1:6)
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, VAXASMT, IF=QMVAX.
- SUBROUTINE VAXASMT
-
-C- Write the final .END line on streams ASSEMBLE for VAX
-C- called from PEND
-C. started 1-july-94
-
-+CDE, QSTATE, Q, PY.
-+CDE, CM_TYP.
-C-------------- End CDE --------------------------------
-
-
- IF (NQERR.NE.0) RETURN
- IF (MOPTIO(24).NE.0) RETURN
-
- LASMT = LQ(LHASM-JAS_TYP)
- LASML = LASMT
- JDIV = 0
-
-C---- do all physical streams
-
- 24 IF (JDIV.GT.4) RETURN
- IF (JDIV.NE.0) LASML= LQ(LASMT-JDIV-1)
- JDIV = JDIV + 1
- IF (IQ(LASML+1).NE.0) GO TO 24
- LASMX = LQ(LASML-1)
- IF (LASMX.EQ.0) GO TO 24
- LUN = IQ(LASMX+2)
- IF (LUN.LE.0) GO TO 24
- NL = IQ(LASMX+4)
- IF (NL.EQ.0) GO TO 24
- IQ(LASMX+4) = NL + 1
- WRITE (LUN,8001)
- GO TO 24
-
- 8001 FORMAT (' .END')
-
- END
-+SEQ, QCARDL. =====================================================
-+PATCH, SERVICE. Service routines
-+DECK, INISEQ.
- SUBROUTINE INISEQ
-
-C- Initialize the built-in sequences
-C. started 12-jan-94
-
-+CDE, QBITS19, QCHAR, QSTATE.
-+CDE, CCPARA, JSPSEQ, Q.
-C-------------- End CDE --------------------------------
-
-
- CCKARD = ' '
- CCKARD(1:1) = CQBSL
- CCKARD(2:2) = CQBSL
- N = LNBLNK (CCKARD(1:8))
- JSLH = LN_TO4 (CCKARD,N)
-
- CCKARD(1:20) = ' IDATQQ= 00 '
-C- _:.=+=.:_1_:.=+=.:_2
- CALL CSETDI (IQDATE,CCKARD,15,20)
- JSLD = LN_TO4 (CCKARD,20)
-
- CCKARD(1:18) = ' ITIMQQ= '
-C- _:.=+=.:_1_:.=+=.:_2
- CALL CSETDI (IQTIME,CCKARD,15,18)
- JSLT = LN_TO4 (CCKARD,18)
-
- CALL INISQX ('QTERMHD', 0, JSLH, KM5+KM6)
- CALL INISQX ('DATEQQ', 0, JSLD, KM5+KM6)
- CALL INISQX ('TIMEQQ', 0, JSLT, KM5+KM6)
-
- MASK = KM13+KM5+KM6
- DO 64 IX=JSPSEQ1,JSPSEQL
- 64 CALL INISQX (' ', IX, 1, MASK)
- RETURN
-
-+SEQ, xJSPSEQ, IF=DOC_INL.
- END
-+SEQ, QCARDL. =====================================================
-+DECK, INISQX.
- SUBROUTINE INISQX (CHNAME,IXSEQ,JSL,MASK)
-
-C- Create KEEP bank for special sequence
-C. started 11-feb-92
-
-+CDE, QBANKS, KQADR, Q, PY.
-C-------------- End CDE --------------------------------
- CHARACTER CHNAME*(*)
-
-+SEQ, Q_OR.
-
-
- IXNAME = IXSEQ
- IF (IXNAME.EQ.0) IXNAME = NA_LONG (CHNAME)
-
- CALL MQLIFT (L,KQKEEP,0,JBKKEE,1)
-
- IQ(L) = IOR (IQ(L),MASK)
- LQ(L-3) = LDECO
- IQ(L+1) = JSL
- IQ(L+2) = 1
- IQ(L+4) = IXNAME
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, LN_EQU, T=JOIN.
- LOGICAL FUNCTION LN_EQU (LINEA,LINEB,NCH)
-
-C- Compare LINEA(1:NCH) with LINEB(1:NCH),
-C- return true if LINEA = LINEB
-
- CHARACTER*512 LINEA, LINEB
-
-
- LN_EQU = LINEA(1:NCH) .EQ. LINEB(1:NCH)
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, LN_GET.
- SUBROUTINE LN_GET (JSL,LINE,NCH)
-
-C- Transfer the line at JSL from the store to local,
-C- NCH characters maximum,
-C- return NDSLAT # of chars. transferred,
-C- NESLAT # of chars. in store
-
-+CDE, SLATE, QTX.
-C-------------- End CDE --------------------------------
- CHARACTER*512 LINE
-
- JTX = MLIAD(JSL)
- NTX = MLIAD(JSL+1) - JTX - NCHNEWL
- NESLAT = NTX
-
- NTX = MIN (NCH,NTX)
- NDSLAT = NTX
-
- CALL CCOPYL (TEXT(JTX),LINE,NTX)
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, LN_PUT, T=JOIN.
- SUBROUTINE LN_PUT (LINE,NCH,JSL)
-
-C- Transfer a line from local to the store at slot JSL
-
-+CDE, QTX.
-C-------------- End CDE --------------------------------
- CHARACTER*512 LINE
-
- JTX = MLIAD(JSL)
- IF (NCH.GT.0) CALL CCOPYL (LINE,TEXT(JTX),NCH)
- JTX = JTX + NCH
-+SELF, IF=QNEWLINE.
- TEXT(JTX) = CHAR (NEWLN)
- JTX = JTX + 1
-+SELF.
- MLIAD(JSL+1) = JTX
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, LN_PUTR, T=JOIN.
- SUBROUTINE LN_PUTR (LINE,NCH,JSL)
-
-C- Transfer a line from local to the store,
-C- reverse at slot JSL-1
-
-+CDE, QTX.
-C-------------- End CDE --------------------------------
- CHARACTER*512 LINE
-
- JTX = MLIAD(JSL) - NCH - NCHNEWL
- MLIAD(JSL-1) = JTX
-
- IF (NCH.GT.0) CALL CCOPYL (LINE,TEXT(JTX),NCH)
-+SELF, IF=QNEWLINE.
- JTX = JTX + NCH
- TEXT(JTX) = CHAR (NEWLN)
-+SELF.
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, LN_COP2.
- FUNCTION LN_COP2 (JSL,NLI)
-
-C- Transfer: Copy NLI lines starting at slot JSL to division 2
-C. started 27-feb-92
-
-+CDE, MQCM, Q.
-C-------------- End CDE --------------------------------
-
-
- JSLFR = JSL
- NSL = NLI
- JTXFR = MLIAD(JSLFR)
- NTX = MLIAD(JSLFR+NSL) - JTXFR
-
- JSLTO = LQLEND(2)
- JTXTO = MLIAD(JSLTO)
- NTXRE = JTXTO - JTXFR
-
- JSLLIM = LQLSTA(4)
- JTXLIM = MLIAD(JSLLIM)
- IF (JSLTO+NSL+4 .GE.JSLLIM)
- + CALL NOSPACE ('no line slots left in text division 2')
- IF (JTXTO+NTX+8 .GE.JTXLIM)
- + CALL NOSPACE ('no text store left in text division 2')
-
- DO 44 J=1,NSL
- 44 MLIAD(JSLTO+J) = MLIAD(JSLFR+J) + NTXRE
-
- CALL CCOPYL (TEXT(JTXFR),TEXT(JTXTO),NTX)
-
- LQLEND(2) = JSLTO + NSL
- LQLSTA(3) = LQLEND(2)
- LQLEND(3) = LQLSTA(3)
- LN_COP2 = JSLTO
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, LN_MOV2, T=JOIN.
- FUNCTION LN_MOV2 (JSL,NLI)
-
-C- Transfer: Move NLI lines at slot JSL from division 1 to division 2
-C. started 27-feb-92
-
-+CDE, MQCM, Q.
-C-------------- End CDE --------------------------------
-
-
- JSLFR = JSL
- NSL = NLI
- JTXFR = MLIAD(JSLFR)
- NTX = MLIAD(JSLFR+NSL) - JTXFR
-
- JSLTO = LQLEND(2)
- JTXTO = MLIAD(JSLTO)
- NTXRE = JTXTO - JTXFR
-
- JSLLIM = LQLSTA(4)
- JTXLIM = MLIAD(JSLLIM)
- IF (JSLTO+NSL+4 .GE.JSLLIM)
- + CALL NOSPACE ('no line slots left in text division 2')
- IF (JTXTO+NTX+8 .GE.JTXLIM)
- + CALL NOSPACE ('no text store left in text division 2')
-
- DO 44 J=1,NSL
- 44 MLIAD(JSLTO+J) = MLIAD(JSLFR+J) + NTXRE
-
- CALL CCOPYL (TEXT(JTXFR),TEXT(JTXTO),NTX)
-
- IF (JSLFR.LT.LQLEND(1)) CALL TOGATX (JSLFR,NSL)
-
- LQLEND(2) = JSLTO + NSL
- LQLSTA(3) = LQLEND(2)
- LQLEND(3) = LQLSTA(3)
- LN_MOV2 = JSLTO
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, LN_TO3.
- FUNCTION LN_TO3 (LINE)
-
-C- Transfer: Set a line from local to division 3
-C. started 22-jun-93
-
-+CDE, MQCM, Q.
-C-------------- End CDE --------------------------------
- CHARACTER LINE*(*)
-
-+SELF, IF=QDEBUG.
- IF (LQLSTA(3).NE.LQLEND(2)) THEN
- CALL P_CRASH ('LN_TO3: LQLSTA(3) not = LQLEND(2)')
- ENDIF
-+SELF.
-
- NCH = LNBLNK (LINE)
- JSLTO = LQLEND(3)
- JTXTO = MLIAD(JSLTO)
- JTXE = JTXTO + NCH
-
- JSLLIM = LQLSTA(4)
- JTXLIM = MLIAD(JSLLIM)
- IF (JSLTO+4 .GE.JSLLIM)
- + CALL NOSPACE ('no line slots left in text division 3')
- IF (JTXE+8 .GE.JTXLIM)
- + CALL NOSPACE ('no text store left in text division 3')
-
- IF (NCH.GT.0) CALL CCOPYL (LINE,TEXT(JTXTO),NCH)
-+SELF, IF=QNEWLINE.
- TEXT(JTXE) = CHAR (NEWLN)
- JTXE = JTXE + 1
-+SELF.
- MLIAD(JSLTO+1) = JTXE
- LQLEND(3) = JSLTO + 1
- LN_TO3 = JSLTO
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, LN_COP3, T=JOIN.
- FUNCTION LN_COP3 (JSL,NLI)
-
-C- Transfer: Copy NLI lines starting at slot JSL into division 3
-C. started 22-jun-93
-
-+CDE, MQCM, Q.
-C-------------- End CDE --------------------------------
-
-+SELF, IF=QDEBUG.
- IF (LQLSTA(3).NE.LQLEND(2)) THEN
- CALL P_CRASH ('LN_COP3: LQLSTA(3) not = LQLEND(2)')
- ENDIF
-+SELF.
-
- JSLFR = JSL
- NSL = NLI
- JTXFR = MLIAD(JSLFR)
- NTX = MLIAD(JSLFR+NSL) - JTXFR
-
- JSLTO = LQLEND(3)
- JTXTO = MLIAD(JSLTO)
- NTXRE = JTXTO - JTXFR
-
- JSLLIM = LQLSTA(4)
- JTXLIM = MLIAD(JSLLIM)
- IF (JSLTO+NSL+4 .GE.JSLLIM)
- + CALL NOSPACE ('no line slots left in text division 3')
- IF (JTXTO+NTX+8 .GE.JTXLIM)
- + CALL NOSPACE ('no text store left in text division 3')
-
- DO 44 J=1,NSL
- 44 MLIAD(JSLTO+J) = MLIAD(JSLFR+J) + NTXRE
-
- CALL CCOPYL (TEXT(JTXFR),TEXT(JTXTO),NTX)
-
- LQLEND(3) = JSLTO + NSL
- LN_COP3 = JSLTO
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, LN_ENV3.
- FUNCTION LN_ENV3 (JSL)
-
-C- Copy the line at slot JSL to the end of division 3 with
-C- substitution of environment variables
-C. started 22-dec-93
-
-+CDE, SLATE, MQCM, Q.
-C-------------- End CDE --------------------------------
-
-+SELF, IF=QDEBUG.
- IF (LQLSTA(3).NE.LQLEND(2)) THEN
- CALL P_CRASH ('LN_ENV3: LQLSTA(3) not = LQLEND(2)')
- ENDIF
-+SELF.
-
- JSLFR = JSL
- JTXFR = MLIAD(JSLFR)
- NTXFR = MLIAD(JSLFR+1) - JTXFR - NCHNEWL
-
- JSLTO = LQLEND(3)
- JTXTO = MLIAD(JSLTO)
-
- JSLLIM = LQLSTA(4)
- JTXLIM = MLIAD(JSLLIM)
- NSLAV = JSLLIM - JSLTO - 2
- NTXAV = JTXLIM - JTXTO - 400
-
- IF (NSLAV.LT.2)
- + CALL NOSPACE ('no text store left in text division 3')
- IF (NTXAV.LT.NTXFR)
- + CALL NOSPACE ('no text store left in text division 3')
-
- CALL CENVIR (TEXT(JTXFR),NTXFR, TEXT(JTXTO),1,NTXAV,0)
-
- IF (NFSLAT.GE.4)
- + CALL NOSPACE ('no text store left in text division 3')
- IF (NFSLAT.GE.2) GO TO 91
- IF (NGSLAT.EQ.0) GO TO 41
- JTXE = JTXTO + NDSLAT
-+SELF, IF=QNEWLINE.
- TEXT(JTXE) = CHAR(NEWLN)
- JTXE = JTXE + 1
-+SELF.
- MLIAD(JSLTO+1) = JTXE
-
- LQLEND(3) = JSLTO + 1
- LN_ENV3 = JSLTO
- NGSLAT = 1
- RETURN
-
-C-- no substitution, return NGSLAT = 0
-
- 41 NDSLAT = NTXFR
- LN_ENV3 = JSLFR
- RETURN
-
-C-- syntax problems
-
- 91 LN_ENV3 = -1
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, LN_TO4.
- FUNCTION LN_TO4 (LINE,NCH)
-
-C- Transfer: Set a line from local to the start of division 4
-C. started 27-feb-92
-
-+CDE, MQCM, Q.
-C-------------- End CDE --------------------------------
- CHARACTER*512 LINE
-
- NTX = NCH + NCHNEWL
- JSLTO = LQLSTA(4)
- JTXTO = MLIAD(JSLTO) - NTX
- JSLTO = JSLTO - 1
-
- JSLLIM = LQLEND(3)
- JTXLIM = MLIAD(JSLLIM)
- IF (JSLTO.LE.JSLLIM+4)
- + CALL NOSPACE ('no line slots left in text division 4')
- IF (JTXTO.LE.JTXLIM+8)
- + CALL NOSPACE ('no text store left in text division 4')
-
- IF (NCH.GT.0) CALL CCOPYL (LINE,TEXT(JTXTO),NCH)
-+SELF, IF=QNEWLINE.
- JTXE = JTXTO + NTX
- TEXT(JTXE-1) = CHAR (NEWLN)
-+SELF.
- MLIAD(JSLTO) = JTXTO
- LQLSTA(4) = JSLTO
- LN_TO4 = JSLTO
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, LN_COP4, T=JOIN.
- FUNCTION LN_COP4 (JSL,NLI)
-
-C- Transfer: Copy NLI lines starting at slot JSL into division 4
-C. started 19-dec-91
-
-+CDE, MQCM, Q.
-C-------------- End CDE --------------------------------
-
-
- JSLFR = JSL
- NSL = NLI
- JTXFR = MLIAD(JSLFR)
- NTX = MLIAD(JSLFR+NSL) - JTXFR
-
- JSLTO = LQLSTA(4)
- JTXTO = MLIAD(JSLTO) - NTX
- JSLTO = JSLTO - NSL
- NTXRE = JTXTO - JTXFR
-
- JSLLIM = LQLEND(3)
- JTXLIM = MLIAD(JSLLIM)
- IF (JSLTO.LE.JSLLIM+4)
- + CALL NOSPACE ('no line slots left in text division 4')
- IF (JTXTO.LE.JTXLIM+8)
- + CALL NOSPACE ('no text store left in text division 4')
-
- DO 44 J=0,NSL-1
- 44 MLIAD(JSLTO+J) = MLIAD(JSLFR+J) + NTXRE
-
- CALL CCOPYL (TEXT(JTXFR),TEXT(JTXTO),NTX)
-
- LQLSTA(4) = JSLTO
- LN_COP4 = JSLTO
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, LUNFREE, IF=QFIO.
- FUNCTION LUNFREE (JOFFS)
-
-C- Find next free Fortran logical unit number, from LUN = 10 to 29
-C. started 3-aug-93
-
-+CDE, FTNLUN.
-C-------------- End CDE --------------------------------
-
-
- DO 24 J=1+JOFFS,NSFTN
- IF (LUNFRS(J).EQ.0) GO TO 27
- 24 CONTINUE
- CALL P_KILL (' All Fortran logical unit numbers occupied.')
-
- 27 LUNFREE = J + 9
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, LUNINQ, T=JOIN, IF=QFIO.
- FUNCTION LUNINQ (LUN)
-
-C- Check connection status of LUN
-C. started 3-aug-93
-
-+CDE, FTNLUN.
-C-------------- End CDE --------------------------------
-
-
- LUNINQ = LUNFRS(LUN-9)
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, LUNRESV, T=JOIN, IF=QFIO.
- SUBROUTINE LUNRESV (LUN,IXFN)
-
-C- Fortran logical unit number LUN is connected to file IXFN,
-C- if zero: LUN is now free
-C. started 3-aug-93
-
-+CDE, FTNLUN.
-C-------------- End CDE --------------------------------
-
-
- LUNFRS(LUN-9) = IXFN
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, NOSPACE, T=JOIN.
- SUBROUTINE NOSPACE (ERRM)
-
-+CDE, QUNIT.
-C-------------- End CDE --------------------------------
- CHARACTER ERRM*(*)
-
- IF (ERRM(1:1).NE.'-') THEN
- WRITE (IQPRNT,9001) ERRM
- IF (IQPRNT.NE.IQTYPE) WRITE (IQTYPE,9001) ERRM
- ENDIF
-
- CALL MQSHOW
-
- CALL P_KILL ('Space full')
-
- 9001 FORMAT (/'***!!! Memory problem because ',A)
- END
-+SEQ, QCARDL. =====================================================
-+DECK, SEGVIOL, T=JOIN, IF=QDIAG, IF=QS_UNIX.
- SUBROUTINE SEGVIOL
-
- CALL PERRORF ('perrorf has')
- CALL P_KILL ('SEGVIOL reached')
-
- END
-+SEQ, QCARDL. =====================================================
-+DECK, TOGARB.
- SUBROUTINE TOGARB (KDO,IFLAG)
-
-C- Shunt the single bank connected at KDO (if IFLAG.EQ.0)
-C- or the linear structure at KDO (if IFLAG.NE.0)
-C- to the garbage structure
-C. started 5-dec-91
-
-+CDE, MQCM, Q, PY.
-C-------------- End CDE --------------------------------
-
-
- LDO = LQ(KDO)
- IF (LDO.EQ.0) RETURN
-
-C-- single bank
-
- IF (IFLAG.NE.0) GO TO 21
- LQ(KDO) = LQ(LDO-1)
- IF (LDO.GE.LQCSTA(2)) RETURN
-
- LQ(LDO-1) = LQGARB
- LQGARB = LDO
- RETURN
-
-C-- linear structure
-
- 21 KL = KDO
- 22 LL = LQ(KL)
- IF (LL.GT.0) THEN
- IF (LL.GE.LQCSTA(2)) THEN
- LQ(KL) = LQ(LL-1)
- GO TO 22
- ELSE
- KL = LL - 1
- GO TO 22
- ENDIF
- ENDIF
-
- LDO = LQ(KDO)
- IF (LDO.EQ.0) RETURN
-
- LQ(KL) = LQGARB
- LQGARB = LDO
-
- LQ(KDO) = 0
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, TOGATX, T=JOIN.
- SUBROUTINE TOGATX (JSL,NSL)
-
-C- Send the NSL lines at JSL in division 1 to garbage
-C. started 5-feb-92
-
-+CDE, QBANKS, MQCM.
-+CDE, KQADR, QSH.
-C-------------- End CDE --------------------------------
-
-
- IF (JSL.GE.LQLEND(1)) RETURN
-
- CALL MQLIFT (L,KQGARB,0,JBKGAR,1)
- LQ(L+1) = JSL
- LQ(L+2) = NSL
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+PATCH, NAMING. Name Handler
-+DECK, NA_INIT.
- SUBROUTINE NA_INIT
-
-C- Pre-initialize the name stack
-C. started 1-oct-91
-
-+CDE, MQCM, Q.
-+CDE, NAMEC.
-C-------------- End CDE --------------------------------
-
-+SEQ, xNAMEC, IF=DOC_INL.
-
- NA_CUT = 32
- NA_MXSL = 6000
- NA_MXTX = 8 * NA_MXSL
-
- JSLA = LQLEND(5) - NA_MXSL
- JTXA = NSIZETX - NA_MXTX
-
- LQLSTA(5) = JSLA
- LQLEND(4) = JSLA
- LQLSTA(4) = JSLA
-
-C-- preset slot 0 one blank
-C- 1 unknown
-
- TEXT(JTXA) = ' '
- MLIAD(JSLA) = JTXA
- MLIAD(JSLA+1) = JTXA + 1
-
- JTXA = JTXA + 1
- JSLA = JSLA + 1
-
- CALL CCOPYL ('unknown', TEXT(JTXA), 7)
- MLIAD(JSLA+1) = JTXA + 7
- NA_OCC = JSLA
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, NA_INPY.
- SUBROUTINE NA_INPY
-
-C- Pre-set the name stack for Patchy
-C. started 19-july-93
-
-+CDE, NAMEC.
-C-------------- End CDE --------------------------------
-
-C-- preset slot (0 one blank)
-C- (1 unknown)
-C- 2 CRA*
-
-+SEQ, JSPSEQ, xJSPSEQ, IF=DOC_INL.
-
- CALL NA_LONG ('CRA*')
- CALL NA_LONG ('QCARD1')
- CALL NA_LONG ('QEJECT')
- CALL NA_LONG ('QFTITLE')
- CALL NA_LONG ('QFTITLCH')
- CALL NA_LONG ('QFHEAD')
- CALL NA_LONG ('QFNAME')
- CALL NA_LONG ('QFVERS')
- CALL NA_LONG ('QFVSNUM')
- CALL NA_LONG ('QFVPRIM')
- CALL NA_LONG ('QFVSEC')
- CALL NA_LONG ('QDATE')
- CALL NA_LONG ('QTIME')
- CALL NA_LONG ('QENVIR')
- CALL NA_LONG ('QTERMHD')
- CALL NA_LONG ('DATEQQ')
- CALL NA_LONG ('TIMEQQ')
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, NA_REIN.
- SUBROUTINE NA_REIN
-
-C- Re-initialize the name stack
-C- for c/l +NAMES, length, slots, text
-C. started 1-oct-91
-
-+CDE, CCPARA, MQCM, Q.
-+CDE, NAMEC.
-C-------------- End CDE --------------------------------
-
-
- IF (NCCPN.EQ.0) RETURN
-
- NLE = MCCPAR(JCCPN+1)
- NSL = 0
- NTX = 0
- IF (NCCPN.GE.2) NSL = MCCPAR(JCCPN+4)
- IF (NCCPN.GE.3) NTX = MCCPAR(JCCPN+7)
-
- IF (NLE.GT.0) NA_CUT = NLE
- IF (NSL.GT.0) NA_MXSL = NSL
-
- NA_CUT = MAX (NA_CUT, 8)
- NA_CUT = MIN (NA_CUT, 32)
- NA_MXSL = MAX (NA_MXSL,200)
-
- IF (NTX.GT.0) THEN
- NA_MXTX = NTX
- ELSE
- NA_MXTX = 8 * NA_MXSL
- ENDIF
- NA_MXTX = MAX (NA_MXTX,1200)
-
- JSLN = LQLEND(5) - NA_MXSL
- JTXN = NSIZETX - NA_MXTX
-
- JSLO = LQLSTA(5)
- JTXO = MLIAD(JSLO)
- NSL = NA_OCC +1 - JSLO
- NTX = MLIAD(NA_OCC+1) - JTXO
- NSH = JTXN - JTXO
-
- CALL UCOPY2 (MLIAD(JSLO),MLIAD(JSLN), NSL+1)
-
- IF (NSH.EQ.0) GO TO 29
-
- IF (NSH.LT.0) THEN
- CALL CCOPYL (TEXT(JTXO),TEXT(JTXN),NTX)
- ELSE
- CALL CCOPYR (TEXT(JTXO),TEXT(JTXN),NTX)
- ENDIF
-
- DO 24 J=JSLN,JSLN+NSL
- 24 MLIAD(J) = MLIAD(J) + NSH
-
- 29 LQLSTA(5) = JSLN
- LQLEND(4) = JSLN
- LQLSTA(4) = JSLN
- NA_OCC = JSLN + NSL -1
-
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, NA_NEW.
- FUNCTION NA_NEW (LINE,JL,JR)
-
-C- Register the P/D/Z name in LINE(JL:JR-1) and return its adr
-C- NDSLAT returns the length of the name
-C. started 1-oct-91
-
-+CDE, SLATE, MQCM, Q.
-+CDE, NAMEC.
-C-------------- End CDE --------------------------------
- CHARACTER LINE*512, NAMEOP*64
-
-
- NN = MIN (64, JR-JL)
- IF (NN.LE.0) GO TO 49
-
- NAMEOP(1:NN) = LINE(JL:JL+NN-1)
- CALL CLEFT (NAMEOP,1,NN)
- NN = MIN (NDSLAT, NA_CUT)
- IF (NN.EQ.0) GO TO 49
-
-
-C---- Find the name if it exists already
-
- JSL = LQLSTA(5) + 1
- 24 JTX = MLIAD(JSL)
- NTX = MLIAD(JSL+1) - JTX
- IF (NTX.EQ.NN) THEN
- IF (ICEQU(NAMEOP,TEXT(JTX),NN) .EQ.0) GO TO 29
- ENDIF
-
- JSL = JSL + 1
- IF (JSL.LE.NA_OCC) GO TO 24
-
-C---- Name does not exist, enter it
-
- IF (JSL+1 .GE.LQLEND(5)) GO TO 81
- JTX = MLIAD(JSL)
- IF (JTX+NN+8.GE.NSIZETX) GO TO 81
-
- CALL CCOPYL (NAMEOP,TEXT(JTX),NN)
- MLIAD(JSL+1) = JTX + NN
- NA_OCC = JSL
- 29 NDSLAT = NN
- NA_NEW = JSL - LQLSTA(5)
- RETURN
-
-C-- Zero-length string
-
- 49 NDSLAT = 0
- NA_NEW = 0
- RETURN
-
-C---- Space full
-
- 81 CALL NA_FUL
- NA_NEW = 0
- END
-+SEQ, QCARDL. =====================================================
-+DECK, NA_LONG.
- FUNCTION NA_LONG (NAMEOP)
-
-C- Register long string in NAMEOP as is and return its adr
-C- NDSLAT returns the length of the name
-C. started 1-oct-91
-
-+CDE, SLATE, MQCM, Q.
-+CDE, NAMEC.
-C-------------- End CDE --------------------------------
- CHARACTER NAMEOP*(*)
-
-
-C---- Find the name if it exists already
-
- NN = LNBLNK(NAMEOP)
- JSL = LQLSTA(5)
- IF (NN.EQ.0) GO TO 999
-
- 24 JTX = MLIAD(JSL)
- NTX = MLIAD(JSL+1) - JTX
- IF (NTX.EQ.NN) THEN
- IF (ICEQU(NAMEOP,TEXT(JTX),NN) .EQ.0) GO TO 999
- ENDIF
-
- JSL = JSL + 1
- IF (JSL.LE.NA_OCC) GO TO 24
-
-C---- Name does not exist, enter it
-
- IF (JSL+1 .GE.LQLEND(5)) GO TO 81
- JTX = MLIAD(JSL)
- IF (JTX+NN+8.GE.NSIZETX) GO TO 81
-
- CALL CCOPYL (NAMEOP,TEXT(JTX),NN)
- MLIAD(JSL+1) = JTX + NN
- NA_OCC = JSL
- 999 NDSLAT = NN
- NA_LONG = JSL - LQLSTA(5)
- RETURN
-
-C---- Space full
-
- 81 CALL NA_FUL
- NA_LONG = 0
- END
-+SEQ, QCARDL. =====================================================
-+DECK, NA_GET.
- SUBROUTINE NA_GET (JNA,LINE,JCL)
-
-C- Transfer the text of name JNA into LINE at col. JCL
-C. started 1-oct-91
-
-+CDE, SLATE, MQCM, Q.
-+CDE, NAMEC.
-C-------------- End CDE --------------------------------
- CHARACTER LINE*(*)
-
-
- JSL = JNA + LQLSTA(5)
-+SELF, IF=QDEBUG.
- IF (JNA.LT.0 .OR. JSL.GT.NA_OCC)
- + CALL P_CRASH ('name-index out of range')
-+SELF.
- JTX = MLIAD(JSL)
- NTX = MLIAD(JSL+1) - JTX
- N = MIN (NTX, LEN(LINE)+1-JCL)
-
- CALL CCOPYL (TEXT(JTX),LINE(JCL:),N)
-
- NDSLAT = N
- NESLAT = JCL + N
- NFSLAT = NTX
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, NA_JTX, T=JOIN.
- FUNCTION NA_JTX (JNA)
-
-C- Get the start adr of the text of name JNA
-C. started 27-jan-92
-
-+CDE, SLATE, MQCM, Q.
-+CDE, NAMEC.
-C-------------- End CDE --------------------------------
-
-
- JSL = JNA + LQLSTA(5)
-+SELF, IF=QDEBUG.
- IF (JNA.LT.0 .OR. JSL.GT.NA_OCC)
- + CALL P_CRASH ('name-index out of range')
-+SELF.
- JTX = MLIAD(JSL)
- NTX = MLIAD(JSL+1) - JTX
-
- NDSLAT = NTX
- NA_JTX = JTX
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, NA_DIF.
- FUNCTION NA_DIF (JNA,JNB)
-
-C- Compare NAMEA at JNA with NAMEB at JNB,
-C- return zero if NAMEA = NAMEB
-C- -1 if NAMEA < NAMEB
-C- +1 if NAMEA > NAMEB
-C. started 12-feb-92
-
-+CDE, MQCM, Q.
-+CDE, NAMEC.
-C-------------- End CDE --------------------------------
-
-
- IF (JNA.EQ.JNB) THEN
- NA_DIF = 0
- RETURN
- ENDIF
-
- JSLA = JNA + LQLSTA(5)
- JSLB = JNB + LQLSTA(5)
-
- JTXA = MLIAD(JSLA)
- JTXB = MLIAD(JSLB)
-
- NTXA = MLIAD(JSLA+1) - JTXA
- NTXB = MLIAD(JSLB+1) - JTXB
-
- NA_DIF = NA_XCO (TEXT(JTXA),TEXT(JTXB),NTXA,NTXB)
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, NA_CHK.
- FUNCTION NA_CHK (LINE,JL,JR)
-
-C- Find the P/D/Z name in LINE(JL:JR-1) and return its relative adr
-C- or -1 if not found
-C- NDSLAT returns the length of the name
-C. started 1-oct-91
-
-+CDE, SLATE, MQCM, Q.
-+CDE, NAMEC.
-C-------------- End CDE --------------------------------
- CHARACTER LINE*512, NAMEOP*64
-
-
- NN = MIN (64, JR-JL)
- IF (NN.NE.0) THEN
- NAMEOP(1:NN) = LINE(JL:JL+NN-1)
- CALL CLEFT (NAMEOP,1,NN)
- NN = MIN (NDSLAT, NA_CUT)
- ENDIF
-
-C---- Find the name
-
- JSL = LQLSTA(5)
- IF (NN.EQ.0) GO TO 29
- 24 JSL = JSL + 1
- IF (JSL.GT.NA_OCC) GO TO 91
- JTX = MLIAD(JSL)
- NTX = MLIAD(JSL+1) - JTX
- IF (NTX.NE.NN) GO TO 24
- IF (ICEQU(NAMEOP,TEXT(JTX),NN) .NE.0) GO TO 24
-
- 29 NA_CHK = JSL - LQLSTA(5)
- NDSLAT = NN
- RETURN
-
- 91 NA_CHK = -1
- NDSLAT = NN
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, NA_XCO.
- FUNCTION NA_XCO (NAMEA,NAMEB,NCHA,NCHB)
-
-C- Compare NAMEA(1:NCH) with NAMEB(1:NCH),
-C- return zero if NAMEA = NAMEB
-C- -1 if NAMEA < NAMEB
-C- +1 if NAMEA > NAMEB
-C- internal routine called only from NA_DIFF
-
- CHARACTER*512 NAMEA, NAMEB
-
- JVAL = 0
- NCH = MIN (NCHA,NCHB)
- IF (NCH.EQ.0) THEN
- IF (NCHA.EQ.NCHB) GO TO 49
- IF (NCHA.LT.NCHB) THEN
- JVAL = -1
- ELSE
- JVAL = 1
- ENDIF
- GO TO 49
- ENDIF
-
- IF (NAMEA(1:NCH) .EQ. NAMEB(1:NCH)) THEN
- IF (NCHA.EQ.NCHB) GO TO 49
- IF (NCHA.LT.NCHB) THEN
- JVAL = -1
- ELSE
- JVAL = 1
- ENDIF
- GO TO 49
- ENDIF
-
- IF (LLT(NAMEA(1:NCH),NAMEB(1:NCH))) THEN
- JVAL = -1
- ELSE
- JVAL = 1
- ENDIF
-
- 49 NA_XCO = JVAL
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, NA_FUL.
- SUBROUTINE NA_FUL
-
-C- Name stack full
-C. started 22-jan-92
-
-+CDE, QUNIT, MQCM, Q.
-+CDE, NAMEC.
-C-------------- End CDE --------------------------------
-
-
- JSL = LQLSTA(5)
- JSLE = NA_OCC + 1
- JTX = MLIAD(JSL)
- JTXE = MLIAD(JSLE)
-
- NSLOCC = JSLE - JSL
- NTXOCC = JTXE - JTX
- NSLAV = LQLEND(5) - JSL
- NTXAV = NSIZETX - JTX
-
- NSLPRO = (100 * NSLOCC) / NSLAV
- NTXPRO = (100 * NTXOCC) / NTXAV
-
- WRITE (IQPRNT,9082) NTXOCC,NTXPRO,NTXAV,
- + NSLOCC,NSLPRO,NSLAV
- 9082 FORMAT (/' ***!!! Name space full !!!***'/
- F5X,'Name text ',I7,' or',I3,'% used of',I7,' bytes maximum'/
- F5X,'Name slots',I7,' or',I3,'% used of',I7,' maximum')
-
- CALL NOSPACE ('-')
- END
-+SEQ, QCARDL. =====================================================
-+DECK, NA_PRIX, T=JOIN.
- SUBROUTINE NA_PRIX (MSG,IX)
-
-C- Print content of index IX with message
-C. started 7-june-94
-
-+CDE, SLATE, SLATLN, QUNIT.
-C-------------- End CDE --------------------------------
- CHARACTER LINE*128, MSG*(*)
- EQUIVALENCE (LINE,SLERRM)
-
-
- CALL NA_GET (IX,LINE,1)
-
- WRITE (IQPRNT,9001) MSG,LINE(1:NDSLAT)
- NQUSED = NQUSED + 1
- NQLLBL = 0
- 9001 FORMAT (A,A)
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, NA_DUMP.
- SUBROUTINE NA_DUMP
-
-C- Dump the NAME stack
-
-+CDE, SLATE, QUNIT, MQCM, Q.
-+CDE, NAMEC.
-C-------------- End CDE --------------------------------
- CHARACTER NAMEOP*80
-
-
- WRITE (IQPRNT,9011) LQLSTA(5), NA_OCC, NA_CUT
- 9011 FORMAT (/'1Dump the NAME stack, start/end/cutat =',2I7,I3)
-
- IF (NA_OCC.EQ.0) RETURN
-
- IF (LQLSTA(5).LT.LQLEND(4)) GO TO 84
- IF (NA_OCC.LT.LQLSTA(5)) GO TO 84
- IF (NA_CUT.LT.6) GO TO 84
- IF (NA_CUT.GT.32) GO TO 84
-
- JSL = LQLSTA(5)
- JSLE = NA_OCC + 1
- JTX = MLIAD(JSL)
- JTXE = MLIAD(JSLE)
-
- NSLOCC = JSLE - JSL
- NTXOCC = JTXE - JTX
- NSLAV = LQLEND(5) - JSL
- NTXAV = NSIZETX - JTX
-
- NSLPRO = (100 * NSLOCC) / NSLAV
- NTXPRO = (100 * NTXOCC) / NTXAV
-
- WRITE (IQPRNT,9017) NTXOCC,NTXPRO,NTXAV,JTX,
- + NSLOCC,NSLPRO,NSLAV
- 9017 FORMAT (/
- F8X,'Name text ',I7,' or',I3,'% used of',I7,' bytes maximum at',I9/
- F8X,'Name slots',I7,' or',I3,'% used of',I7,' maximum'//
- F7X,'J JSL JTX N name'/)
-
- JNA = 0
- 44 JTX = MLIAD(JSL)
- NTX = MLIAD(JSL+1) - JTX
- IF (NTX.LE.0) GO TO 81
-
- NAMEOP = ' '
- CALL NA_GET (JNA,NAMEOP,1)
- IF (NDSLAT.NE.NTX) GO TO 82
-
- WRITE (IQPRNT,9044) JNA,JSL,JTX,NTX,NAMEOP(1:NTX+1)
- 9044 FORMAT (1X,2I7,I9,I3,2X,A)
-
- IF (JSL.EQ.NA_OCC) RETURN
- JSL = JSL + 1
- JNA = JNA + 1
- GO TO 44
-
-C---- Trouble
-
- 81 WRITE (IQPRNT,9081) JNA,JSL,JTX,NTX
- RETURN
-
- 82 WRITE (IQPRNT,9082) JNA,JSL,JTX,NTX,NDSLAT
- RETURN
-
- 84 WRITE (IQPRNT,9084)
- RETURN
-
- 9081 FORMAT (1X,2I7,I9,I3,' ***!!! faulty !!!***')
- 9082 FORMAT (1X,2I7,I9,2I3,' ***!!! faulty !!!***')
- 9084 FORMAT (40X,'***!!! Faulty !!!***')
- END
-+SEQ, QCARDL. =====================================================
-+PATCH, MQ. Hydra memory management routines
-+DECK, MQINIT.
- SUBROUTINE MQINIT
-
-C- Initialise memory manager and some other COMMONs
-
-+CDE, FTNLUN, IF=QFIO.
-+CDE, CCPARA, LUNSLN.
-+CDE, QBANKS, QCHAR, QMACH, QPAGE, QSTATE, QUNIT.
-+CDE, MQCM, MQCT, MQCN, MQCL.
-+CDE, Q.
- +, MUSER(9)
-C-------------- End CDE --------------------------------
- COMMON /SLATE/ ISLATE(40)
- LOGICAL INTRAC
-
- CHARACTER MMTOBK(NBANKS)*20
-
- DATA MMTOBK / 'PAT 0 4 3 2'
- +, 'DECK 0 4 3 1'
- +, 'ORG 0 0 0 2'
- +, 'INCL 0 1 1 1'
- +, 'HOLD 1 1 1 5'
- +, 'KEEP 1 3 2 4'
- +, 'ACT 1 3 2 5'
- +, 'MAT 1 3 1 3'
- +, 'XSQ 1 3 1 5'
- +, 'PREP 1 3 1 2'
- +, 'GARB 0 1 1 2'
- +, 'ASMH 0 63 0 2'
- +, 'ASMT 0 5 1 11'
- +, 'ASML 0 1 1 11'
- +, 'ASMX 0 1 1 4'
- +, 'ARRV 0 2 2 14'
- +, 'ASAV 1 1 1 2'
- +, 'PAM 0 0 0 15'
- +, 'RPAM 0 1 1 4' /
-C- _:.=+=.: 1_:.=+=.: 2
-C- ID LI NL NS ND
-
-
-+SEQ, QEJECT.
-
-C-- Ready common /QCHAR/
-
- CQBLAN = ' '
- CALL CFILL ('====', CQEQS, 1, LEN(CQEQS))
- CQCETA = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ012345'
-+SELF, IF=QASCII.
- CQAPO = CHAR(39)
- CQBSL = CHAR(92)
- CQTAB = CHAR(9)
-+SELF, IF=QEBCDIC.
- CQAPO = CHAR(125)
- CQBSL = CHAR(61)
- CQTAB = CHAR(5)
-+SELF.
-
-C-- Ready common /QPAGE/
-
-+SELF, MQINITLI.
- NQLMAX = 110
- NQCMAX = 120
- NQCPGH = 110
-+SELF.
- CALL MQPAGE
- NQNEWH = 0
- NQJOIN = 0
- NQDKNO = 0
- NQDKPG = 1
- NQPAGE = 1
- NQWYL = 0
- NQWYLDO= 0
-
-C-- Ready common /QSTATE/
-
- CALL VZERO (NQERR,6)
- CALL DATIME (IQDATE,IQTIME)
- IQDATE = (ISLATE(1)*100 + ISLATE(2))*100 + ISLATE(3)
- ISL4 = ISLATE(4)
- ISL5 = ISLATE(5)
-
- CQDATE = '00000000'
- CALL CSETDI (IQDATE,CQDATE,1,8)
- CQDATEM = CQDATE(1:4) // '/' // CQDATE(5:6) // '/' // CQDATE(7:8)
-
- CQTIME = ' 0.0 '
- CALL CSETDI (ISL4, CQTIME,1,2)
- CALL CSETDI (ISL5, CQTIME,4,5)
-
-C-- Ready common /QUNIT/
-
-+SELF, MQINITUN.
- IQREAD = 2
- IQPRNT = 3
- IQTTIN = 5
- IQTYPE = 6
-+SELF.
- IQRSAV = IQREAD
- IQRFD = 0
- IQRRD = 0
- IQRSIZ = 0
- NQLPAT = 0
- NQUSED = 0
- NQLLBL = 0
- NQINIT = 7
-
- IF (INTRAC()) THEN
- IQOFFL = 0
- IQRTTY = IQTTIN
- ELSE
- IQOFFL = 1
- IQRTTY = 0
- ENDIF
-
-C-- Ready common /MQCM/
-
- LQADR = LOCF (LQ(1))
- LQADR0 = LQADR - 1
- NQOFFS = LOCF (MLIAD(1)) - LQADR
- NQSYSS = 12
- NQLINK = 24
- NQMAX = NSIZEQ - 2
-
-C-- Clear commons
-
- CALL VZERO (IQUEST,4000)
- CALL VZERO (LQTA,14)
- CALL VZERO (NQLST,8)
- CALL VZERO (IQLST,10)
-
- IFLAUX = 0
- CALL VZERO (IXLUN,12)
-
- CALL VZERO (NCHCCD,269)
- CCKORG = ' '
- CCKARD = ' '
- MCCPAR(2) = -1
-+SELF, IF=QFIO.
- CALL VZERO (LUNFRS, NSFTN)
-+SELF.
-+SEQ, QEJECT.
-
-C-- Ready control divisions
-
- LQCEND(3) = NQMAX - 1
- LQCSTA(3) = LQCEND(3)
-
- LQCSTA(1) = NQLINK + 1
- LQCEND(1) = LQCSTA(1)
-
- LQCSTA(2) = (LQCSTA(3)+LQCEND(1)) / 2
- LQCEND(2) = LQCSTA(2)
-
-C-- Ready text divisions
-
- JTXL = NSIZETX - 12000
- JSLL = NSIZELN - 2000
- MLIAD(JSLL) = JTXL
-
- LQLSTA(4) = JSLL
- LQLEND(4) = JSLL
- LQLSTA(5) = JSLL
- LQLEND(5) = NSIZELN - 2
- MLIAD(LQLEND(5)) = NSIZETX
-
-C-- slots 1+2 are used for constructing the line
-C-- for each special sequence
-
- DO 42 J=1,999
- 42 TEXT(J) = ' '
- MLIAD(1) = 1
- MLIAD(2) = 257
- MLIAD(3) = 513
-
- LQLSTA(1) = 1
- LQLEND(1) = 3
- LQLSTA(2) = LQLEND(1)
- LQLEND(2) = LQLSTA(2)
- LQLSTA(3) = LQLEND(2)
- LQLEND(3) = LQLSTA(3)
-
-C-- Ready /QBANKS/
-
- DO 47 J=1,NBANKS
- CALL UCTOH (MMTOBK(J),MMBANK(1,J),4,4)
- MMBANK(2,J) = ICDECI (MMTOBK(J), 6, 8)
- MMBANK(3,J) = ICDECI (MMTOBK(J),10,12)
- MMBANK(4,J) = ICDECI (MMTOBK(J),14,16)
- 47 MMBANK(5,J) = ICDECI (MMTOBK(J),18,20)
-
-C-- Initialize the name handler
-
- CALL NA_INIT
- CALL NA_INPY
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, MQPAGE, T=JOIN.
- SUBROUTINE MQPAGE
-
-C- Set derived page size parameters
-
-+CDE, QPAGE.
-C-------------- End CDE --------------------------------
-
-
- NQLTOL = NQLMAX - 7
- NQLTOK = NQLMAX - 4
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, MQSHOW.
- SUBROUTINE MQSHOW
-
-C- Display current memory occupation
-
-+CDE, QUNIT, MQCM, Q, PY.
-C-------------- End CDE --------------------------------
-
-
- CALL DPBLAN (0)
- WRITE (IQPRNT,9010)
- WRITE (IQPRNT,9011) (LQCSTA(J),LQCEND(J),J=1,3)
- WRITE (IQPRNT,9012) (LQLSTA(J),LQLEND(J),J=1,5)
- WRITE (IQPRNT,9013) (MLIAD(LQLSTA(J)),MLIAD(LQLEND(J)),J=1,5)
- WRITE (IQPRNT,9014) NVGAP
- NQUSED = NQUSED + 25
- RETURN
-
- 9010 FORMAT (' Present state of memory,',
- F' start + end adrs of divisions:')
- 9011 FORMAT (
- F/' control div 1: collectable foreign material',2I9
- F/' control div 2: processing current deck ',2I9
- F/' control div 3: permanent foreign material ',2I9)
- 9012 FORMAT (
- F/' line slots of text div 1: foreign material ',2I9
- F/' line slots of text div 2: PAM file in store ',2I9
- F/' line slots of text div 3: volatile construction ',2I9
- F/' line slots of text div 4: permanent construction',2I9
- F/' line slots of text div 5: naming stack ',2I9)
- 9013 FORMAT (
- F/' text div 1: foreign material ',2I9
- F/' text div 2: PAM file in store ',2I9
- F/' text div 3: volatile construction ',2I9
- F/' text div 4: permanent construction',2I9
- F/' text div 5: naming stack ',2I9)
- 9014 FORMAT (/' Gap parameters to control garbage collection:'
- F/' Min. number of words free for control division 2',I7
- F/' Min. number of lines free for text divisions 3+4',I7
- F/' Max. number of lines expected in any deck ',I7
- F/' Mean number of characters per line ',I7/)
- END
-+SEQ, QCARDL. =====================================================
-+DECK, MQWORK, T=JOIN.
- SUBROUTINE MQWORK (LREF,IDATA,IDATAL)
-
-C- Set working space limits and clear wsp to zero
-
-+CDE, MQCM, Q.
-C-------------- End CDE --------------------------------
- DIMENSION IDATA(9),IDATAL(9)
-
-
- NS = IQLOCF(LREF) - 1
- NL = IQLOCF(IDATA) - 1
- NW = IQLOCF(IDATAL) + 1
-
- NQSYSS = NS
- NQLINK = NL
-
- LQCSTA(1) = NW
- LQCEND(1) = NW
- CALL VZERO (IQUEST, NW+200)
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, MQLIFT.
- SUBROUTINE MQLIFT (L,K,N,JN,JD)
-
-C- Satisfy bank request
-C- Linkage control: if N.LE.0 connect at LQ(K-N)
-C- N.EQ.1 connect at K (top level)
-C- N.GE.2 no connection (stand alone)
-C- JN is the bank name index, JD is the division number
-C- return in L the adr of the bank lifted
-C. started 8-oct-91
-
-+CDE, SLATLN.
-+CDE, QBANKS, MQCM, MQCT, MQCL, QUNIT.
-+CDE, QSH.
-C-------------- End CDE --------------------------------
- DIMENSION L(9), K(9), JN(9), JD(9)
-
-
- KK = K(1)
- JBKIX = JN(1)
- JDIV = JD(1)
- IFORW = 3 - JDIV
-+SELF, IF=QDEBUG.
- IF ((JBKIX.LE.0).OR.(JBKIX.GT.NBANKS)) THEN
- CALL P_CRASH ('MQLIFT - faulty bank name index')
- ENDIF
- IF ((JDIV.LE.0).OR.(JDIV.GT.3)) THEN
- CALL P_CRASH ('MQLIFT - faulty division index')
- ENDIF
-+SELF.
-
- NQTY = JBKIX
- NQID = MMBANK(1,JBKIX)
- NQLI = MMBANK(2,JBKIX)
- NQNL = MMBANK(3,JBKIX)
- NQNS = MMBANK(4,JBKIX)
- NQND = MMBANK(5,JBKIX)
- NT = NQNL + NQND + 2
-+SELF, IF=QDEBUG.
- IF ((NQNL.GE.64).OR.(NQNS.GT.NQNL).OR.(NQND.GE.2048)) THEN
- PRINT *, ' MQLIFT: NL/NS/ND=',NQNL,NQNS,NQND
- CALL P_CRASH ('MQLIFT - faulty bank parameters')
- ENDIF
-+SELF.
- IF (IFORW.NE.0) THEN
- NQLNA = LQCEND(JDIV)
- NQRESV(1) = LQCSTA(JDIV+1) - NQLNA - NT
- ELSE
- NQLNA = LQCSTA(JDIV) - NT
- NQRESV(1) = NQLNA - LQCEND(JDIV-1)
- ENDIF
-
- IF (NQRESV(1).LE.0) THEN
- SLERRM = 'no space in control division x'
-C- _:.=+=.: 1_:.=+=.: 2_:.=+=.: 3
- CALL CSETDI (JDIV,SLERRM,30,30)
- CALL NOSPACE (SLERRM(1:30))
- ENDIF
-
- IF (IFORW.NE.0) THEN
- LQCEND(JDIV) = LQCEND(JDIV) + NT
- ELSE
- LQCSTA(JDIV) = LQCSTA(JDIV) - NT
- ENDIF
-
- NQLST = NQLNA + NQNL + 1
- CALL VZERO (LQ(NQLNA),NT)
- CALL QLUMP
- IF (N.LE.0) THEN
- KKN = KK + N
- LNX = LQ(KKN)
- LQ(KKN) = NQLST
- ELSEIF (N.EQ.1) THEN
- LNX = KK
- K(1) = NQLST
- ELSE
- LNX = 0
- ENDIF
- IF (NQNS.GT.0) LQ(NQLST-1) = LNX
- L(1) = NQLST
-+SELF, IF=XDEBUG, IF=XMQLIFT.
- WRITE (IQPRNT,9899) NQID,NQLNA,NQLST,
- + NQTY,NQLI,NQNL,NQNS,NQND
- 9899 FORMAT (/' Xdebug MQLIFT: lift bank ',A4,' at LN/LST=',2I7/
- F16X,'TY=',I2,' LI=',I1,' NL/NS=',2I3,' ND=',I5)
-+SELF.
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, MQSHIFT.
- SUBROUTINE MQSHIFT
-
-C- Shift the TEXT material in division 2 (PAM) supported
-C- by the banks of control division 1 starting at LQHOLD
-C- from text division 1 to division 1
-C- Called just before reading a new PAM (or PAM instalment)
-C. started 14-oct-91
-
-C- LQHOLD is the adr of the first bank created after
-C- the last shift operation
-C- it decribes the trailing lines in text division 2
-C- to be maintained in division 2, if non-zero
-
-+CDE, QBANKS, QUNIT.
-+CDE, MQCM, QSYSBITS, KQADR, Q, MQCN.
-C-------------- End CDE --------------------------------
-+SELF, IF=XSHIFT.
- DIMENSION JTXSTA(5), JTXEND(5)
-+SELF.
-
-+SEQ, Q_OR.
-
-
-+SELF, IF=QDEBUG, IF=XWITHME.
- NQUSED = NQUSED + 2
- WRITE (IQPRNT,9801)
- 9801 FORMAT (/' *** Debug: MQSHIFT operates')
-+SELF, IF=XSHIFT.
- WRITE (IQPRNT,9802) LQCSTA,LQCEND, LQLSTA, LQLEND
- 9802 FORMAT (/' LQCSTA(1-3) =',3I8/' LQCEND(1-3) =',3I8/
- F /' LQLSTA(1-5) =',5I8/' LQLEND(1-5) =',5I8)
-
- DO 17 J=1,5
- JTXSTA(J) = MLIAD(LQLSTA(J))
- 17 JTXEND(J) = MLIAD(LQLEND(J))
-
- WRITE (IQPRNT,9803) JTXSTA, JTXEND
- 9803 FORMAT ( ' JTXSTA(1-5) =',5I8/' JTXEND(1-5) =',5I8)
-+SELF.
-
-C---- Remove dead material if any
-
- IF (LQGARB.NE.0) CALL MQGARB
-
-C---- Shift new text material from text division 2 to 1
-
-C-- is the HOLD bank the last bank in division 1 ?
-C- in which case there is no new text material
-
- CALL QNAME (LQHOLD)
- IF (IQLNX.EQ.LQCEND(1)) THEN
- IF (IQ(LQHOLD+2).EQ.0) THEN
- JSLTO = LQLEND(1)
- GO TO 41
- ENDIF
- ENDIF
-
-C-- create the new HOLD bank
-
- LSAVE = LQHOLD
- CALL MQLIFT (LQHOLD,0,7,JBKHOL,1)
-
- IQ(LQHOLD+1) = IQ(LSAVE+1)
- IQ(LQHOLD+2) = IQ(LSAVE+2)
- IQ(LQHOLD+3) = IQ(LSAVE+3)
-
- IQ(LSAVE+1) = 0
- IQ(LSAVE+2) = 0
-
-+SEQ, QEJECT.
-C---- Create the linear structure of GARB banks
-
- LQCEND(2) = LQCSTA(2)
- LQPREP = 0
- KJOIN = KQPREP
-
- CALL QNAME (LSAVE)
- LQ(IQLNA) = IOR (LQ(IQLNA),KMDROP)
- LNX = IQLNX
-
-C-- do the next bank, does it have lines attached?
-
- 22 IF (LNX.GE.LQCEND(1)) GO TO 31
- CALL QBLOW (LNX)
- LNX = IQLNX
- LST = IQLST
- 24 IF (IQLI.EQ.0) GO TO 22
- JSLFR = IQ(LST+1)
- IF (JSLFR.LT.LQLSTA(2)) GO TO 22
- IF (JSLFR.GE.LQLEND(2)) GO TO 22
- NSL = IQ(LST+2)
- IF (NSL.EQ.0) THEN
- IQ(LST+1) = 0
- GO TO 22
- ENDIF
-
- CALL MQLIFT (LP,KJOIN,0,JBKGAR,2)
- KJOIN = LP - 1
- IQ(LP+1) = JSLFR
- IQ(LP+2) = LST
- GO TO 22
-
-C---- Copy the material
-
- 31 JSLTO = LQLEND(1)
- JTXTO = MLIAD(JSLTO)
- IF (LQPREP.EQ.0) GO TO 41
-
- CALL QSORTI (1,KQPREP)
-
- LP = KQPREP + 1
- 32 LP = LQ(LP-1)
- IF (LP.EQ.0) GO TO 41
- LST = IQ(LP+2)
- JSLFR = IQ(LST+1)
- NSL = IQ(LST+2)
-+SELF, IF=XSHIFT.
- CALL DUMPSL (JSLFR,NSL,'about to be shifted')
-+SELF.
-
- IQ(LST+1) = JSLTO
-
- JTXFR = MLIAD(JSLFR)
- NTX = MLIAD(JSLFR+NSL) - JTXFR
- NTXRE = JTXTO - JTXFR
-
- DO 34 J=1,NSL
- 34 MLIAD(JSLTO+J) = MLIAD(JSLFR+J) + NTXRE
-
- CALL CCOPYL (TEXT(JTXFR),TEXT(JTXTO),NTX)
-+SELF, IF=XSHIFT.
- CALL DUMPSL (JSLTO,NSL,'having been shifted')
-+SELF.
- JTXTO = JTXTO + NTX
- JSLTO = JSLTO + NSL
- GO TO 32
-
-C-- reset end of TEXT division 1 and division 2
-
- 41 IF (IQ(LQHOLD+2).EQ.0) THEN
- LQLEND(1) = JSLTO
- LQLSTA(2) = JSLTO
- LQLEND(2) = JSLTO
- IQ(LQHOLD+1) = JSLTO
- ELSE
- LQLEND(1) = IQ(LQHOLD+1)
- LQLSTA(2) = LQLEND(1)
- LQLEND(2) = LQLSTA(2) + IQ(LQHOLD+2)
- ENDIF
- LQLSTA(3) = LQLEND(2)
- LQLEND(3) = LQLSTA(3)
- LQCEND(2) = LQCSTA(2)
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, MQGARB.
- SUBROUTINE MQGARB
-
-C- Garbage collector - control routine
-C. started 8-oct-91
-
-+CDE, QUNIT, MQCM, MQCT.
-+CDE, QSH.
-C-------------- End CDE --------------------------------
- PARAMETER (KQGARB=1)
-
-
-+SELF, IF=QDEBUG, IF=XWITHME.
- NQUSED = NQUSED + 1
- WRITE (IQPRNT,9801)
- 9801 FORMAT (' *** Debug: garbage collection operates')
-+SELF.
-
- CALL VZERO (NQRESV,3)
-
- IF (LQGARB.EQ.0) GO TO 41
- 24 CALL MQKILL
- IF (LQGARB.EQ.0) GO TO 27
-
-C---- Collect Text garbage
-
- CALL QSORTI (1,KQGARB)
-+SELF, IF=XDEBUG, IF=XMQGARB.
- CALL DDLINS ('Garbage d/s in MQGARB', LQGARB)
-+SELF.
- CALL MQLTAB
-+SELF, IF=XDEBUG, IF=XMQGARB.
- CALL DUMPTB ('after CALL MQLTAB')
-+SELF.
- CALL MQLREL
- CALL MQLMOV
-
-C---- Collect Control garbage
-
- 27 CALL MQTABL
- IF (NQFREE(1).EQ.0) GO TO 41
- CALL MQRELC
- CALL MQMOVE
- IF (LQGARB.NE.0) GO TO 24
- IF (IQPART.NE.0) GO TO 27
-
-C---- Everbody happy?
-
- 41 IF (NQRESV(1).LT.0) GO TO 71
- IF (NQRESV(2).LT.0) GO TO 71
- IF (NQRESV(3).LT.0) GO TO 71
- RETURN
-
-C--- Not enough space
-
- 71 IQUEST(1) = 99
- IQUEST(2) = NQRESV(1)
- IQUEST(3) = NQRESV(2)
- IQUEST(4) = NQRESV(3)
- CALL P_KILL ('MQGARB, no space.')
- END
-+SEQ, QCARDL. =====================================================
-+DECK, MQGETT.
- SUBROUTINE MQGETT
-
-C- Garbage collector - find biggest space for the relocation table
-C. started 8-oct-91
-
-+CDE, MQCM, MQCT.
-+CDE, Q.
-C-------------- End CDE --------------------------------
-
-
-C-- control division 2 empty
-
- LQTA = LQCEND(1)
- IF (LQCSTA(2).EQ.LQCEND(2)) THEN
- NWAV = LQCSTA(3) - LQTA
- GO TO 21
- ENDIF
-
-C-- control division 1/2
-
- NWAV = LQCSTA(2) - LQTA
-
-C-- control division 2/3
-
- IF (NWAV.LT.LQCSTA(3)-LQCEND(2)) THEN
- LQTA = LQCEND(2)
- NWAV = LQCSTA(3) - LQTA
- ENDIF
-
-C-- text division 2/3
-
- 21 IF (NWAV+8.LT.LQLSTA(4)-LQLEND(2)) THEN
- LQTA = LQLEND(2) + 2
- NWAV = LQLSTA(4) - LQTA - 2
- LQTA = LQTA + NQOFFS
- ENDIF
-
- LQTE = LQTA + NWAV
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, MQTABL.
- SUBROUTINE MQTABL
-
-C- Garbage collector - relocation table building
-C- only banks in division 1 can be collected
-C. started 8-oct-91
-
-+CDE, MQCM, MQCT, MQCN.
-+CDE, QSH.
-C-------------- End CDE --------------------------------
- EQUIVALENCE (LS,IQLST)
- PARAMETER (IQTVAL=0)
-
-+SEQ, Q_SHIFTR.
-
-C---- Decide where to put the table
-
- CALL MQGETT
- LIMIT = LQTE - 8
- LQTB = LQTA + 3
- LQTE = LQTA
-
- NWFREE = 0
- IQPART = 0
- MODE = IQTVAL
- LQ(LQTA) = LQCSTA(1)
-
- LN = LQCSTA(1)
- LSTOP = LQCEND(1)
- GO TO 24
-
-C------ Next bank
-
- 21 MODE = NEW
- 22 LN = IQLNX
- 24 IF (LN.GE.LSTOP) GO TO 39
- CALL QBLOW (LN)
- NEW = ISHFTR (IQ(LN),30)
- IF (NEW.EQ.MODE) GO TO 22
- IF (NEW.EQ.IQTVAL) GO TO 36
-
-C-- start of a dead group
- LQ(LQTE+1) = LN
- LQTE = LQTE + 3
- GO TO 21
-
-C-- start of a live group
- 36 LQ(LQTE) = LN
- IF (LQTE.LT.LIMIT) GO TO 21
- MODE = IQTVAL
- IQPART = 1
-
-C------ End of table,
-C-- compute relocation constants
-
- 39 IF (MODE.EQ.IQTVAL) THEN
- LQ(LQTE+1) = LQCEND(1)
- LQTE = LQTE + 3
- ENDIF
- LQ(LQTE) = LQCEND(1)
-
- DO 44 JTB=LQTB,LQTE,3
- NWFREE = NWFREE + LQ(JTB) - LQ(JTB-2)
- 44 LQ(JTB+2) = -NWFREE
-
- LQ(LQTA+2) = 3
- NQRESV(1) = NQRESV(1) + NWFREE
- NQFREE(1) = NWFREE
- LQMTB = LQTB
- LQMTE = LQTE
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, MQRELC.
- SUBROUTINE MQRELC
-
-C- Garbage collector - Relocator
-C- only links in banks in divisions 1 and 3 need relocation
-C. started 8-oct-91
-
-+CDE, MQCM, MQCT, MQCN.
-+CDE, QSH.
-C-------------- End CDE --------------------------------
- EQUIVALENCE (LS,IQLST)
-
-
- LKEEP = LQ(LQTB-2)
- LFIX = LQ(LQTE)
- NENTR = (LQTE-LQTB) / 3
- JDIV = 1
- GO TO 15
-
-C-------------- Trigger control
-
-C-- What next ?
- 12 IF (LN.EQ.0) GO TO 17
- IF (JDIV.EQ.3) RETURN
- JDIV = 3
- LN = LQCSTA(JDIV)
- LDEAD = LQCEND(JDIV)
- LSTOP = LDEAD
- IF (LN.EQ.LSTOP) GO TO 12
- IF (NENTR) 53,43,23
-
-C-- Trigger structural permanent links
- 15 L1 = 0
- L2 = 0
- LN = 0
- LSTOP= 0
- LS = NQSYSS + 1
- GO TO 19
-
-C-- Trigger working space links and division 1
- 17 LS = NQLINK + 1
- L2 = LS
- LMTB = LQMTB-3
- LN = LQ(LMTB)
- LDEAD= LQ(LMTB+1)
- LSTOP= LQCEND(1)
- 19 IF (NENTR) 54,44,24
-
-C-------------- 2 or more relocation intervals -------------
-
-C------ Next bank, check if dead group
-
- 21 IF (LN.EQ.LSTOP) GO TO 12
- IF (LN.NE.LDEAD) GO TO 23
- LMTB = LMTB + 3
- LN = LQ(LMTB)
- LDEAD= LQ(LMTB+1)
- GO TO 21
-
-C-- Next bank, alive
-
- 23 CALL QBLOW (LN)
- L2 = LS - IQNS
- L1 = LN
- LN = IQLNX
-
-C---- Next link
-
- 24 L1 = L1 + 1
- IF (L1.EQ.LS) GO TO 21
- 25 LINK = LQ(L1)
- IF (LINK.GE.LFIX) GO TO 24
- IF (LINK.LT.LKEEP) GO TO 24
-
- IF (LINK.LT.LQ(LQTB)) GO TO 31
- JLOW = 0
- JHI = NENTR + 1
-
-C-- Binary search in relocator table
-
- 27 JEX = (JHI+JLOW) / 2
- IF (JEX.EQ.JLOW) GO TO 29
- IF (LINK.GE.LQ(LQTB+3*JEX)) GO TO 28
- JHI = JEX
- GO TO 27
-
- 28 JLOW = JEX
- GO TO 27
-
- 29 JTB = LQTB + 3*JLOW
- IF (LINK.GE.LQ(JTB+1)) GO TO 31
- LQ(L1) = LINK + LQ(JTB+2)
- GO TO 24
-
-C-- Bridging for dead, structural link
- 31 IF (L1.LT.L2) GO TO 38
- LQ(L1)= LQ(LINK-1)
- GO TO 25
-
- 38 LQ(L1)= 0
- GO TO 24
-
-C-------------- 1 relocation interval only -------------
-
-C------ Next bank, check if dead group
-
- 41 IF (LN.EQ.LSTOP) GO TO 12
- IF (LN.NE.LDEAD) GO TO 43
- LMTB = LMTB + 3
- LN = LQ(LMTB)
- LDEAD= LQ(LMTB+1)
- GO TO 41
-
-C-- Next bank, alive
-
- 43 CALL QBLOW (LN)
- L2 = LS - IQNS
- L1 = LN
- LN = IQLNX
-
-C---- Next link
-
- 44 L1 = L1 + 1
- IF (L1.EQ.LS) GO TO 41
- 45 LINK = LQ(L1)
- IF (LINK.GE.LFIX) GO TO 44
- IF (LINK.LT.LKEEP) GO TO 44
-
- IF (LINK.LT.LQ(LQTB)) GO TO 47
- IF (LINK.GE.LQ(LQTB+1)) GO TO 47
- LQ(L1) = LINK + LQ(LQTB+2)
- GO TO 44
-
-C-- Bridging for dead, structural link
- 47 IF (L1.LT.L2) GO TO 48
- LQ(L1)= LQ(LINK-1)
- GO TO 45
-
- 48 LQ(L1)= 0
- GO TO 44
-
-C-------------- No relocation interval ----------------
-
-C------ Next bank, check if dead group
-
- 51 IF (LN.EQ.LSTOP) GO TO 12
- IF (LN.NE.LDEAD) GO TO 53
- LMTB = LMTB + 3
- LN = LQ(LMTB)
- LDEAD= LQ(LMTB+1)
- GO TO 51
-
-C-- Next bank, alive
-
- 53 CALL QBLOW (LN)
- L2 = LS - IQNS
- L1 = LN
- LN = IQLNX
-
-C---- Next link
-
- 54 L1 = L1 + 1
- IF (L1.EQ.LS) GO TO 51
- 55 LINK= LQ(L1)
- IF (LINK.GE.LFIX) GO TO 54
- IF (LINK.LT.LKEEP) GO TO 54
- IF (L1.LT.L2) GO TO 58
-
-C-- Bridging for dead, structural link
- 57 LINK = LQ(LINK-1)
- IF (LINK.GE.LFIX) GO TO 59
- IF (LINK.LT.LKEEP) GO TO 59
- GO TO 57
-
- 58 LQ(L1)= 0
- GO TO 54
-
- 59 LQ(L1)= LINK
- GO TO 54
- END
-+SEQ, QCARDL. =====================================================
-+DECK, MQMOVE.
- SUBROUTINE MQMOVE
-
-C- Garbage collector - memory move
-C. started 8-oct-91
-
-+CDE, MQCM, MQCT.
-+CDE, QSH.
-C-------------- End CDE --------------------------------
- PARAMETER (NSTEP=3)
-
-
-C---- MOVE LOW BANKS
-
- IF (LQMTB.EQ.LQMTE) THEN
- LQCEND(1) = LQ(LQMTE-2)
- RETURN
- ENDIF
-
- LQCEND(1) = LQ(LQMTE-2) + LQ(LQMTE-1)
- JTB = LQMTB
- JEND = LQMTE
-
- 41 LOLD = LQ(JTB)
- LNEW = LQ(JTB+2) + LOLD
- N = LQ(JTB+1) - LOLD
- CALL UCOPY (LQ(LOLD),LQ(LNEW),N)
- JTB = JTB + NSTEP
- IF (JTB.NE.JEND) GO TO 41
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, MQKILL.
- SUBROUTINE MQKILL
-
-C- Turn the garbage d/s into a flat linear structure
-C- mark banks in division 1 to be dead
-C- keep in the structure only banks in division 1 with line-numbers
-C. started 8-oct-91
-
-+CDE, MQCM, MQCN, QSYSBITS, QSH.
-C-------------- End CDE --------------------------------
- PARAMETER (KQGARB=1)
-
-+SEQ, Q_OR.
-
-
- KCUR = KQGARB
- 21 LCUR = LQ(KCUR)
- IF (LCUR.EQ.0) RETURN
- IF (LCUR.GE.LQCEND(1)) GO TO 49
-
- CALL QNAME (LCUR)
- LQ(IQLNA) = IOR (LQ(IQLNA),KMDROP)
- IF (IQNS.LT.2) GO TO 41
-
-C---- Bank with structural links reached
-
- KUSE = LCUR - IQNS -1
-
-C-- Look at next link
-
- 24 KUSE = KUSE + 1
- IF (KUSE.EQ.LCUR-1) GO TO 41
- LNEW = LQ(KUSE)
- IF (LNEW.EQ.0) GO TO 24
- IF (LNEW.GE.LQCEND(1)) THEN
- LQ(KUSE) = 0
- GO TO 24
- ENDIF
-
-C-- Shunt the linear structure at KUSE to LCUR-1
-
- CALL QSHLIN (KUSE,LCUR-1)
- GO TO 24
-
-C---- Keep current bank connected only if with line-number
-
- 41 IF (IQLI.EQ.0) GO TO 49
- IF (IQ(LCUR+1).EQ.0) GO TO 49
- IF (IQ(LCUR+1).GE.LQLSTA(2)) GO TO 49
- IF (IQ(LCUR+2).EQ.0) GO TO 49
- KCUR = LCUR - 1
- GO TO 21
-
-C-- bridge unwanted bank
-
- 49 LQ(KCUR) = LQ(LCUR-1)
- GO TO 21
- END
-+SEQ, QCARDL. =====================================================
-+DECK, MQLTAB.
- SUBROUTINE MQLTAB
-
-C- Garbage collector - relocation table building, line slot numbers
-C- run through all banks of the linear garbage structure, which
-C- at this point contains only banks with text pointers
-C. started 8-oct-91
-
-+CDE, QUNIT, MQCM, MQCT, MQCN.
-+CDE, QSYSBITS, QSH.
-C-------------- End CDE --------------------------------
-
-+SEQ, Q_AND, Q_NOT.
-
-
-C---- Decide where to put the table
-
- CALL MQGETT
- LIMIT = LQTE - 8
- LQTB = LQTA + 3
- LQTE = LQTA
-
- NLFREE = 0
-
- JSLL = 1
- LNX = LQGARB
-
-C------ Do all banks
-
- 22 LS = LNX
- IF (LS.EQ.0) GO TO 37
- LNX = LQ(LS-1)
- JSLA = IQ(LS+1)
- JSLE = JSLA + IQ(LS+2)
- IF (JSLA.LE.JSLL) THEN
- JSLL = JSLE
- GO TO 22
- ENDIF
-
-C-- start of new dead region
-
- IF (LQTE.GE.LIMIT) GO TO 31
- LQ(LQTE) = JSLL
- LQ(LQTE+1) = JSLA
- JSLL = JSLE
- LQTE = LQTE + 3
- GO TO 22
-
-C------ End of table
-
-C-- Not enough table space, partial collection
-
- 31 LQGARB = LS
-+SELF, IF=QDIAG.
- WRITE (IQPRNT,9801)
- 9801 FORMAT (' *** Debug: partial collection with MQLTAB')
-+SELF.
-
- 34 CALL QNAME (LS)
- LQ(IQLNA) = IAND (LQ(IQLNA), NOT(KMDROP))
- LS = LQ(LS-1)
- IF (LS.NE.0) GO TO 34
- LS = LQGARB
-
-C-- Normal end
-
- 37 LQGARB = LS
- LQ(LQTE) = JSLL
- IF (JSLL.NE.LQLEND(1)) THEN
- LQ(LQTE+1) = LQLEND(1)
- LQTE = LQTE + 3
- LQ(LQTE) = LQLEND(1)
- ENDIF
- LQ(LQTA+2) = 0
- LQ(LQTE+1) = 0
-
-C-- compute relocation constants
-
- DO 44 JTB=LQTB,LQTE,3
- NLFREE = NLFREE + LQ(JTB) - LQ(JTB-2)
- 44 LQ(JTB+2) = -NLFREE
-
- NQRESV(2) = NQRESV(2) + NLFREE
- NQFREE(2) = NLFREE
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, MQLREL.
- SUBROUTINE MQLREL
-
-C- Garbage collector - Relocator, line slot numbers
-C. started 8-oct-91
-
-+CDE, MQCM, MQCT, MQCN.
-+CDE, QSH.
-C-------------- End CDE --------------------------------
- EQUIVALENCE (LS,IQLST)
-
-
- LKEEP = LQ(LQTB-2)
- LFIX = LQ(LQTE)
- NENTR = (LQTE-LQTB) / 3
- JDIV = 0
-
-C---- Do next division
-
- 12 IF (JDIV.EQ.1) RETURN
- JDIV = JDIV + 1
- LN = LQCSTA(JDIV)
- LSTOP = LQCEND(JDIV)
- IF (NENTR) 51,41,21
-
-C-------------- 2 or more relocation intervals -------------
-
-C-- Next bank
-
- 21 IF (LN.EQ.LSTOP) GO TO 12
- CALL QBLOW (LN)
- LN = IQLNX
- IF (IQLI.EQ.0) GO TO 21
-
- JSL = IQ(LS+1)
- IF (JSL.GE.LFIX) GO TO 21
- IF (JSL.LT.LKEEP) GO TO 21
-
- IF (JSL.LT.LQ(LQTB)) GO TO 38
- JLOW = 0
- JHI = NENTR + 1
-
-C-- Binary search in relocator table
-
- 27 JEX = (JHI+JLOW) / 2
- IF (JEX.EQ.JLOW) GO TO 29
- IF (JSL.GE.LQ(LQTB+3*JEX)) GO TO 28
- JHI = JEX
- GO TO 27
-
- 28 JLOW = JEX
- GO TO 27
-
- 29 JTB = LQTB + 3*JLOW
- IF (JSL.GE.LQ(JTB+1)) GO TO 38
- IQ(LS+1) = JSL + LQ(JTB+2)
- GO TO 21
-
- 38 IQ(LS+1) = 0
- GO TO 21
-
-C-------------- 1 relocation interval only -------------
-
-C-- Next bank
-
- 41 IF (LN.EQ.LSTOP) GO TO 12
- CALL QBLOW (LN)
- LN = IQLNX
- IF (IQLI.EQ.0) GO TO 41
-
- JSL = IQ(LS+1)
- IF (JSL.GE.LFIX) GO TO 41
- IF (JSL.LT.LKEEP) GO TO 41
-
- IF (JSL.LT.LQ(LQTB)) GO TO 48
- IF (JSL.GE.LQ(LQTB+1)) GO TO 48
- IQ(LS+1) = JSL + LQ(LQTB+2)
- GO TO 41
-
- 48 IQ(LS+1) = 0
- GO TO 41
-
-C-------------- No relocation interval ----------------
-
-C-- Next bank
-
- 51 IF (LN.EQ.LSTOP) GO TO 12
- CALL QBLOW (LN)
- LN = IQLNX
- IF (IQLI.EQ.0) GO TO 51
-
- JSL = IQ(LS+1)
- IF (JSL.GE.LFIX) GO TO 51
- IF (JSL.LT.LKEEP) GO TO 51
- IQ(LS+1) = 0
- GO TO 51
- END
-+SEQ, QCARDL. =====================================================
-+DECK, MQLMOV.
- SUBROUTINE MQLMOV
-
-C- Garbage collector - memory move, line slot numbers + text
-C. started 8-oct-91
-
-+CDE, MQCM, MQCT.
-+CDE, Q.
-C-------------- End CDE --------------------------------
- PARAMETER (NSTEP=3)
-
-
- IF (LQTB.EQ.LQTE) THEN
- LQLEND(1) = LQ(LQTE-2)
- RETURN
- ENDIF
-
- JSLTO = LQ(LQTB-2)
- JTXTO = MLIAD(JSLTO)
- JTB = LQTB
-
- 41 JSLFR = LQ(JTB)
- NLI = LQ(JTB+1) - JSLFR
-+SELF, IF=QDEBUG.
- IF (JSLTO.NE.JSLFR+LQ(JTB+2)) CALL P_CRASH ('MQLMOV mismatch')
-+SELF.
-
- JTXFR = MLIAD(JSLFR)
- NTX = MLIAD(JSLFR+NLI) - JTXFR
-
- NTXRE = JTXTO - JTXFR
-
- DO 44 J=1,NLI
- 44 MLIAD(JSLTO+J) = MLIAD(JSLFR+J) + NTXRE
-
- CALL CCOPYL (TEXT(JTXFR),TEXT(JTXTO),NTX)
- JTXTO = JTXTO + NTX
- JSLTO = JSLTO + NLI
-
- JTB = JTB + NSTEP
- IF (JTB.NE.LQTE) GO TO 41
-
- NTFREE = MLIAD(LQLEND(1)) - JTXTO
- LQLEND(1) = JSLTO
- NQRESV(3) = NQRESV(3) + NTFREE
- NQFREE(3) = NTFREE
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+PATCH, QUTIL. Hydra utility routines
-+DECK, IQLOCF.
- FUNCTION IQLOCF (VAR)
-
-C- Return the address of VAR in LQ
-
-+CDE, MQCM, QSH.
-C-------------- End CDE --------------------------------
- DIMENSION VAR(9)
-
-
- IQLOCF = LOCF(VAR(1)) - LQADR0
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, KQLAST, T=JOIN.
- FUNCTION KQLAST (KGO)
-
-C-- Find the end of a linear structure attached to LQ(KGO)
-
-+CDE, QSH.
-C-------------- End CDE --------------------------------
-
-
- L = KGO + 1
- 24 K = L-1
- L = LQ(K)
- IF (L.NE.0) GO TO 24
- KQLAST= K
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, KQFIND, T=JOIN.
- FUNCTION KQFIND (IT,JWORD,KGO,KFOUND)
-
-C- Find first bank containing IT in word JWORD
-C- search linear structure attached at LQ(KGO)
-C- return its bank-adr as value, its K-adr in KFOUND
-C- if not found: KQFIND=0, KFOUND = L-1 of last bank
-
-+CDE, QSH.
-C-------------- End CDE --------------------------------
-
-
- JW = JWORD
- L = KGO + 1
- 24 K = L-1
- L = LQ(K)
- IF (L.EQ.0) GO TO 29
- IF (IQ(L+JW).NE.IT) GO TO 24
-
- 29 KFOUND = K
- KQFIND = L
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, LQFIND.
- FUNCTION LQFIND (IT,JWORD,LGO)
-
-C- Find first bank containing IT in word JWORD
-C- in the linear structure supported by LGO;
-C- return its bank-adr as value, if not found: LQFIND=0
-
-+CDE, QSH.
-C-------------- End CDE --------------------------------
-
-
- JW = JWORD
- L = LGO
- 24 IF (L.EQ.0) GO TO 29
- IF (IQ(L+JW).EQ.IT) GO TO 29
- L = LQ(L-1)
- GO TO 24
-
- 29 LQFIND = L
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, LQSTEP, T=JOIN.
- FUNCTION LQSTEP (LBK,NSTEP)
-
-C- Step LBK by NSTEP steps through the linear structure
-C. started 17-june-94
-
-+CDE, QSH.
-C-------------- End CDE --------------------------------
-
-
- N = NSTEP
- L = LBK
- 24 IF (N.LE.0) GO TO 29
- N = N - 1
- IF (L.EQ.0) CALL P_KILL ('LQSTEP is in trouble')
- L = LQ(L-1)
- GO TO 24
-
- 29 LQSTEP = L
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, NQCOUNT, T=JOIN.
- FUNCTION NQCOUNT (LGO)
-
-C- Count the number of banks in the linear structure
-
-+CDE, QSH.
-C-------------- End CDE --------------------------------
-
-
- N = 0
- L = LGO
- 24 IF (L.NE.0) THEN
- N = N + 1
- L = LQ(L-1)
- GO TO 24
- ENDIF
-
- NQCOUNT = N
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, QSHUNT.
- SUBROUTINE QSHUNT (KOLD,KNEW)
-
-C- Shunt the single bank at KOLD connecting it to KNEW
-
-+CDE, QSH.
-C-------------- End CDE --------------------------------
-
-
- IF (KOLD.EQ.KNEW) RETURN
- L = LQ(KOLD)
- IF (L.EQ.0) RETURN
-
- LQ(KOLD) = LQ(L-1)
- LQ(L-1) = LQ(KNEW)
- LQ(KNEW) = L
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, QSHLIN, T=JOIN.
- SUBROUTINE QSHLIN (KOLD,KNEW)
-
-C- Disconnect the linear stucture from KOLD and insert it at KNEW
-
-+CDE, QSH.
-C-------------- End CDE --------------------------------
-
-
- IF (KOLD.EQ.KNEW) RETURN
- LGO = LQ(KOLD)
- IF (LGO.EQ.0) RETURN
- LSV = LQ(KNEW)
- LNX = LGO
- 24 LL = LNX
- LNX = LQ(LL-1)
- IF (LNX.NE.0) GO TO 24
-
- LQ(KOLD) = 0
- LQ(KNEW) = LGO
- LQ(LL-1) = LSV
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, QTOPSY, T=JOIN.
- SUBROUTINE QTOPSY (KGO)
-
-C- Invert order of banks in a linear stucture
-
-+CDE, QSH.
-C-------------- End CDE --------------------------------
-
- LN = LQ(KGO)
- L = 0
- 11 IF (LN.EQ.0) GO TO 21
- LL = L
- L = LN
- LN = LQ(L-1)
- LQ(L-1) = LL
- GO TO 11
-
- 21 LQ(KGO) = L
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, QSORTI.
- SUBROUTINE QSORTI (JWORD,KGO)
-
-C- Sort banks at KGO for words IQ(L+JWORD) to be in increasing order
-
-+CDE, QSH.
-C-------------- End CDE --------------------------------
-
- LL = LQ(KGO)
- IF (LL.EQ.0) RETURN
- JW = JWORD
-
- 11 LN = LQ(LL-1)
- IF (LN.EQ.0) RETURN
- IF (IQ(LN+JW).LT.IQ(LL+JW)) GO TO 21
- LL = LN
- GO TO 11
-
-C-- BANK LN OUT OF SEQUENCE
-
- 21 LQ(LL-1)= LQ(LN-1)
- K = KGO
-
- 24 L = LQ(K)
- IF (IQ(LN+JW).LT.IQ(L+JW)) GO TO 29
- K = L-1
- GO TO 24
-
-C-- PLACE FOR BANK LN FOUND
-
- 29 LQ(LN-1)= L
- LQ(K) = LN
- GO TO 11
- END
-+SEQ, QCARDL. =====================================================
-+DECK, QSORTN, T=JOIN.
- SUBROUTINE QSORTN (JWORD,KGO)
-
-C- Sort banks at KGO for the names pointed to
-C- by words IQ(L+JWORD) to be in increasing order
-
-+CDE, QSH.
-C-------------- End CDE --------------------------------
-
- LL = LQ(KGO)
- IF (LL.EQ.0) RETURN
- JW = JWORD
-
- 11 LN = LQ(LL-1)
- IF (LN.EQ.0) RETURN
- IF (NA_DIF(IQ(LN+JW),IQ(LL+JW)).LT.0) GO TO 21
- LL = LN
- GO TO 11
-
-C-- BANK LN OUT OF SEQUENCE
-
- 21 LQ(LL-1)= LQ(LN-1)
- K = KGO
-
- 24 L = LQ(K)
- IF (NA_DIF(IQ(LN+JW),IQ(L+JW)).LT.0) GO TO 29
- K = L-1
- GO TO 24
-
-C-- PLACE FOR BANK LN FOUND
-
- 29 LQ(LN-1)= L
- LQ(K) = LN
- GO TO 11
- END
-+SEQ, QCARDL. =====================================================
-+DECK, QLUMP.
- SUBROUTINE QLUMP
-
-C- Compact the NAME parameters in /MQCL/ into the name-word
-C- of the bank starting at NQLST
-
-+CDE, MQCL.
-+CDE, QSH.
-C-------------- End CDE --------------------------------
-
-+SEQ, Q_SHIFTL.
-
-
- NACC = NQND
- NACC = ISHFTL(NACC,6) + NQNS
- NACC = ISHFTL(NACC,6) + NQNL
- NACC = ISHFTL(NACC,1) + NQLI
- NACC = ISHFTL(NACC,6) + NQTY
-
- LQ(NQLNA) = NACC
- IQ(NQLST) = ISHFTL(NQNL,26)
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, QBLOW, T=JOIN.
- SUBROUTINE QBLOW (LN)
-
-C- Blow the name of the bank at LN, name-word adr
-
-+CDE, QBANKS, MQCM, MQCN, QSH.
-C-------------- End CDE --------------------------------
-
-+SEQ, Q_AND, Q_SHIFTR.
-
-
- IQLNA = LN
-
- M = LQ(IQLNA)
- IQTY= IAND (M,63)
- M = ISHFTR(M,6)
- IQLI= IAND (M,1)
- M = ISHFTR(M,1)
- IQNL= IAND (M,63)
- M = ISHFTR(M,6)
- IQNS= IAND (M,63)
- M = ISHFTR(M,6)
- IQND= IAND (M,2047)
-
- IQLST = IQLNA + IQNL + 1
-+SELF, IF=QDEBUG.
- NL = ISHFTR(IQ(IQLST),26)
- IF (NL.NE.IQNL) GO TO 91
- IF (IQNL.LT.IQNS) GO TO 91
- IF (IQLST+IQND.GE.NQMAX) GO TO 91
- IF (IQTY.EQ.0) GO TO 91
- IF (IQTY.GT.NBANKS) GO TO 91
- IF (IQNL+IQND.EQ.0) GO TO 91
-+SELF.
-
- IQLNX = IQLST + IQND + 1
- IQID = MMBANK(1,IQTY)
- RETURN
-+SELF, IF=QDEBUG
- 91 CALL DQCLOBB (IQLNA,0)
- RETURN
-+SELF.
- END
-+SEQ, QCARDL. =====================================================
-+DECK, QNAME.
- SUBROUTINE QNAME (LS)
-
-C- Blow the name of the bank at LS, status word adr
-
-+CDE, QBANKS, MQCM, MQCN, QSH.
-C-------------- End CDE --------------------------------
-
-+SEQ, Q_AND, Q_SHIFTR.
-
-
- IQLST = LS
-+SELF, IF=QDEBUG.
- IF (IQLST.LT.LQCSTA(1)) GO TO 91
- IF (IQLST.GE.NQMAX) GO TO 91
-+SELF.
- NL = ISHFTR(LQ(IQLST),26)
- IQLNA = IQLST - NL - 1
-
- M = LQ(IQLNA)
- IQTY= IAND (M,63)
- M = ISHFTR(M,6)
- IQLI= IAND (M,1)
- M = ISHFTR(M,1)
- IQNL= IAND (M,63)
- M = ISHFTR(M,6)
- IQNS= IAND (M,63)
- M = ISHFTR(M,6)
- IQND= IAND (M,2047)
-+SELF, IF=QDEBUG.
- IF (NL.NE.IQNL) GO TO 91
- IF (IQNL.LT.IQNS) GO TO 91
- IF (IQLST+IQND.GE.NQMAX) GO TO 91
- IF (IQTY.EQ.0) GO TO 91
- IF (IQTY.GT.NBANKS) GO TO 91
- IF (IQNL+IQND.EQ.0) GO TO 91
-+SELF.
-
- IQLNX = IQLST + IQND + 1
- IQID = MMBANK(1,IQTY)
- RETURN
-+SELF, IF=QDEBUG.
- 91 CALL DQCLOBB (0,IQLST)
- RETURN
-+SELF.
- END
-+SEQ, QCARDL. =====================================================
-+DECK, QBLOWX.
- SUBROUTINE QBLOWX (LN)
-
-C- QBLOW with legality check
-
-+CDE, QBANKS, MQCM, MQCN, QSH.
-C-------------- End CDE --------------------------------
-
-+SEQ, Q_AND, Q_SHIFTR.
-
-
- IQLNA = LN
-
- M = LQ(IQLNA)
- IQTY= IAND (M,63)
- M = ISHFTR(M,6)
- IQLI= IAND (M,1)
- M = ISHFTR(M,1)
- IQNL= IAND (M,63)
- M = ISHFTR(M,6)
- IQNS= IAND (M,63)
- M = ISHFTR(M,6)
- IQND= IAND (M,2047)
-
- IQLST = IQLNA + IQNL + 1
-
- NL = ISHFTR(IQ(IQLST),26)
- IF (NL.NE.IQNL) GO TO 91
- IF (IQNL.LT.IQNS) GO TO 91
- IF (IQLST+IQND.GE.NQMAX) GO TO 91
- IF (IQTY.EQ.0) GO TO 91
- IF (IQTY.GT.NBANKS) GO TO 91
- IF (IQNL+IQND.EQ.0) GO TO 91
- IQFOUL = 0
-
- IQLNX = IQLST + IQND + 1
- IQID = MMBANK(1,IQTY)
- RETURN
-
- 91 IQFOUL= -1
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, QNAMEX.
- SUBROUTINE QNAMEX (LS)
-
-C- QNAME with legality check
-
-+CDE, QBANKS, MQCM, MQCN, QSH.
-C-------------- End CDE --------------------------------
-
-+SEQ, Q_AND, Q_SHIFTR.
-
-
- IQLST = LS
- IF (IQLST.LT.LQCSTA(1)) GO TO 96
- IF (IQLST.GE.NQMAX) GO TO 96
- NL = ISHFTR(LQ(IQLST),26)
- IQLNA = IQLST - NL - 1
-
- M = LQ(IQLNA)
- IQTY= IAND (M,63)
- M = ISHFTR(M,6)
- IQLI= IAND (M,1)
- M = ISHFTR(M,1)
- IQNL= IAND (M,63)
- M = ISHFTR(M,6)
- IQNS= IAND (M,63)
- M = ISHFTR(M,6)
- IQND= IAND (M,2047)
-
- IF (NL.NE.IQNL) GO TO 91
- IF (IQNL.LT.IQNS) GO TO 91
- IF (IQLST+IQND.GE.NQMAX) GO TO 91
- IF (IQTY.EQ.0) GO TO 91
- IF (IQTY.GT.NBANKS) GO TO 91
- IF (IQNL+IQND.EQ.0) GO TO 91
- IQFOUL = 0
-
- IQLNX = IQLST + IQND + 1
- IQID = MMBANK(1,IQTY)
- RETURN
-
- 91 IQFOUL = -1
- RETURN
-
- 96 IQFOUL = 1
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+PATCH, YINDEX. for program Nyindex
-+DECK, NINDEX.
- PROGRAM NINDEX
-
-+SELF, IF=QDIAG, IF=QS_UNIX.
- EXTERNAL SEGVIOL
-+SELF.
-
-+SEQ, NCNAME.
- PARAMETER (NFILES=3)
- CHARACTER NAME(NFILES)*(NCNAME)
-
-
- DATA NAME/ 'PAM .car 9 2 0 !ff'
- +, 'opt 3 11 0 !ff'
- +, 'print .lis 2 4 0 !ff' /
-C- _:.=+=.:_1_:.=+=.:_2_:.=+=.:_3_:
-C- (1) (2) (3)
-
-C- (1) LUNUSE = 1 read, 2 print,
-C- 3 option, 4 cch subst, >4 file
-
-C- (2) LUNDES = 1 cradle input
-C- 2 PAM input
-C- 4 printed output
-C- 5 Fortran output
-C- 6 ASM output write-only (T=ATT)
-C- 7 ASM input-output (T=MODIF)
-C- 11 option parameter
-C- 12 control-character substitution parameter
-
-C- (3) LUNFLG = 0/>0 parameter value EOF not/yes allowed
-C- 2 the cradle file need not exist
-
-+SELF, IF=QS_IBMVM.
- NAME(3)(9:16) = '.listing'
-+SELF.
-
- CALL MQINIT
-
- CALL FLPARA (NFILES,NAME,
- + 'Nyindex Bare, ' //
- + 'Help, Ponly, Quick, Xpatch, Ydeck, Zseq, 0->4 pg size')
-
-+SELF, IF=QDIAG, IF=QS_UNIX.
- CALL SIGNALF (11, SEGVIOL, -1)
-+SELF.
- CALL EXINDEX
-
-+SEQ, PGMSTOP, T=PASS.
- END
-+SEQ, QCARDL. =====================================================
-+DECK, EXINDEX.
- SUBROUTINE EXINDEX
-
-C- Run nyindex
-C. started 12-jan-94
-
-+CDE, SLATE, SLATLN, QBITA31, QBANKS, QPAGE, QSTATE, QUNIT.
-+CDE, CM_TYP, LUNSLN.
-+CDE, KQADR, KQUSER, Q, PY.
-C-------------- End CDE --------------------------------
- CHARACTER LINE*110, LINETT*60
- EQUIVALENCE (LINE, SLLINE)
- EQUIVALENCE (LINETT, LINE(47:))
-
- PARAMETER (MASK= KMB + KMH + KMP + KMQ + KMX + KMY + KMZ)
-
- DIMENSION MMPAT(4), MMDECK(4), MMKEEP(4)
-
- DATA MMPAT / 0, 1, 1, 2 /
- DATA MMDECK / 0, 2, 1, 3 /
- DATA MMKEEP / 0, 2, 1, 1 /
-
-+SEQ, Q_AND.
-
-+SEQ, bkYINDEX, IF=DOC_INL.
-+SEQ, QEJECT.
-
- CALL INIAUX (LASTWK)
-
- CALL KROPT (IXLUN(2),MASK)
- CALL PGSIZE (0, IXLUN(2))
-
- MOPTIO(16) = MAX (MOPTIO(16), MOPTIO(17))
- IF (MOPTIO(8).NE.0) GO TO 81
-
- NQCMAX = 100
- NQCPGH = 100
-
- CALL UCOPY (MMPAT, MMBANK(2,JBKPAT), 4)
- CALL UCOPY (MMDECK, MMBANK(2,JBKDEC), 4)
- CALL UCOPY (MMKEEP, MMBANK(2,JBKKEE), 4)
-
- CALL INIPAM (11, IXLUN(1), 1,0)
-
-C------ Load the title deck to memory ------------
-
- 21 IF (JDKNEX.EQ.0) CALL ARRIVE (2)
-
-C---- Handle the PAM-file title line
-
- JDKTYP = 3
- CALL KRTITL
-
- IF (NQDKNO.GE.2) THEN
- NQDKNO = ((NQDKNO-1)/100 + 1) *100
- ELSE
- NQDKNO = 0
- ENDIF
-
-C------ Loop over all decks until next title
-
- CALL INDDECK
- IF (JDKTYP.EQ.3) GO TO 21
- CALL INIPAM (0,0, -1,0)
-
-C------- Input finished, print tables
-
- CALL QTOPSY (KQUSER)
- CALL QSORTN (2,KQUSER)
-
- KQDECK = KQUSER + 1
- CALL QTOPSY (KQDECK)
- CALL QSORTN (2,KQDECK)
- CALL QSORTN (1,KQDECK)
-
-C---- Print list of data types
-
- WRITE (IQPRNT,9025)
- NQUSED = NQUSED + 3
-
- DO 27 JASM=1,N_TYP
- LASMT = LQ(LHASM-JASM)
- NDK = IQ(LASMT+8)
- IF (NDK.EQ.0) GO TO 27
- N = LNBLNK (CH_TYP(JASM))
- WRITE (IQPRNT,9027) NDK, CH_TYP(JASM)(1:N)
- NQUSED = NQUSED + 1
- 27 CONTINUE
- NQLLBL = 0
-
-C---- Print duplicates
-
- CALL DPBLAN (0)
- LN = LQUSER(1)
- 32 LA = LN
- LN = LQ(LA-1)
- IF (LN.EQ.0) GO TO 35
- IF (IQ(LA+2).NE.IQ(LN+2)) GO TO 32
-
- IXP = IQ(LA+2)
- LINE = 'p='
- CALL NA_GET (IXP,LINE,3)
- N = NESLAT
- WRITE (IQPRNT,9032) LINE(1:N)
- NQWARN = NQWARN + 1
- NQUSED = NQUSED + 1
- NQLLBL = 0
-
- 33 LN = LQ(LN-1)
- IF (LN.EQ.0) GO TO 35
- IF (IQ(LN+2).NE.IXP) GO TO 32
- GO TO 33
-
-C-- deck names
-
- 35 CALL DPBLAN (0)
- LN = LQUSER(2)
- 36 LA = LN
- LN = LQ(LA-1)
- IF (LN.EQ.0) GO TO 41
- IF (IQ(LA+1).NE.IQ(LN+1)) GO TO 36
- IF (IQ(LA+2).NE.IQ(LN+2)) GO TO 36
-
- IXD = IQ(LA+1)
- IXP = IQ(LA+2)
- LINE = 'p='
- CALL NA_GET (IXP,LINE,3)
- N = NESLAT
- LINE(N+1:N+2) = 'd='
- N = N + 3
- CALL NA_GET (IXD,LINE,N)
- N = NESLAT
- WRITE (IQPRNT,9032) LINE(1:N)
- NQWARN = NQWARN + 1
- NQUSED = NQUSED + 1
- NQLLBL = 0
-
- 37 LN = LQ(LN-1)
- IF (LN.EQ.0) GO TO 41
- IF (IQ(LN+1).NE.IXD) GO TO 36
- IF (IQ(LN+2).NE.IXP) GO TO 36
- GO TO 37
-
-
-C----- Print index of patches
-
- 41 IF (MOPTIO(24).NE.0) GO TO 88
- NBK = NQCOUNT (LQUSER(1))
-
- NQUSED = MOD (NQUSED, NQLMAX)
-
- IF (NQUSED+NBK+4.GE.NQLMAX) THEN
- WRITE (IQPRNT,9041)
- NQUSED = 3
- ELSE
- WRITE (IQPRNT,9042)
- NQUSED = NQUSED + 3
- ENDIF
-
- LP = LQUSER(1)
- 42 IF (LP.EQ.0) GO TO 45
- NDK = IQ(LP+1)
- IXPAT = IQ(LP+2)
- IFLG = IAND (IQ(LP),KM6)
-
- LINE(1:13) = ' = '
-C- ' if 123456 = pname
-C- _:.=+=.: 1_:.=
-
- IF (NDK.LT.0) THEN
- LINE(10:13) = '- '
- ELSE
- CALL CSETDI (NDK,LINE,5,10)
- ENDIF
-
- IF (IFLG.NE.0) LINE(2:3)= 'If'
-
- CALL NA_GET (IXPAT,LINE,14)
- NN = NESLAT - 1
-
- WRITE (IQPRNT,9008) LINE(1:NN)
- NQUSED = NQUSED + 1
- LP = LQ(LP-1)
- GO TO 42
-
-C---- Print index of decks
-
- 45 IF (MOPTIO(25).NE.0) GO TO 87
- NBK = NQCOUNT (LQUSER(2))
-
- NQUSED = MOD (NQUSED, NQLMAX)
-
- IF (NQUSED+NBK+4.GE.NQLMAX) THEN
- WRITE (IQPRNT,9045)
- NQUSED = 3
- ELSE
- WRITE (IQPRNT,9046)
- NQUSED = NQUSED + 3
- ENDIF
-
- LD = LQUSER(2)
- 46 IF (LD.EQ.0) GO TO 51
- IXDEC = IQ(LD+1)
- IXPAT = IQ(LD+2)
- NDK = IQ(LD+3)
-
- LINE(1:26) = ' = .'
-C- ' 123456 = dname .pname
-C- _:.=+=.: 1_:.=+=.: 2_:.=+=.: 3_:.=+=.:
-
- CALL CSETDI (NDK,LINE,5,10)
-
- CALL NA_GET (IXDEC,LINE,14)
- NN = NESLAT
- NN = MAX (NN,26)
-
- LINE(NN:NN) = '.'
- CALL NA_GET (IXPAT,LINE,NN+1)
- NN = NESLAT - 1
-
- WRITE (IQPRNT,9008) LINE(1:NN)
- NQUSED = NQUSED + 1
- LD = LQ(LD-1)
- GO TO 46
-
-+SEQ, QEJECT.
-C---- Print index of sequence definitions
-
- 51 IF (MOPTIO(26).NE.0) GO TO 87
- CALL QTOPSY (KQKEEP)
- CALL QSORTN (1,KQKEEP)
- NBK = NQCOUNT (LQKEEP)
-
- NQUSED = MOD (NQUSED, NQLMAX)
-
- IF (NQUSED+NBK+4.GE.NQLMAX) THEN
- WRITE (IQPRNT,9051)
- NQUSED = 3
- ELSE
- WRITE (IQPRNT,9052)
- NQUSED = NQUSED + 3
- ENDIF
-
- LZ = LQKEEP
- 52 IF (LZ.EQ.0) GO TO 87
- IXSEQ = IQ(LZ+1)
- LD = LQ(LZ-2)
- IF (IAND(IQ(LZ),1).EQ.0) THEN
- IXDEC = IQ(LD+1)
- IXPAT = IQ(LD+2)
- NDK = IQ(LD+3)
- ELSE
- IXDEC = 0
- NDK = IQ(LD+1)
- IXPAT = IQ(LD+2)
- ENDIF
-
- LINE(1:41) = ' : '
-C- ' 123456 : zname d=dname .pname
-C- _:.=+=.: 1_:.=+=.: 2_:.=+=.: 3_:.=+=.: 4_:.=+=.: 5
-
- CALL CSETDI (NDK,LINE,5,10)
-
- CALL NA_GET (IXSEQ,LINE,14)
- NN = NESLAT
- NN = MAX (NN,26) + 1
-
- LINE(NN:NN+1) = 'd='
- CALL NA_GET (IXDEC,LINE,NN+2)
- NN = NESLAT
- NN = MAX (NN,41)
-
- LINE(NN:NN) = '.'
- CALL NA_GET (IXPAT,LINE,NN+1)
- NN = NESLAT - 1
-
- WRITE (IQPRNT,9008) LINE(1:NN)
- NQUSED = NQUSED + 1
- LZ = LQ(LZ-1)
- GO TO 52
-
-C---- Help
-
- 81 WRITE (IQPRNT,9081)
-
- 87 CALL PGSIZE (1, 0)
- 88 IF (NQWARN.NE.0) THEN
- WRITE (IQPRNT,9088)
- CALL EXITRC (1)
- ENDIF
- RETURN
-
- 9008 FORMAT (A)
- 9025 FORMAT (/' Table of Data types'/)
- 9027 FORMAT (4X,I6,' decks of type ',A)
- 9032 FORMAT (' **!! Warn: duplicate ',A)
- 9041 FORMAT ( '1 Index of Patches'/)
- 9042 FORMAT (/' Index of Patches'/)
- 9045 FORMAT ( '1 Index of Decks'/)
- 9046 FORMAT (/' Index of Decks'/)
- 9051 FORMAT ( '1 Index of Sequences defined'/)
- 9052 FORMAT (/' Index of Sequences defined'/)
- 9081 FORMAT ( ' nyindex pam.car options print'/
- F/' reads the "pam" file, printing on "print" a running'
- F/' table-of-content of the patches and decks encountered,'
- F/' and at the end it prints 3 sorted indices of the patches,'
- F/' decks and sequence definitions seen.'
- F/' A "duplicate" warning is given if there are two or more'
- F/' decks of the same name in the same patch.'/
- F/' "options": B bare - comment fields of P/D lines not to'
- F/' appear in the table-of-content'
- F/' H help - print this help information only'
- F/' P patch only - suppress the deck names from'
- F/' the table-of-content'
- F/' Q quick - suppress the table-of-content'
- F/' X - suppress all sorted indices'
- F/' Y - suppress the sorted indices of decks and'
- F/' sequence definitions'
- F/' Z - suppress the sorted index of sequences'
- F/' 0 ... 4 - select page size by single digit option'
- F/' "n" - set page size to be n > 19')
- 9088 FORMAT (' **!! There are warnings !!**'/)
- END
-+SEQ, QCARDL. =====================================================
-+DECK, INDDECK.
- SUBROUTINE INDDECK
-
-C- Handle all decks until next +TITLE for nyindex
-C. started 12-jan-94
-
-+CDE, SLATE, SLATLN, QBITS19, QPAGE, QUNIT.
-+CDE, CCTYPE, CCPARA, CHEXC, DEPCOM.
-+CDE, MQCM, Q, PY.
-C-------------- End CDE --------------------------------
- CHARACTER LINE*110, LINETT*60
- EQUIVALENCE (LINE, SLLINE)
- EQUIVALENCE (LINETT, LINE(47:))
-
-
-C-- set limits of control division 2
-
- 21 LQCSTA(2) = LQCEND(1) + 100
- LQCEND(2) = LQCSTA(2)
-
-C-- clear text division 3
-
- LQLSTA(3) = LQLEND(2)
- LQLEND(3) = LQLSTA(3)
-
-C---- Ready the deck parameters
-
- IXEXDEC = 0
- LEXD = 0
- IF (JDKTYP.EQ.3) GO TO 46
-
- LINE(1:68) = ' '
- LINE(43:46) = '. d='
-C- ' <<< pname nnnnnn . d=
-C- '_:.=+=.: 1_:.=+=.: 2_:.=+=.: 3_:.=+=.: 4_:.=+=.: 5_:.=+=
-C- ' nnnnnn . d=dname
-C- ' F=fname ---- nnnnnn . title
-
- JSLF = IQ(LQHOLD+1)
- IF (JDKTYP.EQ.1) GO TO 42
-
-+SEQ, QEJECT.
-C-- deck header is +PATCH, name
-
- JCCTYP = MCCPAT
- CALL CCKRAK (JSLF)
- IXEXPAT = MCCPAR(JCCPP+1)
- IF (IXEXPAT.EQ.0) IXEXPAT= 1
-
- JD_DTN = 0
- IF (JCCBAD.EQ.0) CALL CCDOPT (1, JD_DTN)
- IF (JD_DTN.EQ.0) JD_DTN= 1
- JD_DTP = JD_DTN
- LASMT = LQ(LHASM-JD_DTN)
- IQ(LASMT+8) = IQ(LASMT+8) + 1
-
- CALL INDCRP (IXEXPAT,0)
- IF (MOPTIO(17).NE.0) GO TO 48
-
- CALL NA_GET (IXEXPAT, LINE,3)
- CALL CRIGHT (LINE,3,34)
- N = 46
- IF (MOPTIO(2).NE.0) GO TO 43
- IF (NCHCCT.LE.NCHCCD) GO TO 43
- CALL CCCOMG (1)
- IF (NCHCCC.EQ.0) GO TO 43
- JP = N + 13
- N = MIN (JP+NCHCCC, 110)
- NN = N - JP
- LINE(JP+1:JP+NN) = CCCOMF(1:NN)
- GO TO 43
-
-C-- deck header is +DECK, name
-
- 42 JCCTYP = MCCDEC
- CALL CCKRAK (JSLF)
- IXEXDEC = MCCPAR(JCCPD+1)
- IF (IXEXDEC.EQ.0) IXEXDEC= 1
-
- JD_DTN = 0
- IF (JCCBAD.EQ.0) CALL CCDOPT (1, JD_DTN)
- IF (JD_DTN.EQ.0) JD_DTN= JD_DTP
- LASMT = LQ(LHASM-JD_DTN)
- IQ(LASMT+8) = IQ(LASMT+8) + 1
-
- CALL INDCRD
- IF (MOPTIO(16).NE.0) GO TO 48
-
- CALL NA_GET (IXEXDEC, LINE,47)
- N = NESLAT - 1
- IF (MOPTIO(2).NE.0) GO TO 43
- IF (NCHCCT.LE.NCHCCD) GO TO 43
- CALL CCCOMG (1)
- IF (NCHCCC.EQ.0) GO TO 43
- JP = MAX (N+1, 46+16)
- N = MIN (JP+NCHCCC, 110)
- NN = N - JP
- LINE(JP+1:JP+NN) = CCCOMF(1:NN)
-
- 43 CALL CSETDI (NQDKNO, LINE,36,41)
- WRITE (IQPRNT,9043) LINE(1:N)
- 9043 FORMAT (A)
- NQUSED = NQUSED + 1
- GO TO 48
-
-C-- deck header is +TITLE or start of PAM
-
- 46 JD_DTP = 1
- CALL INDCRP (IXEXPAT,0)
-
- LINE(1:46) = ' F= ---- . '
-C- ' F=fname ---- nnnnnn . title
-C- '_:.=+=.: 1_:.=+=.: 2_:.=+=.: 3_:.=+=.: 4_:.=+=.: 5_:.=+=
-
- JSLTTL = IQ(LARRV+10)
- CALL LN_GET (JSLTTL, LINETT, 60)
- NTTL = NDSLAT
-
- IF (IQTYPE.NE.IQPRNT) WRITE (IQTYPE,9046) LINETT(1:NTTL)
- 9046 FORMAT (' Read Pam file: ',A/)
-
- CALL CSETDI (NQDKNO, LINE,36,41)
-
- CALL NA_GET (IXEXPAM, LINE,4)
-
- N = NTTL + 46
- IF (MOPTIO(17).EQ.0) THEN
- WRITE (IQPRNT,9047) LINE(1:N)
- ELSE
- WRITE (IQPRNT,9048) LINE(1:N)
- ENDIF
- NQUSED = NQUSED + 3
- 9047 FORMAT (/A/)
- 9048 FORMAT (/A)
-
-+SEQ, QEJECT.
-C------ Process the deck
-
- 48 IF (JDKNEX.EQ.0) CALL ARRIVE (2)
- IF (MOPTIO(24).NE.0) GO TO 88
-
-C-- analyse the contents
-
- CALL DOMAPA (0)
-
-C-- process the contents
-
- CALL INDXQT
-
-C-- step to the next deck
-
- 88 CALL ARRNXD (1)
- NQDKNO = NQDKNO + 1
- IFLGAR = 0
- IF (JDKTYP.LT.3) GO TO 21
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, INDXQT.
- SUBROUTINE INDXQT
-
-C- Process the material according to the map for nyindex
-C. started 12-jan-94
-
-+CDE, CCTYPE, CCPARA.
-+CDE, KQADR, Q, PY.
-+CDE, M_ANAC.
-C-------------- End CDE --------------------------------
-
-+SEQ, Q_JBYT.
-
-
- LUPAN = 0
- LDOAN = KQPREP + 1
-
-C---- Next bank
-
- 21 LDOAN = LQ(LDOAN-1)
- IF (LDOAN.EQ.0) RETURN
-
- JCCTYP = JBYT (IQ(LDOAN),9,6)
- IF (JCCTYP.LE.MCCNIL) GO TO 21
-
-C-- Crack the c/line, register conditional patches
-
- CALL CCKRAK (IQ(LDOAN+1))
- IF (JCCBAD.NE.0) GO TO 21
-
- 24 IF (NCCPIF.EQ.0) GO TO 31
- IXCOND = MCCPAR(JCCPIF+1)
- CALL INDCRP (IXCOND,1)
- JCCPIF = JCCPIF + 3
- NCCPIF = NCCPIF - 1
- GO TO 24
-
-C-- Sequence definition, register name
-
- 31 IF (JCCTYP.NE.MCCKEE) GO TO 21
- IF (MOPTIO(26).NE.0) GO TO 21
- IXSEQ = MCCPAR(JCCPZ+1)
- CALL INDCRZ (IXSEQ)
- GO TO 21
- END
-+SEQ, QCARDL. =====================================================
-+DECK, INDCRP.
- SUBROUTINE INDCRP (IXNAME,MODE)
-
-C- Register patch name IXNAME for nyindex,
-C- MODE = 0 this is the name of the current patch just starting
-C- 1 patch name quoted in IF=
-C. started 17-jan-94
-
-+CDE, QBITS19, QBANKS, QPAGE.
-+CDE, Q, PY.
-C-------------- End CDE --------------------------------
-+SEQ, Q_OR.
-
-
- LPAT = LQFIND (IXNAME,2,LQUSER)
-
- IF (MODE.EQ.0) GO TO 21
- IF (LPAT.EQ.0) GO TO 24
- GO TO 27
-
-C-- start of patch
-
- 21 IF (LPAT.EQ.0) GO TO 24
- IF (IQ(LPAT+1).GE.0) GO TO 24
- 22 LEXP = LPAT
- IQ(LEXP+1) = NQDKNO
- RETURN
-
-C-- lift the PAT bank
-
- 24 CALL MQLIFT (LPAT, LQUSER(1),1, JBKPAT,3)
- IQ(LPAT+2) = IXNAME
- IF (MODE.EQ.0) GO TO 22
- IQ(LPAT+1) = -1
-
-C-- mark patch-name used in IF=
-
- 27 IQ(LPAT) = IOR (IQ(LPAT),KM6)
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, INDCRD.
- SUBROUTINE INDCRD
-
-C- Register current deck name for nyindex
-C. started 17-jan-94
-
-+CDE, CHEXC, QBANKS, QPAGE.
-+CDE, Q, PY.
-C-------------- End CDE --------------------------------
-
-
- CALL MQLIFT (LEXD, LQUSER(2),1, JBKDEC,3)
- IQ(LEXD+1) = IXEXDEC
- IQ(LEXD+2) = IXEXPAT
- IQ(LEXD+3) = NQDKNO
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, INDCRZ, T=JOIN.
- SUBROUTINE INDCRZ (IXNAME)
-
-C- Register sequence name IXNAME for nyindex
-C. started 17-jan-94
-
-+CDE, QBANKS.
-+CDE, Q, PY.
-C-------------- End CDE --------------------------------
-+SEQ, Q_OR.
-
-
- CALL MQLIFT (LKEE, LQKEEP,1, JBKKEE,3)
- IQ(LKEE+1) = IXNAME
- IF (LEXD.NE.0) THEN
- LQ(LKEE-2) = LEXD
- RETURN
- ENDIF
-
- LQ(LKEE-2) = LEXP
- IQ(LKEE) = IOR (IQ(LKEE),1)
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+PATCH, YLIST. for program Nylist
-+DECK, NLIST.
- PROGRAM NLIST
-
-+SELF, IF=QDIAG, IF=QS_UNIX.
- EXTERNAL SEGVIOL
-+SELF.
-
-+SEQ, NCNAME.
- PARAMETER (NFILES=3)
- CHARACTER NAME(NFILES)*(NCNAME)
-
-
- DATA NAME/ 'PAM .car 9 2 0 !ff'
- +, 'opt 3 11 0 !ff'
- +, 'print .lis 2 4 0 !ff' /
-C- _:.=+=.:_1_:.=+=.:_2_:.=+=.:_3_:
-C- (1) (2) (3)
-
-C- (1) LUNUSE = 1 read, 2 print,
-C- 3 option, 4 cch subst, >4 file
-
-C- (2) LUNDES = 1 cradle input
-C- 2 PAM input
-C- 4 printed output
-C- 5 Fortran output
-C- 6 ASM output write-only (T=ATT)
-C- 7 ASM input-output (T=MODIF)
-C- 11 option parameter
-C- 12 control-character substitution parameter
-
-C- (3) LUNFLG = 0/>0 parameter value EOF not/yes allowed
-C- 2 the cradle file need not exist
-
-+SELF, IF=QS_IBMVM.
- NAME(3)(9:16) = '.listing'
-+SELF.
-
- CALL MQINIT
-
- CALL FLPARA (NFILES,NAME,
- + 'Nylist Help, Eject, Start, 0->4 pg size')
-
-+SELF, IF=QDIAG, IF=QS_UNIX.
- CALL SIGNALF (11, SEGVIOL, -1)
-+SELF.
- CALL EXLIST
-
-+SEQ, PGMSTOP, T=PASS.
- END
-+SEQ, QCARDL. =====================================================
-+DECK, EXLIST.
- SUBROUTINE EXLIST
-
-C- Run nylist
-C. started 12-jan-94
-
-+CDE, SLATE, SLATLN, QBITA19, QPAGE, QUNIT.
-+CDE, LUNSLN.
-+CDE, Q, PY.
-C-------------- End CDE --------------------------------
- PARAMETER (MASK= KMH + KME + KMS)
-
-
- CALL INIAUX (LASTWK)
-
- CALL KROPT (IXLUN(2),MASK)
- CALL PGSIZE (0, IXLUN(2))
- IF (MOPTIO(8).NE.0) GO TO 81
-
- IF (MOPTIO(19).NE.0) THEN
- MOPTIO(19) = 0
- ELSE
- MOPTIO(3) = 1
- MOPTIO(5) = 0
- ENDIF
-
- NQCMAX = 104
- NQCPGH = 100
- NQWYLDO = 7
-
- CALL INIPAM (11, IXLUN(1), 1,0)
- NQJOIN = -1
-
-C------ Load the title deck to memory ------------
-
- 21 IF (JDKNEX.EQ.0) CALL ARRIVE (2)
-
-C---- Handle the PAM-file title line
-
- JDKTYP = 3
- CALL KRTITL
- JSLTTL = IQ(LARRV+10)
-
- IF (NQDKNO.GE.2) THEN
- NQDKNO = ((NQDKNO-1)/100 + 1) *100
- ELSE
- NQDKNO = 0
- ENDIF
-
- CALL LN_GET (JSLTTL, SLLINE, 60)
- NTXT = NDSLAT
-
- IF (IQPRNT.NE.IQTYPE) WRITE (IQTYPE,9024) SLLINE(1:NTXT)
- 9024 FORMAT (' Read Pam file: ',A/)
-
-C------ Loop over all decks until next title
-
- CALL LIDECK
- IF (JDKTYP.EQ.3) GO TO 21
- GO TO 89
-
-+SEQ, QEJECT.
-C---- Help
-
- 81 WRITE (IQPRNT,9081)
-
- 89 CALL PGSIZE (1, 0)
- RETURN
-
- 9081 FORMAT (' nylist pam.car options print'/
- F/' reads the "pam" file printing on "print" a numbered'
- F/' listing of the whole file. Line numbers both local to'
- F/' each deck and global in the file are shown. Page ejects'
- F/' can be controled with the option letters S and E, and'
- F/' also with T=JOIN given on any deck header line.'/
- F/' "options": H help - print this help information only'
- F/' E eject - honor the pseudo sequence calls'
- F/' +SEQ, QEJECT, N=n.'
- F/' S start - start each deck on a new page,'
- F/' unless T=JOIN present'
- F/' 0 ... 4 - select page size by single digit option'
- F/' "n" - set page size to be n > 19')
- END
-+SEQ, QCARDL. =====================================================
-+DECK, LIDECK.
- SUBROUTINE LIDECK
-
-C- List all decks until next +TITLE
-C. started 12-jan-94
-
-+CDE, QBITS19, QPAGE.
-+CDE, CCTYPE, CCPARA, CHEXC, MUSEBC.
-+CDE, MQCM, Q, PY.
-C-------------- End CDE --------------------------------
-
-C-- Check file starts with +PATCH or +DECK
-
- IF (JCCTYP.EQ.MCCDEC) JDKTYP= 1
- IF (JCCTYP.EQ.MCCPAT) JDKTYP= 2
-
-C-- set operation mode
-
- NVEXDK(1) = 0
- NVEXDK(2) = 1
- NVEXDK(5) = 1
- NVEXDK(6) = 1
-
-C-- set limits of control division 2
-
- 21 LQCSTA(2) = LQCEND(1) + 100
- LQCEND(2) = LQCSTA(2)
-
-C-- clear text division 3
-
- LQLSTA(3) = LQLEND(2)
- LQLEND(3) = LQLSTA(3)
-
-+SEQ, QEJECT.
-C------ Ready the deck parameters
-
- NQNEWH = 7
- IF (JDKTYP.EQ.1) GO TO 42
- IXEXDEC = 0
- IF (JDKTYP.EQ.2) GO TO 41
-
-C-- deck header is +TITLE or start of PAM
-
- CALL DPHEAD
- NQJOIN = -1
- GO TO 47
-
-C-- deck header is +PATCH, name
-
- 41 JSLF = IQ(LQHOLD+1)
- JCCTYP = MCCPAT
- CALL CCKRAK (JSLF)
- IXEXPAT = MCCPAR(JCCPP+1)
- IF (IXEXPAT.EQ.0) IXEXPAT= 1
- IXEXID = IXEXPAT
- GO TO 44
-
-C-- deck header is +DECK, name
-
- 42 JSLF = IQ(LQHOLD+1)
- JCCTYP = MCCDEC
- CALL CCKRAK (JSLF)
- IXEXDEC = MCCPAR(JCCPD+1)
- IF (IXEXDEC.EQ.0) IXEXDEC= 1
- IXEXID = IXEXDEC
-
- 44 CALL CCJOIN
-
-C------ Process the deck
-
- 47 LEXD = 0
- NSLORG = 0
-
- IF (JDKNEX.EQ.0) CALL ARRIVE (2)
-
-C-- analyse the contents
-
- CALL DOMAPA (0)
-
-C-- process the contents
-
- CALL LIXQT
-
-C-- step to the next deck
-
- 88 CALL ARRNXD (1)
- NQDKNO = NQDKNO + 1
- IFLGAR = 0
- IF (JDKTYP.LT.3) GO TO 21
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, LIXQT.
- SUBROUTINE LIXQT
-
-C- List the material according to the map
-C. started 12-jan-94
-
-+CDE, QBITS31, QUNIT, CCTYPE, CCPARA.
-+CDE, KQADR, Q, PY.
-+CDE, M_ANAC.
-C-------------- End CDE --------------------------------
-
-+SEQ, Q_JBYT, Q_OR.
-
-
- IXPL = -7
- LEVIF = 0
- LUPAN = 0
- LDOAN = KQPREP + 1
-
-C---- Next bank
-
- 20 MODEAN = 0
- LDOAN = LQ(LDOAN-1)
- 22 IF (LDOAN.EQ.0) GO TO 87
-
-+SEQ, QEJECT.
-C-- MODEAN = 0 self material
-C- 1 CDE expansion
-C- 2 comment line
-C- 3 +SELF header line
-C- 4 +CDE call line
-C- 5 foreign material
-C- 6 control line
-
- JCCTYP = JBYT (IQ(LDOAN),9,6)
- IF (JCCTYP.GE.MCCDEL) GO TO 51
-
-C---------- Self material ----------------
-
- IF (JCCTYP.EQ.0) GO TO 39
- IF (JCCTYP.EQ.MCCNIL) GO TO 38
- IF (JCCTYP.LE.MCCINC) GO TO 71
- IF (JCCTYP.LE.MCCXSQ) GO TO 36
- IF (JCCTYP.LT.MCCSEL) GO TO 32
- IXPL = -7
- IF (JCCTYP.EQ.MCCKEE) GO TO 57
-
-C-- to here +SELF, +SKIP and fault
-
- MODEAN = 3
- GO TO 39
-
-C-- to here +_IF etc
-
- 32 IF (JCCTYP.GE.MCCELS) GO TO 34
- IF (LEVIF.EQ.0) IQ(LDOAN)= IOR (IQ(LDOAN), KM17)
- LEVIF = LEVIF + 1
- GO TO 39
-
- 34 IF (JCCTYP.EQ.MCCELS) GO TO 39
- LEVIF = MAX (LEVIF-1, 0)
- IF (LEVIF.EQ.0) IQ(LDOAN)= IOR (IQ(LDOAN), KM17)
- GO TO 39
-
-C-- sequence call
-
- 36 MODEAN = 4
- CALL DPLIST (MODEAN,LDOAN,LUPAN,0)
-
- IF (MOPTIO(5).NE.0) CALL XEJECT
- GO TO 20
-
-C-- comment line
-
- 38 MODEAN = 2
- 39 CALL DPLIST (MODEAN,LDOAN,LUPAN,1)
- GO TO 20
-
-C---------- Foreign material --------------
-
- 51 IF (JCCTYP.GE.MCCUSE) GO TO 71
- CALL CCKRAK (IQ(LDOAN+1))
- IXP = MCCPAR(JCCPP+1)
- IXD = MCCPAR(JCCPD+1)
- IF (IXP.EQ.0) GO TO 52
- IF (IXP.EQ.IXPL .AND. IXD.EQ.IXDL) GO TO 56
- IXPL = IXP
- IXDL = IXD
- GO TO 57
-
-C-- implied target
-
- 52 IF (IXPL.LT.0) GO TO 57
- IF (MCCPAR(JCCPD+2).LT.0) GO TO 56
- IF (IXD.EQ.IXDL) GO TO 56
- IXDL = IXD
- GO TO 57
-
-C-- same action target as previous
-
- 56 IQ(LDOAN) = IOR (IQ(LDOAN), KM18)
-
- 57 MODEAN = 5
- CALL DPLIST (MODEAN,LDOAN,LUPAN,1)
-
- 58 LDOAN = LQ(LDOAN-1)
- IF (LDOAN.EQ.0) GO TO 87
- JCCTYP = JBYT (IQ(LDOAN),9,6)
- IF (JCCTYP.GE.MCCSEL) GO TO 59
- CALL DPLIST (MODEAN,LDOAN,LUPAN,0)
- GO TO 58
-
- 59 MODEAN = 0
- GO TO 22
-
-C---------- Control line ---------------
-
- 71 MODEAN = 6
- CALL DPLIST (MODEAN,LDOAN,LUPAN,1)
- IF (JCCTYP.GE.MCCPAT) NQLPAT = NQUSED
- GO TO 20
-
-C---- Done
-
- 87 CONTINUE
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+PATCH, YSYNOPT. for program Nysynopt
-+DECK, NSYNOPT.
- PROGRAM NSYNOPT
-
-+SELF, IF=QDIAG, IF=QS_UNIX.
- EXTERNAL SEGVIOL
-+SELF.
-
-+SEQ, NCNAME.
- PARAMETER (NFILES=4)
- CHARACTER NAME(NFILES)*(NCNAME)
-
-
- DATA NAME/ 'PAM .car 9 2 0 !ff'
- +, 'opt 3 11 0 !ff'
- +, 'read .cra 1 1 2 !ff'
- +, 'print .lis 2 4 0 !ff' /
-C- _:.=+=.:_1_:.=+=.:_2_:.=+=.:_3_:
-C- (1) (2) (3)
-
-C- (1) LUNUSE = 1 read, 2 print,
-C- 3 option, 4 cch subst, >4 file
-
-C- (2) LUNDES = 1 cradle input
-C- 2 PAM input
-C- 4 printed output
-C- 5 Fortran output
-C- 6 ASM output write-only (T=ATT)
-C- 7 ASM input-output (T=MODIF)
-C- 11 option parameter
-C- 12 control-character substitution parameter
-
-C- (3) LUNFLG = 0/>0 parameter value EOF not/yes allowed
-C- 2 the cradle file need not exist
-
-+SELF, IF=QS_IBMVM.
- NAME(4)(9:16) = '.listing'
-+SELF.
-
- CALL MQINIT
-
- CALL FLPARA (NFILES,NAME,
- + 'Nysynopt Help,Eject,Start, Individual,Missing,' //
- + ' Xact,Ycde,Zseq,0->4 pg size')
-
-+SELF, IF=QDIAG, IF=QS_UNIX.
- CALL SIGNALF (11, SEGVIOL, -1)
-+SELF.
- CALL EXSYNOPT
-
-+SEQ, PGMSTOP, T=PASS.
- END
-+SEQ, QCARDL. =====================================================
-+DECK, EXSYNOPT.
- SUBROUTINE EXSYNOPT
-
-C- Run nysynopt
-C. started 18-july-95
-
-+CDE, QBITA31, QBANKS, QPAGE, QUNIT.
-+CDE, LUNSLN, MUSEBC, Q, PY.
-C-------------- End CDE --------------------------------
- PARAMETER (MASK= KMH + KME + KMS + KMI + KMM + KMX + KMY + KMZ)
-
- DIMENSION MMKEEP(4)
- DATA MMKEEP / 1, 4, 2, 4 /
-
-
- CALL INIAUX (LASTWK)
- NQUSED = 12
-
- CALL KROPT (IXLUN(2),MASK)
- CALL PGSIZE (0, IXLUN(2))
- IF (MOPTIO(8).NE.0) GO TO 81
-
- IF (MOPTIO(19).NE.0) THEN
- MOPTIO(19) = 0
- ELSE
- MOPTIO(3) = 1
- MOPTIO(5) = 0
- ENDIF
- MOPTIO(6) = 1
- CALL PKBYT (MOPTIO(1),MOPTIO(33),1,32,0)
-
- NQCPGH = 120
-
- CALL UCOPY (MMKEEP, MMBANK(2,JBKKEE), 4)
-
-C-- set MOPUPD such that all IF's are true in CCPROC
-
- MOPUPD = -1
-
-C-- Get the cradle into memory
-
- INCRAD = 3
- IF (IQREAD.NE.0) CALL ARRIVE (0)
-
-C-- Complete the initialization
-
- CALL PINIT2
- MU_GLOB = MU_GLOB + KM5
- CALL SBIT0 (MU_GLOB,6)
-
-C-- Do the cradle initially
-
- CALL SYCRAD
- IF (JANSW.NE.0) GO TO 89
-
-C-- Do next PAM file
-
- 41 INCRAD = 0
- CALL SYPAM
-
-C-- Do cradle continuation
-
- INCRAD = 2
- CALL SYCRAD
- IF (JANSW.EQ.0) GO TO 41
- GO TO 89
-
-C---- Help
-
- 81 WRITE (IQPRNT,9081)
-
- 89 CALL PGSIZE (1, 0)
- RETURN
-
- 9081 FORMAT (' nysynopt pam.car options read.cra print'/
- F/' reads the "pam" file printing on "print" a numbered'
- F/' listing of the whole file, much like Nylist, but normally'
- F/' with sequence-calls expanded and actions signalled.'
- F/' The operation can be controlled in some detail by giving'
- F/' a cradle; if this is not needed "EOF" should be'
- F/' given for "read".'/
- F/' "options": H help - print this help information only'
- F/' S start - start each deck on a new page,'
- F/' unless T=JOIN present'
- F/' E eject - honour the pseudo sequence calls'
- F/' +SEQ, QEJECT, N=n.'
- F/' M missing sequences to be signalled'
- F/' I line numbers separate for individual PAM files'
- F/' X do not signal actions'
- F/' Y do not expand +CDE calls'
- F/' Z do not expand +SEQ calls'
- F/' 0 ... 4 - select page size by single digit option'
- F/' "n" - set page size to be n > 19')
- END
-+SEQ, QCARDL. =====================================================
-+DECK, SYCRAD.
- SUBROUTINE SYCRAD
-
-C- Process the cradle
-C. started 18-july-95
-
-+CDE, QBITS19, QBANKS, QPAGE, QUNIT.
-+CDE, CCTYPE, CCPARA, CHEXC, MUSEBC, TAGC.
-+CDE, MQCM, KQADR, Q, PY.
-+CDE, M_ANAC.
-C-------------- End CDE --------------------------------
- PARAMETER (IXCRA=2)
- CHARACTER MARK*4, LINE*8
- EQUIVALENCE (LINE,TEXT)
-
-+SEQ, Q_OR, Q_JBYT.
-
-
- LARRV = LACRAD
- NDKSAV = NQDKNO
- NQDKNO = 0
- NSLORG = 1
- IXEXPAM = 0
- NCHTAG = 0
- NQWYLDO = 0
- NVEXDK(2) = 1
- NVEXDK(6) = 1
- CALL DPBLAN (0)
- IF (INCRAD.NE.3) GO TO 21
- IF (IQREAD.NE.0) GO TO 27
-
-C---- Run in no-cradle mode
-
- MU_GLOB = IOR (MU_GLOB, KM2)
-
- LINE = '+PAM. '
- MLIAD(2) = 7
- JCCTYP = MCCPAM
- CALL CCKRAK (1)
- CALL DOAPAM
- GO TO 77
-
-+SEQ, QEJECT.
-C------ Restart the cradle after having read a PAM file
-
- 21 IF (IQREAD.EQ.0) GO TO 79
- CALL VZERO (IQ(LQHOLD+1),3)
- CALL ARRIVE (1)
-
-C-- lift PAT bank for P=CRA*
-
- CALL CREAPD (IXCRA,-1,1)
- LPCRA = LEXP
- LEXD = 0
-
- IXEXPAT = IXCRA
- IXEXDEC = IXCRA
- IXEXID = IXCRA
- LDECO = 0
- NQNEWH = 1
- NQJOIN = 1
- NSLORG = 1
- INCRAD = 2
-
- 27 IF (JDKTYP.GE.6) GO TO 79
- IF (JDKTYP.GE.4) GO TO 72
-
-C-------- Do next deck
-
- 29 JDKTYP = 1
- IF (JDKNEX.EQ.0) CALL ARRIVE (2)
- CALL DOMAPA (0)
- JSLORG = JSLZER - NSLORG
- NSLHAV = IQ(LQHOLD+3)
-
- LUPAN = 0
- LDOAN = KQPREP + 1
- KKM5AN = 0
-
-C---- Next PREP bank
-
- 31 LDOAN = LQ(LDOAN-1)
- IF (LDOAN.EQ.0) GO TO 39
-
-C-- MODEAN = 0 self material
-C- 1 CDE expansion
-C- 2 comment line
-C- 3 +SELF header line
-C- 4 +CDE call line
-C- 5 foreign material
-C- 6 control line
-
- JCCTYP = JBYT (IQ(LDOAN),9,6)
- IF (JCCTYP.LT.MCCKEE) GO TO 33
- IF (JCCTYP.EQ.MCCKEE) GO TO 34
- IF (JCCTYP.EQ.MCCUSE) GO TO 34
- IF (JCCTYP.EQ.MCCLIS) GO TO 34
- IF (JCCTYP.LT.MCCFOR) GO TO 33
- IF (JCCTYP.LE.MCCOP2) GO TO 34
-
-C---- list no-action lines
-
- 33 JCCTYP = 0
- CALL DPLIST (0,LDOAN,LUPAN,0)
- GO TO 31
-
-C---- Nysynopt cradle actions
-
- 34 CALL CCKRAK (IQ(LDOAN+1))
-
-C-- Do : +KEEP
-
- IF (JCCTYP.EQ.MCCKEE) THEN
- CALL SYKEEP
- GO TO 38
- ENDIF
-
-C-- Do : +USE +LIST +FORCE +SUSPEND
-
- 36 IF (JCCTYP.LE.MCCSUS) THEN
- CALL X_USE
- GO TO 38
- ENDIF
-
-C-- Do : +OPTION +PARAMETER +SHOW
-
- IF (JCCTYP.LE.MCCSHO) THEN
- CALL X_OPT
- GO TO 38
- ENDIF
-
-+SELF, IF=QDEBUG.
- CALL P_CRASH ('SYCRAD should not reach this point')
-+SELF.
-
- 38 CALL DPLIST (6,LDOAN,LUPAN,1)
- GO TO 31
-
-C---- step to the next deck
-
- 39 INCRAD = 1
- CALL ARRNXD (1)
- IF (JDKTYP.GE.6) GO TO 79
-
- NSLORG = NSLORG + NSLHAV
- IF (JDKTYP.LE.3) GO TO 29
-
-+SEQ, QEJECT.
-
-C------ Handle +PAM or +QUIT
-
- 72 JSLCRA = IQ(LQHOLD+1)
- NSLCRA = IQ(LQHOLD+2)
- JTXCRA = MLIAD(JSLCRA)
- NTX = MLIAD(JSLCRA+1) - JTXCRA - NCHNEWL
- JCCTYP = JPTYPE (TEXT(JTXCRA))
-
- MARK = ' + '
- CALL CCKRAK (JSLCRA)
- IF (JCCBAD.NE.0) MARK = ' *! '
-
-C-- print the c/line
-
- CALL DPLINE (NSLORG,MARK,NTX,TEXT(JTXCRA))
-
-C-- exit if faulty c/line
-
- IF (JCCBAD.NE.0) GO TO 91
-
-C------ Accepted control line +PAM or +QUIT
-
- IF (JCCTYP.EQ.MCCQUI) GO TO 79
- NSLORG = 0
-
-C-- Digest the +PAM parameters to bank at LPAM
-
- CALL DOAPAM
- IF (JCCBAD.NE.0) GO TO 91
-
-C-- Save cradle material after +PAM, ...
-
- JSLCRA = JSLCRA + 1
- NSLCRA = NSLCRA - 1
- IF (NSLCRA.EQ.0) GO TO 77
-
- CALL MQLIFT (LASAV, LACRAD,-2, JBKASA,1)
- IQ(LASAV+1) = JSLCRA
- IQ(LASAV+2) = NSLCRA
-
- 77 IQ(LQHOLD+2) = 0
- IQ(LPAM+14) = IQ(LPAM+14) + 1
- NQDKNO = NDKSAV
- JANSW = 0
- RETURN
-
-C-- +QUIT or EOF reached
-
- 79 JANSW = 1
- RETURN
-
-C---- Trouble
-
- 91 IF (JCCTYP.EQ.MCCQUI) GO TO 79
- CALL P_FATAL ('faulty line +PAM,...')
- END
-+SEQ, QCARDL. =====================================================
-+DECK, SYPAM.
- SUBROUTINE SYPAM
-
-C- Process the next multi-PAM file
-C. started 18-july-95
-
-+CDE, SLATE, SLATLN.
-+CDE, QBITS19, QBANKS, QPAGE, QUNIT.
-+CDE, ARRCOM, CCTYPE, CCPARA, CHEXC, MUSEBC, TITLEC.
-+CDE, MQCM, KQADR, Q, PY.
-C-------------- End CDE --------------------------------
-
-+SEQ, Q_AND, Q_OR.
-
-+SEQ, bkPAM, IF=DOC_INL.
-+SEQ, bkARRV, IF=DOC_INL.
-
-
- CALL DOPAMCO
-
- MOPUPD = -1
- IFLMERG = 1
- JDKSUB = 0
- MXFOSV = MX_FORC
- MOPT = IQ(LPAM+6)
- IFLATT = IAND (MOPT,KM1)
- IFLHOL = IAND (MOPT,KM2)
- IFLLIS = IAND (MOPT,KM7)
- IFLSEP = IAND (MOPT,KM8)
- IF (IFLLIS.NE.0) MX_FORC = IOR (MX_FORC, KM16)
- NQWYLDO = 7
-
- NHOLD = IQ(LARRV+9)
- IF (NHOLD.EQ.0) GO TO 31
-
-C---- Resume input of the PAM file stopped by RETURN=pname
-
- IQ(LARRV+9) = 0
- CALL ARRIVE (1)
-
- JSLTTL = IQ(LARRV+10)
- IXEXPAM = IQ(LARRV+11)
- IF (IQ(LPAM+4).GT.0) GO TO 42
-
- NCENT = NQDKNO / 100
- NNUM = MOD (NHOLD,100)
- NNEW = 100*NCENT + NNUM
- IF (NNEW.LT.NQDKNO) NNEW= NNEW + 100
- NQDKNO = NNEW
- NQWYL = IQ(LARRV+5)
- JDKTYP = 2
- GO TO 42
-
-C------ Load the title deck to memory ------------
-
- 31 IF (JDKNEX.EQ.0) CALL ARRIVE (2)
- IF (IFLATT+IFLSEP+MOPTIO(9).NE.0) NQWYL= 0
-
-C---- Handle the PAM-file title
-
- CALL KRTITL
- JDKSUB = 0
- IF (JCCTYP.EQ.MCCDEC) JDKSUB= 1
- IF (JCCTYP.EQ.MCCPAT) JDKSUB= 2
- JDKTYP = 3
-
- JSLTTL = IQ(LARRV+10)
- IQ(LPAM+13) = IQ(LPAM+13) + 1
- IF (IQ(LPAM+4).GT.0) GO TO 42
-
- IF (NQDKNO.GE.2) THEN
- NQDKNO = ((NQDKNO-1)/100 + 1) *100
- ELSE
- NQDKNO = 0
- ENDIF
-
-C-- create RPAM bank
-
- 42 CALL QSHUNT (KQMAIN,KQPAST)
- CALL MQLIFT (LRPAM, LEXP,1, JBKRPA,3)
- IQ(LRPAM+1) = JSLTTL
- IQ(LRPAM+2) = -IXEXPAM
- IQ(LRPAM+3) = NQDKNO
-
-C-- PAM file to be read, not skipped
-
- IF (IQ(LPAM+4).GT.0) GO TO 71
- IF (JDKTYP.EQ.3) THEN
- IF (NFILET.LT.NFIMAX) NFILET= NFILET + 1
- JTIPAM(NFILET) = JSLTTL
- ENDIF
-
-+SEQ, QEJECT.
-C------ DO all patches
-
- IF (JDKSUB.NE.0) JDKTYP= JDKSUB
- JDKSUB = 0
-
- CALL SYPAT
- IF (JDKTYP.EQ.6) GO TO 81
- IF (JDKTYP.EQ.2) GO TO 61
-
-C---- +TITLE seen, do next PAM file
-
- IQ(LPAM+5) = IQ(LPAM+5) - 1
- IF (IQ(LPAM+5).LE.0) GO TO 62
- GO TO 31
-
-C---- Stop input from PAM
-C- for RETURN=name reached
-C- for number of PAM files to be done exhausted
-
- 61 IQ(LARRV+9)= NQDKNO
- 62 JSLSAV = IQ(LQHOLD+1)
- NSLSAV = IQ(LQHOLD+2)
- IF (IFLHOL.EQ.0) THEN
- LQLEND(2) = JSLSAV
- LQLSTA(3) = LQLEND(2)
- LQLEND(3) = LQLSTA(3)
- GO TO 82
- ENDIF
-
- IF (NSLSAV.EQ.0) GO TO 88
-+SELF, IF=QCIO.
- IF (IQ(LARRV+7).GT.0) THEN
- IN_DOX = 1
- IN_DO1 = JSLSAV
- CALL ARRIN
- GO TO 88
- ENDIF
-+SELF.
-
- CALL MQLIFT (LASAV,LARRV,-2,JBKASA,1)
- IQ(LASAV+1) = JSLSAV
- IQ(LASAV+2) = NSLSAV
- GO TO 88
-
-C------ Skip the PAM file
-
- 71 IQ(LPAM+4) = IQ(LPAM+4) - 1
- IQ(LPAM+5) = 0
- IQ(LRPAM+4) = -1
- NQWYL = 0
-
- CALL LN_GET (JSLTTL, SLLINE, 60)
- NTXT = NDSLAT
-
- CALL DPBLAN (0)
- WRITE (IQPRNT,9072) SLLINE(1:NTXT)
- NQUSED = NQUSED + 2
- 9072 FORMAT (' Skip Pam file: ',A/)
-
- JDKTYP = 3
- CALL ARRSKP
- IF (JDKTYP.LT.6) GO TO 31
-
-C------ End of multi-PAM reached
-
- 81 CONTINUE
-
-C-- Detach or Rewind
-
- 82 IF (IFLHOL.EQ.0) THEN
- IN_DOX = -1
- ELSE
- IN_DOX = 0
- ENDIF
- CALL ARRIN
-
- 88 IQ(LQHOLD+2) = 0
- IQ(LPAM+12) = IQ(LPAM+12) + IQ(LARRV+12)
- IQ(LARRV+5) = NQWYL
- IQ(LARRV+12) = 0
- MX_FORC = MXFOSV
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, SYPAT.
- SUBROUTINE SYPAT
-
-C- Process all patches of the current PAM file
-C. started 18-july-95
-
-+CDE, QBITS19, QPAGE.
-+CDE, CCTYPE, CCPARA, CHEXC, MUSEBC, TAGC.
-+CDE, Q, PY.
-C-------------- End CDE --------------------------------
-
-+SEQ, Q_AND.
-
-
- IF (JDKTYP.EQ.3) GO TO 27
- IF (JDKTYP.EQ.1) GO TO 26
-
-C-- get the patch name
-
- 21 JSLF = IQ(LQHOLD+1)
- JCCTYP = MCCPAT
- CALL CCKRAK (JSLF)
-
- IXEXPAT = MCCPAR(JCCPP+1)
- IF (IXEXPAT.NE.0) GO TO 27
- 26 IXEXPAT= 1
-
-C-- find/create the patch bank
-
- 27 CALL CREAPD (IXEXPAT,-1,7)
- IXEXID = IXEXPAT
- CALL SBYT (NQDKNO, IQ(LEXP+1),13,20)
- MU_PAT = IAND (IQ(LEXP),KM19-1)
- IXEXDEC = 0
-
-C-- Check enough space
-
- 31 IFLGAR = 0
- CALL SETGAP
- IF (JDKNEX.EQ.0) CALL ARRIVE (2)
- NQNEWH = 7
- NCHTAG = 0
- LDECO = 0
-
-+SEQ, QEJECT.
-
-C------ Ready the deck parameters
-
- IF (JDKTYP.NE.1) GO TO 37
-
-C---- Deck header is +DECK, name
-
- JSLF = IQ(LQHOLD+1)
- JCCTYP = MCCDEC
- CALL CCKRAK (JSLF)
-
-C-- get the name
-
- IXEXDEC = MCCPAR(JCCPD+1)
- IF (IXEXDEC.EQ.0) IXEXDEC= 1
- IXEXID = IXEXDEC
-
-C-- find the deck bank, set operation mode
-
- 37 LEXD = KQFIND (IXEXDEC,1, LEXP-2,KEXD)
- IF (LEXD.NE.0) THEN
- MU_DECK = IAND (IQ(LEXD),KM19-1)
- ELSE
- MU_DECK = MU_PAT
- ENDIF
-
- NSLHAV = IQ(LQHOLD+3)
- IF (IAND(MU_DECK,KM5).EQ.0) GO TO 71
-
- CALL MXOPER (0)
-
-C-- start of PAM
-
- IF (JDKTYP.NE.3) GO TO 44
- NVEXDK(2) = 1
- IF (NQJOIN.GT.0) NQJOIN = 0
- IF (NQPAGE.LT.2) NQJOIN = 1
- CALL DPHEAD
- NQJOIN = -1
- GO TO 51
-
-C-- start of patch or deck
-
- 44 IF (NVEXDK(2).EQ.0) GO TO 51
- CALL CCJOIN
-
-C------ Process the deck
-
- 51 NSLORG = 0
- NCHTAG = 0
- LLORG = 0
- LLACT = 0
- LMODE = 0
-
-C-- ready the foreign material into this deck
-
- CALL ACSORT
-
-C-- analyse the contents
-
- CALL DOMAPA (7)
-
-C-- process the contents
-
- CALL SYXQT
-
-C------ Processing complete
-
-C-- send the DECK bank to garbage collection
-
- IF (LEXD.NE.0) THEN
- L = KQFIND (IXEXDEC,1, LEXP-2, KEXD)
- IF (L.NE.0) THEN
- CALL TOGARB (KEXD,0)
- ENDIF
- ENDIF
-
- IF (NVEXDK(2).NE.0) GO TO 72
-
-C---- Deck not listed, step the Wylbur line number
-
- 71 NQWYL = NQWYL + NSLHAV
-
-C-- step to the next deck
-
- 72 NQDKNO = NQDKNO + 1
- CALL ARRNXD (1)
- IF (JDKTYP.EQ.1) GO TO 31
-
- IF (IAND(IQ(LEXP+1),KM5).EQ.0) THEN
- IF (LQ(LEXP-2).NE.0) CALL TOGARB (LEXP-2,7)
- IF (LQ(LEXP-3).NE.0) CALL TOGARB (LEXP-3,7)
- ENDIF
-
- IF (JDKTYP.GE.3) RETURN
-
-C-- check stop for RETURN=pname
-
- IF (IXEXPAT.NE.IQ(LPAM+7)) GO TO 21
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, SYXQT.
- SUBROUTINE SYXQT
-
-C- List the material of the current deck according to the map
-C. started 18-july-95
-
-+CDE, QBITA19, QUNIT, CCTYPE, CCPARA, MUSEBC.
-+CDE, MQCM, KQADR, Q, PY.
-+CDE, M_ANAC.
-C-------------- End CDE --------------------------------
-
-+SEQ, Q_JBYT, Q_AND, Q_OR.
-
-+SEQ, QEJECT.
-
- IXPL = -1
- LEVIF = 0
- LUPAN = 0
- LDOAN = KQPREP + 1
-
-C---- Next bank
-
- 20 KDOAN = LDOAN - 1
- LDOAN = LQ(KDOAN)
- 22 MODEAN = 0
- IF (LDOAN.EQ.0) GO TO 87
- IF (LQ(LDOAN-2).EQ.0) GO TO 24
-
-C-- print action into here
-
- 23 IF (NVEXDK(2).NE.0) CALL SYFORG (-7,0)
- IF (MODEAN.EQ.5) GO TO 58
- GO TO 20
-
-C-- MODEAN = 0 self material
-C- 1 CDE expansion
-C- 2 comment line
-C- 3 +SELF header line
-C- 4 +CDE call line
-C- 5 foreign material
-C- 6 control line
-
- 24 JCCTYP = JBYT (IQ(LDOAN),9,6)
- IF (JCCTYP.GE.MCCKEE) GO TO 51
-
-C---------- Self material ----------------
-
- IF (NVEXDK(2).EQ.0) GO TO 20
- IF (JCCTYP.EQ.0) GO TO 39
- IF (JCCTYP.EQ.MCCNIL) GO TO 38
- IF (JCCTYP.LE.MCCINC) GO TO 71
- IF (JCCTYP.LE.MCCXSQ) GO TO 35
- IF (JCCTYP.LT.MCCSEL) GO TO 32
- IXPL = -1
- LEVIF = 0
-
-C-- to here +SELF, +SKIP and fault
-
- MODEAN = 3
- IF (JCCTYP.NE.MCCSES) GO TO 28
- IF (MOPTIO(26).NE.0) GO TO 28
- CALL CCKRAK (IQ(LDOAN+1))
-
- IF (IQ(LDOAN+2).GE.2) L = M_SPLIT (LDOAN, IQ(LDOAN+1)+1)
- CALL DPLIST (MODEAN,LDOAN,LUPAN,1)
- GO TO 37
-
- 28 CALL DPLIST (MODEAN,LDOAN,LUPAN,1)
- GO TO 20
-
-C-- to here +_IF etc
-
- 32 IF (JCCTYP.GE.MCCELS) GO TO 34
- IF (LEVIF.EQ.0) IQ(LDOAN)= IOR (IQ(LDOAN), KM17)
- LEVIF = LEVIF + 1
- GO TO 39
-
- 34 IF (JCCTYP.EQ.MCCELS) GO TO 39
- IF (LEVIF.EQ.1) IQ(LDOAN)= IOR (IQ(LDOAN), KM17)
- LEVIF = MAX (LEVIF-1, 0)
- GO TO 39
-
-C-- sequence call
-
- 35 MODEAN = 4
- CALL DPLIST (MODEAN,LDOAN,LUPAN,0)
- IF (JCCTYP.EQ.MCCCDE) THEN
- IF (MOPTIO(25).EQ.0) GO TO 36
- ELSE
- IF (MOPTIO(26).EQ.0) GO TO 36
- ENDIF
- IF (MOPTIO(5).NE.0) CALL XEJECT
- GO TO 20
-
- 36 CALL CCKRAK (IQ(LDOAN+1))
- IF (NCCPZ.EQ.0) GO TO 20
- IF (IAND(MCCPAR(JCCPT+1),KMD).NE.0) GO TO 20
-
- 37 CALL SYSEQ
- GO TO 20
-
-C-- comment line
-
- 38 MODEAN = 2
- 39 CALL DPLIST (MODEAN,LDOAN,LUPAN,1)
- GO TO 20
-
-+SEQ, QEJECT.
-
-C---------- Foreign material --------------
-
- 51 LEVIF = 0
- IF (JCCTYP.GE.MCCUSE) GO TO 71
- CALL CCKRAK (IQ(LDOAN+1))
- IF (JCCTYP.EQ.MCCKEE) GO TO 56
- IXP = MCCPAR(JCCPP+1)
- IXD = MCCPAR(JCCPD+1)
- IF (IXP.EQ.0) GO TO 52
- IF (IXP.EQ.IXPL .AND. IXD.EQ.IXDL) GO TO 53
- IXPL = IXP
- IXDL = IXD
- GO TO 54
-
-C-- implied target
-
- 52 IF (IXPL.LT.0) GO TO 54
- IF (MCCPAR(JCCPD+2).LT.0) GO TO 53
- IF (IXD.EQ.IXDL) GO TO 53
- IXDL = IXD
- GO TO 54
-
-C-- same action target as previous
-
- 53 IQ(LDOAN) = IOR (IQ(LDOAN), KM18)
- 54 CALL SYFORG (IXPL,IXDL)
- GO TO 57
-
-C-- sequence definition
-
- 56 IXPL = -1
- CALL SYKEEP
-
- 57 MODEAN = 5
- IF (NVEXDK(2).NE.0) CALL DPLIST (MODEAN,LDOAN,LUPAN,1)
-
- 58 KDOAN = LDOAN - 1
- LDOAN = LQ(KDOAN)
- IF (LDOAN.EQ.0) GO TO 87
- IF (LQ(LDOAN-2).NE.0) GO TO 23
- JCCTYP = JBYT (IQ(LDOAN),9,6)
- IF (JCCTYP.GE.MCCSEL) GO TO 22
- IF (NVEXDK(2).NE.0) CALL DPLIST (MODEAN,LDOAN,LUPAN,0)
- GO TO 58
-
-C---------- Control line ---------------
-
- 71 MODEAN = 6
- IF (NVEXDK(2).EQ.0) GO TO 20
- CALL DPLIST (MODEAN,LDOAN,LUPAN,1)
- IF (JCCTYP.LT.MCCPAT) GO TO 20
- NQLPAT = NQUSED
- GO TO 20
-
-C---- Done
-
- 87 LQCEND(2) = LQCSTA(2)
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, SYFORG.
- SUBROUTINE SYFORG (IXP,IXD)
-
-C- Remember actions +ADD etc
-C. started 18-july-95
-
-+CDE, QBANKS, QPAGE.
-+CDE, CCTYPE, CCPARA, MUSEBC.
-+CDE, Q, PY.
-+CDE, M_ANAC.
-C-------------- End CDE --------------------------------
-
-+SEQ, Q_OR, Q_SHIFTL.
-
-
- IF (IXP.EQ.-7) GO TO 41
-
-C---- Create ACT bank for new action going out
-
- IF (MOPTIO(24).NE.0) RETURN
- IF (JCCBAD.NE.0) GO TO 91
- IF (IXP.LE.0) GO TO 91
- CALL CREAPD (IXP, IXD, 0)
- IF (LCRD.EQ.0) GO TO 91
- IF (LDECO.EQ.0) CALL CRDECO
-
- JSLCL = IQ(LDOAN+1)
- JACTU = ISHFTL (JCCTYP-MCCDEL,8)
-
-C-- lift the ACT bank
-
- 24 CALL MQLIFT (LACT,LCRD,-2,JBKACT,1)
-
- IQ(LACT) = IOR (IQ(LACT), JACTU)
- LQ(LACT-3) = LDECO
-C! IQ(LACT+1) = JSLCL
-C! IQ(LACT+2) = 1
- IQ(LACT+3) = JSLCL - JSLORG
- IQ(LACT+4) = MCCPAR(JCCPC+1)
- IQ(LACT+5) = MCCPAR(JCCPC+2)
- IF (JCCTYP.NE.MCCDEL) RETURN
-
-C-- iterate if multiple +DEL
-
- JCCPC = JCCPC + 3
- NCCPC = NCCPC - 1
- IF (NCCPC.NE.0) GO TO 24
- RETURN
-
-C---- List action into here
-
- 41 IF (NVEXDK(2).EQ.0) RETURN
- LOWAN = LDOAN
- LUPAN = LQ(LDOAN-2)
- NQWYLDO = 0
- CALL DPLACT
- NQWYLDO = 7
- LUPAN = 0
- RETURN
-
-C---- Faulty action header line
-
- 91 CONTINUE
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, SYKEEP.
- SUBROUTINE SYKEEP
-
-C- Remember sequence definition
-C. started 18-july-95
-
-+CDE, QBITA19, QBANKS, CCTYPE, CCPARA.
-+CDE, MQCM, Q, PY.
-+CDE, M_ANAC.
-C-------------- End CDE --------------------------------
- PARAMETER (NOFFLI=2, NOFFDA=4)
-
-+SEQ, Q_JBYT, Q_AND, Q_OR, Q_SHIFTL.
-
-
- IF (JCCBAD.NE.0) GO TO 91
- MOPT = MCCPAR(JCCPT+1)
- IXS = MCCPAR(JCCPZ+1)
- IF (LDECO.EQ.0) CALL CRDECO
- IF (INCRAD.EQ.0) GO TO 41
-
-C-------- +KEEP in the cradle --------------------------
-
-C-- check sequence existing
-
- CALL SYLKEEP (LACT)
- IF (LACT.NE.0) GO TO 39
- KACT = IQUEST(1)
-
- CALL MQLIFT (LACT,KACT,0,JBKKEE,1)
-
- IQ(LACT-3) = LDECO
- IQ(LACT) = IOR (IQ(LACT), KM18)
- IQ(LACT+4) = IXS
-
- IF (IAND(MOPT,KMS).EQ.0) THEN
- IQ(LACT) = IOR (IQ(LACT), KM12)
- ELSE
- IQ(LACT) = IOR (IQ(LACT), KM14)
- ENDIF
-
-C-- no associated material for a +KEEP in the cradle
-
- 39 NSL = IQ(LDOAN+2)
- IF (NSL.GE.2) L = M_SPLIT (LDOAN, IQ(LDOAN+1)+1)
- RETURN
-
-+SEQ, QEJECT.
-C-------- +KEEP on the PAM file --------------------------
-
- 41 IF (IAND(MOPT,KMD).NE.0) RETURN
-
-C-- check sequence existing
-
- CALL SYLKEEP (LACT)
- KACT = IQUEST(1)
- IF (LACT.EQ.0) GO TO 47
-
-C-- check sequence is special or blocked from the cradle
-
- MACT = IQ(LACT)
- IF (IAND(MACT,KM12+KM13).NE.0) RETURN
- IF (IAND(MACT,KM14).EQ.0) GO TO 44
-
-C-- sequence had been registered with T=SINGLE
-
- IF (IAND(MACT,KM15).NE.0) RETURN
- CALL TOGARB (KACT,0)
- IFLSING = 7
- GO TO 48
-
-C-- a new definition of an existing sequence
-
- 44 KACT = LACT - 4
- LACT = LQ(KACT)
- IF (LACT.NE.0) GO TO 44
-
-C-- create the heading KEEP bank
-
- 47 IFLSING = 0
- 48 CALL MQLIFT (LACT,KACT,0,JBKKEE,1)
- CALL SYSPLIT (LDOAN)
-
- IQ(LACT-3) = LDECO
- IQ(LACT) = IOR (IQ(LACT), KM7)
- IQ(LACT+1) = IQ(LDOAN+1) + 1
- IQ(LACT+2) = IQ(LDOAN+2) - 1
- IQ(LACT+3) = IQ(LACT+1) - JSLORG
- IQ(LACT+4) = IXS
- IF (IAND(MOPT,KMN).NE.0) IQ(LACT) = IOR (IQ(LACT), KM16)
- IF (IFLSING.NE.0) IQ(LACT) = IOR (IQ(LACT), KM14+KM15)
-
-C------ create MAT continuation banks for KEEP
-
- IFLSGL = KM5+KM6+KM17
- IFLMSK = KM5+KM6
- LAST = LACT
- IF (NCCPP.NE.0) IFLSGL= 0
-
- KJOIN = LACT - 2
- LDOTK = LDOAN
- 51 LDOTK = LQ(LDOTK-1)
- IF (LDOTK.EQ.0) GO TO 69
- IF (LQ(LDOTK-2).NE.0) GO TO 51
-
- JCCTYP = JBYT (IQ(LDOTK),9,6)
- IF (JCCTYP.GE.MCCSEL) GO TO 69
-
- JSLNEW = IQ(LDOTK+1)
- NSLNEW = IQ(LDOTK+2)
- NUMNEW = JSLNEW - JSLORG
- IF (NSLNEW.EQ.0) GO TO 51
-
- IF (JCCTYP.LT.MCCCDE) GO TO 62
- IF (JCCTYP.GE.MCCXSQ) GO TO 61
-
-C-- handle +CDE or +SEQ
-
- CALL CCKRAK (JSLNEW)
-
-C-- check +SEQ,..., T=DUMMY
-
- IF (IAND(MCCPAR(JCCPT+1),KMD).NE.0) GO TO 51
-
-C---- try immediate substitution for +SEQ, single name
-
- IF (NCCPZ.NE.1) GO TO 54
- IF (NCCPIF.NE.0) GO TO 54
-
- IXC = MCCPAR(JCCPZ+1)
- CALL SYLSEQ (LSQF, IXC, 0,0)
- IF (LSQF.EQ.0) GO TO 54
- IF (IAND(IQ(LSQF),KM17).EQ.0) GO TO 54
-
-C-- do the substitution
-
- JSLNEW = IQ(LSQF+1)
- IF (JSLNEW.LT.LQLSTA(4)) THEN
- JSLNEW = LN_COP4 (JSLNEW,1)
- IQ(LSQF+1) = JSLNEW
- ENDIF
-
- JCCTYP = 0
-
-C-- does the KEEP bank have zero lines?
- IF (LAST.NE.LACT) GO TO 62
- IF (IQ(LACT+3).NE.NUMNEW) GO TO 62
- IQ(LACT+1) = JSLNEW
- IQ(LACT+2) = 1
- GO TO 51
-
-+SEQ, QEJECT.
-
-C---- lift XSQ bank for +CDE or +SEQ
-
- 54 NCCPZ = MIN (NCCPZ,61)
-
- MMBANK(3,JBKXSQ) = NCCPZ + NOFFLI
- MMBANK(5,JBKXSQ) = NCCPZ + NOFFDA
- CALL MQLIFT (LMAT,KJOIN,0,JBKXSQ,1)
-
- IQ(LMAT) = IOR (IQ(LMAT), ISHFTL(JCCTYP,8))
- IQ(LMAT) = IOR (IQ(LMAT), IAND(MCCPAR(JCCPT+1),KMP))
-
- IQ(LMAT+NOFFDA) = NCCPZ
- CALL UCOCOP (MCCPAR(JCCPZ+1),IQ(LMAT+NOFFDA+1),NCCPZ,1,3,1)
- IFLMSK = 0
- GO TO 63
-
-C---- lift new MAT bank
-
- 61 IFLMSK = 0
- 62 CALL MQLIFT (LMAT,KJOIN,0,JBKMAT,1)
-
- IQ(LMAT) = IOR (IQ(LMAT), ISHFTL(JCCTYP,8))
- 63 LQ(LMAT-2) = LDECO
- IQ(LMAT+1) = JSLNEW
- IQ(LMAT+2) = NSLNEW
- IQ(LMAT+3) = NUMNEW
-
- LAST = LMAT
- KJOIN = LMAT - 1
- GO TO 51
-
-C---- End of material for KEEP, finalize
-
- 69 IF (LQ(LACT-2).NE.0) IFLSGL= 0
- IF (IQ(LACT+2).NE.1) IFLSGL= 0
-
- IFLMSK = IOR (IFLMSK, IFLSGL)
- IQ(LACT) = IOR (IQ(LACT), IFLMSK)
-
- JCCTYP = MCCKEE
- RETURN
-
-C---- Faulty control line
-
- 91 CONTINUE
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, SYSEQ.
- SUBROUTINE SYSEQ
-
-C- Send the sequences called from bank LDOAN at KDOAN to output.
-C. started 24-aug-95
-
-+CDE, QBITA19, QBANKS, QPAGE, CCTYPE, CCPARA, TAGC.
-+CDE, Q, PY.
-+CDE, M_ANAC.
-C-------------- End CDE --------------------------------
- PARAMETER (NOFFLI=2, NOFFDA=4)
- PARAMETER (MAXLEV=36)
- COMMON /MSAVEC/ MSAVE(6,MAXLEV)
-
-+SEQ, Q_JBYT, Q_AND, Q_OR, Q_SHIFTL.
-
- LEVK = 0
- LNACT = 0
- LLACT = 0
- NCHTAG = 0
-
- KPC = LEXP - 3
- KDC = 0
- IF (LEXD.NE.0) KDC= LEXD - 3
-
- NCCPZ = MIN (NCCPZ,61)
-
- MMBANK(3,JBKXSQ) = NCCPZ + NOFFLI
- MMBANK(5,JBKXSQ) = NCCPZ + NOFFDA
- CALL MQLIFT (LMAT,KDOAN,0,JBKXSQ,2)
-
- LQ(LMAT-1) = LQ(LDOAN-1)
- IQ(LMAT) = IOR (IQ(LMAT), ISHFTL(JCCTYP,8))
- IQ(LMAT) = IOR (IQ(LMAT), IAND(MCCPAR(JCCPT+1),KMP))
- IQ(LMAT+1) = IQ(LDOAN+1)
- IQ(LMAT+2) = IQ(LDOAN+2)
-
- IQ(LMAT+NOFFDA) = NCCPZ
- CALL UCOCOP (MCCPAR(JCCPZ+1),IQ(LMAT+NOFFDA+1),NCCPZ,1,3,1)
-
- LDOAN = LMAT
- LCSQ = LMAT
-
-C---- New XSQ bank
-
- 21 JSEQ = 0
- NSEQ = IQ(LCSQ+NOFFDA)
- IFLPAS = IAND (IQ(LCSQ),KM16)
- 22 JSEQ = JSEQ + 1
- IF (JSEQ.GT.NSEQ) GO TO 67
- ITER = 0
- NDONE = 0
- IXSEQ = IQ(LCSQ+JSEQ+NOFFDA)
- LKEEP = LQ(LCSQ-JSEQ-NOFFLI)
- IF (LKEEP.NE.0) GO TO 41
-
- CALL SYLSEQ (LKEEP, IXSEQ, 0,0)
- IF (LKEEP.EQ.0) GO TO 51
- LQ(LCSQ-JSEQ-NOFFLI) = LKEEP
-
-+SEQ, QEJECT.
-C---- Start output of this sequence
-
- 41 IF (IAND(IQ(LKEEP),KM12+KM16).NE.0) GO TO 22
- IFALTN = NDONE
-
-C-- ready special sequence
-
- IFSPEC = IAND(IQ(LKEEP),KM13)
- IF (IFSPEC.NE.0) THEN
- CALL X_SEQSP (IQ(LCSQ+1), IXSEQ, IFSEND)
- IF (IFSEND.EQ.0) GO TO 22
- ENDIF
-
- NDONE = NDONE + 1
- LLORG = 0
- LNORG = LQ(LKEEP-3)
- CALL SYKTAG (LEVK,IXSEQ)
-
-C-- output of the start of the sequence expansion
-
- IF (IQ(LKEEP+2).NE.0) GO TO 44
- IF (LQ(LKEEP-2).NE.0) GO TO 43
- CALL SYKTAG (-1,0)
- GO TO 48
-
- 43 IFLST = LEVK+1
- GO TO 45
-
- 44 CALL DPLIST (1,LKEEP,0,LEVK+1)
- IFLST = 0
-
-C-- output of continuation MAT banks
-
- 45 LDO = LKEEP - 1
- 46 LDO = LQ(LDO-1)
- IF (LDO.EQ.0) GO TO 48
- JCCTYP = JBYT (IQ(LDO),9,6)
-
- LNORG = LQ(LDO-2)
- CALL DPLIST (1,LDO,0,IFLST)
- IFLST = 0
- IF (JCCTYP.GE.MCCCDE) GO TO 61
- GO TO 46
-
-C-- next sequence in multiple definition
-
- 48 IF (IFSPEC.NE.0) GO TO 22
- LKEEP = LQ(LKEEP-4)
- IF (LKEEP.NE.0) GO TO 41
-
-C-- do also patch/deck directed sequences
-
- 51 ITER = ITER + 1
- IF (ITER.GE.3) GO TO 57
- KP = KPC
- IF (ITER.EQ.1) THEN
- IF (LQ(KP).EQ.0) GO TO 51
- KD = 0
- ELSE
- IF (KDC.EQ.0) GO TO 57
- IF (LQ(KDC).EQ.0) GO TO 57
- KD = KDC
- ENDIF
-
- CALL SYLSEQ (LKEEP, IXSEQ, KP,KD)
- IF (LKEEP.NE.0) GO TO 41
- GO TO 51
-
-C-- missing sequence ?
-
- 57 IF (NDONE.NE.0) GO TO 22
- IF (IFLPAS.NE.0) GO TO 22
- IF (MOPTIO(13).EQ.0) GO TO 22
- CALL DPLMSQ (IXSEQ)
- GO TO 22
-
-C---- new sequence call bank, step level up by one
-
- 61 LEVK = LEVK + 1
- MSAVE(1,LEVK) = LCSQ
- MSAVE(2,LEVK) = LDO
- MSAVE(3,LEVK) = JSEQ
- MSAVE(4,LEVK) = NDONE
- MSAVE(5,LEVK) = LKEEP
- MSAVE(6,LEVK) = ITER
- LCSQ = LDO
- GO TO 21
-
-C---- end of doing this sequence call bank, step level down
-
- 67 IF (LEVK.EQ.0) GO TO 69
-
- LCSQ = MSAVE(1,LEVK)
- LDO = MSAVE(2,LEVK)
- JSEQ = MSAVE(3,LEVK)
- NDONE = MSAVE(4,LEVK)
- LKEEP = MSAVE(5,LEVK)
- ITER = MSAVE(6,LEVK)
- LEVK = LEVK - 1
-
- IFALTN = NDONE - 1
- NSEQ = IQ(LCSQ+NOFFDA)
- IXSEQ = IQ(LCSQ+JSEQ+NOFFDA)
- IFLPAS = IAND (IQ(LCSQ),KM16)
- IFSPEC = 0
- IFLST = 0
- CALL SYKTAG (LEVK,0)
- GO TO 46
-
- 69 NCHTAG = 0
- NQWYLDO = 7
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, SYKTAG.
- SUBROUTINE SYKTAG (LEVEL,IXKEEP)
-
-C- Construct the next tail for sequence IXKEEP at level LEVEL
-C- if LEVEL < 0: simply print the pending tag
-C. started 24-aug-95
-
-+CDE, SLATE, QBITS19, QCHAR, QPAGE, QUNIT.
-+CDE, TAGC, Q, PY.
-C-------------- End CDE --------------------------------
- CHARACTER MASK*4, MASKK(4)*4
- DATA MASKK / ' z ', ' .z ', ' y ', ' .y ' /
-
-+SEQ, Q_AND.
-
-
- LEV = LEVEL
- IF (NCHTAG.LE.0) GO TO 31
- IF (LMODE.LT.2) GO TO 30
-
-C-- Print pending tag
-
- CALL DPHEAD
- NQUSED = NQUSED + 1
- NQLLBL = 0
-
- JP = MIN (LMODE,3) - 1
- IF (LALTN.NE.0) JP= JP + 2
- MASK = MASKK(JP)
-
- NBL = NQCMAX - NCHTAG - 26
- NBL = MIN (NBL,75)
- WRITE (IQPRNT,9024) CHWYL,MASK,CQBLAN(1:NBL),CHTAG(1:NCHTAG)
- 9024 FORMAT (A,A,'-void-',A,A)
-
- 30 NCHTAG = 0
- 31 IF (LEV.LT.0) RETURN
- CHWYL = ' '
- IF (IXKEEP.EQ.0) GO TO 41
- CHTAG(1:10) = ' '
-
-C-- construct prefix
-
- NUMORG = IAND (IQ(LNORG), KM19-1)
- CALL CSETDI (NUMORG, CHWYL,2,5)
- CALL CLEFT (CHWYL,2,5)
- JP = NESLAT
- CHWYL(JP:JP) = '='
- JP = JP + 1
-
- IXORG = IQ(LNORG+1)
- IF (IXORG.EQ.0) IXORG = IQ(LNORG+2)
- CALL NA_GET (IXORG,CHWYL,JP)
-
-C-- construct tag
-
- IF (LEV.NE.0) THEN
- CALL CSETDI (LEV+1,CHTAG,1,2)
- JP = 4
- ELSE
- JP = 1
- ENDIF
-
- CALL NA_GET (IXKEEP,CHTAG,JP)
- NCHTAG = NESLAT - 1
- LLORG = LNORG
- LALTN = IFALTN
- LMODE = 2 + LEV
- NQWYLDO = -1
- RETURN
-
-C-- construct tag to signal continuation
-
- 41 CHTAG(1:12) = ' continued'
- CALL CSETDI (LEV+1,CHTAG,1,2)
- NCHTAG = 12
- LLORG = 0
- LALTN = IFALTN
- LMODE = -2
- NQWYLDO = -3
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, SYLKEEP.
- SUBROUTINE SYLKEEP (LSEQ)
-
-C- Find the KEEP bank for the sequence decribed by
-C- the current +KEEP control line;
-C- create target PAT/DECK banks if local sequence.
-
-C- return LSEQ L-adr of the sequence found, or LSEQ=0
-C- IQUEST(1) K-adr of the seq found, if found
-C- else: K-adr for attachment at end
-C- IQUEST(2) zero: sequence is global
-C- -ve: sequence is local
-C- IQUEST(11) zero if global sequence
-C. started 29-aug-92
-
-+CDE, QBITS19, CCPARA.
-+CDE, Q, PY.
-C-------------- End CDE --------------------------------
-
-+SEQ, Q_AND.
-
-
- IXS = MCCPAR(JCCPZ+1)
- CALL SYLSEQ (L, IXS, 0,0)
- IQUEST(11) = 0
- IF (L.NE.0) GO TO 22
- IF (NCCPP.EQ.0) GO TO 29
- GO TO 23
-
-C-- global sequence exist, check expansion restricted
-
- 22 IF (IAND(IQ(L),KM12+KM13).NE.0) GO TO 29
- IF (NCCPP.EQ.0) GO TO 29
- IF (IAND(IQ(L),KM14).NE.0) THEN
- IF (IAND(IQ(L),KM15).NE.0) GO TO 29
- ENDIF
-
- 23 IXP = MCCPAR(JCCPP+1)
- IXD = MCCPAR(JCCPD+2)
- KD = 0
-
- CALL CREAPD (IXP, IXD, 0)
- KP = LCRP - 3
- IF (LCRD.NE.0) KD = LCRD - 3
-
- 24 CALL SYLSEQ (L, IXS, KP,KD)
- IQUEST(11) = 7
- 29 LSEQ = L
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, SYLSEQ.
- SUBROUTINE SYLSEQ (LSEQ, IXSEQ, KP,KD)
-
-C- Find KEEP bank for the sequence with the name index IXSEQ
-C- KP gives the patch-directed, KD the deck-directed sequences
-C-
-C- return LSEQ L-adr of the sequence found, or LSEQ = 0
-C- IQUEST(1) K-adr of the seq found, if found
-C- else: K-adr for attachment at end
-C-
-C- if the sequence has been found,
-C- it is re-linked to the start of its structure
-C. started 29-aug-92
-
-+CDE, KQADR, Q, PY.
-C-------------- End CDE --------------------------------
- EQUIVALENCE (KSEQ,IQUEST(1))
- PARAMETER (LOCID=4)
-
-
-C-- Global set
-
- IF (KP.NE.0) GO TO 23
- KU = KQKEEP
- GO TO 29
-
-C-- Patch-directed set
-
- 23 IF (KD.NE.0) GO TO 24
- KU = KP
- GO TO 29
-
-C-- Deck-directed set
-
- 24 KU = KD
-
- 29 L = KQFIND (IXSEQ,LOCID,KU,KSEQ)
- IF (L.NE.0) THEN
- IF (KSEQ.NE.KU) THEN
- LQ(KSEQ) = LQ(L-1)
- LQ(L-1) = LQ(KU)
- LQ(KU) = L
- KSEQ = KU
- ENDIF
- ENDIF
-
- LSEQ = L
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, SYSPLIT.
- SUBROUTINE SYSPLIT (LTHIS)
-
-C- split on +CDE or +SEQ contained in a sequence definition
-C. started 24-aug-95
-
-+CDE, CCTYPE, CCPARA, Q, PY.
-C-------------- End CDE --------------------------------
-
-+SEQ, Q_OR, Q_SHIFTL, Q_JBYT.
-
-
- LDO = LTHIS
- JSLA = IQ(LDO+1)
- JSLE = JSLA + IQ(LDO+2)
- JSLF = JSLA
-
-C---- Find next control line
-
- 20 JSLG = JSLF + 1
- 21 IF (JSLG.GE.JSLE) GO TO 41
- CALL NEXTCC ('+',JSLG,JSLE,JSLF,JTYPE)
- IF (JTYPE.EQ.0) GO TO 41
-
- IF (JTYPE.LT.MCCCDE) GO TO 20
- IF (JTYPE.GT.MCCSEQ) GO TO 20
-
-C-- split before +CDE
-
- IF (JSLF.GT.JSLA) LDO= M_SPLIT (LDO,JSLF)
-
- IQ(LDO) = IOR (IQ(LDO), ISHFTL(JTYPE,8))
- JSLG = IQ(LDO+1) + 1
- IF (JSLG.GE.JSLE) GO TO 41
-
-C-- split after +CDE
-
- LDO = M_SPLIT (LDO,JSLG)
- JSLA = JSLG
- GO TO 21
-
-C---- step to next bank
-
- 41 LDO = LQ(LDO-1)
- IF (LDO.EQ.0) RETURN
- IF (LQ(LDO-2).NE.0) GO TO 41
- JTYPE = JBYT (IQ(LDO),9,6)
- IF (JTYPE.GE.MCCSEL) RETURN
- JSLA = IQ(LDO+1)
- JSLE = JSLA + IQ(LDO+2)
- JSLG = JSLA
- GO TO 21
- END
-+SEQ, QCARDL. =====================================================
-+PATCH, YCHECK. for program Nycheck
-+DECK, NCHECK.
- PROGRAM NCHECK
-
-+SELF, IF=QDIAG, IF=QS_UNIX.
- EXTERNAL SEGVIOL
-+SELF.
-
-+SEQ, NCNAME.
- PARAMETER (NFILES=3)
- CHARACTER NAME(NFILES)*(NCNAME)
-
-
- DATA NAME/ 'PAM .car 9 2 0 !ff'
- +, 'opt 3 11 0 !ff'
- +, 'print .lis 2 4 0 !ff' /
-C- _:.=+=.:_1_:.=+=.:_2_:.=+=.:_3_:
-C- (1) (2) (3)
-
-C- (1) LUNUSE = 1 read, 2 print,
-C- 3 option, 4 cch subst, >4 file
-
-C- (2) LUNDES = 1 cradle input
-C- 2 PAM input
-C- 4 printed output
-C- 5 Fortran output
-C- 6 ASM output write-only (T=ATT)
-C- 7 ASM input-output (T=MODIF)
-C- 11 option parameter
-C- 12 control-character substitution parameter
-
-C- (3) LUNFLG = 0/>0 parameter value EOF not/yes allowed
-C- 2 the cradle file need not exist
-
-+SELF, IF=QS_IBMVM.
- NAME(3)(9:16) = '.listing'
-+SELF.
-
- CALL MQINIT
-
- CALL FLPARA (NFILES,NAME,
- + 'Nycheck Help User_dt')
-
-+SELF, IF=QDIAG, IF=QS_UNIX.
- CALL SIGNALF (11, SEGVIOL, -1)
-+SELF.
- CALL EXCHECK
-
-+SEQ, PGMSTOP, T=PASS.
- END
-+SEQ, QCARDL. =====================================================
-+DECK, EXCHECK.
- SUBROUTINE EXCHECK
-
-C- Run nycheck
-C. started 12-jan-94
-
-+CDE, SLATE, SLATLN, QBITA31, QPAGE, QSTATE, QUNIT.
-+CDE, CM_TYP, LUNSLN.
-+CDE, Q, PY.
-C-------------- End CDE --------------------------------
- PARAMETER (MASK= KMH + KMU)
-
-
- CALL INIAUX (LASTWK)
-
- CALL KROPT (IXLUN(2),MASK)
- CALL PGSIZE (0, IXLUN(2))
- IF (MOPTIO(8).NE.0) GO TO 81
-
- NQCMAX = 90
- NQCPGH = 80
- NQJOIN = 1
-
-C------ Load the title deck to memory ------------
-
- CALL INIPAM (11, IXLUN(1), 1,0)
- 21 IF (JDKNEX.EQ.0) CALL ARRIVE (2)
-
-C---- Handle the PAM-file title line
-
- JDKTYP = 3
- CALL KRTITL
- JSLTTL = IQ(LARRV+10)
-
- IF (NQDKNO.GE.2) THEN
- NQDKNO = ((NQDKNO-1)/100 + 1) *100
- ELSE
- NQDKNO = 0
- ENDIF
-
- CALL LN_GET (JSLTTL, SLLINE, 60)
- NTXT = NDSLAT
-
- IF (IQPRNT.NE.IQTYPE) WRITE (IQTYPE,9024) SLLINE(1:NTXT)
- 9024 FORMAT (' Read Pam file: ',A/)
-
-C------ Loop over all decks until next title
-
- CALL CHDECK
- IF (JDKTYP.EQ.3) GO TO 21
-
- IF (MOPTIO(21).EQ.0) GO TO 47
- IF (N_TYP.LE.JIN_TYP) GO TO 47
- CALL DPBLAN (1)
- WRITE (IQPRNT,9025)
-
- DO 27 JASM=1,N_TYP
- LASMT = LQ(LHASM-JASM)
- NDK = IQ(LASMT+8)
- IF (NDK.EQ.0) GO TO 27
- N = LNBLNK (CH_TYP(JASM))
- WRITE (IQPRNT,9027) NDK, CH_TYP(JASM)(1:N)
- NQUSED = NQUSED + 1
- 27 CONTINUE
-
- 47 IF (NQERR .NE.0) CALL EXITRC (2)
- IF (NQWARN.NE.0) CALL EXITRC (1)
- CALL DPBLAN (0)
- WRITE (IQPRNT,9049)
- 9049 FORMAT (' All is well.'/)
- RETURN
-
-C---- Help
-
- 81 WRITE (IQPRNT,9081)
- RETURN
-
- 9025 FORMAT (' Table of Data types'/)
- 9027 FORMAT (4X,I6,' decks of type ',A)
- 9081 FORMAT (' nycheck pam.car options print'/
- F/' reads the "pam" file to check all Patchy control-lines'
- F/' for syntax, reporting errors on "print".'/
- F/' "options": H help - print this help information only'
- F/' U user data-types present to cause warning exit')
- END
-+SEQ, QCARDL. =====================================================
-+DECK, CHDECK.
- SUBROUTINE CHDECK
-
-C- Check all decks until next +TITLE
-C. started 12-jan-94
-
-+CDE, SLATLN, QBITS19, QPAGE.
-+CDE, CCTYPE, CCPARA, CHEXC, CM_TYP, DEPCOM, MUSEBC.
-+CDE, MQCM, KQADR, Q, PY.
-+CDE, M_ANAC.
-C-------------- End CDE --------------------------------
-+SEQ, Q_JBYT.
-
-C-- Check file starts with +PATCH or +DECK
-
- IF (JCCTYP.EQ.MCCDEC) JDKTYP= 1
- IF (JCCTYP.EQ.MCCPAT) JDKTYP= 2
-
-C-- set limits of control division 2
-
- LQCSTA(2) = LQCEND(1) + 100
- LQCEND(2) = LQCSTA(2)
-
-C-- clear text division 3
-
- LQLSTA(3) = LQLEND(2)
- LQLEND(3) = LQLSTA(3)
- JD_DTP = 1
-
-+SEQ, QEJECT.
-C------ Ready the deck parameters
-
- 21 NQNEWH = 7
- IXEXDEC = 0
- IF (JDKTYP.EQ.3) GO TO 47
- JSLF = IQ(LQHOLD+1)
- IF (JDKTYP.EQ.1) GO TO 42
-
-C-- deck header is +PATCH, name
-
- JCCTYP = MCCPAT
- CALL CCKRAK (JSLF)
- IXEXPAT = MCCPAR(JCCPP+1)
- IF (IXEXPAT.EQ.0) IXEXPAT= 1
- IXEXID = IXEXPAT
-
- JD_DTN = 0
- IF (JCCBAD.EQ.0) CALL CCDOPT (1, JD_DTN)
- IF (JD_DTN.EQ.0) JD_DTN= 1
- JD_DTP = JD_DTN
- GO TO 44
-
-C-- deck header is +DECK, name
-
- 42 JSLF = IQ(LQHOLD+1)
- JCCTYP = MCCDEC
- CALL CCKRAK (JSLF)
- IXEXDEC = MCCPAR(JCCPD+1)
- IF (IXEXDEC.EQ.0) IXEXDEC= 1
- IXEXID = IXEXDEC
-
- 44 JD_DTN = 0
- IF (JCCBAD.EQ.0) CALL CCDOPT (1, JD_DTN)
- IF (JD_DTN.EQ.0) JD_DTN= JD_DTP
- LASMT = LQ(LHASM-JD_DTN)
- NR = IQ(LASMT+8)
- IQ(LASMT+8) = NR + 1
-
- IF (MOPTIO(21).EQ.0) GO TO 47
- IF (JD_DTN.LE.JIN_TYP) GO TO 47
- IF (NR.NE.0) GO TO 47
- SLERRM = 'New user data-type ' // CH_TYP(JD_DTN)
- CALL FAILLN (0,0,0,JSLF,SLERRM(1:LENOCC(SLERRM)))
-
-C-- set operation mode
-
- 47 NVEXDK(1) = 0
- NVEXDK(2) = 1
- NVEXDK(5) = 1
- NVEXDK(6) = 1
- NQJOIN = 1
-
-C------ Process the deck
-
- LEXD = 0
- NSLORG = 0
-
- IF (JDKNEX.EQ.0) CALL ARRIVE (2)
-
-C-- analyse the contents
-
- CALL DOMAPA (0)
-
-C-- process the contents
-
- LUPAN = 0
- LDOAN = KQPREP + 1
- 54 LDOAN = LQ(LDOAN-1)
- IF (LDOAN.EQ.0) GO TO 88
-
- JCCTYP = JBYT (IQ(LDOAN),9,6)
- IF (JCCTYP.EQ.0) GO TO 54
-
- CALL CCKRAK (IQ(LDOAN+1))
- IF (JCCBAD.NE.0) THEN
- CALL FAILCC (1,'syntax error')
- GO TO 54
- ENDIF
-
- IF (JCCWAR.EQ.0) GO TO 54
- IF (JCCWAR.EQ.1) CALL FAILCC (0,'hidden dot')
- IF (JCCWAR.EQ.2) CALL FAILCC (0,'trailing comma')
- GO TO 54
-
-C-- step to the next deck
-
- 88 CALL ARRNXD (1)
- NQDKNO = NQDKNO + 1
- IFLGAR = 0
- IF (JDKTYP.LT.3) GO TO 21
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+PATCH, YTIDY. for program Nytidy
-+KEEP, ADDTI.
- +, IXBLADK, IXSQSP(7), NTRBLA,NMODIF, JSLTTL, LASTTI
-+DECK, DOC, T=JOIN, IF=DOCUMENT, DOC_INL.
-+KEEP, xADDTI.
-C IXBLADK = NA_LONG ('BLANKDEK')
-C IXSQSP(1) = NA_LONG ('DATEQQ')
-C IXSQSP(2) = NA_LONG ('TIMEQQ')
-C IXSQSP(3) = NA_LONG ('VERSQQ')
-C IXSQSP(4) = NA_LONG ('VIDQQ')
-+DECK, NTIDY, T=JOIN.
- PROGRAM NTIDY
-
-+SELF, IF=QDIAG, IF=QS_UNIX.
- EXTERNAL SEGVIOL
-+SELF.
-
-+SEQ, NCNAME.
- PARAMETER (NFILES=4)
- CHARACTER NAME(NFILES)*(NCNAME)
-
-
- DATA NAME/ 'PAM .car 9 2 0 !ff'
- +, 'NEW .car 9 6 0 !ff'
- +, 'opt 3 11 0 !ff'
- +, 'print .lis 2 4 0 !ff' /
-C- _:.=+=.:_1_:.=+=.:_2_:.=+=.:_3_:
-C- (1) (2) (3)
-
-C- (1) LUNUSE = 1 read, 2 print,
-C- 3 option, 4 cch subst, >4 file
-
-C- (2) LUNDES = 1 cradle input
-C- 2 PAM input
-C- 4 printed output
-C- 5 Fortran output
-C- 6 ASM output write-only (T=ATT)
-C- 7 ASM input-output (T=MODIF)
-C- 11 option parameter
-C- 12 control-character substitution parameter
-
-C- (3) LUNFLG = 0/>0 parameter value EOF not/yes allowed
-C- 2 the cradle file need not exist
-
-+SELF, IF=QS_IBMVM.
- NAME(4)(9:16) = '.listing'
-+SELF.
-
- CALL MQINIT
-
- CALL FLPARA (NFILES,NAME,
- + 'Nytidy Cmz, Help, Verbose')
-
-+SELF, IF=QDIAG, IF=QS_UNIX.
- CALL SIGNALF (11, SEGVIOL, -1)
-+SELF.
- CALL EXTIDY
-
-+SEQ, PGMSTOP, T=PASS.
- END
-+SEQ, QCARDL. =====================================================
-+DECK, EXTIDY.
- SUBROUTINE EXTIDY
-
-C- Run nytidy
-C. started 26-may-94
-
-+CDE, SLATE, SLATLN, QBITA31, QUNIT.
-+CDE, LUNSLN, FLINKC, DEPCOM.
-+CDE, Q, PY, ADDTI.
-C-------------- End CDE --------------------------------
- INTEGER RENAMEF
- PARAMETER (MASK= KMB + KMC + KMH + KMV)
-
-
- CALL INIAUX (LASTTI)
-
- CALL KROPT (IXLUN(3),MASK)
- IF (MOPTIO(8).NE.0) GO TO 81
- MOPTIO(2) = 0
-
- CALL INIPAM (11, IXLUN(1), 1,0)
-
- IXBLADK = NA_LONG ('BLANKDEK')
- IXSQSP(1) = NA_LONG ('DATEQQ')
- IXSQSP(2) = NA_LONG ('TIMEQQ')
- IXSQSP(3) = NA_LONG ('VERSQQ')
- IXSQSP(4) = NA_LONG ('VIDQQ')
-
- IFLOVW = 0
- IF (IXLUN(2).EQ.0) GO TO 24
-
-C-- check "new" is a pure directory
-
- CALL FLSPLIT (IXLUN(2),IXDIR,IXFN,IXEXT)
- IF (IXFN.NE.0) GO TO 27
- CALL FLSPLIT (IXLUN(1),IXD,IXFN,IXEXT)
- IF (IXD.EQ.IXDIR) CALL P_KILL ('clashing file names')
- GO TO 26
-
-C-- derive the name of "new" if not given
-
- 24 IFLOVW = 7
- CALL FLSPLIT (IXLUN(1),IXDIR,IXFN,IXEXT)
- IXEXT = NA_LONG ('.tdy')
- 26 CALL FLJOIN (IXDIR,IXFN,IXEXT,IXLUN(2))
-
-+SEQ, QEJECT.
-C-- open the output file
-
- 27 JD_LUN = 21
- CALL FLINK (JD_LUN,6,IXLUN(2),0)
-+SELF, IF=QCIO.
- JD_LUN = LUNFD
-+SELF.
- WRITE (IQTYPE,9029) CHLIFI(1:NLIFI)
- 9029 FORMAT (' Writing file: "',A,'"'/)
-
-C------ Load the title deck to memory ------------
-
- 41 IF (JDKNEX.EQ.0) THEN
- CALL ARRIVE (2)
- CALL TIDISTB
- NTRBLA = NTRBLA + IQUEST(1)
- ENDIF
-
-C---- Handle the PAM-file title line
-
- JDKTYP = 3
- CALL KRTITL
- JSLTTL = IQ(LARRV+10)
- CALL USETT (JSLTTL)
-
- CALL LN_GET (JSLTTL, SLLINE, 72)
- NTXT = NDSLAT
-
- CALL DPBLAN (0)
- WRITE (IQPRNT,9044) SLLINE(1:NTXT)
- IF (IQPRNT.NE.IQTYPE) WRITE (IQTYPE,9044) SLLINE(1:NTXT)
- 9044 FORMAT (' Read Pam file: ',A/)
-
-C------ Loop over all decks until next title
-
- CALL TIDECK
- IF (JDKTYP.EQ.3) GO TO 41
-
-C-- close output
-+SELF, IF=QCIO.
- CALL CICLOS (JD_LUN)
-+SELF, IF=QFIO.
- CLOSE (JD_LUN)
-+SELF.
-C-- close input
- CALL INIPAM (0,0, -1,0)
-
- CALL DPBLAN (0)
- WRITE (IQPRNT,9071) NMODIF,NTRBLA
- IF (IQPRNT.NE.IQTYPE) WRITE (IQTYPE,9071) NMODIF,NTRBLA
- 9071 FORMAT (I8,' changes done,',I7,' lines with trailing blanks.'/)
-
- IF (IFLOVW.EQ.0) RETURN
-
-+SELF, IF=-QMIBM.
-C-- delete the new file if overwriting and unchanged
-
- IF (NMODIF+NTRBLA.EQ.0) THEN
- CALL FLNAME (IXLUN(2),N)
- CALL UNLINKF (CHLIFI(1:NLIFI))
- RETURN
- ENDIF
-
-C-- rename "new" to "pam"
-
- CALL FLNAME (IXLUN(1), N)
- NIN = NLIFI
- SLLINE(1:NIN) = CHLIFI(1:NIN)
-
- CALL FLNAME (IXLUN(2),N)
-
- WRITE (IQTYPE,9077) CHLIFI(1:NLIFI),SLLINE(1:NIN)
- 9077 FORMAT (' Renaming file: ',A
- F/ ' to: ',A/)
-
- ISTAT = RENAMEF (CHLIFI(1:NLIFI), SLLINE(1:NIN))
-
- IF (ISTAT.EQ.0) RETURN
- CALL P_KILLM ('Rename new to old failed')
-+SELF, IF=QMIBM.
-C-- show the "new" name on IBM
-
- CALL FLNAME (IXLUN(2),N)
-
- WRITE (IQTYPE,9078) CHLIFI(2:NLIFI)
- 9078 FORMAT (' The name of the new file is: ',A/)
-+SELF.
- RETURN
-
-+SEQ, QEJECT.
-C---- Help
-
- 81 WRITE (IQPRNT,9081)
- RETURN
-
- 9081 FORMAT (' nytidy pam.car new.car options print'/
- F/' copies "pam" to "new" with some tidying-up:'
- F/' - remove trailing blanks'
- F/' - remove lead/trailing comment lines in decks of type FORT'
- F/' - translate non-standard sequence calls'/
- F/' options: C the input is a CMZ output file'
- F/' H help - print this help information only'
- F/' V verbose - print each modification'/
-+SELF, IF=-QMIBM.
- F/' If "new" is not given the result will overwrite "pam".'
- F/' If "new" is given as a directory (with / at the end) it will'
- F/' inherit file-name and extension from "pam".')
-+SELF, IF=QMIBM.
- F/' If "new" is not given the result will go to pam.TDY')
-+SELF.
- END
-+SEQ, QCARDL. =====================================================
-+DECK, TIDECK.
- SUBROUTINE TIDECK
-
-C- Tidy all decks until next +TITLE
-C. started 26-may-94
-
-+CDE, CCTYPE, CCPARA, CHEXC, CM_TYP, DEPCOM.
-+CDE, QPAGE, MQCM, Q, PY, ADDTI.
-C-------------- End CDE --------------------------------
-
-
-C-- Check file starts with +PATCH or +DECK
-
- IF (JCCTYP.EQ.MCCDEC) JDKTYP= 1
- IF (JCCTYP.EQ.MCCPAT) JDKTYP= 2
- NOFFBD = 0
-
-C-- make sure the deck is in memory
-
- 21 IF (JDKNEX.EQ.0) THEN
- CALL ARRIVE (2)
- CALL TIDISTB
- NTRBLA = NTRBLA + IQUEST(1)
- ENDIF
-
-C-- set limits of control division 2
-
- 22 LQCSTA(2) = LQCEND(1) + 100
- LQCEND(2) = LQCSTA(2)
-
-C-- clear text division 3
-
- LQLSTA(3) = LQLEND(2)
- LQLEND(3) = LQLSTA(3)
-
-C-------- Ready the deck parameters
-
- NQNEWH = 7
- IF (JDKTYP.EQ.1) GO TO 46
- IXEXDEC = 0
- IF (JDKTYP.EQ.2) GO TO 41
-
-C---- deck header is +TITLE or start of PAM
-
- JD_DTP = 0
- JD_DTD = 0
- GO TO 49
-
-+SEQ, QEJECT.
-C---- deck header is +PATCH, name
-
- 41 JSLF = IQ(LQHOLD+1)
- IF (JDKNEX.NE.1) GO TO 44
-
-C-- check next deck is BLANKDEK
-
- JSLN = JSLF + IQ(LQHOLD+3)
- JCCTYP = MCCDEC
- CALL CCKRAK (JSLN)
- IX = MCCPAR(JCCPD+1)
- IF (IX.NE.IXBLADK) GO TO 44
-
- NOFFBD = IQ(LQHOLD+3)
- JTXN = MLIAD(JSLN)
- TEXT(JTXN) = '*'
- CALL ARRNXD (0)
- IF (JDKNEX.EQ.0) GO TO 21
-
- 44 JCCTYP = MCCPAT
- CALL CCKRAK (JSLF)
- IXEXPAT = MCCPAR(JCCPP+1)
- IF (IXEXPAT.EQ.0) IXEXPAT= 1
- IXEXID = IXEXPAT
-
- JD_DTD = 0
- IF (JCCBAD.EQ.0) THEN
- CALL CCDOPT (1, JD_DTD)
- IF (JD_DTD.EQ.0) JD_DTD= 1
- ENDIF
- JD_DTP = JD_DTD
- GO TO 49
-
-C---- deck header is +DECK, name
-
- 46 JSLF = IQ(LQHOLD+1)
- JCCTYP = MCCDEC
- CALL CCKRAK (JSLF)
- IXEXDEC = MCCPAR(JCCPD+1)
- IF (IXEXDEC.EQ.0) IXEXDEC= 1
- IXEXID = IXEXDEC
-
- JD_DTD = 0
- IF (JCCBAD.EQ.0) THEN
- CALL CCDOPT (1, JD_DTD)
- IF (JD_DTD.EQ.0) JD_DTD= JD_DTP
- ENDIF
-
-C-- if type is INCLUDE: handle as CC
-
- 49 IF (JD_DTD.EQ.JIN_TYP) JD_DTD= JCC_TYP
-
-C-------- Process the deck
-
- LEXD = 0
- NSLORG = 0
-
-C-- restore the leading + for +DECK, BLANKDEK.
-
- IF (NOFFBD.NE.0) THEN
- JSLN = IQ(LQHOLD+1) + NOFFBD
- JTXN = MLIAD(JSLN)
- TEXT(JTXN) = '+'
- ENDIF
-
-C-- analyse the contents
-
- CALL DOMAPA (0)
- IF (JDKTYP.EQ.3) GO TO 67
-
- IF (NOFFBD.NE.0) THEN
- L = LQFIND (JSLN,1, LQPREP)
- IF (L.NE.0) LQ(L-2) = -1
- NOFFBD = 0
- ENDIF
-
-C-- transform the contents
-
- IF (JD_DTD.EQ.1) CALL TICOMM
- CALL TISEQ
- CALL TILIST
-+SELF, IF=XDEBUG, IF=XDDSNAP.
- CALL DDPREP
-+SELF.
-
-C-- send the deck to output
-
- 67 CALL TISEND
-
-C-- step to the next deck
-
- CALL ARRNXD (1)
- IFLGAR = 0
- IF (JDKTYP.LT.3) GO TO 21
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, TICOMM.
- SUBROUTINE TICOMM
-
-C- Delete leading and trailing comment or blank lines
-C- in Fortran decks only
-C. started 26-may-94
-
-+CDE, CCTYPE, CCPARA.
-+CDE, Q, PY, ADDTI.
-C-------------- End CDE --------------------------------
-
-+SEQ, Q_JBYT.
-
-
-C---- delete leading comments
-
- LDO = LQPREP
- 21 LPR = LDO
- LDO = LQ(LDO-1)
- IF (LDO.EQ.0) RETURN
- IF (LQ(LDO-2).NE.0) GO TO 21
- JCCTYP = JBYT (IQ(LDO),9,6)
- IF (JCCTYP.EQ.0) GO TO 24
- IF (JCCTYP.LT.MCCTRU) GO TO 22
- IF (JCCTYP.LT.MCCKEE) GO TO 31
-
-C-- step over foreign and control material
-
- 22 CALL TIFORG (LPR,LDO)
- IF (LDO.EQ.0) RETURN
- IF (JCCTYP.NE.0) GO TO 31
-
-C-- check all comment
-
- 24 JSLA = IQ(LDO+1)
- NSL = IQ(LDO+2)
- JSLE = JSLA + NSL
-
- JSL = JSLA - 1
- 25 JSL = JSL + 1
- IF (JSL.GE.JSLE) GO TO 27
-
- JTX = MLIAD(JSL)
- NTX = MLIAD(JSL+1) - JTX - NCHNEWL
- IF (NTX.EQ.0) GO TO 25
- IF (TEXT(JTX).EQ.'C') GO TO 25
- IF (TEXT(JTX).EQ.'c') GO TO 25
- IF (TEXT(JTX).EQ.'*') GO TO 25
-
- IF (JSL.EQ.JSLA) GO TO 31
- LPR = LDO
- LDO = M_SPLIT (LPR,JSL)
-+SELF, IF=QDIAG.
- IF (LDO.EQ.0) CALL P_KILL ('M_SLIT failed')
-+SELF.
- LQ(LPR-2) = -1
- GO TO 31
-
- 27 LQ(LDO-2) = -1
- GO TO 21
-
-+SEQ, QEJECT.
-C----- set the reverse link on remaining banks
-
- 31 CONTINUE
- 34 LPR = LDO
- 35 LDO = LQ(LDO-1)
- IF (LDO.EQ.0) GO TO 39
- IF (LQ(LDO-2).NE.0) GO TO 35
- JCCTYP = JBYT (IQ(LDO),9,6)
- IF (JCCTYP.EQ.MCCNIL) GO TO 36
- IF (JCCTYP.EQ.MCCKIL) GO TO 36
- IF (JCCTYP.LT.MCCKEE) GO TO 37
-
-C-- step over foreign and control material
-
- 36 CALL TIFORG (LPR,LDO)
- IF (LDO.EQ.0) GO TO 39
-
- 37 LQ(LDO-3) = LPR
- GO TO 34
-
- 39 LLAST = LPR
-
-C---- look for trailing comment lines
-
- LDO = LLAST
-
- 42 JCCTYP = JBYT (IQ(LDO),9,6)
- IF (JCCTYP.NE.0) GO TO 89
-
- JSLA = IQ(LDO+1)
- NSL = IQ(LDO+2)
- JSLE = JSLA + NSL
-
- JSL = JSLE
- 44 JSL = JSL - 1
- IF (JSL.LT.JSLA) GO TO 47
-
- JTX = MLIAD(JSL)
- NTX = MLIAD(JSL+1) - JTX - NCHNEWL
- IF (NTX.EQ.0) GO TO 44
- IF (TEXT(JTX).EQ.'C') GO TO 44
- IF (TEXT(JTX).EQ.'c') GO TO 44
- IF (TEXT(JTX).EQ.'*') GO TO 44
-
- JSL = JSL + 1
- IF (JSL.EQ.JSLE) GO TO 89
-
- LPR = LDO
- LDO = M_SPLIT (LPR,JSL)
-+SELF, IF=QDIAG.
- IF (LDO.EQ.0) CALL P_KILL ('M_SLIT failed')
-+SELF.
- LQ(LDO-2) = -1
- GO TO 89
-
-C-- all lines are comments
-
- 47 LQ(LDO-2) = -1
- LDO = LQ(LDO-3)
- IF (LDO.NE.0) GO TO 42
-
-C---- done
-
- 89 RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, TIFORG.
- SUBROUTINE TIFORG (LPREV,LNEXT)
-
-C- Skip over foreign and control material
-C. started 9-may-95
-
-+CDE, CCTYPE, CCPARA, Q.
-C-------------- End CDE --------------------------------
-
-+SEQ, Q_JBYT.
-
-
- LDO = LQ(LPREV-1)
- IF (JCCTYP.LT.MCCKEE) GO TO 24
- IF (JCCTYP.GE.MCCUSE) GO TO 24
-
-C-- scan foreign
-
- 21 LDO = LQ(LDO-1)
- IF (LDO.EQ.0) GO TO 27
- IF (LQ(LDO-2).NE.0) GO TO 21
- JCCTYP = JBYT (IQ(LDO),9,6)
- IF (JCCTYP.LT.MCCSEL) GO TO 21
- IF (JCCTYP.GE.MCCUSE) GO TO 24
- IF (JCCTYP.GE.MCCKEE) GO TO 21
- GO TO 27
-
-C-- scan control
-
- 24 LDO = LQ(LDO-1)
- IF (LDO.EQ.0) GO TO 27
- IF (LQ(LDO-2).NE.0) GO TO 24
- JCCTYP = JBYT (IQ(LDO),9,6)
- IF (JCCTYP.GE.MCCUSE) GO TO 24
- IF (JCCTYP.GE.MCCKEE) GO TO 21
- IF (JCCTYP.EQ.0) GO TO 27
- IF (JCCTYP.LT.MCCTRU) GO TO 24
-
-C-- end of scan
-
- 27 LNEXT = LDO
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, TISEQ.
- SUBROUTINE TISEQ
-
-C- Transform special sequence calls
-C. started 26-may-94
-
-+CDE, SLATE, SLATLN, QSTATE.
-+CDE, CCTYPE, CCPARA, CM_TYP, DEPCOM.
-+CDE, USETTC.
-+CDE, QBANKS, KQADR, Q, PY, ADDTI.
-C-------------- End CDE --------------------------------
- EQUIVALENCE (IFLBACK,MOPTIO(2)), (IFLCMZ,MOPTIO(3))
- CHARACTER LINE*128
- EQUIVALENCE (LINE,SLLINE)
-
-+SEQ, Q_JBYT.
-
-
-C---- Next bank
-
- LDO = KQPREP + 1
- 11 LDO = LQ(LDO-1)
- IF (LDO.EQ.0) RETURN
- IF (LQ(LDO-2).NE.0) GO TO 11
-
- JCCTYP = JBYT (IQ(LDO),9,6)
- IF (JCCTYP.LT.MCCCDE) GO TO 11
- IF (JCCTYP.GT.MCCSEQ) GO TO 11
-
- JSLOLD = IQ(LDO+1)
- CALL CCKRAK (JSLOLD)
- IF (NCCPZ.NE.1) GO TO 11
-
- IXZ = MCCPAR(JCCPZ+1)
- IF (IXZ.EQ.0) GO TO 11
- JSQ = IUCOMP (IXZ,IXSQSP,4)
- IF (JSQ.EQ.0) GO TO 11
- NSL = 1
- GO TO (21, 31, 41, 51), JSQ
-
-+SEQ, xADDTI, IF=DOC_INL.
-
-+SEQ, QEJECT.
-C---- doing +SEQ, DATEQQ
-
- 21 IF (IFLCMZ.NE.0) GO TO 24
- 22 IF (IFLBACK.NE.0) GO TO 11
-
- JSLNEW = LN_TO3 ('+SEQ, QDATE . IDATQQ = ?')
- GO TO 88
-
- 24 IF (JD_DTD.NE.JCC_TYP) GO TO 22
- IF (IFLBACK.NE.0) GO TO 26
- JSLNEW = LN_TO3 ('+SEQ, QDATE .#define IDATQQ ?')
- GO TO 88
-
- 26 LINE = '#define IDATQQ '
-C- _:.=+=.: 1_:.=+=.: 2_:.=+
- CALL CSETDI (IQDATE, LINE,17,24)
- JSLNEW = LN_TO3 (LINE(1:24))
- GO TO 88
-
-C---- doing +SEQ, TIMEQQ
-
- 31 IF (IFLCMZ.NE.0) GO TO 34
- 32 IF (IFLBACK.NE.0) GO TO 11
-
- JSLNEW = LN_TO3 ('+SEQ, QTIME . ITIMQQ = ?')
- GO TO 88
-
- 34 IF (JD_DTD.NE.JCC_TYP) GO TO 32
- IF (IFLBACK.NE.0) GO TO 36
- JSLNEW = LN_TO3 ('+SEQ, QTIME .#define ITIMQQ ?')
- GO TO 88
-
- 36 LINE = '#define ITIMQQ '
-C- _:.=+=.: 1_:.=+=.: 2_:.=+
- CALL CSETDI (IQTIME, LINE,17,22)
- JSLNEW = LN_TO3 (LINE(1:24))
- GO TO 88
-
-C---- doing +SEQ, VERSQQ
-
- 41 IF (IFLCMZ.EQ.0) GO TO 11
- IF (JD_DTD.EQ.JCC_TYP) GO TO 44
- IF (IFLBACK.NE.0) GO TO 42
- JSLNEW = LN_TO3 ('+SEQ, QFVSNUM . IVERSQ = ?')
- GO TO 88
-
- 42 LINE = ' IVERSQ = ' // CHTTNA(3)
- JSLNEW = LN_TO3 (LINE(1:40))
- GO TO 88
-
- 44 IF (IFLBACK.NE.0) GO TO 46
- JSLNEW = LN_TO3 ('+SEQ, QFVERS .#define VERSQQ "?"')
- JSL = LN_TO3 ('+SEQ, QFVSNUM .#define IVERSQ ?')
- NSL = 2
- GO TO 88
-
- 46 LINE = '#define VERSQQ "' // CHTTNA(2)
- N = LENOCC (LINE(1:48))
- LINE(N+1:N+1) = '"'
- JSLNEW = LN_TO3 (LINE(1:48))
- LINE = '#define IVERSQ ' // CHTTNA(3)
- JSL = LN_TO3 (LINE(1:48))
- NSL = 2
- GO TO 88
-
-C---- doing +SEQ, VIDQQ
-
- 51 IF (IFLCMZ.EQ.0) GO TO 11
- IF (JD_DTD.EQ.JCC_TYP) GO TO 54
-
- NSL = 2
- JSLNEW = LN_TO3 (' CHARACTER VIDQQ*(48)')
-
- IF (IFLBACK.NE.0) GO TO 52
- JSL = LN_TO3 ('+SEQ, QFHEAD . DATA VIDQQ /''@(#)?>''/')
- GO TO 88
-
- 52 LINE = ' DATA VIDQQ /''@(#)' //
- + CHTTNA(1)(1:9) // CHTTNA(2) // CHTTDT
- N = LENOCC (LINE(1:68))
- LINE(N+1:N+3) = '>''/'
- JSL = LN_TO3 (LINE(1:N+3))
- GO TO 88
-
- 54 IF (IFLBACK.NE.0) GO TO 56
- JSLNEW =
- + LN_TO3 ('+SEQ, QFHEAD .static char vidqq[] = "@(#)?>"')
- GO TO 88
-
- 56 LINE = 'static char vidqq[] = "@(#)' //
- + CHTTNA(1)(1:9) // CHTTNA(2) // CHTTDT
- N = LENOCC (LINE(1:80))
- LINE(N+1:N+2) = '>"'
- JSLNEW = LN_TO3 (LINE(1:N+2))
-
-C---- store the replacement
-
- 88 CALL MQLIFT (LNEW, LDO,-2, JBKPRE,2)
- IQ(LNEW+1) = JSLNEW
- IQ(LNEW+2) = NSL
- GO TO 11
- END
-+SEQ, QCARDL. =====================================================
-+DECK, TILIST.
- SUBROUTINE TILIST
-
-C- Count the modification done, list them if option Verbose
-C. started 27-may-94
-
-+CDE, SLATE, SLATLN, QPAGE, QUNIT, CHEXC.
-+CDE, KQADR, Q, PY, ADDTI.
-C-------------- End CDE --------------------------------
- CHARACTER LINE*512
- EQUIVALENCE (LINE,SLLINE)
-
-
- LDO = KQPREP + 1
- 21 LDO = LQ(LDO-1)
- IF (LDO.EQ.0) RETURN
- IF (LQ(LDO-2).EQ.0) GO TO 21
-
- NMODIF = NMODIF + 1
- IF (MOPTIO(22).EQ.0) GO TO 21
-
- IF (NQNEWH.EQ.0) GO TO 27
- NQNEWH = 0
-
-C-- list P/D identifier
-
- LINE(1:80) = ' --- p='
- CALL NA_GET (IXEXPAT,LINE,8)
- JN = NESLAT
- LINE(JN+1:JN+2) = 'd='
- CALL NA_GET (IXEXDEC,LINE,JN+3)
- N = NESLAT - 1
-
- CALL DPBLAN (0)
- WRITE (IQPRNT,9024) LINE(1:N)
- 9024 FORMAT (A/)
-
- 27 LNEW = LQ(LDO-2)
- JSLOLD = IQ(LDO+1)
- NSLOLD = IQ(LDO+2)
- IF (LNEW.GT.0) GO TO 41
-
-C------ NSLOLD lines deleted
-
-C-- check multiple deletes
-
- 31 LNX = LQ(LDO-1)
- IF (LNX.EQ.0) GO TO 32
- IF (LQ(LNX-2).GE.0) GO TO 32
- NSLOLD = NSLOLD + IQ(LNX+2)
- IQ(LDO+2) = NSLOLD
- LQ(LDO-1) = LQ(LNX-1)
- GO TO 31
-
- 32 CALL DPBLAN (1)
- WRITE (IQPRNT,9032)
- 9032 FORMAT (' delete:')
-
- JSL = JSLOLD
- LNO = JSL - JSLZER
- JSLE = JSLOLD + NSLOLD - 1
- LNOE = LNO + NSLOLD - 1
-
- NSLX = NSLOLD
- IF (NSLX.GT.7) NSLX = 3
-
- DO 34 J=1,NSLX
- CALL LN_GET (JSL,LINE,512)
- WRITE (IQPRNT,9034) LNO,LINE(1:NDSLAT)
- LNO = LNO + 1
- 34 JSL = JSL + 1
- IF (NSLX.EQ.NSLOLD) GO TO 21
-
- CALL LN_GET (JSLE,LINE,512)
- WRITE (IQPRNT,9033)
- WRITE (IQPRNT,9034) LNOE,LINE(1:NDSLAT)
- GO TO 21
-
- 9033 FORMAT (8X,'...')
- 9034 FORMAT (I8,' - ',A)
-
-+SEQ, QEJECT.
-C------ NSLNEW lines replacing
-
- 41 JSLNEW = IQ(LNEW+1)
- NSLNEW = IQ(LNEW+2)
-
- CALL DPBLAN (1)
- WRITE (IQPRNT,9041)
- 9041 FORMAT (' replace:')
-
- JSL = JSLOLD
- LNO = JSL - JSLZER
-
- DO 44 J=1,NSLOLD
- CALL LN_GET (JSL,LINE,512)
- WRITE (IQPRNT,9034) LNO,LINE(1:NDSLAT)
- LNO = LNO + 1
- 44 JSL = JSL + 1
-
- WRITE (IQPRNT,9042)
- 9042 FORMAT (' by:')
-
- JSL = JSLNEW
-
- DO 46 J=1,NSLNEW
- CALL LN_GET (JSL,LINE,512)
- WRITE (IQPRNT,9044) LINE(1:NDSLAT)
- 46 JSL = JSL + 1
- GO TO 21
-
- 9044 FORMAT (8X,' < ',A)
- END
-+SEQ, QCARDL. =====================================================
-+DECK, TISEND.
- SUBROUTINE TISEND
-
-C- Send the material of the current deck to output
-C. started 26-may-94
-
-+CDE, DEPCOM.
-+CDE, KQADR, Q, PY.
-C-------------- End CDE --------------------------------
-
-
- LDO = KQPREP + 1
- 21 LDO = LQ(LDO-1)
- IF (LDO.EQ.0) RETURN
- LNEW = LQ(LDO-2)
- IF (LNEW.LT.0) GO TO 21
- IF (LNEW.EQ.0) THEN
- JSL = IQ(LDO+1)
- NSL = IQ(LDO+2)
- ELSE
- JSL = IQ(LNEW+1)
- NSL = IQ(LNEW+2)
- ENDIF
- IF (NSL.EQ.0) GO TO 21
-
-+SELF, IF=QCIO.
- JTX = MLIAD(JSL)
- NTX = MLIAD(JSL+NSL) - JTX
- CALL CIPUT (JD_LUN,TEXT(JTX),NTX,ISTAT)
- IF (ISTAT.NE.0) CALL P_KILLM ('CIO write fails')
-+SELF, IF=QFIO.
- DO 24 JJ=1,NSL
- JTX = MLIAD(JSL)
- NTX = MLIAD(JSL+1) - JTX - NCHNEWL
- IF (NTX.NE.0) THEN
- CALL DPEXLN (TEXT(JTX), NTX)
- ELSE
- WRITE (JD_LUN, '(A)')
- ENDIF
- 24 JSL = JSL + 1
-+SELF.
- GO TO 21
- END
-+SEQ, QCARDL. =====================================================
-+DECK, TIDISTB.
- SUBROUTINE TIDISTB
-
-C- Discard trailing blanks on the lines in memory
-C. started 26-may-94
-
-+CDE, Q.
-C-------------- End CDE --------------------------------
- EQUIVALENCE (NCOUNT,IQUEST(1))
-
-+SEQ, Q_AND.
-
- NCOUNT = 0
- IF (IAND(IQ(LQHOLD),1) .EQ.0) RETURN
- CALL SBIT0 (IQ(LQHOLD),1)
-
- JSLSTA = IQ(LQHOLD+1)
- JSLEND = IQ(LQHOLD+1) + IQ(LQHOLD+2)
-
-C---- scan to find next line with trailing blank
-
- JSL1 = JSLSTA
- JTXPUT = MLIAD(JSL1)
- 41 JTXTAK = MLIAD(JSL1)
- JSL2 = JSLEND - 1
-
- DO 42 J=JSL1,JSL2
- JTXF = MLIAD(J)
- JTXN = MLIAD(J+1) - NCHNEWL
- IF (JTXN.EQ.JTXF) GO TO 42
- IF (TEXT(JTXN-1).EQ.' ') GO TO 44
- 42 CONTINUE
- IF (NCOUNT.EQ.0) RETURN
- NCHCOP = MLIAD(JSLEND) - JTXTAK
- GO TO 51
-
-C-- step to last non-blank on the line
-
- 44 JSL2 = J
- 45 JTXN = JTXN - 1
- IF (JTXN.GT.JTXF) THEN
- IF (TEXT(JTXN-1).EQ.' ') GO TO 45
- ENDIF
-
-+SELF, IF=QNEWLINE.
- TEXT(JTXN) = CHAR(NEWLN)
- JTXN = JTXN + 1
-+SELF.
- NCHCOP = JTXN - JTXTAK
- IF (NCOUNT.EQ.0) GO TO 57
-
-C-- copy the text and update the line slots
-
- 51 CALL CCOPYL (TEXT(JTXTAK), TEXT(JTXPUT), NCHCOP)
- NSH = JTXPUT - JTXTAK
-
- DO 54 J=JSL1,JSL2
- 54 MLIAD(J) = MLIAD(J) + NSH
-
- 57 JTXPUT = JTXPUT + NCHCOP
- NCOUNT = NCOUNT + 1
- JSL1 = JSL2 + 1
- IF (JSL1.LT.JSLEND) GO TO 41
- MLIAD(JSLEND) = JTXPUT
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+PATCH, YMERGE. for program Nymerge
-+DECK, DOC, IF=DOCUMENT, DOC_INL.
-+KEEP, bkYMERGE.
-C- .YMERGE special usage of the DECK bank
-C- ----------------------------------
-C-
-C- DECK bank linear structure supported by LQUSER(1)
-C-
-C- link 1: next
-C- status:
-C- word 1: JSL of the first line in memory
-C- 2: NSL number of lines in this deck
-C- 3: = 1/2 if deck/patch
-C-
-C- All the material from the "merge" file is held
-C- in text division 1, each deck being supported by
-C- one DECK bank in control division 1.
-+SELF.
-
-+DECK, NMERGE, T=JOIN.
- PROGRAM NMERGE
-
-+SELF, IF=QDIAG, IF=QS_UNIX.
- EXTERNAL SEGVIOL
-+SELF.
-
-+SEQ, NCNAME.
- PARAMETER (NFILES=5)
- CHARACTER NAME(NFILES)*(NCNAME)
-
-
- DATA NAME/ 'MERGE .car 9 2 0 !ff'
- +, 'OLD .car 9 2 0 !ff'
- +, 'NEW .car 9 6 0 !ff'
- +, 'opt 3 11 0 !ff'
- +, 'print .lis 2 4 0 !ff' /
-C- _:.=+=.:_1_:.=+=.:_2_:.=+=.:_3_:
-C- (1) (2) (3)
-
-C- (1) LUNUSE = 1 read, 2 print,
-C- 3 option, 4 cch subst, >4 file
-
-C- (2) LUNDES = 1 cradle input
-C- 2 PAM input
-C- 4 printed output
-C- 5 Fortran output
-C- 6 ASM output write-only (T=ATT)
-C- 7 ASM input-output (T=MODIF)
-C- 11 option parameter
-C- 12 control-character substitution parameter
-
-C- (3) LUNFLG = 0/>0 parameter value EOF not/yes allowed
-C- 2 the cradle file need not exist
-
- CALL MQINIT
-
- CALL FLPARA (NFILES,NAME,
- + 'Nymerge Help First Main Update Ponly Quick')
-
-+SELF, IF=QDIAG, IF=QS_UNIX.
- CALL SIGNALF (11, SEGVIOL, -1)
-+SELF.
- CALL EXMERGE
-
-+SEQ, PGMSTOP, T=PASS.
- END
-+SEQ, QCARDL. =====================================================
-+DECK, EXMERGE.
- SUBROUTINE EXMERGE
-
-C- Run nymerge
-C. started 11-july-95
-
-+CDE, SLATE.
-+CDE, QBITA31, QBANKS, QPAGE, QUNIT.
-+CDE, CCPARA, CCTYPE, CHEXC, DEPCOM, LUNSLN, FLINKC.
-+CDE, MQCM, KQUSER, Q, PY.
-C-------------- End CDE --------------------------------
- EQUIVALENCE (LMERGE,LQUSER(1))
- CHARACTER LINE*80, COL(80)*1
- EQUIVALENCE (LINE,COL)
- PARAMETER (MASK= KMF + KMH + KMM + KMP + KMQ + KMU)
-
- DIMENSION MMDEC(4)
- DATA MMDEC / 1, 1, 1, 3 /
-
-
- CALL INIAUX (LASTWK)
-
- CALL KROPT (IXLUN(4),MASK)
- IF (MOPTIO(8).NE.0) GO TO 81
- MOPTIO(21) = MOPTIO(21) + MOPTIO(6) + MOPTIO(13)
-
- CALL UCOPY (MMDEC, MMBANK(2,JBKDEC), 4)
-
-+SEQ, QEJECT.
-C---- load the "merge" file
-
- CALL MELOAD
-
-C---- open the "new" file
-
- JD_LUN = 21
- IXFLUN = IXLUN(3)
-
- IF (IXFLUN.EQ.0)
- + CALL P_KILL ('output file name missing')
-
- CALL FLINK (JD_LUN, 6, -1, 0)
-+SELF, IF=QCIO.
- JD_LUN = LUNFD
-+SELF.
-
-C---- start the "old" file
-
- CALL MQLIFT (LQHOLD, 0,7, JBKHOL,1)
- CALL MQLIFT (LARRV,LQARRV,1,JBKARR,3)
- CALL INIPAM (11,IXLUN(2),1,0)
- IFSTEP = 0
- NQDKNO = -1
-
-C-------- ready the next "merge" deck ---------------
-
- 31 IF (LMERGE.EQ.0) THEN
- IXMGPAT = -1
- GO TO 41
- ENDIF
-
- JSLM = IQ(LMERGE+1)
- NSLM = IQ(LMERGE+2)
- JTYP = IQ(LMERGE+3)
- IF (JTYP.EQ.1) GO TO 32
- IF (JTYP.NE.2) GO TO 68
-
- JCCTYP = MCCPAT
- CALL CCKRAK (JSLM)
- IXMGPAT = MCCPAR(JCCPP+1)
- IXMGDEC = 0
- IF (JCCBAD.NE.0) GO TO 91
- GO TO 36
-
- 32 JCCTYP = MCCDEC
- CALL CCKRAK (JSLM)
- IF (JCCBAD.NE.0) GO TO 91
- IXMGPAT = MCCPAR(JCCPP+1)
- IXMGDEC = MCCPAR(JCCPD+1)
-
- 36 LINE = 'd='
- CALL NA_GET (IXMGDEC, LINE,3)
- N = NESLAT
- IF (IXMGPAT.GT.0) THEN
- LINE(N+1:N+2) = 'p='
- CALL NA_GET (IXMGPAT, LINE,N+3)
- N = NESLAT
- ENDIF
-
- IF (MOPTIO(17).EQ.0) THEN
- CALL DPBLAN (0)
- WRITE (IQPRNT,9036) LINE(1:N-1)
- ENDIF
- 9036 FORMAT (43X,' merge ',A/)
-
-+SEQ, QEJECT.
-C---- read the next deck from "old"
-
- 41 CALL ARRNXD (IFSTEP)
- IF (JDKTYP.GE.4) GO TO 71
- IFSTEP = 1
- NQDKNO = NQDKNO + 1
- IF (JDKNEX.EQ.0) CALL ARRIVE (2)
- JSLF = IQ(LQHOLD+1)
- NSLF = IQ(LQHOLD+3)
- LINE = ' '
-
- IF (JDKTYP.EQ.1) GO TO 44
- IF (JDKTYP.EQ.2) GO TO 43
-
-C-- Deck header is +TITLE or start of PAM
-
- NQDKNO = (NQDKNO+99) / 100
- NQDKNO = NQDKNO * 100
- CALL METITL (JSLF,NSLF)
- IXEXPAT = 0
- GO TO 41
-
-C-- Deck header is +PATCH, name
-
- 43 JCCTYP = MCCPAT
- CALL CCKRAK (JSLF)
- IXEXPAT = MCCPAR(JCCPP+1)
- IXEXDEC = 0
- IF (IXEXPAT.EQ.0) GO TO 92
- CALL NA_GET (IXEXPAT, LINE,1)
- CALL CRIGHT (LINE,1,32)
- N = 39
- IFPRNT = MOPTIO(17)
- GO TO 51
-
-C-- Deck header is +DECK, name
-
- 44 JCCTYP = MCCDEC
- CALL CCKRAK (JSLF)
- IXEXDEC = MCCPAR(JCCPD+1)
- IF (IXEXDEC.EQ.0) GO TO 92
- CALL NA_GET (IXEXDEC, LINE,41)
- N = NESLAT - 1
- IFPRNT = MOPTIO(16) + MOPTIO(17)
-
-C---- choose next deck from "old" or "merge"
-
- 51 IF (IXMGPAT.LT.0) GO TO 56
- IF (IXMGPAT.NE.0) THEN
- IF (IXMGPAT.NE.IXEXPAT) GO TO 56
- ENDIF
-
- IF (IXMGDEC.EQ.IXEXDEC) GO TO 61
-
-C---- send deck from "old"
-
-C- | pname | num | . | dname
-C- 1 33 38 41
-
- 56 IF (IFPRNT.EQ.0) THEN
- CALL CSETDI (NQDKNO, LINE,34,37)
- COL(39) = '.'
- WRITE (IQPRNT,9056) LINE(1:N)
- NQLLBL = 0
- ENDIF
- 9056 FORMAT (1X,A)
-
- CALL MESEND (JSLF,NSLF)
- GO TO 41
-
-C---- send deck from "merge"
-
- 61 IF (MOPTIO(17).NE.0) GO TO 67
- IF (MOPTIO(16).EQ.0) THEN
- COL(39) = '-'
- WRITE (IQPRNT,9056) LINE(1:N)
- NQLLBL = 0
- ENDIF
-
- LINE = ' '
- IF (IXMGDEC.EQ.0) THEN
- CALL NA_GET (IXMGPAT, LINE,1)
- CALL CRIGHT (LINE,1,32)
- N = 39
- ELSE
- CALL NA_GET (IXMGDEC, LINE,41)
- N = NESLAT - 1
- ENDIF
- CALL CSETDI (NQDKNO, LINE,34,37)
- COL(39) = '+'
- WRITE (IQPRNT,9056) LINE(1:N)
- NQLLBL = 0
-
- 67 CALL MESEND (JSLM,NSLM)
- 68 CALL TOGARB (KQUSER,0)
- GO TO 31
-
-+SEQ, QEJECT.
-C------ Done
-
- 71 CALL DPBLAN (0)
- IF (LQUSER(1).EQ.0) RETURN
-
-C-- "merge" file has not been exhausted
-
- LINE = 'd='
- CALL NA_GET (IXMGDEC, LINE,3)
- N = NESLAT
- IF (IXMGPAT.GT.0) THEN
- LINE(N+1:N+5) = 'of p='
- CALL NA_GET (IXMGPAT, LINE,N+6)
- N = NESLAT
- ENDIF
-
- WRITE (IQPRNT,9074) LINE(1:N-1)
- 9074 FORMAT (' ***!!! ',A,' has not been found.')
-
- CALL P_KILL ('the merge file has not been consumed')
-
-C---- faulty c/l
-
- 91 LINE = ' merge:'
-C- _:.=+=.:_1
- JSL = JSLM
- GO TO 93
-
- 92 LINE = ' old:'
- JSL = JSLF
-
- 93 CALL DPBLAN (0)
- CALL LN_GET (JSL,LINE(9:),70)
- N = NDSLAT + 8
-
- WRITE (IQPRNT,9093) LINE(1:N)
- 9093 FORMAT (' ***!!! faulty control line:'/3X,A)
- CALL P_KILL ('fatal')
-
-C---- Help
-
- 81 WRITE (IQPRNT,9081)
- RETURN
-
- 9081 FORMAT (
- F ' nymerge merge.car old.car new.car options print'/
- F/' Merge "merge" into "old" copying to "new" with matching'
- F/' decks from "merge" overruling their brothers on "old".'
- F/' This is a purely sequential process, the decks on "merge"'
- F/' have to be in the right order.'/
- F/' options: U update the PAM file titles;'
- F/' F update only the first PAM title;'
- F/' M main release: update the primary version number;'
- F/' P ponly - log only the patch names;'
- F/' Q quick - no log printing;'
- F/' H print this help information only.')
- END
-+SEQ, QCARDL. =====================================================
-+DECK, METITL.
- SUBROUTINE METITL (JSLF,NSLF)
-
-C- Run nymerge
-C. started 11-july-95
-
-+CDE, SLATE, SLATLN, QSTATE, QPAGE, QUNIT.
-+CDE, CCPARA, CCTYPE, USETTC.
-+CDE, Q, PY.
-C-------------- End CDE --------------------------------
- CHARACTER LINE*128, LTEXT*128
- EQUIVALENCE (LTEXT,TEXT)
-
-
- JSL = JSLF
- NSL = NSLF
- CALL LN_GET (JSL,LINE,128)
- NL = NDSLAT
-
-C-- copy +TITLE. to output
-
- JCCTYP = JPTYPE (LINE)
- IF (JCCTYP.NE.MCCTIT) GO TO 31
-
- N = MIN (NL,12)
- JC = ICFIND (':', LINE,1,N)
- IF (JC.NE.NL) THEN
- IF (JC.LE.N) GO TO 31
- ENDIF
-
- IF (NSL.EQ.1) RETURN
- CALL MESEND (JSL,1)
- JSL = JSL + 1
- NSL = NSL - 1
- CALL LN_GET (JSL,LINE,128)
- NL = NDSLAT
-
-C-- analyse true title line
-
- 31 CALL USETT (JSL)
- JAOLD = JTTNAM
- JEOLD = NL
-
- IF (MOPTIO(21).NE.0) GO TO 34
- IF (LINE(1:2).NE.'C ') GO TO 48
- LTEXT = LINE(JTTNAM:NL)
- NCHTX = NL+1 - JTTNAM
-+SELF, IF=QNEWLINE.
- NCHTX = NCHTX + 1
- TEXT(NCHTX) = CHAR (NEWLN)
-+SELF.
- MLIAD(2) = NCHTX + 1
- CALL DPBLAN (0)
- WRITE (IQPRNT,9048) NQDKNO, ' . ', LINE(JAOLD:JEOLD)
- GO TO 46
-
-+SEQ, QEJECT.
-C---- title line update
-
- 34 IF (MOPTIO(6).NE.0) MOPTIO(21) = 0
- JTK = 1
- IF (LINE(1:2).EQ.'C ') JTK=JTTNAM
-
-C-- secondary version update
-
- IF (MOPTIO(13).NE.0) GO TO 36
- IF (JTTSLA.EQ.0) GO TO 36
- LTEXT = LINE (JTK:JTTSLA)
- NCHTX = JTTSLA+1 - JTK
-
- N = ICDECI (LINE,JTTSLA+1,JTTSLA+6) + 1
- CALL CSETDI (N, LTEXT,NCHTX+1,NCHTX+6)
- CALL CLEFT (LTEXT,NCHTX+1,NCHTX+6)
- NCHTX = NESLAT + 1
- GO TO 39
-
-C-- primary version update
-
- 36 IF (JTTVER.EQ.0) GO TO 38
- JA = ICNEXT (LINE,JTTVER,NL)
- JE = NESLAT
- JD = ICFIND ('.', LINE,JA,JE)
- IF (NGSLAT.EQ.0) JD= JA-1
- N = ICDECI (LINE,JD+1,JE) + 1
- NDIG = NDSLAT
-
- LTEXT = LINE (JTK:JE)
- NCHTX = JE - JTK
- JD = JD+1 - JTK
- IF (NDIG.NE.0) CALL CSETDI (N, LTEXT,JD+1,NCHTX)
- NCHTX = NCHTX + 2
- GO TO 39
-
-C-- no version number present
-
- 38 LTEXT = LINE(JTK:NL) // ' /1'
- NCHTX = NL+8 - JTK
-
-C-- update date/time
-
- 39 LTEXT(NCHTX+1:NCHTX+16) = CQDATEM // ' ' // CQTIME
- NCHTX = NCHTX + 16
-
-C-- add the free comment
-
- IF (JTTCOM.NE.0) THEN
- NCHTX = MAX (NCHTX+2,JTTCOM-1)
- N = NL+1 - JTTCOM
- LTEXT(NCHTX+1:NCHTX+N) = LINE(JTTCOM:JTTCOM+N-1)
- NCHTX = NCHTX + N
- ENDIF
- NCHPR = NCHTX
-+SELF, IF=QNEWLINE.
- NCHTX = NCHTX + 1
- TEXT(NCHTX) = CHAR (NEWLN)
-+SELF.
- MLIAD(2) = NCHTX + 1
-
-C---- new title line complete
-
- CALL USETT (1)
-
- CALL DPBLAN (0)
- WRITE (IQPRNT,9045) NQDKNO, ' + ', LTEXT(JTTNAM:NCHPR)
- WRITE (IQPRNT,9046) ' - ', LINE(JAOLD:JEOLD)
- 9045 FORMAT (4X,I6,A,A)
- 9046 FORMAT (10X,A,A/)
-
- 46 CALL MESEND (1,1)
-
- JSL = JSL + 1
- NSL = NSL - 1
- IF (NSL.EQ.0) RETURN
- GO TO 49
-
-C-- title unchanged
-
- 48 CALL DPBLAN (0)
- WRITE (IQPRNT,9048) NQDKNO, ' . ', LINE(JAOLD:JEOLD)
- 9048 FORMAT (4X,I6,A,A/)
-
- 49 CALL MESEND (JSL,NSL)
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, MESEND.
- SUBROUTINE MESEND (JSLX,NSLX)
-
-C- Send the NSLX lines at JSLX to output
-C. started 11-july-95
-
-+CDE, DEPCOM, Q, PY.
-C-------------- End CDE --------------------------------
-
-
-+SELF, IF=QCIO.
- 32 JTX = MLIAD(JSLX)
- NTX = MLIAD(JSLX+NSLX) - JTX
- CALL CIPUT (JD_LUN,TEXT(JTX),NTX,ISTAT)
- IF (ISTAT.NE.0) CALL P_KILLM ('CIO write fails')
-+SELF, IF=QFIO.
- 32 JSL = JSLX
- DO 34 JJ=1,NSLX
- JTX = MLIAD(JSL)
- NTX = MLIAD(JSL+1) - JTX - NCHNEWL
- IF (NTX.NE.0) THEN
- CALL DPEXLN (TEXT(JTX), NTX)
- ELSE
- WRITE (JD_LUN, '(A)')
- ENDIF
- 34 JSL = JSL + 1
-+SELF.
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, MELOAD.
- SUBROUTINE MELOAD
-
-C- Load the "merge" file
-C. started 11-july-95
-
-+CDE, QBANKS, LUNSLN.
-+CDE, MQCM, KQUSER, Q, PY.
-C-------------- End CDE --------------------------------
-
-
- IF (IXLUN(1).EQ.0) RETURN
- CALL INIPAM (11,IXLUN(1),1,0)
- CALL ARRIVE (1)
- IF (JDKTYP.GE.4) GO TO 49
-
- LDECK = KQUSER + 1
- NSLCUM = 0
-
- 21 IF (JDKNEX.EQ.0) CALL ARRIVE (2)
-
- JSLF = IQ(LQHOLD+1)
- NSLF = IQ(LQHOLD+3)
- IF (NSLCUM.EQ.0) JSLFIR= JSLF
-
- CALL MQLIFT (LDECK, LDECK,-1, JBKDEC,1)
- IQ(LDECK+1) = JSLF
- IQ(LDECK+2) = NSLF
- IQ(LDECK+3) = JDKTYP
- NSLCUM = NSLCUM + NSLF
-
-C-- step to the next deck
-
- CALL ARRNXD (1)
- IF (JDKTYP.LE.3) GO TO 21
-
- IF (JSLFIR+NSLCUM.NE.LQLEND(2)) GO TO 91
-
-C-- reset division 1 to cover the "merge" material
-
- LQLEND(1) = LQLEND(2)
- LQLSTA(2) = LQLEND(2)
-
-C-- close the input file
-
- 49 CALL INIPAM (0,0,-1,0)
- RETURN
-
-C----- trouble, file too big
-
- 91 CALL P_KILL ('MERGE file too big.')
- END
-+SEQ, QCARDL. =====================================================
-+PATCH, YDIFF. for program Nydiff
-+USE, DIF_XQT.
-+KEEP, ADDDI.
- +, INMEM(2),NSLTOT(2),NSLMAX(2),NTXMAX(2),JSLTTF(2), IFSTRUC
- +, NOBJTT(3,2),NOBJMAT, MDELADD(2,2), LUNCRA,NLSENT, LASTDI
-+DECK, DOC, T=JOIN, IF=DOCUMENT, DOC_INL.
-+KEEP, xADDDI.
-C- INMEM(J) file J is complete in memory if non-zero
-C- NSLTOT(2) number of lines on file 1/2
-C- NSLMAX(2) maximum number of lines per patch, file 1/2
-C- NTXMAX(2) max. number of characters p/p, file 1/2
-C- JSLTTF(2) the title of the first PAM on file 1/2
-C-
-C- NOBJTT(JO,J) total number of objects read
-C- JO= 1 decks, 2 patches, 3 PAMs
-C- NOBJMAT number of matching decks
-C-
-C- MDELADD (1,1) number of deleted patches
-C- (2,1) deleted decks
-C- (1,2) number of new patches added
-C- (2,2) new decks added
-C-
-C- LUNCRA logical unit number for cradle output
-C- NLSENT number of active cradle lines written
-C- LASTDI end for MQWORK
-
-+DECK, NDIFF, T=JOIN.
- PROGRAM NDIFF
-
-+SELF, IF=QDIAG, IF=QS_UNIX.
- EXTERNAL SEGVIOL
-+SELF.
-
-+SEQ, NCNAME.
- PARAMETER (NFILES=5)
- CHARACTER NAME(NFILES)*(NCNAME)
-
-
- DATA NAME/ 'OLD .car 9 2 0 !ff'
- +, 'NEW .car 9 2 0 !ff'
- +, 'DIFF .ucra 9 5 0 !ff'
- +, 'opt 3 11 0 !ff'
- +, 'print .lis 2 4 0 !ff' /
-C- _:.=+=.:_1_:.=+=.:_2_:.=+=.:_3_:
-C- (1) (2) (3)
-
-C- (1) LUNUSE = 1 read, 2 print,
-C- 3 option, 4 cch subst, >4 file
-
-C- (2) LUNDES = 1 cradle input
-C- 2 PAM input
-C- 4 printed output
-C- 5 Fortran output
-C- 6 ASM output write-only (T=ATT)
-C- 7 ASM input-output (T=MODIF)
-C- 11 option parameter
-C- 12 control-character substitution parameter
-
-C- (3) LUNFLG = 0/>0 parameter value EOF not/yes allowed
-C- 2 the cradle file need not exist
-
- CALL MQINIT
-
- CALL FLPARA (NFILES,NAME,
- + 'Nydiff Anyway Force Help')
-
-+SELF, IF=QDIAG, IF=QS_UNIX.
- CALL SIGNALF (11, SEGVIOL, -1)
-+SELF.
- CALL EXDIFF
-
-+SEQ, PGMSTOP, T=PASS.
- END
-+SEQ, QCARDL. =====================================================
-+DECK, EXDIFF.
- SUBROUTINE EXDIFF
-
-C- Run nydiff
-C. started 3-june-94
-
-+CDE, QBITA31, QBANKS, QSTATE, QUNIT.
-+CDE, LUNSLN.
-+CDE, MQCM, Q, PY, ADDDI.
-C-------------- End CDE --------------------------------
- PARAMETER (MASK= KMH + KMA + KMD + KMF)
-
- DIMENSION MMPAT(4)
- DATA MMPAT / 0, 4, 1, 10 /
-
-
- CALL INIAUX (LASTDI)
- LQCSTA(2) = LQCEND(1) + 100
- LQCEND(2) = LQCSTA(2)
-
- LQLSTA(1) = LQLEND(1) + 10
- MLIAD(LQLSTA(1)) = MLIAD(LQLEND(1)) + 2048
- LQLEND(1) = LQLSTA(1)
- LQLSTA(2) = LQLEND(1)
- LQLEND(2) = LQLSTA(2)
-
- CALL KROPT (IXLUN(4),MASK)
- IF (MOPTIO(8).NE.0) GO TO 81
-
- CALL UCOPY (MMPAT, MMBANK(2,JBKPAT), 4)
- MMPAT(2) = 3
- CALL UCOPY (MMPAT, MMBANK(2,JBKDEC), 4)
-
-C---- load the "old" and the "new" file
-
- CALL DILOAD
-
-C---- match decks on the names only
-
- CALL DIPREM
-
-C---- match unmatched P/D on contents
-
- CALL DISAME
-
-C---- insert proxies for new patches
-
- CALL DINEWP
-
-C---- check that 3/4 of the decks have been matched
-
- IF (MOPTIO(6).EQ.0) THEN
- NDK = MIN (NOBJTT(1,1), NOBJTT(1,2))
- IF (4*NOBJMAT.LT.3*NDK)
- + CALL P_KILL ('Less than 3/4 of the decks match')
- ENDIF
-
-C---- prepare for the re-ordering necessary
-
- CALL DIORD
-
-C---- find lost decks in foreign patches
-
- CALL DILOST
-
-C---- make Patchy cradle
-
- CALL DICRAD
-
-C---- make Wylbur re-ordering cradle
-
- CALL DIWYLB
- CALL DPBLAN (0)
-
-C---- done
-
- IF (NQERR.NE.0) THEN
- WRITE (IQPRNT,9067)
- CALL EXITRC (2)
- ENDIF
-
- IF (NQWARN.NE.0) THEN
- WRITE (IQPRNT,9068)
- CALL EXITRC (1)
- ENDIF
- RETURN
-
- 9067 FORMAT (' ***!!! There are errors !!!***'/)
- 9068 FORMAT (' **!! There are warnings !!**'/)
-
-C---- Help
-
- 81 WRITE (IQPRNT,9081)
- WRITE (IQPRNT,9082)
- RETURN
-
- 9081 FORMAT (
- F ' nydiff old.car new.car diff.ucra options print'/
- F/' compare "old" and "new" to derive the cradles which'
- F/' will give "new" when applied to "old":'/
- F/' diff.ucra to update "old" to "temp" using nypatchy;'
- F/' diff.uexe to re-order "temp" to "new" using Wylbur.'/
- F/' options: A anyway: operate even if there are too few'
- F/' matching patch names initially'
- F/' F force operation even if less than 3/4 of'
- F/' the decks have been matched'
- F/' H print this help information only.')
- 9082 FORMAT (
- F/' A shell script to make "new" from "old" using the'
- F/' cradles obtained from nydiff would look like this:'/
- F/' nypatchy - new.car .go <</'
- F/' +UPDATE.'
- F/' +USE, T=EXE.'
- F/' +PAM, T=ATTACH .diff.ucra'
- F/' +PAM, T=ATT, UPDATE .old.car'
- F/' +QUIT.'
- F/' /'/
- F/' useb new.car <</'
- F/' @diff.uexe'
- F/' save,unn,replace'
- F/' quit'
- F/' /')
- END
-+SEQ, QCARDL. =====================================================
-+DECK, DILOAD.
- SUBROUTINE DILOAD
-
-C- Load first the "new" and then the "old" file
-C. started 3-june-94
-
-+CDE, QUNIT, QBANKS, LUNSLN, FLINKC.
-+CDE, MQCM, Q, PY, ADDDI.
-C-------------- End CDE --------------------------------
-
-
-C- On the VAX it is more important to keep file "new" in memory
-C- than file "old" because it will need more random access, hence:
-
-C---- read file "new" into division 1, unit 12
-
- CALL INIPAM (12,IXLUN(2),1,0)
- CALL DILREAD (2)
- IF (NSLTOT(2).EQ.0) GO TO 91
- LQLSTA(1) = LQLSTA(2)
-
-C-- is file "new" complete in memory?
-
- IF (INMEM(2).EQ.0) GO TO 27
- NSLFREE = LQLSTA(4) - LQLEND(2)
- NTXFREE = MLIAD(LQLSTA(4)) - MLIAD(LQLEND(2))
- IF (MAX(NSLMAX(2),4000) .GE.NSLFREE) GO TO 27
- IF (MAX(NTXMAX(2),16000).GE.NTXFREE) GO TO 27
- LQLEND(1) = LQLEND(2)
- LQLSTA(2) = LQLEND(2)
- GO TO 31
-
-C-- file "new" has to be handled in pieces
-
- 27 CALL DICLFI (LQUSER(2))
- INMEM(2) = 0
- LQLEND(1) = LQLSTA(1)
- LQLSTA(2) = LQLSTA(1) + NSLMAX(2) + 4
- LQLEND(2) = LQLSTA(2)
- MLIAD(LQLSTA(2)) = MLIAD(LQLSTA(1)) + NTXMAX(2) + 200
-
-+SEQ, QEJECT.
-C---- read file "old" into division 2, unit 11
-
- 31 CALL MQLIFT (LQHOLD, 0,7, JBKHOL,1)
- CALL MQLIFT (LARRV,LQARRV,1,JBKARR,3)
- CALL INIPAM (11,IXLUN(1),1,0)
- CALL DILREAD (1)
- IF (NSLTOT(1).EQ.0) GO TO 91
-
-C-- is file "old" complete in memory?
-
- IF (INMEM(1).NE.0) GO TO 49
- CALL DICLFI (LQUSER(1))
- JSL1 = LQLSTA(1)
- JSL2 = LQLSTA(2)
- JSL4 = LQLSTA(4)
- JTX1 = MLIAD(JSL1)
- JTX2 = MLIAD(JSL2)
- JTX4 = MLIAD(JSL4)
- IF (INMEM(2).EQ.0) GO TO 47
-
-C- if file "new" is in memory: is there enough space
-C- left for the longest patch on "old" to be read back
-
- IF (JSL2+NSLMAX(1)+8.LT.JSL4) THEN
- IF (JTX2+NTXMAX(1)+8.LT.JTX4) GO TO 48
- ENDIF
- CALL DICLFI (LQUSER(2))
-
-C-- if both files are out of memory, divide the available
-C-- space between them
-
- 47 NSLGAP = JSL4 - JSL1 - NSLMAX(1) - NSLMAX(2)
- NTXGAP = JTX4 - JTX1 - NTXMAX(1) - NTXMAX(2)
- NSLGAP = MAX (4,NSLGAP/2)
- NTXGAP = MAX (4,NTXGAP/2)
-+SELF, IF=QDIAG.
- IF (MOPTIO(4).NE.0) THEN
- NSLGAP = 12
- NTXGAP = 480
- ENDIF
-+SELF.
- LQLSTA(2) = JSL1 + NSLMAX(2) + NSLGAP
- MLIAD(LQLSTA(2)) = JTX1 + NTXMAX(2) + NTXGAP
-
- 48 LQLEND(2) = LQLSTA(2)
- 49 LQLSTA(3) = LQLSTA(4)
- LQLEND(3) = LQLSTA(3)
-+SELF, IF=XDEBUG, IF=XYDIFF.
- WRITE (IQPRNT,9049) NOBJTT,NOBJMAT
- 9049 FORMAT ('.End of DILOAD: ',8I5)
- CALL DISNAP (3,1)
-+SELF.
- RETURN
-
-C---- Trouble
-
- 91 WRITE (IQPRNT,9091) CHLIFI(1:NLIFI)
- 9091 FORMAT (/' ***!!! file ',A,' is empty !!!***')
- CALL P_KILL ('fatal')
- END
-+SEQ, QCARDL. =====================================================
-+DECK, DILREAD.
- SUBROUTINE DILREAD (JFILE)
-
-C- Load the file JFILE = 1 old, 2 new
-C. started 3-june-94
-
-+CDE, SLATE, SLATLN, QBANKS, QUNIT.
-+CDE, ARRCOM, CCTYPE, CCPARA, CHEXC.
-+CDE, MQCM, KQUSER, Q, PY, ADDDI.
-C-------------- End CDE --------------------------------
-
-
- JFI = JFILE
- LFILE = KQUSER + JFI + 2
- NSLCUM = 0
- NTXCUM = 0
- JDKNEX = 0
- JDKSUB = 3
- NPAT = 0
- NDECK = 0
-
- LQLSTA(3) = LQLEND(2)
- LQLEND(3) = LQLSTA(3)
-
- 21 IF (JDKNEX.EQ.0) CALL ARRIVE (2)
- IF (JDKSUB.EQ.3) JDKTYP= 3
-
- 22 JSLF = IQ(LQHOLD+1)
- NSLF = IQ(LQHOLD+3)
- JDKSUB = 0
- IXEXDEC = 0
- IFLGAR = 0
-
- IF (JDKTYP.EQ.1) GO TO 43
- IF (JDKTYP.EQ.2) GO TO 41
-
-C---- Deck header is +TITLE or start of PAM
-
- CALL MQLIFT (LFILE, LFILE,-3, JBKPAT,3)
- IF (NOBJTT(3,JFI).EQ.0) LPAT = LFILE - 3
- NOBJTT(3,JFI) = NOBJTT(3,JFI) + 1
-
- CALL KRTITL
-
- IQ(LFILE+1) = JSLF
- IQ(LFILE+4) = IXEXPAM
- IQ(LFILE+7) = NSLCUM
- IQ(LFILE+8) = NTXCUM
-
-+SEQ, QEJECT.
-
- JSLTTL = IQ(LARRV+10)
- IF (NOBJTT(3,JFI).EQ.1) JSLTTF(JFI)= JSLTTL
-
- CALL LN_GET (JSLTTL, SLLINE, 72)
- NTXT = NDSLAT
-
- CALL DPBLAN (0)
- WRITE (IQPRNT,9027) SLLINE(1:NTXT)
- IF (IQPRNT.NE.IQTYPE) WRITE (IQTYPE,9027) SLLINE(1:NTXT)
-
- 9027 FORMAT (' Read Pam file: ',A/)
-
-C-- check file starts with +PATCH or +DECK
-
- IF (JCCTYP.EQ.MCCDEC) JDKSUB= 1
- IF (JCCTYP.EQ.MCCPAT) JDKSUB= 2
- IF (JDKSUB.NE.0) NSLF = 0
- GO TO 42
-
-C---- Deck header is +PATCH, name
-
- 41 JCCTYP = MCCPAT
- CALL CCKRAK (JSLF)
- IXEXPAT = MCCPAR(JCCPP+1)
- IF (IXEXPAT.EQ.0) IXEXPAT= 1
- 42 CALL MQLIFT (LPAT, LPAT,-1, JBKPAT,3)
- NOBJTT(2,JFI) = NOBJTT(2,JFI) + 1
- LQ(LPAT-3) = LFILE
- IQ(LPAT+1) = JSLF
- IQ(LPAT+4) = IXEXPAT
- IQ(LPAT+5) = NPAT
- IQ(LPAT+7) = NSLCUM
- IQ(LPAT+8) = NTXCUM
- IF (JFI.NE.2) NPAT= NPAT + 1
- IF (JDKTYP.EQ.3) LQ(LFILE-4)= LPAT
- LDECK = LPAT - 3
- GO TO 44
-
-C---- Deck header is +DECK, name
-
- 43 JCCTYP = MCCDEC
- CALL CCKRAK (JSLF)
- IXEXDEC = MCCPAR(JCCPD+1)
- IF (IXEXDEC.EQ.0) IXEXDEC= 1
- 44 CALL MQLIFT (LDECK, LDECK,-1, JBKDEC,3)
- NOBJTT(1,JFI) = NOBJTT(1,JFI) + 1
- LQ(LDECK-3) = LPAT
-
- NTXF = MLIAD(JSLF+NSLF) - MLIAD(JSLF)
-
- IQ(LDECK+1) = JSLF
- IQ(LDECK+2) = NSLF
- IQ(LDECK+3) = NTXF
- IQ(LDECK+4) = IXEXDEC
- IQ(LDECK+5) = NDECK
- IQ(LDECK+7) = NSLCUM
- IQ(LDECK+8) = NTXCUM
- IF (JFI.NE.2) NDECK= NDECK + 1
-
- IQ(LPAT+2) = IQ(LPAT+2) + NSLF
- IQ(LPAT+3) = IQ(LPAT+3) + NTXF
-
- IQ(LFILE+2) = IQ(LFILE+2) + NSLF
- IQ(LFILE+3) = IQ(LFILE+3) + NTXF
-
- NSLCUM = NSLCUM + NSLF
- NTXCUM = NTXCUM + NTXF
-
-C-- step to the next deck
-
- IF (JDKSUB.NE.0) THEN
- JDKTYP = JDKSUB
- GO TO 22
- ENDIF
-
- CALL ARRNXD (1)
- IF (JDKTYP.LE.1) GO TO 21
- NSLMAX(JFI) = MAX (NSLMAX(JFI),IQ(LPAT+2))
- NTXMAX(JFI) = MAX (NTXMAX(JFI),IQ(LPAT+3))
- IF (JDKTYP.LE.3) GO TO 21
-
- NSLTOT(JFI) = NSLCUM
- JSLF = IQ(LQUSER(JFI)+1)
- IF (JSLF+NSLCUM.EQ.LQLEND(2)) INMEM(JFI)= NSLCUM
-+SELF, IF=QDIAG.
- IF (MOPTIO(4).NE.0) INMEM(JFI) = 0
-+SELF.
-
-C-- rewind
-
- IN_DOX = 0
- CALL ARRIN
- CALL DIDUPL (JFI)
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, DIDUPL.
- SUBROUTINE DIDUPL (JFILE)
-
-C- Check presence of duplicate P/D names
-C- JFILE = 1/2 for old/new
-C. started 1-mar-95
-
-+CDE, SLATE, SLATLN, QSTATE, QUNIT.
-+CDE, KQUSER, QSH.
-C-------------- End CDE --------------------------------
- CHARACTER LINE*80
- EQUIVALENCE (LINE,SLERRM)
-
-
- JFI = JFILE
- CALL DPBLAN (0)
-
- LFA = KQUSER + JFI
- LFA = LQ(LFA-1)
- LPA = LFA - 3
-
-C-- next patch A
- 22 LPA = LQ(LPA-1)
- IF (LPA.EQ.0) RETURN
- IXP = IQ(LPA+4)
- LDA = LPA - 3
-
-C-- next deck A
- 24 LDA = LQ(LDA-1)
- IF (LDA.EQ.0) GO TO 22
- IXD = IQ(LDA+4)
-
-C---- search for next deck of same name
-
- LPN = LPA
- LDN = LDA
- 32 LDN = LQ(LDN-1)
- IF (LDN.EQ.0) GO TO 37
- IF (IQ(LDN+4).EQ.IXD) GO TO 41
- GO TO 32
-
- 37 LPN = LQ(LPN-1)
- IF (LPN.EQ.0) GO TO 24
- IF (IQ(LPN+4).NE.IXP) GO TO 37
- LDN = LPN - 3
- GO TO 32
-
-C-- trouble
-
- 41 IQ(LDA+10) = MAX (1, IQ(LDA+10))
- IQ(LDN+10) = IQ(LDA+10) + 1
-
- IF (JFI.EQ.1) THEN
- LINE = 'old p='
- ELSE
- LINE = 'new p='
- ENDIF
- CALL NA_GET (IXP,LINE,7)
- N = NESLAT
- IF (IXD.EQ.0) THEN
- IQ(LPA) = IQ(LDA+10)
- IQ(LPN) = IQ(LDN+10)
- ELSE
- LINE(N+1:N+2) = 'd='
- N = N + 3
- CALL NA_GET (IXD,LINE,N)
- N = NESLAT
- ENDIF
-
- WRITE (IQPRNT,9044) LINE(1:N)
- NQLLBL = 0
- NQINFO = NQINFO + 1
- GO TO 24
-
- 9044 FORMAT (' *! Duplicate: ',A,' !*')
- END
-+SEQ, QCARDL. =====================================================
-+DECK, DIPREM.
- SUBROUTINE DIPREM
-
-C- Pre-match on the basis of patch/deck names only
-C. started 3-june-94
-
-+CDE, QUNIT, Q, PY, ADDDI.
-C-------------- End CDE --------------------------------
-
-
- CALL DPBLAN (1)
- WRITE (IQPRNT,9001) 'old',NSLTOT(1),NOBJTT(1,1),NOBJTT(2,1)
- WRITE (IQPRNT,9001) 'new',NSLTOT(2),NOBJTT(1,2),NOBJTT(2,2)
- CALL DPBLAN (0)
-
- 9001 FORMAT (' file "',A,'" has',I6,' lines in',I5,' decks, in'
- F,I4,' patches')
-
- CALL DILINK (LQUSER(1), LQUSER(2), 2,1)
-
-C---- match patch names
-
- LFOLD = LQUSER(1)
- LFNEW = LQUSER(2)
- NPMAT = 0
-
- CALL DIMNAME (LFOLD,LFNEW,1,1,IRC)
- NPMAT = NPMAT + IQUEST(1)
-
-C-- each patch: match the deck names
-
- LOLD = LQ(LFOLD-4)
- 36 LNEW = LQ(LOLD-2)
- IF (LNEW.NE.0) CALL DIMNAME (LOLD, LNEW, 0, 1, IRC)
-
- 37 LOLD = LQ(LOLD-1)
- IF (LOLD.NE.0) GO TO 36
-
-C-- match unmatched file titles by position
-
- IF (NOBJTT(3,1).NE.NOBJTT(3,2)) GO TO 49
- LFX = LQUSER(1)
- LFN = LQUSER(2)
- 44 LFX = LQ(LFX-3)
- LFN = LQ(LFN-3)
- IF (LFN.EQ.0) GO TO 49
- LPX = LQ(LFX-4)
- LPN = LQ(LFN-4)
- IF (LQ(LPX-2).NE.0) GO TO 44
- IF (LQ(LPN-2).NE.0) GO TO 44
- CALL DILINK (LPX,LPN,1,1)
- GO TO 44
-
- 49 IF (NOBJTT(1,1).NE.NOBJTT(1,2)) IFSTRUC= 7
- IF (NOBJTT(1,1).NE.NOBJMAT) IFSTRUC= 7
-+SELF, IF=XDEBUG, IF=XYDIFF.
- WRITE (IQPRNT,9049) NOBJTT,NOBJMAT
- 9049 FORMAT ('.End of name matching in DIPREM: ',8I5)
- CALL DISNAP (3,0)
-+SELF.
-C-- check that 1/2 of the patches actually match
-
- IF (MOPTIO(1).NE.0) RETURN
-
- NDH = MIN (NOBJTT(1,1), NOBJTT(1,2))
- NPH = MIN (NOBJTT(2,1), NOBJTT(2,2))
- IF (2*NOBJMAT.GE. NDH) RETURN
- IF (2*NPMAT .GE. NPH) RETURN
- IF (NPH.LE.6) RETURN
- CALL P_KILL
- + ('Insufficient number of matching patch-names initially')
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, DISAME.
- SUBROUTINE DISAME
-
-C- Match unmatched p/d by content, but only from the matching f/p
-C. started 6-june-94
-
-+CDE, QBITS19, QUNIT, DIFFC.
-+CDE, Q, PY, ADDDI.
-C-------------- End CDE --------------------------------
-
-+SEQ, Q_AND.
-
-
-+SELF, IF=XDEBUG, IF=XYDIFF.
- WRITE (IQTYPE,9001) INMEM, NOBJTT, NOBJMAT
- 9001 FORMAT (/'.Start matching by content in DISAME'
- F/' INMEM=',2I8,' NOBJTT,NOBJMAT=',8I5)
-+SELF.
-
- LFX = LQUSER(1)
- LFN = LQUSER(2)
-
- LPNL = LQ(LFN-4)
- LPNL = LQ(LPNL-1)
- IF (LPNL.EQ.0) GO TO 27
-
-C-- take next old patch
-
- LPX = LQ(LFX-4)
- 24 LPX = LQ(LPX-1)
- IF (LPX.EQ.0) GO TO 27
-
- LPNM = LQ(LPX-2)
- IF (LPNM.EQ.0) GO TO 31
-
- 25 LPNL = LPNM
- CALL DINOUN (LPX)
- CALL DINOUN (LPNM)
- IF (IAND(IQ(LPX),KM2) .NE.0) GO TO 24
- IF (IAND(IQ(LPNM),KM2).NE.0) GO TO 24
-
- CALL DISAMD (LPX,LPNM)
- GO TO 24
-
-C-- all patches done
-
- 27 CONTINUE
-+SELF, IF=XDEBUG, IF=XYDIFF.
- WRITE (IQTYPE,9028)
- 9028 FORMAT ('.End of execution in DISAME.')
- CALL DISNAP (3,0)
-+SELF.
- RETURN
-
-+SEQ, QEJECT.
-C-------- match the current unresolved patch on "old" by content
-
- 31 CONTINUE
-+SELF, IF=XDEBUG, IF=XYDIFF, IF=XDETAILDB, IF=XDISAME.
- CALL NA_PRIX (' -- OLD p=', IQ(LPX+4))
-+SELF.
- LPN = LPNL
- 32 IF (LQ(LPN-2).EQ.0) GO TO 34
- 33 LPN = LQ(LPN-1)
- IF (LPN.EQ.0) THEN
- LPN = LQ(LFN-4)
- LPN = LQ(LPN-1)
- ENDIF
- IF (LPN.EQ.LPNL) GO TO 24
- GO TO 32
-
-C---- try to match the "new" patch at LPN
-
-C-- match by deck-names
-
- 34 CONTINUE
-+SELF, IF=XDEBUG, IF=XYDIFF, IF=XDETAILDB, IF=XDISAME.
- CALL NA_PRIX (' new p=', IQ(LPN+4))
-+SELF.
- CALL DIMNAME (LPX,LPN,0,0,ISTAT)
- NLEN = IQUEST(1)
- NOLD = NQCOUNT (LQ(LPX-4))
- NNEW = NQCOUNT (LQ(LPN-4))
- NHAV = MIN (NOLD,NNEW)
- IF (NHAV.EQ.0) GO TO 37
- IF (ISTAT.EQ.0) GO TO 39
- IF (4*NLEN.GE.3*NHAV) GO TO 39
-
-C-- match by text content
-
- 37 CALL DILOOK (LPX,LPN,1,LPX,LPN,12,80)
-
- IF (NFAID.LT.0) GO TO 33
-
- 39 LPNM = LPN
- CALL DILINK (LPX,LPN,1,1)
- CALL DIMNAME (LPX,LPN,0,1,ISTAT)
- GO TO 25
- END
-+SEQ, QCARDL. =====================================================
-+DECK, DISAMD.
- SUBROUTINE DISAMD (LPOLD,LPNEW)
-
-C- Match unmatched decks of LPOLD and LPNEW by content
-C. started 6-june-94
-
-+CDE, QBITS19, DIFFC.
-+CDE, Q, PY, ADDDI.
-C-------------- End CDE --------------------------------
-
-+SEQ, Q_AND.
-
-
- LPX = LPOLD
- LPN = LPNEW
-
- LDX = LQ(LPX-4)
- LDN = LQ(LPN-4)
- LDN = LQ(LDN-1)
- IF (LDN.EQ.0) RETURN
-
-C-- take next unmatched deck on OLD
-
- LDNL = LDN
- 42 LDX = LQ(LDX-1)
- IF (LDX.EQ.0) RETURN
-
- LU = LQ(LDX-2)
- IF (LU.NE.0) THEN
- LDNL = LU
- GO TO 42
- ENDIF
-
-C-- try to pair each unmatched deck on NEW in turn
-
- LDN = LDNL
- 45 IF (LQ(LDN-2).EQ.0) GO TO 47
- 46 LDN = LQ(LDN-1)
- IF (LDN.EQ.0) LDN= LQ(LPN-4)
- IF (LDN.EQ.LDNL) GO TO 42
- GO TO 45
-
-C-- try to match the "new" deck at LDN
-
- 47 CALL DILOOK (LDX,LDN,0,LPX,LPN,8,80)
-
- IF (NFAID.LT.0) GO TO 46
- IF (NFAID.EQ.0) IQ(LDX+6)=4
-
- LDNL = LDN
- CALL DILINK (LDX, LDN, 0,1)
- CALL DINOUN (LPX)
- CALL DINOUN (LPN)
- IF (IAND(IQ(LPX),KM2).NE.0) RETURN
- IF (IAND(IQ(LPN),KM2).NE.0) RETURN
- GO TO 42
-
- END
-+SEQ, QCARDL. =====================================================
-+DECK, DINEWP.
- SUBROUTINE DINEWP
-
-C- Create a proxy for each new patch not present on OLD
-C. started 8-mar-95
-
-+CDE, QBANKS, QUNIT.
-+CDE, Q, PY, ADDDI.
-C-------------- End CDE --------------------------------
-
-
-C---- scan all patches on NEW
-
- NOP = 0
- LFI = LQUSER(2)
- LPN = LFI - 3
- 62 LPN = LQ(LPN-1)
- IF (LPN.EQ.0) GO TO 87
- LPX = LQ(LPN-2)
- IF (LPX.EQ.0) GO TO 71
-
-C---- scan all decks of this patch
-
- 63 LDN = LPN - 3
- 64 LDN = LQ(LDN-1)
- IF (LDN.EQ.0) GO TO 62
- LDX = LQ(LDN-2)
- IF (LDX.EQ.0) GO TO 64
-
-C-- check the deck is of foreign origin
- IF (IQ(LDN+6).GE.4) GO TO 64
-
-C-- remember this deck for adding to it
- LASTXQ = LDX
- GO TO 64
-
-+SEQ, QEJECT.
-C------ this patch is new, add a proxy in the OLD structure
-
- 71 NOP = NOP + 1
- LLD = LASTXQ
- LLP = LQ(LLD-3)
-
- CALL MQLIFT (LPIN, LLP,-1, JBKPAT,3)
- LQ(LPIN-3) = LQ(LLP-3)
- IQ(LPIN+1) = 1
- IQ(LPIN+4) = IQ(LPN+4)
- IQ(LPIN+5) = IQ(LLP+5)
- IQ(LPIN+9) = -1
-
- CALL MQLIFT (LDIN, LPIN,-4, JBKDEC,3)
- LQ(LDIN-3) = LPIN
- IQ(LDIN+5) = IQ(LLD+5)
- IQ(LDIN+9) = -1
- LASTXQ = LDIN
-
-C-- match the inserted patch on OLD with the patch on NEW
-
- CALL DILINK (LPIN,LPN,1,-1)
-
-C-- shunt the trailing decks of the old to the inserted patch
-C-- break any match in the trailing decks
-
- LLN = LQ(LLD-1)
- IF (LLN.EQ.0) GO TO 62
-
- JSLN = IQ(LLN+7)
- JTXN = IQ(LLN+8)
-
- JSLF = IQ(LLP+7)
- JTXF = IQ(LLP+8)
-
- NSL1 = JSLN - JSLF
- NTX1 = JTXN - JTXF
-
- NSL2 = IQ(LLP+2) - NSL1
- NTX2 = IQ(LLP+3) - NTX1
-
- IQ(LLP+2) = NSL1
- IQ(LLP+3) = NTX1
-
- IQ(LPIN+1) = 0
- IF (IQ(LLP+1).NE.0) IQ(LPIN+1)= IQ(LLP+1) + NSL1
- IQ(LPIN+2) = NSL2
- IQ(LPIN+3) = NTX2
- IQ(LPIN+4) = IQ(LLP+4)
- IQ(LPIN+7) = JSLF + NSL1
- IQ(LPIN+8) = JTXF + NTX1
-
- IQ(LDIN+1) = IQ(LPIN+1)
- IQ(LDIN+7) = IQ(LPIN+7)
- IQ(LDIN+8) = IQ(LPIN+8)
-
- CALL QSHLIN (LLD-1, LDIN-1)
- CALL DINOUN (LLP)
-
- LD = LDIN
- 74 LD = LQ(LD-1)
- IF (LD.NE.0) THEN
- LQ(LD-3) = LPIN
- LM = LQ(LD-2)
- IF (LM.EQ.0) GO TO 74
- LQ(LD-2) = 0
- LQ(LM-2) = 0
- IQ(LM+5) = 0
- IQ(LM+9) = 0
- GO TO 74
- ENDIF
-
-C-- match the decks by name
-
- CALL DIMNAME (LPIN,LPN, 0, 1, IRC)
-
-C-- match the decks by content
-
- CALL DISAMD (LPIN,LPN)
- GO TO 63
-
- 87 CONTINUE
-+SELF, IF=XDEBUG, IF=XYDIFF.
- IF (NOP.EQ.0) RETURN
- WRITE (IQTYPE,9087) NOP
- 9087 FORMAT ('.End of execution in DINEWP with',I3,' new patches.')
- CALL DISNAP (3,1)
-+SELF.
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, DIMNAME.
- SUBROUTINE DIMNAME (LOLDUP,LNEWUP,LEVEL,IFLINK,IST)
-
-C- Match the dependent banks of the "old" structure LOLDUP to LNEWUP
-C- LEVEL = 0/1 dependent banks are decks/patches
-C- IFLINK = 0/1 do not/do link the matching banks
-C- return IST = 0 exact match
-C- >0 otherwise
-C- IQUEST(1) = number of matching banks
-C. started 3-june-94
-
-+CDE, QBITS19, Q, PY, ADDDI.
-C-------------- End CDE --------------------------------
- EQUIVALENCE (NLEN,IQUEST(1))
-
-+SEQ, Q_OR.
-
-
- NMATCH = 0
- ISTAT = 0
- LOLDF = LQ(LOLDUP-4)
- LOLDF = LQ(LOLDF-1)
- LOLD = LOLDF
-
- LNEWF = LQ(LNEWUP-4)
- LNEWF = LQ(LNEWF-1)
-
- IF (LOLDF+LNEWF.EQ.0) GO TO 37
- IF (LOLDF.NE.0) THEN
- IF (LNEWF.NE.0) GO TO 27
- ENDIF
- ISTAT = 1
- GO TO 39
-
-C-- match each as-yet unmatched bank of the OLD structure
-
- 24 CALL DIMSTR (LOLD, LNEWF, LEVEL, IFLINK, IRC)
- NMATCH = NMATCH + NLEN
- ISTAT = MAX (ISTAT,IRC)
-
- IF (IRC.LT.2) GO TO 31
-
- 26 LOLD = LQ(LOLD-1)
- IF (LOLD.EQ.0) GO TO 31
- 27 IF (LQ(LOLD-2).EQ.0) GO TO 24
- GO TO 26
-
-C-- end of OLD reached
-
- 31 IF (ISTAT.NE.0) GO TO 39
-
-C-- exact match of the whole structure
-
- 37 IF (IFLINK.EQ.0) GO TO 39
- IQ(LOLDUP) = IOR (IQ(LOLDUP),KM1+KM2+KM3)
- IQ(LNEWUP) = IOR (IQ(LNEWUP),KM1+KM2+KM3)
-
- 39 IQUEST(1) = NMATCH
- IST = ISTAT
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, DIMSTR.
- SUBROUTINE DIMSTR (LOLDF,LNEWF,LEVEL,IFLINK,IST)
-
-C- Find first match of bank at LOLDF in lin/st at LNEWF
-C- LEVEL = 0,1,2 for bank type DECK, PATCH, PAM
-C- IFLINK = 0/1 do not/do link the matching banks
-C- return IST = 0 exact match
-C- 1 all remain OLD banks have matched
-C- 2 more OLD banks to be tried
-C- IQUEST(1) = number of consecutive matching banks
-C. started 3-june-94
-
-+CDE, Q, PY, ADDDI.
-C-------------- End CDE --------------------------------
-
-
- LOLD = LOLDF
- LNEW = LNEWF
- IXNM = IQ(LOLD+4)
-
-C-- find the start of match
-
- NLEN = 0
- ISTAT = 0
- IF (LQ(LNEW-2).EQ.0 .AND. IQ(LNEW+4).EQ.IXNM) GO TO 31
-
- ISTAT = 2
- 24 LNEW = LQ(LNEW-1)
- IF (LNEW.EQ.0) GO TO 49
- IF (IQ(LNEW+4).NE.IXNM) GO TO 24
- IF (LQ(LNEW-2).NE.0) GO TO 24
-
-C-- find the length of the match
-
- 31 LOLDM = LOLD
- LNEWM = LNEW
- NLEN = 1
-
- 32 LOLD = LQ(LOLD-1)
- LNEW = LQ(LNEW-1)
- IF (LOLD.EQ.0) GO TO 41
- IF (LNEW.EQ.0) GO TO 42
-
- IF (IQ(LNEW+4).NE.IQ(LOLD+4)) GO TO 42
- IF (LQ(LNEW-2).NE.0) GO TO 42
- NLEN = NLEN + 1
- GO TO 32
-
-C-- store the match
-
- 41 ISTAT = MIN(1,ISTAT)
- IF (LNEW.NE.0) ISTAT= 1
- GO TO 43
-
- 42 ISTAT = 2
- 43 IF (IFLINK.EQ.0) GO TO 49
-
- CALL DILINK (LOLDM,LNEWM,LEVEL,NLEN)
-
- 49 IQUEST(1) = NLEN
- IST = ISTAT
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, DIORD.
- SUBROUTINE DIORD
-
-C- Prepare for the re-ordering to operate on "old" updated by
-C- the cradle generated by DICRAD to give "new"; this must
-C- be done before "lost" decks from foreign patches are linked.
-C. started 18-june-94
-
-+CDE, QUNIT, Q, PY.
-C-------------- End CDE --------------------------------
-
-
-C-- ordering the patches of this PAM
-
- LFI = LQUSER(2)
- CALL DIORDX (LFI)
-
- LPNEW = LFI - 3
- 24 LPNEW = LQ(LPNEW-1)
- IF (LPNEW.EQ.0) GO TO 27
- LPOLD = LQ(LPNEW-2)
- IF (LPOLD.EQ.0) GO TO 24
-
-C-- ordering the decks of this patch
-
- CALL DIORDX (LPNEW)
- GO TO 24
-
- 27 CONTINUE
-+SELF, IF=XDEBUG, IF=XYDIFF.
- WRITE (IQTYPE,9029)
- 9029 FORMAT (/'.End of execution in DIORD.')
- CALL DISNAP (3,1)
-+SELF.
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, DIORDX.
- SUBROUTINE DIORDX (LUP)
-
-C- Find and record the strings of contiguous matches
-C- (unmatched banks to not disturb the order)
-C. started 18-june-94
-
-+CDE, QBITS19, Q.
-C-------------- End CDE --------------------------------
-
-+SEQ, Q_AND, Q_OR.
-
-
- IF (IAND(IQ(LUP),KM3).NE.0) RETURN
- LNEW = LQ(LUP-4)
- NDIS = 0
-
-C---- start of a new string
-
- 22 LOLD = LQ(LNEW-2)
- LX = LOLD
- LN = LNEW
- NLEN = 0
-
-C-- step to next "new"
-
- 24 LN = LQ(LN-1)
- IF (LN.EQ.0) GO TO 27
- IF (LQ(LN-2).EQ.0) THEN
- IQ(LN+6) = 1
- NLEN = NLEN + 1
- GO TO 24
- ENDIF
-
-C-- step to next "old"
-
- 25 LX = LQ(LX-1)
- IF (LX.EQ.0) GO TO 27
- IF (LQ(LX-2).EQ.0) GO TO 25
- IF (LQ(LX-2).NE.LN) GO TO 27
-
-C-- string continues
-
- NLEN = NLEN + 1
- GO TO 24
-
-C---- end of this string
-
- 27 IQ(LNEW+9) = NLEN
- IF (LN.EQ.0) GO TO 29
- LNEW = LN
- NDIS = 7
- GO TO 22
-
-C---- finished
-
- 29 IF (NDIS.EQ.0) IQ(LUP)= IOR (IQ(LUP),KM3)
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, DILOST.
- SUBROUTINE DILOST
-
-C- Try to find unmatched decks by name+content in foreign patches:
-C- for each "old" patch which has unmatched decks, and which is
-C- matched as a patch with a patch on "new" (ie. which will not
-C- be USE-inhibited), look at its unmatched decks and try to find
-C- them as as-yet unmatched decks in other patches on "new".
-C. started 21-june-94
-
-+CDE, QBITS19, QUNIT, DIFFC.
-+CDE, Q, PY, ADDDI.
-C-------------- End CDE --------------------------------
-
-+SEQ, Q_AND, Q_OR.
-
-+SELF, IF=XDEBUG, IF=XYDIFF.
- WRITE (IQTYPE,9001)
- 9001 FORMAT (/'.Start finding lost decks in foreign patches')
-+SELF.
-
- LFX = LQUSER(1)
- LFN = LQUSER(2)
-
-C------ position to the next patch on OLD
-
- LPX = LQ(LFX-4)
- 22 LPX = LQ(LPX-1)
- IF (LPX.EQ.0) GO TO 68
- IF (IAND(IQ(LPX),KM2).NE.0) GO TO 22
-
- LPNM = LQ(LPX-2)
- IF (LPNM.EQ.0) GO TO 22
-
-C---- position to the next patch on NEW
-
- LPN = LQ(LFN-4)
- 24 LPN = LQ(LPN-1)
- IF (LPN.EQ.0) GO TO 22
- IF (IAND(IQ(LPN),KM2).NE.0) GO TO 24
- IF (LPN.EQ.LPNM) GO TO 24
-
-C-- try all "old" decks against all "new" decks of same name
-
- LDX = LQ(LPX-4)
- 42 LDX = LQ(LDX-1)
- IF (LDX.EQ.0) GO TO 24
- IF (LQ(LDX-2).NE.0) GO TO 42
-
- LDN = LQ(LPN-4)
- 44 LDN = LQ(LDN-1)
- IF (LDN.EQ.0) GO TO 42
- IF (LQ(LDN-2).NE.0) GO TO 44
- IF (IQ(LDN+4).NE.IQ(LDX+4)) GO TO 44
-
-C-- found a deck of the same name on "old" and "new",
-C-- verify that the contents match
-
- CALL DILOOK (LDX,LDN,0,LPX,LPN,8,60)
-
- IF (NFAID.LT.0) GO TO 42
- IF (NFAID.EQ.0) IQ(LDX+6)=4
-
- CALL DILINK (LDX, LDN, 0,1)
- IQ(LDN+6) = 4 + IQ(LPNM+4)
- IQ(LPN) = IOR (IQ(LPN),KM4)
-
- CALL DINOUN (LPX)
- CALL DINOUN (LPN)
- IF (IAND(IQ(LPX),KM2).NE.0) GO TO 22
- IF (IAND(IQ(LPN),KM2).NE.0) GO TO 24
- GO TO 42
-
-C-- done
-
- 68 CONTINUE
-+SELF, IF=XDEBUG, IF=XYDIFF.
- WRITE (IQTYPE,9068)
- 9068 FORMAT ('.End of execution in DILOST.')
- CALL DISNAP (3,0)
-+SELF.
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, DICRAD.
- SUBROUTINE DICRAD
-
-C- Write the Patchy update cradle
-C. started 6-june-94
-
-+CDE, SLATE, SLATLN, QBITS19, QUNIT, QSTATE.
-+CDE, FLINKC, LUNSLN.
-+CDE, Q, PY, ADDDI.
-+CDE, DIFFC.
-C-------------- End CDE --------------------------------
- CHARACTER LNDUP*80, LINE*128, COL(128)*1, MARK*4
- EQUIVALENCE (LNDUP,SLLINE), (LINE,SLERRM), (COL,SLERRM)
- DIMENSION MFAID(NSIZEQ)
- EQUIVALENCE (MFAID,IQ)
- LOGICAL ALSO, PRINT
-
- CHARACTER ACTION(3)*4
- DATA ACTION / '+DEL', '+REP', '+ADD' /
-
-+SEQ, Q_AND.
-
-
- ALSO = IQTYPE .NE. IQPRNT
- CALL DPBLAN (1)
-
- IF (IXLUN(3).EQ.0) THEN
- PRINT = .TRUE.
- ASSIGN 9008 TO IFMT
- LUNCRA = IQPRNT
- WRITE (IQPRNT,9002)
- GO TO 20
- ENDIF
-
- PRINT = .FALSE.
- ASSIGN 9009 TO IFMT
- LUNCRA = 21
- CALL FLINK (LUNCRA,5,IXLUN(3),0)
- WRITE (IQPRNT,9001) CHLIFI(1:NLIFI)
- IF (ALSO) WRITE (IQTYPE,9001) CHLIFI(1:NLIFI)
-
- 9001 FORMAT (' the Nypatchy update cradle goes to file ',A)
- 9002 FORMAT (' Here comes the Nypatchy update cradle:'/)
- 9004 FORMAT (A)
- 9005 FORMAT ('+nil. Attention: PAM structure changes !')
- 9008 FORMAT (3X,A,'.')
- 9009 FORMAT (A,'.')
-
-+SEQ, QEJECT.
-C---- Write the leading lines to the cradle
-
- LINE = 'update /1 ' // CQDATEM // ' ' // CQTIME
- + // ' from Nydiff'
- N = LENOCC (LINE)
- WRITE (LUNCRA,9004) LINE(1:N)
-
-C- _:.=+=.: 1_:.=+=.:_2
- LINE = '+nil. "old" was:'
- CALL LN_GET (JSLTTF(1),LINE(20:),40)
- N = LENOCC (LINE)
- WRITE (LUNCRA,9004) LINE(1:N)
-
- LINE = '+nil. "new" was:'
- CALL LN_GET (JSLTTF(2),LINE(20:),40)
- N = LENOCC (LINE)
- WRITE (LUNCRA,9004) LINE(1:N)
- IF (IFSTRUC.NE.0) WRITE (LUNCRA,9005)
-
- LINE = '+PATCH, UPD.'
- N = 12
- IF (IXLUN(3).GT.0) THEN
- CALL FLSPLIT (IXLUN(3),IXDIR,IXFN,IXEXT)
- IF (IXFN.GT.0) THEN
- CALL NA_GET (IXFN,LINE,9)
- N = NESLAT
- COL(N) = '.'
- ENDIF
- ENDIF
- WRITE (LUNCRA,9004) LINE(1:N)
-
-C-------- generate the +USE, T=INH lines for the "old" file ------
-
-C- _:.=+=.: 1_:.=+=.:_2
- 20 LINE = '+use, t=inh, p='
- JCOL = 16
-
- LFI = LQUSER(1)
- LP = LFI - 3
-
-C-- scan all patches
-
- 22 LP = LQ(LP-1)
- IF (LP.EQ.0) GO TO 27
- IF (IAND(IQ(LP),KM2).NE.0) GO TO 22
- CALL NA_GET (IQ(LP+4),LINE,JCOL)
- JCPE = NESLAT - 1
- IF (LQ(LP-2).NE.0) GO TO 24
- WRITE (LUNCRA,IFMT) LINE(1:JCPE)
- NLSENT = NLSENT + 1
- MDELADD(1,1) = MDELADD(1,1) + 1
- IF (IQ(LP+10).EQ.0) GO TO 22
-
- NQERR = NQERR + 1
- LNDUP = 'p='
- CALL NA_GET (IQ(LP+4),LNDUP,3)
- N = NESLAT
- WRITE (IQPRNT,9023) LNDUP(1:N)
- GO TO 22
-
- 9023 FORMAT (' ***!!! Error: deleting duplicate ',A,' !!!***')
-
-C-- scan all decks of this patch
-
- 24 LINE(JCPE+1:JCPE+4) = ', D='
- JCD = JCPE + 5
-
- LD = LQ(LP-4)
- 25 LD = LQ(LD-1)
- IF (LD.EQ.0) GO TO 22
- IF (LQ(LD-2).NE.0) GO TO 25
- CALL NA_GET (IQ(LD+4),LINE,JCD)
- WRITE (LUNCRA,IFMT) LINE(1:NESLAT-1)
- NLSENT = NLSENT + 1
- MDELADD(2,1) = MDELADD(2,1) + 1
- IF (IQ(LD+10).EQ.0) GO TO 25
-
- NQERR = NQERR + 1
- LNDUP = 'p='
- CALL NA_GET (IQ(LP+4),LNDUP,3)
- N = NESLAT
- LNDUP(N+1:N+2) = 'd='
- CALL NA_GET (IQ(LD+4),LNDUP,N+3)
- N = NESLAT
- WRITE (IQPRNT,9023) LNDUP(1:N)
- GO TO 25
-
- 27 IF (PRINT .AND. NLSENT.NE.0) CALL DPBLAN (-1)
-
-C-------- generate corrections for existing decks -------------
-
- LFI = LQUSER(2)
-
-C---- scan all patches
-
- LPN = LFI - 3
- 32 LPN = LQ(LPN-1)
- IF (LPN.EQ.0) GO TO 60
- LPX = LQ(LPN-2)
- IF (LPX.EQ.0) GO TO 32
- CALL DINEED (2,LPN)
-
-+SEQ, QEJECT.
-C---- scan all decks of this patch
-C-- first take only the decks of the matching patch
-
- IXPUSE = 0
- LDNEXT = 0
- LDN = LPN - 3
- 34 LDN = LQ(LDN-1)
- IF (LDN.EQ.0) GO TO 57
-
- LDX = LQ(LDN-2)
- IF (LDX.EQ.0) GO TO 34
- IF (IQ(LDX+2).LE.0) GO TO 34
-
-C-- check the deck is of foreign origin
- IF (IQ(LDN+6).GE.4) THEN
- LDNEXT = LDN
- GO TO 34
- ENDIF
-
-C-- skip if done
- IF (IQ(LDX+6).EQ.4) GO TO 34
-
-C---- compare the "new" deck to the "old"
-
- 41 IQ(LDX+6) = 4
- MARK = ' -> '
- CALL DINEED (1,LPX)
- CALL DIF_XQT (IQ(LDX+1),IQ(LDX+2), IQ(LDN+1),IQ(LDN+2),0)
- IF (NFAID.EQ.0) GO TO 49
-
- IF (IQ(LDX+10)+IQ(LDN+10) .NE.0) THEN
- CALL DIACERR (LDX,IFERR)
- IF (IFERR.NE.0) GO TO 49
- ENDIF
-
- IXP = IQ(LPX+4)
- IXD = IQ(LDX+4)
- LINE = '+xxx, '
- CALL NA_GET (IXP,LINE,7)
- JN = NESLAT
- COL(JN) = ','
- IF (IXD.EQ.0) THEN
- JN = JN + 1
- ELSE
- CALL NA_GET (IXD,LINE,JN+2)
- JN = NESLAT
- ENDIF
- COL(JN) = ','
- JPUT = JN + 2
-
- JFAID = JFAIDA
- 44 JCODE = MFAID(JFAID)
- JFGOX = MFAID(JFAID+1) - 1
- JFGON = MFAID(JFAID+2) - 1
- NLDEL = MFAID(JFAID+3)
- NLINS = MFAID(JFAID+4)
- IF (NLDEL+NLINS.EQ.0) GO TO 47
- LINE(1:4) = ACTION(JCODE+2)
- LINE(JPUT:JPUT+12) = ' '
-
- IF (JCODE.GT.0) THEN
- IF (JFGOX.EQ.0) THEN
- LINE(1:4) = '+ADB'
- ELSE
- JFGOX = JFGOX - 1
- ENDIF
- ENDIF
-
- CALL CSETDI (JFGOX, LINE,JPUT,JPUT+5)
- IF (NLDEL.GE.2) THEN
- COL(JPUT+6) = '-'
- CALL CSETDI (JFGOX+NLDEL-1, LINE,JPUT+7,JPUT+12)
- ENDIF
- CALL CLEFT (LINE,JPUT,JPUT+12)
- N = NESLAT - 1
-
- IF (PRINT) WRITE(IQPRNT,9004) MARK
- WRITE (LUNCRA,IFMT) LINE(1:N)
- NLSENT = NLSENT + 1
- IF (NLINS.NE.0) CALL DISEND (IQ(LDN+1)+JFGON, NLINS)
- MARK = ' > '
-
- 47 JFAID = JFAID + 5
- IF (JFAID.LT.JFAIDE) GO TO 44
- 49 IF (IXPUSE.EQ.0) GO TO 34
-
-C-- scanning foreign decks coming all from the same old patch
-
- 52 LDN = LQ(LDN-1)
- IF (LDN.EQ.0) GO TO 57
- LDX = LQ(LDN-2)
- IF (LDX.EQ.0) GO TO 52
- IF (IQ(LDX+6).EQ.4) GO TO 52
- IF (IQ(LDX+2).LE.0) GO TO 52
- IF (IQ(LDN+6).EQ.IXPUSE) GO TO 41
- LDNEXT = LDN
- GO TO 52
-
-C-- start scanning foreign decks coming from patch IXPUSE
-
- 57 IF (LDNEXT.EQ.0) GO TO 32
- LDN = LDNEXT
- LDX = LQ(LDN-2)
- LPX = LQ(LDX-3)
- IXPUSE = IQ(LDN+6)
- LDNEXT = 0
- LDN = LQ(LPN-4)
- GO TO 52
-
-+SEQ, QEJECT.
-C-------- add new patches or decks --------------------------
-
- 60 LFI = LQUSER(2)
-
-C---- scan all patches
-
- LPN = LFI - 3
- 62 LPN = LQ(LPN-1)
- IF (LPN.EQ.0) GO TO 87
- LPX = LQ(LPN-2)
- IF (LPX.EQ.0) GO TO 71
-
-C---- scan all decks of this patch
-
- LDN = LPN - 3
- 64 LDN = LQ(LDN-1)
- IF (LDN.EQ.0) GO TO 62
- LDX = LQ(LDN-2)
- IF (LDX.EQ.0) GO TO 72
- IF (IQ(LDX+9).LT.0) GO TO 72
-
-C-- check the deck is of foreign origin
- IF (IQ(LDN+6).GE.4) GO TO 64
-
-C-- remember this deck for adding to it
- LLD = LDX
- GO TO 64
-
-C-- this patch is new, generate a +ADD for it
-
- 71 LUSE = LPN
- J = 1
- GO TO 74
-
-C-- this deck is new, generate a +ADD for it
-
- 72 LUSE = LDN
- J = 2
- IF (IQ(LDN+4).EQ.0) J= 1
-
-C-- send the lines held by the bank at LUSE to the cradle
-
- 74 MDELADD(J,2) = MDELADD(J,2) + 1
- CALL DINEED (2,LPN)
- LLP = LQ(LLD-3)
- IXP = IQ(LLP+4)
- IXD = IQ(LLD+4)
- LINO = IQ(LLD+2)
-
- LINE = '+ADD, '
- CALL NA_GET (IXP,LINE,7)
- JN = NESLAT
- COL(JN) = ','
- IF (IXD.EQ.0) THEN
- JN = JN + 1
- ELSE
- CALL NA_GET (IXD,LINE,JN+2)
- JN = NESLAT
- ENDIF
- COL(JN) = ','
- JN = JN + 2
- CALL CSETDI (LINO, LINE,JN,JN+5)
- CALL CLEFT (LINE,JN,JN+5)
- N = NESLAT - 1
-
- MARK = ' -> '
- IF (PRINT) WRITE(IQPRNT,9004) MARK
- WRITE (LUNCRA,IFMT) LINE(1:N)
- NLSENT = NLSENT + 1
- CALL DISEND (IQ(LUSE+1),IQ(LUSE+2))
- IF (LPX.EQ.0) GO TO 62
- GO TO 64
-
-C---- Done
-
- 87 IF (PRINT .AND. NLSENT.NE.0) CALL DPBLAN (-1)
- WRITE (IQPRNT,9087) NLSENT
- IF (ALSO) WRITE (IQTYPE,9087) NLSENT
- WRITE (IQPRNT,9088) MDELADD
- IF (ALSO) WRITE (IQTYPE,9088) MDELADD
- 9087 FORMAT (' the Nypatchy update cradle has',I6,' active lines,')
- 9088 FORMAT (I6,' old patches,',I5,' old decks deleted,'
- F/ I6,' new patches,',I5,' new decks added.')
- NQLLBL = 0
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, DISEND.
- SUBROUTINE DISEND (JSLGO,NSL)
-
-C- Send the NSL lines at JSLGO to the cradle file
-C. started 6-june-94
-
-+CDE, SLATE, SLATLN, QUNIT, CCTYPE.
-+CDE, Q, PY, ADDDI.
-C-------------- End CDE --------------------------------
- CHARACTER LINE*512, COL(512)*1
- EQUIVALENCE (LINE,SLLINE), (COL,SLLINE)
-
-
- IF (LUNCRA.EQ.IQPRNT) THEN
- ASSIGN 9008 TO IFMT
- ELSE
- ASSIGN 9009 TO IFMT
- ENDIF
-
- 9008 FORMAT (3X,A)
- 9009 FORMAT (A)
-
- JSL = JSLGO
-
- DO 24 J=1,NSL
- CALL LN_GET (JSL,LINE,512)
- IF (NDSLAT.EQ.0) THEN
- WRITE (LUNCRA,9009)
- GO TO 24
- ENDIF
-
- IF (COL(1).NE.'+') GO TO 23
- JCCTYP = JPTYPE (LINE)
- IF (JCCTYP.LT.MCCSEL) GO TO 23
- COL(1) = '-'
-
- 23 WRITE (LUNCRA,IFMT) LINE(1:NDSLAT)
- 24 JSL = JSL + 1
- NLSENT = NLSENT + NSL
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, DIACERR.
- SUBROUTINE DIACERR (LOLD,IFERR)
-
-C- Action on duplicate deck
-C. started 3-june-94
-
-+CDE, SLATE, SLATLN, QUNIT, QSTATE.
-+CDE, Q.
-C-------------- End CDE --------------------------------
- CHARACTER LINE*128, COL(128)*1
- EQUIVALENCE (LINE,SLERRM), (COL,SLERRM)
-
-
- LDX = LOLD
- LDN = LQ(LDX-2)
- LPX = LQ(LDX-3)
- LPN = LQ(LDN-3)
-
- LINE = 'p='
- CALL NA_GET (IQ(LPX+4),LINE,3)
- N = NESLAT
- LINE(N+1:N+2) = 'd='
- N = N + 3
-
- CALL NA_GET (IQ(LDX+4),LINE,N)
- N = NESLAT
-
- NDX = IQ(LDX+10)
- NDN = IQ(LDN+10)
-
- IF (NDN.NE.NDX) GO TO 31
- IF (NDN.NE.1) GO TO 31
- IF (IQ(LPX+4).NE.IQ(LPN+4)) GO TO 31
-
- NQWARN = NQWARN
- WRITE (IQPRNT,9024) LINE(1:N)
- IFERR = 0
- RETURN
-
- 31 NQERR = NQERR
- WRITE (IQPRNT,9034) LINE(1:N)
- IFERR = 1
- RETURN
-
- 9024 FORMAT (' **!! Warn: Action on the first member of duplicate '
- F/16X,A,' !!**')
- 9034 FORMAT (' ***!!! Error: Action on a bad member of duplicate '
- F/16X,A,' !!!***')
- END
-+SEQ, QCARDL. =====================================================
-+DECK, DIWYLB.
- SUBROUTINE DIWYLB
-
-C- Make the Wylbur cradle
-C. started 6-june-94
-
-+CDE, SLATE, SLATLN, QBITS19, QUNIT, QSTATE.
-+CDE, FLINKC, LUNSLN.
-+CDE, Q, PY, ADDDI.
-C-------------- End CDE --------------------------------
- CHARACTER LINE*128, COL(128)*1
- EQUIVALENCE (LINE,SLERRM), (COL,SLERRM)
- LOGICAL ALSO, PRINT
-
-+SEQ, Q_AND.
-
-
- ALSO = IQTYPE .NE. IQPRNT
- CALL DPBLAN (1)
- NLSENT = 0
-
- IF (IXLUN(3).EQ.0) THEN
- PRINT = .TRUE.
- ASSIGN 9008 TO IFMT
- LUNCRA = IQPRNT
- WRITE (IQPRNT,9002)
- GO TO 20
- ENDIF
-
- CALL NA_GET (IXLUN(3),LINE,1)
- N = NDSLAT
- J = ICFILA ('.', LINE,1,N)
- LINE(J:J+4) = '.uexe'
- N = J + 4
- IXFLUN = NA_LONG (LINE(1:N))
-
- PRINT = .FALSE.
- ASSIGN 9009 TO IFMT
- LUNCRA = 21
- CALL FLINK (LUNCRA,5,-1,0)
- WRITE (IQPRNT,9001) CHLIFI(1:NLIFI)
- IF (ALSO) WRITE (IQTYPE,9001) CHLIFI(1:NLIFI)
-
- LINE = '# update Wylbur Exec ' // CQDATEM // ' ' // CQTIME
- N = LENOCC (LINE)
- WRITE (LUNCRA,9004) LINE(1:N)
-
-C- _:.=+=.: 1_:.=+=.:_2
- LINE = '# "old" was:'
- CALL LN_GET (JSLTTF(1),LINE(15:),40)
- N = LENOCC (LINE)
- WRITE (LUNCRA,9004) LINE(1:N)
-
- LINE = '# "new" was:'
- CALL LN_GET (JSLTTF(2),LINE(15:),40)
- N = LENOCC (LINE)
- WRITE (LUNCRA,9004) LINE(1:N)
-
- 9001 FORMAT (' the Wylbur update exec goes to file ',A)
- 9002 FORMAT (' Here comes the Wylbur update exec:')
- 9004 FORMAT (A)
- 9008 FORMAT (3X,A)
- 9009 FORMAT (A)
-
-+SEQ, QEJECT.
-C------ generate the re-ordering commands
-
- 20 LFI = LQUSER(2)
-
-C-- re-order the patches of this PAM
-
- IF (IAND(IQ(LFI),KM3).EQ.0) THEN
- CALL DIWYLR (LFI,1)
- ENDIF
-
-C-- scan all patches
-
- LP = LFI - 3
- 22 LP = LQ(LP-1)
- IF (LP.EQ.0) GO TO 27
- IF (IAND(IQ(LP),KM4).EQ.0) GO TO 26
-
-C-- foreign decks moved into this patch
-
- IXP = IQ(LP+4)
- LD = LQ(LP-4)
- 24 LL = LD
- LD = LQ(LL-1)
- IF (LD.EQ.0) GO TO 26
- IXPGET = IQ(LD+6) - 4
- IF (IXPGET.LT.0) GO TO 24
-
- IF (PRINT) WRITE (IQPRNT,9004)
- WRITE (LUNCRA,IFMT) '# fetch a lost child'
-
-C- _:.=+=.:_1
- LINE = 'range p='
- CALL NA_GET (IXP,LINE,9)
- JC = NESLAT
- LINE(JC:JC+2) = ',d='
- CALL NA_GET (IQ(LL+4),LINE,JC+3)
- WRITE (LUNCRA,IFMT) LINE(1:NESLAT-1)
-
-C- _:.=+=.:_1_:.=+=.:_2
- LINE = 'move,n,f |p='
- CALL NA_GET (IXPGET,LINE,16)
- JC = NESLAT
- LINE(JC:JC+2) = ',d='
- CALL NA_GET (IQ(LD+4),LINE,JC+3)
- WRITE (LUNCRA,IFMT) LINE(1:NESLAT-1)
-C! WRITE (LUNCRA,IFMT) 'num -nol'
- NLSENT = NLSENT + 3
- GO TO 24
-
- 26 IF (IAND(IQ(LP),KM3).NE.0) GO TO 22
- CALL DIWYLR (LP,0)
- GO TO 22
-
- 27 IF (PRINT .AND. NLSENT.NE.0) CALL DPBLAN (-1)
- WRITE (IQPRNT,9070) NLSENT
- IF (ALSO) WRITE (IQTYPE,9070) NLSENT
- 9070 FORMAT (' the Wylbur update exec has',I4,' active lines.')
- NQLLBL = 0
-
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, DIWYLR.
- SUBROUTINE DIWYLR (LUP,LEVEL)
-
-C- generate the Wylbur command to re-order
-C- LEVEL = 0: the decks of the patch at LUP
-C- 1: the patches of the PAM at LUP
-C. started 18-june-94
-
-+CDE, SLATE, SLATLN, QUNIT.
-+CDE, Q, PY, ADDDI.
-C-------------- End CDE --------------------------------
- CHARACTER LINE*512, COL(512)*1
- CHARACTER LONG*8192, LONC(8192)*1
- EQUIVALENCE (LINE,SLLINE), (COL,SLLINE)
- EQUIVALENCE (LONG,TEXT), (LONC,TEXT)
- CHARACTER EQU*3
- LOGICAL PRINT
-
-C- this is the maximum number of line-range elements on
-C- a command line which Wylbur can handle:
- PARAMETER (NSIZELI=20)
-
-
- EQU = ' d='
- IF (LEVEL.NE.0) EQU= ' p='
-
- 9001 FORMAT (A)
- 9002 FORMAT (3X,A)
-
- PRINT = LUNCRA.EQ.IQPRNT
- ASSIGN 9001 TO IFMT
- IF (PRINT) ASSIGN 9002 TO IFMT
-
-C---- look for the next re-ordering group
-
- LGO = LQ(LUP-4)
- 21 LGO = LQSTEP (LGO, IQ(LGO+9)+1)
- IF (LGO.EQ.0) RETURN
-
- LMIN = LGO
- LMAX = LGO
- JORD = IQ(LGO+5)
-
- MINCUR = JORD
- MAXCUR = JORD
-
-C-- scan starting from the string at LGO
-
- 23 MINORD = MINCUR
- MAXORD = MAXCUR
- LBK = LGO
-
-C-- find the last string with ordinal number < MAXORD
-
- 24 LBK = LQSTEP (LBK, IQ(LBK+9)+1)
- IF (LBK.EQ.0) GO TO 26
- JORD = IQ(LBK+5)
- IF (JORD.GE.MAXCUR) GO TO 24
- LLAST = LBK
- IF (JORD.GE.MINCUR) GO TO 24
- MINCUR = JORD
- LMIN = LBK
- GO TO 24
-
-C-- no re-ordering of string at LGO if no such string found
-
- 26 IF (LMIN.EQ.LGO) GO TO 21
- IF (MINCUR.EQ.MINORD) GO TO 41
-
-C-- find the string with the highest ordinal number in (LGO | LLAST)
-
- LBK = LGO
- 27 LBK = LQSTEP (LBK, IQ(LBK+9)+1)
- IF (LBK.EQ.LLAST) GO TO 29
- JORD = IQ(LBK+5)
- IF (JORD.LE.MAXCUR) GO TO 27
- MAXCUR = JORD
- LMAX = LBK
- GO TO 27
-
-C-- if the maximum has increased: scan again
-
- 29 IF (MAXCUR.NE.MAXORD) GO TO 23
-
-+SEQ, QEJECT.
-C---- found the re-ordering group from LGO to LLAST
-
-C-- construct: range p=pname,d=dfirst-dlast
-C-- or: range p=pfirst-plast
-
- 41 IXFI = IQ(LMIN+4)
- LBK = LQSTEP (LMAX,IQ(LMAX+9))
- IXLA = IQ(LBK+4)
- NLRE = 0
-
- IF (PRINT) WRITE (IQPRNT,9001)
- WRITE (LUNCRA,IFMT) '# change the order'
-
-C- _:.=+=.:_1
- LINE = 'range p='
- JPUT = 9
-
- IF (LEVEL.EQ.0) THEN
- CALL NA_GET (IQ(LUP+4),LINE,JPUT)
- JPUT = NESLAT
- LINE(JPUT:JPUT+2) = ',d='
- JPUT = JPUT + 3
- ENDIF
-
- CALL NA_GET (IXFI,LINE,JPUT)
- COL(NESLAT) = '-'
- JPUT = NESLAT + 1
- CALL NA_GET (IXLA,LINE,JPUT)
- NRANGE = NESLAT - 1
-
-C-- construct: move,o,n d=d1-d2 d=d3-d4 ... to f
-
-C- _:.=+=.:_1
- LONG(1:10) = 'move,o,n '
- JPUT = 10
- LBK = LGO
- 44 NLEN = IQ(LBK+9)
- IXFI = IQ(LBK+4)
- NLRE = NLRE + 1
-
- LONG(JPUT:JPUT+2) = EQU
- CALL NA_GET (IXFI,LONG,JPUT+3)
- JPUT = NESLAT
-
- LE = LBK
- IF (NLEN.NE.0) THEN
- LONC(JPUT) = '-'
- LE = LQSTEP (LE,NLEN)
- CALL NA_GET (IQ(LE+4),LONG,JPUT+1)
- JPUT = NESLAT
- ENDIF
- IF (LBK.EQ.LLAST) GO TO 47
- LBK = LQ(LE-1)
- GO TO 44
-
-C! 47 IF (JPUT.GT.25) GO TO 61
- 47 IF (JPUT.GT.250) GO TO 61
- IF (NLRE.GE.NSIZELI) GO TO 61
- LONG(JPUT:JPUT+4) = ' to f'
- NPUT = JPUT + 4
- WRITE (LUNCRA,IFMT) LINE(1:NRANGE)
- WRITE (LUNCRA,IFMT) LONG(1:NPUT)
- NLSENT = NLSENT + 2
- LGO = LLAST
- GO TO 21
-
-C-- resulting command line too long, operate in pieces
-
- 61 JEND = JPUT - 1
- WRITE (LUNCRA,IFMT) 'range'
- WRITE (LUNCRA,IFMT) 'end end-marker'
- WRITE (LUNCRA,IFMT) 'set val w11 *'
- WRITE (LUNCRA,IFMT) LINE(1:NRANGE)
- NLSENT = NLSENT + 4
-
- JTAK = 10
- 62 LINE = 'copy,n'
- JPUT = 8
- NLRE = 0
- 63 JTAK = ICNEXT (LONG,JTAK,JEND)
- N = NDSLAT
- IF (JPUT+N.GE.250) GO TO 64
- IF (NLRE+1.EQ.NSIZELI) GO TO 64
-
- NLRE = NLRE + 1
- LINE(JPUT:JPUT+N-1) = LONG(JTAK:JTAK+N-1)
- JTAK = JTAK + N + 1
- JPUT = JPUT + N + 1
- IF (JTAK.LT.JEND) GO TO 63
-
- 64 LINE(JPUT:JPUT+4) = 'to *+'
- NPUT = JPUT + 4
- WRITE (LUNCRA,IFMT) LINE(1:NPUT)
- NLSENT = NLSENT + 1
- IF (JTAK.LT.JEND) GO TO 62
-
- WRITE (LUNCRA,IFMT) 'set val w12 *'
- WRITE (LUNCRA,IFMT) 'copy,o,n :w11+/:w12 to f'
- WRITE (LUNCRA,IFMT) 'del -nol :w11/:w12'
- NLSENT = NLSENT + 3
- LGO = LLAST
- GO TO 21
-
- END
-+SEQ, QCARDL. =====================================================
-+DECK, DINEED.
- SUBROUTINE DINEED (JFILE,LPAT)
-
-C- The patch pointed to by LPAT from file JFILE is needed in memory
-C. started 15-june-94
-
-+CDE, MQCM, Q, PY, ADDDI.
-C-------------- End CDE --------------------------------
-
-
- IF (IQ(LPAT+1).NE.0) RETURN
- JFI = JFILE
- JDIV = 3 - JFI
- JDVN = JDIV + 1
-
- JSLLIM = LQLSTA(JDVN)
- JTXLIM = MLIAD(JSLLIM)
-
- NSLTAK = IQ(LPAT+2)
- NTXTAK = IQ(LPAT+3)
- IFLOOP = 0
-
- IF (NSLTAK.LE.0) THEN
- IQ(LPAT+1) = 1
- RETURN
- ENDIF
-
- 22 JSLGO = LQLEND(JDIV)
- JTXGO = MLIAD(JSLGO)
-
- IF (JSLGO+NSLTAK+2 .LT.JSLLIM) THEN
- IF (JTXGO+NTXTAK+2 .LT.JTXLIM) GO TO 24
- ENDIF
-
- IF (IFLOOP.NE.0) GO TO 91
- 23 IFLOOP = 7
-
- CALL DICLFI (LQUSER(JFI))
- LQLEND(JDIV) = LQLSTA(JDIV)
- GO TO 22
-
-C-- read the patch into memory
-
- 24 LARRV = LQARRV
- IF (JFI.EQ.2) LARRV= LQ(LARRV-1)
-
- CALL DINEIN (JSLGO,LPAT)
-
-C-- set the starting slot number of each deck
-
- IQ(LPAT+1) = JSLGO
- JSL = JSLGO
- LDK = LQ(LPAT-4)
- 27 IQ(LDK+1) = JSL
- JSL = JSL + IQ(LDK+2)
- LDK = LQ(LDK-1)
- IF (LDK.NE.0) GO TO 27
- LQLEND(JDIV) = JSL
-+SELF, IF=QDEBUG.
- JSLE = JSLGO + NSLTAK
- JTXE = JTXGO + NTXTAK
- IF (JSL.NE.JSLE) CALL P_CRASH ('Trouble in DINEED')
- IF (MLIAD(JSL).NE.JTXE) CALL P_CRASH ('Trouble in DINEED')
-+SELF.
- RETURN
-
-C-- trouble
-
- 91 CALL P_KILL ('Crash DINEED - large patch too big')
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, DINEINC, IF=QCIO.
-+SEQ, QCARD1, R=DINEIN
- SUBROUTINE DINEIN (JSLGO,LPAT)
-
-C- Read the patch pointed to by LPAT into memory starting at JSLGO
-C. started 21-june-94
-
-+CDE, ARRCOM, Q, PY.
-C-------------- End CDE --------------------------------
-+SELF, IF=XDEBUG, IF=XDINEED.
-+CDE, SLATE.
- CHARACTER LINE*32
-+SELF.
-
-
- IN_FD = IQ(LARRV+2)
-
-C-- position the file
-
- NSLSKI = IQ(LPAT+7)
- NTXSKI = IQ(LPAT+8)
-
- CALL CISEEK (IN_FD,NTXSKI,ISTAT)
- IF (ISTAT.NE.0) CALL P_KILLM ('CIO seek fails')
-
-C-- read the patch
-
- JSLA = JSLGO
- NSLN = IQ(LPAT+2)
- NTXN = IQ(LPAT+3)
- JTXA = MLIAD(JSLA)
-
- CALL CIGET (IN_FD,TEXT(JTXA),NTXN,NTXR,IN_EOF)
- IF (IN_EOF.NE.0) GO TO 93
-
- JTXE = JTXA + NTXR
- IF (ICHAR(TEXT(JTXE-1)) .NE. NEWLN) THEN
- TEXT(JTXE) = CHAR(NEWLN)
- JTXE = JTXE + 1
- NTXR = NTXR + 1
- ENDIF
-
- IF (NTXR.NE.NTXN) GO TO 92
-
-C-- construct the line directory
-
- JSLE = JSLA
-
- DO 26 JTXU=JTXA,JTXE-1
- IF (ICHAR(TEXT(JTXU)) .EQ. NEWLN) THEN
- JSLE = JSLE + 1
- MLIAD(JSLE) = JTXU + 1
- ENDIF
- 26 CONTINUE
- IF (JSLE.NE.JSLA+NSLN) GO TO 91
-+SELF, IF=XDEBUG, IF=XDINEED.
- CALL NA_GET (IQ(LPAT+4),LINE,1)
- PRINT 9826, LINE(1:NDSLAT),JSLA,JSLE,MLIAD(JSLA),MLIAD(JSLE)
- 9826 FORMAT (' -- load p=',A,' JSLA/JSLE=',2I6,' JTXA/JTXE=',2I8)
-+SELF.
- RETURN
-
- 91 CALL P_KILL ('Crash DINEIN: wrong number of lines')
- 92 CALL P_KILL ('Crash DINEIN: wrong number of characters')
- 93 CALL P_KILLM ('CIO read fails in DINEIN')
-
- END
-+SEQ, QCARDL. =====================================================
-+DECK, DINEINF, IF=QFIO.
-+SEQ, QCARD1, R=DINEIN
- SUBROUTINE DINEIN (JSLGO,LPAT)
-
-C- Read the patch pointed to by LPAT into memory starting at JSLGO
-C. started 21-june-94
-
-+CDE, ARRCOM, Q, PY.
-C-------------- End CDE --------------------------------
-
-
- IN_LUN = IQ(LARRV+1)
-
-C-- position the file
-
- NSLSKI = IQ(LPAT+7) - IQ(LARRV+9)
- IF (NSLSKI.LT.0) THEN
- REWIND IN_LUN
- IQ(LARRV+9) = 0
- NSLSKI = IQ(LPAT+7)
- ENDIF
-
- IF (NSLSKI.EQ.0) GO TO 24
-
- DO 23 J=1,NSLSKI
- READ (IN_LUN,'(A)',END=93)
- 23 CONTINUE
- IQ(LARRV+9) = IQ(LARRV+9) + NSLSKI
-
-C-- read the patch
-
- 24 NSLN = IQ(LPAT+2)
- NTXN = IQ(LPAT+3)
-
- JSL = JSLGO
- JSLE = JSLGO + NSLN
- JTX = MLIAD(JSL)
-
- DO 26 JSL=JSLGO,JSLE-1
- CALL ARRLN (IN_LUN,TEXT(JTX),NTX)
- IF (NTX.LT.0) GO TO 93
- JTX = JTX + NTX
- 26 MLIAD(JSL+1) = JTX
- IF (JTX-MLIAD(JSLGO).NE.NTXN) GO TO 92
-
- IQ(LARRV+9) = IQ(LARRV+9) + NSLN
- RETURN
-
- 92 CALL P_KILL ('Crash DINEIN: wrong number of characters')
- 93 CALL P_KILL ('Unexpected EoF in DINEIN')
-
- END
-+SEQ, QCARDL. =====================================================
-+DECK, DICLFI.
- SUBROUTINE DICLFI (LFI)
-
-C- Reset all banks of all PAMs as out-of-memory
-C. started 3-june-94
-
-+CDE, Q.
-C-------------- End CDE --------------------------------
-
-
-+SELF, IF=XDEBUG, IF=XYDIFF.
- PRINT *, ' !!!! DICLFI entered for ',LFI
-+SELF.
-
- LF = LFI
- LP = LQ(LF-4)
- 22 IF (LP.EQ.0) RETURN
- IF (IQ(LP+1).EQ.0) GO TO 26
-
- IQ(LP+1) = 0
- LD = LQ(LP-4)
- 24 IF (LD.EQ.0) GO TO 26
- IQ(LD+1) = 0
- LD = LQ(LD-1)
- GO TO 24
-
- 26 LP = LQ(LP-1)
- GO TO 22
- END
-+SEQ, QCARDL. =====================================================
-C! +SEQ, bkYDIFF, IF=DOC_INL.
-+DECK, DILINK.
- SUBROUTINE DILINK (LOLD,LNEW,LEVEL,NLEN)
-
-C- Link NLEN banks, at least one, starting with LOLD/LNEW
-C- LEVEL = 0,1,2 for bank type DECK, PATCH, PAM
-C- if NLEN < 0: do not count the match (for proxy)
-C. started 16-june-94
-
-+CDE, Q, PY, ADDDI.
-C-------------- End CDE --------------------------------
-
-
- LX = LOLD
- LN = LNEW
- LEV = LEVEL
- NDO = NLEN
-+SELF, IF=QDEBUG.
- IF ((LEV.GT.2) .OR. (LEV.LT.0))
- + CALL P_KILL ('LEVEL is faulty in DILINK')
-+SELF.
-
- 21 LQ(LX-2) = LN
- LQ(LN-2) = LX
- IQ(LN+5) = IQ(LX+5)
- IF (NDO.GT.0) NOBJMAT= NOBJMAT + 1
- NDO = NDO - 1
- IF (LEV.NE.0) GO TO 26
- 24 IF (NDO.LE.0) RETURN
- LX = LQ(LX-1)
- LN = LQ(LN-1)
- GO TO 21
-
-C-- if a PAT bank has been linked, link also it blank deck
-C-- (similarly for PAM bank)
-
- 26 LXX = LX
- LNN = LN
- LVX = LEV
- 27 LXX = LQ(LXX-4)
- LNN = LQ(LNN-4)
-
- LQ(LXX-2) = LNN
- LQ(LNN-2) = LXX
- LVX = LVX - 1
- IF (LVX.NE.0) GO TO 27
- GO TO 24
- END
-+SEQ, QCARDL. =====================================================
-+DECK, DILOOK.
- SUBROUTINE DILOOK (LDX,LDN,NBIAS,LPX,LPN,LOW,NPCENT)
-
-C- Check that the 2 objects at LDX and LDN are the same to NPCENT
-C. started 6-june-94
-
-+CDE, DIFFC.
-+CDE, Q, PY, ADDDI.
-C-------------- End CDE --------------------------------
-
-
- NSLX = IQ(LDX+2) - NBIAS
- NSLN = IQ(LDN+2) - NBIAS
-
- NSL1 = MIN (NSLX,NSLN)
- NSL2 = MAX (NSLX,NSLN)
- IF (2*NSL1.LT.NSL2) GO TO 29
-
- NSLM = NPCENT*NSL1 /100
- IF (NSLM.LT.2) GO TO 29
- IF (NSL1.NE.NSL2) THEN
- IF (NSLM.LT.LOW) GO TO 29
- ENDIF
-
- IF (IQ(LPX+1).EQ.0) CALL DINEED (1,LPX)
- IF (IQ(LPN+1).EQ.0) CALL DINEED (2,LPN)
-
- JSLX = IQ(LDX+1) + NBIAS
- JSLN = IQ(LDN+1) + NBIAS
-
- CALL DIF_XQT (JSLX,NSLX, JSLN,NSLN, NSLM)
-
- IF (NSLM.EQ.0) GO TO 29
- IF (NFAID.EQ.0) RETURN
- IF (NSLM.GE.LOW) RETURN
-
- 29 NFAID = -1
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, DINOUN.
- SUBROUTINE DINOUN (LUP)
-
-C- Check there are no unmatched banks depending on LUP left
-C. started 17-june-94
-
-+CDE, QBITS19, Q.
-C-------------- End CDE --------------------------------
-
-+SEQ, Q_AND, Q_OR.
-
-
- IF (IAND(IQ(LUP),KM2).NE.0) RETURN
-
- L = LQ(LUP-4)
- 24 L = LQ(L-1)
- IF (L.NE.0) THEN
- IF (LQ(L-2).EQ.0) RETURN
- GO TO 24
- ENDIF
-
- IQ(LUP) = IOR (IQ(LUP),KM2)
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+PATCH, DIF_XQT. Differencing subroutines
-+KEEP, DIFXC.
- PARAMETER (LGLIV=4, LGLIV2=8)
- COMMON /DIFXC/ JX_ORG, JY_ORG, NX_NLI, NY_NLI
- +, JX_FEND, JY_FEND, NLI_MAT
- +, JX_NTH, JX_JSL, JX_JTX, JX_NCH
- +, JY_NTH, JY_JSL, JY_JTX, JY_NCH
- +, LXV_FAI(LGLIV), LYV_FAI(LGLIV)
- +, LXV_SCA(LGLIV), LYV_SCA(LGLIV)
- +, LXV_MAT(LGLIV), LYV_MAT(LGLIV)
-+DECK, DOC, T=JOIN, IF=DOCUMENT, DOC_INL.
-+KEEP, xDIFXC. Difference processing, DIF_XQT and subsidiaries
-
-C- Parameters of the range for the "old" lines :
-
-C- JX_ORG slot number -1 of the first line of "old"
-C- NX_NLI total number of lines in range
-
-C- Parameters of the range for the "new" lines :
-
-C- JY_ORG slot number -1 of the first line of "new"
-C- NY_NLI total number of lines in range
-
-C- LGLIV=4 length of one line-vector JX_NTH, ...
-C- LGLIV2=8 length of the 2 contigous line-vetors JX_NTH / JY_NTH
-
-C- Parameters for the local matching process
-
-C- JX_FEND ordinal numbers of last lines of the
-C- JY_FEND current failure gap to be searched
-C- NLI_MAT length of the match found
-
-C- Line-vector of the current "old" line :
-
-C- JX_NTH ordinal number, = 1,2,...,NX_NLI
-C- JX_JSL JSL of current line
-C- JX_JTX JTX of current line
-C- JX_NCH number of characters in current line
-
-C- Line-vector of the current "new" line :
-
-C- JY_NTH, JY_JSL, JY_JTX, JY_NCH same
-
-C- Line-vectors of particular instances :
-
-C- LXV_FAI(LGLIV), LYV_FAI(LGLIV) start of current failure
-C- LXV_SCA(LGLIV), LYV_SCA(LGLIV) start of current scan
-C- LXV_MAT(LGLIV), LYV_MAT(LGLIV) start of match found
-
-+DECK, DIF_XQT.
- SUBROUTINE DIF_XQT (JSLX,NSLX, JSLY,NSLY, NQUICKP)
-
-C- Excute differencing,
-C- On entry:
-C- JSLX slot number in MLIAD of the first line on "old"
-C- NSLX number of lines on "old"
-C- JSLY, NSLY same for "new"
-C-
-C- NQUICK if not zero:
-C- quick test only to see if at least NQUICK lines do match,
-C- if not so: reset NQUICK to zero
-C- if so: leave NQUICK unchanged,
-C- return NFAID = 0: perfect match (identity)
-C- 1: good but not perfect
-
-C- On exit if NQUICK =zero on entry:
-C- Failure table in MFAID, from JFAIDA to JFAIDE-1,
-C- at the start of control division 2, NFAID entries;
-C- one entry of 5 words describes one failure :
-C-
-C- MFAID(JFAID + 0 : code -1 pure delete
-C- 0 delete / insert
-C- +1 pure insert
-C- + 1 : n of failure-start line for "old"
-C- + 2 : n of failure-start line for "new"
-C- + 3 : no. of lines deleted
-C- + 4 : no. of lines inserted
-
-C- Internal:
-C- Table of matching regions, one entry describes
-C- one set of matching lines:
-C-
-C- MGOOD(JGOOD + 0 : NM number of matching lines
-C- + 1 : JX ordinal number of first line on "old"
-C- + 2 : JY ... on "new"
-C-
-C- The first entry is at JGOOD = JGOODA
-C- the last entry is at JGOOD = JGOODE - 3
-
-+CDE, QUNIT, MQCM, Q, PY, DIFFC, DIFXC.
-C-------------- End CDE -------------------
- COMMON /SLATE/ NDSLAT,NESLAT,DUMMY(38)
-
- DIMENSION MGOOD(NSIZEQ), MHAVE(NSIZEQ), MFAID(NSIZEQ)
- EQUIVALENCE (MGOOD,IQ), (MHAVE,IQ), (MFAID,IQ)
-
-
- NQUICK = NQUICKP
- JX_ORG = JSLX - 1
- JY_ORG = JSLY - 1
-+SELF, IF=QDEBUG.
- IF (JX_ORG.LT.0 .OR. JY_ORG.LT.0)
- + CALL P_CRASH ('Faulty slot number in DIF_XQT')
-+SELF.
- NX_NLI = NSLX
- NY_NLI = NSLY
-
- LOWQ = LQCSTA(2)
- LIMQ = LQCSTA(3)
- JGOODA = LOWQ
- JHAVEE = LIMQ - 6
-
- JFAIDA = LOWQ
- JFAIDE = JFAIDA
- NFAID = 0
-
-+SELF, IF=XDEBUG, IF=XYDIFF.
-C WRITE (IQPRNT,9801) LIMQ-LOWQ, LOWQ, LIMQ
- 9801 FORMAT (/' Entry to DIF_XQT, table space of',I6,' words from',
- FI6,' to',I6)
-+SELF.
-+SEQ, QEJECT.
-C-------- Start, set up a first GOOD table -------
-
- CALL DIF_LX (1)
- CALL DIF_LY (1)
-
-C-- Walk along to find the first failure
-
- CALL DIF_HEAD
- IF (NDSLAT.EQ.2) RETURN
- NFAID = 1
-
- JGOOD = JGOODA
- NGOOD = JX_NTH - 1
- MGOOD(JGOOD) = NGOOD
- MGOOD(JGOOD+1) = 1
- MGOOD(JGOOD+2) = 1
- JGOOD = JGOOD + 3
-
- MGOOD(JGOOD) = 0
- MGOOD(JGOOD+1) = NX_NLI + 1
- MGOOD(JGOOD+2) = NY_NLI + 1
- JGOODE = JGOOD + 3
- IF (NDSLAT.NE.0) THEN
- NGOOD = NGOOD + 1
- MGOOD(JGOODA) = NGOOD
- JHAVEA = JHAVEE - 6
- CALL UCOPY (MGOOD(JGOODA),MHAVE(JHAVEA),6)
- GO TO 61
- ENDIF
-
- MAXGAP = MIN (NX_NLI-JX_NTH, NY_NLI-JY_NTH) + 1
- MIMAT = MIN (MAXGAP/2,128)
- MILILE = 14
- IFTAIL = 0
-
-C-------- Match, construct a new GOOD table --------------
-
- 21 IF (NQUICK.NE.0) THEN
- IF (NGOOD.GE.NQUICK) RETURN
- ENDIF
-
- MIMAT = MIN (MIMAT,MAXGAP)
- IF (MIMAT.GE.8) THEN
- MIMAT = MIMAT/2
- ELSE
- MIMAT = MIN(MIMAT,5) - 1
- ENDIF
-+SELF, IF=XDEBUG, IF=XYDIFFTB.
- WRITE (IQPRNT,9827)
- WRITE (IQPRNT,9828) ((J-JGOODA)/3,MGOOD(J+1),MGOOD(J+2),MGOOD(J),
- + MGOOD(J+1)+MGOOD(J) ,
- + MGOOD(J+2)+MGOOD(J) ,
- + MGOOD(J+4)-(MGOOD(J+1)+MGOOD(J)),
- + MGOOD(J+5)-(MGOOD(J+2)+MGOOD(J)),
- + J=JGOODA,JGOODE-4,3)
- J = JGOODE-3
- WRITE (IQPRNT,9828) (J-JGOODA)/3,MGOOD(J+1),MGOOD(J+2),MGOOD(J)
- IF (MIMAT.GE.0) WRITE (IQPRNT,9829) MAXGAP,MIMAT
- 9827 FORMAT (/
- F' GOOD table: jgX jgY Ng jfX jfY del ins')
- 9828 FORMAT (2X,3I8,I6,2I8,2I6)
- 9829 FORMAT (' Start iteration',19X,'Maxgap=',I6,' MIMAT=',I4)
-+SELF.
-
- NWD = JGOODE - JGOODA
- JHAVEA = JHAVEE - NWD
- IF (JHAVEA.GT.JGOODE) THEN
- CALL UCOPY (MGOOD(JGOODA),MHAVE(JHAVEA),NWD)
- ELSE
- CALL UCOPY2 (MGOOD(JGOODA),MHAVE(JHAVEA),NWD)
- ENDIF
- IF (MIMAT.LT.0) GO TO 61
-
- MAXGAP = 0
- NGOOD = 0
- JGOOD = JGOODA
- JHAVE = JHAVEA
- LMATX = 1
- LMATY = 1
- NMAT = MHAVE(JHAVE)
- JX_FEND = 0
- JY_FEND = 0
- GO TO 34
-
-+SEQ, QEJECT.
-C------ Scan all failure regions
-
-C-- No new match, use the next pre-established match
-
- 31 LMATX = JX_FEND+1
- LMATY = JY_FEND+1
- NMAT = MATAFT
-
-C-- Is this match an extension of the previous?
-
- 32 N = MGOOD(JGOOD-3)
- NFX = LMATX - (MGOOD(JGOOD-2)+N)
- NFY = LMATY - (MGOOD(JGOOD-1)+N)
- IF (NFX.NE.0) GO TO 33
- IF (NFY.NE.0) GO TO 33
- MGOOD(JGOOD-3) = N + NMAT
- NGOOD = NGOOD + NMAT
- GO TO 36
-
-C-- Record this match
-
- 33 MAXGAP = MAX (MAXGAP, MIN(NFX,NFY))
- IF (JGOOD+4.GE.JHAVEA) GO TO 60
- 34 MGOOD(JGOOD) = NMAT
- MGOOD(JGOOD+1) = LMATX
- MGOOD(JGOOD+2) = LMATY
- JGOOD = JGOOD + 3
- NGOOD = NGOOD + NMAT
-
- 36 LFAIX = LMATX + NMAT
- LFAIY = LMATY + NMAT
-
-C-- Moving into the next HAVE region?
-
- N = 0
- IF (LFAIX.GT.JX_FEND) N= 1
- IF (LFAIY.GT.JY_FEND) N= N+1
- IF (N.EQ.0) GO TO 37
- IF (N.EQ.1) GO TO 31
-
- JHAVE = JHAVE + 3
- IF (JHAVE.GE.JHAVEE) GO TO 49
- MATAFT = MHAVE(JHAVE)
- JX_FEND = MHAVE(JHAVE+1) - 1
- JY_FEND = MHAVE(JHAVE+2) - 1
-
-C-- Is the failure gap too small to contain a possible match,
-C-- or is it too big for small MIMAT ?
-
- 37 NFAIX = JX_FEND+1 - LFAIX
- NFAIY = JY_FEND+1 - LFAIY
- NGAP = MIN (NFAIX, NFAIY)
- IF (NGAP.LE.MIMAT) GO TO 31
-
- IF (MIMAT.LT.3) THEN
- NDIS = MAX (NFAIX, NFAIY) - NGAP
- N = 2*NDIS + NGAP
- IF (N.GE.24*(MIMAT+1)) GO TO 31
- ENDIF
-
-C-- Find match, if any, in this failure gap
-
- CALL DIF_LX (LFAIX)
- CALL DIF_LY (LFAIY)
- CALL DIF_FMAT (MILILE,MIMAT)
- IF (NLI_MAT.EQ.0) GO TO 31
- LMATX = LXV_MAT(1)
- LMATY = LYV_MAT(1)
- NMAT = NLI_MAT
-
-C-- Forward extension of imprecise match
-
- IF (MATAFT.LT.2) GO TO 32
- LNNX = LMATX + NMAT
- LNNY = LMATY + NMAT
- IF (LNNX.NE.JX_FEND+1) THEN
- IF (LNNY.NE.JY_FEND+1) GO TO 32
- ENDIF
- CALL DIF_SAME (LNNX,LNNY,IFSAME)
- IF (IFSAME.EQ.0) GO TO 32
-
- NLEXT = 0
- 42 NLEXT = NLEXT + 1
- IF (NLEXT.LT.MATAFT-1) THEN
- CALL DIF_NX
- CALL DIF_NY
- CALL DIF_SAME (JX_NTH, JY_NTH, IFSAME)
- IF (IFSAME.NE.0) GO TO 42
- ENDIF
- NMAT = NMAT + NLEXT
- JX_FEND = JX_FEND + NLEXT
- JY_FEND = JY_FEND + NLEXT
- MATAFT = MATAFT - NLEXT
- GO TO 32
-
-C-- End of this iteration
-
- 49 JGOODE = JGOOD
- IF (MIMAT.GT.9) GO TO 21
- IF (IFTAIL.NE.0) GO TO 21
- CALL DIF_TAIL (MGOOD(JGOODE-6))
- IFTAIL = 7
- GO TO 21
-
-+SEQ, QEJECT.
-C-------- Convert MHAVE table to MFAID table --------------
-
- 60 CONTINUE
-+SELF, IF=XDEBUG.
- WRITE (IQPRNT,9860) LIMQ-LOWQ
- 9860 FORMAT (/' Capacity exceeded in DIF_XQT, table space',I6,' words')
-+SELF.
- 61 IF (NQUICK.NE.0) THEN
- IF (NGOOD.LT.NQUICK) NQUICKP= 0
- RETURN
- ENDIF
-
- JHAVEE = JHAVEE - 3
-
- JHAVE = JHAVEA
- JFAID = JFAIDA
- 64 JCODE = 0
- NMAT = MHAVE(JHAVE)
- JFGOX = MHAVE(JHAVE+1) + NMAT
- JFGOY = MHAVE(JHAVE+2) + NMAT
- NLDEL = MHAVE(JHAVE+4) - JFGOX
- NLINS = MHAVE(JHAVE+5) - JFGOY
-
- IF (NLINS.EQ.0) THEN
- JCODE = -1
- ELSE
- IF (NLDEL.EQ.0) JCODE= 1
- ENDIF
-
- MFAID(JFAID) = JCODE
- MFAID(JFAID+1) = JFGOX
- MFAID(JFAID+2) = JFGOY
- MFAID(JFAID+3) = NLDEL
- MFAID(JFAID+4) = NLINS
- JFAID = JFAID + 5
- JHAVE = JHAVE + 3
- IF (JHAVE.LT.JHAVEE) GO TO 64
- JFAIDE = JFAID
- NFAID = (JFAIDE-JFAIDA) /5
-
-+SELF, IF=XDEBUG, IF=XYDIFFTB.
- WRITE (IQPRNT,9878)
- WRITE (IQPRNT,9879) ((J-JFAIDA)/5,MFAID(J),MFAID(J+1),MFAID(J+2),
- + MFAID(J+3),MFAID(J+4),J=JFAIDA,JFAIDE-1,5)
- 9878 FORMAT (/' Failure table:'/
- F' code jfX jfY del ins')
- 9879 FORMAT (I8,I5,2I8,2I6)
-+SELF.
- IF (JFAIDE.GT.LIMQ) CALL P_KILL ('Capacity exceeded')
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, DIF_HEAD.
- SUBROUTINE DIF_HEAD
-
-C- Find first failure between the two sets
-C- return NDSLAT = 0 failure found, the line vectors are positioned
-C- to the start of the failure
-C- 1 end of one of the sets found, the line vectors
-C- are positioned to the last matching line
-C- 2 the two sets are identical
-
-+CDE, Q, DIFXC.
-C-------------- End CDE -------------------
- COMMON /SLATE/ NDSLAT,NESLAT,DUMMY(38)
- LOGICAL LN_EQU
-
-
- NDSLAT = 0
- 21 IF (JX_NCH.NE.JY_NCH) GO TO 29
- IF (JX_NCH.EQ.0) GO TO 22
- IF (.NOT.LN_EQU(TEXT(JX_JTX), TEXT(JY_JTX), JX_NCH)) GO TO 29
-
- 22 IF (JX_NTH.EQ.NX_NLI) GO TO 27
- IF (JY_NTH.EQ.NY_NLI) GO TO 28
- CALL DIF_NX
- CALL DIF_NY
- GO TO 21
-
- 27 NDSLAT = 1
- IF (JY_NTH.NE.NY_NLI) GO TO 29
- 28 NDSLAT = NDSLAT + 1
- 29 RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, DIF_TAIL, T=JOIN.
- SUBROUTINE DIF_TAIL (MGOOD)
-
-C- Check whether the very last lines of the 2 ranges match,
-C- on entry: MGOOD with the last 2 entries of the GOOD table
-C- on exit: MGOOD updated
-
-+CDE, DIFXC.
-C-------------- End CDE -------------------
- DIMENSION MGOOD(6)
-
-
- IF (MGOOD(4).NE.0) RETURN
- NMAT = MGOOD(1)
- NLDEL = MGOOD(5) - (MGOOD(2) + NMAT)
- NLINS = MGOOD(6) - (MGOOD(3) + NMAT)
- NPOSS = MIN (NLDEL,NLINS)
- IF (NPOSS.EQ.0) RETURN
-
- CALL DIF_LX (NX_NLI)
- CALL DIF_LY (NY_NLI)
- CALL DIF_BACK (NPOSS,NMAT)
- IF (NMAT.EQ.0) RETURN
- MGOOD(4) = NMAT
- MGOOD(5) = JX_NTH
- MGOOD(6) = JY_NTH
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, DIF_FMAT.
- SUBROUTINE DIF_FMAT (MILILE, MIMATP)
-
-C- Find next matching lines, at leat MIMAT+1 lines
-C- with a length of MILILE or more columns
-
-C- On input: old/new JX_/JY_NTH positioned to the start of failure
-C- JX_FEND/Y last possible failing line
-
-C- On output: LXV_FAI/_YFAI param. of the start lines of failure
-C- LXV_MAT/_YMAT param. of the start lines of match
-C- NLI_MAT the length of this match,
-C- =0 : no match found
-
-+CDE, Q, DIFXC.
-C-------------- End CDE -------------------
- LOGICAL LN_EQU
-
-
- CALL UCOPY (JX_NTH, LXV_FAI, LGLIV2)
- MILENGO = MILILE
- MIMAT = MIMATP
- MILENCO = MIN (MILENGO,9)
- NLI_MAT = 0
- GO TO 16
-
-C-- Step to first possible start lines
-
- 15 IF (JX_NTH.GE.JX_FEND) GO TO 81
- CALL DIF_NX
- 16 IF (JX_NCH.LT.MILENGO) GO TO 15
- GO TO 18
-
- 17 IF (JY_NTH.GE.JY_FEND) GO TO 81
- CALL DIF_NY
- 18 IF (JY_NCH.LT.MILENGO) GO TO 17
-
- CALL UCOPY (JX_NTH, LXV_SCA, LGLIV2)
-
- JHALTX = JX_FEND - MIMAT
- JHALTY = JY_FEND - MIMAT
- IF (JX_NTH.GT.JHALTX) GO TO 81
- IF (JY_NTH.GT.JHALTY) GO TO 81
-
- JENDY = JY_NTH
- GO TO 22
-
-+SEQ, QEJECT.
-C---- Next X line, compare against Y lines so far
-
- 21 IF (JENDX.EQ.JHALTX) GO TO 31
- CALL DIF_NX
- 22 JENDX = JX_NTH
- NCH = JX_NCH
- IF (NCH.LT.MILENGO) GO TO 31
-
- CALL UCOPY (LYV_SCA, JY_NTH, LGLIV)
- GO TO 25
-
- 24 IF (JY_NTH.EQ.JENDY) GO TO 31
- CALL DIF_NY
-
- 25 IF (JY_NCH.NE.NCH) GO TO 24
- IF (.NOT.LN_EQU(TEXT(JY_JTX),TEXT(JX_JTX),NCH)) GO TO 24
- GO TO 41
-
-C---- Next Y line, compare against X lines so far
-
- 31 IF (JENDY.EQ.JHALTY) THEN
- IF (JENDX.NE.JHALTX) GO TO 21
- GO TO 81
- ENDIF
- CALL DIF_NY
- JENDY = JY_NTH
- NCH = JY_NCH
- IF (NCH.LT.MILENGO) GO TO 21
-
- CALL UCOPY (LXV_SCA, JX_NTH, LGLIV)
- GO TO 35
-
- 34 IF (JX_NTH.EQ.JENDX) GO TO 21
- CALL DIF_NX
-
- 35 IF (JX_NCH.NE.NCH) GO TO 34
- IF (.NOT.LN_EQU(TEXT(JX_JTX),TEXT(JY_JTX),NCH)) GO TO 34
-
-C-- Found first line of possible match
-
- 41 CALL UCOPY (JX_NTH, LXV_MAT, LGLIV2)
- NEXMAT = 0
- NSAME = 0
- 42 NSAME = NSAME + 1
- IF (JX_NTH.EQ.JX_FEND) GO TO 46
- IF (JY_NTH.EQ.JY_FEND) GO TO 46
- CALL DIF_NX
- CALL DIF_NY
- N = JX_NCH
- IF (JY_NCH.NE.N) GO TO 46
- IF (N.EQ.0) GO TO 42
- IF (.NOT.LN_EQU(TEXT(JX_JTX),TEXT(JY_JTX),N)) GO TO 46
- IF (N.LT.MILENCO) GO TO 42
- NEXMAT = NEXMAT + 1
- GO TO 42
-
-C-- Is the match is long enough ?
-
- 46 IF (NEXMAT.GE.MIMAT) GO TO 51
- CALL DIF_LX (LXV_MAT(1) + NSAME -1)
- CALL DIF_LY (LYV_MAT(1) + NSAME -1)
- JENDX = MIN (MAX(JENDX,JX_NTH), JHALTX)
- JENDY = MIN (MAX(JENDY,JY_NTH), JHALTY)
- IF (JY_NTH.LT.JENDY) GO TO 24
- IF (JX_NTH.LT.JENDX) GO TO 34
- GO TO 21
-
-C---- Match found
-
- 51 NLI_MAT = NSAME
-
-C-- Find identical short lines in front
-
- NPOSS = MIN (LXV_MAT(1)-LXV_FAI(1)
- +, LYV_MAT(1)-LYV_FAI(1))
- IF (NPOSS.LE.0) GO TO 87
-
- CALL UCOPY (LXV_MAT, JX_NTH, LGLIV2)
- CALL DIF_LX (JX_NTH-1)
- CALL DIF_LY (JY_NTH-1)
- CALL DIF_BACK (NPOSS,NPRE)
- IF (NPRE.NE.0) CALL UCOPY (JX_NTH, LXV_MAT, LGLIV2)
- NLI_MAT = NLI_MAT + NPRE
-
-C---- No match in the region
-
- 81 CONTINUE
- 87 RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, DIF_BACK.
- SUBROUTINE DIF_BACK (NPOSSP,NMATP)
-
-C- Compare backwards the NPOSS > 0 lines from the current
-C- On entry: line vectors positioned to the first line to be checked
-C- On return: NMAT > 0 the number of matching lines found,
-C- line vectors positioned to the first
-C- line of the match
-C- NMAT = 0 no match, line vectors unchanged
-
-+CDE, DIFXC.
-C-------------- End CDE -------------------
-
-
- NPOSS = NPOSSP
- NMAT = 0
- CALL DIF_SAME (JX_NTH, JY_NTH, IFSAME)
- IF (IFSAME.EQ.0) GO TO 28
-
-C-- Current lines match
-
- 24 NMAT = NMAT + 1
- NPOSS = NPOSS - 1
- IF (NPOSS.EQ.0) GO TO 28
-
-C-- How about the previous?
-
- CALL DIF_SAME (JX_NTH-1, JY_NTH-1, IFSAME)
- IF (IFSAME.NE.0) GO TO 24
-
-C-- Not equal, position to start of match
-
- CALL DIF_NX
- CALL DIF_NY
- 28 NMATP = NMAT
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, DIF_SAME, T=JOIN.
- SUBROUTINE DIF_SAME (NTHX,NTHY,NMAT)
-
-C- Compare the 2 lines NTHX and NTHY,
-C- return: NMAT = 0/1 for no/yes
-
-+CDE, Q, DIFXC.
-C-------------- End CDE -------------------
- LOGICAL LN_EQU
-
-
- IF (JX_NTH.NE.NTHX) CALL DIF_LX (NTHX)
- IF (JY_NTH.NE.NTHY) CALL DIF_LY (NTHY)
-
- N = JX_NCH
- IF (JY_NCH.EQ.N) THEN
- IF (N.EQ.0) GO TO 24
- IF (LN_EQU(TEXT(JX_JTX),TEXT(JY_JTX),N)) GO TO 24
- ENDIF
- NMAT = 0
- RETURN
-
- 24 NMAT = 1
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, DIF_LX.
- SUBROUTINE DIF_LX (LNO)
-
-C- Set the current to be ordinal line number LNO,
-C- but not beyond the last line NX_NLI
-
-+CDE, Q, DIFXC.
-C-------------- End CDE -------------------
-
-
- JX_NTH = MIN (LNO, NX_NLI)
- JX_JSL = JX_NTH + JX_ORG
- JX_JTX = MLIAD(JX_JSL)
- JX_NCH = MLIAD(JX_JSL+1) - JX_JTX - NCHNEWL
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, DIF_LY, T=JOIN.
- SUBROUTINE DIF_LY (LNO)
-
-C- Set the current to be ordinal line number LNO,
-C- but not beyond the last line NY_NLI
-
-+CDE, Q, DIFXC.
-C-------------- End CDE -------------------
-
-
- JY_NTH = MIN (LNO, NY_NLI)
- JY_JSL = JY_NTH + JY_ORG
- JY_JTX = MLIAD(JY_JSL)
- JY_NCH = MLIAD(JY_JSL+1) - JY_JTX - NCHNEWL
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, DIF_NX.
- SUBROUTINE DIF_NX
-
-C- Step the current line on "old" by +1
-
-+CDE, Q, DIFXC.
-C-------------- End CDE -------------------
-
-
- JX_NTH = JX_NTH + 1
- JX_JSL = JX_NTH + JX_ORG
- JX_JTX = MLIAD(JX_JSL)
- JX_NCH = MLIAD(JX_JSL+1) - JX_JTX - NCHNEWL
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, DIF_NY, T=JOIN.
- SUBROUTINE DIF_NY
-
-C- Step the current line on "new" by +1
-
-+CDE, Q, DIFXC.
-C-------------- End CDE -------------------
-
-
- JY_NTH = JY_NTH + 1
- JY_JSL = JY_NTH + JY_ORG
- JY_JTX = MLIAD(JY_JSL)
- JY_NCH = MLIAD(JY_JSL+1) - JY_JTX - NCHNEWL
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+PATCH, YSHELL. for program Nyshell
-+USE, AUXSM.
-+SELF. +DIVERT, AUXSM, D=SMRXQT. !!!! to test Nyshell
-+SELF. +DIVERT, AUXSM, D=SMCODE.
-+KEEP, SHMKC.
- PARAMETER (NTYSZ=4, NACSZ=4, NLNSZ=4, NRTSZ=10000)
- CHARACTER CHNLOG*80, CODEX*8, CHTYP*8
- COMMON /SHMKC/ NNLOG,CHNLOG, CODEX, CHTYP(17)
-+KEEP, ADDSH.
- +, NLINST(4,NACSZ,NTYSZ), IXINST(NLNSZ,4,NACSZ,NTYSZ)
- +, NCOUNTR(4,NTYSZ), NCSUMR(NTYSZ)
- +, NCOUNTH(4,NTYSZ), NCSUMH(NTYSZ), IXOPTN(4,3), IXOPTP(4,3)
- +, NRXQT, NROUT, NNAME(NRTSZ), NRALLC, NRDEL
- +, LUNSH, IXOBJ, IXSDIR, JXTYP, JXACT, JXSTR, LASTSH
-+DECK, DOC, T=JOIN, IF=DOCUMENT, DOC_INL.
-+KEEP, xADDSH.
-C-- Parameters of NYSHELL
-C- NTYSZ=4 dimensions of IXINST
-C- NACSZ=4
-C- NLNSZ=4
-C-
-C- NRTSZ=10000 dimension of NNAME
-C-
-C- NNLOG number of significant characters in CHNLOG
-C- CHNLOG file-name part of the input file
-C- CODEX last code like "fort:3" analysed by SMCODE
-C- CHTYP(17) list of type-codes, see SMCODE
-C-
-C- NLINST(4,NACSZ,NTYSZ) number of lines in each item
-C- IXINST(NLNSZ,4,NACSZ,NTYSZ) set-up description
-C-
-C: IXINST(JLINE,JSTR,JACT,JTYP) IX of one compile-instruction line
-C-
-C- JTYP= 1 fortran, 2 C, 3 assembler, 4 start/end
-C-
-C- JACT= 1 for fo:i, co:i, ao:i, start:i specific options
-C- 2 for fopt, copt, aopt, start common options
-C- 3 for fc, cc, as, end: compiler name
-C- 4 for fort:i, cc:i, as:i, end command line
-C-
-C- JSTR= i of fo:i, co:i, ..., fort:i, cc:i, etc
-C-
-C- JLINE= 1, 2, ..., NLINST(JSTR,JACT,JTYP)
-C-
-C- IXOPTN(JSTR,JTYP) joined compiler options for this run
-C- IXOPTP(JSTR,JTYP) joined compiler options from .xqtlog
-C-
-C- NCOUNTR(4,NTYSZ) count number of routines to be compiled per stream
-C- NCSUMR(NTYSZ) count number of routines to be compiled per type
-C-
-C- NCOUNTH(4,NTYSZ) count number of routines seen per stream
-C- NCSUMH(NTYSZ) count number of routines seen per type
-C-
-C- NRXQT number of routines from .xqtlog in store
-C- NROUT number of routines in store
-C- J = 1,NRXQT routines from .xqtlog
-C- J = NRXQT+1,NROUT routines from .log
-C- NNAME(NRTSZ) routine descriptors:
-C-
-C: NNAME(JR) = ((IXNAME*8 + JTYP)*8 + JSTR)*4 + IFLNEW
-C-
-C- IXNAME index of the routine name
-C- JTYP routine type: Fortran, C, AS
-C- JSTR stream: 1 normal/normal
-C- 2 normal/divert
-C- 3 extra/normal
-C- 4 extra/divert
-C- IFLNEW has bit 2 set if current .o file valid
-C- bit 1 set if recompilation forced
-C-
-C- NRALLC number of routines to be compiled
-C- NRDEL number of .o files deleted by SHUPTO
-C- LUNSH logical unit number for writing xxx.shfca
-C- IXOBJ IX of the .o file extension,
-C- ".o" on UNIX, ".OBJ" on VAX
-C- IXSDIR IX of the source-files directory
-C-
-C- JXTYP type, action, stream of CODEX cracked by SMCODE
-C- JXACT
-C- JXSTR
-C-
-C- LASTSH last word for use with INIAUX/MQWORK
-+DECK, NSHELL.
- PROGRAM NSHELL
-
-+SELF, IF=QDIAG, IF=QS_UNIX.
- EXTERNAL SEGVIOL
-+SELF.
-
-+SEQ, NCNAME.
- PARAMETER (NFILES=4)
- CHARACTER NAME(NFILES)*(NCNAME)
-
-
- DATA NAME/ 'LOG .log 9 2 0 !ff'
- +, 'opt 3 11 0 !ff'
- +, 'read .cra 1 1 2 !ff'
- +, 'print .lis 2 4 0 !ff' /
-C- _:.=+=.:_1_:.=+=.:_2_:.=+=.:_3_:
-C- (1) (2) (3)
-
-C- (1) LUNUSE = 1 read, 2 print,
-C- 3 option, 4 cch subst, >4 file
-
-C- (2) LUNDES = 1 cradle input
-C- 2 PAM input
-C- 4 printed output
-C- 5 Fortran output
-C- 6 ASM output write-only (T=ATT)
-C- 7 ASM input-output (T=MODIF)
-C- 11 option parameter
-C- 12 control-character substitution parameter
-
-C- (3) LUNFLG = 0/>0 parameter value EOF not/yes allowed
-C- 2 the cradle file need not exist
-
-+SELF, IF=QS_IBMVM.
- NAME(4)(9:16) = '.listing'
-+SELF.
-
- CALL MQINIT
-
- CALL FLPARA (NFILES,NAME,
- + 'Nyshell All, By, Empty, Help, Quick, HSetup, Uptodate, Verbose')
-
-+SELF, IF=QDIAG, IF=QS_UNIX.
- CALL SIGNALF (11, SEGVIOL, -1)
-+SELF.
- CALL EXSHELL
-
-+SEQ, PGMSTOP, T=PASS.
- END
-+SEQ, QCARDL. =====================================================
-+DECK, EXSHELL.
- SUBROUTINE EXSHELL
-
-C- Run nyshell
-C. started 20-jan-94
-
-+CDE, SLATE, QBITA31, QUNIT.
-+CDE, LUNSLN, FLINKC.
-+CDE, SHMKC, Q, PY, ADDSH.
-C-------------- End CDE --------------------------------
- CHARACTER CHFSH*64, CHFIN*128, CHNAME*32, CHDO*2
- PARAMETER (MASK= KMA + KMB + KME + KMH + KMQ + KMS + KMU + KMV)
-
-+SEQ, Q_AND, Q_SHIFTR.
-
-
- CALL INIAUX (LASTSH)
- CALL KROPT (IXLUN(2),MASK)
-
- MOPTIO(2) = MAX (MOPTIO(1), MOPTIO(2))
-+SELF, IF=TRANSIT.
- MOPTIO(5) = 1
-+SELF.
-
- IXFILE = IXLUN(1)
- IF (IXFILE.LE.0) IXFILE = NA_LONG (' f.e')
- CALL FLSPLIT (IXFILE, IXSDIR, IXSFN, IXSEXT)
-
- CHNLOG = ' '
- CALL NA_GET (IXSFN,CHNLOG,1)
- NNLOG = NDSLAT
-
- CHFIN = ' '
- CALL NA_GET (IXFILE,CHFIN,1)
- NCHFIN = NDSLAT
- IF (MOPTIO(8).NE.0) IXLUN(1) = -7
-
-+SEQ, QEJECT.
-C---- Load the defaults
-
- CALL SMDEF
-
-+SELF, IF=QS_UNIX.
- CALL SMCIL (-1, 'start' , '# Script from nyshell for file '
- + // CHFIN(1:NCHFIN))
- CALL SMCIL (-1, 'end' , '# End of the shell script')
-+SELF, IF=QS_VMS.
- CALL SMCIL (-1, 'start', '$! shfca:')
- CALL SMCIL (0, ' ',
- + '$ proc_ver = f$environment("verify_procedure")')
- CALL SMCIL (0, ' ',
- + '$ imag_ver = f$environment("verify_image")')
- CALL SMCIL (0, ' ', '$ set verify=(procedure,noimage)')
- CALL SMCIL (-1, 'end', '$ temp=f$verify(proc_ver,imag_ver)')
-+SELF.
-
-C---- Load the compile-instructions from the cradle
-
- IF (IQREAD.NE.0) CALL SMCINST
- IF (IQREAD.LT.0) IXLUN(1)= -1
-
-C---- Pre-delete the script yyy.shfca
-
-+SELF, IF=QS_IBMVM.
- CHFSH = CHNLOG(1:NNLOG) // '.exec'
- NCHFSH = NNLOG + 5
-+SELF, IF=-QS_IBMVM.
- CHFSH = CHNLOG(1:NNLOG) // '.shfca'
- NCHFSH = NNLOG + 6
-+SELF.
-
- LUNSH = 21
- CHLIFI = CHFSH(1:NCHFSH)
- NLIFI = NCHFSH
- CALL FLINK (LUNSH, -1, 0, 0)
-
-C---- Print the Help information
-
- IF (IXLUN(1).LE.0) THEN
- IF (MOPTIO(19).EQ.0) THEN
- WRITE (IQPRNT,9002)
- WRITE (IQPRNT,9003)
- WRITE (IQPRNT,9004)
- WRITE (IQPRNT,9005)
- WRITE (IQPRNT,9006)
- WRITE (IQPRNT,9007)
- ENDIF
- MOPTIO(17) = 0
- MOPTIO(22) = 1
- ENDIF
-
-C---- Print the run information
-
- WRITE (IQPRNT,9026) CHFIN(1:NCHFIN), CHFSH(1:NCHFSH)
- +, CHNLOG(1:NNLOG)
- 9026 FORMAT (' Input file: ',A
- F/ ' Shell script: ',A
- F/ ' Log file: ',A,'.xqtlog')
-
- IF (MOPTIO(17).NE.0) GO TO 29
- WRITE (IQPRNT,9027)
- 9027 FORMAT (/' Actual set-up used:')
- CALL SMDISP (4)
- DO 28 JTYP=1,3
- CALL SMDISP (JTYP)
- 28 CONTINUE
- CALL SMDISP (5)
- CALL SMDISP (6)
- 29 IF (IXLUN(1).LE.0) GO TO 81
-
-C---- Load the .xqtlog and .log files with the routine names
-
- CALL SMJOPT
- IF (MOPTIO(21).NE.0) THEN
- IF (MOPTIO(2).EQ.0) CALL SMRXQT
- ENDIF
- CALL SMRLOG
-
-+SELF, IF=QS_UNIX, QS_VMS.
-C---- Delete all .o files which are not part of the program
-
- IF (MOPTIO(21).NE.0) CALL SHUPTO
-
-+SELF, IF=QS_VMS.
-C-- Fix parameters on the command lines for the VAX
-
- CALL SHFIXP
-
-+SELF.
-+SEQ, QEJECT.
-C------ Write the shell script ------------------
-
-C-- open the .shfca file
-
- CHLIFI = CHFSH(1:NCHFSH)
- NLIFI = NCHFSH
- CALL FLINK (LUNSH, 5, 0, 0)
-
-C-- write the script header
-
- CALL SHWSTA (1)
- IF (NRALLC.EQ.0) GO TO 49
-
-C-- write the compile instructions for each file
-
-C- NNAME(JR) = ((IXNAME*8 + JXTYP)*8 + JXSTR)*4 + IFLNEW
-C- IFLNEW has bit 2 set if .o file exists
-C- bit 1 set if recompilation forced
- DO 47 JRT=NRXQT+1,NROUT
- JJ = NNAME(JRT)
- IF (IAND(JJ,3).EQ.2) GO TO 47
- JJ = ISHFTR(JJ,2)
- JSTR = IAND (JJ,7)
- JJ = ISHFTR (JJ,3)
- JTYP = IAND (JJ,7)
- IXNA = ISHFTR (JJ,3)
-
- CALL NA_GET (IXNA, CHNAME, 1)
- NN = NDSLAT
- CALL SHWCOMP (JTYP,JSTR, CHNAME(1:NN))
- 47 CONTINUE
-
-C-- write the apreslude
-
- CALL SHWSTA (2)
-
- 49 CLOSE (LUNSH)
-+SELF, IF=QS_UNIX.
- CALL SYSTEMF ('chmod 755 *.shfca')
-+SELF.
-C---- Print the summary
-
- WRITE (IQPRNT,9053)
- IF (NRALLC.EQ.0) GO TO 57
-
- CHDO = 'Do'
- JA = 4
- DO 54 JT=1,3
- DO 53 JS=1,4
- N = NCOUNTR(JS,JT)
- IF (N.EQ.0) GO TO 53
- CHNAME(1:8) = ' '
- CALL SMSID (JT,JS,CHNAME,1)
- WRITE (IQPRNT,9053) CHDO,N,CHNAME(1:6)
- 9053 FORMAT (6X,A,I5,' files for ',A)
- CHDO = ' '
- 53 CONTINUE
- 54 CONTINUE
-
-C---- Write the new .xqtlog file
-
- 57 CALL SHWXQT
- IF (NRALLC+NRDEL.EQ.0) GO TO 94
-
-C---- Done
-
- IF (MOPTIO(21).EQ.0) RETURN
- IF (MOPTIO(22).EQ.0) THEN
- IF (NRDEL.EQ.0) RETURN
- ENDIF
- CALL NA_GET (IXOBJ, CHNAME,1)
- NC = NDSLAT
- WRITE (IQPRNT,9057) NRDEL, CHNAME(1:NC)
- 9057 FORMAT (8X,I5,' orphan ',A,' files deleted')
- RETURN
-
-+SEQ, QEJECT.
- 9002 FORMAT (' nyshell x.log options read print'/
- F/' translates the nypatchy output file x.log for SPLIT or MODIFY'
- F/' mode into the shell-script x.shfca to compile the wanted'
- F/' routines as specified by the options, and according to the'
- F/' compilation rules defined by the "set-up". Nyshell has a'
- F/' default set-up which can be modified by the user with control'
- F/' lines given on the "read" stream. Nyshell writes the script'
- F/' x.shfca and also the file x.xqtlog recording the state which'
- F/' should be achieved with this run, to be used in the next run.'/
- F/' Nyshell and the resulting script x.shfca must be run in the'
- F/' directory where the resulting .o files are to be.'/
- F/' "options": A all - compile or re-compile all files'
- F/' B bypass the use of the input .xqtlog file'
- F/' E empty - bypass the .xqtlog file if it is empty'
- F/' H help - print this help information only'
- F/' Q quick - do not display the set-up information'
- F/' U uptodate - check that all .o files in the'
- F/' current directory are ready to be'
- F/' put into the last-version library'
- F/' V verbose - display the complete set-up.')
- 9003 FORMAT (
- F ' "read": name of the file with the user set-up commands,'
- F/' tty if standard input to be used,'
- F/' eof if default set-up to be used as is.'
- F/' "print" printed output file.'/
- F/' The set of routines to be handled is defined by the log file.'
- F/' If the "A" option is given all routines are to be compiled.'
- F/' If the "U" option is not given only the routines which do not'
- F/' have the "same" flag on the log are to be compiled.'
- F/' If the "U" option is given nyshell will make sure that all'
- F/' the .o files are up-to-date: a routine does not need'
- F/' recompilation only if it meets all these criteria:'
- F/' 1) the "same" flag is present,'
- F/' 2) the compiler options are the same as last time,'
- F/' 3) a re-compilation ordered last time has been done,'
- F/' 4) the .o file is more recent than the .f file,'
- F/' 5) the .o file is more recent than any .h file called.'
- F/' Also: delete all .o files in the current directory whose'
- F/' names to not appear in the log file.')
- 9004 FORMAT (
- F/' Set-up commands, given on "read", may be used to modify'
- F/' the default set-up. The "tag", starting before column 7,'
- F/' identifies the set-up parameter to be changed.'
- F/' An empty tag signals a continuation line. The text after'
- F/' gives the new content.'
- F/' The commands which would generate the set-up used will be'
- F/' printed at the end, unless the Quick option has been given.'
- F/' These are the possible set-up commands:'//' for Fortran:'/
- F/' fo:1 options special to stream :1'
- F/' fo:2 to stream :2'
- F/' fo:3 to stream :3'
- F/' fo:4 to stream :4'
- F/' fopt compiler options common to all streams'
- F/' fc the name of the Fortran compiler'
- F/' fort:1 command to compile a file for stream :1'
- F/' fort:2 for stream :2'
- F/' fort:3 for stream :3'
- F/' fort:4 for stream :4')
- 9005 FORMAT (/' for the C language:'/
- F/' co:1 options special to stream :1'
- F/' co:2 to stream :2'
- F/' co:3 etc.'
- F/' copt compiler options common to all streams'
- F/' cc the name of the C compiler'
- F/' cc:1 command to compile a file for stream :1'
- F/' cc:2 for stream :2'
- F/' cc:3 etc.'/
- F/' for the assembler:'/
- F/' ao:1 options special to stream 1'
- F/' ao:2 etc.'
- F/' aopt assembler options common to all streams'
- F/' as the name of the assembler'
- F/' as:1 command to assemble a file for stream :1'
- F/' as:2 etc.')
- 9006 FORMAT (/' start and end of the shell-script:'/
- F/' start shell commands ahead'
- F/' end shell commands added at the end'/
- F/' where-abouts of the source files:'/
- F/' sdir name, default is directory part of the input file'
- F/' (normally this is empty, ie. the current w.dir.)')
- 9007 FORMAT (
- F/' The special set-up parameter "by" for fort:i, cc:i, as:i'
- F/' requests not to compile the files of this stream.'
- F/' The special set-up parameter "=:1", for example, given'
- F/' for fort:i, cc:i, as:i requests the files of this stream'
- F/' to be processed as for stream :1.'
- F/' Given for fo:i, co:i, as:i it is a request to use for this'
- F/' stream the same options as for stream :1.'/
-+SELF, IF=QS_UNIX.
- F/' Nyshell converts the set-up parameters into shell parameters'
- F/' and puts their definitions at the beginning of the script.'/
- F/' Status returned by nyshell on Unix is =0 normally,'
- F/' =1 for zero routines to be recompiled, >1 for bad data.'/)
-+SELF, IF=QS_VMS.
- F/' Status returned by nyshell on VAX is =1 normally,'
- F/' =9 for zero routines to be recompiled, 4 for bad data.'/)
-+SELF, IF=QS_IBMVM.
- F/' Status returned by nyshell on IBM/VM is =0 normally,'
- F/' =1 for zero routines to be recompiled, 8 for bad data.'/)
-+SELF.
-
-C---- Trouble
-
- 81 IF (IXLUN(1).EQ.0) THEN
- WRITE (IQPRNT,9080)
- ELSEIF (IXLUN(1).EQ.-1) THEN
- WRITE (IQPRNT,9081)
- ENDIF
- CALL EXITRC (2)
-
- 9080 FORMAT (/' ***!!! No file-name given, no execution !!!***')
- 9081 FORMAT (/' ***!!! Errors on input, no execution !!!***')
- 9094 FORMAT (/' **!! Zero routines to be compiled !!**')
- 9095 FORMAT (/' **!! No routines to be compiled or deleted !!**')
-
- 94 IF (MOPTIO(21).EQ.0) THEN
- WRITE (IQPRNT,9094)
- ELSE
- WRITE (IQPRNT,9095)
- ENDIF
- CALL EXITRC (1)
- END
-+SEQ, QCARDL. =====================================================
-+DECK, SHUPTO, IF=QS_UNIX, QS_VMS.
- SUBROUTINE SHUPTO
-
-C- For Uptodate mode: get the names of all .o files,
-C- check each to be in the .log list, if not delete it
-C. started 4-feb-94
-
-+CDE, SLATE, SLATLN, FLINKC, QUNIT.
-+CDE, MQCM.
-+CDE, SHMKC, Q, PY, ADDSH.
-C-------------- End CDE --------------------------------
- CHARACTER LINE*64
- EQUIVALENCE (LINE, SLLINE)
-
- INTEGER SYSTEMF
-
-+SEQ, Q_AND, Q_SHIFTR.
-
-
- CALL UNLINKF ('temp_dir.fca')
- IXTEMP = NA_LONG ('temp_dir.fca')
-
-+SELF, IF=QS_UNIX.
- LINE = 'ls *.o >'
-C- _:.=+=.: 1_:
- CALL NA_GET (IXTEMP, LINE,10)
- N = NESLAT - 1
- ISTAT = SYSTEMF (LINE(1:N))
-+SELF, IF=QS_VMS.
- CALL UNLINKF ('temp_com.fca')
- OPEN (LUNSH,FILE='temp_com.fca',STATUS='UNKNOWN')
-
- WRITE (LUNSH,9007)
- 9007 FORMAT ('$! ''f$verify(0)'' '
- F/'$ purge/nolog/noconfirm *.obj'
- F/'$ dir*ectory :='
- F/'$ directory/col=1/width=file=32/output=temp_dir.fca *.obj')
-
- CLOSE (LUNSH)
- ISTAT = SYSTEMF ('@temp_com.fca')
- CALL UNLINKF ('temp_com.fca')
-+SELF, IF=XDEBUG, IF=XYSHELL.
- IF (ISTAT.NE.0) WRITE (IQPRNT,9019) ISTAT
- 9019 FORMAT (' Dbg SHUPTO: SYSTEMF returns status ',Z8,' hex')
-+SELF.
-
- CALL INIPAM (11, IXTEMP, 0,2)
- IF (IXFLUN.LT.0) GO TO 59
-
- 20 LQLEND(2) = LQLSTA(2)
- IQ(LQHOLD+2) = 0
- CALL ARRIVE (3)
-
-+SELF, IF=XDEBUG, IF=XYSHELL.
- WRITE (IQPRNT,9020) IQ(LQHOLD+2)
- 9020 FORMAT (' Dbg SHUPTO: ',I6,' lines to read from temporary')
-+SELF.
-+SEQ, QEJECT.
-
-C---- Do next line
-
- JSLIN = IQ(LQHOLD+1) - 1
- NSLIN = IQ(LQHOLD+2)
- JSLEND = JSLIN + NSLIN
-
- 21 JSLIN = JSLIN + 1
- IF (JSLIN.GT.JSLEND) GO TO 49
-
- CALL LN_GET (JSLIN,LINE,512)
- NXX = NDSLAT
- IF (NXX.EQ.0) GO TO 21
-+SELF, IF=XDEBUG, IF=XYSHELL, IF=XDETAILDB.
- PRINT *, ' line: ',LINE(1:NXX)
-+SELF.
- NXX = LNBLNK (LINE(1:NXX))
- IF (NXX.EQ.0) GO TO 21
-
-C-- get the routine name
-
- JNA = ICNEXT (LINE,1,NXX)
- JNE = NESLAT - 1
-+SELF, IF=QS_UNIX.
- IF (LINE(JNE-1:JNE).NE.'.o') GO TO 21
- JNN = JNE - 2
-+SELF, IF=QS_VMS.
- CALL CUTOL (LINE(JNA:JNE))
- JNE = ICFIND (';', LINE,JNA,JNE) - 1
- IF (LINE(JNE-3:JNE).NE.'.obj') GO TO 21
- JNN = JNE - 4
-+SELF.
- IF (JNN.LT.JNA) GO TO 21
- IXU = NA_LONG (LINE(JNA:JNN))
-
-C-- find this name in the list of routines
-
-C- NNAME(JR) = ((IXNAME*8 + JXTYP)*8 + JXSTR)*4 + IFLNEW
-
- DO 24 JR=NRXQT+1,NROUT
- MM = NNAME(JR)
- IXN = ISHFTR (MM,8)
- IF (IXN.EQ.IXU) THEN
- IF (IAND(MM,3).EQ.2) GO TO 21
- GO TO 27
- ENDIF
- 24 CONTINUE
- NRDEL = NRDEL + 1
-
-C-- delete .o file if not in the list, if to be re-compiled
-
- 27 CALL UNLINKF (LINE(JNA:JNE))
- IF (MOPTIO(22).EQ.0) GO TO 21
- WRITE (IQPRNT,9028) LINE(JNA:JNE)
- 9028 FORMAT (7X,'delete file ',A)
- GO TO 21
-
-C---- Done
-
- 49 IF (JDKNEX.LT.4) GO TO 20
- CALL INIPAM (0,0, -1,0)
- 59 CALL UNLINKF ('temp_dir.fca')
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, SHFIXP, IF=QS_VMS.
- SUBROUTINE SHFIXP
-
-C- Parameter substitution in the command lines for VAX
-C. started 22-feb-94
-
-+CDE, SLATE, SLATLN.
-+CDE, SHMKC, Q, PY, ADDSH.
-C-------------- End CDE --------------------------------
- CHARACTER LINE*512, SDIR*128
- CHARACTER CONAME*128, COOPT*256, LINEWK*640
- COMMON /CHSLAT/ CONAME, COOPT, LINEWK
- EQUIVALENCE (LINE,SLLINE), (SDIR,SLERRM)
-
- CHARACTER TKNAME*5, TKOPT*7
- CHARACTER CHT(3)*1, CHC(3)*2, CHS(4)*1
-
- DATA CHT / 'F', 'C', 'A' /
- DATA CHC / 'FC', 'CC', 'AS' /
- DATA CHS / '1', '2', '3', '4' /
-
-
-C-- ready the string to be substituted for ${s}
-
- CALL NA_GET (IXSDIR, SDIR,1)
- NSDIR = NDSLAT
- IF (IXSDIR.NE.0) CALL FTOVAX (SDIR,NSDIR)
-
-C-------- Do all types
-
- DO 49 JTYP=1,3
- IF (NCSUMR(JTYP).EQ.0) GO TO 49
-
-C-- ready compiler name for this type
-
- TKNAME = '${' // CHC(JTYP) // '}'
-
- IXU = IXINST(1,1,3,JTYP)
- CALL NA_GET (IXU,CONAME,1)
- NNM = NDSLAT
-
-C-- ready compiler option mask for this type
-
- TKOPT = '${' // CHT(JTYP) // 'O_x}'
-C- _: . =+=.
-
-+SEQ, QEJECT.
-C------ Do all streams of this type
-
- 31 DO 48 JSTR=1,4
- IF (NCOUNTR(JSTR,JTYP).EQ.0) GO TO 48
- NLINES = NLINST(JSTR,4,JTYP)
- IF (NLINES.EQ.0) GO TO 48
-
- TKOPT(6:6) = CHS(JSTR)
-
- CALL NA_GET (IXOPTN(JSTR,JTYP),COOPT,1)
- NOPT = NESLAT - 1
-
-C-- all lines of this stream
-
- DO 47 JLINE=1,NLINES
-
- JTX = NA_JTX (IXINST(JLINE,JSTR,4,JTYP))
- NTX = NDSLAT
-
-C-- replace source directory
-
- CALL CCOSUB (TEXT(JTX),NTX, LINE,1,512,
- + '${s}', SDIR(1:NSDIR))
- NTX = NDSLAT
-
-C-- replace compiler name
-
- CALL CCOSUB (LINE,NTX, LINEWK,1,512,
- + TKNAME, CONAME(1:NNM))
- IF (NGSLAT.NE.0) THEN
- NTX = NDSLAT
- LINE(1:NTX) = LINEWK(1:NTX)
- ENDIF
-
-C-- replace compiler options
-
- CALL CCOSUB (LINE,NTX, LINEWK,1,512,
- + TKOPT, COOPT(1:NOPT))
- IF (NGSLAT.NE.0) THEN
- NTX = NDSLAT
- LINE(1:NTX) = LINEWK(1:NTX)
- ENDIF
-
- IXINST(JLINE,JSTR,4,JTYP) = NA_LONG (LINE(1:NTX))
- 47 CONTINUE
- 48 CONTINUE
- 49 CONTINUE
-
-C------ Replace the source-directory in the start/end text
-
- JTYP = 4
- DO 59 JACT=1,4
- DO 58 JSTR=1,4
- NLINES = NLINST(JSTR,JACT,JTYP)
- IF (NLINES.EQ.0) GO TO 58
-
- DO 57 JLINE=1,NLINES
-
- JTX = NA_JTX (IXINST(JLINE,JSTR,JACT,JTYP))
- NTX = NDSLAT
-
- CALL CCOSUB (TEXT(JTX),NTX, LINE,1,512,
- + '${s}', SDIR(1:NSDIR))
-
- IF (NGSLAT.NE.0) THEN
- NTX = NDSLAT
- IXINST(JLINE,JSTR,JACT,JTYP) = NA_LONG (LINE(1:NTX))
- ENDIF
- 57 CONTINUE
- 58 CONTINUE
- 59 CONTINUE
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, SHWSTA.
- SUBROUTINE SHWSTA (JDO)
-
-C- Output of shell-commands for "start" and "end"
-C- JDO = 1 start of the script
-C- 2 end of the script
-C. started 20-jan-94
-
-+CDE, SLATE, SLATLN.
-+CDE, SHMKC, Q, PY, ADDSH.
-C-------------- End CDE --------------------------------
- CHARACTER LINEWK*524
- EQUIVALENCE (LINEWK,SLLINE)
-
-
-C---- Write part 1 of the end text
-
- JTYP = 4
- JACT = 3
- IF (JDO.NE.1) GO TO 21
-
-C---- Write part 1 of the start text
-
-+SELF, IF=QS_UNIX.
- WRITE (LUNSH,9020)
- 9020 FORMAT ('#!/bin/csh -f')
-+SELF.
- JACT = 1
-
-C---- Send the CIL lines to the shell script
-
- 21 DO 38 JSTR=1,4
-
- NLINES = NLINST(JSTR,JACT,JTYP)
- IF (NLINES.EQ.0) GO TO 38
-
- DO 37 JLINE=1,NLINES
-
- CALL NA_GET (IXINST(JLINE,JSTR,JACT,JTYP), LINEWK,1)
- JE = NESLAT - 1
-
- WRITE (LUNSH,9036) LINEWK(1:JE)
- 9036 FORMAT (A)
- 37 CONTINUE
- 38 CONTINUE
-
- IF (JACT.EQ.2) RETURN
- IF (JACT.EQ.4) RETURN
-
-C---- Write part 2 of the start or end text
-
- JACT = JACT + 1
-+SELF, IF=QS_UNIX.
- IF (JACT.EQ.2) CALL SHWPAR
-+SELF.
- GO TO 21
- END
-+SEQ, QCARDL. =====================================================
-+DECK, SHWPAR, IF=QS_UNIX.
- SUBROUTINE SHWPAR
-
-C- Output of the parameter-defining statements for Unix
-C. started 22-feb-94
-
-+CDE, SLATE, SLATLN.
-+CDE, SHMKC, Q, PY, ADDSH.
-C-------------- End CDE --------------------------------
- CHARACTER LINEWK*256, COLWK(256)*1
- EQUIVALENCE (LINEWK,SLLINE), (COLWK,SLLINE)
-
- CHARACTER CHT(3)*1, CHS(4)*1, CHC(3)*2
-
- DATA CHT / 'F', 'C', 'A' /
- DATA CHC / 'FC', 'CC', 'AS' /
- DATA CHS / '1', '2', '3', '4' /
-
-
- 21 LINEWK = 'set FILE = ' // CHNLOG(1:NNLOG)
-C- _:.=+=.: 1_:.=+=
- N = NNLOG + 12
- WRITE (LUNSH,9000) LINEWK(1:N)
-
- LINEWK = 'set s = "'
-C- _:.=+=.: 1_:.=+=
- CALL NA_GET (IXSDIR, LINEWK, 13)
- N = NESLAT
- COLWK(N) = '"'
- WRITE (LUNSH,9000) LINEWK(1:N)
- 9000 FORMAT (A)
-
-C------ All data-types, all active streams
-
- DO 49 JTYP=1,3
- IF (NCSUMR(JTYP).EQ.0) GO TO 49
-
- DO 48 JSTR=1,4
- IF (NCOUNTR(JSTR,JTYP).EQ.0) GO TO 48
-
-C-- define the compiler options
-
- LINEWK = 'set xO_y = " '
-C- _:.=+=.: 1_:.=+=
-
- COLWK(5) = CHT(JTYP)
- COLWK(8) = CHS(JSTR)
-
- IX = IXOPTN(JSTR,JTYP)
- CALL NA_GET (IX,LINEWK,13)
- N = NESLAT
-
- COLWK(N) = '"'
- WRITE (LUNSH,9000) LINEWK(1:N)
- 48 CONTINUE
-
-C-- define the compiler name
-
- JACT = 3
- LINEWK = 'set xx = "'
-C- _:.=+=.: 1_:.=+=
-
- LINEWK(5:6) = CHC(JTYP)
- IX = IXINST(1,1,JACT,JTYP)
- CALL NA_GET (IX,LINEWK,13)
- N = NESLAT
- COLWK(N) = '"'
- WRITE (LUNSH,9000) LINEWK(1:N)
- 49 CONTINUE
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, SHWCOMP.
- SUBROUTINE SHWCOMP (JTYP,JSTR,XNAME)
-
-C- Output of the shell-command for routine name XNAME
-C. started 20-jan-94
-
-+CDE, SLATE, SLATLN.
-+CDE, SHMKC, Q, PY, ADDSH.
-C-------------- End CDE --------------------------------
-
- CHARACTER XNAME*(*)
- CHARACTER LINEWK*512, COLWK(512)*1
- EQUIVALENCE (LINEWK,SLLINE), (COLWK,LINEWK)
-
-
- JACT = 4
- NLINE = NLINST(JSTR,JACT,JTYP)
- IF (NLINE.EQ.0) RETURN
-
- DO 29 JLINE=1,NLINE
- JTX = NA_JTX (IXINST(JLINE,JSTR,JACT,JTYP))
- NTX = NDSLAT
-
- CALL CCOSUB (TEXT(JTX),NTX, LINEWK,1,512, '$*', XNAME)
- JE = NESLAT - 1
-
-C-- Write the line ready
-
- WRITE (LUNSH,9027) LINEWK(1:JE)
- 9027 FORMAT (A)
- 29 CONTINUE
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, SHWXQT.
- SUBROUTINE SHWXQT
-
-C- Write the .xqtlog file
-C. started 5-may-94
-
-+CDE, SLATE, SLATLN.
-+CDE, FLINKC.
-+CDE, SHMKC, Q, PY, ADDSH.
-C-------------- End CDE --------------------------------
- CHARACTER LINE*64, LINEWK*256
- EQUIVALENCE (LINE,SLLINE), (LINEWK,SLLINE)
-
-+SEQ, Q_AND, Q_SHIFTR.
-
-
-C-- open the .xqtlog file for output
-
- CHLIFI = CHNLOG(1:NNLOG) // '.xqtlog'
- NLIFI = NNLOG + 7
- CALL FLINK (LUNSH, 5, 0, 0)
-
-C-- record the compiler options used
-
- WRITE (LUNSH,9001)
- 9001 FORMAT ('>.xqtlog')
- 9000 FORMAT (A)
-
- DO 27 JTYP=1,3
- IF (NCSUMH(JTYP).EQ.0) GO TO 27
-
- DO 26 JSTR=1,4
- IF (NCOUNTH(JSTR,JTYP).EQ.0) GO TO 26
-
- LINEWK = '>'
- CALL SMSID (JTYP,JSTR,LINEWK,2)
-
- CALL NA_GET (IXOPTN(JSTR,JTYP), LINEWK,10)
- N = NESLAT - 1
-
- WRITE (LUNSH,9000) LINEWK(1:N)
- 26 CONTINUE
- 27 CONTINUE
-
-C-- write the properties of each routine
-C- NNAME(JR) = ((IXNAME*8 + JXTYP)*8 + JXSTR)*4 + IFLNEW
-C- IFLNEW = 2 if "same"
- DO 47 JRT=NRXQT+1,NROUT
- JJ = NNAME(JRT)
- JJ = ISHFTR(JJ,2)
- JSTR = IAND (JJ,7)
- JJ = ISHFTR (JJ,3)
- JTYP = IAND (JJ,7)
- IXNA = ISHFTR (JJ,3)
-
- LINE = ' '
- CALL SMSID (JTYP,JSTR,LINE,2)
-
- CALL NA_GET (IXNA, LINE, 10)
- N = NESLAT
-
- WRITE (LUNSH,9000) LINE(1:N-1)
- 47 CONTINUE
- CLOSE (LUNSH)
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+PATCH, AUXSM. Service routines for NYSHELL
-+DECK, SMCIL.
- SUBROUTINE SMCIL (MODE, CODE, XTEXT)
-
-C- Store a compiler instructions line
-C- MODE = -1 start at line 1, =0 add one line
-C- CODE encoded: JXTYP type number, JXACT action, JXSTR stream
-C- XTEXT text to be stored
-C. started 20-jan-94
-
-+CDE, QUNIT.
-+CDE, SHMKC, Q, PY, ADDSH.
-C-------------- End CDE --------------------------------
-
- CHARACTER CODE*(*), XTEXT*(*), LINE*512
- EQUIVALENCE (LINE, TEXT)
-
-
- CALL SMCODE (CODE)
- IF (JXTYP.EQ.0) GO TO 94
- NTXT = LENOCC (XTEXT)
- IF (JXTYP.GE.5) GO TO 31
-
- IF (MODE.LT.0) THEN
- NLINST(JXSTR,JXACT,JXTYP) = 0
- IXINST(1,JXSTR,JXACT,JXTYP) = 0
- ENDIF
-
- IF (NTXT.EQ.0) RETURN
-
- JLINE = NLINST(JXSTR,JXACT,JXTYP)
-
- 25 JLINE = JLINE + 1
- IF (JLINE.GT.NLNSZ) GO TO 91
-
- IXU = NA_LONG (XTEXT(1:NTXT))
- IXINST(JLINE,JXSTR,JXACT,JXTYP) = IXU
- NLINST(JXSTR,JXACT,JXTYP) = JLINE
- RETURN
-
-C-- sdir name
-
- 31 IXSDIR = 0
- IF (NTXT.GT.0) IXSDIR= NA_LONG (XTEXT(1:NTXT))
- RETURN
-
-C---- trouble
-
- 91 NMAX = NLNSZ
- IF (JXTYP.NE.4) GO TO 93
- IF (JXSTR.EQ.4) GO TO 92
- JXSTR = JXSTR + 1
- JLINE = 0
- GO TO 25
-
- 92 IF (INDEX (CODEX,':').EQ.0) NMAX = 8*NMAX
- IF (JXACT.EQ.2) GO TO 93
- IF (JXACT.EQ.4) GO TO 93
- JXACT = JXACT + 1
- JXSTR = 1
- JLINE = 0
- GO TO 25
-
- 93 WRITE (IQPRNT,9091) NMAX,CODEX
- 9091 FORMAT (/' ***!!! Capacity of',I3,' lines exceeded for ',A)
- GO TO 97
-
- 94 WRITE (IQPRNT,9091) CODE,XTEXT
- 9094 FORMAT (' ***!!! Faulty init with ',A,' for ',A,' !!!***')
-
- 97 CALL P_KILL ('Abend')
- END
-+SEQ, QCARDL. =====================================================
-+DECK, SMCINST.
- SUBROUTINE SMCINST
-
-C- Read the user-defined compiler instructions
-C. started 20-jan-94
-
-+CDE, SLATE, SLATLN, QUNIT.
-+CDE, SHMKC, Q, PY, ADDSH.
-C-------------- End CDE --------------------------------
- CHARACTER LINE*512
- EQUIVALENCE (LINE, SLLINE)
-
-
- INCRAD = 3
- CALL ARRIVE (0)
- INCRAD = 0
-
- JSLIN = IQ(LQHOLD+1) - 1
- JSLEND = JSLIN + IQ(LQHOLD+2)
- NIGN = 0
- JXTYP = 0
- NLINE = 0
-
-C---- Read next line
-
- 21 JSLIN = JSLIN + 1
- IF (JSLIN.GT.JSLEND) GO TO 49
-
- CALL LN_GET (JSLIN,LINE,512)
- NXX = NDSLAT
- IF (NXX.EQ.0) GO TO 21
- NXX = LNBLNK (LINE(1:NXX))
- IF (NXX.EQ.0) GO TO 21
- IF (MOPTIO(17).EQ.0) THEN
- NLINE = NLINE + 1
- WRITE (IQPRNT,9023) NLINE,LINE(1:NXX)
- ENDIF
- 9023 FORMAT (1X,I6,' - ',A)
-
- IF (LINE(1:1).EQ.'#') GO TO 21
-
-C-- get the logical stream type:n
-
- IFL = 0
- JNA = 0
- 24 JNA = ICNEXT (LINE,JNA+1,NXX)
- IF (JNA.GE.7) GO TO 41
- IF (LINE(JNA:JNA).EQ.'+') THEN
- IFL = 7
- GO TO 24
- ENDIF
- IF (NDSLAT.LT.2) GO TO 71
- JTE = NESLAT
-
- CALL SMCODE (LINE(JNA:JTE-1))
- IF (JXTYP.EQ.0) GO TO 71
-
- IF (IFL.EQ.0) CALL SMCIL (-1, ' ', ' ')
-
- JNA = ICFNBL (LINE,JTE,NXX)
- IF (JNA.GT.NXX) GO TO 21
-
-C-- register the new compiler instruction line
-
- 41 IF (JXTYP.EQ.0) GO TO 71
- CALL SMCIL (0, ' ', LINE(JNA:NXX))
- GO TO 21
-
-C---- Done
-
- 49 IF (NIGN.NE.0) GO TO 97
- IF (NLINE.NE.0) WRITE (IQPRNT,9023)
- RETURN
-
-C---- Fault
-
- 71 NIGN = NIGN + 1
- WRITE (IQPRNT,9071) LINE(1:NXX)
- 9071 FORMAT (/' Bad: ',A
- F/' ***!!! Faulty compiler-instruction !!!***')
-
- IF (NIGN.LT.8) GO TO 21
- 97 IQREAD = -1
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, SMCODE.
- SUBROUTINE SMCODE (CODE)
-
-C- Crack CODE into JXTYP, JXACT, JXSTR
-C. started 26-jan-94
-
-+CDE, SLATE.
-+CDE, SHMKC, Q, PY, ADDSH.
-C-------------- End CDE --------------------------------
- CHARACTER CODE*(*)
- PARAMETER (NTYPES = 17)
-
-C- code fo: fopt fc fort: co: copt cc cc: ao: aopt as as:
-C- CHTYP( 1 2 3 4 5 6 7 8 9 10 11 12
-C- JXTYP= 1 2 3
-C- JXACT= 1 2 3 4 1 2 3 4 1 2 3 4
-
-C- code start: start end: end sdir
-C- CHTYP( 13 14 15 16 17
-C- JXTYP= 4 4 4 4 5
-C- JXACT= 1 2 3 4
-
-C-- if all blank: leave the parameters unchanged
-
- NA = LNBLNK (CODE)
- IF (NA.EQ.0) RETURN
- CODEX = CODE
-
-C-- find the length of the string and compare
-
- NC = ICFIND (':', CODEX,1,NA)
- IF (NC.EQ.1) GO TO 49
-
- JTYP = ICNTHL (CODEX(1:NC),CHTYP,NTYPES) - 1
- IF (JTYP.LT.0) GO TO 49
-
- JXTYP = JTYP/4 + 1
- JXACT = MOD (JTYP,4) + 1
- JXSTR = 1
- IF (CODEX(NC:NC).EQ.':') GO TO 24
- IF (JXTYP.LE.3) RETURN
-
-C-- take start:1 for start and end:1 for end
-
- JXACT = JXACT - 1
- RETURN
-
-C-- get number from :n
-
- 24 JXSTR = ICDECI (CODEX, NC+1, 8)
- IF (JXSTR.LE.0) GO TO 49
- IF (JXSTR.LE.4) RETURN
- IF (JXTYP.NE.4) GO TO 49
- JXACT = JXACT + 1
- JXSTR = JXSTR - 4
- IF (JXSTR.LE.4) RETURN
-
-C-- CODEX not for one of the compilers
-
- 49 JXTYP = 0
- END
-+SEQ, QCARDL. =====================================================
-+DECK, SMDEF.
- SUBROUTINE SMDEF
-
-C- Load the default compiler instructions for nyshell and nymake
-C. started 20-jan-94
-
-+CDE, SLATLN.
-+CDE, SHMKC, Q, PY, ADDSH.
-C-------------- End CDE --------------------------------
- CHARACTER LINEWK*128
- EQUIVALENCE (LINEWK, SLERRM)
-
-
- CHTYP(1) = 'fo: '
- CHTYP(2) = 'fopt '
- CHTYP(3) = 'fc '
- CHTYP(4) = 'fort: '
- CHTYP(5) = 'co: '
- CHTYP(6) = 'copt '
- CHTYP(7) = 'cc '
- CHTYP(8) = 'cc: '
- CHTYP(9) = 'ao: '
- CHTYP(10) = 'aopt '
- CHTYP(11) = 'as '
- CHTYP(12) = 'as: '
- CHTYP(13) = 'start: '
- CHTYP(14) = 'start '
- CHTYP(15) = 'end: '
- CHTYP(16) = 'end '
- CHTYP(17) = 'sdir '
-
- CALL SMCIL (-1, 'fo:3' , '=:1')
- CALL SMCIL (-1, 'fo:4' , '=:2')
- CALL SMCIL (-1, 'co:3' , '=:1')
- CALL SMCIL (-1, 'co:4' , '=:2')
- CALL SMCIL (-1, 'ao:2' , '=:1')
- CALL SMCIL (-1, 'ao:3' , '=:1')
- CALL SMCIL (-1, 'ao:4' , '=:2')
-
- CALL SMCIL (-1, 'fort:3', '=:1')
- CALL SMCIL (-1, 'fort:4', '=:2')
- CALL SMCIL (-1, 'cc:3' , '=:1')
- CALL SMCIL (-1, 'cc:4' , '=:2')
- CALL SMCIL (-1, 'as:2' , '=:1')
- CALL SMCIL (-1, 'as:3' , '=:1')
- CALL SMCIL (-1, 'as:4' , '=:2')
-
-+SEQ, QEJECT.
-+SELF, IF=QS_UNIX.
- IXOBJ = NA_LONG ('.o')
- CALL SMCIL (-1, 'fo:1' , '-O')
- CALL SMCIL (-1, 'fopt' , '-c')
- CALL SMCIL (-1, 'co:1' , '-O')
- CALL SMCIL (-1, 'copt' , '-c')
-
- CALL SMCIL (-1, 'fort:1', '${FC} ${FO_1} ${s}$*.f')
- CALL SMCIL (-1, 'fort:2', '${FC} ${FO_2} ${s}$*.f')
- CALL SMCIL (-1, 'cc:1' , '${CC} ${CO_1} ${s}$*.c')
- CALL SMCIL (-1, 'cc:2' , '${CC} ${CO_2} ${s}$*.c')
- CALL SMCIL (-1, 'as:1' , '${AS} ${AO_1} ${s}$*.s')
-
- CALL SMCIL (-1, 'fc' , 'f77')
- CALL SMCIL (-1, 'cc' , 'cc')
- CALL SMCIL (-1, 'as' , 'as')
-+SELF, IF=QS_VMS.
- IXOBJ = NA_LONG ('.obj')
- CALL SMCIL (-1, 'fo:1' , '/opt')
- CALL SMCIL (-1, 'fopt' ,
- + '/nolist/check=noover')
-C! + '/nolist/check=noover/warn=(nounuse,nouncall)')
- CALL SMCIL (-1, 'copt' , '/warn=noinfo')
- CALL SMCIL (-1, 'aopt' , '/nolist')
-
- CALL SMCIL (-1, 'fort:1', '$ ${FC} ${FO_1} ${s}$*.for')
- CALL SMCIL (-1, 'fort:2', '$ ${FC} ${FO_2} ${s}$*.for')
- CALL SMCIL (-1, 'cc:1' , '$ ${CC} ${CO_1} ${s}$*.c')
- CALL SMCIL (-1, 'cc:2' , '$ ${CC} ${CO_2} ${s}$*.c')
- CALL SMCIL (-1, 'as:1' , '$ ${AS} ${AO_1} ${s}$*.mar')
-
- CALL SMCIL (-1, 'fc' , 'fortran')
- CALL SMCIL (-1, 'cc' , 'cc')
- CALL SMCIL (-1, 'as' , 'macro')
-+SELF.
-+SELF, IF=QF_APO, IF=-QMAPO10.
- CALL SMCIL (-1, 'fo:1' , '-opt 3')
- CALL SMCIL (-1, 'fo:2' , '-opt 0')
- CALL SMCIL (-1, 'fopt' ,
- + '-bounds_violation -info 1 -indexl -cpu mathlib_sr10')
-
-+SELF, IF=QF_APO, IF=QMAPO10.
- CALL SMCIL (-1, 'fo:1' , '-opt 2')
- CALL SMCIL (-1, 'fo:2' , '-opt 0')
- CALL SMCIL (-1, 'fopt' ,
- + '-bounds_violation -info 1 -indexl -cpu a88k')
-
-+SELF, IF=QF_APO.
- CALL SMCIL (-1, 'fort:1',
- + '${FC} ${s}$*.ftn ${FO_1}; mv $*.bin $*.o')
- CALL SMCIL (-1, 'fort:2',
- + '${FC} ${s}$*.ftn ${FO_2}; mv $*.bin $*.o')
- CALL SMCIL (-1, 'fc' , '/com/ftn')
-
-+SELF, IF=QF_APO77, IF=-QMAPO10.
- CALL SMCIL (-1, 'fo:1' , '-O3')
- CALL SMCIL (-1, 'fo:2' , '-O0')
-
- LINEWK = '-c -A cpu,mathlib_sr10 -W0,-bounds_violation' //
- + ' -W0,-info,1 -W0,-indexl'
- CALL SMCIL (-1, 'fopt' , LINEWK)
-
-+SELF, IF=QF_APO77, IF=QMAPO10.
- CALL SMCIL (-1, 'fo:1' , '-O3')
- CALL SMCIL (-1, 'fo:2' , '-O0')
-
- LINEWK = '-c -A cpu,a88k -W0,-bounds_violation' //
- + ' -W0,-info,1 -W0,-indexl'
- CALL SMCIL (-1, 'fopt' , LINEWK)
-
-+SELF, IF=QMALT.
-+SELF, IF=QMAMX.
- CALL SMCIL (-1, 'fopt' , '-c -q')
- CALL SMCIL (-1, 'fc' , 'ftn')
-
- CALL SMCIL (-1, 'co:1' , ' ')
-
-+SELF, IF=QMCRY.
- CALL SMCIL (-1, 'fo:1' , ' ')
- CALL SMCIL (-1, 'fopt' , ' ')
- CALL SMCIL (-1, 'co:1' , ' ')
-
- CALL SMCIL (-1, 'fc' , 'cft77')
- CALL SMCIL (-1, 'cc' , 'scc')
-
-+SELF, IF=QMCVX.
- CALL SMCIL (-1, 'fopt' , '-c -72')
- CALL SMCIL (-1, 'fc' , 'fc')
-
-+SELF, IF=QMDOS.
- CALL SMCIL (-1, 'fo:1' , ' ')
- CALL SMCIL (-1, 'fopt' , '-c -vm')
- CALL SMCIL (-1, 'co:1' , ' ')
- CALL SMCIL (-1, 'copt' , '-n2 -n3 -OLM')
-
- CALL SMCIL (-1, 'aopt' , '-c')
-
- CALL SMCIL (-1, 'fc' , 'mf486')
- CALL SMCIL (-1, 'as' , '386ASM')
-
-+SELF, IF=QMHPX.
- CALL SMCIL (-1, 'fo:1' , ' ')
- CALL SMCIL (-1, 'fopt' , '-c -w +ppu')
-
-+SELF, IF=QMIBX.
-+SELF, IF=QMIRT.
- CALL SMCIL (-1, 'fopt' , '-c -qextname -qcharlen=8192')
- CALL SMCIL (-1, 'fc' , 'xlf')
-
-+SELF, IF=QMLNX.
- CALL SMCIL (-1, 'fo:1' , '-O2')
- CALL SMCIL (-1, 'fo:2' , '-O0')
- CALL SMCIL (-1, 'fopt' , '-c -Nx800 -Nc200')
- CALL SMCIL (-1, 'co:1' , '-O2')
- CALL SMCIL (-1, 'co:2' , '-O0')
- CALL SMCIL (-1, 'copt' , '-c -posix')
-+SELF, IF=QMNXT.
-+SELF, IF=QMSGI.
-+SELF, IF=QMSUN.
- CALL SMCIL (-1, 'fopt' , '-c -w66')
- CALL SMCIL (-1, 'as:1' , '${AS} -o $*.o ${s}$*.s')
-
-+SELF, IF=QMTMO.
- CALL SMCIL (-1, 'fo:1' , ' ')
- CALL SMCIL (-1, 'co:1' , ' ')
-
-+SELF, IF=QMVMI.
- CALL SMCIL (-1, 'fopt' , '-c -w1')
- CALL SMCIL (-1, 'cc' , 'f77')
- CALL SMCIL (-1, 'as:1' , '${AS} -o $*.o ${s}$*.s')
-
-+SELF, IF=QMVAO.
- CALL SMCIL (-1, 'fo:2' , '-O0')
- CALL SMCIL (-1, 'fopt' , '-c -w1 -warn nouncalled')
- CALL SMCIL (-1, 'co:1' , '-O2')
- CALL SMCIL (-1, 'co:2' , '-O0')
- CALL SMCIL (-1, 'as:1' , '${AS} -o $*.o ${s}$*.s')
-
-+SELF, IF=QMUUX.
-
-+SELF.
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, SMDISP.
- SUBROUTINE SMDISP (JTARG)
-
-C- Display the compiler instructions for data type JTYP
-C. started 20-jan-94
-
-+CDE, SLATE, SLATLN, QUNIT.
-+CDE, SHMKC, Q, PY, ADDSH.
-C-------------- End CDE --------------------------------
-
- CHARACTER LINEWK*100, CHWK*4
- EQUIVALENCE (LINEWK,SLLINE), (CHWK,LINEWK)
-
-
- JTYP = JTARG
- NLEAD = 9
- IF (JTYP.GE.4) GO TO 41
- WRITE (IQPRNT,9001)
-
-C-- check if stream 3 and 4 need to be displayed
-
- NSTRDO = 4
- IF (MOPTIO(22).NE.0) GO TO 24
- NSTRDO = 2
-
- DO 22 JSTR=3,4
- IXU = IXINST(1,JSTR,4,JTYP)
- IF (IXU.EQ.0) GO TO 22
- CALL NA_GET (IXU, CHWK, 1)
- IF (CHWK(1:2).NE.'=:') NSTRDO= JSTR
- 22 CONTINUE
-
-C---- Do all actions of type JTYP
-
- 24 DO 29 JACT=1,4
-
- JTAC = 4*(JTYP-1) + JACT
- IFSTR = 0
- NSTR = 1
- IF (JACT.EQ.2) GO TO 26
- IF (JACT.EQ.3) GO TO 26
- IFSTR = 1
- NSTR = NSTRDO
-
- 26 JSTR = 0
- 27 IF (JSTR.EQ.NSTR) GO TO 29
- JSTR = JSTR + 1
- NLINE = NLINST(JSTR,JACT,JTYP)
- JLINE = 1
-
- LINEWK = CHTYP(JTAC)
- IF (IFSTR.EQ.0) GO TO 28
-
- CALL CSETDI (JSTR,LINEWK,7,NLEAD)
- CALL CLEFT (LINEWK,4,NLEAD)
-
- 28 CALL NA_GET (IXINST(JLINE,JSTR,JACT,JTYP), LINEWK, NLEAD+1)
- JE = NESLAT - 1
- WRITE (IQPRNT,9002) LINEWK(1:JE)
-
- IF (JLINE.GE.NLINE) GO TO 27
- JLINE = JLINE + 1
- IF (JLINE.NE.2) GO TO 28
- LINEWK(1:NLEAD) = ' '
- GO TO 28
- 29 CONTINUE
- RETURN
-
-+SEQ, QEJECT.
-C---- Display start or end
-
- 41 IF (JTYP.GE.6) GO TO 51
- JACDO = 1
- IF (JTYP.NE.4) JACDO= 3
- JTYP = 4
- JTAC = 12 + JACDO
- LINEWK = CHTYP(JTAC)
- IFANY = 0
-
- DO 49 JACT=JACDO,JACDO+1
- DO 49 JSTR=1,4
- JLINE = 0
- NLINE = NLINST(JSTR,JACT,JTYP)
-
- 44 IF (JLINE.GE.NLINE) GO TO 49
- JLINE = JLINE + 1
-
- CALL NA_GET (IXINST(JLINE,JSTR,JACT,JTYP), LINEWK, NLEAD+1)
- JE = NESLAT - 1
-
- IF (IFANY.EQ.0) WRITE (IQPRNT,9001)
- WRITE (IQPRNT,9002) LINEWK(1:JE)
-
- IF (IFANY.NE.0) GO TO 44
- LINEWK(1:NLEAD) = ' '
- IFANY = 7
- GO TO 44
- 49 CONTINUE
- RETURN
-
-C---- Display source directory
-
- 51 IF (MOPTIO(22).EQ.0) THEN
- IF (IXSDIR.EQ.0) RETURN
- ENDIF
-
- LINEWK = CHTYP(17)
- CALL NA_GET (IXSDIR, LINEWK, NLEAD+1)
- JE = NESLAT - 1
-
- WRITE (IQPRNT,9001)
- WRITE (IQPRNT,9002) LINEWK(1:JE)
- RETURN
-
- 9001 FORMAT (A)
- 9002 FORMAT (1X,A)
- END
-+SEQ, QCARDL. =====================================================
-+DECK, SMJOPT.
- SUBROUTINE SMJOPT
-
-C- Join the stream-specific and general options for all types
-C. started 5-may-94
-
-+CDE, SLATE, SLATLN, QUNIT.
-+CDE, SHMKC, Q, PY, ADDSH.
-C-------------- End CDE --------------------------------
- CHARACTER LINEWK*256, COLWK(256)*1, CHWK*4
- EQUIVALENCE (LINEWK,SLLINE), (COLWK,SLLINE)
-
-
- DO 49 JTYP=1,3
- DO 49 JSTR=1,4
-
- LINEWK = ' '
- JPUT = 1
-
-C-- set the common options first
-
- JACT = 2
- NL = NLINST(1,JACT,JTYP)
- JL = 0
- 24 JL = JL + 1
- IF (JL.GT.NL) GO TO 31
- IX = IXINST(JL,1,JACT,JTYP)
- IF (IX.EQ.0) GO TO 31
- CALL NA_GET (IX,LINEWK,JPUT)
- JPUT = NESLAT + 1
- GO TO 24
-
-C-- add the stream-specific options
-
- 31 JACT = 1
- JSUS = JSTR
- NLOOP = 0
- 32 NL = NLINST(JSUS,JACT,JTYP)
- IF (NL.EQ.0) GO TO 46
- IX = IXINST(1,JSUS,JACT,JTYP)
- IF (IX.EQ.0) GO TO 46
-
- CALL NA_GET (IX,CHWK,1)
- IF (CHWK(1:2).NE.'=:') GO TO 35
- JSUS = ICDECI (CHWK,3,4)
- IF (JSUS.LE.0) GO TO 91
- IF (JSUS.GT.4) GO TO 91
- NLOOP = NLOOP + 1
- IF (NLOOP.GT.7) GO TO 92
- GO TO 32
-
- 35 JL = 1
- 36 CALL NA_GET (IX,LINEWK,JPUT)
- JPUT = NESLAT + 1
- JL = JL + 1
- IF (JL.GT.NL) GO TO 46
- IX = IXINST(JL,JSUS,JACT,JTYP)
- IF (IX.NE.0) GO TO 36
-
-C-- done, store this line
-
- 46 N = LNBLNK(LINEWK(1:JPUT))
- IF (N.EQ.0) GO TO 48
-+SELF, IF=QS_UNIX.
- CALL CSQMBL (LINEWK,1,N)
- N = NDSLAT
-+SELF, IF=QS_VMS.
- CALL CLEFT (LINEWK,1,N)
- N = NDSLAT
-+SELF.
- N = NA_LONG (LINEWK(1:N))
- 48 IXOPTN(JSTR,JTYP) = N
- 49 CONTINUE
- RETURN
-
-C---- Faulty compiler instructions
-
- 91 WRITE (IQPRNT,9091) CHWK
- 9091 FORMAT (/' Trying to do: ',A)
- CALL P_KILL ('Faulty compile-stream re-direction')
-
- 92 CALL P_KILL ('Compile-stream re-direction loop')
- END
-+SEQ, QCARDL. =====================================================
-+DECK, SMRLOG.
- SUBROUTINE SMRLOG
-
-C- Read the Patchy log file and crack each entry
-C. started 20-jan-94
-
-+CDE, SLATE, SLATLN, QUNIT, LUNSLN.
-+CDE, MQCM.
-+CDE, SHMKC, Q, PY, ADDSH.
-C-------------- End CDE --------------------------------
- CHARACTER LINE*256
- EQUIVALENCE (LINE, SLLINE)
-
- CHARACTER SCDIR*80, FILEN*128, CHWK*4
- INTEGER STATF
-
-
-+SEQ, Q_AND, Q_SHIFTR.
-
- IF (NRXQT.EQ.0) THEN
- MOPTIO(2) = MOPTIO(2) + MOPTIO(5)
- IF (MOPTIO(2).EQ.0) MOPTIO(1)= 1
- ENDIF
-
-C-- set the source directory
-
- IF (IXSDIR.NE.0) THEN
- CALL NA_GET (IXSDIR,SCDIR,1)
- NDIR = NDSLAT
-+SELF, IF=QS_VMS.
- CALL FTOVAX (SCDIR,NDIR)
-+SELF.
- ELSE
- NDIR = 0
- ENDIF
-
-C-- get the .log file into memory
-
- NROUT = NRXQT
- NIGN = 0
- IFDOTH = 0
-
- CALL INIPAM (11, IXLUN(1), 0,0)
-
- 20 LQLEND(2) = LQLSTA(2)
- IQ(LQHOLD+2) = 0
- CALL ARRIVE (3)
-
-+SEQ, QEJECT.
-C---- Do next line
-
- JSLIN = IQ(LQHOLD+1) - 1
- NSLIN = IQ(LQHOLD+2)
- JSLEND = JSLIN + NSLIN
-
- 21 JSLIN = JSLIN + 1
- IF (JSLIN.GT.JSLEND) GO TO 39
-
- CALL LN_GET (JSLIN,LINE,512)
- NXX = NDSLAT
- IF (NXX.EQ.0) GO TO 21
- NXX = LNBLNK (LINE(1:NXX))
- IF (NXX.EQ.0) GO TO 21
- IF (IFDOTH.EQ.7) GO TO 65
-
-C-- get and analyse the logical stream type:n
-
- JTA = ICNEXT (LINE,1,NXX)
- JTE = NESLAT
- NTA = NDSLAT
- IF (JTA.GE.11) GO TO 21
- IF (JTA.GE.4) GO TO 81
- IF (NTA.LT.3) GO TO 81
-
- CALL SMCODE (LINE(JTA:JTA+NTA-1))
- IF (JXTYP.EQ.0) GO TO 21
- IF (JXTYP.GT.3) GO TO 21
- IF (JXACT.NE.4) GO TO 81
-
-C-- check if type:n is bypassed or re-directed
-
- NLOOP = 0
- 26 IXU = IXINST(1,JXSTR,JXACT,JXTYP)
- IF (IXU.EQ.0) GO TO 21
- CHWK = ' '
- CALL NA_GET (IXU,CHWK,1)
- IF (CHWK .EQ.'by ') GO TO 21
- IF (CHWK(1:2).NE.'=:') GO TO 31
-
- JXSTR = ICDECI (CHWK,3,4)
- IF (JXSTR.LT.1) GO TO 92
- IF (JXSTR.GT.4) GO TO 92
- NLOOP = NLOOP + 1
- IF (NLOOP.GT.7) GO TO 91
- GO TO 26
-
-C---- Compilable routine, get the routine name
-
- 31 JNA = ICNEXT (LINE,JTE,NXX)
- JNF = NESLAT - 1
- NNA = NDSLAT
- IF (NNA.EQ.0) GO TO 81
-
- JNE = ICFIND ('.', LINE,JNA,JNF) - 1
- IXNAME = NA_LONG (LINE(JNA:JNE))
- IFLNEW = 1
- IRCCO = 0
- IF (MOPTIO(1) .NE.0) GO TO 38
-
-C-- check the "same" flag is present
-
- IF (JNF.EQ.NXX) GO TO 38
- JINC = ICNEXT (LINE,JNF+1,NXX)
- IF (NDSLAT.NE.4) GO TO 38
- IF (LINE(JINC:JINC+3).NE.'same') GO TO 38
- JINCE = NESLAT
- IF (MOPTIO(21).NE.0) GO TO 41
-
-C---- register the new routine name
-
- 37 IFLNEW = 2
- 38 NROUT = NROUT + 1
- IF (NROUT.GT.NRTSZ) GO TO 93
- NNAME(NROUT) = ((IXNAME*8 + JXTYP)*8 + JXSTR)*4 + IFLNEW
-
- NCOUNTH(JXSTR,JXTYP) = NCOUNTH(JXSTR,JXTYP) + 1
- NCSUMH(JXTYP) = NCSUMH(JXTYP) + 1
- IF (IFLNEW.EQ.2) GO TO 21
- NCOUNTR(JXSTR,JXTYP) = NCOUNTR(JXSTR,JXTYP) + 1
- NCSUMR(JXTYP) = NCSUMR(JXTYP) + 1
- NRALLC = NRALLC + 1
-+SELF, IF=XDEBUG, IF=XYSHELL.
- IF (IRCCO.EQ.0) GO TO 21
- CALL NA_GET (IXNAME,LINE,1)
- WRITE (IQPRNT,9038) LINE(1:NDSLAT),IRCCO
- 9038 FORMAT (' routine ',A,' ircco=',I2)
-+SELF.
- GO TO 21
-
-C---- Done
-
- 39 IF (JDKNEX.LT.4) GO TO 20
- IF (NROUT.EQ.NRXQT) GO TO 94
- CALL INIPAM (0,0, -1,0)
- RETURN
-
-+SEQ, QEJECT.
-C---- check dependencies for "same" routine in UPTODATE mode
-
- 41 IF (MOPTIO(2).NE.0) GO TO 46
-
-C-- find this routine in the .xqtlog file
-
- DO 42 JX=1,NRXQT
- JJ = NNAME(JX)
- IXNA = ISHFTR (JJ,8)
- IF (IXNA.EQ.IXNAME) GO TO 44
- 42 CONTINUE
- IRCCO = 1
- GO TO 38
-
-C-- check compiler options unchanged
-
- 44 JJ = ISHFTR(JJ,2)
- JSTR = IAND (JJ,7)
- JJ = ISHFTR (JJ,3)
- JTYP = IAND (JJ,7)
- IRCCO = 2
-
- IF (JTYP.NE.JXTYP) GO TO 38
- IF (IXOPTP(JSTR,JTYP).NE.IXOPTN(JXSTR,JXTYP)) GO TO 38
-
-C-- get the date and length of the .o file
-
- 46 CALL NA_GET (IXNAME,FILEN,1)
- NFI = NESLAT
- CALL NA_GET (IXOBJ, FILEN,NFI)
- NFI = NESLAT - 1
-
- ISTAO = STATF (FILEN(1:NFI), IQUEST)
- ILENO = IQUEST(7)
- ITIMO = IQUEST(9)
-+SELF, IF=XDEBUG, IF=XYSHELL, IF=XDETAILDB.
- WRITE (IQPRNT,9836) FILEN(1:NFI), ITIMO, ISTAO
- 9836 FORMAT (20X,'file ',A/' time=',Z10,' status=',I4)
-+SELF.
- IRCCO = 4
- IF (ISTAO.NE.0) GO TO 38
- IRCCO = 5
- IF (ILENO.EQ.0) GO TO 38
- ITIMOL = ISHFTR (ITIMO,3)
- ITIMOR = IAND (ITIMO,7)
-
-C-- get the date of the .f | .c | .a file
-
- IF (NDIR.GT.0) FILEN(1:NDIR)= SCDIR(1:NDIR)
- IRCCO = 6
-
- 61 FILEN(NDIR+1:NDIR+NNA)= LINE(JNA:JNA+NNA-1)
- NFI = NDIR + NNA
-
-C-- read the date and compare to that of the .o file
-
- ISTAF = STATF (FILEN(1:NFI), IQUEST)
- ITIMF = IQUEST(9)
-+SELF, IF=XDEBUG, IF=XYSHELL, IF=XDETAILDB.
- WRITE (IQPRNT,9836) FILEN(1:NFI), ITIMF, ISTAF
-+SELF.
- IF (ISTAF.NE.0) GO TO 38
-
- ITIMFL = ISHFTR (ITIMF,3)
- IF (ITIMFL.LT.ITIMOL) GO TO 64
- IF (ITIMFL.GT.ITIMOL) GO TO 38
-
- ITIMFR = IAND (ITIMF,7)
- IF (ITIMFR.GE.ITIMOR) GO TO 38
-
-C-- get the name for the next include file, if any
-
- 64 IF (JINCE.GT.NXX) GO TO 37
- IRCCO = 7
- 65 IFDOTH = 0
- JNA = ICNEXT (LINE,JINCE,NXX)
- JINCE = NESLAT
- NNA = NDSLAT
- IF (NNA.GT.1) GO TO 61
- IF (LINE(JNA:JNA).NE.'+') GO TO 61
- IFDOTH = 7
- JINCE = 1
- GO TO 21
-
-+SEQ, QEJECT.
-C---- Ignore meaningless input line
-
- 81 NIGN = NIGN + 1
- WRITE (IQPRNT,9081) LINE(1:NXX)
- 9081 FORMAT (' Ignored: ',A)
-
- IF (NIGN.LT.8) GO TO 21
- IF (NIGN.LT.(NROUT-NRXQT)/2) GO TO 21
-
- CALL P_KILL ('Faulty Patchy log file')
-
-C---- Faulty compiler instructions
-
- 91 CALL P_KILL ('Compile-stream re-direction loop')
-
- 92 WRITE (IQPRNT,9092) CHWK
- 9092 FORMAT (/' Trying to do: ',A)
- CALL P_KILL ('Faulty compile-stream re-direction')
-
- 93 WRITE (IQPRNT,9093) NRTSZ
- 9093 FORMAT (/' ***!!! More than',I7,' routines !!!***'
- F/' complain to zoll at cern.ch')
-
- CALL P_KILL ('Too many routines')
-
- 94 CALL P_KILL ('No compilable routines')
- END
-+SEQ, QCARDL. =====================================================
-+DECK, SMRXQT.
- SUBROUTINE SMRXQT
-
-C- Read the Nyshell .xqtlog file and crack each entry
-C. started 5-may-94
-
-+CDE, SLATE, SLATLN, QUNIT.
-+CDE, MQCM.
-+CDE, FLINKC.
-+CDE, SHMKC, Q, PY, ADDSH.
-C-------------- End CDE --------------------------------
- CHARACTER LINE*256
- EQUIVALENCE (LINE, SLLINE)
-
-
-C-- construct the name of the .xqtlog file
-
- CHLIFI = CHNLOG(1:NNLOG) // '.xqtlog'
- NLIFI = NNLOG + 7
-
-C-- get the .xqtlog file into memory
-
- IXTEMP = NA_LONG (CHLIFI(1:NLIFI))
- CALL INIPAM (11, IXTEMP, 0,2)
- IF (IXFLUN.LT.0) RETURN
-
- MODE = 0
- 20 LQLEND(2) = LQLSTA(2)
- IQ(LQHOLD+2) = 0
- CALL ARRIVE (3)
-+SELF, IF=XDEBUG, IF=XYSHELL.
- WRITE (IQPRNT,9020) IQ(LQHOLD+2),CHLIFI(1:NLIFI)
- 9020 FORMAT (' Dbg: reading',I6,' lines from file ',A)
-+SELF.
-
-+SEQ, QEJECT.
-C---- Do next line
-
- JSLIN = IQ(LQHOLD+1) - 1
- NSLIN = IQ(LQHOLD+2)
- JSLEND = JSLIN + NSLIN
-
- 21 JSLIN = JSLIN + 1
- IF (JSLIN.GT.JSLEND) GO TO 69
-
- CALL LN_GET (JSLIN,LINE,512)
- NXX = NDSLAT
- IF (NXX.EQ.0) GO TO 21
- NXX = LNBLNK (LINE(1:NXX))
- IF (NXX.EQ.0) GO TO 21
-
- IF (MODE.NE.0) GO TO 22
- IF (LINE(1:8).NE.'>.xqtlog') GO TO 91
- MODE = 1
- GO TO 21
-
-C-- get the logical stream type:n
-
- 22 JTA = ICNEXT (LINE,2,NXX)
- JTE = NESLAT
- NTA = NDSLAT
- IF (JTA.GE.7) GO TO 91
- IF (NTA.LT.3) GO TO 91
- CALL SMCODE (LINE(JTA:JTA+NTA-1))
- IF (JXTYP.EQ.0) GO TO 91
- IF (JXTYP.GT.3) GO TO 91
- IF (JXACT.NE.4) GO TO 91
- IF (MODE.GE.2) GO TO 24
-
-C-- get the compiler options in the prelude
-
- IF (LINE(1:1).NE.'>') GO TO 23
- IF (JTE.GT.NXX) GO TO 21
- JNA = ICFNBL (LINE,JTE,NXX)
- IXOPTP(JXSTR,JXTYP) = NA_LONG (LINE(JNA:NXX))
- GO TO 21
-
-C-- get the routine name
-
- 23 MODE = 2
- 24 JNA = ICNEXT (LINE,JTE,NXX)
- JNE = NESLAT
- NNA = NDSLAT
- IF (NNA.EQ.0) GO TO 91
-
-C---- register the new routine name
-
- IXNAME = NA_LONG (LINE(JNA:JNA+NNA-1))
- NROUT = NROUT + 1
- IF (NROUT.GT.NRTSZ) GO TO 93
- NNAME(NROUT) = ((IXNAME*8 + JXTYP)*8 + JXSTR)*4
- GO TO 21
-
-C---- Done
-
- 69 IF (JDKNEX.LT.4) GO TO 20
- CALL INIPAM (0,0, -1,0)
- NRXQT = NROUT
-+SELF, IF=XDEBUG, IF=XYSHELL.
- WRITE (IQPRNT,9071) NRXQT
- 9071 FORMAT (' Dbg: SMRXQT has read',I5,' routines for options:')
-
- DO 74 JTYP=1,3
- DO 73 JSTR=1,4
- IX = IXOPTP(JSTR,JTYP)
- IF (IX.EQ.0) GO TO 73
- LINE = ' '
- CALL SMSID (JTYP,JSTR,LINE,4)
- CALL NA_GET (IX,LINE,12)
- WRITE (IQPRNT,'(A)') LINE(1:NESLAT-1)
- 73 CONTINUE
- 74 CONTINUE
-+SELF.
- RETURN
-
-C---- Fault
-
- 91 CALL INIPAM (0,0, -1,0)
- CALL P_KILL ('Not a valid .xqtlog file')
-
- 93 WRITE (IQPRNT,9093) NRTSZ
- 9093 FORMAT (/' ***!!! More than',I7,' routines !!!***'
- F/' complain to zoll at cern.ch')
-
- CALL P_KILL ('Too many routines')
- END
-+SEQ, QCARDL. =====================================================
-+DECK, SMSID.
- SUBROUTINE SMSID (JTYP,JSTR,LINE,JCOL)
-
-C- Set the stream ID like fort:3
-C. started 5-may-94
-
- CHARACTER LINE*(*)
-
-
- J = JCOL
- IF (JTYP.EQ.1) THEN
- LINE(J:J+3) = 'fort'
- J = J + 4
- ELSEIF (JTYP.EQ.2) THEN
- LINE(J:J+1) = 'cc'
- J = J + 2
- ELSE
- LINE(J:J+1) = 'as'
- J = J + 2
- ENDIF
-
- LINE(J:J) = ':'
- CALL CSETDI (JSTR, LINE,J+1,J+1)
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+PATCH, AUXIL. Service routines for the Auxiliaries
-+DECK, INIAUX.
- SUBROUTINE INIAUX (LASTWSP)
-
-C- Initialize for the Auxiliaries
-C. started 12-jan-94
-
-+CDE, QBITS19, QBANKS.
-+CDE, CM_TYP, TAGC, TITLEC, Q, PY.
-+CDE, M_ANAC.
-C-------------- End CDE --------------------------------
- DIMENSION LASTWSP(9)
-
-
- CALL MQWORK (LACRAD,INCRAD,LASTWSP)
- NFILET = 0
-
- NVGAP(1) = 4000
- NVGAP(2) = 200
- NVGAP(3) = 5000
- NVGAP(4) = 40
-
- NCHTAG = 0
- CALL VZERO (LOWAN,12)
-
-C-- Pre-lift the banks for I/O handling
-
- CALL MQLIFT (LACRAD, 0,7, JBKARR,3)
- CALL MQLIFT (LPAM, 0,7, JBKPAM,3)
- CALL MQLIFT (LQARRV, 0,7, JBKARR,3)
- CALL MQLIFT (LQHOLD, 0,7, JBKHOL,1)
- LARRV = LQARRV
-
-C---- Lift the ASM banks
-
- N_TYP = 0
- NAL_TYP = 2
-
- JAL = MAX_TYP - NAL_TYP
-
- CH_TYP(JAL+1) = 'R*EPEAT'
- CH_TYP(JAL+2) = 'J*OIN'
- JU_TYP(JAL+1) = -1
- JU_TYP(JAL+2) = -2
-
-C-- lift the support bank ASMH
-
- CALL MQLIFT (LHASM, 0,7, JBKSMH,3)
-
-C-- lift the ASMT banks
-
- CALL ASMCREA ('FORT', JASM, 0)
- CALL ASMCREA ('CC', JASM, 0)
- CALL ASMCREA ('AS', JASM, 0)
- CALL ASMCREA ('DATA', JASM, 0)
- CALL ASMCREA ('SHELL', JASM, 0)
- CALL ASMCREA ('CRAD', JASM, 0)
- CALL ASMCREA ('INCL', JASM, 0)
-
-C---- Create standard aliases
-
-+SELF, IF=BACKCOMP.
- JAL = JAL - 4
- CH_TYP(JAL+1) = 'CO*MPILE'
- CH_TYP(JAL+2) = 'X*CC'
- CH_TYP(JAL+3) = 'A*S*'
- CH_TYP(JAL+4) = 'D*ATA'
-
- JU_TYP(JAL+1) = JFO_TYP
- JU_TYP(JAL+2) = JCC_TYP
- JU_TYP(JAL+3) = JAS_TYP
- JU_TYP(JAL+4) = JDA_TYP
-
- NAL_TYP = MAX_TYP - JAL
-+SELF.
-
-
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, INIPAM.
- SUBROUTINE INIPAM (LUNU, IXFILE, IFLAG,IFLEX)
-
-C- Connect PAM file for auxiliaries
-C- IFLAG => 0 start PAM file, with log print if >0
-C- < 0 close the PAM file
-C-
-C- IFLEX = 2 the file does not need to exist
-C- 0 fatal exit for OPEN failure
-C. started 12-jan-94
-
-+CDE, SLATE, SLATLN, QUNIT.
-+CDE, ARRCOM, Q, PY.
-+CDE, FLINKC.
-C-------------- End CDE --------------------------------
-+SEQ, bkARRV, IF=DOC_INL.
-+SEQ, QEJECT.
-
-C---- Connect the PAM file
-
- IF (IFLAG.LT.0) GO TO 41
-
- IN_LUN = LUNU
- IXFLUN = IXFILE
- IF (IXFLUN.EQ.0) GO TO 91
-
- CALL FLINK (IN_LUN, 2, -1, IFLEX)
- IF (IXFLUN.LT.0) RETURN
- IQ(LARRV+1) = IN_LUN
- IQ(LARRV+2) = LUNFD
- IQ(LARRV+4) = IXFLUN
- IQ(LARRV+6) = LUNSIZ
- IQ(LARRV+7) = -2
-+SELF, IF=QCIO.
- IF (LUNSIZ.GT.0) IQ(LARRV+7)= 0
-+SELF.
- JDKTYP = 3
- JDKNEX = 0
-+SELF, IF=-XDEBUG.
- IF (IFLAG.EQ.0) RETURN
-+SELF.
-C-- Print log of file reading
-
- SLLINE(1:25) = ' ---> start reading file '
- CALL NA_GET (IXFLUN,SLLINE,26)
- NTXT = NESLAT - 1
- CALL DPBLAN (0)
- WRITE (IQPRNT,9027) SLLINE(1:NTXT)
- IF (IQTYPE.NE.IQPRNT) WRITE (IQTYPE,9027) SLLINE(1:NTXT)
- 9027 FORMAT (A/)
- RETURN
-
-C---- Disconnect the PAM file
-
- 41 IN_DOX = -1
- CALL ARRIN
- RETURN
-
-C---- Trouble
-
- 91 CALL P_KILL ('No PAM file name given')
- END
-+SEQ, QCARDL. =====================================================
-+DECK, CCJOIN.
- SUBROUTINE CCJOIN
-
-C- Check T=JOIN is present on current control line
-
-+CDE, CCPARA, QPAGE.
-C-------------- End CDE --------------------------------
-
-
- IF (NQJOIN.LT.0) RETURN
- NQJOIN = 0
- IF (NCCPT.EQ.0) RETURN
- LOC = JCCPT
- NTH = NCCPT
- 24 LOC = LOC + 3
- JXX = MCCPAR(LOC+1)
- NXX = MCCPAR(LOC+2)
- J = ICNTH (CCKARD(JXX:JXX+NXX-1),'J*OIN ',1)
- IF (J.NE.0) GO TO 27
- NTH = NTH - 1
- IF (NTH.GT.0) GO TO 24
- RETURN
-
- 27 NQJOIN = 1
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, DOMAPA.
- SUBROUTINE DOMAPA (IFLACT)
-
-C- Content analysis of the next deck for the Auxiliaries,
-C- map the description of this deck's material
-C- into the control-banks of the linear PREP structure.
-C- Merge actions if IFLACT not zero
-C. started 12-jan-94
-
-+CDE, QBANKS, Q, PY.
-+CDE, M_ANAC.
-C-------------- End CDE --------------------------------
-
-+SEQ, Q_JBYT.
-
-
- JSLZER = IQ(LQHOLD+1)
- JSLORG = JSLZER
-
-C-- create the PREP seedling
-
- CALL MQLIFT (LQPREP, 0,7, JBKPRE,2)
-
- IQ(LQPREP+1) = JSLZER
- IQ(LQPREP+2) = IQ(LQHOLD+3)
-
-C---- stage 1 : delimit control lines, create PREP structure
-
- CALL M_ANA1
-
- IF (IFLACT.EQ.0) RETURN
- IF (LEXD.EQ.0) RETURN
- IF (LQ(LEXD-2).EQ.0) RETURN
-
-C---- stage 2 : split PREP banks on action limits
-
- LDO = LQPREP
- LACT = LEXD - 1
-
-C-- Next action
-
- 21 LACT = LQ(LACT-1)
- IF (LACT.EQ.0) RETURN
-
-C- JACT = 0 DEL, 1 REP, 2 ADB, 3 ADD
-
- JACT = JBYT (IQ(LACT),9,3)
- JSLX = IQ(LACT+4) + JSLZER
-
-C- break at the insertion point
-
- LDO = M_SPLIT (LDO,JSLX)
- IF (LDO.EQ.0) GO TO 61
-
-C- zero-line PREP bank with reference to ACT
-
- LX = LDO
- LDO = M_SPLIT (LDO,0)
- LQ(LX-2) = LACT
- GO TO 21
-
-C-- Add trailing actions
-
- 61 LNEW = KQLAST (LQPREP-1) + 1
- 62 CALL MQLIFT (LNEW,LNEW,-1,JBKPRE,2)
- LQ(LNEW-2) = LACT
-
- LACT = LQ(LACT-1)
- IF (LACT.NE.0) GO TO 62
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, KROPT.
- SUBROUTINE KROPT (IXOPT,MASK)
-
-C- Krack the option parameter into MOPTIO(34)
-C. started 13-jan-94
-
-+CDE, SLATE, SLATLN, QCHAR.
-+CDE, Q, PY.
-C-------------- End CDE --------------------------------
- CHARACTER LINE*80, COL(80)*1
- EQUIVALENCE (LINE,SLLINE), (COL,SLLINE)
-
-+SEQ, Q_AND.
-
-
- MOPTIO(34) = 0
- IF (IXOPT.EQ.0) GO TO 37
-
- CALL NA_GET (IXOPT,LINE,1)
- NN = NDSLAT
-
-+SELF, IF=XDEBUG.
- PRINT *, ' Dbg KROPT: opt string= ',LINE(1:NN)
-
-+SELF.
- DO 24 JL=1,NN
- J = INDEX (CQCETA(1:32),COL(JL))
- IF (J.NE.0) CALL SBIT1 (MOPTIO(34),J)
- 24 CONTINUE
-
- 37 MOPTIO(33) = IAND (MOPTIO(34),MASK)
- CALL UPKBYT (MOPTIO(33),1,MOPTIO(1),32,0)
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, PGSIZE.
- SUBROUTINE PGSIZE (MODE,IXOPT)
-
-C- Set (MODE=0) or print (=1) page size
-C. started 17-jan-94
-
-+CDE, SLATE, SLATLN.
-+CDE, QPAGE, QUNIT.
-+CDE, Q, PY.
-C-------------- End CDE --------------------------------
- CHARACTER LINE*80
- EQUIVALENCE (LINE,SLLINE)
-
- DIMENSION LILENG(5)
- DATA LILENG / 56, 62, 74, 84, 98 /
-
-+SEQ, Q_JBIT.
-
-
- IF (MODE.NE.0) GO TO 41
- DO 24 J=1,5
- IF (JBIT(MOPTIO(34),J+26).NE.0) NQLMAX= LILENG(J)
- 24 CONTINUE
-
- CALL NA_GET (IXOPT,LINE,1)
- NN = NDSLAT
-
- J = 0
- 26 J = J + 1
- IF (J.GE.NN) GO TO 29
- NL = ICDECI (LINE,J,NN)
- IF (NDSLAT.LT.2) GO TO 26
- IF (NL.LT.20) GO TO 26
- NQLMAX = NL
-
- 29 CALL MQPAGE
- RETURN
-
- 41 CALL DPBLAN (1)
- WRITE (IQPRNT,9041) NQLMAX, LILENG
- RETURN
-
- 9041 FORMAT (' Page size used:',I5,' lines per page'
- F/' Available with option O:',I3,
- F' 1:',I3,' 2:',I3,' 3:',I3,' 4:',I3)
- END
-+SEQ, QCARDL. =====================================================
-+DECK, XEJECT.
- SUBROUTINE XEJECT
-
-C- Check and act on +SEQ, QEJECT, N=n
-C. started 12-jan-94
-
-+CDE, CCPARA, QPAGE, QUNIT, Q.
-+CDE, M_ANAC.
-C-------------- End CDE --------------------------------
-
-+SEQ, xJSPSEQ, IF=DOC_INL.
-+SEQ, JSPSEQ.
- PARAMETER (IXEJ = JSPSEQ1 + 1)
-
-
- CALL CCKRAK (IQ(LDOAN+1))
-
- IF (JCCBAD.NE.0) RETURN
- IF (NCCPZ.NE.1) RETURN
- IF (MCCPAR(JCCPZ+1).NE.IXEJ) RETURN
-
- NN = MCCPAR(JCCPN+1)
- IF (NN.LT.0) NN = NQLMAX
- IF (NN.EQ.0) NN = NQLMAX - 6
- IF (NQUSED+NN.LE.NQLMAX) RETURN
- NQUSED = NQLMAX
- CALL DPPAGE
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+PATCH, DQ. Debug routines
-+DECK, DQCLOBB.
- SUBROUTINE DQCLOBB (LNAME,LSTAT)
-
-C- Bank chaining clobbered has been detected at LNAME or LSTAT
-C- scan all divisions and print the last 4 good banks
-
-+CDE, QUNIT, MQCM, MQCN, QSH.
-C-------------- End CDE --------------------------------
- DIMENSION LLAST(4)
-
-
- WRITE (IQPRNT,9000)
- IF (LNAME.NE.0) THEN
- WRITE (IQPRNT,9001) 'name',LNAME
- ELSE
- WRITE (IQPRNT,9001) 'status',LSTAT
- ENDIF
-
- 9000 FORMAT (/' ****!!!!! Patchy is crashing !!!!!****'
- F/' please call for help: zoll at cern.ch')
- 9001 FORMAT (/' Bank chaining clobbered at ',A,' adr',I7)
-
-C---- Next division
-
- JDIV = 0
- 21 JDIV = JDIV + 1
- IF (JDIV.GT.3) GO TO 99
-
- LNA = LQCSTA(JDIV)
- LEND = LQCEND(JDIV)
-
- WRITE (IQPRNT,9022) JDIV,LNA,LEND
- 9022 FORMAT (/' Division',I2,' boundaries:',2I7)
-
-C---- Scan to the trouble splot
-
- CALL VZERO (LLAST,4)
-
- 31 IF (LNA.GE.LEND) GO TO 21
- CALL QBLOWX (LNA)
- IF (IQFOUL.NE.0) GO TO 41
-
- CALL UCOPY (LLAST(2),LLAST(1),3)
- LLAST(4) = LNA
- LNA = IQLNX
- GO TO 31
-
-C---- Trouble spot found, dump the last 4 banks
-
- 41 LNATR = LNA
- WRITE (IQPRNT,9041)
- 9041 FORMAT (/' After:')
-
- JBK = 0
- 42 JBK = JBK + 1
- IF (JBK.GT.4) GO TO 44
- LNA = LLAST(JBK)
- IF (LNA.EQ.0) GO TO 42
-
- CALL QBLOWX (LNA)
- CALL DQBANK
- GO TO 42
-
-C---- Find the first good bank after
-
- 44 LOK = 0
- LNA = LNATR
- 45 LNA = LNA + 1
- IF (LNA.GE.LEND-4) GO TO 46
- CALL QBLOWX (LNA)
- IF (IQFOUL.NE.0) GO TO 45
- LOK = LNA
-
- 46 LNAE = MIN (LNA, LNATR+39)
-
- WRITE (IQPRNT,9046)
- 9046 FORMAT (/' the memory is destroyed, dump the next few words:'/)
- 9047 FORMAT (1X,I8,' :',Z10,I20)
-
- DO 47 L=LNATR,LNAE
- WRITE (IQPRNT,9047) L,LQ(L),LQ(L)
- 47 CONTINUE
- IF (LOK.EQ.0) GO TO 21
-
- WRITE (IQPRNT,9049) LOK
- 9049 FORMAT (/' The first good bank after, starting at adr',I8,' is:')
-
- CALL DQBANK
- GO TO 21
-
-C---- Exit
-
- 99 CALL P_KILL ('fatal')
- END
-+SEQ, QCARDL. =====================================================
-+DECK, DQBANK.
- SUBROUTINE DQBANK
-
-C- Dump the bank whose parameters are in /MQCN/
-
-+CDE, SLATLN.
-+CDE, QBITS19, QBANKS, QUNIT, MQCM, QSYSBITS, Q.
-+CDE, MQCN.
-C-------------- End CDE --------------------------------
- INTEGER INTID
- CHARACTER CHID*4, WK*2, CHK*1
- EQUIVALENCE (CHID,INTID)
-
- CHARACTER LINE*48, LINEZ*30, COLZ(30)*1, LINEWH*34
- EQUIVALENCE (LINE,SLLINE), (LINEZ,SLLINE(81:)), (COLZ,LINEZ)
- +, (LINEWH,SLLINE(161:))
-
-+SEQ, Q_JBYT, Q_AND.
-
-
- LNA = IQLNA
- LBK = IQLST
-
- INTID = MMBANK(1,IQTY)
-
- IF (IAND(IQ(LNA),KMDROP).NE.0) THEN
- CHK = '_'
- ELSE
- CHK = ' '
- ENDIF
-
- IF (IQNL.GT.0) THEN
- NLP = MIN (IQNL,6)
- CALL UCOPIV (LQ(LBK-NLP), IQUEST, NLP)
- WRITE (IQPRNT,9022) LBK,CHK,CHID,IQLI,IQNL,IQNS,IQND,
- + (IQUEST(J),J=1,NLP)
- ELSE
- WRITE (IQPRNT,9022) LBK,CHK,CHID,IQLI,IQNL,IQNS,IQND
- ENDIF
-
- 9022 FORMAT (/1X,I6,A,A,' LI/NL/NS/ND= ',I1,2I3,I5,:,
- F', links:',6I7)
-
-C-- Print the object identifier
-
- SLLINE = ' '
-
- IF (IQTY.EQ.JBKPAT) THEN
- WK = 'P='
- IX = IQ(LBK+2)
- ELSEIF (IQTY.EQ.JBKDEC) THEN
- WK = 'D='
- IX = IQ(LBK+1)
- ELSEIF (IQTY.EQ.JBKKEE) THEN
- WK = 'Z='
- IX = IQ(LBK+4)
- ELSE
- GO TO 30
- ENDIF
-
- LINEWH(1:2) = WK
- CALL NA_GET (IX, LINEWH, 3)
-
- N = LENOCC (LINEWH)
- WRITE (IQPRNT,9029) LINEWH(1:N)
- 9029 FORMAT (13X,A)
-
-C---- Dump status word
-
- 30 IF (IQTY.EQ.JBKPRE) GO TO 31
- IF (IQTY.EQ.JBKXSQ) GO TO 31
- IF (IQTY.EQ.JBKMAT) GO TO 31
- IF (IQTY.EQ.JBKKEE) GO TO 31
- IF (IQTY.NE.JBKACT) GO TO 61
-
- 31 MSTAT = IQ(LBK)
- CALL UPKBYT (MSTAT,1,IQUEST,30,0)
-
- DO 32 J=1,30
- IF (IQUEST(31-J).EQ.0) THEN
- LINEZ(J:J) = '.'
- ELSE
- LINEZ(J:J) = '1'
- ENDIF
- 32 CONTINUE
- IF (COLZ(27).NE.'.') COLZ(27) = 'X'
- IF (COLZ(28).NE.'.') COLZ(28) = 'D'
- IF (COLZ(29).NE.'.') COLZ(29) = 'L'
- IF (COLZ(30).NE.'.') COLZ(30) = 'E'
- IF (IQTY.EQ.JBKKEE) GO TO 33
-
- IF (COLZ(25).NE.'.') COLZ(25) = 'K'
- IF (COLZ(26).NE.'.') COLZ(26) = 'D'
- IF (IQTY.EQ.JBKACT) GO TO 34
-
-C-- PREP & XSQ & MAT
-
- LINE(3:8) = LINEZ(11:16)
-
- JC = JBYT(MSTAT,9,6)
- CALL CSETDI (JC,LINE,9,11)
- GO TO 36
-
-C-- KEEP & ACT
-
- 33 IF (COLZ(25).NE.'.') COLZ(25) = 'A'
- IF (COLZ(26).NE.'.') COLZ(26) = 'U'
- 34 LINE(1:9) = LINEZ(11:19)
-
- JC = JBYT(MSTAT,9,3)
- CALL CSETDI (JC,LINE,10,11)
-
- 36 LINE(13:14) = LINEZ(23:24)
- LINE(16:17) = LINEZ(25:26)
- LINE(19:22) = LINEZ(27:30)
-
- 37 WRITE (IQPRNT,9037) LINE(1:22)
- 9037 FORMAT (13X,'st: ',A)
-
-C---- Print line content
-
- 61 IF (IQLI.EQ.0) GO TO 77
-
- JSLA = IQ(LBK+1)
- NSL = IQ(LBK+2)
-
- WRITE (IQPRNT,9062) NSL,JSLA
- 9062 FORMAT (13X,'with',I6,' lines at JSLA',I7)
-
- IF (JSLA.EQ.0) GO TO 77
- IF (JSLA.EQ.1) GO TO 77
- IF (NSL.EQ.0) GO TO 77
- IF (JSLA.LT.0) GO TO 93
- IF (JSLA.GE.LQLSTA(5)) GO TO 93
-
-C-- print first line in lot
-
- JSLU = JSLA
- JTXA = MLIAD(JSLU)
- JTXE = MLIAD(JSLU+1)
- NTX = JTXE - JTXA - NCHNEWL
-
- IF (NTX.LT.0) GO TO 94
- IF (NTX.GE.513) GO TO 94
- N = MIN (NTX,60)
-
- CALL LN_GET (JSLU,SLLINE,N)
- WRITE (IQPRNT,9063) SLLINE(1:N)
-
- 9063 FORMAT (17X,'first: ',A)
- 9064 FORMAT (17X,' last: ',A)
-
-C-- print last line in lot
-
- IF (NSL.LE.1) GO TO 77
- JSLU = JSLA + NSL - 1
- JTXA = MLIAD(JSLU)
- JTXE = MLIAD(JSLU+1)
- NTX = JTXE - JTXA - NCHNEWL
-
- IF (NTX.LT.0) GO TO 94
- IF (NTX.GE.513) GO TO 94
- N = MIN (NTX,60)
-
- CALL LN_GET (JSLU,SLLINE,N)
- WRITE (IQPRNT,9064) SLLINE(1:N)
-
- 77 RETURN
-
-C---- trouble
-
- 93 WRITE (IQPRNT,9093)
- 9093 FORMAT (/' ***!!! JSL invalid !!!***')
- GO TO 97
-
- 94 WRITE (IQPRNT,9094) JSLU,JTXA,JTXE
- 9094 FORMAT (/' ***!!! trouble with line at slot',I6
- F/5X,'JTXA =',Z10/5X,'JTXE =',Z10)
-
- 97 IQFOUL = -1
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+PATCH, KERN. Pending routines for Kernlib
-+DECK, TMINIT, IF=QS_IBMVM.
- SUBROUTINE TMINIT (IFLAG)
-C
-C CERN PROGLIB# Z313 TMINIT .VERSION KERNFOR 4.37 930715
-C ORIG. 16/02/94, JZ
-C
-C Initialize TMPRO / TMREAD
-C
-
- IFLAG = 7
- RETURN
- END
-+USE, CCGEN, D=TMINIT, T=INH.
-+DECK, TMPRO, T=JOIN, IF=QS_IBMVM.
- SUBROUTINE TMPRO (TEXT)
-C
-C CERN PROGLIB# Z313 TMPRO .VERSION KERNFOR 4.37 930715
-C ORIG. 16/02/94, JZ
-C
-C Print a prompt string to stdout
-C
- CHARACTER TEXT*(*)
-
- WRITE (6,9001) TEXT
-+SELF, IF=QS_IBMVM.
- 9001 FORMAT (1X,A)
-+SELF, IF=QS_VMS.
- 9001 FORMAT (1X,A,$)
-+SELF.
- RETURN
- END
-+USE, CCGEN, D=TMPRO, T=INH.
-+DECK, TMREAD, T=JOIN, IF=QS_IBMVM.
- SUBROUTINE TMREAD (MAXCH, LINE, NCH, ISTAT)
-C
-C CERN PROGLIB# Z313 TMREAD .VERSION KERNFOR 4.37 930715
-C ORIG. 16/02/94, JZ
-C
-C Read the next line from stdin
-C
- CHARACTER LINE*512
-
- READ (5,NUM=NCH,ERR=91,END=49) LINE(1:MAXCH)
-
- NCH = MIN(NCH,MAXCH)
- ISTAT = 0
- RETURN
-
- 49 ISTAT = -1
- RETURN
-
- 91 ISTAT = 7
- RETURN
- END
-+USE, CCGEN, D=TMREAD, T=INH.
-+DECK, FTOIBM, IF=QS_IBMVM.
- SUBROUTINE FTOIBM (CHFI, NFI)
-
-C- Convert "name.ext.disk" or "disk/name.ext"
-C- to "/name ext disk" for IBM
-
- COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT, DUMMY(36)
- CHARACTER CHFI*(*)
- CHARACTER CHNAME*27, CHEXT*8, CHDIR*8
- EQUIVALENCE (CHEXT, CHNAME(11:18)), (CHDIR, CHNAME(20:27))
-
-
- CHNAME = '/'
- JSLASH = ICFIND ('/', CHFI,1,NFI)
- IF (NGSLAT.NE.0) THEN
- CHDIR = CHFI(1:JSLASH-1)
- JNAM = JSLASH + 1
- ELSE
- CHDIR = 'A'
- JNAM = 1
- ENDIF
-
- JDOT = ICFIND ('.', CHFI,JNAM,NFI)
- JDT2 = ICFIND ('.', CHFI,JDOT+1,NFI)
-
- N = MIN (8,JDOT-JNAM)
- IF (N.GT.0) CHNAME(2:N+1)= CHFI(JNAM:JNAM+N-1)
-
- IF (JDOT.LT.NFI) THEN
- CHEXT = CHFI(JDOT+1:JDT2-1)
- ENDIF
-
- IF (JDT2.LT.NFI) THEN
- CHDIR = CHFI(JDT2+1:NFI)
- ENDIF
-
- CALL CLTOU (CHNAME)
- CHFI = CHNAME
- NFI = LNBLNK(CHNAME)
- RETURN
- END
-+PATCH, TESTR. Routines used for testing
-+DECK, DIVLIM.
- SUBROUTINE DIVLIM
-
-C- Print the division limits
-C. started 15-june-94
-
-+CDE, QUNIT, MQCM, Q.
-C-------------- End CDE --------------------------------
-
-
- WRITE (IQPRNT,9011) (LQCSTA(J),LQCEND(J),J=1,3)
- 9011 FORMAT (/' Control divisions 1 to 3:',6I6)
-
- WRITE (IQPRNT,9012) (LQLSTA(J),LQLEND(J),J=1,4)
- 9012 FORMAT (/' Text divisions 1 to 4:'/' slot adr ',8I8)
-
- WRITE (IQPRNT,9013) (MLIAD(LQLSTA(J)),MLIAD(LQLEND(J)),J=1,4)
- 9013 FORMAT (' text adr ',8I8/)
-
- NQLLBL = 1
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, TNAPUT, T=JOIN.
- SUBROUTINE TNAPUT (IFLAG,NAME)
-
-C- Test the name handler
-
-+CDE, QUNIT, SLATE.
-C-------------- End CDE --------------------------------
- CHARACTER NAME*(*)
- CHARACTER LINE*64
-
-
- CALL CFILL ('xxxx',LINE,1,64)
-
- NLG = MIN (LEN(NAME), 40)
- LINE(11:10+NLG) = NAME(1:NLG)
-
- IF (IFLAG.NE.0) GO TO 41
-
-C-- Find the name only
-
- JNA = NA_CHK (LINE,11,11+NLG)
-
- WRITE (IQPRNT,9024) JNA,NDSLAT,NAME
- RETURN
-
-C-- Put the name
-
- 41 JNA = NA_NEW (LINE,11,11+NLG)
-
- WRITE (IQPRNT,9044) JNA,NDSLAT,NAME
- RETURN
-
- 9024 FORMAT (4X,'Find:',I6,I4,2X,A)
- 9044 FORMAT (4X,'Put: ',I6,I4,2X,A)
- END
-+DECK, KMPRINT.
- SUBROUTINE KMPRINT
-
-C- Print the KM parameters
-
-+CDE, QUNIT, QBITA31.
-C-------------- End CDE --------------------------------
-
-
- MUST = 1
- JHAV = KM1
- IF (JHAV.NE.MUST) WRITE (IQPRNT,9011) MUST,JHAV
- JHAV = KMA
- IF (JHAV.NE.MUST) WRITE (IQPRNT,9011) MUST,JHAV
-
- MUST = 2*MUST
- JHAV = KM2
- IF (JHAV.NE.MUST) WRITE (IQPRNT,9011) MUST,JHAV
- JHAV = KMB
- IF (JHAV.NE.MUST) WRITE (IQPRNT,9011) MUST,JHAV
-
- MUST = 2*MUST
- JHAV = KM3
- IF (JHAV.NE.MUST) WRITE (IQPRNT,9011) MUST,JHAV
- JHAV = KMC
- IF (JHAV.NE.MUST) WRITE (IQPRNT,9011) MUST,JHAV
-
- MUST = 2*MUST
- JHAV = KM4
- IF (JHAV.NE.MUST) WRITE (IQPRNT,9011) MUST,JHAV
- JHAV = KMD
- IF (JHAV.NE.MUST) WRITE (IQPRNT,9011) MUST,JHAV
-
- MUST = 2*MUST
- JHAV = KM5
- IF (JHAV.NE.MUST) WRITE (IQPRNT,9011) MUST,JHAV
- JHAV = KME
- IF (JHAV.NE.MUST) WRITE (IQPRNT,9011) MUST,JHAV
-
- MUST = 2*MUST
- JHAV = KM6
- IF (JHAV.NE.MUST) WRITE (IQPRNT,9011) MUST,JHAV
- JHAV = KMF
- IF (JHAV.NE.MUST) WRITE (IQPRNT,9011) MUST,JHAV
-
- MUST = 2*MUST
- JHAV = KM7
- IF (JHAV.NE.MUST) WRITE (IQPRNT,9011) MUST,JHAV
- JHAV = KMG
- IF (JHAV.NE.MUST) WRITE (IQPRNT,9011) MUST,JHAV
-
- MUST = 2*MUST
- JHAV = KM8
- IF (JHAV.NE.MUST) WRITE (IQPRNT,9011) MUST,JHAV
- JHAV = KMH
- IF (JHAV.NE.MUST) WRITE (IQPRNT,9011) MUST,JHAV
-
- MUST = 2*MUST
- JHAV = KM9
- IF (JHAV.NE.MUST) WRITE (IQPRNT,9011) MUST,JHAV
- JHAV = KMI
- IF (JHAV.NE.MUST) WRITE (IQPRNT,9011) MUST,JHAV
-
- MUST = 2*MUST
- JHAV = KM10
- IF (JHAV.NE.MUST) WRITE (IQPRNT,9011) MUST,JHAV
- JHAV = KMJ
- IF (JHAV.NE.MUST) WRITE (IQPRNT,9011) MUST,JHAV
-
- MUST = 2*MUST
- JHAV = KM11
- IF (JHAV.NE.MUST) WRITE (IQPRNT,9011) MUST,JHAV
- JHAV = KMK
- IF (JHAV.NE.MUST) WRITE (IQPRNT,9011) MUST,JHAV
-
- MUST = 2*MUST
- JHAV = KM12
- IF (JHAV.NE.MUST) WRITE (IQPRNT,9011) MUST,JHAV
- JHAV = KML
- IF (JHAV.NE.MUST) WRITE (IQPRNT,9011) MUST,JHAV
-
- MUST = 2*MUST
- JHAV = KM13
- IF (JHAV.NE.MUST) WRITE (IQPRNT,9011) MUST,JHAV
- JHAV = KMM
- IF (JHAV.NE.MUST) WRITE (IQPRNT,9011) MUST,JHAV
-
- MUST = 2*MUST
- JHAV = KM14
- IF (JHAV.NE.MUST) WRITE (IQPRNT,9011) MUST,JHAV
- JHAV = KMN
- IF (JHAV.NE.MUST) WRITE (IQPRNT,9011) MUST,JHAV
-
- MUST = 2*MUST
- JHAV = KM15
- IF (JHAV.NE.MUST) WRITE (IQPRNT,9011) MUST,JHAV
- JHAV = KMO
- IF (JHAV.NE.MUST) WRITE (IQPRNT,9011) MUST,JHAV
-
- MUST = 2*MUST
- JHAV = KM16
- IF (JHAV.NE.MUST) WRITE (IQPRNT,9011) MUST,JHAV
- JHAV = KMP
- IF (JHAV.NE.MUST) WRITE (IQPRNT,9011) MUST,JHAV
-
- MUST = 2*MUST
- JHAV = KM17
- IF (JHAV.NE.MUST) WRITE (IQPRNT,9011) MUST,JHAV
- JHAV = KMQ
- IF (JHAV.NE.MUST) WRITE (IQPRNT,9011) MUST,JHAV
-
- MUST = 2*MUST
- JHAV = KM18
- IF (JHAV.NE.MUST) WRITE (IQPRNT,9011) MUST,JHAV
- JHAV = KMR
- IF (JHAV.NE.MUST) WRITE (IQPRNT,9011) MUST,JHAV
-
- MUST = 2*MUST
- JHAV = KM19
- IF (JHAV.NE.MUST) WRITE (IQPRNT,9011) MUST,JHAV
- JHAV = KMS
- IF (JHAV.NE.MUST) WRITE (IQPRNT,9011) MUST,JHAV
-
- MUST = 2*MUST
- JHAV = KM20
- IF (JHAV.NE.MUST) WRITE (IQPRNT,9011) MUST,JHAV
- JHAV = KMT
- IF (JHAV.NE.MUST) WRITE (IQPRNT,9011) MUST,JHAV
-
- MUST = 2*MUST
- JHAV = KM21
- IF (JHAV.NE.MUST) WRITE (IQPRNT,9011) MUST,JHAV
- JHAV = KMU
- IF (JHAV.NE.MUST) WRITE (IQPRNT,9011) MUST,JHAV
-
- MUST = 2*MUST
- JHAV = KM22
- IF (JHAV.NE.MUST) WRITE (IQPRNT,9011) MUST,JHAV
- JHAV = KMV
- IF (JHAV.NE.MUST) WRITE (IQPRNT,9011) MUST,JHAV
-
- MUST = 2*MUST
- JHAV = KM23
- IF (JHAV.NE.MUST) WRITE (IQPRNT,9011) MUST,JHAV
- JHAV = KMW
- IF (JHAV.NE.MUST) WRITE (IQPRNT,9011) MUST,JHAV
-
- MUST = 2*MUST
- JHAV = KM24
- IF (JHAV.NE.MUST) WRITE (IQPRNT,9011) MUST,JHAV
- JHAV = KMX
- IF (JHAV.NE.MUST) WRITE (IQPRNT,9011) MUST,JHAV
-
- MUST = 2*MUST
- JHAV = KM25
- IF (JHAV.NE.MUST) WRITE (IQPRNT,9011) MUST,JHAV
- JHAV = KMY
- IF (JHAV.NE.MUST) WRITE (IQPRNT,9011) MUST,JHAV
-
- MUST = 2*MUST
- JHAV = KM26
- IF (JHAV.NE.MUST) WRITE (IQPRNT,9011) MUST,JHAV
- JHAV = KMZ
- IF (JHAV.NE.MUST) WRITE (IQPRNT,9011) MUST,JHAV
-
- MUST = 2*MUST
- JHAV = KM27
- IF (JHAV.NE.MUST) WRITE (IQPRNT,9011) MUST,JHAV
-
- MUST = 2*MUST
- JHAV = KM28
- IF (JHAV.NE.MUST) WRITE (IQPRNT,9011) MUST,JHAV
-
- MUST = 2*MUST
- JHAV = KM29
- IF (JHAV.NE.MUST) WRITE (IQPRNT,9011) MUST,JHAV
-
- MUST = 2*MUST
- JHAV = KM30
- IF (JHAV.NE.MUST) WRITE (IQPRNT,9011) MUST,JHAV
-
- MUST = 2*MUST
- JHAV = KM31
- IF (JHAV.NE.MUST) WRITE (IQPRNT,9011) MUST,JHAV
- RETURN
-
- 9011 FORMAT (' !!! KM for bit',I3,' is ',Z8,' !!!')
- END
-+DECK, DUMPSL.
- SUBROUTINE DUMPSL (JSLAX,NSLX,MSG)
-
-C- Dump the text content of the NSL slots starting at JSLA
-
-+CDE, QUNIT, Q.
-+CDE, SLATLN.
-C-------------- End CDE --------------------------------
- CHARACTER MSG*(*)
-
-
- JSLA = JSLAX
- NSL = NSLX
-
- JSLE = JSLA + NSL
- WRITE (IQPRNT,9000) NSL,JSLA,MSG
-
- 9000 FORMAT (/' DUMPSL: dump',I5,' lines at slot',I7,', ',A/)
-
- JSLE = MIN (JSLE, JSLA+4000)
- JSLU = JSLA - 1
- 21 JSLU = JSLU + 1
- IF (JSLU.GE.JSLE) RETURN
-
- JTXA = MLIAD(JSLU)
- JTXE = MLIAD(JSLU+1)
- NTX = JTXE - JTXA - NCHNEWL
-
- IF (NTX.LT.0) GO TO 91
- IF (NTX.GE.200) GO TO 91
- N = MIN (NTX,68)
-
- CALL LN_GET (JSLU,SLLINE,N)
- WRITE (IQPRNT,9024) JSLU,SLLINE(1:N)
- GO TO 21
-
- 9024 FORMAT (1X,I6,1X,A)
-
-C---- trouble
-
- 91 WRITE (IQPRNT,9091) JSLU,JTXA,JTXE
- RETURN
-
- 9091 FORMAT (/' ***!!! trouble with line at slot',I6
- F/5X,'JTXA =',Z10/5X,'JTXE =',Z10)
-
- END
-+SEQ, QCARDL. =====================================================
-+DECK, PRHOLD.
- SUBROUTINE PRHOLD
-
-C- Print the status of the HOLD bank
-
-+CDE, QUNIT, MQCM, Q, PY.
-+CDE, SLATLN.
-C-------------- End CDE --------------------------------
-
-
- JSLA = IQ(LQHOLD+1)
- NSLA = IQ(LQHOLD+2)
- NSLD = IQ(LQHOLD+3)
- JTTH = JDKTYP
- JTNX = JDKNEX
-
- WRITE (IQPRNT,9000) LQHOLD,JSLA,NSLD,NSLA,LQLEND(2),JTTH,JTNX
- 9000 FORMAT (' Xdebug: HOLD at',I5,' has JSL, NSLD, NSLALL=',I7,2I5
- F/25X,'LQLEND(2) =',I7
- F/25X,'type this/next=',2I4)
-
-C-- print first line in deck
-
- JSLU = JSLA
- JSER = JSLU - JSLA
- JTXA = MLIAD(JSLU)
- JTXE = MLIAD(JSLU+1)
- NTX = JTXE - JTXA - NCHNEWL
-
- IF (NTX.LT.0) GO TO 91
- IF (NTX.GE.200) GO TO 91
- N = MIN (NTX,40)
-
- CALL LN_GET (JSLU,SLLINE,N)
- WRITE (IQPRNT,9021) JSER,SLLINE(1:N)
-
-C-- print last line in deck
-
- IF (NSLD.LE.1) GO TO 23
- JSLU = JSLA + NSLD - 1
- JSER = JSLU - JSLA
- JTXA = MLIAD(JSLU)
- JTXE = MLIAD(JSLU+1)
- NTX = JTXE - JTXA - NCHNEWL
-
- IF (NTX.LT.0) GO TO 91
- IF (NTX.GE.200) GO TO 91
- N = MIN (NTX,40)
-
- CALL LN_GET (JSLU,SLLINE,N)
- WRITE (IQPRNT,9022) JSER,SLLINE(1:N)
-
-C-- print first line just after deck
-
- 23 IF (NSLA.LE.NSLD) RETURN
- JSLU = JSLA + NSLD
- JSER = JSLU - JSLA
- JTXA = MLIAD(JSLU)
- JTXE = MLIAD(JSLU+1)
- NTX = JTXE - JTXA - NCHNEWL
-
- IF (NTX.LT.0) GO TO 91
- IF (NTX.GE.200) GO TO 91
- N = MIN (NTX,40)
-
- CALL LN_GET (JSLU,SLLINE,N)
- WRITE (IQPRNT,9023) JSER,SLLINE(1:N)
- RETURN
-
- 9021 FORMAT (9X,'first in deck:',I5,1X,A)
- 9022 FORMAT (9X,' last in deck:',I5,1X,A)
- 9023 FORMAT (9X,' just after:',I5,1X,A)
-
-C---- trouble
-
- 91 WRITE (IQPRNT,9091) JSER,JTXA,JTXE
- RETURN
-
- 9091 FORMAT (/' ***!!! trouble with line',I5,' at slot',I6
- F/5X,'JTXA =',Z10/5X,'JTXE =',Z10)
-
- END
-+SEQ, QCARDL. =====================================================
-+DECK, DDSNAP.
- SUBROUTINE DDSNAP (MSG,MODE,JDIVX)
-
-C- Dump banks of division JDIVX
-
-C- if MODE =0 dump the whole division JDIV
-C- <0 dump what is new in division JDIV since last call
-
-+CDE, SLATLN.
-+CDE, QBITS19, QUNIT, MQCM, Q.
-+CDE, MQCN.
-C-------------- End CDE --------------------------------
- CHARACTER MSG*(*)
- CHARACTER CHK*1
-
- SAVE LIMLA
- INTEGER LIMLA(3)
- DATA LIMLA / 0, 0, 0 /
-
- LBK = MODE
- JDIV = JDIVX
- LIMLO = 0
- LIMHI = LQCEND(3)
-
- IF (LBK.GT.0) RETURN
- IF (LBK.NE.0) THEN
- CHK = ' '
- ELSE
- CHK = '1'
- ENDIF
- WRITE (IQPRNT,9000) CHK,MSG,LBK,JDIV
-
- 9000 FORMAT (/A,'------'/' DDSNAP for ',A,
- F ' with MODE=',I7,' and division',I3)
-
-C-- dump division
-
- JDIV = MAX (JDIV,1)
- JDIV = MIN (JDIV,3)
- LNA = LQCSTA(JDIV)
- LEND = LQCEND(JDIV)
- IF (LBK.LT.0) THEN
- IF (JDIV.EQ.1) THEN
- IF (LIMLA(1).GT.LQCEND(1)) LIMLA(1)= 0
- LIMLO = LIMLA(1)
- ELSEIF (JDIV.EQ.3) THEN
- IF (LIMLA(3).LT.LQCSTA(3)) LIMLA(3)= LEND
- LIMHI = LIMLA(3)
- ENDIF
- ENDIF
-
- WRITE (IQPRNT,9016) LNA,LEND
- 9016 FORMAT (' division boundaries:',2I7)
-
- IF (JDIV.LT.3) THEN
- WRITE (IQPRNT,9017) LQCSTA,LQCEND, LQLSTA, LQLEND
- ELSE
- WRITE (IQPRNT,9018) (LQ(J),J=1,23)
- ENDIF
-
- 9017 FORMAT (/' LQCSTA(1-3) =',3I8/' LQCEND(1-3) =',3I8/
- F /' LQLSTA(1-5) =',5I8/' LQLEND(1-5) =',5I8)
-
- 9018 FORMAT (/' Wsp control links:'
- F/5X,'LQGARB LQHOLD LQARRV LQKEEP' /3X,4I8/
- F/5X,'LQPREP LEXP LLPAST LQPAST' /3X,4I8/
- F/5X,'LQUSER (2) (3) (4)' /3X,4I8/
- F/5X,'LHASM LRPAM LPAM LACRAD' /3X,4I8/
- F/5X,'LARRV LPCRA LDCRAB LEXD ' /3X,4I8/
- F/5X,'LDECO LCRP LCRD' /3X,4I8)
-
- IF (LNA.GE.LEND) RETURN
-
-C------ next bank ----------------------
-
- 21 CALL QBLOWX (LNA)
- IF (IQFOUL.NE.0) GO TO 92
- LBK = IQLST
- IF (LBK.LT.LIMLO) GO TO 77
- IF (LNA.GE.LIMHI) GO TO 79
-
- CALL DDBANK (MSG,0)
-
- 77 LNA = IQLNX
- IF (LNA.LT.LEND) GO TO 21
-
- 79 IF (JDIV.EQ.1) THEN
- LIMLA(1) = LQCEND(1)
- ELSEIF (JDIV.EQ.3) THEN
- LIMLA(3) = LQCSTA(3)
- ENDIF
- RETURN
-
-C---- trouble
-
- 92 WRITE (IQPRNT,9092) LNA
- 9092 FORMAT (/' ***!!! QBLOWX does not like LNA=',I12,' !!!***')
-
- CALL P_KILL ('fatal')
- END
-+SEQ, QCARDL. =====================================================
-+DECK, DDLINS.
- SUBROUTINE DDLINS (MSG,LBANK)
-
-C- Dump the banks of the linear structure starting at LBANK
-
-+CDE, SLATLN, QUNIT, Q.
-+CDE, MQCN.
-C-------------- End CDE --------------------------------
- CHARACTER MSG*(*)
-
-
- LDO = LBANK
- WRITE (IQPRNT,9000) MSG,LDO
-
- 9000 FORMAT (/' ------'/' DDLINS for ',A,' with LBANK=',I7)
-
- IF (LDO.LE.0) RETURN
-
-C------ next bank ----------------------
-
- 21 CALL QNAMEX (LDO)
- IF (IQFOUL.NE.0) GO TO 91
-
- CALL DDBANK (MSG,0)
-
- 77 LDO = LQ(LDO-1)
- IF (LDO.NE.0) GO TO 21
- RETURN
-
-C---- trouble
-
- 91 WRITE (IQPRNT,9091) LDO
- 9091 FORMAT (/' ***!!! QNAMEX does not like LBK=',I12,' !!!***')
-
- CALL P_KILL ('fatal')
- END
-+SEQ, QCARDL. =====================================================
-+DECK, DDBANK.
- SUBROUTINE DDBANK (MSG,LBANK)
-
-C- Dump the bank at LBANK,
-C- or if LBANK = 0: the last bank accessed with QNAME or QBLOW
-
-+CDE, SLATLN.
-+CDE, QBITS19, QBANKS, QUNIT, MQCM, QSYSBITS, Q.
-+CDE, MQCN.
-C-------------- End CDE --------------------------------
- CHARACTER MSG*(*)
- INTEGER INTID
- CHARACTER CHID*4
- EQUIVALENCE (CHID,INTID)
-
- CHARACTER LINE*48, LINEZ*30, LINEWH*34
- EQUIVALENCE (LINE,SLLINE), (LINEZ,SLLINE(81:))
- +, (LINEWH,SLLINE(161:))
-
-
- LDO = LBANK
- IF (LDO.LE.0) GO TO 21
-
- WRITE (IQPRNT,9000) MSG,LDO
-
- 9000 FORMAT (/' DDBANK for ',A,' with LBANK=',I7)
-
- CALL QNAMEX (LDO)
- IF (IQFOUL.NE.0) GO TO 91
-
-C---- Dump the bank
-
- 21 CALL DQBANK
- IF (IQFOUL.NE.0) GO TO 97
- RETURN
-
-C---- trouble
-
- 91 WRITE (IQPRNT,9091) LDO
- 9091 FORMAT (/' ***!!! QNAMEX does not like LBK=',I12,' !!!***')
-
- 97 CALL P_KILL ('fatal')
- END
-+SEQ, QCARDL. =====================================================
-+DECK, DDPREP.
- SUBROUTINE DDPREP
-
-C- Dump the structure of PREP banks
-C. started 27-apr-95
-
-+CDE, MQCN, QUNIT.
-+CDE, KQADR, Q, PY.
-+CDE, M_ANAC.
-C-------------- End CDE --------------------------------
-
-
- WRITE (IQPRNT,9000)
- 9000 FORMAT (/' Dump the PREP structure')
-
- LDOAN = KQPREP + 1
- LUPAN = 0
-
-C------ Next PREP bank
-
- 22 KDOAN = LDOAN - 1
- LDOAN = LQ(KDOAN)
- IF (LDOAN.EQ.0) RETURN
-
- CALL QNAMEX (LDOAN)
- IF (IQFOUL.NE.0) GO TO 91
- CALL DQBANK
- IF (IQFOUL.NE.0) GO TO 97
-
- L = LQ(LDOAN-2)
- IF (L.EQ.0) GO TO 22
- IF (L.EQ.-1) GO TO 22
-
- CALL QNAMEX (L)
- IF (IQFOUL.NE.0) GO TO 92
- CALL DQBANK
- IF (IQFOUL.NE.0) GO TO 97
-
-C---- Follow reference to foreign material
-
- 31 LOWAN = LDOAN
- LUPAN = L
- LDOAN = LUPAN - 1
-
- 34 KDOAN = LDOAN - 1
- LDOAN = LQ(KDOAN)
- IF (LDOAN.EQ.0) THEN
-C-- end of chain of MAT banks
- LDOAN = LOWAN
- LUPAN = 0
- GO TO 22
- ENDIF
-
- CALL QNAMEX (LDOAN)
- IF (IQFOUL.NE.0) GO TO 91
- CALL DQBANK
- IF (IQFOUL.NE.0) GO TO 97
- GO TO 34
-
-C---- trouble
-
- 91 L = LDOAN
- 92 WRITE (IQPRNT,9091) L
- 9091 FORMAT (/' ***!!! QNAMEX does not like LBK=',I12,' !!!***')
-
- 97 CALL P_KILL ('fatal')
- END
-+SEQ, QCARDL. =====================================================
-+DECK, DUMPTB.
- SUBROUTINE DUMPTB (MSG)
-
-C- Dump the garbage collection table
-C. started 8-oct-91
-
-+CDE, QUNIT, MQCT, QSH.
-C-------------- End CDE --------------------------------
- CHARACTER MSG*(*)
-
-
- WRITE (IQPRNT,9001) MSG, LQTA,LQTB,LQTE
- 9001 FORMAT (/' Garbage collection table ',A//' LQTA/B/E =',3I7/)
-
- DO 44 JTB=LQTA,LQTE,3
- WRITE (IQPRNT,9044) JTB,LQ(JTB),LQ(JTB+1),LQ(JTB+2)
- 44 CONTINUE
- RETURN
-
- 9044 FORMAT (1X,I7,I6,2I5)
- END
-+SEQ, QCARDL. =====================================================
-+DECK, DISNAP, IF=YDIFF.
- SUBROUTINE DISNAP (MSKFIL,LEVEL)
-
-C- Display the structure at LQUSER(1|2) for nydiff
-C- MSKFIL = 1,2,3 to display file 1 or 2 or both
-C- LEVEL = 0 display unmatched decks only
-C- > 0 display all decks
-C. started 3-june-94
-
-+CDE, SLATE, SLATLN, QUNIT, QBITS19, Q, PY, ADDDI.
-C-------------- End CDE --------------------------------
- CHARACTER LINE*128, COL(128)*1
- EQUIVALENCE (LINE,SLLINE),(COL,SLLINE)
-
-+SEQ, Q_AND.
-
-
- CALL DIVLIM
-
- JFILE = IAND (MSKFIL,1)
- IF (JFILE.EQ.0) GO TO 41
-
- 12 LFILE = LQUSER(JFILE)
- IF (LFILE.EQ.0) THEN
- WRITE (IQPRNT,9021) JFILE
- GO TO 41
- ENDIF
-
- WRITE (IQPRNT,9022) JFILE, LEVEL
- WRITE (IQPRNT,9023) NSLMAX(JFILE),NTXMAX(JFILE)
- NQLLBL = 0
-
- 9021 FORMAT (/' **!! LQUSER is zero for file',I2,' **!!')
- 9022 FORMAT (/' Display F/P/D structure for file',I2,' LEVEL=',I3/)
- 9023 FORMAT (' Longest patch has',I6,' lines with',I8,' characters'/)
- 9024 FORMAT (' ***!!! No patches !!!***'/)
- 9027 FORMAT (1X,A)
-
- 21 LINE = ' f='
- CALL NA_GET (IQ(LFILE+4),LINE,5)
- JP = MAX (NESLAT-1,13) + 1
-
- IF (JFILE.EQ.2) THEN
- IF (IAND(IQ(LFILE),KM3) .EQ.0) COL(JP+1) = 'o'
- ENDIF
- IF (IAND(IQ(LFILE),KM2) .EQ.0) COL(JP+2) = 'u'
- IF (IAND(IQ(LFILE),KM1) .NE.0) COL(JP+3) = 'e'
- IF (LQ(LFILE-2) .EQ.0) COL(JP+5) = '*'
- JP = JP + 6
- WRITE (IQPRNT,9027) LINE(1:JP)
-
- LPAT = LQ(LFILE-4)
- IF (LPAT.EQ.0) THEN
- WRITE (IQPRNT,9024)
- GO TO 39
- ENDIF
-
-C---- each patch
-
- 24 LINE = 'p='
- CALL NA_GET (IQ(LPAT+4),LINE,3)
- JP = MAX (NESLAT-1,12) + 1
-
- IF (JFILE.EQ.2) THEN
- IF (IAND(IQ(LPAT),KM4) .NE.0) COL(JP+1) = '<'
- IF (IAND(IQ(LPAT),KM3) .EQ.0) COL(JP+2) = 'o'
- ENDIF
- IF (IAND(IQ(LPAT),KM2) .EQ.0) COL(JP+3) = 'u'
- IF (IAND(IQ(LPAT),KM1) .NE.0) COL(JP+4) = 'e'
- IF (IQ(LPAT+1) .NE.0) COL(JP+5) = '.'
- IF (LQ(LPAT-2) .EQ.0) COL(JP+6) = '*'
- JP = JP + 7
- CALL CSETDI (IQ(LPAT+5),LINE,JP+1,JP+4)
- CALL CLEFT (LINE,JP+1,JP+4)
- JP = NESLAT
-
- LDKN = LQ(LPAT-4)
- NDK = 0
- MISS = 0
-
-+SEQ, QEJECT.
-C-- each deck
-
- 31 LDECK = LDKN
- IF (LDECK.EQ.0) THEN
- LINE(JP+2:) = '!! no decks !!'
- JP = LENOCC (LINE)
- GO TO 37
- ENDIF
- LDKN = LQ(LDECK-1)
-
- IF (LEVEL.LE.0) THEN
- IF (LQ(LDECK-2).NE.0) GO TO 37
- ENDIF
-
- NDK = NDK + 1
- IF (NDK.GE.4) THEN
- IF (LDKN.EQ.0) GO TO 34
- IF (MISS.NE.0) GO TO 37
- LINE(JP+2:JP+4) = '...'
- JP = JP + 4
- MISS = 7
- GO TO 37
- ENDIF
-
- 34 JP = JP + 2
- CALL CSETDI (IQ(LDECK+5),LINE,JP,JP+2)
- CALL CLEFT (LINE,JP,JP+2)
- JP = NESLAT
- IF (LQ(LDECK-2).EQ.0) THEN
- COL(JP) = '*'
- JP = JP + 1
- ENDIF
-
- CALL NA_GET (IQ(LDECK+4),LINE,JP+1)
- JP = NESLAT - 1
-
- 37 IF (LDKN.NE.0) GO TO 31
- WRITE (IQPRNT,9027) LINE(1:JP)
-
- LPAT = LQ(LPAT-1)
- IF (LPAT.NE.0) GO TO 24
-
- 39 LFILE = LQ(LFILE-1)
- IF (LFILE.NE.0) GO TO 21
-
- 41 IF (JFILE.EQ.2) RETURN
- JFILE = IAND (MSKFIL,2)
- IF (JFILE.NE.0) GO TO 12
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+DECK, DIDUMPM, IF=YDIFF.
- SUBROUTINE DIDUMPM (LPAT)
-
-C- Dump a patch in memory for nydiff
-C. started 24-june-94
-
-+CDE, SLATE, QUNIT, Q.
-C-------------- End CDE --------------------------------
- CHARACTER LINE*256
-
-
- LP = LPAT
- CALL NA_GET (IQ(LP+4),LINE,1)
- N = NDSLAT
-
- WRITE (IQPRNT,9001) LINE(1:N),LP, (IQ(LP+J),J=1,3)
-
- 9001 FORMAT (/' .Dump patch ',A,' in memory, LP =',I6/
- F/' JSL/NSL/NTX =',2I6,I7)
-
- LD = LQ(LPAT-4)
- 24 IF (LD.EQ.0) RETURN
-
- CALL NA_GET (IQ(LD+4),LINE,1)
- N = NDSLAT
-
- WRITE (IQPRNT,9002) LINE(1:N),LD, (IQ(LD+J),J=1,3)
-
- 9002 FORMAT (/' --- Deck ',A,' at LD =',I6,' JSL/NSL/NTX =',2I6,I7/)
-
- JSL = IQ(LD+1)
- NSL = IQ(LD+2)
- JNO = 0
-
- DO 27 J=1,NSL
- CALL LN_GET (JSL,LINE,99)
- WRITE (IQPRNT,9024) JNO,LINE(1:NDSLAT)
- 9024 FORMAT (I6,' - ',A)
- JNO = JNO + 1
- 27 JSL = JSL + 1
-
- LD = LQ(LD-1)
- GO TO 24
- END
-+SEQ, QCARDL. =====================================================
-+DECK, CATCH, T=JOIN.
- SUBROUTINE CATCH (NUM)
-
-C- To allow breakpoint setting
-
- PRINT *, 'arrived in CATCH, NUM= ',NUM
- RETURN
- END
-+SEQ, QCARDL. =====================================================
-+PATCH, PAMEND, T=JOIN.
-last line of PATCHY Pam
diff --git a/src/patchy/yexpand.com b/src/patchy/yexpand.com
deleted file mode 100644
index 1e7506c..0000000
--- a/src/patchy/yexpand.com
+++ /dev/null
@@ -1,220 +0,0 @@
-$! ***********************************************************************
-$! * *
-$! * YEXPAND.COM v1.05 *
-$! * *
-$! * Translator of Unix cradles to Vax/VMS *
-$! * Call : yexpand [ -f -v ] ifile [ofile] *
-$! * Options: -f Substitute Unix filenames by VMS equivalents in *
-$! * +ASM,+PAM *
-$! * -v verbose mode, reporting on substituted variables *
-$! * *
-$! * Author: M.Marquina 92/02/21 *
-$! * *
-$! * Mods Date Comments *
-$! * MARQUINA 92/03/05 Cosmetic changes (single exit point,etc) *
-$! * 92/03/08 Translate Unix directories to VMS equivalent *
-$! * bin=EXE,etc *
-$! * Translate filenames only in +PAM,+ASM *
-$! * 92/07/14 Correct bug when an env.variable ends up the line *
-$! * and when +PAM lines do not have T=A. *
-$! * JAMIE 94/03/08 Only translate control lines *
-$! * JAMIE 94/04/22 Support also variables in {}, e.g. ${PLINAME} *
-$! * JAMIE 94/05/20 Only translate variables that are defined *
-$! * JAMIE 94/09/16 Trim 'uxfile' *
-$! * *
-$! ***********************************************************************
-$ SHNAME=F$ENVIRONMENT("PROCEDURE")
-$ SHNAME=F$PARSE(SHNAME,,,"NAME")
-$!
-$ sav_mess=F$ENVIRONMENT("MESSAGE")
-$!On ERROR Then Goto EXIT
-$!
-$ SAY :== WRITE/SYMBOL SYS$OUTPUT
-$ blk=" "
-$ lfn=" "
-$ b20=" "
-$!
-$ Gosub NARG
-$ If p0.eq.0 Then Call SHEXIT 2 "usage: yexpand [-f] [-v] input_file [output_file]"
-$!
-$ args=s0
-$ getopt "DFV" 'args' ! Invoke the Unix parser
-$ args='getopt_string'
-$!
-$ Gosub PARSE_OPTIONS
-$ If ifile.eqs." " Then Call SHEXIT 2 "input file missing"
-$ itype=F$PARSE(ifile,,,"TYPE")
-$ If itype.eqs."." Then ifile=ifile+".CRA"
-$ If F$SEARCH(ifile).eqs."" Then Call SHEXIT 2 "input file "'ifile'" not found"
-$ If ofile.eqs." "
-$ Then ip=F$LOCATE("]",ifile)
-$ lp=F$LENGTH(ifile)
-$ If ip.eq.lp Then Call SHEXIT 2 "output=input ; it cannot overwrite"
-$ ofile=F$EXTRACT(ip+1,lp-ip,ifile)
-$ Endif
-$!
-$ If _v.eq.1 Then Say blk,"yexpand: translator of Unix cradles to Vax/VMS"
-$ open/read input 'ifile'
-$ open/write output 'ofile'
-$!
-$ nl=0
-$ R_DO:
-$ read/end=EOF input line
-$ nl=nl+1
-$ If _d.eq.1 Then Say line
-$!
-$ If f$extract(0,1,line).nes."+" then goto f_end
-$!
-$ ll=F$LENGTH(line)
-$!
-$! Check first for ${var}
-$!
-$ X_DO:
-$ l_var = f$locate("${",line)
-$ if l_var .eq. ll then goto X_END
-$ left = f$extract(0,l_var,line)
-$ right = f$extract(l_var+2,ll,line)
-$ lr = ll - l_var - 2
-$ e_var = f$locate("}",right)
-$ if e_var .lt. lr
-$ then
-$ var = f$extract(0,e_var,right)
-$ right = f$extract(e_var+1,lr,right)
-$ if f$type('var').eqs.""
-$ then
-$ else var='var'
-$ endif
-$ line=left+var+right
-$ ll=f$length(line)
-$ goto X_DO
-$ endif
-$ X_END:
-$!
-$! Old style
-$!
-$ _p=F$LOCATE("$",line)
-$!
-$ D_DO:
-$ If _p.eq.ll Then Goto D_END
-$! --- Parse the line=lp1"$"lp2
-$ lp1=F$EXTRACT(0,_p,line)
-$ lp2=F$EXTRACT(_p+1,ll-_p,line)
-$! Find out where does the environment variable finish
-$ ip=-1
-$ ll2=F$LENGTH(lp2)
-$ D__DO:
-$ ip=ip+1
-$ If ip.gt.ll2 Then Goto D_DO
-$ is=F$EXTRACT(ip,1,lp2)
-$ If F$LOCATE(is,".,/$*[]").lt.7
-$ Then nvar=F$EXTRACT(0,ip,lp2)
-$ vvar="?"+nvar
-$ If F$TYPE('nvar').nes.""
-$ Then vvar='nvar'
-$ nvar=F$EXTRACT(0,25,nvar+b20)
-$ If _v.eq.1 Then Say lfn,"- env. variable ",nvar," -> ",vvar
-$ Endif
-$ line=lp1+vvar+F$EXTRACT(ip,ll2-ip,lp2)
-$ _p=F$LOCATE("$",line)
-$ ll=F$LENGTH(line)
-$ Goto D_DO
-$ Endif
-$ Goto D__DO
-$ D_END:
-$! check the line for Unix filenames
-$ uline=F$EDIT(line,"UPCASE")
-$ pcmd =F$EXTRACT(0,4,uline)
-$ _sf=F$LOCATE(pcmd,"+PAM +ASM").lt.9.and.F$LOCATE("T=",uline).lt.ll
-$!
-$ _sf= _f.eq.1.and._sf.eq.1
-$ If _sf.eq.0 Then Goto F_END
-$ F_DO:
-$ _ita=F$LOCATE(".",uline)
-$ lux =ll-_ita-1
-$ If lux.eq.0 Then Goto F_END
-$ uxfile0=F$EXTRACT(_ita+1,lux,line)
-$ uxfile =uxfile0
-$ If F$EXTRACT(0,1,uxfile).eqs.":" Then uxfile=F$EXTRACT(1,lux-1,uxfile)
-$ _r=F$EXTRACT(0,1,uxfile).eqs."="
-$ If _r.eq.1 Then uxfile=F$EXTRACT(1,lux-1,uxfile)
-$ vxfile=uxfile
-$ uxfile=f$edit(uxfile,"TRIM") ! remove leading and trailing blanks
-$ If F$EXTRACT(0,1,uxfile).eqs."/"
-$ Then nft=0
-$ FT_DO:
-$ nft=nft+1
-$ sft1=F$ELEMENT(nft ,"/",uxfile)
-$ sft2=F$ELEMENT(nft+1,"/",uxfile)
-$ If nft.eq.1
-$ Then vxfile=sft1+":["
-$ Goto FT_DO
-$ Endif
-$ If sft2.nes."/"
-$ Then If sft1.eqs."bin" Then sft1="exe"
-$ vxfile=vxfile+sft1+"."
-$ Goto FT_DO
-$ Endif
-$ vxfile=vxfile+"]"-".]"+"]"+sft1
-$ Endif
-$ vxtype=F$PARSE(vxfile,,,"TYPE")
-$ If vxtype.eqs.".F" Then vxfile=vxfile+"ZZ"-".fZZ"+".FOR"
-$ If _r.eq.1 Then vxfile="="+vxfile
-$ line=F$EXTRACT(0,_ita+1,line)+vxfile
-$ If _v.eq.1
-$ Then uxfile0=F$EXTRACT(0,30,uxfile0+b20)
-$ Say lfn,"- filename ",uxfile0," -> ",vxfile
-$ Endif
-$ F_END:
-$ If _d.eq.1 Then Say line
-$ write output line
-$ Goto R_DO
-$!
-$ EOF:
-$ close input
-$ close output
-$!
-$ EXIT:
-$ set message'sav_mess'
-$ Exit
-$!--------
-$ NARG:
-$!--------
-$ p0=0
-$ s0=""
-$ N_DO:
-$ p0=p0+1
-$ If p0.lt.9
-$ Then s0=s0+p'p0'+" "
-$ If p'p0'.nes."" Then Goto N_DO
-$ Endif
-$ p0=p0-1
-$ Return
-$!--------
-$ PARSE_OPTIONS:
-$!--------
-$ _d=0 ! debug mode
-$ _f=0 ! translate filenames Unix -> VMS syntax
-$ _v=0 ! verbose mode
-$ np=-1
-$ O_DO:
-$ np=np+1
-$ arg=F$ELEMENT(np," ",args)
-$ If arg.nes."--"
-$ Then If arg.eqs."-D" Then _d=1
-$ If arg.eqs."-F" Then _f=1
-$ If arg.eqs."-V" Then _v=1
-$ Goto O_DO
-$ Endif
-$ ifile=F$ELEMENT(np+1," ",args)
-$ ofile=F$ELEMENT(np+2," ",args)
-$ Return
-$!--------
-$ SHEXIT: SUBROUTINE
-$!--------
-$!set message/nof/noi/nos/not
-$ SHERR="%DCL-F-"
-$ If p1.lt.4 Then SHERR="%DCL-E-"
-$ If p1.lt.2 Then SHERR="%DCL-W-"
-$ Say SHERR,SHNAME,", ",p2
-$ Exit 'p1'
-$ ENDSUBROUTINE
diff --git a/src/patchy/yexpand.script b/src/patchy/yexpand.script
deleted file mode 100755
index c947a2d..0000000
--- a/src/patchy/yexpand.script
+++ /dev/null
@@ -1,38 +0,0 @@
-#!/bin/sh
-# **********************************************************************
-#@(#) * yexpand $Header: /afs/cern.ch/asis/share/cern/CVS/patchy/yexpand.script,v 1.2 2005/04/18 15:23:11 mclareni Exp $
-# * *
-# * Expand environment variables in PATCHY cradles *
-# * *
-# * Author: M.Marquina 91/12/10 *
-# * Mods Date Commments *
-# * M.Marquina 92/03/11 Display syntax if no arguments are given *
-# * Place by default the output in ./, exit with rc*
-# * M.Marquina 93/12/09 Prefix always CERN_ROOT with ":" in order to *
-# * get ypatchy respecting the pam-filename case *
-# * 93/12/21 Translate CERN_ROOT as CERN/CERN_LEVEL in order*
-# * to use the correct LEVEL in the cradle *
-# * G.Folger 94/09/26 make .yexp script run in /bin/sh.
-# * *
-# **********************************************************************
- if [ $# -eq 0 ] ; then
- echo "usage: yexpand input_cradle [output_cradle]"
- exit
- fi
- ifile=$1
- tfile=`echo $ifile | awk -F/ '{ print $NF }'`
- [ $# -eq 1 ] && ofile=$tfile || ofile=$2
-
-# CERN_ROOT=":$CERN_ROOT" ; export CERN_ROOT
- CERN_ROOT=":$CERN/$CERN_LEVEL" ; export CERN_ROOT
-
- tfile="$HOME/$tfile.yexp"
- echo "#!/bin/sh" >$tfile
- echo " cat <<EOI" >>$tfile
- cat <$ifile >>$tfile
- cc=$?
- echo "EOI" >>$tfile
- chmod a+x $tfile
- $tfile >$ofile
- rm $tfile
- exit $cc
diff --git a/src/patchy/yyexpand.com b/src/patchy/yyexpand.com
deleted file mode 100644
index d701981..0000000
--- a/src/patchy/yyexpand.com
+++ /dev/null
@@ -1,7 +0,0 @@
-$!
-$! run yexpand with PLINAME set to 'p1'
-$!
-$ PLINAME=p1
-$!
-$ yexpand 'p2' 'p3'
-$!
diff --git a/src/pawlib/paw/ntuple/dbmalloc.h b/src/pawlib/paw/ntuple/dbmalloc.h
deleted file mode 100644
index e69de29..0000000
diff --git a/src/pawlib/paw/testsuite/paw.commands/hist_5000.dmp b/src/pawlib/paw/testsuite/paw.commands/hist_5000.dmp
deleted file mode 100644
index 930ffb4..0000000
--- a/src/pawlib/paw/testsuite/paw.commands/hist_5000.dmp
+++ /dev/null
@@ -1,16 +0,0 @@
- test histo 1d
- 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
- 10 -25.000000 25.000000
- 0 .000000 .000000
- 0 .000000 .000000
- 1 .000000 .000000
- 2 .000000 .000000
- 3 .000000 .000000
- 4 .000000 .000000
- 5 .000000 .000000
- 6 .000000 .000000
- 7 .000000 .000000
- 8 .000000 .000000
- 9 .000000 .000000
- 10 .000000 .000000
- 11 .000000 .000000
diff --git a/src/pawlib/paw/testsuite/paw.commands/hist_5001.dmp b/src/pawlib/paw/testsuite/paw.commands/hist_5001.dmp
deleted file mode 100644
index c114ed2..0000000
--- a/src/pawlib/paw/testsuite/paw.commands/hist_5001.dmp
+++ /dev/null
@@ -1,106 +0,0 @@
- test histo 1d
- 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
- 100 -5.000000 5.000000
- 0 .000000 .000000
- 0 .000000 .000000
- 1 .000000 .000000
- 2 .000000 .000000
- 3 .000000 .000000
- 4 .000000 .000000
- 5 .000000 .000000
- 6 .000000 .000000
- 7 .000000 .000000
- 8 .000000 .000000
- 9 .000000 .000000
- 10 .000000 .000000
- 11 .000000 .000000
- 12 .000000 .000000
- 13 .000000 .000000
- 14 .000000 .000000
- 15 .000000 .000000
- 16 .000000 .000000
- 17 .000000 .000000
- 18 .000000 .000000
- 19 .000000 .000000
- 20 .000000 .000000
- 21 .000000 .000000
- 22 .000000 .000000
- 23 .000000 .000000
- 24 .000000 .000000
- 25 .000000 .000000
- 26 .000000 .000000
- 27 .000000 .000000
- 28 .000000 .000000
- 29 .000000 .000000
- 30 .000000 .000000
- 31 .000000 .000000
- 32 .000000 .000000
- 33 .000000 .000000
- 34 .000000 .000000
- 35 .000000 .000000
- 36 .000000 .000000
- 37 .000000 .000000
- 38 .000000 .000000
- 39 .000000 .000000
- 40 .000000 .000000
- 41 508.000000 22.538855
- 42 553.000000 23.515951
- 43 513.000000 22.649504
- 44 519.000000 22.781572
- 45 520.000000 22.803509
- 46 539.000000 23.216373
- 47 542.000000 23.280893
- 48 536.000000 23.151674
- 49 523.000000 22.869194
- 50 562.000000 23.706539
- 51 528.000000 22.978251
- 52 531.000000 23.043438
- 53 536.000000 23.151674
- 54 523.000000 22.869194
- 55 533.000000 23.086792
- 56 534.000000 23.108440
- 57 516.000000 22.715633
- 58 493.000000 22.203604
- 59 501.000000 22.383030
- 60 545.000000 23.345236
- 61 510.000000 22.583179
- 62 557.000000 23.600847
- 63 510.000000 22.583179
- 64 498.000000 22.315914
- 65 519.000000 22.781572
- 66 536.000000 23.151674
- 67 497.000000 22.293497
- 68 519.000000 22.781572
- 69 519.000000 22.781572
- 70 500.000000 22.360680
- 71 553.000000 23.515951
- 72 553.000000 23.515951
- 73 521.000000 22.825424
- 74 499.000000 22.338308
- 75 516.000000 22.715633
- 76 514.000000 22.671568
- 77 513.000000 22.649504
- 78 568.000000 23.832750
- 79 482.000000 21.954498
- 80 561.000000 23.685438
- 81 .000000 .000000
- 82 .000000 .000000
- 83 .000000 .000000
- 84 .000000 .000000
- 85 .000000 .000000
- 86 .000000 .000000
- 87 .000000 .000000
- 88 .000000 .000000
- 89 .000000 .000000
- 90 .000000 .000000
- 91 .000000 .000000
- 92 .000000 .000000
- 93 .000000 .000000
- 94 .000000 .000000
- 95 .000000 .000000
- 96 .000000 .000000
- 97 .000000 .000000
- 98 .000000 .000000
- 99 .000000 .000000
- 100 .000000 .000000
- 101 .000000 .000000
diff --git a/src/pawlib/paw/testsuite/paw.commands/hist_6000.dmp b/src/pawlib/paw/testsuite/paw.commands/hist_6000.dmp
deleted file mode 100644
index c286042..0000000
--- a/src/pawlib/paw/testsuite/paw.commands/hist_6000.dmp
+++ /dev/null
@@ -1,268 +0,0 @@
- test histo 2d
- 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
- 10 -25.000000 25.000000
- 20 -4.000000 .000000
- 0 0 .000000 .000000
- 0 1 .000000 .000000
- 0 2 .000000 .000000
- 0 3 .000000 .000000
- 0 4 .000000 .000000
- 0 5 .000000 .000000
- 0 6 .000000 .000000
- 0 7 .000000 .000000
- 0 8 .000000 .000000
- 0 9 .000000 .000000
- 0 10 .000000 .000000
- 0 11 .000000 .000000
- 0 12 .000000 .000000
- 0 13 .000000 .000000
- 0 14 .000000 .000000
- 0 15 .000000 .000000
- 0 16 .000000 .000000
- 0 17 .000000 .000000
- 0 18 .000000 .000000
- 0 19 .000000 .000000
- 0 20 .000000 .000000
- 0 21 .000000 .000000
- 1 0 .000000 .000000
- 1 1 .000000 .000000
- 1 2 .000000 .000000
- 1 3 .000000 .000000
- 1 4 .000000 .000000
- 1 5 .000000 .000000
- 1 6 .000000 .000000
- 1 7 .000000 .000000
- 1 8 .000000 .000000
- 1 9 .000000 .000000
- 1 10 .000000 .000000
- 1 11 .000000 .000000
- 1 12 .000000 .000000
- 1 13 .000000 .000000
- 1 14 .000000 .000000
- 1 15 .000000 .000000
- 1 16 .000000 .000000
- 1 17 .000000 .000000
- 1 18 .000000 .000000
- 1 19 .000000 .000000
- 1 20 .000000 .000000
- 1 21 .000000 .000000
- 2 0 .000000 .000000
- 2 1 .000000 .000000
- 2 2 .000000 .000000
- 2 3 .000000 .000000
- 2 4 .000000 .000000
- 2 5 .000000 .000000
- 2 6 .000000 .000000
- 2 7 .000000 .000000
- 2 8 .000000 .000000
- 2 9 .000000 .000000
- 2 10 .000000 .000000
- 2 11 .000000 .000000
- 2 12 .000000 .000000
- 2 13 .000000 .000000
- 2 14 .000000 .000000
- 2 15 .000000 .000000
- 2 16 .000000 .000000
- 2 17 .000000 .000000
- 2 18 .000000 .000000
- 2 19 .000000 .000000
- 2 20 .000000 .000000
- 2 21 .000000 .000000
- 3 0 .000000 .000000
- 3 1 .000000 .000000
- 3 2 .000000 .000000
- 3 3 .000000 .000000
- 3 4 .000000 .000000
- 3 5 .000000 .000000
- 3 6 .000000 .000000
- 3 7 .000000 .000000
- 3 8 .000000 .000000
- 3 9 .000000 .000000
- 3 10 .000000 .000000
- 3 11 .000000 .000000
- 3 12 .000000 .000000
- 3 13 .000000 .000000
- 3 14 .000000 .000000
- 3 15 .000000 .000000
- 3 16 .000000 .000000
- 3 17 .000000 .000000
- 3 18 .000000 .000000
- 3 19 .000000 .000000
- 3 20 .000000 .000000
- 3 21 .000000 .000000
- 4 0 .000000 .000000
- 4 1 .000000 .000000
- 4 2 .000000 .000000
- 4 3 .000000 .000000
- 4 4 .000000 .000000
- 4 5 .000000 .000000
- 4 6 .000000 .000000
- 4 7 .000000 .000000
- 4 8 .000000 .000000
- 4 9 .000000 .000000
- 4 10 .000000 .000000
- 4 11 .000000 .000000
- 4 12 .000000 .000000
- 4 13 .000000 .000000
- 4 14 .000000 .000000
- 4 15 .000000 .000000
- 4 16 .000000 .000000
- 4 17 .000000 .000000
- 4 18 .000000 .000000
- 4 19 .000000 .000000
- 4 20 .000000 .000000
- 4 21 .000000 .000000
- 5 0 .000000 .000000
- 5 1 .000000 .000000
- 5 2 .000000 .000000
- 5 3 .000000 .000000
- 5 4 .000000 .000000
- 5 5 .000000 .000000
- 5 6 .000000 .000000
- 5 7 .000000 .000000
- 5 8 .000000 .000000
- 5 9 .000000 .000000
- 5 10 .000000 .000000
- 5 11 .000000 .000000
- 5 12 .000000 .000000
- 5 13 .000000 .000000
- 5 14 .000000 .000000
- 5 15 .000000 .000000
- 5 16 .000000 .000000
- 5 17 .000000 .000000
- 5 18 .000000 .000000
- 5 19 .000000 .000000
- 5 20 .000000 .000000
- 5 21 .000000 .000000
- 6 0 .000000 .000000
- 6 1 .000000 .000000
- 6 2 .000000 .000000
- 6 3 .000000 .000000
- 6 4 .000000 .000000
- 6 5 .000000 .000000
- 6 6 .000000 .000000
- 6 7 .000000 .000000
- 6 8 .000000 .000000
- 6 9 .000000 .000000
- 6 10 .000000 .000000
- 6 11 .000000 .000000
- 6 12 .000000 .000000
- 6 13 .000000 .000000
- 6 14 .000000 .000000
- 6 15 .000000 .000000
- 6 16 .000000 .000000
- 6 17 .000000 .000000
- 6 18 .000000 .000000
- 6 19 .000000 .000000
- 6 20 .000000 .000000
- 6 21 .000000 .000000
- 7 0 .000000 .000000
- 7 1 .000000 .000000
- 7 2 .000000 .000000
- 7 3 .000000 .000000
- 7 4 .000000 .000000
- 7 5 .000000 .000000
- 7 6 .000000 .000000
- 7 7 .000000 .000000
- 7 8 .000000 .000000
- 7 9 .000000 .000000
- 7 10 .000000 .000000
- 7 11 .000000 .000000
- 7 12 .000000 .000000
- 7 13 .000000 .000000
- 7 14 .000000 .000000
- 7 15 .000000 .000000
- 7 16 .000000 .000000
- 7 17 .000000 .000000
- 7 18 .000000 .000000
- 7 19 .000000 .000000
- 7 20 .000000 .000000
- 7 21 .000000 .000000
- 8 0 .000000 .000000
- 8 1 .000000 .000000
- 8 2 .000000 .000000
- 8 3 .000000 .000000
- 8 4 .000000 .000000
- 8 5 .000000 .000000
- 8 6 .000000 .000000
- 8 7 .000000 .000000
- 8 8 .000000 .000000
- 8 9 .000000 .000000
- 8 10 .000000 .000000
- 8 11 .000000 .000000
- 8 12 .000000 .000000
- 8 13 .000000 .000000
- 8 14 .000000 .000000
- 8 15 .000000 .000000
- 8 16 .000000 .000000
- 8 17 .000000 .000000
- 8 18 .000000 .000000
- 8 19 .000000 .000000
- 8 20 .000000 .000000
- 8 21 .000000 .000000
- 9 0 .000000 .000000
- 9 1 .000000 .000000
- 9 2 .000000 .000000
- 9 3 .000000 .000000
- 9 4 .000000 .000000
- 9 5 .000000 .000000
- 9 6 .000000 .000000
- 9 7 .000000 .000000
- 9 8 .000000 .000000
- 9 9 .000000 .000000
- 9 10 .000000 .000000
- 9 11 .000000 .000000
- 9 12 .000000 .000000
- 9 13 .000000 .000000
- 9 14 .000000 .000000
- 9 15 .000000 .000000
- 9 16 .000000 .000000
- 9 17 .000000 .000000
- 9 18 .000000 .000000
- 9 19 .000000 .000000
- 9 20 .000000 .000000
- 9 21 .000000 .000000
- 10 0 .000000 .000000
- 10 1 .000000 .000000
- 10 2 .000000 .000000
- 10 3 .000000 .000000
- 10 4 .000000 .000000
- 10 5 .000000 .000000
- 10 6 .000000 .000000
- 10 7 .000000 .000000
- 10 8 .000000 .000000
- 10 9 .000000 .000000
- 10 10 .000000 .000000
- 10 11 .000000 .000000
- 10 12 .000000 .000000
- 10 13 .000000 .000000
- 10 14 .000000 .000000
- 10 15 .000000 .000000
- 10 16 .000000 .000000
- 10 17 .000000 .000000
- 10 18 .000000 .000000
- 10 19 .000000 .000000
- 10 20 .000000 .000000
- 10 21 .000000 .000000
- 11 0 .000000 .000000
- 11 1 .000000 .000000
- 11 2 .000000 .000000
- 11 3 .000000 .000000
- 11 4 .000000 .000000
- 11 5 .000000 .000000
- 11 6 .000000 .000000
- 11 7 .000000 .000000
- 11 8 .000000 .000000
- 11 9 .000000 .000000
- 11 10 .000000 .000000
- 11 11 .000000 .000000
- 11 12 .000000 .000000
- 11 13 .000000 .000000
- 11 14 .000000 .000000
- 11 15 .000000 .000000
- 11 16 .000000 .000000
- 11 17 .000000 .000000
- 11 18 .000000 .000000
- 11 19 .000000 .000000
- 11 20 .000000 .000000
- 11 21 .000000 .000000
diff --git a/src/pawlib/paw/testsuite/paw.commands/hist_6001.dmp b/src/pawlib/paw/testsuite/paw.commands/hist_6001.dmp
deleted file mode 100644
index b26d2ad..0000000
--- a/src/pawlib/paw/testsuite/paw.commands/hist_6001.dmp
+++ /dev/null
@@ -1,1768 +0,0 @@
- test histo 2d
- 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
- 40 -5.000000 5.000000
- 40 -5.000000 5.000000
- 0 0 .000000 .000000
- 0 1 .000000 .000000
- 0 2 .000000 .000000
- 0 3 .000000 .000000
- 0 4 .000000 .000000
- 0 5 .000000 .000000
- 0 6 .000000 .000000
- 0 7 .000000 .000000
- 0 8 .000000 .000000
- 0 9 .000000 .000000
- 0 10 .000000 .000000
- 0 11 .000000 .000000
- 0 12 .000000 .000000
- 0 13 .000000 .000000
- 0 14 .000000 .000000
- 0 15 .000000 .000000
- 0 16 .000000 .000000
- 0 17 .000000 .000000
- 0 18 1.000000 1.000000
- 0 19 1.000000 1.000000
- 0 20 .000000 .000000
- 0 21 .000000 .000000
- 0 22 2.000000 1.414214
- 0 23 .000000 .000000
- 0 24 1.000000 1.000000
- 0 25 .000000 .000000
- 0 26 1.000000 1.000000
- 0 27 1.000000 1.000000
- 0 28 .000000 .000000
- 0 29 .000000 .000000
- 0 30 .000000 .000000
- 0 31 2.000000 1.414214
- 0 32 .000000 .000000
- 0 33 .000000 .000000
- 0 34 .000000 .000000
- 0 35 .000000 .000000
- 0 36 .000000 .000000
- 0 37 .000000 .000000
- 0 38 .000000 .000000
- 0 39 .000000 .000000
- 0 40 .000000 .000000
- 0 41 .000000 .000000
- 1 0 .000000 .000000
- 1 1 .000000 .000000
- 1 2 .000000 .000000
- 1 3 .000000 .000000
- 1 4 .000000 .000000
- 1 5 .000000 .000000
- 1 6 .000000 .000000
- 1 7 .000000 .000000
- 1 8 .000000 .000000
- 1 9 .000000 .000000
- 1 10 .000000 .000000
- 1 11 .000000 .000000
- 1 12 .000000 .000000
- 1 13 .000000 .000000
- 1 14 .000000 .000000
- 1 15 .000000 .000000
- 1 16 .000000 .000000
- 1 17 .000000 .000000
- 1 18 .000000 .000000
- 1 19 .000000 .000000
- 1 20 1.000000 1.000000
- 1 21 1.000000 1.000000
- 1 22 .000000 .000000
- 1 23 .000000 .000000
- 1 24 .000000 .000000
- 1 25 2.000000 1.414214
- 1 26 2.000000 1.414214
- 1 27 1.000000 1.000000
- 1 28 .000000 .000000
- 1 29 .000000 .000000
- 1 30 2.000000 1.414214
- 1 31 1.000000 1.000000
- 1 32 1.000000 1.000000
- 1 33 .000000 .000000
- 1 34 .000000 .000000
- 1 35 .000000 .000000
- 1 36 .000000 .000000
- 1 37 .000000 .000000
- 1 38 .000000 .000000
- 1 39 .000000 .000000
- 1 40 .000000 .000000
- 1 41 .000000 .000000
- 2 0 .000000 .000000
- 2 1 .000000 .000000
- 2 2 .000000 .000000
- 2 3 .000000 .000000
- 2 4 .000000 .000000
- 2 5 .000000 .000000
- 2 6 .000000 .000000
- 2 7 .000000 .000000
- 2 8 .000000 .000000
- 2 9 .000000 .000000
- 2 10 .000000 .000000
- 2 11 .000000 .000000
- 2 12 .000000 .000000
- 2 13 .000000 .000000
- 2 14 .000000 .000000
- 2 15 .000000 .000000
- 2 16 .000000 .000000
- 2 17 .000000 .000000
- 2 18 .000000 .000000
- 2 19 1.000000 1.000000
- 2 20 .000000 .000000
- 2 21 .000000 .000000
- 2 22 1.000000 1.000000
- 2 23 1.000000 1.000000
- 2 24 3.000000 1.732051
- 2 25 1.000000 1.000000
- 2 26 1.000000 1.000000
- 2 27 .000000 .000000
- 2 28 .000000 .000000
- 2 29 .000000 .000000
- 2 30 .000000 .000000
- 2 31 1.000000 1.000000
- 2 32 .000000 .000000
- 2 33 .000000 .000000
- 2 34 .000000 .000000
- 2 35 .000000 .000000
- 2 36 .000000 .000000
- 2 37 .000000 .000000
- 2 38 .000000 .000000
- 2 39 .000000 .000000
- 2 40 .000000 .000000
- 2 41 .000000 .000000
- 3 0 .000000 .000000
- 3 1 .000000 .000000
- 3 2 .000000 .000000
- 3 3 .000000 .000000
- 3 4 .000000 .000000
- 3 5 .000000 .000000
- 3 6 .000000 .000000
- 3 7 .000000 .000000
- 3 8 .000000 .000000
- 3 9 .000000 .000000
- 3 10 .000000 .000000
- 3 11 .000000 .000000
- 3 12 .000000 .000000
- 3 13 .000000 .000000
- 3 14 .000000 .000000
- 3 15 .000000 .000000
- 3 16 .000000 .000000
- 3 17 .000000 .000000
- 3 18 .000000 .000000
- 3 19 1.000000 1.000000
- 3 20 1.000000 1.000000
- 3 21 2.000000 1.414214
- 3 22 2.000000 1.414214
- 3 23 2.000000 1.414214
- 3 24 2.000000 1.414214
- 3 25 6.000000 2.449490
- 3 26 .000000 .000000
- 3 27 3.000000 1.732051
- 3 28 .000000 .000000
- 3 29 3.000000 1.732051
- 3 30 .000000 .000000
- 3 31 2.000000 1.414214
- 3 32 3.000000 1.732051
- 3 33 .000000 .000000
- 3 34 .000000 .000000
- 3 35 .000000 .000000
- 3 36 .000000 .000000
- 3 37 .000000 .000000
- 3 38 .000000 .000000
- 3 39 .000000 .000000
- 3 40 .000000 .000000
- 3 41 .000000 .000000
- 4 0 .000000 .000000
- 4 1 .000000 .000000
- 4 2 .000000 .000000
- 4 3 .000000 .000000
- 4 4 .000000 .000000
- 4 5 .000000 .000000
- 4 6 .000000 .000000
- 4 7 .000000 .000000
- 4 8 .000000 .000000
- 4 9 .000000 .000000
- 4 10 .000000 .000000
- 4 11 .000000 .000000
- 4 12 .000000 .000000
- 4 13 .000000 .000000
- 4 14 .000000 .000000
- 4 15 .000000 .000000
- 4 16 .000000 .000000
- 4 17 5.000000 2.236068
- 4 18 4.000000 2.000000
- 4 19 3.000000 1.732051
- 4 20 2.000000 1.414214
- 4 21 3.000000 1.732051
- 4 22 3.000000 1.732051
- 4 23 3.000000 1.732051
- 4 24 3.000000 1.732051
- 4 25 .000000 .000000
- 4 26 2.000000 1.414214
- 4 27 1.000000 1.000000
- 4 28 3.000000 1.732051
- 4 29 2.000000 1.414214
- 4 30 4.000000 2.000000
- 4 31 1.000000 1.000000
- 4 32 4.000000 2.000000
- 4 33 .000000 .000000
- 4 34 .000000 .000000
- 4 35 .000000 .000000
- 4 36 .000000 .000000
- 4 37 .000000 .000000
- 4 38 .000000 .000000
- 4 39 .000000 .000000
- 4 40 .000000 .000000
- 4 41 .000000 .000000
- 5 0 .000000 .000000
- 5 1 .000000 .000000
- 5 2 .000000 .000000
- 5 3 .000000 .000000
- 5 4 .000000 .000000
- 5 5 .000000 .000000
- 5 6 .000000 .000000
- 5 7 .000000 .000000
- 5 8 .000000 .000000
- 5 9 .000000 .000000
- 5 10 .000000 .000000
- 5 11 .000000 .000000
- 5 12 .000000 .000000
- 5 13 .000000 .000000
- 5 14 .000000 .000000
- 5 15 .000000 .000000
- 5 16 .000000 .000000
- 5 17 3.000000 1.732051
- 5 18 3.000000 1.732051
- 5 19 6.000000 2.449490
- 5 20 9.000000 3.000000
- 5 21 3.000000 1.732051
- 5 22 2.000000 1.414214
- 5 23 4.000000 2.000000
- 5 24 3.000000 1.732051
- 5 25 4.000000 2.000000
- 5 26 6.000000 2.449490
- 5 27 2.000000 1.414214
- 5 28 4.000000 2.000000
- 5 29 3.000000 1.732051
- 5 30 3.000000 1.732051
- 5 31 5.000000 2.236068
- 5 32 4.000000 2.000000
- 5 33 .000000 .000000
- 5 34 .000000 .000000
- 5 35 .000000 .000000
- 5 36 .000000 .000000
- 5 37 .000000 .000000
- 5 38 .000000 .000000
- 5 39 .000000 .000000
- 5 40 .000000 .000000
- 5 41 .000000 .000000
- 6 0 .000000 .000000
- 6 1 .000000 .000000
- 6 2 .000000 .000000
- 6 3 .000000 .000000
- 6 4 .000000 .000000
- 6 5 .000000 .000000
- 6 6 .000000 .000000
- 6 7 .000000 .000000
- 6 8 .000000 .000000
- 6 9 .000000 .000000
- 6 10 .000000 .000000
- 6 11 .000000 .000000
- 6 12 .000000 .000000
- 6 13 .000000 .000000
- 6 14 .000000 .000000
- 6 15 .000000 .000000
- 6 16 .000000 .000000
- 6 17 7.000000 2.645751
- 6 18 6.000000 2.449490
- 6 19 6.000000 2.449490
- 6 20 4.000000 2.000000
- 6 21 10.000000 3.162278
- 6 22 3.000000 1.732051
- 6 23 8.000000 2.828427
- 6 24 9.000000 3.000000
- 6 25 6.000000 2.449490
- 6 26 1.000000 1.000000
- 6 27 5.000000 2.236068
- 6 28 6.000000 2.449490
- 6 29 8.000000 2.828427
- 6 30 7.000000 2.645751
- 6 31 6.000000 2.449490
- 6 32 6.000000 2.449490
- 6 33 .000000 .000000
- 6 34 .000000 .000000
- 6 35 .000000 .000000
- 6 36 .000000 .000000
- 6 37 .000000 .000000
- 6 38 .000000 .000000
- 6 39 .000000 .000000
- 6 40 .000000 .000000
- 6 41 .000000 .000000
- 7 0 .000000 .000000
- 7 1 .000000 .000000
- 7 2 .000000 .000000
- 7 3 .000000 .000000
- 7 4 .000000 .000000
- 7 5 .000000 .000000
- 7 6 .000000 .000000
- 7 7 .000000 .000000
- 7 8 .000000 .000000
- 7 9 .000000 .000000
- 7 10 .000000 .000000
- 7 11 .000000 .000000
- 7 12 .000000 .000000
- 7 13 .000000 .000000
- 7 14 .000000 .000000
- 7 15 .000000 .000000
- 7 16 .000000 .000000
- 7 17 8.000000 2.828427
- 7 18 8.000000 2.828427
- 7 19 10.000000 3.162278
- 7 20 4.000000 2.000000
- 7 21 15.000000 3.872983
- 7 22 9.000000 3.000000
- 7 23 9.000000 3.000000
- 7 24 8.000000 2.828427
- 7 25 11.000000 3.316625
- 7 26 6.000000 2.449490
- 7 27 9.000000 3.000000
- 7 28 3.000000 1.732051
- 7 29 10.000000 3.162278
- 7 30 7.000000 2.645751
- 7 31 5.000000 2.236068
- 7 32 14.000000 3.741657
- 7 33 .000000 .000000
- 7 34 .000000 .000000
- 7 35 .000000 .000000
- 7 36 .000000 .000000
- 7 37 .000000 .000000
- 7 38 .000000 .000000
- 7 39 .000000 .000000
- 7 40 .000000 .000000
- 7 41 .000000 .000000
- 8 0 .000000 .000000
- 8 1 .000000 .000000
- 8 2 .000000 .000000
- 8 3 .000000 .000000
- 8 4 .000000 .000000
- 8 5 .000000 .000000
- 8 6 .000000 .000000
- 8 7 .000000 .000000
- 8 8 .000000 .000000
- 8 9 .000000 .000000
- 8 10 .000000 .000000
- 8 11 .000000 .000000
- 8 12 .000000 .000000
- 8 13 .000000 .000000
- 8 14 .000000 .000000
- 8 15 .000000 .000000
- 8 16 .000000 .000000
- 8 17 7.000000 2.645751
- 8 18 12.000000 3.464102
- 8 19 20.000000 4.472136
- 8 20 13.000000 3.605551
- 8 21 16.000000 4.000000
- 8 22 12.000000 3.464102
- 8 23 10.000000 3.162278
- 8 24 13.000000 3.605551
- 8 25 12.000000 3.464102
- 8 26 3.000000 1.732051
- 8 27 13.000000 3.605551
- 8 28 8.000000 2.828427
- 8 29 11.000000 3.316625
- 8 30 11.000000 3.316625
- 8 31 11.000000 3.316625
- 8 32 9.000000 3.000000
- 8 33 .000000 .000000
- 8 34 .000000 .000000
- 8 35 .000000 .000000
- 8 36 .000000 .000000
- 8 37 .000000 .000000
- 8 38 .000000 .000000
- 8 39 .000000 .000000
- 8 40 .000000 .000000
- 8 41 .000000 .000000
- 9 0 .000000 .000000
- 9 1 .000000 .000000
- 9 2 .000000 .000000
- 9 3 .000000 .000000
- 9 4 .000000 .000000
- 9 5 .000000 .000000
- 9 6 .000000 .000000
- 9 7 .000000 .000000
- 9 8 .000000 .000000
- 9 9 .000000 .000000
- 9 10 .000000 .000000
- 9 11 .000000 .000000
- 9 12 .000000 .000000
- 9 13 .000000 .000000
- 9 14 .000000 .000000
- 9 15 .000000 .000000
- 9 16 .000000 .000000
- 9 17 11.000000 3.316625
- 9 18 12.000000 3.464102
- 9 19 14.000000 3.741657
- 9 20 17.000000 4.123106
- 9 21 17.000000 4.123106
- 9 22 23.000000 4.795832
- 9 23 19.000000 4.358899
- 9 24 16.000000 4.000000
- 9 25 25.000000 5.000000
- 9 26 13.000000 3.605551
- 9 27 11.000000 3.316625
- 9 28 16.000000 4.000000
- 9 29 18.000000 4.242640
- 9 30 19.000000 4.358899
- 9 31 17.000000 4.123106
- 9 32 16.000000 4.000000
- 9 33 .000000 .000000
- 9 34 .000000 .000000
- 9 35 .000000 .000000
- 9 36 .000000 .000000
- 9 37 .000000 .000000
- 9 38 .000000 .000000
- 9 39 .000000 .000000
- 9 40 .000000 .000000
- 9 41 .000000 .000000
- 10 0 .000000 .000000
- 10 1 .000000 .000000
- 10 2 .000000 .000000
- 10 3 .000000 .000000
- 10 4 .000000 .000000
- 10 5 .000000 .000000
- 10 6 .000000 .000000
- 10 7 .000000 .000000
- 10 8 .000000 .000000
- 10 9 .000000 .000000
- 10 10 .000000 .000000
- 10 11 .000000 .000000
- 10 12 .000000 .000000
- 10 13 .000000 .000000
- 10 14 .000000 .000000
- 10 15 .000000 .000000
- 10 16 .000000 .000000
- 10 17 20.000000 4.472136
- 10 18 25.000000 5.000000
- 10 19 24.000000 4.898980
- 10 20 23.000000 4.795832
- 10 21 23.000000 4.795832
- 10 22 14.000000 3.741657
- 10 23 21.000000 4.582576
- 10 24 23.000000 4.795832
- 10 25 28.000000 5.291502
- 10 26 19.000000 4.358899
- 10 27 23.000000 4.795832
- 10 28 27.000000 5.196152
- 10 29 14.000000 3.741657
- 10 30 34.000000 5.830952
- 10 31 26.000000 5.099020
- 10 32 26.000000 5.099020
- 10 33 .000000 .000000
- 10 34 .000000 .000000
- 10 35 .000000 .000000
- 10 36 .000000 .000000
- 10 37 .000000 .000000
- 10 38 .000000 .000000
- 10 39 .000000 .000000
- 10 40 .000000 .000000
- 10 41 .000000 .000000
- 11 0 .000000 .000000
- 11 1 .000000 .000000
- 11 2 .000000 .000000
- 11 3 .000000 .000000
- 11 4 .000000 .000000
- 11 5 .000000 .000000
- 11 6 .000000 .000000
- 11 7 .000000 .000000
- 11 8 .000000 .000000
- 11 9 .000000 .000000
- 11 10 .000000 .000000
- 11 11 .000000 .000000
- 11 12 .000000 .000000
- 11 13 .000000 .000000
- 11 14 .000000 .000000
- 11 15 .000000 .000000
- 11 16 .000000 .000000
- 11 17 30.000000 5.477226
- 11 18 19.000000 4.358899
- 11 19 23.000000 4.795832
- 11 20 26.000000 5.099020
- 11 21 24.000000 4.898980
- 11 22 33.000000 5.744563
- 11 23 28.000000 5.291502
- 11 24 28.000000 5.291502
- 11 25 28.000000 5.291502
- 11 26 34.000000 5.830952
- 11 27 26.000000 5.099020
- 11 28 23.000000 4.795832
- 11 29 34.000000 5.830952
- 11 30 30.000000 5.477226
- 11 31 23.000000 4.795832
- 11 32 29.000000 5.385165
- 11 33 .000000 .000000
- 11 34 .000000 .000000
- 11 35 .000000 .000000
- 11 36 .000000 .000000
- 11 37 .000000 .000000
- 11 38 .000000 .000000
- 11 39 .000000 .000000
- 11 40 .000000 .000000
- 11 41 .000000 .000000
- 12 0 .000000 .000000
- 12 1 .000000 .000000
- 12 2 .000000 .000000
- 12 3 .000000 .000000
- 12 4 .000000 .000000
- 12 5 .000000 .000000
- 12 6 .000000 .000000
- 12 7 .000000 .000000
- 12 8 .000000 .000000
- 12 9 .000000 .000000
- 12 10 .000000 .000000
- 12 11 .000000 .000000
- 12 12 .000000 .000000
- 12 13 .000000 .000000
- 12 14 .000000 .000000
- 12 15 .000000 .000000
- 12 16 .000000 .000000
- 12 17 41.000000 6.403124
- 12 18 32.000000 5.656854
- 12 19 35.000000 5.916080
- 12 20 36.000000 6.000000
- 12 21 34.000000 5.830952
- 12 22 26.000000 5.099020
- 12 23 28.000000 5.291502
- 12 24 42.000000 6.480741
- 12 25 33.000000 5.744563
- 12 26 39.000000 6.244998
- 12 27 38.000000 6.164414
- 12 28 42.000000 6.480741
- 12 29 33.000000 5.744563
- 12 30 23.000000 4.795832
- 12 31 34.000000 5.830952
- 12 32 32.000000 5.656854
- 12 33 .000000 .000000
- 12 34 .000000 .000000
- 12 35 .000000 .000000
- 12 36 .000000 .000000
- 12 37 .000000 .000000
- 12 38 .000000 .000000
- 12 39 .000000 .000000
- 12 40 .000000 .000000
- 12 41 .000000 .000000
- 13 0 .000000 .000000
- 13 1 .000000 .000000
- 13 2 .000000 .000000
- 13 3 .000000 .000000
- 13 4 .000000 .000000
- 13 5 .000000 .000000
- 13 6 .000000 .000000
- 13 7 .000000 .000000
- 13 8 .000000 .000000
- 13 9 .000000 .000000
- 13 10 .000000 .000000
- 13 11 .000000 .000000
- 13 12 .000000 .000000
- 13 13 .000000 .000000
- 13 14 .000000 .000000
- 13 15 .000000 .000000
- 13 16 .000000 .000000
- 13 17 43.000000 6.557438
- 13 18 49.000000 7.000000
- 13 19 59.000000 7.681146
- 13 20 46.000000 6.782330
- 13 21 57.000000 7.549834
- 13 22 46.000000 6.782330
- 13 23 45.000000 6.708204
- 13 24 43.000000 6.557438
- 13 25 35.000000 5.916080
- 13 26 33.000000 5.744563
- 13 27 46.000000 6.782330
- 13 28 38.000000 6.164414
- 13 29 47.000000 6.855655
- 13 30 43.000000 6.557438
- 13 31 35.000000 5.916080
- 13 32 43.000000 6.557438
- 13 33 .000000 .000000
- 13 34 .000000 .000000
- 13 35 .000000 .000000
- 13 36 .000000 .000000
- 13 37 .000000 .000000
- 13 38 .000000 .000000
- 13 39 .000000 .000000
- 13 40 .000000 .000000
- 13 41 .000000 .000000
- 14 0 .000000 .000000
- 14 1 .000000 .000000
- 14 2 .000000 .000000
- 14 3 .000000 .000000
- 14 4 .000000 .000000
- 14 5 .000000 .000000
- 14 6 .000000 .000000
- 14 7 .000000 .000000
- 14 8 .000000 .000000
- 14 9 .000000 .000000
- 14 10 .000000 .000000
- 14 11 .000000 .000000
- 14 12 .000000 .000000
- 14 13 .000000 .000000
- 14 14 .000000 .000000
- 14 15 .000000 .000000
- 14 16 .000000 .000000
- 14 17 37.000000 6.082763
- 14 18 49.000000 7.000000
- 14 19 52.000000 7.211102
- 14 20 41.000000 6.403124
- 14 21 50.000000 7.071068
- 14 22 60.000000 7.745967
- 14 23 48.000000 6.928203
- 14 24 51.000000 7.141428
- 14 25 38.000000 6.164414
- 14 26 54.000000 7.348469
- 14 27 53.000000 7.280110
- 14 28 35.000000 5.916080
- 14 29 39.000000 6.244998
- 14 30 44.000000 6.633250
- 14 31 54.000000 7.348469
- 14 32 55.000000 7.416198
- 14 33 .000000 .000000
- 14 34 .000000 .000000
- 14 35 .000000 .000000
- 14 36 .000000 .000000
- 14 37 .000000 .000000
- 14 38 .000000 .000000
- 14 39 .000000 .000000
- 14 40 .000000 .000000
- 14 41 .000000 .000000
- 15 0 .000000 .000000
- 15 1 .000000 .000000
- 15 2 .000000 .000000
- 15 3 .000000 .000000
- 15 4 .000000 .000000
- 15 5 .000000 .000000
- 15 6 .000000 .000000
- 15 7 .000000 .000000
- 15 8 .000000 .000000
- 15 9 .000000 .000000
- 15 10 .000000 .000000
- 15 11 .000000 .000000
- 15 12 .000000 .000000
- 15 13 .000000 .000000
- 15 14 .000000 .000000
- 15 15 .000000 .000000
- 15 16 .000000 .000000
- 15 17 64.000000 8.000000
- 15 18 64.000000 8.000000
- 15 19 62.000000 7.874008
- 15 20 68.000000 8.246211
- 15 21 59.000000 7.681146
- 15 22 52.000000 7.211102
- 15 23 50.000000 7.071068
- 15 24 60.000000 7.745967
- 15 25 66.000000 8.124039
- 15 26 59.000000 7.681146
- 15 27 48.000000 6.928203
- 15 28 58.000000 7.615773
- 15 29 58.000000 7.615773
- 15 30 57.000000 7.549834
- 15 31 67.000000 8.185352
- 15 32 65.000000 8.062258
- 15 33 .000000 .000000
- 15 34 .000000 .000000
- 15 35 .000000 .000000
- 15 36 .000000 .000000
- 15 37 .000000 .000000
- 15 38 .000000 .000000
- 15 39 .000000 .000000
- 15 40 .000000 .000000
- 15 41 .000000 .000000
- 16 0 .000000 .000000
- 16 1 .000000 .000000
- 16 2 .000000 .000000
- 16 3 .000000 .000000
- 16 4 .000000 .000000
- 16 5 .000000 .000000
- 16 6 .000000 .000000
- 16 7 .000000 .000000
- 16 8 .000000 .000000
- 16 9 .000000 .000000
- 16 10 .000000 .000000
- 16 11 .000000 .000000
- 16 12 .000000 .000000
- 16 13 .000000 .000000
- 16 14 .000000 .000000
- 16 15 .000000 .000000
- 16 16 .000000 .000000
- 16 17 59.000000 7.681146
- 16 18 54.000000 7.348469
- 16 19 62.000000 7.874008
- 16 20 65.000000 8.062258
- 16 21 80.000000 8.944272
- 16 22 68.000000 8.246211
- 16 23 59.000000 7.681146
- 16 24 58.000000 7.615773
- 16 25 62.000000 7.874008
- 16 26 67.000000 8.185352
- 16 27 64.000000 8.000000
- 16 28 61.000000 7.810250
- 16 29 69.000000 8.306623
- 16 30 60.000000 7.745967
- 16 31 69.000000 8.306623
- 16 32 51.000000 7.141428
- 16 33 .000000 .000000
- 16 34 .000000 .000000
- 16 35 .000000 .000000
- 16 36 .000000 .000000
- 16 37 .000000 .000000
- 16 38 .000000 .000000
- 16 39 .000000 .000000
- 16 40 .000000 .000000
- 16 41 .000000 .000000
- 17 0 .000000 .000000
- 17 1 .000000 .000000
- 17 2 .000000 .000000
- 17 3 .000000 .000000
- 17 4 .000000 .000000
- 17 5 .000000 .000000
- 17 6 .000000 .000000
- 17 7 .000000 .000000
- 17 8 .000000 .000000
- 17 9 .000000 .000000
- 17 10 .000000 .000000
- 17 11 .000000 .000000
- 17 12 .000000 .000000
- 17 13 .000000 .000000
- 17 14 .000000 .000000
- 17 15 .000000 .000000
- 17 16 .000000 .000000
- 17 17 74.000000 8.602325
- 17 18 78.000000 8.831760
- 17 19 74.000000 8.602325
- 17 20 80.000000 8.944272
- 17 21 65.000000 8.062258
- 17 22 89.000000 9.433981
- 17 23 71.000000 8.426149
- 17 24 71.000000 8.426149
- 17 25 84.000000 9.165152
- 17 26 57.000000 7.549834
- 17 27 60.000000 7.745967
- 17 28 74.000000 8.602325
- 17 29 72.000000 8.485281
- 17 30 60.000000 7.745967
- 17 31 70.000000 8.366600
- 17 32 61.000000 7.810250
- 17 33 .000000 .000000
- 17 34 .000000 .000000
- 17 35 .000000 .000000
- 17 36 .000000 .000000
- 17 37 .000000 .000000
- 17 38 .000000 .000000
- 17 39 .000000 .000000
- 17 40 .000000 .000000
- 17 41 .000000 .000000
- 18 0 .000000 .000000
- 18 1 .000000 .000000
- 18 2 .000000 .000000
- 18 3 .000000 .000000
- 18 4 .000000 .000000
- 18 5 .000000 .000000
- 18 6 .000000 .000000
- 18 7 .000000 .000000
- 18 8 .000000 .000000
- 18 9 .000000 .000000
- 18 10 .000000 .000000
- 18 11 .000000 .000000
- 18 12 .000000 .000000
- 18 13 .000000 .000000
- 18 14 .000000 .000000
- 18 15 .000000 .000000
- 18 16 .000000 .000000
- 18 17 76.000000 8.717798
- 18 18 64.000000 8.000000
- 18 19 87.000000 9.327379
- 18 20 73.000000 8.544003
- 18 21 86.000000 9.273619
- 18 22 64.000000 8.000000
- 18 23 78.000000 8.831760
- 18 24 84.000000 9.165152
- 18 25 65.000000 8.062258
- 18 26 92.000000 9.591663
- 18 27 74.000000 8.602325
- 18 28 75.000000 8.660254
- 18 29 84.000000 9.165152
- 18 30 83.000000 9.110434
- 18 31 100.000000 10.000000
- 18 32 76.000000 8.717798
- 18 33 .000000 .000000
- 18 34 .000000 .000000
- 18 35 .000000 .000000
- 18 36 .000000 .000000
- 18 37 .000000 .000000
- 18 38 .000000 .000000
- 18 39 .000000 .000000
- 18 40 .000000 .000000
- 18 41 .000000 .000000
- 19 0 .000000 .000000
- 19 1 .000000 .000000
- 19 2 .000000 .000000
- 19 3 .000000 .000000
- 19 4 .000000 .000000
- 19 5 .000000 .000000
- 19 6 .000000 .000000
- 19 7 .000000 .000000
- 19 8 .000000 .000000
- 19 9 .000000 .000000
- 19 10 .000000 .000000
- 19 11 .000000 .000000
- 19 12 .000000 .000000
- 19 13 .000000 .000000
- 19 14 .000000 .000000
- 19 15 .000000 .000000
- 19 16 .000000 .000000
- 19 17 71.000000 8.426149
- 19 18 77.000000 8.774964
- 19 19 68.000000 8.246211
- 19 20 73.000000 8.544003
- 19 21 79.000000 8.888194
- 19 22 71.000000 8.426149
- 19 23 66.000000 8.124039
- 19 24 81.000000 9.000000
- 19 25 74.000000 8.602325
- 19 26 78.000000 8.831760
- 19 27 94.000000 9.695360
- 19 28 89.000000 9.433981
- 19 29 94.000000 9.695360
- 19 30 77.000000 8.774964
- 19 31 91.000000 9.539392
- 19 32 75.000000 8.660254
- 19 33 .000000 .000000
- 19 34 .000000 .000000
- 19 35 .000000 .000000
- 19 36 .000000 .000000
- 19 37 .000000 .000000
- 19 38 .000000 .000000
- 19 39 .000000 .000000
- 19 40 .000000 .000000
- 19 41 .000000 .000000
- 20 0 .000000 .000000
- 20 1 .000000 .000000
- 20 2 .000000 .000000
- 20 3 .000000 .000000
- 20 4 .000000 .000000
- 20 5 .000000 .000000
- 20 6 .000000 .000000
- 20 7 .000000 .000000
- 20 8 .000000 .000000
- 20 9 .000000 .000000
- 20 10 .000000 .000000
- 20 11 .000000 .000000
- 20 12 .000000 .000000
- 20 13 .000000 .000000
- 20 14 .000000 .000000
- 20 15 .000000 .000000
- 20 16 .000000 .000000
- 20 17 82.000000 9.055386
- 20 18 74.000000 8.602325
- 20 19 66.000000 8.124039
- 20 20 77.000000 8.774964
- 20 21 79.000000 8.888194
- 20 22 94.000000 9.695360
- 20 23 91.000000 9.539392
- 20 24 86.000000 9.273619
- 20 25 82.000000 9.055386
- 20 26 94.000000 9.695360
- 20 27 82.000000 9.055386
- 20 28 94.000000 9.695360
- 20 29 101.000000 10.049875
- 20 30 96.000000 9.797959
- 20 31 81.000000 9.000000
- 20 32 66.000000 8.124039
- 20 33 .000000 .000000
- 20 34 .000000 .000000
- 20 35 .000000 .000000
- 20 36 .000000 .000000
- 20 37 .000000 .000000
- 20 38 .000000 .000000
- 20 39 .000000 .000000
- 20 40 .000000 .000000
- 20 41 .000000 .000000
- 21 0 .000000 .000000
- 21 1 .000000 .000000
- 21 2 .000000 .000000
- 21 3 .000000 .000000
- 21 4 .000000 .000000
- 21 5 .000000 .000000
- 21 6 .000000 .000000
- 21 7 .000000 .000000
- 21 8 .000000 .000000
- 21 9 .000000 .000000
- 21 10 .000000 .000000
- 21 11 .000000 .000000
- 21 12 .000000 .000000
- 21 13 .000000 .000000
- 21 14 .000000 .000000
- 21 15 .000000 .000000
- 21 16 .000000 .000000
- 21 17 69.000000 8.306623
- 21 18 83.000000 9.110434
- 21 19 75.000000 8.660254
- 21 20 84.000000 9.165152
- 21 21 76.000000 8.717798
- 21 22 79.000000 8.888194
- 21 23 83.000000 9.110434
- 21 24 77.000000 8.774964
- 21 25 93.000000 9.643651
- 21 26 74.000000 8.602325
- 21 27 77.000000 8.774964
- 21 28 88.000000 9.380832
- 21 29 70.000000 8.366600
- 21 30 82.000000 9.055386
- 21 31 65.000000 8.062258
- 21 32 97.000000 9.848858
- 21 33 .000000 .000000
- 21 34 .000000 .000000
- 21 35 .000000 .000000
- 21 36 .000000 .000000
- 21 37 .000000 .000000
- 21 38 .000000 .000000
- 21 39 .000000 .000000
- 21 40 .000000 .000000
- 21 41 .000000 .000000
- 22 0 .000000 .000000
- 22 1 .000000 .000000
- 22 2 .000000 .000000
- 22 3 .000000 .000000
- 22 4 .000000 .000000
- 22 5 .000000 .000000
- 22 6 .000000 .000000
- 22 7 .000000 .000000
- 22 8 .000000 .000000
- 22 9 .000000 .000000
- 22 10 .000000 .000000
- 22 11 .000000 .000000
- 22 12 .000000 .000000
- 22 13 .000000 .000000
- 22 14 .000000 .000000
- 22 15 .000000 .000000
- 22 16 .000000 .000000
- 22 17 98.000000 9.899495
- 22 18 77.000000 8.774964
- 22 19 94.000000 9.695360
- 22 20 63.000000 7.937254
- 22 21 78.000000 8.831760
- 22 22 72.000000 8.485281
- 22 23 59.000000 7.681146
- 22 24 76.000000 8.717798
- 22 25 80.000000 8.944272
- 22 26 83.000000 9.110434
- 22 27 70.000000 8.366600
- 22 28 82.000000 9.055386
- 22 29 85.000000 9.219544
- 22 30 83.000000 9.110434
- 22 31 68.000000 8.246211
- 22 32 77.000000 8.774964
- 22 33 .000000 .000000
- 22 34 .000000 .000000
- 22 35 .000000 .000000
- 22 36 .000000 .000000
- 22 37 .000000 .000000
- 22 38 .000000 .000000
- 22 39 .000000 .000000
- 22 40 .000000 .000000
- 22 41 .000000 .000000
- 23 0 .000000 .000000
- 23 1 .000000 .000000
- 23 2 .000000 .000000
- 23 3 .000000 .000000
- 23 4 .000000 .000000
- 23 5 .000000 .000000
- 23 6 .000000 .000000
- 23 7 .000000 .000000
- 23 8 .000000 .000000
- 23 9 .000000 .000000
- 23 10 .000000 .000000
- 23 11 .000000 .000000
- 23 12 .000000 .000000
- 23 13 .000000 .000000
- 23 14 .000000 .000000
- 23 15 .000000 .000000
- 23 16 .000000 .000000
- 23 17 76.000000 8.717798
- 23 18 62.000000 7.874008
- 23 19 91.000000 9.539392
- 23 20 87.000000 9.327379
- 23 21 78.000000 8.831760
- 23 22 73.000000 8.544003
- 23 23 82.000000 9.055386
- 23 24 69.000000 8.306623
- 23 25 72.000000 8.485281
- 23 26 64.000000 8.000000
- 23 27 75.000000 8.660254
- 23 28 78.000000 8.831760
- 23 29 91.000000 9.539392
- 23 30 66.000000 8.124039
- 23 31 72.000000 8.485281
- 23 32 79.000000 8.888194
- 23 33 .000000 .000000
- 23 34 .000000 .000000
- 23 35 .000000 .000000
- 23 36 .000000 .000000
- 23 37 .000000 .000000
- 23 38 .000000 .000000
- 23 39 .000000 .000000
- 23 40 .000000 .000000
- 23 41 .000000 .000000
- 24 0 .000000 .000000
- 24 1 .000000 .000000
- 24 2 .000000 .000000
- 24 3 .000000 .000000
- 24 4 .000000 .000000
- 24 5 .000000 .000000
- 24 6 .000000 .000000
- 24 7 .000000 .000000
- 24 8 .000000 .000000
- 24 9 .000000 .000000
- 24 10 .000000 .000000
- 24 11 .000000 .000000
- 24 12 .000000 .000000
- 24 13 .000000 .000000
- 24 14 .000000 .000000
- 24 15 .000000 .000000
- 24 16 .000000 .000000
- 24 17 80.000000 8.944272
- 24 18 89.000000 9.433981
- 24 19 67.000000 8.185352
- 24 20 71.000000 8.426149
- 24 21 64.000000 8.000000
- 24 22 69.000000 8.306623
- 24 23 71.000000 8.426149
- 24 24 74.000000 8.602325
- 24 25 76.000000 8.717798
- 24 26 71.000000 8.426149
- 24 27 68.000000 8.246211
- 24 28 64.000000 8.000000
- 24 29 65.000000 8.062258
- 24 30 72.000000 8.485281
- 24 31 70.000000 8.366600
- 24 32 80.000000 8.944272
- 24 33 .000000 .000000
- 24 34 .000000 .000000
- 24 35 .000000 .000000
- 24 36 .000000 .000000
- 24 37 .000000 .000000
- 24 38 .000000 .000000
- 24 39 .000000 .000000
- 24 40 .000000 .000000
- 24 41 .000000 .000000
- 25 0 .000000 .000000
- 25 1 .000000 .000000
- 25 2 .000000 .000000
- 25 3 .000000 .000000
- 25 4 .000000 .000000
- 25 5 .000000 .000000
- 25 6 .000000 .000000
- 25 7 .000000 .000000
- 25 8 .000000 .000000
- 25 9 .000000 .000000
- 25 10 .000000 .000000
- 25 11 .000000 .000000
- 25 12 .000000 .000000
- 25 13 .000000 .000000
- 25 14 .000000 .000000
- 25 15 .000000 .000000
- 25 16 .000000 .000000
- 25 17 75.000000 8.660254
- 25 18 68.000000 8.246211
- 25 19 70.000000 8.366600
- 25 20 79.000000 8.888194
- 25 21 60.000000 7.745967
- 25 22 67.000000 8.185352
- 25 23 59.000000 7.681146
- 25 24 59.000000 7.681146
- 25 25 57.000000 7.549834
- 25 26 52.000000 7.211102
- 25 27 68.000000 8.246211
- 25 28 56.000000 7.483315
- 25 29 67.000000 8.185352
- 25 30 78.000000 8.831760
- 25 31 50.000000 7.071068
- 25 32 67.000000 8.185352
- 25 33 .000000 .000000
- 25 34 .000000 .000000
- 25 35 .000000 .000000
- 25 36 .000000 .000000
- 25 37 .000000 .000000
- 25 38 .000000 .000000
- 25 39 .000000 .000000
- 25 40 .000000 .000000
- 25 41 .000000 .000000
- 26 0 .000000 .000000
- 26 1 .000000 .000000
- 26 2 .000000 .000000
- 26 3 .000000 .000000
- 26 4 .000000 .000000
- 26 5 .000000 .000000
- 26 6 .000000 .000000
- 26 7 .000000 .000000
- 26 8 .000000 .000000
- 26 9 .000000 .000000
- 26 10 .000000 .000000
- 26 11 .000000 .000000
- 26 12 .000000 .000000
- 26 13 .000000 .000000
- 26 14 .000000 .000000
- 26 15 .000000 .000000
- 26 16 .000000 .000000
- 26 17 51.000000 7.141428
- 26 18 59.000000 7.681146
- 26 19 49.000000 7.000000
- 26 20 56.000000 7.483315
- 26 21 52.000000 7.211102
- 26 22 58.000000 7.615773
- 26 23 52.000000 7.211102
- 26 24 52.000000 7.211102
- 26 25 61.000000 7.810250
- 26 26 43.000000 6.557438
- 26 27 60.000000 7.745967
- 26 28 57.000000 7.549834
- 26 29 62.000000 7.874008
- 26 30 56.000000 7.483315
- 26 31 61.000000 7.810250
- 26 32 72.000000 8.485281
- 26 33 .000000 .000000
- 26 34 .000000 .000000
- 26 35 .000000 .000000
- 26 36 .000000 .000000
- 26 37 .000000 .000000
- 26 38 .000000 .000000
- 26 39 .000000 .000000
- 26 40 .000000 .000000
- 26 41 .000000 .000000
- 27 0 .000000 .000000
- 27 1 .000000 .000000
- 27 2 .000000 .000000
- 27 3 .000000 .000000
- 27 4 .000000 .000000
- 27 5 .000000 .000000
- 27 6 .000000 .000000
- 27 7 .000000 .000000
- 27 8 .000000 .000000
- 27 9 .000000 .000000
- 27 10 .000000 .000000
- 27 11 .000000 .000000
- 27 12 .000000 .000000
- 27 13 .000000 .000000
- 27 14 .000000 .000000
- 27 15 .000000 .000000
- 27 16 .000000 .000000
- 27 17 39.000000 6.244998
- 27 18 50.000000 7.071068
- 27 19 43.000000 6.557438
- 27 20 58.000000 7.615773
- 27 21 46.000000 6.782330
- 27 22 48.000000 6.928203
- 27 23 45.000000 6.708204
- 27 24 41.000000 6.403124
- 27 25 43.000000 6.557438
- 27 26 48.000000 6.928203
- 27 27 30.000000 5.477226
- 27 28 45.000000 6.708204
- 27 29 41.000000 6.403124
- 27 30 50.000000 7.071068
- 27 31 42.000000 6.480741
- 27 32 42.000000 6.480741
- 27 33 .000000 .000000
- 27 34 .000000 .000000
- 27 35 .000000 .000000
- 27 36 .000000 .000000
- 27 37 .000000 .000000
- 27 38 .000000 .000000
- 27 39 .000000 .000000
- 27 40 .000000 .000000
- 27 41 .000000 .000000
- 28 0 .000000 .000000
- 28 1 .000000 .000000
- 28 2 .000000 .000000
- 28 3 .000000 .000000
- 28 4 .000000 .000000
- 28 5 .000000 .000000
- 28 6 .000000 .000000
- 28 7 .000000 .000000
- 28 8 .000000 .000000
- 28 9 .000000 .000000
- 28 10 .000000 .000000
- 28 11 .000000 .000000
- 28 12 .000000 .000000
- 28 13 .000000 .000000
- 28 14 .000000 .000000
- 28 15 .000000 .000000
- 28 16 .000000 .000000
- 28 17 37.000000 6.082763
- 28 18 55.000000 7.416198
- 28 19 40.000000 6.324555
- 28 20 48.000000 6.928203
- 28 21 48.000000 6.928203
- 28 22 45.000000 6.708204
- 28 23 50.000000 7.071068
- 28 24 47.000000 6.855655
- 28 25 42.000000 6.480741
- 28 26 39.000000 6.244998
- 28 27 54.000000 7.348469
- 28 28 36.000000 6.000000
- 28 29 35.000000 5.916080
- 28 30 31.000000 5.567764
- 28 31 37.000000 6.082763
- 28 32 39.000000 6.244998
- 28 33 .000000 .000000
- 28 34 .000000 .000000
- 28 35 .000000 .000000
- 28 36 .000000 .000000
- 28 37 .000000 .000000
- 28 38 .000000 .000000
- 28 39 .000000 .000000
- 28 40 .000000 .000000
- 28 41 .000000 .000000
- 29 0 .000000 .000000
- 29 1 .000000 .000000
- 29 2 .000000 .000000
- 29 3 .000000 .000000
- 29 4 .000000 .000000
- 29 5 .000000 .000000
- 29 6 .000000 .000000
- 29 7 .000000 .000000
- 29 8 .000000 .000000
- 29 9 .000000 .000000
- 29 10 .000000 .000000
- 29 11 .000000 .000000
- 29 12 .000000 .000000
- 29 13 .000000 .000000
- 29 14 .000000 .000000
- 29 15 .000000 .000000
- 29 16 .000000 .000000
- 29 17 44.000000 6.633250
- 29 18 28.000000 5.291502
- 29 19 41.000000 6.403124
- 29 20 40.000000 6.324555
- 29 21 41.000000 6.403124
- 29 22 38.000000 6.164414
- 29 23 35.000000 5.916080
- 29 24 34.000000 5.830952
- 29 25 40.000000 6.324555
- 29 26 36.000000 6.000000
- 29 27 39.000000 6.244998
- 29 28 40.000000 6.324555
- 29 29 27.000000 5.196152
- 29 30 29.000000 5.385165
- 29 31 46.000000 6.782330
- 29 32 44.000000 6.633250
- 29 33 .000000 .000000
- 29 34 .000000 .000000
- 29 35 .000000 .000000
- 29 36 .000000 .000000
- 29 37 .000000 .000000
- 29 38 .000000 .000000
- 29 39 .000000 .000000
- 29 40 .000000 .000000
- 29 41 .000000 .000000
- 30 0 .000000 .000000
- 30 1 .000000 .000000
- 30 2 .000000 .000000
- 30 3 .000000 .000000
- 30 4 .000000 .000000
- 30 5 .000000 .000000
- 30 6 .000000 .000000
- 30 7 .000000 .000000
- 30 8 .000000 .000000
- 30 9 .000000 .000000
- 30 10 .000000 .000000
- 30 11 .000000 .000000
- 30 12 .000000 .000000
- 30 13 .000000 .000000
- 30 14 .000000 .000000
- 30 15 .000000 .000000
- 30 16 .000000 .000000
- 30 17 27.000000 5.196152
- 30 18 21.000000 4.582576
- 30 19 20.000000 4.472136
- 30 20 25.000000 5.000000
- 30 21 30.000000 5.477226
- 30 22 14.000000 3.741657
- 30 23 21.000000 4.582576
- 30 24 25.000000 5.000000
- 30 25 22.000000 4.690416
- 30 26 25.000000 5.000000
- 30 27 27.000000 5.196152
- 30 28 13.000000 3.605551
- 30 29 30.000000 5.477226
- 30 30 19.000000 4.358899
- 30 31 20.000000 4.472136
- 30 32 26.000000 5.099020
- 30 33 .000000 .000000
- 30 34 .000000 .000000
- 30 35 .000000 .000000
- 30 36 .000000 .000000
- 30 37 .000000 .000000
- 30 38 .000000 .000000
- 30 39 .000000 .000000
- 30 40 .000000 .000000
- 30 41 .000000 .000000
- 31 0 .000000 .000000
- 31 1 .000000 .000000
- 31 2 .000000 .000000
- 31 3 .000000 .000000
- 31 4 .000000 .000000
- 31 5 .000000 .000000
- 31 6 .000000 .000000
- 31 7 .000000 .000000
- 31 8 .000000 .000000
- 31 9 .000000 .000000
- 31 10 .000000 .000000
- 31 11 .000000 .000000
- 31 12 .000000 .000000
- 31 13 .000000 .000000
- 31 14 .000000 .000000
- 31 15 .000000 .000000
- 31 16 .000000 .000000
- 31 17 18.000000 4.242640
- 31 18 24.000000 4.898980
- 31 19 26.000000 5.099020
- 31 20 24.000000 4.898980
- 31 21 14.000000 3.741657
- 31 22 18.000000 4.242640
- 31 23 17.000000 4.123106
- 31 24 23.000000 4.795832
- 31 25 22.000000 4.690416
- 31 26 23.000000 4.795832
- 31 27 22.000000 4.690416
- 31 28 21.000000 4.582576
- 31 29 19.000000 4.358899
- 31 30 20.000000 4.472136
- 31 31 17.000000 4.123106
- 31 32 28.000000 5.291502
- 31 33 .000000 .000000
- 31 34 .000000 .000000
- 31 35 .000000 .000000
- 31 36 .000000 .000000
- 31 37 .000000 .000000
- 31 38 .000000 .000000
- 31 39 .000000 .000000
- 31 40 .000000 .000000
- 31 41 .000000 .000000
- 32 0 .000000 .000000
- 32 1 .000000 .000000
- 32 2 .000000 .000000
- 32 3 .000000 .000000
- 32 4 .000000 .000000
- 32 5 .000000 .000000
- 32 6 .000000 .000000
- 32 7 .000000 .000000
- 32 8 .000000 .000000
- 32 9 .000000 .000000
- 32 10 .000000 .000000
- 32 11 .000000 .000000
- 32 12 .000000 .000000
- 32 13 .000000 .000000
- 32 14 .000000 .000000
- 32 15 .000000 .000000
- 32 16 .000000 .000000
- 32 17 13.000000 3.605551
- 32 18 15.000000 3.872983
- 32 19 17.000000 4.123106
- 32 20 26.000000 5.099020
- 32 21 18.000000 4.242640
- 32 22 22.000000 4.690416
- 32 23 19.000000 4.358899
- 32 24 14.000000 3.741657
- 32 25 14.000000 3.741657
- 32 26 14.000000 3.741657
- 32 27 9.000000 3.000000
- 32 28 12.000000 3.464102
- 32 29 13.000000 3.605551
- 32 30 5.000000 2.236068
- 32 31 15.000000 3.872983
- 32 32 19.000000 4.358899
- 32 33 .000000 .000000
- 32 34 .000000 .000000
- 32 35 .000000 .000000
- 32 36 .000000 .000000
- 32 37 .000000 .000000
- 32 38 .000000 .000000
- 32 39 .000000 .000000
- 32 40 .000000 .000000
- 32 41 .000000 .000000
- 33 0 .000000 .000000
- 33 1 .000000 .000000
- 33 2 .000000 .000000
- 33 3 .000000 .000000
- 33 4 .000000 .000000
- 33 5 .000000 .000000
- 33 6 .000000 .000000
- 33 7 .000000 .000000
- 33 8 .000000 .000000
- 33 9 .000000 .000000
- 33 10 .000000 .000000
- 33 11 .000000 .000000
- 33 12 .000000 .000000
- 33 13 .000000 .000000
- 33 14 .000000 .000000
- 33 15 .000000 .000000
- 33 16 .000000 .000000
- 33 17 12.000000 3.464102
- 33 18 12.000000 3.464102
- 33 19 14.000000 3.741657
- 33 20 14.000000 3.741657
- 33 21 6.000000 2.449490
- 33 22 16.000000 4.000000
- 33 23 14.000000 3.741657
- 33 24 10.000000 3.162278
- 33 25 16.000000 4.000000
- 33 26 16.000000 4.000000
- 33 27 13.000000 3.605551
- 33 28 10.000000 3.162278
- 33 29 12.000000 3.464102
- 33 30 13.000000 3.605551
- 33 31 17.000000 4.123106
- 33 32 8.000000 2.828427
- 33 33 .000000 .000000
- 33 34 .000000 .000000
- 33 35 .000000 .000000
- 33 36 .000000 .000000
- 33 37 .000000 .000000
- 33 38 .000000 .000000
- 33 39 .000000 .000000
- 33 40 .000000 .000000
- 33 41 .000000 .000000
- 34 0 .000000 .000000
- 34 1 .000000 .000000
- 34 2 .000000 .000000
- 34 3 .000000 .000000
- 34 4 .000000 .000000
- 34 5 .000000 .000000
- 34 6 .000000 .000000
- 34 7 .000000 .000000
- 34 8 .000000 .000000
- 34 9 .000000 .000000
- 34 10 .000000 .000000
- 34 11 .000000 .000000
- 34 12 .000000 .000000
- 34 13 .000000 .000000
- 34 14 .000000 .000000
- 34 15 .000000 .000000
- 34 16 .000000 .000000
- 34 17 10.000000 3.162278
- 34 18 11.000000 3.316625
- 34 19 9.000000 3.000000
- 34 20 4.000000 2.000000
- 34 21 5.000000 2.236068
- 34 22 11.000000 3.316625
- 34 23 3.000000 1.732051
- 34 24 7.000000 2.645751
- 34 25 9.000000 3.000000
- 34 26 5.000000 2.236068
- 34 27 9.000000 3.000000
- 34 28 4.000000 2.000000
- 34 29 7.000000 2.645751
- 34 30 12.000000 3.464102
- 34 31 10.000000 3.162278
- 34 32 6.000000 2.449490
- 34 33 .000000 .000000
- 34 34 .000000 .000000
- 34 35 .000000 .000000
- 34 36 .000000 .000000
- 34 37 .000000 .000000
- 34 38 .000000 .000000
- 34 39 .000000 .000000
- 34 40 .000000 .000000
- 34 41 .000000 .000000
- 35 0 .000000 .000000
- 35 1 .000000 .000000
- 35 2 .000000 .000000
- 35 3 .000000 .000000
- 35 4 .000000 .000000
- 35 5 .000000 .000000
- 35 6 .000000 .000000
- 35 7 .000000 .000000
- 35 8 .000000 .000000
- 35 9 .000000 .000000
- 35 10 .000000 .000000
- 35 11 .000000 .000000
- 35 12 .000000 .000000
- 35 13 .000000 .000000
- 35 14 .000000 .000000
- 35 15 .000000 .000000
- 35 16 .000000 .000000
- 35 17 6.000000 2.449490
- 35 18 7.000000 2.645751
- 35 19 6.000000 2.449490
- 35 20 4.000000 2.000000
- 35 21 8.000000 2.828427
- 35 22 7.000000 2.645751
- 35 23 9.000000 3.000000
- 35 24 9.000000 3.000000
- 35 25 8.000000 2.828427
- 35 26 5.000000 2.236068
- 35 27 8.000000 2.828427
- 35 28 7.000000 2.645751
- 35 29 10.000000 3.162278
- 35 30 7.000000 2.645751
- 35 31 4.000000 2.000000
- 35 32 5.000000 2.236068
- 35 33 .000000 .000000
- 35 34 .000000 .000000
- 35 35 .000000 .000000
- 35 36 .000000 .000000
- 35 37 .000000 .000000
- 35 38 .000000 .000000
- 35 39 .000000 .000000
- 35 40 .000000 .000000
- 35 41 .000000 .000000
- 36 0 .000000 .000000
- 36 1 .000000 .000000
- 36 2 .000000 .000000
- 36 3 .000000 .000000
- 36 4 .000000 .000000
- 36 5 .000000 .000000
- 36 6 .000000 .000000
- 36 7 .000000 .000000
- 36 8 .000000 .000000
- 36 9 .000000 .000000
- 36 10 .000000 .000000
- 36 11 .000000 .000000
- 36 12 .000000 .000000
- 36 13 .000000 .000000
- 36 14 .000000 .000000
- 36 15 .000000 .000000
- 36 16 .000000 .000000
- 36 17 7.000000 2.645751
- 36 18 2.000000 1.414214
- 36 19 3.000000 1.732051
- 36 20 5.000000 2.236068
- 36 21 3.000000 1.732051
- 36 22 .000000 .000000
- 36 23 8.000000 2.828427
- 36 24 6.000000 2.449490
- 36 25 4.000000 2.000000
- 36 26 2.000000 1.414214
- 36 27 4.000000 2.000000
- 36 28 6.000000 2.449490
- 36 29 5.000000 2.236068
- 36 30 3.000000 1.732051
- 36 31 5.000000 2.236068
- 36 32 3.000000 1.732051
- 36 33 .000000 .000000
- 36 34 .000000 .000000
- 36 35 .000000 .000000
- 36 36 .000000 .000000
- 36 37 .000000 .000000
- 36 38 .000000 .000000
- 36 39 .000000 .000000
- 36 40 .000000 .000000
- 36 41 .000000 .000000
- 37 0 .000000 .000000
- 37 1 .000000 .000000
- 37 2 .000000 .000000
- 37 3 .000000 .000000
- 37 4 .000000 .000000
- 37 5 .000000 .000000
- 37 6 .000000 .000000
- 37 7 .000000 .000000
- 37 8 .000000 .000000
- 37 9 .000000 .000000
- 37 10 .000000 .000000
- 37 11 .000000 .000000
- 37 12 .000000 .000000
- 37 13 .000000 .000000
- 37 14 .000000 .000000
- 37 15 .000000 .000000
- 37 16 .000000 .000000
- 37 17 5.000000 2.236068
- 37 18 7.000000 2.645751
- 37 19 1.000000 1.000000
- 37 20 4.000000 2.000000
- 37 21 3.000000 1.732051
- 37 22 1.000000 1.000000
- 37 23 4.000000 2.000000
- 37 24 2.000000 1.414214
- 37 25 2.000000 1.414214
- 37 26 .000000 .000000
- 37 27 2.000000 1.414214
- 37 28 1.000000 1.000000
- 37 29 6.000000 2.449490
- 37 30 4.000000 2.000000
- 37 31 3.000000 1.732051
- 37 32 4.000000 2.000000
- 37 33 .000000 .000000
- 37 34 .000000 .000000
- 37 35 .000000 .000000
- 37 36 .000000 .000000
- 37 37 .000000 .000000
- 37 38 .000000 .000000
- 37 39 .000000 .000000
- 37 40 .000000 .000000
- 37 41 .000000 .000000
- 38 0 .000000 .000000
- 38 1 .000000 .000000
- 38 2 .000000 .000000
- 38 3 .000000 .000000
- 38 4 .000000 .000000
- 38 5 .000000 .000000
- 38 6 .000000 .000000
- 38 7 .000000 .000000
- 38 8 .000000 .000000
- 38 9 .000000 .000000
- 38 10 .000000 .000000
- 38 11 .000000 .000000
- 38 12 .000000 .000000
- 38 13 .000000 .000000
- 38 14 .000000 .000000
- 38 15 .000000 .000000
- 38 16 .000000 .000000
- 38 17 2.000000 1.414214
- 38 18 1.000000 1.000000
- 38 19 .000000 .000000
- 38 20 2.000000 1.414214
- 38 21 1.000000 1.000000
- 38 22 .000000 .000000
- 38 23 3.000000 1.732051
- 38 24 2.000000 1.414214
- 38 25 2.000000 1.414214
- 38 26 2.000000 1.414214
- 38 27 2.000000 1.414214
- 38 28 1.000000 1.000000
- 38 29 3.000000 1.732051
- 38 30 2.000000 1.414214
- 38 31 1.000000 1.000000
- 38 32 .000000 .000000
- 38 33 .000000 .000000
- 38 34 .000000 .000000
- 38 35 .000000 .000000
- 38 36 .000000 .000000
- 38 37 .000000 .000000
- 38 38 .000000 .000000
- 38 39 .000000 .000000
- 38 40 .000000 .000000
- 38 41 .000000 .000000
- 39 0 .000000 .000000
- 39 1 .000000 .000000
- 39 2 .000000 .000000
- 39 3 .000000 .000000
- 39 4 .000000 .000000
- 39 5 .000000 .000000
- 39 6 .000000 .000000
- 39 7 .000000 .000000
- 39 8 .000000 .000000
- 39 9 .000000 .000000
- 39 10 .000000 .000000
- 39 11 .000000 .000000
- 39 12 .000000 .000000
- 39 13 .000000 .000000
- 39 14 .000000 .000000
- 39 15 .000000 .000000
- 39 16 .000000 .000000
- 39 17 1.000000 1.000000
- 39 18 .000000 .000000
- 39 19 2.000000 1.414214
- 39 20 2.000000 1.414214
- 39 21 2.000000 1.414214
- 39 22 2.000000 1.414214
- 39 23 .000000 .000000
- 39 24 .000000 .000000
- 39 25 3.000000 1.732051
- 39 26 2.000000 1.414214
- 39 27 3.000000 1.732051
- 39 28 .000000 .000000
- 39 29 1.000000 1.000000
- 39 30 1.000000 1.000000
- 39 31 .000000 .000000
- 39 32 1.000000 1.000000
- 39 33 .000000 .000000
- 39 34 .000000 .000000
- 39 35 .000000 .000000
- 39 36 .000000 .000000
- 39 37 .000000 .000000
- 39 38 .000000 .000000
- 39 39 .000000 .000000
- 39 40 .000000 .000000
- 39 41 .000000 .000000
- 40 0 .000000 .000000
- 40 1 .000000 .000000
- 40 2 .000000 .000000
- 40 3 .000000 .000000
- 40 4 .000000 .000000
- 40 5 .000000 .000000
- 40 6 .000000 .000000
- 40 7 .000000 .000000
- 40 8 .000000 .000000
- 40 9 .000000 .000000
- 40 10 .000000 .000000
- 40 11 .000000 .000000
- 40 12 .000000 .000000
- 40 13 .000000 .000000
- 40 14 .000000 .000000
- 40 15 .000000 .000000
- 40 16 .000000 .000000
- 40 17 1.000000 1.000000
- 40 18 1.000000 1.000000
- 40 19 .000000 .000000
- 40 20 1.000000 1.000000
- 40 21 .000000 .000000
- 40 22 .000000 .000000
- 40 23 .000000 .000000
- 40 24 2.000000 1.414214
- 40 25 .000000 .000000
- 40 26 1.000000 1.000000
- 40 27 .000000 .000000
- 40 28 .000000 .000000
- 40 29 .000000 .000000
- 40 30 .000000 .000000
- 40 31 .000000 .000000
- 40 32 1.000000 1.000000
- 40 33 .000000 .000000
- 40 34 .000000 .000000
- 40 35 .000000 .000000
- 40 36 .000000 .000000
- 40 37 .000000 .000000
- 40 38 .000000 .000000
- 40 39 .000000 .000000
- 40 40 .000000 .000000
- 40 41 .000000 .000000
- 41 0 .000000 .000000
- 41 1 .000000 .000000
- 41 2 .000000 .000000
- 41 3 .000000 .000000
- 41 4 .000000 .000000
- 41 5 .000000 .000000
- 41 6 .000000 .000000
- 41 7 .000000 .000000
- 41 8 .000000 .000000
- 41 9 .000000 .000000
- 41 10 .000000 .000000
- 41 11 .000000 .000000
- 41 12 .000000 .000000
- 41 13 .000000 .000000
- 41 14 .000000 .000000
- 41 15 .000000 .000000
- 41 16 .000000 .000000
- 41 17 1.000000 1.000000
- 41 18 .000000 .000000
- 41 19 .000000 .000000
- 41 20 4.000000 2.000000
- 41 21 1.000000 1.000000
- 41 22 .000000 .000000
- 41 23 .000000 .000000
- 41 24 .000000 .000000
- 41 25 .000000 .000000
- 41 26 .000000 .000000
- 41 27 .000000 .000000
- 41 28 .000000 .000000
- 41 29 .000000 .000000
- 41 30 .000000 .000000
- 41 31 .000000 .000000
- 41 32 .000000 .000000
- 41 33 .000000 .000000
- 41 34 .000000 .000000
- 41 35 .000000 .000000
- 41 36 .000000 .000000
- 41 37 .000000 .000000
- 41 38 .000000 .000000
- 41 39 .000000 .000000
- 41 40 .000000 .000000
- 41 41 .000000 .000000
diff --git a/src/pawlib/paw/testsuite/paw.commands/nt_pl_1d_1.ref.ps b/src/pawlib/paw/testsuite/paw.commands/nt_pl_1d_1.ref.ps
deleted file mode 100644
index 3f0d02f..0000000
--- a/src/pawlib/paw/testsuite/paw.commands/nt_pl_1d_1.ref.ps
+++ /dev/null
@@ -1,229 +0,0 @@
-%!PS-Adobe-2.0
-%%Title: /disk3/maartenb/cerncvs/paw/testsuite/tmp/nt_pl_1d_ (Portrait A 4)
-%%Pages: (atend)
-%%Creator: HIGZ Version 1.23/06
-%%CreationDate: 96/04/16 14.37
-%%EndComments
-%%BeginProlog
-/s {stroke} def /l {lineto} def /m {moveto} def /t {translate} def
-/sw {stringwidth} def /r {rotate} def /rl {roll} def /R {repeat} def
-/d {rlineto} def /rm {rmoveto} def /gr {grestore} def /f {eofill} def
-/c {setrgbcolor} def /lw {setlinewidth} def /sd {setdash} def
-/cl {closepath} def /sf {scalefont setfont} def /black {0 setgray} def
-/box {m dup 0 exch d exch 0 d 0 exch neg d cl} def
-/NC{systemdict begin initclip end}def/C{NC box clip newpath}def
-/bl {box s} def /bf {box f} def /Y { 0 exch d} def /X { 0 d} def
-/mp {newpath /y exch def /x exch def} def
-/side {[w .77 mul w .23 mul] .385 w mul sd w 0 l currentpoint t -144 r} def
-/mr {mp x y w2 0 360 arc} def /m24 {mr s} def /m20 {mr f} def
-/mb {mp x y w2 add m w2 neg 0 d 0 w neg d w 0 d 0 w d cl} def
-/mt {mp x y w2 add m w2 neg w neg d w 0 d cl} def
-/m21 {mb f} def /m25 {mb s} def /m22 {mt f} def /m26 {mt s} def
-/m23 {mp x y w2 sub m w2 w d w neg 0 d cl f} def
-/m27 {mp x y w2 add m w3 neg w2 neg d w3 w2 neg d w3 w2 d cl s} def
-/m28 {mp x w2 sub y w2 sub w3 add m w3 0 d 0 w3 neg d w3 0 d 0 w3 d w3 0 d
- 0 w3 d w3 neg 0 d 0 w3 d w3 neg 0 d
- 0 w3 neg d w3 neg 0 d cl s } def
-/m29 {mp gsave x w2 sub y w2 add w3 sub m currentpoint t
- 4 {side} repeat cl fill gr} def
-/m30 {mp gsave x w2 sub y w2 add w3 sub m currentpoint t
- 5 {side} repeat s gr} def
-/m31 {mp x y w2 sub m 0 w d x w2 sub y m w 0 d
- x w2 sub y w2 add m w w neg d x w2 sub y w2
- sub m w w d s} def
-/m2 {mp x y w2 sub m 0 w d x w2 sub y m w 0 d s} def
-/m5 {mp x w2 sub y w2 sub m w w d x w2 sub y w2 add m w w neg d s} def
-/DP {/PT exch def gsave 47.2 47.2 scale PT 1 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < AA AA 55 55 AA AA 55 55 AA AA 55 55 AA AA 55 55 AA AA 55 55 AA AA 55 55
-AA AA 55 55 AA AA 55 55 > } image } if PT 2 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < BB BB EE EE BB BB EE EE BB BB EE EE BB BB EE EE BB BB EE EE BB BB EE EE
-BB BB EE EE BB BB EE EE > } image } if PT 3 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < FF FF BB BB FF FF EE EE FF FF BB BB FF FF EE EE FF FF BB BB FF FF EE EE
-FF FF BB BB FF FF EE EE > } image } if PT 4 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < DF DF BF BF 7F 7F FE FE FD FD FB FB F7 F7 EF EF DF DF BF BF 7F 7F FE FE
-FD FD FB FB F7 F7 EF EF > } image } if PT 5 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < 7F 7F BF B F DF DF EF EF F7 F7 FB FB FD FD FE FE 7F 7F BF BF DF DF EF
-EF F7 F7 FB FB FD FD FE FE > } image } if PT 6 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB
-BB BB BB BB BB BB BB BB BB > } image } if PT 7 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < FF FF FF FF FF FF 00 00 FF FF FF FF FF FF 00 00 FF FF FF FF FF FF 00
-00 FF FF FF FF FF FF 00 00 > } image } if PT 8 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < EE EE 47 47 83 83 C5 C5 EE EE 5C 5C 38 38 74 74 EE EE 47 47 83 83 C5
-C5 EE EE 5C 5C 38 38 74 74 > } image } if PT 9 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < EF EF EF EF D7 D7 38 38 FE FE FE FE 7D 7D 83 83 EF EF EF EF D7 D7 38
-38 FE FE FE FE 7D 7D 83 83 > } image } if PT 10 eq { 16 16 1 [ 16 0 0 16 neg
-0 16 ] { < EF EF EF EF EF EF 00 00 FE FE FE FE FE FE 00 00 EF EF EF EF EF EF
-00 00 FE FE FE FE FE FE 00 00 > } image } if PT 11 eq { 16 16 1 [ 16 0 0 16
-neg 0 16 ] { < F7 F7 B6 B6 D5 D5 E3 E3 D5 D5 B6 B6 F7 F7 FF FF 7F 7F 6B 6B 5D
-5D 3E 3E 5D 5D 6B 6B 7F 7F FF FF > } image } if PT 12 eq { 16 16 1 [ 16 0 0
-16 neg 0 16 ] { < E3 E3 DD DD BE BE BE BE BE BE DD DD E3 E3 FF FF 3E 3E DD DD
-EB EB EB EB EB EB DD DD 3E 3E FF FF > } image } if PT 13 eq { 16 16 1 [ 16 0
-0 16 neg 0 16 ] { < FE FE 7D 7D BB BB D7 D7 EF EF D7 D7 BB BB 7D 7D FE FE 7D
-7D BB BB D7 D7 EF EF D7 D7 BB BB 7D 7D > } image } if PT 14 eq { 16 16 1 [ 16
-0 0 16 neg 0 16 ] { < 00 00 EE EF EE EF EE EF 0E E0 EE EE EE EE EE EE 00 EE
-FE EE FE EE FE EE 00 00 FE EF FE EF FE EF > } image } if PT 15 eq { 16 16 1 [
-16 0 0 16 neg 0 16 ] { < DD DD AA AA DD DD FF FF 77 77 AA AA 77 77 FF FF DD
-DD AA AA DD DD FF FF 77 77 AA AA 77 77 FF FF > } image } if PT 16 eq { 16 16
-1 [ 16 0 0 16 neg 0 16 ] { < F1 F1 EE EE 1F 1F FF FF F1 F1 EE EE 1F 1F FF FF
-F1 F1 EE EE 1F 1F FF FF F1 F1 EE EE 1F 1F FF FF > } image } if PT 17 eq { 16
-16 1 [ 16 0 0 16 neg 0 16 ] { < EE EE DD DD BB BB FF FF EE EE DD DD BB BB FF
- FF EE EE DD DD BB BB FF FF EE EE DD DD BB BB FF FF > } image } if PT 18 eq {
-16 16 1 [ 16 0 0 16 neg 0 16 ] { < BB BB DD DD EE EE FF FF BB BB DD DD EE EE
-FF FF BB BB DD DD EE EE FF FF BB BB DD DD EE EE FF FF > } image } if PT 19 eq
-{ 16 16 1 [ 16 0 0 16 neg 0 16 ] { < 1F FC 67 F3 7B EF BD DE BD DE DE BD E6
-B3 F8 0F E6 B3 DE BD BD DE BD DE 7B EF 67 F3 1F FC 7F FF > } image } if PT
-20 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < DD DD EE EE EE EE EE EE DD DD BB
-BB BB BB BB BB DD DD EE EE EE EE EE EE DD DD BB BB BB BB BB BB > } image }
-if PT 21 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < 0E 0E EF EF EF EF EF EF E0
-E0 FE FE FE FE FE FE 0E 0E EF EF EF EF EF EF E0 E0 FE FE FE FE FE FE > }
-image } if PT 22 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < 70 70 F7 F7 F7 F7 F7
-F7 07 07 7F 7F 7F 7F 7F 7F 70 70 F7 F7 F7 F7 F7 F7 07 07 7F 7F 7F 7F 7F 7F >
-} image } if PT 23 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < AA AA 55 55 A9 A9
-D1 D1 E1 E1 D1 D1 A9 A9 55 55 AA AA 55 55 A9 A9 D1 D1 E1 E1 D1 D1 A9 A9 55 55
-> } image } if PT 24 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < FF FE FF FC EA
-A8 D5 54 EA A8 D5 54 E8 28 D4 54 E8 E8 D4 D4 E8 EA 54 D5 A8 EA 54 D5 00 C0 00
-80 > } image } if PT 25 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < FF FE FF FC
-FF F8 FF F0 F0 00 F0 00 F0 20 F0 60 F0 E0 F1 E0 F3 E0 F0 00 E0 00 C0 00 80 00
-00 00 > } image } if gr } def /FA { /PT exch def gsave clip 0 0 translate 1 1
-54 { 1 sub 47.2 mul /Xcurr exch def 1 1 74 { 1 sub 47.2 mul /Ycurr exch def
-gsave Xcurr Ycurr translate PT DP gr } for } for gr } def
-/reencdict 24 dict def /ReEncode {reencdict begin /nco&na exch def
-/nfnam exch def /basefontname exch def /basefontdict basefontname findfont def
-/newfont basefontdict maxlength dict def basefontdict {exch dup /FID ne
-{dup /Encoding eq {exch dup length array copy newfont 3 1 roll put} {exch
-newfont 3 1 roll put} ifelse} {pop pop} ifelse } forall newfont
-/FontName nfnam put nco&na aload pop nco&na length 2 idiv {newfont
-/Encoding get 3 1 roll put} repeat nfnam newfont definefont pop end } def
-/accvec [ 176 /agrave 181 /Agrave 190 /acircumflex 192 /Acircumflex
-201 /adieresis 204 /Adieresis 209 /ccedilla 210 /Ccedilla 211 /eacute
-212 /Eacute 213 /egrave 214 /Egrave 215 /ecircumflex 216 /Ecircumflex
-217 /edieresis 218 /Edieresis 219 /icircumflex 220 /Icircumflex
-221 /idieresis 222 /Idieresis 223 /ntilde 224 /Ntilde 226 /ocircumflex
-228 /Ocircumflex 229 /odieresis 230 /Odieresis 231 /ucircumflex 236 /Ucircumflex
-237 /udieresis 238 /Udieresis 239 /aring 242 /Aring 243 /ydieresis
-244 /Ydieresis 246 /aacute 247 /Aacute 252 /ugrave 253 /Ugrave] def
-/Times-Roman /Times-Roman accvec ReEncode
-/Times-Italic /Times-Italic accvec ReEncode
-/Times-Bold /Times-Bold accvec ReEncode
-/Times-BoldItalic /Times-BoldItalic accvec ReEncode
-/Helvetica /Helvetica accvec ReEncode
-/Helvetica-Oblique /Helvetica-Oblique accvec ReEncode
-/Helvetica-Bold /Helvetica-Bold accvec ReEncode
-/Helvetica-BoldOblique /Helvetica-BoldOblique accvec ReEncode
-/Courier /Courier accvec ReEncode
-/Courier-Oblique /Courier-Oblique accvec ReEncode
-/Courier-Bold /Courier-Bold accvec ReEncode
-/Courier-BoldOblique /Courier-BoldOblique accvec ReEncode
-/oshow {gsave [] 0 sd true charpath stroke gr} def
-/stwn { /fs exch def /fn exch def /text exch def fn findfont fs sf
- text sw pop xs add /xs exch def} def
-/stwb { /fs exch def /fn exch def /nbas exch def /textf exch def
-textf length /tlen exch def nbas tlen gt {/nbas tlen def} if
-fn findfont fs sf textf dup length nbas sub nbas getinterval sw
-pop neg xs add /xs exch def} def
-/accspe [ 65 /plusminus 66 /bar 67 /existential 68 /universal
-69 /exclam 70 /numbersign 71 /greater 72 /question 73 /integral
-74 /colon 75 /semicolon 76 /less 77 /bracketleft 78 /bracketright
-79 /greaterequal 80 /braceleft 81 /braceright 82 /radical
-83 /spade 84 /heart 85 /diamond 86 /club 87 /lessequal
-88 /multiply 89 /percent 90 /infinity 48 /circlemultiply 49 /circleplus
-50 /emptyset 51 /lozenge 52 /bullet 53 /arrowright 54 /arrowup
-55 /arrowleft 56 /arrowdown 57 /arrowboth 48 /degree 44 /comma 43 /plus
- 45 /angle 42 /angleleft 47 /divide 61 /notequal 40 /equivalence 41 /second
- 97 /approxequal 98 /congruent 99 /perpendicular 100 /partialdiff 101 /florin
- 102 /intersection 103 /union 104 /propersuperset 105 /reflexsuperset
- 106 /notsubset 107 /propersubset 108 /reflexsubset 109 /element 110 /notelement
- 111 /gradient 112 /logicaland 113 /logicalor 114 /arrowdblboth
- 115 /arrowdblleft 116 /arrowdblup 117 /arrowdblright 118 /arrowdbldown
- 119 /ampersand 120 /omega1 121 /similar 122 /aleph ] def
-/Symbol /Special accspe ReEncode
-/Zone {/iy exch def /ix exch def ix 1 sub 2224 mul 1 iy sub 3144
- mul t} def
-%%EndProlog
- gsave 20 28 t .25 .25 scale gsave
-%%Page: number 1
- gsave
- 1 1 Zone
- gsave 0 0 t black [] 0 sd 1 lw 2223 2224 0 460 bl 2223 2224 0 460 C NC 1779
- 1778 222 683 bl 1779 1778 222 683 C 2223 2224 0 460 C 1080 549 m 16 X -9 -11 d
- 5 X 2 -2 d 2 -1 d 1 -5 d -3 Y -1 -4 d -3 -3 d -4 -2 d -5 X -4 2 d -2 1 d -1 3 d
- s 1114 541 m -18 Y s 1106 536 m 15 -9 d s 1121 536 m -15 -9 d s 1130 539 m 16
- -21 d s 1146 539 m -16 -21 d s 1779 1778 222 683 C 222 683 m 223 X 1363 Y 22 X
- 145 Y 22 X -113 Y 22 X -60 Y 23 X 60 Y 22 X 24 Y 22 X -44 Y 22 X 20 Y 22 X 93 Y
- 23 X -53 Y 22 X 5 Y 22 X 20 Y 22 X -53 Y 23 X 20 Y 22 X 101 Y 22 X -97 Y 22 X
- -92 Y 23 X 149 Y 22 X -40 Y 22 X -21 Y 22 X -44 Y 22 X 57 Y 23 X -73 Y 22 X 117
- Y 22 X -121 Y 22 X -44 Y 23 X 56 Y 22 X -24 Y 22 X 89 Y 22 X -25 Y 45 X -8 Y 22
- X 61 Y 22 X -137 Y 22 X 64 Y 23 X -68 Y 22 X -24 Y 22 X 217 Y 22 X -101 Y 23 X
- -136 Y 22 X 157 Y 22 X -77 Y 22 X -20 Y 23 X 32 Y 22 X 4 Y 22 X 105 Y 22 X 8 Y
- 22 X -20 Y 23 X -133 Y 22 X 20 Y 22 X 44 Y 22 X 85 Y 23 X -225 Y 22 X 128 Y 22
- X 8 Y 22 X -52 Y 22 X 253 Y 23 X -333 Y 22 X 140 Y 22 X 113 Y 22 X -1520 Y 223
- X s NC 222 683 m 1778 Y s 256 683 m -34 X s 239 723 m -17 X s 239 763 m -17 X s
- 239 803 m -17 X s 239 844 m -17 X s 256 884 m -34 X s 239 924 m -17 X s 239 964
- m -17 X s 239 1005 m -17 X s 239 1045 m -17 X s 256 1085 m -34 X s 239 1125 m
- -17 X s 239 1165 m -17 X s 239 1206 m -17 X s 239 1246 m -17 X s 256 1286 m -34
- X s 239 1326 m -17 X s 239 1366 m -17 X s 239 1407 m -17 X s 239 1447 m -17 X s
- 256 1487 m -34 X s 239 1527 m -17 X s 239 1568 m -17 X s 239 1608 m -17 X s 239
- 1648 m -17 X s 256 1688 m -34 X s 239 1728 m -17 X s 239 1769 m -17 X s 239
- 1809 m -17 X s 239 1849 m -17 X s 256 1889 m -34 X s 239 1929 m -17 X s 239
- 1970 m -17 X s 239 2010 m -17 X s 239 2050 m -17 X s 256 2090 m -34 X s 239
- 2131 m -17 X s 239 2171 m -17 X s 239 2211 m -17 X s 239 2251 m -17 X s 256
- 2291 m -34 X s 256 2291 m -34 X s 239 2332 m -17 X s 239 2372 m -17 X s 239
- 2412 m -17 X s 239 2452 m -17 X s 162 698 m -5 -1 d -3 -5 d -1 -7 d -4 Y 1 -8 d
- 3 -4 d 5 -2 d 3 X 4 2 d 3 4 d 1 8 d 4 Y -1 7 d -3 5 d -4 1 d -3 X cl s 141 899
- m -15 X -2 -13 d 2 2 d 4 1 d 5 X 4 -1 d 3 -3 d 2 -5 d -3 Y -2 -4 d -3 -3 d -4
- -2 d -5 X -4 2 d -2 1 d -1 3 d s 162 899 m -5 -1 d -3 -4 d -1 -8 d -4 Y 1 -8 d
- 3 -4 d 5 -2 d 3 X 4 2 d 3 4 d 1 8 d 4 Y -1 8 d -3 4 d -4 1 d -3 X cl s 98 1095
- m 3 1 d 4 5 d -32 Y s 132 1101 m -5 -2 d -3 -4 d -1 -8 d -4 Y 1 -8 d 3 -4 d 5
- -2 d 3 X 4 2 d 3 4 d 2 8 d 4 Y -2 8 d -3 4 d -4 2 d -3 X cl s 162 1101 m -5 -2
- d -3 -4 d -1 -8 d -4 Y 1 -8 d 3 -4 d 5 -2 d 3 X 4 2 d 3 4 d 1 8 d 4 Y -1 8 d -3
- 4 d -4 2 d -3 X cl s 98 1296 m 3 1 d 4 5 d -32 Y s 141 1302 m -15 X -2 -14 d 2
- 2 d 4 1 d 5 X 4 -1 d 3 -3 d 2 -5 d -3 Y -2 -4 d -3 -3 d -4 -2 d -5 X -4 2 d -2
- 1 d -1 3 d s 162 1302 m -5 -2 d -3 -4 d -1 -8 d -4 Y 1 -8 d 3 -4 d 5 -2 d 3 X 4
- 2 d 3 4 d 1 8 d 4 Y -1 8 d -3 4 d -4 2 d -3 X cl s 95 1495 m 2 Y 1 3 d 2 1 d 3
- 2 d 6 X 3 -2 d 1 -1 d 2 -3 d -3 Y -2 -3 d -3 -5 d -15 -14 d 21 X s 132 1503 m
- -5 -2 d -3 -4 d -1 -8 d -4 Y 1 -8 d 3 -4 d 5 -1 d 3 X 4 1 d 3 4 d 2 8 d 4 Y -2
- 8 d -3 4 d -4 2 d -3 X cl s 162 1503 m -5 -2 d -3 -4 d -1 -8 d -4 Y 1 -8 d 3 -4
- d 5 -1 d 3 X 4 1 d 3 4 d 1 8 d 4 Y -1 8 d -3 4 d -4 2 d -3 X cl s 95 1696 m 2 Y
- 1 3 d 2 1 d 3 2 d 6 X 3 -2 d 1 -1 d 2 -3 d -3 Y -2 -3 d -3 -5 d -15 -14 d 21 X
- s 141 1704 m -15 X -2 -14 d 2 2 d 4 1 d 5 X 4 -1 d 3 -3 d 2 -5 d -2 Y -2 -5 d
- -3 -3 d -4 -1 d -5 X -4 1 d -2 2 d -1 3 d s 162 1704 m -5 -2 d -3 -4 d -1 -8 d
- -4 Y 1 -7 d 3 -5 d 5 -1 d 3 X 4 1 d 3 5 d 1 7 d 4 Y -1 8 d -3 4 d -4 2 d -3 X
- cl s 96 1905 m 17 X -9 -12 d 4 X 3 -2 d 2 -1 d 1 -4 d -3 Y -1 -5 d -3 -3 d -5
- -1 d -4 X -5 1 d -1 2 d -2 3 d s 132 1905 m -5 -2 d -3 -4 d -1 -8 d -4 Y 1 -7 d
- 3 -5 d 5 -1 d 3 X 4 1 d 3 5 d 2 7 d 4 Y -2 8 d -3 4 d -4 2 d -3 X cl s 162 1905
- m -5 -2 d -3 -4 d -1 -8 d -4 Y 1 -7 d 3 -5 d 5 -1 d 3 X 4 1 d 3 5 d 1 7 d 4 Y
- -1 8 d -3 4 d -4 2 d -3 X cl s 96 2106 m 17 X -9 -12 d 4 X 3 -1 d 2 -2 d 1 -4 d
- -3 Y -1 -5 d -3 -3 d -5 -1 d -4 X -5 1 d -1 2 d -2 3 d s 141 2106 m -15 X -2
- -13 d 2 1 d 4 2 d 5 X 4 -2 d 3 -3 d 2 -4 d -3 Y -2 -5 d -3 -3 d -4 -1 d -5 X -4
- 1 d -2 2 d -1 3 d s 162 2106 m -5 -2 d -3 -4 d -1 -7 d -5 Y 1 -7 d 3 -5 d 5 -1
- d 3 X 4 1 d 3 5 d 1 7 d 5 Y -1 7 d -3 4 d -4 2 d -3 X cl s 108 2307 m -15 -21 d
- 23 X s 108 2307 m -31 Y s 132 2307 m -5 -2 d -3 -4 d -1 -7 d -5 Y 1 -7 d 3 -5 d
- 5 -1 d 3 X 4 1 d 3 5 d 2 7 d 5 Y -2 7 d -3 4 d -4 2 d -3 X cl s 162 2307 m -5
- -2 d -3 -4 d -1 -7 d -5 Y 1 -7 d 3 -5 d 5 -1 d 3 X 4 1 d 3 5 d 1 7 d 5 Y -1 7 d
- -3 4 d -4 2 d -3 X cl s 222 683 m 1779 X s 222 716 m -33 Y s 267 699 m -16 Y s
- 311 699 m -16 Y s 356 699 m -16 Y s 400 699 m -16 Y s 445 716 m -33 Y s 489 699
- m -16 Y s 534 699 m -16 Y s 578 699 m -16 Y s 622 699 m -16 Y s 667 716 m -33 Y
- s 711 699 m -16 Y s 756 699 m -16 Y s 800 699 m -16 Y s 845 699 m -16 Y s 889
- 716 m -33 Y s 934 699 m -16 Y s 978 699 m -16 Y s 1023 699 m -16 Y s 1067 699 m
- -16 Y s 1112 716 m -33 Y s 1156 699 m -16 Y s 1200 699 m -16 Y s 1245 699 m -16
- Y s 1289 699 m -16 Y s 1334 716 m -33 Y s 1378 699 m -16 Y s 1423 699 m -16 Y s
- 1467 699 m -16 Y s 1512 699 m -16 Y s 1556 716 m -33 Y s 1601 699 m -16 Y s
- 1645 699 m -16 Y s 1689 699 m -16 Y s 1734 699 m -16 Y s 1778 716 m -33 Y s
- 1823 699 m -16 Y s 1867 699 m -16 Y s 1912 699 m -16 Y s 1956 699 m -16 Y s
- 2001 716 m -33 Y s 194 643 m 27 X s 236 655 m 3 1 d 4 5 d -32 Y s 443 661 m -4
- -2 d -3 -4 d -2 -8 d -4 Y 2 -8 d 3 -4 d 4 -2 d 3 X 5 2 d 2 4 d 2 8 d 4 Y -2 8 d
- -2 4 d -5 2 d -3 X cl s 661 655 m 3 1 d 4 5 d -32 Y s 880 653 m 2 Y 2 3 d 1 1 d
- 3 2 d 6 X 3 -2 d 2 -1 d 1 -3 d -3 Y -1 -3 d -3 -5 d -15 -15 d 21 X s 1104 661 m
- 16 X -8 -12 d 4 X 3 -2 d 1 -1 d 2 -5 d -3 Y -2 -4 d -3 -3 d -4 -2 d -4 X -5 2 d
- -1 1 d -2 3 d s 1338 661 m -15 -21 d 23 X s 1338 661 m -32 Y s 1564 661 m -15 X
- -2 -14 d 2 2 d 4 1 d 5 X 4 -1 d 3 -3 d 1 -5 d -3 Y -1 -4 d -3 -3 d -4 -2 d -5 X
- -4 2 d -2 1 d -1 3 d s 1787 656 m -1 3 d -5 2 d -3 X -4 -2 d -3 -4 d -1 -8 d -7
- Y 1 -6 d 3 -3 d 4 -2 d 2 X 4 2 d 3 3 d 2 4 d 2 Y -2 4 d -3 3 d -4 2 d -2 X -4
- -2 d -3 -3 d -1 -4 d s 2011 661 m -15 -32 d s 1990 661 m 21 X s 1779 1778 222
- 683 C gr
-showpage
- gr
-%%Trailer
-%%Pages: 1
- gr gr
-%%EOF
diff --git a/src/pawlib/paw/testsuite/paw.commands/nt_pl_1d_2.ref.ps b/src/pawlib/paw/testsuite/paw.commands/nt_pl_1d_2.ref.ps
deleted file mode 100644
index c345de9..0000000
--- a/src/pawlib/paw/testsuite/paw.commands/nt_pl_1d_2.ref.ps
+++ /dev/null
@@ -1,221 +0,0 @@
-%!PS-Adobe-2.0
-%%Title: /disk3/maartenb/cerncvs/paw/testsuite/tmp/nt_pl_1d_ (Portrait A 4)
-%%Pages: (atend)
-%%Creator: HIGZ Version 1.23/06
-%%CreationDate: 96/04/16 14.37
-%%EndComments
-%%BeginProlog
-/s {stroke} def /l {lineto} def /m {moveto} def /t {translate} def
-/sw {stringwidth} def /r {rotate} def /rl {roll} def /R {repeat} def
-/d {rlineto} def /rm {rmoveto} def /gr {grestore} def /f {eofill} def
-/c {setrgbcolor} def /lw {setlinewidth} def /sd {setdash} def
-/cl {closepath} def /sf {scalefont setfont} def /black {0 setgray} def
-/box {m dup 0 exch d exch 0 d 0 exch neg d cl} def
-/NC{systemdict begin initclip end}def/C{NC box clip newpath}def
-/bl {box s} def /bf {box f} def /Y { 0 exch d} def /X { 0 d} def
-/mp {newpath /y exch def /x exch def} def
-/side {[w .77 mul w .23 mul] .385 w mul sd w 0 l currentpoint t -144 r} def
-/mr {mp x y w2 0 360 arc} def /m24 {mr s} def /m20 {mr f} def
-/mb {mp x y w2 add m w2 neg 0 d 0 w neg d w 0 d 0 w d cl} def
-/mt {mp x y w2 add m w2 neg w neg d w 0 d cl} def
-/m21 {mb f} def /m25 {mb s} def /m22 {mt f} def /m26 {mt s} def
-/m23 {mp x y w2 sub m w2 w d w neg 0 d cl f} def
-/m27 {mp x y w2 add m w3 neg w2 neg d w3 w2 neg d w3 w2 d cl s} def
-/m28 {mp x w2 sub y w2 sub w3 add m w3 0 d 0 w3 neg d w3 0 d 0 w3 d w3 0 d
- 0 w3 d w3 neg 0 d 0 w3 d w3 neg 0 d
- 0 w3 neg d w3 neg 0 d cl s } def
-/m29 {mp gsave x w2 sub y w2 add w3 sub m currentpoint t
- 4 {side} repeat cl fill gr} def
-/m30 {mp gsave x w2 sub y w2 add w3 sub m currentpoint t
- 5 {side} repeat s gr} def
-/m31 {mp x y w2 sub m 0 w d x w2 sub y m w 0 d
- x w2 sub y w2 add m w w neg d x w2 sub y w2
- sub m w w d s} def
-/m2 {mp x y w2 sub m 0 w d x w2 sub y m w 0 d s} def
-/m5 {mp x w2 sub y w2 sub m w w d x w2 sub y w2 add m w w neg d s} def
-/DP {/PT exch def gsave 47.2 47.2 scale PT 1 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < AA AA 55 55 AA AA 55 55 AA AA 55 55 AA AA 55 55 AA AA 55 55 AA AA 55 55
-AA AA 55 55 AA AA 55 55 > } image } if PT 2 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < BB BB EE EE BB BB EE EE BB BB EE EE BB BB EE EE BB BB EE EE BB BB EE EE
-BB BB EE EE BB BB EE EE > } image } if PT 3 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < FF FF BB BB FF FF EE EE FF FF BB BB FF FF EE EE FF FF BB BB FF FF EE EE
-FF FF BB BB FF FF EE EE > } image } if PT 4 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < DF DF BF BF 7F 7F FE FE FD FD FB FB F7 F7 EF EF DF DF BF BF 7F 7F FE FE
-FD FD FB FB F7 F7 EF EF > } image } if PT 5 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < 7F 7F BF B F DF DF EF EF F7 F7 FB FB FD FD FE FE 7F 7F BF BF DF DF EF
-EF F7 F7 FB FB FD FD FE FE > } image } if PT 6 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB
-BB BB BB BB BB BB BB BB BB > } image } if PT 7 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < FF FF FF FF FF FF 00 00 FF FF FF FF FF FF 00 00 FF FF FF FF FF FF 00
-00 FF FF FF FF FF FF 00 00 > } image } if PT 8 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < EE EE 47 47 83 83 C5 C5 EE EE 5C 5C 38 38 74 74 EE EE 47 47 83 83 C5
-C5 EE EE 5C 5C 38 38 74 74 > } image } if PT 9 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < EF EF EF EF D7 D7 38 38 FE FE FE FE 7D 7D 83 83 EF EF EF EF D7 D7 38
-38 FE FE FE FE 7D 7D 83 83 > } image } if PT 10 eq { 16 16 1 [ 16 0 0 16 neg
-0 16 ] { < EF EF EF EF EF EF 00 00 FE FE FE FE FE FE 00 00 EF EF EF EF EF EF
-00 00 FE FE FE FE FE FE 00 00 > } image } if PT 11 eq { 16 16 1 [ 16 0 0 16
-neg 0 16 ] { < F7 F7 B6 B6 D5 D5 E3 E3 D5 D5 B6 B6 F7 F7 FF FF 7F 7F 6B 6B 5D
-5D 3E 3E 5D 5D 6B 6B 7F 7F FF FF > } image } if PT 12 eq { 16 16 1 [ 16 0 0
-16 neg 0 16 ] { < E3 E3 DD DD BE BE BE BE BE BE DD DD E3 E3 FF FF 3E 3E DD DD
-EB EB EB EB EB EB DD DD 3E 3E FF FF > } image } if PT 13 eq { 16 16 1 [ 16 0
-0 16 neg 0 16 ] { < FE FE 7D 7D BB BB D7 D7 EF EF D7 D7 BB BB 7D 7D FE FE 7D
-7D BB BB D7 D7 EF EF D7 D7 BB BB 7D 7D > } image } if PT 14 eq { 16 16 1 [ 16
-0 0 16 neg 0 16 ] { < 00 00 EE EF EE EF EE EF 0E E0 EE EE EE EE EE EE 00 EE
-FE EE FE EE FE EE 00 00 FE EF FE EF FE EF > } image } if PT 15 eq { 16 16 1 [
-16 0 0 16 neg 0 16 ] { < DD DD AA AA DD DD FF FF 77 77 AA AA 77 77 FF FF DD
-DD AA AA DD DD FF FF 77 77 AA AA 77 77 FF FF > } image } if PT 16 eq { 16 16
-1 [ 16 0 0 16 neg 0 16 ] { < F1 F1 EE EE 1F 1F FF FF F1 F1 EE EE 1F 1F FF FF
-F1 F1 EE EE 1F 1F FF FF F1 F1 EE EE 1F 1F FF FF > } image } if PT 17 eq { 16
-16 1 [ 16 0 0 16 neg 0 16 ] { < EE EE DD DD BB BB FF FF EE EE DD DD BB BB FF
- FF EE EE DD DD BB BB FF FF EE EE DD DD BB BB FF FF > } image } if PT 18 eq {
-16 16 1 [ 16 0 0 16 neg 0 16 ] { < BB BB DD DD EE EE FF FF BB BB DD DD EE EE
-FF FF BB BB DD DD EE EE FF FF BB BB DD DD EE EE FF FF > } image } if PT 19 eq
-{ 16 16 1 [ 16 0 0 16 neg 0 16 ] { < 1F FC 67 F3 7B EF BD DE BD DE DE BD E6
-B3 F8 0F E6 B3 DE BD BD DE BD DE 7B EF 67 F3 1F FC 7F FF > } image } if PT
-20 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < DD DD EE EE EE EE EE EE DD DD BB
-BB BB BB BB BB DD DD EE EE EE EE EE EE DD DD BB BB BB BB BB BB > } image }
-if PT 21 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < 0E 0E EF EF EF EF EF EF E0
-E0 FE FE FE FE FE FE 0E 0E EF EF EF EF EF EF E0 E0 FE FE FE FE FE FE > }
-image } if PT 22 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < 70 70 F7 F7 F7 F7 F7
-F7 07 07 7F 7F 7F 7F 7F 7F 70 70 F7 F7 F7 F7 F7 F7 07 07 7F 7F 7F 7F 7F 7F >
-} image } if PT 23 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < AA AA 55 55 A9 A9
-D1 D1 E1 E1 D1 D1 A9 A9 55 55 AA AA 55 55 A9 A9 D1 D1 E1 E1 D1 D1 A9 A9 55 55
-> } image } if PT 24 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < FF FE FF FC EA
-A8 D5 54 EA A8 D5 54 E8 28 D4 54 E8 E8 D4 D4 E8 EA 54 D5 A8 EA 54 D5 00 C0 00
-80 > } image } if PT 25 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < FF FE FF FC
-FF F8 FF F0 F0 00 F0 00 F0 20 F0 60 F0 E0 F1 E0 F3 E0 F0 00 E0 00 C0 00 80 00
-00 00 > } image } if gr } def /FA { /PT exch def gsave clip 0 0 translate 1 1
-54 { 1 sub 47.2 mul /Xcurr exch def 1 1 74 { 1 sub 47.2 mul /Ycurr exch def
-gsave Xcurr Ycurr translate PT DP gr } for } for gr } def
-/reencdict 24 dict def /ReEncode {reencdict begin /nco&na exch def
-/nfnam exch def /basefontname exch def /basefontdict basefontname findfont def
-/newfont basefontdict maxlength dict def basefontdict {exch dup /FID ne
-{dup /Encoding eq {exch dup length array copy newfont 3 1 roll put} {exch
-newfont 3 1 roll put} ifelse} {pop pop} ifelse } forall newfont
-/FontName nfnam put nco&na aload pop nco&na length 2 idiv {newfont
-/Encoding get 3 1 roll put} repeat nfnam newfont definefont pop end } def
-/accvec [ 176 /agrave 181 /Agrave 190 /acircumflex 192 /Acircumflex
-201 /adieresis 204 /Adieresis 209 /ccedilla 210 /Ccedilla 211 /eacute
-212 /Eacute 213 /egrave 214 /Egrave 215 /ecircumflex 216 /Ecircumflex
-217 /edieresis 218 /Edieresis 219 /icircumflex 220 /Icircumflex
-221 /idieresis 222 /Idieresis 223 /ntilde 224 /Ntilde 226 /ocircumflex
-228 /Ocircumflex 229 /odieresis 230 /Odieresis 231 /ucircumflex 236 /Ucircumflex
-237 /udieresis 238 /Udieresis 239 /aring 242 /Aring 243 /ydieresis
-244 /Ydieresis 246 /aacute 247 /Aacute 252 /ugrave 253 /Ugrave] def
-/Times-Roman /Times-Roman accvec ReEncode
-/Times-Italic /Times-Italic accvec ReEncode
-/Times-Bold /Times-Bold accvec ReEncode
-/Times-BoldItalic /Times-BoldItalic accvec ReEncode
-/Helvetica /Helvetica accvec ReEncode
-/Helvetica-Oblique /Helvetica-Oblique accvec ReEncode
-/Helvetica-Bold /Helvetica-Bold accvec ReEncode
-/Helvetica-BoldOblique /Helvetica-BoldOblique accvec ReEncode
-/Courier /Courier accvec ReEncode
-/Courier-Oblique /Courier-Oblique accvec ReEncode
-/Courier-Bold /Courier-Bold accvec ReEncode
-/Courier-BoldOblique /Courier-BoldOblique accvec ReEncode
-/oshow {gsave [] 0 sd true charpath stroke gr} def
-/stwn { /fs exch def /fn exch def /text exch def fn findfont fs sf
- text sw pop xs add /xs exch def} def
-/stwb { /fs exch def /fn exch def /nbas exch def /textf exch def
-textf length /tlen exch def nbas tlen gt {/nbas tlen def} if
-fn findfont fs sf textf dup length nbas sub nbas getinterval sw
-pop neg xs add /xs exch def} def
-/accspe [ 65 /plusminus 66 /bar 67 /existential 68 /universal
-69 /exclam 70 /numbersign 71 /greater 72 /question 73 /integral
-74 /colon 75 /semicolon 76 /less 77 /bracketleft 78 /bracketright
-79 /greaterequal 80 /braceleft 81 /braceright 82 /radical
-83 /spade 84 /heart 85 /diamond 86 /club 87 /lessequal
-88 /multiply 89 /percent 90 /infinity 48 /circlemultiply 49 /circleplus
-50 /emptyset 51 /lozenge 52 /bullet 53 /arrowright 54 /arrowup
-55 /arrowleft 56 /arrowdown 57 /arrowboth 48 /degree 44 /comma 43 /plus
- 45 /angle 42 /angleleft 47 /divide 61 /notequal 40 /equivalence 41 /second
- 97 /approxequal 98 /congruent 99 /perpendicular 100 /partialdiff 101 /florin
- 102 /intersection 103 /union 104 /propersuperset 105 /reflexsuperset
- 106 /notsubset 107 /propersubset 108 /reflexsubset 109 /element 110 /notelement
- 111 /gradient 112 /logicaland 113 /logicalor 114 /arrowdblboth
- 115 /arrowdblleft 116 /arrowdblup 117 /arrowdblright 118 /arrowdbldown
- 119 /ampersand 120 /omega1 121 /similar 122 /aleph ] def
-/Symbol /Special accspe ReEncode
-/Zone {/iy exch def /ix exch def ix 1 sub 2224 mul 1 iy sub 3144
- mul t} def
-%%EndProlog
- gsave 20 28 t .25 .25 scale gsave
-%%Page: number 1
- gsave
- 1 1 Zone
- gsave 0 0 t black [] 0 sd 1 lw 2223 2224 0 460 bl 2223 2224 0 460 C NC 1779
- 1778 222 683 bl 2223 2224 0 460 C 1080 549 m 16 X -9 -11 d 5 X 2 -2 d 2 -1 d 1
- -5 d -3 Y -1 -4 d -3 -3 d -4 -2 d -5 X -4 2 d -2 1 d -1 3 d s 1114 541 m -18 Y
- s 1106 536 m 15 -9 d s 1121 536 m -15 -9 d s 1130 539 m 16 -21 d s 1146 539 m
- -16 -21 d s 1779 1778 222 683 C 222 683 m 1228 X 1363 Y 25 X 145 Y 23 X -113 Y
- 21 X -60 Y 20 X 60 Y 18 X 24 Y 17 X -44 Y 16 X 20 Y 15 X 93 Y 14 X -53 Y 14 X 5
- Y 13 X 20 Y 12 X -53 Y 12 X 20 Y 11 X 101 Y 11 X -97 Y 10 X -92 Y 10 X 149 Y 10
- X -40 Y 9 X -21 Y 9 X -44 Y 9 X 57 Y 8 X -73 Y 9 X 117 Y 8 X -121 Y 7 X -44 Y 8
- X 56 Y 7 X -24 Y 7 X 89 Y 7 X -25 Y 13 X -8 Y 7 X 61 Y 6 X -137 Y 6 X 64 Y 6 X
- -68 Y 6 X -24 Y 5 X 217 Y 6 X -101 Y 6 X -136 Y 5 X 157 Y 5 X -77 Y 5 X -20 Y 5
- X 32 Y 5 X 4 Y 5 X 105 Y 5 X 8 Y 5 X -20 Y 4 X -133 Y 5 X 20 Y 4 X 44 Y 5 X 85
- Y 4 X -225 Y 4 X 128 Y 4 X 8 Y 5 X -52 Y 4 X 253 Y 4 X -333 Y 4 X 140 Y 3 X 113
- Y 4 X -1520 Y 36 X s NC 222 683 m 1778 Y s 256 683 m -34 X s 239 723 m -17 X s
- 239 763 m -17 X s 239 803 m -17 X s 239 844 m -17 X s 256 884 m -34 X s 239 924
- m -17 X s 239 964 m -17 X s 239 1005 m -17 X s 239 1045 m -17 X s 256 1085 m
- -34 X s 239 1125 m -17 X s 239 1165 m -17 X s 239 1206 m -17 X s 239 1246 m -17
- X s 256 1286 m -34 X s 239 1326 m -17 X s 239 1366 m -17 X s 239 1407 m -17 X s
- 239 1447 m -17 X s 256 1487 m -34 X s 239 1527 m -17 X s 239 1568 m -17 X s 239
- 1608 m -17 X s 239 1648 m -17 X s 256 1688 m -34 X s 239 1728 m -17 X s 239
- 1769 m -17 X s 239 1809 m -17 X s 239 1849 m -17 X s 256 1889 m -34 X s 239
- 1929 m -17 X s 239 1970 m -17 X s 239 2010 m -17 X s 239 2050 m -17 X s 256
- 2090 m -34 X s 239 2131 m -17 X s 239 2171 m -17 X s 239 2211 m -17 X s 239
- 2251 m -17 X s 256 2291 m -34 X s 256 2291 m -34 X s 239 2332 m -17 X s 239
- 2372 m -17 X s 239 2412 m -17 X s 239 2452 m -17 X s 162 698 m -5 -1 d -3 -5 d
- -1 -7 d -4 Y 1 -8 d 3 -4 d 5 -2 d 3 X 4 2 d 3 4 d 1 8 d 4 Y -1 7 d -3 5 d -4 1
- d -3 X cl s 141 899 m -15 X -2 -13 d 2 2 d 4 1 d 5 X 4 -1 d 3 -3 d 2 -5 d -3 Y
- -2 -4 d -3 -3 d -4 -2 d -5 X -4 2 d -2 1 d -1 3 d s 162 899 m -5 -1 d -3 -4 d
- -1 -8 d -4 Y 1 -8 d 3 -4 d 5 -2 d 3 X 4 2 d 3 4 d 1 8 d 4 Y -1 8 d -3 4 d -4 1
- d -3 X cl s 98 1095 m 3 1 d 4 5 d -32 Y s 132 1101 m -5 -2 d -3 -4 d -1 -8 d -4
- Y 1 -8 d 3 -4 d 5 -2 d 3 X 4 2 d 3 4 d 2 8 d 4 Y -2 8 d -3 4 d -4 2 d -3 X cl s
- 162 1101 m -5 -2 d -3 -4 d -1 -8 d -4 Y 1 -8 d 3 -4 d 5 -2 d 3 X 4 2 d 3 4 d 1
- 8 d 4 Y -1 8 d -3 4 d -4 2 d -3 X cl s 98 1296 m 3 1 d 4 5 d -32 Y s 141 1302 m
- -15 X -2 -14 d 2 2 d 4 1 d 5 X 4 -1 d 3 -3 d 2 -5 d -3 Y -2 -4 d -3 -3 d -4 -2
- d -5 X -4 2 d -2 1 d -1 3 d s 162 1302 m -5 -2 d -3 -4 d -1 -8 d -4 Y 1 -8 d 3
- -4 d 5 -2 d 3 X 4 2 d 3 4 d 1 8 d 4 Y -1 8 d -3 4 d -4 2 d -3 X cl s 95 1495 m
- 2 Y 1 3 d 2 1 d 3 2 d 6 X 3 -2 d 1 -1 d 2 -3 d -3 Y -2 -3 d -3 -5 d -15 -14 d
- 21 X s 132 1503 m -5 -2 d -3 -4 d -1 -8 d -4 Y 1 -8 d 3 -4 d 5 -1 d 3 X 4 1 d 3
- 4 d 2 8 d 4 Y -2 8 d -3 4 d -4 2 d -3 X cl s 162 1503 m -5 -2 d -3 -4 d -1 -8 d
- -4 Y 1 -8 d 3 -4 d 5 -1 d 3 X 4 1 d 3 4 d 1 8 d 4 Y -1 8 d -3 4 d -4 2 d -3 X
- cl s 95 1696 m 2 Y 1 3 d 2 1 d 3 2 d 6 X 3 -2 d 1 -1 d 2 -3 d -3 Y -2 -3 d -3
- -5 d -15 -14 d 21 X s 141 1704 m -15 X -2 -14 d 2 2 d 4 1 d 5 X 4 -1 d 3 -3 d 2
- -5 d -2 Y -2 -5 d -3 -3 d -4 -1 d -5 X -4 1 d -2 2 d -1 3 d s 162 1704 m -5 -2
- d -3 -4 d -1 -8 d -4 Y 1 -7 d 3 -5 d 5 -1 d 3 X 4 1 d 3 5 d 1 7 d 4 Y -1 8 d -3
- 4 d -4 2 d -3 X cl s 96 1905 m 17 X -9 -12 d 4 X 3 -2 d 2 -1 d 1 -4 d -3 Y -1
- -5 d -3 -3 d -5 -1 d -4 X -5 1 d -1 2 d -2 3 d s 132 1905 m -5 -2 d -3 -4 d -1
- -8 d -4 Y 1 -7 d 3 -5 d 5 -1 d 3 X 4 1 d 3 5 d 2 7 d 4 Y -2 8 d -3 4 d -4 2 d
- -3 X cl s 162 1905 m -5 -2 d -3 -4 d -1 -8 d -4 Y 1 -7 d 3 -5 d 5 -1 d 3 X 4 1
- d 3 5 d 1 7 d 4 Y -1 8 d -3 4 d -4 2 d -3 X cl s 96 2106 m 17 X -9 -12 d 4 X 3
- -1 d 2 -2 d 1 -4 d -3 Y -1 -5 d -3 -3 d -5 -1 d -4 X -5 1 d -1 2 d -2 3 d s 141
- 2106 m -15 X -2 -13 d 2 1 d 4 2 d 5 X 4 -2 d 3 -3 d 2 -4 d -3 Y -2 -5 d -3 -3 d
- -4 -1 d -5 X -4 1 d -2 2 d -1 3 d s 162 2106 m -5 -2 d -3 -4 d -1 -7 d -5 Y 1
- -7 d 3 -5 d 5 -1 d 3 X 4 1 d 3 5 d 1 7 d 5 Y -1 7 d -3 4 d -4 2 d -3 X cl s 108
- 2307 m -15 -21 d 23 X s 108 2307 m -31 Y s 132 2307 m -5 -2 d -3 -4 d -1 -7 d
- -5 Y 1 -7 d 3 -5 d 5 -1 d 3 X 4 1 d 3 5 d 2 7 d 5 Y -2 7 d -3 4 d -4 2 d -3 X
- cl s 162 2307 m -5 -2 d -3 -4 d -1 -7 d -5 Y 1 -7 d 3 -5 d 5 -1 d 3 X 4 1 d 3 5
- d 1 7 d 5 Y -1 7 d -3 4 d -4 2 d -3 X cl s 222 683 m 1779 X s 222 716 m -33 Y s
- 186 634 m 3 2 d 4 4 d -31 Y s 220 640 m -4 -1 d -3 -5 d -2 -7 d -4 Y 2 -8 d 3
- -4 d 4 -2 d 3 X 4 2 d 3 4 d 2 8 d 4 Y -2 7 d -3 5 d -4 1 d -3 X cl s 235 651 m
- 21 X s 266 659 m 1 Y 1 3 d 1 1 d 2 1 d 5 X 2 -1 d 2 -1 d 1 -3 d -2 Y -1 -2 d -3
- -4 d -12 -12 d 17 X s 407 699 m -16 Y s 515 699 m -16 Y s 591 699 m -16 Y s 650
- 699 m -16 Y s 699 699 m -16 Y s 740 699 m -16 Y s 775 699 m -16 Y s 807 699 m
- -16 Y s 835 716 m -33 Y s 798 634 m 3 2 d 5 4 d -31 Y s 833 640 m -5 -1 d -3 -5
- d -1 -7 d -4 Y 1 -8 d 3 -4 d 5 -2 d 3 X 4 2 d 3 4 d 1 8 d 4 Y -1 7 d -3 5 d -4
- 1 d -3 X cl s 847 651 m 22 X s 880 660 m 3 2 d 3 3 d -25 Y s 1019 699 m -16 Y s
- 1127 699 m -16 Y s 1204 699 m -16 Y s 1263 699 m -16 Y s 1311 699 m -16 Y s
- 1352 699 m -16 Y s 1388 699 m -16 Y s 1419 699 m -16 Y s 1447 716 m -33 Y s
- 1441 634 m 3 2 d 5 4 d -31 Y s 1632 699 m -16 Y s 1739 699 m -16 Y s 1816 699 m
- -16 Y s 1875 699 m -16 Y s 1924 699 m -16 Y s 1965 699 m -16 Y s 2000 699 m -16
- Y s 1779 1778 222 683 C gr
-showpage
- gr
-%%Trailer
-%%Pages: 1
- gr gr
-%%EOF
diff --git a/src/pawlib/paw/testsuite/paw.commands/nt_pl_1d_3.ref.ps b/src/pawlib/paw/testsuite/paw.commands/nt_pl_1d_3.ref.ps
deleted file mode 100644
index 61bab6d..0000000
--- a/src/pawlib/paw/testsuite/paw.commands/nt_pl_1d_3.ref.ps
+++ /dev/null
@@ -1,204 +0,0 @@
-%!PS-Adobe-2.0
-%%Title: /disk3/maartenb/cerncvs/paw/testsuite/tmp/nt_pl_1d_ (Portrait A 4)
-%%Pages: (atend)
-%%Creator: HIGZ Version 1.23/06
-%%CreationDate: 96/04/16 14.38
-%%EndComments
-%%BeginProlog
-/s {stroke} def /l {lineto} def /m {moveto} def /t {translate} def
-/sw {stringwidth} def /r {rotate} def /rl {roll} def /R {repeat} def
-/d {rlineto} def /rm {rmoveto} def /gr {grestore} def /f {eofill} def
-/c {setrgbcolor} def /lw {setlinewidth} def /sd {setdash} def
-/cl {closepath} def /sf {scalefont setfont} def /black {0 setgray} def
-/box {m dup 0 exch d exch 0 d 0 exch neg d cl} def
-/NC{systemdict begin initclip end}def/C{NC box clip newpath}def
-/bl {box s} def /bf {box f} def /Y { 0 exch d} def /X { 0 d} def
-/mp {newpath /y exch def /x exch def} def
-/side {[w .77 mul w .23 mul] .385 w mul sd w 0 l currentpoint t -144 r} def
-/mr {mp x y w2 0 360 arc} def /m24 {mr s} def /m20 {mr f} def
-/mb {mp x y w2 add m w2 neg 0 d 0 w neg d w 0 d 0 w d cl} def
-/mt {mp x y w2 add m w2 neg w neg d w 0 d cl} def
-/m21 {mb f} def /m25 {mb s} def /m22 {mt f} def /m26 {mt s} def
-/m23 {mp x y w2 sub m w2 w d w neg 0 d cl f} def
-/m27 {mp x y w2 add m w3 neg w2 neg d w3 w2 neg d w3 w2 d cl s} def
-/m28 {mp x w2 sub y w2 sub w3 add m w3 0 d 0 w3 neg d w3 0 d 0 w3 d w3 0 d
- 0 w3 d w3 neg 0 d 0 w3 d w3 neg 0 d
- 0 w3 neg d w3 neg 0 d cl s } def
-/m29 {mp gsave x w2 sub y w2 add w3 sub m currentpoint t
- 4 {side} repeat cl fill gr} def
-/m30 {mp gsave x w2 sub y w2 add w3 sub m currentpoint t
- 5 {side} repeat s gr} def
-/m31 {mp x y w2 sub m 0 w d x w2 sub y m w 0 d
- x w2 sub y w2 add m w w neg d x w2 sub y w2
- sub m w w d s} def
-/m2 {mp x y w2 sub m 0 w d x w2 sub y m w 0 d s} def
-/m5 {mp x w2 sub y w2 sub m w w d x w2 sub y w2 add m w w neg d s} def
-/DP {/PT exch def gsave 47.2 47.2 scale PT 1 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < AA AA 55 55 AA AA 55 55 AA AA 55 55 AA AA 55 55 AA AA 55 55 AA AA 55 55
-AA AA 55 55 AA AA 55 55 > } image } if PT 2 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < BB BB EE EE BB BB EE EE BB BB EE EE BB BB EE EE BB BB EE EE BB BB EE EE
-BB BB EE EE BB BB EE EE > } image } if PT 3 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < FF FF BB BB FF FF EE EE FF FF BB BB FF FF EE EE FF FF BB BB FF FF EE EE
-FF FF BB BB FF FF EE EE > } image } if PT 4 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < DF DF BF BF 7F 7F FE FE FD FD FB FB F7 F7 EF EF DF DF BF BF 7F 7F FE FE
-FD FD FB FB F7 F7 EF EF > } image } if PT 5 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < 7F 7F BF B F DF DF EF EF F7 F7 FB FB FD FD FE FE 7F 7F BF BF DF DF EF
-EF F7 F7 FB FB FD FD FE FE > } image } if PT 6 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB
-BB BB BB BB BB BB BB BB BB > } image } if PT 7 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < FF FF FF FF FF FF 00 00 FF FF FF FF FF FF 00 00 FF FF FF FF FF FF 00
-00 FF FF FF FF FF FF 00 00 > } image } if PT 8 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < EE EE 47 47 83 83 C5 C5 EE EE 5C 5C 38 38 74 74 EE EE 47 47 83 83 C5
-C5 EE EE 5C 5C 38 38 74 74 > } image } if PT 9 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < EF EF EF EF D7 D7 38 38 FE FE FE FE 7D 7D 83 83 EF EF EF EF D7 D7 38
-38 FE FE FE FE 7D 7D 83 83 > } image } if PT 10 eq { 16 16 1 [ 16 0 0 16 neg
-0 16 ] { < EF EF EF EF EF EF 00 00 FE FE FE FE FE FE 00 00 EF EF EF EF EF EF
-00 00 FE FE FE FE FE FE 00 00 > } image } if PT 11 eq { 16 16 1 [ 16 0 0 16
-neg 0 16 ] { < F7 F7 B6 B6 D5 D5 E3 E3 D5 D5 B6 B6 F7 F7 FF FF 7F 7F 6B 6B 5D
-5D 3E 3E 5D 5D 6B 6B 7F 7F FF FF > } image } if PT 12 eq { 16 16 1 [ 16 0 0
-16 neg 0 16 ] { < E3 E3 DD DD BE BE BE BE BE BE DD DD E3 E3 FF FF 3E 3E DD DD
-EB EB EB EB EB EB DD DD 3E 3E FF FF > } image } if PT 13 eq { 16 16 1 [ 16 0
-0 16 neg 0 16 ] { < FE FE 7D 7D BB BB D7 D7 EF EF D7 D7 BB BB 7D 7D FE FE 7D
-7D BB BB D7 D7 EF EF D7 D7 BB BB 7D 7D > } image } if PT 14 eq { 16 16 1 [ 16
-0 0 16 neg 0 16 ] { < 00 00 EE EF EE EF EE EF 0E E0 EE EE EE EE EE EE 00 EE
-FE EE FE EE FE EE 00 00 FE EF FE EF FE EF > } image } if PT 15 eq { 16 16 1 [
-16 0 0 16 neg 0 16 ] { < DD DD AA AA DD DD FF FF 77 77 AA AA 77 77 FF FF DD
-DD AA AA DD DD FF FF 77 77 AA AA 77 77 FF FF > } image } if PT 16 eq { 16 16
-1 [ 16 0 0 16 neg 0 16 ] { < F1 F1 EE EE 1F 1F FF FF F1 F1 EE EE 1F 1F FF FF
-F1 F1 EE EE 1F 1F FF FF F1 F1 EE EE 1F 1F FF FF > } image } if PT 17 eq { 16
-16 1 [ 16 0 0 16 neg 0 16 ] { < EE EE DD DD BB BB FF FF EE EE DD DD BB BB FF
- FF EE EE DD DD BB BB FF FF EE EE DD DD BB BB FF FF > } image } if PT 18 eq {
-16 16 1 [ 16 0 0 16 neg 0 16 ] { < BB BB DD DD EE EE FF FF BB BB DD DD EE EE
-FF FF BB BB DD DD EE EE FF FF BB BB DD DD EE EE FF FF > } image } if PT 19 eq
-{ 16 16 1 [ 16 0 0 16 neg 0 16 ] { < 1F FC 67 F3 7B EF BD DE BD DE DE BD E6
-B3 F8 0F E6 B3 DE BD BD DE BD DE 7B EF 67 F3 1F FC 7F FF > } image } if PT
-20 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < DD DD EE EE EE EE EE EE DD DD BB
-BB BB BB BB BB DD DD EE EE EE EE EE EE DD DD BB BB BB BB BB BB > } image }
-if PT 21 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < 0E 0E EF EF EF EF EF EF E0
-E0 FE FE FE FE FE FE 0E 0E EF EF EF EF EF EF E0 E0 FE FE FE FE FE FE > }
-image } if PT 22 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < 70 70 F7 F7 F7 F7 F7
-F7 07 07 7F 7F 7F 7F 7F 7F 70 70 F7 F7 F7 F7 F7 F7 07 07 7F 7F 7F 7F 7F 7F >
-} image } if PT 23 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < AA AA 55 55 A9 A9
-D1 D1 E1 E1 D1 D1 A9 A9 55 55 AA AA 55 55 A9 A9 D1 D1 E1 E1 D1 D1 A9 A9 55 55
-> } image } if PT 24 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < FF FE FF FC EA
-A8 D5 54 EA A8 D5 54 E8 28 D4 54 E8 E8 D4 D4 E8 EA 54 D5 A8 EA 54 D5 00 C0 00
-80 > } image } if PT 25 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < FF FE FF FC
-FF F8 FF F0 F0 00 F0 00 F0 20 F0 60 F0 E0 F1 E0 F3 E0 F0 00 E0 00 C0 00 80 00
-00 00 > } image } if gr } def /FA { /PT exch def gsave clip 0 0 translate 1 1
-54 { 1 sub 47.2 mul /Xcurr exch def 1 1 74 { 1 sub 47.2 mul /Ycurr exch def
-gsave Xcurr Ycurr translate PT DP gr } for } for gr } def
-/reencdict 24 dict def /ReEncode {reencdict begin /nco&na exch def
-/nfnam exch def /basefontname exch def /basefontdict basefontname findfont def
-/newfont basefontdict maxlength dict def basefontdict {exch dup /FID ne
-{dup /Encoding eq {exch dup length array copy newfont 3 1 roll put} {exch
-newfont 3 1 roll put} ifelse} {pop pop} ifelse } forall newfont
-/FontName nfnam put nco&na aload pop nco&na length 2 idiv {newfont
-/Encoding get 3 1 roll put} repeat nfnam newfont definefont pop end } def
-/accvec [ 176 /agrave 181 /Agrave 190 /acircumflex 192 /Acircumflex
-201 /adieresis 204 /Adieresis 209 /ccedilla 210 /Ccedilla 211 /eacute
-212 /Eacute 213 /egrave 214 /Egrave 215 /ecircumflex 216 /Ecircumflex
-217 /edieresis 218 /Edieresis 219 /icircumflex 220 /Icircumflex
-221 /idieresis 222 /Idieresis 223 /ntilde 224 /Ntilde 226 /ocircumflex
-228 /Ocircumflex 229 /odieresis 230 /Odieresis 231 /ucircumflex 236 /Ucircumflex
-237 /udieresis 238 /Udieresis 239 /aring 242 /Aring 243 /ydieresis
-244 /Ydieresis 246 /aacute 247 /Aacute 252 /ugrave 253 /Ugrave] def
-/Times-Roman /Times-Roman accvec ReEncode
-/Times-Italic /Times-Italic accvec ReEncode
-/Times-Bold /Times-Bold accvec ReEncode
-/Times-BoldItalic /Times-BoldItalic accvec ReEncode
-/Helvetica /Helvetica accvec ReEncode
-/Helvetica-Oblique /Helvetica-Oblique accvec ReEncode
-/Helvetica-Bold /Helvetica-Bold accvec ReEncode
-/Helvetica-BoldOblique /Helvetica-BoldOblique accvec ReEncode
-/Courier /Courier accvec ReEncode
-/Courier-Oblique /Courier-Oblique accvec ReEncode
-/Courier-Bold /Courier-Bold accvec ReEncode
-/Courier-BoldOblique /Courier-BoldOblique accvec ReEncode
-/oshow {gsave [] 0 sd true charpath stroke gr} def
-/stwn { /fs exch def /fn exch def /text exch def fn findfont fs sf
- text sw pop xs add /xs exch def} def
-/stwb { /fs exch def /fn exch def /nbas exch def /textf exch def
-textf length /tlen exch def nbas tlen gt {/nbas tlen def} if
-fn findfont fs sf textf dup length nbas sub nbas getinterval sw
-pop neg xs add /xs exch def} def
-/accspe [ 65 /plusminus 66 /bar 67 /existential 68 /universal
-69 /exclam 70 /numbersign 71 /greater 72 /question 73 /integral
-74 /colon 75 /semicolon 76 /less 77 /bracketleft 78 /bracketright
-79 /greaterequal 80 /braceleft 81 /braceright 82 /radical
-83 /spade 84 /heart 85 /diamond 86 /club 87 /lessequal
-88 /multiply 89 /percent 90 /infinity 48 /circlemultiply 49 /circleplus
-50 /emptyset 51 /lozenge 52 /bullet 53 /arrowright 54 /arrowup
-55 /arrowleft 56 /arrowdown 57 /arrowboth 48 /degree 44 /comma 43 /plus
- 45 /angle 42 /angleleft 47 /divide 61 /notequal 40 /equivalence 41 /second
- 97 /approxequal 98 /congruent 99 /perpendicular 100 /partialdiff 101 /florin
- 102 /intersection 103 /union 104 /propersuperset 105 /reflexsuperset
- 106 /notsubset 107 /propersubset 108 /reflexsubset 109 /element 110 /notelement
- 111 /gradient 112 /logicaland 113 /logicalor 114 /arrowdblboth
- 115 /arrowdblleft 116 /arrowdblup 117 /arrowdblright 118 /arrowdbldown
- 119 /ampersand 120 /omega1 121 /similar 122 /aleph ] def
-/Symbol /Special accspe ReEncode
-/Zone {/iy exch def /ix exch def ix 1 sub 2224 mul 1 iy sub 3144
- mul t} def
-%%EndProlog
- gsave 20 28 t .25 .25 scale gsave
-%%Page: number 1
- gsave
- 1 1 Zone
- gsave 0 0 t black [] 0 sd 1 lw 2223 2224 0 460 bl 2223 2224 0 460 C NC 1779
- 1778 222 683 bl 2223 2224 0 460 C 1080 549 m 16 X -9 -11 d 5 X 2 -2 d 2 -1 d 1
- -5 d -3 Y -1 -4 d -3 -3 d -4 -2 d -5 X -4 2 d -2 1 d -1 3 d s 1114 541 m -18 Y
- s 1106 536 m 15 -9 d s 1121 536 m -15 -9 d s 1130 539 m 16 -21 d s 1146 539 m
- -16 -21 d s 1779 1778 222 683 C 222 683 m 1228 X 843 Y 25 X 111 Y 23 X -85 Y 21
- X -49 Y 20 X 49 Y 18 X 18 Y 17 X -34 Y 16 X 16 Y 15 X 70 Y 14 X -39 Y 14 X 3 Y
- 13 X 15 Y 12 X -40 Y 12 X 16 Y 11 X 74 Y 11 X -71 Y 10 X -73 Y 10 X 115 Y 10 X
- -30 Y 9 X -15 Y 9 X -35 Y 9 X 44 Y 8 X -57 Y 9 X 90 Y 8 X -93 Y 7 X -36 Y 8 X
- 46 Y 7 X -20 Y 7 X 70 Y 7 X -19 Y 13 X -6 Y 7 X 46 Y 6 X -107 Y 6 X 52 Y 6 X
- -55 Y 6 X -21 Y 5 X 169 Y 6 X -75 Y 6 X -111 Y 5 X 127 Y 5 X -60 Y 5 X -16 Y 5
- X 26 Y 5 X 3 Y 5 X 80 Y 5 X 6 Y 5 X -15 Y 4 X -103 Y 5 X 16 Y 4 X 35 Y 5 X 64 Y
- 4 X -180 Y 4 X 106 Y 4 X 7 Y 5 X -42 Y 4 X 189 Y 4 X -256 Y 4 X 115 Y 3 X 84 Y
- 4 X -962 Y 36 X s NC 222 683 m 1778 Y s 239 948 m -17 X s 95 956 m 2 Y 1 3 d 2
- 1 d 3 2 d 6 X 3 -2 d 1 -1 d 2 -3 d -3 Y -2 -3 d -3 -5 d -15 -15 d 21 X s 132
- 964 m -5 -2 d -3 -4 d -1 -8 d -4 Y 1 -8 d 3 -4 d 5 -2 d 3 X 4 2 d 3 4 d 2 8 d 4
- Y -2 8 d -3 4 d -4 2 d -3 X cl s 162 964 m -5 -2 d -3 -4 d -1 -8 d -4 Y 1 -8 d
- 3 -4 d 5 -2 d 3 X 4 2 d 3 4 d 1 8 d 4 Y -1 8 d -3 4 d -4 2 d -3 X cl s 239 1392
- m -17 X s 96 1408 m 17 X -9 -12 d 4 X 3 -2 d 2 -1 d 1 -5 d -2 Y -1 -5 d -3 -3 d
- -5 -1 d -4 X -5 1 d -1 2 d -2 3 d s 132 1408 m -5 -2 d -3 -4 d -1 -8 d -4 Y 1
- -7 d 3 -5 d 5 -1 d 3 X 4 1 d 3 5 d 2 7 d 4 Y -2 8 d -3 4 d -4 2 d -3 X cl s 162
- 1408 m -5 -2 d -3 -4 d -1 -8 d -4 Y 1 -7 d 3 -5 d 5 -1 d 3 X 4 1 d 3 5 d 1 7 d
- 4 Y -1 8 d -3 4 d -4 2 d -3 X cl s 239 1707 m -17 X s 108 1723 m -15 -21 d 23 X
- s 108 1723 m -31 Y s 132 1723 m -5 -2 d -3 -4 d -1 -7 d -5 Y 1 -7 d 3 -5 d 5 -1
- d 3 X 4 1 d 3 5 d 2 7 d 5 Y -2 7 d -3 4 d -4 2 d -3 X cl s 162 1723 m -5 -2 d
- -3 -4 d -1 -7 d -5 Y 1 -7 d 3 -5 d 5 -1 d 3 X 4 1 d 3 5 d 1 7 d 5 Y -1 7 d -3 4
- d -4 2 d -3 X cl s 239 1952 m -17 X s 111 1967 m -15 X -1 -13 d 1 2 d 5 1 d 4 X
- 5 -1 d 3 -3 d 1 -5 d -3 Y -1 -4 d -3 -3 d -5 -2 d -4 X -5 2 d -1 1 d -2 3 d s
- 132 1967 m -5 -1 d -3 -5 d -1 -7 d -4 Y 1 -8 d 3 -4 d 5 -2 d 3 X 4 2 d 3 4 d 2
- 8 d 4 Y -2 7 d -3 5 d -4 1 d -3 X cl s 162 1967 m -5 -1 d -3 -5 d -1 -7 d -4 Y
- 1 -8 d 3 -4 d 5 -2 d 3 X 4 2 d 3 4 d 1 8 d 4 Y -1 7 d -3 5 d -4 1 d -3 X cl s
- 239 2152 m -17 X s 113 2163 m -2 3 d -4 1 d -3 X -5 -1 d -3 -5 d -1 -7 d -8 Y 1
- -6 d 3 -3 d 5 -1 d 1 X 5 1 d 3 3 d 1 5 d 1 Y -1 5 d -3 3 d -5 1 d -1 X -5 -1 d
- -3 -3 d -1 -5 d s 132 2167 m -5 -1 d -3 -5 d -1 -7 d -5 Y 1 -7 d 3 -5 d 5 -1 d
- 3 X 4 1 d 3 5 d 2 7 d 5 Y -2 7 d -3 5 d -4 1 d -3 X cl s 162 2167 m -5 -1 d -3
- -5 d -1 -7 d -5 Y 1 -7 d 3 -5 d 5 -1 d 3 X 4 1 d 3 5 d 1 7 d 5 Y -1 7 d -3 5 d
- -4 1 d -3 X cl s 239 2320 m -17 X s 114 2336 m -15 -31 d s 93 2336 m 21 X s 132
- 2336 m -5 -2 d -3 -4 d -1 -7 d -5 Y 1 -7 d 3 -5 d 5 -1 d 3 X 4 1 d 3 5 d 2 7 d
- 5 Y -2 7 d -3 4 d -4 2 d -3 X cl s 162 2336 m -5 -2 d -3 -4 d -1 -7 d -5 Y 1 -7
- d 3 -5 d 5 -1 d 3 X 4 1 d 3 5 d 1 7 d 5 Y -1 7 d -3 4 d -4 2 d -3 X cl s 222
- 683 m 1779 X s 222 716 m -33 Y s 186 634 m 3 2 d 4 4 d -31 Y s 220 640 m -4 -1
- d -3 -5 d -2 -7 d -4 Y 2 -8 d 3 -4 d 4 -2 d 3 X 4 2 d 3 4 d 2 8 d 4 Y -2 7 d -3
- 5 d -4 1 d -3 X cl s 235 651 m 21 X s 266 659 m 1 Y 1 3 d 1 1 d 2 1 d 5 X 2 -1
- d 2 -1 d 1 -3 d -2 Y -1 -2 d -3 -4 d -12 -12 d 17 X s 407 699 m -16 Y s 515 699
- m -16 Y s 591 699 m -16 Y s 650 699 m -16 Y s 699 699 m -16 Y s 740 699 m -16 Y
- s 775 699 m -16 Y s 807 699 m -16 Y s 835 716 m -33 Y s 798 634 m 3 2 d 5 4 d
- -31 Y s 833 640 m -5 -1 d -3 -5 d -1 -7 d -4 Y 1 -8 d 3 -4 d 5 -2 d 3 X 4 2 d 3
- 4 d 1 8 d 4 Y -1 7 d -3 5 d -4 1 d -3 X cl s 847 651 m 22 X s 880 660 m 3 2 d 3
- 3 d -25 Y s 1019 699 m -16 Y s 1127 699 m -16 Y s 1204 699 m -16 Y s 1263 699 m
- -16 Y s 1311 699 m -16 Y s 1352 699 m -16 Y s 1388 699 m -16 Y s 1419 699 m -16
- Y s 1447 716 m -33 Y s 1441 634 m 3 2 d 5 4 d -31 Y s 1632 699 m -16 Y s 1739
- 699 m -16 Y s 1816 699 m -16 Y s 1875 699 m -16 Y s 1924 699 m -16 Y s 1965 699
- m -16 Y s 2000 699 m -16 Y s 1779 1778 222 683 C gr
-showpage
- gr
-%%Trailer
-%%Pages: 1
- gr gr
-%%EOF
diff --git a/src/pawlib/paw/testsuite/paw.commands/nt_pl_1d_4.ref.ps b/src/pawlib/paw/testsuite/paw.commands/nt_pl_1d_4.ref.ps
deleted file mode 100644
index a2b9087..0000000
--- a/src/pawlib/paw/testsuite/paw.commands/nt_pl_1d_4.ref.ps
+++ /dev/null
@@ -1,228 +0,0 @@
-%!PS-Adobe-2.0
-%%Title: /disk3/maartenb/cerncvs/paw/testsuite/tmp/nt_pl_1d_ (Portrait A 4)
-%%Pages: (atend)
-%%Creator: HIGZ Version 1.23/06
-%%CreationDate: 96/04/16 14.38
-%%EndComments
-%%BeginProlog
-/s {stroke} def /l {lineto} def /m {moveto} def /t {translate} def
-/sw {stringwidth} def /r {rotate} def /rl {roll} def /R {repeat} def
-/d {rlineto} def /rm {rmoveto} def /gr {grestore} def /f {eofill} def
-/c {setrgbcolor} def /lw {setlinewidth} def /sd {setdash} def
-/cl {closepath} def /sf {scalefont setfont} def /black {0 setgray} def
-/box {m dup 0 exch d exch 0 d 0 exch neg d cl} def
-/NC{systemdict begin initclip end}def/C{NC box clip newpath}def
-/bl {box s} def /bf {box f} def /Y { 0 exch d} def /X { 0 d} def
-/mp {newpath /y exch def /x exch def} def
-/side {[w .77 mul w .23 mul] .385 w mul sd w 0 l currentpoint t -144 r} def
-/mr {mp x y w2 0 360 arc} def /m24 {mr s} def /m20 {mr f} def
-/mb {mp x y w2 add m w2 neg 0 d 0 w neg d w 0 d 0 w d cl} def
-/mt {mp x y w2 add m w2 neg w neg d w 0 d cl} def
-/m21 {mb f} def /m25 {mb s} def /m22 {mt f} def /m26 {mt s} def
-/m23 {mp x y w2 sub m w2 w d w neg 0 d cl f} def
-/m27 {mp x y w2 add m w3 neg w2 neg d w3 w2 neg d w3 w2 d cl s} def
-/m28 {mp x w2 sub y w2 sub w3 add m w3 0 d 0 w3 neg d w3 0 d 0 w3 d w3 0 d
- 0 w3 d w3 neg 0 d 0 w3 d w3 neg 0 d
- 0 w3 neg d w3 neg 0 d cl s } def
-/m29 {mp gsave x w2 sub y w2 add w3 sub m currentpoint t
- 4 {side} repeat cl fill gr} def
-/m30 {mp gsave x w2 sub y w2 add w3 sub m currentpoint t
- 5 {side} repeat s gr} def
-/m31 {mp x y w2 sub m 0 w d x w2 sub y m w 0 d
- x w2 sub y w2 add m w w neg d x w2 sub y w2
- sub m w w d s} def
-/m2 {mp x y w2 sub m 0 w d x w2 sub y m w 0 d s} def
-/m5 {mp x w2 sub y w2 sub m w w d x w2 sub y w2 add m w w neg d s} def
-/DP {/PT exch def gsave 47.2 47.2 scale PT 1 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < AA AA 55 55 AA AA 55 55 AA AA 55 55 AA AA 55 55 AA AA 55 55 AA AA 55 55
-AA AA 55 55 AA AA 55 55 > } image } if PT 2 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < BB BB EE EE BB BB EE EE BB BB EE EE BB BB EE EE BB BB EE EE BB BB EE EE
-BB BB EE EE BB BB EE EE > } image } if PT 3 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < FF FF BB BB FF FF EE EE FF FF BB BB FF FF EE EE FF FF BB BB FF FF EE EE
-FF FF BB BB FF FF EE EE > } image } if PT 4 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < DF DF BF BF 7F 7F FE FE FD FD FB FB F7 F7 EF EF DF DF BF BF 7F 7F FE FE
-FD FD FB FB F7 F7 EF EF > } image } if PT 5 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < 7F 7F BF B F DF DF EF EF F7 F7 FB FB FD FD FE FE 7F 7F BF BF DF DF EF
-EF F7 F7 FB FB FD FD FE FE > } image } if PT 6 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB
-BB BB BB BB BB BB BB BB BB > } image } if PT 7 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < FF FF FF FF FF FF 00 00 FF FF FF FF FF FF 00 00 FF FF FF FF FF FF 00
-00 FF FF FF FF FF FF 00 00 > } image } if PT 8 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < EE EE 47 47 83 83 C5 C5 EE EE 5C 5C 38 38 74 74 EE EE 47 47 83 83 C5
-C5 EE EE 5C 5C 38 38 74 74 > } image } if PT 9 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < EF EF EF EF D7 D7 38 38 FE FE FE FE 7D 7D 83 83 EF EF EF EF D7 D7 38
-38 FE FE FE FE 7D 7D 83 83 > } image } if PT 10 eq { 16 16 1 [ 16 0 0 16 neg
-0 16 ] { < EF EF EF EF EF EF 00 00 FE FE FE FE FE FE 00 00 EF EF EF EF EF EF
-00 00 FE FE FE FE FE FE 00 00 > } image } if PT 11 eq { 16 16 1 [ 16 0 0 16
-neg 0 16 ] { < F7 F7 B6 B6 D5 D5 E3 E3 D5 D5 B6 B6 F7 F7 FF FF 7F 7F 6B 6B 5D
-5D 3E 3E 5D 5D 6B 6B 7F 7F FF FF > } image } if PT 12 eq { 16 16 1 [ 16 0 0
-16 neg 0 16 ] { < E3 E3 DD DD BE BE BE BE BE BE DD DD E3 E3 FF FF 3E 3E DD DD
-EB EB EB EB EB EB DD DD 3E 3E FF FF > } image } if PT 13 eq { 16 16 1 [ 16 0
-0 16 neg 0 16 ] { < FE FE 7D 7D BB BB D7 D7 EF EF D7 D7 BB BB 7D 7D FE FE 7D
-7D BB BB D7 D7 EF EF D7 D7 BB BB 7D 7D > } image } if PT 14 eq { 16 16 1 [ 16
-0 0 16 neg 0 16 ] { < 00 00 EE EF EE EF EE EF 0E E0 EE EE EE EE EE EE 00 EE
-FE EE FE EE FE EE 00 00 FE EF FE EF FE EF > } image } if PT 15 eq { 16 16 1 [
-16 0 0 16 neg 0 16 ] { < DD DD AA AA DD DD FF FF 77 77 AA AA 77 77 FF FF DD
-DD AA AA DD DD FF FF 77 77 AA AA 77 77 FF FF > } image } if PT 16 eq { 16 16
-1 [ 16 0 0 16 neg 0 16 ] { < F1 F1 EE EE 1F 1F FF FF F1 F1 EE EE 1F 1F FF FF
-F1 F1 EE EE 1F 1F FF FF F1 F1 EE EE 1F 1F FF FF > } image } if PT 17 eq { 16
-16 1 [ 16 0 0 16 neg 0 16 ] { < EE EE DD DD BB BB FF FF EE EE DD DD BB BB FF
- FF EE EE DD DD BB BB FF FF EE EE DD DD BB BB FF FF > } image } if PT 18 eq {
-16 16 1 [ 16 0 0 16 neg 0 16 ] { < BB BB DD DD EE EE FF FF BB BB DD DD EE EE
-FF FF BB BB DD DD EE EE FF FF BB BB DD DD EE EE FF FF > } image } if PT 19 eq
-{ 16 16 1 [ 16 0 0 16 neg 0 16 ] { < 1F FC 67 F3 7B EF BD DE BD DE DE BD E6
-B3 F8 0F E6 B3 DE BD BD DE BD DE 7B EF 67 F3 1F FC 7F FF > } image } if PT
-20 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < DD DD EE EE EE EE EE EE DD DD BB
-BB BB BB BB BB DD DD EE EE EE EE EE EE DD DD BB BB BB BB BB BB > } image }
-if PT 21 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < 0E 0E EF EF EF EF EF EF E0
-E0 FE FE FE FE FE FE 0E 0E EF EF EF EF EF EF E0 E0 FE FE FE FE FE FE > }
-image } if PT 22 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < 70 70 F7 F7 F7 F7 F7
-F7 07 07 7F 7F 7F 7F 7F 7F 70 70 F7 F7 F7 F7 F7 F7 07 07 7F 7F 7F 7F 7F 7F >
-} image } if PT 23 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < AA AA 55 55 A9 A9
-D1 D1 E1 E1 D1 D1 A9 A9 55 55 AA AA 55 55 A9 A9 D1 D1 E1 E1 D1 D1 A9 A9 55 55
-> } image } if PT 24 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < FF FE FF FC EA
-A8 D5 54 EA A8 D5 54 E8 28 D4 54 E8 E8 D4 D4 E8 EA 54 D5 A8 EA 54 D5 00 C0 00
-80 > } image } if PT 25 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < FF FE FF FC
-FF F8 FF F0 F0 00 F0 00 F0 20 F0 60 F0 E0 F1 E0 F3 E0 F0 00 E0 00 C0 00 80 00
-00 00 > } image } if gr } def /FA { /PT exch def gsave clip 0 0 translate 1 1
-54 { 1 sub 47.2 mul /Xcurr exch def 1 1 74 { 1 sub 47.2 mul /Ycurr exch def
-gsave Xcurr Ycurr translate PT DP gr } for } for gr } def
-/reencdict 24 dict def /ReEncode {reencdict begin /nco&na exch def
-/nfnam exch def /basefontname exch def /basefontdict basefontname findfont def
-/newfont basefontdict maxlength dict def basefontdict {exch dup /FID ne
-{dup /Encoding eq {exch dup length array copy newfont 3 1 roll put} {exch
-newfont 3 1 roll put} ifelse} {pop pop} ifelse } forall newfont
-/FontName nfnam put nco&na aload pop nco&na length 2 idiv {newfont
-/Encoding get 3 1 roll put} repeat nfnam newfont definefont pop end } def
-/accvec [ 176 /agrave 181 /Agrave 190 /acircumflex 192 /Acircumflex
-201 /adieresis 204 /Adieresis 209 /ccedilla 210 /Ccedilla 211 /eacute
-212 /Eacute 213 /egrave 214 /Egrave 215 /ecircumflex 216 /Ecircumflex
-217 /edieresis 218 /Edieresis 219 /icircumflex 220 /Icircumflex
-221 /idieresis 222 /Idieresis 223 /ntilde 224 /Ntilde 226 /ocircumflex
-228 /Ocircumflex 229 /odieresis 230 /Odieresis 231 /ucircumflex 236 /Ucircumflex
-237 /udieresis 238 /Udieresis 239 /aring 242 /Aring 243 /ydieresis
-244 /Ydieresis 246 /aacute 247 /Aacute 252 /ugrave 253 /Ugrave] def
-/Times-Roman /Times-Roman accvec ReEncode
-/Times-Italic /Times-Italic accvec ReEncode
-/Times-Bold /Times-Bold accvec ReEncode
-/Times-BoldItalic /Times-BoldItalic accvec ReEncode
-/Helvetica /Helvetica accvec ReEncode
-/Helvetica-Oblique /Helvetica-Oblique accvec ReEncode
-/Helvetica-Bold /Helvetica-Bold accvec ReEncode
-/Helvetica-BoldOblique /Helvetica-BoldOblique accvec ReEncode
-/Courier /Courier accvec ReEncode
-/Courier-Oblique /Courier-Oblique accvec ReEncode
-/Courier-Bold /Courier-Bold accvec ReEncode
-/Courier-BoldOblique /Courier-BoldOblique accvec ReEncode
-/oshow {gsave [] 0 sd true charpath stroke gr} def
-/stwn { /fs exch def /fn exch def /text exch def fn findfont fs sf
- text sw pop xs add /xs exch def} def
-/stwb { /fs exch def /fn exch def /nbas exch def /textf exch def
-textf length /tlen exch def nbas tlen gt {/nbas tlen def} if
-fn findfont fs sf textf dup length nbas sub nbas getinterval sw
-pop neg xs add /xs exch def} def
-/accspe [ 65 /plusminus 66 /bar 67 /existential 68 /universal
-69 /exclam 70 /numbersign 71 /greater 72 /question 73 /integral
-74 /colon 75 /semicolon 76 /less 77 /bracketleft 78 /bracketright
-79 /greaterequal 80 /braceleft 81 /braceright 82 /radical
-83 /spade 84 /heart 85 /diamond 86 /club 87 /lessequal
-88 /multiply 89 /percent 90 /infinity 48 /circlemultiply 49 /circleplus
-50 /emptyset 51 /lozenge 52 /bullet 53 /arrowright 54 /arrowup
-55 /arrowleft 56 /arrowdown 57 /arrowboth 48 /degree 44 /comma 43 /plus
- 45 /angle 42 /angleleft 47 /divide 61 /notequal 40 /equivalence 41 /second
- 97 /approxequal 98 /congruent 99 /perpendicular 100 /partialdiff 101 /florin
- 102 /intersection 103 /union 104 /propersuperset 105 /reflexsuperset
- 106 /notsubset 107 /propersubset 108 /reflexsubset 109 /element 110 /notelement
- 111 /gradient 112 /logicaland 113 /logicalor 114 /arrowdblboth
- 115 /arrowdblleft 116 /arrowdblup 117 /arrowdblright 118 /arrowdbldown
- 119 /ampersand 120 /omega1 121 /similar 122 /aleph ] def
-/Symbol /Special accspe ReEncode
-/Zone {/iy exch def /ix exch def ix 1 sub 2224 mul 1 iy sub 3144
- mul t} def
-%%EndProlog
- gsave 20 28 t .25 .25 scale gsave
-%%Page: number 1
- gsave
- 1 1 Zone
- gsave 0 0 t black [] 0 sd 1 lw 2223 2224 0 460 bl 2223 2224 0 460 C NC 1779
- 1778 222 683 bl 1779 1778 222 683 C 2223 2224 0 460 C 1066 549 m -31 Y s 1066
- 535 m 3 3 d 2 1 d 5 X 3 -1 d 3 -3 d 1 -5 d -3 Y -1 -4 d -3 -3 d -3 -2 d -5 X -2
- 2 d -3 3 d s 1094 539 m -21 Y s 1094 530 m 1 5 d 3 3 d 3 1 d 5 X s 1113 539 m
- -21 Y s 1113 533 m 4 5 d 3 1 d 5 X 3 -1 d 1 -5 d -15 Y s 1157 549 m -31 Y s
- 1157 535 m -3 3 d -2 1 d -5 X -3 -1 d -3 -3 d -1 -5 d -3 Y 1 -4 d 3 -3 d 3 -2 d
- 5 X 2 2 d 3 3 d s 1779 1778 222 683 C 222 683 m 229 X 1600 Y 25 X -1600 Y 1245
- X 1599 Y 26 X -1599 Y 254 X s NC 222 683 m 1778 Y s 256 683 m -34 X s 239 759 m
- -17 X s 239 835 m -17 X s 239 911 m -17 X s 256 988 m -34 X s 239 1064 m -17 X
- s 239 1140 m -17 X s 239 1216 m -17 X s 256 1292 m -34 X s 239 1369 m -17 X s
- 239 1445 m -17 X s 239 1521 m -17 X s 256 1597 m -34 X s 239 1673 m -17 X s 239
- 1750 m -17 X s 239 1826 m -17 X s 256 1902 m -34 X s 239 1978 m -17 X s 239
- 2054 m -17 X s 239 2131 m -17 X s 256 2207 m -34 X s 256 2207 m -34 X s 239
- 2283 m -17 X s 239 2359 m -17 X s 239 2435 m -17 X s 162 698 m -5 -1 d -3 -5 d
- -1 -7 d -4 Y 1 -8 d 3 -4 d 5 -2 d 3 X 4 2 d 3 4 d 1 8 d 4 Y -1 7 d -3 5 d -4 1
- d -3 X cl s 65 996 m 1 Y 2 3 d 1 2 d 3 1 d 6 X 3 -1 d 2 -2 d 1 -3 d -3 Y -1 -3
- d -3 -4 d -15 -15 d 20 X s 102 1003 m -4 -1 d -3 -5 d -2 -7 d -5 Y 2 -7 d 3 -5
- d 4 -1 d 3 X 5 1 d 3 5 d 1 7 d 5 Y -1 7 d -3 5 d -5 1 d -3 X cl s 132 1003 m -5
- -1 d -3 -5 d -1 -7 d -5 Y 1 -7 d 3 -5 d 5 -1 d 3 X 4 1 d 3 5 d 2 7 d 5 Y -2 7 d
- -3 5 d -4 1 d -3 X cl s 162 1003 m -5 -1 d -3 -5 d -1 -7 d -5 Y 1 -7 d 3 -5 d 5
- -1 d 3 X 4 1 d 3 5 d 1 7 d 5 Y -1 7 d -3 5 d -4 1 d -3 X cl s 79 1308 m -15 -21
- d 22 X s 79 1308 m -31 Y s 102 1308 m -4 -2 d -3 -4 d -2 -7 d -5 Y 2 -7 d 3 -5
- d 4 -1 d 3 X 5 1 d 3 5 d 1 7 d 5 Y -1 7 d -3 4 d -5 2 d -3 X cl s 132 1308 m -5
- -2 d -3 -4 d -1 -7 d -5 Y 1 -7 d 3 -5 d 5 -1 d 3 X 4 1 d 3 5 d 2 7 d 5 Y -2 7 d
- -3 4 d -4 2 d -3 X cl s 162 1308 m -5 -2 d -3 -4 d -1 -7 d -5 Y 1 -7 d 3 -5 d 5
- -1 d 3 X 4 1 d 3 5 d 1 7 d 5 Y -1 7 d -3 4 d -4 2 d -3 X cl s 83 1608 m -1 3 d
- -5 2 d -3 X -4 -2 d -3 -4 d -2 -8 d -7 Y 2 -6 d 3 -3 d 4 -1 d 2 X 4 1 d 3 3 d 1
- 4 d 2 Y -1 4 d -3 3 d -4 2 d -2 X -4 -2 d -3 -3 d -2 -4 d s 102 1613 m -4 -2 d
- -3 -4 d -2 -8 d -4 Y 2 -7 d 3 -5 d 4 -1 d 3 X 5 1 d 3 5 d 1 7 d 4 Y -1 8 d -3 4
- d -5 2 d -3 X cl s 132 1613 m -5 -2 d -3 -4 d -1 -8 d -4 Y 1 -7 d 3 -5 d 5 -1 d
- 3 X 4 1 d 3 5 d 2 7 d 4 Y -2 8 d -3 4 d -4 2 d -3 X cl s 162 1613 m -5 -2 d -3
- -4 d -1 -8 d -4 Y 1 -7 d 3 -5 d 5 -1 d 3 X 4 1 d 3 5 d 1 7 d 4 Y -1 8 d -3 4 d
- -4 2 d -3 X cl s 71 1917 m -4 -1 d -2 -3 d -3 Y 2 -3 d 3 -1 d 6 -2 d 4 -1 d 3
- -3 d 1 -3 d -5 Y -1 -3 d -1 -1 d -5 -2 d -6 X -4 2 d -2 1 d -1 3 d 5 Y 1 3 d 3
- 3 d 5 1 d 6 2 d 3 1 d 1 3 d 3 Y -1 3 d -5 1 d -6 X cl s 102 1917 m -4 -1 d -3
- -4 d -2 -8 d -4 Y 2 -8 d 3 -4 d 4 -2 d 3 X 5 2 d 3 4 d 1 8 d 4 Y -1 8 d -3 4 d
- -5 1 d -3 X cl s 132 1917 m -5 -1 d -3 -4 d -1 -8 d -4 Y 1 -8 d 3 -4 d 5 -2 d 3
- X 4 2 d 3 4 d 2 8 d 4 Y -2 8 d -3 4 d -4 1 d -3 X cl s 162 1917 m -5 -1 d -3 -4
- d -1 -8 d -4 Y 1 -8 d 3 -4 d 5 -2 d 3 X 4 2 d 3 4 d 1 8 d 4 Y -1 8 d -3 4 d -4
- 1 d -3 X cl s 39 2216 m 2 2 d 5 4 d -31 Y s 73 2222 m -5 -1 d -3 -5 d -1 -7 d
- -5 Y 1 -7 d 3 -4 d 5 -2 d 3 X 4 2 d 3 4 d 1 7 d 5 Y -1 7 d -3 5 d -4 1 d -3 X
- cl s 102 2222 m -4 -1 d -3 -5 d -2 -7 d -5 Y 2 -7 d 3 -4 d 4 -2 d 3 X 5 2 d 3 4
- d 1 7 d 5 Y -1 7 d -3 5 d -5 1 d -3 X cl s 132 2222 m -5 -1 d -3 -5 d -1 -7 d
- -5 Y 1 -7 d 3 -4 d 5 -2 d 3 X 4 2 d 3 4 d 2 7 d 5 Y -2 7 d -3 5 d -4 1 d -3 X
- cl s 162 2222 m -5 -1 d -3 -5 d -1 -7 d -5 Y 1 -7 d 3 -4 d 5 -2 d 3 X 4 2 d 3 4
- d 1 7 d 5 Y -1 7 d -3 5 d -4 1 d -3 X cl s 222 683 m 1779 X s 222 716 m -33 Y s
- 286 699 m -16 Y s 349 699 m -16 Y s 413 699 m -16 Y s 476 716 m -33 Y s 540 699
- m -16 Y s 603 699 m -16 Y s 667 699 m -16 Y s 730 716 m -33 Y s 794 699 m -16 Y
- s 857 699 m -16 Y s 921 699 m -16 Y s 984 716 m -33 Y s 1048 699 m -16 Y s 1112
- 699 m -16 Y s 1175 699 m -16 Y s 1239 716 m -33 Y s 1302 699 m -16 Y s 1366 699
- m -16 Y s 1429 699 m -16 Y s 1493 716 m -33 Y s 1556 699 m -16 Y s 1620 699 m
- -16 Y s 1683 699 m -16 Y s 1747 716 m -33 Y s 1810 699 m -16 Y s 1874 699 m -16
- Y s 1937 699 m -16 Y s 2001 716 m -33 Y s 2001 716 m -33 Y s 172 643 m 27 X s
- 218 661 m -5 -2 d -3 -4 d -1 -8 d -4 Y 1 -8 d 3 -4 d 5 -2 d 3 X 4 2 d 3 4 d 2 8
- d 4 Y -2 8 d -3 4 d -4 2 d -3 X cl s 242 632 m -2 -1 d 2 -2 d 1 2 d -1 1 d cl s
- 255 653 m 2 Y 1 3 d 2 1 d 3 2 d 6 X 3 -2 d 1 -1 d 2 -3 d -3 Y -2 -3 d -3 -5 d
- -15 -15 d 21 X s 475 661 m -5 -2 d -3 -4 d -1 -8 d -4 Y 1 -8 d 3 -4 d 5 -2 d 3
- X 4 2 d 3 4 d 2 8 d 4 Y -2 8 d -3 4 d -4 2 d -3 X cl s 707 661 m -5 -2 d -3 -4
- d -1 -8 d -4 Y 1 -8 d 3 -4 d 5 -2 d 3 X 4 2 d 3 4 d 2 8 d 4 Y -2 8 d -3 4 d -4
- 2 d -3 X cl s 730 632 m -1 -1 d 1 -2 d 2 2 d -2 1 d cl s 744 653 m 2 Y 1 3 d 2
- 1 d 3 2 d 6 X 3 -2 d 1 -1 d 2 -3 d -3 Y -2 -3 d -3 -5 d -15 -15 d 21 X s 961
- 661 m -5 -2 d -3 -4 d -1 -8 d -4 Y 1 -8 d 3 -4 d 5 -2 d 3 X 4 2 d 3 4 d 2 8 d 4
- Y -2 8 d -3 4 d -4 2 d -3 X cl s 984 632 m -1 -1 d 1 -2 d 2 2 d -2 1 d cl s
- 1011 661 m -15 -21 d 23 X s 1011 661 m -32 Y s 1215 661 m -5 -2 d -3 -4 d -1 -8
- d -4 Y 1 -8 d 3 -4 d 5 -2 d 3 X 4 2 d 3 4 d 2 8 d 4 Y -2 8 d -3 4 d -4 2 d -3 X
- cl s 1239 632 m -2 -1 d 2 -2 d 1 2 d -1 1 d cl s 1270 656 m -2 3 d -4 2 d -3 X
- -5 -2 d -3 -4 d -1 -8 d -7 Y 1 -6 d 3 -3 d 5 -2 d 1 X 5 2 d 3 3 d 1 4 d 2 Y -1
- 4 d -3 3 d -5 2 d -1 X -5 -2 d -3 -3 d -1 -4 d s 1469 661 m -5 -2 d -3 -4 d -1
- -8 d -4 Y 1 -8 d 3 -4 d 5 -2 d 3 X 4 2 d 3 4 d 2 8 d 4 Y -2 8 d -3 4 d -4 2 d
- -3 X cl s 1493 632 m -2 -1 d 2 -2 d 1 2 d -1 1 d cl s 1512 661 m -5 -2 d -1 -3
- d -3 Y 1 -3 d 3 -1 d 6 -2 d 5 -1 d 3 -3 d 1 -3 d -5 Y -1 -3 d -2 -1 d -4 -2 d
- -6 X -5 2 d -1 1 d -2 3 d 5 Y 2 3 d 3 3 d 4 1 d 6 2 d 3 1 d 2 3 d 3 Y -2 3 d -4
- 2 d -6 X cl s 1741 655 m 3 1 d 4 5 d -32 Y s 1973 655 m 3 1 d 4 5 d -32 Y s
- 2001 632 m -2 -1 d 2 -2 d 1 2 d -1 1 d cl s 2014 653 m 2 Y 2 3 d 1 1 d 3 2 d 6
- X 3 -2 d 1 -1 d 2 -3 d -3 Y -2 -3 d -3 -5 d -14 -15 d 20 X s 1779 1778 222 683
- C gr
-showpage
- gr
-%%Trailer
-%%Pages: 1
- gr gr
-%%EOF
diff --git a/src/pawlib/paw/testsuite/paw.commands/nt_pl_1d_5.ref.ps b/src/pawlib/paw/testsuite/paw.commands/nt_pl_1d_5.ref.ps
deleted file mode 100644
index 310a4a9..0000000
--- a/src/pawlib/paw/testsuite/paw.commands/nt_pl_1d_5.ref.ps
+++ /dev/null
@@ -1,259 +0,0 @@
-%!PS-Adobe-2.0
-%%Title: /disk3/maartenb/cerncvs/paw/testsuite/tmp/nt_pl_1d_ (Portrait A 4)
-%%Pages: (atend)
-%%Creator: HIGZ Version 1.23/06
-%%CreationDate: 96/04/16 14.39
-%%EndComments
-%%BeginProlog
-/s {stroke} def /l {lineto} def /m {moveto} def /t {translate} def
-/sw {stringwidth} def /r {rotate} def /rl {roll} def /R {repeat} def
-/d {rlineto} def /rm {rmoveto} def /gr {grestore} def /f {eofill} def
-/c {setrgbcolor} def /lw {setlinewidth} def /sd {setdash} def
-/cl {closepath} def /sf {scalefont setfont} def /black {0 setgray} def
-/box {m dup 0 exch d exch 0 d 0 exch neg d cl} def
-/NC{systemdict begin initclip end}def/C{NC box clip newpath}def
-/bl {box s} def /bf {box f} def /Y { 0 exch d} def /X { 0 d} def
-/mp {newpath /y exch def /x exch def} def
-/side {[w .77 mul w .23 mul] .385 w mul sd w 0 l currentpoint t -144 r} def
-/mr {mp x y w2 0 360 arc} def /m24 {mr s} def /m20 {mr f} def
-/mb {mp x y w2 add m w2 neg 0 d 0 w neg d w 0 d 0 w d cl} def
-/mt {mp x y w2 add m w2 neg w neg d w 0 d cl} def
-/m21 {mb f} def /m25 {mb s} def /m22 {mt f} def /m26 {mt s} def
-/m23 {mp x y w2 sub m w2 w d w neg 0 d cl f} def
-/m27 {mp x y w2 add m w3 neg w2 neg d w3 w2 neg d w3 w2 d cl s} def
-/m28 {mp x w2 sub y w2 sub w3 add m w3 0 d 0 w3 neg d w3 0 d 0 w3 d w3 0 d
- 0 w3 d w3 neg 0 d 0 w3 d w3 neg 0 d
- 0 w3 neg d w3 neg 0 d cl s } def
-/m29 {mp gsave x w2 sub y w2 add w3 sub m currentpoint t
- 4 {side} repeat cl fill gr} def
-/m30 {mp gsave x w2 sub y w2 add w3 sub m currentpoint t
- 5 {side} repeat s gr} def
-/m31 {mp x y w2 sub m 0 w d x w2 sub y m w 0 d
- x w2 sub y w2 add m w w neg d x w2 sub y w2
- sub m w w d s} def
-/m2 {mp x y w2 sub m 0 w d x w2 sub y m w 0 d s} def
-/m5 {mp x w2 sub y w2 sub m w w d x w2 sub y w2 add m w w neg d s} def
-/DP {/PT exch def gsave 47.2 47.2 scale PT 1 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < AA AA 55 55 AA AA 55 55 AA AA 55 55 AA AA 55 55 AA AA 55 55 AA AA 55 55
-AA AA 55 55 AA AA 55 55 > } image } if PT 2 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < BB BB EE EE BB BB EE EE BB BB EE EE BB BB EE EE BB BB EE EE BB BB EE EE
-BB BB EE EE BB BB EE EE > } image } if PT 3 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < FF FF BB BB FF FF EE EE FF FF BB BB FF FF EE EE FF FF BB BB FF FF EE EE
-FF FF BB BB FF FF EE EE > } image } if PT 4 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < DF DF BF BF 7F 7F FE FE FD FD FB FB F7 F7 EF EF DF DF BF BF 7F 7F FE FE
-FD FD FB FB F7 F7 EF EF > } image } if PT 5 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < 7F 7F BF B F DF DF EF EF F7 F7 FB FB FD FD FE FE 7F 7F BF BF DF DF EF
-EF F7 F7 FB FB FD FD FE FE > } image } if PT 6 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB
-BB BB BB BB BB BB BB BB BB > } image } if PT 7 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < FF FF FF FF FF FF 00 00 FF FF FF FF FF FF 00 00 FF FF FF FF FF FF 00
-00 FF FF FF FF FF FF 00 00 > } image } if PT 8 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < EE EE 47 47 83 83 C5 C5 EE EE 5C 5C 38 38 74 74 EE EE 47 47 83 83 C5
-C5 EE EE 5C 5C 38 38 74 74 > } image } if PT 9 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < EF EF EF EF D7 D7 38 38 FE FE FE FE 7D 7D 83 83 EF EF EF EF D7 D7 38
-38 FE FE FE FE 7D 7D 83 83 > } image } if PT 10 eq { 16 16 1 [ 16 0 0 16 neg
-0 16 ] { < EF EF EF EF EF EF 00 00 FE FE FE FE FE FE 00 00 EF EF EF EF EF EF
-00 00 FE FE FE FE FE FE 00 00 > } image } if PT 11 eq { 16 16 1 [ 16 0 0 16
-neg 0 16 ] { < F7 F7 B6 B6 D5 D5 E3 E3 D5 D5 B6 B6 F7 F7 FF FF 7F 7F 6B 6B 5D
-5D 3E 3E 5D 5D 6B 6B 7F 7F FF FF > } image } if PT 12 eq { 16 16 1 [ 16 0 0
-16 neg 0 16 ] { < E3 E3 DD DD BE BE BE BE BE BE DD DD E3 E3 FF FF 3E 3E DD DD
-EB EB EB EB EB EB DD DD 3E 3E FF FF > } image } if PT 13 eq { 16 16 1 [ 16 0
-0 16 neg 0 16 ] { < FE FE 7D 7D BB BB D7 D7 EF EF D7 D7 BB BB 7D 7D FE FE 7D
-7D BB BB D7 D7 EF EF D7 D7 BB BB 7D 7D > } image } if PT 14 eq { 16 16 1 [ 16
-0 0 16 neg 0 16 ] { < 00 00 EE EF EE EF EE EF 0E E0 EE EE EE EE EE EE 00 EE
-FE EE FE EE FE EE 00 00 FE EF FE EF FE EF > } image } if PT 15 eq { 16 16 1 [
-16 0 0 16 neg 0 16 ] { < DD DD AA AA DD DD FF FF 77 77 AA AA 77 77 FF FF DD
-DD AA AA DD DD FF FF 77 77 AA AA 77 77 FF FF > } image } if PT 16 eq { 16 16
-1 [ 16 0 0 16 neg 0 16 ] { < F1 F1 EE EE 1F 1F FF FF F1 F1 EE EE 1F 1F FF FF
-F1 F1 EE EE 1F 1F FF FF F1 F1 EE EE 1F 1F FF FF > } image } if PT 17 eq { 16
-16 1 [ 16 0 0 16 neg 0 16 ] { < EE EE DD DD BB BB FF FF EE EE DD DD BB BB FF
- FF EE EE DD DD BB BB FF FF EE EE DD DD BB BB FF FF > } image } if PT 18 eq {
-16 16 1 [ 16 0 0 16 neg 0 16 ] { < BB BB DD DD EE EE FF FF BB BB DD DD EE EE
-FF FF BB BB DD DD EE EE FF FF BB BB DD DD EE EE FF FF > } image } if PT 19 eq
-{ 16 16 1 [ 16 0 0 16 neg 0 16 ] { < 1F FC 67 F3 7B EF BD DE BD DE DE BD E6
-B3 F8 0F E6 B3 DE BD BD DE BD DE 7B EF 67 F3 1F FC 7F FF > } image } if PT
-20 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < DD DD EE EE EE EE EE EE DD DD BB
-BB BB BB BB BB DD DD EE EE EE EE EE EE DD DD BB BB BB BB BB BB > } image }
-if PT 21 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < 0E 0E EF EF EF EF EF EF E0
-E0 FE FE FE FE FE FE 0E 0E EF EF EF EF EF EF E0 E0 FE FE FE FE FE FE > }
-image } if PT 22 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < 70 70 F7 F7 F7 F7 F7
-F7 07 07 7F 7F 7F 7F 7F 7F 70 70 F7 F7 F7 F7 F7 F7 07 07 7F 7F 7F 7F 7F 7F >
-} image } if PT 23 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < AA AA 55 55 A9 A9
-D1 D1 E1 E1 D1 D1 A9 A9 55 55 AA AA 55 55 A9 A9 D1 D1 E1 E1 D1 D1 A9 A9 55 55
-> } image } if PT 24 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < FF FE FF FC EA
-A8 D5 54 EA A8 D5 54 E8 28 D4 54 E8 E8 D4 D4 E8 EA 54 D5 A8 EA 54 D5 00 C0 00
-80 > } image } if PT 25 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < FF FE FF FC
-FF F8 FF F0 F0 00 F0 00 F0 20 F0 60 F0 E0 F1 E0 F3 E0 F0 00 E0 00 C0 00 80 00
-00 00 > } image } if gr } def /FA { /PT exch def gsave clip 0 0 translate 1 1
-54 { 1 sub 47.2 mul /Xcurr exch def 1 1 74 { 1 sub 47.2 mul /Ycurr exch def
-gsave Xcurr Ycurr translate PT DP gr } for } for gr } def
-/reencdict 24 dict def /ReEncode {reencdict begin /nco&na exch def
-/nfnam exch def /basefontname exch def /basefontdict basefontname findfont def
-/newfont basefontdict maxlength dict def basefontdict {exch dup /FID ne
-{dup /Encoding eq {exch dup length array copy newfont 3 1 roll put} {exch
-newfont 3 1 roll put} ifelse} {pop pop} ifelse } forall newfont
-/FontName nfnam put nco&na aload pop nco&na length 2 idiv {newfont
-/Encoding get 3 1 roll put} repeat nfnam newfont definefont pop end } def
-/accvec [ 176 /agrave 181 /Agrave 190 /acircumflex 192 /Acircumflex
-201 /adieresis 204 /Adieresis 209 /ccedilla 210 /Ccedilla 211 /eacute
-212 /Eacute 213 /egrave 214 /Egrave 215 /ecircumflex 216 /Ecircumflex
-217 /edieresis 218 /Edieresis 219 /icircumflex 220 /Icircumflex
-221 /idieresis 222 /Idieresis 223 /ntilde 224 /Ntilde 226 /ocircumflex
-228 /Ocircumflex 229 /odieresis 230 /Odieresis 231 /ucircumflex 236 /Ucircumflex
-237 /udieresis 238 /Udieresis 239 /aring 242 /Aring 243 /ydieresis
-244 /Ydieresis 246 /aacute 247 /Aacute 252 /ugrave 253 /Ugrave] def
-/Times-Roman /Times-Roman accvec ReEncode
-/Times-Italic /Times-Italic accvec ReEncode
-/Times-Bold /Times-Bold accvec ReEncode
-/Times-BoldItalic /Times-BoldItalic accvec ReEncode
-/Helvetica /Helvetica accvec ReEncode
-/Helvetica-Oblique /Helvetica-Oblique accvec ReEncode
-/Helvetica-Bold /Helvetica-Bold accvec ReEncode
-/Helvetica-BoldOblique /Helvetica-BoldOblique accvec ReEncode
-/Courier /Courier accvec ReEncode
-/Courier-Oblique /Courier-Oblique accvec ReEncode
-/Courier-Bold /Courier-Bold accvec ReEncode
-/Courier-BoldOblique /Courier-BoldOblique accvec ReEncode
-/oshow {gsave [] 0 sd true charpath stroke gr} def
-/stwn { /fs exch def /fn exch def /text exch def fn findfont fs sf
- text sw pop xs add /xs exch def} def
-/stwb { /fs exch def /fn exch def /nbas exch def /textf exch def
-textf length /tlen exch def nbas tlen gt {/nbas tlen def} if
-fn findfont fs sf textf dup length nbas sub nbas getinterval sw
-pop neg xs add /xs exch def} def
-/accspe [ 65 /plusminus 66 /bar 67 /existential 68 /universal
-69 /exclam 70 /numbersign 71 /greater 72 /question 73 /integral
-74 /colon 75 /semicolon 76 /less 77 /bracketleft 78 /bracketright
-79 /greaterequal 80 /braceleft 81 /braceright 82 /radical
-83 /spade 84 /heart 85 /diamond 86 /club 87 /lessequal
-88 /multiply 89 /percent 90 /infinity 48 /circlemultiply 49 /circleplus
-50 /emptyset 51 /lozenge 52 /bullet 53 /arrowright 54 /arrowup
-55 /arrowleft 56 /arrowdown 57 /arrowboth 48 /degree 44 /comma 43 /plus
- 45 /angle 42 /angleleft 47 /divide 61 /notequal 40 /equivalence 41 /second
- 97 /approxequal 98 /congruent 99 /perpendicular 100 /partialdiff 101 /florin
- 102 /intersection 103 /union 104 /propersuperset 105 /reflexsuperset
- 106 /notsubset 107 /propersubset 108 /reflexsubset 109 /element 110 /notelement
- 111 /gradient 112 /logicaland 113 /logicalor 114 /arrowdblboth
- 115 /arrowdblleft 116 /arrowdblup 117 /arrowdblright 118 /arrowdbldown
- 119 /ampersand 120 /omega1 121 /similar 122 /aleph ] def
-/Symbol /Special accspe ReEncode
-/Zone {/iy exch def /ix exch def ix 1 sub 2224 mul 1 iy sub 3144
- mul t} def
-%%EndProlog
- gsave 20 28 t .25 .25 scale gsave
-%%Page: number 1
- gsave
- 1 1 Zone
- gsave 0 0 t black [] 0 sd 1 lw 2223 2224 0 460 bl 2223 2224 0 460 C NC 1779
- 1778 222 683 bl 1779 1778 222 683 C 2223 2224 0 460 C 1066 539 m -15 Y 1 -4 d 3
- -2 d 4 X 3 2 d 5 4 d s 1082 539 m -21 Y s 1094 539 m -21 Y s 1094 530 m 1 5 d 3
- 3 d 3 1 d 5 X s 1113 539 m -21 Y s 1113 533 m 4 5 d 3 1 d 5 X 3 -1 d 1 -5 d -15
- Y s 1157 549 m -31 Y s 1157 535 m -3 3 d -2 1 d -5 X -3 -1 d -3 -3 d -1 -5 d -3
- Y 1 -4 d 3 -3 d 3 -2 d 5 X 2 2 d 3 3 d s 1779 1778 222 683 C 222 683 m 1600 Y
- 36 X -222 Y 35 X -39 Y 36 X -85 Y 36 X 203 Y 35 X -121 Y 36 X 67 Y 35 X -78 Y
- 36 X -23 Y 35 X 26 Y 36 X 8 Y 36 X -6 Y 35 X 147 Y 36 X -211 Y 35 X 81 Y 36 X
- -25 Y 35 X 67 Y 36 X 62 Y 36 X -64 Y 35 X 19 Y 36 X -28 Y 35 X 82 Y 36 X -37 Y
- 35 X 48 Y 36 X -138 Y 36 X -3 Y 35 X 51 Y 36 X -17 Y 35 X 3 Y 36 X 45 Y 35 X
- -51 Y 36 X 99 Y 35 X -12 Y 36 X -151 Y 36 X 115 Y 35 X -56 Y 71 X 39 Y 36 X 110
- Y 35 X -175 Y 36 X 26 Y 36 X -73 Y 35 X -130 Y 36 X -1153 Y 249 X s NC 222 683
- m 1778 Y s 256 683 m -34 X s 239 739 m -17 X s 239 795 m -17 X s 239 852 m -17
- X s 239 908 m -17 X s 256 964 m -34 X s 239 1020 m -17 X s 239 1077 m -17 X s
- 239 1133 m -17 X s 239 1189 m -17 X s 256 1245 m -34 X s 239 1302 m -17 X s 239
- 1358 m -17 X s 239 1414 m -17 X s 239 1470 m -17 X s 256 1527 m -34 X s 239
- 1583 m -17 X s 239 1639 m -17 X s 239 1695 m -17 X s 239 1752 m -17 X s 256
- 1808 m -34 X s 239 1864 m -17 X s 239 1920 m -17 X s 239 1977 m -17 X s 239
- 2033 m -17 X s 256 2089 m -34 X s 239 2146 m -17 X s 239 2202 m -17 X s 239
- 2258 m -17 X s 239 2314 m -17 X s 256 2371 m -34 X s 256 2371 m -34 X s 239
- 2427 m -17 X s 162 698 m -5 -1 d -3 -5 d -1 -7 d -4 Y 1 -8 d 3 -4 d 5 -2 d 3 X
- 4 2 d 3 4 d 1 8 d 4 Y -1 7 d -3 5 d -4 1 d -3 X cl s 98 974 m 3 1 d 4 5 d -31 Y
- s 132 980 m -5 -2 d -3 -4 d -1 -8 d -4 Y 1 -8 d 3 -4 d 5 -1 d 3 X 4 1 d 3 4 d 2
- 8 d 4 Y -2 8 d -3 4 d -4 2 d -3 X cl s 162 980 m -5 -2 d -3 -4 d -1 -8 d -4 Y 1
- -8 d 3 -4 d 5 -1 d 3 X 4 1 d 3 4 d 1 8 d 4 Y -1 8 d -3 4 d -4 2 d -3 X cl s 95
- 1254 m 1 Y 1 3 d 2 1 d 3 2 d 6 X 3 -2 d 1 -1 d 2 -3 d -3 Y -2 -3 d -3 -4 d -15
- -15 d 21 X s 132 1261 m -5 -2 d -3 -4 d -1 -7 d -5 Y 1 -7 d 3 -5 d 5 -1 d 3 X 4
- 1 d 3 5 d 2 7 d 5 Y -2 7 d -3 4 d -4 2 d -3 X cl s 162 1261 m -5 -2 d -3 -4 d
- -1 -7 d -5 Y 1 -7 d 3 -5 d 5 -1 d 3 X 4 1 d 3 5 d 1 7 d 5 Y -1 7 d -3 4 d -4 2
- d -3 X cl s 96 1542 m 17 X -9 -12 d 4 X 3 -1 d 2 -2 d 1 -4 d -3 Y -1 -4 d -3 -3
- d -5 -2 d -4 X -5 2 d -1 1 d -2 3 d s 132 1542 m -5 -1 d -3 -5 d -1 -7 d -5 Y 1
- -7 d 3 -4 d 5 -2 d 3 X 4 2 d 3 4 d 2 7 d 5 Y -2 7 d -3 5 d -4 1 d -3 X cl s 162
- 1542 m -5 -1 d -3 -5 d -1 -7 d -5 Y 1 -7 d 3 -4 d 5 -2 d 3 X 4 2 d 3 4 d 1 7 d
- 5 Y -1 7 d -3 5 d -4 1 d -3 X cl s 108 1824 m -15 -21 d 23 X s 108 1824 m -32 Y
- s 132 1824 m -5 -2 d -3 -4 d -1 -8 d -4 Y 1 -8 d 3 -4 d 5 -2 d 3 X 4 2 d 3 4 d
- 2 8 d 4 Y -2 8 d -3 4 d -4 2 d -3 X cl s 162 1824 m -5 -2 d -3 -4 d -1 -8 d -4
- Y 1 -8 d 3 -4 d 5 -2 d 3 X 4 2 d 3 4 d 1 8 d 4 Y -1 8 d -3 4 d -4 2 d -3 X cl s
- 111 2105 m -15 X -1 -14 d 1 2 d 5 1 d 4 X 5 -1 d 3 -3 d 1 -4 d -3 Y -1 -5 d -3
- -3 d -5 -1 d -4 X -5 1 d -1 2 d -2 3 d s 132 2105 m -5 -2 d -3 -4 d -1 -8 d -4
- Y 1 -7 d 3 -5 d 5 -1 d 3 X 4 1 d 3 5 d 2 7 d 4 Y -2 8 d -3 4 d -4 2 d -3 X cl s
- 162 2105 m -5 -2 d -3 -4 d -1 -8 d -4 Y 1 -7 d 3 -5 d 5 -1 d 3 X 4 1 d 3 5 d 1
- 7 d 4 Y -1 8 d -3 4 d -4 2 d -3 X cl s 113 2382 m -2 3 d -4 1 d -3 X -5 -1 d -3
- -5 d -1 -7 d -8 Y 1 -6 d 3 -3 d 5 -1 d 1 X 5 1 d 3 3 d 1 5 d 1 Y -1 5 d -3 3 d
- -5 1 d -1 X -5 -1 d -3 -3 d -1 -5 d s 132 2386 m -5 -1 d -3 -5 d -1 -7 d -5 Y 1
- -7 d 3 -5 d 5 -1 d 3 X 4 1 d 3 5 d 2 7 d 5 Y -2 7 d -3 5 d -4 1 d -3 X cl s 162
- 2386 m -5 -1 d -3 -5 d -1 -7 d -5 Y 1 -7 d 3 -5 d 5 -1 d 3 X 4 1 d 3 5 d 1 7 d
- 5 Y -1 7 d -3 5 d -4 1 d -3 X cl s 222 683 m 1779 X s 222 716 m -33 Y s 258 699
- m -16 Y s 293 699 m -16 Y s 329 699 m -16 Y s 365 699 m -16 Y s 400 716 m -33 Y
- s 436 699 m -16 Y s 471 699 m -16 Y s 507 699 m -16 Y s 542 699 m -16 Y s 578
- 716 m -33 Y s 614 699 m -16 Y s 649 699 m -16 Y s 685 699 m -16 Y s 720 699 m
- -16 Y s 756 716 m -33 Y s 791 699 m -16 Y s 827 699 m -16 Y s 863 699 m -16 Y s
- 898 699 m -16 Y s 934 716 m -33 Y s 969 699 m -16 Y s 1005 699 m -16 Y s 1040
- 699 m -16 Y s 1076 699 m -16 Y s 1112 716 m -33 Y s 1147 699 m -16 Y s 1183 699
- m -16 Y s 1218 699 m -16 Y s 1254 699 m -16 Y s 1289 716 m -33 Y s 1325 699 m
- -16 Y s 1360 699 m -16 Y s 1396 699 m -16 Y s 1432 699 m -16 Y s 1467 716 m -33
- Y s 1503 699 m -16 Y s 1538 699 m -16 Y s 1574 699 m -16 Y s 1609 699 m -16 Y s
- 1645 716 m -33 Y s 1681 699 m -16 Y s 1716 699 m -16 Y s 1752 699 m -16 Y s
- 1787 699 m -16 Y s 1823 716 m -33 Y s 1823 716 m -33 Y s 1858 699 m -16 Y s
- 1894 699 m -16 Y s 1930 699 m -16 Y s 1965 699 m -16 Y s 221 661 m -5 -2 d -3
- -4 d -1 -8 d -4 Y 1 -8 d 3 -4 d 5 -2 d 3 X 4 2 d 3 4 d 2 8 d 4 Y -2 8 d -3 4 d
- -4 2 d -3 X cl s 362 653 m 2 Y 1 3 d 2 1 d 3 2 d 5 X 3 -2 d 2 -1 d 1 -3 d -3 Y
- -1 -3 d -3 -5 d -15 -15 d 21 X s 408 661 m -15 X -2 -14 d 2 2 d 4 1 d 5 X 4 -1
- d 3 -3 d 2 -5 d -3 Y -2 -4 d -3 -3 d -4 -2 d -5 X -4 2 d -2 1 d -1 3 d s 428
- 661 m -4 -2 d -3 -4 d -2 -8 d -4 Y 2 -8 d 3 -4 d 4 -2 d 3 X 5 2 d 3 4 d 1 8 d 4
- Y -1 8 d -3 4 d -5 2 d -3 X cl s 556 661 m -15 X -2 -14 d 2 2 d 4 1 d 5 X 4 -1
- d 3 -3 d 2 -5 d -3 Y -2 -4 d -3 -3 d -4 -2 d -5 X -4 2 d -2 1 d -1 3 d s 577
- 661 m -5 -2 d -3 -4 d -1 -8 d -4 Y 1 -8 d 3 -4 d 5 -2 d 2 X 5 2 d 3 4 d 1 8 d 4
- Y -1 8 d -3 4 d -5 2 d -2 X cl s 606 661 m -4 -2 d -3 -4 d -2 -8 d -4 Y 2 -8 d
- 3 -4 d 4 -2 d 3 X 5 2 d 3 4 d 1 8 d 4 Y -1 8 d -3 4 d -5 2 d -3 X cl s 737 661
- m -15 -32 d s 716 661 m 21 X s 763 661 m -15 X -1 -14 d 1 2 d 5 1 d 4 X 5 -1 d
- 3 -3 d 1 -5 d -3 Y -1 -4 d -3 -3 d -5 -2 d -4 X -5 2 d -1 1 d -2 3 d s 784 661
- m -4 -2 d -3 -4 d -2 -8 d -4 Y 2 -8 d 3 -4 d 4 -2 d 3 X 4 2 d 3 4 d 2 8 d 4 Y
- -2 8 d -3 4 d -4 2 d -3 X cl s 883 655 m 3 1 d 5 5 d -32 Y s 917 661 m -4 -2 d
- -3 -4 d -2 -8 d -4 Y 2 -8 d 3 -4 d 4 -2 d 3 X 5 2 d 3 4 d 1 8 d 4 Y -1 8 d -3 4
- d -5 2 d -3 X cl s 947 661 m -4 -2 d -3 -4 d -2 -8 d -4 Y 2 -8 d 3 -4 d 4 -2 d
- 3 X 4 2 d 3 4 d 2 8 d 4 Y -2 8 d -3 4 d -4 2 d -3 X cl s 977 661 m -5 -2 d -3
- -4 d -1 -8 d -4 Y 1 -8 d 3 -4 d 5 -2 d 3 X 4 2 d 3 4 d 2 8 d 4 Y -2 8 d -3 4 d
- -4 2 d -3 X cl s 1061 655 m 3 1 d 5 5 d -32 Y s 1088 653 m 2 Y 1 3 d 2 1 d 3 2
- d 6 X 3 -2 d 1 -1 d 2 -3 d -3 Y -2 -3 d -3 -5 d -15 -15 d 21 X s 1134 661 m -15
- X -2 -14 d 2 2 d 4 1 d 5 X 4 -1 d 3 -3 d 2 -5 d -3 Y -2 -4 d -3 -3 d -4 -2 d -5
- X -4 2 d -2 1 d -1 3 d s 1154 661 m -4 -2 d -3 -4 d -1 -8 d -4 Y 1 -8 d 3 -4 d
- 4 -2 d 3 X 5 2 d 3 4 d 1 8 d 4 Y -1 8 d -3 4 d -5 2 d -3 X cl s 1239 655 m 3 1
- d 4 5 d -32 Y s 1282 661 m -15 X -1 -14 d 1 2 d 5 1 d 4 X 4 -1 d 3 -3 d 2 -5 d
- -3 Y -2 -4 d -3 -3 d -4 -2 d -4 X -5 2 d -1 1 d -2 3 d s 1303 661 m -5 -2 d -3
- -4 d -1 -8 d -4 Y 1 -8 d 3 -4 d 5 -2 d 3 X 4 2 d 3 4 d 2 8 d 4 Y -2 8 d -3 4 d
- -4 2 d -3 X cl s 1332 661 m -4 -2 d -3 -4 d -2 -8 d -4 Y 2 -8 d 3 -4 d 4 -2 d 3
- X 5 2 d 3 4 d 1 8 d 4 Y -1 8 d -3 4 d -5 2 d -3 X cl s 1417 655 m 3 1 d 4 5 d
- -32 Y s 1463 661 m -15 -32 d s 1442 661 m 21 X s 1489 661 m -14 X -2 -14 d 2 2
- d 4 1 d 4 X 5 -1 d 3 -3 d 1 -5 d -3 Y -1 -4 d -3 -3 d -5 -2 d -4 X -4 2 d -2 1
- d -1 3 d s 1510 661 m -4 -2 d -3 -4 d -2 -8 d -4 Y 2 -8 d 3 -4 d 4 -2 d 3 X 5 2
- d 3 4 d 1 8 d 4 Y -1 8 d -3 4 d -5 2 d -3 X cl s 1592 653 m 2 Y 1 3 d 2 1 d 3 2
- d 6 X 3 -2 d 1 -1 d 1 -3 d -3 Y -1 -3 d -3 -5 d -15 -15 d 21 X s 1629 661 m -5
- -2 d -3 -4 d -1 -8 d -4 Y 1 -8 d 3 -4 d 5 -2 d 3 X 4 2 d 3 4 d 2 8 d 4 Y -2 8 d
- -3 4 d -4 2 d -3 X cl s 1658 661 m -4 -2 d -3 -4 d -2 -8 d -4 Y 2 -8 d 3 -4 d 4
- -2 d 3 X 5 2 d 3 4 d 1 8 d 4 Y -1 8 d -3 4 d -5 2 d -3 X cl s 1688 661 m -4 -2
- d -3 -4 d -2 -8 d -4 Y 2 -8 d 3 -4 d 4 -2 d 3 X 4 2 d 3 4 d 2 8 d 4 Y -2 8 d -3
- 4 d -4 2 d -3 X cl s 1770 653 m 2 Y 1 3 d 1 1 d 3 2 d 6 X 3 -2 d 2 -1 d 1 -3 d
- -3 Y -1 -3 d -3 -5 d -15 -15 d 21 X s 1799 653 m 2 Y 2 3 d 1 1 d 3 2 d 6 X 3 -2
- d 1 -1 d 2 -3 d -3 Y -2 -3 d -2 -5 d -15 -15 d 20 X s 1845 661 m -15 X -1 -14 d
- 1 2 d 5 1 d 4 X 5 -1 d 3 -3 d 1 -5 d -3 Y -1 -4 d -3 -3 d -5 -2 d -4 X -5 2 d
- -1 1 d -2 3 d s 1866 661 m -5 -2 d -3 -4 d -1 -8 d -4 Y 1 -8 d 3 -4 d 5 -2 d 3
- X 4 2 d 3 4 d 2 8 d 4 Y -2 8 d -3 4 d -4 2 d -3 X cl s 1778 588 m 16 -21 d s
- 1794 588 m -16 -21 d s 1822 592 m 3 2 d 5 4 d -31 Y s 1856 598 m -4 -1 d -3 -5
- d -2 -7 d -4 Y 2 -8 d 3 -4 d 4 -2 d 3 X 5 2 d 3 4 d 1 8 d 4 Y -1 7 d -3 5 d -5
- 1 d -3 X cl s 1892 620 m -1 2 d -4 1 d -2 X -3 -1 d -3 -4 d -1 -5 d -6 Y 1 -5 d
- 3 -2 d 3 -2 d 1 X 4 2 d 2 2 d 1 3 d 2 Y -1 3 d -2 3 d -4 1 d -1 X -3 -1 d -3 -3
- d -1 -3 d s 1779 1778 222 683 C gr
-showpage
- gr
-%%Trailer
-%%Pages: 1
- gr gr
-%%EOF
diff --git a/src/pawlib/paw/testsuite/paw.commands/nt_pl_1d_6.ref.ps b/src/pawlib/paw/testsuite/paw.commands/nt_pl_1d_6.ref.ps
deleted file mode 100644
index 48c36f0..0000000
--- a/src/pawlib/paw/testsuite/paw.commands/nt_pl_1d_6.ref.ps
+++ /dev/null
@@ -1,274 +0,0 @@
-%!PS-Adobe-2.0
-%%Title: /disk3/maartenb/cerncvs/paw/testsuite/tmp/nt_pl_1d_ (Portrait A 4)
-%%Pages: (atend)
-%%Creator: HIGZ Version 1.23/06
-%%CreationDate: 96/04/16 14.40
-%%EndComments
-%%BeginProlog
-/s {stroke} def /l {lineto} def /m {moveto} def /t {translate} def
-/sw {stringwidth} def /r {rotate} def /rl {roll} def /R {repeat} def
-/d {rlineto} def /rm {rmoveto} def /gr {grestore} def /f {eofill} def
-/c {setrgbcolor} def /lw {setlinewidth} def /sd {setdash} def
-/cl {closepath} def /sf {scalefont setfont} def /black {0 setgray} def
-/box {m dup 0 exch d exch 0 d 0 exch neg d cl} def
-/NC{systemdict begin initclip end}def/C{NC box clip newpath}def
-/bl {box s} def /bf {box f} def /Y { 0 exch d} def /X { 0 d} def
-/mp {newpath /y exch def /x exch def} def
-/side {[w .77 mul w .23 mul] .385 w mul sd w 0 l currentpoint t -144 r} def
-/mr {mp x y w2 0 360 arc} def /m24 {mr s} def /m20 {mr f} def
-/mb {mp x y w2 add m w2 neg 0 d 0 w neg d w 0 d 0 w d cl} def
-/mt {mp x y w2 add m w2 neg w neg d w 0 d cl} def
-/m21 {mb f} def /m25 {mb s} def /m22 {mt f} def /m26 {mt s} def
-/m23 {mp x y w2 sub m w2 w d w neg 0 d cl f} def
-/m27 {mp x y w2 add m w3 neg w2 neg d w3 w2 neg d w3 w2 d cl s} def
-/m28 {mp x w2 sub y w2 sub w3 add m w3 0 d 0 w3 neg d w3 0 d 0 w3 d w3 0 d
- 0 w3 d w3 neg 0 d 0 w3 d w3 neg 0 d
- 0 w3 neg d w3 neg 0 d cl s } def
-/m29 {mp gsave x w2 sub y w2 add w3 sub m currentpoint t
- 4 {side} repeat cl fill gr} def
-/m30 {mp gsave x w2 sub y w2 add w3 sub m currentpoint t
- 5 {side} repeat s gr} def
-/m31 {mp x y w2 sub m 0 w d x w2 sub y m w 0 d
- x w2 sub y w2 add m w w neg d x w2 sub y w2
- sub m w w d s} def
-/m2 {mp x y w2 sub m 0 w d x w2 sub y m w 0 d s} def
-/m5 {mp x w2 sub y w2 sub m w w d x w2 sub y w2 add m w w neg d s} def
-/DP {/PT exch def gsave 47.2 47.2 scale PT 1 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < AA AA 55 55 AA AA 55 55 AA AA 55 55 AA AA 55 55 AA AA 55 55 AA AA 55 55
-AA AA 55 55 AA AA 55 55 > } image } if PT 2 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < BB BB EE EE BB BB EE EE BB BB EE EE BB BB EE EE BB BB EE EE BB BB EE EE
-BB BB EE EE BB BB EE EE > } image } if PT 3 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < FF FF BB BB FF FF EE EE FF FF BB BB FF FF EE EE FF FF BB BB FF FF EE EE
-FF FF BB BB FF FF EE EE > } image } if PT 4 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < DF DF BF BF 7F 7F FE FE FD FD FB FB F7 F7 EF EF DF DF BF BF 7F 7F FE FE
-FD FD FB FB F7 F7 EF EF > } image } if PT 5 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < 7F 7F BF B F DF DF EF EF F7 F7 FB FB FD FD FE FE 7F 7F BF BF DF DF EF
-EF F7 F7 FB FB FD FD FE FE > } image } if PT 6 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB
-BB BB BB BB BB BB BB BB BB > } image } if PT 7 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < FF FF FF FF FF FF 00 00 FF FF FF FF FF FF 00 00 FF FF FF FF FF FF 00
-00 FF FF FF FF FF FF 00 00 > } image } if PT 8 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < EE EE 47 47 83 83 C5 C5 EE EE 5C 5C 38 38 74 74 EE EE 47 47 83 83 C5
-C5 EE EE 5C 5C 38 38 74 74 > } image } if PT 9 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < EF EF EF EF D7 D7 38 38 FE FE FE FE 7D 7D 83 83 EF EF EF EF D7 D7 38
-38 FE FE FE FE 7D 7D 83 83 > } image } if PT 10 eq { 16 16 1 [ 16 0 0 16 neg
-0 16 ] { < EF EF EF EF EF EF 00 00 FE FE FE FE FE FE 00 00 EF EF EF EF EF EF
-00 00 FE FE FE FE FE FE 00 00 > } image } if PT 11 eq { 16 16 1 [ 16 0 0 16
-neg 0 16 ] { < F7 F7 B6 B6 D5 D5 E3 E3 D5 D5 B6 B6 F7 F7 FF FF 7F 7F 6B 6B 5D
-5D 3E 3E 5D 5D 6B 6B 7F 7F FF FF > } image } if PT 12 eq { 16 16 1 [ 16 0 0
-16 neg 0 16 ] { < E3 E3 DD DD BE BE BE BE BE BE DD DD E3 E3 FF FF 3E 3E DD DD
-EB EB EB EB EB EB DD DD 3E 3E FF FF > } image } if PT 13 eq { 16 16 1 [ 16 0
-0 16 neg 0 16 ] { < FE FE 7D 7D BB BB D7 D7 EF EF D7 D7 BB BB 7D 7D FE FE 7D
-7D BB BB D7 D7 EF EF D7 D7 BB BB 7D 7D > } image } if PT 14 eq { 16 16 1 [ 16
-0 0 16 neg 0 16 ] { < 00 00 EE EF EE EF EE EF 0E E0 EE EE EE EE EE EE 00 EE
-FE EE FE EE FE EE 00 00 FE EF FE EF FE EF > } image } if PT 15 eq { 16 16 1 [
-16 0 0 16 neg 0 16 ] { < DD DD AA AA DD DD FF FF 77 77 AA AA 77 77 FF FF DD
-DD AA AA DD DD FF FF 77 77 AA AA 77 77 FF FF > } image } if PT 16 eq { 16 16
-1 [ 16 0 0 16 neg 0 16 ] { < F1 F1 EE EE 1F 1F FF FF F1 F1 EE EE 1F 1F FF FF
-F1 F1 EE EE 1F 1F FF FF F1 F1 EE EE 1F 1F FF FF > } image } if PT 17 eq { 16
-16 1 [ 16 0 0 16 neg 0 16 ] { < EE EE DD DD BB BB FF FF EE EE DD DD BB BB FF
- FF EE EE DD DD BB BB FF FF EE EE DD DD BB BB FF FF > } image } if PT 18 eq {
-16 16 1 [ 16 0 0 16 neg 0 16 ] { < BB BB DD DD EE EE FF FF BB BB DD DD EE EE
-FF FF BB BB DD DD EE EE FF FF BB BB DD DD EE EE FF FF > } image } if PT 19 eq
-{ 16 16 1 [ 16 0 0 16 neg 0 16 ] { < 1F FC 67 F3 7B EF BD DE BD DE DE BD E6
-B3 F8 0F E6 B3 DE BD BD DE BD DE 7B EF 67 F3 1F FC 7F FF > } image } if PT
-20 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < DD DD EE EE EE EE EE EE DD DD BB
-BB BB BB BB BB DD DD EE EE EE EE EE EE DD DD BB BB BB BB BB BB > } image }
-if PT 21 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < 0E 0E EF EF EF EF EF EF E0
-E0 FE FE FE FE FE FE 0E 0E EF EF EF EF EF EF E0 E0 FE FE FE FE FE FE > }
-image } if PT 22 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < 70 70 F7 F7 F7 F7 F7
-F7 07 07 7F 7F 7F 7F 7F 7F 70 70 F7 F7 F7 F7 F7 F7 07 07 7F 7F 7F 7F 7F 7F >
-} image } if PT 23 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < AA AA 55 55 A9 A9
-D1 D1 E1 E1 D1 D1 A9 A9 55 55 AA AA 55 55 A9 A9 D1 D1 E1 E1 D1 D1 A9 A9 55 55
-> } image } if PT 24 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < FF FE FF FC EA
-A8 D5 54 EA A8 D5 54 E8 28 D4 54 E8 E8 D4 D4 E8 EA 54 D5 A8 EA 54 D5 00 C0 00
-80 > } image } if PT 25 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < FF FE FF FC
-FF F8 FF F0 F0 00 F0 00 F0 20 F0 60 F0 E0 F1 E0 F3 E0 F0 00 E0 00 C0 00 80 00
-00 00 > } image } if gr } def /FA { /PT exch def gsave clip 0 0 translate 1 1
-54 { 1 sub 47.2 mul /Xcurr exch def 1 1 74 { 1 sub 47.2 mul /Ycurr exch def
-gsave Xcurr Ycurr translate PT DP gr } for } for gr } def
-/reencdict 24 dict def /ReEncode {reencdict begin /nco&na exch def
-/nfnam exch def /basefontname exch def /basefontdict basefontname findfont def
-/newfont basefontdict maxlength dict def basefontdict {exch dup /FID ne
-{dup /Encoding eq {exch dup length array copy newfont 3 1 roll put} {exch
-newfont 3 1 roll put} ifelse} {pop pop} ifelse } forall newfont
-/FontName nfnam put nco&na aload pop nco&na length 2 idiv {newfont
-/Encoding get 3 1 roll put} repeat nfnam newfont definefont pop end } def
-/accvec [ 176 /agrave 181 /Agrave 190 /acircumflex 192 /Acircumflex
-201 /adieresis 204 /Adieresis 209 /ccedilla 210 /Ccedilla 211 /eacute
-212 /Eacute 213 /egrave 214 /Egrave 215 /ecircumflex 216 /Ecircumflex
-217 /edieresis 218 /Edieresis 219 /icircumflex 220 /Icircumflex
-221 /idieresis 222 /Idieresis 223 /ntilde 224 /Ntilde 226 /ocircumflex
-228 /Ocircumflex 229 /odieresis 230 /Odieresis 231 /ucircumflex 236 /Ucircumflex
-237 /udieresis 238 /Udieresis 239 /aring 242 /Aring 243 /ydieresis
-244 /Ydieresis 246 /aacute 247 /Aacute 252 /ugrave 253 /Ugrave] def
-/Times-Roman /Times-Roman accvec ReEncode
-/Times-Italic /Times-Italic accvec ReEncode
-/Times-Bold /Times-Bold accvec ReEncode
-/Times-BoldItalic /Times-BoldItalic accvec ReEncode
-/Helvetica /Helvetica accvec ReEncode
-/Helvetica-Oblique /Helvetica-Oblique accvec ReEncode
-/Helvetica-Bold /Helvetica-Bold accvec ReEncode
-/Helvetica-BoldOblique /Helvetica-BoldOblique accvec ReEncode
-/Courier /Courier accvec ReEncode
-/Courier-Oblique /Courier-Oblique accvec ReEncode
-/Courier-Bold /Courier-Bold accvec ReEncode
-/Courier-BoldOblique /Courier-BoldOblique accvec ReEncode
-/oshow {gsave [] 0 sd true charpath stroke gr} def
-/stwn { /fs exch def /fn exch def /text exch def fn findfont fs sf
- text sw pop xs add /xs exch def} def
-/stwb { /fs exch def /fn exch def /nbas exch def /textf exch def
-textf length /tlen exch def nbas tlen gt {/nbas tlen def} if
-fn findfont fs sf textf dup length nbas sub nbas getinterval sw
-pop neg xs add /xs exch def} def
-/accspe [ 65 /plusminus 66 /bar 67 /existential 68 /universal
-69 /exclam 70 /numbersign 71 /greater 72 /question 73 /integral
-74 /colon 75 /semicolon 76 /less 77 /bracketleft 78 /bracketright
-79 /greaterequal 80 /braceleft 81 /braceright 82 /radical
-83 /spade 84 /heart 85 /diamond 86 /club 87 /lessequal
-88 /multiply 89 /percent 90 /infinity 48 /circlemultiply 49 /circleplus
-50 /emptyset 51 /lozenge 52 /bullet 53 /arrowright 54 /arrowup
-55 /arrowleft 56 /arrowdown 57 /arrowboth 48 /degree 44 /comma 43 /plus
- 45 /angle 42 /angleleft 47 /divide 61 /notequal 40 /equivalence 41 /second
- 97 /approxequal 98 /congruent 99 /perpendicular 100 /partialdiff 101 /florin
- 102 /intersection 103 /union 104 /propersuperset 105 /reflexsuperset
- 106 /notsubset 107 /propersubset 108 /reflexsubset 109 /element 110 /notelement
- 111 /gradient 112 /logicaland 113 /logicalor 114 /arrowdblboth
- 115 /arrowdblleft 116 /arrowdblup 117 /arrowdblright 118 /arrowdbldown
- 119 /ampersand 120 /omega1 121 /similar 122 /aleph ] def
-/Symbol /Special accspe ReEncode
-/Zone {/iy exch def /ix exch def ix 1 sub 2224 mul 1 iy sub 3144
- mul t} def
-%%EndProlog
- gsave 20 28 t .25 .25 scale gsave
-%%Page: number 1
- gsave
- 1 1 Zone
- gsave 0 0 t black [] 0 sd 1 lw 2223 2224 0 460 bl 2223 2224 0 460 C NC 1779
- 1778 222 683 bl 1779 1778 222 683 C 2223 2224 0 460 C 1072 549 m 2 -1 d 1 1 d
- -1 2 d -2 -2 d cl s 1074 539 m -21 Y s 1086 539 m -21 Y s 1086 530 m 1 5 d 3 3
- d 3 1 d 4 X s 1105 539 m -21 Y s 1105 533 m 4 5 d 3 1 d 5 X 3 -1 d 1 -5 d -15 Y
- s 1149 549 m -31 Y s 1149 535 m -3 3 d -3 1 d -4 X -3 -1 d -3 -3 d -1 -5 d -3 Y
- 1 -4 d 3 -3 d 3 -2 d 4 X 3 2 d 3 3 d s 1779 1778 222 683 C 222 683 m 125 X 1376
- Y 18 X -11 Y 17 X -11 Y 18 X -37 Y 18 X 85 Y 18 X -96 Y 17 X -11 Y 18 X 16 Y 18
- X -123 Y 18 X 150 Y 18 X -11 Y 17 X -123 Y 18 X 182 Y 18 X -59 Y 18 X -69 Y 18
- X 37 Y 17 X 64 Y 18 X 86 Y 18 X -268 Y 18 X 338 Y 17 X -241 Y 18 X 198 Y 18 X
- -241 Y 18 X 70 Y 18 X -81 Y 17 X 150 Y 18 X -96 Y 18 X 102 Y 18 X -145 Y 18 X
- 59 Y 17 X 16 Y 18 X 70 Y 18 X -140 Y 18 X 257 Y 17 X -85 Y 18 X -214 Y 18 X 96
- Y 18 X 96 Y 18 X -101 Y 17 X -182 Y 18 X 144 Y 18 X -43 Y 18 X -48 Y 18 X 289 Y
- 17 X 155 Y 18 X -358 Y 18 X 139 Y 18 X -166 Y 17 X 118 Y 18 X -38 Y 18 X -203 Y
- 18 X 284 Y 18 X 21 Y 17 X -209 Y 18 X 166 Y 18 X -5 Y 18 X -27 Y 17 X -91 Y 18
- X 59 Y 18 X -64 Y 18 X 26 Y 18 X 156 Y 17 X -289 Y 18 X 155 Y 18 X -6 Y 18 X 75
- Y 18 X -155 Y 17 X 177 Y 18 X 80 Y 18 X -225 Y 18 X -32 Y 17 X 123 Y 18 X -59 Y
- 36 X 11 Y 18 X -21 Y 17 X 160 Y 18 X -37 Y 18 X 32 Y 18 X -166 Y 18 X 177 Y 17
- X -38 Y 18 X -64 Y 36 X 11 Y 17 X -16 Y 18 X -1301 Y 125 X s NC 222 683 m 1778
- Y s 256 683 m -34 X s 239 736 m -17 X s 239 790 m -17 X s 239 843 m -17 X s 239
- 897 m -17 X s 256 950 m -34 X s 239 1004 m -17 X s 239 1058 m -17 X s 239 1111
- m -17 X s 239 1165 m -17 X s 256 1218 m -34 X s 239 1272 m -17 X s 239 1325 m
- -17 X s 239 1379 m -17 X s 239 1432 m -17 X s 256 1486 m -34 X s 239 1539 m -17
- X s 239 1593 m -17 X s 239 1646 m -17 X s 239 1700 m -17 X s 256 1753 m -34 X s
- 239 1807 m -17 X s 239 1860 m -17 X s 239 1914 m -17 X s 239 1968 m -17 X s 256
- 2021 m -34 X s 239 2075 m -17 X s 239 2128 m -17 X s 239 2182 m -17 X s 239
- 2235 m -17 X s 256 2289 m -34 X s 256 2289 m -34 X s 239 2342 m -17 X s 239
- 2396 m -17 X s 239 2449 m -17 X s 162 698 m -5 -1 d -3 -5 d -1 -7 d -4 Y 1 -8 d
- 3 -4 d 5 -2 d 3 X 4 2 d 3 4 d 1 8 d 4 Y -1 7 d -3 5 d -4 1 d -3 X cl s 141 966
- m -15 X -2 -13 d 2 1 d 4 2 d 5 X 4 -2 d 3 -3 d 2 -4 d -3 Y -2 -5 d -3 -3 d -4
- -1 d -5 X -4 1 d -2 2 d -1 3 d s 162 966 m -5 -1 d -3 -5 d -1 -7 d -5 Y 1 -7 d
- 3 -5 d 5 -1 d 3 X 4 1 d 3 5 d 1 7 d 5 Y -1 7 d -3 5 d -4 1 d -3 X cl s 98 1228
- m 3 1 d 4 5 d -31 Y s 132 1234 m -5 -2 d -3 -4 d -1 -8 d -4 Y 1 -8 d 3 -4 d 5
- -1 d 3 X 4 1 d 3 4 d 2 8 d 4 Y -2 8 d -3 4 d -4 2 d -3 X cl s 162 1234 m -5 -2
- d -3 -4 d -1 -8 d -4 Y 1 -8 d 3 -4 d 5 -1 d 3 X 4 1 d 3 4 d 1 8 d 4 Y -1 8 d -3
- 4 d -4 2 d -3 X cl s 98 1495 m 3 2 d 4 4 d -31 Y s 141 1501 m -15 X -2 -13 d 2
- 1 d 4 2 d 5 X 4 -2 d 3 -3 d 2 -4 d -3 Y -2 -4 d -3 -3 d -4 -2 d -5 X -4 2 d -2
- 1 d -1 3 d s 162 1501 m -5 -1 d -3 -5 d -1 -7 d -4 Y 1 -8 d 3 -4 d 5 -2 d 3 X 4
- 2 d 3 4 d 1 8 d 4 Y -1 7 d -3 5 d -4 1 d -3 X cl s 95 1762 m 1 Y 1 3 d 2 1 d 3
- 2 d 6 X 3 -2 d 1 -1 d 2 -3 d -3 Y -2 -3 d -3 -4 d -15 -15 d 21 X s 132 1769 m
- -5 -2 d -3 -4 d -1 -7 d -5 Y 1 -7 d 3 -5 d 5 -1 d 3 X 4 1 d 3 5 d 2 7 d 5 Y -2
- 7 d -3 4 d -4 2 d -3 X cl s 162 1769 m -5 -2 d -3 -4 d -1 -7 d -5 Y 1 -7 d 3 -5
- d 5 -1 d 3 X 4 1 d 3 5 d 1 7 d 5 Y -1 7 d -3 4 d -4 2 d -3 X cl s 95 2029 m 2 Y
- 1 3 d 2 1 d 3 2 d 6 X 3 -2 d 1 -1 d 2 -3 d -3 Y -2 -3 d -3 -5 d -15 -14 d 21 X
- s 141 2037 m -15 X -2 -14 d 2 2 d 4 1 d 5 X 4 -1 d 3 -3 d 2 -5 d -3 Y -2 -4 d
- -3 -3 d -4 -1 d -5 X -4 1 d -2 1 d -1 3 d s 162 2037 m -5 -2 d -3 -4 d -1 -8 d
- -4 Y 1 -8 d 3 -4 d 5 -1 d 3 X 4 1 d 3 4 d 1 8 d 4 Y -1 8 d -3 4 d -4 2 d -3 X
- cl s 96 2304 m 17 X -9 -12 d 4 X 3 -1 d 2 -2 d 1 -4 d -3 Y -1 -4 d -3 -3 d -5
- -2 d -4 X -5 2 d -1 1 d -2 3 d s 132 2304 m -5 -1 d -3 -5 d -1 -7 d -5 Y 1 -7 d
- 3 -4 d 5 -2 d 3 X 4 2 d 3 4 d 2 7 d 5 Y -2 7 d -3 5 d -4 1 d -3 X cl s 162 2304
- m -5 -1 d -3 -5 d -1 -7 d -5 Y 1 -7 d 3 -4 d 5 -2 d 3 X 4 2 d 3 4 d 1 7 d 5 Y
- -1 7 d -3 5 d -4 1 d -3 X cl s 222 683 m 1779 X s 222 716 m -33 Y s 258 699 m
- -16 Y s 293 699 m -16 Y s 329 699 m -16 Y s 365 699 m -16 Y s 400 716 m -33 Y s
- 436 699 m -16 Y s 471 699 m -16 Y s 507 699 m -16 Y s 542 699 m -16 Y s 578 716
- m -33 Y s 614 699 m -16 Y s 649 699 m -16 Y s 685 699 m -16 Y s 720 699 m -16 Y
- s 756 716 m -33 Y s 791 699 m -16 Y s 827 699 m -16 Y s 863 699 m -16 Y s 898
- 699 m -16 Y s 934 716 m -33 Y s 969 699 m -16 Y s 1005 699 m -16 Y s 1040 699 m
- -16 Y s 1076 699 m -16 Y s 1112 716 m -33 Y s 1147 699 m -16 Y s 1183 699 m -16
- Y s 1218 699 m -16 Y s 1254 699 m -16 Y s 1289 716 m -33 Y s 1325 699 m -16 Y s
- 1360 699 m -16 Y s 1396 699 m -16 Y s 1432 699 m -16 Y s 1467 716 m -33 Y s
- 1503 699 m -16 Y s 1538 699 m -16 Y s 1574 699 m -16 Y s 1609 699 m -16 Y s
- 1645 716 m -33 Y s 1681 699 m -16 Y s 1716 699 m -16 Y s 1752 699 m -16 Y s
- 1787 699 m -16 Y s 1823 716 m -33 Y s 1858 699 m -16 Y s 1894 699 m -16 Y s
- 1930 699 m -16 Y s 1965 699 m -16 Y s 2001 716 m -33 Y s 150 643 m 26 X s 188
- 653 m 2 Y 2 3 d 1 1 d 3 2 d 6 X 3 -2 d 2 -1 d 1 -3 d -3 Y -1 -3 d -3 -5 d -15
- -15 d 20 X s 234 661 m -15 X -1 -14 d 1 2 d 5 1 d 4 X 5 -1 d 3 -3 d 1 -5 d -3 Y
- -1 -4 d -3 -3 d -5 -2 d -4 X -5 2 d -1 1 d -2 3 d s 255 661 m -5 -2 d -3 -4 d
- -1 -8 d -4 Y 1 -8 d 3 -4 d 5 -2 d 3 X 4 2 d 3 4 d 2 8 d 4 Y -2 8 d -3 4 d -4 2
- d -3 X cl s 285 661 m -5 -2 d -3 -4 d -1 -8 d -4 Y 1 -8 d 3 -4 d 5 -2 d 3 X 4 2
- d 3 4 d 1 8 d 4 Y -1 8 d -3 4 d -4 2 d -3 X cl s 328 643 m 26 X s 366 653 m 2 Y
- 2 3 d 1 1 d 3 2 d 6 X 3 -2 d 1 -1 d 2 -3 d -3 Y -2 -3 d -3 -5 d -14 -15 d 20 X
- s 403 661 m -4 -2 d -3 -4 d -2 -8 d -4 Y 2 -8 d 3 -4 d 4 -2 d 3 X 5 2 d 2 4 d 2
- 8 d 4 Y -2 8 d -2 4 d -5 2 d -3 X cl s 433 661 m -5 -2 d -3 -4 d -1 -8 d -4 Y 1
- -8 d 3 -4 d 5 -2 d 3 X 4 2 d 3 4 d 2 8 d 4 Y -2 8 d -3 4 d -4 2 d -3 X cl s 462
- 661 m -4 -2 d -3 -4 d -2 -8 d -4 Y 2 -8 d 3 -4 d 4 -2 d 3 X 5 2 d 3 4 d 1 8 d 4
- Y -1 8 d -3 4 d -5 2 d -3 X cl s 505 643 m 27 X s 547 655 m 3 1 d 4 5 d -32 Y s
- 590 661 m -15 X -1 -14 d 1 2 d 4 1 d 5 X 4 -1 d 3 -3 d 2 -5 d -3 Y -2 -4 d -3
- -3 d -4 -2 d -5 X -4 2 d -1 1 d -2 3 d s 611 661 m -5 -2 d -3 -4 d -1 -8 d -4 Y
- 1 -8 d 3 -4 d 5 -2 d 3 X 4 2 d 3 4 d 1 8 d 4 Y -1 8 d -3 4 d -4 2 d -3 X cl s
- 640 661 m -4 -2 d -3 -4 d -2 -8 d -4 Y 2 -8 d 3 -4 d 4 -2 d 3 X 5 2 d 3 4 d 1 8
- d 4 Y -1 8 d -3 4 d -5 2 d -3 X cl s 683 643 m 27 X s 725 655 m 3 1 d 4 5 d -32
- Y s 759 661 m -5 -2 d -3 -4 d -1 -8 d -4 Y 1 -8 d 3 -4 d 5 -2 d 3 X 4 2 d 3 4 d
- 2 8 d 4 Y -2 8 d -3 4 d -4 2 d -3 X cl s 788 661 m -4 -2 d -3 -4 d -1 -8 d -4 Y
- 1 -8 d 3 -4 d 4 -2 d 3 X 5 2 d 3 4 d 1 8 d 4 Y -1 8 d -3 4 d -5 2 d -3 X cl s
- 818 661 m -4 -2 d -3 -4 d -2 -8 d -4 Y 2 -8 d 3 -4 d 4 -2 d 3 X 4 2 d 3 4 d 2 8
- d 4 Y -2 8 d -3 4 d -4 2 d -3 X cl s 876 643 m 27 X s 931 661 m -15 X -2 -14 d
- 2 2 d 4 1 d 5 X 4 -1 d 3 -3 d 2 -5 d -3 Y -2 -4 d -3 -3 d -4 -2 d -5 X -4 2 d
- -2 1 d -1 3 d s 951 661 m -4 -2 d -3 -4 d -1 -8 d -4 Y 1 -8 d 3 -4 d 4 -2 d 3 X
- 5 2 d 3 4 d 1 8 d 4 Y -1 8 d -3 4 d -5 2 d -3 X cl s 981 661 m -4 -2 d -3 -4 d
- -2 -8 d -4 Y 2 -8 d 3 -4 d 4 -2 d 3 X 5 2 d 2 4 d 2 8 d 4 Y -2 8 d -2 4 d -5 2
- d -3 X cl s 1110 661 m -4 -2 d -3 -4 d -2 -8 d -4 Y 2 -8 d 3 -4 d 4 -2 d 3 X 4
- 2 d 3 4 d 2 8 d 4 Y -2 8 d -3 4 d -4 2 d -3 X cl s 1267 661 m -15 X -1 -14 d 1
- 2 d 5 1 d 4 X 5 -1 d 3 -3 d 1 -5 d -3 Y -1 -4 d -3 -3 d -5 -2 d -4 X -5 2 d -1
- 1 d -2 3 d s 1288 661 m -5 -2 d -3 -4 d -1 -8 d -4 Y 1 -8 d 3 -4 d 5 -2 d 3 X 4
- 2 d 3 4 d 2 8 d 4 Y -2 8 d -3 4 d -4 2 d -3 X cl s 1318 661 m -5 -2 d -3 -4 d
- -1 -8 d -4 Y 1 -8 d 3 -4 d 5 -2 d 2 X 5 2 d 3 4 d 1 8 d 4 Y -1 8 d -3 4 d -5 2
- d -2 X cl s 1417 655 m 3 1 d 4 5 d -32 Y s 1451 661 m -5 -2 d -3 -4 d -1 -8 d
- -4 Y 1 -8 d 3 -4 d 5 -2 d 3 X 4 2 d 3 4 d 2 8 d 4 Y -2 8 d -3 4 d -4 2 d -3 X
- cl s 1481 661 m -5 -2 d -3 -4 d -1 -8 d -4 Y 1 -8 d 3 -4 d 5 -2 d 2 X 5 2 d 3 4
- d 1 8 d 4 Y -1 8 d -3 4 d -5 2 d -2 X cl s 1510 661 m -4 -2 d -3 -4 d -2 -8 d
- -4 Y 2 -8 d 3 -4 d 4 -2 d 3 X 5 2 d 3 4 d 1 8 d 4 Y -1 8 d -3 4 d -5 2 d -3 X
- cl s 1595 655 m 3 1 d 4 5 d -32 Y s 1638 661 m -15 X -2 -14 d 2 2 d 4 1 d 5 X 4
- -1 d 3 -3 d 2 -5 d -3 Y -2 -4 d -3 -3 d -4 -2 d -5 X -4 2 d -2 1 d -1 3 d s
- 1658 661 m -4 -2 d -3 -4 d -2 -8 d -4 Y 2 -8 d 3 -4 d 4 -2 d 3 X 5 2 d 3 4 d 1
- 8 d 4 Y -1 8 d -3 4 d -5 2 d -3 X cl s 1688 661 m -4 -2 d -3 -4 d -2 -8 d -4 Y
- 2 -8 d 3 -4 d 4 -2 d 3 X 4 2 d 3 4 d 2 8 d 4 Y -2 8 d -3 4 d -4 2 d -3 X cl s
- 1770 653 m 2 Y 1 3 d 1 1 d 3 2 d 6 X 3 -2 d 2 -1 d 1 -3 d -3 Y -1 -3 d -3 -5 d
- -15 -15 d 21 X s 1807 661 m -5 -2 d -3 -4 d -1 -8 d -4 Y 1 -8 d 3 -4 d 5 -2 d 3
- X 4 2 d 3 4 d 1 8 d 4 Y -1 8 d -3 4 d -4 2 d -3 X cl s 1836 661 m -4 -2 d -3 -4
- d -2 -8 d -4 Y 2 -8 d 3 -4 d 4 -2 d 3 X 5 2 d 3 4 d 1 8 d 4 Y -1 8 d -3 4 d -5
- 2 d -3 X cl s 1866 661 m -5 -2 d -3 -4 d -1 -8 d -4 Y 1 -8 d 3 -4 d 5 -2 d 3 X
- 4 2 d 3 4 d 2 8 d 4 Y -2 8 d -3 4 d -4 2 d -3 X cl s 1947 653 m 2 Y 2 3 d 1 1 d
- 3 2 d 6 X 3 -2 d 2 -1 d 1 -3 d -3 Y -1 -3 d -3 -5 d -15 -15 d 21 X s 1993 661 m
- -15 X -1 -14 d 1 2 d 5 1 d 4 X 5 -1 d 3 -3 d 1 -5 d -3 Y -1 -4 d -3 -3 d -5 -2
- d -4 X -5 2 d -1 1 d -1 3 d s 2014 661 m -4 -2 d -3 -4 d -2 -8 d -4 Y 2 -8 d 3
- -4 d 4 -2 d 3 X 4 2 d 3 4 d 2 8 d 4 Y -2 8 d -3 4 d -4 2 d -3 X cl s 2044 661 m
- -5 -2 d -3 -4 d -1 -8 d -4 Y 1 -8 d 3 -4 d 5 -2 d 3 X 4 2 d 3 4 d 2 8 d 4 Y -2
- 8 d -3 4 d -4 2 d -3 X cl s 1956 588 m 16 -21 d s 1972 588 m -16 -21 d s 2000
- 592 m 3 2 d 4 4 d -31 Y s 2034 598 m -4 -1 d -3 -5 d -2 -7 d -4 Y 2 -8 d 3 -4 d
- 4 -2 d 3 X 4 2 d 3 4 d 2 8 d 4 Y -2 7 d -3 5 d -4 1 d -3 X cl s 2070 620 m -1 2
- d -4 1 d -2 X -4 -1 d -2 -4 d -1 -5 d -6 Y 1 -5 d 2 -2 d 4 -2 d 1 X 4 2 d 2 2 d
- 1 3 d 2 Y -1 3 d -2 3 d -4 1 d -1 X -4 -1 d -2 -3 d -1 -3 d s 1779 1778 222 683
- C gr
-showpage
- gr
-%%Trailer
-%%Pages: 1
- gr gr
-%%EOF
diff --git a/src/pawlib/paw/testsuite/paw.commands/nt_pl_1d_7.ref.ps b/src/pawlib/paw/testsuite/paw.commands/nt_pl_1d_7.ref.ps
deleted file mode 100644
index 3715aac..0000000
--- a/src/pawlib/paw/testsuite/paw.commands/nt_pl_1d_7.ref.ps
+++ /dev/null
@@ -1,243 +0,0 @@
-%!PS-Adobe-2.0
-%%Title: /disk3/maartenb/cerncvs/paw/testsuite/tmp/nt_pl_1d_ (Portrait A 4)
-%%Pages: (atend)
-%%Creator: HIGZ Version 1.23/06
-%%CreationDate: 96/04/16 14.40
-%%EndComments
-%%BeginProlog
-/s {stroke} def /l {lineto} def /m {moveto} def /t {translate} def
-/sw {stringwidth} def /r {rotate} def /rl {roll} def /R {repeat} def
-/d {rlineto} def /rm {rmoveto} def /gr {grestore} def /f {eofill} def
-/c {setrgbcolor} def /lw {setlinewidth} def /sd {setdash} def
-/cl {closepath} def /sf {scalefont setfont} def /black {0 setgray} def
-/box {m dup 0 exch d exch 0 d 0 exch neg d cl} def
-/NC{systemdict begin initclip end}def/C{NC box clip newpath}def
-/bl {box s} def /bf {box f} def /Y { 0 exch d} def /X { 0 d} def
-/mp {newpath /y exch def /x exch def} def
-/side {[w .77 mul w .23 mul] .385 w mul sd w 0 l currentpoint t -144 r} def
-/mr {mp x y w2 0 360 arc} def /m24 {mr s} def /m20 {mr f} def
-/mb {mp x y w2 add m w2 neg 0 d 0 w neg d w 0 d 0 w d cl} def
-/mt {mp x y w2 add m w2 neg w neg d w 0 d cl} def
-/m21 {mb f} def /m25 {mb s} def /m22 {mt f} def /m26 {mt s} def
-/m23 {mp x y w2 sub m w2 w d w neg 0 d cl f} def
-/m27 {mp x y w2 add m w3 neg w2 neg d w3 w2 neg d w3 w2 d cl s} def
-/m28 {mp x w2 sub y w2 sub w3 add m w3 0 d 0 w3 neg d w3 0 d 0 w3 d w3 0 d
- 0 w3 d w3 neg 0 d 0 w3 d w3 neg 0 d
- 0 w3 neg d w3 neg 0 d cl s } def
-/m29 {mp gsave x w2 sub y w2 add w3 sub m currentpoint t
- 4 {side} repeat cl fill gr} def
-/m30 {mp gsave x w2 sub y w2 add w3 sub m currentpoint t
- 5 {side} repeat s gr} def
-/m31 {mp x y w2 sub m 0 w d x w2 sub y m w 0 d
- x w2 sub y w2 add m w w neg d x w2 sub y w2
- sub m w w d s} def
-/m2 {mp x y w2 sub m 0 w d x w2 sub y m w 0 d s} def
-/m5 {mp x w2 sub y w2 sub m w w d x w2 sub y w2 add m w w neg d s} def
-/DP {/PT exch def gsave 47.2 47.2 scale PT 1 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < AA AA 55 55 AA AA 55 55 AA AA 55 55 AA AA 55 55 AA AA 55 55 AA AA 55 55
-AA AA 55 55 AA AA 55 55 > } image } if PT 2 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < BB BB EE EE BB BB EE EE BB BB EE EE BB BB EE EE BB BB EE EE BB BB EE EE
-BB BB EE EE BB BB EE EE > } image } if PT 3 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < FF FF BB BB FF FF EE EE FF FF BB BB FF FF EE EE FF FF BB BB FF FF EE EE
-FF FF BB BB FF FF EE EE > } image } if PT 4 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < DF DF BF BF 7F 7F FE FE FD FD FB FB F7 F7 EF EF DF DF BF BF 7F 7F FE FE
-FD FD FB FB F7 F7 EF EF > } image } if PT 5 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < 7F 7F BF B F DF DF EF EF F7 F7 FB FB FD FD FE FE 7F 7F BF BF DF DF EF
-EF F7 F7 FB FB FD FD FE FE > } image } if PT 6 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB
-BB BB BB BB BB BB BB BB BB > } image } if PT 7 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < FF FF FF FF FF FF 00 00 FF FF FF FF FF FF 00 00 FF FF FF FF FF FF 00
-00 FF FF FF FF FF FF 00 00 > } image } if PT 8 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < EE EE 47 47 83 83 C5 C5 EE EE 5C 5C 38 38 74 74 EE EE 47 47 83 83 C5
-C5 EE EE 5C 5C 38 38 74 74 > } image } if PT 9 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < EF EF EF EF D7 D7 38 38 FE FE FE FE 7D 7D 83 83 EF EF EF EF D7 D7 38
-38 FE FE FE FE 7D 7D 83 83 > } image } if PT 10 eq { 16 16 1 [ 16 0 0 16 neg
-0 16 ] { < EF EF EF EF EF EF 00 00 FE FE FE FE FE FE 00 00 EF EF EF EF EF EF
-00 00 FE FE FE FE FE FE 00 00 > } image } if PT 11 eq { 16 16 1 [ 16 0 0 16
-neg 0 16 ] { < F7 F7 B6 B6 D5 D5 E3 E3 D5 D5 B6 B6 F7 F7 FF FF 7F 7F 6B 6B 5D
-5D 3E 3E 5D 5D 6B 6B 7F 7F FF FF > } image } if PT 12 eq { 16 16 1 [ 16 0 0
-16 neg 0 16 ] { < E3 E3 DD DD BE BE BE BE BE BE DD DD E3 E3 FF FF 3E 3E DD DD
-EB EB EB EB EB EB DD DD 3E 3E FF FF > } image } if PT 13 eq { 16 16 1 [ 16 0
-0 16 neg 0 16 ] { < FE FE 7D 7D BB BB D7 D7 EF EF D7 D7 BB BB 7D 7D FE FE 7D
-7D BB BB D7 D7 EF EF D7 D7 BB BB 7D 7D > } image } if PT 14 eq { 16 16 1 [ 16
-0 0 16 neg 0 16 ] { < 00 00 EE EF EE EF EE EF 0E E0 EE EE EE EE EE EE 00 EE
-FE EE FE EE FE EE 00 00 FE EF FE EF FE EF > } image } if PT 15 eq { 16 16 1 [
-16 0 0 16 neg 0 16 ] { < DD DD AA AA DD DD FF FF 77 77 AA AA 77 77 FF FF DD
-DD AA AA DD DD FF FF 77 77 AA AA 77 77 FF FF > } image } if PT 16 eq { 16 16
-1 [ 16 0 0 16 neg 0 16 ] { < F1 F1 EE EE 1F 1F FF FF F1 F1 EE EE 1F 1F FF FF
-F1 F1 EE EE 1F 1F FF FF F1 F1 EE EE 1F 1F FF FF > } image } if PT 17 eq { 16
-16 1 [ 16 0 0 16 neg 0 16 ] { < EE EE DD DD BB BB FF FF EE EE DD DD BB BB FF
- FF EE EE DD DD BB BB FF FF EE EE DD DD BB BB FF FF > } image } if PT 18 eq {
-16 16 1 [ 16 0 0 16 neg 0 16 ] { < BB BB DD DD EE EE FF FF BB BB DD DD EE EE
-FF FF BB BB DD DD EE EE FF FF BB BB DD DD EE EE FF FF > } image } if PT 19 eq
-{ 16 16 1 [ 16 0 0 16 neg 0 16 ] { < 1F FC 67 F3 7B EF BD DE BD DE DE BD E6
-B3 F8 0F E6 B3 DE BD BD DE BD DE 7B EF 67 F3 1F FC 7F FF > } image } if PT
-20 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < DD DD EE EE EE EE EE EE DD DD BB
-BB BB BB BB BB DD DD EE EE EE EE EE EE DD DD BB BB BB BB BB BB > } image }
-if PT 21 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < 0E 0E EF EF EF EF EF EF E0
-E0 FE FE FE FE FE FE 0E 0E EF EF EF EF EF EF E0 E0 FE FE FE FE FE FE > }
-image } if PT 22 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < 70 70 F7 F7 F7 F7 F7
-F7 07 07 7F 7F 7F 7F 7F 7F 70 70 F7 F7 F7 F7 F7 F7 07 07 7F 7F 7F 7F 7F 7F >
-} image } if PT 23 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < AA AA 55 55 A9 A9
-D1 D1 E1 E1 D1 D1 A9 A9 55 55 AA AA 55 55 A9 A9 D1 D1 E1 E1 D1 D1 A9 A9 55 55
-> } image } if PT 24 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < FF FE FF FC EA
-A8 D5 54 EA A8 D5 54 E8 28 D4 54 E8 E8 D4 D4 E8 EA 54 D5 A8 EA 54 D5 00 C0 00
-80 > } image } if PT 25 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < FF FE FF FC
-FF F8 FF F0 F0 00 F0 00 F0 20 F0 60 F0 E0 F1 E0 F3 E0 F0 00 E0 00 C0 00 80 00
-00 00 > } image } if gr } def /FA { /PT exch def gsave clip 0 0 translate 1 1
-54 { 1 sub 47.2 mul /Xcurr exch def 1 1 74 { 1 sub 47.2 mul /Ycurr exch def
-gsave Xcurr Ycurr translate PT DP gr } for } for gr } def
-/reencdict 24 dict def /ReEncode {reencdict begin /nco&na exch def
-/nfnam exch def /basefontname exch def /basefontdict basefontname findfont def
-/newfont basefontdict maxlength dict def basefontdict {exch dup /FID ne
-{dup /Encoding eq {exch dup length array copy newfont 3 1 roll put} {exch
-newfont 3 1 roll put} ifelse} {pop pop} ifelse } forall newfont
-/FontName nfnam put nco&na aload pop nco&na length 2 idiv {newfont
-/Encoding get 3 1 roll put} repeat nfnam newfont definefont pop end } def
-/accvec [ 176 /agrave 181 /Agrave 190 /acircumflex 192 /Acircumflex
-201 /adieresis 204 /Adieresis 209 /ccedilla 210 /Ccedilla 211 /eacute
-212 /Eacute 213 /egrave 214 /Egrave 215 /ecircumflex 216 /Ecircumflex
-217 /edieresis 218 /Edieresis 219 /icircumflex 220 /Icircumflex
-221 /idieresis 222 /Idieresis 223 /ntilde 224 /Ntilde 226 /ocircumflex
-228 /Ocircumflex 229 /odieresis 230 /Odieresis 231 /ucircumflex 236 /Ucircumflex
-237 /udieresis 238 /Udieresis 239 /aring 242 /Aring 243 /ydieresis
-244 /Ydieresis 246 /aacute 247 /Aacute 252 /ugrave 253 /Ugrave] def
-/Times-Roman /Times-Roman accvec ReEncode
-/Times-Italic /Times-Italic accvec ReEncode
-/Times-Bold /Times-Bold accvec ReEncode
-/Times-BoldItalic /Times-BoldItalic accvec ReEncode
-/Helvetica /Helvetica accvec ReEncode
-/Helvetica-Oblique /Helvetica-Oblique accvec ReEncode
-/Helvetica-Bold /Helvetica-Bold accvec ReEncode
-/Helvetica-BoldOblique /Helvetica-BoldOblique accvec ReEncode
-/Courier /Courier accvec ReEncode
-/Courier-Oblique /Courier-Oblique accvec ReEncode
-/Courier-Bold /Courier-Bold accvec ReEncode
-/Courier-BoldOblique /Courier-BoldOblique accvec ReEncode
-/oshow {gsave [] 0 sd true charpath stroke gr} def
-/stwn { /fs exch def /fn exch def /text exch def fn findfont fs sf
- text sw pop xs add /xs exch def} def
-/stwb { /fs exch def /fn exch def /nbas exch def /textf exch def
-textf length /tlen exch def nbas tlen gt {/nbas tlen def} if
-fn findfont fs sf textf dup length nbas sub nbas getinterval sw
-pop neg xs add /xs exch def} def
-/accspe [ 65 /plusminus 66 /bar 67 /existential 68 /universal
-69 /exclam 70 /numbersign 71 /greater 72 /question 73 /integral
-74 /colon 75 /semicolon 76 /less 77 /bracketleft 78 /bracketright
-79 /greaterequal 80 /braceleft 81 /braceright 82 /radical
-83 /spade 84 /heart 85 /diamond 86 /club 87 /lessequal
-88 /multiply 89 /percent 90 /infinity 48 /circlemultiply 49 /circleplus
-50 /emptyset 51 /lozenge 52 /bullet 53 /arrowright 54 /arrowup
-55 /arrowleft 56 /arrowdown 57 /arrowboth 48 /degree 44 /comma 43 /plus
- 45 /angle 42 /angleleft 47 /divide 61 /notequal 40 /equivalence 41 /second
- 97 /approxequal 98 /congruent 99 /perpendicular 100 /partialdiff 101 /florin
- 102 /intersection 103 /union 104 /propersuperset 105 /reflexsuperset
- 106 /notsubset 107 /propersubset 108 /reflexsubset 109 /element 110 /notelement
- 111 /gradient 112 /logicaland 113 /logicalor 114 /arrowdblboth
- 115 /arrowdblleft 116 /arrowdblup 117 /arrowdblright 118 /arrowdbldown
- 119 /ampersand 120 /omega1 121 /similar 122 /aleph ] def
-/Symbol /Special accspe ReEncode
-/Zone {/iy exch def /ix exch def ix 1 sub 2224 mul 1 iy sub 3144
- mul t} def
-%%EndProlog
- gsave 20 28 t .25 .25 scale gsave
-%%Page: number 1
- gsave
- 1 1 Zone
- gsave 0 0 t black [] 0 sd 1 lw 2223 2224 0 460 bl 2223 2224 0 460 C NC 1779
- 1778 222 683 bl 1779 1778 222 683 C 2223 2224 0 460 C 1046 549 m 16 X -9 -11 d
- 4 X 3 -2 d 2 -1 d 1 -5 d -3 Y -1 -4 d -3 -3 d -5 -2 d -4 X -4 2 d -2 1 d -1 3 d
- s 1080 541 m -18 Y s 1072 536 m 15 -9 d s 1087 536 m -15 -9 d s 1106 549 m -3 X
- -3 -1 d -1 -5 d -25 Y s 1094 539 m 11 X s 1115 539 m -21 Y s 1115 530 m 2 5 d 3
- 3 d 3 1 d 4 X s 1134 539 m -21 Y s 1134 533 m 5 5 d 3 1 d 4 X 3 -1 d 2 -5 d -15
- Y s 1179 549 m -31 Y s 1179 535 m -3 3 d -3 1 d -4 X -3 -1 d -3 -3 d -2 -5 d -3
- Y 2 -4 d 3 -3 d 3 -2 d 4 X 3 2 d 3 3 d s 1779 1778 222 683 C 222 683 m 223 X
- 1517 Y 22 X -129 Y 22 X 129 Y 22 X -29 Y 23 X 67 Y 22 X -88 Y 22 X 25 Y 22 X -8
- Y 22 X 12 Y 23 X -25 Y 22 X 75 Y 22 X -104 Y 22 X -16 Y 23 X 133 Y 22 X -129 Y
- 22 X -71 Y 22 X 146 Y 23 X -129 Y 22 X -191 Y 22 X 332 Y 22 X -100 Y 22 X -45 Y
- 23 X 99 Y 22 X -91 Y 22 X 166 Y 22 X -12 Y 23 X -108 Y 22 X -33 Y 22 X 54 Y 45
- X -46 Y 44 X 137 Y 22 X 62 Y 22 X -129 Y 23 X -91 Y 22 X 83 Y 22 X -12 Y 22 X
- 45 Y 23 X -58 Y 22 X 50 Y 22 X -174 Y 22 X 170 Y 23 X -141 Y 22 X 45 Y 22 X 117
- Y 22 X -175 Y 22 X 179 Y 23 X -67 Y 22 X 71 Y 22 X -8 Y 22 X 87 Y 23 X -121 Y
- 22 X -12 Y 22 X -91 Y 22 X 29 Y 22 X 50 Y 23 X -13 Y 22 X 141 Y 22 X -141 Y 22
- X -1434 Y 223 X s NC 222 683 m 1778 Y s 256 683 m -34 X s 239 724 m -17 X s 239
- 766 m -17 X s 239 808 m -17 X s 239 849 m -17 X s 256 891 m -34 X s 239 932 m
- -17 X s 239 974 m -17 X s 239 1015 m -17 X s 239 1057 m -17 X s 256 1099 m -34
- X s 239 1140 m -17 X s 239 1182 m -17 X s 239 1223 m -17 X s 239 1265 m -17 X s
- 256 1306 m -34 X s 239 1348 m -17 X s 239 1390 m -17 X s 239 1431 m -17 X s 239
- 1473 m -17 X s 256 1514 m -34 X s 239 1556 m -17 X s 239 1597 m -17 X s 239
- 1639 m -17 X s 239 1681 m -17 X s 256 1722 m -34 X s 239 1764 m -17 X s 239
- 1805 m -17 X s 239 1847 m -17 X s 239 1888 m -17 X s 256 1930 m -34 X s 239
- 1972 m -17 X s 239 2013 m -17 X s 239 2055 m -17 X s 239 2096 m -17 X s 256
- 2138 m -34 X s 239 2179 m -17 X s 239 2221 m -17 X s 239 2263 m -17 X s 239
- 2304 m -17 X s 256 2346 m -34 X s 256 2346 m -34 X s 239 2387 m -17 X s 239
- 2429 m -17 X s 162 698 m -5 -1 d -3 -5 d -1 -7 d -4 Y 1 -8 d 3 -4 d 5 -2 d 3 X
- 4 2 d 3 4 d 1 8 d 4 Y -1 7 d -3 5 d -4 1 d -3 X cl s 141 906 m -15 X -2 -13 d 2
- 1 d 4 2 d 5 X 4 -2 d 3 -3 d 2 -4 d -3 Y -2 -4 d -3 -3 d -4 -2 d -5 X -4 2 d -2
- 1 d -1 3 d s 162 906 m -5 -1 d -3 -5 d -1 -7 d -5 Y 1 -7 d 3 -4 d 5 -2 d 3 X 4
- 2 d 3 4 d 1 7 d 5 Y -1 7 d -3 5 d -4 1 d -3 X cl s 98 1108 m 3 2 d 4 4 d -31 Y
- s 132 1114 m -5 -1 d -3 -5 d -1 -7 d -5 Y 1 -7 d 3 -5 d 5 -1 d 3 X 4 1 d 3 5 d
- 2 7 d 5 Y -2 7 d -3 5 d -4 1 d -3 X cl s 162 1114 m -5 -1 d -3 -5 d -1 -7 d -5
- Y 1 -7 d 3 -5 d 5 -1 d 3 X 4 1 d 3 5 d 1 7 d 5 Y -1 7 d -3 5 d -4 1 d -3 X cl s
- 98 1316 m 3 2 d 4 4 d -31 Y s 141 1322 m -15 X -2 -13 d 2 1 d 4 2 d 5 X 4 -2 d
- 3 -3 d 2 -4 d -3 Y -2 -5 d -3 -3 d -4 -1 d -5 X -4 1 d -2 2 d -1 3 d s 162 1322
- m -5 -2 d -3 -4 d -1 -7 d -5 Y 1 -7 d 3 -5 d 5 -1 d 3 X 4 1 d 3 5 d 1 7 d 5 Y
- -1 7 d -3 4 d -4 2 d -3 X cl s 95 1522 m 2 Y 1 3 d 2 1 d 3 2 d 6 X 3 -2 d 1 -1
- d 2 -3 d -3 Y -2 -3 d -3 -4 d -15 -15 d 21 X s 132 1530 m -5 -2 d -3 -4 d -1 -8
- d -4 Y 1 -7 d 3 -5 d 5 -1 d 3 X 4 1 d 3 5 d 2 7 d 4 Y -2 8 d -3 4 d -4 2 d -3 X
- cl s 162 1530 m -5 -2 d -3 -4 d -1 -8 d -4 Y 1 -7 d 3 -5 d 5 -1 d 3 X 4 1 d 3 5
- d 1 7 d 4 Y -1 8 d -3 4 d -4 2 d -3 X cl s 95 1730 m 2 Y 1 3 d 2 1 d 3 2 d 6 X
- 3 -2 d 1 -1 d 2 -3 d -3 Y -2 -3 d -3 -5 d -15 -14 d 21 X s 141 1738 m -15 X -2
- -14 d 2 2 d 4 1 d 5 X 4 -1 d 3 -3 d 2 -5 d -3 Y -2 -4 d -3 -3 d -4 -1 d -5 X -4
- 1 d -2 2 d -1 2 d s 162 1738 m -5 -2 d -3 -4 d -1 -8 d -4 Y 1 -8 d 3 -4 d 5 -1
- d 3 X 4 1 d 3 4 d 1 8 d 4 Y -1 8 d -3 4 d -4 2 d -3 X cl s 96 1946 m 17 X -9
- -12 d 4 X 3 -2 d 2 -1 d 1 -5 d -3 Y -1 -4 d -3 -3 d -5 -2 d -4 X -5 2 d -1 1 d
- -2 3 d s 132 1946 m -5 -2 d -3 -4 d -1 -8 d -4 Y 1 -8 d 3 -4 d 5 -2 d 3 X 4 2 d
- 3 4 d 2 8 d 4 Y -2 8 d -3 4 d -4 2 d -3 X cl s 162 1946 m -5 -2 d -3 -4 d -1 -8
- d -4 Y 1 -8 d 3 -4 d 5 -2 d 3 X 4 2 d 3 4 d 1 8 d 4 Y -1 8 d -3 4 d -4 2 d -3 X
- cl s 96 2153 m 17 X -9 -11 d 4 X 3 -2 d 2 -1 d 1 -5 d -3 Y -1 -4 d -3 -3 d -5
- -2 d -4 X -5 2 d -1 1 d -2 3 d s 141 2153 m -15 X -2 -13 d 2 2 d 4 1 d 5 X 4 -1
- d 3 -3 d 2 -5 d -3 Y -2 -4 d -3 -3 d -4 -2 d -5 X -4 2 d -2 1 d -1 3 d s 162
- 2153 m -5 -1 d -3 -5 d -1 -7 d -4 Y 1 -8 d 3 -4 d 5 -2 d 3 X 4 2 d 3 4 d 1 8 d
- 4 Y -1 7 d -3 5 d -4 1 d -3 X cl s 108 2361 m -15 -20 d 23 X s 108 2361 m -31 Y
- s 132 2361 m -5 -1 d -3 -5 d -1 -7 d -4 Y 1 -8 d 3 -4 d 5 -2 d 3 X 4 2 d 3 4 d
- 2 8 d 4 Y -2 7 d -3 5 d -4 1 d -3 X cl s 162 2361 m -5 -1 d -3 -5 d -1 -7 d -4
- Y 1 -8 d 3 -4 d 5 -2 d 3 X 4 2 d 3 4 d 1 8 d 4 Y -1 7 d -3 5 d -4 1 d -3 X cl s
- 222 683 m 1779 X s 222 716 m -33 Y s 267 699 m -16 Y s 311 699 m -16 Y s 356
- 699 m -16 Y s 400 699 m -16 Y s 445 716 m -33 Y s 489 699 m -16 Y s 534 699 m
- -16 Y s 578 699 m -16 Y s 622 699 m -16 Y s 667 716 m -33 Y s 711 699 m -16 Y s
- 756 699 m -16 Y s 800 699 m -16 Y s 845 699 m -16 Y s 889 716 m -33 Y s 934 699
- m -16 Y s 978 699 m -16 Y s 1023 699 m -16 Y s 1067 699 m -16 Y s 1112 716 m
- -33 Y s 1156 699 m -16 Y s 1200 699 m -16 Y s 1245 699 m -16 Y s 1289 699 m -16
- Y s 1334 716 m -33 Y s 1378 699 m -16 Y s 1423 699 m -16 Y s 1467 699 m -16 Y s
- 1512 699 m -16 Y s 1556 716 m -33 Y s 1601 699 m -16 Y s 1645 699 m -16 Y s
- 1689 699 m -16 Y s 1734 699 m -16 Y s 1778 716 m -33 Y s 1823 699 m -16 Y s
- 1867 699 m -16 Y s 1912 699 m -16 Y s 1956 699 m -16 Y s 2001 716 m -33 Y s 172
- 643 m 27 X s 218 661 m -5 -2 d -3 -4 d -1 -8 d -4 Y 1 -8 d 3 -4 d 5 -2 d 3 X 4
- 2 d 3 4 d 2 8 d 4 Y -2 8 d -3 4 d -4 2 d -3 X cl s 242 632 m -2 -1 d 2 -2 d 1 2
- d -1 1 d cl s 271 661 m -15 X -1 -14 d 1 2 d 5 1 d 4 X 5 -1 d 3 -3 d 1 -5 d -3
- Y -1 -4 d -3 -3 d -5 -2 d -4 X -5 2 d -1 1 d -2 3 d s 443 661 m -4 -2 d -3 -4 d
- -2 -8 d -4 Y 2 -8 d 3 -4 d 4 -2 d 3 X 5 2 d 2 4 d 2 8 d 4 Y -2 8 d -2 4 d -5 2
- d -3 X cl s 643 661 m -4 -2 d -3 -4 d -2 -8 d -4 Y 2 -8 d 3 -4 d 4 -2 d 3 X 5 2
- d 3 4 d 1 8 d 4 Y -1 8 d -3 4 d -5 2 d -3 X cl s 667 632 m -2 -1 d 2 -2 d 1 2 d
- -1 1 d cl s 697 661 m -15 X -2 -14 d 2 2 d 4 1 d 5 X 4 -1 d 3 -3 d 2 -5 d -3 Y
- -2 -4 d -3 -3 d -4 -2 d -5 X -4 2 d -2 1 d -1 3 d s 883 655 m 3 1 d 5 5 d -32 Y
- s 1083 655 m 3 1 d 5 5 d -32 Y s 1112 632 m -2 -1 d 2 -2 d 1 2 d -1 1 d cl s
- 1141 661 m -15 X -1 -14 d 1 2 d 5 1 d 4 X 5 -1 d 3 -3 d 1 -5 d -3 Y -1 -4 d -3
- -3 d -5 -2 d -4 X -5 2 d -1 1 d -2 3 d s 1325 653 m 2 Y 1 3 d 2 1 d 3 2 d 6 X 3
- -2 d 1 -1 d 2 -3 d -3 Y -2 -3 d -3 -5 d -15 -15 d 21 X s 1525 653 m 2 Y 1 3 d 2
- 1 d 3 2 d 6 X 3 -2 d 1 -1 d 2 -3 d -3 Y -2 -3 d -3 -5 d -14 -15 d 20 X s 1556
- 632 m -1 -1 d 1 -2 d 2 2 d -2 1 d cl s 1586 661 m -15 X -2 -14 d 2 2 d 4 1 d 5
- X 4 -1 d 3 -3 d 2 -5 d -3 Y -2 -4 d -3 -3 d -4 -2 d -5 X -4 2 d -2 1 d -1 3 d s
- 1771 661 m 16 X -9 -12 d 5 X 3 -2 d 1 -1 d 2 -5 d -3 Y -2 -4 d -3 -3 d -4 -2 d
- -5 X -4 2 d -1 1 d -2 3 d s 1971 661 m 16 X -9 -12 d 5 X 3 -2 d 1 -1 d 2 -5 d
- -3 Y -2 -4 d -3 -3 d -4 -2 d -4 X -5 2 d -1 1 d -2 3 d s 2001 632 m -2 -1 d 2
- -2 d 1 2 d -1 1 d cl s 2030 661 m -14 X -2 -14 d 2 2 d 4 1 d 4 X 5 -1 d 3 -3 d
- 1 -5 d -3 Y -1 -4 d -3 -3 d -5 -2 d -4 X -4 2 d -2 1 d -1 3 d s 1779 1778 222
- 683 C gr
-showpage
- gr
-%%Trailer
-%%Pages: 1
- gr gr
-%%EOF
diff --git a/src/pawlib/paw/testsuite/paw.commands/nt_pl_1d_8.ref.ps b/src/pawlib/paw/testsuite/paw.commands/nt_pl_1d_8.ref.ps
deleted file mode 100644
index 6c50ef9..0000000
--- a/src/pawlib/paw/testsuite/paw.commands/nt_pl_1d_8.ref.ps
+++ /dev/null
@@ -1,243 +0,0 @@
-%!PS-Adobe-2.0
-%%Title: /disk3/maartenb/cerncvs/paw/testsuite/tmp/nt_pl_1d_ (Portrait A 4)
-%%Pages: (atend)
-%%Creator: HIGZ Version 1.23/06
-%%CreationDate: 96/04/16 14.41
-%%EndComments
-%%BeginProlog
-/s {stroke} def /l {lineto} def /m {moveto} def /t {translate} def
-/sw {stringwidth} def /r {rotate} def /rl {roll} def /R {repeat} def
-/d {rlineto} def /rm {rmoveto} def /gr {grestore} def /f {eofill} def
-/c {setrgbcolor} def /lw {setlinewidth} def /sd {setdash} def
-/cl {closepath} def /sf {scalefont setfont} def /black {0 setgray} def
-/box {m dup 0 exch d exch 0 d 0 exch neg d cl} def
-/NC{systemdict begin initclip end}def/C{NC box clip newpath}def
-/bl {box s} def /bf {box f} def /Y { 0 exch d} def /X { 0 d} def
-/mp {newpath /y exch def /x exch def} def
-/side {[w .77 mul w .23 mul] .385 w mul sd w 0 l currentpoint t -144 r} def
-/mr {mp x y w2 0 360 arc} def /m24 {mr s} def /m20 {mr f} def
-/mb {mp x y w2 add m w2 neg 0 d 0 w neg d w 0 d 0 w d cl} def
-/mt {mp x y w2 add m w2 neg w neg d w 0 d cl} def
-/m21 {mb f} def /m25 {mb s} def /m22 {mt f} def /m26 {mt s} def
-/m23 {mp x y w2 sub m w2 w d w neg 0 d cl f} def
-/m27 {mp x y w2 add m w3 neg w2 neg d w3 w2 neg d w3 w2 d cl s} def
-/m28 {mp x w2 sub y w2 sub w3 add m w3 0 d 0 w3 neg d w3 0 d 0 w3 d w3 0 d
- 0 w3 d w3 neg 0 d 0 w3 d w3 neg 0 d
- 0 w3 neg d w3 neg 0 d cl s } def
-/m29 {mp gsave x w2 sub y w2 add w3 sub m currentpoint t
- 4 {side} repeat cl fill gr} def
-/m30 {mp gsave x w2 sub y w2 add w3 sub m currentpoint t
- 5 {side} repeat s gr} def
-/m31 {mp x y w2 sub m 0 w d x w2 sub y m w 0 d
- x w2 sub y w2 add m w w neg d x w2 sub y w2
- sub m w w d s} def
-/m2 {mp x y w2 sub m 0 w d x w2 sub y m w 0 d s} def
-/m5 {mp x w2 sub y w2 sub m w w d x w2 sub y w2 add m w w neg d s} def
-/DP {/PT exch def gsave 47.2 47.2 scale PT 1 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < AA AA 55 55 AA AA 55 55 AA AA 55 55 AA AA 55 55 AA AA 55 55 AA AA 55 55
-AA AA 55 55 AA AA 55 55 > } image } if PT 2 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < BB BB EE EE BB BB EE EE BB BB EE EE BB BB EE EE BB BB EE EE BB BB EE EE
-BB BB EE EE BB BB EE EE > } image } if PT 3 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < FF FF BB BB FF FF EE EE FF FF BB BB FF FF EE EE FF FF BB BB FF FF EE EE
-FF FF BB BB FF FF EE EE > } image } if PT 4 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < DF DF BF BF 7F 7F FE FE FD FD FB FB F7 F7 EF EF DF DF BF BF 7F 7F FE FE
-FD FD FB FB F7 F7 EF EF > } image } if PT 5 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < 7F 7F BF B F DF DF EF EF F7 F7 FB FB FD FD FE FE 7F 7F BF BF DF DF EF
-EF F7 F7 FB FB FD FD FE FE > } image } if PT 6 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB
-BB BB BB BB BB BB BB BB BB > } image } if PT 7 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < FF FF FF FF FF FF 00 00 FF FF FF FF FF FF 00 00 FF FF FF FF FF FF 00
-00 FF FF FF FF FF FF 00 00 > } image } if PT 8 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < EE EE 47 47 83 83 C5 C5 EE EE 5C 5C 38 38 74 74 EE EE 47 47 83 83 C5
-C5 EE EE 5C 5C 38 38 74 74 > } image } if PT 9 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < EF EF EF EF D7 D7 38 38 FE FE FE FE 7D 7D 83 83 EF EF EF EF D7 D7 38
-38 FE FE FE FE 7D 7D 83 83 > } image } if PT 10 eq { 16 16 1 [ 16 0 0 16 neg
-0 16 ] { < EF EF EF EF EF EF 00 00 FE FE FE FE FE FE 00 00 EF EF EF EF EF EF
-00 00 FE FE FE FE FE FE 00 00 > } image } if PT 11 eq { 16 16 1 [ 16 0 0 16
-neg 0 16 ] { < F7 F7 B6 B6 D5 D5 E3 E3 D5 D5 B6 B6 F7 F7 FF FF 7F 7F 6B 6B 5D
-5D 3E 3E 5D 5D 6B 6B 7F 7F FF FF > } image } if PT 12 eq { 16 16 1 [ 16 0 0
-16 neg 0 16 ] { < E3 E3 DD DD BE BE BE BE BE BE DD DD E3 E3 FF FF 3E 3E DD DD
-EB EB EB EB EB EB DD DD 3E 3E FF FF > } image } if PT 13 eq { 16 16 1 [ 16 0
-0 16 neg 0 16 ] { < FE FE 7D 7D BB BB D7 D7 EF EF D7 D7 BB BB 7D 7D FE FE 7D
-7D BB BB D7 D7 EF EF D7 D7 BB BB 7D 7D > } image } if PT 14 eq { 16 16 1 [ 16
-0 0 16 neg 0 16 ] { < 00 00 EE EF EE EF EE EF 0E E0 EE EE EE EE EE EE 00 EE
-FE EE FE EE FE EE 00 00 FE EF FE EF FE EF > } image } if PT 15 eq { 16 16 1 [
-16 0 0 16 neg 0 16 ] { < DD DD AA AA DD DD FF FF 77 77 AA AA 77 77 FF FF DD
-DD AA AA DD DD FF FF 77 77 AA AA 77 77 FF FF > } image } if PT 16 eq { 16 16
-1 [ 16 0 0 16 neg 0 16 ] { < F1 F1 EE EE 1F 1F FF FF F1 F1 EE EE 1F 1F FF FF
-F1 F1 EE EE 1F 1F FF FF F1 F1 EE EE 1F 1F FF FF > } image } if PT 17 eq { 16
-16 1 [ 16 0 0 16 neg 0 16 ] { < EE EE DD DD BB BB FF FF EE EE DD DD BB BB FF
- FF EE EE DD DD BB BB FF FF EE EE DD DD BB BB FF FF > } image } if PT 18 eq {
-16 16 1 [ 16 0 0 16 neg 0 16 ] { < BB BB DD DD EE EE FF FF BB BB DD DD EE EE
-FF FF BB BB DD DD EE EE FF FF BB BB DD DD EE EE FF FF > } image } if PT 19 eq
-{ 16 16 1 [ 16 0 0 16 neg 0 16 ] { < 1F FC 67 F3 7B EF BD DE BD DE DE BD E6
-B3 F8 0F E6 B3 DE BD BD DE BD DE 7B EF 67 F3 1F FC 7F FF > } image } if PT
-20 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < DD DD EE EE EE EE EE EE DD DD BB
-BB BB BB BB BB DD DD EE EE EE EE EE EE DD DD BB BB BB BB BB BB > } image }
-if PT 21 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < 0E 0E EF EF EF EF EF EF E0
-E0 FE FE FE FE FE FE 0E 0E EF EF EF EF EF EF E0 E0 FE FE FE FE FE FE > }
-image } if PT 22 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < 70 70 F7 F7 F7 F7 F7
-F7 07 07 7F 7F 7F 7F 7F 7F 70 70 F7 F7 F7 F7 F7 F7 07 07 7F 7F 7F 7F 7F 7F >
-} image } if PT 23 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < AA AA 55 55 A9 A9
-D1 D1 E1 E1 D1 D1 A9 A9 55 55 AA AA 55 55 A9 A9 D1 D1 E1 E1 D1 D1 A9 A9 55 55
-> } image } if PT 24 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < FF FE FF FC EA
-A8 D5 54 EA A8 D5 54 E8 28 D4 54 E8 E8 D4 D4 E8 EA 54 D5 A8 EA 54 D5 00 C0 00
-80 > } image } if PT 25 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < FF FE FF FC
-FF F8 FF F0 F0 00 F0 00 F0 20 F0 60 F0 E0 F1 E0 F3 E0 F0 00 E0 00 C0 00 80 00
-00 00 > } image } if gr } def /FA { /PT exch def gsave clip 0 0 translate 1 1
-54 { 1 sub 47.2 mul /Xcurr exch def 1 1 74 { 1 sub 47.2 mul /Ycurr exch def
-gsave Xcurr Ycurr translate PT DP gr } for } for gr } def
-/reencdict 24 dict def /ReEncode {reencdict begin /nco&na exch def
-/nfnam exch def /basefontname exch def /basefontdict basefontname findfont def
-/newfont basefontdict maxlength dict def basefontdict {exch dup /FID ne
-{dup /Encoding eq {exch dup length array copy newfont 3 1 roll put} {exch
-newfont 3 1 roll put} ifelse} {pop pop} ifelse } forall newfont
-/FontName nfnam put nco&na aload pop nco&na length 2 idiv {newfont
-/Encoding get 3 1 roll put} repeat nfnam newfont definefont pop end } def
-/accvec [ 176 /agrave 181 /Agrave 190 /acircumflex 192 /Acircumflex
-201 /adieresis 204 /Adieresis 209 /ccedilla 210 /Ccedilla 211 /eacute
-212 /Eacute 213 /egrave 214 /Egrave 215 /ecircumflex 216 /Ecircumflex
-217 /edieresis 218 /Edieresis 219 /icircumflex 220 /Icircumflex
-221 /idieresis 222 /Idieresis 223 /ntilde 224 /Ntilde 226 /ocircumflex
-228 /Ocircumflex 229 /odieresis 230 /Odieresis 231 /ucircumflex 236 /Ucircumflex
-237 /udieresis 238 /Udieresis 239 /aring 242 /Aring 243 /ydieresis
-244 /Ydieresis 246 /aacute 247 /Aacute 252 /ugrave 253 /Ugrave] def
-/Times-Roman /Times-Roman accvec ReEncode
-/Times-Italic /Times-Italic accvec ReEncode
-/Times-Bold /Times-Bold accvec ReEncode
-/Times-BoldItalic /Times-BoldItalic accvec ReEncode
-/Helvetica /Helvetica accvec ReEncode
-/Helvetica-Oblique /Helvetica-Oblique accvec ReEncode
-/Helvetica-Bold /Helvetica-Bold accvec ReEncode
-/Helvetica-BoldOblique /Helvetica-BoldOblique accvec ReEncode
-/Courier /Courier accvec ReEncode
-/Courier-Oblique /Courier-Oblique accvec ReEncode
-/Courier-Bold /Courier-Bold accvec ReEncode
-/Courier-BoldOblique /Courier-BoldOblique accvec ReEncode
-/oshow {gsave [] 0 sd true charpath stroke gr} def
-/stwn { /fs exch def /fn exch def /text exch def fn findfont fs sf
- text sw pop xs add /xs exch def} def
-/stwb { /fs exch def /fn exch def /nbas exch def /textf exch def
-textf length /tlen exch def nbas tlen gt {/nbas tlen def} if
-fn findfont fs sf textf dup length nbas sub nbas getinterval sw
-pop neg xs add /xs exch def} def
-/accspe [ 65 /plusminus 66 /bar 67 /existential 68 /universal
-69 /exclam 70 /numbersign 71 /greater 72 /question 73 /integral
-74 /colon 75 /semicolon 76 /less 77 /bracketleft 78 /bracketright
-79 /greaterequal 80 /braceleft 81 /braceright 82 /radical
-83 /spade 84 /heart 85 /diamond 86 /club 87 /lessequal
-88 /multiply 89 /percent 90 /infinity 48 /circlemultiply 49 /circleplus
-50 /emptyset 51 /lozenge 52 /bullet 53 /arrowright 54 /arrowup
-55 /arrowleft 56 /arrowdown 57 /arrowboth 48 /degree 44 /comma 43 /plus
- 45 /angle 42 /angleleft 47 /divide 61 /notequal 40 /equivalence 41 /second
- 97 /approxequal 98 /congruent 99 /perpendicular 100 /partialdiff 101 /florin
- 102 /intersection 103 /union 104 /propersuperset 105 /reflexsuperset
- 106 /notsubset 107 /propersubset 108 /reflexsubset 109 /element 110 /notelement
- 111 /gradient 112 /logicaland 113 /logicalor 114 /arrowdblboth
- 115 /arrowdblleft 116 /arrowdblup 117 /arrowdblright 118 /arrowdbldown
- 119 /ampersand 120 /omega1 121 /similar 122 /aleph ] def
-/Symbol /Special accspe ReEncode
-/Zone {/iy exch def /ix exch def ix 1 sub 2224 mul 1 iy sub 3144
- mul t} def
-%%EndProlog
- gsave 20 28 t .25 .25 scale gsave
-%%Page: number 1
- gsave
- 1 1 Zone
- gsave 0 0 t black [] 0 sd 1 lw 2223 2224 0 460 bl 2223 2224 0 460 C NC 1779
- 1778 222 683 bl 1779 1778 222 683 C 2223 2224 0 460 C 1040 549 m 17 X -9 -11 d
- 4 X 3 -2 d 2 -1 d 1 -5 d -3 Y -1 -4 d -3 -3 d -5 -2 d -4 X -5 2 d -1 1 d -2 3 d
- s 1074 541 m -18 Y s 1067 536 m 15 -9 d s 1082 536 m -15 -9 d s 1109 549 m -31
- Y s 1109 535 m -3 3 d -3 1 d -5 X -3 -1 d -3 -3 d -1 -5 d -3 Y 1 -4 d 3 -3 d 3
- -2 d 5 X 3 2 d 3 3 d s 1120 539 m -21 Y s 1120 530 m 2 5 d 3 3 d 3 1 d 4 X s
- 1140 539 m -21 Y s 1140 533 m 4 5 d 3 1 d 5 X 2 -1 d 2 -5 d -15 Y s 1184 549 m
- -31 Y s 1184 535 m -3 3 d -3 1 d -4 X -3 -1 d -3 -3 d -2 -5 d -3 Y 2 -4 d 3 -3
- d 3 -2 d 4 X 3 2 d 3 3 d s 1779 1778 222 683 C 222 683 m 223 X 1517 Y 22 X -129
- Y 22 X 129 Y 22 X -29 Y 23 X 67 Y 22 X -88 Y 22 X 25 Y 22 X -8 Y 22 X 12 Y 23 X
- -25 Y 22 X 75 Y 22 X -104 Y 22 X -16 Y 23 X 133 Y 22 X -129 Y 22 X -71 Y 22 X
- 146 Y 23 X -129 Y 22 X -191 Y 22 X 332 Y 22 X -100 Y 22 X -45 Y 23 X 99 Y 22 X
- -91 Y 22 X 166 Y 22 X -12 Y 23 X -108 Y 22 X -33 Y 22 X 54 Y 45 X -46 Y 44 X
- 137 Y 22 X 62 Y 22 X -129 Y 23 X -91 Y 22 X 83 Y 22 X -12 Y 22 X 45 Y 23 X -58
- Y 22 X 50 Y 22 X -174 Y 22 X 170 Y 23 X -141 Y 22 X 45 Y 22 X 117 Y 22 X -175 Y
- 22 X 179 Y 23 X -67 Y 22 X 71 Y 22 X -8 Y 22 X 87 Y 23 X -121 Y 22 X -12 Y 22 X
- -91 Y 22 X 29 Y 22 X 50 Y 23 X -13 Y 22 X 141 Y 22 X -141 Y 22 X -1434 Y 223 X
- s NC 222 683 m 1778 Y s 256 683 m -34 X s 239 724 m -17 X s 239 766 m -17 X s
- 239 808 m -17 X s 239 849 m -17 X s 256 891 m -34 X s 239 932 m -17 X s 239 974
- m -17 X s 239 1015 m -17 X s 239 1057 m -17 X s 256 1099 m -34 X s 239 1140 m
- -17 X s 239 1182 m -17 X s 239 1223 m -17 X s 239 1265 m -17 X s 256 1306 m -34
- X s 239 1348 m -17 X s 239 1390 m -17 X s 239 1431 m -17 X s 239 1473 m -17 X s
- 256 1514 m -34 X s 239 1556 m -17 X s 239 1597 m -17 X s 239 1639 m -17 X s 239
- 1681 m -17 X s 256 1722 m -34 X s 239 1764 m -17 X s 239 1805 m -17 X s 239
- 1847 m -17 X s 239 1888 m -17 X s 256 1930 m -34 X s 239 1972 m -17 X s 239
- 2013 m -17 X s 239 2055 m -17 X s 239 2096 m -17 X s 256 2138 m -34 X s 239
- 2179 m -17 X s 239 2221 m -17 X s 239 2263 m -17 X s 239 2304 m -17 X s 256
- 2346 m -34 X s 256 2346 m -34 X s 239 2387 m -17 X s 239 2429 m -17 X s 162 698
- m -5 -1 d -3 -5 d -1 -7 d -4 Y 1 -8 d 3 -4 d 5 -2 d 3 X 4 2 d 3 4 d 1 8 d 4 Y
- -1 7 d -3 5 d -4 1 d -3 X cl s 141 906 m -15 X -2 -13 d 2 1 d 4 2 d 5 X 4 -2 d
- 3 -3 d 2 -4 d -3 Y -2 -4 d -3 -3 d -4 -2 d -5 X -4 2 d -2 1 d -1 3 d s 162 906
- m -5 -1 d -3 -5 d -1 -7 d -5 Y 1 -7 d 3 -4 d 5 -2 d 3 X 4 2 d 3 4 d 1 7 d 5 Y
- -1 7 d -3 5 d -4 1 d -3 X cl s 98 1108 m 3 2 d 4 4 d -31 Y s 132 1114 m -5 -1 d
- -3 -5 d -1 -7 d -5 Y 1 -7 d 3 -5 d 5 -1 d 3 X 4 1 d 3 5 d 2 7 d 5 Y -2 7 d -3 5
- d -4 1 d -3 X cl s 162 1114 m -5 -1 d -3 -5 d -1 -7 d -5 Y 1 -7 d 3 -5 d 5 -1 d
- 3 X 4 1 d 3 5 d 1 7 d 5 Y -1 7 d -3 5 d -4 1 d -3 X cl s 98 1316 m 3 2 d 4 4 d
- -31 Y s 141 1322 m -15 X -2 -13 d 2 1 d 4 2 d 5 X 4 -2 d 3 -3 d 2 -4 d -3 Y -2
- -5 d -3 -3 d -4 -1 d -5 X -4 1 d -2 2 d -1 3 d s 162 1322 m -5 -2 d -3 -4 d -1
- -7 d -5 Y 1 -7 d 3 -5 d 5 -1 d 3 X 4 1 d 3 5 d 1 7 d 5 Y -1 7 d -3 4 d -4 2 d
- -3 X cl s 95 1522 m 2 Y 1 3 d 2 1 d 3 2 d 6 X 3 -2 d 1 -1 d 2 -3 d -3 Y -2 -3 d
- -3 -4 d -15 -15 d 21 X s 132 1530 m -5 -2 d -3 -4 d -1 -8 d -4 Y 1 -7 d 3 -5 d
- 5 -1 d 3 X 4 1 d 3 5 d 2 7 d 4 Y -2 8 d -3 4 d -4 2 d -3 X cl s 162 1530 m -5
- -2 d -3 -4 d -1 -8 d -4 Y 1 -7 d 3 -5 d 5 -1 d 3 X 4 1 d 3 5 d 1 7 d 4 Y -1 8 d
- -3 4 d -4 2 d -3 X cl s 95 1730 m 2 Y 1 3 d 2 1 d 3 2 d 6 X 3 -2 d 1 -1 d 2 -3
- d -3 Y -2 -3 d -3 -5 d -15 -14 d 21 X s 141 1738 m -15 X -2 -14 d 2 2 d 4 1 d 5
- X 4 -1 d 3 -3 d 2 -5 d -3 Y -2 -4 d -3 -3 d -4 -1 d -5 X -4 1 d -2 2 d -1 2 d s
- 162 1738 m -5 -2 d -3 -4 d -1 -8 d -4 Y 1 -8 d 3 -4 d 5 -1 d 3 X 4 1 d 3 4 d 1
- 8 d 4 Y -1 8 d -3 4 d -4 2 d -3 X cl s 96 1946 m 17 X -9 -12 d 4 X 3 -2 d 2 -1
- d 1 -5 d -3 Y -1 -4 d -3 -3 d -5 -2 d -4 X -5 2 d -1 1 d -2 3 d s 132 1946 m -5
- -2 d -3 -4 d -1 -8 d -4 Y 1 -8 d 3 -4 d 5 -2 d 3 X 4 2 d 3 4 d 2 8 d 4 Y -2 8 d
- -3 4 d -4 2 d -3 X cl s 162 1946 m -5 -2 d -3 -4 d -1 -8 d -4 Y 1 -8 d 3 -4 d 5
- -2 d 3 X 4 2 d 3 4 d 1 8 d 4 Y -1 8 d -3 4 d -4 2 d -3 X cl s 96 2153 m 17 X -9
- -11 d 4 X 3 -2 d 2 -1 d 1 -5 d -3 Y -1 -4 d -3 -3 d -5 -2 d -4 X -5 2 d -1 1 d
- -2 3 d s 141 2153 m -15 X -2 -13 d 2 2 d 4 1 d 5 X 4 -1 d 3 -3 d 2 -5 d -3 Y -2
- -4 d -3 -3 d -4 -2 d -5 X -4 2 d -2 1 d -1 3 d s 162 2153 m -5 -1 d -3 -5 d -1
- -7 d -4 Y 1 -8 d 3 -4 d 5 -2 d 3 X 4 2 d 3 4 d 1 8 d 4 Y -1 7 d -3 5 d -4 1 d
- -3 X cl s 108 2361 m -15 -20 d 23 X s 108 2361 m -31 Y s 132 2361 m -5 -1 d -3
- -5 d -1 -7 d -4 Y 1 -8 d 3 -4 d 5 -2 d 3 X 4 2 d 3 4 d 2 8 d 4 Y -2 7 d -3 5 d
- -4 1 d -3 X cl s 162 2361 m -5 -1 d -3 -5 d -1 -7 d -4 Y 1 -8 d 3 -4 d 5 -2 d 3
- X 4 2 d 3 4 d 1 8 d 4 Y -1 7 d -3 5 d -4 1 d -3 X cl s 222 683 m 1779 X s 222
- 716 m -33 Y s 267 699 m -16 Y s 311 699 m -16 Y s 356 699 m -16 Y s 400 699 m
- -16 Y s 445 716 m -33 Y s 489 699 m -16 Y s 534 699 m -16 Y s 578 699 m -16 Y s
- 622 699 m -16 Y s 667 716 m -33 Y s 711 699 m -16 Y s 756 699 m -16 Y s 800 699
- m -16 Y s 845 699 m -16 Y s 889 716 m -33 Y s 934 699 m -16 Y s 978 699 m -16 Y
- s 1023 699 m -16 Y s 1067 699 m -16 Y s 1112 716 m -33 Y s 1156 699 m -16 Y s
- 1200 699 m -16 Y s 1245 699 m -16 Y s 1289 699 m -16 Y s 1334 716 m -33 Y s
- 1378 699 m -16 Y s 1423 699 m -16 Y s 1467 699 m -16 Y s 1512 699 m -16 Y s
- 1556 716 m -33 Y s 1601 699 m -16 Y s 1645 699 m -16 Y s 1689 699 m -16 Y s
- 1734 699 m -16 Y s 1778 716 m -33 Y s 1823 699 m -16 Y s 1867 699 m -16 Y s
- 1912 699 m -16 Y s 1956 699 m -16 Y s 2001 716 m -33 Y s 172 643 m 27 X s 218
- 661 m -5 -2 d -3 -4 d -1 -8 d -4 Y 1 -8 d 3 -4 d 5 -2 d 3 X 4 2 d 3 4 d 2 8 d 4
- Y -2 8 d -3 4 d -4 2 d -3 X cl s 242 632 m -2 -1 d 2 -2 d 1 2 d -1 1 d cl s 271
- 661 m -15 X -1 -14 d 1 2 d 5 1 d 4 X 5 -1 d 3 -3 d 1 -5 d -3 Y -1 -4 d -3 -3 d
- -5 -2 d -4 X -5 2 d -1 1 d -2 3 d s 443 661 m -4 -2 d -3 -4 d -2 -8 d -4 Y 2 -8
- d 3 -4 d 4 -2 d 3 X 5 2 d 2 4 d 2 8 d 4 Y -2 8 d -2 4 d -5 2 d -3 X cl s 643
- 661 m -4 -2 d -3 -4 d -2 -8 d -4 Y 2 -8 d 3 -4 d 4 -2 d 3 X 5 2 d 3 4 d 1 8 d 4
- Y -1 8 d -3 4 d -5 2 d -3 X cl s 667 632 m -2 -1 d 2 -2 d 1 2 d -1 1 d cl s 697
- 661 m -15 X -2 -14 d 2 2 d 4 1 d 5 X 4 -1 d 3 -3 d 2 -5 d -3 Y -2 -4 d -3 -3 d
- -4 -2 d -5 X -4 2 d -2 1 d -1 3 d s 883 655 m 3 1 d 5 5 d -32 Y s 1083 655 m 3
- 1 d 5 5 d -32 Y s 1112 632 m -2 -1 d 2 -2 d 1 2 d -1 1 d cl s 1141 661 m -15 X
- -1 -14 d 1 2 d 5 1 d 4 X 5 -1 d 3 -3 d 1 -5 d -3 Y -1 -4 d -3 -3 d -5 -2 d -4 X
- -5 2 d -1 1 d -2 3 d s 1325 653 m 2 Y 1 3 d 2 1 d 3 2 d 6 X 3 -2 d 1 -1 d 2 -3
- d -3 Y -2 -3 d -3 -5 d -15 -15 d 21 X s 1525 653 m 2 Y 1 3 d 2 1 d 3 2 d 6 X 3
- -2 d 1 -1 d 2 -3 d -3 Y -2 -3 d -3 -5 d -14 -15 d 20 X s 1556 632 m -1 -1 d 1
- -2 d 2 2 d -2 1 d cl s 1586 661 m -15 X -2 -14 d 2 2 d 4 1 d 5 X 4 -1 d 3 -3 d
- 2 -5 d -3 Y -2 -4 d -3 -3 d -4 -2 d -5 X -4 2 d -2 1 d -1 3 d s 1771 661 m 16 X
- -9 -12 d 5 X 3 -2 d 1 -1 d 2 -5 d -3 Y -2 -4 d -3 -3 d -4 -2 d -5 X -4 2 d -1 1
- d -2 3 d s 1971 661 m 16 X -9 -12 d 5 X 3 -2 d 1 -1 d 2 -5 d -3 Y -2 -4 d -3 -3
- d -4 -2 d -4 X -5 2 d -1 1 d -2 3 d s 2001 632 m -2 -1 d 2 -2 d 1 2 d -1 1 d cl
- s 2030 661 m -14 X -2 -14 d 2 2 d 4 1 d 4 X 5 -1 d 3 -3 d 1 -5 d -3 Y -1 -4 d
- -3 -3 d -5 -2 d -4 X -4 2 d -2 1 d -1 3 d s 1779 1778 222 683 C gr
-showpage
- gr
-%%Trailer
-%%Pages: 1
- gr gr
-%%EOF
diff --git a/src/pawlib/paw/testsuite/paw.commands/nt_pl_1d_9.ref.ps b/src/pawlib/paw/testsuite/paw.commands/nt_pl_1d_9.ref.ps
deleted file mode 100644
index d12b4e6..0000000
--- a/src/pawlib/paw/testsuite/paw.commands/nt_pl_1d_9.ref.ps
+++ /dev/null
@@ -1,247 +0,0 @@
-%!PS-Adobe-2.0
-%%Title: /disk3/maartenb/cerncvs/paw/testsuite/tmp/nt_pl_1d_ (Portrait A 4)
-%%Pages: (atend)
-%%Creator: HIGZ Version 1.23/06
-%%CreationDate: 96/04/19 10.22
-%%EndComments
-%%BeginProlog
-/s {stroke} def /l {lineto} def /m {moveto} def /t {translate} def
-/sw {stringwidth} def /r {rotate} def /rl {roll} def /R {repeat} def
-/d {rlineto} def /rm {rmoveto} def /gr {grestore} def /f {eofill} def
-/c {setrgbcolor} def /lw {setlinewidth} def /sd {setdash} def
-/cl {closepath} def /sf {scalefont setfont} def /black {0 setgray} def
-/box {m dup 0 exch d exch 0 d 0 exch neg d cl} def
-/NC{systemdict begin initclip end}def/C{NC box clip newpath}def
-/bl {box s} def /bf {box f} def /Y { 0 exch d} def /X { 0 d} def
-/mp {newpath /y exch def /x exch def} def
-/side {[w .77 mul w .23 mul] .385 w mul sd w 0 l currentpoint t -144 r} def
-/mr {mp x y w2 0 360 arc} def /m24 {mr s} def /m20 {mr f} def
-/mb {mp x y w2 add m w2 neg 0 d 0 w neg d w 0 d 0 w d cl} def
-/mt {mp x y w2 add m w2 neg w neg d w 0 d cl} def
-/m21 {mb f} def /m25 {mb s} def /m22 {mt f} def /m26 {mt s} def
-/m23 {mp x y w2 sub m w2 w d w neg 0 d cl f} def
-/m27 {mp x y w2 add m w3 neg w2 neg d w3 w2 neg d w3 w2 d cl s} def
-/m28 {mp x w2 sub y w2 sub w3 add m w3 0 d 0 w3 neg d w3 0 d 0 w3 d w3 0 d
- 0 w3 d w3 neg 0 d 0 w3 d w3 neg 0 d
- 0 w3 neg d w3 neg 0 d cl s } def
-/m29 {mp gsave x w2 sub y w2 add w3 sub m currentpoint t
- 4 {side} repeat cl fill gr} def
-/m30 {mp gsave x w2 sub y w2 add w3 sub m currentpoint t
- 5 {side} repeat s gr} def
-/m31 {mp x y w2 sub m 0 w d x w2 sub y m w 0 d
- x w2 sub y w2 add m w w neg d x w2 sub y w2
- sub m w w d s} def
-/m2 {mp x y w2 sub m 0 w d x w2 sub y m w 0 d s} def
-/m5 {mp x w2 sub y w2 sub m w w d x w2 sub y w2 add m w w neg d s} def
-/DP {/PT exch def gsave 47.2 47.2 scale PT 1 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < AA AA 55 55 AA AA 55 55 AA AA 55 55 AA AA 55 55 AA AA 55 55 AA AA 55 55
-AA AA 55 55 AA AA 55 55 > } image } if PT 2 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < BB BB EE EE BB BB EE EE BB BB EE EE BB BB EE EE BB BB EE EE BB BB EE EE
-BB BB EE EE BB BB EE EE > } image } if PT 3 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < FF FF BB BB FF FF EE EE FF FF BB BB FF FF EE EE FF FF BB BB FF FF EE EE
-FF FF BB BB FF FF EE EE > } image } if PT 4 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < DF DF BF BF 7F 7F FE FE FD FD FB FB F7 F7 EF EF DF DF BF BF 7F 7F FE FE
-FD FD FB FB F7 F7 EF EF > } image } if PT 5 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < 7F 7F BF B F DF DF EF EF F7 F7 FB FB FD FD FE FE 7F 7F BF BF DF DF EF
-EF F7 F7 FB FB FD FD FE FE > } image } if PT 6 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB
-BB BB BB BB BB BB BB BB BB > } image } if PT 7 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < FF FF FF FF FF FF 00 00 FF FF FF FF FF FF 00 00 FF FF FF FF FF FF 00
-00 FF FF FF FF FF FF 00 00 > } image } if PT 8 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < EE EE 47 47 83 83 C5 C5 EE EE 5C 5C 38 38 74 74 EE EE 47 47 83 83 C5
-C5 EE EE 5C 5C 38 38 74 74 > } image } if PT 9 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < EF EF EF EF D7 D7 38 38 FE FE FE FE 7D 7D 83 83 EF EF EF EF D7 D7 38
-38 FE FE FE FE 7D 7D 83 83 > } image } if PT 10 eq { 16 16 1 [ 16 0 0 16 neg
-0 16 ] { < EF EF EF EF EF EF 00 00 FE FE FE FE FE FE 00 00 EF EF EF EF EF EF
-00 00 FE FE FE FE FE FE 00 00 > } image } if PT 11 eq { 16 16 1 [ 16 0 0 16
-neg 0 16 ] { < F7 F7 B6 B6 D5 D5 E3 E3 D5 D5 B6 B6 F7 F7 FF FF 7F 7F 6B 6B 5D
-5D 3E 3E 5D 5D 6B 6B 7F 7F FF FF > } image } if PT 12 eq { 16 16 1 [ 16 0 0
-16 neg 0 16 ] { < E3 E3 DD DD BE BE BE BE BE BE DD DD E3 E3 FF FF 3E 3E DD DD
-EB EB EB EB EB EB DD DD 3E 3E FF FF > } image } if PT 13 eq { 16 16 1 [ 16 0
-0 16 neg 0 16 ] { < FE FE 7D 7D BB BB D7 D7 EF EF D7 D7 BB BB 7D 7D FE FE 7D
-7D BB BB D7 D7 EF EF D7 D7 BB BB 7D 7D > } image } if PT 14 eq { 16 16 1 [ 16
-0 0 16 neg 0 16 ] { < 00 00 EE EF EE EF EE EF 0E E0 EE EE EE EE EE EE 00 EE
-FE EE FE EE FE EE 00 00 FE EF FE EF FE EF > } image } if PT 15 eq { 16 16 1 [
-16 0 0 16 neg 0 16 ] { < DD DD AA AA DD DD FF FF 77 77 AA AA 77 77 FF FF DD
-DD AA AA DD DD FF FF 77 77 AA AA 77 77 FF FF > } image } if PT 16 eq { 16 16
-1 [ 16 0 0 16 neg 0 16 ] { < F1 F1 EE EE 1F 1F FF FF F1 F1 EE EE 1F 1F FF FF
-F1 F1 EE EE 1F 1F FF FF F1 F1 EE EE 1F 1F FF FF > } image } if PT 17 eq { 16
-16 1 [ 16 0 0 16 neg 0 16 ] { < EE EE DD DD BB BB FF FF EE EE DD DD BB BB FF
- FF EE EE DD DD BB BB FF FF EE EE DD DD BB BB FF FF > } image } if PT 18 eq {
-16 16 1 [ 16 0 0 16 neg 0 16 ] { < BB BB DD DD EE EE FF FF BB BB DD DD EE EE
-FF FF BB BB DD DD EE EE FF FF BB BB DD DD EE EE FF FF > } image } if PT 19 eq
-{ 16 16 1 [ 16 0 0 16 neg 0 16 ] { < 1F FC 67 F3 7B EF BD DE BD DE DE BD E6
-B3 F8 0F E6 B3 DE BD BD DE BD DE 7B EF 67 F3 1F FC 7F FF > } image } if PT
-20 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < DD DD EE EE EE EE EE EE DD DD BB
-BB BB BB BB BB DD DD EE EE EE EE EE EE DD DD BB BB BB BB BB BB > } image }
-if PT 21 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < 0E 0E EF EF EF EF EF EF E0
-E0 FE FE FE FE FE FE 0E 0E EF EF EF EF EF EF E0 E0 FE FE FE FE FE FE > }
-image } if PT 22 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < 70 70 F7 F7 F7 F7 F7
-F7 07 07 7F 7F 7F 7F 7F 7F 70 70 F7 F7 F7 F7 F7 F7 07 07 7F 7F 7F 7F 7F 7F >
-} image } if PT 23 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < AA AA 55 55 A9 A9
-D1 D1 E1 E1 D1 D1 A9 A9 55 55 AA AA 55 55 A9 A9 D1 D1 E1 E1 D1 D1 A9 A9 55 55
-> } image } if PT 24 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < FF FE FF FC EA
-A8 D5 54 EA A8 D5 54 E8 28 D4 54 E8 E8 D4 D4 E8 EA 54 D5 A8 EA 54 D5 00 C0 00
-80 > } image } if PT 25 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < FF FE FF FC
-FF F8 FF F0 F0 00 F0 00 F0 20 F0 60 F0 E0 F1 E0 F3 E0 F0 00 E0 00 C0 00 80 00
-00 00 > } image } if gr } def /FA { /PT exch def gsave clip 0 0 translate 1 1
-54 { 1 sub 47.2 mul /Xcurr exch def 1 1 74 { 1 sub 47.2 mul /Ycurr exch def
-gsave Xcurr Ycurr translate PT DP gr } for } for gr } def
-/reencdict 24 dict def /ReEncode {reencdict begin /nco&na exch def
-/nfnam exch def /basefontname exch def /basefontdict basefontname findfont def
-/newfont basefontdict maxlength dict def basefontdict {exch dup /FID ne
-{dup /Encoding eq {exch dup length array copy newfont 3 1 roll put} {exch
-newfont 3 1 roll put} ifelse} {pop pop} ifelse } forall newfont
-/FontName nfnam put nco&na aload pop nco&na length 2 idiv {newfont
-/Encoding get 3 1 roll put} repeat nfnam newfont definefont pop end } def
-/accvec [ 176 /agrave 181 /Agrave 190 /acircumflex 192 /Acircumflex
-201 /adieresis 204 /Adieresis 209 /ccedilla 210 /Ccedilla 211 /eacute
-212 /Eacute 213 /egrave 214 /Egrave 215 /ecircumflex 216 /Ecircumflex
-217 /edieresis 218 /Edieresis 219 /icircumflex 220 /Icircumflex
-221 /idieresis 222 /Idieresis 223 /ntilde 224 /Ntilde 226 /ocircumflex
-228 /Ocircumflex 229 /odieresis 230 /Odieresis 231 /ucircumflex 236 /Ucircumflex
-237 /udieresis 238 /Udieresis 239 /aring 242 /Aring 243 /ydieresis
-244 /Ydieresis 246 /aacute 247 /Aacute 252 /ugrave 253 /Ugrave] def
-/Times-Roman /Times-Roman accvec ReEncode
-/Times-Italic /Times-Italic accvec ReEncode
-/Times-Bold /Times-Bold accvec ReEncode
-/Times-BoldItalic /Times-BoldItalic accvec ReEncode
-/Helvetica /Helvetica accvec ReEncode
-/Helvetica-Oblique /Helvetica-Oblique accvec ReEncode
-/Helvetica-Bold /Helvetica-Bold accvec ReEncode
-/Helvetica-BoldOblique /Helvetica-BoldOblique accvec ReEncode
-/Courier /Courier accvec ReEncode
-/Courier-Oblique /Courier-Oblique accvec ReEncode
-/Courier-Bold /Courier-Bold accvec ReEncode
-/Courier-BoldOblique /Courier-BoldOblique accvec ReEncode
-/oshow {gsave [] 0 sd true charpath stroke gr} def
-/stwn { /fs exch def /fn exch def /text exch def fn findfont fs sf
- text sw pop xs add /xs exch def} def
-/stwb { /fs exch def /fn exch def /nbas exch def /textf exch def
-textf length /tlen exch def nbas tlen gt {/nbas tlen def} if
-fn findfont fs sf textf dup length nbas sub nbas getinterval sw
-pop neg xs add /xs exch def} def
-/accspe [ 65 /plusminus 66 /bar 67 /existential 68 /universal
-69 /exclam 70 /numbersign 71 /greater 72 /question 73 /integral
-74 /colon 75 /semicolon 76 /less 77 /bracketleft 78 /bracketright
-79 /greaterequal 80 /braceleft 81 /braceright 82 /radical
-83 /spade 84 /heart 85 /diamond 86 /club 87 /lessequal
-88 /multiply 89 /percent 90 /infinity 48 /circlemultiply 49 /circleplus
-50 /emptyset 51 /lozenge 52 /bullet 53 /arrowright 54 /arrowup
-55 /arrowleft 56 /arrowdown 57 /arrowboth 48 /degree 44 /comma 43 /plus
- 45 /angle 42 /angleleft 47 /divide 61 /notequal 40 /equivalence 41 /second
- 97 /approxequal 98 /congruent 99 /perpendicular 100 /partialdiff 101 /florin
- 102 /intersection 103 /union 104 /propersuperset 105 /reflexsuperset
- 106 /notsubset 107 /propersubset 108 /reflexsubset 109 /element 110 /notelement
- 111 /gradient 112 /logicaland 113 /logicalor 114 /arrowdblboth
- 115 /arrowdblleft 116 /arrowdblup 117 /arrowdblright 118 /arrowdbldown
- 119 /ampersand 120 /omega1 121 /similar 122 /aleph ] def
-/Symbol /Special accspe ReEncode
-/Zone {/iy exch def /ix exch def ix 1 sub 2224 mul 1 iy sub 3144
- mul t} def
-%%EndProlog
- gsave 20 28 t .25 .25 scale gsave
-%%Page: number 1
- gsave
- 1 1 Zone
- gsave 0 0 t black [] 0 sd 1 lw 2223 2224 0 460 bl 2223 2224 0 460 C NC 1779
- 1778 222 683 bl 1779 1778 222 683 C 2223 2224 0 460 C 1083 535 m -3 3 d -3 1 d
- -5 X -3 -1 d -3 -3 d -1 -5 d -3 Y 1 -4 d 3 -3 d 3 -2 d 5 X 3 2 d 3 3 d s 1093
- 539 m -21 Y s 1093 530 m 1 5 d 3 3 d 3 1 d 5 X s 1112 539 m -21 Y s 1112 533 m
- 5 5 d 3 1 d 4 X 3 -1 d 2 -5 d -15 Y s 1157 549 m -31 Y s 1157 535 m -3 3 d -3 1
- d -5 X -3 -1 d -3 -3 d -1 -5 d -3 Y 1 -4 d 3 -3 d 3 -2 d 5 X 3 2 d 3 3 d s 1779
- 1778 222 683 C 222 683 m 97 Y 223 X 1493 Y 222 X -914 Y 222 X -672 Y 223 X 649
- Y 222 X 947 Y 222 X -1493 Y 222 X -107 Y 223 X s NC 222 683 m 1778 Y s 256 683
- m -34 X s 239 728 m -17 X s 239 773 m -17 X s 239 818 m -17 X s 239 863 m -17 X
- s 256 908 m -34 X s 239 953 m -17 X s 239 998 m -17 X s 239 1043 m -17 X s 239
- 1088 m -17 X s 256 1133 m -34 X s 239 1178 m -17 X s 239 1224 m -17 X s 239
- 1269 m -17 X s 239 1314 m -17 X s 256 1359 m -34 X s 239 1404 m -17 X s 239
- 1449 m -17 X s 239 1494 m -17 X s 239 1539 m -17 X s 256 1584 m -34 X s 239
- 1629 m -17 X s 239 1674 m -17 X s 239 1719 m -17 X s 239 1764 m -17 X s 256
- 1809 m -34 X s 239 1854 m -17 X s 239 1899 m -17 X s 239 1945 m -17 X s 239
- 1990 m -17 X s 256 2035 m -34 X s 239 2080 m -17 X s 239 2125 m -17 X s 239
- 2170 m -17 X s 239 2215 m -17 X s 256 2260 m -34 X s 256 2260 m -34 X s 239
- 2305 m -17 X s 239 2350 m -17 X s 239 2395 m -17 X s 239 2440 m -17 X s 162 698
- m -5 -1 d -3 -5 d -1 -7 d -4 Y 1 -8 d 3 -4 d 5 -2 d 3 X 4 2 d 3 4 d 1 8 d 4 Y
- -1 7 d -3 5 d -4 1 d -3 X cl s 68 918 m 3 1 d 5 5 d -31 Y s 102 924 m -4 -2 d
- -3 -4 d -2 -8 d -4 Y 2 -8 d 3 -4 d 4 -1 d 3 X 5 1 d 3 4 d 1 8 d 4 Y -1 8 d -3 4
- d -5 2 d -3 X cl s 132 924 m -5 -2 d -3 -4 d -1 -8 d -4 Y 1 -8 d 3 -4 d 5 -1 d
- 3 X 4 1 d 3 4 d 2 8 d 4 Y -2 8 d -3 4 d -4 2 d -3 X cl s 162 924 m -5 -2 d -3
- -4 d -1 -8 d -4 Y 1 -8 d 3 -4 d 5 -1 d 3 X 4 1 d 3 4 d 1 8 d 4 Y -1 8 d -3 4 d
- -4 2 d -3 X cl s 65 1142 m 1 Y 2 3 d 1 1 d 3 2 d 6 X 3 -2 d 2 -1 d 1 -3 d -3 Y
- -1 -3 d -3 -4 d -15 -15 d 20 X s 102 1149 m -4 -2 d -3 -4 d -2 -7 d -5 Y 2 -7 d
- 3 -5 d 4 -1 d 3 X 5 1 d 3 5 d 1 7 d 5 Y -1 7 d -3 4 d -5 2 d -3 X cl s 132 1149
- m -5 -2 d -3 -4 d -1 -7 d -5 Y 1 -7 d 3 -5 d 5 -1 d 3 X 4 1 d 3 5 d 2 7 d 5 Y
- -2 7 d -3 4 d -4 2 d -3 X cl s 162 1149 m -5 -2 d -3 -4 d -1 -7 d -5 Y 1 -7 d 3
- -5 d 5 -1 d 3 X 4 1 d 3 5 d 1 7 d 5 Y -1 7 d -3 4 d -4 2 d -3 X cl s 67 1374 m
- 16 X -9 -12 d 5 X 3 -1 d 1 -2 d 1 -4 d -3 Y -1 -4 d -3 -3 d -4 -2 d -5 X -4 2 d
- -2 1 d -1 3 d s 102 1374 m -4 -1 d -3 -5 d -2 -7 d -5 Y 2 -7 d 3 -4 d 4 -2 d 3
- X 5 2 d 3 4 d 1 7 d 5 Y -1 7 d -3 5 d -5 1 d -3 X cl s 132 1374 m -5 -1 d -3 -5
- d -1 -7 d -5 Y 1 -7 d 3 -4 d 5 -2 d 3 X 4 2 d 3 4 d 2 7 d 5 Y -2 7 d -3 5 d -4
- 1 d -3 X cl s 162 1374 m -5 -1 d -3 -5 d -1 -7 d -5 Y 1 -7 d 3 -4 d 5 -2 d 3 X
- 4 2 d 3 4 d 1 7 d 5 Y -1 7 d -3 5 d -4 1 d -3 X cl s 79 1600 m -15 -21 d 22 X s
- 79 1600 m -32 Y s 102 1600 m -4 -2 d -3 -4 d -2 -8 d -4 Y 2 -8 d 3 -4 d 4 -2 d
- 3 X 5 2 d 3 4 d 1 8 d 4 Y -1 8 d -3 4 d -5 2 d -3 X cl s 132 1600 m -5 -2 d -3
- -4 d -1 -8 d -4 Y 1 -8 d 3 -4 d 5 -2 d 3 X 4 2 d 3 4 d 2 8 d 4 Y -2 8 d -3 4 d
- -4 2 d -3 X cl s 162 1600 m -5 -2 d -3 -4 d -1 -8 d -4 Y 1 -8 d 3 -4 d 5 -2 d 3
- X 4 2 d 3 4 d 1 8 d 4 Y -1 8 d -3 4 d -4 2 d -3 X cl s 82 1825 m -15 X -2 -13 d
- 2 1 d 4 2 d 5 X 4 -2 d 3 -3 d 1 -4 d -3 Y -1 -5 d -3 -3 d -4 -1 d -5 X -4 1 d
- -2 2 d -1 3 d s 102 1825 m -4 -2 d -3 -4 d -2 -7 d -5 Y 2 -7 d 3 -5 d 4 -1 d 3
- X 5 1 d 3 5 d 1 7 d 5 Y -1 7 d -3 4 d -5 2 d -3 X cl s 132 1825 m -5 -2 d -3 -4
- d -1 -7 d -5 Y 1 -7 d 3 -5 d 5 -1 d 3 X 4 1 d 3 5 d 2 7 d 5 Y -2 7 d -3 4 d -4
- 2 d -3 X cl s 162 1825 m -5 -2 d -3 -4 d -1 -7 d -5 Y 1 -7 d 3 -5 d 5 -1 d 3 X
- 4 1 d 3 5 d 1 7 d 5 Y -1 7 d -3 4 d -4 2 d -3 X cl s 83 2046 m -1 3 d -5 1 d -3
- X -4 -1 d -3 -5 d -2 -7 d -8 Y 2 -5 d 3 -3 d 4 -2 d 2 X 4 2 d 3 3 d 1 4 d 1 Y
- -1 5 d -3 3 d -4 1 d -2 X -4 -1 d -3 -3 d -2 -5 d s 102 2050 m -4 -1 d -3 -5 d
- -2 -7 d -5 Y 2 -7 d 3 -4 d 4 -2 d 3 X 5 2 d 3 4 d 1 7 d 5 Y -1 7 d -3 5 d -5 1
- d -3 X cl s 132 2050 m -5 -1 d -3 -5 d -1 -7 d -5 Y 1 -7 d 3 -4 d 5 -2 d 3 X 4
- 2 d 3 4 d 2 7 d 5 Y -2 7 d -3 5 d -4 1 d -3 X cl s 162 2050 m -5 -1 d -3 -5 d
- -1 -7 d -5 Y 1 -7 d 3 -4 d 5 -2 d 3 X 4 2 d 3 4 d 1 7 d 5 Y -1 7 d -3 5 d -4 1
- d -3 X cl s 84 2275 m -14 -31 d s 64 2275 m 20 X s 102 2275 m -4 -1 d -3 -4 d
- -2 -8 d -4 Y 2 -8 d 3 -4 d 4 -2 d 3 X 5 2 d 3 4 d 1 8 d 4 Y -1 8 d -3 4 d -5 1
- d -3 X cl s 132 2275 m -5 -1 d -3 -4 d -1 -8 d -4 Y 1 -8 d 3 -4 d 5 -2 d 3 X 4
- 2 d 3 4 d 2 8 d 4 Y -2 8 d -3 4 d -4 1 d -3 X cl s 162 2275 m -5 -1 d -3 -4 d
- -1 -8 d -4 Y 1 -8 d 3 -4 d 5 -2 d 3 X 4 2 d 3 4 d 1 8 d 4 Y -1 8 d -3 4 d -4 1
- d -3 X cl s 222 683 m 1779 X s 222 716 m -33 Y s 445 716 m -33 Y s 667 716 m
- -33 Y s 889 716 m -33 Y s 1112 716 m -33 Y s 1334 716 m -33 Y s 1556 716 m -33
- Y s 1778 716 m -33 Y s 2001 716 m -33 Y s 282 641 m 17 X 3 Y -1 3 d -2 2 d -3 1
- d -4 X -3 -1 d -3 -3 d -1 -5 d -3 Y 1 -4 d 3 -3 d 3 -2 d 4 X 3 2 d 3 3 d s 308
- 661 m 2 -2 d 1 2 d -1 1 d -2 -1 d cl s 310 650 m -21 Y s 338 650 m -24 Y -2 -4
- d -1 -1 d -3 -2 d -4 X -3 2 d s 338 646 m -3 3 d -3 1 d -4 X -3 -1 d -3 -3 d -2
- -5 d -3 Y 2 -4 d 3 -3 d 3 -2 d 4 X 3 2 d 3 3 d s 350 661 m -32 Y s 350 644 m 4
- 5 d 3 1 d 5 X 3 -1 d 1 -5 d -15 Y s 379 661 m -26 Y 2 -4 d 3 -2 d 3 X s 375 650
- m 10 X s 531 661 m -3 X -3 -2 d -2 -4 d -26 Y s 519 650 m 10 X s 538 661 m 1 -2
- d 2 2 d -2 1 d -1 -1 d cl s 539 650 m -21 Y s 548 650 m 9 -21 d s 566 650 m -9
- -21 d s 574 641 m 17 X 3 Y -1 3 d -2 2 d -3 1 d -4 X -3 -1 d -3 -3 d -1 -5 d -3
- Y 1 -4 d 3 -3 d 3 -2 d 4 X 3 2 d 3 3 d s 746 661 m -3 X -3 -2 d -1 -4 d -26 Y s
- 734 650 m 11 X s 761 650 m -3 -1 d -3 -3 d -1 -5 d -3 Y 1 -4 d 3 -3 d 3 -2 d 4
- X 3 2 d 3 3 d 2 4 d 3 Y -2 5 d -3 3 d -3 1 d -4 X cl s 783 650 m -15 Y 2 -4 d 3
- -2 d 4 X 3 2 d 5 4 d s 800 650 m -21 Y s 811 650 m -21 Y s 811 641 m 2 5 d 3 3
- d 3 1 d 4 X s 959 650 m -21 Y s 959 644 m 4 5 d 3 1 d 5 X 3 -1 d 1 -5 d -15 Y s
- 986 661 m 1 -2 d 2 2 d -2 1 d -1 -1 d cl s 987 650 m -21 Y s 999 650 m -21 Y s
- 999 644 m 4 5 d 3 1 d 5 X 3 -1 d 1 -5 d -15 Y s 1026 641 m 17 X 3 Y -1 3 d -2 2
- d -3 1 d -4 X -3 -1 d -3 -3 d -1 -5 d -3 Y 1 -4 d 3 -3 d 3 -2 d 4 X 3 2 d 3 3 d
- s 1178 646 m -1 3 d -5 1 d -4 X -5 -1 d -1 -3 d 1 -3 d 3 -2 d 8 -1 d 3 -2 d 1
- -3 d -1 Y -1 -3 d -5 -2 d -4 X -5 2 d -1 3 d s 1187 641 m 18 X 3 Y -2 3 d -1 2
- d -3 1 d -4 X -3 -1 d -3 -3 d -2 -5 d -3 Y 2 -4 d 3 -3 d 3 -2 d 4 X 3 2 d 3 3 d
- s 1212 650 m 9 -21 d s 1230 650 m -9 -21 d s 1237 641 m 18 X 3 Y -1 3 d -2 2 d
- -3 1 d -4 X -3 -1 d -3 -3 d -2 -5 d -3 Y 2 -4 d 3 -3 d 3 -2 d 4 X 3 2 d 3 3 d s
- 1266 650 m -21 Y s 1266 644 m 4 5 d 3 1 d 4 X 3 -1 d 2 -5 d -15 Y s 1435 646 m
- -2 3 d -4 1 d -5 X -4 -1 d -2 -3 d 2 -3 d 3 -2 d 7 -1 d 3 -2 d 2 -3 d -1 Y -2
- -3 d -4 -2 d -5 X -4 2 d -2 3 d s 1443 661 m 2 -2 d 1 2 d -1 1 d -2 -1 d cl s
- 1445 650 m -21 Y s 1455 650 m 17 -21 d s 1472 650 m -17 -21 d s 1615 661 m -26
- Y 2 -4 d 3 -2 d 3 X s 1611 650 m 10 X s 1632 661 m -32 Y s 1632 644 m 4 5 d 3 1
- d 5 X 3 -1 d 1 -5 d -15 Y s 1660 650 m -21 Y s 1660 641 m 1 5 d 3 3 d 3 1 d 5 X
- s 1678 641 m 17 X 3 Y -1 3 d -2 2 d -3 1 d -4 X -3 -1 d -3 -3 d -1 -5 d -3 Y 1
- -4 d 3 -3 d 3 -2 d 4 X 3 2 d 3 3 d s 1704 641 m 18 X 3 Y -1 3 d -2 2 d -3 1 d
- -4 X -3 -1 d -3 -3 d -2 -5 d -3 Y 2 -4 d 3 -3 d 3 -2 d 4 X 3 2 d 3 3 d s 1858
- 661 m -26 Y 1 -4 d 3 -2 d 3 X s 1853 650 m 11 X s 1873 650 m 5 -21 d s 1884 650
- m -6 -21 d s 1884 650 m 6 -21 d s 1896 650 m -6 -21 d s 1913 650 m -3 -1 d -3
- -3 d -2 -5 d -3 Y 2 -4 d 3 -3 d 3 -2 d 4 X 3 2 d 3 3 d 1 4 d 3 Y -1 5 d -3 3 d
- -3 1 d -4 X cl s 1779 1778 222 683 C gr
-showpage
- gr
-%%Trailer
-%%Pages: 1
- gr gr
-%%EOF
diff --git a/src/pawlib/paw/testsuite/paw.commands/nt_pl_2d_1.ref.ps b/src/pawlib/paw/testsuite/paw.commands/nt_pl_2d_1.ref.ps
deleted file mode 100644
index d71d6ef..0000000
--- a/src/pawlib/paw/testsuite/paw.commands/nt_pl_2d_1.ref.ps
+++ /dev/null
@@ -1,2841 +0,0 @@
-%!PS-Adobe-2.0
-%%Title: /disk3/maartenb/cerncvs/paw/testsuite/tmp/nt_pl_2d_ (Portrait A 4)
-%%Pages: (atend)
-%%Creator: HIGZ Version 1.23/06
-%%CreationDate: 96/04/16 14.42
-%%EndComments
-%%BeginProlog
-/s {stroke} def /l {lineto} def /m {moveto} def /t {translate} def
-/sw {stringwidth} def /r {rotate} def /rl {roll} def /R {repeat} def
-/d {rlineto} def /rm {rmoveto} def /gr {grestore} def /f {eofill} def
-/c {setrgbcolor} def /lw {setlinewidth} def /sd {setdash} def
-/cl {closepath} def /sf {scalefont setfont} def /black {0 setgray} def
-/box {m dup 0 exch d exch 0 d 0 exch neg d cl} def
-/NC{systemdict begin initclip end}def/C{NC box clip newpath}def
-/bl {box s} def /bf {box f} def /Y { 0 exch d} def /X { 0 d} def
-/mp {newpath /y exch def /x exch def} def
-/side {[w .77 mul w .23 mul] .385 w mul sd w 0 l currentpoint t -144 r} def
-/mr {mp x y w2 0 360 arc} def /m24 {mr s} def /m20 {mr f} def
-/mb {mp x y w2 add m w2 neg 0 d 0 w neg d w 0 d 0 w d cl} def
-/mt {mp x y w2 add m w2 neg w neg d w 0 d cl} def
-/m21 {mb f} def /m25 {mb s} def /m22 {mt f} def /m26 {mt s} def
-/m23 {mp x y w2 sub m w2 w d w neg 0 d cl f} def
-/m27 {mp x y w2 add m w3 neg w2 neg d w3 w2 neg d w3 w2 d cl s} def
-/m28 {mp x w2 sub y w2 sub w3 add m w3 0 d 0 w3 neg d w3 0 d 0 w3 d w3 0 d
- 0 w3 d w3 neg 0 d 0 w3 d w3 neg 0 d
- 0 w3 neg d w3 neg 0 d cl s } def
-/m29 {mp gsave x w2 sub y w2 add w3 sub m currentpoint t
- 4 {side} repeat cl fill gr} def
-/m30 {mp gsave x w2 sub y w2 add w3 sub m currentpoint t
- 5 {side} repeat s gr} def
-/m31 {mp x y w2 sub m 0 w d x w2 sub y m w 0 d
- x w2 sub y w2 add m w w neg d x w2 sub y w2
- sub m w w d s} def
-/m2 {mp x y w2 sub m 0 w d x w2 sub y m w 0 d s} def
-/m5 {mp x w2 sub y w2 sub m w w d x w2 sub y w2 add m w w neg d s} def
-/DP {/PT exch def gsave 47.2 47.2 scale PT 1 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < AA AA 55 55 AA AA 55 55 AA AA 55 55 AA AA 55 55 AA AA 55 55 AA AA 55 55
-AA AA 55 55 AA AA 55 55 > } image } if PT 2 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < BB BB EE EE BB BB EE EE BB BB EE EE BB BB EE EE BB BB EE EE BB BB EE EE
-BB BB EE EE BB BB EE EE > } image } if PT 3 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < FF FF BB BB FF FF EE EE FF FF BB BB FF FF EE EE FF FF BB BB FF FF EE EE
-FF FF BB BB FF FF EE EE > } image } if PT 4 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < DF DF BF BF 7F 7F FE FE FD FD FB FB F7 F7 EF EF DF DF BF BF 7F 7F FE FE
-FD FD FB FB F7 F7 EF EF > } image } if PT 5 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < 7F 7F BF B F DF DF EF EF F7 F7 FB FB FD FD FE FE 7F 7F BF BF DF DF EF
-EF F7 F7 FB FB FD FD FE FE > } image } if PT 6 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB
-BB BB BB BB BB BB BB BB BB > } image } if PT 7 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < FF FF FF FF FF FF 00 00 FF FF FF FF FF FF 00 00 FF FF FF FF FF FF 00
-00 FF FF FF FF FF FF 00 00 > } image } if PT 8 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < EE EE 47 47 83 83 C5 C5 EE EE 5C 5C 38 38 74 74 EE EE 47 47 83 83 C5
-C5 EE EE 5C 5C 38 38 74 74 > } image } if PT 9 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < EF EF EF EF D7 D7 38 38 FE FE FE FE 7D 7D 83 83 EF EF EF EF D7 D7 38
-38 FE FE FE FE 7D 7D 83 83 > } image } if PT 10 eq { 16 16 1 [ 16 0 0 16 neg
-0 16 ] { < EF EF EF EF EF EF 00 00 FE FE FE FE FE FE 00 00 EF EF EF EF EF EF
-00 00 FE FE FE FE FE FE 00 00 > } image } if PT 11 eq { 16 16 1 [ 16 0 0 16
-neg 0 16 ] { < F7 F7 B6 B6 D5 D5 E3 E3 D5 D5 B6 B6 F7 F7 FF FF 7F 7F 6B 6B 5D
-5D 3E 3E 5D 5D 6B 6B 7F 7F FF FF > } image } if PT 12 eq { 16 16 1 [ 16 0 0
-16 neg 0 16 ] { < E3 E3 DD DD BE BE BE BE BE BE DD DD E3 E3 FF FF 3E 3E DD DD
-EB EB EB EB EB EB DD DD 3E 3E FF FF > } image } if PT 13 eq { 16 16 1 [ 16 0
-0 16 neg 0 16 ] { < FE FE 7D 7D BB BB D7 D7 EF EF D7 D7 BB BB 7D 7D FE FE 7D
-7D BB BB D7 D7 EF EF D7 D7 BB BB 7D 7D > } image } if PT 14 eq { 16 16 1 [ 16
-0 0 16 neg 0 16 ] { < 00 00 EE EF EE EF EE EF 0E E0 EE EE EE EE EE EE 00 EE
-FE EE FE EE FE EE 00 00 FE EF FE EF FE EF > } image } if PT 15 eq { 16 16 1 [
-16 0 0 16 neg 0 16 ] { < DD DD AA AA DD DD FF FF 77 77 AA AA 77 77 FF FF DD
-DD AA AA DD DD FF FF 77 77 AA AA 77 77 FF FF > } image } if PT 16 eq { 16 16
-1 [ 16 0 0 16 neg 0 16 ] { < F1 F1 EE EE 1F 1F FF FF F1 F1 EE EE 1F 1F FF FF
-F1 F1 EE EE 1F 1F FF FF F1 F1 EE EE 1F 1F FF FF > } image } if PT 17 eq { 16
-16 1 [ 16 0 0 16 neg 0 16 ] { < EE EE DD DD BB BB FF FF EE EE DD DD BB BB FF
- FF EE EE DD DD BB BB FF FF EE EE DD DD BB BB FF FF > } image } if PT 18 eq {
-16 16 1 [ 16 0 0 16 neg 0 16 ] { < BB BB DD DD EE EE FF FF BB BB DD DD EE EE
-FF FF BB BB DD DD EE EE FF FF BB BB DD DD EE EE FF FF > } image } if PT 19 eq
-{ 16 16 1 [ 16 0 0 16 neg 0 16 ] { < 1F FC 67 F3 7B EF BD DE BD DE DE BD E6
-B3 F8 0F E6 B3 DE BD BD DE BD DE 7B EF 67 F3 1F FC 7F FF > } image } if PT
-20 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < DD DD EE EE EE EE EE EE DD DD BB
-BB BB BB BB BB DD DD EE EE EE EE EE EE DD DD BB BB BB BB BB BB > } image }
-if PT 21 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < 0E 0E EF EF EF EF EF EF E0
-E0 FE FE FE FE FE FE 0E 0E EF EF EF EF EF EF E0 E0 FE FE FE FE FE FE > }
-image } if PT 22 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < 70 70 F7 F7 F7 F7 F7
-F7 07 07 7F 7F 7F 7F 7F 7F 70 70 F7 F7 F7 F7 F7 F7 07 07 7F 7F 7F 7F 7F 7F >
-} image } if PT 23 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < AA AA 55 55 A9 A9
-D1 D1 E1 E1 D1 D1 A9 A9 55 55 AA AA 55 55 A9 A9 D1 D1 E1 E1 D1 D1 A9 A9 55 55
-> } image } if PT 24 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < FF FE FF FC EA
-A8 D5 54 EA A8 D5 54 E8 28 D4 54 E8 E8 D4 D4 E8 EA 54 D5 A8 EA 54 D5 00 C0 00
-80 > } image } if PT 25 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < FF FE FF FC
-FF F8 FF F0 F0 00 F0 00 F0 20 F0 60 F0 E0 F1 E0 F3 E0 F0 00 E0 00 C0 00 80 00
-00 00 > } image } if gr } def /FA { /PT exch def gsave clip 0 0 translate 1 1
-54 { 1 sub 47.2 mul /Xcurr exch def 1 1 74 { 1 sub 47.2 mul /Ycurr exch def
-gsave Xcurr Ycurr translate PT DP gr } for } for gr } def
-/reencdict 24 dict def /ReEncode {reencdict begin /nco&na exch def
-/nfnam exch def /basefontname exch def /basefontdict basefontname findfont def
-/newfont basefontdict maxlength dict def basefontdict {exch dup /FID ne
-{dup /Encoding eq {exch dup length array copy newfont 3 1 roll put} {exch
-newfont 3 1 roll put} ifelse} {pop pop} ifelse } forall newfont
-/FontName nfnam put nco&na aload pop nco&na length 2 idiv {newfont
-/Encoding get 3 1 roll put} repeat nfnam newfont definefont pop end } def
-/accvec [ 176 /agrave 181 /Agrave 190 /acircumflex 192 /Acircumflex
-201 /adieresis 204 /Adieresis 209 /ccedilla 210 /Ccedilla 211 /eacute
-212 /Eacute 213 /egrave 214 /Egrave 215 /ecircumflex 216 /Ecircumflex
-217 /edieresis 218 /Edieresis 219 /icircumflex 220 /Icircumflex
-221 /idieresis 222 /Idieresis 223 /ntilde 224 /Ntilde 226 /ocircumflex
-228 /Ocircumflex 229 /odieresis 230 /Odieresis 231 /ucircumflex 236 /Ucircumflex
-237 /udieresis 238 /Udieresis 239 /aring 242 /Aring 243 /ydieresis
-244 /Ydieresis 246 /aacute 247 /Aacute 252 /ugrave 253 /Ugrave] def
-/Times-Roman /Times-Roman accvec ReEncode
-/Times-Italic /Times-Italic accvec ReEncode
-/Times-Bold /Times-Bold accvec ReEncode
-/Times-BoldItalic /Times-BoldItalic accvec ReEncode
-/Helvetica /Helvetica accvec ReEncode
-/Helvetica-Oblique /Helvetica-Oblique accvec ReEncode
-/Helvetica-Bold /Helvetica-Bold accvec ReEncode
-/Helvetica-BoldOblique /Helvetica-BoldOblique accvec ReEncode
-/Courier /Courier accvec ReEncode
-/Courier-Oblique /Courier-Oblique accvec ReEncode
-/Courier-Bold /Courier-Bold accvec ReEncode
-/Courier-BoldOblique /Courier-BoldOblique accvec ReEncode
-/oshow {gsave [] 0 sd true charpath stroke gr} def
-/stwn { /fs exch def /fn exch def /text exch def fn findfont fs sf
- text sw pop xs add /xs exch def} def
-/stwb { /fs exch def /fn exch def /nbas exch def /textf exch def
-textf length /tlen exch def nbas tlen gt {/nbas tlen def} if
-fn findfont fs sf textf dup length nbas sub nbas getinterval sw
-pop neg xs add /xs exch def} def
-/accspe [ 65 /plusminus 66 /bar 67 /existential 68 /universal
-69 /exclam 70 /numbersign 71 /greater 72 /question 73 /integral
-74 /colon 75 /semicolon 76 /less 77 /bracketleft 78 /bracketright
-79 /greaterequal 80 /braceleft 81 /braceright 82 /radical
-83 /spade 84 /heart 85 /diamond 86 /club 87 /lessequal
-88 /multiply 89 /percent 90 /infinity 48 /circlemultiply 49 /circleplus
-50 /emptyset 51 /lozenge 52 /bullet 53 /arrowright 54 /arrowup
-55 /arrowleft 56 /arrowdown 57 /arrowboth 48 /degree 44 /comma 43 /plus
- 45 /angle 42 /angleleft 47 /divide 61 /notequal 40 /equivalence 41 /second
- 97 /approxequal 98 /congruent 99 /perpendicular 100 /partialdiff 101 /florin
- 102 /intersection 103 /union 104 /propersuperset 105 /reflexsuperset
- 106 /notsubset 107 /propersubset 108 /reflexsubset 109 /element 110 /notelement
- 111 /gradient 112 /logicaland 113 /logicalor 114 /arrowdblboth
- 115 /arrowdblleft 116 /arrowdblup 117 /arrowdblright 118 /arrowdbldown
- 119 /ampersand 120 /omega1 121 /similar 122 /aleph ] def
-/Symbol /Special accspe ReEncode
-/Zone {/iy exch def /ix exch def ix 1 sub 2224 mul 1 iy sub 3144
- mul t} def
-%%EndProlog
- gsave 20 28 t .25 .25 scale gsave
-%%Page: number 1
- gsave
- 1 1 Zone
- gsave 0 0 t black [] 0 sd 1 lw 2223 2224 0 460 bl 2223 2224 0 460 C NC 1779
- 1778 222 683 bl 1779 1778 222 683 C NC 222 683 m 1778 Y s 256 683 m -34 X s 239
- 727 m -17 X s 239 772 m -17 X s 239 816 m -17 X s 239 861 m -17 X s 256 905 m
- -34 X s 239 950 m -17 X s 239 994 m -17 X s 239 1038 m -17 X s 239 1083 m -17 X
- s 256 1127 m -34 X s 239 1172 m -17 X s 239 1216 m -17 X s 239 1261 m -17 X s
- 239 1305 m -17 X s 256 1350 m -34 X s 239 1394 m -17 X s 239 1439 m -17 X s 239
- 1483 m -17 X s 239 1528 m -17 X s 256 1572 m -34 X s 239 1616 m -17 X s 239
- 1661 m -17 X s 239 1705 m -17 X s 239 1750 m -17 X s 256 1794 m -34 X s 239
- 1839 m -17 X s 239 1883 m -17 X s 239 1928 m -17 X s 239 1972 m -17 X s 256
- 2017 m -34 X s 239 2061 m -17 X s 239 2106 m -17 X s 239 2150 m -17 X s 239
- 2194 m -17 X s 256 2239 m -34 X s 239 2283 m -17 X s 239 2328 m -17 X s 239
- 2372 m -17 X s 239 2417 m -17 X s 256 2461 m -34 X s 116 681 m 26 X s 154 691 m
- 1 Y 2 3 d 1 2 d 3 1 d 6 X 3 -1 d 1 -2 d 2 -3 d -3 Y -2 -3 d -3 -4 d -14 -15 d
- 20 X s 71 903 m 27 X s 113 915 m 3 1 d 4 5 d -31 Y s 141 892 m -2 -1 d 2 -1 d 1
- 1 d -1 1 d cl s 170 921 m -14 X -2 -14 d 2 2 d 4 1 d 5 X 4 -1 d 3 -3 d 1 -5 d
- -3 Y -1 -4 d -3 -3 d -4 -1 d -5 X -4 1 d -2 1 d -1 3 d s 116 1125 m 26 X s 157
- 1137 m 3 2 d 5 4 d -31 Y s 71 1347 m 27 X s 117 1365 m -4 -1 d -3 -5 d -2 -7 d
- -5 Y 2 -7 d 3 -4 d 4 -2 d 3 X 4 2 d 3 4 d 2 7 d 5 Y -2 7 d -3 5 d -4 1 d -3 X
- cl s 141 1337 m -2 -1 d 2 -2 d 1 2 d -1 1 d cl s 170 1365 m -14 X -2 -13 d 2 1
- d 4 2 d 5 X 4 -2 d 3 -3 d 1 -4 d -3 Y -1 -4 d -3 -3 d -4 -2 d -5 X -4 2 d -2 1
- d -1 3 d s 162 1588 m -5 -2 d -3 -4 d -1 -8 d -4 Y 1 -8 d 3 -4 d 5 -2 d 3 X 4 2
- d 3 4 d 1 8 d 4 Y -1 8 d -3 4 d -4 2 d -3 X cl s 117 1810 m -4 -2 d -3 -4 d -2
- -7 d -5 Y 2 -7 d 3 -5 d 4 -1 d 3 X 4 1 d 3 5 d 2 7 d 5 Y -2 7 d -3 4 d -4 2 d
- -3 X cl s 141 1782 m -2 -2 d 2 -1 d 1 1 d -1 2 d cl s 170 1810 m -14 X -2 -13 d
- 2 1 d 4 1 d 5 X 4 -1 d 3 -3 d 1 -4 d -3 Y -1 -5 d -3 -3 d -4 -1 d -5 X -4 1 d
- -2 2 d -1 3 d s 157 2026 m 3 2 d 5 4 d -31 Y s 113 2249 m 3 1 d 4 4 d -31 Y s
- 141 2226 m -2 -1 d 2 -2 d 1 2 d -1 1 d cl s 170 2254 m -14 X -2 -13 d 2 2 d 4 1
- d 5 X 4 -1 d 3 -3 d 1 -5 d -3 Y -1 -4 d -3 -3 d -4 -2 d -5 X -4 2 d -2 1 d -1 3
- d s 154 2469 m 2 Y 2 3 d 1 1 d 3 2 d 6 X 3 -2 d 1 -1 d 2 -3 d -3 Y -2 -3 d -3
- -5 d -14 -14 d 20 X s 222 683 m 1779 X s 371 716 m -33 Y s 408 699 m -16 Y s
- 445 699 m -16 Y s 482 699 m -16 Y s 519 699 m -16 Y s 556 716 m -33 Y s 593 699
- m -16 Y s 630 699 m -16 Y s 667 699 m -16 Y s 704 699 m -16 Y s 741 716 m -33 Y
- s 778 699 m -16 Y s 815 699 m -16 Y s 852 699 m -16 Y s 889 699 m -16 Y s 926
- 716 m -33 Y s 963 699 m -16 Y s 1000 699 m -16 Y s 1037 699 m -16 Y s 1074 699
- m -16 Y s 1112 716 m -33 Y s 1149 699 m -16 Y s 1186 699 m -16 Y s 1223 699 m
- -16 Y s 1260 699 m -16 Y s 1297 716 m -33 Y s 1334 699 m -16 Y s 1371 699 m -16
- Y s 1408 699 m -16 Y s 1445 699 m -16 Y s 1482 716 m -33 Y s 1519 699 m -16 Y s
- 1556 699 m -16 Y s 1593 699 m -16 Y s 1630 699 m -16 Y s 1667 716 m -33 Y s
- 1704 699 m -16 Y s 1741 699 m -16 Y s 1778 699 m -16 Y s 1815 699 m -16 Y s
- 1853 716 m -33 Y s 371 716 m -33 Y s 333 699 m -16 Y s 296 699 m -16 Y s 259
- 699 m -16 Y s 1853 716 m -33 Y s 1890 699 m -16 Y s 1927 699 m -16 Y s 1964 699
- m -16 Y s 2001 699 m -16 Y s 369 661 m -4 -2 d -3 -4 d -2 -8 d -4 Y 2 -8 d 3 -4
- d 4 -2 d 3 X 4 2 d 3 4 d 2 8 d 4 Y -2 8 d -3 4 d -4 2 d -3 X cl s 517 661 m -4
- -2 d -3 -4 d -2 -8 d -4 Y 2 -8 d 3 -4 d 4 -2 d 3 X 5 2 d 3 4 d 1 8 d 4 Y -1 8 d
- -3 4 d -5 2 d -3 X cl s 541 632 m -2 -1 d 2 -2 d 1 2 d -1 1 d cl s 554 653 m 2
- Y 2 3 d 1 1 d 3 2 d 6 X 3 -2 d 2 -1 d 1 -3 d -3 Y -1 -3 d -3 -5 d -15 -15 d 21
- X s 600 661 m -15 X -1 -14 d 1 2 d 5 1 d 4 X 5 -1 d 3 -3 d 1 -5 d -3 Y -1 -4 d
- -3 -3 d -5 -2 d -4 X -5 2 d -1 1 d -2 3 d s 717 661 m -4 -2 d -3 -4 d -2 -8 d
- -4 Y 2 -8 d 3 -4 d 4 -2 d 3 X 5 2 d 3 4 d 1 8 d 4 Y -1 8 d -3 4 d -5 2 d -3 X
- cl s 741 632 m -1 -1 d 1 -2 d 1 2 d -1 1 d cl s 771 661 m -15 X -2 -14 d 2 2 d
- 4 1 d 5 X 4 -1 d 3 -3 d 2 -5 d -3 Y -2 -4 d -3 -3 d -4 -2 d -5 X -4 2 d -2 1 d
- -1 3 d s 888 661 m -5 -2 d -3 -4 d -1 -8 d -4 Y 1 -8 d 3 -4 d 5 -2 d 3 X 4 2 d
- 3 4 d 2 8 d 4 Y -2 8 d -3 4 d -4 2 d -3 X cl s 911 632 m -1 -1 d 1 -2 d 2 2 d
- -2 1 d cl s 944 661 m -15 -32 d s 923 661 m 21 X s 971 661 m -15 X -2 -14 d 2 2
- d 4 1 d 5 X 4 -1 d 3 -3 d 2 -5 d -3 Y -2 -4 d -3 -3 d -4 -2 d -5 X -4 2 d -2 1
- d -1 3 d s 1106 655 m 3 1 d 4 5 d -32 Y s 1254 655 m 3 1 d 4 5 d -32 Y s 1282
- 632 m -2 -1 d 2 -2 d 1 2 d -1 1 d cl s 1295 653 m 2 Y 2 3 d 1 1 d 3 2 d 6 X 3
- -2 d 2 -1 d 1 -3 d -3 Y -1 -3 d -3 -5 d -15 -15 d 21 X s 1341 661 m -15 X -1
- -14 d 1 2 d 5 1 d 4 X 5 -1 d 3 -3 d 1 -5 d -3 Y -1 -4 d -3 -3 d -5 -2 d -4 X -5
- 2 d -1 1 d -2 3 d s 1454 655 m 3 1 d 4 5 d -32 Y s 1482 632 m -1 -1 d 1 -2 d 1
- 2 d -1 1 d cl s 1512 661 m -15 X -2 -14 d 2 2 d 4 1 d 5 X 4 -1 d 3 -3 d 2 -5 d
- -3 Y -2 -4 d -3 -3 d -4 -2 d -5 X -4 2 d -2 1 d -1 3 d s 1624 655 m 3 1 d 5 5 d
- -32 Y s 1652 632 m -1 -1 d 1 -2 d 2 2 d -2 1 d cl s 1685 661 m -15 -32 d s 1664
- 661 m 21 X s 1712 661 m -15 X -2 -14 d 2 2 d 4 1 d 5 X 4 -1 d 3 -3 d 2 -5 d -3
- Y -2 -4 d -3 -3 d -4 -2 d -5 X -4 2 d -2 1 d -1 3 d s 1844 653 m 2 Y 1 3 d 2 1
- d 3 2 d 5 X 3 -2 d 2 -1 d 1 -3 d -3 Y -1 -3 d -3 -5 d -15 -15 d 21 X s 1779
- 1778 222 683 C 2223 2224 0 460 C 1040 539 m 9 -21 d s 1057 539 m -8 -21 d -3 -6
- d -3 -3 d -3 -1 d -2 X s 1077 549 m 12 -31 d s 1100 549 m -11 -31 d s 1127 545
- m -3 3 d -4 1 d -6 X -5 -1 d -3 -3 d -3 Y 2 -3 d 1 -1 d 3 -2 d 9 -3 d 3 -1 d 2
- -2 d 1 -3 d -4 Y -3 -3 d -4 -2 d -6 X -5 2 d -3 3 d s 1139 521 m -2 -1 d 2 -2 d
- 1 2 d -1 1 d cl s 1166 539 m 16 -21 d s 1182 539 m -16 -21 d s 1779 1778 222
- 683 C /w 2 def /w2 {w 2 div} def /w3 {w 3 div} def 371 1179 1212 1524 1684 1500
- 1380 1455 1669 1688 492 1820 865 1386 656 1600 1064 1803 1556 1611 1272 1895
- 1810 1281 815 1186 1048 1304 1842 1929 1518 1437 1287 1610 1021 1335 951 1538
- 459 1375 1541 1524 385 1358 1333 1584 409 1859 414 1091 750 1632 1830 1474 1454
- 1657 1794 1441 1071 1916 1510 1409 503 1659 712 1322 434 1567 725 1776 1583
- 1351 1013 1046 995 1695 1198 1724 975 1221 959 1240 1706 1403 753 1926 468 1522
- 523 1398 883 1510 989 1848 1414 1214 1081 1339 1835 1705 800 1300 971 1772 1663
- 1359 1564 1919 1768 1718 748 1910 803 1317 1097 1769 665 1524 1629 1505 1503
- 1243 1746 1657 1448 1384 946 2075 471 1702 1195 1485 1796 1464 1729 1867 933
- 1692 1195 1734 485 1646 1129 1693 1066 1383 764 1803 471 1358 1624 1371 1620
- 1601 723 1335 1776 1590 1201 1676 486 1737 1050 1628 1650 1202 1688 1803 1171
- 1426 566 1713 1642 1890 1050 1284 1774 1555 1036 1423 1687 1648 1314 1460 563
- 1469 1287 1325 789 1949 484 1631 1690 1802 613 1387 1835 1628 1366 1539 100 {
- m20} R 1233 1499 469 1393 442 1456 654 1483 1565 1466 794 1499 1138 1491 1563
- 1373 691 1597 1494 1480 1185 1546 588 1681 1077 1089 836 1655 799 2008 1587
- 1882 434 1631 1016 2013 645 1713 753 1789 1835 1293 776 1427 1835 1967 1770
- 1440 382 1876 817 1361 810 1338 1114 1611 536 1669 1845 1720 1402 1848 630 1876
- 549 1561 1245 1601 388 1687 1398 1529 1471 1515 1080 1709 1528 1270 806 1654
- 1570 1710 1825 1587 1617 1670 618 1644 1529 2020 1680 1766 1692 1821 1188 1729
- 811 1641 741 1436 1217 1259 1761 1691 1304 1425 490 1271 1848 1575 423 1632 673
- 1261 1118 2168 378 1514 1058 1585 1601 1323 1171 1412 991 1398 710 1413 513
- 1864 801 1365 872 1274 941 1169 743 1577 1178 1309 1264 1614 1212 1377 672 1217
- 1306 1394 1193 1436 508 1879 1286 1786 913 1503 1744 1481 1330 1258 452 2230
- 1544 1670 399 1600 1157 1605 531 1747 456 1595 663 1371 823 1729 949 1631 611
- 1549 1235 1431 992 1777 734 2261 1847 1665 1303 2087 378 1547 779 1306 669 1624
- 1707 1235 1826 1438 100 { m20} R 742 1362 560 1480 1835 1073 1551 1642 404 1706
- 1538 1908 891 1851 846 1087 1276 1540 588 1957 802 1857 1353 1459 585 1654 1376
- 1333 1666 1738 1561 1987 1304 1534 1111 1542 1742 1552 694 1592 854 1743 388
- 1506 872 1465 687 1804 882 1483 641 1576 816 1656 1196 1682 465 1209 1780 1887
- 1117 1632 1752 1756 833 1424 1494 1426 635 1720 1186 1369 1033 1793 1253 1485
- 1113 1528 539 1680 970 1683 1753 1600 1349 1467 391 1487 820 1285 789 1294 1553
- 1488 1360 1337 1799 1649 804 1402 954 2007 1803 1354 1534 1560 730 1267 381
- 1463 1638 1343 909 1170 1139 1628 1769 1525 1373 1485 832 1624 906 1458 1150
- 1812 1052 1315 767 1425 1099 1391 1022 1047 761 1284 1380 1432 1072 1482 1746
- 1261 1591 1695 1384 1745 677 1748 1187 1557 1025 1073 497 1823 681 1229 716
- 1635 1093 1560 638 1520 863 1887 1202 1376 899 1848 1389 1631 1700 1451 1363
- 1072 1582 1415 1118 1773 1223 1239 1585 1750 1256 1569 1041 1567 1013 1443 853
- 1270 1514 1855 665 1483 1468 1411 589 2075 613 2003 100 { m20} R 1671 1583 870
- 1483 545 2000 1712 1537 1447 1472 1099 1436 1570 1731 1236 1153 894 1882 972
- 1648 1635 1822 1560 1371 414 1646 944 1586 1193 1450 982 1349 1767 1607 1151
- 1577 1521 1458 939 1582 1023 1420 1389 1731 1599 1438 444 1283 1080 1619 675
- 1338 1662 2001 1740 1366 868 1727 1546 1588 1362 1482 635 1779 398 1249 836
- 1653 945 1982 683 1764 1807 1544 1761 1466 403 1698 572 1814 1639 1602 959 1595
- 1120 1720 1798 1522 1065 1852 1711 1276 591 1790 677 1983 1105 1687 1265 1373
- 1540 1530 1140 1766 481 1847 564 1802 1221 1944 604 1819 722 1549 1840 1965 534
- 1261 1622 1620 869 1594 1150 1879 1190 1504 832 1451 749 1433 1070 1551 403
- 1493 478 1477 514 1943 1441 1648 903 1802 536 1788 933 1737 597 1594 569 1253
- 624 1635 1603 1749 746 1524 1527 1469 979 1339 494 973 642 1432 1750 1783 1536
- 1318 487 1306 923 1527 519 1506 1390 1535 1215 1645 1114 1425 1233 1595 401
- 1741 1066 1554 1569 1399 1134 1173 1843 1281 675 1345 437 2078 1509 1674 1359
- 1303 100 { m20} R 587 1521 1505 1221 875 1665 1414 1046 1839 1329 493 1836 668
- 1661 1014 1290 588 1391 1722 1807 1306 1478 474 1521 660 1197 848 1668 1193
- 1746 1539 1366 1397 1567 1681 1536 1577 1783 588 1265 1521 1738 870 1625 1502
- 1712 883 1603 652 1477 514 1695 1447 1561 1714 1662 1412 1534 1357 1656 664
- 1176 620 1654 573 1198 768 1793 402 2055 727 1159 1635 1308 1347 1824 498 1624
- 1749 1620 507 1681 516 1594 743 1803 516 1852 1472 2035 1484 1557 1297 1944
- 1338 1757 822 1438 394 1606 474 1613 698 1620 1729 1477 914 1377 1341 1747 1293
- 1717 1270 1416 1442 1749 1706 1472 1521 1487 1126 1934 525 1100 1011 1753 642
- 1580 1427 1484 1194 1462 540 1758 1465 1650 569 1559 626 1925 1831 1778 784
- 1380 523 1422 869 1616 717 1841 371 1684 1759 1778 814 1299 1566 1463 437 1713
- 797 1717 1035 1756 1765 1555 472 1834 1019 1418 1086 1627 530 1360 715 1829 886
- 1702 916 1393 1388 1799 1324 1507 1089 1060 379 1835 1445 1701 1815 1338 832
- 1192 1483 1683 1159 1899 1194 1664 100 { m20} R 1087 1916 534 1271 1539 1396
- 706 1737 546 1676 1067 1757 1031 1930 832 1078 1657 1378 1222 1650 1370 1588
- 704 1755 1288 1784 1409 1656 1351 1652 1793 1709 1321 1809 713 1254 939 1342
- 1051 1339 839 1236 721 1799 1637 1451 523 1785 1414 1229 570 1241 990 1569 1805
- 1339 885 2012 1483 1978 1633 1935 1322 1861 1268 1515 1361 1131 1032 1918 726
- 1544 1076 1660 1282 1579 819 1548 759 1596 813 1409 958 1338 1159 1712 1305
- 1563 1490 1827 684 1871 733 1540 1495 1775 1074 1518 1601 1000 1050 1165 1819
- 1546 1626 1534 985 1480 1540 1714 397 1482 437 1593 1295 1352 1484 1937 434
- 1246 1727 1620 417 1611 688 1753 1683 1171 967 1631 1694 1508 866 1299 1127
- 1556 1033 1051 1187 1252 1259 1738 620 1626 606 1499 1089 1598 880 1747 1113
- 1538 804 1166 1084 1408 1526 1771 1498 1883 607 1322 452 1752 1198 1594 1848
- 1491 1482 1417 1737 1368 1532 1515 676 1179 1440 1202 1447 1571 435 1693 536
- 1684 1139 1770 1496 1341 579 1675 455 1335 682 1536 1771 1654 510 771 1658 1790
- 100 { m20} R 1735 1611 460 1781 948 1759 427 1595 745 1580 1704 1843 788 1272
- 422 1649 1674 1771 1538 1778 1703 1483 923 1783 594 1566 1132 1392 1024 1464
- 1220 1406 1489 1674 1789 1854 1300 1352 1257 2192 791 1655 1215 1624 1449 1260
- 1082 1647 827 1345 1445 1460 1527 1899 1637 1196 1268 1395 372 1819 1066 1314
- 530 1165 1455 1447 1410 1409 987 1518 1713 1947 1357 1831 1464 1792 941 1174
- 1230 1304 1727 2083 1790 1356 1746 1733 579 1477 1746 1515 1547 1333 1717 1525
- 1214 1532 1626 1478 1600 1788 374 1449 918 1545 1208 1780 989 1421 1495 2100
- 1105 1851 886 1511 1248 1691 491 1391 1171 1214 824 1526 781 1353 1299 1637 693
- 1625 560 1473 1155 1548 1247 1563 945 1438 944 1762 1232 1620 1605 1348 913
- 1841 1119 1819 1435 1585 674 1839 1302 1779 545 1522 1838 1191 466 1783 1537
- 1215 1848 1670 505 1443 634 1474 1177 1489 510 1683 1750 1601 1672 1396 1824
- 1574 961 1392 1795 1817 946 1565 1382 1743 1320 1577 1387 1602 1067 1439 419
- 1416 1689 1847 747 1778 416 1742 1790 1762 100 { m20} R 1308 1558 666 1675 859
- 1580 760 1606 657 1528 518 1705 487 1386 1319 1753 1036 1993 539 1792 1560 1455
- 1488 1815 1539 1569 882 1662 1117 1588 1219 1559 1053 1710 1761 1649 736 1451
- 1781 1423 1433 1614 1484 1506 1802 1842 1096 1519 540 1404 1288 1600 1017 1955
- 1530 1747 1241 1936 877 1695 570 1870 1042 1609 929 1223 380 1327 527 1579 489
- 1417 1796 1788 992 1552 494 1686 804 1478 430 1397 1671 1657 433 1324 1361 1894
- 1017 1765 766 1628 676 1723 933 1407 578 1672 675 1586 1754 1822 547 1823 935
- 1714 960 1528 1774 893 728 2143 1177 1867 907 1666 790 1776 459 1495 1095 1373
- 1196 1613 700 1281 803 1707 1250 1760 1519 1836 413 1534 1704 1515 1851 1600
- 847 1539 1539 1351 1018 1463 1139 1299 903 1383 655 1590 383 1323 1411 1546 807
- 1053 1830 1532 945 1506 771 1869 1423 1678 1523 1722 1374 1656 1303 1411 914
- 1500 681 1546 848 1657 793 1549 1309 1350 914 1738 1398 1729 1270 1308 1035
- 1890 690 1733 1738 1527 1408 1275 512 1454 857 1827 1773 1780 100 { m20} R 1463
- 1760 943 1599 1586 1308 1738 1394 1070 1535 443 1712 907 1671 814 1895 671 1639
- 1150 1428 1719 1671 388 1076 1693 1709 1739 1496 526 1610 1673 1723 1440 1964
- 1088 1255 1369 1802 888 1452 418 1615 1495 1515 1710 1522 425 1394 953 1191 770
- 1780 1666 1180 1838 1643 1429 1328 518 1442 1023 1476 1095 1666 1354 1429 1569
- 1319 1212 1274 688 1302 1452 1534 1509 1280 1567 1509 1176 1522 1281 2041 817
- 1685 549 1757 555 1653 583 1241 1246 1655 1574 1711 1693 1476 1586 1621 1236
- 1840 1158 1977 1703 1601 1421 1255 1806 1207 1445 1777 607 1264 1226 1312 1632
- 1569 492 1576 1454 1300 1275 1093 1749 1427 1040 1749 784 1616 958 1456 1318
- 1912 454 1442 1634 1848 1825 1780 1812 1617 534 1491 1563 1606 772 1816 1818
- 1372 1589 1210 372 1879 1717 1837 1143 1798 835 1052 1031 1461 949 1593 1810
- 1476 1699 1507 860 1296 1758 1945 853 1318 392 1282 1046 1266 1334 1310 1711
- 1570 1387 1101 494 1420 950 1557 1065 1227 1368 1614 408 1754 1159 1563 509
- 1163 1111 1405 768 1248 100 { m20} R 698 1636 1756 1147 1269 1647 1050 1550
- 1344 1765 954 1800 501 1888 705 1503 1006 1118 1667 1709 1630 1440 1489 1249
- 1286 1230 671 1815 940 2088 675 1280 1234 1173 1536 1722 1169 1626 607 1635
- 1098 1553 774 1300 929 1521 407 1262 899 1517 1580 1588 1575 1469 970 1392 1498
- 1621 1003 1999 417 1856 1016 1977 1154 1762 816 1330 1171 1690 1262 1545 803
- 1736 1157 1802 1792 1379 494 1033 914 1477 1054 1771 1357 1723 723 1747 890
- 1729 1377 1600 538 1826 1573 1817 1698 1650 1680 1415 1651 1607 769 1666 1315
- 1598 1292 1505 573 1541 1308 1408 506 1841 409 1811 776 1824 520 1140 1490 1453
- 1672 1572 528 1512 1674 1237 1378 1331 1156 1595 1065 1889 545 1404 1138 1464
- 1645 1246 879 1644 1723 1277 1599 1739 1165 1669 1168 1444 1135 1220 450 1703
- 1206 1508 1312 1498 776 1983 1437 1543 1176 1460 465 1804 941 1620 1417 1527
- 478 1703 1436 1719 911 1955 1334 1754 1249 1636 451 1593 948 1624 852 1398 629
- 1754 490 1044 1157 1631 505 1178 1427 1733 956 1671 1717 1655 100 { m20} R 1363
- 1611 1676 1396 696 1645 1762 1634 1625 1516 1267 1329 643 1661 660 1470 802
- 1950 1119 1741 806 1370 1518 1627 803 1527 1154 1612 973 1315 1786 1351 1037
- 1467 776 1695 1402 1387 466 1480 1041 1598 659 2242 1511 1111 1481 1456 876
- 1837 534 1704 1065 1348 1738 1394 1248 1302 764 1755 584 1722 1529 1576 593
- 1442 898 1449 1321 1555 488 1840 1569 1824 1451 1654 397 1836 1760 1950 698
- 1419 1389 1900 1110 1691 905 1304 545 1528 392 1737 1178 1337 1010 1407 1801
- 1761 991 1694 1176 1125 648 1660 946 1854 652 1716 791 1440 389 1597 1753 1934
- 1386 2060 924 1475 731 1713 1167 1631 379 1431 1079 1597 1109 1715 1692 1603
- 1457 1708 424 1616 689 1574 906 1501 1609 1725 1529 1435 838 1584 1281 1712
- 1390 1611 1023 1961 1644 1542 1020 1608 1536 1586 1378 1359 1612 1749 1174 1337
- 1407 1982 795 1689 1484 1322 1294 1520 911 1649 1045 1057 1185 1871 1038 2004
- 832 1877 1251 1350 1454 1597 1472 1586 529 1514 1031 1494 1090 1793 1438 1521
- 755 1606 837 1461 1026 1734 100 { m20} R 743 1440 1160 1566 1158 1378 1779 1421
- 1687 1663 1348 1657 1429 1427 931 1431 1508 1664 1224 1804 702 1298 732 1612
- 1349 1601 1417 1631 648 1828 1127 1269 1289 1412 1021 1745 1102 1945 1835 1410
- 1407 1756 1244 1406 1717 1499 1728 1408 1494 1575 1012 1318 1075 1983 1411 1310
- 529 1906 800 1464 773 1653 1546 2025 1320 1735 1746 1600 1100 1541 1022 1434
- 1360 1791 847 1411 945 1482 1729 1641 401 1268 393 1512 1028 1591 1340 1422
- 1296 1874 765 2080 1844 1437 1627 1639 1643 1053 1592 1343 1015 1507 1808 1482
- 1772 1286 589 1625 420 1545 687 1481 1808 1293 1475 1530 1407 1676 624 1319
- 1582 1669 786 1772 1550 1452 1750 1325 914 1089 1778 1681 775 2098 1207 1701
- 899 1724 774 1679 1819 1933 1208 1434 1437 1422 1452 1357 1257 1674 1564 1860
- 892 1456 704 1561 708 1829 1697 1377 1511 1593 569 1618 702 1890 1022 1584 644
- 1709 439 1609 1493 1716 909 1415 426 1714 812 1819 408 1294 1360 1792 1787 1480
- 1823 1318 922 1922 834 1474 1356 1803 1369 1688 1772 1585 796 1526 100 { m20} R
- 717 1489 543 1383 1650 1856 1566 2109 1531 1350 454 1573 460 1300 919 1422 1553
- 1678 1358 1490 419 1781 920 1353 916 1872 1777 1579 1723 1351 1808 1248 651
- 1439 750 1535 1484 1356 690 1338 609 1453 824 1689 1019 1680 470 1478 1710 1968
- 833 1722 951 1479 867 1841 1628 1462 596 1257 1097 1473 416 1597 1217 1555 1716
- 1884 1294 1429 987 1546 958 1208 1684 1281 1749 1579 490 1358 1158 1259 488
- 1920 470 1146 1330 1592 523 1395 872 975 1075 1472 1295 1556 1579 1887 1397
- 1536 1195 1548 912 1176 1378 1054 1546 1676 432 1315 1644 1140 1334 1459 1025
- 1491 1499 1226 1763 1536 1026 1549 741 1526 514 1681 1473 1414 760 1407 982
- 1591 1544 1677 1042 1632 1063 1605 583 1702 1306 1751 740 1537 1778 1634 1792
- 1641 1783 1357 1160 1700 972 1801 1307 1880 1453 1316 1627 1929 505 1465 850
- 1964 731 1408 572 1680 1121 1848 846 2013 885 1563 838 1283 403 1238 1175 1588
- 829 1626 671 1515 785 1414 1823 1567 1613 1492 745 1766 1086 1764 1379 1539
- 1189 1430 1643 1672 100 { m20} R 604 1706 945 1713 377 1454 682 1032 1322 1821
- 899 1778 1513 1482 788 1185 1037 1673 1773 1855 1674 1425 1712 1283 1198 1239
- 1620 2164 743 1827 973 1888 1685 1194 507 1859 791 1636 1583 1700 816 1452 1483
- 1855 1106 1836 945 1657 440 1390 1623 1276 669 1405 959 1580 1640 1769 1028
- 1478 1627 1514 584 1574 375 1481 444 1760 931 1614 620 1863 956 1704 1652 1365
- 530 1626 854 1869 1286 1848 1808 1350 608 1869 873 1801 970 1548 974 1769 1708
- 1771 1542 1691 372 1627 1763 1781 1059 1956 1637 1292 1474 1224 1569 1836 1745
- 1722 1824 1735 1546 1720 1387 1615 1826 1502 1036 1598 1343 1602 1587 1375 989
- 1941 1378 1457 534 1432 1542 1227 576 1721 1781 1659 879 1513 1182 1761 600
- 1663 709 1513 626 1178 1101 1344 533 1699 1818 1513 1619 1388 1765 1852 503
- 1813 1351 1722 1682 1268 1391 1240 635 1466 612 1707 1105 1166 1712 2016 610
- 1651 650 1368 1698 1509 1152 1541 438 1642 848 1539 1124 1628 1626 979 763 1659
- 494 1928 1766 1567 1104 1719 784 1503 648 1721 100 { m20} R 1506 1729 831 1699
- 904 1975 899 1768 1314 1234 667 1670 1769 1557 1800 1931 783 1652 1128 1470
- 1321 1766 1148 2122 659 1704 961 1992 1297 1548 1182 1912 941 1670 670 1457 852
- 1392 987 2078 1818 1272 1756 1172 1036 1499 461 1871 566 1177 835 1918 441 1533
- 671 1675 630 1410 949 1795 1025 1209 921 1330 411 1399 687 1409 552 1748 1537
- 1778 940 1472 684 1795 1182 1692 871 1392 1458 1349 756 1628 1650 1780 723 1289
- 810 1565 1835 1391 1689 1676 1625 1922 567 1372 1194 1179 403 1699 685 1440 792
- 1281 918 1859 998 1320 546 2167 1237 1422 1005 1630 1692 1652 660 1936 594 1709
- 1552 1399 1777 1623 910 1452 604 1331 700 1807 441 1272 1739 1665 1744 1540
- 1676 1188 1231 1576 1304 1445 445 1908 983 1751 1491 1764 1229 1745 655 1588
- 1459 1823 598 1678 1206 1690 1027 1837 1744 1500 446 1442 660 1567 413 1504 444
- 1383 1452 1192 1730 1861 1166 1446 1539 1603 571 1873 685 1853 962 1840 376
- 1742 846 1136 1536 1808 1240 1694 1713 1431 739 1137 875 1448 100 { m20} R 996
- 1631 881 1469 662 1372 389 1845 896 1348 1631 1126 969 1151 1355 1305 1513 1362
- 594 1598 1324 1947 1350 1592 1103 1534 1833 1784 991 1414 1021 1242 621 1802
- 1583 1626 1649 1473 661 1583 460 1512 629 1902 1103 1360 624 1370 1479 1574
- 1522 1539 1525 1426 1594 1329 1133 1158 1214 1783 660 1423 896 1614 1669 1958
- 857 1691 1662 1226 1073 1247 812 1872 1466 2187 439 1662 1417 1363 1711 1341
- 1483 1531 1581 2045 380 1623 842 1133 973 1707 597 1471 1623 1932 621 1476 1125
- 1133 1308 1514 1322 1557 1025 1756 1341 1773 608 1578 569 1668 1138 1215 1844
- 1374 731 1763 1791 1548 1008 1786 867 1734 1291 1794 1570 1352 1206 1165 1414
- 1643 1631 1736 1155 1182 1203 1538 1471 1429 847 1744 1303 1603 1643 1433 636
- 1205 805 1698 1839 1310 1231 1659 887 1593 996 1460 1819 1677 663 866 845 1702
- 1263 1536 828 1033 1122 1621 1132 1651 836 2061 1521 1603 803 1428 1720 1530
- 836 1699 488 1358 778 1676 1346 1905 1814 1363 1246 1547 585 1877 818 1830 1416
- 1590 1806 1733 100 { m20} R 571 1359 795 1738 644 1789 412 1592 1188 1964 718
- 1360 392 1964 1548 1447 748 1518 1317 1826 1035 1476 1668 1975 806 1406 1397
- 1430 1685 803 842 1656 1816 1618 1096 1684 1225 2078 1051 1897 1515 1881 1186
- 1272 1471 1486 1166 1832 1481 1363 1542 1222 1740 1460 905 1437 1851 1383 1081
- 1480 1119 1262 577 1371 1649 1820 959 1448 376 1243 1811 1694 570 1662 756 1302
- 591 1013 1587 1424 1387 1486 574 1330 1452 1682 871 1429 1838 1722 651 1559
- 1590 1405 884 1216 852 1156 1604 1670 1666 1522 959 1998 695 1585 1455 1603
- 1690 1330 1240 1741 761 1523 1375 1216 987 1503 394 1365 752 1476 1760 1890 519
- 1656 762 1397 1496 1258 1262 1702 863 1385 605 1533 979 1571 994 1553 712 1411
- 1541 1499 1191 1690 1558 1131 448 1464 631 1497 1680 1315 1676 1556 1842 1646
- 960 1553 1383 1361 1374 1500 725 1693 997 1368 1804 1373 691 1916 1376 1264
- 1480 1567 423 1767 1567 1612 1523 1770 913 1413 442 1647 812 1577 405 1255 805
- 1418 1253 1446 966 1657 1636 1779 1731 1553 100 { m20} R 1229 1546 898 1512 431
- 1796 1835 1779 709 1442 1748 1650 1578 1928 1776 1674 1372 1381 1457 1549 550
- 1731 910 1502 714 1532 718 1912 418 1303 1627 1646 1160 1635 1094 1893 1140
- 1403 1226 1788 1601 1191 1098 1889 926 1947 1172 1694 1034 1199 1750 1440 1104
- 1550 1544 2102 743 1476 1562 1767 383 1950 1202 1678 1585 1560 1423 1700 1445
- 1614 640 1238 402 1495 536 1737 588 1279 1347 999 607 1670 1113 1666 853 1275
- 1651 1561 1314 1680 808 1743 499 1714 1746 1474 1542 1754 1359 1531 1476 1493
- 876 1418 1624 1565 502 1902 847 1240 1275 1847 1310 1848 1163 1723 448 1860 910
- 1417 881 1513 1002 1361 1538 1842 1222 1965 668 1371 438 1675 1328 1803 1391
- 1686 1600 1612 902 1450 857 1772 1752 1886 1365 1592 1293 1390 724 1320 1666
- 1813 1844 1830 1192 1495 798 1838 989 1309 1473 1672 432 1291 399 1287 542 1719
- 732 1606 1378 1587 1463 1600 1760 1089 1490 1229 1816 987 794 1770 533 1466
- 1291 1528 1352 1623 682 1721 618 1687 1002 1228 1307 1421 1085 1423 537 1319
- 100 { m20} R 1373 1885 1750 1679 388 1101 607 1608 1100 2026 1292 1605 1093
- 1528 1320 1571 1550 1401 743 1625 475 1821 1447 1561 921 1174 1467 1496 716
- 1765 1523 1719 1588 1236 1364 1287 453 1832 1478 1693 1850 1776 1662 1557 650
- 1848 1289 1490 1290 1445 991 1538 1812 1308 1352 1523 1721 1377 1281 1304 454
- 1573 714 1664 1325 1586 892 1731 1474 1349 550 1436 1429 1377 1130 1540 430
- 1420 931 1616 987 1787 1293 1365 876 1292 629 2048 453 1738 404 1625 964 1628
- 995 1124 864 1583 1617 1602 1683 1056 995 1237 916 1409 1028 1634 1291 1530 374
- 1462 530 1373 1730 1909 1520 1692 722 1953 1393 1275 464 1714 975 1690 1197
- 1672 1412 1549 550 1329 804 1278 1224 1444 455 1449 1415 1512 1722 1468 747
- 1488 1285 1918 1370 1606 868 1492 1618 1445 514 1654 1422 1745 416 1522 1371
- 1714 1781 1855 879 1638 1738 2162 388 2059 1368 1588 528 1667 948 1517 1035
- 1615 1523 1269 457 1447 1594 2020 1128 1424 1341 1600 958 1718 1262 1583 436
- 1631 1758 1643 1272 1677 761 1511 859 1399 100 { m20} R 586 1785 1732 1687 1466
- 1787 601 1588 1220 1231 1518 1412 1693 1755 1138 1390 1562 1721 717 1395 1109
- 1323 1014 1661 931 1515 559 1443 979 1709 1087 1490 694 1612 851 1393 1017 1328
- 1600 1692 1445 1340 1646 1601 384 1198 1080 1837 1307 1308 1394 2079 1519 1411
- 1052 1580 1341 1322 1334 1597 1157 1489 770 1101 1471 1824 1257 1301 1427 1563
- 1474 1450 1728 1629 1185 1946 1340 1421 739 1467 1370 1534 1587 1945 1692 1588
- 1111 1694 508 1777 845 1746 1335 1172 628 1511 1411 1405 687 1128 1324 1372
- 1603 1450 650 1880 1044 1906 744 1479 809 1803 1529 1708 908 1272 1736 2055
- 1742 1755 1723 1496 860 1856 1793 1331 1670 1702 1024 1531 867 1457 929 1867
- 811 1715 813 1738 1281 1576 1410 1878 1822 1953 588 1691 820 1511 1644 1400
- 1307 1288 744 1727 432 1194 476 1742 1816 959 1596 1435 971 1956 1480 1512 555
- 1328 461 1401 602 1625 1176 1497 974 1668 1613 1571 1455 1202 1731 1658 525
- 1533 1719 1923 1041 1674 1755 1464 1420 1572 829 1833 1535 1265 1541 1641 1596
- 1821 100 { m20} R 1818 1480 1266 1270 521 1595 1553 1673 1031 1475 461 1794
- 1760 1495 1125 1797 1456 1992 605 1355 867 1792 1478 2059 531 1783 1339 1494
- 1674 1247 468 1717 1361 1531 513 1686 582 1868 1151 1410 1372 1725 1800 1707
- 791 1448 1193 1311 1553 1474 677 1413 639 1598 893 1383 1846 1756 1271 2011
- 1186 1525 1845 1625 1728 1621 417 1632 1694 1506 776 1616 371 1568 1243 1920
- 1661 1778 517 1185 1575 1487 1088 1433 383 2133 1022 1492 961 1233 1419 1900
- 658 1290 1026 1491 48 { m20} R 851 1546 1733 1359 1052 1344 1795 1869 1421 1555
- 1697 1858 640 1730 1481 1530 923 1697 1154 1456 966 1479 905 1507 1545 1373
- 1679 1333 639 1512 819 2073 1721 1623 1040 1559 1837 1379 955 1432 1779 1576
- 659 1533 991 1681 1767 1247 383 1472 1736 1858 780 1490 1038 1578 1279 1744
- 1749 1892 575 1201 1468 1587 586 1881 450 1896 538 1747 1537 1953 1300 1432 702
- 1389 605 1605 729 1538 617 1483 1324 1265 665 1201 1322 1741 596 1667 1197 1645
- 944 1560 481 1801 710 1812 1047 1412 1130 1431 1262 1695 711 1467 857 1785 591
- 1355 1618 1099 1177 1142 432 1817 676 1537 1401 1544 616 1374 627 1679 1581
- 1523 1052 1856 1326 1502 428 1352 1346 1468 916 1183 1791 1505 1259 1366 545
- 1746 1124 1151 1010 1022 828 1515 1559 1745 1621 1357 613 1538 937 1455 1354
- 1590 1438 1670 772 1406 1810 1825 441 1371 997 1495 1464 1604 424 1350 1444
- 1699 1060 1822 1815 1637 1270 1432 473 1496 1721 1570 1272 1703 970 1458 1822
- 1313 1788 1616 1239 1150 1005 1708 1111 1297 1447 1324 100 { m20} R 1799 1528
- 479 1654 427 1791 1758 1602 1141 1751 732 1520 526 1742 658 1473 1091 1735 1634
- 1386 1523 1103 1534 1462 1486 1740 933 1689 860 1578 669 1564 498 1361 439 1671
- 622 1669 900 1597 1035 2023 1164 1886 673 1841 1363 1599 1828 1714 1252 1715
- 539 1509 850 1705 1285 1996 1485 1387 1070 1705 751 1349 917 1705 1021 1390
- 1745 1461 1082 1640 606 1158 747 1292 1098 1351 844 1301 721 1701 1342 1527
- 1270 1740 795 1393 1715 1363 1784 1329 1634 1707 1001 1623 1012 1659 1826 1674
- 1317 1759 1647 1769 543 1704 1568 1517 1762 1797 1298 1582 927 1939 890 1984
- 602 1689 1563 1795 615 1277 446 1193 1262 2015 806 1720 996 1697 1774 1826 1127
- 1624 1079 1231 544 2008 1175 1336 1803 1253 1173 1387 872 1565 557 1260 1626
- 1240 1603 1784 670 1433 535 1520 1704 2091 594 1715 1697 1423 675 1275 599 1650
- 1039 1413 647 1462 1575 1873 456 1493 1083 1377 631 1740 1564 1615 843 1554 737
- 1863 524 1801 1071 1420 1170 1689 403 1775 1539 1755 1703 1501 611 1308 554
- 1310 100 { m20} R 1511 1547 1433 1518 507 1647 572 1616 1590 1717 660 1989 484
- 1453 409 1337 490 2097 1825 1254 1126 1473 411 1306 441 1516 1538 1685 1633
- 2036 1814 1708 547 1375 1314 1506 853 1245 621 1638 1190 1517 764 1689 1144
- 1587 496 1599 1395 1524 1018 1931 629 1290 716 1542 1520 1778 1293 1784 1223
- 1553 526 1569 449 1342 1830 1676 695 1471 480 1765 1251 1533 896 1663 1390 1745
- 1353 1559 702 1618 1545 1796 1645 1520 990 1489 1848 1253 535 2059 669 1720 820
- 1254 1070 1367 1545 1507 1190 1499 1513 1476 1301 1606 531 1819 1774 1538 906
- 1968 782 1676 1652 1418 1732 1770 1021 1549 942 1854 847 1863 1359 1655 1697
- 1405 845 1774 435 1741 1138 1409 1448 1265 581 1898 541 1984 644 1580 663 1571
- 1590 1819 1218 1701 1232 1677 543 1614 1180 1515 1253 1836 1436 1777 1704 1880
- 1680 1297 1692 1444 1443 1668 1330 1548 1644 1435 1011 1426 666 1425 791 1372
- 783 1627 1822 1400 626 1436 1584 1509 1423 1377 830 1426 699 1572 680 1586 1240
- 1381 605 1165 844 1336 452 1289 100 { m20} R 1437 1768 1076 1631 866 1148 383
- 1296 941 1603 1353 1688 1103 1462 615 1919 1754 1546 462 1649 1366 1440 1536
- 1819 1421 1685 1492 1711 1356 1644 803 1912 567 1826 1802 1698 1235 1700 1576
- 1747 1739 1628 617 1634 1050 1477 1154 1442 588 1421 549 1468 1524 1182 550
- 1949 1361 1306 1755 1410 734 1781 1490 1824 1075 1653 1697 1950 1398 1401 1774
- 1463 1179 1457 1205 1801 773 1106 765 1252 1345 1236 687 1917 763 1938 1007
- 1612 1544 1527 1077 1834 1512 1531 982 1997 459 1540 1445 1558 1845 1688 1549
- 1485 769 1627 971 1589 1470 1375 1624 1893 1781 1707 1844 1231 735 1473 870
- 1601 1441 1479 780 1737 1329 1600 1698 1296 430 1347 760 1323 1837 1689 1353
- 1775 975 1598 1214 1539 1160 1414 811 1902 1683 1321 1493 1795 1589 1385 419
- 1152 1685 1196 1702 1184 776 1380 1457 1761 1828 1422 1749 1435 1738 1211 539
- 1618 1830 1517 1507 1335 986 1549 1363 1476 1301 1704 740 1709 1511 1472 568
- 1601 1367 1457 439 1626 1615 1886 1127 1625 483 1471 934 1778 1658 1912 706
- 1452 100 { m20} R 1705 1309 1482 1164 1635 1297 985 1075 1762 1501 1326 1796
- 1036 1623 1470 1450 704 1546 473 1439 1224 1380 395 1642 651 1675 1364 1497 466
- 1373 956 1498 973 1687 1072 1834 1063 1668 1657 1744 1318 1651 409 1730 848
- 1780 1036 1470 426 1676 1713 1599 1328 1878 1370 1599 779 1718 1028 1399 1121
- 1387 1147 1930 1339 1707 1449 1532 684 1416 765 1487 911 1592 1775 1443 1394
- 1680 746 1555 1441 1646 535 1877 550 1598 1571 1475 1590 1175 1601 1674 458
- 2071 1460 1518 906 1658 416 1079 847 1516 1802 1373 1791 1730 1727 1724 1181
- 1387 1328 1516 1330 2015 1636 1560 1451 1986 1186 1465 853 1784 411 1853 1232
- 1783 1779 1713 1693 1476 1521 1545 890 1504 1543 1259 502 1709 1649 1707 1364
- 1839 882 1515 862 1616 432 1540 844 1728 990 1754 398 1706 1495 1477 1595 1789
- 1803 1766 755 1700 1738 1426 1643 1316 1393 1458 1781 1592 1795 1174 855 1783
- 996 1663 1499 1889 1782 1544 718 1705 1712 1845 846 1676 484 1505 537 1884 1670
- 1393 1642 1363 1467 1687 1224 1348 553 1602 100 { m20} R 591 1926 873 1136 705
- 1433 1561 1611 440 1871 422 1572 413 1291 1248 1419 1455 1105 676 1618 410 1452
- 1797 1729 1789 1642 925 1878 524 1273 1639 1900 501 1367 1180 1303 1257 1659
- 945 1417 475 1430 1483 1537 711 1537 1262 1190 579 1827 964 1205 1348 1531 978
- 1479 720 1637 765 1399 1066 1671 506 1363 1129 1180 1621 1216 1149 1704 771
- 1188 429 1461 1299 1739 488 1385 1030 1535 1523 1341 372 1642 561 1449 1069
- 1261 1692 1774 1374 1782 518 1452 525 2007 1833 1703 1338 1449 1712 1804 1562
- 1675 526 1757 1690 1479 1031 1805 1201 1562 782 1452 622 1653 945 1619 1751
- 1497 545 1430 1635 1644 424 1347 1581 1567 1069 1448 1476 1423 1373 1490 1109
- 1758 1041 1710 893 1583 896 1113 504 1513 1229 1722 1842 1576 1246 1603 1838
- 1485 1821 1607 1244 1484 1037 1334 1827 1536 802 1052 378 1568 645 1930 1821
- 2117 1158 1440 980 1455 1584 1464 1408 1180 1303 1622 1734 1669 1101 1927 1748
- 1480 1807 1700 693 1548 1521 1844 1715 1506 563 1821 1617 1508 1587 1762 1129
- 1470 100 { m20} R 855 1620 874 1317 1736 1566 1110 1650 551 1484 1467 1598 1351
- 1422 628 1852 1539 1838 802 1501 428 1478 1675 1939 1678 1557 1246 1530 812
- 1456 1587 1547 1617 1608 731 1840 863 1372 877 1295 1465 1686 1193 1370 1101
- 1680 1271 1372 558 1858 1074 1328 631 1332 1481 1482 1053 1849 1102 1254 697
- 1646 645 1867 641 1242 859 1561 1420 1369 498 1329 1280 1726 1046 1501 793 1523
- 774 1800 1086 1950 991 1772 1007 1747 821 1601 1727 1511 456 1433 1545 1792 463
- 1821 1764 1035 952 1642 1349 1326 1247 1604 371 1731 1643 1587 1677 1502 1532
- 1496 831 2016 1314 1742 567 1584 964 1318 1037 1687 1728 1459 1598 1524 1441
- 1555 1462 1690 1329 1715 723 2002 1132 1542 896 1834 1420 1727 1298 1336 540
- 1459 411 1683 1337 1418 1013 1423 379 1732 660 1524 1103 1828 978 2126 1303
- 1610 563 1642 838 1677 537 1787 663 1319 842 1519 382 1519 1327 1199 1220 1833
- 1346 1564 1750 1393 1559 1195 1224 1746 1597 1718 480 1502 1631 1624 1196 1711
- 773 1581 1274 1407 1720 1574 694 1511 100 { m20} R 831 1707 924 1756 1415 1530
- 545 1625 625 1259 936 1691 905 1443 1049 1144 938 1715 498 1396 1592 1382 1385
- 1312 1823 1755 1840 1280 932 1590 923 1456 1437 1673 1243 1522 583 1837 896
- 1238 1517 1594 1003 1654 922 1605 715 1784 1663 1208 1433 1260 1549 1674 597
- 1408 583 1447 1676 1446 864 1490 614 1635 1698 1352 876 1397 1328 2062 1610
- 1661 1409 1460 1749 1218 1025 1188 627 1234 1154 1939 595 1431 562 1238 1589
- 2009 1263 1783 632 1406 1220 1894 515 1663 1013 1566 1291 1902 1630 1197 1151
- 1705 820 1645 1091 1228 753 1216 748 1220 1562 1549 440 1588 1126 1396 699 1428
- 1760 1677 755 1196 678 1780 836 1646 1057 1618 1075 1434 436 1385 1177 1566
- 1034 1586 1630 1761 1745 1829 929 1624 1029 1712 455 1553 1184 1754 1742 1807
- 1572 1649 898 1707 494 1683 947 1370 1729 1681 488 2187 1057 1300 1176 1228
- 1146 1421 1149 1664 715 1191 1462 1745 751 1861 1118 1827 1415 1607 1625 1235
- 1512 1988 985 1902 756 1336 852 1535 371 1632 862 1174 1756 1502 896 1967 100 {
- m20} R 1245 1271 1525 1604 913 1798 1143 1347 969 1608 1128 1559 1708 1401 645
- 1330 1387 1752 1686 1337 1432 1496 444 1934 877 2228 1003 1516 1665 1764 1464
- 1486 1043 1701 1258 1397 1812 1364 895 1855 863 1857 657 1658 1070 1720 398
- 1544 706 1327 462 1535 1455 1687 1808 1244 1159 1369 552 1348 1687 1298 921
- 1604 1412 1936 921 1908 1186 1249 598 1579 1372 1915 1461 1615 808 1472 1521
- 1257 406 1462 1607 1504 1325 1825 934 1544 434 1123 1325 1713 1107 1886 1011
- 1686 1834 1568 804 1855 1166 1824 888 1302 1462 1505 1009 2196 788 1411 490
- 1610 1045 1514 486 1606 1716 1687 1521 1345 1454 1155 1027 1474 1421 1042 936
- 1420 501 1226 1534 2019 1330 1313 1295 1249 947 1869 402 1694 1192 1561 1405
- 1463 647 1810 1835 1536 1346 1297 925 1568 987 1335 768 1494 1071 1678 1600
- 1671 1171 1492 1021 1420 770 1271 1257 1530 1114 1292 1736 1880 1819 1567 1238
- 1661 1701 1533 460 1483 685 1747 948 1827 720 1409 734 1680 744 1391 1222 1247
- 1663 1532 735 1522 371 1457 595 1526 100 { m20} R 713 1266 597 1585 1706 1428
- 771 1313 1623 1710 1241 1354 686 1524 1668 1440 1522 1592 1757 1354 700 1397
- 660 1410 1437 1843 589 1906 1295 1496 794 1655 1529 1278 475 1599 745 1409 457
- 1389 620 1135 1594 1575 872 1859 612 1419 630 1762 1214 1660 1635 1345 1561
- 1093 921 1260 620 1479 529 1410 1449 1853 1075 1537 701 1700 902 1928 1546 1562
- 541 1272 701 1908 1528 1735 696 1646 1379 1789 1737 2030 1664 1365 1582 1528
- 1134 1484 1332 1551 996 1529 1368 1556 725 1645 1728 1512 545 1552 632 1589
- 1220 1740 892 1799 1763 1836 1056 1467 961 1536 1152 1638 1661 1593 1672 1477
- 711 1753 891 1512 774 1642 924 1746 1622 1637 844 1780 973 1883 1652 1625 1245
- 1751 1024 1573 373 1410 1611 1487 646 1097 661 1643 435 1621 756 1774 1120 1563
- 1050 1424 412 1451 1060 1163 1125 1152 662 1757 1638 1474 1633 1178 1524 1551
- 1346 1347 921 1561 671 1681 1728 1803 432 1363 1613 1471 960 1693 1592 1623
- 1456 1632 1024 1517 730 1921 1411 2078 1246 1512 904 1572 1644 1568 100 { m20
-} R 1508 1474 1152 1173 567 1144 870 1374 1250 1429 1065 1978 1104 1854 953 1420
- 1243 1840 897 1670 1791 1663 780 1525 736 1519 436 1751 1802 1581 1453 1371 551
- 1742 565 1749 1818 1465 518 1545 433 1489 1612 1997 1467 1763 1273 1349 1019
- 1179 692 1472 1407 1562 478 1848 488 1548 658 1948 374 1279 471 1695 917 1748
- 1845 1638 821 1508 1200 1455 560 1606 1485 1656 582 1397 1433 1380 1447 1541
- 1375 1394 978 1599 1392 1634 745 1277 1569 2055 1255 1458 1253 1459 470 1518
- 1540 1675 1003 1887 586 1379 1484 1496 651 1806 1680 1554 1575 2054 1421 1376
- 467 1592 1796 1843 1086 1521 418 1669 1289 1702 1770 1792 1844 1733 453 1400
- 747 1393 477 1697 520 1451 489 1785 1730 1119 1754 1282 1056 1359 688 1855 1013
- 1725 694 1659 991 1254 651 1774 1124 1694 1800 1391 647 1522 824 1591 1833 1694
- 1286 1561 1577 1727 1458 1310 1732 1420 1712 1370 1545 1267 1618 1750 890 1298
- 849 1797 1288 1663 1601 1680 1699 1291 706 1729 844 1625 427 1525 1821 1938
- 1513 1289 1575 1482 100 { m20} R 1721 1459 1500 1167 494 1460 1828 1619 1804
- 1633 1453 1840 1465 1267 469 1497 918 1311 981 1176 759 1842 1743 2066 371 1637
- 467 1670 1268 1873 1079 1955 1355 1631 593 1338 921 1705 1539 1411 508 1766
- 1832 1659 1250 1508 1336 1695 1081 1480 625 1601 1350 1715 391 1251 493 1534
- 1350 1387 625 1567 1519 1661 1570 1501 484 1313 640 971 1750 1776 852 1613 399
- 1511 603 1926 1820 1854 570 1426 740 1404 1196 1758 450 1499 1367 1502 1024
- 1447 526 1573 1196 1836 634 1710 843 1222 1117 1392 1113 1364 402 1143 1574
- 1907 1124 1322 1277 1254 481 1484 631 1364 975 1606 552 1749 973 1633 1642 1746
- 1757 1283 723 1784 671 1567 689 1689 1348 1509 1426 1321 1674 1398 1340 1273
- 1439 1499 1397 1866 828 1320 1180 1389 629 1718 1373 1195 725 1493 1312 1717
- 415 1713 1682 1689 436 1599 1749 1654 1131 2023 1305 1669 395 1382 745 1490 537
- 1573 497 1252 1089 1286 463 1880 806 1666 1411 1556 1816 1933 1312 1487 917
- 1763 427 1573 1457 1531 1370 1876 540 1709 1465 1401 100 { m20} R 1582 1642 772
- 1562 967 1273 1109 1459 727 1536 1258 1649 477 1698 704 1277 1394 1540 1479
- 1748 1242 1693 1554 1274 463 1325 1226 1469 446 1771 1043 1664 1239 1595 430
- 1069 1583 1316 734 1592 1662 1799 557 1645 913 1695 995 1818 1391 1765 1395
- 1416 1831 1573 1840 1906 643 1617 628 1739 378 1495 1784 1201 798 1639 1085
- 1695 1085 1805 1222 1492 1737 1335 1205 1508 1409 1664 1584 1549 1721 997 1658
- 1281 1006 1540 1044 1686 595 1426 1424 1772 765 1490 1754 1675 1735 1539 1118
- 1599 1323 1619 1467 1769 1170 1533 1709 1553 643 1429 846 1627 1797 1636 1381
- 1618 905 1624 1485 1249 1653 1452 1460 1842 680 1821 592 1596 796 1463 941 1597
- 1202 1765 731 1844 1399 1550 644 1642 1639 1233 441 2260 591 1305 1756 1294 868
- 1519 1647 1562 598 1744 1348 1966 1830 1536 1652 1574 703 1397 1743 1471 553
- 1186 1737 1450 1282 1467 591 1330 895 1567 715 1525 679 1380 717 1466 1543 1404
- 1327 1542 1790 1820 779 1213 1761 1577 1211 1404 1195 1954 944 1818 1108 1349
- 1567 1717 100 { m20} R 414 1801 1339 1410 391 1279 1341 1349 1297 1524 1147
- 1603 1818 1305 578 1403 1620 1580 980 1137 1104 1545 1194 1717 839 1431 1059
- 1522 961 1661 1749 1494 465 1836 655 1666 1552 1621 905 1500 1412 1402 592 1383
- 749 1648 1824 1718 834 1772 662 1788 1151 1676 790 1568 392 1914 1635 1626 1514
- 1800 1107 1263 1705 1635 494 1883 1348 1928 1319 1078 1546 2059 513 1544 665
- 1384 1117 1537 1321 1436 1320 1683 1041 1594 1174 1602 372 1714 578 2100 1819
- 1701 544 1632 1161 1284 628 1569 752 1505 1145 1691 896 1890 815 1440 630 1682
- 855 1343 678 2001 1081 1322 1217 1633 1676 1501 655 1833 462 1842 1516 1704 375
- 1645 711 1581 562 1656 519 1617 757 1587 1463 1256 620 1727 930 1559 1057 1747
- 1171 1675 1107 1386 948 1426 1617 1565 1421 1513 953 1545 1372 1840 846 1682
- 1160 1934 1343 1643 1184 1506 1183 1802 1652 1565 1430 1928 1072 1216 764 1902
- 1200 1572 1534 1427 1766 1539 1711 1584 668 1471 1826 1737 1132 1640 544 1521
- 1733 1461 700 1680 770 1653 1049 1392 100 { m20} R 695 1524 1763 1748 844 1914
- 1485 1890 1454 1443 1320 1527 891 1736 720 1964 1711 1635 1415 1857 714 1906
- 1101 1653 1025 1721 549 1925 429 1543 877 1457 1531 1289 907 1661 1024 1915 545
- 1736 520 2021 458 1850 602 1437 1267 1372 1422 1540 910 1795 775 1592 1799 1763
- 1803 1737 1774 1342 397 1610 633 1483 1656 1431 1626 1866 675 1778 1076 1718
- 1030 1609 427 1664 562 1289 512 1416 1512 1322 1533 1979 515 1225 613 1383 1632
- 1744 1612 1190 1667 1704 520 1706 1788 1659 540 1578 1696 1865 579 1541 1852
- 1484 573 1432 1280 1409 1052 1744 1040 1462 1333 1645 1348 1378 866 1918 603
- 1431 421 1549 953 2008 538 1242 390 1343 1226 1752 516 2021 1831 1702 1100 1305
- 383 1548 1290 1656 720 1405 1330 1882 1591 1391 1711 1153 762 1516 1469 1324
- 1286 1943 1019 1397 667 1691 1665 1450 983 976 585 1154 1405 1507 1039 1306
- 1638 1757 658 1286 1839 1641 1468 1661 663 1638 1268 1634 1279 1563 1618 1316
- 1099 1284 972 1830 894 1738 1360 1467 373 1646 1095 1586 1804 1501 100 { m20} R
- 393 1599 402 1503 1551 1559 825 1051 1500 1750 841 1770 528 1064 1539 1561 1824
- 1647 1766 1308 1186 1785 711 1794 969 1607 553 1701 753 1674 1712 1898 1431
- 1560 621 1921 1438 1976 903 2086 1133 1724 848 1810 1532 1130 1566 2092 815
- 1680 904 1396 1542 1534 1022 2185 587 1658 1217 1474 965 1568 764 1648 1777
- 1424 1491 1925 1526 1732 700 1589 1422 1634 1782 1604 812 1562 1571 1064 1365
- 1548 1803 1389 1718 1499 1406 1732 1009 1641 476 1628 551 1824 730 1510 550
- 1496 1509 1552 1531 1505 734 1676 955 1089 1342 1382 1779 1766 620 1598 632
- 1573 1259 1635 731 1585 870 1549 1612 1201 1317 1700 1180 1529 1732 1780 1380
- 1767 1715 1476 1176 1379 550 1222 682 1527 455 1339 1419 1582 875 2101 1575
- 1214 1733 1531 761 1415 1699 1350 1674 1791 1539 1678 1574 1651 1328 1567 1135
- 1797 1412 1612 1010 1356 1137 1581 760 1818 838 1431 1432 1448 1733 1530 1124
- 1750 1263 1587 1350 1804 1574 1760 1280 1232 709 1708 405 1589 1739 1637 1007
- 1430 736 1732 1434 1598 911 1698 100 { m20} R 1319 1355 558 1476 916 1608 1171
- 1533 1570 1370 899 1599 1598 1818 981 1692 1318 1822 1754 1885 1495 1556 1210
- 1259 1383 1527 1124 1895 700 1296 646 1353 1654 1685 969 1642 725 1538 1217
- 1108 1597 1533 1615 1742 1641 1569 1440 1189 949 1136 1480 1686 486 1408 693
- 1716 1579 1729 1025 2072 383 1516 470 1473 1592 2164 1710 1413 1055 1675 1515
- 1482 815 1930 1579 1387 1018 1292 1583 1444 1678 1575 1722 1661 688 1228 1119
- 1846 685 1562 869 1421 576 1159 573 1124 1749 1792 825 1790 887 1514 872 1962
- 1633 1816 562 2020 778 1738 1428 1508 855 1809 581 1820 967 1844 949 1579 602
- 1210 554 1479 1461 1378 1358 1264 1265 1612 1165 1688 877 1923 383 1565 1593
- 1911 864 1490 1752 1342 389 1422 772 1721 647 1798 1141 1239 1139 1511 851 1607
- 1246 1745 1652 1802 604 1949 817 1379 848 1527 1243 1755 608 1413 741 1770 432
- 1320 641 1624 1606 1697 624 1564 1818 1658 1108 1717 1275 1154 1783 1294 1428
- 1459 1819 1478 408 1528 1366 1549 804 1414 1450 1715 489 1791 100 { m20} R 1595
- 1481 896 1410 810 1621 1439 1558 1211 1596 1524 1093 1376 1319 668 1660 601
- 1904 1207 1834 1751 1886 1474 1644 1259 1176 516 1796 1395 1551 1570 1536 1849
- 1688 1744 1414 1644 1704 1185 1663 747 1568 1832 1000 1225 1700 786 1691 511
- 1279 1110 1657 1607 1360 1214 1437 634 1681 890 1335 1236 1539 780 1218 1076
- 1713 1129 1356 396 2005 1343 1919 566 1681 1052 1837 1438 1740 1306 1534 375
- 1200 1235 2074 694 1397 657 1678 1706 1495 947 1642 1819 1443 1265 1311 1569
- 1527 481 1863 771 1608 1374 1673 1292 1476 1170 1420 1146 1309 1723 1707 759
- 1383 1062 1698 816 1531 1790 1561 1264 1550 587 1628 607 1016 1548 1500 1612
- 1586 1535 1935 660 1715 1623 1558 1589 1617 576 1466 929 1813 1558 1375 395
- 1413 597 1624 853 1885 1081 1759 1753 1529 1303 1554 632 1685 686 1660 594 1597
- 1115 1497 1450 1606 1439 1393 1579 1484 1204 1512 965 1690 1446 1479 437 1586
- 944 1279 749 1675 1551 1816 967 1480 1547 1991 1436 1253 1156 1300 1650 1577
- 1179 1769 1683 1729 1271 1185 100 { m20} R 1520 1295 1755 1533 1187 1510 387
- 1690 1644 1438 1267 1796 817 1424 994 1477 797 2070 1587 1977 637 1930 472 1806
- 880 1829 1664 1596 438 1385 558 1637 1552 1914 955 1673 389 1506 1063 1410 757
- 1620 1343 1611 458 1594 1670 1800 1736 1619 477 1593 1025 1528 1439 1814 1431
- 1394 1806 1221 642 1363 1410 1658 1260 1493 1027 1509 501 1517 1467 1500 1581
- 1205 1494 1442 728 1199 1298 1438 611 1422 727 1467 690 1913 1650 1396 727 1639
- 428 1402 1365 1206 1759 1714 1141 1669 504 1276 381 1729 1788 944 1833 1435 946
- 1758 773 1535 1047 1939 484 1060 1069 1757 1846 1203 1763 1385 1749 1404 871
- 1597 1171 1682 554 1413 1036 1586 1404 1451 893 1530 1093 1586 1659 1327 475
- 1477 729 1698 1450 1434 536 1627 1052 1573 1774 1817 1340 1285 1831 1706 1434
- 1774 842 1915 915 1492 1313 1543 1348 1816 441 1537 1633 1583 1543 1694 760
- 1890 1819 1921 476 1467 827 1500 1578 1603 801 1529 1745 1675 1709 1543 1435
- 1356 1599 1538 481 1937 1106 1685 841 1726 514 1431 503 1609 100 { m20} R 688
- 1447 1561 1417 708 1630 968 1222 848 1661 645 1355 377 1850 462 1194 905 1450
- 1551 964 1233 1770 1531 1729 1645 1735 1486 1567 1134 1555 573 1557 1375 1853
- 1297 1443 707 1794 943 1668 822 1649 1765 1326 1713 1341 1526 1369 688 1251
- 1130 1570 1310 1985 1231 1509 818 1637 889 1605 579 1362 381 1553 1487 1497
- 1391 1711 566 1355 1370 1676 1721 1388 980 1749 1014 1504 467 1582 686 1984
- 1502 1859 430 1238 1247 1773 1067 1560 788 1090 780 1539 1609 1705 719 1391 884
- 1517 504 1553 1227 1272 1841 1724 1786 1540 1398 1538 1826 1659 787 1554 956
- 1720 802 1547 783 1426 1225 1557 817 1360 879 1357 493 1492 418 1669 1254 1424
- 1771 1917 1851 1877 1459 1379 951 1339 1230 1588 1701 1286 1049 1432 1510 1790
- 886 1054 1173 1100 1043 1357 1097 2042 1845 1843 1030 1462 1101 1508 1743 1727
- 1594 1295 1488 1572 812 1590 1177 1590 452 1454 1538 1706 1625 1950 557 1189
- 610 1641 1640 1394 1612 1891 1649 1881 934 1646 785 1904 569 1512 1422 1717 562
- 1255 1330 1470 100 { m20} R 706 1926 1748 1319 1681 1713 1170 1593 627 1503
- 1581 1813 1578 1795 1759 1107 1554 1709 1788 1270 1105 1777 1246 1388 1832 1521
- 905 1314 1344 1222 1717 1683 633 2097 1646 1708 965 1785 1032 1877 1549 1666
- 1473 1769 1320 1515 1350 1400 1052 1675 1591 1593 1588 1399 1676 1856 432 1743
- 1411 1566 1688 1359 1640 1616 1476 1700 1078 2070 553 999 819 1416 768 1755
- 1235 1883 1819 1620 748 1844 1012 1966 438 1546 1378 1750 977 1572 1147 1744
- 753 1804 1366 2104 1716 1753 48 { m20} R 992 1387 1074 1917 782 1636 1529 1635
- 1564 1941 1312 1625 980 1350 1791 1633 1290 1664 1381 1779 383 1486 1368 1524
- 1767 1184 994 1494 1573 1932 784 1666 1787 1383 1200 1157 1197 1346 407 1566
- 726 1569 911 1725 1341 1515 1378 1460 814 1416 809 1585 1097 1191 589 1698 620
- 1720 1423 1483 853 1581 399 1643 1425 1523 1684 1444 1369 1680 1278 1420 861
- 1121 1832 1392 1008 1311 903 1566 1322 1654 1020 1632 714 1453 1252 1469 1849
- 1523 1214 1775 915 1660 683 1313 1423 1615 385 1613 1138 1481 886 1683 1123
- 1585 1341 1603 1839 1820 436 1911 501 1762 748 1587 1005 1807 1096 1431 1734
- 1610 986 1880 464 1633 1067 1563 1086 2080 534 1767 379 1427 1147 1186 985 1671
- 536 1734 602 1660 1710 1071 705 1557 502 1729 1425 1616 904 2019 479 1432 1700
- 1753 1521 1997 525 1133 1807 1459 1143 1411 1722 1347 1267 1381 1603 1738 1633
- 1217 1841 1585 1378 1826 516 1801 737 1409 547 1513 522 1573 1270 1820 1201
- 1595 1187 1886 1169 1287 387 1386 1591 1734 773 1062 1097 1372 100 { m20} R
- 1613 1556 610 1475 1134 1478 821 1591 490 1791 820 1676 1670 1379 1195 1198
- 1729 1824 956 1412 1455 1218 1665 1497 708 1416 401 1674 601 1710 1554 1380 831
- 1868 1247 1625 440 1889 1377 1648 1495 1625 1251 2027 1013 1028 1717 1756 1091
- 1339 1780 1272 409 1648 1394 1765 817 1629 1232 1416 1688 1389 1609 1194 513
- 1538 1423 1410 523 1785 1632 1573 1035 1859 1558 1724 1032 1339 1426 1417 813
- 1820 1841 1401 1106 1429 1071 1419 1804 1622 888 1622 422 1445 635 1511 1066
- 1373 684 1731 1759 1759 474 1248 790 1256 1502 1630 1337 1369 1226 1804 440
- 1656 1702 1684 749 1556 724 1545 718 1151 1260 1599 1408 1224 447 1374 1424
- 1507 1434 1809 560 1715 1075 1506 400 1358 1723 1450 1574 1607 1613 1601 1275
- 1619 748 1748 1632 1857 773 1789 1300 1247 1510 1377 1836 1379 1730 1614 1728
- 1885 1623 1123 1605 1377 953 1380 1816 1464 1812 1672 649 1569 1466 1632 1149
- 1602 906 1398 1272 1284 436 1804 1087 1513 1264 1340 1350 1355 1791 1300 920
- 1175 935 1816 1243 1531 1078 1441 100 { m20} R 1486 1622 1607 1296 694 1473
- 1771 1868 989 1863 1249 1919 992 1305 1420 1858 1247 1546 1524 1276 848 1574
- 938 1521 511 2094 1321 1714 1534 1236 666 1616 1370 1906 1440 1560 899 1725
- 1003 1465 1294 1548 1615 1349 1477 1527 1492 1751 1411 1296 717 1598 1409 1048
- 1430 1515 977 1581 890 1656 661 1806 973 1676 477 1568 485 1399 737 1296 408
- 1405 1066 1461 1065 1345 1617 1563 1454 1454 1411 1867 1483 1487 1615 1845 1128
- 1482 1274 1374 1283 1725 659 1461 1778 1654 1630 1456 1523 1518 1400 1618 717
- 1723 1756 1205 1145 1424 993 1388 486 1523 1084 1779 1175 1608 754 1345 627
- 1074 531 1624 1612 2069 1150 1447 1276 1483 1822 1737 1265 1269 522 1509 395
- 1350 1360 1230 532 1516 848 1758 1146 1783 1533 1545 1680 1695 979 1278 1516
- 1691 1310 1115 1307 2022 1523 1307 1597 1357 1612 1627 506 1415 868 1769 1404
- 1664 1231 1439 653 1738 1680 1367 1221 1686 1220 1584 413 1770 1848 1140 498
- 1569 872 1627 512 1435 1728 1437 1763 1876 1178 1201 605 1659 656 1841 715 1319
- 100 { m20} R 1101 1125 703 2097 431 1659 392 1728 1404 1419 1802 1524 1785 1421
- 724 1575 1715 1083 379 1474 1141 1709 1797 1923 1437 1738 615 1783 1746 1393
- 974 1689 1185 1681 923 1699 995 1974 1127 1324 1690 1416 1487 1497 650 1589
- 1347 1356 414 1498 1519 1696 1258 1420 532 1987 815 1782 794 1725 1140 1669
- 1510 1370 938 1716 706 2171 1726 1707 1374 1857 964 1674 1061 1262 900 1580 736
- 1969 1565 2141 736 1989 535 1563 1205 1346 893 1844 893 1673 1280 1912 864 1969
- 732 1593 751 1761 1094 1733 718 2078 1506 1773 408 1586 792 1082 1776 1776 1811
- 1461 1362 1733 1218 1566 710 1480 404 1348 1181 1700 904 1472 933 1849 1221
- 1254 1043 1273 728 1320 528 1476 1174 1313 1005 1540 1570 1132 605 1268 371
- 2004 995 1457 928 1507 1053 1682 424 1637 1270 1599 1181 1359 1666 1614 1464
- 1649 1631 1633 1797 1681 1231 1439 1845 1185 581 1544 590 1441 1278 1370 1046
- 1831 858 1099 1423 1269 1836 1460 990 1765 993 1540 1495 1404 855 1554 1699
- 1663 1704 1341 1391 1265 1687 1619 100 { m20} R 469 1499 1397 1531 477 1499
- 1441 1142 655 1808 1334 1718 655 1875 1200 1259 859 1546 618 1544 1073 1452 571
- 1503 720 1522 1708 1850 390 1941 1589 1539 566 1218 1416 1663 1078 1563 1115
- 1407 713 1594 460 1657 1274 1354 1852 2092 656 1702 959 1519 833 1648 1419 1335
- 412 1443 1775 1559 611 1637 741 1522 873 1877 1746 1673 616 1349 1155 1556 1017
- 1479 709 1315 949 1487 1418 1377 1125 920 1386 1378 1639 1561 1742 1654 735
- 1628 479 1569 486 1226 1330 1649 1212 1549 1851 1602 1690 1405 1273 1407 834
- 1573 1555 1564 1375 1562 1565 1819 408 1642 1509 1909 1492 1219 1472 1573 1413
- 1720 1264 1673 405 1684 1847 1926 804 1196 1825 1561 1843 1468 469 1571 1177
- 1697 1679 1491 594 1494 1048 1488 628 1751 811 1675 439 1568 1810 1365 1778
- 1347 1646 1728 1047 1308 1381 1279 1668 1808 1758 1939 664 1632 1633 1326 530
- 1736 916 1175 1786 1315 441 1737 1745 1750 1266 1279 1648 1436 1189 1982 933
- 1662 1459 1543 638 1016 716 1420 510 1577 439 2153 928 1531 1658 1679 100 { m20
-} R 466 1548 1337 1427 939 1845 763 1542 1104 1696 568 1615 397 1619 1655 1456
- 803 1738 1524 1327 400 1306 424 1660 1730 1721 475 1568 881 2051 693 1493 932
- 1318 1274 1723 637 1767 796 1797 1120 1724 993 1430 544 1620 1689 1510 1651
- 1035 1589 2044 1166 1766 921 1833 1600 1542 580 1362 409 1637 769 1472 894 999
- 1697 1830 1256 1473 1219 1710 1269 1747 1514 1502 580 1433 712 1720 765 1384
- 803 1727 1150 1830 955 1600 714 1565 629 1616 1148 1716 1477 1889 1172 1966
- 1699 1474 1242 1798 1849 1713 1277 1505 429 1620 1441 2126 907 1454 949 1456
- 1406 1540 824 1472 1738 1557 1419 1558 986 1743 1763 1535 736 1958 696 1502
- 1755 1757 1493 1768 841 1926 1324 1656 565 1696 1133 1395 1258 1367 1723 1392
- 375 1414 451 1832 575 1718 643 932 1684 1657 1827 1368 1654 1621 1536 1924 1152
- 1566 1783 1734 677 1917 1690 1526 590 1637 941 1609 1275 1565 1351 1682 1568
- 1270 1391 1586 1223 1475 791 1463 1494 1785 1432 1284 1660 1427 1347 1636 1586
- 1796 1305 1323 882 1252 100 { m20} R 1742 1775 827 1506 876 1429 1160 1784 1147
- 1072 1251 1664 450 1528 371 1283 944 1581 1729 1771 1821 1542 1216 1952 1177
- 1462 1100 1300 908 1690 826 1672 1440 1811 418 1292 971 1615 1810 1579 879 1809
- 1044 1853 981 1802 451 1484 675 1300 719 1521 827 1584 1618 1529 611 1779 1458
- 1592 553 1528 716 1294 1531 1318 1631 1594 1646 1654 1039 1853 1193 1668 402
- 1565 1108 1380 1498 1650 1692 1258 863 2016 1021 1685 1783 1758 1516 1568 558
- 1127 720 1625 1141 1673 456 1511 396 1633 1223 1629 533 1531 1131 1742 1212
- 1374 1308 1347 777 1177 1813 1578 1606 1523 1387 1566 1315 1335 539 1812 1122
- 1727 517 1658 409 1437 1153 1713 1822 1685 863 1261 1390 1355 1469 1662 1058
- 1718 1351 1125 1071 2076 1333 1394 958 1301 1517 1157 1229 1873 1232 1444 573
- 1310 485 1575 1146 1582 1340 1963 512 1467 919 1457 547 1489 1223 1675 1059
- 1483 1420 1655 765 1350 706 1837 417 1545 1766 1568 1472 1401 1506 1632 1529
- 2169 654 1689 936 1454 473 1260 737 1561 1205 1399 764 1373 100 { m20} R 1740
- 1671 1153 1289 381 1766 1445 1916 1469 1769 1081 1891 931 1467 689 2078 1385
- 1477 1123 1607 1064 1393 1466 1167 657 1274 726 1844 1769 1389 1263 1614 550
- 1508 543 1735 845 1549 963 1664 433 1747 1367 1889 829 1376 1101 1362 814 1804
- 806 1523 525 1513 1294 1281 1368 2210 573 1582 1105 2060 1707 2128 494 1370 671
- 1526 1377 1391 1025 1636 1669 1706 1167 1315 822 1508 953 1641 653 1463 1538
- 1306 1554 1763 1531 1921 1567 1788 1727 1600 1000 1698 695 1661 752 1177 991
- 1727 1071 1595 941 1569 1494 1406 1365 1299 1281 1457 371 1304 1052 1026 1532
- 1740 1703 1423 676 1494 918 1593 527 1606 868 1640 1449 2021 483 1789 477 1961
- 551 1718 1427 1549 1351 1361 1340 1239 1277 1347 872 1852 699 1870 752 1832 719
- 1384 1211 1184 1096 1505 786 1772 389 1256 679 1238 1681 1681 1809 1913 1629
- 1618 1198 1837 1580 1725 400 1371 1331 1423 1392 1565 794 1739 431 1615 1508
- 1888 506 1395 1111 1588 1216 1651 1471 1161 721 1674 1234 1626 784 1507 819
- 1596 616 1135 100 { m20} R 582 1090 596 1744 1692 1028 1455 984 1649 1454 1065
- 1478 1008 1668 1219 1635 1715 2162 1225 1733 926 1706 936 1285 1010 1477 1629
- 1778 413 1619 1796 1360 548 1557 1297 1695 1807 1275 1742 1859 978 1421 1220
- 1759 1555 1717 1163 1360 1719 1635 863 1853 1199 1619 1780 1396 1500 1611 1473
- 1369 448 1443 914 1648 530 1576 1507 1230 1065 1924 1594 1466 1773 1915 1364
- 1605 1059 1370 1518 1716 522 1280 688 1300 1623 1194 512 1644 1192 1569 1700
- 1354 477 1635 1399 1654 989 1376 1037 1526 1302 1426 724 1284 1034 1822 973
- 2137 714 1280 1521 1457 804 1641 1763 1721 1261 1545 839 1868 533 1549 574 1289
- 394 1527 1496 1306 1360 1373 952 1732 1521 1322 974 1719 617 1580 1274 1410
- 1163 1847 1454 1667 1244 1746 439 1691 1738 1220 1384 1408 794 2190 380 1653
- 1806 1439 460 1528 667 1469 1082 1516 851 1733 1330 1420 1800 1658 1134 1286
- 1395 1464 596 1440 614 1381 1114 1571 1841 1250 831 1364 409 1630 529 1370 1438
- 1641 1319 1761 1266 1426 1685 1191 979 1566 530 1530 100 { m20} R 410 1450 684
- 1494 1664 1145 861 1371 892 1588 865 1329 1215 1928 1673 1363 582 1729 1721
- 1548 1029 1627 1850 1458 1293 1557 374 1754 1075 1525 1236 763 1153 1675 928
- 2116 1739 1449 528 1456 1852 1430 1011 1703 1191 1503 794 1530 1247 1095 752
- 1921 744 1495 1355 2051 1829 1236 1038 1803 903 1531 1202 1421 551 1619 1319
- 1770 974 1593 1413 1587 705 1733 1712 1612 1578 1630 1394 1863 1398 1476 1824
- 1350 1314 1441 804 1231 1766 1834 1410 1642 1452 1755 1718 1359 873 1638 607
- 1164 1122 1785 1285 1466 1847 1630 1328 1760 1464 1782 1148 1475 439 1606 941
- 1535 445 1625 954 2044 1184 1552 468 1773 1710 1773 1718 1559 732 1377 717 1738
- 1352 1788 1534 1671 640 1732 376 1754 598 997 764 1257 487 1725 1142 1510 561
- 1302 478 1524 1813 1654 476 1636 947 1698 1160 1659 1777 1229 430 1758 463 1622
- 1163 1597 1850 1969 1390 1386 1293 1853 401 1522 1084 1532 1059 1414 830 1458
- 922 1820 912 1817 1122 1805 1407 1795 601 1546 1602 1473 1595 1763 953 1196 442
- 1558 100 { m20} R 377 1693 857 2032 736 1696 699 1744 1839 1463 478 1556 1633
- 1419 520 1640 482 1625 1328 1270 771 1336 555 1799 1193 1767 583 1534 1026 1454
- 854 1875 447 1668 823 1508 1036 1576 1834 1506 714 1599 1695 1479 1119 1446 732
- 1868 751 1932 986 1452 1161 1642 1650 1310 725 1170 1766 1598 1059 1366 1694
- 1800 1643 1959 1508 1661 1005 1921 1774 1775 1279 1877 703 1719 884 1556 871
- 1393 575 2027 1174 1709 1080 1173 1007 1990 932 1170 1291 1632 989 1586 1456
- 1775 538 1128 1803 1583 682 1607 1232 1391 1082 1468 1094 1397 1138 1699 963
- 1445 1101 1645 1757 1303 745 1619 1422 1766 891 1674 914 1704 1053 1317 653
- 1191 756 1654 842 1744 1119 1263 931 1445 387 1882 989 1465 1688 1529 815 1381
- 529 1529 1592 1918 1295 1514 1371 1338 1302 1515 885 1579 877 1658 1607 2049
- 961 1403 1579 1470 1550 1656 895 1325 1210 1221 1451 1619 1679 1790 1355 1534
- 755 1378 1007 1478 926 1672 926 1238 395 1928 1273 1809 1171 1755 1111 1566
- 1748 1870 1416 1516 910 1359 1478 1765 100 { m20} R 1085 1909 758 1376 1825
- 1766 1404 1633 1139 1328 637 1359 1768 1399 1234 1761 1174 1617 1489 1408 839
- 1453 415 1700 1673 1659 1213 1269 640 1637 1741 1572 1118 1778 1513 1547 1334
- 1505 1131 1071 941 1351 1476 1521 1655 1780 803 1430 1587 1879 1449 1811 406
- 1692 1005 1735 447 1500 645 1662 1665 1431 1567 1585 913 1276 1637 1269 1414
- 1470 1644 1747 1192 1382 985 1645 1654 1669 1062 1454 386 1759 806 1472 863
- 1207 994 1451 993 1487 1637 1560 630 1933 923 1430 674 1783 1403 1720 892 1880
- 861 1768 1633 1465 1205 1259 1273 1344 1459 1389 1396 1665 438 1267 703 1674
- 1361 1482 996 1710 431 2036 1250 2057 400 1290 1568 1591 1266 1227 1010 1301
- 1032 1400 544 1383 763 1821 1108 1460 1767 1685 794 1229 397 1481 1716 1421 534
- 1703 464 1427 1110 1388 675 1666 1644 1368 1714 1190 1157 1574 1247 1623 666
- 1544 1207 1494 803 1734 407 1359 1493 1453 1608 1386 724 1440 389 1619 644 1595
- 1840 1498 781 1349 1525 1383 707 1706 1823 1524 449 1754 982 1658 1766 1916 100
- { m20} R 1004 1162 406 1499 1150 1940 1446 1562 773 1334 1563 2126 1421 1735
- 1717 1646 1787 1674 725 1759 1366 1638 1802 1258 836 1547 1115 1658 1468 1600
- 1442 1658 1694 1804 450 1089 953 1591 1087 1189 1108 1252 828 1488 1291 1727
- 461 1284 819 1896 1844 1929 648 1120 798 1550 757 1825 681 1498 1426 1698 1015
- 1756 1316 1623 1089 1622 460 1708 413 1699 1691 1439 1412 1487 1356 1529 1780
- 1976 1001 1438 953 1991 869 1492 751 1376 1769 1869 472 1433 743 2046 949 1790
- 1090 1942 690 1655 868 1425 723 1326 479 1409 1748 1436 655 1546 1134 1414 852
- 1702 1800 1324 652 1658 658 1647 1659 1490 1676 1451 397 1294 646 1503 1806
- 1311 1412 1517 1692 1416 455 1634 436 1824 1711 2028 467 1576 1449 1653 1399
- 1610 1797 1584 774 1774 1210 1726 626 1869 641 1520 490 1835 1808 1483 1629
- 1307 1851 1534 1819 1268 414 1893 415 1704 1371 1509 1188 1664 1209 1567 636
- 2080 1693 1655 1374 1622 589 1474 1055 1290 1129 1151 1568 1506 1077 2114 1641
- 1302 471 1584 1378 1405 524 1690 100 { m20} R 1317 1565 1632 1483 590 1872 396
- 1817 1468 1625 1379 1822 1641 1543 1121 1464 1111 1675 855 1755 1453 1806 1022
- 1535 671 1690 1335 1829 791 1847 1677 1905 630 1360 1296 1366 1462 1340 1650
- 1591 756 1356 1660 1590 770 1877 556 1799 632 1329 410 1575 942 1322 736 1327
- 1313 1502 673 1390 1209 1218 1468 1931 681 1227 1807 1656 1377 1856 722 1970
- 1572 1413 1105 1345 853 1774 1405 1317 1128 1566 1540 1032 957 1709 1783 1538
- 512 1677 1381 1490 480 1177 1123 1707 1484 1460 1632 1239 1480 1643 638 1415
- 746 1564 1145 1171 860 1100 971 1646 1326 1305 628 1826 778 1579 389 1560 703
- 1484 626 1382 1429 1466 1266 2003 1288 1703 1154 1574 389 1689 1410 1540 463
- 1543 378 1234 907 1867 703 1867 449 1528 1411 1389 1459 1649 877 1129 812 1579
- 1367 1130 687 1200 1615 1526 1651 1802 787 1649 447 1876 463 1581 1178 1641 886
- 1718 774 1788 1214 2028 1040 1464 1667 1615 1077 1827 1227 1518 873 1631 1113
- 2024 774 1576 794 1843 868 1631 572 1873 587 1701 799 1708 100 { m20} R 1652
- 1353 851 1837 749 1498 1570 1952 535 2168 855 1440 1468 1372 1334 1851 1055
- 1790 584 1575 1073 1646 1700 1349 1469 1888 1025 1248 823 1490 577 1592 1152
- 1925 1470 1463 1371 1390 1080 1559 1200 1365 489 1540 511 1696 400 1739 1450
- 1701 1149 1208 764 1654 1576 1503 1554 1403 896 1539 763 1125 402 1501 724 1267
- 1699 1777 511 1582 686 1604 1700 1662 521 1833 726 1827 679 1821 445 2115 1847
- 1821 1229 1572 1127 1679 853 1394 1231 1234 1617 1745 1251 1643 813 1745 696
- 1377 1399 1436 1442 1494 645 1343 1296 1379 1584 1658 1068 1624 1739 1920 1180
- 1760 1720 1358 716 1840 912 1544 1781 1668 763 1218 443 1273 1760 1318 1480
- 1368 1144 1459 899 1749 1326 1398 1756 1825 1099 1678 1463 1235 419 1852 389
- 1291 1729 1224 941 1391 1405 1452 1358 1673 919 1738 808 1728 750 980 859 1625
- 778 1564 430 1545 1308 1781 1242 1516 1520 1403 629 1293 381 1721 826 1663 1642
- 1545 1543 1645 866 1667 784 1791 1520 1886 1193 1777 1379 1639 1386 1775 1162
- 1424 1357 2022 100 { m20} R 1274 1657 749 1443 976 1659 1839 1358 1644 1519
- 1749 1494 1015 1366 404 1577 1606 1843 1512 1284 1013 1070 503 1688 501 1604
- 1486 1529 1363 1769 680 1347 1243 1747 1353 1486 724 1606 872 1379 1715 1236
- 792 1486 1646 1594 675 1650 1197 1797 782 1448 617 2037 458 1730 406 1829 1740
- 1456 1607 2145 575 1554 1519 1313 847 1649 1686 1420 1015 1444 657 1553 1224
- 1310 678 1593 1823 1602 651 1448 849 1790 506 1777 1480 1511 1339 1415 516 1727
- 1484 1543 1725 1584 920 1659 402 1885 1416 1530 758 1633 1416 1540 807 1646 916
- 1726 1182 2083 566 1622 1280 1666 426 1214 1318 1643 931 1616 1370 1695 718
- 1191 1304 1658 1514 1581 777 1644 1487 1774 1045 1597 1735 1769 1218 1465 637
- 1884 1824 1600 1296 1736 1487 1522 888 1326 498 1695 757 1531 1692 2066 1301
- 1691 501 1655 1305 1765 649 1399 1609 1359 746 1923 1062 1422 1730 1752 1174
- 1445 681 1540 1367 1208 1028 1666 1414 1624 1201 1705 1371 1506 601 1857 1277
- 1577 1665 1482 1106 1334 1041 1962 1584 1671 1273 1783 100 { m20} R 1745 1561
- 527 1745 1239 1593 928 1840 595 1497 378 2025 1583 1562 1446 1647 1620 1411 737
- 1452 462 1479 695 1673 401 1095 990 2069 1488 1253 1611 1820 501 1591 728 2021
- 678 1424 1074 1631 1358 2085 826 1497 622 1660 1572 1475 619 1623 1196 1506
- 1717 1406 1422 1780 1764 1580 1050 1583 1189 1668 970 1664 585 1538 762 1607
- 1182 1677 1036 1199 404 1497 1009 1471 553 1374 420 1677 1142 1849 1469 1453
- 644 1783 572 1883 835 1997 487 1698 687 1571 1457 1683 1362 1614 985 1876 692
- 1951 648 1829 981 1588 1334 1220 492 1826 453 1412 1689 1417 1025 1592 1400
- 1529 434 1891 1453 1729 1081 1726 1656 1244 547 1707 912 1677 1018 1544 879
- 1248 473 1177 1324 1503 1212 1749 1172 1315 1424 1721 467 1503 1806 1624 398
- 1587 1506 1531 1077 1601 1157 2040 558 2051 575 1449 1702 1628 1146 1508 1486
- 1484 394 1653 428 1558 1076 2017 641 1276 1103 1996 736 1571 498 1375 1507 1869
- 410 1697 1653 1687 904 1447 1133 1722 596 1554 861 1573 797 958 1637 1581 659
- 1679 100 { m20} R 1587 996 800 1687 931 1501 1181 1866 1492 2069 810 1478 807
- 1132 907 929 682 1749 400 1232 1786 1481 1520 1142 1796 1678 781 1730 437 1778
- 1584 1500 530 1635 1295 1638 1469 1626 564 1563 751 1432 769 1536 830 1524 1797
- 1923 625 1303 1750 1686 1256 1702 985 1434 1236 1658 1538 1438 1396 1791 1437
- 1678 1623 2041 1619 1068 1248 1457 1597 1605 564 1645 824 1293 474 1311 1414
- 1633 1017 1410 472 1585 1061 1441 734 1976 1066 1601 399 1685 407 1998 1261
- 1688 807 1352 637 1761 1086 1388 1780 1521 1764 1763 1842 1471 523 1323 1005
- 1851 1792 1630 505 1341 1399 1433 738 1742 1250 1627 1584 1673 1096 1511 628
- 1425 1705 1612 738 1664 583 1465 1722 1569 557 1636 1001 2003 1337 1941 1522
- 936 735 1344 1662 2047 889 1428 588 1617 1709 1648 1183 1513 951 1410 1223 1494
- 1346 1938 1136 1701 1104 2129 1139 1387 881 1682 1342 1662 784 1718 554 1593
- 938 1550 580 1803 512 1922 942 1875 1335 1379 1615 1546 1679 1688 1504 1527 831
- 1417 1265 1509 1247 1422 1057 1535 100 { m20} R 553 1402 754 1709 843 1821 983
- 1578 1567 2125 663 1354 671 1823 1102 1824 495 1206 748 1318 1290 1279 1580
- 1287 1830 1809 1044 1804 1309 1907 1064 1424 1440 1582 603 1998 567 1564 1771
- 1795 398 1535 1675 1722 1344 1646 1033 2119 415 1620 554 1187 1344 1491 776
- 1361 536 1400 1469 1297 1002 1860 1616 1360 932 1779 518 1492 874 1245 989 1553
- 1447 1321 803 1430 922 1359 1725 1580 598 1600 489 1755 936 1786 394 1766 1439
- 1761 464 1630 1717 1547 992 1545 881 1359 1033 2076 1085 1349 1517 1881 574
- 1456 1764 1578 1497 1555 1057 1467 1740 1871 458 1437 1221 1555 798 1472 1062
- 1843 1532 1808 1318 1808 598 1301 896 1462 580 1627 1557 1841 1339 1572 914
- 1577 795 1453 611 1986 565 1487 1237 1872 1534 1810 1696 1495 1607 1409 1824
- 1418 1237 1387 908 1979 1554 1822 1072 1505 403 1665 487 1099 1108 1513 656
- 1288 1689 1601 1695 1903 1764 1596 1329 1683 390 1493 922 1122 815 1289 960
- 1158 468 1446 420 1491 1073 1709 1023 1584 1668 1317 1447 1528 1281 1966 100 {
- m20} R 1297 1412 1275 1511 1718 1787 720 1433 1415 1758 433 1314 1416 1602 883
- 1465 587 1375 1828 1482 1758 1736 468 1924 1795 1287 1638 1596 1213 1613 1478
- 1709 391 1647 1235 1257 876 1590 1797 1442 1263 1931 776 1739 1034 1737 562
- 1284 912 1605 1766 1482 1509 1194 1425 1434 1216 1828 645 1502 379 1482 1789
- 1904 1359 1365 1713 1820 983 1515 719 1524 721 1865 1609 1089 946 1195 504 1379
- 1164 1486 1313 1321 1589 1526 1644 1713 382 1347 771 2381 1122 1484 1641 1613
- 672 1010 766 1649 1091 1115 1588 1490 1157 1537 1171 1757 1412 1721 692 1337
- 622 1591 1808 1401 1327 1415 1321 1170 724 1848 1298 2067 1286 1542 1132 1605
- 538 1518 1777 1298 724 1856 958 1836 917 1483 1388 1606 1372 1726 687 1547 1361
- 1514 1310 1561 1564 1625 1174 1442 1193 1387 754 1454 1735 1672 1188 1369 733
- 1418 1760 1485 713 1589 1389 1546 1138 1828 1109 1752 489 1441 739 1316 1387
- 1898 1815 1512 1311 1846 1268 1282 965 1553 964 1686 1342 1405 779 1318 656
- 1491 477 1936 923 1633 1657 1663 100 { m20} R 1606 1609 650 1721 1129 1390 681
- 1610 1259 1480 715 1612 512 1452 1362 1550 1603 1388 1461 1951 1733 1427 1632
- 1537 1578 1761 1049 1733 405 1358 1577 1568 776 1429 1777 1596 759 1785 1314
- 1640 1757 1375 1099 1002 567 1643 904 1684 1529 1592 1145 1183 1342 1593 1627
- 1510 876 1575 1250 1395 1488 1411 505 1586 1131 1597 905 1709 1159 2053 1501
- 2069 1623 1486 1724 1926 588 1532 1631 1842 1164 1248 728 1872 1651 1754 1408
- 1503 1565 1323 1733 1627 377 1585 1520 1084 48 { m20} R 648 1242 385 1729 456
- 1213 879 1622 1828 1227 498 1466 1063 1420 1249 1313 469 1147 1375 1513 1444
- 1766 1670 1381 1510 1679 1476 1423 603 1821 1098 1466 461 1237 845 1467 1069
- 1856 642 1673 938 1688 1238 1308 1793 1625 1173 1596 615 1727 1225 1664 1232
- 1788 1588 1538 1190 2015 1507 1575 1502 1434 733 1660 1324 1511 1674 1466 1783
- 1577 1196 1565 627 1883 451 1660 565 1407 1250 1208 1100 1475 765 1270 1805
- 1476 1784 2145 1071 1418 1284 1593 1771 1504 1796 1725 437 1593 1508 1480 1846
- 1482 1762 1241 730 1733 982 2133 936 1259 708 1720 1848 1593 1689 1763 562 1822
- 802 1857 1507 1093 628 1423 679 1319 1554 1528 535 1642 1366 1372 886 1622 1424
- 1746 653 1791 374 1515 761 1786 1250 1856 865 1655 589 1489 1435 1597 1092 1296
- 693 1788 1230 1531 645 1555 1298 1873 530 1243 1542 1615 1046 1880 1547 1246
- 622 1235 1511 1686 1688 1528 1156 1616 673 1408 1398 1649 1284 1243 866 1546
- 1373 1686 617 1624 446 1106 766 1478 1121 1441 1576 1719 1795 1259 895 2053 100
- { m20} R 1051 1908 1561 1590 1647 1637 749 1686 1528 1418 1213 1511 470 1752
- 440 1654 1801 1537 1481 1582 1295 1802 943 1869 1330 1518 1084 1557 485 1655
- 420 1836 1671 1281 1591 1860 898 1077 1430 1429 1287 1737 866 1757 1210 1793
- 1626 1153 1673 1340 389 1752 966 1915 533 1791 841 1553 1126 1226 1726 1736 910
- 1836 919 1440 1017 1782 718 1835 1597 1400 1432 1951 1536 1493 659 1528 1390
- 1382 764 1348 1728 1513 417 1815 1502 1641 1144 1586 1671 1537 463 1455 808
- 1735 934 1190 746 1646 842 2020 544 1447 1322 1552 958 1794 875 1726 575 1376
- 955 1281 894 1711 1825 1333 865 1337 375 1318 1521 1661 1846 1476 395 1520 1619
- 1285 665 1269 665 1447 1057 1674 1673 1791 1680 1752 372 1690 1466 1679 523
- 1386 1119 1438 968 1754 1130 1420 763 1408 1421 1576 565 1821 1100 1797 1710
- 1635 1241 1307 697 1374 1811 1328 1553 1500 1182 1455 524 1087 953 1183 1004
- 1915 1257 1395 1031 1781 1027 1935 611 1605 1166 1621 1242 1364 952 1102 1429
- 1839 1564 1468 1116 1859 652 1565 100 { m20} R 1750 1364 773 1416 1170 1177
- 1208 1667 1409 1538 414 1889 1153 1710 1155 1344 855 1456 1066 1692 1821 1356
- 870 1444 1683 1686 1375 1569 593 1096 605 1586 1010 1596 857 2000 1627 1869 914
- 1594 871 1480 465 1927 841 1393 1737 1537 1806 1952 797 1496 1537 1932 1318
- 1526 1067 1611 1639 1568 1852 1733 440 1425 1725 1488 947 1697 1481 1434 1570
- 1170 1526 1471 1184 1888 995 1559 1175 1227 1610 1609 818 1289 611 1470 1798
- 1086 1186 1555 1556 1384 1211 1638 887 1579 442 1776 937 2008 1794 1742 1541
- 1559 843 1614 930 2024 435 1842 1498 1565 930 1131 1599 1843 641 1087 1229 1374
- 1549 1312 659 1974 443 1921 1675 1841 1261 1868 503 1130 1838 1418 1257 1809
- 1526 1603 1305 1492 543 1540 503 1581 928 1268 664 1735 1725 1448 582 1645 1217
- 1922 1679 1825 1131 1430 480 1533 1564 1536 1302 1540 1629 1556 378 1718 783
- 1618 1300 1716 1336 1780 1121 1745 1267 1573 1202 1605 1594 1754 611 1339 1060
- 1644 1314 1871 1357 1206 812 1742 731 1108 695 1660 1669 1716 706 1754 100 {
- m20} R 1157 1439 845 1240 850 1334 775 1695 791 1100 400 1674 933 2084 1261
- 1853 831 1180 912 1662 1576 1666 662 1725 1315 1330 1661 1596 535 1740 845 1811
- 1011 1872 1507 1855 1158 1888 897 1979 917 1437 1630 1743 1650 1166 766 1781
- 470 1453 1226 1366 1709 1558 794 1664 684 1597 1690 1578 1722 1330 1571 1912
- 1684 1498 1272 1839 1039 1647 1577 1641 1805 1763 1600 1744 1526 1429 1754 1970
- 591 1501 646 1735 1512 1465 804 1266 1169 1496 897 1978 1494 1811 1246 1533 517
- 1712 1526 1646 1590 1328 1529 1267 974 2103 1785 1379 900 1624 897 1838 448
- 1802 1834 1759 1811 1325 1824 1273 416 1478 1768 1537 1005 1359 987 1548 1576
- 1716 1715 1427 1093 1854 1672 1553 1476 1379 436 1377 376 1543 1282 1283 938
- 1248 960 1230 1609 1657 1028 1377 1081 1820 1504 1785 1842 1894 1139 1031 680
- 1575 501 1302 1731 1134 659 1671 1500 1295 408 1572 1509 1572 1062 1864 1288
- 1520 778 1274 1260 1716 532 1611 833 1255 514 1408 845 1798 610 1562 1018 1648
- 412 1512 744 1699 654 1498 100 { m20} R 1412 1772 1704 1660 549 1359 1274 1585
- 699 1991 1723 1865 1527 1177 1767 1371 1068 1529 599 1419 414 1570 632 1071 389
- 1830 1444 1167 1232 1446 575 1544 864 1422 1361 1610 1298 1472 465 1400 1752
- 1782 1164 1361 567 1668 1233 2040 482 2167 814 1556 496 1663 1534 1643 1174
- 1603 615 1606 1113 1948 1772 1294 466 1667 1465 1386 848 1216 483 1764 895 1434
- 1670 1980 1630 1637 970 1796 781 2143 863 1226 1071 1402 749 1964 1113 1203
- 1482 1296 628 1462 1142 1372 670 1761 1217 1596 1661 1562 707 1591 624 1942
- 1374 1577 1655 1558 1481 1248 1809 1408 1495 1396 1344 2242 661 1082 426 1359
- 933 1196 973 1537 1827 1802 1254 1767 1266 1625 1545 1514 1369 1481 1257 1374
- 626 1425 969 1835 1546 1396 766 1634 632 1871 1472 1570 1162 1036 418 1678 1016
- 1494 1116 1682 939 1753 706 1859 1409 1772 915 1949 1398 2027 1718 1730 1741
- 1475 558 1523 1583 1398 1691 1563 631 1477 1192 1898 1094 1910 1658 2023 507
- 1307 1689 1456 1507 1723 1137 1460 1353 1249 1846 1699 1799 1513 100 { m20} R
- 581 1359 1186 1459 1187 2002 1634 1239 1724 1456 962 1570 452 1179 475 1099
- 1352 2086 1386 1829 1515 1536 1410 1773 965 1449 1208 1701 523 1489 735 1137
- 859 1596 674 1302 1222 1287 1748 1659 1081 1783 1348 1524 1576 1771 1758 1682
- 1695 1249 480 1392 849 1351 1319 1651 1017 1848 1754 1872 1701 1362 976 1418
- 1635 1381 1687 1676 761 1764 1038 1985 1019 1992 737 1719 1029 1568 1285 1227
- 1393 1741 702 1811 601 1293 1436 1303 1099 1573 432 1738 1188 1223 1779 1459
- 1507 1634 1716 1253 764 1933 951 2008 423 1612 1617 1335 711 1695 1041 1710 689
- 1390 1035 1371 509 1965 1655 1176 1565 1518 1611 1744 1276 1236 1067 1631 642
- 1369 496 1716 1098 1613 867 1658 509 1528 1329 1831 884 1850 1491 1652 1701
- 1874 420 1607 1079 1150 853 1683 1016 1350 776 1458 1439 1485 1462 1785 498
- 1540 1155 1757 1753 1183 1229 1293 827 1896 1369 1628 970 1688 413 1381 1060
- 1885 651 1677 1157 2083 1794 1253 958 1737 464 1501 1796 1637 820 1552 584 1499
- 480 1557 1484 1660 1551 1454 100 { m20} R 1265 1212 796 1975 709 1336 761 1853
- 385 1542 1177 1480 1131 1698 1793 1664 393 1485 560 1730 926 1566 1603 1522 952
- 1606 1392 1214 396 1510 1840 1573 1393 1892 1003 1309 491 1653 1324 1480 1193
- 1474 1304 1098 1402 1538 1549 1843 801 1297 744 1544 1097 1463 1188 1620 1661
- 1536 1072 1706 1435 1443 1471 1824 717 1535 593 1415 1505 1529 649 1429 1634
- 1800 487 1704 949 1351 1191 1298 808 1659 1447 1285 1741 1272 1169 1930 1214
- 1623 422 1425 1755 1310 1800 1380 824 1238 923 1806 807 1539 579 1377 924 1317
- 1067 1307 1166 1159 376 1254 1697 1654 1838 1928 914 1535 1456 1605 772 1420
- 909 1973 801 1908 1382 1259 393 1459 1818 1863 485 1441 605 1509 1442 1225 449
- 1367 1290 1379 386 1303 871 1769 1170 1820 1121 1043 1650 1794 600 1275 1132
- 1369 483 1583 1189 1479 1095 1908 1347 1360 1571 1722 1244 1438 1775 1933 1541
- 1627 1708 2119 609 1655 1075 1723 1306 1666 1473 1823 1453 1772 731 1338 1388
- 1917 1343 1560 552 1354 1272 1745 633 1593 1120 1816 979 1369 100 { m20} R 1055
- 1707 1007 1660 711 1449 1432 1924 1376 1487 1177 1613 1444 1738 1093 2199 437
- 1326 1165 1768 452 1441 466 1561 607 1683 1676 1510 921 1612 1266 1749 1200
- 1721 1216 1593 1741 1556 741 1618 1417 1642 994 1435 413 1460 1674 1596 1843
- 1487 1539 1650 1615 1675 1661 1685 837 1805 1380 1734 1037 1792 428 1385 1468
- 1813 1737 1823 1125 1893 1243 2177 488 1679 1784 1651 1228 1205 1247 1732 1157
- 1851 1122 1572 1384 1352 1495 1867 1253 1835 1612 1756 734 1819 593 1394 843
- 1733 684 1531 761 2039 1730 1720 1472 1511 1034 1690 1229 1534 588 1793 1737
- 1320 1223 1436 726 1228 1485 1399 1458 1649 712 1639 1480 1570 1807 1407 435
- 2193 1049 1578 1674 1363 610 1462 436 1685 385 2061 459 1407 405 1460 620 1487
- 732 1452 662 1656 673 1747 511 1445 1829 1516 1215 1880 832 1604 1397 1375 1197
- 1380 1421 1756 387 1845 840 1112 1715 1291 862 1772 1726 1681 1252 1590 1569
- 1640 1342 1563 712 1084 1198 1579 1280 877 541 1309 600 1464 1663 1680 953 1783
- 908 1439 666 2008 100 { m20} R 1275 1367 879 1272 1748 1445 840 1673 1821 1731
- 1509 2090 671 1481 1551 1601 423 1477 476 1605 1848 1318 1167 1233 1102 1683
- 1746 1527 1344 1867 1706 1317 876 1267 641 1765 1632 1785 1643 1639 817 1883
- 408 1470 815 1883 1037 1551 399 1420 876 2084 552 1577 1103 1233 1322 2086 1824
- 2003 630 1739 897 1688 1713 1444 958 1706 619 1800 456 1943 1087 1805 1823 1706
- 1683 1379 1756 1525 1601 1716 1085 1451 588 1604 1647 1668 1591 1750 1335 1436
- 1759 1482 506 1853 1176 1504 724 1857 826 1534 998 1330 1393 1391 1240 1625 818
- 1590 630 1349 1076 1721 755 1322 725 1808 1815 1834 1552 1699 1249 1424 1748
- 1756 899 1441 1816 1046 998 1083 1259 1361 506 2070 469 1681 1421 1501 1756
- 1470 908 1343 776 1901 1490 1605 890 1662 1240 1837 1077 1850 1257 1410 1131
- 1802 1280 1337 1284 1814 1614 1270 1667 1477 959 1920 1833 1396 902 1744 661
- 1230 590 1423 1333 1158 1278 1519 989 1874 1159 1275 1296 1476 662 1793 1774
- 1191 710 1296 935 1564 1173 2035 667 1679 502 1907 100 { m20} R 630 1457 1326
- 1661 1435 1529 611 2237 1532 1509 1556 1325 675 1393 1785 1766 809 1258 706
- 1259 1172 1431 1411 1308 942 1383 480 1365 465 1482 492 1611 808 1663 1139 1755
- 1710 1618 899 1822 1846 1688 429 1646 1447 1662 582 1338 787 1271 1240 1479 653
- 1025 455 1653 467 1701 904 1337 1217 1332 1779 1829 1625 887 1329 1718 658 1471
- 1728 1747 433 1951 823 1681 993 1415 779 1788 1836 1878 1296 1647 804 1305 758
- 1494 1112 1626 1418 1709 1073 1645 1208 1400 1084 1425 1839 1799 1406 1342 1418
- 1338 1456 1682 394 1628 1179 1089 1302 1453 1146 1641 1657 1332 822 1305 1523
- 1398 1837 1502 1367 1887 511 1298 1207 1432 476 1268 1751 1260 455 1558 1149
- 1279 1147 1185 1614 1502 1067 1920 430 1635 1706 1459 458 1684 1026 1675 1284
- 1835 580 1766 1607 1368 1067 1215 1235 1476 574 1847 389 1614 1351 1562 1276
- 1422 376 1694 718 1671 1557 1914 1395 1554 1331 1250 1398 1673 775 2104 1123
- 1727 429 1799 1426 1862 763 1992 974 1540 1086 1690 1322 1662 1300 1664 645
- 1640 100 { m20} R 998 1656 576 1517 1181 1538 1107 1181 733 1067 1154 1421 689
- 1824 433 1324 737 1595 920 1823 803 1641 1096 1623 559 1513 858 1610 557 1636
- 1827 1460 1392 1550 1011 1322 1489 1541 1354 1939 571 1183 1494 1962 643 1432
- 1719 1456 1408 1747 1083 1953 1393 1313 1106 1539 1688 1882 804 1493 1817 1381
- 413 1738 1075 1741 504 1784 831 1531 679 1738 794 1695 1587 1477 1707 1168 1241
- 1682 1504 1002 1613 1738 492 1723 1577 1379 695 1840 1135 1397 1271 1590 586
- 1673 910 1397 593 1380 1626 1717 1101 2106 1114 1524 433 1376 1284 1647 509
- 1602 372 2002 1312 1116 784 1471 650 1819 556 1635 1249 1172 1536 1403 1737
- 1772 628 1417 1711 1529 1773 1775 483 1439 1834 1354 1217 1344 718 1755 1374
- 1399 984 1134 1822 1585 882 1333 1741 2192 804 1741 1749 1556 1446 1863 587
- 1817 1695 1633 1773 1550 500 2130 1012 2138 1647 1509 836 1854 565 1478 1180
- 1893 711 1760 1036 1947 509 1701 852 1526 1471 1710 600 1966 1051 1525 1739
- 1129 1666 1665 1826 1386 394 1630 873 1632 100 { m20} R 1275 1297 1599 1270 556
- 1929 376 1716 1078 1872 1391 1664 855 1466 790 1784 1309 1768 1547 1539 1279
- 1891 1829 1502 644 1691 1168 1612 1104 1553 1813 1754 1395 1720 936 1367 941
- 1895 1268 1668 1730 1441 863 1692 942 1541 704 1204 424 1543 1219 1570 1777
- 1701 1712 1444 825 1858 1803 1611 1278 1705 437 1570 1512 1400 1296 1493 769
- 1172 668 1431 521 1167 1485 1541 1598 1740 1560 1616 1569 1508 1706 1479 829
- 1754 737 1433 1211 1690 954 1661 511 1669 1083 1887 822 1638 1263 1889 884 1578
- 1802 1582 1246 1238 1000 1771 820 1558 417 1422 1689 1550 944 1583 1623 1277
- 1603 1698 1807 1789 1105 1574 842 1179 1103 1672 1043 1779 434 1488 536 1662
- 1562 2078 1302 1801 1723 1548 1753 1123 1551 1898 1295 2002 1050 1451 1334 1319
- 1348 1591 867 1619 760 1647 1790 1341 471 1935 1160 1454 581 1374 573 1131 1428
- 1487 1549 1754 1484 1594 1518 1742 1694 1386 1805 1562 998 1568 650 1049 665
- 1368 1737 1452 570 1227 1054 1796 606 1977 1095 1344 810 1457 1374 1454 1846
- 1489 100 { m20} R 1016 1564 1474 1476 625 1441 422 1480 1351 1873 1189 1319 574
- 1338 425 1237 1731 1828 593 1762 1554 1769 643 1993 538 1682 1101 1976 1813
- 1111 976 1565 1687 2052 1032 1571 476 1572 1121 1552 1454 1638 391 1896 1148
- 1506 567 1835 1078 1248 391 1639 623 1860 1212 1600 1813 1704 829 1393 1497
- 1935 1314 1736 1563 1518 1628 1556 1272 1446 941 1507 1708 1594 1476 1589 815
- 1602 601 1625 682 1495 703 1679 1287 1436 1004 1629 787 1479 1469 1177 1459
- 1692 1391 1400 519 1582 1170 1070 1174 1303 1110 1771 1536 1452 1252 1838 1406
- 1452 1337 1184 787 1489 1326 1711 1460 1792 1366 1612 613 1558 813 1490 1830
- 1347 488 1441 822 1241 1646 1743 884 1440 1207 1733 1747 1668 821 1511 443 1262
- 415 2314 1161 1519 635 1528 1708 1944 494 1434 482 1208 508 2040 1313 1708 1734
- 1657 915 1735 1582 1351 409 1379 609 1878 471 1607 642 1783 1683 1475 1242 1034
- 800 1447 1014 1534 1505 1463 632 1138 832 1552 1649 1241 696 1912 772 1590 656
- 1932 1528 1510 1813 1571 1082 1711 100 { m20} R 680 1627 1180 1748 1125 1549
- 517 1532 1483 1375 1145 1509 1655 1404 1674 2002 1624 1267 590 1927 1133 1759
- 927 1460 1012 1501 726 1671 1021 1277 406 1377 889 1312 720 1582 906 1357 1350
- 1651 580 1701 949 1243 1333 1985 891 2003 1810 1622 478 1663 1652 2143 1316
- 1495 879 1377 542 1272 990 1577 1363 1751 1803 1612 1607 1617 1631 1546 1593
- 1692 403 1737 849 1453 748 1838 1066 1897 1062 1382 1013 1452 717 1378 1041
- 1718 1430 1642 1012 1473 426 1814 1541 1338 1253 1538 935 1244 1126 1437 704
- 1978 996 1577 1140 1408 1580 1492 1567 1468 742 1471 471 1540 1101 1421 754
- 1578 646 1679 867 1667 1471 1535 877 1872 558 1876 1378 1353 1261 1695 670 1619
- 1417 1511 1675 1467 647 1686 571 1504 1502 1491 1391 1683 1405 1587 995 1485
- 1038 1405 1470 1306 1645 1562 529 1843 1307 1642 1163 1545 1214 1250 616 1503
- 859 1449 974 1598 806 1383 1487 1298 1154 1080 1345 1685 908 1973 1581 1648 622
- 1732 592 1343 896 1608 1128 1178 1631 1538 1094 1611 1776 1239 1367 1710 100 {
- m20} R 1711 1299 1632 1874 1198 1216 686 1422 1319 1332 966 1350 1822 1738 688
- 1593 1263 1546 894 1379 1613 1599 1393 1412 1349 1917 1698 1638 1287 1676 1057
- 1275 700 2131 1122 1576 482 1222 690 1597 554 1700 996 1435 798 1576 1623 1777
- 737 1783 526 1497 595 1471 1459 1903 586 1484 1003 1312 1161 1625 1787 1592 597
- 1933 828 1549 1100 1483 1475 1623 988 1830 530 1854 459 1743 1474 1773 428 1657
- 1828 1743 505 1933 802 1545 516 1618 833 1477 812 1250 1721 1189 1224 1573 1261
- 1567 1525 1428 1468 1404 998 1528 1584 1392 928 1869 1484 1558 1661 1419 1834
- 1587 492 1842 1761 1433 464 1401 1744 1625 710 1845 797 1144 1490 1225 738 1563
- 867 1520 1628 1160 1667 1409 1746 1626 1388 1695 763 1491 1089 1581 1306 1650
- 1686 1592 400 1683 749 1352 1168 1470 1514 1766 1109 1096 1589 1537 1804 1379
- 538 1523 466 1621 1806 1879 1552 1296 552 1844 563 1956 399 1417 1187 1349 1322
- 1469 1636 1662 1815 1411 824 1856 974 1285 1215 1357 760 1571 414 1668 1429
- 1531 831 1308 100 { m20} R 1119 1671 1672 1396 1615 1557 754 1375 1463 1807
- 1705 1887 1551 1727 1121 1276 867 1606 1643 1369 1002 1591 1777 1288 1246 1801
- 1452 1482 1318 1714 747 1363 1846 1811 981 1232 932 1833 1642 1547 1460 1451
- 452 1546 1539 1558 1169 1663 1011 1835 418 1456 663 1858 1741 1672 1254 1309
- 760 1860 572 1420 1716 1022 1065 1323 989 1470 835 1563 915 1481 1338 1503 942
- 1170 1104 1258 989 1846 780 1644 1264 1746 1571 1610 1744 1696 1618 1231 1711
- 2050 873 1811 1596 1534 1759 1912 1765 1768 1368 1556 1080 1792 1385 1677 562
- 1458 1538 1654 1119 1464 530 1771 522 1726 706 1856 621 1150 838 1835 1319 1459
- 1319 2213 1766 1841 1498 1696 1497 1699 1720 1360 1630 1920 976 1526 1298 1728
- 1510 1318 1577 1915 1737 1658 412 1801 827 1550 953 1582 954 1490 1313 1523
- 1081 1265 865 1603 924 1665 387 1641 966 1569 915 1811 726 1504 1021 1782 1084
- 1413 1764 1586 844 1821 461 1418 901 1531 1391 1679 1160 1579 666 1481 376 1704
- 1116 1546 495 1846 1018 1686 1483 2081 495 1210 100 { m20} R 1149 1963 557 1629
- 640 1579 1650 1272 400 1726 501 1539 452 1371 1306 1713 882 1396 549 1572 783
- 1203 1743 2043 1780 1060 699 1478 935 1865 644 1306 1223 1571 1385 1825 1083
- 1599 1152 1693 1312 1834 583 1355 1713 1516 714 1452 1806 1517 1167 1866 1847
- 1664 1793 1705 1741 1469 1276 1232 654 1604 1254 1667 615 1538 1765 1839 1731
- 1362 952 1881 1199 1577 1227 1620 1248 1711 1002 1472 1694 1473 1450 1805 1667
- 1585 944 1312 1482 1365 1524 1528 756 1442 536 1864 797 1358 965 1656 1544 1862
- 909 1439 459 1920 441 2077 1630 1632 525 1605 1338 1541 1055 1550 644 1715 607
- 1764 878 1399 1332 1241 1649 1638 560 1839 665 1549 860 1136 824 1529 1546 1680
- 1754 1839 604 1562 1486 1174 1715 2021 434 1592 1576 1767 512 1466 571 1382
- 1277 1467 1298 1632 820 1473 928 1971 421 1785 500 1892 899 1520 1070 1761 825
- 1367 1605 2045 1155 1425 791 1560 1516 2147 1234 1615 1540 1657 1650 1453 1794
- 1248 1028 1536 837 1540 730 1329 1170 1892 1817 1766 1133 1600 1521 1696 100 {
- m20} R 1027 1641 1493 1629 809 1779 1187 1939 1431 1695 1426 1349 1146 1938
- 1424 1362 1737 1144 1240 1657 413 1430 1198 1301 1393 1217 579 1775 416 2013
- 994 1267 1330 1494 1047 1323 860 1761 1756 1974 612 1197 887 1735 505 1128 1701
- 1744 1361 1304 1845 1579 1523 1516 1792 1760 737 1170 767 1830 1743 1428 1062
- 927 1289 1480 1644 1514 1512 1479 1619 1143 1478 1831 1023 1375 917 1732 697
- 1677 895 1696 377 1503 690 1485 643 1593 1149 2233 546 1542 1080 1244 1154 1502
- 1626 1303 999 1597 1645 1704 1619 1283 1763 1340 403 1908 1689 1492 1157 1686
- 1151 1345 1464 1651 1167 1896 1744 1461 1715 1783 604 1531 1385 1438 890 1885
- 1695 1997 599 1817 555 1507 517 1733 792 1502 1219 1719 1318 1281 762 1895 468
- 1722 949 1349 1514 1417 521 1471 1708 1366 1565 1545 1107 1597 628 1541 1375
- 1939 499 1886 530 1559 739 1410 1529 1616 513 1276 1129 1729 1213 1340 940 1486
- 566 1389 1000 1116 1310 1865 1509 1543 482 1044 1734 1860 1222 1679 496 2018
- 503 1429 1178 1678 1778 1773 100 { m20} R 481 1648 1587 1587 539 1440 1607 1322
- 1639 1147 1219 1473 1801 1135 588 1639 1841 1599 1275 1874 766 1844 1411 1456
- 1138 1079 444 1713 516 1424 1268 1511 897 1487 1341 2005 1660 1438 1377 1481
- 1404 1277 1852 1441 1721 1334 592 1614 610 1822 983 1352 593 1419 494 1535 711
- 1611 1525 1488 435 1408 1827 1788 591 1276 1559 1557 1274 1551 1383 1256 1518
- 1952 1630 1642 1140 1700 1248 1569 386 1832 1497 1399 411 1385 1006 1332 1159
- 1457 703 1736 1151 1242 1459 1995 936 1511 626 1352 482 1850 1013 1845 455 1504
- 545 1816 857 1641 1710 1935 1378 1348 491 1591 896 1248 534 1639 726 1751 1570
- 1690 779 1355 436 1742 965 1400 1102 1570 460 1950 1359 1341 1399 1371 1338
- 1410 476 1522 1669 1007 1070 1775 1604 1764 1377 1500 726 1380 1752 1975 1852
- 1399 1690 1473 1699 1690 1631 1544 747 1701 510 1725 1222 1480 1747 1570 1213
- 1576 1397 1126 371 1280 1310 1858 1287 1592 707 1580 1138 1747 1693 1437 978
- 1388 518 1452 1412 1850 1204 1619 1684 1552 1685 1819 1198 1798 100 { m20} R
- 868 1797 669 1326 1103 1724 560 1639 1802 1369 503 1238 1569 1819 803 1598 1585
- 1627 440 1598 1261 1479 775 1512 1675 1810 1588 1439 1797 1705 373 1412 504
- 1804 875 1664 1328 1101 1208 1683 773 1839 938 1592 523 1665 1082 1561 1338
- 1638 1130 1713 924 1769 924 1425 470 1562 849 1776 628 1476 1611 1315 744 1821
- 1371 1708 1231 1789 1801 1133 1781 1627 564 1305 1323 1356 826 1864 542 1561
- 744 1258 1243 1210 898 1501 1432 1943 717 1355 442 1327 1833 1647 790 1349 1379
- 1743 388 1612 1305 1491 771 1915 811 1589 463 1808 392 1539 1595 1812 641 937
- 1099 1333 1259 1333 838 1422 421 1411 583 1791 1777 1702 768 1529 934 1662 1248
- 1707 502 1564 476 1563 918 1544 1005 1431 1809 1355 465 1290 780 1584 1699 1705
- 1483 1689 937 1343 1641 1894 1652 1607 529 1812 1215 1642 1421 1724 1050 2001
- 452 1586 1850 1876 1363 1423 1425 1517 1655 1698 1183 1686 1758 1736 603 1781
- 1850 1601 1600 1574 900 1471 1011 1815 1170 1310 1673 1830 998 1445 621 1521
- 594 1986 100 { m20} R 1086 1653 1577 1702 1458 1823 1730 1508 1591 1481 737
- 1784 1493 1337 1680 2113 1065 2168 1213 1470 1755 730 964 1472 1697 1703 1520
- 1526 1533 2208 1819 1762 442 1569 1221 1606 567 1539 719 1513 518 1846 1008
- 1695 1694 1398 907 1512 1568 1057 604 1506 1361 1976 604 1451 521 2036 952 1748
- 528 1592 995 1172 1429 1379 1373 1606 641 1477 1594 1858 1320 1559 489 1586
- 1359 1772 560 1776 1216 1860 1418 1429 669 1302 736 1861 903 1448 495 1310 829
- 1229 820 1708 48 { m20} R 1159 1652 815 1551 1142 1798 1627 1588 458 1793 418
- 1724 1550 1118 998 1528 1212 1811 1751 1815 1628 1724 1761 1794 804 1698 1159
- 1643 1099 1370 1446 1391 1166 1753 802 2049 530 1550 522 1650 521 1453 1735
- 1209 1757 1436 1602 1420 1655 1655 1797 1392 1115 1602 1067 1507 1397 1716 455
- 1496 1675 1421 1461 1471 1342 1331 920 1882 1828 1663 1684 1756 1533 1487 1519
- 1483 402 1569 1526 1480 943 1778 527 1171 396 1397 1480 1650 977 1579 1758 1679
- 1417 1560 634 1676 896 1703 1631 1295 1308 1684 1364 1656 1807 1263 709 1247
- 722 1377 1495 1458 886 1715 1417 1919 1226 1960 611 1284 1029 1415 1801 1695
- 1846 1968 1598 1643 454 1285 1295 1699 415 1888 749 1618 1450 1469 637 1830
- 1128 1188 1075 1242 720 1315 410 1619 1476 1870 839 1570 727 1779 714 1202 1540
- 1454 661 1472 1289 1660 1052 994 1380 1280 884 1542 520 1504 1819 1572 1322
- 1511 1030 1510 638 1595 767 1336 578 1564 1454 1566 916 1168 819 1651 1163 1524
- 1238 1467 980 1576 1646 1473 702 1556 1416 1512 100 { m20} R 492 1799 1066 1620
- 1052 1610 1480 1456 1726 1798 583 1461 1723 1542 1586 1499 502 1212 780 1700
- 1356 1655 815 1552 1496 1448 381 1509 976 1776 853 1441 1775 1510 1104 1245
- 1313 1936 1785 1760 1450 1329 1323 1205 1104 1735 1366 1702 1151 1862 996 1540
- 1272 1585 500 1560 1581 1643 1203 1349 1140 1581 805 1699 752 1125 1336 1740
- 398 1230 1012 1857 473 1765 1669 1980 790 1545 1061 1470 974 1794 890 1942 1463
- 1533 663 1531 563 1378 884 1522 1203 1710 753 1523 576 1297 996 1680 1312 1523
- 1195 1243 1415 1618 599 1750 678 1189 1194 1819 1251 1679 1737 1617 394 1459
- 1349 1447 1018 1486 618 1300 1513 1658 1411 1750 1402 1467 1833 1496 1456 1607
- 1149 1638 1276 1474 1386 1454 951 1409 1145 1503 1701 1315 909 1578 873 1621
- 1341 1539 1092 1651 818 1511 764 1667 995 1771 1324 1358 830 1700 1082 2009
- 1562 1741 1824 1319 1181 1461 846 1536 1486 1606 1660 1381 790 1881 1589 2208
- 479 1478 1731 1616 1002 1796 1728 1330 1703 1271 1127 1571 861 1356 706 1578
- 975 1421 100 { m20} R 422 1437 1587 1144 707 1387 873 1397 1211 1470 1193 1869
- 1189 1412 1337 1601 1068 1839 1834 1506 1452 1350 1109 1528 396 1256 871 1399
- 1000 932 1153 1716 1154 1584 412 1342 1301 1665 906 1434 1109 1625 768 1531
- 1171 1513 779 1569 489 1753 831 1658 874 1388 1330 1275 1055 1749 1647 1587
- 1287 1565 717 1942 550 1824 778 1671 680 1678 1603 1943 717 1681 678 1762 1690
- 1201 850 1628 1293 1356 1765 1372 949 1650 1030 1251 712 1484 1357 1464 532
- 1620 726 1847 396 1740 1472 1773 1099 1469 1669 2006 955 1865 1210 1116 1015
- 1730 617 1871 918 1160 1850 1986 1719 1609 905 1539 1501 1301 1372 1257 638
- 1362 1814 1436 1171 943 987 1594 1820 1654 1764 1580 1849 1631 1636 1548 874
- 1562 641 1993 975 2002 1221 1381 1804 1716 1791 1595 1231 1231 1724 1284 408
- 1572 1026 1506 1182 1383 668 1113 1435 1573 472 1675 932 1285 662 1358 1015
- 1549 1705 1383 1242 1967 987 1490 652 1500 1573 2189 698 1197 1525 1354 1452
- 1001 1288 1529 1629 1712 1585 1491 1081 1310 1210 1587 100 { m20} R 615 1380
- 1111 1639 770 1530 570 1614 1507 1492 1029 1749 1787 1480 439 1814 637 1412 767
- 1641 1804 1904 897 1933 424 1767 571 1613 1821 1505 1247 1633 399 1321 616 1330
- 605 1713 711 1380 944 1454 1639 1679 855 1378 637 1474 672 1777 1759 1377 760
- 1551 441 1603 939 1419 1540 1349 1625 1833 1070 1610 565 1730 874 1147 1409
- 1744 1514 1734 1381 1513 1609 1582 428 1405 646 1486 1161 1615 1440 1752 1808
- 2071 1180 1693 1463 1843 827 1490 789 1659 1571 1653 1374 1320 1667 1321 1193
- 1690 934 2109 418 1324 600 1667 544 1557 1787 1780 1774 1500 1734 931 858 1651
- 445 2106 1171 1700 470 1680 1239 1500 1351 1720 1433 1516 1089 1364 1024 1424
- 1041 1645 765 1865 610 1665 1745 1454 1243 1342 1400 1629 1761 1764 726 1427
- 1814 1503 986 1605 1492 1649 373 1694 894 1476 758 1346 1536 1716 1344 1509
- 1794 1868 1762 1499 1768 1508 1472 1889 645 1825 1386 1596 1290 1688 1312 1767
- 396 1455 1793 1593 730 1500 1217 1808 1453 1253 1062 1376 651 1928 1234 2072
- 1367 1452 100 { m20} R 1658 1583 1377 1553 556 1516 459 1414 1116 2016 739 1385
- 1211 1621 1767 1105 1352 1412 1820 1469 1771 1389 1685 1644 659 1019 1616 1669
- 1775 1216 981 1792 1076 1339 1040 1819 1401 1841 1211 1759 551 1540 1183 1466
- 964 1952 1527 1661 523 1901 877 1368 849 1385 1389 1737 964 1982 493 1452 1645
- 1676 684 1439 1410 1699 413 1398 547 1714 1780 1841 967 1477 774 1754 1459 1611
- 1057 1741 1632 1951 1202 1661 1833 1277 1277 1537 485 1269 560 1796 1616 1939
- 1091 1910 1173 1392 962 1258 898 1600 1700 1569 1445 1329 677 1549 1758 1328
- 552 1766 1430 1978 542 1512 521 1238 1484 1042 1443 1430 1717 1503 933 1641
- 1220 1370 1093 1646 483 1407 1110 1504 1437 1663 889 1705 1366 1214 975 1510
- 1159 1782 738 1511 1486 1757 1465 1723 1823 1957 1209 1676 835 1328 1511 1462
- 765 1578 968 1673 1009 1400 1515 1714 895 1484 907 1233 1632 1697 1814 1748
- 1029 1329 1398 1381 1143 1460 811 1552 1289 1400 1846 1319 757 1710 669 1781
- 672 1721 1294 1523 1239 1815 1108 1327 1227 1833 100 { m20} R 802 1712 1165
- 2105 395 1497 1566 1744 1485 1455 1066 1565 1529 1792 579 1592 1789 1405 842
- 1287 964 968 689 1845 833 1367 1310 1476 516 1755 583 1476 1493 1472 542 1941
- 709 1394 499 1741 1626 1717 1684 1643 1284 1618 1418 1534 743 1530 1602 1552
- 802 1365 375 1295 911 1569 667 1599 1053 1487 1470 1318 1460 1622 1686 1461 558
- 1334 678 1555 1550 1664 744 1686 1765 1668 1264 1356 1817 1943 1486 1446 1033
- 2056 1502 1315 943 1951 1285 1622 684 1975 1822 1862 805 1808 419 1631 1401
- 1443 1587 1352 436 1575 776 1838 1226 1750 1646 1543 1236 1479 1341 1503 867
- 1341 1279 1437 1162 1710 724 1929 1466 1813 1530 1204 1701 1511 1594 1394 1546
- 1396 1728 1885 1672 1517 1347 1783 542 1299 1293 1278 775 1646 1263 1541 1266
- 1386 1754 1935 758 1065 1336 1754 386 1521 1736 1451 1308 1949 1735 1485 659
- 1564 1842 1761 763 1883 1156 1361 1555 1438 442 1457 1384 1406 1652 1525 1730
- 1274 1850 1732 729 1425 1579 1478 1132 1877 1209 1887 1754 1709 1542 1383 978
- 1642 806 1731 100 { m20} R 739 1514 1259 1911 609 1497 1577 1932 564 1651 1362
- 711 512 2037 1103 1386 390 1591 945 1188 1681 1218 450 1685 1378 1647 1340 1782
- 1327 1368 1604 1265 431 1684 1160 1883 1253 1501 1128 1214 1603 1686 1029 1352
- 1197 1244 1562 1422 562 1027 1510 1790 423 1554 814 1820 1479 1475 1061 912
- 1177 1426 672 1830 718 1309 538 1375 835 1481 1083 1523 1660 1822 771 1413 861
- 1598 601 1413 1624 1471 1299 1222 1641 1345 1132 2094 919 1390 1579 1784 1235
- 1803 989 1679 1542 1661 554 1319 912 1351 1708 1634 1632 1740 1095 1468 544
- 1572 385 1868 1312 1701 1725 1625 1557 1687 622 2025 1694 1365 1557 1126 749
- 1478 731 1230 1422 1511 497 1545 1375 1529 627 1525 1076 1834 1381 1562 640
- 1648 808 1418 455 1182 1363 1563 1725 1751 922 1529 1549 1453 699 1739 983 1604
- 1560 1426 1189 1866 719 1678 803 1821 1686 1492 1139 1633 1067 1644 467 1725
- 899 1607 1521 1625 520 1593 590 1324 494 1478 435 1523 1358 1953 978 1386 956
- 1676 685 1451 978 1519 747 1869 1799 1743 100 { m20} R 1725 1403 1626 1366 911
- 1297 1441 1317 1501 1289 1448 1724 1845 1647 1634 1599 602 1978 861 1668 1711
- 1925 1566 2010 1274 1422 1418 1547 1606 1554 1438 1799 1750 1261 372 1507 530
- 1490 470 2017 1778 1291 1265 1965 1527 1055 1852 1158 1192 1446 1322 1122 1079
- 1696 1222 1161 675 1816 500 1529 408 1784 1777 1707 1362 1434 1600 1506 1026
- 1454 1812 1449 1705 1196 1695 1593 623 1725 974 1432 449 1426 416 1629 991 1571
- 1792 1195 1127 1977 812 1641 1142 1828 807 1522 853 1351 1275 1783 1383 1552
- 890 1575 748 1582 831 1238 1431 1367 911 1191 1262 1449 999 1550 848 1292 1261
- 1521 1824 1038 1511 1645 1239 1616 1075 1493 1825 1642 1150 1784 1755 1592 1329
- 1529 1849 1323 658 1869 1098 1734 567 1318 1260 1611 815 1425 932 1524 532 1344
- 1825 2024 939 1651 1188 1402 617 1405 1648 1379 392 1559 1582 1679 648 1613
- 1608 1486 733 984 606 1769 585 1322 974 1825 922 1498 1071 1390 471 2066 1419
- 1655 729 1988 1602 1434 1229 1760 809 1326 564 1778 436 1692 777 1307 100 { m20
-} R 681 1365 653 1665 387 1719 433 1672 1675 1541 749 1572 1081 1183 654 1798
- 724 1864 1631 1278 1395 1793 440 1439 1646 1518 963 1345 1622 1417 1712 1109
- 1466 1677 1690 1443 1568 1591 1778 1145 433 1929 1374 1550 948 1478 1306 1492
- 560 1543 887 1800 648 1493 610 1664 981 1494 1634 1301 1111 1571 695 1389 557
- 1749 1351 1533 1098 935 1372 1322 710 1854 480 1484 563 1230 1342 1753 652 1211
- 1378 1670 1808 1458 771 1777 1845 1283 673 1482 1097 1727 425 978 1556 1963
- 1616 1406 478 1569 1503 1893 833 1844 1349 1698 695 1653 674 1383 955 1559 1644
- 1369 1707 1572 926 1321 1622 1692 948 1320 376 1611 541 1326 1634 1622 1620
- 1882 777 1098 1209 1783 1623 1608 801 1588 1316 1549 448 1618 418 1884 1436
- 1268 1374 1528 1462 1293 1773 1545 1710 1457 1581 1569 1798 1404 422 1485 757
- 1517 1457 1757 1510 1535 708 1971 1415 1681 1156 1793 1206 1542 1190 946 1526
- 1900 1671 1665 1468 1470 1696 1537 1344 1335 1553 1760 884 1631 1639 1598 1463
- 1475 1613 1742 440 1523 100 { m20} R 731 1445 1832 1098 1309 1533 794 1536 1477
- 1583 595 1389 619 1324 1585 1809 380 1019 824 1456 1164 1666 1620 1545 471 1668
- 1363 1186 1134 1786 1503 1652 1195 1649 834 1444 1178 1785 1650 1806 623 1824
- 1254 2033 1202 1769 1085 1922 1734 1824 759 1442 1627 1486 445 1512 487 1696
- 1834 1335 1147 1928 1720 1778 415 1780 874 1499 707 1905 394 1056 1829 1868 597
- 1327 1788 1660 1491 1526 592 1889 1615 1499 635 1203 854 1625 466 1483 1161
- 1590 508 1451 1387 1852 1781 1916 1538 1733 898 1705 1203 1470 1269 1423 1809
- 1643 934 1468 1241 1200 843 1675 732 1749 561 1350 610 1651 1600 1366 1588 1608
- 1764 1384 986 1679 1136 1577 476 1912 981 1813 1456 1520 1626 1887 726 1862
- 1297 1695 375 1670 444 1696 905 1689 1309 1486 1192 1399 1398 1467 637 1404 401
- 1642 1445 1512 625 1972 452 1252 1305 1498 755 1859 1009 1644 921 1609 718 1513
- 500 1855 1434 1491 1198 1360 1161 1516 1848 1582 1758 1830 1201 1832 1174 1553
- 575 1384 1350 1274 753 1499 661 1429 1822 1828 100 { m20} R 471 1859 1573 1619
- 397 1798 471 1680 1205 1914 1776 1377 1181 1425 1769 1890 1262 1818 1150 1720
- 499 1608 1173 1505 1666 1111 524 1963 824 1499 1765 1170 1088 1024 587 1542
- 1163 1626 467 1644 1655 1498 1589 1609 1695 1441 1650 1449 1365 1387 651 1284
- 1687 1410 627 1626 1623 1619 414 1312 1827 1610 738 1803 482 1203 932 1388 740
- 1744 832 1614 616 1457 689 1457 495 1757 746 1500 1728 1478 552 1929 1252 1444
- 484 1474 1107 1470 1198 1610 1511 1787 574 1585 492 1795 1166 1695 801 1206
- 1673 1488 1470 2087 1567 1518 1273 1616 684 1470 1774 1488 1116 2061 476 1625
- 643 1491 1825 1546 1325 1838 1378 1504 403 1377 1059 1300 1840 1515 379 1359
- 704 1538 1618 1539 1284 1559 1196 1314 1030 1386 751 1295 399 1451 474 2037
- 1055 1323 1431 2024 1683 1053 417 1709 1093 1980 1656 1363 577 1730 1493 1137
- 536 1298 899 1539 654 1287 953 1376 1584 1790 788 1548 829 1348 1592 1496 1549
- 1728 1040 1741 1025 1774 449 1436 1093 1384 895 1354 888 1482 1332 1396 1377
- 1464 100 { m20} R 1763 1907 763 1488 983 1583 1580 1673 1521 1943 1764 1314
- 1693 1775 1152 1353 1839 1173 1436 1274 932 1358 691 1791 1561 1318 811 1884
- 553 1609 1480 1465 1520 1099 465 1573 1307 1425 1127 1813 415 1631 678 1981
- 1567 1569 1618 1608 933 1464 633 1610 1583 1084 970 2170 581 1329 534 1670 1293
- 1070 1322 1608 1079 1545 1480 2011 502 1766 1748 1578 1429 1258 781 1147 899
- 1614 973 1957 1393 1915 1592 1629 412 1434 405 1596 1577 1526 1766 1433 1489
- 1494 471 1561 1616 1642 1375 1447 1640 1537 1722 1696 949 1446 998 1527 1201
- 1465 1787 1998 1457 1519 718 1323 1802 1814 1310 1802 599 1311 1686 1520 1344
- 1387 1673 1866 977 1636 1044 1218 703 1672 1590 1493 1812 1888 969 1792 1338
- 1796 1465 1957 810 1379 643 2226 748 1727 1671 1736 1211 872 927 2013 1098 1282
- 1494 1356 519 1925 1806 1718 1601 1208 1473 1334 1368 1644 697 1436 1326 1614
- 381 1754 1500 1360 686 1550 1603 1856 1599 1666 1387 1516 1019 1223 779 1575
- 540 1380 876 1885 1691 1346 1472 1565 372 1426 100 { m20} R 687 1469 1559 1551
- 784 1140 1809 1387 662 2063 1437 1545 1142 1321 705 1650 1707 1750 1098 1109
- 1089 1574 1501 2166 1033 1542 838 1809 1470 1688 581 1940 887 1434 918 1378
- 1032 1760 1692 1661 761 1227 964 1545 959 1654 1532 1430 1769 1154 1172 1369
- 527 1308 626 1327 693 1537 1145 1394 812 1621 1439 1389 1812 1782 1117 1168 927
- 1773 745 1590 1191 1431 567 1519 493 1196 534 1927 968 1642 1757 1751 524 1582
- 874 1409 1800 1457 460 1558 404 1867 1143 1785 898 1832 653 1654 619 1366 612
- 1472 642 1542 1289 1713 872 1378 1767 1617 926 1720 482 1437 1083 1150 1244
- 1581 1043 1772 1261 1761 1217 1446 450 1270 801 1544 895 1781 1095 1533 1018
- 1759 1493 1213 943 1407 1254 1660 1401 1728 1286 1559 1434 1479 917 1407 1628
- 1708 1077 1685 791 1468 768 1539 1067 1874 642 1668 1345 1676 1092 1687 397
- 1829 438 1555 1790 1384 818 1285 1217 1554 1699 1370 1520 1593 1635 1666 665
- 1695 411 1446 1114 1783 1776 1430 720 1751 923 1300 1236 1598 748 1600 1363
- 1675 100 { m20} R 1798 1952 820 2021 665 1734 1415 1592 989 1577 1481 1960 1051
- 1213 1494 1426 825 1448 861 1204 1524 1621 641 1326 701 1683 474 1414 956 1730
- 551 1278 1435 1463 1662 1378 1748 1570 502 1586 1133 1493 653 2000 1119 1653
- 649 1769 413 1991 474 1742 444 1718 1567 1602 1493 1719 679 1112 1135 1573 489
- 1342 676 1473 1565 1860 1245 1591 771 1396 373 1668 1614 1440 1486 1511 933
- 1300 1475 1806 1247 1439 681 2206 1738 1589 1687 1594 1547 1579 1426 1670 1542
- 1506 384 1787 625 1375 535 1505 449 1561 1619 1484 860 1641 452 1709 558 1636
- 624 1671 1054 1324 1296 1903 415 1807 1128 1320 1453 1477 901 1550 479 1704
- 1261 1505 774 1812 1251 1396 1394 1474 453 1632 1284 1388 1749 1673 1583 1626
- 1440 1432 425 1933 1611 1790 408 1688 381 1920 1208 1214 1515 1707 388 1446
- 1247 1779 947 1842 1831 1195 841 1582 388 1710 1108 1337 774 1350 1071 1481
- 1480 1427 1847 1440 832 1890 513 1834 1765 1619 1366 1643 1221 1432 1428 1812
- 555 1982 1157 1325 1430 1417 1256 1331 100 { m20} R 1167 1443 1711 1543 1290
- 1778 1334 1765 640 1302 384 1198 1756 1663 1755 1635 1820 1666 1644 1801 1545
- 1489 1588 1600 1505 1745 394 1662 629 1275 1609 1465 1075 1795 1593 1824 1392
- 1704 438 2120 1204 1642 1124 1836 1499 1711 1285 1181 852 1688 979 1552 454
- 1239 1421 1524 1080 1276 1822 1811 631 1647 421 1521 1295 1344 417 1590 521
- 1802 1588 1297 1379 1869 1499 1502 1510 1699 1517 1552 671 1654 1608 1441 983
- 2088 1142 1461 1185 1519 562 1209 1487 1453 1314 1360 678 1976 1833 1582 1128
- 1524 1811 1153 811 1157 1417 1385 1291 1620 1708 1296 616 1474 1621 1410 1279
- 1528 1104 1536 1163 1689 869 1295 1778 2037 1772 1341 804 1482 1238 1687 1191
- 1914 773 1513 1363 1593 751 1449 1404 1089 1780 1395 788 1720 861 1554 1721
- 1647 732 1815 1266 1517 1692 1343 1057 1656 1044 1530 1559 1564 1285 1285 863
- 1436 1278 1227 1635 1215 418 1288 1681 1575 1141 1658 1054 1649 903 1479 1420
- 1491 1719 1400 1647 1515 1130 1407 781 1342 1225 1241 447 1734 527 1621 900
- 1450 1520 1660 100 { m20} R 375 1509 1436 1471 1695 1357 823 1493 1090 1766
- 1027 1647 1255 1592 932 1918 1096 1486 1005 1409 1352 1356 1139 1720 1785 1143
- 1716 1327 594 1303 1774 1271 584 1646 1152 2076 522 1456 1325 1339 1102 1324
- 1303 1272 1305 1608 1818 1973 1606 1701 557 1403 624 1035 782 1722 834 1736 701
- 1702 1774 1438 1129 1295 582 1600 1018 1329 628 1880 780 1255 1839 1802 604
- 1715 1672 1391 851 1998 1481 1629 1246 1599 1127 1285 380 1470 1633 1200 1714
- 1530 640 2033 1775 1632 1615 1763 671 1725 1794 1329 1386 1846 1320 957 1432
- 1711 1240 1303 776 1414 1596 873 562 1634 984 1378 709 1613 1720 1551 1458 1620
- 1431 1805 1633 1628 1223 1869 846 1415 1029 1687 1296 1357 947 1617 1196 1826
- 1123 1443 526 1748 867 1416 504 1655 1702 1542 1339 1803 1772 1387 372 1263
- 1816 1610 982 1737 1226 1279 978 1586 1432 1785 1422 1884 1414 1575 371 1360
- 698 1606 976 1841 1831 1608 492 2046 1166 1672 1206 1280 760 1200 550 1487 1062
- 1459 1664 1406 1752 1665 1436 1622 750 1545 624 1648 100 { m20} R 1795 1656 501
- 1551 1112 1624 856 1695 1639 1659 1133 1706 1275 1644 410 1627 1301 1552 511
- 1958 863 1803 1527 1642 548 1707 1435 1868 374 1654 579 1617 759 1859 986 1836
- 460 1704 501 1302 493 1745 1169 1021 805 1787 982 996 1378 1511 390 1506 1732
- 1725 507 2013 845 1264 1821 1794 1824 1651 497 1871 706 1316 962 1475 711 1510
- 1838 1006 610 1605 1448 1234 705 1648 1787 1509 807 1168 1820 1598 1143 1540
- 980 1683 1824 1562 1552 1602 1096 1572 735 1751 1161 1536 1128 1522 942 1389
- 796 1300 1787 1609 479 1683 546 1414 890 1797 838 1597 502 1600 1502 1777 1743
- 1778 899 1698 775 1742 504 1834 667 1882 750 1770 730 1218 666 1602 1308 1723
- 1500 1521 573 1274 760 2094 1293 1502 830 1875 945 1828 812 1395 1622 1780 1851
- 1824 1556 1714 1732 1814 1719 1655 768 1753 1588 1572 410 1616 387 1856 411
- 2050 1007 1666 482 1718 1490 1267 760 1874 1726 1453 1509 1625 917 1498 986
- 1733 621 1501 456 1814 1653 1576 758 1770 1771 1536 1838 1997 875 1435 100 {
- m20} R 1217 1405 895 1193 454 1685 1582 1679 908 1749 750 1473 703 1418 1153
- 1508 924 1428 1484 1689 1837 1756 655 1873 602 1304 458 1766 1240 1620 609 1677
- 970 1287 819 1455 1542 1591 1229 1605 810 1502 721 1615 1016 1557 959 1842 1218
- 1538 1050 1833 914 1521 1607 2081 1773 1757 1765 1820 1676 1622 510 1501 1099
- 1411 1440 1371 1664 1357 1629 1381 1427 1569 1342 1573 1538 1629 1143 1606 1337
- 1450 1025 1574 1286 1608 624 1670 745 2070 1286 1551 1245 1710 1843 1870 466
- 1454 736 1967 1673 1871 412 1277 1491 1568 665 1691 1424 2027 1249 1513 1506
- 1506 1466 1402 573 1470 1392 1329 569 1838 1669 1453 1334 1356 1800 1472 847
- 1289 705 1793 1513 1406 1283 1396 1617 1490 1754 1492 1591 1407 1360 1580 645
- 1775 847 1334 451 1542 1213 1627 1743 1641 1701 1374 452 1500 1378 1419 1289
- 1506 689 1369 900 1489 1336 1836 483 1368 397 1373 726 1320 1104 1742 1352 1763
- 744 1534 1645 1866 809 1564 605 1623 1520 1239 444 1494 1348 1514 1116 1981 796
- 1207 1396 1895 876 1079 100 { m20} R 1831 1477 1166 1434 1456 1995 1468 1637
- 1149 1343 1712 2010 908 1551 1361 1728 1589 1817 1769 1872 1844 1599 1051 1988
- 616 1825 701 1363 1174 1362 878 1663 1054 1545 1240 1654 1377 1449 620 1767
- 1441 1490 1065 1432 1486 1540 1559 1231 1157 1488 1525 1786 1042 1538 1725 1479
- 664 2019 1746 1306 806 1460 1058 1509 485 1039 412 1584 381 1449 471 1380 805
- 1326 622 1323 1510 1578 386 1600 897 964 1705 1570 876 1406 1698 1601 1424 1636
- 1332 1592 1765 1329 1479 1549 676 1207 1150 1124 1192 1608 1108 1526 1831 1614
- 1760 1632 696 1399 1349 1454 921 1698 1762 1752 641 1230 714 1754 656 1842 1591
- 1034 400 1610 656 1136 1214 1621 1550 1882 1190 1595 549 1941 1847 1437 1064
- 1539 916 1051 926 1578 676 1571 1532 1772 1557 1474 1451 1649 1388 1231 1339
- 1737 1303 1267 1244 1415 602 2131 634 1778 627 1404 1415 1783 445 1964 1674
- 1477 1750 1919 659 1352 535 1843 1250 1487 387 1681 1069 1640 582 1373 1441
- 1469 1719 1429 695 1706 1343 1620 1784 1531 835 1430 1226 1543 100 { m20} R 819
- 1387 1020 1110 1400 1576 1192 1700 895 1450 476 1518 557 1308 1585 2101 435
- 1891 725 1740 1281 1704 955 1978 1582 1384 423 1446 500 1428 1238 1688 1512
- 1581 430 1939 386 1601 667 1279 1801 1689 1549 1640 876 1961 1531 1513 1323
- 1510 1493 1720 1328 1329 502 1551 960 1614 1749 1585 1396 2084 912 1391 785
- 1929 994 1457 1346 1920 966 1755 543 1910 1265 1511 847 1963 1407 1601 1002
- 1728 1004 1486 1396 1495 571 1790 1273 1041 548 1311 1263 1390 1812 1548 594
- 1276 806 1575 1625 1481 481 1999 1371 1897 839 2067 1192 1579 948 1410 1305
- 1540 563 1840 872 2090 1463 1819 706 1558 746 1495 786 1565 621 1663 488 2153
- 1670 1538 879 1492 1372 1479 1429 1576 828 1438 776 957 690 1773 1749 1445 478
- 1286 794 1666 787 1439 1495 2085 1550 1822 1621 1581 1736 1480 1789 1548 1121
- 1831 372 1470 1836 2024 397 1498 1422 1689 436 1517 1437 1610 1297 917 1363
- 1206 1185 1622 1381 1420 897 1510 407 1612 938 1501 1722 1594 1242 1479 835
- 1771 618 1441 607 1577 100 { m20} R 1642 1626 723 1821 816 1543 1511 1740 1768
- 1581 1559 1592 1523 1654 1496 1561 883 1628 1152 1457 1658 1232 537 1935 1154
- 1434 585 1690 1475 1432 1247 1765 1246 1223 1777 1768 992 1381 938 2087 804
- 1402 1526 2137 451 1454 928 1341 1233 1680 1233 1885 1621 1451 1431 1227 1157
- 1688 683 1757 1715 1814 1221 2239 1625 1560 991 1490 574 1633 1348 1515 1211
- 992 1240 1515 1599 1711 856 1800 1834 1439 486 1678 865 1991 1833 1668 810 1599
- 586 1684 1413 1642 1478 1624 48 { m20} R 897 1380 550 1469 940 1783 1108 1512
- 1630 1575 751 2078 1619 1617 702 1681 1822 1320 1644 1620 1373 1876 1593 1702
- 1160 1635 1043 1791 503 1435 1512 1580 1395 1721 413 1795 1616 1514 394 1393
- 548 1940 1018 1689 645 1263 1633 1584 1360 1780 1333 1397 677 1623 508 1572
- 1133 1913 1165 1245 529 1537 1572 1578 1059 1799 1406 1503 1550 1495 1651 1807
- 1547 1480 1102 1259 1640 1472 1485 1616 1840 1394 1756 1879 1836 1344 385 1645
- 1318 1568 1505 1724 721 1629 1422 1582 1498 1459 930 1560 544 1673 1611 1768
- 702 1527 1452 1485 1069 1655 374 1834 686 1657 1061 1405 424 1486 613 1514 1395
- 1719 827 1414 618 1627 1764 2017 1626 992 1657 1168 957 2061 1088 1783 1065
- 1419 1190 1134 1807 1820 1032 1189 984 1423 766 1831 1431 1953 1763 1667 1539
- 1466 1336 1624 1092 1550 1450 1515 1022 1833 687 1888 1240 1408 1291 1386 1811
- 1509 1359 1693 1078 1514 1633 1608 1725 1945 804 1654 767 1575 987 1266 716
- 1467 444 1562 456 1470 1759 1421 470 1388 1008 1916 1434 1622 1755 1452 100 {
- m20} R 1793 1552 1305 1854 1401 1406 1472 1362 1520 1651 565 1959 1329 1655 416
- 1395 1475 1634 871 1567 470 1356 1242 1963 829 1495 1618 1700 1056 1549 513
- 1368 1380 1573 900 1544 1003 1614 1688 1683 1538 1818 967 1834 534 1787 1211
- 1313 1545 1494 1592 1243 391 1929 562 1073 1784 1771 1503 1650 1367 1760 482
- 1428 1593 1419 948 959 592 1370 1390 1680 1278 1857 1463 2117 753 1240 759 1283
- 1843 1550 697 2103 574 1660 1572 1673 890 1346 1203 1582 606 1073 1185 1883
- 1435 1881 420 1649 1466 1470 1765 1955 1830 1148 1087 1681 1048 1634 490 1987
- 1590 1495 1569 1621 428 1486 1535 1265 1112 1582 905 1548 824 1331 1294 1876
- 594 1601 1374 1778 1462 1647 1476 1301 572 1904 1179 1769 1624 1557 1066 1621
- 486 1635 839 1638 1104 1482 1553 1897 1355 1709 1729 1686 859 1393 741 1932
- 1735 1519 1690 1950 1523 1654 1118 1330 1626 1560 1826 1709 898 1292 561 1812
- 1620 1588 645 1574 1454 1948 1211 1657 1153 1532 994 1619 722 1755 453 1677
- 1040 1751 544 1269 487 1531 783 1411 100 { m20} R 1550 1397 776 1749 1043 1619
- 1274 1439 1723 1497 695 1827 1320 1601 725 1547 678 1375 762 2168 1595 1197
- 1073 1334 500 1546 461 1578 496 1392 1834 1659 522 1451 955 1662 1148 1324 1533
- 1063 1713 1404 1533 1159 1437 1548 1128 1792 1299 1851 396 1227 764 1086 929
- 1576 1688 1651 498 1780 1389 1310 635 1461 722 1741 502 1756 535 1822 1106 1495
- 1168 1540 453 1657 1422 1735 812 1407 457 1621 610 1462 499 1413 1298 1375 461
- 1512 690 1505 1274 1444 910 1725 1415 1876 1844 1385 1005 1512 1747 1641 1518
- 1436 1827 1531 685 1879 446 1331 1644 1519 856 1681 1348 1524 694 1327 859 1527
- 1207 1595 1657 1614 614 1451 598 1519 1113 1371 1652 1620 1126 1156 1617 1711
- 1783 1763 1507 1568 506 1381 1391 1647 471 1302 1031 1611 1785 1660 1683 1451
- 798 1770 989 1379 1461 1484 1598 1529 1121 1209 958 1475 943 1501 827 1529 898
- 1549 611 1336 1223 1546 1465 1584 1010 1792 1292 1272 1555 1707 1459 1833 918
- 1620 914 1607 721 1809 1159 955 1022 1698 539 1641 1529 1368 100 { m20} R 1451
- 1400 1111 1654 1801 1601 1777 1679 1509 1885 1644 1590 1663 1417 920 1189 1185
- 1798 1616 1505 956 1681 821 1700 1098 1685 694 1407 812 1513 1528 1844 1185
- 1618 1241 1508 1175 1724 393 1638 1812 1672 626 1949 998 1614 703 1861 934 2074
- 758 1296 739 1350 1544 1542 1552 1244 404 1416 1474 1363 884 1290 759 1359 1438
- 1620 465 1631 1795 1718 1819 1604 1359 1560 1313 1592 1647 1414 1570 1223 1175
- 1745 1019 1806 744 1613 867 1355 420 1393 763 1669 1280 1740 412 1394 552 2005
- 724 1371 1815 1437 1083 1476 1247 1814 1438 1441 1316 1303 978 1768 1020 1537
- 1150 1884 1702 1769 880 1625 1148 1455 1214 1687 1511 1469 729 1439 443 1999
- 1575 1498 824 1392 888 1504 1148 1687 955 1450 1852 1510 1255 1278 809 1264
- 1302 1520 432 1991 437 1963 1805 1544 1799 1694 465 1972 1495 1551 501 1483 440
- 1858 1684 1588 634 2114 992 1882 1178 1672 1435 1456 698 1772 1703 1574 387
- 1709 717 1285 1806 1777 406 1859 1200 1504 1483 1343 1492 1242 1567 1558 1413
- 1239 1660 1397 100 { m20} R 1294 1724 872 1438 684 1500 452 1857 1122 956 1070
- 1873 1710 1743 1279 1559 1727 1553 1240 1435 1741 1454 395 1855 1050 1513 1790
- 1574 807 1914 1427 1450 409 1344 583 1321 1063 1561 410 1185 635 1304 658 1925
- 1735 1881 635 1747 1399 1736 746 1721 945 1831 657 1723 645 1474 1389 1679 1224
- 1955 1331 1487 552 1709 1360 1546 1844 1540 667 1959 1658 1848 1542 1398 1420
- 1779 1851 1699 455 1426 1680 1367 984 1340 1564 1507 1057 1413 1073 1565 1214
- 1375 1372 1820 1651 1758 568 1453 1024 1576 1401 1656 618 1560 442 1492 1417
- 1493 1221 1551 1094 1573 565 1524 1502 1723 744 1834 603 1548 1463 1674 1248
- 1853 1006 1990 1336 1512 1600 1690 1650 1302 834 1458 1698 1655 846 1454 575
- 1834 1631 2078 1488 1632 515 1185 906 1126 641 1092 1636 1431 852 1560 463 2088
- 1147 1586 1105 1732 873 1521 1586 1485 1812 1846 1066 1682 917 1460 1307 1333
- 1311 1321 933 1705 1105 1442 480 1303 1630 1114 1805 1446 892 1221 485 1458 769
- 1718 1718 1391 1570 1576 1771 1223 1677 1591 100 { m20} R 998 1624 538 1347 477
- 1700 916 1432 1052 1552 1820 1508 1612 1504 389 1733 800 1397 477 1867 405 1987
- 1606 1432 1190 1571 450 1870 444 1686 534 1380 1081 1549 558 1984 1240 1264
- 1158 1890 1058 1637 1137 1608 1591 1232 622 1114 1787 1828 1506 1270 1432 1110
- 739 1794 1741 1718 1108 1435 502 1765 1116 1515 1441 1464 1792 1890 1539 1610
- 586 1295 1768 1124 1829 1810 1236 1609 648 1627 445 1525 1607 1520 1601 1670
- 1626 1469 1306 1737 724 1858 1166 1529 516 1577 1483 1370 1286 1228 1314 1779
- 549 1870 825 1115 839 1451 926 1306 1286 1281 860 1732 1193 1406 1288 1625 390
- 1426 393 1204 1465 1470 388 1740 1081 1518 1703 1282 1532 1775 1226 1488 1003
- 1093 476 1819 1748 1570 502 1675 756 1601 1524 1409 706 1714 630 1703 880 1697
- 652 1398 1738 963 659 1311 1478 1822 1658 1418 1274 1427 1572 1496 881 1501 731
- 1263 753 1660 1100 1710 1497 1729 1798 1638 1308 1672 1479 1460 1261 1605 1487
- 1650 1402 1607 921 1646 392 1551 928 1674 610 1426 1606 1696 765 1290 100 { m20
-} R 1479 1596 1214 1607 1434 1456 828 1654 1019 1265 445 1688 1638 1763 443 1058
- 1440 1495 606 1732 612 1724 1297 1475 1351 1466 1640 1514 1305 1496 1542 1651
- 469 1685 1042 1670 640 2065 1453 1885 1305 1229 753 1307 678 1720 456 1638 1064
- 1671 418 1540 750 1553 1119 1525 1784 1059 1056 1860 579 1739 529 1689 1087
- 1610 1296 1381 957 1554 1138 1822 1812 1213 724 1525 1389 1393 480 1773 1404
- 1680 456 1470 674 1627 859 1564 730 1694 1114 1658 1673 1833 1706 1528 1284
- 1998 1761 1550 868 1358 1278 1241 690 1629 1185 1713 1701 1665 860 1823 1486
- 1843 980 1287 1279 1553 1010 1380 1786 1166 569 1891 1624 2017 761 2002 553
- 1782 1486 1805 868 1402 1826 2035 632 1689 1194 1632 410 1259 1701 1589 1516
- 1118 927 1340 782 1505 1289 1336 936 1525 1638 1486 517 1536 900 1548 1500 1558
- 449 1857 1374 1659 806 1312 920 1669 1840 1669 418 1608 1784 1625 1113 1499
- 1571 1385 505 1434 885 1359 1783 1762 1257 1259 1286 1313 1578 1572 677 1459
- 1786 1580 851 1713 721 1849 100 { m20} R 767 1683 1184 1348 972 1138 925 1317
- 1513 1602 635 1309 1531 1251 1686 1702 1424 1479 445 1319 873 1909 538 1583 777
- 1604 1125 1667 1116 1396 804 1479 563 1523 1048 1449 395 1653 392 1556 1789
- 1597 597 1370 1578 1580 1055 1390 1227 1531 806 1648 1107 1558 982 1587 1085
- 1601 1746 1931 445 1580 380 1614 1362 1656 751 1573 1531 1512 796 1843 1749
- 1409 474 1393 1834 1403 1081 1553 759 1404 488 1541 1313 1762 1251 1253 511
- 1826 1332 1689 1458 1519 456 1373 1829 1703 707 1619 657 1378 1717 1219 800
- 1244 1489 1447 1239 1541 853 2009 1717 1543 864 1619 1757 1430 1102 1567 459
- 2063 1643 1754 1839 1375 1380 1744 1116 1170 623 1631 1711 1457 1742 1528 1742
- 1258 1083 1638 555 1828 917 1403 1607 1732 1423 1650 1449 1051 1191 1600 1121
- 1574 956 1555 1490 1673 727 1802 1722 1644 1135 1640 1775 1801 928 1502 637
- 1191 503 1788 379 1609 537 1940 1773 1518 811 1672 844 1684 971 1884 1424 1508
- 596 1833 882 1635 382 1193 786 1433 1772 1932 783 1462 681 1533 100 { m20} R
- 598 1458 1161 1288 1360 2073 1364 1905 1404 1321 1523 1435 1139 1560 506 1686
- 1387 1266 954 1740 1214 1924 1021 1564 1652 1655 372 1590 1376 1851 852 1818
- 1757 1410 916 1455 409 1391 1842 1664 1360 1357 1342 1650 1085 1760 1768 1448
- 1573 1751 1281 1466 1142 1077 1130 1600 829 1424 927 1539 769 1435 1613 1310
- 1549 1807 1797 1578 791 1611 1122 1695 555 1665 904 2063 1508 1544 862 1692 609
- 1323 1627 1669 1464 1384 1727 1686 688 1563 1639 1463 564 1782 1767 1503 1290
- 1433 1018 1624 1001 1837 543 1425 610 1255 840 1840 1424 1452 1546 1657 1013
- 1402 1204 1492 1360 1495 579 1738 820 1619 533 1975 1547 1645 1824 1350 576
- 1805 1280 1493 1789 1758 1438 1669 750 1243 853 1959 1151 1427 756 1172 1347
- 1306 1172 1338 1315 1500 1538 1324 1335 1391 1536 1151 1247 1318 1237 1370 1413
- 1882 1096 1763 1427 1602 1382 1663 888 1291 1565 1301 1458 1633 947 1727 480
- 1495 944 1509 1504 1333 1291 1193 1409 1289 1307 1494 581 1953 371 1432 1380
- 1623 1850 1376 1547 1258 1753 1027 100 { m20} R 1552 1574 1510 1927 1575 1888
- 702 1784 1624 1475 1193 1566 1117 2238 652 1986 436 1849 1220 1555 1041 1631
- 1792 1642 1451 1424 513 1667 1784 1967 1278 1448 1533 1153 1219 1667 666 1599
- 1376 1619 1162 1752 443 1937 1498 1703 447 1467 645 1842 1837 1364 970 1762
- 1426 1461 1098 1816 992 1718 1852 1319 1044 1525 446 2065 1579 1512 393 1237
- 1241 1639 1065 1429 633 1318 1533 1382 1719 1626 1492 1292 1280 1933 1303 1604
- 498 1595 1119 1585 449 1566 407 1648 839 1335 423 1352 1745 1505 583 1244 811
- 1905 1026 1491 401 1378 752 1964 682 1627 1736 1739 1528 1504 389 1367 1375
- 1580 886 1352 615 1802 1162 1867 1169 1280 1516 1463 833 1259 1182 1840 450
- 1907 938 1835 1107 1213 800 1394 1848 1744 1731 1162 1816 1272 890 1702 1184
- 1801 834 1437 1171 1413 1544 1509 467 1552 594 1900 529 1711 1772 1412 1345
- 1674 1731 1622 623 1718 745 1747 495 1389 1839 1679 1689 1917 1699 1801 422
- 1330 588 1728 764 1972 1763 1481 1092 1445 919 1662 1699 1784 716 1612 579 1470
- 100 { m20} R 1825 1470 668 1661 1326 1825 1615 1677 599 1454 1028 1447 1567
- 1469 1155 1644 1312 1474 525 1133 1434 1377 1039 1952 1418 1580 1806 1463 773
- 1746 1026 1602 1684 1506 492 1631 1007 1209 560 1642 1169 1798 1081 1251 1485
- 1632 905 1846 479 1393 841 1533 1627 1436 513 1105 1741 1653 1760 1843 1750
- 1674 848 1396 1131 2233 446 1628 1173 1964 702 1231 774 1779 492 1293 617 1068
- 554 1428 1706 1801 1782 1620 951 1645 1037 1506 1757 1582 1577 1199 1121 1378
- 389 1498 1157 1349 852 1380 1104 1505 1463 1504 558 1579 1465 1374 1744 1157
- 480 1328 441 1588 1669 1392 1351 1859 1792 1485 1187 1176 1655 1212 1701 1517
- 852 1687 1558 1914 1197 1581 804 1477 1638 1401 972 1555 1541 1579 1027 1119
- 1042 1761 1492 1524 464 1353 1091 1876 1234 1571 1015 1497 1615 1499 626 1345
- 703 1246 954 1675 601 1361 478 1720 1039 1715 1542 1569 1675 1528 978 1533 1652
- 1336 1768 1394 1723 1435 1720 1783 539 1712 1237 1400 931 1467 953 1443 502
- 1623 1630 1603 887 1739 646 1508 1645 1644 100 { m20} R 543 1576 916 1997 1475
- 1474 439 1976 890 1554 1283 1535 1318 1745 1367 1587 1798 1686 1438 1874 1617
- 1392 600 1777 1295 1676 621 1712 1327 1794 924 1673 829 1562 1699 1384 1030
- 1313 1364 2118 465 1741 1610 1308 1537 1535 1156 1453 527 1299 390 1554 393
- 1184 1682 1703 1632 1745 1436 1828 576 1545 1489 1472 1775 1828 1242 1289 926
- 1387 402 1383 575 1501 716 1522 1503 1654 1406 1652 1579 1334 1578 1682 410
- 1619 725 1651 1646 1076 942 1895 440 1896 843 1696 632 1494 1210 1671 740 1697
- 1373 1443 967 1296 1238 1950 890 1236 1791 1541 801 1732 1292 1498 788 1350 515
- 2085 493 1721 1680 2139 602 1642 950 1255 1770 1779 1502 1385 805 1520 1171
- 1785 1421 1323 1179 1890 789 1010 742 1536 780 1103 1125 1844 1218 1848 840
- 1456 774 1546 792 2002 382 1590 636 1151 1532 1693 693 1936 892 1182 1641 1583
- 613 1318 796 1181 1728 1643 1280 1480 515 1661 672 1565 1776 1715 609 1504 669
- 1854 984 1660 494 1735 923 1352 1289 1818 851 1776 1036 1347 457 1476 100 { m20
-} R 568 1725 1210 1340 1533 1289 486 1456 1352 1700 641 1566 405 1610 505 1369
- 715 1857 774 1818 737 1654 391 1354 824 1827 1466 1431 429 1160 1192 2005 449
- 1713 1814 1822 538 1324 688 1162 1537 1621 1298 1781 1199 1901 609 1582 1011
- 1612 914 1943 617 1425 1028 1780 1687 1830 1703 1692 1073 1722 1632 1857 852
- 1760 940 1241 1280 1439 725 1289 1027 1470 819 1428 1097 1627 1102 1647 580
- 1681 519 1391 1289 1695 914 1683 1550 1448 899 1349 992 1789 1233 1777 1618
- 1399 1676 2105 549 1727 1658 1466 1508 1783 1445 1573 1473 2001 1250 1616 592
- 1559 1275 1601 1721 1528 892 1548 1036 1805 962 1177 724 1503 866 1520 1741
- 1399 1373 1355 1676 1613 881 1552 1767 1479 598 1699 1107 1697 1059 1606 1700
- 1590 1430 1341 1574 1762 811 1792 1837 1665 1332 1521 1252 1491 930 1911 1405
- 1866 1548 1484 1230 1473 817 1948 785 1486 788 1767 1478 1606 1537 1416 897
- 1736 1605 1878 1464 1190 1382 1859 561 1810 1266 1081 1508 1583 1348 1845 677
- 1531 1161 1409 962 1689 970 1924 100 { m20} R 556 1614 1390 1231 843 1631 1314
- 1540 1115 1479 457 2025 500 1511 1320 1257 830 1527 860 1585 1041 1832 1378
- 1633 1537 1497 1823 977 1386 1431 1763 1644 978 1137 931 1156 1406 1433 1082
- 1519 1184 1786 1482 1515 1771 1677 615 1646 1381 1774 1491 1281 411 1626 525
- 1620 1112 1818 520 1412 441 1237 1507 1544 1800 1722 387 1812 830 1471 1020
- 1793 852 2066 822 1101 1238 1391 1837 1545 1241 1539 786 1933 1207 1356 732
- 1040 1324 1519 617 1340 1765 1690 867 1635 1754 2032 1308 1418 553 1580 463
- 1457 1105 1283 1849 1359 1065 1709 1785 1646 1185 1745 1339 1589 471 1548 1468
- 1831 1311 1309 1174 1595 460 1598 1344 1284 1689 1779 1845 1542 1435 1438 512
- 1649 1109 1488 424 1736 1365 1813 1701 1643 1821 1884 857 1801 1416 1475 513
- 1460 1569 1831 527 1554 528 1747 1028 1593 1107 1426 1577 1718 643 1274 1817
- 1388 942 1590 701 1367 1768 1484 939 1906 471 1510 1484 1572 421 1711 1691 1718
- 1700 1362 1575 1540 1470 1635 1575 1585 1584 1313 1136 1884 1091 1603 452 1390
- 100 { m20} R 1798 1424 1659 1195 1603 1227 1565 1557 1261 1333 801 1148 1075
- 1531 1581 1754 731 2023 650 1817 1567 1485 733 1225 1294 1530 869 1441 622 1465
- 1523 2231 1691 1248 1647 2029 1206 1576 1387 1400 1328 1586 1503 1492 1167 1625
- 1665 1202 401 1984 1481 1823 527 1823 1439 1597 774 1856 1597 1520 1178 1505
- 830 1496 1352 1638 389 1639 1301 1082 654 1703 910 1979 1509 1885 1181 1692 909
- 1213 379 1371 1316 1505 858 1595 686 1240 456 1311 561 1496 1431 1806 896 1615
- 1278 1564 528 1522 739 1850 664 1736 946 1347 777 1047 1691 1601 1146 1701 1379
- 1373 1829 1732 1766 1557 1775 1435 469 1761 1198 1882 508 1274 575 1239 923
- 1835 771 1981 658 1462 1019 1495 1139 1539 650 1346 397 1691 1744 1504 1408
- 1587 1500 980 492 1892 571 1879 1759 1548 942 1748 765 1362 1573 1434 1003 1949
- 1217 1720 1267 1262 1150 1634 1383 1853 1618 1907 1422 2010 381 1760 397 1542
- 616 1499 1568 1475 470 1532 507 1607 1614 1706 908 1817 1486 2194 1385 1931
- 1834 1263 1544 1390 1754 1598 100 { m20} R 971 1703 1274 1554 928 1835 849 1879
- 659 1214 1512 1694 732 1741 1525 1647 816 1806 1408 1469 777 1263 1122 1664 702
- 1017 580 1498 651 1664 654 1733 729 1816 551 1373 920 1276 993 1729 1379 1592
- 371 2167 1036 1441 1392 1751 1369 1526 461 1715 932 1384 901 1364 1296 1636
- 1021 1556 1717 1798 1683 1394 1723 1842 1516 1169 1242 1643 991 1656 534 990
- 1361 1478 486 1717 1708 1370 1000 1560 474 1473 1317 1533 1494 1567 1170 2097
- 1142 1770 1227 1613 732 1928 519 1384 1083 1615 1618 1482 1359 1935 1678 1727
- 1280 1298 576 1092 497 1608 389 1558 1498 1427 668 1208 551 1461 1002 1790 597
- 1474 986 1621 903 1430 580 1632 1722 1678 1534 1419 514 1298 1226 1748 1414
- 1901 1004 1593 544 1355 1102 1669 792 1707 1674 1420 1409 1817 1239 1612 1801
- 1609 1448 1742 897 1717 480 1059 1291 1591 913 1364 562 1670 1825 1815 1437
- 2100 1036 1831 1717 2034 675 1479 570 1646 600 1306 1186 1662 1762 1452 1378
- 1671 764 1440 434 1752 1525 1491 1579 1156 487 1893 742 1873 100 { m20} R 1502
- 1291 1693 1264 1683 1563 513 1424 521 1566 657 1649 1192 1668 1569 1571 624
- 1655 1425 1432 586 1682 1665 1517 624 1539 1418 1654 1136 2033 1287 1005 492
- 1801 543 1279 1773 1380 1133 1355 900 1671 1382 1534 1199 1785 1530 1762 650
- 1855 826 1389 748 1801 711 1447 1374 1498 1324 2045 1816 1471 839 1776 1360
- 1578 520 1435 578 1567 1307 1388 498 1463 890 1491 976 1637 1232 1359 396 1656
- 1252 1710 900 1662 910 1432 1056 2036 1107 1721 537 1428 536 1206 595 1328 1835
- 1644 832 1563 933 1475 758 1454 1081 1134 1005 1654 792 1473 1226 1220 677 1205
- 847 1316 1154 1396 574 1661 1848 1393 1730 1770 1617 1836 1393 1546 666 2321
- 1842 1635 426 1505 660 1375 1170 1229 1509 1695 1674 1348 1812 1572 901 1408
- 627 1665 532 1663 1718 1510 1819 1698 1105 1928 1521 1529 606 1210 1161 1662
- 945 1746 543 1167 628 1793 1228 1584 1368 1581 1055 1768 710 1780 1156 1515
- 1714 1873 1545 2021 972 1563 1471 1341 999 1651 1243 1463 1056 1802 1533 1299
- 1204 1885 964 1819 100 { m20} R 498 1171 1371 1890 1361 1784 1010 1436 1284
- 1730 600 1731 752 1478 509 1472 1328 1940 372 1686 1367 1591 1523 1497 1455
- 1231 965 1764 1336 1296 1237 1127 612 1254 429 1459 795 1709 1376 1831 1828
- 1206 1767 1639 1645 1632 1514 1350 1664 1816 503 1835 901 1544 1366 2066 1049
- 1626 1791 1828 593 1540 636 1490 596 1882 1242 1985 696 1268 1842 1611 1495
- 1304 1471 1821 1113 1851 1780 1356 704 1847 1005 1545 1587 1220 918 1790 1610
- 1346 1037 937 1275 1704 1266 1467 1177 1215 500 1240 396 979 648 1603 1152 2029
- 514 1340 958 1582 1835 1186 1080 1534 999 1368 1550 1373 709 1291 1651 1164
- 1391 1695 807 1157 1342 1666 1390 1368 641 1437 1433 2059 1366 1241 874 1434
- 1649 1536 1391 1445 951 1761 830 1399 781 1583 1345 1492 1517 1725 1809 1652
- 842 1839 1303 1481 1501 1414 1697 1438 1710 1243 418 1510 1065 1707 632 1688
- 1196 1859 1268 1425 873 1597 1601 1634 953 1735 399 1664 563 1641 702 1715 694
- 1550 1099 1425 1441 1456 1679 1467 1082 1854 1822 1471 1715 1525 100 { m20} R
- 686 1665 849 1963 1810 2000 1260 1683 868 1109 917 1710 621 2149 883 1342 939
- 1318 835 1760 1376 1407 1586 2111 596 1566 1171 1236 470 1368 1085 1421 1558
- 1672 1334 1797 388 1476 1720 1507 1144 1263 1473 1471 536 1817 703 1692 895
- 1435 457 1522 514 1628 1158 1453 587 1503 422 1593 1016 1247 1285 1983 866 1899
- 752 1452 1322 1734 520 1586 1284 1895 1833 1943 680 1683 1140 1647 1569 1621
- 550 1217 1127 1436 688 1636 803 1650 1058 1292 1208 1511 853 1583 952 2197 1511
- 1409 1384 1669 1151 1388 610 1818 992 1304 1374 1546 1279 1248 409 1794 420
- 1229 1706 890 1081 1240 766 1495 717 1849 1027 1860 1847 1889 1614 1233 504
- 1385 1410 1404 1268 1532 990 1391 417 2031 1040 1763 431 1228 699 1718 1589
- 1728 1497 1724 607 1778 508 1705 721 1441 824 1788 1565 1761 1521 1736 1284
- 1744 955 1456 1129 1611 1274 1446 968 1635 610 1498 1063 1536 1729 1679 1706
- 1877 1677 1316 443 1557 1708 1734 1812 1313 886 1654 1087 1071 1132 1198 1381
- 1689 1468 1267 852 1637 100 { m20} R 1089 1852 641 1111 699 1477 1838 1701 540
- 1625 1456 1882 1069 1767 1629 1703 1078 1187 1575 1446 397 1780 996 1253 1812
- 1427 1679 1523 866 1495 644 1113 1731 1790 1593 1579 817 1917 1666 1564 868
- 1357 425 1304 1306 1461 1838 1341 1709 1601 684 1402 1529 1940 934 1882 619
- 1873 626 1641 1271 2044 753 1292 1141 1636 1210 1369 1364 1433 493 1528 1539
- 1725 1202 1489 1188 1655 740 1597 1764 1505 1817 1378 1089 1361 741 1456 1404
- 1446 1669 1766 1665 1774 1206 1507 1085 1657 1574 1586 623 1829 699 1737 683
- 1636 1384 1556 1792 1480 898 1431 1797 1436 1716 1842 1400 1583 1317 1642 948
- 1307 392 1530 946 1434 1782 1595 562 1393 1000 1285 1597 1680 1494 1108 622
- 1700 926 1567 1335 1889 1843 1642 1189 1556 963 1429 1315 1432 741 1623 1126
- 1583 1237 1480 1664 1526 1564 1282 1699 1391 1259 1414 889 1158 1289 1639 1636
- 1343 769 2082 626 1720 1679 1588 531 1193 1605 1712 1309 1546 819 1587 680 1581
- 1399 1601 637 1535 721 1443 1430 1167 801 1326 394 1695 1194 1798 100 { m20} R
- 1324 1318 1692 1526 1798 1302 1667 1868 454 1411 1610 1850 566 1716 1074 1546
- 521 1796 1385 1096 448 1586 1647 1227 395 1488 958 1222 1424 1581 1632 1743
- 1840 1321 796 1447 1154 1647 693 1951 1140 1481 1499 1504 1482 1599 536 1187
- 588 1959 1334 2088 620 1367 1003 1055 1608 1313 609 1672 546 1101 777 1756 971
- 1763 1234 1975 1053 1330 1017 1323 1161 1252 1758 1694 1736 1608 1393 1622 721
- 1401 1836 1861 1707 1423 1638 1723 1456 1696 1107 1357 823 1653 908 1723 48 {
- m20} R 1202 1187 741 1570 917 1558 1102 1374 626 1177 1176 1983 450 1429 1505
- 1621 605 2009 1674 1417 1121 1627 1118 1818 1127 1662 644 1503 702 1540 983
- 1505 1607 1486 504 1376 438 1500 603 1465 607 1779 664 1674 829 1865 1715 1853
- 1599 1796 1611 1196 1332 1726 1389 1476 1770 1917 606 1486 1665 1557 1540 1591
- 1535 1513 671 1581 996 1743 1488 1530 1602 1189 1195 1610 960 1681 882 1966
- 1818 1379 1457 1274 1101 1443 1506 1346 1847 1834 877 1196 554 1511 973 1862
- 942 1707 1064 1448 574 1480 1460 1751 1172 1658 1177 1829 1851 1797 851 2000
- 1362 1832 1746 1795 1518 1444 899 1456 736 1594 1440 1523 1060 1683 1134 1651
- 386 1639 823 1533 1540 1753 1444 1887 1637 1466 415 1218 1421 1412 967 1877 886
- 1534 979 1393 1186 1805 1039 1525 1119 1577 1316 1656 633 1700 571 2030 1114
- 1775 1455 1520 629 1685 1817 1454 568 1769 411 1309 1294 1518 636 1784 804 1373
- 506 1789 1228 1930 1130 1389 1590 1561 1095 1689 1371 1494 1506 1951 1575 1361
- 1828 1746 516 1571 1007 1796 100 { m20} R 887 1272 1495 1469 1778 1701 666 1639
- 1343 1699 1314 1441 1118 1662 1606 1780 952 1363 809 1431 430 1485 706 1406 435
- 1951 712 1857 1188 1558 1505 1457 724 1602 614 1849 768 1481 384 1129 1105 1284
- 1113 1549 819 1772 1439 1450 429 1715 1646 1916 1831 2222 1470 1443 1676 1589
- 581 1327 877 1330 610 1670 576 1812 1385 1342 852 2096 1282 1384 1041 1446 423
- 1730 1361 2017 806 1760 807 1456 1037 1409 1491 1498 1321 1539 1471 1390 862
- 1941 1079 1520 1338 1822 507 1348 965 1592 1086 1956 1592 1347 1843 1168 1606
- 1996 805 1829 1793 1401 750 1597 697 1942 1452 1630 785 1737 607 1538 1774 1214
- 1681 1606 805 1711 500 1678 1655 1848 695 1466 681 1456 922 1470 1400 1465 698
- 1373 1643 1473 1446 1462 1631 1751 1421 1803 435 1578 621 1541 1738 1493 757
- 1695 1146 1565 1143 1470 675 1931 781 1790 1391 1691 1441 1748 1649 1550 1444
- 1178 1605 1599 866 1458 478 1638 616 1720 1195 1470 1513 1782 1368 1511 589
- 1586 1022 1964 712 1315 848 1441 934 1894 1777 1716 100 { m20} R 1771 1686 994
- 1610 951 1611 1434 1288 1306 1460 474 1511 1767 1466 1042 1876 1440 1187 714
- 1347 1139 1204 1664 1539 1401 1520 797 1365 1273 2011 688 1736 799 1668 1852
- 1253 916 1723 385 1890 906 1350 1767 1585 608 1827 847 1706 667 1619 549 1790
- 1068 1360 1064 1687 751 1422 745 1767 1612 1424 503 1777 1565 1737 644 1719
- 1765 1437 678 1376 964 1387 1417 1156 875 1739 1395 1538 577 2027 1052 1286
- 1579 1567 633 1519 1041 1548 1039 1488 1642 1592 1057 1586 463 1378 772 1419
- 1723 1468 939 1484 479 1362 1140 1654 1841 1785 623 1501 741 1637 507 1681 1336
- 1222 1636 1160 1573 1702 585 1332 455 1630 1443 1956 1551 1925 757 1619 1032
- 1610 1518 1699 1601 1791 522 1330 625 1303 523 1217 411 1884 1462 1726 704 1776
- 1649 1734 1422 1213 1220 1546 1543 1167 1494 1677 976 1667 730 1345 871 1362
- 1049 1829 1099 1438 1201 1841 1504 1580 887 1178 772 1244 1031 1319 1338 1514
- 1687 1262 571 1987 746 1511 1606 1591 1090 1372 1052 1894 1196 1493 1686 1723
- 968 1645 100 { m20} R 1193 1503 454 1641 1107 1572 469 1420 1717 1791 1681 1698
- 839 1481 918 1262 1045 1469 683 1348 1129 1813 1715 1514 1225 1723 934 1886
- 1609 1694 1039 1796 759 1463 443 1777 1748 1525 1249 1309 598 1410 669 1417
- 1848 1266 706 1698 1167 1278 1794 1800 1009 1355 1726 1218 1014 1739 1310 1491
- 414 1880 409 1112 1000 1336 443 1448 1760 1386 1549 1400 796 1604 1119 1124 475
- 1633 1582 1761 1591 1736 875 1417 1705 1763 872 1345 1436 1616 895 1538 1532
- 1605 1297 1871 674 1801 522 1585 1008 1587 1123 1418 1252 1712 706 1854 852
- 1832 802 1444 661 1154 1131 1422 1032 1811 1828 1388 720 1307 1732 1295 535
- 1493 957 1901 883 2044 1053 1578 836 1766 1722 1766 728 1478 1673 1168 693 1895
- 1508 1849 1481 1659 1442 1268 432 1308 1315 1881 1211 1642 1532 1819 773 1492
- 870 1538 1208 1667 571 1879 1785 1230 1818 1496 566 1237 1825 1672 1319 1756
- 399 1181 1546 1762 1326 1499 1740 1162 788 1839 1768 1695 1271 1644 862 1180
- 1765 1881 484 1418 825 2037 1319 1614 846 1251 100 { m20} R 407 1873 642 1318
- 1119 1287 1229 1478 1421 2110 961 1590 582 1193 381 1609 729 1645 1745 1724
- 1367 1642 835 1447 1083 1290 1528 1768 1556 1756 532 1462 1036 1365 1602 1593
- 1441 1301 1046 1269 1086 1733 1215 1806 670 1799 908 1535 766 1617 1501 1384
- 1317 1570 495 1260 1081 1418 1801 1533 1829 1921 1636 1409 664 1209 1151 1668
- 941 1834 1657 1182 426 1901 1572 1006 1017 1402 559 1492 1434 1206 1569 1697
- 1513 1524 1329 1450 589 1447 457 1546 1636 1376 697 1656 1034 1289 999 1492 697
- 1325 1406 1497 1391 1570 1645 1640 1848 1562 1480 1674 1144 1525 514 1367 837
- 1436 1171 1842 1455 1553 986 1678 1397 1140 686 1915 1514 1602 810 1476 1313
- 1215 1202 1318 868 1741 458 1626 1220 1233 1747 1934 996 1357 793 1560 1763
- 1323 392 1853 661 1254 817 1409 647 1221 889 1724 1250 1412 1318 1947 1731 1596
- 1392 1702 720 1400 1408 1723 714 1619 518 1611 1841 1920 1781 1411 1660 1833
- 495 1710 1841 1631 1078 1866 1080 1511 1390 1577 1662 2019 856 1814 964 1306
- 439 1739 100 { m20} R 1036 1673 1530 1614 377 1537 1523 1790 1093 1831 1202
- 1750 1653 1245 1293 1878 1518 1315 872 1285 1493 1645 1576 1646 409 1267 1258
- 1635 1374 1894 888 1272 834 1763 400 1775 513 1184 422 1509 647 1651 1806 1689
- 1455 1352 803 1582 410 1425 1193 1740 1662 1664 614 1509 1001 1750 939 1607 605
- 1947 1741 1680 1166 1760 618 1445 1631 1795 1214 1192 581 1621 1318 1163 857
- 1270 916 1561 1614 1797 998 1584 1462 1685 798 1155 1766 1084 734 1697 1199
- 1665 1215 1752 1509 1645 383 2002 1626 1507 554 1466 1099 1732 1774 1832 716
- 1824 1486 1918 795 1485 943 1437 1157 1727 1727 1558 917 1512 1049 1314 544
- 1270 1640 1635 1441 1813 1241 1396 1495 1590 714 1547 1480 1513 692 1654 1158
- 1578 1451 1974 595 1640 1001 1733 1755 1484 1761 1747 1479 1888 1832 1507 1286
- 1580 1172 1431 719 1775 1119 1818 1631 1377 1158 1583 1441 1367 962 1348 972
- 1130 752 1470 1776 1086 803 1421 1735 1385 1381 1569 1653 1314 944 1783 1164
- 1695 382 1662 1585 1468 927 1836 739 1580 579 1786 100 { m20} R 1835 1485 1138
- 1360 1078 1646 1661 1540 1085 1585 1510 1628 1628 1205 470 1072 1084 1459 1714
- 1838 1657 1639 1757 1485 1248 1387 1509 2034 899 1237 1592 1190 460 1282 803
- 1771 483 1805 1046 1266 977 1553 1014 1653 1640 1768 1156 1465 449 1517 793
- 1409 1061 1380 1244 1464 1332 1753 692 1643 442 1749 1770 1554 1382 1632 1216
- 1562 1708 1792 1087 1570 1145 1449 1302 1534 1595 1788 1578 1266 373 1713 439
- 1449 1758 1398 1019 2098 747 1137 561 1837 1137 1465 1018 1442 1692 1694 1084
- 1657 1486 1632 1092 1357 1464 1155 1223 1679 967 1627 375 1483 1565 1315 799
- 1362 1007 1551 372 1788 1007 1009 1375 1639 1725 1394 808 1118 1510 1300 1004
- 1717 750 1827 1604 1673 372 1657 1675 1573 1607 1543 941 1872 1038 1284 733
- 1514 1674 1417 549 1472 1548 1704 389 1232 578 1721 817 1748 427 1371 876 1774
- 1591 1807 500 1447 1239 1825 1617 1172 1320 1569 448 1903 401 1524 561 1769
- 1127 1739 470 1588 1492 1407 903 1708 1027 1491 1849 1528 1729 1296 1591 1572
- 715 1280 1171 1487 100 { m20} R 1129 1690 818 1660 882 1467 822 1814 1083 1300
- 444 1457 1382 1275 619 1932 964 1876 1636 1842 1377 1123 565 1127 1681 1558 487
- 1581 1190 1544 1354 1617 446 1680 1834 1386 1557 1457 748 1819 1723 1459 372
- 1543 937 1564 1665 1632 1353 2042 642 1374 925 1687 463 1726 789 1410 1522 1678
- 894 2058 1237 1851 1176 1902 1161 1910 1612 1286 704 1970 1494 1914 661 1306
- 1758 1243 1034 1577 1352 1666 926 1377 1806 1712 1665 1611 1694 1212 734 1447
- 921 1352 1622 1383 374 1572 1368 1507 749 1430 1582 1402 1621 1899 777 1598
- 1488 1753 1407 1641 747 1289 820 1628 1660 1456 623 1692 1734 1919 1307 1427
- 522 1337 405 1848 698 1366 789 1728 974 1563 1488 1459 710 1143 589 1458 636
- 1416 1013 1475 649 1566 1493 1361 651 1414 1571 1251 408 1761 1756 1497 1822
- 1875 373 2177 907 1675 720 1926 1666 1422 1651 1653 607 1463 1109 1928 1478
- 1712 1186 1209 1015 1521 589 1310 812 1871 441 1857 858 1276 434 1709 534 1124
- 1762 1731 742 1311 808 1798 1845 2077 1591 1409 100 { m20} R 1347 1575 681 1172
- 1010 1399 1804 1740 1200 1729 638 1635 1226 1844 1603 1388 1178 1848 636 1761
- 1465 1394 733 1489 1614 1433 1066 1731 733 1634 1127 1195 1188 1758 721 1418
- 1399 1213 1533 2036 687 1963 503 1863 1841 1767 745 1905 1326 1793 962 1764
- 1687 1597 532 1728 1220 1911 1215 1435 1444 1602 512 1560 1766 1603 1408 1815
- 948 1661 931 1596 537 1729 737 1673 917 1607 907 1525 1445 1381 412 1382 1664
- 1565 947 1778 1298 1317 1713 1348 752 1503 698 1676 1022 1260 684 1291 1655
- 1535 874 1933 499 1478 738 1532 1118 1412 1659 1379 1825 2166 654 1320 1281
- 1564 1698 1385 704 1790 864 1274 1638 1518 1699 1236 1370 1193 1407 1281 1563
- 1453 1027 1654 449 1578 1534 1347 1089 1779 1031 1797 1773 1331 1595 1359 1801
- 1372 957 1036 1184 1505 530 1408 1184 1627 1784 1316 1656 1741 770 1732 1300
- 1598 458 1700 387 1486 1726 1255 1625 1454 1283 1464 983 1330 1587 1809 1067
- 1365 1646 1688 1713 1545 761 1767 1626 1488 661 1590 1126 1513 1633 1380 1166
- 1062 1406 1953 100 { m20} R 971 1557 1151 1381 1041 1549 1109 1494 1390 1517
- 634 1457 757 1538 1533 1455 636 1700 1042 1634 837 1517 1243 1960 1003 1219
- 1350 1477 1121 1109 1274 1340 1041 1250 540 1349 695 1152 1639 1023 520 1833
- 883 1543 413 1561 1261 1274 1486 1970 1074 1685 431 1626 537 1779 1507 1768
- 1475 1517 1526 1508 1255 1772 798 1513 622 1491 468 1365 689 1400 1727 1909 528
- 1755 760 1597 1139 1748 954 1649 1754 1972 1826 1417 580 1377 1398 999 568 1697
- 1418 1599 1116 1355 397 1530 1538 1653 1446 1663 414 1794 466 1190 1373 1519
- 656 1397 828 1420 1584 1424 1478 1317 1038 1406 1047 1742 1588 1443 894 1332
- 1809 1916 388 1657 417 1863 834 1758 792 1371 572 1733 907 1695 1707 1712 573
- 1865 1650 1573 1708 1475 1041 846 731 1514 760 1736 1386 1688 884 1510 1161
- 1792 1427 1826 627 1262 531 1807 1236 1951 1829 1409 521 1654 1414 1405 643
- 1717 1192 2013 1510 1901 1139 1673 617 1508 1578 1581 1498 1312 431 1422 1649
- 1446 1249 1871 1282 1401 1522 1250 1662 1778 931 1690 100 { m20} R 678 1653 610
- 1634 982 1413 1432 1834 703 1582 559 1212 1793 1421 1148 1780 1621 1519 522
- 1343 738 1758 946 1471 1164 1718 1004 1872 835 1302 1447 1575 882 1745 1670
- 1495 491 1222 1537 1621 765 1561 553 1495 1670 1502 1347 1313 1568 1415 1320
- 1675 796 1559 1061 1067 1771 1696 1555 1652 765 1416 406 1921 1328 1385 1145
- 1216 1088 1152 1722 1526 1298 1722 512 1289 996 1513 1832 1385 413 2095 1683
- 1481 1629 1855 617 2037 752 1472 885 1758 992 1569 479 1398 1809 1307 1425 1285
- 983 1604 470 1232 1234 1535 1544 1608 1852 1820 1850 1232 397 1565 511 1475 492
- 1509 1526 1390 1056 1183 1269 1696 668 2230 1358 1940 1634 1867 1235 1607 988
- 1367 1846 1354 1131 1629 856 1539 1079 1861 1188 1383 424 1779 712 1574 789
- 1547 1233 1332 1830 1735 995 1876 467 1807 1442 1657 1182 1651 1488 1571 814
- 1592 1130 1854 1708 1631 1700 1073 1742 1778 466 1753 1468 1282 606 1739 1404
- 1507 1269 1792 1236 1402 1665 1499 1186 1277 1296 1583 1619 1521 1144 1424 1184
- 1702 1815 1665 100 { m20} R 1534 1700 1760 1433 399 1681 1272 1543 569 1607 959
- 1330 1212 1461 484 1602 1703 1602 1834 1043 707 1307 709 1779 1158 1457 1075
- 2061 1319 1206 1811 1342 1620 1419 1795 1353 1675 1221 1156 1860 901 1810 1380
- 1706 1827 1772 1378 1554 1066 1374 1187 1913 1739 1566 825 1838 1448 1827 1700
- 1853 959 1589 1166 1376 1314 1698 1119 2022 873 1723 1038 1375 548 1297 1653
- 1282 910 1557 518 1430 882 1227 1298 1401 1623 1456 943 1749 971 1312 1274 1618
- 1649 1585 995 1758 1373 1562 1722 1834 1693 1329 1503 1490 1529 1995 1759 1570
- 1323 1260 1098 1810 1301 1680 1234 1785 1096 1727 732 1727 1646 1350 594 1256
- 909 1348 737 1444 858 1491 1695 1627 1618 1618 1844 1760 958 1563 586 1846 1034
- 1405 1580 1643 1166 1583 1480 1899 1044 1776 1158 961 1797 1557 1018 1577 1428
- 1474 1228 1509 1498 1623 508 1137 937 1717 1295 1847 715 1148 1170 1859 1662
- 1832 706 1489 1636 1567 1839 1345 1183 1413 782 1674 945 1522 804 1973 1471
- 1737 687 1331 974 1817 492 1330 1303 1713 765 1614 100 { m20} R 1210 1622 974
- 1347 1299 1252 1710 2086 1622 1693 1585 1474 1572 1463 739 1549 717 1452 1118
- 1462 1262 1496 740 1356 1375 1903 1159 1563 1643 2022 782 1428 1525 1540 980
- 1322 1356 1879 448 2147 1843 1757 1630 1502 862 1534 980 1585 1370 1287 791
- 1296 1149 1504 1444 1564 1674 1310 1092 1366 1020 1872 652 1388 439 1687 995
- 1667 1219 1642 1781 1278 621 1119 1402 1465 1852 1542 1829 1993 1204 1416 800
- 1563 1848 1543 1680 1638 1225 1317 1792 1547 712 1786 1209 1322 592 1434 851
- 1565 824 1611 748 2119 436 1610 1308 1928 1183 1774 1580 1419 591 1282 1267
- 1083 1129 1607 910 1729 1638 1550 822 1763 1035 1654 588 1608 670 1541 850 1303
- 499 1821 1789 1842 1694 1708 1272 1703 1172 1632 486 1656 845 1916 823 1245 923
- 1274 1655 1818 709 1738 489 1699 716 1280 962 1992 838 1760 1120 1309 1149 1571
- 1428 1769 501 1780 1021 1277 616 2056 1123 1135 403 1543 1147 1322 691 1442 510
- 1681 572 1260 880 1882 1040 1226 1601 1569 1116 2082 1387 1613 789 1145 991
- 1465 100 { m20} R 1730 1467 762 1415 1811 1778 1407 2030 1509 1220 588 1888 674
- 1733 408 1461 788 1261 1264 1511 1061 1498 1386 1993 877 1539 1568 1838 1616
- 1938 728 1399 1190 1882 1262 1760 1746 1511 622 1133 981 1633 1180 1892 489
- 1516 1575 1517 761 1866 1657 1528 1681 1444 1674 1743 658 1632 983 1565 669
- 1709 1150 1865 781 1487 1228 1346 1003 1780 659 1812 1210 1569 1821 1568 1139
- 1634 1646 1766 712 1503 1141 1655 1174 1767 812 1515 381 1623 1780 1621 1215
- 1488 743 1147 831 1208 624 1386 545 1392 1332 1847 906 1418 1204 1831 1082 1455
- 1680 1878 1158 1753 1769 1861 700 1545 1559 1678 1838 1880 1781 1246 892 1542
- 1779 1732 1617 1438 1170 1583 1408 1804 882 1575 994 1549 1798 1696 1094 1430
- 1849 2074 1240 1602 582 1619 1643 1415 1227 1636 1399 1401 854 1023 400 1796
- 803 1542 522 1354 1528 1684 442 1497 1263 1603 733 1588 648 1903 431 1577 576
- 1453 1031 1445 1534 1437 729 1570 1375 1604 795 1027 839 1648 1368 1913 1452
- 1671 1251 1442 1404 1718 816 1390 425 1595 100 { m20} R 936 1544 567 1625 1235
- 1385 915 2043 1497 1126 949 1363 1064 1503 1656 1285 444 1380 1653 1513 891
- 1756 1720 1600 1558 1209 949 1765 1555 1643 1573 1422 483 1491 1532 1570 1476
- 1352 1637 1486 585 1927 1279 1370 1319 1951 597 1757 954 1684 1005 1869 1000
- 1417 1487 1573 1852 1631 1535 1588 1840 1291 1610 1950 787 1619 667 1436 1516
- 1646 1263 1473 584 1471 1606 1444 1223 1716 1235 1479 1725 1624 1086 1631 1289
- 1568 936 1805 374 1653 970 1404 1397 1319 1334 1412 679 1834 1391 1489 893 1201
- 664 1477 786 1659 1125 2072 1144 1834 689 1412 793 1518 783 1501 1119 1958 878
- 1749 1769 1634 1808 1701 847 1707 1824 1102 1587 1368 1576 1795 773 1654 604
- 1571 1720 1502 1840 1591 577 1549 849 1485 398 1612 1223 1459 1102 1494 1511
- 1521 1031 1493 1377 1807 372 1726 691 1654 1746 1356 550 1287 1263 1406 1332
- 1671 1633 1852 1521 1343 737 1669 747 1624 922 1553 965 1080 1395 1284 1012
- 1400 1504 1763 703 1345 1321 1135 780 1423 1553 1745 1479 1557 883 1563 1346
- 1644 100 { m20} R 390 1232 933 1530 508 1317 1120 1365 1785 1748 514 1616 583
- 1621 1624 1277 1517 1559 1698 1394 957 1543 1296 1358 1024 1699 792 1986 1467
- 1478 1692 1185 1105 1768 825 1593 587 1206 1723 1467 1545 1210 614 1734 826
- 1420 1627 1507 1648 1663 875 1488 533 1607 973 1420 1823 1980 1182 1773 1352
- 1655 1801 1673 1690 1751 1583 1375 1367 1680 445 1794 1724 1830 1397 1656 1574
- 1737 893 1499 548 1373 1591 1488 1319 1308 1787 1614 1499 1811 613 1703 1591
- 1291 1384 1582 1464 1613 1036 1517 1245 1539 686 1977 1436 1442 930 1556 1586
- 1439 629 1497 944 1790 461 1810 650 1660 594 1570 554 1357 511 1429 1397 1762
- 1057 1434 940 1407 1095 930 910 1661 1240 1576 1391 1627 970 1875 1201 1327 541
- 1439 410 1741 1790 1468 384 1528 918 1527 1827 1439 1124 1328 880 1789 653 1647
- 1404 1676 1676 1349 1758 1885 1078 1364 656 1958 1434 1173 1635 1673 1462 1451
- 1135 1452 1624 1645 560 1470 393 1977 1313 1193 1314 1605 1360 1803 482 1715
- 909 1358 735 1897 1793 1842 1414 1331 100 { m20} R 1051 1743 1023 1633 1382
- 1899 1106 1660 665 1494 419 1379 1790 1618 1667 1281 1047 1705 1131 1485 1319
- 1467 813 1608 1483 1509 1833 1914 1590 1747 1156 1274 1808 1189 1065 1382 576
- 2047 614 1637 1566 1463 1503 1488 1749 1716 1511 1623 937 1684 1470 1142 1234
- 1658 1107 1639 1182 1593 1386 1424 713 1394 1455 1551 1601 1476 1126 1528 822
- 1425 1419 1617 1239 1475 1732 1346 1145 1687 761 1480 898 2100 1381 1241 1287
- 1301 963 1442 1338 1572 726 1911 876 1367 1384 1869 1689 1468 486 1303 1679
- 1411 461 1583 572 1584 399 1967 841 1945 959 1231 574 1606 1411 1827 1483 1486
- 599 1640 441 1875 1057 1691 1424 1608 1198 1480 1338 1639 707 1199 1342 1353
- 1054 1674 817 1559 961 1550 1798 1598 1408 1848 572 1461 950 1886 768 1683 590
- 1525 1276 1808 494 1666 1199 1563 391 1953 763 1615 415 1499 468 1439 772 1813
- 1436 1449 1254 1838 629 1551 1789 1940 642 2001 1669 1988 977 1388 937 1431 532
- 1829 917 1495 509 1491 1827 1489 530 1251 491 1198 1132 1489 1067 1550 100 {
- m20} R 1654 1151 841 1452 578 1307 1077 1334 955 1805 1318 1778 1086 2246 1387
- 1359 1592 1575 1589 2007 1727 1627 985 1922 1539 1399 1167 1605 610 1293 722
- 1791 1421 1416 1177 1654 1828 1595 1629 1584 1181 1614 1076 1603 1675 1731 862
- 1622 1198 1726 1344 1636 1472 1858 522 1602 1202 1206 1069 1387 858 1462 813
- 1207 805 1384 1286 2031 567 1386 996 1570 1284 1256 1100 1608 1378 1470 1630
- 1755 1805 1613 392 1829 1814 1513 1766 1758 1052 1854 1181 1593 1539 1755 1807
- 1412 1682 1327 943 1346 1485 1679 1849 1691 949 1193 799 1371 1517 1257 506
- 1449 1060 1742 555 1658 1587 1711 724 1514 1390 1358 825 1398 1147 1619 462
- 1055 1108 1448 1478 1259 1253 1474 1076 1948 850 1388 1430 1172 1437 1411 1619
- 1765 592 1598 1657 1229 436 1624 1766 1625 420 1910 1202 1331 1530 1903 510
- 1588 1725 1642 602 1715 1738 1439 1023 1622 421 1767 1629 1307 1480 1644 1167
- 1483 1115 1691 1037 1490 1141 1563 1692 1649 915 805 1375 1844 1059 1600 1058
- 1262 1171 1744 1782 1269 892 1804 1736 1845 100 { m20} R 537 1655 513 1663 1304
- 1306 1674 1288 1566 1504 576 1545 606 1562 1062 1509 1088 1558 1521 1542 660
- 1687 1139 1500 1406 1600 1208 1594 1520 1536 1597 2107 575 1561 1175 1508 849
- 1618 971 1334 1142 1462 787 1553 1732 1492 719 1275 1624 1593 505 1812 1280
- 1468 1405 1491 673 1389 1771 1417 1447 1557 1523 1557 500 1356 1807 2151 1295
- 1421 832 1311 482 1439 429 1860 1739 2039 1065 1682 1842 1537 432 1510 1444
- 1503 634 1166 832 1742 1552 1598 1578 1491 864 1695 1134 1340 610 1559 712 1519
- 491 1454 1591 1484 1230 1549 1766 1246 1326 1427 1365 1621 1504 1553 897 1400
- 1379 1523 969 1871 1038 1258 543 1391 1633 1735 656 1348 989 1792 1747 1781
- 1430 1609 526 1962 1323 1745 1440 1291 794 1320 1783 1561 560 1523 456 2114 948
- 1555 1851 1695 1019 1549 1330 1461 1074 1938 516 1498 951 1674 1610 1427 1290
- 1707 1344 2106 1438 1936 1767 1748 1500 1554 1693 1406 1119 1682 1846 1267 577
- 1646 1743 1289 569 1874 811 1248 1785 1071 1749 1296 1370 1348 1709 1568 1047
- 1631 100 { m20} R 1613 1754 809 1351 1537 1561 1720 1726 1103 1518 1583 2056
- 1344 1335 818 1579 1530 1869 400 1366 1630 1300 882 1491 1179 2019 1480 1578
- 512 1504 1090 2043 960 1462 1614 1191 944 1323 1249 1872 423 1604 1309 2004
- 1027 1445 449 1915 1852 1404 974 1325 1816 1889 1510 1822 1828 1337 692 1545
- 1805 1203 716 1510 1471 1561 1165 1524 1319 1406 1178 1704 411 1420 830 1243
- 1049 1520 1763 1748 564 1302 1429 1639 844 1567 1487 1596 1845 1516 1038 1570
- 1207 1243 1123 1710 1785 1359 1764 1106 614 1319 580 1649 879 1728 1096 1533
- 459 1514 1746 1192 668 1489 1278 1787 470 2155 1687 1594 702 1726 437 1617 1596
- 1748 489 1601 1852 1479 389 1706 938 1626 1757 1536 828 1449 1018 1770 1849
- 1589 889 1579 692 1640 1315 1885 1285 1596 1517 1839 1052 1587 1459 1774 1807
- 1374 1217 1684 1668 1205 750 1192 1852 1339 488 1431 1533 1843 1850 1467 652
- 1741 1014 1721 653 1673 497 1707 710 1727 1124 2062 1291 1786 1344 1371 1105
- 1656 897 1460 1342 1398 1711 1858 910 1250 374 1565 100 { m20} R 1146 1631 680
- 1600 1070 1406 876 1455 759 1268 800 1821 1554 1505 678 1277 923 1811 539 1571
- 1576 1780 1142 1645 1349 1289 904 1785 1092 1651 1778 1198 876 1680 1560 1787
- 1656 1338 1674 1697 1531 1741 1255 1419 539 1620 784 1953 1179 1503 691 1438
- 1298 1520 661 1594 701 1250 897 1516 1410 1586 735 1143 1687 1167 611 1897 687
- 1597 854 1569 1040 1578 1305 1885 717 1500 1046 1840 1508 1827 482 1661 1182
- 1639 1540 1492 1527 1662 1159 1603 714 1645 973 1338 48 { m20} R 446 1837 1055
- 2165 657 2182 426 1598 1621 1202 1373 1338 1666 1060 1585 1638 1792 1541 973
- 1698 1314 1048 1768 1305 734 1285 963 1525 622 1651 1025 1529 777 1839 419 1462
- 518 1706 1493 1762 1771 2045 770 1871 1721 1556 814 1769 1280 1842 1441 1420
- 1530 1345 744 1629 1716 1484 1677 1102 1274 1918 1837 1789 864 1734 696 1371
- 1696 1519 1587 1849 1148 1270 830 2048 965 1650 954 1320 387 1453 1083 2123 578
- 1599 442 1523 833 1717 1706 1789 1784 1896 548 1375 888 1291 729 1239 935 1801
- 1349 1557 1048 1452 814 1484 1459 1728 505 1333 1540 1324 1635 1552 453 1322
- 1558 1799 1630 1295 1441 1184 1310 1297 1756 1768 481 1431 1610 1660 1192 1690
- 817 1576 857 1880 1142 1423 1557 1698 729 1932 1139 1647 1851 1574 625 1832
- 1766 1528 424 1285 1840 1712 1496 1760 858 1934 1466 1497 1405 1563 1029 1529
- 1510 1531 1750 1471 739 1459 825 1506 1639 1469 670 1683 1832 1592 1336 1508
- 583 1568 1391 1538 1407 1472 1025 1701 1136 1448 1838 1758 1831 1441 405 1737
- 1230 1579 100 { m20} R 1113 1505 851 1421 1271 1615 484 1858 1630 1551 1503
- 1229 1439 1801 939 1535 1093 1627 1129 1761 1552 1730 653 1745 1422 1549 990
- 1706 1837 1946 1488 1329 1528 1282 1360 1921 1408 1575 1565 1363 1189 1365 1589
- 1368 1799 1732 842 1803 1309 1556 630 1277 1691 1513 1011 1557 1482 1860 1441
- 1802 1109 1350 376 1738 766 1576 1215 1675 724 1473 721 1483 1401 1753 1020
- 1751 460 1726 1525 1618 1231 1462 1797 1273 543 1458 1449 1269 1653 1412 1057
- 1272 586 1468 446 1459 715 1664 1617 2214 1435 1515 1495 1629 731 1593 1335
- 1767 1732 1871 1026 1583 475 1517 905 1466 1510 1665 1425 1807 933 1503 1130
- 1551 1537 1375 707 1735 939 1690 594 1440 650 1628 372 1784 722 1670 906 1308
- 932 1650 1809 1162 1739 1468 1042 1389 1579 1052 1096 1442 923 1769 1393 1881
- 1850 1714 1537 1511 712 1454 568 1958 583 1453 1812 1756 1751 1410 665 1445
- 1769 1571 632 1434 865 1692 1427 1905 544 1351 1366 1030 999 1683 864 1669 726
- 1546 1299 2002 1167 1423 525 1882 1042 1509 1209 1406 100 { m20} R 686 1415 451
- 1550 688 1545 380 1769 1288 1418 603 1779 1268 1753 1047 1506 662 1733 1588
- 1603 455 1457 818 1703 1020 1696 1048 1356 1072 1661 1686 1599 709 1151 988
- 1302 1831 1516 978 1548 1359 1332 479 1583 620 1123 966 1701 948 1988 864 1378
- 1650 1659 1199 2198 472 1387 491 1395 1415 1692 631 1793 920 1424 1728 1551 642
- 1429 921 1578 1153 2005 1512 1392 733 1347 1451 1214 1648 2199 859 1680 576
- 1810 1510 1748 1579 1724 928 1843 1326 1878 781 1584 428 1882 1422 1781 497
- 1381 1373 1447 1712 1563 473 1648 955 1609 789 1716 1771 1609 1213 1407 525
- 1318 1806 1465 1149 1320 1408 1257 1396 1698 1739 1241 1594 1827 1277 1494 1143
- 1474 668 1478 1090 1378 1076 1663 857 1402 1118 1641 717 1502 1315 1544 638
- 1961 987 1493 779 1593 863 1760 740 1251 832 1848 447 1267 531 1705 1846 1332
- 1528 1734 900 1436 763 2011 625 1611 431 1446 966 1541 810 1549 1578 1563 1620
- 1781 1191 1431 783 1427 949 1960 1408 1457 1557 1358 1336 1644 1721 1683 1793
- 1190 100 { m20} R 1815 1696 1716 1515 1779 1244 1611 1920 1571 1390 577 1467
- 1076 1257 1612 1096 1754 1777 1121 2153 1455 1558 418 1638 1656 1629 1677 1511
- 899 1314 611 1291 957 1555 1215 1521 1200 1613 1621 1616 1789 1543 877 1839
- 1692 1503 390 1521 1288 1883 1025 1122 935 1519 1577 1477 777 1792 1354 1510
- 553 1344 522 1683 1501 1279 1297 1490 1441 1534 1389 1474 440 1749 1159 1725
- 1620 1168 1723 1644 1000 1450 1562 1809 495 1477 1457 2100 781 1317 507 1776
- 1732 1456 1065 1678 751 1520 957 2168 1385 1111 1740 1552 686 1404 406 1816 499
- 1511 1564 2127 459 1316 542 1318 1814 1665 1505 1423 385 1689 1635 1634 1775
- 1600 659 1230 1832 1449 1233 1459 1343 1695 1478 1518 651 1630 1805 1612 681
- 1596 1576 1755 1575 1568 1069 1538 1139 1493 1485 1550 639 1391 1244 1937 839
- 1800 1642 1642 1176 1839 478 1955 740 1565 726 1595 1043 1630 601 1630 1111
- 1422 427 1646 1807 1948 950 1363 1215 1302 1382 1407 1097 1456 608 1343 1758
- 1797 396 1138 661 1411 536 1223 986 1828 1204 1597 100 { m20} R 569 1487 1144
- 1864 564 1739 1282 1506 1230 1886 1619 1463 1313 1840 635 1907 1342 1605 1776
- 1408 1692 1384 1149 1720 1760 1214 394 1581 1327 1405 1364 1662 681 1332 1265
- 1666 732 1730 1658 1603 983 1485 1513 1063 1485 2048 1727 1595 727 1708 1260
- 1347 1015 1620 575 1565 1653 1376 1710 1373 995 1594 1008 1845 1557 1489 1073
- 1377 1453 1739 373 1907 659 1434 1421 1339 1234 1293 1798 1604 1348 1262 1626
- 2000 480 1539 1774 1388 1288 1182 589 1125 647 1327 743 1309 1216 1749 1738
- 1573 1538 1351 1828 1406 1084 1629 815 1335 1305 1488 808 1649 441 2055 821
- 1864 1004 1669 1049 1225 1620 1951 1101 1483 860 1358 1243 1615 1158 1481 1718
- 1771 1211 1552 1218 1250 1507 1596 1596 1659 1392 1243 1769 1895 1690 1156 944
- 1402 1559 1858 889 1871 1696 1456 479 1873 1774 1635 1762 1491 1539 1642 1178
- 1596 1069 1496 1321 1865 1357 1158 466 1438 1717 1284 1181 1101 1223 1637 1475
- 1582 1365 1824 708 1628 782 1547 1481 1669 915 1407 645 1382 380 1255 571 1810
- 1745 1717 728 1229 100 { m20} R 783 1765 441 1778 526 1711 779 1637 791 1705
- 1635 1752 1118 1728 1713 1714 1147 1751 1129 1708 1440 1880 979 1154 1311 1219
- 439 1303 1406 1436 462 1799 480 1383 1230 1880 669 1886 917 2002 1661 1869 1344
- 1486 1318 1605 431 1877 1090 1607 1662 1706 418 1660 1166 1467 631 1791 986
- 1674 437 1564 725 1712 1709 1363 1224 1500 1728 1537 1527 1455 1340 1292 989
- 1487 559 1415 585 1792 769 1626 1077 1635 1253 1652 973 1095 419 1255 1815 1729
- 830 1497 1348 1754 1815 1290 1188 1683 497 1636 1358 1820 767 1812 588 1970
- 1498 1431 809 1335 793 1412 941 1734 1343 1672 624 1362 1435 1479 1134 1298
- 1472 1765 681 1951 1710 1567 1649 1463 743 1631 1404 1511 1830 1906 790 1609
- 1422 1607 504 1531 566 1484 1433 1652 1294 1891 514 1530 1057 1409 1472 1584
- 1295 1497 1302 1927 628 1509 1134 1334 942 1384 1038 1300 644 1085 1106 1249
- 1056 1882 1308 1506 791 1591 1323 1408 868 1574 597 1428 1129 1762 1217 2120
- 381 1222 1709 1783 1278 1611 1294 1649 1678 1942 884 1537 100 { m20} R 1640
- 1429 1510 1466 398 1166 1295 1890 1580 1144 1710 1529 563 1802 1841 1816 1307
- 1524 508 1315 1343 1524 924 1637 1446 1738 1646 1407 675 1711 1695 2118 839
- 1643 597 1731 1131 1626 1618 1571 1297 1663 866 1527 1434 1299 661 1874 1305
- 2190 1515 1569 1819 1175 1812 1478 1843 1685 1083 1800 1563 1273 675 2023 1155
- 1234 1609 1379 1447 1794 1207 1344 1680 1566 491 1829 544 1611 1682 1893 1722
- 1668 1287 1692 403 1271 800 1452 1068 1657 1450 1552 658 1432 441 1713 1438
- 1303 993 1461 612 1134 1473 1810 1390 1601 1099 1446 601 1870 467 1207 897 1350
- 898 1852 1668 1433 905 1813 798 1747 1478 1520 831 1480 1692 1898 606 1314 1196
- 1464 1322 1570 1813 1292 557 1716 1646 1606 794 1605 855 1433 452 1832 1655
- 1341 371 1491 945 1306 1722 1761 799 1822 1178 1391 1436 1264 813 1692 858 1532
- 1249 1726 1184 2001 736 2329 1120 1622 1447 1185 1485 1524 1418 1213 1001 1249
- 883 1824 1539 1452 728 1811 1597 1615 447 1177 1200 1588 1357 1377 408 1734
- 1103 1393 645 1788 100 { m20} R 1313 1457 1668 1464 631 2113 584 1585 1364 1703
- 1099 1254 799 1776 771 1936 1729 1884 1703 1247 734 1301 383 1712 624 1285 678
- 1670 599 1291 632 1705 1244 1792 1322 1510 1274 1869 1778 1722 371 1559 489
- 1712 1458 1538 1619 1669 976 1496 1484 1564 1238 1619 671 1231 1471 1714 675
- 1512 1501 1650 454 1604 508 1593 1837 1735 1719 1770 1083 1331 1816 1418 1830
- 1364 1738 1356 1780 1648 1493 1646 1317 1202 446 1652 379 1615 1035 1524 1024
- 1348 1731 1344 459 1547 502 1297 1203 1474 861 1397 817 1763 1726 1390 910 1418
- 1531 2144 602 1928 443 1707 872 1558 1725 1407 922 1603 1130 2019 704 1460 464
- 1768 1759 1493 1483 1263 1492 1792 460 1184 1686 1545 834 1740 1066 1636 1668
- 1332 412 1734 1820 1493 1446 1567 1422 1567 593 1257 1695 1582 1735 1522 402
- 1413 1729 1467 1458 1423 888 1830 920 1176 1763 1982 1236 1091 1154 1630 753
- 1607 655 1692 514 1576 1094 1341 1129 1599 1552 1528 852 1542 1277 2245 1231
- 1776 1662 1561 1310 1604 1309 1596 554 1755 1757 1658 100 { m20} R 1766 1646
- 455 1460 1608 1254 1401 1212 1253 1424 829 1905 1727 1487 1477 1255 1829 1331
- 1388 1217 832 1220 1842 1540 542 1302 1171 1236 1304 1456 1573 1658 681 1787
- 539 1611 1852 1755 547 1324 1430 1767 526 1618 866 1425 999 2016 669 1640 1798
- 1602 454 2095 1130 1403 1027 1653 1040 1932 533 1457 1662 1585 1249 1346 779
- 1331 1338 1365 541 1339 570 1649 585 1216 1120 1373 581 1653 1650 1607 760 1633
- 1552 1517 789 1768 926 1497 1339 1550 770 1414 794 1303 1395 1234 882 1633 1698
- 1193 802 1423 1757 1476 580 1815 854 1293 906 1758 1000 2100 1214 1815 1588
- 1322 761 1894 1350 1850 1318 1326 1471 1560 1566 1150 816 1825 464 1278 1814
- 1409 1295 1661 1840 1603 1320 1375 958 1282 470 1729 1393 1792 634 1766 958
- 1384 689 1755 1257 1559 1451 1584 963 1520 1179 884 1519 2019 884 1374 798 2108
- 1583 1931 1666 1798 791 1971 1716 1516 717 1130 1511 1867 1060 1151 940 1362
- 585 1308 927 1559 1401 1428 1526 1416 1764 1215 1845 1586 1590 1575 1164 1768
- 810 1836 100 { m20} R 1308 1552 1547 1582 1481 1468 1306 1181 1673 1374 646
- 1774 1091 1520 844 1379 640 1631 918 1329 589 1735 768 1749 699 1178 1365 1510
- 811 1633 1465 1446 421 1461 1486 1642 1786 1869 1036 1562 1677 1538 1015 1481
- 473 1444 1671 1753 813 1741 997 1292 1759 1518 843 1854 922 1481 449 1541 1328
- 1387 892 1666 552 1448 1110 1836 1687 1521 1086 2019 1470 1252 1364 1850 1485
- 1543 904 1553 1325 1632 1534 1753 1220 1557 506 2278 1112 1461 1326 1820 1227
- 1334 801 1642 646 1582 1476 1606 1509 1776 1664 1402 813 1380 1034 1193 672
- 1700 1400 1714 1114 1208 979 1685 1755 1964 1304 1582 1154 1625 425 1510 879
- 1589 1719 2014 1089 1490 1455 1864 1029 1692 1298 1623 393 1688 1476 1293 1614
- 1292 1029 1540 960 1584 875 1716 1793 1665 901 1454 1102 1566 418 1366 1848
- 1018 1519 1451 868 1689 1851 1690 1146 1542 989 1606 1288 1324 439 1409 899
- 1856 920 1579 894 1357 778 1849 591 1411 1156 1392 1658 1290 518 1770 1436 1782
- 1252 1474 962 1262 552 1520 732 1490 966 1615 100 { m20} R 1541 1796 1181 1526
- 824 1690 1264 1476 1826 1303 533 1364 1799 1195 1341 1272 1445 2021 1130 1854
- 1467 1336 1146 2126 772 1654 1826 1396 1437 1538 421 1687 830 1601 614 1708 564
- 1487 1821 1713 612 1599 588 1395 942 1435 390 1409 1525 1550 1756 1799 1744
- 1059 1088 1714 1440 1686 961 1528 1013 1566 554 1003 859 1436 681 1533 926 1824
- 880 1438 736 1680 1750 1525 558 1948 1301 1732 1272 1595 1079 1738 878 1382
- 1051 1629 647 1549 701 1992 534 1339 1294 1493 1356 1363 1696 1373 1852 2046
- 1655 1524 424 1486 1738 1996 752 1156 821 1683 1218 2013 1105 1341 909 1245
- 1718 1910 883 1559 682 1911 882 1762 1675 1372 795 1547 440 1249 1836 1155 1373
- 1727 1847 1767 1063 1130 739 1339 1247 2003 690 1571 1321 1505 586 1524 1491
- 1893 1706 1867 751 1833 1292 1688 887 1478 968 1484 1402 1712 1412 1572 899
- 1516 1009 1536 1499 1530 1382 1940 1555 1598 672 1197 1778 1793 1153 1393 1259
- 1613 1692 1794 1609 1659 1252 1558 1840 1222 1575 1995 979 1361 1348 1718 540
- 1467 100 { m20} R 1245 1451 1517 1766 571 1614 982 1735 460 1670 1805 1482 1376
- 1676 515 1852 587 1441 1423 1600 1503 1529 1653 1672 985 1357 1170 1446 1387
- 1612 1359 1660 1747 1427 872 1588 1841 1699 1160 1430 745 1878 675 1650 446
- 1062 1377 1390 1445 1569 759 1642 1742 1127 1302 1477 464 1407 1481 1512 1306
- 1884 583 1759 374 1718 1647 1344 654 1354 656 1415 973 1826 991 1707 1065 1686
- 415 1577 1023 1727 384 1434 406 1649 1786 1601 592 1871 1110 1844 507 2161 1200
- 1657 1414 1769 898 1433 597 1709 1382 1616 1378 1417 1115 1587 971 1484 379
- 1450 1575 1743 593 1417 792 1676 512 1689 1252 1642 897 1583 1596 1689 1356
- 1593 1606 1611 1513 1357 956 1488 699 2002 1251 1398 385 1664 1517 1623 1731
- 1507 446 1671 694 1986 1489 1602 481 1571 592 1265 788 1144 1571 1478 676 1285
- 677 1249 1557 1317 1261 1473 1278 1514 1623 1509 1209 1392 1544 1516 903 1148
- 1719 1516 624 1736 1318 1737 763 1413 611 1351 821 1373 539 1487 1729 1423 1535
- 1665 1336 1252 551 1796 1447 1366 100 { m20} R 1680 1338 1399 1631 1472 1502
- 1841 1670 1153 1839 1123 1588 440 1474 835 2010 713 1619 663 947 466 1478 1524
- 1528 1187 1581 1055 1588 654 1435 1768 1876 821 1568 1603 1410 1403 1481 1826
- 1594 1222 1459 712 1387 423 1619 1380 1174 965 1290 492 1584 895 1729 900 1728
- 500 1373 869 1497 873 1482 1703 1789 845 1355 1183 1671 1116 1355 1851 1564 858
- 1343 1485 1557 501 1589 755 1063 1561 1764 485 1228 463 1780 759 1574 529 1822
- 667 1817 1499 1742 617 1476 1658 1313 718 1177 1306 1352 1794 1579 1138 1349
- 464 1511 942 1150 1585 1928 1727 1167 981 1206 1507 1849 416 1006 936 1571 1749
- 1767 1352 1364 1432 1395 548 1815 1541 1574 1361 1633 1772 1580 401 1807 1487
- 1181 1137 1501 781 1808 1611 1507 1297 1319 656 1322 1840 1251 1565 1382 1069
- 1274 1559 1735 800 1673 1020 1445 468 1681 1171 1707 1788 1940 1536 1705 1428
- 1370 1118 1590 378 1004 744 1346 1502 1750 499 1826 1707 1652 1213 1526 1697
- 1377 1517 1661 422 1728 475 1742 517 1546 1525 1498 1029 1527 100 { m20} R 1205
- 1474 1256 1502 756 1378 1400 1713 1820 1381 1427 1736 764 1532 980 1782 1329
- 1516 1265 1423 1481 1725 397 1128 521 1740 952 1916 952 1474 1542 1467 782 1244
- 946 1589 1669 1701 1101 1664 775 1645 457 1676 400 1297 1350 1485 527 1828 582
- 1951 1417 1641 1087 1723 1051 1561 1504 1854 614 1463 597 1812 637 1454 1311
- 1668 896 1331 970 1496 816 1926 551 1522 843 1727 1190 1540 1725 1287 855 1768
- 942 1711 1803 1349 382 1447 1184 1733 1026 1567 912 1469 492 1809 663 1511 1357
- 1785 682 2021 994 1443 470 1435 1129 1127 1121 1381 760 1311 1305 1443 1092
- 1752 1300 1598 388 2157 581 1435 1455 1689 1574 1275 821 1447 1252 1419 767
- 1808 915 1571 683 1619 695 1786 1052 2068 1469 1442 1255 2232 460 1716 1634
- 1717 986 1493 1119 1781 654 1431 1362 1744 1029 1216 612 1443 759 1583 1053
- 1205 1342 1573 935 1312 1843 1377 815 1646 955 1673 1612 1794 1793 1284 1329
- 1824 1749 1353 897 1350 1745 1470 636 1740 940 1468 535 1832 855 1697 665 1483
- 1160 1878 100 { m20} R 1841 1665 486 1408 767 1630 400 1576 1146 1269 1039 2008
- 1528 1297 509 1340 446 1389 988 1645 1695 1581 1513 1372 1655 1385 1426 1421
- 755 1873 1052 1996 1313 1521 1494 2050 791 1995 768 1093 1598 1947 1082 1996
- 510 1769 1840 1874 1116 1355 1487 1694 576 1331 1538 1571 568 1676 1362 1609
- 1658 1543 1358 1756 1100 1870 1173 1165 728 1370 1560 1461 1402 1434 1355 1510
- 420 1100 1116 1740 952 1454 1046 1297 471 1341 433 1415 1502 1424 452 1777 657
- 1445 529 1543 984 1398 1057 1806 640 1259 1484 1371 1194 1876 960 1705 1630
- 1232 1225 1289 1634 1422 1254 1665 1469 1429 1445 1762 1041 1330 1777 1516 817
- 1927 1244 1640 1055 1163 1444 1591 1561 1310 728 1319 866 1962 1754 1793 1194
- 1827 773 1671 1133 1780 996 1857 727 1624 702 1497 846 1400 1008 1531 1094 1147
- 839 1707 1165 1563 1198 1476 1850 1164 1589 1718 1490 1497 940 1566 588 1300
- 1739 1501 681 1472 1110 1450 531 1670 542 1677 1821 1169 1274 2032 503 1721 855
- 1918 414 1647 1052 1909 888 1957 1591 1430 100 { m20} R 559 1963 1645 1507 1628
- 1911 442 1899 1640 1850 1311 1444 1412 1790 1435 1399 1723 1515 719 1250 608
- 1983 1230 1260 1335 1243 653 1670 1537 1651 1784 1177 539 2066 658 1651 946
- 1824 1624 1748 852 1803 541 1257 769 1687 1292 1747 830 1355 1062 1371 1337
- 1519 1355 1598 1600 1072 641 1370 1628 1719 1388 1599 653 1693 1803 1888 1179
- 1487 1004 1894 820 1751 381 1670 1558 1622 1671 1696 1336 1228 1314 1546 1794
- 1563 919 1458 922 1562 743 1598 691 1359 717 1753 1515 1512 1530 1735 1083 1244
- 533 1888 1052 1561 1209 1378 379 1430 1516 1645 1371 1310 511 1712 1825 1937
- 1290 1706 765 1500 1494 1667 1113 1660 610 1605 714 1618 381 1391 1274 1741 982
- 1804 1021 1627 1850 1667 1760 1536 908 1590 1206 1847 1047 2004 438 1985 1103
- 1502 1563 1258 1274 1633 1015 1655 1776 1856 783 1358 1003 1440 391 1370 1265
- 1827 1053 1516 540 1751 552 1384 648 1822 1040 1548 1620 1471 917 1868 850 1601
- 1006 1507 1485 1975 1762 1592 417 1538 999 1522 1152 1451 1323 1220 1725 1245
- 100 { m20} R 1225 1885 1308 1745 718 1800 1635 1382 1245 1491 1766 1573 1692
- 1670 549 1605 1801 1478 430 1161 1466 1342 588 1851 1117 1676 901 1731 1587
- 1319 1539 2009 1644 2034 601 1592 1318 1566 956 1933 1526 1643 1815 1254 1310
- 1561 1558 1345 590 1471 1319 1507 1085 1727 396 1555 1085 1860 644 1596 1560
- 1302 1523 1361 450 1717 502 1787 935 1197 1268 1618 1729 1300 1709 1532 1782
- 2031 1794 1441 1264 1223 879 1961 1170 1586 1370 1708 384 1397 944 1530 944
- 1746 1761 1379 1103 1579 406 1561 983 1744 1485 1464 1469 1241 1030 1500 855
- 1434 637 1670 1402 1279 1050 1595 1766 1443 1834 1533 1039 1819 836 1245 1615
- 1289 1641 1480 813 1701 890 1273 602 1813 896 1542 587 1120 1479 1691 1178 1422
- 528 1518 1715 1650 597 1529 565 1076 634 1414 927 1557 432 1252 1308 1573 1349
- 1290 587 1757 545 1755 1387 1337 1789 2135 1313 1871 1551 1356 1009 1498 1546
- 1323 1314 1341 965 1277 1081 1383 944 1695 1408 1397 748 1739 1477 1552 1282
- 1266 612 1601 1000 1599 556 1478 465 1996 100 { m20} R 1543 1561 1670 1613 1082
- 1043 427 1276 1283 1470 1761 1715 1497 1847 1239 1495 1836 1893 1411 1675 1191
- 1219 671 1789 1404 1543 1611 1572 453 1641 1355 1843 1598 1346 1400 1465 437
- 1841 1417 1350 834 1584 1628 1745 390 1564 948 1791 1286 1304 1747 1734 1136
- 1403 1494 1470 418 1371 1303 1139 388 1446 414 1853 1271 1965 1806 1965 1751
- 1445 790 1661 393 1201 1405 1758 1107 1558 1203 1851 1521 1698 740 1730 705
- 1453 445 1604 826 1604 1618 1413 927 1506 1400 1711 1385 1643 1235 1545 1199
- 1284 575 1638 1085 1754 885 1192 1367 1485 778 1712 1152 1551 623 1490 1136
- 1479 984 1721 660 1571 1030 1707 734 1745 1589 2011 749 1410 1319 1549 429 1663
- 724 1976 868 1627 1620 1724 967 1543 998 1809 978 2046 1417 1855 1370 1405 812
- 1190 535 1597 550 1577 485 1575 880 1782 499 1584 1814 1433 1583 1978 826 1512
- 1257 1465 412 1625 1573 1131 1151 865 804 1631 836 1850 1823 1724 870 1591 1840
- 1877 1009 1318 650 1744 1240 2024 1544 1638 1834 1575 1490 1626 1342 1887 100 {
- m20} R 428 1779 1516 1692 1117 1095 439 1833 1050 1813 947 1817 527 1537 843
- 1257 1755 1106 946 1665 993 1524 796 1607 416 1890 1650 1141 1510 1514 640 1482
- 717 1570 1796 1637 468 1751 593 1658 585 1622 1163 1676 522 1672 1338 2036 700
- 1669 1428 1689 1165 1950 636 1406 1112 1446 1119 1399 1001 1399 785 1691 1120
- 1573 1322 1558 465 1528 711 1327 375 1745 465 1432 371 1556 680 1677 1156 1336
- 787 1841 621 1639 1235 1699 1563 1041 1522 1714 523 1641 1312 1704 593 1495
- 1798 2034 1795 1759 1442 1299 683 1534 1019 1754 753 1659 1312 1214 868 1831
- 1162 1368 947 1704 1350 2027 1180 1459 1676 1715 1274 1713 602 1745 1275 1518
- 1585 1481 1343 2020 431 1664 670 1432 1261 1538 1224 1493 1145 1436 1607 1558
- 1682 1719 658 1395 781 1429 745 1497 1774 1766 936 1601 1145 1155 1125 1444 856
- 1641 1227 1526 1338 1704 732 1589 980 1154 1595 1442 404 1573 1672 1509 917
- 1378 1126 1645 1308 1607 1806 1699 632 1663 1321 1774 506 1718 1406 1745 1166
- 1389 1166 1238 1300 1741 100 { m20} R 848 1655 1319 968 522 1518 1543 1635 1467
- 1419 478 1097 1107 1488 515 1347 1288 1623 538 1706 593 1412 601 1734 1460 2132
- 398 1517 1498 1500 629 1498 477 1410 704 1385 569 1536 909 1536 1436 1860 534
- 1382 735 1415 1739 1657 1111 1742 1674 1167 998 1684 1522 1440 1038 1893 712
- 2009 1587 1635 382 1429 1434 1431 1490 1781 1247 1806 854 1309 1693 1563 604
- 1666 616 1530 1488 1950 1069 1083 1047 1641 1180 1763 1407 1307 1129 1834 1543
- 1798 934 1676 1192 1900 731 1472 940 1465 382 1278 1708 1569 1166 1879 1588
- 1918 1315 1461 548 1617 1445 1693 875 1408 1802 1480 476 1801 588 1423 481 1635
- 1788 1080 862 1563 777 1527 1297 1602 881 1575 1569 1847 375 1668 912 1439 1485
- 1644 860 1537 681 1719 608 1858 1686 1639 1803 1684 1014 1178 1490 1833 590
- 1726 415 1596 939 1467 1473 1662 1025 1619 1110 1958 500 1425 1184 1597 655
- 1636 1036 1657 464 1292 497 1647 604 1453 1771 1913 1591 1234 675 1302 373 1602
- 534 1584 1562 1568 1414 1779 1647 1963 611 1797 100 { m20} R 639 1466 1290 1490
- 1226 1721 780 1397 1344 1450 523 1653 1489 1448 571 1741 1550 1252 1685 1178
- 1082 1137 1798 1934 1498 1368 1655 1488 1672 1748 490 1852 1452 1674 1420 1486
- 1619 2125 1121 1248 502 1617 1122 1949 783 1526 1239 1652 1589 1702 570 1258
- 668 2147 1744 1728 1708 1395 1711 1315 1286 1403 690 1372 1543 1396 597 1651
- 1053 1242 1111 1649 714 1657 625 1181 454 1423 1654 1273 414 1244 1812 1207
- 1720 1352 1443 1329 1191 1197 1322 1920 1262 1559 571 1358 48 { m20} R 1451
- 1203 1160 1561 1225 1823 861 1719 1379 1362 1021 1599 1483 1689 605 2026 725
- 1583 1643 1395 908 1767 532 1766 1493 1566 1516 1716 668 1958 1324 1568 846
- 1349 985 1836 928 1437 446 1514 665 1591 1431 1874 1248 1541 863 1541 790 1387
- 1116 1362 1200 1691 1536 1775 863 1481 1348 1649 1476 1284 1453 1560 1591 1504
- 503 1682 732 1492 857 1244 1119 1716 520 1417 1299 1054 1454 1583 1500 1114 600
- 1194 1169 1718 1682 1394 992 1444 1379 1414 833 1473 1405 1874 1518 1725 1584
- 1659 1166 1777 1714 1360 1124 1595 1293 1656 1248 1596 1359 1874 1332 1435 373
- 1359 590 1498 1200 1451 724 1524 1599 1339 985 1186 1230 1591 1212 1688 906
- 1524 424 1040 1175 1163 860 1818 1752 1541 839 1296 1646 1534 976 1093 1221
- 1862 1116 1327 1118 1612 410 1538 1126 1537 567 1141 701 1921 500 1458 1546
- 1908 958 1247 900 1845 1428 1356 1143 1403 1487 1902 829 1428 1157 1345 816
- 1357 466 1629 1013 1656 937 1709 1502 1463 983 1755 1308 1411 1762 1508 1702
- 1697 591 1790 1521 1393 100 { m20} R 1367 1466 1555 1999 446 1602 864 1365 1336
- 1262 1284 1535 1158 1867 1609 1544 1094 987 886 1692 1184 1559 1045 1952 450
- 1692 1331 1862 503 1518 1084 1489 1065 1188 1289 1522 757 1265 1511 1649 1346
- 1256 744 1644 1829 1489 1178 1391 1757 1385 978 1044 516 1743 1416 1640 1430
- 1568 1156 1382 534 1988 450 1611 778 1978 487 1637 1242 1566 1220 1380 1033
- 1556 1277 1783 1826 1328 1755 2015 551 1295 1385 1777 1472 1286 528 1225 782
- 1535 1501 1355 1536 1559 707 1135 538 1237 1361 1332 810 1575 813 1675 735 1895
- 940 1400 1167 1417 1522 1610 1026 1455 1018 1746 1611 1808 1332 1308 557 1630
- 1330 2038 808 1085 1761 1761 1733 1628 558 1841 1339 1588 674 1521 1335 1558
- 1518 1623 636 1403 497 1461 1488 1437 1277 1576 1337 1474 723 1908 1329 1685
- 1243 2021 1080 1480 1240 1500 1607 1489 1188 1682 1172 1904 1812 1344 1554 1406
- 372 1636 1154 1514 1066 1115 1599 1879 1666 1537 1230 1559 1178 1116 764 1665
- 1187 1625 533 1693 656 1436 468 1454 1294 1492 1286 1663 780 1329 100 { m20} R
- 860 1248 1802 1503 507 1605 1583 1933 1513 1877 1157 1711 1527 1875 982 1797
- 1580 1470 1804 1495 1396 1375 918 1612 1727 1707 386 1699 600 1656 1385 1345
- 452 2148 695 1436 677 1804 904 1448 1294 1437 1122 1485 442 1544 1031 1277 1535
- 1664 917 1578 887 1649 799 1254 1600 2092 806 1617 1735 1902 1331 1743 1075
- 1743 1315 1685 850 1370 952 1429 1303 1957 1645 1725 1679 1359 1313 1187 703
- 1315 764 1481 1289 1392 477 1457 1200 1279 1841 1884 1494 1228 1180 1429 1236
- 1026 1029 1711 500 1741 731 1439 1679 1740 1149 1678 421 1736 581 1529 884 1531
- 417 1391 722 1758 763 1330 1538 1427 1132 1715 1438 1658 424 1378 1254 1558
- 1067 1931 1684 1728 750 1210 854 1532 739 1507 385 1610 1236 1681 542 1291 1597
- 2094 649 1698 885 1499 1567 1886 564 1340 1693 1723 667 1540 1139 1578 1555
- 1586 1590 1707 1636 1628 859 1943 1742 2053 837 1423 1066 1296 882 1961 1591
- 1734 1319 1643 1005 1740 544 1488 799 1546 806 1501 689 1743 1443 1737 670 1363
- 808 1872 1826 1663 100 { m20} R 847 1540 1542 1188 982 1750 1276 1817 511 1972
- 730 1401 1171 1664 1217 1977 400 1187 1637 1570 1067 1730 1177 1670 1761 1595
- 1827 1411 1300 1641 1076 1459 650 1484 619 1238 1372 1372 1334 1560 981 1610
- 1847 1633 1782 1716 980 1420 1210 1713 541 1496 1361 2018 1684 1612 813 1400
- 597 2072 1034 1716 621 1382 997 1692 1479 1493 1580 1708 443 1524 1392 1605
- 1748 1697 1045 1616 378 1516 1053 1551 1294 1737 1433 1377 911 862 958 1819 476
- 1736 1478 1877 1508 1905 722 1527 1236 2084 1195 1385 619 1563 632 1704 1774
- 1511 611 1480 473 1274 1490 1691 693 1515 1841 1231 1414 1665 1050 1491 1753
- 1130 1576 1580 1587 1228 549 1771 779 1667 1187 1641 794 1620 1023 2030 1167
- 1634 642 1139 456 1957 1034 1582 1548 1834 516 1891 929 1374 501 1515 1512 1360
- 1093 1549 835 1305 1198 1990 434 1431 1552 1470 1379 1439 1552 1612 1061 1623
- 1248 1504 1449 1719 838 1820 1365 1732 583 1750 1791 1615 689 1393 1627 1669
- 992 1648 1404 1608 1683 1169 1329 1420 450 1851 567 1686 100 { m20} R 383 1580
- 1350 1747 689 1053 585 1615 1251 1358 1287 1753 1460 1553 638 1551 619 1570
- 1255 1784 794 1670 966 1972 1118 1489 916 1677 387 1745 1059 1440 1515 1619
- 1186 1460 1576 1738 785 1553 889 1662 1696 1652 490 1192 997 1162 419 1953 1102
- 1711 574 1441 572 1631 1742 1575 1096 1778 704 1667 1819 1657 1557 1618 933
- 1623 1064 1727 1326 1641 1299 2021 1649 1603 1573 1378 1295 1189 1416 1788 1125
- 1850 872 1319 1137 1563 915 1762 385 1686 459 1722 1704 2001 1126 1342 785 1448
- 723 1932 1299 1695 1464 1562 411 1479 1003 1669 1645 1212 809 1827 436 1394
- 1518 1496 1626 1699 1685 1469 1140 1949 598 1921 693 1786 1284 1831 518 1355
- 975 1731 1043 1707 796 1295 1206 1036 1057 1846 479 1614 1549 1501 1077 1449
- 782 1608 463 1667 741 1015 1067 1724 591 1658 1087 1499 623 1350 769 1611 1686
- 1518 1807 1592 1503 1503 1385 1562 1548 1447 1390 1141 626 1800 1450 1276 1054
- 1739 644 1749 416 1310 786 1543 1415 1946 1091 1438 1572 1611 708 1291 1244
- 1708 1314 1680 100 { m20} R 1589 1143 978 1598 1353 1370 523 1572 813 1925 1096
- 1644 960 1439 1555 1373 1339 1736 1828 1297 419 1521 1678 1512 788 1745 625
- 1629 1607 1594 1037 1384 1230 1901 1246 1531 888 1655 824 1659 923 1514 1850
- 1489 1619 1840 939 1381 891 1655 948 1695 1068 1511 600 1587 1089 1741 592 1196
- 555 1256 1378 1505 1175 2015 743 1647 1238 1373 495 1626 1471 1609 1134 1631
- 1754 1701 1133 1841 764 1435 1777 1226 1610 1567 1142 1791 1290 1511 1506 1651
- 1588 1916 1306 1396 1852 1410 1249 1785 532 1619 1233 1726 819 1965 1695 1745
- 1212 1144 780 1860 604 1295 1537 1319 1234 1482 1304 1700 643 1730 415 1705
- 1227 1479 1605 1308 1820 1675 724 1404 1808 1312 652 1695 1636 1411 1686 1675
- 1689 1472 971 1403 1048 1419 1287 1744 1832 1197 670 1380 1652 1502 512 1392
- 1196 1119 870 1399 559 1558 1185 1986 1091 1692 1850 1721 533 1747 502 1297
- 1236 1703 1819 1552 1282 1436 1088 1601 1690 1659 1744 1657 1300 1673 1750 1399
- 1535 1644 458 1477 522 1512 510 1684 1797 1431 832 1309 100 { m20} R 728 1677
- 1326 1775 1734 1338 1395 1670 1837 1808 1167 1722 1489 1215 769 1679 1132 1729
- 639 1530 644 1489 858 1412 839 1507 1267 1700 1203 1370 1790 1561 559 1708 579
- 1319 1448 1544 434 1684 1461 1677 844 1175 372 1781 418 1838 1776 1535 1466
- 1523 525 1747 483 1408 592 1878 380 1871 1780 1236 935 1247 1445 1611 824 1629
- 1493 1827 1773 1721 994 1707 728 1682 1743 1469 1541 1655 1232 1639 1556 1619
- 1008 1639 870 1607 1793 1633 869 1593 1266 1353 1489 1522 681 1601 995 1454 541
- 1935 1261 1538 866 1363 700 1761 1379 1250 1192 1803 1791 1185 989 1430 1224
- 1619 1844 1794 1121 1566 1346 1795 1689 1700 1269 1883 1564 1738 1244 1897 1404
- 1840 1339 1302 1448 1398 1412 1727 461 1886 804 1440 1189 1578 1599 1407 1739
- 1728 1758 1317 1280 1910 787 1654 848 1110 1400 1553 1054 1799 734 1675 1621
- 1543 1790 1745 1016 1852 1071 1599 558 1592 599 1129 1751 2079 475 1885 1162
- 1497 456 1569 655 1439 1675 1520 1271 1188 542 1348 1526 1675 1216 1640 1299
- 1540 1087 1663 100 { m20} R 1302 1908 425 1702 1689 1348 1147 1410 546 1460
- 1340 900 661 1924 1515 1803 1781 1771 882 1324 900 1506 1690 1520 1653 1672
- 1389 1644 1081 1710 626 1683 1320 1255 1066 1791 1247 1412 760 1294 969 1907
- 848 1323 548 1364 1819 1732 982 1748 1019 1699 1272 1559 1130 1756 372 1649
- 1536 1727 530 1678 1549 1395 545 1486 1789 1379 823 1293 1480 1203 625 1517 594
- 1375 1637 1412 1303 1691 449 1448 1247 1751 1134 1369 668 1504 820 1481 1245
- 1605 1642 1510 530 1857 1779 1663 1116 1321 1677 1636 1238 1497 1108 1566 1139
- 1522 719 1743 914 1378 1413 1594 1022 1616 1642 1543 1615 1453 1535 1781 1518
- 1539 390 1822 1644 1478 1415 1673 1089 1099 1085 1370 495 1565 1228 1366 1441
- 1816 1010 1523 1636 1715 1143 1671 1702 1947 716 2018 1624 1687 1064 1815 767
- 1676 1373 1026 1041 1501 1180 1503 415 1877 683 2365 1689 1295 758 1534 723
- 2010 986 1268 1512 1508 599 1648 1682 1359 461 1626 1048 1549 1053 1330 1195
- 1624 681 1470 821 1315 1640 1624 988 1544 1253 1602 910 1890 100 { m20} R 690
- 1821 1727 1628 976 1196 1290 1690 1756 1509 388 1532 1541 1278 622 1632 626
- 1436 956 1546 957 1527 687 1157 412 1268 1781 1798 1735 1341 1228 1623 1157
- 1678 1290 1651 565 1491 1546 1702 680 1678 1601 1675 1738 1547 851 1378 455
- 1486 1211 1664 1542 1393 790 1757 603 1352 430 1303 1359 1718 441 1719 1523
- 1686 504 1660 1731 1449 1179 1014 567 1474 1053 1146 1480 1239 474 1591 1195
- 1555 1249 1912 1753 1644 650 1372 1269 1496 959 1371 1208 1816 1183 1748 1571
- 1367 401 1432 392 2008 1599 1683 1196 1546 1392 1726 1710 1298 663 1780 594
- 1452 1139 1717 914 1648 1656 1786 1352 2111 1274 1349 389 1655 1340 1705 1640
- 1742 1360 1293 1292 1517 595 1614 1594 1422 1649 1219 583 1945 1238 1428 1380
- 1855 668 1439 1357 1327 1704 1697 1490 1447 1129 1259 1640 1797 1606 1267 1365
- 1894 1059 1303 1126 1716 1675 1752 1259 1692 614 1430 1789 1854 718 1321 879
- 1409 1418 1664 1702 1367 607 1519 1810 1477 475 1307 1568 1454 725 1419 1540
- 1494 1019 1826 755 1766 1374 1544 100 { m20} R 441 1273 525 1763 1701 1489 585
- 1803 406 1379 1476 1451 708 1809 1130 1583 1588 1594 1478 1610 1814 1142 1165
- 1594 626 1646 1013 1546 1042 1513 1828 1886 373 1303 818 1251 1499 1844 1127
- 1888 1687 1449 761 1489 1238 1674 1306 2203 1110 1578 1170 1514 775 1432 965
- 1744 1513 1551 1010 1934 934 1402 1458 1686 1751 1640 1703 1167 1838 1602 1817
- 1400 914 1401 1257 1927 1277 1347 690 1811 501 1691 601 1855 1466 1823 1166
- 1158 1555 1594 1048 1772 482 1772 1444 1704 1592 1748 636 1679 1755 1287 1770
- 1439 1807 1810 1624 1308 822 1695 635 1640 1048 1790 429 1993 1789 1311 857
- 1433 1477 1215 1655 1865 1478 1166 831 1773 852 1503 708 1364 1626 1645 625
- 1758 1221 1369 846 1224 471 1636 1236 1805 1554 1774 651 1627 592 1791 1109
- 1428 996 1750 412 1318 1752 1497 903 1546 1464 1478 1436 1509 1467 1276 571
- 1918 530 1545 769 1582 518 1706 975 1720 437 1916 1837 1662 1333 1617 927 1598
- 1202 1478 1342 1938 1726 1492 1308 1511 1449 1124 598 1771 1088 1647 1734 1703
- 100 { m20} R 1515 1508 683 1551 829 1559 971 1265 1311 1623 1116 1927 1530 1368
- 1326 1536 1518 1716 862 1726 752 1361 411 1535 1590 1520 571 2017 1528 1380
- 1269 1646 713 1600 1230 1509 694 1603 1319 1828 877 1390 1767 1781 957 1592
- 1378 1243 1688 1227 1817 1768 1088 1439 894 1471 478 2002 1140 1148 1675 1522
- 956 1825 992 1606 1156 1512 1128 1608 1091 1683 600 1604 757 1636 1189 1230
- 1611 1720 1777 1757 796 1506 737 1756 1202 1736 1031 1555 1121 1272 640 1449
- 1801 1993 1668 1431 477 1605 678 1820 571 1459 982 1411 499 1645 563 1384 830
- 1846 1003 1530 990 1577 1169 1512 1276 1523 1601 1852 406 2033 505 1568 1557
- 1442 1514 1564 1744 1275 1286 1192 1745 1510 1388 1307 1031 1157 878 1355 995
- 1373 988 1747 985 1207 1504 1617 963 1648 1439 1692 1814 1910 1495 1581 1063
- 1639 424 1812 1469 1135 1186 1594 437 1387 541 1541 1838 1174 997 1403 1038
- 1649 1643 1346 645 1794 1478 2166 994 1934 1777 1735 629 1514 1257 1350 498
- 1834 728 1691 1195 1706 1025 1515 923 1430 100 { m20} R 633 1334 1371 1409 1839
- 1130 925 1691 465 1532 384 2105 1812 1808 508 1455 448 1724 488 1470 1376 1373
- 1101 1332 608 1623 1385 1276 906 1445 1234 1371 545 1451 532 1307 1610 1521 552
- 1662 504 1764 1665 1616 1331 1295 1732 1329 557 1543 1287 1696 972 1654 1572
- 1300 597 1206 932 1686 483 1781 1451 1280 1115 1781 397 1058 585 1303 701 1587
- 1474 1378 574 1636 951 1960 1719 1489 758 1407 1435 1765 522 1567 1017 1581
- 1543 1502 1764 1591 1300 1444 1736 1524 1294 1813 1175 1743 961 1440 1761 1599
- 741 1658 828 1643 1272 2077 1784 1996 1722 1413 902 1851 907 1485 1369 1150 949
- 1817 613 1609 509 2069 1648 1751 1451 1646 842 1321 1077 1543 758 1761 1647
- 1396 1774 1569 1684 1415 428 1468 1544 1553 714 1699 852 1419 1111 1717 884
- 1695 764 1112 1114 1257 830 1332 814 1882 1181 1585 1390 1557 950 1975 1803
- 1441 1786 1478 1792 1585 1152 1605 587 1498 876 1803 712 1696 676 1513 1028
- 1284 1372 1073 455 1777 1500 1954 1614 1813 1140 2126 1500 1396 1167 1594 100 {
- m20} R 1048 1498 1550 1585 478 1625 1688 1717 1110 1713 555 1556 1699 2012 1708
- 1458 1184 1437 907 1403 594 1087 1724 1446 1727 1562 810 1561 417 1229 639 1682
- 973 1779 942 1618 1560 1744 1230 1372 700 1442 1744 1446 1839 1664 547 2087 879
- 1620 1192 1631 1594 1615 1384 1321 973 1189 1106 2055 852 1744 581 1311 862
- 1663 1401 1591 1342 1554 1836 1710 1144 1548 1721 1632 715 1527 1850 1400 372
- 1417 425 1794 1328 1727 1669 1568 651 1717 977 1822 840 1986 484 1738 1244 1740
- 852 1863 376 1731 1297 1547 1396 1547 1465 1944 1687 1695 1576 1824 1843 1490
- 943 1738 611 1381 1492 1374 1459 1538 1685 1657 876 1435 766 1409 1370 2069
- 1214 1227 651 1188 1824 1720 1460 2130 1247 1448 690 1563 1559 1327 960 1336
- 1569 1471 981 1282 532 2002 870 1852 1431 1521 1731 1019 1567 1175 1065 1685
- 1483 1354 1624 1159 1454 1773 1397 1644 946 1500 1420 1160 1187 1538 967 1254
- 1066 1652 586 1746 1218 1824 1775 1446 1012 1424 1124 1745 1203 1573 1437 1303
- 1601 1436 1505 945 689 1785 100 { m20} R 794 1601 745 1752 792 1411 1003 2133
- 1694 1877 1044 1751 1443 1453 810 1296 1606 1603 1538 1540 717 2065 1107 1317
- 789 1361 1217 1354 1665 1820 893 1660 1428 1883 1237 1487 1557 1458 1531 1682
- 815 1765 1507 1633 1667 1148 725 1656 1172 1443 840 1799 1231 1795 763 1531
- 1732 1785 1520 1670 557 1419 1026 1558 1420 1201 825 1982 1122 1385 1756 1998
- 522 1773 1845 1650 1485 1604 1301 1775 1669 1369 1437 1436 869 1463 564 1318
- 1369 1864 904 1427 966 1762 1118 1579 652 1436 548 1137 869 1822 582 1496 1342
- 1801 1189 1662 1831 1800 984 1650 1685 1372 392 1637 756 1357 1303 1619 568
- 1707 806 1387 1409 1682 517 1478 557 1659 1631 1198 589 1431 505 1290 750 1282
- 1300 1635 1356 1714 1484 1380 459 1861 1353 1311 728 1599 1187 1866 491 1901
- 1353 1699 682 1483 1544 1428 1011 1796 708 1927 822 1298 1251 1535 1245 1484
- 737 1114 1046 1485 1564 1670 672 1339 573 1582 1792 1495 553 1273 889 1955 949
- 1845 480 1701 1405 1703 415 1724 1343 1583 697 1694 1161 1502 100 { m20} R 1845
- 1424 505 1560 777 1339 1037 1178 1490 1241 1283 1467 788 1298 1113 1696 1703
- 1701 917 1631 1709 1797 1523 1408 942 1993 1608 1644 1476 1331 732 1579 633
- 1225 1779 1512 703 1796 1325 1382 1062 1820 1541 1228 1738 1711 1746 1691 975
- 1789 420 1746 925 1761 1568 2154 588 1511 804 1622 1154 1909 1635 1345 827 1638
- 1829 1678 1462 1243 1174 1857 1404 1625 1800 1413 521 1840 652 1605 1715 1679
- 1329 1088 1043 1807 678 1660 1437 1061 631 1238 1447 1637 830 1468 1331 1531
- 604 1686 514 1708 1317 1301 1551 1559 1745 1638 685 1373 679 1750 747 1487 1566
- 1619 503 1332 579 1426 1671 1980 1664 1863 1402 1415 489 1562 548 1634 1134
- 1833 1564 1697 1113 1205 784 1839 790 893 1496 1686 1709 1730 1061 1407 1783
- 1705 989 1449 1222 1455 1491 1760 813 1597 1183 1577 1493 1771 1084 1680 628
- 1331 1059 1605 1687 1270 1538 1737 690 1656 454 1870 1376 1641 685 1978 1690
- 1611 1570 1829 701 1704 1602 1456 1754 1692 1384 1558 491 1773 395 1664 660
- 1726 562 1449 818 1700 100 { m20} R 444 1317 1677 1594 1035 1501 583 1645 1838
- 1563 1257 1211 856 1472 1166 1269 1440 1553 1764 1103 1410 1927 494 1162 1698
- 1259 1429 1427 839 1533 789 1258 821 1269 1698 1793 460 1708 1772 1545 1520
- 1660 1626 1572 958 1937 640 1646 1746 1397 1766 1569 811 1601 921 1606 1293
- 1662 1822 1589 531 1812 1832 1748 1744 1813 1276 1761 851 1670 1566 1065 641
- 1739 945 1830 1502 1540 1376 1720 1610 1504 802 1990 440 1919 1516 1836 710
- 1682 668 1499 451 1446 1647 1824 702 1697 599 1681 1535 1455 587 2029 984 1318
- 1460 1657 477 1262 539 1503 1257 1417 1745 1615 636 1466 1605 1631 543 1468 874
- 1486 1547 1413 1042 1244 1274 1798 996 1056 1784 1433 1695 1591 1175 1677 1589
- 1866 1247 1333 554 1398 1459 1534 559 1492 1477 1135 1718 1424 1437 1899 736
- 1958 1276 1691 1347 2002 1336 1667 1105 1332 646 1621 901 1921 1712 1782 412
- 1224 1770 1885 1196 1543 1184 1118 1487 1440 1547 1759 1617 1687 952 1697 1534
- 1686 882 1405 1809 1464 1407 1348 635 1428 1660 1411 756 1504 100 { m20} R 1324
- 1702 919 1577 1683 1546 1104 1571 1432 1604 1598 1575 1003 1111 1029 1168 634
- 1640 1607 1508 910 1488 1128 1518 481 1657 1289 1961 975 1716 824 1682 1384
- 1682 1643 1358 1034 1357 1208 1361 1295 1840 1117 1872 1699 1522 824 1247 923
- 1243 851 1445 1156 1554 1724 1494 419 1722 700 1559 1474 1526 1699 1819 1377
- 1453 819 1132 408 1441 1431 1537 862 1707 1519 1670 490 1342 1307 1924 448 1523
- 1383 1192 897 1642 877 1555 1836 1629 817 1936 1053 1365 1629 1374 1425 1509
- 478 1031 688 1367 1664 1847 722 1445 1124 1048 1845 1936 551 1831 1783 1434 908
- 1304 1535 1452 689 1427 1426 1414 656 1772 1365 1642 733 2059 1525 1606 1254
- 1518 1059 1407 621 1757 1551 1328 1292 1551 680 1233 548 1539 950 1362 830 1717
- 828 1692 987 1603 1071 1375 1520 1426 727 1704 1485 1680 907 1316 1267 1544
- 1666 1637 1346 1584 1701 1467 1105 1287 807 1737 1149 1240 524 1272 1189 1568
- 846 1288 451 1444 897 1577 1267 1403 465 2051 452 1517 1250 1227 967 1311 1378
- 1186 1402 1636 100 { m20} R 1467 1502 1778 1661 1404 1332 667 1388 665 1560 785
- 1200 1778 1744 480 1763 701 1567 559 1272 999 1502 730 1514 1602 1397 1364 1501
- 774 1480 980 1680 825 1510 917 1432 1313 1486 1653 1171 1268 1534 473 1641 1517
- 1507 750 1211 431 1692 1367 1514 1362 1120 770 1113 1334 1439 1237 1727 1543
- 1550 1773 1298 1536 1893 1556 1354 1761 1840 1442 1397 1390 1584 592 1762 555
- 1631 1004 2027 1177 1498 641 1661 1445 1563 1642 1354 1205 1498 763 1622 1293
- 1485 949 1483 1173 1571 546 1543 1729 1331 794 1987 1765 1737 1622 1765 1735
- 1365 1724 1607 1061 1494 1692 1640 650 1672 1034 1412 1820 1622 1580 1541 911
- 1871 1225 1567 1059 1579 1234 1483 1382 1744 621 1339 1734 1317 1262 1628 698
- 1414 1170 1441 1554 1747 969 2152 386 1413 470 1614 666 1668 1102 1414 485 1525
- 641 1392 1593 2060 905 1715 1123 1831 1572 1751 1583 1532 712 1162 1756 1263
- 1469 1654 1577 1379 1675 1868 396 1643 701 1466 1111 1471 1487 1615 1677 1580
- 1544 1498 1787 1750 1659 1560 572 1667 935 1500 100 { m20} R 889 2148 770 1872
- 949 1438 1212 1367 1573 1541 806 2161 1531 1375 651 1392 1174 1418 679 1024 709
- 1337 1642 1439 918 1290 1852 1472 593 1837 887 1535 1631 1395 1269 1480 1398
- 1530 1326 1556 1589 1497 1795 1392 1252 1462 810 1587 1405 1593 1506 1962 955
- 1520 1465 1456 616 1667 1202 1494 1542 2003 1049 1843 1492 1607 1490 1777 475
- 1513 942 1294 1456 1483 1551 1907 1150 1592 503 1827 430 1864 1052 2271 421
- 1427 704 1410 1567 1346 1156 1290 1624 1885 518 1876 1660 1079 1014 1743 1320
- 1877 389 2057 1202 1112 387 1305 1656 1947 1063 1389 440 1742 1472 1760 1625
- 1638 737 1285 1313 1642 1755 1677 1104 1446 825 1434 479 1966 871 1722 824 1636
- 630 1413 1637 1641 675 1602 983 1335 614 1160 813 1498 778 1762 1363 1431 1378
- 1853 1413 1632 1044 1576 717 1522 1672 1730 959 1598 735 1497 1404 1519 717
- 2122 996 1315 455 1620 918 1797 657 1538 1430 1361 1046 1220 1230 1899 989 1810
- 1531 1287 476 1636 760 1686 897 1250 1277 1934 1661 1357 927 1626 1098 1292 100
- { m20} R 1693 1227 485 1542 1671 1704 529 1736 516 1396 727 2068 1561 1255 603
- 1960 1331 1467 881 1559 1791 1708 1621 1468 1470 1626 486 1469 1440 1970 1759
- 1610 1565 1556 556 1657 979 1607 655 1669 426 1777 1844 1305 1124 1317 1189
- 1215 1809 1664 609 1495 848 1168 1743 1696 631 1430 931 1746 687 1856 813 1320
- 689 1863 1331 1329 1184 1935 1801 1372 1027 1387 980 1429 1557 1661 1370 1656
- 1015 1255 395 1422 1140 1595 578 1466 759 1427 1623 1521 405 1171 1039 1378 407
- 1306 1630 1549 1677 1480 1221 1331 753 1574 1509 1521 1073 1544 1771 1852 1726
- 1372 648 1773 1702 1236 1513 1943 1228 1232 1604 1462 573 2000 1091 1588 1163
- 1543 741 1111 443 1107 1818 1791 554 2093 413 1300 892 1639 1822 1246 1579 1811
- 886 1665 541 1266 1772 1867 751 994 604 1675 1001 1181 1840 1707 1718 1544 861
- 1766 621 1603 385 1773 430 1409 1218 1339 773 1464 378 1486 1731 1433 1099 1544
- 726 1567 757 1543 439 1703 1304 1550 921 2001 881 1307 1194 1515 726 1727 602
- 1466 1405 1187 100 { m20} R 818 1503 1199 1533 414 2108 1538 1703 875 1809 689
- 1497 1817 1525 1019 1703 384 1482 485 1768 935 1423 464 1948 1288 1816 1477
- 1994 1392 1533 1021 1206 739 1344 693 1242 1646 1231 725 1197 1024 1657 1428
- 1826 930 1547 1472 1855 400 1498 754 1318 1673 1486 1149 1893 489 1641 1735
- 1537 1598 1577 1716 970 1277 1407 1183 1406 762 1295 559 1403 1533 1398 463
- 1344 1376 1193 609 1853 1071 1735 839 1518 1309 1494 1253 1589 618 1335 699
- 1582 1159 1556 1563 1562 48 { m20} R 1107 1604 723 1625 724 1539 1224 1495 1112
- 1151 1281 1554 561 1601 1192 1298 1635 1354 1335 1667 1828 1855 1808 1472 469
- 1343 1821 1489 1245 1539 1565 1539 789 1917 1543 1611 745 1781 770 1728 1325
- 1269 1263 1721 1785 2133 829 1821 519 1680 928 1653 1757 1529 798 1879 583 1219
- 1035 1344 1427 1427 862 1629 1810 1417 591 1546 1116 1443 1172 1751 964 1853
- 777 1449 1603 1569 657 1324 1702 1195 1461 1478 815 1704 826 1506 594 1244 1730
- 1542 1537 1599 1841 1330 1531 1410 843 1435 802 1437 1513 1556 711 1440 579
- 1995 1092 1772 992 1666 849 1250 569 1902 840 1238 1397 1547 596 1646 1200 1819
- 1186 1624 1605 1231 396 1727 1530 1546 1228 1639 1519 1406 820 1550 629 1580
- 852 1271 602 1532 1107 1428 1372 1748 1062 1806 713 1494 551 1733 1843 1324 661
- 1257 1451 1799 1082 1893 1409 1560 417 1370 518 1738 1601 1722 421 1737 655
- 1578 1806 1981 615 1498 899 1603 959 1393 1119 1287 1043 1719 1498 1550 1325
- 1761 1197 2009 1851 1762 647 1436 566 1620 972 1383 100 { m20} R 544 1702 1339
- 1935 1354 1449 1749 1731 894 1552 813 1462 622 2098 880 1799 1633 1560 617 1695
- 1121 1773 1845 1888 1589 1337 616 1606 613 1528 917 1779 1056 1452 1516 1523
- 1098 1255 950 1472 1128 1481 1370 1171 750 1310 1241 1460 832 1347 681 1383
- 1816 1739 473 1690 1746 1477 1247 1268 588 1412 1501 1714 714 1623 733 1127 472
- 1551 1331 1368 1576 1409 699 1871 1823 1782 1818 1890 649 1129 1168 1444 608
- 1616 1579 1989 1170 1217 427 1973 409 1546 1354 1412 1419 1587 663 1650 476
- 1339 1847 1695 1133 1322 1083 1303 894 1900 684 2114 1183 1834 1340 1445 1280
- 1387 1350 964 909 1626 1761 1703 1396 1405 1766 1602 1222 1708 948 1229 1292
- 1687 1711 1681 1157 1522 611 2067 1083 1873 1085 1806 815 1375 1573 1558 452
- 1759 945 1614 908 1467 1834 1526 1321 1691 1063 1705 547 1819 870 973 1310 1511
- 821 1609 1332 1707 785 1695 1846 1385 406 1552 1569 1385 851 1253 1179 1729
- 1566 1616 479 1714 1081 1801 890 1642 1432 1470 1120 1901 425 1614 660 1420 708
- 1666 100 { m20} R 414 1628 1773 1626 666 1529 1105 1273 1825 1344 725 2165 1282
- 1241 1086 2112 1505 1520 1259 1584 1370 1487 1383 1942 1443 1627 943 1655 564
- 1311 792 1074 1716 1797 1820 1951 1644 1241 715 1443 417 1755 1221 1620 527
- 1416 587 1713 1821 1576 1765 1534 1607 1668 813 1671 435 1864 1277 1167 546
- 1839 1431 1644 1352 1415 1411 1668 1623 1719 1370 1811 980 1357 1241 1290 1434
- 1022 1315 1541 698 1667 1500 1750 1588 1789 1491 1376 515 1458 818 1817 1836
- 1457 388 1272 1330 1781 1275 2005 459 1479 1141 1371 1290 1594 1528 1907 1158
- 1883 1120 1833 1641 1723 1493 1498 770 1377 1028 1625 1728 1515 1661 1492 499
- 1355 864 1992 1059 1449 1485 1419 872 1555 975 1610 1664 1538 1251 1833 1839
- 1449 1303 1921 1087 1821 910 1824 551 1848 948 1204 1151 1836 1162 1436 1591
- 1565 706 1628 1218 1850 393 1171 777 1476 632 1921 1610 2049 1849 1522 552 1679
- 1043 1449 840 1766 1652 1572 1347 1756 975 1621 1789 1929 567 1378 1561 1669
- 910 1690 959 1417 1390 1862 590 1306 1851 1613 100 { m20} R 1746 1484 1023 1465
- 1808 1780 1465 1307 939 1717 1579 1781 1401 1398 912 1411 1481 1497 938 1470
- 579 1590 828 1874 910 1594 1768 1826 984 1496 1783 1657 1675 1727 1646 1647
- 1144 1297 1693 1695 1179 1151 1208 1889 404 1518 738 1041 846 1260 945 1377
- 1653 1471 1154 1360 1095 1451 584 2003 1002 1401 1581 1705 1184 1526 1433 1204
- 1287 1543 806 1579 1332 1630 1676 1603 972 1285 1781 1607 1526 1225 1094 1350
- 1150 1442 610 1730 1057 1371 540 1936 887 1967 585 1739 660 1468 735 1441 1262
- 1623 641 1617 852 2209 1792 1860 1421 1629 1811 1477 426 1937 1541 1634 939
- 1853 753 1685 927 1658 1499 1550 1028 1671 1748 1221 1417 1792 966 1783 1422
- 1738 375 1267 726 1635 861 2071 1782 1332 993 1408 838 1164 1769 1472 1587 1426
- 1114 1282 1092 1429 1426 1551 633 1228 948 1547 1071 1819 649 1804 1063 1552
- 823 1695 1577 1722 1023 1514 944 1729 429 1381 961 1981 400 1394 1617 1680 1306
- 1645 1443 1615 1611 1335 1599 1695 1406 1561 1727 1754 869 1596 1228 1872 1214
- 1435 100 { m20} R 1420 1386 1717 1414 1678 1425 595 1701 704 1602 1174 1387
- 1546 1316 469 1194 1542 1676 1588 1703 1197 1710 1395 1279 1644 1645 1175 1609
- 484 1438 1203 1741 1266 1932 1493 1785 684 1772 1413 1378 1365 1590 424 1751
- 1400 1574 1064 1919 463 1849 626 1688 526 1604 1640 2007 729 1799 1422 1551
- 1452 1494 511 1261 476 1775 537 1132 423 1608 1620 1668 1285 1015 1334 1668
- 1539 1361 701 1846 1381 1420 823 1265 1231 1240 621 1331 1675 1444 1724 1505
- 1803 1724 812 1399 1176 1389 588 1540 1356 1127 1414 1789 1334 1416 1409 1415
- 677 1393 503 1879 1107 1287 1272 1670 411 1543 1187 1646 752 1724 434 1489 1573
- 1794 1501 1568 1421 1552 815 1899 1716 1393 835 1806 1846 1356 682 1462 1665
- 1689 1107 1854 1518 1528 1298 1776 1400 1450 409 1318 1206 1354 850 1518 1256
- 1396 635 1692 1599 1688 407 1803 1221 1555 1574 1253 1163 1427 1528 1939 405
- 1673 713 1520 1595 1572 1490 1150 704 1369 1645 1844 1051 1482 638 1514 1040
- 1486 838 1385 1529 1599 1258 1538 1034 2086 969 1820 100 { m20} R 1840 1716 924
- 1725 1804 1885 1112 1081 1826 1460 528 1332 645 1090 725 1878 779 1637 590 1328
- 1570 1842 1087 1609 1659 1606 1484 1589 1561 1202 1429 2007 1330 1697 1609 1742
- 1829 1002 1286 1664 1183 1360 978 1745 1318 1685 797 1698 1324 1743 1533 1564
- 1054 1184 1565 1341 1350 1280 583 1733 1514 1443 1080 1624 638 1680 752 1704
- 1056 1395 1529 1247 1362 1597 564 1559 1411 1782 1077 1672 1490 1646 1550 1464
- 1691 1868 1776 1963 992 1561 1790 1606 556 1369 1480 1825 1071 1329 1080 1371
- 1374 1132 1416 1752 763 1469 617 1479 763 1311 1444 1820 1464 1586 1603 1663
- 1699 1179 582 1655 1687 1554 553 1482 828 1107 404 1658 1085 1935 876 1535 1600
- 1449 480 1472 1008 1334 1542 1203 871 1551 1460 1613 1656 1701 1331 1396 1503
- 1675 1312 2075 1081 1261 1769 1575 1500 1615 1842 2160 1166 1747 1136 1341 702
- 1588 477 1693 1822 1352 1438 1871 1398 1221 941 1992 1240 1347 1282 1304 1090
- 1054 1728 1615 586 1728 590 1514 1665 1270 1606 1196 1315 1913 1820 1867 1430
- 1583 1058 2088 100 { m20} R 413 1589 1064 1472 1497 1484 662 1622 1193 1445
- 1480 1203 1524 1553 875 1495 1064 1449 1312 1179 533 1206 652 1622 1288 1466
- 1071 1423 1568 1558 1819 1755 1538 1534 903 1412 1783 1353 689 1597 666 1711
- 1485 1289 1731 1570 388 1664 1485 1621 1007 1441 605 1680 843 1539 780 1793
- 1180 1393 410 1453 1797 1827 1806 1509 1653 1552 1686 1490 1580 1722 1107 1349
- 1482 1703 1291 1967 424 1441 610 1279 1284 1316 565 1779 417 1209 1539 1224
- 1830 970 1030 1293 1230 1828 1059 1587 595 1459 601 1662 778 1922 1777 1502
- 1395 1592 1114 1513 1123 1632 631 1387 788 1432 604 1638 939 1184 454 1763 1443
- 1615 1115 1703 1842 1504 697 2044 1810 1869 1297 1627 550 1893 1825 1571 1278
- 1933 1616 1490 1630 1504 1715 1565 1437 1633 1748 1908 786 1540 1526 1475 1236
- 1351 1083 1222 835 964 1029 1857 844 1638 1017 1829 1250 1674 720 1734 708 1461
- 1373 1701 900 1357 469 1633 1012 1512 390 1455 991 1224 955 1644 955 1740 778
- 1226 789 1296 1233 1491 1067 1974 585 1430 1475 1577 100 { m20} R 1079 1298
- 1193 1538 1081 1224 482 1843 1262 1446 1392 1258 1849 1776 741 1403 663 1586
- 891 1195 871 1692 1740 1843 1406 1606 828 1661 1411 1427 1844 1487 517 1685
- 1141 1530 1698 1498 898 1675 827 1629 1349 1381 1542 1351 1683 1826 774 1538
- 1381 1262 1734 1487 1361 1398 658 1688 509 1731 691 1463 631 1746 994 1892 1505
- 1617 859 1295 1441 1310 1760 1585 972 1817 1316 1747 549 1407 449 1620 1784
- 1754 1846 1762 1361 1290 375 1584 439 1542 1373 1867 954 975 806 1674 534 1517
- 917 1614 1697 1355 1246 1605 716 1636 1369 1358 372 1609 1302 1747 1276 1561
- 1099 1233 835 1619 1393 1729 983 1346 510 1321 705 1714 1403 1628 906 1591 799
- 1395 516 1295 1008 1452 641 1196 470 2158 1279 1621 570 1591 1201 1956 1419
- 1498 621 1500 525 1458 1694 1116 1474 1452 484 1882 844 1866 1041 1259 621 1398
- 374 1731 373 1358 1381 1292 509 1338 396 1441 1601 1479 1708 1402 443 1602 1602
- 1464 1109 1669 1222 1588 1037 1415 1460 1626 881 1571 519 1639 875 1391 1746
- 1718 100 { m20} R 1403 1364 1292 1375 1385 1672 1119 1432 1419 1308 568 1807
- 1052 1559 1017 1756 783 1217 1531 1291 522 1556 1019 1556 1715 1558 1023 1553
- 671 1311 609 1507 573 1609 928 1597 780 1340 1262 1344 1452 1048 952 1683 627
- 1394 1584 1813 1536 1523 1069 1745 1641 1424 1826 1256 1784 1707 894 1157 1318
- 1768 1119 1183 1145 1941 1176 1221 414 1748 1104 1156 442 1693 1265 1919 1361
- 1382 1173 1742 1534 1446 458 1931 1413 1019 1408 1417 1060 1375 1018 1226 1177
- 1452 996 1927 710 1451 993 1915 1441 1843 1573 1607 1553 1098 1230 1194 1798
- 1409 824 1322 1181 1360 1648 1767 859 1639 860 1583 785 1326 1594 1452 694 1686
- 939 1734 642 1651 1078 1581 1710 1666 1727 1215 829 1805 997 1614 1274 1554
- 1051 1352 1429 1572 1109 1477 1123 1442 528 1300 1821 1509 843 1348 1304 1258
- 808 1884 1560 1657 917 1691 525 2122 617 1449 1627 1519 1571 1617 421 1839 1272
- 1303 864 1596 1748 1477 969 1647 1247 1343 1198 1887 1159 1791 1557 1542 517
- 1536 1178 1776 699 1553 634 1670 1546 1502 100 { m20} R 691 1323 1839 1378 511
- 1453 1202 1431 1453 1641 406 1202 1160 1367 491 1895 1658 1538 386 1447 1583
- 1484 1748 1189 870 1413 749 1369 516 1389 853 1665 1600 1630 1226 1769 1836
- 1612 510 1543 570 1703 1526 1530 788 1459 1273 1700 416 1903 1156 1460 710 1365
- 1005 1281 1008 1464 1806 1726 1503 1554 1491 1423 514 1637 1062 1442 1675 1285
- 783 1224 680 1410 1287 1198 670 1581 1652 1517 830 1387 418 1749 1580 1571 487
- 1546 1053 1355 1022 1613 1315 1165 1631 1714 694 1604 1060 1300 1688 1678 903
- 1946 1705 2006 933 1436 1131 1314 1216 1663 630 1871 1707 1183 388 1500 1384
- 1407 1487 1755 1103 1709 781 1370 802 1471 1472 1949 1051 1604 835 1629 991
- 1208 769 1847 1732 1661 1107 1746 552 1861 1111 1215 1183 1660 1055 1748 882
- 1686 601 1142 1508 1482 503 1314 1223 1230 1078 1593 679 1414 683 1802 839 1776
- 674 1900 1030 1552 1468 1479 1169 1403 587 1442 1101 1888 1072 1565 1178 1475
- 1746 1473 1736 1512 1640 1800 1622 1463 1267 1535 505 1179 1446 1813 1324 1969
- 100 { m20} R 662 1734 383 1254 976 1705 410 1415 947 1325 993 1370 927 1408 697
- 1545 1096 1560 1190 1795 1649 1532 475 1316 524 1668 948 1496 1535 1531 1384
- 1830 1198 1380 1496 1250 1831 1391 1417 1655 1731 1301 1710 1483 408 1469 1729
- 1483 431 1653 1171 1226 1379 1533 778 1427 1578 1691 1772 1524 446 1572 1272
- 1344 1514 1562 1703 1421 653 1685 825 1419 919 1222 1498 1258 1814 1548 963
- 1264 903 1594 1661 1456 1762 1618 1416 1364 1495 1453 759 1639 720 1769 968
- 1107 1653 1206 1025 1723 1838 1691 1660 1891 1318 1511 725 1441 443 1386 867
- 2001 810 1378 666 1438 1318 1647 593 1376 1178 1607 954 1353 659 1545 760 1163
- 1818 1639 672 2008 1724 1604 1524 1477 989 1589 1111 1754 881 1709 1693 1686
- 1500 1819 1364 1406 1597 2076 1568 1217 1820 1451 668 1756 949 1188 1029 1516
- 1141 1494 1333 1635 529 2035 1315 1711 1398 2122 521 1613 1690 1995 963 1573
- 718 1715 1506 1720 1407 1438 957 1288 664 1493 1552 1518 1305 1720 1566 1597
- 1274 1497 1111 1505 1581 1722 1617 1715 100 { m20} R 654 1855 1024 1443 1090
- 1642 969 1441 486 1875 671 1315 1036 1498 995 1528 1802 1191 792 1915 663 1042
- 1171 1524 1343 1615 716 1401 733 1804 1618 1218 1794 1358 894 1510 1065 1905
- 1472 1611 679 1730 589 1413 1010 1474 1536 1518 1745 1621 504 1919 1478 1823
- 1574 1768 800 1056 1689 1252 1804 1294 1036 1489 1250 1561 871 1188 978 1927
- 1136 1530 1675 1577 764 1683 1030 1630 607 1895 1806 1509 1118 1710 1288 1471
- 846 1397 417 1398 1581 1653 901 1480 1396 1493 1552 1617 541 1595 1850 1576 425
- 1218 1326 1703 936 1157 698 1875 1537 1651 1841 1294 728 1873 991 2106 372 1737
- 895 1318 730 1825 1424 1449 453 1744 791 1544 1053 1601 1274 1529 592 1399 1492
- 1682 1501 2011 978 1422 1351 1424 1456 1639 525 1299 395 1764 902 1607 466 1653
- 1610 1663 1841 1578 575 1396 686 1279 1165 1492 851 1742 1155 1729 1203 1539
- 808 1370 1341 1821 733 1561 1023 1284 514 1501 857 1632 646 1654 594 1709 1315
- 1840 1011 1624 415 1473 1331 1597 627 1417 944 1649 1558 1605 100 { m20} R 1347
- 1836 494 1935 1189 1430 578 1513 1175 1780 1182 1473 1147 1893 1304 1717 1130
- 1546 381 1736 930 1591 1800 1575 1495 2102 1563 1534 920 1676 1296 1403 1650
- 1716 704 1477 1226 1393 998 1795 1302 1753 515 1691 1141 1400 1661 1393 713
- 1829 1098 1593 536 1789 439 1836 1455 1711 395 1676 1179 2069 490 1760 763 1070
- 1550 1320 785 1657 1155 1946 882 1367 1280 1618 1718 1560 1672 1989 805 1291
- 1466 1332 1223 1151 519 1918 1295 1980 1730 1669 670 1735 1839 1610 1708 1424
- 827 1431 859 1751 1687 1281 477 1195 932 1738 1393 1640 380 1566 1743 1860 1676
- 1335 641 1552 1773 1491 1292 2013 1537 1459 1773 1111 407 1511 1649 1924 603
- 1766 685 1517 1455 1878 1034 1474 554 1600 1002 1857 953 1478 1781 1705 1840
- 1606 627 1642 1341 1313 1015 1292 1417 1495 667 1515 1419 1612 1572 1240 1611
- 1750 1349 1432 1467 1469 553 1755 1478 1790 1443 1277 989 1471 1598 1600 1197
- 1517 653 1720 1219 1577 1545 1636 563 1437 1007 1665 1404 1465 753 2222 1758
- 1508 544 1682 1057 1023 100 { m20} R 827 1365 1548 1759 590 861 1406 1941 778
- 1292 472 1452 418 1595 637 1526 766 1723 1277 1637 1627 1402 1766 1282 518 1443
- 642 1407 1577 1201 1394 1792 1837 1790 425 1854 1793 1789 927 1756 1350 1491
- 592 1200 1488 1640 485 1689 1706 1829 559 1872 1249 1707 1223 1808 656 1595 467
- 1741 775 1606 652 1280 1701 1856 1442 1715 814 1422 1334 1582 1179 1750 1643
- 1524 1237 1864 1329 1384 898 1782 1433 1600 1316 1518 1365 1981 418 1748 1536
- 1793 806 1686 1104 1567 1224 1470 883 1608 1411 1680 1621 1784 440 1823 459
- 1779 850 1876 668 1511 1187 1772 954 1523 1765 1107 696 2437 1540 1210 1245
- 1885 1495 1827 1363 1681 599 1481 1849 1516 470 1322 1027 1498 1767 1673 386
- 1760 640 1245 1337 1519 410 1469 1157 1402 1231 1610 1748 2033 760 1800 1417
- 1859 1558 1349 700 1437 1357 1405 1333 1894 1058 1562 1673 1282 1354 1492 1188
- 1770 731 1554 408 993 1109 1755 635 1466 1691 1386 1457 1224 1136 1576 1039
- 1610 623 1716 1245 1552 388 1917 1762 1137 969 1840 415 1511 100 { m20} R 1244
- 1347 1196 1766 1845 1444 879 1426 843 1408 411 1238 1612 1667 512 1687 738 1523
- 736 1783 1631 1682 1678 1690 1741 1637 804 998 1043 1639 1387 1351 823 1381
- 1153 2004 1282 1273 1408 1513 1600 1050 1802 1368 593 1302 1111 1794 618 1553
- 1222 1807 749 2237 1552 1662 1131 1989 1068 1665 848 1814 1038 1595 1468 1506
- 1077 1603 1797 1586 1213 1291 1592 1353 1024 1595 1792 1485 1428 1800 1738 2007
- 583 1149 1200 1633 1694 1685 743 1445 1649 1741 1554 1572 1622 1533 857 1732
- 1115 1452 1048 1562 1317 1593 1237 1603 496 1563 1771 2058 1424 1657 905 1669
- 1527 1642 1832 1697 1310 2027 1120 1824 546 1281 624 1430 1212 1575 1290 1419
- 1399 1426 804 1413 1479 1027 715 1389 828 1833 730 1621 889 1551 595 1370 1584
- 1424 545 1695 1703 1485 1768 1509 1766 1572 375 1416 648 1807 1847 1482 756
- 1455 1368 1358 1393 2042 881 1522 1585 1805 1297 1678 638 1627 469 1973 382
- 1234 1180 959 1650 1488 993 1365 574 1364 968 1737 1435 1311 958 1598 411 1525
- 394 1360 1805 1419 100 { m20} R 490 1162 778 1898 1404 1525 1832 1439 1032 1815
- 667 1169 1003 1448 1021 1479 675 1777 716 1687 595 1604 1621 1745 695 1357 1422
- 1694 832 1806 1528 1644 774 1716 1146 1598 553 1215 1759 1385 1320 1740 898
- 1739 1485 1645 1407 1266 1299 1477 768 1843 866 1447 1511 1376 1570 1386 1222
- 1446 494 1755 1556 1363 686 1588 584 1824 559 1725 1029 1531 1044 1443 1274
- 1556 991 1436 1788 1104 1098 1472 1219 1608 879 1773 1759 1707 647 1837 1005
- 1898 1311 1622 1161 2067 537 1452 726 1437 1528 1471 531 1429 1690 1281 1027
- 1508 954 1353 1007 1412 1676 1853 1296 1558 942 1227 507 1778 1756 1622 427
- 1290 1150 1568 868 1426 1027 1701 1393 1478 1595 1844 887 1440 1431 1930 690
- 1724 1190 2053 1354 1789 619 1015 837 1444 1662 1764 1037 1641 958 1306 963
- 1515 1084 1355 892 1523 1330 2164 851 1607 427 1327 1246 1397 1332 1821 1230
- 1653 380 1204 579 1453 879 1516 675 1423 839 1512 1754 1389 1262 1512 1108 1423
- 596 1844 1787 1961 1747 1759 1433 1657 941 1578 556 1552 100 { m20} R 649 1623
- 1191 1104 1824 1640 1478 2094 400 1436 1263 1841 1311 1672 1471 1929 1223 1744
- 1019 1571 1019 1645 1088 1881 531 1737 1216 1684 1088 1683 1846 2099 932 1701
- 755 1684 1206 1506 419 1707 1389 1907 1172 1936 1773 1805 1427 1427 1770 1913
- 544 1697 825 1570 828 1534 1482 1711 1672 1419 538 1504 1158 2202 440 1612 1279
- 1372 1697 1825 1002 1297 498 1466 379 1384 802 1631 723 1388 1848 1498 1565
- 1368 816 1264 1195 1199 444 1716 879 1376 1518 1914 951 1495 798 1546 1062 1440
- 1260 1757 1620 1685 1534 1215 1798 1262 1648 1487 1430 1422 1272 1263 815 1306
- 629 1780 404 1901 659 1695 1472 1882 1219 1493 707 1663 738 1450 1837 1578 1186
- 1415 899 1852 844 1675 450 1476 1334 1540 1501 1536 1399 1817 1155 1605 888
- 1604 489 1473 626 1655 683 1825 1713 1479 856 1038 1067 1526 812 1537 748 1424
- 1641 1612 1079 1090 382 1671 1287 1026 1415 1230 510 1710 1523 1933 573 1426
- 1310 1533 744 1682 1297 1595 1445 1648 1663 1631 911 1390 1266 1365 1049 1505
- 1675 1395 100 { m20} R 1249 1633 567 1552 1554 1851 440 1351 463 1349 1695 1890
- 1720 1396 1005 1601 1273 1714 1237 1599 909 1609 1311 1737 1200 1586 971 1675
- 1481 1508 405 1474 1747 1482 1027 1872 1735 1788 1768 1534 1481 1211 592 1752
- 1376 1273 728 1903 1578 1591 1343 1474 659 1280 769 1531 656 1395 1093 1572 760
- 1610 1302 1409 1143 1439 771 1543 1070 1860 1687 1628 910 1514 1317 1776 1460
- 1872 1542 1777 618 1295 1649 1590 1291 1256 1152 1483 980 1550 1481 1891 1526
- 2001 1353 1846 450 1631 1010 1488 818 1802 548 1946 1708 1615 896 1384 885 1330
- 932 1433 493 1662 1290 1548 581 1509 421 1421 1297 1550 569 1598 1540 1666 1800
- 1425 1305 1391 809 1350 605 1728 1076 1607 1289 1401 881 1539 1349 2150 1254
- 1543 406 1707 1220 1476 1132 1339 1073 1648 809 1969 627 1458 882 1230 786 1593
- 1170 1644 840 1876 1529 1701 1394 1605 1325 1827 1245 1827 755 1640 1287 1536
- 1379 1522 430 1707 740 1925 823 1719 807 1906 1734 1711 1503 1500 1527 1665 886
- 1130 1677 1568 1022 1326 919 1864 100 { m20} R 964 1760 1115 1359 501 1964 1721
- 1495 941 1527 412 1545 1801 1708 913 1386 544 1730 803 1621 1104 1324 1801 1781
- 1762 1542 1170 1515 401 1266 564 1585 1482 1393 627 1666 1349 1722 944 1882
- 1819 1511 394 1366 851 1748 1831 1317 1095 1293 499 1441 1439 1513 578 1231 856
- 1820 1792 1659 489 1490 1329 1693 384 1621 1538 1573 1488 1505 829 1761 1252
- 1771 1815 1641 1240 1502 1055 1661 588 1521 662 1748 1122 1566 1703 1582 897
- 1342 642 1977 1047 1482 1245 1584 744 1618 1609 1591 424 1805 1128 1970 540
- 1363 842 1142 390 1717 402 1394 1604 1337 1544 1818 1218 1482 766 1612 1280
- 1577 400 1820 877 1877 1408 1204 1205 1801 390 1113 818 1703 1424 1461 677 1761
- 1490 1462 1309 1342 1294 1855 1528 1173 1081 1768 1830 1641 1046 1279 663 1285
- 1335 1349 1753 1873 1068 1763 591 1322 1808 1980 776 1173 1831 1705 729 1820
- 723 1442 559 1364 693 1395 729 2115 1451 1461 910 1473 938 1512 555 1712 1541
- 1636 437 1884 673 1459 1057 1693 789 1464 599 1860 1413 1167 100 { m20} R 1123
- 1697 1066 1319 1595 1809 863 1666 1579 1741 469 1359 947 1222 963 1479 1156
- 1532 1804 1798 836 1558 964 1068 1505 1915 832 1563 918 1625 1051 1846 1055
- 1821 1384 1727 497 1697 496 1381 1325 1227 1572 1414 1409 1542 1693 1680 1822
- 1549 1535 1540 1655 1295 1466 1547 1503 1389 1598 1689 656 1270 1592 1676 378
- 1473 1316 1806 1164 1759 1849 1811 1463 1016 931 1645 1094 1443 1385 1650 1103
- 1117 683 1687 1244 1156 562 1392 752 1766 1201 1370 664 1384 1775 1664 1817
- 1283 434 1578 1801 1476 702 1435 1810 1631 989 1150 890 1544 991 1488 592 1406
- 741 1502 923 1542 1219 1480 1757 1538 440 1646 1449 1524 851 1556 909 1754 1667
- 1479 1605 1578 431 1339 1175 1568 811 1413 720 1604 879 1323 844 1713 1226 1623
- 1799 1513 1594 1319 1486 1451 1039 1761 1584 1671 767 1815 1766 1692 794 1556
- 1369 1565 1472 1433 1735 1334 1433 1778 1147 1504 635 1965 1775 1697 1798 1852
- 809 1576 521 1357 1142 1412 701 1605 782 1255 1703 1902 823 1523 459 1003 1700
- 1617 773 1987 100 { m20} R 1214 1754 1048 1401 1229 1764 1829 1490 979 1754
- 1210 1947 1024 1495 803 1481 1332 1636 1493 1859 1623 1514 1399 1319 1167 1610
- 1602 1634 1447 1781 693 1871 1833 1397 1177 1753 857 1881 690 1688 1622 1298
- 1019 1339 1178 1250 1052 1464 641 1611 1026 1829 1327 1775 1698 1416 1798 1662
- 1135 1318 807 1350 440 1799 1623 1712 880 1333 1389 1452 932 1560 400 1375 1564
- 1469 948 1290 1232 1956 1180 1603 1468 1832 898 1219 874 1737 1458 1776 1354
- 1642 578 1575 1366 1727 48 { m20} R 753 1357 896 1555 1702 1498 1814 1793 547
- 1392 1833 1770 1043 1749 1525 1970 1345 1632 668 1002 1549 1162 1100 1140 656
- 1455 1396 1591 1278 1697 1433 1581 1065 1443 1438 1682 524 1377 1330 1411 377
- 1267 1843 1895 1260 1869 1161 1264 856 1082 1172 1143 1650 1625 1492 1685 767
- 1564 672 1518 1764 1231 535 1606 1100 1848 1463 1550 1412 1596 1442 1626 1618
- 1448 633 1656 1518 1538 1280 1557 503 1417 670 1963 420 1463 880 1297 873 1566
- 1626 1642 1798 1853 1634 1494 1104 1859 1646 1960 865 1702 1182 1876 603 1451
- 1085 1483 864 1737 1427 1862 1684 1404 384 1642 1598 1808 758 1217 859 1251
- 1011 1341 1533 1549 481 1466 1780 1977 1851 1702 1151 1766 852 1507 1392 1347
- 601 1552 1703 1133 408 1663 764 1760 1625 1388 1829 1675 688 1778 1802 1485 729
- 1486 1626 1741 1498 1594 1631 1479 521 1745 890 1538 894 1439 1301 1977 1820
- 1942 1628 1180 758 1892 1842 1502 1079 1514 707 1233 1086 1203 1046 1880 1514
- 1617 653 1604 1460 1628 1128 1673 834 1579 1303 1787 1643 1474 100 { m20} R 503
- 1870 904 1740 1599 1609 1594 1859 740 1809 1726 1443 1663 1621 465 1850 423
- 1241 857 1570 1677 1172 1535 1636 1499 1440 691 1554 1149 1673 1610 1372 1739
- 1538 1675 1463 1747 1360 609 1209 1575 1235 1818 1190 1363 1237 1307 1474 555
- 1363 690 1567 1688 1887 413 1487 1175 1681 1753 1545 1227 1570 1234 1582 670
- 1335 522 1602 927 1492 1087 1293 1704 1421 1757 1394 1264 1828 556 1959 443
- 1802 1036 1689 1691 1749 1694 1480 679 1693 513 1573 1098 1624 1621 1298 1835
- 1565 1471 1430 1693 1565 972 1452 1201 1567 946 1660 1214 1861 1846 1728 1206
- 1520 694 1449 1526 1731 840 1720 456 1642 1815 1358 753 1447 1483 1292 708 1698
- 1166 1782 522 1824 646 1502 1549 1060 1489 1628 584 1185 1024 1635 1324 1731
- 1171 1471 1647 1708 429 1645 1693 1962 750 1569 998 1485 1815 1634 1659 1572
- 915 1483 1240 1980 1234 1481 1565 2062 437 1417 1646 1560 593 1434 760 1132
- 1604 1551 380 1689 502 1753 1296 1813 767 1727 1196 1449 1516 1081 1187 1476
- 1118 1817 1119 1624 1210 1486 100 { m20} R 429 1222 1538 1410 1419 1278 933
- 1726 586 1657 864 1333 754 1488 1601 1812 708 1231 1336 1094 747 1435 1633 1364
- 1055 1975 407 1374 1672 1496 911 1548 1739 1903 767 1142 1515 1594 965 1611
- 1397 1930 1268 1429 1327 1735 664 1397 1200 1986 1502 1500 707 1605 704 1370
- 689 1692 1490 1667 1752 1292 1241 1953 1076 1607 1060 1489 718 1604 1294 1607
- 1232 1213 1205 1889 681 1580 1790 1692 1630 1766 836 1768 825 1808 1100 1568
- 1613 1722 826 1182 557 1712 984 1046 636 1563 880 1680 584 1528 1769 1374 1456
- 1269 1451 1610 1114 1545 564 1291 1675 1389 404 1815 994 1455 678 1885 708 1743
- 449 1380 1463 1963 499 1818 1537 1611 926 1783 1372 1693 554 1617 1327 1123
- 1389 1609 438 1555 1744 1833 586 992 821 1850 1644 1721 780 1172 1345 1628 528
- 1641 586 1312 658 1432 1814 1775 1041 1534 1561 1405 734 1467 819 1288 1759
- 1747 1150 1261 1576 1739 1159 1551 752 1430 970 1460 1180 1680 669 1411 1341
- 1769 633 1472 1086 1200 1836 1675 1241 1687 1232 1666 1171 2034 100 { m20} R
- 558 1535 1252 1814 1422 1579 1213 1697 812 1915 1077 1334 564 1824 393 2019 604
- 1391 695 1504 606 1286 655 1849 1436 1596 406 1886 1087 1477 599 1904 1421 1651
- 1358 1689 874 1438 1041 1245 942 1486 1036 1692 1774 1856 887 1809 1592 1460
- 1364 1442 1174 1611 576 1568 1594 1500 1376 1457 1082 1247 1318 1255 795 1731
- 1603 1702 1152 1560 1606 1666 904 1615 1212 1777 663 1372 1276 1257 712 1436
- 503 1687 722 1876 447 1690 1654 1109 434 1560 1557 1270 704 1924 644 1653 1799
- 1681 925 1489 1721 1215 1111 1624 405 1338 1679 1628 968 1549 1349 1712 1561
- 1520 417 1539 1686 1051 1192 1354 1767 1551 1219 1889 629 1872 1409 1852 1591
- 1385 1620 1232 924 1210 1609 1845 510 1316 858 1649 1589 1504 484 1111 626 1325
- 1446 1692 545 1652 1225 1659 1555 1749 1521 1770 1514 1389 594 1470 1337 1681
- 558 1304 551 1254 604 1835 1264 1614 894 1596 1741 1499 1535 1480 1808 1583
- 1643 1603 700 1788 1294 1344 806 1497 685 1787 1464 1270 452 1561 1267 1387 392
- 1858 978 1649 100 { m20} R 803 1695 1216 1537 754 1497 1288 2106 1771 1471 1006
- 1516 609 1887 1687 1713 1165 1618 1213 1792 982 1826 580 1609 1373 1217 735
- 1817 404 1367 414 1509 622 1978 838 1450 697 1391 598 1780 1493 1706 804 1314
- 523 1314 1314 1324 1480 1563 911 1601 1405 1348 491 1908 960 1609 1187 1718 776
- 1543 937 2186 1085 1916 1176 1519 1661 1188 1323 1497 1043 1102 1036 1852 633
- 1390 1672 1837 982 1685 1475 1596 1582 1680 1427 1157 1328 1372 558 1746 963
- 1383 1225 1838 1778 1430 629 1602 611 1216 806 1778 976 1683 1821 2265 1543
- 1724 1307 1830 1679 1320 799 1514 1644 1548 980 1671 888 1888 1280 1405 1783
- 1724 1686 1432 1103 1768 1767 1741 1583 1289 756 1333 1838 1188 1417 1530 1697
- 1866 951 1602 1058 1488 1717 2010 937 1595 538 1791 575 1449 1058 1582 516 1401
- 692 1350 1637 1364 410 1758 1758 1497 828 1437 1827 1477 1222 1746 1449 1304
- 1683 1144 1231 1899 1381 1862 1776 1621 606 1685 1512 1513 1205 1828 1215 1716
- 962 1528 986 1509 731 1611 1210 1438 1428 1491 100 { m20} R 1403 1391 1021 1476
- 828 1736 1421 1428 1532 1949 872 2057 1124 1614 608 1581 1118 1600 960 1297 619
- 1671 1069 1890 817 1566 1200 1492 852 1541 455 1426 509 2042 517 1743 1191 1546
- 484 1863 20 { m20} R gr
-showpage
- gr
-%%Trailer
-%%Pages: 1
- gr gr
-%%EOF
diff --git a/src/pawlib/paw/testsuite/paw.commands/nt_pl_2d_2.ref.ps b/src/pawlib/paw/testsuite/paw.commands/nt_pl_2d_2.ref.ps
deleted file mode 100644
index 6c929cb..0000000
--- a/src/pawlib/paw/testsuite/paw.commands/nt_pl_2d_2.ref.ps
+++ /dev/null
@@ -1,3175 +0,0 @@
-%!PS-Adobe-2.0
-%%Title: /disk3/maartenb/cerncvs/paw/testsuite/tmp/nt_pl_2d_ (Portrait A 4)
-%%Pages: (atend)
-%%Creator: HIGZ Version 1.23/06
-%%CreationDate: 96/04/16 14.43
-%%EndComments
-%%BeginProlog
-/s {stroke} def /l {lineto} def /m {moveto} def /t {translate} def
-/sw {stringwidth} def /r {rotate} def /rl {roll} def /R {repeat} def
-/d {rlineto} def /rm {rmoveto} def /gr {grestore} def /f {eofill} def
-/c {setrgbcolor} def /lw {setlinewidth} def /sd {setdash} def
-/cl {closepath} def /sf {scalefont setfont} def /black {0 setgray} def
-/box {m dup 0 exch d exch 0 d 0 exch neg d cl} def
-/NC{systemdict begin initclip end}def/C{NC box clip newpath}def
-/bl {box s} def /bf {box f} def /Y { 0 exch d} def /X { 0 d} def
-/mp {newpath /y exch def /x exch def} def
-/side {[w .77 mul w .23 mul] .385 w mul sd w 0 l currentpoint t -144 r} def
-/mr {mp x y w2 0 360 arc} def /m24 {mr s} def /m20 {mr f} def
-/mb {mp x y w2 add m w2 neg 0 d 0 w neg d w 0 d 0 w d cl} def
-/mt {mp x y w2 add m w2 neg w neg d w 0 d cl} def
-/m21 {mb f} def /m25 {mb s} def /m22 {mt f} def /m26 {mt s} def
-/m23 {mp x y w2 sub m w2 w d w neg 0 d cl f} def
-/m27 {mp x y w2 add m w3 neg w2 neg d w3 w2 neg d w3 w2 d cl s} def
-/m28 {mp x w2 sub y w2 sub w3 add m w3 0 d 0 w3 neg d w3 0 d 0 w3 d w3 0 d
- 0 w3 d w3 neg 0 d 0 w3 d w3 neg 0 d
- 0 w3 neg d w3 neg 0 d cl s } def
-/m29 {mp gsave x w2 sub y w2 add w3 sub m currentpoint t
- 4 {side} repeat cl fill gr} def
-/m30 {mp gsave x w2 sub y w2 add w3 sub m currentpoint t
- 5 {side} repeat s gr} def
-/m31 {mp x y w2 sub m 0 w d x w2 sub y m w 0 d
- x w2 sub y w2 add m w w neg d x w2 sub y w2
- sub m w w d s} def
-/m2 {mp x y w2 sub m 0 w d x w2 sub y m w 0 d s} def
-/m5 {mp x w2 sub y w2 sub m w w d x w2 sub y w2 add m w w neg d s} def
-/DP {/PT exch def gsave 47.2 47.2 scale PT 1 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < AA AA 55 55 AA AA 55 55 AA AA 55 55 AA AA 55 55 AA AA 55 55 AA AA 55 55
-AA AA 55 55 AA AA 55 55 > } image } if PT 2 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < BB BB EE EE BB BB EE EE BB BB EE EE BB BB EE EE BB BB EE EE BB BB EE EE
-BB BB EE EE BB BB EE EE > } image } if PT 3 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < FF FF BB BB FF FF EE EE FF FF BB BB FF FF EE EE FF FF BB BB FF FF EE EE
-FF FF BB BB FF FF EE EE > } image } if PT 4 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < DF DF BF BF 7F 7F FE FE FD FD FB FB F7 F7 EF EF DF DF BF BF 7F 7F FE FE
-FD FD FB FB F7 F7 EF EF > } image } if PT 5 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < 7F 7F BF B F DF DF EF EF F7 F7 FB FB FD FD FE FE 7F 7F BF BF DF DF EF
-EF F7 F7 FB FB FD FD FE FE > } image } if PT 6 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB
-BB BB BB BB BB BB BB BB BB > } image } if PT 7 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < FF FF FF FF FF FF 00 00 FF FF FF FF FF FF 00 00 FF FF FF FF FF FF 00
-00 FF FF FF FF FF FF 00 00 > } image } if PT 8 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < EE EE 47 47 83 83 C5 C5 EE EE 5C 5C 38 38 74 74 EE EE 47 47 83 83 C5
-C5 EE EE 5C 5C 38 38 74 74 > } image } if PT 9 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < EF EF EF EF D7 D7 38 38 FE FE FE FE 7D 7D 83 83 EF EF EF EF D7 D7 38
-38 FE FE FE FE 7D 7D 83 83 > } image } if PT 10 eq { 16 16 1 [ 16 0 0 16 neg
-0 16 ] { < EF EF EF EF EF EF 00 00 FE FE FE FE FE FE 00 00 EF EF EF EF EF EF
-00 00 FE FE FE FE FE FE 00 00 > } image } if PT 11 eq { 16 16 1 [ 16 0 0 16
-neg 0 16 ] { < F7 F7 B6 B6 D5 D5 E3 E3 D5 D5 B6 B6 F7 F7 FF FF 7F 7F 6B 6B 5D
-5D 3E 3E 5D 5D 6B 6B 7F 7F FF FF > } image } if PT 12 eq { 16 16 1 [ 16 0 0
-16 neg 0 16 ] { < E3 E3 DD DD BE BE BE BE BE BE DD DD E3 E3 FF FF 3E 3E DD DD
-EB EB EB EB EB EB DD DD 3E 3E FF FF > } image } if PT 13 eq { 16 16 1 [ 16 0
-0 16 neg 0 16 ] { < FE FE 7D 7D BB BB D7 D7 EF EF D7 D7 BB BB 7D 7D FE FE 7D
-7D BB BB D7 D7 EF EF D7 D7 BB BB 7D 7D > } image } if PT 14 eq { 16 16 1 [ 16
-0 0 16 neg 0 16 ] { < 00 00 EE EF EE EF EE EF 0E E0 EE EE EE EE EE EE 00 EE
-FE EE FE EE FE EE 00 00 FE EF FE EF FE EF > } image } if PT 15 eq { 16 16 1 [
-16 0 0 16 neg 0 16 ] { < DD DD AA AA DD DD FF FF 77 77 AA AA 77 77 FF FF DD
-DD AA AA DD DD FF FF 77 77 AA AA 77 77 FF FF > } image } if PT 16 eq { 16 16
-1 [ 16 0 0 16 neg 0 16 ] { < F1 F1 EE EE 1F 1F FF FF F1 F1 EE EE 1F 1F FF FF
-F1 F1 EE EE 1F 1F FF FF F1 F1 EE EE 1F 1F FF FF > } image } if PT 17 eq { 16
-16 1 [ 16 0 0 16 neg 0 16 ] { < EE EE DD DD BB BB FF FF EE EE DD DD BB BB FF
- FF EE EE DD DD BB BB FF FF EE EE DD DD BB BB FF FF > } image } if PT 18 eq {
-16 16 1 [ 16 0 0 16 neg 0 16 ] { < BB BB DD DD EE EE FF FF BB BB DD DD EE EE
-FF FF BB BB DD DD EE EE FF FF BB BB DD DD EE EE FF FF > } image } if PT 19 eq
-{ 16 16 1 [ 16 0 0 16 neg 0 16 ] { < 1F FC 67 F3 7B EF BD DE BD DE DE BD E6
-B3 F8 0F E6 B3 DE BD BD DE BD DE 7B EF 67 F3 1F FC 7F FF > } image } if PT
-20 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < DD DD EE EE EE EE EE EE DD DD BB
-BB BB BB BB BB DD DD EE EE EE EE EE EE DD DD BB BB BB BB BB BB > } image }
-if PT 21 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < 0E 0E EF EF EF EF EF EF E0
-E0 FE FE FE FE FE FE 0E 0E EF EF EF EF EF EF E0 E0 FE FE FE FE FE FE > }
-image } if PT 22 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < 70 70 F7 F7 F7 F7 F7
-F7 07 07 7F 7F 7F 7F 7F 7F 70 70 F7 F7 F7 F7 F7 F7 07 07 7F 7F 7F 7F 7F 7F >
-} image } if PT 23 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < AA AA 55 55 A9 A9
-D1 D1 E1 E1 D1 D1 A9 A9 55 55 AA AA 55 55 A9 A9 D1 D1 E1 E1 D1 D1 A9 A9 55 55
-> } image } if PT 24 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < FF FE FF FC EA
-A8 D5 54 EA A8 D5 54 E8 28 D4 54 E8 E8 D4 D4 E8 EA 54 D5 A8 EA 54 D5 00 C0 00
-80 > } image } if PT 25 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < FF FE FF FC
-FF F8 FF F0 F0 00 F0 00 F0 20 F0 60 F0 E0 F1 E0 F3 E0 F0 00 E0 00 C0 00 80 00
-00 00 > } image } if gr } def /FA { /PT exch def gsave clip 0 0 translate 1 1
-54 { 1 sub 47.2 mul /Xcurr exch def 1 1 74 { 1 sub 47.2 mul /Ycurr exch def
-gsave Xcurr Ycurr translate PT DP gr } for } for gr } def
-/reencdict 24 dict def /ReEncode {reencdict begin /nco&na exch def
-/nfnam exch def /basefontname exch def /basefontdict basefontname findfont def
-/newfont basefontdict maxlength dict def basefontdict {exch dup /FID ne
-{dup /Encoding eq {exch dup length array copy newfont 3 1 roll put} {exch
-newfont 3 1 roll put} ifelse} {pop pop} ifelse } forall newfont
-/FontName nfnam put nco&na aload pop nco&na length 2 idiv {newfont
-/Encoding get 3 1 roll put} repeat nfnam newfont definefont pop end } def
-/accvec [ 176 /agrave 181 /Agrave 190 /acircumflex 192 /Acircumflex
-201 /adieresis 204 /Adieresis 209 /ccedilla 210 /Ccedilla 211 /eacute
-212 /Eacute 213 /egrave 214 /Egrave 215 /ecircumflex 216 /Ecircumflex
-217 /edieresis 218 /Edieresis 219 /icircumflex 220 /Icircumflex
-221 /idieresis 222 /Idieresis 223 /ntilde 224 /Ntilde 226 /ocircumflex
-228 /Ocircumflex 229 /odieresis 230 /Odieresis 231 /ucircumflex 236 /Ucircumflex
-237 /udieresis 238 /Udieresis 239 /aring 242 /Aring 243 /ydieresis
-244 /Ydieresis 246 /aacute 247 /Aacute 252 /ugrave 253 /Ugrave] def
-/Times-Roman /Times-Roman accvec ReEncode
-/Times-Italic /Times-Italic accvec ReEncode
-/Times-Bold /Times-Bold accvec ReEncode
-/Times-BoldItalic /Times-BoldItalic accvec ReEncode
-/Helvetica /Helvetica accvec ReEncode
-/Helvetica-Oblique /Helvetica-Oblique accvec ReEncode
-/Helvetica-Bold /Helvetica-Bold accvec ReEncode
-/Helvetica-BoldOblique /Helvetica-BoldOblique accvec ReEncode
-/Courier /Courier accvec ReEncode
-/Courier-Oblique /Courier-Oblique accvec ReEncode
-/Courier-Bold /Courier-Bold accvec ReEncode
-/Courier-BoldOblique /Courier-BoldOblique accvec ReEncode
-/oshow {gsave [] 0 sd true charpath stroke gr} def
-/stwn { /fs exch def /fn exch def /text exch def fn findfont fs sf
- text sw pop xs add /xs exch def} def
-/stwb { /fs exch def /fn exch def /nbas exch def /textf exch def
-textf length /tlen exch def nbas tlen gt {/nbas tlen def} if
-fn findfont fs sf textf dup length nbas sub nbas getinterval sw
-pop neg xs add /xs exch def} def
-/accspe [ 65 /plusminus 66 /bar 67 /existential 68 /universal
-69 /exclam 70 /numbersign 71 /greater 72 /question 73 /integral
-74 /colon 75 /semicolon 76 /less 77 /bracketleft 78 /bracketright
-79 /greaterequal 80 /braceleft 81 /braceright 82 /radical
-83 /spade 84 /heart 85 /diamond 86 /club 87 /lessequal
-88 /multiply 89 /percent 90 /infinity 48 /circlemultiply 49 /circleplus
-50 /emptyset 51 /lozenge 52 /bullet 53 /arrowright 54 /arrowup
-55 /arrowleft 56 /arrowdown 57 /arrowboth 48 /degree 44 /comma 43 /plus
- 45 /angle 42 /angleleft 47 /divide 61 /notequal 40 /equivalence 41 /second
- 97 /approxequal 98 /congruent 99 /perpendicular 100 /partialdiff 101 /florin
- 102 /intersection 103 /union 104 /propersuperset 105 /reflexsuperset
- 106 /notsubset 107 /propersubset 108 /reflexsubset 109 /element 110 /notelement
- 111 /gradient 112 /logicaland 113 /logicalor 114 /arrowdblboth
- 115 /arrowdblleft 116 /arrowdblup 117 /arrowdblright 118 /arrowdbldown
- 119 /ampersand 120 /omega1 121 /similar 122 /aleph ] def
-/Symbol /Special accspe ReEncode
-/Zone {/iy exch def /ix exch def ix 1 sub 2224 mul 1 iy sub 3144
- mul t} def
-%%EndProlog
- gsave 20 28 t .25 .25 scale gsave
-%%Page: number 1
- gsave
- 1 1 Zone
- gsave 0 0 t black [] 0 sd 1 lw 2223 2224 0 460 bl 2223 2224 0 460 C NC 1779
- 1778 222 683 bl 2223 2224 0 460 C 1779 1778 222 683 C NC 222 683 m 1778 Y s 239
- 847 m -17 X s 239 990 m -17 X s 239 1090 m -17 X s 239 1169 m -17 X s 239 1232
- m -17 X s 239 1286 m -17 X s 239 1333 m -17 X s 239 1375 m -17 X s 256 1411 m
- -34 X s 112 1421 m 3 2 d 4 4 d -31 Y s 146 1427 m -4 -1 d -3 -5 d -2 -7 d -5 Y
- 2 -7 d 3 -5 d 4 -1 d 3 X 4 1 d 3 5 d 2 7 d 5 Y -2 7 d -3 5 d -4 1 d -3 X cl s
- 159 1445 m 22 X s 192 1454 m 3 1 d 3 4 d -25 Y s 239 1654 m -17 X s 239 1796 m
- -17 X s 239 1897 m -17 X s 239 1975 m -17 X s 239 2039 m -17 X s 239 2093 m -17
- X s 239 2140 m -17 X s 239 2181 m -17 X s 256 2218 m -34 X s 157 2228 m 3 1 d 5
- 5 d -31 Y s 239 2461 m -17 X s 222 683 m 1779 X s 222 699 m -16 Y s 276 699 m
- -16 Y s 321 699 m -16 Y s 360 699 m -16 Y s 394 699 m -16 Y s 425 716 m -33 Y s
- 389 634 m 2 2 d 5 4 d -31 Y s 423 640 m -5 -1 d -3 -5 d -1 -7 d -4 Y 1 -8 d 3
- -4 d 5 -2 d 3 X 4 2 d 3 4 d 1 8 d 4 Y -1 7 d -3 5 d -4 1 d -3 X cl s 437 651 m
- 22 X s 468 659 m 1 Y 1 3 d 2 1 d 2 1 d 5 X 2 -1 d 1 -1 d 1 -3 d -2 Y -1 -2 d -2
- -4 d -12 -12 d 17 X s 627 699 m -16 Y s 746 699 m -16 Y s 830 699 m -16 Y s 895
- 699 m -16 Y s 948 699 m -16 Y s 993 699 m -16 Y s 1032 699 m -16 Y s 1067 699 m
- -16 Y s 1098 716 m -33 Y s 1061 634 m 3 2 d 5 4 d -31 Y s 1095 640 m -4 -1 d -3
- -5 d -2 -7 d -4 Y 2 -8 d 3 -4 d 4 -2 d 3 X 5 2 d 3 4 d 1 8 d 4 Y -1 7 d -3 5 d
- -5 1 d -3 X cl s 1110 651 m 21 X s 1143 660 m 3 2 d 3 3 d -25 Y s 1300 699 m
- -16 Y s 1419 699 m -16 Y s 1503 699 m -16 Y s 1568 699 m -16 Y s 1621 699 m -16
- Y s 1666 699 m -16 Y s 1705 699 m -16 Y s 1740 699 m -16 Y s 1770 716 m -33 Y s
- 1764 634 m 3 2 d 5 4 d -31 Y s 1973 699 m -16 Y s 1779 1778 222 683 C 2223 2224
- 0 460 C 1040 539 m 9 -21 d s 1057 539 m -8 -21 d -3 -6 d -3 -3 d -3 -1 d -2 X s
- 1077 549 m 12 -31 d s 1100 549 m -11 -31 d s 1127 545 m -3 3 d -4 1 d -6 X -5
- -1 d -3 -3 d -3 Y 2 -3 d 1 -1 d 3 -2 d 9 -3 d 3 -1 d 2 -2 d 1 -3 d -4 Y -3 -3 d
- -4 -2 d -6 X -5 2 d -3 3 d s 1139 521 m -2 -1 d 2 -2 d 1 2 d -1 1 d cl s 1166
- 539 m 16 -21 d s 1182 539 m -16 -21 d s 1779 1778 222 683 C /w 2
- def /w2 {w 2 div} def /w3 {w 3 div} def -7048 -21988 1808 -21988 1938 -21988
- 1861 -21988 1934 1747 1242 2014 1652 -21988 1492 1250 1751 1989 1908 1366 1828
- 2106 1964 -21988 1621 -21988 1744 -21988 1971 2141 1898 -21988 1832 1354 1732
- -21988 1699 -21988 1149 -21988 1904 -21988 629 -21988 1847 960 909 2065 941
- -21988 1575 1517 1968 -21988 1881 1637 1961 -21988 1754 2128 1896 -21988 1267
- 1645 1544 -21988 1051 -21988 1555 1946 1914 -21988 1729 -21988 1720 1769 1803
- 1842 1711 -21988 1703 -21988 1942 -21988 1577 2139 1179 -21988 1308 -21988 1663
- -21988 1718 2051 1870 -21988 1758 -21988 1969 1796 1611 -21988 1709 1938 1933
- -21988 1909 2132 1956 1828 1574 2123 1613 -21988 1765 1933 1500 -21988 1925
- -21988 1894 -21988 1951 1637 1880 -21988 1696 2261 1186 1786 1802 -21988 1962
- -21988 1947 2074 1690 1760 1802 1864 1226 1588 1777 1764 1752 -21988 1585 1989
- 1188 -21988 1924 -21988 1923 1265 1554 -21988 1957 1094 1804 1710 1227 1872
- 1745 1493 1930 -21988 1938 1989 1793 -21988 1381 1815 1928 2101 1745 -21988
- 1957 -21988 1739 -21988 1938 1601 1841 -21988 1377 -21988 1832 -21988 1603 2160
- 1223 1513 1939 1987 1444 -21988 1969 1490 1857 -21988 100 { m20} R 1815 -21988
- 1181 -21988 1086 -21988 1490 -21988 1910 -21988 1607 -21988 1781 -21988 1909
- -21988 1525 1216 1892 -21988 1798 -21988 1413 1725 1756 -21988 1634 1629 1610
- 2212 1915 2092 1052 1508 1730 2215 1480 1816 1577 1967 1969 -21988 1594 -21988
- 1969 2177 1956 -21988 562 2086 1623 -21988 1618 -21988 1771 1362 1332 1684 1971
- 1832 1867 2051 1464 2085 1354 -21988 1819 1258 682 1745 1866 -21988 1886 -21988
- 1758 1805 1901 -21988 1615 1625 1911 1809 1967 1042 1922 1688 1450 1582 1901
- 2221 1937 1927 1939 2015 1799 1853 1619 1564 1568 -21988 1809 -21988 1954 1757
- 1838 -21988 1238 -21988 1972 513 996 1519 1508 -21988 1773 2321 424 -21988 1748
- 967 1918 -21988 1793 -21988 1719 -21988 1542 -21988 1289 2071 1611 -21988 1656
- -21988 1694 -21988 1570 631 1796 -21988 1825 1394 1808 -21988 1507 -21988 1838
- -21988 1801 -21988 1278 2088 1832 1962 1679 -21988 1951 -21988 1846 -21988 1125
- 2356 1905 1688 822 1245 1788 1309 1323 1892 1138 1187 1499 -21988 1626 1854
- 1698 1510 1441 -21988 1815 -21988 1719 1947 1562 2372 1972 1670 1838 2270 412
- -21988 1597 -21988 1505 1464 1943 -21988 1968 -21988 100 { m20} R 1568 -21988
- 1373 -21988 1969 -21988 1906 1570 862 1797 1903 2120 1667 2056 1641 -21988 1829
- -21988 1412 2168 1612 2062 1853 -21988 1408 1627 1859 -21988 1934 1873 1909
- 2194 1838 -21988 1770 -21988 1950 -21988 1528 1125 1645 1883 675 -21988 1656
- -21988 1522 1990 1662 -21988 1475 583 1622 1636 1802 1730 1169 -21988 1958 2098
- 1773 1514 1952 1909 1633 -21988 1892 -21988 1469 1834 1798 -21988 1738 1973
- 1821 -21988 1771 -21988 1337 1722 1708 1732 1953 1244 1852 -21988 716 -21988
- 1624 -21988 1603 -21988 1907 -21988 1855 -21988 1962 1603 1614 -21988 1701 2210
- 1963 -21988 1902 -21988 1559 -21988 513 -21988 1927 -21988 1677 -21988 1781
- 1491 1956 -21988 1859 -21988 1632 1464 1675 -21988 1785 2003 1746 -21988 1587
- -21988 1765 -21988 1733 -21988 1583 -21988 1861 -21988 1755 -21988 1951 -21988
- 1916 1768 1862 1888 1512 1894 1799 -21988 1734 -21988 1253 2018 1516 -21988
- 1547 1531 1763 -21988 1473 -21988 1651 2097 1804 -21988 1672 2051 1863 1508
- 1941 -21988 1856 -21988 1914 -21988 1773 1941 1811 -21988 1915 1897 1822 -21988
- 1741 -21988 1729 -21988 1645 -21988 1897 2060 1501 -21988 1885 -21988 1413 2262
- 1444 2208 100 { m20} R 1935 912 1655 -21988 1348 2205 1944 -21988 1880 -21988
- 1766 -21988 1911 1859 1816 -21988 1669 2092 1709 1601 1927 2017 1909 -21988 943
- 1591 1696 1009 1801 -21988 1714 -21988 1956 1331 1786 614 1899 -21988 1693 891
- 1733 -21988 1863 1859 1918 -21988 1095 -21988 1757 1428 1510 -21988 1933 2206
- 1950 -21988 1654 1849 1905 1052 1855 -21988 1469 1951 810 -21988 1635 1621 1696
- 2190 1518 1925 1964 -21988 1954 -21988 855 1777 1389 2005 1927 1276 1703 1174
- 1774 1834 1962 -21988 1751 2056 1944 -21988 1416 1969 1512 2191 1768 1746 1825
- -21988 1904 -21988 1781 1928 1215 2050 1378 1988 1810 2156 1432 2013 1552
- -21988 1970 2175 1329 -21988 1923 1440 1654 1159 1785 2088 1800 -21988 1632
- -21988 1574 -21988 1754 -21988 855 -21988 1207 -21988 1291 2155 1878 1602 1674
- 1988 1332 1965 1690 1871 1424 1159 1386 -21988 1457 1532 1919 1896 1572 -21988
- 1900 -21988 1713 -21988 1246 -21988 1477 -21988 1952 1958 1903 -21988 1229
- -21988 1685 -21988 1302 -21988 1864 -21988 1808 1587 1771 -21988 1815 1181 839
- 1879 1752 -21988 1911 -21988 1779 -21988 1971 -21988 1510 -21988 1065 2263 1896
- 1703 1855 -21988 100 { m20} R 1411 -21988 1895 -21988 1658 1671 1870 -21988
- 1970 -21988 1244 2036 1504 1656 1729 -21988 1412 -21988 1946 1995 1838 -21988
- 1196 -21988 1495 -21988 1642 1681 1801 1891 1904 -21988 1866 -21988 1937 -21988
- 1913 1958 1412 -21988 1899 1874 1655 1472 1894 1814 1662 1281 1487 -21988 1291
- 1768 1880 -21988 1944 1659 1870 -21988 1854 1633 1500 -21988 1452 1627 1391
- -21988 1588 1974 846 2247 1557 -21988 1927 -21988 1851 2020 1257 1470 1952 1441
- 1276 1727 1295 1169 1569 1989 1296 2056 1886 2232 1889 -21988 1835 2155 1848
- 1911 1625 -21988 765 1314 1196 1386 1532 1440 1947 -21988 1680 -21988 1849 1891
- 1834 1826 1827 -21988 1878 1895 1942 -21988 1899 -21988 1776 2146 1312 -21988
- 1728 1904 1477 810 1874 -21988 1801 -21988 1340 1912 1884 1607 1386 -21988 1459
- 2137 1969 1949 1600 -21988 1309 -21988 1655 1408 1548 2042 -264 1734 1954 1949
- 1621 -21988 1910 -21988 1067 1815 1609 1826 1738 1909 1955 -21988 1191 2033
- 1732 -21988 1760 1486 1322 -21988 1547 2027 1664 1789 1681 -21988 1863 1983
- 1844 -21988 1761 -21988 455 2034 1879 1785 1965 -21988 1632 -21988 1889 1733
- 1788 2111 1801 1667 100 { m20} R 1761 2128 1328 -21988 1903 -21988 1539 1871
- 1350 1711 1752 1910 1737 2142 1632 -21988 1932 -21988 1811 1610 1858 1058 1537
- 1908 1833 1959 1869 1635 1852 1617 1961 1805 1843 1998 1545 -21988 1693 -21988
- 1746 -21988 1637 -21988 1552 1983 1927 -21988 1309 1961 1870 -21988 1387 -21988
- 1718 -21988 1963 -21988 1664 2214 1889 2186 1926 2147 1843 2067 1826 -21988
- 1855 -21988 1737 2130 1556 -21988 1756 1651 1831 749 1624 -21988 1582 1192 1620
- -21988 1702 -21988 1789 1813 1838 -21988 1891 2023 1519 2079 1562 -21988 1892
- 1944 1755 -21988 1918 -21988 1745 -21988 1966 -21988 1924 -21988 1716 -21988
- 1904 1818 801 -21988 1066 1149 1835 -21988 1889 2149 1054 -21988 1947 1440 963
- 1367 1522 1904 1937 -21988 1707 1511 1940 -21988 1653 -21988 1776 -21988 1738
- -21988 1799 -21988 1823 1873 1453 1478 1436 -21988 1761 1221 1661 1892 1771
- -21988 1614 -21988 1759 -21988 1900 1937 1893 2093 1436 -21988 1127 1902 1803
- 1158 1972 -21988 1889 -21988 1949 -21988 1902 -21988 1512 -21988 1878 -21988
- 1880 -21988 1057 1764 1332 1736 1781 1935 1892 -21988 1400 1707 1137 -21988
- 1517 -21988 1956 1626 1282 -21988 1932 1969 100 { m20} R 1949 1367 1152 1954
- 1697 1914 1019 1186 1571 803 1942 2044 1603 -21988 989 1603 1935 1937 1903 1949
- 1942 -21988 1684 1957 1420 -21988 1778 -21988 1734 -21988 1810 -21988 1891 1703
- 1960 2058 1837 -21988 1823 2335 1605 1630 1809 1466 1880 -21988 1758 1593 1629
- -21988 1879 -21988 1900 2111 1927 -21988 1826 -21988 -131 2012 1752 -21988 1321
- -21988 1882 -21988 1869 -21988 1716 -21988 1944 2159 1854 2029 1884 1972 1694
- -21988 1814 -21988 1947 2267 1960 -21988 1951 1863 1400 -21988 1951 -21988 1905
- -21988 1945 -21988 1808 -21988 1924 -21988 1918 1966 211 -21988 1682 -21988
- 1806 1952 1718 -21988 1892 2279 1768 2055 1664 -21988 1820 1756 1239 -21988
- 1793 -21988 1627 -21988 1598 -21988 1836 1544 1527 1476 1372 -21988 1787 -21988
- 1819 -21988 1696 -21988 1696 1921 1814 1441 1919 -21988 1679 2043 1773 2012
- 1876 972 1509 2040 1837 1951 1348 -21988 1970 -21988 1172 1957 1903 -21988 1972
- 1689 1271 -21988 1469 -21988 1795 -21988 1282 1731 1952 1267 1935 -21988 1967
- 243 1704 -21988 1961 2010 1696 -21988 1861 1884 1843 646 1863 1277 1752 -21988
- 972 -21988 1939 2050 1572 1949 955 1882 1960 1921 100 { m20} R 1839 -21988 1502
- 1707 1649 791 1583 1321 1493 -21988 1299 1796 1230 -21988 1842 1904 1739 2199
- 1338 1972 1909 -21988 1890 2007 1904 -21988 1662 1657 1773 1057 1810 -21988
- 1746 1808 1954 1605 1564 -21988 1958 -21988 1876 1391 1889 -21988 1963 2043
- 1764 -21988 1339 -21988 1833 1253 1730 2166 1901 1892 1817 2148 1659 1769 1387
- 2078 1742 1347 1688 -21988 512 -21988 1317 754 1235 -21988 1962 1966 1719
- -21988 1248 1742 1614 -21988 1035 -21988 1935 1640 1046 -21988 1855 2105 1731
- 1926 1587 1490 1512 1841 1690 -21988 1398 1694 1510 1007 1953 2016 1351 2018
- 1691 1819 1704 -21988 1957 -21988 1557 2306 1795 2075 1676 1672 1604 1946 1148
- -21988 1764 -21988 1802 1380 1533 -21988 1613 1800 1820 1917 1898 2036 932
- -21988 1942 -21988 1972 1247 1641 -21988 1903 -21988 1731 -21988 1781 -21988
- 1674 -21988 1491 1097 566 -21988 1870 -21988 1615 -21988 1968 -21988 1696
- -21988 1590 2077 1873 1717 1900 1838 1859 1633 1837 -21988 1680 -21988 1516
- -21988 1642 1640 1606 -21988 1839 -21988 1680 1872 1866 1852 1827 -21988 1738
- 2101 1524 1862 1949 -21988 1869 -21988 1286 -21988 1648 2024 1957 1952 100 {
- m20} R 1884 1916 1695 1241 1915 -21988 1949 -21988 1753 -21988 1092 1812 1676
- 1691 1621 2106 1507 1556 1785 -21988 1945 1693 672 -21988 1940 1805 1950 -21988
- 1315 1356 1935 1839 1877 2174 1761 -21988 1857 1987 1666 -21988 966 1399 1892
- -21988 1943 -21988 1008 -21988 1700 -21988 1590 1952 1933 -21988 1970 1575 1874
- -21988 1298 -21988 1733 -21988 1764 1672 1853 -21988 1911 -21988 1808 -21988
- 1522 -21988 1881 -21988 1896 -21988 1910 -21988 1795 -21988 1831 2237 1622 1737
- 1354 1910 1365 1622 1405 -21988 1819 1629 1912 1811 1940 -21988 1915 1445 1816
- 2040 1788 2186 1942 1260 1872 -21988 1963 -21988 1879 1947 1437 -21988 1812
- -21988 1926 -21988 1243 576 1881 -21988 1829 -21988 1952 -21988 1741 1896 1600
- 1408 1703 -21988 1842 2124 1131 -21988 1926 2051 1967 1952 1965 1418 1329
- -21988 1909 1322 1592 2008 1966 -21988 1916 -21988 -79 2089 1945 2037 1782 1981
- 1634 -21988 1737 -21988 1698 1144 1964 -21988 1941 -21988 1649 -21988 1954 2157
- 1645 -21988 733 -21988 1743 -21988 1847 -21988 1943 -21988 1863 -21988 1246
- -21988 1698 -21988 1752 -21988 1857 1389 901 1906 1789 -21988 1281 -21988 1770
- -21988 1589 -21988 100 { m20} R 1532 1539 1953 -21988 1827 1593 1745 -21988
- 1850 1926 1700 1984 1263 2098 1538 -21988 1726 -21988 1934 1807 1925 -21988
- 1891 -21988 1832 -21988 1506 2007 1693 2270 1511 -21988 1815 -21988 1903 1838
- 1792 1480 1437 1534 1765 -21988 1593 -21988 1688 -21988 891 -21988 1671 -21988
- 1914 1057 1912 -21988 1708 -21988 1893 1443 1724 2205 964 2061 1730 2186 1786
- 1920 1622 -21988 1793 1752 1824 -21988 1613 1869 1788 1987 1961 -21988 1246
- -21988 1680 -21988 1747 1938 1854 1840 1553 1892 1666 1854 1860 1244 1335 2022
- 1912 2009 1941 1608 1937 -21988 1930 1332 1589 1672 1841 1228 1834 -21988 1391
- -21988 1839 -21988 1274 2043 908 2001 1594 2020 1302 -21988 1891 -21988 1935
- -584 1319 -21988 1935 -21988 1860 -21988 1787 1182 1752 2100 1348 -21988 1781
- -21988 1929 -21988 1660 1579 1946 -21988 1918 1875 1791 1685 1792 -21988 1779
- -21988 1118 1791 1805 -21988 1840 -21988 1594 2191 1877 -21988 1795 -21988 1167
- 1991 1694 1441 1871 -21988 1205 1790 1877 1831 1678 2166 1847 1905 1820 1538
- 1122 1142 1697 1467 1644 -21988 1463 1906 1238 -21988 1788 1513 1271 -21988
- 1874 1863 1702 1692 1945 1629 100 { m20} R 1856 1361 1936 -21988 1530 1587 1955
- 1529 1924 -21988 1826 -21988 1478 1656 1496 -21988 1612 2161 1773 1879 1615
- -21988 1898 1486 1613 -21988 1787 1373 1710 -21988 1959 -21988 1739 -21988 1594
- 1767 1867 -21988 1170 -21988 1741 1223 1495 2362 1896 -21988 1889 -21988 1659
- 2037 1330 1792 1752 -21988 1949 -21988 1820 -21988 1585 1908 1407 1838 1901 530
- 1418 -21988 1671 -21988 1843 -21988 1233 2041 1911 2019 1881 1628 794 2036 1954
- 2161 1532 -21988 1863 2112 1770 1758 1675 -21988 1348 -21988 736 1872 1795
- -21988 1727 -21988 1962 1919 1719 1765 1795 -21988 1483 1650 1696 2059 1487
- 1823 1605 -21988 694 1206 1952 2146 1862 2251 1685 -21988 1560 1816 1791 1510
- 451 -21988 1757 1205 1769 1821 1939 1287 1882 1804 1002 1407 1524 327 1675
- -21988 1920 1845 1901 -21988 1636 963 1830 1814 1864 1369 1733 2171 1929 -21988
- 1732 1333 1903 1016 1860 -21988 1921 1895 1794 -21988 1868 2190 1607 1751 1889
- -21988 1835 -21988 1678 1602 1743 -21988 1798 2079 1740 2208 1632 2086 1821
- -21988 1881 1214 1886 997 1320 -21988 1737 -21988 1762 1973 1877 -21988 1579
- 1318 1635 -21988 1735 1864 100 { m20} R 1570 -21988 1789 -21988 1788 -21988
- 1958 -21988 1938 1663 1851 1638 1875 -21988 1689 -21988 1896 1667 1812 1990
- 1535 -21988 1561 1376 1852 1265 1871 1508 1484 2025 1777 -21988 1833 -21988
- 1732 1887 1767 2157 1969 -21988 1868 1909 1819 -21988 1945 -21988 1947 -21988
- 1892 504 1728 -21988 1755 2191 1870 -21988 1319 2118 1611 -21988 1592 1620 1905
- 2225 1843 1867 1951 1253 1766 -21988 1733 -21988 1855 1970 1641 -21988 1696
- -21988 1947 1566 836 -21988 745 -21988 1735 1110 1849 -21988 1835 2083 1586
- 2265 1971 -21988 1925 1555 1928 -21988 1916 -21988 1730 -21988 1964 -21988 1956
- -21988 1413 1473 980 -21988 1521 -21988 1964 -21988 1887 -21988 1868 1710 1457
- -21988 1914 1686 1601 1939 1906 -21988 1952 -21988 1680 -21988 1958 1727 1593
- 2277 1806 1784 1671 1842 1592 1718 1966 2146 1806 -21988 1877 -21988 1881
- -21988 1823 1703 1910 2066 1667 -21988 1537 -21988 1541 2026 1940 -21988 1896
- 1155 1385 1422 1535 2101 1733 951 1480 1805 1076 1345 1892 1823 1677 -21988
- 1013 1817 1619 2013 898 -21988 1855 1973 1960 -21988 1967 -21988 1684 2135 1633
- -21988 1854 1989 1857 1749 1957 988 1608 -21988 100 { m20} R 1549 -21988 1344
- -21988 1930 2061 1910 2284 1901 -21988 1133 135 1153 -21988 1683 -21988 1907
- 1717 1854 -21988 972 1953 1683 -21988 1681 2080 1958 784 1946 -21988 1964
- -21988 1486 -21988 1575 -21988 1889 -21988 1524 -21988 1439 -21988 1627 1751
- 1731 1723 1183 -21988 1943 2178 1633 1838 1699 -21988 1653 2042 1925 -21988
- 1423 -21988 1764 -21988 953 1206 1809 -21988 1945 2094 1835 -21988 1716 -21988
- 1703 -21988 1938 -21988 1952 758 1237 -21988 1788 -21988 1232 2133 1184 -21988
- 1846 1126 1309 -21988 1656 -21988 1755 -21988 1835 -21988 1913 2098 1865 -21988
- 1802 -21988 1679 -21988 1860 -21988 1905 1711 1045 -21988 1929 -21988 1847
- -21988 1734 -21988 1893 -21988 1955 -21988 1735 -21988 1568 -21988 1290 1726
- 1886 -21988 1582 -21988 1714 1110 1905 1712 1741 1515 1751 1311 1405 1787 1838
- 1899 1567 -21988 1958 1526 1961 1566 1959 -21988 1789 1781 1709 1985 1839 2089
- 1881 -21988 1925 2141 1271 -21988 1643 2174 1560 -21988 1390 1723 1774 2052
- 1641 2215 1664 -21988 1636 -21988 852 -21988 1794 1061 1630 1480 1506 -21988
- 1601 -21988 1967 -21988 1921 -21988 1571 1928 1760 1924 1861 -21988 1800 -21988
- 1928 1697 100 { m20} R 1433 1798 1696 1816 374 -21988 1518 -21988 1843 2015
- 1672 1949 1897 -21988 1603 -21988 1739 1701 1957 2060 1935 -21988 1944 -21988
- 1803 -21988 1923 2318 1569 2023 1710 2098 1938 -21988 1276 2065 1605 1539 1914
- 1782 1622 -21988 1889 2060 1768 2036 1696 1637 1078 -21988 1924 -21988 1504
- -21988 1703 825 1928 1932 1735 -21988 1925 -21988 1406 316 247 -21988 1095 1916
- 1689 1394 1452 2070 1701 1793 1930 -21988 1322 1482 1646 2077 1832 2051 1964
- -21988 1438 2078 1657 1986 1708 -21988 1710 1934 1943 1937 1904 1755 -75 1489
- 1955 1953 1749 2167 1927 -21988 1887 -21988 1911 2036 1951 1838 1967 1866 1905
- 1832 1863 1397 1968 -21988 1739 1220 1850 1276 1915 -21988 1718 2153 1860
- -21988 1329 -21988 1904 -21988 1396 1836 1959 1648 1660 -21988 1797 1918 1428
- 1663 1541 -21988 1459 -21988 1766 -21988 1327 1779 1966 -21988 1923 -21988 1955
- 2056 1268 2003 1852 1838 1937 -21988 1864 -21988 1469 -21988 1443 1801 1768
- -21988 1944 2218 1441 1611 1485 -21988 1941 -21988 1786 -21988 1072 1572 1642
- -21988 1775 1494 1924 -21988 1585 1648 1248 2141 1955 -21988 1767 1830 1600
- -21988 1483 1835 100 { m20} R 1895 1853 1631 1779 1674 2184 1672 1932 1841
- -21988 1503 1687 1956 -21988 1962 2143 1599 1619 1777 -21988 1843 1927 1784
- 2293 1494 1791 1704 2198 1836 -21988 1797 2124 1694 1688 1505 -21988 1644
- -21988 1716 2263 1966 -21988 1953 -21988 1739 -21988 1157 2079 1381 -21988 1634
- 2131 1085 -21988 1506 1705 1464 -21988 1698 1977 1734 -21988 1683 -21988 921
- -21988 1522 -21988 1359 1893 1903 1949 1693 -21988 1519 1976 1797 1758 1655
- -21988 1882 -21988 1579 1490 1930 1952 1553 -21988 1618 -21988 1969 -21988 1939
- 1709 1924 2134 1382 -21988 1801 -21988 854 1780 1520 -21988 1606 -21988 1682
- 2064 1722 -21988 1350 2321 1816 -21988 1725 1503 1939 1617 1496 2148 1420 1806
- 1907 -21988 1958 1462 1678 -21988 1433 -21988 1534 1995 1084 -21988 1950 1671
- 1951 -21988 1936 -21988 1814 564 1838 -21988 1099 2120 1715 1900 1891 1924 1813
- 1888 1490 1052 1883 2018 1426 1716 1806 1754 1735 2037 1951 -21988 1103 -21988
- 1495 -21988 934 -21988 1096 -21988 1881 -21988 1948 2067 1791 -21988 1903 1282
- 1388 2081 1520 2058 1704 2041 354 1881 1641 -21988 1903 1996 1817 1766 1944
- -21988 1566 -21988 1658 -21988 100 { m20} R 1721 1510 1662 -21988 1498 -21988
- 695 2047 1670 -21988 1926 -21988 1708 -21988 1853 -21988 1897 -21988 1421 1218
- 1844 2159 1852 1130 1767 -21988 1969 1959 1718 -21988 1732 -21988 1454 1987
- 1914 1478 1930 -21988 1496 924 1153 -21988 1462 2114 1767 -21988 1457 -21988
- 1888 361 1899 -21988 1900 -21988 1917 -21988 1779 -21988 1808 1957 1495 -21988
- 1670 1394 1934 2168 1648 1756 1933 -21988 1755 -21988 1619 2081 1885 2332 1076
- 1657 1871 -21988 1943 -21988 1889 -21988 1914 2240 510 1457 1638 -21988 1710
- 1801 1424 -21988 1924 2144 1453 -21988 1775 -21988 1839 -21988 1843 -21988 1734
- 1909 1849 1941 1438 722 1385 1682 1781 -21988 1971 -21988 1560 1922 1961 -21988
- 1726 1962 1653 1864 1834 1975 1911 -21988 1805 -21988 1870 1573 1926 1869 1787
- -21988 1804 -21988 1886 -21988 1641 1885 1838 1287 1928 -21988 1471 -21988 1615
- 1775 1970 -21988 1814 1648 1665 1156 1721 -21988 1966 1712 1498 -21988 1640
- 1787 1825 -21988 1630 -21988 1774 1447 1778 1613 1635 2252 1899 1280 1613
- -21988 1945 -21988 1634 1779 1232 -21988 1596 1710 1851 2117 1965 -21988 1819
- -21988 1408 2086 1623 2028 1871 1097 1964 1862 100 { m20} R 1388 -21988 1608
- 1873 1479 1968 931 1123 1799 2174 1549 -21988 743 2174 1906 -21988 1573 -21988
- 1842 2022 1739 -21988 1934 2184 1615 -21988 1866 -21988 1938 -21988 1638 1635
- 1966 1422 1764 1736 1812 2264 1745 2108 1897 2091 1798 -21988 1886 -21988 1791
- 2030 1888 -21988 1904 -21988 1950 -21988 1675 -21988 1973 -21988 1758 -21988
- 1773 -21988 1397 -21988 1930 2013 1703 -21988 347 -21988 1965 1764 1387 1658
- 1579 -21988 1416 -21988 1915 -21988 1863 -21988 1393 -21988 1881 1729 1655
- -21988 1970 1838 1487 -21988 1916 -21988 1663 -21988 1645 -21988 1919 1687 1934
- -21988 1703 2204 1529 976 1882 1284 1939 -21988 1817 1879 1583 -21988 1859
- -21988 1717 -21988 760 -21988 1576 -21988 1954 2101 1301 1635 1584 -21988 1892
- -21988 1825 1788 1651 -21988 1435 -21988 1713 -21988 1720 -21988 1544 -21988
- 1904 -21988 1800 1754 1908 -21988 1110 -21988 1465 -21988 1937 -21988 1936
- -21988 1971 1590 1704 -21988 1862 -21988 1859 -21988 1555 1761 1721 -21988 1963
- -21988 1525 2128 1859 -21988 1888 -21988 995 1929 1910 1379 1899 1934 1679
- -21988 1088 1592 1619 635 870 -21988 1615 -21988 1821 -21988 1706 1639 1927
- 1950 1948 -21988 100 { m20} R 1813 -21988 1671 -21988 1040 1978 1969 1950 1541
- -21988 1951 1608 1913 2140 1957 1701 1858 -21988 1882 -21988 1356 1859 1678
- -21988 1546 -21988 1549 2124 966 -21988 1925 1589 1789 1536 1763 2104 1781
- -21988 1812 1965 1918 -21988 1765 2100 1686 2158 1793 1764 1738 -21988 1952
- -21988 1767 -21988 1905 2280 1569 -21988 1909 1930 586 2162 1804 1717 1915
- -21988 1873 1781 1879 1390 1475 -21988 846 -21988 1332 1872 1413 -21988 1851
- -21988 1437 1687 1771 1673 1645 -21988 1930 -21988 1841 1723 1616 1884 1259
- 1819 1951 -21988 1904 1904 1855 -21988 1887 -21988 1659 -21988 1924 -21988 1265
- 2114 1641 -21988 1829 2049 1840 2052 1790 1839 1111 2067 1678 -21988 1662
- -21988 1724 -21988 1903 2043 1811 2175 1504 -21988 1071 1704 1845 1988 1864
- 1741 1918 1377 1673 -21988 1647 1939 1952 2097 1856 1129 1834 -21988 1554
- -21988 1934 2004 1971 2028 1801 -21988 1610 2038 1718 -21988 1886 1696 1043
- -21988 818 -21988 1342 1829 1560 1317 1860 1025 1884 1246 1954 -21988 1891
- -21988 1966 -21988 1607 1935 1328 -21988 1834 -21988 1852 1463 1517 1834 1450
- 1744 1724 -21988 1839 -21988 1760 -21988 1334 -21988 100 { m20} R 1859 2095
- 1952 1718 669 -21988 1436 1335 1766 2226 1834 1308 1763 -21988 1843 -21988 1906
- -21988 1570 1476 1197 2015 1879 -21988 1683 -21988 1885 -21988 1547 1927 1899
- 1829 1915 -21988 1856 -21988 1127 2030 1888 1763 1972 1945 1933 -21988 1485
- 2051 1833 -21988 1833 -21988 1719 -21988 1965 -21988 1852 -21988 1946 -21988
- 1831 -21988 1132 215 1546 1668 1844 997 1668 1858 1887 -21988 1355 -21988 1874
- -21988 1778 -21988 1033 -21988 1689 1411 1717 1964 1834 -21988 1659 -21988 1463
- 2242 1129 1874 862 1476 1705 1491 1720 -21988 1652 915 1922 1278 1937 -21988
- 1720 -21988 1681 -21988 1735 1528 1834 -21988 232 -21988 1322 -21988 1948 2122
- 1899 1758 1553 2165 1864 -21988 1164 1817 1711 1754 1802 1695 1870 -21988 1355
- -21988 1614 -21988 1812 -21988 1135 -21988 1871 -21988 1946 -21988 1573 -21988
- 1832 2131 1858 1314 1654 -21988 1923 -21988 1290 1628 1873 1887 958 -21988 1858
- 1817 1958 2059 1660 1549 1949 2318 681 2250 1857 1054 1319 1676 1697 -21988
- 1739 1403 1899 -21988 1144 -21988 1917 2221 1777 -21988 1849 1254 1702 1829
- 1825 912 1060 1511 1954 1575 1828 1712 1583 -21988 1649 -21988 100 { m20} R
- 1409 1960 1948 1745 1884 1964 1429 1052 1810 -21988 1898 -21988 1940 1907 1781
- -21988 1909 1836 1548 -21988 1769 -21988 1729 1655 1689 -21988 1370 -21988 1713
- 1806 1761 -21988 1528 1377 1644 -21988 1731 -21988 1918 1761 1879 -21988 1929
- 1262 608 -21988 1758 2036 1839 -21988 1865 2264 1898 -21988 1746 801 1849
- -21988 1847 1205 1788 -21988 1590 -21988 1886 2020 1823 -21988 1874 -21988 1887
- -21988 1947 1499 1798 2158 1849 -21988 1566 -21988 1858 -21988 1915 2156 1939
- 1056 1770 1767 1277 1947 1640 1889 1847 -21988 1461 -21988 1870 -21988 1522
- -21988 1844 -21988 1919 -21988 1486 2089 1743 2118 1570 -21988 1617 1989 1901
- 1802 1676 -21988 1949 2247 1950 1907 1946 -21988 1649 2061 1961 -21988 1934
- 1786 1734 -21988 1653 -21988 1688 2074 1618 1822 1619 1873 1831 535 1869 2087
- 1967 2164 1412 1756 1624 -21988 1928 -21988 1839 -21988 1570 1849 1044 -21988
- 1201 1881 1966 -21988 1917 -21988 1709 2167 1888 -21988 1364 -21988 1155 -21988
- 1431 1474 1795 -21988 1710 1680 1921 -21988 1882 -21988 1948 1643 1311 -21988
- 1945 2136 1741 1702 1953 -21988 1872 -399 1630 2031 1903 -21988 1904 1566 1917
- 2015 100 { m20} R 1966 -21988 1826 -21988 1304 1187 1907 1700 1737 -21988 1157
- 1974 1954 -21988 1776 1980 1882 2198 1434 -21988 1653 1972 1888 2250 1323 1956
- 1849 -21988 1935 -21988 1179 1827 1855 -21988 1289 1741 1404 2076 1785 -21988
- 1858 1845 1962 1801 1605 -21988 1801 -21988 1907 -21988 1512 -21988 1474 1218
- 1668 -21988 1972 1909 1827 2214 1798 -21988 1971 1475 1947 1444 959 1518 1940
- -21988 1594 1408 -274 -21988 1818 2132 1932 1948 1297 -21988 1912 -21988 1761
- -21988 578 2300 1733 -21988 1704 -21988 1872 2112 1493 -21988 1734 -21988 48 {
- m20} R 1644 -21988 1948 -21988 1746 -21988 1961 2077 1872 -21988 1940 2063 1475
- 1856 1888 -21988 1685 1775 1787 -21988 1707 -21988 1675 -21988 1905 -21988 1936
- -21988 1474 -21988 1624 2260 1946 1459 1741 -21988 1970 -21988 1701 -21988 1958
- 600 1495 -21988 1718 1725 1955 -21988 575 -21988 1949 2064 1597 -21988 1740 719
- 1830 1886 1952 2104 1394 -21988 1885 1040 1410 2091 1118 2107 1336 1891 1903
- 2164 1837 -21988 1536 -21988 1435 1308 1559 -21988 1449 -21988 1844 -21988 1500
- -21988 1843 1879 1423 1676 1802 1584 1696 -21988 1215 1985 1542 2002 1744
- -21988 1777 -21988 1824 1769 1543 -21988 1648 1961 1417 -21988 1923 -21988 1795
- -21988 1044 2010 1512 -21988 1867 -21988 1447 -21988 1460 1718 1914 -21988 1746
- 2062 1845 -21988 1022 -21988 1851 -21988 1681 -21988 1960 -21988 1823 -21988
- 1348 1890 1775 -21988 1727 -21988 1629 -21988 1908 1888 1923 -21988 1444 -21988
- 1692 -21988 1853 1103 1877 1687 1591 -21988 1964 2020 1084 -21988 1721 -21988
- 1884 1299 1004 -21988 1879 1780 1749 2017 1965 1543 1827 -21988 1193 -21988
- 1946 -21988 1828 1790 1709 -21988 1967 -21988 1960 1409 1817 -21988 1725 1803
- 1770 -21988 1879 -21988 100 { m20} R 1962 -21988 1209 1625 1021 1971 1954 1276
- 1782 1899 1561 -21988 1315 1882 1493 -21988 1762 1867 1926 -21988 1899 -21988
- 1902 -21988 1890 1878 1690 1752 1649 715 1505 -21988 1256 -21988 1076 1691 1455
- 1685 1672 1203 1738 2224 1790 2097 1509 2043 1856 1236 1968 1818 1821 1822 1337
- -21988 1643 1796 1832 2201 1890 -21988 1754 1795 1576 -21988 1681 1796 1732
- -21988 1951 -21988 1758 1559 1436 -21988 1573 -21988 1765 -21988 1640 -21988
- 1552 1786 1850 -21988 1827 1878 1607 -21988 1944 -21988 1959 -21988 1926 1801
- 1723 1459 1728 1648 1968 1701 1842 1914 1929 1933 1345 1793 1911 -21988 1954
- 1979 1836 893 1687 2151 1666 2191 1431 1750 1909 1976 1447 -21988 1104 -21988
- 1824 2217 1615 1834 1721 1774 1957 2022 1776 1464 1757 -21988 1347 2212 1794
- -21988 1963 -21988 1794 -21988 1656 -21988 1368 -21988 1924 -21988 1919 1960
- 1505 -21988 1330 -21988 1942 2273 1420 1820 1941 -21988 1511 -21988 1427 1609
- 1740 -21988 1482 -21988 1912 2082 1141 -21988 1759 -21988 1465 1878 1910 1403
- 1639 -21988 1564 2070 1310 1986 1754 -21988 1793 1752 854 1944 1904 1906 1942
- -21988 1441 -21988 1363 -21988 100 { m20} R 1896 -21988 1876 -21988 1276 1595
- 1390 1411 1916 1827 1496 2196 1222 -21988 910 -21988 1238 2277 1967 -21988 1776
- -21988 924 -21988 1083 -21988 1903 1739 1926 2234 1965 1803 1352 -21988 1841
- -21988 1645 -21988 1453 1552 1800 -21988 1586 1751 1783 1021 1253 1237 1865
- -21988 1731 2144 1462 -21988 1548 -21988 1899 1949 1834 1960 1811 -21988 1315
- -21988 1114 -21988 1968 1708 1529 -21988 1210 1927 1821 -21988 1670 1663 1864
- 1888 1853 -21988 1535 1426 1905 1978 1929 -21988 1718 -21988 1972 -21988 1330
- 2251 1504 1833 1624 -21988 1753 -21988 1905 -21988 1800 -21988 1897 -21988 1837
- 1316 1324 2012 1957 -21988 1676 2178 1598 1709 1930 -21988 1948 1934 1732
- -21988 1695 2059 1641 2070 1854 1629 1940 -21988 1640 1942 1057 1880 1781
- -21988 1880 -21988 1402 2109 1341 2192 1479 794 1498 -21988 1916 2013 1810 1784
- 1814 1711 1345 1389 1796 -21988 1822 2036 1876 1946 1942 2090 1937 -21988 1939
- -21988 1878 1681 1846 -21988 1928 -21988 1728 -21988 1502 -21988 1605 -21988
- 1599 1489 1967 -21988 1459 -21988 1915 -21988 1873 -21988 1630 -21988 1533 -931
- 1516 997 1817 -21988 1435 -21988 1640 -21988 1125 -21988 100 { m20} R 1877 1931
- 1756 1511 1652 -21988 578 -21988 1694 1285 1853 1746 1767 -21988 1446 2131 1953
- -21988 1160 1603 1856 -21988 1903 2013 1872 1739 1892 1812 1854 1582 1613 2125
- 1382 2022 1963 1777 1816 1781 1913 1892 1950 1492 1449 1527 1745 -21988 1787
- -21988 1412 -21988 1354 -21988 1900 -21988 1355 2160 1855 -21988 1953 -21988
- 1562 1954 1891 2019 1755 1621 1940 2162 1866 -21988 1957 -21988 1796 -21988
- 1805 1986 1592 -21988 1586 -21988 1851 -21988 1522 2130 1585 2150 1726 1374
- 1905 -21988 1756 2033 1896 -21988 1714 2202 1150 -21988 1879 -21988 1971 1746
- 1906 -21988 1589 1485 1709 1079 1886 -21988 1924 2104 1958 1802 1971 -21988
- 1563 -21988 1655 1256 1878 -21988 1597 1870 1845 1251 1941 -21988 1035 -21988
- 1582 -21988 1970 1751 1853 1944 1711 1218 1808 -21988 1789 -21988 1618 2114
- 1937 -21988 1892 1976 1916 -21988 976 -21988 1938 -21988 1942 -21988 1594
- -21988 1882 1919 1968 -21988 1952 -21988 1949 -21988 1338 1426 1968 -21988 1895
- -21988 1716 -21988 1856 -21988 1837 1792 1567 1806 1896 -21988 1384 1263 1857
- -21988 1075 1478 1922 2097 1776 1474 1220 -21988 1690 1950 1932 2125 1539
- -21988 100 { m20} R 1942 -21988 1889 -21988 1927 -21988 1716 -21988 1954 -21988
- 1845 1978 1739 1460 1886 -21988 1538 -21988 1192 -21988 1812 -21988 770 1569
- 1486 1705 1856 -21988 1173 -21988 1702 -21988 1710 1745 1754 2033 1751 1681
- 1931 1885 1842 1612 909 1855 1642 1951 1739 -21988 1012 1709 1944 1232 1845
- 2088 1858 1232 1597 1828 1735 -21988 1774 -21988 1784 2142 1849 1800 1880
- -21988 1519 -21988 1586 -21988 1678 1127 1957 -21988 1865 1724 1572 -21988 1878
- 1589 1330 2086 1356 1222 1911 -21988 1916 -21988 1918 1701 1146 2259 1883
- -21988 1675 1643 955 -21988 1642 -21988 1963 -21988 1961 1855 1947 1842 1797
- -21988 1845 -21988 1846 2217 1927 -21988 1881 2193 1798 -21988 1645 1958 920
- 2058 1814 1957 1958 1817 1940 -21988 1899 -21988 1667 -21988 1904 -21988 1266
- 1807 1930 1802 1856 2040 1662 -21988 1650 1404 1041 -21988 1640 1852 1718 1906
- 809 1799 1892 -21988 1917 1966 1963 1927 1578 1782 1949 -21988 1928 -21988 1864
- -21988 1958 1129 1961 -21988 1646 1956 1721 1662 1893 2100 1959 -21988 1549
- 1794 1944 2048 1641 1711 1222 -21988 1335 2094 1935 -21988 1928 -21988 1885
- 1745 1812 -21988 1360 1279 100 { m20} R 1416 2138 1657 -21988 1538 -21988 1909
- 1366 1077 2079 994 -750 934 -21988 1820 -21988 1882 -21988 1511 1425 915 -21988
- 1962 1853 1960 1571 1686 2088 1311 -21988 1927 2111 1264 -21988 1796 -21988
- 1823 1646 1696 -21988 1197 -21988 1889 -21988 1543 -21988 1824 -21988 1399 2023
- 1705 -21988 1851 -21988 1712 -21988 1551 1547 1586 -21988 1752 1693 1274 -21988
- 1777 -21988 1923 -21988 1785 1792 1590 -21988 1030 -21988 1836 1875 1231 -21988
- 1736 -21988 1899 -21988 -4 1572 1373 -21988 1753 -21988 1939 1942 1859 1956
- 1299 -21988 1312 2210 1969 1789 1848 -21988 1944 1990 1909 1705 1315 1911 1939
- -21988 1737 1991 1804 -21988 1599 -21988 1455 1623 1696 1431 1952 -21988 1348
- -21988 1927 1581 1005 -21988 1914 -21988 1753 -21988 1887 -21988 1859 -21988
- 1769 1912 1741 1809 1668 938 1670 -21988 1269 -21988 1813 1839 1971 598 1819
- 1287 1970 -21988 1967 1330 1818 -21988 1739 -21988 1968 -21988 1612 -21988 443
- -21988 1480 2142 1967 2290 1788 -21988 1713 -21988 1914 -21988 1869 -21988 1837
- 1455 1948 1685 1766 2140 1952 -21988 1964 1782 1527 -21988 1899 2046 1944
- -21988 1377 2016 1922 -21988 1915 1920 1777 -21988 100 { m20} R 1646 1441 1658
- -21988 1949 -21988 1770 1609 1358 -21988 1885 1230 1852 -21988 1461 2056 1903
- 2038 1612 -21988 1026 -21988 1936 2151 1936 -21988 1819 -21988 1619 -21988 1915
- -21988 1922 1337 1560 2041 1651 -21988 1659 -21988 1884 1742 1801 -21988 1766
- 1724 1827 -21988 1369 2063 1755 -21988 1465 -21988 1889 -21988 1746 2053 1767
- -21988 1531 1589 1480 2075 1476 -21988 1648 -21988 1872 -21988 1256 -21988 1830
- 1848 1743 -21988 1606 -21988 1593 1984 1760 2161 1718 1939 1726 1891 1625 1258
- 1947 -21988 1139 -21988 1905 1972 1161 2015 1955 -21988 1699 1569 1852 -21988
- 1819 1294 -299 1859 1928 1024 1936 -21988 1902 -21988 1631 2218 1841 1881 1382
- 938 1706 -21988 1740 1745 1947 -21988 1918 -21988 1878 -21988 1884 1752 1845
- 1822 1553 2207 1778 -21988 1670 2033 1872 1849 1836 -21988 1340 -21988 918 1734
- 1848 -21988 1729 -21988 465 1860 1496 -21988 1767 2025 1712 2296 1838 1358 1376
- 1570 1636 1713 1335 1964 1499 -21988 1638 -21988 542 -21988 1845 -21988 1810
- 2032 1851 -21988 1952 -21988 1909 -21988 1812 1889 1918 1828 1211 -21988 1926
- 1466 1802 1811 1592 857 1828 -21988 1945 367 1529 -21988 100 { m20} R 1631 1800
- 1685 1909 1871 -21988 1348 1470 1459 -21988 1691 1757 1675 -21988 1745 -21988
- 1693 1820 1257 -21988 1916 -21988 1862 -21988 1967 1907 1970 -21988 1689 1097
- 1685 -21988 1877 1699 1818 -21988 1405 2037 1670 -21988 1898 1158 1724 1628
- 1684 1311 1546 1958 1933 -21988 1876 -21988 1906 1704 1425 -21988 1405 -21988
- 1936 -21988 1652 -21988 1445 1535 1941 -21988 1658 -21988 1845 2253 1921 1655
- 1869 -21988 1952 -21988 1734 -21988 1461 -21988 1787 2151 1422 -21988 1374
- -21988 1916 2212 1825 1957 1466 -21988 1810 2105 1292 1663 1729 -21988 1834
- 2114 1925 -21988 1786 1795 1624 1585 1762 -21988 1577 -21988 1574 -21988 1909
- -21988 1077 1055 1776 -21988 1533 -21988 1954 1711 1579 -21988 1513 1953 1634
- 1592 1748 1426 1756 -21988 1060 -21988 1795 -21988 1738 1016 1925 1919 1951
- 2027 1688 1467 1736 1814 1137 -21988 1798 1906 1950 1995 1912 1603 1671 1801
- 1248 1732 1697 -21988 1947 1725 1233 2332 1748 -21988 1795 -21988 1784 -21988
- 1785 1666 1547 -21988 1883 1887 1576 2068 1773 2024 1871 1327 1924 -21988 1896
- 2195 1716 2114 1580 -21988 1645 -21988 -201 1517 1650 -21988 1953 -21988 1670
- 2177 100 { m20} R 1819 -21988 1900 1301 1679 1981 1783 -21988 1708 1342 1777
- -21988 1943 -21988 1480 -21988 1863 1902 1938 -21988 1875 -21988 1096 2147 1659
- 2355 1724 -21988 1933 1923 1884 -21988 1742 1785 1823 -21988 1965 -21988 1670
- 2060 1651 2062 1493 1642 1753 1833 808 -21988 1539 -21988 1160 -21988 1882 1744
- 1964 -21988 1789 -21988 1359 -21988 1938 -21988 1684 1294 1870 2148 1683 2120
- 1798 -21988 1425 759 1858 2127 1883 1398 1616 -21988 1899 -21988 880 -21988
- 1920 -21988 1844 2020 1691 -21988 1052 -21988 1844 1817 1768 2096 1728 1741
- 1969 -21988 1614 2060 1791 2020 1666 -21988 1884 -21988 1727 2337 1603 -21988
- 1237 1353 1743 -21988 1228 1318 1945 1743 1899 -21988 1881 -21988 1735 -21988
- 1872 -21988 1692 -21988 1263 -21988 1902 2220 1846 -21988 1835 -21988 1697 2077
- 846 1764 1801 -21988 1868 -21988 1482 1999 1969 -21988 1851 -21988 1685 -21988
- 1716 -21988 1589 -21988 1754 1715 1918 1693 1793 -21988 1732 -21988 1590 -21988
- 1823 -21988 1771 -21988 1949 2089 1966 -21988 1816 1654 1941 -21988 1153 -21988
- 1520 1892 1698 2023 1551 -21988 1563 1723 1570 -21988 1811 -21988 1933 -21988
- 1563 -21988 -415 -21988 1421 -21988 100 { m20} R 1545 -21988 1424 985 1942
- -21988 1591 -21988 1924 1809 1817 -21988 1521 -21988 1934 -21988 1899 1124 1953
- -21988 1533 -21988 1496 -21988 1877 2045 1414 2118 1835 -21988 1607 1631 1901
- -21988 1199 1243 1571 -21988 1143 -21988 1452 -21988 1917 488 1656 2065 1442
- -21988 1464 1921 1808 1649 1926 -21988 1909 -21988 1684 -21988 1453 -21988 1319
- -21988 1880 2057 1756 -21988 1535 1782 1673 2141 1905 -21988 1341 -21988 1535
- 2121 1901 1867 1530 1592 1860 1967 1949 2229 1933 -21988 1914 -21988 1779
- -21988 1847 -21988 1721 -21988 1857 -21988 1555 1586 1947 -21988 1347 -21988
- 1466 1077 1810 1878 1668 1982 1955 2036 1748 -21988 1704 -21988 1786 1551 1932
- 1143 1935 -21988 1543 1903 1667 -21988 1593 1568 1685 1890 1923 1542 1639 1951
- 1710 2093 1930 1470 1819 1899 1734 136 98 -21988 1921 -21988 1481 -21988 1497
- 1576 1057 1447 1579 1941 1774 -21988 1745 -21988 928 -21988 1749 -21988 1776
- -21988 1498 1910 1927 -21988 1926 -21988 1900 -21988 1851 -21988 1684 -21988
- 1507 1727 1947 1989 1042 -21988 1921 -21988 1703 1763 1916 1461 1882 1516 1733
- -21988 1559 2134 1869 2264 1819 -21988 1674 -21988 1929 -21988 100 { m20} R
- 1896 -21988 1786 -21988 1382 -21988 1655 -21988 1821 -21988 1751 2186 1767 2059
- 1700 -21988 1818 2041 1671 1689 1960 1663 1597 -21988 1564 -21988 1063 1900
- 1963 858 1881 -21988 1357 1882 1380 1896 1966 -21988 1298 -21988 1049 -21988
- 1921 2203 1885 1922 1828 -21988 1732 -21988 1527 -21988 1868 -21988 1207 2051
- 1232 -21988 1493 2160 208 -21988 1185 1767 1682 1894 1971 1552 1625 -21988 1803
- -21988 1371 1321 1890 1636 1404 -21988 1876 -21988 1879 -21988 1859 -21988 1712
- 1233 1864 1530 1571 -21988 1911 2247 1822 -21988 1821 -21988 1184 -21988 1904
- 1705 1724 2098 1410 -21988 1889 -21988 1486 1993 1937 -21988 1912 2247 1872
- -21988 1174 1124 1961 2045 1760 -21988 969 1686 1833 1786 1956 1972 1971 1863
- 1128 -21988 1573 -21988 1202 1773 1302 -21988 1234 1960 1948 -21988 1953 -21988
- 1748 -21988 1523 2060 1729 1844 1528 1645 1719 -21988 1486 1942 1775 1766 1962
- -21988 1483 -21988 1627 1112 1969 1765 1832 -21988 1913 1850 1882 -21988 1948
- -21988 1944 -21988 1905 -21988 1923 1898 1667 -21988 1642 1979 1833 1661 1919
- 1723 1941 -21988 1539 1854 1639 1475 1019 -21988 1967 2150 1897 -21988 1912
- -21988 100 { m20} R 1946 -21988 1894 -21988 1246 -21988 1968 1428 1963 1525
- 1881 2041 1884 -21988 1182 -21988 1682 -21988 1714 -21988 1582 2044 1950 2255
- -642 1546 1175 1689 1826 2082 1757 2166 1854 1513 1419 -21988 1683 1797 1903
- -21988 1277 1927 1969 1645 1820 -21988 1848 1768 1758 -21988 1458 1267 1852
- 1822 718 -21988 1244 -21988 1852 -21988 1458 -21988 1898 1653 1911 -21988 1221
- -21988 1475 -21988 1952 1945 1645 1380 817 -21988 1431 2139 1966 2059 1386
- -21988 1567 -21988 1802 1913 1118 -21988 1857 -21988 1734 -21988 1315 211 1802
- 2036 1468 1810 1639 -21988 1772 -21988 1771 -21988 848 -21988 1912 2119 1775
- -21988 1829 -21988 1215 -21988 1465 -21988 1711 1317 1359 1896 1710 1523 1928
- 1890 1953 -21988 1553 1958 1506 -21988 1523 1751 1851 -21988 1874 -21988 1935
- -21988 1849 -21988 1877 -21988 1866 2074 1629 -21988 1796 -21988 1462 1829 1859
- -21988 1555 -21988 1840 1826 947 1817 1937 1751 1060 1241 1952 1626 1778 2223
- 1838 1683 772 -21988 1571 -21988 1335 41 1254 -21988 1761 -21988 1161 2089 1615
- 1675 1870 -21988 1966 2145 1840 -21988 1682 1923 1019 216 1882 -21988 1858 2085
- 1339 1807 1884 -21988 100 { m20} R 1914 1568 1592 -21988 1707 -21988 1769
- -21988 1556 -21988 1823 1604 1203 1776 1537 -21988 1865 -21988 1888 1893 1818
- 1764 1907 -21988 1161 -21988 1812 -21988 1103 1936 1742 1666 1817 1180 1035
- -21988 1914 -21988 1562 1137 1933 1982 1367 1586 1679 1768 1720 2011 1864 1926
- 1865 -21988 1969 -112 1970 2118 1478 1415 1461 1874 430 -21988 1959 -21988 1610
- 1557 1760 1769 1760 1991 1811 -21988 1949 -21988 1805 -21988 1869 1665 1914
- -21988 1946 -21988 1932 -21988 1726 -21988 1743 1740 1421 -21988 1873 1939 1586
- -21988 1953 1707 1949 -21988 1773 1231 1844 1430 1885 1934 1792 -21988 1943
- -21988 1478 -21988 1640 1483 1962 1537 1861 1420 1675 1464 1889 -21988 1931
- -21988 1883 2044 1515 2015 1417 1201 1608 -21988 1694 1205 1804 1925 1560 2046
- 1866 -21988 1480 1569 1927 -21988 1082 2371 1417 -21988 1953 -21988 1654 -21988
- 1929 -21988 1426 1886 1851 2176 1968 -21988 1931 266 1536 -21988 1951 -21988
- 1361 -21988 1949 -21988 1831 -21988 1416 -21988 1669 -21988 1546 -21988 1514
- -21988 1549 -21988 1904 -21988 1845 -21988 1960 2013 1597 -21988 1954 650 1807
- -21988 1802 2165 1695 2010 1769 -21988 1910 1825 100 { m20} R 941 1986 1849
- -21988 725 -21988 1849 -21988 1836 -21988 1784 1284 1966 -21988 1399 -21988
- 1923 821 1713 -21988 1768 -21988 1801 1825 1636 -21988 1749 -21988 1704 1654
- 1952 -21988 1169 2036 1491 1674 1907 1446 1675 -21988 1870 -21988 1417 -21988
- 1574 1598 1967 1828 1633 1938 1498 1965 1786 1710 1604 -21988 733 2127 1926
- 1482 1897 1984 1769 -21988 1942 1533 1248 2093 1851 2141 1842 -21988 1905 2250
- 1288 -21988 1500 -21988 1773 -21988 1843 -21988 1843 1731 1741 1158 1794 1277
- -99 1819 1398 2279 1966 1784 1345 1518 1789 -21988 1461 -21988 1576 -21988 1783
- 1757 1670 2101 1621 -21988 1463 1729 1646 -21988 1513 2206 1758 -21988 1809
- 1520 1936 -21988 1491 2031 1160 2044 1898 1794 253 1583 1543 834 1374 1633 1301
- 1417 1580 1022 1884 -21988 1453 1849 1688 -21988 1748 1892 1793 1707 1769
- -21988 1698 -21988 1922 -21988 1872 -21988 1700 -21988 1858 2040 1641 1730 1789
- 2146 1850 1577 1798 -21988 1797 1988 1930 -21988 1875 2141 1754 -21988 1586
- 2113 1803 -21988 1902 -21988 1955 -21988 1944 946 1504 -21988 1968 1871 1778
- 1561 1345 -21988 1948 -21988 1534 1724 1590 1621 1745 -21988 100 { m20} R 1529
- -21988 1955 1893 1639 2127 1890 2101 1881 -21988 1843 -21988 1667 1869 1551
- 2174 1944 1535 1871 2062 1546 2119 1766 1620 1734 1836 1355 2137 1029 -21988
- 1659 -21988 1902 -21988 1676 1653 1733 2127 1348 1868 1302 2221 1148 2054 1430
- -21988 1826 -21988 1873 -21988 1677 1976 1593 1133 1962 1923 1963 1870 1957
- -21988 801 1355 1467 -21988 1931 -21988 1925 2073 1511 1948 1756 1828 1736 1349
- 1020 1666 1375 -21988 1287 -21988 1896 -21988 1902 2187 1292 -21988 1444 -21988
- 1926 1886 1921 -21988 1934 1794 1302 1799 1960 1646 1339 714 1940 2073 1399
- -21988 1973 -21988 1392 -21988 1830 -21988 1746 1885 1741 -21988 1847 1588 1851
- -21988 1653 2130 1431 -21988 988 -21988 1700 2212 1336 -21988 704 -21988 1812
- 1901 1295 2222 1969 1788 1766 -21988 568 -21988 1834 1633 1550 -21988 1846 2092
- 1916 -21988 1943 -21988 1584 -21988 1885 -21988 1832 2155 1731 -21988 1502 1755
- 1933 -21988 1715 -21988 1408 -21988 1868 -21988 1740 -21988 1927 1910 1494
- -21988 1970 1567 1885 1654 1499 1549 1826 1530 1830 -21988 1922 -21988 1765
- -21988 1710 2027 1669 1873 1855 -21988 141 1592 1764 994 1963 -21988 100 { m20
-} R 754 1234 849 -21988 1906 -21988 1628 -21988 1894 1897 1638 1934 1318 -21988
- 1903 -21988 1967 1596 1955 -21988 1798 1960 1543 1975 1708 1323 1360 1783 1577
- 1703 1944 2109 1875 -21988 1453 2134 1877 2185 1674 2269 1779 1843 1642 1999
- 1902 -21988 1910 2273 1621 1722 1674 -21988 1904 -21988 1733 2331 1411 1642
- 1809 -21988 1706 -21988 1585 1598 1958 -21988 1891 2138 1900 1859 1534 1066
- 1873 1528 1959 1293 1619 -21988 1911 -21988 1856 -21988 1963 -21988 1945 -21988
- 1868 1859 1727 1564 1201 1494 1358 2020 1559 -21988 1356 -21988 1896 -21988
- 1901 -21988 1562 1708 1701 -21988 1849 -21988 1958 1928 1452 1227 1466 109 1823
- 1535 1560 976 1655 -21988 1921 -21988 1842 1782 1796 -21988 1948 1952 1861 1929
- 1944 -21988 1795 -21988 1357 -21988 1517 -21988 1137 -21988 1872 885 1658 2279
- 1912 -21988 1948 -21988 1583 -21988 1941 -21988 1935 1971 1903 1717 1912 1612
- 1845 -21988 1779 1980 1870 1378 1727 -21988 1780 834 1582 2010 1636 -21988 1875
- -21988 1948 -21988 1775 1898 1825 1032 1852 1990 1912 1916 1830 -21988 1542
- 1803 878 1079 1950 1547 1726 -21988 1564 1859 1876 1227 1678 1776 100 { m20} R
- 1842 -21988 1368 -21988 1681 1342 1793 -21988 1911 -21988 1672 1237 1918 2011
- 1714 1760 1842 2017 1953 2096 1892 -21988 1807 -21988 1862 -21988 1775 2106
- 1534 -21988 1481 -21988 1931 1738 1708 1570 1555 -21988 1809 -21988 1918 -21988
- 1922 1880 1928 -21988 1878 -21988 1698 -21988 1888 1743 1226 -21988 1527 1824
- 1913 1853 1734 2259 586 -21988 1183 -21988 1916 2319 1943 -21988 1747 1707 1897
- -21988 1621 2143 1913 -21988 1731 -21988 1914 -21988 1936 470 1946 1656 1523
- -21988 1773 2049 1520 -21988 1654 -21988 1395 -21988 1391 -21988 1952 1971 1628
- 1968 1665 -21988 1656 2173 1926 2008 1375 2221 1596 1873 1874 -21988 1646 1998
- 1402 2014 1707 2046 1698 775 1431 -21988 1362 -21988 1883 -21988 1854 -21988
- 1825 1373 1791 1748 1659 2135 570 -21988 1917 2123 1652 -21988 1952 -21988 699
- -21988 1591 1835 1482 1981 1782 -21988 1781 -21988 1644 1329 1819 1887 1930
- 1987 1433 2160 1622 -21988 1642 -21988 1818 1908 1438 -21988 1568 1935 1045
- -21988 1476 1464 1920 1774 1457 -21988 1966 1641 1769 1827 1829 -21988 1959
- -21988 1874 -21988 1966 -21988 902 -21988 1857 -21988 1614 -21988 1880 1821
- 1234 1970 100 { m20} R 1917 -21988 1670 -21988 1618 1448 1877 -21988 1807 1188
- 1900 -21988 1860 -21988 1504 1652 1430 2116 1806 2033 1952 2096 1887 1582 1823
- -21988 1294 1978 1865 -21988 1911 -21988 1972 1748 1951 -21988 1929 1793 1798
- 1663 1573 -21988 1969 -21988 1812 1782 1602 1756 1284 -21988 1770 1638 1920
- -21988 1808 -21988 1468 1726 1666 -21988 1816 -21988 1597 -21988 1756 1815 1777
- -21988 788 2209 1850 2132 1382 1727 1746 2036 1877 1877 1838 -21988 268 -21988
- 1815 2261 1529 -21988 1492 1717 1942 -21988 1697 1573 1966 -21988 1825 -21988
- 1911 -21988 1213 2069 1590 1336 1859 1699 1834 -21988 1793 -21988 1784 -21988
- 1946 1802 1582 -21988 1750 1775 1622 -21988 1960 -21988 1825 -21988 1410 1490
- 1437 -21988 1906 -21988 1921 996 1902 2148 1495 1821 1924 -21988 1916 1415 1396
- -21988 1688 2004 1908 -21988 775 -21988 1423 1467 1645 2095 1758 1915 1953
- -21988 1837 -21988 1466 1739 1521 1651 1420 1205 1772 -21988 1880 1322 1877
- -21988 1913 -21988 1805 -21988 1706 1754 1879 -21988 1065 1006 1695 -21988 1574
- 1707 1907 2008 1707 -21988 1905 2197 1877 -21988 1787 -21988 1930 639 1796 1933
- 1937 1854 1827 -21988 100 { m20} R 1899 -21988 1953 -21988 1799 -21988 653 1753
- 1929 -21988 1826 1978 1623 -21988 1720 -21988 1609 2258 1915 2186 1472 2142
- 1189 1993 1661 2026 1933 1198 1071 -21988 1368 1543 1907 2127 1701 1697 686
- -21988 1751 -21988 1580 1439 1850 1369 1147 1162 1935 1984 1949 1429 1203 1149
- 1734 -21988 1877 2005 1875 -21988 1964 -21988 1476 -21988 1869 1641 1824 -21988
- 1735 -21988 1264 -21988 1885 -21988 1914 -21988 1892 -21988 1557 -21988 1836
- -21988 1442 -21988 1557 -21988 1524 2126 1930 -21988 1556 1554 1022 -21988 1856
- -21988 1954 1817 1782 1687 1269 -21988 538 1853 1960 -21988 1969 -21988 1697
- 1913 1592 -21988 1744 2151 1221 -21988 1753 1911 1972 -21988 1955 -21988 1952
- -21988 1656 1203 1793 1729 1362 -21988 1739 995 1868 -21988 1668 -21988 1763
- 998 1932 -21988 1198 -21988 1558 1776 1880 -21988 1332 1488 1746 156 1957 2010
- 1849 -21988 1969 1799 1876 1943 1638 2127 1680 -21988 1841 -21988 1851 2008
- 1083 -21988 1926 930 1904 1764 1582 2101 1966 2133 1201 -21988 1629 -21988 1913
- 1290 1612 -21988 1951 1704 1943 -21988 1876 -21988 1918 -21988 1214 2150 1768
- 1737 1638 1847 1291 -21988 1268 1344 100 { m20} R 1523 -21988 1909 -21988 1541
- 1506 1708 -21988 1642 1655 1480 -21988 394 2054 1158 -21988 1675 -21988 1906
- -21988 1815 1935 1902 1853 1929 1867 1890 -21988 1779 -21988 1391 -21988 1859
- 2058 1836 -21988 1540 1975 1695 1681 1625 1603 1955 -21988 1944 -21988 1900
- -21988 1523 -21988 1778 -21988 1840 2193 1814 -21988 1623 1544 1666 1311 1400
- -21988 517 -21988 1890 -21988 1864 1810 1381 -21988 1858 1708 1946 -21988 1713
- 1895 1729 -21988 1174 897 1521 2192 1894 2065 1034 -21988 1820 1941 1752 -21988
- 1603 -21988 1597 -21988 1920 1795 1550 -21988 1663 -21988 1271 -21988 1813
- -21988 1971 1842 1959 -21988 1866 -21988 1968 1648 1602 -21988 1702 1833 1613
- -21988 1599 -21988 1812 -21988 1622 -21988 1660 -21988 1246 -21988 965 1684
- 1822 -21988 1956 2130 1973 2086 1883 -21988 1699 -21988 1814 1056 1941 -21988
- 1745 -21988 1896 1969 1664 -21988 1794 -21988 1742 -21988 1765 2238 1971 2045
- 1736 -21988 1766 -21988 1950 1850 1917 -21988 1890 -21988 1619 1104 1795 1085
- 1127 -21988 1903 1799 1924 2161 1368 -21988 1441 1566 1928 -21988 1921 2102
- 1930 2090 1690 1588 1600 2116 1386 -21988 1873 1826 1375 -21988 1846 -21988 100
- { m20} R 1538 2139 1951 -21988 1937 1815 1792 1154 1460 -21988 1914 2003 1913
- 1976 1954 -21988 1907 1806 1960 -21988 1768 1946 1819 -21988 1969 -21988 1675
- -21988 1850 -21988 1945 1733 1468 2276 1929 1802 1706 1960 1737 2086 1906 1673
- 1886 1933 1843 -21988 1852 -21988 1746 1706 1916 1154 1915 -21988 1936 2061
- 1045 1883 1870 -21988 1938 -21988 1928 1410 1887 1782 1757 2258 1361 -21988
- 1624 -21988 1588 1907 1815 2093 1966 1437 1573 2047 1728 2176 1069 -21988 1860
- 1897 1712 -882 1784 1885 1577 1990 1857 2281 1945 1903 48 { m20} R 1719 -21988
- 1755 2129 1598 1540 1901 1532 1910 2153 1840 1472 1713 -21988 1960 1525 1833
- 1668 1861 1950 578 -21988 1857 -21988 1955 -21988 1720 -21988 1912 2144 1600
- 1674 1960 -21988 1803 -21988 1802 -21988 889 -21988 1556 -21988 1678 1845 1849
- -21988 1860 -21988 1621 -21988 1617 973 1765 -21988 1414 1777 1452 1833 1873
- -21988 1645 861 821 1577 1873 -21988 1938 -21988 1857 1722 1829 -21988 1650
- -21988 1969 -21988 1726 -21988 1674 -21988 1843 1626 1732 1515 1546 -21988 1821
- -21988 1972 -21988 1808 1944 1681 1651 1518 -21988 1873 1396 613 1384 1781
- -21988 1664 1732 1775 991 1849 1284 1970 2013 1061 2123 1262 1921 1573 1027
- 1725 1995 1764 -21988 1948 1352 1716 2089 1166 1520 1752 -21988 1760 2265 1328
- 1930 454 -21988 1784 -21988 1716 1691 1333 1866 1430 1651 1943 -21988 1538
- -21988 1265 1853 1873 1406 1675 2220 1210 -21988 1941 1904 1899 2203 1313
- -21988 1964 -21988 1783 -21988 1946 -21988 1826 -21988 1919 1873 1926 -21988
- 1971 982 1860 2023 1294 1986 1565 -21988 1351 -21988 1307 -150 1827 2013 1804
- 1185 1799 2096 1792 -21988 665 -21988 1916 1864 1592 -21988 1765 -21988 100 {
- m20} R 1921 -21988 1441 -21988 1779 -21988 1625 1110 1237 1970 1624 1709 1934
- -21988 1802 -21988 1947 2020 1702 -21988 1882 -21988 1933 -21988 1541 -21988
- 839 1702 1429 1807 1907 -21988 1631 2076 1820 1475 1080 2100 1860 1598 1892
- 1476 1821 2227 1729 -21988 1945 1909 1762 -21988 1958 -21988 906 1598 1865 1926
- 1623 1497 1814 -21988 1938 -21988 1920 -21988 1289 -21988 1873 -21988 1309 1961
- 1926 190 1738 2065 1908 1841 1737 -21988 1874 -21988 1620 2013 1971 -21988 1768
- -21988 1754 -21988 1963 1451 1665 1454 990 -21988 1470 -21988 1752 -21988 1519
- 1858 1954 1915 1195 -21988 1604 -21988 1894 1502 1848 -21988 1812 1991 1079
- 1635 1942 1736 1574 -21988 1554 -21988 1549 -21988 1824 1238 1869 -21988 1107
- -21988 1873 -21988 1876 1998 1372 1822 1756 -21988 831 -21988 1946 -21988 1912
- 1325 1921 1266 1829 1433 1574 1893 1926 2063 1592 1966 1836 -21988 1896 -21988
- 1970 -21988 1948 1394 1947 2096 1924 -21988 1920 -21988 1700 -21988 1966 -21988
- 1965 1695 1485 -21988 1885 1518 1785 1269 1675 -21988 1828 -21988 1063 1991
- 1760 -21988 1825 -21988 1852 -21988 1961 -21988 1683 -21988 1691 2008 1818
- -21988 1757 -21988 100 { m20} R 1890 1453 1920 -21988 1528 -21988 1956 2076
- 1718 2070 1820 2131 1719 -21988 1872 2064 1819 -21988 1900 -21988 1642 263 1692
- -21988 1286 2275 1843 1818 1902 -21988 1502 1405 1858 2118 1878 -21988 1671
- 1844 1724 -21988 1835 -21988 1922 -21988 1888 -21988 1891 1899 1870 -21988 1548
- 1219 1869 -21988 1875 -21988 1712 870 1666 1634 1497 1994 1710 1710 1205 -21988
- 1224 -21988 1565 -21988 895 -21988 1752 -21988 1751 -21988 1922 -21988 1881
- -21988 1869 2075 1889 -21988 1922 2047 1777 -21988 1828 -21988 1831 1843 1494
- -21988 1958 1628 1925 -21988 1899 -21988 1866 1423 1548 1840 1953 -21988 1783
- -21988 1719 -21988 1228 -21988 1759 1951 1794 1341 1578 -21988 1460 -21988 1323
- 1464 1921 2257 1785 -21988 1829 -21988 1967 1870 1826 -21988 1307 -21988 769
- -21988 1855 -21988 1326 -21988 1642 1912 1784 1957 1902 -21988 1937 1768 1713
- -21988 1898 1757 1840 -21988 1839 2223 1900 -21988 1918 -21988 1921 1487 1273
- -21988 1654 1933 1868 1665 1814 -21988 1489 1873 1937 -21988 1810 1740 1810 958
- 932 1936 1972 -21988 1256 -21988 1656 1489 1286 -21988 1947 -21988 1955 2086
- 1796 -21988 1434 1647 1492 2042 1547 -21988 100 { m20} R 1766 -21988 1537 2277
- 1036 1648 735 1851 1867 -21988 1963 -21988 1959 -21988 1554 512 1945 -21988 468
- -21988 1782 1806 1962 2136 1877 1873 1446 1957 1951 -21988 1711 1751 1798 1725
- 1685 1780 1720 2183 1776 -21988 1939 -21988 1890 -21988 1486 1075 1851 -21988
- 939 -21988 1898 1772 1823 -21988 1326 2194 1621 1955 1607 1844 1781 1687 1896
- -21988 1692 1822 1539 2323 1947 1802 1859 2062 1705 1703 1750 -21988 1672 821
- 1563 2178 1910 2305 1564 2196 1330 -21988 1805 -21988 1668 2046 1668 1698 1830
- 2125 1652 2179 1561 1152 1576 1918 1763 1862 1549 2264 1895 1940 900 998 1605
- -21988 1957 1946 1965 -21988 1856 1863 1810 -21988 1543 -21988 866 -21988 1797
- 1783 1674 -21988 1690 2053 1811 -21988 1742 -21988 1557 -21988 1319 -21988 1794
- -21988 1725 -21988 1911 -21988 1434 -21988 -825 2208 1721 -21988 1687 -21988
- 1746 1728 1004 1546 1827 1234 1797 -21988 1934 1395 1884 1602 1926 1524 1962
- 1727 1814 -21988 1971 -21988 1403 -21988 1415 -21988 1830 -21988 1743 2030 1648
- -21988 1873 -21988 1970 -21988 1718 1926 1720 -21988 1892 -21988 1646 -21988
- 1941 1662 1942 -21988 1864 -21988 1938 1431 100 { m20} R 1181 -21988 1866
- -21988 1202 -21988 1878 -21988 1490 1996 1847 1829 1491 2084 1803 -21988 1648
- -21988 1450 -21988 1755 -21988 1389 -21988 1551 -21988 1943 2054 711 2153 1916
- -21988 1380 -21988 1871 1662 1757 -21988 1772 -21988 1545 1167 1152 1637 1828
- -21988 1973 2273 1492 1789 1703 -21988 1633 1598 1872 -21988 931 -21988 1957
- -21988 1441 1545 1568 -21988 1657 2087 1951 1698 1448 -21988 1787 -21988 1731
- -21988 1541 -21988 1698 -21988 1871 -21988 1775 -21988 1862 -21988 1928 -21988
- 1950 1625 1563 1493 1210 -21988 1227 -21988 1846 1602 1808 -21988 1973 1275
- 1939 -21988 1828 -21988 1633 -159 1907 -21988 1859 -21988 1910 2012 899 1572
- 1896 2121 1892 -21988 1886 57 1870 1832 1825 1700 875 1736 1972 2139 1613
- -21988 1967 -21988 1971 -21988 1182 -21988 1795 1773 1936 -21988 1420 -21988
- 1744 -21988 1462 1900 1618 1706 1076 -21988 1964 -21988 1958 -21988 1929 1851
- 1744 -21988 1861 -21988 1934 1996 1954 2151 1500 1516 1926 -21988 1321 1868
- 1681 -21988 1959 -21988 1082 1870 1951 1898 1826 -21988 1930 -21988 1799 2190
- 1690 1659 1883 -21988 1472 -21988 1547 -21988 1282 676 1073 2312 1687 -21988
- 1932 1720 100 { m20} R 1173 -21988 1848 -21988 1693 2048 1585 -21988 1767 1771
- 1384 1399 799 1430 1931 -21988 1613 1872 1900 -21988 830 -21988 1000 1653 1948
- 1835 1198 -21988 1661 2244 1527 -21988 1689 -21988 1828 1839 1472 1930 1608
- 1980 1774 1842 1719 -21988 1345 1435 1939 -21988 1930 -21988 1916 2239 1791
- 1927 1683 2031 1918 -21988 1401 -21988 906 1544 1589 -21988 1669 -21988 1940
- 2027 1822 -21988 1810 1809 1827 1892 1897 -21988 1402 -21988 1544 1834 1586
- -21988 1613 1849 1785 2028 1701 1254 1546 -21988 1463 1410 1784 1824 1888 2100
- 1793 2176 1941 -21988 1818 1981 1972 1816 1829 -21988 1031 1435 1878 2296 1676
- -21988 1698 -21988 1868 -21988 1627 -21988 1949 -21988 1872 -21988 1716 1883
- 1955 -21988 1564 2169 1530 -21988 1953 1911 1892 1931 1638 2138 1844 1636 1379
- 1772 1779 -21988 1823 -21988 1946 -21988 294 -21988 1123 2030 1394 1829 1478
- -21988 1938 1638 1968 -21988 1931 1447 1903 2136 1786 -21988 1959 1865 1513
- 2129 1939 -21988 1415 1546 1694 1348 1829 -21988 1852 1727 1910 -21988 1864
- 1013 1811 -21988 1605 -21988 1892 1961 1875 -21988 1932 -21988 1851 1539 1915
- 1979 1838 -21988 1662 -21988 100 { m20} R 1950 1943 1629 -21988 1659 -21988
- 1789 1960 1784 -21988 1821 1666 1117 -21988 -250 -21988 1695 838 1947 1937 1967
- -21988 1809 2163 1795 -21988 1766 -21988 1676 1755 1628 1695 1877 2000 966
- -21988 1709 1398 1964 761 1660 1998 1742 2058 1714 1988 1123 -21988 1510 -21988
- 1550 -21988 1629 967 1923 -21988 1441 1950 1882 1138 1361 -21988 1547 -21988
- 1902 -21988 1926 1162 1929 1628 1740 2058 1801 1681 850 -21988 1769 -21988 1893
- 1607 1939 -21988 1651 2218 1732 1738 1959 1914 1898 -21988 1370 -21988 1551
- 1470 1782 1698 1140 -21988 790 1520 1811 1497 1327 -21988 1778 1881 1807 -21988
- 1839 -21988 1595 -21988 1965 721 1920 -21988 1863 -21988 1841 -21988 1338 2002
- 1774 1848 1296 1641 910 -21988 1786 1816 1967 1737 1651 -21988 1863 -21988 1885
- 1660 1748 1828 1852 -21988 1754 2262 1847 -21988 1703 -21988 1898 -21988 1813
- 2082 1814 -21988 1392 -21988 1225 450 1783 905 1849 2173 1287 -21988 1682
- -21988 1351 -21988 1811 1704 1749 -21988 1872 1629 1586 -21988 1539 2037 959
- -21988 1955 -21988 1886 -21988 1895 1515 1901 2321 1489 1751 1692 -21988 1193
- -21988 1564 -21988 1805 -21988 1586 -21988 100 { m20} R 1950 1692 1786 -21988
- 522 1929 1879 2128 1885 1933 1758 2102 1689 -21988 1523 2263 1862 -21988 1775
- 1325 1751 -21988 1885 -21988 1493 -21988 1556 2046 1956 -21988 1825 1392 1356
- -21988 1344 1867 1640 -21988 1705 1666 1047 1891 1857 2100 1630 -21988 1766
- -21988 1620 1990 1615 -21988 1312 -21988 1835 -21988 1857 2345 1391 905 1768
- 2251 1943 2297 1246 -21988 1506 -21988 1860 -21988 1734 1541 1934 1798 1791
- -21988 1625 -21988 1700 1563 1489 -21988 1903 -21988 1907 1922 1901 2133 1910
- 1965 1947 1255 1723 1778 1529 1655 1577 -21988 1719 1849 1754 1186 1694 -21988
- 1892 -21988 1856 -21988 1830 -21988 -1406 -21988 1746 -21988 1902 1876 1942
- -21988 1511 -21988 1682 1151 1316 1319 1654 1560 1880 2222 1219 1966 1204 2171
- 1358 1828 1874 -21988 1852 -21988 1849 -21988 1829 -21988 1656 2057 1533 2078
- 1576 2031 1550 -21988 1807 -21988 1764 -21988 1601 1939 697 -21988 1514 -21988
- 1937 1726 1964 2125 1925 1426 1803 2037 1913 1843 830 -21988 1846 -21988 1864
- -21988 1607 1874 1039 1397 1896 2099 1274 -21988 1770 1053 1809 1612 1886
- -21988 1552 1702 1815 1479 1600 -21988 1624 1195 1448 -21988 100 { m20} R 1404
- -21988 1422 1886 1939 -21988 1882 -21988 1930 -21988 1751 -21988 1726 1681 1810
- 1532 1944 2317 1812 1862 1686 1798 1692 -21988 1727 -21988 1925 1948 933 1432
- 1961 -21988 1353 -21988 1836 1768 1964 -21988 1950 2065 1712 -21988 1810 1916
- 1907 1825 1790 -21988 1945 1534 1651 2058 1803 1430 1958 -21988 1893 1363 1886
- -21988 1111 -21988 1680 1599 1321 550 1895 -21988 1751 2136 1917 -21988 1957
- 2128 1856 1305 1749 -21988 1898 1824 1306 -21988 1523 -21988 1924 -21988 1286
- 1580 1801 -21988 1941 -21988 1205 1534 1866 1626 1718 -21988 1740 -21988 1837
- -21988 1554 -21988 1738 2017 1710 2303 1545 -21988 1899 -21988 1614 1566 1955
- 1836 1824 -21988 1636 2075 1327 -21988 1393 -21988 766 -21988 1893 -21988 1855
- -21988 1699 1861 1899 -21988 1710 1830 1448 789 1828 -21988 1790 2050 1881 1677
- 1818 1890 1075 1755 1949 -21988 1862 -21988 1607 2334 511 1621 1964 -21988 1154
- -21988 1503 -21988 1759 -21988 1644 1862 1846 -21988 1962 1642 1779 -21988 1865
- -21988 1423 -21988 1445 -21988 1771 -21988 1971 -21988 1631 -21988 907 1505
- 1320 -21988 1877 1563 1843 1918 1826 -21988 1938 -21988 1713 -21988 1321 -21988
- 100 { m20} R 916 -21988 1519 -21988 1933 -21988 1650 -21988 1668 1060 1652
- -21988 1808 2141 1935 -21988 1405 1854 1946 -21988 1736 1488 1972 -21988 1834
- -21988 221 1905 1756 -21988 1816 -21988 1786 1707 1687 2289 1950 -21988 1318
- -21988 1973 -21988 1728 1790 1800 -21988 1607 -21988 1819 -21988 1577 2133 1570
- -21988 1853 2244 1968 -21988 1740 1989 1674 -21988 1804 -21988 1358 1428 1842
- 1935 1710 1150 1870 1032 1538 1862 1944 1375 1913 1507 1865 2070 1866 -21988
- 1967 -21988 1841 -21988 1613 -21988 1955 2034 1869 1572 1881 1906 1945 -21988
- 1657 1549 1436 -21988 1775 1960 1832 -21988 1972 1502 1845 1916 1884 1955 1784
- -21988 1075 1321 1694 -21988 1097 1472 1700 2239 1797 -21988 1178 1940 1943
- 1941 1945 -21988 1561 -21988 1548 1874 1852 1965 1902 1691 1475 1861 310 1906
- 1425 -21988 1586 -21988 1229 1843 1782 -21988 1374 -21988 1206 -21988 1965 1626
- 1202 1538 1697 1777 1789 1645 1958 -21988 1031 1913 1162 1450 1790 1215 1972
- 2178 1864 -21988 1834 2057 839 -21988 1759 -21988 1749 -21988 1631 -21988 1684
- 2014 1679 2010 1775 1993 1869 1977 1429 -21988 1919 -21988 1917 1922 1700
- -21988 1088 -21988 100 { m20} R 379 1764 1648 2230 1564 1770 1533 1886 1970
- -21988 1206 -21988 1926 -21988 1302 1561 1216 1474 1845 -21988 1590 -21988 1364
- 1982 1801 1929 1406 -21988 1735 -21988 1646 2084 1107 1683 1626 -21988 1739 537
- 1969 -21988 1546 1236 1940 -21988 1773 -21988 1561 2076 1575 2144 1716 -21988
- 1789 1572 1930 -21988 1555 -21988 1955 1221 1749 -21988 1940 1984 1928 2170
- 1895 1654 1725 2133 1957 1944 1830 2086 1536 1830 1663 -21988 1656 -21988 1394
- 2227 1794 1806 1758 -21988 1726 2197 1689 -21988 1834 1519 1717 1001 1882 1943
- 1335 -21988 1963 916 1517 1330 1814 -21988 1759 -21988 1763 -21988 1781 1779
- 1705 -21988 1766 1585 1953 -21988 1571 1430 1873 1929 1667 1701 1680 1793 1746
- -21988 1489 -21988 1579 1624 1639 1886 1773 -21988 1689 -21988 652 2092 1717
- -21988 1938 -21988 1621 -21988 1320 -21988 1916 2131 1835 -21988 1858 -21988
- 1837 -21988 1664 739 1659 1643 1920 2243 1704 -21988 1913 -21988 1906 1636 1670
- -21988 1807 -21988 1880 1432 1937 1968 1853 -21988 1578 -21988 1726 -21988 1686
- 1696 1686 -21988 772 2141 1828 1997 1793 1907 1770 -21988 1951 2078 1871 -21988
- 1677 -21988 1888 1927 100 { m20} R 1760 2122 1581 -21988 1967 1928 1867 1524
- 1781 -21988 1471 -21988 1956 -21988 1815 1918 1794 1415 1891 -21988 1637 -21988
- 947 1782 1935 1645 1808 -21988 1475 1544 1950 -21988 1773 1949 1897 -21988 1847
- -21988 1778 -21988 1694 -21988 1887 -21988 1931 1953 1613 -21988 1915 2089 1880
- 2001 886 1761 1725 1867 1106 -21988 1480 1658 1933 -21988 1910 983 1679 -21988
- 1927 -21988 1870 -21988 1929 1891 1800 -21988 1716 1586 1931 1684 1750 -21988
- 631 1914 1615 -21988 1651 -21988 1720 -21988 1719 -21988 1927 -21988 1464 2145
- 1684 -21988 1510 1958 1867 1833 1667 2090 1650 1932 1926 -21988 1805 -21988
- 1828 -21988 1883 -21988 1865 1669 1069 -21988 1537 1701 1855 -21988 1721 1809
- 1040 2233 1821 2249 826 -21988 1911 1120 1826 -21988 1727 -21988 1737 -21988
- 1346 -21988 1585 2015 1769 -21988 1956 1738 1607 -21988 793 -21988 1945 -21988
- 1329 1790 1164 -21988 1770 -21988 1510 1673 1929 -21988 1944 -21988 1788 281
- 1819 1459 1501 -21988 1806 -21988 1613 1864 888 -21988 1892 -21988 1920 -21988
- 1554 -21988 690 1429 1479 1185 1970 -21988 1598 -21988 1900 -21988 1540 1799
- 1967 -21988 1116 1904 1714 1643 1955 2129 100 { m20} R 1724 -21988 884 -21988
- 1785 2152 1879 -21988 1592 -21988 1909 2295 1872 1868 1945 1589 1960 1702 1555
- 1914 1857 1549 1963 -21988 1635 -21988 1772 1644 1885 1248 1878 1644 1940 1991
- 1117 -21988 1700 1117 1761 -21988 1769 -21988 1630 -21988 1834 1848 1155 -21988
- 1624 2107 1971 2141 1484 -21988 1610 -21988 1580 2021 1516 -21988 1874 1775
- 1730 1910 1842 1458 1761 1451 1153 1803 933 1780 1939 -21988 1870 -21988 1854
- -21988 1958 2185 1723 -21988 1700 2198 1655 -21988 1576 -21988 1956 2076 1189
- -21988 1569 2241 1698 1969 1762 2154 1524 1630 1654 -21988 1553 -21988 1210
- -21988 1952 -21988 1490 -21988 1779 -21988 1644 1786 1962 -21988 1488 1645 1494
- 1596 1932 -21988 1936 -21988 792 -21988 1482 -21988 1964 -21988 1870 -21988
- 1939 -21988 1135 1530 1062 2019 1943 2227 1175 590 1880 1620 1866 1356 1962 950
- 1593 1942 1807 1846 1459 2077 1476 -21988 1237 2034 1964 -21988 1925 -21988
- 1973 -21988 1966 -21988 943 2104 948 1794 1858 -21988 1799 1666 1806 -21988
- 1470 2265 1940 1630 1859 1451 1414 -21988 1747 -21988 1777 -21988 1911 -21988
- 1757 2288 1928 -21988 1188 960 1860 -21988 1311 1754 100 { m20} R 1842 -21988
- 1926 -21988 1415 2081 780 2009 1885 1476 1860 2017 1928 -21988 1774 -21988 1770
- 1704 1646 1908 1881 1994 1733 -21988 1506 1754 1847 2026 1605 2050 1936 2117
- 1464 -21988 1835 -21988 1884 -21988 1930 1104 1579 -21988 1932 1091 1590 2086
- 1366 1982 1466 -21988 916 509 1695 -21988 1564 -21988 1841 -21988 1509 -21988
- 1807 -21988 1885 2144 1516 -21988 1964 1634 1860 2062 1552 2180 1912 -21988
- 1768 -21988 1645 1941 1868 -21988 1777 -21988 1904 -21988 1702 1806 1959 -21988
- 1286 1711 1861 -21988 1213 -21988 1775 1800 1889 -21988 1926 -21988 1888 1578
- 1472 -21988 1572 -21988 1783 -21988 1649 -21988 1709 1588 1845 -21988 1461 2022
- 1596 783 700 -21988 1536 -21988 1460 -21988 1875 -21988 1826 2207 1833 1791
- 1787 256 685 1750 1869 -21988 1161 -21988 440 -21988 1676 2075 1536 2074 1116
- -21988 1869 -21988 1883 1606 1659 -21988 1619 749 1857 -21988 1522 -21988 1922
- -21988 1930 1987 1602 1604 1105 2085 1164 854 1795 1564 1664 1829 1593 1966
- 1808 2227 1741 -21988 1934 1399 1756 2024 1813 -21988 1657 1511 1771 2224 1593
- 563 1607 2045 1654 1508 1390 2081 1411 1785 1610 1802 100 { m20} R 1930 -21988
- 1644 2038 1574 -21988 1911 2164 1330 2321 1646 -21988 1885 -21988 1847 2055
- 1747 1969 1406 469 1755 1592 1941 -21988 1885 2098 1734 -21988 1626 -21988 1397
- 1130 1786 2137 1886 -21988 1858 -21988 1758 -21988 1803 -21988 1236 -21988 1284
- 1771 831 1875 1880 1784 1785 -21988 1585 1626 1913 -21988 1907 -21988 1670
- -21988 1584 -21988 844 -21988 1554 -21988 1941 1947 1284 894 1521 1294 1941
- 1658 1305 2031 1556 2023 1514 2015 1097 2288 1972 2015 1813 -21988 1776 1720
- 1645 -21988 1814 -21988 1922 1887 1821 1573 1619 1887 1530 -21988 1866 -21988
- 1878 -21988 1480 -21988 1835 -21988 1915 1644 1753 1463 1950 2132 1796 1916
- 1945 -21988 1548 2042 1679 -21988 1958 1680 1584 -21988 1091 -21988 1954 -21988
- 1888 -21988 1783 -21988 1672 1896 1845 -21988 1953 2021 1765 1717 1884 -21988
- 976 2056 695 -21988 1948 -21988 1694 -21988 1868 -21988 1854 1700 1682 1873
- 1617 1852 1575 -21988 1649 1474 1595 -21988 1035 -21988 1839 1954 1818 -21988
- 1899 -21988 1463 -21988 526 1836 1628 1663 1928 -21988 1904 1585 1653 1676 1600
- 1970 1899 2096 1801 1948 1860 1556 1863 1943 1790 -21988 1854 2222 100 { m20} R
- 1828 1637 1574 -21988 1711 1648 1970 -21988 1929 -21988 1952 -21988 1730 -21988
- 868 627 1920 2044 1897 -21988 1729 -21988 1266 1746 1264 1291 1890 -21988 1856
- 1933 1515 -21988 1818 1891 1853 -21988 1554 1319 1656 -21988 1944 -21988 1606
- -21988 1929 1163 1511 1609 1802 1980 1598 -21988 1449 2234 1147 1855 879 2026
- 1950 -21988 1920 2307 1394 -21988 1898 -21988 1641 1603 1938 -21988 1729 -21988
- 1493 -21988 1812 -21988 1514 1156 1967 1274 1487 -21988 1643 1969 1274 1947
- 1888 -21988 1849 -21988 1296 1850 1889 -21988 1947 942 1683 1645 843 2096 1871
- -21988 1581 1524 1871 -21988 1615 1589 1681 1846 1797 2267 1381 1455 1830 1672
- 1011 -21988 1842 1576 1689 1409 1858 1768 1549 -21988 1838 1643 1897 836 1595
- 1581 1890 1942 1743 1216 1949 1933 1810 -21988 1471 2094 1967 1251 1835 1869
- 1890 -21988 1665 -21988 1256 1769 1580 -21988 1939 2255 1837 1758 1263 1631
- 1838 1926 1484 -21988 1920 -21988 1572 2136 1750 -21988 1948 1901 1794 -21988
- 1516 -21988 1857 -21988 1735 1675 1870 1469 1804 1794 1858 -21988 1429 2062
- 1829 649 1933 -21988 1768 -21988 1741 2173 1914 1691 1828 1957 100 { m20} R
- 1951 -21988 1317 1887 1817 1152 1687 2042 1422 -21988 430 2225 1914 -21988 1879
- 1593 1923 -21988 1564 -21988 1158 -21988 1529 1698 840 -21988 1718 2258 1890
- -21988 1921 2014 1263 1112 1558 2222 1513 -21988 1755 1509 1854 2268 1628
- -21988 1454 1650 1912 -21988 1452 1459 1802 -21988 1945 -21988 1873 1953 1955
- 802 1745 912 1800 1682 1708 1666 1408 -21988 1584 1325 1797 1713 1739 -21988
- 869 -21988 1727 -21988 1361 -21988 980 1713 1782 2053 1885 -21988 1479 1958
- 1390 2093 1634 2203 1230 1777 1522 -21988 1882 1731 1856 1392 1716 2086 1526
- 2162 1483 2026 1714 1044 1847 -21988 1241 2023 1129 -21988 1939 -21988 1734
- 1136 1866 -21988 1052 2102 1881 1853 1758 1847 1931 -21988 1351 1802 1679 1712
- 1731 -21988 1660 -21988 1193 -21988 1844 -21988 1807 1895 1793 -21988 1873 1834
- 1175 -21988 1963 1467 810 1024 1895 -21988 1756 1257 1788 2236 1370 2245 1394
- -21988 1942 1490 1783 -21988 1890 -21988 767 1623 1022 -21988 1756 2219 1476
- -21988 1767 2202 1564 -21988 1256 -21988 1895 2077 912 1774 1931 1744 1674
- -21988 1779 1838 1423 -21988 1650 -151 1609 -21988 1927 841 1494 1718 100 { m20
-} R 1915 -21988 1611 1743 1689 -21988 1796 2073 1891 2257 1618 -21988 1616
- -21988 1676 -21988 1518 1895 827 -21988 1959 -21988 1899 -21988 1961 1717 1598
- 1857 1068 1948 1915 -21988 1321 1532 1835 1548 1885 1479 1378 -21988 1576
- -21988 1589 -21988 1631 -21988 1962 2135 1459 -21988 1952 1740 1822 1787 1715
- -21988 1816 1645 1903 -21988 1865 1969 1877 1717 1924 2237 1923 -21988 1820
- -21988 1918 1304 1378 1587 1627 -21988 1196 -21988 1870 1521 1730 -21988 1189
- 988 1750 -21988 1562 2185 1752 1260 820 1739 887 2204 1824 1749 1616 -21988
- 1472 1918 1760 -21988 1958 -21988 1955 1922 1971 -21988 1309 -21988 1725 2054
- 1961 1507 1271 -21988 1866 -21988 1565 1881 1821 1484 1914 1701 1764 -21988
- 1461 -21988 1942 1373 1566 1667 1405 -21988 1946 -21988 1367 1539 1723 2208
- 1848 2153 1899 -21988 1563 -21988 1933 2241 1666 -21988 1412 1415 1943 1598
- 1797 -21988 1699 -21988 1811 -21988 1851 2150 1780 1785 1767 2297 1781 -21988
- 1662 1729 1850 1657 1600 1829 1363 1151 1693 -21988 1402 1989 1287 2134 1695
- 2084 1847 -21988 1922 -21988 1936 1747 1895 -21988 1631 -21988 1825 -21988 1819
- -21988 1748 -21988 100 { m20} R 1361 -21988 1578 1807 1639 2016 1715 724 1910
- 2295 1499 -21988 1507 2018 1766 2020 1248 -21988 1573 -21988 1833 -21988 1913
- -21988 1968 1998 1742 1990 1839 2119 1751 -21988 1877 881 1431 2204 1383 -21988
- 1956 1977 809 -21988 1936 1838 1850 1592 1738 2291 949 1438 1363 -21988 1850
- -21988 1594 -21988 1333 -21988 1885 -21988 1723 2066 1922 -21988 1689 1951 1299
- -21988 1658 -21988 1718 -21988 1879 -21988 1613 -21988 1684 -21988 1947 803
- 1425 1246 1234 1907 1691 1963 764 1928 1877 1918 1167 1504 1945 -21988 1719
- -21988 1661 -21988 1738 2262 1760 -21988 1898 2091 1392 -21988 1955 736 1893
- -21988 1748 -21988 1950 2080 1145 -21988 1811 -21988 1610 -21988 1750 2045 1902
- 1996 1842 1997 1425 -21988 1670 -21988 1401 1485 1908 2042 1849 -724 1680 671
- 1608 -21988 1441 2193 1380 -21988 1816 2080 1902 1999 1940 -21988 1920 -21988
- 1967 -21988 1816 -21988 1676 2187 1907 2017 1754 -21988 861 1669 1229 -21988
- 1769 -21988 1492 -21988 1939 1264 1940 2115 1955 1197 1846 1732 714 -21988 1684
- -21988 1621 -21988 1703 -21988 1179 -21988 981 -21988 1755 1806 1733 965 1934
- -21988 1879 -21988 1830 2176 100 { m20} R 1836 -21988 1829 -21988 1945 1963
- 1551 -21988 1871 1913 1047 -21988 1871 1278 1663 -21988 1410 -21988 1968 -21988
- 1954 1869 1179 2137 1961 -21988 1927 1202 1808 1386 1888 1805 722 1593 1815
- -21988 1659 1099 1962 -21988 1825 2144 1594 1875 1738 1870 1375 -21988 1679
- 1303 1955 -21988 1896 -21988 1873 -21988 1809 2025 1480 -21988 470 -21988 1960
- 2116 1854 -21988 1944 2013 1715 -21988 1550 -21988 1552 2072 1920 -21988 1697
- -21988 1270 -21988 1790 -21988 1841 -21988 1916 -21988 1929 1817 541 -21988
- 1591 2428 1775 -21988 1928 1383 1507 -21988 1587 1603 1762 -21988 1915 -21988
- 1788 -21988 1793 1912 1870 1836 1526 -21988 1454 1118 1964 -21988 1845 -21988
- 1843 -21988 1554 2051 1836 2256 1832 -21988 1778 1311 1337 -21988 1958 -21988
- 1554 2061 1702 2035 1681 -21988 1863 1313 1858 1846 1521 -21988 1855 -21988
- 1840 -21988 1910 1472 1794 -21988 1801 -21988 1578 -21988 1949 1696 1799 -21988
- 1561 -21988 1954 -21988 1545 1075 1863 -21988 1780 2025 1769 1902 1234 -21988
- 1566 -21988 1863 2110 1965 -21988 1840 2048 1826 -21988 1706 -21988 1705 1743
- 1849 -21988 1596 -21988 1491 -21988 1205 2148 1684 1522 1931 1664 100 { m20} R
- 1920 1350 1485 1836 1777 -21988 1516 1355 1823 -21988 1547 1370 1287 -21988
- 1855 -21988 1919 -21988 1883 2163 1948 -21988 1926 -21988 1913 1919 1745 1862
- 876 -21988 1913 -21988 1594 -21988 1958 1198 1582 1961 1841 1561 1953 -21988
- 1765 -21988 1383 1578 1675 1736 1901 1133 1783 -21988 1849 1156 1925 -21988
- 1659 468 1820 -21988 1890 -21988 1271 994 1778 1205 1675 1805 1788 2246 1894
- 2257 1924 -21988 1946 2138 1412 -21988 1926 2044 1790 -21988 1557 2081 1930
- 1906 1869 -21988 1910 -21988 1948 1484 393 991 1899 -21988 48 { m20} R 1484
- -21988 616 1854 1140 -21988 1661 1452 1968 -21988 1257 -21988 1751 -21988 1820
- -21988 1182 -21988 1859 -21988 1879 1928 1934 -21988 1896 1719 1887 -21988 1432
- 2015 1765 -21988 1156 -21988 1640 -21988 1753 2061 1476 1699 1692 1748 1816
- -21988 1961 1476 1794 1201 1446 1850 1812 1668 1814 1965 1915 -21988 1800 2217
- 1895 430 1894 -21988 1562 1651 1844 -21988 1935 -21988 1959 644 1802 -21988
- 1461 2093 1123 1652 1380 -21988 1821 -21988 1766 -21988 1586 -21988 1963 -21988
- 1959 2307 1754 -21988 1831 1155 1956 -21988 1961 1845 1068 1143 1896 -21988
- 1972 -21988 1954 -21988 1559 1862 1714 2300 1692 -21988 1541 1832 1972 1146
- 1939 1922 1376 2017 1612 2062 1895 -21988 1461 -21988 1515 -21988 1907 -21988
- 1331 1571 1857 -21988 1664 1453 1873 1889 1489 1970 203 -21988 1583 1962 1821
- 2061 1652 1632 1414 -21988 1876 1204 1762 -21988 1527 1965 1814 -21988 1480
- -21988 1836 2081 1321 -21988 1904 1399 1744 2090 1905 -21988 1455 -21988 1896
- 1740 1938 -21988 1787 1405 1509 -21988 1866 1603 1832 -21988 1653 -21988 1859
- 1741 1449 1464 1102 -21988 1587 -21988 1774 -21988 1912 1830 1961 -21988 1669
- 2246 100 { m20} R 1746 2120 1909 1090 1929 1544 1574 1740 1901 -21988 1808
- -21988 1185 1901 1079 1625 1962 -21988 1889 896 1835 1987 1695 2077 1846 -21988
- 1759 -21988 1224 1628 980 2036 1935 -21988 1916 2066 1671 -21988 1875 -21988
- 1833 1871 1653 1912 1807 1973 1924 -21988 1935 -21988 687 1902 1706 2128 1328
- 1969 1637 -21988 1776 -21988 1947 1869 1678 2036 1683 -21988 1731 1956 1549
- 2034 1918 -21988 1875 2162 1903 -21988 1495 -21988 1864 -21988 1585 -21988 1947
- -21988 963 2007 1894 1568 1783 995 1935 -21988 1162 -21988 1616 1866 1690
- -21988 1572 1590 1638 2221 1346 -21988 1843 -21988 1703 1975 1658 1847 1394
- -21988 1701 -21988 1669 1811 1967 -21988 1652 -21988 283 -21988 1899 1655 1972
- -21988 770 -21988 1923 -21988 1501 -21988 1501 -21988 1748 1701 1935 1971 1937
- 1902 -82 1755 1884 1719 1308 -21988 1773 -21988 1707 1906 1778 -21988 1585
- -21988 1872 575 1379 2015 1766 1980 1943 1532 1817 -21988 1531 -21988 1965
- -21988 1907 -21988 1797 -21988 1310 -21988 1700 -21988 1724 2128 1823 -21988
- 1737 1954 1735 2147 1441 1307 1791 1446 1818 -21988 1699 -21988 1875 2040 1910
- -21988 1772 2065 1487 -21988 100 { m20} R 1952 -21988 1592 -21988 1792 -21988
- 1806 1678 1869 -21988 945 2100 1786 1808 1787 -21988 1646 -21988 1752 1759 1967
- -21988 1655 -21988 1937 1742 1859 -21988 1419 -21988 1434 999 1727 1196 1647
- 2205 1925 2077 1680 1163 1656 -21988 1167 2139 1638 -21988 1949 -21988 1963
- 2163 1609 -21988 1903 2144 1842 -21988 1752 1370 1928 -21988 1973 1862 1077
- -21988 1947 -21988 1697 1774 1888 -21988 1911 -21988 1900 -21988 1798 2099 1720
- -21988 1794 -21988 1921 1345 1623 -21988 1441 -21988 1962 -21988 1798 -21988
- 1908 -21988 1807 1550 1665 753 1089 1945 1692 2212 1961 1881 1904 -21988 1639
- 1391 1688 2224 1057 2044 1893 -21988 1688 -21988 1918 2045 1476 -21988 1814
- -21988 1906 -21988 1495 2183 1089 2133 1936 2042 1824 2076 1267 -21988 1970
- -21988 1823 1998 1900 1282 1838 -21988 1344 -21988 1266 846 1687 -21988 1500
- 1868 1947 -21988 1403 1587 1809 2134 1936 2021 1778 -21988 1212 -21988 1909
- -21988 1837 -21988 1925 -21988 416 1827 1599 1426 1836 1824 1848 1952 1774 1887
- 1826 -33 1804 1305 1917 1905 1441 -21988 1749 1582 1841 2079 1854 -21988 1619
- 1881 1560 -21988 1529 1650 1934 1823 1539 1905 100 { m20} R 1788 -21988 1640
- -21988 1643 -21988 1594 1768 1605 -21988 829 1701 1690 2268 1824 2058 1632
- -21988 1679 1660 1913 1675 1498 1844 1841 -21988 1932 1191 1330 1876 1640 2001
- 1728 2080 1895 2061 1788 2099 1671 2188 1682 -21988 1925 1883 1930 -21988 1587
- 1953 1185 -21988 1812 -21988 1943 -21988 1607 1665 1519 1215 1939 713 1946
- -21988 1911 2125 1938 -21988 1828 2040 1740 1596 1913 1568 1963 1922 1918 1885
- 1900 -21988 1953 2180 1416 -21988 1481 1868 1897 -21988 1614 -21988 1792 -21988
- 1671 2187 1892 2000 1819 -21988 1298 1814 1900 1589 1916 -21988 1901 -21988
- 1710 2280 1959 -21988 1672 1464 1671 2038 1111 1988 1969 1915 1965 -21988 1967
- -21988 956 -21988 1956 -21988 1725 -21988 1717 -21988 1913 1823 1944 -21988
- 1763 2059 1935 -21988 1887 -21988 1060 -21988 332 -21988 1831 -21988 1692
- -21988 1704 -21988 1920 1637 1735 -21988 1758 2014 1894 1960 1971 2105 1781
- -21988 1516 474 1264 -21988 1948 -21988 1494 1691 1893 -21988 902 -642 1896
- -21988 1750 2071 1833 -21988 1596 -21988 1824 1823 1326 1361 1632 -21988 1291
- -21988 1640 1982 1440 -21988 1731 1598 930 -21988 1570 1780 1490 -21988 100 {
- m20} R 1870 1938 1942 1649 1354 -21988 1828 993 1533 2198 1946 2072 1900 -21988
- 1956 -21988 1753 -21988 1427 -21988 943 -21988 1466 -21988 693 2028 1879 -21988
- 1814 -21988 1394 -21988 1652 -21988 1855 1359 1836 -21988 1170 -21988 1952 1956
- 1790 -21988 1383 1681 1815 2236 1217 2320 1620 -21988 1251 1663 1902 1574 1794
- 1283 1447 1312 1771 2159 1957 -21988 1171 1678 1884 -21988 1642 -21988 1220
- 1925 1669 -21988 1935 2188 1925 1542 1708 1977 1598 2306 1651 -21988 1754
- -21988 1574 2174 1771 -21988 1889 -21988 1462 -21988 1782 -21988 1506 1919 1809
- 1189 1932 -21988 1540 1105 1457 2154 1859 616 1931 -21988 1888 -21988 1964
- -21988 1892 -21988 1850 2362 1496 -21988 1015 -21988 1690 -21988 1710 -21988
- 1968 1988 1822 1929 1826 1472 1905 -21988 1857 -21988 1823 -21988 1460 -21988
- 1708 2035 1905 -21988 1587 1526 1466 2080 1886 -21988 1790 -21988 965 1714 1730
- -21988 1772 1729 1693 1904 1539 2065 1869 1938 1680 2161 1866 2226 1945 1856
- 1950 -21988 1369 -21988 1914 -21988 1939 -21988 1464 -21988 1801 2110 1764 2122
- 1932 2223 1276 -21988 1939 -21988 1895 1840 1780 -21988 1853 -21988 1972 1779
- 1962 -21988 100 { m20} R 1403 -21988 1798 -21988 1799 2207 1926 -21988 1946
- -21988 1705 -21988 1127 -21988 1199 -21988 1853 2269 1862 2026 1897 -21988 1869
- 1941 1706 -21988 1806 1786 1308 -21988 1563 -21988 1649 1198 1510 -21988 1811
- -21988 1951 1648 1758 1957 1851 -21988 1912 1936 1954 1730 1940 -21988 1213
- -21988 1642 -21988 1842 1613 1730 2052 1953 2081 1941 -21988 1711 -21988 1927
- -21988 1938 1709 1583 1924 1740 2193 1731 2198 1565 1831 1736 -21988 1832
- -21988 1864 1879 1536 2001 1429 -21988 1876 -21988 1765 191 1045 1872 1799
- -21988 1958 -21988 1895 1527 1945 -21988 1585 2146 1699 2211 997 1374 1922
- -21988 1543 1769 1741 1808 1524 -21988 1739 -21988 1280 2175 1931 -21988 1910
- -21988 1921 1885 1829 -21988 1752 1513 1477 -21988 1252 1823 1765 1385 1654
- 1641 1280 -21988 1845 2029 1663 2053 1891 1615 1941 2082 981 1323 1757 -21988
- 1645 1732 1730 -21988 1594 -21988 1877 -21988 1884 1960 1256 -21988 1787 1910
- 1952 -21988 1813 -21988 1629 2108 1857 1491 1708 1747 936 -21988 1749 2096 1487
- 1712 1788 2267 1961 -21988 1703 1872 1167 -21988 1962 1544 1625 -21988 1406
- -21988 1211 -21988 1889 1651 1906 -21988 100 { m20} R 1825 -21988 1608 2184
- 1541 -21988 1583 2057 616 -21988 1795 -21988 1778 1777 1961 1668 744 -21988
- 1372 1856 1686 -21988 1919 -21988 1699 1314 1864 -21988 785 -21988 1970 110
- 1865 2103 1724 -21988 1239 1620 1844 -21988 1801 -21988 1838 -21988 1867 -21988
- 1906 2045 1612 -21988 1570 -21988 1765 -21988 1799 1440 1933 -21988 1755 1799
- 1876 -21988 1886 2019 1549 -21988 1418 -21988 1895 -21988 1484 -21988 1926 1984
- 1229 1792 1698 -21988 1800 -21988 1616 1647 1880 -21988 1950 -21988 1792 2142
- 1808 1463 991 -21988 1953 -21988 1962 -21988 1627 -21988 1684 1994 1616 -21988
- 1400 -21988 1685 -21988 1752 -21988 1791 -21988 336 -21988 1941 1627 1970 2140
- 1680 -21988 1882 1308 1591 -21988 1677 2183 1612 2120 1861 -21988 747 -21988
- 1966 2070 1225 -21988 1434 -21988 1878 -21988 1115 -21988 1833 -21988 635
- -21988 1656 1934 1793 2014 1774 -21988 1930 1975 1428 -21988 1778 -21988 1219
- 922 1800 -21988 1764 2120 1851 -21988 1911 1838 1818 -21988 1957 2145 1904 1487
- 1943 2291 1439 1629 1756 1841 1838 1673 1887 2018 1881 1939 1560 -21988 1863
- 2129 1850 -21988 1360 -21988 1827 1888 1467 1142 1774 2008 1713 -21988 100 {
- m20} R 1747 1801 1726 1649 1543 -21988 1875 2136 1860 -21988 1795 1385 1879
- 1873 1763 2339 1066 -21988 1791 1931 1124 -21988 1170 -21988 1437 1731 1936
- -21988 1683 1378 1826 1896 1803 1834 1809 1141 1950 -21988 1568 1423 1871 1570
- 1720 -21988 935 -21988 1935 1191 1971 -21988 1904 1606 1922 1706 1933 1737 1635
- 1993 1861 1865 1740 1972 1024 -21988 1885 2003 1949 2018 1776 2105 1818 2326
- 1233 1718 1959 1615 1813 -21988 1819 1860 1788 2054 1774 -289 1862 -21988 1892
- 2075 1821 2034 1921 1909 1562 2013 1418 -21988 1639 1863 1519 -21988 1583 2236
- 1948 1832 1886 -21988 1738 1754 1813 -21988 1412 1973 1949 -21988 1811 -21988
- 1556 -21988 1890 -21988 1883 1605 1544 1554 1888 -21988 1964 -21988 1059 2335
- 1745 716 1935 -21988 1440 -21988 1062 1740 631 2252 1150 -21988 870 -21988 1452
- -21988 1560 -21988 1498 1636 1509 1892 1284 -21988 1968 -21988 1808 2089 1632
- 1297 1866 -21988 1802 -21988 1872 1908 650 2047 1637 -21988 1944 -21988 1650
- 1939 1947 1725 1821 1103 1911 1562 1850 -21988 1544 -21988 1802 785 1830 -21988
- 1340 -21988 1428 -21988 1933 1721 1700 1958 1676 -21988 1502 2211 100 { m20} R
- 1829 -21988 1660 -21988 1952 -21988 1637 1700 1967 1858 1896 2272 1507 -21988
- 1906 1258 998 -21988 1201 1310 1972 -21988 1791 -21988 1766 1731 1951 -21988
- 1850 2074 1942 -21988 1659 -21988 1476 1925 1926 1960 1928 1554 1623 2093 897
- -21988 1621 2093 1740 -21988 817 -21988 1659 2268 1359 616 1767 -21988 1843
- 2269 1967 2207 1464 1876 1671 1746 1944 -21988 1703 1799 1451 1984 1138 2155
- 1760 1992 1967 1798 1937 -21988 1953 -21988 1919 1822 1760 -21988 1412 1293
- 1929 1682 1916 1897 1847 -21988 1954 -21988 1274 2058 1795 -21988 1554 2062
- 1628 -21988 1722 -21988 1865 -21988 1817 1474 1623 1087 1463 -21988 1756 1836
- 1579 -21988 1555 1996 1965 2033 1907 1778 1820 -21988 1951 1908 1671 -21988
- 1966 -21988 1722 -21988 1823 -21988 1274 2258 1181 1724 1872 -21988 1953 -21988
- 1676 -21988 1594 2113 1891 1305 1667 1658 1817 2037 1757 2054 1823 -21988 1778
- 1988 1830 -21988 1831 2006 1922 -21988 1934 -21988 1703 2132 1969 -21988 1673
- 1886 1497 -21988 1415 -21988 1847 -21988 1830 -21988 1717 2083 1789 -21988 1835
- -21988 1497 1973 1957 -21988 1542 -21988 1691 -21988 1794 2233 1503 1719 1265
- 2119 100 { m20} R 1464 -21988 1845 1655 1876 -21988 1441 2359 1902 -21988 1908
- -21988 1510 -21988 1959 1928 1617 -21988 1539 -21988 1793 -21988 1869 -21988
- 1694 -21988 1212 -21988 1170 -21988 1243 1368 1616 1662 1781 1908 1943 1424
- 1672 2016 1972 1748 1031 1589 1879 1657 1404 -21988 1602 -21988 1817 -21988
- 1488 -21988 1137 1620 1175 1786 1675 -21988 1809 -21988 1958 2026 1924 -21988
- 1845 1828 1494 -21988 1947 1892 1049 2162 1626 1725 1720 -21988 1597 1965 1970
- 2088 1835 1593 1614 -21988 1581 -21988 1771 1481 1871 1807 1755 1583 1806
- -21988 1759 -21988 1970 1982 1868 -21988 1872 -21988 1882 1728 764 1491 1796
- -21988 1837 -21988 1784 1568 1931 -21988 1626 -21988 1899 -21988 1970 -21988
- 1857 2097 1285 -21988 1806 -21988 1199 -21988 1952 -21988 1135 -21988 1785
- -21988 1784 -21988 1922 -21988 1752 2133 1034 1532 1942 -21988 1145 1734 1734
- 1706 1832 2034 1401 1928 1920 -21988 1752 -21988 1815 -21988 1392 2051 695 1392
- 1852 -21988 1829 -21988 328 1766 1549 1692 1908 2127 1865 -21988 1846 -21988
- 1866 1700 1594 2281 1775 1850 1027 1982 1874 2068 1584 2198 1710 -21988 1760
- 1753 1843 1660 1837 1667 1480 1561 100 { m20} R 1722 1632 1395 -21988 1796
- -21988 1769 -21988 1562 -21988 1787 -21988 1524 2019 1048 -21988 1564 1183 1683
- 2018 1613 1564 1764 1458 1370 -21988 1648 1360 1367 1540 1968 -21988 1864
- -21988 1728 -21988 1891 -21988 1853 2152 1389 -21988 1892 2172 1479 -21988 1945
- -21988 1869 1892 1759 2164 1864 -21988 1768 -21988 1939 2092 1613 -21988 1966
- -21988 938 1874 1756 1879 1269 1959 1631 -21988 1515 1872 1607 1769 1915 -21988
- 1943 -21988 1817 1730 1894 -21988 1921 1873 1242 1840 1913 -21988 1529 2040
- 1779 -21988 1827 1101 1409 1699 1677 -21988 1419 -21988 1924 1826 1766 2282
- 1771 -21988 1047 -21988 1831 1595 1280 1271 -68 2207 1840 -21988 1600 -21988
- 1485 2012 1365 1536 1820 -21988 1903 -21988 1949 1938 1461 -21988 1944 -21988
- 1957 1943 1220 -21988 1969 -21988 1809 -21988 1549 1906 1859 -21988 1715 -21988
- 1967 975 1662 -21988 1950 2335 1613 1878 1952 -21988 1879 2070 1410 2010 1940
- 1524 1957 -21988 1260 2298 1728 2303 1929 -21988 1634 2058 1380 -21988 1796
- 2105 1543 1917 1739 2159 1281 1785 1644 -21988 1886 1809 1428 2176 1745 -21988
- 1950 -21988 1934 1670 1968 -21988 759 1504 1657 1514 100 { m20} R 1828 -21988
- 1918 -21988 1366 2142 339 1823 1757 2080 1864 1668 1646 -21988 1604 1959 1839
- 1932 1905 -21988 1830 2102 1968 -21988 1479 1758 1792 1376 1767 -21988 1965
- 1905 1865 1832 1692 -21988 1694 2106 1826 1680 1948 -21988 1651 1760 1695
- -21988 1537 -21988 1000 -21988 1810 -21988 1958 1786 1944 -21988 1628 2064 1963
- 1368 1830 1795 1065 -21988 1897 -21988 1835 -21988 1589 -21988 1504 -21988 1305
- -21988 1890 -21988 1918 1877 1909 1408 1911 -21988 1942 -21988 1630 1905 1565
- -21988 1807 1754 1700 1656 1284 1686 1759 2098 1626 1550 1825 2100 1663 737
- 1963 892 1819 -21988 1723 1936 1624 -21988 962 -21988 1939 -21988 1696 920 1924
- -21988 1919 1778 1964 1966 1768 377 1638 -21988 1767 1694 1742 1951 1052 -21988
- 1332 1660 1909 2263 1837 1986 1946 -21988 1953 -21988 1907 2110 1835 2206 1745
- -21988 1847 -21988 1851 1116 1653 1430 1583 1596 1960 -21988 1187 2148 1789
- -21988 1402 -21988 1391 -21988 1874 -21988 1906 1905 1889 1166 1898 1882 1940
- -21988 1963 -21988 1722 -21988 1486 -21988 1500 -21988 1949 -21988 1387 -21988
- 1747 1978 1436 2186 1764 -21988 1618 -21988 1859 -21988 1972 -21988 100 { m20
-} R 1730 -21988 1887 -21988 1459 -21988 990 -21988 1852 2082 1800 -21988 1392
- -21988 1007 -21988 1948 2024 1418 1921 1907 1932 1478 2199 1336 1730 1766 2185
- 1965 -21988 1711 -21988 1938 2245 1737 -21988 1200 -21988 1774 -21988 1881 1550
- 729 2107 1785 -21988 1382 2035 1757 -21988 726 1553 1455 2066 1808 1249 1965
- 1794 1630 -21988 1893 2148 1841 1868 1909 -21988 1925 -21988 1827 -21988 1694
- -21988 1943 1169 1887 1071 1621 1275 1429 1471 1517 -21988 1536 1718 1832
- -21988 1725 1496 1602 -21988 1885 -21988 1883 1760 1864 -21988 1301 875 1793
- -21988 1794 -21988 1770 1937 1903 -21988 1821 2038 1868 -21988 1848 -21988 1602
- -21988 1845 1812 1883 1971 1857 1371 1443 -21988 1620 -21988 1968 -21988 1232
- -21988 1625 -21988 1929 1884 1663 -21988 1806 1863 1951 1682 1625 -21988 1090
- -21988 947 2398 1789 -21988 1469 -21988 1943 2156 1247 -21988 1218 -21988 1279
- 2237 1841 1803 1948 1638 1681 1868 1914 -21988 904 -21988 1439 2087 1187 1325
- 1477 1957 1937 -21988 1818 -21988 1611 -21988 1729 -21988 1895 -21988 1466
- -21988 1632 -21988 1930 -21988 1530 2125 1591 1101 1492 2144 1901 -21988 1965
- -21988 1759 1811 100 { m20} R 1515 1485 1796 1893 1776 -21988 1297 -21988 1889
- -21988 1783 -21988 1931 -21988 1935 2207 1924 -21988 1415 2139 1779 1915 1687
- -21988 1728 -21988 1556 1693 1732 -21988 879 -21988 1666 -21988 1551 874 1675
- -21988 1852 1614 1401 1786 1698 -21988 1847 2192 1667 2208 1964 1453 1205 1662
- 1930 2306 1842 -21988 1660 -21988 1343 -21988 1718 657 1856 1900 1963 1371 1920
- 1412 1926 -21988 1917 1759 857 1870 1643 -21988 1574 2039 1752 2109 1750 -21988
- 1729 -21988 1549 -21988 1741 1829 1875 1568 1728 -21988 1014 2006 1904 -21988
- 1822 -21988 1691 -21988 1776 -21988 1537 2187 1721 640 1781 -21988 1913 -21988
- 1910 -21988 1569 -21988 1187 -21988 1766 -21988 1578 711 1481 1720 1653 1677
- 1886 -21988 1659 2080 1369 2085 1860 -21988 1824 1769 1506 1427 1871 -21988
- 1936 -21988 1483 1743 1388 -21988 1894 -21988 1864 1734 1868 1032 1721 -21988
- 1740 -21988 1886 -21988 1929 -21988 1320 2044 1839 1569 1790 -21988 1808 -21988
- 1448 -21988 1648 -21988 1711 1229 1615 -21988 1890 -21988 1787 -21988 1850 1739
- 1677 2183 1914 1597 1455 1860 1418 -21988 1670 1336 1777 -21988 1925 -21988
- 1763 1369 1957 -21988 1857 1809 100 { m20} R 1944 -21988 1926 2083 1803 -21988
- 1521 -21988 1842 -21988 1707 -21988 1967 1874 1523 1149 1825 -21988 1669 -21988
- 1921 1239 1864 -21988 1852 2129 1941 1550 1832 1709 1748 -21988 1534 2299 1774
- 577 1218 -21988 1524 1206 1362 1782 1721 -21988 1610 564 1924 1947 1564 1957
- 1315 -21988 1422 -21988 1883 2115 1409 -21988 1724 -21988 1789 1475 1960 1130
- 1425 2145 1629 -21988 1766 -21988 1887 1460 1717 2028 1321 2058 1149 1883 1887
- 1941 1025 1637 1968 1883 1271 2145 1612 -21988 1296 1427 1633 -21988 1619
- -21988 1946 -21988 1812 64 1824 -21988 1900 -21988 1885 -21988 1722 -21988 1914
- -21988 1687 2077 1889 -21988 1932 -21988 1969 1034 1243 2044 1954 -21988 1164
- -21988 1951 1476 1542 2047 1609 -21988 1891 -21988 1566 -21988 1654 -21988 1925
- -21988 1934 -21988 1951 1482 1863 1768 1585 -21988 1762 845 1839 1609 1938 1139
- 825 1732 1574 -21988 1792 -21988 1897 1927 1769 -21988 1916 -21988 1963 -21988
- 1336 -21988 1171 1444 1963 2088 1907 -21988 1360 2046 1377 2167 819 -21988 1799
- -21988 1843 -21988 1927 1660 1965 -21988 1627 2061 1710 -21988 1809 -21988 1582
- -21988 940 1681 1875 -21988 1632 -21988 100 { m20} R 1773 1692 1935 -21988 1922
- -21988 1578 -21988 1884 1995 1942 2098 1906 1849 1774 -21988 1654 1319 1928
- -21988 1724 1116 1958 -21988 1819 1987 1881 -21988 1842 1819 1573 -21988 1972
- 2000 1714 -21988 1689 2031 1928 -21988 1883 -21988 1127 -21988 1903 -21988 1792
- 1664 1728 2034 966 -21988 1498 2064 1950 1697 1822 -21988 1583 2066 1390 -21988
- 1945 -21988 1751 -21988 1718 -21988 1634 -21988 1680 -21988 1848 -21988 1694
- -21988 1767 -21988 1718 2049 1597 1581 1825 1889 1911 1359 1951 1772 1923
- -21988 1944 2244 1657 2001 1917 -21988 1954 2125 1955 1931 1857 -21988 1758
- 1972 1862 1712 1374 -21988 1903 1626 1773 -21988 1322 1937 1306 1848 1539 2061
- 1453 -21988 1636 2034 1843 -21988 1842 2347 1955 2043 1893 1771 1893 1779 1945
- -21988 1925 2133 1711 -21988 1836 1852 1896 -21988 1913 2128 1949 1644 932 1985
- 1629 -21988 1700 902 1700 -21988 1841 -21988 1758 -21988 1652 1285 1685 1669
- 654 1564 1707 -21988 1680 2001 1556 -21988 1732 1956 1759 -21988 1955 1010 1640
- 2015 1155 -21988 1672 -21988 1864 1718 1789 769 1502 -21988 331 1793 1772
- -21988 1250 2049 1731 1742 1889 2266 1250 -21988 100 { m20} R 1785 2173 1368
- 1500 1475 768 1930 -21988 826 1846 1263 -21988 1126 -21988 1838 1815 1662
- -21988 1354 -251 1599 -21988 1950 2239 1958 -21988 1533 -21988 1691 2072 1479
- -21988 1811 -21988 1862 2021 1759 1238 1786 1762 1840 2033 1406 -21988 1944
- -21988 1545 -21988 1964 -21988 1792 2074 1972 1665 1961 1796 1950 -21988 1829
- -21988 1490 1292 1822 1676 1447 -21988 1955 2040 1948 -21988 1699 2091 1803 647
- 1813 1438 1820 1812 1724 -21988 1940 -21988 1880 1992 1934 993 1695 -21988 1889
- -21988 1900 -21988 1580 -21988 1332 2070 1609 -21988 1706 1635 1905 2069 1677
- -21988 1150 2132 1082 2263 1925 1516 1313 1308 1848 -21988 1747 -21988 1479
- 1820 1436 1925 1660 -21988 1846 -21988 1930 1551 1372 2040 1501 -21988 1649
- -21988 1627 -21988 1905 1724 1953 2039 1433 -21988 1890 -21988 1944 2221 1054
- 1131 1913 1930 1287 -21988 1389 -21988 1829 -21988 1836 1517 1624 -21988 1687
- 2181 988 1960 1260 2104 1672 -21988 1753 1919 1628 -21988 1920 2240 1787 -21988
- 1605 -21988 1898 2308 1815 1404 1904 1637 1930 -21988 1961 -21988 1735 -21988
- 1635 -21988 1559 -21988 1792 2103 1966 1928 1779 1248 1899 1772 100 { m20} R
- 1735 1565 1892 1498 1617 1950 1799 2151 1875 1767 1874 -21988 1784 2150 1873
- -21988 1949 -21988 1817 1638 938 -21988 1803 -21988 1864 -21988 1400 1943 958
- 2216 1720 -21988 1846 -21988 1744 -21988 1649 1919 1953 2183 1443 -21988 1665
- 1866 1272 -21988 1941 1885 1855 -21988 1971 740 1899 -21988 1961 1916 1565
- -21988 1588 2027 1950 -21988 1750 -21988 1833 -21988 1928 -21988 1897 -21988
- 1923 -21988 1888 2029 1733 -21988 1681 1860 1531 1714 1670 1770 399 -21988 1525
- -21988 1478 1156 1785 2357 1349 -21988 1758 -21988 1787 -21988 1924 -21988 1722
- 1214 1929 1793 1923 -21988 1955 -21988 856 2120 1939 -21988 1788 1742 1786
- -21988 1884 1614 1792 2107 1951 -21988 1944 1958 1433 -21988 1862 -21988 1667
- 2096 1940 2203 1427 2010 1364 -21988 1297 1862 1605 -21988 1810 1831 1842
- -21988 1584 2107 1179 1837 1698 -21988 1897 -21988 1304 -21988 1943 -21988 1910
- -21988 1768 1217 1461 -21988 1859 2151 1257 2097 1322 -21988 1566 -21988 1901
- 1409 1288 -21988 1777 1853 1808 -21988 1694 -21988 1382 -21988 1723 -21988 1840
- 2072 1896 -21988 1216 -21988 1948 2066 1811 1718 1252 2219 1267 -21988 1795
- 1717 1958 1941 100 { m20} R 1214 1599 1915 1036 1338 -21988 1920 -21988 1927
- -21988 1810 -21988 1962 -21988 1412 1555 1971 1235 1828 2083 1587 2046 1869
- -21988 1781 -21988 1095 1816 1294 -21988 1826 -21988 1670 -21988 1849 2209 1932
- -21988 1860 -21988 1867 -21988 1973 -21988 1946 -21988 1417 1393 1440 2017 1715
- -21988 1419 -21988 1246 -21988 1543 1369 1900 -21988 1056 -21988 1968 1965 1416
- -21988 1908 -21988 1828 -21988 1862 -21988 1898 2163 1925 1568 1781 1782 1820
- -21988 640 2030 1893 -21988 922 -21988 1725 -21988 1789 -21988 1536 1868 1786
- -21988 1883 2201 1691 -21988 1459 -21988 1218 2053 1729 2048 1136 -21988 1347
- 2007 1648 1564 1943 2147 1860 -21988 1239 1118 1670 -21988 1329 1555 1556 1900
- 1911 1755 1596 -21988 1061 1881 1706 -21988 1766 -21988 1152 2162 1855 -21988
- 1866 -21988 1848 -21988 1201 -21988 1934 -21988 1753 1943 1919 1923 1860 -21988
- 1555 -21988 1952 2184 1973 -21988 1939 -21988 1941 1753 1926 -21988 1573 1786
- 1282 1845 1811 -21988 1951 -21988 1808 536 1866 -21988 -430 -21988 1840 2064
- 1832 1124 1540 794 1781 1892 1940 -21988 1712 -21988 1299 -21988 1870 2053 1805
- 1431 1938 -21988 1938 2012 1803 1982 100 { m20} R 1654 1980 1505 -21988 1767
- 1842 1372 1554 1963 -21988 1267 -21988 1911 2013 1613 1219 1915 1484 1080 1229
- 1824 -21988 1593 -21988 1936 1999 1915 -21988 1962 1794 42 -21988 1270 1991
- 1658 1666 1845 -21988 1806 1732 1592 2039 1692 1131 1308 1669 1758 -21988 1848
- 1550 1777 1817 1685 1933 1685 -21988 1184 -21988 1643 1946 1462 -21988 1921
- -21988 1570 2016 1858 1804 1814 1966 1963 -21988 1958 1484 1379 -21988 1844
- -21988 1628 2071 1342 -21988 1570 -21988 1818 -21988 1671 -21988 1875 2155 1548
- -21988 1087 -21988 1969 1592 1604 -21988 1861 1884 673 1372 1838 -21988 1590
- 2127 1619 1073 1163 1997 739 -21988 1917 2002 1476 -21988 1765 -21988 1824
- -21988 1636 -21988 983 -21988 1405 1971 1958 1787 1588 -21988 1690 1657 1820
- 1800 1264 -21988 1201 -21988 1682 -21988 1725 -21988 1964 -21988 1169 -21988
- 1597 938 1941 1796 1889 1750 1692 -21988 1928 2105 1930 1330 1319 2003 1808
- 1572 1872 1842 1745 2206 1127 995 1972 2086 1856 -21988 1873 -21988 1931 1776
- 1797 1743 1954 1869 1431 1953 1972 1262 1918 394 1672 -21988 1728 2006 1792
- -21988 1935 2028 1722 -21988 1453 -21988 1421 2194 100 { m20} R 1760 1623 1913
- 1788 1882 2019 1948 -21988 1916 -21988 1565 1959 1892 -21988 1937 2287 1751
- 2321 1808 -21988 1953 -21988 1705 -21988 1940 1789 1899 -21988 1902 2344 1966
- 1921 1086 -21988 1811 1314 1383 -21988 1550 -21988 1299 2049 1726 1769 1940
- -21988 1676 -21988 1911 -21988 1433 -21988 1855 2185 1433 -21988 1305 2234 1699
- 1893 1317 1127 1720 -21988 1875 -21988 1859 1322 1476 -21988 1917 2064 1843
- -21988 1235 1016 1855 1938 1372 1946 1809 2067 1872 -21988 1505 -21988 1564
- 2067 1674 -21988 1249 -21988 1630 -21988 1625 1803 48 { m20} R 1788 1619 1621
- -21988 1782 1981 1925 1050 1147 1973 971 1843 1906 -21988 1722 -21988 1808 2000
- 1952 2007 1925 1842 1954 1976 1613 1776 1789 1575 1765 -21988 1879 -21988 1791
- 1904 1612 2243 1321 -21988 1307 1609 1305 -21988 1949 -21988 1953 -21988 1919
- -21988 1931 1628 1962 -21988 1772 1278 1752 -21988 1866 1822 1137 -21988 1936
- -21988 1883 -21988 1850 -21988 1683 2092 1968 1662 1938 1909 1902 -21988 1898
- -21988 843 -21988 1900 -21988 1695 1949 1315 -21988 783 -21988 1888 1607 1712
- 774 1954 1719 1871 -21988 1468 1709 1670 1791 1926 -21988 1839 1735 1856 1636
- 1964 -21988 1541 -21988 1553 -21988 1892 -21988 1664 1822 1871 2131 1812 2171
- 1442 -21988 1736 -21988 1962 1768 1972 2177 1918 1573 1133 -21988 1835 1780 947
- 2099 1574 1423 1880 -21988 1472 2027 1777 -21988 1756 -21988 1551 -21988 913
- 1428 1887 2079 1636 -21988 1557 1951 1546 -21988 1904 -21988 1497 -21988 1833
- 1651 1746 -21988 1861 -21988 1663 -21988 1302 -21988 1966 -21988 1843 -21988
- 1736 -21988 1473 1186 1588 -21988 1398 -21988 1881 -21988 1681 -21988 1624 1612
- 1790 -21988 1816 -21988 1713 607 1929 -21988 1536 -21988 1871 -21988 100 { m20
-} R 1242 1982 1752 1436 1746 1352 1888 -21988 1947 1981 1405 -21988 1946 -21988
- 1915 -21988 1265 -21988 1597 1782 1854 1629 1621 -21988 1892 -21988 532 -21988
- 1711 1946 1645 -21988 1957 -21988 1767 -21988 1841 2148 1959 1917 1880 -21988
- 1844 -21988 1768 1866 1857 1789 1785 2069 1721 -21988 1828 973 1260 -21988 1914
- 1575 1804 -21988 1782 853 1614 1778 1576 -21988 1848 1876 806 -21988 1728 2063
- 1191 1926 1934 2188 1604 -21988 1750 -21988 1710 1975 1666 2154 1884 -21988
- 1498 -21988 1377 -21988 1663 -21988 1804 1808 1577 -21988 1396 -21988 1721 1722
- 1840 -21988 1802 -21988 1871 1424 1426 1897 1514 -21988 1801 2012 1821 1719
- 1949 1416 768 -21988 1852 -21988 1731 -21988 1450 -21988 1897 1644 1869 1897
- 1867 -21988 1969 -21988 1882 1324 1785 1548 1829 -21988 1862 -21988 1699 -21988
- 1783 -21988 1941 -21988 1677 733 1657 1449 1849 -21988 1762 1611 1623 -21988
- 1585 1677 1720 1937 1844 -21988 1631 1781 1759 2212 1909 1880 1967 -21988 1797
- -21988 1641 -21988 1890 1320 1932 -21988 1604 2090 1916 2344 1209 -21988 1948
- 1410 1723 1979 1947 -21988 1942 -21988 1776 -21988 1650 -21988 1539 723 1711
- -21988 100 { m20} R 991 -21988 1915 -21988 1539 -21988 1657 -21988 1807 -21988
- 1801 2077 1799 -21988 1848 1267 1753 2040 1969 -21988 1881 -21988 1769 -21988
- 781 -21988 1656 -21988 1722 -21988 1786 1823 1786 943 928 -21988 1837 1670 1675
- -21988 1769 1472 1588 -21988 1793 -21988 1596 -21988 1234 1903 1632 1645 1657
- -21988 1846 -21988 1747 1895 1929 1034 1833 -21988 1548 2154 1355 2019 1596
- 1693 1515 1715 1919 2155 1548 1726 1513 1920 1939 -21988 1643 1490 1834 -21988
- 1955 -21988 1698 1608 1736 -21988 1544 -21988 1854 -21988 1325 1437 1555 2051
- 782 1877 1886 1939 1765 -21988 1934 2210 1701 2072 1807 -21988 1730 1856 1449
- 2079 1682 -21988 1972 2193 1945 1348 1675 -21988 1894 -21988 1858 -21988 1473
- -21988 1965 -21988 1793 -21988 1717 1158 1966 1624 1955 800 1972 1513 1927
- -21988 1658 -21988 1476 2199 1711 2207 1811 -21988 1963 1822 1961 1188 1814
- -21988 1946 -21988 899 -21988 1735 -21988 1797 -21988 1504 -21988 1876 110 1189
- 1705 1689 -21988 1498 -21988 1729 -21988 1942 -21988 1818 2177 1717 -21988 1487
- -21988 1912 2333 1532 -21988 1900 -21988 1881 -21988 1833 -21988 1925 1813 1915
- -21988 1758 -21988 1807 1037 100 { m20} R 1447 -21988 1770 1556 1590 -21988
- 1387 1390 1895 -21988 1736 1896 1960 -21988 1075 2006 1471 -21988 1588 1567
- 1963 2116 1671 2145 1003 1929 1388 1382 1967 -21988 1819 1524 820 -21988 1448
- -21988 1434 1816 1543 -21988 1696 -21988 1927 1718 1646 -21988 1472 -21988 1508
- 1948 1954 -21988 1583 -21988 1083 1287 1693 -21988 1904 -21988 1924 2032 1753
- 1354 1380 1855 1657 -21988 1869 1885 1897 1865 1861 -21988 1921 903 1026 -21988
- 1481 -21988 1789 1397 1877 1902 1964 2259 1796 1762 1884 2045 1629 -21988 1604
- 1648 1911 1621 1859 -21988 1934 -21988 1801 1754 1690 2285 968 -21988 1428 1676
- 1346 -21988 1960 1952 1957 -21988 1949 -21988 1648 1612 1101 2282 1793 1783
- 1185 1724 1817 -21988 1852 1833 1876 -21988 1761 -21988 1734 -21988 1741 1586
- 1586 2072 1440 1672 1951 -21988 1818 -21988 1867 1499 1954 1924 1556 -21988
- 1965 -21988 1716 1307 1891 1606 61 1766 1669 -21988 1581 -21988 1903 1824 1850
- -21988 1961 2076 1954 -21988 1956 -21988 1886 2100 1480 2021 1862 1195 1833
- 1748 1840 1930 783 -21988 1961 1150 1559 -21988 1809 1996 1881 -21988 1750
- -21988 1486 2141 1815 2260 1857 -21988 100 { m20} R 1932 921 1860 -21988 1366
- -21988 1149 -21988 1772 2218 1566 -21988 1807 1443 1955 -21988 1852 -21988 1966
- -21988 1956 -21988 1938 1582 1495 -21988 1922 1685 1957 -21988 1714 1972 1756
- -21988 1741 2013 1867 2043 1807 1915 1357 -21988 1797 -21988 1705 2163 1900
- 1655 1308 2113 1659 -21988 1643 -21988 1863 1871 1705 2190 1245 -21988 1929
- 1708 1519 -21988 1869 1780 933 -21988 1352 1818 1958 2042 1707 -21988 1593 1906
- 1883 1362 1748 1879 1926 2162 1804 1654 1969 -21988 1829 -21988 1224 -21988
- 1371 1978 1922 2151 1762 2123 1794 -21988 1704 -21988 1671 1247 1941 -21988
- 1879 -21988 1513 -21988 1954 -21988 1360 1927 1875 2187 1343 -21988 1305 -21988
- 1889 -21988 1878 -21988 1945 -21988 1690 1564 1810 -21988 1763 1588 1220 -21988
- 1770 -21988 1877 1662 1666 1796 1857 -21988 1711 -21988 1788 1956 1565 -21988
- 1890 1912 1884 1840 1967 2168 1807 1709 1634 -21988 1896 -21988 1586 699 1707
- 1697 1727 -21988 1897 1819 1670 -21988 1676 -21988 1926 1773 1965 1894 1736
- -21988 1866 -21988 1783 -21988 1618 -21988 1833 -21988 1972 -21988 1580 1808
- 1504 1953 1508 1834 1835 -21988 1817 2007 1769 -21988 1813 2031 100 { m20} R
- 1613 1812 1791 2282 780 -21988 1910 1885 1890 -21988 1752 -21988 1901 1972 1400
- 1125 1960 -21988 1639 -21988 1706 -21988 1524 2048 1633 -21988 1840 -21988 1295
- 1908 1405 -21988 1892 -21988 1343 2153 1542 -21988 1259 1880 1924 1826 1938
- 1573 1831 1422 1871 -21988 1569 -21988 1919 -21988 1612 -21988 270 -21988 1678
- -21988 1503 1231 1746 -21988 1886 -21988 1883 1452 1938 -21988 1369 -21988 1513
- -21988 1906 1665 1571 1743 1955 1680 1825 -21988 1966 2155 1890 -21988 1738
- 2248 1894 -21988 1695 2162 1832 1453 1519 2184 1967 2069 1615 1997 975 1509
- 1867 -21988 1915 -21988 1062 452 1594 2038 1812 1897 1929 -21988 1816 -21988
- 1849 -21988 1654 -21988 1830 -21988 1790 1809 1554 2142 1885 2004 1901 -21988
- 1941 -21988 1917 -21988 1905 -21988 1947 2095 1935 -21988 1851 1957 1343 -21988
- 1835 -21988 1594 1590 1825 -21988 1826 -21988 1953 2147 1581 -21988 1848 1905
- 642 -21988 1949 -21988 1839 2160 1949 -21988 1495 -21988 1971 1919 1585 2093
- 1787 -21988 1907 -21988 1086 -21988 1862 -21988 1930 -21988 1948 -21988 1972
- 1860 1558 -21988 1913 -21988 1778 2087 1806 2098 1953 1807 1904 -21988 1713
- 1573 1615 1857 100 { m20} R 1566 -21988 1823 2123 1439 -21988 1913 2144 1378
- 1613 1855 -21988 1286 2234 1767 -21988 707 1116 1696 -21988 1937 -21988 1118
- 1737 1860 1593 1849 1955 1845 -21988 1919 -21988 1037 1734 1789 2094 1821
- -21988 1777 -21988 1919 1742 1736 -21988 1802 -21988 1909 -21988 1375 -21988
- 1896 1968 995 -21988 1620 2014 1888 -21988 1750 -21988 1795 -21988 1508 2028
- 1549 -21988 1336 -21988 1634 -21988 1759 -21988 1932 2017 1590 -21988 1650 1220
- 1430 -21988 1924 -21988 1836 -21988 1928 -21988 1779 2275 1682 -21988 1913 1959
- 1815 1988 1718 1718 1904 1653 1363 -21988 1679 -21988 1943 1529 1926 1878 1764
- -21988 1346 -181 623 2076 1840 1786 1947 1476 1908 1746 1455 2225 1940 -21988
- 1908 -21988 1574 -21988 1560 -21988 1873 -21988 1253 -21988 1859 -21988 1461
- -21988 1756 2034 1861 -21988 1475 1597 1617 -21988 1136 -21988 1856 -21988 1947
- 1900 1684 -21988 1906 -21988 1532 1875 1715 1296 1909 -21988 1799 2074 1550
- 1717 1613 2016 1938 -21988 1781 1522 1752 1581 1173 1845 1671 1329 1899 1474
- 1303 1141 1414 -21988 1247 -21988 1057 -21988 1854 2164 1712 -21988 1701 1709
- 1520 -21988 1712 -21988 1573 2077 1962 1884 100 { m20} R 1946 -21988 1924
- -21988 1678 -21988 1878 -21988 1894 -21988 1880 1841 1971 1593 1926 1234 1431
- 2187 1650 1683 1944 2137 1910 2213 1828 -21988 1872 -21988 1920 -21988 1877
- 1983 1952 -21988 -14 -21988 1321 -21988 1184 2219 1958 -21988 1825 2175 1900
- -21988 1973 -21988 1800 -21988 1843 -21988 1757 1771 1811 -21988 1511 2008 1261
- -21988 898 1959 1958 1801 1855 -21988 1918 -21988 1735 -21988 1965 -21988 1942
- -21988 1940 1147 1456 1844 1710 -21988 1115 -21988 954 1496 1718 -21988 1961
- -21988 1776 2186 1619 1565 1782 2025 1616 -21988 1645 -21988 1829 1957 1861
- -21988 1667 514 1573 905 1631 -21988 1875 -21988 1678 -21988 1824 -21988 1722
- -21988 1642 -21988 1824 -21988 1967 -21988 1896 1585 1817 1404 1756 -21988 1967
- 1572 1785 1959 1953 1135 1846 -21988 1972 -21988 1493 2076 1765 1864 1383
- -21988 1824 1363 1621 -21988 1689 -21988 1326 -21988 1967 2224 1693 1612 1799
- -21988 1449 -21988 1929 -21988 733 -21988 1914 1720 1484 1381 1920 -21988 1562
- -21988 1436 1933 1408 -21988 1711 2021 1684 -21988 1754 -21988 1185 2255 1872
- 1631 1558 2195 1919 -21988 1813 1916 1617 -21988 1378 1949 1063 1759 1595
- -21988 100 { m20} R 1516 -21988 1488 1671 652 1830 1046 1696 1936 -21988 1574
- -21988 1758 -21988 1490 1981 1554 2071 1926 -21988 1865 1974 1077 -21988 1929
- -21988 1705 -21988 1924 -21988 1944 -21988 1885 1713 1939 -21988 1910 1116 1958
- -21988 1048 2142 1859 -21988 1698 -21988 1838 -21988 1372 -21988 1665 1985 1484
- -21988 1440 1667 1714 -21988 1926 -21988 1770 -21988 1529 -21988 1367 1895 1852
- -21988 1765 -21988 1858 -21988 1542 2059 1210 -21988 1376 -21988 1849 1903 1487
- -21988 1860 1689 1964 -21988 1591 1947 1971 -21988 1509 -21988 1765 1849 1008
- -21988 1908 2174 1922 -21988 1207 -21988 1894 2104 1633 2047 1851 1777 1529
- 1622 1509 -21988 1701 -21988 1929 -21988 1943 -196 1686 -21988 1923 1760 1698
- -21988 314 1367 1342 -21988 1926 1451 1923 2092 1595 -21988 1807 1957 1924 1341
- 1612 1045 1841 -21988 1112 1423 968 2095 1876 -21988 1859 -21988 1883 -21988
- 1957 -21988 1943 -21988 1914 -21988 1962 -21988 994 -21988 1580 -21988 1882
- 1911 1896 -21988 1541 2181 1871 1726 1788 1974 1805 -21988 1800 -21988 1900
- 2112 1935 1671 1885 -21988 1940 -21988 1850 -21988 1907 1916 1663 1510 1927
- 1226 1884 -21988 1921 1882 1077 -21988 100 { m20} R 1560 -21988 1969 -21988
- 1839 -21988 1607 -21988 1887 929 1421 -21988 1451 -21988 1915 1998 495 -21988
- 1627 -21988 1790 1673 1923 -21988 1187 1679 1856 -21988 1779 1962 1894 1617
- 1801 1604 1633 -21988 1796 1961 1930 1994 1455 2019 1822 2231 1804 1934 1760
- 2134 1948 2019 1582 -21988 1925 -21988 1099 -21988 1231 1771 1969 -21988 1784
- 2140 1945 1948 948 1952 1657 -21988 1540 2117 762 -21988 1968 2076 1424 -21988
- 1960 1651 1891 -21988 1417 2100 1922 -21988 1469 -21988 1646 1471 1173 -21988
- 1789 1099 1278 -21988 1863 2057 1958 2129 1903 1862 1671 1796 1804 -21988 1827
- -21988 1964 1575 1690 -21988 1817 -21988 1639 1705 1560 1895 1373 -21988 1441
- 1611 1918 -21988 1916 1339 1955 -21988 1716 1721 1780 631 1202 2125 1714 2004
- 1882 -21988 1924 2097 1556 2069 1836 1768 286 1687 1094 1770 1675 1749 1839
- -21988 1801 -21988 1866 -21988 1472 -21988 840 1571 1879 -21988 1458 2181 1125
- -21988 1838 -21988 1578 2065 1727 1581 1683 1349 1549 -21988 1262 2060 1876
- -21988 1803 -21988 1789 -21988 1972 897 1954 2027 1804 2031 1794 -21988 1395
- -21988 1852 -21988 1577 -21988 1497 -21988 1967 2025 100 { m20} R 1186 2065
- 1912 1432 796 1981 1187 1721 1805 2127 1957 -21988 1796 -21988 1956 2101 1824
- 2011 1785 1833 1259 1333 1794 -21988 1934 -21988 1310 2173 1627 -21988 1955
- -21988 1761 -21988 1410 -21988 1790 1479 1176 1582 1931 -21988 1916 1345 1940
- -21988 1930 -21988 1856 -21988 1487 -21988 1938 -21988 1461 1479 1924 1434 945
- -21988 1968 1360 1566 1988 1217 -21988 1689 -21988 1567 1885 1632 1389 1447
- -21988 1524 -21988 1249 1911 1572 -21988 1947 -21988 1360 2142 1821 -21988 1222
- -21988 1768 -21988 1803 1359 1896 1963 1393 989 1243 1977 1791 1769 1612 -21988
- 1935 -21988 1886 2270 1910 -21988 1828 1408 1519 -21988 1957 -21988 1772 2252
- 1200 1470 1478 -21988 1967 -21988 1844 2038 1860 -21988 854 -21988 1749 -21988
- 1970 -21988 464 -21988 1538 -21988 1922 -21988 1831 -21988 1802 -21988 1736
- -21988 1576 -21988 823 -21988 1194 2234 1747 -21988 1875 2224 1937 -21988 960
- 1806 1763 2188 1931 -21988 1398 1857 1892 -21988 1333 -21988 1672 -21988 1490
- -21988 1700 -21988 1915 1969 1603 -21988 1630 -21988 1916 -21988 1906 1850 1741
- 1879 1734 1943 1115 -21988 1763 -21988 1670 -21988 1665 -21988 1847 -21988 1860
- -21988 100 { m20} R 1955 2119 1585 -21988 1715 936 1913 1697 1899 2155 1955
- -21988 1940 1944 1786 -21988 1970 -21988 1876 -21988 1689 -21988 1525 1971 1909
- -21988 1618 2094 1361 1347 1888 -21988 1899 -21988 1167 -131 1839 -21988 1776
- 2003 951 1513 1513 2189 1910 -21988 1923 1333 1690 -21988 1468 1355 1914 -21988
- 1708 2322 1403 -21988 1328 1688 1834 -21988 1844 1340 1757 -21988 1888 2214
- 1266 1928 1952 705 1874 -21988 1598 -21988 1672 1392 1710 2168 1864 2128 1916
- 1497 925 -21988 870 1200 1913 -21988 1955 -21988 1891 -21988 1186 -21988 1922
- 1569 1859 -21988 1928 -21988 1946 1770 1698 -21988 1722 -21988 1804 -21988 1960
- 2203 1882 -21988 1549 -21988 1963 2006 1840 1987 1426 -21988 1938 -21988 1850
- -21988 1935 2073 1712 1540 1742 -21988 1536 1696 1916 -21988 1965 2099 1708
- 1972 1848 1979 1884 2168 1618 -21988 1478 2353 1573 1849 1935 1868 1807 -21988
- 1687 2215 1765 -21988 1892 -21988 1300 2138 1964 1828 1919 -21988 1886 -21988
- 1857 1583 1531 -21988 1844 1390 527 1905 1893 -21988 1521 -21988 1919 2062 1918
- 1673 1863 -21988 1731 -21988 1597 418 1339 -21988 1658 2095 1939 -21988 1886
- -21988 20 -21988 100 { m20} R 1522 -21988 1908 -21988 1600 -21988 1964 -21988
- 1498 2253 1877 -21988 1782 -21988 1538 1608 1943 1898 1765 -21988 1762 343 1894
- 2320 1738 -21988 1636 1998 1886 1748 1402 2152 1665 -21988 1682 -21988 1737
- 1916 1939 1655 1583 -21988 1705 -21988 1703 1624 1902 -21988 1956 -21988 1793
- -21988 1316 -21988 1459 -21988 1528 -21988 1783 -21988 1619 1445 1877 -21988
- 1965 1955 1773 -21988 1687 1940 1571 1101 1800 -21988 1383 -21988 1245 -21988
- 1329 2140 1707 1569 1953 1899 1310 879 1657 -21988 1962 -21988 1153 -21988 862
- 2075 1782 1960 1671 2030 1488 1626 1451 -21988 1443 -21988 1477 -21988 1833
- 1816 1656 -21988 1955 1414 1686 1833 1217 -21988 1759 -21988 1818 838 1742 1938
- 1824 1918 1809 -21988 1118 -21988 1612 -21988 1669 1954 1764 -21988 1731 1914
- 1892 -21988 1695 -21988 1822 1653 1867 1852 1832 -21988 1876 -21988 1682 -21988
- 1925 1804 1756 1738 1605 -21988 1588 -21988 1752 2082 1477 1680 1850 1708 1763
- 1745 792 2026 1070 -21988 1960 -21988 1623 -21988 1809 -21988 1941 -21988 1899
- 1146 1926 1673 1501 1768 919 -21988 1771 1958 1957 -21988 1551 1899 1685 -21988
- 1816 1230 1573 1254 1856 1707 100 { m20} R 1962 2163 1625 2222 1501 1864 1871
- 1134 1717 621 1889 2170 1745 -21988 1892 -21988 1628 -21988 1650 -21988 1900
- 1445 1476 -21988 1534 1731 1196 -21988 1702 1856 1357 -21988 1876 -21988 1933
- -21988 1951 -21988 1264 1000 1779 -21988 1489 2205 1773 1623 1484 1934 938 2197
- 1195 1881 1096 1829 1910 1276 1892 1830 1514 -21988 1780 216 1235 -21988 1511
- -21988 1910 2066 1819 1111 1591 -21988 150 1680 1922 -21988 1890 -21988 1690
- -21988 1887 1994 1819 -21988 1516 2343 1949 1084 1938 1165 1906 762 1874 1687
- 1904 -21988 604 1964 1458 -21988 1330 -21988 1116 -21988 1923 -21988 1649 1565
- 1124 1805 1369 1542 1456 1692 1747 -21988 1835 2115 950 1995 1777 -21988 1881
- -21988 1672 -21988 1209 1793 1824 -21988 1592 2002 1821 -21988 1865 -21988 1128
- 1519 1831 -21988 1952 1697 1914 1482 1877 -21988 1009 2145 1921 1968 897 1747
- 535 2132 1806 -21988 1897 1800 681 -21988 1819 1950 1697 2044 1969 -21988 1637
- 893 677 1810 1769 -21988 1593 -21988 1754 -21988 1888 -21988 1972 -21988 1632
- 2101 1288 2034 1955 1434 1857 1577 1811 -21988 1874 2002 1364 2190 1788 -21988
- 1875 -21988 1822 -21988 100 { m20} R 1791 -21988 1943 -21988 1833 1948 1847
- 1926 1475 -21988 596 -21988 1953 1663 1953 1532 1966 1673 1929 1986 1905 -21988
- 1915 1247 1895 1887 763 1657 1463 -21988 1920 -21988 1755 1976 1917 2019 1864
- 1794 1069 2292 1805 1571 1775 2036 1893 1812 1832 -21988 1644 1747 1713 -21988
- 1133 -21988 1872 -21988 1758 -21988 1967 2001 1465 1594 985 -21988 1835 -21988
- 962 1099 1305 1987 1915 -21988 1860 2077 1893 -21988 1896 1780 1898 -21988 1506
- 1628 1920 -21988 1715 2271 1782 -21988 1798 -21988 1376 -21988 1890 -21988 1841
- -21988 1514 2185 1969 875 1777 -21988 1965 -21988 1618 -21988 1871 -21988 1834
- 1439 1943 -21988 1448 -21988 1923 -21988 1830 -21988 1767 -21988 1790 1752 1654
- -21988 1958 2234 1957 -21988 1614 -21988 1816 1745 1800 2126 1592 -21988 1856
- 1145 1576 -21988 1868 -21988 1958 -21988 1602 1833 1650 -21988 1946 1597 1561
- 2007 1826 -21988 1939 -21988 1748 1633 1742 -21988 1908 -21988 1832 -21988 1651
- -21988 1830 -21988 1927 -21988 967 -21988 1937 511 1782 1642 1747 1605 1674
- -21988 1872 -21988 1945 -21988 1929 -21988 1778 -21988 1598 -21988 1812 -21988
- 1107 1864 1316 1446 1672 -21988 1899 1650 100 { m20} R 279 -21988 1877 -21988
- 1940 -21988 1626 -21988 1762 1928 1735 1594 1822 1123 1689 2131 1764 -21988
- 1725 -21988 1852 -21988 1781 1832 1959 -21988 1945 -21988 1420 -21988 1957
- -21988 1407 1592 1786 2262 1307 -21988 1844 -21988 1767 -21988 1837 -21988 1838
- 1339 1966 2182 1920 1784 1367 -21988 1457 -21988 1599 1837 1633 1869 1534 1787
- 1957 -21988 1777 -21988 1405 1243 1731 -21988 1462 2090 1597 -21988 1970 1987
- 1433 1821 1935 -21988 1644 2203 1889 1496 1819 1238 1776 -21988 482 -21988 1926
- -21988 1944 -21988 1475 2231 1957 1519 1922 1923 1507 1845 1961 -21988 1862
- 2049 1843 -21988 1875 1811 1817 -21988 1594 -21988 1917 -21988 1375 1527 1715
- -21988 1542 1380 1945 -21988 1882 1438 1875 1992 1926 1495 1811 2077 1641
- -21988 1736 1746 1835 -21988 1697 1412 1802 2022 1775 -21988 1314 1893 1654
- -21988 1269 1630 1942 -21988 1849 1990 1957 -21988 -83 -21988 1966 1356 1714
- 1871 1812 -21988 1712 996 1875 1960 1873 2094 1870 483 -951 -21988 1531 1315
- 1711 2042 1969 1341 1242 2241 1791 1696 1805 -21988 1582 -21988 1355 -21988
- 1750 -21988 1933 -21988 1952 1671 1876 1453 1575 -21988 1457 1598 100 { m20} R
- 1961 1633 1263 -21988 1771 1465 1647 1769 1927 1646 1779 1799 1829 1582 916
- 1489 1837 -21988 1284 2169 1651 1989 1900 1569 1352 1800 1876 2076 187 1627
- 1400 1419 1582 2065 1716 2035 1152 1793 1264 -21988 1244 1888 1792 -21988 1615
- 1963 1714 -21988 1860 -21988 713 -21988 1948 1845 1276 2216 1640 -21988 1967
- 1975 1967 1612 1253 2079 1539 -21988 1704 -21988 1543 -21988 1970 -21988 1440
- 1310 1880 -21988 1538 1599 1960 -21988 1616 -21988 1966 1223 1782 -21988 1713
- 1731 1967 -21988 1907 1268 1764 -21988 1563 1899 1789 -21988 1777 -21988 1694
- -21988 1608 -21988 1960 1348 1208 1732 1350 -21988 1667 1979 1636 1204 1265
- 1255 1894 1947 1950 1948 1672 1778 1594 1881 1270 2032 1503 2092 1575 1935 1559
- -21988 1502 1271 1839 1839 1893 -21988 1392 -21988 1583 2274 1834 -21988 1631
- 2084 1696 2025 1619 -21988 1923 1952 1973 2020 1908 1818 1948 2005 1945 1631
- 1588 1903 1915 -21988 914 1408 657 2061 920 2244 1726 1673 1218 1828 1891
- -21988 1583 2083 1947 -21988 1896 1472 1682 -21988 1716 1861 1453 -21988 1139
- 2005 1931 605 1581 1935 1956 -21988 1970 2203 1658 -21988 100 { m20} R 1809
- -21988 1670 -21988 1131 1738 1914 1720 1677 1895 1574 -21988 1536 -21988 1786
- -21988 1685 -21988 1889 1750 1970 1909 1491 2082 1431 -21988 1146 1927 1817
- 1441 1439 1713 1708 -21988 1623 -21988 1904 1123 1813 1306 1618 -21988 1551
- 1399 1730 -21988 1703 2044 1810 -21988 1745 2032 1680 -21988 1920 2266 1957
- 1912 1955 2013 1936 1453 1283 -21988 1765 -21988 1877 -21988 1933 -21988 1925
- -21988 1874 -21988 1849 119 1903 1496 1783 1314 1848 -21988 1734 288 1832 1333
- 1456 1689 1571 2258 1832 -21988 1819 1808 1971 2079 1171 -21988 1564 2177 1935
- 2079 930 -21988 1891 -21988 1501 1758 1873 2226 1820 -21988 1895 -21988 1884
- -21988 1391 -21988 1864 -21988 1385 2038 1934 -21988 1847 -21988 1962 -21988
- 1641 -21988 1538 1974 1897 -21988 1831 -21988 1922 -21988 1953 -21988 1916
- -21988 1855 804 1480 1944 1642 -21988 1121 -21988 1808 1486 1950 1565 1941
- -21988 1125 -21988 1860 -21988 1833 -21988 1523 -21988 1672 -21988 1848 2035
- 1219 -21988 801 -21988 1556 -21988 1767 1881 1852 1921 1570 -21988 1929 2073
- 1617 -21988 1434 1457 1899 -21988 1097 -21988 1851 -21988 1772 2189 1608 -21988
- 1865 2107 1658 -21988 100 { m20} R 1969 -21988 1791 -21988 1882 2201 1885 1545
- 1785 -21988 1944 2213 1677 -21988 1855 1852 1916 2010 1956 2081 1971 1235 1745
- 2195 1448 2020 1534 -21988 1794 -21988 1660 1663 1747 -21988 1817 1626 1860
- -21988 1452 1929 1878 -21988 1751 -21988 1890 -21988 1908 -21988 1788 -21988
- 1900 1963 1741 -21988 1947 -21988 1499 2220 1951 -21988 1615 -21988 1748 -21988
- 1226 -21988 928 965 517 -21988 1188 -21988 1615 -21988 1454 -21988 1896 711 633
- 1254 1670 -21988 1942 -21988 1659 -21988 1941 1259 1873 1538 1846 1126 1955
- -21988 1888 -21988 1511 -21988 1785 -21988 1800 1340 1769 -21988 1969 1390 1954
- 1519 1530 -21988 1851 -21988 1683 1777 1954 1902 1476 -21988 1546 1905 1492
- 2043 1916 -21988 828 1358 1492 -21988 1808 1445 1906 2092 1800 1183 1354 2153
- 1972 -21988 1751 -21988 1681 -21988 1686 705 1511 -21988 1902 1938 1908 -21988
- 1880 1602 1863 -21988 1849 1871 1838 -21988 1819 -21988 1430 2298 1468 1948
- 1461 -21988 1871 1958 1101 2174 1935 -21988 1952 2131 1495 -21988 1330 2045
- 1820 -21988 660 1724 1753 1558 1404 -21988 1878 -21988 1945 -21988 1529 1799
- 1850 1441 1959 -21988 1634 -21988 1812 -21988 100 { m20} R 1624 -21988 1732
- -21988 1866 576 1800 1783 1669 -21988 1201 -21988 1367 -21988 1915 2279 1057
- 2102 1555 1878 1831 1793 1701 2186 1914 -21988 996 -21988 1260 -21988 1816 1748
- 1897 870 1031 2151 646 1264 1503 -21988 1962 1751 1906 1562 1658 2172 1901
- -21988 1844 -21988 1892 1833 1845 -21988 1266 -21988 1703 1395 1952 992 1865
- 2268 1679 -21988 1601 2141 1720 -21988 1851 2133 1706 1908 1344 2122 1825
- -21988 1642 2173 1868 1261 1724 1850 1724 -21988 1865 -21988 1388 1969 1828
- -21988 1353 -21988 1825 -21988 1965 -21988 1420 -21988 1615 517 1924 -21988
- 1214 2204 1858 2109 1636 2256 1800 775 1698 -21988 1838 -21988 1376 2041 1656
- 2272 1884 2013 1538 -21988 1572 -21988 1601 -21988 1453 1663 1233 2312 1934
- -21988 1660 -21988 1858 -21988 1875 541 1629 -21988 1594 -21988 1525 1941 1952
- -21988 1205 -21988 1607 1673 1602 -21988 1892 2268 1906 2017 1923 844 1949
- -21988 1960 -21988 1774 2029 -148 -21988 1970 2224 800 -21988 1873 1751 1061
- -21988 1877 1359 1836 -21988 1856 -21988 1798 1453 1861 -21988 1671 -21988 890
- 1375 1692 -21988 1946 1172 1818 -21988 1634 1936 1450 -21988 1437 639 100 { m20
-} R 1928 1480 1553 2015 1622 -21988 1896 1877 1956 848 1908 1128 1899 1624 1893
- -21988 1663 1491 1786 -21988 1932 -21988 1335 2148 1787 -21988 1409 1754 1887
- -21988 1819 1925 1819 -21988 1958 1931 1719 -21988 1692 2270 1614 -21988 1900
- 2302 1121 -21988 1687 -21988 1815 1721 1815 2095 1923 -21988 1875 -21988 1788
- 1747 1518 1912 1944 2005 1811 2360 1924 -21988 1719 -21988 1393 1525 1851
- -21988 1807 -21988 1817 -21988 1918 1811 1647 1985 1969 -21988 1226 1717 1652
- 2198 1969 1681 1618 1232 1410 1735 1870 1572 1888 1470 48 { m20} R 1671 -21988
- 1357 -21988 1693 1957 1769 -21988 1925 514 1576 2264 1923 1419 1536 1727 1967
- -21988 1929 1437 1859 2085 1917 1786 1789 1532 1742 1970 1267 -21988 1897 814
- 1865 1834 933 1977 1922 -21988 766 -21988 1352 2153 1731 1749 1480 -21988 1926
- 956 1855 1952 1847 -21988 1512 1458 1278 -21988 1779 2125 1791 -21988 1319
- -21988 1912 695 1749 1983 1868 -21988 1906 -21988 1930 1994 1906 -21988 1766
- -21988 1928 -21988 1890 1411 1970 -21988 1953 2089 1970 -21988 616 1585 1842
- -21988 1895 1841 1552 1498 1873 903 1893 -21988 1688 -21988 1346 1700 1921 1932
- 1535 -21988 1881 -21988 1753 1631 203 2033 1521 1638 1750 -21988 1005 -21988
- 1444 -21988 1865 1830 1629 -21988 1450 1487 1955 2218 1924 -21988 1932 -21988
- 1702 2252 1761 1957 1752 -21988 1800 -21988 1964 2013 1737 -21988 1715 -21988
- 1587 2029 1875 2164 1955 1677 1903 -21988 1848 1468 1762 -21988 1880 -21988
- 1733 2032 1521 2098 1817 -21988 1834 -21988 1965 -21988 1855 1762 1757 -21988
- 1926 1336 1947 2157 1614 1628 1588 446 1717 -21988 1547 -21988 1096 -21988 1139
- -21988 1954 -21988 1182 -21988 1726 2128 1876 1454 1953 -21988 100 { m20} R
- 1961 -21988 1838 2058 1867 -21988 1886 -21988 1899 1614 1379 2170 1845 1628 955
- -21988 1887 1528 1656 -21988 1182 -21988 1818 2173 1630 -21988 1923 1783 1747
- -21988 1290 -21988 1861 143 1672 -21988 1724 1391 1939 1733 1903 2010 1707 2032
- 1328 1964 1807 -21988 1905 -21988 1916 -21988 717 2142 1375 -21988 1959 1937
- 1894 1608 1857 1917 1217 -21988 1917 -21988 1698 -21988 1418 -21988 1864 1724
- 1830 2062 1884 2290 1577 -21988 1581 -21988 1971 -21988 1531 2281 1393 1651
- 1911 1700 1667 -21988 1804 872 1435 -21988 1798 2093 1876 2091 978 1604 1885
- -21988 1955 2166 1968 -21988 1761 1727 1744 1529 1236 2194 1916 -21988 1911
- 1444 1023 -21988 1902 -21988 1771 899 1675 -21988 1627 -21988 1835 2085 1421
- 1257 1859 1949 1883 1594 1887 -21988 1390 2116 1796 1934 1924 -21988 1752 1449
- 1228 1535 1636 1548 1768 -21988 1907 2109 1853 1806 1947 1741 1648 -21988 1568
- 2144 1949 -21988 1939 2162 1899 1626 1773 -21988 1924 -21988 1968 1806 1671
- -21988 1374 2002 1923 1050 1481 276 1881 2160 1807 1637 1786 -21988 1720 1434
- 1552 1908 1130 1711 1741 1899 1346 -21988 1229 -21988 1599 -21988 100 { m20} R
- 1906 -21988 1594 1896 1742 1429 1828 -21988 1946 -21988 1529 2024 1843 1256
- 1555 -21988 1514 -21988 1584 2321 1917 -21988 1755 -21988 1261 -21988 1156 711
- 1253 -21988 1969 1648 1306 -21988 1701 1658 1784 -21988 1902 -21988 1944 -21988
- 1902 -21988 1877 -21988 1777 1971 1836 2055 789 -21988 1585 -21988 1688 583
- 1939 1614 1256 1952 1863 -21988 1469 -21988 1552 1879 1266 1910 1331 2016 1768
- -21988 1792 -21988 1130 1641 1873 1867 1619 -21988 1142 1442 1441 -21988 1260
- -21988 1836 -21988 1156 -21988 1524 -21988 1828 -21988 1678 1844 1871 2086 1971
- -21988 1725 -21988 1951 1564 1898 -21988 1968 -21988 1520 2088 1103 -21988 1929
- -21988 1647 1725 1851 -21988 1528 -21988 1649 -21988 1806 1180 1932 1393 1445
- -21988 1425 -21988 1771 -21988 1930 1435 1776 -21988 1922 1811 1959 1923 1895
- -21988 1273 -21988 1864 1596 1187 -21988 1737 1366 1959 1649 1937 -21988 1609
- 1936 1718 -21988 1883 -21988 1918 -21988 1774 -21988 1703 -21988 1695 -21988
- 1629 -21988 1671 -21988 1441 -21988 1811 -21988 1884 965 1727 1972 1834 -21988
- 1907 1800 1883 2031 1682 1437 1680 1332 1552 1998 1789 -21988 1733 1776 1337
- 1564 1901 -21988 100 { m20} R 1881 -21988 1770 1624 1963 1265 1958 1721 1896
- 2095 1929 1085 1933 -21988 1683 -21988 1798 1981 1922 -21988 1702 1726 1625
- 1782 1765 1739 1528 -21988 1619 -21988 1901 2046 1798 1425 1817 -21988 1795
- 1841 753 1551 1965 1695 1460 2160 1722 1390 1536 2068 1690 2261 1581 -21988
- 1566 -21988 1905 -21988 1907 -21988 869 -21988 1887 -21988 1663 -21988 1582
- -21988 1877 1440 1168 1508 1961 1828 1966 1296 1855 -21988 1841 1135 1929
- -21988 1911 -21988 1794 1887 1732 1993 1570 1381 1653 -21988 978 -21988 1585
- 1684 1830 1878 930 -21988 1359 2209 1554 -21988 1965 -21988 1759 -21988 1819
- 2006 1877 -21988 1841 -21988 1712 1932 1732 -21988 1785 2094 1942 1932 1661
- 1475 1784 -21988 1808 1744 1896 -21988 1558 -21988 1090 2204 1912 -21988 1627
- -21988 1665 -21988 1784 1744 1701 -21988 1973 -21988 1822 -21988 1617 -21988
- 1837 -21988 1043 2197 1066 2173 1963 -21988 1962 1766 1170 2181 1892 -21988
- 1262 -21988 1077 2064 1938 1044 1468 2288 1719 2092 1795 1694 1876 -21988 1532
- 1938 1942 371 663 1806 1548 -21988 1964 1947 886 2065 1803 -21988 1889 -21988
- 1891 -21988 1910 -21988 1870 -21988 1932 -21988 100 { m20} R 1835 1841 1656
- -21988 1519 -21988 1127 2063 1775 -21988 1754 2082 1943 1884 1830 -21988 1947
- -21988 1817 -21988 1950 -21988 778 2060 1745 -21988 1960 260 1615 2126 1874
- -21988 910 -21988 1405 -21988 1750 -21988 912 -21988 1470 -21988 1494 2138 1949
- 2091 1470 1892 1866 1870 1572 1836 1696 2028 1493 1840 1480 -21988 1863 1720
- 1812 2166 1846 -21988 1359 1806 1855 -21988 1971 -21988 1503 2170 1932 2051
- 1904 -21988 1872 1951 1973 1781 1135 -21988 1937 -21988 1715 -21988 1910 -21988
- 1748 -21988 1755 -21988 1808 -21988 1858 2014 1930 1913 1383 -21988 1734 532
- 1867 1633 1450 -21988 1088 -21988 1871 -21988 1810 -21988 1763 15 1380 -21988
- 1894 1840 1570 2033 1432 -21988 1884 1703 1820 2057 1725 2197 1848 -21988 1918
- 1752 1930 -21988 1633 -21988 1941 1629 1641 -21988 1395 2033 1926 2263 1890
- 1517 1293 -21988 1675 -21988 1475 -21988 1927 -21988 1645 -21988 1162 2271 1784
- 1018 1768 1861 1657 -21988 1915 -21988 1965 2049 1752 1728 1682 -21988 1839
- -21988 1840 -21988 1690 1795 1768 -21988 1212 -21988 1925 -21988 1963 -21988
- 1668 -21988 1225 -21988 1589 1829 1945 -21988 1911 573 1956 -21988 1936 1110
- 100 { m20} R 1722 1468 1335 -21988 1202 1782 1681 -21988 1746 -21988 1966
- -21988 1921 -21988 697 1863 1611 -21988 1204 2074 873 2194 1920 -21988 1800
- -21988 1117 2078 1097 1740 1329 -21988 1758 -21988 1368 2192 1817 -21988 1788
- 2101 1748 1542 1780 1338 1916 -21988 1455 -21988 1960 2025 1895 -21988 1875
- -21988 1566 1975 1950 1827 1769 -21988 1265 1926 1772 -21988 1878 -21988 1961
- 2100 1903 1357 1410 -21988 1956 -21988 1968 2000 1816 1349 1483 1485 1099
- -21988 1920 -21988 1919 1687 1924 -21988 1838 1871 1554 2063 1791 -21988 1294
- 672 1889 -21988 1832 -21988 1841 1951 1354 2078 1628 -21988 1636 -21988 1686
- -21988 1832 -21988 1649 1859 1801 -21988 1833 1471 700 -21988 745 -21988 1884
- -21988 679 1877 1758 -21988 1942 -21988 1902 1943 1812 -21988 1724 -21988 1202
- 2012 1951 -21988 1265 1706 1579 1258 1900 -21988 1539 1818 1464 1790 1661 1773
- 1487 -21988 1949 -21988 1495 -21988 1888 2016 1932 -21988 1828 -21988 1911
- -21988 1662 -21988 1560 -21988 1577 1651 1766 1809 1893 1854 1962 1548 1839
- 1695 1888 -21988 1824 1311 1890 1610 1867 1331 1683 1590 737 -21988 1687 1702
- 1440 -21988 1920 1771 1586 -21988 100 { m20} R 1888 1194 1808 1327 1876 -21988
- 1630 1625 1731 -21988 1100 1747 1927 1923 1091 -21988 1878 -21988 1436 1860
- 1442 1841 1836 -21988 1852 -21988 1928 -21988 1838 -21988 1904 1614 1179 1737
- 1742 1689 1475 2255 1881 2096 1838 -21988 1577 -21988 1513 1833 1139 1552 1751
- 1691 967 -21988 1575 -21988 1773 -21988 1959 -21988 1748 2066 1400 1875 1320
- 1752 1761 1357 1835 -21988 1702 -21988 1780 2017 1965 -21988 1554 -21988 1863
- -21988 1213 1940 1868 1721 1140 -21988 1509 1484 1649 -21988 1559 1766 1771
- 1644 1935 2031 1942 -21988 1832 2203 1954 -21988 1654 -21988 1830 -21988 1525
- 1498 1798 1816 1941 1671 1649 2019 1890 2045 1713 -21988 1830 -21988 1727
- -21988 1959 -21988 1385 2102 1924 2219 1583 2207 1361 1956 1890 1993 1654
- -21988 1968 2233 1466 1752 1801 1514 913 -21988 1941 1076 1898 -21988 1687
- -21988 1598 -21988 1833 -21988 1692 -21988 1927 -21988 1297 -21988 1672 -21988
- 1894 -21988 1114 2062 1859 1647 1615 -21988 1683 1685 1970 1687 968 1341 1959
- 1471 1771 -21988 1911 -21988 1272 -21988 1664 -21988 1959 1920 1823 -21988 1832
- -21988 1913 -21988 1513 -21988 1959 814 1644 1815 1552 2053 100 { m20} R 1587
- 1732 1797 -21988 1710 -21988 1686 -21988 1897 1272 1470 -21988 1901 -21988 1938
- 1788 1873 -21988 1100 -21988 1657 2121 1337 911 1595 1292 1776 1677 1772 -21988
- 1614 -21988 1376 -21988 1744 -21988 772 1623 738 -21988 1960 1207 1424 -21988
- 1913 806 1747 -21988 1813 -21988 1615 1598 1769 -21988 1714 1040 1760 1265 1951
- 2143 1098 825 511 1394 1856 1634 1576 216 1902 -21988 1608 2045 1952 -21988
- 1195 -21988 1969 -21988 1758 -21988 1581 -21988 1233 -21988 1841 1921 1821
- -21988 1285 2022 1846 1751 1883 -21988 1141 -21988 1968 1790 1539 1429 1492
- -21988 1945 -21988 1611 -21988 1891 -21988 1817 -21988 1645 2212 1945 -21988
- 1651 1434 1954 -21988 1766 -21988 1150 2253 1928 1904 1970 -21988 1861 1885
- 1772 -21988 1455 1513 1943 -21988 1950 -21988 1950 -21988 1759 1552 1364 2025
- 1681 -21988 1920 1861 1873 1610 1880 -21988 1800 1248 1774 384 1701 -21988 1891
- 1698 1557 1987 1946 1582 1779 1560 1957 1986 1687 -21988 1471 -21988 1268 1965
- 466 1346 1333 2152 1957 -21988 1618 1695 1639 1735 1709 2094 1873 -21988 1423
- 2031 1662 1536 551 -21988 1601 -21988 1957 2144 1599 -21988 1516 -21988 100 {
- m20} R 1425 -21988 1789 -21988 1855 2260 1856 2117 1868 -21988 1899 -21988 1781
- -21988 1275 1740 1863 -21988 1700 1878 1808 2137 1732 -21988 1930 1631 -12 1099
- 1860 2055 1645 2011 1953 -21988 1681 -21988 905 -21988 1971 1668 1855 -21988
- 1850 1608 1760 1917 1956 -21988 1912 1899 1830 -21988 1782 -21988 1778 1247
- 1630 -21988 1687 -21988 1589 -21988 1921 -21988 1906 1994 1962 683 1605 1362
- 1774 1768 1364 1669 1674 2253 1895 -21988 1651 1761 1439 -21988 1925 1685 1884
- -21988 1947 1742 1523 -21988 1927 -21988 1378 1955 1956 -21988 1833 -21988 1731
- 1467 1723 2037 1345 -21988 1440 -21988 1637 2040 1873 -21988 1905 1638 1729
- -21988 1805 -21988 1855 -21988 1400 1873 1624 1431 1327 2184 1905 1584 1967
- -21988 1396 1992 1830 -21988 1960 1913 1877 1686 1574 -21988 1645 2169 1785
- -21988 1580 -21988 1851 -21988 1793 -21988 1841 -21988 1903 -21988 1847 -21988
- 1903 -21988 1820 -21988 1816 -21988 1870 2092 1764 1922 1874 1275 1861 1664
- 1666 -21988 1910 -21988 1882 1525 1697 1848 1212 -21988 1695 -21988 1895 -21988
- 1834 -21988 1869 -21988 1839 -21988 1403 2164 -270 -21988 1861 1460 1972 -21988
- 1905 -21988 1953 -21988 100 { m20} R 1907 337 1896 2140 1912 2099 1535 1958
- 1924 -21988 1801 -21988 1772 2360 1488 2193 1061 2053 1810 -21988 1741 1511
- 1961 1570 1880 -21988 1289 1678 1959 2176 1829 -21988 1902 -21988 1810 1676
- 1502 1239 1860 1428 1790 1902 1090 2149 1893 1790 1108 -21988 1480 2043 1970
- -21988 1708 1921 1874 -21988 1765 2008 1719 1828 1973 -21988 1742 -21988 1102
- 2255 1913 -21988 743 -21988 1817 1556 1751 -21988 1467 -21988 1902 -21988 1945
- 1480 1891 -21988 1830 2145 1837 1292 1256 1176 1773 979 1113 -21988 889 1600
- 1637 -21988 995 -21988 1951 -21988 1405 -21988 1618 2117 1734 -21988 840 -21988
- 1576 2174 1517 1483 1949 1876 1901 -21988 692 -21988 1859 811 1664 -21988 1447
- 1987 1790 2075 1792 -21988 1898 -21988 1633 -21988 1797 2042 1117 2120 1693
- 2034 1769 -21988 1611 -21988 1972 1885 1948 -21988 1966 -21988 1667 1789 1798
- 1986 1634 -21988 1793 -21988 1905 -21988 1175 -21988 1420 2112 1319 1811 1957
- -21988 1850 1704 1948 1452 1455 1829 1571 1892 1250 -21988 1970 1719 1939 2130
- 1941 1986 992 -21988 1412 1851 1585 2181 1955 -21988 1763 -21988 1682 1658 1941
- 1959 1547 1378 1400 -21988 100 { m20} R 1967 -21988 1504 1656 1845 2021 1922
- 1713 1427 -21988 1736 -21988 1910 -21988 1787 1581 1840 -21988 1313 -21988 1876
- -21988 1740 2163 1872 824 1964 -21988 1592 1889 1734 1270 1938 -21988 1243 1510
- 1726 -21988 1372 1572 1792 1981 1758 -21988 1890 1518 1675 2048 1208 -21988
- 1638 -21988 1925 -21988 1288 -21988 1950 1622 1954 2045 1952 1704 1642 -21988
- 1778 2357 1102 1491 1794 2174 1535 -21988 1593 1951 1242 -21988 1448 -21988
- 1363 -21988 1942 1986 1959 1438 1699 1586 1739 -21988 1953 885 1913 -21988 1774
- -21988 693 -21988 1788 -21988 1644 -21988 1767 -21988 1884 -21988 1369 781 1884
- -21988 1951 -21988 1211 -21988 1084 1061 1934 -21988 1852 2065 1961 -21988 1799
- -21988 1931 -21988 1941 -21988 1645 1745 1908 2126 1802 865 1614 -21988 1927
- -21988 1710 -21988 1904 738 1735 -21988 1742 1918 1892 -21988 1167 -21988 1762
- 2085 1815 -21988 1729 -21988 1922 -21988 1460 -21988 1536 -21988 1701 1707 1429
- -21988 1206 1834 1740 1820 1904 -21988 1936 -21988 1712 -21988 1930 -21988 1956
- -21988 1946 -21988 1946 1957 1338 1813 1816 -21988 1689 -21988 1700 -21988 1265
- 1461 1925 1285 1665 1876 1481 -21988 1929 1579 100 { m20} R 1344 572 1681 2202
- 1887 -21988 1077 2185 1667 -21988 1831 -21988 1842 1888 1857 1020 1962 1740
- 1877 2083 1922 -21988 1428 1947 1835 1708 1453 1815 1845 1974 1685 1699 1630
- -21988 1941 -21988 1736 -21988 1856 2290 1168 1879 1921 -21988 1903 -21988 1788
- -21988 1317 -21988 707 -21988 746 -21988 1937 1791 1926 1887 1876 2025 1396
- -21988 1891 -21988 1957 2025 1818 -21988 1686 -21988 848 -21988 1394 -21988
- 1547 -21988 1894 1627 1868 1618 1913 -21988 1913 1730 912 1430 1555 1612 1929
- -21988 1694 2106 1081 2108 1639 1772 1467 -21988 1807 1691 1567 1773 1859
- -21988 1707 -21988 1817 2162 1667 -21988 1960 -21988 1612 1860 1834 -21988 1603
- -21988 1292 2268 1244 1835 1937 2304 1430 1568 1698 -21988 1956 1950 1894
- -21988 1614 -21988 1793 1960 1872 -21988 1796 2101 1604 -21988 1569 -21988 1597
- -21988 1776 2046 1810 2052 1637 -21988 1593 -21988 1605 2206 565 1091 1470
- -21988 1902 1761 1527 2149 1668 -21988 1928 917 1444 -21988 1608 -21988 1947
- 1576 1830 -21988 1293 1653 1508 -21988 1957 1822 1439 -21988 1505 2059 1715
- 1652 1246 1867 1684 -21988 1833 2011 1643 1946 1739 -21988 1141 -21988 100 {
- m20} R 1385 1845 1807 -21988 1902 -21988 1228 -21988 1853 1782 1476 -21988 874
- 1354 1273 -21988 1546 2063 1593 2011 1565 1625 729 -21988 1627 2024 1885 -21988
- 1028 -21988 1801 2209 1116 1816 1965 2017 1335 -21988 1523 -21988 1903 1444
- 1836 1953 1803 2113 1439 901 1728 1373 1680 2155 1449 -21988 1735 1953 1938
- 2028 1942 1758 1755 1837 1926 2062 1644 1916 1694 -21988 1830 -21988 1555
- -21988 1735 -21988 1624 -21988 1765 1485 1767 1595 1402 1724 1300 -21988 1833
- 1769 1680 1732 1906 -21988 1671 -21988 1719 1967 1815 1947 1923 -21988 1936
- 2282 1354 1850 1932 -21988 1896 1957 1879 -64 1886 2206 1820 1410 1418 -21988
- 1829 1259 1946 -21988 1668 -21988 1739 1991 1704 -21988 1554 -21988 1653 -21988
- 1950 -21988 1859 -21988 1936 1383 1662 -21988 1956 -21988 1425 1779 1769 1775
- 1749 1317 1941 1097 1875 -21988 1912 1920 1619 1972 1970 1671 1846 -21988 1821
- -21988 1689 2123 1868 2074 1906 -21988 1814 -21988 1622 2159 1601 -21988 1603
- 1930 1888 1318 1903 -21988 1670 1869 1920 2087 1884 -21988 1861 2065 1373 1999
- 1826 -21988 1896 911 1851 2048 1512 -21988 1789 -21988 1705 1751 1709 2137 100
- { m20} R 1366 1391 1864 -21988 1639 1512 1841 -21988 1772 -21988 1143 2225 1260
- -21988 1843 -21988 1631 -21988 1649 989 1741 2030 1860 1524 1903 -21988 1967
- -21988 1862 -21988 1955 1582 1712 -21988 1689 -21988 1868 -21988 1758 -21988
- 1797 1962 1889 -21988 1956 1712 1446 1592 1861 1942 1891 -21988 922 1478 1313
- 1437 1771 2011 1302 -21988 1084 -21988 1895 -21988 1962 1837 666 2003 1631
- -21988 1732 1973 1645 2255 1625 -21988 1816 -21988 1970 -21988 1817 -21988 1602
- 2146 1806 -21988 1560 -21988 1844 -21988 1449 -21988 1955 1753 1654 1531 1953
- 2230 1839 -21988 1361 805 1161 -21988 1768 -21988 1972 -21988 1751 1807 1959
- 1588 1798 1887 1849 1075 1187 -21988 1885 2029 1840 -21988 1794 1179 1154 1221
- 1850 -21988 1939 1951 1971 -21988 1876 -21988 1287 1605 1769 -21988 1004 1869
- 1856 2004 1941 1573 1967 2094 1647 1987 1871 -21988 1288 -21988 1911 2029 1315
- -21988 1318 1891 1736 1154 1768 -21988 1913 1828 1479 -21988 1966 -21988 1694
- 1103 1535 -21988 1956 -21988 1693 2118 1188 -21988 1889 -21988 986 1810 1939
- 1828 1941 -21988 1912 -21988 1886 1535 1912 976 1915 -21988 1780 2095 1762 1284
- 1126 -21988 100 { m20} R 1962 -21988 1932 -21988 1919 -21988 1910 -21988 1824
- -21988 1612 -21988 1756 -21988 1914 1906 1560 2223 1485 2009 1910 -21988 1562
- -21988 1835 -21988 1654 -21988 1455 -21988 1899 2356 1939 -21988 1929 2228 1805
- 544 1863 -21988 1845 1011 1894 -21988 1791 1474 1933 -21988 837 2192 1889 2018
- 1316 2018 1877 1203 1593 2061 1918 -21988 1795 -21988 1631 -21988 1852 1551 696
- 1555 1837 -21988 1489 1790 1677 2187 1896 2095 1797 1760 1677 -21988 464 -21988
- 1842 -21988 1648 1185 1521 -21988 1138 -21988 1373 -21988 1875 1994 1670 1400
- 1830 -21988 1319 -21988 1566 2054 1500 1868 1697 -21988 1595 -21988 1939 1259
- 1784 1786 1860 -21988 1968 1859 1955 -21988 1957 -21988 1180 1918 1802 2091
- 1278 -21988 1395 -21988 1684 2035 1590 2189 1494 -21988 1732 -21988 1781 -21988
- 1485 -21988 792 1755 1951 -21988 1869 1039 1893 -21988 1242 2103 1388 2089 1954
- -21988 1694 1894 1586 -21988 1912 -21988 1724 2160 1809 1834 1826 -21988 1785
- 1531 1861 2057 1923 2119 1873 2213 533 1917 796 -21988 1447 -21988 1911 -21988
- 1184 -21988 1275 1324 1922 1797 1677 2010 1890 2336 1862 2144 1969 -21988 1905
- -21988 1953 1224 100 { m20} R 1709 1791 1828 -21988 1687 2034 1642 2088 1494
- -21988 1897 1766 1560 1879 1900 1596 1622 1994 1869 -21988 1595 -21988 1775
- 1667 1535 -21988 1401 -21988 1487 1665 1489 1862 1558 2008 1358 -21988 1683
- -21988 1720 1854 1860 1125 -293 2320 1739 -21988 1864 1900 1857 -21988 1155
- 1821 1689 -21988 1673 -21988 1835 1539 1732 -21988 1945 1982 1937 -21988 1946
- 2044 1898 -21988 1818 1574 1719 1632 1328 -21988 1855 -21988 1227 1825 1943
- -21988 1723 -21988 1195 -21988 1842 -21988 1892 -21988 1793 2277 1782 1935 1813
- 1387 1561 2141 1301 -21988 1759 1397 1923 -21988 1855 2148 1936 1849 1830
- -21988 1395 -21988 1255 1334 684 -21988 1893 -21988 1503 -21988 1357 -21988
- 1723 1968 1424 -21988 1716 1447 1674 -21988 1401 1514 1946 1717 1902 -21988
- 1291 -21988 1812 1893 1870 2113 1725 1153 1346 -21988 1767 1685 1605 1801 1935
- -21988 1869 2010 1817 1374 1963 1343 1880 1882 1670 1825 1212 -21988 1834 1120
- 1679 -21988 1375 1688 1967 2006 1877 2279 1739 2028 1945 2232 1511 -21988 1387
- 1592 1428 -21988 1799 1657 1954 -21988 1860 1691 1586 -21988 1053 1902 1900
- -21988 1913 -21988 1229 2104 1568 2082 100 { m20} R 1894 -21988 1940 -21988
- 1937 -21988 1289 -21988 1304 -21988 1493 1606 1800 1681 1911 -21988 1457 1631
- 1874 -21988 1409 1729 1933 -21988 1457 -21988 1872 1624 1780 2231 1832 -21988
- 1243 1987 1344 -21988 1957 -21988 1779 -21988 1672 1691 1861 -21988 1803 1961
- 1901 1920 1485 2059 1628 -21988 1573 1986 1543 -21988 1859 -21988 1844 2240
- 1966 -21988 1636 1946 1855 709 1302 -21988 1398 -21988 1839 -21988 1256 -21988
- 1667 -21988 1711 1544 1814 -21988 790 1633 1821 1807 1672 1658 1677 -21988 1748
- 2233 1769 1835 1335 -21988 1332 -21988 1422 -21988 1969 1579 1632 -21988 1690
- -21988 1581 -21988 1758 -21988 1725 1628 1606 -21988 1812 -21988 1512 -21988
- 1641 -21988 1787 -21988 1393 1654 1972 -21988 1948 1934 1922 2036 1864 -21988
- 1502 2401 1971 1533 1016 -21988 1496 -21988 1793 -21988 1896 1767 1935 -21988
- 1965 -1460 1673 -21988 1460 1672 1326 1662 1945 -21988 1966 1777 1768 2141 1899
- -21988 1435 -21988 1789 1657 1696 1889 1344 -21988 1461 1973 1813 949 1857 846
- 1747 1931 1542 1952 1787 -21988 1944 2081 1905 2222 1709 -21988 1886 -21988
- 1722 1613 1818 -21988 1747 1988 1902 -21988 1805 2096 1705 2013 100 { m20} R
- 1256 -21988 1858 2101 1855 1959 1727 -21988 1831 1857 1428 1857 1576 -21988
- 1280 -21988 1845 2152 -56 1742 1857 1121 1899 -21988 1882 -21988 1706 1923 1848
- -21988 1816 -21988 1443 -21988 1026 -21988 1608 1805 1860 2030 1968 -21988 1955
- 1555 1929 1519 1897 -21988 1933 2008 1268 2034 1672 -21988 1857 2255 1745 1480
- 1960 2025 1419 -21988 1471 -21988 1422 2092 1818 2192 1530 -21988 1971 1364
- 1892 -21988 1886 2015 1771 2055 1958 -21988 1537 2050 1725 -21988 1915 -21988
- 1682 1968 1921 -21988 1740 -21988 1828 1792 1826 -21988 1795 -21988 1261 -21988
- 788 -21988 1483 1288 1786 2228 1292 -21988 1702 889 1969 -21988 1757 -21988
- 1722 -21988 1906 -21988 1541 -21988 1930 -21988 1864 1768 1616 -21988 1849 1672
- 1864 -21988 1476 -21988 1876 2250 1857 -21988 1657 -21988 1930 -21988 1864
- -21988 1699 1919 1631 -21988 1598 912 1850 -21988 1898 1843 1964 1615 1638 2039
- 1837 -21988 1894 -21988 1940 -21988 1943 -21988 970 -21988 1751 1802 1466 1746
- 1802 2065 1826 -21988 1657 1214 1919 1530 1700 1868 818 1667 1377 1563 1535
- 1821 1528 -21988 1765 -21988 1878 -21988 1936 -21988 1758 2059 1967 -21988 1944
- -21988 100 { m20} R 1521 1668 1643 2174 1964 2205 1824 1733 1654 -21988 1682
- 1810 1454 2309 1663 -21988 1693 -21988 1634 1917 1860 -21988 1915 2286 1422
- -21988 1793 -21988 1183 -21988 1760 -21988 1908 1696 1847 1980 677 -21988 1946
- -21988 1783 -21988 1886 -21988 1333 2009 1536 1759 1669 -21988 1143 -21988 1291
- 1492 1788 -21988 1411 -21988 992 1147 1730 -21988 1832 2191 1653 2111 1576
- -21988 1843 1865 1303 1014 1831 2106 1969 2155 1515 1733 1781 1595 1911 1447
- 1356 -21988 1777 -21988 1522 1537 1613 1609 1748 -21988 1806 -21988 1645 924
- 1699 2338 1896 -21988 1862 1684 1785 -21988 1440 2011 1719 -21988 1859 -21988
- 1830 -21988 903 1975 977 -21988 1942 -21988 1758 -21988 1587 -21988 1548 2053
- 1735 2066 1972 2099 1922 -21988 1269 -21988 1869 -21988 1826 -21988 1718 -21988
- 960 2230 1741 1922 1038 -21988 1533 1828 1916 1850 1893 1842 1437 1950 1278
- 1796 1551 -21988 1627 1966 1910 1919 1899 1870 1831 1885 1701 -21988 1777 1368
- 1828 -21988 1708 1533 1441 -21988 1751 -21988 1948 1720 1942 2086 1936 -21988
- 1091 -21988 1943 1864 1965 -21988 1665 1627 1760 -21988 1778 -21988 1861 1749
- 1885 -21988 1644 1546 100 { m20} R 1761 2056 1475 -21988 1533 -21988 1970 1786
- 1339 1471 1882 2092 1753 1929 1925 1791 1757 -21988 1912 -21988 798 1953 1721
- -21988 1965 -21988 1936 -21988 1653 -21988 1479 -21988 1948 1968 1917 743 1623
- 2130 1933 -21988 1654 -21988 1008 -21988 1838 -21988 1970 -21988 1943 1267 1519
- -21988 1901 2152 1690 2092 1451 2082 1460 1567 1827 2239 1577 -21988 1782 1540
- 1807 -21988 1856 -21988 1244 -21988 1903 1846 1804 -21988 1799 1632 1567 1205
- 1955 -21988 1966 -21988 1762 -21988 1568 -21988 1868 -21988 1934 1928 1933 1942
- 1805 -21988 1760 1639 1912 1012 1456 2027 1533 1871 1518 1541 1862 -21988 1961
- -21988 1671 -21988 1962 -21988 1945 2043 1866 924 1842 1572 1697 -21988 731
- -21988 1696 -21988 1959 1175 1374 -21988 1723 -21988 1918 1721 1892 -21988 1455
- 1782 1686 -21988 1847 2099 1971 1570 1800 -21988 1705 -21988 1841 -21988 1568
- 1459 1776 926 1816 -21988 1933 -21988 1910 -21988 1941 -21988 1824 -21988 1666
- -21988 1833 1555 1927 -21988 1589 2266 1459 1833 1937 1048 1324 -21988 1919
- 1813 1839 -21988 1624 1041 1516 868 1866 1258 1471 -21988 1552 -21988 1875
- -21988 1612 -21988 757 1769 1801 1981 100 { m20} R 1844 -21988 1939 -21988 1962
- -21988 1934 2075 1134 -21988 1921 2054 1381 1823 1755 -21988 1305 1979 1862
- -21988 1112 995 1929 -21988 774 -21988 1702 -21988 1873 854 1926 1884 1970
- -21988 1608 -21988 1787 1593 1528 2162 1781 -21988 1893 -21988 1889 1243 1333
- -21988 1412 2169 1847 2270 1452 -21988 1724 -21988 1920 -21988 1440 1695 1350
- -21988 1595 1910 1709 1922 1815 2184 1746 -21988 1731 -21988 1789 -21988 1954
- 1765 1949 1338 1864 1452 1552 -21988 1970 2067 1943 -21988 1927 1840 1882 1770
- 1769 -21988 1626 1621 1676 1841 48 { m20} R 1804 -21988 1568 -21988 1681 -21988
- 1767 -21988 1459 -21988 1795 2191 1117 -21988 1895 1443 1434 2212 1935 -21988
- 1774 1485 1773 2012 1777 1659 1479 -21988 1536 -21988 1715 -21988 1920 -21988
- 1270 -21988 1072 -21988 1431 -21988 1436 1951 1500 1703 1630 2072 1944 2058
- 1918 1979 1921 -21988 1847 1847 1863 -21988 1956 2130 1435 -21988 1933 -21988
- 1904 1108 1902 -21988 1506 848 1721 1883 1890 -21988 1919 -21988 1802 1359 1703
- 1726 1662 2176 1966 -21988 1882 -21988 1766 -21988 1895 -21988 1972 2033 1659
- -21988 1362 -21988 1710 2068 1694 1800 1751 -21988 1393 -21988 1883 1900 1793
- 1643 1795 2026 1973 1980 1644 2205 1855 2031 1951 1977 1898 -21988 1672 -21988
- 1564 1161 1877 -21988 1749 1733 1779 1612 640 1556 1626 -21988 1904 1904 1879
- 2098 1927 -21988 950 -21988 1872 -21988 1707 2086 1664 -21988 1713 -21988 1798
- 1992 1740 -21988 1773 669 1842 1636 1467 1782 1388 2229 1771 1943 1882 -21988
- 1463 1738 1966 -21988 1383 1933 921 -21988 1835 -21988 1471 1959 1614 -21988
- 1273 1968 1813 2143 1777 -21988 1916 -21988 1764 1751 1858 -21988 1895 2163
- 1912 -21988 1968 1891 1295 -21988 1726 1978 100 { m20} R 1665 -21988 1892
- -21988 1958 1784 1502 1556 1850 1780 1841 -21988 1773 1657 1920 1952 1700
- -21988 1617 -21988 1035 -21988 1539 -21988 1058 2162 1544 2063 1799 -21988 1895
- -21988 1554 1271 1445 2052 1589 -21988 605 -21988 1768 -21988 1771 -21988 1624
- 1938 1877 -21988 1031 1820 1929 2129 1969 2351 1886 -21988 1936 1077 1403
- -21988 1659 -21988 1440 1687 1396 2003 1862 -21988 1644 2276 1831 -21988 1741
- -21988 998 1855 1855 2219 1615 1918 1616 -21988 1739 -21988 1891 -21988 1843
- -21988 1886 -21988 1650 2153 1757 -21988 1848 2017 1275 -21988 1706 1129 1760
- 2167 1916 -21988 1971 -21988 1920 2202 1614 2026 1961 -21988 1575 1208 1530
- 2154 1881 1505 1601 1871 1436 -21988 1957 -21988 1937 1320 1614 1811 1260 1714
- 1931 2052 1529 -21988 1516 -21988 1684 -21988 1866 -21988 1532 -21988 1928
- -21988 1879 -21988 1926 1900 1872 1989 1055 682 1453 -21988 1949 -21988 1580
- 1768 1784 -21988 1782 -21988 1511 2143 1598 1969 1864 1756 1878 1894 1930
- -21988 1879 -21988 1919 1240 1653 -21988 1207 1552 1447 1832 1802 -21988 1897
- 1955 1857 -21988 1413 994 1733 2174 1544 -21988 1642 -21988 1691 2106 1957 1824
- 100 { m20} R 1956 1743 1720 1356 1699 1362 1876 -21988 1839 -21988 1194 -21988
- 1955 -21988 1742 2086 1878 -21988 1545 -21988 1781 -21988 1933 -21988 1867
- -21988 1609 -21988 1828 2214 1523 1868 1611 1681 1973 -21988 1681 1839 611 2101
- 1676 -21988 1956 971 1438 2024 1642 1798 1503 1434 1354 1968 1753 -21988 1751
- 1744 1576 -21988 1571 1930 1921 -21988 1267 1948 1910 1872 1479 1831 1955
- -21988 1514 -21988 1705 -21988 1871 -21988 1658 1875 1865 -21988 1397 2227 1746
- -21988 1913 -21988 1467 -21988 1741 -21988 1740 -21988 1928 1127 1748 1003 1162
- -21988 1592 -21988 1946 -21988 1693 -21988 1210 -21988 1781 1625 1971 1960 1456
- -21988 1568 1544 1277 1726 1848 -21988 1927 -21988 1912 1789 1408 -21988 1134
- 1507 1878 2167 1906 2137 1580 1428 1737 1356 1898 1778 1918 1971 1306 -21988
- 1459 -21988 1308 -21988 924 2094 1884 1846 1537 1945 1930 1865 1873 -21988 1810
- -21988 1904 -21988 1892 1711 1712 1676 1559 -21988 1656 -21988 1745 2026 1766
- -21988 1804 2043 1894 828 1665 -21988 1592 -21988 1737 -21988 1848 -21988 1938
- -21988 1389 2194 1572 -21988 1920 1107 1762 -21988 1746 2105 1802 -21988 1938
- 1839 1708 1587 100 { m20} R 1801 -21988 1134 1564 1768 -200 1182 -21988 1945
- 1970 1937 1776 1636 -21988 1682 -21988 1743 -21988 1518 -21988 1777 2003 1944
- -21988 1812 1840 1690 2096 1920 1764 1740 1979 1582 -21988 1093 1946 1951
- -21988 1820 -21988 1426 -21988 1504 -21988 1972 -21988 1539 1778 1792 -21988
- 1961 1984 1727 -21988 1947 -21988 1729 1876 1840 -21988 944 2090 903 -21988
- 1723 -21988 1090 -21988 1954 -21988 1906 -21988 1609 1299 1773 -21988 1197 1522
- 1914 1918 1916 1870 1658 -21988 1942 1921 1656 -21988 1876 1408 1669 -21988
- 1902 1304 1836 2079 1509 1986 1307 974 1727 1030 1775 -21988 1821 1813 1539
- 2058 1644 2031 1613 -21988 1497 -21988 1778 -21988 1737 2001 1968 -21988 1551
- -21988 1948 -21988 1331 -21988 1702 2113 1663 2239 1746 703 1635 1927 1946 1928
- 1557 -21988 1935 -21988 1527 2106 1896 2052 1888 1646 1878 -21988 1044 -21988
- 1841 2091 1807 1570 1902 2012 1592 -21988 1655 -21988 1806 1678 1389 2089 1959
- -21988 1966 -21988 1381 -21988 1967 1695 1843 1909 817 -21988 1905 1921 1845
- -21988 1950 -21988 1603 2039 1956 1768 1827 1579 1651 -21988 1955 2090 1222
- -21988 1627 2234 1843 1389 1640 -21988 100 { m20} R 894 2081 1477 -21988 1773
- -21988 1813 -21988 1872 2285 1704 1093 1404 -21988 531 1343 1558 1587 1951 1842
- 1857 1569 1634 -21988 1759 -21988 1901 1931 1908 1910 1326 -21988 1739 -21988
- 1919 1150 1878 -21988 1743 -21988 1760 1863 1808 1993 1505 1983 1676 -21988
- 1587 1417 1894 -21988 1842 -21988 1248 -21988 1758 -21988 1963 -21988 1968 2133
- 1927 -21988 1500 -21988 1785 1680 1694 2033 1932 -21988 1015 2113 1911 -21988
- 1730 -21988 1371 -21988 1876 -21988 1911 1772 1897 -21988 1845 -21988 1414
- -21988 1141 -21988 1927 -21988 1531 1636 1738 -21988 1722 -21988 1531 -21988
- 1868 -21988 1864 -21988 1929 1559 1972 -21988 1888 1701 1783 -21988 1292 -21988
- 1635 -21988 1793 2043 1882 -21988 1716 1715 1866 -21988 1521 2127 1897 1270
- 1618 -21988 1841 -21988 1804 -21988 1654 1880 1147 1482 1810 -21988 1951 2147
- 1721 -21988 1606 -21988 1955 -21988 733 2057 1497 -21988 1623 -21988 1482
- -21988 1666 1842 1821 -21988 1842 2158 1948 1200 1864 1786 1550 -21988 1869
- 1839 1546 1434 1298 1367 1971 2133 1959 -21988 1932 2031 1250 1810 1971 1512
- 1757 2074 1758 -21988 1864 670 1933 2221 1647 2005 1706 -21988 1074 1875 100 {
- m20} R 1739 1698 1901 1395 393 -21988 1899 1968 1763 2029 1804 1897 1931 -21988
- 1834 2087 1898 -21988 1656 -21988 1892 1584 1913 1592 905 -21988 1823 1531 1859
- 2105 1666 -21988 1633 1922 826 1943 1288 -21988 989 -21988 1482 1612 1964 1750
- 1882 -21988 1613 897 916 -21988 1801 1877 1933 1665 1445 -21988 1723 1898 1693
- 1328 1434 2159 1950 1723 1791 1917 1450 -21988 1926 1977 1808 -21988 1402 1445
- 1842 -21988 1647 -21988 1681 -21988 1922 1980 1722 948 1884 1737 1610 -21988
- 1955 -21988 1562 1775 1803 1670 1809 1901 1896 1585 575 2206 1924 -21988 1362
- -21988 1766 1859 1957 2030 1547 2019 1890 2130 1608 -21988 1695 -21988 1788
- 1850 1947 -21988 1682 -21988 1745 -21988 1347 -21988 1928 1531 1878 2003 1817
- -21988 1892 1103 1546 -21988 1888 -21988 1527 1627 1788 703 1880 2183 1421 1560
- 1723 1863 1953 -21988 1954 1891 1888 2099 1969 -21988 1832 824 1793 -21988 1550
- 1943 1773 2011 1926 -21988 1788 934 1878 -21988 1705 -21988 1710 -21988 1577
- -21988 1957 -21988 1613 -21988 1949 -21988 1861 -21988 1931 -21988 1696 1957
- 1790 1769 555 1657 1915 -21988 1687 2035 1566 808 1400 1961 100 { m20} R 1969
- -21988 1781 -21988 1757 1592 1933 -21988 1760 984 1896 1492 1925 -21988 1182
- -21988 1759 -21988 1944 2038 1932 1557 1953 -21988 1820 -21988 1896 2232 1671
- -21988 1916 -21988 1151 -21988 1613 1936 1221 1992 1743 -21988 1712 -21988 1729
- 1621 1928 1931 1787 -21988 1113 -21988 1606 -21988 1750 -21988 1818 -21988 1846
- 1903 1526 1574 1085 1896 1956 -21988 1861 1517 1809 -21988 1943 1971 1760
- -21988 1783 -21988 1837 -21988 1917 1966 1913 -21988 116 1816 1077 -21988 1954
- -21988 1731 2277 1572 -21988 1373 2036 1780 -21988 1731 -21988 1939 1765 1759
- 1637 1890 1517 1763 -21988 1884 -21988 1811 1719 1707 1486 264 -21988 1910
- -21988 1611 -21988 1726 -21988 -69 1965 1726 -21988 1859 1554 1946 -21988 1616
- -21988 1896 -21988 1725 1825 1575 2024 1919 1698 -30 1639 1936 109 1920 -21988
- 1694 2080 1740 -21988 1562 -21988 1935 -21988 1354 -21988 1906 1794 699 -21988
- 1398 1836 1622 1894 1021 -21988 1659 1942 1916 1995 1261 -21988 1817 2021 1922
- -21988 1843 -21988 1109 2115 838 -21988 1373 1934 1777 1875 1183 1062 1892
- -21988 1674 1802 1735 -21988 1972 -21988 1947 -21988 1916 -21988 1546 -21988
- 1793 -21988 100 { m20} R 1777 1753 1623 1650 1662 -21988 1626 2005 1759 -21988
- 1096 -21988 1861 -21988 1451 2145 1706 2085 1927 2043 1860 -21988 1380 -21988
- 1937 -21988 1230 864 1800 -21988 1853 1415 1102 1722 1969 -21988 1908 -21988
- 1573 2012 1946 -21988 -45 -21988 1692 -21988 1933 1515 1853 2238 1477 -21988
- 1685 1745 1163 1848 1603 -21988 1899 1717 1669 2250 1816 2055 1795 2114 1789
- 2122 1921 -21988 1537 2180 1892 2127 1496 -21988 1954 -21988 1738 631 1852 1673
- 1686 -21988 1964 1814 1933 1365 1940 -21988 1562 -21988 1684 -21988 1924 -21988
- 243 -21988 1857 -21988 1574 -21988 1914 -21988 1923 2110 1595 1229 1890 1903
- 1868 1565 1573 -21988 1624 1491 1932 -21988 1455 1758 1949 2131 1839 -21988
- 1307 -21988 872 2051 1532 -21988 1604 1850 1710 -21988 1890 -21988 1542 -21988
- 1414 -21988 1471 -21988 1729 -21988 1484 -21988 1892 -21988 1487 -21988 1911
- -21988 895 1918 1953 -21988 1967 2084 111 2326 1676 1707 1551 2138 1934 -21988
- 1930 1623 1437 -21988 1769 2140 1888 1812 1798 -21988 1730 -21988 1413 -21988
- 1619 2079 1083 2063 1648 -21988 1053 1806 1329 -21988 1954 1859 1569 -21988
- 1616 1982 1971 2263 1916 -21988 100 { m20} R 1851 511 1516 -21988 1728 -21988
- 1963 1877 1803 1854 1472 1533 1812 2046 1919 -21988 1795 2052 1471 1918 1884
- -21988 1561 -21988 1922 -21988 1752 1858 1562 1527 1777 -21988 1799 1913 1551
- -21988 1866 -21988 1902 2234 1521 2173 1267 2070 1971 1930 1571 2117 1845 1973
- 1705 1924 1938 1205 1326 1851 1810 2123 1808 -21988 1879 1271 1286 -21988 1955
- 1290 1869 2006 1698 1653 1689 1200 1335 1853 1564 1699 1682 1327 1676 -21988
- 1879 -21988 930 -21988 1933 -21988 1697 1948 1836 -21988 1944 -21988 1576
- -21988 1532 1708 1733 -21988 1519 -21988 1931 -21988 1657 2145 1258 -21988 1565
- -21988 1773 -21988 1932 -21988 1967 2320 1490 -21988 1831 -21988 1941 -21988
- 1537 1969 1651 -21988 1927 -21988 1941 -21988 1858 -21988 1868 -21988 1909
- -21988 1735 1626 1115 708 1902 -21988 1761 1951 1737 1979 1957 -21988 1917
- -21988 1963 -21988 1702 -21988 1798 -21988 1322 -21988 1798 1486 1959 -21988
- 1931 1880 1590 1861 1836 1220 1146 1783 661 -21988 1947 -21988 1924 -21988 1831
- -21988 1715 -21988 1915 1998 1752 -21988 1929 1746 1944 -21988 1583 1930 1924
- -21988 1497 1092 1776 -21988 1926 -21988 1791 -21988 1868 2164 100 { m20} R
- 1709 -21988 1786 -21988 1741 -21988 1769 -21988 1864 -21988 1469 -21988 1580
- -21988 1902 -21988 1471 1781 1741 1526 1635 -21988 1818 2171 1724 -21988 1852
- -21988 1774 -21988 1828 -21988 1741 -21988 1340 -21988 1529 -21988 1927 -21988
- 1302 2032 1663 -21988 935 -21988 1824 -21988 1890 2179 1755 1740 1039 1480 1334
- 1950 1895 1930 1887 -21988 1900 -21988 1822 1939 1609 -21988 1454 -21988 1178
- -21988 1523 -21988 1947 2121 1319 1907 1582 1208 1781 1895 1701 1605 1953 2181
- 1968 -21988 1401 -21988 1866 -21988 1384 1774 1871 1239 1772 -21988 800 -21988
- 1903 1624 1879 1663 939 1975 1173 -21988 1859 -21988 1492 -21988 1630 -21988
- 1915 -21988 1888 -21988 1740 -21988 1744 1882 1915 -21988 1669 -21988 1964 2129
- 673 1639 963 2070 1633 1914 1606 -21988 1390 1863 1676 1768 1943 1813 1392 2073
- 1930 136 1943 -21988 1741 -21988 1560 -21988 1582 1869 1862 1748 1663 -21988
- 1789 1971 1874 2022 1460 -21988 1323 1995 1816 2163 1968 -21988 1305 1628 1870
- -21988 1478 1827 1800 2215 1896 2113 1781 1700 1449 -21988 1913 855 1893 -21988
- 1038 -21988 1930 -21988 1820 2079 1831 -21988 1899 -21988 1933 1948 1689 1754
- 100 { m20} R 1514 1620 1440 1526 1714 -21988 1875 2033 1537 900 1370 -21988
- 1961 -21988 1784 1953 1923 -21988 1306 -21988 1565 1914 1696 -21988 1790 1828
- 1725 2081 1634 -21988 1879 405 1662 1888 1934 -21988 1239 -21988 1903 1445 1586
- -21988 1361 -21988 1934 -21988 1851 -21988 1911 -21988 1843 1707 1608 -21988
- 1750 -21988 1956 1772 1907 1617 1586 -21988 879 2133 1845 -21988 1783 -21988
- 1761 -21988 1946 -21988 1836 1837 1287 -21988 1721 -21988 1969 -21988 938 2275
- 1937 -21988 1925 2060 1449 2234 1577 -21988 1664 1912 1719 -21988 1209 -21988
- 1964 -21988 1873 -21988 1715 1297 1184 -21988 1815 -21988 1905 1341 1973 2014
- 1972 -21988 793 -21988 1284 -21988 1241 -21988 1900 -21988 1748 -21988 1827
- 1772 1503 2356 1854 2152 1926 2074 1815 1331 1717 -21988 1972 -21988 1778 1498
- 1647 -21988 1757 2068 1799 -21988 1002 1950 1544 286 1603 -21988 1815 -21988
- 1968 1866 1720 2085 1174 1995 1878 1639 1797 1614 1890 -21988 1620 1123 1778
- 2059 1943 1510 1941 -21988 1950 1949 1170 1904 1885 -21988 1436 1876 1868
- -21988 1827 1971 1816 -21988 1933 -21988 1798 -21988 1835 926 1923 -21988 1783
- -21988 1797 1787 1965 1672 100 { m20} R 1902 1782 1954 -21988 823 1725 1827
- -21988 1385 1326 1703 -21988 1808 -21988 1222 1275 1942 1269 1969 -21988 1540
- -21988 1542 1950 1788 -21988 1756 2252 1842 -21988 1965 -21988 1923 -21988 1961
- -21988 1936 -21988 1787 2067 1672 1999 1861 1798 1968 1939 1860 -21988 1752
- -21988 1799 2125 1949 -21988 1627 2039 1880 2023 1941 2057 1703 1070 1791
- -21988 1841 1777 1773 2223 1657 1841 1740 -21988 1353 -21988 1931 -21988 1678
- -21988 1300 -21988 1662 -21988 1836 -21988 1924 -21988 1695 1896 1709 -21988
- 1828 1424 1930 984 1720 1913 1859 -21988 1946 2033 1940 -21988 1894 -21988 1901
- 2201 1954 -21988 1844 -21988 1765 1999 1837 1721 1815 1960 1764 1850 1560 1850
- 1929 -21988 1420 -21988 1677 -21988 1565 -21988 1648 -21988 1940 1489 1923 1420
- 1971 1917 1703 -21988 1410 2049 1738 -21988 1914 1576 1791 926 1888 2111 1743
- 1945 1788 -21988 1962 -21988 1731 613 1874 -21988 1813 -21988 1893 1456 1278
- -21988 1692 1826 1835 2049 1547 -21988 1792 2065 1933 2030 1538 -21988 1927
- -21988 1970 -21988 1797 -21988 1599 1703 1696 -21988 1614 2182 1886 1872 1521
- -21988 1710 2010 1241 -21988 1838 1815 1586 1388 100 { m20} R 1807 1451 1710
- -21988 1836 -21988 1943 2269 1923 1762 1915 -21988 1911 -21988 1566 -21988 1548
- -21988 1773 -21988 1824 -21988 1567 -21988 1859 2115 1788 -21988 1928 2223 1598
- -21988 1900 -21988 1713 -21988 1854 2089 1113 2309 1971 1910 1925 -21988 1651
- -21988 1713 984 1858 -21988 1605 -21988 1785 -21988 1879 -21988 1935 -21988
- 1763 -21988 1732 2080 1487 -21988 1074 1746 1721 1676 1810 1570 1958 -21988
- 1453 -21988 1867 -21988 1973 -21988 1968 2200 1805 -21988 1611 -21988 1972
- -21988 1937 1552 1812 -21988 1961 -21988 1544 1962 1807 -21988 1418 -21988 1644
- -21988 1627 1363 1573 2291 1063 1358 1839 2140 1797 1942 1914 -21988 1416
- -21988 1826 -21988 1777 1330 1678 1854 1927 -21988 1626 1923 1739 1624 1413
- 1339 1505 -21988 1643 -21988 1258 2016 1960 2043 1940 1803 1828 1791 1793 1516
- 1227 1633 1640 2128 1626 -21988 1684 -21988 1931 2010 1541 1874 1236 1778 1548
- -21988 1704 2198 1636 1917 1774 -21988 1785 -21988 1874 1933 1263 1951 1732
- -21988 1448 2248 1775 -21988 853 -21988 1784 -21988 1526 -21988 1283 1724 1389
- -21988 1661 2092 1741 -21988 1919 -21988 1772 2266 1863 1382 1603 -21988 1719
- -21988 100 { m20} R 1948 -21988 1584 -21988 1965 1949 1868 2229 1896 -21988
- 1413 2099 1510 1862 902 -21988 1602 -21988 1825 -21988 1750 -21988 1862 2199
- 1659 -21988 1911 2038 1922 2150 1557 -21988 1800 2092 1824 1917 1951 -21988
- 1455 -21988 1714 1524 1796 2104 1235 -21988 1912 -21988 1583 2073 1932 -21988
- 1937 -21988 1935 1884 1494 1515 1715 -21988 1504 1805 1785 2072 1598 -21988
- 1813 -21988 1724 1952 1494 2002 1807 -21988 1967 -21988 1781 1527 1929 1928
- 1544 -21988 1782 1632 1794 1929 1619 -21988 530 1459 1958 1449 1809 -21988 1569
- -21988 1631 -21988 1457 -21988 1348 -21988 1846 2049 1675 -21988 1805 2029 1758
- -21988 1937 2087 1788 1902 1956 2068 1534 -21988 1908 1715 1970 2090 1959
- -21988 1668 -21988 1958 1860 1922 -21988 1793 937 1869 1991 1662 433 1720
- -21988 1962 1771 1763 -21988 1972 2261 1817 1274 1404 1430 1928 -21988 1813
- 1539 1866 -21988 1646 -21988 828 1977 1613 -21988 1307 -21988 1901 1734 1085
- -21988 1825 1282 1561 1046 1483 2115 1037 643 1396 -21988 1737 -21988 1902
- -21988 1558 -21988 1859 1291 1608 -21988 1636 1597 1857 2125 1881 1693 1821
- -21988 1868 1828 1622 -21988 1008 1178 100 { m20} R 1691 -21988 1382 1476 1816
- -21988 1680 2238 1893 -21988 1698 -21988 1751 -21988 1931 -21988 1097 -21988
- 1931 -21988 1667 1908 1946 1250 1908 -21988 1698 1925 1907 1573 1912 -21988
- 1219 -21988 1902 -21988 1887 -21988 1927 -21988 1408 2139 1830 -21988 1843 2163
- 1424 1911 1700 1734 1725 2077 1723 -21988 1890 -93 1973 1509 1902 1048 1970
- -21988 1921 2161 1602 1434 1503 -21988 1898 1588 1825 -21988 1406 -21988 1920
- -21988 1811 1824 1816 -21988 1947 1464 1760 1513 1833 -21988 1692 1993 188 1620
- 1709 -21988 1866 -21988 1847 -21988 1515 2034 1864 -21988 1668 -21988 1500
- -21988 1602 1647 1776 2259 1783 2033 1523 -21988 1606 -21988 1599 -21988 1773
- 2169 1660 1896 1956 1530 1964 1786 1642 1802 1967 -21988 1915 -21988 1912 1976
- 1592 1626 1433 -21988 1946 -21988 1970 1113 1397 -21988 1643 -21988 804 1377
- 1811 -21988 1767 -21988 1896 -21988 1737 -21988 1860 1995 -113 1847 1526 1628
- 1951 -21988 1356 -21988 1825 -21988 1846 1691 1926 2056 1899 -21988 1565 1686
- 1573 1467 1684 -21988 1706 -21988 1865 -21988 1728 -21988 1895 1922 1536 -21988
- 1843 -21988 1597 -21988 1907 1888 1888 -21988 1663 -21988 1851 1581 100 { m20
-} R 705 -21988 1690 -21988 1279 -21988 1774 -21988 1959 1893 1290 1409 1405 1446
- 1924 -21988 1898 -21988 1941 -21988 1702 -21988 1835 -21988 1734 1779 1605 2194
- 1885 -21988 1939 -21988 1768 1932 1628 1154 1411 -21988 1946 -21988 1905 -21988
- 1445 1865 1628 -21988 1925 -21988 1930 1664 1658 -21988 1327 1326 1710 -21988
- 1967 2188 1797 1939 1852 1630 1963 1700 1939 1900 1914 -21988 1857 1722 1099
- 1975 1946 2028 1866 1634 1912 1872 1668 -21988 1353 -21988 1916 -21988 1843
- -21988 1960 1391 1893 2001 1444 1791 1916 -21988 1862 878 1884 1382 1739 -21988
- 1819 -21988 1521 2186 1876 -21988 1688 -21988 1915 -21988 1462 -21988 1696 1968
- 1155 2000 1486 1651 1421 -21988 1363 -21988 1284 -21988 1865 1920 1748 -21988
- 1694 -21988 1764 -21988 1677 1653 1817 593 1864 1484 1709 2084 1804 -21988 1340
- -21988 917 1880 1960 -21988 597 -21988 1682 -21988 1968 -21988 1775 -21988 1661
- 1967 1488 1596 1867 1710 1936 -21988 1954 2095 1757 -21988 1492 2169 1876
- -21988 1927 1698 1884 -21988 1780 -21988 1924 1587 1371 -21988 753 2186 1841
- -21988 1841 1308 1855 1989 1218 1820 1677 -21988 1563 2108 1961 2043 1870
- -21988 100 { m20} R 1745 1884 1733 1522 1861 2110 1768 1650 1501 -21988 972
- -21988 1960 1423 1934 -21988 1744 1796 1778 -21988 1843 -21988 1620 1333 1889
- -21988 1969 2127 1916 1892 1787 -21988 1964 -21988 1752 -21988 1396 2241 1445
- 1545 1910 -21988 1894 -21988 1952 1824 1896 1461 1692 1736 1886 -21988 1815
- 1641 1769 1554 1797 1148 1862 -21988 1545 -21988 1882 -21988 1918 -21988 1776
- -21988 1625 -21988 1872 1419 1817 -21988 1948 -21988 1783 1745 1583 -21988 1671
- 2279 1861 -21988 1832 -21988 1705 -21988 1848 -21988 1556 2124 1659 -21988 1862
- 2077 1939 -21988 1226 -21988 1937 -21988 1157 919 1390 939 818 2177 1638 2157
- 1703 -21988 1393 1314 1869 2024 1889 -21988 1426 1562 1083 2084 1748 1758 1873
- 1341 1803 -21988 1848 1554 1539 -21988 1849 -21988 1747 1702 1622 -21988 1704
- -21988 1962 1217 1869 2052 1390 -21988 1698 2096 1588 1733 1415 -21988 1829
- 1996 1247 1672 1803 -21988 728 2165 1585 1402 947 -21988 1178 -21988 1591 2004
- 1876 -21988 1822 2039 1462 -21988 1960 2152 1477 2205 1934 2195 1712 -21988
- 1692 -21988 1324 2027 1682 -21988 1281 -21988 1968 -21988 1322 -21988 1239
- -21988 1778 -21988 1752 -21988 100 { m20} R 1931 -21988 1638 -21988 1399 -21988
- 1756 -21988 1701 1992 1842 1948 1760 2364 1863 -21988 1916 407 1916 2210 1947
- 1487 1715 2135 1903 -21988 1792 1305 1440 -21988 1553 1971 1872 -21988 1795
- 1625 1968 1175 1925 960 1797 1388 1756 1280 1936 1858 1651 1456 1803 1848 1850
- 1538 1886 2064 1307 1279 1804 -21988 1753 -21988 1648 -21988 1620 -21988 1615
- -21988 1832 2229 1382 -21988 1721 -21988 1831 -21988 1766 1336 1860 -21988 1925
- 1906 1963 1381 739 2027 1965 -21988 1955 1913 1746 2059 1797 1153 1903 1908
- 1964 -21988 1937 -21988 1695 -21988 1889 1719 1972 1756 1698 -21988 1610 -21988
- 1898 -21988 1274 -21988 1749 1881 1364 1641 1915 1810 1554 -21988 1863 -21988
- 1627 -21988 1784 1432 1158 -21988 1769 -21988 1888 -21988 1821 -21988 1756 2160
- 1643 -21988 1875 -21988 1877 -21988 1923 1927 1417 1226 1931 -21988 1060 1466
- 1955 1472 981 2123 1804 -21988 1901 2115 1283 1044 1946 1572 1431 1821 1949
- -21988 1733 1456 988 1929 1925 -21988 1888 1580 1792 -21988 1772 1755 1739
- -21988 1782 -21988 1939 1605 1680 -21988 1859 2046 1749 1251 1749 -21988 1793
- 1886 1959 -21988 1668 1991 1949 2047 100 { m20} R 1333 1629 1288 1664 1838
- -21988 1935 -21988 1910 -21988 1396 -21988 1435 -21988 1750 -21988 1761 -21988
- 1899 -21988 1496 1743 1781 -21988 1868 1247 1806 1160 1899 -21988 1917 2283
- 1395 -21988 1794 -21988 1643 1421 1709 -21988 1782 -21988 1602 -21988 1948
- -21988 1550 -21988 1924 1151 1271 2002 1830 -21988 1868 -21988 1508 -21988 1956
- -21988 1880 -21988 1899 -21988 1261 -21988 1964 2311 1835 -21988 1632 -21988
- 1217 -21988 1028 2066 1950 2235 1751 1728 1971 -21988 1043 -21988 1879 -21988
- 1468 -21988 1632 1881 1907 1219 1913 -21988 1651 1768 1779 -21988 1440 -21988
- 1544 -21988 1239 -21988 1916 -21988 1814 -21988 1955 -21988 1845 -21988 1856
- 1448 1894 -21988 1670 -21988 1860 -21988 1708 2079 1740 -21988 1344 -21988 1926
- 1866 1491 -21988 1718 1972 1951 1953 1875 1346 1315 2172 1844 1887 1878 -21988
- 1607 -21988 1959 -21988 1373 -21988 1139 2288 1697 -21988 1973 1767 1731 -21988
- 1846 -21988 1755 2151 1295 -21988 1699 1702 1921 -21988 1833 1802 1850 2283
- 1877 2148 1955 1893 1893 -21988 1940 -21988 1773 1728 1972 -21988 1397 1588
- 1951 -21988 1385 2083 1619 -21988 1959 -21988 1952 -21988 1858 -21988 1943
- -21988 1744 1513 100 { m20} R 1921 1906 1617 -21988 1903 -21988 1946 1846 1767
- -21988 1914 2248 1850 -21988 1623 774 1901 2077 825 -21988 1925 -21988 1662
- -21988 1796 2221 1888 715 1286 -21988 1762 2239 1703 -21988 1922 -21988 1695
- -21988 1820 2080 999 1296 1839 2208 1735 -21988 1114 2127 1973 -21988 1710
- -21988 1966 2100 1896 2017 1968 -21988 1527 -21988 1963 -21988 1547 -21988 1886
- -21988 1791 -21988 1842 -21988 1795 1792 921 -21988 1630 -21988 1745 -21988
- 1955 1893 1378 -21988 1875 1557 1639 -21988 1890 1193 1971 -21988 1740 -21988
- 1806 -21988 1775 1807 1959 -21988 1955 -21988 1445 -21988 1402 1603 1660 1851
- 1764 -21988 1150 -21988 1951 -21988 1504 -21988 1830 1964 1185 2313 1938 1170
- 1535 1847 1067 1412 1917 1894 1235 1257 1973 -21988 687 1797 1692 1477 1953
- -21988 1629 -21988 1731 1935 1972 1077 1666 772 1527 1561 1841 2095 1832 1193
- 1898 2039 1746 1030 1883 1942 1964 -21988 1809 1735 1934 -21988 1575 -21988
- 1973 -21988 1233 -21988 1902 2045 1972 -21988 1488 1879 1729 1836 1489 1698
- 1253 1800 1542 1849 1775 2252 1834 1963 1850 -21988 1768 1636 1671 -21988 1849
- -21988 1944 2063 1678 -21988 240 -21988 100 { m20} R 1784 1512 1515 1246 1753
- -21988 1659 -21988 1581 -21988 1611 2015 1907 -21988 1513 -21988 1684 2000 1337
- -21988 1912 1953 1782 1585 1852 -21988 1674 1961 1763 1613 1958 -21988 1659
- 1722 1909 1964 1931 -21988 1935 1773 1901 1879 1822 -21988 1337 1440 1600 2164
- 1796 -21988 1526 -21988 1836 -21988 1496 1172 1535 -21988 1670 -21988 1869 1002
- 1563 -21988 1938 -21988 1442 2109 1522 1210 1646 -21988 1741 700 1838 2095 1548
- -21988 1743 2041 1895 2024 1217 1653 1797 1557 1904 -21988 1900 1658 1788 1288
- 1546 1586 1710 -21988 48 { m20} R 1104 2038 1747 2319 1493 2329 1013 1224 1923
- -21988 1859 -21988 1934 -21988 1915 1551 1961 -21988 1710 1776 1841 -21988 1956
- -21988 1562 -21988 1705 -21988 1455 1611 1734 -21988 1595 2040 977 -21988 1298
- 1797 1892 1921 1956 2240 1590 2080 1946 -21988 1621 1933 1830 2043 1878 -21988
- 1901 -21988 1570 1498 1945 -21988 1936 -21988 1828 2131 1970 1966 1652 1865
- 1530 -21988 1940 -21988 1915 2053 1785 -21988 1631 2242 1706 1607 1700 -21988
- 654 -21988 1759 2293 1398 1239 1086 -21988 1633 1826 1943 1967 1959 2107 1352
- -21988 1666 -21988 1558 -21988 1691 1986 1852 -21988 1744 -21988 1621 -21988
- 1883 1851 1272 -21988 1904 -21988 1927 -21988 1130 -21988 1908 1983 1925 -21988
- 1878 -21988 1840 -21988 1953 1931 1215 -21988 1921 1651 1801 1754 1622 574 1647
- 2089 1782 -21988 1908 1776 1558 2144 1781 1593 1973 253 1458 2030 1955 -21988
- 1003 -21988 1970 1812 1893 1916 1648 2146 1885 -21988 1868 -21988 1736 -21988
- 1896 -21988 1952 -21988 1566 -21988 1627 -21988 1927 -21988 1506 1731 1969 1124
- 1848 -21988 1406 -21988 1864 -21988 1869 -21988 1734 1786 1780 -21988 1970 1913
- 1969 -21988 871 1871 1814 786 100 { m20} R 1771 -21988 1644 -21988 1827 1400
- 1221 2063 1925 -21988 1894 -21988 1877 1986 1693 -21988 1763 1484 1777 1918
- 1907 1855 1488 1888 1873 -21988 1718 1799 1970 2157 1890 -21988 1901 -21988
- 1855 2134 1869 444 1910 -21988 1800 -21988 1916 -21988 1962 1859 1638 1989 1839
- -21988 1464 -21988 1939 -21988 1728 -21988 1889 2066 1878 1987 1769 -21988 329
- 1872 1587 538 1808 1707 1555 -21988 1551 -21988 1867 1904 1732 1900 1153 1847
- 1900 1420 1814 -21988 1962 -21988 1345 -21988 1880 -21988 1931 -21988 1748
- -21988 1409 -21988 1105 -21988 1547 1668 1922 2347 1876 -21988 1892 1498 1560
- 1154 1847 1929 1948 2080 1735 929 1198 -21988 1675 -21988 1896 1669 1873 1995
- 1690 -21988 1778 -21988 1903 -21988 1539 1867 1693 1752 1420 -21988 1485 1494
- -52 1959 1553 1687 1675 -21988 1689 1607 1964 -21988 1950 -21988 1742 -21988
- 1913 -21988 1764 -21988 1684 1933 1865 2091 1972 1819 1903 -21988 1544 -21988
- 1385 2169 1405 -21988 1965 1908 1952 -21988 1501 -21988 1956 -21988 1466 -21988
- 1652 1761 1874 2117 1347 -21988 1857 -21988 1722 1731 1651 1685 1556 -21988
- 1836 2206 1792 -21988 1313 2092 1742 -21988 1806 -21988 100 { m20} R 1521
- -21988 1122 -21988 1522 -21988 507 1934 1833 -21988 1432 1951 1826 1904 1744
- -21988 1497 1863 1916 1286 1136 -21988 1623 1790 1732 1772 1744 -21988 1754
- 1655 1938 1231 1541 -21988 1717 -21988 1969 -21988 1712 -21988 1854 -21988 1209
- 926 1452 -21988 1707 1785 1697 2195 1652 -21988 1930 1645 1803 2338 1190 -21988
- 1240 -21988 1871 1759 1465 1973 1683 -21988 1947 -21988 1477 -21988 1684 734
- 1786 2209 1897 -21988 1562 -21988 1881 -21988 1930 2339 1649 1721 1396 1999
- 1896 1894 1913 1842 1687 2044 1845 2087 1598 962 1024 2092 1873 1954 1253
- -21988 1859 -21988 1944 -21988 1191 1601 1701 1345 1603 1822 1956 1347 1808
- -21988 1311 -21988 1964 -21988 1785 -21988 1869 -21988 1865 1775 1950 -21988
- 1917 2024 1829 -21988 1783 -21988 1503 -21988 1762 -21988 1756 1662 1647 -21988
- 1773 1566 1548 -21988 1841 -21988 1472 2172 1716 -21988 1597 1140 1651 1917
- 1567 -21988 1632 2051 1106 -21988 1323 1797 1971 -21988 1901 1865 1672 -21988
- 1585 2214 1459 1367 1037 -21988 1706 -21988 1618 -21988 1913 -21988 1923 1953
- 1800 -21988 1599 -21988 1698 2170 1869 -21988 1908 -21988 1848 1579 1946 1733
- 1961 -21988 100 { m20} R 1965 1771 1945 -21988 1958 -21988 1921 2132 1911
- -21988 1396 -21988 1756 -21988 1921 -21988 1953 1948 1774 2312 1882 -21988 971
- 1548 1931 1496 1936 -21988 1671 -21988 1442 -21988 1702 -21988 1809 -21988 1803
- 1387 1923 1410 1960 -21988 1659 2039 1939 -21988 712 -21988 1833 2093 1734
- -21988 1691 -21988 1913 -21988 1595 1971 1853 -21988 1361 -21988 1307 1731 1894
- -21988 1835 -21988 1878 -21988 1863 -21988 1078 1895 1788 1844 1923 -21988 1946
- 1580 1722 -21988 1909 1998 1250 -21988 1882 2278 1598 -21988 1276 1945 1948
- -21988 1751 1716 1576 -21988 1702 2321 1862 -21988 1950 -21988 1521 -21988 884
- 2008 1257 -21988 1910 2296 1151 -21988 1343 -21988 1965 1669 1895 -21988 616
- 1750 1927 1529 1957 1245 1495 -21988 1969 -21988 1815 -21988 1850 1767 1888
- -21988 1487 1505 1963 1371 1516 1194 1913 1907 1912 -21988 1753 -21988 1781
- -21988 1890 -21988 1474 -21988 1818 2149 1636 1984 1928 1572 1795 2040 1207
- 2166 1567 -21988 1555 1175 1742 1507 1429 1507 1770 -21988 1021 1590 1964 2159
- 1698 -21988 1808 -21988 1861 -21988 1764 -21988 1438 -21988 1954 1979 784
- -21988 1497 -21988 1333 -21988 1716 2026 1805 1214 100 { m20} R 1385 -21988
- 1783 2071 1379 1875 1831 -21988 1814 2096 1923 -21988 1841 2040 1470 2119 1850
- 1309 1957 -21988 1939 -21988 1785 1833 1954 -21988 758 840 1845 -21988 1856
- 1660 1516 -21988 1826 1672 1561 1855 1932 1280 1715 -21988 1897 -21988 1890
- 2242 1947 1175 1556 1804 1824 -21988 1730 1437 1394 -21988 1931 -21988 1943
- -21988 1720 1171 1727 2047 1908 -21988 1755 -21988 1881 1874 55 2119 1495
- -21988 1872 -21988 1815 -21988 1962 1296 1851 -21988 1924 2205 1211 -21988 1957
- -21988 1833 -21988 1413 -21988 1482 -21988 1569 -21988 1809 1895 1949 -30 1903
- -21988 1968 -21988 1759 1497 1621 -21988 1838 -21988 1616 1602 1084 2247 1625
- 2071 1724 1687 1744 -21988 1923 2162 1766 -21988 1649 -21988 1818 1398 1788
- -21988 1945 1936 1807 -21988 1810 -21988 1895 1201 1917 1648 1864 -21988 1956
- 2107 1939 -21988 1695 -21988 1908 2064 1666 2079 1940 -21988 1208 2081 1957
- 1536 1954 -21988 1903 1569 1795 1188 1753 -21988 1843 2072 1854 -21988 1173
- -21988 1945 -21988 1797 -21988 1811 1546 1887 880 1856 2020 1540 1492 1598
- -21988 1889 1684 1680 -21988 1480 -21988 492 -21988 1388 2000 1951 1826 1557
- -21988 100 { m20} R 1599 1926 1082 1948 1315 1810 1596 1545 1605 1796 1926 1901
- 1773 1851 1944 1818 1784 1899 1777 1802 1878 2090 1713 -21988 1840 -21988 1076
- -21988 1868 -21988 1160 1982 1212 -21988 1814 2089 1505 2096 1681 2206 1932
- 2078 1850 -21988 1842 1308 1038 2087 1762 1325 1933 1799 966 1650 1791 -21988
- 1465 1970 1716 1704 1068 -21988 1555 1813 1943 -21988 1812 -21988 1947 -21988
- 1901 -21988 1849 -21988 1718 -21988 1370 -21988 1408 1973 1589 1482 1756 1533
- 1821 1617 1710 -21988 976 -21988 1965 1854 1631 -21988 1851 1905 1965 -21988
- 1799 1733 1253 1538 1854 2014 1588 2002 1413 2180 1893 -21988 1617 -21988 1606
- -21988 1694 1864 1850 1696 1457 -21988 1876 -21988 1779 -21988 1886 1926 1516
- 2163 1943 -21988 1930 -21988 1569 1509 1868 -21988 1968 2118 1604 1350 1873
- 1324 1270 -21988 1380 -21988 1876 1617 1835 2102 1291 -21988 1748 -21988 1886
- 946 1835 -21988 1837 2139 1462 -21988 1779 -21988 1694 -21988 1740 -21988 1479
- -21988 1768 -21988 1748 2092 1839 -21988 1605 1122 1844 -21988 1654 267 1424
- -21988 1777 1920 1809 2291 519 -21988 1943 1957 1830 1367 1835 1604 1936 2154
- 1663 -21988 100 { m20} R 1928 -21988 1896 -21988 808 -21988 1835 2101 1913
- -21988 1943 -21988 1377 1987 1971 2008 1839 -21988 1278 -21988 1850 -21988 1685
- 1546 1879 1872 1929 -21988 1511 1810 1940 2291 1636 1575 1424 1858 1778 1480
- 1922 -21988 1836 1663 1653 -21988 1876 -21988 1497 2083 1838 2333 1897 -21988
- 1966 -21988 1965 -21988 1971 1739 1759 1985 1909 -21988 1510 2223 1787 -21988
- 1921 -21988 1879 1975 1806 -21988 1937 -21988 1240 2026 1346 1369 1937 2105
- 1946 1680 1833 1760 855 -21988 1611 -21988 1753 1639 1880 -21988 1493 -21988
- 1082 1817 1877 -21988 1720 -21988 1443 -21988 1887 2000 1863 1266 1765 -21988
- 1429 2078 1174 -21988 1670 -21988 1671 2057 1934 -21988 1675 2003 1610 1891
- 1888 -21988 1632 -21988 1939 2109 1436 -21988 1802 -21988 1843 -21988 1965
- -21988 1367 1822 1929 1316 1607 1312 1646 -21988 1126 2030 1931 -21988 -202
- -21988 1696 -21988 1946 1919 1610 2016 1795 -21988 1876 -21988 1620 1760 1648
- -21988 1820 1847 1798 2206 1564 2405 1774 1453 1879 -21988 1890 -21988 1872
- -21988 1723 -21988 1663 2020 1904 -21988 1558 2001 1918 1402 1108 -21988 1803
- 1053 1854 -21988 899 1864 1767 -21988 1480 1965 100 { m20} R 1841 -21988 1934
- -21988 1465 2287 1407 982 1856 1789 1765 -21988 1610 1946 1591 2148 1948 2094
- 1942 -21988 1562 -21988 566 1814 1457 -21988 1514 1687 1426 -21988 1466 1797
- 1818 1972 1843 -21988 1828 2077 1958 1838 -269 -21988 1236 1813 1883 -21988
- 1923 1685 1711 -21988 1889 -21988 1816 1434 1507 -21988 1886 1818 1510 -21988
- 1894 1609 1131 1293 1278 1152 1970 1867 1945 1935 1759 -21988 1966 -21988 1968
- -21988 1949 -21988 1958 1599 1892 1590 1842 -21988 1102 1618 463 1403 1738
- -21988 1734 -21988 1948 -21988 1150 -21988 1266 -21988 1804 -21988 1650 -21988
- 1622 1923 1947 -21988 1678 -21988 1901 2306 1430 2141 1092 1801 1656 -21988
- 1947 -21988 1684 1279 1778 2221 1537 -21988 1164 1931 1954 -21988 1889 -21988
- 1891 1972 1153 -21988 1938 -21988 1633 1877 1752 1540 1934 -21988 925 1864 1966
- -21988 1879 -21988 1873 -21988 1419 -21988 1940 898 1949 -21988 844 -21988 1947
- -21988 1882 -21988 1666 2027 1683 -21988 1955 2190 1816 -21988 1787 1504 1577
- 1323 1491 1761 1290 598 1764 -21988 1777 1232 1907 -21988 1644 -21988 1829 2363
- 1814 1946 1933 -21988 1840 1297 1839 1190 1363 1907 1953 1641 100 { m20} R 1955
- 1590 1136 -21988 1920 -21988 1867 -21988 1821 -21988 1630 2117 1947 -21988 1887
- -21988 1968 -21988 1863 -21988 1632 -21988 1971 -21988 1344 -21988 1793 -21988
- 1838 -21988 1912 1642 1517 1964 1338 1369 1973 1907 1352 -21988 1875 1930 1314
- 1423 1653 -21988 1722 2217 1505 1560 1962 1270 1133 2275 1777 -21988 1735 1624
- 1741 2144 1327 -21988 1933 980 1820 -21988 1597 -21988 1848 -21988 1341 -21988
- 1387 1606 1408 -21988 1774 -21988 1403 1620 1930 1326 1582 1523 1907 -21988
- 1603 1931 1686 -21988 1848 -21988 1590 -21988 1607 -21988 1865 -21988 1662 1523
- 1941 -21988 1613 -21988 1953 -21988 1402 2007 1646 -21988 1676 1913 1723 2278
- 1808 2007 1915 -21988 1583 2105 1852 2054 1842 -21988 1886 -21988 1910 -21988
- 1622 2021 1165 -21988 1965 -21988 1835 1654 1970 1288 1843 -21988 1702 -21988
- 1184 1854 1864 1973 1469 1929 1703 -21988 1523 1908 1823 -21988 1880 938 1705
- -21988 1796 -21988 1898 2220 1663 -21988 1609 2284 1914 2144 1934 1982 1605
- 2180 1945 -21988 1548 -21988 1896 2074 1749 -21988 1693 -21988 1408 -21988 1686
- -21988 1867 -21988 1900 -21988 1955 -21988 1971 1008 1916 462 1790 1932 1618
- 2035 100 { m20} R 1839 -21988 1906 887 1888 -21988 1839 -21988 1935 -21988 1481
- 1941 1762 -21988 1639 -21988 1475 1511 1682 -21988 1414 1868 1588 1896 1533
- -21988 1856 -21988 1618 1525 1884 -21988 984 -21988 1890 1572 1960 2077 1739
- -21988 1936 -21988 1729 -21988 1192 -21988 1935 1904 1619 1879 1721 -21988 1954
- -21988 1639 2059 1684 -21988 1115 -21988 1845 -21988 1668 1675 1359 -21988 1770
- 2035 1938 -21988 1760 2220 1886 -21988 1856 2054 1890 -21988 1675 -21988 1844
- 1518 1902 1903 1810 -21988 1274 2380 1771 -21988 1845 2014 1813 -21988 1612
- 1571 1481 879 1887 1318 1896 1946 1933 -21988 1620 -21988 1738 -21988 1508 1781
- 1866 1819 1771 -21988 1713 1737 1953 2174 1838 886 1787 1471 1008 -21988 1661
- 1079 1945 2216 1761 -21988 1882 2071 1736 1758 1836 1460 754 1749 1887 -21988
- 1922 -21988 1736 -21988 1704 956 1658 1824 1961 1671 1673 -21988 1767 -21988
- 967 -21988 1972 -21988 1898 -21988 1654 1751 1973 1752 1784 -21988 1717 1317
- 1833 -21988 1075 -21988 1672 2061 1683 742 1669 -21988 1595 2052 1417 -21988
- 1788 -21988 1932 -21988 1299 1936 1876 1956 1821 -21988 1705 -21988 1360 -21988
- 1560 -21988 1706 1400 100 { m20} R 1904 1977 1797 -21988 1627 1753 1825 -21988
- 1968 -21988 1327 -21988 1962 -21988 1849 -21988 1879 2222 1778 2059 1885 -21988
- 1784 2296 1591 1626 1968 -21988 1877 -21988 984 1743 1631 1266 1445 1802 1378
- -21988 1967 1816 1443 1243 1412 -21988 1694 -21988 700 -21988 1900 -21988 1953
- 1982 1951 -21988 1761 1819 1878 1740 1704 -21988 1729 -21988 1362 -21988 1648
- -21988 1517 -21988 1686 2020 1661 -21988 1564 1723 1952 -21988 1368 2160 1837
- 1861 1828 1173 1757 1873 1660 -21988 1745 1500 1483 -21988 1534 2198 1329
- -21988 1835 -21988 1854 -21988 1940 -21988 1973 2241 1931 -21988 1000 -21988
- 1949 2202 1576 -21988 1625 1731 1810 2216 1768 -21988 1677 -21988 1945 2122
- 1663 -21988 1517 2123 1662 1921 1936 -21988 1607 -21988 1079 -21988 1969 -21988
- 1859 1848 1972 1929 1751 -21988 1566 -21988 1819 2208 1524 -21988 1843 -21988
- 1410 -21988 1891 2104 1943 2075 1576 2032 1834 1748 1665 -21988 1708 -21988
- 1867 1813 1870 -21988 1672 -21988 1727 -21988 1893 -21988 1861 2152 1907 1225
- 1508 -21988 1958 1973 1786 -21988 1824 1383 1939 1975 1920 1647 1821 -21988
- 1970 -21988 1912 2201 1713 -21988 1851 1827 1340 -21988 100 { m20} R 1819
- -21988 1898 1928 1388 1390 1714 1866 1151 1687 1963 -21988 1860 1709 1292 2056
- 1411 -21988 1873 1248 1894 -21988 1931 1696 1716 -21988 1793 -21988 1863 1377
- 1855 1651 1951 -21988 1657 1044 1971 1780 1789 -21988 1571 2087 1511 1607 1103
- -21988 1860 -21988 1879 -21988 1582 1568 1950 -21988 1837 -21988 1164 -21988
- 1889 -21988 1838 2094 1405 1914 191 1828 1929 -21988 1490 -21988 1492 -21988
- 1710 2023 1718 1802 1751 1741 949 660 1733 1848 602 -21988 884 1602 1959 1260
- 1417 2079 1770 2046 1276 2317 1803 1637 1870 1932 1671 -21988 1424 1805 1861
- 1411 1860 -21988 1772 1032 1709 -21988 458 -21988 1912 1883 1419 -21988 1605
- 1711 1286 1750 1821 1569 1671 910 1917 1750 1854 1146 1920 1370 1897 -21988
- 1702 -21988 1533 2207 1821 -21988 630 1665 1898 1457 1948 -21988 1102 1692 1528
- 2194 1891 1272 1215 -21988 1418 -21988 1602 -21988 1911 -21988 1512 -21988 1513
- -21988 1908 -21988 1824 -21988 1830 -21988 1924 -21988 1806 -21988 1905 -21988
- 1674 -21988 1945 -21988 1457 1869 1842 1871 1585 -21988 1441 -21988 1625 -21988
- 1338 -21988 1947 -21988 1903 1672 1848 -21988 1357 1977 1879 -21988 100 { m20
-} R 1937 -21988 1866 1510 1886 -21988 1971 1688 1786 2040 1775 1055 1077 -21988
- 1634 2213 1545 1428 1499 -21988 1170 -21988 1900 -21988 1799 860 1747 1061 1490
- -21988 1956 2085 1625 -21988 1919 -21988 1867 -21988 1968 1168 1811 -21988 1544
- -21988 997 1429 1861 -21988 1706 -21988 1242 961 1670 1853 1672 1852 1261
- -21988 1654 -21988 1657 -21988 1942 1968 1640 -21988 1797 1692 1772 -21988 1973
- -21988 1648 -21988 1890 -21988 1263 1069 1579 -21988 1909 1924 1226 -21988 1164
- 1952 1581 393 1320 2017 1503 2010 1893 1882 1449 -21988 1932 -21988 1549 -21988
- 1838 -21988 1961 767 1780 -21988 1167 -21988 1694 -21988 1915 2140 1947 -21988
- 1714 -21988 1895 2053 955 -21988 1691 -21988 1952 1930 1852 -21988 1875 -21988
- 1353 2007 1904 387 1855 1521 1957 822 835 1995 1890 -21988 1780 -21988 1598
- 1996 1921 -21988 1836 -21988 1491 -21988 1970 -21988 1910 -21988 1753 -21988
- 1908 1868 1611 1697 1732 -21988 1176 1726 1793 1800 1960 2152 1903 1797 1874
- -21988 1773 1092 418 -21988 1570 -21988 1894 1898 1257 2022 1943 1619 1808
- -21988 1941 -21988 1898 1656 994 1852 1199 1882 1297 -21988 1900 -21988 1736
- -21988 100 { m20} R 1805 -21988 1822 -21988 1579 -21988 1867 1816 1966 -21988
- 1874 1868 1586 -21988 1713 1956 1846 -21988 1825 -21988 1889 1845 799 -21988
- 1305 1877 1699 2128 1700 -21988 1904 -21988 1599 -21988 1697 1068 1934 1786
- 1766 1667 1593 1586 1144 1709 832 -21988 1852 -21988 1316 2025 1404 2163 1871
- 1566 1760 1840 1746 -21988 1895 2059 1446 -21988 1424 2002 1471 -21988 1840
- 1681 1670 -21988 1709 -21988 1622 2138 1358 -21988 1639 1850 1800 -21988 1947
- -21988 1646 1932 1694 1812 1963 -21988 561 -21988 1798 1861 1734 -21988 1679
- -21988 1242 1998 1499 -21988 1854 1960 1517 2222 1720 -21988 1183 -21988 1777
- -21988 1774 -21988 1582 -21988 1838 -21988 1762 1902 1837 1217 671 2314 1402
- -21988 1882 1752 1912 -21988 1625 -21988 1821 -21988 1588 1997 1680 -21988 1518
- 1434 1529 1962 1746 2257 1885 -21988 1822 2357 1154 1823 1926 1827 1716 -21988
- 1773 1954 1489 -21988 1855 1886 1736 -21988 1443 -21988 1582 928 1746 -21988
- 1849 3 1691 -21988 1971 -21988 1621 1591 1701 1700 1921 1974 1961 -21988 1845
- 2019 1952 -21988 1671 -21988 1951 -21988 1471 1876 1694 -21988 1331 2030 1646
- 1774 1501 -21988 1789 2087 100 { m20} R 1971 1671 1227 -21988 1587 1506 831 562
- 1784 -21988 1740 2211 1901 -21988 1281 -21988 1103 -21988 1717 1584 1940 849
- 1897 -21988 1931 -21988 1874 -21988 1579 2081 1746 2202 1841 -21988 1892 2244
- 1605 2200 1588 -21988 1918 2159 1759 2202 1282 1933 1970 2082 1772 -21988 1890
- 1765 1396 -21988 1903 -21988 1384 1709 1855 1345 1932 -21988 1854 1908 1766
- 2078 1794 -21988 1558 -21988 1909 -21988 1867 -21988 1853 -21988 979 -21988
- 1772 1877 1700 -21988 1743 -21988 1186 -21988 1048 -21988 1894 -21988 1127 1948
- 1493 -21988 1320 -21988 1715 -21988 1748 1994 1475 -21988 1889 -21988 1801 2085
- 1704 1794 1925 -21988 1812 -21988 1926 -21988 1822 1672 1885 -21988 1879 1921
- 1741 -21988 1958 -21988 1622 2139 1818 1563 1747 -21988 1879 1117 1909 -21988
- 1558 -21988 1653 2172 1953 1974 1801 2023 1592 1693 1779 1952 1721 2063 1557
- 1465 1536 -21988 1641 -21988 1726 -21988 1763 -21988 1636 1800 1791 -21988 1802
- -21988 1972 -21988 1916 1828 1891 -21988 1694 -21988 1412 -21988 1950 -21988
- 1516 -21988 1770 -21988 1323 1688 1343 1712 1967 -21988 1828 2230 1267 1836
- 1646 2130 945 1596 1746 2121 1665 2168 1916 -21988 100 { m20} R 1371 2174 1929
- -21988 1925 2124 1086 2110 1928 2054 1840 -21988 1870 1969 1876 -21988 1946
- -21988 1550 -21988 1439 2191 1814 -21988 1847 -21988 1489 1687 1903 1614 1959
- -21988 1338 2255 1494 1613 1697 2019 1924 1894 1645 1988 1341 -21988 1589 1744
- 1834 1892 1631 -21988 1750 -21988 1848 -21988 1853 1223 1918 -21988 1476 -21988
- 1925 1830 1863 1235 1488 1763 1963 2099 1796 -21988 1725 2105 1624 1900 530
- 1689 1908 1454 1935 1771 1848 -21988 1841 -21988 1961 -21988 1682 -21988 1684
- -21988 1569 1220 1526 -21988 1548 1903 1897 -21988 1901 1866 1759 -21988 1328
- 2098 1746 -21988 1806 -21988 475 -21988 1898 1585 1858 -21988 1285 1814 1967
- 2150 1833 1798 1586 -21988 1892 1678 1771 1649 1440 1311 1546 1425 524 -21988
- 1828 1880 1714 1990 1732 1484 1972 1678 1954 -21988 1676 1087 1806 2050 1744
- 2208 1068 2193 1767 -21988 1909 -21988 1828 1520 1730 1632 1957 2061 1600
- -21988 1724 -21988 726 -21988 1825 2023 1746 -21988 1339 1899 1360 -21988 1484
- 2017 1741 -21988 1923 -21988 1682 2076 1643 1261 1726 -21988 1890 2184 1954
- 1126 959 -21988 1722 -21988 1786 -21988 1844 -21988 1947 -21988 100 { m20} R
- 1812 2095 1839 1888 1549 1984 1927 -21988 1819 -21988 1955 11 1939 1688 1355
- 1311 1963 -21988 1035 -21988 1884 -21988 1412 2055 1772 1708 1673 1857 1915
- -21988 1903 2212 1928 2232 1429 1140 1842 -21988 1702 2145 1900 1575 1965
- -21988 1840 -21988 1908 -21988 1414 -21988 1842 -21988 1760 1850 781 -21988
- 1760 2066 1479 1201 1909 -21988 1899 -21988 1120 1827 1266 1964 1691 -21988
- 1826 1424 1947 -21988 1943 -21988 1959 2229 1961 -21988 1825 -21988 1661 2172
- 1793 1004 1858 1803 592 -21988 1696 -21988 1695 1890 1954 -21988 1767 778 886
- -21988 1715 1885 1890 -21988 1885 -21988 1736 -21988 1646 -21988 1471 1688 1867
- -21988 1745 1180 1955 -21988 1969 -21988 1740 2012 1634 -21988 1922 -21988 1928
- -21988 1619 1785 1666 -21988 1431 2004 1670 -21988 1410 -21988 1888 1755 1796
- -21988 1318 -21988 1944 1611 1424 -21988 1379 -21988 1468 -21988 1687 -21988
- 1041 -21988 1839 -69 1851 -21988 1411 1912 1349 1907 1863 -21988 1960 2301 1840
- 2079 1906 -21988 1727 -21988 1905 -21988 1841 -21988 1706 -21988 1758 -21988
- 1695 1767 1869 -21988 1573 1875 1888 -21988 1831 -21988 1443 1264 1723 1239
- 1366 -21988 1168 2201 100 { m20} R 1904 -21988 1935 1383 1759 -21988 1018
- -21988 1831 -21988 1954 1822 1893 2051 1817 -21988 1970 2104 1870 1706 1800
- -21988 1507 1967 1868 -21988 1921 -21988 1130 1564 1853 2045 1918 -21988 1867
- -21988 1065 2043 1871 -21988 1633 963 1925 1889 703 -21988 1697 1971 1832
- -21988 1951 1864 1780 -21988 1892 -21988 970 -21988 1838 -21988 669 -21988 939
- 2058 1827 2175 1964 2175 1952 -21988 1604 1653 754 -21988 1868 1914 1768 -21988
- 1804 2055 1899 1777 1567 1856 1538 -21988 1097 1291 1628 1295 1922 -21988 1687
- -21988 1867 1810 1862 1575 1815 -21988 1803 -21988 1394 1551 1760 1905 1664
- -21988 1857 -21988 1596 1813 1786 -21988 1456 -21988 1780 -21988 1715 1835 1496
- -21988 1736 1800 1562 1889 1916 2214 1574 -21988 1842 -21988 1027 1663 1554
- 2185 1654 1484 1923 1843 1707 -21988 1722 1998 1712 2241 1871 2061 1858 -21988
- 1619 -21988 1331 1206 1356 650 1224 431 1661 1955 1259 948 1965 -21988 1914
- 2186 1628 -21988 1823 -21988 929 1471 1912 -21988 1785 -21988 1614 1513 1635
- 2053 1967 1843 1655 1112 1970 2086 1727 -21988 1485 1885 1817 2224 1905 1548
- 1969 464 1891 1478 1849 2098 100 { m20} R 1025 1951 1898 1758 1772 -21988 1075
- 2031 1745 2004 1697 2009 1316 -21988 1639 -21988 1953 -21988 1697 1671 1720
- -21988 1608 1326 953 2101 1930 -21988 1896 -21988 1475 -21988 1548 -21988 1962
- 1544 1177 1899 1419 1642 1409 1452 1790 1709 1307 1694 1848 2234 1533 1686 1874
- 1750 1791 2161 1471 -21988 1771 -21988 1773 -21988 1723 -21988 1601 1756 1773
- 194 1843 -21988 1168 -21988 1543 -21988 281 1888 1168 -21988 -188 -21988 1515
- 1711 1787 -21988 1602 2043 1454 1553 1815 1780 1909 -21988 1899 1818 1309 1564
- 1840 1794 1418 -21988 1962 2232 1961 1915 1878 -21988 1518 -21988 1732 1906
- 1577 1645 1840 -21988 1654 2029 1790 -21988 1697 1792 1852 2226 1796 -21988
- 1936 1821 1828 1816 1431 1888 1829 -21988 1915 -21988 1850 2221 1037 1666 1506
- -21988 1824 -21988 1812 -21988 1783 -21988 1920 -21988 1937 1829 1494 -21988
- 1598 -21988 1571 -21988 1957 1928 1691 1261 1783 -21988 1776 -21988 1647 1567
- 1813 -21988 1848 1793 1561 1066 1713 -21988 1917 -21988 868 181 1935 -21988
- 1681 -21988 1776 1587 1839 1329 1963 1779 1466 1663 1843 1942 1275 1828 1868
- 1888 1791 -21988 1791 -21988 1836 1879 100 { m20} R 1642 1631 1842 -21988 1306
- -21988 1905 1535 1885 -21988 1207 -21988 1768 -21988 1293 -21988 1833 1456 1335
- 1798 1419 -21988 1430 1864 1883 2299 809 -21988 1893 -21988 1463 -21988 1205
- -21988 1537 -21988 1386 -21988 1677 -21988 1876 2066 1329 -21988 1563 -21988
- 1950 1639 1770 1882 1935 -21988 1722 1735 1899 -21988 1740 2105 1544 2212 1915
- 1535 546 -21988 1876 -21988 1891 1953 1819 1994 1646 -21988 1940 -21988 1433
- 1675 1447 -21988 1890 2162 1753 -21988 1744 1565 1796 1922 1868 -21988 1777
- 2034 1904 1981 1690 1710 1800 2112 1560 -21988 1694 -21988 548 -21988 1943
- -21988 1791 2088 1915 2131 1841 -21988 1353 1413 1879 1762 1658 -21988 1963
- -21988 1200 1986 1413 -21988 1215 1531 1960 -21988 1650 -21988 1595 -21988 1836
- 1278 1661 496 1911 2050 259 1682 1678 -21988 1890 1581 1649 -21988 1516 1830
- 1438 2063 1938 1558 1963 1735 1729 -21988 1891 2032 1414 1847 946 1203 1693
- -21988 1886 1660 1734 1429 1770 2168 1261 -21988 1798 1214 1491 1539 1739 1638
- 1167 -21988 1253 1595 1433 -21988 1956 2125 1916 -21988 1510 -21988 135 1277
- 1330 941 1909 -21988 1870 1951 1929 2173 1442 1979 100 { m20} R 1474 -21988
- 1833 -21988 1812 1834 1597 -21988 1850 -21988 1308 1623 1891 -21988 1389 1880
- 1906 -21988 1938 -21988 1758 -21988 1962 2146 1893 -21988 1931 -21988 1935 1893
- 1238 2057 1881 1704 1872 -21988 1923 2295 1774 -21988 1266 1415 1775 2161 1599
- -21988 1817 1616 1916 1788 1387 -21988 1504 2308 1951 1850 1943 -21988 1943
- -21988 1832 -21988 1525 -21988 1904 -21988 1424 1612 1746 -21988 1770 1604 1545
- 1639 1458 -21988 1133 -21988 1931 -21988 942 -21988 1965 -21988 1946 -21988
- 1878 -21988 1800 -21988 1843 2133 1824 -21988 1388 -21988 48 { m20} R 1880
- -21988 1789 -21988 1812 2018 1650 1831 1860 -21988 1732 1232 1889 1750 1434
- 2226 1555 911 1928 -21988 1677 1930 1326 1928 1892 -21988 1898 1823 1504 2169
- 1844 -21988 1641 -21988 1715 2035 1687 -21988 1101 -21988 1501 1111 1875 2083
- 1820 -21988 1651 -21988 1604 -21988 1772 -21988 1803 1756 1903 1943 1651 -21988
- 1851 1604 1887 -21988 1881 -21988 1916 -21988 1266 1729 1561 -21988 1647 -21988
- 1773 1824 1302 -21988 1836 -21988 1881 928 1893 -21988 1428 -21988 1792 1828
- 1937 -21988 1719 -21988 1861 -21988 1633 -21988 1868 2083 1898 1844 1914 1647
- 1791 1946 1944 -21988 1775 1176 1834 1635 1820 1196 1855 2083 1847 -21988 123
- -21988 1415 -21988 1803 -21988 1554 -21988 1918 -21988 1716 -21988 1814 1111
- 1807 1748 1676 -21988 1005 -21988 1794 -21988 1649 2011 1952 -21988 1636 -21988
- 1929 -21988 1711 -21988 1810 2068 1772 -21988 1773 1378 915 -21988 1776 -21988
- 1383 -21988 1535 2134 1261 -21988 1905 2120 1703 -21988 1672 2047 1874 -21988
- 1782 -21988 1890 2114 1630 -21988 1788 -21988 1622 -21988 1173 1499 1728 1635
- 1692 1806 1894 -21988 1715 1908 1839 -21988 1954 -21988 1942 1774 1416 1968
- 1899 -21988 100 { m20} R 1857 -21988 1907 2204 1102 1276 1652 -21988 1848
- -21988 1832 -21988 1788 2075 1920 -21988 1763 -21988 1665 1760 1797 -21988 1743
- 2163 1118 1761 1846 2069 1268 -21988 1759 -21988 1752 -21988 1833 -21988 1580
- -21988 1896 1602 1851 -21988 1570 1582 1968 -21988 1795 -21988 1953 -21988 1712
- -21988 1295 1882 1871 1559 1875 -21988 1787 -21988 1328 2195 1117 1366 1596
- 2187 1229 1546 1818 -21988 1810 -21988 1738 -21988 1829 1958 1968 -21988 1953
- 2217 1358 -21988 1862 1947 1886 -21988 1318 -21988 1599 -21988 1894 -21988 1903
- -21988 1540 -21988 1336 -21988 1855 -21988 1618 479 1620 1706 1563 2107 1693
- -21988 1791 -21988 1899 1358 1735 -21988 1731 1889 1921 1996 1846 -21988 1367
- 1507 1846 2235 1617 -21988 1954 1918 1948 1495 1369 2042 1848 1052 1509 -21988
- 1847 -21988 1898 1462 1470 -21988 1254 -21988 1890 -21988 1829 528 1848 -21988
- 1553 2120 1845 1737 1818 2221 1758 -21988 1817 -21988 1920 -21988 1799 1728
- 1793 2116 1965 -21988 1907 -21988 30 1539 1786 -21988 1752 -21988 1918 2089
- 1934 -21988 1814 -21988 1795 -21988 1586 1671 1799 1476 1327 1763 1492 -21988
- 1177 -21988 1835 -21988 1832 1662 1597 -21988 100 { m20} R 1649 -21988 1963
- -21988 1277 1312 1914 2146 1897 2087 1788 1811 1900 2083 1714 1980 1914 -21988
- 1963 -21988 1865 -21988 1682 1378 1947 1801 633 1778 1427 1635 1862 -21988 1127
- 2309 1529 -21988 1512 1991 1674 -21988 1835 -21988 1774 -21988 1087 -21988 1737
- -21988 1902 1665 1681 728 1665 1605 1610 -21988 1918 2274 1615 1414 1949 2113
- 1846 1884 1755 1883 1841 1739 1643 -21988 1699 -21988 1838 2168 1929 1844 1937
- -21988 1841 -21988 1536 -21988 1585 -21988 1833 -21988 1204 -21988 1803 -21988
- 1971 2094 1892 -21988 1796 -21988 1816 -21988 1736 1811 1260 1878 1560 -21988
- 1936 1878 1785 1717 988 1868 1402 -21988 1663 -21988 962 -21988 1552 1913 1585
- -21988 1903 -21988 1778 1820 1877 1643 1001 -21988 1822 -21988 1752 2143 1938
- 1852 1575 -21988 1645 -21988 1566 -21988 629 1356 1816 1726 1343 -21988 1918
- 2275 1484 1775 1664 -21988 1910 2097 1378 -21988 1940 1841 1502 -21988 1781 736
- 1907 1005 1916 1802 1927 1495 1649 2155 1950 2246 1635 -21988 1752 -21988 1662
- 2171 1916 1864 1842 1576 1725 1878 1347 -21988 1610 -21988 1615 -21988 1523
- 1884 1878 1870 1506 -21988 1616 2081 1968 1664 100 { m20} R 1642 -21988 1904
- -21988 1714 1897 1829 2010 1284 2182 1559 -21988 1793 1666 1809 2186 825 -21988
- 1927 -21988 1752 1857 1795 1687 1954 1187 1968 -21988 1837 1567 1756 -21988
- 1486 -21988 1451 -21988 1858 -21988 1847 -21988 1714 1355 1972 1524 1959 1823
- 1713 -21988 1807 1817 1340 -21988 1855 2219 1938 1378 1620 -21988 1425 2260
- 1738 1824 1453 -21988 1721 1759 1888 -21988 1913 1804 1091 -21988 1864 1306
- 1952 1775 1743 1410 419 -21988 1746 -21988 1835 1871 1876 -21988 1678 -21988
- 1702 2013 1202 1869 1888 2086 1896 2117 1552 -21988 1816 2267 1802 -21988 1451
- -21988 1466 1793 1957 -21988 1441 -21988 1194 -21988 1891 1758 1527 -21988 1971
- -21988 1870 1671 1745 -21988 1953 -21988 1913 789 1915 -21988 1354 1936 1596
- 1678 1799 1563 1607 1439 1733 2229 1791 1526 1477 -21988 1139 2168 1738 890
- 1906 2032 1294 2102 1688 -21988 1263 -21988 1897 -21988 1763 -21988 1634 -21988
- 1802 2197 1051 -21988 1907 -21988 1860 -21988 1907 1375 1750 1458 1820 -21988
- 1880 1831 1635 2013 1856 1860 1405 1898 1960 1402 1524 -21988 1925 1686 1719
- 1602 1868 1333 1937 -21988 1846 -21988 1119 2056 1383 1742 100 { m20} R 578 812
- 1852 1891 1524 -21988 1408 1399 1821 -21988 1833 1903 1883 -21988 1473 -21988
- 1451 -21988 1822 1959 1607 1690 1707 2181 1773 -21988 1681 1712 658 1888 1749
- -21988 1897 1428 1798 -21988 1912 1873 1601 -21988 1666 1659 1940 1619 1236
- -21988 1721 -21988 973 2164 1767 1812 1393 -21988 1389 1510 1950 501 1764 1949
- 1537 1676 1966 1637 1908 1423 1690 1461 1751 1849 1845 1565 1836 2222 1930 1282
- 1912 -21988 1835 -21988 1871 1965 1776 2053 1656 -21988 1780 -21988 1680 1921
- 616 1742 1149 1838 1942 2206 1776 -21988 1601 -21988 1553 2145 1836 1769 1884
- -21988 921 -21988 1724 1686 1929 -21988 1617 2024 1061 -21988 1898 -21988 1924
- 1778 1938 -21988 1781 2161 1425 2134 1527 1962 1831 2029 1298 -21988 1711 1858
- 1742 1801 1609 -21988 1806 -21988 1748 2048 1210 1389 1906 -21988 1756 -21988
- 1598 1338 1163 1676 1568 -21988 1752 1843 1416 1644 1760 -21988 1455 -21988
- 1589 1366 1938 -21988 1964 1133 1894 -21988 1862 -21988 1906 -21988 1863 -21988
- 1459 1984 1880 -21988 1747 1875 1479 1895 954 -21988 1601 -21988 1871 2158 1762
- -21988 1912 1364 1540 -21988 1818 1803 1841 1722 100 { m20} R 1916 -21988 1712
- 1225 1853 -21988 1309 -887 1620 2137 1764 1579 1703 -21988 1908 -21988 1848
- 1868 1968 -21988 976 -21988 1936 -21988 1602 1887 1458 1500 1920 1165 1739
- -21988 1814 2112 1819 -21988 1665 1631 1627 1648 1684 -21988 1972 -21988 1923
- 2041 1693 -21988 1667 1631 1698 1768 1753 -21988 1428 1038 1761 1879 1417
- -21988 1364 -21988 1860 -21988 1795 2217 1569 1596 1817 -21988 1249 1481 1886
- 1344 1779 1512 1953 1785 1779 2042 1585 -21988 1958 -21988 1921 -21988 1782
- 1970 1833 -21988 1895 1614 1916 2129 1838 -21988 1973 -21988 1820 1960 1326
- 1430 1815 1846 1623 2175 1940 1887 1808 -21988 1597 2067 1433 -21988 1903
- -21988 1815 -21988 1838 1781 1478 1856 952 1795 1813 -21988 1919 -21988 1966
- 1706 1554 -21988 1964 -21988 1487 1767 1927 -21988 1938 1707 1939 -21988 1709
- -21988 1744 -21988 1832 1886 1969 -21988 1506 -21988 1930 -21988 1287 -21988
- 1802 -21988 1655 -21988 1370 -21988 1798 2193 1762 1760 1972 1834 1327 1891
- 1266 -21988 1816 1790 1966 -21988 1831 -21988 1761 1265 1939 1648 1951 1637
- 1837 1700 1952 -21988 1903 1582 1147 -21988 1307 -21988 1282 1734 1962 -21988
- 1632 -21988 100 { m20} R 1557 1712 1845 1944 1948 -21988 1865 1687 1970 1997
- 1791 1838 1891 -21988 1589 1719 1778 1854 1474 -21988 1479 -21988 1648 -21988
- 1637 -21988 1826 1782 1804 -21988 1960 -21988 1371 1804 1400 -21988 1880 -21988
- 1053 1735 1883 1713 1639 -21988 -154 1954 966 2039 1957 -21988 1885 -21988 1312
- 1891 1220 -21988 1417 2087 490 2079 1958 -21988 1691 -21988 1879 1364 1627 1501
- 1892 2024 1957 1836 1720 1799 1557 1729 1950 -21988 1904 1631 1814 1557 1908
- 1428 1726 1553 1655 1332 1961 1523 1654 1144 1826 -21988 1891 -21988 1516 1260
- 1720 -21988 1341 2147 1824 -21988 1653 -21988 1533 1918 1860 -21988 1800 1989
- 1961 -21988 1718 -21988 1812 1431 1971 1975 1774 -21988 1851 1977 1939 1782
- 1827 2093 1910 1874 1818 2109 1868 2041 1849 -21988 1880 -21988 1870 1849 1157
- 2096 1613 -21988 1799 736 1918 -21988 1950 1851 1954 -21988 1830 2122 1602 1626
- 1642 -21988 1867 -21988 1747 1983 1562 1705 1923 -21988 1960 1888 1730 2056
- 1754 1235 1368 1133 1426 -21988 1952 2264 1197 2095 1790 -21988 1138 -21988
- 1491 -21988 1936 -21988 1827 -21988 1343 -21988 1900 1705 1809 1559 1836 -21988
- 1761 1662 100 { m20} R 1837 2121 1010 1788 1939 -21988 1784 -21988 1349 -21988
- 1849 -21988 1497 2137 1897 1990 1958 1937 1662 -21988 1672 -21988 1939 -21988
- 1931 1695 1863 1579 1758 1809 1459 1732 1843 -21988 1752 1970 1819 -21988 1582
- -21988 1708 2120 1642 -21988 1353 -21988 1966 1859 1714 1894 1731 1779 1828
- -21988 1777 1910 -71 1605 1903 1850 1321 1716 1906 -21988 1349 -21988 1960
- -21988 1626 -21988 1888 -21988 1458 -21988 1420 -21988 1927 -21988 1837 1755
- 1115 -21988 1819 1899 1779 -21988 1504 -21988 1625 -21988 1819 1309 1928 -21988
- 1322 2063 1958 1662 1772 -21988 1936 1540 1816 -21988 1769 -21988 1781 -21988
- 1550 1883 1680 -21988 1870 1164 1733 1406 1928 -21988 1922 -21988 1902 1954
- 1898 -21988 706 2016 1929 -21988 1871 1699 1761 -21988 1760 -21988 1248 -21988
- 1813 -21988 1878 2008 1727 -21988 1927 1821 1782 1690 1942 2159 1548 2219 1924
- 1745 1751 2007 1588 1711 1859 -21988 1741 -21988 1796 -21988 950 2087 1518 2421
- 1939 -21988 1581 -21988 1553 2213 1716 -21988 1897 -21988 1426 1601 1937 -21988
- 1156 1482 1744 -21988 1746 -21988 1802 1468 1516 -21988 1625 -21988 1928 1468
- 1717 -21988 1822 1273 1678 2101 100 { m20} R 1524 2016 1947 1493 1711 -21988
- 1833 1754 1953 -21988 674 -21988 1904 -21988 1455 1515 1459 -21988 1701 -21988
- 1702 -21988 1522 -21988 927 -21988 1958 1982 1949 -21988 1813 1459 1788 1716
- 1833 1615 1380 -21988 1905 1788 1515 1716 1918 1705 1949 -21988 1644 -21988
- 1137 -21988 1807 1665 1904 -21988 1604 1911 1431 -21988 1035 -21988 1855 1828
- 1082 1830 1899 1741 1269 1651 1948 -21988 1796 -21988 1383 -21988 1746 -21988
- 1888 -21988 1195 1108 1801 -21988 1820 2124 1953 1582 1485 -21988 1827 -21988
- 1703 -21988 1806 2007 1797 1894 1911 -21988 840 -21988 733 2211 1918 1732 1802
- -21988 1864 1848 1943 -21988 1499 1953 1420 -21988 1781 1826 1680 1597 1931
- 1962 1852 2285 1828 -21988 685 1631 1849 1796 1928 1881 1855 -21988 1834 -21988
- 1422 1390 1917 -21988 1930 -21988 1405 2157 1816 -21988 1861 2060 1504 -21988
- 1854 -21988 1942 1775 1891 -21988 1777 -21988 1928 1979 1920 -21988 1856 2105
- 1749 -21988 1776 1824 1936 1902 1823 1759 1445 -21988 1960 2059 1549 -21988
- 1660 -21988 1871 1667 1942 -21988 1437 -21988 1964 -21988 1198 -21988 1911
- -21988 1555 -21988 1904 -21988 1731 2022 1578 1928 1859 -21988 100 { m20} R
- 1082 -21988 1312 1922 1941 -21988 1409 1990 886 -21988 1887 -21988 1541 1998
- 1778 936 1915 1161 1888 1361 1965 -21988 1791 1166 1459 1588 1729 -21988 1741
- -21988 1968 2096 137 -21988 1623 -21988 1893 2046 1776 2098 1938 -21988 1583
- -21988 1816 1701 1838 2341 1770 703 1792 -21988 1594 -21988 1706 1886 1897
- -21988 1727 2146 1691 -21988 1882 1743 1952 1561 1942 -21988 1970 1276 1966
- -21988 1680 -21988 1823 2140 1829 -21988 1525 2002 1264 1757 1430 2060 1884
- 2017 1791 -21988 1907 1160 1744 1939 1217 1939 1879 1792 1916 1893 1470 1720
- 1953 -21988 1956 -21988 1964 2000 1924 -21988 1626 1767 1469 1559 1744 1969
- 1029 2199 1960 -21988 1648 -21988 1887 -21988 1931 2073 1888 -21988 1632 1941
- 1644 -21988 1541 -21988 1924 1585 1458 1913 1811 -21988 1641 -21988 1188 1540
- 1816 1992 1907 1941 1487 1486 1418 1970 1769 -21988 1721 1898 930 -21988 1952
- -21988 1674 -21988 1884 -21988 1876 -21988 1885 -21988 1388 2130 1322 -21988
- 1589 872 1298 1799 1711 1834 1067 2128 1970 1658 1847 1417 1687 1220 1804
- -21988 1849 2150 1947 -21988 1839 -21988 1880 -21988 1425 1936 1761 1593 1949
- 1791 100 { m20} R 1897 -21988 1518 -21988 1630 -21988 1709 -21988 1840 1460
- 1772 2139 1901 -21988 1845 -21988 1898 1823 1650 1846 1576 -21988 922 -21988
- 1916 -21988 1389 2219 1901 -21988 1827 1592 1545 1255 1814 -21988 1528 1281
- 1842 2025 1659 -21988 1956 1954 1702 1136 1860 -21988 1938 -21988 1966 1932
- 1761 -21988 1669 -21988 1207 2206 1782 -21988 1936 -21988 1701 2021 1719 1322
- 1787 -21988 1777 1334 1762 1731 1428 1298 1580 1537 1799 -21988 1921 1832 1958
- 1910 1608 -21988 1565 1910 1804 1869 1737 -21988 1774 -21988 1475 -21988 1963
- 2200 1934 -21988 1204 1311 1513 2014 1388 -21988 1714 -21988 1257 1585 1377
- -21988 1631 2049 1724 -21988 1718 677 1792 -21988 1829 -21988 1919 2056 884
- 2231 1271 -21988 1908 -21988 1897 -21988 1951 -21988 1832 -21988 1951 -21988
- 1863 -21988 1737 -21988 1660 -21988 1720 -21988 1717 1891 1716 -21988 1895 1413
- 1705 1601 1877 1760 1965 2122 1892 839 1751 1556 1001 2003 1885 -21988 1798
- 1164 1064 -21988 1341 -21988 1970 -21988 1721 -21988 1740 1604 1928 -21988 1480
- 1976 1888 2320 1720 2146 1958 1866 1462 -21988 1823 -21988 1257 2033 1558 1758
- 1801 1799 1734 -21988 1684 -21988 100 { m20} R 1467 -21988 1858 -21988 1970
- -21988 1685 1757 1168 -21988 599 2282 1965 1996 1279 -21988 1110 1842 1233
- -21988 1859 -21988 1766 -21988 1438 1458 1862 -21988 1675 -21988 1815 -21988
- 1347 -21988 1325 -21988 1921 -21988 1359 1659 1269 1924 1933 1405 1846 -21988
- 1948 -21988 1368 -21988 1832 1770 1709 1625 1911 -21988 1424 -21988 1689 1741
- 1220 1953 1881 -21988 1772 1955 800 -21988 1408 -21988 1535 1037 1887 -21988
- 1392 1539 1699 2170 1945 -21988 1581 -21988 1876 1926 1306 -21988 1730 838 1904
- -21988 1955 1105 1836 -21988 1949 -21988 1835 2003 1794 1884 1704 -21988 1954
- 1242 1568 1644 1630 1574 1828 2263 1959 2202 1946 -21988 1673 2054 1676 -21988
- 1857 -21988 1698 2009 1445 1348 1281 2257 1930 1899 1880 1589 1638 -21988 1756
- -21988 1581 1919 1929 -21988 1957 -21988 1938 -21988 1025 -21988 1905 -21988
- 1545 1781 1644 -21988 1770 1825 1663 1769 1585 -21988 1771 -21988 1631 -21988
- 1620 2092 1796 972 1864 -21988 1699 2184 1963 -21988 1959 -21988 1961 993 1786
- 1307 1410 -21988 1659 1989 1544 1771 1511 -21988 1735 -21988 1858 -21988 1136
- 1947 1894 2165 1922 2003 1782 2295 1893 -21988 1792 1165 100 { m20} R 1744
- -21988 1906 976 1206 1475 1939 1826 1770 1817 1364 -21988 1941 2215 1943 -21988
- 1798 -21988 1676 -21988 1420 -21988 1946 -21988 1947 -21988 1618 -21988 961
- -21988 1474 1730 1710 1951 1695 1423 1909 1886 1814 -21988 1533 -21988 1951
- -21988 1970 1665 1351 2270 1660 1435 1800 1510 1917 1398 1862 -21988 1710
- -21988 1768 2248 1644 1886 1402 -21988 1651 1664 1867 1118 1849 -21988 1970
- 1809 1783 -21988 1946 1518 1546 -21988 1972 -21988 -20 -21988 1006 1975 1845
- 1850 1934 -21988 1486 1825 1712 2016 1637 2194 1223 1874 1818 1878 1644 2070
- 327 1859 1836 -21988 1865 -21988 1884 2156 1938 1769 1913 2019 1971 -21988 1695
- 1873 1442 -21988 1891 -21988 1883 -21988 1938 1640 1658 -21988 1587 -21988 1858
- 2257 1808 -21988 1486 -21988 1967 1832 1883 2298 1819 -21988 1525 -21988 1908
- -21988 1704 -21988 1911 -21988 1714 -21988 1326 2206 1655 2056 1875 -21988 1948
- -21988 1910 -21988 1752 1737 1889 -21988 1924 -21988 1881 1939 1866 1582 1696
- -21988 1872 -21988 1799 -21988 1707 -21988 1752 1617 1409 1890 1810 2019 1957
- -21988 1728 -21988 1775 1887 1804 -10 1877 -21988 1919 -21988 1895 -21988 1524
- 1960 100 { m20} R 1607 1256 1571 1901 1606 -21988 1724 2300 1940 2087 1742 1900
- 1878 -21988 1618 -21988 1920 1286 1903 -21988 1548 2255 1769 -21988 1604 -21988
- 1809 -21988 1933 2014 1668 1652 1874 2093 1816 -21988 1908 -21988 1901 1728
- 1621 1925 1895 1525 1934 -21988 1555 1632 1793 -21988 1637 1982 1814 1977 1585
- -21988 1948 1961 1899 1690 1367 -21988 1734 -21988 1872 -21988 1628 2190 1774
- -21988 1953 2203 1306 1941 1971 1609 1890 1296 1837 1944 1934 -21988 1877
- -21988 1655 -21988 1377 -21988 1857 2071 1675 -21988 1707 1921 1773 750 1487
- -21988 1352 -21988 1655 2017 1404 -21988 1850 1985 1799 1659 1969 1984 1715
- 1609 1938 -21988 730 1545 1579 -21988 1837 1429 1384 1800 1615 -21988 1869 1728
- 1297 -21988 1366 1645 1926 -21988 1414 -21988 1271 -21988 1575 -21988 1837 1532
- 1854 1818 1889 -21988 1148 2068 1853 -21988 1557 1233 1799 2074 1239 2113 1853
- 1780 1518 -21988 1905 -21988 1728 1978 1541 2140 1625 -21988 1821 -21988 1819
- -21988 1564 -21988 1743 -21988 1909 1689 1507 -21988 1392 889 1961 -21988 1362
- -21988 1666 2166 1698 2048 1212 1785 1868 1791 950 1843 1850 928 1531 1766 1789
- -21988 100 { m20} R 1971 -21988 1272 -21988 1595 -21988 1739 -21988 1891 -21988
- 1831 -21988 1603 -21988 1771 1771 1942 1784 1681 1513 1943 1979 1899 -21988
- 1694 2200 1920 1578 1887 -21988 1560 744 1467 -21988 1958 -21988 1536 1978 1844
- -21988 1750 2013 1904 -21988 1949 1811 1951 1758 1711 1967 979 1890 1686 1919
- 1911 2312 1412 -21988 1614 1451 1787 2121 1927 -21988 1629 1551 1968 1716 1884
- -21988 1794 2062 1868 1471 1962 -21988 1304 2041 1487 1311 1944 1720 1846
- -21988 1742 1995 1514 1649 1877 -21988 1465 -21988 1879 1545 1631 -21988 1846
- -21988 1433 1742 1290 1802 1842 -21988 1906 -21988 1951 1550 1520 -21988 1515
- 1898 1572 -21988 1910 1430 1267 -21988 1399 -21988 1935 2188 1933 2069 1867
- -21988 1234 -21988 1353 1527 1779 2031 1910 1772 1771 -21988 1600 2039 1604
- -21988 1892 1740 1943 1856 1750 -21988 1959 1796 1717 -21988 1811 -21988 1891
- 1916 1619 1215 1797 674 1892 1937 1759 1721 1462 -21988 1749 1312 1938 -21988
- 1903 1870 1525 1635 1131 2078 1859 1563 1520 2186 1939 1365 1911 2027 1535 1791
- 1919 -21988 1953 1759 1862 -21988 1239 1941 779 1665 1496 1846 1375 -21988 1623
- 1783 100 { m20} R 1094 -21988 1936 1161 1738 -21988 1406 1586 1970 -21988 1823
- -21988 1647 -21988 1791 -21988 1878 -21988 1955 -21988 1869 2139 1247 -21988
- 1941 -21988 1875 -21988 1636 -21988 1603 -21988 1625 -21988 1941 1973 1153 1803
- 1957 -21988 1899 1652 1924 -692 1702 2149 1475 1590 1951 -21988 1955 -21988
- 1619 1265 1684 1321 1834 1658 1967 1068 1324 2002 1969 1893 1951 2004 1829 1918
- 1644 1689 1910 -21988 1476 1874 1696 2028 1894 -21988 1859 1832 1921 -21988
- 1613 2197 1077 2132 1898 2036 1542 1730 1504 -21988 1122 -21988 1929 2019 1536
- 1774 1427 1726 1903 -21988 1411 2228 1715 -21988 1883 1639 1205 -21988 1337
- -21988 1823 -21988 1951 1401 1471 -21988 1920 1513 1344 -21988 1657 -21988 1906
- -21988 1742 -21988 1828 1981 1721 -21988 1959 -21988 1940 1121 1794 1714 1916
- 2073 1819 -21988 1363 -21988 1883 -21988 1370 -21988 1887 -21988 1945 -21988
- 1877 2111 1564 2169 1829 1755 1851 2206 1848 1679 1768 -21988 1481 1445 1673
- 2134 1944 1955 932 -21988 1956 2095 1802 -21988 1798 -21988 1890 -21988 1905
- 1914 1922 1745 1700 1774 1902 1741 1662 -21988 1964 -21988 1868 -21988 1470
- -21988 1932 -21988 1580 -21988 100 { m20} R 1844 1787 1682 651 1937 -21988 1767
- -21988 1875 1299 1918 449 1724 -21988 1736 -21988 1468 1558 1920 -21988 1678
- -21988 1777 -21988 1214 1639 1833 2171 1711 1823 1627 1728 1862 1728 1928
- -21988 1738 -21988 1806 -21988 1835 2041 1773 2081 1941 -21988 1627 -21988 1685
- -21988 1644 -21988 1787 -21988 1946 -21988 972 1837 1533 -21988 1887 -21988
- 1941 2012 1860 -21988 1623 -21988 900 -21988 1875 -21988 1650 1800 1898 1690
- 1238 -21988 1839 2137 1109 -21988 1862 -21988 1671 1571 1659 -21988 1970 1496
- 1622 2148 1746 -21988 1925 -21988 1873 -21988 1205 -21988 1523 -21988 1933 2050
- 1553 -21988 1775 -21988 1971 2148 1358 2029 1959 -21988 1677 -21988 1902 -21988
- 1524 -21988 1874 -21988 1492 1939 1856 1570 1562 2250 1900 1317 1822 -21988
- 1749 -21988 1453 1910 1906 -21988 1834 -21988 1515 -21988 1353 -21988 1698
- -21988 1631 1825 1630 1760 1717 1282 1754 -21988 1899 -21988 1556 1793 1890
- 1722 1676 -21988 1826 -21988 1933 1544 1851 938 1941 -21988 1768 -21988 1616
- 1870 1785 -21988 1310 -21988 1799 -21988 1641 -21988 1123 -21988 1671 678 1826
- -21988 1169 2244 1126 -21988 1820 -21988 1707 -21988 1860 -21988 1867 1539 100
- { m20} R 1885 -21988 1958 1656 1867 -21988 1502 -21988 1501 -21988 1601 -21988
- 1958 1886 1211 1922 1534 -21988 1371 -21988 1722 -21988 1559 -21988 1919 -21988
- 1856 -21988 1593 -21988 1713 1721 1627 -21988 1681 -21988 1841 -21988 1931
- -21988 1826 -21988 1193 1566 1898 -21988 1574 -21988 1037 1760 1857 -21988 1856
- -21988 1590 -21988 1847 -21988 1816 1850 1905 -21988 1957 -21988 1903 2104 1908
- -21988 1954 2041 1878 -21988 1864 961 1417 1920 1364 1512 1725 2227 1795 -21988
- 1476 1653 1879 -21988 1928 -21988 1805 -21988 1585 1453 1834 -21988 1698 -21988
- 1794 -21988 1350 -21988 1948 -21988 1607 2194 1955 1872 1924 1926 1949 -21988
- 1946 1325 1750 -21988 1939 1559 1486 1696 1738 -21988 1966 1451 1914 -21988
- 1678 2080 1812 -21988 1749 766 1815 -21988 1861 1886 1453 -21988 1949 -21988
- 1824 1492 1532 -21988 1793 -21988 1907 1891 1708 2311 641 -21988 1183 1390 1502
- 1680 1767 -21988 1224 -21988 1476 -21988 1917 2251 1675 1820 1775 2029 1912
- 1900 1914 -21988 1544 -21988 1953 -21988 1885 1624 1913 -21988 1936 2075 790
- 1574 1534 -21988 1770 -21988 1890 1397 1936 804 1905 -21988 1960 1898 1932
- -21988 1390 1678 1691 -21988 100 { m20} R 1666 2309 1590 2080 1698 -21988 1808
- -21988 1912 -21988 1615 2317 1901 -21988 1486 -21988 1794 -21988 1514 -21988
- 1541 -21988 1928 -21988 1682 -21988 1973 -21988 1419 2037 1665 -21988 1926
- -21988 1827 -21988 1866 -21988 1845 -21988 1916 -21988 1961 -21988 1821 -21988
- 1618 1037 1868 1146 1895 2173 1701 -21988 1884 -21988 1447 1676 1804 -21988
- 1904 2207 1745 2045 1891 1326 1891 1946 1198 -21988 1695 -21988 1882 -21988
- 1906 2119 1785 1125 1268 2023 1036 2070 1746 2377 987 -21988 1537 -21988 1910
- -21988 1787 -21988 1924 2095 1298 2085 1932 -21988 1729 1882 1843 2086 692 2249
- 1804 -21988 665 -21988 1931 2158 1751 -21988 1078 1880 1886 1917 1924 1548 1565
- -21988 1841 1572 1953 1712 1767 -21988 1628 -21988 1210 2176 1656 1837 1627
- 1542 1464 -21988 1927 1565 1510 1275 1715 -21988 1445 -21988 1620 -21988 1595
- 1920 1856 -21988 1860 2058 1870 1517 1743 533 1549 -21988 1935 1856 1703 1230
- 1563 -21988 1868 -21988 1548 2293 1721 -21988 1136 1440 1682 1980 1493 -21988
- 1875 -21988 1743 -21988 1814 2110 1718 2000 1901 -21988 1200 1538 1582 1743
- 1670 -21988 1829 2146 1933 -21988 1687 1480 1765 -21988 100 { m20} R 1940
- -21988 1225 -21988 1935 1794 1320 1868 1294 -21988 1557 2257 1909 -21988 1432
- 2170 1846 -21988 1662 -21988 1960 1803 1923 -21988 1886 1477 1226 -21988 1878
- 2180 1954 1359 1910 -21988 1366 1641 1713 1324 1491 1684 1011 1946 1971 -21988
- 1775 -21988 1800 -21988 1964 1665 1439 -21988 1642 -21988 1951 1770 1465 -21988
- 1689 1889 1521 2061 1620 -21988 1524 2070 1846 -21988 1797 2147 1962 -21988
- 1735 -21988 1713 -21988 1908 1657 1858 1635 1730 -21988 779 -21988 1781 1181
- 1398 -21988 1582 -21988 1924 -21988 874 -21988 1740 -21988 894 -21988 1925
- -21988 1936 -21988 1810 -21988 1577 239 1896 -21988 1755 -21988 1956 2056 1947
- -21988 1483 1940 1942 -21988 1897 2155 1813 -21988 1919 -21988 1392 2205 1762
- 1049 1790 -21988 1568 -21988 1090 -21988 1966 1969 1362 2274 935 -21988 1668
- 1555 1967 -21988 1913 2000 1665 1671 1342 -21988 1957 2075 1576 -21988 1433
- 1705 1723 -21988 1970 1801 1945 -21988 1650 1928 1453 1285 620 1940 1034 -21988
- 1809 -21988 1592 -21988 426 -21988 1948 -21988 1765 -21988 1555 -21988 1580
- -21988 1073 1790 1838 -21988 1684 2205 1661 -21988 1801 -21988 1555 1850 1430
- -21988 1868 -21988 100 { m20} R 1623 -21988 1803 -21988 944 2284 1903 1791 1658
- 1998 1524 -21988 1966 -21988 1731 1790 597 -21988 1224 1931 1691 -21988 1167
- 2159 1833 2008 1888 2200 1864 -21988 1732 -21988 1566 -21988 1527 -21988 1929
- -21988 1555 -21988 1734 1640 1874 2022 1688 -21988 1886 2060 832 -21988 1578
- -21988 1935 -21988 1785 2104 1235 1567 1949 -21988 1918 612 1945 -21988 1829
- -21988 1797 -21988 1584 -21988 1370 -21988 1902 -21988 1162 -21988 1860 -21988
- 1439 2058 1754 1867 1636 -21988 1839 -21988 1821 1067 1450 -21988 1533 898 1788
- -21988 1909 -21988 48 { m20} R 1769 1296 1554 1474 1554 -21988 1812 -21988 1770
- -21988 1830 -21988 1373 1257 1800 -21988 1926 -21988 1847 1677 1968 2060 1964
- -21988 1180 -21988 1967 -21988 1819 -21988 1910 -21988 1603 2129 1904 1367 1571
- 1953 1590 1851 1844 -21988 1825 1835 1959 2300 1630 2016 1302 1724 1687 1622
- 1953 -21988 1609 2088 1405 -21988 1738 -21988 1874 -21988 1650 1499 1964 -21988
- 1416 -21988 1772 -21988 1793 1900 1706 2057 1595 -21988 1919 -21988 1493 -21988
- 1942 -21988 1883 -21988 1621 1793 1628 -21988 1420 -21988 1948 -21988 1903 1240
- 1971 -21988 1901 -21988 1639 -21988 1613 -21988 1897 -21988 1543 -21988 1400
- 2201 1763 1938 1719 1674 1643 -21988 1385 2114 1637 -21988 1866 -21988 1423
- 1591 1803 2012 1798 1464 1919 -21988 785 1848 1901 -21988 1813 1553 1898 -21988
- 1624 -21988 1463 795 1645 -21988 1430 -21988 1768 -21988 1858 1893 1750 1994
- 1545 -21988 1357 1863 1971 -21988 1496 -21988 1881 1982 1758 2104 1869 -21988
- 964 -21988 1298 1873 1918 1837 987 1870 1490 680 1964 2189 1447 -21988 1672
- 1282 1703 -21988 1773 -21988 1742 1831 1893 -21988 1844 1919 1802 2212 1973
- 1921 1483 -21988 1380 1441 1709 -21988 100 { m20} R 1346 1786 1849 2147 1853
- -21988 1952 1857 1669 -21988 1620 -21988 1455 2277 1661 1983 1926 -21988 1449
- 1767 1774 1939 1971 2098 1916 -21988 1448 1319 1444 -21988 1681 1950 1748
- -21988 1898 -21988 1765 -21988 1699 -21988 1777 -21988 1858 -21988 1575 -21988
- 1818 -21988 1632 -21988 1516 -21988 1965 1875 1192 1754 1951 -21988 1820 -21988
- 1412 -21988 1894 1819 1545 1459 1561 -21988 1189 -21988 1846 -21988 1913 -21988
- 1533 2080 1967 1956 1966 2101 1485 -21988 1792 -21988 1437 1411 1913 2196 1792
- -21988 1018 2182 909 -21988 1853 -21988 1872 1025 1498 1609 1199 -21988 1972
- 1767 1779 -21988 1759 -21988 1669 2111 1519 2288 1797 2033 1849 -21988 1830
- -21988 1852 -21988 1677 1481 1954 1791 1865 -21988 1955 1268 1811 1804 1698
- -21988 1834 1745 1944 1727 1788 -21988 1442 2256 1759 2082 1760 1993 1621
- -21988 1912 -21988 1127 1915 1696 1395 1676 -21988 1969 -21988 1843 1755 1751
- 1796 1351 2012 1655 -21988 1840 -21988 1625 1345 1846 1801 1601 1767 1972
- -21988 879 -21988 1911 -21988 1644 -21988 1796 1854 1910 1408 1209 1817 1758
- 1986 1667 1569 1875 -21988 1774 2112 1008 1394 1495 -21988 1540 1673 100 { m20
-} R 939 1494 1957 1482 1502 -21988 1768 -21988 1967 -21988 1555 2319 1831 -21988
- 1760 2287 1895 -21988 1823 944 1858 -21988 1862 2154 1878 1483 1695 1630 1378
- -21988 1605 -21988 1945 1980 1966 2162 1929 -21988 1546 -21988 959 1907 1811
- 1436 1316 -21988 1411 1815 1967 525 1955 -21988 1920 1680 1620 1691 1055 2071
- 1829 -21988 1350 2040 1875 1579 1853 -21988 1870 1681 1924 1830 1858 2001 1713
- -21988 1817 -21988 1876 -21988 1841 -21988 1532 1677 1893 1898 1915 1966 1891
- -21988 1292 -21988 1623 2010 1970 -21988 668 -21988 1846 1954 1829 2209 1150
- -21988 1782 -21988 1834 1169 1901 2119 1788 2093 1774 2031 1928 1839 1892
- -21988 1590 -21988 1736 1475 1947 -21988 1932 -21988 1258 -21988 1652 2198 1749
- -21988 1890 -21988 1657 -21988 1711 1360 1933 -21988 1821 2032 1970 -21988 1837
- 2133 1760 2015 1678 2020 1358 2052 1698 -21988 1785 2035 1789 -21988 1916
- -21988 1539 1491 1809 2054 749 -21988 1595 -21988 1466 2134 1921 2243 1972
- -21988 1360 1718 1742 -21988 1637 1927 1930 -170 1851 1910 1711 1443 1960 2141
- 1382 -21988 1909 1685 1678 1753 1703 -21988 1864 2069 1415 -21988 1972 1385 100
- { m20} R 1951 -21988 1733 -21988 1964 1952 1884 -21988 1693 1826 1913 1954 1867
- -21988 1678 -21988 1888 -21988 1692 -21988 1400 1104 1630 2083 1677 1170 1956
- 2022 1715 -21988 1959 1637 1936 1849 1929 1594 1783 -21988 1940 1768 1796
- -21988 1806 2099 865 -21988 1565 -21988 1641 -21988 1696 -21988 1931 -21988
- 1787 -21988 1764 -21988 1407 2207 1724 -21988 1914 1795 1798 -21988 1876 -21988
- 1832 -21988 1615 763 1846 1507 1936 1280 1710 -21988 1958 1326 1900 -21988 1764
- -21988 1785 -21988 1440 1856 1748 -21988 1339 2148 1665 2177 1409 1875 1496
- -21988 1563 -21988 1824 1461 1475 1418 1645 2344 1961 2066 1872 1500 1965
- -21988 1014 2149 1904 1529 1693 2057 1577 1737 1687 1643 1893 -21988 1735 1691
- 1951 -21988 1871 1972 1707 1956 1873 1874 254 -21988 1556 1531 1650 2259 1959
- -21988 1720 -21988 1636 -21988 1956 -21988 1915 -21988 1771 -21988 1762 -21988
- 1874 -21988 1467 -21988 1697 -21988 1754 2012 1484 1990 1751 -21988 1626 1769
- 1913 1839 1733 -21988 1695 1853 1030 -21988 1704 2189 826 -21988 1922 1724 1838
- 1585 1878 1401 1921 -21988 1918 1769 1868 -21988 1947 1906 1655 1198 1813 2081
- 1808 -21988 100 { m20} R 1872 -21988 1945 -21988 1936 -21988 1422 1785 1537
- 1276 1794 -21988 1905 -21988 1179 -21988 1904 1710 1915 1789 1802 1810 1865
- -21988 1928 1586 1794 1344 1222 -21988 1804 1880 1826 2144 1892 1960 1519 1939
- 1870 -21988 1856 1103 1005 1900 1866 257 1751 2132 1163 2053 1459 1748 1314
- 1296 1928 2210 1558 1983 1873 -21988 1881 -21988 1284 -21988 1200 1943 1335
- -21988 995 1334 1923 1683 1832 -21988 1847 1682 1903 -21988 1535 2048 1861
- -21988 1626 -21988 1814 -21988 1454 -21988 1936 -21988 1946 -21988 1963 1842
- 1619 -21988 1795 -21988 1413 -21988 1854 -21988 1870 1967 1847 -21988 1869
- -21988 1512 -21988 1268 2089 1769 -21988 1828 1687 923 -21988 1799 1589 1576
- 1842 1053 -21988 1912 1976 1894 -21988 1872 -21988 1621 2111 1945 -21988 1634
- 1993 1972 -21988 1518 -21988 1933 1752 1768 2058 1898 -21988 1836 1945 1867
- -21988 905 -21988 1805 -21988 1643 -21988 1822 -21988 1469 1760 1918 1749 894
- 1989 1811 -21988 1912 -21988 1790 -21988 1901 2151 871 1698 1544 -21988 1917
- -312 1891 -21988 1537 -21988 1929 2046 1745 -21988 1473 -21988 1741 -21988 1636
- -21988 1901 1233 1823 -21988 1738 2269 1708 2014 100 { m20} R 1970 1823 1685
- 1846 1963 2095 1771 -21988 1968 -21988 1318 -21988 1480 -21988 1555 2087 1596
- 1546 1415 -21988 1911 2044 1760 1343 1932 1319 1889 1074 1909 -21988 1874 2211
- 1846 1774 1920 1881 1968 -21988 1832 1666 1797 -21988 1712 1887 1842 1737 1609
- 1778 1844 1883 1902 -21988 1747 -21988 1910 -21988 1852 -21988 1405 1862 1897
- -21988 1758 1468 1473 1721 1577 1794 1748 -21988 1901 -21988 1855 1208 1378
- -21988 1869 1955 1757 1696 1891 1592 1906 -21988 1939 2076 1957 2173 1719
- -21988 1960 1320 1366 -21988 1888 2020 1754 -21988 1758 -21988 1859 -21988 1871
- 1901 1585 -21988 1449 -21988 1585 -21988 1879 2014 1884 1010 1919 1664 1941
- -21988 1404 1628 1938 -21988 1361 -21988 1630 -21988 861 1642 1760 2147 1659
- -21988 1918 -21988 1212 -21988 1727 -21988 1904 -21988 1656 -21988 1883 1380
- 1931 1784 1846 -21988 1894 1707 1840 2262 1758 -21988 1956 439 1894 1400 1971
- 2316 1791 1891 1780 -21988 1535 1052 1203 1763 1967 -21988 1877 2079 1866
- -21988 1694 2198 1817 -21988 1831 -21988 1762 -21988 1947 1400 1410 1851 1414
- -21988 1933 -21988 1920 -21988 1841 2125 1966 2075 1875 919 1748 2271 100 { m20
-} R 933 1071 1751 -21988 1893 -21988 1498 1450 1801 -21988 1888 -21988 1900
- -21988 1658 -21988 1751 -21988 1840 -21988 1327 -21988 1488 1451 1833 -21988
- 1754 -21988 1911 -21988 1966 1907 1903 -21988 1674 -21988 1959 -21988 1523 1208
- 1502 1810 1890 -21988 1948 -21988 677 1665 1890 1445 1726 -21988 1434 1722 1639
- -21988 1597 1973 1796 -21988 911 -21988 1962 2024 1964 -21988 1931 -21988 1938
- -21988 1913 1838 1769 -21988 1889 1789 1834 2177 1002 -21988 1440 -21988 1832
- -21988 1379 1951 962 -21988 1903 -21988 1968 -21988 1736 -21988 1814 2025 1749
- 1031 1421 -21988 1429 1659 1596 2134 1958 -21988 1865 1138 1771 -21988 1775
- 1516 1465 -21988 1603 -21988 1433 1548 1693 -21988 1132 1923 1878 1396 1772
- 1789 1971 -21988 1531 2240 1964 2076 1836 1489 1356 2104 1967 -21988 1829 2145
- 1922 -21988 1925 -21988 1944 -21988 1877 1524 1952 2120 1602 -21988 1900 -21988
- 1816 -21988 1759 -21988 1634 -21988 1736 2062 1639 1551 1731 2026 1821 1701
- 1550 1864 1541 -21988 1859 1784 1672 -21988 1180 1523 1728 -21988 713 -21988
- 1718 -21988 1701 1579 1701 1877 1596 -21988 1603 -21988 1815 -21988 1752 2183
- 1408 -21988 1887 671 100 { m20} R 1757 -21988 1801 -21988 1758 -21988 1217 2045
- 1824 -21988 1864 -21988 1972 1946 1568 -21988 1499 1008 1667 -21988 1656 1759
- 1950 2045 1868 1314 1629 1653 1870 -21988 1971 -21988 1297 1737 1782 -21988
- 1941 -21988 1671 1707 1629 1497 1851 -21988 1904 -21988 1937 2023 1593 -21988
- 1861 -21988 1948 -21988 1855 -21988 1494 1747 1280 1858 1525 -21988 1464 1889
- 1720 2103 1895 1419 1649 -21988 1878 -21988 1954 974 1710 2010 1842 1892 1354
- -21988 1114 1441 1959 1905 1972 1920 1855 -21988 252 959 1075 -21988 1859 2074
- 1701 -21988 1615 1701 1329 -21988 1681 1394 1941 -21988 1819 1305 1547 1539
- 1857 -21988 -102 1351 1837 1891 1829 -21988 1765 -21988 1634 1433 1864 1855
- 1715 -21988 1283 -21988 1538 1818 1867 1494 1675 1115 1610 -21988 1295 -21988
- 1726 -21988 1476 -21988 1182 2315 1830 1449 1387 1118 1804 2167 1872 -21988
- 1454 -21988 1312 -21988 1940 -21988 1887 -21988 1222 2091 1639 2074 1741 -21988
- 1453 -21988 219 1859 104 -21988 1861 -21988 1280 -21988 790 -21988 1919 -21988
- 1943 -21988 1093 1274 1919 -21988 1769 1686 1811 1054 1740 -21988 1883 1477
- 1661 -21988 1301 1555 1658 -21988 1951 1829 100 { m20} R 1867 -21988 1834
- -21988 1862 1695 1773 -21988 1872 -21988 1383 1995 1746 -21988 1731 1909 1599
- -21988 1901 -21988 1306 -21988 1731 -21988 1944 -21988 1733 -21988 1507 -21988
- 1440 -21988 1391 1350 1687 1212 1597 -21988 1825 -21988 1881 -21988 1699 1733
- 1460 -21988 1914 2004 1903 -21988 1753 1888 1928 -21988 1968 -21988 1959 1801
- 1669 -21988 1842 1932 1773 -21988 1783 2153 1795 -21988 941 1894 1768 -21988
- 1089 1764 1825 2132 1855 -21988 1794 1882 1902 -21988 1148 2143 1870 -21988
- 1869 -21988 1749 -21988 1731 -21988 1795 -21988 1721 2139 1543 -21988 1719 2128
- 1878 2044 1912 1330 1907 -21988 1814 -21988 1962 -21988 1627 -21988 1797 -21988
- 1929 1929 1649 1557 1649 912 1601 -21988 1917 -21988 1528 1743 1693 1864 1477
- 1612 1757 839 1943 1676 1947 -21988 1630 1992 1721 1395 1828 -21988 1745 -21988
- 1874 -21988 1769 -21988 1775 -21988 1318 -21988 1967 -21988 1639 -21988 1838
- -21988 1616 2094 1909 1639 1681 1755 1312 2293 1449 -21988 1925 -21988 1911
- 1417 986 2040 1828 -21988 1652 1197 1952 -21988 1708 1594 1819 -21988 1803 2097
- 1789 1970 1908 -21988 1297 -21988 1796 1946 1533 -21988 1468 1689 1905 -21988
- 100 { m20} R 1525 -21988 1970 -21988 1285 -21988 1804 -21988 1881 1568 881
- -21988 1789 -21988 1239 2107 1932 -21988 643 -21988 1914 -21988 1952 -21988
- 1655 -21988 1574 -21988 1295 -21988 1645 1672 1918 1507 1812 1933 1970 1376
- 1282 -21988 1387 1790 1900 -21988 1602 -21988 1828 1781 955 2115 1788 -21988
- 1543 -21988 1725 -21988 1726 -21988 1963 1847 1894 -21988 1891 -21988 1290 1544
- 1750 -21988 1935 -21988 1599 -21988 1515 -21988 1832 -21988 1506 864 1930
- -21988 1631 -21988 969 1895 1913 -21988 1229 -21988 1746 -21988 1733 1381 1841
- -21988 1926 1818 1528 1292 1749 -21988 1939 1715 1674 2158 1942 2210 1690
- -21988 1778 -21988 1809 1663 1464 2079 1943 -21988 682 -21988 1862 -21988 1890
- 1907 1767 1805 1598 -21988 1612 -21988 1886 2161 1746 1295 1634 1499 1719
- -21988 1589 2050 1948 1656 1768 1889 1360 2067 1770 -21988 1797 1649 1747 1893
- 1662 1743 1429 -21988 1895 -21988 1267 -21988 1811 -21988 1757 1142 1514 -21988
- 1518 1988 1636 1945 1509 2112 1736 -21988 1885 -21988 1792 -21988 1410 -21988
- 1766 2099 1754 -21988 1795 -21988 1951 -21988 1949 -21988 1928 1985 1923 -21988
- 1826 -21988 1272 -21988 1879 2004 1844 2179 100 { m20} R 1498 1864 570 -21988
- 1711 1795 911 -21988 1697 -21988 1719 -21988 1687 -21988 1530 -21988 1764
- -21988 1800 1977 1930 -21988 1198 -21988 1310 1683 1697 -21988 1903 -21988 1862
- 2027 1803 -21988 1893 -21988 1969 -21988 1871 1629 1948 -21988 1943 -21988 895
- -21988 1947 -21988 1037 1620 1793 -21988 1860 -21988 1595 -21988 1913 1757 1956
- -21988 1104 -21988 1828 -21988 1897 -21988 1942 -21988 1489 1739 1627 -21988
- 1682 -21988 1893 -21988 1965 -21988 1705 -21988 1674 1163 1932 -21988 1954 1426
- 1871 -21988 1892 -21988 1582 1558 1551 1933 1707 -21988 1931 -21988 1734 1840
- 1970 1757 1932 2102 1842 -21988 1555 -21988 1090 -21988 1653 2206 1618 -21988
- 1502 -21988 1842 1595 1419 -21988 1796 1332 1701 -21988 1494 -21988 1582 -21988
- 1966 1557 1507 2212 1946 1296 1900 -21988 1717 1083 1770 1905 1661 1806 1940
- 1742 1893 2013 1856 -21988 1918 2262 1911 -21988 1966 -21988 1504 1909 1698
- -21988 1736 -21988 1782 -21988 1847 1533 1320 2233 1841 1812 1866 2293 1305
- 1383 1939 2201 1705 7 1549 1821 1895 1832 1868 -21988 1702 -21988 1500 -21988
- 1907 -21988 1838 1832 1910 1216 1828 -21988 1770 -21988 1914 1838 1922 1821 100
- { m20} R 1489 2060 1734 -21988 1762 1572 1708 -21988 1228 2083 1507 -21988 1739
- -21988 1720 -21988 1963 -21988 1605 2128 1499 -21988 1793 -21988 1850 1397 1547
- -21988 1562 1991 1923 -21988 1961 -21988 1669 -21988 1751 2117 1886 1362 1515
- 1856 1414 -21988 1727 -21988 1903 -21988 1951 1446 1269 2132 1888 2018 1912
- 1931 1611 -21988 1939 -21988 1963 -21988 1739 -21988 1821 -21988 1656 -21988
- 1712 2139 1780 -21988 1936 647 1585 1732 1737 1507 1437 2106 1964 -21988 1773
- 1809 1833 -21988 1641 -21988 959 -21988 1914 1621 1673 -21988 1865 -21988 1907
- 1417 1341 1182 1972 527 1006 -21988 1845 1790 1692 -21988 1532 2084 1903 1612
- 1971 -21988 1557 2082 1719 2283 -142 1871 1669 -21988 1559 2021 1873 -21988
- 1128 1886 1605 -21988 1746 1258 1828 -21988 1418 -21988 1891 1727 1894 2214
- 1712 -21988 1852 -21988 1882 1553 1313 -21988 770 1923 1673 1325 1172 1622 1921
- 1663 1971 714 1395 -21988 1520 -21988 1791 -21988 1644 1881 1787 1853 1804
- -21988 1617 -21988 1849 2016 1561 -21988 1733 -21988 1290 -21988 1648 1517 1481
- 1626 1420 1805 1841 2041 1728 1468 948 -21988 1846 1216 1461 -21988 1695 1605
- 1908 1304 100 { m20} R 1851 2036 1248 2147 1799 -21988 1399 -21988 1794 1952
- 1797 -21988 1784 2104 1838 1825 1778 -21988 535 1869 1688 1120 1962 478 1892
- 2280 1909 -21988 1683 1710 1835 -21988 1930 1824 1537 -21988 1812 -21988 1722
- 1976 1837 1903 1293 1756 1782 -21988 1932 -21988 1545 2026 1765 1140 1332 1967
- 1076 2036 1882 1810 769 1708 1796 2257 1237 1916 1584 -21988 1906 -21988 1601
- 1639 1787 2158 1662 -21988 1830 1426 1945 -21988 1935 2196 1614 -21988 1885
- -21988 1811 -21988 1300 2130 1835 2188 1948 1687 1506 1867 1970 1361 1943
- -21988 1629 -21988 1648 1899 1938 -21988 1202 -21988 1689 1874 1865 1559 507
- -21988 1950 2066 1936 -21988 1476 -21988 1957 -21988 1834 2216 1903 -21988 1957
- -21988 892 -21988 1930 2137 1431 1927 1520 -21988 1882 2088 1738 -21988 1362
- 1244 1724 2062 1700 -21988 1958 1796 1970 1314 1460 1571 1849 -21988 1730
- -21988 1871 -21988 1502 -21988 1872 1374 1912 -21988 1921 1897 1852 -21988 1885
- -21988 1360 1907 1888 1968 1878 -21988 1717 -21988 1918 1254 1802 -21988 1489
- 1832 1810 615 1905 1540 1377 -21988 1726 1672 1867 -21988 1577 2351 1954 -21988
- 1346 1730 1748 -21988 100 { m20} R 1629 -21988 1906 1914 1415 -21988 1868 2153
- 1596 -21988 1191 -21988 967 1185 1472 -21988 1587 1840 1829 1544 1925 -21988
- 1955 -21988 1298 -21988 1477 -21988 1913 -21988 1865 1972 1970 1969 1009 2059
- 1961 1968 1686 1908 1852 -21988 1418 -21988 1890 1560 1224 1749 1943 2027 1370
- 2081 1820 1800 1811 1997 1491 1182 1174 1879 1593 1318 1487 -21988 1941 2061
- 1878 1820 1620 -21988 1847 886 1796 1897 1928 -21988 1816 2071 1846 -21988 1671
- 1956 1876 1244 1842 -21988 1856 2189 966 1894 1903 1973 1615 1741 1767 -21988
- 1812 -21988 1663 1341 1869 1723 1923 1959 1077 2018 1150 1951 1643 2085 1503
- -21988 1799 1939 1701 -21988 1955 -21988 1530 2451 1904 -21988 1819 2096 1892
- 2023 1856 1725 1427 -21988 1972 -21988 1182 -21988 1735 -21988 1956 1701 633
- 1917 1475 -21988 1848 -21988 916 -21988 1788 -21988 1814 1357 1952 2231 1583
- 1984 1871 2065 1908 -21988 1533 -21988 1854 -21988 1847 2105 1748 -21988 1935
- -21988 1853 -21988 1799 1935 1560 -21988 896 -21988 1769 1906 1469 -21988 1939
- -21988 1882 -21988 1780 601 1740 1355 1455 1823 1819 -21988 678 2129 1954
- -21988 1708 2041 950 -21988 100 { m20} R 1818 -21988 1802 1928 1971 -21988 1660
- -21988 1639 -21988 922 -21988 1921 1678 1287 1744 1565 -21988 1564 1957 1925
- 1730 1936 1753 1950 1544 1614 -21988 1742 1553 1863 -21988 1626 -21988 1786
- 2208 1831 -21988 1869 -21988 1918 -21988 1963 -21988 1419 -21988 1770 1975 1450
- -21988 1811 1995 1574 2359 1907 1658 1778 2196 1753 1671 1642 2006 1740 1181
- 1885 -21988 1756 1289 1962 1006 1808 -21988 1916 -21988 1733 1183 1961 -21988
- 1874 1984 1949 2210 1406 -21988 1803 1525 1940 1739 1569 -21988 1930 1880 1907
- -21988 1923 -21988 1648 1861 1772 -21988 1744 -21988 1842 1149 1816 1283 1252
- -21988 1956 2250 1873 1640 1675 1686 1900 1573 1969 1774 1840 2227 1774 2019
- 1350 -21988 1456 -21988 1807 433 1833 -21988 1866 -21988 1614 -21988 1888
- -21988 1546 -21988 1629 2032 1559 1445 1666 -21988 1421 -21988 1914 -21988 1347
- 1768 1942 -21988 1956 -21988 1955 -325 297 -21988 1484 1996 1972 -21988 1579
- -21988 1857 -21988 1864 2237 1662 -21988 1915 1991 1835 1715 1472 1485 1180
- 2182 544 -21988 1796 -21988 1930 -21988 1719 -21988 1392 -21988 1707 1872 1876
- -21988 1703 1226 924 -21988 756 -21988 1963 -21988 100 { m20} R 1238 -21988
- 1595 2110 1867 -21988 1969 -21988 1737 2006 1503 -21988 1724 -21988 1732 -21988
- 1510 1948 1547 1746 1421 1293 1923 1888 1530 -21988 1872 1765 1632 1993 1901
- 1581 1593 1824 1784 1230 1360 -21988 1954 -21988 1843 1878 1671 1875 1890 1587
- 1868 -21988 1836 -21988 1588 2045 1653 -21988 1896 -21988 1911 -21988 1811
- -21988 1247 1907 1908 -21988 1521 1056 1407 2019 1370 1843 1736 -21988 1743
- -21988 1828 -21988 1719 -21988 1960 -21988 1765 -21988 1810 1339 1660 1941 1954
- 1800 1483 2038 1725 2109 1840 1450 1789 2256 1335 -21988 1556 -21988 1901
- -21988 1324 -21988 1939 -21988 1735 -21988 1701 -21988 1726 -21988 1936 2057
- 1835 -21988 1694 -21988 1276 1949 1953 1452 1017 -21988 1785 -21988 1654 -21988
- 1735 1785 1864 -21988 1917 2045 1665 -21988 1875 2142 1524 1842 1800 2246 1853
- 1968 1451 -21988 1635 -21988 1933 1924 1739 1563 1703 -21988 1705 -21988 1759
- -21988 1668 -21988 1846 2319 1644 1327 1018 -21988 1819 -21988 1846 2016 1814
- 1622 512 -21988 1399 -21988 1661 -21988 1510 -21988 1637 -21988 1953 -21988
- 1824 -21988 1769 -21988 1422 2046 1960 2172 1951 1916 1876 1639 1694 733 1365
- -21988 100 { m20} R 1485 1457 1800 -21988 1967 1558 1888 2275 829 -21988 1825
- 2042 1840 1697 1886 2141 1811 1885 1731 -21988 1731 1587 1761 2091 1324 1870
- 1809 1737 1761 1733 1972 2278 1689 1786 1579 1736 1806 -21988 975 1799 1863
- 2119 1793 2148 1957 1991 1874 -21988 1956 2126 1346 1774 1627 -21988 1629
- -21988 1889 1811 1935 -21988 1336 -21988 1788 2340 1078 1378 1830 -21988 1940
- 2021 1724 -21988 1255 -21988 461 -21988 1612 1513 1554 -21988 1972 -21988 1910
- -21988 1622 -21988 1802 -21988 1096 1824 1660 -21988 1898 2126 1699 -21988 1609
- -21988 1750 -21988 1824 1911 1923 1738 1902 -21988 1962 -21988 1930 -21988 1875
- -21988 1828 -21988 1621 -21988 1462 1952 867 2113 1495 1769 1886 2092 1810
- -21988 1539 1661 1565 -21988 1970 737 1798 -21988 1671 2056 1640 1705 1118
- -21988 1847 -21988 1894 -21988 1866 2009 1787 1311 1665 1296 1234 -21988 1459
- 1630 1518 2020 1944 -21988 1647 -21988 1752 -21988 1619 -21988 1574 -21988 1928
- 1372 1757 -21988 543 1691 1833 -21988 1871 -21988 1283 1808 1899 2145 1391
- -21988 1840 -21988 1570 1730 1836 1175 1879 1602 1933 1512 1678 -21988 1826
- -21988 1745 -21988 1936 -21988 100 { m20} R 1820 1522 1382 -21988 1907 2055
- 1077 -21988 1162 -21988 1940 2101 1946 -21988 1725 1257 1828 1817 1816 1241
- 1677 1345 1840 1871 1803 1004 1709 1705 1888 -21988 872 -21988 1951 -21988 1735
- 2080 1949 1965 1956 -21988 1889 -21988 1417 1901 1860 -21988 1557 2115 1913
- 1121 1850 -21988 1495 -21988 1589 -21988 1492 -21988 1763 -364 1583 1352 1837
- -21988 1783 -21988 1590 -21988 1754 2067 1938 1495 1678 -21988 1842 1945 1883
- 2080 1904 1947 1450 -21988 1930 1097 1834 -21988 1786 -21988 1713 -21988 1889
- 2102 1900 2206 1853 2049 1119 1513 1727 -21988 1623 1987 1353 2158 1943 1400
- 1670 -21988 1664 -21988 1689 -21988 1245 1659 1833 -21988 1402 -21988 986
- -21988 1836 -21988 1386 1223 1904 1672 1962 -21988 1838 -21988 1617 -21988 1434
- 1850 1756 1332 1833 -21988 1661 -21988 1852 2310 1822 -21988 883 1802 1810
- -21988 1778 -21988 1755 1598 1617 2179 1461 -21988 1662 -21988 1601 1151 1792
- 1582 1637 2085 1901 1785 1865 1302 1844 2024 1819 2024 1578 1562 1832 -21988
- 1861 -21988 1034 1801 1567 2138 1626 1832 1616 2118 1949 1811 1894 -21988 1901
- 1670 1664 -21988 1936 -21988 1733 -21988 1682 2071 100 { m20} R 1705 1916 1772
- -21988 1263 2174 1946 -21988 1694 -21988 927 -21988 1963 1804 1679 -21988 1346
- 1855 1613 1449 1768 -21988 1962 1954 1955 -21988 1792 -21988 840 -21988 1378
- 971 1889 -21988 1460 1674 1852 1838 1695 2092 1966 -21988 763 -21988 1644 1895
- 1969 -21988 1764 -21988 1257 -21988 1877 -21988 1399 -21988 1647 2014 1961 1648
- 1235 -21988 1846 1763 603 1449 1903 208 1890 -21988 1630 1918 1821 1936 1965
- 1567 1817 -21988 1747 1654 1412 -21988 1498 1893 1774 -21988 1942 902 1670
- -21988 1477 2185 1744 -21988 1819 962 1570 1423 1920 1105 1005 1992 1777 2179
- 1339 -21988 1638 -21988 710 1825 849 -21988 1919 -21988 1905 2010 1810 -21988
- 1587 1373 1830 679 826 2013 1659 2086 1869 -21988 1805 1986 711 -21988 1623
- 1791 1873 -21988 1512 1919 1891 -21988 1839 -21988 1835 2060 1901 -21988 1758
- 1931 1968 1567 1743 -21988 1499 -21988 1847 -21988 1953 2081 1753 1922 1416
- -21988 1964 2189 1594 -21988 1969 1796 1559 2014 1553 -21988 1371 -21988 1527
- -21988 1558 2288 1881 -21988 1677 -21988 1692 -21988 1364 1812 1904 1540 1068
- 2094 1509 -21988 1748 1763 1603 -21988 1427 2066 1870 -21988 100 { m20} R 1775
- 1774 1752 -21988 1917 1998 1651 1675 1913 1878 1181 -21988 1697 -21988 1705
- -21988 1787 -21988 1963 1981 1634 -21988 1706 -21988 1895 2127 1632 -21988 1682
- 1476 1746 2049 1747 2016 1862 1849 1253 1774 1252 -21988 1844 -21988 1912
- -21988 1869 -21988 1940 1721 1967 -21988 1902 -21988 1931 -21988 1885 -21988
- 1894 -21988 1918 1750 1492 -21988 1916 1709 415 -21988 1842 1994 1790 1915 1972
- 2001 1884 -21988 1689 1587 1763 -21988 1862 1611 1767 -21988 1518 1745 1818
- -21988 1375 -21988 1576 1927 1804 -21988 1499 -21988 1957 1665 1966 -21988 1052
- 700 1962 -21988 1535 -21988 1964 1510 1718 -21988 1667 -21988 1718 -21988 1417
- -21988 1567 -21988 1685 -21988 1810 -21988 1954 -21988 1079 1591 1880 -21988
- 1644 -21988 1677 1906 1934 -21988 1919 689 1040 -21988 1795 -21988 1619 -21988
- 1551 1296 1660 -21988 1640 1816 1812 1462 1962 -21988 1917 -21988 1890 -21988
- 1740 1919 1914 1691 1588 2007 1955 1758 1607 -21988 1858 -21988 1886 -21988
- 1949 -21988 1876 1949 1784 -21988 1469 2175 1957 1773 1962 2056 1617 600 1304
- -21988 1782 -21988 1534 1310 1598 -21988 1942 2114 1626 -21988 1149 -21988 1941
- 1419 1592 2194 100 { m20} R 1808 1905 1744 -21988 1814 1925 1968 -21988 1713
- 1906 1807 2158 1734 -21988 1613 -21988 1847 1542 1892 2065 1924 -21988 1866
- -21988 1791 1357 1919 1527 1880 1953 1527 2079 1969 -21988 1795 1903 1648 2091
- 1524 1748 1923 -21988 1731 -21988 1795 -21988 1746 -21988 1476 1367 1734 2026
- 1845 1944 1941 -21988 1962 1657 1779 -21988 1616 -21988 1081 1983 1924 1814
- 1661 -21988 1863 -21988 1689 -21988 831 -21988 1910 -21988 1697 -21988 1814
- 2167 1796 1280 1885 2031 1671 -21988 1657 1871 1882 1946 1853 1571 1398 519
- 1857 1850 48 { m20} R 1577 -21988 1670 -21988 1942 -21988 1965 1973 1350 -21988
- 1969 1934 1742 1896 1900 2179 1850 1518 1504 -21988 1906 -21988 1766 -21988
- 1492 -21988 1865 1121 1830 1772 1876 860 1752 -21988 1877 1728 1310 -21988 1846
- -21988 384 -21988 1971 2106 1824 2077 1789 -21988 1647 -21988 1793 -21988 1930
- 1472 1891 1738 1587 -21988 1507 -21988 1955 -21988 1330 1318 1766 2051 1884
- -21988 1870 1194 1878 1481 1922 -21988 1467 1634 1898 -21988 1830 -21988 1267
- -21988 1505 2174 979 -21988 1661 -21988 1657 -21988 1924 1570 1962 2058 1926
- -21988 1768 2064 1929 2171 1652 1786 1797 2085 1432 -21988 1760 -21988 1652
- 1870 1874 2068 1938 -21988 603 1570 1918 1997 1581 -21988 1648 -21988 1728
- -21988 1902 -21988 1213 -21988 1958 2185 1973 1787 1785 1927 1644 -21988 1864
- -21988 1430 -21988 1942 -21988 899 1661 1585 1918 1924 -21988 1968 1705 1522
- 1949 1963 -21988 1558 -21988 1924 1878 1893 1161 1926 -21988 1305 1888 1667
- -21988 1669 -21988 1837 2185 1966 2154 1925 -21988 1581 2103 1971 -21988 1757
- -21988 1540 -21988 1760 -21988 1743 2089 1897 1414 1488 1297 1883 1494 1777
- 1698 1634 750 1837 1963 1928 -21988 100 { m20} R 1268 2078 1674 1877 1918 1350
- 1917 2065 1567 1998 1947 -21988 1933 1443 1168 2054 998 -21988 1647 -21988 1936
- -21988 1902 1541 1893 -21988 1526 -21988 1785 1697 1921 -21988 1950 -21988 1936
- -21988 1951 -21988 1439 -21988 1912 -21988 1966 -21988 1856 -21988 1839 -21988
- 1364 -21988 1524 -21988 1938 2097 937 -21988 1794 1727 1953 -21988 1813 -21988
- 1815 883 1506 -21988 1306 1269 1687 -21988 1760 -21988 1942 -21988 1953 -21988
- 1825 2024 1365 2169 1092 1987 1739 1751 1939 1896 1940 -21988 1515 1762 1289 90
- 1765 1466 1923 -21988 1969 -21988 1886 -21988 1940 -21988 1709 -21988 1804
- -21988 1696 1650 1808 2068 1972 1851 1806 -21988 1528 -21988 1900 1859 1637
- 1832 1139 1572 1965 -21988 1577 -21988 1889 -21988 1541 1777 1791 1955 1306
- 2019 1481 -21988 1906 -21988 1891 1494 1406 -21988 1733 1535 1844 1858 1793
- -21988 1929 1804 1030 1585 1940 2172 1575 -21988 1722 -21988 1965 1530 1932
- -445 1680 -21988 1817 2188 1815 -21988 1910 2252 1067 -21988 1929 -21988 1419
- -21988 1583 -21988 1919 -21988 508 1749 1266 1904 1835 2003 1588 1849 1802
- -21988 1898 -21988 1799 -21988 1773 2009 1773 1467 1807 -21988 100 { m20} R
- 1028 -21988 1903 -21988 1872 -21988 1690 1846 1409 1640 1651 -21988 1578 -21988
- 1919 2003 1540 -21988 1848 -21988 1572 -21988 1926 -21988 1747 2184 894 -21988
- 1935 -21988 1678 -21988 1950 2115 1588 -21988 1897 1163 1706 1369 1866 2143
- 1826 -21988 1845 1868 1500 -21988 1803 2194 1894 -21988 1540 1308 1537 -21988
- 1523 1761 1891 1676 1952 -21988 1817 2164 1756 1326 1749 -21988 1549 1298 1835
- 1323 1814 -21988 1805 2100 1516 828 1960 1759 1925 1927 1635 1931 1628 1996
- 1766 -21988 1921 1838 1628 -21988 1367 1814 1715 -21988 1471 -21988 1661 1721
- 1407 -21988 1956 -21988 1882 -21988 1880 1356 1771 -21988 1378 -21988 1936
- -21988 867 2006 1720 -21988 1513 2096 1540 1884 1116 -21988 1884 2173 1259 2012
- 1903 1363 1686 1958 1858 1763 1363 1417 1845 -21988 1863 1346 1070 -21988 1951
- 2031 1409 -21988 1625 2054 1929 1836 1597 -21988 1850 1490 1317 1567 1409
- -21988 1494 -21988 1965 1944 1741 -21988 1909 -21988 1563 -21988 1624 -21988
- 1954 1891 1785 -21988 1912 1876 1789 -21988 1577 -21988 1708 -21988 1796 1722
- 1505 -21988 1849 1932 1467 -21988 1760 -21988 1970 1704 1817 1746 1814 1675
- 1793 2232 100 { m20} R 1369 -21988 1821 2005 1873 760 1808 1773 1619 2127 1756
- -21988 1379 2019 748 2220 1433 -21988 1529 -21988 1435 -21988 1490 2052 1876
- 1199 879 2096 1760 -21988 1427 2116 1872 1614 1854 1752 1657 -21988 1741 -21988
- 1694 -21988 1739 1758 1957 2061 1665 1997 1916 -21988 1856 -21988 1794 1361
- 1395 -21988 1917 -21988 1860 -21988 1759 -21988 1842 -21988 1607 1857 1919 1788
- 1786 -21988 1920 1675 1674 1403 1807 1947 1498 -21988 1829 -21988 1544 -21988
- 1268 1744 1552 2085 1107 1755 1931 -21988 1055 -21988 1908 -21988 1537 2137
- 1479 1623 1962 1727 1686 -21988 1946 -21988 1770 1467 877 -21988 1936 1494 1707
- -21988 1852 1814 1909 -21988 963 -21988 1938 -21988 1800 -21988 1956 -21988
- 1810 2100 1463 2080 1869 2057 1916 -21988 1923 -21988 1685 -21988 1920 2047
- 1282 -21988 1648 1603 1916 -21988 1222 -21988 1460 -21988 1879 1759 1348 1616
- 1812 1648 1907 1896 1899 1934 1897 -21988 1420 -21988 1848 1727 1369 -21988
- 1357 -21988 1433 2035 1825 1395 1669 1196 1950 -21988 1902 -21988 1964 916 1928
- 1283 1534 1966 1835 -21988 1615 -21988 1520 1964 1884 -21988 1126 -21988 1826
- -21988 736 2064 1712 1604 100 { m20} R 1613 1767 1809 -21988 1578 -21988 1833
- 2282 1956 -21988 1725 -21988 1439 2097 1938 1816 1791 1426 1808 1972 1714 2023
- 1402 1347 1859 -21988 1563 2010 863 -21988 942 -21988 1455 2187 1636 -21988
- 1531 -21988 1425 1952 1892 1798 1614 -21988 1308 -21988 1841 -21988 1888 -21988
- 1678 1267 1868 -21988 1239 2120 1704 1349 1799 1827 1594 -21988 1692 2332 1760
- 2129 1795 -21988 1932 -21988 1844 -21988 1742 -21988 1739 2057 1467 -21988 1935
- 2037 1714 1737 1887 1194 1914 1722 1874 -21988 1845 -21988 1369 1889 1705
- -21988 1812 2038 1958 -21988 1463 1273 1442 -21988 1615 1949 1712 1733 1967
- 2374 1904 1842 1839 2027 1937 -21988 1610 -21988 1929 -21988 1713 1692 1666
- 2099 1830 -21988 1959 1842 1938 -21988 1767 1932 1955 1880 1914 -21988 1580
- -21988 1970 -21988 1871 -21988 1941 2074 1699 1270 1749 -21988 1945 2213 1692
- 1181 1336 1970 1394 -21988 1748 901 1294 -21988 1527 -21988 1927 -21988 911
- 1913 1954 -21988 1630 -21988 1968 -21988 1811 1890 1880 -21988 1937 -21988 1814
- 2110 1861 2069 1957 1447 1435 1739 1897 -21988 1805 2025 1809 1823 1704 -21988
- 1716 -21988 1560 1368 1807 -21988 1874 -21988 100 { m20} R 1867 -21988 1732
- -21988 1629 1870 1872 -21988 1902 2160 1656 2249 1775 1394 1438 869 1773 1250
- 1704 -21988 1451 1691 1753 2100 1622 -21988 1803 -21988 1644 -21988 1135 -21988
- 1281 2238 1297 1884 1800 -21988 1223 2069 20 { m20} R gr
-showpage
- gr
-%%Trailer
-%%Pages: 1
- gr gr
-%%EOF
diff --git a/src/pawlib/paw/testsuite/paw.commands/nt_pl_2d_box.ref.ps b/src/pawlib/paw/testsuite/paw.commands/nt_pl_2d_box.ref.ps
deleted file mode 100644
index 38d064a..0000000
--- a/src/pawlib/paw/testsuite/paw.commands/nt_pl_2d_box.ref.ps
+++ /dev/null
@@ -1,441 +0,0 @@
-%!PS-Adobe-2.0
-%%Title: /disk3/maartenb/cerncvs/paw/testsuite/tmp/nt_pl_2d_ (Portrait A 4)
-%%Pages: (atend)
-%%Creator: HIGZ Version 1.23/06
-%%CreationDate: 96/04/16 16.05
-%%EndComments
-%%BeginProlog
-/s {stroke} def /l {lineto} def /m {moveto} def /t {translate} def
-/sw {stringwidth} def /r {rotate} def /rl {roll} def /R {repeat} def
-/d {rlineto} def /rm {rmoveto} def /gr {grestore} def /f {eofill} def
-/c {setrgbcolor} def /lw {setlinewidth} def /sd {setdash} def
-/cl {closepath} def /sf {scalefont setfont} def /black {0 setgray} def
-/box {m dup 0 exch d exch 0 d 0 exch neg d cl} def
-/NC{systemdict begin initclip end}def/C{NC box clip newpath}def
-/bl {box s} def /bf {box f} def /Y { 0 exch d} def /X { 0 d} def
-/mp {newpath /y exch def /x exch def} def
-/side {[w .77 mul w .23 mul] .385 w mul sd w 0 l currentpoint t -144 r} def
-/mr {mp x y w2 0 360 arc} def /m24 {mr s} def /m20 {mr f} def
-/mb {mp x y w2 add m w2 neg 0 d 0 w neg d w 0 d 0 w d cl} def
-/mt {mp x y w2 add m w2 neg w neg d w 0 d cl} def
-/m21 {mb f} def /m25 {mb s} def /m22 {mt f} def /m26 {mt s} def
-/m23 {mp x y w2 sub m w2 w d w neg 0 d cl f} def
-/m27 {mp x y w2 add m w3 neg w2 neg d w3 w2 neg d w3 w2 d cl s} def
-/m28 {mp x w2 sub y w2 sub w3 add m w3 0 d 0 w3 neg d w3 0 d 0 w3 d w3 0 d
- 0 w3 d w3 neg 0 d 0 w3 d w3 neg 0 d
- 0 w3 neg d w3 neg 0 d cl s } def
-/m29 {mp gsave x w2 sub y w2 add w3 sub m currentpoint t
- 4 {side} repeat cl fill gr} def
-/m30 {mp gsave x w2 sub y w2 add w3 sub m currentpoint t
- 5 {side} repeat s gr} def
-/m31 {mp x y w2 sub m 0 w d x w2 sub y m w 0 d
- x w2 sub y w2 add m w w neg d x w2 sub y w2
- sub m w w d s} def
-/m2 {mp x y w2 sub m 0 w d x w2 sub y m w 0 d s} def
-/m5 {mp x w2 sub y w2 sub m w w d x w2 sub y w2 add m w w neg d s} def
-/DP {/PT exch def gsave 47.2 47.2 scale PT 1 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < AA AA 55 55 AA AA 55 55 AA AA 55 55 AA AA 55 55 AA AA 55 55 AA AA 55 55
-AA AA 55 55 AA AA 55 55 > } image } if PT 2 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < BB BB EE EE BB BB EE EE BB BB EE EE BB BB EE EE BB BB EE EE BB BB EE EE
-BB BB EE EE BB BB EE EE > } image } if PT 3 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < FF FF BB BB FF FF EE EE FF FF BB BB FF FF EE EE FF FF BB BB FF FF EE EE
-FF FF BB BB FF FF EE EE > } image } if PT 4 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < DF DF BF BF 7F 7F FE FE FD FD FB FB F7 F7 EF EF DF DF BF BF 7F 7F FE FE
-FD FD FB FB F7 F7 EF EF > } image } if PT 5 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < 7F 7F BF B F DF DF EF EF F7 F7 FB FB FD FD FE FE 7F 7F BF BF DF DF EF
-EF F7 F7 FB FB FD FD FE FE > } image } if PT 6 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB
-BB BB BB BB BB BB BB BB BB > } image } if PT 7 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < FF FF FF FF FF FF 00 00 FF FF FF FF FF FF 00 00 FF FF FF FF FF FF 00
-00 FF FF FF FF FF FF 00 00 > } image } if PT 8 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < EE EE 47 47 83 83 C5 C5 EE EE 5C 5C 38 38 74 74 EE EE 47 47 83 83 C5
-C5 EE EE 5C 5C 38 38 74 74 > } image } if PT 9 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < EF EF EF EF D7 D7 38 38 FE FE FE FE 7D 7D 83 83 EF EF EF EF D7 D7 38
-38 FE FE FE FE 7D 7D 83 83 > } image } if PT 10 eq { 16 16 1 [ 16 0 0 16 neg
-0 16 ] { < EF EF EF EF EF EF 00 00 FE FE FE FE FE FE 00 00 EF EF EF EF EF EF
-00 00 FE FE FE FE FE FE 00 00 > } image } if PT 11 eq { 16 16 1 [ 16 0 0 16
-neg 0 16 ] { < F7 F7 B6 B6 D5 D5 E3 E3 D5 D5 B6 B6 F7 F7 FF FF 7F 7F 6B 6B 5D
-5D 3E 3E 5D 5D 6B 6B 7F 7F FF FF > } image } if PT 12 eq { 16 16 1 [ 16 0 0
-16 neg 0 16 ] { < E3 E3 DD DD BE BE BE BE BE BE DD DD E3 E3 FF FF 3E 3E DD DD
-EB EB EB EB EB EB DD DD 3E 3E FF FF > } image } if PT 13 eq { 16 16 1 [ 16 0
-0 16 neg 0 16 ] { < FE FE 7D 7D BB BB D7 D7 EF EF D7 D7 BB BB 7D 7D FE FE 7D
-7D BB BB D7 D7 EF EF D7 D7 BB BB 7D 7D > } image } if PT 14 eq { 16 16 1 [ 16
-0 0 16 neg 0 16 ] { < 00 00 EE EF EE EF EE EF 0E E0 EE EE EE EE EE EE 00 EE
-FE EE FE EE FE EE 00 00 FE EF FE EF FE EF > } image } if PT 15 eq { 16 16 1 [
-16 0 0 16 neg 0 16 ] { < DD DD AA AA DD DD FF FF 77 77 AA AA 77 77 FF FF DD
-DD AA AA DD DD FF FF 77 77 AA AA 77 77 FF FF > } image } if PT 16 eq { 16 16
-1 [ 16 0 0 16 neg 0 16 ] { < F1 F1 EE EE 1F 1F FF FF F1 F1 EE EE 1F 1F FF FF
-F1 F1 EE EE 1F 1F FF FF F1 F1 EE EE 1F 1F FF FF > } image } if PT 17 eq { 16
-16 1 [ 16 0 0 16 neg 0 16 ] { < EE EE DD DD BB BB FF FF EE EE DD DD BB BB FF
- FF EE EE DD DD BB BB FF FF EE EE DD DD BB BB FF FF > } image } if PT 18 eq {
-16 16 1 [ 16 0 0 16 neg 0 16 ] { < BB BB DD DD EE EE FF FF BB BB DD DD EE EE
-FF FF BB BB DD DD EE EE FF FF BB BB DD DD EE EE FF FF > } image } if PT 19 eq
-{ 16 16 1 [ 16 0 0 16 neg 0 16 ] { < 1F FC 67 F3 7B EF BD DE BD DE DE BD E6
-B3 F8 0F E6 B3 DE BD BD DE BD DE 7B EF 67 F3 1F FC 7F FF > } image } if PT
-20 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < DD DD EE EE EE EE EE EE DD DD BB
-BB BB BB BB BB DD DD EE EE EE EE EE EE DD DD BB BB BB BB BB BB > } image }
-if PT 21 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < 0E 0E EF EF EF EF EF EF E0
-E0 FE FE FE FE FE FE 0E 0E EF EF EF EF EF EF E0 E0 FE FE FE FE FE FE > }
-image } if PT 22 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < 70 70 F7 F7 F7 F7 F7
-F7 07 07 7F 7F 7F 7F 7F 7F 70 70 F7 F7 F7 F7 F7 F7 07 07 7F 7F 7F 7F 7F 7F >
-} image } if PT 23 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < AA AA 55 55 A9 A9
-D1 D1 E1 E1 D1 D1 A9 A9 55 55 AA AA 55 55 A9 A9 D1 D1 E1 E1 D1 D1 A9 A9 55 55
-> } image } if PT 24 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < FF FE FF FC EA
-A8 D5 54 EA A8 D5 54 E8 28 D4 54 E8 E8 D4 D4 E8 EA 54 D5 A8 EA 54 D5 00 C0 00
-80 > } image } if PT 25 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < FF FE FF FC
-FF F8 FF F0 F0 00 F0 00 F0 20 F0 60 F0 E0 F1 E0 F3 E0 F0 00 E0 00 C0 00 80 00
-00 00 > } image } if gr } def /FA { /PT exch def gsave clip 0 0 translate 1 1
-54 { 1 sub 47.2 mul /Xcurr exch def 1 1 74 { 1 sub 47.2 mul /Ycurr exch def
-gsave Xcurr Ycurr translate PT DP gr } for } for gr } def
-/reencdict 24 dict def /ReEncode {reencdict begin /nco&na exch def
-/nfnam exch def /basefontname exch def /basefontdict basefontname findfont def
-/newfont basefontdict maxlength dict def basefontdict {exch dup /FID ne
-{dup /Encoding eq {exch dup length array copy newfont 3 1 roll put} {exch
-newfont 3 1 roll put} ifelse} {pop pop} ifelse } forall newfont
-/FontName nfnam put nco&na aload pop nco&na length 2 idiv {newfont
-/Encoding get 3 1 roll put} repeat nfnam newfont definefont pop end } def
-/accvec [ 176 /agrave 181 /Agrave 190 /acircumflex 192 /Acircumflex
-201 /adieresis 204 /Adieresis 209 /ccedilla 210 /Ccedilla 211 /eacute
-212 /Eacute 213 /egrave 214 /Egrave 215 /ecircumflex 216 /Ecircumflex
-217 /edieresis 218 /Edieresis 219 /icircumflex 220 /Icircumflex
-221 /idieresis 222 /Idieresis 223 /ntilde 224 /Ntilde 226 /ocircumflex
-228 /Ocircumflex 229 /odieresis 230 /Odieresis 231 /ucircumflex 236 /Ucircumflex
-237 /udieresis 238 /Udieresis 239 /aring 242 /Aring 243 /ydieresis
-244 /Ydieresis 246 /aacute 247 /Aacute 252 /ugrave 253 /Ugrave] def
-/Times-Roman /Times-Roman accvec ReEncode
-/Times-Italic /Times-Italic accvec ReEncode
-/Times-Bold /Times-Bold accvec ReEncode
-/Times-BoldItalic /Times-BoldItalic accvec ReEncode
-/Helvetica /Helvetica accvec ReEncode
-/Helvetica-Oblique /Helvetica-Oblique accvec ReEncode
-/Helvetica-Bold /Helvetica-Bold accvec ReEncode
-/Helvetica-BoldOblique /Helvetica-BoldOblique accvec ReEncode
-/Courier /Courier accvec ReEncode
-/Courier-Oblique /Courier-Oblique accvec ReEncode
-/Courier-Bold /Courier-Bold accvec ReEncode
-/Courier-BoldOblique /Courier-BoldOblique accvec ReEncode
-/oshow {gsave [] 0 sd true charpath stroke gr} def
-/stwn { /fs exch def /fn exch def /text exch def fn findfont fs sf
- text sw pop xs add /xs exch def} def
-/stwb { /fs exch def /fn exch def /nbas exch def /textf exch def
-textf length /tlen exch def nbas tlen gt {/nbas tlen def} if
-fn findfont fs sf textf dup length nbas sub nbas getinterval sw
-pop neg xs add /xs exch def} def
-/accspe [ 65 /plusminus 66 /bar 67 /existential 68 /universal
-69 /exclam 70 /numbersign 71 /greater 72 /question 73 /integral
-74 /colon 75 /semicolon 76 /less 77 /bracketleft 78 /bracketright
-79 /greaterequal 80 /braceleft 81 /braceright 82 /radical
-83 /spade 84 /heart 85 /diamond 86 /club 87 /lessequal
-88 /multiply 89 /percent 90 /infinity 48 /circlemultiply 49 /circleplus
-50 /emptyset 51 /lozenge 52 /bullet 53 /arrowright 54 /arrowup
-55 /arrowleft 56 /arrowdown 57 /arrowboth 48 /degree 44 /comma 43 /plus
- 45 /angle 42 /angleleft 47 /divide 61 /notequal 40 /equivalence 41 /second
- 97 /approxequal 98 /congruent 99 /perpendicular 100 /partialdiff 101 /florin
- 102 /intersection 103 /union 104 /propersuperset 105 /reflexsuperset
- 106 /notsubset 107 /propersubset 108 /reflexsubset 109 /element 110 /notelement
- 111 /gradient 112 /logicaland 113 /logicalor 114 /arrowdblboth
- 115 /arrowdblleft 116 /arrowdblup 117 /arrowdblright 118 /arrowdbldown
- 119 /ampersand 120 /omega1 121 /similar 122 /aleph ] def
-/Symbol /Special accspe ReEncode
-/Zone {/iy exch def /ix exch def ix 1 sub 2224 mul 1 iy sub 3144
- mul t} def
-%%EndProlog
- gsave 20 28 t .25 .25 scale gsave
-%%Page: number 1
- gsave
- 1 1 Zone
- gsave 0 0 t black [] 0 sd 1 lw 2223 2224 0 460 bl 2223 2224 0 460 C NC 1779
- 1778 222 683 bl 1779 1778 222 683 C 4 7 1350 707 bl 4 7 1758 707 bl 4 6 498 763
- bl 4 6 1239 763 bl 4 7 906 818 bl 4 7 1054 818 bl 4 7 1684 818 bl 4 7 572 874
- bl 5 7 646 874 bl 5 7 794 874 bl 4 7 906 874 bl 6 9 1164 873 bl 4 7 1202 874 bl
- 4 7 1276 874 bl 4 7 1350 874 bl 6 9 1609 873 bl 4 7 1721 874 bl 4 7 1758 874 bl
- 7 11 645 927 bl 5 6 757 930 bl 5 6 794 930 bl 4 6 906 930 bl 4 6 943 930 bl 4 6
- 980 930 bl 8 11 1052 927 bl 6 9 1090 928 bl 6 9 1127 928 bl 8 11 1163 927 bl 4
- 6 1202 930 bl 4 6 1276 930 bl 4 6 1313 930 bl 5 6 1498 930 bl 5 6 1535 930 bl 4
- 6 1721 930 bl 4 6 1795 930 bl 4 6 1832 930 bl 6 9 386 984 bl 8 11 422 983 bl 4
- 7 461 985 bl 4 7 498 985 bl 7 11 534 983 bl 6 9 571 984 bl 7 11 608 983 bl 6 9
- 645 984 bl 6 9 682 984 bl 7 9 719 984 bl 7 9 756 984 bl 6 9 794 984 bl 5 7 831
- 985 bl 6 9 868 984 bl 6 9 905 984 bl 4 7 943 985 bl 8 11 978 983 bl 4 7 1017
- 985 bl 4 7 1054 985 bl 6 9 1090 984 bl 6 9 1164 984 bl 4 7 1202 985 bl 6 9 1275
- 984 bl 4 7 1313 985 bl 6 9 1349 984 bl 5 7 1387 985 bl 7 9 1460 984 bl 7 9 1497
- 984 bl 5 7 1535 985 bl 6 9 1572 984 bl 7 11 1608 983 bl 4 7 1684 985 bl 8 11
- 1719 983 bl 10 15 1829 981 bl 8 12 385 1038 bl 8 12 422 1038 bl 8 12 459 1038
- bl 10 14 495 1037 bl 4 6 535 1041 bl 4 6 572 1041 bl 6 10 608 1039 bl 9 14 644
- 1037 bl 9 12 681 1038 bl 7 12 719 1038 bl 9 14 755 1037 bl 9 12 792 1038 bl 7
- 12 830 1038 bl 7 12 867 1038 bl 4 6 906 1041 bl 4 6 943 1041 bl 8 12 978 1038
- bl 12 18 1013 1035 bl 8 12 1052 1038 bl 10 14 1088 1037 bl 10 14 1125 1037 bl 8
- 12 1163 1038 bl 4 6 1202 1041 bl 6 10 1238 1039 bl 7 12 1275 1038 bl 6 10 1312
- 1039 bl 4 6 1350 1041 bl 6 10 1386 1039 bl 11 16 1421 1036 bl 9 12 1459 1038 bl
- 7 10 1497 1039 bl 9 12 1533 1038 bl 11 16 1569 1036 bl 6 10 1609 1039 bl 9 12
- 1644 1038 bl 9 12 1681 1038 bl 8 12 1719 1038 bl 8 12 1756 1038 bl 8 12 1793
- 1038 bl 8 12 1830 1038 bl 8 13 385 1093 bl 10 16 421 1092 bl 10 15 458 1092 bl
- 8 11 496 1094 bl 9 13 533 1093 bl 13 19 568 1090 bl 11 17 606 1091 bl 13 19 642
- 1090 bl 6 9 682 1095 bl 7 11 719 1094 bl 13 21 753 1089 bl 11 17 791 1091 bl 11
- 17 828 1091 bl 11 16 865 1092 bl 10 15 903 1092 bl 6 9 942 1095 bl 12 19 976
- 1090 bl 12 17 1013 1091 bl 8 11 1052 1094 bl 12 19 1087 1090 bl 12 17 1124 1091
- bl 12 19 1161 1090 bl 10 15 1199 1092 bl 8 11 1237 1094 bl 7 11 1275 1094 bl 13
- 19 1309 1090 bl 9 15 1348 1092 bl 11 17 1384 1091 bl 5 7 1424 1096 bl 7 9 1460
- 1095 bl 11 17 1495 1091 bl 11 16 1532 1092 bl 7 11 1571 1094 bl 11 16 1606 1092
- bl 10 15 1644 1092 bl 8 11 1682 1094 bl 8 11 1719 1094 bl 16 23 1752 1088 bl 8
- 13 1793 1093 bl 8 11 1830 1094 bl 12 20 383 1145 bl 8 11 422 1150 bl 12 17 457
- 1147 bl 13 20 494 1145 bl 14 20 530 1145 bl 11 17 569 1147 bl 16 24 603 1143 bl
- 12 18 642 1146 bl 13 18 679 1146 bl 17 25 714 1143 bl 15 22 752 1144 bl 16 24
- 789 1143 bl 13 20 827 1145 bl 13 20 864 1145 bl 15 23 900 1144 bl 15 22 937
- 1144 bl 15 22 974 1144 bl 12 17 1013 1147 bl 12 17 1050 1147 bl 14 22 1086 1144
- bl 18 27 1121 1142 bl 14 20 1160 1145 bl 12 17 1198 1147 bl 12 17 1235 1147 bl
- 9 13 1274 1149 bl 12 18 1309 1146 bl 11 16 1347 1147 bl 9 13 1385 1149 bl 15 22
- 1419 1144 bl 13 20 1457 1145 bl 13 18 1494 1146 bl 13 20 1531 1145 bl 15 22
- 1567 1144 bl 11 17 1606 1147 bl 17 25 1640 1143 bl 15 22 1678 1144 bl 12 18
- 1717 1146 bl 12 18 1754 1146 bl 13 20 1790 1145 bl 14 22 1827 1144 bl 20 29 379
- 1196 bl 16 25 418 1198 bl 14 21 456 1200 bl 18 27 491 1197 bl 16 24 529 1199 bl
- 19 28 565 1197 bl 13 20 605 1201 bl 19 28 639 1197 bl 17 25 677 1198 bl 17 24
- 714 1199 bl 15 21 752 1200 bl 17 26 788 1198 bl 15 21 826 1200 bl 13 19 864
- 1201 bl 17 25 899 1198 bl 19 29 935 1196 bl 15 22 974 1200 bl 16 23 1011 1199
- bl 15 22 1048 1200 bl 16 23 1085 1199 bl 18 26 1121 1198 bl 16 25 1159 1198 bl
- 19 29 1195 1196 bl 17 25 1233 1198 bl 18 27 1269 1197 bl 16 24 1307 1199 bl 17
- 25 1344 1198 bl 17 27 1381 1197 bl 17 25 1418 1198 bl 17 26 1455 1198 bl 15 22
- 1493 1200 bl 15 23 1530 1199 bl 18 27 1566 1197 bl 20 30 1602 1196 bl 20 30
- 1639 1196 bl 18 27 1677 1197 bl 16 24 1715 1199 bl 18 27 1751 1197 bl 16 24
- 1789 1199 bl 16 25 1826 1198 bl 22 33 378 1250 bl 20 31 416 1251 bl 18 27 454
- 1253 bl 16 23 492 1255 bl 20 30 527 1251 bl 19 29 565 1252 bl 21 32 601 1250 bl
- 19 29 639 1252 bl 17 27 677 1253 bl 21 30 712 1251 bl 19 29 750 1252 bl 21 30
- 786 1251 bl 24 36 822 1248 bl 21 32 860 1250 bl 16 24 900 1254 bl 19 29 935
- 1252 bl 18 27 973 1253 bl 20 29 1009 1252 bl 20 31 1046 1251 bl 24 37 1081 1248
- bl 18 28 1121 1252 bl 18 28 1158 1252 bl 20 30 1194 1251 bl 18 27 1232 1253 bl
- 22 33 1267 1250 bl 18 27 1306 1253 bl 20 30 1342 1251 bl 22 33 1378 1250 bl 19
- 28 1417 1252 bl 21 33 1453 1250 bl 21 31 1490 1251 bl 21 32 1527 1250 bl 17 25
- 1566 1254 bl 17 25 1603 1254 bl 18 27 1640 1253 bl 20 30 1676 1251 bl 16 23
- 1715 1255 bl 21 31 1749 1251 bl 22 33 1786 1250 bl 20 30 1824 1251 bl 18 26 380
- 1309 bl 24 36 414 1304 bl 20 30 453 1307 bl 23 34 489 1305 bl 26 38 524 1303 bl
- 26 40 561 1302 bl 27 40 598 1302 bl 19 30 639 1307 bl 23 34 674 1305 bl 25 38
- 710 1303 bl 23 36 748 1304 bl 25 37 784 1303 bl 23 34 822 1305 bl 23 34 859
- 1305 bl 23 34 896 1305 bl 23 34 933 1305 bl 22 34 971 1305 bl 22 33 1008 1305
- bl 24 36 1044 1304 bl 24 37 1081 1303 bl 24 34 1118 1305 bl 20 29 1157 1307 bl
- 20 31 1194 1306 bl 22 32 1230 1306 bl 23 34 1267 1305 bl 24 36 1303 1304 bl 23
- 34 1341 1305 bl 23 34 1378 1305 bl 21 31 1416 1306 bl 21 32 1453 1306 bl 19 29
- 1491 1307 bl 23 34 1526 1305 bl 21 32 1564 1306 bl 23 34 1600 1305 bl 22 32
- 1638 1306 bl 22 34 1675 1305 bl 23 34 1711 1305 bl 20 31 1750 1306 bl 20 31
- 1787 1306 bl 24 36 1822 1304 bl 26 39 376 1358 bl 28 41 412 1357 bl 24 37 451
- 1359 bl 26 39 487 1358 bl 27 41 524 1357 bl 28 41 560 1357 bl 25 37 599 1359 bl
- 27 41 635 1357 bl 27 41 672 1357 bl 25 37 710 1359 bl 23 35 748 1360 bl 27 41
- 783 1357 bl 26 39 821 1358 bl 29 45 856 1355 bl 26 39 895 1358 bl 25 37 932
- 1359 bl 25 37 969 1359 bl 22 33 1008 1361 bl 26 39 1043 1358 bl 24 37 1081 1359
- bl 26 39 1117 1358 bl 26 39 1154 1358 bl 26 39 1191 1358 bl 26 39 1228 1358 bl
- 28 41 1264 1357 bl 22 33 1304 1361 bl 25 37 1340 1359 bl 27 41 1376 1357 bl 25
- 37 1414 1359 bl 25 37 1451 1359 bl 25 39 1488 1358 bl 29 43 1523 1356 bl 27 41
- 1561 1357 bl 22 33 1601 1361 bl 28 41 1635 1357 bl 30 45 1671 1355 bl 27 41
- 1709 1357 bl 24 37 1748 1359 bl 28 41 1783 1357 bl 30 45 1819 1355 bl 28 42 375
- 1412 bl 28 42 412 1412 bl 31 46 448 1410 bl 32 48 484 1409 bl 25 38 525 1414 bl
- 29 42 560 1412 bl 29 44 597 1411 bl 29 44 634 1411 bl 28 42 671 1412 bl 31 46
- 707 1410 bl 29 44 745 1411 bl 30 46 782 1410 bl 32 48 818 1409 bl 29 44 856
- 1411 bl 33 50 891 1408 bl 28 42 931 1412 bl 28 42 968 1412 bl 27 40 1005 1413
- bl 28 42 1042 1412 bl 28 44 1079 1411 bl 28 42 1116 1412 bl 34 50 1150 1408 bl
- 24 36 1192 1415 bl 28 42 1227 1412 bl 26 40 1265 1413 bl 28 42 1301 1412 bl 26
- 38 1339 1414 bl 31 46 1374 1410 bl 29 44 1412 1411 bl 25 38 1451 1414 bl 29 44
- 1486 1411 bl 28 42 1524 1412 bl 24 36 1563 1415 bl 25 38 1599 1414 bl 28 42
- 1635 1412 bl 28 42 1672 1412 bl 30 46 1708 1410 bl 28 40 1746 1413 bl 26 38
- 1784 1414 bl 24 37 1822 1415 bl 30 46 374 1466 bl 28 41 412 1468 bl 31 47 448
- 1465 bl 25 37 488 1470 bl 28 43 523 1467 bl 30 45 559 1466 bl 31 47 596 1465 bl
- 31 46 633 1466 bl 29 43 671 1467 bl 29 43 708 1467 bl 29 45 745 1466 bl 29 45
- 782 1466 bl 27 41 820 1468 bl 27 40 857 1469 bl 30 45 893 1466 bl 30 45 930
- 1466 bl 27 41 968 1468 bl 34 52 1002 1463 bl 28 43 1042 1467 bl 30 45 1078 1466
- bl 28 43 1116 1467 bl 30 45 1152 1466 bl 32 47 1188 1465 bl 32 49 1225 1464 bl
- 32 47 1262 1465 bl 32 49 1299 1464 bl 31 45 1337 1466 bl 29 43 1375 1467 bl 29
- 45 1412 1466 bl 31 46 1448 1466 bl 33 50 1484 1464 bl 32 48 1522 1465 bl 33 49
- 1558 1464 bl 32 47 1596 1465 bl 27 41 1635 1468 bl 32 49 1670 1464 bl 33 49
- 1706 1464 bl 34 51 1743 1463 bl 28 42 1783 1468 bl 32 49 1818 1464 bl 30 44 374
- 1522 bl 30 45 411 1522 bl 32 48 447 1520 bl 28 42 486 1523 bl 29 43 523 1523 bl
- 29 43 560 1523 bl 28 42 597 1523 bl 27 40 635 1524 bl 29 44 671 1522 bl 31 45
- 707 1522 bl 29 44 745 1522 bl 31 47 781 1521 bl 31 48 818 1520 bl 31 47 855
- 1521 bl 32 48 892 1520 bl 32 48 929 1520 bl 32 48 966 1520 bl 31 47 1003 1521
- bl 30 44 1041 1522 bl 32 48 1077 1520 bl 28 41 1116 1524 bl 30 44 1152 1522 bl
- 32 48 1188 1520 bl 30 44 1226 1522 bl 35 52 1261 1518 bl 35 52 1298 1518 bl 27
- 40 1339 1524 bl 33 50 1373 1519 bl 33 49 1410 1520 bl 31 48 1448 1520 bl 37 56
- 1482 1516 bl 31 48 1522 1520 bl 31 48 1559 1520 bl 29 44 1597 1522 bl 35 53
- 1631 1518 bl 28 42 1672 1523 bl 34 51 1706 1519 bl 32 48 1744 1520 bl 24 35
- 1785 1527 bl 28 41 1820 1524 bl 28 42 375 1579 bl 34 51 409 1574 bl 28 43 449
- 1578 bl 28 43 486 1578 bl 33 50 521 1575 bl 31 46 559 1577 bl 30 45 596 1577 bl
- 29 44 634 1578 bl 29 44 671 1578 bl 31 46 707 1577 bl 31 47 744 1576 bl 29 42
- 782 1579 bl 25 38 821 1581 bl 33 49 854 1575 bl 30 46 893 1577 bl 32 48 929
- 1576 bl 31 47 966 1576 bl 29 43 1004 1578 bl 28 42 1042 1579 bl 30 44 1078 1578
- bl 32 48 1114 1576 bl 32 49 1151 1575 bl 31 47 1189 1576 bl 32 48 1225 1576 bl
- 30 45 1263 1577 bl 28 42 1301 1579 bl 31 46 1337 1577 bl 31 46 1374 1577 bl 33
- 48 1410 1576 bl 31 45 1448 1577 bl 29 44 1486 1578 bl 30 45 1523 1577 bl 31 47
- 1559 1576 bl 30 45 1597 1577 bl 33 50 1632 1575 bl 29 43 1671 1578 bl 27 40
- 1709 1580 bl 31 47 1744 1576 bl 30 46 1782 1577 bl 32 47 1818 1576 bl 32 47 373
- 1632 bl 30 44 411 1633 bl 31 47 448 1632 bl 28 43 486 1634 bl 28 41 523 1635 bl
- 32 48 558 1631 bl 35 53 594 1629 bl 35 51 631 1630 bl 31 47 670 1632 bl 29 43
- 708 1634 bl 31 45 744 1633 bl 31 45 781 1633 bl 31 45 818 1633 bl 29 44 856
- 1633 bl 28 41 894 1635 bl 28 41 931 1635 bl 31 47 966 1632 bl 28 41 1005 1635
- bl 30 45 1041 1633 bl 28 43 1079 1634 bl 28 43 1116 1634 bl 30 45 1152 1633 bl
- 30 45 1189 1633 bl 28 43 1227 1634 bl 26 38 1265 1636 bl 29 43 1301 1634 bl 31
- 47 1337 1632 bl 30 45 1374 1633 bl 31 47 1411 1632 bl 31 45 1448 1633 bl 31 46
- 1485 1632 bl 35 53 1520 1629 bl 26 39 1562 1636 bl 29 43 1597 1634 bl 29 43
- 1634 1634 bl 27 41 1672 1635 bl 30 45 1708 1633 bl 30 45 1745 1633 bl 30 45
- 1782 1633 bl 32 47 1818 1632 bl 32 48 373 1687 bl 30 46 411 1688 bl 28 42 449
- 1690 bl 31 46 485 1688 bl 28 42 523 1690 bl 26 40 561 1691 bl 29 42 597 1690 bl
- 32 48 632 1687 bl 27 40 672 1691 bl 29 42 708 1690 bl 23 36 748 1693 bl 31 46
- 781 1688 bl 27 40 820 1691 bl 26 40 858 1691 bl 31 47 892 1687 bl 30 44 930
- 1689 bl 26 40 969 1691 bl 26 38 1006 1692 bl 26 38 1043 1692 bl 30 44 1078 1689
- bl 26 40 1117 1691 bl 28 42 1153 1690 bl 27 40 1191 1691 bl 24 36 1229 1693 bl
- 28 42 1264 1690 bl 31 46 1300 1688 bl 25 38 1340 1692 bl 29 42 1375 1690 bl 25
- 37 1414 1692 bl 25 38 1451 1692 bl 29 44 1486 1689 bl 29 44 1523 1689 bl 29 44
- 1560 1689 bl 30 44 1597 1689 bl 24 36 1637 1693 bl 30 46 1671 1688 bl 22 33
- 1712 1694 bl 30 44 1745 1689 bl 29 44 1782 1689 bl 32 48 1818 1687 bl 22 33 378
- 1750 bl 28 41 412 1746 bl 25 37 451 1748 bl 27 41 487 1746 bl 28 43 523 1745 bl
- 24 35 562 1749 bl 21 33 601 1750 bl 26 39 635 1747 bl 27 39 672 1747 bl 29 43
- 708 1745 bl 27 41 746 1746 bl 23 35 785 1749 bl 27 41 820 1746 bl 23 35 859
- 1749 bl 22 33 897 1750 bl 23 35 933 1749 bl 28 41 968 1746 bl 24 36 1007 1749
- bl 24 37 1044 1748 bl 24 36 1081 1749 bl 26 39 1117 1747 bl 30 43 1152 1745 bl
- 24 35 1192 1749 bl 26 39 1228 1747 bl 23 35 1267 1749 bl 28 43 1301 1745 bl 25
- 37 1340 1748 bl 23 35 1378 1749 bl 27 41 1413 1746 bl 25 37 1451 1748 bl 27 41
- 1487 1746 bl 27 39 1524 1747 bl 26 39 1562 1747 bl 28 41 1598 1746 bl 26 39
- 1636 1747 bl 23 35 1674 1749 bl 25 37 1710 1748 bl 30 45 1745 1744 bl 26 39
- 1784 1747 bl 26 39 1821 1747 bl 20 30 379 1807 bl 22 33 415 1806 bl 21 32 453
- 1806 bl 24 36 488 1804 bl 26 38 524 1803 bl 25 38 562 1803 bl 21 31 601 1807 bl
- 21 32 638 1806 bl 23 34 674 1805 bl 27 40 709 1802 bl 25 38 747 1803 bl 21 30
- 786 1807 bl 26 40 821 1802 bl 23 34 859 1805 bl 23 34 896 1805 bl 24 36 933
- 1804 bl 24 36 970 1804 bl 20 31 1009 1807 bl 24 36 1044 1804 bl 20 31 1083 1807
- bl 24 36 1118 1804 bl 18 28 1158 1808 bl 24 36 1192 1804 bl 22 34 1230 1805 bl
- 21 32 1268 1806 bl 22 33 1304 1806 bl 22 33 1341 1806 bl 17 26 1381 1809 bl 23
- 34 1415 1805 bl 23 36 1452 1804 bl 21 31 1490 1807 bl 19 30 1528 1807 bl 23 36
- 1563 1804 bl 19 29 1602 1808 bl 23 34 1637 1805 bl 20 30 1676 1807 bl 22 32
- 1712 1806 bl 23 34 1748 1805 bl 20 30 1787 1807 bl 20 30 1824 1807 bl 18 27 380
- 1864 bl 24 37 414 1859 bl 19 28 454 1864 bl 22 33 489 1861 bl 14 21 530 1867 bl
- 21 31 564 1862 bl 21 32 601 1862 bl 16 24 640 1866 bl 19 29 676 1863 bl 21 31
- 712 1862 bl 22 33 749 1861 bl 17 27 788 1864 bl 21 32 823 1862 bl 19 29 861
- 1863 bl 19 29 898 1863 bl 19 29 935 1863 bl 18 27 973 1864 bl 19 28 1009 1864
- bl 20 31 1046 1862 bl 20 31 1083 1862 bl 16 23 1122 1866 bl 24 37 1155 1859 bl
- 21 31 1194 1862 bl 19 29 1232 1863 bl 21 31 1268 1862 bl 20 29 1305 1863 bl 19
- 28 1343 1864 bl 23 35 1378 1860 bl 21 32 1416 1862 bl 19 28 1454 1864 bl 21 31
- 1490 1862 bl 15 23 1530 1866 bl 15 21 1567 1867 bl 18 27 1603 1864 bl 17 26
- 1640 1865 bl 21 31 1675 1862 bl 20 31 1713 1862 bl 23 34 1748 1861 bl 18 28
- 1788 1864 bl 22 32 1823 1862 bl 14 21 382 1923 bl 16 24 418 1921 bl 18 27 454
- 1920 bl 14 20 493 1923 bl 18 27 528 1920 bl 17 26 566 1920 bl 16 24 603 1921 bl
- 15 21 641 1923 bl 19 27 676 1920 bl 19 27 713 1920 bl 13 20 753 1923 bl 16 24
- 789 1921 bl 15 21 826 1923 bl 15 22 863 1922 bl 14 21 901 1923 bl 14 21 938
- 1923 bl 15 22 974 1922 bl 16 23 1011 1922 bl 16 25 1048 1921 bl 18 28 1084 1919
- bl 14 21 1123 1923 bl 16 23 1159 1922 bl 16 23 1196 1922 bl 17 25 1233 1921 bl
- 16 23 1270 1922 bl 17 26 1307 1920 bl 17 25 1344 1921 bl 15 21 1382 1923 bl 15
- 22 1419 1922 bl 13 19 1457 1924 bl 17 24 1492 1921 bl 17 26 1529 1920 bl 19 28
- 1565 1919 bl 15 23 1604 1922 bl 13 19 1642 1924 bl 11 17 1680 1925 bl 15 22
- 1715 1922 bl 20 29 1750 1919 bl 16 24 1789 1921 bl 20 30 1824 1918 bl 14 22 382
- 1978 bl 13 20 420 1979 bl 12 17 457 1980 bl 10 14 495 1982 bl 15 22 530 1978 bl
- 11 17 569 1980 bl 14 22 604 1978 bl 15 22 641 1978 bl 17 26 677 1976 bl 15 23
- 715 1977 bl 13 20 753 1979 bl 15 22 789 1978 bl 15 22 826 1978 bl 16 24 863
- 1977 bl 16 24 900 1977 bl 18 27 936 1975 bl 10 16 977 1981 bl 14 20 1012 1979
- bl 14 22 1049 1978 bl 10 16 1088 1981 bl 10 14 1125 1982 bl 14 20 1160 1979 bl
- 15 22 1197 1978 bl 10 16 1236 1981 bl 17 25 1270 1976 bl 11 17 1310 1980 bl 11
- 16 1347 1981 bl 6 9 1386 1984 bl 11 16 1421 1981 bl 13 20 1457 1979 bl 11 17
- 1495 1980 bl 13 20 1531 1979 bl 13 20 1568 1979 bl 7 11 1608 1983 bl 7 11 1645
- 1983 bl 15 22 1678 1978 bl 13 20 1716 1979 bl 14 20 1753 1979 bl 14 22 1790
- 1978 bl 14 20 1827 1979 bl 12 17 383 2036 bl 8 13 422 2038 bl 12 19 457 2035 bl
- 12 19 494 2035 bl 10 15 532 2037 bl 12 19 568 2035 bl 11 17 606 2036 bl 9 13
- 644 2038 bl 7 11 682 2039 bl 11 16 717 2036 bl 7 11 756 2039 bl 6 9 794 2040 bl
- 11 16 828 2036 bl 11 16 865 2036 bl 10 15 903 2037 bl 8 11 941 2039 bl 6 9 979
- 2040 bl 10 15 1014 2037 bl 6 9 1053 2040 bl 12 19 1087 2035 bl 12 19 1124 2035
- bl 12 19 1161 2035 bl 6 9 1201 2040 bl 10 16 1236 2036 bl 9 13 1274 2038 bl 11
- 17 1310 2036 bl 13 21 1346 2034 bl 9 13 1385 2038 bl 9 13 1422 2038 bl 7 11
- 1460 2039 bl 11 16 1495 2036 bl 11 16 1532 2036 bl 11 16 1569 2036 bl 12 19
- 1606 2035 bl 11 17 1643 2036 bl 6 9 1683 2040 bl 12 17 1717 2036 bl 12 17 1754
- 2036 bl 8 13 1793 2038 bl 8 13 1830 2038 bl 4 6 387 2097 bl 10 16 421 2092 bl 8
- 12 459 2094 bl 8 12 496 2094 bl 7 12 534 2094 bl 6 10 571 2095 bl 6 10 608 2095
- bl 9 12 644 2094 bl 9 12 681 2094 bl 7 12 719 2094 bl 11 18 754 2091 bl 5 6 794
- 2097 bl 6 10 831 2095 bl 7 12 867 2094 bl 6 10 905 2095 bl 11 18 939 2091 bl 10
- 16 977 2092 bl 8 12 1015 2094 bl 6 10 1053 2095 bl 10 14 1088 2093 bl 10 14
- 1125 2093 bl 10 14 1162 2093 bl 4 6 1202 2097 bl 8 12 1237 2094 bl 6 10 1275
- 2095 bl 7 12 1312 2094 bl 12 18 1346 2091 bl 7 12 1386 2094 bl 9 12 1422 2094
- bl 9 12 1459 2094 bl 9 14 1496 2093 bl 5 6 1535 2097 bl 12 18 1569 2091 bl 11
- 16 1606 2092 bl 4 6 1647 2097 bl 9 12 1681 2094 bl 8 12 1719 2094 bl 4 6 1758
- 2097 bl 10 14 1829 2093 bl 8 13 385 2149 bl 4 7 424 2152 bl 8 13 459 2149 bl 8
- 13 496 2149 bl 6 9 534 2151 bl 6 9 608 2151 bl 5 7 646 2152 bl 6 9 682 2151 bl
- 7 11 719 2150 bl 5 7 757 2152 bl 6 9 794 2151 bl 4 7 869 2152 bl 4 7 943 2152
- bl 8 13 978 2149 bl 6 9 1016 2151 bl 6 9 1053 2151 bl 4 7 1091 2152 bl 6 9 1127
- 2151 bl 4 7 1239 2152 bl 4 7 1313 2152 bl 4 7 1350 2152 bl 7 11 1460 2150 bl 7
- 9 1497 2151 bl 7 11 1534 2150 bl 7 11 1571 2150 bl 6 9 1609 2151 bl 4 7 1647
- 2152 bl 4 7 1684 2152 bl 8 11 1719 2150 bl 8 13 1793 2149 bl 6 9 1831 2151 bl 4
- 6 424 2208 bl 4 6 461 2208 bl 4 6 498 2208 bl 4 6 609 2208 bl 5 6 646 2208 bl 6
- 9 682 2207 bl 7 9 756 2207 bl 5 6 794 2208 bl 6 9 868 2207 bl 6 9 942 2207 bl 6
- 9 1016 2207 bl 4 6 1091 2208 bl 6 9 1127 2207 bl 6 9 1164 2207 bl 6 9 1201 2207
- bl 6 9 1238 2207 bl 7 11 1312 2206 bl 4 6 1350 2208 bl 5 6 1461 2208 bl 5 6
- 1498 2208 bl 6 9 1535 2207 bl 6 9 1572 2207 bl 4 6 1610 2208 bl 4 6 1647 2208
- bl 4 6 1721 2208 bl 4 6 1832 2208 bl 4 7 424 2263 bl 4 7 498 2263 bl 5 7 646
- 2263 bl 5 7 720 2263 bl 4 7 1054 2263 bl 4 7 1091 2263 bl 4 7 1276 2263 bl 4 7
- 1350 2263 bl 4 7 1832 2263 bl 4 6 424 2319 bl 5 6 646 2319 bl 5 6 720 2319 bl 5
- 6 683 2375 bl 5 6 757 2375 bl 5 7 683 2430 bl NC 222 683 m 1778 Y s 256 683 m
- -34 X s 239 727 m -17 X s 239 772 m -17 X s 239 816 m -17 X s 239 861 m -17 X s
- 256 905 m -34 X s 239 950 m -17 X s 239 994 m -17 X s 239 1038 m -17 X s 239
- 1083 m -17 X s 256 1127 m -34 X s 239 1172 m -17 X s 239 1216 m -17 X s 239
- 1261 m -17 X s 239 1305 m -17 X s 256 1350 m -34 X s 239 1394 m -17 X s 239
- 1439 m -17 X s 239 1483 m -17 X s 239 1528 m -17 X s 256 1572 m -34 X s 239
- 1616 m -17 X s 239 1661 m -17 X s 239 1705 m -17 X s 239 1750 m -17 X s 256
- 1794 m -34 X s 239 1839 m -17 X s 239 1883 m -17 X s 239 1928 m -17 X s 239
- 1972 m -17 X s 256 2017 m -34 X s 239 2061 m -17 X s 239 2106 m -17 X s 239
- 2150 m -17 X s 239 2194 m -17 X s 256 2239 m -34 X s 239 2283 m -17 X s 239
- 2328 m -17 X s 239 2372 m -17 X s 239 2417 m -17 X s 256 2461 m -34 X s 116 681
- m 26 X s 154 691 m 1 Y 2 3 d 1 2 d 3 1 d 6 X 3 -1 d 1 -2 d 2 -3 d -3 Y -2 -3 d
- -3 -4 d -14 -15 d 20 X s 71 903 m 27 X s 113 915 m 3 1 d 4 5 d -31 Y s 141 892
- m -2 -1 d 2 -1 d 1 1 d -1 1 d cl s 170 921 m -14 X -2 -14 d 2 2 d 4 1 d 5 X 4
- -1 d 3 -3 d 1 -5 d -3 Y -1 -4 d -3 -3 d -4 -1 d -5 X -4 1 d -2 1 d -1 3 d s 116
- 1125 m 26 X s 157 1137 m 3 2 d 5 4 d -31 Y s 71 1347 m 27 X s 117 1365 m -4 -1
- d -3 -5 d -2 -7 d -5 Y 2 -7 d 3 -4 d 4 -2 d 3 X 4 2 d 3 4 d 2 7 d 5 Y -2 7 d -3
- 5 d -4 1 d -3 X cl s 141 1337 m -2 -1 d 2 -2 d 1 2 d -1 1 d cl s 170 1365 m -14
- X -2 -13 d 2 1 d 4 2 d 5 X 4 -2 d 3 -3 d 1 -4 d -3 Y -1 -4 d -3 -3 d -4 -2 d -5
- X -4 2 d -2 1 d -1 3 d s 162 1588 m -5 -2 d -3 -4 d -1 -8 d -4 Y 1 -8 d 3 -4 d
- 5 -2 d 3 X 4 2 d 3 4 d 1 8 d 4 Y -1 8 d -3 4 d -4 2 d -3 X cl s 117 1810 m -4
- -2 d -3 -4 d -2 -7 d -5 Y 2 -7 d 3 -5 d 4 -1 d 3 X 4 1 d 3 5 d 2 7 d 5 Y -2 7 d
- -3 4 d -4 2 d -3 X cl s 141 1782 m -2 -2 d 2 -1 d 1 1 d -1 2 d cl s 170 1810 m
- -14 X -2 -13 d 2 1 d 4 1 d 5 X 4 -1 d 3 -3 d 1 -4 d -3 Y -1 -5 d -3 -3 d -4 -1
- d -5 X -4 1 d -2 2 d -1 3 d s 157 2026 m 3 2 d 5 4 d -31 Y s 113 2249 m 3 1 d 4
- 4 d -31 Y s 141 2226 m -2 -1 d 2 -2 d 1 2 d -1 1 d cl s 170 2254 m -14 X -2 -13
- d 2 2 d 4 1 d 5 X 4 -1 d 3 -3 d 1 -5 d -3 Y -1 -4 d -3 -3 d -4 -2 d -5 X -4 2 d
- -2 1 d -1 3 d s 154 2469 m 2 Y 2 3 d 1 1 d 3 2 d 6 X 3 -2 d 1 -1 d 2 -3 d -3 Y
- -2 -3 d -3 -5 d -14 -14 d 20 X s 222 683 m 1779 X s 371 716 m -33 Y s 408 699 m
- -16 Y s 445 699 m -16 Y s 482 699 m -16 Y s 519 699 m -16 Y s 556 716 m -33 Y s
- 593 699 m -16 Y s 630 699 m -16 Y s 667 699 m -16 Y s 704 699 m -16 Y s 741 716
- m -33 Y s 778 699 m -16 Y s 815 699 m -16 Y s 852 699 m -16 Y s 889 699 m -16 Y
- s 926 716 m -33 Y s 963 699 m -16 Y s 1000 699 m -16 Y s 1037 699 m -16 Y s
- 1074 699 m -16 Y s 1112 716 m -33 Y s 1149 699 m -16 Y s 1186 699 m -16 Y s
- 1223 699 m -16 Y s 1260 699 m -16 Y s 1297 716 m -33 Y s 1334 699 m -16 Y s
- 1371 699 m -16 Y s 1408 699 m -16 Y s 1445 699 m -16 Y s 1482 716 m -33 Y s
- 1519 699 m -16 Y s 1556 699 m -16 Y s 1593 699 m -16 Y s 1630 699 m -16 Y s
- 1667 716 m -33 Y s 1704 699 m -16 Y s 1741 699 m -16 Y s 1778 699 m -16 Y s
- 1815 699 m -16 Y s 1853 716 m -33 Y s 371 716 m -33 Y s 333 699 m -16 Y s 296
- 699 m -16 Y s 259 699 m -16 Y s 1853 716 m -33 Y s 1890 699 m -16 Y s 1927 699
- m -16 Y s 1964 699 m -16 Y s 2001 699 m -16 Y s 369 661 m -4 -2 d -3 -4 d -2 -8
- d -4 Y 2 -8 d 3 -4 d 4 -2 d 3 X 4 2 d 3 4 d 2 8 d 4 Y -2 8 d -3 4 d -4 2 d -3 X
- cl s 517 661 m -4 -2 d -3 -4 d -2 -8 d -4 Y 2 -8 d 3 -4 d 4 -2 d 3 X 5 2 d 3 4
- d 1 8 d 4 Y -1 8 d -3 4 d -5 2 d -3 X cl s 541 632 m -2 -1 d 2 -2 d 1 2 d -1 1
- d cl s 554 653 m 2 Y 2 3 d 1 1 d 3 2 d 6 X 3 -2 d 2 -1 d 1 -3 d -3 Y -1 -3 d -3
- -5 d -15 -15 d 21 X s 600 661 m -15 X -1 -14 d 1 2 d 5 1 d 4 X 5 -1 d 3 -3 d 1
- -5 d -3 Y -1 -4 d -3 -3 d -5 -2 d -4 X -5 2 d -1 1 d -2 3 d s 717 661 m -4 -2 d
- -3 -4 d -2 -8 d -4 Y 2 -8 d 3 -4 d 4 -2 d 3 X 5 2 d 3 4 d 1 8 d 4 Y -1 8 d -3 4
- d -5 2 d -3 X cl s 741 632 m -1 -1 d 1 -2 d 1 2 d -1 1 d cl s 771 661 m -15 X
- -2 -14 d 2 2 d 4 1 d 5 X 4 -1 d 3 -3 d 2 -5 d -3 Y -2 -4 d -3 -3 d -4 -2 d -5 X
- -4 2 d -2 1 d -1 3 d s 888 661 m -5 -2 d -3 -4 d -1 -8 d -4 Y 1 -8 d 3 -4 d 5
- -2 d 3 X 4 2 d 3 4 d 2 8 d 4 Y -2 8 d -3 4 d -4 2 d -3 X cl s 911 632 m -1 -1 d
- 1 -2 d 2 2 d -2 1 d cl s 944 661 m -15 -32 d s 923 661 m 21 X s 971 661 m -15 X
- -2 -14 d 2 2 d 4 1 d 5 X 4 -1 d 3 -3 d 2 -5 d -3 Y -2 -4 d -3 -3 d -4 -2 d -5 X
- -4 2 d -2 1 d -1 3 d s 1106 655 m 3 1 d 4 5 d -32 Y s 1254 655 m 3 1 d 4 5 d
- -32 Y s 1282 632 m -2 -1 d 2 -2 d 1 2 d -1 1 d cl s 1295 653 m 2 Y 2 3 d 1 1 d
- 3 2 d 6 X 3 -2 d 2 -1 d 1 -3 d -3 Y -1 -3 d -3 -5 d -15 -15 d 21 X s 1341 661 m
- -15 X -1 -14 d 1 2 d 5 1 d 4 X 5 -1 d 3 -3 d 1 -5 d -3 Y -1 -4 d -3 -3 d -5 -2
- d -4 X -5 2 d -1 1 d -2 3 d s 1454 655 m 3 1 d 4 5 d -32 Y s 1482 632 m -1 -1 d
- 1 -2 d 1 2 d -1 1 d cl s 1512 661 m -15 X -2 -14 d 2 2 d 4 1 d 5 X 4 -1 d 3 -3
- d 2 -5 d -3 Y -2 -4 d -3 -3 d -4 -2 d -5 X -4 2 d -2 1 d -1 3 d s 1624 655 m 3
- 1 d 5 5 d -32 Y s 1652 632 m -1 -1 d 1 -2 d 2 2 d -2 1 d cl s 1685 661 m -15
- -32 d s 1664 661 m 21 X s 1712 661 m -15 X -2 -14 d 2 2 d 4 1 d 5 X 4 -1 d 3 -3
- d 2 -5 d -3 Y -2 -4 d -3 -3 d -4 -2 d -5 X -4 2 d -2 1 d -1 3 d s 1844 653 m 2
- Y 1 3 d 2 1 d 3 2 d 5 X 3 -2 d 2 -1 d 1 -3 d -3 Y -1 -3 d -3 -5 d -15 -15 d 21
- X s 1779 1778 222 683 C 2223 2224 0 460 C 1040 539 m 9 -21 d s 1057 539 m -8
- -21 d -3 -6 d -3 -3 d -3 -1 d -2 X s 1077 549 m 12 -31 d s 1100 549 m -11 -31 d
- s 1127 545 m -3 3 d -4 1 d -6 X -5 -1 d -3 -3 d -3 Y 2 -3 d 1 -1 d 3 -2 d 9 -3
- d 3 -1 d 2 -2 d 1 -3 d -4 Y -3 -3 d -4 -2 d -6 X -5 2 d -3 3 d s 1139 521 m -2
- -1 d 2 -2 d 1 2 d -1 1 d cl s 1166 539 m 16 -21 d s 1182 539 m -16 -21 d s 1779
- 1778 222 683 C gr
-showpage
- gr
-%%Trailer
-%%Pages: 1
- gr gr
-%%EOF
diff --git a/src/pawlib/paw/testsuite/paw.commands/nt_pl_2d_lego.ref.ps b/src/pawlib/paw/testsuite/paw.commands/nt_pl_2d_lego.ref.ps
deleted file mode 100644
index 47206e4..0000000
--- a/src/pawlib/paw/testsuite/paw.commands/nt_pl_2d_lego.ref.ps
+++ /dev/null
@@ -1,1062 +0,0 @@
-%!PS-Adobe-2.0
-%%Title: /disk3/maartenb/cerncvs/paw/testsuite/tmp/nt_pl_2d_ (Portrait A 4)
-%%Pages: (atend)
-%%Creator: HIGZ Version 1.23/06
-%%CreationDate: 96/04/16 14.44
-%%EndComments
-%%BeginProlog
-/s {stroke} def /l {lineto} def /m {moveto} def /t {translate} def
-/sw {stringwidth} def /r {rotate} def /rl {roll} def /R {repeat} def
-/d {rlineto} def /rm {rmoveto} def /gr {grestore} def /f {eofill} def
-/c {setrgbcolor} def /lw {setlinewidth} def /sd {setdash} def
-/cl {closepath} def /sf {scalefont setfont} def /black {0 setgray} def
-/box {m dup 0 exch d exch 0 d 0 exch neg d cl} def
-/NC{systemdict begin initclip end}def/C{NC box clip newpath}def
-/bl {box s} def /bf {box f} def /Y { 0 exch d} def /X { 0 d} def
-/mp {newpath /y exch def /x exch def} def
-/side {[w .77 mul w .23 mul] .385 w mul sd w 0 l currentpoint t -144 r} def
-/mr {mp x y w2 0 360 arc} def /m24 {mr s} def /m20 {mr f} def
-/mb {mp x y w2 add m w2 neg 0 d 0 w neg d w 0 d 0 w d cl} def
-/mt {mp x y w2 add m w2 neg w neg d w 0 d cl} def
-/m21 {mb f} def /m25 {mb s} def /m22 {mt f} def /m26 {mt s} def
-/m23 {mp x y w2 sub m w2 w d w neg 0 d cl f} def
-/m27 {mp x y w2 add m w3 neg w2 neg d w3 w2 neg d w3 w2 d cl s} def
-/m28 {mp x w2 sub y w2 sub w3 add m w3 0 d 0 w3 neg d w3 0 d 0 w3 d w3 0 d
- 0 w3 d w3 neg 0 d 0 w3 d w3 neg 0 d
- 0 w3 neg d w3 neg 0 d cl s } def
-/m29 {mp gsave x w2 sub y w2 add w3 sub m currentpoint t
- 4 {side} repeat cl fill gr} def
-/m30 {mp gsave x w2 sub y w2 add w3 sub m currentpoint t
- 5 {side} repeat s gr} def
-/m31 {mp x y w2 sub m 0 w d x w2 sub y m w 0 d
- x w2 sub y w2 add m w w neg d x w2 sub y w2
- sub m w w d s} def
-/m2 {mp x y w2 sub m 0 w d x w2 sub y m w 0 d s} def
-/m5 {mp x w2 sub y w2 sub m w w d x w2 sub y w2 add m w w neg d s} def
-/DP {/PT exch def gsave 47.2 47.2 scale PT 1 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < AA AA 55 55 AA AA 55 55 AA AA 55 55 AA AA 55 55 AA AA 55 55 AA AA 55 55
-AA AA 55 55 AA AA 55 55 > } image } if PT 2 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < BB BB EE EE BB BB EE EE BB BB EE EE BB BB EE EE BB BB EE EE BB BB EE EE
-BB BB EE EE BB BB EE EE > } image } if PT 3 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < FF FF BB BB FF FF EE EE FF FF BB BB FF FF EE EE FF FF BB BB FF FF EE EE
-FF FF BB BB FF FF EE EE > } image } if PT 4 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < DF DF BF BF 7F 7F FE FE FD FD FB FB F7 F7 EF EF DF DF BF BF 7F 7F FE FE
-FD FD FB FB F7 F7 EF EF > } image } if PT 5 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < 7F 7F BF B F DF DF EF EF F7 F7 FB FB FD FD FE FE 7F 7F BF BF DF DF EF
-EF F7 F7 FB FB FD FD FE FE > } image } if PT 6 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB
-BB BB BB BB BB BB BB BB BB > } image } if PT 7 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < FF FF FF FF FF FF 00 00 FF FF FF FF FF FF 00 00 FF FF FF FF FF FF 00
-00 FF FF FF FF FF FF 00 00 > } image } if PT 8 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < EE EE 47 47 83 83 C5 C5 EE EE 5C 5C 38 38 74 74 EE EE 47 47 83 83 C5
-C5 EE EE 5C 5C 38 38 74 74 > } image } if PT 9 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < EF EF EF EF D7 D7 38 38 FE FE FE FE 7D 7D 83 83 EF EF EF EF D7 D7 38
-38 FE FE FE FE 7D 7D 83 83 > } image } if PT 10 eq { 16 16 1 [ 16 0 0 16 neg
-0 16 ] { < EF EF EF EF EF EF 00 00 FE FE FE FE FE FE 00 00 EF EF EF EF EF EF
-00 00 FE FE FE FE FE FE 00 00 > } image } if PT 11 eq { 16 16 1 [ 16 0 0 16
-neg 0 16 ] { < F7 F7 B6 B6 D5 D5 E3 E3 D5 D5 B6 B6 F7 F7 FF FF 7F 7F 6B 6B 5D
-5D 3E 3E 5D 5D 6B 6B 7F 7F FF FF > } image } if PT 12 eq { 16 16 1 [ 16 0 0
-16 neg 0 16 ] { < E3 E3 DD DD BE BE BE BE BE BE DD DD E3 E3 FF FF 3E 3E DD DD
-EB EB EB EB EB EB DD DD 3E 3E FF FF > } image } if PT 13 eq { 16 16 1 [ 16 0
-0 16 neg 0 16 ] { < FE FE 7D 7D BB BB D7 D7 EF EF D7 D7 BB BB 7D 7D FE FE 7D
-7D BB BB D7 D7 EF EF D7 D7 BB BB 7D 7D > } image } if PT 14 eq { 16 16 1 [ 16
-0 0 16 neg 0 16 ] { < 00 00 EE EF EE EF EE EF 0E E0 EE EE EE EE EE EE 00 EE
-FE EE FE EE FE EE 00 00 FE EF FE EF FE EF > } image } if PT 15 eq { 16 16 1 [
-16 0 0 16 neg 0 16 ] { < DD DD AA AA DD DD FF FF 77 77 AA AA 77 77 FF FF DD
-DD AA AA DD DD FF FF 77 77 AA AA 77 77 FF FF > } image } if PT 16 eq { 16 16
-1 [ 16 0 0 16 neg 0 16 ] { < F1 F1 EE EE 1F 1F FF FF F1 F1 EE EE 1F 1F FF FF
-F1 F1 EE EE 1F 1F FF FF F1 F1 EE EE 1F 1F FF FF > } image } if PT 17 eq { 16
-16 1 [ 16 0 0 16 neg 0 16 ] { < EE EE DD DD BB BB FF FF EE EE DD DD BB BB FF
- FF EE EE DD DD BB BB FF FF EE EE DD DD BB BB FF FF > } image } if PT 18 eq {
-16 16 1 [ 16 0 0 16 neg 0 16 ] { < BB BB DD DD EE EE FF FF BB BB DD DD EE EE
-FF FF BB BB DD DD EE EE FF FF BB BB DD DD EE EE FF FF > } image } if PT 19 eq
-{ 16 16 1 [ 16 0 0 16 neg 0 16 ] { < 1F FC 67 F3 7B EF BD DE BD DE DE BD E6
-B3 F8 0F E6 B3 DE BD BD DE BD DE 7B EF 67 F3 1F FC 7F FF > } image } if PT
-20 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < DD DD EE EE EE EE EE EE DD DD BB
-BB BB BB BB BB DD DD EE EE EE EE EE EE DD DD BB BB BB BB BB BB > } image }
-if PT 21 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < 0E 0E EF EF EF EF EF EF E0
-E0 FE FE FE FE FE FE 0E 0E EF EF EF EF EF EF E0 E0 FE FE FE FE FE FE > }
-image } if PT 22 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < 70 70 F7 F7 F7 F7 F7
-F7 07 07 7F 7F 7F 7F 7F 7F 70 70 F7 F7 F7 F7 F7 F7 07 07 7F 7F 7F 7F 7F 7F >
-} image } if PT 23 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < AA AA 55 55 A9 A9
-D1 D1 E1 E1 D1 D1 A9 A9 55 55 AA AA 55 55 A9 A9 D1 D1 E1 E1 D1 D1 A9 A9 55 55
-> } image } if PT 24 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < FF FE FF FC EA
-A8 D5 54 EA A8 D5 54 E8 28 D4 54 E8 E8 D4 D4 E8 EA 54 D5 A8 EA 54 D5 00 C0 00
-80 > } image } if PT 25 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < FF FE FF FC
-FF F8 FF F0 F0 00 F0 00 F0 20 F0 60 F0 E0 F1 E0 F3 E0 F0 00 E0 00 C0 00 80 00
-00 00 > } image } if gr } def /FA { /PT exch def gsave clip 0 0 translate 1 1
-54 { 1 sub 47.2 mul /Xcurr exch def 1 1 74 { 1 sub 47.2 mul /Ycurr exch def
-gsave Xcurr Ycurr translate PT DP gr } for } for gr } def
-/reencdict 24 dict def /ReEncode {reencdict begin /nco&na exch def
-/nfnam exch def /basefontname exch def /basefontdict basefontname findfont def
-/newfont basefontdict maxlength dict def basefontdict {exch dup /FID ne
-{dup /Encoding eq {exch dup length array copy newfont 3 1 roll put} {exch
-newfont 3 1 roll put} ifelse} {pop pop} ifelse } forall newfont
-/FontName nfnam put nco&na aload pop nco&na length 2 idiv {newfont
-/Encoding get 3 1 roll put} repeat nfnam newfont definefont pop end } def
-/accvec [ 176 /agrave 181 /Agrave 190 /acircumflex 192 /Acircumflex
-201 /adieresis 204 /Adieresis 209 /ccedilla 210 /Ccedilla 211 /eacute
-212 /Eacute 213 /egrave 214 /Egrave 215 /ecircumflex 216 /Ecircumflex
-217 /edieresis 218 /Edieresis 219 /icircumflex 220 /Icircumflex
-221 /idieresis 222 /Idieresis 223 /ntilde 224 /Ntilde 226 /ocircumflex
-228 /Ocircumflex 229 /odieresis 230 /Odieresis 231 /ucircumflex 236 /Ucircumflex
-237 /udieresis 238 /Udieresis 239 /aring 242 /Aring 243 /ydieresis
-244 /Ydieresis 246 /aacute 247 /Aacute 252 /ugrave 253 /Ugrave] def
-/Times-Roman /Times-Roman accvec ReEncode
-/Times-Italic /Times-Italic accvec ReEncode
-/Times-Bold /Times-Bold accvec ReEncode
-/Times-BoldItalic /Times-BoldItalic accvec ReEncode
-/Helvetica /Helvetica accvec ReEncode
-/Helvetica-Oblique /Helvetica-Oblique accvec ReEncode
-/Helvetica-Bold /Helvetica-Bold accvec ReEncode
-/Helvetica-BoldOblique /Helvetica-BoldOblique accvec ReEncode
-/Courier /Courier accvec ReEncode
-/Courier-Oblique /Courier-Oblique accvec ReEncode
-/Courier-Bold /Courier-Bold accvec ReEncode
-/Courier-BoldOblique /Courier-BoldOblique accvec ReEncode
-/oshow {gsave [] 0 sd true charpath stroke gr} def
-/stwn { /fs exch def /fn exch def /text exch def fn findfont fs sf
- text sw pop xs add /xs exch def} def
-/stwb { /fs exch def /fn exch def /nbas exch def /textf exch def
-textf length /tlen exch def nbas tlen gt {/nbas tlen def} if
-fn findfont fs sf textf dup length nbas sub nbas getinterval sw
-pop neg xs add /xs exch def} def
-/accspe [ 65 /plusminus 66 /bar 67 /existential 68 /universal
-69 /exclam 70 /numbersign 71 /greater 72 /question 73 /integral
-74 /colon 75 /semicolon 76 /less 77 /bracketleft 78 /bracketright
-79 /greaterequal 80 /braceleft 81 /braceright 82 /radical
-83 /spade 84 /heart 85 /diamond 86 /club 87 /lessequal
-88 /multiply 89 /percent 90 /infinity 48 /circlemultiply 49 /circleplus
-50 /emptyset 51 /lozenge 52 /bullet 53 /arrowright 54 /arrowup
-55 /arrowleft 56 /arrowdown 57 /arrowboth 48 /degree 44 /comma 43 /plus
- 45 /angle 42 /angleleft 47 /divide 61 /notequal 40 /equivalence 41 /second
- 97 /approxequal 98 /congruent 99 /perpendicular 100 /partialdiff 101 /florin
- 102 /intersection 103 /union 104 /propersuperset 105 /reflexsuperset
- 106 /notsubset 107 /propersubset 108 /reflexsubset 109 /element 110 /notelement
- 111 /gradient 112 /logicaland 113 /logicalor 114 /arrowdblboth
- 115 /arrowdblleft 116 /arrowdblup 117 /arrowdblright 118 /arrowdbldown
- 119 /ampersand 120 /omega1 121 /similar 122 /aleph ] def
-/Symbol /Special accspe ReEncode
-/Zone {/iy exch def /ix exch def ix 1 sub 2224 mul 1 iy sub 3144
- mul t} def
-%%EndProlog
- gsave 20 28 t .25 .25 scale gsave
-%%Page: number 1
- gsave
- 1 1 Zone
- gsave 0 0 t black [] 0 sd 1 lw 2223 2224 0 460 bl 2223 2224 0 460 C 1779 1778
- 222 683 C NC 873 683 m 24 6 d s 876 704 m 21 -15 d s 853 698 m 23 6 d s 853 698
- m 20 -15 d s 897 689 m 23 6 d s 900 710 m 20 -15 d s 876 704 m 24 6 d s 920 695
- m 24 6 d s 923 716 m 21 -15 d s 900 710 m 23 6 d s 944 701 m 23 6 d s 947 722 m
- 20 -15 d s 923 716 m 24 6 d s 967 707 m 24 6 d s 970 728 m 21 -15 d s 947 722 m
- 23 6 d s 991 713 m 23 6 d s 994 734 m 20 -15 d s 970 728 m 24 6 d s 1014 719 m
- 24 6 d s 1017 740 m 21 -15 d s 994 734 m 23 6 d s 1038 725 m 23 6 d s 1041 746
- m 20 -15 d s 1017 740 m 24 6 d s 1061 731 m 24 6 d s 1064 752 m 21 -15 d s 1041
- 746 m 23 6 d s 1085 737 m 23 6 d s 1088 758 m 20 -15 d s 1064 752 m 24 6 d s
- 1108 743 m 24 6 d s 1111 764 m 21 -15 d s 1088 758 m 23 6 d s 1132 749 m 23 6 d
- s 1135 770 m 20 -15 d s 1111 764 m 24 6 d s 1155 755 m 24 6 d s 1158 776 m 21
- -15 d s 1135 770 m 23 6 d s 1179 761 m 23 6 d s 1182 782 m 20 -15 d s 1158 776
- m 24 6 d s 1202 767 m 24 5 d s 1205 788 m 21 -16 d s 1182 782 m 23 6 d s 1226
- 772 m 23 6 d s 1229 794 m 20 -16 d s 1205 788 m 24 6 d s 1249 778 m 24 6 d s
- 1252 800 m 21 -16 d s 1229 794 m 23 6 d s 1273 784 m 23 6 d s 1276 806 m 20 -16
- d s 1252 800 m 24 6 d s 1296 790 m 24 6 d s 1299 812 m 21 -16 d s 1276 806 m 23
- 6 d s 1320 796 m 23 6 d s 1323 818 m 20 -16 d s 1299 812 m 24 6 d s 1320 796 m
- s 1343 802 m 24 6 d s 1346 824 m 21 -16 d s 1323 818 m 23 6 d s 1367 808 m 23 6
- d s 1370 830 m 20 -16 d s 1346 824 m 24 6 d s 1390 814 m 23 6 d s 1393 836 m 20
- -16 d s 1370 830 m 23 6 d s 1413 820 m 24 6 d s 1417 842 m 20 -16 d s 1393 836
- m 24 6 d s 1437 826 m 23 6 d s 1440 848 m 20 -16 d s 1417 842 m 23 6 d s 1460
- 832 m 24 6 d s 1464 854 m 20 -16 d s 1440 848 m 24 6 d s 1484 838 m 23 6 d s
- 1487 860 m 20 -16 d s 1464 854 m 23 6 d s 1507 844 m 24 6 d s 1511 866 m 20 -16
- d s 1487 860 m 24 6 d s 1531 850 m 23 6 d s 1534 872 m 20 -16 d s 1511 866 m 23
- 6 d s 1554 856 m 24 6 d s 1558 878 m 20 -16 d s 1534 872 m 24 6 d s 1578 862 m
- 23 6 d s 1601 868 m 14 Y s 1578 876 m 23 6 d s 1578 862 m 14 Y s 1558 891 m 20
- -15 d s 1558 878 m 13 Y s 1581 897 m 20 -15 d s 1558 891 m 23 6 d s 1601 868 m
- 24 6 d s 1605 890 m 20 -16 d s 1595 887 m 10 3 d s 1625 874 m 23 6 d s 1628 896
- m 20 -16 d s 1605 890 m 23 6 d s 1648 880 m 24 6 d s 1652 902 m 20 -16 d s 1628
- 896 m 24 6 d s 1672 886 m 23 6 d s 1675 908 m 20 -16 d s 1652 902 m 23 6 d s
- 1695 892 m 24 6 d s 1699 914 m 20 -16 d s 1675 908 m 24 6 d s 1719 898 m 23 6 d
- s 1722 920 m 20 -16 d s 1699 914 m 23 6 d s 1742 904 m 24 6 d s 1745 926 m 21
- -16 d s 1722 920 m 23 6 d s 1766 910 m 23 6 d s 1769 932 m 20 -16 d s 1745 926
- m 24 6 d s 1789 916 m 24 6 d s 1792 938 m 21 -16 d s 1769 932 m 23 6 d s 1769
- 932 m 20 -16 d s 1813 922 m 23 6 d s 1816 943 m 20 -15 d s 1792 938 m 24 5 d s
- 1836 928 m 24 6 d s 1860 934 m 13 Y s 1836 941 m 24 6 d s 1836 928 m 13 Y s
- 1816 957 m 20 -16 d s 1816 943 m 14 Y s 1839 963 m 21 -16 d s 1816 957 m 23 6 d
- s 1860 934 m 23 6 d s 1863 955 m 20 -15 d s 1853 953 m 10 2 d s 1883 940 m 24 6
- d s 1886 961 m 21 -15 d s 1863 955 m 23 6 d s 1907 946 m 23 6 d s 1910 967 m 20
- -15 d s 1886 961 m 24 6 d s 1930 952 m 24 6 d s 1933 973 m 21 -15 d s 1910 967
- m 23 6 d s 1954 958 m 23 6 d s 1957 979 m 20 -15 d s 1933 973 m 24 6 d s 1977
- 964 m 24 6 d s 1980 985 m 21 -15 d s 1957 979 m 23 6 d s 1957 979 m 20 -15 d s
- 856 720 m 20 -16 d s 833 714 m 23 6 d s 833 714 m 20 -16 d s 880 726 m 20 -16 d
- s 856 720 m 24 6 d s 903 732 m 20 -16 d s 880 726 m 23 6 d s 927 738 m 20 -16 d
- s 903 732 m 24 6 d s 950 744 m 20 -16 d s 927 738 m 23 6 d s 973 750 m 21 -16 d
- s 950 744 m 23 6 d s 997 756 m 20 -16 d s 973 750 m 24 6 d s 1041 746 m 14 Y s
- 1017 754 m 24 6 d s 1017 740 m 14 Y s 997 769 m 20 -15 d s 997 756 m 13 Y s
- 1020 775 m 21 -15 d s 997 769 m 23 6 d s 1044 768 m 20 -16 d s 1033 765 m 11 3
- d s 1067 774 m 21 -16 d s 1044 768 m 23 6 d s 1091 780 m 20 -16 d s 1067 774 m
- 24 6 d s 1114 786 m 21 -16 d s 1091 780 m 23 6 d s 1138 792 m 20 -16 d s 1114
- 786 m 24 6 d s 1161 798 m 21 -16 d s 1138 792 m 23 6 d s 1185 804 m 20 -16 d s
- 1161 798 m 24 6 d s 1208 810 m 21 -16 d s 1185 804 m 23 6 d s 1232 816 m 20 -16
- d s 1208 810 m 24 6 d s 1255 821 m 21 -15 d s 1232 816 m 23 5 d s 1279 827 m 20
- -15 d s 1255 821 m 24 6 d s 1302 833 m 21 -15 d s 1279 827 m 23 6 d s 1326 839
- m 20 -15 d s 1302 833 m 24 6 d s 1349 845 m 21 -15 d s 1326 839 m 23 6 d s 1373
- 851 m 20 -15 d s 1349 845 m 24 6 d s 1396 857 m 21 -15 d s 1373 851 m 23 6 d s
- 1420 863 m 20 -15 d s 1396 857 m 24 6 d s 1443 869 m 21 -15 d s 1420 863 m 23 6
- d s 1467 875 m 20 -15 d s 1443 869 m 24 6 d s 1511 866 m 13 Y s 1487 873 m 24 6
- d s 1487 860 m 13 Y s 1467 889 m 20 -16 d s 1467 875 m 14 Y s 1490 895 m 21 -16
- d s 1467 889 m 23 6 d s 1514 887 m 20 -15 d s 1504 885 m 10 2 d s 1537 893 m 21
- -15 d s 1514 887 m 23 6 d s 1561 899 m 7 -5 d s 1537 893 m 24 6 d s 1584 905 m
- 21 -15 d s 1561 899 m 23 6 d s 1561 899 m 5 -4 d s 1608 911 m 20 -15 d s 1584
- 905 m 24 6 d s 1631 917 m 21 -15 d s 1608 911 m 23 6 d s 1655 923 m 20 -15 d s
- 1631 917 m 24 6 d s 1678 929 m 21 -15 d s 1655 923 m 23 6 d s 1702 935 m 20 -15
- d s 1678 929 m 24 6 d s 1725 941 m 20 -15 d s 1702 935 m 23 6 d s 1749 947 m 20
- -15 d s 1725 941 m 24 6 d s 1772 953 m 20 -15 d s 1749 947 m 23 6 d s 1749 947
- m 20 -15 d s 1796 959 m 20 -16 d s 1772 953 m 24 6 d s 1819 965 m 7 -6 d s 1796
- 959 m 23 6 d s 1843 971 m 20 -16 d s 1819 965 m 24 6 d s 1819 965 m 5 -4 d s
- 1866 977 m 20 -16 d s 1843 971 m 23 6 d s 1890 983 m 20 -16 d s 1866 977 m 24 6
- d s 1913 989 m 20 -16 d s 1890 983 m 23 6 d s 1937 995 m 20 -16 d s 1913 989 m
- 24 6 d s 1960 1001 m 20 -16 d s 1937 995 m 23 6 d s 1937 995 m 20 -16 d s 836
- 735 m 20 -15 d s 812 729 m 24 6 d s 812 729 m 21 -15 d s 859 741 m 21 -15 d s
- 836 735 m 23 6 d s 883 747 m 20 -15 d s 859 741 m 24 6 d s 906 753 m 21 -15 d s
- 883 747 m 23 6 d s 930 759 m 20 -15 d s 906 753 m 24 6 d s 953 765 m 20 -15 d s
- 930 759 m 23 6 d s 977 771 m 20 -15 d s 953 765 m 24 6 d s 1000 777 m 7 -5 d s
- 977 771 m 23 6 d s 1024 783 m 20 -15 d s 1000 777 m 24 6 d s 1047 789 m 20 -15
- d s 1024 783 m 23 6 d s 1071 795 m 20 -15 d s 1047 789 m 24 6 d s 1094 801 m 20
- -15 d s 1071 795 m 23 6 d s 1118 807 m 20 -15 d s 1094 801 m 24 6 d s 1141 813
- m 20 -15 d s 1118 807 m 23 6 d s 1165 819 m 20 -15 d s 1141 813 m 24 6 d s 1188
- 825 m 20 -15 d s 1165 819 m 23 6 d s 1212 831 m 20 -15 d s 1188 825 m 24 6 d s
- 1235 837 m 20 -16 d s 1212 831 m 23 6 d s 1279 827 m 14 Y s 1255 835 m 24 6 d s
- 1255 821 m 14 Y s 1235 850 m 20 -15 d s 1235 837 m 13 Y s 1259 856 m 20 -15 d s
- 1235 850 m 24 6 d s 1282 849 m 20 -16 d s 1271 846 m 11 3 d s 1305 855 m 21 -16
- d s 1282 849 m 23 6 d s 1329 861 m 20 -16 d s 1305 855 m 24 6 d s 1373 851 m 14
- Y s 1349 859 m 24 6 d s 1349 845 m 14 Y s 1329 874 m 20 -15 d s 1329 861 m 13 Y
- s 1352 880 m 21 -15 d s 1329 874 m 23 6 d s 1376 873 m 20 -16 d s 1365 870 m 11
- 3 d s 1399 879 m 21 -16 d s 1376 873 m 23 6 d s 1423 885 m 20 -16 d s 1399 879
- m 24 6 d s 1446 891 m 21 -16 d s 1423 885 m 23 6 d s 1470 897 m 7 -6 d s 1446
- 891 m 24 6 d s 1493 903 m 21 -16 d s 1470 897 m 23 6 d s 1517 909 m 20 -16 d s
- 1493 903 m 24 6 d s 1540 915 m 21 -16 d s 1517 909 m 23 6 d s 1564 921 m 20 -16
- d s 1540 915 m 24 6 d s 1540 915 m 21 -16 d s 1587 927 m 21 -16 d s 1564 921 m
- 23 6 d s 1611 933 m 20 -16 d s 1587 927 m 24 6 d s 1634 939 m 21 -16 d s 1611
- 933 m 23 6 d s 1658 945 m 20 -16 d s 1634 939 m 24 6 d s 1681 951 m 21 -16 d s
- 1658 945 m 23 6 d s 1705 957 m 20 -16 d s 1681 951 m 24 6 d s 1728 963 m 21 -16
- d s 1705 957 m 23 6 d s 1772 953 m 13 Y s 1749 961 m 23 5 d s 1749 947 m 14 Y s
- 1728 963 m 21 -16 d s 1728 976 m 21 -15 d s 1728 963 m 13 Y s 1752 982 m 20 -16
- d s 1728 976 m 24 6 d s 1775 975 m 21 -16 d s 1764 972 m 11 3 d s 1799 981 m 20
- -16 d s 1775 975 m 24 6 d s 1822 987 m 21 -16 d s 1799 981 m 23 6 d s 1799 981
- m 20 -16 d s 1846 992 m 20 -15 d s 1822 987 m 24 5 d s 1869 998 m 21 -15 d s
- 1846 992 m 23 6 d s 1893 1004 m 20 -15 d s 1869 998 m 24 6 d s 1916 1010 m 21
- -15 d s 1893 1004 m 23 6 d s 1940 1016 m 20 -15 d s 1916 1010 m 24 6 d s 1916
- 1010 m 21 -15 d s 815 751 m 21 -16 d s 792 745 m 23 6 d s 792 745 m 20 -16 d s
- 839 757 m 20 -16 d s 815 751 m 24 6 d s 862 763 m 21 -16 d s 839 757 m 23 6 d s
- 886 769 m 20 -16 d s 862 763 m 24 6 d s 909 775 m 21 -16 d s 886 769 m 23 6 d s
- 933 781 m 20 -16 d s 909 775 m 24 6 d s 956 787 m 21 -16 d s 933 781 m 23 6 d s
- 980 793 m 20 -16 d s 956 787 m 24 6 d s 1003 799 m 21 -16 d s 980 793 m 23 6 d
- s 1047 789 m 14 Y s 1024 797 m 23 6 d s 1024 783 m 14 Y s 1003 812 m 21 -15 d s
- 1003 799 m 13 Y s 1027 818 m 20 -15 d s 1003 812 m 24 6 d s 1050 811 m 21 -16 d
- s 1040 808 m 10 3 d s 1094 801 m 14 Y s 1071 809 m 23 6 d s 1071 795 m 14 Y s
- 1050 824 m 21 -15 d s 1050 811 m 13 Y s 1074 830 m 20 -15 d s 1050 824 m 24 6 d
- s 1097 823 m 21 -16 d s 1087 820 m 10 3 d s 1121 829 m 20 -16 d s 1097 823 m 24
- 6 d s 1144 835 m 21 -16 d s 1121 829 m 23 6 d s 1188 825 m 14 Y s 1165 833 m 23
- 6 d s 1165 819 m 14 Y s 1144 848 m 21 -15 d s 1144 835 m 13 Y s 1168 854 m 20
- -15 d s 1144 848 m 24 6 d s 1191 847 m 21 -16 d s 1181 844 m 10 3 d s 1215 853
- m 20 -16 d s 1191 847 m 24 6 d s 1215 866 m 20 -16 d s 1215 853 m 13 Y s 1238
- 872 m 21 -16 d s 1215 866 m 23 6 d s 1262 865 m 20 -16 d s 1251 862 m 11 3 d s
- 1285 871 m 20 -16 d s 1262 865 m 23 6 d s 1309 876 m 20 -15 d s 1285 871 m 24 5
- d s 1332 882 m 7 -5 d s 1309 876 m 23 6 d s 1356 888 m 20 -15 d s 1332 882 m 24
- 6 d s 1379 894 m 20 -15 d s 1356 888 m 23 6 d s 1423 885 m 27 Y s 1399 906 m 24
- 6 d s 1399 879 m 27 Y s 1379 921 m 20 -15 d s 1379 894 m 27 Y s 1403 927 m 20
- -15 d s 1379 921 m 24 6 d s 1446 891 m 13 Y s 1423 898 m 23 6 d s 1426 920 m 20
- -16 d s 1416 917 m 10 3 d s 1450 912 m 20 -15 d s 1440 910 m 10 2 d s 1493 903
- m 13 Y s 1470 910 m 23 6 d s 1470 897 m 13 Y s 1450 926 m 20 -16 d s 1450 912 m
- 14 Y s 1473 932 m 20 -16 d s 1450 926 m 23 6 d s 1497 924 m 20 -15 d s 1487 922
- m 10 2 d s 1540 915 m 13 Y s 1517 922 m 23 6 d s 1517 909 m 13 Y s 1497 938 m
- 20 -16 d s 1497 924 m 14 Y s 1520 944 m 20 -16 d s 1497 938 m 23 6 d s 1544 936
- m 20 -15 d s 1533 934 m 11 2 d s 1567 942 m 20 -15 d s 1544 936 m 23 6 d s 1591
- 948 m 20 -15 d s 1567 942 m 24 6 d s 1614 954 m 20 -15 d s 1591 948 m 23 6 d s
- 1637 960 m 21 -15 d s 1614 954 m 23 6 d s 1661 966 m 20 -15 d s 1637 960 m 24 6
- d s 1705 957 m 26 Y s 1681 978 m 24 5 d s 1681 951 m 27 Y s 1661 993 m 20 -15 d
- s 1661 966 m 27 Y s 1684 999 m 21 -16 d s 1661 993 m 23 6 d s 1708 978 m 20 -15
- d s 1705 977 m 3 1 d s 1731 984 m 8 -5 d s 1708 978 m 23 6 d s 1708 978 m 20
- -15 d s 1775 975 m 13 Y s 1752 982 m 23 6 d s 1731 998 m 21 -16 d s 1731 984 m
- 14 Y s 1755 1004 m 20 -16 d s 1731 998 m 24 6 d s 1799 981 m 13 Y s 1775 988 m
- 24 6 d s 1778 1010 m 21 -16 d s 1755 1004 m 23 6 d s 1802 1002 m 20 -15 d s
- 1792 1000 m 10 2 d s 1825 1008 m 21 -16 d s 1802 1002 m 23 6 d s 1849 1014 m 20
- -16 d s 1825 1008 m 24 6 d s 1872 1020 m 21 -16 d s 1849 1014 m 23 6 d s 1896
- 1026 m 20 -16 d s 1872 1020 m 24 6 d s 1919 1032 m 21 -16 d s 1896 1026 m 23 6
- d s 1896 1026 m 20 -16 d s 795 766 m 20 -15 d s 772 760 m 23 6 d s 772 760 m 20
- -15 d s 819 772 m 20 -15 d s 795 766 m 24 6 d s 842 778 m 20 -15 d s 819 772 m
- 23 6 d s 865 784 m 21 -15 d s 842 778 m 23 6 d s 889 790 m 20 -15 d s 865 784 m
- 24 6 d s 912 796 m 21 -15 d s 889 790 m 23 6 d s 936 802 m 20 -15 d s 912 796 m
- 24 6 d s 959 808 m 21 -15 d s 936 802 m 23 6 d s 983 814 m 20 -15 d s 959 808 m
- 24 6 d s 1006 820 m 7 -5 d s 983 814 m 23 6 d s 1030 826 m 20 -15 d s 1006 820
- m 24 6 d s 1074 830 m 27 Y s 1050 851 m 24 6 d s 1050 824 m 27 Y s 1030 867 m
- 20 -16 d s 1030 826 m 41 Y s 1053 873 m 21 -16 d s 1030 867 m 23 6 d s 1077 838
- m 20 -15 d s 1074 838 m 3 X s 1100 844 m 21 -15 d s 1077 838 m 23 6 d s 1121
- 842 m 23 6 d s 1121 829 m 13 Y s 1100 858 m 21 -16 d s 1100 844 m 14 Y s 1124
- 864 m 20 -16 d s 1100 858 m 24 6 d s 1147 870 m 21 -16 d s 1124 864 m 23 6 d s
- 1171 862 m 20 -15 d s 1161 860 m 10 2 d s 1194 868 m 21 -15 d s 1171 862 m 23 6
- d s 1194 882 m 21 -16 d s 1194 868 m 14 Y s 1218 888 m 20 -16 d s 1194 882 m 24
- 6 d s 1262 865 m 13 Y s 1238 872 m 24 6 d s 1241 893 m 21 -15 d s 1218 888 m 23
- 5 d s 1285 871 m 13 Y s 1262 878 m 23 6 d s 1265 899 m 20 -15 d s 1241 893 m 24
- 6 d s 1288 892 m 21 -16 d s 1278 889 m 10 3 d s 1332 882 m 41 Y s 1309 917 m 23
- 6 d s 1309 876 m 41 Y s 1288 932 m 21 -15 d s 1288 892 m 40 Y s 1312 938 m 20
- -15 d s 1288 932 m 24 6 d s 1356 888 m 27 Y s 1332 909 m 24 6 d s 1335 931 m 21
- -16 d s 1325 928 m 10 3 d s 1356 915 m 23 6 d s 1359 937 m 20 -16 d s 1335 931
- m 24 6 d s 1403 927 m 14 Y s 1379 935 m 24 6 d s 1379 921 m 14 Y s 1359 950 m
- 20 -15 d s 1359 937 m 13 Y s 1382 956 m 21 -15 d s 1359 950 m 23 6 d s 1406 935
- m 20 -15 d s 1401 934 m 5 1 d s 1429 928 m 21 -16 d s 1419 925 m 10 3 d s 1429
- 941 m 21 -15 d s 1429 928 m 13 Y s 1453 947 m 20 -15 d s 1429 941 m 24 6 d s
- 1473 932 m 24 6 d s 1476 953 m 21 -15 d s 1453 947 m 23 6 d s 1500 946 m 7 -6 d
- s 1490 943 m 10 3 d s 1523 952 m 21 -16 d s 1500 946 m 23 6 d s 1500 946 m 6 -5
- d s 1547 958 m 20 -16 d s 1523 952 m 24 6 d s 1570 964 m 21 -16 d s 1547 958 m
- 23 6 d s 1614 954 m 14 Y s 1591 962 m 23 6 d s 1591 948 m 14 Y s 1570 977 m 21
- -15 d s 1570 964 m 13 Y s 1594 983 m 20 -15 d s 1570 977 m 24 6 d s 1637 960 m
- 14 Y s 1614 968 m 23 6 d s 1617 989 m 20 -15 d s 1594 983 m 23 6 d s 1641 982 m
- 20 -16 d s 1631 979 m 10 3 d s 1641 982 m 21 5 d s 1705 980 m 3 -2 d s 1711
- 1000 m 20 -16 d s 1691 994 m 20 6 d s 1705 980 m 3 -2 d s 1711 1013 m 20 -15 d
- s 1711 1000 m 13 Y s 1735 1019 m 20 -15 d s 1711 1013 m 24 6 d s 1758 1012 m 7
- -6 d s 1747 1009 m 11 3 d s 1802 1002 m 13 Y s 1778 1010 m 24 5 d s 1758 1012 m
- 5 -4 d s 1758 1025 m 20 -15 d s 1758 1012 m 13 Y s 1782 1031 m 20 -16 d s 1758
- 1025 m 24 6 d s 1825 1008 m 13 Y s 1802 1015 m 23 6 d s 1805 1037 m 20 -16 d s
- 1782 1031 m 23 6 d s 1829 1030 m 20 -16 d s 1819 1027 m 10 3 d s 1852 1036 m 20
- -16 d s 1829 1030 m 23 6 d s 1876 1042 m 20 -16 d s 1852 1036 m 24 6 d s 1899
- 1047 m 20 -15 d s 1876 1042 m 23 5 d s 1876 1042 m 20 -16 d s 775 782 m 20 -16
- d s 751 776 m 24 6 d s 751 776 m 21 -16 d s 798 788 m 21 -16 d s 775 782 m 23 6
- d s 822 794 m 20 -16 d s 798 788 m 24 6 d s 845 800 m 20 -16 d s 822 794 m 23 6
- d s 889 790 m 27 Y s 865 811 m 24 6 d s 865 784 m 27 Y s 845 827 m 20 -16 d s
- 845 800 m 27 Y s 869 833 m 20 -16 d s 845 827 m 24 6 d s 912 796 m 41 Y s 889
- 831 m 23 6 d s 889 817 m 14 Y s 869 846 m 20 -15 d s 869 833 m 13 Y s 892 852 m
- 20 -15 d s 869 846 m 23 6 d s 936 802 m 14 Y s 912 810 m 24 6 d s 916 831 m 20
- -15 d s 913 831 m 3 X s 959 808 m 14 Y s 936 816 m 23 6 d s 939 837 m 20 -15 d
- s 916 831 m 23 6 d s 983 814 m 41 Y s 959 849 m 24 6 d s 959 822 m 27 Y s 939
- 864 m 20 -15 d s 939 837 m 27 Y s 963 870 m 20 -15 d s 939 864 m 24 6 d s 1006
- 820 m 27 Y s 983 841 m 23 6 d s 986 863 m 20 -16 d s 976 860 m 10 3 d s 1006
- 861 m 24 6 d s 1006 847 m 14 Y s 986 876 m 20 -15 d s 986 863 m 13 Y s 1010 882
- m 20 -15 d s 986 876 m 24 6 d s 1033 875 m 7 -6 d s 1023 872 m 10 3 d s 1077
- 838 m 27 Y s 1067 863 m 10 2 d s 1057 881 m 20 -16 d s 1033 875 m 24 6 d s 1100
- 858 m 13 Y s 1077 865 m 23 6 d s 1080 887 m 20 -16 d s 1057 881 m 23 6 d s 1124
- 864 m 13 Y s 1100 871 m 24 6 d s 1104 893 m 20 -16 d s 1080 887 m 24 6 d s 1147
- 870 m 13 Y s 1124 877 m 23 6 d s 1127 899 m 20 -16 d s 1104 893 m 23 6 d s 1171
- 862 m 14 Y s 1147 870 m 24 6 d s 1151 891 m 20 -15 d s 1139 888 m 12 3 d s 1194
- 882 m 13 Y s 1171 889 m 23 6 d s 1171 876 m 13 Y s 1151 905 m 20 -16 d s 1151
- 891 m 14 Y s 1174 911 m 20 -16 d s 1151 905 m 23 6 d s 1218 888 m 13 Y s 1194
- 895 m 24 6 d s 1197 916 m 21 -15 d s 1174 911 m 23 5 d s 1221 909 m 20 -16 d s
- 1211 906 m 10 3 d s 1265 899 m 27 Y s 1241 920 m 24 6 d s 1241 893 m 27 Y s
- 1221 936 m 20 -16 d s 1221 909 m 27 Y s 1244 942 m 21 -16 d s 1221 936 m 23 6 d
- s 1265 899 m 23 6 d s 1268 921 m 20 -16 d s 1265 920 m 3 1 d s 1268 921 m 19 5
- d s 1291 940 m 7 -5 d s 1291 934 m 6 Y s 1315 946 m 20 -15 d s 1291 940 m 24 6
- d s 1338 952 m 21 -15 d s 1338 931 m 21 Y s 1362 958 m 7 -5 d s 1338 952 m 24 6
- d s 1401 939 m 5 -4 d s 1409 943 m 20 -15 d s 1401 941 m 8 2 d s 1453 947 m 14
- Y s 1429 955 m 24 6 d s 1429 941 m 14 Y s 1409 970 m 20 -15 d s 1409 943 m 27 Y
- s 1432 976 m 21 -15 d s 1409 970 m 23 6 d s 1456 969 m 20 -16 d s 1446 966 m 10
- 3 d s 1500 946 m 27 Y s 1476 967 m 24 6 d s 1476 953 m 14 Y s 1456 982 m 20 -15
- d s 1456 969 m 13 Y s 1479 988 m 21 -15 d s 1456 982 m 23 6 d s 1523 952 m 13 Y
- s 1500 959 m 23 6 d s 1503 981 m 20 -16 d s 1492 978 m 11 3 d s 1526 973 m 21
- -15 d s 1516 971 m 10 2 d s 1570 977 m 14 Y s 1547 985 m 23 6 d s 1547 958 m 27
- Y s 1526 1000 m 21 -15 d s 1526 973 m 27 Y s 1550 1006 m 20 -15 d s 1526 1000 m
- 24 6 d s 1594 983 m 14 Y s 1570 991 m 24 6 d s 1570 991 m s 1563 996 m 7 -5 d s
- 1573 1012 m 21 -15 d s 1550 1006 m 23 6 d s 1597 1005 m 20 -16 d s 1586 1002 m
- 11 3 d s 1641 982 m 27 Y s 1617 1003 m 24 6 d s 1617 989 m 14 Y s 1597 1018 m
- 20 -15 d s 1597 1005 m 13 Y s 1620 1024 m 21 -15 d s 1597 1018 m 23 6 d s 1664
- 994 m 34 Y s 1641 1022 m 23 6 d s 1641 1009 m 13 Y s 1620 1038 m 21 -16 d s
- 1620 1024 m 14 Y s 1644 1044 m 20 -16 d s 1620 1038 m 24 6 d s 1667 1009 m 15
- -11 d s 1665 1009 m 2 X s 1688 1007 m 23 6 d s 1688 997 m 10 Y s 1680 999 m s
- 1667 1023 m 21 -16 d s 1667 1009 m 14 Y s 1691 1029 m 20 -16 d s 1667 1023 m 24
- 6 d s 1735 1019 m 27 Y s 1711 1040 m 24 6 d s 1711 1013 m 27 Y s 1691 1055 m 20
- -15 d s 1691 1029 m 26 Y s 1714 1061 m 21 -15 d s 1691 1055 m 23 6 d s 1738
- 1027 m 20 -15 d s 1735 1026 m 3 1 d s 1761 1033 m 7 -5 d s 1738 1027 m 23 6 d s
- 1738 1027 m 20 -15 d s 1805 1037 m 67 Y s 1782 1098 m 23 6 d s 1782 1031 m 67 Y
- s 1761 1114 m 21 -16 d s 1761 1033 m 81 Y s 1785 1120 m 20 -16 d s 1761 1114 m
- 24 6 d s 1808 1045 m 21 -15 d s 1806 1044 m 2 1 d s 1832 1051 m 20 -15 d s 1808
- 1045 m 24 6 d s 1855 1057 m 21 -15 d s 1832 1051 m 23 6 d s 1879 1063 m 20 -16
- d s 1855 1057 m 24 6 d s 1855 1057 m 21 -15 d s 754 798 m 21 -16 d s 731 792 m
- 23 6 d s 731 792 m 20 -16 d s 778 803 m 20 -15 d s 754 798 m 24 5 d s 801 809 m
- 21 -15 d s 778 803 m 23 6 d s 825 815 m 20 -15 d s 801 809 m 24 6 d s 845 840 m
- 24 6 d s 845 827 m 13 Y s 825 856 m 20 -16 d s 825 815 m 41 Y s 848 862 m 21
- -16 d s 825 856 m 23 6 d s 872 868 m 20 -16 d s 848 862 m 24 6 d s 916 831 m 41
- Y s 892 866 m 24 6 d s 892 852 m 14 Y s 872 881 m 20 -15 d s 872 868 m 13 Y s
- 895 887 m 21 -15 d s 872 881 m 23 6 d s 939 864 m 27 Y s 916 885 m 23 6 d s 916
- 872 m 13 Y s 895 901 m 21 -16 d s 895 887 m 14 Y s 919 907 m 20 -16 d s 895 901
- m 24 6 d s 966 878 m 20 -15 d s 966 868 m 10 Y s 989 884 m 7 -5 d s 966 878 m
- 23 6 d s 1033 875 m 40 Y s 1010 909 m 23 6 d s 1010 882 m 27 Y s 989 924 m 21
- -15 d s 989 884 m 40 Y s 1013 930 m 20 -15 d s 989 924 m 24 6 d s 1057 881 m 26
- Y s 1033 902 m 24 5 d s 1036 923 m 21 -16 d s 1025 920 m 11 3 d s 1080 887 m 13
- Y s 1057 894 m 23 6 d s 1060 916 m 20 -16 d s 1050 913 m 10 3 d s 1104 893 m 40
- Y s 1080 927 m 24 6 d s 1080 900 m 27 Y s 1060 942 m 20 -15 d s 1060 916 m 26 Y
- s 1083 948 m 21 -15 d s 1060 942 m 23 6 d s 1127 899 m 26 Y s 1104 919 m 23 6 d
- s 1107 941 m 20 -16 d s 1097 938 m 10 3 d s 1151 905 m 13 Y s 1127 912 m 24 6 d
- s 1130 933 m 21 -15 d s 1119 931 m 11 2 d s 1174 911 m 13 Y s 1151 918 m 23 6 d
- s 1154 939 m 20 -15 d s 1130 933 m 24 6 d s 1177 919 m 7 -6 d s 1175 918 m 2 1
- d s 1201 925 m 20 -16 d s 1177 919 m 24 6 d s 1244 942 m 13 Y s 1221 949 m 23 6
- d s 1221 936 m 13 Y s 1201 965 m 20 -16 d s 1201 925 m 40 Y s 1224 971 m 20 -16
- d s 1201 965 m 23 6 d s 1268 921 m 81 Y s 1244 996 m 24 6 d s 1244 955 m 41 Y s
- 1224 1011 m 20 -15 d s 1224 971 m 40 Y s 1248 1017 m 20 -15 d s 1224 1011 m 24
- 6 d s 1291 940 m 27 Y s 1268 961 m 23 6 d s 1271 983 m 20 -16 d s 1268 982 m 3
- 1 d s 1315 946 m 41 Y s 1291 981 m 24 6 d s 1291 967 m 14 Y s 1271 996 m 20 -15
- d s 1271 983 m 13 Y s 1295 1002 m 20 -15 d s 1271 996 m 24 6 d s 1338 952 m 41
- Y s 1315 987 m 23 6 d s 1318 1008 m 20 -15 d s 1295 1002 m 23 6 d s 1362 958 m
- 27 Y s 1338 979 m 24 6 d s 1342 1001 m 20 -16 d s 1331 998 m 11 3 d s 1365 966
- m 15 -11 d s 1362 966 m 3 X s 1385 964 m 24 6 d s 1385 954 m 10 Y s 1365 980 m
- 20 -16 d s 1365 966 m 14 Y s 1389 986 m 20 -16 d s 1365 980 m 24 6 d s 1432 976
- m 14 Y s 1409 984 m 23 6 d s 1409 970 m 14 Y s 1389 999 m 20 -15 d s 1389 986 m
- 13 Y s 1412 1005 m 20 -15 d s 1389 999 m 23 6 d s 1432 976 m 24 6 d s 1436 998
- m 20 -16 d s 1424 995 m 12 3 d s 1459 990 m 7 -5 d s 1449 988 m 10 2 d s 1503
- 981 m 13 Y s 1479 988 m 24 6 d s 1479 988 m s 1459 1004 m 20 -16 d s 1459 990 m
- 14 Y s 1483 1010 m 20 -16 d s 1459 1004 m 24 6 d s 1526 1000 m 54 Y s 1503 1048
- m 23 6 d s 1503 994 m 54 Y s 1483 1064 m 20 -16 d s 1483 1010 m 54 Y s 1506
- 1069 m 20 -15 d s 1483 1064 m 23 5 d s 1550 1006 m 27 Y s 1526 1027 m 24 6 d s
- 1529 1049 m 21 -16 d s 1525 1047 m 4 2 d s 1553 1028 m 20 -16 d s 1550 1027 m 3
- 1 d s 1597 1018 m 27 Y s 1573 1039 m 24 6 d s 1573 1012 m 27 Y s 1553 1055 m 20
- -16 d s 1553 1028 m 27 Y s 1576 1061 m 21 -16 d s 1553 1055 m 23 6 d s 1620
- 1038 m 40 Y s 1597 1072 m 23 6 d s 1597 1045 m 27 Y s 1576 1087 m 21 -15 d s
- 1576 1061 m 26 Y s 1600 1093 m 20 -15 d s 1576 1087 m 24 6 d s 1623 1046 m 8 -6
- d s 1621 1045 m 2 1 d s 1667 1023 m 40 Y s 1644 1057 m 23 6 d s 1644 1044 m 13
- Y s 1623 1073 m 21 -16 d s 1623 1046 m 27 Y s 1647 1078 m 20 -15 d s 1623 1073
- m 24 5 d s 1691 1055 m 14 Y s 1667 1063 m 24 6 d s 1670 1084 m 21 -15 d s 1647
- 1078 m 23 6 d s 1694 1077 m 20 -16 d s 1684 1074 m 10 3 d s 1738 1027 m 40 Y s
- 1714 1061 m 24 6 d s 1717 1083 m 21 -16 d s 1694 1077 m 23 6 d s 1738 1067 m 23
- 6 d s 1741 1089 m 20 -16 d s 1717 1083 m 24 6 d s 1741 1102 m 20 -15 d s 1741
- 1089 m 13 Y s 1741 1102 m 21 6 d s 1806 1047 m 2 -2 d s 1811 1067 m 21 -16 d s
- 1806 1065 m 5 2 d s 1835 1073 m 20 -16 d s 1811 1067 m 24 6 d s 1858 1079 m 21
- -16 d s 1835 1073 m 23 6 d s 1835 1073 m 20 -16 d s 734 813 m 20 -15 d s 711
- 807 m 23 6 d s 711 807 m 20 -15 d s 757 819 m 21 -16 d s 734 813 m 23 6 d s 781
- 825 m 20 -16 d s 757 819 m 24 6 d s 804 831 m 21 -16 d s 781 825 m 23 6 d s 848
- 862 m 13 Y s 825 869 m 23 6 d s 825 856 m 13 Y s 804 885 m 21 -16 d s 804 831 m
- 54 Y s 828 891 m 20 -16 d s 804 885 m 24 6 d s 872 881 m 27 Y s 848 902 m 24 6
- d s 848 875 m 27 Y s 828 918 m 20 -16 d s 828 891 m 27 Y s 851 924 m 21 -16 d s
- 828 918 m 23 6 d s 872 895 m 23 6 d s 875 916 m 20 -15 d s 864 913 m 11 3 d s
- 942 865 m 34 Y s 931 896 m 11 3 d s 898 909 m 8 -6 d s 898 901 m 8 Y s 922 915
- m 20 -16 d s 898 909 m 24 6 d s 966 878 m 94 Y s 942 966 m 24 6 d s 942 899 m
- 67 Y s 922 982 m 20 -16 d s 922 915 m 67 Y s 945 988 m 21 -16 d s 922 982 m 23
- 6 d s 989 924 m 27 Y s 966 945 m 23 6 d s 969 967 m 20 -16 d s 964 966 m 5 1 d
- s 1013 930 m 54 Y s 989 978 m 24 6 d s 989 951 m 27 Y s 969 994 m 20 -16 d s
- 969 967 m 27 Y s 992 1000 m 21 -16 d s 969 994 m 23 6 d s 1039 931 m 21 -15 d s
- 1019 926 m 20 5 d s 1083 948 m 68 Y s 1060 1010 m 23 6 d s 1060 942 m 68 Y s
- 1039 1025 m 21 -15 d s 1039 931 m 94 Y s 1063 1031 m 20 -15 d s 1039 1025 m 24
- 6 d s 1107 941 m 40 Y s 1083 975 m 24 6 d s 1086 997 m 21 -16 d s 1084 996 m 2
- 1 d s 1130 933 m 54 Y s 1107 981 m 23 6 d s 1110 1003 m 20 -16 d s 1086 997 m
- 24 6 d s 1154 939 m 41 Y s 1130 974 m 24 6 d s 1133 995 m 21 -15 d s 1123 993 m
- 10 2 d s 1177 919 m 53 Y s 1154 966 m 23 6 d s 1157 988 m 20 -16 d s 1147 985 m
- 10 3 d s 1177 932 m 24 6 d s 1180 954 m 21 -16 d s 1176 952 m 4 2 d s 1224 1011
- m 14 Y s 1201 1019 m 23 6 d s 1201 965 m 54 Y s 1180 1034 m 21 -15 d s 1180 954
- m 80 Y s 1204 1040 m 20 -15 d s 1180 1034 m 24 6 d s 1227 1033 m 21 -16 d s
- 1216 1030 m 11 3 d s 1295 1002 m 41 Y s 1271 1037 m 24 6 d s 1271 996 m 41 Y s
- 1251 1052 m 20 -15 d s 1251 1015 m 37 Y s 1274 1058 m 21 -15 d s 1251 1052 m 23
- 6 d s 1318 1008 m 27 Y s 1295 1029 m 23 6 d s 1298 1051 m 20 -16 d s 1288 1048
- m 10 3 d s 1342 1001 m 53 Y s 1318 1049 m 24 5 d s 1318 1035 m 14 Y s 1298 1064
- m 20 -15 d s 1298 1051 m 13 Y s 1321 1070 m 21 -16 d s 1298 1064 m 23 6 d s
- 1365 980 m 40 Y s 1342 1014 m 23 6 d s 1345 1036 m 20 -16 d s 1342 1035 m 3 1 d
- s 1365 993 m 24 6 d s 1368 1015 m 21 -16 d s 1366 1014 m 2 1 d s 1392 1021 m 20
- -16 d s 1368 1015 m 24 6 d s 1436 998 m 94 Y s 1412 1086 m 24 6 d s 1412 1005 m
- 81 Y s 1392 1101 m 20 -15 d s 1392 1021 m 80 Y s 1415 1107 m 21 -15 d s 1392
- 1101 m 23 6 d s 1459 1004 m 40 Y s 1436 1038 m 23 6 d s 1439 1060 m 20 -16 d s
- 1436 1059 m 3 1 d s 1483 1064 m 13 Y s 1459 1071 m 24 6 d s 1459 1044 m 27 Y s
- 1439 1086 m 20 -15 d s 1439 1060 m 26 Y s 1462 1092 m 21 -15 d s 1439 1086 m 23
- 6 d s 1553 1055 m 40 Y s 1529 1089 m 24 6 d s 1529 1049 m 40 Y s 1509 1104 m 20
- -15 d s 1509 1068 m 36 Y s 1533 1110 m 20 -15 d s 1509 1104 m 24 6 d s 1553
- 1081 m 23 6 d s 1556 1103 m 20 -16 d s 1546 1100 m 10 3 d s 1623 1073 m 26 Y s
- 1600 1093 m 23 6 d s 1580 1109 m 20 -16 d s 1580 1089 m 20 Y s 1603 1115 m 20
- -16 d s 1580 1109 m 23 6 d s 1647 1078 m 14 Y s 1623 1086 m 24 6 d s 1627 1107
- m 20 -15 d s 1616 1105 m 11 2 d s 1650 1087 m 7 -6 d s 1647 1086 m 3 1 d s 1674
- 1093 m 20 -16 d s 1650 1087 m 24 6 d s 1717 1083 m 134 Y s 1694 1211 m 23 6 d s
- 1694 1077 m 134 Y s 1674 1227 m 20 -16 d s 1674 1093 m 134 Y s 1697 1233 m 20
- -16 d s 1674 1227 m 23 6 d s 1717 1096 m 24 6 d s 1721 1118 m 20 -16 d s 1716
- 1117 m 5 1 d s 1744 1110 m 7 -5 d s 1734 1108 m 10 2 d s 1806 1070 m 5 -3 d s
- 1814 1088 m 21 -15 d s 1807 1086 m 7 2 d s 1838 1094 m 20 -15 d s 1814 1088 m
- 24 6 d s 1814 1088 m 21 -15 d s 714 829 m 20 -16 d s 690 823 m 24 6 d s 690 823
- m 21 -16 d s 737 835 m 20 -16 d s 714 829 m 23 6 d s 761 841 m 20 -16 d s 737
- 835 m 24 6 d s 784 847 m 20 -16 d s 761 841 m 23 6 d s 828 918 m 40 Y s 804 952
- m 24 6 d s 804 885 m 67 Y s 784 967 m 20 -15 d s 784 847 m 120 Y s 808 973 m 20
- -15 d s 784 967 m 24 6 d s 875 916 m 27 Y s 851 937 m 24 6 d s 851 924 m 13 Y s
- 831 953 m 20 -16 d s 831 918 m 35 Y s 855 959 m 20 -16 d s 831 953 m 24 6 d s
- 898 909 m 67 Y s 875 970 m 23 6 d s 875 943 m 27 Y s 855 985 m 20 -15 d s 855
- 959 m 26 Y s 878 991 m 20 -15 d s 855 985 m 23 6 d s 922 982 m 13 Y s 898 989 m
- 24 6 d s 898 976 m 13 Y s 878 1005 m 20 -16 d s 878 991 m 14 Y s 902 1011 m 20
- -16 d s 878 1005 m 24 6 d s 969 994 m 67 Y s 945 1055 m 24 6 d s 945 988 m 67 Y
- s 925 1071 m 20 -16 d s 925 982 m 89 Y s 949 1076 m 20 -15 d s 925 1071 m 24 5
- d s 972 1002 m 7 -6 d s 970 1001 m 2 1 d s 1016 929 m 63 Y s 1006 990 m 10 2 d
- s 996 1008 m 20 -16 d s 972 1002 m 24 6 d s 1039 1025 m 67 Y s 1016 1086 m 23 6
- d s 1016 992 m 94 Y s 996 1102 m 20 -16 d s 996 1008 m 94 Y s 1019 1108 m 20
- -16 d s 996 1102 m 23 6 d s 1063 1031 m 14 Y s 1039 1039 m 24 6 d s 1043 1060 m
- 20 -15 d s 1040 1059 m 3 1 d s 1086 997 m 94 Y s 1063 1085 m 23 6 d s 1063 1045
- m 40 Y s 1043 1100 m 20 -15 d s 1043 1060 m 40 Y s 1066 1106 m 20 -15 d s 1043
- 1100 m 23 6 d s 1110 1003 m 40 Y s 1086 1037 m 24 6 d s 1089 1059 m 21 -16 d s
- 1087 1058 m 2 1 d s 1133 995 m 54 Y s 1110 1043 m 23 6 d s 1113 1065 m 20 -16 d
- s 1089 1059 m 24 6 d s 1157 988 m 107 Y s 1133 1089 m 24 6 d s 1133 1049 m 40 Y
- s 1113 1105 m 20 -16 d s 1113 1065 m 40 Y s 1136 1111 m 21 -16 d s 1113 1105 m
- 23 6 d s 1180 1034 m 54 Y s 1157 1082 m 23 6 d s 1160 1103 m 20 -15 d s 1149
- 1101 m 11 2 d s 1204 1040 m 54 Y s 1180 1088 m 24 6 d s 1183 1109 m 21 -15 d s
- 1160 1103 m 23 6 d s 1207 1048 m 20 -15 d s 1204 1048 m 3 X s 1227 1033 m 24 6
- d s 1230 1054 m 21 -15 d s 1207 1048 m 23 6 d s 1274 1058 m 54 Y s 1251 1106 m
- 23 6 d s 1251 1052 m 54 Y s 1230 1121 m 21 -15 d s 1230 1054 m 67 Y s 1254 1127
- m 20 -15 d s 1230 1121 m 24 6 d s 1298 1064 m 121 Y s 1274 1179 m 24 6 d s 1274
- 1112 m 67 Y s 1254 1195 m 20 -16 d s 1254 1127 m 68 Y s 1277 1201 m 21 -16 d s
- 1254 1195 m 23 6 d s 1321 1070 m 27 Y s 1298 1091 m 23 6 d s 1301 1112 m 20 -15
- d s 1298 1112 m 3 X s 1345 1036 m 27 Y s 1335 1060 m 10 3 d s 1324 1078 m 21
- -15 d s 1322 1078 m 2 X s 1368 1015 m 54 Y s 1345 1063 m 23 6 d s 1348 1084 m
- 20 -15 d s 1324 1078 m 24 6 d s 1368 1028 m 24 6 d s 1371 1050 m 21 -16 d s
- 1367 1049 m 4 1 d s 1371 1104 m 21 -16 d s 1371 1050 m 54 Y s 1395 1109 m 7 -5
- d s 1371 1104 m 24 5 d s 1436 1072 m 3 1 d s 1436 1075 m 3 -2 d s 1486 1064 m
- 88 Y s 1462 1146 m 24 6 d s 1462 1092 m 54 Y s 1442 1162 m 20 -16 d s 1442 1087
- m 75 Y s 1465 1168 m 21 -16 d s 1442 1162 m 23 6 d s 1509 1104 m 27 Y s 1486
- 1125 m 23 6 d s 1489 1147 m 20 -16 d s 1486 1146 m 3 1 d s 1533 1110 m 14 Y s
- 1509 1118 m 24 6 d s 1512 1139 m 21 -15 d s 1501 1137 m 11 2 d s 1556 1103 m 54
- Y s 1533 1151 m 23 6 d s 1533 1124 m 27 Y s 1512 1166 m 21 -15 d s 1512 1139 m
- 27 Y s 1536 1172 m 20 -15 d s 1512 1166 m 24 6 d s 1580 1109 m 67 Y s 1556 1170
- m 24 6 d s 1556 1157 m 13 Y s 1536 1186 m 20 -16 d s 1536 1172 m 14 Y s 1559
- 1192 m 21 -16 d s 1536 1186 m 23 6 d s 1603 1115 m 13 Y s 1580 1122 m 23 6 d s
- 1583 1144 m 20 -16 d s 1580 1143 m 3 1 d s 1627 1107 m 135 Y s 1603 1236 m 24 6
- d s 1603 1128 m 108 Y s 1583 1251 m 20 -15 d s 1583 1144 m 107 Y s 1606 1257 m
- 21 -15 d s 1583 1251 m 23 6 d s 1650 1087 m 120 Y s 1627 1202 m 23 5 d s 1630
- 1223 m 20 -16 d s 1627 1222 m 3 1 d s 1650 1154 m 24 6 d s 1653 1175 m 21 -15 d
- s 1651 1175 m 2 X s 1653 1175 m 21 6 d s 1721 1118 m 67 Y s 1716 1184 m 5 1 d s
- 1716 1189 m 5 -4 d s 1744 1110 m 108 Y s 1721 1212 m 23 6 d s 1721 1185 m 27 Y
- s 1716 1215 m 5 -3 d s 1724 1234 m 20 -16 d s 1703 1228 m 21 6 d s 1807 1094 m
- 7 -6 d s 1818 1110 m 20 -16 d s 1803 1106 m 15 4 d s 1807 1094 m 7 -6 d s 693
- 844 m 21 -15 d s 670 838 m 23 6 d s 670 838 m 20 -15 d s 717 850 m 20 -15 d s
- 693 844 m 24 6 d s 740 856 m 21 -15 d s 717 850 m 23 6 d s 764 862 m 20 -15 d s
- 740 856 m 24 6 d s 808 973 m 148 Y s 784 1115 m 24 6 d s 784 967 m 148 Y s 764
- 1131 m 20 -16 d s 764 862 m 269 Y s 787 1137 m 21 -16 d s 764 1131 m 23 6 d s
- 831 953 m 107 Y s 808 1054 m 23 6 d s 811 1076 m 20 -16 d s 806 1074 m 5 2 d s
- 855 985 m 27 Y s 831 1006 m 24 6 d s 834 1028 m 21 -16 d s 832 1027 m 2 1 d s
- 878 1005 m 107 Y s 855 1106 m 23 6 d s 855 1012 m 94 Y s 834 1122 m 21 -16 d s
- 834 1028 m 94 Y s 858 1128 m 20 -16 d s 834 1122 m 24 6 d s 902 1011 m 54 Y s
- 878 1059 m 24 6 d s 881 1080 m 21 -15 d s 879 1079 m 2 1 d s 925 1071 m 67 Y s
- 902 1132 m 23 6 d s 902 1065 m 67 Y s 881 1147 m 21 -15 d s 881 1080 m 67 Y s
- 905 1153 m 20 -15 d s 881 1147 m 24 6 d s 972 1002 m 148 Y s 949 1144 m 23 6 d
- s 949 1076 m 68 Y s 928 1159 m 21 -15 d s 928 1071 m 88 Y s 952 1165 m 20 -15 d
- s 928 1159 m 24 6 d s 972 1096 m 24 6 d s 975 1117 m 21 -15 d s 973 1117 m 2 X
- s 999 1110 m 7 -5 d s 988 1107 m 11 3 d s 1040 1062 m 3 -2 d s 1066 1106 m 27 Y
- s 1043 1127 m 23 6 d s 1043 1100 m 27 Y s 1022 1143 m 21 -16 d s 1022 1106 m 37
- Y s 1046 1149 m 20 -16 d s 1022 1143 m 24 6 d s 1089 1059 m 13 Y s 1087 1071 m
- 2 1 d s 1087 1074 m 2 -2 d s 1093 1067 m 7 -6 d s 1090 1066 m 3 1 d s 1136 1111
- m 27 Y s 1113 1132 m 23 6 d s 1113 1105 m 27 Y s 1093 1147 m 20 -15 d s 1093
- 1067 m 80 Y s 1116 1153 m 20 -15 d s 1093 1147 m 23 6 d s 1160 1103 m 108 Y s
- 1136 1205 m 24 6 d s 1136 1138 m 67 Y s 1116 1220 m 20 -15 d s 1116 1153 m 67 Y
- s 1140 1226 m 20 -15 d s 1116 1220 m 24 6 d s 1163 1125 m 20 -16 d s 1161 1124
- m 2 1 d s 1207 1048 m 81 Y s 1183 1123 m 24 6 d s 1183 1109 m 14 Y s 1163 1138
- m 20 -15 d s 1163 1125 m 13 Y s 1187 1144 m 20 -15 d s 1163 1138 m 24 6 d s
- 1207 1115 m 23 6 d s 1210 1137 m 20 -16 d s 1199 1134 m 11 3 d s 1230 1135 m 24
- 6 d s 1230 1121 m 14 Y s 1210 1150 m 20 -15 d s 1210 1137 m 13 Y s 1234 1156 m
- 20 -15 d s 1210 1150 m 24 6 d s 1234 1197 m 20 -16 d s 1234 1156 m 41 Y s 1257
- 1203 m 7 -6 d s 1234 1197 m 23 6 d s 1301 1112 m 68 Y s 1298 1179 m 3 1 d s
- 1298 1182 m 3 -2 d s 1324 1078 m 175 Y s 1301 1247 m 23 6 d s 1301 1180 m 67 Y
- s 1281 1262 m 20 -15 d s 1281 1199 m 63 Y s 1304 1268 m 20 -15 d s 1281 1262 m
- 23 6 d s 1348 1084 m 108 Y s 1324 1186 m 24 6 d s 1328 1207 m 20 -15 d s 1325
- 1206 m 3 1 d s 1371 1104 m 120 Y s 1348 1218 m 23 6 d s 1348 1192 m 26 Y s 1328
- 1234 m 20 -16 d s 1328 1207 m 27 Y s 1351 1240 m 20 -16 d s 1328 1234 m 23 6 d
- s 1395 1109 m 81 Y s 1371 1184 m 24 6 d s 1374 1206 m 21 -16 d s 1372 1205 m 2
- 1 d s 1418 1104 m 106 Y s 1395 1204 m 23 6 d s 1395 1190 m 14 Y s 1374 1219 m
- 21 -15 d s 1374 1206 m 13 Y s 1398 1225 m 20 -15 d s 1374 1219 m 24 6 d s 1442
- 1162 m 80 Y s 1418 1236 m 24 6 d s 1418 1210 m 26 Y s 1398 1252 m 20 -16 d s
- 1398 1225 m 27 Y s 1421 1258 m 21 -16 d s 1398 1252 m 23 6 d s 1465 1168 m 53 Y
- s 1442 1215 m 23 6 d s 1445 1237 m 20 -16 d s 1442 1236 m 3 1 d s 1489 1147 m
- 94 Y s 1465 1235 m 24 6 d s 1465 1221 m 14 Y s 1445 1250 m 20 -15 d s 1445 1237
- m 13 Y s 1468 1256 m 21 -15 d s 1445 1250 m 23 6 d s 1512 1166 m 27 Y s 1489
- 1187 m 23 6 d s 1492 1209 m 20 -16 d s 1489 1208 m 3 1 d s 1536 1186 m 27 Y s
- 1512 1207 m 24 6 d s 1512 1193 m 14 Y s 1492 1222 m 20 -15 d s 1492 1209 m 13 Y
- s 1515 1228 m 21 -15 d s 1492 1222 m 23 6 d s 1559 1192 m 94 Y s 1536 1280 m 23
- 6 d s 1536 1213 m 67 Y s 1515 1295 m 21 -15 d s 1515 1228 m 67 Y s 1539 1301 m
- 20 -15 d s 1515 1295 m 24 6 d s 1583 1251 m 81 Y s 1559 1326 m 24 6 d s 1559
- 1286 m 40 Y s 1539 1342 m 20 -16 d s 1539 1301 m 41 Y s 1562 1348 m 21 -16 d s
- 1539 1342 m 23 6 d s 1606 1257 m 94 Y s 1583 1345 m 23 6 d s 1583 1332 m 13 Y s
- 1562 1361 m 21 -16 d s 1562 1348 m 13 Y s 1586 1367 m 20 -16 d s 1562 1361 m 24
- 6 d s 1630 1223 m 81 Y s 1606 1298 m 24 6 d s 1609 1319 m 21 -15 d s 1605 1318
- m 4 1 d s 1653 1175 m 81 Y s 1630 1250 m 23 6 d s 1633 1271 m 20 -15 d s 1630
- 1271 m 3 X s 1677 1228 m 74 Y s 1653 1296 m 24 6 d s 1653 1256 m 40 Y s 1633
- 1312 m 20 -16 d s 1633 1271 m 41 Y s 1656 1318 m 21 -16 d s 1633 1312 m 23 6 d
- s 1700 1231 m 37 Y s 1677 1262 m 23 6 d s 1680 1283 m 20 -15 d s 1677 1283 m 3
- X s 1724 1234 m 53 Y s 1700 1281 m 24 6 d s 1700 1268 m 13 Y s 1680 1297 m 20
- -16 d s 1680 1283 m 14 Y s 1703 1303 m 21 -16 d s 1680 1297 m 23 6 d s 1750
- 1113 m 8 -6 d s 1743 1111 m 7 2 d s 1774 1119 m 2 -1 d s 1750 1113 m 24 6 d s
- 1797 1125 m 21 -15 d s 1774 1119 m 23 6 d s 1774 1119 m s 673 860 m 20 -16 d s
- 649 854 m 24 6 d s 649 854 m 21 -16 d s 696 866 m 21 -16 d s 673 860 m 23 6 d s
- 720 872 m 20 -16 d s 696 866 m 24 6 d s 743 878 m 21 -16 d s 720 872 m 23 6 d s
- 787 1137 m 94 Y s 764 1225 m 23 6 d s 764 1131 m 94 Y s 743 1240 m 21 -15 d s
- 743 878 m 362 Y s 767 1246 m 20 -15 d s 743 1240 m 24 6 d s 811 1076 m 107 Y s
- 787 1177 m 24 6 d s 790 1199 m 21 -16 d s 786 1197 m 4 2 d s 811 1102 m 23 6 d
- s 814 1124 m 20 -16 d s 811 1123 m 3 1 d s 881 1147 m 41 Y s 858 1182 m 23 6 d
- s 858 1128 m 54 Y s 837 1197 m 21 -15 d s 837 1122 m 75 Y s 861 1203 m 20 -15 d
- s 837 1197 m 24 6 d s 905 1153 m 14 Y s 881 1161 m 24 6 d s 884 1182 m 21 -15 d
- s 882 1182 m 2 X s 928 1159 m 81 Y s 905 1234 m 23 6 d s 905 1167 m 67 Y s 884
- 1249 m 21 -15 d s 884 1182 m 67 Y s 908 1255 m 20 -15 d s 884 1249 m 24 6 d s
- 952 1165 m 14 Y s 928 1173 m 24 6 d s 931 1194 m 21 -15 d s 929 1193 m 2 1 d s
- 975 1117 m 27 Y s 973 1144 m 2 X s 973 1146 m 2 -2 d s 999 1110 m 107 Y s 975
- 1211 m 24 6 d s 975 1144 m 67 Y s 955 1227 m 20 -16 d s 955 1163 m 64 Y s 978
- 1233 m 21 -16 d s 955 1227 m 23 6 d s 1022 1143 m 54 Y s 999 1191 m 23 6 d s
- 1002 1212 m 20 -15 d s 999 1211 m 3 1 d s 1046 1149 m 80 Y s 1022 1223 m 24 6 d
- s 1022 1197 m 26 Y s 1002 1239 m 20 -16 d s 1002 1212 m 27 Y s 1025 1245 m 21
- -16 d s 1002 1239 m 23 6 d s 1069 1104 m 252 Y s 1046 1350 m 23 6 d s 1046 1229
- m 121 Y s 1025 1366 m 21 -16 d s 1025 1245 m 121 Y s 1049 1372 m 20 -16 d s
- 1025 1366 m 24 6 d s 1093 1147 m 135 Y s 1069 1276 m 24 6 d s 1072 1297 m 21
- -15 d s 1070 1297 m 2 X s 1096 1155 m 7 -5 d s 1091 1154 m 5 1 d s 1096 1236 m
- 20 -16 d s 1096 1155 m 81 Y s 1119 1242 m 21 -16 d s 1096 1236 m 23 6 d s 1163
- 1138 m 68 Y s 1161 1205 m 2 1 d s 1161 1208 m 2 -2 d s 1187 1144 m 94 Y s 1163
- 1232 m 24 6 d s 1163 1206 m 26 Y s 1143 1248 m 20 -16 d s 1143 1223 m 25 Y s
- 1166 1254 m 21 -16 d s 1143 1248 m 23 6 d s 1210 1150 m 135 Y s 1187 1279 m 23
- 6 d s 1187 1238 m 41 Y s 1166 1294 m 21 -15 d s 1166 1254 m 40 Y s 1190 1300 m
- 20 -15 d s 1166 1294 m 24 6 d s 1234 1197 m 228 Y s 1210 1419 m 24 6 d s 1210
- 1285 m 134 Y s 1190 1435 m 20 -16 d s 1190 1300 m 135 Y s 1213 1441 m 21 -16 d
- s 1190 1435 m 23 6 d s 1257 1203 m 40 Y s 1234 1237 m 23 6 d s 1237 1258 m 20
- -15 d s 1234 1258 m 3 X s 1257 1243 m 24 6 d s 1260 1264 m 21 -15 d s 1237 1258
- m 23 6 d s 1304 1268 m 27 Y s 1281 1289 m 23 6 d s 1281 1262 m 27 Y s 1260 1305
- m 21 -16 d s 1260 1264 m 41 Y s 1284 1311 m 20 -16 d s 1260 1305 m 24 6 d s
- 1328 1234 m 13 Y s 1325 1247 m 3 X s 1325 1249 m 3 -2 d s 1351 1240 m 121 Y s
- 1328 1355 m 23 6 d s 1328 1247 m 108 Y s 1307 1370 m 21 -15 d s 1307 1266 m 104
- Y s 1331 1376 m 20 -15 d s 1307 1370 m 24 6 d s 1374 1219 m 40 Y s 1351 1253 m
- 23 6 d s 1354 1275 m 20 -16 d s 1352 1274 m 2 1 d s 1398 1252 m 67 Y s 1374
- 1313 m 24 6 d s 1374 1259 m 54 Y s 1354 1329 m 20 -16 d s 1354 1275 m 54 Y s
- 1378 1335 m 20 -16 d s 1354 1329 m 24 6 d s 1421 1258 m 121 Y s 1398 1373 m 23
- 6 d s 1398 1319 m 54 Y s 1378 1388 m 20 -15 d s 1378 1335 m 53 Y s 1401 1394 m
- 20 -15 d s 1378 1388 m 23 6 d s 1445 1250 m 41 Y s 1421 1285 m 24 6 d s 1425
- 1306 m 20 -15 d s 1422 1306 m 3 X s 1468 1256 m 135 Y s 1445 1385 m 23 6 d s
- 1445 1291 m 94 Y s 1425 1400 m 20 -15 d s 1425 1306 m 94 Y s 1448 1406 m 20 -15
- d s 1425 1400 m 23 6 d s 1492 1222 m 134 Y s 1468 1350 m 24 6 d s 1472 1372 m
- 20 -16 d s 1469 1371 m 3 1 d s 1515 1295 m 94 Y s 1492 1383 m 23 6 d s 1492
- 1356 m 27 Y s 1472 1399 m 20 -16 d s 1472 1372 m 27 Y s 1495 1405 m 20 -16 d s
- 1472 1399 m 23 6 d s 1609 1319 m 54 Y s 1586 1367 m 23 6 d s 1566 1382 m 20 -15
- d s 1566 1362 m 20 Y s 1589 1388 m 20 -15 d s 1566 1382 m 23 6 d s 1656 1318 m
- 94 Y s 1633 1406 m 23 6 d s 1633 1312 m 94 Y s 1613 1421 m 20 -15 d s 1613 1317
- m 104 Y s 1636 1427 m 20 -15 d s 1613 1421 m 23 6 d s 1680 1297 m 148 Y s 1656
- 1439 m 24 6 d s 1656 1412 m 27 Y s 1636 1454 m 20 -15 d s 1636 1427 m 27 Y s
- 1660 1460 m 20 -15 d s 1636 1454 m 24 6 d s 1703 1303 m 94 Y s 1680 1391 m 23 6
- d s 1683 1412 m 20 -15 d s 1680 1412 m 3 X s 1744 1118 m 6 -5 d s 1753 1135 m
- 21 -16 d s 1744 1132 m 9 3 d s 1777 1141 m 20 -16 d s 1753 1135 m 24 6 d s 1753
- 1135 m 21 -16 d s 653 875 m 20 -15 d s 629 869 m 24 6 d s 629 869 m 20 -15 d s
- 676 881 m 20 -15 d s 653 875 m 23 6 d s 700 887 m 20 -15 d s 676 881 m 24 6 d s
- 723 893 m 20 -15 d s 700 887 m 23 6 d s 723 1122 m 20 -16 d s 723 893 m 229 Y s
- 723 1122 m 21 5 d s 790 1199 m 94 Y s 767 1287 m 23 6 d s 767 1246 m 41 Y s 747
- 1302 m 20 -15 d s 747 1241 m 61 Y s 770 1308 m 20 -15 d s 747 1302 m 23 6 d s
- 814 1124 m 67 Y s 804 1189 m 10 2 d s 794 1207 m 20 -16 d s 791 1206 m 3 1 d s
- 837 1197 m 94 Y s 814 1285 m 23 6 d s 814 1191 m 94 Y s 794 1301 m 20 -16 d s
- 794 1207 m 94 Y s 817 1307 m 20 -16 d s 794 1301 m 23 6 d s 861 1203 m 188 Y s
- 837 1385 m 24 6 d s 837 1291 m 94 Y s 817 1401 m 20 -16 d s 817 1307 m 94 Y s
- 841 1407 m 20 -16 d s 817 1401 m 24 6 d s 884 1249 m 162 Y s 861 1405 m 23 6 d
- s 861 1391 m 14 Y s 841 1420 m 20 -15 d s 841 1407 m 13 Y s 864 1426 m 20 -15 d
- s 841 1420 m 23 6 d s 908 1255 m 175 Y s 884 1424 m 24 6 d s 884 1411 m 13 Y s
- 864 1440 m 20 -16 d s 864 1426 m 14 Y s 888 1446 m 20 -16 d s 864 1440 m 24 6 d
- s 931 1194 m 14 Y s 929 1207 m 2 1 d s 929 1210 m 2 -2 d s 955 1227 m 94 Y s
- 931 1315 m 24 6 d s 931 1208 m 107 Y s 911 1331 m 20 -16 d s 911 1253 m 78 Y s
- 935 1337 m 20 -16 d s 911 1331 m 24 6 d s 978 1233 m 175 Y s 955 1402 m 23 6 d
- s 955 1321 m 81 Y s 935 1417 m 20 -15 d s 935 1337 m 80 Y s 958 1423 m 20 -15 d
- s 935 1417 m 23 6 d s 1002 1239 m 107 Y s 978 1340 m 24 6 d s 981 1362 m 21 -16
- d s 977 1361 m 4 1 d s 1025 1366 m 27 Y s 1002 1387 m 23 6 d s 1002 1346 m 41 Y
- s 981 1402 m 21 -15 d s 981 1362 m 40 Y s 1005 1408 m 20 -15 d s 981 1402 m 24
- 6 d s 1072 1297 m 27 Y s 1070 1323 m 2 1 d s 1070 1326 m 2 -2 d s 1096 1236 m
- 108 Y s 1072 1338 m 24 6 d s 1072 1324 m 14 Y s 1070 1339 m 2 -1 d s 1075 1359
- m 21 -15 d s 1069 1357 m 6 2 d s 1119 1242 m 121 Y s 1096 1357 m 23 6 d s 1096
- 1344 m 13 Y s 1075 1372 m 21 -15 d s 1075 1359 m 13 Y s 1099 1378 m 20 -15 d s
- 1075 1372 m 24 6 d s 1143 1248 m 94 Y s 1119 1336 m 24 6 d s 1122 1358 m 21 -16
- d s 1120 1357 m 2 1 d s 1166 1294 m 41 Y s 1143 1329 m 23 6 d s 1146 1350 m 20
- -15 d s 1136 1348 m 10 2 d s 1166 1388 m 24 6 d s 1166 1335 m 53 Y s 1146 1404
- m 20 -16 d s 1146 1350 m 54 Y s 1169 1410 m 21 -16 d s 1146 1404 m 23 6 d s
- 1169 1450 m 21 -15 d s 1169 1410 m 40 Y s 1193 1456 m 20 -15 d s 1169 1450 m 24
- 6 d s 1237 1258 m 135 Y s 1234 1392 m 3 1 d s 1234 1395 m 3 -2 d s 1237 1272 m
- 23 6 d s 1240 1293 m 20 -15 d s 1235 1292 m 5 1 d s 1284 1311 m 13 Y s 1260
- 1318 m 24 6 d s 1260 1305 m 13 Y s 1240 1334 m 20 -16 d s 1240 1293 m 41 Y s
- 1263 1340 m 21 -16 d s 1240 1334 m 23 6 d s 1284 1351 m 23 6 d s 1284 1324 m 27
- Y s 1263 1367 m 21 -16 d s 1263 1340 m 27 Y s 1287 1373 m 20 -16 d s 1263 1367
- m 24 6 d s 1331 1376 m 41 Y s 1307 1411 m 24 6 d s 1307 1370 m 41 Y s 1287 1426
- m 20 -15 d s 1287 1373 m 53 Y s 1310 1432 m 21 -15 d s 1287 1426 m 23 6 d s
- 1354 1329 m 107 Y s 1331 1430 m 23 6 d s 1331 1417 m 13 Y s 1310 1446 m 21 -16
- d s 1310 1432 m 14 Y s 1334 1452 m 20 -16 d s 1310 1446 m 24 6 d s 1378 1388 m
- 41 Y s 1354 1423 m 24 6 d s 1357 1444 m 21 -15 d s 1347 1442 m 10 2 d s 1401
- 1394 m 14 Y s 1378 1402 m 23 6 d s 1381 1423 m 20 -15 d s 1376 1422 m 5 1 d s
- 1422 1359 m 3 1 d s 1422 1362 m 3 -2 d s 1404 1402 m 21 -15 d s 1404 1392 m 10
- Y s 1428 1408 m 7 -5 d s 1404 1402 m 24 6 d s 1495 1405 m 40 Y s 1472 1439 m 23
- 6 d s 1472 1399 m 40 Y s 1451 1455 m 21 -16 d s 1451 1404 m 51 Y s 1475 1461 m
- 20 -16 d s 1451 1455 m 24 6 d s 1519 1296 m 115 Y s 1495 1405 m 24 6 d s 1498
- 1426 m 21 -15 d s 1496 1426 m 2 X s 1542 1343 m 114 Y s 1519 1451 m 23 6 d s
- 1519 1411 m 40 Y s 1498 1467 m 21 -16 d s 1498 1426 m 41 Y s 1522 1473 m 20 -16
- d s 1498 1467 m 24 6 d s 1566 1382 m 41 Y s 1542 1417 m 24 6 d s 1545 1438 m 21
- -15 d s 1543 1438 m 2 X s 1589 1388 m 68 Y s 1566 1450 m 23 6 d s 1566 1423 m
- 27 Y s 1545 1465 m 21 -15 d s 1545 1438 m 27 Y s 1569 1471 m 20 -15 d s 1545
- 1465 m 24 6 d s 1613 1421 m 54 Y s 1589 1469 m 24 6 d s 1589 1456 m 13 Y s 1569
- 1485 m 20 -16 d s 1569 1471 m 14 Y s 1592 1491 m 21 -16 d s 1569 1485 m 23 6 d
- s 1616 1429 m 7 -5 d s 1613 1429 m 3 X s 1616 1429 m 5 -3 d s 1616 1429 m s
- 1616 1429 m 18 5 d s 1683 1412 m 108 Y s 1660 1514 m 23 6 d s 1660 1460 m 54 Y
- s 1639 1529 m 21 -15 d s 1639 1455 m 74 Y s 1663 1535 m 20 -15 d s 1639 1529 m
- 24 6 d s 1743 1142 m 10 -7 d s 1757 1156 m 20 -15 d s 1744 1153 m 13 3 d s 1743
- 1142 m 10 -7 d s 632 891 m 21 -16 d s 609 885 m 23 6 d s 609 885 m 20 -16 d s
- 656 897 m 20 -16 d s 632 891 m 24 6 d s 679 903 m 21 -16 d s 656 897 m 23 6 d s
- 703 909 m 20 -16 d s 679 903 m 24 6 d s 747 1302 m 81 Y s 723 1377 m 24 6 d s
- 723 1122 m 255 Y s 703 1392 m 20 -15 d s 703 909 m 483 Y s 726 1398 m 21 -15 d
- s 703 1392 m 23 6 d s 770 1308 m 161 Y s 747 1463 m 23 6 d s 747 1383 m 80 Y s
- 726 1479 m 21 -16 d s 726 1398 m 81 Y s 750 1485 m 20 -16 d s 726 1479 m 24 6 d
- s 794 1301 m 40 Y s 770 1335 m 24 6 d s 773 1357 m 21 -16 d s 769 1355 m 4 2 d
- s 794 1381 m 23 6 d s 794 1341 m 40 Y s 773 1397 m 21 -16 d s 773 1357 m 40 Y s
- 797 1403 m 20 -16 d s 773 1397 m 24 6 d s 841 1420 m 27 Y s 817 1441 m 24 6 d s
- 817 1401 m 40 Y s 797 1457 m 20 -16 d s 797 1403 m 54 Y s 820 1463 m 21 -16 d s
- 797 1457 m 23 6 d s 864 1440 m 40 Y s 841 1474 m 23 6 d s 841 1447 m 27 Y s 820
- 1489 m 21 -15 d s 820 1463 m 26 Y s 844 1495 m 20 -15 d s 820 1489 m 24 6 d s
- 911 1331 m 134 Y s 888 1459 m 23 6 d s 888 1446 m 13 Y s 867 1475 m 21 -16 d s
- 867 1440 m 35 Y s 891 1481 m 20 -16 d s 867 1475 m 24 6 d s 935 1417 m 81 Y s
- 911 1492 m 24 6 d s 911 1465 m 27 Y s 891 1507 m 20 -15 d s 891 1481 m 26 Y s
- 914 1513 m 21 -15 d s 891 1507 m 23 6 d s 938 1425 m 7 -5 d s 935 1425 m 3 X s
- 1005 1408 m 94 Y s 981 1496 m 24 6 d s 981 1402 m 94 Y s 961 1512 m 20 -16 d s
- 961 1421 m 91 Y s 985 1518 m 20 -16 d s 961 1512 m 24 6 d s 1028 1367 m 101 Y s
- 1005 1462 m 23 6 d s 1008 1484 m 20 -16 d s 1006 1483 m 2 1 d s 1052 1370 m 238
- Y s 1028 1602 m 24 6 d s 1028 1468 m 134 Y s 1008 1618 m 20 -16 d s 1008 1484 m
- 134 Y s 1032 1624 m 20 -16 d s 1008 1618 m 24 6 d s 1075 1372 m 108 Y s 1052
- 1474 m 23 6 d s 1055 1495 m 20 -15 d s 1052 1495 m 3 X s 1099 1378 m 68 Y s
- 1075 1440 m 24 6 d s 1079 1461 m 20 -15 d s 1074 1460 m 5 1 d s 1122 1358 m 94
- Y s 1099 1446 m 23 6 d s 1102 1467 m 20 -15 d s 1079 1461 m 23 6 d s 1122 1358
- m 24 6 d s 1126 1379 m 20 -15 d s 1121 1378 m 5 1 d s 1169 1450 m 54 Y s 1146
- 1498 m 23 6 d s 1146 1404 m 94 Y s 1126 1513 m 20 -15 d s 1126 1379 m 134 Y s
- 1149 1519 m 20 -15 d s 1126 1513 m 23 6 d s 1173 1458 m 6 -5 d s 1168 1457 m 5
- 1 d s 1216 1439 m 77 Y s 1193 1510 m 23 6 d s 1193 1456 m 54 Y s 1173 1525 m 20
- -15 d s 1173 1458 m 67 Y s 1196 1531 m 20 -15 d s 1173 1525 m 23 6 d s 1240
- 1334 m 161 Y s 1216 1489 m 24 6 d s 1220 1510 m 20 -15 d s 1215 1509 m 5 1 d s
- 1263 1367 m 161 Y s 1240 1522 m 23 6 d s 1240 1495 m 27 Y s 1220 1537 m 20 -15
- d s 1220 1510 m 27 Y s 1243 1543 m 20 -15 d s 1220 1537 m 23 6 d s 1287 1426 m
- 108 Y s 1263 1528 m 24 6 d s 1266 1549 m 21 -15 d s 1243 1543 m 23 6 d s 1310
- 1446 m 148 Y s 1287 1588 m 23 6 d s 1287 1534 m 54 Y s 1266 1603 m 21 -15 d s
- 1266 1549 m 54 Y s 1290 1609 m 20 -15 d s 1266 1603 m 24 6 d s 1357 1444 m 67 Y
- s 1334 1505 m 23 6 d s 1334 1452 m 53 Y s 1313 1521 m 21 -16 d s 1313 1446 m 75
- Y s 1337 1527 m 20 -16 d s 1313 1521 m 24 6 d s 1381 1423 m 175 Y s 1357 1592 m
- 24 6 d s 1357 1511 m 81 Y s 1337 1608 m 20 -16 d s 1337 1527 m 81 Y s 1360 1614
- m 21 -16 d s 1337 1608 m 23 6 d s 1404 1402 m 121 Y s 1381 1517 m 23 6 d s 1384
- 1539 m 20 -16 d s 1382 1538 m 2 1 d s 1428 1408 m 94 Y s 1404 1496 m 24 6 d s
- 1407 1518 m 21 -16 d s 1405 1517 m 2 1 d s 1451 1455 m 94 Y s 1428 1543 m 23 6
- d s 1428 1502 m 41 Y s 1407 1558 m 21 -15 d s 1407 1518 m 40 Y s 1431 1564 m 20
- -15 d s 1407 1558 m 24 6 d s 1475 1461 m 228 Y s 1451 1683 m 24 6 d s 1451 1549
- m 134 Y s 1431 1699 m 20 -16 d s 1431 1564 m 135 Y s 1454 1705 m 21 -16 d s
- 1431 1699 m 23 6 d s 1498 1467 m 161 Y s 1475 1622 m 23 6 d s 1478 1643 m 20
- -15 d s 1473 1642 m 5 1 d s 1501 1475 m 8 -6 d s 1499 1474 m 2 1 d s 1545 1465
- m 188 Y s 1522 1647 m 23 6 d s 1522 1473 m 174 Y s 1501 1663 m 21 -16 d s 1501
- 1475 m 188 Y s 1525 1669 m 20 -16 d s 1501 1663 m 24 6 d s 1569 1485 m 295 Y s
- 1545 1774 m 24 6 d s 1545 1653 m 121 Y s 1525 1790 m 20 -16 d s 1525 1669 m 121
- Y s 1548 1796 m 21 -16 d s 1525 1790 m 23 6 d s 1592 1491 m 147 Y s 1569 1632 m
- 23 6 d s 1572 1654 m 20 -16 d s 1567 1653 m 5 1 d s 1616 1429 m 121 Y s 1592
- 1544 m 24 6 d s 1595 1566 m 21 -16 d s 1593 1565 m 2 1 d s 1639 1529 m 148 Y s
- 1616 1671 m 23 6 d s 1616 1550 m 121 Y s 1595 1687 m 21 -16 d s 1595 1566 m 121
- Y s 1619 1693 m 20 -16 d s 1595 1687 m 24 6 d s 1663 1535 m 229 Y s 1639 1758 m
- 24 6 d s 1639 1677 m 81 Y s 1619 1773 m 20 -15 d s 1619 1693 m 80 Y s 1642 1779
- m 21 -15 d s 1619 1773 m 23 6 d s 1744 1166 m 13 -10 d s 612 906 m 20 -15 d s
- 588 900 m 24 6 d s 588 900 m 21 -15 d s 635 912 m 21 -15 d s 612 906 m 23 6 d s
- 659 918 m 20 -15 d s 635 912 m 24 6 d s 635 912 m 11 -8 d s 682 924 m 21 -15 d
- s 659 918 m 23 6 d s 703 1460 m 23 6 d s 703 1392 m 68 Y s 682 1475 m 21 -15 d
- s 682 924 m 551 Y s 706 1481 m 20 -15 d s 682 1475 m 24 6 d s 750 1485 m 27 Y s
- 726 1506 m 24 6 d s 726 1479 m 27 Y s 706 1521 m 20 -15 d s 706 1481 m 40 Y s
- 729 1527 m 21 -15 d s 706 1521 m 23 6 d s 773 1397 m 215 Y s 750 1606 m 23 6 d
- s 750 1512 m 94 Y s 729 1621 m 21 -15 d s 729 1527 m 94 Y s 753 1627 m 20 -15 d
- s 729 1621 m 24 6 d s 797 1457 m 241 Y s 773 1692 m 24 6 d s 773 1612 m 80 Y s
- 753 1708 m 20 -16 d s 753 1627 m 81 Y s 776 1714 m 21 -16 d s 753 1708 m 23 6 d
- s 844 1495 m 41 Y s 820 1530 m 24 6 d s 820 1489 m 41 Y s 800 1545 m 20 -15 d s
- 800 1457 m 88 Y s 823 1551 m 21 -15 d s 800 1545 m 23 6 d s 867 1475 m 80 Y s
- 844 1549 m 23 6 d s 844 1536 m 13 Y s 823 1565 m 21 -16 d s 823 1551 m 14 Y s
- 847 1571 m 20 -16 d s 823 1565 m 24 6 d s 891 1507 m 68 Y s 867 1569 m 24 6 d s
- 867 1555 m 14 Y s 847 1584 m 20 -15 d s 847 1571 m 13 Y s 870 1590 m 21 -15 d s
- 847 1584 m 23 6 d s 914 1513 m 14 Y s 891 1521 m 23 6 d s 894 1542 m 20 -15 d s
- 891 1542 m 3 X s 938 1425 m 242 Y s 914 1661 m 24 6 d s 914 1527 m 134 Y s 894
- 1677 m 20 -16 d s 894 1542 m 135 Y s 917 1683 m 21 -16 d s 894 1677 m 23 6 d s
- 961 1512 m 94 Y s 938 1600 m 23 6 d s 941 1621 m 20 -15 d s 938 1621 m 3 X s
- 985 1518 m 121 Y s 961 1633 m 24 6 d s 961 1606 m 27 Y s 941 1648 m 20 -15 d s
- 941 1621 m 27 Y s 964 1654 m 21 -15 d s 941 1648 m 23 6 d s 1008 1618 m 107 Y s
- 985 1719 m 23 6 d s 985 1639 m 80 Y s 964 1735 m 21 -16 d s 964 1654 m 81 Y s
- 988 1741 m 20 -16 d s 964 1735 m 24 6 d s 1011 1626 m 7 -5 d s 1007 1625 m 4 1
- d s 1055 1495 m 296 Y s 1032 1785 m 23 6 d s 1032 1624 m 161 Y s 1011 1801 m 21
- -16 d s 1011 1626 m 175 Y s 1035 1807 m 20 -16 d s 1011 1801 m 24 6 d s 1079
- 1461 m 121 Y s 1055 1576 m 24 6 d s 1058 1598 m 21 -16 d s 1054 1596 m 4 2 d s
- 1102 1467 m 108 Y s 1079 1569 m 23 6 d s 1082 1590 m 20 -15 d s 1072 1588 m 10
- 2 d s 1126 1513 m 27 Y s 1102 1534 m 24 6 d s 1105 1556 m 21 -16 d s 1103 1555
- m 2 1 d s 1149 1519 m 94 Y s 1126 1607 m 23 6 d s 1126 1540 m 67 Y s 1105 1623
- m 21 -16 d s 1105 1556 m 67 Y s 1129 1629 m 20 -16 d s 1105 1623 m 24 6 d s
- 1173 1525 m 108 Y s 1149 1627 m 24 6 d s 1149 1613 m 14 Y s 1129 1642 m 20 -15
- d s 1129 1629 m 13 Y s 1152 1648 m 21 -15 d s 1129 1642 m 23 6 d s 1196 1531 m
- 68 Y s 1173 1593 m 23 6 d s 1176 1614 m 20 -15 d s 1173 1613 m 3 1 d s 1220
- 1537 m 309 Y s 1196 1840 m 24 6 d s 1196 1599 m 241 Y s 1176 1856 m 20 -16 d s
- 1176 1614 m 242 Y s 1199 1862 m 21 -16 d s 1176 1856 m 23 6 d s 1243 1597 m 23
- 6 d s 1243 1543 m 54 Y s 1223 1613 m 20 -16 d s 1223 1538 m 75 Y s 1246 1619 m
- 20 -16 d s 1223 1613 m 23 6 d s 1313 1521 m 94 Y s 1290 1609 m 23 6 d s 1270
- 1625 m 20 -16 d s 1270 1604 m 21 Y s 1293 1631 m 20 -16 d s 1270 1625 m 23 6 d
- s 1313 1548 m 24 6 d s 1317 1569 m 20 -15 d s 1312 1568 m 5 1 d s 1360 1614 m
- 161 Y s 1337 1769 m 23 6 d s 1337 1608 m 161 Y s 1317 1784 m 20 -15 d s 1317
- 1569 m 215 Y s 1340 1790 m 20 -15 d s 1317 1784 m 23 6 d s 1384 1539 m 161 Y s
- 1360 1694 m 24 6 d s 1364 1716 m 20 -16 d s 1359 1714 m 5 2 d s 1384 1552 m 23
- 6 d s 1387 1574 m 20 -16 d s 1384 1573 m 3 1 d s 1431 1699 m 13 Y s 1407 1706 m
- 24 6 d s 1407 1558 m 148 Y s 1387 1722 m 20 -16 d s 1387 1574 m 148 Y s 1411
- 1728 m 20 -16 d s 1387 1722 m 24 6 d s 1499 1582 m 2 X s 1499 1584 m 2 -2 d s
- 1481 1678 m 20 -15 d s 1481 1641 m 37 Y s 1505 1684 m 20 -15 d s 1481 1678 m 24
- 6 d s 1505 1711 m 20 -15 d s 1505 1684 m 27 Y s 1505 1711 m 21 6 d s 1572 1654
- m 134 Y s 1561 1785 m 11 3 d s 1528 1798 m 7 -6 d s 1528 1790 m 8 Y s 1552 1804
- m 20 -16 d s 1528 1798 m 24 6 d s 1572 1667 m 23 6 d s 1575 1689 m 20 -16 d s
- 1573 1688 m 2 1 d s 592 922 m 20 -16 d s 568 916 m 24 6 d s 568 916 m 20 -16 d
- s 615 928 m 20 -16 d s 592 922 m 23 6 d s 639 934 m 20 -16 d s 615 928 m 24 6 d
- s 625 920 m 10 -8 d s 662 940 m 20 -16 d s 639 934 m 23 6 d s 706 1521 m 94 Y s
- 682 1609 m 24 6 d s 682 1475 m 134 Y s 662 1625 m 20 -16 d s 662 940 m 685 Y s
- 686 1631 m 20 -16 d s 662 1625 m 24 6 d s 729 1635 m 24 6 d s 729 1621 m 14 Y s
- 709 1650 m 20 -15 d s 709 1523 m 127 Y s 733 1656 m 20 -15 d s 709 1650 m 24 6
- d s 797 1531 m 3 1 d s 797 1534 m 3 -2 d s 823 1565 m 53 Y s 800 1612 m 23 6 d
- s 800 1545 m 67 Y s 797 1614 m 3 -2 d s 803 1634 m 20 -16 d s 796 1632 m 7 2 d
- s 847 1584 m 108 Y s 823 1686 m 24 6 d s 823 1618 m 68 Y s 803 1701 m 20 -15 d
- s 803 1634 m 67 Y s 826 1707 m 21 -15 d s 803 1701 m 23 6 d s 870 1590 m 67 Y s
- 847 1651 m 23 6 d s 850 1673 m 20 -16 d s 845 1672 m 5 1 d s 891 1569 m 3 X s
- 891 1571 m 3 -2 d s 877 1586 m 15 4 d s 938 1634 m 3 1 d s 938 1637 m 3 -2 d s
- 939 1642 m 2 X s 1007 1683 m 4 -3 d s 1007 1699 m 5 2 d s 1058 1598 m 67 Y s
- 1054 1664 m 4 1 d s 1054 1668 m 4 -3 d s 1105 1623 m 282 Y s 1082 1899 m 23 6 d
- s 1082 1590 m 309 Y s 1061 1915 m 21 -16 d s 1061 1596 m 319 Y s 1085 1921 m 20
- -16 d s 1061 1915 m 24 6 d s 1108 1631 m 7 -5 d s 1104 1630 m 4 1 d s 1152 1648
- m 41 Y s 1129 1683 m 23 6 d s 1129 1642 m 41 Y s 1108 1698 m 21 -15 d s 1108
- 1631 m 67 Y s 1132 1704 m 20 -15 d s 1108 1698 m 24 6 d s 1152 1648 m 24 6 d s
- 1155 1670 m 21 -16 d s 1151 1669 m 4 1 d s 1155 1697 m 21 -16 d s 1155 1670 m
- 27 Y s 1155 1697 m 21 5 d s 1223 1613 m 174 Y s 1220 1787 m 3 X s 1220 1789 m 3
- -2 d s 1246 1619 m 201 Y s 1223 1814 m 23 6 d s 1223 1787 m 27 Y s 1220 1816 m
- 3 -2 d s 1226 1836 m 20 -16 d s 1221 1834 m 5 2 d s 1270 1625 m 174 Y s 1246
- 1793 m 24 6 d s 1249 1815 m 21 -16 d s 1245 1814 m 4 1 d s 1293 1631 m 201 Y s
- 1270 1826 m 23 6 d s 1270 1799 m 27 Y s 1249 1842 m 21 -16 d s 1249 1815 m 27 Y
- s 1273 1848 m 20 -16 d s 1249 1842 m 24 6 d s 1293 1751 m 24 6 d s 1296 1773 m
- 21 -16 d s 1294 1772 m 2 1 d s 1364 1716 m 13 Y s 1359 1728 m 5 1 d s 1359 1733
- m 5 -4 d s 1387 1722 m 67 Y s 1364 1783 m 23 6 d s 1364 1729 m 54 Y s 1343 1798
- m 21 -15 d s 1343 1788 m 10 Y s 1367 1804 m 20 -15 d s 1343 1798 m 24 6 d s
- 1411 1728 m 188 Y s 1387 1910 m 24 6 d s 1387 1789 m 121 Y s 1367 1925 m 20 -15
- d s 1367 1804 m 121 Y s 1390 1931 m 21 -15 d s 1367 1925 m 23 6 d s 1434 1699 m
- 156 Y s 1411 1849 m 23 6 d s 1414 1870 m 20 -15 d s 1411 1869 m 3 1 d s 1458
- 1701 m 200 Y s 1434 1895 m 24 6 d s 1434 1855 m 40 Y s 1414 1910 m 20 -15 d s
- 1414 1870 m 40 Y s 1437 1916 m 21 -15 d s 1414 1910 m 23 6 d s 1481 1678 m 175
- Y s 1458 1847 m 23 6 d s 1461 1869 m 20 -16 d s 1458 1868 m 3 1 d s 1528 1798 m
- 94 Y s 1505 1886 m 23 6 d s 1505 1711 m 175 Y s 1484 1901 m 21 -15 d s 1484
- 1679 m 222 Y s 1508 1907 m 20 -15 d s 1484 1901 m 24 6 d s 1552 1804 m 121 Y s
- 1528 1919 m 24 6 d s 1528 1892 m 27 Y s 1508 1934 m 20 -15 d s 1508 1907 m 27 Y
- s 1531 1940 m 21 -15 d s 1508 1934 m 23 6 d s 1575 1689 m 309 Y s 1552 1992 m
- 23 6 d s 1552 1925 m 67 Y s 1531 2007 m 21 -15 d s 1531 1940 m 67 Y s 1555 2013
- m 20 -15 d s 1531 2007 m 24 6 d s 1598 1687 m 35 Y s 1575 1716 m 23 6 d s 1578
- 1737 m 20 -15 d s 1576 1737 m 2 X s 1622 1774 m 169 Y s 1598 1937 m 24 6 d s
- 1598 1722 m 215 Y s 1578 1952 m 20 -15 d s 1578 1737 m 215 Y s 1602 1958 m 20
- -15 d s 1578 1952 m 24 6 d s 571 937 m 21 -15 d s 548 931 m 23 6 d s 548 931 m
- 20 -15 d s 595 943 m 20 -15 d s 571 937 m 24 6 d s 618 949 m 21 -15 d s 595 943
- m 23 6 d s 642 955 m 20 -15 d s 618 949 m 24 6 d s 642 1587 m 20 -16 d s 642
- 955 m 632 Y s 642 1587 m 21 5 d s 704 1595 m 5 2 d s 704 1601 m 5 -4 d s 733
- 1656 m 41 Y s 709 1691 m 24 6 d s 709 1650 m 41 Y s 689 1706 m 20 -15 d s 689
- 1627 m 79 Y s 712 1712 m 21 -15 d s 689 1706 m 23 6 d s 873 1588 m 37 Y s 871
- 1624 m 2 1 d s 871 1627 m 2 -2 d s 873 1652 m 19 5 d s 873 1625 m 27 Y s 871
- 1654 m 2 -2 d s 877 1673 m 15 -12 d s 857 1668 m 20 5 d s 944 1649 m 61 Y s 920
- 1704 m 24 6 d s 920 1681 m 23 Y s 900 1720 m 20 -16 d s 900 1678 m 42 Y s 924
- 1726 m 20 -16 d s 900 1720 m 24 6 d s 967 1736 m 7 Y s 944 1737 m 23 6 d s 944
- 1710 m 27 Y s 924 1753 m 20 -16 d s 924 1726 m 27 Y s 947 1759 m 20 -16 d s 924
- 1753 m 23 6 d s 971 1751 m 14 -11 d s 961 1749 m 10 2 d s 991 1776 m 21 5 d s
- 991 1739 m 37 Y s 971 1791 m 20 -15 d s 971 1751 m 40 Y s 994 1797 m 18 -13 d s
- 971 1791 m 23 6 d s 1018 1803 m 1 -1 d s 994 1797 m 24 6 d s 1054 1765 m 7 2 d
- s 1054 1773 m 7 -6 d s 1104 1670 m 4 1 d s 1103 1675 m 5 -4 d s 1132 1704 m 81
- Y s 1108 1779 m 24 6 d s 1108 1698 m 81 Y s 1103 1783 m 5 -4 d s 1112 1800 m 20
- -15 d s 1104 1798 m 8 2 d s 1151 1687 m 4 -4 d s 1158 1705 m 8 -6 d s 1138 1700
- m 20 5 d s 1158 1812 m 18 -13 d s 1158 1705 m 107 Y s 1158 1812 m 19 5 d s 1249
- 1842 m 121 Y s 1226 1957 m 23 6 d s 1226 1836 m 121 Y s 1205 1972 m 21 -15 d s
- 1205 1857 m 115 Y s 1229 1978 m 20 -15 d s 1205 1972 m 24 6 d s 1273 1848 m 121
- Y s 1249 1963 m 24 6 d s 1252 1984 m 21 -15 d s 1229 1978 m 23 6 d s 1320 1785
- m 128 Y s 1296 1907 m 24 6 d s 1296 1773 m 134 Y s 1276 1923 m 20 -16 d s 1276
- 1846 m 77 Y s 1299 1929 m 21 -16 d s 1276 1923 m 23 6 d s 1343 1798 m 81 Y s
- 1320 1873 m 23 6 d s 1323 1895 m 20 -16 d s 1320 1894 m 3 1 d s 1343 1852 m 24
- 6 d s 1346 1874 m 21 -16 d s 1342 1872 m 4 2 d s 1390 1931 m 188 Y s 1367 2113
- m 23 6 d s 1367 1925 m 188 Y s 1346 2129 m 21 -16 d s 1346 1874 m 255 Y s 1370
- 2135 m 20 -16 d s 1346 2129 m 24 6 d s 1412 1877 m 2 X s 1484 1901 m 148 Y s
- 1461 2043 m 23 6 d s 1461 1869 m 174 Y s 1440 2059 m 21 -16 d s 1440 1913 m 146
- Y s 1464 2065 m 20 -16 d s 1440 2059 m 24 6 d s 1508 1988 m 23 6 d s 1508 1934
- m 54 Y s 1487 2004 m 21 -16 d s 1487 1903 m 101 Y s 1511 2010 m 20 -16 d s 1487
- 2004 m 24 6 d s 551 953 m 20 -16 d s 527 947 m 24 6 d s 527 947 m 21 -16 d s
- 574 959 m 21 -16 d s 551 953 m 23 6 d s 598 965 m 20 -16 d s 574 959 m 24 6 d s
- 621 971 m 21 -16 d s 598 965 m 23 6 d s 621 1535 m 21 -15 d s 621 971 m 564 Y s
- 621 1535 m 22 6 d s 689 1706 m 94 Y s 665 1794 m 24 6 d s 665 1626 m 168 Y s
- 645 1810 m 20 -16 d s 645 1587 m 223 Y s 668 1816 m 21 -16 d s 645 1810 m 23 6
- d s 759 1710 m 81 Y s 736 1785 m 23 6 d s 736 1654 m 131 Y s 715 1801 m 21 -16
- d s 715 1710 m 91 Y s 739 1807 m 20 -16 d s 715 1801 m 24 6 d s 797 1640 m 7 1
- d s 796 1650 m 8 -6 d s 799 1648 m 5 1 d s 877 1673 m 14 Y s 853 1681 m 24 6 d
- s 853 1671 m 10 Y s 846 1687 m 7 -6 d s 856 1702 m 21 -15 d s 838 1698 m 18 4 d
- s 900 1720 m 13 Y s 877 1727 m 23 6 d s 877 1687 m 40 Y s 856 1743 m 21 -16 d s
- 856 1702 m 41 Y s 880 1749 m 20 -16 d s 856 1743 m 24 6 d s 971 1791 m 14 Y s
- 947 1799 m 24 6 d s 947 1759 m 40 Y s 927 1814 m 20 -15 d s 927 1754 m 60 Y s
- 950 1820 m 21 -15 d s 927 1814 m 23 6 d s 974 1813 m 20 -16 d s 974 1792 m 21 Y
- s 997 1819 m 21 -16 d s 974 1813 m 23 6 d s 1135 1702 m 131 Y s 1112 1827 m 23
- 6 d s 1112 1800 m 27 Y s 1104 1833 m 8 -6 d s 1115 1849 m 20 -16 d s 1104 1846
- m 11 3 d s 1158 1812 m 54 Y s 1135 1860 m 23 6 d s 1135 1833 m 27 Y s 1115 1876
- m 20 -16 d s 1115 1849 m 27 Y s 1138 1882 m 20 -16 d s 1115 1876 m 23 6 d s
- 1162 1834 m 15 -12 d s 1162 1813 m 21 Y s 1162 1834 m 14 3 d s 1420 1967 m 20
- -16 d s 1420 1912 m 55 Y s 1420 1967 m 21 5 d s 1576 1905 m 3 1 d s 1576 1910 m
- 3 -1 d s 531 968 m 20 -15 d s 507 962 m 24 6 d s 507 962 m 20 -15 d s 554 974 m
- 20 -15 d s 531 968 m 23 6 d s 578 980 m 20 -15 d s 554 974 m 24 6 d s 601 986 m
- 20 -15 d s 578 980 m 23 6 d s 621 1696 m 24 6 d s 621 1535 m 161 Y s 601 1712 m
- 20 -16 d s 601 986 m 726 Y s 625 1718 m 20 -16 d s 601 1712 m 24 6 d s 762 1710
- m 36 Y s 760 1745 m 2 1 d s 760 1748 m 2 -2 d s 786 1706 m 220 Y s 762 1920 m
- 24 6 d s 762 1746 m 174 Y s 742 1936 m 20 -16 d s 742 1805 m 131 Y s 765 1942 m
- 21 -16 d s 742 1936 m 23 6 d s 809 1702 m 177 Y s 786 1873 m 23 6 d s 789 1894
- m 20 -15 d s 787 1893 m 2 1 d s 833 1701 m 22 Y s 809 1717 m 24 6 d s 812 1739
- m 21 -16 d s 810 1738 m 2 1 d s 836 1705 m 7 -6 d s 836 1699 m 6 Y s 836 1705 m
- 21 5 d s 906 1736 m 14 -11 d s 900 1734 m 6 2 d s 1272 1856 m 3 -2 d s 1273
- 1869 m 2 1 d s 1329 2072 m 18 -14 d s 1329 1889 m 183 Y s 1329 2072 m 18 5 d s
- 510 984 m 21 -16 d s 487 978 m 23 6 d s 487 978 m 20 -16 d s 534 990 m 20 -16 d
- s 510 984 m 24 6 d s 557 996 m 21 -16 d s 534 990 m 23 6 d s 581 1002 m 20 -16
- d s 557 996 m 24 6 d s 625 1718 m 13 Y s 601 1725 m 24 6 d s 601 1712 m 13 Y s
- 581 1741 m 20 -16 d s 581 1002 m 739 Y s 604 1747 m 21 -16 d s 581 1741 m 23 6
- d s 695 1708 m 1 Y s 690 1708 m 5 1 d s 690 1713 m 5 -4 d s 839 1739 m 18 -13 d
- s 839 1705 m 34 Y s 863 1745 m 1 X s 839 1739 m 24 6 d s 910 1798 m 17 -14 d s
- 910 1732 m 66 Y s 910 1798 m 18 4 d s 490 999 m 20 -15 d s 466 993 m 24 6 d s
- 466 993 m 21 -15 d s 513 1005 m 21 -15 d s 490 999 m 23 6 d s 537 1011 m 20 -15
- d s 513 1005 m 24 6 d s 560 1017 m 21 -15 d s 537 1011 m 23 6 d s 560 1367 m 21
- -16 d s 560 1017 m 350 Y s 560 1367 m 21 5 d s 470 1015 m 20 -16 d s 446 1009 m
- 24 6 d s 446 1009 m 20 -16 d s 493 1021 m 20 -16 d s 470 1015 m 23 6 d s 517
- 1027 m 20 -16 d s 493 1021 m 24 6 d s 540 1033 m 20 -16 d s 517 1027 m 23 6 d s
- 540 1329 m 20 -16 d s 540 1033 m 296 Y s 540 1329 m 21 5 d s 564 1388 m 17 -13
- d s 564 1367 m 21 Y s 564 1388 m 16 4 d s 449 1031 m 21 -16 d s 426 1025 m 23 6
- d s 426 1025 m 20 -16 d s 473 1037 m 20 -16 d s 449 1031 m 24 6 d s 496 1043 m
- 21 -16 d s 473 1037 m 23 6 d s 520 1048 m 20 -15 d s 496 1043 m 24 5 d s 520
- 1290 m 20 -15 d s 520 1048 m 242 Y s 520 1290 m 21 6 d s 564 1469 m 16 4 d s
- 564 1388 m 81 Y s 543 1484 m 21 -15 d s 543 1329 m 155 Y s 567 1490 m 13 -10 d
- s 543 1484 m 24 6 d s 429 1046 m 20 -15 d s 405 1040 m 24 6 d s 405 1040 m 21
- -15 d s 452 1052 m 21 -15 d s 429 1046 m 23 6 d s 476 1058 m 20 -15 d s 452
- 1052 m 24 6 d s 499 1064 m 21 -16 d s 476 1058 m 23 6 d s 499 1212 m 21 -16 d s
- 499 1064 m 148 Y s 499 1212 m 19 5 d s 409 1062 m 20 -16 d s 385 1056 m 24 6 d
- s 385 1056 m 20 -16 d s 432 1068 m 20 -16 d s 409 1062 m 23 6 d s 456 1074 m 20
- -16 d s 432 1068 m 24 6 d s 479 1080 m 20 -16 d s 456 1074 m 23 6 d s 479 1227
- m 20 -15 d s 479 1080 m 147 Y s 502 1233 m 16 -12 d s 479 1227 m 23 6 d s 388
- 1077 m 21 -15 d s 365 1071 m 23 6 d s 365 1071 m 20 -15 d s 412 1083 m 20 -15 d
- s 388 1077 m 24 6 d s 435 1089 m 21 -15 d s 412 1083 m 23 6 d s 459 1095 m 20
- -15 d s 435 1089 m 24 6 d s 435 1089 m 7 -5 d s 446 1080 m 5 -3 d s 459 1189 m
- 20 -15 d s 459 1095 m 94 Y s 459 1189 m 21 5 d s 368 1093 m 20 -16 d s 344 1087
- m 24 6 d s 344 1087 m 21 -16 d s 391 1099 m 21 -16 d s 368 1093 m 23 6 d s 415
- 1105 m 20 -16 d s 391 1099 m 24 6 d s 438 1111 m 21 -16 d s 415 1105 m 23 6 d s
- 425 1097 m 10 -8 d s 438 1124 m 21 -15 d s 438 1111 m 13 Y s 438 1124 m 21 5 d
- s 462 1197 m 7 -5 d s 462 1190 m 7 Y s 462 1197 m 16 4 d s 348 1108 m 20 -15 d
- s 324 1102 m 24 6 d s 324 1102 m 20 -15 d s 371 1114 m 20 -15 d s 348 1108 m 23
- 6 d s 394 1120 m 21 -15 d s 371 1114 m 23 6 d s 418 1126 m 20 -15 d s 394 1120
- m 24 6 d s 438 1164 m 21 6 d s 438 1124 m 40 Y s 418 1180 m 20 -16 d s 418 1126
- m 54 Y s 441 1186 m 18 -14 d s 418 1180 m 23 6 d s 327 1124 m 21 -16 d s 304
- 1118 m 23 6 d s 304 1118 m 20 -16 d s 351 1130 m 20 -16 d s 327 1124 m 24 6 d s
- 374 1136 m 20 -16 d s 351 1130 m 23 6 d s 398 1142 m 20 -16 d s 374 1136 m 24 6
- d s 398 1142 m 18 4 d s 307 1139 m 20 -15 d s 283 1133 m 24 6 d s 283 1133 m 21
- -15 d s 330 1145 m 21 -15 d s 307 1139 m 23 6 d s 354 1151 m 20 -15 d s 330
- 1145 m 24 6 d s 377 1157 m 21 -15 d s 354 1151 m 23 6 d s 401 1163 m 16 -12 d s
- 377 1157 m 24 6 d s 401 1177 m 16 -12 d s 401 1163 m 14 Y s 424 1183 m 1 -1 d s
- 401 1177 m 23 6 d s 448 1189 m 11 -9 d s 448 1182 m 7 Y s 448 1189 m 14 3 d s
- 286 1155 m 21 -16 d s 263 1149 m 23 6 d s 263 1149 m 20 -16 d s 310 1161 m 20
- -16 d s 286 1155 m 24 6 d s 333 1167 m 21 -16 d s 310 1161 m 23 6 d s 357 1173
- m 20 -16 d s 333 1167 m 24 6 d s 380 1179 m 21 -16 d s 357 1173 m 23 6 d s 380
- 1192 m 21 -15 d s 380 1179 m 13 Y s 404 1198 m 20 -15 d s 380 1192 m 24 6 d s
- 427 1191 m 9 -7 d s 417 1188 m 10 3 d s 451 1197 m 7 -6 d s 427 1191 m 24 6 d s
- 474 1203 m 3 -2 d s 451 1197 m 23 6 d s 474 1203 m 5 1 d s 266 1170 m 20 -15 d
- s 243 1164 m 23 6 d s 243 1164 m 20 -15 d s 290 1176 m 20 -15 d s 266 1170 m 24
- 6 d s 313 1182 m 20 -15 d s 290 1176 m 23 6 d s 337 1188 m 20 -15 d s 313 1182
- m 24 6 d s 360 1194 m 20 -15 d s 337 1188 m 23 6 d s 384 1200 m 6 -5 d s 360
- 1194 m 24 6 d s 407 1206 m 20 -15 d s 384 1200 m 23 6 d s 431 1212 m 20 -15 d s
- 407 1206 m 24 6 d s 454 1218 m 20 -15 d s 431 1212 m 23 6 d s 478 1224 m 2 -2 d
- s 454 1218 m 24 6 d s 478 1224 m 2 1 d s 504 1231 m 15 4 d s 246 1186 m 20 -16
- d s 222 1180 m 24 6 d s 222 1180 m 21 -16 d s 269 1192 m 21 -16 d s 246 1186 m
- 23 6 d s 293 1198 m 20 -16 d s 269 1192 m 24 6 d s 316 1204 m 21 -16 d s 293
- 1198 m 23 6 d s 340 1210 m 20 -16 d s 316 1204 m 24 6 d s 363 1216 m 21 -16 d s
- 340 1210 m 23 6 d s 387 1222 m 20 -16 d s 363 1216 m 24 6 d s 410 1228 m 21 -16
- d s 387 1222 m 23 6 d s 434 1234 m 20 -16 d s 410 1228 m 24 6 d s 457 1240 m 21
- -16 d s 434 1234 m 23 6 d s 481 1246 m 17 -13 d s 457 1240 m 24 6 d s 504 1252
- m 15 -12 d s 481 1246 m 23 6 d s 504 1265 m 15 -12 d s 504 1252 m 13 Y s 504
- 1265 m 14 4 d s [4 8] 0 sd 222 1314 m 321 82 d s 222 1449 m 358 91 d s 222 1583
- m 358 91 d s 817 1734 m 93 24 d s 1051 1794 m 11 3 d s 1159 1821 m 2 1 d s 222
- 1717 m 519 132 d s 808 1867 m 398 101 d s 1257 1981 m 73 18 d s 222 1852 m 1128
- 287 d s 222 1986 m 1128 287 d s 222 2120 m 1128 287 d s [] 0 sd 1350 2130 m 331
- Y s 222 2174 m 1128 287 d s 222 1180 m 994 Y s [4 8] 0 sd 1705 1330 m 296 -226
- d s 1683 1481 m 318 -242 d s 1663 1631 m 338 -258 d s 1390 1974 m 29 -23 d s
- 1484 1902 m s 1623 1796 m 378 -289 d s 1350 2139 m 9 -7 d s 1390 2108 m 61 -47
- d s 1484 2036 m 47 -36 d s 1576 1966 m 14 -11 d s 1623 1930 m 378 -288 d s 1350
- 2273 m 651 -497 d s 1350 2407 m 651 -497 d s [] 0 sd 1784 1136 m 16 -13 d s
- 1892 1053 m 9 -7 d s 2001 970 m 994 Y s 1350 2461 m 651 -497 d s 222 1180 m 651
- -497 d s 873 683 m 994 Y s 222 2174 m 651 -497 d s 222 1180 m 994 Y s 873 683 m
- 1128 287 d s 2001 970 m 994 Y s 873 1677 m 1128 287 d s 873 1677 m cl s 873 683
- m 1128 287 d s 967 673 m 34 Y s 991 696 m 17 Y s 1014 702 m 17 Y s 1038 708 m
- 17 Y s 1061 714 m 17 Y s 1085 703 m 34 Y s 1108 726 m 17 Y s 1132 732 m 17 Y s
- 1155 738 m 17 Y s 1179 744 m 17 Y s 1202 733 m 34 Y s 1226 756 m 16 Y s 1249
- 762 m 16 Y s 1273 768 m 16 Y s 1296 774 m 16 Y s 1320 763 m 33 Y s 1343 786 m
- 16 Y s 1367 792 m 16 Y s 1390 798 m 16 Y s 1413 804 m 16 Y s 1437 793 m 33 Y s
- 1460 816 m 16 Y s 1484 822 m 16 Y s 1507 828 m 16 Y s 1531 834 m 16 Y s 1554
- 823 m 33 Y s 1578 846 m 16 Y s 1601 851 m 17 Y s 1625 857 m 17 Y s 1648 863 m
- 17 Y s 1672 853 m 33 Y s 1695 875 m 17 Y s 1719 881 m 17 Y s 1742 887 m 17 Y s
- 1766 893 m 17 Y s 1789 883 m 33 Y s 1813 905 m 17 Y s 1836 911 m 17 Y s 1860
- 917 m 17 Y s 1883 923 m 17 Y s 1907 913 m 33 Y s 967 673 m 34 Y s 944 684 m 17
- Y s 920 678 m 17 Y s 897 672 m 17 Y s 873 666 m 17 Y s 1907 913 m 33 Y s 1930
- 935 m 17 Y s 1954 941 m 17 Y s 1977 947 m 17 Y s 2001 953 m 17 Y s 970 654 m -5
- -1 d -3 -4 d -1 -8 d -4 Y 1 -8 d 3 -4 d 5 -2 d 3 X 4 2 d 3 4 d 1 8 d 4 Y -1 8 d
- -3 4 d -4 1 d -3 X cl s 1061 684 m -4 -1 d -3 -5 d -1 -7 d -4 Y 1 -8 d 3 -4 d 4
- -2 d 3 X 5 2 d 3 4 d 1 8 d 4 Y -1 7 d -3 5 d -5 1 d -3 X cl s 1085 656 m -1 -1
- d 1 -2 d 2 2 d -2 1 d cl s 1099 677 m 1 Y 1 3 d 1 2 d 3 1 d 6 X 3 -1 d 2 -2 d 1
- -3 d -3 Y -1 -2 d -3 -5 d -15 -15 d 21 X s 1144 684 m -14 X -2 -13 d 2 2 d 4 1
- d 5 X 4 -1 d 3 -3 d 1 -5 d -3 Y -1 -4 d -3 -3 d -4 -2 d -5 X -4 2 d -2 1 d -1 3
- d s 1190 714 m -5 -1 d -3 -5 d -1 -7 d -5 Y 1 -7 d 3 -4 d 5 -2 d 3 X 4 2 d 3 4
- d 2 7 d 5 Y -2 7 d -3 5 d -4 1 d -3 X cl s 1214 686 m -2 -1 d 2 -2 d 1 2 d -1 1
- d cl s 1243 714 m -15 X -1 -13 d 1 1 d 5 2 d 4 X 5 -2 d 3 -3 d 1 -4 d -3 Y -1
- -4 d -3 -3 d -5 -2 d -4 X -5 2 d -1 1 d -2 3 d s 1296 744 m -4 -1 d -3 -5 d -2
- -7 d -5 Y 2 -7 d 3 -4 d 4 -2 d 3 X 5 2 d 3 4 d 1 7 d 5 Y -1 7 d -3 5 d -5 1 d
- -3 X cl s 1320 716 m -1 -1 d 1 -2 d 2 2 d -2 1 d cl s 1353 744 m -15 -31 d s
- 1332 744 m 21 X s 1379 744 m -14 X -2 -13 d 2 1 d 4 2 d 4 X 5 -2 d 3 -3 d 1 -4
- d -3 Y -1 -5 d -3 -2 d -5 -2 d -4 X -4 2 d -2 1 d -1 3 d s 1435 768 m 3 2 d 4 4
- d -31 Y s 1527 798 m 3 2 d 4 4 d -31 Y s 1555 776 m -2 -2 d 2 -1 d 1 1 d -1 2 d
- cl s 1568 797 m 1 Y 2 3 d 1 1 d 3 2 d 6 X 3 -2 d 2 -1 d 1 -3 d -3 Y -1 -3 d -3
- -4 d -15 -15 d 21 X s 1614 804 m -15 X -1 -13 d 1 1 d 5 2 d 4 X 5 -2 d 3 -3 d 1
- -4 d -3 Y -1 -5 d -3 -3 d -5 -1 d -4 X -5 1 d -1 2 d -2 3 d s 1655 828 m 3 1 d
- 5 5 d -31 Y s 1683 806 m -1 -2 d 1 -1 d 2 1 d -2 2 d cl s 1713 834 m -15 X -1
- -13 d 1 1 d 5 1 d 4 X 5 -1 d 3 -3 d 1 -4 d -3 Y -1 -5 d -3 -3 d -5 -1 d -4 X -5
- 1 d -1 2 d -2 3 d s 1762 858 m 3 1 d 4 5 d -31 Y s 1790 836 m -2 -2 d 2 -1 d 1
- 1 d -1 2 d cl s 1822 864 m -14 -31 d s 1802 864 m 20 X s 1849 864 m -15 X -1
- -14 d 1 2 d 5 1 d 4 X 5 -1 d 3 -3 d 1 -5 d -2 Y -1 -5 d -3 -3 d -5 -1 d -4 X -5
- 1 d -1 2 d -2 3 d s 1902 886 m 2 Y 1 3 d 2 1 d 3 2 d 6 X 3 -2 d 1 -1 d 1 -3 d
- -3 Y -1 -3 d -3 -5 d -15 -14 d 21 X s 873 683 m -651 497 d s 873 649 m 34 Y s
- 857 679 m 16 Y s 841 691 m 17 Y s 824 703 m 17 Y s 808 716 m 17 Y s 792 712 m
- 33 Y s 776 741 m 16 Y s 759 753 m 17 Y s 743 766 m 16 Y s 727 778 m 17 Y s 711
- 774 m 33 Y s 694 803 m 17 Y s 678 815 m 17 Y s 662 828 m 16 Y s 645 840 m 17 Y
- s 629 836 m 33 Y s 613 865 m 17 Y s 597 877 m 17 Y s 580 890 m 17 Y s 564 902 m
- 17 Y s 548 898 m 33 Y s 532 927 m 17 Y s 515 940 m 16 Y s 499 952 m 17 Y s 483
- 964 m 17 Y s 466 960 m 33 Y s 450 989 m 17 Y s 434 1002 m 16 Y s 418 1014 m 17
- Y s 401 1027 m 16 Y s 385 1022 m 34 Y s 369 1051 m 17 Y s 352 1064 m 16 Y s 336
- 1076 m 17 Y s 320 1089 m 16 Y s 304 1084 m 34 Y s 287 1114 m 16 Y s 271 1126 m
- 17 Y s 255 1138 m 17 Y s 239 1151 m 16 Y s 222 1147 m 33 Y s 873 649 m 34 Y s
- 826 573 m 27 X s 865 583 m 2 Y 1 3 d 2 1 d 3 2 d 6 X 3 -2 d 1 -1 d 2 -3 d -3 Y
- -2 -3 d -3 -5 d -15 -15 d 21 X s 704 635 m 26 X s 745 647 m 3 1 d 5 5 d -31 Y s
- 773 625 m -1 -2 d 1 -1 d 2 1 d -2 2 d cl s 803 653 m -15 X -1 -14 d 1 2 d 5 1 d
- 4 X 5 -1 d 2 -3 d 2 -5 d -3 Y -2 -4 d -2 -3 d -5 -1 d -4 X -5 1 d -1 2 d -2 2 d
- s 663 697 m 27 X s 705 709 m 3 1 d 4 5 d -31 Y s 541 759 m 27 X s 587 777 m -5
- -2 d -2 -4 d -2 -7 d -5 Y 2 -7 d 2 -5 d 5 -1 d 3 X 4 1 d 3 5 d 2 7 d 5 Y -2 7 d
- -3 4 d -4 2 d -3 X cl s 611 749 m -2 -2 d 2 -1 d 1 1 d -1 2 d cl s 640 777 m
- -15 X -1 -13 d 1 1 d 5 2 d 4 X 5 -2 d 3 -3 d 1 -4 d -3 Y -1 -5 d -3 -3 d -5 -1
- d -4 X -5 1 d -1 2 d -2 3 d s 537 839 m -5 -1 d -3 -5 d -1 -7 d -5 Y 1 -7 d 3
- -5 d 5 -1 d 3 X 4 1 d 3 5 d 2 7 d 5 Y -2 7 d -3 5 d -4 1 d -3 X cl s 414 901 m
- -4 -1 d -3 -5 d -2 -7 d -5 Y 2 -7 d 3 -4 d 4 -2 d 3 X 5 2 d 3 4 d 1 7 d 5 Y -1
- 7 d -3 5 d -5 1 d -3 X cl s 438 873 m -1 -1 d 1 -2 d 2 2 d -2 1 d cl s 468 901
- m -15 X -2 -13 d 2 1 d 4 2 d 5 X 4 -2 d 3 -3 d 2 -4 d -3 Y -2 -4 d -3 -3 d -4
- -2 d -5 X -4 2 d -2 1 d -1 3 d s 370 957 m 3 2 d 4 4 d -31 Y s 247 1020 m 3 1 d
- 5 5 d -32 Y s 275 997 m -1 -1 d 1 -2 d 2 2 d -2 1 d cl s 305 1026 m -15 X -1
- -14 d 1 2 d 5 1 d 4 X 4 -1 d 3 -3 d 2 -5 d -3 Y -2 -4 d -3 -3 d -4 -2 d -4 X -5
- 2 d -1 1 d -2 3 d s 204 1080 m 2 Y 1 3 d 2 1 d 3 2 d 6 X 3 -2 d 1 -1 d 2 -3 d
- -3 Y -2 -3 d -3 -5 d -15 -14 d 21 X s 222 1180 m 994 Y s 189 1180 m 33 X s 206
- 1207 m 16 X s 206 1234 m 16 X s 206 1261 m 16 X s 206 1287 m 16 X s 189 1314 m
- 33 X s 206 1341 m 16 X s 206 1368 m 16 X s 206 1395 m 16 X s 206 1422 m 16 X s
- 189 1449 m 33 X s 206 1476 m 16 X s 206 1502 m 16 X s 206 1529 m 16 X s 206
- 1556 m 16 X s 189 1583 m 33 X s 206 1610 m 16 X s 206 1637 m 16 X s 206 1664 m
- 16 X s 206 1690 m 16 X s 189 1717 m 33 X s 206 1744 m 16 X s 206 1771 m 16 X s
- 206 1798 m 16 X s 206 1825 m 16 X s 189 1852 m 33 X s 206 1879 m 16 X s 206
- 1905 m 16 X s 206 1932 m 16 X s 206 1959 m 16 X s 189 1986 m 33 X s 206 2013 m
- 16 X s 206 2040 m 16 X s 206 2067 m 16 X s 206 2094 m 16 X s 189 2120 m 33 X s
- 189 2120 m 33 X s 206 2147 m 16 X s 150 1195 m -4 -1 d -3 -4 d -1 -8 d -4 Y 1
- -8 d 3 -4 d 4 -2 d 3 X 5 2 d 3 4 d 1 8 d 4 Y -1 8 d -3 4 d -5 1 d -3 X cl s 116
- 1324 m 3 1 d 5 5 d -31 Y s 150 1330 m -4 -2 d -3 -4 d -1 -7 d -5 Y 1 -7 d 3 -5
- d 4 -1 d 3 X 5 1 d 3 5 d 1 7 d 5 Y -1 7 d -3 4 d -5 2 d -3 X cl s 113 1457 m 1
- Y 2 3 d 1 2 d 3 1 d 6 X 3 -1 d 2 -2 d 1 -3 d -3 Y -1 -3 d -3 -4 d -15 -15 d 21
- X s 150 1464 m -4 -1 d -3 -5 d -1 -7 d -5 Y 1 -7 d 3 -4 d 4 -2 d 3 X 5 2 d 3 4
- d 1 7 d 5 Y -1 7 d -3 5 d -5 1 d -3 X cl s 115 1599 m 16 X -9 -12 d 5 X 3 -2 d
- 1 -1 d 2 -5 d -3 Y -2 -4 d -3 -3 d -4 -2 d -5 X -4 2 d -2 1 d -1 3 d s 150 1599
- m -4 -2 d -3 -4 d -1 -8 d -4 Y 1 -8 d 3 -4 d 4 -2 d 3 X 5 2 d 3 4 d 1 8 d 4 Y
- -1 8 d -3 4 d -5 2 d -3 X cl s 127 1733 m -15 -21 d 22 X s 127 1733 m -31 Y s
- 150 1733 m -4 -2 d -3 -4 d -1 -7 d -5 Y 1 -7 d 3 -5 d 4 -1 d 3 X 5 1 d 3 5 d 1
- 7 d 5 Y -1 7 d -3 4 d -5 2 d -3 X cl s 130 1867 m -15 X -2 -13 d 2 1 d 4 2 d 5
- X 4 -2 d 3 -3 d 2 -4 d -3 Y -2 -4 d -3 -3 d -4 -2 d -5 X -4 2 d -2 1 d -1 3 d s
- 150 1867 m -4 -1 d -3 -5 d -1 -7 d -4 Y 1 -8 d 3 -4 d 4 -2 d 3 X 5 2 d 3 4 d 1
- 8 d 4 Y -1 7 d -3 5 d -5 1 d -3 X cl s 131 1997 m -1 3 d -5 2 d -3 X -4 -2 d -3
- -4 d -2 -8 d -7 Y 2 -6 d 3 -3 d 4 -1 d 2 X 4 1 d 3 3 d 2 4 d 2 Y -2 4 d -3 3 d
- -4 2 d -2 X -4 -2 d -3 -3 d -2 -4 d s 150 2002 m -4 -2 d -3 -4 d -1 -8 d -4 Y 1
- -8 d 3 -4 d 4 -1 d 3 X 5 1 d 3 4 d 1 8 d 4 Y -1 8 d -3 4 d -5 2 d -3 X cl s 133
- 2136 m -15 -31 d s 112 2136 m 21 X s 150 2136 m -4 -1 d -3 -5 d -1 -7 d -5 Y 1
- -7 d 3 -5 d 4 -1 d 3 X 5 1 d 3 5 d 1 7 d 5 Y -1 7 d -3 5 d -5 1 d -3 X cl s
- 1040 539 m 9 -21 d s 1057 539 m -8 -21 d -3 -6 d -3 -3 d -3 -1 d -2 X s 1077
- 549 m 12 -31 d s 1100 549 m -11 -31 d s 1127 545 m -3 3 d -4 1 d -6 X -5 -1 d
- -3 -3 d -3 Y 2 -3 d 1 -1 d 3 -2 d 9 -3 d 3 -1 d 2 -2 d 1 -3 d -4 Y -3 -3 d -4
- -2 d -6 X -5 2 d -3 3 d s 1139 521 m -2 -1 d 2 -2 d 1 2 d -1 1 d cl s 1166 539
- m 16 -21 d s 1182 539 m -16 -21 d s gr
-showpage
- gr
-%%Trailer
-%%Pages: 1
- gr gr
-%%EOF
diff --git a/src/pawlib/paw/testsuite/paw.commands/nt_pl_2d_lego1.ref.ps b/src/pawlib/paw/testsuite/paw.commands/nt_pl_2d_lego1.ref.ps
deleted file mode 100644
index 7dcd06c..0000000
--- a/src/pawlib/paw/testsuite/paw.commands/nt_pl_2d_lego1.ref.ps
+++ /dev/null
@@ -1,4286 +0,0 @@
-%!PS-Adobe-2.0
-%%Title: /disk3/maartenb/cerncvs/paw/testsuite/tmp/nt_pl_2d_ (Portrait A 4)
-%%Pages: (atend)
-%%Creator: HIGZ Version 1.23/06
-%%CreationDate: 96/04/16 14.44
-%%EndComments
-%%BeginProlog
-/s {stroke} def /l {lineto} def /m {moveto} def /t {translate} def
-/sw {stringwidth} def /r {rotate} def /rl {roll} def /R {repeat} def
-/d {rlineto} def /rm {rmoveto} def /gr {grestore} def /f {eofill} def
-/c {setrgbcolor} def /lw {setlinewidth} def /sd {setdash} def
-/cl {closepath} def /sf {scalefont setfont} def /black {0 setgray} def
-/box {m dup 0 exch d exch 0 d 0 exch neg d cl} def
-/NC{systemdict begin initclip end}def/C{NC box clip newpath}def
-/bl {box s} def /bf {box f} def /Y { 0 exch d} def /X { 0 d} def
-/mp {newpath /y exch def /x exch def} def
-/side {[w .77 mul w .23 mul] .385 w mul sd w 0 l currentpoint t -144 r} def
-/mr {mp x y w2 0 360 arc} def /m24 {mr s} def /m20 {mr f} def
-/mb {mp x y w2 add m w2 neg 0 d 0 w neg d w 0 d 0 w d cl} def
-/mt {mp x y w2 add m w2 neg w neg d w 0 d cl} def
-/m21 {mb f} def /m25 {mb s} def /m22 {mt f} def /m26 {mt s} def
-/m23 {mp x y w2 sub m w2 w d w neg 0 d cl f} def
-/m27 {mp x y w2 add m w3 neg w2 neg d w3 w2 neg d w3 w2 d cl s} def
-/m28 {mp x w2 sub y w2 sub w3 add m w3 0 d 0 w3 neg d w3 0 d 0 w3 d w3 0 d
- 0 w3 d w3 neg 0 d 0 w3 d w3 neg 0 d
- 0 w3 neg d w3 neg 0 d cl s } def
-/m29 {mp gsave x w2 sub y w2 add w3 sub m currentpoint t
- 4 {side} repeat cl fill gr} def
-/m30 {mp gsave x w2 sub y w2 add w3 sub m currentpoint t
- 5 {side} repeat s gr} def
-/m31 {mp x y w2 sub m 0 w d x w2 sub y m w 0 d
- x w2 sub y w2 add m w w neg d x w2 sub y w2
- sub m w w d s} def
-/m2 {mp x y w2 sub m 0 w d x w2 sub y m w 0 d s} def
-/m5 {mp x w2 sub y w2 sub m w w d x w2 sub y w2 add m w w neg d s} def
-/DP {/PT exch def gsave 47.2 47.2 scale PT 1 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < AA AA 55 55 AA AA 55 55 AA AA 55 55 AA AA 55 55 AA AA 55 55 AA AA 55 55
-AA AA 55 55 AA AA 55 55 > } image } if PT 2 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < BB BB EE EE BB BB EE EE BB BB EE EE BB BB EE EE BB BB EE EE BB BB EE EE
-BB BB EE EE BB BB EE EE > } image } if PT 3 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < FF FF BB BB FF FF EE EE FF FF BB BB FF FF EE EE FF FF BB BB FF FF EE EE
-FF FF BB BB FF FF EE EE > } image } if PT 4 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < DF DF BF BF 7F 7F FE FE FD FD FB FB F7 F7 EF EF DF DF BF BF 7F 7F FE FE
-FD FD FB FB F7 F7 EF EF > } image } if PT 5 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < 7F 7F BF B F DF DF EF EF F7 F7 FB FB FD FD FE FE 7F 7F BF BF DF DF EF
-EF F7 F7 FB FB FD FD FE FE > } image } if PT 6 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB
-BB BB BB BB BB BB BB BB BB > } image } if PT 7 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < FF FF FF FF FF FF 00 00 FF FF FF FF FF FF 00 00 FF FF FF FF FF FF 00
-00 FF FF FF FF FF FF 00 00 > } image } if PT 8 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < EE EE 47 47 83 83 C5 C5 EE EE 5C 5C 38 38 74 74 EE EE 47 47 83 83 C5
-C5 EE EE 5C 5C 38 38 74 74 > } image } if PT 9 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < EF EF EF EF D7 D7 38 38 FE FE FE FE 7D 7D 83 83 EF EF EF EF D7 D7 38
-38 FE FE FE FE 7D 7D 83 83 > } image } if PT 10 eq { 16 16 1 [ 16 0 0 16 neg
-0 16 ] { < EF EF EF EF EF EF 00 00 FE FE FE FE FE FE 00 00 EF EF EF EF EF EF
-00 00 FE FE FE FE FE FE 00 00 > } image } if PT 11 eq { 16 16 1 [ 16 0 0 16
-neg 0 16 ] { < F7 F7 B6 B6 D5 D5 E3 E3 D5 D5 B6 B6 F7 F7 FF FF 7F 7F 6B 6B 5D
-5D 3E 3E 5D 5D 6B 6B 7F 7F FF FF > } image } if PT 12 eq { 16 16 1 [ 16 0 0
-16 neg 0 16 ] { < E3 E3 DD DD BE BE BE BE BE BE DD DD E3 E3 FF FF 3E 3E DD DD
-EB EB EB EB EB EB DD DD 3E 3E FF FF > } image } if PT 13 eq { 16 16 1 [ 16 0
-0 16 neg 0 16 ] { < FE FE 7D 7D BB BB D7 D7 EF EF D7 D7 BB BB 7D 7D FE FE 7D
-7D BB BB D7 D7 EF EF D7 D7 BB BB 7D 7D > } image } if PT 14 eq { 16 16 1 [ 16
-0 0 16 neg 0 16 ] { < 00 00 EE EF EE EF EE EF 0E E0 EE EE EE EE EE EE 00 EE
-FE EE FE EE FE EE 00 00 FE EF FE EF FE EF > } image } if PT 15 eq { 16 16 1 [
-16 0 0 16 neg 0 16 ] { < DD DD AA AA DD DD FF FF 77 77 AA AA 77 77 FF FF DD
-DD AA AA DD DD FF FF 77 77 AA AA 77 77 FF FF > } image } if PT 16 eq { 16 16
-1 [ 16 0 0 16 neg 0 16 ] { < F1 F1 EE EE 1F 1F FF FF F1 F1 EE EE 1F 1F FF FF
-F1 F1 EE EE 1F 1F FF FF F1 F1 EE EE 1F 1F FF FF > } image } if PT 17 eq { 16
-16 1 [ 16 0 0 16 neg 0 16 ] { < EE EE DD DD BB BB FF FF EE EE DD DD BB BB FF
- FF EE EE DD DD BB BB FF FF EE EE DD DD BB BB FF FF > } image } if PT 18 eq {
-16 16 1 [ 16 0 0 16 neg 0 16 ] { < BB BB DD DD EE EE FF FF BB BB DD DD EE EE
-FF FF BB BB DD DD EE EE FF FF BB BB DD DD EE EE FF FF > } image } if PT 19 eq
-{ 16 16 1 [ 16 0 0 16 neg 0 16 ] { < 1F FC 67 F3 7B EF BD DE BD DE DE BD E6
-B3 F8 0F E6 B3 DE BD BD DE BD DE 7B EF 67 F3 1F FC 7F FF > } image } if PT
-20 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < DD DD EE EE EE EE EE EE DD DD BB
-BB BB BB BB BB DD DD EE EE EE EE EE EE DD DD BB BB BB BB BB BB > } image }
-if PT 21 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < 0E 0E EF EF EF EF EF EF E0
-E0 FE FE FE FE FE FE 0E 0E EF EF EF EF EF EF E0 E0 FE FE FE FE FE FE > }
-image } if PT 22 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < 70 70 F7 F7 F7 F7 F7
-F7 07 07 7F 7F 7F 7F 7F 7F 70 70 F7 F7 F7 F7 F7 F7 07 07 7F 7F 7F 7F 7F 7F >
-} image } if PT 23 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < AA AA 55 55 A9 A9
-D1 D1 E1 E1 D1 D1 A9 A9 55 55 AA AA 55 55 A9 A9 D1 D1 E1 E1 D1 D1 A9 A9 55 55
-> } image } if PT 24 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < FF FE FF FC EA
-A8 D5 54 EA A8 D5 54 E8 28 D4 54 E8 E8 D4 D4 E8 EA 54 D5 A8 EA 54 D5 00 C0 00
-80 > } image } if PT 25 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < FF FE FF FC
-FF F8 FF F0 F0 00 F0 00 F0 20 F0 60 F0 E0 F1 E0 F3 E0 F0 00 E0 00 C0 00 80 00
-00 00 > } image } if gr } def /FA { /PT exch def gsave clip 0 0 translate 1 1
-54 { 1 sub 47.2 mul /Xcurr exch def 1 1 74 { 1 sub 47.2 mul /Ycurr exch def
-gsave Xcurr Ycurr translate PT DP gr } for } for gr } def
-/reencdict 24 dict def /ReEncode {reencdict begin /nco&na exch def
-/nfnam exch def /basefontname exch def /basefontdict basefontname findfont def
-/newfont basefontdict maxlength dict def basefontdict {exch dup /FID ne
-{dup /Encoding eq {exch dup length array copy newfont 3 1 roll put} {exch
-newfont 3 1 roll put} ifelse} {pop pop} ifelse } forall newfont
-/FontName nfnam put nco&na aload pop nco&na length 2 idiv {newfont
-/Encoding get 3 1 roll put} repeat nfnam newfont definefont pop end } def
-/accvec [ 176 /agrave 181 /Agrave 190 /acircumflex 192 /Acircumflex
-201 /adieresis 204 /Adieresis 209 /ccedilla 210 /Ccedilla 211 /eacute
-212 /Eacute 213 /egrave 214 /Egrave 215 /ecircumflex 216 /Ecircumflex
-217 /edieresis 218 /Edieresis 219 /icircumflex 220 /Icircumflex
-221 /idieresis 222 /Idieresis 223 /ntilde 224 /Ntilde 226 /ocircumflex
-228 /Ocircumflex 229 /odieresis 230 /Odieresis 231 /ucircumflex 236 /Ucircumflex
-237 /udieresis 238 /Udieresis 239 /aring 242 /Aring 243 /ydieresis
-244 /Ydieresis 246 /aacute 247 /Aacute 252 /ugrave 253 /Ugrave] def
-/Times-Roman /Times-Roman accvec ReEncode
-/Times-Italic /Times-Italic accvec ReEncode
-/Times-Bold /Times-Bold accvec ReEncode
-/Times-BoldItalic /Times-BoldItalic accvec ReEncode
-/Helvetica /Helvetica accvec ReEncode
-/Helvetica-Oblique /Helvetica-Oblique accvec ReEncode
-/Helvetica-Bold /Helvetica-Bold accvec ReEncode
-/Helvetica-BoldOblique /Helvetica-BoldOblique accvec ReEncode
-/Courier /Courier accvec ReEncode
-/Courier-Oblique /Courier-Oblique accvec ReEncode
-/Courier-Bold /Courier-Bold accvec ReEncode
-/Courier-BoldOblique /Courier-BoldOblique accvec ReEncode
-/oshow {gsave [] 0 sd true charpath stroke gr} def
-/stwn { /fs exch def /fn exch def /text exch def fn findfont fs sf
- text sw pop xs add /xs exch def} def
-/stwb { /fs exch def /fn exch def /nbas exch def /textf exch def
-textf length /tlen exch def nbas tlen gt {/nbas tlen def} if
-fn findfont fs sf textf dup length nbas sub nbas getinterval sw
-pop neg xs add /xs exch def} def
-/accspe [ 65 /plusminus 66 /bar 67 /existential 68 /universal
-69 /exclam 70 /numbersign 71 /greater 72 /question 73 /integral
-74 /colon 75 /semicolon 76 /less 77 /bracketleft 78 /bracketright
-79 /greaterequal 80 /braceleft 81 /braceright 82 /radical
-83 /spade 84 /heart 85 /diamond 86 /club 87 /lessequal
-88 /multiply 89 /percent 90 /infinity 48 /circlemultiply 49 /circleplus
-50 /emptyset 51 /lozenge 52 /bullet 53 /arrowright 54 /arrowup
-55 /arrowleft 56 /arrowdown 57 /arrowboth 48 /degree 44 /comma 43 /plus
- 45 /angle 42 /angleleft 47 /divide 61 /notequal 40 /equivalence 41 /second
- 97 /approxequal 98 /congruent 99 /perpendicular 100 /partialdiff 101 /florin
- 102 /intersection 103 /union 104 /propersuperset 105 /reflexsuperset
- 106 /notsubset 107 /propersubset 108 /reflexsubset 109 /element 110 /notelement
- 111 /gradient 112 /logicaland 113 /logicalor 114 /arrowdblboth
- 115 /arrowdblleft 116 /arrowdblup 117 /arrowdblright 118 /arrowdbldown
- 119 /ampersand 120 /omega1 121 /similar 122 /aleph ] def
-/Symbol /Special accspe ReEncode
-/Zone {/iy exch def /ix exch def ix 1 sub 2224 mul 1 iy sub 3144
- mul t} def
-%%EndProlog
- gsave 20 28 t .25 .25 scale gsave
-%%Page: number 1
- gsave
- 1 1 Zone
- gsave 0 0 t black [] 0 sd 1 lw 2223 2224 0 460 bl 2223 2224 0 460 C 1779 1778
- 222 683 C NC [4 8] 0 sd 222 1314 m 1128 287 d s 222 1449 m 1128 287 d s 222
- 1583 m 1128 287 d s 222 1717 m 1128 287 d s 222 1852 m 1128 287 d s 222 1986 m
- 1128 287 d s 222 2120 m 1128 287 d s [] 0 sd 222 1180 m 1128 287 d s 1350 1467
- m 994 Y s 222 2174 m 1128 287 d s 222 1180 m 994 Y s [4 8] 0 sd 1350 1601 m 651
- -497 d s 1350 1736 m 651 -497 d s 1350 1870 m 651 -497 d s 1350 2004 m 651 -497
- d s 1350 2139 m 651 -497 d s 1350 2273 m 651 -497 d s 1350 2407 m 651 -497 d s
- [] 0 sd 1350 1467 m 651 -497 d s 2001 970 m 994 Y s 1350 2461 m 651 -497 d s
- 1350 1467 m cl s 1 1 1 c 1347 1445 m 23 6 d -20 16 d -24 -6 d f black 1347 1445
- m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1323 1439 m 24 6 d -21 16 d -23 -6 d f
- black 1323 1439 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 1300 1433 m 23 6 d -20
- 16 d -24 -6 d f black 1300 1433 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1276
- 1427 m 24 6 d -21 16 d -23 -6 d f black 1276 1427 m 24 6 d -21 16 d -23 -6 d
- cl s 1 1 1 c 1253 1422 m 23 5 d -20 16 d -24 -6 d f black 1253 1422 m 23 5 d
- -20 16 d -24 -6 d cl s 1 1 1 c 1229 1416 m 24 6 d -21 15 d -23 -6 d f black
- 1229 1416 m 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 1206 1410 m 23 6 d -20 15 d
- -24 -6 d f black 1206 1410 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1182 1404 m
- 24 6 d -21 15 d -23 -6 d f black 1182 1404 m 24 6 d -21 15 d -23 -6 d cl s 1 1
- 1 c 1159 1398 m 23 6 d -20 15 d -24 -6 d f black 1159 1398 m 23 6 d -20 15 d
- -24 -6 d cl s 1 1 1 c 1135 1392 m 24 6 d -21 15 d -23 -6 d f black 1135 1392 m
- 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 1112 1386 m 23 6 d -20 15 d -24 -6 d f
- black 1112 1386 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1088 1380 m 24 6 d -21
- 15 d -23 -6 d f black 1088 1380 m 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 1065
- 1374 m 23 6 d -20 15 d -24 -6 d f black 1065 1374 m 23 6 d -20 15 d -24 -6 d
- cl s 1 1 1 c 1041 1368 m 24 6 d -21 15 d -23 -6 d f black 1041 1368 m 24 6 d
- -21 15 d -23 -6 d cl s 1 1 1 c 1018 1362 m 23 6 d -20 15 d -24 -6 d f black
- 1018 1362 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 994 1356 m 24 6 d -21 15 d
- -23 -6 d f black 994 1356 m 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 971 1350 m 23
- 6 d -20 15 d -24 -6 d f black 971 1350 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c
- 947 1344 m 24 6 d -21 15 d -23 -6 d f black 947 1344 m 24 6 d -21 15 d -23 -6 d
- cl s 1 1 1 c 924 1338 m 23 6 d -20 15 d -24 -6 d f black 924 1338 m 23 6 d -20
- 15 d -24 -6 d cl s 1 1 1 c 900 1332 m 24 6 d -21 15 d -23 -6 d f black 900 1332
- m 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 877 1326 m 23 6 d -20 15 d -23 -6 d f
- black 877 1326 m 23 6 d -20 15 d -23 -6 d cl s 1 1 1 c 853 1320 m 24 6 d -20 15
- d -24 -6 d f black 853 1320 m 24 6 d -20 15 d -24 -6 d cl s 1 1 1 c 830 1314 m
- 23 6 d -20 15 d -23 -6 d f black 830 1314 m 23 6 d -20 15 d -23 -6 d cl s 1 1 1
- c 806 1308 m 24 6 d -20 15 d -24 -6 d f black 806 1308 m 24 6 d -20 15 d -24 -6
- d cl s 1 1 1 c 783 1302 m 23 6 d -20 15 d -23 -6 d f black 783 1302 m 23 6 d
- -20 15 d -23 -6 d cl s 1 1 1 c 759 1296 m 24 6 d -20 15 d -24 -6 d f black 759
- 1296 m 24 6 d -20 15 d -24 -6 d cl s 1 1 1 c 736 1290 m 23 6 d -20 15 d -23 -6
- d f black 736 1290 m 23 6 d -20 15 d -23 -6 d cl s 1 1 1 c 712 1284 m 24 6 d
- -20 15 d -24 -5 d f black 712 1284 m 24 6 d -20 15 d -24 -5 d cl s 1 1 1 c 689
- 1278 m 23 6 d -20 16 d -23 -6 d f black 689 1278 m 23 6 d -20 16 d -23 -6 d
- cl s 1 1 1 c 665 1272 m 24 6 d -20 16 d -24 -6 d f black 665 1272 m 24 6 d -20
- 16 d -24 -6 d cl s 1 1 1 c 642 1266 m 23 6 d -20 16 d -23 -6 d f black 642 1266
- m 23 6 d -20 16 d -23 -6 d cl s 1 1 1 c 618 1260 m 24 6 d -20 16 d -24 -6 d f
- black 618 1260 m 24 6 d -20 16 d -24 -6 d cl s 1 1 1 c 595 1254 m 23 6 d -20 16
- d -23 -6 d f black 595 1254 m 23 6 d -20 16 d -23 -6 d cl s 1 1 1 c 571 1248 m
- 24 6 d -20 16 d -24 -6 d f black 571 1248 m 24 6 d -20 16 d -24 -6 d cl s 1 1 1
- c 548 1242 m 23 6 d -20 16 d -23 -6 d f black 548 1242 m 23 6 d -20 16 d -23 -6
- d cl s 1 1 1 c 525 1236 m 23 6 d 14 Y -23 -6 d f black 525 1236 m 23 6 d 14 Y
- -23 -6 d cl s 0.6 0.6 0.6 c 504 1252 m 21 -16 d 14 Y -21 15 d f black 504 1252
- m 21 -16 d 14 Y -21 15 d cl s 1 1 1 c 525 1250 m 23 6 d -20 15 d -24 -6 d f
- black 525 1250 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 501 1230 m 24 6 d -21 16
- d -23 -6 d f black 501 1230 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 478 1224 m
- 23 6 d -20 16 d -24 -6 d f black 478 1224 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1
- c 454 1218 m 24 6 d -21 16 d -23 -6 d f black 454 1218 m 24 6 d -21 16 d -23 -6
- d cl s 1 1 1 c 431 1212 m 23 6 d -20 16 d -24 -6 d f black 431 1212 m 23 6 d
- -20 16 d -24 -6 d cl s 1 1 1 c 407 1206 m 24 6 d -21 16 d -23 -6 d f black 407
- 1206 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 384 1200 m 23 6 d -20 16 d -24 -6
- d f black 384 1200 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 360 1194 m 24 6 d
- -21 16 d -23 -6 d f black 360 1194 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 337
- 1188 m 23 6 d -20 16 d -24 -6 d f black 337 1188 m 23 6 d -20 16 d -24 -6 d
- cl s 1 1 1 c 313 1182 m 24 6 d -21 16 d -23 -6 d f black 313 1182 m 24 6 d -21
- 16 d -23 -6 d cl s 1 1 1 c 290 1176 m 23 6 d -20 16 d -24 -6 d f black 290 1176
- m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 266 1170 m 24 6 d -21 16 d -23 -6 d f
- black 266 1170 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 243 1164 m 23 6 d -20 16
- d -24 -6 d f black 243 1164 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1367 1430 m
- 23 6 d -20 15 d -23 -6 d f black 1367 1430 m 23 6 d -20 15 d -23 -6 d cl s 1 1
- 1 c 1343 1424 m 24 6 d -20 15 d -24 -6 d f black 1343 1424 m 24 6 d -20 15 d
- -24 -6 d cl s 1 1 1 c 1320 1418 m 23 6 d -20 15 d -23 -6 d f black 1320 1418 m
- 23 6 d -20 15 d -23 -6 d cl s 1 1 1 c 1297 1412 m 23 6 d -20 15 d -24 -6 d f
- black 1297 1412 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1273 1406 m 24 6 d -21
- 15 d -23 -5 d f black 1273 1406 m 24 6 d -21 15 d -23 -5 d cl s 1 1 1 c 1250
- 1400 m 23 6 d -20 16 d -24 -6 d f black 1250 1400 m 23 6 d -20 16 d -24 -6 d
- cl s 1 1 1 c 1226 1394 m 24 6 d -21 16 d -23 -6 d f black 1226 1394 m 24 6 d
- -21 16 d -23 -6 d cl s 1 1 1 c 1203 1388 m 23 6 d -20 16 d -24 -6 d f black
- 1203 1388 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1179 1382 m 24 6 d -21 16 d
- -23 -6 d f black 1179 1382 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 1156 1376 m
- 23 6 d -20 16 d -24 -6 d f black 1156 1376 m 23 6 d -20 16 d -24 -6 d cl s 1 1
- 1 c 1132 1370 m 24 6 d -21 16 d -23 -6 d f black 1132 1370 m 24 6 d -21 16 d
- -23 -6 d cl s 1 1 1 c 1109 1364 m 23 6 d -20 16 d -24 -6 d f black 1109 1364 m
- 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1085 1358 m 24 6 d -21 16 d -23 -6 d f
- black 1085 1358 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 1062 1352 m 23 6 d -20
- 16 d -24 -6 d f black 1062 1352 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1038
- 1346 m 24 6 d -21 16 d -23 -6 d f black 1038 1346 m 24 6 d -21 16 d -23 -6 d
- cl s 1 1 1 c 1015 1340 m 23 6 d -20 16 d -24 -6 d f black 1015 1340 m 23 6 d
- -20 16 d -24 -6 d cl s 1 1 1 c 991 1334 m 24 6 d -21 16 d -23 -6 d f black 991
- 1334 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 968 1328 m 23 6 d -20 16 d -24 -6
- d f black 968 1328 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 944 1322 m 24 6 d
- -21 16 d -23 -6 d f black 944 1322 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 921
- 1316 m 23 6 d -20 16 d -24 -6 d f black 921 1316 m 23 6 d -20 16 d -24 -6 d
- cl s 1 1 1 c 897 1310 m 24 6 d -21 16 d -23 -6 d f black 897 1310 m 24 6 d -21
- 16 d -23 -6 d cl s 1 1 1 c 874 1304 m 23 6 d -20 16 d -24 -6 d f black 874 1304
- m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 850 1298 m 24 6 d -21 16 d -23 -6 d f
- black 850 1298 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 827 1292 m 23 6 d -20 16
- d -24 -6 d f black 827 1292 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 803 1286 m
- 24 6 d -21 16 d -23 -6 d f black 803 1286 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1
- c 780 1280 m 23 6 d -20 16 d -24 -6 d f black 780 1280 m 23 6 d -20 16 d -24 -6
- d cl s 1 1 1 c 756 1274 m 24 6 d -21 16 d -23 -6 d f black 756 1274 m 24 6 d
- -21 16 d -23 -6 d cl s 1 1 1 c 733 1268 m 23 6 d -20 16 d -24 -6 d f black 733
- 1268 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 709 1262 m 24 6 d -21 16 d -23 -6
- d f black 709 1262 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 686 1256 m 23 6 d
- -20 16 d -24 -6 d f black 686 1256 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 662
- 1251 m 24 5 d -21 16 d -23 -6 d f black 662 1251 m 24 5 d -21 16 d -23 -6 d
- cl s 1 1 1 c 639 1245 m 23 6 d -20 15 d -24 -6 d f black 639 1245 m 23 6 d -20
- 15 d -24 -6 d cl s 1 1 1 c 615 1239 m 24 6 d -21 15 d -23 -6 d f black 615 1239
- m 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 592 1233 m 23 6 d 13 Y -23 -6 d f black
- 592 1233 m 23 6 d 13 Y -23 -6 d cl s 0.6 0.6 0.6 c 571 1248 m 21 -15 d 13 Y -21
- 16 d f black 571 1248 m 21 -15 d 13 Y -21 16 d cl s 1 1 1 c 592 1246 m 23 6 d
- -20 16 d -24 -6 d f black 592 1246 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 568
- 1227 m 24 6 d -21 15 d -23 -6 d f black 568 1227 m 24 6 d -21 15 d -23 -6 d
- cl s 1 1 1 c 545 1221 m 23 6 d 13 Y -23 -6 d f black 545 1221 m 23 6 d 13 Y -23
- -6 d cl s 0.6 0.6 0.6 c 525 1236 m 20 -15 d 13 Y -20 16 d f black 525 1236 m 20
- -15 d 13 Y -20 16 d cl s 1 1 1 c 545 1234 m 23 6 d -20 16 d -23 -6 d f black
- 545 1234 m 23 6 d -20 16 d -23 -6 d cl s 1 1 1 c 521 1215 m 24 6 d -20 15 d -24
- -6 d f black 521 1215 m 24 6 d -20 15 d -24 -6 d cl s 1 1 1 c 498 1209 m 23 6 d
- -20 15 d -23 -6 d f black 498 1209 m 23 6 d -20 15 d -23 -6 d cl s 1 1 1 c 474
- 1203 m 24 6 d -20 15 d -24 -6 d f black 474 1203 m 24 6 d -20 15 d -24 -6 d
- cl s 1 1 1 c 451 1197 m 23 6 d -20 15 d -23 -6 d f black 451 1197 m 23 6 d -20
- 15 d -23 -6 d cl s 1 1 1 c 427 1191 m 24 6 d -20 15 d -24 -6 d f black 427 1191
- m 24 6 d -20 15 d -24 -6 d cl s 1 1 1 c 404 1185 m 23 6 d -20 15 d -23 -6 d f
- black 404 1185 m 23 6 d -20 15 d -23 -6 d cl s 1 1 1 c 380 1179 m 24 6 d -20 15
- d -24 -6 d f black 380 1179 m 24 6 d -20 15 d -24 -6 d cl s 1 1 1 c 357 1173 m
- 23 6 d -20 15 d -23 -6 d f black 357 1173 m 23 6 d -20 15 d -23 -6 d cl s 1 1 1
- c 333 1167 m 24 6 d -20 15 d -24 -6 d f black 333 1167 m 24 6 d -20 15 d -24 -6
- d cl s 1 1 1 c 310 1161 m 23 6 d -20 15 d -23 -6 d f black 310 1161 m 23 6 d
- -20 15 d -23 -6 d cl s 1 1 1 c 286 1155 m 24 6 d -20 15 d -24 -6 d f black 286
- 1155 m 24 6 d -20 15 d -24 -6 d cl s 1 1 1 c 263 1149 m 23 6 d -20 15 d -23 -6
- d f black 263 1149 m 23 6 d -20 15 d -23 -6 d cl s 1 1 1 c 1387 1414 m 24 6 d
- -21 16 d -23 -6 d f black 1387 1414 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c
- 1364 1408 m 23 6 d -20 16 d -24 -6 d f black 1364 1408 m 23 6 d -20 16 d -24 -6
- d cl s 1 1 1 c 1340 1402 m 24 6 d -21 16 d -23 -6 d f black 1340 1402 m 24 6 d
- -21 16 d -23 -6 d cl s 1 1 1 c 1317 1396 m 23 6 d -20 16 d -23 -6 d f black
- 1317 1396 m 23 6 d -20 16 d -23 -6 d cl s 1 1 1 c 1293 1390 m 24 6 d -20 16 d
- -24 -6 d f black 1293 1390 m 24 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1270 1384 m
- 23 6 d -20 16 d -23 -6 d f black 1270 1384 m 23 6 d -20 16 d -23 -6 d cl s 1 1
- 1 c 1246 1378 m 24 6 d -20 16 d -24 -6 d f black 1246 1378 m 24 6 d -20 16 d
- -24 -6 d cl s 1 1 1 c 1223 1373 m 23 5 d -20 16 d -23 -6 d f black 1223 1373 m
- 23 5 d -20 16 d -23 -6 d cl s 1 1 1 c 1199 1367 m 24 6 d -20 15 d -24 -6 d f
- black 1199 1367 m 24 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1176 1361 m 23 6 d -20
- 15 d -23 -6 d f black 1176 1361 m 23 6 d -20 15 d -23 -6 d cl s 1 1 1 c 1152
- 1355 m 24 6 d -20 15 d -24 -6 d f black 1152 1355 m 24 6 d -20 15 d -24 -6 d
- cl s 1 1 1 c 1129 1349 m 23 6 d -20 15 d -23 -6 d f black 1129 1349 m 23 6 d
- -20 15 d -23 -6 d cl s 1 1 1 c 1105 1343 m 24 6 d -20 15 d -24 -6 d f black
- 1105 1343 m 24 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1082 1337 m 23 6 d -20 15 d
- -23 -6 d f black 1082 1337 m 23 6 d -20 15 d -23 -6 d cl s 1 1 1 c 1058 1331 m
- 24 6 d -20 15 d -24 -6 d f black 1058 1331 m 24 6 d -20 15 d -24 -6 d cl s 1 1
- 1 c 1035 1325 m 23 6 d -20 15 d -23 -6 d f black 1035 1325 m 23 6 d -20 15 d
- -23 -6 d cl s 1 1 1 c 1011 1319 m 24 6 d -20 15 d -24 -6 d f black 1011 1319 m
- 24 6 d -20 15 d -24 -6 d cl s 1 1 1 c 988 1313 m 23 6 d -20 15 d -23 -6 d f
- black 988 1313 m 23 6 d -20 15 d -23 -6 d cl s 1 1 1 c 965 1307 m 23 6 d -20 15
- d -24 -6 d f black 965 1307 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 941 1301 m
- 24 6 d -21 15 d -23 -6 d f black 941 1301 m 24 6 d -21 15 d -23 -6 d cl s 1 1 1
- c 918 1295 m 23 6 d -20 15 d -24 -6 d f black 918 1295 m 23 6 d -20 15 d -24 -6
- d cl s 1 1 1 c 894 1289 m 24 6 d -21 15 d -23 -6 d f black 894 1289 m 24 6 d
- -21 15 d -23 -6 d cl s 1 1 1 c 871 1283 m 23 6 d -20 15 d -24 -6 d f black 871
- 1283 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 847 1277 m 24 6 d -21 15 d -23 -6
- d f black 847 1277 m 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 824 1271 m 23 6 d
- -20 15 d -24 -6 d f black 824 1271 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 800
- 1265 m 24 6 d -21 15 d -23 -6 d f black 800 1265 m 24 6 d -21 15 d -23 -6 d
- cl s 1 1 1 c 777 1259 m 23 6 d -20 15 d -24 -6 d f black 777 1259 m 23 6 d -20
- 15 d -24 -6 d cl s 1 1 1 c 753 1253 m 24 6 d -21 15 d -23 -6 d f black 753 1253
- m 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 730 1247 m 23 6 d -20 15 d -24 -6 d f
- black 730 1247 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 706 1241 m 24 6 d -21 15
- d -23 -6 d f black 706 1241 m 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 683 1235 m
- 23 6 d -20 15 d -24 -5 d f black 683 1235 m 23 6 d -20 15 d -24 -5 d cl s 1 1 1
- c 659 1229 m 24 6 d -21 16 d -23 -6 d f black 659 1229 m 24 6 d -21 16 d -23 -6
- d cl s 1 1 1 c 636 1223 m 23 6 d -20 16 d -24 -6 d f black 636 1223 m 23 6 d
- -20 16 d -24 -6 d cl s 1 1 1 c 612 1217 m 24 6 d -21 16 d -23 -6 d f black 612
- 1217 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 589 1211 m 23 6 d 13 Y -23 -6 d f
- black 589 1211 m 23 6 d 13 Y -23 -6 d cl s 0.6 0.6 0.6 c 568 1227 m 21 -16 d 13
- Y -21 16 d f black 568 1227 m 21 -16 d 13 Y -21 16 d cl s 1 1 1 c 589 1224 m 23
- 6 d -20 16 d -24 -6 d f black 589 1224 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c
- 565 1205 m 24 6 d -21 16 d -23 -6 d f black 565 1205 m 24 6 d -21 16 d -23 -6 d
- cl s 1 1 1 c 542 1199 m 23 6 d 14 Y -23 -6 d f black 542 1199 m 23 6 d 14 Y -23
- -6 d cl s 0.6 0.6 0.6 c 521 1215 m 21 -16 d 14 Y -21 15 d f black 521 1215 m 21
- -16 d 14 Y -21 15 d cl s 1 1 1 c 542 1213 m 23 6 d -20 15 d -24 -6 d f black
- 542 1213 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 518 1193 m 24 6 d -21 16 d -23
- -6 d f black 518 1193 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 495 1187 m 23 6 d
- -20 16 d -24 -6 d f black 495 1187 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 471
- 1181 m 24 6 d -21 16 d -23 -6 d f black 471 1181 m 24 6 d -21 16 d -23 -6 d
- cl s 1 1 1 c 448 1175 m 23 6 d -20 16 d -24 -6 d f black 448 1175 m 23 6 d -20
- 16 d -24 -6 d cl s 1 1 1 c 424 1169 m 24 6 d -21 16 d -23 -6 d f black 424 1169
- m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 401 1163 m 23 6 d 14 Y -23 -6 d f black
- 401 1163 m 23 6 d 14 Y -23 -6 d cl s 0.6 0.6 0.6 c 380 1179 m 21 -16 d 14 Y -21
- 15 d f black 380 1179 m 21 -16 d 14 Y -21 15 d cl s 1 1 1 c 401 1177 m 23 6 d
- -20 15 d -24 -6 d f black 401 1177 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 377
- 1157 m 24 6 d -21 16 d -23 -6 d f black 377 1157 m 24 6 d -21 16 d -23 -6 d
- cl s 1 1 1 c 354 1151 m 23 6 d -20 16 d -24 -6 d f black 354 1151 m 23 6 d -20
- 16 d -24 -6 d cl s 1 1 1 c 330 1145 m 24 6 d -21 16 d -23 -6 d f black 330 1145
- m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 307 1139 m 23 6 d -20 16 d -24 -6 d f
- black 307 1139 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 283 1133 m 24 6 d -21 16
- d -23 -6 d f black 283 1133 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 1408 1399 m
- 23 6 d -20 15 d -24 -6 d f black 1408 1399 m 23 6 d -20 15 d -24 -6 d cl s 1 1
- 1 c 1384 1393 m 24 6 d -21 15 d -23 -6 d f black 1384 1393 m 24 6 d -21 15 d
- -23 -6 d cl s 1 1 1 c 1361 1387 m 23 6 d -20 15 d -24 -6 d f black 1361 1387 m
- 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1337 1381 m 24 6 d -21 15 d -23 -6 d f
- black 1337 1381 m 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 1314 1375 m 23 6 d 13 Y
- -23 -6 d f black 1314 1375 m 23 6 d 13 Y -23 -6 d cl s 0.6 0.6 0.6 c 1293 1390
- m 21 -15 d 13 Y -21 16 d f black 1293 1390 m 21 -15 d 13 Y -21 16 d cl s 1 1 1
- c 1314 1388 m 23 6 d -20 16 d -24 -6 d f black 1314 1388 m 23 6 d -20 16 d -24
- -6 d cl s 1 1 1 c 1290 1369 m 24 6 d -21 15 d -23 -6 d f black 1290 1369 m 24 6
- d -21 15 d -23 -6 d cl s 1 1 1 c 1267 1363 m 23 6 d -20 15 d -24 -6 d f black
- 1267 1363 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1243 1357 m 24 6 d -21 15 d
- -23 -5 d f black 1243 1357 m 24 6 d -21 15 d -23 -5 d cl s 1 1 1 c 1220 1351 m
- 23 6 d -20 16 d -24 -6 d f black 1220 1351 m 23 6 d -20 16 d -24 -6 d cl s 1 1
- 1 c 1196 1345 m 24 6 d -21 16 d -23 -6 d f black 1196 1345 m 24 6 d -21 16 d
- -23 -6 d cl s 1 1 1 c 1173 1339 m 23 6 d -20 16 d -24 -6 d f black 1173 1339 m
- 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1149 1333 m 24 6 d -21 16 d -23 -6 d f
- black 1149 1333 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 1126 1327 m 23 6 d -20
- 16 d -24 -6 d f black 1126 1327 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1102
- 1321 m 24 6 d -21 16 d -23 -6 d f black 1102 1321 m 24 6 d -21 16 d -23 -6 d
- cl s 1 1 1 c 1079 1315 m 23 6 d -20 16 d -24 -6 d f black 1079 1315 m 23 6 d
- -20 16 d -24 -6 d cl s 1 1 1 c 1055 1309 m 24 6 d -21 16 d -23 -6 d f black
- 1055 1309 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 1032 1303 m 23 6 d -20 16 d
- -24 -6 d f black 1032 1303 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1008 1297 m
- 24 6 d 14 Y -24 -6 d f black 1008 1297 m 24 6 d 14 Y -24 -6 d cl s 0.6 0.6 0.6
- c 988 1313 m 20 -16 d 14 Y -20 15 d f black 988 1313 m 20 -16 d 14 Y -20 15 d
- cl s 1 1 1 c 1008 1311 m 24 6 d -21 15 d -23 -6 d f black 1008 1311 m 24 6 d
- -21 15 d -23 -6 d cl s 1 1 1 c 985 1291 m 23 6 d -20 16 d -23 -6 d f black 985
- 1291 m 23 6 d -20 16 d -23 -6 d cl s 1 1 1 c 961 1285 m 24 6 d 14 Y -24 -6 d f
- black 961 1285 m 24 6 d 14 Y -24 -6 d cl s 0.6 0.6 0.6 c 941 1301 m 20 -16 d 14
- Y -20 15 d f black 941 1301 m 20 -16 d 14 Y -20 15 d cl s 1 1 1 c 961 1299 m 24
- 6 d -20 15 d -24 -6 d f black 961 1299 m 24 6 d -20 15 d -24 -6 d cl s 1 1 1 c
- 938 1279 m 23 6 d -20 16 d -23 -6 d f black 938 1279 m 23 6 d -20 16 d -23 -6 d
- cl s 1 1 1 c 914 1273 m 24 6 d -20 16 d -24 -6 d f black 914 1273 m 24 6 d -20
- 16 d -24 -6 d cl s 1 1 1 c 891 1267 m 23 6 d -20 16 d -23 -6 d f black 891 1267
- m 23 6 d -20 16 d -23 -6 d cl s 1 1 1 c 867 1261 m 24 6 d -20 16 d -24 -6 d f
- black 867 1261 m 24 6 d -20 16 d -24 -6 d cl s 1 1 1 c 844 1255 m 23 6 d 14 Y
- -23 -6 d f black 844 1255 m 23 6 d 14 Y -23 -6 d cl s 0.6 0.6 0.6 c 824 1271 m
- 20 -16 d 14 Y -20 15 d f black 824 1271 m 20 -16 d 14 Y -20 15 d cl s 1 1 1 c
- 844 1269 m 23 6 d -20 15 d -23 -6 d f black 844 1269 m 23 6 d -20 15 d -23 -6 d
- cl s 1 1 1 c 820 1249 m 24 6 d 14 Y -24 -6 d f black 820 1249 m 24 6 d 14 Y -24
- -6 d cl s 0.6 0.6 0.6 c 800 1265 m 20 -16 d 14 Y -20 15 d f black 800 1265 m 20
- -16 d 14 Y -20 15 d cl s 1 1 1 c 820 1263 m 24 6 d -20 15 d -24 -6 d f black
- 820 1263 m 24 6 d -20 15 d -24 -6 d cl s 1 1 1 c 797 1243 m 23 6 d -20 16 d -23
- -6 d f black 797 1243 m 23 6 d -20 16 d -23 -6 d cl s 1 1 1 c 773 1237 m 24 6 d
- -20 16 d -24 -6 d f black 773 1237 m 24 6 d -20 16 d -24 -6 d cl s 1 1 1 c 750
- 1231 m 23 6 d -20 16 d -23 -6 d f black 750 1231 m 23 6 d -20 16 d -23 -6 d
- cl s 1 1 1 c 726 1225 m 24 6 d -20 16 d -24 -6 d f black 726 1225 m 24 6 d -20
- 16 d -24 -6 d cl s 1 1 1 c 703 1219 m 23 6 d -20 16 d -23 -6 d f black 703 1219
- m 23 6 d -20 16 d -23 -6 d cl s 1 1 1 c 679 1213 m 24 6 d -20 16 d -24 -6 d f
- black 679 1213 m 24 6 d -20 16 d -24 -6 d cl s 1 1 1 c 656 1207 m 23 6 d -20 16
- d -23 -6 d f black 656 1207 m 23 6 d -20 16 d -23 -6 d cl s 1 1 1 c 633 1201 m
- 23 6 d -20 16 d -24 -6 d f black 633 1201 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1
- c 609 1196 m 24 5 d 14 Y -24 -6 d f black 609 1196 m 24 5 d 14 Y -24 -6 d cl s
- 0.6 0.6 0.6 c 589 1211 m 20 -15 d 13 Y -20 15 d f black 589 1211 m 20 -15 d 13
- Y -20 15 d cl s 1 1 1 c 609 1209 m 24 6 d -21 15 d -23 -6 d f black 609 1209 m
- 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 586 1190 m 23 6 d -20 15 d -24 -6 d f
- black 586 1190 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 562 1184 m 24 6 d 13 Y
- -24 -6 d f black 562 1184 m 24 6 d 13 Y -24 -6 d cl s 0.6 0.6 0.6 c 542 1199 m
- 20 -15 d 13 Y -20 16 d f black 542 1199 m 20 -15 d 13 Y -20 16 d cl s 1 1 1 c
- 562 1197 m 24 6 d -21 16 d -23 -6 d f black 562 1197 m 24 6 d -21 16 d -23 -6 d
- cl s 1 1 1 c 539 1178 m 23 6 d -20 15 d -24 -6 d f black 539 1178 m 23 6 d -20
- 15 d -24 -6 d cl s 1 1 1 c 515 1172 m 24 6 d -21 15 d -23 -6 d f black 515 1172
- m 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 492 1166 m 23 6 d -20 15 d -24 -6 d f
- black 492 1166 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 468 1160 m 24 6 d 13 Y
- -24 -6 d f black 468 1160 m 24 6 d 13 Y -24 -6 d cl s 0.6 0.6 0.6 c 448 1175 m
- 20 -15 d 13 Y -20 16 d f black 448 1175 m 20 -15 d 13 Y -20 16 d cl s 1 1 1 c
- 468 1173 m 24 6 d -21 16 d -23 -6 d f black 468 1173 m 24 6 d -21 16 d -23 -6 d
- cl s 1 1 1 c 445 1154 m 23 6 d -20 15 d -24 -6 d f black 445 1154 m 23 6 d -20
- 15 d -24 -6 d cl s 1 1 1 c 421 1148 m 24 6 d 13 Y -24 -6 d f black 421 1148 m
- 24 6 d 13 Y -24 -6 d cl s 0.6 0.6 0.6 c 401 1163 m 20 -15 d 13 Y -20 16 d f
- black 401 1163 m 20 -15 d 13 Y -20 16 d cl s 1 1 1 c 421 1161 m 24 6 d -21 16 d
- -23 -6 d f black 421 1161 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 398 1142 m 23
- 6 d -20 15 d -24 -6 d f black 398 1142 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c
- 374 1136 m 24 6 d -21 15 d -23 -6 d f black 374 1136 m 24 6 d -21 15 d -23 -6 d
- cl s 1 1 1 c 351 1130 m 23 6 d -20 15 d -24 -6 d f black 351 1130 m 23 6 d -20
- 15 d -24 -6 d cl s 1 1 1 c 327 1124 m 24 6 d -21 15 d -23 -6 d f black 327 1124
- m 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 304 1118 m 23 6 d -20 15 d -24 -6 d f
- black 304 1118 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1428 1383 m 23 6 d -20
- 16 d -23 -6 d f black 1428 1383 m 23 6 d -20 16 d -23 -6 d cl s 1 1 1 c 1405
- 1377 m 23 6 d -20 16 d -24 -6 d f black 1405 1377 m 23 6 d -20 16 d -24 -6 d
- cl s 1 1 1 c 1381 1371 m 24 6 d -21 16 d -23 -6 d f black 1381 1371 m 24 6 d
- -21 16 d -23 -6 d cl s 1 1 1 c 1358 1365 m 23 6 d -20 16 d -24 -6 d f black
- 1358 1365 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1334 1359 m 24 6 d 14 Y -24
- -6 d f black 1334 1359 m 24 6 d 14 Y -24 -6 d cl s 0.6 0.6 0.6 c 1314 1375 m 20
- -16 d 14 Y -20 15 d f black 1314 1375 m 20 -16 d 14 Y -20 15 d cl s 1 1 1 c
- 1334 1373 m 24 6 d -21 15 d -23 -6 d f black 1334 1373 m 24 6 d -21 15 d -23 -6
- d cl s 1 1 1 c 1311 1353 m 23 6 d -20 16 d -24 -6 d f black 1311 1353 m 23 6 d
- -20 16 d -24 -6 d cl s 1 1 1 c 1287 1347 m 24 6 d -21 16 d -23 -6 d f black
- 1287 1347 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 1264 1341 m 23 6 d 14 Y -23
- -6 d f black 1264 1341 m 23 6 d 14 Y -23 -6 d cl s 0.6 0.6 0.6 c 1243 1357 m 21
- -16 d 14 Y -21 15 d f black 1243 1357 m 21 -16 d 14 Y -21 15 d cl s 1 1 1 c
- 1264 1355 m 23 6 d -20 15 d -24 -6 d f black 1264 1355 m 23 6 d -20 15 d -24 -6
- d cl s 1 1 1 c 1240 1335 m 24 6 d -21 16 d -23 -6 d f black 1240 1335 m 24 6 d
- -21 16 d -23 -6 d cl s 1 1 1 c 1217 1329 m 23 6 d 14 Y -23 -6 d f black 1217
- 1329 m 23 6 d 14 Y -23 -6 d cl s 0.6 0.6 0.6 c 1196 1345 m 21 -16 d 14 Y -21 15
- d f black 1196 1345 m 21 -16 d 14 Y -21 15 d cl s 1 1 1 c 1217 1343 m 23 6 d
- -20 15 d -24 -6 d f black 1217 1343 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c
- 1193 1323 m 24 6 d 14 Y -24 -6 d f black 1193 1323 m 24 6 d 14 Y -24 -6 d cl s
- 0.6 0.6 0.6 c 1173 1339 m 20 -16 d 14 Y -20 15 d f black 1173 1339 m 20 -16 d
- 14 Y -20 15 d cl s 1 1 1 c 1193 1337 m 24 6 d -21 15 d -23 -6 d f black 1193
- 1337 m 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 1170 1318 m 23 5 d 27 Y -23 -6 d f
- black 1170 1318 m 23 5 d 27 Y -23 -6 d cl s 0.6 0.6 0.6 c 1149 1333 m 21 -15 d
- 26 Y -21 16 d f black 1149 1333 m 21 -15 d 26 Y -21 16 d cl s 1 1 1 c 1170 1344
- m 23 6 d -20 16 d -24 -6 d f black 1170 1344 m 23 6 d -20 16 d -24 -6 d cl s 1
- 1 1 c 1146 1312 m 24 6 d 26 Y -24 -6 d f black 1146 1312 m 24 6 d 26 Y -24 -6 d
- cl s 0.6 0.6 0.6 c 1126 1327 m 20 -15 d 26 Y -20 16 d f black 1126 1327 m 20
- -15 d 26 Y -20 16 d cl s 1 1 1 c 1146 1338 m 24 6 d -21 16 d -23 -6 d f black
- 1146 1338 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 1123 1306 m 23 6 d 13 Y -23
- -6 d f black 1123 1306 m 23 6 d 13 Y -23 -6 d cl s 0.6 0.6 0.6 c 1102 1321 m 21
- -15 d 13 Y -21 16 d f black 1102 1321 m 21 -15 d 13 Y -21 16 d cl s 1 1 1 c
- 1123 1319 m 23 6 d -20 16 d -24 -6 d f black 1123 1319 m 23 6 d -20 16 d -24 -6
- d cl s 1 1 1 c 1099 1300 m 24 6 d 13 Y -24 -6 d f black 1099 1300 m 24 6 d 13 Y
- -24 -6 d cl s 0.6 0.6 0.6 c 1079 1315 m 20 -15 d 13 Y -20 16 d f black 1079
- 1315 m 20 -15 d 13 Y -20 16 d cl s 1 1 1 c 1099 1313 m 24 6 d -21 16 d -23 -6 d
- f black 1099 1313 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 1076 1294 m 23 6 d
- -20 15 d -24 -6 d f black 1076 1294 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c
- 1052 1288 m 24 6 d -21 15 d -23 -6 d f black 1052 1288 m 24 6 d -21 15 d -23 -6
- d cl s 1 1 1 c 1029 1282 m 23 6 d 13 Y -23 -6 d f black 1029 1282 m 23 6 d 13 Y
- -23 -6 d cl s 0.6 0.6 0.6 c 1008 1297 m 21 -15 d 13 Y -21 16 d f black 1008
- 1297 m 21 -15 d 13 Y -21 16 d cl s 1 1 1 c 1029 1295 m 23 6 d -20 16 d -24 -6 d
- f black 1029 1295 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1005 1276 m 24 6 d 40
- Y -24 -6 d f black 1005 1276 m 24 6 d 40 Y -24 -6 d cl s 0.6 0.6 0.6 c 985 1291
- m 20 -15 d 40 Y -20 15 d f black 985 1291 m 20 -15 d 40 Y -20 15 d cl s 1 1 1 c
- 1005 1316 m 24 6 d -21 15 d -23 -6 d f black 1005 1316 m 24 6 d -21 15 d -23 -6
- d cl s 1 1 1 c 982 1270 m 23 6 d -20 15 d -24 -6 d f black 982 1270 m 23 6 d
- -20 15 d -24 -6 d cl s 1 1 1 c 958 1264 m 24 6 d 27 Y -24 -6 d f black 958 1264
- m 24 6 d 27 Y -24 -6 d cl s 0.6 0.6 0.6 c 938 1279 m 20 -15 d 27 Y -20 15 d f
- black 938 1279 m 20 -15 d 27 Y -20 15 d cl s 1 1 1 c 958 1291 m 24 6 d -21 15 d
- -23 -6 d f black 958 1291 m 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 935 1258 m 23
- 6 d 27 Y -23 -6 d f black 935 1258 m 23 6 d 27 Y -23 -6 d cl s 0.6 0.6 0.6 c
- 914 1273 m 21 -15 d 27 Y -21 15 d f black 914 1273 m 21 -15 d 27 Y -21 15 d
- cl s 1 1 1 c 935 1285 m 23 6 d -20 15 d -24 -6 d f black 935 1285 m 23 6 d -20
- 15 d -24 -6 d cl s 1 1 1 c 911 1252 m 24 6 d 27 Y -24 -6 d f black 911 1252 m
- 24 6 d 27 Y -24 -6 d cl s 0.6 0.6 0.6 c 891 1267 m 20 -15 d 27 Y -20 15 d f
- black 891 1267 m 20 -15 d 27 Y -20 15 d cl s 1 1 1 c 911 1279 m 24 6 d -21 15 d
- -23 -6 d f black 911 1279 m 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 888 1246 m 23
- 6 d 27 Y -23 -6 d f black 888 1246 m 23 6 d 27 Y -23 -6 d cl s 0.6 0.6 0.6 c
- 867 1261 m 21 -15 d 27 Y -21 15 d f black 867 1261 m 21 -15 d 27 Y -21 15 d
- cl s 1 1 1 c 888 1273 m 23 6 d -20 15 d -24 -6 d f black 888 1273 m 23 6 d -20
- 15 d -24 -6 d cl s 1 1 1 c 864 1240 m 24 6 d 13 Y -24 -6 d f black 864 1240 m
- 24 6 d 13 Y -24 -6 d cl s 0.6 0.6 0.6 c 844 1255 m 20 -15 d 13 Y -20 16 d f
- black 844 1255 m 20 -15 d 13 Y -20 16 d cl s 1 1 1 c 864 1253 m 24 6 d -21 16 d
- -23 -6 d f black 864 1253 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 841 1234 m 23
- 6 d -20 15 d -24 -6 d f black 841 1234 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c
- 817 1228 m 24 6 d 27 Y -24 -6 d f black 817 1228 m 24 6 d 27 Y -24 -6 d cl s
- 0.6 0.6 0.6 c 797 1243 m 20 -15 d 27 Y -20 15 d f black 797 1243 m 20 -15 d 27
- Y -20 15 d cl s 1 1 1 c 817 1255 m 24 6 d -21 15 d -23 -6 d f black 817 1255 m
- 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 794 1222 m 23 6 d -20 15 d -24 -6 d f
- black 794 1222 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 770 1216 m 24 6 d 27 Y
- -24 -6 d f black 770 1216 m 24 6 d 27 Y -24 -6 d cl s 0.6 0.6 0.6 c 750 1231 m
- 20 -15 d 27 Y -20 15 d f black 750 1231 m 20 -15 d 27 Y -20 15 d cl s 1 1 1 c
- 770 1243 m 24 6 d -21 15 d -23 -6 d f black 770 1243 m 24 6 d -21 15 d -23 -6 d
- cl s 1 1 1 c 747 1210 m 23 6 d -20 15 d -24 -6 d f black 747 1210 m 23 6 d -20
- 15 d -24 -6 d cl s 1 1 1 c 723 1204 m 24 6 d 27 Y -24 -6 d f black 723 1204 m
- 24 6 d 27 Y -24 -6 d cl s 0.6 0.6 0.6 c 703 1219 m 20 -15 d 27 Y -20 15 d f
- black 703 1219 m 20 -15 d 27 Y -20 15 d cl s 1 1 1 c 723 1231 m 24 6 d -21 15 d
- -23 -6 d f black 723 1231 m 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 700 1198 m 23
- 6 d -20 15 d -24 -6 d f black 700 1198 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c
- 676 1192 m 24 6 d 13 Y -24 -6 d f black 676 1192 m 24 6 d 13 Y -24 -6 d cl s
- 0.6 0.6 0.6 c 656 1207 m 20 -15 d 13 Y -20 16 d f black 656 1207 m 20 -15 d 13
- Y -20 16 d cl s 1 1 1 c 676 1205 m 24 6 d -21 16 d -23 -6 d f black 676 1205 m
- 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 653 1186 m 23 6 d 27 Y -23 -6 d f black
- 653 1186 m 23 6 d 27 Y -23 -6 d cl s 0.6 0.6 0.6 c 633 1201 m 20 -15 d 27 Y -20
- 15 d f black 633 1201 m 20 -15 d 27 Y -20 15 d cl s 1 1 1 c 653 1213 m 23 6 d
- -20 15 d -23 -6 d f black 653 1213 m 23 6 d -20 15 d -23 -6 d cl s 1 1 1 c 629
- 1180 m 24 6 d -20 15 d -24 -5 d f black 629 1180 m 24 6 d -20 15 d -24 -5 d
- cl s 1 1 1 c 606 1174 m 23 6 d 27 Y -23 -6 d f black 606 1174 m 23 6 d 27 Y -23
- -6 d cl s 0.6 0.6 0.6 c 586 1190 m 20 -16 d 27 Y -20 15 d f black 586 1190 m 20
- -16 d 27 Y -20 15 d cl s 1 1 1 c 606 1201 m 23 6 d -20 15 d -23 -6 d f black
- 606 1201 m 23 6 d -20 15 d -23 -6 d cl s 1 1 1 c 582 1168 m 24 6 d 13 Y -24 -6
- d f black 582 1168 m 24 6 d 13 Y -24 -6 d cl s 0.6 0.6 0.6 c 562 1184 m 20 -16
- d 13 Y -20 16 d f black 562 1184 m 20 -16 d 13 Y -20 16 d cl s 1 1 1 c 582 1181
- m 24 6 d -20 16 d -24 -6 d f black 582 1181 m 24 6 d -20 16 d -24 -6 d cl s 1 1
- 1 c 559 1162 m 23 6 d 13 Y -23 -6 d f black 559 1162 m 23 6 d 13 Y -23 -6 d
- cl s 0.6 0.6 0.6 c 539 1178 m 20 -16 d 13 Y -20 16 d f black 539 1178 m 20 -16
- d 13 Y -20 16 d cl s 1 1 1 c 559 1175 m 23 6 d -20 16 d -23 -6 d f black 559
- 1175 m 23 6 d -20 16 d -23 -6 d cl s 1 1 1 c 535 1156 m 24 6 d -20 16 d -24 -6
- d f black 535 1156 m 24 6 d -20 16 d -24 -6 d cl s 1 1 1 c 512 1150 m 23 6 d
- -20 16 d -23 -6 d f black 512 1150 m 23 6 d -20 16 d -23 -6 d cl s 1 1 1 c 488
- 1144 m 24 6 d 14 Y -24 -6 d f black 488 1144 m 24 6 d 14 Y -24 -6 d cl s 0.6
- 0.6 0.6 c 468 1160 m 20 -16 d 14 Y -20 15 d f black 468 1160 m 20 -16 d 14 Y
- -20 15 d cl s 1 1 1 c 488 1158 m 24 6 d -20 15 d -24 -6 d f black 488 1158 m 24
- 6 d -20 15 d -24 -6 d cl s 1 1 1 c 465 1138 m 23 6 d 14 Y -23 -6 d f black 465
- 1138 m 23 6 d 14 Y -23 -6 d cl s 0.6 0.6 0.6 c 445 1154 m 20 -16 d 14 Y -20 15
- d f black 445 1154 m 20 -16 d 14 Y -20 15 d cl s 1 1 1 c 465 1152 m 23 6 d -20
- 15 d -23 -6 d f black 465 1152 m 23 6 d -20 15 d -23 -6 d cl s 1 1 1 c 441 1132
- m 24 6 d 14 Y -24 -6 d f black 441 1132 m 24 6 d 14 Y -24 -6 d cl s 0.6 0.6 0.6
- c 421 1148 m 20 -16 d 14 Y -20 15 d f black 421 1148 m 20 -16 d 14 Y -20 15 d
- cl s 1 1 1 c 441 1146 m 24 6 d -20 15 d -24 -6 d f black 441 1146 m 24 6 d -20
- 15 d -24 -6 d cl s 1 1 1 c 418 1126 m 23 6 d -20 16 d -23 -6 d f black 418 1126
- m 23 6 d -20 16 d -23 -6 d cl s 1 1 1 c 394 1120 m 24 6 d -20 16 d -24 -6 d f
- black 394 1120 m 24 6 d -20 16 d -24 -6 d cl s 1 1 1 c 371 1114 m 23 6 d -20 16
- d -23 -6 d f black 371 1114 m 23 6 d -20 16 d -23 -6 d cl s 1 1 1 c 348 1108 m
- 23 6 d -20 16 d -24 -6 d f black 348 1108 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1
- c 324 1102 m 24 6 d -21 16 d -23 -6 d f black 324 1102 m 24 6 d -21 16 d -23 -6
- d cl s 1 1 1 c 1448 1368 m 24 6 d -21 15 d -23 -6 d f black 1448 1368 m 24 6 d
- -21 15 d -23 -6 d cl s 1 1 1 c 1425 1362 m 23 6 d -20 15 d -23 -6 d f black
- 1425 1362 m 23 6 d -20 15 d -23 -6 d cl s 1 1 1 c 1401 1356 m 24 6 d -20 15 d
- -24 -6 d f black 1401 1356 m 24 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1378 1350 m
- 23 6 d -20 15 d -23 -6 d f black 1378 1350 m 23 6 d -20 15 d -23 -6 d cl s 1 1
- 1 c 1354 1344 m 24 6 d 27 Y -24 -6 d f black 1354 1344 m 24 6 d 27 Y -24 -6 d
- cl s 0.6 0.6 0.6 c 1334 1359 m 20 -15 d 27 Y -20 15 d f black 1334 1359 m 20
- -15 d 27 Y -20 15 d cl s 1 1 1 c 1354 1371 m 24 6 d -20 15 d -24 -6 d f black
- 1354 1371 m 24 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1331 1338 m 23 6 d 54 Y -23
- -6 d f black 1331 1338 m 23 6 d 54 Y -23 -6 d cl s 0.6 0.6 0.6 c 1311 1353 m 20
- -15 d 54 Y -20 15 d f black 1311 1353 m 20 -15 d 54 Y -20 15 d cl s 1 1 1 c
- 1331 1392 m 23 6 d -20 15 d -23 -6 d f black 1331 1392 m 23 6 d -20 15 d -23 -6
- d cl s 1 1 1 c 1307 1332 m 24 6 d -20 15 d -24 -6 d f black 1307 1332 m 24 6 d
- -20 15 d -24 -6 d cl s 1 1 1 c 1284 1326 m 23 6 d 40 Y -23 -6 d f black 1284
- 1326 m 23 6 d 40 Y -23 -6 d cl s 0.6 0.6 0.6 c 1264 1341 m 20 -15 d 40 Y -20 16
- d f black 1264 1341 m 20 -15 d 40 Y -20 16 d cl s 1 1 1 c 1284 1366 m 23 6 d
- -20 16 d -23 -6 d f black 1284 1366 m 23 6 d -20 16 d -23 -6 d cl s 1 1 1 c
- 1260 1320 m 24 6 d 13 Y -24 -6 d f black 1260 1320 m 24 6 d 13 Y -24 -6 d cl s
- 0.6 0.6 0.6 c 1240 1335 m 20 -15 d 13 Y -20 16 d f black 1240 1335 m 20 -15 d
- 13 Y -20 16 d cl s 1 1 1 c 1260 1333 m 24 6 d -20 16 d -24 -6 d f black 1260
- 1333 m 24 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1237 1314 m 23 6 d 13 Y -23 -6 d f
- black 1237 1314 m 23 6 d 13 Y -23 -6 d cl s 0.6 0.6 0.6 c 1217 1329 m 20 -15 d
- 13 Y -20 16 d f black 1217 1329 m 20 -15 d 13 Y -20 16 d cl s 1 1 1 c 1237 1327
- m 23 6 d -20 16 d -23 -6 d f black 1237 1327 m 23 6 d -20 16 d -23 -6 d cl s 1
- 1 1 c 1213 1308 m 24 6 d 27 Y -24 -6 d f black 1213 1308 m 24 6 d 27 Y -24 -6 d
- cl s 0.6 0.6 0.6 c 1193 1323 m 20 -15 d 27 Y -20 15 d f black 1193 1323 m 20
- -15 d 27 Y -20 15 d cl s 1 1 1 c 1213 1335 m 24 6 d -20 15 d -24 -6 d f black
- 1213 1335 m 24 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1190 1302 m 23 6 d 40 Y -23
- -6 d f black 1190 1302 m 23 6 d 40 Y -23 -6 d cl s 0.6 0.6 0.6 c 1170 1318 m 20
- -16 d 40 Y -20 16 d f black 1170 1318 m 20 -16 d 40 Y -20 16 d cl s 1 1 1 c
- 1190 1342 m 23 6 d -20 16 d -23 -6 d f black 1190 1342 m 23 6 d -20 16 d -23 -6
- d cl s 1 1 1 c 1166 1296 m 24 6 d 40 Y -24 -6 d f black 1166 1296 m 24 6 d 40 Y
- -24 -6 d cl s 0.6 0.6 0.6 c 1146 1312 m 20 -16 d 40 Y -20 16 d f black 1146
- 1312 m 20 -16 d 40 Y -20 16 d cl s 1 1 1 c 1166 1336 m 24 6 d -20 16 d -24 -6 d
- f black 1166 1336 m 24 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1143 1290 m 23 6 d 27
- Y -23 -6 d f black 1143 1290 m 23 6 d 27 Y -23 -6 d cl s 0.6 0.6 0.6 c 1123
- 1306 m 20 -16 d 27 Y -20 15 d f black 1123 1306 m 20 -16 d 27 Y -20 15 d cl s 1
- 1 1 c 1143 1317 m 23 6 d -20 15 d -23 -6 d f black 1143 1317 m 23 6 d -20 15 d
- -23 -6 d cl s 1 1 1 c 1119 1284 m 24 6 d 40 Y -24 -6 d f black 1119 1284 m 24 6
- d 40 Y -24 -6 d cl s 0.6 0.6 0.6 c 1099 1300 m 20 -16 d 40 Y -20 16 d f black
- 1099 1300 m 20 -16 d 40 Y -20 16 d cl s 1 1 1 c 1119 1324 m 24 6 d -20 16 d -24
- -6 d f black 1119 1324 m 24 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1096 1278 m 23 6
- d -20 16 d -23 -6 d f black 1096 1278 m 23 6 d -20 16 d -23 -6 d cl s 1 1 1 c
- 1073 1272 m 23 6 d -20 16 d -24 -6 d f black 1073 1272 m 23 6 d -20 16 d -24 -6
- d cl s 1 1 1 c 1049 1266 m 24 6 d 14 Y -24 -6 d f black 1049 1266 m 24 6 d 14 Y
- -24 -6 d cl s 0.6 0.6 0.6 c 1029 1282 m 20 -16 d 14 Y -20 15 d f black 1029
- 1282 m 20 -16 d 14 Y -20 15 d cl s 1 1 1 c 1049 1280 m 24 6 d -21 15 d -23 -6 d
- f black 1049 1280 m 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 1026 1260 m 23 6 d 14
- Y -23 -6 d f black 1026 1260 m 23 6 d 14 Y -23 -6 d cl s 0.6 0.6 0.6 c 1005
- 1276 m 21 -16 d 14 Y -21 15 d f black 1005 1276 m 21 -16 d 14 Y -21 15 d cl s 1
- 1 1 c 1026 1274 m 23 6 d -20 15 d -24 -6 d f black 1026 1274 m 23 6 d -20 15 d
- -24 -6 d cl s 1 1 1 c 1002 1254 m 24 6 d -21 16 d -23 -6 d f black 1002 1254 m
- 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 979 1248 m 23 6 d 14 Y -23 -6 d f black
- 979 1248 m 23 6 d 14 Y -23 -6 d cl s 0.6 0.6 0.6 c 958 1264 m 21 -16 d 14 Y -21
- 15 d f black 958 1264 m 21 -16 d 14 Y -21 15 d cl s 1 1 1 c 979 1262 m 23 6 d
- -20 15 d -24 -6 d f black 979 1262 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 955
- 1242 m 24 6 d -21 16 d -23 -6 d f black 955 1242 m 24 6 d -21 16 d -23 -6 d
- cl s 1 1 1 c 932 1236 m 23 6 d -20 16 d -24 -6 d f black 932 1236 m 23 6 d -20
- 16 d -24 -6 d cl s 1 1 1 c 908 1230 m 24 6 d 27 Y -24 -6 d f black 908 1230 m
- 24 6 d 27 Y -24 -6 d cl s 0.6 0.6 0.6 c 888 1246 m 20 -16 d 27 Y -20 16 d f
- black 888 1246 m 20 -16 d 27 Y -20 16 d cl s 1 1 1 c 908 1257 m 24 6 d -21 16 d
- -23 -6 d f black 908 1257 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 885 1224 m 23
- 6 d 14 Y -23 -6 d f black 885 1224 m 23 6 d 14 Y -23 -6 d cl s 0.6 0.6 0.6 c
- 864 1240 m 21 -16 d 14 Y -21 15 d f black 864 1240 m 21 -16 d 14 Y -21 15 d
- cl s 1 1 1 c 885 1238 m 23 6 d -20 15 d -24 -6 d f black 885 1238 m 23 6 d -20
- 15 d -24 -6 d cl s 1 1 1 c 861 1218 m 24 6 d 27 Y -24 -6 d f black 861 1218 m
- 24 6 d 27 Y -24 -6 d cl s 0.6 0.6 0.6 c 841 1234 m 20 -16 d 27 Y -20 16 d f
- black 841 1234 m 20 -16 d 27 Y -20 16 d cl s 1 1 1 c 861 1245 m 24 6 d -21 16 d
- -23 -6 d f black 861 1245 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 838 1212 m 23
- 6 d 27 Y -23 -6 d f black 838 1212 m 23 6 d 27 Y -23 -6 d cl s 0.6 0.6 0.6 c
- 817 1228 m 21 -16 d 27 Y -21 16 d f black 817 1228 m 21 -16 d 27 Y -21 16 d
- cl s 1 1 1 c 838 1239 m 23 6 d -20 16 d -24 -6 d f black 838 1239 m 23 6 d -20
- 16 d -24 -6 d cl s 1 1 1 c 814 1206 m 24 6 d 54 Y -24 -6 d f black 814 1206 m
- 24 6 d 54 Y -24 -6 d cl s 0.6 0.6 0.6 c 794 1222 m 20 -16 d 54 Y -20 16 d f
- black 794 1222 m 20 -16 d 54 Y -20 16 d cl s 1 1 1 c 814 1260 m 24 6 d -21 16 d
- -23 -6 d f black 814 1260 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 791 1200 m 23
- 6 d 14 Y -23 -6 d f black 791 1200 m 23 6 d 14 Y -23 -6 d cl s 0.6 0.6 0.6 c
- 770 1216 m 21 -16 d 14 Y -21 15 d f black 770 1216 m 21 -16 d 14 Y -21 15 d
- cl s 1 1 1 c 791 1214 m 23 6 d -20 15 d -24 -6 d f black 791 1214 m 23 6 d -20
- 15 d -24 -6 d cl s 1 1 1 c 767 1194 m 24 6 d -21 16 d -23 -6 d f black 767 1194
- m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 744 1188 m 23 6 d 14 Y -23 -6 d f black
- 744 1188 m 23 6 d 14 Y -23 -6 d cl s 0.6 0.6 0.6 c 723 1204 m 21 -16 d 14 Y -21
- 15 d f black 723 1204 m 21 -16 d 14 Y -21 15 d cl s 1 1 1 c 744 1202 m 23 6 d
- -20 15 d -24 -6 d f black 744 1202 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 720
- 1182 m 24 6 d -21 16 d -23 -6 d f black 720 1182 m 24 6 d -21 16 d -23 -6 d
- cl s 1 1 1 c 697 1176 m 23 6 d 27 Y -23 -6 d f black 697 1176 m 23 6 d 27 Y -23
- -6 d cl s 0.6 0.6 0.6 c 676 1192 m 21 -16 d 27 Y -21 16 d f black 676 1192 m 21
- -16 d 27 Y -21 16 d cl s 1 1 1 c 697 1203 m 23 6 d -20 16 d -24 -6 d f black
- 697 1203 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 673 1170 m 24 6 d 14 Y -24 -6
- d f black 673 1170 m 24 6 d 14 Y -24 -6 d cl s 0.6 0.6 0.6 c 653 1186 m 20 -16
- d 14 Y -20 15 d f black 653 1186 m 20 -16 d 14 Y -20 15 d cl s 1 1 1 c 673 1184
- m 24 6 d -21 15 d -23 -6 d f black 673 1184 m 24 6 d -21 15 d -23 -6 d cl s 1 1
- 1 c 650 1164 m 23 6 d 41 Y -23 -6 d f black 650 1164 m 23 6 d 41 Y -23 -6 d
- cl s 0.6 0.6 0.6 c 629 1180 m 21 -16 d 41 Y -21 15 d f black 629 1180 m 21 -16
- d 41 Y -21 15 d cl s 1 1 1 c 650 1205 m 23 6 d -20 15 d -24 -6 d f black 650
- 1205 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 626 1158 m 24 6 d 27 Y -24 -6 d f
- black 626 1158 m 24 6 d 27 Y -24 -6 d cl s 0.6 0.6 0.6 c 606 1174 m 20 -16 d 27
- Y -20 16 d f black 606 1174 m 20 -16 d 27 Y -20 16 d cl s 1 1 1 c 626 1185 m 24
- 6 d -21 16 d -23 -6 d f black 626 1185 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c
- 603 1152 m 23 6 d 14 Y -23 -6 d f black 603 1152 m 23 6 d 14 Y -23 -6 d cl s
- 0.6 0.6 0.6 c 582 1168 m 21 -16 d 14 Y -21 15 d f black 582 1168 m 21 -16 d 14
- Y -21 15 d cl s 1 1 1 c 603 1166 m 23 6 d -20 15 d -24 -6 d f black 603 1166 m
- 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 579 1147 m 24 5 d 27 Y -24 -6 d f black
- 579 1147 m 24 5 d 27 Y -24 -6 d cl s 0.6 0.6 0.6 c 559 1162 m 20 -15 d 26 Y -20
- 16 d f black 559 1162 m 20 -15 d 26 Y -20 16 d cl s 1 1 1 c 579 1173 m 24 6 d
- -21 16 d -23 -6 d f black 579 1173 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 556
- 1141 m 23 6 d -20 15 d -24 -6 d f black 556 1141 m 23 6 d -20 15 d -24 -6 d
- cl s 1 1 1 c 532 1135 m 24 6 d 26 Y -24 -6 d f black 532 1135 m 24 6 d 26 Y -24
- -6 d cl s 0.6 0.6 0.6 c 512 1150 m 20 -15 d 26 Y -20 16 d f black 512 1150 m 20
- -15 d 26 Y -20 16 d cl s 1 1 1 c 532 1161 m 24 6 d -21 16 d -23 -6 d f black
- 532 1161 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 509 1129 m 23 6 d 53 Y -23 -6
- d f black 509 1129 m 23 6 d 53 Y -23 -6 d cl s 0.6 0.6 0.6 c 488 1144 m 21 -15
- d 53 Y -21 16 d f black 488 1144 m 21 -15 d 53 Y -21 16 d cl s 1 1 1 c 509 1182
- m 23 6 d -20 16 d -24 -6 d f black 509 1182 m 23 6 d -20 16 d -24 -6 d cl s 1 1
- 1 c 485 1123 m 24 6 d 53 Y -24 -6 d f black 485 1123 m 24 6 d 53 Y -24 -6 d
- cl s 0.6 0.6 0.6 c 465 1138 m 20 -15 d 53 Y -20 16 d f black 465 1138 m 20 -15
- d 53 Y -20 16 d cl s 1 1 1 c 485 1176 m 24 6 d -21 16 d -23 -6 d f black 485
- 1176 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 462 1117 m 23 6 d 13 Y -23 -6 d f
- black 462 1117 m 23 6 d 13 Y -23 -6 d cl s 0.6 0.6 0.6 c 441 1132 m 21 -15 d 13
- Y -21 16 d f black 441 1132 m 21 -15 d 13 Y -21 16 d cl s 1 1 1 c 462 1130 m 23
- 6 d -20 16 d -24 -6 d f black 462 1130 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c
- 438 1111 m 24 6 d 53 Y -24 -6 d f black 438 1111 m 24 6 d 53 Y -24 -6 d cl s
- 0.6 0.6 0.6 c 418 1126 m 20 -15 d 53 Y -20 16 d f black 418 1126 m 20 -15 d 53
- Y -20 16 d cl s 1 1 1 c 438 1164 m 24 6 d -21 16 d -23 -6 d f black 438 1164 m
- 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 415 1105 m 23 6 d -20 15 d -24 -6 d f
- black 415 1105 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 391 1099 m 24 6 d -21 15
- d -23 -6 d f black 391 1099 m 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 368 1093 m
- 23 6 d -20 15 d -23 -6 d f black 368 1093 m 23 6 d -20 15 d -23 -6 d cl s 1 1 1
- c 344 1087 m 24 6 d -20 15 d -24 -6 d f black 344 1087 m 24 6 d -20 15 d -24 -6
- d cl s 1 1 1 c 1469 1352 m 23 6 d -20 16 d -24 -6 d f black 1469 1352 m 23 6 d
- -20 16 d -24 -6 d cl s 1 1 1 c 1445 1346 m 24 6 d -21 16 d -23 -6 d f black
- 1445 1346 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 1422 1340 m 23 6 d -20 16 d
- -24 -6 d f black 1422 1340 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1398 1334 m
- 24 6 d -21 16 d -23 -6 d f black 1398 1334 m 24 6 d -21 16 d -23 -6 d cl s 1 1
- 1 c 1375 1328 m 23 6 d 67 Y -23 -6 d f black 1375 1328 m 23 6 d 67 Y -23 -6 d
- cl s 0.6 0.6 0.6 c 1354 1344 m 21 -16 d 67 Y -21 16 d f black 1354 1344 m 21
- -16 d 67 Y -21 16 d cl s 1 1 1 c 1375 1395 m 23 6 d -20 16 d -24 -6 d f black
- 1375 1395 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1351 1322 m 24 6 d -21 16 d
- -23 -6 d f black 1351 1322 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 1328 1316 m
- 23 6 d 14 Y -23 -6 d f black 1328 1316 m 23 6 d 14 Y -23 -6 d cl s 0.6 0.6 0.6
- c 1307 1332 m 21 -16 d 14 Y -21 15 d f black 1307 1332 m 21 -16 d 14 Y -21 15 d
- cl s 1 1 1 c 1328 1330 m 23 6 d -20 15 d -24 -6 d f black 1328 1330 m 23 6 d
- -20 15 d -24 -6 d cl s 1 1 1 c 1304 1310 m 24 6 d 41 Y -24 -6 d f black 1304
- 1310 m 24 6 d 41 Y -24 -6 d cl s 0.6 0.6 0.6 c 1284 1326 m 20 -16 d 41 Y -20 15
- d f black 1284 1326 m 20 -16 d 41 Y -20 15 d cl s 1 1 1 c 1304 1351 m 24 6 d
- -21 15 d -23 -6 d f black 1304 1351 m 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c
- 1281 1304 m 23 6 d 54 Y -23 -6 d f black 1281 1304 m 23 6 d 54 Y -23 -6 d cl s
- 0.6 0.6 0.6 c 1260 1320 m 21 -16 d 54 Y -21 16 d f black 1260 1320 m 21 -16 d
- 54 Y -21 16 d cl s 1 1 1 c 1281 1358 m 23 6 d -20 16 d -24 -6 d f black 1281
- 1358 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1257 1298 m 24 6 d 14 Y -24 -6 d f
- black 1257 1298 m 24 6 d 14 Y -24 -6 d cl s 0.6 0.6 0.6 c 1237 1314 m 20 -16 d
- 14 Y -20 15 d f black 1237 1314 m 20 -16 d 14 Y -20 15 d cl s 1 1 1 c 1257 1312
- m 24 6 d -21 15 d -23 -6 d f black 1257 1312 m 24 6 d -21 15 d -23 -6 d cl s 1
- 1 1 c 1234 1292 m 23 6 d 81 Y -23 -6 d f black 1234 1292 m 23 6 d 81 Y -23 -6 d
- cl s 0.6 0.6 0.6 c 1213 1308 m 21 -16 d 81 Y -21 16 d f black 1213 1308 m 21
- -16 d 81 Y -21 16 d cl s 1 1 1 c 1234 1373 m 23 6 d -20 16 d -24 -6 d f black
- 1234 1373 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1210 1286 m 24 6 d 108 Y -24
- -6 d f black 1210 1286 m 24 6 d 108 Y -24 -6 d cl s 0.6 0.6 0.6 c 1190 1302 m
- 20 -16 d 108 Y -20 15 d f black 1190 1302 m 20 -16 d 108 Y -20 15 d cl s 1 1 1
- c 1210 1394 m 24 6 d -21 15 d -23 -6 d f black 1210 1394 m 24 6 d -21 15 d -23
- -6 d cl s 1 1 1 c 1187 1280 m 23 6 d 14 Y -23 -6 d f black 1187 1280 m 23 6 d
- 14 Y -23 -6 d cl s 0.6 0.6 0.6 c 1166 1296 m 21 -16 d 14 Y -21 15 d f black
- 1166 1296 m 21 -16 d 14 Y -21 15 d cl s 1 1 1 c 1187 1294 m 23 6 d -20 15 d -24
- -6 d f black 1187 1294 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1163 1274 m 24 6
- d 68 Y -24 -6 d f black 1163 1274 m 24 6 d 68 Y -24 -6 d cl s 0.6 0.6 0.6 c
- 1143 1290 m 20 -16 d 68 Y -20 15 d f black 1143 1290 m 20 -16 d 68 Y -20 15 d
- cl s 1 1 1 c 1163 1342 m 24 6 d -21 15 d -23 -6 d f black 1163 1342 m 24 6 d
- -21 15 d -23 -6 d cl s 1 1 1 c 1140 1269 m 23 5 d 54 Y -23 -6 d f black 1140
- 1269 m 23 5 d 54 Y -23 -6 d cl s 0.6 0.6 0.6 c 1119 1284 m 21 -15 d 53 Y -21 16
- d f black 1119 1284 m 21 -15 d 53 Y -21 16 d cl s 1 1 1 c 1140 1322 m 23 6 d
- -20 16 d -24 -6 d f black 1140 1322 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c
- 1116 1263 m 24 6 d 53 Y -24 -6 d f black 1116 1263 m 24 6 d 53 Y -24 -6 d cl s
- 0.6 0.6 0.6 c 1096 1278 m 20 -15 d 53 Y -20 16 d f black 1096 1278 m 20 -15 d
- 53 Y -20 16 d cl s 1 1 1 c 1116 1316 m 24 6 d -21 16 d -23 -6 d f black 1116
- 1316 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 1093 1257 m 23 6 d 40 Y -23 -6 d f
- black 1093 1257 m 23 6 d 40 Y -23 -6 d cl s 0.6 0.6 0.6 c 1073 1272 m 20 -15 d
- 40 Y -20 15 d f black 1073 1272 m 20 -15 d 40 Y -20 15 d cl s 1 1 1 c 1093 1297
- m 23 6 d -20 15 d -23 -6 d f black 1093 1297 m 23 6 d -20 15 d -23 -6 d cl s 1
- 1 1 c 1069 1251 m 24 6 d 107 Y -24 -6 d f black 1069 1251 m 24 6 d 107 Y -24 -6
- d cl s 0.6 0.6 0.6 c 1049 1266 m 20 -15 d 107 Y -20 16 d f black 1049 1266 m 20
- -15 d 107 Y -20 16 d cl s 1 1 1 c 1069 1358 m 24 6 d -20 16 d -24 -6 d f black
- 1069 1358 m 24 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1046 1245 m 23 6 d 40 Y -23
- -6 d f black 1046 1245 m 23 6 d 40 Y -23 -6 d cl s 0.6 0.6 0.6 c 1026 1260 m 20
- -15 d 40 Y -20 15 d f black 1026 1260 m 20 -15 d 40 Y -20 15 d cl s 1 1 1 c
- 1046 1285 m 23 6 d -20 15 d -23 -6 d f black 1046 1285 m 23 6 d -20 15 d -23 -6
- d cl s 1 1 1 c 1022 1239 m 24 6 d 26 Y -24 -6 d f black 1022 1239 m 24 6 d 26 Y
- -24 -6 d cl s 0.6 0.6 0.6 c 1002 1254 m 20 -15 d 26 Y -20 16 d f black 1002
- 1254 m 20 -15 d 26 Y -20 16 d cl s 1 1 1 c 1022 1265 m 24 6 d -20 16 d -24 -6 d
- f black 1022 1265 m 24 6 d -20 16 d -24 -6 d cl s 1 1 1 c 999 1233 m 23 6 d 53
- Y -23 -6 d f black 999 1233 m 23 6 d 53 Y -23 -6 d cl s 0.6 0.6 0.6 c 979 1248
- m 20 -15 d 53 Y -20 16 d f black 979 1248 m 20 -15 d 53 Y -20 16 d cl s 1 1 1 c
- 999 1286 m 23 6 d -20 16 d -23 -6 d f black 999 1286 m 23 6 d -20 16 d -23 -6 d
- cl s 1 1 1 c 975 1227 m 24 6 d 13 Y -24 -6 d f black 975 1227 m 24 6 d 13 Y -24
- -6 d cl s 0.6 0.6 0.6 c 955 1242 m 20 -15 d 13 Y -20 16 d f black 955 1242 m 20
- -15 d 13 Y -20 16 d cl s 1 1 1 c 975 1240 m 24 6 d -20 16 d -24 -6 d f black
- 975 1240 m 24 6 d -20 16 d -24 -6 d cl s 1 1 1 c 952 1221 m 23 6 d 67 Y -23 -6
- d f black 952 1221 m 23 6 d 67 Y -23 -6 d cl s 0.6 0.6 0.6 c 932 1236 m 20 -15
- d 67 Y -20 15 d f black 932 1236 m 20 -15 d 67 Y -20 15 d cl s 1 1 1 c 952 1288
- m 23 6 d -20 15 d -23 -6 d f black 952 1288 m 23 6 d -20 15 d -23 -6 d cl s 1 1
- 1 c 928 1215 m 24 6 d 67 Y -24 -6 d f black 928 1215 m 24 6 d 67 Y -24 -6 d
- cl s 0.6 0.6 0.6 c 908 1230 m 20 -15 d 67 Y -20 15 d f black 908 1230 m 20 -15
- d 67 Y -20 15 d cl s 1 1 1 c 928 1282 m 24 6 d -20 15 d -24 -6 d f black 928
- 1282 m 24 6 d -20 15 d -24 -6 d cl s 1 1 1 c 905 1209 m 23 6 d 67 Y -23 -6 d f
- black 905 1209 m 23 6 d 67 Y -23 -6 d cl s 0.6 0.6 0.6 c 885 1224 m 20 -15 d 67
- Y -20 15 d f black 885 1224 m 20 -15 d 67 Y -20 15 d cl s 1 1 1 c 905 1276 m 23
- 6 d -20 15 d -23 -6 d f black 905 1276 m 23 6 d -20 15 d -23 -6 d cl s 1 1 1 c
- 881 1203 m 24 6 d 27 Y -24 -6 d f black 881 1203 m 24 6 d 27 Y -24 -6 d cl s
- 0.6 0.6 0.6 c 861 1218 m 20 -15 d 27 Y -20 15 d f black 861 1218 m 20 -15 d 27
- Y -20 15 d cl s 1 1 1 c 881 1230 m 24 6 d -20 15 d -24 -6 d f black 881 1230 m
- 24 6 d -20 15 d -24 -6 d cl s 1 1 1 c 858 1197 m 23 6 d 53 Y -23 -6 d f black
- 858 1197 m 23 6 d 53 Y -23 -6 d cl s 0.6 0.6 0.6 c 838 1212 m 20 -15 d 53 Y -20
- 16 d f black 838 1212 m 20 -15 d 53 Y -20 16 d cl s 1 1 1 c 858 1250 m 23 6 d
- -20 16 d -23 -6 d f black 858 1250 m 23 6 d -20 16 d -23 -6 d cl s 1 1 1 c 834
- 1191 m 24 6 d 80 Y -24 -6 d f black 834 1191 m 24 6 d 80 Y -24 -6 d cl s 0.6
- 0.6 0.6 c 814 1206 m 20 -15 d 80 Y -20 16 d f black 814 1206 m 20 -15 d 80 Y
- -20 16 d cl s 1 1 1 c 834 1271 m 24 6 d -20 16 d -24 -6 d f black 834 1271 m 24
- 6 d -20 16 d -24 -6 d cl s 1 1 1 c 811 1185 m 23 6 d 94 Y -23 -6 d f black 811
- 1185 m 23 6 d 94 Y -23 -6 d cl s 0.6 0.6 0.6 c 791 1200 m 20 -15 d 94 Y -20 15
- d f black 791 1200 m 20 -15 d 94 Y -20 15 d cl s 1 1 1 c 811 1279 m 23 6 d -20
- 15 d -23 -6 d f black 811 1279 m 23 6 d -20 15 d -23 -6 d cl s 1 1 1 c 787 1179
- m 24 6 d 27 Y -24 -6 d f black 787 1179 m 24 6 d 27 Y -24 -6 d cl s 0.6 0.6 0.6
- c 767 1194 m 20 -15 d 27 Y -20 15 d f black 767 1194 m 20 -15 d 27 Y -20 15 d
- cl s 1 1 1 c 787 1206 m 24 6 d -20 15 d -24 -6 d f black 787 1206 m 24 6 d -20
- 15 d -24 -6 d cl s 1 1 1 c 764 1173 m 23 6 d 40 Y -23 -6 d f black 764 1173 m
- 23 6 d 40 Y -23 -6 d cl s 0.6 0.6 0.6 c 744 1188 m 20 -15 d 40 Y -20 16 d f
- black 744 1188 m 20 -15 d 40 Y -20 16 d cl s 1 1 1 c 764 1213 m 23 6 d -20 16 d
- -23 -6 d f black 764 1213 m 23 6 d -20 16 d -23 -6 d cl s 1 1 1 c 741 1167 m 23
- 6 d 27 Y -23 -6 d f black 741 1167 m 23 6 d 27 Y -23 -6 d cl s 0.6 0.6 0.6 c
- 720 1182 m 21 -15 d 27 Y -21 15 d f black 720 1182 m 21 -15 d 27 Y -21 15 d
- cl s 1 1 1 c 741 1194 m 23 6 d -20 15 d -24 -6 d f black 741 1194 m 23 6 d -20
- 15 d -24 -6 d cl s 1 1 1 c 717 1161 m 24 6 d 13 Y -24 -6 d f black 717 1161 m
- 24 6 d 13 Y -24 -6 d cl s 0.6 0.6 0.6 c 697 1176 m 20 -15 d 13 Y -20 16 d f
- black 697 1176 m 20 -15 d 13 Y -20 16 d cl s 1 1 1 c 717 1174 m 24 6 d -21 16 d
- -23 -6 d f black 717 1174 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 694 1155 m 23
- 6 d 94 Y -23 -6 d f black 694 1155 m 23 6 d 94 Y -23 -6 d cl s 0.6 0.6 0.6 c
- 673 1170 m 21 -15 d 94 Y -21 15 d f black 673 1170 m 21 -15 d 94 Y -21 15 d
- cl s 1 1 1 c 694 1249 m 23 6 d -20 15 d -24 -6 d f black 694 1249 m 23 6 d -20
- 15 d -24 -6 d cl s 1 1 1 c 670 1149 m 24 6 d 40 Y -24 -6 d f black 670 1149 m
- 24 6 d 40 Y -24 -6 d cl s 0.6 0.6 0.6 c 650 1164 m 20 -15 d 40 Y -20 16 d f
- black 650 1164 m 20 -15 d 40 Y -20 16 d cl s 1 1 1 c 670 1189 m 24 6 d -21 16 d
- -23 -6 d f black 670 1189 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 647 1143 m 23
- 6 d 54 Y -23 -6 d f black 647 1143 m 23 6 d 54 Y -23 -6 d cl s 0.6 0.6 0.6 c
- 626 1158 m 21 -15 d 54 Y -21 15 d f black 626 1158 m 21 -15 d 54 Y -21 15 d
- cl s 1 1 1 c 647 1197 m 23 6 d -20 15 d -24 -6 d f black 647 1197 m 23 6 d -20
- 15 d -24 -6 d cl s 1 1 1 c 623 1137 m 24 6 d 54 Y -24 -6 d f black 623 1137 m
- 24 6 d 54 Y -24 -6 d cl s 0.6 0.6 0.6 c 603 1152 m 20 -15 d 54 Y -20 15 d f
- black 603 1152 m 20 -15 d 54 Y -20 15 d cl s 1 1 1 c 623 1191 m 24 6 d -21 15 d
- -23 -6 d f black 623 1191 m 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 600 1131 m 23
- 6 d 27 Y -23 -6 d f black 600 1131 m 23 6 d 27 Y -23 -6 d cl s 0.6 0.6 0.6 c
- 579 1147 m 21 -16 d 27 Y -21 15 d f black 579 1147 m 21 -16 d 27 Y -21 15 d
- cl s 1 1 1 c 600 1158 m 23 6 d -20 15 d -24 -6 d f black 600 1158 m 23 6 d -20
- 15 d -24 -6 d cl s 1 1 1 c 576 1125 m 24 6 d 27 Y -24 -6 d f black 576 1125 m
- 24 6 d 27 Y -24 -6 d cl s 0.6 0.6 0.6 c 556 1141 m 20 -16 d 27 Y -20 15 d f
- black 556 1141 m 20 -16 d 27 Y -20 15 d cl s 1 1 1 c 576 1152 m 24 6 d -21 15 d
- -23 -6 d f black 576 1152 m 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 553 1119 m 23
- 6 d 40 Y -23 -6 d f black 553 1119 m 23 6 d 40 Y -23 -6 d cl s 0.6 0.6 0.6 c
- 532 1135 m 21 -16 d 40 Y -21 16 d f black 532 1135 m 21 -16 d 40 Y -21 16 d
- cl s 1 1 1 c 553 1159 m 23 6 d -20 16 d -24 -6 d f black 553 1159 m 23 6 d -20
- 16 d -24 -6 d cl s 1 1 1 c 529 1113 m 24 6 d 40 Y -24 -6 d f black 529 1113 m
- 24 6 d 40 Y -24 -6 d cl s 0.6 0.6 0.6 c 509 1129 m 20 -16 d 40 Y -20 16 d f
- black 509 1129 m 20 -16 d 40 Y -20 16 d cl s 1 1 1 c 529 1153 m 24 6 d -21 16 d
- -23 -6 d f black 529 1153 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 506 1107 m 23
- 6 d 54 Y -23 -6 d f black 506 1107 m 23 6 d 54 Y -23 -6 d cl s 0.6 0.6 0.6 c
- 485 1123 m 21 -16 d 54 Y -21 15 d f black 485 1123 m 21 -16 d 54 Y -21 15 d
- cl s 1 1 1 c 506 1161 m 23 6 d -20 15 d -24 -6 d f black 506 1161 m 23 6 d -20
- 15 d -24 -6 d cl s 1 1 1 c 482 1101 m 24 6 d 81 Y -24 -6 d f black 482 1101 m
- 24 6 d 81 Y -24 -6 d cl s 0.6 0.6 0.6 c 462 1117 m 20 -16 d 81 Y -20 15 d f
- black 462 1117 m 20 -16 d 81 Y -20 15 d cl s 1 1 1 c 482 1182 m 24 6 d -21 15 d
- -23 -6 d f black 482 1182 m 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 459 1095 m 23
- 6 d 14 Y -23 -6 d f black 459 1095 m 23 6 d 14 Y -23 -6 d cl s 0.6 0.6 0.6 c
- 438 1111 m 21 -16 d 14 Y -21 15 d f black 438 1111 m 21 -16 d 14 Y -21 15 d
- cl s 1 1 1 c 459 1109 m 23 6 d -20 15 d -24 -6 d f black 459 1109 m 23 6 d -20
- 15 d -24 -6 d cl s 1 1 1 c 435 1089 m 24 6 d -21 16 d -23 -6 d f black 435 1089
- m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 412 1083 m 23 6 d -20 16 d -24 -6 d f
- black 412 1083 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 388 1077 m 24 6 d -21 16
- d -23 -6 d f black 388 1077 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 365 1071 m
- 23 6 d -20 16 d -24 -6 d f black 365 1071 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1
- c 1489 1337 m 24 6 d -21 15 d -23 -6 d f black 1489 1337 m 24 6 d -21 15 d -23
- -6 d cl s 1 1 1 c 1466 1331 m 23 6 d -20 15 d -24 -6 d f black 1466 1331 m 23 6
- d -20 15 d -24 -6 d cl s 1 1 1 c 1442 1325 m 24 6 d -21 15 d -23 -6 d f black
- 1442 1325 m 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 1419 1319 m 23 6 d -20 15 d
- -24 -6 d f black 1419 1319 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1395 1313 m
- 24 6 d 53 Y -24 -5 d f black 1395 1313 m 24 6 d 53 Y -24 -5 d cl s 0.6 0.6 0.6
- c 1375 1328 m 20 -15 d 54 Y -20 15 d f black 1375 1328 m 20 -15 d 54 Y -20 15 d
- cl s 1 1 1 c 1395 1367 m 24 5 d -21 16 d -23 -6 d f black 1395 1367 m 24 5 d
- -21 16 d -23 -6 d cl s 1 1 1 c 1372 1307 m 23 6 d 54 Y -23 -6 d f black 1372
- 1307 m 23 6 d 54 Y -23 -6 d cl s 0.6 0.6 0.6 c 1351 1322 m 21 -15 d 54 Y -21 15
- d f black 1351 1322 m 21 -15 d 54 Y -21 15 d cl s 1 1 1 c 1372 1361 m 23 6 d
- -20 15 d -24 -6 d f black 1372 1361 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c
- 1348 1301 m 24 6 d 94 Y -24 -6 d f black 1348 1301 m 24 6 d 94 Y -24 -6 d cl s
- 0.6 0.6 0.6 c 1328 1316 m 20 -15 d 94 Y -20 15 d f black 1328 1316 m 20 -15 d
- 94 Y -20 15 d cl s 1 1 1 c 1348 1395 m 24 6 d -21 15 d -23 -6 d f black 1348
- 1395 m 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 1325 1295 m 23 6 d 94 Y -23 -6 d f
- black 1325 1295 m 23 6 d 94 Y -23 -6 d cl s 0.6 0.6 0.6 c 1304 1310 m 21 -15 d
- 94 Y -21 15 d f black 1304 1310 m 21 -15 d 94 Y -21 15 d cl s 1 1 1 c 1325 1389
- m 23 6 d -20 15 d -24 -6 d f black 1325 1389 m 23 6 d -20 15 d -24 -6 d cl s 1
- 1 1 c 1301 1289 m 24 6 d 27 Y -24 -6 d f black 1301 1289 m 24 6 d 27 Y -24 -6 d
- cl s 0.6 0.6 0.6 c 1281 1304 m 20 -15 d 27 Y -20 15 d f black 1281 1304 m 20
- -15 d 27 Y -20 15 d cl s 1 1 1 c 1301 1316 m 24 6 d -21 15 d -23 -6 d f black
- 1301 1316 m 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 1278 1283 m 23 6 d 94 Y -23
- -6 d f black 1278 1283 m 23 6 d 94 Y -23 -6 d cl s 0.6 0.6 0.6 c 1257 1298 m 21
- -15 d 94 Y -21 15 d f black 1257 1298 m 21 -15 d 94 Y -21 15 d cl s 1 1 1 c
- 1278 1377 m 23 6 d -20 15 d -24 -6 d f black 1278 1377 m 23 6 d -20 15 d -24 -6
- d cl s 1 1 1 c 1254 1277 m 24 6 d 107 Y -24 -6 d f black 1254 1277 m 24 6 d 107
- Y -24 -6 d cl s 0.6 0.6 0.6 c 1234 1292 m 20 -15 d 107 Y -20 16 d f black 1234
- 1292 m 20 -15 d 107 Y -20 16 d cl s 1 1 1 c 1254 1384 m 24 6 d -21 16 d -23 -6
- d f black 1254 1384 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 1231 1271 m 23 6 d
- 81 Y -23 -6 d f black 1231 1271 m 23 6 d 81 Y -23 -6 d cl s 0.6 0.6 0.6 c 1210
- 1286 m 21 -15 d 81 Y -21 15 d f black 1210 1286 m 21 -15 d 81 Y -21 15 d cl s 1
- 1 1 c 1231 1352 m 23 6 d -20 15 d -24 -6 d f black 1231 1352 m 23 6 d -20 15 d
- -24 -6 d cl s 1 1 1 c 1207 1265 m 24 6 d 81 Y -24 -6 d f black 1207 1265 m 24 6
- d 81 Y -24 -6 d cl s 0.6 0.6 0.6 c 1187 1280 m 20 -15 d 81 Y -20 15 d f black
- 1187 1280 m 20 -15 d 81 Y -20 15 d cl s 1 1 1 c 1207 1346 m 24 6 d -21 15 d -23
- -6 d f black 1207 1346 m 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 1184 1259 m 23 6
- d 81 Y -23 -6 d f black 1184 1259 m 23 6 d 81 Y -23 -6 d cl s 0.6 0.6 0.6 c
- 1163 1274 m 21 -15 d 81 Y -21 15 d f black 1163 1274 m 21 -15 d 81 Y -21 15 d
- cl s 1 1 1 c 1184 1340 m 23 6 d -20 15 d -24 -6 d f black 1184 1340 m 23 6 d
- -20 15 d -24 -6 d cl s 1 1 1 c 1160 1253 m 24 6 d 40 Y -24 -6 d f black 1160
- 1253 m 24 6 d 40 Y -24 -6 d cl s 0.6 0.6 0.6 c 1140 1269 m 20 -16 d 40 Y -20 16
- d f black 1140 1269 m 20 -16 d 40 Y -20 16 d cl s 1 1 1 c 1160 1293 m 24 6 d
- -21 16 d -23 -6 d f black 1160 1293 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c
- 1137 1247 m 23 6 d 54 Y -23 -6 d f black 1137 1247 m 23 6 d 54 Y -23 -6 d cl s
- 0.6 0.6 0.6 c 1116 1263 m 21 -16 d 54 Y -21 15 d f black 1116 1263 m 21 -16 d
- 54 Y -21 15 d cl s 1 1 1 c 1137 1301 m 23 6 d -20 15 d -24 -6 d f black 1137
- 1301 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1113 1241 m 24 6 d 54 Y -24 -6 d f
- black 1113 1241 m 24 6 d 54 Y -24 -6 d cl s 0.6 0.6 0.6 c 1093 1257 m 20 -16 d
- 54 Y -20 15 d f black 1093 1257 m 20 -16 d 54 Y -20 15 d cl s 1 1 1 c 1113 1295
- m 24 6 d -21 15 d -23 -6 d f black 1113 1295 m 24 6 d -21 15 d -23 -6 d cl s 1
- 1 1 c 1090 1235 m 23 6 d 134 Y -23 -6 d f black 1090 1235 m 23 6 d 134 Y -23 -6
- d cl s 0.6 0.6 0.6 c 1069 1251 m 21 -16 d 134 Y -21 16 d f black 1069 1251 m 21
- -16 d 134 Y -21 16 d cl s 1 1 1 c 1090 1369 m 23 6 d -20 16 d -24 -6 d f black
- 1090 1369 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1066 1229 m 24 6 d 94 Y -24
- -6 d f black 1066 1229 m 24 6 d 94 Y -24 -6 d cl s 0.6 0.6 0.6 c 1046 1245 m 20
- -16 d 94 Y -20 16 d f black 1046 1245 m 20 -16 d 94 Y -20 16 d cl s 1 1 1 c
- 1066 1323 m 24 6 d -21 16 d -23 -6 d f black 1066 1323 m 24 6 d -21 16 d -23 -6
- d cl s 1 1 1 c 1043 1223 m 23 6 d 54 Y -23 -6 d f black 1043 1223 m 23 6 d 54 Y
- -23 -6 d cl s 0.6 0.6 0.6 c 1022 1239 m 21 -16 d 54 Y -21 15 d f black 1022
- 1239 m 21 -16 d 54 Y -21 15 d cl s 1 1 1 c 1043 1277 m 23 6 d -20 15 d -24 -6 d
- f black 1043 1277 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1019 1217 m 24 6 d 81
- Y -24 -6 d f black 1019 1217 m 24 6 d 81 Y -24 -6 d cl s 0.6 0.6 0.6 c 999 1233
- m 20 -16 d 81 Y -20 15 d f black 999 1233 m 20 -16 d 81 Y -20 15 d cl s 1 1 1 c
- 1019 1298 m 24 6 d -21 15 d -23 -6 d f black 1019 1298 m 24 6 d -21 15 d -23 -6
- d cl s 1 1 1 c 996 1211 m 23 6 d 27 Y -23 -6 d f black 996 1211 m 23 6 d 27 Y
- -23 -6 d cl s 0.6 0.6 0.6 c 975 1227 m 21 -16 d 27 Y -21 16 d f black 975 1227
- m 21 -16 d 27 Y -21 16 d cl s 1 1 1 c 996 1238 m 23 6 d -20 15 d -24 -5 d f
- black 996 1238 m 23 6 d -20 15 d -24 -5 d cl s 1 1 1 c 972 1205 m 24 6 d 108 Y
- -24 -6 d f black 972 1205 m 24 6 d 108 Y -24 -6 d cl s 0.6 0.6 0.6 c 952 1221 m
- 20 -16 d 108 Y -20 15 d f black 952 1221 m 20 -16 d 108 Y -20 15 d cl s 1 1 1 c
- 972 1313 m 24 6 d -21 15 d -23 -6 d f black 972 1313 m 24 6 d -21 15 d -23 -6 d
- cl s 1 1 1 c 949 1199 m 23 6 d 108 Y -23 -6 d f black 949 1199 m 23 6 d 108 Y
- -23 -6 d cl s 0.6 0.6 0.6 c 928 1215 m 21 -16 d 108 Y -21 15 d f black 928 1215
- m 21 -16 d 108 Y -21 15 d cl s 1 1 1 c 949 1307 m 23 6 d -20 15 d -24 -6 d f
- black 949 1307 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 925 1193 m 24 6 d 121 Y
- -24 -6 d f black 925 1193 m 24 6 d 121 Y -24 -6 d cl s 0.6 0.6 0.6 c 905 1209 m
- 20 -16 d 121 Y -20 16 d f black 905 1209 m 20 -16 d 121 Y -20 16 d cl s 1 1 1 c
- 925 1314 m 24 6 d -21 16 d -23 -6 d f black 925 1314 m 24 6 d -21 16 d -23 -6 d
- cl s 1 1 1 c 902 1187 m 23 6 d 27 Y -23 -6 d f black 902 1187 m 23 6 d 27 Y -23
- -6 d cl s 0.6 0.6 0.6 c 881 1203 m 21 -16 d 27 Y -21 16 d f black 881 1203 m 21
- -16 d 27 Y -21 16 d cl s 1 1 1 c 902 1214 m 23 6 d -20 16 d -24 -6 d f black
- 902 1214 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 878 1181 m 24 6 d 67 Y -24 -6
- d f black 878 1181 m 24 6 d 67 Y -24 -6 d cl s 0.6 0.6 0.6 c 858 1197 m 20 -16
- d 67 Y -20 16 d f black 858 1197 m 20 -16 d 67 Y -20 16 d cl s 1 1 1 c 878 1248
- m 24 6 d -21 16 d -23 -6 d f black 878 1248 m 24 6 d -21 16 d -23 -6 d cl s 1 1
- 1 c 855 1175 m 23 6 d 27 Y -23 -6 d f black 855 1175 m 23 6 d 27 Y -23 -6 d
- cl s 0.6 0.6 0.6 c 834 1191 m 21 -16 d 27 Y -21 16 d f black 834 1191 m 21 -16
- d 27 Y -21 16 d cl s 1 1 1 c 855 1202 m 23 6 d -20 16 d -24 -6 d f black 855
- 1202 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 831 1169 m 24 6 d 41 Y -24 -6 d f
- black 831 1169 m 24 6 d 41 Y -24 -6 d cl s 0.6 0.6 0.6 c 811 1185 m 20 -16 d 41
- Y -20 15 d f black 811 1185 m 20 -16 d 41 Y -20 15 d cl s 1 1 1 c 831 1210 m 24
- 6 d -21 15 d -23 -6 d f black 831 1210 m 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c
- 808 1163 m 23 6 d 67 Y -23 -6 d f black 808 1163 m 23 6 d 67 Y -23 -6 d cl s
- 0.6 0.6 0.6 c 787 1179 m 21 -16 d 67 Y -21 16 d f black 787 1179 m 21 -16 d 67
- Y -21 16 d cl s 1 1 1 c 808 1230 m 23 6 d -20 16 d -24 -6 d f black 808 1230 m
- 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 784 1157 m 24 6 d 81 Y -24 -6 d f black
- 784 1157 m 24 6 d 81 Y -24 -6 d cl s 0.6 0.6 0.6 c 764 1173 m 20 -16 d 81 Y -20
- 15 d f black 764 1173 m 20 -16 d 81 Y -20 15 d cl s 1 1 1 c 784 1238 m 24 6 d
- -21 15 d -23 -6 d f black 784 1238 m 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 761
- 1151 m 23 6 d 81 Y -23 -6 d f black 761 1151 m 23 6 d 81 Y -23 -6 d cl s 0.6
- 0.6 0.6 c 741 1167 m 20 -16 d 81 Y -20 15 d f black 741 1167 m 20 -16 d 81 Y
- -20 15 d cl s 1 1 1 c 761 1232 m 23 6 d -20 15 d -23 -6 d f black 761 1232 m 23
- 6 d -20 15 d -23 -6 d cl s 1 1 1 c 737 1145 m 24 6 d 27 Y -24 -6 d f black 737
- 1145 m 24 6 d 27 Y -24 -6 d cl s 0.6 0.6 0.6 c 717 1161 m 20 -16 d 27 Y -20 16
- d f black 717 1161 m 20 -16 d 27 Y -20 16 d cl s 1 1 1 c 737 1172 m 24 6 d -20
- 16 d -24 -6 d f black 737 1172 m 24 6 d -20 16 d -24 -6 d cl s 1 1 1 c 714 1139
- m 23 6 d 41 Y -23 -6 d f black 714 1139 m 23 6 d 41 Y -23 -6 d cl s 0.6 0.6 0.6
- c 694 1155 m 20 -16 d 41 Y -20 15 d f black 694 1155 m 20 -16 d 41 Y -20 15 d
- cl s 1 1 1 c 714 1180 m 23 6 d -20 15 d -23 -6 d f black 714 1180 m 23 6 d -20
- 15 d -23 -6 d cl s 1 1 1 c 690 1133 m 24 6 d 81 Y -24 -6 d f black 690 1133 m
- 24 6 d 81 Y -24 -6 d cl s 0.6 0.6 0.6 c 670 1149 m 20 -16 d 81 Y -20 16 d f
- black 670 1149 m 20 -16 d 81 Y -20 16 d cl s 1 1 1 c 690 1214 m 24 6 d -20 16 d
- -24 -6 d f black 690 1214 m 24 6 d -20 16 d -24 -6 d cl s 1 1 1 c 667 1127 m 23
- 6 d 41 Y -23 -6 d f black 667 1127 m 23 6 d 41 Y -23 -6 d cl s 0.6 0.6 0.6 c
- 647 1143 m 20 -16 d 41 Y -20 15 d f black 647 1143 m 20 -16 d 41 Y -20 15 d
- cl s 1 1 1 c 667 1168 m 23 6 d -20 15 d -23 -6 d f black 667 1168 m 23 6 d -20
- 15 d -23 -6 d cl s 1 1 1 c 643 1121 m 24 6 d 54 Y -24 -6 d f black 643 1121 m
- 24 6 d 54 Y -24 -6 d cl s 0.6 0.6 0.6 c 623 1137 m 20 -16 d 54 Y -20 16 d f
- black 623 1137 m 20 -16 d 54 Y -20 16 d cl s 1 1 1 c 643 1175 m 24 6 d -20 16 d
- -24 -6 d f black 643 1175 m 24 6 d -20 16 d -24 -6 d cl s 1 1 1 c 620 1115 m 23
- 6 d 94 Y -23 -6 d f black 620 1115 m 23 6 d 94 Y -23 -6 d cl s 0.6 0.6 0.6 c
- 600 1131 m 20 -16 d 94 Y -20 16 d f black 600 1131 m 20 -16 d 94 Y -20 16 d
- cl s 1 1 1 c 620 1209 m 23 6 d -20 16 d -23 -6 d f black 620 1209 m 23 6 d -20
- 16 d -23 -6 d cl s 1 1 1 c 596 1109 m 24 6 d 108 Y -24 -6 d f black 596 1109 m
- 24 6 d 108 Y -24 -6 d cl s 0.6 0.6 0.6 c 576 1125 m 20 -16 d 108 Y -20 15 d f
- black 576 1125 m 20 -16 d 108 Y -20 15 d cl s 1 1 1 c 596 1217 m 24 6 d -20 15
- d -24 -6 d f black 596 1217 m 24 6 d -20 15 d -24 -6 d cl s 1 1 1 c 573 1103 m
- 23 6 d 68 Y -23 -6 d f black 573 1103 m 23 6 d 68 Y -23 -6 d cl s 0.6 0.6 0.6 c
- 553 1119 m 20 -16 d 68 Y -20 15 d f black 553 1119 m 20 -16 d 68 Y -20 15 d
- cl s 1 1 1 c 573 1171 m 23 6 d -20 15 d -23 -6 d f black 573 1171 m 23 6 d -20
- 15 d -23 -6 d cl s 1 1 1 c 549 1097 m 24 6 d 108 Y -24 -6 d f black 549 1097 m
- 24 6 d 108 Y -24 -6 d cl s 0.6 0.6 0.6 c 529 1113 m 20 -16 d 108 Y -20 16 d f
- black 529 1113 m 20 -16 d 108 Y -20 16 d cl s 1 1 1 c 549 1205 m 24 6 d -20 16
- d -24 -6 d f black 549 1205 m 24 6 d -20 16 d -24 -6 d cl s 1 1 1 c 526 1092 m
- 23 5 d 108 Y -23 -6 d f black 526 1092 m 23 5 d 108 Y -23 -6 d cl s 0.6 0.6 0.6
- c 506 1107 m 20 -15 d 107 Y -20 16 d f black 506 1107 m 20 -15 d 107 Y -20 16 d
- cl s 1 1 1 c 526 1199 m 23 6 d -20 16 d -23 -6 d f black 526 1199 m 23 6 d -20
- 16 d -23 -6 d cl s 1 1 1 c 502 1086 m 24 6 d 53 Y -24 -6 d f black 502 1086 m
- 24 6 d 53 Y -24 -6 d cl s 0.6 0.6 0.6 c 482 1101 m 20 -15 d 53 Y -20 16 d f
- black 482 1101 m 20 -15 d 53 Y -20 16 d cl s 1 1 1 c 502 1139 m 24 6 d -20 16 d
- -24 -6 d f black 502 1139 m 24 6 d -20 16 d -24 -6 d cl s 1 1 1 c 479 1080 m 23
- 6 d 94 Y -23 -6 d f black 479 1080 m 23 6 d 94 Y -23 -6 d cl s 0.6 0.6 0.6 c
- 459 1095 m 20 -15 d 94 Y -20 15 d f black 459 1095 m 20 -15 d 94 Y -20 15 d
- cl s 1 1 1 c 479 1174 m 23 6 d -20 15 d -23 -6 d f black 479 1174 m 23 6 d -20
- 15 d -23 -6 d cl s 1 1 1 c 456 1074 m 23 6 d -20 15 d -24 -6 d f black 456 1074
- m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 432 1068 m 24 6 d -21 15 d -23 -6 d f
- black 432 1068 m 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 409 1062 m 23 6 d -20 15
- d -24 -6 d f black 409 1062 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 385 1056 m
- 24 6 d -21 15 d -23 -6 d f black 385 1056 m 24 6 d -21 15 d -23 -6 d cl s 1 1 1
- c 1509 1321 m 24 6 d -20 16 d -24 -6 d f black 1509 1321 m 24 6 d -20 16 d -24
- -6 d cl s 1 1 1 c 1486 1315 m 23 6 d -20 16 d -23 -6 d f black 1486 1315 m 23 6
- d -20 16 d -23 -6 d cl s 1 1 1 c 1462 1309 m 24 6 d -20 16 d -24 -6 d f black
- 1462 1309 m 24 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1439 1303 m 23 6 d -20 16 d
- -23 -6 d f black 1439 1303 m 23 6 d -20 16 d -23 -6 d cl s 1 1 1 c 1415 1297 m
- 24 6 d 135 Y -24 -6 d f black 1415 1297 m 24 6 d 135 Y -24 -6 d cl s 0.6 0.6
- 0.6 c 1395 1313 m 20 -16 d 135 Y -20 15 d f black 1395 1313 m 20 -16 d 135 Y
- -20 15 d cl s 1 1 1 c 1415 1432 m 24 6 d -20 15 d -24 -6 d f black 1415 1432 m
- 24 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1392 1291 m 23 6 d 148 Y -23 -6 d f black
- 1392 1291 m 23 6 d 148 Y -23 -6 d cl s 0.6 0.6 0.6 c 1372 1307 m 20 -16 d 148 Y
- -20 16 d f black 1372 1307 m 20 -16 d 148 Y -20 16 d cl s 1 1 1 c 1392 1439 m
- 23 6 d -20 16 d -23 -6 d f black 1392 1439 m 23 6 d -20 16 d -23 -6 d cl s 1 1
- 1 c 1368 1285 m 24 6 d 135 Y -24 -6 d f black 1368 1285 m 24 6 d 135 Y -24 -6 d
- cl s 0.6 0.6 0.6 c 1348 1301 m 20 -16 d 135 Y -20 15 d f black 1348 1301 m 20
- -16 d 135 Y -20 15 d cl s 1 1 1 c 1368 1420 m 24 6 d -20 15 d -24 -6 d f black
- 1368 1420 m 24 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1345 1279 m 23 6 d 121 Y -23
- -6 d f black 1345 1279 m 23 6 d 121 Y -23 -6 d cl s 0.6 0.6 0.6 c 1325 1295 m
- 20 -16 d 121 Y -20 16 d f black 1325 1295 m 20 -16 d 121 Y -20 16 d cl s 1 1 1
- c 1345 1400 m 23 6 d -20 16 d -23 -6 d f black 1345 1400 m 23 6 d -20 16 d -23
- -6 d cl s 1 1 1 c 1321 1273 m 24 6 d 162 Y -24 -6 d f black 1321 1273 m 24 6 d
- 162 Y -24 -6 d cl s 0.6 0.6 0.6 c 1301 1289 m 20 -16 d 162 Y -20 15 d f black
- 1301 1289 m 20 -16 d 162 Y -20 15 d cl s 1 1 1 c 1321 1435 m 24 6 d -20 15 d
- -24 -6 d f black 1321 1435 m 24 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1298 1267 m
- 23 6 d 41 Y -23 -6 d f black 1298 1267 m 23 6 d 41 Y -23 -6 d cl s 0.6 0.6 0.6
- c 1278 1283 m 20 -16 d 41 Y -20 15 d f black 1278 1283 m 20 -16 d 41 Y -20 15 d
- cl s 1 1 1 c 1298 1308 m 23 6 d -20 15 d -23 -6 d f black 1298 1308 m 23 6 d
- -20 15 d -23 -6 d cl s 1 1 1 c 1274 1261 m 24 6 d 41 Y -24 -6 d f black 1274
- 1261 m 24 6 d 41 Y -24 -6 d cl s 0.6 0.6 0.6 c 1254 1277 m 20 -16 d 41 Y -20 15
- d f black 1254 1277 m 20 -16 d 41 Y -20 15 d cl s 1 1 1 c 1274 1302 m 24 6 d
- -20 15 d -24 -6 d f black 1274 1302 m 24 6 d -20 15 d -24 -6 d cl s 1 1 1 c
- 1251 1255 m 23 6 d 121 Y -23 -6 d f black 1251 1255 m 23 6 d 121 Y -23 -6 d
- cl s 0.6 0.6 0.6 c 1231 1271 m 20 -16 d 121 Y -20 16 d f black 1231 1271 m 20
- -16 d 121 Y -20 16 d cl s 1 1 1 c 1251 1376 m 23 6 d -20 16 d -23 -6 d f black
- 1251 1376 m 23 6 d -20 16 d -23 -6 d cl s 1 1 1 c 1227 1249 m 24 6 d 135 Y -24
- -6 d f black 1227 1249 m 24 6 d 135 Y -24 -6 d cl s 0.6 0.6 0.6 c 1207 1265 m
- 20 -16 d 135 Y -20 15 d f black 1207 1265 m 20 -16 d 135 Y -20 15 d cl s 1 1 1
- c 1227 1384 m 24 6 d -20 15 d -24 -6 d f black 1227 1384 m 24 6 d -20 15 d -24
- -6 d cl s 1 1 1 c 1204 1243 m 23 6 d 94 Y -23 -6 d f black 1204 1243 m 23 6 d
- 94 Y -23 -6 d cl s 0.6 0.6 0.6 c 1184 1259 m 20 -16 d 94 Y -20 16 d f black
- 1184 1259 m 20 -16 d 94 Y -20 16 d cl s 1 1 1 c 1204 1337 m 23 6 d -20 16 d -23
- -6 d f black 1204 1337 m 23 6 d -20 16 d -23 -6 d cl s 1 1 1 c 1181 1237 m 23 6
- d 121 Y -23 -6 d f black 1181 1237 m 23 6 d 121 Y -23 -6 d cl s 0.6 0.6 0.6 c
- 1160 1253 m 21 -16 d 121 Y -21 16 d f black 1160 1253 m 21 -16 d 121 Y -21 16 d
- cl s 1 1 1 c 1181 1358 m 23 6 d -20 16 d -24 -6 d f black 1181 1358 m 23 6 d
- -20 16 d -24 -6 d cl s 1 1 1 c 1157 1231 m 24 6 d 81 Y -24 -6 d f black 1157
- 1231 m 24 6 d 81 Y -24 -6 d cl s 0.6 0.6 0.6 c 1137 1247 m 20 -16 d 81 Y -20 16
- d f black 1137 1247 m 20 -16 d 81 Y -20 16 d cl s 1 1 1 c 1157 1312 m 24 6 d
- -21 16 d -23 -6 d f black 1157 1312 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c
- 1134 1225 m 23 6 d 27 Y -23 -6 d f black 1134 1225 m 23 6 d 27 Y -23 -6 d cl s
- 0.6 0.6 0.6 c 1113 1241 m 21 -16 d 27 Y -21 16 d f black 1113 1241 m 21 -16 d
- 27 Y -21 16 d cl s 1 1 1 c 1134 1252 m 23 6 d -20 16 d -24 -6 d f black 1134
- 1252 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1110 1219 m 24 6 d 81 Y -24 -6 d f
- black 1110 1219 m 24 6 d 81 Y -24 -6 d cl s 0.6 0.6 0.6 c 1090 1235 m 20 -16 d
- 81 Y -20 16 d f black 1090 1235 m 20 -16 d 81 Y -20 16 d cl s 1 1 1 c 1110 1300
- m 24 6 d -21 16 d -23 -6 d f black 1110 1300 m 24 6 d -21 16 d -23 -6 d cl s 1
- 1 1 c 1087 1214 m 23 5 d 95 Y -23 -6 d f black 1087 1214 m 23 5 d 95 Y -23 -6 d
- cl s 0.6 0.6 0.6 c 1066 1229 m 21 -15 d 94 Y -21 15 d f black 1066 1229 m 21
- -15 d 94 Y -21 15 d cl s 1 1 1 c 1087 1308 m 23 6 d -20 15 d -24 -6 d f black
- 1087 1308 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1063 1208 m 24 6 d 201 Y -24
- -6 d f black 1063 1208 m 24 6 d 201 Y -24 -6 d cl s 0.6 0.6 0.6 c 1043 1223 m
- 20 -15 d 201 Y -20 16 d f black 1043 1223 m 20 -15 d 201 Y -20 16 d cl s 1 1 1
- c 1063 1409 m 24 6 d -21 16 d -23 -6 d f black 1063 1409 m 24 6 d -21 16 d -23
- -6 d cl s 1 1 1 c 1040 1202 m 23 6 d 80 Y -23 -6 d f black 1040 1202 m 23 6 d
- 80 Y -23 -6 d cl s 0.6 0.6 0.6 c 1019 1217 m 21 -15 d 80 Y -21 16 d f black
- 1019 1217 m 21 -15 d 80 Y -21 16 d cl s 1 1 1 c 1040 1282 m 23 6 d -20 16 d -24
- -6 d f black 1040 1282 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1016 1196 m 24 6
- d 161 Y -24 -6 d f black 1016 1196 m 24 6 d 161 Y -24 -6 d cl s 0.6 0.6 0.6 c
- 996 1211 m 20 -15 d 161 Y -20 15 d f black 996 1211 m 20 -15 d 161 Y -20 15 d
- cl s 1 1 1 c 1016 1357 m 24 6 d -21 15 d -23 -6 d f black 1016 1357 m 24 6 d
- -21 15 d -23 -6 d cl s 1 1 1 c 993 1190 m 23 6 d 134 Y -23 -6 d f black 993
- 1190 m 23 6 d 134 Y -23 -6 d cl s 0.6 0.6 0.6 c 972 1205 m 21 -15 d 134 Y -21
- 15 d f black 972 1205 m 21 -15 d 134 Y -21 15 d cl s 1 1 1 c 993 1324 m 23 6 d
- -20 15 d -24 -6 d f black 993 1324 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 969
- 1184 m 24 6 d 67 Y -24 -6 d f black 969 1184 m 24 6 d 67 Y -24 -6 d cl s 0.6
- 0.6 0.6 c 949 1199 m 20 -15 d 67 Y -20 15 d f black 949 1199 m 20 -15 d 67 Y
- -20 15 d cl s 1 1 1 c 969 1251 m 24 6 d -21 15 d -23 -6 d f black 969 1251 m 24
- 6 d -21 15 d -23 -6 d cl s 1 1 1 c 946 1178 m 23 6 d 80 Y -23 -6 d f black 946
- 1178 m 23 6 d 80 Y -23 -6 d cl s 0.6 0.6 0.6 c 925 1193 m 21 -15 d 80 Y -21 16
- d f black 925 1193 m 21 -15 d 80 Y -21 16 d cl s 1 1 1 c 946 1258 m 23 6 d -20
- 16 d -24 -6 d f black 946 1258 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 922 1172
- m 24 6 d 147 Y -24 -6 d f black 922 1172 m 24 6 d 147 Y -24 -6 d cl s 0.6 0.6
- 0.6 c 902 1187 m 20 -15 d 147 Y -20 16 d f black 902 1187 m 20 -15 d 147 Y -20
- 16 d cl s 1 1 1 c 922 1319 m 24 6 d -21 16 d -23 -6 d f black 922 1319 m 24 6 d
- -21 16 d -23 -6 d cl s 1 1 1 c 899 1166 m 23 6 d 134 Y -23 -6 d f black 899
- 1166 m 23 6 d 134 Y -23 -6 d cl s 0.6 0.6 0.6 c 878 1181 m 21 -15 d 134 Y -21
- 16 d f black 878 1181 m 21 -15 d 134 Y -21 16 d cl s 1 1 1 c 899 1300 m 23 6 d
- -20 16 d -24 -6 d f black 899 1300 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 875
- 1160 m 24 6 d 80 Y -24 -6 d f black 875 1160 m 24 6 d 80 Y -24 -6 d cl s 0.6
- 0.6 0.6 c 855 1175 m 20 -15 d 80 Y -20 16 d f black 855 1175 m 20 -15 d 80 Y
- -20 16 d cl s 1 1 1 c 875 1240 m 24 6 d -21 16 d -23 -6 d f black 875 1240 m 24
- 6 d -21 16 d -23 -6 d cl s 1 1 1 c 852 1154 m 23 6 d 228 Y -23 -6 d f black 852
- 1154 m 23 6 d 228 Y -23 -6 d cl s 0.6 0.6 0.6 c 831 1169 m 21 -15 d 228 Y -21
- 16 d f black 831 1169 m 21 -15 d 228 Y -21 16 d cl s 1 1 1 c 852 1382 m 23 6 d
- -20 16 d -24 -6 d f black 852 1382 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 828
- 1148 m 24 6 d 188 Y -24 -6 d f black 828 1148 m 24 6 d 188 Y -24 -6 d cl s 0.6
- 0.6 0.6 c 808 1163 m 20 -15 d 188 Y -20 15 d f black 808 1163 m 20 -15 d 188 Y
- -20 15 d cl s 1 1 1 c 828 1336 m 24 6 d -21 15 d -23 -6 d f black 828 1336 m 24
- 6 d -21 15 d -23 -6 d cl s 1 1 1 c 805 1142 m 23 6 d 188 Y -23 -6 d f black 805
- 1142 m 23 6 d 188 Y -23 -6 d cl s 0.6 0.6 0.6 c 784 1157 m 21 -15 d 188 Y -21
- 15 d f black 784 1157 m 21 -15 d 188 Y -21 15 d cl s 1 1 1 c 805 1330 m 23 6 d
- -20 15 d -24 -6 d f black 805 1330 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 781
- 1136 m 24 6 d 161 Y -24 -6 d f black 781 1136 m 24 6 d 161 Y -24 -6 d cl s 0.6
- 0.6 0.6 c 761 1151 m 20 -15 d 161 Y -20 16 d f black 761 1151 m 20 -15 d 161 Y
- -20 16 d cl s 1 1 1 c 781 1297 m 24 6 d -21 16 d -23 -6 d f black 781 1297 m 24
- 6 d -21 16 d -23 -6 d cl s 1 1 1 c 758 1130 m 23 6 d 148 Y -23 -6 d f black 758
- 1130 m 23 6 d 148 Y -23 -6 d cl s 0.6 0.6 0.6 c 737 1145 m 21 -15 d 148 Y -21
- 15 d f black 737 1145 m 21 -15 d 148 Y -21 15 d cl s 1 1 1 c 758 1278 m 23 6 d
- -20 15 d -24 -6 d f black 758 1278 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 734
- 1124 m 24 6 d 121 Y -24 -6 d f black 734 1124 m 24 6 d 121 Y -24 -6 d cl s 0.6
- 0.6 0.6 c 714 1139 m 20 -15 d 121 Y -20 15 d f black 714 1139 m 20 -15 d 121 Y
- -20 15 d cl s 1 1 1 c 734 1245 m 24 6 d -21 15 d -23 -6 d f black 734 1245 m 24
- 6 d -21 15 d -23 -6 d cl s 1 1 1 c 711 1118 m 23 6 d 174 Y -23 -5 d f black 711
- 1118 m 23 6 d 174 Y -23 -5 d cl s 0.6 0.6 0.6 c 690 1133 m 21 -15 d 175 Y -21
- 15 d f black 690 1133 m 21 -15 d 175 Y -21 15 d cl s 1 1 1 c 711 1293 m 23 5 d
- -20 16 d -24 -6 d f black 711 1293 m 23 5 d -20 16 d -24 -6 d cl s 1 1 1 c 687
- 1112 m 24 6 d 215 Y -24 -6 d f black 687 1112 m 24 6 d 215 Y -24 -6 d cl s 0.6
- 0.6 0.6 c 667 1127 m 20 -15 d 215 Y -20 15 d f black 667 1127 m 20 -15 d 215 Y
- -20 15 d cl s 1 1 1 c 687 1327 m 24 6 d -21 15 d -23 -6 d f black 687 1327 m 24
- 6 d -21 15 d -23 -6 d cl s 1 1 1 c 664 1106 m 23 6 d 148 Y -23 -6 d f black 664
- 1106 m 23 6 d 148 Y -23 -6 d cl s 0.6 0.6 0.6 c 643 1121 m 21 -15 d 148 Y -21
- 15 d f black 643 1121 m 21 -15 d 148 Y -21 15 d cl s 1 1 1 c 664 1254 m 23 6 d
- -20 15 d -24 -6 d f black 664 1254 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 640
- 1100 m 24 6 d 148 Y -24 -6 d f black 640 1100 m 24 6 d 148 Y -24 -6 d cl s 0.6
- 0.6 0.6 c 620 1115 m 20 -15 d 148 Y -20 15 d f black 620 1115 m 20 -15 d 148 Y
- -20 15 d cl s 1 1 1 c 640 1248 m 24 6 d -21 15 d -23 -6 d f black 640 1248 m 24
- 6 d -21 15 d -23 -6 d cl s 1 1 1 c 617 1094 m 23 6 d 94 Y -23 -6 d f black 617
- 1094 m 23 6 d 94 Y -23 -6 d cl s 0.6 0.6 0.6 c 596 1109 m 21 -15 d 94 Y -21 16
- d f black 596 1109 m 21 -15 d 94 Y -21 16 d cl s 1 1 1 c 617 1188 m 23 6 d -20
- 15 d -24 -5 d f black 617 1188 m 23 6 d -20 15 d -24 -5 d cl s 1 1 1 c 593 1088
- m 24 6 d 161 Y -24 -6 d f black 593 1088 m 24 6 d 161 Y -24 -6 d cl s 0.6 0.6
- 0.6 c 573 1103 m 20 -15 d 161 Y -20 16 d f black 573 1103 m 20 -15 d 161 Y -20
- 16 d cl s 1 1 1 c 593 1249 m 24 6 d -21 16 d -23 -6 d f black 593 1249 m 24 6 d
- -21 16 d -23 -6 d cl s 1 1 1 c 570 1082 m 23 6 d 67 Y -23 -6 d f black 570 1082
- m 23 6 d 67 Y -23 -6 d cl s 0.6 0.6 0.6 c 549 1097 m 21 -15 d 67 Y -21 16 d f
- black 549 1097 m 21 -15 d 67 Y -21 16 d cl s 1 1 1 c 570 1149 m 23 6 d -20 16 d
- -24 -6 d f black 570 1149 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 546 1076 m 24
- 6 d 94 Y -24 -6 d f black 546 1076 m 24 6 d 94 Y -24 -6 d cl s 0.6 0.6 0.6 c
- 526 1092 m 20 -16 d 94 Y -20 16 d f black 526 1092 m 20 -16 d 94 Y -20 16 d
- cl s 1 1 1 c 546 1170 m 24 6 d -21 16 d -23 -6 d f black 546 1170 m 24 6 d -21
- 16 d -23 -6 d cl s 1 1 1 c 523 1070 m 23 6 d 121 Y -23 -6 d f black 523 1070 m
- 23 6 d 121 Y -23 -6 d cl s 0.6 0.6 0.6 c 502 1086 m 21 -16 d 121 Y -21 15 d f
- black 502 1086 m 21 -16 d 121 Y -21 15 d cl s 1 1 1 c 523 1191 m 23 6 d -20 15
- d -24 -6 d f black 523 1191 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 499 1064 m
- 24 6 d 148 Y -24 -6 d f black 499 1064 m 24 6 d 148 Y -24 -6 d cl s 0.6 0.6 0.6
- c 479 1080 m 20 -16 d 148 Y -20 15 d f black 479 1080 m 20 -16 d 148 Y -20 15 d
- cl s 1 1 1 c 499 1212 m 24 6 d -21 15 d -23 -6 d f black 499 1212 m 24 6 d -21
- 15 d -23 -6 d cl s 1 1 1 c 476 1058 m 23 6 d -20 16 d -23 -6 d f black 476 1058
- m 23 6 d -20 16 d -23 -6 d cl s 1 1 1 c 452 1052 m 24 6 d -20 16 d -24 -6 d f
- black 452 1052 m 24 6 d -20 16 d -24 -6 d cl s 1 1 1 c 429 1046 m 23 6 d -20 16
- d -23 -6 d f black 429 1046 m 23 6 d -20 16 d -23 -6 d cl s 1 1 1 c 405 1040 m
- 24 6 d -20 16 d -24 -6 d f black 405 1040 m 24 6 d -20 16 d -24 -6 d cl s 1 1 1
- c 1530 1306 m 23 6 d -20 15 d -24 -6 d f black 1530 1306 m 23 6 d -20 15 d -24
- -6 d cl s 1 1 1 c 1506 1300 m 24 6 d -21 15 d -23 -6 d f black 1506 1300 m 24 6
- d -21 15 d -23 -6 d cl s 1 1 1 c 1483 1294 m 23 6 d -20 15 d -24 -6 d f black
- 1483 1294 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1459 1288 m 24 6 d -21 15 d
- -23 -6 d f black 1459 1288 m 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 1436 1282 m
- 23 6 d 295 Y -23 -6 d f black 1436 1282 m 23 6 d 295 Y -23 -6 d cl s 0.6 0.6
- 0.6 c 1415 1297 m 21 -15 d 295 Y -21 16 d f black 1415 1297 m 21 -15 d 295 Y
- -21 16 d cl s 1 1 1 c 1436 1577 m 23 6 d -20 16 d -24 -6 d f black 1436 1577 m
- 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1412 1276 m 24 6 d 188 Y -24 -6 d f black
- 1412 1276 m 24 6 d 188 Y -24 -6 d cl s 0.6 0.6 0.6 c 1392 1291 m 20 -15 d 188 Y
- -20 15 d f black 1392 1291 m 20 -15 d 188 Y -20 15 d cl s 1 1 1 c 1412 1464 m
- 24 6 d -21 15 d -23 -6 d f black 1412 1464 m 24 6 d -21 15 d -23 -6 d cl s 1 1
- 1 c 1389 1270 m 23 6 d 268 Y -23 -6 d f black 1389 1270 m 23 6 d 268 Y -23 -6 d
- cl s 0.6 0.6 0.6 c 1368 1285 m 21 -15 d 268 Y -21 16 d f black 1368 1285 m 21
- -15 d 268 Y -21 16 d cl s 1 1 1 c 1389 1538 m 23 6 d -20 16 d -24 -6 d f black
- 1389 1538 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1365 1264 m 24 6 d 161 Y -24
- -6 d f black 1365 1264 m 24 6 d 161 Y -24 -6 d cl s 0.6 0.6 0.6 c 1345 1279 m
- 20 -15 d 161 Y -20 16 d f black 1345 1279 m 20 -15 d 161 Y -20 16 d cl s 1 1 1
- c 1365 1425 m 24 6 d -21 16 d -23 -6 d f black 1365 1425 m 24 6 d -21 16 d -23
- -6 d cl s 1 1 1 c 1342 1258 m 23 6 d 94 Y -23 -6 d f black 1342 1258 m 23 6 d
- 94 Y -23 -6 d cl s 0.6 0.6 0.6 c 1321 1273 m 21 -15 d 94 Y -21 15 d f black
- 1321 1273 m 21 -15 d 94 Y -21 15 d cl s 1 1 1 c 1342 1352 m 23 6 d -20 15 d -24
- -6 d f black 1342 1352 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1318 1252 m 24 6
- d 121 Y -24 -6 d f black 1318 1252 m 24 6 d 121 Y -24 -6 d cl s 0.6 0.6 0.6 c
- 1298 1267 m 20 -15 d 121 Y -20 15 d f black 1298 1267 m 20 -15 d 121 Y -20 15 d
- cl s 1 1 1 c 1318 1373 m 24 6 d -21 15 d -23 -6 d f black 1318 1373 m 24 6 d
- -21 15 d -23 -6 d cl s 1 1 1 c 1295 1246 m 23 6 d 174 Y -23 -6 d f black 1295
- 1246 m 23 6 d 174 Y -23 -6 d cl s 0.6 0.6 0.6 c 1274 1261 m 21 -15 d 174 Y -21
- 16 d f black 1274 1261 m 21 -15 d 174 Y -21 16 d cl s 1 1 1 c 1295 1420 m 23 6
- d -20 16 d -24 -6 d f black 1295 1420 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c
- 1271 1240 m 24 6 d 255 Y -24 -6 d f black 1271 1240 m 24 6 d 255 Y -24 -6 d
- cl s 0.6 0.6 0.6 c 1251 1255 m 20 -15 d 255 Y -20 16 d f black 1251 1255 m 20
- -15 d 255 Y -20 16 d cl s 1 1 1 c 1271 1495 m 24 6 d -21 16 d -23 -6 d f black
- 1271 1495 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 1248 1234 m 23 6 d 215 Y -23
- -6 d f black 1248 1234 m 23 6 d 215 Y -23 -6 d cl s 0.6 0.6 0.6 c 1227 1249 m
- 21 -15 d 215 Y -21 15 d f black 1227 1249 m 21 -15 d 215 Y -21 15 d cl s 1 1 1
- c 1248 1449 m 23 6 d -20 15 d -24 -6 d f black 1248 1449 m 23 6 d -20 15 d -24
- -6 d cl s 1 1 1 c 1224 1228 m 24 6 d 188 Y -24 -6 d f black 1224 1228 m 24 6 d
- 188 Y -24 -6 d cl s 0.6 0.6 0.6 c 1204 1243 m 20 -15 d 188 Y -20 16 d f black
- 1204 1243 m 20 -15 d 188 Y -20 16 d cl s 1 1 1 c 1224 1416 m 24 6 d -21 15 d
- -23 -5 d f black 1224 1416 m 24 6 d -21 15 d -23 -5 d cl s 1 1 1 c 1201 1222 m
- 23 6 d 121 Y -23 -6 d f black 1201 1222 m 23 6 d 121 Y -23 -6 d cl s 0.6 0.6
- 0.6 c 1181 1237 m 20 -15 d 121 Y -20 15 d f black 1181 1237 m 20 -15 d 121 Y
- -20 15 d cl s 1 1 1 c 1201 1343 m 23 6 d -20 15 d -23 -6 d f black 1201 1343 m
- 23 6 d -20 15 d -23 -6 d cl s 1 1 1 c 1177 1216 m 24 6 d 161 Y -24 -6 d f black
- 1177 1216 m 24 6 d 161 Y -24 -6 d cl s 0.6 0.6 0.6 c 1157 1231 m 20 -15 d 161 Y
- -20 16 d f black 1157 1231 m 20 -15 d 161 Y -20 16 d cl s 1 1 1 c 1177 1377 m
- 24 6 d -20 16 d -24 -6 d f black 1177 1377 m 24 6 d -20 16 d -24 -6 d cl s 1 1
- 1 c 1154 1210 m 23 6 d 148 Y -23 -6 d f black 1154 1210 m 23 6 d 148 Y -23 -6 d
- cl s 0.6 0.6 0.6 c 1134 1225 m 20 -15 d 148 Y -20 15 d f black 1134 1225 m 20
- -15 d 148 Y -20 15 d cl s 1 1 1 c 1154 1358 m 23 6 d -20 15 d -23 -6 d f black
- 1154 1358 m 23 6 d -20 15 d -23 -6 d cl s 1 1 1 c 1130 1204 m 24 6 d 201 Y -24
- -6 d f black 1130 1204 m 24 6 d 201 Y -24 -6 d cl s 0.6 0.6 0.6 c 1110 1219 m
- 20 -15 d 201 Y -20 16 d f black 1110 1219 m 20 -15 d 201 Y -20 16 d cl s 1 1 1
- c 1130 1405 m 24 6 d -20 16 d -24 -6 d f black 1130 1405 m 24 6 d -20 16 d -24
- -6 d cl s 1 1 1 c 1107 1198 m 23 6 d 215 Y -23 -6 d f black 1107 1198 m 23 6 d
- 215 Y -23 -6 d cl s 0.6 0.6 0.6 c 1087 1214 m 20 -16 d 215 Y -20 15 d f black
- 1087 1214 m 20 -16 d 215 Y -20 15 d cl s 1 1 1 c 1107 1413 m 23 6 d -20 15 d
- -23 -6 d f black 1107 1413 m 23 6 d -20 15 d -23 -6 d cl s 1 1 1 c 1083 1192 m
- 24 6 d 175 Y -24 -6 d f black 1083 1192 m 24 6 d 175 Y -24 -6 d cl s 0.6 0.6
- 0.6 c 1063 1208 m 20 -16 d 175 Y -20 15 d f black 1063 1208 m 20 -16 d 175 Y
- -20 15 d cl s 1 1 1 c 1083 1367 m 24 6 d -20 15 d -24 -6 d f black 1083 1367 m
- 24 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1060 1186 m 23 6 d 202 Y -23 -6 d f black
- 1060 1186 m 23 6 d 202 Y -23 -6 d cl s 0.6 0.6 0.6 c 1040 1202 m 20 -16 d 202 Y
- -20 15 d f black 1040 1202 m 20 -16 d 202 Y -20 15 d cl s 1 1 1 c 1060 1388 m
- 23 6 d -20 15 d -23 -6 d f black 1060 1388 m 23 6 d -20 15 d -23 -6 d cl s 1 1
- 1 c 1036 1180 m 24 6 d 175 Y -24 -6 d f black 1036 1180 m 24 6 d 175 Y -24 -6 d
- cl s 0.6 0.6 0.6 c 1016 1196 m 20 -16 d 175 Y -20 15 d f black 1016 1196 m 20
- -16 d 175 Y -20 15 d cl s 1 1 1 c 1036 1355 m 24 6 d -20 15 d -24 -6 d f black
- 1036 1355 m 24 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1013 1174 m 23 6 d 175 Y -23
- -6 d f black 1013 1174 m 23 6 d 175 Y -23 -6 d cl s 0.6 0.6 0.6 c 993 1190 m 20
- -16 d 175 Y -20 15 d f black 993 1190 m 20 -16 d 175 Y -20 15 d cl s 1 1 1 c
- 1013 1349 m 23 6 d -20 15 d -23 -6 d f black 1013 1349 m 23 6 d -20 15 d -23 -6
- d cl s 1 1 1 c 989 1168 m 24 6 d 148 Y -24 -6 d f black 989 1168 m 24 6 d 148 Y
- -24 -6 d cl s 0.6 0.6 0.6 c 969 1184 m 20 -16 d 148 Y -20 15 d f black 969 1184
- m 20 -16 d 148 Y -20 15 d cl s 1 1 1 c 989 1316 m 24 6 d -20 15 d -24 -6 d f
- black 989 1316 m 24 6 d -20 15 d -24 -6 d cl s 1 1 1 c 966 1162 m 23 6 d 255 Y
- -23 -6 d f black 966 1162 m 23 6 d 255 Y -23 -6 d cl s 0.6 0.6 0.6 c 946 1178 m
- 20 -16 d 255 Y -20 16 d f black 946 1178 m 20 -16 d 255 Y -20 16 d cl s 1 1 1 c
- 966 1417 m 23 6 d -20 16 d -23 -6 d f black 966 1417 m 23 6 d -20 16 d -23 -6 d
- cl s 1 1 1 c 942 1156 m 24 6 d 202 Y -24 -6 d f black 942 1156 m 24 6 d 202 Y
- -24 -6 d cl s 0.6 0.6 0.6 c 922 1172 m 20 -16 d 202 Y -20 15 d f black 922 1172
- m 20 -16 d 202 Y -20 15 d cl s 1 1 1 c 942 1358 m 24 6 d -20 15 d -24 -6 d f
- black 942 1358 m 24 6 d -20 15 d -24 -6 d cl s 1 1 1 c 919 1150 m 23 6 d 175 Y
- -23 -6 d f black 919 1150 m 23 6 d 175 Y -23 -6 d cl s 0.6 0.6 0.6 c 899 1166 m
- 20 -16 d 175 Y -20 15 d f black 899 1166 m 20 -16 d 175 Y -20 15 d cl s 1 1 1 c
- 919 1325 m 23 6 d -20 15 d -23 -6 d f black 919 1325 m 23 6 d -20 15 d -23 -6 d
- cl s 1 1 1 c 896 1144 m 23 6 d 161 Y -23 -6 d f black 896 1144 m 23 6 d 161 Y
- -23 -6 d cl s 0.6 0.6 0.6 c 875 1160 m 21 -16 d 161 Y -21 16 d f black 875 1160
- m 21 -16 d 161 Y -21 16 d cl s 1 1 1 c 896 1305 m 23 6 d -20 16 d -24 -6 d f
- black 896 1305 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 872 1138 m 24 6 d 148 Y
- -24 -6 d f black 872 1138 m 24 6 d 148 Y -24 -6 d cl s 0.6 0.6 0.6 c 852 1154 m
- 20 -16 d 148 Y -20 16 d f black 852 1154 m 20 -16 d 148 Y -20 16 d cl s 1 1 1 c
- 872 1286 m 24 6 d -21 15 d -23 -5 d f black 872 1286 m 24 6 d -21 15 d -23 -5 d
- cl s 1 1 1 c 849 1132 m 23 6 d 148 Y -23 -6 d f black 849 1132 m 23 6 d 148 Y
- -23 -6 d cl s 0.6 0.6 0.6 c 828 1148 m 21 -16 d 148 Y -21 16 d f black 828 1148
- m 21 -16 d 148 Y -21 16 d cl s 1 1 1 c 849 1280 m 23 6 d -20 16 d -24 -6 d f
- black 849 1280 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 825 1126 m 24 6 d 161 Y
- -24 -6 d f black 825 1126 m 24 6 d 161 Y -24 -6 d cl s 0.6 0.6 0.6 c 805 1142 m
- 20 -16 d 161 Y -20 16 d f black 805 1142 m 20 -16 d 161 Y -20 16 d cl s 1 1 1 c
- 825 1287 m 24 6 d -21 16 d -23 -6 d f black 825 1287 m 24 6 d -21 16 d -23 -6 d
- cl s 1 1 1 c 802 1120 m 23 6 d 148 Y -23 -6 d f black 802 1120 m 23 6 d 148 Y
- -23 -6 d cl s 0.6 0.6 0.6 c 781 1136 m 21 -16 d 148 Y -21 16 d f black 781 1136
- m 21 -16 d 148 Y -21 16 d cl s 1 1 1 c 802 1268 m 23 6 d -20 16 d -24 -6 d f
- black 802 1268 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 778 1114 m 24 6 d 188 Y
- -24 -6 d f black 778 1114 m 24 6 d 188 Y -24 -6 d cl s 0.6 0.6 0.6 c 758 1130 m
- 20 -16 d 188 Y -20 16 d f black 758 1130 m 20 -16 d 188 Y -20 16 d cl s 1 1 1 c
- 778 1302 m 24 6 d -21 16 d -23 -6 d f black 778 1302 m 24 6 d -21 16 d -23 -6 d
- cl s 1 1 1 c 755 1108 m 23 6 d 135 Y -23 -6 d f black 755 1108 m 23 6 d 135 Y
- -23 -6 d cl s 0.6 0.6 0.6 c 734 1124 m 21 -16 d 135 Y -21 15 d f black 734 1124
- m 21 -16 d 135 Y -21 15 d cl s 1 1 1 c 755 1243 m 23 6 d -20 15 d -24 -6 d f
- black 755 1243 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 731 1102 m 24 6 d 242 Y
- -24 -6 d f black 731 1102 m 24 6 d 242 Y -24 -6 d cl s 0.6 0.6 0.6 c 711 1118 m
- 20 -16 d 242 Y -20 16 d f black 711 1118 m 20 -16 d 242 Y -20 16 d cl s 1 1 1 c
- 731 1344 m 24 6 d -21 16 d -23 -6 d f black 731 1344 m 24 6 d -21 16 d -23 -6 d
- cl s 1 1 1 c 708 1096 m 23 6 d 242 Y -23 -6 d f black 708 1096 m 23 6 d 242 Y
- -23 -6 d cl s 0.6 0.6 0.6 c 687 1112 m 21 -16 d 242 Y -21 16 d f black 687 1112
- m 21 -16 d 242 Y -21 16 d cl s 1 1 1 c 708 1338 m 23 6 d -20 16 d -24 -6 d f
- black 708 1338 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 684 1090 m 24 6 d 148 Y
- -24 -6 d f black 684 1090 m 24 6 d 148 Y -24 -6 d cl s 0.6 0.6 0.6 c 664 1106 m
- 20 -16 d 148 Y -20 16 d f black 664 1106 m 20 -16 d 148 Y -20 16 d cl s 1 1 1 c
- 684 1238 m 24 6 d -21 16 d -23 -6 d f black 684 1238 m 24 6 d -21 16 d -23 -6 d
- cl s 1 1 1 c 661 1084 m 23 6 d 188 Y -23 -6 d f black 661 1084 m 23 6 d 188 Y
- -23 -6 d cl s 0.6 0.6 0.6 c 640 1100 m 21 -16 d 188 Y -21 16 d f black 640 1100
- m 21 -16 d 188 Y -21 16 d cl s 1 1 1 c 661 1272 m 23 6 d -20 16 d -24 -6 d f
- black 661 1272 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 637 1078 m 24 6 d 215 Y
- -24 -6 d f black 637 1078 m 24 6 d 215 Y -24 -6 d cl s 0.6 0.6 0.6 c 617 1094 m
- 20 -16 d 215 Y -20 16 d f black 617 1094 m 20 -16 d 215 Y -20 16 d cl s 1 1 1 c
- 637 1293 m 24 6 d -21 16 d -23 -6 d f black 637 1293 m 24 6 d -21 16 d -23 -6 d
- cl s 1 1 1 c 614 1072 m 23 6 d 229 Y -23 -6 d f black 614 1072 m 23 6 d 229 Y
- -23 -6 d cl s 0.6 0.6 0.6 c 593 1088 m 21 -16 d 229 Y -21 15 d f black 593 1088
- m 21 -16 d 229 Y -21 15 d cl s 1 1 1 c 614 1301 m 23 6 d -20 15 d -24 -6 d f
- black 614 1301 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 590 1066 m 24 6 d 135 Y
- -24 -6 d f black 590 1066 m 24 6 d 135 Y -24 -6 d cl s 0.6 0.6 0.6 c 570 1082 m
- 20 -16 d 135 Y -20 15 d f black 570 1082 m 20 -16 d 135 Y -20 15 d cl s 1 1 1 c
- 590 1201 m 24 6 d -21 15 d -23 -6 d f black 590 1201 m 24 6 d -21 15 d -23 -6 d
- cl s 1 1 1 c 567 1060 m 23 6 d 229 Y -23 -6 d f black 567 1060 m 23 6 d 229 Y
- -23 -6 d cl s 0.6 0.6 0.6 c 546 1076 m 21 -16 d 229 Y -21 15 d f black 546 1076
- m 21 -16 d 229 Y -21 15 d cl s 1 1 1 c 567 1289 m 23 6 d -20 15 d -24 -6 d f
- black 567 1289 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 543 1054 m 24 6 d 189 Y
- -24 -6 d f black 543 1054 m 24 6 d 189 Y -24 -6 d cl s 0.6 0.6 0.6 c 523 1070 m
- 20 -16 d 189 Y -20 15 d f black 523 1070 m 20 -16 d 189 Y -20 15 d cl s 1 1 1 c
- 543 1243 m 24 6 d -21 15 d -23 -6 d f black 543 1243 m 24 6 d -21 15 d -23 -6 d
- cl s 1 1 1 c 520 1048 m 23 6 d 148 Y -23 -6 d f black 520 1048 m 23 6 d 148 Y
- -23 -6 d cl s 0.6 0.6 0.6 c 499 1064 m 21 -16 d 148 Y -21 16 d f black 499 1064
- m 21 -16 d 148 Y -21 16 d cl s 1 1 1 c 520 1196 m 23 6 d -20 16 d -24 -6 d f
- black 520 1196 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 496 1043 m 24 5 d -21 16
- d -23 -6 d f black 496 1043 m 24 5 d -21 16 d -23 -6 d cl s 1 1 1 c 473 1037 m
- 23 6 d -20 15 d -24 -6 d f black 473 1037 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1
- c 449 1031 m 24 6 d -21 15 d -23 -6 d f black 449 1031 m 24 6 d -21 15 d -23 -6
- d cl s 1 1 1 c 426 1025 m 23 6 d -20 15 d -24 -6 d f black 426 1025 m 23 6 d
- -20 15 d -24 -6 d cl s 1 1 1 c 1550 1290 m 24 6 d -21 16 d -23 -6 d f black
- 1550 1290 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 1527 1284 m 23 6 d -20 16 d
- -24 -6 d f black 1527 1284 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1503 1278 m
- 24 6 d -21 16 d -23 -6 d f black 1503 1278 m 24 6 d -21 16 d -23 -6 d cl s 1 1
- 1 c 1480 1272 m 23 6 d -20 16 d -24 -6 d f black 1480 1272 m 23 6 d -20 16 d
- -24 -6 d cl s 1 1 1 c 1456 1266 m 24 6 d 336 Y -24 -6 d f black 1456 1266 m 24
- 6 d 336 Y -24 -6 d cl s 0.6 0.6 0.6 c 1436 1282 m 20 -16 d 336 Y -20 16 d f
- black 1436 1282 m 20 -16 d 336 Y -20 16 d cl s 1 1 1 c 1456 1602 m 24 6 d -21
- 16 d -23 -6 d f black 1456 1602 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 1433
- 1260 m 23 6 d 255 Y -23 -6 d f black 1433 1260 m 23 6 d 255 Y -23 -6 d cl s 0.6
- 0.6 0.6 c 1412 1276 m 21 -16 d 255 Y -21 16 d f black 1412 1276 m 21 -16 d 255
- Y -21 16 d cl s 1 1 1 c 1433 1515 m 23 6 d -20 16 d -24 -6 d f black 1433 1515
- m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1409 1254 m 24 6 d 376 Y -24 -6 d f
- black 1409 1254 m 24 6 d 376 Y -24 -6 d cl s 0.6 0.6 0.6 c 1389 1270 m 20 -16 d
- 376 Y -20 16 d f black 1389 1270 m 20 -16 d 376 Y -20 16 d cl s 1 1 1 c 1409
- 1630 m 24 6 d -21 16 d -23 -6 d f black 1409 1630 m 24 6 d -21 16 d -23 -6 d
- cl s 1 1 1 c 1386 1248 m 23 6 d 309 Y -23 -6 d f black 1386 1248 m 23 6 d 309 Y
- -23 -6 d cl s 0.6 0.6 0.6 c 1365 1264 m 21 -16 d 309 Y -21 16 d f black 1365
- 1264 m 21 -16 d 309 Y -21 16 d cl s 1 1 1 c 1386 1557 m 23 6 d -20 16 d -24 -6
- d f black 1386 1557 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1362 1242 m 24 6 d
- 323 Y -24 -6 d f black 1362 1242 m 24 6 d 323 Y -24 -6 d cl s 0.6 0.6 0.6 c
- 1342 1258 m 20 -16 d 323 Y -20 15 d f black 1342 1258 m 20 -16 d 323 Y -20 15 d
- cl s 1 1 1 c 1362 1565 m 24 6 d -21 15 d -23 -6 d f black 1362 1565 m 24 6 d
- -21 15 d -23 -6 d cl s 1 1 1 c 1339 1236 m 23 6 d 215 Y -23 -6 d f black 1339
- 1236 m 23 6 d 215 Y -23 -6 d cl s 0.6 0.6 0.6 c 1318 1252 m 21 -16 d 215 Y -21
- 16 d f black 1318 1252 m 21 -16 d 215 Y -21 16 d cl s 1 1 1 c 1339 1451 m 23 6
- d -20 16 d -24 -6 d f black 1339 1451 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c
- 1315 1230 m 24 6 d 229 Y -24 -6 d f black 1315 1230 m 24 6 d 229 Y -24 -6 d
- cl s 0.6 0.6 0.6 c 1295 1246 m 20 -16 d 229 Y -20 15 d f black 1295 1246 m 20
- -16 d 229 Y -20 15 d cl s 1 1 1 c 1315 1459 m 24 6 d -21 15 d -23 -6 d f black
- 1315 1459 m 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 1292 1224 m 23 6 d 148 Y -23
- -6 d f black 1292 1224 m 23 6 d 148 Y -23 -6 d cl s 0.6 0.6 0.6 c 1271 1240 m
- 21 -16 d 148 Y -21 16 d f black 1271 1240 m 21 -16 d 148 Y -21 16 d cl s 1 1 1
- c 1292 1372 m 23 6 d -20 16 d -24 -6 d f black 1292 1372 m 23 6 d -20 16 d -24
- -6 d cl s 1 1 1 c 1268 1218 m 24 6 d 162 Y -24 -6 d f black 1268 1218 m 24 6 d
- 162 Y -24 -6 d cl s 0.6 0.6 0.6 c 1248 1234 m 20 -16 d 162 Y -20 15 d f black
- 1248 1234 m 20 -16 d 162 Y -20 15 d cl s 1 1 1 c 1268 1380 m 24 6 d -21 15 d
- -23 -6 d f black 1268 1380 m 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 1245 1212 m
- 23 6 d 323 Y -23 -6 d f black 1245 1212 m 23 6 d 323 Y -23 -6 d cl s 0.6 0.6
- 0.6 c 1224 1228 m 21 -16 d 323 Y -21 15 d f black 1224 1228 m 21 -16 d 323 Y
- -21 15 d cl s 1 1 1 c 1245 1535 m 23 6 d -20 15 d -24 -6 d f black 1245 1535 m
- 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1221 1206 m 24 6 d 256 Y -24 -6 d f black
- 1221 1206 m 24 6 d 256 Y -24 -6 d cl s 0.6 0.6 0.6 c 1201 1222 m 20 -16 d 256 Y
- -20 15 d f black 1201 1222 m 20 -16 d 256 Y -20 15 d cl s 1 1 1 c 1221 1462 m
- 24 6 d -21 15 d -23 -6 d f black 1221 1462 m 24 6 d -21 15 d -23 -6 d cl s 1 1
- 1 c 1198 1200 m 23 6 d 336 Y -23 -6 d f black 1198 1200 m 23 6 d 336 Y -23 -6 d
- cl s 0.6 0.6 0.6 c 1177 1216 m 21 -16 d 336 Y -21 16 d f black 1177 1216 m 21
- -16 d 336 Y -21 16 d cl s 1 1 1 c 1198 1536 m 23 6 d -20 16 d -24 -6 d f black
- 1198 1536 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1174 1194 m 24 6 d 390 Y -24
- -6 d f black 1174 1194 m 24 6 d 390 Y -24 -6 d cl s 0.6 0.6 0.6 c 1154 1210 m
- 20 -16 d 390 Y -20 16 d f black 1154 1210 m 20 -16 d 390 Y -20 16 d cl s 1 1 1
- c 1174 1584 m 24 6 d -21 16 d -23 -6 d f black 1174 1584 m 24 6 d -21 16 d -23
- -6 d cl s 1 1 1 c 1151 1188 m 23 6 d 256 Y -23 -6 d f black 1151 1188 m 23 6 d
- 256 Y -23 -6 d cl s 0.6 0.6 0.6 c 1130 1204 m 21 -16 d 256 Y -21 15 d f black
- 1130 1204 m 21 -16 d 256 Y -21 15 d cl s 1 1 1 c 1151 1444 m 23 6 d -20 15 d
- -24 -6 d f black 1151 1444 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1127 1182 m
- 24 6 d 283 Y -24 -6 d f black 1127 1182 m 24 6 d 283 Y -24 -6 d cl s 0.6 0.6
- 0.6 c 1107 1198 m 20 -16 d 283 Y -20 15 d f black 1107 1198 m 20 -16 d 283 Y
- -20 15 d cl s 1 1 1 c 1127 1465 m 24 6 d -21 15 d -23 -6 d f black 1127 1465 m
- 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 1104 1176 m 23 6 d 309 Y -23 -6 d f black
- 1104 1176 m 23 6 d 309 Y -23 -6 d cl s 0.6 0.6 0.6 c 1083 1192 m 21 -16 d 309 Y
- -21 16 d f black 1083 1192 m 21 -16 d 309 Y -21 16 d cl s 1 1 1 c 1104 1485 m
- 23 6 d -20 16 d -24 -6 d f black 1104 1485 m 23 6 d -20 16 d -24 -6 d cl s 1 1
- 1 c 1080 1170 m 24 6 d 269 Y -24 -6 d f black 1080 1170 m 24 6 d 269 Y -24 -6 d
- cl s 0.6 0.6 0.6 c 1060 1186 m 20 -16 d 269 Y -20 16 d f black 1060 1186 m 20
- -16 d 269 Y -20 16 d cl s 1 1 1 c 1080 1439 m 24 6 d -21 16 d -23 -6 d f black
- 1080 1439 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 1057 1165 m 23 5 d 323 Y -23
- -6 d f black 1057 1165 m 23 5 d 323 Y -23 -6 d cl s 0.6 0.6 0.6 c 1036 1180 m
- 21 -15 d 322 Y -21 16 d f black 1036 1180 m 21 -15 d 322 Y -21 16 d cl s 1 1 1
- c 1057 1487 m 23 6 d -20 15 d -24 -5 d f black 1057 1487 m 23 6 d -20 15 d -24
- -5 d cl s 1 1 1 c 1033 1159 m 24 6 d 443 Y -24 -6 d f black 1033 1159 m 24 6 d
- 443 Y -24 -6 d cl s 0.6 0.6 0.6 c 1013 1174 m 20 -15 d 443 Y -20 15 d f black
- 1013 1174 m 20 -15 d 443 Y -20 15 d cl s 1 1 1 c 1033 1602 m 24 6 d -21 15 d
- -23 -6 d f black 1033 1602 m 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 1010 1153 m
- 23 6 d 174 Y -23 -6 d f black 1010 1153 m 23 6 d 174 Y -23 -6 d cl s 0.6 0.6
- 0.6 c 989 1168 m 21 -15 d 174 Y -21 16 d f black 989 1168 m 21 -15 d 174 Y -21
- 16 d cl s 1 1 1 c 1010 1327 m 23 6 d -20 16 d -24 -6 d f black 1010 1327 m 23 6
- d -20 16 d -24 -6 d cl s 1 1 1 c 986 1147 m 24 6 d 309 Y -24 -6 d f black 986
- 1147 m 24 6 d 309 Y -24 -6 d cl s 0.6 0.6 0.6 c 966 1162 m 20 -15 d 309 Y -20
- 15 d f black 966 1162 m 20 -15 d 309 Y -20 15 d cl s 1 1 1 c 986 1456 m 24 6 d
- -21 15 d -23 -6 d f black 986 1456 m 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 963
- 1141 m 23 6 d 309 Y -23 -6 d f black 963 1141 m 23 6 d 309 Y -23 -6 d cl s 0.6
- 0.6 0.6 c 942 1156 m 21 -15 d 309 Y -21 15 d f black 942 1156 m 21 -15 d 309 Y
- -21 15 d cl s 1 1 1 c 963 1450 m 23 6 d -20 15 d -24 -6 d f black 963 1450 m 23
- 6 d -20 15 d -24 -6 d cl s 1 1 1 c 939 1135 m 24 6 d 255 Y -24 -6 d f black 939
- 1135 m 24 6 d 255 Y -24 -6 d cl s 0.6 0.6 0.6 c 919 1150 m 20 -15 d 255 Y -20
- 15 d f black 919 1150 m 20 -15 d 255 Y -20 15 d cl s 1 1 1 c 939 1390 m 24 6 d
- -21 15 d -23 -6 d f black 939 1390 m 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 916
- 1129 m 23 6 d 241 Y -23 -6 d f black 916 1129 m 23 6 d 241 Y -23 -6 d cl s 0.6
- 0.6 0.6 c 896 1144 m 20 -15 d 241 Y -20 16 d f black 896 1144 m 20 -15 d 241 Y
- -20 16 d cl s 1 1 1 c 916 1370 m 23 6 d -20 16 d -23 -6 d f black 916 1370 m 23
- 6 d -20 16 d -23 -6 d cl s 1 1 1 c 892 1123 m 24 6 d 268 Y -24 -6 d f black 892
- 1123 m 24 6 d 268 Y -24 -6 d cl s 0.6 0.6 0.6 c 872 1138 m 20 -15 d 268 Y -20
- 16 d f black 872 1138 m 20 -15 d 268 Y -20 16 d cl s 1 1 1 c 892 1391 m 24 6 d
- -20 16 d -24 -6 d f black 892 1391 m 24 6 d -20 16 d -24 -6 d cl s 1 1 1 c 869
- 1117 m 23 6 d 268 Y -23 -6 d f black 869 1117 m 23 6 d 268 Y -23 -6 d cl s 0.6
- 0.6 0.6 c 849 1132 m 20 -15 d 268 Y -20 16 d f black 849 1132 m 20 -15 d 268 Y
- -20 16 d cl s 1 1 1 c 869 1385 m 23 6 d -20 16 d -23 -6 d f black 869 1385 m 23
- 6 d -20 16 d -23 -6 d cl s 1 1 1 c 845 1111 m 24 6 d 268 Y -24 -6 d f black 845
- 1111 m 24 6 d 268 Y -24 -6 d cl s 0.6 0.6 0.6 c 825 1126 m 20 -15 d 268 Y -20
- 16 d f black 825 1126 m 20 -15 d 268 Y -20 16 d cl s 1 1 1 c 845 1379 m 24 6 d
- -20 16 d -24 -6 d f black 845 1379 m 24 6 d -20 16 d -24 -6 d cl s 1 1 1 c 822
- 1105 m 23 6 d 336 Y -23 -6 d f black 822 1105 m 23 6 d 336 Y -23 -6 d cl s 0.6
- 0.6 0.6 c 802 1120 m 20 -15 d 336 Y -20 15 d f black 802 1120 m 20 -15 d 336 Y
- -20 15 d cl s 1 1 1 c 822 1441 m 23 6 d -20 15 d -23 -6 d f black 822 1441 m 23
- 6 d -20 15 d -23 -6 d cl s 1 1 1 c 798 1099 m 24 6 d 228 Y -24 -6 d f black 798
- 1099 m 24 6 d 228 Y -24 -6 d cl s 0.6 0.6 0.6 c 778 1114 m 20 -15 d 228 Y -20
- 16 d f black 778 1114 m 20 -15 d 228 Y -20 16 d cl s 1 1 1 c 798 1327 m 24 6 d
- -20 16 d -24 -6 d f black 798 1327 m 24 6 d -20 16 d -24 -6 d cl s 1 1 1 c 775
- 1093 m 23 6 d 349 Y -23 -6 d f black 775 1093 m 23 6 d 349 Y -23 -6 d cl s 0.6
- 0.6 0.6 c 755 1108 m 20 -15 d 349 Y -20 16 d f black 755 1108 m 20 -15 d 349 Y
- -20 16 d cl s 1 1 1 c 775 1442 m 23 6 d -20 16 d -23 -6 d f black 775 1442 m 23
- 6 d -20 16 d -23 -6 d cl s 1 1 1 c 751 1087 m 24 6 d 322 Y -24 -6 d f black 751
- 1087 m 24 6 d 322 Y -24 -6 d cl s 0.6 0.6 0.6 c 731 1102 m 20 -15 d 322 Y -20
- 16 d f black 731 1102 m 20 -15 d 322 Y -20 16 d cl s 1 1 1 c 751 1409 m 24 6 d
- -20 16 d -24 -6 d f black 751 1409 m 24 6 d -20 16 d -24 -6 d cl s 1 1 1 c 728
- 1081 m 23 6 d 268 Y -23 -5 d f black 728 1081 m 23 6 d 268 Y -23 -5 d cl s 0.6
- 0.6 0.6 c 708 1096 m 20 -15 d 269 Y -20 15 d f black 708 1096 m 20 -15 d 269 Y
- -20 15 d cl s 1 1 1 c 728 1350 m 23 5 d -20 16 d -23 -6 d f black 728 1350 m 23
- 5 d -20 16 d -23 -6 d cl s 1 1 1 c 704 1075 m 24 6 d 188 Y -24 -6 d f black 704
- 1075 m 24 6 d 188 Y -24 -6 d cl s 0.6 0.6 0.6 c 684 1090 m 20 -15 d 188 Y -20
- 15 d f black 684 1090 m 20 -15 d 188 Y -20 15 d cl s 1 1 1 c 704 1263 m 24 6 d
- -20 15 d -24 -6 d f black 704 1263 m 24 6 d -20 15 d -24 -6 d cl s 1 1 1 c 681
- 1069 m 23 6 d 336 Y -23 -6 d f black 681 1069 m 23 6 d 336 Y -23 -6 d cl s 0.6
- 0.6 0.6 c 661 1084 m 20 -15 d 336 Y -20 15 d f black 661 1084 m 20 -15 d 336 Y
- -20 15 d cl s 1 1 1 c 681 1405 m 23 6 d -20 15 d -23 -6 d f black 681 1405 m 23
- 6 d -20 15 d -23 -6 d cl s 1 1 1 c 657 1063 m 24 6 d 322 Y -24 -6 d f black 657
- 1063 m 24 6 d 322 Y -24 -6 d cl s 0.6 0.6 0.6 c 637 1078 m 20 -15 d 322 Y -20
- 16 d f black 637 1078 m 20 -15 d 322 Y -20 16 d cl s 1 1 1 c 657 1385 m 24 6 d
- -20 16 d -24 -6 d f black 657 1385 m 24 6 d -20 16 d -24 -6 d cl s 1 1 1 c 634
- 1057 m 23 6 d 148 Y -23 -6 d f black 634 1057 m 23 6 d 148 Y -23 -6 d cl s 0.6
- 0.6 0.6 c 614 1072 m 20 -15 d 148 Y -20 15 d f black 614 1072 m 20 -15 d 148 Y
- -20 15 d cl s 1 1 1 c 634 1205 m 23 6 d -20 15 d -23 -6 d f black 634 1205 m 23
- 6 d -20 15 d -23 -6 d cl s 1 1 1 c 610 1051 m 24 6 d 363 Y -24 -6 d f black 610
- 1051 m 24 6 d 363 Y -24 -6 d cl s 0.6 0.6 0.6 c 590 1066 m 20 -15 d 363 Y -20
- 15 d f black 590 1066 m 20 -15 d 363 Y -20 15 d cl s 1 1 1 c 610 1414 m 24 6 d
- -20 15 d -24 -6 d f black 610 1414 m 24 6 d -20 15 d -24 -6 d cl s 1 1 1 c 587
- 1045 m 23 6 d 255 Y -23 -6 d f black 587 1045 m 23 6 d 255 Y -23 -6 d cl s 0.6
- 0.6 0.6 c 567 1060 m 20 -15 d 255 Y -20 16 d f black 567 1060 m 20 -15 d 255 Y
- -20 16 d cl s 1 1 1 c 587 1300 m 23 6 d -20 16 d -23 -6 d f black 587 1300 m 23
- 6 d -20 16 d -23 -6 d cl s 1 1 1 c 564 1039 m 23 6 d 430 Y -23 -6 d f black 564
- 1039 m 23 6 d 430 Y -23 -6 d cl s 0.6 0.6 0.6 c 543 1054 m 21 -15 d 430 Y -21
- 15 d f black 543 1054 m 21 -15 d 430 Y -21 15 d cl s 1 1 1 c 564 1469 m 23 6 d
- -20 15 d -24 -6 d f black 564 1469 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 540
- 1033 m 24 6 d 242 Y -24 -6 d f black 540 1033 m 24 6 d 242 Y -24 -6 d cl s 0.6
- 0.6 0.6 c 520 1048 m 20 -15 d 242 Y -20 15 d f black 520 1048 m 20 -15 d 242 Y
- -20 15 d cl s 1 1 1 c 540 1275 m 24 6 d -21 15 d -23 -6 d f black 540 1275 m 24
- 6 d -21 15 d -23 -6 d cl s 1 1 1 c 517 1027 m 23 6 d -20 15 d -24 -5 d f black
- 517 1027 m 23 6 d -20 15 d -24 -5 d cl s 1 1 1 c 493 1021 m 24 6 d -21 16 d -23
- -6 d f black 493 1021 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 470 1015 m 23 6 d
- -20 16 d -24 -6 d f black 470 1015 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 446
- 1009 m 24 6 d -21 16 d -23 -6 d f black 446 1009 m 24 6 d -21 16 d -23 -6 d
- cl s 1 1 1 c 1570 1275 m 24 6 d -20 15 d -24 -6 d f black 1570 1275 m 24 6 d
- -20 15 d -24 -6 d cl s 1 1 1 c 1547 1269 m 23 6 d -20 15 d -23 -6 d f black
- 1547 1269 m 23 6 d -20 15 d -23 -6 d cl s 1 1 1 c 1523 1263 m 24 6 d -20 15 d
- -24 -6 d f black 1523 1263 m 24 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1500 1257 m
- 23 6 d -20 15 d -23 -6 d f black 1500 1257 m 23 6 d -20 15 d -23 -6 d cl s 1 1
- 1 c 1476 1251 m 24 6 d 295 Y -24 -6 d f black 1476 1251 m 24 6 d 295 Y -24 -6 d
- cl s 0.6 0.6 0.6 c 1456 1266 m 20 -15 d 295 Y -20 16 d f black 1456 1266 m 20
- -15 d 295 Y -20 16 d cl s 1 1 1 c 1476 1546 m 24 6 d -20 16 d -24 -6 d f black
- 1476 1546 m 24 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1453 1245 m 23 6 d 295 Y -23
- -6 d f black 1453 1245 m 23 6 d 295 Y -23 -6 d cl s 0.6 0.6 0.6 c 1433 1260 m
- 20 -15 d 295 Y -20 16 d f black 1433 1260 m 20 -15 d 295 Y -20 16 d cl s 1 1 1
- c 1453 1540 m 23 6 d -20 16 d -23 -6 d f black 1453 1540 m 23 6 d -20 16 d -23
- -6 d cl s 1 1 1 c 1429 1239 m 24 6 d 389 Y -24 -6 d f black 1429 1239 m 24 6 d
- 389 Y -24 -6 d cl s 0.6 0.6 0.6 c 1409 1254 m 20 -15 d 389 Y -20 16 d f black
- 1409 1254 m 20 -15 d 389 Y -20 16 d cl s 1 1 1 c 1429 1628 m 24 6 d -20 16 d
- -24 -6 d f black 1429 1628 m 24 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1406 1233 m
- 23 6 d 336 Y -23 -6 d f black 1406 1233 m 23 6 d 336 Y -23 -6 d cl s 0.6 0.6
- 0.6 c 1386 1248 m 20 -15 d 336 Y -20 15 d f black 1386 1248 m 20 -15 d 336 Y
- -20 15 d cl s 1 1 1 c 1406 1569 m 23 6 d -20 15 d -23 -6 d f black 1406 1569 m
- 23 6 d -20 15 d -23 -6 d cl s 1 1 1 c 1382 1227 m 24 6 d 295 Y -24 -6 d f black
- 1382 1227 m 24 6 d 295 Y -24 -6 d cl s 0.6 0.6 0.6 c 1362 1242 m 20 -15 d 295 Y
- -20 16 d f black 1362 1242 m 20 -15 d 295 Y -20 16 d cl s 1 1 1 c 1382 1522 m
- 24 6 d -20 16 d -24 -6 d f black 1382 1522 m 24 6 d -20 16 d -24 -6 d cl s 1 1
- 1 c 1359 1221 m 23 6 d 389 Y -23 -6 d f black 1359 1221 m 23 6 d 389 Y -23 -6 d
- cl s 0.6 0.6 0.6 c 1339 1236 m 20 -15 d 389 Y -20 16 d f black 1339 1236 m 20
- -15 d 389 Y -20 16 d cl s 1 1 1 c 1359 1610 m 23 6 d -20 16 d -23 -6 d f black
- 1359 1610 m 23 6 d -20 16 d -23 -6 d cl s 1 1 1 c 1335 1215 m 24 6 d 268 Y -24
- -6 d f black 1335 1215 m 24 6 d 268 Y -24 -6 d cl s 0.6 0.6 0.6 c 1315 1230 m
- 20 -15 d 268 Y -20 16 d f black 1315 1230 m 20 -15 d 268 Y -20 16 d cl s 1 1 1
- c 1335 1483 m 24 6 d -20 16 d -24 -6 d f black 1335 1483 m 24 6 d -20 16 d -24
- -6 d cl s 1 1 1 c 1312 1209 m 23 6 d 403 Y -23 -6 d f black 1312 1209 m 23 6 d
- 403 Y -23 -6 d cl s 0.6 0.6 0.6 c 1292 1224 m 20 -15 d 403 Y -20 15 d f black
- 1292 1224 m 20 -15 d 403 Y -20 15 d cl s 1 1 1 c 1312 1612 m 23 6 d -20 15 d
- -23 -6 d f black 1312 1612 m 23 6 d -20 15 d -23 -6 d cl s 1 1 1 c 1289 1203 m
- 23 6 d 282 Y -23 -6 d f black 1289 1203 m 23 6 d 282 Y -23 -6 d cl s 0.6 0.6
- 0.6 c 1268 1218 m 21 -15 d 282 Y -21 15 d f black 1268 1218 m 21 -15 d 282 Y
- -21 15 d cl s 1 1 1 c 1289 1485 m 23 6 d -20 15 d -24 -6 d f black 1289 1485 m
- 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1265 1197 m 24 6 d 309 Y -24 -6 d f black
- 1265 1197 m 24 6 d 309 Y -24 -6 d cl s 0.6 0.6 0.6 c 1245 1212 m 20 -15 d 309 Y
- -20 15 d f black 1245 1212 m 20 -15 d 309 Y -20 15 d cl s 1 1 1 c 1265 1506 m
- 24 6 d -21 15 d -23 -6 d f black 1265 1506 m 24 6 d -21 15 d -23 -6 d cl s 1 1
- 1 c 1242 1191 m 23 6 d 403 Y -23 -6 d f black 1242 1191 m 23 6 d 403 Y -23 -6 d
- cl s 0.6 0.6 0.6 c 1221 1206 m 21 -15 d 403 Y -21 15 d f black 1221 1206 m 21
- -15 d 403 Y -21 15 d cl s 1 1 1 c 1242 1594 m 23 6 d -20 15 d -24 -6 d f black
- 1242 1594 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1218 1185 m 24 6 d 376 Y -24
- -6 d f black 1218 1185 m 24 6 d 376 Y -24 -6 d cl s 0.6 0.6 0.6 c 1198 1200 m
- 20 -15 d 376 Y -20 16 d f black 1198 1200 m 20 -15 d 376 Y -20 16 d cl s 1 1 1
- c 1218 1561 m 24 6 d -21 16 d -23 -6 d f black 1218 1561 m 24 6 d -21 16 d -23
- -6 d cl s 1 1 1 c 1195 1179 m 23 6 d 228 Y -23 -6 d f black 1195 1179 m 23 6 d
- 228 Y -23 -6 d cl s 0.6 0.6 0.6 c 1174 1194 m 21 -15 d 228 Y -21 16 d f black
- 1174 1194 m 21 -15 d 228 Y -21 16 d cl s 1 1 1 c 1195 1407 m 23 6 d -20 16 d
- -24 -6 d f black 1195 1407 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1171 1173 m
- 24 6 d 349 Y -24 -6 d f black 1171 1173 m 24 6 d 349 Y -24 -6 d cl s 0.6 0.6
- 0.6 c 1151 1188 m 20 -15 d 349 Y -20 16 d f black 1151 1188 m 20 -15 d 349 Y
- -20 16 d cl s 1 1 1 c 1171 1522 m 24 6 d -21 16 d -23 -6 d f black 1171 1522 m
- 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 1148 1167 m 23 6 d 349 Y -23 -6 d f black
- 1148 1167 m 23 6 d 349 Y -23 -6 d cl s 0.6 0.6 0.6 c 1127 1182 m 21 -15 d 349 Y
- -21 16 d f black 1127 1182 m 21 -15 d 349 Y -21 16 d cl s 1 1 1 c 1148 1516 m
- 23 6 d -20 16 d -24 -6 d f black 1148 1516 m 23 6 d -20 16 d -24 -6 d cl s 1 1
- 1 c 1124 1161 m 24 6 d 322 Y -24 -6 d f black 1124 1161 m 24 6 d 322 Y -24 -6 d
- cl s 0.6 0.6 0.6 c 1104 1176 m 20 -15 d 322 Y -20 16 d f black 1104 1176 m 20
- -15 d 322 Y -20 16 d cl s 1 1 1 c 1124 1483 m 24 6 d -21 16 d -23 -6 d f black
- 1124 1483 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 1101 1155 m 23 6 d 363 Y -23
- -6 d f black 1101 1155 m 23 6 d 363 Y -23 -6 d cl s 0.6 0.6 0.6 c 1080 1170 m
- 21 -15 d 363 Y -21 15 d f black 1080 1170 m 21 -15 d 363 Y -21 15 d cl s 1 1 1
- c 1101 1518 m 23 6 d -20 15 d -24 -6 d f black 1101 1518 m 23 6 d -20 15 d -24
- -6 d cl s 1 1 1 c 1077 1149 m 24 6 d 416 Y -24 -6 d f black 1077 1149 m 24 6 d
- 416 Y -24 -6 d cl s 0.6 0.6 0.6 c 1057 1165 m 20 -16 d 416 Y -20 16 d f black
- 1057 1165 m 20 -16 d 416 Y -20 16 d cl s 1 1 1 c 1077 1565 m 24 6 d -21 16 d
- -23 -6 d f black 1077 1565 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 1054 1143 m
- 23 6 d 255 Y -23 -6 d f black 1054 1143 m 23 6 d 255 Y -23 -6 d cl s 0.6 0.6
- 0.6 c 1033 1159 m 21 -16 d 255 Y -21 16 d f black 1033 1159 m 21 -16 d 255 Y
- -21 16 d cl s 1 1 1 c 1054 1398 m 23 6 d -20 16 d -24 -6 d f black 1054 1398 m
- 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1030 1137 m 24 6 d 430 Y -24 -6 d f black
- 1030 1137 m 24 6 d 430 Y -24 -6 d cl s 0.6 0.6 0.6 c 1010 1153 m 20 -16 d 430 Y
- -20 15 d f black 1010 1153 m 20 -16 d 430 Y -20 15 d cl s 1 1 1 c 1030 1567 m
- 24 6 d -21 15 d -23 -6 d f black 1030 1567 m 24 6 d -21 15 d -23 -6 d cl s 1 1
- 1 c 1007 1131 m 23 6 d 309 Y -23 -6 d f black 1007 1131 m 23 6 d 309 Y -23 -6 d
- cl s 0.6 0.6 0.6 c 986 1147 m 21 -16 d 309 Y -21 16 d f black 986 1147 m 21 -16
- d 309 Y -21 16 d cl s 1 1 1 c 1007 1440 m 23 6 d -20 16 d -24 -6 d f black 1007
- 1440 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 983 1125 m 24 6 d 430 Y -24 -6 d f
- black 983 1125 m 24 6 d 430 Y -24 -6 d cl s 0.6 0.6 0.6 c 963 1141 m 20 -16 d
- 430 Y -20 16 d f black 963 1141 m 20 -16 d 430 Y -20 16 d cl s 1 1 1 c 983 1555
- m 24 6 d -21 16 d -23 -6 d f black 983 1555 m 24 6 d -21 16 d -23 -6 d cl s 1 1
- 1 c 960 1119 m 23 6 d 309 Y -23 -6 d f black 960 1119 m 23 6 d 309 Y -23 -6 d
- cl s 0.6 0.6 0.6 c 939 1135 m 21 -16 d 309 Y -21 16 d f black 939 1135 m 21 -16
- d 309 Y -21 16 d cl s 1 1 1 c 960 1428 m 23 6 d -20 16 d -24 -6 d f black 960
- 1428 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 936 1113 m 24 6 d 403 Y -24 -6 d f
- black 936 1113 m 24 6 d 403 Y -24 -6 d cl s 0.6 0.6 0.6 c 916 1129 m 20 -16 d
- 403 Y -20 16 d f black 916 1129 m 20 -16 d 403 Y -20 16 d cl s 1 1 1 c 936 1516
- m 24 6 d -21 16 d -23 -6 d f black 936 1516 m 24 6 d -21 16 d -23 -6 d cl s 1 1
- 1 c 913 1107 m 23 6 d 430 Y -23 -6 d f black 913 1107 m 23 6 d 430 Y -23 -6 d
- cl s 0.6 0.6 0.6 c 892 1123 m 21 -16 d 430 Y -21 16 d f black 892 1123 m 21 -16
- d 430 Y -21 16 d cl s 1 1 1 c 913 1537 m 23 6 d -20 16 d -24 -6 d f black 913
- 1537 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 889 1101 m 24 6 d 390 Y -24 -6 d f
- black 889 1101 m 24 6 d 390 Y -24 -6 d cl s 0.6 0.6 0.6 c 869 1117 m 20 -16 d
- 390 Y -20 15 d f black 869 1117 m 20 -16 d 390 Y -20 15 d cl s 1 1 1 c 889 1491
- m 24 6 d -21 15 d -23 -6 d f black 889 1491 m 24 6 d -21 15 d -23 -6 d cl s 1 1
- 1 c 866 1095 m 23 6 d 390 Y -23 -6 d f black 866 1095 m 23 6 d 390 Y -23 -6 d
- cl s 0.6 0.6 0.6 c 845 1111 m 21 -16 d 390 Y -21 15 d f black 845 1111 m 21 -16
- d 390 Y -21 15 d cl s 1 1 1 c 866 1485 m 23 6 d -20 15 d -24 -6 d f black 866
- 1485 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 842 1089 m 24 6 d 497 Y -24 -6 d f
- black 842 1089 m 24 6 d 497 Y -24 -6 d cl s 0.6 0.6 0.6 c 822 1105 m 20 -16 d
- 497 Y -20 16 d f black 822 1105 m 20 -16 d 497 Y -20 16 d cl s 1 1 1 c 842 1586
- m 24 6 d -21 16 d -23 -6 d f black 842 1586 m 24 6 d -21 16 d -23 -6 d cl s 1 1
- 1 c 819 1083 m 23 6 d 296 Y -23 -6 d f black 819 1083 m 23 6 d 296 Y -23 -6 d
- cl s 0.6 0.6 0.6 c 798 1099 m 21 -16 d 296 Y -21 15 d f black 798 1099 m 21 -16
- d 296 Y -21 15 d cl s 1 1 1 c 819 1379 m 23 6 d -20 15 d -24 -6 d f black 819
- 1379 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 795 1077 m 24 6 d 484 Y -24 -6 d f
- black 795 1077 m 24 6 d 484 Y -24 -6 d cl s 0.6 0.6 0.6 c 775 1093 m 20 -16 d
- 484 Y -20 15 d f black 775 1093 m 20 -16 d 484 Y -20 15 d cl s 1 1 1 c 795 1561
- m 24 6 d -21 15 d -23 -6 d f black 795 1561 m 24 6 d -21 15 d -23 -6 d cl s 1 1
- 1 c 772 1071 m 23 6 d 511 Y -23 -6 d f black 772 1071 m 23 6 d 511 Y -23 -6 d
- cl s 0.6 0.6 0.6 c 751 1087 m 21 -16 d 511 Y -21 15 d f black 751 1087 m 21 -16
- d 511 Y -21 15 d cl s 1 1 1 c 772 1582 m 23 6 d -20 15 d -24 -6 d f black 772
- 1582 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 748 1065 m 24 6 d 376 Y -24 -6 d f
- black 748 1065 m 24 6 d 376 Y -24 -6 d cl s 0.6 0.6 0.6 c 728 1081 m 20 -16 d
- 376 Y -20 16 d f black 728 1081 m 20 -16 d 376 Y -20 16 d cl s 1 1 1 c 748 1441
- m 24 6 d -21 16 d -23 -6 d f black 748 1441 m 24 6 d -21 16 d -23 -6 d cl s 1 1
- 1 c 725 1059 m 23 6 d 323 Y -23 -6 d f black 725 1059 m 23 6 d 323 Y -23 -6 d
- cl s 0.6 0.6 0.6 c 704 1075 m 21 -16 d 323 Y -21 15 d f black 704 1075 m 21 -16
- d 323 Y -21 15 d cl s 1 1 1 c 725 1382 m 23 6 d -20 15 d -24 -6 d f black 725
- 1382 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 701 1053 m 24 6 d 309 Y -24 -6 d f
- black 701 1053 m 24 6 d 309 Y -24 -6 d cl s 0.6 0.6 0.6 c 681 1069 m 20 -16 d
- 309 Y -20 16 d f black 681 1069 m 20 -16 d 309 Y -20 16 d cl s 1 1 1 c 701 1362
- m 24 6 d -21 16 d -23 -6 d f black 701 1362 m 24 6 d -21 16 d -23 -6 d cl s 1 1
- 1 c 678 1047 m 23 6 d 457 Y -23 -6 d f black 678 1047 m 23 6 d 457 Y -23 -6 d
- cl s 0.6 0.6 0.6 c 657 1063 m 21 -16 d 457 Y -21 16 d f black 657 1063 m 21 -16
- d 457 Y -21 16 d cl s 1 1 1 c 678 1504 m 23 6 d -20 16 d -24 -6 d f black 678
- 1504 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 654 1041 m 24 6 d 471 Y -24 -6 d f
- black 654 1041 m 24 6 d 471 Y -24 -6 d cl s 0.6 0.6 0.6 c 634 1057 m 20 -16 d
- 471 Y -20 15 d f black 634 1057 m 20 -16 d 471 Y -20 15 d cl s 1 1 1 c 654 1512
- m 24 6 d -21 15 d -23 -6 d f black 654 1512 m 24 6 d -21 15 d -23 -6 d cl s 1 1
- 1 c 631 1035 m 23 6 d 430 Y -23 -6 d f black 631 1035 m 23 6 d 430 Y -23 -6 d
- cl s 0.6 0.6 0.6 c 610 1051 m 21 -16 d 430 Y -21 16 d f black 610 1051 m 21 -16
- d 430 Y -21 16 d cl s 1 1 1 c 631 1465 m 23 6 d -20 16 d -24 -6 d f black 631
- 1465 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 607 1029 m 24 6 d 323 Y -24 -6 d f
- black 607 1029 m 24 6 d 323 Y -24 -6 d cl s 0.6 0.6 0.6 c 587 1045 m 20 -16 d
- 323 Y -20 15 d f black 587 1045 m 20 -16 d 323 Y -20 15 d cl s 1 1 1 c 607 1352
- m 24 6 d -21 15 d -23 -6 d f black 607 1352 m 24 6 d -21 15 d -23 -6 d cl s 1 1
- 1 c 584 1023 m 23 6 d 350 Y -23 -6 d f black 584 1023 m 23 6 d 350 Y -23 -6 d
- cl s 0.6 0.6 0.6 c 564 1039 m 20 -16 d 350 Y -20 15 d f black 564 1039 m 20 -16
- d 350 Y -20 15 d cl s 1 1 1 c 584 1373 m 23 6 d -20 15 d -23 -6 d f black 584
- 1373 m 23 6 d -20 15 d -23 -6 d cl s 1 1 1 c 560 1017 m 24 6 d 296 Y -24 -6 d f
- black 560 1017 m 24 6 d 296 Y -24 -6 d cl s 0.6 0.6 0.6 c 540 1033 m 20 -16 d
- 296 Y -20 16 d f black 540 1033 m 20 -16 d 296 Y -20 16 d cl s 1 1 1 c 560 1313
- m 24 6 d -20 16 d -24 -6 d f black 560 1313 m 24 6 d -20 16 d -24 -6 d cl s 1 1
- 1 c 537 1011 m 23 6 d -20 16 d -23 -6 d f black 537 1011 m 23 6 d -20 16 d -23
- -6 d cl s 1 1 1 c 513 1005 m 24 6 d -20 16 d -24 -6 d f black 513 1005 m 24 6 d
- -20 16 d -24 -6 d cl s 1 1 1 c 490 999 m 23 6 d -20 16 d -23 -6 d f black 490
- 999 m 23 6 d -20 16 d -23 -6 d cl s 1 1 1 c 466 993 m 24 6 d -20 16 d -24 -6 d
- f black 466 993 m 24 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1591 1259 m 23 6 d -20
- 16 d -24 -6 d f black 1591 1259 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1567
- 1253 m 24 6 d -21 16 d -23 -6 d f black 1567 1253 m 24 6 d -21 16 d -23 -6 d
- cl s 1 1 1 c 1544 1247 m 23 6 d -20 16 d -24 -6 d f black 1544 1247 m 23 6 d
- -20 16 d -24 -6 d cl s 1 1 1 c 1520 1241 m 24 6 d -21 16 d -23 -6 d f black
- 1520 1241 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 1497 1235 m 23 6 d 511 Y -23
- -6 d f black 1497 1235 m 23 6 d 511 Y -23 -6 d cl s 0.6 0.6 0.6 c 1476 1251 m
- 21 -16 d 511 Y -21 15 d f black 1476 1251 m 21 -16 d 511 Y -21 15 d cl s 1 1 1
- c 1497 1746 m 23 6 d -20 15 d -24 -6 d f black 1497 1746 m 23 6 d -20 15 d -24
- -6 d cl s 1 1 1 c 1473 1229 m 24 6 d 511 Y -24 -6 d f black 1473 1229 m 24 6 d
- 511 Y -24 -6 d cl s 0.6 0.6 0.6 c 1453 1245 m 20 -16 d 511 Y -20 15 d f black
- 1453 1245 m 20 -16 d 511 Y -20 15 d cl s 1 1 1 c 1473 1740 m 24 6 d -21 15 d
- -23 -6 d f black 1473 1740 m 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 1450 1223 m
- 23 6 d 632 Y -23 -6 d f black 1450 1223 m 23 6 d 632 Y -23 -6 d cl s 0.6 0.6
- 0.6 c 1429 1239 m 21 -16 d 632 Y -21 15 d f black 1429 1239 m 21 -16 d 632 Y
- -21 15 d cl s 1 1 1 c 1450 1855 m 23 6 d -20 15 d -24 -6 d f black 1450 1855 m
- 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1426 1217 m 24 6 d 457 Y -24 -6 d f black
- 1426 1217 m 24 6 d 457 Y -24 -6 d cl s 0.6 0.6 0.6 c 1406 1233 m 20 -16 d 457 Y
- -20 16 d f black 1406 1233 m 20 -16 d 457 Y -20 16 d cl s 1 1 1 c 1426 1674 m
- 24 6 d -21 15 d -23 -5 d f black 1426 1674 m 24 6 d -21 15 d -23 -5 d cl s 1 1
- 1 c 1403 1211 m 23 6 d 390 Y -23 -6 d f black 1403 1211 m 23 6 d 390 Y -23 -6 d
- cl s 0.6 0.6 0.6 c 1382 1227 m 21 -16 d 390 Y -21 15 d f black 1382 1227 m 21
- -16 d 390 Y -21 15 d cl s 1 1 1 c 1403 1601 m 23 6 d -20 15 d -24 -6 d f black
- 1403 1601 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1379 1205 m 24 6 d 484 Y -24
- -6 d f black 1379 1205 m 24 6 d 484 Y -24 -6 d cl s 0.6 0.6 0.6 c 1359 1221 m
- 20 -16 d 484 Y -20 15 d f black 1359 1221 m 20 -16 d 484 Y -20 15 d cl s 1 1 1
- c 1379 1689 m 24 6 d -21 15 d -23 -6 d f black 1379 1689 m 24 6 d -21 15 d -23
- -6 d cl s 1 1 1 c 1356 1199 m 23 6 d 565 Y -23 -6 d f black 1356 1199 m 23 6 d
- 565 Y -23 -6 d cl s 0.6 0.6 0.6 c 1335 1215 m 21 -16 d 565 Y -21 15 d f black
- 1335 1215 m 21 -16 d 565 Y -21 15 d cl s 1 1 1 c 1356 1764 m 23 6 d -20 15 d
- -24 -6 d f black 1356 1764 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1332 1193 m
- 24 6 d 484 Y -24 -6 d f black 1332 1193 m 24 6 d 484 Y -24 -6 d cl s 0.6 0.6
- 0.6 c 1312 1209 m 20 -16 d 484 Y -20 15 d f black 1312 1209 m 20 -16 d 484 Y
- -20 15 d cl s 1 1 1 c 1332 1677 m 24 6 d -21 15 d -23 -6 d f black 1332 1677 m
- 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 1309 1187 m 23 6 d 497 Y -23 -6 d f black
- 1309 1187 m 23 6 d 497 Y -23 -6 d cl s 0.6 0.6 0.6 c 1289 1203 m 20 -16 d 497 Y
- -20 16 d f black 1289 1203 m 20 -16 d 497 Y -20 16 d cl s 1 1 1 c 1309 1684 m
- 23 6 d -20 16 d -23 -6 d f black 1309 1684 m 23 6 d -20 16 d -23 -6 d cl s 1 1
- 1 c 1285 1181 m 24 6 d 524 Y -24 -6 d f black 1285 1181 m 24 6 d 524 Y -24 -6 d
- cl s 0.6 0.6 0.6 c 1265 1197 m 20 -16 d 524 Y -20 16 d f black 1265 1197 m 20
- -16 d 524 Y -20 16 d cl s 1 1 1 c 1285 1705 m 24 6 d -20 16 d -24 -6 d f black
- 1285 1705 m 24 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1262 1175 m 23 6 d 430 Y -23
- -6 d f black 1262 1175 m 23 6 d 430 Y -23 -6 d cl s 0.6 0.6 0.6 c 1242 1191 m
- 20 -16 d 430 Y -20 16 d f black 1242 1191 m 20 -16 d 430 Y -20 16 d cl s 1 1 1
- c 1262 1605 m 23 6 d -20 16 d -23 -6 d f black 1262 1605 m 23 6 d -20 16 d -23
- -6 d cl s 1 1 1 c 1238 1169 m 24 6 d 524 Y -24 -6 d f black 1238 1169 m 24 6 d
- 524 Y -24 -6 d cl s 0.6 0.6 0.6 c 1218 1185 m 20 -16 d 524 Y -20 16 d f black
- 1218 1185 m 20 -16 d 524 Y -20 16 d cl s 1 1 1 c 1238 1693 m 24 6 d -20 16 d
- -24 -6 d f black 1238 1693 m 24 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1215 1163 m
- 23 6 d 403 Y -23 -6 d f black 1215 1163 m 23 6 d 403 Y -23 -6 d cl s 0.6 0.6
- 0.6 c 1195 1179 m 20 -16 d 403 Y -20 16 d f black 1195 1179 m 20 -16 d 403 Y
- -20 16 d cl s 1 1 1 c 1215 1566 m 23 6 d -20 16 d -23 -6 d f black 1215 1566 m
- 23 6 d -20 16 d -23 -6 d cl s 1 1 1 c 1191 1157 m 24 6 d 430 Y -24 -6 d f black
- 1191 1157 m 24 6 d 430 Y -24 -6 d cl s 0.6 0.6 0.6 c 1171 1173 m 20 -16 d 430 Y
- -20 16 d f black 1171 1173 m 20 -16 d 430 Y -20 16 d cl s 1 1 1 c 1191 1587 m
- 24 6 d -20 16 d -24 -6 d f black 1191 1587 m 24 6 d -20 16 d -24 -6 d cl s 1 1
- 1 c 1168 1151 m 23 6 d 578 Y -23 -6 d f black 1168 1151 m 23 6 d 578 Y -23 -6 d
- cl s 0.6 0.6 0.6 c 1148 1167 m 20 -16 d 578 Y -20 16 d f black 1148 1167 m 20
- -16 d 578 Y -20 16 d cl s 1 1 1 c 1168 1729 m 23 6 d -20 16 d -23 -6 d f black
- 1168 1729 m 23 6 d -20 16 d -23 -6 d cl s 1 1 1 c 1144 1145 m 24 6 d 377 Y -24
- -6 d f black 1144 1145 m 24 6 d 377 Y -24 -6 d cl s 0.6 0.6 0.6 c 1124 1161 m
- 20 -16 d 377 Y -20 15 d f black 1124 1161 m 20 -16 d 377 Y -20 15 d cl s 1 1 1
- c 1144 1522 m 24 6 d -20 15 d -24 -6 d f black 1144 1522 m 24 6 d -20 15 d -24
- -6 d cl s 1 1 1 c 1121 1139 m 23 6 d 498 Y -23 -6 d f black 1121 1139 m 23 6 d
- 498 Y -23 -6 d cl s 0.6 0.6 0.6 c 1101 1155 m 20 -16 d 498 Y -20 15 d f black
- 1101 1155 m 20 -16 d 498 Y -20 15 d cl s 1 1 1 c 1121 1637 m 23 6 d -20 15 d
- -23 -6 d f black 1121 1637 m 23 6 d -20 15 d -23 -6 d cl s 1 1 1 c 1097 1133 m
- 24 6 d 403 Y -24 -5 d f black 1097 1133 m 24 6 d 403 Y -24 -5 d cl s 0.6 0.6
- 0.6 c 1077 1149 m 20 -16 d 404 Y -20 15 d f black 1077 1149 m 20 -16 d 404 Y
- -20 15 d cl s 1 1 1 c 1097 1537 m 24 5 d -20 16 d -24 -6 d f black 1097 1537 m
- 24 5 d -20 16 d -24 -6 d cl s 1 1 1 c 1074 1127 m 23 6 d 618 Y -23 -5 d f black
- 1074 1127 m 23 6 d 618 Y -23 -5 d cl s 0.6 0.6 0.6 c 1054 1143 m 20 -16 d 619 Y
- -20 15 d f black 1054 1143 m 20 -16 d 619 Y -20 15 d cl s 1 1 1 c 1074 1746 m
- 23 5 d -20 16 d -23 -6 d f black 1074 1746 m 23 5 d -20 16 d -23 -6 d cl s 1 1
- 1 c 1050 1121 m 24 6 d 471 Y -24 -6 d f black 1050 1121 m 24 6 d 471 Y -24 -6 d
- cl s 0.6 0.6 0.6 c 1030 1137 m 20 -16 d 471 Y -20 15 d f black 1030 1137 m 20
- -16 d 471 Y -20 15 d cl s 1 1 1 c 1050 1592 m 24 6 d -20 15 d -24 -6 d f black
- 1050 1592 m 24 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1027 1115 m 23 6 d 417 Y -23
- -6 d f black 1027 1115 m 23 6 d 417 Y -23 -6 d cl s 0.6 0.6 0.6 c 1007 1131 m
- 20 -16 d 417 Y -20 16 d f black 1007 1131 m 20 -16 d 417 Y -20 16 d cl s 1 1 1
- c 1027 1532 m 23 6 d -20 16 d -23 -6 d f black 1027 1532 m 23 6 d -20 16 d -23
- -6 d cl s 1 1 1 c 1004 1110 m 23 5 d 444 Y -23 -6 d f black 1004 1110 m 23 5 d
- 444 Y -23 -6 d cl s 0.6 0.6 0.6 c 983 1125 m 21 -15 d 443 Y -21 15 d f black
- 983 1125 m 21 -15 d 443 Y -21 15 d cl s 1 1 1 c 1004 1553 m 23 6 d -20 15 d -24
- -6 d f black 1004 1553 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 980 1104 m 24 6
- d 416 Y -24 -6 d f black 980 1104 m 24 6 d 416 Y -24 -6 d cl s 0.6 0.6 0.6 c
- 960 1119 m 20 -15 d 416 Y -20 16 d f black 960 1119 m 20 -15 d 416 Y -20 16 d
- cl s 1 1 1 c 980 1520 m 24 6 d -21 16 d -23 -6 d f black 980 1520 m 24 6 d -21
- 16 d -23 -6 d cl s 1 1 1 c 957 1098 m 23 6 d 564 Y -23 -6 d f black 957 1098 m
- 23 6 d 564 Y -23 -6 d cl s 0.6 0.6 0.6 c 936 1113 m 21 -15 d 564 Y -21 15 d f
- black 936 1113 m 21 -15 d 564 Y -21 15 d cl s 1 1 1 c 957 1662 m 23 6 d -20 15
- d -24 -6 d f black 957 1662 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 933 1092 m
- 24 6 d 389 Y -24 -6 d f black 933 1092 m 24 6 d 389 Y -24 -6 d cl s 0.6 0.6 0.6
- c 913 1107 m 20 -15 d 389 Y -20 16 d f black 913 1107 m 20 -15 d 389 Y -20 16 d
- cl s 1 1 1 c 933 1481 m 24 6 d -21 16 d -23 -6 d f black 933 1481 m 24 6 d -21
- 16 d -23 -6 d cl s 1 1 1 c 910 1086 m 23 6 d 335 Y -23 -6 d f black 910 1086 m
- 23 6 d 335 Y -23 -6 d cl s 0.6 0.6 0.6 c 889 1101 m 21 -15 d 335 Y -21 16 d f
- black 889 1101 m 21 -15 d 335 Y -21 16 d cl s 1 1 1 c 910 1421 m 23 6 d -20 16
- d -24 -6 d f black 910 1421 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 886 1080 m
- 24 6 d 403 Y -24 -6 d f black 886 1080 m 24 6 d 403 Y -24 -6 d cl s 0.6 0.6 0.6
- c 866 1095 m 20 -15 d 403 Y -20 15 d f black 866 1095 m 20 -15 d 403 Y -20 15 d
- cl s 1 1 1 c 886 1483 m 24 6 d -21 15 d -23 -6 d f black 886 1483 m 24 6 d -21
- 15 d -23 -6 d cl s 1 1 1 c 863 1074 m 23 6 d 524 Y -23 -6 d f black 863 1074 m
- 23 6 d 524 Y -23 -6 d cl s 0.6 0.6 0.6 c 842 1089 m 21 -15 d 524 Y -21 15 d f
- black 842 1089 m 21 -15 d 524 Y -21 15 d cl s 1 1 1 c 863 1598 m 23 6 d -20 15
- d -24 -6 d f black 863 1598 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 839 1068 m
- 24 6 d 403 Y -24 -6 d f black 839 1068 m 24 6 d 403 Y -24 -6 d cl s 0.6 0.6 0.6
- c 819 1083 m 20 -15 d 403 Y -20 15 d f black 819 1083 m 20 -15 d 403 Y -20 15 d
- cl s 1 1 1 c 839 1471 m 24 6 d -21 15 d -23 -6 d f black 839 1471 m 24 6 d -21
- 15 d -23 -6 d cl s 1 1 1 c 816 1062 m 23 6 d 537 Y -23 -6 d f black 816 1062 m
- 23 6 d 537 Y -23 -6 d cl s 0.6 0.6 0.6 c 795 1077 m 21 -15 d 537 Y -21 16 d f
- black 795 1077 m 21 -15 d 537 Y -21 16 d cl s 1 1 1 c 816 1599 m 23 6 d -20 16
- d -24 -6 d f black 816 1599 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 792 1056 m
- 24 6 d 618 Y -24 -6 d f black 792 1056 m 24 6 d 618 Y -24 -6 d cl s 0.6 0.6 0.6
- c 772 1071 m 20 -15 d 618 Y -20 15 d f black 772 1071 m 20 -15 d 618 Y -20 15 d
- cl s 1 1 1 c 792 1674 m 24 6 d -21 15 d -23 -6 d f black 792 1674 m 24 6 d -21
- 15 d -23 -6 d cl s 1 1 1 c 769 1050 m 23 6 d 510 Y -23 -6 d f black 769 1050 m
- 23 6 d 510 Y -23 -6 d cl s 0.6 0.6 0.6 c 748 1065 m 21 -15 d 510 Y -21 16 d f
- black 748 1065 m 21 -15 d 510 Y -21 16 d cl s 1 1 1 c 769 1560 m 23 6 d -20 16
- d -24 -6 d f black 769 1560 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 745 1044 m
- 24 6 d 483 Y -24 -6 d f black 745 1044 m 24 6 d 483 Y -24 -6 d cl s 0.6 0.6 0.6
- c 725 1059 m 20 -15 d 483 Y -20 16 d f black 725 1059 m 20 -15 d 483 Y -20 16 d
- cl s 1 1 1 c 745 1527 m 24 6 d -21 16 d -23 -6 d f black 745 1527 m 24 6 d -21
- 16 d -23 -6 d cl s 1 1 1 c 722 1038 m 23 6 d 336 Y -23 -6 d f black 722 1038 m
- 23 6 d 336 Y -23 -6 d cl s 0.6 0.6 0.6 c 701 1053 m 21 -15 d 336 Y -21 15 d f
- black 701 1053 m 21 -15 d 336 Y -21 15 d cl s 1 1 1 c 722 1374 m 23 6 d -20 15
- d -24 -6 d f black 722 1374 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 698 1032 m
- 24 6 d 403 Y -24 -6 d f black 698 1032 m 24 6 d 403 Y -24 -6 d cl s 0.6 0.6 0.6
- c 678 1047 m 20 -15 d 403 Y -20 15 d f black 678 1047 m 20 -15 d 403 Y -20 15 d
- cl s 1 1 1 c 698 1435 m 24 6 d -21 15 d -23 -6 d f black 698 1435 m 24 6 d -21
- 15 d -23 -6 d cl s 1 1 1 c 675 1026 m 23 6 d 578 Y -23 -6 d f black 675 1026 m
- 23 6 d 578 Y -23 -6 d cl s 0.6 0.6 0.6 c 654 1041 m 21 -15 d 578 Y -21 15 d f
- black 654 1041 m 21 -15 d 578 Y -21 15 d cl s 1 1 1 c 675 1604 m 23 6 d -20 15
- d -24 -6 d f black 675 1604 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 651 1020 m
- 24 6 d 537 Y -24 -6 d f black 651 1020 m 24 6 d 537 Y -24 -6 d cl s 0.6 0.6 0.6
- c 631 1035 m 20 -15 d 537 Y -20 16 d f black 631 1035 m 20 -15 d 537 Y -20 16 d
- cl s 1 1 1 c 651 1557 m 24 6 d -21 16 d -23 -6 d f black 651 1557 m 24 6 d -21
- 16 d -23 -6 d cl s 1 1 1 c 628 1014 m 23 6 d 443 Y -23 -6 d f black 628 1014 m
- 23 6 d 443 Y -23 -6 d cl s 0.6 0.6 0.6 c 607 1029 m 21 -15 d 443 Y -21 16 d f
- black 607 1029 m 21 -15 d 443 Y -21 16 d cl s 1 1 1 c 628 1457 m 23 6 d -20 16
- d -24 -6 d f black 628 1457 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 604 1008 m
- 24 6 d 564 Y -24 -6 d f black 604 1008 m 24 6 d 564 Y -24 -6 d cl s 0.6 0.6 0.6
- c 584 1023 m 20 -15 d 564 Y -20 16 d f black 584 1023 m 20 -15 d 564 Y -20 16 d
- cl s 1 1 1 c 604 1572 m 24 6 d -21 16 d -23 -6 d f black 604 1572 m 24 6 d -21
- 16 d -23 -6 d cl s 1 1 1 c 581 1002 m 23 6 d 349 Y -23 -6 d f black 581 1002 m
- 23 6 d 349 Y -23 -6 d cl s 0.6 0.6 0.6 c 560 1017 m 21 -15 d 349 Y -21 16 d f
- black 560 1017 m 21 -15 d 349 Y -21 16 d cl s 1 1 1 c 581 1351 m 23 6 d -20 16
- d -24 -6 d f black 581 1351 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 557 996 m
- 24 6 d -21 15 d -23 -6 d f black 557 996 m 24 6 d -21 15 d -23 -6 d cl s 1 1 1
- c 534 990 m 23 6 d -20 15 d -24 -6 d f black 534 990 m 23 6 d -20 15 d -24 -6 d
- cl s 1 1 1 c 510 984 m 24 6 d -21 15 d -23 -6 d f black 510 984 m 24 6 d -21 15
- d -23 -6 d cl s 1 1 1 c 487 978 m 23 6 d -20 15 d -24 -6 d f black 487 978 m 23
- 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1611 1243 m 24 6 d -21 16 d -23 -6 d f black
- 1611 1243 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 1588 1237 m 23 6 d -20 16 d
- -24 -6 d f black 1588 1237 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1564 1232 m
- 24 5 d -21 16 d -23 -6 d f black 1564 1232 m 24 5 d -21 16 d -23 -6 d cl s 1 1
- 1 c 1541 1226 m 23 6 d -20 15 d -24 -6 d f black 1541 1226 m 23 6 d -20 15 d
- -24 -6 d cl s 1 1 1 c 1517 1220 m 24 6 d 752 Y -24 -6 d f black 1517 1220 m 24
- 6 d 752 Y -24 -6 d cl s 0.6 0.6 0.6 c 1497 1235 m 20 -15 d 752 Y -20 16 d f
- black 1497 1235 m 20 -15 d 752 Y -20 16 d cl s 1 1 1 c 1517 1972 m 24 6 d -21
- 15 d -23 -5 d f black 1517 1972 m 24 6 d -21 15 d -23 -5 d cl s 1 1 1 c 1494
- 1214 m 23 6 d 604 Y -23 -6 d f black 1494 1214 m 23 6 d 604 Y -23 -6 d cl s 0.6
- 0.6 0.6 c 1473 1229 m 21 -15 d 604 Y -21 16 d f black 1473 1229 m 21 -15 d 604
- Y -21 16 d cl s 1 1 1 c 1494 1818 m 23 6 d -20 16 d -24 -6 d f black 1494 1818
- m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1470 1208 m 24 6 d 631 Y -24 -6 d f
- black 1470 1208 m 24 6 d 631 Y -24 -6 d cl s 0.6 0.6 0.6 c 1450 1223 m 20 -15 d
- 631 Y -20 16 d f black 1450 1223 m 20 -15 d 631 Y -20 16 d cl s 1 1 1 c 1470
- 1839 m 24 6 d -21 16 d -23 -6 d f black 1470 1839 m 24 6 d -21 16 d -23 -6 d
- cl s 1 1 1 c 1447 1202 m 23 6 d 349 Y -23 -6 d f black 1447 1202 m 23 6 d 349 Y
- -23 -6 d cl s 0.6 0.6 0.6 c 1426 1217 m 21 -15 d 349 Y -21 15 d f black 1426
- 1217 m 21 -15 d 349 Y -21 15 d cl s 1 1 1 c 1447 1551 m 23 6 d -20 15 d -24 -6
- d f black 1447 1551 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1423 1196 m 24 6 d
- 658 Y -24 -6 d f black 1423 1196 m 24 6 d 658 Y -24 -6 d cl s 0.6 0.6 0.6 c
- 1403 1211 m 20 -15 d 658 Y -20 16 d f black 1403 1211 m 20 -15 d 658 Y -20 16 d
- cl s 1 1 1 c 1423 1854 m 24 6 d -21 16 d -23 -6 d f black 1423 1854 m 24 6 d
- -21 16 d -23 -6 d cl s 1 1 1 c 1400 1190 m 23 6 d 430 Y -23 -6 d f black 1400
- 1190 m 23 6 d 430 Y -23 -6 d cl s 0.6 0.6 0.6 c 1379 1205 m 21 -15 d 430 Y -21
- 15 d f black 1379 1205 m 21 -15 d 430 Y -21 15 d cl s 1 1 1 c 1400 1620 m 23 6
- d -20 15 d -24 -6 d f black 1400 1620 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c
- 1376 1184 m 24 6 d 645 Y -24 -6 d f black 1376 1184 m 24 6 d 645 Y -24 -6 d
- cl s 0.6 0.6 0.6 c 1356 1199 m 20 -15 d 645 Y -20 15 d f black 1356 1199 m 20
- -15 d 645 Y -20 15 d cl s 1 1 1 c 1376 1829 m 24 6 d -21 15 d -23 -6 d f black
- 1376 1829 m 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 1353 1178 m 23 6 d 604 Y -23
- -6 d f black 1353 1178 m 23 6 d 604 Y -23 -6 d cl s 0.6 0.6 0.6 c 1332 1193 m
- 21 -15 d 604 Y -21 16 d f black 1332 1193 m 21 -15 d 604 Y -21 16 d cl s 1 1 1
- c 1353 1782 m 23 6 d -20 16 d -24 -6 d f black 1353 1782 m 23 6 d -20 16 d -24
- -6 d cl s 1 1 1 c 1329 1172 m 24 6 d 618 Y -24 -6 d f black 1329 1172 m 24 6 d
- 618 Y -24 -6 d cl s 0.6 0.6 0.6 c 1309 1187 m 20 -15 d 618 Y -20 15 d f black
- 1309 1187 m 20 -15 d 618 Y -20 15 d cl s 1 1 1 c 1329 1790 m 24 6 d -21 15 d
- -23 -6 d f black 1329 1790 m 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 1306 1166 m
- 23 6 d 604 Y -23 -6 d f black 1306 1166 m 23 6 d 604 Y -23 -6 d cl s 0.6 0.6
- 0.6 c 1285 1181 m 21 -15 d 604 Y -21 16 d f black 1285 1181 m 21 -15 d 604 Y
- -21 16 d cl s 1 1 1 c 1306 1770 m 23 6 d -20 16 d -24 -6 d f black 1306 1770 m
- 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1282 1160 m 24 6 d 457 Y -24 -6 d f black
- 1282 1160 m 24 6 d 457 Y -24 -6 d cl s 0.6 0.6 0.6 c 1262 1175 m 20 -15 d 457 Y
- -20 15 d f black 1262 1175 m 20 -15 d 457 Y -20 15 d cl s 1 1 1 c 1282 1617 m
- 24 6 d -21 15 d -23 -6 d f black 1282 1617 m 24 6 d -21 15 d -23 -6 d cl s 1 1
- 1 c 1259 1154 m 23 6 d 443 Y -23 -6 d f black 1259 1154 m 23 6 d 443 Y -23 -6 d
- cl s 0.6 0.6 0.6 c 1238 1169 m 21 -15 d 443 Y -21 16 d f black 1238 1169 m 21
- -15 d 443 Y -21 16 d cl s 1 1 1 c 1259 1597 m 23 6 d -20 16 d -24 -6 d f black
- 1259 1597 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1235 1148 m 24 6 d 578 Y -24
- -6 d f black 1235 1148 m 24 6 d 578 Y -24 -6 d cl s 0.6 0.6 0.6 c 1215 1163 m
- 20 -15 d 578 Y -20 15 d f black 1215 1163 m 20 -15 d 578 Y -20 15 d cl s 1 1 1
- c 1235 1726 m 24 6 d -21 15 d -23 -6 d f black 1235 1726 m 24 6 d -21 15 d -23
- -6 d cl s 1 1 1 c 1212 1142 m 23 6 d 470 Y -23 -6 d f black 1212 1142 m 23 6 d
- 470 Y -23 -6 d cl s 0.6 0.6 0.6 c 1191 1157 m 21 -15 d 470 Y -21 16 d f black
- 1191 1157 m 21 -15 d 470 Y -21 16 d cl s 1 1 1 c 1212 1612 m 23 6 d -20 16 d
- -24 -6 d f black 1212 1612 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1188 1136 m
- 24 6 d 672 Y -24 -6 d f black 1188 1136 m 24 6 d 672 Y -24 -6 d cl s 0.6 0.6
- 0.6 c 1168 1151 m 20 -15 d 672 Y -20 15 d f black 1168 1151 m 20 -15 d 672 Y
- -20 15 d cl s 1 1 1 c 1188 1808 m 24 6 d -21 15 d -23 -6 d f black 1188 1808 m
- 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 1165 1130 m 23 6 d 578 Y -23 -6 d f black
- 1165 1130 m 23 6 d 578 Y -23 -6 d cl s 0.6 0.6 0.6 c 1144 1145 m 21 -15 d 578 Y
- -21 15 d f black 1144 1145 m 21 -15 d 578 Y -21 15 d cl s 1 1 1 c 1165 1708 m
- 23 6 d -20 15 d -24 -6 d f black 1165 1708 m 23 6 d -20 15 d -24 -6 d cl s 1 1
- 1 c 1141 1124 m 24 6 d 416 Y -24 -6 d f black 1141 1124 m 24 6 d 416 Y -24 -6 d
- cl s 0.6 0.6 0.6 c 1121 1139 m 20 -15 d 416 Y -20 16 d f black 1121 1139 m 20
- -15 d 416 Y -20 16 d cl s 1 1 1 c 1141 1540 m 24 6 d -21 16 d -23 -6 d f black
- 1141 1540 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 1118 1118 m 23 6 d 524 Y -23
- -6 d f black 1118 1118 m 23 6 d 524 Y -23 -6 d cl s 0.6 0.6 0.6 c 1097 1133 m
- 21 -15 d 524 Y -21 15 d f black 1097 1133 m 21 -15 d 524 Y -21 15 d cl s 1 1 1
- c 1118 1642 m 23 6 d -20 15 d -24 -6 d f black 1118 1642 m 23 6 d -20 15 d -24
- -6 d cl s 1 1 1 c 1094 1112 m 24 6 d 578 Y -24 -6 d f black 1094 1112 m 24 6 d
- 578 Y -24 -6 d cl s 0.6 0.6 0.6 c 1074 1127 m 20 -15 d 578 Y -20 15 d f black
- 1074 1127 m 20 -15 d 578 Y -20 15 d cl s 1 1 1 c 1094 1690 m 24 6 d -21 15 d
- -23 -6 d f black 1094 1690 m 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 1071 1106 m
- 23 6 d 510 Y -23 -5 d f black 1071 1106 m 23 6 d 510 Y -23 -5 d cl s 0.6 0.6
- 0.6 c 1050 1121 m 21 -15 d 511 Y -21 15 d f black 1050 1121 m 21 -15 d 511 Y
- -21 15 d cl s 1 1 1 c 1071 1617 m 23 5 d -20 16 d -24 -6 d f black 1071 1617 m
- 23 5 d -20 16 d -24 -6 d cl s 1 1 1 c 1047 1100 m 24 6 d 631 Y -24 -6 d f black
- 1047 1100 m 24 6 d 631 Y -24 -6 d cl s 0.6 0.6 0.6 c 1027 1115 m 20 -15 d 631 Y
- -20 16 d f black 1027 1115 m 20 -15 d 631 Y -20 16 d cl s 1 1 1 c 1047 1731 m
- 24 6 d -21 16 d -23 -6 d f black 1047 1731 m 24 6 d -21 16 d -23 -6 d cl s 1 1
- 1 c 1024 1094 m 23 6 d 484 Y -23 -6 d f black 1024 1094 m 23 6 d 484 Y -23 -6 d
- cl s 0.6 0.6 0.6 c 1004 1110 m 20 -16 d 484 Y -20 15 d f black 1004 1110 m 20
- -16 d 484 Y -20 15 d cl s 1 1 1 c 1024 1578 m 23 6 d -20 15 d -23 -6 d f black
- 1024 1578 m 23 6 d -20 15 d -23 -6 d cl s 1 1 1 c 1000 1088 m 24 6 d 470 Y -24
- -6 d f black 1000 1088 m 24 6 d 470 Y -24 -6 d cl s 0.6 0.6 0.6 c 980 1104 m 20
- -16 d 470 Y -20 16 d f black 980 1104 m 20 -16 d 470 Y -20 16 d cl s 1 1 1 c
- 1000 1558 m 24 6 d -20 16 d -24 -6 d f black 1000 1558 m 24 6 d -20 16 d -24 -6
- d cl s 1 1 1 c 977 1082 m 23 6 d 511 Y -23 -6 d f black 977 1082 m 23 6 d 511 Y
- -23 -6 d cl s 0.6 0.6 0.6 c 957 1098 m 20 -16 d 511 Y -20 15 d f black 957 1098
- m 20 -16 d 511 Y -20 15 d cl s 1 1 1 c 977 1593 m 23 6 d -20 15 d -23 -6 d f
- black 977 1593 m 23 6 d -20 15 d -23 -6 d cl s 1 1 1 c 953 1076 m 24 6 d 645 Y
- -24 -6 d f black 953 1076 m 24 6 d 645 Y -24 -6 d cl s 0.6 0.6 0.6 c 933 1092 m
- 20 -16 d 645 Y -20 16 d f black 933 1092 m 20 -16 d 645 Y -20 16 d cl s 1 1 1 c
- 953 1721 m 24 6 d -20 15 d -24 -5 d f black 953 1721 m 24 6 d -20 15 d -24 -5 d
- cl s 1 1 1 c 930 1070 m 23 6 d 712 Y -23 -6 d f black 930 1070 m 23 6 d 712 Y
- -23 -6 d cl s 0.6 0.6 0.6 c 910 1086 m 20 -16 d 712 Y -20 16 d f black 910 1086
- m 20 -16 d 712 Y -20 16 d cl s 1 1 1 c 930 1782 m 23 6 d -20 16 d -23 -6 d f
- black 930 1782 m 23 6 d -20 16 d -23 -6 d cl s 1 1 1 c 906 1064 m 24 6 d 497 Y
- -24 -6 d f black 906 1064 m 24 6 d 497 Y -24 -6 d cl s 0.6 0.6 0.6 c 886 1080 m
- 20 -16 d 497 Y -20 16 d f black 886 1080 m 20 -16 d 497 Y -20 16 d cl s 1 1 1 c
- 906 1561 m 24 6 d -20 16 d -24 -6 d f black 906 1561 m 24 6 d -20 16 d -24 -6 d
- cl s 1 1 1 c 883 1058 m 23 6 d 538 Y -23 -6 d f black 883 1058 m 23 6 d 538 Y
- -23 -6 d cl s 0.6 0.6 0.6 c 863 1074 m 20 -16 d 538 Y -20 15 d f black 863 1074
- m 20 -16 d 538 Y -20 15 d cl s 1 1 1 c 883 1596 m 23 6 d -20 15 d -23 -6 d f
- black 883 1596 m 23 6 d -20 15 d -23 -6 d cl s 1 1 1 c 859 1052 m 24 6 d 672 Y
- -24 -6 d f black 859 1052 m 24 6 d 672 Y -24 -6 d cl s 0.6 0.6 0.6 c 839 1068 m
- 20 -16 d 672 Y -20 15 d f black 839 1068 m 20 -16 d 672 Y -20 15 d cl s 1 1 1 c
- 859 1724 m 24 6 d -20 15 d -24 -6 d f black 859 1724 m 24 6 d -20 15 d -24 -6 d
- cl s 1 1 1 c 836 1046 m 23 6 d 403 Y -23 -6 d f black 836 1046 m 23 6 d 403 Y
- -23 -6 d cl s 0.6 0.6 0.6 c 816 1062 m 20 -16 d 403 Y -20 16 d f black 816 1062
- m 20 -16 d 403 Y -20 16 d cl s 1 1 1 c 836 1449 m 23 6 d -20 16 d -23 -6 d f
- black 836 1449 m 23 6 d -20 16 d -23 -6 d cl s 1 1 1 c 812 1040 m 24 6 d 578 Y
- -24 -6 d f black 812 1040 m 24 6 d 578 Y -24 -6 d cl s 0.6 0.6 0.6 c 792 1056 m
- 20 -16 d 578 Y -20 15 d f black 792 1056 m 20 -16 d 578 Y -20 15 d cl s 1 1 1 c
- 812 1618 m 24 6 d -20 15 d -24 -6 d f black 812 1618 m 24 6 d -20 15 d -24 -6 d
- cl s 1 1 1 c 789 1034 m 23 6 d 538 Y -23 -6 d f black 789 1034 m 23 6 d 538 Y
- -23 -6 d cl s 0.6 0.6 0.6 c 769 1050 m 20 -16 d 538 Y -20 15 d f black 769 1050
- m 20 -16 d 538 Y -20 15 d cl s 1 1 1 c 789 1572 m 23 6 d -20 15 d -23 -6 d f
- black 789 1572 m 23 6 d -20 15 d -23 -6 d cl s 1 1 1 c 765 1028 m 24 6 d 739 Y
- -24 -6 d f black 765 1028 m 24 6 d 739 Y -24 -6 d cl s 0.6 0.6 0.6 c 745 1044 m
- 20 -16 d 739 Y -20 16 d f black 745 1044 m 20 -16 d 739 Y -20 16 d cl s 1 1 1 c
- 765 1767 m 24 6 d -20 16 d -24 -6 d f black 765 1767 m 24 6 d -20 16 d -24 -6 d
- cl s 1 1 1 c 742 1022 m 23 6 d 591 Y -23 -6 d f black 742 1022 m 23 6 d 591 Y
- -23 -6 d cl s 0.6 0.6 0.6 c 722 1038 m 20 -16 d 591 Y -20 16 d f black 722 1038
- m 20 -16 d 591 Y -20 16 d cl s 1 1 1 c 742 1613 m 23 6 d -20 16 d -23 -6 d f
- black 742 1613 m 23 6 d -20 16 d -23 -6 d cl s 1 1 1 c 718 1016 m 24 6 d 497 Y
- -24 -6 d f black 718 1016 m 24 6 d 497 Y -24 -6 d cl s 0.6 0.6 0.6 c 698 1032 m
- 20 -16 d 497 Y -20 16 d f black 698 1032 m 20 -16 d 497 Y -20 16 d cl s 1 1 1 c
- 718 1513 m 24 6 d -20 16 d -24 -6 d f black 718 1513 m 24 6 d -20 16 d -24 -6 d
- cl s 1 1 1 c 695 1010 m 23 6 d 551 Y -23 -6 d f black 695 1010 m 23 6 d 551 Y
- -23 -6 d cl s 0.6 0.6 0.6 c 675 1026 m 20 -16 d 551 Y -20 16 d f black 675 1026
- m 20 -16 d 551 Y -20 16 d cl s 1 1 1 c 695 1561 m 23 6 d -20 16 d -23 -6 d f
- black 695 1561 m 23 6 d -20 16 d -23 -6 d cl s 1 1 1 c 672 1004 m 23 6 d 699 Y
- -23 -6 d f black 672 1004 m 23 6 d 699 Y -23 -6 d cl s 0.6 0.6 0.6 c 651 1020 m
- 21 -16 d 699 Y -21 15 d f black 651 1020 m 21 -16 d 699 Y -21 15 d cl s 1 1 1 c
- 672 1703 m 23 6 d -20 15 d -24 -6 d f black 672 1703 m 23 6 d -20 15 d -24 -6 d
- cl s 1 1 1 c 648 998 m 24 6 d 578 Y -24 -6 d f black 648 998 m 24 6 d 578 Y -24
- -6 d cl s 0.6 0.6 0.6 c 628 1014 m 20 -16 d 578 Y -20 16 d f black 628 1014 m
- 20 -16 d 578 Y -20 16 d cl s 1 1 1 c 648 1576 m 24 6 d -21 16 d -23 -6 d f
- black 648 1576 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 625 992 m 23 6 d 686 Y
- -23 -6 d f black 625 992 m 23 6 d 686 Y -23 -6 d cl s 0.6 0.6 0.6 c 604 1008 m
- 21 -16 d 686 Y -21 15 d f black 604 1008 m 21 -16 d 686 Y -21 15 d cl s 1 1 1 c
- 625 1678 m 23 6 d -20 15 d -24 -6 d f black 625 1678 m 23 6 d -20 15 d -24 -6 d
- cl s 1 1 1 c 601 986 m 24 6 d 739 Y -24 -6 d f black 601 986 m 24 6 d 739 Y -24
- -6 d cl s 0.6 0.6 0.6 c 581 1002 m 20 -16 d 739 Y -20 16 d f black 581 1002 m
- 20 -16 d 739 Y -20 16 d cl s 1 1 1 c 601 1725 m 24 6 d -21 16 d -23 -6 d f
- black 601 1725 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 578 980 m 23 6 d -20 16
- d -24 -6 d f black 578 980 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 554 974 m 24
- 6 d -21 16 d -23 -6 d f black 554 974 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c
- 531 968 m 23 6 d -20 16 d -24 -6 d f black 531 968 m 23 6 d -20 16 d -24 -6 d
- cl s 1 1 1 c 507 962 m 24 6 d -21 16 d -23 -6 d f black 507 962 m 24 6 d -21 16
- d -23 -6 d cl s 1 1 1 c 1631 1228 m 24 6 d -20 15 d -24 -6 d f black 1631 1228
- m 24 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1608 1222 m 23 6 d -20 15 d -23 -6 d f
- black 1608 1222 m 23 6 d -20 15 d -23 -6 d cl s 1 1 1 c 1584 1216 m 24 6 d -20
- 15 d -24 -5 d f black 1584 1216 m 24 6 d -20 15 d -24 -5 d cl s 1 1 1 c 1561
- 1210 m 23 6 d -20 16 d -23 -6 d f black 1561 1210 m 23 6 d -20 16 d -23 -6 d
- cl s 1 1 1 c 1537 1204 m 24 6 d 699 Y -24 -6 d f black 1537 1204 m 24 6 d 699 Y
- -24 -6 d cl s 0.6 0.6 0.6 c 1517 1220 m 20 -16 d 699 Y -20 15 d f black 1517
- 1220 m 20 -16 d 699 Y -20 15 d cl s 1 1 1 c 1537 1903 m 24 6 d -20 15 d -24 -6
- d f black 1537 1903 m 24 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1514 1198 m 23 6 d
- 632 Y -23 -6 d f black 1514 1198 m 23 6 d 632 Y -23 -6 d cl s 0.6 0.6 0.6 c
- 1494 1214 m 20 -16 d 632 Y -20 15 d f black 1494 1214 m 20 -16 d 632 Y -20 15 d
- cl s 1 1 1 c 1514 1830 m 23 6 d -20 15 d -23 -6 d f black 1514 1830 m 23 6 d
- -20 15 d -23 -6 d cl s 1 1 1 c 1490 1192 m 24 6 d 645 Y -24 -6 d f black 1490
- 1192 m 24 6 d 645 Y -24 -6 d cl s 0.6 0.6 0.6 c 1470 1208 m 20 -16 d 645 Y -20
- 16 d f black 1470 1208 m 20 -16 d 645 Y -20 16 d cl s 1 1 1 c 1490 1837 m 24 6
- d -20 15 d -24 -5 d f black 1490 1837 m 24 6 d -20 15 d -24 -5 d cl s 1 1 1 c
- 1467 1186 m 23 6 d 658 Y -23 -6 d f black 1467 1186 m 23 6 d 658 Y -23 -6 d
- cl s 0.6 0.6 0.6 c 1447 1202 m 20 -16 d 658 Y -20 16 d f black 1447 1202 m 20
- -16 d 658 Y -20 16 d cl s 1 1 1 c 1467 1844 m 23 6 d -20 16 d -23 -6 d f black
- 1467 1844 m 23 6 d -20 16 d -23 -6 d cl s 1 1 1 c 1444 1180 m 23 6 d 538 Y -23
- -6 d f black 1444 1180 m 23 6 d 538 Y -23 -6 d cl s 0.6 0.6 0.6 c 1423 1196 m
- 21 -16 d 538 Y -21 15 d f black 1423 1196 m 21 -16 d 538 Y -21 15 d cl s 1 1 1
- c 1444 1718 m 23 6 d -20 15 d -24 -6 d f black 1444 1718 m 23 6 d -20 15 d -24
- -6 d cl s 1 1 1 c 1420 1174 m 24 6 d 605 Y -24 -6 d f black 1420 1174 m 24 6 d
- 605 Y -24 -6 d cl s 0.6 0.6 0.6 c 1400 1190 m 20 -16 d 605 Y -20 15 d f black
- 1400 1190 m 20 -16 d 605 Y -20 15 d cl s 1 1 1 c 1420 1779 m 24 6 d -21 15 d
- -23 -6 d f black 1420 1779 m 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 1397 1168 m
- 23 6 d 605 Y -23 -6 d f black 1397 1168 m 23 6 d 605 Y -23 -6 d cl s 0.6 0.6
- 0.6 c 1376 1184 m 21 -16 d 605 Y -21 15 d f black 1376 1184 m 21 -16 d 605 Y
- -21 15 d cl s 1 1 1 c 1397 1773 m 23 6 d -20 15 d -24 -6 d f black 1397 1773 m
- 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1373 1162 m 24 6 d 497 Y -24 -6 d f black
- 1373 1162 m 24 6 d 497 Y -24 -6 d cl s 0.6 0.6 0.6 c 1353 1178 m 20 -16 d 497 Y
- -20 16 d f black 1353 1178 m 20 -16 d 497 Y -20 16 d cl s 1 1 1 c 1373 1659 m
- 24 6 d -21 16 d -23 -6 d f black 1373 1659 m 24 6 d -21 16 d -23 -6 d cl s 1 1
- 1 c 1350 1156 m 23 6 d 900 Y -23 -6 d f black 1350 1156 m 23 6 d 900 Y -23 -6 d
- cl s 0.6 0.6 0.6 c 1329 1172 m 21 -16 d 900 Y -21 16 d f black 1329 1172 m 21
- -16 d 900 Y -21 16 d cl s 1 1 1 c 1350 2056 m 23 6 d -20 16 d -24 -6 d f black
- 1350 2056 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1326 1150 m 24 6 d 685 Y -24
- -6 d f black 1326 1150 m 24 6 d 685 Y -24 -6 d cl s 0.6 0.6 0.6 c 1306 1166 m
- 20 -16 d 685 Y -20 16 d f black 1306 1166 m 20 -16 d 685 Y -20 16 d cl s 1 1 1
- c 1326 1835 m 24 6 d -21 16 d -23 -6 d f black 1326 1835 m 24 6 d -21 16 d -23
- -6 d cl s 1 1 1 c 1303 1144 m 23 6 d 672 Y -23 -6 d f black 1303 1144 m 23 6 d
- 672 Y -23 -6 d cl s 0.6 0.6 0.6 c 1282 1160 m 21 -16 d 672 Y -21 16 d f black
- 1282 1160 m 21 -16 d 672 Y -21 16 d cl s 1 1 1 c 1303 1816 m 23 6 d -20 16 d
- -24 -6 d f black 1303 1816 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1279 1138 m
- 24 6 d 712 Y -24 -6 d f black 1279 1138 m 24 6 d 712 Y -24 -6 d cl s 0.6 0.6
- 0.6 c 1259 1154 m 20 -16 d 712 Y -20 16 d f black 1259 1154 m 20 -16 d 712 Y
- -20 16 d cl s 1 1 1 c 1279 1850 m 24 6 d -21 16 d -23 -6 d f black 1279 1850 m
- 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 1256 1132 m 23 6 d 659 Y -23 -6 d f black
- 1256 1132 m 23 6 d 659 Y -23 -6 d cl s 0.6 0.6 0.6 c 1235 1148 m 21 -16 d 659 Y
- -21 15 d f black 1235 1148 m 21 -16 d 659 Y -21 15 d cl s 1 1 1 c 1256 1791 m
- 23 6 d -20 15 d -24 -6 d f black 1256 1791 m 23 6 d -20 15 d -24 -6 d cl s 1 1
- 1 c 1232 1126 m 24 6 d 699 Y -24 -6 d f black 1232 1126 m 24 6 d 699 Y -24 -6 d
- cl s 0.6 0.6 0.6 c 1212 1142 m 20 -16 d 699 Y -20 15 d f black 1212 1142 m 20
- -16 d 699 Y -20 15 d cl s 1 1 1 c 1232 1825 m 24 6 d -21 15 d -23 -6 d f black
- 1232 1825 m 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 1209 1120 m 23 6 d 605 Y -23
- -6 d f black 1209 1120 m 23 6 d 605 Y -23 -6 d cl s 0.6 0.6 0.6 c 1188 1136 m
- 21 -16 d 605 Y -21 15 d f black 1188 1136 m 21 -16 d 605 Y -21 15 d cl s 1 1 1
- c 1209 1725 m 23 6 d -20 15 d -24 -6 d f black 1209 1725 m 23 6 d -20 15 d -24
- -6 d cl s 1 1 1 c 1185 1114 m 24 6 d 471 Y -24 -6 d f black 1185 1114 m 24 6 d
- 471 Y -24 -6 d cl s 0.6 0.6 0.6 c 1165 1130 m 20 -16 d 471 Y -20 15 d f black
- 1165 1130 m 20 -16 d 471 Y -20 15 d cl s 1 1 1 c 1185 1585 m 24 6 d -21 15 d
- -23 -6 d f black 1185 1585 m 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 1162 1108 m
- 23 6 d 578 Y -23 -6 d f black 1162 1108 m 23 6 d 578 Y -23 -6 d cl s 0.6 0.6
- 0.6 c 1141 1124 m 21 -16 d 578 Y -21 16 d f black 1141 1124 m 21 -16 d 578 Y
- -21 16 d cl s 1 1 1 c 1162 1686 m 23 6 d -20 16 d -24 -6 d f black 1162 1686 m
- 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1138 1102 m 24 6 d 632 Y -24 -6 d f black
- 1138 1102 m 24 6 d 632 Y -24 -6 d cl s 0.6 0.6 0.6 c 1118 1118 m 20 -16 d 632 Y
- -20 15 d f black 1118 1118 m 20 -16 d 632 Y -20 15 d cl s 1 1 1 c 1138 1734 m
- 24 6 d -21 15 d -23 -6 d f black 1138 1734 m 24 6 d -21 15 d -23 -6 d cl s 1 1
- 1 c 1115 1096 m 23 6 d 659 Y -23 -6 d f black 1115 1096 m 23 6 d 659 Y -23 -6 d
- cl s 0.6 0.6 0.6 c 1094 1112 m 21 -16 d 659 Y -21 15 d f black 1094 1112 m 21
- -16 d 659 Y -21 15 d cl s 1 1 1 c 1115 1755 m 23 6 d -20 15 d -24 -6 d f black
- 1115 1755 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1091 1090 m 24 6 d 578 Y -24
- -6 d f black 1091 1090 m 24 6 d 578 Y -24 -6 d cl s 0.6 0.6 0.6 c 1071 1106 m
- 20 -16 d 578 Y -20 16 d f black 1071 1106 m 20 -16 d 578 Y -20 16 d cl s 1 1 1
- c 1091 1668 m 24 6 d -21 16 d -23 -6 d f black 1091 1668 m 24 6 d -21 16 d -23
- -6 d cl s 1 1 1 c 1068 1084 m 23 6 d 605 Y -23 -6 d f black 1068 1084 m 23 6 d
- 605 Y -23 -6 d cl s 0.6 0.6 0.6 c 1047 1100 m 21 -16 d 605 Y -21 16 d f black
- 1047 1100 m 21 -16 d 605 Y -21 16 d cl s 1 1 1 c 1068 1689 m 23 6 d -20 16 d
- -24 -6 d f black 1068 1689 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1044 1078 m
- 24 6 d 645 Y -24 -6 d f black 1044 1078 m 24 6 d 645 Y -24 -6 d cl s 0.6 0.6
- 0.6 c 1024 1094 m 20 -16 d 645 Y -20 16 d f black 1024 1094 m 20 -16 d 645 Y
- -20 16 d cl s 1 1 1 c 1044 1723 m 24 6 d -21 16 d -23 -6 d f black 1044 1723 m
- 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 1021 1072 m 23 6 d 538 Y -23 -6 d f black
- 1021 1072 m 23 6 d 538 Y -23 -6 d cl s 0.6 0.6 0.6 c 1000 1088 m 21 -16 d 538 Y
- -21 15 d f black 1000 1088 m 21 -16 d 538 Y -21 15 d cl s 1 1 1 c 1021 1610 m
- 23 6 d -20 15 d -24 -6 d f black 1021 1610 m 23 6 d -20 15 d -24 -6 d cl s 1 1
- 1 c 997 1066 m 24 6 d 699 Y -24 -6 d f black 997 1066 m 24 6 d 699 Y -24 -6 d
- cl s 0.6 0.6 0.6 c 977 1082 m 20 -16 d 699 Y -20 16 d f black 977 1082 m 20 -16
- d 699 Y -20 16 d cl s 1 1 1 c 997 1765 m 24 6 d -21 16 d -23 -6 d f black 997
- 1765 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 974 1061 m 23 5 d 551 Y -23 -6 d f
- black 974 1061 m 23 5 d 551 Y -23 -6 d cl s 0.6 0.6 0.6 c 953 1076 m 21 -15 d
- 550 Y -21 16 d f black 953 1076 m 21 -15 d 550 Y -21 16 d cl s 1 1 1 c 974 1611
- m 23 6 d -20 16 d -24 -6 d f black 974 1611 m 23 6 d -20 16 d -24 -6 d cl s 1 1
- 1 c 950 1055 m 24 6 d 550 Y -24 -6 d f black 950 1055 m 24 6 d 550 Y -24 -6 d
- cl s 0.6 0.6 0.6 c 930 1070 m 20 -15 d 550 Y -20 16 d f black 930 1070 m 20 -15
- d 550 Y -20 16 d cl s 1 1 1 c 950 1605 m 24 6 d -21 16 d -23 -6 d f black 950
- 1605 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 927 1049 m 23 6 d 618 Y -23 -6 d f
- black 927 1049 m 23 6 d 618 Y -23 -6 d cl s 0.6 0.6 0.6 c 906 1064 m 21 -15 d
- 618 Y -21 15 d f black 906 1064 m 21 -15 d 618 Y -21 15 d cl s 1 1 1 c 927 1667
- m 23 6 d -20 15 d -24 -6 d f black 927 1667 m 23 6 d -20 15 d -24 -6 d cl s 1 1
- 1 c 903 1043 m 24 6 d 671 Y -24 -6 d f black 903 1043 m 24 6 d 671 Y -24 -6 d
- cl s 0.6 0.6 0.6 c 883 1058 m 20 -15 d 671 Y -20 16 d f black 883 1058 m 20 -15
- d 671 Y -20 16 d cl s 1 1 1 c 903 1714 m 24 6 d -21 16 d -23 -6 d f black 903
- 1714 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 880 1037 m 23 6 d 671 Y -23 -6 d f
- black 880 1037 m 23 6 d 671 Y -23 -6 d cl s 0.6 0.6 0.6 c 859 1052 m 21 -15 d
- 671 Y -21 16 d f black 859 1052 m 21 -15 d 671 Y -21 16 d cl s 1 1 1 c 880 1708
- m 23 6 d -20 16 d -24 -6 d f black 880 1708 m 23 6 d -20 16 d -24 -6 d cl s 1 1
- 1 c 856 1031 m 24 6 d 658 Y -24 -6 d f black 856 1031 m 24 6 d 658 Y -24 -6 d
- cl s 0.6 0.6 0.6 c 836 1046 m 20 -15 d 658 Y -20 16 d f black 836 1046 m 20 -15
- d 658 Y -20 16 d cl s 1 1 1 c 856 1689 m 24 6 d -21 15 d -23 -5 d f black 856
- 1689 m 24 6 d -21 15 d -23 -5 d cl s 1 1 1 c 833 1025 m 23 6 d 577 Y -23 -6 d f
- black 833 1025 m 23 6 d 577 Y -23 -6 d cl s 0.6 0.6 0.6 c 812 1040 m 21 -15 d
- 577 Y -21 16 d f black 812 1040 m 21 -15 d 577 Y -21 16 d cl s 1 1 1 c 833 1602
- m 23 6 d -20 16 d -24 -6 d f black 833 1602 m 23 6 d -20 16 d -24 -6 d cl s 1 1
- 1 c 809 1019 m 24 6 d 698 Y -24 -6 d f black 809 1019 m 24 6 d 698 Y -24 -6 d
- cl s 0.6 0.6 0.6 c 789 1034 m 20 -15 d 698 Y -20 16 d f black 789 1034 m 20 -15
- d 698 Y -20 16 d cl s 1 1 1 c 809 1717 m 24 6 d -21 16 d -23 -6 d f black 809
- 1717 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 786 1013 m 23 6 d 860 Y -23 -6 d f
- black 786 1013 m 23 6 d 860 Y -23 -6 d cl s 0.6 0.6 0.6 c 765 1028 m 21 -15 d
- 860 Y -21 15 d f black 765 1028 m 21 -15 d 860 Y -21 15 d cl s 1 1 1 c 786 1873
- m 23 6 d -20 15 d -24 -6 d f black 786 1873 m 23 6 d -20 15 d -24 -6 d cl s 1 1
- 1 c 762 1007 m 24 6 d 913 Y -24 -6 d f black 762 1007 m 24 6 d 913 Y -24 -6 d
- cl s 0.6 0.6 0.6 c 742 1022 m 20 -15 d 913 Y -20 16 d f black 742 1022 m 20 -15
- d 913 Y -20 16 d cl s 1 1 1 c 762 1920 m 24 6 d -21 16 d -23 -6 d f black 762
- 1920 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 739 1001 m 23 6 d 739 Y -23 -6 d f
- black 739 1001 m 23 6 d 739 Y -23 -6 d cl s 0.6 0.6 0.6 c 718 1016 m 21 -15 d
- 739 Y -21 15 d f black 718 1016 m 21 -15 d 739 Y -21 15 d cl s 1 1 1 c 739 1740
- m 23 6 d -20 15 d -24 -6 d f black 739 1740 m 23 6 d -20 15 d -24 -6 d cl s 1 1
- 1 c 715 995 m 24 6 d 551 Y -24 -6 d f black 715 995 m 24 6 d 551 Y -24 -6 d
- cl s 0.6 0.6 0.6 c 695 1010 m 20 -15 d 551 Y -20 15 d f black 695 1010 m 20 -15
- d 551 Y -20 15 d cl s 1 1 1 c 715 1546 m 24 6 d -21 15 d -23 -6 d f black 715
- 1546 m 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 692 989 m 23 6 d 591 Y -23 -6 d f
- black 692 989 m 23 6 d 591 Y -23 -6 d cl s 0.6 0.6 0.6 c 672 1004 m 20 -15 d
- 591 Y -20 15 d f black 672 1004 m 20 -15 d 591 Y -20 15 d cl s 1 1 1 c 692 1580
- m 23 6 d -20 15 d -23 -6 d f black 692 1580 m 23 6 d -20 15 d -23 -6 d cl s 1 1
- 1 c 668 983 m 24 6 d 698 Y -24 -6 d f black 668 983 m 24 6 d 698 Y -24 -6 d
- cl s 0.6 0.6 0.6 c 648 998 m 20 -15 d 698 Y -20 16 d f black 648 998 m 20 -15 d
- 698 Y -20 16 d cl s 1 1 1 c 668 1681 m 24 6 d -20 16 d -24 -6 d f black 668
- 1681 m 24 6 d -20 16 d -24 -6 d cl s 1 1 1 c 645 977 m 23 6 d 618 Y -23 -6 d f
- black 645 977 m 23 6 d 618 Y -23 -6 d cl s 0.6 0.6 0.6 c 625 992 m 20 -15 d 618
- Y -20 15 d f black 625 992 m 20 -15 d 618 Y -20 15 d cl s 1 1 1 c 645 1595 m 23
- 6 d -20 15 d -23 -6 d f black 645 1595 m 23 6 d -20 15 d -23 -6 d cl s 1 1 1 c
- 621 971 m 24 6 d 725 Y -24 -6 d f black 621 971 m 24 6 d 725 Y -24 -6 d cl s
- 0.6 0.6 0.6 c 601 986 m 20 -15 d 725 Y -20 16 d f black 601 986 m 20 -15 d 725
- Y -20 16 d cl s 1 1 1 c 621 1696 m 24 6 d -20 16 d -24 -6 d f black 621 1696 m
- 24 6 d -20 16 d -24 -6 d cl s 1 1 1 c 598 965 m 23 6 d -20 15 d -23 -6 d f
- black 598 965 m 23 6 d -20 15 d -23 -6 d cl s 1 1 1 c 574 959 m 24 6 d -20 15 d
- -24 -6 d f black 574 959 m 24 6 d -20 15 d -24 -6 d cl s 1 1 1 c 551 953 m 23 6
- d -20 15 d -23 -6 d f black 551 953 m 23 6 d -20 15 d -23 -6 d cl s 1 1 1 c 527
- 947 m 24 6 d -20 15 d -24 -6 d f black 527 947 m 24 6 d -20 15 d -24 -6 d cl s
- 1 1 1 c 1652 1212 m 23 6 d -20 16 d -24 -6 d f black 1652 1212 m 23 6 d -20 16
- d -24 -6 d cl s 1 1 1 c 1628 1206 m 24 6 d -21 16 d -23 -6 d f black 1628 1206
- m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 1605 1200 m 23 6 d -20 16 d -24 -6 d f
- black 1605 1200 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1581 1194 m 24 6 d -21
- 16 d -23 -6 d f black 1581 1194 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 1558
- 1188 m 23 6 d 713 Y -23 -6 d f black 1558 1188 m 23 6 d 713 Y -23 -6 d cl s 0.6
- 0.6 0.6 c 1537 1204 m 21 -16 d 713 Y -21 15 d f black 1537 1204 m 21 -16 d 713
- Y -21 15 d cl s 1 1 1 c 1558 1901 m 23 6 d -20 15 d -24 -6 d f black 1558 1901
- m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1534 1182 m 24 6 d 686 Y -24 -6 d f
- black 1534 1182 m 24 6 d 686 Y -24 -6 d cl s 0.6 0.6 0.6 c 1514 1198 m 20 -16 d
- 686 Y -20 15 d f black 1514 1198 m 20 -16 d 686 Y -20 15 d cl s 1 1 1 c 1534
- 1868 m 24 6 d -21 15 d -23 -6 d f black 1534 1868 m 24 6 d -21 15 d -23 -6 d
- cl s 1 1 1 c 1511 1177 m 23 5 d 699 Y -23 -6 d f black 1511 1177 m 23 5 d 699 Y
- -23 -6 d cl s 0.6 0.6 0.6 c 1490 1192 m 21 -15 d 698 Y -21 16 d f black 1490
- 1192 m 21 -15 d 698 Y -21 16 d cl s 1 1 1 c 1511 1875 m 23 6 d -20 16 d -24 -6
- d f black 1511 1875 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1487 1171 m 24 6 d
- 524 Y -24 -6 d f black 1487 1171 m 24 6 d 524 Y -24 -6 d cl s 0.6 0.6 0.6 c
- 1467 1186 m 20 -15 d 524 Y -20 15 d f black 1467 1186 m 20 -15 d 524 Y -20 15 d
- cl s 1 1 1 c 1487 1695 m 24 6 d -21 15 d -23 -6 d f black 1487 1695 m 24 6 d
- -21 15 d -23 -6 d cl s 1 1 1 c 1464 1165 m 23 6 d 604 Y -23 -6 d f black 1464
- 1165 m 23 6 d 604 Y -23 -6 d cl s 0.6 0.6 0.6 c 1444 1180 m 20 -15 d 604 Y -20
- 16 d f black 1444 1180 m 20 -15 d 604 Y -20 16 d cl s 1 1 1 c 1464 1769 m 23 6
- d -20 16 d -23 -6 d f black 1464 1769 m 23 6 d -20 16 d -23 -6 d cl s 1 1 1 c
- 1440 1159 m 24 6 d 792 Y -24 -6 d f black 1440 1159 m 24 6 d 792 Y -24 -6 d
- cl s 0.6 0.6 0.6 c 1420 1174 m 20 -15 d 792 Y -20 16 d f black 1420 1174 m 20
- -15 d 792 Y -20 16 d cl s 1 1 1 c 1440 1951 m 24 6 d -20 16 d -24 -6 d f black
- 1440 1951 m 24 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1417 1153 m 23 6 d 645 Y -23
- -6 d f black 1417 1153 m 23 6 d 645 Y -23 -6 d cl s 0.6 0.6 0.6 c 1397 1168 m
- 20 -15 d 645 Y -20 15 d f black 1397 1168 m 20 -15 d 645 Y -20 15 d cl s 1 1 1
- c 1417 1798 m 23 6 d -20 15 d -23 -6 d f black 1417 1798 m 23 6 d -20 15 d -23
- -6 d cl s 1 1 1 c 1393 1147 m 24 6 d 698 Y -24 -6 d f black 1393 1147 m 24 6 d
- 698 Y -24 -6 d cl s 0.6 0.6 0.6 c 1373 1162 m 20 -15 d 698 Y -20 16 d f black
- 1373 1162 m 20 -15 d 698 Y -20 16 d cl s 1 1 1 c 1393 1845 m 24 6 d -20 16 d
- -24 -6 d f black 1393 1845 m 24 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1370 1141 m
- 23 6 d 645 Y -23 -6 d f black 1370 1141 m 23 6 d 645 Y -23 -6 d cl s 0.6 0.6
- 0.6 c 1350 1156 m 20 -15 d 645 Y -20 15 d f black 1350 1156 m 20 -15 d 645 Y
- -20 15 d cl s 1 1 1 c 1370 1786 m 23 6 d -20 15 d -23 -6 d f black 1370 1786 m
- 23 6 d -20 15 d -23 -6 d cl s 1 1 1 c 1346 1135 m 24 6 d 618 Y -24 -6 d f black
- 1346 1135 m 24 6 d 618 Y -24 -6 d cl s 0.6 0.6 0.6 c 1326 1150 m 20 -15 d 618 Y
- -20 15 d f black 1326 1150 m 20 -15 d 618 Y -20 15 d cl s 1 1 1 c 1346 1753 m
- 24 6 d -20 15 d -24 -6 d f black 1346 1753 m 24 6 d -20 15 d -24 -6 d cl s 1 1
- 1 c 1323 1129 m 23 6 d 658 Y -23 -6 d f black 1323 1129 m 23 6 d 658 Y -23 -6 d
- cl s 0.6 0.6 0.6 c 1303 1144 m 20 -15 d 658 Y -20 16 d f black 1303 1144 m 20
- -15 d 658 Y -20 16 d cl s 1 1 1 c 1323 1787 m 23 6 d -20 16 d -23 -6 d f black
- 1323 1787 m 23 6 d -20 16 d -23 -6 d cl s 1 1 1 c 1299 1123 m 24 6 d 752 Y -24
- -6 d f black 1299 1123 m 24 6 d 752 Y -24 -6 d cl s 0.6 0.6 0.6 c 1279 1138 m
- 20 -15 d 752 Y -20 16 d f black 1279 1138 m 20 -15 d 752 Y -20 16 d cl s 1 1 1
- c 1299 1875 m 24 6 d -20 16 d -24 -6 d f black 1299 1875 m 24 6 d -20 16 d -24
- -6 d cl s 1 1 1 c 1276 1117 m 23 6 d 672 Y -23 -6 d f black 1276 1117 m 23 6 d
- 672 Y -23 -6 d cl s 0.6 0.6 0.6 c 1256 1132 m 20 -15 d 672 Y -20 15 d f black
- 1256 1132 m 20 -15 d 672 Y -20 15 d cl s 1 1 1 c 1276 1789 m 23 6 d -20 15 d
- -23 -6 d f black 1276 1789 m 23 6 d -20 15 d -23 -6 d cl s 1 1 1 c 1252 1111 m
- 24 6 d 672 Y -24 -6 d f black 1252 1111 m 24 6 d 672 Y -24 -6 d cl s 0.6 0.6
- 0.6 c 1232 1126 m 20 -15 d 672 Y -20 15 d f black 1232 1126 m 20 -15 d 672 Y
- -20 15 d cl s 1 1 1 c 1252 1783 m 24 6 d -20 15 d -24 -6 d f black 1252 1783 m
- 24 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1229 1105 m 23 6 d 564 Y -23 -6 d f black
- 1229 1105 m 23 6 d 564 Y -23 -6 d cl s 0.6 0.6 0.6 c 1209 1120 m 20 -15 d 564 Y
- -20 16 d f black 1209 1120 m 20 -15 d 564 Y -20 16 d cl s 1 1 1 c 1229 1669 m
- 23 6 d -20 16 d -23 -6 d f black 1229 1669 m 23 6 d -20 16 d -23 -6 d cl s 1 1
- 1 c 1205 1099 m 24 6 d 645 Y -24 -6 d f black 1205 1099 m 24 6 d 645 Y -24 -6 d
- cl s 0.6 0.6 0.6 c 1185 1114 m 20 -15 d 645 Y -20 15 d f black 1185 1114 m 20
- -15 d 645 Y -20 15 d cl s 1 1 1 c 1205 1744 m 24 6 d -20 15 d -24 -6 d f black
- 1205 1744 m 24 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1182 1093 m 23 6 d 725 Y -23
- -6 d f black 1182 1093 m 23 6 d 725 Y -23 -6 d cl s 0.6 0.6 0.6 c 1162 1108 m
- 20 -15 d 725 Y -20 16 d f black 1162 1108 m 20 -15 d 725 Y -20 16 d cl s 1 1 1
- c 1182 1818 m 23 6 d -20 16 d -23 -6 d f black 1182 1818 m 23 6 d -20 16 d -23
- -6 d cl s 1 1 1 c 1158 1087 m 24 6 d 698 Y -24 -6 d f black 1158 1087 m 24 6 d
- 698 Y -24 -6 d cl s 0.6 0.6 0.6 c 1138 1102 m 20 -15 d 698 Y -20 16 d f black
- 1138 1102 m 20 -15 d 698 Y -20 16 d cl s 1 1 1 c 1158 1785 m 24 6 d -20 16 d
- -24 -6 d f black 1158 1785 m 24 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1135 1081 m
- 23 6 d 779 Y -23 -6 d f black 1135 1081 m 23 6 d 779 Y -23 -6 d cl s 0.6 0.6
- 0.6 c 1115 1096 m 20 -15 d 779 Y -20 16 d f black 1115 1096 m 20 -15 d 779 Y
- -20 16 d cl s 1 1 1 c 1135 1860 m 23 6 d -20 16 d -23 -6 d f black 1135 1860 m
- 23 6 d -20 16 d -23 -6 d cl s 1 1 1 c 1112 1075 m 23 6 d 752 Y -23 -6 d f black
- 1112 1075 m 23 6 d 752 Y -23 -6 d cl s 0.6 0.6 0.6 c 1091 1090 m 21 -15 d 752 Y
- -21 16 d f black 1091 1090 m 21 -15 d 752 Y -21 16 d cl s 1 1 1 c 1112 1827 m
- 23 6 d -20 16 d -24 -6 d f black 1112 1827 m 23 6 d -20 16 d -24 -6 d cl s 1 1
- 1 c 1088 1069 m 24 6 d 631 Y -24 -6 d f black 1088 1069 m 24 6 d 631 Y -24 -6 d
- cl s 0.6 0.6 0.6 c 1068 1084 m 20 -15 d 631 Y -20 16 d f black 1068 1084 m 20
- -15 d 631 Y -20 16 d cl s 1 1 1 c 1088 1700 m 24 6 d -21 16 d -23 -6 d f black
- 1088 1700 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 1065 1063 m 23 6 d 564 Y -23
- -6 d f black 1065 1063 m 23 6 d 564 Y -23 -6 d cl s 0.6 0.6 0.6 c 1044 1078 m
- 21 -15 d 564 Y -21 16 d f black 1044 1078 m 21 -15 d 564 Y -21 16 d cl s 1 1 1
- c 1065 1627 m 23 6 d -20 16 d -24 -6 d f black 1065 1627 m 23 6 d -20 16 d -24
- -6 d cl s 1 1 1 c 1041 1057 m 24 6 d 605 Y -24 -6 d f black 1041 1057 m 24 6 d
- 605 Y -24 -6 d cl s 0.6 0.6 0.6 c 1021 1072 m 20 -15 d 605 Y -20 15 d f black
- 1021 1072 m 20 -15 d 605 Y -20 15 d cl s 1 1 1 c 1041 1662 m 24 6 d -21 15 d
- -23 -6 d f black 1041 1662 m 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 1018 1051 m
- 23 6 d 699 Y -23 -6 d f black 1018 1051 m 23 6 d 699 Y -23 -6 d cl s 0.6 0.6
- 0.6 c 997 1066 m 21 -15 d 699 Y -21 15 d f black 997 1066 m 21 -15 d 699 Y -21
- 15 d cl s 1 1 1 c 1018 1750 m 23 6 d -20 15 d -24 -6 d f black 1018 1750 m 23 6
- d -20 15 d -24 -6 d cl s 1 1 1 c 994 1045 m 24 6 d 752 Y -24 -6 d f black 994
- 1045 m 24 6 d 752 Y -24 -6 d cl s 0.6 0.6 0.6 c 974 1061 m 20 -16 d 752 Y -20
- 16 d f black 974 1061 m 20 -16 d 752 Y -20 16 d cl s 1 1 1 c 994 1797 m 24 6 d
- -21 16 d -23 -6 d f black 994 1797 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 971
- 1039 m 23 6 d 672 Y -23 -6 d f black 971 1039 m 23 6 d 672 Y -23 -6 d cl s 0.6
- 0.6 0.6 c 950 1055 m 21 -16 d 672 Y -21 15 d f black 950 1055 m 21 -16 d 672 Y
- -21 15 d cl s 1 1 1 c 971 1711 m 23 6 d -20 15 d -24 -6 d f black 971 1711 m 23
- 6 d -20 15 d -24 -6 d cl s 1 1 1 c 947 1033 m 24 6 d 766 Y -24 -6 d f black 947
- 1033 m 24 6 d 766 Y -24 -6 d cl s 0.6 0.6 0.6 c 927 1049 m 20 -16 d 766 Y -20
- 15 d f black 927 1049 m 20 -16 d 766 Y -20 15 d cl s 1 1 1 c 947 1799 m 24 6 d
- -21 15 d -23 -6 d f black 947 1799 m 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 924
- 1027 m 23 6 d 470 Y -23 -6 d f black 924 1027 m 23 6 d 470 Y -23 -6 d cl s 0.6
- 0.6 0.6 c 903 1043 m 21 -16 d 470 Y -21 16 d f black 903 1043 m 21 -16 d 470 Y
- -21 16 d cl s 1 1 1 c 924 1497 m 23 6 d -20 16 d -24 -6 d f black 924 1497 m 23
- 6 d -20 16 d -24 -6 d cl s 1 1 1 c 900 1021 m 24 6 d 578 Y -24 -6 d f black 900
- 1021 m 24 6 d 578 Y -24 -6 d cl s 0.6 0.6 0.6 c 880 1037 m 20 -16 d 578 Y -20
- 15 d f black 880 1037 m 20 -16 d 578 Y -20 15 d cl s 1 1 1 c 900 1599 m 24 6 d
- -21 15 d -23 -6 d f black 900 1599 m 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 877
- 1015 m 23 6 d 712 Y -23 -6 d f black 877 1015 m 23 6 d 712 Y -23 -6 d cl s 0.6
- 0.6 0.6 c 856 1031 m 21 -16 d 712 Y -21 16 d f black 856 1031 m 21 -16 d 712 Y
- -21 16 d cl s 1 1 1 c 877 1727 m 23 6 d -20 16 d -24 -6 d f black 877 1727 m 23
- 6 d -20 16 d -24 -6 d cl s 1 1 1 c 853 1009 m 24 6 d 672 Y -24 -6 d f black 853
- 1009 m 24 6 d 672 Y -24 -6 d cl s 0.6 0.6 0.6 c 833 1025 m 20 -16 d 672 Y -20
- 15 d f black 833 1025 m 20 -16 d 672 Y -20 15 d cl s 1 1 1 c 853 1681 m 24 6 d
- -21 15 d -23 -6 d f black 853 1681 m 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 830
- 1003 m 23 6 d 632 Y -23 -6 d f black 830 1003 m 23 6 d 632 Y -23 -6 d cl s 0.6
- 0.6 0.6 c 809 1019 m 21 -16 d 632 Y -21 15 d f black 809 1019 m 21 -16 d 632 Y
- -21 15 d cl s 1 1 1 c 830 1635 m 23 6 d -20 15 d -24 -6 d f black 830 1635 m 23
- 6 d -20 15 d -24 -6 d cl s 1 1 1 c 806 997 m 24 6 d 632 Y -24 -6 d f black 806
- 997 m 24 6 d 632 Y -24 -6 d cl s 0.6 0.6 0.6 c 786 1013 m 20 -16 d 632 Y -20 15
- d f black 786 1013 m 20 -16 d 632 Y -20 15 d cl s 1 1 1 c 806 1629 m 24 6 d -21
- 15 d -23 -6 d f black 806 1629 m 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 783 991
- m 23 6 d 645 Y -23 -6 d f black 783 991 m 23 6 d 645 Y -23 -6 d cl s 0.6 0.6
- 0.6 c 762 1007 m 21 -16 d 645 Y -21 16 d f black 762 1007 m 21 -16 d 645 Y -21
- 16 d cl s 1 1 1 c 783 1636 m 23 6 d -20 16 d -24 -6 d f black 783 1636 m 23 6 d
- -20 16 d -24 -6 d cl s 1 1 1 c 759 985 m 24 6 d 685 Y -24 -6 d f black 759 985
- m 24 6 d 685 Y -24 -6 d cl s 0.6 0.6 0.6 c 739 1001 m 20 -16 d 685 Y -20 16 d f
- black 739 1001 m 20 -16 d 685 Y -20 16 d cl s 1 1 1 c 759 1670 m 24 6 d -21 16
- d -23 -6 d f black 759 1670 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 736 979 m
- 23 6 d 806 Y -23 -6 d f black 736 979 m 23 6 d 806 Y -23 -6 d cl s 0.6 0.6 0.6
- c 715 995 m 21 -16 d 806 Y -21 16 d f black 715 995 m 21 -16 d 806 Y -21 16 d
- cl s 1 1 1 c 736 1785 m 23 6 d -20 16 d -24 -6 d f black 736 1785 m 23 6 d -20
- 16 d -24 -6 d cl s 1 1 1 c 712 973 m 24 6 d 591 Y -24 -6 d f black 712 973 m 24
- 6 d 591 Y -24 -6 d cl s 0.6 0.6 0.6 c 692 989 m 20 -16 d 591 Y -20 16 d f black
- 692 989 m 20 -16 d 591 Y -20 16 d cl s 1 1 1 c 712 1564 m 24 6 d -21 16 d -23
- -6 d f black 712 1564 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 689 967 m 23 6 d
- 591 Y -23 -6 d f black 689 967 m 23 6 d 591 Y -23 -6 d cl s 0.6 0.6 0.6 c 668
- 983 m 21 -16 d 591 Y -21 16 d f black 668 983 m 21 -16 d 591 Y -21 16 d cl s 1
- 1 1 c 689 1558 m 23 6 d -20 16 d -24 -6 d f black 689 1558 m 23 6 d -20 16 d
- -24 -6 d cl s 1 1 1 c 665 961 m 24 6 d 833 Y -24 -6 d f black 665 961 m 24 6 d
- 833 Y -24 -6 d cl s 0.6 0.6 0.6 c 645 977 m 20 -16 d 833 Y -20 16 d f black 645
- 977 m 20 -16 d 833 Y -20 16 d cl s 1 1 1 c 665 1794 m 24 6 d -21 16 d -23 -6 d
- f black 665 1794 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 642 955 m 23 6 d 565 Y
- -23 -6 d f black 642 955 m 23 6 d 565 Y -23 -6 d cl s 0.6 0.6 0.6 c 621 971 m
- 21 -16 d 565 Y -21 15 d f black 621 971 m 21 -16 d 565 Y -21 15 d cl s 1 1 1 c
- 642 1520 m 23 6 d -20 15 d -24 -6 d f black 642 1520 m 23 6 d -20 15 d -24 -6 d
- cl s 1 1 1 c 618 949 m 24 6 d -21 16 d -23 -6 d f black 618 949 m 24 6 d -21 16
- d -23 -6 d cl s 1 1 1 c 595 943 m 23 6 d -20 16 d -24 -6 d f black 595 943 m 23
- 6 d -20 16 d -24 -6 d cl s 1 1 1 c 571 937 m 24 6 d -21 16 d -23 -6 d f black
- 571 937 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 548 931 m 23 6 d -20 16 d -24
- -6 d f black 548 931 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1672 1197 m 24 6 d
- -21 15 d -23 -6 d f black 1672 1197 m 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c
- 1649 1191 m 23 6 d -20 15 d -24 -6 d f black 1649 1191 m 23 6 d -20 15 d -24 -6
- d cl s 1 1 1 c 1625 1185 m 24 6 d -21 15 d -23 -6 d f black 1625 1185 m 24 6 d
- -21 15 d -23 -6 d cl s 1 1 1 c 1602 1179 m 23 6 d -20 15 d -24 -6 d f black
- 1602 1179 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1578 1173 m 24 6 d 537 Y -24
- -6 d f black 1578 1173 m 24 6 d 537 Y -24 -6 d cl s 0.6 0.6 0.6 c 1558 1188 m
- 20 -15 d 537 Y -20 16 d f black 1558 1188 m 20 -15 d 537 Y -20 16 d cl s 1 1 1
- c 1578 1710 m 24 6 d -21 16 d -23 -6 d f black 1578 1710 m 24 6 d -21 16 d -23
- -6 d cl s 1 1 1 c 1555 1167 m 23 6 d 390 Y -23 -6 d f black 1555 1167 m 23 6 d
- 390 Y -23 -6 d cl s 0.6 0.6 0.6 c 1534 1182 m 21 -15 d 390 Y -21 15 d f black
- 1534 1182 m 21 -15 d 390 Y -21 15 d cl s 1 1 1 c 1555 1557 m 23 6 d -20 15 d
- -24 -6 d f black 1555 1557 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1531 1161 m
- 24 6 d 726 Y -24 -6 d f black 1531 1161 m 24 6 d 726 Y -24 -6 d cl s 0.6 0.6
- 0.6 c 1511 1177 m 20 -16 d 726 Y -20 15 d f black 1511 1177 m 20 -16 d 726 Y
- -20 15 d cl s 1 1 1 c 1531 1887 m 24 6 d -21 15 d -23 -6 d f black 1531 1887 m
- 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 1508 1155 m 23 6 d 833 Y -23 -6 d f black
- 1508 1155 m 23 6 d 833 Y -23 -6 d cl s 0.6 0.6 0.6 c 1487 1171 m 21 -16 d 833 Y
- -21 16 d f black 1487 1171 m 21 -16 d 833 Y -21 16 d cl s 1 1 1 c 1508 1988 m
- 23 6 d -20 16 d -24 -6 d f black 1508 1988 m 23 6 d -20 16 d -24 -6 d cl s 1 1
- 1 c 1484 1149 m 24 6 d 564 Y -24 -6 d f black 1484 1149 m 24 6 d 564 Y -24 -6 d
- cl s 0.6 0.6 0.6 c 1464 1165 m 20 -16 d 564 Y -20 16 d f black 1464 1165 m 20
- -16 d 564 Y -20 16 d cl s 1 1 1 c 1484 1713 m 24 6 d -21 16 d -23 -6 d f black
- 1484 1713 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 1461 1143 m 23 6 d 900 Y -23
- -6 d f black 1461 1143 m 23 6 d 900 Y -23 -6 d cl s 0.6 0.6 0.6 c 1440 1159 m
- 21 -16 d 900 Y -21 16 d f black 1440 1159 m 21 -16 d 900 Y -21 16 d cl s 1 1 1
- c 1461 2043 m 23 6 d -20 16 d -24 -6 d f black 1461 2043 m 23 6 d -20 16 d -24
- -6 d cl s 1 1 1 c 1437 1137 m 24 6 d 618 Y -24 -6 d f black 1437 1137 m 24 6 d
- 618 Y -24 -6 d cl s 0.6 0.6 0.6 c 1417 1153 m 20 -16 d 618 Y -20 16 d f black
- 1417 1153 m 20 -16 d 618 Y -20 16 d cl s 1 1 1 c 1437 1755 m 24 6 d -21 16 d
- -23 -6 d f black 1437 1755 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 1414 1131 m
- 23 6 d 726 Y -23 -6 d f black 1414 1131 m 23 6 d 726 Y -23 -6 d cl s 0.6 0.6
- 0.6 c 1393 1147 m 21 -16 d 726 Y -21 15 d f black 1393 1147 m 21 -16 d 726 Y
- -21 15 d cl s 1 1 1 c 1414 1857 m 23 6 d -20 15 d -24 -6 d f black 1414 1857 m
- 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1390 1125 m 24 6 d 726 Y -24 -6 d f black
- 1390 1125 m 24 6 d 726 Y -24 -6 d cl s 0.6 0.6 0.6 c 1370 1141 m 20 -16 d 726 Y
- -20 15 d f black 1370 1141 m 20 -16 d 726 Y -20 15 d cl s 1 1 1 c 1390 1851 m
- 24 6 d -21 15 d -23 -6 d f black 1390 1851 m 24 6 d -21 15 d -23 -6 d cl s 1 1
- 1 c 1367 1119 m 23 6 d 994 Y -23 -6 d f black 1367 1119 m 23 6 d 994 Y -23 -6 d
- cl s 0.6 0.6 0.6 c 1346 1135 m 21 -16 d 994 Y -21 16 d f black 1346 1135 m 21
- -16 d 994 Y -21 16 d cl s 1 1 1 c 1367 2113 m 23 6 d -20 16 d -24 -6 d f black
- 1367 2113 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1343 1113 m 24 6 d 739 Y -24
- -6 d f black 1343 1113 m 24 6 d 739 Y -24 -6 d cl s 0.6 0.6 0.6 c 1323 1129 m
- 20 -16 d 739 Y -20 16 d f black 1323 1129 m 20 -16 d 739 Y -20 16 d cl s 1 1 1
- c 1343 1852 m 24 6 d -21 16 d -23 -6 d f black 1343 1852 m 24 6 d -21 16 d -23
- -6 d cl s 1 1 1 c 1320 1107 m 23 6 d 766 Y -23 -6 d f black 1320 1107 m 23 6 d
- 766 Y -23 -6 d cl s 0.6 0.6 0.6 c 1299 1123 m 21 -16 d 766 Y -21 16 d f black
- 1299 1123 m 21 -16 d 766 Y -21 16 d cl s 1 1 1 c 1320 1873 m 23 6 d -20 16 d
- -24 -6 d f black 1320 1873 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1296 1101 m
- 24 6 d 806 Y -24 -6 d f black 1296 1101 m 24 6 d 806 Y -24 -6 d cl s 0.6 0.6
- 0.6 c 1276 1117 m 20 -16 d 806 Y -20 16 d f black 1276 1117 m 20 -16 d 806 Y
- -20 16 d cl s 1 1 1 c 1296 1907 m 24 6 d -21 16 d -23 -6 d f black 1296 1907 m
- 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 1273 1095 m 23 6 d 524 Y -23 -6 d f black
- 1273 1095 m 23 6 d 524 Y -23 -6 d cl s 0.6 0.6 0.6 c 1252 1111 m 21 -16 d 524 Y
- -21 16 d f black 1252 1111 m 21 -16 d 524 Y -21 16 d cl s 1 1 1 c 1273 1619 m
- 23 6 d -20 16 d -24 -6 d f black 1273 1619 m 23 6 d -20 16 d -24 -6 d cl s 1 1
- 1 c 1249 1089 m 24 6 d 874 Y -24 -6 d f black 1249 1089 m 24 6 d 874 Y -24 -6 d
- cl s 0.6 0.6 0.6 c 1229 1105 m 20 -16 d 874 Y -20 15 d f black 1229 1105 m 20
- -16 d 874 Y -20 15 d cl s 1 1 1 c 1249 1963 m 24 6 d -21 15 d -23 -6 d f black
- 1249 1963 m 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 1226 1083 m 23 6 d 874 Y -23
- -6 d f black 1226 1083 m 23 6 d 874 Y -23 -6 d cl s 0.6 0.6 0.6 c 1205 1099 m
- 21 -16 d 874 Y -21 15 d f black 1205 1099 m 21 -16 d 874 Y -21 15 d cl s 1 1 1
- c 1226 1957 m 23 6 d -20 15 d -24 -6 d f black 1226 1957 m 23 6 d -20 15 d -24
- -6 d cl s 1 1 1 c 1202 1077 m 24 6 d 632 Y -24 -6 d f black 1202 1077 m 24 6 d
- 632 Y -24 -6 d cl s 0.6 0.6 0.6 c 1182 1093 m 20 -16 d 632 Y -20 15 d f black
- 1182 1093 m 20 -16 d 632 Y -20 15 d cl s 1 1 1 c 1202 1709 m 24 6 d -21 15 d
- -23 -6 d f black 1202 1709 m 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 1179 1071 m
- 23 6 d 726 Y -23 -6 d f black 1179 1071 m 23 6 d 726 Y -23 -6 d cl s 0.6 0.6
- 0.6 c 1158 1087 m 21 -16 d 726 Y -21 15 d f black 1158 1087 m 21 -16 d 726 Y
- -21 15 d cl s 1 1 1 c 1179 1797 m 23 6 d -20 15 d -24 -6 d f black 1179 1797 m
- 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1155 1065 m 24 6 d 618 Y -24 -6 d f black
- 1155 1065 m 24 6 d 618 Y -24 -6 d cl s 0.6 0.6 0.6 c 1135 1081 m 20 -16 d 618 Y
- -20 16 d f black 1135 1081 m 20 -16 d 618 Y -20 16 d cl s 1 1 1 c 1155 1683 m
- 24 6 d -21 16 d -23 -6 d f black 1155 1683 m 24 6 d -21 16 d -23 -6 d cl s 1 1
- 1 c 1132 1059 m 23 6 d 551 Y -23 -6 d f black 1132 1059 m 23 6 d 551 Y -23 -6 d
- cl s 0.6 0.6 0.6 c 1112 1075 m 20 -16 d 551 Y -20 16 d f black 1112 1075 m 20
- -16 d 551 Y -20 16 d cl s 1 1 1 c 1132 1610 m 23 6 d -20 16 d -23 -6 d f black
- 1132 1610 m 23 6 d -20 16 d -23 -6 d cl s 1 1 1 c 1108 1053 m 24 6 d 726 Y -24
- -6 d f black 1108 1053 m 24 6 d 726 Y -24 -6 d cl s 0.6 0.6 0.6 c 1088 1069 m
- 20 -16 d 726 Y -20 15 d f black 1088 1069 m 20 -16 d 726 Y -20 15 d cl s 1 1 1
- c 1108 1779 m 24 6 d -20 15 d -24 -6 d f black 1108 1779 m 24 6 d -20 15 d -24
- -6 d cl s 1 1 1 c 1085 1047 m 23 6 d 618 Y -23 -6 d f black 1085 1047 m 23 6 d
- 618 Y -23 -6 d cl s 0.6 0.6 0.6 c 1065 1063 m 20 -16 d 618 Y -20 16 d f black
- 1065 1063 m 20 -16 d 618 Y -20 16 d cl s 1 1 1 c 1085 1665 m 23 6 d -20 16 d
- -23 -6 d f black 1085 1665 m 23 6 d -20 16 d -23 -6 d cl s 1 1 1 c 1061 1041 m
- 24 6 d 699 Y -24 -6 d f black 1061 1041 m 24 6 d 699 Y -24 -6 d cl s 0.6 0.6
- 0.6 c 1041 1057 m 20 -16 d 699 Y -20 16 d f black 1041 1057 m 20 -16 d 699 Y
- -20 16 d cl s 1 1 1 c 1061 1740 m 24 6 d -20 16 d -24 -6 d f black 1061 1740 m
- 24 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1038 1035 m 23 6 d 726 Y -23 -6 d f black
- 1038 1035 m 23 6 d 726 Y -23 -6 d cl s 0.6 0.6 0.6 c 1018 1051 m 20 -16 d 726 Y
- -20 15 d f black 1018 1051 m 20 -16 d 726 Y -20 15 d cl s 1 1 1 c 1038 1761 m
- 23 6 d -20 15 d -23 -6 d f black 1038 1761 m 23 6 d -20 15 d -23 -6 d cl s 1 1
- 1 c 1014 1029 m 24 6 d 753 Y -24 -6 d f black 1014 1029 m 24 6 d 753 Y -24 -6 d
- cl s 0.6 0.6 0.6 c 994 1045 m 20 -16 d 753 Y -20 15 d f black 994 1045 m 20 -16
- d 753 Y -20 15 d cl s 1 1 1 c 1014 1782 m 24 6 d -20 15 d -24 -6 d f black 1014
- 1782 m 24 6 d -20 15 d -24 -6 d cl s 1 1 1 c 991 1023 m 23 6 d 753 Y -23 -6 d f
- black 991 1023 m 23 6 d 753 Y -23 -6 d cl s 0.6 0.6 0.6 c 971 1039 m 20 -16 d
- 753 Y -20 15 d f black 971 1039 m 20 -16 d 753 Y -20 15 d cl s 1 1 1 c 991 1776
- m 23 6 d -20 15 d -23 -6 d f black 991 1776 m 23 6 d -20 15 d -23 -6 d cl s 1 1
- 1 c 967 1017 m 24 6 d 713 Y -24 -6 d f black 967 1017 m 24 6 d 713 Y -24 -6 d
- cl s 0.6 0.6 0.6 c 947 1033 m 20 -16 d 713 Y -20 15 d f black 947 1033 m 20 -16
- d 713 Y -20 15 d cl s 1 1 1 c 967 1730 m 24 6 d -20 15 d -24 -6 d f black 967
- 1730 m 24 6 d -20 15 d -24 -6 d cl s 1 1 1 c 944 1011 m 23 6 d 726 Y -23 -6 d f
- black 944 1011 m 23 6 d 726 Y -23 -6 d cl s 0.6 0.6 0.6 c 924 1027 m 20 -16 d
- 726 Y -20 16 d f black 924 1027 m 20 -16 d 726 Y -20 16 d cl s 1 1 1 c 944 1737
- m 23 6 d -20 16 d -23 -6 d f black 944 1737 m 23 6 d -20 16 d -23 -6 d cl s 1 1
- 1 c 920 1006 m 24 5 d 699 Y -24 -6 d f black 920 1006 m 24 5 d 699 Y -24 -6 d
- cl s 0.6 0.6 0.6 c 900 1021 m 20 -15 d 698 Y -20 16 d f black 900 1021 m 20 -15
- d 698 Y -20 16 d cl s 1 1 1 c 920 1704 m 24 6 d -20 16 d -24 -6 d f black 920
- 1704 m 24 6 d -20 16 d -24 -6 d cl s 1 1 1 c 897 1000 m 23 6 d 631 Y -23 -6 d f
- black 897 1000 m 23 6 d 631 Y -23 -6 d cl s 0.6 0.6 0.6 c 877 1015 m 20 -15 d
- 631 Y -20 16 d f black 877 1015 m 20 -15 d 631 Y -20 16 d cl s 1 1 1 c 897 1631
- m 23 6 d -20 16 d -23 -6 d f black 897 1631 m 23 6 d -20 16 d -23 -6 d cl s 1 1
- 1 c 873 994 m 24 6 d 658 Y -24 -6 d f black 873 994 m 24 6 d 658 Y -24 -6 d
- cl s 0.6 0.6 0.6 c 853 1009 m 20 -15 d 658 Y -20 15 d f black 853 1009 m 20 -15
- d 658 Y -20 15 d cl s 1 1 1 c 873 1652 m 24 6 d -20 15 d -24 -6 d f black 873
- 1652 m 24 6 d -20 15 d -24 -6 d cl s 1 1 1 c 850 988 m 23 6 d 631 Y -23 -6 d f
- black 850 988 m 23 6 d 631 Y -23 -6 d cl s 0.6 0.6 0.6 c 830 1003 m 20 -15 d
- 631 Y -20 16 d f black 830 1003 m 20 -15 d 631 Y -20 16 d cl s 1 1 1 c 850 1619
- m 23 6 d -20 16 d -23 -6 d f black 850 1619 m 23 6 d -20 16 d -23 -6 d cl s 1 1
- 1 c 826 982 m 24 6 d 510 Y -24 -6 d f black 826 982 m 24 6 d 510 Y -24 -6 d
- cl s 0.6 0.6 0.6 c 806 997 m 20 -15 d 510 Y -20 16 d f black 806 997 m 20 -15 d
- 510 Y -20 16 d cl s 1 1 1 c 826 1492 m 24 6 d -20 16 d -24 -6 d f black 826
- 1492 m 24 6 d -20 16 d -24 -6 d cl s 1 1 1 c 803 976 m 23 6 d 564 Y -23 -6 d f
- black 803 976 m 23 6 d 564 Y -23 -6 d cl s 0.6 0.6 0.6 c 783 991 m 20 -15 d 564
- Y -20 15 d f black 783 991 m 20 -15 d 564 Y -20 15 d cl s 1 1 1 c 803 1540 m 23
- 6 d -20 15 d -23 -6 d f black 803 1540 m 23 6 d -20 15 d -23 -6 d cl s 1 1 1 c
- 780 970 m 23 6 d 604 Y -23 -6 d f black 780 970 m 23 6 d 604 Y -23 -6 d cl s
- 0.6 0.6 0.6 c 759 985 m 21 -15 d 604 Y -21 16 d f black 759 985 m 21 -15 d 604
- Y -21 16 d cl s 1 1 1 c 780 1574 m 23 6 d -20 16 d -24 -6 d f black 780 1574 m
- 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 756 964 m 24 6 d 591 Y -24 -6 d f black
- 756 964 m 24 6 d 591 Y -24 -6 d cl s 0.6 0.6 0.6 c 736 979 m 20 -15 d 591 Y -20
- 15 d f black 736 979 m 20 -15 d 591 Y -20 15 d cl s 1 1 1 c 756 1555 m 24 6 d
- -21 15 d -23 -6 d f black 756 1555 m 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 733
- 958 m 23 6 d 577 Y -23 -6 d f black 733 958 m 23 6 d 577 Y -23 -6 d cl s 0.6
- 0.6 0.6 c 712 973 m 21 -15 d 577 Y -21 16 d f black 712 973 m 21 -15 d 577 Y
- -21 16 d cl s 1 1 1 c 733 1535 m 23 6 d -20 16 d -24 -6 d f black 733 1535 m 23
- 6 d -20 16 d -24 -6 d cl s 1 1 1 c 709 952 m 24 6 d 739 Y -24 -6 d f black 709
- 952 m 24 6 d 739 Y -24 -6 d cl s 0.6 0.6 0.6 c 689 967 m 20 -15 d 739 Y -20 15
- d f black 689 967 m 20 -15 d 739 Y -20 15 d cl s 1 1 1 c 709 1691 m 24 6 d -21
- 15 d -23 -6 d f black 709 1691 m 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 686 946
- m 23 6 d 645 Y -23 -6 d f black 686 946 m 23 6 d 645 Y -23 -6 d cl s 0.6 0.6
- 0.6 c 665 961 m 21 -15 d 645 Y -21 15 d f black 665 961 m 21 -15 d 645 Y -21 15
- d cl s 1 1 1 c 686 1591 m 23 6 d -20 15 d -24 -6 d f black 686 1591 m 23 6 d
- -20 15 d -24 -6 d cl s 1 1 1 c 662 940 m 24 6 d 631 Y -24 -6 d f black 662 940
- m 24 6 d 631 Y -24 -6 d cl s 0.6 0.6 0.6 c 642 955 m 20 -15 d 631 Y -20 16 d f
- black 642 955 m 20 -15 d 631 Y -20 16 d cl s 1 1 1 c 662 1571 m 24 6 d -21 16 d
- -23 -6 d f black 662 1571 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 639 934 m 23
- 6 d -20 15 d -24 -6 d f black 639 934 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c
- 615 928 m 24 6 d -21 15 d -23 -6 d f black 615 928 m 24 6 d -21 15 d -23 -6 d
- cl s 1 1 1 c 592 922 m 23 6 d -20 15 d -24 -6 d f black 592 922 m 23 6 d -20 15
- d -24 -6 d cl s 1 1 1 c 568 916 m 24 6 d -21 15 d -23 -6 d f black 568 916 m 24
- 6 d -21 15 d -23 -6 d cl s 1 1 1 c 1692 1181 m 24 6 d -20 16 d -24 -6 d f black
- 1692 1181 m 24 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1669 1175 m 23 6 d -20 16 d
- -23 -6 d f black 1669 1175 m 23 6 d -20 16 d -23 -6 d cl s 1 1 1 c 1645 1169 m
- 24 6 d -20 16 d -24 -6 d f black 1645 1169 m 24 6 d -20 16 d -24 -6 d cl s 1 1
- 1 c 1622 1163 m 23 6 d -20 16 d -23 -6 d f black 1622 1163 m 23 6 d -20 16 d
- -23 -6 d cl s 1 1 1 c 1598 1157 m 24 6 d 780 Y -24 -6 d f black 1598 1157 m 24
- 6 d 780 Y -24 -6 d cl s 0.6 0.6 0.6 c 1578 1173 m 20 -16 d 780 Y -20 15 d f
- black 1578 1173 m 20 -16 d 780 Y -20 15 d cl s 1 1 1 c 1598 1937 m 24 6 d -20
- 15 d -24 -6 d f black 1598 1937 m 24 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1575
- 1151 m 23 6 d 565 Y -23 -6 d f black 1575 1151 m 23 6 d 565 Y -23 -6 d cl s 0.6
- 0.6 0.6 c 1555 1167 m 20 -16 d 565 Y -20 15 d f black 1555 1167 m 20 -16 d 565
- Y -20 15 d cl s 1 1 1 c 1575 1716 m 23 6 d -20 15 d -23 -6 d f black 1575 1716
- m 23 6 d -20 15 d -23 -6 d cl s 1 1 1 c 1552 1145 m 23 6 d 847 Y -23 -6 d f
- black 1552 1145 m 23 6 d 847 Y -23 -6 d cl s 0.6 0.6 0.6 c 1531 1161 m 21 -16 d
- 847 Y -21 15 d f black 1531 1161 m 21 -16 d 847 Y -21 15 d cl s 1 1 1 c 1552
- 1992 m 23 6 d -20 15 d -24 -6 d f black 1552 1992 m 23 6 d -20 15 d -24 -6 d
- cl s 1 1 1 c 1528 1139 m 24 6 d 780 Y -24 -6 d f black 1528 1139 m 24 6 d 780 Y
- -24 -6 d cl s 0.6 0.6 0.6 c 1508 1155 m 20 -16 d 780 Y -20 15 d f black 1508
- 1155 m 20 -16 d 780 Y -20 15 d cl s 1 1 1 c 1528 1919 m 24 6 d -21 15 d -23 -6
- d f black 1528 1919 m 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 1505 1133 m 23 6 d
- 753 Y -23 -6 d f black 1505 1133 m 23 6 d 753 Y -23 -6 d cl s 0.6 0.6 0.6 c
- 1484 1149 m 21 -16 d 753 Y -21 15 d f black 1484 1149 m 21 -16 d 753 Y -21 15 d
- cl s 1 1 1 c 1505 1886 m 23 6 d -20 15 d -24 -6 d f black 1505 1886 m 23 6 d
- -20 15 d -24 -6 d cl s 1 1 1 c 1481 1128 m 24 5 d 524 Y -24 -5 d f black 1481
- 1128 m 24 5 d 524 Y -24 -5 d cl s 0.6 0.6 0.6 c 1461 1143 m 20 -15 d 524 Y -20
- 15 d f black 1461 1143 m 20 -15 d 524 Y -20 15 d cl s 1 1 1 c 1481 1652 m 24 5
- d -21 16 d -23 -6 d f black 1481 1652 m 24 5 d -21 16 d -23 -6 d cl s 1 1 1 c
- 1458 1122 m 23 6 d 725 Y -23 -6 d f black 1458 1122 m 23 6 d 725 Y -23 -6 d
- cl s 0.6 0.6 0.6 c 1437 1137 m 21 -15 d 725 Y -21 16 d f black 1437 1137 m 21
- -15 d 725 Y -21 16 d cl s 1 1 1 c 1458 1847 m 23 6 d -20 16 d -24 -6 d f black
- 1458 1847 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1434 1116 m 24 6 d 779 Y -24
- -6 d f black 1434 1116 m 24 6 d 779 Y -24 -6 d cl s 0.6 0.6 0.6 c 1414 1131 m
- 20 -15 d 779 Y -20 15 d f black 1414 1131 m 20 -15 d 779 Y -20 15 d cl s 1 1 1
- c 1434 1895 m 24 6 d -21 15 d -23 -6 d f black 1434 1895 m 24 6 d -21 15 d -23
- -6 d cl s 1 1 1 c 1411 1110 m 23 6 d 739 Y -23 -6 d f black 1411 1110 m 23 6 d
- 739 Y -23 -6 d cl s 0.6 0.6 0.6 c 1390 1125 m 21 -15 d 739 Y -21 15 d f black
- 1390 1125 m 21 -15 d 739 Y -21 15 d cl s 1 1 1 c 1411 1849 m 23 6 d -20 15 d
- -24 -6 d f black 1411 1849 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1387 1104 m
- 24 6 d 806 Y -24 -6 d f black 1387 1104 m 24 6 d 806 Y -24 -6 d cl s 0.6 0.6
- 0.6 c 1367 1119 m 20 -15 d 806 Y -20 15 d f black 1367 1119 m 20 -15 d 806 Y
- -20 15 d cl s 1 1 1 c 1387 1910 m 24 6 d -21 15 d -23 -6 d f black 1387 1910 m
- 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 1364 1098 m 23 6 d 685 Y -23 -6 d f black
- 1364 1098 m 23 6 d 685 Y -23 -6 d cl s 0.6 0.6 0.6 c 1343 1113 m 21 -15 d 685 Y
- -21 15 d f black 1343 1113 m 21 -15 d 685 Y -21 15 d cl s 1 1 1 c 1364 1783 m
- 23 6 d -20 15 d -24 -6 d f black 1364 1783 m 23 6 d -20 15 d -24 -6 d cl s 1 1
- 1 c 1340 1092 m 24 6 d 631 Y -24 -6 d f black 1340 1092 m 24 6 d 631 Y -24 -6 d
- cl s 0.6 0.6 0.6 c 1320 1107 m 20 -15 d 631 Y -20 16 d f black 1320 1107 m 20
- -15 d 631 Y -20 16 d cl s 1 1 1 c 1340 1723 m 24 6 d -21 16 d -23 -6 d f black
- 1340 1723 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 1317 1086 m 23 6 d 604 Y -23
- -6 d f black 1317 1086 m 23 6 d 604 Y -23 -6 d cl s 0.6 0.6 0.6 c 1296 1101 m
- 21 -15 d 604 Y -21 16 d f black 1296 1101 m 21 -15 d 604 Y -21 16 d cl s 1 1 1
- c 1317 1690 m 23 6 d -20 16 d -24 -6 d f black 1317 1690 m 23 6 d -20 16 d -24
- -6 d cl s 1 1 1 c 1293 1080 m 24 6 d 671 Y -24 -6 d f black 1293 1080 m 24 6 d
- 671 Y -24 -6 d cl s 0.6 0.6 0.6 c 1273 1095 m 20 -15 d 671 Y -20 16 d f black
- 1273 1095 m 20 -15 d 671 Y -20 16 d cl s 1 1 1 c 1293 1751 m 24 6 d -21 16 d
- -23 -6 d f black 1293 1751 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 1270 1074 m
- 23 6 d 752 Y -23 -6 d f black 1270 1074 m 23 6 d 752 Y -23 -6 d cl s 0.6 0.6
- 0.6 c 1249 1089 m 21 -15 d 752 Y -21 16 d f black 1249 1089 m 21 -15 d 752 Y
- -21 16 d cl s 1 1 1 c 1270 1826 m 23 6 d -20 16 d -24 -6 d f black 1270 1826 m
- 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1246 1068 m 24 6 d 725 Y -24 -6 d f black
- 1246 1068 m 24 6 d 725 Y -24 -6 d cl s 0.6 0.6 0.6 c 1226 1083 m 20 -15 d 725 Y
- -20 16 d f black 1226 1083 m 20 -15 d 725 Y -20 16 d cl s 1 1 1 c 1246 1793 m
- 24 6 d -21 16 d -23 -6 d f black 1246 1793 m 24 6 d -21 16 d -23 -6 d cl s 1 1
- 1 c 1223 1062 m 23 6 d 752 Y -23 -6 d f black 1223 1062 m 23 6 d 752 Y -23 -6 d
- cl s 0.6 0.6 0.6 c 1202 1077 m 21 -15 d 752 Y -21 16 d f black 1202 1077 m 21
- -15 d 752 Y -21 16 d cl s 1 1 1 c 1223 1814 m 23 6 d -20 16 d -24 -6 d f black
- 1223 1814 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1199 1056 m 24 6 d 725 Y -24
- -6 d f black 1199 1056 m 24 6 d 725 Y -24 -6 d cl s 0.6 0.6 0.6 c 1179 1071 m
- 20 -15 d 725 Y -20 16 d f black 1179 1071 m 20 -15 d 725 Y -20 16 d cl s 1 1 1
- c 1199 1781 m 24 6 d -21 16 d -23 -6 d f black 1199 1781 m 24 6 d -21 16 d -23
- -6 d cl s 1 1 1 c 1176 1050 m 23 6 d 631 Y -23 -6 d f black 1176 1050 m 23 6 d
- 631 Y -23 -6 d cl s 0.6 0.6 0.6 c 1155 1065 m 21 -15 d 631 Y -21 16 d f black
- 1155 1065 m 21 -15 d 631 Y -21 16 d cl s 1 1 1 c 1176 1681 m 23 6 d -20 16 d
- -24 -6 d f black 1176 1681 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1152 1044 m
- 24 6 d 604 Y -24 -6 d f black 1152 1044 m 24 6 d 604 Y -24 -6 d cl s 0.6 0.6
- 0.6 c 1132 1059 m 20 -15 d 604 Y -20 16 d f black 1132 1059 m 20 -15 d 604 Y
- -20 16 d cl s 1 1 1 c 1152 1648 m 24 6 d -21 16 d -23 -6 d f black 1152 1648 m
- 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 1129 1038 m 23 6 d 645 Y -23 -6 d f black
- 1129 1038 m 23 6 d 645 Y -23 -6 d cl s 0.6 0.6 0.6 c 1108 1053 m 21 -15 d 645 Y
- -21 15 d f black 1108 1053 m 21 -15 d 645 Y -21 15 d cl s 1 1 1 c 1129 1683 m
- 23 6 d -20 15 d -24 -6 d f black 1129 1683 m 23 6 d -20 15 d -24 -6 d cl s 1 1
- 1 c 1105 1032 m 24 6 d 578 Y -24 -6 d f black 1105 1032 m 24 6 d 578 Y -24 -6 d
- cl s 0.6 0.6 0.6 c 1085 1047 m 20 -15 d 578 Y -20 15 d f black 1085 1047 m 20
- -15 d 578 Y -20 15 d cl s 1 1 1 c 1105 1610 m 24 6 d -21 15 d -23 -6 d f black
- 1105 1610 m 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 1082 1026 m 23 6 d 873 Y -23
- -6 d f black 1082 1026 m 23 6 d 873 Y -23 -6 d cl s 0.6 0.6 0.6 c 1061 1041 m
- 21 -15 d 873 Y -21 16 d f black 1061 1041 m 21 -15 d 873 Y -21 16 d cl s 1 1 1
- c 1082 1899 m 23 6 d -20 16 d -24 -6 d f black 1082 1899 m 23 6 d -20 16 d -24
- -6 d cl s 1 1 1 c 1058 1020 m 24 6 d 524 Y -24 -6 d f black 1058 1020 m 24 6 d
- 524 Y -24 -6 d cl s 0.6 0.6 0.6 c 1038 1035 m 20 -15 d 524 Y -20 15 d f black
- 1038 1035 m 20 -15 d 524 Y -20 15 d cl s 1 1 1 c 1058 1544 m 24 6 d -21 15 d
- -23 -6 d f black 1058 1544 m 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 1035 1014 m
- 23 6 d 645 Y -23 -6 d f black 1035 1014 m 23 6 d 645 Y -23 -6 d cl s 0.6 0.6
- 0.6 c 1014 1029 m 21 -15 d 645 Y -21 15 d f black 1014 1029 m 21 -15 d 645 Y
- -21 15 d cl s 1 1 1 c 1035 1659 m 23 6 d -20 15 d -24 -6 d f black 1035 1659 m
- 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1011 1008 m 24 6 d 672 Y -24 -6 d f black
- 1011 1008 m 24 6 d 672 Y -24 -6 d cl s 0.6 0.6 0.6 c 991 1023 m 20 -15 d 672 Y
- -20 15 d f black 991 1023 m 20 -15 d 672 Y -20 15 d cl s 1 1 1 c 1011 1680 m 24
- 6 d -21 15 d -23 -6 d f black 1011 1680 m 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c
- 988 1002 m 23 6 d 510 Y -23 -5 d f black 988 1002 m 23 6 d 510 Y -23 -5 d cl s
- 0.6 0.6 0.6 c 967 1017 m 21 -15 d 511 Y -21 15 d f black 967 1017 m 21 -15 d
- 511 Y -21 15 d cl s 1 1 1 c 988 1513 m 23 5 d -20 16 d -24 -6 d f black 988
- 1513 m 23 5 d -20 16 d -24 -6 d cl s 1 1 1 c 964 996 m 24 6 d 551 Y -24 -6 d f
- black 964 996 m 24 6 d 551 Y -24 -6 d cl s 0.6 0.6 0.6 c 944 1011 m 20 -15 d
- 551 Y -20 15 d f black 944 1011 m 20 -15 d 551 Y -20 15 d cl s 1 1 1 c 964 1547
- m 24 6 d -21 15 d -23 -6 d f black 964 1547 m 24 6 d -21 15 d -23 -6 d cl s 1 1
- 1 c 941 990 m 23 6 d 631 Y -23 -6 d f black 941 990 m 23 6 d 631 Y -23 -6 d
- cl s 0.6 0.6 0.6 c 920 1006 m 21 -16 d 631 Y -21 16 d f black 920 1006 m 21 -16
- d 631 Y -21 16 d cl s 1 1 1 c 941 1621 m 23 6 d -20 16 d -24 -6 d f black 941
- 1621 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 917 984 m 24 6 d 645 Y -24 -6 d f
- black 917 984 m 24 6 d 645 Y -24 -6 d cl s 0.6 0.6 0.6 c 897 1000 m 20 -16 d
- 645 Y -20 15 d f black 897 1000 m 20 -16 d 645 Y -20 15 d cl s 1 1 1 c 917 1629
- m 24 6 d -21 15 d -23 -6 d f black 917 1629 m 24 6 d -21 15 d -23 -6 d cl s 1 1
- 1 c 894 978 m 23 6 d 591 Y -23 -6 d f black 894 978 m 23 6 d 591 Y -23 -6 d
- cl s 0.6 0.6 0.6 c 873 994 m 21 -16 d 591 Y -21 16 d f black 873 994 m 21 -16 d
- 591 Y -21 16 d cl s 1 1 1 c 894 1569 m 23 6 d -20 16 d -24 -6 d f black 894
- 1569 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 870 972 m 24 6 d 591 Y -24 -6 d f
- black 870 972 m 24 6 d 591 Y -24 -6 d cl s 0.6 0.6 0.6 c 850 988 m 20 -16 d 591
- Y -20 16 d f black 850 988 m 20 -16 d 591 Y -20 16 d cl s 1 1 1 c 870 1563 m 24
- 6 d -21 16 d -23 -6 d f black 870 1563 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c
- 847 966 m 23 6 d 685 Y -23 -6 d f black 847 966 m 23 6 d 685 Y -23 -6 d cl s
- 0.6 0.6 0.6 c 826 982 m 21 -16 d 685 Y -21 16 d f black 826 982 m 21 -16 d 685
- Y -21 16 d cl s 1 1 1 c 847 1651 m 23 6 d -20 16 d -24 -6 d f black 847 1651 m
- 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 823 960 m 24 6 d 726 Y -24 -6 d f black
- 823 960 m 24 6 d 726 Y -24 -6 d cl s 0.6 0.6 0.6 c 803 976 m 20 -16 d 726 Y -20
- 15 d f black 803 976 m 20 -16 d 726 Y -20 15 d cl s 1 1 1 c 823 1686 m 24 6 d
- -21 15 d -23 -6 d f black 823 1686 m 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 800
- 954 m 23 6 d 658 Y -23 -6 d f black 800 954 m 23 6 d 658 Y -23 -6 d cl s 0.6
- 0.6 0.6 c 780 970 m 20 -16 d 658 Y -20 16 d f black 780 970 m 20 -16 d 658 Y
- -20 16 d cl s 1 1 1 c 800 1612 m 23 6 d -20 16 d -23 -6 d f black 800 1612 m 23
- 6 d -20 16 d -23 -6 d cl s 1 1 1 c 776 948 m 24 6 d 578 Y -24 -6 d f black 776
- 948 m 24 6 d 578 Y -24 -6 d cl s 0.6 0.6 0.6 c 756 964 m 20 -16 d 578 Y -20 15
- d f black 756 964 m 20 -16 d 578 Y -20 15 d cl s 1 1 1 c 776 1526 m 24 6 d -20
- 15 d -24 -6 d f black 776 1526 m 24 6 d -20 15 d -24 -6 d cl s 1 1 1 c 753 942
- m 23 6 d 457 Y -23 -6 d f black 753 942 m 23 6 d 457 Y -23 -6 d cl s 0.6 0.6
- 0.6 c 733 958 m 20 -16 d 457 Y -20 16 d f black 733 958 m 20 -16 d 457 Y -20 16
- d cl s 1 1 1 c 753 1399 m 23 6 d -20 15 d -23 -5 d f black 753 1399 m 23 6 d
- -20 15 d -23 -5 d cl s 1 1 1 c 729 936 m 24 6 d 699 Y -24 -6 d f black 729 936
- m 24 6 d 699 Y -24 -6 d cl s 0.6 0.6 0.6 c 709 952 m 20 -16 d 699 Y -20 15 d f
- black 709 952 m 20 -16 d 699 Y -20 15 d cl s 1 1 1 c 729 1635 m 24 6 d -20 15 d
- -24 -6 d f black 729 1635 m 24 6 d -20 15 d -24 -6 d cl s 1 1 1 c 706 930 m 23
- 6 d 538 Y -23 -6 d f black 706 930 m 23 6 d 538 Y -23 -6 d cl s 0.6 0.6 0.6 c
- 686 946 m 20 -16 d 538 Y -20 15 d f black 686 946 m 20 -16 d 538 Y -20 15 d
- cl s 1 1 1 c 706 1468 m 23 6 d -20 15 d -23 -6 d f black 706 1468 m 23 6 d -20
- 15 d -23 -6 d cl s 1 1 1 c 682 924 m 24 6 d 685 Y -24 -6 d f black 682 924 m 24
- 6 d 685 Y -24 -6 d cl s 0.6 0.6 0.6 c 662 940 m 20 -16 d 685 Y -20 16 d f black
- 662 940 m 20 -16 d 685 Y -20 16 d cl s 1 1 1 c 682 1609 m 24 6 d -20 16 d -24
- -6 d f black 682 1609 m 24 6 d -20 16 d -24 -6 d cl s 1 1 1 c 659 918 m 23 6 d
- -20 16 d -23 -6 d f black 659 918 m 23 6 d -20 16 d -23 -6 d cl s 1 1 1 c 635
- 912 m 24 6 d -20 16 d -24 -6 d f black 635 912 m 24 6 d -20 16 d -24 -6 d cl s
- 1 1 1 c 612 906 m 23 6 d -20 16 d -23 -6 d f black 612 906 m 23 6 d -20 16 d
- -23 -6 d cl s 1 1 1 c 588 900 m 24 6 d -20 16 d -24 -6 d f black 588 900 m 24 6
- d -20 16 d -24 -6 d cl s 1 1 1 c 1713 1166 m 23 6 d -20 15 d -24 -6 d f black
- 1713 1166 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1689 1160 m 24 6 d -21 15 d
- -23 -6 d f black 1689 1160 m 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 1666 1154 m
- 23 6 d -20 15 d -24 -6 d f black 1666 1154 m 23 6 d -20 15 d -24 -6 d cl s 1 1
- 1 c 1642 1148 m 24 6 d -21 15 d -23 -6 d f black 1642 1148 m 24 6 d -21 15 d
- -23 -6 d cl s 1 1 1 c 1619 1142 m 23 6 d 443 Y -23 -6 d f black 1619 1142 m 23
- 6 d 443 Y -23 -6 d cl s 0.6 0.6 0.6 c 1598 1157 m 21 -15 d 443 Y -21 16 d f
- black 1598 1157 m 21 -15 d 443 Y -21 16 d cl s 1 1 1 c 1619 1585 m 23 6 d -20
- 16 d -24 -6 d f black 1619 1585 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1595
- 1136 m 24 6 d 470 Y -24 -6 d f black 1595 1136 m 24 6 d 470 Y -24 -6 d cl s 0.6
- 0.6 0.6 c 1575 1151 m 20 -15 d 470 Y -20 16 d f black 1575 1151 m 20 -15 d 470
- Y -20 16 d cl s 1 1 1 c 1595 1606 m 24 6 d -21 16 d -23 -6 d f black 1595 1606
- m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 1572 1130 m 23 6 d 537 Y -23 -6 d f
- black 1572 1130 m 23 6 d 537 Y -23 -6 d cl s 0.6 0.6 0.6 c 1552 1145 m 20 -15 d
- 537 Y -20 16 d f black 1552 1145 m 20 -15 d 537 Y -20 16 d cl s 1 1 1 c 1572
- 1667 m 23 6 d -20 16 d -23 -6 d f black 1572 1667 m 23 6 d -20 16 d -23 -6 d
- cl s 1 1 1 c 1548 1124 m 24 6 d 658 Y -24 -6 d f black 1548 1124 m 24 6 d 658 Y
- -24 -6 d cl s 0.6 0.6 0.6 c 1528 1139 m 20 -15 d 658 Y -20 16 d f black 1528
- 1139 m 20 -15 d 658 Y -20 16 d cl s 1 1 1 c 1548 1782 m 24 6 d -20 16 d -24 -6
- d f black 1548 1782 m 24 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1525 1118 m 23 6 d
- 578 Y -23 -6 d f black 1525 1118 m 23 6 d 578 Y -23 -6 d cl s 0.6 0.6 0.6 c
- 1505 1133 m 20 -15 d 578 Y -20 15 d f black 1505 1133 m 20 -15 d 578 Y -20 15 d
- cl s 1 1 1 c 1525 1696 m 23 6 d -20 15 d -23 -6 d f black 1525 1696 m 23 6 d
- -20 15 d -23 -6 d cl s 1 1 1 c 1501 1112 m 24 6 d 551 Y -24 -6 d f black 1501
- 1112 m 24 6 d 551 Y -24 -6 d cl s 0.6 0.6 0.6 c 1481 1128 m 20 -16 d 551 Y -20
- 15 d f black 1481 1128 m 20 -16 d 551 Y -20 15 d cl s 1 1 1 c 1501 1663 m 24 6
- d -20 15 d -24 -6 d f black 1501 1663 m 24 6 d -20 15 d -24 -6 d cl s 1 1 1 c
- 1478 1106 m 23 6 d 470 Y -23 -6 d f black 1478 1106 m 23 6 d 470 Y -23 -6 d
- cl s 0.6 0.6 0.6 c 1458 1122 m 20 -16 d 470 Y -20 16 d f black 1458 1122 m 20
- -16 d 470 Y -20 16 d cl s 1 1 1 c 1478 1576 m 23 6 d -20 16 d -23 -6 d f black
- 1478 1576 m 23 6 d -20 16 d -23 -6 d cl s 1 1 1 c 1454 1100 m 24 6 d 417 Y -24
- -6 d f black 1454 1100 m 24 6 d 417 Y -24 -6 d cl s 0.6 0.6 0.6 c 1434 1116 m
- 20 -16 d 417 Y -20 15 d f black 1434 1116 m 20 -16 d 417 Y -20 15 d cl s 1 1 1
- c 1454 1517 m 24 6 d -20 15 d -24 -6 d f black 1454 1517 m 24 6 d -20 15 d -24
- -6 d cl s 1 1 1 c 1431 1094 m 23 6 d 564 Y -23 -6 d f black 1431 1094 m 23 6 d
- 564 Y -23 -6 d cl s 0.6 0.6 0.6 c 1411 1110 m 20 -16 d 564 Y -20 16 d f black
- 1411 1110 m 20 -16 d 564 Y -20 16 d cl s 1 1 1 c 1431 1658 m 23 6 d -20 16 d
- -23 -6 d f black 1431 1658 m 23 6 d -20 16 d -23 -6 d cl s 1 1 1 c 1407 1088 m
- 24 6 d 618 Y -24 -6 d f black 1407 1088 m 24 6 d 618 Y -24 -6 d cl s 0.6 0.6
- 0.6 c 1387 1104 m 20 -16 d 618 Y -20 16 d f black 1387 1104 m 20 -16 d 618 Y
- -20 16 d cl s 1 1 1 c 1407 1706 m 24 6 d -20 16 d -24 -6 d f black 1407 1706 m
- 24 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1384 1082 m 23 6 d 470 Y -23 -6 d f black
- 1384 1082 m 23 6 d 470 Y -23 -6 d cl s 0.6 0.6 0.6 c 1364 1098 m 20 -16 d 470 Y
- -20 16 d f black 1364 1098 m 20 -16 d 470 Y -20 16 d cl s 1 1 1 c 1384 1552 m
- 23 6 d -20 16 d -23 -6 d f black 1384 1552 m 23 6 d -20 16 d -23 -6 d cl s 1 1
- 1 c 1360 1076 m 24 6 d 618 Y -24 -6 d f black 1360 1076 m 24 6 d 618 Y -24 -6 d
- cl s 0.6 0.6 0.6 c 1340 1092 m 20 -16 d 618 Y -20 16 d f black 1340 1092 m 20
- -16 d 618 Y -20 16 d cl s 1 1 1 c 1360 1694 m 24 6 d -20 16 d -24 -6 d f black
- 1360 1694 m 24 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1337 1070 m 23 6 d 699 Y -23
- -6 d f black 1337 1070 m 23 6 d 699 Y -23 -6 d cl s 0.6 0.6 0.6 c 1317 1086 m
- 20 -16 d 699 Y -20 15 d f black 1317 1086 m 20 -16 d 699 Y -20 15 d cl s 1 1 1
- c 1337 1769 m 23 6 d -20 15 d -23 -6 d f black 1337 1769 m 23 6 d -20 15 d -23
- -6 d cl s 1 1 1 c 1313 1064 m 24 6 d 484 Y -24 -6 d f black 1313 1064 m 24 6 d
- 484 Y -24 -6 d cl s 0.6 0.6 0.6 c 1293 1080 m 20 -16 d 484 Y -20 15 d f black
- 1293 1080 m 20 -16 d 484 Y -20 15 d cl s 1 1 1 c 1313 1548 m 24 6 d -20 15 d
- -24 -6 d f black 1313 1548 m 24 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1290 1058 m
- 23 6 d 551 Y -23 -6 d f black 1290 1058 m 23 6 d 551 Y -23 -6 d cl s 0.6 0.6
- 0.6 c 1270 1074 m 20 -16 d 551 Y -20 16 d f black 1270 1074 m 20 -16 d 551 Y
- -20 16 d cl s 1 1 1 c 1290 1609 m 23 6 d -20 16 d -23 -6 d f black 1290 1609 m
- 23 6 d -20 16 d -23 -6 d cl s 1 1 1 c 1266 1052 m 24 6 d 497 Y -24 -6 d f black
- 1266 1052 m 24 6 d 497 Y -24 -6 d cl s 0.6 0.6 0.6 c 1246 1068 m 20 -16 d 497 Y
- -20 16 d f black 1246 1068 m 20 -16 d 497 Y -20 16 d cl s 1 1 1 c 1266 1549 m
- 24 6 d -20 16 d -24 -6 d f black 1266 1549 m 24 6 d -20 16 d -24 -6 d cl s 1 1
- 1 c 1243 1046 m 23 6 d 551 Y -23 -6 d f black 1243 1046 m 23 6 d 551 Y -23 -6 d
- cl s 0.6 0.6 0.6 c 1223 1062 m 20 -16 d 551 Y -20 16 d f black 1223 1062 m 20
- -16 d 551 Y -20 16 d cl s 1 1 1 c 1243 1597 m 23 6 d -20 16 d -23 -6 d f black
- 1243 1597 m 23 6 d -20 16 d -23 -6 d cl s 1 1 1 c 1220 1040 m 23 6 d 417 Y -23
- -6 d f black 1220 1040 m 23 6 d 417 Y -23 -6 d cl s 0.6 0.6 0.6 c 1199 1056 m
- 21 -16 d 417 Y -21 15 d f black 1199 1056 m 21 -16 d 417 Y -21 15 d cl s 1 1 1
- c 1220 1457 m 23 6 d -20 15 d -24 -6 d f black 1220 1457 m 23 6 d -20 15 d -24
- -6 d cl s 1 1 1 c 1196 1034 m 24 6 d 806 Y -24 -6 d f black 1196 1034 m 24 6 d
- 806 Y -24 -6 d cl s 0.6 0.6 0.6 c 1176 1050 m 20 -16 d 806 Y -20 16 d f black
- 1176 1050 m 20 -16 d 806 Y -20 16 d cl s 1 1 1 c 1196 1840 m 24 6 d -21 16 d
- -23 -6 d f black 1196 1840 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 1173 1028 m
- 23 6 d 565 Y -23 -6 d f black 1173 1028 m 23 6 d 565 Y -23 -6 d cl s 0.6 0.6
- 0.6 c 1152 1044 m 21 -16 d 565 Y -21 15 d f black 1152 1044 m 21 -16 d 565 Y
- -21 15 d cl s 1 1 1 c 1173 1593 m 23 6 d -20 15 d -24 -6 d f black 1173 1593 m
- 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1149 1022 m 24 6 d 605 Y -24 -6 d f black
- 1149 1022 m 24 6 d 605 Y -24 -6 d cl s 0.6 0.6 0.6 c 1129 1038 m 20 -16 d 605 Y
- -20 15 d f black 1129 1038 m 20 -16 d 605 Y -20 15 d cl s 1 1 1 c 1149 1627 m
- 24 6 d -21 15 d -23 -6 d f black 1149 1627 m 24 6 d -21 15 d -23 -6 d cl s 1 1
- 1 c 1126 1016 m 23 6 d 591 Y -23 -6 d f black 1126 1016 m 23 6 d 591 Y -23 -6 d
- cl s 0.6 0.6 0.6 c 1105 1032 m 21 -16 d 591 Y -21 16 d f black 1105 1032 m 21
- -16 d 591 Y -21 16 d cl s 1 1 1 c 1126 1607 m 23 6 d -20 16 d -24 -6 d f black
- 1126 1607 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1102 1010 m 24 6 d 524 Y -24
- -6 d f black 1102 1010 m 24 6 d 524 Y -24 -6 d cl s 0.6 0.6 0.6 c 1082 1026 m
- 20 -16 d 524 Y -20 16 d f black 1082 1026 m 20 -16 d 524 Y -20 16 d cl s 1 1 1
- c 1102 1534 m 24 6 d -21 16 d -23 -6 d f black 1102 1534 m 24 6 d -21 16 d -23
- -6 d cl s 1 1 1 c 1079 1004 m 23 6 d 565 Y -23 -6 d f black 1079 1004 m 23 6 d
- 565 Y -23 -6 d cl s 0.6 0.6 0.6 c 1058 1020 m 21 -16 d 565 Y -21 15 d f black
- 1058 1020 m 21 -16 d 565 Y -21 15 d cl s 1 1 1 c 1079 1569 m 23 6 d -20 15 d
- -24 -6 d f black 1079 1569 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1055 998 m
- 24 6 d 578 Y -24 -6 d f black 1055 998 m 24 6 d 578 Y -24 -6 d cl s 0.6 0.6 0.6
- c 1035 1014 m 20 -16 d 578 Y -20 16 d f black 1035 1014 m 20 -16 d 578 Y -20 16
- d cl s 1 1 1 c 1055 1576 m 24 6 d -21 16 d -23 -6 d f black 1055 1576 m 24 6 d
- -21 16 d -23 -6 d cl s 1 1 1 c 1032 992 m 23 6 d 793 Y -23 -6 d f black 1032
- 992 m 23 6 d 793 Y -23 -6 d cl s 0.6 0.6 0.6 c 1011 1008 m 21 -16 d 793 Y -21
- 16 d f black 1011 1008 m 21 -16 d 793 Y -21 16 d cl s 1 1 1 c 1032 1785 m 23 6
- d -20 16 d -24 -6 d f black 1032 1785 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c
- 1008 986 m 24 6 d 618 Y -24 -6 d f black 1008 986 m 24 6 d 618 Y -24 -6 d cl s
- 0.6 0.6 0.6 c 988 1002 m 20 -16 d 618 Y -20 16 d f black 988 1002 m 20 -16 d
- 618 Y -20 16 d cl s 1 1 1 c 1008 1604 m 24 6 d -21 16 d -23 -6 d f black 1008
- 1604 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 985 980 m 23 6 d 739 Y -23 -6 d f
- black 985 980 m 23 6 d 739 Y -23 -6 d cl s 0.6 0.6 0.6 c 964 996 m 21 -16 d 739
- Y -21 16 d f black 964 996 m 21 -16 d 739 Y -21 16 d cl s 1 1 1 c 985 1719 m 23
- 6 d -20 16 d -24 -6 d f black 985 1719 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c
- 961 974 m 24 6 d 659 Y -24 -6 d f black 961 974 m 24 6 d 659 Y -24 -6 d cl s
- 0.6 0.6 0.6 c 941 990 m 20 -16 d 659 Y -20 15 d f black 941 990 m 20 -16 d 659
- Y -20 15 d cl s 1 1 1 c 961 1633 m 24 6 d -21 15 d -23 -6 d f black 961 1633 m
- 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 938 968 m 23 6 d 632 Y -23 -6 d f black
- 938 968 m 23 6 d 632 Y -23 -6 d cl s 0.6 0.6 0.6 c 917 984 m 21 -16 d 632 Y -21
- 15 d f black 917 984 m 21 -16 d 632 Y -21 15 d cl s 1 1 1 c 938 1600 m 23 6 d
- -20 15 d -24 -6 d f black 938 1600 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 914
- 962 m 24 6 d 699 Y -24 -6 d f black 914 962 m 24 6 d 699 Y -24 -6 d cl s 0.6
- 0.6 0.6 c 894 978 m 20 -16 d 699 Y -20 16 d f black 894 978 m 20 -16 d 699 Y
- -20 16 d cl s 1 1 1 c 914 1661 m 24 6 d -21 16 d -23 -6 d f black 914 1661 m 24
- 6 d -21 16 d -23 -6 d cl s 1 1 1 c 891 957 m 23 5 d 565 Y -23 -6 d f black 891
- 957 m 23 5 d 565 Y -23 -6 d cl s 0.6 0.6 0.6 c 870 972 m 21 -15 d 564 Y -21 15
- d f black 870 972 m 21 -15 d 564 Y -21 15 d cl s 1 1 1 c 891 1521 m 23 6 d -20
- 15 d -24 -6 d f black 891 1521 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 867 951
- m 24 6 d 618 Y -24 -6 d f black 867 951 m 24 6 d 618 Y -24 -6 d cl s 0.6 0.6
- 0.6 c 847 966 m 20 -15 d 618 Y -20 15 d f black 847 966 m 20 -15 d 618 Y -20 15
- d cl s 1 1 1 c 867 1569 m 24 6 d -21 15 d -23 -6 d f black 867 1569 m 24 6 d
- -21 15 d -23 -6 d cl s 1 1 1 c 844 945 m 23 6 d 604 Y -23 -6 d f black 844 945
- m 23 6 d 604 Y -23 -6 d cl s 0.6 0.6 0.6 c 823 960 m 21 -15 d 604 Y -21 16 d f
- black 823 960 m 21 -15 d 604 Y -21 16 d cl s 1 1 1 c 844 1549 m 23 6 d -20 16 d
- -24 -6 d f black 844 1549 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 820 939 m 24
- 6 d 591 Y -24 -6 d f black 820 939 m 24 6 d 591 Y -24 -6 d cl s 0.6 0.6 0.6 c
- 800 954 m 20 -15 d 591 Y -20 15 d f black 800 954 m 20 -15 d 591 Y -20 15 d
- cl s 1 1 1 c 820 1530 m 24 6 d -21 15 d -23 -6 d f black 820 1530 m 24 6 d -21
- 15 d -23 -6 d cl s 1 1 1 c 797 933 m 23 6 d 456 Y -23 -6 d f black 797 933 m 23
- 6 d 456 Y -23 -6 d cl s 0.6 0.6 0.6 c 776 948 m 21 -15 d 456 Y -21 16 d f black
- 776 948 m 21 -15 d 456 Y -21 16 d cl s 1 1 1 c 797 1389 m 23 6 d -20 16 d -24
- -6 d f black 797 1389 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 773 927 m 24 6 d
- 765 Y -24 -6 d f black 773 927 m 24 6 d 765 Y -24 -6 d cl s 0.6 0.6 0.6 c 753
- 942 m 20 -15 d 765 Y -20 16 d f black 753 942 m 20 -15 d 765 Y -20 16 d cl s 1
- 1 1 c 773 1692 m 24 6 d -21 16 d -23 -6 d f black 773 1692 m 24 6 d -21 16 d
- -23 -6 d cl s 1 1 1 c 750 921 m 23 6 d 685 Y -23 -6 d f black 750 921 m 23 6 d
- 685 Y -23 -6 d cl s 0.6 0.6 0.6 c 729 936 m 21 -15 d 685 Y -21 15 d f black 729
- 936 m 21 -15 d 685 Y -21 15 d cl s 1 1 1 c 750 1606 m 23 6 d -20 15 d -24 -6 d
- f black 750 1606 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 726 915 m 24 6 d 591 Y
- -24 -6 d f black 726 915 m 24 6 d 591 Y -24 -6 d cl s 0.6 0.6 0.6 c 706 930 m
- 20 -15 d 591 Y -20 15 d f black 706 930 m 20 -15 d 591 Y -20 15 d cl s 1 1 1 c
- 726 1506 m 24 6 d -21 15 d -23 -6 d f black 726 1506 m 24 6 d -21 15 d -23 -6 d
- cl s 1 1 1 c 703 909 m 23 6 d 551 Y -23 -6 d f black 703 909 m 23 6 d 551 Y -23
- -6 d cl s 0.6 0.6 0.6 c 682 924 m 21 -15 d 551 Y -21 15 d f black 682 924 m 21
- -15 d 551 Y -21 15 d cl s 1 1 1 c 703 1460 m 23 6 d -20 15 d -24 -6 d f black
- 703 1460 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 679 903 m 24 6 d -21 15 d -23
- -6 d f black 679 903 m 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 656 897 m 23 6 d
- -20 15 d -24 -6 d f black 656 897 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 632
- 891 m 24 6 d -21 15 d -23 -6 d f black 632 891 m 24 6 d -21 15 d -23 -6 d cl s
- 1 1 1 c 609 885 m 23 6 d -20 15 d -24 -6 d f black 609 885 m 23 6 d -20 15 d
- -24 -6 d cl s 1 1 1 c 1733 1150 m 24 6 d -21 16 d -23 -6 d f black 1733 1150 m
- 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 1710 1144 m 23 6 d -20 16 d -24 -6 d f
- black 1710 1144 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1686 1138 m 24 6 d -21
- 16 d -23 -6 d f black 1686 1138 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 1663
- 1132 m 23 6 d -20 16 d -24 -6 d f black 1663 1132 m 23 6 d -20 16 d -24 -6 d
- cl s 1 1 1 c 1639 1126 m 24 6 d 632 Y -24 -6 d f black 1639 1126 m 24 6 d 632 Y
- -24 -6 d cl s 0.6 0.6 0.6 c 1619 1142 m 20 -16 d 632 Y -20 15 d f black 1619
- 1142 m 20 -16 d 632 Y -20 15 d cl s 1 1 1 c 1639 1758 m 24 6 d -21 15 d -23 -6
- d f black 1639 1758 m 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 1616 1120 m 23 6 d
- 551 Y -23 -6 d f black 1616 1120 m 23 6 d 551 Y -23 -6 d cl s 0.6 0.6 0.6 c
- 1595 1136 m 21 -16 d 551 Y -21 16 d f black 1595 1136 m 21 -16 d 551 Y -21 16 d
- cl s 1 1 1 c 1616 1671 m 23 6 d -20 16 d -24 -6 d f black 1616 1671 m 23 6 d
- -20 16 d -24 -6 d cl s 1 1 1 c 1592 1114 m 24 6 d 430 Y -24 -6 d f black 1592
- 1114 m 24 6 d 430 Y -24 -6 d cl s 0.6 0.6 0.6 c 1572 1130 m 20 -16 d 430 Y -20
- 16 d f black 1572 1130 m 20 -16 d 430 Y -20 16 d cl s 1 1 1 c 1592 1544 m 24 6
- d -21 16 d -23 -6 d f black 1592 1544 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c
- 1569 1108 m 23 6 d 524 Y -23 -6 d f black 1569 1108 m 23 6 d 524 Y -23 -6 d
- cl s 0.6 0.6 0.6 c 1548 1124 m 21 -16 d 524 Y -21 16 d f black 1548 1124 m 21
- -16 d 524 Y -21 16 d cl s 1 1 1 c 1569 1632 m 23 6 d -20 16 d -24 -6 d f black
- 1569 1632 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1545 1102 m 24 6 d 672 Y -24
- -6 d f black 1545 1102 m 24 6 d 672 Y -24 -6 d cl s 0.6 0.6 0.6 c 1525 1118 m
- 20 -16 d 672 Y -20 16 d f black 1525 1118 m 20 -16 d 672 Y -20 16 d cl s 1 1 1
- c 1545 1774 m 24 6 d -21 16 d -23 -6 d f black 1545 1774 m 24 6 d -21 16 d -23
- -6 d cl s 1 1 1 c 1522 1096 m 23 6 d 551 Y -23 -6 d f black 1522 1096 m 23 6 d
- 551 Y -23 -6 d cl s 0.6 0.6 0.6 c 1501 1112 m 21 -16 d 551 Y -21 16 d f black
- 1501 1112 m 21 -16 d 551 Y -21 16 d cl s 1 1 1 c 1522 1647 m 23 6 d -20 16 d
- -24 -6 d f black 1522 1647 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1498 1090 m
- 24 6 d 363 Y -24 -6 d f black 1498 1090 m 24 6 d 363 Y -24 -6 d cl s 0.6 0.6
- 0.6 c 1478 1106 m 20 -16 d 363 Y -20 16 d f black 1478 1106 m 20 -16 d 363 Y
- -20 16 d cl s 1 1 1 c 1498 1453 m 24 6 d -21 16 d -23 -6 d f black 1498 1453 m
- 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 1475 1084 m 23 6 d 538 Y -23 -6 d f black
- 1475 1084 m 23 6 d 538 Y -23 -6 d cl s 0.6 0.6 0.6 c 1454 1100 m 21 -16 d 538 Y
- -21 15 d f black 1454 1100 m 21 -16 d 538 Y -21 15 d cl s 1 1 1 c 1475 1622 m
- 23 6 d -20 15 d -24 -6 d f black 1475 1622 m 23 6 d -20 15 d -24 -6 d cl s 1 1
- 1 c 1451 1079 m 24 5 d 605 Y -24 -6 d f black 1451 1079 m 24 5 d 605 Y -24 -6 d
- cl s 0.6 0.6 0.6 c 1431 1094 m 20 -15 d 604 Y -20 16 d f black 1431 1094 m 20
- -15 d 604 Y -20 16 d cl s 1 1 1 c 1451 1683 m 24 6 d -21 16 d -23 -6 d f black
- 1451 1683 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 1428 1073 m 23 6 d 470 Y -23
- -6 d f black 1428 1073 m 23 6 d 470 Y -23 -6 d cl s 0.6 0.6 0.6 c 1407 1088 m
- 21 -15 d 470 Y -21 15 d f black 1407 1088 m 21 -15 d 470 Y -21 15 d cl s 1 1 1
- c 1428 1543 m 23 6 d -20 15 d -24 -6 d f black 1428 1543 m 23 6 d -20 15 d -24
- -6 d cl s 1 1 1 c 1404 1067 m 24 6 d 429 Y -24 -6 d f black 1404 1067 m 24 6 d
- 429 Y -24 -6 d cl s 0.6 0.6 0.6 c 1384 1082 m 20 -15 d 429 Y -20 16 d f black
- 1384 1082 m 20 -15 d 429 Y -20 16 d cl s 1 1 1 c 1404 1496 m 24 6 d -21 16 d
- -23 -6 d f black 1404 1496 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 1381 1061 m
- 23 6 d 456 Y -23 -6 d f black 1381 1061 m 23 6 d 456 Y -23 -6 d cl s 0.6 0.6
- 0.6 c 1360 1076 m 21 -15 d 456 Y -21 16 d f black 1360 1076 m 21 -15 d 456 Y
- -21 16 d cl s 1 1 1 c 1381 1517 m 23 6 d -20 16 d -24 -6 d f black 1381 1517 m
- 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1357 1055 m 24 6 d 537 Y -24 -6 d f black
- 1357 1055 m 24 6 d 537 Y -24 -6 d cl s 0.6 0.6 0.6 c 1337 1070 m 20 -15 d 537 Y
- -20 16 d f black 1337 1070 m 20 -15 d 537 Y -20 16 d cl s 1 1 1 c 1357 1592 m
- 24 6 d -21 16 d -23 -6 d f black 1357 1592 m 24 6 d -21 16 d -23 -6 d cl s 1 1
- 1 c 1334 1049 m 23 6 d 456 Y -23 -6 d f black 1334 1049 m 23 6 d 456 Y -23 -6 d
- cl s 0.6 0.6 0.6 c 1313 1064 m 21 -15 d 456 Y -21 16 d f black 1313 1064 m 21
- -15 d 456 Y -21 16 d cl s 1 1 1 c 1334 1505 m 23 6 d -20 16 d -24 -6 d f black
- 1334 1505 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1310 1043 m 24 6 d 362 Y -24
- -6 d f black 1310 1043 m 24 6 d 362 Y -24 -6 d cl s 0.6 0.6 0.6 c 1290 1058 m
- 20 -15 d 362 Y -20 16 d f black 1290 1058 m 20 -15 d 362 Y -20 16 d cl s 1 1 1
- c 1310 1405 m 24 6 d -21 16 d -23 -6 d f black 1310 1405 m 24 6 d -21 16 d -23
- -6 d cl s 1 1 1 c 1287 1037 m 23 6 d 551 Y -23 -6 d f black 1287 1037 m 23 6 d
- 551 Y -23 -6 d cl s 0.6 0.6 0.6 c 1266 1052 m 21 -15 d 551 Y -21 15 d f black
- 1266 1052 m 21 -15 d 551 Y -21 15 d cl s 1 1 1 c 1287 1588 m 23 6 d -20 15 d
- -24 -6 d f black 1287 1588 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1263 1031 m
- 24 6 d 497 Y -24 -6 d f black 1263 1031 m 24 6 d 497 Y -24 -6 d cl s 0.6 0.6
- 0.6 c 1243 1046 m 20 -15 d 497 Y -20 15 d f black 1243 1046 m 20 -15 d 497 Y
- -20 15 d cl s 1 1 1 c 1263 1528 m 24 6 d -21 15 d -23 -6 d f black 1263 1528 m
- 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 1240 1025 m 23 6 d 497 Y -23 -6 d f black
- 1240 1025 m 23 6 d 497 Y -23 -6 d cl s 0.6 0.6 0.6 c 1220 1040 m 20 -15 d 497 Y
- -20 15 d f black 1220 1040 m 20 -15 d 497 Y -20 15 d cl s 1 1 1 c 1240 1522 m
- 23 6 d -20 15 d -23 -6 d f black 1240 1522 m 23 6 d -20 15 d -23 -6 d cl s 1 1
- 1 c 1216 1019 m 24 6 d 470 Y -24 -6 d f black 1216 1019 m 24 6 d 470 Y -24 -6 d
- cl s 0.6 0.6 0.6 c 1196 1034 m 20 -15 d 470 Y -20 16 d f black 1196 1034 m 20
- -15 d 470 Y -20 16 d cl s 1 1 1 c 1216 1489 m 24 6 d -20 15 d -24 -5 d f black
- 1216 1489 m 24 6 d -20 15 d -24 -5 d cl s 1 1 1 c 1193 1013 m 23 6 d 497 Y -23
- -6 d f black 1193 1013 m 23 6 d 497 Y -23 -6 d cl s 0.6 0.6 0.6 c 1173 1028 m
- 20 -15 d 497 Y -20 15 d f black 1173 1028 m 20 -15 d 497 Y -20 15 d cl s 1 1 1
- c 1193 1510 m 23 6 d -20 15 d -23 -6 d f black 1193 1510 m 23 6 d -20 15 d -23
- -6 d cl s 1 1 1 c 1169 1007 m 24 6 d 430 Y -24 -6 d f black 1169 1007 m 24 6 d
- 430 Y -24 -6 d cl s 0.6 0.6 0.6 c 1149 1022 m 20 -15 d 430 Y -20 15 d f black
- 1149 1022 m 20 -15 d 430 Y -20 15 d cl s 1 1 1 c 1169 1437 m 24 6 d -20 15 d
- -24 -6 d f black 1169 1437 m 24 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1146 1001 m
- 23 6 d 497 Y -23 -6 d f black 1146 1001 m 23 6 d 497 Y -23 -6 d cl s 0.6 0.6
- 0.6 c 1126 1016 m 20 -15 d 497 Y -20 15 d f black 1126 1016 m 20 -15 d 497 Y
- -20 15 d cl s 1 1 1 c 1146 1498 m 23 6 d -20 15 d -23 -6 d f black 1146 1498 m
- 23 6 d -20 15 d -23 -6 d cl s 1 1 1 c 1122 995 m 24 6 d 363 Y -24 -6 d f black
- 1122 995 m 24 6 d 363 Y -24 -6 d cl s 0.6 0.6 0.6 c 1102 1010 m 20 -15 d 363 Y
- -20 15 d f black 1102 1010 m 20 -15 d 363 Y -20 15 d cl s 1 1 1 c 1122 1358 m
- 24 6 d -20 15 d -24 -6 d f black 1122 1358 m 24 6 d -20 15 d -24 -6 d cl s 1 1
- 1 c 1099 989 m 23 6 d 457 Y -23 -6 d f black 1099 989 m 23 6 d 457 Y -23 -6 d
- cl s 0.6 0.6 0.6 c 1079 1004 m 20 -15 d 457 Y -20 15 d f black 1079 1004 m 20
- -15 d 457 Y -20 15 d cl s 1 1 1 c 1099 1446 m 23 6 d -20 15 d -23 -6 d f black
- 1099 1446 m 23 6 d -20 15 d -23 -6 d cl s 1 1 1 c 1075 983 m 24 6 d 457 Y -24
- -6 d f black 1075 983 m 24 6 d 457 Y -24 -6 d cl s 0.6 0.6 0.6 c 1055 998 m 20
- -15 d 457 Y -20 15 d f black 1055 998 m 20 -15 d 457 Y -20 15 d cl s 1 1 1 c
- 1075 1440 m 24 6 d -20 15 d -24 -6 d f black 1075 1440 m 24 6 d -20 15 d -24 -6
- d cl s 1 1 1 c 1052 977 m 23 6 d 497 Y -23 -6 d f black 1052 977 m 23 6 d 497 Y
- -23 -6 d cl s 0.6 0.6 0.6 c 1032 992 m 20 -15 d 497 Y -20 16 d f black 1032 992
- m 20 -15 d 497 Y -20 16 d cl s 1 1 1 c 1052 1474 m 23 6 d -20 15 d -23 -5 d f
- black 1052 1474 m 23 6 d -20 15 d -23 -5 d cl s 1 1 1 c 1028 971 m 24 6 d 631 Y
- -24 -6 d f black 1028 971 m 24 6 d 631 Y -24 -6 d cl s 0.6 0.6 0.6 c 1008 986 m
- 20 -15 d 631 Y -20 16 d f black 1008 986 m 20 -15 d 631 Y -20 16 d cl s 1 1 1 c
- 1028 1602 m 24 6 d -20 16 d -24 -6 d f black 1028 1602 m 24 6 d -20 16 d -24 -6
- d cl s 1 1 1 c 1005 965 m 23 6 d 497 Y -23 -6 d f black 1005 965 m 23 6 d 497 Y
- -23 -6 d cl s 0.6 0.6 0.6 c 985 980 m 20 -15 d 497 Y -20 16 d f black 985 980 m
- 20 -15 d 497 Y -20 16 d cl s 1 1 1 c 1005 1462 m 23 6 d -20 16 d -23 -6 d f
- black 1005 1462 m 23 6 d -20 16 d -23 -6 d cl s 1 1 1 c 981 959 m 24 6 d 537 Y
- -24 -6 d f black 981 959 m 24 6 d 537 Y -24 -6 d cl s 0.6 0.6 0.6 c 961 974 m
- 20 -15 d 537 Y -20 16 d f black 961 974 m 20 -15 d 537 Y -20 16 d cl s 1 1 1 c
- 981 1496 m 24 6 d -20 16 d -24 -6 d f black 981 1496 m 24 6 d -20 16 d -24 -6 d
- cl s 1 1 1 c 958 953 m 23 6 d 390 Y -23 -6 d f black 958 953 m 23 6 d 390 Y -23
- -6 d cl s 0.6 0.6 0.6 c 938 968 m 20 -15 d 390 Y -20 15 d f black 938 968 m 20
- -15 d 390 Y -20 15 d cl s 1 1 1 c 958 1343 m 23 6 d -20 15 d -23 -6 d f black
- 958 1343 m 23 6 d -20 15 d -23 -6 d cl s 1 1 1 c 935 947 m 23 6 d 457 Y -23 -6
- d f black 935 947 m 23 6 d 457 Y -23 -6 d cl s 0.6 0.6 0.6 c 914 962 m 21 -15 d
- 457 Y -21 15 d f black 914 962 m 21 -15 d 457 Y -21 15 d cl s 1 1 1 c 935 1404
- m 23 6 d -20 15 d -24 -6 d f black 935 1404 m 23 6 d -20 15 d -24 -6 d cl s 1 1
- 1 c 911 941 m 24 6 d 551 Y -24 -6 d f black 911 941 m 24 6 d 551 Y -24 -6 d
- cl s 0.6 0.6 0.6 c 891 957 m 20 -16 d 551 Y -20 15 d f black 891 957 m 20 -16 d
- 551 Y -20 15 d cl s 1 1 1 c 911 1492 m 24 6 d -21 15 d -23 -6 d f black 911
- 1492 m 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 888 935 m 23 6 d 524 Y -23 -6 d f
- black 888 935 m 23 6 d 524 Y -23 -6 d cl s 0.6 0.6 0.6 c 867 951 m 21 -16 d 524
- Y -21 16 d f black 867 951 m 21 -16 d 524 Y -21 16 d cl s 1 1 1 c 888 1459 m 23
- 6 d -20 16 d -24 -6 d f black 888 1459 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c
- 864 929 m 24 6 d 430 Y -24 -6 d f black 864 929 m 24 6 d 430 Y -24 -6 d cl s
- 0.6 0.6 0.6 c 844 945 m 20 -16 d 430 Y -20 15 d f black 844 945 m 20 -16 d 430
- Y -20 15 d cl s 1 1 1 c 864 1359 m 24 6 d -21 15 d -23 -6 d f black 864 1359 m
- 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 841 923 m 23 6 d 551 Y -23 -6 d f black
- 841 923 m 23 6 d 551 Y -23 -6 d cl s 0.6 0.6 0.6 c 820 939 m 21 -16 d 551 Y -21
- 15 d f black 820 939 m 21 -16 d 551 Y -21 15 d cl s 1 1 1 c 841 1474 m 23 6 d
- -20 15 d -24 -6 d f black 841 1474 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 817
- 917 m 24 6 d 524 Y -24 -6 d f black 817 917 m 24 6 d 524 Y -24 -6 d cl s 0.6
- 0.6 0.6 c 797 933 m 20 -16 d 524 Y -20 16 d f black 797 933 m 20 -16 d 524 Y
- -20 16 d cl s 1 1 1 c 817 1441 m 24 6 d -21 16 d -23 -6 d f black 817 1441 m 24
- 6 d -21 16 d -23 -6 d cl s 1 1 1 c 794 911 m 23 6 d 470 Y -23 -6 d f black 794
- 911 m 23 6 d 470 Y -23 -6 d cl s 0.6 0.6 0.6 c 773 927 m 21 -16 d 470 Y -21 16
- d f black 773 927 m 21 -16 d 470 Y -21 16 d cl s 1 1 1 c 794 1381 m 23 6 d -20
- 16 d -24 -6 d f black 794 1381 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 770 905
- m 24 6 d 430 Y -24 -6 d f black 770 905 m 24 6 d 430 Y -24 -6 d cl s 0.6 0.6
- 0.6 c 750 921 m 20 -16 d 430 Y -20 16 d f black 750 921 m 20 -16 d 430 Y -20 16
- d cl s 1 1 1 c 770 1335 m 24 6 d -21 16 d -23 -6 d f black 770 1335 m 24 6 d
- -21 16 d -23 -6 d cl s 1 1 1 c 747 899 m 23 6 d 564 Y -23 -6 d f black 747 899
- m 23 6 d 564 Y -23 -6 d cl s 0.6 0.6 0.6 c 726 915 m 21 -16 d 564 Y -21 16 d f
- black 726 915 m 21 -16 d 564 Y -21 16 d cl s 1 1 1 c 747 1463 m 23 6 d -20 16 d
- -24 -6 d f black 747 1463 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 723 893 m 24
- 6 d 484 Y -24 -6 d f black 723 893 m 24 6 d 484 Y -24 -6 d cl s 0.6 0.6 0.6 c
- 703 909 m 20 -16 d 484 Y -20 15 d f black 703 909 m 20 -16 d 484 Y -20 15 d
- cl s 1 1 1 c 723 1377 m 24 6 d -21 15 d -23 -6 d f black 723 1377 m 24 6 d -21
- 15 d -23 -6 d cl s 1 1 1 c 700 887 m 23 6 d -20 16 d -24 -6 d f black 700 887 m
- 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 676 881 m 24 6 d -21 16 d -23 -6 d f
- black 676 881 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 653 875 m 23 6 d -20 16 d
- -24 -6 d f black 653 875 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 629 869 m 24 6
- d -21 16 d -23 -6 d f black 629 869 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c
- 1753 1135 m 24 6 d -20 15 d -24 -6 d f black 1753 1135 m 24 6 d -20 15 d -24 -6
- d cl s 1 1 1 c 1730 1129 m 23 6 d -20 15 d -23 -6 d f black 1730 1129 m 23 6 d
- -20 15 d -23 -6 d cl s 1 1 1 c 1706 1123 m 24 6 d -20 15 d -24 -6 d f black
- 1706 1123 m 24 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1683 1117 m 23 6 d -20 15 d
- -23 -6 d f black 1683 1117 m 23 6 d -20 15 d -23 -6 d cl s 1 1 1 c 1660 1111 m
- 23 6 d 403 Y -23 -6 d f black 1660 1111 m 23 6 d 403 Y -23 -6 d cl s 0.6 0.6
- 0.6 c 1639 1126 m 21 -15 d 403 Y -21 15 d f black 1639 1126 m 21 -15 d 403 Y
- -21 15 d cl s 1 1 1 c 1660 1514 m 23 6 d -20 15 d -24 -6 d f black 1660 1514 m
- 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1636 1105 m 24 6 d 309 Y -24 -6 d f black
- 1636 1105 m 24 6 d 309 Y -24 -6 d cl s 0.6 0.6 0.6 c 1616 1120 m 20 -15 d 309 Y
- -20 15 d f black 1616 1120 m 20 -15 d 309 Y -20 15 d cl s 1 1 1 c 1636 1414 m
- 24 6 d -21 15 d -23 -6 d f black 1636 1414 m 24 6 d -21 15 d -23 -6 d cl s 1 1
- 1 c 1613 1099 m 23 6 d 309 Y -23 -6 d f black 1613 1099 m 23 6 d 309 Y -23 -6 d
- cl s 0.6 0.6 0.6 c 1592 1114 m 21 -15 d 309 Y -21 15 d f black 1592 1114 m 21
- -15 d 309 Y -21 15 d cl s 1 1 1 c 1613 1408 m 23 6 d -20 15 d -24 -6 d f black
- 1613 1408 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1589 1093 m 24 6 d 376 Y -24
- -6 d f black 1589 1093 m 24 6 d 376 Y -24 -6 d cl s 0.6 0.6 0.6 c 1569 1108 m
- 20 -15 d 376 Y -20 16 d f black 1569 1108 m 20 -15 d 376 Y -20 16 d cl s 1 1 1
- c 1589 1469 m 24 6 d -21 16 d -23 -6 d f black 1589 1469 m 24 6 d -21 16 d -23
- -6 d cl s 1 1 1 c 1566 1087 m 23 6 d 363 Y -23 -6 d f black 1566 1087 m 23 6 d
- 363 Y -23 -6 d cl s 0.6 0.6 0.6 c 1545 1102 m 21 -15 d 363 Y -21 15 d f black
- 1545 1102 m 21 -15 d 363 Y -21 15 d cl s 1 1 1 c 1566 1450 m 23 6 d -20 15 d
- -24 -6 d f black 1566 1450 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1542 1081 m
- 24 6 d 336 Y -24 -6 d f black 1542 1081 m 24 6 d 336 Y -24 -6 d cl s 0.6 0.6
- 0.6 c 1522 1096 m 20 -15 d 336 Y -20 15 d f black 1522 1096 m 20 -15 d 336 Y
- -20 15 d cl s 1 1 1 c 1542 1417 m 24 6 d -21 15 d -23 -6 d f black 1542 1417 m
- 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 1519 1075 m 23 6 d 376 Y -23 -6 d f black
- 1519 1075 m 23 6 d 376 Y -23 -6 d cl s 0.6 0.6 0.6 c 1498 1090 m 21 -15 d 376 Y
- -21 16 d f black 1498 1090 m 21 -15 d 376 Y -21 16 d cl s 1 1 1 c 1519 1451 m
- 23 6 d -20 16 d -24 -6 d f black 1519 1451 m 23 6 d -20 16 d -24 -6 d cl s 1 1
- 1 c 1495 1069 m 24 6 d 336 Y -24 -6 d f black 1495 1069 m 24 6 d 336 Y -24 -6 d
- cl s 0.6 0.6 0.6 c 1475 1084 m 20 -15 d 336 Y -20 15 d f black 1475 1084 m 20
- -15 d 336 Y -20 15 d cl s 1 1 1 c 1495 1405 m 24 6 d -21 15 d -23 -6 d f black
- 1495 1405 m 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 1472 1063 m 23 6 d 376 Y -23
- -6 d f black 1472 1063 m 23 6 d 376 Y -23 -6 d cl s 0.6 0.6 0.6 c 1451 1079 m
- 21 -16 d 376 Y -21 16 d f black 1451 1079 m 21 -16 d 376 Y -21 16 d cl s 1 1 1
- c 1472 1439 m 23 6 d -20 16 d -24 -6 d f black 1472 1439 m 23 6 d -20 16 d -24
- -6 d cl s 1 1 1 c 1448 1057 m 24 6 d 269 Y -24 -6 d f black 1448 1057 m 24 6 d
- 269 Y -24 -6 d cl s 0.6 0.6 0.6 c 1428 1073 m 20 -16 d 269 Y -20 15 d f black
- 1428 1073 m 20 -16 d 269 Y -20 15 d cl s 1 1 1 c 1448 1326 m 24 6 d -21 15 d
- -23 -6 d f black 1448 1326 m 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 1425 1051 m
- 23 6 d 336 Y -23 -6 d f black 1425 1051 m 23 6 d 336 Y -23 -6 d cl s 0.6 0.6
- 0.6 c 1404 1067 m 21 -16 d 336 Y -21 15 d f black 1404 1067 m 21 -16 d 336 Y
- -21 15 d cl s 1 1 1 c 1425 1387 m 23 6 d -20 15 d -24 -6 d f black 1425 1387 m
- 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1401 1045 m 24 6 d 309 Y -24 -6 d f black
- 1401 1045 m 24 6 d 309 Y -24 -6 d cl s 0.6 0.6 0.6 c 1381 1061 m 20 -16 d 309 Y
- -20 16 d f black 1381 1061 m 20 -16 d 309 Y -20 16 d cl s 1 1 1 c 1401 1354 m
- 24 6 d -21 16 d -23 -6 d f black 1401 1354 m 24 6 d -21 16 d -23 -6 d cl s 1 1
- 1 c 1378 1039 m 23 6 d 363 Y -23 -6 d f black 1378 1039 m 23 6 d 363 Y -23 -6 d
- cl s 0.6 0.6 0.6 c 1357 1055 m 21 -16 d 363 Y -21 15 d f black 1357 1055 m 21
- -16 d 363 Y -21 15 d cl s 1 1 1 c 1378 1402 m 23 6 d -20 15 d -24 -6 d f black
- 1378 1402 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1354 1033 m 24 6 d 390 Y -24
- -6 d f black 1354 1033 m 24 6 d 390 Y -24 -6 d cl s 0.6 0.6 0.6 c 1334 1049 m
- 20 -16 d 390 Y -20 15 d f black 1334 1049 m 20 -16 d 390 Y -20 15 d cl s 1 1 1
- c 1354 1423 m 24 6 d -21 15 d -23 -6 d f black 1354 1423 m 24 6 d -21 15 d -23
- -6 d cl s 1 1 1 c 1331 1027 m 23 6 d 403 Y -23 -6 d f black 1331 1027 m 23 6 d
- 403 Y -23 -6 d cl s 0.6 0.6 0.6 c 1310 1043 m 21 -16 d 403 Y -21 16 d f black
- 1310 1043 m 21 -16 d 403 Y -21 16 d cl s 1 1 1 c 1331 1430 m 23 6 d -20 16 d
- -24 -6 d f black 1331 1430 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1307 1021 m
- 24 6 d 390 Y -24 -6 d f black 1307 1021 m 24 6 d 390 Y -24 -6 d cl s 0.6 0.6
- 0.6 c 1287 1037 m 20 -16 d 390 Y -20 15 d f black 1287 1037 m 20 -16 d 390 Y
- -20 15 d cl s 1 1 1 c 1307 1411 m 24 6 d -21 15 d -23 -6 d f black 1307 1411 m
- 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 1284 1015 m 23 6 d 336 Y -23 -6 d f black
- 1284 1015 m 23 6 d 336 Y -23 -6 d cl s 0.6 0.6 0.6 c 1263 1031 m 21 -16 d 336 Y
- -21 16 d f black 1263 1031 m 21 -16 d 336 Y -21 16 d cl s 1 1 1 c 1284 1351 m
- 23 6 d -20 16 d -24 -6 d f black 1284 1351 m 23 6 d -20 16 d -24 -6 d cl s 1 1
- 1 c 1260 1009 m 24 6 d 309 Y -24 -6 d f black 1260 1009 m 24 6 d 309 Y -24 -6 d
- cl s 0.6 0.6 0.6 c 1240 1025 m 20 -16 d 309 Y -20 16 d f black 1240 1025 m 20
- -16 d 309 Y -20 16 d cl s 1 1 1 c 1260 1318 m 24 6 d -21 16 d -23 -6 d f black
- 1260 1318 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 1237 1003 m 23 6 d 269 Y -23
- -6 d f black 1237 1003 m 23 6 d 269 Y -23 -6 d cl s 0.6 0.6 0.6 c 1216 1019 m
- 21 -16 d 269 Y -21 15 d f black 1216 1019 m 21 -16 d 269 Y -21 15 d cl s 1 1 1
- c 1237 1272 m 23 6 d -20 15 d -24 -6 d f black 1237 1272 m 23 6 d -20 15 d -24
- -6 d cl s 1 1 1 c 1213 997 m 24 6 d 390 Y -24 -6 d f black 1213 997 m 24 6 d
- 390 Y -24 -6 d cl s 0.6 0.6 0.6 c 1193 1013 m 20 -16 d 390 Y -20 15 d f black
- 1193 1013 m 20 -16 d 390 Y -20 15 d cl s 1 1 1 c 1213 1387 m 24 6 d -21 15 d
- -23 -6 d f black 1213 1387 m 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 1190 991 m
- 23 6 d 444 Y -23 -6 d f black 1190 991 m 23 6 d 444 Y -23 -6 d cl s 0.6 0.6 0.6
- c 1169 1007 m 21 -16 d 444 Y -21 15 d f black 1169 1007 m 21 -16 d 444 Y -21 15
- d cl s 1 1 1 c 1190 1435 m 23 6 d -20 15 d -24 -6 d f black 1190 1435 m 23 6 d
- -20 15 d -24 -6 d cl s 1 1 1 c 1166 985 m 24 6 d 403 Y -24 -6 d f black 1166
- 985 m 24 6 d 403 Y -24 -6 d cl s 0.6 0.6 0.6 c 1146 1001 m 20 -16 d 403 Y -20
- 16 d f black 1146 1001 m 20 -16 d 403 Y -20 16 d cl s 1 1 1 c 1166 1388 m 24 6
- d -21 16 d -23 -6 d f black 1166 1388 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c
- 1143 979 m 23 6 d 350 Y -23 -6 d f black 1143 979 m 23 6 d 350 Y -23 -6 d cl s
- 0.6 0.6 0.6 c 1122 995 m 21 -16 d 350 Y -21 15 d f black 1122 995 m 21 -16 d
- 350 Y -21 15 d cl s 1 1 1 c 1143 1329 m 23 6 d -20 15 d -24 -6 d f black 1143
- 1329 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1119 973 m 24 6 d 363 Y -24 -6 d f
- black 1119 973 m 24 6 d 363 Y -24 -6 d cl s 0.6 0.6 0.6 c 1099 989 m 20 -16 d
- 363 Y -20 16 d f black 1099 989 m 20 -16 d 363 Y -20 16 d cl s 1 1 1 c 1119
- 1336 m 24 6 d -21 16 d -23 -6 d f black 1119 1336 m 24 6 d -21 16 d -23 -6 d
- cl s 1 1 1 c 1096 967 m 23 6 d 390 Y -23 -6 d f black 1096 967 m 23 6 d 390 Y
- -23 -6 d cl s 0.6 0.6 0.6 c 1075 983 m 21 -16 d 390 Y -21 15 d f black 1075 983
- m 21 -16 d 390 Y -21 15 d cl s 1 1 1 c 1096 1357 m 23 6 d -20 15 d -24 -6 d f
- black 1096 1357 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1072 961 m 24 6 d 377 Y
- -24 -6 d f black 1072 961 m 24 6 d 377 Y -24 -6 d cl s 0.6 0.6 0.6 c 1052 977 m
- 20 -16 d 377 Y -20 15 d f black 1052 977 m 20 -16 d 377 Y -20 15 d cl s 1 1 1 c
- 1072 1338 m 24 6 d -21 15 d -23 -6 d f black 1072 1338 m 24 6 d -21 15 d -23 -6
- d cl s 1 1 1 c 1049 955 m 23 6 d 363 Y -23 -6 d f black 1049 955 m 23 6 d 363 Y
- -23 -6 d cl s 0.6 0.6 0.6 c 1028 971 m 21 -16 d 363 Y -21 16 d f black 1028 971
- m 21 -16 d 363 Y -21 16 d cl s 1 1 1 c 1049 1318 m 23 6 d -20 16 d -24 -6 d f
- black 1049 1318 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1025 949 m 24 6 d 390 Y
- -24 -6 d f black 1025 949 m 24 6 d 390 Y -24 -6 d cl s 0.6 0.6 0.6 c 1005 965 m
- 20 -16 d 390 Y -20 16 d f black 1005 965 m 20 -16 d 390 Y -20 16 d cl s 1 1 1 c
- 1025 1339 m 24 6 d -21 16 d -23 -6 d f black 1025 1339 m 24 6 d -21 16 d -23 -6
- d cl s 1 1 1 c 1002 943 m 23 6 d 444 Y -23 -6 d f black 1002 943 m 23 6 d 444 Y
- -23 -6 d cl s 0.6 0.6 0.6 c 981 959 m 21 -16 d 444 Y -21 15 d f black 981 959 m
- 21 -16 d 444 Y -21 15 d cl s 1 1 1 c 1002 1387 m 23 6 d -20 15 d -24 -6 d f
- black 1002 1387 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 978 937 m 24 6 d 403 Y
- -24 -6 d f black 978 937 m 24 6 d 403 Y -24 -6 d cl s 0.6 0.6 0.6 c 958 953 m
- 20 -16 d 403 Y -20 16 d f black 958 953 m 20 -16 d 403 Y -20 16 d cl s 1 1 1 c
- 978 1340 m 24 6 d -21 16 d -23 -6 d f black 978 1340 m 24 6 d -21 16 d -23 -6 d
- cl s 1 1 1 c 955 931 m 23 6 d 471 Y -23 -6 d f black 955 931 m 23 6 d 471 Y -23
- -6 d cl s 0.6 0.6 0.6 c 935 947 m 20 -16 d 471 Y -20 15 d f black 935 947 m 20
- -16 d 471 Y -20 15 d cl s 1 1 1 c 955 1402 m 23 6 d -20 15 d -23 -6 d f black
- 955 1402 m 23 6 d -20 15 d -23 -6 d cl s 1 1 1 c 931 925 m 24 6 d 390 Y -24 -6
- d f black 931 925 m 24 6 d 390 Y -24 -6 d cl s 0.6 0.6 0.6 c 911 941 m 20 -16 d
- 390 Y -20 16 d f black 911 941 m 20 -16 d 390 Y -20 16 d cl s 1 1 1 c 931 1315
- m 24 6 d -20 16 d -24 -6 d f black 931 1315 m 24 6 d -20 16 d -24 -6 d cl s 1 1
- 1 c 908 919 m 23 6 d 283 Y -23 -6 d f black 908 919 m 23 6 d 283 Y -23 -6 d
- cl s 0.6 0.6 0.6 c 888 935 m 20 -16 d 283 Y -20 15 d f black 888 935 m 20 -16 d
- 283 Y -20 15 d cl s 1 1 1 c 908 1202 m 23 6 d -20 15 d -23 -6 d f black 908
- 1202 m 23 6 d -20 15 d -23 -6 d cl s 1 1 1 c 884 913 m 24 6 d 511 Y -24 -6 d f
- black 884 913 m 24 6 d 511 Y -24 -6 d cl s 0.6 0.6 0.6 c 864 929 m 20 -16 d 511
- Y -20 16 d f black 864 929 m 20 -16 d 511 Y -20 16 d cl s 1 1 1 c 884 1424 m 24
- 6 d -20 16 d -24 -6 d f black 884 1424 m 24 6 d -20 16 d -24 -6 d cl s 1 1 1 c
- 861 907 m 23 6 d 498 Y -23 -6 d f black 861 907 m 23 6 d 498 Y -23 -6 d cl s
- 0.6 0.6 0.6 c 841 923 m 20 -16 d 498 Y -20 15 d f black 841 923 m 20 -16 d 498
- Y -20 15 d cl s 1 1 1 c 861 1405 m 23 6 d -20 15 d -23 -6 d f black 861 1405 m
- 23 6 d -20 15 d -23 -6 d cl s 1 1 1 c 837 902 m 24 5 d 484 Y -24 -6 d f black
- 837 902 m 24 5 d 484 Y -24 -6 d cl s 0.6 0.6 0.6 c 817 917 m 20 -15 d 483 Y -20
- 16 d f black 817 917 m 20 -15 d 483 Y -20 16 d cl s 1 1 1 c 837 1385 m 24 6 d
- -20 16 d -24 -6 d f black 837 1385 m 24 6 d -20 16 d -24 -6 d cl s 1 1 1 c 814
- 896 m 23 6 d 389 Y -23 -6 d f black 814 896 m 23 6 d 389 Y -23 -6 d cl s 0.6
- 0.6 0.6 c 794 911 m 20 -15 d 389 Y -20 16 d f black 794 911 m 20 -15 d 389 Y
- -20 16 d cl s 1 1 1 c 814 1285 m 23 6 d -20 16 d -23 -6 d f black 814 1285 m 23
- 6 d -20 16 d -23 -6 d cl s 1 1 1 c 790 890 m 24 6 d 295 Y -24 -6 d f black 790
- 890 m 24 6 d 295 Y -24 -6 d cl s 0.6 0.6 0.6 c 770 905 m 20 -15 d 295 Y -20 16
- d f black 770 905 m 20 -15 d 295 Y -20 16 d cl s 1 1 1 c 790 1185 m 24 6 d -20
- 16 d -24 -6 d f black 790 1185 m 24 6 d -20 16 d -24 -6 d cl s 1 1 1 c 767 884
- m 23 6 d 403 Y -23 -6 d f black 767 884 m 23 6 d 403 Y -23 -6 d cl s 0.6 0.6
- 0.6 c 747 899 m 20 -15 d 403 Y -20 15 d f black 747 899 m 20 -15 d 403 Y -20 15
- d cl s 1 1 1 c 767 1287 m 23 6 d -20 15 d -23 -6 d f black 767 1287 m 23 6 d
- -20 15 d -23 -6 d cl s 1 1 1 c 743 878 m 24 6 d 228 Y -24 -6 d f black 743 878
- m 24 6 d 228 Y -24 -6 d cl s 0.6 0.6 0.6 c 723 893 m 20 -15 d 228 Y -20 16 d f
- black 723 893 m 20 -15 d 228 Y -20 16 d cl s 1 1 1 c 743 1106 m 24 6 d -20 16 d
- -24 -6 d f black 743 1106 m 24 6 d -20 16 d -24 -6 d cl s 1 1 1 c 720 872 m 23
- 6 d -20 15 d -23 -6 d f black 720 872 m 23 6 d -20 15 d -23 -6 d cl s 1 1 1 c
- 696 866 m 24 6 d -20 15 d -24 -6 d f black 696 866 m 24 6 d -20 15 d -24 -6 d
- cl s 1 1 1 c 673 860 m 23 6 d -20 15 d -23 -6 d f black 673 860 m 23 6 d -20 15
- d -23 -6 d cl s 1 1 1 c 649 854 m 24 6 d -20 15 d -24 -6 d f black 649 854 m 24
- 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1774 1119 m 23 6 d -20 16 d -24 -6 d f black
- 1774 1119 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1750 1113 m 24 6 d -21 16 d
- -23 -6 d f black 1750 1113 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 1727 1107 m
- 23 6 d -20 16 d -24 -6 d f black 1727 1107 m 23 6 d -20 16 d -24 -6 d cl s 1 1
- 1 c 1703 1101 m 24 6 d -21 16 d -23 -6 d f black 1703 1101 m 24 6 d -21 16 d
- -23 -6 d cl s 1 1 1 c 1680 1095 m 23 6 d 296 Y -23 -6 d f black 1680 1095 m 23
- 6 d 296 Y -23 -6 d cl s 0.6 0.6 0.6 c 1660 1111 m 20 -16 d 296 Y -20 15 d f
- black 1660 1111 m 20 -16 d 296 Y -20 15 d cl s 1 1 1 c 1680 1391 m 23 6 d -20
- 15 d -23 -6 d f black 1680 1391 m 23 6 d -20 15 d -23 -6 d cl s 1 1 1 c 1656
- 1089 m 24 6 d 350 Y -24 -6 d f black 1656 1089 m 24 6 d 350 Y -24 -6 d cl s 0.6
- 0.6 0.6 c 1636 1105 m 20 -16 d 350 Y -20 15 d f black 1636 1105 m 20 -16 d 350
- Y -20 15 d cl s 1 1 1 c 1656 1439 m 24 6 d -20 15 d -24 -6 d f black 1656 1439
- m 24 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1633 1083 m 23 6 d 323 Y -23 -6 d f
- black 1633 1083 m 23 6 d 323 Y -23 -6 d cl s 0.6 0.6 0.6 c 1613 1099 m 20 -16 d
- 323 Y -20 15 d f black 1613 1099 m 20 -16 d 323 Y -20 15 d cl s 1 1 1 c 1633
- 1406 m 23 6 d -20 15 d -23 -6 d f black 1633 1406 m 23 6 d -20 15 d -23 -6 d
- cl s 1 1 1 c 1609 1077 m 24 6 d 175 Y -24 -6 d f black 1609 1077 m 24 6 d 175 Y
- -24 -6 d cl s 0.6 0.6 0.6 c 1589 1093 m 20 -16 d 175 Y -20 16 d f black 1589
- 1093 m 20 -16 d 175 Y -20 16 d cl s 1 1 1 c 1609 1252 m 24 6 d -20 16 d -24 -6
- d f black 1609 1252 m 24 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1586 1071 m 23 6 d
- 296 Y -23 -6 d f black 1586 1071 m 23 6 d 296 Y -23 -6 d cl s 0.6 0.6 0.6 c
- 1566 1087 m 20 -16 d 296 Y -20 15 d f black 1566 1087 m 20 -16 d 296 Y -20 15 d
- cl s 1 1 1 c 1586 1367 m 23 6 d -20 15 d -23 -6 d f black 1586 1367 m 23 6 d
- -20 15 d -23 -6 d cl s 1 1 1 c 1562 1065 m 24 6 d 242 Y -24 -6 d f black 1562
- 1065 m 24 6 d 242 Y -24 -6 d cl s 0.6 0.6 0.6 c 1542 1081 m 20 -16 d 242 Y -20
- 16 d f black 1542 1081 m 20 -16 d 242 Y -20 16 d cl s 1 1 1 c 1562 1307 m 24 6
- d -20 16 d -24 -6 d f black 1562 1307 m 24 6 d -20 16 d -24 -6 d cl s 1 1 1 c
- 1539 1059 m 23 6 d 202 Y -23 -6 d f black 1539 1059 m 23 6 d 202 Y -23 -6 d
- cl s 0.6 0.6 0.6 c 1519 1075 m 20 -16 d 202 Y -20 15 d f black 1519 1075 m 20
- -16 d 202 Y -20 15 d cl s 1 1 1 c 1539 1261 m 23 6 d -20 15 d -23 -6 d f black
- 1539 1261 m 23 6 d -20 15 d -23 -6 d cl s 1 1 1 c 1515 1053 m 24 6 d 202 Y -24
- -6 d f black 1515 1053 m 24 6 d 202 Y -24 -6 d cl s 0.6 0.6 0.6 c 1495 1069 m
- 20 -16 d 202 Y -20 15 d f black 1495 1069 m 20 -16 d 202 Y -20 15 d cl s 1 1 1
- c 1515 1255 m 24 6 d -20 15 d -24 -6 d f black 1515 1255 m 24 6 d -20 15 d -24
- -6 d cl s 1 1 1 c 1492 1047 m 23 6 d 336 Y -23 -6 d f black 1492 1047 m 23 6 d
- 336 Y -23 -6 d cl s 0.6 0.6 0.6 c 1472 1063 m 20 -16 d 336 Y -20 16 d f black
- 1472 1063 m 20 -16 d 336 Y -20 16 d cl s 1 1 1 c 1492 1383 m 23 6 d -20 16 d
- -23 -6 d f black 1492 1383 m 23 6 d -20 16 d -23 -6 d cl s 1 1 1 c 1468 1041 m
- 24 6 d 309 Y -24 -6 d f black 1468 1041 m 24 6 d 309 Y -24 -6 d cl s 0.6 0.6
- 0.6 c 1448 1057 m 20 -16 d 309 Y -20 16 d f black 1448 1057 m 20 -16 d 309 Y
- -20 16 d cl s 1 1 1 c 1468 1350 m 24 6 d -20 16 d -24 -6 d f black 1468 1350 m
- 24 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1445 1035 m 23 6 d 350 Y -23 -6 d f black
- 1445 1035 m 23 6 d 350 Y -23 -6 d cl s 0.6 0.6 0.6 c 1425 1051 m 20 -16 d 350 Y
- -20 15 d f black 1425 1051 m 20 -16 d 350 Y -20 15 d cl s 1 1 1 c 1445 1385 m
- 23 6 d -20 15 d -23 -6 d f black 1445 1385 m 23 6 d -20 15 d -23 -6 d cl s 1 1
- 1 c 1421 1029 m 24 6 d 256 Y -24 -6 d f black 1421 1029 m 24 6 d 256 Y -24 -6 d
- cl s 0.6 0.6 0.6 c 1401 1045 m 20 -16 d 256 Y -20 15 d f black 1401 1045 m 20
- -16 d 256 Y -20 15 d cl s 1 1 1 c 1421 1285 m 24 6 d -20 15 d -24 -6 d f black
- 1421 1285 m 24 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1398 1024 m 23 5 d 350 Y -23
- -6 d f black 1398 1024 m 23 5 d 350 Y -23 -6 d cl s 0.6 0.6 0.6 c 1378 1039 m
- 20 -15 d 349 Y -20 15 d f black 1378 1039 m 20 -15 d 349 Y -20 15 d cl s 1 1 1
- c 1398 1373 m 23 6 d -20 15 d -23 -6 d f black 1398 1373 m 23 6 d -20 15 d -23
- -6 d cl s 1 1 1 c 1374 1018 m 24 6 d 295 Y -24 -6 d f black 1374 1018 m 24 6 d
- 295 Y -24 -6 d cl s 0.6 0.6 0.6 c 1354 1033 m 20 -15 d 295 Y -20 16 d f black
- 1354 1033 m 20 -15 d 295 Y -20 16 d cl s 1 1 1 c 1374 1313 m 24 6 d -20 16 d
- -24 -6 d f black 1374 1313 m 24 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1351 1012 m
- 23 6 d 241 Y -23 -6 d f black 1351 1012 m 23 6 d 241 Y -23 -6 d cl s 0.6 0.6
- 0.6 c 1331 1027 m 20 -15 d 241 Y -20 16 d f black 1331 1027 m 20 -15 d 241 Y
- -20 16 d cl s 1 1 1 c 1351 1253 m 23 6 d -20 16 d -23 -6 d f black 1351 1253 m
- 23 6 d -20 16 d -23 -6 d cl s 1 1 1 c 1328 1006 m 23 6 d 349 Y -23 -6 d f black
- 1328 1006 m 23 6 d 349 Y -23 -6 d cl s 0.6 0.6 0.6 c 1307 1021 m 21 -15 d 349 Y
- -21 15 d f black 1307 1021 m 21 -15 d 349 Y -21 15 d cl s 1 1 1 c 1328 1355 m
- 23 6 d -20 15 d -24 -6 d f black 1328 1355 m 23 6 d -20 15 d -24 -6 d cl s 1 1
- 1 c 1304 1000 m 24 6 d 241 Y -24 -6 d f black 1304 1000 m 24 6 d 241 Y -24 -6 d
- cl s 0.6 0.6 0.6 c 1284 1015 m 20 -15 d 241 Y -20 16 d f black 1284 1015 m 20
- -15 d 241 Y -20 16 d cl s 1 1 1 c 1304 1241 m 24 6 d -21 16 d -23 -6 d f black
- 1304 1241 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 1281 994 m 23 6 d 295 Y -23
- -6 d f black 1281 994 m 23 6 d 295 Y -23 -6 d cl s 0.6 0.6 0.6 c 1260 1009 m 21
- -15 d 295 Y -21 16 d f black 1260 1009 m 21 -15 d 295 Y -21 16 d cl s 1 1 1 c
- 1281 1289 m 23 6 d -20 16 d -24 -6 d f black 1281 1289 m 23 6 d -20 16 d -24 -6
- d cl s 1 1 1 c 1257 988 m 24 6 d 255 Y -24 -6 d f black 1257 988 m 24 6 d 255 Y
- -24 -6 d cl s 0.6 0.6 0.6 c 1237 1003 m 20 -15 d 255 Y -20 15 d f black 1237
- 1003 m 20 -15 d 255 Y -20 15 d cl s 1 1 1 c 1257 1243 m 24 6 d -21 15 d -23 -6
- d f black 1257 1243 m 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 1234 982 m 23 6 d
- 255 Y -23 -6 d f black 1234 982 m 23 6 d 255 Y -23 -6 d cl s 0.6 0.6 0.6 c 1213
- 997 m 21 -15 d 255 Y -21 15 d f black 1213 997 m 21 -15 d 255 Y -21 15 d cl s 1
- 1 1 c 1234 1237 m 23 6 d -20 15 d -24 -6 d f black 1234 1237 m 23 6 d -20 15 d
- -24 -6 d cl s 1 1 1 c 1210 976 m 24 6 d 443 Y -24 -6 d f black 1210 976 m 24 6
- d 443 Y -24 -6 d cl s 0.6 0.6 0.6 c 1190 991 m 20 -15 d 443 Y -20 16 d f black
- 1190 991 m 20 -15 d 443 Y -20 16 d cl s 1 1 1 c 1210 1419 m 24 6 d -21 16 d -23
- -6 d f black 1210 1419 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 1187 970 m 23 6
- d 309 Y -23 -6 d f black 1187 970 m 23 6 d 309 Y -23 -6 d cl s 0.6 0.6 0.6 c
- 1166 985 m 21 -15 d 309 Y -21 15 d f black 1166 985 m 21 -15 d 309 Y -21 15 d
- cl s 1 1 1 c 1187 1279 m 23 6 d -20 15 d -24 -6 d f black 1187 1279 m 23 6 d
- -20 15 d -24 -6 d cl s 1 1 1 c 1163 964 m 24 6 d 268 Y -24 -6 d f black 1163
- 964 m 24 6 d 268 Y -24 -6 d cl s 0.6 0.6 0.6 c 1143 979 m 20 -15 d 268 Y -20 16
- d f black 1143 979 m 20 -15 d 268 Y -20 16 d cl s 1 1 1 c 1163 1232 m 24 6 d
- -21 16 d -23 -6 d f black 1163 1232 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c
- 1140 958 m 23 6 d 242 Y -23 -6 d f black 1140 958 m 23 6 d 242 Y -23 -6 d cl s
- 0.6 0.6 0.6 c 1119 973 m 21 -15 d 242 Y -21 15 d f black 1119 973 m 21 -15 d
- 242 Y -21 15 d cl s 1 1 1 c 1140 1200 m 23 6 d -20 15 d -24 -6 d f black 1140
- 1200 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1116 952 m 24 6 d 268 Y -24 -6 d f
- black 1116 952 m 24 6 d 268 Y -24 -6 d cl s 0.6 0.6 0.6 c 1096 967 m 20 -15 d
- 268 Y -20 16 d f black 1096 967 m 20 -15 d 268 Y -20 16 d cl s 1 1 1 c 1116
- 1220 m 24 6 d -21 16 d -23 -6 d f black 1116 1220 m 24 6 d -21 16 d -23 -6 d
- cl s 1 1 1 c 1093 946 m 23 6 d 188 Y -23 -6 d f black 1093 946 m 23 6 d 188 Y
- -23 -6 d cl s 0.6 0.6 0.6 c 1072 961 m 21 -15 d 188 Y -21 15 d f black 1072 961
- m 21 -15 d 188 Y -21 15 d cl s 1 1 1 c 1093 1134 m 23 6 d -20 15 d -24 -6 d f
- black 1093 1134 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1069 940 m 24 6 d 336 Y
- -24 -6 d f black 1069 940 m 24 6 d 336 Y -24 -6 d cl s 0.6 0.6 0.6 c 1049 955 m
- 20 -15 d 336 Y -20 15 d f black 1049 955 m 20 -15 d 336 Y -20 15 d cl s 1 1 1 c
- 1069 1276 m 24 6 d -21 15 d -23 -6 d f black 1069 1276 m 24 6 d -21 15 d -23 -6
- d cl s 1 1 1 c 1046 934 m 23 6 d 416 Y -23 -6 d f black 1046 934 m 23 6 d 416 Y
- -23 -6 d cl s 0.6 0.6 0.6 c 1025 949 m 21 -15 d 416 Y -21 16 d f black 1025 949
- m 21 -15 d 416 Y -21 16 d cl s 1 1 1 c 1046 1350 m 23 6 d -20 16 d -24 -6 d f
- black 1046 1350 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1022 928 m 24 6 d 295 Y
- -24 -6 d f black 1022 928 m 24 6 d 295 Y -24 -6 d cl s 0.6 0.6 0.6 c 1002 943 m
- 20 -15 d 295 Y -20 16 d f black 1002 943 m 20 -15 d 295 Y -20 16 d cl s 1 1 1 c
- 1022 1223 m 24 6 d -21 16 d -23 -6 d f black 1022 1223 m 24 6 d -21 16 d -23 -6
- d cl s 1 1 1 c 999 922 m 23 6 d 269 Y -23 -6 d f black 999 922 m 23 6 d 269 Y
- -23 -6 d cl s 0.6 0.6 0.6 c 978 937 m 21 -15 d 269 Y -21 15 d f black 978 937 m
- 21 -15 d 269 Y -21 15 d cl s 1 1 1 c 999 1191 m 23 6 d -20 15 d -24 -6 d f
- black 999 1191 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 975 916 m 24 6 d 295 Y
- -24 -6 d f black 975 916 m 24 6 d 295 Y -24 -6 d cl s 0.6 0.6 0.6 c 955 931 m
- 20 -15 d 295 Y -20 16 d f black 955 931 m 20 -15 d 295 Y -20 16 d cl s 1 1 1 c
- 975 1211 m 24 6 d -21 16 d -23 -6 d f black 975 1211 m 24 6 d -21 16 d -23 -6 d
- cl s 1 1 1 c 952 910 m 23 6 d 228 Y -23 -6 d f black 952 910 m 23 6 d 228 Y -23
- -6 d cl s 0.6 0.6 0.6 c 931 925 m 21 -15 d 228 Y -21 16 d f black 931 925 m 21
- -15 d 228 Y -21 16 d cl s 1 1 1 c 952 1138 m 23 6 d -20 16 d -24 -6 d f black
- 952 1138 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 928 904 m 24 6 d 269 Y -24 -6
- d f black 928 904 m 24 6 d 269 Y -24 -6 d cl s 0.6 0.6 0.6 c 908 919 m 20 -15 d
- 269 Y -20 15 d f black 908 919 m 20 -15 d 269 Y -20 15 d cl s 1 1 1 c 928 1173
- m 24 6 d -21 15 d -23 -6 d f black 928 1173 m 24 6 d -21 15 d -23 -6 d cl s 1 1
- 1 c 905 898 m 23 6 d 336 Y -23 -6 d f black 905 898 m 23 6 d 336 Y -23 -6 d
- cl s 0.6 0.6 0.6 c 884 913 m 21 -15 d 336 Y -21 15 d f black 884 913 m 21 -15 d
- 336 Y -21 15 d cl s 1 1 1 c 905 1234 m 23 6 d -20 15 d -24 -6 d f black 905
- 1234 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 881 892 m 24 6 d 269 Y -24 -6 d f
- black 881 892 m 24 6 d 269 Y -24 -6 d cl s 0.6 0.6 0.6 c 861 907 m 20 -15 d 269
- Y -20 15 d f black 861 907 m 20 -15 d 269 Y -20 15 d cl s 1 1 1 c 881 1161 m 24
- 6 d -21 15 d -23 -6 d f black 881 1161 m 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c
- 858 886 m 23 6 d 296 Y -23 -6 d f black 858 886 m 23 6 d 296 Y -23 -6 d cl s
- 0.6 0.6 0.6 c 837 902 m 21 -16 d 296 Y -21 15 d f black 837 902 m 21 -16 d 296
- Y -21 15 d cl s 1 1 1 c 858 1182 m 23 6 d -20 15 d -24 -6 d f black 858 1182 m
- 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 834 880 m 24 6 d 175 Y -24 -6 d f black
- 834 880 m 24 6 d 175 Y -24 -6 d cl s 0.6 0.6 0.6 c 814 896 m 20 -16 d 175 Y -20
- 15 d f black 814 896 m 20 -16 d 175 Y -20 15 d cl s 1 1 1 c 834 1055 m 24 6 d
- -21 15 d -23 -6 d f black 834 1055 m 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 811
- 874 m 23 6 d 228 Y -23 -6 d f black 811 874 m 23 6 d 228 Y -23 -6 d cl s 0.6
- 0.6 0.6 c 790 890 m 21 -16 d 228 Y -21 16 d f black 790 890 m 21 -16 d 228 Y
- -21 16 d cl s 1 1 1 c 811 1102 m 23 6 d -20 16 d -24 -6 d f black 811 1102 m 23
- 6 d -20 16 d -24 -6 d cl s 1 1 1 c 787 868 m 24 6 d 309 Y -24 -6 d f black 787
- 868 m 24 6 d 309 Y -24 -6 d cl s 0.6 0.6 0.6 c 767 884 m 20 -16 d 309 Y -20 16
- d f black 767 884 m 20 -16 d 309 Y -20 16 d cl s 1 1 1 c 787 1177 m 24 6 d -21
- 16 d -23 -6 d f black 787 1177 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 764 862
- m 23 6 d 363 Y -23 -6 d f black 764 862 m 23 6 d 363 Y -23 -6 d cl s 0.6 0.6
- 0.6 c 743 878 m 21 -16 d 363 Y -21 15 d f black 743 878 m 21 -16 d 363 Y -21 15
- d cl s 1 1 1 c 764 1225 m 23 6 d -20 15 d -24 -6 d f black 764 1225 m 23 6 d
- -20 15 d -24 -6 d cl s 1 1 1 c 740 856 m 24 6 d -21 16 d -23 -6 d f black 740
- 856 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 717 850 m 23 6 d -20 16 d -24 -6 d
- f black 717 850 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 693 844 m 24 6 d -21 16
- d -23 -6 d f black 693 844 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 670 838 m 23
- 6 d -20 16 d -24 -6 d f black 670 838 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c
- 1794 1104 m 24 6 d -21 15 d -23 -6 d f black 1794 1104 m 24 6 d -21 15 d -23 -6
- d cl s 1 1 1 c 1771 1098 m 23 6 d -20 15 d -24 -6 d f black 1771 1098 m 23 6 d
- -20 15 d -24 -6 d cl s 1 1 1 c 1747 1092 m 24 6 d -21 15 d -23 -6 d f black
- 1747 1092 m 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 1724 1086 m 23 6 d -20 15 d
- -24 -6 d f black 1724 1086 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1700 1080 m
- 24 6 d 201 Y -24 -6 d f black 1700 1080 m 24 6 d 201 Y -24 -6 d cl s 0.6 0.6
- 0.6 c 1680 1095 m 20 -15 d 201 Y -20 16 d f black 1680 1095 m 20 -15 d 201 Y
- -20 16 d cl s 1 1 1 c 1700 1281 m 24 6 d -21 16 d -23 -6 d f black 1700 1281 m
- 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 1677 1074 m 23 6 d 188 Y -23 -6 d f black
- 1677 1074 m 23 6 d 188 Y -23 -6 d cl s 0.6 0.6 0.6 c 1656 1089 m 21 -15 d 188 Y
- -21 15 d f black 1656 1089 m 21 -15 d 188 Y -21 15 d cl s 1 1 1 c 1677 1262 m
- 23 6 d -20 15 d -24 -6 d f black 1677 1262 m 23 6 d -20 15 d -24 -6 d cl s 1 1
- 1 c 1653 1068 m 24 6 d 228 Y -24 -6 d f black 1653 1068 m 24 6 d 228 Y -24 -6 d
- cl s 0.6 0.6 0.6 c 1633 1083 m 20 -15 d 228 Y -20 16 d f black 1633 1083 m 20
- -15 d 228 Y -20 16 d cl s 1 1 1 c 1653 1296 m 24 6 d -21 16 d -23 -6 d f black
- 1653 1296 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 1630 1062 m 23 6 d 188 Y -23
- -6 d f black 1630 1062 m 23 6 d 188 Y -23 -6 d cl s 0.6 0.6 0.6 c 1609 1077 m
- 21 -15 d 188 Y -21 15 d f black 1609 1077 m 21 -15 d 188 Y -21 15 d cl s 1 1 1
- c 1630 1250 m 23 6 d -20 15 d -24 -6 d f black 1630 1250 m 23 6 d -20 15 d -24
- -6 d cl s 1 1 1 c 1606 1056 m 24 6 d 242 Y -24 -6 d f black 1606 1056 m 24 6 d
- 242 Y -24 -6 d cl s 0.6 0.6 0.6 c 1586 1071 m 20 -15 d 242 Y -20 15 d f black
- 1586 1071 m 20 -15 d 242 Y -20 15 d cl s 1 1 1 c 1606 1298 m 24 6 d -21 15 d
- -23 -6 d f black 1606 1298 m 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 1583 1050 m
- 23 6 d 295 Y -23 -6 d f black 1583 1050 m 23 6 d 295 Y -23 -6 d cl s 0.6 0.6
- 0.6 c 1562 1065 m 21 -15 d 295 Y -21 16 d f black 1562 1065 m 21 -15 d 295 Y
- -21 16 d cl s 1 1 1 c 1583 1345 m 23 6 d -20 16 d -24 -6 d f black 1583 1345 m
- 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1559 1044 m 24 6 d 282 Y -24 -6 d f black
- 1559 1044 m 24 6 d 282 Y -24 -6 d cl s 0.6 0.6 0.6 c 1539 1059 m 20 -15 d 282 Y
- -20 16 d f black 1539 1059 m 20 -15 d 282 Y -20 16 d cl s 1 1 1 c 1559 1326 m
- 24 6 d -21 16 d -23 -6 d f black 1559 1326 m 24 6 d -21 16 d -23 -6 d cl s 1 1
- 1 c 1536 1038 m 23 6 d 242 Y -23 -6 d f black 1536 1038 m 23 6 d 242 Y -23 -6 d
- cl s 0.6 0.6 0.6 c 1515 1053 m 21 -15 d 242 Y -21 15 d f black 1515 1053 m 21
- -15 d 242 Y -21 15 d cl s 1 1 1 c 1536 1280 m 23 6 d -20 15 d -24 -6 d f black
- 1536 1280 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1512 1032 m 24 6 d 175 Y -24
- -6 d f black 1512 1032 m 24 6 d 175 Y -24 -6 d cl s 0.6 0.6 0.6 c 1492 1047 m
- 20 -15 d 175 Y -20 15 d f black 1492 1047 m 20 -15 d 175 Y -20 15 d cl s 1 1 1
- c 1512 1207 m 24 6 d -21 15 d -23 -6 d f black 1512 1207 m 24 6 d -21 15 d -23
- -6 d cl s 1 1 1 c 1489 1026 m 23 6 d 161 Y -23 -6 d f black 1489 1026 m 23 6 d
- 161 Y -23 -6 d cl s 0.6 0.6 0.6 c 1468 1041 m 21 -15 d 161 Y -21 16 d f black
- 1468 1041 m 21 -15 d 161 Y -21 16 d cl s 1 1 1 c 1489 1187 m 23 6 d -20 16 d
- -24 -6 d f black 1489 1187 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1465 1020 m
- 24 6 d 215 Y -24 -6 d f black 1465 1020 m 24 6 d 215 Y -24 -6 d cl s 0.6 0.6
- 0.6 c 1445 1035 m 20 -15 d 215 Y -20 15 d f black 1445 1035 m 20 -15 d 215 Y
- -20 15 d cl s 1 1 1 c 1465 1235 m 24 6 d -21 15 d -23 -6 d f black 1465 1235 m
- 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 1442 1014 m 23 6 d 201 Y -23 -6 d f black
- 1442 1014 m 23 6 d 201 Y -23 -6 d cl s 0.6 0.6 0.6 c 1421 1029 m 21 -15 d 201 Y
- -21 16 d f black 1421 1029 m 21 -15 d 201 Y -21 16 d cl s 1 1 1 c 1442 1215 m
- 23 6 d -20 16 d -24 -6 d f black 1442 1215 m 23 6 d -20 16 d -24 -6 d cl s 1 1
- 1 c 1418 1008 m 24 6 d 228 Y -24 -6 d f black 1418 1008 m 24 6 d 228 Y -24 -6 d
- cl s 0.6 0.6 0.6 c 1398 1024 m 20 -16 d 228 Y -20 16 d f black 1398 1024 m 20
- -16 d 228 Y -20 16 d cl s 1 1 1 c 1418 1236 m 24 6 d -21 16 d -23 -6 d f black
- 1418 1236 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 1395 1002 m 23 6 d 202 Y -23
- -6 d f black 1395 1002 m 23 6 d 202 Y -23 -6 d cl s 0.6 0.6 0.6 c 1374 1018 m
- 21 -16 d 202 Y -21 15 d f black 1374 1018 m 21 -16 d 202 Y -21 15 d cl s 1 1 1
- c 1395 1204 m 23 6 d -20 15 d -24 -6 d f black 1395 1204 m 23 6 d -20 15 d -24
- -6 d cl s 1 1 1 c 1371 996 m 24 6 d 188 Y -24 -6 d f black 1371 996 m 24 6 d
- 188 Y -24 -6 d cl s 0.6 0.6 0.6 c 1351 1012 m 20 -16 d 188 Y -20 16 d f black
- 1351 1012 m 20 -16 d 188 Y -20 16 d cl s 1 1 1 c 1371 1184 m 24 6 d -21 16 d
- -23 -6 d f black 1371 1184 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 1348 990 m
- 23 6 d 228 Y -23 -6 d f black 1348 990 m 23 6 d 228 Y -23 -6 d cl s 0.6 0.6 0.6
- c 1328 1006 m 20 -16 d 228 Y -20 16 d f black 1328 1006 m 20 -16 d 228 Y -20 16
- d cl s 1 1 1 c 1348 1218 m 23 6 d -20 16 d -23 -6 d f black 1348 1218 m 23 6 d
- -20 16 d -23 -6 d cl s 1 1 1 c 1324 984 m 24 6 d 202 Y -24 -6 d f black 1324
- 984 m 24 6 d 202 Y -24 -6 d cl s 0.6 0.6 0.6 c 1304 1000 m 20 -16 d 202 Y -20
- 15 d f black 1304 1000 m 20 -16 d 202 Y -20 15 d cl s 1 1 1 c 1324 1186 m 24 6
- d -20 15 d -24 -6 d f black 1324 1186 m 24 6 d -20 15 d -24 -6 d cl s 1 1 1 c
- 1301 978 m 23 6 d 269 Y -23 -6 d f black 1301 978 m 23 6 d 269 Y -23 -6 d cl s
- 0.6 0.6 0.6 c 1281 994 m 20 -16 d 269 Y -20 15 d f black 1281 994 m 20 -16 d
- 269 Y -20 15 d cl s 1 1 1 c 1301 1247 m 23 6 d -20 15 d -23 -6 d f black 1301
- 1247 m 23 6 d -20 15 d -23 -6 d cl s 1 1 1 c 1277 972 m 24 6 d 202 Y -24 -6 d f
- black 1277 972 m 24 6 d 202 Y -24 -6 d cl s 0.6 0.6 0.6 c 1257 988 m 20 -16 d
- 202 Y -20 15 d f black 1257 988 m 20 -16 d 202 Y -20 15 d cl s 1 1 1 c 1277
- 1174 m 24 6 d -20 15 d -24 -6 d f black 1277 1174 m 24 6 d -20 15 d -24 -6 d
- cl s 1 1 1 c 1254 966 m 23 6 d 215 Y -23 -6 d f black 1254 966 m 23 6 d 215 Y
- -23 -6 d cl s 0.6 0.6 0.6 c 1234 982 m 20 -16 d 215 Y -20 16 d f black 1234 982
- m 20 -16 d 215 Y -20 16 d cl s 1 1 1 c 1254 1181 m 23 6 d -20 16 d -23 -6 d f
- black 1254 1181 m 23 6 d -20 16 d -23 -6 d cl s 1 1 1 c 1230 960 m 24 6 d 175 Y
- -24 -6 d f black 1230 960 m 24 6 d 175 Y -24 -6 d cl s 0.6 0.6 0.6 c 1210 976 m
- 20 -16 d 175 Y -20 15 d f black 1210 976 m 20 -16 d 175 Y -20 15 d cl s 1 1 1 c
- 1230 1135 m 24 6 d -20 15 d -24 -6 d f black 1230 1135 m 24 6 d -20 15 d -24 -6
- d cl s 1 1 1 c 1207 954 m 23 6 d 161 Y -23 -6 d f black 1207 954 m 23 6 d 161 Y
- -23 -6 d cl s 0.6 0.6 0.6 c 1187 970 m 20 -16 d 161 Y -20 16 d f black 1187 970
- m 20 -16 d 161 Y -20 16 d cl s 1 1 1 c 1207 1115 m 23 6 d -20 16 d -23 -6 d f
- black 1207 1115 m 23 6 d -20 16 d -23 -6 d cl s 1 1 1 c 1183 948 m 24 6 d 175 Y
- -24 -6 d f black 1183 948 m 24 6 d 175 Y -24 -6 d cl s 0.6 0.6 0.6 c 1163 964 m
- 20 -16 d 175 Y -20 15 d f black 1163 964 m 20 -16 d 175 Y -20 15 d cl s 1 1 1 c
- 1183 1123 m 24 6 d -20 15 d -24 -6 d f black 1183 1123 m 24 6 d -20 15 d -24 -6
- d cl s 1 1 1 c 1160 942 m 23 6 d 161 Y -23 -6 d f black 1160 942 m 23 6 d 161 Y
- -23 -6 d cl s 0.6 0.6 0.6 c 1140 958 m 20 -16 d 161 Y -20 16 d f black 1140 958
- m 20 -16 d 161 Y -20 16 d cl s 1 1 1 c 1160 1103 m 23 6 d -20 16 d -23 -6 d f
- black 1160 1103 m 23 6 d -20 16 d -23 -6 d cl s 1 1 1 c 1136 936 m 24 6 d 269 Y
- -24 -6 d f black 1136 936 m 24 6 d 269 Y -24 -6 d cl s 0.6 0.6 0.6 c 1116 952 m
- 20 -16 d 269 Y -20 15 d f black 1116 952 m 20 -16 d 269 Y -20 15 d cl s 1 1 1 c
- 1136 1205 m 24 6 d -20 15 d -24 -6 d f black 1136 1205 m 24 6 d -20 15 d -24 -6
- d cl s 1 1 1 c 1113 930 m 23 6 d 202 Y -23 -6 d f black 1113 930 m 23 6 d 202 Y
- -23 -6 d cl s 0.6 0.6 0.6 c 1093 946 m 20 -16 d 202 Y -20 15 d f black 1093 946
- m 20 -16 d 202 Y -20 15 d cl s 1 1 1 c 1113 1132 m 23 6 d -20 15 d -23 -6 d f
- black 1113 1132 m 23 6 d -20 15 d -23 -6 d cl s 1 1 1 c 1089 924 m 24 6 d 121 Y
- -24 -6 d f black 1089 924 m 24 6 d 121 Y -24 -6 d cl s 0.6 0.6 0.6 c 1069 940 m
- 20 -16 d 121 Y -20 16 d f black 1069 940 m 20 -16 d 121 Y -20 16 d cl s 1 1 1 c
- 1089 1045 m 24 6 d -20 16 d -24 -6 d f black 1089 1045 m 24 6 d -20 16 d -24 -6
- d cl s 1 1 1 c 1066 918 m 23 6 d 148 Y -23 -6 d f black 1066 918 m 23 6 d 148 Y
- -23 -6 d cl s 0.6 0.6 0.6 c 1046 934 m 20 -16 d 148 Y -20 16 d f black 1046 934
- m 20 -16 d 148 Y -20 16 d cl s 1 1 1 c 1066 1066 m 23 6 d -20 16 d -23 -6 d f
- black 1066 1066 m 23 6 d -20 16 d -23 -6 d cl s 1 1 1 c 1043 912 m 23 6 d 215 Y
- -23 -6 d f black 1043 912 m 23 6 d 215 Y -23 -6 d cl s 0.6 0.6 0.6 c 1022 928 m
- 21 -16 d 215 Y -21 16 d f black 1022 928 m 21 -16 d 215 Y -21 16 d cl s 1 1 1 c
- 1043 1127 m 23 6 d -20 16 d -24 -6 d f black 1043 1127 m 23 6 d -20 16 d -24 -6
- d cl s 1 1 1 c 1019 906 m 24 6 d 148 Y -24 -6 d f black 1019 906 m 24 6 d 148 Y
- -24 -6 d cl s 0.6 0.6 0.6 c 999 922 m 20 -16 d 148 Y -20 16 d f black 999 922 m
- 20 -16 d 148 Y -20 16 d cl s 1 1 1 c 1019 1054 m 24 6 d -21 16 d -23 -6 d f
- black 1019 1054 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 996 900 m 23 6 d 188 Y
- -23 -6 d f black 996 900 m 23 6 d 188 Y -23 -6 d cl s 0.6 0.6 0.6 c 975 916 m
- 21 -16 d 188 Y -21 16 d f black 975 916 m 21 -16 d 188 Y -21 16 d cl s 1 1 1 c
- 996 1088 m 23 6 d -20 16 d -24 -6 d f black 996 1088 m 23 6 d -20 16 d -24 -6 d
- cl s 1 1 1 c 972 894 m 24 6 d 202 Y -24 -6 d f black 972 894 m 24 6 d 202 Y -24
- -6 d cl s 0.6 0.6 0.6 c 952 910 m 20 -16 d 202 Y -20 15 d f black 952 910 m 20
- -16 d 202 Y -20 15 d cl s 1 1 1 c 972 1096 m 24 6 d -21 15 d -23 -6 d f black
- 972 1096 m 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 949 888 m 23 6 d 256 Y -23 -6
- d f black 949 888 m 23 6 d 256 Y -23 -6 d cl s 0.6 0.6 0.6 c 928 904 m 21 -16 d
- 256 Y -21 15 d f black 928 904 m 21 -16 d 256 Y -21 15 d cl s 1 1 1 c 949 1144
- m 23 6 d -20 15 d -24 -6 d f black 949 1144 m 23 6 d -20 15 d -24 -6 d cl s 1 1
- 1 c 925 882 m 24 6 d 135 Y -24 -6 d f black 925 882 m 24 6 d 135 Y -24 -6 d
- cl s 0.6 0.6 0.6 c 905 898 m 20 -16 d 135 Y -20 15 d f black 905 898 m 20 -16 d
- 135 Y -20 15 d cl s 1 1 1 c 925 1017 m 24 6 d -21 15 d -23 -6 d f black 925
- 1017 m 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 902 876 m 23 6 d 256 Y -23 -6 d f
- black 902 876 m 23 6 d 256 Y -23 -6 d cl s 0.6 0.6 0.6 c 881 892 m 21 -16 d 256
- Y -21 15 d f black 881 892 m 21 -16 d 256 Y -21 15 d cl s 1 1 1 c 902 1132 m 23
- 6 d -20 15 d -24 -6 d f black 902 1132 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c
- 878 870 m 24 6 d 189 Y -24 -6 d f black 878 870 m 24 6 d 189 Y -24 -6 d cl s
- 0.6 0.6 0.6 c 858 886 m 20 -16 d 189 Y -20 15 d f black 858 886 m 20 -16 d 189
- Y -20 15 d cl s 1 1 1 c 878 1059 m 24 6 d -21 15 d -23 -6 d f black 878 1059 m
- 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 855 864 m 23 6 d 242 Y -23 -6 d f black
- 855 864 m 23 6 d 242 Y -23 -6 d cl s 0.6 0.6 0.6 c 834 880 m 21 -16 d 242 Y -21
- 16 d f black 834 880 m 21 -16 d 242 Y -21 16 d cl s 1 1 1 c 855 1106 m 23 6 d
- -20 16 d -24 -6 d f black 855 1106 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 831
- 858 m 24 6 d 148 Y -24 -6 d f black 831 858 m 24 6 d 148 Y -24 -6 d cl s 0.6
- 0.6 0.6 c 811 874 m 20 -16 d 148 Y -20 16 d f black 811 874 m 20 -16 d 148 Y
- -20 16 d cl s 1 1 1 c 831 1006 m 24 6 d -21 16 d -23 -6 d f black 831 1006 m 24
- 6 d -21 16 d -23 -6 d cl s 1 1 1 c 808 853 m 23 5 d 202 Y -23 -6 d f black 808
- 853 m 23 5 d 202 Y -23 -6 d cl s 0.6 0.6 0.6 c 787 868 m 21 -15 d 201 Y -21 16
- d f black 787 868 m 21 -15 d 201 Y -21 16 d cl s 1 1 1 c 808 1054 m 23 6 d -20
- 16 d -24 -6 d f black 808 1054 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 784 847
- m 24 6 d 268 Y -24 -6 d f black 784 847 m 24 6 d 268 Y -24 -6 d cl s 0.6 0.6
- 0.6 c 764 862 m 20 -15 d 268 Y -20 16 d f black 764 862 m 20 -15 d 268 Y -20 16
- d cl s 1 1 1 c 784 1115 m 24 6 d -21 16 d -23 -6 d f black 784 1115 m 24 6 d
- -21 16 d -23 -6 d cl s 1 1 1 c 761 841 m 23 6 d -20 15 d -24 -6 d f black 761
- 841 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 737 835 m 24 6 d -21 15 d -23 -6 d
- f black 737 835 m 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 714 829 m 23 6 d -20 15
- d -24 -6 d f black 714 829 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 690 823 m 24
- 6 d -21 15 d -23 -6 d f black 690 823 m 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c
- 1814 1088 m 24 6 d -20 16 d -24 -6 d f black 1814 1088 m 24 6 d -20 16 d -24 -6
- d cl s 1 1 1 c 1791 1082 m 23 6 d -20 16 d -23 -6 d f black 1791 1082 m 23 6 d
- -20 16 d -23 -6 d cl s 1 1 1 c 1768 1076 m 23 6 d -20 16 d -24 -6 d f black
- 1768 1076 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1744 1070 m 24 6 d -21 16 d
- -23 -6 d f black 1744 1070 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 1721 1064 m
- 23 6 d 148 Y -23 -6 d f black 1721 1064 m 23 6 d 148 Y -23 -6 d cl s 0.6 0.6
- 0.6 c 1700 1080 m 21 -16 d 148 Y -21 16 d f black 1700 1080 m 21 -16 d 148 Y
- -21 16 d cl s 1 1 1 c 1721 1212 m 23 6 d -20 16 d -24 -6 d f black 1721 1212 m
- 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1697 1058 m 24 6 d 121 Y -24 -6 d f black
- 1697 1058 m 24 6 d 121 Y -24 -6 d cl s 0.6 0.6 0.6 c 1677 1074 m 20 -16 d 121 Y
- -20 16 d f black 1677 1074 m 20 -16 d 121 Y -20 16 d cl s 1 1 1 c 1697 1179 m
- 24 6 d -21 16 d -23 -6 d f black 1697 1179 m 24 6 d -21 16 d -23 -6 d cl s 1 1
- 1 c 1674 1052 m 23 6 d 108 Y -23 -6 d f black 1674 1052 m 23 6 d 108 Y -23 -6 d
- cl s 0.6 0.6 0.6 c 1653 1068 m 21 -16 d 108 Y -21 15 d f black 1653 1068 m 21
- -16 d 108 Y -21 15 d cl s 1 1 1 c 1674 1160 m 23 6 d -20 15 d -24 -6 d f black
- 1674 1160 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1650 1046 m 24 6 d 108 Y -24
- -6 d f black 1650 1046 m 24 6 d 108 Y -24 -6 d cl s 0.6 0.6 0.6 c 1630 1062 m
- 20 -16 d 108 Y -20 15 d f black 1630 1062 m 20 -16 d 108 Y -20 15 d cl s 1 1 1
- c 1650 1154 m 24 6 d -21 15 d -23 -6 d f black 1650 1154 m 24 6 d -21 15 d -23
- -6 d cl s 1 1 1 c 1627 1040 m 23 6 d 161 Y -23 -5 d f black 1627 1040 m 23 6 d
- 161 Y -23 -5 d cl s 0.6 0.6 0.6 c 1606 1056 m 21 -16 d 162 Y -21 15 d f black
- 1606 1056 m 21 -16 d 162 Y -21 15 d cl s 1 1 1 c 1627 1202 m 23 5 d -20 16 d
- -24 -6 d f black 1627 1202 m 23 5 d -20 16 d -24 -6 d cl s 1 1 1 c 1603 1034 m
- 24 6 d 202 Y -24 -6 d f black 1603 1034 m 24 6 d 202 Y -24 -6 d cl s 0.6 0.6
- 0.6 c 1583 1050 m 20 -16 d 202 Y -20 15 d f black 1583 1050 m 20 -16 d 202 Y
- -20 15 d cl s 1 1 1 c 1603 1236 m 24 6 d -21 15 d -23 -6 d f black 1603 1236 m
- 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 1580 1028 m 23 6 d 94 Y -23 -6 d f black
- 1580 1028 m 23 6 d 94 Y -23 -6 d cl s 0.6 0.6 0.6 c 1559 1044 m 21 -16 d 94 Y
- -21 16 d f black 1559 1044 m 21 -16 d 94 Y -21 16 d cl s 1 1 1 c 1580 1122 m 23
- 6 d -20 16 d -24 -6 d f black 1580 1122 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c
- 1556 1022 m 24 6 d 148 Y -24 -6 d f black 1556 1022 m 24 6 d 148 Y -24 -6 d
- cl s 0.6 0.6 0.6 c 1536 1038 m 20 -16 d 148 Y -20 16 d f black 1536 1038 m 20
- -16 d 148 Y -20 16 d cl s 1 1 1 c 1556 1170 m 24 6 d -21 16 d -23 -6 d f black
- 1556 1170 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 1533 1016 m 23 6 d 135 Y -23
- -6 d f black 1533 1016 m 23 6 d 135 Y -23 -6 d cl s 0.6 0.6 0.6 c 1512 1032 m
- 21 -16 d 135 Y -21 15 d f black 1512 1032 m 21 -16 d 135 Y -21 15 d cl s 1 1 1
- c 1533 1151 m 23 6 d -20 15 d -24 -6 d f black 1533 1151 m 23 6 d -20 15 d -24
- -6 d cl s 1 1 1 c 1509 1010 m 24 6 d 108 Y -24 -6 d f black 1509 1010 m 24 6 d
- 108 Y -24 -6 d cl s 0.6 0.6 0.6 c 1489 1026 m 20 -16 d 108 Y -20 15 d f black
- 1489 1026 m 20 -16 d 108 Y -20 15 d cl s 1 1 1 c 1509 1118 m 24 6 d -21 15 d
- -23 -6 d f black 1509 1118 m 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 1486 1004 m
- 23 6 d 121 Y -23 -6 d f black 1486 1004 m 23 6 d 121 Y -23 -6 d cl s 0.6 0.6
- 0.6 c 1465 1020 m 21 -16 d 121 Y -21 16 d f black 1465 1020 m 21 -16 d 121 Y
- -21 16 d cl s 1 1 1 c 1486 1125 m 23 6 d -20 16 d -24 -6 d f black 1486 1125 m
- 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1462 998 m 24 6 d 148 Y -24 -6 d f black
- 1462 998 m 24 6 d 148 Y -24 -6 d cl s 0.6 0.6 0.6 c 1442 1014 m 20 -16 d 148 Y
- -20 16 d f black 1442 1014 m 20 -16 d 148 Y -20 16 d cl s 1 1 1 c 1462 1146 m
- 24 6 d -21 16 d -23 -6 d f black 1462 1146 m 24 6 d -21 16 d -23 -6 d cl s 1 1
- 1 c 1439 992 m 23 6 d 54 Y -23 -6 d f black 1439 992 m 23 6 d 54 Y -23 -6 d
- cl s 0.6 0.6 0.6 c 1418 1008 m 21 -16 d 54 Y -21 16 d f black 1418 1008 m 21
- -16 d 54 Y -21 16 d cl s 1 1 1 c 1439 1046 m 23 6 d -20 16 d -24 -6 d f black
- 1439 1046 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1415 986 m 24 6 d 81 Y -24 -6
- d f black 1415 986 m 24 6 d 81 Y -24 -6 d cl s 0.6 0.6 0.6 c 1395 1002 m 20 -16
- d 81 Y -20 16 d f black 1395 1002 m 20 -16 d 81 Y -20 16 d cl s 1 1 1 c 1415
- 1067 m 24 6 d -21 16 d -23 -6 d f black 1415 1067 m 24 6 d -21 16 d -23 -6 d
- cl s 1 1 1 c 1392 980 m 23 6 d 108 Y -23 -6 d f black 1392 980 m 23 6 d 108 Y
- -23 -6 d cl s 0.6 0.6 0.6 c 1371 996 m 21 -16 d 108 Y -21 16 d f black 1371 996
- m 21 -16 d 108 Y -21 16 d cl s 1 1 1 c 1392 1088 m 23 6 d -20 15 d -24 -5 d f
- black 1392 1088 m 23 6 d -20 15 d -24 -5 d cl s 1 1 1 c 1368 975 m 24 5 d 54 Y
- -24 -6 d f black 1368 975 m 24 5 d 54 Y -24 -6 d cl s 0.6 0.6 0.6 c 1348 990 m
- 20 -15 d 53 Y -20 16 d f black 1348 990 m 20 -15 d 53 Y -20 16 d cl s 1 1 1 c
- 1368 1028 m 24 6 d -21 16 d -23 -6 d f black 1368 1028 m 24 6 d -21 16 d -23 -6
- d cl s 1 1 1 c 1345 969 m 23 6 d 94 Y -23 -6 d f black 1345 969 m 23 6 d 94 Y
- -23 -6 d cl s 0.6 0.6 0.6 c 1324 984 m 21 -15 d 94 Y -21 15 d f black 1324 984
- m 21 -15 d 94 Y -21 15 d cl s 1 1 1 c 1345 1063 m 23 6 d -20 15 d -24 -6 d f
- black 1345 1063 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1321 963 m 24 6 d 94 Y
- -24 -6 d f black 1321 963 m 24 6 d 94 Y -24 -6 d cl s 0.6 0.6 0.6 c 1301 978 m
- 20 -15 d 94 Y -20 15 d f black 1301 978 m 20 -15 d 94 Y -20 15 d cl s 1 1 1 c
- 1321 1057 m 24 6 d -21 15 d -23 -6 d f black 1321 1057 m 24 6 d -21 15 d -23 -6
- d cl s 1 1 1 c 1298 957 m 23 6 d 134 Y -23 -6 d f black 1298 957 m 23 6 d 134 Y
- -23 -6 d cl s 0.6 0.6 0.6 c 1277 972 m 21 -15 d 134 Y -21 15 d f black 1277 972
- m 21 -15 d 134 Y -21 15 d cl s 1 1 1 c 1298 1091 m 23 6 d -20 15 d -24 -6 d f
- black 1298 1091 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1274 951 m 24 6 d 228 Y
- -24 -6 d f black 1274 951 m 24 6 d 228 Y -24 -6 d cl s 0.6 0.6 0.6 c 1254 966 m
- 20 -15 d 228 Y -20 16 d f black 1254 966 m 20 -15 d 228 Y -20 16 d cl s 1 1 1 c
- 1274 1179 m 24 6 d -21 16 d -23 -6 d f black 1274 1179 m 24 6 d -21 16 d -23 -6
- d cl s 1 1 1 c 1251 945 m 23 6 d 161 Y -23 -6 d f black 1251 945 m 23 6 d 161 Y
- -23 -6 d cl s 0.6 0.6 0.6 c 1230 960 m 21 -15 d 161 Y -21 15 d f black 1230 960
- m 21 -15 d 161 Y -21 15 d cl s 1 1 1 c 1251 1106 m 23 6 d -20 15 d -24 -6 d f
- black 1251 1106 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1227 939 m 24 6 d 94 Y
- -24 -6 d f black 1227 939 m 24 6 d 94 Y -24 -6 d cl s 0.6 0.6 0.6 c 1207 954 m
- 20 -15 d 94 Y -20 15 d f black 1207 954 m 20 -15 d 94 Y -20 15 d cl s 1 1 1 c
- 1227 1033 m 24 6 d -21 15 d -23 -6 d f black 1227 1033 m 24 6 d -21 15 d -23 -6
- d cl s 1 1 1 c 1204 933 m 23 6 d 94 Y -23 -6 d f black 1204 933 m 23 6 d 94 Y
- -23 -6 d cl s 0.6 0.6 0.6 c 1183 948 m 21 -15 d 94 Y -21 15 d f black 1183 948
- m 21 -15 d 94 Y -21 15 d cl s 1 1 1 c 1204 1027 m 23 6 d -20 15 d -24 -6 d f
- black 1204 1027 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1180 927 m 24 6 d 161 Y
- -24 -6 d f black 1180 927 m 24 6 d 161 Y -24 -6 d cl s 0.6 0.6 0.6 c 1160 942 m
- 20 -15 d 161 Y -20 15 d f black 1160 942 m 20 -15 d 161 Y -20 15 d cl s 1 1 1 c
- 1180 1088 m 24 6 d -21 15 d -23 -6 d f black 1180 1088 m 24 6 d -21 15 d -23 -6
- d cl s 1 1 1 c 1157 921 m 23 6 d 161 Y -23 -6 d f black 1157 921 m 23 6 d 161 Y
- -23 -6 d cl s 0.6 0.6 0.6 c 1136 936 m 21 -15 d 161 Y -21 15 d f black 1136 936
- m 21 -15 d 161 Y -21 15 d cl s 1 1 1 c 1157 1082 m 23 6 d -20 15 d -24 -6 d f
- black 1157 1082 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1133 915 m 24 6 d 174 Y
- -24 -6 d f black 1133 915 m 24 6 d 174 Y -24 -6 d cl s 0.6 0.6 0.6 c 1113 930 m
- 20 -15 d 174 Y -20 16 d f black 1113 930 m 20 -15 d 174 Y -20 16 d cl s 1 1 1 c
- 1133 1089 m 24 6 d -21 16 d -23 -6 d f black 1133 1089 m 24 6 d -21 16 d -23 -6
- d cl s 1 1 1 c 1110 909 m 23 6 d 134 Y -23 -6 d f black 1110 909 m 23 6 d 134 Y
- -23 -6 d cl s 0.6 0.6 0.6 c 1089 924 m 21 -15 d 134 Y -21 16 d f black 1089 924
- m 21 -15 d 134 Y -21 16 d cl s 1 1 1 c 1110 1043 m 23 6 d -20 16 d -24 -6 d f
- black 1110 1043 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1086 903 m 24 6 d 134 Y
- -24 -6 d f black 1086 903 m 24 6 d 134 Y -24 -6 d cl s 0.6 0.6 0.6 c 1066 918 m
- 20 -15 d 134 Y -20 16 d f black 1066 918 m 20 -15 d 134 Y -20 16 d cl s 1 1 1 c
- 1086 1037 m 24 6 d -21 16 d -23 -6 d f black 1086 1037 m 24 6 d -21 16 d -23 -6
- d cl s 1 1 1 c 1063 897 m 23 6 d 188 Y -23 -6 d f black 1063 897 m 23 6 d 188 Y
- -23 -6 d cl s 0.6 0.6 0.6 c 1043 912 m 20 -15 d 188 Y -20 15 d f black 1043 912
- m 20 -15 d 188 Y -20 15 d cl s 1 1 1 c 1063 1085 m 23 6 d -20 15 d -23 -6 d f
- black 1063 1085 m 23 6 d -20 15 d -23 -6 d cl s 1 1 1 c 1039 891 m 24 6 d 148 Y
- -24 -6 d f black 1039 891 m 24 6 d 148 Y -24 -6 d cl s 0.6 0.6 0.6 c 1019 906 m
- 20 -15 d 148 Y -20 15 d f black 1019 906 m 20 -15 d 148 Y -20 15 d cl s 1 1 1 c
- 1039 1039 m 24 6 d -20 15 d -24 -6 d f black 1039 1039 m 24 6 d -20 15 d -24 -6
- d cl s 1 1 1 c 1016 885 m 23 6 d 201 Y -23 -6 d f black 1016 885 m 23 6 d 201 Y
- -23 -6 d cl s 0.6 0.6 0.6 c 996 900 m 20 -15 d 201 Y -20 16 d f black 996 900 m
- 20 -15 d 201 Y -20 16 d cl s 1 1 1 c 1016 1086 m 23 6 d -20 16 d -23 -6 d f
- black 1016 1086 m 23 6 d -20 16 d -23 -6 d cl s 1 1 1 c 992 879 m 24 6 d 107 Y
- -24 -6 d f black 992 879 m 24 6 d 107 Y -24 -6 d cl s 0.6 0.6 0.6 c 972 894 m
- 20 -15 d 107 Y -20 16 d f black 972 894 m 20 -15 d 107 Y -20 16 d cl s 1 1 1 c
- 992 986 m 24 6 d -20 16 d -24 -6 d f black 992 986 m 24 6 d -20 16 d -24 -6 d
- cl s 1 1 1 c 969 873 m 23 6 d 107 Y -23 -6 d f black 969 873 m 23 6 d 107 Y -23
- -6 d cl s 0.6 0.6 0.6 c 949 888 m 20 -15 d 107 Y -20 16 d f black 949 888 m 20
- -15 d 107 Y -20 16 d cl s 1 1 1 c 969 980 m 23 6 d -20 16 d -23 -6 d f black
- 969 980 m 23 6 d -20 16 d -23 -6 d cl s 1 1 1 c 945 867 m 24 6 d 188 Y -24 -6 d
- f black 945 867 m 24 6 d 188 Y -24 -6 d cl s 0.6 0.6 0.6 c 925 882 m 20 -15 d
- 188 Y -20 16 d f black 925 882 m 20 -15 d 188 Y -20 16 d cl s 1 1 1 c 945 1055
- m 24 6 d -20 15 d -24 -5 d f black 945 1055 m 24 6 d -20 15 d -24 -5 d cl s 1 1
- 1 c 922 861 m 23 6 d 94 Y -23 -6 d f black 922 861 m 23 6 d 94 Y -23 -6 d cl s
- 0.6 0.6 0.6 c 902 876 m 20 -15 d 94 Y -20 15 d f black 902 876 m 20 -15 d 94 Y
- -20 15 d cl s 1 1 1 c 922 955 m 23 6 d -20 15 d -23 -6 d f black 922 955 m 23 6
- d -20 15 d -23 -6 d cl s 1 1 1 c 898 855 m 24 6 d 134 Y -24 -6 d f black 898
- 855 m 24 6 d 134 Y -24 -6 d cl s 0.6 0.6 0.6 c 878 870 m 20 -15 d 134 Y -20 16
- d f black 878 870 m 20 -15 d 134 Y -20 16 d cl s 1 1 1 c 898 989 m 24 6 d -20
- 16 d -24 -6 d f black 898 989 m 24 6 d -20 16 d -24 -6 d cl s 1 1 1 c 875 849 m
- 23 6 d 121 Y -23 -6 d f black 875 849 m 23 6 d 121 Y -23 -6 d cl s 0.6 0.6 0.6
- c 855 864 m 20 -15 d 121 Y -20 15 d f black 855 864 m 20 -15 d 121 Y -20 15 d
- cl s 1 1 1 c 875 970 m 23 6 d -20 15 d -23 -6 d f black 875 970 m 23 6 d -20 15
- d -23 -6 d cl s 1 1 1 c 851 843 m 24 6 d 94 Y -24 -6 d f black 851 843 m 24 6 d
- 94 Y -24 -6 d cl s 0.6 0.6 0.6 c 831 858 m 20 -15 d 94 Y -20 16 d f black 831
- 858 m 20 -15 d 94 Y -20 16 d cl s 1 1 1 c 851 937 m 24 6 d -20 16 d -24 -6 d f
- black 851 937 m 24 6 d -20 16 d -24 -6 d cl s 1 1 1 c 828 837 m 23 6 d 40 Y -23
- -6 d f black 828 837 m 23 6 d 40 Y -23 -6 d cl s 0.6 0.6 0.6 c 808 853 m 20 -16
- d 40 Y -20 16 d f black 808 853 m 20 -16 d 40 Y -20 16 d cl s 1 1 1 c 828 877 m
- 23 6 d -20 16 d -23 -6 d f black 828 877 m 23 6 d -20 16 d -23 -6 d cl s 1 1 1
- c 804 831 m 24 6 d 121 Y -24 -6 d f black 804 831 m 24 6 d 121 Y -24 -6 d cl s
- 0.6 0.6 0.6 c 784 847 m 20 -16 d 121 Y -20 15 d f black 784 847 m 20 -16 d 121
- Y -20 15 d cl s 1 1 1 c 804 952 m 24 6 d -20 15 d -24 -6 d f black 804 952 m 24
- 6 d -20 15 d -24 -6 d cl s 1 1 1 c 781 825 m 23 6 d -20 16 d -23 -6 d f black
- 781 825 m 23 6 d -20 16 d -23 -6 d cl s 1 1 1 c 757 819 m 24 6 d -20 16 d -24
- -6 d f black 757 819 m 24 6 d -20 16 d -24 -6 d cl s 1 1 1 c 734 813 m 23 6 d
- -20 16 d -23 -6 d f black 734 813 m 23 6 d -20 16 d -23 -6 d cl s 1 1 1 c 711
- 807 m 23 6 d -20 16 d -24 -6 d f black 711 807 m 23 6 d -20 16 d -24 -6 d cl s
- 1 1 1 c 1835 1073 m 23 6 d -20 15 d -24 -6 d f black 1835 1073 m 23 6 d -20 15
- d -24 -6 d cl s 1 1 1 c 1811 1067 m 24 6 d -21 15 d -23 -6 d f black 1811 1067
- m 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 1788 1061 m 23 6 d -20 15 d -23 -6 d f
- black 1788 1061 m 23 6 d -20 15 d -23 -6 d cl s 1 1 1 c 1764 1055 m 24 6 d -20
- 15 d -24 -6 d f black 1764 1055 m 24 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1741
- 1049 m 23 6 d 40 Y -23 -6 d f black 1741 1049 m 23 6 d 40 Y -23 -6 d cl s 0.6
- 0.6 0.6 c 1721 1064 m 20 -15 d 40 Y -20 16 d f black 1721 1064 m 20 -15 d 40 Y
- -20 16 d cl s 1 1 1 c 1741 1089 m 23 6 d -20 15 d -23 -5 d f black 1741 1089 m
- 23 6 d -20 15 d -23 -5 d cl s 1 1 1 c 1717 1043 m 24 6 d 53 Y -24 -6 d f black
- 1717 1043 m 24 6 d 53 Y -24 -6 d cl s 0.6 0.6 0.6 c 1697 1058 m 20 -15 d 53 Y
- -20 16 d f black 1697 1058 m 20 -15 d 53 Y -20 16 d cl s 1 1 1 c 1717 1096 m 24
- 6 d -20 16 d -24 -6 d f black 1717 1096 m 24 6 d -20 16 d -24 -6 d cl s 1 1 1 c
- 1694 1037 m 23 6 d 174 Y -23 -6 d f black 1694 1037 m 23 6 d 174 Y -23 -6 d
- cl s 0.6 0.6 0.6 c 1674 1052 m 20 -15 d 174 Y -20 16 d f black 1674 1052 m 20
- -15 d 174 Y -20 16 d cl s 1 1 1 c 1694 1211 m 23 6 d -20 16 d -23 -6 d f black
- 1694 1211 m 23 6 d -20 16 d -23 -6 d cl s 1 1 1 c 1670 1031 m 24 6 d 40 Y -24
- -6 d f black 1670 1031 m 24 6 d 40 Y -24 -6 d cl s 0.6 0.6 0.6 c 1650 1046 m 20
- -15 d 40 Y -20 16 d f black 1650 1046 m 20 -15 d 40 Y -20 16 d cl s 1 1 1 c
- 1670 1071 m 24 6 d -20 16 d -24 -6 d f black 1670 1071 m 24 6 d -20 16 d -24 -6
- d cl s 1 1 1 c 1647 1025 m 23 6 d 40 Y -23 -6 d f black 1647 1025 m 23 6 d 40 Y
- -23 -6 d cl s 0.6 0.6 0.6 c 1627 1040 m 20 -15 d 40 Y -20 16 d f black 1627
- 1040 m 20 -15 d 40 Y -20 16 d cl s 1 1 1 c 1647 1065 m 23 6 d -20 16 d -23 -6 d
- f black 1647 1065 m 23 6 d -20 16 d -23 -6 d cl s 1 1 1 c 1623 1019 m 24 6 d 67
- Y -24 -6 d f black 1623 1019 m 24 6 d 67 Y -24 -6 d cl s 0.6 0.6 0.6 c 1603
- 1034 m 20 -15 d 67 Y -20 15 d f black 1603 1034 m 20 -15 d 67 Y -20 15 d cl s 1
- 1 1 c 1623 1086 m 24 6 d -20 15 d -24 -6 d f black 1623 1086 m 24 6 d -20 15 d
- -24 -6 d cl s 1 1 1 c 1600 1013 m 23 6 d 80 Y -23 -6 d f black 1600 1013 m 23 6
- d 80 Y -23 -6 d cl s 0.6 0.6 0.6 c 1580 1028 m 20 -15 d 80 Y -20 16 d f black
- 1580 1028 m 20 -15 d 80 Y -20 16 d cl s 1 1 1 c 1600 1093 m 23 6 d -20 16 d -23
- -6 d f black 1600 1093 m 23 6 d -20 16 d -23 -6 d cl s 1 1 1 c 1576 1007 m 24 6
- d 40 Y -24 -6 d f black 1576 1007 m 24 6 d 40 Y -24 -6 d cl s 0.6 0.6 0.6 c
- 1556 1022 m 20 -15 d 40 Y -20 16 d f black 1556 1022 m 20 -15 d 40 Y -20 16 d
- cl s 1 1 1 c 1576 1047 m 24 6 d -20 16 d -24 -6 d f black 1576 1047 m 24 6 d
- -20 16 d -24 -6 d cl s 1 1 1 c 1553 1001 m 23 6 d 80 Y -23 -6 d f black 1553
- 1001 m 23 6 d 80 Y -23 -6 d cl s 0.6 0.6 0.6 c 1533 1016 m 20 -15 d 80 Y -20 16
- d f black 1533 1016 m 20 -15 d 80 Y -20 16 d cl s 1 1 1 c 1553 1081 m 23 6 d
- -20 16 d -23 -6 d f black 1553 1081 m 23 6 d -20 16 d -23 -6 d cl s 1 1 1 c
- 1529 995 m 24 6 d 94 Y -24 -6 d f black 1529 995 m 24 6 d 94 Y -24 -6 d cl s
- 0.6 0.6 0.6 c 1509 1010 m 20 -15 d 94 Y -20 15 d f black 1509 1010 m 20 -15 d
- 94 Y -20 15 d cl s 1 1 1 c 1529 1089 m 24 6 d -20 15 d -24 -6 d f black 1529
- 1089 m 24 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1506 989 m 23 6 d 27 Y -23 -6 d f
- black 1506 989 m 23 6 d 27 Y -23 -6 d cl s 0.6 0.6 0.6 c 1486 1004 m 20 -15 d
- 27 Y -20 15 d f black 1486 1004 m 20 -15 d 27 Y -20 15 d cl s 1 1 1 c 1506 1016
- m 23 6 d -20 15 d -23 -6 d f black 1506 1016 m 23 6 d -20 15 d -23 -6 d cl s 1
- 1 1 c 1483 983 m 23 6 d 13 Y -23 -6 d f black 1483 983 m 23 6 d 13 Y -23 -6 d
- cl s 0.6 0.6 0.6 c 1462 998 m 21 -15 d 13 Y -21 16 d f black 1462 998 m 21 -15
- d 13 Y -21 16 d cl s 1 1 1 c 1483 996 m 23 6 d -20 16 d -24 -6 d f black 1483
- 996 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1459 977 m 24 6 d 94 Y -24 -6 d f
- black 1459 977 m 24 6 d 94 Y -24 -6 d cl s 0.6 0.6 0.6 c 1439 992 m 20 -15 d 94
- Y -20 15 d f black 1439 992 m 20 -15 d 94 Y -20 15 d cl s 1 1 1 c 1459 1071 m
- 24 6 d -21 15 d -23 -6 d f black 1459 1071 m 24 6 d -21 15 d -23 -6 d cl s 1 1
- 1 c 1436 971 m 23 6 d 67 Y -23 -6 d f black 1436 971 m 23 6 d 67 Y -23 -6 d
- cl s 0.6 0.6 0.6 c 1415 986 m 21 -15 d 67 Y -21 16 d f black 1415 986 m 21 -15
- d 67 Y -21 16 d cl s 1 1 1 c 1436 1038 m 23 6 d -20 16 d -24 -6 d f black 1436
- 1038 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1412 965 m 24 6 d 121 Y -24 -6 d f
- black 1412 965 m 24 6 d 121 Y -24 -6 d cl s 0.6 0.6 0.6 c 1392 980 m 20 -15 d
- 121 Y -20 15 d f black 1392 980 m 20 -15 d 121 Y -20 15 d cl s 1 1 1 c 1412
- 1086 m 24 6 d -21 15 d -23 -6 d f black 1412 1086 m 24 6 d -21 15 d -23 -6 d
- cl s 1 1 1 c 1389 959 m 23 6 d 40 Y -23 -6 d f black 1389 959 m 23 6 d 40 Y -23
- -6 d cl s 0.6 0.6 0.6 c 1368 975 m 21 -16 d 40 Y -21 16 d f black 1368 975 m 21
- -16 d 40 Y -21 16 d cl s 1 1 1 c 1389 999 m 23 6 d -20 16 d -24 -6 d f black
- 1389 999 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1365 953 m 24 6 d 40 Y -24 -6
- d f black 1365 953 m 24 6 d 40 Y -24 -6 d cl s 0.6 0.6 0.6 c 1345 969 m 20 -16
- d 40 Y -20 16 d f black 1345 969 m 20 -16 d 40 Y -20 16 d cl s 1 1 1 c 1365 993
- m 24 6 d -21 16 d -23 -6 d f black 1365 993 m 24 6 d -21 16 d -23 -6 d cl s 1 1
- 1 c 1342 947 m 23 6 d 67 Y -23 -6 d f black 1342 947 m 23 6 d 67 Y -23 -6 d
- cl s 0.6 0.6 0.6 c 1321 963 m 21 -16 d 67 Y -21 16 d f black 1321 963 m 21 -16
- d 67 Y -21 16 d cl s 1 1 1 c 1342 1014 m 23 6 d -20 16 d -24 -6 d f black 1342
- 1014 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1318 941 m 24 6 d 107 Y -24 -5 d f
- black 1318 941 m 24 6 d 107 Y -24 -5 d cl s 0.6 0.6 0.6 c 1298 957 m 20 -16 d
- 108 Y -20 15 d f black 1298 957 m 20 -16 d 108 Y -20 15 d cl s 1 1 1 c 1318
- 1049 m 24 5 d -21 16 d -23 -6 d f black 1318 1049 m 24 5 d -21 16 d -23 -6 d
- cl s 1 1 1 c 1295 935 m 23 6 d 94 Y -23 -6 d f black 1295 935 m 23 6 d 94 Y -23
- -6 d cl s 0.6 0.6 0.6 c 1274 951 m 21 -16 d 94 Y -21 16 d f black 1274 951 m 21
- -16 d 94 Y -21 16 d cl s 1 1 1 c 1295 1029 m 23 6 d -20 16 d -24 -6 d f black
- 1295 1029 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1271 929 m 24 6 d 108 Y -24
- -6 d f black 1271 929 m 24 6 d 108 Y -24 -6 d cl s 0.6 0.6 0.6 c 1251 945 m 20
- -16 d 108 Y -20 15 d f black 1251 945 m 20 -16 d 108 Y -20 15 d cl s 1 1 1 c
- 1271 1037 m 24 6 d -21 15 d -23 -6 d f black 1271 1037 m 24 6 d -21 15 d -23 -6
- d cl s 1 1 1 c 1248 923 m 23 6 d 40 Y -23 -6 d f black 1248 923 m 23 6 d 40 Y
- -23 -6 d cl s 0.6 0.6 0.6 c 1227 939 m 21 -16 d 40 Y -21 16 d f black 1227 939
- m 21 -16 d 40 Y -21 16 d cl s 1 1 1 c 1248 963 m 23 6 d -20 16 d -24 -6 d f
- black 1248 963 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1224 917 m 24 6 d 94 Y
- -24 -6 d f black 1224 917 m 24 6 d 94 Y -24 -6 d cl s 0.6 0.6 0.6 c 1204 933 m
- 20 -16 d 94 Y -20 16 d f black 1204 933 m 20 -16 d 94 Y -20 16 d cl s 1 1 1 c
- 1224 1011 m 24 6 d -21 16 d -23 -6 d f black 1224 1011 m 24 6 d -21 16 d -23 -6
- d cl s 1 1 1 c 1201 911 m 23 6 d 108 Y -23 -6 d f black 1201 911 m 23 6 d 108 Y
- -23 -6 d cl s 0.6 0.6 0.6 c 1180 927 m 21 -16 d 108 Y -21 15 d f black 1180 927
- m 21 -16 d 108 Y -21 15 d cl s 1 1 1 c 1201 1019 m 23 6 d -20 15 d -24 -6 d f
- black 1201 1019 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1177 905 m 24 6 d 27 Y
- -24 -6 d f black 1177 905 m 24 6 d 27 Y -24 -6 d cl s 0.6 0.6 0.6 c 1157 921 m
- 20 -16 d 27 Y -20 16 d f black 1157 921 m 20 -16 d 27 Y -20 16 d cl s 1 1 1 c
- 1177 932 m 24 6 d -21 16 d -23 -6 d f black 1177 932 m 24 6 d -21 16 d -23 -6 d
- cl s 1 1 1 c 1154 899 m 23 6 d 67 Y -23 -6 d f black 1154 899 m 23 6 d 67 Y -23
- -6 d cl s 0.6 0.6 0.6 c 1133 915 m 21 -16 d 67 Y -21 16 d f black 1133 915 m 21
- -16 d 67 Y -21 16 d cl s 1 1 1 c 1154 966 m 23 6 d -20 16 d -24 -6 d f black
- 1154 966 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1130 893 m 24 6 d 81 Y -24 -6
- d f black 1130 893 m 24 6 d 81 Y -24 -6 d cl s 0.6 0.6 0.6 c 1110 909 m 20 -16
- d 81 Y -20 15 d f black 1110 909 m 20 -16 d 81 Y -20 15 d cl s 1 1 1 c 1130 974
- m 24 6 d -21 15 d -23 -6 d f black 1130 974 m 24 6 d -21 15 d -23 -6 d cl s 1 1
- 1 c 1107 887 m 23 6 d 94 Y -23 -6 d f black 1107 887 m 23 6 d 94 Y -23 -6 d
- cl s 0.6 0.6 0.6 c 1086 903 m 21 -16 d 94 Y -21 16 d f black 1086 903 m 21 -16
- d 94 Y -21 16 d cl s 1 1 1 c 1107 981 m 23 6 d -20 16 d -24 -6 d f black 1107
- 981 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1083 881 m 24 6 d 94 Y -24 -6 d f
- black 1083 881 m 24 6 d 94 Y -24 -6 d cl s 0.6 0.6 0.6 c 1063 897 m 20 -16 d 94
- Y -20 16 d f black 1063 897 m 20 -16 d 94 Y -20 16 d cl s 1 1 1 c 1083 975 m 24
- 6 d -21 16 d -23 -6 d f black 1083 975 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c
- 1060 875 m 23 6 d 135 Y -23 -6 d f black 1060 875 m 23 6 d 135 Y -23 -6 d cl s
- 0.6 0.6 0.6 c 1039 891 m 21 -16 d 135 Y -21 15 d f black 1039 891 m 21 -16 d
- 135 Y -21 15 d cl s 1 1 1 c 1060 1010 m 23 6 d -20 15 d -24 -6 d f black 1060
- 1010 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1036 869 m 24 6 d 41 Y -24 -6 d f
- black 1036 869 m 24 6 d 41 Y -24 -6 d cl s 0.6 0.6 0.6 c 1016 885 m 20 -16 d 41
- Y -20 15 d f black 1016 885 m 20 -16 d 41 Y -20 15 d cl s 1 1 1 c 1036 910 m 24
- 6 d -21 15 d -23 -6 d f black 1036 910 m 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c
- 1013 863 m 23 6 d 27 Y -23 -6 d f black 1013 863 m 23 6 d 27 Y -23 -6 d cl s
- 0.6 0.6 0.6 c 992 879 m 21 -16 d 27 Y -21 16 d f black 992 879 m 21 -16 d 27 Y
- -21 16 d cl s 1 1 1 c 1013 890 m 23 6 d -20 16 d -24 -6 d f black 1013 890 m 23
- 6 d -20 16 d -24 -6 d cl s 1 1 1 c 989 857 m 24 6 d 121 Y -24 -6 d f black 989
- 857 m 24 6 d 121 Y -24 -6 d cl s 0.6 0.6 0.6 c 969 873 m 20 -16 d 121 Y -20 16
- d f black 969 873 m 20 -16 d 121 Y -20 16 d cl s 1 1 1 c 989 978 m 24 6 d -21
- 16 d -23 -6 d f black 989 978 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 966 851 m
- 23 6 d 94 Y -23 -6 d f black 966 851 m 23 6 d 94 Y -23 -6 d cl s 0.6 0.6 0.6 c
- 945 867 m 21 -16 d 94 Y -21 16 d f black 945 867 m 21 -16 d 94 Y -21 16 d cl s
- 1 1 1 c 966 945 m 23 6 d -20 16 d -24 -6 d f black 966 945 m 23 6 d -20 16 d
- -24 -6 d cl s 1 1 1 c 942 845 m 24 6 d 121 Y -24 -6 d f black 942 845 m 24 6 d
- 121 Y -24 -6 d cl s 0.6 0.6 0.6 c 922 861 m 20 -16 d 121 Y -20 16 d f black 922
- 861 m 20 -16 d 121 Y -20 16 d cl s 1 1 1 c 942 966 m 24 6 d -21 16 d -23 -6 d f
- black 942 966 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 919 839 m 23 6 d 54 Y -23
- -6 d f black 919 839 m 23 6 d 54 Y -23 -6 d cl s 0.6 0.6 0.6 c 898 855 m 21 -16
- d 54 Y -21 16 d f black 898 855 m 21 -16 d 54 Y -21 16 d cl s 1 1 1 c 919 893 m
- 23 6 d -20 16 d -24 -6 d f black 919 893 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1
- c 895 833 m 24 6 d 41 Y -24 -6 d f black 895 833 m 24 6 d 41 Y -24 -6 d cl s
- 0.6 0.6 0.6 c 875 849 m 20 -16 d 41 Y -20 15 d f black 875 849 m 20 -16 d 41 Y
- -20 15 d cl s 1 1 1 c 895 874 m 24 6 d -21 15 d -23 -6 d f black 895 874 m 24 6
- d -21 15 d -23 -6 d cl s 1 1 1 c 872 827 m 23 6 d 68 Y -23 -6 d f black 872 827
- m 23 6 d 68 Y -23 -6 d cl s 0.6 0.6 0.6 c 851 843 m 21 -16 d 68 Y -21 15 d f
- black 851 843 m 21 -16 d 68 Y -21 15 d cl s 1 1 1 c 872 895 m 23 6 d -20 15 d
- -24 -6 d f black 872 895 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 848 821 m 24 6
- d 81 Y -24 -6 d f black 848 821 m 24 6 d 81 Y -24 -6 d cl s 0.6 0.6 0.6 c 828
- 837 m 20 -16 d 81 Y -20 16 d f black 828 837 m 20 -16 d 81 Y -20 16 d cl s 1 1
- 1 c 848 902 m 24 6 d -21 16 d -23 -6 d f black 848 902 m 24 6 d -21 16 d -23 -6
- d cl s 1 1 1 c 825 815 m 23 6 d 54 Y -23 -6 d f black 825 815 m 23 6 d 54 Y -23
- -6 d cl s 0.6 0.6 0.6 c 804 831 m 21 -16 d 54 Y -21 16 d f black 804 831 m 21
- -16 d 54 Y -21 16 d cl s 1 1 1 c 825 869 m 23 6 d -20 16 d -24 -6 d f black 825
- 869 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 801 809 m 24 6 d -21 16 d -23 -6 d
- f black 801 809 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 778 803 m 23 6 d -20 16
- d -24 -6 d f black 778 803 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 754 798 m 24
- 5 d -21 16 d -23 -6 d f black 754 798 m 24 5 d -21 16 d -23 -6 d cl s 1 1 1 c
- 731 792 m 23 6 d -20 15 d -23 -6 d f black 731 792 m 23 6 d -20 15 d -23 -6 d
- cl s 1 1 1 c 1855 1057 m 24 6 d -21 16 d -23 -6 d f black 1855 1057 m 24 6 d
- -21 16 d -23 -6 d cl s 1 1 1 c 1832 1051 m 23 6 d -20 16 d -24 -6 d f black
- 1832 1051 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1808 1045 m 24 6 d -21 16 d
- -23 -6 d f black 1808 1045 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 1785 1039 m
- 23 6 d -20 16 d -24 -6 d f black 1785 1039 m 23 6 d -20 16 d -24 -6 d cl s 1 1
- 1 c 1761 1033 m 24 6 d 54 Y -24 -6 d f black 1761 1033 m 24 6 d 54 Y -24 -6 d
- cl s 0.6 0.6 0.6 c 1741 1049 m 20 -16 d 54 Y -20 15 d f black 1741 1049 m 20
- -16 d 54 Y -20 15 d cl s 1 1 1 c 1761 1087 m 24 6 d -21 15 d -23 -6 d f black
- 1761 1087 m 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 1738 1027 m 23 6 d 40 Y -23
- -6 d f black 1738 1027 m 23 6 d 40 Y -23 -6 d cl s 0.6 0.6 0.6 c 1717 1043 m 21
- -16 d 40 Y -21 16 d f black 1717 1043 m 21 -16 d 40 Y -21 16 d cl s 1 1 1 c
- 1738 1067 m 23 6 d -20 16 d -24 -6 d f black 1738 1067 m 23 6 d -20 16 d -24 -6
- d cl s 1 1 1 c 1714 1021 m 24 6 d 40 Y -24 -6 d f black 1714 1021 m 24 6 d 40 Y
- -24 -6 d cl s 0.6 0.6 0.6 c 1694 1037 m 20 -16 d 40 Y -20 16 d f black 1694
- 1037 m 20 -16 d 40 Y -20 16 d cl s 1 1 1 c 1714 1061 m 24 6 d -21 16 d -23 -6 d
- f black 1714 1061 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 1691 1015 m 23 6 d 40
- Y -23 -6 d f black 1691 1015 m 23 6 d 40 Y -23 -6 d cl s 0.6 0.6 0.6 c 1670
- 1031 m 21 -16 d 40 Y -21 16 d f black 1670 1031 m 21 -16 d 40 Y -21 16 d cl s 1
- 1 1 c 1691 1055 m 23 6 d -20 16 d -24 -6 d f black 1691 1055 m 23 6 d -20 16 d
- -24 -6 d cl s 1 1 1 c 1667 1009 m 24 6 d 54 Y -24 -6 d f black 1667 1009 m 24 6
- d 54 Y -24 -6 d cl s 0.6 0.6 0.6 c 1647 1025 m 20 -16 d 54 Y -20 15 d f black
- 1647 1025 m 20 -16 d 54 Y -20 15 d cl s 1 1 1 c 1667 1063 m 24 6 d -21 15 d -23
- -6 d f black 1667 1063 m 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 1644 1003 m 23 6
- d 54 Y -23 -6 d f black 1644 1003 m 23 6 d 54 Y -23 -6 d cl s 0.6 0.6 0.6 c
- 1623 1019 m 21 -16 d 54 Y -21 16 d f black 1623 1019 m 21 -16 d 54 Y -21 16 d
- cl s 1 1 1 c 1644 1057 m 23 6 d -20 15 d -24 -5 d f black 1644 1057 m 23 6 d
- -20 15 d -24 -5 d cl s 1 1 1 c 1620 997 m 24 6 d 27 Y -24 -6 d f black 1620 997
- m 24 6 d 27 Y -24 -6 d cl s 0.6 0.6 0.6 c 1600 1013 m 20 -16 d 27 Y -20 16 d f
- black 1600 1013 m 20 -16 d 27 Y -20 16 d cl s 1 1 1 c 1620 1024 m 24 6 d -21 16
- d -23 -6 d f black 1620 1024 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 1597 991 m
- 23 6 d 81 Y -23 -6 d f black 1597 991 m 23 6 d 81 Y -23 -6 d cl s 0.6 0.6 0.6 c
- 1576 1007 m 21 -16 d 81 Y -21 15 d f black 1576 1007 m 21 -16 d 81 Y -21 15 d
- cl s 1 1 1 c 1597 1072 m 23 6 d -20 15 d -24 -6 d f black 1597 1072 m 23 6 d
- -20 15 d -24 -6 d cl s 1 1 1 c 1573 985 m 24 6 d 54 Y -24 -6 d f black 1573 985
- m 24 6 d 54 Y -24 -6 d cl s 0.6 0.6 0.6 c 1553 1001 m 20 -16 d 54 Y -20 16 d f
- black 1553 1001 m 20 -16 d 54 Y -20 16 d cl s 1 1 1 c 1573 1039 m 24 6 d -21 16
- d -23 -6 d f black 1573 1039 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 1550 979 m
- 23 6 d 27 Y -23 -6 d f black 1550 979 m 23 6 d 27 Y -23 -6 d cl s 0.6 0.6 0.6 c
- 1529 995 m 21 -16 d 27 Y -21 16 d f black 1529 995 m 21 -16 d 27 Y -21 16 d
- cl s 1 1 1 c 1550 1006 m 23 6 d -20 16 d -24 -6 d f black 1550 1006 m 23 6 d
- -20 16 d -24 -6 d cl s 1 1 1 c 1526 973 m 24 6 d 54 Y -24 -6 d f black 1526 973
- m 24 6 d 54 Y -24 -6 d cl s 0.6 0.6 0.6 c 1506 989 m 20 -16 d 54 Y -20 16 d f
- black 1506 989 m 20 -16 d 54 Y -20 16 d cl s 1 1 1 c 1526 1027 m 24 6 d -21 16
- d -23 -6 d f black 1526 1027 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 1503 967 m
- 23 6 d 81 Y -23 -6 d f black 1503 967 m 23 6 d 81 Y -23 -6 d cl s 0.6 0.6 0.6 c
- 1483 983 m 20 -16 d 81 Y -20 16 d f black 1483 983 m 20 -16 d 81 Y -20 16 d
- cl s 1 1 1 c 1503 1048 m 23 6 d -20 15 d -23 -5 d f black 1503 1048 m 23 6 d
- -20 15 d -23 -5 d cl s 1 1 1 c 1479 961 m 24 6 d 27 Y -24 -6 d f black 1479 961
- m 24 6 d 27 Y -24 -6 d cl s 0.6 0.6 0.6 c 1459 977 m 20 -16 d 27 Y -20 16 d f
- black 1459 977 m 20 -16 d 27 Y -20 16 d cl s 1 1 1 c 1479 988 m 24 6 d -20 16 d
- -24 -6 d f black 1479 988 m 24 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1456 955 m 23
- 6 d 14 Y -23 -6 d f black 1456 955 m 23 6 d 14 Y -23 -6 d cl s 0.6 0.6 0.6 c
- 1436 971 m 20 -16 d 14 Y -20 15 d f black 1436 971 m 20 -16 d 14 Y -20 15 d
- cl s 1 1 1 c 1456 969 m 23 6 d -20 15 d -23 -6 d f black 1456 969 m 23 6 d -20
- 15 d -23 -6 d cl s 1 1 1 c 1432 949 m 24 6 d 27 Y -24 -6 d f black 1432 949 m
- 24 6 d 27 Y -24 -6 d cl s 0.6 0.6 0.6 c 1412 965 m 20 -16 d 27 Y -20 16 d f
- black 1412 965 m 20 -16 d 27 Y -20 16 d cl s 1 1 1 c 1432 976 m 24 6 d -20 16 d
- -24 -6 d f black 1432 976 m 24 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1409 943 m 23
- 6 d 41 Y -23 -6 d f black 1409 943 m 23 6 d 41 Y -23 -6 d cl s 0.6 0.6 0.6 c
- 1389 959 m 20 -16 d 41 Y -20 15 d f black 1389 959 m 20 -16 d 41 Y -20 15 d
- cl s 1 1 1 c 1409 984 m 23 6 d -20 15 d -23 -6 d f black 1409 984 m 23 6 d -20
- 15 d -23 -6 d cl s 1 1 1 c 1385 937 m 24 6 d 27 Y -24 -6 d f black 1385 937 m
- 24 6 d 27 Y -24 -6 d cl s 0.6 0.6 0.6 c 1365 953 m 20 -16 d 27 Y -20 16 d f
- black 1365 953 m 20 -16 d 27 Y -20 16 d cl s 1 1 1 c 1385 964 m 24 6 d -20 16 d
- -24 -6 d f black 1385 964 m 24 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1362 931 m 23
- 6 d 14 Y -23 -6 d f black 1362 931 m 23 6 d 14 Y -23 -6 d cl s 0.6 0.6 0.6 c
- 1342 947 m 20 -16 d 14 Y -20 15 d f black 1342 947 m 20 -16 d 14 Y -20 15 d
- cl s 1 1 1 c 1362 945 m 23 6 d -20 15 d -23 -6 d f black 1362 945 m 23 6 d -20
- 15 d -23 -6 d cl s 1 1 1 c 1338 925 m 24 6 d 54 Y -24 -6 d f black 1338 925 m
- 24 6 d 54 Y -24 -6 d cl s 0.6 0.6 0.6 c 1318 941 m 20 -16 d 54 Y -20 16 d f
- black 1318 941 m 20 -16 d 54 Y -20 16 d cl s 1 1 1 c 1338 979 m 24 6 d -20 16 d
- -24 -6 d f black 1338 979 m 24 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1315 920 m 23
- 5 d 68 Y -23 -6 d f black 1315 920 m 23 5 d 68 Y -23 -6 d cl s 0.6 0.6 0.6 c
- 1295 935 m 20 -15 d 67 Y -20 15 d f black 1295 935 m 20 -15 d 67 Y -20 15 d
- cl s 1 1 1 c 1315 987 m 23 6 d -20 15 d -23 -6 d f black 1315 987 m 23 6 d -20
- 15 d -23 -6 d cl s 1 1 1 c 1291 914 m 24 6 d 67 Y -24 -6 d f black 1291 914 m
- 24 6 d 67 Y -24 -6 d cl s 0.6 0.6 0.6 c 1271 929 m 20 -15 d 67 Y -20 15 d f
- black 1271 929 m 20 -15 d 67 Y -20 15 d cl s 1 1 1 c 1291 981 m 24 6 d -20 15 d
- -24 -6 d f black 1291 981 m 24 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1268 908 m 23
- 6 d 53 Y -23 -6 d f black 1268 908 m 23 6 d 53 Y -23 -6 d cl s 0.6 0.6 0.6 c
- 1248 923 m 20 -15 d 53 Y -20 16 d f black 1248 923 m 20 -15 d 53 Y -20 16 d
- cl s 1 1 1 c 1268 961 m 23 6 d -20 16 d -23 -6 d f black 1268 961 m 23 6 d -20
- 16 d -23 -6 d cl s 1 1 1 c 1244 902 m 24 6 d 94 Y -24 -6 d f black 1244 902 m
- 24 6 d 94 Y -24 -6 d cl s 0.6 0.6 0.6 c 1224 917 m 20 -15 d 94 Y -20 15 d f
- black 1224 917 m 20 -15 d 94 Y -20 15 d cl s 1 1 1 c 1244 996 m 24 6 d -20 15 d
- -24 -6 d f black 1244 996 m 24 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1221 896 m 23
- 6 d 53 Y -23 -6 d f black 1221 896 m 23 6 d 53 Y -23 -6 d cl s 0.6 0.6 0.6 c
- 1201 911 m 20 -15 d 53 Y -20 16 d f black 1201 911 m 20 -15 d 53 Y -20 16 d
- cl s 1 1 1 c 1221 949 m 23 6 d -20 16 d -23 -6 d f black 1221 949 m 23 6 d -20
- 16 d -23 -6 d cl s 1 1 1 c 1197 890 m 24 6 d 13 Y -24 -6 d f black 1197 890 m
- 24 6 d 13 Y -24 -6 d cl s 0.6 0.6 0.6 c 1177 905 m 20 -15 d 13 Y -20 16 d f
- black 1177 905 m 20 -15 d 13 Y -20 16 d cl s 1 1 1 c 1197 903 m 24 6 d -20 16 d
- -24 -6 d f black 1197 903 m 24 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1174 884 m 23
- 6 d 13 Y -23 -6 d f black 1174 884 m 23 6 d 13 Y -23 -6 d cl s 0.6 0.6 0.6 c
- 1154 899 m 20 -15 d 13 Y -20 16 d f black 1154 899 m 20 -15 d 13 Y -20 16 d
- cl s 1 1 1 c 1174 897 m 23 6 d -20 16 d -23 -6 d f black 1174 897 m 23 6 d -20
- 16 d -23 -6 d cl s 1 1 1 c 1151 878 m 23 6 d 40 Y -23 -6 d f black 1151 878 m
- 23 6 d 40 Y -23 -6 d cl s 0.6 0.6 0.6 c 1130 893 m 21 -15 d 40 Y -21 15 d f
- black 1130 893 m 21 -15 d 40 Y -21 15 d cl s 1 1 1 c 1151 918 m 23 6 d -20 15 d
- -24 -6 d f black 1151 918 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1127 872 m 24
- 6 d 40 Y -24 -6 d f black 1127 872 m 24 6 d 40 Y -24 -6 d cl s 0.6 0.6 0.6 c
- 1107 887 m 20 -15 d 40 Y -20 16 d f black 1107 887 m 20 -15 d 40 Y -20 16 d
- cl s 1 1 1 c 1127 912 m 24 6 d -21 15 d -23 -5 d f black 1127 912 m 24 6 d -21
- 15 d -23 -5 d cl s 1 1 1 c 1104 866 m 23 6 d 53 Y -23 -6 d f black 1104 866 m
- 23 6 d 53 Y -23 -6 d cl s 0.6 0.6 0.6 c 1083 881 m 21 -15 d 53 Y -21 16 d f
- black 1083 881 m 21 -15 d 53 Y -21 16 d cl s 1 1 1 c 1104 919 m 23 6 d -20 16 d
- -24 -6 d f black 1104 919 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1080 860 m 24
- 6 d 67 Y -24 -6 d f black 1080 860 m 24 6 d 67 Y -24 -6 d cl s 0.6 0.6 0.6 c
- 1060 875 m 20 -15 d 67 Y -20 15 d f black 1060 875 m 20 -15 d 67 Y -20 15 d
- cl s 1 1 1 c 1080 927 m 24 6 d -21 15 d -23 -6 d f black 1080 927 m 24 6 d -21
- 15 d -23 -6 d cl s 1 1 1 c 1057 854 m 23 6 d 40 Y -23 -6 d f black 1057 854 m
- 23 6 d 40 Y -23 -6 d cl s 0.6 0.6 0.6 c 1036 869 m 21 -15 d 40 Y -21 16 d f
- black 1036 869 m 21 -15 d 40 Y -21 16 d cl s 1 1 1 c 1057 894 m 23 6 d -20 16 d
- -24 -6 d f black 1057 894 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1033 848 m 24
- 6 d 53 Y -24 -5 d f black 1033 848 m 24 6 d 53 Y -24 -5 d cl s 0.6 0.6 0.6 c
- 1013 863 m 20 -15 d 54 Y -20 15 d f black 1013 863 m 20 -15 d 54 Y -20 15 d
- cl s 1 1 1 c 1033 902 m 24 5 d -21 16 d -23 -6 d f black 1033 902 m 24 5 d -21
- 16 d -23 -6 d cl s 1 1 1 c 1010 842 m 23 6 d 67 Y -23 -6 d f black 1010 842 m
- 23 6 d 67 Y -23 -6 d cl s 0.6 0.6 0.6 c 989 857 m 21 -15 d 67 Y -21 15 d f
- black 989 857 m 21 -15 d 67 Y -21 15 d cl s 1 1 1 c 1010 909 m 23 6 d -20 15 d
- -24 -6 d f black 1010 909 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 986 836 m 24
- 6 d 27 Y -24 -6 d f black 986 836 m 24 6 d 27 Y -24 -6 d cl s 0.6 0.6 0.6 c 966
- 851 m 20 -15 d 27 Y -20 15 d f black 966 851 m 20 -15 d 27 Y -20 15 d cl s 1 1
- 1 c 986 863 m 24 6 d -21 15 d -23 -6 d f black 986 863 m 24 6 d -21 15 d -23 -6
- d cl s 1 1 1 c 963 830 m 23 6 d 13 Y -23 -6 d f black 963 830 m 23 6 d 13 Y -23
- -6 d cl s 0.6 0.6 0.6 c 942 845 m 21 -15 d 13 Y -21 16 d f black 942 845 m 21
- -15 d 13 Y -21 16 d cl s 1 1 1 c 963 843 m 23 6 d -20 16 d -24 -6 d f black 963
- 843 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 939 824 m 24 6 d 13 Y -24 -6 d f
- black 939 824 m 24 6 d 13 Y -24 -6 d cl s 0.6 0.6 0.6 c 919 839 m 20 -15 d 13 Y
- -20 16 d f black 919 839 m 20 -15 d 13 Y -20 16 d cl s 1 1 1 c 939 837 m 24 6 d
- -21 16 d -23 -6 d f black 939 837 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 916
- 818 m 23 6 d 67 Y -23 -6 d f black 916 818 m 23 6 d 67 Y -23 -6 d cl s 0.6 0.6
- 0.6 c 895 833 m 21 -15 d 67 Y -21 16 d f black 895 833 m 21 -15 d 67 Y -21 16 d
- cl s 1 1 1 c 916 885 m 23 6 d -20 16 d -24 -6 d f black 916 885 m 23 6 d -20 16
- d -24 -6 d cl s 1 1 1 c 892 812 m 24 6 d 54 Y -24 -6 d f black 892 812 m 24 6 d
- 54 Y -24 -6 d cl s 0.6 0.6 0.6 c 872 827 m 20 -15 d 54 Y -20 15 d f black 872
- 827 m 20 -15 d 54 Y -20 15 d cl s 1 1 1 c 892 866 m 24 6 d -21 15 d -23 -6 d f
- black 892 866 m 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 869 806 m 23 6 d 40 Y -23
- -6 d f black 869 806 m 23 6 d 40 Y -23 -6 d cl s 0.6 0.6 0.6 c 848 821 m 21 -15
- d 40 Y -21 16 d f black 848 821 m 21 -15 d 40 Y -21 16 d cl s 1 1 1 c 869 846 m
- 23 6 d -20 16 d -24 -6 d f black 869 846 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1
- c 845 800 m 24 6 d 40 Y -24 -6 d f black 845 800 m 24 6 d 40 Y -24 -6 d cl s
- 0.6 0.6 0.6 c 825 815 m 20 -15 d 40 Y -20 16 d f black 825 815 m 20 -15 d 40 Y
- -20 16 d cl s 1 1 1 c 845 840 m 24 6 d -21 16 d -23 -6 d f black 845 840 m 24 6
- d -21 16 d -23 -6 d cl s 1 1 1 c 822 794 m 23 6 d -20 15 d -24 -6 d f black 822
- 794 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 798 788 m 24 6 d -21 15 d -23 -6 d
- f black 798 788 m 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 775 782 m 23 6 d -20 15
- d -24 -5 d f black 775 782 m 23 6 d -20 15 d -24 -5 d cl s 1 1 1 c 751 776 m 24
- 6 d -21 16 d -23 -6 d f black 751 776 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c
- 1876 1042 m 23 5 d -20 16 d -24 -6 d f black 1876 1042 m 23 5 d -20 16 d -24 -6
- d cl s 1 1 1 c 1852 1036 m 24 6 d -21 15 d -23 -6 d f black 1852 1036 m 24 6 d
- -21 15 d -23 -6 d cl s 1 1 1 c 1829 1030 m 23 6 d -20 15 d -24 -6 d f black
- 1829 1030 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1805 1024 m 24 6 d -21 15 d
- -23 -6 d f black 1805 1024 m 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 1782 1018 m
- 23 6 d 80 Y -23 -6 d f black 1782 1018 m 23 6 d 80 Y -23 -6 d cl s 0.6 0.6 0.6
- c 1761 1033 m 21 -15 d 80 Y -21 16 d f black 1761 1033 m 21 -15 d 80 Y -21 16 d
- cl s 1 1 1 c 1782 1098 m 23 6 d -20 16 d -24 -6 d f black 1782 1098 m 23 6 d
- -20 16 d -24 -6 d cl s 1 1 1 c 1758 1012 m 24 6 d -21 15 d -23 -6 d f black
- 1758 1012 m 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 1735 1006 m 23 6 d -20 15 d
- -24 -6 d f black 1735 1006 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1711 1000 m
- 24 6 d 40 Y -24 -6 d f black 1711 1000 m 24 6 d 40 Y -24 -6 d cl s 0.6 0.6 0.6
- c 1691 1015 m 20 -15 d 40 Y -20 15 d f black 1691 1015 m 20 -15 d 40 Y -20 15 d
- cl s 1 1 1 c 1711 1040 m 24 6 d -21 15 d -23 -6 d f black 1711 1040 m 24 6 d
- -21 15 d -23 -6 d cl s 1 1 1 c 1688 994 m 23 6 d 13 Y -23 -6 d f black 1688 994
- m 23 6 d 13 Y -23 -6 d cl s 0.6 0.6 0.6 c 1667 1009 m 21 -15 d 13 Y -21 16 d f
- black 1667 1009 m 21 -15 d 13 Y -21 16 d cl s 1 1 1 c 1688 1007 m 23 6 d -20 16
- d -24 -6 d f black 1688 1007 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1664 988 m
- 24 6 d -21 15 d -23 -6 d f black 1664 988 m 24 6 d -21 15 d -23 -6 d cl s 1 1 1
- c 1641 982 m 23 6 d 40 Y -23 -6 d f black 1641 982 m 23 6 d 40 Y -23 -6 d cl s
- 0.6 0.6 0.6 c 1620 997 m 21 -15 d 40 Y -21 16 d f black 1620 997 m 21 -15 d 40
- Y -21 16 d cl s 1 1 1 c 1641 1022 m 23 6 d -20 16 d -24 -6 d f black 1641 1022
- m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1617 976 m 24 6 d 27 Y -24 -6 d f black
- 1617 976 m 24 6 d 27 Y -24 -6 d cl s 0.6 0.6 0.6 c 1597 991 m 20 -15 d 27 Y -20
- 15 d f black 1597 991 m 20 -15 d 27 Y -20 15 d cl s 1 1 1 c 1617 1003 m 24 6 d
- -21 15 d -23 -6 d f black 1617 1003 m 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c
- 1594 970 m 23 6 d 13 Y -23 -6 d f black 1594 970 m 23 6 d 13 Y -23 -6 d cl s
- 0.6 0.6 0.6 c 1573 985 m 21 -15 d 13 Y -21 16 d f black 1573 985 m 21 -15 d 13
- Y -21 16 d cl s 1 1 1 c 1594 983 m 23 6 d -20 16 d -24 -6 d f black 1594 983 m
- 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1570 964 m 24 6 d 27 Y -24 -6 d f black
- 1570 964 m 24 6 d 27 Y -24 -6 d cl s 0.6 0.6 0.6 c 1550 979 m 20 -15 d 27 Y -20
- 15 d f black 1550 979 m 20 -15 d 27 Y -20 15 d cl s 1 1 1 c 1570 991 m 24 6 d
- -21 15 d -23 -6 d f black 1570 991 m 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 1547
- 958 m 23 6 d 27 Y -23 -6 d f black 1547 958 m 23 6 d 27 Y -23 -6 d cl s 0.6 0.6
- 0.6 c 1526 973 m 21 -15 d 27 Y -21 15 d f black 1526 973 m 21 -15 d 27 Y -21 15
- d cl s 1 1 1 c 1547 985 m 23 6 d -20 15 d -24 -6 d f black 1547 985 m 23 6 d
- -20 15 d -24 -6 d cl s 1 1 1 c 1523 952 m 24 6 d -21 15 d -23 -6 d f black 1523
- 952 m 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 1500 946 m 23 6 d 13 Y -23 -6 d f
- black 1500 946 m 23 6 d 13 Y -23 -6 d cl s 0.6 0.6 0.6 c 1479 961 m 21 -15 d 13
- Y -21 16 d f black 1479 961 m 21 -15 d 13 Y -21 16 d cl s 1 1 1 c 1500 959 m 23
- 6 d -20 16 d -24 -6 d f black 1500 959 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c
- 1476 940 m 24 6 d 27 Y -24 -6 d f black 1476 940 m 24 6 d 27 Y -24 -6 d cl s
- 0.6 0.6 0.6 c 1456 955 m 20 -15 d 27 Y -20 15 d f black 1456 955 m 20 -15 d 27
- Y -20 15 d cl s 1 1 1 c 1476 967 m 24 6 d -21 15 d -23 -6 d f black 1476 967 m
- 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 1453 934 m 23 6 d 13 Y -23 -6 d f black
- 1453 934 m 23 6 d 13 Y -23 -6 d cl s 0.6 0.6 0.6 c 1432 949 m 21 -15 d 13 Y -21
- 16 d f black 1432 949 m 21 -15 d 13 Y -21 16 d cl s 1 1 1 c 1453 947 m 23 6 d
- -20 16 d -24 -6 d f black 1453 947 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1429
- 928 m 24 6 d 27 Y -24 -6 d f black 1429 928 m 24 6 d 27 Y -24 -6 d cl s 0.6 0.6
- 0.6 c 1409 943 m 20 -15 d 27 Y -20 15 d f black 1409 943 m 20 -15 d 27 Y -20 15
- d cl s 1 1 1 c 1429 955 m 24 6 d -21 15 d -23 -6 d f black 1429 955 m 24 6 d
- -21 15 d -23 -6 d cl s 1 1 1 c 1406 922 m 23 6 d -20 15 d -24 -6 d f black 1406
- 922 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1382 916 m 24 6 d 13 Y -24 -6 d f
- black 1382 916 m 24 6 d 13 Y -24 -6 d cl s 0.6 0.6 0.6 c 1362 931 m 20 -15 d 13
- Y -20 16 d f black 1362 931 m 20 -15 d 13 Y -20 16 d cl s 1 1 1 c 1382 929 m 24
- 6 d -21 16 d -23 -6 d f black 1382 929 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c
- 1359 910 m 23 6 d 27 Y -23 -6 d f black 1359 910 m 23 6 d 27 Y -23 -6 d cl s
- 0.6 0.6 0.6 c 1338 925 m 21 -15 d 27 Y -21 15 d f black 1338 925 m 21 -15 d 27
- Y -21 15 d cl s 1 1 1 c 1359 937 m 23 6 d -20 15 d -24 -6 d f black 1359 937 m
- 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1335 904 m 24 6 d -21 15 d -23 -5 d f
- black 1335 904 m 24 6 d -21 15 d -23 -5 d cl s 1 1 1 c 1312 898 m 23 6 d 27 Y
- -23 -6 d f black 1312 898 m 23 6 d 27 Y -23 -6 d cl s 0.6 0.6 0.6 c 1291 914 m
- 21 -16 d 27 Y -21 15 d f black 1291 914 m 21 -16 d 27 Y -21 15 d cl s 1 1 1 c
- 1312 925 m 23 6 d -20 15 d -24 -6 d f black 1312 925 m 23 6 d -20 15 d -24 -6 d
- cl s 1 1 1 c 1288 892 m 24 6 d 13 Y -24 -6 d f black 1288 892 m 24 6 d 13 Y -24
- -6 d cl s 0.6 0.6 0.6 c 1268 908 m 20 -16 d 13 Y -20 16 d f black 1268 908 m 20
- -16 d 13 Y -20 16 d cl s 1 1 1 c 1288 905 m 24 6 d -21 16 d -23 -6 d f black
- 1288 905 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 1265 886 m 23 6 d 13 Y -23 -6
- d f black 1265 886 m 23 6 d 13 Y -23 -6 d cl s 0.6 0.6 0.6 c 1244 902 m 21 -16
- d 13 Y -21 16 d f black 1244 902 m 21 -16 d 13 Y -21 16 d cl s 1 1 1 c 1265 899
- m 23 6 d -20 16 d -24 -6 d f black 1265 899 m 23 6 d -20 16 d -24 -6 d cl s 1 1
- 1 c 1241 880 m 24 6 d 40 Y -24 -6 d f black 1241 880 m 24 6 d 40 Y -24 -6 d
- cl s 0.6 0.6 0.6 c 1221 896 m 20 -16 d 40 Y -20 16 d f black 1221 896 m 20 -16
- d 40 Y -20 16 d cl s 1 1 1 c 1241 920 m 24 6 d -21 16 d -23 -6 d f black 1241
- 920 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 1218 874 m 23 6 d 13 Y -23 -5 d f
- black 1218 874 m 23 6 d 13 Y -23 -5 d cl s 0.6 0.6 0.6 c 1197 890 m 21 -16 d 14
- Y -21 15 d f black 1197 890 m 21 -16 d 14 Y -21 15 d cl s 1 1 1 c 1218 888 m 23
- 5 d -20 16 d -24 -6 d f black 1218 888 m 23 5 d -20 16 d -24 -6 d cl s 1 1 1 c
- 1194 868 m 24 6 d 27 Y -24 -6 d f black 1194 868 m 24 6 d 27 Y -24 -6 d cl s
- 0.6 0.6 0.6 c 1174 884 m 20 -16 d 27 Y -20 16 d f black 1174 884 m 20 -16 d 27
- Y -20 16 d cl s 1 1 1 c 1194 895 m 24 6 d -21 15 d -23 -5 d f black 1194 895 m
- 24 6 d -21 15 d -23 -5 d cl s 1 1 1 c 1171 862 m 23 6 d 27 Y -23 -6 d f black
- 1171 862 m 23 6 d 27 Y -23 -6 d cl s 0.6 0.6 0.6 c 1151 878 m 20 -16 d 27 Y -20
- 16 d f black 1151 878 m 20 -16 d 27 Y -20 16 d cl s 1 1 1 c 1171 889 m 23 6 d
- -20 16 d -23 -6 d f black 1171 889 m 23 6 d -20 16 d -23 -6 d cl s 1 1 1 c 1147
- 856 m 24 6 d 14 Y -24 -6 d f black 1147 856 m 24 6 d 14 Y -24 -6 d cl s 0.6 0.6
- 0.6 c 1127 872 m 20 -16 d 14 Y -20 15 d f black 1127 872 m 20 -16 d 14 Y -20 15
- d cl s 1 1 1 c 1147 870 m 24 6 d -20 15 d -24 -6 d f black 1147 870 m 24 6 d
- -20 15 d -24 -6 d cl s 1 1 1 c 1124 850 m 23 6 d 27 Y -23 -6 d f black 1124 850
- m 23 6 d 27 Y -23 -6 d cl s 0.6 0.6 0.6 c 1104 866 m 20 -16 d 27 Y -20 16 d f
- black 1104 866 m 20 -16 d 27 Y -20 16 d cl s 1 1 1 c 1124 877 m 23 6 d -20 16 d
- -23 -6 d f black 1124 877 m 23 6 d -20 16 d -23 -6 d cl s 1 1 1 c 1100 844 m 24
- 6 d 27 Y -24 -6 d f black 1100 844 m 24 6 d 27 Y -24 -6 d cl s 0.6 0.6 0.6 c
- 1080 860 m 20 -16 d 27 Y -20 16 d f black 1080 860 m 20 -16 d 27 Y -20 16 d
- cl s 1 1 1 c 1100 871 m 24 6 d -20 16 d -24 -6 d f black 1100 871 m 24 6 d -20
- 16 d -24 -6 d cl s 1 1 1 c 1077 838 m 23 6 d 27 Y -23 -6 d f black 1077 838 m
- 23 6 d 27 Y -23 -6 d cl s 0.6 0.6 0.6 c 1057 854 m 20 -16 d 27 Y -20 16 d f
- black 1057 854 m 20 -16 d 27 Y -20 16 d cl s 1 1 1 c 1077 865 m 23 6 d -20 16 d
- -23 -6 d f black 1077 865 m 23 6 d -20 16 d -23 -6 d cl s 1 1 1 c 1053 832 m 24
- 6 d 27 Y -24 -6 d f black 1053 832 m 24 6 d 27 Y -24 -6 d cl s 0.6 0.6 0.6 c
- 1033 848 m 20 -16 d 27 Y -20 16 d f black 1033 848 m 20 -16 d 27 Y -20 16 d
- cl s 1 1 1 c 1053 859 m 24 6 d -20 16 d -24 -6 d f black 1053 859 m 24 6 d -20
- 16 d -24 -6 d cl s 1 1 1 c 1030 826 m 23 6 d 27 Y -23 -6 d f black 1030 826 m
- 23 6 d 27 Y -23 -6 d cl s 0.6 0.6 0.6 c 1010 842 m 20 -16 d 27 Y -20 16 d f
- black 1010 842 m 20 -16 d 27 Y -20 16 d cl s 1 1 1 c 1030 853 m 23 6 d -20 16 d
- -23 -6 d f black 1030 853 m 23 6 d -20 16 d -23 -6 d cl s 1 1 1 c 1006 820 m 24
- 6 d 41 Y -24 -6 d f black 1006 820 m 24 6 d 41 Y -24 -6 d cl s 0.6 0.6 0.6 c
- 986 836 m 20 -16 d 41 Y -20 15 d f black 986 836 m 20 -16 d 41 Y -20 15 d cl s
- 1 1 1 c 1006 861 m 24 6 d -20 15 d -24 -6 d f black 1006 861 m 24 6 d -20 15 d
- -24 -6 d cl s 1 1 1 c 983 814 m 23 6 d 27 Y -23 -6 d f black 983 814 m 23 6 d
- 27 Y -23 -6 d cl s 0.6 0.6 0.6 c 963 830 m 20 -16 d 27 Y -20 16 d f black 963
- 830 m 20 -16 d 27 Y -20 16 d cl s 1 1 1 c 983 841 m 23 6 d -20 16 d -23 -6 d f
- black 983 841 m 23 6 d -20 16 d -23 -6 d cl s 1 1 1 c 959 808 m 24 6 d 41 Y -24
- -6 d f black 959 808 m 24 6 d 41 Y -24 -6 d cl s 0.6 0.6 0.6 c 939 824 m 20 -16
- d 41 Y -20 15 d f black 939 824 m 20 -16 d 41 Y -20 15 d cl s 1 1 1 c 959 849 m
- 24 6 d -20 15 d -24 -6 d f black 959 849 m 24 6 d -20 15 d -24 -6 d cl s 1 1 1
- c 936 802 m 23 6 d 14 Y -23 -6 d f black 936 802 m 23 6 d 14 Y -23 -6 d cl s
- 0.6 0.6 0.6 c 916 818 m 20 -16 d 14 Y -20 15 d f black 916 818 m 20 -16 d 14 Y
- -20 15 d cl s 1 1 1 c 936 816 m 23 6 d -20 15 d -23 -6 d f black 936 816 m 23 6
- d -20 15 d -23 -6 d cl s 1 1 1 c 912 796 m 24 6 d 14 Y -24 -6 d f black 912 796
- m 24 6 d 14 Y -24 -6 d cl s 0.6 0.6 0.6 c 892 812 m 20 -16 d 14 Y -20 15 d f
- black 892 812 m 20 -16 d 14 Y -20 15 d cl s 1 1 1 c 912 810 m 24 6 d -20 15 d
- -24 -6 d f black 912 810 m 24 6 d -20 15 d -24 -6 d cl s 1 1 1 c 889 790 m 23 6
- d 41 Y -23 -6 d f black 889 790 m 23 6 d 41 Y -23 -6 d cl s 0.6 0.6 0.6 c 869
- 806 m 20 -16 d 41 Y -20 15 d f black 869 806 m 20 -16 d 41 Y -20 15 d cl s 1 1
- 1 c 889 831 m 23 6 d -20 15 d -23 -6 d f black 889 831 m 23 6 d -20 15 d -23 -6
- d cl s 1 1 1 c 865 784 m 24 6 d 27 Y -24 -6 d f black 865 784 m 24 6 d 27 Y -24
- -6 d cl s 0.6 0.6 0.6 c 845 800 m 20 -16 d 27 Y -20 16 d f black 845 800 m 20
- -16 d 27 Y -20 16 d cl s 1 1 1 c 865 811 m 24 6 d -20 16 d -24 -6 d f black 865
- 811 m 24 6 d -20 16 d -24 -6 d cl s 1 1 1 c 842 778 m 23 6 d -20 16 d -23 -6 d
- f black 842 778 m 23 6 d -20 16 d -23 -6 d cl s 1 1 1 c 819 772 m 23 6 d -20 16
- d -24 -6 d f black 819 772 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 795 766 m 24
- 6 d -21 16 d -23 -6 d f black 795 766 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c
- 772 760 m 23 6 d -20 16 d -24 -6 d f black 772 760 m 23 6 d -20 16 d -24 -6 d
- cl s 1 1 1 c 1896 1026 m 23 6 d -20 15 d -23 -5 d f black 1896 1026 m 23 6 d
- -20 15 d -23 -5 d cl s 1 1 1 c 1872 1020 m 24 6 d -20 16 d -24 -6 d f black
- 1872 1020 m 24 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1849 1014 m 23 6 d -20 16 d
- -23 -6 d f black 1849 1014 m 23 6 d -20 16 d -23 -6 d cl s 1 1 1 c 1825 1008 m
- 24 6 d -20 16 d -24 -6 d f black 1825 1008 m 24 6 d -20 16 d -24 -6 d cl s 1 1
- 1 c 1802 1002 m 23 6 d 13 Y -23 -6 d f black 1802 1002 m 23 6 d 13 Y -23 -6 d
- cl s 0.6 0.6 0.6 c 1782 1018 m 20 -16 d 13 Y -20 16 d f black 1782 1018 m 20
- -16 d 13 Y -20 16 d cl s 1 1 1 c 1802 1015 m 23 6 d -20 16 d -23 -6 d f black
- 1802 1015 m 23 6 d -20 16 d -23 -6 d cl s 1 1 1 c 1778 996 m 24 6 d 13 Y -24 -5
- d f black 1778 996 m 24 6 d 13 Y -24 -5 d cl s 0.6 0.6 0.6 c 1758 1012 m 20 -16
- d 14 Y -20 15 d f black 1758 1012 m 20 -16 d 14 Y -20 15 d cl s 1 1 1 c 1778
- 1010 m 24 5 d -20 16 d -24 -6 d f black 1778 1010 m 24 5 d -20 16 d -24 -6 d
- cl s 1 1 1 c 1755 990 m 23 6 d -20 16 d -23 -6 d f black 1755 990 m 23 6 d -20
- 16 d -23 -6 d cl s 1 1 1 c 1731 984 m 24 6 d 14 Y -24 -6 d f black 1731 984 m
- 24 6 d 14 Y -24 -6 d cl s 0.6 0.6 0.6 c 1711 1000 m 20 -16 d 14 Y -20 15 d f
- black 1711 1000 m 20 -16 d 14 Y -20 15 d cl s 1 1 1 c 1731 998 m 24 6 d -20 15
- d -24 -6 d f black 1731 998 m 24 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1708 978 m
- 23 6 d -20 16 d -23 -6 d f black 1708 978 m 23 6 d -20 16 d -23 -6 d cl s 1 1 1
- c 1684 972 m 24 6 d -20 16 d -24 -6 d f black 1684 972 m 24 6 d -20 16 d -24 -6
- d cl s 1 1 1 c 1661 966 m 23 6 d -20 16 d -23 -6 d f black 1661 966 m 23 6 d
- -20 16 d -23 -6 d cl s 1 1 1 c 1637 960 m 24 6 d -20 16 d -24 -6 d f black 1637
- 960 m 24 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1614 954 m 23 6 d 14 Y -23 -6 d f
- black 1614 954 m 23 6 d 14 Y -23 -6 d cl s 0.6 0.6 0.6 c 1594 970 m 20 -16 d 14
- Y -20 15 d f black 1594 970 m 20 -16 d 14 Y -20 15 d cl s 1 1 1 c 1614 968 m 23
- 6 d -20 15 d -23 -6 d f black 1614 968 m 23 6 d -20 15 d -23 -6 d cl s 1 1 1 c
- 1591 948 m 23 6 d 14 Y -23 -6 d f black 1591 948 m 23 6 d 14 Y -23 -6 d cl s
- 0.6 0.6 0.6 c 1570 964 m 21 -16 d 14 Y -21 15 d f black 1570 964 m 21 -16 d 14
- Y -21 15 d cl s 1 1 1 c 1591 962 m 23 6 d -20 15 d -24 -6 d f black 1591 962 m
- 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1567 942 m 24 6 d -21 16 d -23 -6 d f
- black 1567 942 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 1544 936 m 23 6 d -20 16
- d -24 -6 d f black 1544 936 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1520 930 m
- 24 6 d -21 16 d -23 -6 d f black 1520 930 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1
- c 1497 924 m 23 6 d -20 16 d -24 -6 d f black 1497 924 m 23 6 d -20 16 d -24 -6
- d cl s 1 1 1 c 1473 918 m 24 6 d 14 Y -24 -6 d f black 1473 918 m 24 6 d 14 Y
- -24 -6 d cl s 0.6 0.6 0.6 c 1453 934 m 20 -16 d 14 Y -20 15 d f black 1453 934
- m 20 -16 d 14 Y -20 15 d cl s 1 1 1 c 1473 932 m 24 6 d -21 15 d -23 -6 d f
- black 1473 932 m 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 1450 912 m 23 6 d 14 Y
- -23 -6 d f black 1450 912 m 23 6 d 14 Y -23 -6 d cl s 0.6 0.6 0.6 c 1429 928 m
- 21 -16 d 14 Y -21 15 d f black 1429 928 m 21 -16 d 14 Y -21 15 d cl s 1 1 1 c
- 1450 926 m 23 6 d -20 15 d -24 -6 d f black 1450 926 m 23 6 d -20 15 d -24 -6 d
- cl s 1 1 1 c 1426 906 m 24 6 d -21 16 d -23 -6 d f black 1426 906 m 24 6 d -21
- 16 d -23 -6 d cl s 1 1 1 c 1403 900 m 23 6 d 14 Y -23 -6 d f black 1403 900 m
- 23 6 d 14 Y -23 -6 d cl s 0.6 0.6 0.6 c 1382 916 m 21 -16 d 14 Y -21 15 d f
- black 1382 916 m 21 -16 d 14 Y -21 15 d cl s 1 1 1 c 1403 914 m 23 6 d -20 15 d
- -24 -6 d f black 1403 914 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1379 894 m 24
- 6 d 41 Y -24 -6 d f black 1379 894 m 24 6 d 41 Y -24 -6 d cl s 0.6 0.6 0.6 c
- 1359 910 m 20 -16 d 41 Y -20 15 d f black 1359 910 m 20 -16 d 41 Y -20 15 d
- cl s 1 1 1 c 1379 935 m 24 6 d -21 15 d -23 -6 d f black 1379 935 m 24 6 d -21
- 15 d -23 -6 d cl s 1 1 1 c 1356 888 m 23 6 d 27 Y -23 -6 d f black 1356 888 m
- 23 6 d 27 Y -23 -6 d cl s 0.6 0.6 0.6 c 1335 904 m 21 -16 d 27 Y -21 16 d f
- black 1335 904 m 21 -16 d 27 Y -21 16 d cl s 1 1 1 c 1356 915 m 23 6 d -20 16 d
- -24 -6 d f black 1356 915 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1332 882 m 24
- 6 d 27 Y -24 -6 d f black 1332 882 m 24 6 d 27 Y -24 -6 d cl s 0.6 0.6 0.6 c
- 1312 898 m 20 -16 d 27 Y -20 16 d f black 1312 898 m 20 -16 d 27 Y -20 16 d
- cl s 1 1 1 c 1332 909 m 24 6 d -21 16 d -23 -6 d f black 1332 909 m 24 6 d -21
- 16 d -23 -6 d cl s 1 1 1 c 1309 876 m 23 6 d 41 Y -23 -6 d f black 1309 876 m
- 23 6 d 41 Y -23 -6 d cl s 0.6 0.6 0.6 c 1288 892 m 21 -16 d 41 Y -21 15 d f
- black 1288 892 m 21 -16 d 41 Y -21 15 d cl s 1 1 1 c 1309 917 m 23 6 d -20 15 d
- -24 -6 d f black 1309 917 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1285 871 m 24
- 5 d -21 16 d -23 -6 d f black 1285 871 m 24 5 d -21 16 d -23 -6 d cl s 1 1 1 c
- 1262 865 m 23 6 d 13 Y -23 -6 d f black 1262 865 m 23 6 d 13 Y -23 -6 d cl s
- 0.6 0.6 0.6 c 1241 880 m 21 -15 d 13 Y -21 15 d f black 1241 880 m 21 -15 d 13
- Y -21 15 d cl s 1 1 1 c 1262 878 m 23 6 d -20 15 d -24 -6 d f black 1262 878 m
- 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1238 859 m 24 6 d 13 Y -24 -6 d f black
- 1238 859 m 24 6 d 13 Y -24 -6 d cl s 0.6 0.6 0.6 c 1218 874 m 20 -15 d 13 Y -20
- 16 d f black 1218 874 m 20 -15 d 13 Y -20 16 d cl s 1 1 1 c 1238 872 m 24 6 d
- -21 15 d -23 -5 d f black 1238 872 m 24 6 d -21 15 d -23 -5 d cl s 1 1 1 c 1215
- 853 m 23 6 d 13 Y -23 -6 d f black 1215 853 m 23 6 d 13 Y -23 -6 d cl s 0.6 0.6
- 0.6 c 1194 868 m 21 -15 d 13 Y -21 16 d f black 1194 868 m 21 -15 d 13 Y -21 16
- d cl s 1 1 1 c 1215 866 m 23 6 d -20 16 d -24 -6 d f black 1215 866 m 23 6 d
- -20 16 d -24 -6 d cl s 1 1 1 c 1191 847 m 24 6 d -21 15 d -23 -6 d f black 1191
- 847 m 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 1168 841 m 23 6 d -20 15 d -24 -6 d
- f black 1168 841 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1144 835 m 24 6 d 13 Y
- -24 -6 d f black 1144 835 m 24 6 d 13 Y -24 -6 d cl s 0.6 0.6 0.6 c 1124 850 m
- 20 -15 d 13 Y -20 16 d f black 1124 850 m 20 -15 d 13 Y -20 16 d cl s 1 1 1 c
- 1144 848 m 24 6 d -21 16 d -23 -6 d f black 1144 848 m 24 6 d -21 16 d -23 -6 d
- cl s 1 1 1 c 1121 829 m 23 6 d 13 Y -23 -6 d f black 1121 829 m 23 6 d 13 Y -23
- -6 d cl s 0.6 0.6 0.6 c 1100 844 m 21 -15 d 13 Y -21 16 d f black 1100 844 m 21
- -15 d 13 Y -21 16 d cl s 1 1 1 c 1121 842 m 23 6 d -20 16 d -24 -6 d f black
- 1121 842 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1097 823 m 24 6 d -21 15 d -23
- -6 d f black 1097 823 m 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 1074 817 m 23 6 d
- -20 15 d -24 -6 d f black 1074 817 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1050
- 811 m 24 6 d 40 Y -24 -6 d f black 1050 811 m 24 6 d 40 Y -24 -6 d cl s 0.6 0.6
- 0.6 c 1030 826 m 20 -15 d 40 Y -20 16 d f black 1030 826 m 20 -15 d 40 Y -20 16
- d cl s 1 1 1 c 1050 851 m 24 6 d -21 16 d -23 -6 d f black 1050 851 m 24 6 d
- -21 16 d -23 -6 d cl s 1 1 1 c 1027 805 m 23 6 d -20 15 d -24 -6 d f black 1027
- 805 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1003 799 m 24 6 d -21 15 d -23 -6 d
- f black 1003 799 m 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 980 793 m 23 6 d -20
- 15 d -24 -6 d f black 980 793 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 956 787 m
- 24 6 d -21 15 d -23 -6 d f black 956 787 m 24 6 d -21 15 d -23 -6 d cl s 1 1 1
- c 933 781 m 23 6 d -20 15 d -24 -6 d f black 933 781 m 23 6 d -20 15 d -24 -6 d
- cl s 1 1 1 c 909 775 m 24 6 d -21 15 d -23 -6 d f black 909 775 m 24 6 d -21 15
- d -23 -6 d cl s 1 1 1 c 886 769 m 23 6 d -20 15 d -24 -6 d f black 886 769 m 23
- 6 d -20 15 d -24 -6 d cl s 1 1 1 c 862 763 m 24 6 d -21 15 d -23 -6 d f black
- 862 763 m 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 839 757 m 23 6 d -20 15 d -23
- -6 d f black 839 757 m 23 6 d -20 15 d -23 -6 d cl s 1 1 1 c 815 751 m 24 6 d
- -20 15 d -24 -6 d f black 815 751 m 24 6 d -20 15 d -24 -6 d cl s 1 1 1 c 792
- 745 m 23 6 d -20 15 d -23 -6 d f black 792 745 m 23 6 d -20 15 d -23 -6 d cl s
- 1 1 1 c 1916 1010 m 24 6 d -21 16 d -23 -6 d f black 1916 1010 m 24 6 d -21 16
- d -23 -6 d cl s 1 1 1 c 1893 1004 m 23 6 d -20 16 d -24 -6 d f black 1893 1004
- m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1869 998 m 24 6 d -21 16 d -23 -6 d f
- black 1869 998 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 1846 992 m 23 6 d -20 16
- d -24 -6 d f black 1846 992 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1822 987 m
- 24 5 d -21 16 d -23 -6 d f black 1822 987 m 24 5 d -21 16 d -23 -6 d cl s 1 1 1
- c 1799 981 m 23 6 d -20 15 d -24 -6 d f black 1799 981 m 23 6 d -20 15 d -24 -6
- d cl s 1 1 1 c 1775 975 m 24 6 d 13 Y -24 -6 d f black 1775 975 m 24 6 d 13 Y
- -24 -6 d cl s 0.6 0.6 0.6 c 1755 990 m 20 -15 d 13 Y -20 16 d f black 1755 990
- m 20 -15 d 13 Y -20 16 d cl s 1 1 1 c 1775 988 m 24 6 d -21 16 d -23 -6 d f
- black 1775 988 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 1752 969 m 23 6 d 13 Y
- -23 -6 d f black 1752 969 m 23 6 d 13 Y -23 -6 d cl s 0.6 0.6 0.6 c 1731 984 m
- 21 -15 d 13 Y -21 16 d f black 1731 984 m 21 -15 d 13 Y -21 16 d cl s 1 1 1 c
- 1752 982 m 23 6 d -20 16 d -24 -6 d f black 1752 982 m 23 6 d -20 16 d -24 -6 d
- cl s 1 1 1 c 1728 963 m 24 6 d -21 15 d -23 -6 d f black 1728 963 m 24 6 d -21
- 15 d -23 -6 d cl s 1 1 1 c 1705 957 m 23 6 d -20 15 d -24 -6 d f black 1705 957
- m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1681 951 m 24 6 d 26 Y -24 -5 d f black
- 1681 951 m 24 6 d 26 Y -24 -5 d cl s 0.6 0.6 0.6 c 1661 966 m 20 -15 d 27 Y -20
- 15 d f black 1661 966 m 20 -15 d 27 Y -20 15 d cl s 1 1 1 c 1681 978 m 24 5 d
- -21 16 d -23 -6 d f black 1681 978 m 24 5 d -21 16 d -23 -6 d cl s 1 1 1 c 1658
- 945 m 23 6 d -20 15 d -24 -6 d f black 1658 945 m 23 6 d -20 15 d -24 -6 d cl s
- 1 1 1 c 1634 939 m 24 6 d -21 15 d -23 -6 d f black 1634 939 m 24 6 d -21 15 d
- -23 -6 d cl s 1 1 1 c 1611 933 m 23 6 d -20 15 d -23 -6 d f black 1611 933 m 23
- 6 d -20 15 d -23 -6 d cl s 1 1 1 c 1587 927 m 24 6 d -20 15 d -24 -6 d f black
- 1587 927 m 24 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1564 921 m 23 6 d -20 15 d -23
- -6 d f black 1564 921 m 23 6 d -20 15 d -23 -6 d cl s 1 1 1 c 1540 915 m 24 6 d
- -20 15 d -24 -6 d f black 1540 915 m 24 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1517
- 909 m 23 6 d 13 Y -23 -6 d f black 1517 909 m 23 6 d 13 Y -23 -6 d cl s 0.6 0.6
- 0.6 c 1497 924 m 20 -15 d 13 Y -20 16 d f black 1497 924 m 20 -15 d 13 Y -20 16
- d cl s 1 1 1 c 1517 922 m 23 6 d -20 16 d -23 -6 d f black 1517 922 m 23 6 d
- -20 16 d -23 -6 d cl s 1 1 1 c 1493 903 m 24 6 d -20 15 d -24 -6 d f black 1493
- 903 m 24 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1470 897 m 23 6 d 13 Y -23 -6 d f
- black 1470 897 m 23 6 d 13 Y -23 -6 d cl s 0.6 0.6 0.6 c 1450 912 m 20 -15 d 13
- Y -20 16 d f black 1450 912 m 20 -15 d 13 Y -20 16 d cl s 1 1 1 c 1470 910 m 23
- 6 d -20 16 d -23 -6 d f black 1470 910 m 23 6 d -20 16 d -23 -6 d cl s 1 1 1 c
- 1446 891 m 24 6 d -20 15 d -24 -6 d f black 1446 891 m 24 6 d -20 15 d -24 -6 d
- cl s 1 1 1 c 1423 885 m 23 6 d 13 Y -23 -6 d f black 1423 885 m 23 6 d 13 Y -23
- -6 d cl s 0.6 0.6 0.6 c 1403 900 m 20 -15 d 13 Y -20 16 d f black 1403 900 m 20
- -15 d 13 Y -20 16 d cl s 1 1 1 c 1423 898 m 23 6 d -20 16 d -23 -6 d f black
- 1423 898 m 23 6 d -20 16 d -23 -6 d cl s 1 1 1 c 1399 879 m 24 6 d 27 Y -24 -6
- d f black 1399 879 m 24 6 d 27 Y -24 -6 d cl s 0.6 0.6 0.6 c 1379 894 m 20 -15
- d 27 Y -20 15 d f black 1379 894 m 20 -15 d 27 Y -20 15 d cl s 1 1 1 c 1399 906
- m 24 6 d -20 15 d -24 -6 d f black 1399 906 m 24 6 d -20 15 d -24 -6 d cl s 1 1
- 1 c 1376 873 m 23 6 d -20 15 d -23 -6 d f black 1376 873 m 23 6 d -20 15 d -23
- -6 d cl s 1 1 1 c 1352 867 m 24 6 d -20 15 d -24 -6 d f black 1352 867 m 24 6 d
- -20 15 d -24 -6 d cl s 1 1 1 c 1329 861 m 23 6 d -20 15 d -23 -6 d f black 1329
- 861 m 23 6 d -20 15 d -23 -6 d cl s 1 1 1 c 1305 855 m 24 6 d -20 15 d -24 -5 d
- f black 1305 855 m 24 6 d -20 15 d -24 -5 d cl s 1 1 1 c 1282 849 m 23 6 d -20
- 16 d -23 -6 d f black 1282 849 m 23 6 d -20 16 d -23 -6 d cl s 1 1 1 c 1259 843
- m 23 6 d -20 16 d -24 -6 d f black 1259 843 m 23 6 d -20 16 d -24 -6 d cl s 1 1
- 1 c 1235 837 m 24 6 d 13 Y -24 -6 d f black 1235 837 m 24 6 d 13 Y -24 -6 d
- cl s 0.6 0.6 0.6 c 1215 853 m 20 -16 d 13 Y -20 16 d f black 1215 853 m 20 -16
- d 13 Y -20 16 d cl s 1 1 1 c 1235 850 m 24 6 d -21 16 d -23 -6 d f black 1235
- 850 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 1212 831 m 23 6 d -20 16 d -24 -6 d
- f black 1212 831 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1188 825 m 24 6 d -21
- 16 d -23 -6 d f black 1188 825 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 1165 819
- m 23 6 d 14 Y -23 -6 d f black 1165 819 m 23 6 d 14 Y -23 -6 d cl s 0.6 0.6 0.6
- c 1144 835 m 21 -16 d 14 Y -21 15 d f black 1144 835 m 21 -16 d 14 Y -21 15 d
- cl s 1 1 1 c 1165 833 m 23 6 d -20 15 d -24 -6 d f black 1165 833 m 23 6 d -20
- 15 d -24 -6 d cl s 1 1 1 c 1141 813 m 24 6 d -21 16 d -23 -6 d f black 1141 813
- m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 1118 807 m 23 6 d -20 16 d -24 -6 d f
- black 1118 807 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1094 801 m 24 6 d -21 16
- d -23 -6 d f black 1094 801 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 1071 795 m
- 23 6 d 14 Y -23 -6 d f black 1071 795 m 23 6 d 14 Y -23 -6 d cl s 0.6 0.6 0.6 c
- 1050 811 m 21 -16 d 14 Y -21 15 d f black 1050 811 m 21 -16 d 14 Y -21 15 d
- cl s 1 1 1 c 1071 809 m 23 6 d -20 15 d -24 -6 d f black 1071 809 m 23 6 d -20
- 15 d -24 -6 d cl s 1 1 1 c 1047 789 m 24 6 d -21 16 d -23 -6 d f black 1047 789
- m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 1024 783 m 23 6 d 14 Y -23 -6 d f black
- 1024 783 m 23 6 d 14 Y -23 -6 d cl s 0.6 0.6 0.6 c 1003 799 m 21 -16 d 14 Y -21
- 15 d f black 1003 799 m 21 -16 d 14 Y -21 15 d cl s 1 1 1 c 1024 797 m 23 6 d
- -20 15 d -24 -6 d f black 1024 797 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1000
- 777 m 24 6 d -21 16 d -23 -6 d f black 1000 777 m 24 6 d -21 16 d -23 -6 d cl s
- 1 1 1 c 977 771 m 23 6 d -20 16 d -24 -6 d f black 977 771 m 23 6 d -20 16 d
- -24 -6 d cl s 1 1 1 c 953 765 m 24 6 d -21 16 d -23 -6 d f black 953 765 m 24 6
- d -21 16 d -23 -6 d cl s 1 1 1 c 930 759 m 23 6 d -20 16 d -24 -6 d f black 930
- 759 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 906 753 m 24 6 d -21 16 d -23 -6 d
- f black 906 753 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 883 747 m 23 6 d -20 16
- d -24 -6 d f black 883 747 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 859 741 m 24
- 6 d -21 16 d -23 -6 d f black 859 741 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c
- 836 735 m 23 6 d -20 16 d -24 -6 d f black 836 735 m 23 6 d -20 16 d -24 -6 d
- cl s 1 1 1 c 812 729 m 24 6 d -21 16 d -23 -6 d f black 812 729 m 24 6 d -21 16
- d -23 -6 d cl s 1 1 1 c 1937 995 m 23 6 d -20 15 d -24 -6 d f black 1937 995 m
- 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1913 989 m 24 6 d -21 15 d -23 -6 d f
- black 1913 989 m 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 1890 983 m 23 6 d -20 15
- d -24 -6 d f black 1890 983 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1866 977 m
- 24 6 d -21 15 d -23 -6 d f black 1866 977 m 24 6 d -21 15 d -23 -6 d cl s 1 1 1
- c 1843 971 m 23 6 d -20 15 d -24 -5 d f black 1843 971 m 23 6 d -20 15 d -24 -5
- d cl s 1 1 1 c 1819 965 m 24 6 d -21 16 d -23 -6 d f black 1819 965 m 24 6 d
- -21 16 d -23 -6 d cl s 1 1 1 c 1796 959 m 23 6 d -20 16 d -24 -6 d f black 1796
- 959 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1772 953 m 24 6 d -21 16 d -23 -6 d
- f black 1772 953 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 1749 947 m 23 6 d 13 Y
- -23 -5 d f black 1749 947 m 23 6 d 13 Y -23 -5 d cl s 0.6 0.6 0.6 c 1728 963 m
- 21 -16 d 14 Y -21 15 d f black 1728 963 m 21 -16 d 14 Y -21 15 d cl s 1 1 1 c
- 1749 961 m 23 5 d -20 16 d -24 -6 d f black 1749 961 m 23 5 d -20 16 d -24 -6 d
- cl s 1 1 1 c 1725 941 m 24 6 d -21 16 d -23 -6 d f black 1725 941 m 24 6 d -21
- 16 d -23 -6 d cl s 1 1 1 c 1702 935 m 23 6 d -20 16 d -24 -6 d f black 1702 935
- m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1678 929 m 24 6 d -21 16 d -23 -6 d f
- black 1678 929 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 1655 923 m 23 6 d -20 16
- d -24 -6 d f black 1655 923 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1631 917 m
- 24 6 d -21 16 d -23 -6 d f black 1631 917 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1
- c 1608 911 m 23 6 d -20 16 d -24 -6 d f black 1608 911 m 23 6 d -20 16 d -24 -6
- d cl s 1 1 1 c 1584 905 m 24 6 d -21 16 d -23 -6 d f black 1584 905 m 24 6 d
- -21 16 d -23 -6 d cl s 1 1 1 c 1561 899 m 23 6 d -20 16 d -24 -6 d f black 1561
- 899 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1537 893 m 24 6 d -21 16 d -23 -6 d
- f black 1537 893 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 1514 887 m 23 6 d -20
- 16 d -24 -6 d f black 1514 887 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1490 881
- m 24 6 d -21 16 d -23 -6 d f black 1490 881 m 24 6 d -21 16 d -23 -6 d cl s 1 1
- 1 c 1467 875 m 23 6 d -20 16 d -24 -6 d f black 1467 875 m 23 6 d -20 16 d -24
- -6 d cl s 1 1 1 c 1443 869 m 24 6 d -21 16 d -23 -6 d f black 1443 869 m 24 6 d
- -21 16 d -23 -6 d cl s 1 1 1 c 1420 863 m 23 6 d -20 16 d -24 -6 d f black 1420
- 863 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1396 857 m 24 6 d -21 16 d -23 -6 d
- f black 1396 857 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 1373 851 m 23 6 d -20
- 16 d -24 -6 d f black 1373 851 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1349 845
- m 24 6 d 14 Y -24 -6 d f black 1349 845 m 24 6 d 14 Y -24 -6 d cl s 0.6 0.6 0.6
- c 1329 861 m 20 -16 d 14 Y -20 15 d f black 1329 861 m 20 -16 d 14 Y -20 15 d
- cl s 1 1 1 c 1349 859 m 24 6 d -21 15 d -23 -6 d f black 1349 859 m 24 6 d -21
- 15 d -23 -6 d cl s 1 1 1 c 1326 839 m 23 6 d -20 16 d -24 -6 d f black 1326 839
- m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1302 833 m 24 6 d -21 16 d -23 -6 d f
- black 1302 833 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 1279 827 m 23 6 d -20 16
- d -23 -6 d f black 1279 827 m 23 6 d -20 16 d -23 -6 d cl s 1 1 1 c 1255 821 m
- 24 6 d 14 Y -24 -6 d f black 1255 821 m 24 6 d 14 Y -24 -6 d cl s 0.6 0.6 0.6 c
- 1235 837 m 20 -16 d 14 Y -20 15 d f black 1235 837 m 20 -16 d 14 Y -20 15 d
- cl s 1 1 1 c 1255 835 m 24 6 d -20 15 d -24 -6 d f black 1255 835 m 24 6 d -20
- 15 d -24 -6 d cl s 1 1 1 c 1232 816 m 23 5 d -20 16 d -23 -6 d f black 1232 816
- m 23 5 d -20 16 d -23 -6 d cl s 1 1 1 c 1208 810 m 24 6 d -20 15 d -24 -6 d f
- black 1208 810 m 24 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1185 804 m 23 6 d -20 15
- d -23 -6 d f black 1185 804 m 23 6 d -20 15 d -23 -6 d cl s 1 1 1 c 1161 798 m
- 24 6 d -20 15 d -24 -6 d f black 1161 798 m 24 6 d -20 15 d -24 -6 d cl s 1 1 1
- c 1138 792 m 23 6 d -20 15 d -23 -6 d f black 1138 792 m 23 6 d -20 15 d -23 -6
- d cl s 1 1 1 c 1114 786 m 24 6 d -20 15 d -24 -6 d f black 1114 786 m 24 6 d
- -20 15 d -24 -6 d cl s 1 1 1 c 1091 780 m 23 6 d -20 15 d -23 -6 d f black 1091
- 780 m 23 6 d -20 15 d -23 -6 d cl s 1 1 1 c 1067 774 m 24 6 d -20 15 d -24 -6 d
- f black 1067 774 m 24 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1044 768 m 23 6 d -20
- 15 d -23 -6 d f black 1044 768 m 23 6 d -20 15 d -23 -6 d cl s 1 1 1 c 1020 762
- m 24 6 d -20 15 d -24 -6 d f black 1020 762 m 24 6 d -20 15 d -24 -6 d cl s 1 1
- 1 c 997 756 m 23 6 d -20 15 d -23 -6 d f black 997 756 m 23 6 d -20 15 d -23 -6
- d cl s 1 1 1 c 973 750 m 24 6 d -20 15 d -24 -6 d f black 973 750 m 24 6 d -20
- 15 d -24 -6 d cl s 1 1 1 c 950 744 m 23 6 d -20 15 d -23 -6 d f black 950 744 m
- 23 6 d -20 15 d -23 -6 d cl s 1 1 1 c 927 738 m 23 6 d -20 15 d -24 -6 d f
- black 927 738 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 903 732 m 24 6 d -21 15 d
- -23 -6 d f black 903 732 m 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 880 726 m 23 6
- d -20 15 d -24 -6 d f black 880 726 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 856
- 720 m 24 6 d -21 15 d -23 -6 d f black 856 720 m 24 6 d -21 15 d -23 -6 d cl s
- 1 1 1 c 833 714 m 23 6 d -20 15 d -24 -6 d f black 833 714 m 23 6 d -20 15 d
- -24 -6 d cl s 1 1 1 c 1957 979 m 23 6 d -20 16 d -23 -6 d f black 1957 979 m 23
- 6 d -20 16 d -23 -6 d cl s 1 1 1 c 1933 973 m 24 6 d -20 16 d -24 -6 d f black
- 1933 973 m 24 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1910 967 m 23 6 d -20 16 d -23
- -6 d f black 1910 967 m 23 6 d -20 16 d -23 -6 d cl s 1 1 1 c 1886 961 m 24 6 d
- -20 16 d -24 -6 d f black 1886 961 m 24 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1863
- 955 m 23 6 d -20 16 d -23 -6 d f black 1863 955 m 23 6 d -20 16 d -23 -6 d cl s
- 1 1 1 c 1839 949 m 24 6 d -20 16 d -24 -6 d f black 1839 949 m 24 6 d -20 16 d
- -24 -6 d cl s 1 1 1 c 1816 943 m 23 6 d -20 16 d -23 -6 d f black 1816 943 m 23
- 6 d -20 16 d -23 -6 d cl s 1 1 1 c 1792 938 m 24 5 d -20 16 d -24 -6 d f black
- 1792 938 m 24 5 d -20 16 d -24 -6 d cl s 1 1 1 c 1769 932 m 23 6 d -20 15 d -23
- -6 d f black 1769 932 m 23 6 d -20 15 d -23 -6 d cl s 1 1 1 c 1745 926 m 24 6 d
- -20 15 d -24 -6 d f black 1745 926 m 24 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1722
- 920 m 23 6 d -20 15 d -23 -6 d f black 1722 920 m 23 6 d -20 15 d -23 -6 d cl s
- 1 1 1 c 1699 914 m 23 6 d -20 15 d -24 -6 d f black 1699 914 m 23 6 d -20 15 d
- -24 -6 d cl s 1 1 1 c 1675 908 m 24 6 d -21 15 d -23 -6 d f black 1675 908 m 24
- 6 d -21 15 d -23 -6 d cl s 1 1 1 c 1652 902 m 23 6 d -20 15 d -24 -6 d f black
- 1652 902 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1628 896 m 24 6 d -21 15 d -23
- -6 d f black 1628 896 m 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 1605 890 m 23 6 d
- -20 15 d -24 -6 d f black 1605 890 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1581
- 884 m 24 6 d -21 15 d -23 -6 d f black 1581 884 m 24 6 d -21 15 d -23 -6 d cl s
- 1 1 1 c 1558 878 m 23 6 d -20 15 d -24 -6 d f black 1558 878 m 23 6 d -20 15 d
- -24 -6 d cl s 1 1 1 c 1534 872 m 24 6 d -21 15 d -23 -6 d f black 1534 872 m 24
- 6 d -21 15 d -23 -6 d cl s 1 1 1 c 1511 866 m 23 6 d -20 15 d -24 -6 d f black
- 1511 866 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1487 860 m 24 6 d 13 Y -24 -6
- d f black 1487 860 m 24 6 d 13 Y -24 -6 d cl s 0.6 0.6 0.6 c 1467 875 m 20 -15
- d 13 Y -20 16 d f black 1467 875 m 20 -15 d 13 Y -20 16 d cl s 1 1 1 c 1487 873
- m 24 6 d -21 16 d -23 -6 d f black 1487 873 m 24 6 d -21 16 d -23 -6 d cl s 1 1
- 1 c 1464 854 m 23 6 d -20 15 d -24 -6 d f black 1464 854 m 23 6 d -20 15 d -24
- -6 d cl s 1 1 1 c 1440 848 m 24 6 d -21 15 d -23 -6 d f black 1440 848 m 24 6 d
- -21 15 d -23 -6 d cl s 1 1 1 c 1417 842 m 23 6 d -20 15 d -24 -6 d f black 1417
- 842 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1393 836 m 24 6 d -21 15 d -23 -6 d
- f black 1393 836 m 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 1370 830 m 23 6 d -20
- 15 d -24 -6 d f black 1370 830 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1346 824
- m 24 6 d -21 15 d -23 -6 d f black 1346 824 m 24 6 d -21 15 d -23 -6 d cl s 1 1
- 1 c 1323 818 m 23 6 d -20 15 d -24 -6 d f black 1323 818 m 23 6 d -20 15 d -24
- -6 d cl s 1 1 1 c 1299 812 m 24 6 d -21 15 d -23 -6 d f black 1299 812 m 24 6 d
- -21 15 d -23 -6 d cl s 1 1 1 c 1276 806 m 23 6 d -20 15 d -24 -6 d f black 1276
- 806 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1252 800 m 24 6 d -21 15 d -23 -5 d
- f black 1252 800 m 24 6 d -21 15 d -23 -5 d cl s 1 1 1 c 1229 794 m 23 6 d -20
- 16 d -24 -6 d f black 1229 794 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1205 788
- m 24 6 d -21 16 d -23 -6 d f black 1205 788 m 24 6 d -21 16 d -23 -6 d cl s 1 1
- 1 c 1182 782 m 23 6 d -20 16 d -24 -6 d f black 1182 782 m 23 6 d -20 16 d -24
- -6 d cl s 1 1 1 c 1158 776 m 24 6 d -21 16 d -23 -6 d f black 1158 776 m 24 6 d
- -21 16 d -23 -6 d cl s 1 1 1 c 1135 770 m 23 6 d -20 16 d -24 -6 d f black 1135
- 770 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1111 764 m 24 6 d -21 16 d -23 -6 d
- f black 1111 764 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 1088 758 m 23 6 d -20
- 16 d -24 -6 d f black 1088 758 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1064 752
- m 24 6 d -21 16 d -23 -6 d f black 1064 752 m 24 6 d -21 16 d -23 -6 d cl s 1 1
- 1 c 1041 746 m 23 6 d -20 16 d -24 -6 d f black 1041 746 m 23 6 d -20 16 d -24
- -6 d cl s 1 1 1 c 1017 740 m 24 6 d 14 Y -24 -6 d f black 1017 740 m 24 6 d 14
- Y -24 -6 d cl s 0.6 0.6 0.6 c 997 756 m 20 -16 d 14 Y -20 15 d f black 997 756
- m 20 -16 d 14 Y -20 15 d cl s 1 1 1 c 1017 754 m 24 6 d -21 15 d -23 -6 d f
- black 1017 754 m 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 994 734 m 23 6 d -20 16
- d -24 -6 d f black 994 734 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 970 728 m 24
- 6 d -21 16 d -23 -6 d f black 970 728 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c
- 947 722 m 23 6 d -20 16 d -23 -6 d f black 947 722 m 23 6 d -20 16 d -23 -6 d
- cl s 1 1 1 c 923 716 m 24 6 d -20 16 d -24 -6 d f black 923 716 m 24 6 d -20 16
- d -24 -6 d cl s 1 1 1 c 900 710 m 23 6 d -20 16 d -23 -6 d f black 900 710 m 23
- 6 d -20 16 d -23 -6 d cl s 1 1 1 c 876 704 m 24 6 d -20 16 d -24 -6 d f black
- 876 704 m 24 6 d -20 16 d -24 -6 d cl s 1 1 1 c 853 698 m 23 6 d -20 16 d -23
- -6 d f black 853 698 m 23 6 d -20 16 d -23 -6 d cl s 1 1 1 c 1977 964 m 24 6 d
- -21 15 d -23 -6 d f black 1977 964 m 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 1954
- 958 m 23 6 d -20 15 d -24 -6 d f black 1954 958 m 23 6 d -20 15 d -24 -6 d cl s
- 1 1 1 c 1930 952 m 24 6 d -21 15 d -23 -6 d f black 1930 952 m 24 6 d -21 15 d
- -23 -6 d cl s 1 1 1 c 1907 946 m 23 6 d -20 15 d -24 -6 d f black 1907 946 m 23
- 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1883 940 m 24 6 d -21 15 d -23 -6 d f black
- 1883 940 m 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 1860 934 m 23 6 d -20 15 d -24
- -6 d f black 1860 934 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1836 928 m 24 6 d
- 13 Y -24 -6 d f black 1836 928 m 24 6 d 13 Y -24 -6 d cl s 0.6 0.6 0.6 c 1816
- 943 m 20 -15 d 13 Y -20 16 d f black 1816 943 m 20 -15 d 13 Y -20 16 d cl s 1 1
- 1 c 1836 941 m 24 6 d -21 16 d -23 -6 d f black 1836 941 m 24 6 d -21 16 d -23
- -6 d cl s 1 1 1 c 1813 922 m 23 6 d -20 15 d -24 -5 d f black 1813 922 m 23 6 d
- -20 15 d -24 -5 d cl s 1 1 1 c 1789 916 m 24 6 d -21 16 d -23 -6 d f black 1789
- 916 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 1766 910 m 23 6 d -20 16 d -24 -6 d
- f black 1766 910 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1742 904 m 24 6 d -21
- 16 d -23 -6 d f black 1742 904 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 1719 898
- m 23 6 d -20 16 d -23 -6 d f black 1719 898 m 23 6 d -20 16 d -23 -6 d cl s 1 1
- 1 c 1695 892 m 24 6 d -20 16 d -24 -6 d f black 1695 892 m 24 6 d -20 16 d -24
- -6 d cl s 1 1 1 c 1672 886 m 23 6 d -20 16 d -23 -6 d f black 1672 886 m 23 6 d
- -20 16 d -23 -6 d cl s 1 1 1 c 1648 880 m 24 6 d -20 16 d -24 -6 d f black 1648
- 880 m 24 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1625 874 m 23 6 d -20 16 d -23 -6 d
- f black 1625 874 m 23 6 d -20 16 d -23 -6 d cl s 1 1 1 c 1601 868 m 24 6 d -20
- 16 d -24 -6 d f black 1601 868 m 24 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1578 862
- m 23 6 d 14 Y -23 -6 d f black 1578 862 m 23 6 d 14 Y -23 -6 d cl s 0.6 0.6 0.6
- c 1558 878 m 20 -16 d 14 Y -20 15 d f black 1558 878 m 20 -16 d 14 Y -20 15 d
- cl s 1 1 1 c 1578 876 m 23 6 d -20 15 d -23 -6 d f black 1578 876 m 23 6 d -20
- 15 d -23 -6 d cl s 1 1 1 c 1554 856 m 24 6 d -20 16 d -24 -6 d f black 1554 856
- m 24 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1531 850 m 23 6 d -20 16 d -23 -6 d f
- black 1531 850 m 23 6 d -20 16 d -23 -6 d cl s 1 1 1 c 1507 844 m 24 6 d -20 16
- d -24 -6 d f black 1507 844 m 24 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1484 838 m
- 23 6 d -20 16 d -23 -6 d f black 1484 838 m 23 6 d -20 16 d -23 -6 d cl s 1 1 1
- c 1460 832 m 24 6 d -20 16 d -24 -6 d f black 1460 832 m 24 6 d -20 16 d -24 -6
- d cl s 1 1 1 c 1437 826 m 23 6 d -20 16 d -23 -6 d f black 1437 826 m 23 6 d
- -20 16 d -23 -6 d cl s 1 1 1 c 1413 820 m 24 6 d -20 16 d -24 -6 d f black 1413
- 820 m 24 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1390 814 m 23 6 d -20 16 d -23 -6 d
- f black 1390 814 m 23 6 d -20 16 d -23 -6 d cl s 1 1 1 c 1367 808 m 23 6 d -20
- 16 d -24 -6 d f black 1367 808 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1343 802
- m 24 6 d -21 16 d -23 -6 d f black 1343 802 m 24 6 d -21 16 d -23 -6 d cl s 1 1
- 1 c 1320 796 m 23 6 d -20 16 d -24 -6 d f black 1320 796 m 23 6 d -20 16 d -24
- -6 d cl s 1 1 1 c 1296 790 m 24 6 d -21 16 d -23 -6 d f black 1296 790 m 24 6 d
- -21 16 d -23 -6 d cl s 1 1 1 c 1273 784 m 23 6 d -20 16 d -24 -6 d f black 1273
- 784 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1249 778 m 24 6 d -21 16 d -23 -6 d
- f black 1249 778 m 24 6 d -21 16 d -23 -6 d cl s 1 1 1 c 1226 772 m 23 6 d -20
- 16 d -24 -6 d f black 1226 772 m 23 6 d -20 16 d -24 -6 d cl s 1 1 1 c 1202 767
- m 24 5 d -21 16 d -23 -6 d f black 1202 767 m 24 5 d -21 16 d -23 -6 d cl s 1 1
- 1 c 1179 761 m 23 6 d -20 15 d -24 -6 d f black 1179 761 m 23 6 d -20 15 d -24
- -6 d cl s 1 1 1 c 1155 755 m 24 6 d -21 15 d -23 -6 d f black 1155 755 m 24 6 d
- -21 15 d -23 -6 d cl s 1 1 1 c 1132 749 m 23 6 d -20 15 d -24 -6 d f black 1132
- 749 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1108 743 m 24 6 d -21 15 d -23 -6 d
- f black 1108 743 m 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 1085 737 m 23 6 d -20
- 15 d -24 -6 d f black 1085 737 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 1061 731
- m 24 6 d -21 15 d -23 -6 d f black 1061 731 m 24 6 d -21 15 d -23 -6 d cl s 1 1
- 1 c 1038 725 m 23 6 d -20 15 d -24 -6 d f black 1038 725 m 23 6 d -20 15 d -24
- -6 d cl s 1 1 1 c 1014 719 m 24 6 d -21 15 d -23 -6 d f black 1014 719 m 24 6 d
- -21 15 d -23 -6 d cl s 1 1 1 c 991 713 m 23 6 d -20 15 d -24 -6 d f black 991
- 713 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 967 707 m 24 6 d -21 15 d -23 -6 d
- f black 967 707 m 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c 944 701 m 23 6 d -20 15
- d -24 -6 d f black 944 701 m 23 6 d -20 15 d -24 -6 d cl s 1 1 1 c 920 695 m 24
- 6 d -21 15 d -23 -6 d f black 920 695 m 24 6 d -21 15 d -23 -6 d cl s 1 1 1 c
- 897 689 m 23 6 d -20 15 d -24 -6 d f black 897 689 m 23 6 d -20 15 d -24 -6 d
- cl s 1 1 1 c 873 683 m 24 6 d -21 15 d -23 -6 d f black 873 683 m 24 6 d -21 15
- d -23 -6 d cl s 222 1180 m 651 -497 d s 873 683 m 994 Y s 222 2174 m 651 -497 d
- s 222 1180 m 994 Y s 873 683 m 1128 287 d s 2001 970 m 994 Y s 873 1677 m 1128
- 287 d s 873 1677 m cl s 873 683 m 1128 287 d s 967 673 m 34 Y s 991 696 m 17 Y
- s 1014 702 m 17 Y s 1038 708 m 17 Y s 1061 714 m 17 Y s 1085 703 m 34 Y s 1108
- 726 m 17 Y s 1132 732 m 17 Y s 1155 738 m 17 Y s 1179 744 m 17 Y s 1202 733 m
- 34 Y s 1226 756 m 16 Y s 1249 762 m 16 Y s 1273 768 m 16 Y s 1296 774 m 16 Y s
- 1320 763 m 33 Y s 1343 786 m 16 Y s 1367 792 m 16 Y s 1390 798 m 16 Y s 1413
- 804 m 16 Y s 1437 793 m 33 Y s 1460 816 m 16 Y s 1484 822 m 16 Y s 1507 828 m
- 16 Y s 1531 834 m 16 Y s 1554 823 m 33 Y s 1578 846 m 16 Y s 1601 851 m 17 Y s
- 1625 857 m 17 Y s 1648 863 m 17 Y s 1672 853 m 33 Y s 1695 875 m 17 Y s 1719
- 881 m 17 Y s 1742 887 m 17 Y s 1766 893 m 17 Y s 1789 883 m 33 Y s 1813 905 m
- 17 Y s 1836 911 m 17 Y s 1860 917 m 17 Y s 1883 923 m 17 Y s 1907 913 m 33 Y s
- 967 673 m 34 Y s 944 684 m 17 Y s 920 678 m 17 Y s 897 672 m 17 Y s 873 666 m
- 17 Y s 1907 913 m 33 Y s 1930 935 m 17 Y s 1954 941 m 17 Y s 1977 947 m 17 Y s
- 2001 953 m 17 Y s 970 654 m -5 -1 d -3 -4 d -1 -8 d -4 Y 1 -8 d 3 -4 d 5 -2 d 3
- X 4 2 d 3 4 d 1 8 d 4 Y -1 8 d -3 4 d -4 1 d -3 X cl s 1061 684 m -4 -1 d -3 -5
- d -1 -7 d -4 Y 1 -8 d 3 -4 d 4 -2 d 3 X 5 2 d 3 4 d 1 8 d 4 Y -1 7 d -3 5 d -5
- 1 d -3 X cl s 1085 656 m -1 -1 d 1 -2 d 2 2 d -2 1 d cl s 1099 677 m 1 Y 1 3 d
- 1 2 d 3 1 d 6 X 3 -1 d 2 -2 d 1 -3 d -3 Y -1 -2 d -3 -5 d -15 -15 d 21 X s 1144
- 684 m -14 X -2 -13 d 2 2 d 4 1 d 5 X 4 -1 d 3 -3 d 1 -5 d -3 Y -1 -4 d -3 -3 d
- -4 -2 d -5 X -4 2 d -2 1 d -1 3 d s 1190 714 m -5 -1 d -3 -5 d -1 -7 d -5 Y 1
- -7 d 3 -4 d 5 -2 d 3 X 4 2 d 3 4 d 2 7 d 5 Y -2 7 d -3 5 d -4 1 d -3 X cl s
- 1214 686 m -2 -1 d 2 -2 d 1 2 d -1 1 d cl s 1243 714 m -15 X -1 -13 d 1 1 d 5 2
- d 4 X 5 -2 d 3 -3 d 1 -4 d -3 Y -1 -4 d -3 -3 d -5 -2 d -4 X -5 2 d -1 1 d -2 3
- d s 1296 744 m -4 -1 d -3 -5 d -2 -7 d -5 Y 2 -7 d 3 -4 d 4 -2 d 3 X 5 2 d 3 4
- d 1 7 d 5 Y -1 7 d -3 5 d -5 1 d -3 X cl s 1320 716 m -1 -1 d 1 -2 d 2 2 d -2 1
- d cl s 1353 744 m -15 -31 d s 1332 744 m 21 X s 1379 744 m -14 X -2 -13 d 2 1 d
- 4 2 d 4 X 5 -2 d 3 -3 d 1 -4 d -3 Y -1 -5 d -3 -2 d -5 -2 d -4 X -4 2 d -2 1 d
- -1 3 d s 1435 768 m 3 2 d 4 4 d -31 Y s 1527 798 m 3 2 d 4 4 d -31 Y s 1555 776
- m -2 -2 d 2 -1 d 1 1 d -1 2 d cl s 1568 797 m 1 Y 2 3 d 1 1 d 3 2 d 6 X 3 -2 d
- 2 -1 d 1 -3 d -3 Y -1 -3 d -3 -4 d -15 -15 d 21 X s 1614 804 m -15 X -1 -13 d 1
- 1 d 5 2 d 4 X 5 -2 d 3 -3 d 1 -4 d -3 Y -1 -5 d -3 -3 d -5 -1 d -4 X -5 1 d -1
- 2 d -2 3 d s 1655 828 m 3 1 d 5 5 d -31 Y s 1683 806 m -1 -2 d 1 -1 d 2 1 d -2
- 2 d cl s 1713 834 m -15 X -1 -13 d 1 1 d 5 1 d 4 X 5 -1 d 3 -3 d 1 -4 d -3 Y -1
- -5 d -3 -3 d -5 -1 d -4 X -5 1 d -1 2 d -2 3 d s 1762 858 m 3 1 d 4 5 d -31 Y s
- 1790 836 m -2 -2 d 2 -1 d 1 1 d -1 2 d cl s 1822 864 m -14 -31 d s 1802 864 m
- 20 X s 1849 864 m -15 X -1 -14 d 1 2 d 5 1 d 4 X 5 -1 d 3 -3 d 1 -5 d -2 Y -1
- -5 d -3 -3 d -5 -1 d -4 X -5 1 d -1 2 d -2 3 d s 1902 886 m 2 Y 1 3 d 2 1 d 3 2
- d 6 X 3 -2 d 1 -1 d 1 -3 d -3 Y -1 -3 d -3 -5 d -15 -14 d 21 X s 873 683 m -651
- 497 d s 873 649 m 34 Y s 857 679 m 16 Y s 841 691 m 17 Y s 824 703 m 17 Y s 808
- 716 m 17 Y s 792 712 m 33 Y s 776 741 m 16 Y s 759 753 m 17 Y s 743 766 m 16 Y
- s 727 778 m 17 Y s 711 774 m 33 Y s 694 803 m 17 Y s 678 815 m 17 Y s 662 828 m
- 16 Y s 645 840 m 17 Y s 629 836 m 33 Y s 613 865 m 17 Y s 597 877 m 17 Y s 580
- 890 m 17 Y s 564 902 m 17 Y s 548 898 m 33 Y s 532 927 m 17 Y s 515 940 m 16 Y
- s 499 952 m 17 Y s 483 964 m 17 Y s 466 960 m 33 Y s 450 989 m 17 Y s 434 1002
- m 16 Y s 418 1014 m 17 Y s 401 1027 m 16 Y s 385 1022 m 34 Y s 369 1051 m 17 Y
- s 352 1064 m 16 Y s 336 1076 m 17 Y s 320 1089 m 16 Y s 304 1084 m 34 Y s 287
- 1114 m 16 Y s 271 1126 m 17 Y s 255 1138 m 17 Y s 239 1151 m 16 Y s 222 1147 m
- 33 Y s 873 649 m 34 Y s 826 573 m 27 X s 865 583 m 2 Y 1 3 d 2 1 d 3 2 d 6 X 3
- -2 d 1 -1 d 2 -3 d -3 Y -2 -3 d -3 -5 d -15 -15 d 21 X s 704 635 m 26 X s 745
- 647 m 3 1 d 5 5 d -31 Y s 773 625 m -1 -2 d 1 -1 d 2 1 d -2 2 d cl s 803 653 m
- -15 X -1 -14 d 1 2 d 5 1 d 4 X 5 -1 d 2 -3 d 2 -5 d -3 Y -2 -4 d -2 -3 d -5 -1
- d -4 X -5 1 d -1 2 d -2 2 d s 663 697 m 27 X s 705 709 m 3 1 d 4 5 d -31 Y s
- 541 759 m 27 X s 587 777 m -5 -2 d -2 -4 d -2 -7 d -5 Y 2 -7 d 2 -5 d 5 -1 d 3
- X 4 1 d 3 5 d 2 7 d 5 Y -2 7 d -3 4 d -4 2 d -3 X cl s 611 749 m -2 -2 d 2 -1 d
- 1 1 d -1 2 d cl s 640 777 m -15 X -1 -13 d 1 1 d 5 2 d 4 X 5 -2 d 3 -3 d 1 -4 d
- -3 Y -1 -5 d -3 -3 d -5 -1 d -4 X -5 1 d -1 2 d -2 3 d s 537 839 m -5 -1 d -3
- -5 d -1 -7 d -5 Y 1 -7 d 3 -5 d 5 -1 d 3 X 4 1 d 3 5 d 2 7 d 5 Y -2 7 d -3 5 d
- -4 1 d -3 X cl s 414 901 m -4 -1 d -3 -5 d -2 -7 d -5 Y 2 -7 d 3 -4 d 4 -2 d 3
- X 5 2 d 3 4 d 1 7 d 5 Y -1 7 d -3 5 d -5 1 d -3 X cl s 438 873 m -1 -1 d 1 -2 d
- 2 2 d -2 1 d cl s 468 901 m -15 X -2 -13 d 2 1 d 4 2 d 5 X 4 -2 d 3 -3 d 2 -4 d
- -3 Y -2 -4 d -3 -3 d -4 -2 d -5 X -4 2 d -2 1 d -1 3 d s 370 957 m 3 2 d 4 4 d
- -31 Y s 247 1020 m 3 1 d 5 5 d -32 Y s 275 997 m -1 -1 d 1 -2 d 2 2 d -2 1 d cl
- s 305 1026 m -15 X -1 -14 d 1 2 d 5 1 d 4 X 4 -1 d 3 -3 d 2 -5 d -3 Y -2 -4 d
- -3 -3 d -4 -2 d -4 X -5 2 d -1 1 d -2 3 d s 204 1080 m 2 Y 1 3 d 2 1 d 3 2 d 6
- X 3 -2 d 1 -1 d 2 -3 d -3 Y -2 -3 d -3 -5 d -15 -14 d 21 X s 222 1180 m 994 Y s
- 189 1180 m 33 X s 206 1207 m 16 X s 206 1234 m 16 X s 206 1261 m 16 X s 206
- 1287 m 16 X s 189 1314 m 33 X s 206 1341 m 16 X s 206 1368 m 16 X s 206 1395 m
- 16 X s 206 1422 m 16 X s 189 1449 m 33 X s 206 1476 m 16 X s 206 1502 m 16 X s
- 206 1529 m 16 X s 206 1556 m 16 X s 189 1583 m 33 X s 206 1610 m 16 X s 206
- 1637 m 16 X s 206 1664 m 16 X s 206 1690 m 16 X s 189 1717 m 33 X s 206 1744 m
- 16 X s 206 1771 m 16 X s 206 1798 m 16 X s 206 1825 m 16 X s 189 1852 m 33 X s
- 206 1879 m 16 X s 206 1905 m 16 X s 206 1932 m 16 X s 206 1959 m 16 X s 189
- 1986 m 33 X s 206 2013 m 16 X s 206 2040 m 16 X s 206 2067 m 16 X s 206 2094 m
- 16 X s 189 2120 m 33 X s 189 2120 m 33 X s 206 2147 m 16 X s 150 1195 m -4 -1 d
- -3 -4 d -1 -8 d -4 Y 1 -8 d 3 -4 d 4 -2 d 3 X 5 2 d 3 4 d 1 8 d 4 Y -1 8 d -3 4
- d -5 1 d -3 X cl s 116 1324 m 3 1 d 5 5 d -31 Y s 150 1330 m -4 -2 d -3 -4 d -1
- -7 d -5 Y 1 -7 d 3 -5 d 4 -1 d 3 X 5 1 d 3 5 d 1 7 d 5 Y -1 7 d -3 4 d -5 2 d
- -3 X cl s 113 1457 m 1 Y 2 3 d 1 2 d 3 1 d 6 X 3 -1 d 2 -2 d 1 -3 d -3 Y -1 -3
- d -3 -4 d -15 -15 d 21 X s 150 1464 m -4 -1 d -3 -5 d -1 -7 d -5 Y 1 -7 d 3 -4
- d 4 -2 d 3 X 5 2 d 3 4 d 1 7 d 5 Y -1 7 d -3 5 d -5 1 d -3 X cl s 115 1599 m 16
- X -9 -12 d 5 X 3 -2 d 1 -1 d 2 -5 d -3 Y -2 -4 d -3 -3 d -4 -2 d -5 X -4 2 d -2
- 1 d -1 3 d s 150 1599 m -4 -2 d -3 -4 d -1 -8 d -4 Y 1 -8 d 3 -4 d 4 -2 d 3 X 5
- 2 d 3 4 d 1 8 d 4 Y -1 8 d -3 4 d -5 2 d -3 X cl s 127 1733 m -15 -21 d 22 X s
- 127 1733 m -31 Y s 150 1733 m -4 -2 d -3 -4 d -1 -7 d -5 Y 1 -7 d 3 -5 d 4 -1 d
- 3 X 5 1 d 3 5 d 1 7 d 5 Y -1 7 d -3 4 d -5 2 d -3 X cl s 130 1867 m -15 X -2
- -13 d 2 1 d 4 2 d 5 X 4 -2 d 3 -3 d 2 -4 d -3 Y -2 -4 d -3 -3 d -4 -2 d -5 X -4
- 2 d -2 1 d -1 3 d s 150 1867 m -4 -1 d -3 -5 d -1 -7 d -4 Y 1 -8 d 3 -4 d 4 -2
- d 3 X 5 2 d 3 4 d 1 8 d 4 Y -1 7 d -3 5 d -5 1 d -3 X cl s 131 1997 m -1 3 d -5
- 2 d -3 X -4 -2 d -3 -4 d -2 -8 d -7 Y 2 -6 d 3 -3 d 4 -1 d 2 X 4 1 d 3 3 d 2 4
- d 2 Y -2 4 d -3 3 d -4 2 d -2 X -4 -2 d -3 -3 d -2 -4 d s 150 2002 m -4 -2 d -3
- -4 d -1 -8 d -4 Y 1 -8 d 3 -4 d 4 -1 d 3 X 5 1 d 3 4 d 1 8 d 4 Y -1 8 d -3 4 d
- -5 2 d -3 X cl s 133 2136 m -15 -31 d s 112 2136 m 21 X s 150 2136 m -4 -1 d -3
- -5 d -1 -7 d -5 Y 1 -7 d 3 -5 d 4 -1 d 3 X 5 1 d 3 5 d 1 7 d 5 Y -1 7 d -3 5 d
- -5 1 d -3 X cl s 1040 539 m 9 -21 d s 1057 539 m -8 -21 d -3 -6 d -3 -3 d -3 -1
- d -2 X s 1077 549 m 12 -31 d s 1100 549 m -11 -31 d s 1127 545 m -3 3 d -4 1 d
- -6 X -5 -1 d -3 -3 d -3 Y 2 -3 d 1 -1 d 3 -2 d 9 -3 d 3 -1 d 2 -2 d 1 -3 d -4 Y
- -3 -3 d -4 -2 d -6 X -5 2 d -3 3 d s 1139 521 m -2 -1 d 2 -2 d 1 2 d -1 1 d cl
- s 1166 539 m 16 -21 d s 1182 539 m -16 -21 d s gr
-showpage
- gr
-%%Trailer
-%%Pages: 1
- gr gr
-%%EOF
diff --git a/src/pawlib/paw/testsuite/paw.commands/nt_pl_2d_lego2.ref.ps b/src/pawlib/paw/testsuite/paw.commands/nt_pl_2d_lego2.ref.ps
deleted file mode 100644
index 4e12dbd..0000000
--- a/src/pawlib/paw/testsuite/paw.commands/nt_pl_2d_lego2.ref.ps
+++ /dev/null
@@ -1,9024 +0,0 @@
-%!PS-Adobe-2.0
-%%Title: /disk3/maartenb/cerncvs/paw/testsuite/tmp/nt_pl_2d_ (Portrait A 4)
-%%Pages: (atend)
-%%Creator: HIGZ Version 1.23/06
-%%CreationDate: 96/04/16 14.46
-%%EndComments
-%%BeginProlog
-/s {stroke} def /l {lineto} def /m {moveto} def /t {translate} def
-/sw {stringwidth} def /r {rotate} def /rl {roll} def /R {repeat} def
-/d {rlineto} def /rm {rmoveto} def /gr {grestore} def /f {eofill} def
-/c {setrgbcolor} def /lw {setlinewidth} def /sd {setdash} def
-/cl {closepath} def /sf {scalefont setfont} def /black {0 setgray} def
-/box {m dup 0 exch d exch 0 d 0 exch neg d cl} def
-/NC{systemdict begin initclip end}def/C{NC box clip newpath}def
-/bl {box s} def /bf {box f} def /Y { 0 exch d} def /X { 0 d} def
-/mp {newpath /y exch def /x exch def} def
-/side {[w .77 mul w .23 mul] .385 w mul sd w 0 l currentpoint t -144 r} def
-/mr {mp x y w2 0 360 arc} def /m24 {mr s} def /m20 {mr f} def
-/mb {mp x y w2 add m w2 neg 0 d 0 w neg d w 0 d 0 w d cl} def
-/mt {mp x y w2 add m w2 neg w neg d w 0 d cl} def
-/m21 {mb f} def /m25 {mb s} def /m22 {mt f} def /m26 {mt s} def
-/m23 {mp x y w2 sub m w2 w d w neg 0 d cl f} def
-/m27 {mp x y w2 add m w3 neg w2 neg d w3 w2 neg d w3 w2 d cl s} def
-/m28 {mp x w2 sub y w2 sub w3 add m w3 0 d 0 w3 neg d w3 0 d 0 w3 d w3 0 d
- 0 w3 d w3 neg 0 d 0 w3 d w3 neg 0 d
- 0 w3 neg d w3 neg 0 d cl s } def
-/m29 {mp gsave x w2 sub y w2 add w3 sub m currentpoint t
- 4 {side} repeat cl fill gr} def
-/m30 {mp gsave x w2 sub y w2 add w3 sub m currentpoint t
- 5 {side} repeat s gr} def
-/m31 {mp x y w2 sub m 0 w d x w2 sub y m w 0 d
- x w2 sub y w2 add m w w neg d x w2 sub y w2
- sub m w w d s} def
-/m2 {mp x y w2 sub m 0 w d x w2 sub y m w 0 d s} def
-/m5 {mp x w2 sub y w2 sub m w w d x w2 sub y w2 add m w w neg d s} def
-/DP {/PT exch def gsave 47.2 47.2 scale PT 1 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < AA AA 55 55 AA AA 55 55 AA AA 55 55 AA AA 55 55 AA AA 55 55 AA AA 55 55
-AA AA 55 55 AA AA 55 55 > } image } if PT 2 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < BB BB EE EE BB BB EE EE BB BB EE EE BB BB EE EE BB BB EE EE BB BB EE EE
-BB BB EE EE BB BB EE EE > } image } if PT 3 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < FF FF BB BB FF FF EE EE FF FF BB BB FF FF EE EE FF FF BB BB FF FF EE EE
-FF FF BB BB FF FF EE EE > } image } if PT 4 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < DF DF BF BF 7F 7F FE FE FD FD FB FB F7 F7 EF EF DF DF BF BF 7F 7F FE FE
-FD FD FB FB F7 F7 EF EF > } image } if PT 5 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < 7F 7F BF B F DF DF EF EF F7 F7 FB FB FD FD FE FE 7F 7F BF BF DF DF EF
-EF F7 F7 FB FB FD FD FE FE > } image } if PT 6 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB
-BB BB BB BB BB BB BB BB BB > } image } if PT 7 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < FF FF FF FF FF FF 00 00 FF FF FF FF FF FF 00 00 FF FF FF FF FF FF 00
-00 FF FF FF FF FF FF 00 00 > } image } if PT 8 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < EE EE 47 47 83 83 C5 C5 EE EE 5C 5C 38 38 74 74 EE EE 47 47 83 83 C5
-C5 EE EE 5C 5C 38 38 74 74 > } image } if PT 9 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < EF EF EF EF D7 D7 38 38 FE FE FE FE 7D 7D 83 83 EF EF EF EF D7 D7 38
-38 FE FE FE FE 7D 7D 83 83 > } image } if PT 10 eq { 16 16 1 [ 16 0 0 16 neg
-0 16 ] { < EF EF EF EF EF EF 00 00 FE FE FE FE FE FE 00 00 EF EF EF EF EF EF
-00 00 FE FE FE FE FE FE 00 00 > } image } if PT 11 eq { 16 16 1 [ 16 0 0 16
-neg 0 16 ] { < F7 F7 B6 B6 D5 D5 E3 E3 D5 D5 B6 B6 F7 F7 FF FF 7F 7F 6B 6B 5D
-5D 3E 3E 5D 5D 6B 6B 7F 7F FF FF > } image } if PT 12 eq { 16 16 1 [ 16 0 0
-16 neg 0 16 ] { < E3 E3 DD DD BE BE BE BE BE BE DD DD E3 E3 FF FF 3E 3E DD DD
-EB EB EB EB EB EB DD DD 3E 3E FF FF > } image } if PT 13 eq { 16 16 1 [ 16 0
-0 16 neg 0 16 ] { < FE FE 7D 7D BB BB D7 D7 EF EF D7 D7 BB BB 7D 7D FE FE 7D
-7D BB BB D7 D7 EF EF D7 D7 BB BB 7D 7D > } image } if PT 14 eq { 16 16 1 [ 16
-0 0 16 neg 0 16 ] { < 00 00 EE EF EE EF EE EF 0E E0 EE EE EE EE EE EE 00 EE
-FE EE FE EE FE EE 00 00 FE EF FE EF FE EF > } image } if PT 15 eq { 16 16 1 [
-16 0 0 16 neg 0 16 ] { < DD DD AA AA DD DD FF FF 77 77 AA AA 77 77 FF FF DD
-DD AA AA DD DD FF FF 77 77 AA AA 77 77 FF FF > } image } if PT 16 eq { 16 16
-1 [ 16 0 0 16 neg 0 16 ] { < F1 F1 EE EE 1F 1F FF FF F1 F1 EE EE 1F 1F FF FF
-F1 F1 EE EE 1F 1F FF FF F1 F1 EE EE 1F 1F FF FF > } image } if PT 17 eq { 16
-16 1 [ 16 0 0 16 neg 0 16 ] { < EE EE DD DD BB BB FF FF EE EE DD DD BB BB FF
- FF EE EE DD DD BB BB FF FF EE EE DD DD BB BB FF FF > } image } if PT 18 eq {
-16 16 1 [ 16 0 0 16 neg 0 16 ] { < BB BB DD DD EE EE FF FF BB BB DD DD EE EE
-FF FF BB BB DD DD EE EE FF FF BB BB DD DD EE EE FF FF > } image } if PT 19 eq
-{ 16 16 1 [ 16 0 0 16 neg 0 16 ] { < 1F FC 67 F3 7B EF BD DE BD DE DE BD E6
-B3 F8 0F E6 B3 DE BD BD DE BD DE 7B EF 67 F3 1F FC 7F FF > } image } if PT
-20 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < DD DD EE EE EE EE EE EE DD DD BB
-BB BB BB BB BB DD DD EE EE EE EE EE EE DD DD BB BB BB BB BB BB > } image }
-if PT 21 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < 0E 0E EF EF EF EF EF EF E0
-E0 FE FE FE FE FE FE 0E 0E EF EF EF EF EF EF E0 E0 FE FE FE FE FE FE > }
-image } if PT 22 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < 70 70 F7 F7 F7 F7 F7
-F7 07 07 7F 7F 7F 7F 7F 7F 70 70 F7 F7 F7 F7 F7 F7 07 07 7F 7F 7F 7F 7F 7F >
-} image } if PT 23 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < AA AA 55 55 A9 A9
-D1 D1 E1 E1 D1 D1 A9 A9 55 55 AA AA 55 55 A9 A9 D1 D1 E1 E1 D1 D1 A9 A9 55 55
-> } image } if PT 24 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < FF FE FF FC EA
-A8 D5 54 EA A8 D5 54 E8 28 D4 54 E8 E8 D4 D4 E8 EA 54 D5 A8 EA 54 D5 00 C0 00
-80 > } image } if PT 25 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < FF FE FF FC
-FF F8 FF F0 F0 00 F0 00 F0 20 F0 60 F0 E0 F1 E0 F3 E0 F0 00 E0 00 C0 00 80 00
-00 00 > } image } if gr } def /FA { /PT exch def gsave clip 0 0 translate 1 1
-54 { 1 sub 47.2 mul /Xcurr exch def 1 1 74 { 1 sub 47.2 mul /Ycurr exch def
-gsave Xcurr Ycurr translate PT DP gr } for } for gr } def
-/reencdict 24 dict def /ReEncode {reencdict begin /nco&na exch def
-/nfnam exch def /basefontname exch def /basefontdict basefontname findfont def
-/newfont basefontdict maxlength dict def basefontdict {exch dup /FID ne
-{dup /Encoding eq {exch dup length array copy newfont 3 1 roll put} {exch
-newfont 3 1 roll put} ifelse} {pop pop} ifelse } forall newfont
-/FontName nfnam put nco&na aload pop nco&na length 2 idiv {newfont
-/Encoding get 3 1 roll put} repeat nfnam newfont definefont pop end } def
-/accvec [ 176 /agrave 181 /Agrave 190 /acircumflex 192 /Acircumflex
-201 /adieresis 204 /Adieresis 209 /ccedilla 210 /Ccedilla 211 /eacute
-212 /Eacute 213 /egrave 214 /Egrave 215 /ecircumflex 216 /Ecircumflex
-217 /edieresis 218 /Edieresis 219 /icircumflex 220 /Icircumflex
-221 /idieresis 222 /Idieresis 223 /ntilde 224 /Ntilde 226 /ocircumflex
-228 /Ocircumflex 229 /odieresis 230 /Odieresis 231 /ucircumflex 236 /Ucircumflex
-237 /udieresis 238 /Udieresis 239 /aring 242 /Aring 243 /ydieresis
-244 /Ydieresis 246 /aacute 247 /Aacute 252 /ugrave 253 /Ugrave] def
-/Times-Roman /Times-Roman accvec ReEncode
-/Times-Italic /Times-Italic accvec ReEncode
-/Times-Bold /Times-Bold accvec ReEncode
-/Times-BoldItalic /Times-BoldItalic accvec ReEncode
-/Helvetica /Helvetica accvec ReEncode
-/Helvetica-Oblique /Helvetica-Oblique accvec ReEncode
-/Helvetica-Bold /Helvetica-Bold accvec ReEncode
-/Helvetica-BoldOblique /Helvetica-BoldOblique accvec ReEncode
-/Courier /Courier accvec ReEncode
-/Courier-Oblique /Courier-Oblique accvec ReEncode
-/Courier-Bold /Courier-Bold accvec ReEncode
-/Courier-BoldOblique /Courier-BoldOblique accvec ReEncode
-/oshow {gsave [] 0 sd true charpath stroke gr} def
-/stwn { /fs exch def /fn exch def /text exch def fn findfont fs sf
- text sw pop xs add /xs exch def} def
-/stwb { /fs exch def /fn exch def /nbas exch def /textf exch def
-textf length /tlen exch def nbas tlen gt {/nbas tlen def} if
-fn findfont fs sf textf dup length nbas sub nbas getinterval sw
-pop neg xs add /xs exch def} def
-/accspe [ 65 /plusminus 66 /bar 67 /existential 68 /universal
-69 /exclam 70 /numbersign 71 /greater 72 /question 73 /integral
-74 /colon 75 /semicolon 76 /less 77 /bracketleft 78 /bracketright
-79 /greaterequal 80 /braceleft 81 /braceright 82 /radical
-83 /spade 84 /heart 85 /diamond 86 /club 87 /lessequal
-88 /multiply 89 /percent 90 /infinity 48 /circlemultiply 49 /circleplus
-50 /emptyset 51 /lozenge 52 /bullet 53 /arrowright 54 /arrowup
-55 /arrowleft 56 /arrowdown 57 /arrowboth 48 /degree 44 /comma 43 /plus
- 45 /angle 42 /angleleft 47 /divide 61 /notequal 40 /equivalence 41 /second
- 97 /approxequal 98 /congruent 99 /perpendicular 100 /partialdiff 101 /florin
- 102 /intersection 103 /union 104 /propersuperset 105 /reflexsuperset
- 106 /notsubset 107 /propersubset 108 /reflexsubset 109 /element 110 /notelement
- 111 /gradient 112 /logicaland 113 /logicalor 114 /arrowdblboth
- 115 /arrowdblleft 116 /arrowdblup 117 /arrowdblright 118 /arrowdbldown
- 119 /ampersand 120 /omega1 121 /similar 122 /aleph ] def
-/Symbol /Special accspe ReEncode
-/Zone {/iy exch def /ix exch def ix 1 sub 2224 mul 1 iy sub 3144
- mul t} def
-%%EndProlog
- gsave 20 28 t .25 .25 scale gsave
-%%Page: number 1
- gsave
- 1 1 Zone
- gsave 0 0 t black [] 0 sd 1 lw 2223 2224 0 460 bl 2223 2224 0 460 C 1779 1778
- 222 683 C NC [4 8] 0 sd 222 1314 m 1128 287 d s 222 1449 m 1128 287 d s 222
- 1583 m 1128 287 d s 222 1717 m 1128 287 d s 222 1852 m 1128 287 d s 222 1986 m
- 1128 287 d s 222 2120 m 1128 287 d s [] 0 sd 222 1180 m 1128 287 d s 1350 1467
- m 994 Y s 222 2174 m 1128 287 d s 222 1180 m 994 Y s [4 8] 0 sd 1350 1601 m 651
- -497 d s 1350 1736 m 651 -497 d s 1350 1870 m 651 -497 d s 1350 2004 m 651 -497
- d s 1350 2139 m 651 -497 d s 1350 2273 m 651 -497 d s 1350 2407 m 651 -497 d s
- [] 0 sd 1350 1467 m 651 -497 d s 2001 970 m 994 Y s 1350 2461 m 651 -497 d s
- 1350 1467 m cl s 0 0 0.8 c 1347 1445 m 23 6 d -20 16 d -24 -6 d f black 1347
- 1445 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1323 1439 m 24 6 d -21 16 d -23
- -6 d f black 1323 1439 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1300 1433 m 23
- 6 d -20 16 d -24 -6 d f black 1300 1433 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8
- c 1276 1427 m 24 6 d -21 16 d -23 -6 d f black 1276 1427 m 24 6 d -21 16 d -23
- -6 d cl s 0 0 0.8 c 1253 1422 m 23 5 d -20 16 d -24 -6 d f black 1253 1422 m 23
- 5 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1229 1416 m 24 6 d -21 15 d -23 -6 d f
- black 1229 1416 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 1206 1410 m 23 6 d
- -20 15 d -24 -6 d f black 1206 1410 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c
- 1182 1404 m 24 6 d -21 15 d -23 -6 d f black 1182 1404 m 24 6 d -21 15 d -23 -6
- d cl s 0 0 0.8 c 1159 1398 m 23 6 d -20 15 d -24 -6 d f black 1159 1398 m 23 6
- d -20 15 d -24 -6 d cl s 0 0 0.8 c 1135 1392 m 24 6 d -21 15 d -23 -6 d f black
- 1135 1392 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 1112 1386 m 23 6 d -20 15 d
- -24 -6 d f black 1112 1386 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1088 1380
- m 24 6 d -21 15 d -23 -6 d f black 1088 1380 m 24 6 d -21 15 d -23 -6 d cl s 0
- 0 0.8 c 1065 1374 m 23 6 d -20 15 d -24 -6 d f black 1065 1374 m 23 6 d -20 15
- d -24 -6 d cl s 0 0 0.8 c 1041 1368 m 24 6 d -21 15 d -23 -6 d f black 1041
- 1368 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 1018 1362 m 23 6 d -20 15 d -24
- -6 d f black 1018 1362 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 994 1356 m 24
- 6 d -21 15 d -23 -6 d f black 994 1356 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8
- c 971 1350 m 23 6 d -20 15 d -24 -6 d f black 971 1350 m 23 6 d -20 15 d -24 -6
- d cl s 0 0 0.8 c 947 1344 m 24 6 d -21 15 d -23 -6 d f black 947 1344 m 24 6 d
- -21 15 d -23 -6 d cl s 0 0 0.8 c 924 1338 m 23 6 d -20 15 d -24 -6 d f black
- 924 1338 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 900 1332 m 24 6 d -21 15 d
- -23 -6 d f black 900 1332 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 877 1326 m
- 23 6 d -20 15 d -23 -6 d f black 877 1326 m 23 6 d -20 15 d -23 -6 d cl s 0 0
- 0.8 c 853 1320 m 24 6 d -20 15 d -24 -6 d f black 853 1320 m 24 6 d -20 15 d
- -24 -6 d cl s 0 0 0.8 c 830 1314 m 23 6 d -20 15 d -23 -6 d f black 830 1314 m
- 23 6 d -20 15 d -23 -6 d cl s 0 0 0.8 c 806 1308 m 24 6 d -20 15 d -24 -6 d f
- black 806 1308 m 24 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 783 1302 m 23 6 d -20
- 15 d -23 -6 d f black 783 1302 m 23 6 d -20 15 d -23 -6 d cl s 0 0 0.8 c 759
- 1296 m 24 6 d -20 15 d -24 -6 d f black 759 1296 m 24 6 d -20 15 d -24 -6 d
- cl s 0 0 0.8 c 736 1290 m 23 6 d -20 15 d -23 -6 d f black 736 1290 m 23 6 d
- -20 15 d -23 -6 d cl s 0 0 0.8 c 712 1284 m 24 6 d -20 15 d -24 -5 d f black
- 712 1284 m 24 6 d -20 15 d -24 -5 d cl s 0 0 0.8 c 689 1278 m 23 6 d -20 16 d
- -23 -6 d f black 689 1278 m 23 6 d -20 16 d -23 -6 d cl s 0 0 0.8 c 665 1272 m
- 24 6 d -20 16 d -24 -6 d f black 665 1272 m 24 6 d -20 16 d -24 -6 d cl s 0 0
- 0.8 c 642 1266 m 23 6 d -20 16 d -23 -6 d f black 642 1266 m 23 6 d -20 16 d
- -23 -6 d cl s 0 0 0.8 c 618 1260 m 24 6 d -20 16 d -24 -6 d f black 618 1260 m
- 24 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 595 1254 m 23 6 d -20 16 d -23 -6 d f
- black 595 1254 m 23 6 d -20 16 d -23 -6 d cl s 0 0 0.8 c 571 1248 m 24 6 d -20
- 16 d -24 -6 d f black 571 1248 m 24 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 548
- 1242 m 23 6 d -20 16 d -23 -6 d f black 548 1242 m 23 6 d -20 16 d -23 -6 d
- cl s 0 0 0.8 c 525 1236 m 23 6 d 14 Y -23 -6 d f black 525 1236 m 23 6 d 14 Y
- -23 -6 d cl s 0 0 0.8 c 504 1252 m 21 -16 d 14 Y -21 15 d f black 504 1252 m 21
- -16 d 14 Y -21 15 d cl s 0 0 0.8 c 525 1250 m 23 6 d -20 15 d -24 -6 d f black
- 525 1250 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 501 1230 m 24 6 d -21 16 d
- -23 -6 d f black 501 1230 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 478 1224 m
- 23 6 d -20 16 d -24 -6 d f black 478 1224 m 23 6 d -20 16 d -24 -6 d cl s 0 0
- 0.8 c 454 1218 m 24 6 d -21 16 d -23 -6 d f black 454 1218 m 24 6 d -21 16 d
- -23 -6 d cl s 0 0 0.8 c 431 1212 m 23 6 d -20 16 d -24 -6 d f black 431 1212 m
- 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 407 1206 m 24 6 d -21 16 d -23 -6 d f
- black 407 1206 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 384 1200 m 23 6 d -20
- 16 d -24 -6 d f black 384 1200 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 360
- 1194 m 24 6 d -21 16 d -23 -6 d f black 360 1194 m 24 6 d -21 16 d -23 -6 d
- cl s 0 0 0.8 c 337 1188 m 23 6 d -20 16 d -24 -6 d f black 337 1188 m 23 6 d
- -20 16 d -24 -6 d cl s 0 0 0.8 c 313 1182 m 24 6 d -21 16 d -23 -6 d f black
- 313 1182 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 290 1176 m 23 6 d -20 16 d
- -24 -6 d f black 290 1176 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 266 1170 m
- 24 6 d -21 16 d -23 -6 d f black 266 1170 m 24 6 d -21 16 d -23 -6 d cl s 0 0
- 0.8 c 243 1164 m 23 6 d -20 16 d -24 -6 d f black 243 1164 m 23 6 d -20 16 d
- -24 -6 d cl s 0 0 0.8 c 1367 1430 m 23 6 d -20 15 d -23 -6 d f black 1367 1430
- m 23 6 d -20 15 d -23 -6 d cl s 0 0 0.8 c 1343 1424 m 24 6 d -20 15 d -24 -6 d
- f black 1343 1424 m 24 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1320 1418 m 23 6 d
- -20 15 d -23 -6 d f black 1320 1418 m 23 6 d -20 15 d -23 -6 d cl s 0 0 0.8 c
- 1297 1412 m 23 6 d -20 15 d -24 -6 d f black 1297 1412 m 23 6 d -20 15 d -24 -6
- d cl s 0 0 0.8 c 1273 1406 m 24 6 d -21 15 d -23 -5 d f black 1273 1406 m 24 6
- d -21 15 d -23 -5 d cl s 0 0 0.8 c 1250 1400 m 23 6 d -20 16 d -24 -6 d f black
- 1250 1400 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1226 1394 m 24 6 d -21 16 d
- -23 -6 d f black 1226 1394 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1203 1388
- m 23 6 d -20 16 d -24 -6 d f black 1203 1388 m 23 6 d -20 16 d -24 -6 d cl s 0
- 0 0.8 c 1179 1382 m 24 6 d -21 16 d -23 -6 d f black 1179 1382 m 24 6 d -21 16
- d -23 -6 d cl s 0 0 0.8 c 1156 1376 m 23 6 d -20 16 d -24 -6 d f black 1156
- 1376 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1132 1370 m 24 6 d -21 16 d -23
- -6 d f black 1132 1370 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1109 1364 m 23
- 6 d -20 16 d -24 -6 d f black 1109 1364 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8
- c 1085 1358 m 24 6 d -21 16 d -23 -6 d f black 1085 1358 m 24 6 d -21 16 d -23
- -6 d cl s 0 0 0.8 c 1062 1352 m 23 6 d -20 16 d -24 -6 d f black 1062 1352 m 23
- 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1038 1346 m 24 6 d -21 16 d -23 -6 d f
- black 1038 1346 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1015 1340 m 23 6 d
- -20 16 d -24 -6 d f black 1015 1340 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c
- 991 1334 m 24 6 d -21 16 d -23 -6 d f black 991 1334 m 24 6 d -21 16 d -23 -6 d
- cl s 0 0 0.8 c 968 1328 m 23 6 d -20 16 d -24 -6 d f black 968 1328 m 23 6 d
- -20 16 d -24 -6 d cl s 0 0 0.8 c 944 1322 m 24 6 d -21 16 d -23 -6 d f black
- 944 1322 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 921 1316 m 23 6 d -20 16 d
- -24 -6 d f black 921 1316 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 897 1310 m
- 24 6 d -21 16 d -23 -6 d f black 897 1310 m 24 6 d -21 16 d -23 -6 d cl s 0 0
- 0.8 c 874 1304 m 23 6 d -20 16 d -24 -6 d f black 874 1304 m 23 6 d -20 16 d
- -24 -6 d cl s 0 0 0.8 c 850 1298 m 24 6 d -21 16 d -23 -6 d f black 850 1298 m
- 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 827 1292 m 23 6 d -20 16 d -24 -6 d f
- black 827 1292 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 803 1286 m 24 6 d -21
- 16 d -23 -6 d f black 803 1286 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 780
- 1280 m 23 6 d -20 16 d -24 -6 d f black 780 1280 m 23 6 d -20 16 d -24 -6 d
- cl s 0 0 0.8 c 756 1274 m 24 6 d -21 16 d -23 -6 d f black 756 1274 m 24 6 d
- -21 16 d -23 -6 d cl s 0 0 0.8 c 733 1268 m 23 6 d -20 16 d -24 -6 d f black
- 733 1268 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 709 1262 m 24 6 d -21 16 d
- -23 -6 d f black 709 1262 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 686 1256 m
- 23 6 d -20 16 d -24 -6 d f black 686 1256 m 23 6 d -20 16 d -24 -6 d cl s 0 0
- 0.8 c 662 1251 m 24 5 d -21 16 d -23 -6 d f black 662 1251 m 24 5 d -21 16 d
- -23 -6 d cl s 0 0 0.8 c 639 1245 m 23 6 d -20 15 d -24 -6 d f black 639 1245 m
- 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 615 1239 m 24 6 d -21 15 d -23 -6 d f
- black 615 1239 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 592 1233 m 23 6 d 13 Y
- -23 -6 d f black 592 1233 m 23 6 d 13 Y -23 -6 d cl s 0 0 0.8 c 571 1248 m 21
- -15 d 13 Y -21 16 d f black 571 1248 m 21 -15 d 13 Y -21 16 d cl s 0 0 0.8 c
- 592 1246 m 23 6 d -20 16 d -24 -6 d f black 592 1246 m 23 6 d -20 16 d -24 -6 d
- cl s 0 0 0.8 c 568 1227 m 24 6 d -21 15 d -23 -6 d f black 568 1227 m 24 6 d
- -21 15 d -23 -6 d cl s 0 0 0.8 c 545 1221 m 23 6 d 13 Y -23 -6 d f black 545
- 1221 m 23 6 d 13 Y -23 -6 d cl s 0 0 0.8 c 525 1236 m 20 -15 d 13 Y -20 16 d f
- black 525 1236 m 20 -15 d 13 Y -20 16 d cl s 0 0 0.8 c 545 1234 m 23 6 d -20 16
- d -23 -6 d f black 545 1234 m 23 6 d -20 16 d -23 -6 d cl s 0 0 0.8 c 521 1215
- m 24 6 d -20 15 d -24 -6 d f black 521 1215 m 24 6 d -20 15 d -24 -6 d cl s 0 0
- 0.8 c 498 1209 m 23 6 d -20 15 d -23 -6 d f black 498 1209 m 23 6 d -20 15 d
- -23 -6 d cl s 0 0 0.8 c 474 1203 m 24 6 d -20 15 d -24 -6 d f black 474 1203 m
- 24 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 451 1197 m 23 6 d -20 15 d -23 -6 d f
- black 451 1197 m 23 6 d -20 15 d -23 -6 d cl s 0 0 0.8 c 427 1191 m 24 6 d -20
- 15 d -24 -6 d f black 427 1191 m 24 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 404
- 1185 m 23 6 d -20 15 d -23 -6 d f black 404 1185 m 23 6 d -20 15 d -23 -6 d
- cl s 0 0 0.8 c 380 1179 m 24 6 d -20 15 d -24 -6 d f black 380 1179 m 24 6 d
- -20 15 d -24 -6 d cl s 0 0 0.8 c 357 1173 m 23 6 d -20 15 d -23 -6 d f black
- 357 1173 m 23 6 d -20 15 d -23 -6 d cl s 0 0 0.8 c 333 1167 m 24 6 d -20 15 d
- -24 -6 d f black 333 1167 m 24 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 310 1161 m
- 23 6 d -20 15 d -23 -6 d f black 310 1161 m 23 6 d -20 15 d -23 -6 d cl s 0 0
- 0.8 c 286 1155 m 24 6 d -20 15 d -24 -6 d f black 286 1155 m 24 6 d -20 15 d
- -24 -6 d cl s 0 0 0.8 c 263 1149 m 23 6 d -20 15 d -23 -6 d f black 263 1149 m
- 23 6 d -20 15 d -23 -6 d cl s 0 0 0.8 c 1387 1414 m 24 6 d -21 16 d -23 -6 d f
- black 1387 1414 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1364 1408 m 23 6 d
- -20 16 d -24 -6 d f black 1364 1408 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c
- 1340 1402 m 24 6 d -21 16 d -23 -6 d f black 1340 1402 m 24 6 d -21 16 d -23 -6
- d cl s 0 0 0.8 c 1317 1396 m 23 6 d -20 16 d -23 -6 d f black 1317 1396 m 23 6
- d -20 16 d -23 -6 d cl s 0 0 0.8 c 1293 1390 m 24 6 d -20 16 d -24 -6 d f black
- 1293 1390 m 24 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1270 1384 m 23 6 d -20 16 d
- -23 -6 d f black 1270 1384 m 23 6 d -20 16 d -23 -6 d cl s 0 0 0.8 c 1246 1378
- m 24 6 d -20 16 d -24 -6 d f black 1246 1378 m 24 6 d -20 16 d -24 -6 d cl s 0
- 0 0.8 c 1223 1373 m 23 5 d -20 16 d -23 -6 d f black 1223 1373 m 23 5 d -20 16
- d -23 -6 d cl s 0 0 0.8 c 1199 1367 m 24 6 d -20 15 d -24 -6 d f black 1199
- 1367 m 24 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1176 1361 m 23 6 d -20 15 d -23
- -6 d f black 1176 1361 m 23 6 d -20 15 d -23 -6 d cl s 0 0 0.8 c 1152 1355 m 24
- 6 d -20 15 d -24 -6 d f black 1152 1355 m 24 6 d -20 15 d -24 -6 d cl s 0 0 0.8
- c 1129 1349 m 23 6 d -20 15 d -23 -6 d f black 1129 1349 m 23 6 d -20 15 d -23
- -6 d cl s 0 0 0.8 c 1105 1343 m 24 6 d -20 15 d -24 -6 d f black 1105 1343 m 24
- 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1082 1337 m 23 6 d -20 15 d -23 -6 d f
- black 1082 1337 m 23 6 d -20 15 d -23 -6 d cl s 0 0 0.8 c 1058 1331 m 24 6 d
- -20 15 d -24 -6 d f black 1058 1331 m 24 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c
- 1035 1325 m 23 6 d -20 15 d -23 -6 d f black 1035 1325 m 23 6 d -20 15 d -23 -6
- d cl s 0 0 0.8 c 1011 1319 m 24 6 d -20 15 d -24 -6 d f black 1011 1319 m 24 6
- d -20 15 d -24 -6 d cl s 0 0 0.8 c 988 1313 m 23 6 d -20 15 d -23 -6 d f black
- 988 1313 m 23 6 d -20 15 d -23 -6 d cl s 0 0 0.8 c 965 1307 m 23 6 d -20 15 d
- -24 -6 d f black 965 1307 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 941 1301 m
- 24 6 d -21 15 d -23 -6 d f black 941 1301 m 24 6 d -21 15 d -23 -6 d cl s 0 0
- 0.8 c 918 1295 m 23 6 d -20 15 d -24 -6 d f black 918 1295 m 23 6 d -20 15 d
- -24 -6 d cl s 0 0 0.8 c 894 1289 m 24 6 d -21 15 d -23 -6 d f black 894 1289 m
- 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 871 1283 m 23 6 d -20 15 d -24 -6 d f
- black 871 1283 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 847 1277 m 24 6 d -21
- 15 d -23 -6 d f black 847 1277 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 824
- 1271 m 23 6 d -20 15 d -24 -6 d f black 824 1271 m 23 6 d -20 15 d -24 -6 d
- cl s 0 0 0.8 c 800 1265 m 24 6 d -21 15 d -23 -6 d f black 800 1265 m 24 6 d
- -21 15 d -23 -6 d cl s 0 0 0.8 c 777 1259 m 23 6 d -20 15 d -24 -6 d f black
- 777 1259 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 753 1253 m 24 6 d -21 15 d
- -23 -6 d f black 753 1253 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 730 1247 m
- 23 6 d -20 15 d -24 -6 d f black 730 1247 m 23 6 d -20 15 d -24 -6 d cl s 0 0
- 0.8 c 706 1241 m 24 6 d -21 15 d -23 -6 d f black 706 1241 m 24 6 d -21 15 d
- -23 -6 d cl s 0 0 0.8 c 683 1235 m 23 6 d -20 15 d -24 -5 d f black 683 1235 m
- 23 6 d -20 15 d -24 -5 d cl s 0 0 0.8 c 659 1229 m 24 6 d -21 16 d -23 -6 d f
- black 659 1229 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 636 1223 m 23 6 d -20
- 16 d -24 -6 d f black 636 1223 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 612
- 1217 m 24 6 d -21 16 d -23 -6 d f black 612 1217 m 24 6 d -21 16 d -23 -6 d
- cl s 0 0 0.8 c 589 1211 m 23 6 d 13 Y -23 -6 d f black 589 1211 m 23 6 d 13 Y
- -23 -6 d cl s 0 0 0.8 c 568 1227 m 21 -16 d 13 Y -21 16 d f black 568 1227 m 21
- -16 d 13 Y -21 16 d cl s 0 0 0.8 c 589 1224 m 23 6 d -20 16 d -24 -6 d f black
- 589 1224 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 565 1205 m 24 6 d -21 16 d
- -23 -6 d f black 565 1205 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 542 1199 m
- 23 6 d 14 Y -23 -6 d f black 542 1199 m 23 6 d 14 Y -23 -6 d cl s 0 0 0.8 c 521
- 1215 m 21 -16 d 14 Y -21 15 d f black 521 1215 m 21 -16 d 14 Y -21 15 d cl s 0
- 0 0.8 c 542 1213 m 23 6 d -20 15 d -24 -6 d f black 542 1213 m 23 6 d -20 15 d
- -24 -6 d cl s 0 0 0.8 c 518 1193 m 24 6 d -21 16 d -23 -6 d f black 518 1193 m
- 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 495 1187 m 23 6 d -20 16 d -24 -6 d f
- black 495 1187 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 471 1181 m 24 6 d -21
- 16 d -23 -6 d f black 471 1181 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 448
- 1175 m 23 6 d -20 16 d -24 -6 d f black 448 1175 m 23 6 d -20 16 d -24 -6 d
- cl s 0 0 0.8 c 424 1169 m 24 6 d -21 16 d -23 -6 d f black 424 1169 m 24 6 d
- -21 16 d -23 -6 d cl s 0 0 0.8 c 401 1163 m 23 6 d 14 Y -23 -6 d f black 401
- 1163 m 23 6 d 14 Y -23 -6 d cl s 0 0 0.8 c 380 1179 m 21 -16 d 14 Y -21 15 d f
- black 380 1179 m 21 -16 d 14 Y -21 15 d cl s 0 0 0.8 c 401 1177 m 23 6 d -20 15
- d -24 -6 d f black 401 1177 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 377 1157
- m 24 6 d -21 16 d -23 -6 d f black 377 1157 m 24 6 d -21 16 d -23 -6 d cl s 0 0
- 0.8 c 354 1151 m 23 6 d -20 16 d -24 -6 d f black 354 1151 m 23 6 d -20 16 d
- -24 -6 d cl s 0 0 0.8 c 330 1145 m 24 6 d -21 16 d -23 -6 d f black 330 1145 m
- 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 307 1139 m 23 6 d -20 16 d -24 -6 d f
- black 307 1139 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 283 1133 m 24 6 d -21
- 16 d -23 -6 d f black 283 1133 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1408
- 1399 m 23 6 d -20 15 d -24 -6 d f black 1408 1399 m 23 6 d -20 15 d -24 -6 d
- cl s 0 0 0.8 c 1384 1393 m 24 6 d -21 15 d -23 -6 d f black 1384 1393 m 24 6 d
- -21 15 d -23 -6 d cl s 0 0 0.8 c 1361 1387 m 23 6 d -20 15 d -24 -6 d f black
- 1361 1387 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1337 1381 m 24 6 d -21 15 d
- -23 -6 d f black 1337 1381 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 1314 1375
- m 23 6 d 13 Y -23 -6 d f black 1314 1375 m 23 6 d 13 Y -23 -6 d cl s 0 0 0.8 c
- 1293 1390 m 21 -15 d 13 Y -21 16 d f black 1293 1390 m 21 -15 d 13 Y -21 16 d
- cl s 0 0 0.8 c 1314 1388 m 23 6 d -20 16 d -24 -6 d f black 1314 1388 m 23 6 d
- -20 16 d -24 -6 d cl s 0 0 0.8 c 1290 1369 m 24 6 d -21 15 d -23 -6 d f black
- 1290 1369 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 1267 1363 m 23 6 d -20 15 d
- -24 -6 d f black 1267 1363 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1243 1357
- m 24 6 d -21 15 d -23 -5 d f black 1243 1357 m 24 6 d -21 15 d -23 -5 d cl s 0
- 0 0.8 c 1220 1351 m 23 6 d -20 16 d -24 -6 d f black 1220 1351 m 23 6 d -20 16
- d -24 -6 d cl s 0 0 0.8 c 1196 1345 m 24 6 d -21 16 d -23 -6 d f black 1196
- 1345 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1173 1339 m 23 6 d -20 16 d -24
- -6 d f black 1173 1339 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1149 1333 m 24
- 6 d -21 16 d -23 -6 d f black 1149 1333 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8
- c 1126 1327 m 23 6 d -20 16 d -24 -6 d f black 1126 1327 m 23 6 d -20 16 d -24
- -6 d cl s 0 0 0.8 c 1102 1321 m 24 6 d -21 16 d -23 -6 d f black 1102 1321 m 24
- 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1079 1315 m 23 6 d -20 16 d -24 -6 d f
- black 1079 1315 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1055 1309 m 24 6 d
- -21 16 d -23 -6 d f black 1055 1309 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c
- 1032 1303 m 23 6 d -20 16 d -24 -6 d f black 1032 1303 m 23 6 d -20 16 d -24 -6
- d cl s 0 0 0.8 c 1008 1297 m 24 6 d 14 Y -24 -6 d f black 1008 1297 m 24 6 d 14
- Y -24 -6 d cl s 0 0 0.8 c 988 1313 m 20 -16 d 14 Y -20 15 d f black 988 1313 m
- 20 -16 d 14 Y -20 15 d cl s 0 0 0.8 c 1008 1311 m 24 6 d -21 15 d -23 -6 d f
- black 1008 1311 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 985 1291 m 23 6 d -20
- 16 d -23 -6 d f black 985 1291 m 23 6 d -20 16 d -23 -6 d cl s 0 0 0.8 c 961
- 1285 m 24 6 d 14 Y -24 -6 d f black 961 1285 m 24 6 d 14 Y -24 -6 d cl s 0 0
- 0.8 c 941 1301 m 20 -16 d 14 Y -20 15 d f black 941 1301 m 20 -16 d 14 Y -20 15
- d cl s 0 0 0.8 c 961 1299 m 24 6 d -20 15 d -24 -6 d f black 961 1299 m 24 6 d
- -20 15 d -24 -6 d cl s 0 0 0.8 c 938 1279 m 23 6 d -20 16 d -23 -6 d f black
- 938 1279 m 23 6 d -20 16 d -23 -6 d cl s 0 0 0.8 c 914 1273 m 24 6 d -20 16 d
- -24 -6 d f black 914 1273 m 24 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 891 1267 m
- 23 6 d -20 16 d -23 -6 d f black 891 1267 m 23 6 d -20 16 d -23 -6 d cl s 0 0
- 0.8 c 867 1261 m 24 6 d -20 16 d -24 -6 d f black 867 1261 m 24 6 d -20 16 d
- -24 -6 d cl s 0 0 0.8 c 844 1255 m 23 6 d 14 Y -23 -6 d f black 844 1255 m 23 6
- d 14 Y -23 -6 d cl s 0 0 0.8 c 824 1271 m 20 -16 d 14 Y -20 15 d f black 824
- 1271 m 20 -16 d 14 Y -20 15 d cl s 0 0 0.8 c 844 1269 m 23 6 d -20 15 d -23 -6
- d f black 844 1269 m 23 6 d -20 15 d -23 -6 d cl s 0 0 0.8 c 820 1249 m 24 6 d
- 14 Y -24 -6 d f black 820 1249 m 24 6 d 14 Y -24 -6 d cl s 0 0 0.8 c 800 1265 m
- 20 -16 d 14 Y -20 15 d f black 800 1265 m 20 -16 d 14 Y -20 15 d cl s 0 0 0.8 c
- 820 1263 m 24 6 d -20 15 d -24 -6 d f black 820 1263 m 24 6 d -20 15 d -24 -6 d
- cl s 0 0 0.8 c 797 1243 m 23 6 d -20 16 d -23 -6 d f black 797 1243 m 23 6 d
- -20 16 d -23 -6 d cl s 0 0 0.8 c 773 1237 m 24 6 d -20 16 d -24 -6 d f black
- 773 1237 m 24 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 750 1231 m 23 6 d -20 16 d
- -23 -6 d f black 750 1231 m 23 6 d -20 16 d -23 -6 d cl s 0 0 0.8 c 726 1225 m
- 24 6 d -20 16 d -24 -6 d f black 726 1225 m 24 6 d -20 16 d -24 -6 d cl s 0 0
- 0.8 c 703 1219 m 23 6 d -20 16 d -23 -6 d f black 703 1219 m 23 6 d -20 16 d
- -23 -6 d cl s 0 0 0.8 c 679 1213 m 24 6 d -20 16 d -24 -6 d f black 679 1213 m
- 24 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 656 1207 m 23 6 d -20 16 d -23 -6 d f
- black 656 1207 m 23 6 d -20 16 d -23 -6 d cl s 0 0 0.8 c 633 1201 m 23 6 d -20
- 16 d -24 -6 d f black 633 1201 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 609
- 1196 m 24 5 d 14 Y -24 -6 d f black 609 1196 m 24 5 d 14 Y -24 -6 d cl s 0 0
- 0.8 c 589 1211 m 20 -15 d 13 Y -20 15 d f black 589 1211 m 20 -15 d 13 Y -20 15
- d cl s 0 0 0.8 c 609 1209 m 24 6 d -21 15 d -23 -6 d f black 609 1209 m 24 6 d
- -21 15 d -23 -6 d cl s 0 0 0.8 c 586 1190 m 23 6 d -20 15 d -24 -6 d f black
- 586 1190 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 562 1184 m 24 6 d 13 Y -24
- -6 d f black 562 1184 m 24 6 d 13 Y -24 -6 d cl s 0 0 0.8 c 542 1199 m 20 -15 d
- 13 Y -20 16 d f black 542 1199 m 20 -15 d 13 Y -20 16 d cl s 0 0 0.8 c 562 1197
- m 24 6 d -21 16 d -23 -6 d f black 562 1197 m 24 6 d -21 16 d -23 -6 d cl s 0 0
- 0.8 c 539 1178 m 23 6 d -20 15 d -24 -6 d f black 539 1178 m 23 6 d -20 15 d
- -24 -6 d cl s 0 0 0.8 c 515 1172 m 24 6 d -21 15 d -23 -6 d f black 515 1172 m
- 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 492 1166 m 23 6 d -20 15 d -24 -6 d f
- black 492 1166 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 468 1160 m 24 6 d 13 Y
- -24 -6 d f black 468 1160 m 24 6 d 13 Y -24 -6 d cl s 0 0 0.8 c 448 1175 m 20
- -15 d 13 Y -20 16 d f black 448 1175 m 20 -15 d 13 Y -20 16 d cl s 0 0 0.8 c
- 468 1173 m 24 6 d -21 16 d -23 -6 d f black 468 1173 m 24 6 d -21 16 d -23 -6 d
- cl s 0 0 0.8 c 445 1154 m 23 6 d -20 15 d -24 -6 d f black 445 1154 m 23 6 d
- -20 15 d -24 -6 d cl s 0 0 0.8 c 421 1148 m 24 6 d 13 Y -24 -6 d f black 421
- 1148 m 24 6 d 13 Y -24 -6 d cl s 0 0 0.8 c 401 1163 m 20 -15 d 13 Y -20 16 d f
- black 401 1163 m 20 -15 d 13 Y -20 16 d cl s 0 0 0.8 c 421 1161 m 24 6 d -21 16
- d -23 -6 d f black 421 1161 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 398 1142
- m 23 6 d -20 15 d -24 -6 d f black 398 1142 m 23 6 d -20 15 d -24 -6 d cl s 0 0
- 0.8 c 374 1136 m 24 6 d -21 15 d -23 -6 d f black 374 1136 m 24 6 d -21 15 d
- -23 -6 d cl s 0 0 0.8 c 351 1130 m 23 6 d -20 15 d -24 -6 d f black 351 1130 m
- 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 327 1124 m 24 6 d -21 15 d -23 -6 d f
- black 327 1124 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 304 1118 m 23 6 d -20
- 15 d -24 -6 d f black 304 1118 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1428
- 1383 m 23 6 d -20 16 d -23 -6 d f black 1428 1383 m 23 6 d -20 16 d -23 -6 d
- cl s 0 0 0.8 c 1405 1377 m 23 6 d -20 16 d -24 -6 d f black 1405 1377 m 23 6 d
- -20 16 d -24 -6 d cl s 0 0 0.8 c 1381 1371 m 24 6 d -21 16 d -23 -6 d f black
- 1381 1371 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1358 1365 m 23 6 d -20 16 d
- -24 -6 d f black 1358 1365 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1334 1359
- m 24 6 d 14 Y -24 -6 d f black 1334 1359 m 24 6 d 14 Y -24 -6 d cl s 0 0 0.8 c
- 1314 1375 m 20 -16 d 14 Y -20 15 d f black 1314 1375 m 20 -16 d 14 Y -20 15 d
- cl s 0 0 0.8 c 1334 1373 m 24 6 d -21 15 d -23 -6 d f black 1334 1373 m 24 6 d
- -21 15 d -23 -6 d cl s 0 0 0.8 c 1311 1353 m 23 6 d -20 16 d -24 -6 d f black
- 1311 1353 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1287 1347 m 24 6 d -21 16 d
- -23 -6 d f black 1287 1347 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1264 1341
- m 23 6 d 14 Y -23 -6 d f black 1264 1341 m 23 6 d 14 Y -23 -6 d cl s 0 0 0.8 c
- 1243 1357 m 21 -16 d 14 Y -21 15 d f black 1243 1357 m 21 -16 d 14 Y -21 15 d
- cl s 0 0 0.8 c 1264 1355 m 23 6 d -20 15 d -24 -6 d f black 1264 1355 m 23 6 d
- -20 15 d -24 -6 d cl s 0 0 0.8 c 1240 1335 m 24 6 d -21 16 d -23 -6 d f black
- 1240 1335 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1217 1329 m 23 6 d 14 Y -23
- -6 d f black 1217 1329 m 23 6 d 14 Y -23 -6 d cl s 0 0 0.8 c 1196 1345 m 21 -16
- d 14 Y -21 15 d f black 1196 1345 m 21 -16 d 14 Y -21 15 d cl s 0 0 0.8 c 1217
- 1343 m 23 6 d -20 15 d -24 -6 d f black 1217 1343 m 23 6 d -20 15 d -24 -6 d
- cl s 0 0 0.8 c 1193 1323 m 24 6 d 14 Y -24 -6 d f black 1193 1323 m 24 6 d 14 Y
- -24 -6 d cl s 0 0 0.8 c 1173 1339 m 20 -16 d 14 Y -20 15 d f black 1173 1339 m
- 20 -16 d 14 Y -20 15 d cl s 0 0 0.8 c 1193 1337 m 24 6 d -21 15 d -23 -6 d f
- black 1193 1337 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 1170 1318 m 23 5 d 27
- Y -23 -6 d f black 1170 1318 m 23 5 d 27 Y -23 -6 d cl s 0 0 0.8 c 1149 1333 m
- 21 -15 d 26 Y -21 16 d f black 1149 1333 m 21 -15 d 26 Y -21 16 d cl s 0 0 0.8
- c 1170 1344 m 23 6 d -20 16 d -24 -6 d f black 1170 1344 m 23 6 d -20 16 d -24
- -6 d cl s 0 0 0.8 c 1146 1312 m 24 6 d 26 Y -24 -6 d f black 1146 1312 m 24 6 d
- 26 Y -24 -6 d cl s 0 0 0.8 c 1126 1327 m 20 -15 d 26 Y -20 16 d f black 1126
- 1327 m 20 -15 d 26 Y -20 16 d cl s 0 0 0.8 c 1146 1338 m 24 6 d -21 16 d -23 -6
- d f black 1146 1338 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1123 1306 m 23 6
- d 13 Y -23 -6 d f black 1123 1306 m 23 6 d 13 Y -23 -6 d cl s 0 0 0.8 c 1102
- 1321 m 21 -15 d 13 Y -21 16 d f black 1102 1321 m 21 -15 d 13 Y -21 16 d cl s 0
- 0 0.8 c 1123 1319 m 23 6 d -20 16 d -24 -6 d f black 1123 1319 m 23 6 d -20 16
- d -24 -6 d cl s 0 0 0.8 c 1099 1300 m 24 6 d 13 Y -24 -6 d f black 1099 1300 m
- 24 6 d 13 Y -24 -6 d cl s 0 0 0.8 c 1079 1315 m 20 -15 d 13 Y -20 16 d f black
- 1079 1315 m 20 -15 d 13 Y -20 16 d cl s 0 0 0.8 c 1099 1313 m 24 6 d -21 16 d
- -23 -6 d f black 1099 1313 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1076 1294
- m 23 6 d -20 15 d -24 -6 d f black 1076 1294 m 23 6 d -20 15 d -24 -6 d cl s 0
- 0 0.8 c 1052 1288 m 24 6 d -21 15 d -23 -6 d f black 1052 1288 m 24 6 d -21 15
- d -23 -6 d cl s 0 0 0.8 c 1029 1282 m 23 6 d 13 Y -23 -6 d f black 1029 1282 m
- 23 6 d 13 Y -23 -6 d cl s 0 0 0.8 c 1008 1297 m 21 -15 d 13 Y -21 16 d f black
- 1008 1297 m 21 -15 d 13 Y -21 16 d cl s 0 0 0.8 c 1029 1295 m 23 6 d -20 16 d
- -24 -6 d f black 1029 1295 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1005 1276
- m 24 6 d 40 Y -24 -6 d f black 1005 1276 m 24 6 d 40 Y -24 -6 d cl s 0 0 0.8 c
- 985 1291 m 20 -15 d 40 Y -20 15 d f black 985 1291 m 20 -15 d 40 Y -20 15 d
- cl s 0 0 0.8 c 1005 1316 m 24 6 d -21 15 d -23 -6 d f black 1005 1316 m 24 6 d
- -21 15 d -23 -6 d cl s 0 0 0.8 c 982 1270 m 23 6 d -20 15 d -24 -6 d f black
- 982 1270 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 958 1264 m 24 6 d 27 Y -24
- -6 d f black 958 1264 m 24 6 d 27 Y -24 -6 d cl s 0 0 0.8 c 938 1279 m 20 -15 d
- 27 Y -20 15 d f black 938 1279 m 20 -15 d 27 Y -20 15 d cl s 0 0 0.8 c 958 1291
- m 24 6 d -21 15 d -23 -6 d f black 958 1291 m 24 6 d -21 15 d -23 -6 d cl s 0 0
- 0.8 c 935 1258 m 23 6 d 27 Y -23 -6 d f black 935 1258 m 23 6 d 27 Y -23 -6 d
- cl s 0 0 0.8 c 914 1273 m 21 -15 d 27 Y -21 15 d f black 914 1273 m 21 -15 d 27
- Y -21 15 d cl s 0 0 0.8 c 935 1285 m 23 6 d -20 15 d -24 -6 d f black 935 1285
- m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 911 1252 m 24 6 d 27 Y -24 -6 d f
- black 911 1252 m 24 6 d 27 Y -24 -6 d cl s 0 0 0.8 c 891 1267 m 20 -15 d 27 Y
- -20 15 d f black 891 1267 m 20 -15 d 27 Y -20 15 d cl s 0 0 0.8 c 911 1279 m 24
- 6 d -21 15 d -23 -6 d f black 911 1279 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8
- c 888 1246 m 23 6 d 27 Y -23 -6 d f black 888 1246 m 23 6 d 27 Y -23 -6 d cl s
- 0 0 0.8 c 867 1261 m 21 -15 d 27 Y -21 15 d f black 867 1261 m 21 -15 d 27 Y
- -21 15 d cl s 0 0 0.8 c 888 1273 m 23 6 d -20 15 d -24 -6 d f black 888 1273 m
- 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 864 1240 m 24 6 d 13 Y -24 -6 d f black
- 864 1240 m 24 6 d 13 Y -24 -6 d cl s 0 0 0.8 c 844 1255 m 20 -15 d 13 Y -20 16
- d f black 844 1255 m 20 -15 d 13 Y -20 16 d cl s 0 0 0.8 c 864 1253 m 24 6 d
- -21 16 d -23 -6 d f black 864 1253 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c
- 841 1234 m 23 6 d -20 15 d -24 -6 d f black 841 1234 m 23 6 d -20 15 d -24 -6 d
- cl s 0 0 0.8 c 817 1228 m 24 6 d 27 Y -24 -6 d f black 817 1228 m 24 6 d 27 Y
- -24 -6 d cl s 0 0 0.8 c 797 1243 m 20 -15 d 27 Y -20 15 d f black 797 1243 m 20
- -15 d 27 Y -20 15 d cl s 0 0 0.8 c 817 1255 m 24 6 d -21 15 d -23 -6 d f black
- 817 1255 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 794 1222 m 23 6 d -20 15 d
- -24 -6 d f black 794 1222 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 770 1216 m
- 24 6 d 27 Y -24 -6 d f black 770 1216 m 24 6 d 27 Y -24 -6 d cl s 0 0 0.8 c 750
- 1231 m 20 -15 d 27 Y -20 15 d f black 750 1231 m 20 -15 d 27 Y -20 15 d cl s 0
- 0 0.8 c 770 1243 m 24 6 d -21 15 d -23 -6 d f black 770 1243 m 24 6 d -21 15 d
- -23 -6 d cl s 0 0 0.8 c 747 1210 m 23 6 d -20 15 d -24 -6 d f black 747 1210 m
- 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 723 1204 m 24 6 d 27 Y -24 -6 d f black
- 723 1204 m 24 6 d 27 Y -24 -6 d cl s 0 0 0.8 c 703 1219 m 20 -15 d 27 Y -20 15
- d f black 703 1219 m 20 -15 d 27 Y -20 15 d cl s 0 0 0.8 c 723 1231 m 24 6 d
- -21 15 d -23 -6 d f black 723 1231 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c
- 700 1198 m 23 6 d -20 15 d -24 -6 d f black 700 1198 m 23 6 d -20 15 d -24 -6 d
- cl s 0 0 0.8 c 676 1192 m 24 6 d 13 Y -24 -6 d f black 676 1192 m 24 6 d 13 Y
- -24 -6 d cl s 0 0 0.8 c 656 1207 m 20 -15 d 13 Y -20 16 d f black 656 1207 m 20
- -15 d 13 Y -20 16 d cl s 0 0 0.8 c 676 1205 m 24 6 d -21 16 d -23 -6 d f black
- 676 1205 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 653 1186 m 23 6 d 27 Y -23
- -6 d f black 653 1186 m 23 6 d 27 Y -23 -6 d cl s 0 0 0.8 c 633 1201 m 20 -15 d
- 27 Y -20 15 d f black 633 1201 m 20 -15 d 27 Y -20 15 d cl s 0 0 0.8 c 653 1213
- m 23 6 d -20 15 d -23 -6 d f black 653 1213 m 23 6 d -20 15 d -23 -6 d cl s 0 0
- 0.8 c 629 1180 m 24 6 d -20 15 d -24 -5 d f black 629 1180 m 24 6 d -20 15 d
- -24 -5 d cl s 0 0 0.8 c 606 1174 m 23 6 d 27 Y -23 -6 d f black 606 1174 m 23 6
- d 27 Y -23 -6 d cl s 0 0 0.8 c 586 1190 m 20 -16 d 27 Y -20 15 d f black 586
- 1190 m 20 -16 d 27 Y -20 15 d cl s 0 0 0.8 c 606 1201 m 23 6 d -20 15 d -23 -6
- d f black 606 1201 m 23 6 d -20 15 d -23 -6 d cl s 0 0 0.8 c 582 1168 m 24 6 d
- 13 Y -24 -6 d f black 582 1168 m 24 6 d 13 Y -24 -6 d cl s 0 0 0.8 c 562 1184 m
- 20 -16 d 13 Y -20 16 d f black 562 1184 m 20 -16 d 13 Y -20 16 d cl s 0 0 0.8 c
- 582 1181 m 24 6 d -20 16 d -24 -6 d f black 582 1181 m 24 6 d -20 16 d -24 -6 d
- cl s 0 0 0.8 c 559 1162 m 23 6 d 13 Y -23 -6 d f black 559 1162 m 23 6 d 13 Y
- -23 -6 d cl s 0 0 0.8 c 539 1178 m 20 -16 d 13 Y -20 16 d f black 539 1178 m 20
- -16 d 13 Y -20 16 d cl s 0 0 0.8 c 559 1175 m 23 6 d -20 16 d -23 -6 d f black
- 559 1175 m 23 6 d -20 16 d -23 -6 d cl s 0 0 0.8 c 535 1156 m 24 6 d -20 16 d
- -24 -6 d f black 535 1156 m 24 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 512 1150 m
- 23 6 d -20 16 d -23 -6 d f black 512 1150 m 23 6 d -20 16 d -23 -6 d cl s 0 0
- 0.8 c 488 1144 m 24 6 d 14 Y -24 -6 d f black 488 1144 m 24 6 d 14 Y -24 -6 d
- cl s 0 0 0.8 c 468 1160 m 20 -16 d 14 Y -20 15 d f black 468 1160 m 20 -16 d 14
- Y -20 15 d cl s 0 0 0.8 c 488 1158 m 24 6 d -20 15 d -24 -6 d f black 488 1158
- m 24 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 465 1138 m 23 6 d 14 Y -23 -6 d f
- black 465 1138 m 23 6 d 14 Y -23 -6 d cl s 0 0 0.8 c 445 1154 m 20 -16 d 14 Y
- -20 15 d f black 445 1154 m 20 -16 d 14 Y -20 15 d cl s 0 0 0.8 c 465 1152 m 23
- 6 d -20 15 d -23 -6 d f black 465 1152 m 23 6 d -20 15 d -23 -6 d cl s 0 0 0.8
- c 441 1132 m 24 6 d 14 Y -24 -6 d f black 441 1132 m 24 6 d 14 Y -24 -6 d cl s
- 0 0 0.8 c 421 1148 m 20 -16 d 14 Y -20 15 d f black 421 1148 m 20 -16 d 14 Y
- -20 15 d cl s 0 0 0.8 c 441 1146 m 24 6 d -20 15 d -24 -6 d f black 441 1146 m
- 24 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 418 1126 m 23 6 d -20 16 d -23 -6 d f
- black 418 1126 m 23 6 d -20 16 d -23 -6 d cl s 0 0 0.8 c 394 1120 m 24 6 d -20
- 16 d -24 -6 d f black 394 1120 m 24 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 371
- 1114 m 23 6 d -20 16 d -23 -6 d f black 371 1114 m 23 6 d -20 16 d -23 -6 d
- cl s 0 0 0.8 c 348 1108 m 23 6 d -20 16 d -24 -6 d f black 348 1108 m 23 6 d
- -20 16 d -24 -6 d cl s 0 0 0.8 c 324 1102 m 24 6 d -21 16 d -23 -6 d f black
- 324 1102 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1448 1368 m 24 6 d -21 15 d
- -23 -6 d f black 1448 1368 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 1425 1362
- m 23 6 d -20 15 d -23 -6 d f black 1425 1362 m 23 6 d -20 15 d -23 -6 d cl s 0
- 0 0.8 c 1401 1356 m 24 6 d -20 15 d -24 -6 d f black 1401 1356 m 24 6 d -20 15
- d -24 -6 d cl s 0 0 0.8 c 1378 1350 m 23 6 d -20 15 d -23 -6 d f black 1378
- 1350 m 23 6 d -20 15 d -23 -6 d cl s 0 0 0.8 c 1354 1344 m 24 6 d 27 Y -24 -6 d
- f black 1354 1344 m 24 6 d 27 Y -24 -6 d cl s 0 0 0.8 c 1334 1359 m 20 -15 d 27
- Y -20 15 d f black 1334 1359 m 20 -15 d 27 Y -20 15 d cl s 0 0 0.8 c 1354 1371
- m 24 6 d -20 15 d -24 -6 d f black 1354 1371 m 24 6 d -20 15 d -24 -6 d cl s 0
- 0 0.8 c 1331 1338 m 23 6 d 54 Y -23 -6 d f black 1331 1338 m 23 6 d 54 Y -23 -6
- d cl s 0 0 0.8 c 1311 1353 m 20 -15 d 54 Y -20 15 d f black 1311 1353 m 20 -15
- d 54 Y -20 15 d cl s 0 0 0.8 c 1331 1392 m 23 6 d -20 15 d -23 -6 d f black
- 1331 1392 m 23 6 d -20 15 d -23 -6 d cl s 0 0 0.8 c 1307 1332 m 24 6 d -20 15 d
- -24 -6 d f black 1307 1332 m 24 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1284 1326
- m 23 6 d 40 Y -23 -6 d f black 1284 1326 m 23 6 d 40 Y -23 -6 d cl s 0 0 0.8 c
- 1264 1341 m 20 -15 d 40 Y -20 16 d f black 1264 1341 m 20 -15 d 40 Y -20 16 d
- cl s 0 0 0.8 c 1284 1366 m 23 6 d -20 16 d -23 -6 d f black 1284 1366 m 23 6 d
- -20 16 d -23 -6 d cl s 0 0 0.8 c 1260 1320 m 24 6 d 13 Y -24 -6 d f black 1260
- 1320 m 24 6 d 13 Y -24 -6 d cl s 0 0 0.8 c 1240 1335 m 20 -15 d 13 Y -20 16 d f
- black 1240 1335 m 20 -15 d 13 Y -20 16 d cl s 0 0 0.8 c 1260 1333 m 24 6 d -20
- 16 d -24 -6 d f black 1260 1333 m 24 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1237
- 1314 m 23 6 d 13 Y -23 -6 d f black 1237 1314 m 23 6 d 13 Y -23 -6 d cl s 0 0
- 0.8 c 1217 1329 m 20 -15 d 13 Y -20 16 d f black 1217 1329 m 20 -15 d 13 Y -20
- 16 d cl s 0 0 0.8 c 1237 1327 m 23 6 d -20 16 d -23 -6 d f black 1237 1327 m 23
- 6 d -20 16 d -23 -6 d cl s 0 0 0.8 c 1213 1308 m 24 6 d 27 Y -24 -6 d f black
- 1213 1308 m 24 6 d 27 Y -24 -6 d cl s 0 0 0.8 c 1193 1323 m 20 -15 d 27 Y -20
- 15 d f black 1193 1323 m 20 -15 d 27 Y -20 15 d cl s 0 0 0.8 c 1213 1335 m 24 6
- d -20 15 d -24 -6 d f black 1213 1335 m 24 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c
- 1190 1302 m 23 6 d 40 Y -23 -6 d f black 1190 1302 m 23 6 d 40 Y -23 -6 d cl s
- 0 0 0.8 c 1170 1318 m 20 -16 d 40 Y -20 16 d f black 1170 1318 m 20 -16 d 40 Y
- -20 16 d cl s 0 0 0.8 c 1190 1342 m 23 6 d -20 16 d -23 -6 d f black 1190 1342
- m 23 6 d -20 16 d -23 -6 d cl s 0 0 0.8 c 1166 1296 m 24 6 d 40 Y -24 -6 d f
- black 1166 1296 m 24 6 d 40 Y -24 -6 d cl s 0 0 0.8 c 1146 1312 m 20 -16 d 40 Y
- -20 16 d f black 1146 1312 m 20 -16 d 40 Y -20 16 d cl s 0 0 0.8 c 1166 1336 m
- 24 6 d -20 16 d -24 -6 d f black 1166 1336 m 24 6 d -20 16 d -24 -6 d cl s 0 0
- 0.8 c 1143 1290 m 23 6 d 27 Y -23 -6 d f black 1143 1290 m 23 6 d 27 Y -23 -6 d
- cl s 0 0 0.8 c 1123 1306 m 20 -16 d 27 Y -20 15 d f black 1123 1306 m 20 -16 d
- 27 Y -20 15 d cl s 0 0 0.8 c 1143 1317 m 23 6 d -20 15 d -23 -6 d f black 1143
- 1317 m 23 6 d -20 15 d -23 -6 d cl s 0 0 0.8 c 1119 1284 m 24 6 d 40 Y -24 -6 d
- f black 1119 1284 m 24 6 d 40 Y -24 -6 d cl s 0 0 0.8 c 1099 1300 m 20 -16 d 40
- Y -20 16 d f black 1099 1300 m 20 -16 d 40 Y -20 16 d cl s 0 0 0.8 c 1119 1324
- m 24 6 d -20 16 d -24 -6 d f black 1119 1324 m 24 6 d -20 16 d -24 -6 d cl s 0
- 0 0.8 c 1096 1278 m 23 6 d -20 16 d -23 -6 d f black 1096 1278 m 23 6 d -20 16
- d -23 -6 d cl s 0 0 0.8 c 1073 1272 m 23 6 d -20 16 d -24 -6 d f black 1073
- 1272 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1049 1266 m 24 6 d 14 Y -24 -6 d
- f black 1049 1266 m 24 6 d 14 Y -24 -6 d cl s 0 0 0.8 c 1029 1282 m 20 -16 d 14
- Y -20 15 d f black 1029 1282 m 20 -16 d 14 Y -20 15 d cl s 0 0 0.8 c 1049 1280
- m 24 6 d -21 15 d -23 -6 d f black 1049 1280 m 24 6 d -21 15 d -23 -6 d cl s 0
- 0 0.8 c 1026 1260 m 23 6 d 14 Y -23 -6 d f black 1026 1260 m 23 6 d 14 Y -23 -6
- d cl s 0 0 0.8 c 1005 1276 m 21 -16 d 14 Y -21 15 d f black 1005 1276 m 21 -16
- d 14 Y -21 15 d cl s 0 0 0.8 c 1026 1274 m 23 6 d -20 15 d -24 -6 d f black
- 1026 1274 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1002 1254 m 24 6 d -21 16 d
- -23 -6 d f black 1002 1254 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 979 1248 m
- 23 6 d 14 Y -23 -6 d f black 979 1248 m 23 6 d 14 Y -23 -6 d cl s 0 0 0.8 c 958
- 1264 m 21 -16 d 14 Y -21 15 d f black 958 1264 m 21 -16 d 14 Y -21 15 d cl s 0
- 0 0.8 c 979 1262 m 23 6 d -20 15 d -24 -6 d f black 979 1262 m 23 6 d -20 15 d
- -24 -6 d cl s 0 0 0.8 c 955 1242 m 24 6 d -21 16 d -23 -6 d f black 955 1242 m
- 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 932 1236 m 23 6 d -20 16 d -24 -6 d f
- black 932 1236 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 908 1230 m 24 6 d 27 Y
- -24 -6 d f black 908 1230 m 24 6 d 27 Y -24 -6 d cl s 0 0 0.8 c 888 1246 m 20
- -16 d 27 Y -20 16 d f black 888 1246 m 20 -16 d 27 Y -20 16 d cl s 0 0 0.8 c
- 908 1257 m 24 6 d -21 16 d -23 -6 d f black 908 1257 m 24 6 d -21 16 d -23 -6 d
- cl s 0 0 0.8 c 885 1224 m 23 6 d 14 Y -23 -6 d f black 885 1224 m 23 6 d 14 Y
- -23 -6 d cl s 0 0 0.8 c 864 1240 m 21 -16 d 14 Y -21 15 d f black 864 1240 m 21
- -16 d 14 Y -21 15 d cl s 0 0 0.8 c 885 1238 m 23 6 d -20 15 d -24 -6 d f black
- 885 1238 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 861 1218 m 24 6 d 27 Y -24
- -6 d f black 861 1218 m 24 6 d 27 Y -24 -6 d cl s 0 0 0.8 c 841 1234 m 20 -16 d
- 27 Y -20 16 d f black 841 1234 m 20 -16 d 27 Y -20 16 d cl s 0 0 0.8 c 861 1245
- m 24 6 d -21 16 d -23 -6 d f black 861 1245 m 24 6 d -21 16 d -23 -6 d cl s 0 0
- 0.8 c 838 1212 m 23 6 d 27 Y -23 -6 d f black 838 1212 m 23 6 d 27 Y -23 -6 d
- cl s 0 0 0.8 c 817 1228 m 21 -16 d 27 Y -21 16 d f black 817 1228 m 21 -16 d 27
- Y -21 16 d cl s 0 0 0.8 c 838 1239 m 23 6 d -20 16 d -24 -6 d f black 838 1239
- m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 814 1206 m 24 6 d 54 Y -24 -6 d f
- black 814 1206 m 24 6 d 54 Y -24 -6 d cl s 0 0 0.8 c 794 1222 m 20 -16 d 54 Y
- -20 16 d f black 794 1222 m 20 -16 d 54 Y -20 16 d cl s 0 0 0.8 c 814 1260 m 24
- 6 d -21 16 d -23 -6 d f black 814 1260 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8
- c 791 1200 m 23 6 d 14 Y -23 -6 d f black 791 1200 m 23 6 d 14 Y -23 -6 d cl s
- 0 0 0.8 c 770 1216 m 21 -16 d 14 Y -21 15 d f black 770 1216 m 21 -16 d 14 Y
- -21 15 d cl s 0 0 0.8 c 791 1214 m 23 6 d -20 15 d -24 -6 d f black 791 1214 m
- 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 767 1194 m 24 6 d -21 16 d -23 -6 d f
- black 767 1194 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 744 1188 m 23 6 d 14 Y
- -23 -6 d f black 744 1188 m 23 6 d 14 Y -23 -6 d cl s 0 0 0.8 c 723 1204 m 21
- -16 d 14 Y -21 15 d f black 723 1204 m 21 -16 d 14 Y -21 15 d cl s 0 0 0.8 c
- 744 1202 m 23 6 d -20 15 d -24 -6 d f black 744 1202 m 23 6 d -20 15 d -24 -6 d
- cl s 0 0 0.8 c 720 1182 m 24 6 d -21 16 d -23 -6 d f black 720 1182 m 24 6 d
- -21 16 d -23 -6 d cl s 0 0 0.8 c 697 1176 m 23 6 d 27 Y -23 -6 d f black 697
- 1176 m 23 6 d 27 Y -23 -6 d cl s 0 0 0.8 c 676 1192 m 21 -16 d 27 Y -21 16 d f
- black 676 1192 m 21 -16 d 27 Y -21 16 d cl s 0 0 0.8 c 697 1203 m 23 6 d -20 16
- d -24 -6 d f black 697 1203 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 673 1170
- m 24 6 d 14 Y -24 -6 d f black 673 1170 m 24 6 d 14 Y -24 -6 d cl s 0 0 0.8 c
- 653 1186 m 20 -16 d 14 Y -20 15 d f black 653 1186 m 20 -16 d 14 Y -20 15 d
- cl s 0 0 0.8 c 673 1184 m 24 6 d -21 15 d -23 -6 d f black 673 1184 m 24 6 d
- -21 15 d -23 -6 d cl s 0 0 0.8 c 650 1164 m 23 6 d 41 Y -23 -6 d f black 650
- 1164 m 23 6 d 41 Y -23 -6 d cl s 0 0 0.8 c 629 1180 m 21 -16 d 41 Y -21 15 d f
- black 629 1180 m 21 -16 d 41 Y -21 15 d cl s 0 0 0.8 c 650 1205 m 23 6 d -20 15
- d -24 -6 d f black 650 1205 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 626 1158
- m 24 6 d 27 Y -24 -6 d f black 626 1158 m 24 6 d 27 Y -24 -6 d cl s 0 0 0.8 c
- 606 1174 m 20 -16 d 27 Y -20 16 d f black 606 1174 m 20 -16 d 27 Y -20 16 d
- cl s 0 0 0.8 c 626 1185 m 24 6 d -21 16 d -23 -6 d f black 626 1185 m 24 6 d
- -21 16 d -23 -6 d cl s 0 0 0.8 c 603 1152 m 23 6 d 14 Y -23 -6 d f black 603
- 1152 m 23 6 d 14 Y -23 -6 d cl s 0 0 0.8 c 582 1168 m 21 -16 d 14 Y -21 15 d f
- black 582 1168 m 21 -16 d 14 Y -21 15 d cl s 0 0 0.8 c 603 1166 m 23 6 d -20 15
- d -24 -6 d f black 603 1166 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 579 1147
- m 24 5 d 27 Y -24 -6 d f black 579 1147 m 24 5 d 27 Y -24 -6 d cl s 0 0 0.8 c
- 559 1162 m 20 -15 d 26 Y -20 16 d f black 559 1162 m 20 -15 d 26 Y -20 16 d
- cl s 0 0 0.8 c 579 1173 m 24 6 d -21 16 d -23 -6 d f black 579 1173 m 24 6 d
- -21 16 d -23 -6 d cl s 0 0 0.8 c 556 1141 m 23 6 d -20 15 d -24 -6 d f black
- 556 1141 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 532 1135 m 24 6 d 26 Y -24
- -6 d f black 532 1135 m 24 6 d 26 Y -24 -6 d cl s 0 0 0.8 c 512 1150 m 20 -15 d
- 26 Y -20 16 d f black 512 1150 m 20 -15 d 26 Y -20 16 d cl s 0 0 0.8 c 532 1161
- m 24 6 d -21 16 d -23 -6 d f black 532 1161 m 24 6 d -21 16 d -23 -6 d cl s 0 0
- 0.8 c 509 1129 m 23 6 d 53 Y -23 -6 d f black 509 1129 m 23 6 d 53 Y -23 -6 d
- cl s 0 0 0.8 c 488 1144 m 21 -15 d 53 Y -21 16 d f black 488 1144 m 21 -15 d 53
- Y -21 16 d cl s 0 0 0.8 c 509 1182 m 23 6 d -20 16 d -24 -6 d f black 509 1182
- m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 485 1123 m 24 6 d 53 Y -24 -6 d f
- black 485 1123 m 24 6 d 53 Y -24 -6 d cl s 0 0 0.8 c 465 1138 m 20 -15 d 53 Y
- -20 16 d f black 465 1138 m 20 -15 d 53 Y -20 16 d cl s 0 0 0.8 c 485 1176 m 24
- 6 d -21 16 d -23 -6 d f black 485 1176 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8
- c 462 1117 m 23 6 d 13 Y -23 -6 d f black 462 1117 m 23 6 d 13 Y -23 -6 d cl s
- 0 0 0.8 c 441 1132 m 21 -15 d 13 Y -21 16 d f black 441 1132 m 21 -15 d 13 Y
- -21 16 d cl s 0 0 0.8 c 462 1130 m 23 6 d -20 16 d -24 -6 d f black 462 1130 m
- 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 438 1111 m 24 6 d 53 Y -24 -6 d f black
- 438 1111 m 24 6 d 53 Y -24 -6 d cl s 0 0 0.8 c 418 1126 m 20 -15 d 53 Y -20 16
- d f black 418 1126 m 20 -15 d 53 Y -20 16 d cl s 0 0 0.8 c 438 1164 m 24 6 d
- -21 16 d -23 -6 d f black 438 1164 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c
- 415 1105 m 23 6 d -20 15 d -24 -6 d f black 415 1105 m 23 6 d -20 15 d -24 -6 d
- cl s 0 0 0.8 c 391 1099 m 24 6 d -21 15 d -23 -6 d f black 391 1099 m 24 6 d
- -21 15 d -23 -6 d cl s 0 0 0.8 c 368 1093 m 23 6 d -20 15 d -23 -6 d f black
- 368 1093 m 23 6 d -20 15 d -23 -6 d cl s 0 0 0.8 c 344 1087 m 24 6 d -20 15 d
- -24 -6 d f black 344 1087 m 24 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1469 1352 m
- 23 6 d -20 16 d -24 -6 d f black 1469 1352 m 23 6 d -20 16 d -24 -6 d cl s 0 0
- 0.8 c 1445 1346 m 24 6 d -21 16 d -23 -6 d f black 1445 1346 m 24 6 d -21 16 d
- -23 -6 d cl s 0 0 0.8 c 1422 1340 m 23 6 d -20 16 d -24 -6 d f black 1422 1340
- m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1398 1334 m 24 6 d -21 16 d -23 -6 d
- f black 1398 1334 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1375 1328 m 23 6 d
- 62 Y -23 -6 d f 0 0.2 0.8 c 1398 1396 m 5 Y -23 -6 d -5 Y f black 1375 1328 m
- 23 6 d 67 Y -23 -6 d cl s 0 0 0.8 c 1354 1344 m 21 -16 d 62 Y -21 16 d f 0 0.2
- 0.8 c 1375 1390 m 5 Y -21 16 d -5 Y f black 1354 1344 m 21 -16 d 67 Y -21 16 d
- cl s 0 0.2 0.8 c 1375 1395 m 23 6 d -20 16 d -24 -6 d f black 1375 1395 m 23 6
- d -20 16 d -24 -6 d cl s 0 0 0.8 c 1351 1322 m 24 6 d -21 16 d -23 -6 d f black
- 1351 1322 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1328 1316 m 23 6 d 14 Y -23
- -6 d f black 1328 1316 m 23 6 d 14 Y -23 -6 d cl s 0 0 0.8 c 1307 1332 m 21 -16
- d 14 Y -21 15 d f black 1307 1332 m 21 -16 d 14 Y -21 15 d cl s 0 0 0.8 c 1328
- 1330 m 23 6 d -20 15 d -24 -6 d f black 1328 1330 m 23 6 d -20 15 d -24 -6 d
- cl s 0 0 0.8 c 1304 1310 m 24 6 d 41 Y -24 -6 d f black 1304 1310 m 24 6 d 41 Y
- -24 -6 d cl s 0 0 0.8 c 1284 1326 m 20 -16 d 41 Y -20 15 d f black 1284 1326 m
- 20 -16 d 41 Y -20 15 d cl s 0 0 0.8 c 1304 1351 m 24 6 d -21 15 d -23 -6 d f
- black 1304 1351 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 1281 1304 m 23 6 d 54
- Y -23 -6 d f black 1281 1304 m 23 6 d 54 Y -23 -6 d cl s 0 0 0.8 c 1260 1320 m
- 21 -16 d 54 Y -21 16 d f black 1260 1320 m 21 -16 d 54 Y -21 16 d cl s 0 0 0.8
- c 1281 1358 m 23 6 d -20 16 d -24 -6 d f black 1281 1358 m 23 6 d -20 16 d -24
- -6 d cl s 0 0 0.8 c 1257 1298 m 24 6 d 14 Y -24 -6 d f black 1257 1298 m 24 6 d
- 14 Y -24 -6 d cl s 0 0 0.8 c 1237 1314 m 20 -16 d 14 Y -20 15 d f black 1237
- 1314 m 20 -16 d 14 Y -20 15 d cl s 0 0 0.8 c 1257 1312 m 24 6 d -21 15 d -23 -6
- d f black 1257 1312 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 1234 1292 m 23 6
- d 63 Y -23 -6 d f 0 0.2 0.8 c 1257 1361 m 18 Y -23 -6 d -18 Y f black 1234 1292
- m 23 6 d 81 Y -23 -6 d cl s 0 0 0.8 c 1213 1308 m 21 -16 d 63 Y -21 15 d f 0
- 0.2 0.8 c 1234 1355 m 18 Y -21 16 d -19 Y f black 1213 1308 m 21 -16 d 81 Y -21
- 16 d cl s 0 0.2 0.8 c 1234 1373 m 23 6 d -20 16 d -24 -6 d f black 1234 1373 m
- 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1210 1286 m 24 6 d 63 Y -24 -6 d f 0
- 0.2 0.8 c 1234 1355 m 45 Y -24 -6 d -45 Y f black 1210 1286 m 24 6 d 108 Y -24
- -6 d cl s 0 0 0.8 c 1190 1302 m 20 -16 d 63 Y -20 15 d f 0 0.2 0.8 c 1210 1349
- m 45 Y -20 15 d -45 Y f black 1190 1302 m 20 -16 d 108 Y -20 15 d cl s 0 0.2
- 0.8 c 1210 1394 m 24 6 d -21 15 d -23 -6 d f black 1210 1394 m 24 6 d -21 15 d
- -23 -6 d cl s 0 0 0.8 c 1187 1280 m 23 6 d 14 Y -23 -6 d f black 1187 1280 m 23
- 6 d 14 Y -23 -6 d cl s 0 0 0.8 c 1166 1296 m 21 -16 d 14 Y -21 15 d f black
- 1166 1296 m 21 -16 d 14 Y -21 15 d cl s 0 0 0.8 c 1187 1294 m 23 6 d -20 15 d
- -24 -6 d f black 1187 1294 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1163 1274
- m 24 6 d 63 Y -24 -6 d f 0 0.2 0.8 c 1187 1343 m 5 Y -24 -6 d -5 Y f black 1163
- 1274 m 24 6 d 68 Y -24 -6 d cl s 0 0 0.8 c 1143 1290 m 20 -16 d 63 Y -20 15 d f
- 0 0.2 0.8 c 1163 1337 m 5 Y -20 15 d -5 Y f black 1143 1290 m 20 -16 d 68 Y -20
- 15 d cl s 0 0.2 0.8 c 1163 1342 m 24 6 d -21 15 d -23 -6 d f black 1163 1342 m
- 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 1140 1269 m 23 5 d 54 Y -23 -6 d f
- black 1140 1269 m 23 5 d 54 Y -23 -6 d cl s 0 0 0.8 c 1119 1284 m 21 -15 d 53 Y
- -21 16 d f black 1119 1284 m 21 -15 d 53 Y -21 16 d cl s 0 0 0.8 c 1140 1322 m
- 23 6 d -20 16 d -24 -6 d f black 1140 1322 m 23 6 d -20 16 d -24 -6 d cl s 0 0
- 0.8 c 1116 1263 m 24 6 d 53 Y -24 -6 d f black 1116 1263 m 24 6 d 53 Y -24 -6 d
- cl s 0 0 0.8 c 1096 1278 m 20 -15 d 53 Y -20 16 d f black 1096 1278 m 20 -15 d
- 53 Y -20 16 d cl s 0 0 0.8 c 1116 1316 m 24 6 d -21 16 d -23 -6 d f black 1116
- 1316 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1093 1257 m 23 6 d 40 Y -23 -6 d
- f black 1093 1257 m 23 6 d 40 Y -23 -6 d cl s 0 0 0.8 c 1073 1272 m 20 -15 d 40
- Y -20 15 d f black 1073 1272 m 20 -15 d 40 Y -20 15 d cl s 0 0 0.8 c 1093 1297
- m 23 6 d -20 15 d -23 -6 d f black 1093 1297 m 23 6 d -20 15 d -23 -6 d cl s 0
- 0 0.8 c 1069 1251 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1093 1319 m 45 Y -24 -6
- d -45 Y f black 1069 1251 m 24 6 d 107 Y -24 -6 d cl s 0 0 0.8 c 1049 1266 m 20
- -15 d 62 Y -20 15 d f 0 0.2 0.8 c 1069 1313 m 45 Y -20 16 d -46 Y f black 1049
- 1266 m 20 -15 d 107 Y -20 16 d cl s 0 0.2 0.8 c 1069 1358 m 24 6 d -20 16 d -24
- -6 d f black 1069 1358 m 24 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1046 1245 m 23
- 6 d 40 Y -23 -6 d f black 1046 1245 m 23 6 d 40 Y -23 -6 d cl s 0 0 0.8 c 1026
- 1260 m 20 -15 d 40 Y -20 15 d f black 1026 1260 m 20 -15 d 40 Y -20 15 d cl s 0
- 0 0.8 c 1046 1285 m 23 6 d -20 15 d -23 -6 d f black 1046 1285 m 23 6 d -20 15
- d -23 -6 d cl s 0 0 0.8 c 1022 1239 m 24 6 d 26 Y -24 -6 d f black 1022 1239 m
- 24 6 d 26 Y -24 -6 d cl s 0 0 0.8 c 1002 1254 m 20 -15 d 26 Y -20 16 d f black
- 1002 1254 m 20 -15 d 26 Y -20 16 d cl s 0 0 0.8 c 1022 1265 m 24 6 d -20 16 d
- -24 -6 d f black 1022 1265 m 24 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 999 1233 m
- 23 6 d 53 Y -23 -6 d f black 999 1233 m 23 6 d 53 Y -23 -6 d cl s 0 0 0.8 c 979
- 1248 m 20 -15 d 53 Y -20 16 d f black 979 1248 m 20 -15 d 53 Y -20 16 d cl s 0
- 0 0.8 c 999 1286 m 23 6 d -20 16 d -23 -6 d f black 999 1286 m 23 6 d -20 16 d
- -23 -6 d cl s 0 0 0.8 c 975 1227 m 24 6 d 13 Y -24 -6 d f black 975 1227 m 24 6
- d 13 Y -24 -6 d cl s 0 0 0.8 c 955 1242 m 20 -15 d 13 Y -20 16 d f black 955
- 1242 m 20 -15 d 13 Y -20 16 d cl s 0 0 0.8 c 975 1240 m 24 6 d -20 16 d -24 -6
- d f black 975 1240 m 24 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 952 1221 m 23 6 d
- 62 Y -23 -6 d f 0 0.2 0.8 c 975 1289 m 5 Y -23 -6 d -5 Y f black 952 1221 m 23
- 6 d 67 Y -23 -6 d cl s 0 0 0.8 c 932 1236 m 20 -15 d 62 Y -20 15 d f 0 0.2 0.8
- c 952 1283 m 5 Y -20 15 d -5 Y f black 932 1236 m 20 -15 d 67 Y -20 15 d cl s 0
- 0.2 0.8 c 952 1288 m 23 6 d -20 15 d -23 -6 d f black 952 1288 m 23 6 d -20 15
- d -23 -6 d cl s 0 0 0.8 c 928 1215 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 952
- 1283 m 5 Y -24 -6 d -5 Y f black 928 1215 m 24 6 d 67 Y -24 -6 d cl s 0 0 0.8 c
- 908 1230 m 20 -15 d 62 Y -20 15 d f 0 0.2 0.8 c 928 1277 m 5 Y -20 15 d -5 Y f
- black 908 1230 m 20 -15 d 67 Y -20 15 d cl s 0 0.2 0.8 c 928 1282 m 24 6 d -20
- 15 d -24 -6 d f black 928 1282 m 24 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 905
- 1209 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 928 1277 m 5 Y -23 -6 d -5 Y f black
- 905 1209 m 23 6 d 67 Y -23 -6 d cl s 0 0 0.8 c 885 1224 m 20 -15 d 62 Y -20 15
- d f 0 0.2 0.8 c 905 1271 m 5 Y -20 15 d -5 Y f black 885 1224 m 20 -15 d 67 Y
- -20 15 d cl s 0 0.2 0.8 c 905 1276 m 23 6 d -20 15 d -23 -6 d f black 905 1276
- m 23 6 d -20 15 d -23 -6 d cl s 0 0 0.8 c 881 1203 m 24 6 d 27 Y -24 -6 d f
- black 881 1203 m 24 6 d 27 Y -24 -6 d cl s 0 0 0.8 c 861 1218 m 20 -15 d 27 Y
- -20 15 d f black 861 1218 m 20 -15 d 27 Y -20 15 d cl s 0 0 0.8 c 881 1230 m 24
- 6 d -20 15 d -24 -6 d f black 881 1230 m 24 6 d -20 15 d -24 -6 d cl s 0 0 0.8
- c 858 1197 m 23 6 d 53 Y -23 -6 d f black 858 1197 m 23 6 d 53 Y -23 -6 d cl s
- 0 0 0.8 c 838 1212 m 20 -15 d 53 Y -20 16 d f black 838 1212 m 20 -15 d 53 Y
- -20 16 d cl s 0 0 0.8 c 858 1250 m 23 6 d -20 16 d -23 -6 d f black 858 1250 m
- 23 6 d -20 16 d -23 -6 d cl s 0 0 0.8 c 834 1191 m 24 6 d 62 Y -24 -6 d f 0 0.2
- 0.8 c 858 1259 m 18 Y -24 -6 d -18 Y f black 834 1191 m 24 6 d 80 Y -24 -6 d
- cl s 0 0 0.8 c 814 1206 m 20 -15 d 62 Y -20 15 d f 0 0.2 0.8 c 834 1253 m 18 Y
- -20 16 d -19 Y f black 814 1206 m 20 -15 d 80 Y -20 16 d cl s 0 0.2 0.8 c 834
- 1271 m 24 6 d -20 16 d -24 -6 d f black 834 1271 m 24 6 d -20 16 d -24 -6 d
- cl s 0 0 0.8 c 811 1185 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 834 1253 m 32 Y
- -23 -6 d -32 Y f black 811 1185 m 23 6 d 94 Y -23 -6 d cl s 0 0 0.8 c 791 1200
- m 20 -15 d 62 Y -20 15 d f 0 0.2 0.8 c 811 1247 m 32 Y -20 15 d -32 Y f black
- 791 1200 m 20 -15 d 94 Y -20 15 d cl s 0 0.2 0.8 c 811 1279 m 23 6 d -20 15 d
- -23 -6 d f black 811 1279 m 23 6 d -20 15 d -23 -6 d cl s 0 0 0.8 c 787 1179 m
- 24 6 d 27 Y -24 -6 d f black 787 1179 m 24 6 d 27 Y -24 -6 d cl s 0 0 0.8 c 767
- 1194 m 20 -15 d 27 Y -20 15 d f black 767 1194 m 20 -15 d 27 Y -20 15 d cl s 0
- 0 0.8 c 787 1206 m 24 6 d -20 15 d -24 -6 d f black 787 1206 m 24 6 d -20 15 d
- -24 -6 d cl s 0 0 0.8 c 764 1173 m 23 6 d 40 Y -23 -6 d f black 764 1173 m 23 6
- d 40 Y -23 -6 d cl s 0 0 0.8 c 744 1188 m 20 -15 d 40 Y -20 16 d f black 744
- 1188 m 20 -15 d 40 Y -20 16 d cl s 0 0 0.8 c 764 1213 m 23 6 d -20 16 d -23 -6
- d f black 764 1213 m 23 6 d -20 16 d -23 -6 d cl s 0 0 0.8 c 741 1167 m 23 6 d
- 27 Y -23 -6 d f black 741 1167 m 23 6 d 27 Y -23 -6 d cl s 0 0 0.8 c 720 1182 m
- 21 -15 d 27 Y -21 15 d f black 720 1182 m 21 -15 d 27 Y -21 15 d cl s 0 0 0.8 c
- 741 1194 m 23 6 d -20 15 d -24 -6 d f black 741 1194 m 23 6 d -20 15 d -24 -6 d
- cl s 0 0 0.8 c 717 1161 m 24 6 d 13 Y -24 -6 d f black 717 1161 m 24 6 d 13 Y
- -24 -6 d cl s 0 0 0.8 c 697 1176 m 20 -15 d 13 Y -20 16 d f black 697 1176 m 20
- -15 d 13 Y -20 16 d cl s 0 0 0.8 c 717 1174 m 24 6 d -21 16 d -23 -6 d f black
- 717 1174 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 694 1155 m 23 6 d 62 Y -23
- -6 d f 0 0.2 0.8 c 717 1223 m 32 Y -23 -6 d -32 Y f black 694 1155 m 23 6 d 94
- Y -23 -6 d cl s 0 0 0.8 c 673 1170 m 21 -15 d 62 Y -21 16 d f 0 0.2 0.8 c 694
- 1217 m 32 Y -21 15 d -31 Y f black 673 1170 m 21 -15 d 94 Y -21 15 d cl s 0 0.2
- 0.8 c 694 1249 m 23 6 d -20 15 d -24 -6 d f black 694 1249 m 23 6 d -20 15 d
- -24 -6 d cl s 0 0 0.8 c 670 1149 m 24 6 d 40 Y -24 -6 d f black 670 1149 m 24 6
- d 40 Y -24 -6 d cl s 0 0 0.8 c 650 1164 m 20 -15 d 40 Y -20 16 d f black 650
- 1164 m 20 -15 d 40 Y -20 16 d cl s 0 0 0.8 c 670 1189 m 24 6 d -21 16 d -23 -6
- d f black 670 1189 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 647 1143 m 23 6 d
- 54 Y -23 -6 d f black 647 1143 m 23 6 d 54 Y -23 -6 d cl s 0 0 0.8 c 626 1158 m
- 21 -15 d 54 Y -21 15 d f black 626 1158 m 21 -15 d 54 Y -21 15 d cl s 0 0 0.8 c
- 647 1197 m 23 6 d -20 15 d -24 -6 d f black 647 1197 m 23 6 d -20 15 d -24 -6 d
- cl s 0 0 0.8 c 623 1137 m 24 6 d 54 Y -24 -6 d f black 623 1137 m 24 6 d 54 Y
- -24 -6 d cl s 0 0 0.8 c 603 1152 m 20 -15 d 54 Y -20 15 d f black 603 1152 m 20
- -15 d 54 Y -20 15 d cl s 0 0 0.8 c 623 1191 m 24 6 d -21 15 d -23 -6 d f black
- 623 1191 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 600 1131 m 23 6 d 27 Y -23
- -6 d f black 600 1131 m 23 6 d 27 Y -23 -6 d cl s 0 0 0.8 c 579 1147 m 21 -16 d
- 27 Y -21 15 d f black 579 1147 m 21 -16 d 27 Y -21 15 d cl s 0 0 0.8 c 600 1158
- m 23 6 d -20 15 d -24 -6 d f black 600 1158 m 23 6 d -20 15 d -24 -6 d cl s 0 0
- 0.8 c 576 1125 m 24 6 d 27 Y -24 -6 d f black 576 1125 m 24 6 d 27 Y -24 -6 d
- cl s 0 0 0.8 c 556 1141 m 20 -16 d 27 Y -20 15 d f black 556 1141 m 20 -16 d 27
- Y -20 15 d cl s 0 0 0.8 c 576 1152 m 24 6 d -21 15 d -23 -6 d f black 576 1152
- m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 553 1119 m 23 6 d 40 Y -23 -6 d f
- black 553 1119 m 23 6 d 40 Y -23 -6 d cl s 0 0 0.8 c 532 1135 m 21 -16 d 40 Y
- -21 16 d f black 532 1135 m 21 -16 d 40 Y -21 16 d cl s 0 0 0.8 c 553 1159 m 23
- 6 d -20 16 d -24 -6 d f black 553 1159 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8
- c 529 1113 m 24 6 d 40 Y -24 -6 d f black 529 1113 m 24 6 d 40 Y -24 -6 d cl s
- 0 0 0.8 c 509 1129 m 20 -16 d 40 Y -20 16 d f black 509 1129 m 20 -16 d 40 Y
- -20 16 d cl s 0 0 0.8 c 529 1153 m 24 6 d -21 16 d -23 -6 d f black 529 1153 m
- 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 506 1107 m 23 6 d 54 Y -23 -6 d f black
- 506 1107 m 23 6 d 54 Y -23 -6 d cl s 0 0 0.8 c 485 1123 m 21 -16 d 54 Y -21 15
- d f black 485 1123 m 21 -16 d 54 Y -21 15 d cl s 0 0 0.8 c 506 1161 m 23 6 d
- -20 15 d -24 -6 d f black 506 1161 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c
- 482 1101 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 506 1169 m 19 Y -24 -6 d -19 Y f
- black 482 1101 m 24 6 d 81 Y -24 -6 d cl s 0 0 0.8 c 462 1117 m 20 -16 d 62 Y
- -20 16 d f 0 0.2 0.8 c 482 1163 m 19 Y -20 15 d -18 Y f black 462 1117 m 20 -16
- d 81 Y -20 15 d cl s 0 0.2 0.8 c 482 1182 m 24 6 d -21 15 d -23 -6 d f black
- 482 1182 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 459 1095 m 23 6 d 14 Y -23
- -6 d f black 459 1095 m 23 6 d 14 Y -23 -6 d cl s 0 0 0.8 c 438 1111 m 21 -16 d
- 14 Y -21 15 d f black 438 1111 m 21 -16 d 14 Y -21 15 d cl s 0 0 0.8 c 459 1109
- m 23 6 d -20 15 d -24 -6 d f black 459 1109 m 23 6 d -20 15 d -24 -6 d cl s 0 0
- 0.8 c 435 1089 m 24 6 d -21 16 d -23 -6 d f black 435 1089 m 24 6 d -21 16 d
- -23 -6 d cl s 0 0 0.8 c 412 1083 m 23 6 d -20 16 d -24 -6 d f black 412 1083 m
- 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 388 1077 m 24 6 d -21 16 d -23 -6 d f
- black 388 1077 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 365 1071 m 23 6 d -20
- 16 d -24 -6 d f black 365 1071 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1489
- 1337 m 24 6 d -21 15 d -23 -6 d f black 1489 1337 m 24 6 d -21 15 d -23 -6 d
- cl s 0 0 0.8 c 1466 1331 m 23 6 d -20 15 d -24 -6 d f black 1466 1331 m 23 6 d
- -20 15 d -24 -6 d cl s 0 0 0.8 c 1442 1325 m 24 6 d -21 15 d -23 -6 d f black
- 1442 1325 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 1419 1319 m 23 6 d -20 15 d
- -24 -6 d f black 1419 1319 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1395 1313
- m 24 6 d 53 Y -24 -5 d f black 1395 1313 m 24 6 d 53 Y -24 -5 d cl s 0 0 0.8 c
- 1375 1328 m 20 -15 d 54 Y -20 15 d f black 1375 1328 m 20 -15 d 54 Y -20 15 d
- cl s 0 0 0.8 c 1395 1367 m 24 5 d -21 16 d -23 -6 d f black 1395 1367 m 24 5 d
- -21 16 d -23 -6 d cl s 0 0 0.8 c 1372 1307 m 23 6 d 54 Y -23 -6 d f black 1372
- 1307 m 23 6 d 54 Y -23 -6 d cl s 0 0 0.8 c 1351 1322 m 21 -15 d 54 Y -21 15 d f
- black 1351 1322 m 21 -15 d 54 Y -21 15 d cl s 0 0 0.8 c 1372 1361 m 23 6 d -20
- 15 d -24 -6 d f black 1372 1361 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1348
- 1301 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1372 1369 m 32 Y -24 -6 d -32 Y f
- black 1348 1301 m 24 6 d 94 Y -24 -6 d cl s 0 0 0.8 c 1328 1316 m 20 -15 d 62 Y
- -20 15 d f 0 0.2 0.8 c 1348 1363 m 32 Y -20 15 d -32 Y f black 1328 1316 m 20
- -15 d 94 Y -20 15 d cl s 0 0.2 0.8 c 1348 1395 m 24 6 d -21 15 d -23 -6 d f
- black 1348 1395 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 1325 1295 m 23 6 d 62
- Y -23 -6 d f 0 0.2 0.8 c 1348 1363 m 32 Y -23 -6 d -32 Y f black 1325 1295 m 23
- 6 d 94 Y -23 -6 d cl s 0 0 0.8 c 1304 1310 m 21 -15 d 62 Y -21 16 d f 0 0.2 0.8
- c 1325 1357 m 32 Y -21 15 d -31 Y f black 1304 1310 m 21 -15 d 94 Y -21 15 d
- cl s 0 0.2 0.8 c 1325 1389 m 23 6 d -20 15 d -24 -6 d f black 1325 1389 m 23 6
- d -20 15 d -24 -6 d cl s 0 0 0.8 c 1301 1289 m 24 6 d 27 Y -24 -6 d f black
- 1301 1289 m 24 6 d 27 Y -24 -6 d cl s 0 0 0.8 c 1281 1304 m 20 -15 d 27 Y -20
- 15 d f black 1281 1304 m 20 -15 d 27 Y -20 15 d cl s 0 0 0.8 c 1301 1316 m 24 6
- d -21 15 d -23 -6 d f black 1301 1316 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c
- 1278 1283 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 1301 1351 m 32 Y -23 -6 d -32 Y
- f black 1278 1283 m 23 6 d 94 Y -23 -6 d cl s 0 0 0.8 c 1257 1298 m 21 -15 d 62
- Y -21 16 d f 0 0.2 0.8 c 1278 1345 m 32 Y -21 15 d -31 Y f black 1257 1298 m 21
- -15 d 94 Y -21 15 d cl s 0 0.2 0.8 c 1278 1377 m 23 6 d -20 15 d -24 -6 d f
- black 1278 1377 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1254 1277 m 24 6 d 62
- Y -24 -6 d f 0 0.2 0.8 c 1278 1345 m 45 Y -24 -6 d -45 Y f black 1254 1277 m 24
- 6 d 107 Y -24 -6 d cl s 0 0 0.8 c 1234 1292 m 20 -15 d 62 Y -20 16 d f 0 0.2
- 0.8 c 1254 1339 m 45 Y -20 16 d -45 Y f black 1234 1292 m 20 -15 d 107 Y -20 16
- d cl s 0 0.2 0.8 c 1254 1384 m 24 6 d -21 16 d -23 -6 d f black 1254 1384 m 24
- 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1231 1271 m 23 6 d 62 Y -23 -6 d f 0 0.2
- 0.8 c 1254 1339 m 19 Y -23 -6 d -19 Y f black 1231 1271 m 23 6 d 81 Y -23 -6 d
- cl s 0 0 0.8 c 1210 1286 m 21 -15 d 62 Y -21 16 d f 0 0.2 0.8 c 1231 1333 m 19
- Y -21 15 d -18 Y f black 1210 1286 m 21 -15 d 81 Y -21 15 d cl s 0 0.2 0.8 c
- 1231 1352 m 23 6 d -20 15 d -24 -6 d f black 1231 1352 m 23 6 d -20 15 d -24 -6
- d cl s 0 0 0.8 c 1207 1265 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1231 1333 m 19
- Y -24 -6 d -19 Y f black 1207 1265 m 24 6 d 81 Y -24 -6 d cl s 0 0 0.8 c 1187
- 1280 m 20 -15 d 62 Y -20 16 d f 0 0.2 0.8 c 1207 1327 m 19 Y -20 15 d -18 Y f
- black 1187 1280 m 20 -15 d 81 Y -20 15 d cl s 0 0.2 0.8 c 1207 1346 m 24 6 d
- -21 15 d -23 -6 d f black 1207 1346 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c
- 1184 1259 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 1207 1327 m 19 Y -23 -6 d -19 Y
- f black 1184 1259 m 23 6 d 81 Y -23 -6 d cl s 0 0 0.8 c 1163 1274 m 21 -15 d 62
- Y -21 16 d f 0 0.2 0.8 c 1184 1321 m 19 Y -21 15 d -18 Y f black 1163 1274 m 21
- -15 d 81 Y -21 15 d cl s 0 0.2 0.8 c 1184 1340 m 23 6 d -20 15 d -24 -6 d f
- black 1184 1340 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1160 1253 m 24 6 d 40
- Y -24 -6 d f black 1160 1253 m 24 6 d 40 Y -24 -6 d cl s 0 0 0.8 c 1140 1269 m
- 20 -16 d 40 Y -20 16 d f black 1140 1269 m 20 -16 d 40 Y -20 16 d cl s 0 0 0.8
- c 1160 1293 m 24 6 d -21 16 d -23 -6 d f black 1160 1293 m 24 6 d -21 16 d -23
- -6 d cl s 0 0 0.8 c 1137 1247 m 23 6 d 54 Y -23 -6 d f black 1137 1247 m 23 6 d
- 54 Y -23 -6 d cl s 0 0 0.8 c 1116 1263 m 21 -16 d 54 Y -21 15 d f black 1116
- 1263 m 21 -16 d 54 Y -21 15 d cl s 0 0 0.8 c 1137 1301 m 23 6 d -20 15 d -24 -6
- d f black 1137 1301 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1113 1241 m 24 6
- d 54 Y -24 -6 d f black 1113 1241 m 24 6 d 54 Y -24 -6 d cl s 0 0 0.8 c 1093
- 1257 m 20 -16 d 54 Y -20 15 d f black 1093 1257 m 20 -16 d 54 Y -20 15 d cl s 0
- 0 0.8 c 1113 1295 m 24 6 d -21 15 d -23 -6 d f black 1113 1295 m 24 6 d -21 15
- d -23 -6 d cl s 0 0 0.8 c 1090 1235 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 1113
- 1303 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 1113 1365 m 10 Y -23 -6 d -10 Y f
- black 1090 1235 m 23 6 d 134 Y -23 -6 d cl s 0 0 0.8 c 1069 1251 m 21 -16 d 62
- Y -21 16 d f 0 0.2 0.8 c 1090 1297 m 62 Y -21 16 d -62 Y f 0 0.4 0.8 c 1090
- 1359 m 10 Y -21 16 d -10 Y f black 1069 1251 m 21 -16 d 134 Y -21 16 d cl s 0
- 0.4 0.8 c 1090 1369 m 23 6 d -20 16 d -24 -6 d f black 1090 1369 m 23 6 d -20
- 16 d -24 -6 d cl s 0 0 0.8 c 1066 1229 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c
- 1090 1297 m 32 Y -24 -6 d -32 Y f black 1066 1229 m 24 6 d 94 Y -24 -6 d cl s 0
- 0 0.8 c 1046 1245 m 20 -16 d 62 Y -20 16 d f 0 0.2 0.8 c 1066 1291 m 32 Y -20
- 16 d -32 Y f black 1046 1245 m 20 -16 d 94 Y -20 16 d cl s 0 0.2 0.8 c 1066
- 1323 m 24 6 d -21 16 d -23 -6 d f black 1066 1323 m 24 6 d -21 16 d -23 -6 d
- cl s 0 0 0.8 c 1043 1223 m 23 6 d 54 Y -23 -6 d f black 1043 1223 m 23 6 d 54 Y
- -23 -6 d cl s 0 0 0.8 c 1022 1239 m 21 -16 d 54 Y -21 15 d f black 1022 1239 m
- 21 -16 d 54 Y -21 15 d cl s 0 0 0.8 c 1043 1277 m 23 6 d -20 15 d -24 -6 d f
- black 1043 1277 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1019 1217 m 24 6 d 62
- Y -24 -6 d f 0 0.2 0.8 c 1043 1285 m 19 Y -24 -6 d -19 Y f black 1019 1217 m 24
- 6 d 81 Y -24 -6 d cl s 0 0 0.8 c 999 1233 m 20 -16 d 62 Y -20 16 d f 0 0.2 0.8
- c 1019 1279 m 19 Y -20 15 d -18 Y f black 999 1233 m 20 -16 d 81 Y -20 15 d
- cl s 0 0.2 0.8 c 1019 1298 m 24 6 d -21 15 d -23 -6 d f black 1019 1298 m 24 6
- d -21 15 d -23 -6 d cl s 0 0 0.8 c 996 1211 m 23 6 d 27 Y -23 -6 d f black 996
- 1211 m 23 6 d 27 Y -23 -6 d cl s 0 0 0.8 c 975 1227 m 21 -16 d 27 Y -21 16 d f
- black 975 1227 m 21 -16 d 27 Y -21 16 d cl s 0 0 0.8 c 996 1238 m 23 6 d -20 15
- d -24 -5 d f black 996 1238 m 23 6 d -20 15 d -24 -5 d cl s 0 0 0.8 c 972 1205
- m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 996 1273 m 46 Y -24 -6 d -46 Y f black 972
- 1205 m 24 6 d 108 Y -24 -6 d cl s 0 0 0.8 c 952 1221 m 20 -16 d 62 Y -20 16 d f
- 0 0.2 0.8 c 972 1267 m 46 Y -20 15 d -45 Y f black 952 1221 m 20 -16 d 108 Y
- -20 15 d cl s 0 0.2 0.8 c 972 1313 m 24 6 d -21 15 d -23 -6 d f black 972 1313
- m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 949 1199 m 23 6 d 62 Y -23 -6 d f 0
- 0.2 0.8 c 972 1267 m 46 Y -23 -6 d -46 Y f black 949 1199 m 23 6 d 108 Y -23 -6
- d cl s 0 0 0.8 c 928 1215 m 21 -16 d 62 Y -21 16 d f 0 0.2 0.8 c 949 1261 m 46
- Y -21 15 d -45 Y f black 928 1215 m 21 -16 d 108 Y -21 15 d cl s 0 0.2 0.8 c
- 949 1307 m 23 6 d -20 15 d -24 -6 d f black 949 1307 m 23 6 d -20 15 d -24 -6 d
- cl s 0 0 0.8 c 925 1193 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 949 1261 m 59 Y
- -24 -6 d -59 Y f black 925 1193 m 24 6 d 121 Y -24 -6 d cl s 0 0 0.8 c 905 1209
- m 20 -16 d 62 Y -20 16 d f 0 0.2 0.8 c 925 1255 m 59 Y -20 16 d -59 Y f black
- 905 1209 m 20 -16 d 121 Y -20 16 d cl s 0 0.2 0.8 c 925 1314 m 24 6 d -21 16 d
- -23 -6 d f black 925 1314 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 902 1187 m
- 23 6 d 27 Y -23 -6 d f black 902 1187 m 23 6 d 27 Y -23 -6 d cl s 0 0 0.8 c 881
- 1203 m 21 -16 d 27 Y -21 16 d f black 881 1203 m 21 -16 d 27 Y -21 16 d cl s 0
- 0 0.8 c 902 1214 m 23 6 d -20 16 d -24 -6 d f black 902 1214 m 23 6 d -20 16 d
- -24 -6 d cl s 0 0 0.8 c 878 1181 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 902 1249
- m 5 Y -24 -6 d -5 Y f black 878 1181 m 24 6 d 67 Y -24 -6 d cl s 0 0 0.8 c 858
- 1197 m 20 -16 d 62 Y -20 16 d f 0 0.2 0.8 c 878 1243 m 5 Y -20 16 d -5 Y f
- black 858 1197 m 20 -16 d 67 Y -20 16 d cl s 0 0.2 0.8 c 878 1248 m 24 6 d -21
- 16 d -23 -6 d f black 878 1248 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 855
- 1175 m 23 6 d 27 Y -23 -6 d f black 855 1175 m 23 6 d 27 Y -23 -6 d cl s 0 0
- 0.8 c 834 1191 m 21 -16 d 27 Y -21 16 d f black 834 1191 m 21 -16 d 27 Y -21 16
- d cl s 0 0 0.8 c 855 1202 m 23 6 d -20 16 d -24 -6 d f black 855 1202 m 23 6 d
- -20 16 d -24 -6 d cl s 0 0 0.8 c 831 1169 m 24 6 d 41 Y -24 -6 d f black 831
- 1169 m 24 6 d 41 Y -24 -6 d cl s 0 0 0.8 c 811 1185 m 20 -16 d 41 Y -20 15 d f
- black 811 1185 m 20 -16 d 41 Y -20 15 d cl s 0 0 0.8 c 831 1210 m 24 6 d -21 15
- d -23 -6 d f black 831 1210 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 808 1163
- m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 831 1231 m 5 Y -23 -6 d -5 Y f black 808
- 1163 m 23 6 d 67 Y -23 -6 d cl s 0 0 0.8 c 787 1179 m 21 -16 d 62 Y -21 16 d f
- 0 0.2 0.8 c 808 1225 m 5 Y -21 16 d -5 Y f black 787 1179 m 21 -16 d 67 Y -21
- 16 d cl s 0 0.2 0.8 c 808 1230 m 23 6 d -20 16 d -24 -6 d f black 808 1230 m 23
- 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 784 1157 m 24 6 d 62 Y -24 -6 d f 0 0.2
- 0.8 c 808 1225 m 19 Y -24 -6 d -19 Y f black 784 1157 m 24 6 d 81 Y -24 -6 d
- cl s 0 0 0.8 c 764 1173 m 20 -16 d 62 Y -20 16 d f 0 0.2 0.8 c 784 1219 m 19 Y
- -20 15 d -18 Y f black 764 1173 m 20 -16 d 81 Y -20 15 d cl s 0 0.2 0.8 c 784
- 1238 m 24 6 d -21 15 d -23 -6 d f black 784 1238 m 24 6 d -21 15 d -23 -6 d
- cl s 0 0 0.8 c 761 1151 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 784 1219 m 19 Y
- -23 -6 d -19 Y f black 761 1151 m 23 6 d 81 Y -23 -6 d cl s 0 0 0.8 c 741 1167
- m 20 -16 d 62 Y -20 16 d f 0 0.2 0.8 c 761 1213 m 19 Y -20 15 d -18 Y f black
- 741 1167 m 20 -16 d 81 Y -20 15 d cl s 0 0.2 0.8 c 761 1232 m 23 6 d -20 15 d
- -23 -6 d f black 761 1232 m 23 6 d -20 15 d -23 -6 d cl s 0 0 0.8 c 737 1145 m
- 24 6 d 27 Y -24 -6 d f black 737 1145 m 24 6 d 27 Y -24 -6 d cl s 0 0 0.8 c 717
- 1161 m 20 -16 d 27 Y -20 16 d f black 717 1161 m 20 -16 d 27 Y -20 16 d cl s 0
- 0 0.8 c 737 1172 m 24 6 d -20 16 d -24 -6 d f black 737 1172 m 24 6 d -20 16 d
- -24 -6 d cl s 0 0 0.8 c 714 1139 m 23 6 d 41 Y -23 -6 d f black 714 1139 m 23 6
- d 41 Y -23 -6 d cl s 0 0 0.8 c 694 1155 m 20 -16 d 41 Y -20 15 d f black 694
- 1155 m 20 -16 d 41 Y -20 15 d cl s 0 0 0.8 c 714 1180 m 23 6 d -20 15 d -23 -6
- d f black 714 1180 m 23 6 d -20 15 d -23 -6 d cl s 0 0 0.8 c 690 1133 m 24 6 d
- 62 Y -24 -5 d f 0 0.2 0.8 c 714 1201 m 19 Y -24 -6 d -18 Y f black 690 1133 m
- 24 6 d 81 Y -24 -6 d cl s 0 0 0.8 c 670 1149 m 20 -16 d 63 Y -20 15 d f 0 0.2
- 0.8 c 690 1196 m 18 Y -20 16 d -19 Y f black 670 1149 m 20 -16 d 81 Y -20 16 d
- cl s 0 0.2 0.8 c 690 1214 m 24 6 d -20 16 d -24 -6 d f black 690 1214 m 24 6 d
- -20 16 d -24 -6 d cl s 0 0 0.8 c 667 1127 m 23 6 d 41 Y -23 -6 d f black 667
- 1127 m 23 6 d 41 Y -23 -6 d cl s 0 0 0.8 c 647 1143 m 20 -16 d 41 Y -20 15 d f
- black 647 1143 m 20 -16 d 41 Y -20 15 d cl s 0 0 0.8 c 667 1168 m 23 6 d -20 15
- d -23 -6 d f black 667 1168 m 23 6 d -20 15 d -23 -6 d cl s 0 0 0.8 c 643 1121
- m 24 6 d 54 Y -24 -6 d f black 643 1121 m 24 6 d 54 Y -24 -6 d cl s 0 0 0.8 c
- 623 1137 m 20 -16 d 54 Y -20 16 d f black 623 1137 m 20 -16 d 54 Y -20 16 d
- cl s 0 0 0.8 c 643 1175 m 24 6 d -20 16 d -24 -6 d f black 643 1175 m 24 6 d
- -20 16 d -24 -6 d cl s 0 0 0.8 c 620 1115 m 23 6 d 63 Y -23 -6 d f 0 0.2 0.8 c
- 643 1184 m 31 Y -23 -6 d -31 Y f black 620 1115 m 23 6 d 94 Y -23 -6 d cl s 0 0
- 0.8 c 600 1131 m 20 -16 d 63 Y -20 15 d f 0 0.2 0.8 c 620 1178 m 31 Y -20 16 d
- -32 Y f black 600 1131 m 20 -16 d 94 Y -20 16 d cl s 0 0.2 0.8 c 620 1209 m 23
- 6 d -20 16 d -23 -6 d f black 620 1209 m 23 6 d -20 16 d -23 -6 d cl s 0 0 0.8
- c 596 1109 m 24 6 d 63 Y -24 -6 d f 0 0.2 0.8 c 620 1178 m 45 Y -24 -6 d -45 Y
- f black 596 1109 m 24 6 d 108 Y -24 -6 d cl s 0 0 0.8 c 576 1125 m 20 -16 d 63
- Y -20 15 d f 0 0.2 0.8 c 596 1172 m 45 Y -20 15 d -45 Y f black 576 1125 m 20
- -16 d 108 Y -20 15 d cl s 0 0.2 0.8 c 596 1217 m 24 6 d -20 15 d -24 -6 d f
- black 596 1217 m 24 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 573 1103 m 23 6 d 63 Y
- -23 -6 d f 0 0.2 0.8 c 596 1172 m 5 Y -23 -6 d -5 Y f black 573 1103 m 23 6 d
- 68 Y -23 -6 d cl s 0 0 0.8 c 553 1119 m 20 -16 d 63 Y -20 15 d f 0 0.2 0.8 c
- 573 1166 m 5 Y -20 15 d -5 Y f black 553 1119 m 20 -16 d 68 Y -20 15 d cl s 0
- 0.2 0.8 c 573 1171 m 23 6 d -20 15 d -23 -6 d f black 573 1171 m 23 6 d -20 15
- d -23 -6 d cl s 0 0 0.8 c 549 1097 m 24 6 d 63 Y -24 -6 d f 0 0.2 0.8 c 573
- 1166 m 45 Y -24 -6 d -45 Y f black 549 1097 m 24 6 d 108 Y -24 -6 d cl s 0 0
- 0.8 c 529 1113 m 20 -16 d 63 Y -20 15 d f 0 0.2 0.8 c 549 1160 m 45 Y -20 16 d
- -46 Y f black 529 1113 m 20 -16 d 108 Y -20 16 d cl s 0 0.2 0.8 c 549 1205 m 24
- 6 d -20 16 d -24 -6 d f black 549 1205 m 24 6 d -20 16 d -24 -6 d cl s 0 0 0.8
- c 526 1092 m 23 5 d 63 Y -23 -6 d f 0 0.2 0.8 c 549 1160 m 45 Y -23 -6 d -45 Y
- f black 526 1092 m 23 5 d 108 Y -23 -6 d cl s 0 0 0.8 c 506 1107 m 20 -15 d 62
- Y -20 15 d f 0 0.2 0.8 c 526 1154 m 45 Y -20 16 d -46 Y f black 506 1107 m 20
- -15 d 107 Y -20 16 d cl s 0 0.2 0.8 c 526 1199 m 23 6 d -20 16 d -23 -6 d f
- black 526 1199 m 23 6 d -20 16 d -23 -6 d cl s 0 0 0.8 c 502 1086 m 24 6 d 53 Y
- -24 -6 d f black 502 1086 m 24 6 d 53 Y -24 -6 d cl s 0 0 0.8 c 482 1101 m 20
- -15 d 53 Y -20 16 d f black 482 1101 m 20 -15 d 53 Y -20 16 d cl s 0 0 0.8 c
- 502 1139 m 24 6 d -20 16 d -24 -6 d f black 502 1139 m 24 6 d -20 16 d -24 -6 d
- cl s 0 0 0.8 c 479 1080 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 502 1148 m 32 Y
- -23 -6 d -32 Y f black 479 1080 m 23 6 d 94 Y -23 -6 d cl s 0 0 0.8 c 459 1095
- m 20 -15 d 62 Y -20 15 d f 0 0.2 0.8 c 479 1142 m 32 Y -20 15 d -32 Y f black
- 459 1095 m 20 -15 d 94 Y -20 15 d cl s 0 0.2 0.8 c 479 1174 m 23 6 d -20 15 d
- -23 -6 d f black 479 1174 m 23 6 d -20 15 d -23 -6 d cl s 0 0 0.8 c 456 1074 m
- 23 6 d -20 15 d -24 -6 d f black 456 1074 m 23 6 d -20 15 d -24 -6 d cl s 0 0
- 0.8 c 432 1068 m 24 6 d -21 15 d -23 -6 d f black 432 1068 m 24 6 d -21 15 d
- -23 -6 d cl s 0 0 0.8 c 409 1062 m 23 6 d -20 15 d -24 -6 d f black 409 1062 m
- 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 385 1056 m 24 6 d -21 15 d -23 -6 d f
- black 385 1056 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 1509 1321 m 24 6 d -20
- 16 d -24 -6 d f black 1509 1321 m 24 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1486
- 1315 m 23 6 d -20 16 d -23 -6 d f black 1486 1315 m 23 6 d -20 16 d -23 -6 d
- cl s 0 0 0.8 c 1462 1309 m 24 6 d -20 16 d -24 -6 d f black 1462 1309 m 24 6 d
- -20 16 d -24 -6 d cl s 0 0 0.8 c 1439 1303 m 23 6 d -20 16 d -23 -6 d f black
- 1439 1303 m 23 6 d -20 16 d -23 -6 d cl s 0 0 0.8 c 1415 1297 m 24 6 d 62 Y -24
- -6 d f 0 0.2 0.8 c 1439 1365 m 62 Y -24 -5 d -63 Y f 0 0.4 0.8 c 1439 1427 m 11
- Y -24 -6 d -10 Y f black 1415 1297 m 24 6 d 135 Y -24 -6 d cl s 0 0 0.8 c 1395
- 1313 m 20 -16 d 62 Y -20 16 d f 0 0.2 0.8 c 1415 1359 m 63 Y -20 15 d -62 Y f 0
- 0.4 0.8 c 1415 1422 m 10 Y -20 15 d -10 Y f black 1395 1313 m 20 -16 d 135 Y
- -20 15 d cl s 0 0.4 0.8 c 1415 1432 m 24 6 d -20 15 d -24 -6 d f black 1415
- 1432 m 24 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1392 1291 m 23 6 d 62 Y -23 -6 d
- f 0 0.2 0.8 c 1415 1359 m 63 Y -23 -6 d -63 Y f 0 0.4 0.8 c 1415 1422 m 23 Y
- -23 -6 d -23 Y f black 1392 1291 m 23 6 d 148 Y -23 -6 d cl s 0 0 0.8 c 1372
- 1307 m 20 -16 d 62 Y -20 16 d f 0 0.2 0.8 c 1392 1353 m 63 Y -20 15 d -62 Y f 0
- 0.4 0.8 c 1392 1416 m 23 Y -20 16 d -24 Y f black 1372 1307 m 20 -16 d 148 Y
- -20 16 d cl s 0 0.4 0.8 c 1392 1439 m 23 6 d -20 16 d -23 -6 d f black 1392
- 1439 m 23 6 d -20 16 d -23 -6 d cl s 0 0 0.8 c 1368 1285 m 24 6 d 62 Y -24 -6 d
- f 0 0.2 0.8 c 1392 1353 m 63 Y -24 -6 d -63 Y f 0 0.4 0.8 c 1392 1416 m 10 Y
- -24 -6 d -10 Y f black 1368 1285 m 24 6 d 135 Y -24 -6 d cl s 0 0 0.8 c 1348
- 1301 m 20 -16 d 62 Y -20 16 d f 0 0.2 0.8 c 1368 1347 m 63 Y -20 15 d -62 Y f 0
- 0.4 0.8 c 1368 1410 m 10 Y -20 15 d -10 Y f black 1348 1301 m 20 -16 d 135 Y
- -20 15 d cl s 0 0.4 0.8 c 1368 1420 m 24 6 d -20 15 d -24 -6 d f black 1368
- 1420 m 24 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1345 1279 m 23 6 d 62 Y -23 -6 d
- f 0 0.2 0.8 c 1368 1347 m 59 Y -23 -6 d -59 Y f black 1345 1279 m 23 6 d 121 Y
- -23 -6 d cl s 0 0 0.8 c 1325 1295 m 20 -16 d 62 Y -20 16 d f 0 0.2 0.8 c 1345
- 1341 m 59 Y -20 16 d -59 Y f black 1325 1295 m 20 -16 d 121 Y -20 16 d cl s 0
- 0.2 0.8 c 1345 1400 m 23 6 d -20 16 d -23 -6 d f black 1345 1400 m 23 6 d -20
- 16 d -23 -6 d cl s 0 0 0.8 c 1321 1273 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c
- 1345 1341 m 63 Y -24 -6 d -63 Y f 0 0.4 0.8 c 1345 1404 m 37 Y -24 -6 d -37 Y f
- black 1321 1273 m 24 6 d 162 Y -24 -6 d cl s 0 0 0.8 c 1301 1289 m 20 -16 d 62
- Y -20 16 d f 0 0.2 0.8 c 1321 1335 m 63 Y -20 15 d -62 Y f 0 0.4 0.8 c 1321
- 1398 m 37 Y -20 15 d -37 Y f black 1301 1289 m 20 -16 d 162 Y -20 15 d cl s 0
- 0.4 0.8 c 1321 1435 m 24 6 d -20 15 d -24 -6 d f black 1321 1435 m 24 6 d -20
- 15 d -24 -6 d cl s 0 0 0.8 c 1298 1267 m 23 6 d 41 Y -23 -6 d f black 1298 1267
- m 23 6 d 41 Y -23 -6 d cl s 0 0 0.8 c 1278 1283 m 20 -16 d 41 Y -20 15 d f
- black 1278 1283 m 20 -16 d 41 Y -20 15 d cl s 0 0 0.8 c 1298 1308 m 23 6 d -20
- 15 d -23 -6 d f black 1298 1308 m 23 6 d -20 15 d -23 -6 d cl s 0 0 0.8 c 1274
- 1261 m 24 6 d 41 Y -24 -6 d f black 1274 1261 m 24 6 d 41 Y -24 -6 d cl s 0 0
- 0.8 c 1254 1277 m 20 -16 d 41 Y -20 15 d f black 1254 1277 m 20 -16 d 41 Y -20
- 15 d cl s 0 0 0.8 c 1274 1302 m 24 6 d -20 15 d -24 -6 d f black 1274 1302 m 24
- 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1251 1255 m 23 6 d 62 Y -23 -5 d f 0 0.2
- 0.8 c 1274 1323 m 59 Y -23 -6 d -58 Y f black 1251 1255 m 23 6 d 121 Y -23 -6 d
- cl s 0 0 0.8 c 1231 1271 m 20 -16 d 63 Y -20 15 d f 0 0.2 0.8 c 1251 1318 m 58
- Y -20 16 d -59 Y f black 1231 1271 m 20 -16 d 121 Y -20 16 d cl s 0 0.2 0.8 c
- 1251 1376 m 23 6 d -20 16 d -23 -6 d f black 1251 1376 m 23 6 d -20 16 d -23 -6
- d cl s 0 0 0.8 c 1227 1249 m 24 6 d 63 Y -24 -6 d f 0 0.2 0.8 c 1251 1318 m 62
- Y -24 -6 d -62 Y f 0 0.4 0.8 c 1251 1380 m 10 Y -24 -6 d -10 Y f black 1227
- 1249 m 24 6 d 135 Y -24 -6 d cl s 0 0 0.8 c 1207 1265 m 20 -16 d 63 Y -20 15 d
- f 0 0.2 0.8 c 1227 1312 m 62 Y -20 15 d -62 Y f 0 0.4 0.8 c 1227 1374 m 10 Y
- -20 15 d -10 Y f black 1207 1265 m 20 -16 d 135 Y -20 15 d cl s 0 0.4 0.8 c
- 1227 1384 m 24 6 d -20 15 d -24 -6 d f black 1227 1384 m 24 6 d -20 15 d -24 -6
- d cl s 0 0 0.8 c 1204 1243 m 23 6 d 63 Y -23 -6 d f 0 0.2 0.8 c 1227 1312 m 31
- Y -23 -6 d -31 Y f black 1204 1243 m 23 6 d 94 Y -23 -6 d cl s 0 0 0.8 c 1184
- 1259 m 20 -16 d 63 Y -20 15 d f 0 0.2 0.8 c 1204 1306 m 31 Y -20 16 d -32 Y f
- black 1184 1259 m 20 -16 d 94 Y -20 16 d cl s 0 0.2 0.8 c 1204 1337 m 23 6 d
- -20 16 d -23 -6 d f black 1204 1337 m 23 6 d -20 16 d -23 -6 d cl s 0 0 0.8 c
- 1181 1237 m 23 6 d 63 Y -23 -6 d f 0 0.2 0.8 c 1204 1306 m 58 Y -23 -6 d -58 Y
- f black 1181 1237 m 23 6 d 121 Y -23 -6 d cl s 0 0 0.8 c 1160 1253 m 21 -16 d
- 63 Y -21 15 d f 0 0.2 0.8 c 1181 1300 m 58 Y -21 16 d -59 Y f black 1160 1253 m
- 21 -16 d 121 Y -21 16 d cl s 0 0.2 0.8 c 1181 1358 m 23 6 d -20 16 d -24 -6 d f
- black 1181 1358 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1157 1231 m 24 6 d 63
- Y -24 -6 d f 0 0.2 0.8 c 1181 1300 m 18 Y -24 -6 d -18 Y f black 1157 1231 m 24
- 6 d 81 Y -24 -6 d cl s 0 0 0.8 c 1137 1247 m 20 -16 d 63 Y -20 15 d f 0 0.2 0.8
- c 1157 1294 m 18 Y -20 16 d -19 Y f black 1137 1247 m 20 -16 d 81 Y -20 16 d
- cl s 0 0.2 0.8 c 1157 1312 m 24 6 d -21 16 d -23 -6 d f black 1157 1312 m 24 6
- d -21 16 d -23 -6 d cl s 0 0 0.8 c 1134 1225 m 23 6 d 27 Y -23 -6 d f black
- 1134 1225 m 23 6 d 27 Y -23 -6 d cl s 0 0 0.8 c 1113 1241 m 21 -16 d 27 Y -21
- 16 d f black 1113 1241 m 21 -16 d 27 Y -21 16 d cl s 0 0 0.8 c 1134 1252 m 23 6
- d -20 16 d -24 -6 d f black 1134 1252 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c
- 1110 1219 m 24 6 d 63 Y -24 -6 d f 0 0.2 0.8 c 1134 1288 m 18 Y -24 -6 d -18 Y
- f black 1110 1219 m 24 6 d 81 Y -24 -6 d cl s 0 0 0.8 c 1090 1235 m 20 -16 d 63
- Y -20 15 d f 0 0.2 0.8 c 1110 1282 m 18 Y -20 16 d -19 Y f black 1090 1235 m 20
- -16 d 81 Y -20 16 d cl s 0 0.2 0.8 c 1110 1300 m 24 6 d -21 16 d -23 -6 d f
- black 1110 1300 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1087 1214 m 23 5 d 63
- Y -23 -6 d f 0 0.2 0.8 c 1110 1282 m 32 Y -23 -6 d -32 Y f black 1087 1214 m 23
- 5 d 95 Y -23 -6 d cl s 0 0 0.8 c 1066 1229 m 21 -15 d 62 Y -21 15 d f 0 0.2 0.8
- c 1087 1276 m 32 Y -21 15 d -32 Y f black 1066 1229 m 21 -15 d 94 Y -21 15 d
- cl s 0 0.2 0.8 c 1087 1308 m 23 6 d -20 15 d -24 -6 d f black 1087 1308 m 23 6
- d -20 15 d -24 -6 d cl s 0 0 0.8 c 1063 1208 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8
- c 1087 1276 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 1087 1338 m 62 Y -24 -6 d -62 Y
- f 0 0.6 0.8 c 1087 1400 m 15 Y -24 -6 d -15 Y f black 1063 1208 m 24 6 d 201 Y
- -24 -6 d cl s 0 0 0.8 c 1043 1223 m 20 -15 d 62 Y -20 15 d f 0 0.2 0.8 c 1063
- 1270 m 62 Y -20 15 d -62 Y f 0 0.4 0.8 c 1063 1332 m 62 Y -20 15 d -62 Y f 0
- 0.6 0.8 c 1063 1394 m 15 Y -20 16 d -16 Y f black 1043 1223 m 20 -15 d 201 Y
- -20 16 d cl s 0 0.6 0.8 c 1063 1409 m 24 6 d -21 16 d -23 -6 d f black 1063
- 1409 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1040 1202 m 23 6 d 62 Y -23 -6 d
- f 0 0.2 0.8 c 1063 1270 m 18 Y -23 -6 d -18 Y f black 1040 1202 m 23 6 d 80 Y
- -23 -6 d cl s 0 0 0.8 c 1019 1217 m 21 -15 d 62 Y -21 15 d f 0 0.2 0.8 c 1040
- 1264 m 18 Y -21 16 d -19 Y f black 1019 1217 m 21 -15 d 80 Y -21 16 d cl s 0
- 0.2 0.8 c 1040 1282 m 23 6 d -20 16 d -24 -6 d f black 1040 1282 m 23 6 d -20
- 16 d -24 -6 d cl s 0 0 0.8 c 1016 1196 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c
- 1040 1264 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 1040 1326 m 37 Y -24 -6 d -37 Y f
- black 1016 1196 m 24 6 d 161 Y -24 -6 d cl s 0 0 0.8 c 996 1211 m 20 -15 d 62 Y
- -20 15 d f 0 0.2 0.8 c 1016 1258 m 62 Y -20 15 d -62 Y f 0 0.4 0.8 c 1016 1320
- m 37 Y -20 15 d -37 Y f black 996 1211 m 20 -15 d 161 Y -20 15 d cl s 0 0.4 0.8
- c 1016 1357 m 24 6 d -21 15 d -23 -6 d f black 1016 1357 m 24 6 d -21 15 d -23
- -6 d cl s 0 0 0.8 c 993 1190 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 1016 1258 m
- 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 1016 1320 m 10 Y -23 -6 d -10 Y f black 993
- 1190 m 23 6 d 134 Y -23 -6 d cl s 0 0 0.8 c 972 1205 m 21 -15 d 62 Y -21 15 d f
- 0 0.2 0.8 c 993 1252 m 62 Y -21 15 d -62 Y f 0 0.4 0.8 c 993 1314 m 10 Y -21 15
- d -10 Y f black 972 1205 m 21 -15 d 134 Y -21 15 d cl s 0 0.4 0.8 c 993 1324 m
- 23 6 d -20 15 d -24 -6 d f black 993 1324 m 23 6 d -20 15 d -24 -6 d cl s 0 0
- 0.8 c 969 1184 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 993 1252 m 5 Y -24 -6 d -5
- Y f black 969 1184 m 24 6 d 67 Y -24 -6 d cl s 0 0 0.8 c 949 1199 m 20 -15 d 62
- Y -20 15 d f 0 0.2 0.8 c 969 1246 m 5 Y -20 15 d -5 Y f black 949 1199 m 20 -15
- d 67 Y -20 15 d cl s 0 0.2 0.8 c 969 1251 m 24 6 d -21 15 d -23 -6 d f black
- 969 1251 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 946 1178 m 23 6 d 62 Y -23
- -6 d f 0 0.2 0.8 c 969 1246 m 18 Y -23 -6 d -18 Y f black 946 1178 m 23 6 d 80
- Y -23 -6 d cl s 0 0 0.8 c 925 1193 m 21 -15 d 62 Y -21 15 d f 0 0.2 0.8 c 946
- 1240 m 18 Y -21 16 d -19 Y f black 925 1193 m 21 -15 d 80 Y -21 16 d cl s 0 0.2
- 0.8 c 946 1258 m 23 6 d -20 16 d -24 -6 d f black 946 1258 m 23 6 d -20 16 d
- -24 -6 d cl s 0 0 0.8 c 922 1172 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 946 1240
- m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 946 1302 m 23 Y -24 -6 d -23 Y f black 922
- 1172 m 24 6 d 147 Y -24 -6 d cl s 0 0 0.8 c 902 1187 m 20 -15 d 62 Y -20 15 d f
- 0 0.2 0.8 c 922 1234 m 62 Y -20 15 d -62 Y f 0 0.4 0.8 c 922 1296 m 23 Y -20 16
- d -24 Y f black 902 1187 m 20 -15 d 147 Y -20 16 d cl s 0 0.4 0.8 c 922 1319 m
- 24 6 d -21 16 d -23 -6 d f black 922 1319 m 24 6 d -21 16 d -23 -6 d cl s 0 0
- 0.8 c 899 1166 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 922 1234 m 62 Y -23 -6 d
- -62 Y f 0 0.4 0.8 c 922 1296 m 10 Y -23 -6 d -10 Y f black 899 1166 m 23 6 d
- 134 Y -23 -6 d cl s 0 0 0.8 c 878 1181 m 21 -15 d 62 Y -21 15 d f 0 0.2 0.8 c
- 899 1228 m 62 Y -21 15 d -62 Y f 0 0.4 0.8 c 899 1290 m 10 Y -21 16 d -11 Y f
- black 878 1181 m 21 -15 d 134 Y -21 16 d cl s 0 0.4 0.8 c 899 1300 m 23 6 d -20
- 16 d -24 -6 d f black 899 1300 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 875
- 1160 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 899 1228 m 18 Y -24 -6 d -18 Y f
- black 875 1160 m 24 6 d 80 Y -24 -6 d cl s 0 0 0.8 c 855 1175 m 20 -15 d 62 Y
- -20 15 d f 0 0.2 0.8 c 875 1222 m 18 Y -20 16 d -19 Y f black 855 1175 m 20 -15
- d 80 Y -20 16 d cl s 0 0.2 0.8 c 875 1240 m 24 6 d -21 16 d -23 -6 d f black
- 875 1240 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 852 1154 m 23 6 d 62 Y -23
- -6 d f 0 0.2 0.8 c 875 1222 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 875 1284 m 62 Y
- -23 -6 d -62 Y f 0 0.6 0.8 c 875 1346 m 42 Y -23 -6 d -42 Y f black 852 1154 m
- 23 6 d 228 Y -23 -6 d cl s 0 0 0.8 c 831 1169 m 21 -15 d 62 Y -21 15 d f 0 0.2
- 0.8 c 852 1216 m 62 Y -21 16 d -63 Y f 0 0.4 0.8 c 852 1278 m 62 Y -21 16 d -62
- Y f 0 0.6 0.8 c 852 1340 m 42 Y -21 16 d -42 Y f black 831 1169 m 21 -15 d 228
- Y -21 16 d cl s 0 0.6 0.8 c 852 1382 m 23 6 d -20 16 d -24 -6 d f black 852
- 1382 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 828 1148 m 24 6 d 62 Y -24 -6 d
- f 0 0.2 0.8 c 852 1216 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 852 1278 m 62 Y -24
- -6 d -62 Y f 0 0.6 0.8 c 852 1340 m 2 Y -24 -6 d -2 Y f black 828 1148 m 24 6 d
- 188 Y -24 -6 d cl s 0 0 0.8 c 808 1163 m 20 -15 d 62 Y -20 15 d f 0 0.2 0.8 c
- 828 1210 m 62 Y -20 16 d -63 Y f 0 0.4 0.8 c 828 1272 m 62 Y -20 16 d -62 Y f 0
- 0.6 0.8 c 828 1334 m 2 Y -20 15 d -1 Y f black 808 1163 m 20 -15 d 188 Y -20 15
- d cl s 0 0.6 0.8 c 828 1336 m 24 6 d -21 15 d -23 -6 d f black 828 1336 m 24 6
- d -21 15 d -23 -6 d cl s 0 0 0.8 c 805 1142 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8
- c 828 1210 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 828 1272 m 62 Y -23 -6 d -62 Y f
- 0 0.6 0.8 c 828 1334 m 2 Y -23 -6 d -2 Y f black 805 1142 m 23 6 d 188 Y -23 -6
- d cl s 0 0 0.8 c 784 1157 m 21 -15 d 62 Y -21 15 d f 0 0.2 0.8 c 805 1204 m 62
- Y -21 16 d -63 Y f 0 0.4 0.8 c 805 1266 m 62 Y -21 16 d -62 Y f 0 0.6 0.8 c 805
- 1328 m 2 Y -21 15 d -1 Y f black 784 1157 m 21 -15 d 188 Y -21 15 d cl s 0 0.6
- 0.8 c 805 1330 m 23 6 d -20 15 d -24 -6 d f black 805 1330 m 23 6 d -20 15 d
- -24 -6 d cl s 0 0 0.8 c 781 1136 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 805 1204
- m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 805 1266 m 37 Y -24 -6 d -37 Y f black 781
- 1136 m 24 6 d 161 Y -24 -6 d cl s 0 0 0.8 c 761 1151 m 20 -15 d 62 Y -20 15 d f
- 0 0.2 0.8 c 781 1198 m 62 Y -20 16 d -63 Y f 0 0.4 0.8 c 781 1260 m 37 Y -20 16
- d -37 Y f black 761 1151 m 20 -15 d 161 Y -20 16 d cl s 0 0.4 0.8 c 781 1297 m
- 24 6 d -21 16 d -23 -6 d f black 781 1297 m 24 6 d -21 16 d -23 -6 d cl s 0 0
- 0.8 c 758 1130 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 781 1198 m 62 Y -23 -6 d
- -62 Y f 0 0.4 0.8 c 781 1260 m 24 Y -23 -6 d -24 Y f black 758 1130 m 23 6 d
- 148 Y -23 -6 d cl s 0 0 0.8 c 737 1145 m 21 -15 d 62 Y -21 15 d f 0 0.2 0.8 c
- 758 1192 m 62 Y -21 16 d -63 Y f 0 0.4 0.8 c 758 1254 m 24 Y -21 15 d -23 Y f
- black 737 1145 m 21 -15 d 148 Y -21 15 d cl s 0 0.4 0.8 c 758 1278 m 23 6 d -20
- 15 d -24 -6 d f black 758 1278 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 734
- 1124 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 758 1192 m 59 Y -24 -6 d -59 Y f
- black 734 1124 m 24 6 d 121 Y -24 -6 d cl s 0 0 0.8 c 714 1139 m 20 -15 d 62 Y
- -20 15 d f 0 0.2 0.8 c 734 1186 m 59 Y -20 15 d -59 Y f black 714 1139 m 20 -15
- d 121 Y -20 15 d cl s 0 0.2 0.8 c 734 1245 m 24 6 d -21 15 d -23 -6 d f black
- 734 1245 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 711 1118 m 23 6 d 62 Y -23
- -6 d f 0 0.2 0.8 c 734 1186 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 734 1248 m 50 Y
- -23 -5 d -51 Y f black 711 1118 m 23 6 d 174 Y -23 -5 d cl s 0 0 0.8 c 690 1133
- m 21 -15 d 62 Y -21 16 d f 0 0.2 0.8 c 711 1180 m 62 Y -21 16 d -62 Y f 0 0.4
- 0.8 c 711 1242 m 51 Y -21 15 d -50 Y f black 690 1133 m 21 -15 d 175 Y -21 15 d
- cl s 0 0.4 0.8 c 711 1293 m 23 5 d -20 16 d -24 -6 d f black 711 1293 m 23 5 d
- -20 16 d -24 -6 d cl s 0 0 0.8 c 687 1112 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c
- 711 1180 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 711 1242 m 62 Y -24 -6 d -62 Y f 0
- 0.6 0.8 c 711 1304 m 29 Y -24 -6 d -29 Y f black 687 1112 m 24 6 d 215 Y -24 -6
- d cl s 0 0 0.8 c 667 1127 m 20 -15 d 62 Y -20 16 d f 0 0.2 0.8 c 687 1174 m 62
- Y -20 16 d -62 Y f 0 0.4 0.8 c 687 1236 m 62 Y -20 16 d -62 Y f 0 0.6 0.8 c 687
- 1298 m 29 Y -20 15 d -28 Y f black 667 1127 m 20 -15 d 215 Y -20 15 d cl s 0
- 0.6 0.8 c 687 1327 m 24 6 d -21 15 d -23 -6 d f black 687 1327 m 24 6 d -21 15
- d -23 -6 d cl s 0 0 0.8 c 664 1106 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 687
- 1174 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 687 1236 m 24 Y -23 -6 d -24 Y f black
- 664 1106 m 23 6 d 148 Y -23 -6 d cl s 0 0 0.8 c 643 1121 m 21 -15 d 62 Y -21 16
- d f 0 0.2 0.8 c 664 1168 m 62 Y -21 16 d -62 Y f 0 0.4 0.8 c 664 1230 m 24 Y
- -21 15 d -23 Y f black 643 1121 m 21 -15 d 148 Y -21 15 d cl s 0 0.4 0.8 c 664
- 1254 m 23 6 d -20 15 d -24 -6 d f black 664 1254 m 23 6 d -20 15 d -24 -6 d
- cl s 0 0 0.8 c 640 1100 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 664 1168 m 62 Y
- -24 -6 d -62 Y f 0 0.4 0.8 c 664 1230 m 24 Y -24 -6 d -24 Y f black 640 1100 m
- 24 6 d 148 Y -24 -6 d cl s 0 0 0.8 c 620 1115 m 20 -15 d 62 Y -20 16 d f 0 0.2
- 0.8 c 640 1162 m 62 Y -20 16 d -62 Y f 0 0.4 0.8 c 640 1224 m 24 Y -20 15 d -23
- Y f black 620 1115 m 20 -15 d 148 Y -20 15 d cl s 0 0.4 0.8 c 640 1248 m 24 6 d
- -21 15 d -23 -6 d f black 640 1248 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c
- 617 1094 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 640 1162 m 32 Y -23 -6 d -32 Y f
- black 617 1094 m 23 6 d 94 Y -23 -6 d cl s 0 0 0.8 c 596 1109 m 21 -15 d 62 Y
- -21 16 d f 0 0.2 0.8 c 617 1156 m 32 Y -21 16 d -32 Y f black 596 1109 m 21 -15
- d 94 Y -21 16 d cl s 0 0.2 0.8 c 617 1188 m 23 6 d -20 15 d -24 -5 d f black
- 617 1188 m 23 6 d -20 15 d -24 -5 d cl s 0 0 0.8 c 593 1088 m 24 6 d 62 Y -24
- -6 d f 0 0.2 0.8 c 617 1156 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 617 1218 m 37 Y
- -24 -6 d -37 Y f black 593 1088 m 24 6 d 161 Y -24 -6 d cl s 0 0 0.8 c 573 1103
- m 20 -15 d 62 Y -20 16 d f 0 0.2 0.8 c 593 1150 m 62 Y -20 16 d -62 Y f 0 0.4
- 0.8 c 593 1212 m 37 Y -20 16 d -37 Y f black 573 1103 m 20 -15 d 161 Y -20 16 d
- cl s 0 0.4 0.8 c 593 1249 m 24 6 d -21 16 d -23 -6 d f black 593 1249 m 24 6 d
- -21 16 d -23 -6 d cl s 0 0 0.8 c 570 1082 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c
- 593 1150 m 5 Y -23 -6 d -5 Y f black 570 1082 m 23 6 d 67 Y -23 -6 d cl s 0 0
- 0.8 c 549 1097 m 21 -15 d 62 Y -21 16 d f 0 0.2 0.8 c 570 1144 m 5 Y -21 16 d
- -5 Y f black 549 1097 m 21 -15 d 67 Y -21 16 d cl s 0 0.2 0.8 c 570 1149 m 23 6
- d -20 16 d -24 -6 d f black 570 1149 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c
- 546 1076 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 570 1144 m 32 Y -24 -6 d -32 Y f
- black 546 1076 m 24 6 d 94 Y -24 -6 d cl s 0 0 0.8 c 526 1092 m 20 -16 d 62 Y
- -20 16 d f 0 0.2 0.8 c 546 1138 m 32 Y -20 16 d -32 Y f black 526 1092 m 20 -16
- d 94 Y -20 16 d cl s 0 0.2 0.8 c 546 1170 m 24 6 d -21 16 d -23 -6 d f black
- 546 1170 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 523 1070 m 23 6 d 62 Y -23
- -6 d f 0 0.2 0.8 c 546 1138 m 59 Y -23 -6 d -59 Y f black 523 1070 m 23 6 d 121
- Y -23 -6 d cl s 0 0 0.8 c 502 1086 m 21 -16 d 62 Y -21 16 d f 0 0.2 0.8 c 523
- 1132 m 59 Y -21 15 d -58 Y f black 502 1086 m 21 -16 d 121 Y -21 15 d cl s 0
- 0.2 0.8 c 523 1191 m 23 6 d -20 15 d -24 -6 d f black 523 1191 m 23 6 d -20 15
- d -24 -6 d cl s 0 0 0.8 c 499 1064 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 523
- 1132 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 523 1194 m 24 Y -24 -6 d -24 Y f black
- 499 1064 m 24 6 d 148 Y -24 -6 d cl s 0 0 0.8 c 479 1080 m 20 -16 d 62 Y -20 16
- d f 0 0.2 0.8 c 499 1126 m 62 Y -20 16 d -62 Y f 0 0.4 0.8 c 499 1188 m 24 Y
- -20 15 d -23 Y f black 479 1080 m 20 -16 d 148 Y -20 15 d cl s 0 0.4 0.8 c 499
- 1212 m 24 6 d -21 15 d -23 -6 d f black 499 1212 m 24 6 d -21 15 d -23 -6 d
- cl s 0 0 0.8 c 476 1058 m 23 6 d -20 16 d -23 -6 d f black 476 1058 m 23 6 d
- -20 16 d -23 -6 d cl s 0 0 0.8 c 452 1052 m 24 6 d -20 16 d -24 -6 d f black
- 452 1052 m 24 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 429 1046 m 23 6 d -20 16 d
- -23 -6 d f black 429 1046 m 23 6 d -20 16 d -23 -6 d cl s 0 0 0.8 c 405 1040 m
- 24 6 d -20 16 d -24 -6 d f black 405 1040 m 24 6 d -20 16 d -24 -6 d cl s 0 0
- 0.8 c 1530 1306 m 23 6 d -20 15 d -24 -6 d f black 1530 1306 m 23 6 d -20 15 d
- -24 -6 d cl s 0 0 0.8 c 1506 1300 m 24 6 d -21 15 d -23 -6 d f black 1506 1300
- m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 1483 1294 m 23 6 d -20 15 d -24 -6 d
- f black 1483 1294 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1459 1288 m 24 6 d
- -21 15 d -23 -6 d f black 1459 1288 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c
- 1436 1282 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 1459 1350 m 62 Y -23 -6 d -62 Y
- f 0 0.4 0.8 c 1459 1412 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c 1459 1474 m 62 Y
- -23 -6 d -62 Y f 0 0.8 0.8 c 1459 1536 m 47 Y -23 -6 d -47 Y f black 1436 1282
- m 23 6 d 295 Y -23 -6 d cl s 0 0 0.8 c 1415 1297 m 21 -15 d 62 Y -21 15 d f 0
- 0.2 0.8 c 1436 1344 m 62 Y -21 16 d -63 Y f 0 0.4 0.8 c 1436 1406 m 62 Y -21 16
- d -62 Y f 0 0.6 0.8 c 1436 1468 m 62 Y -21 16 d -62 Y f 0 0.8 0.8 c 1436 1530 m
- 47 Y -21 16 d -47 Y f black 1415 1297 m 21 -15 d 295 Y -21 16 d cl s 0 0.8 0.8
- c 1436 1577 m 23 6 d -20 16 d -24 -6 d f black 1436 1577 m 23 6 d -20 16 d -24
- -6 d cl s 0 0 0.8 c 1412 1276 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1436 1344 m
- 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 1436 1406 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c
- 1436 1468 m 2 Y -24 -6 d -2 Y f black 1412 1276 m 24 6 d 188 Y -24 -6 d cl s 0
- 0 0.8 c 1392 1291 m 20 -15 d 62 Y -20 15 d f 0 0.2 0.8 c 1412 1338 m 62 Y -20
- 16 d -63 Y f 0 0.4 0.8 c 1412 1400 m 62 Y -20 16 d -62 Y f 0 0.6 0.8 c 1412
- 1462 m 2 Y -20 15 d -1 Y f black 1392 1291 m 20 -15 d 188 Y -20 15 d cl s 0 0.6
- 0.8 c 1412 1464 m 24 6 d -21 15 d -23 -6 d f black 1412 1464 m 24 6 d -21 15 d
- -23 -6 d cl s 0 0 0.8 c 1389 1270 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 1412
- 1338 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 1412 1400 m 62 Y -23 -6 d -62 Y f 0
- 0.6 0.8 c 1412 1462 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 1412 1524 m 20 Y -23 -6
- d -20 Y f black 1389 1270 m 23 6 d 268 Y -23 -6 d cl s 0 0 0.8 c 1368 1285 m 21
- -15 d 62 Y -21 15 d f 0 0.2 0.8 c 1389 1332 m 62 Y -21 16 d -63 Y f 0 0.4 0.8 c
- 1389 1394 m 62 Y -21 16 d -62 Y f 0 0.6 0.8 c 1389 1456 m 62 Y -21 16 d -62 Y f
- 0 0.8 0.8 c 1389 1518 m 20 Y -21 16 d -20 Y f black 1368 1285 m 21 -15 d 268 Y
- -21 16 d cl s 0 0.8 0.8 c 1389 1538 m 23 6 d -20 16 d -24 -6 d f black 1389
- 1538 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1365 1264 m 24 6 d 62 Y -24 -6 d
- f 0 0.2 0.8 c 1389 1332 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 1389 1394 m 37 Y
- -24 -6 d -37 Y f black 1365 1264 m 24 6 d 161 Y -24 -6 d cl s 0 0 0.8 c 1345
- 1279 m 20 -15 d 62 Y -20 15 d f 0 0.2 0.8 c 1365 1326 m 62 Y -20 16 d -63 Y f 0
- 0.4 0.8 c 1365 1388 m 37 Y -20 16 d -37 Y f black 1345 1279 m 20 -15 d 161 Y
- -20 16 d cl s 0 0.4 0.8 c 1365 1425 m 24 6 d -21 16 d -23 -6 d f black 1365
- 1425 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1342 1258 m 23 6 d 62 Y -23 -6 d
- f 0 0.2 0.8 c 1365 1326 m 32 Y -23 -6 d -32 Y f black 1342 1258 m 23 6 d 94 Y
- -23 -6 d cl s 0 0 0.8 c 1321 1273 m 21 -15 d 62 Y -21 15 d f 0 0.2 0.8 c 1342
- 1320 m 32 Y -21 15 d -32 Y f black 1321 1273 m 21 -15 d 94 Y -21 15 d cl s 0
- 0.2 0.8 c 1342 1352 m 23 6 d -20 15 d -24 -6 d f black 1342 1352 m 23 6 d -20
- 15 d -24 -6 d cl s 0 0 0.8 c 1318 1252 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c
- 1342 1320 m 59 Y -24 -6 d -59 Y f black 1318 1252 m 24 6 d 121 Y -24 -6 d cl s
- 0 0 0.8 c 1298 1267 m 20 -15 d 62 Y -20 15 d f 0 0.2 0.8 c 1318 1314 m 59 Y -20
- 15 d -59 Y f black 1298 1267 m 20 -15 d 121 Y -20 15 d cl s 0 0.2 0.8 c 1318
- 1373 m 24 6 d -21 15 d -23 -6 d f black 1318 1373 m 24 6 d -21 15 d -23 -6 d
- cl s 0 0 0.8 c 1295 1246 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 1318 1314 m 62 Y
- -23 -6 d -62 Y f 0 0.4 0.8 c 1318 1376 m 50 Y -23 -6 d -50 Y f black 1295 1246
- m 23 6 d 174 Y -23 -6 d cl s 0 0 0.8 c 1274 1261 m 21 -15 d 62 Y -21 15 d f 0
- 0.2 0.8 c 1295 1308 m 62 Y -21 16 d -63 Y f 0 0.4 0.8 c 1295 1370 m 50 Y -21 16
- d -50 Y f black 1274 1261 m 21 -15 d 174 Y -21 16 d cl s 0 0.4 0.8 c 1295 1420
- m 23 6 d -20 16 d -24 -6 d f black 1295 1420 m 23 6 d -20 16 d -24 -6 d cl s 0
- 0 0.8 c 1271 1240 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1295 1308 m 62 Y -24 -6
- d -62 Y f 0 0.4 0.8 c 1295 1370 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 1295 1432 m
- 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 1295 1494 m 7 Y -24 -6 d -7 Y f black 1271
- 1240 m 24 6 d 255 Y -24 -6 d cl s 0 0 0.8 c 1251 1255 m 20 -15 d 62 Y -20 16 d
- f 0 0.2 0.8 c 1271 1302 m 62 Y -20 16 d -62 Y f 0 0.4 0.8 c 1271 1364 m 62 Y
- -20 16 d -62 Y f 0 0.6 0.8 c 1271 1426 m 62 Y -20 16 d -62 Y f 0 0.8 0.8 c 1271
- 1488 m 7 Y -20 16 d -7 Y f black 1251 1255 m 20 -15 d 255 Y -20 16 d cl s 0 0.8
- 0.8 c 1271 1495 m 24 6 d -21 16 d -23 -6 d f black 1271 1495 m 24 6 d -21 16 d
- -23 -6 d cl s 0 0 0.8 c 1248 1234 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 1271
- 1302 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 1271 1364 m 62 Y -23 -6 d -62 Y f 0
- 0.6 0.8 c 1271 1426 m 29 Y -23 -6 d -29 Y f black 1248 1234 m 23 6 d 215 Y -23
- -6 d cl s 0 0 0.8 c 1227 1249 m 21 -15 d 62 Y -21 16 d f 0 0.2 0.8 c 1248 1296
- m 62 Y -21 16 d -62 Y f 0 0.4 0.8 c 1248 1358 m 62 Y -21 16 d -62 Y f 0 0.6 0.8
- c 1248 1420 m 29 Y -21 15 d -28 Y f black 1227 1249 m 21 -15 d 215 Y -21 15 d
- cl s 0 0.6 0.8 c 1248 1449 m 23 6 d -20 15 d -24 -6 d f black 1248 1449 m 23 6
- d -20 15 d -24 -6 d cl s 0 0 0.8 c 1224 1228 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8
- c 1248 1296 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 1248 1358 m 62 Y -24 -6 d -62 Y
- f 0 0.6 0.8 c 1248 1420 m 2 Y -24 -6 d -2 Y f black 1224 1228 m 24 6 d 188 Y
- -24 -6 d cl s 0 0 0.8 c 1204 1243 m 20 -15 d 62 Y -20 16 d f 0 0.2 0.8 c 1224
- 1290 m 62 Y -20 16 d -62 Y f 0 0.4 0.8 c 1224 1352 m 62 Y -20 16 d -62 Y f 0
- 0.6 0.8 c 1224 1414 m 2 Y -20 16 d -2 Y f black 1204 1243 m 20 -15 d 188 Y -20
- 16 d cl s 0 0.6 0.8 c 1224 1416 m 24 6 d -21 15 d -23 -5 d f black 1224 1416 m
- 24 6 d -21 15 d -23 -5 d cl s 0 0 0.8 c 1201 1222 m 23 6 d 62 Y -23 -6 d f 0
- 0.2 0.8 c 1224 1290 m 59 Y -23 -6 d -59 Y f black 1201 1222 m 23 6 d 121 Y -23
- -6 d cl s 0 0 0.8 c 1181 1237 m 20 -15 d 62 Y -20 16 d f 0 0.2 0.8 c 1201 1284
- m 59 Y -20 15 d -58 Y f black 1181 1237 m 20 -15 d 121 Y -20 15 d cl s 0 0.2
- 0.8 c 1201 1343 m 23 6 d -20 15 d -23 -6 d f black 1201 1343 m 23 6 d -20 15 d
- -23 -6 d cl s 0 0 0.8 c 1177 1216 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1201
- 1284 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 1201 1346 m 37 Y -24 -6 d -37 Y f
- black 1177 1216 m 24 6 d 161 Y -24 -6 d cl s 0 0 0.8 c 1157 1231 m 20 -15 d 62
- Y -20 16 d f 0 0.2 0.8 c 1177 1278 m 62 Y -20 16 d -62 Y f 0 0.4 0.8 c 1177
- 1340 m 37 Y -20 16 d -37 Y f black 1157 1231 m 20 -15 d 161 Y -20 16 d cl s 0
- 0.4 0.8 c 1177 1377 m 24 6 d -20 16 d -24 -6 d f black 1177 1377 m 24 6 d -20
- 16 d -24 -6 d cl s 0 0 0.8 c 1154 1210 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c
- 1177 1278 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 1177 1340 m 24 Y -23 -6 d -24 Y f
- black 1154 1210 m 23 6 d 148 Y -23 -6 d cl s 0 0 0.8 c 1134 1225 m 20 -15 d 62
- Y -20 16 d f 0 0.2 0.8 c 1154 1272 m 62 Y -20 16 d -62 Y f 0 0.4 0.8 c 1154
- 1334 m 24 Y -20 15 d -23 Y f black 1134 1225 m 20 -15 d 148 Y -20 15 d cl s 0
- 0.4 0.8 c 1154 1358 m 23 6 d -20 15 d -23 -6 d f black 1154 1358 m 23 6 d -20
- 15 d -23 -6 d cl s 0 0 0.8 c 1130 1204 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c
- 1154 1272 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 1154 1334 m 62 Y -24 -6 d -62 Y f
- 0 0.6 0.8 c 1154 1396 m 15 Y -24 -6 d -15 Y f black 1130 1204 m 24 6 d 201 Y
- -24 -6 d cl s 0 0 0.8 c 1110 1219 m 20 -15 d 62 Y -20 16 d f 0 0.2 0.8 c 1130
- 1266 m 62 Y -20 16 d -62 Y f 0 0.4 0.8 c 1130 1328 m 62 Y -20 16 d -62 Y f 0
- 0.6 0.8 c 1130 1390 m 15 Y -20 16 d -15 Y f black 1110 1219 m 20 -15 d 201 Y
- -20 16 d cl s 0 0.6 0.8 c 1130 1405 m 24 6 d -20 16 d -24 -6 d f black 1130
- 1405 m 24 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1107 1198 m 23 6 d 62 Y -23 -6 d
- f 0 0.2 0.8 c 1130 1266 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 1130 1328 m 62 Y
- -23 -6 d -62 Y f 0 0.6 0.8 c 1130 1390 m 29 Y -23 -6 d -29 Y f black 1107 1198
- m 23 6 d 215 Y -23 -6 d cl s 0 0 0.8 c 1087 1214 m 20 -16 d 62 Y -20 16 d f 0
- 0.2 0.8 c 1107 1260 m 62 Y -20 16 d -62 Y f 0 0.4 0.8 c 1107 1322 m 62 Y -20 16
- d -62 Y f 0 0.6 0.8 c 1107 1384 m 29 Y -20 15 d -28 Y f black 1087 1214 m 20
- -16 d 215 Y -20 15 d cl s 0 0.6 0.8 c 1107 1413 m 23 6 d -20 15 d -23 -6 d f
- black 1107 1413 m 23 6 d -20 15 d -23 -6 d cl s 0 0 0.8 c 1083 1192 m 24 6 d 62
- Y -24 -6 d f 0 0.2 0.8 c 1107 1260 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 1107
- 1322 m 51 Y -24 -6 d -51 Y f black 1083 1192 m 24 6 d 175 Y -24 -6 d cl s 0 0
- 0.8 c 1063 1208 m 20 -16 d 62 Y -20 16 d f 0 0.2 0.8 c 1083 1254 m 62 Y -20 16
- d -62 Y f 0 0.4 0.8 c 1083 1316 m 51 Y -20 15 d -50 Y f black 1063 1208 m 20
- -16 d 175 Y -20 15 d cl s 0 0.4 0.8 c 1083 1367 m 24 6 d -20 15 d -24 -6 d f
- black 1083 1367 m 24 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1060 1186 m 23 6 d 62
- Y -23 -6 d f 0 0.2 0.8 c 1083 1254 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 1083
- 1316 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c 1083 1378 m 16 Y -23 -6 d -16 Y f
- black 1060 1186 m 23 6 d 202 Y -23 -6 d cl s 0 0 0.8 c 1040 1202 m 20 -16 d 62
- Y -20 16 d f 0 0.2 0.8 c 1060 1248 m 62 Y -20 16 d -62 Y f 0 0.4 0.8 c 1060
- 1310 m 62 Y -20 16 d -62 Y f 0 0.6 0.8 c 1060 1372 m 16 Y -20 15 d -15 Y f
- black 1040 1202 m 20 -16 d 202 Y -20 15 d cl s 0 0.6 0.8 c 1060 1388 m 23 6 d
- -20 15 d -23 -6 d f black 1060 1388 m 23 6 d -20 15 d -23 -6 d cl s 0 0 0.8 c
- 1036 1180 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1060 1248 m 62 Y -24 -6 d -62 Y
- f 0 0.4 0.8 c 1060 1310 m 51 Y -24 -6 d -51 Y f black 1036 1180 m 24 6 d 175 Y
- -24 -6 d cl s 0 0 0.8 c 1016 1196 m 20 -16 d 62 Y -20 16 d f 0 0.2 0.8 c 1036
- 1242 m 62 Y -20 16 d -62 Y f 0 0.4 0.8 c 1036 1304 m 51 Y -20 15 d -50 Y f
- black 1016 1196 m 20 -16 d 175 Y -20 15 d cl s 0 0.4 0.8 c 1036 1355 m 24 6 d
- -20 15 d -24 -6 d f black 1036 1355 m 24 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c
- 1013 1174 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 1036 1242 m 62 Y -23 -6 d -62 Y
- f 0 0.4 0.8 c 1036 1304 m 51 Y -23 -6 d -51 Y f black 1013 1174 m 23 6 d 175 Y
- -23 -6 d cl s 0 0 0.8 c 993 1190 m 20 -16 d 62 Y -20 16 d f 0 0.2 0.8 c 1013
- 1236 m 62 Y -20 16 d -62 Y f 0 0.4 0.8 c 1013 1298 m 51 Y -20 15 d -50 Y f
- black 993 1190 m 20 -16 d 175 Y -20 15 d cl s 0 0.4 0.8 c 1013 1349 m 23 6 d
- -20 15 d -23 -6 d f black 1013 1349 m 23 6 d -20 15 d -23 -6 d cl s 0 0 0.8 c
- 989 1168 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1013 1236 m 62 Y -24 -6 d -62 Y f
- 0 0.4 0.8 c 1013 1298 m 24 Y -24 -6 d -24 Y f black 989 1168 m 24 6 d 148 Y -24
- -6 d cl s 0 0 0.8 c 969 1184 m 20 -16 d 62 Y -20 16 d f 0 0.2 0.8 c 989 1230 m
- 62 Y -20 16 d -62 Y f 0 0.4 0.8 c 989 1292 m 24 Y -20 15 d -23 Y f black 969
- 1184 m 20 -16 d 148 Y -20 15 d cl s 0 0.4 0.8 c 989 1316 m 24 6 d -20 15 d -24
- -6 d f black 989 1316 m 24 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 966 1162 m 23 6
- d 62 Y -23 -6 d f 0 0.2 0.8 c 989 1230 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 989
- 1292 m 63 Y -23 -6 d -63 Y f 0 0.6 0.8 c 989 1355 m 62 Y -23 -6 d -62 Y f 0 0.8
- 0.8 c 989 1417 m 6 Y -23 -6 d -6 Y f black 966 1162 m 23 6 d 255 Y -23 -6 d
- cl s 0 0 0.8 c 946 1178 m 20 -16 d 62 Y -20 16 d f 0 0.2 0.8 c 966 1224 m 62 Y
- -20 16 d -62 Y f 0 0.4 0.8 c 966 1286 m 63 Y -20 15 d -62 Y f 0 0.6 0.8 c 966
- 1349 m 62 Y -20 15 d -62 Y f 0 0.8 0.8 c 966 1411 m 6 Y -20 16 d -7 Y f black
- 946 1178 m 20 -16 d 255 Y -20 16 d cl s 0 0.8 0.8 c 966 1417 m 23 6 d -20 16 d
- -23 -6 d f black 966 1417 m 23 6 d -20 16 d -23 -6 d cl s 0 0 0.8 c 942 1156 m
- 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 966 1224 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c
- 966 1286 m 63 Y -24 -6 d -63 Y f 0 0.6 0.8 c 966 1349 m 15 Y -24 -6 d -15 Y f
- black 942 1156 m 24 6 d 202 Y -24 -6 d cl s 0 0 0.8 c 922 1172 m 20 -16 d 62 Y
- -20 16 d f 0 0.2 0.8 c 942 1218 m 62 Y -20 16 d -62 Y f 0 0.4 0.8 c 942 1280 m
- 63 Y -20 15 d -62 Y f 0 0.6 0.8 c 942 1343 m 15 Y -20 15 d -15 Y f black 922
- 1172 m 20 -16 d 202 Y -20 15 d cl s 0 0.6 0.8 c 942 1358 m 24 6 d -20 15 d -24
- -6 d f black 942 1358 m 24 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 919 1150 m 23 6
- d 62 Y -23 -6 d f 0 0.2 0.8 c 942 1218 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 942
- 1280 m 51 Y -23 -6 d -51 Y f black 919 1150 m 23 6 d 175 Y -23 -6 d cl s 0 0
- 0.8 c 899 1166 m 20 -16 d 62 Y -20 16 d f 0 0.2 0.8 c 919 1212 m 62 Y -20 16 d
- -62 Y f 0 0.4 0.8 c 919 1274 m 51 Y -20 15 d -50 Y f black 899 1166 m 20 -16 d
- 175 Y -20 15 d cl s 0 0.4 0.8 c 919 1325 m 23 6 d -20 15 d -23 -6 d f black 919
- 1325 m 23 6 d -20 15 d -23 -6 d cl s 0 0 0.8 c 896 1144 m 23 6 d 62 Y -23 -6 d
- f 0 0.2 0.8 c 919 1212 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 919 1274 m 37 Y -23
- -6 d -37 Y f black 896 1144 m 23 6 d 161 Y -23 -6 d cl s 0 0 0.8 c 875 1160 m
- 21 -16 d 62 Y -21 16 d f 0 0.2 0.8 c 896 1206 m 62 Y -21 16 d -62 Y f 0 0.4 0.8
- c 896 1268 m 37 Y -21 16 d -37 Y f black 875 1160 m 21 -16 d 161 Y -21 16 d
- cl s 0 0.4 0.8 c 896 1305 m 23 6 d -20 16 d -24 -6 d f black 896 1305 m 23 6 d
- -20 16 d -24 -6 d cl s 0 0 0.8 c 872 1138 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c
- 896 1206 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 896 1268 m 24 Y -24 -6 d -24 Y f
- black 872 1138 m 24 6 d 148 Y -24 -6 d cl s 0 0 0.8 c 852 1154 m 20 -16 d 62 Y
- -20 16 d f 0 0.2 0.8 c 872 1200 m 62 Y -20 16 d -62 Y f 0 0.4 0.8 c 872 1262 m
- 24 Y -20 16 d -24 Y f black 852 1154 m 20 -16 d 148 Y -20 16 d cl s 0 0.4 0.8 c
- 872 1286 m 24 6 d -21 15 d -23 -5 d f black 872 1286 m 24 6 d -21 15 d -23 -5 d
- cl s 0 0 0.8 c 849 1132 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 872 1200 m 62 Y
- -23 -6 d -62 Y f 0 0.4 0.8 c 872 1262 m 24 Y -23 -6 d -24 Y f black 849 1132 m
- 23 6 d 148 Y -23 -6 d cl s 0 0 0.8 c 828 1148 m 21 -16 d 62 Y -21 16 d f 0 0.2
- 0.8 c 849 1194 m 62 Y -21 16 d -62 Y f 0 0.4 0.8 c 849 1256 m 24 Y -21 16 d -24
- Y f black 828 1148 m 21 -16 d 148 Y -21 16 d cl s 0 0.4 0.8 c 849 1280 m 23 6 d
- -20 16 d -24 -6 d f black 849 1280 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c
- 825 1126 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 849 1194 m 62 Y -24 -5 d -63 Y f
- 0 0.4 0.8 c 849 1256 m 37 Y -24 -6 d -36 Y f black 825 1126 m 24 6 d 161 Y -24
- -6 d cl s 0 0 0.8 c 805 1142 m 20 -16 d 62 Y -20 16 d f 0 0.2 0.8 c 825 1188 m
- 63 Y -20 15 d -62 Y f 0 0.4 0.8 c 825 1251 m 36 Y -20 16 d -37 Y f black 805
- 1142 m 20 -16 d 161 Y -20 16 d cl s 0 0.4 0.8 c 825 1287 m 24 6 d -21 16 d -23
- -6 d f black 825 1287 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 802 1120 m 23 6
- d 62 Y -23 -6 d f 0 0.2 0.8 c 825 1188 m 63 Y -23 -6 d -63 Y f 0 0.4 0.8 c 825
- 1251 m 23 Y -23 -6 d -23 Y f black 802 1120 m 23 6 d 148 Y -23 -6 d cl s 0 0
- 0.8 c 781 1136 m 21 -16 d 62 Y -21 16 d f 0 0.2 0.8 c 802 1182 m 63 Y -21 15 d
- -62 Y f 0 0.4 0.8 c 802 1245 m 23 Y -21 16 d -24 Y f black 781 1136 m 21 -16 d
- 148 Y -21 16 d cl s 0 0.4 0.8 c 802 1268 m 23 6 d -20 16 d -24 -6 d f black 802
- 1268 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 778 1114 m 24 6 d 62 Y -24 -6 d
- f 0 0.2 0.8 c 802 1182 m 63 Y -24 -6 d -63 Y f 0 0.4 0.8 c 802 1245 m 62 Y -24
- -6 d -62 Y f 0 0.6 0.8 c 802 1307 m 1 Y -24 -6 d -1 Y f black 778 1114 m 24 6 d
- 188 Y -24 -6 d cl s 0 0 0.8 c 758 1130 m 20 -16 d 62 Y -20 16 d f 0 0.2 0.8 c
- 778 1176 m 63 Y -20 15 d -62 Y f 0 0.4 0.8 c 778 1239 m 62 Y -20 15 d -62 Y f 0
- 0.6 0.8 c 778 1301 m 1 Y -20 16 d -2 Y f black 758 1130 m 20 -16 d 188 Y -20 16
- d cl s 0 0.6 0.8 c 778 1302 m 24 6 d -21 16 d -23 -6 d f black 778 1302 m 24 6
- d -21 16 d -23 -6 d cl s 0 0 0.8 c 755 1108 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8
- c 778 1176 m 63 Y -23 -6 d -63 Y f 0 0.4 0.8 c 778 1239 m 10 Y -23 -6 d -10 Y f
- black 755 1108 m 23 6 d 135 Y -23 -6 d cl s 0 0 0.8 c 734 1124 m 21 -16 d 62 Y
- -21 16 d f 0 0.2 0.8 c 755 1170 m 63 Y -21 15 d -62 Y f 0 0.4 0.8 c 755 1233 m
- 10 Y -21 15 d -10 Y f black 734 1124 m 21 -16 d 135 Y -21 15 d cl s 0 0.4 0.8 c
- 755 1243 m 23 6 d -20 15 d -24 -6 d f black 755 1243 m 23 6 d -20 15 d -24 -6 d
- cl s 0 0 0.8 c 731 1102 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 755 1170 m 63 Y
- -24 -6 d -63 Y f 0 0.4 0.8 c 755 1233 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 755
- 1295 m 55 Y -24 -6 d -55 Y f black 731 1102 m 24 6 d 242 Y -24 -6 d cl s 0 0
- 0.8 c 711 1118 m 20 -16 d 62 Y -20 16 d f 0 0.2 0.8 c 731 1164 m 63 Y -20 15 d
- -62 Y f 0 0.4 0.8 c 731 1227 m 62 Y -20 15 d -62 Y f 0 0.6 0.8 c 731 1289 m 55
- Y -20 16 d -56 Y f black 711 1118 m 20 -16 d 242 Y -20 16 d cl s 0 0.6 0.8 c
- 731 1344 m 24 6 d -21 16 d -23 -6 d f black 731 1344 m 24 6 d -21 16 d -23 -6 d
- cl s 0 0 0.8 c 708 1096 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 731 1164 m 63 Y
- -23 -6 d -63 Y f 0 0.4 0.8 c 731 1227 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c 731
- 1289 m 55 Y -23 -6 d -55 Y f black 708 1096 m 23 6 d 242 Y -23 -6 d cl s 0 0
- 0.8 c 687 1112 m 21 -16 d 62 Y -21 16 d f 0 0.2 0.8 c 708 1158 m 63 Y -21 15 d
- -62 Y f 0 0.4 0.8 c 708 1221 m 62 Y -21 15 d -62 Y f 0 0.6 0.8 c 708 1283 m 55
- Y -21 16 d -56 Y f black 687 1112 m 21 -16 d 242 Y -21 16 d cl s 0 0.6 0.8 c
- 708 1338 m 23 6 d -20 16 d -24 -6 d f black 708 1338 m 23 6 d -20 16 d -24 -6 d
- cl s 0 0 0.8 c 684 1090 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 708 1158 m 63 Y
- -24 -6 d -63 Y f 0 0.4 0.8 c 708 1221 m 23 Y -24 -6 d -23 Y f black 684 1090 m
- 24 6 d 148 Y -24 -6 d cl s 0 0 0.8 c 664 1106 m 20 -16 d 62 Y -20 16 d f 0 0.2
- 0.8 c 684 1152 m 63 Y -20 15 d -62 Y f 0 0.4 0.8 c 684 1215 m 23 Y -20 16 d -24
- Y f black 664 1106 m 20 -16 d 148 Y -20 16 d cl s 0 0.4 0.8 c 684 1238 m 24 6 d
- -21 16 d -23 -6 d f black 684 1238 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c
- 661 1084 m 23 6 d 62 Y -23 -5 d f 0 0.2 0.8 c 684 1152 m 63 Y -23 -6 d -62 Y f
- 0 0.4 0.8 c 684 1215 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c 684 1277 m 1 Y -23 -6
- d -1 Y f black 661 1084 m 23 6 d 188 Y -23 -6 d cl s 0 0 0.8 c 640 1100 m 21
- -16 d 63 Y -21 15 d f 0 0.2 0.8 c 661 1147 m 62 Y -21 15 d -62 Y f 0 0.4 0.8 c
- 661 1209 m 62 Y -21 15 d -62 Y f 0 0.6 0.8 c 661 1271 m 1 Y -21 16 d -2 Y f
- black 640 1100 m 21 -16 d 188 Y -21 16 d cl s 0 0.6 0.8 c 661 1272 m 23 6 d -20
- 16 d -24 -6 d f black 661 1272 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 637
- 1078 m 24 6 d 63 Y -24 -6 d f 0 0.2 0.8 c 661 1147 m 62 Y -24 -6 d -62 Y f 0
- 0.4 0.8 c 661 1209 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 661 1271 m 28 Y -24 -6 d
- -28 Y f black 637 1078 m 24 6 d 215 Y -24 -6 d cl s 0 0 0.8 c 617 1094 m 20 -16
- d 63 Y -20 15 d f 0 0.2 0.8 c 637 1141 m 62 Y -20 15 d -62 Y f 0 0.4 0.8 c 637
- 1203 m 62 Y -20 15 d -62 Y f 0 0.6 0.8 c 637 1265 m 28 Y -20 16 d -29 Y f black
- 617 1094 m 20 -16 d 215 Y -20 16 d cl s 0 0.6 0.8 c 637 1293 m 24 6 d -21 16 d
- -23 -6 d f black 637 1293 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 614 1072 m
- 23 6 d 63 Y -23 -6 d f 0 0.2 0.8 c 637 1141 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c
- 637 1203 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c 637 1265 m 42 Y -23 -6 d -42 Y f
- black 614 1072 m 23 6 d 229 Y -23 -6 d cl s 0 0 0.8 c 593 1088 m 21 -16 d 63 Y
- -21 15 d f 0 0.2 0.8 c 614 1135 m 62 Y -21 15 d -62 Y f 0 0.4 0.8 c 614 1197 m
- 62 Y -21 15 d -62 Y f 0 0.6 0.8 c 614 1259 m 42 Y -21 15 d -42 Y f black 593
- 1088 m 21 -16 d 229 Y -21 15 d cl s 0 0.6 0.8 c 614 1301 m 23 6 d -20 15 d -24
- -6 d f black 614 1301 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 590 1066 m 24 6
- d 63 Y -24 -6 d f 0 0.2 0.8 c 614 1135 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 614
- 1197 m 10 Y -24 -6 d -10 Y f black 590 1066 m 24 6 d 135 Y -24 -6 d cl s 0 0
- 0.8 c 570 1082 m 20 -16 d 63 Y -20 15 d f 0 0.2 0.8 c 590 1129 m 62 Y -20 15 d
- -62 Y f 0 0.4 0.8 c 590 1191 m 10 Y -20 15 d -10 Y f black 570 1082 m 20 -16 d
- 135 Y -20 15 d cl s 0 0.4 0.8 c 590 1201 m 24 6 d -21 15 d -23 -6 d f black 590
- 1201 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 567 1060 m 23 6 d 63 Y -23 -6 d
- f 0 0.2 0.8 c 590 1129 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 590 1191 m 62 Y -23
- -6 d -62 Y f 0 0.6 0.8 c 590 1253 m 42 Y -23 -6 d -42 Y f black 567 1060 m 23 6
- d 229 Y -23 -6 d cl s 0 0 0.8 c 546 1076 m 21 -16 d 63 Y -21 15 d f 0 0.2 0.8 c
- 567 1123 m 62 Y -21 15 d -62 Y f 0 0.4 0.8 c 567 1185 m 62 Y -21 15 d -62 Y f 0
- 0.6 0.8 c 567 1247 m 42 Y -21 15 d -42 Y f black 546 1076 m 21 -16 d 229 Y -21
- 15 d cl s 0 0.6 0.8 c 567 1289 m 23 6 d -20 15 d -24 -6 d f black 567 1289 m 23
- 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 543 1054 m 24 6 d 63 Y -24 -6 d f 0 0.2
- 0.8 c 567 1123 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 567 1185 m 62 Y -24 -6 d -62
- Y f 0 0.6 0.8 c 567 1247 m 2 Y -24 -6 d -2 Y f black 543 1054 m 24 6 d 189 Y
- -24 -6 d cl s 0 0 0.8 c 523 1070 m 20 -16 d 63 Y -20 15 d f 0 0.2 0.8 c 543
- 1117 m 62 Y -20 15 d -62 Y f 0 0.4 0.8 c 543 1179 m 62 Y -20 15 d -62 Y f 0 0.6
- 0.8 c 543 1241 m 2 Y -20 15 d -2 Y f black 523 1070 m 20 -16 d 189 Y -20 15 d
- cl s 0 0.6 0.8 c 543 1243 m 24 6 d -21 15 d -23 -6 d f black 543 1243 m 24 6 d
- -21 15 d -23 -6 d cl s 0 0 0.8 c 520 1048 m 23 6 d 63 Y -23 -6 d f 0 0.2 0.8 c
- 543 1117 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 543 1179 m 23 Y -23 -6 d -23 Y f
- black 520 1048 m 23 6 d 148 Y -23 -6 d cl s 0 0 0.8 c 499 1064 m 21 -16 d 63 Y
- -21 15 d f 0 0.2 0.8 c 520 1111 m 62 Y -21 15 d -62 Y f 0 0.4 0.8 c 520 1173 m
- 23 Y -21 16 d -24 Y f black 499 1064 m 21 -16 d 148 Y -21 16 d cl s 0 0.4 0.8 c
- 520 1196 m 23 6 d -20 16 d -24 -6 d f black 520 1196 m 23 6 d -20 16 d -24 -6 d
- cl s 0 0 0.8 c 496 1043 m 24 5 d -21 16 d -23 -6 d f black 496 1043 m 24 5 d
- -21 16 d -23 -6 d cl s 0 0 0.8 c 473 1037 m 23 6 d -20 15 d -24 -6 d f black
- 473 1037 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 449 1031 m 24 6 d -21 15 d
- -23 -6 d f black 449 1031 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 426 1025 m
- 23 6 d -20 15 d -24 -6 d f black 426 1025 m 23 6 d -20 15 d -24 -6 d cl s 0 0
- 0.8 c 1550 1290 m 24 6 d -21 16 d -23 -6 d f black 1550 1290 m 24 6 d -21 16 d
- -23 -6 d cl s 0 0 0.8 c 1527 1284 m 23 6 d -20 16 d -24 -6 d f black 1527 1284
- m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1503 1278 m 24 6 d -21 16 d -23 -6 d
- f black 1503 1278 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1480 1272 m 23 6 d
- -20 16 d -24 -6 d f black 1480 1272 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c
- 1456 1266 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1480 1334 m 62 Y -24 -6 d -62 Y
- f 0 0.4 0.8 c 1480 1396 m 63 Y -24 -6 d -63 Y f 0 0.6 0.8 c 1480 1459 m 62 Y
- -24 -6 d -62 Y f 0 0.8 0.8 c 1480 1521 m 62 Y -24 -6 d -62 Y f 0 0.8 0.6 c 1480
- 1583 m 25 Y -24 -6 d -25 Y f black 1456 1266 m 24 6 d 336 Y -24 -6 d cl s 0 0
- 0.8 c 1436 1282 m 20 -16 d 62 Y -20 16 d f 0 0.2 0.8 c 1456 1328 m 62 Y -20 16
- d -62 Y f 0 0.4 0.8 c 1456 1390 m 63 Y -20 15 d -62 Y f 0 0.6 0.8 c 1456 1453 m
- 62 Y -20 15 d -62 Y f 0 0.8 0.8 c 1456 1515 m 62 Y -20 15 d -62 Y f 0 0.8 0.6 c
- 1456 1577 m 25 Y -20 16 d -26 Y f black 1436 1282 m 20 -16 d 336 Y -20 16 d
- cl s 0 0.8 0.6 c 1456 1602 m 24 6 d -21 16 d -23 -6 d f black 1456 1602 m 24 6
- d -21 16 d -23 -6 d cl s 0 0 0.8 c 1433 1260 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8
- c 1456 1328 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 1456 1390 m 63 Y -23 -6 d -63 Y
- f 0 0.6 0.8 c 1456 1453 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 1456 1515 m 6 Y -23
- -6 d -6 Y f black 1433 1260 m 23 6 d 255 Y -23 -6 d cl s 0 0 0.8 c 1412 1276 m
- 21 -16 d 62 Y -21 16 d f 0 0.2 0.8 c 1433 1322 m 62 Y -21 16 d -62 Y f 0 0.4
- 0.8 c 1433 1384 m 63 Y -21 15 d -62 Y f 0 0.6 0.8 c 1433 1447 m 62 Y -21 15 d
- -62 Y f 0 0.8 0.8 c 1433 1509 m 6 Y -21 16 d -7 Y f black 1412 1276 m 21 -16 d
- 255 Y -21 16 d cl s 0 0.8 0.8 c 1433 1515 m 23 6 d -20 16 d -24 -6 d f black
- 1433 1515 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1409 1254 m 24 6 d 62 Y -24
- -6 d f 0 0.2 0.8 c 1433 1322 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 1433 1384 m 63
- Y -24 -6 d -63 Y f 0 0.6 0.8 c 1433 1447 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c
- 1433 1509 m 62 Y -24 -6 d -62 Y f 0 0.8 0.6 c 1433 1571 m 62 Y -24 -6 d -62 Y f
- 0 0.8 0.4 c 1433 1633 m 3 Y -24 -6 d -3 Y f black 1409 1254 m 24 6 d 376 Y -24
- -6 d cl s 0 0 0.8 c 1389 1270 m 20 -16 d 62 Y -20 16 d f 0 0.2 0.8 c 1409 1316
- m 62 Y -20 16 d -62 Y f 0 0.4 0.8 c 1409 1378 m 63 Y -20 15 d -62 Y f 0 0.6 0.8
- c 1409 1441 m 62 Y -20 15 d -62 Y f 0 0.8 0.8 c 1409 1503 m 62 Y -20 15 d -62 Y
- f 0 0.8 0.6 c 1409 1565 m 62 Y -20 16 d -63 Y f 0 0.8 0.4 c 1409 1627 m 3 Y -20
- 16 d -3 Y f black 1389 1270 m 20 -16 d 376 Y -20 16 d cl s 0 0.8 0.4 c 1409
- 1630 m 24 6 d -21 16 d -23 -6 d f black 1409 1630 m 24 6 d -21 16 d -23 -6 d
- cl s 0 0 0.8 c 1386 1248 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 1409 1316 m 62 Y
- -23 -5 d -63 Y f 0 0.4 0.8 c 1409 1378 m 63 Y -23 -6 d -62 Y f 0 0.6 0.8 c 1409
- 1441 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 1409 1503 m 60 Y -23 -6 d -60 Y f
- black 1386 1248 m 23 6 d 309 Y -23 -6 d cl s 0 0 0.8 c 1365 1264 m 21 -16 d 62
- Y -21 16 d f 0 0.2 0.8 c 1386 1310 m 63 Y -21 15 d -62 Y f 0 0.4 0.8 c 1386
- 1373 m 62 Y -21 15 d -62 Y f 0 0.6 0.8 c 1386 1435 m 62 Y -21 15 d -62 Y f 0
- 0.8 0.8 c 1386 1497 m 60 Y -21 16 d -61 Y f black 1365 1264 m 21 -16 d 309 Y
- -21 16 d cl s 0 0.8 0.8 c 1386 1557 m 23 6 d -20 16 d -24 -6 d f black 1386
- 1557 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1362 1242 m 24 6 d 62 Y -24 -6 d
- f 0 0.2 0.8 c 1386 1310 m 63 Y -24 -6 d -63 Y f 0 0.4 0.8 c 1386 1373 m 62 Y
- -24 -6 d -62 Y f 0 0.6 0.8 c 1386 1435 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 1386
- 1497 m 62 Y -24 -6 d -62 Y f 0 0.8 0.6 c 1386 1559 m 12 Y -24 -6 d -12 Y f
- black 1362 1242 m 24 6 d 323 Y -24 -6 d cl s 0 0 0.8 c 1342 1258 m 20 -16 d 62
- Y -20 16 d f 0 0.2 0.8 c 1362 1304 m 63 Y -20 15 d -62 Y f 0 0.4 0.8 c 1362
- 1367 m 62 Y -20 15 d -62 Y f 0 0.6 0.8 c 1362 1429 m 62 Y -20 15 d -62 Y f 0
- 0.8 0.8 c 1362 1491 m 62 Y -20 15 d -62 Y f 0 0.8 0.6 c 1362 1553 m 12 Y -20 15
- d -12 Y f black 1342 1258 m 20 -16 d 323 Y -20 15 d cl s 0 0.8 0.6 c 1362 1565
- m 24 6 d -21 15 d -23 -6 d f black 1362 1565 m 24 6 d -21 15 d -23 -6 d cl s 0
- 0 0.8 c 1339 1236 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 1362 1304 m 63 Y -23 -6
- d -63 Y f 0 0.4 0.8 c 1362 1367 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c 1362 1429 m
- 28 Y -23 -6 d -28 Y f black 1339 1236 m 23 6 d 215 Y -23 -6 d cl s 0 0 0.8 c
- 1318 1252 m 21 -16 d 62 Y -21 16 d f 0 0.2 0.8 c 1339 1298 m 63 Y -21 15 d -62
- Y f 0 0.4 0.8 c 1339 1361 m 62 Y -21 15 d -62 Y f 0 0.6 0.8 c 1339 1423 m 28 Y
- -21 16 d -29 Y f black 1318 1252 m 21 -16 d 215 Y -21 16 d cl s 0 0.6 0.8 c
- 1339 1451 m 23 6 d -20 16 d -24 -6 d f black 1339 1451 m 23 6 d -20 16 d -24 -6
- d cl s 0 0 0.8 c 1315 1230 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1339 1298 m 63
- Y -24 -6 d -63 Y f 0 0.4 0.8 c 1339 1361 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c
- 1339 1423 m 42 Y -24 -6 d -42 Y f black 1315 1230 m 24 6 d 229 Y -24 -6 d cl s
- 0 0 0.8 c 1295 1246 m 20 -16 d 62 Y -20 16 d f 0 0.2 0.8 c 1315 1292 m 63 Y -20
- 15 d -62 Y f 0 0.4 0.8 c 1315 1355 m 62 Y -20 15 d -62 Y f 0 0.6 0.8 c 1315
- 1417 m 42 Y -20 15 d -42 Y f black 1295 1246 m 20 -16 d 229 Y -20 15 d cl s 0
- 0.6 0.8 c 1315 1459 m 24 6 d -21 15 d -23 -6 d f black 1315 1459 m 24 6 d -21
- 15 d -23 -6 d cl s 0 0 0.8 c 1292 1224 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c
- 1315 1292 m 63 Y -23 -6 d -63 Y f 0 0.4 0.8 c 1315 1355 m 23 Y -23 -6 d -23 Y f
- black 1292 1224 m 23 6 d 148 Y -23 -6 d cl s 0 0 0.8 c 1271 1240 m 21 -16 d 62
- Y -21 16 d f 0 0.2 0.8 c 1292 1286 m 63 Y -21 15 d -62 Y f 0 0.4 0.8 c 1292
- 1349 m 23 Y -21 16 d -24 Y f black 1271 1240 m 21 -16 d 148 Y -21 16 d cl s 0
- 0.4 0.8 c 1292 1372 m 23 6 d -20 16 d -24 -6 d f black 1292 1372 m 23 6 d -20
- 16 d -24 -6 d cl s 0 0 0.8 c 1268 1218 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c
- 1292 1286 m 63 Y -24 -6 d -63 Y f 0 0.4 0.8 c 1292 1349 m 37 Y -24 -6 d -37 Y f
- black 1268 1218 m 24 6 d 162 Y -24 -6 d cl s 0 0 0.8 c 1248 1234 m 20 -16 d 62
- Y -20 16 d f 0 0.2 0.8 c 1268 1280 m 63 Y -20 15 d -62 Y f 0 0.4 0.8 c 1268
- 1343 m 37 Y -20 15 d -37 Y f black 1248 1234 m 20 -16 d 162 Y -20 15 d cl s 0
- 0.4 0.8 c 1268 1380 m 24 6 d -21 15 d -23 -6 d f black 1268 1380 m 24 6 d -21
- 15 d -23 -6 d cl s 0 0 0.8 c 1245 1212 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c
- 1268 1280 m 63 Y -23 -6 d -63 Y f 0 0.4 0.8 c 1268 1343 m 62 Y -23 -6 d -62 Y f
- 0 0.6 0.8 c 1268 1405 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 1268 1467 m 62 Y -23
- -6 d -62 Y f 0 0.8 0.6 c 1268 1529 m 12 Y -23 -6 d -12 Y f black 1245 1212 m 23
- 6 d 323 Y -23 -6 d cl s 0 0 0.8 c 1224 1228 m 21 -16 d 62 Y -21 16 d f 0 0.2
- 0.8 c 1245 1274 m 63 Y -21 15 d -62 Y f 0 0.4 0.8 c 1245 1337 m 62 Y -21 15 d
- -62 Y f 0 0.6 0.8 c 1245 1399 m 62 Y -21 15 d -62 Y f 0 0.8 0.8 c 1245 1461 m
- 62 Y -21 16 d -63 Y f 0 0.8 0.6 c 1245 1523 m 12 Y -21 15 d -11 Y f black 1224
- 1228 m 21 -16 d 323 Y -21 15 d cl s 0 0.8 0.6 c 1245 1535 m 23 6 d -20 15 d -24
- -6 d f black 1245 1535 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1221 1206 m 24
- 6 d 62 Y -24 -5 d f 0 0.2 0.8 c 1245 1274 m 63 Y -24 -6 d -62 Y f 0 0.4 0.8 c
- 1245 1337 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 1245 1399 m 62 Y -24 -6 d -62 Y f
- 0 0.8 0.8 c 1245 1461 m 7 Y -24 -6 d -7 Y f black 1221 1206 m 24 6 d 256 Y -24
- -6 d cl s 0 0 0.8 c 1201 1222 m 20 -16 d 63 Y -20 15 d f 0 0.2 0.8 c 1221 1269
- m 62 Y -20 15 d -62 Y f 0 0.4 0.8 c 1221 1331 m 62 Y -20 15 d -62 Y f 0 0.6 0.8
- c 1221 1393 m 62 Y -20 15 d -62 Y f 0 0.8 0.8 c 1221 1455 m 7 Y -20 15 d -7 Y f
- black 1201 1222 m 20 -16 d 256 Y -20 15 d cl s 0 0.8 0.8 c 1221 1462 m 24 6 d
- -21 15 d -23 -6 d f black 1221 1462 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c
- 1198 1200 m 23 6 d 63 Y -23 -6 d f 0 0.2 0.8 c 1221 1269 m 62 Y -23 -6 d -62 Y
- f 0 0.4 0.8 c 1221 1331 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c 1221 1393 m 62 Y
- -23 -6 d -62 Y f 0 0.8 0.8 c 1221 1455 m 62 Y -23 -6 d -62 Y f 0 0.8 0.6 c 1221
- 1517 m 25 Y -23 -6 d -25 Y f black 1198 1200 m 23 6 d 336 Y -23 -6 d cl s 0 0
- 0.8 c 1177 1216 m 21 -16 d 63 Y -21 15 d f 0 0.2 0.8 c 1198 1263 m 62 Y -21 15
- d -62 Y f 0 0.4 0.8 c 1198 1325 m 62 Y -21 15 d -62 Y f 0 0.6 0.8 c 1198 1387 m
- 62 Y -21 15 d -62 Y f 0 0.8 0.8 c 1198 1449 m 62 Y -21 16 d -63 Y f 0 0.8 0.6 c
- 1198 1511 m 25 Y -21 16 d -25 Y f black 1177 1216 m 21 -16 d 336 Y -21 16 d
- cl s 0 0.8 0.6 c 1198 1536 m 23 6 d -20 16 d -24 -6 d f black 1198 1536 m 23 6
- d -20 16 d -24 -6 d cl s 0 0 0.8 c 1174 1194 m 24 6 d 63 Y -24 -6 d f 0 0.2 0.8
- c 1198 1263 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 1198 1325 m 62 Y -24 -6 d -62 Y
- f 0 0.6 0.8 c 1198 1387 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 1198 1449 m 62 Y
- -24 -6 d -62 Y f 0 0.8 0.6 c 1198 1511 m 62 Y -24 -6 d -62 Y f 0 0.8 0.4 c 1198
- 1573 m 17 Y -24 -6 d -17 Y f black 1174 1194 m 24 6 d 390 Y -24 -6 d cl s 0 0
- 0.8 c 1154 1210 m 20 -16 d 63 Y -20 15 d f 0 0.2 0.8 c 1174 1257 m 62 Y -20 15
- d -62 Y f 0 0.4 0.8 c 1174 1319 m 62 Y -20 15 d -62 Y f 0 0.6 0.8 c 1174 1381 m
- 62 Y -20 16 d -63 Y f 0 0.8 0.8 c 1174 1443 m 62 Y -20 16 d -62 Y f 0 0.8 0.6 c
- 1174 1505 m 62 Y -20 16 d -62 Y f 0 0.8 0.4 c 1174 1567 m 17 Y -20 16 d -17 Y f
- black 1154 1210 m 20 -16 d 390 Y -20 16 d cl s 0 0.8 0.4 c 1174 1584 m 24 6 d
- -21 16 d -23 -6 d f black 1174 1584 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c
- 1151 1188 m 23 6 d 63 Y -23 -6 d f 0 0.2 0.8 c 1174 1257 m 62 Y -23 -6 d -62 Y
- f 0 0.4 0.8 c 1174 1319 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c 1174 1381 m 62 Y
- -23 -6 d -62 Y f 0 0.8 0.8 c 1174 1443 m 7 Y -23 -6 d -7 Y f black 1151 1188 m
- 23 6 d 256 Y -23 -6 d cl s 0 0 0.8 c 1130 1204 m 21 -16 d 63 Y -21 15 d f 0 0.2
- 0.8 c 1151 1251 m 62 Y -21 15 d -62 Y f 0 0.4 0.8 c 1151 1313 m 62 Y -21 15 d
- -62 Y f 0 0.6 0.8 c 1151 1375 m 62 Y -21 16 d -63 Y f 0 0.8 0.8 c 1151 1437 m 7
- Y -21 15 d -6 Y f black 1130 1204 m 21 -16 d 256 Y -21 15 d cl s 0 0.8 0.8 c
- 1151 1444 m 23 6 d -20 15 d -24 -6 d f black 1151 1444 m 23 6 d -20 15 d -24 -6
- d cl s 0 0 0.8 c 1127 1182 m 24 6 d 63 Y -24 -6 d f 0 0.2 0.8 c 1151 1251 m 62
- Y -24 -6 d -62 Y f 0 0.4 0.8 c 1151 1313 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c
- 1151 1375 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 1151 1437 m 34 Y -24 -6 d -34 Y f
- black 1127 1182 m 24 6 d 283 Y -24 -6 d cl s 0 0 0.8 c 1107 1198 m 20 -16 d 63
- Y -20 15 d f 0 0.2 0.8 c 1127 1245 m 62 Y -20 15 d -62 Y f 0 0.4 0.8 c 1127
- 1307 m 62 Y -20 15 d -62 Y f 0 0.6 0.8 c 1127 1369 m 62 Y -20 16 d -63 Y f 0
- 0.8 0.8 c 1127 1431 m 34 Y -20 15 d -33 Y f black 1107 1198 m 20 -16 d 283 Y
- -20 15 d cl s 0 0.8 0.8 c 1127 1465 m 24 6 d -21 15 d -23 -6 d f black 1127
- 1465 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 1104 1176 m 23 6 d 63 Y -23 -6 d
- f 0 0.2 0.8 c 1127 1245 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 1127 1307 m 62 Y
- -23 -6 d -62 Y f 0 0.6 0.8 c 1127 1369 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 1127
- 1431 m 60 Y -23 -6 d -60 Y f black 1104 1176 m 23 6 d 309 Y -23 -6 d cl s 0 0
- 0.8 c 1083 1192 m 21 -16 d 63 Y -21 15 d f 0 0.2 0.8 c 1104 1239 m 62 Y -21 15
- d -62 Y f 0 0.4 0.8 c 1104 1301 m 62 Y -21 15 d -62 Y f 0 0.6 0.8 c 1104 1363 m
- 62 Y -21 16 d -63 Y f 0 0.8 0.8 c 1104 1425 m 60 Y -21 16 d -60 Y f black 1083
- 1192 m 21 -16 d 309 Y -21 16 d cl s 0 0.8 0.8 c 1104 1485 m 23 6 d -20 16 d -24
- -6 d f black 1104 1485 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1080 1170 m 24
- 6 d 63 Y -24 -6 d f 0 0.2 0.8 c 1104 1239 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c
- 1104 1301 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 1104 1363 m 62 Y -24 -6 d -62 Y f
- 0 0.8 0.8 c 1104 1425 m 20 Y -24 -6 d -20 Y f black 1080 1170 m 24 6 d 269 Y
- -24 -6 d cl s 0 0 0.8 c 1060 1186 m 20 -16 d 63 Y -20 15 d f 0 0.2 0.8 c 1080
- 1233 m 62 Y -20 15 d -62 Y f 0 0.4 0.8 c 1080 1295 m 62 Y -20 15 d -62 Y f 0
- 0.6 0.8 c 1080 1357 m 62 Y -20 16 d -63 Y f 0 0.8 0.8 c 1080 1419 m 20 Y -20 16
- d -20 Y f black 1060 1186 m 20 -16 d 269 Y -20 16 d cl s 0 0.8 0.8 c 1080 1439
- m 24 6 d -21 16 d -23 -6 d f black 1080 1439 m 24 6 d -21 16 d -23 -6 d cl s 0
- 0 0.8 c 1057 1165 m 23 5 d 63 Y -23 -6 d f 0 0.2 0.8 c 1080 1233 m 62 Y -23 -6
- d -62 Y f 0 0.4 0.8 c 1080 1295 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c 1080 1357 m
- 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 1080 1419 m 62 Y -23 -6 d -62 Y f 0 0.8 0.6 c
- 1080 1481 m 12 Y -23 -6 d -12 Y f black 1057 1165 m 23 5 d 323 Y -23 -6 d cl s
- 0 0 0.8 c 1036 1180 m 21 -15 d 62 Y -21 15 d f 0 0.2 0.8 c 1057 1227 m 62 Y -21
- 15 d -62 Y f 0 0.4 0.8 c 1057 1289 m 62 Y -21 15 d -62 Y f 0 0.6 0.8 c 1057
- 1351 m 62 Y -21 16 d -63 Y f 0 0.8 0.8 c 1057 1413 m 62 Y -21 16 d -62 Y f 0
- 0.8 0.6 c 1057 1475 m 12 Y -21 16 d -12 Y f black 1036 1180 m 21 -15 d 322 Y
- -21 16 d cl s 0 0.8 0.6 c 1057 1487 m 23 6 d -20 15 d -24 -5 d f black 1057
- 1487 m 23 6 d -20 15 d -24 -5 d cl s 0 0 0.8 c 1033 1159 m 24 6 d 62 Y -24 -6 d
- f 0 0.2 0.8 c 1057 1227 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 1057 1289 m 62 Y
- -24 -6 d -62 Y f 0 0.6 0.8 c 1057 1351 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 1057
- 1413 m 62 Y -24 -6 d -62 Y f 0 0.8 0.6 c 1057 1475 m 62 Y -24 -6 d -62 Y f 0
- 0.8 0.4 c 1057 1537 m 62 Y -24 -5 d -63 Y f 0 0.8 0.2 c 1057 1599 m 9 Y -24 -6
- d -8 Y f black 1033 1159 m 24 6 d 443 Y -24 -6 d cl s 0 0 0.8 c 1013 1174 m 20
- -15 d 62 Y -20 15 d f 0 0.2 0.8 c 1033 1221 m 62 Y -20 15 d -62 Y f 0 0.4 0.8 c
- 1033 1283 m 62 Y -20 15 d -62 Y f 0 0.6 0.8 c 1033 1345 m 62 Y -20 16 d -63 Y f
- 0 0.8 0.8 c 1033 1407 m 62 Y -20 16 d -62 Y f 0 0.8 0.6 c 1033 1469 m 62 Y -20
- 16 d -62 Y f 0 0.8 0.4 c 1033 1531 m 63 Y -20 15 d -62 Y f 0 0.8 0.2 c 1033
- 1594 m 8 Y -20 15 d -8 Y f black 1013 1174 m 20 -15 d 443 Y -20 15 d cl s 0 0.8
- 0.2 c 1033 1602 m 24 6 d -21 15 d -23 -6 d f black 1033 1602 m 24 6 d -21 15 d
- -23 -6 d cl s 0 0 0.8 c 1010 1153 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 1033
- 1221 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 1033 1283 m 50 Y -23 -6 d -50 Y f
- black 1010 1153 m 23 6 d 174 Y -23 -6 d cl s 0 0 0.8 c 989 1168 m 21 -15 d 62 Y
- -21 15 d f 0 0.2 0.8 c 1010 1215 m 62 Y -21 15 d -62 Y f 0 0.4 0.8 c 1010 1277
- m 50 Y -21 16 d -51 Y f black 989 1168 m 21 -15 d 174 Y -21 16 d cl s 0 0.4 0.8
- c 1010 1327 m 23 6 d -20 16 d -24 -6 d f black 1010 1327 m 23 6 d -20 16 d -24
- -6 d cl s 0 0 0.8 c 986 1147 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1010 1215 m
- 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 1010 1277 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c
- 1010 1339 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 1010 1401 m 61 Y -24 -6 d -61 Y f
- black 986 1147 m 24 6 d 309 Y -24 -6 d cl s 0 0 0.8 c 966 1162 m 20 -15 d 62 Y
- -20 15 d f 0 0.2 0.8 c 986 1209 m 62 Y -20 15 d -62 Y f 0 0.4 0.8 c 986 1271 m
- 62 Y -20 16 d -63 Y f 0 0.6 0.8 c 986 1333 m 62 Y -20 16 d -62 Y f 0 0.8 0.8 c
- 986 1395 m 61 Y -20 15 d -60 Y f black 966 1162 m 20 -15 d 309 Y -20 15 d cl s
- 0 0.8 0.8 c 986 1456 m 24 6 d -21 15 d -23 -6 d f black 986 1456 m 24 6 d -21
- 15 d -23 -6 d cl s 0 0 0.8 c 963 1141 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 986
- 1209 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 986 1271 m 62 Y -23 -6 d -62 Y f 0 0.6
- 0.8 c 986 1333 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 986 1395 m 61 Y -23 -6 d -61
- Y f black 963 1141 m 23 6 d 309 Y -23 -6 d cl s 0 0 0.8 c 942 1156 m 21 -15 d
- 62 Y -21 15 d f 0 0.2 0.8 c 963 1203 m 62 Y -21 15 d -62 Y f 0 0.4 0.8 c 963
- 1265 m 62 Y -21 16 d -63 Y f 0 0.6 0.8 c 963 1327 m 62 Y -21 16 d -62 Y f 0 0.8
- 0.8 c 963 1389 m 61 Y -21 15 d -60 Y f black 942 1156 m 21 -15 d 309 Y -21 15 d
- cl s 0 0.8 0.8 c 963 1450 m 23 6 d -20 15 d -24 -6 d f black 963 1450 m 23 6 d
- -20 15 d -24 -6 d cl s 0 0 0.8 c 939 1135 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c
- 963 1203 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 963 1265 m 62 Y -24 -6 d -62 Y f 0
- 0.6 0.8 c 963 1327 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 963 1389 m 7 Y -24 -6 d
- -7 Y f black 939 1135 m 24 6 d 255 Y -24 -6 d cl s 0 0 0.8 c 919 1150 m 20 -15
- d 62 Y -20 15 d f 0 0.2 0.8 c 939 1197 m 62 Y -20 15 d -62 Y f 0 0.4 0.8 c 939
- 1259 m 62 Y -20 16 d -63 Y f 0 0.6 0.8 c 939 1321 m 62 Y -20 16 d -62 Y f 0 0.8
- 0.8 c 939 1383 m 7 Y -20 15 d -6 Y f black 919 1150 m 20 -15 d 255 Y -20 15 d
- cl s 0 0.8 0.8 c 939 1390 m 24 6 d -21 15 d -23 -6 d f black 939 1390 m 24 6 d
- -21 15 d -23 -6 d cl s 0 0 0.8 c 916 1129 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c
- 939 1197 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 939 1259 m 62 Y -23 -6 d -62 Y f 0
- 0.6 0.8 c 939 1321 m 55 Y -23 -6 d -55 Y f black 916 1129 m 23 6 d 241 Y -23 -6
- d cl s 0 0 0.8 c 896 1144 m 20 -15 d 62 Y -20 15 d f 0 0.2 0.8 c 916 1191 m 62
- Y -20 15 d -62 Y f 0 0.4 0.8 c 916 1253 m 62 Y -20 16 d -63 Y f 0 0.6 0.8 c 916
- 1315 m 55 Y -20 16 d -55 Y f black 896 1144 m 20 -15 d 241 Y -20 16 d cl s 0
- 0.6 0.8 c 916 1370 m 23 6 d -20 16 d -23 -6 d f black 916 1370 m 23 6 d -20 16
- d -23 -6 d cl s 0 0 0.8 c 892 1123 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 916
- 1191 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 916 1253 m 62 Y -24 -6 d -62 Y f 0 0.6
- 0.8 c 916 1315 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 916 1377 m 20 Y -24 -6 d -20
- Y f black 892 1123 m 24 6 d 268 Y -24 -6 d cl s 0 0 0.8 c 872 1138 m 20 -15 d
- 62 Y -20 15 d f 0 0.2 0.8 c 892 1185 m 62 Y -20 15 d -62 Y f 0 0.4 0.8 c 892
- 1247 m 62 Y -20 16 d -63 Y f 0 0.6 0.8 c 892 1309 m 62 Y -20 16 d -62 Y f 0 0.8
- 0.8 c 892 1371 m 20 Y -20 16 d -20 Y f black 872 1138 m 20 -15 d 268 Y -20 16 d
- cl s 0 0.8 0.8 c 892 1391 m 24 6 d -20 16 d -24 -6 d f black 892 1391 m 24 6 d
- -20 16 d -24 -6 d cl s 0 0 0.8 c 869 1117 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c
- 892 1185 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 892 1247 m 62 Y -23 -6 d -62 Y f 0
- 0.6 0.8 c 892 1309 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 892 1371 m 20 Y -23 -6 d
- -20 Y f black 869 1117 m 23 6 d 268 Y -23 -6 d cl s 0 0 0.8 c 849 1132 m 20 -15
- d 62 Y -20 15 d f 0 0.2 0.8 c 869 1179 m 62 Y -20 15 d -62 Y f 0 0.4 0.8 c 869
- 1241 m 62 Y -20 16 d -63 Y f 0 0.6 0.8 c 869 1303 m 62 Y -20 16 d -62 Y f 0 0.8
- 0.8 c 869 1365 m 20 Y -20 16 d -20 Y f black 849 1132 m 20 -15 d 268 Y -20 16 d
- cl s 0 0.8 0.8 c 869 1385 m 23 6 d -20 16 d -23 -6 d f black 869 1385 m 23 6 d
- -20 16 d -23 -6 d cl s 0 0 0.8 c 845 1111 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c
- 869 1179 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 869 1241 m 62 Y -24 -6 d -62 Y f 0
- 0.6 0.8 c 869 1303 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 869 1365 m 20 Y -24 -6 d
- -20 Y f black 845 1111 m 24 6 d 268 Y -24 -6 d cl s 0 0 0.8 c 825 1126 m 20 -15
- d 62 Y -20 15 d f 0 0.2 0.8 c 845 1173 m 62 Y -20 16 d -63 Y f 0 0.4 0.8 c 845
- 1235 m 62 Y -20 16 d -62 Y f 0 0.6 0.8 c 845 1297 m 62 Y -20 16 d -62 Y f 0 0.8
- 0.8 c 845 1359 m 20 Y -20 16 d -20 Y f black 825 1126 m 20 -15 d 268 Y -20 16 d
- cl s 0 0.8 0.8 c 845 1379 m 24 6 d -20 16 d -24 -6 d f black 845 1379 m 24 6 d
- -20 16 d -24 -6 d cl s 0 0 0.8 c 822 1105 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c
- 845 1173 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 845 1235 m 62 Y -23 -6 d -62 Y f 0
- 0.6 0.8 c 845 1297 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 845 1359 m 62 Y -23 -6 d
- -62 Y f 0 0.8 0.6 c 845 1421 m 26 Y -23 -6 d -26 Y f black 822 1105 m 23 6 d
- 336 Y -23 -6 d cl s 0 0 0.8 c 802 1120 m 20 -15 d 62 Y -20 15 d f 0 0.2 0.8 c
- 822 1167 m 62 Y -20 16 d -63 Y f 0 0.4 0.8 c 822 1229 m 62 Y -20 16 d -62 Y f 0
- 0.6 0.8 c 822 1291 m 62 Y -20 16 d -62 Y f 0 0.8 0.8 c 822 1353 m 62 Y -20 16 d
- -62 Y f 0 0.8 0.6 c 822 1415 m 26 Y -20 15 d -25 Y f black 802 1120 m 20 -15 d
- 336 Y -20 15 d cl s 0 0.8 0.6 c 822 1441 m 23 6 d -20 15 d -23 -6 d f black 822
- 1441 m 23 6 d -20 15 d -23 -6 d cl s 0 0 0.8 c 798 1099 m 24 6 d 62 Y -24 -6 d
- f 0 0.2 0.8 c 822 1167 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 822 1229 m 62 Y -24
- -6 d -62 Y f 0 0.6 0.8 c 822 1291 m 42 Y -24 -6 d -42 Y f black 798 1099 m 24 6
- d 228 Y -24 -6 d cl s 0 0 0.8 c 778 1114 m 20 -15 d 62 Y -20 15 d f 0 0.2 0.8 c
- 798 1161 m 62 Y -20 16 d -63 Y f 0 0.4 0.8 c 798 1223 m 62 Y -20 16 d -62 Y f 0
- 0.6 0.8 c 798 1285 m 42 Y -20 16 d -42 Y f black 778 1114 m 20 -15 d 228 Y -20
- 16 d cl s 0 0.6 0.8 c 798 1327 m 24 6 d -20 16 d -24 -6 d f black 798 1327 m 24
- 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 775 1093 m 23 6 d 62 Y -23 -6 d f 0 0.2
- 0.8 c 798 1161 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 798 1223 m 62 Y -23 -6 d -62
- Y f 0 0.6 0.8 c 798 1285 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 798 1347 m 62 Y
- -23 -6 d -62 Y f 0 0.8 0.6 c 798 1409 m 39 Y -23 -6 d -39 Y f black 775 1093 m
- 23 6 d 349 Y -23 -6 d cl s 0 0 0.8 c 755 1108 m 20 -15 d 62 Y -20 15 d f 0 0.2
- 0.8 c 775 1155 m 62 Y -20 16 d -63 Y f 0 0.4 0.8 c 775 1217 m 62 Y -20 16 d -62
- Y f 0 0.6 0.8 c 775 1279 m 62 Y -20 16 d -62 Y f 0 0.8 0.8 c 775 1341 m 62 Y
- -20 16 d -62 Y f 0 0.8 0.6 c 775 1403 m 39 Y -20 16 d -39 Y f black 755 1108 m
- 20 -15 d 349 Y -20 16 d cl s 0 0.8 0.6 c 775 1442 m 23 6 d -20 16 d -23 -6 d f
- black 775 1442 m 23 6 d -20 16 d -23 -6 d cl s 0 0 0.8 c 751 1087 m 24 6 d 62 Y
- -24 -6 d f 0 0.2 0.8 c 775 1155 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 775 1217 m
- 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 775 1279 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c
- 775 1341 m 62 Y -24 -6 d -62 Y f 0 0.8 0.6 c 775 1403 m 12 Y -24 -6 d -12 Y f
- black 751 1087 m 24 6 d 322 Y -24 -6 d cl s 0 0 0.8 c 731 1102 m 20 -15 d 62 Y
- -20 15 d f 0 0.2 0.8 c 751 1149 m 62 Y -20 16 d -63 Y f 0 0.4 0.8 c 751 1211 m
- 62 Y -20 16 d -62 Y f 0 0.6 0.8 c 751 1273 m 62 Y -20 16 d -62 Y f 0 0.8 0.8 c
- 751 1335 m 62 Y -20 16 d -62 Y f 0 0.8 0.6 c 751 1397 m 12 Y -20 16 d -12 Y f
- black 731 1102 m 20 -15 d 322 Y -20 16 d cl s 0 0.8 0.6 c 751 1409 m 24 6 d -20
- 16 d -24 -6 d f black 751 1409 m 24 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 728
- 1081 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 751 1149 m 62 Y -23 -6 d -62 Y f 0
- 0.4 0.8 c 751 1211 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c 751 1273 m 62 Y -23 -6 d
- -62 Y f 0 0.8 0.8 c 751 1335 m 20 Y -23 -5 d -21 Y f black 728 1081 m 23 6 d
- 268 Y -23 -5 d cl s 0 0 0.8 c 708 1096 m 20 -15 d 62 Y -20 15 d f 0 0.2 0.8 c
- 728 1143 m 62 Y -20 16 d -63 Y f 0 0.4 0.8 c 728 1205 m 62 Y -20 16 d -62 Y f 0
- 0.6 0.8 c 728 1267 m 62 Y -20 16 d -62 Y f 0 0.8 0.8 c 728 1329 m 21 Y -20 15 d
- -20 Y f black 708 1096 m 20 -15 d 269 Y -20 15 d cl s 0 0.8 0.8 c 728 1350 m 23
- 5 d -20 16 d -23 -6 d f black 728 1350 m 23 5 d -20 16 d -23 -6 d cl s 0 0 0.8
- c 704 1075 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 728 1143 m 62 Y -24 -6 d -62 Y
- f 0 0.4 0.8 c 728 1205 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 728 1267 m 2 Y -24
- -6 d -2 Y f black 704 1075 m 24 6 d 188 Y -24 -6 d cl s 0 0 0.8 c 684 1090 m 20
- -15 d 62 Y -20 15 d f 0 0.2 0.8 c 704 1137 m 62 Y -20 16 d -63 Y f 0 0.4 0.8 c
- 704 1199 m 62 Y -20 16 d -62 Y f 0 0.6 0.8 c 704 1261 m 2 Y -20 15 d -1 Y f
- black 684 1090 m 20 -15 d 188 Y -20 15 d cl s 0 0.6 0.8 c 704 1263 m 24 6 d -20
- 15 d -24 -6 d f black 704 1263 m 24 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 681
- 1069 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 704 1137 m 62 Y -23 -6 d -62 Y f 0
- 0.4 0.8 c 704 1199 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c 704 1261 m 62 Y -23 -6 d
- -62 Y f 0 0.8 0.8 c 704 1323 m 63 Y -23 -6 d -63 Y f 0 0.8 0.6 c 704 1386 m 25
- Y -23 -6 d -25 Y f black 681 1069 m 23 6 d 336 Y -23 -6 d cl s 0 0 0.8 c 661
- 1084 m 20 -15 d 62 Y -20 16 d f 0 0.2 0.8 c 681 1131 m 62 Y -20 16 d -62 Y f 0
- 0.4 0.8 c 681 1193 m 62 Y -20 16 d -62 Y f 0 0.6 0.8 c 681 1255 m 62 Y -20 16 d
- -62 Y f 0 0.8 0.8 c 681 1317 m 63 Y -20 15 d -62 Y f 0 0.8 0.6 c 681 1380 m 25
- Y -20 15 d -25 Y f black 661 1084 m 20 -15 d 336 Y -20 15 d cl s 0 0.8 0.6 c
- 681 1405 m 23 6 d -20 15 d -23 -6 d f black 681 1405 m 23 6 d -20 15 d -23 -6 d
- cl s 0 0 0.8 c 657 1063 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 681 1131 m 62 Y
- -24 -6 d -62 Y f 0 0.4 0.8 c 681 1193 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 681
- 1255 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 681 1317 m 63 Y -24 -6 d -63 Y f 0 0.8
- 0.6 c 681 1380 m 11 Y -24 -6 d -11 Y f black 657 1063 m 24 6 d 322 Y -24 -6 d
- cl s 0 0 0.8 c 637 1078 m 20 -15 d 62 Y -20 16 d f 0 0.2 0.8 c 657 1125 m 62 Y
- -20 16 d -62 Y f 0 0.4 0.8 c 657 1187 m 62 Y -20 16 d -62 Y f 0 0.6 0.8 c 657
- 1249 m 62 Y -20 16 d -62 Y f 0 0.8 0.8 c 657 1311 m 63 Y -20 15 d -62 Y f 0 0.8
- 0.6 c 657 1374 m 11 Y -20 16 d -12 Y f black 637 1078 m 20 -15 d 322 Y -20 16 d
- cl s 0 0.8 0.6 c 657 1385 m 24 6 d -20 16 d -24 -6 d f black 657 1385 m 24 6 d
- -20 16 d -24 -6 d cl s 0 0 0.8 c 634 1057 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c
- 657 1125 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 657 1187 m 24 Y -23 -6 d -24 Y f
- black 634 1057 m 23 6 d 148 Y -23 -6 d cl s 0 0 0.8 c 614 1072 m 20 -15 d 62 Y
- -20 16 d f 0 0.2 0.8 c 634 1119 m 62 Y -20 16 d -62 Y f 0 0.4 0.8 c 634 1181 m
- 24 Y -20 15 d -23 Y f black 614 1072 m 20 -15 d 148 Y -20 15 d cl s 0 0.4 0.8 c
- 634 1205 m 23 6 d -20 15 d -23 -6 d f black 634 1205 m 23 6 d -20 15 d -23 -6 d
- cl s 0 0 0.8 c 610 1051 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 634 1119 m 62 Y
- -24 -6 d -62 Y f 0 0.4 0.8 c 634 1181 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 634
- 1243 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 634 1305 m 63 Y -24 -6 d -63 Y f 0 0.8
- 0.6 c 634 1368 m 52 Y -24 -6 d -52 Y f black 610 1051 m 24 6 d 363 Y -24 -6 d
- cl s 0 0 0.8 c 590 1066 m 20 -15 d 62 Y -20 16 d f 0 0.2 0.8 c 610 1113 m 62 Y
- -20 16 d -62 Y f 0 0.4 0.8 c 610 1175 m 62 Y -20 16 d -62 Y f 0 0.6 0.8 c 610
- 1237 m 62 Y -20 16 d -62 Y f 0 0.8 0.8 c 610 1299 m 63 Y -20 15 d -62 Y f 0 0.8
- 0.6 c 610 1362 m 52 Y -20 15 d -52 Y f black 590 1066 m 20 -15 d 363 Y -20 15 d
- cl s 0 0.8 0.6 c 610 1414 m 24 6 d -20 15 d -24 -6 d f black 610 1414 m 24 6 d
- -20 15 d -24 -6 d cl s 0 0 0.8 c 587 1045 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c
- 610 1113 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 610 1175 m 62 Y -23 -6 d -62 Y f 0
- 0.6 0.8 c 610 1237 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 610 1299 m 7 Y -23 -6 d
- -7 Y f black 587 1045 m 23 6 d 255 Y -23 -6 d cl s 0 0 0.8 c 567 1060 m 20 -15
- d 62 Y -20 16 d f 0 0.2 0.8 c 587 1107 m 62 Y -20 16 d -62 Y f 0 0.4 0.8 c 587
- 1169 m 62 Y -20 16 d -62 Y f 0 0.6 0.8 c 587 1231 m 62 Y -20 16 d -62 Y f 0 0.8
- 0.8 c 587 1293 m 7 Y -20 16 d -7 Y f black 567 1060 m 20 -15 d 255 Y -20 16 d
- cl s 0 0.8 0.8 c 587 1300 m 23 6 d -20 16 d -23 -6 d f black 587 1300 m 23 6 d
- -20 16 d -23 -6 d cl s 0 0 0.8 c 564 1039 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c
- 587 1107 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 587 1169 m 62 Y -23 -6 d -62 Y f 0
- 0.6 0.8 c 587 1231 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 587 1293 m 63 Y -23 -6 d
- -63 Y f 0 0.8 0.6 c 587 1356 m 62 Y -23 -6 d -62 Y f 0 0.8 0.4 c 587 1418 m 57
- Y -23 -6 d -57 Y f black 564 1039 m 23 6 d 430 Y -23 -6 d cl s 0 0 0.8 c 543
- 1054 m 21 -15 d 62 Y -21 16 d f 0 0.2 0.8 c 564 1101 m 62 Y -21 16 d -62 Y f 0
- 0.4 0.8 c 564 1163 m 62 Y -21 16 d -62 Y f 0 0.6 0.8 c 564 1225 m 62 Y -21 16 d
- -62 Y f 0 0.8 0.8 c 564 1287 m 63 Y -21 15 d -62 Y f 0 0.8 0.6 c 564 1350 m 62
- Y -21 15 d -62 Y f 0 0.8 0.4 c 564 1412 m 57 Y -21 15 d -57 Y f black 543 1054
- m 21 -15 d 430 Y -21 15 d cl s 0 0.8 0.4 c 564 1469 m 23 6 d -20 15 d -24 -6 d
- f black 564 1469 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 540 1033 m 24 6 d 62
- Y -24 -6 d f 0 0.2 0.8 c 564 1101 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 564 1163
- m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 564 1225 m 56 Y -24 -6 d -56 Y f black 540
- 1033 m 24 6 d 242 Y -24 -6 d cl s 0 0 0.8 c 520 1048 m 20 -15 d 62 Y -20 16 d f
- 0 0.2 0.8 c 540 1095 m 62 Y -20 16 d -62 Y f 0 0.4 0.8 c 540 1157 m 62 Y -20 16
- d -62 Y f 0 0.6 0.8 c 540 1219 m 56 Y -20 15 d -55 Y f black 520 1048 m 20 -15
- d 242 Y -20 15 d cl s 0 0.6 0.8 c 540 1275 m 24 6 d -21 15 d -23 -6 d f black
- 540 1275 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 517 1027 m 23 6 d -20 15 d
- -24 -5 d f black 517 1027 m 23 6 d -20 15 d -24 -5 d cl s 0 0 0.8 c 493 1021 m
- 24 6 d -21 16 d -23 -6 d f black 493 1021 m 24 6 d -21 16 d -23 -6 d cl s 0 0
- 0.8 c 470 1015 m 23 6 d -20 16 d -24 -6 d f black 470 1015 m 23 6 d -20 16 d
- -24 -6 d cl s 0 0 0.8 c 446 1009 m 24 6 d -21 16 d -23 -6 d f black 446 1009 m
- 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1570 1275 m 24 6 d -20 15 d -24 -6 d f
- black 1570 1275 m 24 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1547 1269 m 23 6 d
- -20 15 d -23 -6 d f black 1547 1269 m 23 6 d -20 15 d -23 -6 d cl s 0 0 0.8 c
- 1523 1263 m 24 6 d -20 15 d -24 -6 d f black 1523 1263 m 24 6 d -20 15 d -24 -6
- d cl s 0 0 0.8 c 1500 1257 m 23 6 d -20 15 d -23 -6 d f black 1500 1257 m 23 6
- d -20 15 d -23 -6 d cl s 0 0 0.8 c 1476 1251 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8
- c 1500 1319 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 1500 1381 m 62 Y -24 -6 d -62 Y
- f 0 0.6 0.8 c 1500 1443 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 1500 1505 m 47 Y
- -24 -6 d -47 Y f black 1476 1251 m 24 6 d 295 Y -24 -6 d cl s 0 0 0.8 c 1456
- 1266 m 20 -15 d 62 Y -20 15 d f 0 0.2 0.8 c 1476 1313 m 62 Y -20 15 d -62 Y f 0
- 0.4 0.8 c 1476 1375 m 62 Y -20 16 d -63 Y f 0 0.6 0.8 c 1476 1437 m 62 Y -20 16
- d -62 Y f 0 0.8 0.8 c 1476 1499 m 47 Y -20 16 d -47 Y f black 1456 1266 m 20
- -15 d 295 Y -20 16 d cl s 0 0.8 0.8 c 1476 1546 m 24 6 d -20 16 d -24 -6 d f
- black 1476 1546 m 24 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1453 1245 m 23 6 d 62
- Y -23 -6 d f 0 0.2 0.8 c 1476 1313 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 1476
- 1375 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c 1476 1437 m 62 Y -23 -6 d -62 Y f 0
- 0.8 0.8 c 1476 1499 m 47 Y -23 -6 d -47 Y f black 1453 1245 m 23 6 d 295 Y -23
- -6 d cl s 0 0 0.8 c 1433 1260 m 20 -15 d 62 Y -20 15 d f 0 0.2 0.8 c 1453 1307
- m 62 Y -20 15 d -62 Y f 0 0.4 0.8 c 1453 1369 m 62 Y -20 16 d -63 Y f 0 0.6 0.8
- c 1453 1431 m 62 Y -20 16 d -62 Y f 0 0.8 0.8 c 1453 1493 m 47 Y -20 16 d -47 Y
- f black 1433 1260 m 20 -15 d 295 Y -20 16 d cl s 0 0.8 0.8 c 1453 1540 m 23 6 d
- -20 16 d -23 -6 d f black 1453 1540 m 23 6 d -20 16 d -23 -6 d cl s 0 0 0.8 c
- 1429 1239 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1453 1307 m 62 Y -24 -6 d -62 Y
- f 0 0.4 0.8 c 1453 1369 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 1453 1431 m 62 Y
- -24 -6 d -62 Y f 0 0.8 0.8 c 1453 1493 m 62 Y -24 -6 d -62 Y f 0 0.8 0.6 c 1453
- 1555 m 62 Y -24 -5 d -63 Y f 0 0.8 0.4 c 1453 1617 m 17 Y -24 -6 d -16 Y f
- black 1429 1239 m 24 6 d 389 Y -24 -6 d cl s 0 0 0.8 c 1409 1254 m 20 -15 d 62
- Y -20 15 d f 0 0.2 0.8 c 1429 1301 m 62 Y -20 15 d -62 Y f 0 0.4 0.8 c 1429
- 1363 m 62 Y -20 16 d -63 Y f 0 0.6 0.8 c 1429 1425 m 62 Y -20 16 d -62 Y f 0
- 0.8 0.8 c 1429 1487 m 62 Y -20 16 d -62 Y f 0 0.8 0.6 c 1429 1549 m 63 Y -20 15
- d -62 Y f 0 0.8 0.4 c 1429 1612 m 16 Y -20 16 d -17 Y f black 1409 1254 m 20
- -15 d 389 Y -20 16 d cl s 0 0.8 0.4 c 1429 1628 m 24 6 d -20 16 d -24 -6 d f
- black 1429 1628 m 24 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1406 1233 m 23 6 d 62
- Y -23 -6 d f 0 0.2 0.8 c 1429 1301 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 1429
- 1363 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c 1429 1425 m 62 Y -23 -6 d -62 Y f 0
- 0.8 0.8 c 1429 1487 m 62 Y -23 -6 d -62 Y f 0 0.8 0.6 c 1429 1549 m 26 Y -23 -6
- d -26 Y f black 1406 1233 m 23 6 d 336 Y -23 -6 d cl s 0 0 0.8 c 1386 1248 m 20
- -15 d 62 Y -20 15 d f 0 0.2 0.8 c 1406 1295 m 62 Y -20 16 d -63 Y f 0 0.4 0.8 c
- 1406 1357 m 62 Y -20 16 d -62 Y f 0 0.6 0.8 c 1406 1419 m 62 Y -20 16 d -62 Y f
- 0 0.8 0.8 c 1406 1481 m 62 Y -20 16 d -62 Y f 0 0.8 0.6 c 1406 1543 m 26 Y -20
- 15 d -25 Y f black 1386 1248 m 20 -15 d 336 Y -20 15 d cl s 0 0.8 0.6 c 1406
- 1569 m 23 6 d -20 15 d -23 -6 d f black 1406 1569 m 23 6 d -20 15 d -23 -6 d
- cl s 0 0 0.8 c 1382 1227 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1406 1295 m 62 Y
- -24 -6 d -62 Y f 0 0.4 0.8 c 1406 1357 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 1406
- 1419 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 1406 1481 m 47 Y -24 -6 d -47 Y f
- black 1382 1227 m 24 6 d 295 Y -24 -6 d cl s 0 0 0.8 c 1362 1242 m 20 -15 d 62
- Y -20 15 d f 0 0.2 0.8 c 1382 1289 m 62 Y -20 16 d -63 Y f 0 0.4 0.8 c 1382
- 1351 m 62 Y -20 16 d -62 Y f 0 0.6 0.8 c 1382 1413 m 62 Y -20 16 d -62 Y f 0
- 0.8 0.8 c 1382 1475 m 47 Y -20 16 d -47 Y f black 1362 1242 m 20 -15 d 295 Y
- -20 16 d cl s 0 0.8 0.8 c 1382 1522 m 24 6 d -20 16 d -24 -6 d f black 1382
- 1522 m 24 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1359 1221 m 23 6 d 62 Y -23 -6 d
- f 0 0.2 0.8 c 1382 1289 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 1382 1351 m 62 Y
- -23 -6 d -62 Y f 0 0.6 0.8 c 1382 1413 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 1382
- 1475 m 62 Y -23 -6 d -62 Y f 0 0.8 0.6 c 1382 1537 m 63 Y -23 -6 d -63 Y f 0
- 0.8 0.4 c 1382 1600 m 16 Y -23 -6 d -16 Y f black 1359 1221 m 23 6 d 389 Y -23
- -6 d cl s 0 0 0.8 c 1339 1236 m 20 -15 d 62 Y -20 15 d f 0 0.2 0.8 c 1359 1283
- m 62 Y -20 16 d -63 Y f 0 0.4 0.8 c 1359 1345 m 62 Y -20 16 d -62 Y f 0 0.6 0.8
- c 1359 1407 m 62 Y -20 16 d -62 Y f 0 0.8 0.8 c 1359 1469 m 62 Y -20 16 d -62 Y
- f 0 0.8 0.6 c 1359 1531 m 63 Y -20 15 d -62 Y f 0 0.8 0.4 c 1359 1594 m 16 Y
- -20 16 d -17 Y f black 1339 1236 m 20 -15 d 389 Y -20 16 d cl s 0 0.8 0.4 c
- 1359 1610 m 23 6 d -20 16 d -23 -6 d f black 1359 1610 m 23 6 d -20 16 d -23 -6
- d cl s 0 0 0.8 c 1335 1215 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1359 1283 m 62
- Y -24 -6 d -62 Y f 0 0.4 0.8 c 1359 1345 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c
- 1359 1407 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 1359 1469 m 20 Y -24 -6 d -20 Y f
- black 1335 1215 m 24 6 d 268 Y -24 -6 d cl s 0 0 0.8 c 1315 1230 m 20 -15 d 62
- Y -20 15 d f 0 0.2 0.8 c 1335 1277 m 62 Y -20 16 d -63 Y f 0 0.4 0.8 c 1335
- 1339 m 62 Y -20 16 d -62 Y f 0 0.6 0.8 c 1335 1401 m 62 Y -20 16 d -62 Y f 0
- 0.8 0.8 c 1335 1463 m 20 Y -20 16 d -20 Y f black 1315 1230 m 20 -15 d 268 Y
- -20 16 d cl s 0 0.8 0.8 c 1335 1483 m 24 6 d -20 16 d -24 -6 d f black 1335
- 1483 m 24 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1312 1209 m 23 6 d 62 Y -23 -6 d
- f 0 0.2 0.8 c 1335 1277 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 1335 1339 m 62 Y
- -23 -6 d -62 Y f 0 0.6 0.8 c 1335 1401 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 1335
- 1463 m 62 Y -23 -6 d -62 Y f 0 0.8 0.6 c 1335 1525 m 63 Y -23 -6 d -63 Y f 0
- 0.8 0.4 c 1335 1588 m 30 Y -23 -6 d -30 Y f black 1312 1209 m 23 6 d 403 Y -23
- -6 d cl s 0 0 0.8 c 1292 1224 m 20 -15 d 62 Y -20 15 d f 0 0.2 0.8 c 1312 1271
- m 62 Y -20 16 d -63 Y f 0 0.4 0.8 c 1312 1333 m 62 Y -20 16 d -62 Y f 0 0.6 0.8
- c 1312 1395 m 62 Y -20 16 d -62 Y f 0 0.8 0.8 c 1312 1457 m 62 Y -20 16 d -62 Y
- f 0 0.8 0.6 c 1312 1519 m 63 Y -20 15 d -62 Y f 0 0.8 0.4 c 1312 1582 m 30 Y
- -20 15 d -30 Y f black 1292 1224 m 20 -15 d 403 Y -20 15 d cl s 0 0.8 0.4 c
- 1312 1612 m 23 6 d -20 15 d -23 -6 d f black 1312 1612 m 23 6 d -20 15 d -23 -6
- d cl s 0 0 0.8 c 1289 1203 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 1312 1271 m 62
- Y -23 -6 d -62 Y f 0 0.4 0.8 c 1312 1333 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c
- 1312 1395 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 1312 1457 m 34 Y -23 -6 d -34 Y f
- black 1289 1203 m 23 6 d 282 Y -23 -6 d cl s 0 0 0.8 c 1268 1218 m 21 -15 d 62
- Y -21 15 d f 0 0.2 0.8 c 1289 1265 m 62 Y -21 16 d -63 Y f 0 0.4 0.8 c 1289
- 1327 m 62 Y -21 16 d -62 Y f 0 0.6 0.8 c 1289 1389 m 62 Y -21 16 d -62 Y f 0
- 0.8 0.8 c 1289 1451 m 34 Y -21 15 d -33 Y f black 1268 1218 m 21 -15 d 282 Y
- -21 15 d cl s 0 0.8 0.8 c 1289 1485 m 23 6 d -20 15 d -24 -6 d f black 1289
- 1485 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1265 1197 m 24 6 d 62 Y -24 -6 d
- f 0 0.2 0.8 c 1289 1265 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 1289 1327 m 62 Y
- -24 -6 d -62 Y f 0 0.6 0.8 c 1289 1389 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 1289
- 1451 m 61 Y -24 -6 d -61 Y f black 1265 1197 m 24 6 d 309 Y -24 -6 d cl s 0 0
- 0.8 c 1245 1212 m 20 -15 d 62 Y -20 15 d f 0 0.2 0.8 c 1265 1259 m 62 Y -20 16
- d -63 Y f 0 0.4 0.8 c 1265 1321 m 62 Y -20 16 d -62 Y f 0 0.6 0.8 c 1265 1383 m
- 62 Y -20 16 d -62 Y f 0 0.8 0.8 c 1265 1445 m 61 Y -20 15 d -60 Y f black 1245
- 1212 m 20 -15 d 309 Y -20 15 d cl s 0 0.8 0.8 c 1265 1506 m 24 6 d -21 15 d -23
- -6 d f black 1265 1506 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 1242 1191 m 23
- 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 1265 1259 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c
- 1265 1321 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c 1265 1383 m 62 Y -23 -6 d -62 Y f
- 0 0.8 0.8 c 1265 1445 m 63 Y -23 -6 d -63 Y f 0 0.8 0.6 c 1265 1508 m 62 Y -23
- -6 d -62 Y f 0 0.8 0.4 c 1265 1570 m 30 Y -23 -6 d -30 Y f black 1242 1191 m 23
- 6 d 403 Y -23 -6 d cl s 0 0 0.8 c 1221 1206 m 21 -15 d 62 Y -21 16 d f 0 0.2
- 0.8 c 1242 1253 m 62 Y -21 16 d -62 Y f 0 0.4 0.8 c 1242 1315 m 62 Y -21 16 d
- -62 Y f 0 0.6 0.8 c 1242 1377 m 62 Y -21 16 d -62 Y f 0 0.8 0.8 c 1242 1439 m
- 63 Y -21 15 d -62 Y f 0 0.8 0.6 c 1242 1502 m 62 Y -21 15 d -62 Y f 0 0.8 0.4 c
- 1242 1564 m 30 Y -21 15 d -30 Y f black 1221 1206 m 21 -15 d 403 Y -21 15 d
- cl s 0 0.8 0.4 c 1242 1594 m 23 6 d -20 15 d -24 -6 d f black 1242 1594 m 23 6
- d -20 15 d -24 -6 d cl s 0 0 0.8 c 1218 1185 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8
- c 1242 1253 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 1242 1315 m 62 Y -24 -6 d -62 Y
- f 0 0.6 0.8 c 1242 1377 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 1242 1439 m 63 Y
- -24 -6 d -63 Y f 0 0.8 0.6 c 1242 1502 m 62 Y -24 -6 d -62 Y f 0 0.8 0.4 c 1242
- 1564 m 3 Y -24 -6 d -3 Y f black 1218 1185 m 24 6 d 376 Y -24 -6 d cl s 0 0 0.8
- c 1198 1200 m 20 -15 d 62 Y -20 16 d f 0 0.2 0.8 c 1218 1247 m 62 Y -20 16 d
- -62 Y f 0 0.4 0.8 c 1218 1309 m 62 Y -20 16 d -62 Y f 0 0.6 0.8 c 1218 1371 m
- 62 Y -20 16 d -62 Y f 0 0.8 0.8 c 1218 1433 m 63 Y -20 15 d -62 Y f 0 0.8 0.6 c
- 1218 1496 m 62 Y -20 15 d -62 Y f 0 0.8 0.4 c 1218 1558 m 3 Y -20 16 d -4 Y f
- black 1198 1200 m 20 -15 d 376 Y -20 16 d cl s 0 0.8 0.4 c 1218 1561 m 24 6 d
- -21 16 d -23 -6 d f black 1218 1561 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c
- 1195 1179 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 1218 1247 m 62 Y -23 -6 d -62 Y
- f 0 0.4 0.8 c 1218 1309 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c 1218 1371 m 42 Y
- -23 -6 d -42 Y f black 1195 1179 m 23 6 d 228 Y -23 -6 d cl s 0 0 0.8 c 1174
- 1194 m 21 -15 d 62 Y -21 16 d f 0 0.2 0.8 c 1195 1241 m 62 Y -21 16 d -62 Y f 0
- 0.4 0.8 c 1195 1303 m 62 Y -21 16 d -62 Y f 0 0.6 0.8 c 1195 1365 m 42 Y -21 16
- d -42 Y f black 1174 1194 m 21 -15 d 228 Y -21 16 d cl s 0 0.6 0.8 c 1195 1407
- m 23 6 d -20 16 d -24 -6 d f black 1195 1407 m 23 6 d -20 16 d -24 -6 d cl s 0
- 0 0.8 c 1171 1173 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1195 1241 m 62 Y -24 -6
- d -62 Y f 0 0.4 0.8 c 1195 1303 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 1195 1365 m
- 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 1195 1427 m 63 Y -24 -6 d -63 Y f 0 0.8 0.6 c
- 1195 1490 m 38 Y -24 -6 d -38 Y f black 1171 1173 m 24 6 d 349 Y -24 -6 d cl s
- 0 0 0.8 c 1151 1188 m 20 -15 d 62 Y -20 16 d f 0 0.2 0.8 c 1171 1235 m 62 Y -20
- 16 d -62 Y f 0 0.4 0.8 c 1171 1297 m 62 Y -20 16 d -62 Y f 0 0.6 0.8 c 1171
- 1359 m 62 Y -20 16 d -62 Y f 0 0.8 0.8 c 1171 1421 m 63 Y -20 15 d -62 Y f 0
- 0.8 0.6 c 1171 1484 m 38 Y -20 16 d -39 Y f black 1151 1188 m 20 -15 d 349 Y
- -20 16 d cl s 0 0.8 0.6 c 1171 1522 m 24 6 d -21 16 d -23 -6 d f black 1171
- 1522 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1148 1167 m 23 6 d 62 Y -23 -6 d
- f 0 0.2 0.8 c 1171 1235 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 1171 1297 m 62 Y
- -23 -6 d -62 Y f 0 0.6 0.8 c 1171 1359 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 1171
- 1421 m 63 Y -23 -6 d -63 Y f 0 0.8 0.6 c 1171 1484 m 38 Y -23 -6 d -38 Y f
- black 1148 1167 m 23 6 d 349 Y -23 -6 d cl s 0 0 0.8 c 1127 1182 m 21 -15 d 62
- Y -21 16 d f 0 0.2 0.8 c 1148 1229 m 62 Y -21 16 d -62 Y f 0 0.4 0.8 c 1148
- 1291 m 62 Y -21 16 d -62 Y f 0 0.6 0.8 c 1148 1353 m 62 Y -21 16 d -62 Y f 0
- 0.8 0.8 c 1148 1415 m 63 Y -21 15 d -62 Y f 0 0.8 0.6 c 1148 1478 m 38 Y -21 16
- d -39 Y f black 1127 1182 m 21 -15 d 349 Y -21 16 d cl s 0 0.8 0.6 c 1148 1516
- m 23 6 d -20 16 d -24 -6 d f black 1148 1516 m 23 6 d -20 16 d -24 -6 d cl s 0
- 0 0.8 c 1124 1161 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1148 1229 m 62 Y -24 -6
- d -62 Y f 0 0.4 0.8 c 1148 1291 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 1148 1353 m
- 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 1148 1415 m 63 Y -24 -6 d -63 Y f 0 0.8 0.6 c
- 1148 1478 m 11 Y -24 -6 d -11 Y f black 1124 1161 m 24 6 d 322 Y -24 -6 d cl s
- 0 0 0.8 c 1104 1176 m 20 -15 d 62 Y -20 16 d f 0 0.2 0.8 c 1124 1223 m 62 Y -20
- 16 d -62 Y f 0 0.4 0.8 c 1124 1285 m 62 Y -20 16 d -62 Y f 0 0.6 0.8 c 1124
- 1347 m 62 Y -20 16 d -62 Y f 0 0.8 0.8 c 1124 1409 m 63 Y -20 15 d -62 Y f 0
- 0.8 0.6 c 1124 1472 m 11 Y -20 16 d -12 Y f black 1104 1176 m 20 -15 d 322 Y
- -20 16 d cl s 0 0.8 0.6 c 1124 1483 m 24 6 d -21 16 d -23 -6 d f black 1124
- 1483 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1101 1155 m 23 6 d 62 Y -23 -6 d
- f 0 0.2 0.8 c 1124 1223 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 1124 1285 m 62 Y
- -23 -6 d -62 Y f 0 0.6 0.8 c 1124 1347 m 62 Y -23 -5 d -63 Y f 0 0.8 0.8 c 1124
- 1409 m 63 Y -23 -6 d -62 Y f 0 0.8 0.6 c 1124 1472 m 52 Y -23 -6 d -52 Y f
- black 1101 1155 m 23 6 d 363 Y -23 -6 d cl s 0 0 0.8 c 1080 1170 m 21 -15 d 62
- Y -21 16 d f 0 0.2 0.8 c 1101 1217 m 62 Y -21 16 d -62 Y f 0 0.4 0.8 c 1101
- 1279 m 62 Y -21 16 d -62 Y f 0 0.6 0.8 c 1101 1341 m 63 Y -21 15 d -62 Y f 0
- 0.8 0.8 c 1101 1404 m 62 Y -21 15 d -62 Y f 0 0.8 0.6 c 1101 1466 m 52 Y -21 15
- d -52 Y f black 1080 1170 m 21 -15 d 363 Y -21 15 d cl s 0 0.8 0.6 c 1101 1518
- m 23 6 d -20 15 d -24 -6 d f black 1101 1518 m 23 6 d -20 15 d -24 -6 d cl s 0
- 0 0.8 c 1077 1149 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1101 1217 m 62 Y -24 -6
- d -62 Y f 0 0.4 0.8 c 1101 1279 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 1101 1341 m
- 63 Y -24 -6 d -63 Y f 0 0.8 0.8 c 1101 1404 m 62 Y -24 -6 d -62 Y f 0 0.8 0.6 c
- 1101 1466 m 62 Y -24 -6 d -62 Y f 0 0.8 0.4 c 1101 1528 m 43 Y -24 -6 d -43 Y f
- black 1077 1149 m 24 6 d 416 Y -24 -6 d cl s 0 0 0.8 c 1057 1165 m 20 -16 d 62
- Y -20 16 d f 0 0.2 0.8 c 1077 1211 m 62 Y -20 16 d -62 Y f 0 0.4 0.8 c 1077
- 1273 m 62 Y -20 16 d -62 Y f 0 0.6 0.8 c 1077 1335 m 63 Y -20 15 d -62 Y f 0
- 0.8 0.8 c 1077 1398 m 62 Y -20 15 d -62 Y f 0 0.8 0.6 c 1077 1460 m 62 Y -20 15
- d -62 Y f 0 0.8 0.4 c 1077 1522 m 43 Y -20 16 d -44 Y f black 1057 1165 m 20
- -16 d 416 Y -20 16 d cl s 0 0.8 0.4 c 1077 1565 m 24 6 d -21 16 d -23 -6 d f
- black 1077 1565 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1054 1143 m 23 6 d 62
- Y -23 -6 d f 0 0.2 0.8 c 1077 1211 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 1077
- 1273 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c 1077 1335 m 63 Y -23 -6 d -63 Y f 0
- 0.8 0.8 c 1077 1398 m 6 Y -23 -6 d -6 Y f black 1054 1143 m 23 6 d 255 Y -23 -6
- d cl s 0 0 0.8 c 1033 1159 m 21 -16 d 62 Y -21 16 d f 0 0.2 0.8 c 1054 1205 m
- 62 Y -21 16 d -62 Y f 0 0.4 0.8 c 1054 1267 m 62 Y -21 16 d -62 Y f 0 0.6 0.8 c
- 1054 1329 m 63 Y -21 15 d -62 Y f 0 0.8 0.8 c 1054 1392 m 6 Y -21 16 d -7 Y f
- black 1033 1159 m 21 -16 d 255 Y -21 16 d cl s 0 0.8 0.8 c 1054 1398 m 23 6 d
- -20 16 d -24 -6 d f black 1054 1398 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c
- 1030 1137 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1054 1205 m 62 Y -24 -6 d -62 Y
- f 0 0.4 0.8 c 1054 1267 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 1054 1329 m 63 Y
- -24 -6 d -63 Y f 0 0.8 0.8 c 1054 1392 m 62 Y -24 -6 d -62 Y f 0 0.8 0.6 c 1054
- 1454 m 62 Y -24 -6 d -62 Y f 0 0.8 0.4 c 1054 1516 m 57 Y -24 -6 d -57 Y f
- black 1030 1137 m 24 6 d 430 Y -24 -6 d cl s 0 0 0.8 c 1010 1153 m 20 -16 d 62
- Y -20 16 d f 0 0.2 0.8 c 1030 1199 m 62 Y -20 16 d -62 Y f 0 0.4 0.8 c 1030
- 1261 m 62 Y -20 16 d -62 Y f 0 0.6 0.8 c 1030 1323 m 63 Y -20 15 d -62 Y f 0
- 0.8 0.8 c 1030 1386 m 62 Y -20 15 d -62 Y f 0 0.8 0.6 c 1030 1448 m 62 Y -20 15
- d -62 Y f 0 0.8 0.4 c 1030 1510 m 57 Y -20 15 d -57 Y f black 1010 1153 m 20
- -16 d 430 Y -20 15 d cl s 0 0.8 0.4 c 1030 1567 m 24 6 d -21 15 d -23 -6 d f
- black 1030 1567 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 1007 1131 m 23 6 d 62
- Y -23 -6 d f 0 0.2 0.8 c 1030 1199 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 1030
- 1261 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c 1030 1323 m 63 Y -23 -6 d -63 Y f 0
- 0.8 0.8 c 1030 1386 m 60 Y -23 -6 d -60 Y f black 1007 1131 m 23 6 d 309 Y -23
- -6 d cl s 0 0 0.8 c 986 1147 m 21 -16 d 62 Y -21 16 d f 0 0.2 0.8 c 1007 1193 m
- 62 Y -21 16 d -62 Y f 0 0.4 0.8 c 1007 1255 m 62 Y -21 16 d -62 Y f 0 0.6 0.8 c
- 1007 1317 m 63 Y -21 15 d -62 Y f 0 0.8 0.8 c 1007 1380 m 60 Y -21 16 d -61 Y f
- black 986 1147 m 21 -16 d 309 Y -21 16 d cl s 0 0.8 0.8 c 1007 1440 m 23 6 d
- -20 16 d -24 -6 d f black 1007 1440 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c
- 983 1125 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1007 1193 m 62 Y -24 -6 d -62 Y f
- 0 0.4 0.8 c 1007 1255 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 1007 1317 m 63 Y -24
- -6 d -63 Y f 0 0.8 0.8 c 1007 1380 m 62 Y -24 -6 d -62 Y f 0 0.8 0.6 c 1007
- 1442 m 62 Y -24 -6 d -62 Y f 0 0.8 0.4 c 1007 1504 m 57 Y -24 -6 d -57 Y f
- black 983 1125 m 24 6 d 430 Y -24 -6 d cl s 0 0 0.8 c 963 1141 m 20 -16 d 62 Y
- -20 16 d f 0 0.2 0.8 c 983 1187 m 62 Y -20 16 d -62 Y f 0 0.4 0.8 c 983 1249 m
- 62 Y -20 16 d -62 Y f 0 0.6 0.8 c 983 1311 m 63 Y -20 15 d -62 Y f 0 0.8 0.8 c
- 983 1374 m 62 Y -20 15 d -62 Y f 0 0.8 0.6 c 983 1436 m 62 Y -20 15 d -62 Y f 0
- 0.8 0.4 c 983 1498 m 57 Y -20 16 d -58 Y f black 963 1141 m 20 -16 d 430 Y -20
- 16 d cl s 0 0.8 0.4 c 983 1555 m 24 6 d -21 16 d -23 -6 d f black 983 1555 m 24
- 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 960 1119 m 23 6 d 62 Y -23 -6 d f 0 0.2
- 0.8 c 983 1187 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 983 1249 m 62 Y -23 -6 d -62
- Y f 0 0.6 0.8 c 983 1311 m 63 Y -23 -6 d -63 Y f 0 0.8 0.8 c 983 1374 m 60 Y
- -23 -6 d -60 Y f black 960 1119 m 23 6 d 309 Y -23 -6 d cl s 0 0 0.8 c 939 1135
- m 21 -16 d 62 Y -21 16 d f 0 0.2 0.8 c 960 1181 m 62 Y -21 16 d -62 Y f 0 0.4
- 0.8 c 960 1243 m 62 Y -21 16 d -62 Y f 0 0.6 0.8 c 960 1305 m 63 Y -21 15 d -62
- Y f 0 0.8 0.8 c 960 1368 m 60 Y -21 16 d -61 Y f black 939 1135 m 21 -16 d 309
- Y -21 16 d cl s 0 0.8 0.8 c 960 1428 m 23 6 d -20 16 d -24 -6 d f black 960
- 1428 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 936 1113 m 24 6 d 62 Y -24 -6 d
- f 0 0.2 0.8 c 960 1181 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 960 1243 m 62 Y -24
- -5 d -63 Y f 0 0.6 0.8 c 960 1305 m 63 Y -24 -6 d -62 Y f 0 0.8 0.8 c 960 1368
- m 62 Y -24 -6 d -62 Y f 0 0.8 0.6 c 960 1430 m 62 Y -24 -6 d -62 Y f 0 0.8 0.4
- c 960 1492 m 30 Y -24 -6 d -30 Y f black 936 1113 m 24 6 d 403 Y -24 -6 d cl s
- 0 0 0.8 c 916 1129 m 20 -16 d 62 Y -20 16 d f 0 0.2 0.8 c 936 1175 m 62 Y -20
- 16 d -62 Y f 0 0.4 0.8 c 936 1237 m 63 Y -20 15 d -62 Y f 0 0.6 0.8 c 936 1300
- m 62 Y -20 15 d -62 Y f 0 0.8 0.8 c 936 1362 m 62 Y -20 15 d -62 Y f 0 0.8 0.6
- c 936 1424 m 62 Y -20 15 d -62 Y f 0 0.8 0.4 c 936 1486 m 30 Y -20 16 d -31 Y f
- black 916 1129 m 20 -16 d 403 Y -20 16 d cl s 0 0.8 0.4 c 936 1516 m 24 6 d -21
- 16 d -23 -6 d f black 936 1516 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 913
- 1107 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 936 1175 m 62 Y -23 -6 d -62 Y f 0
- 0.4 0.8 c 936 1237 m 63 Y -23 -6 d -63 Y f 0 0.6 0.8 c 936 1300 m 62 Y -23 -6 d
- -62 Y f 0 0.8 0.8 c 936 1362 m 62 Y -23 -6 d -62 Y f 0 0.8 0.6 c 936 1424 m 62
- Y -23 -6 d -62 Y f 0 0.8 0.4 c 936 1486 m 57 Y -23 -6 d -57 Y f black 913 1107
- m 23 6 d 430 Y -23 -6 d cl s 0 0 0.8 c 892 1123 m 21 -16 d 62 Y -21 16 d f 0
- 0.2 0.8 c 913 1169 m 62 Y -21 16 d -62 Y f 0 0.4 0.8 c 913 1231 m 63 Y -21 15 d
- -62 Y f 0 0.6 0.8 c 913 1294 m 62 Y -21 15 d -62 Y f 0 0.8 0.8 c 913 1356 m 62
- Y -21 15 d -62 Y f 0 0.8 0.6 c 913 1418 m 62 Y -21 15 d -62 Y f 0 0.8 0.4 c 913
- 1480 m 57 Y -21 16 d -58 Y f black 892 1123 m 21 -16 d 430 Y -21 16 d cl s 0
- 0.8 0.4 c 913 1537 m 23 6 d -20 16 d -24 -6 d f black 913 1537 m 23 6 d -20 16
- d -24 -6 d cl s 0 0 0.8 c 889 1101 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 913
- 1169 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 913 1231 m 63 Y -24 -6 d -63 Y f 0 0.6
- 0.8 c 913 1294 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 913 1356 m 62 Y -24 -6 d -62
- Y f 0 0.8 0.6 c 913 1418 m 62 Y -24 -6 d -62 Y f 0 0.8 0.4 c 913 1480 m 17 Y
- -24 -6 d -17 Y f black 889 1101 m 24 6 d 390 Y -24 -6 d cl s 0 0 0.8 c 869 1117
- m 20 -16 d 62 Y -20 16 d f 0 0.2 0.8 c 889 1163 m 62 Y -20 16 d -62 Y f 0 0.4
- 0.8 c 889 1225 m 63 Y -20 15 d -62 Y f 0 0.6 0.8 c 889 1288 m 62 Y -20 15 d -62
- Y f 0 0.8 0.8 c 889 1350 m 62 Y -20 15 d -62 Y f 0 0.8 0.6 c 889 1412 m 62 Y
- -20 16 d -63 Y f 0 0.8 0.4 c 889 1474 m 17 Y -20 15 d -16 Y f black 869 1117 m
- 20 -16 d 390 Y -20 15 d cl s 0 0.8 0.4 c 889 1491 m 24 6 d -21 15 d -23 -6 d f
- black 889 1491 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 866 1095 m 23 6 d 62 Y
- -23 -6 d f 0 0.2 0.8 c 889 1163 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 889 1225 m
- 63 Y -23 -6 d -63 Y f 0 0.6 0.8 c 889 1288 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c
- 889 1350 m 62 Y -23 -6 d -62 Y f 0 0.8 0.6 c 889 1412 m 62 Y -23 -6 d -62 Y f 0
- 0.8 0.4 c 889 1474 m 17 Y -23 -6 d -17 Y f black 866 1095 m 23 6 d 390 Y -23 -6
- d cl s 0 0 0.8 c 845 1111 m 21 -16 d 62 Y -21 16 d f 0 0.2 0.8 c 866 1157 m 62
- Y -21 16 d -62 Y f 0 0.4 0.8 c 866 1219 m 63 Y -21 15 d -62 Y f 0 0.6 0.8 c 866
- 1282 m 62 Y -21 15 d -62 Y f 0 0.8 0.8 c 866 1344 m 62 Y -21 15 d -62 Y f 0 0.8
- 0.6 c 866 1406 m 62 Y -21 16 d -63 Y f 0 0.8 0.4 c 866 1468 m 17 Y -21 15 d -16
- Y f black 845 1111 m 21 -16 d 390 Y -21 15 d cl s 0 0.8 0.4 c 866 1485 m 23 6 d
- -20 15 d -24 -6 d f black 866 1485 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c
- 842 1089 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 866 1157 m 62 Y -24 -6 d -62 Y f
- 0 0.4 0.8 c 866 1219 m 63 Y -24 -6 d -63 Y f 0 0.6 0.8 c 866 1282 m 62 Y -24 -6
- d -62 Y f 0 0.8 0.8 c 866 1344 m 62 Y -24 -6 d -62 Y f 0 0.8 0.6 c 866 1406 m
- 62 Y -24 -6 d -62 Y f 0 0.8 0.4 c 866 1468 m 62 Y -24 -6 d -62 Y f 0 0.8 0.2 c
- 866 1530 m 62 Y -24 -6 d -62 Y f black 842 1089 m 24 6 d 497 Y -24 -6 d cl s 0
- 0 0.8 c 822 1105 m 20 -16 d 62 Y -20 16 d f 0 0.2 0.8 c 842 1151 m 62 Y -20 16
- d -62 Y f 0 0.4 0.8 c 842 1213 m 63 Y -20 15 d -62 Y f 0 0.6 0.8 c 842 1276 m
- 62 Y -20 15 d -62 Y f 0 0.8 0.8 c 842 1338 m 62 Y -20 15 d -62 Y f 0 0.8 0.6 c
- 842 1400 m 62 Y -20 16 d -63 Y f 0 0.8 0.4 c 842 1462 m 62 Y -20 16 d -62 Y f 0
- 0.8 0.2 c 842 1524 m 62 Y -20 16 d -62 Y f black 822 1105 m 20 -16 d 497 Y -20
- 16 d cl s 0 0.8 0.2 c 842 1586 m 24 6 d -21 16 d -23 -6 d f 0 0.8 0 c 842 1586
- m 24 6 d -21 16 d -23 -6 d f black 842 1586 m 24 6 d -21 16 d -23 -6 d cl s 0 0
- 0.8 c 819 1083 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 842 1151 m 62 Y -23 -6 d
- -62 Y f 0 0.4 0.8 c 842 1213 m 63 Y -23 -6 d -63 Y f 0 0.6 0.8 c 842 1276 m 62
- Y -23 -6 d -62 Y f 0 0.8 0.8 c 842 1338 m 47 Y -23 -6 d -47 Y f black 819 1083
- m 23 6 d 296 Y -23 -6 d cl s 0 0 0.8 c 798 1099 m 21 -16 d 62 Y -21 16 d f 0
- 0.2 0.8 c 819 1145 m 62 Y -21 16 d -62 Y f 0 0.4 0.8 c 819 1207 m 63 Y -21 15 d
- -62 Y f 0 0.6 0.8 c 819 1270 m 62 Y -21 15 d -62 Y f 0 0.8 0.8 c 819 1332 m 47
- Y -21 15 d -47 Y f black 798 1099 m 21 -16 d 296 Y -21 15 d cl s 0 0.8 0.8 c
- 819 1379 m 23 6 d -20 15 d -24 -6 d f black 819 1379 m 23 6 d -20 15 d -24 -6 d
- cl s 0 0 0.8 c 795 1077 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 819 1145 m 62 Y
- -24 -6 d -62 Y f 0 0.4 0.8 c 819 1207 m 63 Y -24 -6 d -63 Y f 0 0.6 0.8 c 819
- 1270 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 819 1332 m 62 Y -24 -6 d -62 Y f 0 0.8
- 0.6 c 819 1394 m 62 Y -24 -6 d -62 Y f 0 0.8 0.4 c 819 1456 m 62 Y -24 -6 d -62
- Y f 0 0.8 0.2 c 819 1518 m 49 Y -24 -6 d -49 Y f black 795 1077 m 24 6 d 484 Y
- -24 -6 d cl s 0 0 0.8 c 775 1093 m 20 -16 d 62 Y -20 16 d f 0 0.2 0.8 c 795
- 1139 m 62 Y -20 16 d -62 Y f 0 0.4 0.8 c 795 1201 m 63 Y -20 15 d -62 Y f 0 0.6
- 0.8 c 795 1264 m 62 Y -20 15 d -62 Y f 0 0.8 0.8 c 795 1326 m 62 Y -20 15 d -62
- Y f 0 0.8 0.6 c 795 1388 m 62 Y -20 16 d -63 Y f 0 0.8 0.4 c 795 1450 m 62 Y
- -20 16 d -62 Y f 0 0.8 0.2 c 795 1512 m 49 Y -20 15 d -48 Y f black 775 1093 m
- 20 -16 d 484 Y -20 15 d cl s 0 0.8 0.2 c 795 1561 m 24 6 d -21 15 d -23 -6 d f
- black 795 1561 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 772 1071 m 23 6 d 62 Y
- -23 -6 d f 0 0.2 0.8 c 795 1139 m 62 Y -23 -5 d -63 Y f 0 0.4 0.8 c 795 1201 m
- 63 Y -23 -6 d -62 Y f 0 0.6 0.8 c 795 1264 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c
- 795 1326 m 62 Y -23 -6 d -62 Y f 0 0.8 0.6 c 795 1388 m 62 Y -23 -6 d -62 Y f 0
- 0.8 0.4 c 795 1450 m 62 Y -23 -6 d -62 Y f 0 0.8 0.2 c 795 1512 m 62 Y -23 -6 d
- -62 Y f 0 0.8 0 c 795 1574 m 14 Y -23 -6 d -14 Y f black 772 1071 m 23 6 d 511
- Y -23 -6 d cl s 0 0 0.8 c 751 1087 m 21 -16 d 62 Y -21 16 d f 0 0.2 0.8 c 772
- 1133 m 63 Y -21 15 d -62 Y f 0 0.4 0.8 c 772 1196 m 62 Y -21 15 d -62 Y f 0 0.6
- 0.8 c 772 1258 m 62 Y -21 15 d -62 Y f 0 0.8 0.8 c 772 1320 m 62 Y -21 15 d -62
- Y f 0 0.8 0.6 c 772 1382 m 62 Y -21 16 d -63 Y f 0 0.8 0.4 c 772 1444 m 62 Y
- -21 16 d -62 Y f 0 0.8 0.2 c 772 1506 m 62 Y -21 16 d -62 Y f 0 0.8 0 c 772
- 1568 m 14 Y -21 15 d -13 Y f black 751 1087 m 21 -16 d 511 Y -21 15 d cl s 0
- 0.8 0 c 772 1582 m 23 6 d -20 15 d -24 -6 d f black 772 1582 m 23 6 d -20 15 d
- -24 -6 d cl s 0 0 0.8 c 748 1065 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 772 1133
- m 63 Y -24 -6 d -63 Y f 0 0.4 0.8 c 772 1196 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8
- c 772 1258 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 772 1320 m 62 Y -24 -6 d -62 Y f
- 0 0.8 0.6 c 772 1382 m 62 Y -24 -6 d -62 Y f 0 0.8 0.4 c 772 1444 m 3 Y -24 -6
- d -3 Y f black 748 1065 m 24 6 d 376 Y -24 -6 d cl s 0 0 0.8 c 728 1081 m 20
- -16 d 62 Y -20 16 d f 0 0.2 0.8 c 748 1127 m 63 Y -20 15 d -62 Y f 0 0.4 0.8 c
- 748 1190 m 62 Y -20 15 d -62 Y f 0 0.6 0.8 c 748 1252 m 62 Y -20 15 d -62 Y f 0
- 0.8 0.8 c 748 1314 m 62 Y -20 15 d -62 Y f 0 0.8 0.6 c 748 1376 m 62 Y -20 16 d
- -63 Y f 0 0.8 0.4 c 748 1438 m 3 Y -20 16 d -3 Y f black 728 1081 m 20 -16 d
- 376 Y -20 16 d cl s 0 0.8 0.4 c 748 1441 m 24 6 d -21 16 d -23 -6 d f black 748
- 1441 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 725 1059 m 23 6 d 62 Y -23 -6 d
- f 0 0.2 0.8 c 748 1127 m 63 Y -23 -6 d -63 Y f 0 0.4 0.8 c 748 1190 m 62 Y -23
- -6 d -62 Y f 0 0.6 0.8 c 748 1252 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 748 1314
- m 62 Y -23 -6 d -62 Y f 0 0.8 0.6 c 748 1376 m 12 Y -23 -6 d -12 Y f black 725
- 1059 m 23 6 d 323 Y -23 -6 d cl s 0 0 0.8 c 704 1075 m 21 -16 d 62 Y -21 16 d f
- 0 0.2 0.8 c 725 1121 m 63 Y -21 15 d -62 Y f 0 0.4 0.8 c 725 1184 m 62 Y -21 15
- d -62 Y f 0 0.6 0.8 c 725 1246 m 62 Y -21 15 d -62 Y f 0 0.8 0.8 c 725 1308 m
- 62 Y -21 16 d -63 Y f 0 0.8 0.6 c 725 1370 m 12 Y -21 15 d -11 Y f black 704
- 1075 m 21 -16 d 323 Y -21 15 d cl s 0 0.8 0.6 c 725 1382 m 23 6 d -20 15 d -24
- -6 d f black 725 1382 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 701 1053 m 24 6
- d 62 Y -24 -6 d f 0 0.2 0.8 c 725 1121 m 63 Y -24 -6 d -63 Y f 0 0.4 0.8 c 725
- 1184 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 725 1246 m 62 Y -24 -6 d -62 Y f 0 0.8
- 0.8 c 725 1308 m 60 Y -24 -6 d -60 Y f black 701 1053 m 24 6 d 309 Y -24 -6 d
- cl s 0 0 0.8 c 681 1069 m 20 -16 d 62 Y -20 16 d f 0 0.2 0.8 c 701 1115 m 63 Y
- -20 15 d -62 Y f 0 0.4 0.8 c 701 1178 m 62 Y -20 15 d -62 Y f 0 0.6 0.8 c 701
- 1240 m 62 Y -20 15 d -62 Y f 0 0.8 0.8 c 701 1302 m 60 Y -20 16 d -61 Y f black
- 681 1069 m 20 -16 d 309 Y -20 16 d cl s 0 0.8 0.8 c 701 1362 m 24 6 d -21 16 d
- -23 -6 d f black 701 1362 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 678 1047 m
- 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 701 1115 m 63 Y -23 -6 d -63 Y f 0 0.4 0.8 c
- 701 1178 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c 701 1240 m 62 Y -23 -6 d -62 Y f 0
- 0.8 0.8 c 701 1302 m 62 Y -23 -6 d -62 Y f 0 0.8 0.6 c 701 1364 m 62 Y -23 -6 d
- -62 Y f 0 0.8 0.4 c 701 1426 m 62 Y -23 -6 d -62 Y f 0 0.8 0.2 c 701 1488 m 22
- Y -23 -6 d -22 Y f black 678 1047 m 23 6 d 457 Y -23 -6 d cl s 0 0 0.8 c 657
- 1063 m 21 -16 d 62 Y -21 16 d f 0 0.2 0.8 c 678 1109 m 63 Y -21 15 d -62 Y f 0
- 0.4 0.8 c 678 1172 m 62 Y -21 15 d -62 Y f 0 0.6 0.8 c 678 1234 m 62 Y -21 15 d
- -62 Y f 0 0.8 0.8 c 678 1296 m 62 Y -21 16 d -63 Y f 0 0.8 0.6 c 678 1358 m 62
- Y -21 16 d -62 Y f 0 0.8 0.4 c 678 1420 m 62 Y -21 16 d -62 Y f 0 0.8 0.2 c 678
- 1482 m 22 Y -21 16 d -22 Y f black 657 1063 m 21 -16 d 457 Y -21 16 d cl s 0
- 0.8 0.2 c 678 1504 m 23 6 d -20 16 d -24 -6 d f black 678 1504 m 23 6 d -20 16
- d -24 -6 d cl s 0 0 0.8 c 654 1041 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 678
- 1109 m 63 Y -24 -6 d -63 Y f 0 0.4 0.8 c 678 1172 m 62 Y -24 -6 d -62 Y f 0 0.6
- 0.8 c 678 1234 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 678 1296 m 62 Y -24 -6 d -62
- Y f 0 0.8 0.6 c 678 1358 m 62 Y -24 -6 d -62 Y f 0 0.8 0.4 c 678 1420 m 62 Y
- -24 -6 d -62 Y f 0 0.8 0.2 c 678 1482 m 36 Y -24 -6 d -36 Y f black 654 1041 m
- 24 6 d 471 Y -24 -6 d cl s 0 0 0.8 c 634 1057 m 20 -16 d 62 Y -20 16 d f 0 0.2
- 0.8 c 654 1103 m 63 Y -20 15 d -62 Y f 0 0.4 0.8 c 654 1166 m 62 Y -20 15 d -62
- Y f 0 0.6 0.8 c 654 1228 m 62 Y -20 15 d -62 Y f 0 0.8 0.8 c 654 1290 m 62 Y
- -20 16 d -63 Y f 0 0.8 0.6 c 654 1352 m 62 Y -20 16 d -62 Y f 0 0.8 0.4 c 654
- 1414 m 62 Y -20 16 d -62 Y f 0 0.8 0.2 c 654 1476 m 36 Y -20 15 d -35 Y f black
- 634 1057 m 20 -16 d 471 Y -20 15 d cl s 0 0.8 0.2 c 654 1512 m 24 6 d -21 15 d
- -23 -6 d f black 654 1512 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 631 1035 m
- 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 654 1103 m 63 Y -23 -6 d -63 Y f 0 0.4 0.8 c
- 654 1166 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c 654 1228 m 62 Y -23 -6 d -62 Y f 0
- 0.8 0.8 c 654 1290 m 62 Y -23 -6 d -62 Y f 0 0.8 0.6 c 654 1352 m 62 Y -23 -6 d
- -62 Y f 0 0.8 0.4 c 654 1414 m 57 Y -23 -6 d -57 Y f black 631 1035 m 23 6 d
- 430 Y -23 -6 d cl s 0 0 0.8 c 610 1051 m 21 -16 d 62 Y -21 16 d f 0 0.2 0.8 c
- 631 1097 m 63 Y -21 15 d -62 Y f 0 0.4 0.8 c 631 1160 m 62 Y -21 15 d -62 Y f 0
- 0.6 0.8 c 631 1222 m 62 Y -21 15 d -62 Y f 0 0.8 0.8 c 631 1284 m 62 Y -21 16 d
- -63 Y f 0 0.8 0.6 c 631 1346 m 62 Y -21 16 d -62 Y f 0 0.8 0.4 c 631 1408 m 57
- Y -21 16 d -57 Y f black 610 1051 m 21 -16 d 430 Y -21 16 d cl s 0 0.8 0.4 c
- 631 1465 m 23 6 d -20 16 d -24 -6 d f black 631 1465 m 23 6 d -20 16 d -24 -6 d
- cl s 0 0 0.8 c 607 1029 m 24 6 d 62 Y -24 -5 d f 0 0.2 0.8 c 631 1097 m 63 Y
- -24 -6 d -62 Y f 0 0.4 0.8 c 631 1160 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 631
- 1222 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 631 1284 m 62 Y -24 -6 d -62 Y f 0 0.8
- 0.6 c 631 1346 m 12 Y -24 -6 d -12 Y f black 607 1029 m 24 6 d 323 Y -24 -6 d
- cl s 0 0 0.8 c 587 1045 m 20 -16 d 63 Y -20 15 d f 0 0.2 0.8 c 607 1092 m 62 Y
- -20 15 d -62 Y f 0 0.4 0.8 c 607 1154 m 62 Y -20 15 d -62 Y f 0 0.6 0.8 c 607
- 1216 m 62 Y -20 15 d -62 Y f 0 0.8 0.8 c 607 1278 m 62 Y -20 16 d -63 Y f 0 0.8
- 0.6 c 607 1340 m 12 Y -20 15 d -11 Y f black 587 1045 m 20 -16 d 323 Y -20 15 d
- cl s 0 0.8 0.6 c 607 1352 m 24 6 d -21 15 d -23 -6 d f black 607 1352 m 24 6 d
- -21 15 d -23 -6 d cl s 0 0 0.8 c 584 1023 m 23 6 d 63 Y -23 -6 d f 0 0.2 0.8 c
- 607 1092 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 607 1154 m 62 Y -23 -6 d -62 Y f 0
- 0.6 0.8 c 607 1216 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 607 1278 m 62 Y -23 -6 d
- -62 Y f 0 0.8 0.6 c 607 1340 m 39 Y -23 -6 d -39 Y f black 584 1023 m 23 6 d
- 350 Y -23 -6 d cl s 0 0 0.8 c 564 1039 m 20 -16 d 63 Y -20 15 d f 0 0.2 0.8 c
- 584 1086 m 62 Y -20 15 d -62 Y f 0 0.4 0.8 c 584 1148 m 62 Y -20 15 d -62 Y f 0
- 0.6 0.8 c 584 1210 m 62 Y -20 15 d -62 Y f 0 0.8 0.8 c 584 1272 m 62 Y -20 16 d
- -63 Y f 0 0.8 0.6 c 584 1334 m 39 Y -20 15 d -38 Y f black 564 1039 m 20 -16 d
- 350 Y -20 15 d cl s 0 0.8 0.6 c 584 1373 m 23 6 d -20 15 d -23 -6 d f black 584
- 1373 m 23 6 d -20 15 d -23 -6 d cl s 0 0 0.8 c 560 1017 m 24 6 d 63 Y -24 -6 d
- f 0 0.2 0.8 c 584 1086 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 584 1148 m 62 Y -24
- -6 d -62 Y f 0 0.6 0.8 c 584 1210 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 584 1272
- m 47 Y -24 -6 d -47 Y f black 560 1017 m 24 6 d 296 Y -24 -6 d cl s 0 0 0.8 c
- 540 1033 m 20 -16 d 63 Y -20 15 d f 0 0.2 0.8 c 560 1080 m 62 Y -20 15 d -62 Y
- f 0 0.4 0.8 c 560 1142 m 62 Y -20 15 d -62 Y f 0 0.6 0.8 c 560 1204 m 62 Y -20
- 16 d -63 Y f 0 0.8 0.8 c 560 1266 m 47 Y -20 16 d -47 Y f black 540 1033 m 20
- -16 d 296 Y -20 16 d cl s 0 0.8 0.8 c 560 1313 m 24 6 d -20 16 d -24 -6 d f
- black 560 1313 m 24 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 537 1011 m 23 6 d -20
- 16 d -23 -6 d f black 537 1011 m 23 6 d -20 16 d -23 -6 d cl s 0 0 0.8 c 513
- 1005 m 24 6 d -20 16 d -24 -6 d f black 513 1005 m 24 6 d -20 16 d -24 -6 d
- cl s 0 0 0.8 c 490 999 m 23 6 d -20 16 d -23 -6 d f black 490 999 m 23 6 d -20
- 16 d -23 -6 d cl s 0 0 0.8 c 466 993 m 24 6 d -20 16 d -24 -6 d f black 466 993
- m 24 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1591 1259 m 23 6 d -20 16 d -24 -6 d
- f black 1591 1259 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1567 1253 m 24 6 d
- -21 16 d -23 -6 d f black 1567 1253 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c
- 1544 1247 m 23 6 d -20 16 d -24 -6 d f black 1544 1247 m 23 6 d -20 16 d -24 -6
- d cl s 0 0 0.8 c 1520 1241 m 24 6 d -21 16 d -23 -6 d f black 1520 1241 m 24 6
- d -21 16 d -23 -6 d cl s 0 0 0.8 c 1497 1235 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8
- c 1520 1303 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 1520 1365 m 62 Y -23 -5 d -63 Y
- f 0 0.6 0.8 c 1520 1427 m 63 Y -23 -6 d -62 Y f 0 0.8 0.8 c 1520 1490 m 62 Y
- -23 -6 d -62 Y f 0 0.8 0.6 c 1520 1552 m 62 Y -23 -6 d -62 Y f 0 0.8 0.4 c 1520
- 1614 m 62 Y -23 -6 d -62 Y f 0 0.8 0.2 c 1520 1676 m 62 Y -23 -6 d -62 Y f 0
- 0.8 0 c 1520 1738 m 14 Y -23 -6 d -14 Y f black 1497 1235 m 23 6 d 511 Y -23 -6
- d cl s 0 0 0.8 c 1476 1251 m 21 -16 d 62 Y -21 16 d f 0 0.2 0.8 c 1497 1297 m
- 62 Y -21 16 d -62 Y f 0 0.4 0.8 c 1497 1359 m 63 Y -21 15 d -62 Y f 0 0.6 0.8 c
- 1497 1422 m 62 Y -21 15 d -62 Y f 0 0.8 0.8 c 1497 1484 m 62 Y -21 15 d -62 Y f
- 0 0.8 0.6 c 1497 1546 m 62 Y -21 15 d -62 Y f 0 0.8 0.4 c 1497 1608 m 62 Y -21
- 16 d -63 Y f 0 0.8 0.2 c 1497 1670 m 62 Y -21 16 d -62 Y f 0 0.8 0 c 1497 1732
- m 14 Y -21 15 d -13 Y f black 1476 1251 m 21 -16 d 511 Y -21 15 d cl s 0 0.8 0
- c 1497 1746 m 23 6 d -20 15 d -24 -6 d f black 1497 1746 m 23 6 d -20 15 d -24
- -6 d cl s 0 0 0.8 c 1473 1229 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1497 1297 m
- 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 1497 1359 m 63 Y -24 -6 d -63 Y f 0 0.6 0.8 c
- 1497 1422 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 1497 1484 m 62 Y -24 -6 d -62 Y f
- 0 0.8 0.6 c 1497 1546 m 62 Y -24 -6 d -62 Y f 0 0.8 0.4 c 1497 1608 m 62 Y -24
- -6 d -62 Y f 0 0.8 0.2 c 1497 1670 m 62 Y -24 -6 d -62 Y f 0 0.8 0 c 1497 1732
- m 14 Y -24 -6 d -14 Y f black 1473 1229 m 24 6 d 511 Y -24 -6 d cl s 0 0 0.8 c
- 1453 1245 m 20 -16 d 62 Y -20 16 d f 0 0.2 0.8 c 1473 1291 m 62 Y -20 16 d -62
- Y f 0 0.4 0.8 c 1473 1353 m 63 Y -20 15 d -62 Y f 0 0.6 0.8 c 1473 1416 m 62 Y
- -20 15 d -62 Y f 0 0.8 0.8 c 1473 1478 m 62 Y -20 15 d -62 Y f 0 0.8 0.6 c 1473
- 1540 m 62 Y -20 15 d -62 Y f 0 0.8 0.4 c 1473 1602 m 62 Y -20 16 d -63 Y f 0
- 0.8 0.2 c 1473 1664 m 62 Y -20 16 d -62 Y f 0 0.8 0 c 1473 1726 m 14 Y -20 15 d
- -13 Y f black 1453 1245 m 20 -16 d 511 Y -20 15 d cl s 0 0.8 0 c 1473 1740 m 24
- 6 d -21 15 d -23 -6 d f black 1473 1740 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8
- c 1450 1223 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 1473 1291 m 62 Y -23 -6 d -62
- Y f 0 0.4 0.8 c 1473 1353 m 63 Y -23 -6 d -63 Y f 0 0.6 0.8 c 1473 1416 m 62 Y
- -23 -6 d -62 Y f 0 0.8 0.8 c 1473 1478 m 62 Y -23 -6 d -62 Y f 0 0.8 0.6 c 1473
- 1540 m 62 Y -23 -6 d -62 Y f 0 0.8 0.4 c 1473 1602 m 62 Y -23 -6 d -62 Y f 0
- 0.8 0.2 c 1473 1664 m 62 Y -23 -6 d -62 Y f 0 0.8 0 c 1473 1726 m 62 Y -23 -6 d
- -62 Y f 0.2 0.8 0 c 1473 1788 m 63 Y -23 -6 d -63 Y f 0.4 0.8 0 c 1473 1851 m
- 10 Y -23 -6 d -10 Y f black 1450 1223 m 23 6 d 632 Y -23 -6 d cl s 0 0 0.8 c
- 1429 1239 m 21 -16 d 62 Y -21 16 d f 0 0.2 0.8 c 1450 1285 m 62 Y -21 16 d -62
- Y f 0 0.4 0.8 c 1450 1347 m 63 Y -21 15 d -62 Y f 0 0.6 0.8 c 1450 1410 m 62 Y
- -21 15 d -62 Y f 0 0.8 0.8 c 1450 1472 m 62 Y -21 15 d -62 Y f 0 0.8 0.6 c 1450
- 1534 m 62 Y -21 16 d -63 Y f 0 0.8 0.4 c 1450 1596 m 62 Y -21 16 d -62 Y f 0
- 0.8 0.2 c 1450 1658 m 62 Y -21 16 d -62 Y f 0 0.8 0 c 1450 1720 m 62 Y -21 16 d
- -62 Y f 0.2 0.8 0 c 1450 1782 m 63 Y -21 15 d -62 Y f 0.4 0.8 0 c 1450 1845 m
- 10 Y -21 15 d -10 Y f black 1429 1239 m 21 -16 d 632 Y -21 15 d cl s 0.4 0.8 0
- c 1450 1855 m 23 6 d -20 15 d -24 -6 d f black 1450 1855 m 23 6 d -20 15 d -24
- -6 d cl s 0 0 0.8 c 1426 1217 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1450 1285 m
- 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 1450 1347 m 63 Y -24 -6 d -63 Y f 0 0.6 0.8 c
- 1450 1410 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 1450 1472 m 62 Y -24 -6 d -62 Y f
- 0 0.8 0.6 c 1450 1534 m 62 Y -24 -6 d -62 Y f 0 0.8 0.4 c 1450 1596 m 62 Y -24
- -6 d -62 Y f 0 0.8 0.2 c 1450 1658 m 22 Y -24 -6 d -22 Y f black 1426 1217 m 24
- 6 d 457 Y -24 -6 d cl s 0 0 0.8 c 1406 1233 m 20 -16 d 62 Y -20 16 d f 0 0.2
- 0.8 c 1426 1279 m 62 Y -20 16 d -62 Y f 0 0.4 0.8 c 1426 1341 m 63 Y -20 15 d
- -62 Y f 0 0.6 0.8 c 1426 1404 m 62 Y -20 15 d -62 Y f 0 0.8 0.8 c 1426 1466 m
- 62 Y -20 15 d -62 Y f 0 0.8 0.6 c 1426 1528 m 62 Y -20 16 d -63 Y f 0 0.8 0.4 c
- 1426 1590 m 62 Y -20 16 d -62 Y f 0 0.8 0.2 c 1426 1652 m 22 Y -20 16 d -22 Y f
- black 1406 1233 m 20 -16 d 457 Y -20 16 d cl s 0 0.8 0.2 c 1426 1674 m 24 6 d
- -21 15 d -23 -5 d f black 1426 1674 m 24 6 d -21 15 d -23 -5 d cl s 0 0 0.8 c
- 1403 1211 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 1426 1279 m 62 Y -23 -6 d -62 Y
- f 0 0.4 0.8 c 1426 1341 m 63 Y -23 -6 d -63 Y f 0 0.6 0.8 c 1426 1404 m 62 Y
- -23 -6 d -62 Y f 0 0.8 0.8 c 1426 1466 m 62 Y -23 -6 d -62 Y f 0 0.8 0.6 c 1426
- 1528 m 62 Y -23 -6 d -62 Y f 0 0.8 0.4 c 1426 1590 m 17 Y -23 -6 d -17 Y f
- black 1403 1211 m 23 6 d 390 Y -23 -6 d cl s 0 0 0.8 c 1382 1227 m 21 -16 d 62
- Y -21 16 d f 0 0.2 0.8 c 1403 1273 m 62 Y -21 16 d -62 Y f 0 0.4 0.8 c 1403
- 1335 m 63 Y -21 15 d -62 Y f 0 0.6 0.8 c 1403 1398 m 62 Y -21 15 d -62 Y f 0
- 0.8 0.8 c 1403 1460 m 62 Y -21 15 d -62 Y f 0 0.8 0.6 c 1403 1522 m 62 Y -21 16
- d -63 Y f 0 0.8 0.4 c 1403 1584 m 17 Y -21 15 d -16 Y f black 1382 1227 m 21
- -16 d 390 Y -21 15 d cl s 0 0.8 0.4 c 1403 1601 m 23 6 d -20 15 d -24 -6 d f
- black 1403 1601 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1379 1205 m 24 6 d 62
- Y -24 -6 d f 0 0.2 0.8 c 1403 1273 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 1403
- 1335 m 63 Y -24 -6 d -63 Y f 0 0.6 0.8 c 1403 1398 m 62 Y -24 -6 d -62 Y f 0
- 0.8 0.8 c 1403 1460 m 62 Y -24 -6 d -62 Y f 0 0.8 0.6 c 1403 1522 m 62 Y -24 -6
- d -62 Y f 0 0.8 0.4 c 1403 1584 m 62 Y -24 -6 d -62 Y f 0 0.8 0.2 c 1403 1646 m
- 49 Y -24 -6 d -49 Y f black 1379 1205 m 24 6 d 484 Y -24 -6 d cl s 0 0 0.8 c
- 1359 1221 m 20 -16 d 62 Y -20 16 d f 0 0.2 0.8 c 1379 1267 m 62 Y -20 16 d -62
- Y f 0 0.4 0.8 c 1379 1329 m 63 Y -20 15 d -62 Y f 0 0.6 0.8 c 1379 1392 m 62 Y
- -20 15 d -62 Y f 0 0.8 0.8 c 1379 1454 m 62 Y -20 15 d -62 Y f 0 0.8 0.6 c 1379
- 1516 m 62 Y -20 16 d -63 Y f 0 0.8 0.4 c 1379 1578 m 62 Y -20 16 d -62 Y f 0
- 0.8 0.2 c 1379 1640 m 49 Y -20 15 d -48 Y f black 1359 1221 m 20 -16 d 484 Y
- -20 15 d cl s 0 0.8 0.2 c 1379 1689 m 24 6 d -21 15 d -23 -6 d f black 1379
- 1689 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 1356 1199 m 23 6 d 62 Y -23 -6 d
- f 0 0.2 0.8 c 1379 1267 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 1379 1329 m 63 Y
- -23 -6 d -63 Y f 0 0.6 0.8 c 1379 1392 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 1379
- 1454 m 62 Y -23 -6 d -62 Y f 0 0.8 0.6 c 1379 1516 m 62 Y -23 -6 d -62 Y f 0
- 0.8 0.4 c 1379 1578 m 62 Y -23 -6 d -62 Y f 0 0.8 0.2 c 1379 1640 m 62 Y -23 -6
- d -62 Y f 0 0.8 0 c 1379 1702 m 62 Y -23 -6 d -62 Y f 0.2 0.8 0 c 1379 1764 m 6
- Y -23 -6 d -6 Y f black 1356 1199 m 23 6 d 565 Y -23 -6 d cl s 0 0 0.8 c 1335
- 1215 m 21 -16 d 62 Y -21 16 d f 0 0.2 0.8 c 1356 1261 m 62 Y -21 16 d -62 Y f 0
- 0.4 0.8 c 1356 1323 m 63 Y -21 15 d -62 Y f 0 0.6 0.8 c 1356 1386 m 62 Y -21 15
- d -62 Y f 0 0.8 0.8 c 1356 1448 m 62 Y -21 15 d -62 Y f 0 0.8 0.6 c 1356 1510 m
- 62 Y -21 16 d -63 Y f 0 0.8 0.4 c 1356 1572 m 62 Y -21 16 d -62 Y f 0 0.8 0.2 c
- 1356 1634 m 62 Y -21 16 d -62 Y f 0 0.8 0 c 1356 1696 m 62 Y -21 16 d -62 Y f
- 0.2 0.8 0 c 1356 1758 m 6 Y -21 15 d -5 Y f black 1335 1215 m 21 -16 d 565 Y
- -21 15 d cl s 0.2 0.8 0 c 1356 1764 m 23 6 d -20 15 d -24 -6 d f black 1356
- 1764 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1332 1193 m 24 6 d 62 Y -24 -6 d
- f 0 0.2 0.8 c 1356 1261 m 62 Y -24 -5 d -63 Y f 0 0.4 0.8 c 1356 1323 m 63 Y
- -24 -6 d -62 Y f 0 0.6 0.8 c 1356 1386 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 1356
- 1448 m 62 Y -24 -6 d -62 Y f 0 0.8 0.6 c 1356 1510 m 62 Y -24 -6 d -62 Y f 0
- 0.8 0.4 c 1356 1572 m 62 Y -24 -6 d -62 Y f 0 0.8 0.2 c 1356 1634 m 49 Y -24 -6
- d -49 Y f black 1332 1193 m 24 6 d 484 Y -24 -6 d cl s 0 0 0.8 c 1312 1209 m 20
- -16 d 62 Y -20 16 d f 0 0.2 0.8 c 1332 1255 m 63 Y -20 15 d -62 Y f 0 0.4 0.8 c
- 1332 1318 m 62 Y -20 15 d -62 Y f 0 0.6 0.8 c 1332 1380 m 62 Y -20 15 d -62 Y f
- 0 0.8 0.8 c 1332 1442 m 62 Y -20 15 d -62 Y f 0 0.8 0.6 c 1332 1504 m 62 Y -20
- 16 d -63 Y f 0 0.8 0.4 c 1332 1566 m 62 Y -20 16 d -62 Y f 0 0.8 0.2 c 1332
- 1628 m 49 Y -20 15 d -48 Y f black 1312 1209 m 20 -16 d 484 Y -20 15 d cl s 0
- 0.8 0.2 c 1332 1677 m 24 6 d -21 15 d -23 -6 d f black 1332 1677 m 24 6 d -21
- 15 d -23 -6 d cl s 0 0 0.8 c 1309 1187 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c
- 1332 1255 m 63 Y -23 -6 d -63 Y f 0 0.4 0.8 c 1332 1318 m 62 Y -23 -6 d -62 Y f
- 0 0.6 0.8 c 1332 1380 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 1332 1442 m 62 Y -23
- -6 d -62 Y f 0 0.8 0.6 c 1332 1504 m 62 Y -23 -6 d -62 Y f 0 0.8 0.4 c 1332
- 1566 m 62 Y -23 -6 d -62 Y f 0 0.8 0.2 c 1332 1628 m 62 Y -23 -6 d -62 Y f
- black 1309 1187 m 23 6 d 497 Y -23 -6 d cl s 0 0 0.8 c 1289 1203 m 20 -16 d 62
- Y -20 16 d f 0 0.2 0.8 c 1309 1249 m 63 Y -20 15 d -62 Y f 0 0.4 0.8 c 1309
- 1312 m 62 Y -20 15 d -62 Y f 0 0.6 0.8 c 1309 1374 m 62 Y -20 15 d -62 Y f 0
- 0.8 0.8 c 1309 1436 m 62 Y -20 15 d -62 Y f 0 0.8 0.6 c 1309 1498 m 62 Y -20 16
- d -63 Y f 0 0.8 0.4 c 1309 1560 m 62 Y -20 16 d -62 Y f 0 0.8 0.2 c 1309 1622 m
- 62 Y -20 16 d -62 Y f black 1289 1203 m 20 -16 d 497 Y -20 16 d cl s 0 0.8 0.2
- c 1309 1684 m 23 6 d -20 16 d -23 -6 d f 0 0.8 0 c 1309 1684 m 23 6 d -20 16 d
- -23 -6 d f black 1309 1684 m 23 6 d -20 16 d -23 -6 d cl s 0 0 0.8 c 1285 1181
- m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1309 1249 m 63 Y -24 -6 d -63 Y f 0 0.4
- 0.8 c 1309 1312 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 1309 1374 m 62 Y -24 -6 d
- -62 Y f 0 0.8 0.8 c 1309 1436 m 62 Y -24 -6 d -62 Y f 0 0.8 0.6 c 1309 1498 m
- 62 Y -24 -6 d -62 Y f 0 0.8 0.4 c 1309 1560 m 62 Y -24 -6 d -62 Y f 0 0.8 0.2 c
- 1309 1622 m 62 Y -24 -6 d -62 Y f 0 0.8 0 c 1309 1684 m 27 Y -24 -6 d -27 Y f
- black 1285 1181 m 24 6 d 524 Y -24 -6 d cl s 0 0 0.8 c 1265 1197 m 20 -16 d 62
- Y -20 16 d f 0 0.2 0.8 c 1285 1243 m 63 Y -20 15 d -62 Y f 0 0.4 0.8 c 1285
- 1306 m 62 Y -20 15 d -62 Y f 0 0.6 0.8 c 1285 1368 m 62 Y -20 15 d -62 Y f 0
- 0.8 0.8 c 1285 1430 m 62 Y -20 16 d -63 Y f 0 0.8 0.6 c 1285 1492 m 62 Y -20 16
- d -62 Y f 0 0.8 0.4 c 1285 1554 m 62 Y -20 16 d -62 Y f 0 0.8 0.2 c 1285 1616 m
- 62 Y -20 16 d -62 Y f 0 0.8 0 c 1285 1678 m 27 Y -20 16 d -27 Y f black 1265
- 1197 m 20 -16 d 524 Y -20 16 d cl s 0 0.8 0 c 1285 1705 m 24 6 d -20 16 d -24
- -6 d f black 1285 1705 m 24 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1262 1175 m 23
- 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 1285 1243 m 63 Y -23 -6 d -63 Y f 0 0.4 0.8 c
- 1285 1306 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c 1285 1368 m 62 Y -23 -6 d -62 Y f
- 0 0.8 0.8 c 1285 1430 m 62 Y -23 -6 d -62 Y f 0 0.8 0.6 c 1285 1492 m 62 Y -23
- -6 d -62 Y f 0 0.8 0.4 c 1285 1554 m 57 Y -23 -6 d -57 Y f black 1262 1175 m 23
- 6 d 430 Y -23 -6 d cl s 0 0 0.8 c 1242 1191 m 20 -16 d 62 Y -20 16 d f 0 0.2
- 0.8 c 1262 1237 m 63 Y -20 15 d -62 Y f 0 0.4 0.8 c 1262 1300 m 62 Y -20 15 d
- -62 Y f 0 0.6 0.8 c 1262 1362 m 62 Y -20 15 d -62 Y f 0 0.8 0.8 c 1262 1424 m
- 62 Y -20 16 d -63 Y f 0 0.8 0.6 c 1262 1486 m 62 Y -20 16 d -62 Y f 0 0.8 0.4 c
- 1262 1548 m 57 Y -20 16 d -57 Y f black 1242 1191 m 20 -16 d 430 Y -20 16 d
- cl s 0 0.8 0.4 c 1262 1605 m 23 6 d -20 16 d -23 -6 d f black 1262 1605 m 23 6
- d -20 16 d -23 -6 d cl s 0 0 0.8 c 1238 1169 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8
- c 1262 1237 m 63 Y -24 -6 d -63 Y f 0 0.4 0.8 c 1262 1300 m 62 Y -24 -6 d -62 Y
- f 0 0.6 0.8 c 1262 1362 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 1262 1424 m 62 Y
- -24 -6 d -62 Y f 0 0.8 0.6 c 1262 1486 m 62 Y -24 -6 d -62 Y f 0 0.8 0.4 c 1262
- 1548 m 62 Y -24 -6 d -62 Y f 0 0.8 0.2 c 1262 1610 m 62 Y -24 -6 d -62 Y f 0
- 0.8 0 c 1262 1672 m 27 Y -24 -6 d -27 Y f black 1238 1169 m 24 6 d 524 Y -24 -6
- d cl s 0 0 0.8 c 1218 1185 m 20 -16 d 62 Y -20 16 d f 0 0.2 0.8 c 1238 1231 m
- 63 Y -20 15 d -62 Y f 0 0.4 0.8 c 1238 1294 m 62 Y -20 15 d -62 Y f 0 0.6 0.8 c
- 1238 1356 m 62 Y -20 15 d -62 Y f 0 0.8 0.8 c 1238 1418 m 62 Y -20 16 d -63 Y f
- 0 0.8 0.6 c 1238 1480 m 62 Y -20 16 d -62 Y f 0 0.8 0.4 c 1238 1542 m 62 Y -20
- 16 d -62 Y f 0 0.8 0.2 c 1238 1604 m 62 Y -20 16 d -62 Y f 0 0.8 0 c 1238 1666
- m 27 Y -20 16 d -27 Y f black 1218 1185 m 20 -16 d 524 Y -20 16 d cl s 0 0.8 0
- c 1238 1693 m 24 6 d -20 16 d -24 -6 d f black 1238 1693 m 24 6 d -20 16 d -24
- -6 d cl s 0 0 0.8 c 1215 1163 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 1238 1231 m
- 63 Y -23 -6 d -63 Y f 0 0.4 0.8 c 1238 1294 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c
- 1238 1356 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 1238 1418 m 62 Y -23 -6 d -62 Y f
- 0 0.8 0.6 c 1238 1480 m 62 Y -23 -6 d -62 Y f 0 0.8 0.4 c 1238 1542 m 30 Y -23
- -6 d -30 Y f black 1215 1163 m 23 6 d 403 Y -23 -6 d cl s 0 0 0.8 c 1195 1179 m
- 20 -16 d 62 Y -20 16 d f 0 0.2 0.8 c 1215 1225 m 63 Y -20 15 d -62 Y f 0 0.4
- 0.8 c 1215 1288 m 62 Y -20 15 d -62 Y f 0 0.6 0.8 c 1215 1350 m 62 Y -20 15 d
- -62 Y f 0 0.8 0.8 c 1215 1412 m 62 Y -20 16 d -63 Y f 0 0.8 0.6 c 1215 1474 m
- 62 Y -20 16 d -62 Y f 0 0.8 0.4 c 1215 1536 m 30 Y -20 16 d -30 Y f black 1195
- 1179 m 20 -16 d 403 Y -20 16 d cl s 0 0.8 0.4 c 1215 1566 m 23 6 d -20 16 d -23
- -6 d f black 1215 1566 m 23 6 d -20 16 d -23 -6 d cl s 0 0 0.8 c 1191 1157 m 24
- 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1215 1225 m 63 Y -24 -6 d -63 Y f 0 0.4 0.8 c
- 1215 1288 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 1215 1350 m 62 Y -24 -6 d -62 Y f
- 0 0.8 0.8 c 1215 1412 m 62 Y -24 -6 d -62 Y f 0 0.8 0.6 c 1215 1474 m 62 Y -24
- -6 d -62 Y f 0 0.8 0.4 c 1215 1536 m 57 Y -24 -6 d -57 Y f black 1191 1157 m 24
- 6 d 430 Y -24 -6 d cl s 0 0 0.8 c 1171 1173 m 20 -16 d 62 Y -20 16 d f 0 0.2
- 0.8 c 1191 1219 m 63 Y -20 15 d -62 Y f 0 0.4 0.8 c 1191 1282 m 62 Y -20 15 d
- -62 Y f 0 0.6 0.8 c 1191 1344 m 62 Y -20 15 d -62 Y f 0 0.8 0.8 c 1191 1406 m
- 62 Y -20 16 d -63 Y f 0 0.8 0.6 c 1191 1468 m 62 Y -20 16 d -62 Y f 0 0.8 0.4 c
- 1191 1530 m 57 Y -20 16 d -57 Y f black 1171 1173 m 20 -16 d 430 Y -20 16 d
- cl s 0 0.8 0.4 c 1191 1587 m 24 6 d -20 16 d -24 -6 d f black 1191 1587 m 24 6
- d -20 16 d -24 -6 d cl s 0 0 0.8 c 1168 1151 m 23 6 d 62 Y -23 -5 d f 0 0.2 0.8
- c 1191 1219 m 63 Y -23 -6 d -62 Y f 0 0.4 0.8 c 1191 1282 m 62 Y -23 -6 d -62 Y
- f 0 0.6 0.8 c 1191 1344 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 1191 1406 m 62 Y
- -23 -6 d -62 Y f 0 0.8 0.6 c 1191 1468 m 62 Y -23 -6 d -62 Y f 0 0.8 0.4 c 1191
- 1530 m 62 Y -23 -6 d -62 Y f 0 0.8 0.2 c 1191 1592 m 62 Y -23 -5 d -63 Y f 0
- 0.8 0 c 1191 1654 m 63 Y -23 -6 d -62 Y f 0.2 0.8 0 c 1191 1717 m 18 Y -23 -6 d
- -18 Y f black 1168 1151 m 23 6 d 578 Y -23 -6 d cl s 0 0 0.8 c 1148 1167 m 20
- -16 d 63 Y -20 15 d f 0 0.2 0.8 c 1168 1214 m 62 Y -20 15 d -62 Y f 0 0.4 0.8 c
- 1168 1276 m 62 Y -20 15 d -62 Y f 0 0.6 0.8 c 1168 1338 m 62 Y -20 15 d -62 Y f
- 0 0.8 0.8 c 1168 1400 m 62 Y -20 16 d -63 Y f 0 0.8 0.6 c 1168 1462 m 62 Y -20
- 16 d -62 Y f 0 0.8 0.4 c 1168 1524 m 62 Y -20 16 d -62 Y f 0 0.8 0.2 c 1168
- 1586 m 63 Y -20 15 d -62 Y f 0 0.8 0 c 1168 1649 m 62 Y -20 15 d -62 Y f 0.2
- 0.8 0 c 1168 1711 m 18 Y -20 16 d -19 Y f black 1148 1167 m 20 -16 d 578 Y -20
- 16 d cl s 0.2 0.8 0 c 1168 1729 m 23 6 d -20 16 d -23 -6 d f black 1168 1729 m
- 23 6 d -20 16 d -23 -6 d cl s 0 0 0.8 c 1144 1145 m 24 6 d 63 Y -24 -6 d f 0
- 0.2 0.8 c 1168 1214 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 1168 1276 m 62 Y -24 -6
- d -62 Y f 0 0.6 0.8 c 1168 1338 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 1168 1400 m
- 62 Y -24 -6 d -62 Y f 0 0.8 0.6 c 1168 1462 m 62 Y -24 -6 d -62 Y f 0 0.8 0.4 c
- 1168 1524 m 4 Y -24 -6 d -4 Y f black 1144 1145 m 24 6 d 377 Y -24 -6 d cl s 0
- 0 0.8 c 1124 1161 m 20 -16 d 63 Y -20 15 d f 0 0.2 0.8 c 1144 1208 m 62 Y -20
- 15 d -62 Y f 0 0.4 0.8 c 1144 1270 m 62 Y -20 15 d -62 Y f 0 0.6 0.8 c 1144
- 1332 m 62 Y -20 15 d -62 Y f 0 0.8 0.8 c 1144 1394 m 62 Y -20 16 d -63 Y f 0
- 0.8 0.6 c 1144 1456 m 62 Y -20 16 d -62 Y f 0 0.8 0.4 c 1144 1518 m 4 Y -20 15
- d -3 Y f black 1124 1161 m 20 -16 d 377 Y -20 15 d cl s 0 0.8 0.4 c 1144 1522 m
- 24 6 d -20 15 d -24 -6 d f black 1144 1522 m 24 6 d -20 15 d -24 -6 d cl s 0 0
- 0.8 c 1121 1139 m 23 6 d 63 Y -23 -6 d f 0 0.2 0.8 c 1144 1208 m 62 Y -23 -6 d
- -62 Y f 0 0.4 0.8 c 1144 1270 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c 1144 1332 m
- 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 1144 1394 m 62 Y -23 -6 d -62 Y f 0 0.8 0.6 c
- 1144 1456 m 62 Y -23 -6 d -62 Y f 0 0.8 0.4 c 1144 1518 m 62 Y -23 -6 d -62 Y f
- 0 0.8 0.2 c 1144 1580 m 63 Y -23 -6 d -63 Y f black 1121 1139 m 23 6 d 498 Y
- -23 -6 d cl s 0 0 0.8 c 1101 1155 m 20 -16 d 63 Y -20 15 d f 0 0.2 0.8 c 1121
- 1202 m 62 Y -20 15 d -62 Y f 0 0.4 0.8 c 1121 1264 m 62 Y -20 15 d -62 Y f 0
- 0.6 0.8 c 1121 1326 m 62 Y -20 16 d -63 Y f 0 0.8 0.8 c 1121 1388 m 62 Y -20 16
- d -62 Y f 0 0.8 0.6 c 1121 1450 m 62 Y -20 16 d -62 Y f 0 0.8 0.4 c 1121 1512 m
- 62 Y -20 16 d -62 Y f 0 0.8 0.2 c 1121 1574 m 63 Y -20 15 d -62 Y f black 1101
- 1155 m 20 -16 d 498 Y -20 15 d cl s 0 0.8 0.2 c 1121 1637 m 23 6 d -20 15 d -23
- -6 d f 0 0.8 0 c 1121 1637 m 23 6 d -20 15 d -23 -6 d f black 1121 1637 m 23 6
- d -20 15 d -23 -6 d cl s 0 0 0.8 c 1097 1133 m 24 6 d 63 Y -24 -6 d f 0 0.2 0.8
- c 1121 1202 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 1121 1264 m 62 Y -24 -6 d -62 Y
- f 0 0.6 0.8 c 1121 1326 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 1121 1388 m 62 Y
- -24 -6 d -62 Y f 0 0.8 0.6 c 1121 1450 m 62 Y -24 -6 d -62 Y f 0 0.8 0.4 c 1121
- 1512 m 30 Y -24 -5 d -31 Y f black 1097 1133 m 24 6 d 403 Y -24 -5 d cl s 0 0
- 0.8 c 1077 1149 m 20 -16 d 63 Y -20 15 d f 0 0.2 0.8 c 1097 1196 m 62 Y -20 15
- d -62 Y f 0 0.4 0.8 c 1097 1258 m 62 Y -20 15 d -62 Y f 0 0.6 0.8 c 1097 1320 m
- 62 Y -20 16 d -63 Y f 0 0.8 0.8 c 1097 1382 m 62 Y -20 16 d -62 Y f 0 0.8 0.6 c
- 1097 1444 m 62 Y -20 16 d -62 Y f 0 0.8 0.4 c 1097 1506 m 31 Y -20 15 d -30 Y f
- black 1077 1149 m 20 -16 d 404 Y -20 15 d cl s 0 0.8 0.4 c 1097 1537 m 24 5 d
- -20 16 d -24 -6 d f black 1097 1537 m 24 5 d -20 16 d -24 -6 d cl s 0 0 0.8 c
- 1074 1127 m 23 6 d 63 Y -23 -6 d f 0 0.2 0.8 c 1097 1196 m 62 Y -23 -6 d -62 Y
- f 0 0.4 0.8 c 1097 1258 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c 1097 1320 m 62 Y
- -23 -6 d -62 Y f 0 0.8 0.8 c 1097 1382 m 62 Y -23 -6 d -62 Y f 0 0.8 0.6 c 1097
- 1444 m 62 Y -23 -6 d -62 Y f 0 0.8 0.4 c 1097 1506 m 62 Y -23 -6 d -62 Y f 0
- 0.8 0.2 c 1097 1568 m 63 Y -23 -6 d -63 Y f 0 0.8 0 c 1097 1631 m 62 Y -23 -6 d
- -62 Y f 0.2 0.8 0 c 1097 1693 m 58 Y -23 -5 d -59 Y f black 1074 1127 m 23 6 d
- 618 Y -23 -5 d cl s 0 0 0.8 c 1054 1143 m 20 -16 d 63 Y -20 15 d f 0 0.2 0.8 c
- 1074 1190 m 62 Y -20 15 d -62 Y f 0 0.4 0.8 c 1074 1252 m 62 Y -20 15 d -62 Y f
- 0 0.6 0.8 c 1074 1314 m 62 Y -20 16 d -63 Y f 0 0.8 0.8 c 1074 1376 m 62 Y -20
- 16 d -62 Y f 0 0.8 0.6 c 1074 1438 m 62 Y -20 16 d -62 Y f 0 0.8 0.4 c 1074
- 1500 m 62 Y -20 16 d -62 Y f 0 0.8 0.2 c 1074 1562 m 63 Y -20 15 d -62 Y f 0
- 0.8 0 c 1074 1625 m 62 Y -20 15 d -62 Y f 0.2 0.8 0 c 1074 1687 m 59 Y -20 15 d
- -59 Y f black 1054 1143 m 20 -16 d 619 Y -20 15 d cl s 0.2 0.8 0 c 1074 1746 m
- 23 5 d -20 16 d -23 -6 d f black 1074 1746 m 23 5 d -20 16 d -23 -6 d cl s 0 0
- 0.8 c 1050 1121 m 24 6 d 63 Y -24 -6 d f 0 0.2 0.8 c 1074 1190 m 62 Y -24 -6 d
- -62 Y f 0 0.4 0.8 c 1074 1252 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 1074 1314 m
- 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 1074 1376 m 62 Y -24 -6 d -62 Y f 0 0.8 0.6 c
- 1074 1438 m 62 Y -24 -6 d -62 Y f 0 0.8 0.4 c 1074 1500 m 62 Y -24 -6 d -62 Y f
- 0 0.8 0.2 c 1074 1562 m 36 Y -24 -6 d -36 Y f black 1050 1121 m 24 6 d 471 Y
- -24 -6 d cl s 0 0 0.8 c 1030 1137 m 20 -16 d 63 Y -20 15 d f 0 0.2 0.8 c 1050
- 1184 m 62 Y -20 15 d -62 Y f 0 0.4 0.8 c 1050 1246 m 62 Y -20 15 d -62 Y f 0
- 0.6 0.8 c 1050 1308 m 62 Y -20 16 d -63 Y f 0 0.8 0.8 c 1050 1370 m 62 Y -20 16
- d -62 Y f 0 0.8 0.6 c 1050 1432 m 62 Y -20 16 d -62 Y f 0 0.8 0.4 c 1050 1494 m
- 62 Y -20 16 d -62 Y f 0 0.8 0.2 c 1050 1556 m 36 Y -20 15 d -35 Y f black 1030
- 1137 m 20 -16 d 471 Y -20 15 d cl s 0 0.8 0.2 c 1050 1592 m 24 6 d -20 15 d -24
- -6 d f black 1050 1592 m 24 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1027 1115 m 23
- 6 d 63 Y -23 -6 d f 0 0.2 0.8 c 1050 1184 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c
- 1050 1246 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c 1050 1308 m 62 Y -23 -6 d -62 Y f
- 0 0.8 0.8 c 1050 1370 m 62 Y -23 -6 d -62 Y f 0 0.8 0.6 c 1050 1432 m 62 Y -23
- -6 d -62 Y f 0 0.8 0.4 c 1050 1494 m 44 Y -23 -6 d -44 Y f black 1027 1115 m 23
- 6 d 417 Y -23 -6 d cl s 0 0 0.8 c 1007 1131 m 20 -16 d 63 Y -20 15 d f 0 0.2
- 0.8 c 1027 1178 m 62 Y -20 15 d -62 Y f 0 0.4 0.8 c 1027 1240 m 62 Y -20 15 d
- -62 Y f 0 0.6 0.8 c 1027 1302 m 62 Y -20 16 d -63 Y f 0 0.8 0.8 c 1027 1364 m
- 62 Y -20 16 d -62 Y f 0 0.8 0.6 c 1027 1426 m 62 Y -20 16 d -62 Y f 0 0.8 0.4 c
- 1027 1488 m 44 Y -20 16 d -44 Y f black 1007 1131 m 20 -16 d 417 Y -20 16 d
- cl s 0 0.8 0.4 c 1027 1532 m 23 6 d -20 16 d -23 -6 d f black 1027 1532 m 23 6
- d -20 16 d -23 -6 d cl s 0 0 0.8 c 1004 1110 m 23 5 d 63 Y -23 -6 d f 0 0.2 0.8
- c 1027 1178 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 1027 1240 m 62 Y -23 -6 d -62 Y
- f 0 0.6 0.8 c 1027 1302 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 1027 1364 m 62 Y
- -23 -6 d -62 Y f 0 0.8 0.6 c 1027 1426 m 62 Y -23 -6 d -62 Y f 0 0.8 0.4 c 1027
- 1488 m 62 Y -23 -5 d -63 Y f 0 0.8 0.2 c 1027 1550 m 9 Y -23 -6 d -8 Y f black
- 1004 1110 m 23 5 d 444 Y -23 -6 d cl s 0 0 0.8 c 983 1125 m 21 -15 d 62 Y -21
- 15 d f 0 0.2 0.8 c 1004 1172 m 62 Y -21 15 d -62 Y f 0 0.4 0.8 c 1004 1234 m 62
- Y -21 15 d -62 Y f 0 0.6 0.8 c 1004 1296 m 62 Y -21 16 d -63 Y f 0 0.8 0.8 c
- 1004 1358 m 62 Y -21 16 d -62 Y f 0 0.8 0.6 c 1004 1420 m 62 Y -21 16 d -62 Y f
- 0 0.8 0.4 c 1004 1482 m 63 Y -21 15 d -62 Y f 0 0.8 0.2 c 1004 1545 m 8 Y -21
- 15 d -8 Y f black 983 1125 m 21 -15 d 443 Y -21 15 d cl s 0 0.8 0.2 c 1004 1553
- m 23 6 d -20 15 d -24 -6 d f black 1004 1553 m 23 6 d -20 15 d -24 -6 d cl s 0
- 0 0.8 c 980 1104 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1004 1172 m 62 Y -24 -6 d
- -62 Y f 0 0.4 0.8 c 1004 1234 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 1004 1296 m
- 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 1004 1358 m 62 Y -24 -6 d -62 Y f 0 0.8 0.6 c
- 1004 1420 m 62 Y -24 -6 d -62 Y f 0 0.8 0.4 c 1004 1482 m 44 Y -24 -6 d -44 Y f
- black 980 1104 m 24 6 d 416 Y -24 -6 d cl s 0 0 0.8 c 960 1119 m 20 -15 d 62 Y
- -20 15 d f 0 0.2 0.8 c 980 1166 m 62 Y -20 15 d -62 Y f 0 0.4 0.8 c 980 1228 m
- 62 Y -20 15 d -62 Y f 0 0.6 0.8 c 980 1290 m 62 Y -20 16 d -63 Y f 0 0.8 0.8 c
- 980 1352 m 62 Y -20 16 d -62 Y f 0 0.8 0.6 c 980 1414 m 62 Y -20 16 d -62 Y f 0
- 0.8 0.4 c 980 1476 m 44 Y -20 16 d -44 Y f black 960 1119 m 20 -15 d 416 Y -20
- 16 d cl s 0 0.8 0.4 c 980 1520 m 24 6 d -21 16 d -23 -6 d f black 980 1520 m 24
- 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 957 1098 m 23 6 d 62 Y -23 -6 d f 0 0.2
- 0.8 c 980 1166 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 980 1228 m 62 Y -23 -6 d -62
- Y f 0 0.6 0.8 c 980 1290 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 980 1352 m 62 Y
- -23 -6 d -62 Y f 0 0.8 0.6 c 980 1414 m 62 Y -23 -6 d -62 Y f 0 0.8 0.4 c 980
- 1476 m 63 Y -23 -6 d -63 Y f 0 0.8 0.2 c 980 1539 m 62 Y -23 -6 d -62 Y f 0 0.8
- 0 c 980 1601 m 62 Y -23 -6 d -62 Y f 0.2 0.8 0 c 980 1663 m 5 Y -23 -6 d -5 Y f
- black 957 1098 m 23 6 d 564 Y -23 -6 d cl s 0 0 0.8 c 936 1113 m 21 -15 d 62 Y
- -21 15 d f 0 0.2 0.8 c 957 1160 m 62 Y -21 15 d -62 Y f 0 0.4 0.8 c 957 1222 m
- 62 Y -21 16 d -63 Y f 0 0.6 0.8 c 957 1284 m 62 Y -21 16 d -62 Y f 0 0.8 0.8 c
- 957 1346 m 62 Y -21 16 d -62 Y f 0 0.8 0.6 c 957 1408 m 62 Y -21 16 d -62 Y f 0
- 0.8 0.4 c 957 1470 m 63 Y -21 15 d -62 Y f 0 0.8 0.2 c 957 1533 m 62 Y -21 15 d
- -62 Y f 0 0.8 0 c 957 1595 m 62 Y -21 15 d -62 Y f 0.2 0.8 0 c 957 1657 m 5 Y
- -21 15 d -5 Y f black 936 1113 m 21 -15 d 564 Y -21 15 d cl s 0.2 0.8 0 c 957
- 1662 m 23 6 d -20 15 d -24 -6 d f black 957 1662 m 23 6 d -20 15 d -24 -6 d
- cl s 0 0 0.8 c 933 1092 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 957 1160 m 62 Y
- -24 -6 d -62 Y f 0 0.4 0.8 c 957 1222 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 957
- 1284 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 957 1346 m 62 Y -24 -6 d -62 Y f 0 0.8
- 0.6 c 957 1408 m 62 Y -24 -6 d -62 Y f 0 0.8 0.4 c 957 1470 m 17 Y -24 -6 d -17
- Y f black 933 1092 m 24 6 d 389 Y -24 -6 d cl s 0 0 0.8 c 913 1107 m 20 -15 d
- 62 Y -20 15 d f 0 0.2 0.8 c 933 1154 m 62 Y -20 15 d -62 Y f 0 0.4 0.8 c 933
- 1216 m 62 Y -20 16 d -63 Y f 0 0.6 0.8 c 933 1278 m 62 Y -20 16 d -62 Y f 0 0.8
- 0.8 c 933 1340 m 62 Y -20 16 d -62 Y f 0 0.8 0.6 c 933 1402 m 62 Y -20 16 d -62
- Y f 0 0.8 0.4 c 933 1464 m 17 Y -20 16 d -17 Y f black 913 1107 m 20 -15 d 389
- Y -20 16 d cl s 0 0.8 0.4 c 933 1481 m 24 6 d -21 16 d -23 -6 d f black 933
- 1481 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 910 1086 m 23 6 d 62 Y -23 -6 d
- f 0 0.2 0.8 c 933 1154 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 933 1216 m 62 Y -23
- -6 d -62 Y f 0 0.6 0.8 c 933 1278 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 933 1340
- m 62 Y -23 -6 d -62 Y f 0 0.8 0.6 c 933 1402 m 25 Y -23 -6 d -25 Y f black 910
- 1086 m 23 6 d 335 Y -23 -6 d cl s 0 0 0.8 c 889 1101 m 21 -15 d 62 Y -21 15 d f
- 0 0.2 0.8 c 910 1148 m 62 Y -21 15 d -62 Y f 0 0.4 0.8 c 910 1210 m 62 Y -21 16
- d -63 Y f 0 0.6 0.8 c 910 1272 m 62 Y -21 16 d -62 Y f 0 0.8 0.8 c 910 1334 m
- 62 Y -21 16 d -62 Y f 0 0.8 0.6 c 910 1396 m 25 Y -21 16 d -25 Y f black 889
- 1101 m 21 -15 d 335 Y -21 16 d cl s 0 0.8 0.6 c 910 1421 m 23 6 d -20 16 d -24
- -6 d f black 910 1421 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 886 1080 m 24 6
- d 62 Y -24 -6 d f 0 0.2 0.8 c 910 1148 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 910
- 1210 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 910 1272 m 62 Y -24 -6 d -62 Y f 0 0.8
- 0.8 c 910 1334 m 62 Y -24 -6 d -62 Y f 0 0.8 0.6 c 910 1396 m 62 Y -24 -6 d -62
- Y f 0 0.8 0.4 c 910 1458 m 31 Y -24 -6 d -31 Y f black 886 1080 m 24 6 d 403 Y
- -24 -6 d cl s 0 0 0.8 c 866 1095 m 20 -15 d 62 Y -20 15 d f 0 0.2 0.8 c 886
- 1142 m 62 Y -20 15 d -62 Y f 0 0.4 0.8 c 886 1204 m 62 Y -20 16 d -63 Y f 0 0.6
- 0.8 c 886 1266 m 62 Y -20 16 d -62 Y f 0 0.8 0.8 c 886 1328 m 62 Y -20 16 d -62
- Y f 0 0.8 0.6 c 886 1390 m 62 Y -20 16 d -62 Y f 0 0.8 0.4 c 886 1452 m 31 Y
- -20 15 d -30 Y f black 866 1095 m 20 -15 d 403 Y -20 15 d cl s 0 0.8 0.4 c 886
- 1483 m 24 6 d -21 15 d -23 -6 d f black 886 1483 m 24 6 d -21 15 d -23 -6 d
- cl s 0 0 0.8 c 863 1074 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 886 1142 m 62 Y
- -23 -6 d -62 Y f 0 0.4 0.8 c 886 1204 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c 886
- 1266 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 886 1328 m 62 Y -23 -6 d -62 Y f 0 0.8
- 0.6 c 886 1390 m 62 Y -23 -6 d -62 Y f 0 0.8 0.4 c 886 1452 m 63 Y -23 -6 d -63
- Y f 0 0.8 0.2 c 886 1515 m 62 Y -23 -6 d -62 Y f 0 0.8 0 c 886 1577 m 27 Y -23
- -6 d -27 Y f black 863 1074 m 23 6 d 524 Y -23 -6 d cl s 0 0 0.8 c 842 1089 m
- 21 -15 d 62 Y -21 15 d f 0 0.2 0.8 c 863 1136 m 62 Y -21 15 d -62 Y f 0 0.4 0.8
- c 863 1198 m 62 Y -21 16 d -63 Y f 0 0.6 0.8 c 863 1260 m 62 Y -21 16 d -62 Y f
- 0 0.8 0.8 c 863 1322 m 62 Y -21 16 d -62 Y f 0 0.8 0.6 c 863 1384 m 62 Y -21 16
- d -62 Y f 0 0.8 0.4 c 863 1446 m 63 Y -21 15 d -62 Y f 0 0.8 0.2 c 863 1509 m
- 62 Y -21 15 d -62 Y f 0 0.8 0 c 863 1571 m 27 Y -21 15 d -27 Y f black 842 1089
- m 21 -15 d 524 Y -21 15 d cl s 0 0.8 0 c 863 1598 m 23 6 d -20 15 d -24 -6 d f
- black 863 1598 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 839 1068 m 24 6 d 62 Y
- -24 -6 d f 0 0.2 0.8 c 863 1136 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 863 1198 m
- 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 863 1260 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c
- 863 1322 m 62 Y -24 -6 d -62 Y f 0 0.8 0.6 c 863 1384 m 62 Y -24 -5 d -63 Y f 0
- 0.8 0.4 c 863 1446 m 31 Y -24 -6 d -30 Y f black 839 1068 m 24 6 d 403 Y -24 -6
- d cl s 0 0 0.8 c 819 1083 m 20 -15 d 62 Y -20 15 d f 0 0.2 0.8 c 839 1130 m 62
- Y -20 15 d -62 Y f 0 0.4 0.8 c 839 1192 m 62 Y -20 16 d -63 Y f 0 0.6 0.8 c 839
- 1254 m 62 Y -20 16 d -62 Y f 0 0.8 0.8 c 839 1316 m 62 Y -20 16 d -62 Y f 0 0.8
- 0.6 c 839 1378 m 63 Y -20 15 d -62 Y f 0 0.8 0.4 c 839 1441 m 30 Y -20 15 d -30
- Y f black 819 1083 m 20 -15 d 403 Y -20 15 d cl s 0 0.8 0.4 c 839 1471 m 24 6 d
- -21 15 d -23 -6 d f black 839 1471 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c
- 816 1062 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 839 1130 m 62 Y -23 -6 d -62 Y f
- 0 0.4 0.8 c 839 1192 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c 839 1254 m 62 Y -23 -6
- d -62 Y f 0 0.8 0.8 c 839 1316 m 62 Y -23 -6 d -62 Y f 0 0.8 0.6 c 839 1378 m
- 63 Y -23 -6 d -63 Y f 0 0.8 0.4 c 839 1441 m 62 Y -23 -6 d -62 Y f 0 0.8 0.2 c
- 839 1503 m 62 Y -23 -6 d -62 Y f 0 0.8 0 c 839 1565 m 40 Y -23 -6 d -40 Y f
- black 816 1062 m 23 6 d 537 Y -23 -6 d cl s 0 0 0.8 c 795 1077 m 21 -15 d 62 Y
- -21 15 d f 0 0.2 0.8 c 816 1124 m 62 Y -21 15 d -62 Y f 0 0.4 0.8 c 816 1186 m
- 62 Y -21 16 d -63 Y f 0 0.6 0.8 c 816 1248 m 62 Y -21 16 d -62 Y f 0 0.8 0.8 c
- 816 1310 m 62 Y -21 16 d -62 Y f 0 0.8 0.6 c 816 1372 m 63 Y -21 15 d -62 Y f 0
- 0.8 0.4 c 816 1435 m 62 Y -21 15 d -62 Y f 0 0.8 0.2 c 816 1497 m 62 Y -21 15 d
- -62 Y f 0 0.8 0 c 816 1559 m 40 Y -21 16 d -41 Y f black 795 1077 m 21 -15 d
- 537 Y -21 16 d cl s 0 0.8 0 c 816 1599 m 23 6 d -20 16 d -24 -6 d f black 816
- 1599 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 792 1056 m 24 6 d 62 Y -24 -6 d
- f 0 0.2 0.8 c 816 1124 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 816 1186 m 62 Y -24
- -6 d -62 Y f 0 0.6 0.8 c 816 1248 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 816 1310
- m 62 Y -24 -6 d -62 Y f 0 0.8 0.6 c 816 1372 m 63 Y -24 -6 d -63 Y f 0 0.8 0.4
- c 816 1435 m 62 Y -24 -6 d -62 Y f 0 0.8 0.2 c 816 1497 m 62 Y -24 -6 d -62 Y f
- 0 0.8 0 c 816 1559 m 62 Y -24 -6 d -62 Y f 0.2 0.8 0 c 816 1621 m 59 Y -24 -6 d
- -59 Y f black 792 1056 m 24 6 d 618 Y -24 -6 d cl s 0 0 0.8 c 772 1071 m 20 -15
- d 62 Y -20 15 d f 0 0.2 0.8 c 792 1118 m 62 Y -20 16 d -63 Y f 0 0.4 0.8 c 792
- 1180 m 62 Y -20 16 d -62 Y f 0 0.6 0.8 c 792 1242 m 62 Y -20 16 d -62 Y f 0 0.8
- 0.8 c 792 1304 m 62 Y -20 16 d -62 Y f 0 0.8 0.6 c 792 1366 m 63 Y -20 15 d -62
- Y f 0 0.8 0.4 c 792 1429 m 62 Y -20 15 d -62 Y f 0 0.8 0.2 c 792 1491 m 62 Y
- -20 15 d -62 Y f 0 0.8 0 c 792 1553 m 62 Y -20 16 d -63 Y f 0.2 0.8 0 c 792
- 1615 m 59 Y -20 15 d -58 Y f black 772 1071 m 20 -15 d 618 Y -20 15 d cl s 0.2
- 0.8 0 c 792 1674 m 24 6 d -21 15 d -23 -6 d f black 792 1674 m 24 6 d -21 15 d
- -23 -6 d cl s 0 0 0.8 c 769 1050 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 792 1118
- m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 792 1180 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8
- c 792 1242 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 792 1304 m 62 Y -23 -6 d -62 Y f
- 0 0.8 0.6 c 792 1366 m 63 Y -23 -6 d -63 Y f 0 0.8 0.4 c 792 1429 m 62 Y -23 -6
- d -62 Y f 0 0.8 0.2 c 792 1491 m 62 Y -23 -6 d -62 Y f 0 0.8 0 c 792 1553 m 13
- Y -23 -6 d -13 Y f black 769 1050 m 23 6 d 510 Y -23 -6 d cl s 0 0 0.8 c 748
- 1065 m 21 -15 d 62 Y -21 15 d f 0 0.2 0.8 c 769 1112 m 62 Y -21 16 d -63 Y f 0
- 0.4 0.8 c 769 1174 m 62 Y -21 16 d -62 Y f 0 0.6 0.8 c 769 1236 m 62 Y -21 16 d
- -62 Y f 0 0.8 0.8 c 769 1298 m 62 Y -21 16 d -62 Y f 0 0.8 0.6 c 769 1360 m 63
- Y -21 15 d -62 Y f 0 0.8 0.4 c 769 1423 m 62 Y -21 15 d -62 Y f 0 0.8 0.2 c 769
- 1485 m 62 Y -21 15 d -62 Y f 0 0.8 0 c 769 1547 m 13 Y -21 16 d -14 Y f black
- 748 1065 m 21 -15 d 510 Y -21 16 d cl s 0 0.8 0 c 769 1560 m 23 6 d -20 16 d
- -24 -6 d f black 769 1560 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 745 1044 m
- 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 769 1112 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c
- 769 1174 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 769 1236 m 62 Y -24 -6 d -62 Y f 0
- 0.8 0.8 c 769 1298 m 62 Y -24 -6 d -62 Y f 0 0.8 0.6 c 769 1360 m 63 Y -24 -6 d
- -63 Y f 0 0.8 0.4 c 769 1423 m 62 Y -24 -6 d -62 Y f 0 0.8 0.2 c 769 1485 m 48
- Y -24 -6 d -48 Y f black 745 1044 m 24 6 d 483 Y -24 -6 d cl s 0 0 0.8 c 725
- 1059 m 20 -15 d 62 Y -20 15 d f 0 0.2 0.8 c 745 1106 m 62 Y -20 16 d -63 Y f 0
- 0.4 0.8 c 745 1168 m 62 Y -20 16 d -62 Y f 0 0.6 0.8 c 745 1230 m 62 Y -20 16 d
- -62 Y f 0 0.8 0.8 c 745 1292 m 62 Y -20 16 d -62 Y f 0 0.8 0.6 c 745 1354 m 63
- Y -20 15 d -62 Y f 0 0.8 0.4 c 745 1417 m 62 Y -20 15 d -62 Y f 0 0.8 0.2 c 745
- 1479 m 48 Y -20 16 d -49 Y f black 725 1059 m 20 -15 d 483 Y -20 16 d cl s 0
- 0.8 0.2 c 745 1527 m 24 6 d -21 16 d -23 -6 d f black 745 1527 m 24 6 d -21 16
- d -23 -6 d cl s 0 0 0.8 c 722 1038 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 745
- 1106 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 745 1168 m 62 Y -23 -6 d -62 Y f 0 0.6
- 0.8 c 745 1230 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 745 1292 m 62 Y -23 -6 d -62
- Y f 0 0.8 0.6 c 745 1354 m 26 Y -23 -6 d -26 Y f black 722 1038 m 23 6 d 336 Y
- -23 -6 d cl s 0 0 0.8 c 701 1053 m 21 -15 d 62 Y -21 15 d f 0 0.2 0.8 c 722
- 1100 m 62 Y -21 16 d -63 Y f 0 0.4 0.8 c 722 1162 m 62 Y -21 16 d -62 Y f 0 0.6
- 0.8 c 722 1224 m 62 Y -21 16 d -62 Y f 0 0.8 0.8 c 722 1286 m 62 Y -21 16 d -62
- Y f 0 0.8 0.6 c 722 1348 m 26 Y -21 15 d -25 Y f black 701 1053 m 21 -15 d 336
- Y -21 15 d cl s 0 0.8 0.6 c 722 1374 m 23 6 d -20 15 d -24 -6 d f black 722
- 1374 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 698 1032 m 24 6 d 62 Y -24 -6 d
- f 0 0.2 0.8 c 722 1100 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 722 1162 m 62 Y -24
- -6 d -62 Y f 0 0.6 0.8 c 722 1224 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 722 1286
- m 62 Y -24 -6 d -62 Y f 0 0.8 0.6 c 722 1348 m 63 Y -24 -6 d -63 Y f 0 0.8 0.4
- c 722 1411 m 30 Y -24 -6 d -30 Y f black 698 1032 m 24 6 d 403 Y -24 -6 d cl s
- 0 0 0.8 c 678 1047 m 20 -15 d 62 Y -20 15 d f 0 0.2 0.8 c 698 1094 m 62 Y -20
- 16 d -63 Y f 0 0.4 0.8 c 698 1156 m 62 Y -20 16 d -62 Y f 0 0.6 0.8 c 698 1218
- m 62 Y -20 16 d -62 Y f 0 0.8 0.8 c 698 1280 m 62 Y -20 16 d -62 Y f 0 0.8 0.6
- c 698 1342 m 63 Y -20 15 d -62 Y f 0 0.8 0.4 c 698 1405 m 30 Y -20 15 d -30 Y f
- black 678 1047 m 20 -15 d 403 Y -20 15 d cl s 0 0.8 0.4 c 698 1435 m 24 6 d -21
- 15 d -23 -6 d f black 698 1435 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 675
- 1026 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 698 1094 m 62 Y -23 -6 d -62 Y f 0
- 0.4 0.8 c 698 1156 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c 698 1218 m 62 Y -23 -6 d
- -62 Y f 0 0.8 0.8 c 698 1280 m 62 Y -23 -5 d -63 Y f 0 0.8 0.6 c 698 1342 m 63
- Y -23 -6 d -62 Y f 0 0.8 0.4 c 698 1405 m 62 Y -23 -6 d -62 Y f 0 0.8 0.2 c 698
- 1467 m 62 Y -23 -6 d -62 Y f 0 0.8 0 c 698 1529 m 62 Y -23 -6 d -62 Y f 0.2 0.8
- 0 c 698 1591 m 19 Y -23 -6 d -19 Y f black 675 1026 m 23 6 d 578 Y -23 -6 d
- cl s 0 0 0.8 c 654 1041 m 21 -15 d 62 Y -21 15 d f 0 0.2 0.8 c 675 1088 m 62 Y
- -21 16 d -63 Y f 0 0.4 0.8 c 675 1150 m 62 Y -21 16 d -62 Y f 0 0.6 0.8 c 675
- 1212 m 62 Y -21 16 d -62 Y f 0 0.8 0.8 c 675 1274 m 63 Y -21 15 d -62 Y f 0 0.8
- 0.6 c 675 1337 m 62 Y -21 15 d -62 Y f 0 0.8 0.4 c 675 1399 m 62 Y -21 15 d -62
- Y f 0 0.8 0.2 c 675 1461 m 62 Y -21 15 d -62 Y f 0 0.8 0 c 675 1523 m 62 Y -21
- 16 d -63 Y f 0.2 0.8 0 c 675 1585 m 19 Y -21 15 d -18 Y f black 654 1041 m 21
- -15 d 578 Y -21 15 d cl s 0.2 0.8 0 c 675 1604 m 23 6 d -20 15 d -24 -6 d f
- black 675 1604 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 651 1020 m 24 6 d 62 Y
- -24 -6 d f 0 0.2 0.8 c 675 1088 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 675 1150 m
- 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 675 1212 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c
- 675 1274 m 63 Y -24 -6 d -63 Y f 0 0.8 0.6 c 675 1337 m 62 Y -24 -6 d -62 Y f 0
- 0.8 0.4 c 675 1399 m 62 Y -24 -6 d -62 Y f 0 0.8 0.2 c 675 1461 m 62 Y -24 -6 d
- -62 Y f 0 0.8 0 c 675 1523 m 40 Y -24 -6 d -40 Y f black 651 1020 m 24 6 d 537
- Y -24 -6 d cl s 0 0 0.8 c 631 1035 m 20 -15 d 62 Y -20 15 d f 0 0.2 0.8 c 651
- 1082 m 62 Y -20 16 d -63 Y f 0 0.4 0.8 c 651 1144 m 62 Y -20 16 d -62 Y f 0 0.6
- 0.8 c 651 1206 m 62 Y -20 16 d -62 Y f 0 0.8 0.8 c 651 1268 m 63 Y -20 15 d -62
- Y f 0 0.8 0.6 c 651 1331 m 62 Y -20 15 d -62 Y f 0 0.8 0.4 c 651 1393 m 62 Y
- -20 15 d -62 Y f 0 0.8 0.2 c 651 1455 m 62 Y -20 15 d -62 Y f 0 0.8 0 c 651
- 1517 m 40 Y -20 16 d -41 Y f black 631 1035 m 20 -15 d 537 Y -20 16 d cl s 0
- 0.8 0 c 651 1557 m 24 6 d -21 16 d -23 -6 d f black 651 1557 m 24 6 d -21 16 d
- -23 -6 d cl s 0 0 0.8 c 628 1014 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 651 1082
- m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 651 1144 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8
- c 651 1206 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 651 1268 m 63 Y -23 -6 d -63 Y f
- 0 0.8 0.6 c 651 1331 m 62 Y -23 -6 d -62 Y f 0 0.8 0.4 c 651 1393 m 62 Y -23 -6
- d -62 Y f 0 0.8 0.2 c 651 1455 m 8 Y -23 -6 d -8 Y f black 628 1014 m 23 6 d
- 443 Y -23 -6 d cl s 0 0 0.8 c 607 1029 m 21 -15 d 62 Y -21 16 d f 0 0.2 0.8 c
- 628 1076 m 62 Y -21 16 d -62 Y f 0 0.4 0.8 c 628 1138 m 62 Y -21 16 d -62 Y f 0
- 0.6 0.8 c 628 1200 m 62 Y -21 16 d -62 Y f 0 0.8 0.8 c 628 1262 m 63 Y -21 15 d
- -62 Y f 0 0.8 0.6 c 628 1325 m 62 Y -21 15 d -62 Y f 0 0.8 0.4 c 628 1387 m 62
- Y -21 15 d -62 Y f 0 0.8 0.2 c 628 1449 m 8 Y -21 16 d -9 Y f black 607 1029 m
- 21 -15 d 443 Y -21 16 d cl s 0 0.8 0.2 c 628 1457 m 23 6 d -20 16 d -24 -6 d f
- black 628 1457 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 604 1008 m 24 6 d 62 Y
- -24 -6 d f 0 0.2 0.8 c 628 1076 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 628 1138 m
- 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 628 1200 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c
- 628 1262 m 63 Y -24 -6 d -63 Y f 0 0.8 0.6 c 628 1325 m 62 Y -24 -6 d -62 Y f 0
- 0.8 0.4 c 628 1387 m 62 Y -24 -6 d -62 Y f 0 0.8 0.2 c 628 1449 m 62 Y -24 -6 d
- -62 Y f 0 0.8 0 c 628 1511 m 62 Y -24 -6 d -62 Y f 0.2 0.8 0 c 628 1573 m 5 Y
- -24 -6 d -5 Y f black 604 1008 m 24 6 d 564 Y -24 -6 d cl s 0 0 0.8 c 584 1023
- m 20 -15 d 62 Y -20 16 d f 0 0.2 0.8 c 604 1070 m 62 Y -20 16 d -62 Y f 0 0.4
- 0.8 c 604 1132 m 62 Y -20 16 d -62 Y f 0 0.6 0.8 c 604 1194 m 62 Y -20 16 d -62
- Y f 0 0.8 0.8 c 604 1256 m 63 Y -20 15 d -62 Y f 0 0.8 0.6 c 604 1319 m 62 Y
- -20 15 d -62 Y f 0 0.8 0.4 c 604 1381 m 62 Y -20 15 d -62 Y f 0 0.8 0.2 c 604
- 1443 m 62 Y -20 16 d -63 Y f 0 0.8 0 c 604 1505 m 62 Y -20 16 d -62 Y f 0.2 0.8
- 0 c 604 1567 m 5 Y -20 16 d -5 Y f black 584 1023 m 20 -15 d 564 Y -20 16 d
- cl s 0.2 0.8 0 c 604 1572 m 24 6 d -21 16 d -23 -6 d f black 604 1572 m 24 6 d
- -21 16 d -23 -6 d cl s 0 0 0.8 c 581 1002 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c
- 604 1070 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 604 1132 m 62 Y -23 -6 d -62 Y f 0
- 0.6 0.8 c 604 1194 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 604 1256 m 63 Y -23 -6 d
- -63 Y f 0 0.8 0.6 c 604 1319 m 38 Y -23 -6 d -38 Y f black 581 1002 m 23 6 d
- 349 Y -23 -6 d cl s 0 0 0.8 c 560 1017 m 21 -15 d 62 Y -21 16 d f 0 0.2 0.8 c
- 581 1064 m 62 Y -21 16 d -62 Y f 0 0.4 0.8 c 581 1126 m 62 Y -21 16 d -62 Y f 0
- 0.6 0.8 c 581 1188 m 62 Y -21 16 d -62 Y f 0 0.8 0.8 c 581 1250 m 63 Y -21 15 d
- -62 Y f 0 0.8 0.6 c 581 1313 m 38 Y -21 16 d -39 Y f black 560 1017 m 21 -15 d
- 349 Y -21 16 d cl s 0 0.8 0.6 c 581 1351 m 23 6 d -20 16 d -24 -6 d f black 581
- 1351 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 557 996 m 24 6 d -21 15 d -23 -6
- d f black 557 996 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 534 990 m 23 6 d
- -20 15 d -24 -6 d f black 534 990 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 510
- 984 m 24 6 d -21 15 d -23 -6 d f black 510 984 m 24 6 d -21 15 d -23 -6 d cl s
- 0 0 0.8 c 487 978 m 23 6 d -20 15 d -24 -6 d f black 487 978 m 23 6 d -20 15 d
- -24 -6 d cl s 0 0 0.8 c 1611 1243 m 24 6 d -21 16 d -23 -6 d f black 1611 1243
- m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1588 1237 m 23 6 d -20 16 d -24 -6 d
- f black 1588 1237 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1564 1232 m 24 5 d
- -21 16 d -23 -6 d f black 1564 1232 m 24 5 d -21 16 d -23 -6 d cl s 0 0 0.8 c
- 1541 1226 m 23 6 d -20 15 d -24 -6 d f black 1541 1226 m 23 6 d -20 15 d -24 -6
- d cl s 0 0 0.8 c 1517 1220 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1541 1288 m 62
- Y -24 -6 d -62 Y f 0 0.4 0.8 c 1541 1350 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c
- 1541 1412 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 1541 1474 m 62 Y -24 -6 d -62 Y f
- 0 0.8 0.6 c 1541 1536 m 62 Y -24 -6 d -62 Y f 0 0.8 0.4 c 1541 1598 m 63 Y -24
- -6 d -63 Y f 0 0.8 0.2 c 1541 1661 m 62 Y -24 -6 d -62 Y f 0 0.8 0 c 1541 1723
- m 62 Y -24 -6 d -62 Y f 0.2 0.8 0 c 1541 1785 m 62 Y -24 -6 d -62 Y f 0.4 0.8 0
- c 1541 1847 m 62 Y -24 -6 d -62 Y f 0.6 0.8 0 c 1541 1909 m 62 Y -24 -6 d -62 Y
- f 0.8 0.8 0 c 1541 1971 m 7 Y -24 -6 d -7 Y f black 1517 1220 m 24 6 d 752 Y
- -24 -6 d cl s 0 0 0.8 c 1497 1235 m 20 -15 d 62 Y -20 15 d f 0 0.2 0.8 c 1517
- 1282 m 62 Y -20 15 d -62 Y f 0 0.4 0.8 c 1517 1344 m 62 Y -20 16 d -63 Y f 0
- 0.6 0.8 c 1517 1406 m 62 Y -20 16 d -62 Y f 0 0.8 0.8 c 1517 1468 m 62 Y -20 16
- d -62 Y f 0 0.8 0.6 c 1517 1530 m 62 Y -20 16 d -62 Y f 0 0.8 0.4 c 1517 1592 m
- 63 Y -20 15 d -62 Y f 0 0.8 0.2 c 1517 1655 m 62 Y -20 15 d -62 Y f 0 0.8 0 c
- 1517 1717 m 62 Y -20 15 d -62 Y f 0.2 0.8 0 c 1517 1779 m 62 Y -20 16 d -63 Y f
- 0.4 0.8 0 c 1517 1841 m 62 Y -20 16 d -62 Y f 0.6 0.8 0 c 1517 1903 m 62 Y -20
- 16 d -62 Y f 0.8 0.8 0 c 1517 1965 m 7 Y -20 16 d -7 Y f black 1497 1235 m 20
- -15 d 752 Y -20 16 d cl s 0.8 0.8 0 c 1517 1972 m 24 6 d -21 15 d -23 -5 d f
- black 1517 1972 m 24 6 d -21 15 d -23 -5 d cl s 0 0 0.8 c 1494 1214 m 23 6 d 62
- Y -23 -6 d f 0 0.2 0.8 c 1517 1282 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 1517
- 1344 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c 1517 1406 m 62 Y -23 -6 d -62 Y f 0
- 0.8 0.8 c 1517 1468 m 62 Y -23 -6 d -62 Y f 0 0.8 0.6 c 1517 1530 m 62 Y -23 -6
- d -62 Y f 0 0.8 0.4 c 1517 1592 m 63 Y -23 -6 d -63 Y f 0 0.8 0.2 c 1517 1655 m
- 62 Y -23 -6 d -62 Y f 0 0.8 0 c 1517 1717 m 62 Y -23 -6 d -62 Y f 0.2 0.8 0 c
- 1517 1779 m 45 Y -23 -6 d -45 Y f black 1494 1214 m 23 6 d 604 Y -23 -6 d cl s
- 0 0 0.8 c 1473 1229 m 21 -15 d 62 Y -21 15 d f 0 0.2 0.8 c 1494 1276 m 62 Y -21
- 15 d -62 Y f 0 0.4 0.8 c 1494 1338 m 62 Y -21 16 d -63 Y f 0 0.6 0.8 c 1494
- 1400 m 62 Y -21 16 d -62 Y f 0 0.8 0.8 c 1494 1462 m 62 Y -21 16 d -62 Y f 0
- 0.8 0.6 c 1494 1524 m 62 Y -21 16 d -62 Y f 0 0.8 0.4 c 1494 1586 m 63 Y -21 15
- d -62 Y f 0 0.8 0.2 c 1494 1649 m 62 Y -21 15 d -62 Y f 0 0.8 0 c 1494 1711 m
- 62 Y -21 15 d -62 Y f 0.2 0.8 0 c 1494 1773 m 45 Y -21 16 d -46 Y f black 1473
- 1229 m 21 -15 d 604 Y -21 16 d cl s 0.2 0.8 0 c 1494 1818 m 23 6 d -20 16 d -24
- -6 d f black 1494 1818 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1470 1208 m 24
- 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1494 1276 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c
- 1494 1338 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 1494 1400 m 62 Y -24 -6 d -62 Y f
- 0 0.8 0.8 c 1494 1462 m 62 Y -24 -6 d -62 Y f 0 0.8 0.6 c 1494 1524 m 62 Y -24
- -6 d -62 Y f 0 0.8 0.4 c 1494 1586 m 63 Y -24 -6 d -63 Y f 0 0.8 0.2 c 1494
- 1649 m 62 Y -24 -6 d -62 Y f 0 0.8 0 c 1494 1711 m 62 Y -24 -6 d -62 Y f 0.2
- 0.8 0 c 1494 1773 m 62 Y -24 -6 d -62 Y f 0.4 0.8 0 c 1494 1835 m 10 Y -24 -6 d
- -10 Y f black 1470 1208 m 24 6 d 631 Y -24 -6 d cl s 0 0 0.8 c 1450 1223 m 20
- -15 d 62 Y -20 15 d f 0 0.2 0.8 c 1470 1270 m 62 Y -20 15 d -62 Y f 0 0.4 0.8 c
- 1470 1332 m 62 Y -20 16 d -63 Y f 0 0.6 0.8 c 1470 1394 m 62 Y -20 16 d -62 Y f
- 0 0.8 0.8 c 1470 1456 m 62 Y -20 16 d -62 Y f 0 0.8 0.6 c 1470 1518 m 62 Y -20
- 16 d -62 Y f 0 0.8 0.4 c 1470 1580 m 63 Y -20 15 d -62 Y f 0 0.8 0.2 c 1470
- 1643 m 62 Y -20 15 d -62 Y f 0 0.8 0 c 1470 1705 m 62 Y -20 15 d -62 Y f 0.2
- 0.8 0 c 1470 1767 m 62 Y -20 16 d -63 Y f 0.4 0.8 0 c 1470 1829 m 10 Y -20 16 d
- -10 Y f black 1450 1223 m 20 -15 d 631 Y -20 16 d cl s 0.4 0.8 0 c 1470 1839 m
- 24 6 d -21 16 d -23 -6 d f black 1470 1839 m 24 6 d -21 16 d -23 -6 d cl s 0 0
- 0.8 c 1447 1202 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 1470 1270 m 62 Y -23 -6 d
- -62 Y f 0 0.4 0.8 c 1470 1332 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c 1470 1394 m
- 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 1470 1456 m 62 Y -23 -6 d -62 Y f 0 0.8 0.6 c
- 1470 1518 m 39 Y -23 -6 d -39 Y f black 1447 1202 m 23 6 d 349 Y -23 -6 d cl s
- 0 0 0.8 c 1426 1217 m 21 -15 d 62 Y -21 15 d f 0 0.2 0.8 c 1447 1264 m 62 Y -21
- 15 d -62 Y f 0 0.4 0.8 c 1447 1326 m 62 Y -21 16 d -63 Y f 0 0.6 0.8 c 1447
- 1388 m 62 Y -21 16 d -62 Y f 0 0.8 0.8 c 1447 1450 m 62 Y -21 16 d -62 Y f 0
- 0.8 0.6 c 1447 1512 m 39 Y -21 15 d -38 Y f black 1426 1217 m 21 -15 d 349 Y
- -21 15 d cl s 0 0.8 0.6 c 1447 1551 m 23 6 d -20 15 d -24 -6 d f black 1447
- 1551 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1423 1196 m 24 6 d 62 Y -24 -6 d
- f 0 0.2 0.8 c 1447 1264 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 1447 1326 m 62 Y
- -24 -6 d -62 Y f 0 0.6 0.8 c 1447 1388 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 1447
- 1450 m 62 Y -24 -6 d -62 Y f 0 0.8 0.6 c 1447 1512 m 62 Y -24 -6 d -62 Y f 0
- 0.8 0.4 c 1447 1574 m 63 Y -24 -6 d -63 Y f 0 0.8 0.2 c 1447 1637 m 62 Y -24 -6
- d -62 Y f 0 0.8 0 c 1447 1699 m 62 Y -24 -6 d -62 Y f 0.2 0.8 0 c 1447 1761 m
- 62 Y -24 -6 d -62 Y f 0.4 0.8 0 c 1447 1823 m 37 Y -24 -6 d -37 Y f black 1423
- 1196 m 24 6 d 658 Y -24 -6 d cl s 0 0 0.8 c 1403 1211 m 20 -15 d 62 Y -20 15 d
- f 0 0.2 0.8 c 1423 1258 m 62 Y -20 15 d -62 Y f 0 0.4 0.8 c 1423 1320 m 62 Y
- -20 16 d -63 Y f 0 0.6 0.8 c 1423 1382 m 62 Y -20 16 d -62 Y f 0 0.8 0.8 c 1423
- 1444 m 62 Y -20 16 d -62 Y f 0 0.8 0.6 c 1423 1506 m 62 Y -20 16 d -62 Y f 0
- 0.8 0.4 c 1423 1568 m 63 Y -20 15 d -62 Y f 0 0.8 0.2 c 1423 1631 m 62 Y -20 15
- d -62 Y f 0 0.8 0 c 1423 1693 m 62 Y -20 15 d -62 Y f 0.2 0.8 0 c 1423 1755 m
- 62 Y -20 16 d -63 Y f 0.4 0.8 0 c 1423 1817 m 37 Y -20 16 d -37 Y f black 1403
- 1211 m 20 -15 d 658 Y -20 16 d cl s 0.4 0.8 0 c 1423 1854 m 24 6 d -21 16 d -23
- -6 d f black 1423 1854 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1400 1190 m 23
- 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 1423 1258 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c
- 1423 1320 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c 1423 1382 m 62 Y -23 -6 d -62 Y f
- 0 0.8 0.8 c 1423 1444 m 62 Y -23 -6 d -62 Y f 0 0.8 0.6 c 1423 1506 m 62 Y -23
- -5 d -63 Y f 0 0.8 0.4 c 1423 1568 m 58 Y -23 -6 d -57 Y f black 1400 1190 m 23
- 6 d 430 Y -23 -6 d cl s 0 0 0.8 c 1379 1205 m 21 -15 d 62 Y -21 15 d f 0 0.2
- 0.8 c 1400 1252 m 62 Y -21 15 d -62 Y f 0 0.4 0.8 c 1400 1314 m 62 Y -21 16 d
- -63 Y f 0 0.6 0.8 c 1400 1376 m 62 Y -21 16 d -62 Y f 0 0.8 0.8 c 1400 1438 m
- 62 Y -21 16 d -62 Y f 0 0.8 0.6 c 1400 1500 m 63 Y -21 15 d -62 Y f 0 0.8 0.4 c
- 1400 1563 m 57 Y -21 15 d -57 Y f black 1379 1205 m 21 -15 d 430 Y -21 15 d
- cl s 0 0.8 0.4 c 1400 1620 m 23 6 d -20 15 d -24 -6 d f black 1400 1620 m 23 6
- d -20 15 d -24 -6 d cl s 0 0 0.8 c 1376 1184 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8
- c 1400 1252 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 1400 1314 m 62 Y -24 -6 d -62 Y
- f 0 0.6 0.8 c 1400 1376 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 1400 1438 m 62 Y
- -24 -6 d -62 Y f 0 0.8 0.6 c 1400 1500 m 63 Y -24 -6 d -63 Y f 0 0.8 0.4 c 1400
- 1563 m 62 Y -24 -6 d -62 Y f 0 0.8 0.2 c 1400 1625 m 62 Y -24 -6 d -62 Y f 0
- 0.8 0 c 1400 1687 m 62 Y -24 -6 d -62 Y f 0.2 0.8 0 c 1400 1749 m 62 Y -24 -6 d
- -62 Y f 0.4 0.8 0 c 1400 1811 m 24 Y -24 -6 d -24 Y f black 1376 1184 m 24 6 d
- 645 Y -24 -6 d cl s 0 0 0.8 c 1356 1199 m 20 -15 d 62 Y -20 15 d f 0 0.2 0.8 c
- 1376 1246 m 62 Y -20 15 d -62 Y f 0 0.4 0.8 c 1376 1308 m 62 Y -20 16 d -63 Y f
- 0 0.6 0.8 c 1376 1370 m 62 Y -20 16 d -62 Y f 0 0.8 0.8 c 1376 1432 m 62 Y -20
- 16 d -62 Y f 0 0.8 0.6 c 1376 1494 m 63 Y -20 15 d -62 Y f 0 0.8 0.4 c 1376
- 1557 m 62 Y -20 15 d -62 Y f 0 0.8 0.2 c 1376 1619 m 62 Y -20 15 d -62 Y f 0
- 0.8 0 c 1376 1681 m 62 Y -20 15 d -62 Y f 0.2 0.8 0 c 1376 1743 m 62 Y -20 16 d
- -63 Y f 0.4 0.8 0 c 1376 1805 m 24 Y -20 15 d -23 Y f black 1356 1199 m 20 -15
- d 645 Y -20 15 d cl s 0.4 0.8 0 c 1376 1829 m 24 6 d -21 15 d -23 -6 d f black
- 1376 1829 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 1353 1178 m 23 6 d 62 Y -23
- -6 d f 0 0.2 0.8 c 1376 1246 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 1376 1308 m 62
- Y -23 -6 d -62 Y f 0 0.6 0.8 c 1376 1370 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c
- 1376 1432 m 62 Y -23 -6 d -62 Y f 0 0.8 0.6 c 1376 1494 m 63 Y -23 -6 d -63 Y f
- 0 0.8 0.4 c 1376 1557 m 62 Y -23 -6 d -62 Y f 0 0.8 0.2 c 1376 1619 m 62 Y -23
- -6 d -62 Y f 0 0.8 0 c 1376 1681 m 62 Y -23 -6 d -62 Y f 0.2 0.8 0 c 1376 1743
- m 45 Y -23 -6 d -45 Y f black 1353 1178 m 23 6 d 604 Y -23 -6 d cl s 0 0 0.8 c
- 1332 1193 m 21 -15 d 62 Y -21 15 d f 0 0.2 0.8 c 1353 1240 m 62 Y -21 16 d -63
- Y f 0 0.4 0.8 c 1353 1302 m 62 Y -21 16 d -62 Y f 0 0.6 0.8 c 1353 1364 m 62 Y
- -21 16 d -62 Y f 0 0.8 0.8 c 1353 1426 m 62 Y -21 16 d -62 Y f 0 0.8 0.6 c 1353
- 1488 m 63 Y -21 15 d -62 Y f 0 0.8 0.4 c 1353 1551 m 62 Y -21 15 d -62 Y f 0
- 0.8 0.2 c 1353 1613 m 62 Y -21 15 d -62 Y f 0 0.8 0 c 1353 1675 m 62 Y -21 16 d
- -63 Y f 0.2 0.8 0 c 1353 1737 m 45 Y -21 16 d -45 Y f black 1332 1193 m 21 -15
- d 604 Y -21 16 d cl s 0.2 0.8 0 c 1353 1782 m 23 6 d -20 16 d -24 -6 d f black
- 1353 1782 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1329 1172 m 24 6 d 62 Y -24
- -6 d f 0 0.2 0.8 c 1353 1240 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 1353 1302 m 62
- Y -24 -6 d -62 Y f 0 0.6 0.8 c 1353 1364 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c
- 1353 1426 m 62 Y -24 -6 d -62 Y f 0 0.8 0.6 c 1353 1488 m 63 Y -24 -6 d -63 Y f
- 0 0.8 0.4 c 1353 1551 m 62 Y -24 -6 d -62 Y f 0 0.8 0.2 c 1353 1613 m 62 Y -24
- -6 d -62 Y f 0 0.8 0 c 1353 1675 m 62 Y -24 -6 d -62 Y f 0.2 0.8 0 c 1353 1737
- m 59 Y -24 -6 d -59 Y f black 1329 1172 m 24 6 d 618 Y -24 -6 d cl s 0 0 0.8 c
- 1309 1187 m 20 -15 d 62 Y -20 15 d f 0 0.2 0.8 c 1329 1234 m 62 Y -20 16 d -63
- Y f 0 0.4 0.8 c 1329 1296 m 62 Y -20 16 d -62 Y f 0 0.6 0.8 c 1329 1358 m 62 Y
- -20 16 d -62 Y f 0 0.8 0.8 c 1329 1420 m 62 Y -20 16 d -62 Y f 0 0.8 0.6 c 1329
- 1482 m 63 Y -20 15 d -62 Y f 0 0.8 0.4 c 1329 1545 m 62 Y -20 15 d -62 Y f 0
- 0.8 0.2 c 1329 1607 m 62 Y -20 15 d -62 Y f 0 0.8 0 c 1329 1669 m 62 Y -20 16 d
- -63 Y f 0.2 0.8 0 c 1329 1731 m 59 Y -20 15 d -58 Y f black 1309 1187 m 20 -15
- d 618 Y -20 15 d cl s 0.2 0.8 0 c 1329 1790 m 24 6 d -21 15 d -23 -6 d f black
- 1329 1790 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 1306 1166 m 23 6 d 62 Y -23
- -6 d f 0 0.2 0.8 c 1329 1234 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 1329 1296 m 62
- Y -23 -6 d -62 Y f 0 0.6 0.8 c 1329 1358 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c
- 1329 1420 m 62 Y -23 -6 d -62 Y f 0 0.8 0.6 c 1329 1482 m 63 Y -23 -6 d -63 Y f
- 0 0.8 0.4 c 1329 1545 m 62 Y -23 -6 d -62 Y f 0 0.8 0.2 c 1329 1607 m 62 Y -23
- -6 d -62 Y f 0 0.8 0 c 1329 1669 m 62 Y -23 -6 d -62 Y f 0.2 0.8 0 c 1329 1731
- m 45 Y -23 -6 d -45 Y f black 1306 1166 m 23 6 d 604 Y -23 -6 d cl s 0 0 0.8 c
- 1285 1181 m 21 -15 d 62 Y -21 15 d f 0 0.2 0.8 c 1306 1228 m 62 Y -21 16 d -63
- Y f 0 0.4 0.8 c 1306 1290 m 62 Y -21 16 d -62 Y f 0 0.6 0.8 c 1306 1352 m 62 Y
- -21 16 d -62 Y f 0 0.8 0.8 c 1306 1414 m 62 Y -21 16 d -62 Y f 0 0.8 0.6 c 1306
- 1476 m 63 Y -21 15 d -62 Y f 0 0.8 0.4 c 1306 1539 m 62 Y -21 15 d -62 Y f 0
- 0.8 0.2 c 1306 1601 m 62 Y -21 15 d -62 Y f 0 0.8 0 c 1306 1663 m 62 Y -21 16 d
- -63 Y f 0.2 0.8 0 c 1306 1725 m 45 Y -21 16 d -45 Y f black 1285 1181 m 21 -15
- d 604 Y -21 16 d cl s 0.2 0.8 0 c 1306 1770 m 23 6 d -20 16 d -24 -6 d f black
- 1306 1770 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1282 1160 m 24 6 d 62 Y -24
- -6 d f 0 0.2 0.8 c 1306 1228 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 1306 1290 m 62
- Y -24 -6 d -62 Y f 0 0.6 0.8 c 1306 1352 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c
- 1306 1414 m 62 Y -24 -6 d -62 Y f 0 0.8 0.6 c 1306 1476 m 63 Y -24 -6 d -63 Y f
- 0 0.8 0.4 c 1306 1539 m 62 Y -24 -6 d -62 Y f 0 0.8 0.2 c 1306 1601 m 22 Y -24
- -6 d -22 Y f black 1282 1160 m 24 6 d 457 Y -24 -6 d cl s 0 0 0.8 c 1262 1175 m
- 20 -15 d 62 Y -20 15 d f 0 0.2 0.8 c 1282 1222 m 62 Y -20 16 d -63 Y f 0 0.4
- 0.8 c 1282 1284 m 62 Y -20 16 d -62 Y f 0 0.6 0.8 c 1282 1346 m 62 Y -20 16 d
- -62 Y f 0 0.8 0.8 c 1282 1408 m 62 Y -20 16 d -62 Y f 0 0.8 0.6 c 1282 1470 m
- 63 Y -20 15 d -62 Y f 0 0.8 0.4 c 1282 1533 m 62 Y -20 15 d -62 Y f 0 0.8 0.2 c
- 1282 1595 m 22 Y -20 15 d -22 Y f black 1262 1175 m 20 -15 d 457 Y -20 15 d
- cl s 0 0.8 0.2 c 1282 1617 m 24 6 d -21 15 d -23 -6 d f black 1282 1617 m 24 6
- d -21 15 d -23 -6 d cl s 0 0 0.8 c 1259 1154 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8
- c 1282 1222 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 1282 1284 m 62 Y -23 -6 d -62 Y
- f 0 0.6 0.8 c 1282 1346 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 1282 1408 m 62 Y
- -23 -6 d -62 Y f 0 0.8 0.6 c 1282 1470 m 63 Y -23 -6 d -63 Y f 0 0.8 0.4 c 1282
- 1533 m 62 Y -23 -6 d -62 Y f 0 0.8 0.2 c 1282 1595 m 8 Y -23 -6 d -8 Y f black
- 1259 1154 m 23 6 d 443 Y -23 -6 d cl s 0 0 0.8 c 1238 1169 m 21 -15 d 62 Y -21
- 15 d f 0 0.2 0.8 c 1259 1216 m 62 Y -21 16 d -63 Y f 0 0.4 0.8 c 1259 1278 m 62
- Y -21 16 d -62 Y f 0 0.6 0.8 c 1259 1340 m 62 Y -21 16 d -62 Y f 0 0.8 0.8 c
- 1259 1402 m 62 Y -21 16 d -62 Y f 0 0.8 0.6 c 1259 1464 m 63 Y -21 15 d -62 Y f
- 0 0.8 0.4 c 1259 1527 m 62 Y -21 15 d -62 Y f 0 0.8 0.2 c 1259 1589 m 8 Y -21
- 16 d -9 Y f black 1238 1169 m 21 -15 d 443 Y -21 16 d cl s 0 0.8 0.2 c 1259
- 1597 m 23 6 d -20 16 d -24 -6 d f black 1259 1597 m 23 6 d -20 16 d -24 -6 d
- cl s 0 0 0.8 c 1235 1148 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1259 1216 m 62 Y
- -24 -6 d -62 Y f 0 0.4 0.8 c 1259 1278 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 1259
- 1340 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 1259 1402 m 62 Y -24 -5 d -63 Y f 0
- 0.8 0.6 c 1259 1464 m 63 Y -24 -6 d -62 Y f 0 0.8 0.4 c 1259 1527 m 62 Y -24 -6
- d -62 Y f 0 0.8 0.2 c 1259 1589 m 62 Y -24 -6 d -62 Y f 0 0.8 0 c 1259 1651 m
- 62 Y -24 -6 d -62 Y f 0.2 0.8 0 c 1259 1713 m 19 Y -24 -6 d -19 Y f black 1235
- 1148 m 24 6 d 578 Y -24 -6 d cl s 0 0 0.8 c 1215 1163 m 20 -15 d 62 Y -20 15 d
- f 0 0.2 0.8 c 1235 1210 m 62 Y -20 16 d -63 Y f 0 0.4 0.8 c 1235 1272 m 62 Y
- -20 16 d -62 Y f 0 0.6 0.8 c 1235 1334 m 62 Y -20 16 d -62 Y f 0 0.8 0.8 c 1235
- 1396 m 63 Y -20 15 d -62 Y f 0 0.8 0.6 c 1235 1459 m 62 Y -20 15 d -62 Y f 0
- 0.8 0.4 c 1235 1521 m 62 Y -20 15 d -62 Y f 0 0.8 0.2 c 1235 1583 m 62 Y -20 15
- d -62 Y f 0 0.8 0 c 1235 1645 m 62 Y -20 16 d -63 Y f 0.2 0.8 0 c 1235 1707 m
- 19 Y -20 15 d -18 Y f black 1215 1163 m 20 -15 d 578 Y -20 15 d cl s 0.2 0.8 0
- c 1235 1726 m 24 6 d -21 15 d -23 -6 d f black 1235 1726 m 24 6 d -21 15 d -23
- -6 d cl s 0 0 0.8 c 1212 1142 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 1235 1210 m
- 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 1235 1272 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c
- 1235 1334 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 1235 1396 m 63 Y -23 -6 d -63 Y f
- 0 0.8 0.6 c 1235 1459 m 62 Y -23 -6 d -62 Y f 0 0.8 0.4 c 1235 1521 m 62 Y -23
- -6 d -62 Y f 0 0.8 0.2 c 1235 1583 m 35 Y -23 -6 d -35 Y f black 1212 1142 m 23
- 6 d 470 Y -23 -6 d cl s 0 0 0.8 c 1191 1157 m 21 -15 d 62 Y -21 15 d f 0 0.2
- 0.8 c 1212 1204 m 62 Y -21 16 d -63 Y f 0 0.4 0.8 c 1212 1266 m 62 Y -21 16 d
- -62 Y f 0 0.6 0.8 c 1212 1328 m 62 Y -21 16 d -62 Y f 0 0.8 0.8 c 1212 1390 m
- 63 Y -21 15 d -62 Y f 0 0.8 0.6 c 1212 1453 m 62 Y -21 15 d -62 Y f 0 0.8 0.4 c
- 1212 1515 m 62 Y -21 15 d -62 Y f 0 0.8 0.2 c 1212 1577 m 35 Y -21 16 d -36 Y f
- black 1191 1157 m 21 -15 d 470 Y -21 16 d cl s 0 0.8 0.2 c 1212 1612 m 23 6 d
- -20 16 d -24 -6 d f black 1212 1612 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c
- 1188 1136 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1212 1204 m 62 Y -24 -6 d -62 Y
- f 0 0.4 0.8 c 1212 1266 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 1212 1328 m 62 Y
- -24 -6 d -62 Y f 0 0.8 0.8 c 1212 1390 m 63 Y -24 -6 d -63 Y f 0 0.8 0.6 c 1212
- 1453 m 62 Y -24 -6 d -62 Y f 0 0.8 0.4 c 1212 1515 m 62 Y -24 -6 d -62 Y f 0
- 0.8 0.2 c 1212 1577 m 62 Y -24 -6 d -62 Y f 0 0.8 0 c 1212 1639 m 62 Y -24 -6 d
- -62 Y f 0.2 0.8 0 c 1212 1701 m 62 Y -24 -6 d -62 Y f 0.4 0.8 0 c 1212 1763 m
- 51 Y -24 -6 d -51 Y f black 1188 1136 m 24 6 d 672 Y -24 -6 d cl s 0 0 0.8 c
- 1168 1151 m 20 -15 d 62 Y -20 16 d f 0 0.2 0.8 c 1188 1198 m 62 Y -20 16 d -62
- Y f 0 0.4 0.8 c 1188 1260 m 62 Y -20 16 d -62 Y f 0 0.6 0.8 c 1188 1322 m 62 Y
- -20 16 d -62 Y f 0 0.8 0.8 c 1188 1384 m 63 Y -20 15 d -62 Y f 0 0.8 0.6 c 1188
- 1447 m 62 Y -20 15 d -62 Y f 0 0.8 0.4 c 1188 1509 m 62 Y -20 15 d -62 Y f 0
- 0.8 0.2 c 1188 1571 m 62 Y -20 16 d -63 Y f 0 0.8 0 c 1188 1633 m 62 Y -20 16 d
- -62 Y f 0.2 0.8 0 c 1188 1695 m 62 Y -20 16 d -62 Y f 0.4 0.8 0 c 1188 1757 m
- 51 Y -20 15 d -50 Y f black 1168 1151 m 20 -15 d 672 Y -20 15 d cl s 0.4 0.8 0
- c 1188 1808 m 24 6 d -21 15 d -23 -6 d f black 1188 1808 m 24 6 d -21 15 d -23
- -6 d cl s 0 0 0.8 c 1165 1130 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 1188 1198 m
- 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 1188 1260 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c
- 1188 1322 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 1188 1384 m 63 Y -23 -6 d -63 Y f
- 0 0.8 0.6 c 1188 1447 m 62 Y -23 -6 d -62 Y f 0 0.8 0.4 c 1188 1509 m 62 Y -23
- -6 d -62 Y f 0 0.8 0.2 c 1188 1571 m 62 Y -23 -6 d -62 Y f 0 0.8 0 c 1188 1633
- m 62 Y -23 -6 d -62 Y f 0.2 0.8 0 c 1188 1695 m 19 Y -23 -6 d -19 Y f black
- 1165 1130 m 23 6 d 578 Y -23 -6 d cl s 0 0 0.8 c 1144 1145 m 21 -15 d 62 Y -21
- 16 d f 0 0.2 0.8 c 1165 1192 m 62 Y -21 16 d -62 Y f 0 0.4 0.8 c 1165 1254 m 62
- Y -21 16 d -62 Y f 0 0.6 0.8 c 1165 1316 m 62 Y -21 16 d -62 Y f 0 0.8 0.8 c
- 1165 1378 m 63 Y -21 15 d -62 Y f 0 0.8 0.6 c 1165 1441 m 62 Y -21 15 d -62 Y f
- 0 0.8 0.4 c 1165 1503 m 62 Y -21 15 d -62 Y f 0 0.8 0.2 c 1165 1565 m 62 Y -21
- 16 d -63 Y f 0 0.8 0 c 1165 1627 m 62 Y -21 16 d -62 Y f 0.2 0.8 0 c 1165 1689
- m 19 Y -21 15 d -18 Y f black 1144 1145 m 21 -15 d 578 Y -21 15 d cl s 0.2 0.8
- 0 c 1165 1708 m 23 6 d -20 15 d -24 -6 d f black 1165 1708 m 23 6 d -20 15 d
- -24 -6 d cl s 0 0 0.8 c 1141 1124 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1165
- 1192 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 1165 1254 m 62 Y -24 -6 d -62 Y f 0
- 0.6 0.8 c 1165 1316 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 1165 1378 m 63 Y -24 -6
- d -63 Y f 0 0.8 0.6 c 1165 1441 m 62 Y -24 -6 d -62 Y f 0 0.8 0.4 c 1165 1503 m
- 43 Y -24 -6 d -43 Y f black 1141 1124 m 24 6 d 416 Y -24 -6 d cl s 0 0 0.8 c
- 1121 1139 m 20 -15 d 62 Y -20 16 d f 0 0.2 0.8 c 1141 1186 m 62 Y -20 16 d -62
- Y f 0 0.4 0.8 c 1141 1248 m 62 Y -20 16 d -62 Y f 0 0.6 0.8 c 1141 1310 m 62 Y
- -20 16 d -62 Y f 0 0.8 0.8 c 1141 1372 m 63 Y -20 15 d -62 Y f 0 0.8 0.6 c 1141
- 1435 m 62 Y -20 15 d -62 Y f 0 0.8 0.4 c 1141 1497 m 43 Y -20 16 d -44 Y f
- black 1121 1139 m 20 -15 d 416 Y -20 16 d cl s 0 0.8 0.4 c 1141 1540 m 24 6 d
- -21 16 d -23 -6 d f black 1141 1540 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c
- 1118 1118 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 1141 1186 m 62 Y -23 -6 d -62 Y
- f 0 0.4 0.8 c 1141 1248 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c 1141 1310 m 62 Y
- -23 -6 d -62 Y f 0 0.8 0.8 c 1141 1372 m 63 Y -23 -6 d -63 Y f 0 0.8 0.6 c 1141
- 1435 m 62 Y -23 -6 d -62 Y f 0 0.8 0.4 c 1141 1497 m 62 Y -23 -6 d -62 Y f 0
- 0.8 0.2 c 1141 1559 m 62 Y -23 -6 d -62 Y f 0 0.8 0 c 1141 1621 m 27 Y -23 -6 d
- -27 Y f black 1118 1118 m 23 6 d 524 Y -23 -6 d cl s 0 0 0.8 c 1097 1133 m 21
- -15 d 62 Y -21 16 d f 0 0.2 0.8 c 1118 1180 m 62 Y -21 16 d -62 Y f 0 0.4 0.8 c
- 1118 1242 m 62 Y -21 16 d -62 Y f 0 0.6 0.8 c 1118 1304 m 62 Y -21 16 d -62 Y f
- 0 0.8 0.8 c 1118 1366 m 63 Y -21 15 d -62 Y f 0 0.8 0.6 c 1118 1429 m 62 Y -21
- 15 d -62 Y f 0 0.8 0.4 c 1118 1491 m 62 Y -21 15 d -62 Y f 0 0.8 0.2 c 1118
- 1553 m 62 Y -21 16 d -63 Y f 0 0.8 0 c 1118 1615 m 27 Y -21 15 d -26 Y f black
- 1097 1133 m 21 -15 d 524 Y -21 15 d cl s 0 0.8 0 c 1118 1642 m 23 6 d -20 15 d
- -24 -6 d f black 1118 1642 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1094 1112
- m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1118 1180 m 62 Y -24 -6 d -62 Y f 0 0.4
- 0.8 c 1118 1242 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 1118 1304 m 62 Y -24 -6 d
- -62 Y f 0 0.8 0.8 c 1118 1366 m 63 Y -24 -6 d -63 Y f 0 0.8 0.6 c 1118 1429 m
- 62 Y -24 -6 d -62 Y f 0 0.8 0.4 c 1118 1491 m 62 Y -24 -6 d -62 Y f 0 0.8 0.2 c
- 1118 1553 m 62 Y -24 -6 d -62 Y f 0 0.8 0 c 1118 1615 m 62 Y -24 -6 d -62 Y f
- 0.2 0.8 0 c 1118 1677 m 19 Y -24 -6 d -19 Y f black 1094 1112 m 24 6 d 578 Y
- -24 -6 d cl s 0 0 0.8 c 1074 1127 m 20 -15 d 62 Y -20 16 d f 0 0.2 0.8 c 1094
- 1174 m 62 Y -20 16 d -62 Y f 0 0.4 0.8 c 1094 1236 m 62 Y -20 16 d -62 Y f 0
- 0.6 0.8 c 1094 1298 m 62 Y -20 16 d -62 Y f 0 0.8 0.8 c 1094 1360 m 63 Y -20 15
- d -62 Y f 0 0.8 0.6 c 1094 1423 m 62 Y -20 15 d -62 Y f 0 0.8 0.4 c 1094 1485 m
- 62 Y -20 15 d -62 Y f 0 0.8 0.2 c 1094 1547 m 62 Y -20 16 d -63 Y f 0 0.8 0 c
- 1094 1609 m 62 Y -20 16 d -62 Y f 0.2 0.8 0 c 1094 1671 m 19 Y -20 15 d -18 Y f
- black 1074 1127 m 20 -15 d 578 Y -20 15 d cl s 0.2 0.8 0 c 1094 1690 m 24 6 d
- -21 15 d -23 -6 d f black 1094 1690 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c
- 1071 1106 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 1094 1174 m 62 Y -23 -6 d -62 Y
- f 0 0.4 0.8 c 1094 1236 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c 1094 1298 m 62 Y
- -23 -5 d -63 Y f 0 0.8 0.8 c 1094 1360 m 63 Y -23 -6 d -62 Y f 0 0.8 0.6 c 1094
- 1423 m 62 Y -23 -6 d -62 Y f 0 0.8 0.4 c 1094 1485 m 62 Y -23 -6 d -62 Y f 0
- 0.8 0.2 c 1094 1547 m 62 Y -23 -6 d -62 Y f 0 0.8 0 c 1094 1609 m 13 Y -23 -5 d
- -14 Y f black 1071 1106 m 23 6 d 510 Y -23 -5 d cl s 0 0 0.8 c 1050 1121 m 21
- -15 d 62 Y -21 16 d f 0 0.2 0.8 c 1071 1168 m 62 Y -21 16 d -62 Y f 0 0.4 0.8 c
- 1071 1230 m 62 Y -21 16 d -62 Y f 0 0.6 0.8 c 1071 1292 m 63 Y -21 15 d -62 Y f
- 0 0.8 0.8 c 1071 1355 m 62 Y -21 15 d -62 Y f 0 0.8 0.6 c 1071 1417 m 62 Y -21
- 15 d -62 Y f 0 0.8 0.4 c 1071 1479 m 62 Y -21 15 d -62 Y f 0 0.8 0.2 c 1071
- 1541 m 62 Y -21 16 d -63 Y f 0 0.8 0 c 1071 1603 m 14 Y -21 15 d -13 Y f black
- 1050 1121 m 21 -15 d 511 Y -21 15 d cl s 0 0.8 0 c 1071 1617 m 23 5 d -20 16 d
- -24 -6 d f black 1071 1617 m 23 5 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1047 1100
- m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1071 1168 m 62 Y -24 -6 d -62 Y f 0 0.4
- 0.8 c 1071 1230 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 1071 1292 m 63 Y -24 -6 d
- -63 Y f 0 0.8 0.8 c 1071 1355 m 62 Y -24 -6 d -62 Y f 0 0.8 0.6 c 1071 1417 m
- 62 Y -24 -6 d -62 Y f 0 0.8 0.4 c 1071 1479 m 62 Y -24 -6 d -62 Y f 0 0.8 0.2 c
- 1071 1541 m 62 Y -24 -6 d -62 Y f 0 0.8 0 c 1071 1603 m 62 Y -24 -6 d -62 Y f
- 0.2 0.8 0 c 1071 1665 m 62 Y -24 -6 d -62 Y f 0.4 0.8 0 c 1071 1727 m 10 Y -24
- -6 d -10 Y f black 1047 1100 m 24 6 d 631 Y -24 -6 d cl s 0 0 0.8 c 1027 1115 m
- 20 -15 d 62 Y -20 16 d f 0 0.2 0.8 c 1047 1162 m 62 Y -20 16 d -62 Y f 0 0.4
- 0.8 c 1047 1224 m 62 Y -20 16 d -62 Y f 0 0.6 0.8 c 1047 1286 m 63 Y -20 15 d
- -62 Y f 0 0.8 0.8 c 1047 1349 m 62 Y -20 15 d -62 Y f 0 0.8 0.6 c 1047 1411 m
- 62 Y -20 15 d -62 Y f 0 0.8 0.4 c 1047 1473 m 62 Y -20 15 d -62 Y f 0 0.8 0.2 c
- 1047 1535 m 62 Y -20 16 d -63 Y f 0 0.8 0 c 1047 1597 m 62 Y -20 16 d -62 Y f
- 0.2 0.8 0 c 1047 1659 m 62 Y -20 16 d -62 Y f 0.4 0.8 0 c 1047 1721 m 10 Y -20
- 16 d -10 Y f black 1027 1115 m 20 -15 d 631 Y -20 16 d cl s 0.4 0.8 0 c 1047
- 1731 m 24 6 d -21 16 d -23 -6 d f black 1047 1731 m 24 6 d -21 16 d -23 -6 d
- cl s 0 0 0.8 c 1024 1094 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 1047 1162 m 62 Y
- -23 -6 d -62 Y f 0 0.4 0.8 c 1047 1224 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c 1047
- 1286 m 63 Y -23 -6 d -63 Y f 0 0.8 0.8 c 1047 1349 m 62 Y -23 -6 d -62 Y f 0
- 0.8 0.6 c 1047 1411 m 62 Y -23 -6 d -62 Y f 0 0.8 0.4 c 1047 1473 m 62 Y -23 -6
- d -62 Y f 0 0.8 0.2 c 1047 1535 m 49 Y -23 -6 d -49 Y f black 1024 1094 m 23 6
- d 484 Y -23 -6 d cl s 0 0 0.8 c 1004 1110 m 20 -16 d 62 Y -20 16 d f 0 0.2 0.8
- c 1024 1156 m 62 Y -20 16 d -62 Y f 0 0.4 0.8 c 1024 1218 m 62 Y -20 16 d -62 Y
- f 0 0.6 0.8 c 1024 1280 m 63 Y -20 15 d -62 Y f 0 0.8 0.8 c 1024 1343 m 62 Y
- -20 15 d -62 Y f 0 0.8 0.6 c 1024 1405 m 62 Y -20 15 d -62 Y f 0 0.8 0.4 c 1024
- 1467 m 62 Y -20 16 d -63 Y f 0 0.8 0.2 c 1024 1529 m 49 Y -20 15 d -48 Y f
- black 1004 1110 m 20 -16 d 484 Y -20 15 d cl s 0 0.8 0.2 c 1024 1578 m 23 6 d
- -20 15 d -23 -6 d f black 1024 1578 m 23 6 d -20 15 d -23 -6 d cl s 0 0 0.8 c
- 1000 1088 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1024 1156 m 62 Y -24 -6 d -62 Y
- f 0 0.4 0.8 c 1024 1218 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 1024 1280 m 63 Y
- -24 -6 d -63 Y f 0 0.8 0.8 c 1024 1343 m 62 Y -24 -6 d -62 Y f 0 0.8 0.6 c 1024
- 1405 m 62 Y -24 -6 d -62 Y f 0 0.8 0.4 c 1024 1467 m 62 Y -24 -6 d -62 Y f 0
- 0.8 0.2 c 1024 1529 m 35 Y -24 -6 d -35 Y f black 1000 1088 m 24 6 d 470 Y -24
- -6 d cl s 0 0 0.8 c 980 1104 m 20 -16 d 62 Y -20 16 d f 0 0.2 0.8 c 1000 1150 m
- 62 Y -20 16 d -62 Y f 0 0.4 0.8 c 1000 1212 m 62 Y -20 16 d -62 Y f 0 0.6 0.8 c
- 1000 1274 m 63 Y -20 15 d -62 Y f 0 0.8 0.8 c 1000 1337 m 62 Y -20 15 d -62 Y f
- 0 0.8 0.6 c 1000 1399 m 62 Y -20 15 d -62 Y f 0 0.8 0.4 c 1000 1461 m 62 Y -20
- 16 d -63 Y f 0 0.8 0.2 c 1000 1523 m 35 Y -20 16 d -35 Y f black 980 1104 m 20
- -16 d 470 Y -20 16 d cl s 0 0.8 0.2 c 1000 1558 m 24 6 d -20 16 d -24 -6 d f
- black 1000 1558 m 24 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 977 1082 m 23 6 d 62
- Y -23 -6 d f 0 0.2 0.8 c 1000 1150 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 1000
- 1212 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c 1000 1274 m 63 Y -23 -6 d -63 Y f 0
- 0.8 0.8 c 1000 1337 m 62 Y -23 -6 d -62 Y f 0 0.8 0.6 c 1000 1399 m 62 Y -23 -6
- d -62 Y f 0 0.8 0.4 c 1000 1461 m 62 Y -23 -6 d -62 Y f 0 0.8 0.2 c 1000 1523 m
- 62 Y -23 -6 d -62 Y f 0 0.8 0 c 1000 1585 m 14 Y -23 -6 d -14 Y f black 977
- 1082 m 23 6 d 511 Y -23 -6 d cl s 0 0 0.8 c 957 1098 m 20 -16 d 62 Y -20 16 d f
- 0 0.2 0.8 c 977 1144 m 62 Y -20 16 d -62 Y f 0 0.4 0.8 c 977 1206 m 62 Y -20 16
- d -62 Y f 0 0.6 0.8 c 977 1268 m 63 Y -20 15 d -62 Y f 0 0.8 0.8 c 977 1331 m
- 62 Y -20 15 d -62 Y f 0 0.8 0.6 c 977 1393 m 62 Y -20 15 d -62 Y f 0 0.8 0.4 c
- 977 1455 m 62 Y -20 16 d -63 Y f 0 0.8 0.2 c 977 1517 m 62 Y -20 16 d -62 Y f 0
- 0.8 0 c 977 1579 m 14 Y -20 15 d -13 Y f black 957 1098 m 20 -16 d 511 Y -20 15
- d cl s 0 0.8 0 c 977 1593 m 23 6 d -20 15 d -23 -6 d f black 977 1593 m 23 6 d
- -20 15 d -23 -6 d cl s 0 0 0.8 c 953 1076 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c
- 977 1144 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 977 1206 m 62 Y -24 -6 d -62 Y f 0
- 0.6 0.8 c 977 1268 m 63 Y -24 -6 d -63 Y f 0 0.8 0.8 c 977 1331 m 62 Y -24 -6 d
- -62 Y f 0 0.8 0.6 c 977 1393 m 62 Y -24 -6 d -62 Y f 0 0.8 0.4 c 977 1455 m 62
- Y -24 -6 d -62 Y f 0 0.8 0.2 c 977 1517 m 62 Y -24 -6 d -62 Y f 0 0.8 0 c 977
- 1579 m 62 Y -24 -6 d -62 Y f 0.2 0.8 0 c 977 1641 m 62 Y -24 -6 d -62 Y f 0.4
- 0.8 0 c 977 1703 m 24 Y -24 -6 d -24 Y f black 953 1076 m 24 6 d 645 Y -24 -6 d
- cl s 0 0 0.8 c 933 1092 m 20 -16 d 62 Y -20 16 d f 0 0.2 0.8 c 953 1138 m 62 Y
- -20 16 d -62 Y f 0 0.4 0.8 c 953 1200 m 62 Y -20 16 d -62 Y f 0 0.6 0.8 c 953
- 1262 m 63 Y -20 15 d -62 Y f 0 0.8 0.8 c 953 1325 m 62 Y -20 15 d -62 Y f 0 0.8
- 0.6 c 953 1387 m 62 Y -20 15 d -62 Y f 0 0.8 0.4 c 953 1449 m 62 Y -20 16 d -63
- Y f 0 0.8 0.2 c 953 1511 m 62 Y -20 16 d -62 Y f 0 0.8 0 c 953 1573 m 62 Y -20
- 16 d -62 Y f 0.2 0.8 0 c 953 1635 m 62 Y -20 16 d -62 Y f 0.4 0.8 0 c 953 1697
- m 24 Y -20 16 d -24 Y f black 933 1092 m 20 -16 d 645 Y -20 16 d cl s 0.4 0.8 0
- c 953 1721 m 24 6 d -20 15 d -24 -5 d f black 953 1721 m 24 6 d -20 15 d -24 -5
- d cl s 0 0 0.8 c 930 1070 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 953 1138 m 62 Y
- -23 -6 d -62 Y f 0 0.4 0.8 c 953 1200 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c 953
- 1262 m 63 Y -23 -6 d -63 Y f 0 0.8 0.8 c 953 1325 m 62 Y -23 -6 d -62 Y f 0 0.8
- 0.6 c 953 1387 m 62 Y -23 -6 d -62 Y f 0 0.8 0.4 c 953 1449 m 62 Y -23 -6 d -62
- Y f 0 0.8 0.2 c 953 1511 m 62 Y -23 -6 d -62 Y f 0 0.8 0 c 953 1573 m 62 Y -23
- -6 d -62 Y f 0.2 0.8 0 c 953 1635 m 62 Y -23 -6 d -62 Y f 0.4 0.8 0 c 953 1697
- m 63 Y -23 -6 d -63 Y f 0.6 0.8 0 c 953 1760 m 28 Y -23 -6 d -28 Y f black 930
- 1070 m 23 6 d 712 Y -23 -6 d cl s 0 0 0.8 c 910 1086 m 20 -16 d 62 Y -20 16 d f
- 0 0.2 0.8 c 930 1132 m 62 Y -20 16 d -62 Y f 0 0.4 0.8 c 930 1194 m 62 Y -20 16
- d -62 Y f 0 0.6 0.8 c 930 1256 m 63 Y -20 15 d -62 Y f 0 0.8 0.8 c 930 1319 m
- 62 Y -20 15 d -62 Y f 0 0.8 0.6 c 930 1381 m 62 Y -20 15 d -62 Y f 0 0.8 0.4 c
- 930 1443 m 62 Y -20 16 d -63 Y f 0 0.8 0.2 c 930 1505 m 62 Y -20 16 d -62 Y f 0
- 0.8 0 c 930 1567 m 62 Y -20 16 d -62 Y f 0.2 0.8 0 c 930 1629 m 62 Y -20 16 d
- -62 Y f 0.4 0.8 0 c 930 1691 m 63 Y -20 15 d -62 Y f 0.6 0.8 0 c 930 1754 m 28
- Y -20 16 d -29 Y f black 910 1086 m 20 -16 d 712 Y -20 16 d cl s 0.6 0.8 0 c
- 930 1782 m 23 6 d -20 16 d -23 -6 d f black 930 1782 m 23 6 d -20 16 d -23 -6 d
- cl s 0 0 0.8 c 906 1064 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 930 1132 m 62 Y
- -24 -6 d -62 Y f 0 0.4 0.8 c 930 1194 m 62 Y -24 -5 d -63 Y f 0 0.6 0.8 c 930
- 1256 m 63 Y -24 -6 d -62 Y f 0 0.8 0.8 c 930 1319 m 62 Y -24 -6 d -62 Y f 0 0.8
- 0.6 c 930 1381 m 62 Y -24 -6 d -62 Y f 0 0.8 0.4 c 930 1443 m 62 Y -24 -6 d -62
- Y f 0 0.8 0.2 c 930 1505 m 62 Y -24 -6 d -62 Y f black 906 1064 m 24 6 d 497 Y
- -24 -6 d cl s 0 0 0.8 c 886 1080 m 20 -16 d 62 Y -20 16 d f 0 0.2 0.8 c 906
- 1126 m 62 Y -20 16 d -62 Y f 0 0.4 0.8 c 906 1188 m 63 Y -20 15 d -62 Y f 0 0.6
- 0.8 c 906 1251 m 62 Y -20 15 d -62 Y f 0 0.8 0.8 c 906 1313 m 62 Y -20 15 d -62
- Y f 0 0.8 0.6 c 906 1375 m 62 Y -20 15 d -62 Y f 0 0.8 0.4 c 906 1437 m 62 Y
- -20 16 d -63 Y f 0 0.8 0.2 c 906 1499 m 62 Y -20 16 d -62 Y f black 886 1080 m
- 20 -16 d 497 Y -20 16 d cl s 0 0.8 0.2 c 906 1561 m 24 6 d -20 16 d -24 -6 d f
- 0 0.8 0 c 906 1561 m 24 6 d -20 16 d -24 -6 d f black 906 1561 m 24 6 d -20 16
- d -24 -6 d cl s 0 0 0.8 c 883 1058 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 906
- 1126 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 906 1188 m 63 Y -23 -6 d -63 Y f 0 0.6
- 0.8 c 906 1251 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 906 1313 m 62 Y -23 -6 d -62
- Y f 0 0.8 0.6 c 906 1375 m 62 Y -23 -6 d -62 Y f 0 0.8 0.4 c 906 1437 m 62 Y
- -23 -6 d -62 Y f 0 0.8 0.2 c 906 1499 m 62 Y -23 -6 d -62 Y f 0 0.8 0 c 906
- 1561 m 41 Y -23 -6 d -41 Y f black 883 1058 m 23 6 d 538 Y -23 -6 d cl s 0 0
- 0.8 c 863 1074 m 20 -16 d 62 Y -20 16 d f 0 0.2 0.8 c 883 1120 m 62 Y -20 16 d
- -62 Y f 0 0.4 0.8 c 883 1182 m 63 Y -20 15 d -62 Y f 0 0.6 0.8 c 883 1245 m 62
- Y -20 15 d -62 Y f 0 0.8 0.8 c 883 1307 m 62 Y -20 15 d -62 Y f 0 0.8 0.6 c 883
- 1369 m 62 Y -20 15 d -62 Y f 0 0.8 0.4 c 883 1431 m 62 Y -20 16 d -63 Y f 0 0.8
- 0.2 c 883 1493 m 62 Y -20 16 d -62 Y f 0 0.8 0 c 883 1555 m 41 Y -20 15 d -40 Y
- f black 863 1074 m 20 -16 d 538 Y -20 15 d cl s 0 0.8 0 c 883 1596 m 23 6 d -20
- 15 d -23 -6 d f black 883 1596 m 23 6 d -20 15 d -23 -6 d cl s 0 0 0.8 c 859
- 1052 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 883 1120 m 62 Y -24 -6 d -62 Y f 0
- 0.4 0.8 c 883 1182 m 63 Y -24 -6 d -63 Y f 0 0.6 0.8 c 883 1245 m 62 Y -24 -6 d
- -62 Y f 0 0.8 0.8 c 883 1307 m 62 Y -24 -6 d -62 Y f 0 0.8 0.6 c 883 1369 m 62
- Y -24 -6 d -62 Y f 0 0.8 0.4 c 883 1431 m 62 Y -24 -6 d -62 Y f 0 0.8 0.2 c 883
- 1493 m 62 Y -24 -6 d -62 Y f 0 0.8 0 c 883 1555 m 62 Y -24 -6 d -62 Y f 0.2 0.8
- 0 c 883 1617 m 63 Y -24 -6 d -63 Y f 0.4 0.8 0 c 883 1680 m 50 Y -24 -6 d -50 Y
- f black 859 1052 m 24 6 d 672 Y -24 -6 d cl s 0 0 0.8 c 839 1068 m 20 -16 d 62
- Y -20 16 d f 0 0.2 0.8 c 859 1114 m 62 Y -20 16 d -62 Y f 0 0.4 0.8 c 859 1176
- m 63 Y -20 15 d -62 Y f 0 0.6 0.8 c 859 1239 m 62 Y -20 15 d -62 Y f 0 0.8 0.8
- c 859 1301 m 62 Y -20 15 d -62 Y f 0 0.8 0.6 c 859 1363 m 62 Y -20 16 d -63 Y f
- 0 0.8 0.4 c 859 1425 m 62 Y -20 16 d -62 Y f 0 0.8 0.2 c 859 1487 m 62 Y -20 16
- d -62 Y f 0 0.8 0 c 859 1549 m 62 Y -20 16 d -62 Y f 0.2 0.8 0 c 859 1611 m 63
- Y -20 15 d -62 Y f 0.4 0.8 0 c 859 1674 m 50 Y -20 15 d -50 Y f black 839 1068
- m 20 -16 d 672 Y -20 15 d cl s 0.4 0.8 0 c 859 1724 m 24 6 d -20 15 d -24 -6 d
- f black 859 1724 m 24 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 836 1046 m 23 6 d 62
- Y -23 -6 d f 0 0.2 0.8 c 859 1114 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 859 1176
- m 63 Y -23 -6 d -63 Y f 0 0.6 0.8 c 859 1239 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8
- c 859 1301 m 62 Y -23 -6 d -62 Y f 0 0.8 0.6 c 859 1363 m 62 Y -23 -6 d -62 Y f
- 0 0.8 0.4 c 859 1425 m 30 Y -23 -6 d -30 Y f black 836 1046 m 23 6 d 403 Y -23
- -6 d cl s 0 0 0.8 c 816 1062 m 20 -16 d 62 Y -20 16 d f 0 0.2 0.8 c 836 1108 m
- 62 Y -20 16 d -62 Y f 0 0.4 0.8 c 836 1170 m 63 Y -20 15 d -62 Y f 0 0.6 0.8 c
- 836 1233 m 62 Y -20 15 d -62 Y f 0 0.8 0.8 c 836 1295 m 62 Y -20 15 d -62 Y f 0
- 0.8 0.6 c 836 1357 m 62 Y -20 16 d -63 Y f 0 0.8 0.4 c 836 1419 m 30 Y -20 16 d
- -30 Y f black 816 1062 m 20 -16 d 403 Y -20 16 d cl s 0 0.8 0.4 c 836 1449 m 23
- 6 d -20 16 d -23 -6 d f black 836 1449 m 23 6 d -20 16 d -23 -6 d cl s 0 0 0.8
- c 812 1040 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 836 1108 m 62 Y -24 -6 d -62 Y
- f 0 0.4 0.8 c 836 1170 m 63 Y -24 -6 d -63 Y f 0 0.6 0.8 c 836 1233 m 62 Y -24
- -6 d -62 Y f 0 0.8 0.8 c 836 1295 m 62 Y -24 -6 d -62 Y f 0 0.8 0.6 c 836 1357
- m 62 Y -24 -6 d -62 Y f 0 0.8 0.4 c 836 1419 m 62 Y -24 -6 d -62 Y f 0 0.8 0.2
- c 836 1481 m 62 Y -24 -6 d -62 Y f 0 0.8 0 c 836 1543 m 62 Y -24 -6 d -62 Y f
- 0.2 0.8 0 c 836 1605 m 19 Y -24 -6 d -19 Y f black 812 1040 m 24 6 d 578 Y -24
- -6 d cl s 0 0 0.8 c 792 1056 m 20 -16 d 62 Y -20 16 d f 0 0.2 0.8 c 812 1102 m
- 62 Y -20 16 d -62 Y f 0 0.4 0.8 c 812 1164 m 63 Y -20 15 d -62 Y f 0 0.6 0.8 c
- 812 1227 m 62 Y -20 15 d -62 Y f 0 0.8 0.8 c 812 1289 m 62 Y -20 15 d -62 Y f 0
- 0.8 0.6 c 812 1351 m 62 Y -20 16 d -63 Y f 0 0.8 0.4 c 812 1413 m 62 Y -20 16 d
- -62 Y f 0 0.8 0.2 c 812 1475 m 62 Y -20 16 d -62 Y f 0 0.8 0 c 812 1537 m 62 Y
- -20 16 d -62 Y f 0.2 0.8 0 c 812 1599 m 19 Y -20 15 d -18 Y f black 792 1056 m
- 20 -16 d 578 Y -20 15 d cl s 0.2 0.8 0 c 812 1618 m 24 6 d -20 15 d -24 -6 d f
- black 812 1618 m 24 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 789 1034 m 23 6 d 62 Y
- -23 -6 d f 0 0.2 0.8 c 812 1102 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 812 1164 m
- 63 Y -23 -6 d -63 Y f 0 0.6 0.8 c 812 1227 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c
- 812 1289 m 62 Y -23 -6 d -62 Y f 0 0.8 0.6 c 812 1351 m 62 Y -23 -6 d -62 Y f 0
- 0.8 0.4 c 812 1413 m 62 Y -23 -6 d -62 Y f 0 0.8 0.2 c 812 1475 m 62 Y -23 -6 d
- -62 Y f 0 0.8 0 c 812 1537 m 41 Y -23 -6 d -41 Y f black 789 1034 m 23 6 d 538
- Y -23 -6 d cl s 0 0 0.8 c 769 1050 m 20 -16 d 62 Y -20 16 d f 0 0.2 0.8 c 789
- 1096 m 62 Y -20 16 d -62 Y f 0 0.4 0.8 c 789 1158 m 63 Y -20 15 d -62 Y f 0 0.6
- 0.8 c 789 1221 m 62 Y -20 15 d -62 Y f 0 0.8 0.8 c 789 1283 m 62 Y -20 15 d -62
- Y f 0 0.8 0.6 c 789 1345 m 62 Y -20 16 d -63 Y f 0 0.8 0.4 c 789 1407 m 62 Y
- -20 16 d -62 Y f 0 0.8 0.2 c 789 1469 m 62 Y -20 16 d -62 Y f 0 0.8 0 c 789
- 1531 m 41 Y -20 15 d -40 Y f black 769 1050 m 20 -16 d 538 Y -20 15 d cl s 0
- 0.8 0 c 789 1572 m 23 6 d -20 15 d -23 -6 d f black 789 1572 m 23 6 d -20 15 d
- -23 -6 d cl s 0 0 0.8 c 765 1028 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 789 1096
- m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 789 1158 m 63 Y -24 -6 d -63 Y f 0 0.6 0.8
- c 789 1221 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 789 1283 m 62 Y -24 -6 d -62 Y f
- 0 0.8 0.6 c 789 1345 m 62 Y -24 -6 d -62 Y f 0 0.8 0.4 c 789 1407 m 62 Y -24 -6
- d -62 Y f 0 0.8 0.2 c 789 1469 m 62 Y -24 -6 d -62 Y f 0 0.8 0 c 789 1531 m 62
- Y -24 -6 d -62 Y f 0.2 0.8 0 c 789 1593 m 63 Y -24 -6 d -63 Y f 0.4 0.8 0 c 789
- 1656 m 62 Y -24 -6 d -62 Y f 0.6 0.8 0 c 789 1718 m 55 Y -24 -6 d -55 Y f black
- 765 1028 m 24 6 d 739 Y -24 -6 d cl s 0 0 0.8 c 745 1044 m 20 -16 d 62 Y -20 16
- d f 0 0.2 0.8 c 765 1090 m 62 Y -20 16 d -62 Y f 0 0.4 0.8 c 765 1152 m 63 Y
- -20 15 d -62 Y f 0 0.6 0.8 c 765 1215 m 62 Y -20 15 d -62 Y f 0 0.8 0.8 c 765
- 1277 m 62 Y -20 15 d -62 Y f 0 0.8 0.6 c 765 1339 m 62 Y -20 16 d -63 Y f 0 0.8
- 0.4 c 765 1401 m 62 Y -20 16 d -62 Y f 0 0.8 0.2 c 765 1463 m 62 Y -20 16 d -62
- Y f 0 0.8 0 c 765 1525 m 62 Y -20 16 d -62 Y f 0.2 0.8 0 c 765 1587 m 63 Y -20
- 15 d -62 Y f 0.4 0.8 0 c 765 1650 m 62 Y -20 15 d -62 Y f 0.6 0.8 0 c 765 1712
- m 55 Y -20 16 d -56 Y f black 745 1044 m 20 -16 d 739 Y -20 16 d cl s 0.6 0.8 0
- c 765 1767 m 24 6 d -20 16 d -24 -6 d f black 765 1767 m 24 6 d -20 16 d -24 -6
- d cl s 0 0 0.8 c 742 1022 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 765 1090 m 62 Y
- -23 -5 d -63 Y f 0 0.4 0.8 c 765 1152 m 63 Y -23 -6 d -62 Y f 0 0.6 0.8 c 765
- 1215 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 765 1277 m 62 Y -23 -6 d -62 Y f 0 0.8
- 0.6 c 765 1339 m 62 Y -23 -6 d -62 Y f 0 0.8 0.4 c 765 1401 m 62 Y -23 -6 d -62
- Y f 0 0.8 0.2 c 765 1463 m 62 Y -23 -6 d -62 Y f 0 0.8 0 c 765 1525 m 62 Y -23
- -6 d -62 Y f 0.2 0.8 0 c 765 1587 m 32 Y -23 -6 d -32 Y f black 742 1022 m 23 6
- d 591 Y -23 -6 d cl s 0 0 0.8 c 722 1038 m 20 -16 d 62 Y -20 16 d f 0 0.2 0.8 c
- 742 1084 m 63 Y -20 15 d -62 Y f 0 0.4 0.8 c 742 1147 m 62 Y -20 15 d -62 Y f 0
- 0.6 0.8 c 742 1209 m 62 Y -20 15 d -62 Y f 0 0.8 0.8 c 742 1271 m 62 Y -20 15 d
- -62 Y f 0 0.8 0.6 c 742 1333 m 62 Y -20 16 d -63 Y f 0 0.8 0.4 c 742 1395 m 62
- Y -20 16 d -62 Y f 0 0.8 0.2 c 742 1457 m 62 Y -20 16 d -62 Y f 0 0.8 0 c 742
- 1519 m 62 Y -20 16 d -62 Y f 0.2 0.8 0 c 742 1581 m 32 Y -20 16 d -32 Y f black
- 722 1038 m 20 -16 d 591 Y -20 16 d cl s 0.2 0.8 0 c 742 1613 m 23 6 d -20 16 d
- -23 -6 d f black 742 1613 m 23 6 d -20 16 d -23 -6 d cl s 0 0 0.8 c 718 1016 m
- 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 742 1084 m 63 Y -24 -6 d -63 Y f 0 0.4 0.8 c
- 742 1147 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 742 1209 m 62 Y -24 -6 d -62 Y f 0
- 0.8 0.8 c 742 1271 m 62 Y -24 -6 d -62 Y f 0 0.8 0.6 c 742 1333 m 62 Y -24 -6 d
- -62 Y f 0 0.8 0.4 c 742 1395 m 62 Y -24 -6 d -62 Y f 0 0.8 0.2 c 742 1457 m 62
- Y -24 -6 d -62 Y f black 718 1016 m 24 6 d 497 Y -24 -6 d cl s 0 0 0.8 c 698
- 1032 m 20 -16 d 62 Y -20 16 d f 0 0.2 0.8 c 718 1078 m 63 Y -20 15 d -62 Y f 0
- 0.4 0.8 c 718 1141 m 62 Y -20 15 d -62 Y f 0 0.6 0.8 c 718 1203 m 62 Y -20 15 d
- -62 Y f 0 0.8 0.8 c 718 1265 m 62 Y -20 15 d -62 Y f 0 0.8 0.6 c 718 1327 m 62
- Y -20 16 d -63 Y f 0 0.8 0.4 c 718 1389 m 62 Y -20 16 d -62 Y f 0 0.8 0.2 c 718
- 1451 m 62 Y -20 16 d -62 Y f black 698 1032 m 20 -16 d 497 Y -20 16 d cl s 0
- 0.8 0.2 c 718 1513 m 24 6 d -20 16 d -24 -6 d f 0 0.8 0 c 718 1513 m 24 6 d -20
- 16 d -24 -6 d f black 718 1513 m 24 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 695
- 1010 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 718 1078 m 63 Y -23 -6 d -63 Y f 0
- 0.4 0.8 c 718 1141 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c 718 1203 m 62 Y -23 -6 d
- -62 Y f 0 0.8 0.8 c 718 1265 m 62 Y -23 -6 d -62 Y f 0 0.8 0.6 c 718 1327 m 62
- Y -23 -6 d -62 Y f 0 0.8 0.4 c 718 1389 m 62 Y -23 -6 d -62 Y f 0 0.8 0.2 c 718
- 1451 m 62 Y -23 -6 d -62 Y f 0 0.8 0 c 718 1513 m 54 Y -23 -6 d -54 Y f black
- 695 1010 m 23 6 d 551 Y -23 -6 d cl s 0 0 0.8 c 675 1026 m 20 -16 d 62 Y -20 16
- d f 0 0.2 0.8 c 695 1072 m 63 Y -20 15 d -62 Y f 0 0.4 0.8 c 695 1135 m 62 Y
- -20 15 d -62 Y f 0 0.6 0.8 c 695 1197 m 62 Y -20 15 d -62 Y f 0 0.8 0.8 c 695
- 1259 m 62 Y -20 16 d -63 Y f 0 0.8 0.6 c 695 1321 m 62 Y -20 16 d -62 Y f 0 0.8
- 0.4 c 695 1383 m 62 Y -20 16 d -62 Y f 0 0.8 0.2 c 695 1445 m 62 Y -20 16 d -62
- Y f 0 0.8 0 c 695 1507 m 54 Y -20 16 d -54 Y f black 675 1026 m 20 -16 d 551 Y
- -20 16 d cl s 0 0.8 0 c 695 1561 m 23 6 d -20 16 d -23 -6 d f black 695 1561 m
- 23 6 d -20 16 d -23 -6 d cl s 0 0 0.8 c 672 1004 m 23 6 d 62 Y -23 -6 d f 0 0.2
- 0.8 c 695 1072 m 63 Y -23 -6 d -63 Y f 0 0.4 0.8 c 695 1135 m 62 Y -23 -6 d -62
- Y f 0 0.6 0.8 c 695 1197 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 695 1259 m 62 Y
- -23 -6 d -62 Y f 0 0.8 0.6 c 695 1321 m 62 Y -23 -6 d -62 Y f 0 0.8 0.4 c 695
- 1383 m 62 Y -23 -6 d -62 Y f 0 0.8 0.2 c 695 1445 m 62 Y -23 -6 d -62 Y f 0 0.8
- 0 c 695 1507 m 63 Y -23 -6 d -63 Y f 0.2 0.8 0 c 695 1570 m 62 Y -23 -6 d -62 Y
- f 0.4 0.8 0 c 695 1632 m 62 Y -23 -6 d -62 Y f 0.6 0.8 0 c 695 1694 m 15 Y -23
- -6 d -15 Y f black 672 1004 m 23 6 d 699 Y -23 -6 d cl s 0 0 0.8 c 651 1020 m
- 21 -16 d 62 Y -21 16 d f 0 0.2 0.8 c 672 1066 m 63 Y -21 15 d -62 Y f 0 0.4 0.8
- c 672 1129 m 62 Y -21 15 d -62 Y f 0 0.6 0.8 c 672 1191 m 62 Y -21 15 d -62 Y f
- 0 0.8 0.8 c 672 1253 m 62 Y -21 16 d -63 Y f 0 0.8 0.6 c 672 1315 m 62 Y -21 16
- d -62 Y f 0 0.8 0.4 c 672 1377 m 62 Y -21 16 d -62 Y f 0 0.8 0.2 c 672 1439 m
- 62 Y -21 16 d -62 Y f 0 0.8 0 c 672 1501 m 63 Y -21 15 d -62 Y f 0.2 0.8 0 c
- 672 1564 m 62 Y -21 15 d -62 Y f 0.4 0.8 0 c 672 1626 m 62 Y -21 15 d -62 Y f
- 0.6 0.8 0 c 672 1688 m 15 Y -21 15 d -15 Y f black 651 1020 m 21 -16 d 699 Y
- -21 15 d cl s 0.6 0.8 0 c 672 1703 m 23 6 d -20 15 d -24 -6 d f black 672 1703
- m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 648 998 m 24 6 d 62 Y -24 -6 d f 0
- 0.2 0.8 c 672 1066 m 63 Y -24 -6 d -63 Y f 0 0.4 0.8 c 672 1129 m 62 Y -24 -6 d
- -62 Y f 0 0.6 0.8 c 672 1191 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 672 1253 m 62
- Y -24 -6 d -62 Y f 0 0.8 0.6 c 672 1315 m 62 Y -24 -6 d -62 Y f 0 0.8 0.4 c 672
- 1377 m 62 Y -24 -6 d -62 Y f 0 0.8 0.2 c 672 1439 m 62 Y -24 -6 d -62 Y f 0 0.8
- 0 c 672 1501 m 63 Y -24 -6 d -63 Y f 0.2 0.8 0 c 672 1564 m 18 Y -24 -6 d -18 Y
- f black 648 998 m 24 6 d 578 Y -24 -6 d cl s 0 0 0.8 c 628 1014 m 20 -16 d 62 Y
- -20 16 d f 0 0.2 0.8 c 648 1060 m 63 Y -20 15 d -62 Y f 0 0.4 0.8 c 648 1123 m
- 62 Y -20 15 d -62 Y f 0 0.6 0.8 c 648 1185 m 62 Y -20 15 d -62 Y f 0 0.8 0.8 c
- 648 1247 m 62 Y -20 16 d -63 Y f 0 0.8 0.6 c 648 1309 m 62 Y -20 16 d -62 Y f 0
- 0.8 0.4 c 648 1371 m 62 Y -20 16 d -62 Y f 0 0.8 0.2 c 648 1433 m 62 Y -20 16 d
- -62 Y f 0 0.8 0 c 648 1495 m 63 Y -20 15 d -62 Y f 0.2 0.8 0 c 648 1558 m 18 Y
- -20 16 d -19 Y f black 628 1014 m 20 -16 d 578 Y -20 16 d cl s 0.2 0.8 0 c 648
- 1576 m 24 6 d -21 16 d -23 -6 d f black 648 1576 m 24 6 d -21 16 d -23 -6 d
- cl s 0 0 0.8 c 625 992 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 648 1060 m 63 Y -23
- -6 d -63 Y f 0 0.4 0.8 c 648 1123 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c 648 1185
- m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 648 1247 m 62 Y -23 -6 d -62 Y f 0 0.8 0.6
- c 648 1309 m 62 Y -23 -6 d -62 Y f 0 0.8 0.4 c 648 1371 m 62 Y -23 -6 d -62 Y f
- 0 0.8 0.2 c 648 1433 m 62 Y -23 -6 d -62 Y f 0 0.8 0 c 648 1495 m 63 Y -23 -6 d
- -63 Y f 0.2 0.8 0 c 648 1558 m 62 Y -23 -6 d -62 Y f 0.4 0.8 0 c 648 1620 m 62
- Y -23 -6 d -62 Y f 0.6 0.8 0 c 648 1682 m 2 Y -23 -6 d -2 Y f black 625 992 m
- 23 6 d 686 Y -23 -6 d cl s 0 0 0.8 c 604 1008 m 21 -16 d 62 Y -21 16 d f 0 0.2
- 0.8 c 625 1054 m 63 Y -21 15 d -62 Y f 0 0.4 0.8 c 625 1117 m 62 Y -21 15 d -62
- Y f 0 0.6 0.8 c 625 1179 m 62 Y -21 15 d -62 Y f 0 0.8 0.8 c 625 1241 m 62 Y
- -21 16 d -63 Y f 0 0.8 0.6 c 625 1303 m 62 Y -21 16 d -62 Y f 0 0.8 0.4 c 625
- 1365 m 62 Y -21 16 d -62 Y f 0 0.8 0.2 c 625 1427 m 62 Y -21 16 d -62 Y f 0 0.8
- 0 c 625 1489 m 63 Y -21 15 d -62 Y f 0.2 0.8 0 c 625 1552 m 62 Y -21 15 d -62 Y
- f 0.4 0.8 0 c 625 1614 m 62 Y -21 15 d -62 Y f 0.6 0.8 0 c 625 1676 m 2 Y -21
- 15 d -2 Y f black 604 1008 m 21 -16 d 686 Y -21 15 d cl s 0.6 0.8 0 c 625 1678
- m 23 6 d -20 15 d -24 -6 d f black 625 1678 m 23 6 d -20 15 d -24 -6 d cl s 0 0
- 0.8 c 601 986 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 625 1054 m 63 Y -24 -6 d -63
- Y f 0 0.4 0.8 c 625 1117 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 625 1179 m 62 Y
- -24 -6 d -62 Y f 0 0.8 0.8 c 625 1241 m 62 Y -24 -6 d -62 Y f 0 0.8 0.6 c 625
- 1303 m 62 Y -24 -6 d -62 Y f 0 0.8 0.4 c 625 1365 m 62 Y -24 -6 d -62 Y f 0 0.8
- 0.2 c 625 1427 m 62 Y -24 -6 d -62 Y f 0 0.8 0 c 625 1489 m 63 Y -24 -6 d -63 Y
- f 0.2 0.8 0 c 625 1552 m 62 Y -24 -6 d -62 Y f 0.4 0.8 0 c 625 1614 m 62 Y -24
- -6 d -62 Y f 0.6 0.8 0 c 625 1676 m 55 Y -24 -6 d -55 Y f black 601 986 m 24 6
- d 739 Y -24 -6 d cl s 0 0 0.8 c 581 1002 m 20 -16 d 62 Y -20 16 d f 0 0.2 0.8 c
- 601 1048 m 63 Y -20 15 d -62 Y f 0 0.4 0.8 c 601 1111 m 62 Y -20 15 d -62 Y f 0
- 0.6 0.8 c 601 1173 m 62 Y -20 15 d -62 Y f 0 0.8 0.8 c 601 1235 m 62 Y -20 16 d
- -63 Y f 0 0.8 0.6 c 601 1297 m 62 Y -20 16 d -62 Y f 0 0.8 0.4 c 601 1359 m 62
- Y -20 16 d -62 Y f 0 0.8 0.2 c 601 1421 m 62 Y -20 16 d -62 Y f 0 0.8 0 c 601
- 1483 m 63 Y -20 15 d -62 Y f 0.2 0.8 0 c 601 1546 m 62 Y -20 15 d -62 Y f 0.4
- 0.8 0 c 601 1608 m 62 Y -20 15 d -62 Y f 0.6 0.8 0 c 601 1670 m 55 Y -20 16 d
- -56 Y f black 581 1002 m 20 -16 d 739 Y -20 16 d cl s 0.6 0.8 0 c 601 1725 m 24
- 6 d -21 16 d -23 -6 d f black 601 1725 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8
- c 578 980 m 23 6 d -20 16 d -24 -6 d f black 578 980 m 23 6 d -20 16 d -24 -6 d
- cl s 0 0 0.8 c 554 974 m 24 6 d -21 16 d -23 -6 d f black 554 974 m 24 6 d -21
- 16 d -23 -6 d cl s 0 0 0.8 c 531 968 m 23 6 d -20 16 d -24 -6 d f black 531 968
- m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 507 962 m 24 6 d -21 16 d -23 -6 d f
- black 507 962 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1631 1228 m 24 6 d -20
- 15 d -24 -6 d f black 1631 1228 m 24 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1608
- 1222 m 23 6 d -20 15 d -23 -6 d f black 1608 1222 m 23 6 d -20 15 d -23 -6 d
- cl s 0 0 0.8 c 1584 1216 m 24 6 d -20 15 d -24 -5 d f black 1584 1216 m 24 6 d
- -20 15 d -24 -5 d cl s 0 0 0.8 c 1561 1210 m 23 6 d -20 16 d -23 -6 d f black
- 1561 1210 m 23 6 d -20 16 d -23 -6 d cl s 0 0 0.8 c 1537 1204 m 24 6 d 62 Y -24
- -6 d f 0 0.2 0.8 c 1561 1272 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 1561 1334 m 62
- Y -24 -6 d -62 Y f 0 0.6 0.8 c 1561 1396 m 63 Y -24 -6 d -63 Y f 0 0.8 0.8 c
- 1561 1459 m 62 Y -24 -6 d -62 Y f 0 0.8 0.6 c 1561 1521 m 62 Y -24 -6 d -62 Y f
- 0 0.8 0.4 c 1561 1583 m 62 Y -24 -6 d -62 Y f 0 0.8 0.2 c 1561 1645 m 62 Y -24
- -6 d -62 Y f 0 0.8 0 c 1561 1707 m 62 Y -24 -6 d -62 Y f 0.2 0.8 0 c 1561 1769
- m 62 Y -24 -6 d -62 Y f 0.4 0.8 0 c 1561 1831 m 63 Y -24 -6 d -63 Y f 0.6 0.8 0
- c 1561 1894 m 15 Y -24 -6 d -15 Y f black 1537 1204 m 24 6 d 699 Y -24 -6 d
- cl s 0 0 0.8 c 1517 1220 m 20 -16 d 62 Y -20 16 d f 0 0.2 0.8 c 1537 1266 m 62
- Y -20 16 d -62 Y f 0 0.4 0.8 c 1537 1328 m 62 Y -20 16 d -62 Y f 0 0.6 0.8 c
- 1537 1390 m 63 Y -20 15 d -62 Y f 0 0.8 0.8 c 1537 1453 m 62 Y -20 15 d -62 Y f
- 0 0.8 0.6 c 1537 1515 m 62 Y -20 15 d -62 Y f 0 0.8 0.4 c 1537 1577 m 62 Y -20
- 16 d -63 Y f 0 0.8 0.2 c 1537 1639 m 62 Y -20 16 d -62 Y f 0 0.8 0 c 1537 1701
- m 62 Y -20 16 d -62 Y f 0.2 0.8 0 c 1537 1763 m 62 Y -20 16 d -62 Y f 0.4 0.8 0
- c 1537 1825 m 63 Y -20 15 d -62 Y f 0.6 0.8 0 c 1537 1888 m 15 Y -20 15 d -15 Y
- f black 1517 1220 m 20 -16 d 699 Y -20 15 d cl s 0.6 0.8 0 c 1537 1903 m 24 6 d
- -20 15 d -24 -6 d f black 1537 1903 m 24 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c
- 1514 1198 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 1537 1266 m 62 Y -23 -6 d -62 Y
- f 0 0.4 0.8 c 1537 1328 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c 1537 1390 m 63 Y
- -23 -6 d -63 Y f 0 0.8 0.8 c 1537 1453 m 62 Y -23 -6 d -62 Y f 0 0.8 0.6 c 1537
- 1515 m 62 Y -23 -6 d -62 Y f 0 0.8 0.4 c 1537 1577 m 62 Y -23 -6 d -62 Y f 0
- 0.8 0.2 c 1537 1639 m 62 Y -23 -6 d -62 Y f 0 0.8 0 c 1537 1701 m 62 Y -23 -6 d
- -62 Y f 0.2 0.8 0 c 1537 1763 m 62 Y -23 -6 d -62 Y f 0.4 0.8 0 c 1537 1825 m
- 11 Y -23 -6 d -11 Y f black 1514 1198 m 23 6 d 632 Y -23 -6 d cl s 0 0 0.8 c
- 1494 1214 m 20 -16 d 62 Y -20 16 d f 0 0.2 0.8 c 1514 1260 m 62 Y -20 16 d -62
- Y f 0 0.4 0.8 c 1514 1322 m 62 Y -20 16 d -62 Y f 0 0.6 0.8 c 1514 1384 m 63 Y
- -20 15 d -62 Y f 0 0.8 0.8 c 1514 1447 m 62 Y -20 15 d -62 Y f 0 0.8 0.6 c 1514
- 1509 m 62 Y -20 15 d -62 Y f 0 0.8 0.4 c 1514 1571 m 62 Y -20 16 d -63 Y f 0
- 0.8 0.2 c 1514 1633 m 62 Y -20 16 d -62 Y f 0 0.8 0 c 1514 1695 m 62 Y -20 16 d
- -62 Y f 0.2 0.8 0 c 1514 1757 m 62 Y -20 16 d -62 Y f 0.4 0.8 0 c 1514 1819 m
- 11 Y -20 15 d -10 Y f black 1494 1214 m 20 -16 d 632 Y -20 15 d cl s 0.4 0.8 0
- c 1514 1830 m 23 6 d -20 15 d -23 -6 d f black 1514 1830 m 23 6 d -20 15 d -23
- -6 d cl s 0 0 0.8 c 1490 1192 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1514 1260 m
- 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 1514 1322 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c
- 1514 1384 m 63 Y -24 -6 d -63 Y f 0 0.8 0.8 c 1514 1447 m 62 Y -24 -6 d -62 Y f
- 0 0.8 0.6 c 1514 1509 m 62 Y -24 -6 d -62 Y f 0 0.8 0.4 c 1514 1571 m 62 Y -24
- -6 d -62 Y f 0 0.8 0.2 c 1514 1633 m 62 Y -24 -6 d -62 Y f 0 0.8 0 c 1514 1695
- m 62 Y -24 -6 d -62 Y f 0.2 0.8 0 c 1514 1757 m 62 Y -24 -6 d -62 Y f 0.4 0.8 0
- c 1514 1819 m 24 Y -24 -6 d -24 Y f black 1490 1192 m 24 6 d 645 Y -24 -6 d
- cl s 0 0 0.8 c 1470 1208 m 20 -16 d 62 Y -20 16 d f 0 0.2 0.8 c 1490 1254 m 62
- Y -20 16 d -62 Y f 0 0.4 0.8 c 1490 1316 m 62 Y -20 16 d -62 Y f 0 0.6 0.8 c
- 1490 1378 m 63 Y -20 15 d -62 Y f 0 0.8 0.8 c 1490 1441 m 62 Y -20 15 d -62 Y f
- 0 0.8 0.6 c 1490 1503 m 62 Y -20 15 d -62 Y f 0 0.8 0.4 c 1490 1565 m 62 Y -20
- 16 d -63 Y f 0 0.8 0.2 c 1490 1627 m 62 Y -20 16 d -62 Y f 0 0.8 0 c 1490 1689
- m 62 Y -20 16 d -62 Y f 0.2 0.8 0 c 1490 1751 m 62 Y -20 16 d -62 Y f 0.4 0.8 0
- c 1490 1813 m 24 Y -20 16 d -24 Y f black 1470 1208 m 20 -16 d 645 Y -20 16 d
- cl s 0.4 0.8 0 c 1490 1837 m 24 6 d -20 15 d -24 -5 d f black 1490 1837 m 24 6
- d -20 15 d -24 -5 d cl s 0 0 0.8 c 1467 1186 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8
- c 1490 1254 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 1490 1316 m 62 Y -23 -5 d -63 Y
- f 0 0.6 0.8 c 1490 1378 m 63 Y -23 -6 d -62 Y f 0 0.8 0.8 c 1490 1441 m 62 Y
- -23 -6 d -62 Y f 0 0.8 0.6 c 1490 1503 m 62 Y -23 -6 d -62 Y f 0 0.8 0.4 c 1490
- 1565 m 62 Y -23 -6 d -62 Y f 0 0.8 0.2 c 1490 1627 m 62 Y -23 -6 d -62 Y f 0
- 0.8 0 c 1490 1689 m 62 Y -23 -6 d -62 Y f 0.2 0.8 0 c 1490 1751 m 62 Y -23 -6 d
- -62 Y f 0.4 0.8 0 c 1490 1813 m 37 Y -23 -6 d -37 Y f black 1467 1186 m 23 6 d
- 658 Y -23 -6 d cl s 0 0 0.8 c 1447 1202 m 20 -16 d 62 Y -20 16 d f 0 0.2 0.8 c
- 1467 1248 m 62 Y -20 16 d -62 Y f 0 0.4 0.8 c 1467 1310 m 63 Y -20 15 d -62 Y f
- 0 0.6 0.8 c 1467 1373 m 62 Y -20 15 d -62 Y f 0 0.8 0.8 c 1467 1435 m 62 Y -20
- 15 d -62 Y f 0 0.8 0.6 c 1467 1497 m 62 Y -20 15 d -62 Y f 0 0.8 0.4 c 1467
- 1559 m 62 Y -20 16 d -63 Y f 0 0.8 0.2 c 1467 1621 m 62 Y -20 16 d -62 Y f 0
- 0.8 0 c 1467 1683 m 62 Y -20 16 d -62 Y f 0.2 0.8 0 c 1467 1745 m 62 Y -20 16 d
- -62 Y f 0.4 0.8 0 c 1467 1807 m 37 Y -20 16 d -37 Y f black 1447 1202 m 20 -16
- d 658 Y -20 16 d cl s 0.4 0.8 0 c 1467 1844 m 23 6 d -20 16 d -23 -6 d f black
- 1467 1844 m 23 6 d -20 16 d -23 -6 d cl s 0 0 0.8 c 1444 1180 m 23 6 d 62 Y -23
- -6 d f 0 0.2 0.8 c 1467 1248 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 1467 1310 m 63
- Y -23 -6 d -63 Y f 0 0.6 0.8 c 1467 1373 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c
- 1467 1435 m 62 Y -23 -6 d -62 Y f 0 0.8 0.6 c 1467 1497 m 62 Y -23 -6 d -62 Y f
- 0 0.8 0.4 c 1467 1559 m 62 Y -23 -6 d -62 Y f 0 0.8 0.2 c 1467 1621 m 62 Y -23
- -6 d -62 Y f 0 0.8 0 c 1467 1683 m 41 Y -23 -6 d -41 Y f black 1444 1180 m 23 6
- d 538 Y -23 -6 d cl s 0 0 0.8 c 1423 1196 m 21 -16 d 62 Y -21 16 d f 0 0.2 0.8
- c 1444 1242 m 62 Y -21 16 d -62 Y f 0 0.4 0.8 c 1444 1304 m 63 Y -21 15 d -62 Y
- f 0 0.6 0.8 c 1444 1367 m 62 Y -21 15 d -62 Y f 0 0.8 0.8 c 1444 1429 m 62 Y
- -21 15 d -62 Y f 0 0.8 0.6 c 1444 1491 m 62 Y -21 15 d -62 Y f 0 0.8 0.4 c 1444
- 1553 m 62 Y -21 16 d -63 Y f 0 0.8 0.2 c 1444 1615 m 62 Y -21 16 d -62 Y f 0
- 0.8 0 c 1444 1677 m 41 Y -21 15 d -40 Y f black 1423 1196 m 21 -16 d 538 Y -21
- 15 d cl s 0 0.8 0 c 1444 1718 m 23 6 d -20 15 d -24 -6 d f black 1444 1718 m 23
- 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1420 1174 m 24 6 d 62 Y -24 -6 d f 0 0.2
- 0.8 c 1444 1242 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 1444 1304 m 63 Y -24 -6 d
- -63 Y f 0 0.6 0.8 c 1444 1367 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 1444 1429 m
- 62 Y -24 -6 d -62 Y f 0 0.8 0.6 c 1444 1491 m 62 Y -24 -6 d -62 Y f 0 0.8 0.4 c
- 1444 1553 m 62 Y -24 -6 d -62 Y f 0 0.8 0.2 c 1444 1615 m 62 Y -24 -6 d -62 Y f
- 0 0.8 0 c 1444 1677 m 62 Y -24 -6 d -62 Y f 0.2 0.8 0 c 1444 1739 m 46 Y -24 -6
- d -46 Y f black 1420 1174 m 24 6 d 605 Y -24 -6 d cl s 0 0 0.8 c 1400 1190 m 20
- -16 d 62 Y -20 16 d f 0 0.2 0.8 c 1420 1236 m 62 Y -20 16 d -62 Y f 0 0.4 0.8 c
- 1420 1298 m 63 Y -20 15 d -62 Y f 0 0.6 0.8 c 1420 1361 m 62 Y -20 15 d -62 Y f
- 0 0.8 0.8 c 1420 1423 m 62 Y -20 15 d -62 Y f 0 0.8 0.6 c 1420 1485 m 62 Y -20
- 16 d -63 Y f 0 0.8 0.4 c 1420 1547 m 62 Y -20 16 d -62 Y f 0 0.8 0.2 c 1420
- 1609 m 62 Y -20 16 d -62 Y f 0 0.8 0 c 1420 1671 m 62 Y -20 16 d -62 Y f 0.2
- 0.8 0 c 1420 1733 m 46 Y -20 15 d -45 Y f black 1400 1190 m 20 -16 d 605 Y -20
- 15 d cl s 0.2 0.8 0 c 1420 1779 m 24 6 d -21 15 d -23 -6 d f black 1420 1779 m
- 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 1397 1168 m 23 6 d 62 Y -23 -6 d f 0
- 0.2 0.8 c 1420 1236 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 1420 1298 m 63 Y -23 -6
- d -63 Y f 0 0.6 0.8 c 1420 1361 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 1420 1423 m
- 62 Y -23 -6 d -62 Y f 0 0.8 0.6 c 1420 1485 m 62 Y -23 -6 d -62 Y f 0 0.8 0.4 c
- 1420 1547 m 62 Y -23 -6 d -62 Y f 0 0.8 0.2 c 1420 1609 m 62 Y -23 -6 d -62 Y f
- 0 0.8 0 c 1420 1671 m 62 Y -23 -6 d -62 Y f 0.2 0.8 0 c 1420 1733 m 46 Y -23 -6
- d -46 Y f black 1397 1168 m 23 6 d 605 Y -23 -6 d cl s 0 0 0.8 c 1376 1184 m 21
- -16 d 62 Y -21 16 d f 0 0.2 0.8 c 1397 1230 m 62 Y -21 16 d -62 Y f 0 0.4 0.8 c
- 1397 1292 m 63 Y -21 15 d -62 Y f 0 0.6 0.8 c 1397 1355 m 62 Y -21 15 d -62 Y f
- 0 0.8 0.8 c 1397 1417 m 62 Y -21 15 d -62 Y f 0 0.8 0.6 c 1397 1479 m 62 Y -21
- 16 d -63 Y f 0 0.8 0.4 c 1397 1541 m 62 Y -21 16 d -62 Y f 0 0.8 0.2 c 1397
- 1603 m 62 Y -21 16 d -62 Y f 0 0.8 0 c 1397 1665 m 62 Y -21 16 d -62 Y f 0.2
- 0.8 0 c 1397 1727 m 46 Y -21 15 d -45 Y f black 1376 1184 m 21 -16 d 605 Y -21
- 15 d cl s 0.2 0.8 0 c 1397 1773 m 23 6 d -20 15 d -24 -6 d f black 1397 1773 m
- 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1373 1162 m 24 6 d 62 Y -24 -6 d f 0
- 0.2 0.8 c 1397 1230 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 1397 1292 m 63 Y -24 -6
- d -63 Y f 0 0.6 0.8 c 1397 1355 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 1397 1417 m
- 62 Y -24 -6 d -62 Y f 0 0.8 0.6 c 1397 1479 m 62 Y -24 -6 d -62 Y f 0 0.8 0.4 c
- 1397 1541 m 62 Y -24 -6 d -62 Y f 0 0.8 0.2 c 1397 1603 m 62 Y -24 -6 d -62 Y f
- black 1373 1162 m 24 6 d 497 Y -24 -6 d cl s 0 0 0.8 c 1353 1178 m 20 -16 d 62
- Y -20 16 d f 0 0.2 0.8 c 1373 1224 m 62 Y -20 16 d -62 Y f 0 0.4 0.8 c 1373
- 1286 m 63 Y -20 15 d -62 Y f 0 0.6 0.8 c 1373 1349 m 62 Y -20 15 d -62 Y f 0
- 0.8 0.8 c 1373 1411 m 62 Y -20 15 d -62 Y f 0 0.8 0.6 c 1373 1473 m 62 Y -20 16
- d -63 Y f 0 0.8 0.4 c 1373 1535 m 62 Y -20 16 d -62 Y f 0 0.8 0.2 c 1373 1597 m
- 62 Y -20 16 d -62 Y f black 1353 1178 m 20 -16 d 497 Y -20 16 d cl s 0 0.8 0.2
- c 1373 1659 m 24 6 d -21 16 d -23 -6 d f 0 0.8 0 c 1373 1659 m 24 6 d -21 16 d
- -23 -6 d f black 1373 1659 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1350 1156
- m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 1373 1224 m 62 Y -23 -6 d -62 Y f 0 0.4
- 0.8 c 1373 1286 m 63 Y -23 -6 d -63 Y f 0 0.6 0.8 c 1373 1349 m 62 Y -23 -6 d
- -62 Y f 0 0.8 0.8 c 1373 1411 m 62 Y -23 -6 d -62 Y f 0 0.8 0.6 c 1373 1473 m
- 62 Y -23 -6 d -62 Y f 0 0.8 0.4 c 1373 1535 m 62 Y -23 -6 d -62 Y f 0 0.8 0.2 c
- 1373 1597 m 62 Y -23 -6 d -62 Y f 0 0.8 0 c 1373 1659 m 62 Y -23 -6 d -62 Y f
- 0.2 0.8 0 c 1373 1721 m 63 Y -23 -6 d -63 Y f 0.4 0.8 0 c 1373 1784 m 62 Y -23
- -6 d -62 Y f 0.6 0.8 0 c 1373 1846 m 62 Y -23 -6 d -62 Y f 0.8 0.8 0 c 1373
- 1908 m 62 Y -23 -6 d -62 Y f 0.8 0.6 0 c 1373 1970 m 62 Y -23 -6 d -62 Y f 0.8
- 0.4 0 c 1373 2032 m 30 Y -23 -6 d -30 Y f black 1350 1156 m 23 6 d 900 Y -23 -6
- d cl s 0 0 0.8 c 1329 1172 m 21 -16 d 62 Y -21 16 d f 0 0.2 0.8 c 1350 1218 m
- 62 Y -21 16 d -62 Y f 0 0.4 0.8 c 1350 1280 m 63 Y -21 15 d -62 Y f 0 0.6 0.8 c
- 1350 1343 m 62 Y -21 15 d -62 Y f 0 0.8 0.8 c 1350 1405 m 62 Y -21 15 d -62 Y f
- 0 0.8 0.6 c 1350 1467 m 62 Y -21 16 d -63 Y f 0 0.8 0.4 c 1350 1529 m 62 Y -21
- 16 d -62 Y f 0 0.8 0.2 c 1350 1591 m 62 Y -21 16 d -62 Y f 0 0.8 0 c 1350 1653
- m 62 Y -21 16 d -62 Y f 0.2 0.8 0 c 1350 1715 m 63 Y -21 15 d -62 Y f 0.4 0.8 0
- c 1350 1778 m 62 Y -21 15 d -62 Y f 0.6 0.8 0 c 1350 1840 m 62 Y -21 15 d -62 Y
- f 0.8 0.8 0 c 1350 1902 m 62 Y -21 16 d -63 Y f 0.8 0.6 0 c 1350 1964 m 62 Y
- -21 16 d -62 Y f 0.8 0.4 0 c 1350 2026 m 30 Y -21 16 d -30 Y f black 1329 1172
- m 21 -16 d 900 Y -21 16 d cl s 0.8 0.4 0 c 1350 2056 m 23 6 d -20 16 d -24 -6 d
- f black 1350 2056 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1326 1150 m 24 6 d
- 62 Y -24 -6 d f 0 0.2 0.8 c 1350 1218 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 1350
- 1280 m 63 Y -24 -6 d -63 Y f 0 0.6 0.8 c 1350 1343 m 62 Y -24 -6 d -62 Y f 0
- 0.8 0.8 c 1350 1405 m 62 Y -24 -6 d -62 Y f 0 0.8 0.6 c 1350 1467 m 62 Y -24 -6
- d -62 Y f 0 0.8 0.4 c 1350 1529 m 62 Y -24 -6 d -62 Y f 0 0.8 0.2 c 1350 1591 m
- 62 Y -24 -6 d -62 Y f 0 0.8 0 c 1350 1653 m 62 Y -24 -6 d -62 Y f 0.2 0.8 0 c
- 1350 1715 m 63 Y -24 -6 d -63 Y f 0.4 0.8 0 c 1350 1778 m 62 Y -24 -6 d -62 Y f
- 0.6 0.8 0 c 1350 1840 m 1 Y -24 -6 d -1 Y f black 1326 1150 m 24 6 d 685 Y -24
- -6 d cl s 0 0 0.8 c 1306 1166 m 20 -16 d 62 Y -20 16 d f 0 0.2 0.8 c 1326 1212
- m 62 Y -20 16 d -62 Y f 0 0.4 0.8 c 1326 1274 m 63 Y -20 15 d -62 Y f 0 0.6 0.8
- c 1326 1337 m 62 Y -20 15 d -62 Y f 0 0.8 0.8 c 1326 1399 m 62 Y -20 15 d -62 Y
- f 0 0.8 0.6 c 1326 1461 m 62 Y -20 16 d -63 Y f 0 0.8 0.4 c 1326 1523 m 62 Y
- -20 16 d -62 Y f 0 0.8 0.2 c 1326 1585 m 62 Y -20 16 d -62 Y f 0 0.8 0 c 1326
- 1647 m 62 Y -20 16 d -62 Y f 0.2 0.8 0 c 1326 1709 m 63 Y -20 15 d -62 Y f 0.4
- 0.8 0 c 1326 1772 m 62 Y -20 15 d -62 Y f 0.6 0.8 0 c 1326 1834 m 1 Y -20 16 d
- -2 Y f black 1306 1166 m 20 -16 d 685 Y -20 16 d cl s 0.6 0.8 0 c 1326 1835 m
- 24 6 d -21 16 d -23 -6 d f black 1326 1835 m 24 6 d -21 16 d -23 -6 d cl s 0 0
- 0.8 c 1303 1144 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 1326 1212 m 62 Y -23 -5 d
- -63 Y f 0 0.4 0.8 c 1326 1274 m 63 Y -23 -6 d -62 Y f 0 0.6 0.8 c 1326 1337 m
- 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 1326 1399 m 62 Y -23 -6 d -62 Y f 0 0.8 0.6 c
- 1326 1461 m 62 Y -23 -6 d -62 Y f 0 0.8 0.4 c 1326 1523 m 62 Y -23 -6 d -62 Y f
- 0 0.8 0.2 c 1326 1585 m 62 Y -23 -6 d -62 Y f 0 0.8 0 c 1326 1647 m 62 Y -23 -6
- d -62 Y f 0.2 0.8 0 c 1326 1709 m 63 Y -23 -6 d -63 Y f 0.4 0.8 0 c 1326 1772 m
- 50 Y -23 -6 d -50 Y f black 1303 1144 m 23 6 d 672 Y -23 -6 d cl s 0 0 0.8 c
- 1282 1160 m 21 -16 d 62 Y -21 16 d f 0 0.2 0.8 c 1303 1206 m 63 Y -21 15 d -62
- Y f 0 0.4 0.8 c 1303 1269 m 62 Y -21 15 d -62 Y f 0 0.6 0.8 c 1303 1331 m 62 Y
- -21 15 d -62 Y f 0 0.8 0.8 c 1303 1393 m 62 Y -21 15 d -62 Y f 0 0.8 0.6 c 1303
- 1455 m 62 Y -21 16 d -63 Y f 0 0.8 0.4 c 1303 1517 m 62 Y -21 16 d -62 Y f 0
- 0.8 0.2 c 1303 1579 m 62 Y -21 16 d -62 Y f 0 0.8 0 c 1303 1641 m 62 Y -21 16 d
- -62 Y f 0.2 0.8 0 c 1303 1703 m 63 Y -21 15 d -62 Y f 0.4 0.8 0 c 1303 1766 m
- 50 Y -21 16 d -51 Y f black 1282 1160 m 21 -16 d 672 Y -21 16 d cl s 0.4 0.8 0
- c 1303 1816 m 23 6 d -20 16 d -24 -6 d f black 1303 1816 m 23 6 d -20 16 d -24
- -6 d cl s 0 0 0.8 c 1279 1138 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1303 1206 m
- 63 Y -24 -6 d -63 Y f 0 0.4 0.8 c 1303 1269 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c
- 1303 1331 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 1303 1393 m 62 Y -24 -6 d -62 Y f
- 0 0.8 0.6 c 1303 1455 m 62 Y -24 -6 d -62 Y f 0 0.8 0.4 c 1303 1517 m 62 Y -24
- -6 d -62 Y f 0 0.8 0.2 c 1303 1579 m 62 Y -24 -6 d -62 Y f 0 0.8 0 c 1303 1641
- m 62 Y -24 -5 d -63 Y f 0.2 0.8 0 c 1303 1703 m 63 Y -24 -6 d -62 Y f 0.4 0.8 0
- c 1303 1766 m 62 Y -24 -6 d -62 Y f 0.6 0.8 0 c 1303 1828 m 28 Y -24 -6 d -28 Y
- f black 1279 1138 m 24 6 d 712 Y -24 -6 d cl s 0 0 0.8 c 1259 1154 m 20 -16 d
- 62 Y -20 16 d f 0 0.2 0.8 c 1279 1200 m 63 Y -20 15 d -62 Y f 0 0.4 0.8 c 1279
- 1263 m 62 Y -20 15 d -62 Y f 0 0.6 0.8 c 1279 1325 m 62 Y -20 15 d -62 Y f 0
- 0.8 0.8 c 1279 1387 m 62 Y -20 15 d -62 Y f 0 0.8 0.6 c 1279 1449 m 62 Y -20 16
- d -63 Y f 0 0.8 0.4 c 1279 1511 m 62 Y -20 16 d -62 Y f 0 0.8 0.2 c 1279 1573 m
- 62 Y -20 16 d -62 Y f 0 0.8 0 c 1279 1635 m 63 Y -20 15 d -62 Y f 0.2 0.8 0 c
- 1279 1698 m 62 Y -20 15 d -62 Y f 0.4 0.8 0 c 1279 1760 m 62 Y -20 15 d -62 Y f
- 0.6 0.8 0 c 1279 1822 m 28 Y -20 16 d -29 Y f black 1259 1154 m 20 -16 d 712 Y
- -20 16 d cl s 0.6 0.8 0 c 1279 1850 m 24 6 d -21 16 d -23 -6 d f black 1279
- 1850 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1256 1132 m 23 6 d 62 Y -23 -6 d
- f 0 0.2 0.8 c 1279 1200 m 63 Y -23 -6 d -63 Y f 0 0.4 0.8 c 1279 1263 m 62 Y
- -23 -6 d -62 Y f 0 0.6 0.8 c 1279 1325 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 1279
- 1387 m 62 Y -23 -6 d -62 Y f 0 0.8 0.6 c 1279 1449 m 62 Y -23 -6 d -62 Y f 0
- 0.8 0.4 c 1279 1511 m 62 Y -23 -6 d -62 Y f 0 0.8 0.2 c 1279 1573 m 62 Y -23 -6
- d -62 Y f 0 0.8 0 c 1279 1635 m 63 Y -23 -6 d -63 Y f 0.2 0.8 0 c 1279 1698 m
- 62 Y -23 -6 d -62 Y f 0.4 0.8 0 c 1279 1760 m 37 Y -23 -6 d -37 Y f black 1256
- 1132 m 23 6 d 659 Y -23 -6 d cl s 0 0 0.8 c 1235 1148 m 21 -16 d 62 Y -21 16 d
- f 0 0.2 0.8 c 1256 1194 m 63 Y -21 15 d -62 Y f 0 0.4 0.8 c 1256 1257 m 62 Y
- -21 15 d -62 Y f 0 0.6 0.8 c 1256 1319 m 62 Y -21 15 d -62 Y f 0 0.8 0.8 c 1256
- 1381 m 62 Y -21 16 d -63 Y f 0 0.8 0.6 c 1256 1443 m 62 Y -21 16 d -62 Y f 0
- 0.8 0.4 c 1256 1505 m 62 Y -21 16 d -62 Y f 0 0.8 0.2 c 1256 1567 m 62 Y -21 16
- d -62 Y f 0 0.8 0 c 1256 1629 m 63 Y -21 15 d -62 Y f 0.2 0.8 0 c 1256 1692 m
- 62 Y -21 15 d -62 Y f 0.4 0.8 0 c 1256 1754 m 37 Y -21 15 d -37 Y f black 1235
- 1148 m 21 -16 d 659 Y -21 15 d cl s 0.4 0.8 0 c 1256 1791 m 23 6 d -20 15 d -24
- -6 d f black 1256 1791 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1232 1126 m 24
- 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1256 1194 m 63 Y -24 -6 d -63 Y f 0 0.4 0.8 c
- 1256 1257 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 1256 1319 m 62 Y -24 -6 d -62 Y f
- 0 0.8 0.8 c 1256 1381 m 62 Y -24 -6 d -62 Y f 0 0.8 0.6 c 1256 1443 m 62 Y -24
- -6 d -62 Y f 0 0.8 0.4 c 1256 1505 m 62 Y -24 -6 d -62 Y f 0 0.8 0.2 c 1256
- 1567 m 62 Y -24 -6 d -62 Y f 0 0.8 0 c 1256 1629 m 63 Y -24 -6 d -63 Y f 0.2
- 0.8 0 c 1256 1692 m 62 Y -24 -6 d -62 Y f 0.4 0.8 0 c 1256 1754 m 62 Y -24 -6 d
- -62 Y f 0.6 0.8 0 c 1256 1816 m 15 Y -24 -6 d -15 Y f black 1232 1126 m 24 6 d
- 699 Y -24 -6 d cl s 0 0 0.8 c 1212 1142 m 20 -16 d 62 Y -20 16 d f 0 0.2 0.8 c
- 1232 1188 m 63 Y -20 15 d -62 Y f 0 0.4 0.8 c 1232 1251 m 62 Y -20 15 d -62 Y f
- 0 0.6 0.8 c 1232 1313 m 62 Y -20 15 d -62 Y f 0 0.8 0.8 c 1232 1375 m 62 Y -20
- 16 d -63 Y f 0 0.8 0.6 c 1232 1437 m 62 Y -20 16 d -62 Y f 0 0.8 0.4 c 1232
- 1499 m 62 Y -20 16 d -62 Y f 0 0.8 0.2 c 1232 1561 m 62 Y -20 16 d -62 Y f 0
- 0.8 0 c 1232 1623 m 63 Y -20 15 d -62 Y f 0.2 0.8 0 c 1232 1686 m 62 Y -20 15 d
- -62 Y f 0.4 0.8 0 c 1232 1748 m 62 Y -20 15 d -62 Y f 0.6 0.8 0 c 1232 1810 m
- 15 Y -20 15 d -15 Y f black 1212 1142 m 20 -16 d 699 Y -20 15 d cl s 0.6 0.8 0
- c 1232 1825 m 24 6 d -21 15 d -23 -6 d f black 1232 1825 m 24 6 d -21 15 d -23
- -6 d cl s 0 0 0.8 c 1209 1120 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 1232 1188 m
- 63 Y -23 -6 d -63 Y f 0 0.4 0.8 c 1232 1251 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c
- 1232 1313 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 1232 1375 m 62 Y -23 -6 d -62 Y f
- 0 0.8 0.6 c 1232 1437 m 62 Y -23 -6 d -62 Y f 0 0.8 0.4 c 1232 1499 m 62 Y -23
- -6 d -62 Y f 0 0.8 0.2 c 1232 1561 m 62 Y -23 -6 d -62 Y f 0 0.8 0 c 1232 1623
- m 63 Y -23 -6 d -63 Y f 0.2 0.8 0 c 1232 1686 m 45 Y -23 -6 d -45 Y f black
- 1209 1120 m 23 6 d 605 Y -23 -6 d cl s 0 0 0.8 c 1188 1136 m 21 -16 d 62 Y -21
- 16 d f 0 0.2 0.8 c 1209 1182 m 63 Y -21 15 d -62 Y f 0 0.4 0.8 c 1209 1245 m 62
- Y -21 15 d -62 Y f 0 0.6 0.8 c 1209 1307 m 62 Y -21 15 d -62 Y f 0 0.8 0.8 c
- 1209 1369 m 62 Y -21 16 d -63 Y f 0 0.8 0.6 c 1209 1431 m 62 Y -21 16 d -62 Y f
- 0 0.8 0.4 c 1209 1493 m 62 Y -21 16 d -62 Y f 0 0.8 0.2 c 1209 1555 m 62 Y -21
- 16 d -62 Y f 0 0.8 0 c 1209 1617 m 63 Y -21 15 d -62 Y f 0.2 0.8 0 c 1209 1680
- m 45 Y -21 15 d -45 Y f black 1188 1136 m 21 -16 d 605 Y -21 15 d cl s 0.2 0.8
- 0 c 1209 1725 m 23 6 d -20 15 d -24 -6 d f black 1209 1725 m 23 6 d -20 15 d
- -24 -6 d cl s 0 0 0.8 c 1185 1114 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1209
- 1182 m 63 Y -24 -6 d -63 Y f 0 0.4 0.8 c 1209 1245 m 62 Y -24 -6 d -62 Y f 0
- 0.6 0.8 c 1209 1307 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 1209 1369 m 62 Y -24 -6
- d -62 Y f 0 0.8 0.6 c 1209 1431 m 62 Y -24 -6 d -62 Y f 0 0.8 0.4 c 1209 1493 m
- 62 Y -24 -6 d -62 Y f 0 0.8 0.2 c 1209 1555 m 36 Y -24 -6 d -36 Y f black 1185
- 1114 m 24 6 d 471 Y -24 -6 d cl s 0 0 0.8 c 1165 1130 m 20 -16 d 62 Y -20 16 d
- f 0 0.2 0.8 c 1185 1176 m 63 Y -20 15 d -62 Y f 0 0.4 0.8 c 1185 1239 m 62 Y
- -20 15 d -62 Y f 0 0.6 0.8 c 1185 1301 m 62 Y -20 15 d -62 Y f 0 0.8 0.8 c 1185
- 1363 m 62 Y -20 16 d -63 Y f 0 0.8 0.6 c 1185 1425 m 62 Y -20 16 d -62 Y f 0
- 0.8 0.4 c 1185 1487 m 62 Y -20 16 d -62 Y f 0 0.8 0.2 c 1185 1549 m 36 Y -20 15
- d -35 Y f black 1165 1130 m 20 -16 d 471 Y -20 15 d cl s 0 0.8 0.2 c 1185 1585
- m 24 6 d -21 15 d -23 -6 d f black 1185 1585 m 24 6 d -21 15 d -23 -6 d cl s 0
- 0 0.8 c 1162 1108 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 1185 1176 m 63 Y -23 -6
- d -63 Y f 0 0.4 0.8 c 1185 1239 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c 1185 1301 m
- 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 1185 1363 m 62 Y -23 -6 d -62 Y f 0 0.8 0.6 c
- 1185 1425 m 62 Y -23 -6 d -62 Y f 0 0.8 0.4 c 1185 1487 m 62 Y -23 -6 d -62 Y f
- 0 0.8 0.2 c 1185 1549 m 62 Y -23 -6 d -62 Y f 0 0.8 0 c 1185 1611 m 63 Y -23 -6
- d -63 Y f 0.2 0.8 0 c 1185 1674 m 18 Y -23 -6 d -18 Y f black 1162 1108 m 23 6
- d 578 Y -23 -6 d cl s 0 0 0.8 c 1141 1124 m 21 -16 d 62 Y -21 16 d f 0 0.2 0.8
- c 1162 1170 m 63 Y -21 15 d -62 Y f 0 0.4 0.8 c 1162 1233 m 62 Y -21 15 d -62 Y
- f 0 0.6 0.8 c 1162 1295 m 62 Y -21 15 d -62 Y f 0 0.8 0.8 c 1162 1357 m 62 Y
- -21 16 d -63 Y f 0 0.8 0.6 c 1162 1419 m 62 Y -21 16 d -62 Y f 0 0.8 0.4 c 1162
- 1481 m 62 Y -21 16 d -62 Y f 0 0.8 0.2 c 1162 1543 m 62 Y -21 16 d -62 Y f 0
- 0.8 0 c 1162 1605 m 63 Y -21 15 d -62 Y f 0.2 0.8 0 c 1162 1668 m 18 Y -21 16 d
- -19 Y f black 1141 1124 m 21 -16 d 578 Y -21 16 d cl s 0.2 0.8 0 c 1162 1686 m
- 23 6 d -20 16 d -24 -6 d f black 1162 1686 m 23 6 d -20 16 d -24 -6 d cl s 0 0
- 0.8 c 1138 1102 m 24 6 d 62 Y -24 -5 d f 0 0.2 0.8 c 1162 1170 m 63 Y -24 -6 d
- -62 Y f 0 0.4 0.8 c 1162 1233 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 1162 1295 m
- 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 1162 1357 m 62 Y -24 -6 d -62 Y f 0 0.8 0.6 c
- 1162 1419 m 62 Y -24 -6 d -62 Y f 0 0.8 0.4 c 1162 1481 m 62 Y -24 -6 d -62 Y f
- 0 0.8 0.2 c 1162 1543 m 62 Y -24 -6 d -62 Y f 0 0.8 0 c 1162 1605 m 63 Y -24 -6
- d -63 Y f 0.2 0.8 0 c 1162 1668 m 62 Y -24 -6 d -62 Y f 0.4 0.8 0 c 1162 1730 m
- 10 Y -24 -6 d -10 Y f black 1138 1102 m 24 6 d 632 Y -24 -6 d cl s 0 0 0.8 c
- 1118 1118 m 20 -16 d 63 Y -20 15 d f 0 0.2 0.8 c 1138 1165 m 62 Y -20 15 d -62
- Y f 0 0.4 0.8 c 1138 1227 m 62 Y -20 15 d -62 Y f 0 0.6 0.8 c 1138 1289 m 62 Y
- -20 15 d -62 Y f 0 0.8 0.8 c 1138 1351 m 62 Y -20 16 d -63 Y f 0 0.8 0.6 c 1138
- 1413 m 62 Y -20 16 d -62 Y f 0 0.8 0.4 c 1138 1475 m 62 Y -20 16 d -62 Y f 0
- 0.8 0.2 c 1138 1537 m 62 Y -20 16 d -62 Y f 0 0.8 0 c 1138 1599 m 63 Y -20 15 d
- -62 Y f 0.2 0.8 0 c 1138 1662 m 62 Y -20 15 d -62 Y f 0.4 0.8 0 c 1138 1724 m
- 10 Y -20 15 d -10 Y f black 1118 1118 m 20 -16 d 632 Y -20 15 d cl s 0.4 0.8 0
- c 1138 1734 m 24 6 d -21 15 d -23 -6 d f black 1138 1734 m 24 6 d -21 15 d -23
- -6 d cl s 0 0 0.8 c 1115 1096 m 23 6 d 63 Y -23 -6 d f 0 0.2 0.8 c 1138 1165 m
- 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 1138 1227 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c
- 1138 1289 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 1138 1351 m 62 Y -23 -6 d -62 Y f
- 0 0.8 0.6 c 1138 1413 m 62 Y -23 -6 d -62 Y f 0 0.8 0.4 c 1138 1475 m 62 Y -23
- -6 d -62 Y f 0 0.8 0.2 c 1138 1537 m 62 Y -23 -5 d -63 Y f 0 0.8 0 c 1138 1599
- m 63 Y -23 -6 d -62 Y f 0.2 0.8 0 c 1138 1662 m 62 Y -23 -6 d -62 Y f 0.4 0.8 0
- c 1138 1724 m 37 Y -23 -6 d -37 Y f black 1115 1096 m 23 6 d 659 Y -23 -6 d
- cl s 0 0 0.8 c 1094 1112 m 21 -16 d 63 Y -21 15 d f 0 0.2 0.8 c 1115 1159 m 62
- Y -21 15 d -62 Y f 0 0.4 0.8 c 1115 1221 m 62 Y -21 15 d -62 Y f 0 0.6 0.8 c
- 1115 1283 m 62 Y -21 15 d -62 Y f 0 0.8 0.8 c 1115 1345 m 62 Y -21 16 d -63 Y f
- 0 0.8 0.6 c 1115 1407 m 62 Y -21 16 d -62 Y f 0 0.8 0.4 c 1115 1469 m 62 Y -21
- 16 d -62 Y f 0 0.8 0.2 c 1115 1531 m 63 Y -21 15 d -62 Y f 0 0.8 0 c 1115 1594
- m 62 Y -21 15 d -62 Y f 0.2 0.8 0 c 1115 1656 m 62 Y -21 15 d -62 Y f 0.4 0.8 0
- c 1115 1718 m 37 Y -21 15 d -37 Y f black 1094 1112 m 21 -16 d 659 Y -21 15 d
- cl s 0.4 0.8 0 c 1115 1755 m 23 6 d -20 15 d -24 -6 d f black 1115 1755 m 23 6
- d -20 15 d -24 -6 d cl s 0 0 0.8 c 1091 1090 m 24 6 d 63 Y -24 -6 d f 0 0.2 0.8
- c 1115 1159 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 1115 1221 m 62 Y -24 -6 d -62 Y
- f 0 0.6 0.8 c 1115 1283 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 1115 1345 m 62 Y
- -24 -6 d -62 Y f 0 0.8 0.6 c 1115 1407 m 62 Y -24 -6 d -62 Y f 0 0.8 0.4 c 1115
- 1469 m 62 Y -24 -6 d -62 Y f 0 0.8 0.2 c 1115 1531 m 63 Y -24 -6 d -63 Y f 0
- 0.8 0 c 1115 1594 m 62 Y -24 -6 d -62 Y f 0.2 0.8 0 c 1115 1656 m 18 Y -24 -6 d
- -18 Y f black 1091 1090 m 24 6 d 578 Y -24 -6 d cl s 0 0 0.8 c 1071 1106 m 20
- -16 d 63 Y -20 15 d f 0 0.2 0.8 c 1091 1153 m 62 Y -20 15 d -62 Y f 0 0.4 0.8 c
- 1091 1215 m 62 Y -20 15 d -62 Y f 0 0.6 0.8 c 1091 1277 m 62 Y -20 16 d -63 Y f
- 0 0.8 0.8 c 1091 1339 m 62 Y -20 16 d -62 Y f 0 0.8 0.6 c 1091 1401 m 62 Y -20
- 16 d -62 Y f 0 0.8 0.4 c 1091 1463 m 62 Y -20 16 d -62 Y f 0 0.8 0.2 c 1091
- 1525 m 63 Y -20 15 d -62 Y f 0 0.8 0 c 1091 1588 m 62 Y -20 15 d -62 Y f 0.2
- 0.8 0 c 1091 1650 m 18 Y -20 16 d -19 Y f black 1071 1106 m 20 -16 d 578 Y -20
- 16 d cl s 0.2 0.8 0 c 1091 1668 m 24 6 d -21 16 d -23 -6 d f black 1091 1668 m
- 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1068 1084 m 23 6 d 63 Y -23 -6 d f 0
- 0.2 0.8 c 1091 1153 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 1091 1215 m 62 Y -23 -6
- d -62 Y f 0 0.6 0.8 c 1091 1277 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 1091 1339 m
- 62 Y -23 -6 d -62 Y f 0 0.8 0.6 c 1091 1401 m 62 Y -23 -6 d -62 Y f 0 0.8 0.4 c
- 1091 1463 m 62 Y -23 -6 d -62 Y f 0 0.8 0.2 c 1091 1525 m 63 Y -23 -6 d -63 Y f
- 0 0.8 0 c 1091 1588 m 62 Y -23 -6 d -62 Y f 0.2 0.8 0 c 1091 1650 m 45 Y -23 -6
- d -45 Y f black 1068 1084 m 23 6 d 605 Y -23 -6 d cl s 0 0 0.8 c 1047 1100 m 21
- -16 d 63 Y -21 15 d f 0 0.2 0.8 c 1068 1147 m 62 Y -21 15 d -62 Y f 0 0.4 0.8 c
- 1068 1209 m 62 Y -21 15 d -62 Y f 0 0.6 0.8 c 1068 1271 m 62 Y -21 16 d -63 Y f
- 0 0.8 0.8 c 1068 1333 m 62 Y -21 16 d -62 Y f 0 0.8 0.6 c 1068 1395 m 62 Y -21
- 16 d -62 Y f 0 0.8 0.4 c 1068 1457 m 62 Y -21 16 d -62 Y f 0 0.8 0.2 c 1068
- 1519 m 63 Y -21 15 d -62 Y f 0 0.8 0 c 1068 1582 m 62 Y -21 15 d -62 Y f 0.2
- 0.8 0 c 1068 1644 m 45 Y -21 16 d -46 Y f black 1047 1100 m 21 -16 d 605 Y -21
- 16 d cl s 0.2 0.8 0 c 1068 1689 m 23 6 d -20 16 d -24 -6 d f black 1068 1689 m
- 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1044 1078 m 24 6 d 63 Y -24 -6 d f 0
- 0.2 0.8 c 1068 1147 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 1068 1209 m 62 Y -24 -6
- d -62 Y f 0 0.6 0.8 c 1068 1271 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 1068 1333 m
- 62 Y -24 -6 d -62 Y f 0 0.8 0.6 c 1068 1395 m 62 Y -24 -6 d -62 Y f 0 0.8 0.4 c
- 1068 1457 m 62 Y -24 -6 d -62 Y f 0 0.8 0.2 c 1068 1519 m 63 Y -24 -6 d -63 Y f
- 0 0.8 0 c 1068 1582 m 62 Y -24 -6 d -62 Y f 0.2 0.8 0 c 1068 1644 m 62 Y -24 -6
- d -62 Y f 0.4 0.8 0 c 1068 1706 m 23 Y -24 -6 d -23 Y f black 1044 1078 m 24 6
- d 645 Y -24 -6 d cl s 0 0 0.8 c 1024 1094 m 20 -16 d 63 Y -20 15 d f 0 0.2 0.8
- c 1044 1141 m 62 Y -20 15 d -62 Y f 0 0.4 0.8 c 1044 1203 m 62 Y -20 15 d -62 Y
- f 0 0.6 0.8 c 1044 1265 m 62 Y -20 16 d -63 Y f 0 0.8 0.8 c 1044 1327 m 62 Y
- -20 16 d -62 Y f 0 0.8 0.6 c 1044 1389 m 62 Y -20 16 d -62 Y f 0 0.8 0.4 c 1044
- 1451 m 62 Y -20 16 d -62 Y f 0 0.8 0.2 c 1044 1513 m 63 Y -20 15 d -62 Y f 0
- 0.8 0 c 1044 1576 m 62 Y -20 15 d -62 Y f 0.2 0.8 0 c 1044 1638 m 62 Y -20 15 d
- -62 Y f 0.4 0.8 0 c 1044 1700 m 23 Y -20 16 d -24 Y f black 1024 1094 m 20 -16
- d 645 Y -20 16 d cl s 0.4 0.8 0 c 1044 1723 m 24 6 d -21 16 d -23 -6 d f black
- 1044 1723 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1021 1072 m 23 6 d 63 Y -23
- -6 d f 0 0.2 0.8 c 1044 1141 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 1044 1203 m 62
- Y -23 -6 d -62 Y f 0 0.6 0.8 c 1044 1265 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c
- 1044 1327 m 62 Y -23 -6 d -62 Y f 0 0.8 0.6 c 1044 1389 m 62 Y -23 -6 d -62 Y f
- 0 0.8 0.4 c 1044 1451 m 62 Y -23 -6 d -62 Y f 0 0.8 0.2 c 1044 1513 m 63 Y -23
- -6 d -63 Y f 0 0.8 0 c 1044 1576 m 40 Y -23 -6 d -40 Y f black 1021 1072 m 23 6
- d 538 Y -23 -6 d cl s 0 0 0.8 c 1000 1088 m 21 -16 d 63 Y -21 15 d f 0 0.2 0.8
- c 1021 1135 m 62 Y -21 15 d -62 Y f 0 0.4 0.8 c 1021 1197 m 62 Y -21 15 d -62 Y
- f 0 0.6 0.8 c 1021 1259 m 62 Y -21 16 d -63 Y f 0 0.8 0.8 c 1021 1321 m 62 Y
- -21 16 d -62 Y f 0 0.8 0.6 c 1021 1383 m 62 Y -21 16 d -62 Y f 0 0.8 0.4 c 1021
- 1445 m 62 Y -21 16 d -62 Y f 0 0.8 0.2 c 1021 1507 m 63 Y -21 15 d -62 Y f 0
- 0.8 0 c 1021 1570 m 40 Y -21 15 d -40 Y f black 1000 1088 m 21 -16 d 538 Y -21
- 15 d cl s 0 0.8 0 c 1021 1610 m 23 6 d -20 15 d -24 -6 d f black 1021 1610 m 23
- 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 997 1066 m 24 6 d 63 Y -24 -6 d f 0 0.2
- 0.8 c 1021 1135 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 1021 1197 m 62 Y -24 -6 d
- -62 Y f 0 0.6 0.8 c 1021 1259 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 1021 1321 m
- 62 Y -24 -6 d -62 Y f 0 0.8 0.6 c 1021 1383 m 62 Y -24 -6 d -62 Y f 0 0.8 0.4 c
- 1021 1445 m 62 Y -24 -6 d -62 Y f 0 0.8 0.2 c 1021 1507 m 63 Y -24 -6 d -63 Y f
- 0 0.8 0 c 1021 1570 m 62 Y -24 -6 d -62 Y f 0.2 0.8 0 c 1021 1632 m 62 Y -24 -6
- d -62 Y f 0.4 0.8 0 c 1021 1694 m 62 Y -24 -6 d -62 Y f 0.6 0.8 0 c 1021 1756 m
- 15 Y -24 -6 d -15 Y f black 997 1066 m 24 6 d 699 Y -24 -6 d cl s 0 0 0.8 c 977
- 1082 m 20 -16 d 63 Y -20 15 d f 0 0.2 0.8 c 997 1129 m 62 Y -20 15 d -62 Y f 0
- 0.4 0.8 c 997 1191 m 62 Y -20 15 d -62 Y f 0 0.6 0.8 c 997 1253 m 62 Y -20 16 d
- -63 Y f 0 0.8 0.8 c 997 1315 m 62 Y -20 16 d -62 Y f 0 0.8 0.6 c 997 1377 m 62
- Y -20 16 d -62 Y f 0 0.8 0.4 c 997 1439 m 62 Y -20 16 d -62 Y f 0 0.8 0.2 c 997
- 1501 m 63 Y -20 15 d -62 Y f 0 0.8 0 c 997 1564 m 62 Y -20 15 d -62 Y f 0.2 0.8
- 0 c 997 1626 m 62 Y -20 15 d -62 Y f 0.4 0.8 0 c 997 1688 m 62 Y -20 16 d -63 Y
- f 0.6 0.8 0 c 997 1750 m 15 Y -20 16 d -15 Y f black 977 1082 m 20 -16 d 699 Y
- -20 16 d cl s 0.6 0.8 0 c 997 1765 m 24 6 d -21 16 d -23 -6 d f black 997 1765
- m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 974 1061 m 23 5 d 63 Y -23 -6 d f 0
- 0.2 0.8 c 997 1129 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 997 1191 m 62 Y -23 -6 d
- -62 Y f 0 0.6 0.8 c 997 1253 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 997 1315 m 62
- Y -23 -6 d -62 Y f 0 0.8 0.6 c 997 1377 m 62 Y -23 -6 d -62 Y f 0 0.8 0.4 c 997
- 1439 m 62 Y -23 -6 d -62 Y f 0 0.8 0.2 c 997 1501 m 63 Y -23 -6 d -63 Y f 0 0.8
- 0 c 997 1564 m 53 Y -23 -6 d -53 Y f black 974 1061 m 23 5 d 551 Y -23 -6 d
- cl s 0 0 0.8 c 953 1076 m 21 -15 d 62 Y -21 15 d f 0 0.2 0.8 c 974 1123 m 62 Y
- -21 15 d -62 Y f 0 0.4 0.8 c 974 1185 m 62 Y -21 15 d -62 Y f 0 0.6 0.8 c 974
- 1247 m 62 Y -21 16 d -63 Y f 0 0.8 0.8 c 974 1309 m 62 Y -21 16 d -62 Y f 0 0.8
- 0.6 c 974 1371 m 62 Y -21 16 d -62 Y f 0 0.8 0.4 c 974 1433 m 62 Y -21 16 d -62
- Y f 0 0.8 0.2 c 974 1495 m 63 Y -21 15 d -62 Y f 0 0.8 0 c 974 1558 m 53 Y -21
- 16 d -54 Y f black 953 1076 m 21 -15 d 550 Y -21 16 d cl s 0 0.8 0 c 974 1611 m
- 23 6 d -20 16 d -24 -6 d f black 974 1611 m 23 6 d -20 16 d -24 -6 d cl s 0 0
- 0.8 c 950 1055 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 974 1123 m 62 Y -24 -6 d
- -62 Y f 0 0.4 0.8 c 974 1185 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 974 1247 m 62
- Y -24 -6 d -62 Y f 0 0.8 0.8 c 974 1309 m 62 Y -24 -6 d -62 Y f 0 0.8 0.6 c 974
- 1371 m 62 Y -24 -6 d -62 Y f 0 0.8 0.4 c 974 1433 m 62 Y -24 -5 d -63 Y f 0 0.8
- 0.2 c 974 1495 m 63 Y -24 -6 d -62 Y f 0 0.8 0 c 974 1558 m 53 Y -24 -6 d -53 Y
- f black 950 1055 m 24 6 d 550 Y -24 -6 d cl s 0 0 0.8 c 930 1070 m 20 -15 d 62
- Y -20 15 d f 0 0.2 0.8 c 950 1117 m 62 Y -20 15 d -62 Y f 0 0.4 0.8 c 950 1179
- m 62 Y -20 15 d -62 Y f 0 0.6 0.8 c 950 1241 m 62 Y -20 16 d -63 Y f 0 0.8 0.8
- c 950 1303 m 62 Y -20 16 d -62 Y f 0 0.8 0.6 c 950 1365 m 62 Y -20 16 d -62 Y f
- 0 0.8 0.4 c 950 1427 m 63 Y -20 15 d -62 Y f 0 0.8 0.2 c 950 1490 m 62 Y -20 15
- d -62 Y f 0 0.8 0 c 950 1552 m 53 Y -20 16 d -54 Y f black 930 1070 m 20 -15 d
- 550 Y -20 16 d cl s 0 0.8 0 c 950 1605 m 24 6 d -21 16 d -23 -6 d f black 950
- 1605 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 927 1049 m 23 6 d 62 Y -23 -6 d
- f 0 0.2 0.8 c 950 1117 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 950 1179 m 62 Y -23
- -6 d -62 Y f 0 0.6 0.8 c 950 1241 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 950 1303
- m 62 Y -23 -6 d -62 Y f 0 0.8 0.6 c 950 1365 m 62 Y -23 -6 d -62 Y f 0 0.8 0.4
- c 950 1427 m 63 Y -23 -6 d -63 Y f 0 0.8 0.2 c 950 1490 m 62 Y -23 -6 d -62 Y f
- 0 0.8 0 c 950 1552 m 62 Y -23 -6 d -62 Y f 0.2 0.8 0 c 950 1614 m 59 Y -23 -6 d
- -59 Y f black 927 1049 m 23 6 d 618 Y -23 -6 d cl s 0 0 0.8 c 906 1064 m 21 -15
- d 62 Y -21 15 d f 0 0.2 0.8 c 927 1111 m 62 Y -21 15 d -62 Y f 0 0.4 0.8 c 927
- 1173 m 62 Y -21 16 d -63 Y f 0 0.6 0.8 c 927 1235 m 62 Y -21 16 d -62 Y f 0 0.8
- 0.8 c 927 1297 m 62 Y -21 16 d -62 Y f 0 0.8 0.6 c 927 1359 m 62 Y -21 16 d -62
- Y f 0 0.8 0.4 c 927 1421 m 63 Y -21 15 d -62 Y f 0 0.8 0.2 c 927 1484 m 62 Y
- -21 15 d -62 Y f 0 0.8 0 c 927 1546 m 62 Y -21 15 d -62 Y f 0.2 0.8 0 c 927
- 1608 m 59 Y -21 15 d -59 Y f black 906 1064 m 21 -15 d 618 Y -21 15 d cl s 0.2
- 0.8 0 c 927 1667 m 23 6 d -20 15 d -24 -6 d f black 927 1667 m 23 6 d -20 15 d
- -24 -6 d cl s 0 0 0.8 c 903 1043 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 927 1111
- m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 927 1173 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8
- c 927 1235 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 927 1297 m 62 Y -24 -6 d -62 Y f
- 0 0.8 0.6 c 927 1359 m 62 Y -24 -6 d -62 Y f 0 0.8 0.4 c 927 1421 m 63 Y -24 -6
- d -63 Y f 0 0.8 0.2 c 927 1484 m 62 Y -24 -6 d -62 Y f 0 0.8 0 c 927 1546 m 62
- Y -24 -6 d -62 Y f 0.2 0.8 0 c 927 1608 m 62 Y -24 -6 d -62 Y f 0.4 0.8 0 c 927
- 1670 m 50 Y -24 -6 d -50 Y f black 903 1043 m 24 6 d 671 Y -24 -6 d cl s 0 0
- 0.8 c 883 1058 m 20 -15 d 62 Y -20 15 d f 0 0.2 0.8 c 903 1105 m 62 Y -20 15 d
- -62 Y f 0 0.4 0.8 c 903 1167 m 62 Y -20 16 d -63 Y f 0 0.6 0.8 c 903 1229 m 62
- Y -20 16 d -62 Y f 0 0.8 0.8 c 903 1291 m 62 Y -20 16 d -62 Y f 0 0.8 0.6 c 903
- 1353 m 62 Y -20 16 d -62 Y f 0 0.8 0.4 c 903 1415 m 63 Y -20 15 d -62 Y f 0 0.8
- 0.2 c 903 1478 m 62 Y -20 15 d -62 Y f 0 0.8 0 c 903 1540 m 62 Y -20 15 d -62 Y
- f 0.2 0.8 0 c 903 1602 m 62 Y -20 16 d -63 Y f 0.4 0.8 0 c 903 1664 m 50 Y -20
- 16 d -50 Y f black 883 1058 m 20 -15 d 671 Y -20 16 d cl s 0.4 0.8 0 c 903 1714
- m 24 6 d -21 16 d -23 -6 d f black 903 1714 m 24 6 d -21 16 d -23 -6 d cl s 0 0
- 0.8 c 880 1037 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 903 1105 m 62 Y -23 -6 d
- -62 Y f 0 0.4 0.8 c 903 1167 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c 903 1229 m 62
- Y -23 -6 d -62 Y f 0 0.8 0.8 c 903 1291 m 62 Y -23 -6 d -62 Y f 0 0.8 0.6 c 903
- 1353 m 62 Y -23 -6 d -62 Y f 0 0.8 0.4 c 903 1415 m 63 Y -23 -6 d -63 Y f 0 0.8
- 0.2 c 903 1478 m 62 Y -23 -6 d -62 Y f 0 0.8 0 c 903 1540 m 62 Y -23 -6 d -62 Y
- f 0.2 0.8 0 c 903 1602 m 62 Y -23 -6 d -62 Y f 0.4 0.8 0 c 903 1664 m 50 Y -23
- -6 d -50 Y f black 880 1037 m 23 6 d 671 Y -23 -6 d cl s 0 0 0.8 c 859 1052 m
- 21 -15 d 62 Y -21 15 d f 0 0.2 0.8 c 880 1099 m 62 Y -21 15 d -62 Y f 0 0.4 0.8
- c 880 1161 m 62 Y -21 16 d -63 Y f 0 0.6 0.8 c 880 1223 m 62 Y -21 16 d -62 Y f
- 0 0.8 0.8 c 880 1285 m 62 Y -21 16 d -62 Y f 0 0.8 0.6 c 880 1347 m 62 Y -21 16
- d -62 Y f 0 0.8 0.4 c 880 1409 m 63 Y -21 15 d -62 Y f 0 0.8 0.2 c 880 1472 m
- 62 Y -21 15 d -62 Y f 0 0.8 0 c 880 1534 m 62 Y -21 15 d -62 Y f 0.2 0.8 0 c
- 880 1596 m 62 Y -21 16 d -63 Y f 0.4 0.8 0 c 880 1658 m 50 Y -21 16 d -50 Y f
- black 859 1052 m 21 -15 d 671 Y -21 16 d cl s 0.4 0.8 0 c 880 1708 m 23 6 d -20
- 16 d -24 -6 d f black 880 1708 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 856
- 1031 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 880 1099 m 62 Y -24 -6 d -62 Y f 0
- 0.4 0.8 c 880 1161 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 880 1223 m 62 Y -24 -6 d
- -62 Y f 0 0.8 0.8 c 880 1285 m 62 Y -24 -6 d -62 Y f 0 0.8 0.6 c 880 1347 m 62
- Y -24 -6 d -62 Y f 0 0.8 0.4 c 880 1409 m 63 Y -24 -6 d -63 Y f 0 0.8 0.2 c 880
- 1472 m 62 Y -24 -6 d -62 Y f 0 0.8 0 c 880 1534 m 62 Y -24 -6 d -62 Y f 0.2 0.8
- 0 c 880 1596 m 62 Y -24 -6 d -62 Y f 0.4 0.8 0 c 880 1658 m 37 Y -24 -6 d -37 Y
- f black 856 1031 m 24 6 d 658 Y -24 -6 d cl s 0 0 0.8 c 836 1046 m 20 -15 d 62
- Y -20 15 d f 0 0.2 0.8 c 856 1093 m 62 Y -20 15 d -62 Y f 0 0.4 0.8 c 856 1155
- m 62 Y -20 16 d -63 Y f 0 0.6 0.8 c 856 1217 m 62 Y -20 16 d -62 Y f 0 0.8 0.8
- c 856 1279 m 62 Y -20 16 d -62 Y f 0 0.8 0.6 c 856 1341 m 62 Y -20 16 d -62 Y f
- 0 0.8 0.4 c 856 1403 m 63 Y -20 15 d -62 Y f 0 0.8 0.2 c 856 1466 m 62 Y -20 15
- d -62 Y f 0 0.8 0 c 856 1528 m 62 Y -20 15 d -62 Y f 0.2 0.8 0 c 856 1590 m 62
- Y -20 16 d -63 Y f 0.4 0.8 0 c 856 1652 m 37 Y -20 16 d -37 Y f black 836 1046
- m 20 -15 d 658 Y -20 16 d cl s 0.4 0.8 0 c 856 1689 m 24 6 d -21 15 d -23 -5 d
- f black 856 1689 m 24 6 d -21 15 d -23 -5 d cl s 0 0 0.8 c 833 1025 m 23 6 d 62
- Y -23 -6 d f 0 0.2 0.8 c 856 1093 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 856 1155
- m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c 856 1217 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8
- c 856 1279 m 62 Y -23 -6 d -62 Y f 0 0.8 0.6 c 856 1341 m 62 Y -23 -6 d -62 Y f
- 0 0.8 0.4 c 856 1403 m 63 Y -23 -6 d -63 Y f 0 0.8 0.2 c 856 1466 m 62 Y -23 -6
- d -62 Y f 0 0.8 0 c 856 1528 m 62 Y -23 -6 d -62 Y f 0.2 0.8 0 c 856 1590 m 18
- Y -23 -6 d -18 Y f black 833 1025 m 23 6 d 577 Y -23 -6 d cl s 0 0 0.8 c 812
- 1040 m 21 -15 d 62 Y -21 15 d f 0 0.2 0.8 c 833 1087 m 62 Y -21 15 d -62 Y f 0
- 0.4 0.8 c 833 1149 m 62 Y -21 16 d -63 Y f 0 0.6 0.8 c 833 1211 m 62 Y -21 16 d
- -62 Y f 0 0.8 0.8 c 833 1273 m 62 Y -21 16 d -62 Y f 0 0.8 0.6 c 833 1335 m 62
- Y -21 16 d -62 Y f 0 0.8 0.4 c 833 1397 m 63 Y -21 15 d -62 Y f 0 0.8 0.2 c 833
- 1460 m 62 Y -21 15 d -62 Y f 0 0.8 0 c 833 1522 m 62 Y -21 15 d -62 Y f 0.2 0.8
- 0 c 833 1584 m 18 Y -21 16 d -19 Y f black 812 1040 m 21 -15 d 577 Y -21 16 d
- cl s 0.2 0.8 0 c 833 1602 m 23 6 d -20 16 d -24 -6 d f black 833 1602 m 23 6 d
- -20 16 d -24 -6 d cl s 0 0 0.8 c 809 1019 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c
- 833 1087 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 833 1149 m 62 Y -24 -6 d -62 Y f 0
- 0.6 0.8 c 833 1211 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 833 1273 m 62 Y -24 -6 d
- -62 Y f 0 0.8 0.6 c 833 1335 m 62 Y -24 -6 d -62 Y f 0 0.8 0.4 c 833 1397 m 63
- Y -24 -6 d -63 Y f 0 0.8 0.2 c 833 1460 m 62 Y -24 -6 d -62 Y f 0 0.8 0 c 833
- 1522 m 62 Y -24 -6 d -62 Y f 0.2 0.8 0 c 833 1584 m 62 Y -24 -6 d -62 Y f 0.4
- 0.8 0 c 833 1646 m 62 Y -24 -6 d -62 Y f 0.6 0.8 0 c 833 1708 m 15 Y -24 -6 d
- -15 Y f black 809 1019 m 24 6 d 698 Y -24 -6 d cl s 0 0 0.8 c 789 1034 m 20 -15
- d 62 Y -20 15 d f 0 0.2 0.8 c 809 1081 m 62 Y -20 15 d -62 Y f 0 0.4 0.8 c 809
- 1143 m 62 Y -20 16 d -63 Y f 0 0.6 0.8 c 809 1205 m 62 Y -20 16 d -62 Y f 0 0.8
- 0.8 c 809 1267 m 62 Y -20 16 d -62 Y f 0 0.8 0.6 c 809 1329 m 62 Y -20 16 d -62
- Y f 0 0.8 0.4 c 809 1391 m 63 Y -20 15 d -62 Y f 0 0.8 0.2 c 809 1454 m 62 Y
- -20 15 d -62 Y f 0 0.8 0 c 809 1516 m 62 Y -20 15 d -62 Y f 0.2 0.8 0 c 809
- 1578 m 62 Y -20 16 d -63 Y f 0.4 0.8 0 c 809 1640 m 62 Y -20 16 d -62 Y f 0.6
- 0.8 0 c 809 1702 m 15 Y -20 16 d -15 Y f black 789 1034 m 20 -15 d 698 Y -20 16
- d cl s 0.6 0.8 0 c 809 1717 m 24 6 d -21 16 d -23 -6 d f black 809 1717 m 24 6
- d -21 16 d -23 -6 d cl s 0 0 0.8 c 786 1013 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8
- c 809 1081 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 809 1143 m 62 Y -23 -6 d -62 Y f
- 0 0.6 0.8 c 809 1205 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 809 1267 m 62 Y -23 -6
- d -62 Y f 0 0.8 0.6 c 809 1329 m 62 Y -23 -5 d -63 Y f 0 0.8 0.4 c 809 1391 m
- 63 Y -23 -6 d -62 Y f 0 0.8 0.2 c 809 1454 m 62 Y -23 -6 d -62 Y f 0 0.8 0 c
- 809 1516 m 62 Y -23 -6 d -62 Y f 0.2 0.8 0 c 809 1578 m 62 Y -23 -6 d -62 Y f
- 0.4 0.8 0 c 809 1640 m 62 Y -23 -6 d -62 Y f 0.6 0.8 0 c 809 1702 m 62 Y -23 -6
- d -62 Y f 0.8 0.8 0 c 809 1764 m 62 Y -23 -5 d -63 Y f 0.8 0.6 0 c 809 1826 m
- 53 Y -23 -6 d -52 Y f black 786 1013 m 23 6 d 860 Y -23 -6 d cl s 0 0 0.8 c 765
- 1028 m 21 -15 d 62 Y -21 15 d f 0 0.2 0.8 c 786 1075 m 62 Y -21 15 d -62 Y f 0
- 0.4 0.8 c 786 1137 m 62 Y -21 16 d -63 Y f 0 0.6 0.8 c 786 1199 m 62 Y -21 16 d
- -62 Y f 0 0.8 0.8 c 786 1261 m 62 Y -21 16 d -62 Y f 0 0.8 0.6 c 786 1323 m 63
- Y -21 15 d -62 Y f 0 0.8 0.4 c 786 1386 m 62 Y -21 15 d -62 Y f 0 0.8 0.2 c 786
- 1448 m 62 Y -21 15 d -62 Y f 0 0.8 0 c 786 1510 m 62 Y -21 15 d -62 Y f 0.2 0.8
- 0 c 786 1572 m 62 Y -21 16 d -63 Y f 0.4 0.8 0 c 786 1634 m 62 Y -21 16 d -62 Y
- f 0.6 0.8 0 c 786 1696 m 62 Y -21 16 d -62 Y f 0.8 0.8 0 c 786 1758 m 63 Y -21
- 15 d -62 Y f 0.8 0.6 0 c 786 1821 m 52 Y -21 15 d -52 Y f black 765 1028 m 21
- -15 d 860 Y -21 15 d cl s 0.8 0.6 0 c 786 1873 m 23 6 d -20 15 d -24 -6 d f
- black 786 1873 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 762 1007 m 24 6 d 62 Y
- -24 -6 d f 0 0.2 0.8 c 786 1075 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 786 1137 m
- 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 786 1199 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c
- 786 1261 m 62 Y -24 -6 d -62 Y f 0 0.8 0.6 c 786 1323 m 63 Y -24 -6 d -63 Y f 0
- 0.8 0.4 c 786 1386 m 62 Y -24 -6 d -62 Y f 0 0.8 0.2 c 786 1448 m 62 Y -24 -6 d
- -62 Y f 0 0.8 0 c 786 1510 m 62 Y -24 -6 d -62 Y f 0.2 0.8 0 c 786 1572 m 62 Y
- -24 -6 d -62 Y f 0.4 0.8 0 c 786 1634 m 62 Y -24 -6 d -62 Y f 0.6 0.8 0 c 786
- 1696 m 62 Y -24 -6 d -62 Y f 0.8 0.8 0 c 786 1758 m 63 Y -24 -6 d -63 Y f 0.8
- 0.6 0 c 786 1821 m 62 Y -24 -6 d -62 Y f 0.8 0.4 0 c 786 1883 m 43 Y -24 -6 d
- -43 Y f black 762 1007 m 24 6 d 913 Y -24 -6 d cl s 0 0 0.8 c 742 1022 m 20 -15
- d 62 Y -20 15 d f 0 0.2 0.8 c 762 1069 m 62 Y -20 16 d -63 Y f 0 0.4 0.8 c 762
- 1131 m 62 Y -20 16 d -62 Y f 0 0.6 0.8 c 762 1193 m 62 Y -20 16 d -62 Y f 0 0.8
- 0.8 c 762 1255 m 62 Y -20 16 d -62 Y f 0 0.8 0.6 c 762 1317 m 63 Y -20 15 d -62
- Y f 0 0.8 0.4 c 762 1380 m 62 Y -20 15 d -62 Y f 0 0.8 0.2 c 762 1442 m 62 Y
- -20 15 d -62 Y f 0 0.8 0 c 762 1504 m 62 Y -20 15 d -62 Y f 0.2 0.8 0 c 762
- 1566 m 62 Y -20 16 d -63 Y f 0.4 0.8 0 c 762 1628 m 62 Y -20 16 d -62 Y f 0.6
- 0.8 0 c 762 1690 m 62 Y -20 16 d -62 Y f 0.8 0.8 0 c 762 1752 m 63 Y -20 15 d
- -62 Y f 0.8 0.6 0 c 762 1815 m 62 Y -20 15 d -62 Y f 0.8 0.4 0 c 762 1877 m 43
- Y -20 16 d -44 Y f black 742 1022 m 20 -15 d 913 Y -20 16 d cl s 0.8 0.4 0 c
- 762 1920 m 24 6 d -21 16 d -23 -6 d f black 762 1920 m 24 6 d -21 16 d -23 -6 d
- cl s 0 0 0.8 c 739 1001 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 762 1069 m 62 Y
- -23 -6 d -62 Y f 0 0.4 0.8 c 762 1131 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c 762
- 1193 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 762 1255 m 62 Y -23 -6 d -62 Y f 0 0.8
- 0.6 c 762 1317 m 63 Y -23 -6 d -63 Y f 0 0.8 0.4 c 762 1380 m 62 Y -23 -6 d -62
- Y f 0 0.8 0.2 c 762 1442 m 62 Y -23 -6 d -62 Y f 0 0.8 0 c 762 1504 m 62 Y -23
- -6 d -62 Y f 0.2 0.8 0 c 762 1566 m 62 Y -23 -6 d -62 Y f 0.4 0.8 0 c 762 1628
- m 62 Y -23 -6 d -62 Y f 0.6 0.8 0 c 762 1690 m 56 Y -23 -6 d -56 Y f black 739
- 1001 m 23 6 d 739 Y -23 -6 d cl s 0 0 0.8 c 718 1016 m 21 -15 d 62 Y -21 15 d f
- 0 0.2 0.8 c 739 1063 m 62 Y -21 16 d -63 Y f 0 0.4 0.8 c 739 1125 m 62 Y -21 16
- d -62 Y f 0 0.6 0.8 c 739 1187 m 62 Y -21 16 d -62 Y f 0 0.8 0.8 c 739 1249 m
- 62 Y -21 16 d -62 Y f 0 0.8 0.6 c 739 1311 m 63 Y -21 15 d -62 Y f 0 0.8 0.4 c
- 739 1374 m 62 Y -21 15 d -62 Y f 0 0.8 0.2 c 739 1436 m 62 Y -21 15 d -62 Y f 0
- 0.8 0 c 739 1498 m 62 Y -21 16 d -63 Y f 0.2 0.8 0 c 739 1560 m 62 Y -21 16 d
- -62 Y f 0.4 0.8 0 c 739 1622 m 62 Y -21 16 d -62 Y f 0.6 0.8 0 c 739 1684 m 56
- Y -21 15 d -55 Y f black 718 1016 m 21 -15 d 739 Y -21 15 d cl s 0.6 0.8 0 c
- 739 1740 m 23 6 d -20 15 d -24 -6 d f black 739 1740 m 23 6 d -20 15 d -24 -6 d
- cl s 0 0 0.8 c 715 995 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 739 1063 m 62 Y -24
- -6 d -62 Y f 0 0.4 0.8 c 739 1125 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 739 1187
- m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 739 1249 m 62 Y -24 -6 d -62 Y f 0 0.8 0.6
- c 739 1311 m 63 Y -24 -6 d -63 Y f 0 0.8 0.4 c 739 1374 m 62 Y -24 -6 d -62 Y f
- 0 0.8 0.2 c 739 1436 m 62 Y -24 -6 d -62 Y f 0 0.8 0 c 739 1498 m 54 Y -24 -6 d
- -54 Y f black 715 995 m 24 6 d 551 Y -24 -6 d cl s 0 0 0.8 c 695 1010 m 20 -15
- d 62 Y -20 15 d f 0 0.2 0.8 c 715 1057 m 62 Y -20 16 d -63 Y f 0 0.4 0.8 c 715
- 1119 m 62 Y -20 16 d -62 Y f 0 0.6 0.8 c 715 1181 m 62 Y -20 16 d -62 Y f 0 0.8
- 0.8 c 715 1243 m 62 Y -20 16 d -62 Y f 0 0.8 0.6 c 715 1305 m 63 Y -20 15 d -62
- Y f 0 0.8 0.4 c 715 1368 m 62 Y -20 15 d -62 Y f 0 0.8 0.2 c 715 1430 m 62 Y
- -20 15 d -62 Y f 0 0.8 0 c 715 1492 m 54 Y -20 15 d -54 Y f black 695 1010 m 20
- -15 d 551 Y -20 15 d cl s 0 0.8 0 c 715 1546 m 24 6 d -21 15 d -23 -6 d f black
- 715 1546 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 692 989 m 23 6 d 62 Y -23 -6
- d f 0 0.2 0.8 c 715 1057 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 715 1119 m 62 Y
- -23 -6 d -62 Y f 0 0.6 0.8 c 715 1181 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 715
- 1243 m 62 Y -23 -6 d -62 Y f 0 0.8 0.6 c 715 1305 m 63 Y -23 -6 d -63 Y f 0 0.8
- 0.4 c 715 1368 m 62 Y -23 -6 d -62 Y f 0 0.8 0.2 c 715 1430 m 62 Y -23 -6 d -62
- Y f 0 0.8 0 c 715 1492 m 62 Y -23 -6 d -62 Y f 0.2 0.8 0 c 715 1554 m 32 Y -23
- -6 d -32 Y f black 692 989 m 23 6 d 591 Y -23 -6 d cl s 0 0 0.8 c 672 1004 m 20
- -15 d 62 Y -20 15 d f 0 0.2 0.8 c 692 1051 m 62 Y -20 16 d -63 Y f 0 0.4 0.8 c
- 692 1113 m 62 Y -20 16 d -62 Y f 0 0.6 0.8 c 692 1175 m 62 Y -20 16 d -62 Y f 0
- 0.8 0.8 c 692 1237 m 62 Y -20 16 d -62 Y f 0 0.8 0.6 c 692 1299 m 63 Y -20 15 d
- -62 Y f 0 0.8 0.4 c 692 1362 m 62 Y -20 15 d -62 Y f 0 0.8 0.2 c 692 1424 m 62
- Y -20 15 d -62 Y f 0 0.8 0 c 692 1486 m 62 Y -20 16 d -63 Y f 0.2 0.8 0 c 692
- 1548 m 32 Y -20 15 d -31 Y f black 672 1004 m 20 -15 d 591 Y -20 15 d cl s 0.2
- 0.8 0 c 692 1580 m 23 6 d -20 15 d -23 -6 d f black 692 1580 m 23 6 d -20 15 d
- -23 -6 d cl s 0 0 0.8 c 668 983 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 692 1051 m
- 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 692 1113 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c
- 692 1175 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 692 1237 m 62 Y -24 -6 d -62 Y f 0
- 0.8 0.6 c 692 1299 m 63 Y -24 -6 d -63 Y f 0 0.8 0.4 c 692 1362 m 62 Y -24 -6 d
- -62 Y f 0 0.8 0.2 c 692 1424 m 62 Y -24 -6 d -62 Y f 0 0.8 0 c 692 1486 m 62 Y
- -24 -6 d -62 Y f 0.2 0.8 0 c 692 1548 m 62 Y -24 -6 d -62 Y f 0.4 0.8 0 c 692
- 1610 m 62 Y -24 -6 d -62 Y f 0.6 0.8 0 c 692 1672 m 15 Y -24 -6 d -15 Y f black
- 668 983 m 24 6 d 698 Y -24 -6 d cl s 0 0 0.8 c 648 998 m 20 -15 d 62 Y -20 15 d
- f 0 0.2 0.8 c 668 1045 m 62 Y -20 16 d -63 Y f 0 0.4 0.8 c 668 1107 m 62 Y -20
- 16 d -62 Y f 0 0.6 0.8 c 668 1169 m 62 Y -20 16 d -62 Y f 0 0.8 0.8 c 668 1231
- m 62 Y -20 16 d -62 Y f 0 0.8 0.6 c 668 1293 m 63 Y -20 15 d -62 Y f 0 0.8 0.4
- c 668 1356 m 62 Y -20 15 d -62 Y f 0 0.8 0.2 c 668 1418 m 62 Y -20 15 d -62 Y f
- 0 0.8 0 c 668 1480 m 62 Y -20 16 d -63 Y f 0.2 0.8 0 c 668 1542 m 62 Y -20 16 d
- -62 Y f 0.4 0.8 0 c 668 1604 m 62 Y -20 16 d -62 Y f 0.6 0.8 0 c 668 1666 m 15
- Y -20 16 d -15 Y f black 648 998 m 20 -15 d 698 Y -20 16 d cl s 0.6 0.8 0 c 668
- 1681 m 24 6 d -20 16 d -24 -6 d f black 668 1681 m 24 6 d -20 16 d -24 -6 d
- cl s 0 0 0.8 c 645 977 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 668 1045 m 62 Y -23
- -6 d -62 Y f 0 0.4 0.8 c 668 1107 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c 668 1169
- m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 668 1231 m 62 Y -23 -6 d -62 Y f 0 0.8 0.6
- c 668 1293 m 63 Y -23 -6 d -63 Y f 0 0.8 0.4 c 668 1356 m 62 Y -23 -6 d -62 Y f
- 0 0.8 0.2 c 668 1418 m 62 Y -23 -6 d -62 Y f 0 0.8 0 c 668 1480 m 62 Y -23 -6 d
- -62 Y f 0.2 0.8 0 c 668 1542 m 59 Y -23 -6 d -59 Y f black 645 977 m 23 6 d 618
- Y -23 -6 d cl s 0 0 0.8 c 625 992 m 20 -15 d 62 Y -20 15 d f 0 0.2 0.8 c 645
- 1039 m 62 Y -20 16 d -63 Y f 0 0.4 0.8 c 645 1101 m 62 Y -20 16 d -62 Y f 0 0.6
- 0.8 c 645 1163 m 62 Y -20 16 d -62 Y f 0 0.8 0.8 c 645 1225 m 62 Y -20 16 d -62
- Y f 0 0.8 0.6 c 645 1287 m 63 Y -20 15 d -62 Y f 0 0.8 0.4 c 645 1350 m 62 Y
- -20 15 d -62 Y f 0 0.8 0.2 c 645 1412 m 62 Y -20 15 d -62 Y f 0 0.8 0 c 645
- 1474 m 62 Y -20 16 d -63 Y f 0.2 0.8 0 c 645 1536 m 59 Y -20 15 d -58 Y f black
- 625 992 m 20 -15 d 618 Y -20 15 d cl s 0.2 0.8 0 c 645 1595 m 23 6 d -20 15 d
- -23 -6 d f black 645 1595 m 23 6 d -20 15 d -23 -6 d cl s 0 0 0.8 c 621 971 m
- 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 645 1039 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c
- 645 1101 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 645 1163 m 62 Y -24 -6 d -62 Y f 0
- 0.8 0.8 c 645 1225 m 62 Y -24 -5 d -63 Y f 0 0.8 0.6 c 645 1287 m 63 Y -24 -6 d
- -62 Y f 0 0.8 0.4 c 645 1350 m 62 Y -24 -6 d -62 Y f 0 0.8 0.2 c 645 1412 m 62
- Y -24 -6 d -62 Y f 0 0.8 0 c 645 1474 m 62 Y -24 -6 d -62 Y f 0.2 0.8 0 c 645
- 1536 m 62 Y -24 -6 d -62 Y f 0.4 0.8 0 c 645 1598 m 62 Y -24 -6 d -62 Y f 0.6
- 0.8 0 c 645 1660 m 42 Y -24 -6 d -42 Y f black 621 971 m 24 6 d 725 Y -24 -6 d
- cl s 0 0 0.8 c 601 986 m 20 -15 d 62 Y -20 15 d f 0 0.2 0.8 c 621 1033 m 62 Y
- -20 16 d -63 Y f 0 0.4 0.8 c 621 1095 m 62 Y -20 16 d -62 Y f 0 0.6 0.8 c 621
- 1157 m 62 Y -20 16 d -62 Y f 0 0.8 0.8 c 621 1219 m 63 Y -20 15 d -62 Y f 0 0.8
- 0.6 c 621 1282 m 62 Y -20 15 d -62 Y f 0 0.8 0.4 c 621 1344 m 62 Y -20 15 d -62
- Y f 0 0.8 0.2 c 621 1406 m 62 Y -20 15 d -62 Y f 0 0.8 0 c 621 1468 m 62 Y -20
- 16 d -63 Y f 0.2 0.8 0 c 621 1530 m 62 Y -20 16 d -62 Y f 0.4 0.8 0 c 621 1592
- m 62 Y -20 16 d -62 Y f 0.6 0.8 0 c 621 1654 m 42 Y -20 16 d -42 Y f black 601
- 986 m 20 -15 d 725 Y -20 16 d cl s 0.6 0.8 0 c 621 1696 m 24 6 d -20 16 d -24
- -6 d f black 621 1696 m 24 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 598 965 m 23 6
- d -20 15 d -23 -6 d f black 598 965 m 23 6 d -20 15 d -23 -6 d cl s 0 0 0.8 c
- 574 959 m 24 6 d -20 15 d -24 -6 d f black 574 959 m 24 6 d -20 15 d -24 -6 d
- cl s 0 0 0.8 c 551 953 m 23 6 d -20 15 d -23 -6 d f black 551 953 m 23 6 d -20
- 15 d -23 -6 d cl s 0 0 0.8 c 527 947 m 24 6 d -20 15 d -24 -6 d f black 527 947
- m 24 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1652 1212 m 23 6 d -20 16 d -24 -6 d
- f black 1652 1212 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1628 1206 m 24 6 d
- -21 16 d -23 -6 d f black 1628 1206 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c
- 1605 1200 m 23 6 d -20 16 d -24 -6 d f black 1605 1200 m 23 6 d -20 16 d -24 -6
- d cl s 0 0 0.8 c 1581 1194 m 24 6 d -21 16 d -23 -6 d f black 1581 1194 m 24 6
- d -21 16 d -23 -6 d cl s 0 0 0.8 c 1558 1188 m 23 6 d 63 Y -23 -6 d f 0 0.2 0.8
- c 1581 1257 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 1581 1319 m 62 Y -23 -6 d -62 Y
- f 0 0.6 0.8 c 1581 1381 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 1581 1443 m 62 Y
- -23 -6 d -62 Y f 0 0.8 0.6 c 1581 1505 m 62 Y -23 -6 d -62 Y f 0 0.8 0.4 c 1581
- 1567 m 62 Y -23 -6 d -62 Y f 0 0.8 0.2 c 1581 1629 m 63 Y -23 -6 d -63 Y f 0
- 0.8 0 c 1581 1692 m 62 Y -23 -6 d -62 Y f 0.2 0.8 0 c 1581 1754 m 62 Y -23 -6 d
- -62 Y f 0.4 0.8 0 c 1581 1816 m 62 Y -23 -6 d -62 Y f 0.6 0.8 0 c 1581 1878 m
- 29 Y -23 -6 d -29 Y f black 1558 1188 m 23 6 d 713 Y -23 -6 d cl s 0 0 0.8 c
- 1537 1204 m 21 -16 d 63 Y -21 15 d f 0 0.2 0.8 c 1558 1251 m 62 Y -21 15 d -62
- Y f 0 0.4 0.8 c 1558 1313 m 62 Y -21 15 d -62 Y f 0 0.6 0.8 c 1558 1375 m 62 Y
- -21 16 d -63 Y f 0 0.8 0.8 c 1558 1437 m 62 Y -21 16 d -62 Y f 0 0.8 0.6 c 1558
- 1499 m 62 Y -21 16 d -62 Y f 0 0.8 0.4 c 1558 1561 m 62 Y -21 16 d -62 Y f 0
- 0.8 0.2 c 1558 1623 m 63 Y -21 15 d -62 Y f 0 0.8 0 c 1558 1686 m 62 Y -21 15 d
- -62 Y f 0.2 0.8 0 c 1558 1748 m 62 Y -21 15 d -62 Y f 0.4 0.8 0 c 1558 1810 m
- 62 Y -21 16 d -63 Y f 0.6 0.8 0 c 1558 1872 m 29 Y -21 15 d -28 Y f black 1537
- 1204 m 21 -16 d 713 Y -21 15 d cl s 0.6 0.8 0 c 1558 1901 m 23 6 d -20 15 d -24
- -6 d f black 1558 1901 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1534 1182 m 24
- 6 d 63 Y -24 -6 d f 0 0.2 0.8 c 1558 1251 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c
- 1558 1313 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 1558 1375 m 62 Y -24 -6 d -62 Y f
- 0 0.8 0.8 c 1558 1437 m 62 Y -24 -6 d -62 Y f 0 0.8 0.6 c 1558 1499 m 62 Y -24
- -6 d -62 Y f 0 0.8 0.4 c 1558 1561 m 62 Y -24 -6 d -62 Y f 0 0.8 0.2 c 1558
- 1623 m 63 Y -24 -6 d -63 Y f 0 0.8 0 c 1558 1686 m 62 Y -24 -6 d -62 Y f 0.2
- 0.8 0 c 1558 1748 m 62 Y -24 -6 d -62 Y f 0.4 0.8 0 c 1558 1810 m 62 Y -24 -6 d
- -62 Y f 0.6 0.8 0 c 1558 1872 m 2 Y -24 -6 d -2 Y f black 1534 1182 m 24 6 d
- 686 Y -24 -6 d cl s 0 0 0.8 c 1514 1198 m 20 -16 d 63 Y -20 15 d f 0 0.2 0.8 c
- 1534 1245 m 62 Y -20 15 d -62 Y f 0 0.4 0.8 c 1534 1307 m 62 Y -20 15 d -62 Y f
- 0 0.6 0.8 c 1534 1369 m 62 Y -20 16 d -63 Y f 0 0.8 0.8 c 1534 1431 m 62 Y -20
- 16 d -62 Y f 0 0.8 0.6 c 1534 1493 m 62 Y -20 16 d -62 Y f 0 0.8 0.4 c 1534
- 1555 m 62 Y -20 16 d -62 Y f 0 0.8 0.2 c 1534 1617 m 63 Y -20 15 d -62 Y f 0
- 0.8 0 c 1534 1680 m 62 Y -20 15 d -62 Y f 0.2 0.8 0 c 1534 1742 m 62 Y -20 15 d
- -62 Y f 0.4 0.8 0 c 1534 1804 m 62 Y -20 16 d -63 Y f 0.6 0.8 0 c 1534 1866 m 2
- Y -20 15 d -1 Y f black 1514 1198 m 20 -16 d 686 Y -20 15 d cl s 0.6 0.8 0 c
- 1534 1868 m 24 6 d -21 15 d -23 -6 d f black 1534 1868 m 24 6 d -21 15 d -23 -6
- d cl s 0 0 0.8 c 1511 1177 m 23 5 d 63 Y -23 -6 d f 0 0.2 0.8 c 1534 1245 m 62
- Y -23 -6 d -62 Y f 0 0.4 0.8 c 1534 1307 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c
- 1534 1369 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 1534 1431 m 62 Y -23 -6 d -62 Y f
- 0 0.8 0.6 c 1534 1493 m 62 Y -23 -6 d -62 Y f 0 0.8 0.4 c 1534 1555 m 62 Y -23
- -5 d -63 Y f 0 0.8 0.2 c 1534 1617 m 63 Y -23 -6 d -62 Y f 0 0.8 0 c 1534 1680
- m 62 Y -23 -6 d -62 Y f 0.2 0.8 0 c 1534 1742 m 62 Y -23 -6 d -62 Y f 0.4 0.8 0
- c 1534 1804 m 62 Y -23 -6 d -62 Y f 0.6 0.8 0 c 1534 1866 m 15 Y -23 -6 d -15 Y
- f black 1511 1177 m 23 5 d 699 Y -23 -6 d cl s 0 0 0.8 c 1490 1192 m 21 -15 d
- 62 Y -21 15 d f 0 0.2 0.8 c 1511 1239 m 62 Y -21 15 d -62 Y f 0 0.4 0.8 c 1511
- 1301 m 62 Y -21 15 d -62 Y f 0 0.6 0.8 c 1511 1363 m 62 Y -21 16 d -63 Y f 0
- 0.8 0.8 c 1511 1425 m 62 Y -21 16 d -62 Y f 0 0.8 0.6 c 1511 1487 m 62 Y -21 16
- d -62 Y f 0 0.8 0.4 c 1511 1549 m 63 Y -21 15 d -62 Y f 0 0.8 0.2 c 1511 1612 m
- 62 Y -21 15 d -62 Y f 0 0.8 0 c 1511 1674 m 62 Y -21 15 d -62 Y f 0.2 0.8 0 c
- 1511 1736 m 62 Y -21 15 d -62 Y f 0.4 0.8 0 c 1511 1798 m 62 Y -21 16 d -63 Y f
- 0.6 0.8 0 c 1511 1860 m 15 Y -21 16 d -15 Y f black 1490 1192 m 21 -15 d 698 Y
- -21 16 d cl s 0.6 0.8 0 c 1511 1875 m 23 6 d -20 16 d -24 -6 d f black 1511
- 1875 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1487 1171 m 24 6 d 62 Y -24 -6 d
- f 0 0.2 0.8 c 1511 1239 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 1511 1301 m 62 Y
- -24 -6 d -62 Y f 0 0.6 0.8 c 1511 1363 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 1511
- 1425 m 62 Y -24 -6 d -62 Y f 0 0.8 0.6 c 1511 1487 m 62 Y -24 -6 d -62 Y f 0
- 0.8 0.4 c 1511 1549 m 63 Y -24 -6 d -63 Y f 0 0.8 0.2 c 1511 1612 m 62 Y -24 -6
- d -62 Y f 0 0.8 0 c 1511 1674 m 27 Y -24 -6 d -27 Y f black 1487 1171 m 24 6 d
- 524 Y -24 -6 d cl s 0 0 0.8 c 1467 1186 m 20 -15 d 62 Y -20 15 d f 0 0.2 0.8 c
- 1487 1233 m 62 Y -20 15 d -62 Y f 0 0.4 0.8 c 1487 1295 m 62 Y -20 16 d -63 Y f
- 0 0.6 0.8 c 1487 1357 m 62 Y -20 16 d -62 Y f 0 0.8 0.8 c 1487 1419 m 62 Y -20
- 16 d -62 Y f 0 0.8 0.6 c 1487 1481 m 62 Y -20 16 d -62 Y f 0 0.8 0.4 c 1487
- 1543 m 63 Y -20 15 d -62 Y f 0 0.8 0.2 c 1487 1606 m 62 Y -20 15 d -62 Y f 0
- 0.8 0 c 1487 1668 m 27 Y -20 15 d -27 Y f black 1467 1186 m 20 -15 d 524 Y -20
- 15 d cl s 0 0.8 0 c 1487 1695 m 24 6 d -21 15 d -23 -6 d f black 1487 1695 m 24
- 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 1464 1165 m 23 6 d 62 Y -23 -6 d f 0 0.2
- 0.8 c 1487 1233 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 1487 1295 m 62 Y -23 -6 d
- -62 Y f 0 0.6 0.8 c 1487 1357 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 1487 1419 m
- 62 Y -23 -6 d -62 Y f 0 0.8 0.6 c 1487 1481 m 62 Y -23 -6 d -62 Y f 0 0.8 0.4 c
- 1487 1543 m 63 Y -23 -6 d -63 Y f 0 0.8 0.2 c 1487 1606 m 62 Y -23 -6 d -62 Y f
- 0 0.8 0 c 1487 1668 m 62 Y -23 -6 d -62 Y f 0.2 0.8 0 c 1487 1730 m 45 Y -23 -6
- d -45 Y f black 1464 1165 m 23 6 d 604 Y -23 -6 d cl s 0 0 0.8 c 1444 1180 m 20
- -15 d 62 Y -20 15 d f 0 0.2 0.8 c 1464 1227 m 62 Y -20 15 d -62 Y f 0 0.4 0.8 c
- 1464 1289 m 62 Y -20 16 d -63 Y f 0 0.6 0.8 c 1464 1351 m 62 Y -20 16 d -62 Y f
- 0 0.8 0.8 c 1464 1413 m 62 Y -20 16 d -62 Y f 0 0.8 0.6 c 1464 1475 m 62 Y -20
- 16 d -62 Y f 0 0.8 0.4 c 1464 1537 m 63 Y -20 15 d -62 Y f 0 0.8 0.2 c 1464
- 1600 m 62 Y -20 15 d -62 Y f 0 0.8 0 c 1464 1662 m 62 Y -20 15 d -62 Y f 0.2
- 0.8 0 c 1464 1724 m 45 Y -20 16 d -46 Y f black 1444 1180 m 20 -15 d 604 Y -20
- 16 d cl s 0.2 0.8 0 c 1464 1769 m 23 6 d -20 16 d -23 -6 d f black 1464 1769 m
- 23 6 d -20 16 d -23 -6 d cl s 0 0 0.8 c 1440 1159 m 24 6 d 62 Y -24 -6 d f 0
- 0.2 0.8 c 1464 1227 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 1464 1289 m 62 Y -24 -6
- d -62 Y f 0 0.6 0.8 c 1464 1351 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 1464 1413 m
- 62 Y -24 -6 d -62 Y f 0 0.8 0.6 c 1464 1475 m 62 Y -24 -6 d -62 Y f 0 0.8 0.4 c
- 1464 1537 m 63 Y -24 -6 d -63 Y f 0 0.8 0.2 c 1464 1600 m 62 Y -24 -6 d -62 Y f
- 0 0.8 0 c 1464 1662 m 62 Y -24 -6 d -62 Y f 0.2 0.8 0 c 1464 1724 m 62 Y -24 -6
- d -62 Y f 0.4 0.8 0 c 1464 1786 m 62 Y -24 -6 d -62 Y f 0.6 0.8 0 c 1464 1848 m
- 62 Y -24 -6 d -62 Y f 0.8 0.8 0 c 1464 1910 m 47 Y -24 -6 d -47 Y f black 1440
- 1159 m 24 6 d 792 Y -24 -6 d cl s 0 0 0.8 c 1420 1174 m 20 -15 d 62 Y -20 15 d
- f 0 0.2 0.8 c 1440 1221 m 62 Y -20 15 d -62 Y f 0 0.4 0.8 c 1440 1283 m 62 Y
- -20 16 d -63 Y f 0 0.6 0.8 c 1440 1345 m 62 Y -20 16 d -62 Y f 0 0.8 0.8 c 1440
- 1407 m 62 Y -20 16 d -62 Y f 0 0.8 0.6 c 1440 1469 m 62 Y -20 16 d -62 Y f 0
- 0.8 0.4 c 1440 1531 m 63 Y -20 15 d -62 Y f 0 0.8 0.2 c 1440 1594 m 62 Y -20 15
- d -62 Y f 0 0.8 0 c 1440 1656 m 62 Y -20 15 d -62 Y f 0.2 0.8 0 c 1440 1718 m
- 62 Y -20 16 d -63 Y f 0.4 0.8 0 c 1440 1780 m 62 Y -20 16 d -62 Y f 0.6 0.8 0 c
- 1440 1842 m 62 Y -20 16 d -62 Y f 0.8 0.8 0 c 1440 1904 m 47 Y -20 16 d -47 Y f
- black 1420 1174 m 20 -15 d 792 Y -20 16 d cl s 0.8 0.8 0 c 1440 1951 m 24 6 d
- -20 16 d -24 -6 d f black 1440 1951 m 24 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c
- 1417 1153 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 1440 1221 m 62 Y -23 -6 d -62 Y
- f 0 0.4 0.8 c 1440 1283 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c 1440 1345 m 62 Y
- -23 -6 d -62 Y f 0 0.8 0.8 c 1440 1407 m 62 Y -23 -6 d -62 Y f 0 0.8 0.6 c 1440
- 1469 m 62 Y -23 -6 d -62 Y f 0 0.8 0.4 c 1440 1531 m 63 Y -23 -6 d -63 Y f 0
- 0.8 0.2 c 1440 1594 m 62 Y -23 -6 d -62 Y f 0 0.8 0 c 1440 1656 m 62 Y -23 -6 d
- -62 Y f 0.2 0.8 0 c 1440 1718 m 62 Y -23 -6 d -62 Y f 0.4 0.8 0 c 1440 1780 m
- 24 Y -23 -6 d -24 Y f black 1417 1153 m 23 6 d 645 Y -23 -6 d cl s 0 0 0.8 c
- 1397 1168 m 20 -15 d 62 Y -20 15 d f 0 0.2 0.8 c 1417 1215 m 62 Y -20 15 d -62
- Y f 0 0.4 0.8 c 1417 1277 m 62 Y -20 16 d -63 Y f 0 0.6 0.8 c 1417 1339 m 62 Y
- -20 16 d -62 Y f 0 0.8 0.8 c 1417 1401 m 62 Y -20 16 d -62 Y f 0 0.8 0.6 c 1417
- 1463 m 62 Y -20 16 d -62 Y f 0 0.8 0.4 c 1417 1525 m 63 Y -20 15 d -62 Y f 0
- 0.8 0.2 c 1417 1588 m 62 Y -20 15 d -62 Y f 0 0.8 0 c 1417 1650 m 62 Y -20 15 d
- -62 Y f 0.2 0.8 0 c 1417 1712 m 62 Y -20 16 d -63 Y f 0.4 0.8 0 c 1417 1774 m
- 24 Y -20 15 d -23 Y f black 1397 1168 m 20 -15 d 645 Y -20 15 d cl s 0.4 0.8 0
- c 1417 1798 m 23 6 d -20 15 d -23 -6 d f black 1417 1798 m 23 6 d -20 15 d -23
- -6 d cl s 0 0 0.8 c 1393 1147 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1417 1215 m
- 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 1417 1277 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c
- 1417 1339 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 1417 1401 m 62 Y -24 -6 d -62 Y f
- 0 0.8 0.6 c 1417 1463 m 62 Y -24 -6 d -62 Y f 0 0.8 0.4 c 1417 1525 m 63 Y -24
- -6 d -63 Y f 0 0.8 0.2 c 1417 1588 m 62 Y -24 -6 d -62 Y f 0 0.8 0 c 1417 1650
- m 62 Y -24 -6 d -62 Y f 0.2 0.8 0 c 1417 1712 m 62 Y -24 -6 d -62 Y f 0.4 0.8 0
- c 1417 1774 m 62 Y -24 -6 d -62 Y f 0.6 0.8 0 c 1417 1836 m 15 Y -24 -6 d -15 Y
- f black 1393 1147 m 24 6 d 698 Y -24 -6 d cl s 0 0 0.8 c 1373 1162 m 20 -15 d
- 62 Y -20 15 d f 0 0.2 0.8 c 1393 1209 m 62 Y -20 15 d -62 Y f 0 0.4 0.8 c 1393
- 1271 m 62 Y -20 16 d -63 Y f 0 0.6 0.8 c 1393 1333 m 62 Y -20 16 d -62 Y f 0
- 0.8 0.8 c 1393 1395 m 62 Y -20 16 d -62 Y f 0 0.8 0.6 c 1393 1457 m 62 Y -20 16
- d -62 Y f 0 0.8 0.4 c 1393 1519 m 63 Y -20 15 d -62 Y f 0 0.8 0.2 c 1393 1582 m
- 62 Y -20 15 d -62 Y f 0 0.8 0 c 1393 1644 m 62 Y -20 15 d -62 Y f 0.2 0.8 0 c
- 1393 1706 m 62 Y -20 16 d -63 Y f 0.4 0.8 0 c 1393 1768 m 62 Y -20 16 d -62 Y f
- 0.6 0.8 0 c 1393 1830 m 15 Y -20 16 d -15 Y f black 1373 1162 m 20 -15 d 698 Y
- -20 16 d cl s 0.6 0.8 0 c 1393 1845 m 24 6 d -20 16 d -24 -6 d f black 1393
- 1845 m 24 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1370 1141 m 23 6 d 62 Y -23 -6 d
- f 0 0.2 0.8 c 1393 1209 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 1393 1271 m 62 Y
- -23 -6 d -62 Y f 0 0.6 0.8 c 1393 1333 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 1393
- 1395 m 62 Y -23 -6 d -62 Y f 0 0.8 0.6 c 1393 1457 m 62 Y -23 -6 d -62 Y f 0
- 0.8 0.4 c 1393 1519 m 63 Y -23 -6 d -63 Y f 0 0.8 0.2 c 1393 1582 m 62 Y -23 -6
- d -62 Y f 0 0.8 0 c 1393 1644 m 62 Y -23 -6 d -62 Y f 0.2 0.8 0 c 1393 1706 m
- 62 Y -23 -6 d -62 Y f 0.4 0.8 0 c 1393 1768 m 24 Y -23 -6 d -24 Y f black 1370
- 1141 m 23 6 d 645 Y -23 -6 d cl s 0 0 0.8 c 1350 1156 m 20 -15 d 62 Y -20 15 d
- f 0 0.2 0.8 c 1370 1203 m 62 Y -20 15 d -62 Y f 0 0.4 0.8 c 1370 1265 m 62 Y
- -20 16 d -63 Y f 0 0.6 0.8 c 1370 1327 m 62 Y -20 16 d -62 Y f 0 0.8 0.8 c 1370
- 1389 m 62 Y -20 16 d -62 Y f 0 0.8 0.6 c 1370 1451 m 62 Y -20 16 d -62 Y f 0
- 0.8 0.4 c 1370 1513 m 63 Y -20 15 d -62 Y f 0 0.8 0.2 c 1370 1576 m 62 Y -20 15
- d -62 Y f 0 0.8 0 c 1370 1638 m 62 Y -20 15 d -62 Y f 0.2 0.8 0 c 1370 1700 m
- 62 Y -20 16 d -63 Y f 0.4 0.8 0 c 1370 1762 m 24 Y -20 15 d -23 Y f black 1350
- 1156 m 20 -15 d 645 Y -20 15 d cl s 0.4 0.8 0 c 1370 1786 m 23 6 d -20 15 d -23
- -6 d f black 1370 1786 m 23 6 d -20 15 d -23 -6 d cl s 0 0 0.8 c 1346 1135 m 24
- 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1370 1203 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c
- 1370 1265 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 1370 1327 m 62 Y -24 -6 d -62 Y f
- 0 0.8 0.8 c 1370 1389 m 62 Y -24 -6 d -62 Y f 0 0.8 0.6 c 1370 1451 m 62 Y -24
- -5 d -63 Y f 0 0.8 0.4 c 1370 1513 m 63 Y -24 -6 d -62 Y f 0 0.8 0.2 c 1370
- 1576 m 62 Y -24 -6 d -62 Y f 0 0.8 0 c 1370 1638 m 62 Y -24 -6 d -62 Y f 0.2
- 0.8 0 c 1370 1700 m 59 Y -24 -6 d -59 Y f black 1346 1135 m 24 6 d 618 Y -24 -6
- d cl s 0 0 0.8 c 1326 1150 m 20 -15 d 62 Y -20 15 d f 0 0.2 0.8 c 1346 1197 m
- 62 Y -20 15 d -62 Y f 0 0.4 0.8 c 1346 1259 m 62 Y -20 16 d -63 Y f 0 0.6 0.8 c
- 1346 1321 m 62 Y -20 16 d -62 Y f 0 0.8 0.8 c 1346 1383 m 62 Y -20 16 d -62 Y f
- 0 0.8 0.6 c 1346 1445 m 63 Y -20 15 d -62 Y f 0 0.8 0.4 c 1346 1508 m 62 Y -20
- 15 d -62 Y f 0 0.8 0.2 c 1346 1570 m 62 Y -20 15 d -62 Y f 0 0.8 0 c 1346 1632
- m 62 Y -20 15 d -62 Y f 0.2 0.8 0 c 1346 1694 m 59 Y -20 15 d -59 Y f black
- 1326 1150 m 20 -15 d 618 Y -20 15 d cl s 0.2 0.8 0 c 1346 1753 m 24 6 d -20 15
- d -24 -6 d f black 1346 1753 m 24 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1323
- 1129 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 1346 1197 m 62 Y -23 -6 d -62 Y f 0
- 0.4 0.8 c 1346 1259 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c 1346 1321 m 62 Y -23 -6
- d -62 Y f 0 0.8 0.8 c 1346 1383 m 62 Y -23 -6 d -62 Y f 0 0.8 0.6 c 1346 1445 m
- 63 Y -23 -6 d -63 Y f 0 0.8 0.4 c 1346 1508 m 62 Y -23 -6 d -62 Y f 0 0.8 0.2 c
- 1346 1570 m 62 Y -23 -6 d -62 Y f 0 0.8 0 c 1346 1632 m 62 Y -23 -6 d -62 Y f
- 0.2 0.8 0 c 1346 1694 m 62 Y -23 -6 d -62 Y f 0.4 0.8 0 c 1346 1756 m 37 Y -23
- -6 d -37 Y f black 1323 1129 m 23 6 d 658 Y -23 -6 d cl s 0 0 0.8 c 1303 1144 m
- 20 -15 d 62 Y -20 15 d f 0 0.2 0.8 c 1323 1191 m 62 Y -20 16 d -63 Y f 0 0.4
- 0.8 c 1323 1253 m 62 Y -20 16 d -62 Y f 0 0.6 0.8 c 1323 1315 m 62 Y -20 16 d
- -62 Y f 0 0.8 0.8 c 1323 1377 m 62 Y -20 16 d -62 Y f 0 0.8 0.6 c 1323 1439 m
- 63 Y -20 15 d -62 Y f 0 0.8 0.4 c 1323 1502 m 62 Y -20 15 d -62 Y f 0 0.8 0.2 c
- 1323 1564 m 62 Y -20 15 d -62 Y f 0 0.8 0 c 1323 1626 m 62 Y -20 15 d -62 Y f
- 0.2 0.8 0 c 1323 1688 m 62 Y -20 16 d -63 Y f 0.4 0.8 0 c 1323 1750 m 37 Y -20
- 16 d -37 Y f black 1303 1144 m 20 -15 d 658 Y -20 16 d cl s 0.4 0.8 0 c 1323
- 1787 m 23 6 d -20 16 d -23 -6 d f black 1323 1787 m 23 6 d -20 16 d -23 -6 d
- cl s 0 0 0.8 c 1299 1123 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1323 1191 m 62 Y
- -24 -6 d -62 Y f 0 0.4 0.8 c 1323 1253 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 1323
- 1315 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 1323 1377 m 62 Y -24 -6 d -62 Y f 0
- 0.8 0.6 c 1323 1439 m 63 Y -24 -6 d -63 Y f 0 0.8 0.4 c 1323 1502 m 62 Y -24 -6
- d -62 Y f 0 0.8 0.2 c 1323 1564 m 62 Y -24 -6 d -62 Y f 0 0.8 0 c 1323 1626 m
- 62 Y -24 -6 d -62 Y f 0.2 0.8 0 c 1323 1688 m 62 Y -24 -6 d -62 Y f 0.4 0.8 0 c
- 1323 1750 m 62 Y -24 -6 d -62 Y f 0.6 0.8 0 c 1323 1812 m 62 Y -24 -6 d -62 Y f
- 0.8 0.8 0 c 1323 1874 m 7 Y -24 -6 d -7 Y f black 1299 1123 m 24 6 d 752 Y -24
- -6 d cl s 0 0 0.8 c 1279 1138 m 20 -15 d 62 Y -20 15 d f 0 0.2 0.8 c 1299 1185
- m 62 Y -20 16 d -63 Y f 0 0.4 0.8 c 1299 1247 m 62 Y -20 16 d -62 Y f 0 0.6 0.8
- c 1299 1309 m 62 Y -20 16 d -62 Y f 0 0.8 0.8 c 1299 1371 m 62 Y -20 16 d -62 Y
- f 0 0.8 0.6 c 1299 1433 m 63 Y -20 15 d -62 Y f 0 0.8 0.4 c 1299 1496 m 62 Y
- -20 15 d -62 Y f 0 0.8 0.2 c 1299 1558 m 62 Y -20 15 d -62 Y f 0 0.8 0 c 1299
- 1620 m 62 Y -20 16 d -63 Y f 0.2 0.8 0 c 1299 1682 m 62 Y -20 16 d -62 Y f 0.4
- 0.8 0 c 1299 1744 m 62 Y -20 16 d -62 Y f 0.6 0.8 0 c 1299 1806 m 62 Y -20 16 d
- -62 Y f 0.8 0.8 0 c 1299 1868 m 7 Y -20 16 d -7 Y f black 1279 1138 m 20 -15 d
- 752 Y -20 16 d cl s 0.8 0.8 0 c 1299 1875 m 24 6 d -20 16 d -24 -6 d f black
- 1299 1875 m 24 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1276 1117 m 23 6 d 62 Y -23
- -6 d f 0 0.2 0.8 c 1299 1185 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 1299 1247 m 62
- Y -23 -6 d -62 Y f 0 0.6 0.8 c 1299 1309 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c
- 1299 1371 m 62 Y -23 -6 d -62 Y f 0 0.8 0.6 c 1299 1433 m 63 Y -23 -6 d -63 Y f
- 0 0.8 0.4 c 1299 1496 m 62 Y -23 -6 d -62 Y f 0 0.8 0.2 c 1299 1558 m 62 Y -23
- -6 d -62 Y f 0 0.8 0 c 1299 1620 m 62 Y -23 -6 d -62 Y f 0.2 0.8 0 c 1299 1682
- m 62 Y -23 -6 d -62 Y f 0.4 0.8 0 c 1299 1744 m 51 Y -23 -6 d -51 Y f black
- 1276 1117 m 23 6 d 672 Y -23 -6 d cl s 0 0 0.8 c 1256 1132 m 20 -15 d 62 Y -20
- 15 d f 0 0.2 0.8 c 1276 1179 m 62 Y -20 16 d -63 Y f 0 0.4 0.8 c 1276 1241 m 62
- Y -20 16 d -62 Y f 0 0.6 0.8 c 1276 1303 m 62 Y -20 16 d -62 Y f 0 0.8 0.8 c
- 1276 1365 m 62 Y -20 16 d -62 Y f 0 0.8 0.6 c 1276 1427 m 63 Y -20 15 d -62 Y f
- 0 0.8 0.4 c 1276 1490 m 62 Y -20 15 d -62 Y f 0 0.8 0.2 c 1276 1552 m 62 Y -20
- 15 d -62 Y f 0 0.8 0 c 1276 1614 m 62 Y -20 16 d -63 Y f 0.2 0.8 0 c 1276 1676
- m 62 Y -20 16 d -62 Y f 0.4 0.8 0 c 1276 1738 m 51 Y -20 15 d -50 Y f black
- 1256 1132 m 20 -15 d 672 Y -20 15 d cl s 0.4 0.8 0 c 1276 1789 m 23 6 d -20 15
- d -23 -6 d f black 1276 1789 m 23 6 d -20 15 d -23 -6 d cl s 0 0 0.8 c 1252
- 1111 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1276 1179 m 62 Y -24 -6 d -62 Y f 0
- 0.4 0.8 c 1276 1241 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 1276 1303 m 62 Y -24 -6
- d -62 Y f 0 0.8 0.8 c 1276 1365 m 62 Y -24 -6 d -62 Y f 0 0.8 0.6 c 1276 1427 m
- 63 Y -24 -6 d -63 Y f 0 0.8 0.4 c 1276 1490 m 62 Y -24 -6 d -62 Y f 0 0.8 0.2 c
- 1276 1552 m 62 Y -24 -6 d -62 Y f 0 0.8 0 c 1276 1614 m 62 Y -24 -6 d -62 Y f
- 0.2 0.8 0 c 1276 1676 m 62 Y -24 -6 d -62 Y f 0.4 0.8 0 c 1276 1738 m 51 Y -24
- -6 d -51 Y f black 1252 1111 m 24 6 d 672 Y -24 -6 d cl s 0 0 0.8 c 1232 1126 m
- 20 -15 d 62 Y -20 15 d f 0 0.2 0.8 c 1252 1173 m 62 Y -20 16 d -63 Y f 0 0.4
- 0.8 c 1252 1235 m 62 Y -20 16 d -62 Y f 0 0.6 0.8 c 1252 1297 m 62 Y -20 16 d
- -62 Y f 0 0.8 0.8 c 1252 1359 m 62 Y -20 16 d -62 Y f 0 0.8 0.6 c 1252 1421 m
- 63 Y -20 15 d -62 Y f 0 0.8 0.4 c 1252 1484 m 62 Y -20 15 d -62 Y f 0 0.8 0.2 c
- 1252 1546 m 62 Y -20 15 d -62 Y f 0 0.8 0 c 1252 1608 m 62 Y -20 16 d -63 Y f
- 0.2 0.8 0 c 1252 1670 m 62 Y -20 16 d -62 Y f 0.4 0.8 0 c 1252 1732 m 51 Y -20
- 15 d -50 Y f black 1232 1126 m 20 -15 d 672 Y -20 15 d cl s 0.4 0.8 0 c 1252
- 1783 m 24 6 d -20 15 d -24 -6 d f black 1252 1783 m 24 6 d -20 15 d -24 -6 d
- cl s 0 0 0.8 c 1229 1105 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 1252 1173 m 62 Y
- -23 -6 d -62 Y f 0 0.4 0.8 c 1252 1235 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c 1252
- 1297 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 1252 1359 m 62 Y -23 -6 d -62 Y f 0
- 0.8 0.6 c 1252 1421 m 63 Y -23 -6 d -63 Y f 0 0.8 0.4 c 1252 1484 m 62 Y -23 -6
- d -62 Y f 0 0.8 0.2 c 1252 1546 m 62 Y -23 -6 d -62 Y f 0 0.8 0 c 1252 1608 m
- 62 Y -23 -6 d -62 Y f 0.2 0.8 0 c 1252 1670 m 5 Y -23 -6 d -5 Y f black 1229
- 1105 m 23 6 d 564 Y -23 -6 d cl s 0 0 0.8 c 1209 1120 m 20 -15 d 62 Y -20 15 d
- f 0 0.2 0.8 c 1229 1167 m 62 Y -20 16 d -63 Y f 0 0.4 0.8 c 1229 1229 m 62 Y
- -20 16 d -62 Y f 0 0.6 0.8 c 1229 1291 m 62 Y -20 16 d -62 Y f 0 0.8 0.8 c 1229
- 1353 m 62 Y -20 16 d -62 Y f 0 0.8 0.6 c 1229 1415 m 63 Y -20 15 d -62 Y f 0
- 0.8 0.4 c 1229 1478 m 62 Y -20 15 d -62 Y f 0 0.8 0.2 c 1229 1540 m 62 Y -20 15
- d -62 Y f 0 0.8 0 c 1229 1602 m 62 Y -20 16 d -63 Y f 0.2 0.8 0 c 1229 1664 m 5
- Y -20 16 d -5 Y f black 1209 1120 m 20 -15 d 564 Y -20 16 d cl s 0.2 0.8 0 c
- 1229 1669 m 23 6 d -20 16 d -23 -6 d f black 1229 1669 m 23 6 d -20 16 d -23 -6
- d cl s 0 0 0.8 c 1205 1099 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1229 1167 m 62
- Y -24 -6 d -62 Y f 0 0.4 0.8 c 1229 1229 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c
- 1229 1291 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 1229 1353 m 62 Y -24 -6 d -62 Y f
- 0 0.8 0.6 c 1229 1415 m 63 Y -24 -6 d -63 Y f 0 0.8 0.4 c 1229 1478 m 62 Y -24
- -6 d -62 Y f 0 0.8 0.2 c 1229 1540 m 62 Y -24 -6 d -62 Y f 0 0.8 0 c 1229 1602
- m 62 Y -24 -6 d -62 Y f 0.2 0.8 0 c 1229 1664 m 62 Y -24 -6 d -62 Y f 0.4 0.8 0
- c 1229 1726 m 24 Y -24 -6 d -24 Y f black 1205 1099 m 24 6 d 645 Y -24 -6 d
- cl s 0 0 0.8 c 1185 1114 m 20 -15 d 62 Y -20 15 d f 0 0.2 0.8 c 1205 1161 m 62
- Y -20 16 d -63 Y f 0 0.4 0.8 c 1205 1223 m 62 Y -20 16 d -62 Y f 0 0.6 0.8 c
- 1205 1285 m 62 Y -20 16 d -62 Y f 0 0.8 0.8 c 1205 1347 m 62 Y -20 16 d -62 Y f
- 0 0.8 0.6 c 1205 1409 m 63 Y -20 15 d -62 Y f 0 0.8 0.4 c 1205 1472 m 62 Y -20
- 15 d -62 Y f 0 0.8 0.2 c 1205 1534 m 62 Y -20 15 d -62 Y f 0 0.8 0 c 1205 1596
- m 62 Y -20 16 d -63 Y f 0.2 0.8 0 c 1205 1658 m 62 Y -20 16 d -62 Y f 0.4 0.8 0
- c 1205 1720 m 24 Y -20 15 d -23 Y f black 1185 1114 m 20 -15 d 645 Y -20 15 d
- cl s 0.4 0.8 0 c 1205 1744 m 24 6 d -20 15 d -24 -6 d f black 1205 1744 m 24 6
- d -20 15 d -24 -6 d cl s 0 0 0.8 c 1182 1093 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8
- c 1205 1161 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 1205 1223 m 62 Y -23 -6 d -62 Y
- f 0 0.6 0.8 c 1205 1285 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 1205 1347 m 62 Y
- -23 -5 d -63 Y f 0 0.8 0.6 c 1205 1409 m 63 Y -23 -6 d -62 Y f 0 0.8 0.4 c 1205
- 1472 m 62 Y -23 -6 d -62 Y f 0 0.8 0.2 c 1205 1534 m 62 Y -23 -6 d -62 Y f 0
- 0.8 0 c 1205 1596 m 62 Y -23 -6 d -62 Y f 0.2 0.8 0 c 1205 1658 m 62 Y -23 -6 d
- -62 Y f 0.4 0.8 0 c 1205 1720 m 62 Y -23 -6 d -62 Y f 0.6 0.8 0 c 1205 1782 m
- 42 Y -23 -6 d -42 Y f black 1182 1093 m 23 6 d 725 Y -23 -6 d cl s 0 0 0.8 c
- 1162 1108 m 20 -15 d 62 Y -20 15 d f 0 0.2 0.8 c 1182 1155 m 62 Y -20 16 d -63
- Y f 0 0.4 0.8 c 1182 1217 m 62 Y -20 16 d -62 Y f 0 0.6 0.8 c 1182 1279 m 62 Y
- -20 16 d -62 Y f 0 0.8 0.8 c 1182 1341 m 63 Y -20 15 d -62 Y f 0 0.8 0.6 c 1182
- 1404 m 62 Y -20 15 d -62 Y f 0 0.8 0.4 c 1182 1466 m 62 Y -20 15 d -62 Y f 0
- 0.8 0.2 c 1182 1528 m 62 Y -20 15 d -62 Y f 0 0.8 0 c 1182 1590 m 62 Y -20 16 d
- -63 Y f 0.2 0.8 0 c 1182 1652 m 62 Y -20 16 d -62 Y f 0.4 0.8 0 c 1182 1714 m
- 62 Y -20 16 d -62 Y f 0.6 0.8 0 c 1182 1776 m 42 Y -20 16 d -42 Y f black 1162
- 1108 m 20 -15 d 725 Y -20 16 d cl s 0.6 0.8 0 c 1182 1818 m 23 6 d -20 16 d -23
- -6 d f black 1182 1818 m 23 6 d -20 16 d -23 -6 d cl s 0 0 0.8 c 1158 1087 m 24
- 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1182 1155 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c
- 1182 1217 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 1182 1279 m 62 Y -24 -6 d -62 Y f
- 0 0.8 0.8 c 1182 1341 m 63 Y -24 -6 d -63 Y f 0 0.8 0.6 c 1182 1404 m 62 Y -24
- -6 d -62 Y f 0 0.8 0.4 c 1182 1466 m 62 Y -24 -6 d -62 Y f 0 0.8 0.2 c 1182
- 1528 m 62 Y -24 -6 d -62 Y f 0 0.8 0 c 1182 1590 m 62 Y -24 -6 d -62 Y f 0.2
- 0.8 0 c 1182 1652 m 62 Y -24 -6 d -62 Y f 0.4 0.8 0 c 1182 1714 m 62 Y -24 -6 d
- -62 Y f 0.6 0.8 0 c 1182 1776 m 15 Y -24 -6 d -15 Y f black 1158 1087 m 24 6 d
- 698 Y -24 -6 d cl s 0 0 0.8 c 1138 1102 m 20 -15 d 62 Y -20 16 d f 0 0.2 0.8 c
- 1158 1149 m 62 Y -20 16 d -62 Y f 0 0.4 0.8 c 1158 1211 m 62 Y -20 16 d -62 Y f
- 0 0.6 0.8 c 1158 1273 m 62 Y -20 16 d -62 Y f 0 0.8 0.8 c 1158 1335 m 63 Y -20
- 15 d -62 Y f 0 0.8 0.6 c 1158 1398 m 62 Y -20 15 d -62 Y f 0 0.8 0.4 c 1158
- 1460 m 62 Y -20 15 d -62 Y f 0 0.8 0.2 c 1158 1522 m 62 Y -20 15 d -62 Y f 0
- 0.8 0 c 1158 1584 m 62 Y -20 16 d -63 Y f 0.2 0.8 0 c 1158 1646 m 62 Y -20 16 d
- -62 Y f 0.4 0.8 0 c 1158 1708 m 62 Y -20 16 d -62 Y f 0.6 0.8 0 c 1158 1770 m
- 15 Y -20 16 d -15 Y f black 1138 1102 m 20 -15 d 698 Y -20 16 d cl s 0.6 0.8 0
- c 1158 1785 m 24 6 d -20 16 d -24 -6 d f black 1158 1785 m 24 6 d -20 16 d -24
- -6 d cl s 0 0 0.8 c 1135 1081 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 1158 1149 m
- 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 1158 1211 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c
- 1158 1273 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 1158 1335 m 63 Y -23 -6 d -63 Y f
- 0 0.8 0.6 c 1158 1398 m 62 Y -23 -6 d -62 Y f 0 0.8 0.4 c 1158 1460 m 62 Y -23
- -6 d -62 Y f 0 0.8 0.2 c 1158 1522 m 62 Y -23 -6 d -62 Y f 0 0.8 0 c 1158 1584
- m 62 Y -23 -6 d -62 Y f 0.2 0.8 0 c 1158 1646 m 62 Y -23 -6 d -62 Y f 0.4 0.8 0
- c 1158 1708 m 62 Y -23 -6 d -62 Y f 0.6 0.8 0 c 1158 1770 m 63 Y -23 -6 d -63 Y
- f 0.8 0.8 0 c 1158 1833 m 33 Y -23 -6 d -33 Y f black 1135 1081 m 23 6 d 779 Y
- -23 -6 d cl s 0 0 0.8 c 1115 1096 m 20 -15 d 62 Y -20 16 d f 0 0.2 0.8 c 1135
- 1143 m 62 Y -20 16 d -62 Y f 0 0.4 0.8 c 1135 1205 m 62 Y -20 16 d -62 Y f 0
- 0.6 0.8 c 1135 1267 m 62 Y -20 16 d -62 Y f 0 0.8 0.8 c 1135 1329 m 63 Y -20 15
- d -62 Y f 0 0.8 0.6 c 1135 1392 m 62 Y -20 15 d -62 Y f 0 0.8 0.4 c 1135 1454 m
- 62 Y -20 15 d -62 Y f 0 0.8 0.2 c 1135 1516 m 62 Y -20 16 d -63 Y f 0 0.8 0 c
- 1135 1578 m 62 Y -20 16 d -62 Y f 0.2 0.8 0 c 1135 1640 m 62 Y -20 16 d -62 Y f
- 0.4 0.8 0 c 1135 1702 m 62 Y -20 16 d -62 Y f 0.6 0.8 0 c 1135 1764 m 63 Y -20
- 15 d -62 Y f 0.8 0.8 0 c 1135 1827 m 33 Y -20 16 d -34 Y f black 1115 1096 m 20
- -15 d 779 Y -20 16 d cl s 0.8 0.8 0 c 1135 1860 m 23 6 d -20 16 d -23 -6 d f
- black 1135 1860 m 23 6 d -20 16 d -23 -6 d cl s 0 0 0.8 c 1112 1075 m 23 6 d 62
- Y -23 -6 d f 0 0.2 0.8 c 1135 1143 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 1135
- 1205 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c 1135 1267 m 62 Y -23 -6 d -62 Y f 0
- 0.8 0.8 c 1135 1329 m 63 Y -23 -6 d -63 Y f 0 0.8 0.6 c 1135 1392 m 62 Y -23 -6
- d -62 Y f 0 0.8 0.4 c 1135 1454 m 62 Y -23 -6 d -62 Y f 0 0.8 0.2 c 1135 1516 m
- 62 Y -23 -6 d -62 Y f 0 0.8 0 c 1135 1578 m 62 Y -23 -6 d -62 Y f 0.2 0.8 0 c
- 1135 1640 m 62 Y -23 -6 d -62 Y f 0.4 0.8 0 c 1135 1702 m 62 Y -23 -6 d -62 Y f
- 0.6 0.8 0 c 1135 1764 m 63 Y -23 -6 d -63 Y f 0.8 0.8 0 c 1135 1827 m 6 Y -23
- -6 d -6 Y f black 1112 1075 m 23 6 d 752 Y -23 -6 d cl s 0 0 0.8 c 1091 1090 m
- 21 -15 d 62 Y -21 16 d f 0 0.2 0.8 c 1112 1137 m 62 Y -21 16 d -62 Y f 0 0.4
- 0.8 c 1112 1199 m 62 Y -21 16 d -62 Y f 0 0.6 0.8 c 1112 1261 m 62 Y -21 16 d
- -62 Y f 0 0.8 0.8 c 1112 1323 m 63 Y -21 15 d -62 Y f 0 0.8 0.6 c 1112 1386 m
- 62 Y -21 15 d -62 Y f 0 0.8 0.4 c 1112 1448 m 62 Y -21 15 d -62 Y f 0 0.8 0.2 c
- 1112 1510 m 62 Y -21 16 d -63 Y f 0 0.8 0 c 1112 1572 m 62 Y -21 16 d -62 Y f
- 0.2 0.8 0 c 1112 1634 m 62 Y -21 16 d -62 Y f 0.4 0.8 0 c 1112 1696 m 62 Y -21
- 16 d -62 Y f 0.6 0.8 0 c 1112 1758 m 63 Y -21 15 d -62 Y f 0.8 0.8 0 c 1112
- 1821 m 6 Y -21 16 d -7 Y f black 1091 1090 m 21 -15 d 752 Y -21 16 d cl s 0.8
- 0.8 0 c 1112 1827 m 23 6 d -20 16 d -24 -6 d f black 1112 1827 m 23 6 d -20 16
- d -24 -6 d cl s 0 0 0.8 c 1088 1069 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1112
- 1137 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 1112 1199 m 62 Y -24 -6 d -62 Y f 0
- 0.6 0.8 c 1112 1261 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 1112 1323 m 63 Y -24 -6
- d -63 Y f 0 0.8 0.6 c 1112 1386 m 62 Y -24 -6 d -62 Y f 0 0.8 0.4 c 1112 1448 m
- 62 Y -24 -6 d -62 Y f 0 0.8 0.2 c 1112 1510 m 62 Y -24 -6 d -62 Y f 0 0.8 0 c
- 1112 1572 m 62 Y -24 -6 d -62 Y f 0.2 0.8 0 c 1112 1634 m 62 Y -24 -6 d -62 Y f
- 0.4 0.8 0 c 1112 1696 m 10 Y -24 -6 d -10 Y f black 1088 1069 m 24 6 d 631 Y
- -24 -6 d cl s 0 0 0.8 c 1068 1084 m 20 -15 d 62 Y -20 16 d f 0 0.2 0.8 c 1088
- 1131 m 62 Y -20 16 d -62 Y f 0 0.4 0.8 c 1088 1193 m 62 Y -20 16 d -62 Y f 0
- 0.6 0.8 c 1088 1255 m 62 Y -20 16 d -62 Y f 0 0.8 0.8 c 1088 1317 m 63 Y -20 15
- d -62 Y f 0 0.8 0.6 c 1088 1380 m 62 Y -20 15 d -62 Y f 0 0.8 0.4 c 1088 1442 m
- 62 Y -20 15 d -62 Y f 0 0.8 0.2 c 1088 1504 m 62 Y -20 16 d -63 Y f 0 0.8 0 c
- 1088 1566 m 62 Y -20 16 d -62 Y f 0.2 0.8 0 c 1088 1628 m 62 Y -20 16 d -62 Y f
- 0.4 0.8 0 c 1088 1690 m 10 Y -20 16 d -10 Y f black 1068 1084 m 20 -15 d 631 Y
- -20 16 d cl s 0.4 0.8 0 c 1088 1700 m 24 6 d -21 16 d -23 -6 d f black 1088
- 1700 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1065 1063 m 23 6 d 62 Y -23 -6 d
- f 0 0.2 0.8 c 1088 1131 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 1088 1193 m 62 Y
- -23 -6 d -62 Y f 0 0.6 0.8 c 1088 1255 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 1088
- 1317 m 63 Y -23 -6 d -63 Y f 0 0.8 0.6 c 1088 1380 m 62 Y -23 -6 d -62 Y f 0
- 0.8 0.4 c 1088 1442 m 62 Y -23 -6 d -62 Y f 0 0.8 0.2 c 1088 1504 m 62 Y -23 -6
- d -62 Y f 0 0.8 0 c 1088 1566 m 62 Y -23 -6 d -62 Y f 0.2 0.8 0 c 1088 1628 m 5
- Y -23 -6 d -5 Y f black 1065 1063 m 23 6 d 564 Y -23 -6 d cl s 0 0 0.8 c 1044
- 1078 m 21 -15 d 62 Y -21 16 d f 0 0.2 0.8 c 1065 1125 m 62 Y -21 16 d -62 Y f 0
- 0.4 0.8 c 1065 1187 m 62 Y -21 16 d -62 Y f 0 0.6 0.8 c 1065 1249 m 62 Y -21 16
- d -62 Y f 0 0.8 0.8 c 1065 1311 m 63 Y -21 15 d -62 Y f 0 0.8 0.6 c 1065 1374 m
- 62 Y -21 15 d -62 Y f 0 0.8 0.4 c 1065 1436 m 62 Y -21 15 d -62 Y f 0 0.8 0.2 c
- 1065 1498 m 62 Y -21 16 d -63 Y f 0 0.8 0 c 1065 1560 m 62 Y -21 16 d -62 Y f
- 0.2 0.8 0 c 1065 1622 m 5 Y -21 16 d -5 Y f black 1044 1078 m 21 -15 d 564 Y
- -21 16 d cl s 0.2 0.8 0 c 1065 1627 m 23 6 d -20 16 d -24 -6 d f black 1065
- 1627 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1041 1057 m 24 6 d 62 Y -24 -6 d
- f 0 0.2 0.8 c 1065 1125 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 1065 1187 m 62 Y
- -24 -6 d -62 Y f 0 0.6 0.8 c 1065 1249 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 1065
- 1311 m 63 Y -24 -6 d -63 Y f 0 0.8 0.6 c 1065 1374 m 62 Y -24 -6 d -62 Y f 0
- 0.8 0.4 c 1065 1436 m 62 Y -24 -6 d -62 Y f 0 0.8 0.2 c 1065 1498 m 62 Y -24 -6
- d -62 Y f 0 0.8 0 c 1065 1560 m 62 Y -24 -6 d -62 Y f 0.2 0.8 0 c 1065 1622 m
- 46 Y -24 -6 d -46 Y f black 1041 1057 m 24 6 d 605 Y -24 -6 d cl s 0 0 0.8 c
- 1021 1072 m 20 -15 d 62 Y -20 16 d f 0 0.2 0.8 c 1041 1119 m 62 Y -20 16 d -62
- Y f 0 0.4 0.8 c 1041 1181 m 62 Y -20 16 d -62 Y f 0 0.6 0.8 c 1041 1243 m 62 Y
- -20 16 d -62 Y f 0 0.8 0.8 c 1041 1305 m 63 Y -20 15 d -62 Y f 0 0.8 0.6 c 1041
- 1368 m 62 Y -20 15 d -62 Y f 0 0.8 0.4 c 1041 1430 m 62 Y -20 15 d -62 Y f 0
- 0.8 0.2 c 1041 1492 m 62 Y -20 16 d -63 Y f 0 0.8 0 c 1041 1554 m 62 Y -20 16 d
- -62 Y f 0.2 0.8 0 c 1041 1616 m 46 Y -20 15 d -45 Y f black 1021 1072 m 20 -15
- d 605 Y -20 15 d cl s 0.2 0.8 0 c 1041 1662 m 24 6 d -21 15 d -23 -6 d f black
- 1041 1662 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 1018 1051 m 23 6 d 62 Y -23
- -6 d f 0 0.2 0.8 c 1041 1119 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 1041 1181 m 62
- Y -23 -6 d -62 Y f 0 0.6 0.8 c 1041 1243 m 62 Y -23 -5 d -63 Y f 0 0.8 0.8 c
- 1041 1305 m 63 Y -23 -6 d -62 Y f 0 0.8 0.6 c 1041 1368 m 62 Y -23 -6 d -62 Y f
- 0 0.8 0.4 c 1041 1430 m 62 Y -23 -6 d -62 Y f 0 0.8 0.2 c 1041 1492 m 62 Y -23
- -6 d -62 Y f 0 0.8 0 c 1041 1554 m 62 Y -23 -6 d -62 Y f 0.2 0.8 0 c 1041 1616
- m 62 Y -23 -6 d -62 Y f 0.4 0.8 0 c 1041 1678 m 62 Y -23 -5 d -63 Y f 0.6 0.8 0
- c 1041 1740 m 16 Y -23 -6 d -15 Y f black 1018 1051 m 23 6 d 699 Y -23 -6 d
- cl s 0 0 0.8 c 997 1066 m 21 -15 d 62 Y -21 16 d f 0 0.2 0.8 c 1018 1113 m 62 Y
- -21 16 d -62 Y f 0 0.4 0.8 c 1018 1175 m 62 Y -21 16 d -62 Y f 0 0.6 0.8 c 1018
- 1237 m 63 Y -21 15 d -62 Y f 0 0.8 0.8 c 1018 1300 m 62 Y -21 15 d -62 Y f 0
- 0.8 0.6 c 1018 1362 m 62 Y -21 15 d -62 Y f 0 0.8 0.4 c 1018 1424 m 62 Y -21 15
- d -62 Y f 0 0.8 0.2 c 1018 1486 m 62 Y -21 16 d -63 Y f 0 0.8 0 c 1018 1548 m
- 62 Y -21 16 d -62 Y f 0.2 0.8 0 c 1018 1610 m 62 Y -21 16 d -62 Y f 0.4 0.8 0 c
- 1018 1672 m 63 Y -21 15 d -62 Y f 0.6 0.8 0 c 1018 1735 m 15 Y -21 15 d -15 Y f
- black 997 1066 m 21 -15 d 699 Y -21 15 d cl s 0.6 0.8 0 c 1018 1750 m 23 6 d
- -20 15 d -24 -6 d f black 1018 1750 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c
- 994 1045 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1018 1113 m 62 Y -24 -6 d -62 Y f
- 0 0.4 0.8 c 1018 1175 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 1018 1237 m 63 Y -24
- -6 d -63 Y f 0 0.8 0.8 c 1018 1300 m 62 Y -24 -6 d -62 Y f 0 0.8 0.6 c 1018
- 1362 m 62 Y -24 -6 d -62 Y f 0 0.8 0.4 c 1018 1424 m 62 Y -24 -6 d -62 Y f 0
- 0.8 0.2 c 1018 1486 m 62 Y -24 -6 d -62 Y f 0 0.8 0 c 1018 1548 m 62 Y -24 -6 d
- -62 Y f 0.2 0.8 0 c 1018 1610 m 62 Y -24 -6 d -62 Y f 0.4 0.8 0 c 1018 1672 m
- 63 Y -24 -6 d -63 Y f 0.6 0.8 0 c 1018 1735 m 62 Y -24 -6 d -62 Y f 0.8 0.8 0 c
- 1018 1797 m 6 Y -24 -6 d -6 Y f black 994 1045 m 24 6 d 752 Y -24 -6 d cl s 0 0
- 0.8 c 974 1061 m 20 -16 d 62 Y -20 16 d f 0 0.2 0.8 c 994 1107 m 62 Y -20 16 d
- -62 Y f 0 0.4 0.8 c 994 1169 m 62 Y -20 16 d -62 Y f 0 0.6 0.8 c 994 1231 m 63
- Y -20 15 d -62 Y f 0 0.8 0.8 c 994 1294 m 62 Y -20 15 d -62 Y f 0 0.8 0.6 c 994
- 1356 m 62 Y -20 15 d -62 Y f 0 0.8 0.4 c 994 1418 m 62 Y -20 15 d -62 Y f 0 0.8
- 0.2 c 994 1480 m 62 Y -20 16 d -63 Y f 0 0.8 0 c 994 1542 m 62 Y -20 16 d -62 Y
- f 0.2 0.8 0 c 994 1604 m 62 Y -20 16 d -62 Y f 0.4 0.8 0 c 994 1666 m 63 Y -20
- 15 d -62 Y f 0.6 0.8 0 c 994 1729 m 62 Y -20 15 d -62 Y f 0.8 0.8 0 c 994 1791
- m 6 Y -20 16 d -7 Y f black 974 1061 m 20 -16 d 752 Y -20 16 d cl s 0.8 0.8 0 c
- 994 1797 m 24 6 d -21 16 d -23 -6 d f black 994 1797 m 24 6 d -21 16 d -23 -6 d
- cl s 0 0 0.8 c 971 1039 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 994 1107 m 62 Y
- -23 -6 d -62 Y f 0 0.4 0.8 c 994 1169 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c 994
- 1231 m 63 Y -23 -6 d -63 Y f 0 0.8 0.8 c 994 1294 m 62 Y -23 -6 d -62 Y f 0 0.8
- 0.6 c 994 1356 m 62 Y -23 -6 d -62 Y f 0 0.8 0.4 c 994 1418 m 62 Y -23 -6 d -62
- Y f 0 0.8 0.2 c 994 1480 m 62 Y -23 -6 d -62 Y f 0 0.8 0 c 994 1542 m 62 Y -23
- -6 d -62 Y f 0.2 0.8 0 c 994 1604 m 62 Y -23 -6 d -62 Y f 0.4 0.8 0 c 994 1666
- m 51 Y -23 -6 d -51 Y f black 971 1039 m 23 6 d 672 Y -23 -6 d cl s 0 0 0.8 c
- 950 1055 m 21 -16 d 62 Y -21 16 d f 0 0.2 0.8 c 971 1101 m 62 Y -21 16 d -62 Y
- f 0 0.4 0.8 c 971 1163 m 62 Y -21 16 d -62 Y f 0 0.6 0.8 c 971 1225 m 63 Y -21
- 15 d -62 Y f 0 0.8 0.8 c 971 1288 m 62 Y -21 15 d -62 Y f 0 0.8 0.6 c 971 1350
- m 62 Y -21 15 d -62 Y f 0 0.8 0.4 c 971 1412 m 62 Y -21 16 d -63 Y f 0 0.8 0.2
- c 971 1474 m 62 Y -21 16 d -62 Y f 0 0.8 0 c 971 1536 m 62 Y -21 16 d -62 Y f
- 0.2 0.8 0 c 971 1598 m 62 Y -21 16 d -62 Y f 0.4 0.8 0 c 971 1660 m 51 Y -21 15
- d -50 Y f black 950 1055 m 21 -16 d 672 Y -21 15 d cl s 0.4 0.8 0 c 971 1711 m
- 23 6 d -20 15 d -24 -6 d f black 971 1711 m 23 6 d -20 15 d -24 -6 d cl s 0 0
- 0.8 c 947 1033 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 971 1101 m 62 Y -24 -6 d
- -62 Y f 0 0.4 0.8 c 971 1163 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 971 1225 m 63
- Y -24 -6 d -63 Y f 0 0.8 0.8 c 971 1288 m 62 Y -24 -6 d -62 Y f 0 0.8 0.6 c 971
- 1350 m 62 Y -24 -6 d -62 Y f 0 0.8 0.4 c 971 1412 m 62 Y -24 -6 d -62 Y f 0 0.8
- 0.2 c 971 1474 m 62 Y -24 -6 d -62 Y f 0 0.8 0 c 971 1536 m 62 Y -24 -6 d -62 Y
- f 0.2 0.8 0 c 971 1598 m 62 Y -24 -6 d -62 Y f 0.4 0.8 0 c 971 1660 m 63 Y -24
- -6 d -63 Y f 0.6 0.8 0 c 971 1723 m 62 Y -24 -6 d -62 Y f 0.8 0.8 0 c 971 1785
- m 20 Y -24 -6 d -20 Y f black 947 1033 m 24 6 d 766 Y -24 -6 d cl s 0 0 0.8 c
- 927 1049 m 20 -16 d 62 Y -20 16 d f 0 0.2 0.8 c 947 1095 m 62 Y -20 16 d -62 Y
- f 0 0.4 0.8 c 947 1157 m 62 Y -20 16 d -62 Y f 0 0.6 0.8 c 947 1219 m 63 Y -20
- 15 d -62 Y f 0 0.8 0.8 c 947 1282 m 62 Y -20 15 d -62 Y f 0 0.8 0.6 c 947 1344
- m 62 Y -20 15 d -62 Y f 0 0.8 0.4 c 947 1406 m 62 Y -20 16 d -63 Y f 0 0.8 0.2
- c 947 1468 m 62 Y -20 16 d -62 Y f 0 0.8 0 c 947 1530 m 62 Y -20 16 d -62 Y f
- 0.2 0.8 0 c 947 1592 m 62 Y -20 16 d -62 Y f 0.4 0.8 0 c 947 1654 m 63 Y -20 15
- d -62 Y f 0.6 0.8 0 c 947 1717 m 62 Y -20 15 d -62 Y f 0.8 0.8 0 c 947 1779 m
- 20 Y -20 15 d -20 Y f black 927 1049 m 20 -16 d 766 Y -20 15 d cl s 0.8 0.8 0 c
- 947 1799 m 24 6 d -21 15 d -23 -6 d f black 947 1799 m 24 6 d -21 15 d -23 -6 d
- cl s 0 0 0.8 c 924 1027 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 947 1095 m 62 Y
- -23 -6 d -62 Y f 0 0.4 0.8 c 947 1157 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c 947
- 1219 m 63 Y -23 -6 d -63 Y f 0 0.8 0.8 c 947 1282 m 62 Y -23 -6 d -62 Y f 0 0.8
- 0.6 c 947 1344 m 62 Y -23 -6 d -62 Y f 0 0.8 0.4 c 947 1406 m 62 Y -23 -6 d -62
- Y f 0 0.8 0.2 c 947 1468 m 35 Y -23 -6 d -35 Y f black 924 1027 m 23 6 d 470 Y
- -23 -6 d cl s 0 0 0.8 c 903 1043 m 21 -16 d 62 Y -21 16 d f 0 0.2 0.8 c 924
- 1089 m 62 Y -21 16 d -62 Y f 0 0.4 0.8 c 924 1151 m 62 Y -21 16 d -62 Y f 0 0.6
- 0.8 c 924 1213 m 63 Y -21 15 d -62 Y f 0 0.8 0.8 c 924 1276 m 62 Y -21 15 d -62
- Y f 0 0.8 0.6 c 924 1338 m 62 Y -21 15 d -62 Y f 0 0.8 0.4 c 924 1400 m 62 Y
- -21 16 d -63 Y f 0 0.8 0.2 c 924 1462 m 35 Y -21 16 d -35 Y f black 903 1043 m
- 21 -16 d 470 Y -21 16 d cl s 0 0.8 0.2 c 924 1497 m 23 6 d -20 16 d -24 -6 d f
- black 924 1497 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 900 1021 m 24 6 d 62 Y
- -24 -6 d f 0 0.2 0.8 c 924 1089 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 924 1151 m
- 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 924 1213 m 63 Y -24 -6 d -63 Y f 0 0.8 0.8 c
- 924 1276 m 62 Y -24 -6 d -62 Y f 0 0.8 0.6 c 924 1338 m 62 Y -24 -6 d -62 Y f 0
- 0.8 0.4 c 924 1400 m 62 Y -24 -6 d -62 Y f 0 0.8 0.2 c 924 1462 m 62 Y -24 -6 d
- -62 Y f 0 0.8 0 c 924 1524 m 62 Y -24 -6 d -62 Y f 0.2 0.8 0 c 924 1586 m 19 Y
- -24 -6 d -19 Y f black 900 1021 m 24 6 d 578 Y -24 -6 d cl s 0 0 0.8 c 880 1037
- m 20 -16 d 62 Y -20 16 d f 0 0.2 0.8 c 900 1083 m 62 Y -20 16 d -62 Y f 0 0.4
- 0.8 c 900 1145 m 62 Y -20 16 d -62 Y f 0 0.6 0.8 c 900 1207 m 63 Y -20 15 d -62
- Y f 0 0.8 0.8 c 900 1270 m 62 Y -20 15 d -62 Y f 0 0.8 0.6 c 900 1332 m 62 Y
- -20 15 d -62 Y f 0 0.8 0.4 c 900 1394 m 62 Y -20 16 d -63 Y f 0 0.8 0.2 c 900
- 1456 m 62 Y -20 16 d -62 Y f 0 0.8 0 c 900 1518 m 62 Y -20 16 d -62 Y f 0.2 0.8
- 0 c 900 1580 m 19 Y -20 15 d -18 Y f black 880 1037 m 20 -16 d 578 Y -20 15 d
- cl s 0.2 0.8 0 c 900 1599 m 24 6 d -21 15 d -23 -6 d f black 900 1599 m 24 6 d
- -21 15 d -23 -6 d cl s 0 0 0.8 c 877 1015 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c
- 900 1083 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 900 1145 m 62 Y -23 -6 d -62 Y f 0
- 0.6 0.8 c 900 1207 m 63 Y -23 -6 d -63 Y f 0 0.8 0.8 c 900 1270 m 62 Y -23 -6 d
- -62 Y f 0 0.8 0.6 c 900 1332 m 62 Y -23 -6 d -62 Y f 0 0.8 0.4 c 900 1394 m 62
- Y -23 -6 d -62 Y f 0 0.8 0.2 c 900 1456 m 62 Y -23 -6 d -62 Y f 0 0.8 0 c 900
- 1518 m 62 Y -23 -6 d -62 Y f 0.2 0.8 0 c 900 1580 m 62 Y -23 -6 d -62 Y f 0.4
- 0.8 0 c 900 1642 m 63 Y -23 -6 d -63 Y f 0.6 0.8 0 c 900 1705 m 28 Y -23 -6 d
- -28 Y f black 877 1015 m 23 6 d 712 Y -23 -6 d cl s 0 0 0.8 c 856 1031 m 21 -16
- d 62 Y -21 16 d f 0 0.2 0.8 c 877 1077 m 62 Y -21 16 d -62 Y f 0 0.4 0.8 c 877
- 1139 m 62 Y -21 16 d -62 Y f 0 0.6 0.8 c 877 1201 m 63 Y -21 15 d -62 Y f 0 0.8
- 0.8 c 877 1264 m 62 Y -21 15 d -62 Y f 0 0.8 0.6 c 877 1326 m 62 Y -21 15 d -62
- Y f 0 0.8 0.4 c 877 1388 m 62 Y -21 16 d -63 Y f 0 0.8 0.2 c 877 1450 m 62 Y
- -21 16 d -62 Y f 0 0.8 0 c 877 1512 m 62 Y -21 16 d -62 Y f 0.2 0.8 0 c 877
- 1574 m 62 Y -21 16 d -62 Y f 0.4 0.8 0 c 877 1636 m 63 Y -21 15 d -62 Y f 0.6
- 0.8 0 c 877 1699 m 28 Y -21 16 d -29 Y f black 856 1031 m 21 -16 d 712 Y -21 16
- d cl s 0.6 0.8 0 c 877 1727 m 23 6 d -20 16 d -24 -6 d f black 877 1727 m 23 6
- d -20 16 d -24 -6 d cl s 0 0 0.8 c 853 1009 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8
- c 877 1077 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 877 1139 m 62 Y -24 -5 d -63 Y f
- 0 0.6 0.8 c 877 1201 m 63 Y -24 -6 d -62 Y f 0 0.8 0.8 c 877 1264 m 62 Y -24 -6
- d -62 Y f 0 0.8 0.6 c 877 1326 m 62 Y -24 -6 d -62 Y f 0 0.8 0.4 c 877 1388 m
- 62 Y -24 -6 d -62 Y f 0 0.8 0.2 c 877 1450 m 62 Y -24 -6 d -62 Y f 0 0.8 0 c
- 877 1512 m 62 Y -24 -6 d -62 Y f 0.2 0.8 0 c 877 1574 m 62 Y -24 -5 d -63 Y f
- 0.4 0.8 0 c 877 1636 m 51 Y -24 -6 d -50 Y f black 853 1009 m 24 6 d 672 Y -24
- -6 d cl s 0 0 0.8 c 833 1025 m 20 -16 d 62 Y -20 16 d f 0 0.2 0.8 c 853 1071 m
- 62 Y -20 16 d -62 Y f 0 0.4 0.8 c 853 1133 m 63 Y -20 15 d -62 Y f 0 0.6 0.8 c
- 853 1196 m 62 Y -20 15 d -62 Y f 0 0.8 0.8 c 853 1258 m 62 Y -20 15 d -62 Y f 0
- 0.8 0.6 c 853 1320 m 62 Y -20 15 d -62 Y f 0 0.8 0.4 c 853 1382 m 62 Y -20 16 d
- -63 Y f 0 0.8 0.2 c 853 1444 m 62 Y -20 16 d -62 Y f 0 0.8 0 c 853 1506 m 62 Y
- -20 16 d -62 Y f 0.2 0.8 0 c 853 1568 m 63 Y -20 15 d -62 Y f 0.4 0.8 0 c 853
- 1631 m 50 Y -20 15 d -50 Y f black 833 1025 m 20 -16 d 672 Y -20 15 d cl s 0.4
- 0.8 0 c 853 1681 m 24 6 d -21 15 d -23 -6 d f black 853 1681 m 24 6 d -21 15 d
- -23 -6 d cl s 0 0 0.8 c 830 1003 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 853 1071
- m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 853 1133 m 63 Y -23 -6 d -63 Y f 0 0.6 0.8
- c 853 1196 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 853 1258 m 62 Y -23 -6 d -62 Y f
- 0 0.8 0.6 c 853 1320 m 62 Y -23 -6 d -62 Y f 0 0.8 0.4 c 853 1382 m 62 Y -23 -6
- d -62 Y f 0 0.8 0.2 c 853 1444 m 62 Y -23 -6 d -62 Y f 0 0.8 0 c 853 1506 m 62
- Y -23 -6 d -62 Y f 0.2 0.8 0 c 853 1568 m 63 Y -23 -6 d -63 Y f 0.4 0.8 0 c 853
- 1631 m 10 Y -23 -6 d -10 Y f black 830 1003 m 23 6 d 632 Y -23 -6 d cl s 0 0
- 0.8 c 809 1019 m 21 -16 d 62 Y -21 16 d f 0 0.2 0.8 c 830 1065 m 62 Y -21 16 d
- -62 Y f 0 0.4 0.8 c 830 1127 m 63 Y -21 15 d -62 Y f 0 0.6 0.8 c 830 1190 m 62
- Y -21 15 d -62 Y f 0 0.8 0.8 c 830 1252 m 62 Y -21 15 d -62 Y f 0 0.8 0.6 c 830
- 1314 m 62 Y -21 15 d -62 Y f 0 0.8 0.4 c 830 1376 m 62 Y -21 16 d -63 Y f 0 0.8
- 0.2 c 830 1438 m 62 Y -21 16 d -62 Y f 0 0.8 0 c 830 1500 m 62 Y -21 16 d -62 Y
- f 0.2 0.8 0 c 830 1562 m 63 Y -21 15 d -62 Y f 0.4 0.8 0 c 830 1625 m 10 Y -21
- 15 d -10 Y f black 809 1019 m 21 -16 d 632 Y -21 15 d cl s 0.4 0.8 0 c 830 1635
- m 23 6 d -20 15 d -24 -6 d f black 830 1635 m 23 6 d -20 15 d -24 -6 d cl s 0 0
- 0.8 c 806 997 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 830 1065 m 62 Y -24 -6 d -62
- Y f 0 0.4 0.8 c 830 1127 m 63 Y -24 -6 d -63 Y f 0 0.6 0.8 c 830 1190 m 62 Y
- -24 -6 d -62 Y f 0 0.8 0.8 c 830 1252 m 62 Y -24 -6 d -62 Y f 0 0.8 0.6 c 830
- 1314 m 62 Y -24 -6 d -62 Y f 0 0.8 0.4 c 830 1376 m 62 Y -24 -6 d -62 Y f 0 0.8
- 0.2 c 830 1438 m 62 Y -24 -6 d -62 Y f 0 0.8 0 c 830 1500 m 62 Y -24 -6 d -62 Y
- f 0.2 0.8 0 c 830 1562 m 63 Y -24 -6 d -63 Y f 0.4 0.8 0 c 830 1625 m 10 Y -24
- -6 d -10 Y f black 806 997 m 24 6 d 632 Y -24 -6 d cl s 0 0 0.8 c 786 1013 m 20
- -16 d 62 Y -20 16 d f 0 0.2 0.8 c 806 1059 m 62 Y -20 16 d -62 Y f 0 0.4 0.8 c
- 806 1121 m 63 Y -20 15 d -62 Y f 0 0.6 0.8 c 806 1184 m 62 Y -20 15 d -62 Y f 0
- 0.8 0.8 c 806 1246 m 62 Y -20 15 d -62 Y f 0 0.8 0.6 c 806 1308 m 62 Y -20 16 d
- -63 Y f 0 0.8 0.4 c 806 1370 m 62 Y -20 16 d -62 Y f 0 0.8 0.2 c 806 1432 m 62
- Y -20 16 d -62 Y f 0 0.8 0 c 806 1494 m 62 Y -20 16 d -62 Y f 0.2 0.8 0 c 806
- 1556 m 63 Y -20 15 d -62 Y f 0.4 0.8 0 c 806 1619 m 10 Y -20 15 d -10 Y f black
- 786 1013 m 20 -16 d 632 Y -20 15 d cl s 0.4 0.8 0 c 806 1629 m 24 6 d -21 15 d
- -23 -6 d f black 806 1629 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 783 991 m
- 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 806 1059 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c
- 806 1121 m 63 Y -23 -6 d -63 Y f 0 0.6 0.8 c 806 1184 m 62 Y -23 -6 d -62 Y f 0
- 0.8 0.8 c 806 1246 m 62 Y -23 -6 d -62 Y f 0 0.8 0.6 c 806 1308 m 62 Y -23 -6 d
- -62 Y f 0 0.8 0.4 c 806 1370 m 62 Y -23 -6 d -62 Y f 0 0.8 0.2 c 806 1432 m 62
- Y -23 -6 d -62 Y f 0 0.8 0 c 806 1494 m 62 Y -23 -6 d -62 Y f 0.2 0.8 0 c 806
- 1556 m 63 Y -23 -6 d -63 Y f 0.4 0.8 0 c 806 1619 m 23 Y -23 -6 d -23 Y f black
- 783 991 m 23 6 d 645 Y -23 -6 d cl s 0 0 0.8 c 762 1007 m 21 -16 d 62 Y -21 16
- d f 0 0.2 0.8 c 783 1053 m 62 Y -21 16 d -62 Y f 0 0.4 0.8 c 783 1115 m 63 Y
- -21 15 d -62 Y f 0 0.6 0.8 c 783 1178 m 62 Y -21 15 d -62 Y f 0 0.8 0.8 c 783
- 1240 m 62 Y -21 15 d -62 Y f 0 0.8 0.6 c 783 1302 m 62 Y -21 16 d -63 Y f 0 0.8
- 0.4 c 783 1364 m 62 Y -21 16 d -62 Y f 0 0.8 0.2 c 783 1426 m 62 Y -21 16 d -62
- Y f 0 0.8 0 c 783 1488 m 62 Y -21 16 d -62 Y f 0.2 0.8 0 c 783 1550 m 63 Y -21
- 15 d -62 Y f 0.4 0.8 0 c 783 1613 m 23 Y -21 16 d -24 Y f black 762 1007 m 21
- -16 d 645 Y -21 16 d cl s 0.4 0.8 0 c 783 1636 m 23 6 d -20 16 d -24 -6 d f
- black 783 1636 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 759 985 m 24 6 d 62 Y
- -24 -6 d f 0 0.2 0.8 c 783 1053 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 783 1115 m
- 63 Y -24 -6 d -63 Y f 0 0.6 0.8 c 783 1178 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c
- 783 1240 m 62 Y -24 -6 d -62 Y f 0 0.8 0.6 c 783 1302 m 62 Y -24 -6 d -62 Y f 0
- 0.8 0.4 c 783 1364 m 62 Y -24 -6 d -62 Y f 0 0.8 0.2 c 783 1426 m 62 Y -24 -6 d
- -62 Y f 0 0.8 0 c 783 1488 m 62 Y -24 -6 d -62 Y f 0.2 0.8 0 c 783 1550 m 63 Y
- -24 -6 d -63 Y f 0.4 0.8 0 c 783 1613 m 62 Y -24 -6 d -62 Y f 0.6 0.8 0 c 783
- 1675 m 1 Y -24 -6 d -1 Y f black 759 985 m 24 6 d 685 Y -24 -6 d cl s 0 0 0.8 c
- 739 1001 m 20 -16 d 62 Y -20 16 d f 0 0.2 0.8 c 759 1047 m 62 Y -20 16 d -62 Y
- f 0 0.4 0.8 c 759 1109 m 63 Y -20 15 d -62 Y f 0 0.6 0.8 c 759 1172 m 62 Y -20
- 15 d -62 Y f 0 0.8 0.8 c 759 1234 m 62 Y -20 15 d -62 Y f 0 0.8 0.6 c 759 1296
- m 62 Y -20 16 d -63 Y f 0 0.8 0.4 c 759 1358 m 62 Y -20 16 d -62 Y f 0 0.8 0.2
- c 759 1420 m 62 Y -20 16 d -62 Y f 0 0.8 0 c 759 1482 m 62 Y -20 16 d -62 Y f
- 0.2 0.8 0 c 759 1544 m 63 Y -20 15 d -62 Y f 0.4 0.8 0 c 759 1607 m 62 Y -20 15
- d -62 Y f 0.6 0.8 0 c 759 1669 m 1 Y -20 16 d -2 Y f black 739 1001 m 20 -16 d
- 685 Y -20 16 d cl s 0.6 0.8 0 c 759 1670 m 24 6 d -21 16 d -23 -6 d f black 759
- 1670 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 736 979 m 23 6 d 62 Y -23 -6 d f
- 0 0.2 0.8 c 759 1047 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 759 1109 m 63 Y -23 -6
- d -63 Y f 0 0.6 0.8 c 759 1172 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 759 1234 m
- 62 Y -23 -6 d -62 Y f 0 0.8 0.6 c 759 1296 m 62 Y -23 -6 d -62 Y f 0 0.8 0.4 c
- 759 1358 m 62 Y -23 -6 d -62 Y f 0 0.8 0.2 c 759 1420 m 62 Y -23 -6 d -62 Y f 0
- 0.8 0 c 759 1482 m 62 Y -23 -6 d -62 Y f 0.2 0.8 0 c 759 1544 m 63 Y -23 -6 d
- -63 Y f 0.4 0.8 0 c 759 1607 m 62 Y -23 -6 d -62 Y f 0.6 0.8 0 c 759 1669 m 62
- Y -23 -6 d -62 Y f 0.8 0.8 0 c 759 1731 m 60 Y -23 -6 d -60 Y f black 736 979 m
- 23 6 d 806 Y -23 -6 d cl s 0 0 0.8 c 715 995 m 21 -16 d 62 Y -21 16 d f 0 0.2
- 0.8 c 736 1041 m 62 Y -21 16 d -62 Y f 0 0.4 0.8 c 736 1103 m 63 Y -21 15 d -62
- Y f 0 0.6 0.8 c 736 1166 m 62 Y -21 15 d -62 Y f 0 0.8 0.8 c 736 1228 m 62 Y
- -21 15 d -62 Y f 0 0.8 0.6 c 736 1290 m 62 Y -21 16 d -63 Y f 0 0.8 0.4 c 736
- 1352 m 62 Y -21 16 d -62 Y f 0 0.8 0.2 c 736 1414 m 62 Y -21 16 d -62 Y f 0 0.8
- 0 c 736 1476 m 62 Y -21 16 d -62 Y f 0.2 0.8 0 c 736 1538 m 63 Y -21 15 d -62 Y
- f 0.4 0.8 0 c 736 1601 m 62 Y -21 15 d -62 Y f 0.6 0.8 0 c 736 1663 m 62 Y -21
- 15 d -62 Y f 0.8 0.8 0 c 736 1725 m 60 Y -21 16 d -61 Y f black 715 995 m 21
- -16 d 806 Y -21 16 d cl s 0.8 0.8 0 c 736 1785 m 23 6 d -20 16 d -24 -6 d f
- black 736 1785 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 712 973 m 24 6 d 62 Y
- -24 -6 d f 0 0.2 0.8 c 736 1041 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 736 1103 m
- 63 Y -24 -6 d -63 Y f 0 0.6 0.8 c 736 1166 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c
- 736 1228 m 62 Y -24 -6 d -62 Y f 0 0.8 0.6 c 736 1290 m 62 Y -24 -6 d -62 Y f 0
- 0.8 0.4 c 736 1352 m 62 Y -24 -6 d -62 Y f 0 0.8 0.2 c 736 1414 m 62 Y -24 -6 d
- -62 Y f 0 0.8 0 c 736 1476 m 62 Y -24 -6 d -62 Y f 0.2 0.8 0 c 736 1538 m 32 Y
- -24 -6 d -32 Y f black 712 973 m 24 6 d 591 Y -24 -6 d cl s 0 0 0.8 c 692 989 m
- 20 -16 d 62 Y -20 16 d f 0 0.2 0.8 c 712 1035 m 62 Y -20 16 d -62 Y f 0 0.4 0.8
- c 712 1097 m 63 Y -20 15 d -62 Y f 0 0.6 0.8 c 712 1160 m 62 Y -20 15 d -62 Y f
- 0 0.8 0.8 c 712 1222 m 62 Y -20 15 d -62 Y f 0 0.8 0.6 c 712 1284 m 62 Y -20 16
- d -63 Y f 0 0.8 0.4 c 712 1346 m 62 Y -20 16 d -62 Y f 0 0.8 0.2 c 712 1408 m
- 62 Y -20 16 d -62 Y f 0 0.8 0 c 712 1470 m 62 Y -20 16 d -62 Y f 0.2 0.8 0 c
- 712 1532 m 32 Y -20 16 d -32 Y f black 692 989 m 20 -16 d 591 Y -20 16 d cl s
- 0.2 0.8 0 c 712 1564 m 24 6 d -21 16 d -23 -6 d f black 712 1564 m 24 6 d -21
- 16 d -23 -6 d cl s 0 0 0.8 c 689 967 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 712
- 1035 m 62 Y -23 -5 d -63 Y f 0 0.4 0.8 c 712 1097 m 63 Y -23 -6 d -62 Y f 0 0.6
- 0.8 c 712 1160 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 712 1222 m 62 Y -23 -6 d -62
- Y f 0 0.8 0.6 c 712 1284 m 62 Y -23 -6 d -62 Y f 0 0.8 0.4 c 712 1346 m 62 Y
- -23 -6 d -62 Y f 0 0.8 0.2 c 712 1408 m 62 Y -23 -6 d -62 Y f 0 0.8 0 c 712
- 1470 m 62 Y -23 -5 d -63 Y f 0.2 0.8 0 c 712 1532 m 32 Y -23 -6 d -31 Y f black
- 689 967 m 23 6 d 591 Y -23 -6 d cl s 0 0 0.8 c 668 983 m 21 -16 d 62 Y -21 16 d
- f 0 0.2 0.8 c 689 1029 m 63 Y -21 15 d -62 Y f 0 0.4 0.8 c 689 1092 m 62 Y -21
- 15 d -62 Y f 0 0.6 0.8 c 689 1154 m 62 Y -21 15 d -62 Y f 0 0.8 0.8 c 689 1216
- m 62 Y -21 15 d -62 Y f 0 0.8 0.6 c 689 1278 m 62 Y -21 16 d -63 Y f 0 0.8 0.4
- c 689 1340 m 62 Y -21 16 d -62 Y f 0 0.8 0.2 c 689 1402 m 62 Y -21 16 d -62 Y f
- 0 0.8 0 c 689 1464 m 63 Y -21 15 d -62 Y f 0.2 0.8 0 c 689 1527 m 31 Y -21 16 d
- -32 Y f black 668 983 m 21 -16 d 591 Y -21 16 d cl s 0.2 0.8 0 c 689 1558 m 23
- 6 d -20 16 d -24 -6 d f black 689 1558 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8
- c 665 961 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 689 1029 m 63 Y -24 -6 d -63 Y f
- 0 0.4 0.8 c 689 1092 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 689 1154 m 62 Y -24 -6
- d -62 Y f 0 0.8 0.8 c 689 1216 m 62 Y -24 -6 d -62 Y f 0 0.8 0.6 c 689 1278 m
- 62 Y -24 -6 d -62 Y f 0 0.8 0.4 c 689 1340 m 62 Y -24 -6 d -62 Y f 0 0.8 0.2 c
- 689 1402 m 62 Y -24 -6 d -62 Y f 0 0.8 0 c 689 1464 m 63 Y -24 -6 d -63 Y f 0.2
- 0.8 0 c 689 1527 m 62 Y -24 -6 d -62 Y f 0.4 0.8 0 c 689 1589 m 62 Y -24 -6 d
- -62 Y f 0.6 0.8 0 c 689 1651 m 62 Y -24 -6 d -62 Y f 0.8 0.8 0 c 689 1713 m 62
- Y -24 -6 d -62 Y f 0.8 0.6 0 c 689 1775 m 25 Y -24 -6 d -25 Y f black 665 961 m
- 24 6 d 833 Y -24 -6 d cl s 0 0 0.8 c 645 977 m 20 -16 d 62 Y -20 16 d f 0 0.2
- 0.8 c 665 1023 m 63 Y -20 15 d -62 Y f 0 0.4 0.8 c 665 1086 m 62 Y -20 15 d -62
- Y f 0 0.6 0.8 c 665 1148 m 62 Y -20 15 d -62 Y f 0 0.8 0.8 c 665 1210 m 62 Y
- -20 15 d -62 Y f 0 0.8 0.6 c 665 1272 m 62 Y -20 16 d -63 Y f 0 0.8 0.4 c 665
- 1334 m 62 Y -20 16 d -62 Y f 0 0.8 0.2 c 665 1396 m 62 Y -20 16 d -62 Y f 0 0.8
- 0 c 665 1458 m 63 Y -20 15 d -62 Y f 0.2 0.8 0 c 665 1521 m 62 Y -20 15 d -62 Y
- f 0.4 0.8 0 c 665 1583 m 62 Y -20 15 d -62 Y f 0.6 0.8 0 c 665 1645 m 62 Y -20
- 15 d -62 Y f 0.8 0.8 0 c 665 1707 m 62 Y -20 16 d -63 Y f 0.8 0.6 0 c 665 1769
- m 25 Y -20 16 d -25 Y f black 645 977 m 20 -16 d 833 Y -20 16 d cl s 0.8 0.6 0
- c 665 1794 m 24 6 d -21 16 d -23 -6 d f black 665 1794 m 24 6 d -21 16 d -23 -6
- d cl s 0 0 0.8 c 642 955 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 665 1023 m 63 Y
- -23 -6 d -63 Y f 0 0.4 0.8 c 665 1086 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c 665
- 1148 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 665 1210 m 62 Y -23 -6 d -62 Y f 0 0.8
- 0.6 c 665 1272 m 62 Y -23 -6 d -62 Y f 0 0.8 0.4 c 665 1334 m 62 Y -23 -6 d -62
- Y f 0 0.8 0.2 c 665 1396 m 62 Y -23 -6 d -62 Y f 0 0.8 0 c 665 1458 m 63 Y -23
- -6 d -63 Y f 0.2 0.8 0 c 665 1521 m 5 Y -23 -6 d -5 Y f black 642 955 m 23 6 d
- 565 Y -23 -6 d cl s 0 0 0.8 c 621 971 m 21 -16 d 62 Y -21 16 d f 0 0.2 0.8 c
- 642 1017 m 63 Y -21 15 d -62 Y f 0 0.4 0.8 c 642 1080 m 62 Y -21 15 d -62 Y f 0
- 0.6 0.8 c 642 1142 m 62 Y -21 15 d -62 Y f 0 0.8 0.8 c 642 1204 m 62 Y -21 16 d
- -63 Y f 0 0.8 0.6 c 642 1266 m 62 Y -21 16 d -62 Y f 0 0.8 0.4 c 642 1328 m 62
- Y -21 16 d -62 Y f 0 0.8 0.2 c 642 1390 m 62 Y -21 16 d -62 Y f 0 0.8 0 c 642
- 1452 m 63 Y -21 15 d -62 Y f 0.2 0.8 0 c 642 1515 m 5 Y -21 15 d -5 Y f black
- 621 971 m 21 -16 d 565 Y -21 15 d cl s 0.2 0.8 0 c 642 1520 m 23 6 d -20 15 d
- -24 -6 d f black 642 1520 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 618 949 m
- 24 6 d -21 16 d -23 -6 d f black 618 949 m 24 6 d -21 16 d -23 -6 d cl s 0 0
- 0.8 c 595 943 m 23 6 d -20 16 d -24 -6 d f black 595 943 m 23 6 d -20 16 d -24
- -6 d cl s 0 0 0.8 c 571 937 m 24 6 d -21 16 d -23 -6 d f black 571 937 m 24 6 d
- -21 16 d -23 -6 d cl s 0 0 0.8 c 548 931 m 23 6 d -20 16 d -24 -6 d f black 548
- 931 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1672 1197 m 24 6 d -21 15 d -23
- -6 d f black 1672 1197 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 1649 1191 m 23
- 6 d -20 15 d -24 -6 d f black 1649 1191 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8
- c 1625 1185 m 24 6 d -21 15 d -23 -6 d f black 1625 1185 m 24 6 d -21 15 d -23
- -6 d cl s 0 0 0.8 c 1602 1179 m 23 6 d -20 15 d -24 -6 d f black 1602 1179 m 23
- 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1578 1173 m 24 6 d 62 Y -24 -6 d f 0 0.2
- 0.8 c 1602 1241 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 1602 1303 m 62 Y -24 -6 d
- -62 Y f 0 0.6 0.8 c 1602 1365 m 62 Y -24 -5 d -63 Y f 0 0.8 0.8 c 1602 1427 m
- 63 Y -24 -6 d -62 Y f 0 0.8 0.6 c 1602 1490 m 62 Y -24 -6 d -62 Y f 0 0.8 0.4 c
- 1602 1552 m 62 Y -24 -6 d -62 Y f 0 0.8 0.2 c 1602 1614 m 62 Y -24 -6 d -62 Y f
- 0 0.8 0 c 1602 1676 m 40 Y -24 -6 d -40 Y f black 1578 1173 m 24 6 d 537 Y -24
- -6 d cl s 0 0 0.8 c 1558 1188 m 20 -15 d 62 Y -20 16 d f 0 0.2 0.8 c 1578 1235
- m 62 Y -20 16 d -62 Y f 0 0.4 0.8 c 1578 1297 m 62 Y -20 16 d -62 Y f 0 0.6 0.8
- c 1578 1359 m 63 Y -20 15 d -62 Y f 0 0.8 0.8 c 1578 1422 m 62 Y -20 15 d -62 Y
- f 0 0.8 0.6 c 1578 1484 m 62 Y -20 15 d -62 Y f 0 0.8 0.4 c 1578 1546 m 62 Y
- -20 15 d -62 Y f 0 0.8 0.2 c 1578 1608 m 62 Y -20 16 d -63 Y f 0 0.8 0 c 1578
- 1670 m 40 Y -20 16 d -40 Y f black 1558 1188 m 20 -15 d 537 Y -20 16 d cl s 0
- 0.8 0 c 1578 1710 m 24 6 d -21 16 d -23 -6 d f black 1578 1710 m 24 6 d -21 16
- d -23 -6 d cl s 0 0 0.8 c 1555 1167 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 1578
- 1235 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 1578 1297 m 62 Y -23 -6 d -62 Y f 0
- 0.6 0.8 c 1578 1359 m 63 Y -23 -6 d -63 Y f 0 0.8 0.8 c 1578 1422 m 62 Y -23 -6
- d -62 Y f 0 0.8 0.6 c 1578 1484 m 62 Y -23 -6 d -62 Y f 0 0.8 0.4 c 1578 1546 m
- 17 Y -23 -6 d -17 Y f black 1555 1167 m 23 6 d 390 Y -23 -6 d cl s 0 0 0.8 c
- 1534 1182 m 21 -15 d 62 Y -21 16 d f 0 0.2 0.8 c 1555 1229 m 62 Y -21 16 d -62
- Y f 0 0.4 0.8 c 1555 1291 m 62 Y -21 16 d -62 Y f 0 0.6 0.8 c 1555 1353 m 63 Y
- -21 15 d -62 Y f 0 0.8 0.8 c 1555 1416 m 62 Y -21 15 d -62 Y f 0 0.8 0.6 c 1555
- 1478 m 62 Y -21 15 d -62 Y f 0 0.8 0.4 c 1555 1540 m 17 Y -21 15 d -17 Y f
- black 1534 1182 m 21 -15 d 390 Y -21 15 d cl s 0 0.8 0.4 c 1555 1557 m 23 6 d
- -20 15 d -24 -6 d f black 1555 1557 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c
- 1531 1161 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1555 1229 m 62 Y -24 -6 d -62 Y
- f 0 0.4 0.8 c 1555 1291 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 1555 1353 m 63 Y
- -24 -6 d -63 Y f 0 0.8 0.8 c 1555 1416 m 62 Y -24 -6 d -62 Y f 0 0.8 0.6 c 1555
- 1478 m 62 Y -24 -6 d -62 Y f 0 0.8 0.4 c 1555 1540 m 62 Y -24 -6 d -62 Y f 0
- 0.8 0.2 c 1555 1602 m 62 Y -24 -6 d -62 Y f 0 0.8 0 c 1555 1664 m 62 Y -24 -6 d
- -62 Y f 0.2 0.8 0 c 1555 1726 m 62 Y -24 -6 d -62 Y f 0.4 0.8 0 c 1555 1788 m
- 63 Y -24 -6 d -63 Y f 0.6 0.8 0 c 1555 1851 m 42 Y -24 -6 d -42 Y f black 1531
- 1161 m 24 6 d 726 Y -24 -6 d cl s 0 0 0.8 c 1511 1177 m 20 -16 d 62 Y -20 16 d
- f 0 0.2 0.8 c 1531 1223 m 62 Y -20 16 d -62 Y f 0 0.4 0.8 c 1531 1285 m 62 Y
- -20 16 d -62 Y f 0 0.6 0.8 c 1531 1347 m 63 Y -20 15 d -62 Y f 0 0.8 0.8 c 1531
- 1410 m 62 Y -20 15 d -62 Y f 0 0.8 0.6 c 1531 1472 m 62 Y -20 15 d -62 Y f 0
- 0.8 0.4 c 1531 1534 m 62 Y -20 16 d -63 Y f 0 0.8 0.2 c 1531 1596 m 62 Y -20 16
- d -62 Y f 0 0.8 0 c 1531 1658 m 62 Y -20 16 d -62 Y f 0.2 0.8 0 c 1531 1720 m
- 62 Y -20 16 d -62 Y f 0.4 0.8 0 c 1531 1782 m 63 Y -20 15 d -62 Y f 0.6 0.8 0 c
- 1531 1845 m 42 Y -20 15 d -42 Y f black 1511 1177 m 20 -16 d 726 Y -20 15 d
- cl s 0.6 0.8 0 c 1531 1887 m 24 6 d -21 15 d -23 -6 d f black 1531 1887 m 24 6
- d -21 15 d -23 -6 d cl s 0 0 0.8 c 1508 1155 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8
- c 1531 1223 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 1531 1285 m 62 Y -23 -6 d -62 Y
- f 0 0.6 0.8 c 1531 1347 m 63 Y -23 -6 d -63 Y f 0 0.8 0.8 c 1531 1410 m 62 Y
- -23 -6 d -62 Y f 0 0.8 0.6 c 1531 1472 m 62 Y -23 -6 d -62 Y f 0 0.8 0.4 c 1531
- 1534 m 62 Y -23 -6 d -62 Y f 0 0.8 0.2 c 1531 1596 m 62 Y -23 -6 d -62 Y f 0
- 0.8 0 c 1531 1658 m 62 Y -23 -6 d -62 Y f 0.2 0.8 0 c 1531 1720 m 62 Y -23 -6 d
- -62 Y f 0.4 0.8 0 c 1531 1782 m 63 Y -23 -6 d -63 Y f 0.6 0.8 0 c 1531 1845 m
- 62 Y -23 -6 d -62 Y f 0.8 0.8 0 c 1531 1907 m 62 Y -23 -6 d -62 Y f 0.8 0.6 0 c
- 1531 1969 m 25 Y -23 -6 d -25 Y f black 1508 1155 m 23 6 d 833 Y -23 -6 d cl s
- 0 0 0.8 c 1487 1171 m 21 -16 d 62 Y -21 16 d f 0 0.2 0.8 c 1508 1217 m 62 Y -21
- 16 d -62 Y f 0 0.4 0.8 c 1508 1279 m 62 Y -21 16 d -62 Y f 0 0.6 0.8 c 1508
- 1341 m 63 Y -21 15 d -62 Y f 0 0.8 0.8 c 1508 1404 m 62 Y -21 15 d -62 Y f 0
- 0.8 0.6 c 1508 1466 m 62 Y -21 15 d -62 Y f 0 0.8 0.4 c 1508 1528 m 62 Y -21 16
- d -63 Y f 0 0.8 0.2 c 1508 1590 m 62 Y -21 16 d -62 Y f 0 0.8 0 c 1508 1652 m
- 62 Y -21 16 d -62 Y f 0.2 0.8 0 c 1508 1714 m 62 Y -21 16 d -62 Y f 0.4 0.8 0 c
- 1508 1776 m 63 Y -21 15 d -62 Y f 0.6 0.8 0 c 1508 1839 m 62 Y -21 15 d -62 Y f
- 0.8 0.8 0 c 1508 1901 m 62 Y -21 15 d -62 Y f 0.8 0.6 0 c 1508 1963 m 25 Y -21
- 16 d -26 Y f black 1487 1171 m 21 -16 d 833 Y -21 16 d cl s 0.8 0.6 0 c 1508
- 1988 m 23 6 d -20 16 d -24 -6 d f black 1508 1988 m 23 6 d -20 16 d -24 -6 d
- cl s 0 0 0.8 c 1484 1149 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1508 1217 m 62 Y
- -24 -6 d -62 Y f 0 0.4 0.8 c 1508 1279 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 1508
- 1341 m 63 Y -24 -6 d -63 Y f 0 0.8 0.8 c 1508 1404 m 62 Y -24 -6 d -62 Y f 0
- 0.8 0.6 c 1508 1466 m 62 Y -24 -6 d -62 Y f 0 0.8 0.4 c 1508 1528 m 62 Y -24 -6
- d -62 Y f 0 0.8 0.2 c 1508 1590 m 62 Y -24 -6 d -62 Y f 0 0.8 0 c 1508 1652 m
- 62 Y -24 -6 d -62 Y f 0.2 0.8 0 c 1508 1714 m 5 Y -24 -6 d -5 Y f black 1484
- 1149 m 24 6 d 564 Y -24 -6 d cl s 0 0 0.8 c 1464 1165 m 20 -16 d 62 Y -20 16 d
- f 0 0.2 0.8 c 1484 1211 m 62 Y -20 16 d -62 Y f 0 0.4 0.8 c 1484 1273 m 62 Y
- -20 16 d -62 Y f 0 0.6 0.8 c 1484 1335 m 63 Y -20 15 d -62 Y f 0 0.8 0.8 c 1484
- 1398 m 62 Y -20 15 d -62 Y f 0 0.8 0.6 c 1484 1460 m 62 Y -20 15 d -62 Y f 0
- 0.8 0.4 c 1484 1522 m 62 Y -20 16 d -63 Y f 0 0.8 0.2 c 1484 1584 m 62 Y -20 16
- d -62 Y f 0 0.8 0 c 1484 1646 m 62 Y -20 16 d -62 Y f 0.2 0.8 0 c 1484 1708 m 5
- Y -20 16 d -5 Y f black 1464 1165 m 20 -16 d 564 Y -20 16 d cl s 0.2 0.8 0 c
- 1484 1713 m 24 6 d -21 16 d -23 -6 d f black 1484 1713 m 24 6 d -21 16 d -23 -6
- d cl s 0 0 0.8 c 1461 1143 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 1484 1211 m 62
- Y -23 -6 d -62 Y f 0 0.4 0.8 c 1484 1273 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c
- 1484 1335 m 63 Y -23 -6 d -63 Y f 0 0.8 0.8 c 1484 1398 m 62 Y -23 -6 d -62 Y f
- 0 0.8 0.6 c 1484 1460 m 62 Y -23 -6 d -62 Y f 0 0.8 0.4 c 1484 1522 m 62 Y -23
- -6 d -62 Y f 0 0.8 0.2 c 1484 1584 m 62 Y -23 -6 d -62 Y f 0 0.8 0 c 1484 1646
- m 62 Y -23 -6 d -62 Y f 0.2 0.8 0 c 1484 1708 m 62 Y -23 -6 d -62 Y f 0.4 0.8 0
- c 1484 1770 m 63 Y -23 -6 d -63 Y f 0.6 0.8 0 c 1484 1833 m 62 Y -23 -6 d -62 Y
- f 0.8 0.8 0 c 1484 1895 m 62 Y -23 -6 d -62 Y f 0.8 0.6 0 c 1484 1957 m 62 Y
- -23 -6 d -62 Y f 0.8 0.4 0 c 1484 2019 m 30 Y -23 -6 d -30 Y f black 1461 1143
- m 23 6 d 900 Y -23 -6 d cl s 0 0 0.8 c 1440 1159 m 21 -16 d 62 Y -21 16 d f 0
- 0.2 0.8 c 1461 1205 m 62 Y -21 16 d -62 Y f 0 0.4 0.8 c 1461 1267 m 62 Y -21 16
- d -62 Y f 0 0.6 0.8 c 1461 1329 m 63 Y -21 15 d -62 Y f 0 0.8 0.8 c 1461 1392 m
- 62 Y -21 15 d -62 Y f 0 0.8 0.6 c 1461 1454 m 62 Y -21 15 d -62 Y f 0 0.8 0.4 c
- 1461 1516 m 62 Y -21 16 d -63 Y f 0 0.8 0.2 c 1461 1578 m 62 Y -21 16 d -62 Y f
- 0 0.8 0 c 1461 1640 m 62 Y -21 16 d -62 Y f 0.2 0.8 0 c 1461 1702 m 62 Y -21 16
- d -62 Y f 0.4 0.8 0 c 1461 1764 m 63 Y -21 15 d -62 Y f 0.6 0.8 0 c 1461 1827 m
- 62 Y -21 15 d -62 Y f 0.8 0.8 0 c 1461 1889 m 62 Y -21 15 d -62 Y f 0.8 0.6 0 c
- 1461 1951 m 62 Y -21 16 d -63 Y f 0.8 0.4 0 c 1461 2013 m 30 Y -21 16 d -30 Y f
- black 1440 1159 m 21 -16 d 900 Y -21 16 d cl s 0.8 0.4 0 c 1461 2043 m 23 6 d
- -20 16 d -24 -6 d f black 1461 2043 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c
- 1437 1137 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1461 1205 m 62 Y -24 -6 d -62 Y
- f 0 0.4 0.8 c 1461 1267 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 1461 1329 m 63 Y
- -24 -6 d -63 Y f 0 0.8 0.8 c 1461 1392 m 62 Y -24 -6 d -62 Y f 0 0.8 0.6 c 1461
- 1454 m 62 Y -24 -6 d -62 Y f 0 0.8 0.4 c 1461 1516 m 62 Y -24 -6 d -62 Y f 0
- 0.8 0.2 c 1461 1578 m 62 Y -24 -6 d -62 Y f 0 0.8 0 c 1461 1640 m 62 Y -24 -6 d
- -62 Y f 0.2 0.8 0 c 1461 1702 m 59 Y -24 -6 d -59 Y f black 1437 1137 m 24 6 d
- 618 Y -24 -6 d cl s 0 0 0.8 c 1417 1153 m 20 -16 d 62 Y -20 16 d f 0 0.2 0.8 c
- 1437 1199 m 62 Y -20 16 d -62 Y f 0 0.4 0.8 c 1437 1261 m 62 Y -20 16 d -62 Y f
- 0 0.6 0.8 c 1437 1323 m 63 Y -20 15 d -62 Y f 0 0.8 0.8 c 1437 1386 m 62 Y -20
- 15 d -62 Y f 0 0.8 0.6 c 1437 1448 m 62 Y -20 15 d -62 Y f 0 0.8 0.4 c 1437
- 1510 m 62 Y -20 16 d -63 Y f 0 0.8 0.2 c 1437 1572 m 62 Y -20 16 d -62 Y f 0
- 0.8 0 c 1437 1634 m 62 Y -20 16 d -62 Y f 0.2 0.8 0 c 1437 1696 m 59 Y -20 16 d
- -59 Y f black 1417 1153 m 20 -16 d 618 Y -20 16 d cl s 0.2 0.8 0 c 1437 1755 m
- 24 6 d -21 16 d -23 -6 d f black 1437 1755 m 24 6 d -21 16 d -23 -6 d cl s 0 0
- 0.8 c 1414 1131 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 1437 1199 m 62 Y -23 -6 d
- -62 Y f 0 0.4 0.8 c 1437 1261 m 62 Y -23 -5 d -63 Y f 0 0.6 0.8 c 1437 1323 m
- 63 Y -23 -6 d -62 Y f 0 0.8 0.8 c 1437 1386 m 62 Y -23 -6 d -62 Y f 0 0.8 0.6 c
- 1437 1448 m 62 Y -23 -6 d -62 Y f 0 0.8 0.4 c 1437 1510 m 62 Y -23 -6 d -62 Y f
- 0 0.8 0.2 c 1437 1572 m 62 Y -23 -6 d -62 Y f 0 0.8 0 c 1437 1634 m 62 Y -23 -6
- d -62 Y f 0.2 0.8 0 c 1437 1696 m 62 Y -23 -5 d -63 Y f 0.4 0.8 0 c 1437 1758 m
- 63 Y -23 -6 d -62 Y f 0.6 0.8 0 c 1437 1821 m 42 Y -23 -6 d -42 Y f black 1414
- 1131 m 23 6 d 726 Y -23 -6 d cl s 0 0 0.8 c 1393 1147 m 21 -16 d 62 Y -21 16 d
- f 0 0.2 0.8 c 1414 1193 m 62 Y -21 16 d -62 Y f 0 0.4 0.8 c 1414 1255 m 63 Y
- -21 15 d -62 Y f 0 0.6 0.8 c 1414 1318 m 62 Y -21 15 d -62 Y f 0 0.8 0.8 c 1414
- 1380 m 62 Y -21 15 d -62 Y f 0 0.8 0.6 c 1414 1442 m 62 Y -21 15 d -62 Y f 0
- 0.8 0.4 c 1414 1504 m 62 Y -21 16 d -63 Y f 0 0.8 0.2 c 1414 1566 m 62 Y -21 16
- d -62 Y f 0 0.8 0 c 1414 1628 m 62 Y -21 16 d -62 Y f 0.2 0.8 0 c 1414 1690 m
- 63 Y -21 15 d -62 Y f 0.4 0.8 0 c 1414 1753 m 62 Y -21 15 d -62 Y f 0.6 0.8 0 c
- 1414 1815 m 42 Y -21 15 d -42 Y f black 1393 1147 m 21 -16 d 726 Y -21 15 d
- cl s 0.6 0.8 0 c 1414 1857 m 23 6 d -20 15 d -24 -6 d f black 1414 1857 m 23 6
- d -20 15 d -24 -6 d cl s 0 0 0.8 c 1390 1125 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8
- c 1414 1193 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 1414 1255 m 63 Y -24 -6 d -63 Y
- f 0 0.6 0.8 c 1414 1318 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 1414 1380 m 62 Y
- -24 -6 d -62 Y f 0 0.8 0.6 c 1414 1442 m 62 Y -24 -6 d -62 Y f 0 0.8 0.4 c 1414
- 1504 m 62 Y -24 -6 d -62 Y f 0 0.8 0.2 c 1414 1566 m 62 Y -24 -6 d -62 Y f 0
- 0.8 0 c 1414 1628 m 62 Y -24 -6 d -62 Y f 0.2 0.8 0 c 1414 1690 m 63 Y -24 -6 d
- -63 Y f 0.4 0.8 0 c 1414 1753 m 62 Y -24 -6 d -62 Y f 0.6 0.8 0 c 1414 1815 m
- 42 Y -24 -6 d -42 Y f black 1390 1125 m 24 6 d 726 Y -24 -6 d cl s 0 0 0.8 c
- 1370 1141 m 20 -16 d 62 Y -20 16 d f 0 0.2 0.8 c 1390 1187 m 62 Y -20 16 d -62
- Y f 0 0.4 0.8 c 1390 1249 m 63 Y -20 15 d -62 Y f 0 0.6 0.8 c 1390 1312 m 62 Y
- -20 15 d -62 Y f 0 0.8 0.8 c 1390 1374 m 62 Y -20 15 d -62 Y f 0 0.8 0.6 c 1390
- 1436 m 62 Y -20 15 d -62 Y f 0 0.8 0.4 c 1390 1498 m 62 Y -20 16 d -63 Y f 0
- 0.8 0.2 c 1390 1560 m 62 Y -20 16 d -62 Y f 0 0.8 0 c 1390 1622 m 62 Y -20 16 d
- -62 Y f 0.2 0.8 0 c 1390 1684 m 63 Y -20 15 d -62 Y f 0.4 0.8 0 c 1390 1747 m
- 62 Y -20 15 d -62 Y f 0.6 0.8 0 c 1390 1809 m 42 Y -20 15 d -42 Y f black 1370
- 1141 m 20 -16 d 726 Y -20 15 d cl s 0.6 0.8 0 c 1390 1851 m 24 6 d -21 15 d -23
- -6 d f black 1390 1851 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 1367 1119 m 23
- 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 1390 1187 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c
- 1390 1249 m 63 Y -23 -6 d -63 Y f 0 0.6 0.8 c 1390 1312 m 62 Y -23 -6 d -62 Y f
- 0 0.8 0.8 c 1390 1374 m 62 Y -23 -6 d -62 Y f 0 0.8 0.6 c 1390 1436 m 62 Y -23
- -6 d -62 Y f 0 0.8 0.4 c 1390 1498 m 62 Y -23 -6 d -62 Y f 0 0.8 0.2 c 1390
- 1560 m 62 Y -23 -6 d -62 Y f 0 0.8 0 c 1390 1622 m 62 Y -23 -6 d -62 Y f 0.2
- 0.8 0 c 1390 1684 m 63 Y -23 -6 d -63 Y f 0.4 0.8 0 c 1390 1747 m 62 Y -23 -6 d
- -62 Y f 0.6 0.8 0 c 1390 1809 m 62 Y -23 -6 d -62 Y f 0.8 0.8 0 c 1390 1871 m
- 62 Y -23 -6 d -62 Y f 0.8 0.6 0 c 1390 1933 m 62 Y -23 -6 d -62 Y f 0.8 0.4 0 c
- 1390 1995 m 62 Y -23 -6 d -62 Y f 0.8 0.2 0 c 1390 2057 m 62 Y -23 -6 d -62 Y f
- black 1367 1119 m 23 6 d 994 Y -23 -6 d cl s 0 0 0.8 c 1346 1135 m 21 -16 d 62
- Y -21 16 d f 0 0.2 0.8 c 1367 1181 m 62 Y -21 16 d -62 Y f 0 0.4 0.8 c 1367
- 1243 m 63 Y -21 15 d -62 Y f 0 0.6 0.8 c 1367 1306 m 62 Y -21 15 d -62 Y f 0
- 0.8 0.8 c 1367 1368 m 62 Y -21 15 d -62 Y f 0 0.8 0.6 c 1367 1430 m 62 Y -21 16
- d -63 Y f 0 0.8 0.4 c 1367 1492 m 62 Y -21 16 d -62 Y f 0 0.8 0.2 c 1367 1554 m
- 62 Y -21 16 d -62 Y f 0 0.8 0 c 1367 1616 m 62 Y -21 16 d -62 Y f 0.2 0.8 0 c
- 1367 1678 m 63 Y -21 15 d -62 Y f 0.4 0.8 0 c 1367 1741 m 62 Y -21 15 d -62 Y f
- 0.6 0.8 0 c 1367 1803 m 62 Y -21 15 d -62 Y f 0.8 0.8 0 c 1367 1865 m 62 Y -21
- 16 d -63 Y f 0.8 0.6 0 c 1367 1927 m 62 Y -21 16 d -62 Y f 0.8 0.4 0 c 1367
- 1989 m 62 Y -21 16 d -62 Y f 0.8 0.2 0 c 1367 2051 m 62 Y -21 16 d -62 Y f
- black 1346 1135 m 21 -16 d 994 Y -21 16 d cl s 0.8 0.2 0 c 1367 2113 m 23 6 d
- -20 16 d -24 -6 d f black 1367 2113 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c
- 1343 1113 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1367 1181 m 62 Y -24 -6 d -62 Y
- f 0 0.4 0.8 c 1367 1243 m 63 Y -24 -6 d -63 Y f 0 0.6 0.8 c 1367 1306 m 62 Y
- -24 -6 d -62 Y f 0 0.8 0.8 c 1367 1368 m 62 Y -24 -6 d -62 Y f 0 0.8 0.6 c 1367
- 1430 m 62 Y -24 -6 d -62 Y f 0 0.8 0.4 c 1367 1492 m 62 Y -24 -6 d -62 Y f 0
- 0.8 0.2 c 1367 1554 m 62 Y -24 -6 d -62 Y f 0 0.8 0 c 1367 1616 m 62 Y -24 -6 d
- -62 Y f 0.2 0.8 0 c 1367 1678 m 63 Y -24 -6 d -63 Y f 0.4 0.8 0 c 1367 1741 m
- 62 Y -24 -6 d -62 Y f 0.6 0.8 0 c 1367 1803 m 55 Y -24 -6 d -55 Y f black 1343
- 1113 m 24 6 d 739 Y -24 -6 d cl s 0 0 0.8 c 1323 1129 m 20 -16 d 62 Y -20 16 d
- f 0 0.2 0.8 c 1343 1175 m 62 Y -20 16 d -62 Y f 0 0.4 0.8 c 1343 1237 m 63 Y
- -20 15 d -62 Y f 0 0.6 0.8 c 1343 1300 m 62 Y -20 15 d -62 Y f 0 0.8 0.8 c 1343
- 1362 m 62 Y -20 15 d -62 Y f 0 0.8 0.6 c 1343 1424 m 62 Y -20 16 d -63 Y f 0
- 0.8 0.4 c 1343 1486 m 62 Y -20 16 d -62 Y f 0 0.8 0.2 c 1343 1548 m 62 Y -20 16
- d -62 Y f 0 0.8 0 c 1343 1610 m 62 Y -20 16 d -62 Y f 0.2 0.8 0 c 1343 1672 m
- 63 Y -20 15 d -62 Y f 0.4 0.8 0 c 1343 1735 m 62 Y -20 15 d -62 Y f 0.6 0.8 0 c
- 1343 1797 m 55 Y -20 16 d -56 Y f black 1323 1129 m 20 -16 d 739 Y -20 16 d
- cl s 0.6 0.8 0 c 1343 1852 m 24 6 d -21 16 d -23 -6 d f black 1343 1852 m 24 6
- d -21 16 d -23 -6 d cl s 0 0 0.8 c 1320 1107 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8
- c 1343 1175 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 1343 1237 m 63 Y -23 -6 d -63 Y
- f 0 0.6 0.8 c 1343 1300 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 1343 1362 m 62 Y
- -23 -6 d -62 Y f 0 0.8 0.6 c 1343 1424 m 62 Y -23 -6 d -62 Y f 0 0.8 0.4 c 1343
- 1486 m 62 Y -23 -6 d -62 Y f 0 0.8 0.2 c 1343 1548 m 62 Y -23 -6 d -62 Y f 0
- 0.8 0 c 1343 1610 m 62 Y -23 -6 d -62 Y f 0.2 0.8 0 c 1343 1672 m 63 Y -23 -6 d
- -63 Y f 0.4 0.8 0 c 1343 1735 m 62 Y -23 -6 d -62 Y f 0.6 0.8 0 c 1343 1797 m
- 62 Y -23 -6 d -62 Y f 0.8 0.8 0 c 1343 1859 m 20 Y -23 -6 d -20 Y f black 1320
- 1107 m 23 6 d 766 Y -23 -6 d cl s 0 0 0.8 c 1299 1123 m 21 -16 d 62 Y -21 16 d
- f 0 0.2 0.8 c 1320 1169 m 62 Y -21 16 d -62 Y f 0 0.4 0.8 c 1320 1231 m 63 Y
- -21 15 d -62 Y f 0 0.6 0.8 c 1320 1294 m 62 Y -21 15 d -62 Y f 0 0.8 0.8 c 1320
- 1356 m 62 Y -21 15 d -62 Y f 0 0.8 0.6 c 1320 1418 m 62 Y -21 16 d -63 Y f 0
- 0.8 0.4 c 1320 1480 m 62 Y -21 16 d -62 Y f 0 0.8 0.2 c 1320 1542 m 62 Y -21 16
- d -62 Y f 0 0.8 0 c 1320 1604 m 62 Y -21 16 d -62 Y f 0.2 0.8 0 c 1320 1666 m
- 63 Y -21 15 d -62 Y f 0.4 0.8 0 c 1320 1729 m 62 Y -21 15 d -62 Y f 0.6 0.8 0 c
- 1320 1791 m 62 Y -21 15 d -62 Y f 0.8 0.8 0 c 1320 1853 m 20 Y -21 16 d -21 Y f
- black 1299 1123 m 21 -16 d 766 Y -21 16 d cl s 0.8 0.8 0 c 1320 1873 m 23 6 d
- -20 16 d -24 -6 d f black 1320 1873 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c
- 1296 1101 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1320 1169 m 62 Y -24 -6 d -62 Y
- f 0 0.4 0.8 c 1320 1231 m 63 Y -24 -6 d -63 Y f 0 0.6 0.8 c 1320 1294 m 62 Y
- -24 -6 d -62 Y f 0 0.8 0.8 c 1320 1356 m 62 Y -24 -6 d -62 Y f 0 0.8 0.6 c 1320
- 1418 m 62 Y -24 -6 d -62 Y f 0 0.8 0.4 c 1320 1480 m 62 Y -24 -6 d -62 Y f 0
- 0.8 0.2 c 1320 1542 m 62 Y -24 -6 d -62 Y f 0 0.8 0 c 1320 1604 m 62 Y -24 -6 d
- -62 Y f 0.2 0.8 0 c 1320 1666 m 63 Y -24 -6 d -63 Y f 0.4 0.8 0 c 1320 1729 m
- 62 Y -24 -6 d -62 Y f 0.6 0.8 0 c 1320 1791 m 62 Y -24 -6 d -62 Y f 0.8 0.8 0 c
- 1320 1853 m 60 Y -24 -6 d -60 Y f black 1296 1101 m 24 6 d 806 Y -24 -6 d cl s
- 0 0 0.8 c 1276 1117 m 20 -16 d 62 Y -20 16 d f 0 0.2 0.8 c 1296 1163 m 62 Y -20
- 16 d -62 Y f 0 0.4 0.8 c 1296 1225 m 63 Y -20 15 d -62 Y f 0 0.6 0.8 c 1296
- 1288 m 62 Y -20 15 d -62 Y f 0 0.8 0.8 c 1296 1350 m 62 Y -20 15 d -62 Y f 0
- 0.8 0.6 c 1296 1412 m 62 Y -20 16 d -63 Y f 0 0.8 0.4 c 1296 1474 m 62 Y -20 16
- d -62 Y f 0 0.8 0.2 c 1296 1536 m 62 Y -20 16 d -62 Y f 0 0.8 0 c 1296 1598 m
- 62 Y -20 16 d -62 Y f 0.2 0.8 0 c 1296 1660 m 63 Y -20 15 d -62 Y f 0.4 0.8 0 c
- 1296 1723 m 62 Y -20 15 d -62 Y f 0.6 0.8 0 c 1296 1785 m 62 Y -20 15 d -62 Y f
- 0.8 0.8 0 c 1296 1847 m 60 Y -20 16 d -61 Y f black 1276 1117 m 20 -16 d 806 Y
- -20 16 d cl s 0.8 0.8 0 c 1296 1907 m 24 6 d -21 16 d -23 -6 d f black 1296
- 1907 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1273 1095 m 23 6 d 62 Y -23 -6 d
- f 0 0.2 0.8 c 1296 1163 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 1296 1225 m 63 Y
- -23 -6 d -63 Y f 0 0.6 0.8 c 1296 1288 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 1296
- 1350 m 62 Y -23 -6 d -62 Y f 0 0.8 0.6 c 1296 1412 m 62 Y -23 -6 d -62 Y f 0
- 0.8 0.4 c 1296 1474 m 62 Y -23 -6 d -62 Y f 0 0.8 0.2 c 1296 1536 m 62 Y -23 -6
- d -62 Y f 0 0.8 0 c 1296 1598 m 27 Y -23 -6 d -27 Y f black 1273 1095 m 23 6 d
- 524 Y -23 -6 d cl s 0 0 0.8 c 1252 1111 m 21 -16 d 62 Y -21 16 d f 0 0.2 0.8 c
- 1273 1157 m 62 Y -21 16 d -62 Y f 0 0.4 0.8 c 1273 1219 m 63 Y -21 15 d -62 Y f
- 0 0.6 0.8 c 1273 1282 m 62 Y -21 15 d -62 Y f 0 0.8 0.8 c 1273 1344 m 62 Y -21
- 15 d -62 Y f 0 0.8 0.6 c 1273 1406 m 62 Y -21 16 d -63 Y f 0 0.8 0.4 c 1273
- 1468 m 62 Y -21 16 d -62 Y f 0 0.8 0.2 c 1273 1530 m 62 Y -21 16 d -62 Y f 0
- 0.8 0 c 1273 1592 m 27 Y -21 16 d -27 Y f black 1252 1111 m 21 -16 d 524 Y -21
- 16 d cl s 0 0.8 0 c 1273 1619 m 23 6 d -20 16 d -24 -6 d f black 1273 1619 m 23
- 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1249 1089 m 24 6 d 62 Y -24 -6 d f 0 0.2
- 0.8 c 1273 1157 m 62 Y -24 -5 d -63 Y f 0 0.4 0.8 c 1273 1219 m 63 Y -24 -6 d
- -62 Y f 0 0.6 0.8 c 1273 1282 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 1273 1344 m
- 62 Y -24 -6 d -62 Y f 0 0.8 0.6 c 1273 1406 m 62 Y -24 -6 d -62 Y f 0 0.8 0.4 c
- 1273 1468 m 62 Y -24 -6 d -62 Y f 0 0.8 0.2 c 1273 1530 m 62 Y -24 -6 d -62 Y f
- 0 0.8 0 c 1273 1592 m 62 Y -24 -5 d -63 Y f 0.2 0.8 0 c 1273 1654 m 63 Y -24 -6
- d -62 Y f 0.4 0.8 0 c 1273 1717 m 62 Y -24 -6 d -62 Y f 0.6 0.8 0 c 1273 1779 m
- 62 Y -24 -6 d -62 Y f 0.8 0.8 0 c 1273 1841 m 62 Y -24 -6 d -62 Y f 0.8 0.6 0 c
- 1273 1903 m 62 Y -24 -6 d -62 Y f 0.8 0.4 0 c 1273 1965 m 4 Y -24 -6 d -4 Y f
- black 1249 1089 m 24 6 d 874 Y -24 -6 d cl s 0 0 0.8 c 1229 1105 m 20 -16 d 62
- Y -20 16 d f 0 0.2 0.8 c 1249 1151 m 63 Y -20 15 d -62 Y f 0 0.4 0.8 c 1249
- 1214 m 62 Y -20 15 d -62 Y f 0 0.6 0.8 c 1249 1276 m 62 Y -20 15 d -62 Y f 0
- 0.8 0.8 c 1249 1338 m 62 Y -20 15 d -62 Y f 0 0.8 0.6 c 1249 1400 m 62 Y -20 16
- d -63 Y f 0 0.8 0.4 c 1249 1462 m 62 Y -20 16 d -62 Y f 0 0.8 0.2 c 1249 1524 m
- 62 Y -20 16 d -62 Y f 0 0.8 0 c 1249 1586 m 63 Y -20 15 d -62 Y f 0.2 0.8 0 c
- 1249 1649 m 62 Y -20 15 d -62 Y f 0.4 0.8 0 c 1249 1711 m 62 Y -20 15 d -62 Y f
- 0.6 0.8 0 c 1249 1773 m 62 Y -20 15 d -62 Y f 0.8 0.8 0 c 1249 1835 m 62 Y -20
- 16 d -63 Y f 0.8 0.6 0 c 1249 1897 m 62 Y -20 16 d -62 Y f 0.8 0.4 0 c 1249
- 1959 m 4 Y -20 15 d -3 Y f black 1229 1105 m 20 -16 d 874 Y -20 15 d cl s 0.8
- 0.4 0 c 1249 1963 m 24 6 d -21 15 d -23 -6 d f black 1249 1963 m 24 6 d -21 15
- d -23 -6 d cl s 0 0 0.8 c 1226 1083 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 1249
- 1151 m 63 Y -23 -6 d -63 Y f 0 0.4 0.8 c 1249 1214 m 62 Y -23 -6 d -62 Y f 0
- 0.6 0.8 c 1249 1276 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 1249 1338 m 62 Y -23 -6
- d -62 Y f 0 0.8 0.6 c 1249 1400 m 62 Y -23 -6 d -62 Y f 0 0.8 0.4 c 1249 1462 m
- 62 Y -23 -6 d -62 Y f 0 0.8 0.2 c 1249 1524 m 62 Y -23 -6 d -62 Y f 0 0.8 0 c
- 1249 1586 m 63 Y -23 -6 d -63 Y f 0.2 0.8 0 c 1249 1649 m 62 Y -23 -6 d -62 Y f
- 0.4 0.8 0 c 1249 1711 m 62 Y -23 -6 d -62 Y f 0.6 0.8 0 c 1249 1773 m 62 Y -23
- -6 d -62 Y f 0.8 0.8 0 c 1249 1835 m 62 Y -23 -6 d -62 Y f 0.8 0.6 0 c 1249
- 1897 m 62 Y -23 -6 d -62 Y f 0.8 0.4 0 c 1249 1959 m 4 Y -23 -6 d -4 Y f black
- 1226 1083 m 23 6 d 874 Y -23 -6 d cl s 0 0 0.8 c 1205 1099 m 21 -16 d 62 Y -21
- 16 d f 0 0.2 0.8 c 1226 1145 m 63 Y -21 15 d -62 Y f 0 0.4 0.8 c 1226 1208 m 62
- Y -21 15 d -62 Y f 0 0.6 0.8 c 1226 1270 m 62 Y -21 15 d -62 Y f 0 0.8 0.8 c
- 1226 1332 m 62 Y -21 15 d -62 Y f 0 0.8 0.6 c 1226 1394 m 62 Y -21 16 d -63 Y f
- 0 0.8 0.4 c 1226 1456 m 62 Y -21 16 d -62 Y f 0 0.8 0.2 c 1226 1518 m 62 Y -21
- 16 d -62 Y f 0 0.8 0 c 1226 1580 m 63 Y -21 15 d -62 Y f 0.2 0.8 0 c 1226 1643
- m 62 Y -21 15 d -62 Y f 0.4 0.8 0 c 1226 1705 m 62 Y -21 15 d -62 Y f 0.6 0.8 0
- c 1226 1767 m 62 Y -21 15 d -62 Y f 0.8 0.8 0 c 1226 1829 m 62 Y -21 16 d -63 Y
- f 0.8 0.6 0 c 1226 1891 m 62 Y -21 16 d -62 Y f 0.8 0.4 0 c 1226 1953 m 4 Y -21
- 15 d -3 Y f black 1205 1099 m 21 -16 d 874 Y -21 15 d cl s 0.8 0.4 0 c 1226
- 1957 m 23 6 d -20 15 d -24 -6 d f black 1226 1957 m 23 6 d -20 15 d -24 -6 d
- cl s 0 0 0.8 c 1202 1077 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1226 1145 m 63 Y
- -24 -6 d -63 Y f 0 0.4 0.8 c 1226 1208 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 1226
- 1270 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 1226 1332 m 62 Y -24 -6 d -62 Y f 0
- 0.8 0.6 c 1226 1394 m 62 Y -24 -6 d -62 Y f 0 0.8 0.4 c 1226 1456 m 62 Y -24 -6
- d -62 Y f 0 0.8 0.2 c 1226 1518 m 62 Y -24 -6 d -62 Y f 0 0.8 0 c 1226 1580 m
- 63 Y -24 -6 d -63 Y f 0.2 0.8 0 c 1226 1643 m 62 Y -24 -6 d -62 Y f 0.4 0.8 0 c
- 1226 1705 m 10 Y -24 -6 d -10 Y f black 1202 1077 m 24 6 d 632 Y -24 -6 d cl s
- 0 0 0.8 c 1182 1093 m 20 -16 d 62 Y -20 16 d f 0 0.2 0.8 c 1202 1139 m 63 Y -20
- 15 d -62 Y f 0 0.4 0.8 c 1202 1202 m 62 Y -20 15 d -62 Y f 0 0.6 0.8 c 1202
- 1264 m 62 Y -20 15 d -62 Y f 0 0.8 0.8 c 1202 1326 m 62 Y -20 16 d -63 Y f 0
- 0.8 0.6 c 1202 1388 m 62 Y -20 16 d -62 Y f 0 0.8 0.4 c 1202 1450 m 62 Y -20 16
- d -62 Y f 0 0.8 0.2 c 1202 1512 m 62 Y -20 16 d -62 Y f 0 0.8 0 c 1202 1574 m
- 63 Y -20 15 d -62 Y f 0.2 0.8 0 c 1202 1637 m 62 Y -20 15 d -62 Y f 0.4 0.8 0 c
- 1202 1699 m 10 Y -20 15 d -10 Y f black 1182 1093 m 20 -16 d 632 Y -20 15 d
- cl s 0.4 0.8 0 c 1202 1709 m 24 6 d -21 15 d -23 -6 d f black 1202 1709 m 24 6
- d -21 15 d -23 -6 d cl s 0 0 0.8 c 1179 1071 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8
- c 1202 1139 m 63 Y -23 -6 d -63 Y f 0 0.4 0.8 c 1202 1202 m 62 Y -23 -6 d -62 Y
- f 0 0.6 0.8 c 1202 1264 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 1202 1326 m 62 Y
- -23 -6 d -62 Y f 0 0.8 0.6 c 1202 1388 m 62 Y -23 -6 d -62 Y f 0 0.8 0.4 c 1202
- 1450 m 62 Y -23 -6 d -62 Y f 0 0.8 0.2 c 1202 1512 m 62 Y -23 -6 d -62 Y f 0
- 0.8 0 c 1202 1574 m 63 Y -23 -6 d -63 Y f 0.2 0.8 0 c 1202 1637 m 62 Y -23 -6 d
- -62 Y f 0.4 0.8 0 c 1202 1699 m 62 Y -23 -6 d -62 Y f 0.6 0.8 0 c 1202 1761 m
- 42 Y -23 -6 d -42 Y f black 1179 1071 m 23 6 d 726 Y -23 -6 d cl s 0 0 0.8 c
- 1158 1087 m 21 -16 d 62 Y -21 16 d f 0 0.2 0.8 c 1179 1133 m 63 Y -21 15 d -62
- Y f 0 0.4 0.8 c 1179 1196 m 62 Y -21 15 d -62 Y f 0 0.6 0.8 c 1179 1258 m 62 Y
- -21 15 d -62 Y f 0 0.8 0.8 c 1179 1320 m 62 Y -21 16 d -63 Y f 0 0.8 0.6 c 1179
- 1382 m 62 Y -21 16 d -62 Y f 0 0.8 0.4 c 1179 1444 m 62 Y -21 16 d -62 Y f 0
- 0.8 0.2 c 1179 1506 m 62 Y -21 16 d -62 Y f 0 0.8 0 c 1179 1568 m 63 Y -21 15 d
- -62 Y f 0.2 0.8 0 c 1179 1631 m 62 Y -21 15 d -62 Y f 0.4 0.8 0 c 1179 1693 m
- 62 Y -21 15 d -62 Y f 0.6 0.8 0 c 1179 1755 m 42 Y -21 15 d -42 Y f black 1158
- 1087 m 21 -16 d 726 Y -21 15 d cl s 0.6 0.8 0 c 1179 1797 m 23 6 d -20 15 d -24
- -6 d f black 1179 1797 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1155 1065 m 24
- 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1179 1133 m 63 Y -24 -6 d -63 Y f 0 0.4 0.8 c
- 1179 1196 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 1179 1258 m 62 Y -24 -6 d -62 Y f
- 0 0.8 0.8 c 1179 1320 m 62 Y -24 -6 d -62 Y f 0 0.8 0.6 c 1179 1382 m 62 Y -24
- -6 d -62 Y f 0 0.8 0.4 c 1179 1444 m 62 Y -24 -6 d -62 Y f 0 0.8 0.2 c 1179
- 1506 m 62 Y -24 -6 d -62 Y f 0 0.8 0 c 1179 1568 m 63 Y -24 -6 d -63 Y f 0.2
- 0.8 0 c 1179 1631 m 58 Y -24 -6 d -58 Y f black 1155 1065 m 24 6 d 618 Y -24 -6
- d cl s 0 0 0.8 c 1135 1081 m 20 -16 d 62 Y -20 16 d f 0 0.2 0.8 c 1155 1127 m
- 63 Y -20 15 d -62 Y f 0 0.4 0.8 c 1155 1190 m 62 Y -20 15 d -62 Y f 0 0.6 0.8 c
- 1155 1252 m 62 Y -20 15 d -62 Y f 0 0.8 0.8 c 1155 1314 m 62 Y -20 16 d -63 Y f
- 0 0.8 0.6 c 1155 1376 m 62 Y -20 16 d -62 Y f 0 0.8 0.4 c 1155 1438 m 62 Y -20
- 16 d -62 Y f 0 0.8 0.2 c 1155 1500 m 62 Y -20 16 d -62 Y f 0 0.8 0 c 1155 1562
- m 63 Y -20 15 d -62 Y f 0.2 0.8 0 c 1155 1625 m 58 Y -20 16 d -59 Y f black
- 1135 1081 m 20 -16 d 618 Y -20 16 d cl s 0.2 0.8 0 c 1155 1683 m 24 6 d -21 16
- d -23 -6 d f black 1155 1683 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1132
- 1059 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 1155 1127 m 63 Y -23 -6 d -63 Y f 0
- 0.4 0.8 c 1155 1190 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c 1155 1252 m 62 Y -23 -6
- d -62 Y f 0 0.8 0.8 c 1155 1314 m 62 Y -23 -6 d -62 Y f 0 0.8 0.6 c 1155 1376 m
- 62 Y -23 -6 d -62 Y f 0 0.8 0.4 c 1155 1438 m 62 Y -23 -6 d -62 Y f 0 0.8 0.2 c
- 1155 1500 m 62 Y -23 -6 d -62 Y f 0 0.8 0 c 1155 1562 m 54 Y -23 -6 d -54 Y f
- black 1132 1059 m 23 6 d 551 Y -23 -6 d cl s 0 0 0.8 c 1112 1075 m 20 -16 d 62
- Y -20 16 d f 0 0.2 0.8 c 1132 1121 m 63 Y -20 15 d -62 Y f 0 0.4 0.8 c 1132
- 1184 m 62 Y -20 15 d -62 Y f 0 0.6 0.8 c 1132 1246 m 62 Y -20 15 d -62 Y f 0
- 0.8 0.8 c 1132 1308 m 62 Y -20 16 d -63 Y f 0 0.8 0.6 c 1132 1370 m 62 Y -20 16
- d -62 Y f 0 0.8 0.4 c 1132 1432 m 62 Y -20 16 d -62 Y f 0 0.8 0.2 c 1132 1494 m
- 62 Y -20 16 d -62 Y f 0 0.8 0 c 1132 1556 m 54 Y -20 16 d -54 Y f black 1112
- 1075 m 20 -16 d 551 Y -20 16 d cl s 0 0.8 0 c 1132 1610 m 23 6 d -20 16 d -23
- -6 d f black 1132 1610 m 23 6 d -20 16 d -23 -6 d cl s 0 0 0.8 c 1108 1053 m 24
- 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1132 1121 m 63 Y -24 -6 d -63 Y f 0 0.4 0.8 c
- 1132 1184 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 1132 1246 m 62 Y -24 -6 d -62 Y f
- 0 0.8 0.8 c 1132 1308 m 62 Y -24 -6 d -62 Y f 0 0.8 0.6 c 1132 1370 m 62 Y -24
- -6 d -62 Y f 0 0.8 0.4 c 1132 1432 m 62 Y -24 -6 d -62 Y f 0 0.8 0.2 c 1132
- 1494 m 62 Y -24 -6 d -62 Y f 0 0.8 0 c 1132 1556 m 63 Y -24 -6 d -63 Y f 0.2
- 0.8 0 c 1132 1619 m 62 Y -24 -6 d -62 Y f 0.4 0.8 0 c 1132 1681 m 62 Y -24 -6 d
- -62 Y f 0.6 0.8 0 c 1132 1743 m 42 Y -24 -6 d -42 Y f black 1108 1053 m 24 6 d
- 726 Y -24 -6 d cl s 0 0 0.8 c 1088 1069 m 20 -16 d 62 Y -20 16 d f 0 0.2 0.8 c
- 1108 1115 m 63 Y -20 15 d -62 Y f 0 0.4 0.8 c 1108 1178 m 62 Y -20 15 d -62 Y f
- 0 0.6 0.8 c 1108 1240 m 62 Y -20 15 d -62 Y f 0 0.8 0.8 c 1108 1302 m 62 Y -20
- 16 d -63 Y f 0 0.8 0.6 c 1108 1364 m 62 Y -20 16 d -62 Y f 0 0.8 0.4 c 1108
- 1426 m 62 Y -20 16 d -62 Y f 0 0.8 0.2 c 1108 1488 m 62 Y -20 16 d -62 Y f 0
- 0.8 0 c 1108 1550 m 63 Y -20 15 d -62 Y f 0.2 0.8 0 c 1108 1613 m 62 Y -20 15 d
- -62 Y f 0.4 0.8 0 c 1108 1675 m 62 Y -20 15 d -62 Y f 0.6 0.8 0 c 1108 1737 m
- 42 Y -20 15 d -42 Y f black 1088 1069 m 20 -16 d 726 Y -20 15 d cl s 0.6 0.8 0
- c 1108 1779 m 24 6 d -20 15 d -24 -6 d f black 1108 1779 m 24 6 d -20 15 d -24
- -6 d cl s 0 0 0.8 c 1085 1047 m 23 6 d 62 Y -23 -5 d f 0 0.2 0.8 c 1108 1115 m
- 63 Y -23 -6 d -62 Y f 0 0.4 0.8 c 1108 1178 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c
- 1108 1240 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 1108 1302 m 62 Y -23 -6 d -62 Y f
- 0 0.8 0.6 c 1108 1364 m 62 Y -23 -6 d -62 Y f 0 0.8 0.4 c 1108 1426 m 62 Y -23
- -6 d -62 Y f 0 0.8 0.2 c 1108 1488 m 62 Y -23 -5 d -63 Y f 0 0.8 0 c 1108 1550
- m 63 Y -23 -6 d -62 Y f 0.2 0.8 0 c 1108 1613 m 58 Y -23 -6 d -58 Y f black
- 1085 1047 m 23 6 d 618 Y -23 -6 d cl s 0 0 0.8 c 1065 1063 m 20 -16 d 63 Y -20
- 15 d f 0 0.2 0.8 c 1085 1110 m 62 Y -20 15 d -62 Y f 0 0.4 0.8 c 1085 1172 m 62
- Y -20 15 d -62 Y f 0 0.6 0.8 c 1085 1234 m 62 Y -20 15 d -62 Y f 0 0.8 0.8 c
- 1085 1296 m 62 Y -20 16 d -63 Y f 0 0.8 0.6 c 1085 1358 m 62 Y -20 16 d -62 Y f
- 0 0.8 0.4 c 1085 1420 m 62 Y -20 16 d -62 Y f 0 0.8 0.2 c 1085 1482 m 63 Y -20
- 15 d -62 Y f 0 0.8 0 c 1085 1545 m 62 Y -20 15 d -62 Y f 0.2 0.8 0 c 1085 1607
- m 58 Y -20 16 d -59 Y f black 1065 1063 m 20 -16 d 618 Y -20 16 d cl s 0.2 0.8
- 0 c 1085 1665 m 23 6 d -20 16 d -23 -6 d f black 1085 1665 m 23 6 d -20 16 d
- -23 -6 d cl s 0 0 0.8 c 1061 1041 m 24 6 d 63 Y -24 -6 d f 0 0.2 0.8 c 1085
- 1110 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 1085 1172 m 62 Y -24 -6 d -62 Y f 0
- 0.6 0.8 c 1085 1234 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 1085 1296 m 62 Y -24 -6
- d -62 Y f 0 0.8 0.6 c 1085 1358 m 62 Y -24 -6 d -62 Y f 0 0.8 0.4 c 1085 1420 m
- 62 Y -24 -6 d -62 Y f 0 0.8 0.2 c 1085 1482 m 63 Y -24 -6 d -63 Y f 0 0.8 0 c
- 1085 1545 m 62 Y -24 -6 d -62 Y f 0.2 0.8 0 c 1085 1607 m 62 Y -24 -6 d -62 Y f
- 0.4 0.8 0 c 1085 1669 m 62 Y -24 -6 d -62 Y f 0.6 0.8 0 c 1085 1731 m 15 Y -24
- -6 d -15 Y f black 1061 1041 m 24 6 d 699 Y -24 -6 d cl s 0 0 0.8 c 1041 1057 m
- 20 -16 d 63 Y -20 15 d f 0 0.2 0.8 c 1061 1104 m 62 Y -20 15 d -62 Y f 0 0.4
- 0.8 c 1061 1166 m 62 Y -20 15 d -62 Y f 0 0.6 0.8 c 1061 1228 m 62 Y -20 15 d
- -62 Y f 0 0.8 0.8 c 1061 1290 m 62 Y -20 16 d -63 Y f 0 0.8 0.6 c 1061 1352 m
- 62 Y -20 16 d -62 Y f 0 0.8 0.4 c 1061 1414 m 62 Y -20 16 d -62 Y f 0 0.8 0.2 c
- 1061 1476 m 63 Y -20 15 d -62 Y f 0 0.8 0 c 1061 1539 m 62 Y -20 15 d -62 Y f
- 0.2 0.8 0 c 1061 1601 m 62 Y -20 15 d -62 Y f 0.4 0.8 0 c 1061 1663 m 62 Y -20
- 15 d -62 Y f 0.6 0.8 0 c 1061 1725 m 15 Y -20 16 d -16 Y f black 1041 1057 m 20
- -16 d 699 Y -20 16 d cl s 0.6 0.8 0 c 1061 1740 m 24 6 d -20 16 d -24 -6 d f
- black 1061 1740 m 24 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1038 1035 m 23 6 d 63
- Y -23 -6 d f 0 0.2 0.8 c 1061 1104 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 1061
- 1166 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c 1061 1228 m 62 Y -23 -6 d -62 Y f 0
- 0.8 0.8 c 1061 1290 m 62 Y -23 -6 d -62 Y f 0 0.8 0.6 c 1061 1352 m 62 Y -23 -6
- d -62 Y f 0 0.8 0.4 c 1061 1414 m 62 Y -23 -6 d -62 Y f 0 0.8 0.2 c 1061 1476 m
- 63 Y -23 -6 d -63 Y f 0 0.8 0 c 1061 1539 m 62 Y -23 -6 d -62 Y f 0.2 0.8 0 c
- 1061 1601 m 62 Y -23 -6 d -62 Y f 0.4 0.8 0 c 1061 1663 m 62 Y -23 -6 d -62 Y f
- 0.6 0.8 0 c 1061 1725 m 42 Y -23 -6 d -42 Y f black 1038 1035 m 23 6 d 726 Y
- -23 -6 d cl s 0 0 0.8 c 1018 1051 m 20 -16 d 63 Y -20 15 d f 0 0.2 0.8 c 1038
- 1098 m 62 Y -20 15 d -62 Y f 0 0.4 0.8 c 1038 1160 m 62 Y -20 15 d -62 Y f 0
- 0.6 0.8 c 1038 1222 m 62 Y -20 16 d -63 Y f 0 0.8 0.8 c 1038 1284 m 62 Y -20 16
- d -62 Y f 0 0.8 0.6 c 1038 1346 m 62 Y -20 16 d -62 Y f 0 0.8 0.4 c 1038 1408 m
- 62 Y -20 16 d -62 Y f 0 0.8 0.2 c 1038 1470 m 63 Y -20 15 d -62 Y f 0 0.8 0 c
- 1038 1533 m 62 Y -20 15 d -62 Y f 0.2 0.8 0 c 1038 1595 m 62 Y -20 15 d -62 Y f
- 0.4 0.8 0 c 1038 1657 m 62 Y -20 16 d -63 Y f 0.6 0.8 0 c 1038 1719 m 42 Y -20
- 15 d -41 Y f black 1018 1051 m 20 -16 d 726 Y -20 15 d cl s 0.6 0.8 0 c 1038
- 1761 m 23 6 d -20 15 d -23 -6 d f black 1038 1761 m 23 6 d -20 15 d -23 -6 d
- cl s 0 0 0.8 c 1014 1029 m 24 6 d 63 Y -24 -6 d f 0 0.2 0.8 c 1038 1098 m 62 Y
- -24 -6 d -62 Y f 0 0.4 0.8 c 1038 1160 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 1038
- 1222 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 1038 1284 m 62 Y -24 -6 d -62 Y f 0
- 0.8 0.6 c 1038 1346 m 62 Y -24 -6 d -62 Y f 0 0.8 0.4 c 1038 1408 m 62 Y -24 -6
- d -62 Y f 0 0.8 0.2 c 1038 1470 m 63 Y -24 -6 d -63 Y f 0 0.8 0 c 1038 1533 m
- 62 Y -24 -6 d -62 Y f 0.2 0.8 0 c 1038 1595 m 62 Y -24 -6 d -62 Y f 0.4 0.8 0 c
- 1038 1657 m 62 Y -24 -6 d -62 Y f 0.6 0.8 0 c 1038 1719 m 62 Y -24 -6 d -62 Y f
- 0.8 0.8 0 c 1038 1781 m 7 Y -24 -6 d -7 Y f black 1014 1029 m 24 6 d 753 Y -24
- -6 d cl s 0 0 0.8 c 994 1045 m 20 -16 d 63 Y -20 15 d f 0 0.2 0.8 c 1014 1092 m
- 62 Y -20 15 d -62 Y f 0 0.4 0.8 c 1014 1154 m 62 Y -20 15 d -62 Y f 0 0.6 0.8 c
- 1014 1216 m 62 Y -20 16 d -63 Y f 0 0.8 0.8 c 1014 1278 m 62 Y -20 16 d -62 Y f
- 0 0.8 0.6 c 1014 1340 m 62 Y -20 16 d -62 Y f 0 0.8 0.4 c 1014 1402 m 62 Y -20
- 16 d -62 Y f 0 0.8 0.2 c 1014 1464 m 63 Y -20 15 d -62 Y f 0 0.8 0 c 1014 1527
- m 62 Y -20 15 d -62 Y f 0.2 0.8 0 c 1014 1589 m 62 Y -20 15 d -62 Y f 0.4 0.8 0
- c 1014 1651 m 62 Y -20 16 d -63 Y f 0.6 0.8 0 c 1014 1713 m 62 Y -20 16 d -62 Y
- f 0.8 0.8 0 c 1014 1775 m 7 Y -20 15 d -6 Y f black 994 1045 m 20 -16 d 753 Y
- -20 15 d cl s 0.8 0.8 0 c 1014 1782 m 24 6 d -20 15 d -24 -6 d f black 1014
- 1782 m 24 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 991 1023 m 23 6 d 63 Y -23 -6 d
- f 0 0.2 0.8 c 1014 1092 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 1014 1154 m 62 Y
- -23 -6 d -62 Y f 0 0.6 0.8 c 1014 1216 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 1014
- 1278 m 62 Y -23 -6 d -62 Y f 0 0.8 0.6 c 1014 1340 m 62 Y -23 -6 d -62 Y f 0
- 0.8 0.4 c 1014 1402 m 62 Y -23 -6 d -62 Y f 0 0.8 0.2 c 1014 1464 m 63 Y -23 -6
- d -63 Y f 0 0.8 0 c 1014 1527 m 62 Y -23 -6 d -62 Y f 0.2 0.8 0 c 1014 1589 m
- 62 Y -23 -6 d -62 Y f 0.4 0.8 0 c 1014 1651 m 62 Y -23 -6 d -62 Y f 0.6 0.8 0 c
- 1014 1713 m 62 Y -23 -6 d -62 Y f 0.8 0.8 0 c 1014 1775 m 7 Y -23 -6 d -7 Y f
- black 991 1023 m 23 6 d 753 Y -23 -6 d cl s 0 0 0.8 c 971 1039 m 20 -16 d 63 Y
- -20 15 d f 0 0.2 0.8 c 991 1086 m 62 Y -20 15 d -62 Y f 0 0.4 0.8 c 991 1148 m
- 62 Y -20 15 d -62 Y f 0 0.6 0.8 c 991 1210 m 62 Y -20 16 d -63 Y f 0 0.8 0.8 c
- 991 1272 m 62 Y -20 16 d -62 Y f 0 0.8 0.6 c 991 1334 m 62 Y -20 16 d -62 Y f 0
- 0.8 0.4 c 991 1396 m 62 Y -20 16 d -62 Y f 0 0.8 0.2 c 991 1458 m 63 Y -20 15 d
- -62 Y f 0 0.8 0 c 991 1521 m 62 Y -20 15 d -62 Y f 0.2 0.8 0 c 991 1583 m 62 Y
- -20 15 d -62 Y f 0.4 0.8 0 c 991 1645 m 62 Y -20 16 d -63 Y f 0.6 0.8 0 c 991
- 1707 m 62 Y -20 16 d -62 Y f 0.8 0.8 0 c 991 1769 m 7 Y -20 15 d -6 Y f black
- 971 1039 m 20 -16 d 753 Y -20 15 d cl s 0.8 0.8 0 c 991 1776 m 23 6 d -20 15 d
- -23 -6 d f black 991 1776 m 23 6 d -20 15 d -23 -6 d cl s 0 0 0.8 c 967 1017 m
- 24 6 d 63 Y -24 -6 d f 0 0.2 0.8 c 991 1086 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c
- 991 1148 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 991 1210 m 62 Y -24 -6 d -62 Y f 0
- 0.8 0.8 c 991 1272 m 62 Y -24 -6 d -62 Y f 0 0.8 0.6 c 991 1334 m 62 Y -24 -6 d
- -62 Y f 0 0.8 0.4 c 991 1396 m 62 Y -24 -6 d -62 Y f 0 0.8 0.2 c 991 1458 m 63
- Y -24 -6 d -63 Y f 0 0.8 0 c 991 1521 m 62 Y -24 -6 d -62 Y f 0.2 0.8 0 c 991
- 1583 m 62 Y -24 -6 d -62 Y f 0.4 0.8 0 c 991 1645 m 62 Y -24 -6 d -62 Y f 0.6
- 0.8 0 c 991 1707 m 29 Y -24 -6 d -29 Y f black 967 1017 m 24 6 d 713 Y -24 -6 d
- cl s 0 0 0.8 c 947 1033 m 20 -16 d 63 Y -20 15 d f 0 0.2 0.8 c 967 1080 m 62 Y
- -20 15 d -62 Y f 0 0.4 0.8 c 967 1142 m 62 Y -20 15 d -62 Y f 0 0.6 0.8 c 967
- 1204 m 62 Y -20 16 d -63 Y f 0 0.8 0.8 c 967 1266 m 62 Y -20 16 d -62 Y f 0 0.8
- 0.6 c 967 1328 m 62 Y -20 16 d -62 Y f 0 0.8 0.4 c 967 1390 m 62 Y -20 16 d -62
- Y f 0 0.8 0.2 c 967 1452 m 63 Y -20 15 d -62 Y f 0 0.8 0 c 967 1515 m 62 Y -20
- 15 d -62 Y f 0.2 0.8 0 c 967 1577 m 62 Y -20 15 d -62 Y f 0.4 0.8 0 c 967 1639
- m 62 Y -20 16 d -63 Y f 0.6 0.8 0 c 967 1701 m 29 Y -20 15 d -28 Y f black 947
- 1033 m 20 -16 d 713 Y -20 15 d cl s 0.6 0.8 0 c 967 1730 m 24 6 d -20 15 d -24
- -6 d f black 967 1730 m 24 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 944 1011 m 23 6
- d 63 Y -23 -6 d f 0 0.2 0.8 c 967 1080 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 967
- 1142 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c 967 1204 m 62 Y -23 -6 d -62 Y f 0 0.8
- 0.8 c 967 1266 m 62 Y -23 -6 d -62 Y f 0 0.8 0.6 c 967 1328 m 62 Y -23 -6 d -62
- Y f 0 0.8 0.4 c 967 1390 m 62 Y -23 -6 d -62 Y f 0 0.8 0.2 c 967 1452 m 63 Y
- -23 -6 d -63 Y f 0 0.8 0 c 967 1515 m 62 Y -23 -6 d -62 Y f 0.2 0.8 0 c 967
- 1577 m 62 Y -23 -6 d -62 Y f 0.4 0.8 0 c 967 1639 m 62 Y -23 -6 d -62 Y f 0.6
- 0.8 0 c 967 1701 m 42 Y -23 -6 d -42 Y f black 944 1011 m 23 6 d 726 Y -23 -6 d
- cl s 0 0 0.8 c 924 1027 m 20 -16 d 63 Y -20 15 d f 0 0.2 0.8 c 944 1074 m 62 Y
- -20 15 d -62 Y f 0 0.4 0.8 c 944 1136 m 62 Y -20 15 d -62 Y f 0 0.6 0.8 c 944
- 1198 m 62 Y -20 16 d -63 Y f 0 0.8 0.8 c 944 1260 m 62 Y -20 16 d -62 Y f 0 0.8
- 0.6 c 944 1322 m 62 Y -20 16 d -62 Y f 0 0.8 0.4 c 944 1384 m 62 Y -20 16 d -62
- Y f 0 0.8 0.2 c 944 1446 m 63 Y -20 15 d -62 Y f 0 0.8 0 c 944 1509 m 62 Y -20
- 15 d -62 Y f 0.2 0.8 0 c 944 1571 m 62 Y -20 15 d -62 Y f 0.4 0.8 0 c 944 1633
- m 62 Y -20 16 d -63 Y f 0.6 0.8 0 c 944 1695 m 42 Y -20 16 d -42 Y f black 924
- 1027 m 20 -16 d 726 Y -20 16 d cl s 0.6 0.8 0 c 944 1737 m 23 6 d -20 16 d -23
- -6 d f black 944 1737 m 23 6 d -20 16 d -23 -6 d cl s 0 0 0.8 c 920 1006 m 24 5
- d 63 Y -24 -6 d f 0 0.2 0.8 c 944 1074 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 944
- 1136 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 944 1198 m 62 Y -24 -6 d -62 Y f 0 0.8
- 0.8 c 944 1260 m 62 Y -24 -6 d -62 Y f 0 0.8 0.6 c 944 1322 m 62 Y -24 -6 d -62
- Y f 0 0.8 0.4 c 944 1384 m 62 Y -24 -5 d -63 Y f 0 0.8 0.2 c 944 1446 m 63 Y
- -24 -6 d -62 Y f 0 0.8 0 c 944 1509 m 62 Y -24 -6 d -62 Y f 0.2 0.8 0 c 944
- 1571 m 62 Y -24 -6 d -62 Y f 0.4 0.8 0 c 944 1633 m 62 Y -24 -6 d -62 Y f 0.6
- 0.8 0 c 944 1695 m 15 Y -24 -6 d -15 Y f black 920 1006 m 24 5 d 699 Y -24 -6 d
- cl s 0 0 0.8 c 900 1021 m 20 -15 d 62 Y -20 15 d f 0 0.2 0.8 c 920 1068 m 62 Y
- -20 15 d -62 Y f 0 0.4 0.8 c 920 1130 m 62 Y -20 15 d -62 Y f 0 0.6 0.8 c 920
- 1192 m 62 Y -20 16 d -63 Y f 0 0.8 0.8 c 920 1254 m 62 Y -20 16 d -62 Y f 0 0.8
- 0.6 c 920 1316 m 62 Y -20 16 d -62 Y f 0 0.8 0.4 c 920 1378 m 63 Y -20 15 d -62
- Y f 0 0.8 0.2 c 920 1441 m 62 Y -20 15 d -62 Y f 0 0.8 0 c 920 1503 m 62 Y -20
- 15 d -62 Y f 0.2 0.8 0 c 920 1565 m 62 Y -20 15 d -62 Y f 0.4 0.8 0 c 920 1627
- m 62 Y -20 16 d -63 Y f 0.6 0.8 0 c 920 1689 m 15 Y -20 16 d -15 Y f black 900
- 1021 m 20 -15 d 698 Y -20 16 d cl s 0.6 0.8 0 c 920 1704 m 24 6 d -20 16 d -24
- -6 d f black 920 1704 m 24 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 897 1000 m 23 6
- d 62 Y -23 -6 d f 0 0.2 0.8 c 920 1068 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 920
- 1130 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c 920 1192 m 62 Y -23 -6 d -62 Y f 0 0.8
- 0.8 c 920 1254 m 62 Y -23 -6 d -62 Y f 0 0.8 0.6 c 920 1316 m 62 Y -23 -6 d -62
- Y f 0 0.8 0.4 c 920 1378 m 63 Y -23 -6 d -63 Y f 0 0.8 0.2 c 920 1441 m 62 Y
- -23 -6 d -62 Y f 0 0.8 0 c 920 1503 m 62 Y -23 -6 d -62 Y f 0.2 0.8 0 c 920
- 1565 m 62 Y -23 -6 d -62 Y f 0.4 0.8 0 c 920 1627 m 10 Y -23 -6 d -10 Y f black
- 897 1000 m 23 6 d 631 Y -23 -6 d cl s 0 0 0.8 c 877 1015 m 20 -15 d 62 Y -20 15
- d f 0 0.2 0.8 c 897 1062 m 62 Y -20 15 d -62 Y f 0 0.4 0.8 c 897 1124 m 62 Y
- -20 15 d -62 Y f 0 0.6 0.8 c 897 1186 m 62 Y -20 16 d -63 Y f 0 0.8 0.8 c 897
- 1248 m 62 Y -20 16 d -62 Y f 0 0.8 0.6 c 897 1310 m 62 Y -20 16 d -62 Y f 0 0.8
- 0.4 c 897 1372 m 63 Y -20 15 d -62 Y f 0 0.8 0.2 c 897 1435 m 62 Y -20 15 d -62
- Y f 0 0.8 0 c 897 1497 m 62 Y -20 15 d -62 Y f 0.2 0.8 0 c 897 1559 m 62 Y -20
- 15 d -62 Y f 0.4 0.8 0 c 897 1621 m 10 Y -20 16 d -11 Y f black 877 1015 m 20
- -15 d 631 Y -20 16 d cl s 0.4 0.8 0 c 897 1631 m 23 6 d -20 16 d -23 -6 d f
- black 897 1631 m 23 6 d -20 16 d -23 -6 d cl s 0 0 0.8 c 873 994 m 24 6 d 62 Y
- -24 -6 d f 0 0.2 0.8 c 897 1062 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 897 1124 m
- 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 897 1186 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c
- 897 1248 m 62 Y -24 -6 d -62 Y f 0 0.8 0.6 c 897 1310 m 62 Y -24 -6 d -62 Y f 0
- 0.8 0.4 c 897 1372 m 63 Y -24 -6 d -63 Y f 0 0.8 0.2 c 897 1435 m 62 Y -24 -6 d
- -62 Y f 0 0.8 0 c 897 1497 m 62 Y -24 -6 d -62 Y f 0.2 0.8 0 c 897 1559 m 62 Y
- -24 -6 d -62 Y f 0.4 0.8 0 c 897 1621 m 37 Y -24 -6 d -37 Y f black 873 994 m
- 24 6 d 658 Y -24 -6 d cl s 0 0 0.8 c 853 1009 m 20 -15 d 62 Y -20 15 d f 0 0.2
- 0.8 c 873 1056 m 62 Y -20 15 d -62 Y f 0 0.4 0.8 c 873 1118 m 62 Y -20 16 d -63
- Y f 0 0.6 0.8 c 873 1180 m 62 Y -20 16 d -62 Y f 0 0.8 0.8 c 873 1242 m 62 Y
- -20 16 d -62 Y f 0 0.8 0.6 c 873 1304 m 62 Y -20 16 d -62 Y f 0 0.8 0.4 c 873
- 1366 m 63 Y -20 15 d -62 Y f 0 0.8 0.2 c 873 1429 m 62 Y -20 15 d -62 Y f 0 0.8
- 0 c 873 1491 m 62 Y -20 15 d -62 Y f 0.2 0.8 0 c 873 1553 m 62 Y -20 16 d -63 Y
- f 0.4 0.8 0 c 873 1615 m 37 Y -20 15 d -36 Y f black 853 1009 m 20 -15 d 658 Y
- -20 15 d cl s 0.4 0.8 0 c 873 1652 m 24 6 d -20 15 d -24 -6 d f black 873 1652
- m 24 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 850 988 m 23 6 d 62 Y -23 -6 d f 0
- 0.2 0.8 c 873 1056 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 873 1118 m 62 Y -23 -6 d
- -62 Y f 0 0.6 0.8 c 873 1180 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 873 1242 m 62
- Y -23 -6 d -62 Y f 0 0.8 0.6 c 873 1304 m 62 Y -23 -6 d -62 Y f 0 0.8 0.4 c 873
- 1366 m 63 Y -23 -6 d -63 Y f 0 0.8 0.2 c 873 1429 m 62 Y -23 -6 d -62 Y f 0 0.8
- 0 c 873 1491 m 62 Y -23 -6 d -62 Y f 0.2 0.8 0 c 873 1553 m 62 Y -23 -6 d -62 Y
- f 0.4 0.8 0 c 873 1615 m 10 Y -23 -6 d -10 Y f black 850 988 m 23 6 d 631 Y -23
- -6 d cl s 0 0 0.8 c 830 1003 m 20 -15 d 62 Y -20 15 d f 0 0.2 0.8 c 850 1050 m
- 62 Y -20 15 d -62 Y f 0 0.4 0.8 c 850 1112 m 62 Y -20 16 d -63 Y f 0 0.6 0.8 c
- 850 1174 m 62 Y -20 16 d -62 Y f 0 0.8 0.8 c 850 1236 m 62 Y -20 16 d -62 Y f 0
- 0.8 0.6 c 850 1298 m 62 Y -20 16 d -62 Y f 0 0.8 0.4 c 850 1360 m 63 Y -20 15 d
- -62 Y f 0 0.8 0.2 c 850 1423 m 62 Y -20 15 d -62 Y f 0 0.8 0 c 850 1485 m 62 Y
- -20 15 d -62 Y f 0.2 0.8 0 c 850 1547 m 62 Y -20 16 d -63 Y f 0.4 0.8 0 c 850
- 1609 m 10 Y -20 16 d -10 Y f black 830 1003 m 20 -15 d 631 Y -20 16 d cl s 0.4
- 0.8 0 c 850 1619 m 23 6 d -20 16 d -23 -6 d f black 850 1619 m 23 6 d -20 16 d
- -23 -6 d cl s 0 0 0.8 c 826 982 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 850 1050 m
- 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 850 1112 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c
- 850 1174 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 850 1236 m 62 Y -24 -6 d -62 Y f 0
- 0.8 0.6 c 850 1298 m 62 Y -24 -6 d -62 Y f 0 0.8 0.4 c 850 1360 m 63 Y -24 -6 d
- -63 Y f 0 0.8 0.2 c 850 1423 m 62 Y -24 -6 d -62 Y f 0 0.8 0 c 850 1485 m 13 Y
- -24 -6 d -13 Y f black 826 982 m 24 6 d 510 Y -24 -6 d cl s 0 0 0.8 c 806 997 m
- 20 -15 d 62 Y -20 15 d f 0 0.2 0.8 c 826 1044 m 62 Y -20 15 d -62 Y f 0 0.4 0.8
- c 826 1106 m 62 Y -20 16 d -63 Y f 0 0.6 0.8 c 826 1168 m 62 Y -20 16 d -62 Y f
- 0 0.8 0.8 c 826 1230 m 62 Y -20 16 d -62 Y f 0 0.8 0.6 c 826 1292 m 62 Y -20 16
- d -62 Y f 0 0.8 0.4 c 826 1354 m 63 Y -20 15 d -62 Y f 0 0.8 0.2 c 826 1417 m
- 62 Y -20 15 d -62 Y f 0 0.8 0 c 826 1479 m 13 Y -20 16 d -14 Y f black 806 997
- m 20 -15 d 510 Y -20 16 d cl s 0 0.8 0 c 826 1492 m 24 6 d -20 16 d -24 -6 d f
- black 826 1492 m 24 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 803 976 m 23 6 d 62 Y
- -23 -6 d f 0 0.2 0.8 c 826 1044 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 826 1106 m
- 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c 826 1168 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c
- 826 1230 m 62 Y -23 -6 d -62 Y f 0 0.8 0.6 c 826 1292 m 62 Y -23 -6 d -62 Y f 0
- 0.8 0.4 c 826 1354 m 63 Y -23 -6 d -63 Y f 0 0.8 0.2 c 826 1417 m 62 Y -23 -6 d
- -62 Y f 0 0.8 0 c 826 1479 m 62 Y -23 -6 d -62 Y f 0.2 0.8 0 c 826 1541 m 5 Y
- -23 -6 d -5 Y f black 803 976 m 23 6 d 564 Y -23 -6 d cl s 0 0 0.8 c 783 991 m
- 20 -15 d 62 Y -20 15 d f 0 0.2 0.8 c 803 1038 m 62 Y -20 15 d -62 Y f 0 0.4 0.8
- c 803 1100 m 62 Y -20 16 d -63 Y f 0 0.6 0.8 c 803 1162 m 62 Y -20 16 d -62 Y f
- 0 0.8 0.8 c 803 1224 m 62 Y -20 16 d -62 Y f 0 0.8 0.6 c 803 1286 m 62 Y -20 16
- d -62 Y f 0 0.8 0.4 c 803 1348 m 63 Y -20 15 d -62 Y f 0 0.8 0.2 c 803 1411 m
- 62 Y -20 15 d -62 Y f 0 0.8 0 c 803 1473 m 62 Y -20 15 d -62 Y f 0.2 0.8 0 c
- 803 1535 m 5 Y -20 15 d -5 Y f black 783 991 m 20 -15 d 564 Y -20 15 d cl s 0.2
- 0.8 0 c 803 1540 m 23 6 d -20 15 d -23 -6 d f black 803 1540 m 23 6 d -20 15 d
- -23 -6 d cl s 0 0 0.8 c 780 970 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 803 1038 m
- 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 803 1100 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c
- 803 1162 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 803 1224 m 62 Y -23 -6 d -62 Y f 0
- 0.8 0.6 c 803 1286 m 62 Y -23 -6 d -62 Y f 0 0.8 0.4 c 803 1348 m 63 Y -23 -6 d
- -63 Y f 0 0.8 0.2 c 803 1411 m 62 Y -23 -6 d -62 Y f 0 0.8 0 c 803 1473 m 62 Y
- -23 -6 d -62 Y f 0.2 0.8 0 c 803 1535 m 45 Y -23 -6 d -45 Y f black 780 970 m
- 23 6 d 604 Y -23 -6 d cl s 0 0 0.8 c 759 985 m 21 -15 d 62 Y -21 15 d f 0 0.2
- 0.8 c 780 1032 m 62 Y -21 15 d -62 Y f 0 0.4 0.8 c 780 1094 m 62 Y -21 16 d -63
- Y f 0 0.6 0.8 c 780 1156 m 62 Y -21 16 d -62 Y f 0 0.8 0.8 c 780 1218 m 62 Y
- -21 16 d -62 Y f 0 0.8 0.6 c 780 1280 m 62 Y -21 16 d -62 Y f 0 0.8 0.4 c 780
- 1342 m 63 Y -21 15 d -62 Y f 0 0.8 0.2 c 780 1405 m 62 Y -21 15 d -62 Y f 0 0.8
- 0 c 780 1467 m 62 Y -21 15 d -62 Y f 0.2 0.8 0 c 780 1529 m 45 Y -21 16 d -46 Y
- f black 759 985 m 21 -15 d 604 Y -21 16 d cl s 0.2 0.8 0 c 780 1574 m 23 6 d
- -20 16 d -24 -6 d f black 780 1574 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c
- 756 964 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 780 1032 m 62 Y -24 -6 d -62 Y f 0
- 0.4 0.8 c 780 1094 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 780 1156 m 62 Y -24 -6 d
- -62 Y f 0 0.8 0.8 c 780 1218 m 62 Y -24 -6 d -62 Y f 0 0.8 0.6 c 780 1280 m 62
- Y -24 -5 d -63 Y f 0 0.8 0.4 c 780 1342 m 63 Y -24 -6 d -62 Y f 0 0.8 0.2 c 780
- 1405 m 62 Y -24 -6 d -62 Y f 0 0.8 0 c 780 1467 m 62 Y -24 -6 d -62 Y f 0.2 0.8
- 0 c 780 1529 m 32 Y -24 -6 d -32 Y f black 756 964 m 24 6 d 591 Y -24 -6 d cl s
- 0 0 0.8 c 736 979 m 20 -15 d 62 Y -20 15 d f 0 0.2 0.8 c 756 1026 m 62 Y -20 15
- d -62 Y f 0 0.4 0.8 c 756 1088 m 62 Y -20 16 d -63 Y f 0 0.6 0.8 c 756 1150 m
- 62 Y -20 16 d -62 Y f 0 0.8 0.8 c 756 1212 m 62 Y -20 16 d -62 Y f 0 0.8 0.6 c
- 756 1274 m 63 Y -20 15 d -62 Y f 0 0.8 0.4 c 756 1337 m 62 Y -20 15 d -62 Y f 0
- 0.8 0.2 c 756 1399 m 62 Y -20 15 d -62 Y f 0 0.8 0 c 756 1461 m 62 Y -20 15 d
- -62 Y f 0.2 0.8 0 c 756 1523 m 32 Y -20 15 d -32 Y f black 736 979 m 20 -15 d
- 591 Y -20 15 d cl s 0.2 0.8 0 c 756 1555 m 24 6 d -21 15 d -23 -6 d f black 756
- 1555 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 733 958 m 23 6 d 62 Y -23 -6 d f
- 0 0.2 0.8 c 756 1026 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 756 1088 m 62 Y -23 -6
- d -62 Y f 0 0.6 0.8 c 756 1150 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 756 1212 m
- 62 Y -23 -6 d -62 Y f 0 0.8 0.6 c 756 1274 m 63 Y -23 -6 d -63 Y f 0 0.8 0.4 c
- 756 1337 m 62 Y -23 -6 d -62 Y f 0 0.8 0.2 c 756 1399 m 62 Y -23 -6 d -62 Y f 0
- 0.8 0 c 756 1461 m 62 Y -23 -6 d -62 Y f 0.2 0.8 0 c 756 1523 m 18 Y -23 -6 d
- -18 Y f black 733 958 m 23 6 d 577 Y -23 -6 d cl s 0 0 0.8 c 712 973 m 21 -15 d
- 62 Y -21 15 d f 0 0.2 0.8 c 733 1020 m 62 Y -21 15 d -62 Y f 0 0.4 0.8 c 733
- 1082 m 62 Y -21 16 d -63 Y f 0 0.6 0.8 c 733 1144 m 62 Y -21 16 d -62 Y f 0 0.8
- 0.8 c 733 1206 m 62 Y -21 16 d -62 Y f 0 0.8 0.6 c 733 1268 m 63 Y -21 15 d -62
- Y f 0 0.8 0.4 c 733 1331 m 62 Y -21 15 d -62 Y f 0 0.8 0.2 c 733 1393 m 62 Y
- -21 15 d -62 Y f 0 0.8 0 c 733 1455 m 62 Y -21 15 d -62 Y f 0.2 0.8 0 c 733
- 1517 m 18 Y -21 16 d -19 Y f black 712 973 m 21 -15 d 577 Y -21 16 d cl s 0.2
- 0.8 0 c 733 1535 m 23 6 d -20 16 d -24 -6 d f black 733 1535 m 23 6 d -20 16 d
- -24 -6 d cl s 0 0 0.8 c 709 952 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 733 1020 m
- 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 733 1082 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c
- 733 1144 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 733 1206 m 62 Y -24 -6 d -62 Y f 0
- 0.8 0.6 c 733 1268 m 63 Y -24 -6 d -63 Y f 0 0.8 0.4 c 733 1331 m 62 Y -24 -6 d
- -62 Y f 0 0.8 0.2 c 733 1393 m 62 Y -24 -6 d -62 Y f 0 0.8 0 c 733 1455 m 62 Y
- -24 -6 d -62 Y f 0.2 0.8 0 c 733 1517 m 62 Y -24 -6 d -62 Y f 0.4 0.8 0 c 733
- 1579 m 62 Y -24 -6 d -62 Y f 0.6 0.8 0 c 733 1641 m 56 Y -24 -6 d -56 Y f black
- 709 952 m 24 6 d 739 Y -24 -6 d cl s 0 0 0.8 c 689 967 m 20 -15 d 62 Y -20 15 d
- f 0 0.2 0.8 c 709 1014 m 62 Y -20 16 d -63 Y f 0 0.4 0.8 c 709 1076 m 62 Y -20
- 16 d -62 Y f 0 0.6 0.8 c 709 1138 m 62 Y -20 16 d -62 Y f 0 0.8 0.8 c 709 1200
- m 62 Y -20 16 d -62 Y f 0 0.8 0.6 c 709 1262 m 63 Y -20 15 d -62 Y f 0 0.8 0.4
- c 709 1325 m 62 Y -20 15 d -62 Y f 0 0.8 0.2 c 709 1387 m 62 Y -20 15 d -62 Y f
- 0 0.8 0 c 709 1449 m 62 Y -20 16 d -63 Y f 0.2 0.8 0 c 709 1511 m 62 Y -20 16 d
- -62 Y f 0.4 0.8 0 c 709 1573 m 62 Y -20 16 d -62 Y f 0.6 0.8 0 c 709 1635 m 56
- Y -20 15 d -55 Y f black 689 967 m 20 -15 d 739 Y -20 15 d cl s 0.6 0.8 0 c 709
- 1691 m 24 6 d -21 15 d -23 -6 d f black 709 1691 m 24 6 d -21 15 d -23 -6 d
- cl s 0 0 0.8 c 686 946 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 709 1014 m 62 Y -23
- -6 d -62 Y f 0 0.4 0.8 c 709 1076 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c 709 1138
- m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 709 1200 m 62 Y -23 -6 d -62 Y f 0 0.8 0.6
- c 709 1262 m 63 Y -23 -6 d -63 Y f 0 0.8 0.4 c 709 1325 m 62 Y -23 -6 d -62 Y f
- 0 0.8 0.2 c 709 1387 m 62 Y -23 -6 d -62 Y f 0 0.8 0 c 709 1449 m 62 Y -23 -6 d
- -62 Y f 0.2 0.8 0 c 709 1511 m 62 Y -23 -6 d -62 Y f 0.4 0.8 0 c 709 1573 m 24
- Y -23 -6 d -24 Y f black 686 946 m 23 6 d 645 Y -23 -6 d cl s 0 0 0.8 c 665 961
- m 21 -15 d 62 Y -21 15 d f 0 0.2 0.8 c 686 1008 m 62 Y -21 16 d -63 Y f 0 0.4
- 0.8 c 686 1070 m 62 Y -21 16 d -62 Y f 0 0.6 0.8 c 686 1132 m 62 Y -21 16 d -62
- Y f 0 0.8 0.8 c 686 1194 m 62 Y -21 16 d -62 Y f 0 0.8 0.6 c 686 1256 m 63 Y
- -21 15 d -62 Y f 0 0.8 0.4 c 686 1319 m 62 Y -21 15 d -62 Y f 0 0.8 0.2 c 686
- 1381 m 62 Y -21 15 d -62 Y f 0 0.8 0 c 686 1443 m 62 Y -21 16 d -63 Y f 0.2 0.8
- 0 c 686 1505 m 62 Y -21 16 d -62 Y f 0.4 0.8 0 c 686 1567 m 24 Y -21 15 d -23 Y
- f black 665 961 m 21 -15 d 645 Y -21 15 d cl s 0.4 0.8 0 c 686 1591 m 23 6 d
- -20 15 d -24 -6 d f black 686 1591 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c
- 662 940 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 686 1008 m 62 Y -24 -6 d -62 Y f 0
- 0.4 0.8 c 686 1070 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 686 1132 m 62 Y -24 -6 d
- -62 Y f 0 0.8 0.8 c 686 1194 m 62 Y -24 -6 d -62 Y f 0 0.8 0.6 c 686 1256 m 63
- Y -24 -6 d -63 Y f 0 0.8 0.4 c 686 1319 m 62 Y -24 -6 d -62 Y f 0 0.8 0.2 c 686
- 1381 m 62 Y -24 -6 d -62 Y f 0 0.8 0 c 686 1443 m 62 Y -24 -6 d -62 Y f 0.2 0.8
- 0 c 686 1505 m 62 Y -24 -6 d -62 Y f 0.4 0.8 0 c 686 1567 m 10 Y -24 -6 d -10 Y
- f black 662 940 m 24 6 d 631 Y -24 -6 d cl s 0 0 0.8 c 642 955 m 20 -15 d 62 Y
- -20 15 d f 0 0.2 0.8 c 662 1002 m 62 Y -20 16 d -63 Y f 0 0.4 0.8 c 662 1064 m
- 62 Y -20 16 d -62 Y f 0 0.6 0.8 c 662 1126 m 62 Y -20 16 d -62 Y f 0 0.8 0.8 c
- 662 1188 m 62 Y -20 16 d -62 Y f 0 0.8 0.6 c 662 1250 m 63 Y -20 15 d -62 Y f 0
- 0.8 0.4 c 662 1313 m 62 Y -20 15 d -62 Y f 0 0.8 0.2 c 662 1375 m 62 Y -20 15 d
- -62 Y f 0 0.8 0 c 662 1437 m 62 Y -20 16 d -63 Y f 0.2 0.8 0 c 662 1499 m 62 Y
- -20 16 d -62 Y f 0.4 0.8 0 c 662 1561 m 10 Y -20 16 d -10 Y f black 642 955 m
- 20 -15 d 631 Y -20 16 d cl s 0.4 0.8 0 c 662 1571 m 24 6 d -21 16 d -23 -6 d f
- black 662 1571 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 639 934 m 23 6 d -20
- 15 d -24 -6 d f black 639 934 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 615 928
- m 24 6 d -21 15 d -23 -6 d f black 615 928 m 24 6 d -21 15 d -23 -6 d cl s 0 0
- 0.8 c 592 922 m 23 6 d -20 15 d -24 -6 d f black 592 922 m 23 6 d -20 15 d -24
- -6 d cl s 0 0 0.8 c 568 916 m 24 6 d -21 15 d -23 -6 d f black 568 916 m 24 6 d
- -21 15 d -23 -6 d cl s 0 0 0.8 c 1692 1181 m 24 6 d -20 16 d -24 -6 d f black
- 1692 1181 m 24 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1669 1175 m 23 6 d -20 16 d
- -23 -6 d f black 1669 1175 m 23 6 d -20 16 d -23 -6 d cl s 0 0 0.8 c 1645 1169
- m 24 6 d -20 16 d -24 -6 d f black 1645 1169 m 24 6 d -20 16 d -24 -6 d cl s 0
- 0 0.8 c 1622 1163 m 23 6 d -20 16 d -23 -6 d f black 1622 1163 m 23 6 d -20 16
- d -23 -6 d cl s 0 0 0.8 c 1598 1157 m 24 6 d 63 Y -24 -6 d f 0 0.2 0.8 c 1622
- 1226 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 1622 1288 m 62 Y -24 -6 d -62 Y f 0
- 0.6 0.8 c 1622 1350 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 1622 1412 m 62 Y -24 -6
- d -62 Y f 0 0.8 0.6 c 1622 1474 m 62 Y -24 -6 d -62 Y f 0 0.8 0.4 c 1622 1536 m
- 62 Y -24 -6 d -62 Y f 0 0.8 0.2 c 1622 1598 m 63 Y -24 -6 d -63 Y f 0 0.8 0 c
- 1622 1661 m 62 Y -24 -6 d -62 Y f 0.2 0.8 0 c 1622 1723 m 62 Y -24 -6 d -62 Y f
- 0.4 0.8 0 c 1622 1785 m 62 Y -24 -6 d -62 Y f 0.6 0.8 0 c 1622 1847 m 62 Y -24
- -6 d -62 Y f 0.8 0.8 0 c 1622 1909 m 34 Y -24 -6 d -34 Y f black 1598 1157 m 24
- 6 d 780 Y -24 -6 d cl s 0 0 0.8 c 1578 1173 m 20 -16 d 63 Y -20 15 d f 0 0.2
- 0.8 c 1598 1220 m 62 Y -20 15 d -62 Y f 0 0.4 0.8 c 1598 1282 m 62 Y -20 15 d
- -62 Y f 0 0.6 0.8 c 1598 1344 m 62 Y -20 16 d -63 Y f 0 0.8 0.8 c 1598 1406 m
- 62 Y -20 16 d -62 Y f 0 0.8 0.6 c 1598 1468 m 62 Y -20 16 d -62 Y f 0 0.8 0.4 c
- 1598 1530 m 62 Y -20 16 d -62 Y f 0 0.8 0.2 c 1598 1592 m 63 Y -20 15 d -62 Y f
- 0 0.8 0 c 1598 1655 m 62 Y -20 15 d -62 Y f 0.2 0.8 0 c 1598 1717 m 62 Y -20 15
- d -62 Y f 0.4 0.8 0 c 1598 1779 m 62 Y -20 16 d -63 Y f 0.6 0.8 0 c 1598 1841 m
- 62 Y -20 16 d -62 Y f 0.8 0.8 0 c 1598 1903 m 34 Y -20 15 d -33 Y f black 1578
- 1173 m 20 -16 d 780 Y -20 15 d cl s 0.8 0.8 0 c 1598 1937 m 24 6 d -20 15 d -24
- -6 d f black 1598 1937 m 24 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1575 1151 m 23
- 6 d 63 Y -23 -6 d f 0 0.2 0.8 c 1598 1220 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c
- 1598 1282 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c 1598 1344 m 62 Y -23 -6 d -62 Y f
- 0 0.8 0.8 c 1598 1406 m 62 Y -23 -6 d -62 Y f 0 0.8 0.6 c 1598 1468 m 62 Y -23
- -6 d -62 Y f 0 0.8 0.4 c 1598 1530 m 62 Y -23 -6 d -62 Y f 0 0.8 0.2 c 1598
- 1592 m 63 Y -23 -6 d -63 Y f 0 0.8 0 c 1598 1655 m 62 Y -23 -6 d -62 Y f 0.2
- 0.8 0 c 1598 1717 m 5 Y -23 -6 d -5 Y f black 1575 1151 m 23 6 d 565 Y -23 -6 d
- cl s 0 0 0.8 c 1555 1167 m 20 -16 d 63 Y -20 15 d f 0 0.2 0.8 c 1575 1214 m 62
- Y -20 15 d -62 Y f 0 0.4 0.8 c 1575 1276 m 62 Y -20 15 d -62 Y f 0 0.6 0.8 c
- 1575 1338 m 62 Y -20 16 d -63 Y f 0 0.8 0.8 c 1575 1400 m 62 Y -20 16 d -62 Y f
- 0 0.8 0.6 c 1575 1462 m 62 Y -20 16 d -62 Y f 0 0.8 0.4 c 1575 1524 m 62 Y -20
- 16 d -62 Y f 0 0.8 0.2 c 1575 1586 m 63 Y -20 15 d -62 Y f 0 0.8 0 c 1575 1649
- m 62 Y -20 15 d -62 Y f 0.2 0.8 0 c 1575 1711 m 5 Y -20 15 d -5 Y f black 1555
- 1167 m 20 -16 d 565 Y -20 15 d cl s 0.2 0.8 0 c 1575 1716 m 23 6 d -20 15 d -23
- -6 d f black 1575 1716 m 23 6 d -20 15 d -23 -6 d cl s 0 0 0.8 c 1552 1145 m 23
- 6 d 63 Y -23 -6 d f 0 0.2 0.8 c 1575 1214 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c
- 1575 1276 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c 1575 1338 m 62 Y -23 -6 d -62 Y f
- 0 0.8 0.8 c 1575 1400 m 62 Y -23 -6 d -62 Y f 0 0.8 0.6 c 1575 1462 m 62 Y -23
- -6 d -62 Y f 0 0.8 0.4 c 1575 1524 m 62 Y -23 -6 d -62 Y f 0 0.8 0.2 c 1575
- 1586 m 63 Y -23 -6 d -63 Y f 0 0.8 0 c 1575 1649 m 62 Y -23 -6 d -62 Y f 0.2
- 0.8 0 c 1575 1711 m 62 Y -23 -6 d -62 Y f 0.4 0.8 0 c 1575 1773 m 62 Y -23 -6 d
- -62 Y f 0.6 0.8 0 c 1575 1835 m 62 Y -23 -6 d -62 Y f 0.8 0.8 0 c 1575 1897 m
- 62 Y -23 -6 d -62 Y f 0.8 0.6 0 c 1575 1959 m 39 Y -23 -6 d -39 Y f black 1552
- 1145 m 23 6 d 847 Y -23 -6 d cl s 0 0 0.8 c 1531 1161 m 21 -16 d 63 Y -21 15 d
- f 0 0.2 0.8 c 1552 1208 m 62 Y -21 15 d -62 Y f 0 0.4 0.8 c 1552 1270 m 62 Y
- -21 15 d -62 Y f 0 0.6 0.8 c 1552 1332 m 62 Y -21 16 d -63 Y f 0 0.8 0.8 c 1552
- 1394 m 62 Y -21 16 d -62 Y f 0 0.8 0.6 c 1552 1456 m 62 Y -21 16 d -62 Y f 0
- 0.8 0.4 c 1552 1518 m 62 Y -21 16 d -62 Y f 0 0.8 0.2 c 1552 1580 m 63 Y -21 15
- d -62 Y f 0 0.8 0 c 1552 1643 m 62 Y -21 15 d -62 Y f 0.2 0.8 0 c 1552 1705 m
- 62 Y -21 15 d -62 Y f 0.4 0.8 0 c 1552 1767 m 62 Y -21 16 d -63 Y f 0.6 0.8 0 c
- 1552 1829 m 62 Y -21 16 d -62 Y f 0.8 0.8 0 c 1552 1891 m 62 Y -21 16 d -62 Y f
- 0.8 0.6 0 c 1552 1953 m 39 Y -21 15 d -38 Y f black 1531 1161 m 21 -16 d 847 Y
- -21 15 d cl s 0.8 0.6 0 c 1552 1992 m 23 6 d -20 15 d -24 -6 d f black 1552
- 1992 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1528 1139 m 24 6 d 63 Y -24 -6 d
- f 0 0.2 0.8 c 1552 1208 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 1552 1270 m 62 Y
- -24 -6 d -62 Y f 0 0.6 0.8 c 1552 1332 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 1552
- 1394 m 62 Y -24 -6 d -62 Y f 0 0.8 0.6 c 1552 1456 m 62 Y -24 -6 d -62 Y f 0
- 0.8 0.4 c 1552 1518 m 62 Y -24 -6 d -62 Y f 0 0.8 0.2 c 1552 1580 m 63 Y -24 -6
- d -63 Y f 0 0.8 0 c 1552 1643 m 62 Y -24 -6 d -62 Y f 0.2 0.8 0 c 1552 1705 m
- 62 Y -24 -6 d -62 Y f 0.4 0.8 0 c 1552 1767 m 62 Y -24 -6 d -62 Y f 0.6 0.8 0 c
- 1552 1829 m 62 Y -24 -6 d -62 Y f 0.8 0.8 0 c 1552 1891 m 34 Y -24 -6 d -34 Y f
- black 1528 1139 m 24 6 d 780 Y -24 -6 d cl s 0 0 0.8 c 1508 1155 m 20 -16 d 63
- Y -20 15 d f 0 0.2 0.8 c 1528 1202 m 62 Y -20 15 d -62 Y f 0 0.4 0.8 c 1528
- 1264 m 62 Y -20 15 d -62 Y f 0 0.6 0.8 c 1528 1326 m 62 Y -20 16 d -63 Y f 0
- 0.8 0.8 c 1528 1388 m 62 Y -20 16 d -62 Y f 0 0.8 0.6 c 1528 1450 m 62 Y -20 16
- d -62 Y f 0 0.8 0.4 c 1528 1512 m 62 Y -20 16 d -62 Y f 0 0.8 0.2 c 1528 1574 m
- 63 Y -20 15 d -62 Y f 0 0.8 0 c 1528 1637 m 62 Y -20 15 d -62 Y f 0.2 0.8 0 c
- 1528 1699 m 62 Y -20 15 d -62 Y f 0.4 0.8 0 c 1528 1761 m 62 Y -20 16 d -63 Y f
- 0.6 0.8 0 c 1528 1823 m 62 Y -20 16 d -62 Y f 0.8 0.8 0 c 1528 1885 m 34 Y -20
- 15 d -33 Y f black 1508 1155 m 20 -16 d 780 Y -20 15 d cl s 0.8 0.8 0 c 1528
- 1919 m 24 6 d -21 15 d -23 -6 d f black 1528 1919 m 24 6 d -21 15 d -23 -6 d
- cl s 0 0 0.8 c 1505 1133 m 23 6 d 63 Y -23 -6 d f 0 0.2 0.8 c 1528 1202 m 62 Y
- -23 -6 d -62 Y f 0 0.4 0.8 c 1528 1264 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c 1528
- 1326 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 1528 1388 m 62 Y -23 -6 d -62 Y f 0
- 0.8 0.6 c 1528 1450 m 62 Y -23 -6 d -62 Y f 0 0.8 0.4 c 1528 1512 m 62 Y -23 -6
- d -62 Y f 0 0.8 0.2 c 1528 1574 m 63 Y -23 -6 d -63 Y f 0 0.8 0 c 1528 1637 m
- 62 Y -23 -6 d -62 Y f 0.2 0.8 0 c 1528 1699 m 62 Y -23 -6 d -62 Y f 0.4 0.8 0 c
- 1528 1761 m 62 Y -23 -6 d -62 Y f 0.6 0.8 0 c 1528 1823 m 62 Y -23 -6 d -62 Y f
- 0.8 0.8 0 c 1528 1885 m 7 Y -23 -6 d -7 Y f black 1505 1133 m 23 6 d 753 Y -23
- -6 d cl s 0 0 0.8 c 1484 1149 m 21 -16 d 63 Y -21 15 d f 0 0.2 0.8 c 1505 1196
- m 62 Y -21 15 d -62 Y f 0 0.4 0.8 c 1505 1258 m 62 Y -21 15 d -62 Y f 0 0.6 0.8
- c 1505 1320 m 62 Y -21 16 d -63 Y f 0 0.8 0.8 c 1505 1382 m 62 Y -21 16 d -62 Y
- f 0 0.8 0.6 c 1505 1444 m 62 Y -21 16 d -62 Y f 0 0.8 0.4 c 1505 1506 m 62 Y
- -21 16 d -62 Y f 0 0.8 0.2 c 1505 1568 m 63 Y -21 15 d -62 Y f 0 0.8 0 c 1505
- 1631 m 62 Y -21 15 d -62 Y f 0.2 0.8 0 c 1505 1693 m 62 Y -21 15 d -62 Y f 0.4
- 0.8 0 c 1505 1755 m 62 Y -21 16 d -63 Y f 0.6 0.8 0 c 1505 1817 m 62 Y -21 16 d
- -62 Y f 0.8 0.8 0 c 1505 1879 m 7 Y -21 15 d -6 Y f black 1484 1149 m 21 -16 d
- 753 Y -21 15 d cl s 0.8 0.8 0 c 1505 1886 m 23 6 d -20 15 d -24 -6 d f black
- 1505 1886 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1481 1128 m 24 5 d 63 Y -24
- -6 d f 0 0.2 0.8 c 1505 1196 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 1505 1258 m 62
- Y -24 -6 d -62 Y f 0 0.6 0.8 c 1505 1320 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c
- 1505 1382 m 62 Y -24 -6 d -62 Y f 0 0.8 0.6 c 1505 1444 m 62 Y -24 -6 d -62 Y f
- 0 0.8 0.4 c 1505 1506 m 62 Y -24 -5 d -63 Y f 0 0.8 0.2 c 1505 1568 m 63 Y -24
- -6 d -62 Y f 0 0.8 0 c 1505 1631 m 26 Y -24 -5 d -27 Y f black 1481 1128 m 24 5
- d 524 Y -24 -5 d cl s 0 0 0.8 c 1461 1143 m 20 -15 d 62 Y -20 15 d f 0 0.2 0.8
- c 1481 1190 m 62 Y -20 15 d -62 Y f 0 0.4 0.8 c 1481 1252 m 62 Y -20 15 d -62 Y
- f 0 0.6 0.8 c 1481 1314 m 62 Y -20 16 d -63 Y f 0 0.8 0.8 c 1481 1376 m 62 Y
- -20 16 d -62 Y f 0 0.8 0.6 c 1481 1438 m 62 Y -20 16 d -62 Y f 0 0.8 0.4 c 1481
- 1500 m 63 Y -20 15 d -62 Y f 0 0.8 0.2 c 1481 1563 m 62 Y -20 15 d -62 Y f 0
- 0.8 0 c 1481 1625 m 27 Y -20 15 d -27 Y f black 1461 1143 m 20 -15 d 524 Y -20
- 15 d cl s 0 0.8 0 c 1481 1652 m 24 5 d -21 16 d -23 -6 d f black 1481 1652 m 24
- 5 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1458 1122 m 23 6 d 62 Y -23 -6 d f 0 0.2
- 0.8 c 1481 1190 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 1481 1252 m 62 Y -23 -6 d
- -62 Y f 0 0.6 0.8 c 1481 1314 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 1481 1376 m
- 62 Y -23 -6 d -62 Y f 0 0.8 0.6 c 1481 1438 m 62 Y -23 -6 d -62 Y f 0 0.8 0.4 c
- 1481 1500 m 63 Y -23 -6 d -63 Y f 0 0.8 0.2 c 1481 1563 m 62 Y -23 -6 d -62 Y f
- 0 0.8 0 c 1481 1625 m 62 Y -23 -6 d -62 Y f 0.2 0.8 0 c 1481 1687 m 62 Y -23 -6
- d -62 Y f 0.4 0.8 0 c 1481 1749 m 62 Y -23 -6 d -62 Y f 0.6 0.8 0 c 1481 1811 m
- 42 Y -23 -6 d -42 Y f black 1458 1122 m 23 6 d 725 Y -23 -6 d cl s 0 0 0.8 c
- 1437 1137 m 21 -15 d 62 Y -21 15 d f 0 0.2 0.8 c 1458 1184 m 62 Y -21 15 d -62
- Y f 0 0.4 0.8 c 1458 1246 m 62 Y -21 15 d -62 Y f 0 0.6 0.8 c 1458 1308 m 62 Y
- -21 16 d -63 Y f 0 0.8 0.8 c 1458 1370 m 62 Y -21 16 d -62 Y f 0 0.8 0.6 c 1458
- 1432 m 62 Y -21 16 d -62 Y f 0 0.8 0.4 c 1458 1494 m 63 Y -21 15 d -62 Y f 0
- 0.8 0.2 c 1458 1557 m 62 Y -21 15 d -62 Y f 0 0.8 0 c 1458 1619 m 62 Y -21 15 d
- -62 Y f 0.2 0.8 0 c 1458 1681 m 62 Y -21 15 d -62 Y f 0.4 0.8 0 c 1458 1743 m
- 62 Y -21 16 d -63 Y f 0.6 0.8 0 c 1458 1805 m 42 Y -21 16 d -42 Y f black 1437
- 1137 m 21 -15 d 725 Y -21 16 d cl s 0.6 0.8 0 c 1458 1847 m 23 6 d -20 16 d -24
- -6 d f black 1458 1847 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1434 1116 m 24
- 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1458 1184 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c
- 1458 1246 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 1458 1308 m 62 Y -24 -6 d -62 Y f
- 0 0.8 0.8 c 1458 1370 m 62 Y -24 -6 d -62 Y f 0 0.8 0.6 c 1458 1432 m 62 Y -24
- -6 d -62 Y f 0 0.8 0.4 c 1458 1494 m 63 Y -24 -6 d -63 Y f 0 0.8 0.2 c 1458
- 1557 m 62 Y -24 -6 d -62 Y f 0 0.8 0 c 1458 1619 m 62 Y -24 -6 d -62 Y f 0.2
- 0.8 0 c 1458 1681 m 62 Y -24 -6 d -62 Y f 0.4 0.8 0 c 1458 1743 m 62 Y -24 -6 d
- -62 Y f 0.6 0.8 0 c 1458 1805 m 62 Y -24 -6 d -62 Y f 0.8 0.8 0 c 1458 1867 m
- 34 Y -24 -6 d -34 Y f black 1434 1116 m 24 6 d 779 Y -24 -6 d cl s 0 0 0.8 c
- 1414 1131 m 20 -15 d 62 Y -20 15 d f 0 0.2 0.8 c 1434 1178 m 62 Y -20 15 d -62
- Y f 0 0.4 0.8 c 1434 1240 m 62 Y -20 16 d -63 Y f 0 0.6 0.8 c 1434 1302 m 62 Y
- -20 16 d -62 Y f 0 0.8 0.8 c 1434 1364 m 62 Y -20 16 d -62 Y f 0 0.8 0.6 c 1434
- 1426 m 62 Y -20 16 d -62 Y f 0 0.8 0.4 c 1434 1488 m 63 Y -20 15 d -62 Y f 0
- 0.8 0.2 c 1434 1551 m 62 Y -20 15 d -62 Y f 0 0.8 0 c 1434 1613 m 62 Y -20 15 d
- -62 Y f 0.2 0.8 0 c 1434 1675 m 62 Y -20 16 d -63 Y f 0.4 0.8 0 c 1434 1737 m
- 62 Y -20 16 d -62 Y f 0.6 0.8 0 c 1434 1799 m 62 Y -20 16 d -62 Y f 0.8 0.8 0 c
- 1434 1861 m 34 Y -20 15 d -33 Y f black 1414 1131 m 20 -15 d 779 Y -20 15 d
- cl s 0.8 0.8 0 c 1434 1895 m 24 6 d -21 15 d -23 -6 d f black 1434 1895 m 24 6
- d -21 15 d -23 -6 d cl s 0 0 0.8 c 1411 1110 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8
- c 1434 1178 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 1434 1240 m 62 Y -23 -6 d -62 Y
- f 0 0.6 0.8 c 1434 1302 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 1434 1364 m 62 Y
- -23 -6 d -62 Y f 0 0.8 0.6 c 1434 1426 m 62 Y -23 -6 d -62 Y f 0 0.8 0.4 c 1434
- 1488 m 63 Y -23 -6 d -63 Y f 0 0.8 0.2 c 1434 1551 m 62 Y -23 -6 d -62 Y f 0
- 0.8 0 c 1434 1613 m 62 Y -23 -6 d -62 Y f 0.2 0.8 0 c 1434 1675 m 62 Y -23 -6 d
- -62 Y f 0.4 0.8 0 c 1434 1737 m 62 Y -23 -6 d -62 Y f 0.6 0.8 0 c 1434 1799 m
- 56 Y -23 -6 d -56 Y f black 1411 1110 m 23 6 d 739 Y -23 -6 d cl s 0 0 0.8 c
- 1390 1125 m 21 -15 d 62 Y -21 15 d f 0 0.2 0.8 c 1411 1172 m 62 Y -21 15 d -62
- Y f 0 0.4 0.8 c 1411 1234 m 62 Y -21 16 d -63 Y f 0 0.6 0.8 c 1411 1296 m 62 Y
- -21 16 d -62 Y f 0 0.8 0.8 c 1411 1358 m 62 Y -21 16 d -62 Y f 0 0.8 0.6 c 1411
- 1420 m 62 Y -21 16 d -62 Y f 0 0.8 0.4 c 1411 1482 m 63 Y -21 15 d -62 Y f 0
- 0.8 0.2 c 1411 1545 m 62 Y -21 15 d -62 Y f 0 0.8 0 c 1411 1607 m 62 Y -21 15 d
- -62 Y f 0.2 0.8 0 c 1411 1669 m 62 Y -21 16 d -63 Y f 0.4 0.8 0 c 1411 1731 m
- 62 Y -21 16 d -62 Y f 0.6 0.8 0 c 1411 1793 m 56 Y -21 15 d -55 Y f black 1390
- 1125 m 21 -15 d 739 Y -21 15 d cl s 0.6 0.8 0 c 1411 1849 m 23 6 d -20 15 d -24
- -6 d f black 1411 1849 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1387 1104 m 24
- 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1411 1172 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c
- 1411 1234 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 1411 1296 m 62 Y -24 -6 d -62 Y f
- 0 0.8 0.8 c 1411 1358 m 62 Y -24 -6 d -62 Y f 0 0.8 0.6 c 1411 1420 m 62 Y -24
- -6 d -62 Y f 0 0.8 0.4 c 1411 1482 m 63 Y -24 -6 d -63 Y f 0 0.8 0.2 c 1411
- 1545 m 62 Y -24 -6 d -62 Y f 0 0.8 0 c 1411 1607 m 62 Y -24 -6 d -62 Y f 0.2
- 0.8 0 c 1411 1669 m 62 Y -24 -6 d -62 Y f 0.4 0.8 0 c 1411 1731 m 62 Y -24 -6 d
- -62 Y f 0.6 0.8 0 c 1411 1793 m 62 Y -24 -6 d -62 Y f 0.8 0.8 0 c 1411 1855 m
- 61 Y -24 -6 d -61 Y f black 1387 1104 m 24 6 d 806 Y -24 -6 d cl s 0 0 0.8 c
- 1367 1119 m 20 -15 d 62 Y -20 15 d f 0 0.2 0.8 c 1387 1166 m 62 Y -20 15 d -62
- Y f 0 0.4 0.8 c 1387 1228 m 62 Y -20 16 d -63 Y f 0 0.6 0.8 c 1387 1290 m 62 Y
- -20 16 d -62 Y f 0 0.8 0.8 c 1387 1352 m 62 Y -20 16 d -62 Y f 0 0.8 0.6 c 1387
- 1414 m 62 Y -20 16 d -62 Y f 0 0.8 0.4 c 1387 1476 m 63 Y -20 15 d -62 Y f 0
- 0.8 0.2 c 1387 1539 m 62 Y -20 15 d -62 Y f 0 0.8 0 c 1387 1601 m 62 Y -20 15 d
- -62 Y f 0.2 0.8 0 c 1387 1663 m 62 Y -20 16 d -63 Y f 0.4 0.8 0 c 1387 1725 m
- 62 Y -20 16 d -62 Y f 0.6 0.8 0 c 1387 1787 m 62 Y -20 16 d -62 Y f 0.8 0.8 0 c
- 1387 1849 m 61 Y -20 15 d -60 Y f black 1367 1119 m 20 -15 d 806 Y -20 15 d
- cl s 0.8 0.8 0 c 1387 1910 m 24 6 d -21 15 d -23 -6 d f black 1387 1910 m 24 6
- d -21 15 d -23 -6 d cl s 0 0 0.8 c 1364 1098 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8
- c 1387 1166 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 1387 1228 m 62 Y -23 -6 d -62 Y
- f 0 0.6 0.8 c 1387 1290 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 1387 1352 m 62 Y
- -23 -6 d -62 Y f 0 0.8 0.6 c 1387 1414 m 62 Y -23 -6 d -62 Y f 0 0.8 0.4 c 1387
- 1476 m 63 Y -23 -6 d -63 Y f 0 0.8 0.2 c 1387 1539 m 62 Y -23 -6 d -62 Y f 0
- 0.8 0 c 1387 1601 m 62 Y -23 -6 d -62 Y f 0.2 0.8 0 c 1387 1663 m 62 Y -23 -6 d
- -62 Y f 0.4 0.8 0 c 1387 1725 m 62 Y -23 -6 d -62 Y f 0.6 0.8 0 c 1387 1787 m 2
- Y -23 -6 d -2 Y f black 1364 1098 m 23 6 d 685 Y -23 -6 d cl s 0 0 0.8 c 1343
- 1113 m 21 -15 d 62 Y -21 15 d f 0 0.2 0.8 c 1364 1160 m 62 Y -21 15 d -62 Y f 0
- 0.4 0.8 c 1364 1222 m 62 Y -21 16 d -63 Y f 0 0.6 0.8 c 1364 1284 m 62 Y -21 16
- d -62 Y f 0 0.8 0.8 c 1364 1346 m 62 Y -21 16 d -62 Y f 0 0.8 0.6 c 1364 1408 m
- 62 Y -21 16 d -62 Y f 0 0.8 0.4 c 1364 1470 m 63 Y -21 15 d -62 Y f 0 0.8 0.2 c
- 1364 1533 m 62 Y -21 15 d -62 Y f 0 0.8 0 c 1364 1595 m 62 Y -21 15 d -62 Y f
- 0.2 0.8 0 c 1364 1657 m 62 Y -21 16 d -63 Y f 0.4 0.8 0 c 1364 1719 m 62 Y -21
- 16 d -62 Y f 0.6 0.8 0 c 1364 1781 m 2 Y -21 15 d -1 Y f black 1343 1113 m 21
- -15 d 685 Y -21 15 d cl s 0.6 0.8 0 c 1364 1783 m 23 6 d -20 15 d -24 -6 d f
- black 1364 1783 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1340 1092 m 24 6 d 62
- Y -24 -6 d f 0 0.2 0.8 c 1364 1160 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 1364
- 1222 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 1364 1284 m 62 Y -24 -6 d -62 Y f 0
- 0.8 0.8 c 1364 1346 m 62 Y -24 -6 d -62 Y f 0 0.8 0.6 c 1364 1408 m 62 Y -24 -6
- d -62 Y f 0 0.8 0.4 c 1364 1470 m 63 Y -24 -6 d -63 Y f 0 0.8 0.2 c 1364 1533 m
- 62 Y -24 -6 d -62 Y f 0 0.8 0 c 1364 1595 m 62 Y -24 -6 d -62 Y f 0.2 0.8 0 c
- 1364 1657 m 62 Y -24 -6 d -62 Y f 0.4 0.8 0 c 1364 1719 m 10 Y -24 -6 d -10 Y f
- black 1340 1092 m 24 6 d 631 Y -24 -6 d cl s 0 0 0.8 c 1320 1107 m 20 -15 d 62
- Y -20 15 d f 0 0.2 0.8 c 1340 1154 m 62 Y -20 15 d -62 Y f 0 0.4 0.8 c 1340
- 1216 m 62 Y -20 16 d -63 Y f 0 0.6 0.8 c 1340 1278 m 62 Y -20 16 d -62 Y f 0
- 0.8 0.8 c 1340 1340 m 62 Y -20 16 d -62 Y f 0 0.8 0.6 c 1340 1402 m 62 Y -20 16
- d -62 Y f 0 0.8 0.4 c 1340 1464 m 63 Y -20 15 d -62 Y f 0 0.8 0.2 c 1340 1527 m
- 62 Y -20 15 d -62 Y f 0 0.8 0 c 1340 1589 m 62 Y -20 15 d -62 Y f 0.2 0.8 0 c
- 1340 1651 m 62 Y -20 16 d -63 Y f 0.4 0.8 0 c 1340 1713 m 10 Y -20 16 d -10 Y f
- black 1320 1107 m 20 -15 d 631 Y -20 16 d cl s 0.4 0.8 0 c 1340 1723 m 24 6 d
- -21 16 d -23 -6 d f black 1340 1723 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c
- 1317 1086 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 1340 1154 m 62 Y -23 -6 d -62 Y
- f 0 0.4 0.8 c 1340 1216 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c 1340 1278 m 62 Y
- -23 -6 d -62 Y f 0 0.8 0.8 c 1340 1340 m 62 Y -23 -6 d -62 Y f 0 0.8 0.6 c 1340
- 1402 m 62 Y -23 -5 d -63 Y f 0 0.8 0.4 c 1340 1464 m 63 Y -23 -6 d -62 Y f 0
- 0.8 0.2 c 1340 1527 m 62 Y -23 -6 d -62 Y f 0 0.8 0 c 1340 1589 m 62 Y -23 -6 d
- -62 Y f 0.2 0.8 0 c 1340 1651 m 45 Y -23 -6 d -45 Y f black 1317 1086 m 23 6 d
- 604 Y -23 -6 d cl s 0 0 0.8 c 1296 1101 m 21 -15 d 62 Y -21 15 d f 0 0.2 0.8 c
- 1317 1148 m 62 Y -21 15 d -62 Y f 0 0.4 0.8 c 1317 1210 m 62 Y -21 16 d -63 Y f
- 0 0.6 0.8 c 1317 1272 m 62 Y -21 16 d -62 Y f 0 0.8 0.8 c 1317 1334 m 62 Y -21
- 16 d -62 Y f 0 0.8 0.6 c 1317 1396 m 63 Y -21 15 d -62 Y f 0 0.8 0.4 c 1317
- 1459 m 62 Y -21 15 d -62 Y f 0 0.8 0.2 c 1317 1521 m 62 Y -21 15 d -62 Y f 0
- 0.8 0 c 1317 1583 m 62 Y -21 15 d -62 Y f 0.2 0.8 0 c 1317 1645 m 45 Y -21 16 d
- -46 Y f black 1296 1101 m 21 -15 d 604 Y -21 16 d cl s 0.2 0.8 0 c 1317 1690 m
- 23 6 d -20 16 d -24 -6 d f black 1317 1690 m 23 6 d -20 16 d -24 -6 d cl s 0 0
- 0.8 c 1293 1080 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1317 1148 m 62 Y -24 -6 d
- -62 Y f 0 0.4 0.8 c 1317 1210 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 1317 1272 m
- 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 1317 1334 m 62 Y -24 -6 d -62 Y f 0 0.8 0.6 c
- 1317 1396 m 63 Y -24 -6 d -63 Y f 0 0.8 0.4 c 1317 1459 m 62 Y -24 -6 d -62 Y f
- 0 0.8 0.2 c 1317 1521 m 62 Y -24 -6 d -62 Y f 0 0.8 0 c 1317 1583 m 62 Y -24 -6
- d -62 Y f 0.2 0.8 0 c 1317 1645 m 62 Y -24 -6 d -62 Y f 0.4 0.8 0 c 1317 1707 m
- 50 Y -24 -6 d -50 Y f black 1293 1080 m 24 6 d 671 Y -24 -6 d cl s 0 0 0.8 c
- 1273 1095 m 20 -15 d 62 Y -20 15 d f 0 0.2 0.8 c 1293 1142 m 62 Y -20 15 d -62
- Y f 0 0.4 0.8 c 1293 1204 m 62 Y -20 16 d -63 Y f 0 0.6 0.8 c 1293 1266 m 62 Y
- -20 16 d -62 Y f 0 0.8 0.8 c 1293 1328 m 62 Y -20 16 d -62 Y f 0 0.8 0.6 c 1293
- 1390 m 63 Y -20 15 d -62 Y f 0 0.8 0.4 c 1293 1453 m 62 Y -20 15 d -62 Y f 0
- 0.8 0.2 c 1293 1515 m 62 Y -20 15 d -62 Y f 0 0.8 0 c 1293 1577 m 62 Y -20 15 d
- -62 Y f 0.2 0.8 0 c 1293 1639 m 62 Y -20 16 d -63 Y f 0.4 0.8 0 c 1293 1701 m
- 50 Y -20 16 d -50 Y f black 1273 1095 m 20 -15 d 671 Y -20 16 d cl s 0.4 0.8 0
- c 1293 1751 m 24 6 d -21 16 d -23 -6 d f black 1293 1751 m 24 6 d -21 16 d -23
- -6 d cl s 0 0 0.8 c 1270 1074 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 1293 1142 m
- 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 1293 1204 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c
- 1293 1266 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 1293 1328 m 62 Y -23 -6 d -62 Y f
- 0 0.8 0.6 c 1293 1390 m 63 Y -23 -6 d -63 Y f 0 0.8 0.4 c 1293 1453 m 62 Y -23
- -6 d -62 Y f 0 0.8 0.2 c 1293 1515 m 62 Y -23 -6 d -62 Y f 0 0.8 0 c 1293 1577
- m 62 Y -23 -6 d -62 Y f 0.2 0.8 0 c 1293 1639 m 62 Y -23 -6 d -62 Y f 0.4 0.8 0
- c 1293 1701 m 62 Y -23 -6 d -62 Y f 0.6 0.8 0 c 1293 1763 m 62 Y -23 -6 d -62 Y
- f 0.8 0.8 0 c 1293 1825 m 7 Y -23 -6 d -7 Y f black 1270 1074 m 23 6 d 752 Y
- -23 -6 d cl s 0 0 0.8 c 1249 1089 m 21 -15 d 62 Y -21 15 d f 0 0.2 0.8 c 1270
- 1136 m 62 Y -21 16 d -63 Y f 0 0.4 0.8 c 1270 1198 m 62 Y -21 16 d -62 Y f 0
- 0.6 0.8 c 1270 1260 m 62 Y -21 16 d -62 Y f 0 0.8 0.8 c 1270 1322 m 62 Y -21 16
- d -62 Y f 0 0.8 0.6 c 1270 1384 m 63 Y -21 15 d -62 Y f 0 0.8 0.4 c 1270 1447 m
- 62 Y -21 15 d -62 Y f 0 0.8 0.2 c 1270 1509 m 62 Y -21 15 d -62 Y f 0 0.8 0 c
- 1270 1571 m 62 Y -21 16 d -63 Y f 0.2 0.8 0 c 1270 1633 m 62 Y -21 16 d -62 Y f
- 0.4 0.8 0 c 1270 1695 m 62 Y -21 16 d -62 Y f 0.6 0.8 0 c 1270 1757 m 62 Y -21
- 16 d -62 Y f 0.8 0.8 0 c 1270 1819 m 7 Y -21 16 d -7 Y f black 1249 1089 m 21
- -15 d 752 Y -21 16 d cl s 0.8 0.8 0 c 1270 1826 m 23 6 d -20 16 d -24 -6 d f
- black 1270 1826 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1246 1068 m 24 6 d 62
- Y -24 -6 d f 0 0.2 0.8 c 1270 1136 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 1270
- 1198 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 1270 1260 m 62 Y -24 -6 d -62 Y f 0
- 0.8 0.8 c 1270 1322 m 62 Y -24 -6 d -62 Y f 0 0.8 0.6 c 1270 1384 m 63 Y -24 -6
- d -63 Y f 0 0.8 0.4 c 1270 1447 m 62 Y -24 -6 d -62 Y f 0 0.8 0.2 c 1270 1509 m
- 62 Y -24 -6 d -62 Y f 0 0.8 0 c 1270 1571 m 62 Y -24 -6 d -62 Y f 0.2 0.8 0 c
- 1270 1633 m 62 Y -24 -6 d -62 Y f 0.4 0.8 0 c 1270 1695 m 62 Y -24 -6 d -62 Y f
- 0.6 0.8 0 c 1270 1757 m 42 Y -24 -6 d -42 Y f black 1246 1068 m 24 6 d 725 Y
- -24 -6 d cl s 0 0 0.8 c 1226 1083 m 20 -15 d 62 Y -20 15 d f 0 0.2 0.8 c 1246
- 1130 m 62 Y -20 16 d -63 Y f 0 0.4 0.8 c 1246 1192 m 62 Y -20 16 d -62 Y f 0
- 0.6 0.8 c 1246 1254 m 62 Y -20 16 d -62 Y f 0 0.8 0.8 c 1246 1316 m 62 Y -20 16
- d -62 Y f 0 0.8 0.6 c 1246 1378 m 63 Y -20 15 d -62 Y f 0 0.8 0.4 c 1246 1441 m
- 62 Y -20 15 d -62 Y f 0 0.8 0.2 c 1246 1503 m 62 Y -20 15 d -62 Y f 0 0.8 0 c
- 1246 1565 m 62 Y -20 16 d -63 Y f 0.2 0.8 0 c 1246 1627 m 62 Y -20 16 d -62 Y f
- 0.4 0.8 0 c 1246 1689 m 62 Y -20 16 d -62 Y f 0.6 0.8 0 c 1246 1751 m 42 Y -20
- 16 d -42 Y f black 1226 1083 m 20 -15 d 725 Y -20 16 d cl s 0.6 0.8 0 c 1246
- 1793 m 24 6 d -21 16 d -23 -6 d f black 1246 1793 m 24 6 d -21 16 d -23 -6 d
- cl s 0 0 0.8 c 1223 1062 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 1246 1130 m 62 Y
- -23 -6 d -62 Y f 0 0.4 0.8 c 1246 1192 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c 1246
- 1254 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 1246 1316 m 62 Y -23 -6 d -62 Y f 0
- 0.8 0.6 c 1246 1378 m 63 Y -23 -6 d -63 Y f 0 0.8 0.4 c 1246 1441 m 62 Y -23 -6
- d -62 Y f 0 0.8 0.2 c 1246 1503 m 62 Y -23 -6 d -62 Y f 0 0.8 0 c 1246 1565 m
- 62 Y -23 -6 d -62 Y f 0.2 0.8 0 c 1246 1627 m 62 Y -23 -6 d -62 Y f 0.4 0.8 0 c
- 1246 1689 m 62 Y -23 -6 d -62 Y f 0.6 0.8 0 c 1246 1751 m 62 Y -23 -6 d -62 Y f
- 0.8 0.8 0 c 1246 1813 m 7 Y -23 -6 d -7 Y f black 1223 1062 m 23 6 d 752 Y -23
- -6 d cl s 0 0 0.8 c 1202 1077 m 21 -15 d 62 Y -21 15 d f 0 0.2 0.8 c 1223 1124
- m 62 Y -21 16 d -63 Y f 0 0.4 0.8 c 1223 1186 m 62 Y -21 16 d -62 Y f 0 0.6 0.8
- c 1223 1248 m 62 Y -21 16 d -62 Y f 0 0.8 0.8 c 1223 1310 m 62 Y -21 16 d -62 Y
- f 0 0.8 0.6 c 1223 1372 m 63 Y -21 15 d -62 Y f 0 0.8 0.4 c 1223 1435 m 62 Y
- -21 15 d -62 Y f 0 0.8 0.2 c 1223 1497 m 62 Y -21 15 d -62 Y f 0 0.8 0 c 1223
- 1559 m 62 Y -21 16 d -63 Y f 0.2 0.8 0 c 1223 1621 m 62 Y -21 16 d -62 Y f 0.4
- 0.8 0 c 1223 1683 m 62 Y -21 16 d -62 Y f 0.6 0.8 0 c 1223 1745 m 62 Y -21 16 d
- -62 Y f 0.8 0.8 0 c 1223 1807 m 7 Y -21 16 d -7 Y f black 1202 1077 m 21 -15 d
- 752 Y -21 16 d cl s 0.8 0.8 0 c 1223 1814 m 23 6 d -20 16 d -24 -6 d f black
- 1223 1814 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1199 1056 m 24 6 d 62 Y -24
- -6 d f 0 0.2 0.8 c 1223 1124 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 1223 1186 m 62
- Y -24 -6 d -62 Y f 0 0.6 0.8 c 1223 1248 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c
- 1223 1310 m 62 Y -24 -6 d -62 Y f 0 0.8 0.6 c 1223 1372 m 63 Y -24 -6 d -63 Y f
- 0 0.8 0.4 c 1223 1435 m 62 Y -24 -6 d -62 Y f 0 0.8 0.2 c 1223 1497 m 62 Y -24
- -6 d -62 Y f 0 0.8 0 c 1223 1559 m 62 Y -24 -6 d -62 Y f 0.2 0.8 0 c 1223 1621
- m 62 Y -24 -6 d -62 Y f 0.4 0.8 0 c 1223 1683 m 62 Y -24 -6 d -62 Y f 0.6 0.8 0
- c 1223 1745 m 42 Y -24 -6 d -42 Y f black 1199 1056 m 24 6 d 725 Y -24 -6 d
- cl s 0 0 0.8 c 1179 1071 m 20 -15 d 62 Y -20 15 d f 0 0.2 0.8 c 1199 1118 m 62
- Y -20 16 d -63 Y f 0 0.4 0.8 c 1199 1180 m 62 Y -20 16 d -62 Y f 0 0.6 0.8 c
- 1199 1242 m 62 Y -20 16 d -62 Y f 0 0.8 0.8 c 1199 1304 m 62 Y -20 16 d -62 Y f
- 0 0.8 0.6 c 1199 1366 m 63 Y -20 15 d -62 Y f 0 0.8 0.4 c 1199 1429 m 62 Y -20
- 15 d -62 Y f 0 0.8 0.2 c 1199 1491 m 62 Y -20 15 d -62 Y f 0 0.8 0 c 1199 1553
- m 62 Y -20 16 d -63 Y f 0.2 0.8 0 c 1199 1615 m 62 Y -20 16 d -62 Y f 0.4 0.8 0
- c 1199 1677 m 62 Y -20 16 d -62 Y f 0.6 0.8 0 c 1199 1739 m 42 Y -20 16 d -42 Y
- f black 1179 1071 m 20 -15 d 725 Y -20 16 d cl s 0.6 0.8 0 c 1199 1781 m 24 6 d
- -21 16 d -23 -6 d f black 1199 1781 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c
- 1176 1050 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 1199 1118 m 62 Y -23 -6 d -62 Y
- f 0 0.4 0.8 c 1199 1180 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c 1199 1242 m 62 Y
- -23 -6 d -62 Y f 0 0.8 0.8 c 1199 1304 m 62 Y -23 -6 d -62 Y f 0 0.8 0.6 c 1199
- 1366 m 63 Y -23 -6 d -63 Y f 0 0.8 0.4 c 1199 1429 m 62 Y -23 -6 d -62 Y f 0
- 0.8 0.2 c 1199 1491 m 62 Y -23 -6 d -62 Y f 0 0.8 0 c 1199 1553 m 62 Y -23 -6 d
- -62 Y f 0.2 0.8 0 c 1199 1615 m 62 Y -23 -6 d -62 Y f 0.4 0.8 0 c 1199 1677 m
- 10 Y -23 -6 d -10 Y f black 1176 1050 m 23 6 d 631 Y -23 -6 d cl s 0 0 0.8 c
- 1155 1065 m 21 -15 d 62 Y -21 15 d f 0 0.2 0.8 c 1176 1112 m 62 Y -21 16 d -63
- Y f 0 0.4 0.8 c 1176 1174 m 62 Y -21 16 d -62 Y f 0 0.6 0.8 c 1176 1236 m 62 Y
- -21 16 d -62 Y f 0 0.8 0.8 c 1176 1298 m 62 Y -21 16 d -62 Y f 0 0.8 0.6 c 1176
- 1360 m 63 Y -21 15 d -62 Y f 0 0.8 0.4 c 1176 1423 m 62 Y -21 15 d -62 Y f 0
- 0.8 0.2 c 1176 1485 m 62 Y -21 15 d -62 Y f 0 0.8 0 c 1176 1547 m 62 Y -21 16 d
- -63 Y f 0.2 0.8 0 c 1176 1609 m 62 Y -21 16 d -62 Y f 0.4 0.8 0 c 1176 1671 m
- 10 Y -21 16 d -10 Y f black 1155 1065 m 21 -15 d 631 Y -21 16 d cl s 0.4 0.8 0
- c 1176 1681 m 23 6 d -20 16 d -24 -6 d f black 1176 1681 m 23 6 d -20 16 d -24
- -6 d cl s 0 0 0.8 c 1152 1044 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1176 1112 m
- 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 1176 1174 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c
- 1176 1236 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 1176 1298 m 62 Y -24 -5 d -63 Y f
- 0 0.8 0.6 c 1176 1360 m 63 Y -24 -6 d -62 Y f 0 0.8 0.4 c 1176 1423 m 62 Y -24
- -6 d -62 Y f 0 0.8 0.2 c 1176 1485 m 62 Y -24 -6 d -62 Y f 0 0.8 0 c 1176 1547
- m 62 Y -24 -6 d -62 Y f 0.2 0.8 0 c 1176 1609 m 45 Y -24 -6 d -45 Y f black
- 1152 1044 m 24 6 d 604 Y -24 -6 d cl s 0 0 0.8 c 1132 1059 m 20 -15 d 62 Y -20
- 15 d f 0 0.2 0.8 c 1152 1106 m 62 Y -20 16 d -63 Y f 0 0.4 0.8 c 1152 1168 m 62
- Y -20 16 d -62 Y f 0 0.6 0.8 c 1152 1230 m 62 Y -20 16 d -62 Y f 0 0.8 0.8 c
- 1152 1292 m 63 Y -20 15 d -62 Y f 0 0.8 0.6 c 1152 1355 m 62 Y -20 15 d -62 Y f
- 0 0.8 0.4 c 1152 1417 m 62 Y -20 15 d -62 Y f 0 0.8 0.2 c 1152 1479 m 62 Y -20
- 15 d -62 Y f 0 0.8 0 c 1152 1541 m 62 Y -20 16 d -63 Y f 0.2 0.8 0 c 1152 1603
- m 45 Y -20 16 d -45 Y f black 1132 1059 m 20 -15 d 604 Y -20 16 d cl s 0.2 0.8
- 0 c 1152 1648 m 24 6 d -21 16 d -23 -6 d f black 1152 1648 m 24 6 d -21 16 d
- -23 -6 d cl s 0 0 0.8 c 1129 1038 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 1152
- 1106 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 1152 1168 m 62 Y -23 -6 d -62 Y f 0
- 0.6 0.8 c 1152 1230 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 1152 1292 m 63 Y -23 -6
- d -63 Y f 0 0.8 0.6 c 1152 1355 m 62 Y -23 -6 d -62 Y f 0 0.8 0.4 c 1152 1417 m
- 62 Y -23 -6 d -62 Y f 0 0.8 0.2 c 1152 1479 m 62 Y -23 -6 d -62 Y f 0 0.8 0 c
- 1152 1541 m 62 Y -23 -6 d -62 Y f 0.2 0.8 0 c 1152 1603 m 62 Y -23 -6 d -62 Y f
- 0.4 0.8 0 c 1152 1665 m 24 Y -23 -6 d -24 Y f black 1129 1038 m 23 6 d 645 Y
- -23 -6 d cl s 0 0 0.8 c 1108 1053 m 21 -15 d 62 Y -21 15 d f 0 0.2 0.8 c 1129
- 1100 m 62 Y -21 16 d -63 Y f 0 0.4 0.8 c 1129 1162 m 62 Y -21 16 d -62 Y f 0
- 0.6 0.8 c 1129 1224 m 62 Y -21 16 d -62 Y f 0 0.8 0.8 c 1129 1286 m 63 Y -21 15
- d -62 Y f 0 0.8 0.6 c 1129 1349 m 62 Y -21 15 d -62 Y f 0 0.8 0.4 c 1129 1411 m
- 62 Y -21 15 d -62 Y f 0 0.8 0.2 c 1129 1473 m 62 Y -21 15 d -62 Y f 0 0.8 0 c
- 1129 1535 m 62 Y -21 16 d -63 Y f 0.2 0.8 0 c 1129 1597 m 62 Y -21 16 d -62 Y f
- 0.4 0.8 0 c 1129 1659 m 24 Y -21 15 d -23 Y f black 1108 1053 m 21 -15 d 645 Y
- -21 15 d cl s 0.4 0.8 0 c 1129 1683 m 23 6 d -20 15 d -24 -6 d f black 1129
- 1683 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1105 1032 m 24 6 d 62 Y -24 -6 d
- f 0 0.2 0.8 c 1129 1100 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 1129 1162 m 62 Y
- -24 -6 d -62 Y f 0 0.6 0.8 c 1129 1224 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 1129
- 1286 m 63 Y -24 -6 d -63 Y f 0 0.8 0.6 c 1129 1349 m 62 Y -24 -6 d -62 Y f 0
- 0.8 0.4 c 1129 1411 m 62 Y -24 -6 d -62 Y f 0 0.8 0.2 c 1129 1473 m 62 Y -24 -6
- d -62 Y f 0 0.8 0 c 1129 1535 m 62 Y -24 -6 d -62 Y f 0.2 0.8 0 c 1129 1597 m
- 19 Y -24 -6 d -19 Y f black 1105 1032 m 24 6 d 578 Y -24 -6 d cl s 0 0 0.8 c
- 1085 1047 m 20 -15 d 62 Y -20 16 d f 0 0.2 0.8 c 1105 1094 m 62 Y -20 16 d -62
- Y f 0 0.4 0.8 c 1105 1156 m 62 Y -20 16 d -62 Y f 0 0.6 0.8 c 1105 1218 m 62 Y
- -20 16 d -62 Y f 0 0.8 0.8 c 1105 1280 m 63 Y -20 15 d -62 Y f 0 0.8 0.6 c 1105
- 1343 m 62 Y -20 15 d -62 Y f 0 0.8 0.4 c 1105 1405 m 62 Y -20 15 d -62 Y f 0
- 0.8 0.2 c 1105 1467 m 62 Y -20 16 d -63 Y f 0 0.8 0 c 1105 1529 m 62 Y -20 16 d
- -62 Y f 0.2 0.8 0 c 1105 1591 m 19 Y -20 15 d -18 Y f black 1085 1047 m 20 -15
- d 578 Y -20 15 d cl s 0.2 0.8 0 c 1105 1610 m 24 6 d -21 15 d -23 -6 d f black
- 1105 1610 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 1082 1026 m 23 6 d 62 Y -23
- -6 d f 0 0.2 0.8 c 1105 1094 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 1105 1156 m 62
- Y -23 -6 d -62 Y f 0 0.6 0.8 c 1105 1218 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c
- 1105 1280 m 63 Y -23 -6 d -63 Y f 0 0.8 0.6 c 1105 1343 m 62 Y -23 -6 d -62 Y f
- 0 0.8 0.4 c 1105 1405 m 62 Y -23 -6 d -62 Y f 0 0.8 0.2 c 1105 1467 m 62 Y -23
- -6 d -62 Y f 0 0.8 0 c 1105 1529 m 62 Y -23 -6 d -62 Y f 0.2 0.8 0 c 1105 1591
- m 62 Y -23 -6 d -62 Y f 0.4 0.8 0 c 1105 1653 m 62 Y -23 -6 d -62 Y f 0.6 0.8 0
- c 1105 1715 m 63 Y -23 -6 d -63 Y f 0.8 0.8 0 c 1105 1778 m 62 Y -23 -6 d -62 Y
- f 0.8 0.6 0 c 1105 1840 m 62 Y -23 -6 d -62 Y f 0.8 0.4 0 c 1105 1902 m 3 Y -23
- -6 d -3 Y f black 1082 1026 m 23 6 d 873 Y -23 -6 d cl s 0 0 0.8 c 1061 1041 m
- 21 -15 d 62 Y -21 16 d f 0 0.2 0.8 c 1082 1088 m 62 Y -21 16 d -62 Y f 0 0.4
- 0.8 c 1082 1150 m 62 Y -21 16 d -62 Y f 0 0.6 0.8 c 1082 1212 m 62 Y -21 16 d
- -62 Y f 0 0.8 0.8 c 1082 1274 m 63 Y -21 15 d -62 Y f 0 0.8 0.6 c 1082 1337 m
- 62 Y -21 15 d -62 Y f 0 0.8 0.4 c 1082 1399 m 62 Y -21 15 d -62 Y f 0 0.8 0.2 c
- 1082 1461 m 62 Y -21 16 d -63 Y f 0 0.8 0 c 1082 1523 m 62 Y -21 16 d -62 Y f
- 0.2 0.8 0 c 1082 1585 m 62 Y -21 16 d -62 Y f 0.4 0.8 0 c 1082 1647 m 62 Y -21
- 16 d -62 Y f 0.6 0.8 0 c 1082 1709 m 63 Y -21 15 d -62 Y f 0.8 0.8 0 c 1082
- 1772 m 62 Y -21 15 d -62 Y f 0.8 0.6 0 c 1082 1834 m 62 Y -21 15 d -62 Y f 0.8
- 0.4 0 c 1082 1896 m 3 Y -21 16 d -4 Y f black 1061 1041 m 21 -15 d 873 Y -21 16
- d cl s 0.8 0.4 0 c 1082 1899 m 23 6 d -20 16 d -24 -6 d f black 1082 1899 m 23
- 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1058 1020 m 24 6 d 62 Y -24 -6 d f 0 0.2
- 0.8 c 1082 1088 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 1082 1150 m 62 Y -24 -6 d
- -62 Y f 0 0.6 0.8 c 1082 1212 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 1082 1274 m
- 63 Y -24 -6 d -63 Y f 0 0.8 0.6 c 1082 1337 m 62 Y -24 -6 d -62 Y f 0 0.8 0.4 c
- 1082 1399 m 62 Y -24 -6 d -62 Y f 0 0.8 0.2 c 1082 1461 m 62 Y -24 -6 d -62 Y f
- 0 0.8 0 c 1082 1523 m 27 Y -24 -6 d -27 Y f black 1058 1020 m 24 6 d 524 Y -24
- -6 d cl s 0 0 0.8 c 1038 1035 m 20 -15 d 62 Y -20 16 d f 0 0.2 0.8 c 1058 1082
- m 62 Y -20 16 d -62 Y f 0 0.4 0.8 c 1058 1144 m 62 Y -20 16 d -62 Y f 0 0.6 0.8
- c 1058 1206 m 62 Y -20 16 d -62 Y f 0 0.8 0.8 c 1058 1268 m 63 Y -20 15 d -62 Y
- f 0 0.8 0.6 c 1058 1331 m 62 Y -20 15 d -62 Y f 0 0.8 0.4 c 1058 1393 m 62 Y
- -20 15 d -62 Y f 0 0.8 0.2 c 1058 1455 m 62 Y -20 16 d -63 Y f 0 0.8 0 c 1058
- 1517 m 27 Y -20 15 d -26 Y f black 1038 1035 m 20 -15 d 524 Y -20 15 d cl s 0
- 0.8 0 c 1058 1544 m 24 6 d -21 15 d -23 -6 d f black 1058 1544 m 24 6 d -21 15
- d -23 -6 d cl s 0 0 0.8 c 1035 1014 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 1058
- 1082 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 1058 1144 m 62 Y -23 -6 d -62 Y f 0
- 0.6 0.8 c 1058 1206 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 1058 1268 m 63 Y -23 -6
- d -63 Y f 0 0.8 0.6 c 1058 1331 m 62 Y -23 -6 d -62 Y f 0 0.8 0.4 c 1058 1393 m
- 62 Y -23 -6 d -62 Y f 0 0.8 0.2 c 1058 1455 m 62 Y -23 -6 d -62 Y f 0 0.8 0 c
- 1058 1517 m 62 Y -23 -6 d -62 Y f 0.2 0.8 0 c 1058 1579 m 62 Y -23 -6 d -62 Y f
- 0.4 0.8 0 c 1058 1641 m 24 Y -23 -6 d -24 Y f black 1035 1014 m 23 6 d 645 Y
- -23 -6 d cl s 0 0 0.8 c 1014 1029 m 21 -15 d 62 Y -21 16 d f 0 0.2 0.8 c 1035
- 1076 m 62 Y -21 16 d -62 Y f 0 0.4 0.8 c 1035 1138 m 62 Y -21 16 d -62 Y f 0
- 0.6 0.8 c 1035 1200 m 62 Y -21 16 d -62 Y f 0 0.8 0.8 c 1035 1262 m 63 Y -21 15
- d -62 Y f 0 0.8 0.6 c 1035 1325 m 62 Y -21 15 d -62 Y f 0 0.8 0.4 c 1035 1387 m
- 62 Y -21 15 d -62 Y f 0 0.8 0.2 c 1035 1449 m 62 Y -21 16 d -63 Y f 0 0.8 0 c
- 1035 1511 m 62 Y -21 16 d -62 Y f 0.2 0.8 0 c 1035 1573 m 62 Y -21 16 d -62 Y f
- 0.4 0.8 0 c 1035 1635 m 24 Y -21 15 d -23 Y f black 1014 1029 m 21 -15 d 645 Y
- -21 15 d cl s 0.4 0.8 0 c 1035 1659 m 23 6 d -20 15 d -24 -6 d f black 1035
- 1659 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1011 1008 m 24 6 d 62 Y -24 -6 d
- f 0 0.2 0.8 c 1035 1076 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 1035 1138 m 62 Y
- -24 -6 d -62 Y f 0 0.6 0.8 c 1035 1200 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 1035
- 1262 m 63 Y -24 -6 d -63 Y f 0 0.8 0.6 c 1035 1325 m 62 Y -24 -6 d -62 Y f 0
- 0.8 0.4 c 1035 1387 m 62 Y -24 -6 d -62 Y f 0 0.8 0.2 c 1035 1449 m 62 Y -24 -6
- d -62 Y f 0 0.8 0 c 1035 1511 m 62 Y -24 -6 d -62 Y f 0.2 0.8 0 c 1035 1573 m
- 62 Y -24 -6 d -62 Y f 0.4 0.8 0 c 1035 1635 m 51 Y -24 -6 d -51 Y f black 1011
- 1008 m 24 6 d 672 Y -24 -6 d cl s 0 0 0.8 c 991 1023 m 20 -15 d 62 Y -20 16 d f
- 0 0.2 0.8 c 1011 1070 m 62 Y -20 16 d -62 Y f 0 0.4 0.8 c 1011 1132 m 62 Y -20
- 16 d -62 Y f 0 0.6 0.8 c 1011 1194 m 62 Y -20 16 d -62 Y f 0 0.8 0.8 c 1011
- 1256 m 63 Y -20 15 d -62 Y f 0 0.8 0.6 c 1011 1319 m 62 Y -20 15 d -62 Y f 0
- 0.8 0.4 c 1011 1381 m 62 Y -20 15 d -62 Y f 0 0.8 0.2 c 1011 1443 m 62 Y -20 16
- d -63 Y f 0 0.8 0 c 1011 1505 m 62 Y -20 16 d -62 Y f 0.2 0.8 0 c 1011 1567 m
- 62 Y -20 16 d -62 Y f 0.4 0.8 0 c 1011 1629 m 51 Y -20 15 d -50 Y f black 991
- 1023 m 20 -15 d 672 Y -20 15 d cl s 0.4 0.8 0 c 1011 1680 m 24 6 d -21 15 d -23
- -6 d f black 1011 1680 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 988 1002 m 23
- 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 1011 1070 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c
- 1011 1132 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c 1011 1194 m 62 Y -23 -5 d -63 Y f
- 0 0.8 0.8 c 1011 1256 m 63 Y -23 -6 d -62 Y f 0 0.8 0.6 c 1011 1319 m 62 Y -23
- -6 d -62 Y f 0 0.8 0.4 c 1011 1381 m 62 Y -23 -6 d -62 Y f 0 0.8 0.2 c 1011
- 1443 m 62 Y -23 -6 d -62 Y f 0 0.8 0 c 1011 1505 m 13 Y -23 -5 d -14 Y f black
- 988 1002 m 23 6 d 510 Y -23 -5 d cl s 0 0 0.8 c 967 1017 m 21 -15 d 62 Y -21 16
- d f 0 0.2 0.8 c 988 1064 m 62 Y -21 16 d -62 Y f 0 0.4 0.8 c 988 1126 m 62 Y
- -21 16 d -62 Y f 0 0.6 0.8 c 988 1188 m 63 Y -21 15 d -62 Y f 0 0.8 0.8 c 988
- 1251 m 62 Y -21 15 d -62 Y f 0 0.8 0.6 c 988 1313 m 62 Y -21 15 d -62 Y f 0 0.8
- 0.4 c 988 1375 m 62 Y -21 15 d -62 Y f 0 0.8 0.2 c 988 1437 m 62 Y -21 16 d -63
- Y f 0 0.8 0 c 988 1499 m 14 Y -21 15 d -13 Y f black 967 1017 m 21 -15 d 511 Y
- -21 15 d cl s 0 0.8 0 c 988 1513 m 23 5 d -20 16 d -24 -6 d f black 988 1513 m
- 23 5 d -20 16 d -24 -6 d cl s 0 0 0.8 c 964 996 m 24 6 d 62 Y -24 -6 d f 0 0.2
- 0.8 c 988 1064 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 988 1126 m 62 Y -24 -6 d -62
- Y f 0 0.6 0.8 c 988 1188 m 63 Y -24 -6 d -63 Y f 0 0.8 0.8 c 988 1251 m 62 Y
- -24 -6 d -62 Y f 0 0.8 0.6 c 988 1313 m 62 Y -24 -6 d -62 Y f 0 0.8 0.4 c 988
- 1375 m 62 Y -24 -6 d -62 Y f 0 0.8 0.2 c 988 1437 m 62 Y -24 -6 d -62 Y f 0 0.8
- 0 c 988 1499 m 54 Y -24 -6 d -54 Y f black 964 996 m 24 6 d 551 Y -24 -6 d cl s
- 0 0 0.8 c 944 1011 m 20 -15 d 62 Y -20 16 d f 0 0.2 0.8 c 964 1058 m 62 Y -20
- 16 d -62 Y f 0 0.4 0.8 c 964 1120 m 62 Y -20 16 d -62 Y f 0 0.6 0.8 c 964 1182
- m 63 Y -20 15 d -62 Y f 0 0.8 0.8 c 964 1245 m 62 Y -20 15 d -62 Y f 0 0.8 0.6
- c 964 1307 m 62 Y -20 15 d -62 Y f 0 0.8 0.4 c 964 1369 m 62 Y -20 15 d -62 Y f
- 0 0.8 0.2 c 964 1431 m 62 Y -20 16 d -63 Y f 0 0.8 0 c 964 1493 m 54 Y -20 15 d
- -53 Y f black 944 1011 m 20 -15 d 551 Y -20 15 d cl s 0 0.8 0 c 964 1547 m 24 6
- d -21 15 d -23 -6 d f black 964 1547 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c
- 941 990 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 964 1058 m 62 Y -23 -6 d -62 Y f 0
- 0.4 0.8 c 964 1120 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c 964 1182 m 63 Y -23 -6 d
- -63 Y f 0 0.8 0.8 c 964 1245 m 62 Y -23 -6 d -62 Y f 0 0.8 0.6 c 964 1307 m 62
- Y -23 -6 d -62 Y f 0 0.8 0.4 c 964 1369 m 62 Y -23 -6 d -62 Y f 0 0.8 0.2 c 964
- 1431 m 62 Y -23 -6 d -62 Y f 0 0.8 0 c 964 1493 m 62 Y -23 -6 d -62 Y f 0.2 0.8
- 0 c 964 1555 m 62 Y -23 -6 d -62 Y f 0.4 0.8 0 c 964 1617 m 10 Y -23 -6 d -10 Y
- f black 941 990 m 23 6 d 631 Y -23 -6 d cl s 0 0 0.8 c 920 1006 m 21 -16 d 62 Y
- -21 16 d f 0 0.2 0.8 c 941 1052 m 62 Y -21 16 d -62 Y f 0 0.4 0.8 c 941 1114 m
- 62 Y -21 16 d -62 Y f 0 0.6 0.8 c 941 1176 m 63 Y -21 15 d -62 Y f 0 0.8 0.8 c
- 941 1239 m 62 Y -21 15 d -62 Y f 0 0.8 0.6 c 941 1301 m 62 Y -21 15 d -62 Y f 0
- 0.8 0.4 c 941 1363 m 62 Y -21 16 d -63 Y f 0 0.8 0.2 c 941 1425 m 62 Y -21 16 d
- -62 Y f 0 0.8 0 c 941 1487 m 62 Y -21 16 d -62 Y f 0.2 0.8 0 c 941 1549 m 62 Y
- -21 16 d -62 Y f 0.4 0.8 0 c 941 1611 m 10 Y -21 16 d -10 Y f black 920 1006 m
- 21 -16 d 631 Y -21 16 d cl s 0.4 0.8 0 c 941 1621 m 23 6 d -20 16 d -24 -6 d f
- black 941 1621 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 917 984 m 24 6 d 62 Y
- -24 -6 d f 0 0.2 0.8 c 941 1052 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 941 1114 m
- 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 941 1176 m 63 Y -24 -6 d -63 Y f 0 0.8 0.8 c
- 941 1239 m 62 Y -24 -6 d -62 Y f 0 0.8 0.6 c 941 1301 m 62 Y -24 -6 d -62 Y f 0
- 0.8 0.4 c 941 1363 m 62 Y -24 -6 d -62 Y f 0 0.8 0.2 c 941 1425 m 62 Y -24 -6 d
- -62 Y f 0 0.8 0 c 941 1487 m 62 Y -24 -6 d -62 Y f 0.2 0.8 0 c 941 1549 m 62 Y
- -24 -6 d -62 Y f 0.4 0.8 0 c 941 1611 m 24 Y -24 -6 d -24 Y f black 917 984 m
- 24 6 d 645 Y -24 -6 d cl s 0 0 0.8 c 897 1000 m 20 -16 d 62 Y -20 16 d f 0 0.2
- 0.8 c 917 1046 m 62 Y -20 16 d -62 Y f 0 0.4 0.8 c 917 1108 m 62 Y -20 16 d -62
- Y f 0 0.6 0.8 c 917 1170 m 63 Y -20 15 d -62 Y f 0 0.8 0.8 c 917 1233 m 62 Y
- -20 15 d -62 Y f 0 0.8 0.6 c 917 1295 m 62 Y -20 15 d -62 Y f 0 0.8 0.4 c 917
- 1357 m 62 Y -20 16 d -63 Y f 0 0.8 0.2 c 917 1419 m 62 Y -20 16 d -62 Y f 0 0.8
- 0 c 917 1481 m 62 Y -20 16 d -62 Y f 0.2 0.8 0 c 917 1543 m 62 Y -20 16 d -62 Y
- f 0.4 0.8 0 c 917 1605 m 24 Y -20 15 d -23 Y f black 897 1000 m 20 -16 d 645 Y
- -20 15 d cl s 0.4 0.8 0 c 917 1629 m 24 6 d -21 15 d -23 -6 d f black 917 1629
- m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 894 978 m 23 6 d 62 Y -23 -6 d f 0
- 0.2 0.8 c 917 1046 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 917 1108 m 62 Y -23 -6 d
- -62 Y f 0 0.6 0.8 c 917 1170 m 63 Y -23 -6 d -63 Y f 0 0.8 0.8 c 917 1233 m 62
- Y -23 -6 d -62 Y f 0 0.8 0.6 c 917 1295 m 62 Y -23 -6 d -62 Y f 0 0.8 0.4 c 917
- 1357 m 62 Y -23 -6 d -62 Y f 0 0.8 0.2 c 917 1419 m 62 Y -23 -6 d -62 Y f 0 0.8
- 0 c 917 1481 m 62 Y -23 -6 d -62 Y f 0.2 0.8 0 c 917 1543 m 32 Y -23 -6 d -32 Y
- f black 894 978 m 23 6 d 591 Y -23 -6 d cl s 0 0 0.8 c 873 994 m 21 -16 d 62 Y
- -21 16 d f 0 0.2 0.8 c 894 1040 m 62 Y -21 16 d -62 Y f 0 0.4 0.8 c 894 1102 m
- 62 Y -21 16 d -62 Y f 0 0.6 0.8 c 894 1164 m 63 Y -21 15 d -62 Y f 0 0.8 0.8 c
- 894 1227 m 62 Y -21 15 d -62 Y f 0 0.8 0.6 c 894 1289 m 62 Y -21 15 d -62 Y f 0
- 0.8 0.4 c 894 1351 m 62 Y -21 16 d -63 Y f 0 0.8 0.2 c 894 1413 m 62 Y -21 16 d
- -62 Y f 0 0.8 0 c 894 1475 m 62 Y -21 16 d -62 Y f 0.2 0.8 0 c 894 1537 m 32 Y
- -21 16 d -32 Y f black 873 994 m 21 -16 d 591 Y -21 16 d cl s 0.2 0.8 0 c 894
- 1569 m 23 6 d -20 16 d -24 -6 d f black 894 1569 m 23 6 d -20 16 d -24 -6 d
- cl s 0 0 0.8 c 870 972 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 894 1040 m 62 Y -24
- -6 d -62 Y f 0 0.4 0.8 c 894 1102 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 894 1164
- m 63 Y -24 -6 d -63 Y f 0 0.8 0.8 c 894 1227 m 62 Y -24 -6 d -62 Y f 0 0.8 0.6
- c 894 1289 m 62 Y -24 -6 d -62 Y f 0 0.8 0.4 c 894 1351 m 62 Y -24 -6 d -62 Y f
- 0 0.8 0.2 c 894 1413 m 62 Y -24 -6 d -62 Y f 0 0.8 0 c 894 1475 m 62 Y -24 -6 d
- -62 Y f 0.2 0.8 0 c 894 1537 m 32 Y -24 -6 d -32 Y f black 870 972 m 24 6 d 591
- Y -24 -6 d cl s 0 0 0.8 c 850 988 m 20 -16 d 62 Y -20 16 d f 0 0.2 0.8 c 870
- 1034 m 62 Y -20 16 d -62 Y f 0 0.4 0.8 c 870 1096 m 62 Y -20 16 d -62 Y f 0 0.6
- 0.8 c 870 1158 m 63 Y -20 15 d -62 Y f 0 0.8 0.8 c 870 1221 m 62 Y -20 15 d -62
- Y f 0 0.8 0.6 c 870 1283 m 62 Y -20 15 d -62 Y f 0 0.8 0.4 c 870 1345 m 62 Y
- -20 16 d -63 Y f 0 0.8 0.2 c 870 1407 m 62 Y -20 16 d -62 Y f 0 0.8 0 c 870
- 1469 m 62 Y -20 16 d -62 Y f 0.2 0.8 0 c 870 1531 m 32 Y -20 16 d -32 Y f black
- 850 988 m 20 -16 d 591 Y -20 16 d cl s 0.2 0.8 0 c 870 1563 m 24 6 d -21 16 d
- -23 -6 d f black 870 1563 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 847 966 m
- 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 870 1034 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c
- 870 1096 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c 870 1158 m 63 Y -23 -6 d -63 Y f 0
- 0.8 0.8 c 870 1221 m 62 Y -23 -6 d -62 Y f 0 0.8 0.6 c 870 1283 m 62 Y -23 -6 d
- -62 Y f 0 0.8 0.4 c 870 1345 m 62 Y -23 -6 d -62 Y f 0 0.8 0.2 c 870 1407 m 62
- Y -23 -6 d -62 Y f 0 0.8 0 c 870 1469 m 62 Y -23 -6 d -62 Y f 0.2 0.8 0 c 870
- 1531 m 62 Y -23 -6 d -62 Y f 0.4 0.8 0 c 870 1593 m 63 Y -23 -6 d -63 Y f 0.6
- 0.8 0 c 870 1656 m 1 Y -23 -6 d -1 Y f black 847 966 m 23 6 d 685 Y -23 -6 d
- cl s 0 0 0.8 c 826 982 m 21 -16 d 62 Y -21 16 d f 0 0.2 0.8 c 847 1028 m 62 Y
- -21 16 d -62 Y f 0 0.4 0.8 c 847 1090 m 62 Y -21 16 d -62 Y f 0 0.6 0.8 c 847
- 1152 m 63 Y -21 15 d -62 Y f 0 0.8 0.8 c 847 1215 m 62 Y -21 15 d -62 Y f 0 0.8
- 0.6 c 847 1277 m 62 Y -21 15 d -62 Y f 0 0.8 0.4 c 847 1339 m 62 Y -21 16 d -63
- Y f 0 0.8 0.2 c 847 1401 m 62 Y -21 16 d -62 Y f 0 0.8 0 c 847 1463 m 62 Y -21
- 16 d -62 Y f 0.2 0.8 0 c 847 1525 m 62 Y -21 16 d -62 Y f 0.4 0.8 0 c 847 1587
- m 63 Y -21 15 d -62 Y f 0.6 0.8 0 c 847 1650 m 1 Y -21 16 d -2 Y f black 826
- 982 m 21 -16 d 685 Y -21 16 d cl s 0.6 0.8 0 c 847 1651 m 23 6 d -20 16 d -24
- -6 d f black 847 1651 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 823 960 m 24 6
- d 62 Y -24 -6 d f 0 0.2 0.8 c 847 1028 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 847
- 1090 m 62 Y -24 -5 d -63 Y f 0 0.6 0.8 c 847 1152 m 63 Y -24 -6 d -62 Y f 0 0.8
- 0.8 c 847 1215 m 62 Y -24 -6 d -62 Y f 0 0.8 0.6 c 847 1277 m 62 Y -24 -6 d -62
- Y f 0 0.8 0.4 c 847 1339 m 62 Y -24 -6 d -62 Y f 0 0.8 0.2 c 847 1401 m 62 Y
- -24 -6 d -62 Y f 0 0.8 0 c 847 1463 m 62 Y -24 -6 d -62 Y f 0.2 0.8 0 c 847
- 1525 m 62 Y -24 -6 d -62 Y f 0.4 0.8 0 c 847 1587 m 63 Y -24 -6 d -63 Y f 0.6
- 0.8 0 c 847 1650 m 42 Y -24 -6 d -42 Y f black 823 960 m 24 6 d 726 Y -24 -6 d
- cl s 0 0 0.8 c 803 976 m 20 -16 d 62 Y -20 16 d f 0 0.2 0.8 c 823 1022 m 62 Y
- -20 16 d -62 Y f 0 0.4 0.8 c 823 1084 m 63 Y -20 15 d -62 Y f 0 0.6 0.8 c 823
- 1147 m 62 Y -20 15 d -62 Y f 0 0.8 0.8 c 823 1209 m 62 Y -20 15 d -62 Y f 0 0.8
- 0.6 c 823 1271 m 62 Y -20 15 d -62 Y f 0 0.8 0.4 c 823 1333 m 62 Y -20 16 d -63
- Y f 0 0.8 0.2 c 823 1395 m 62 Y -20 16 d -62 Y f 0 0.8 0 c 823 1457 m 62 Y -20
- 16 d -62 Y f 0.2 0.8 0 c 823 1519 m 62 Y -20 16 d -62 Y f 0.4 0.8 0 c 823 1581
- m 63 Y -20 15 d -62 Y f 0.6 0.8 0 c 823 1644 m 42 Y -20 15 d -42 Y f black 803
- 976 m 20 -16 d 726 Y -20 15 d cl s 0.6 0.8 0 c 823 1686 m 24 6 d -21 15 d -23
- -6 d f black 823 1686 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 800 954 m 23 6
- d 62 Y -23 -6 d f 0 0.2 0.8 c 823 1022 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 823
- 1084 m 63 Y -23 -6 d -63 Y f 0 0.6 0.8 c 823 1147 m 62 Y -23 -6 d -62 Y f 0 0.8
- 0.8 c 823 1209 m 62 Y -23 -6 d -62 Y f 0 0.8 0.6 c 823 1271 m 62 Y -23 -6 d -62
- Y f 0 0.8 0.4 c 823 1333 m 62 Y -23 -6 d -62 Y f 0 0.8 0.2 c 823 1395 m 62 Y
- -23 -6 d -62 Y f 0 0.8 0 c 823 1457 m 62 Y -23 -6 d -62 Y f 0.2 0.8 0 c 823
- 1519 m 62 Y -23 -5 d -63 Y f 0.4 0.8 0 c 823 1581 m 37 Y -23 -6 d -36 Y f black
- 800 954 m 23 6 d 658 Y -23 -6 d cl s 0 0 0.8 c 780 970 m 20 -16 d 62 Y -20 16 d
- f 0 0.2 0.8 c 800 1016 m 62 Y -20 16 d -62 Y f 0 0.4 0.8 c 800 1078 m 63 Y -20
- 15 d -62 Y f 0 0.6 0.8 c 800 1141 m 62 Y -20 15 d -62 Y f 0 0.8 0.8 c 800 1203
- m 62 Y -20 15 d -62 Y f 0 0.8 0.6 c 800 1265 m 62 Y -20 15 d -62 Y f 0 0.8 0.4
- c 800 1327 m 62 Y -20 16 d -63 Y f 0 0.8 0.2 c 800 1389 m 62 Y -20 16 d -62 Y f
- 0 0.8 0 c 800 1451 m 62 Y -20 16 d -62 Y f 0.2 0.8 0 c 800 1513 m 63 Y -20 15 d
- -62 Y f 0.4 0.8 0 c 800 1576 m 36 Y -20 16 d -37 Y f black 780 970 m 20 -16 d
- 658 Y -20 16 d cl s 0.4 0.8 0 c 800 1612 m 23 6 d -20 16 d -23 -6 d f black 800
- 1612 m 23 6 d -20 16 d -23 -6 d cl s 0 0 0.8 c 776 948 m 24 6 d 62 Y -24 -6 d f
- 0 0.2 0.8 c 800 1016 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 800 1078 m 63 Y -24 -6
- d -63 Y f 0 0.6 0.8 c 800 1141 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 800 1203 m
- 62 Y -24 -6 d -62 Y f 0 0.8 0.6 c 800 1265 m 62 Y -24 -6 d -62 Y f 0 0.8 0.4 c
- 800 1327 m 62 Y -24 -6 d -62 Y f 0 0.8 0.2 c 800 1389 m 62 Y -24 -6 d -62 Y f 0
- 0.8 0 c 800 1451 m 62 Y -24 -6 d -62 Y f 0.2 0.8 0 c 800 1513 m 19 Y -24 -6 d
- -19 Y f black 776 948 m 24 6 d 578 Y -24 -6 d cl s 0 0 0.8 c 756 964 m 20 -16 d
- 62 Y -20 16 d f 0 0.2 0.8 c 776 1010 m 62 Y -20 16 d -62 Y f 0 0.4 0.8 c 776
- 1072 m 63 Y -20 15 d -62 Y f 0 0.6 0.8 c 776 1135 m 62 Y -20 15 d -62 Y f 0 0.8
- 0.8 c 776 1197 m 62 Y -20 15 d -62 Y f 0 0.8 0.6 c 776 1259 m 62 Y -20 16 d -63
- Y f 0 0.8 0.4 c 776 1321 m 62 Y -20 16 d -62 Y f 0 0.8 0.2 c 776 1383 m 62 Y
- -20 16 d -62 Y f 0 0.8 0 c 776 1445 m 62 Y -20 16 d -62 Y f 0.2 0.8 0 c 776
- 1507 m 19 Y -20 15 d -18 Y f black 756 964 m 20 -16 d 578 Y -20 15 d cl s 0.2
- 0.8 0 c 776 1526 m 24 6 d -20 15 d -24 -6 d f black 776 1526 m 24 6 d -20 15 d
- -24 -6 d cl s 0 0 0.8 c 753 942 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 776 1010 m
- 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 776 1072 m 63 Y -23 -6 d -63 Y f 0 0.6 0.8 c
- 776 1135 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 776 1197 m 62 Y -23 -6 d -62 Y f 0
- 0.8 0.6 c 776 1259 m 62 Y -23 -6 d -62 Y f 0 0.8 0.4 c 776 1321 m 62 Y -23 -6 d
- -62 Y f 0 0.8 0.2 c 776 1383 m 22 Y -23 -6 d -22 Y f black 753 942 m 23 6 d 457
- Y -23 -6 d cl s 0 0 0.8 c 733 958 m 20 -16 d 62 Y -20 16 d f 0 0.2 0.8 c 753
- 1004 m 62 Y -20 16 d -62 Y f 0 0.4 0.8 c 753 1066 m 63 Y -20 15 d -62 Y f 0 0.6
- 0.8 c 753 1129 m 62 Y -20 15 d -62 Y f 0 0.8 0.8 c 753 1191 m 62 Y -20 15 d -62
- Y f 0 0.8 0.6 c 753 1253 m 62 Y -20 16 d -63 Y f 0 0.8 0.4 c 753 1315 m 62 Y
- -20 16 d -62 Y f 0 0.8 0.2 c 753 1377 m 22 Y -20 16 d -22 Y f black 733 958 m
- 20 -16 d 457 Y -20 16 d cl s 0 0.8 0.2 c 753 1399 m 23 6 d -20 15 d -23 -5 d f
- black 753 1399 m 23 6 d -20 15 d -23 -5 d cl s 0 0 0.8 c 729 936 m 24 6 d 62 Y
- -24 -6 d f 0 0.2 0.8 c 753 1004 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 753 1066 m
- 63 Y -24 -6 d -63 Y f 0 0.6 0.8 c 753 1129 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c
- 753 1191 m 62 Y -24 -6 d -62 Y f 0 0.8 0.6 c 753 1253 m 62 Y -24 -6 d -62 Y f 0
- 0.8 0.4 c 753 1315 m 62 Y -24 -6 d -62 Y f 0 0.8 0.2 c 753 1377 m 62 Y -24 -6 d
- -62 Y f 0 0.8 0 c 753 1439 m 62 Y -24 -6 d -62 Y f 0.2 0.8 0 c 753 1501 m 63 Y
- -24 -6 d -63 Y f 0.4 0.8 0 c 753 1564 m 62 Y -24 -6 d -62 Y f 0.6 0.8 0 c 753
- 1626 m 15 Y -24 -6 d -15 Y f black 729 936 m 24 6 d 699 Y -24 -6 d cl s 0 0 0.8
- c 709 952 m 20 -16 d 62 Y -20 16 d f 0 0.2 0.8 c 729 998 m 62 Y -20 16 d -62 Y
- f 0 0.4 0.8 c 729 1060 m 63 Y -20 15 d -62 Y f 0 0.6 0.8 c 729 1123 m 62 Y -20
- 15 d -62 Y f 0 0.8 0.8 c 729 1185 m 62 Y -20 15 d -62 Y f 0 0.8 0.6 c 729 1247
- m 62 Y -20 16 d -63 Y f 0 0.8 0.4 c 729 1309 m 62 Y -20 16 d -62 Y f 0 0.8 0.2
- c 729 1371 m 62 Y -20 16 d -62 Y f 0 0.8 0 c 729 1433 m 62 Y -20 16 d -62 Y f
- 0.2 0.8 0 c 729 1495 m 63 Y -20 15 d -62 Y f 0.4 0.8 0 c 729 1558 m 62 Y -20 15
- d -62 Y f 0.6 0.8 0 c 729 1620 m 15 Y -20 15 d -15 Y f black 709 952 m 20 -16 d
- 699 Y -20 15 d cl s 0.6 0.8 0 c 729 1635 m 24 6 d -20 15 d -24 -6 d f black 729
- 1635 m 24 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 706 930 m 23 6 d 62 Y -23 -6 d f
- 0 0.2 0.8 c 729 998 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 729 1060 m 63 Y -23 -6
- d -63 Y f 0 0.6 0.8 c 729 1123 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 729 1185 m
- 62 Y -23 -6 d -62 Y f 0 0.8 0.6 c 729 1247 m 62 Y -23 -6 d -62 Y f 0 0.8 0.4 c
- 729 1309 m 62 Y -23 -6 d -62 Y f 0 0.8 0.2 c 729 1371 m 62 Y -23 -6 d -62 Y f 0
- 0.8 0 c 729 1433 m 41 Y -23 -6 d -41 Y f black 706 930 m 23 6 d 538 Y -23 -6 d
- cl s 0 0 0.8 c 686 946 m 20 -16 d 62 Y -20 16 d f 0 0.2 0.8 c 706 992 m 62 Y
- -20 16 d -62 Y f 0 0.4 0.8 c 706 1054 m 63 Y -20 15 d -62 Y f 0 0.6 0.8 c 706
- 1117 m 62 Y -20 15 d -62 Y f 0 0.8 0.8 c 706 1179 m 62 Y -20 15 d -62 Y f 0 0.8
- 0.6 c 706 1241 m 62 Y -20 16 d -63 Y f 0 0.8 0.4 c 706 1303 m 62 Y -20 16 d -62
- Y f 0 0.8 0.2 c 706 1365 m 62 Y -20 16 d -62 Y f 0 0.8 0 c 706 1427 m 41 Y -20
- 15 d -40 Y f black 686 946 m 20 -16 d 538 Y -20 15 d cl s 0 0.8 0 c 706 1468 m
- 23 6 d -20 15 d -23 -6 d f black 706 1468 m 23 6 d -20 15 d -23 -6 d cl s 0 0
- 0.8 c 682 924 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 706 992 m 62 Y -24 -6 d -62
- Y f 0 0.4 0.8 c 706 1054 m 63 Y -24 -6 d -63 Y f 0 0.6 0.8 c 706 1117 m 62 Y
- -24 -6 d -62 Y f 0 0.8 0.8 c 706 1179 m 62 Y -24 -6 d -62 Y f 0 0.8 0.6 c 706
- 1241 m 62 Y -24 -6 d -62 Y f 0 0.8 0.4 c 706 1303 m 62 Y -24 -6 d -62 Y f 0 0.8
- 0.2 c 706 1365 m 62 Y -24 -6 d -62 Y f 0 0.8 0 c 706 1427 m 62 Y -24 -6 d -62 Y
- f 0.2 0.8 0 c 706 1489 m 63 Y -24 -6 d -63 Y f 0.4 0.8 0 c 706 1552 m 62 Y -24
- -6 d -62 Y f 0.6 0.8 0 c 706 1614 m 1 Y -24 -6 d -1 Y f black 682 924 m 24 6 d
- 685 Y -24 -6 d cl s 0 0 0.8 c 662 940 m 20 -16 d 62 Y -20 16 d f 0 0.2 0.8 c
- 682 986 m 62 Y -20 16 d -62 Y f 0 0.4 0.8 c 682 1048 m 63 Y -20 15 d -62 Y f 0
- 0.6 0.8 c 682 1111 m 62 Y -20 15 d -62 Y f 0 0.8 0.8 c 682 1173 m 62 Y -20 15 d
- -62 Y f 0 0.8 0.6 c 682 1235 m 62 Y -20 16 d -63 Y f 0 0.8 0.4 c 682 1297 m 62
- Y -20 16 d -62 Y f 0 0.8 0.2 c 682 1359 m 62 Y -20 16 d -62 Y f 0 0.8 0 c 682
- 1421 m 62 Y -20 16 d -62 Y f 0.2 0.8 0 c 682 1483 m 63 Y -20 15 d -62 Y f 0.4
- 0.8 0 c 682 1546 m 62 Y -20 15 d -62 Y f 0.6 0.8 0 c 682 1608 m 1 Y -20 16 d -2
- Y f black 662 940 m 20 -16 d 685 Y -20 16 d cl s 0.6 0.8 0 c 682 1609 m 24 6 d
- -20 16 d -24 -6 d f black 682 1609 m 24 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c
- 659 918 m 23 6 d -20 16 d -23 -6 d f black 659 918 m 23 6 d -20 16 d -23 -6 d
- cl s 0 0 0.8 c 635 912 m 24 6 d -20 16 d -24 -6 d f black 635 912 m 24 6 d -20
- 16 d -24 -6 d cl s 0 0 0.8 c 612 906 m 23 6 d -20 16 d -23 -6 d f black 612 906
- m 23 6 d -20 16 d -23 -6 d cl s 0 0 0.8 c 588 900 m 24 6 d -20 16 d -24 -6 d f
- black 588 900 m 24 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1713 1166 m 23 6 d -20
- 15 d -24 -6 d f black 1713 1166 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1689
- 1160 m 24 6 d -21 15 d -23 -6 d f black 1689 1160 m 24 6 d -21 15 d -23 -6 d
- cl s 0 0 0.8 c 1666 1154 m 23 6 d -20 15 d -24 -6 d f black 1666 1154 m 23 6 d
- -20 15 d -24 -6 d cl s 0 0 0.8 c 1642 1148 m 24 6 d -21 15 d -23 -6 d f black
- 1642 1148 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 1619 1142 m 23 6 d 62 Y -23
- -6 d f 0 0.2 0.8 c 1642 1210 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 1642 1272 m 62
- Y -23 -6 d -62 Y f 0 0.6 0.8 c 1642 1334 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c
- 1642 1396 m 63 Y -23 -6 d -63 Y f 0 0.8 0.6 c 1642 1459 m 62 Y -23 -6 d -62 Y f
- 0 0.8 0.4 c 1642 1521 m 62 Y -23 -6 d -62 Y f 0 0.8 0.2 c 1642 1583 m 8 Y -23
- -6 d -8 Y f black 1619 1142 m 23 6 d 443 Y -23 -6 d cl s 0 0 0.8 c 1598 1157 m
- 21 -15 d 62 Y -21 16 d f 0 0.2 0.8 c 1619 1204 m 62 Y -21 16 d -62 Y f 0 0.4
- 0.8 c 1619 1266 m 62 Y -21 16 d -62 Y f 0 0.6 0.8 c 1619 1328 m 62 Y -21 16 d
- -62 Y f 0 0.8 0.8 c 1619 1390 m 63 Y -21 15 d -62 Y f 0 0.8 0.6 c 1619 1453 m
- 62 Y -21 15 d -62 Y f 0 0.8 0.4 c 1619 1515 m 62 Y -21 15 d -62 Y f 0 0.8 0.2 c
- 1619 1577 m 8 Y -21 16 d -9 Y f black 1598 1157 m 21 -15 d 443 Y -21 16 d cl s
- 0 0.8 0.2 c 1619 1585 m 23 6 d -20 16 d -24 -6 d f black 1619 1585 m 23 6 d -20
- 16 d -24 -6 d cl s 0 0 0.8 c 1595 1136 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c
- 1619 1204 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 1619 1266 m 62 Y -24 -6 d -62 Y f
- 0 0.6 0.8 c 1619 1328 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 1619 1390 m 63 Y -24
- -6 d -63 Y f 0 0.8 0.6 c 1619 1453 m 62 Y -24 -6 d -62 Y f 0 0.8 0.4 c 1619
- 1515 m 62 Y -24 -6 d -62 Y f 0 0.8 0.2 c 1619 1577 m 35 Y -24 -6 d -35 Y f
- black 1595 1136 m 24 6 d 470 Y -24 -6 d cl s 0 0 0.8 c 1575 1151 m 20 -15 d 62
- Y -20 16 d f 0 0.2 0.8 c 1595 1198 m 62 Y -20 16 d -62 Y f 0 0.4 0.8 c 1595
- 1260 m 62 Y -20 16 d -62 Y f 0 0.6 0.8 c 1595 1322 m 62 Y -20 16 d -62 Y f 0
- 0.8 0.8 c 1595 1384 m 63 Y -20 15 d -62 Y f 0 0.8 0.6 c 1595 1447 m 62 Y -20 15
- d -62 Y f 0 0.8 0.4 c 1595 1509 m 62 Y -20 15 d -62 Y f 0 0.8 0.2 c 1595 1571 m
- 35 Y -20 16 d -36 Y f black 1575 1151 m 20 -15 d 470 Y -20 16 d cl s 0 0.8 0.2
- c 1595 1606 m 24 6 d -21 16 d -23 -6 d f black 1595 1606 m 24 6 d -21 16 d -23
- -6 d cl s 0 0 0.8 c 1572 1130 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 1595 1198 m
- 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 1595 1260 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c
- 1595 1322 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 1595 1384 m 63 Y -23 -6 d -63 Y f
- 0 0.8 0.6 c 1595 1447 m 62 Y -23 -6 d -62 Y f 0 0.8 0.4 c 1595 1509 m 62 Y -23
- -6 d -62 Y f 0 0.8 0.2 c 1595 1571 m 62 Y -23 -6 d -62 Y f 0 0.8 0 c 1595 1633
- m 40 Y -23 -6 d -40 Y f black 1572 1130 m 23 6 d 537 Y -23 -6 d cl s 0 0 0.8 c
- 1552 1145 m 20 -15 d 62 Y -20 16 d f 0 0.2 0.8 c 1572 1192 m 62 Y -20 16 d -62
- Y f 0 0.4 0.8 c 1572 1254 m 62 Y -20 16 d -62 Y f 0 0.6 0.8 c 1572 1316 m 62 Y
- -20 16 d -62 Y f 0 0.8 0.8 c 1572 1378 m 63 Y -20 15 d -62 Y f 0 0.8 0.6 c 1572
- 1441 m 62 Y -20 15 d -62 Y f 0 0.8 0.4 c 1572 1503 m 62 Y -20 15 d -62 Y f 0
- 0.8 0.2 c 1572 1565 m 62 Y -20 16 d -63 Y f 0 0.8 0 c 1572 1627 m 40 Y -20 16 d
- -40 Y f black 1552 1145 m 20 -15 d 537 Y -20 16 d cl s 0 0.8 0 c 1572 1667 m 23
- 6 d -20 16 d -23 -6 d f black 1572 1667 m 23 6 d -20 16 d -23 -6 d cl s 0 0 0.8
- c 1548 1124 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1572 1192 m 62 Y -24 -6 d -62
- Y f 0 0.4 0.8 c 1572 1254 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 1572 1316 m 62 Y
- -24 -5 d -63 Y f 0 0.8 0.8 c 1572 1378 m 63 Y -24 -6 d -62 Y f 0 0.8 0.6 c 1572
- 1441 m 62 Y -24 -6 d -62 Y f 0 0.8 0.4 c 1572 1503 m 62 Y -24 -6 d -62 Y f 0
- 0.8 0.2 c 1572 1565 m 62 Y -24 -6 d -62 Y f 0 0.8 0 c 1572 1627 m 62 Y -24 -6 d
- -62 Y f 0.2 0.8 0 c 1572 1689 m 62 Y -24 -6 d -62 Y f 0.4 0.8 0 c 1572 1751 m
- 37 Y -24 -6 d -37 Y f black 1548 1124 m 24 6 d 658 Y -24 -6 d cl s 0 0 0.8 c
- 1528 1139 m 20 -15 d 62 Y -20 16 d f 0 0.2 0.8 c 1548 1186 m 62 Y -20 16 d -62
- Y f 0 0.4 0.8 c 1548 1248 m 62 Y -20 16 d -62 Y f 0 0.6 0.8 c 1548 1310 m 63 Y
- -20 15 d -62 Y f 0 0.8 0.8 c 1548 1373 m 62 Y -20 15 d -62 Y f 0 0.8 0.6 c 1548
- 1435 m 62 Y -20 15 d -62 Y f 0 0.8 0.4 c 1548 1497 m 62 Y -20 15 d -62 Y f 0
- 0.8 0.2 c 1548 1559 m 62 Y -20 16 d -63 Y f 0 0.8 0 c 1548 1621 m 62 Y -20 16 d
- -62 Y f 0.2 0.8 0 c 1548 1683 m 62 Y -20 16 d -62 Y f 0.4 0.8 0 c 1548 1745 m
- 37 Y -20 16 d -37 Y f black 1528 1139 m 20 -15 d 658 Y -20 16 d cl s 0.4 0.8 0
- c 1548 1782 m 24 6 d -20 16 d -24 -6 d f black 1548 1782 m 24 6 d -20 16 d -24
- -6 d cl s 0 0 0.8 c 1525 1118 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 1548 1186 m
- 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 1548 1248 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c
- 1548 1310 m 63 Y -23 -6 d -63 Y f 0 0.8 0.8 c 1548 1373 m 62 Y -23 -6 d -62 Y f
- 0 0.8 0.6 c 1548 1435 m 62 Y -23 -6 d -62 Y f 0 0.8 0.4 c 1548 1497 m 62 Y -23
- -6 d -62 Y f 0 0.8 0.2 c 1548 1559 m 62 Y -23 -6 d -62 Y f 0 0.8 0 c 1548 1621
- m 62 Y -23 -6 d -62 Y f 0.2 0.8 0 c 1548 1683 m 19 Y -23 -6 d -19 Y f black
- 1525 1118 m 23 6 d 578 Y -23 -6 d cl s 0 0 0.8 c 1505 1133 m 20 -15 d 62 Y -20
- 16 d f 0 0.2 0.8 c 1525 1180 m 62 Y -20 16 d -62 Y f 0 0.4 0.8 c 1525 1242 m 62
- Y -20 16 d -62 Y f 0 0.6 0.8 c 1525 1304 m 63 Y -20 15 d -62 Y f 0 0.8 0.8 c
- 1525 1367 m 62 Y -20 15 d -62 Y f 0 0.8 0.6 c 1525 1429 m 62 Y -20 15 d -62 Y f
- 0 0.8 0.4 c 1525 1491 m 62 Y -20 15 d -62 Y f 0 0.8 0.2 c 1525 1553 m 62 Y -20
- 16 d -63 Y f 0 0.8 0 c 1525 1615 m 62 Y -20 16 d -62 Y f 0.2 0.8 0 c 1525 1677
- m 19 Y -20 15 d -18 Y f black 1505 1133 m 20 -15 d 578 Y -20 15 d cl s 0.2 0.8
- 0 c 1525 1696 m 23 6 d -20 15 d -23 -6 d f black 1525 1696 m 23 6 d -20 15 d
- -23 -6 d cl s 0 0 0.8 c 1501 1112 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1525
- 1180 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 1525 1242 m 62 Y -24 -6 d -62 Y f 0
- 0.6 0.8 c 1525 1304 m 63 Y -24 -6 d -63 Y f 0 0.8 0.8 c 1525 1367 m 62 Y -24 -6
- d -62 Y f 0 0.8 0.6 c 1525 1429 m 62 Y -24 -6 d -62 Y f 0 0.8 0.4 c 1525 1491 m
- 62 Y -24 -6 d -62 Y f 0 0.8 0.2 c 1525 1553 m 62 Y -24 -6 d -62 Y f 0 0.8 0 c
- 1525 1615 m 54 Y -24 -6 d -54 Y f black 1501 1112 m 24 6 d 551 Y -24 -6 d cl s
- 0 0 0.8 c 1481 1128 m 20 -16 d 62 Y -20 16 d f 0 0.2 0.8 c 1501 1174 m 62 Y -20
- 16 d -62 Y f 0 0.4 0.8 c 1501 1236 m 62 Y -20 16 d -62 Y f 0 0.6 0.8 c 1501
- 1298 m 63 Y -20 15 d -62 Y f 0 0.8 0.8 c 1501 1361 m 62 Y -20 15 d -62 Y f 0
- 0.8 0.6 c 1501 1423 m 62 Y -20 15 d -62 Y f 0 0.8 0.4 c 1501 1485 m 62 Y -20 16
- d -63 Y f 0 0.8 0.2 c 1501 1547 m 62 Y -20 16 d -62 Y f 0 0.8 0 c 1501 1609 m
- 54 Y -20 15 d -53 Y f black 1481 1128 m 20 -16 d 551 Y -20 15 d cl s 0 0.8 0 c
- 1501 1663 m 24 6 d -20 15 d -24 -6 d f black 1501 1663 m 24 6 d -20 15 d -24 -6
- d cl s 0 0 0.8 c 1478 1106 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 1501 1174 m 62
- Y -23 -6 d -62 Y f 0 0.4 0.8 c 1501 1236 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c
- 1501 1298 m 63 Y -23 -6 d -63 Y f 0 0.8 0.8 c 1501 1361 m 62 Y -23 -6 d -62 Y f
- 0 0.8 0.6 c 1501 1423 m 62 Y -23 -6 d -62 Y f 0 0.8 0.4 c 1501 1485 m 62 Y -23
- -6 d -62 Y f 0 0.8 0.2 c 1501 1547 m 35 Y -23 -6 d -35 Y f black 1478 1106 m 23
- 6 d 470 Y -23 -6 d cl s 0 0 0.8 c 1458 1122 m 20 -16 d 62 Y -20 16 d f 0 0.2
- 0.8 c 1478 1168 m 62 Y -20 16 d -62 Y f 0 0.4 0.8 c 1478 1230 m 62 Y -20 16 d
- -62 Y f 0 0.6 0.8 c 1478 1292 m 63 Y -20 15 d -62 Y f 0 0.8 0.8 c 1478 1355 m
- 62 Y -20 15 d -62 Y f 0 0.8 0.6 c 1478 1417 m 62 Y -20 15 d -62 Y f 0 0.8 0.4 c
- 1478 1479 m 62 Y -20 16 d -63 Y f 0 0.8 0.2 c 1478 1541 m 35 Y -20 16 d -35 Y f
- black 1458 1122 m 20 -16 d 470 Y -20 16 d cl s 0 0.8 0.2 c 1478 1576 m 23 6 d
- -20 16 d -23 -6 d f black 1478 1576 m 23 6 d -20 16 d -23 -6 d cl s 0 0 0.8 c
- 1454 1100 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1478 1168 m 62 Y -24 -6 d -62 Y
- f 0 0.4 0.8 c 1478 1230 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 1478 1292 m 63 Y
- -24 -6 d -63 Y f 0 0.8 0.8 c 1478 1355 m 62 Y -24 -6 d -62 Y f 0 0.8 0.6 c 1478
- 1417 m 62 Y -24 -6 d -62 Y f 0 0.8 0.4 c 1478 1479 m 44 Y -24 -6 d -44 Y f
- black 1454 1100 m 24 6 d 417 Y -24 -6 d cl s 0 0 0.8 c 1434 1116 m 20 -16 d 62
- Y -20 16 d f 0 0.2 0.8 c 1454 1162 m 62 Y -20 16 d -62 Y f 0 0.4 0.8 c 1454
- 1224 m 62 Y -20 16 d -62 Y f 0 0.6 0.8 c 1454 1286 m 63 Y -20 15 d -62 Y f 0
- 0.8 0.8 c 1454 1349 m 62 Y -20 15 d -62 Y f 0 0.8 0.6 c 1454 1411 m 62 Y -20 15
- d -62 Y f 0 0.8 0.4 c 1454 1473 m 44 Y -20 15 d -44 Y f black 1434 1116 m 20
- -16 d 417 Y -20 15 d cl s 0 0.8 0.4 c 1454 1517 m 24 6 d -20 15 d -24 -6 d f
- black 1454 1517 m 24 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1431 1094 m 23 6 d 62
- Y -23 -6 d f 0 0.2 0.8 c 1454 1162 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 1454
- 1224 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c 1454 1286 m 63 Y -23 -6 d -63 Y f 0
- 0.8 0.8 c 1454 1349 m 62 Y -23 -6 d -62 Y f 0 0.8 0.6 c 1454 1411 m 62 Y -23 -6
- d -62 Y f 0 0.8 0.4 c 1454 1473 m 62 Y -23 -6 d -62 Y f 0 0.8 0.2 c 1454 1535 m
- 62 Y -23 -6 d -62 Y f 0 0.8 0 c 1454 1597 m 62 Y -23 -6 d -62 Y f 0.2 0.8 0 c
- 1454 1659 m 5 Y -23 -6 d -5 Y f black 1431 1094 m 23 6 d 564 Y -23 -6 d cl s 0
- 0 0.8 c 1411 1110 m 20 -16 d 62 Y -20 16 d f 0 0.2 0.8 c 1431 1156 m 62 Y -20
- 16 d -62 Y f 0 0.4 0.8 c 1431 1218 m 62 Y -20 16 d -62 Y f 0 0.6 0.8 c 1431
- 1280 m 63 Y -20 15 d -62 Y f 0 0.8 0.8 c 1431 1343 m 62 Y -20 15 d -62 Y f 0
- 0.8 0.6 c 1431 1405 m 62 Y -20 15 d -62 Y f 0 0.8 0.4 c 1431 1467 m 62 Y -20 16
- d -63 Y f 0 0.8 0.2 c 1431 1529 m 62 Y -20 16 d -62 Y f 0 0.8 0 c 1431 1591 m
- 62 Y -20 16 d -62 Y f 0.2 0.8 0 c 1431 1653 m 5 Y -20 16 d -5 Y f black 1411
- 1110 m 20 -16 d 564 Y -20 16 d cl s 0.2 0.8 0 c 1431 1658 m 23 6 d -20 16 d -23
- -6 d f black 1431 1658 m 23 6 d -20 16 d -23 -6 d cl s 0 0 0.8 c 1407 1088 m 24
- 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1431 1156 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c
- 1431 1218 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 1431 1280 m 63 Y -24 -6 d -63 Y f
- 0 0.8 0.8 c 1431 1343 m 62 Y -24 -6 d -62 Y f 0 0.8 0.6 c 1431 1405 m 62 Y -24
- -6 d -62 Y f 0 0.8 0.4 c 1431 1467 m 62 Y -24 -6 d -62 Y f 0 0.8 0.2 c 1431
- 1529 m 62 Y -24 -6 d -62 Y f 0 0.8 0 c 1431 1591 m 62 Y -24 -6 d -62 Y f 0.2
- 0.8 0 c 1431 1653 m 59 Y -24 -6 d -59 Y f black 1407 1088 m 24 6 d 618 Y -24 -6
- d cl s 0 0 0.8 c 1387 1104 m 20 -16 d 62 Y -20 16 d f 0 0.2 0.8 c 1407 1150 m
- 62 Y -20 16 d -62 Y f 0 0.4 0.8 c 1407 1212 m 62 Y -20 16 d -62 Y f 0 0.6 0.8 c
- 1407 1274 m 63 Y -20 15 d -62 Y f 0 0.8 0.8 c 1407 1337 m 62 Y -20 15 d -62 Y f
- 0 0.8 0.6 c 1407 1399 m 62 Y -20 15 d -62 Y f 0 0.8 0.4 c 1407 1461 m 62 Y -20
- 16 d -63 Y f 0 0.8 0.2 c 1407 1523 m 62 Y -20 16 d -62 Y f 0 0.8 0 c 1407 1585
- m 62 Y -20 16 d -62 Y f 0.2 0.8 0 c 1407 1647 m 59 Y -20 16 d -59 Y f black
- 1387 1104 m 20 -16 d 618 Y -20 16 d cl s 0.2 0.8 0 c 1407 1706 m 24 6 d -20 16
- d -24 -6 d f black 1407 1706 m 24 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1384
- 1082 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 1407 1150 m 62 Y -23 -6 d -62 Y f 0
- 0.4 0.8 c 1407 1212 m 62 Y -23 -5 d -63 Y f 0 0.6 0.8 c 1407 1274 m 63 Y -23 -6
- d -62 Y f 0 0.8 0.8 c 1407 1337 m 62 Y -23 -6 d -62 Y f 0 0.8 0.6 c 1407 1399 m
- 62 Y -23 -6 d -62 Y f 0 0.8 0.4 c 1407 1461 m 62 Y -23 -6 d -62 Y f 0 0.8 0.2 c
- 1407 1523 m 35 Y -23 -6 d -35 Y f black 1384 1082 m 23 6 d 470 Y -23 -6 d cl s
- 0 0 0.8 c 1364 1098 m 20 -16 d 62 Y -20 16 d f 0 0.2 0.8 c 1384 1144 m 62 Y -20
- 16 d -62 Y f 0 0.4 0.8 c 1384 1206 m 63 Y -20 15 d -62 Y f 0 0.6 0.8 c 1384
- 1269 m 62 Y -20 15 d -62 Y f 0 0.8 0.8 c 1384 1331 m 62 Y -20 15 d -62 Y f 0
- 0.8 0.6 c 1384 1393 m 62 Y -20 15 d -62 Y f 0 0.8 0.4 c 1384 1455 m 62 Y -20 16
- d -63 Y f 0 0.8 0.2 c 1384 1517 m 35 Y -20 16 d -35 Y f black 1364 1098 m 20
- -16 d 470 Y -20 16 d cl s 0 0.8 0.2 c 1384 1552 m 23 6 d -20 16 d -23 -6 d f
- black 1384 1552 m 23 6 d -20 16 d -23 -6 d cl s 0 0 0.8 c 1360 1076 m 24 6 d 62
- Y -24 -6 d f 0 0.2 0.8 c 1384 1144 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 1384
- 1206 m 63 Y -24 -6 d -63 Y f 0 0.6 0.8 c 1384 1269 m 62 Y -24 -6 d -62 Y f 0
- 0.8 0.8 c 1384 1331 m 62 Y -24 -6 d -62 Y f 0 0.8 0.6 c 1384 1393 m 62 Y -24 -6
- d -62 Y f 0 0.8 0.4 c 1384 1455 m 62 Y -24 -6 d -62 Y f 0 0.8 0.2 c 1384 1517 m
- 62 Y -24 -6 d -62 Y f 0 0.8 0 c 1384 1579 m 62 Y -24 -6 d -62 Y f 0.2 0.8 0 c
- 1384 1641 m 59 Y -24 -6 d -59 Y f black 1360 1076 m 24 6 d 618 Y -24 -6 d cl s
- 0 0 0.8 c 1340 1092 m 20 -16 d 62 Y -20 16 d f 0 0.2 0.8 c 1360 1138 m 62 Y -20
- 16 d -62 Y f 0 0.4 0.8 c 1360 1200 m 63 Y -20 15 d -62 Y f 0 0.6 0.8 c 1360
- 1263 m 62 Y -20 15 d -62 Y f 0 0.8 0.8 c 1360 1325 m 62 Y -20 15 d -62 Y f 0
- 0.8 0.6 c 1360 1387 m 62 Y -20 15 d -62 Y f 0 0.8 0.4 c 1360 1449 m 62 Y -20 16
- d -63 Y f 0 0.8 0.2 c 1360 1511 m 62 Y -20 16 d -62 Y f 0 0.8 0 c 1360 1573 m
- 62 Y -20 16 d -62 Y f 0.2 0.8 0 c 1360 1635 m 59 Y -20 16 d -59 Y f black 1340
- 1092 m 20 -16 d 618 Y -20 16 d cl s 0.2 0.8 0 c 1360 1694 m 24 6 d -20 16 d -24
- -6 d f black 1360 1694 m 24 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1337 1070 m 23
- 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 1360 1138 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c
- 1360 1200 m 63 Y -23 -6 d -63 Y f 0 0.6 0.8 c 1360 1263 m 62 Y -23 -6 d -62 Y f
- 0 0.8 0.8 c 1360 1325 m 62 Y -23 -6 d -62 Y f 0 0.8 0.6 c 1360 1387 m 62 Y -23
- -6 d -62 Y f 0 0.8 0.4 c 1360 1449 m 62 Y -23 -6 d -62 Y f 0 0.8 0.2 c 1360
- 1511 m 62 Y -23 -6 d -62 Y f 0 0.8 0 c 1360 1573 m 62 Y -23 -6 d -62 Y f 0.2
- 0.8 0 c 1360 1635 m 63 Y -23 -6 d -63 Y f 0.4 0.8 0 c 1360 1698 m 62 Y -23 -6 d
- -62 Y f 0.6 0.8 0 c 1360 1760 m 15 Y -23 -6 d -15 Y f black 1337 1070 m 23 6 d
- 699 Y -23 -6 d cl s 0 0 0.8 c 1317 1086 m 20 -16 d 62 Y -20 16 d f 0 0.2 0.8 c
- 1337 1132 m 62 Y -20 16 d -62 Y f 0 0.4 0.8 c 1337 1194 m 63 Y -20 15 d -62 Y f
- 0 0.6 0.8 c 1337 1257 m 62 Y -20 15 d -62 Y f 0 0.8 0.8 c 1337 1319 m 62 Y -20
- 15 d -62 Y f 0 0.8 0.6 c 1337 1381 m 62 Y -20 16 d -63 Y f 0 0.8 0.4 c 1337
- 1443 m 62 Y -20 16 d -62 Y f 0 0.8 0.2 c 1337 1505 m 62 Y -20 16 d -62 Y f 0
- 0.8 0 c 1337 1567 m 62 Y -20 16 d -62 Y f 0.2 0.8 0 c 1337 1629 m 63 Y -20 15 d
- -62 Y f 0.4 0.8 0 c 1337 1692 m 62 Y -20 15 d -62 Y f 0.6 0.8 0 c 1337 1754 m
- 15 Y -20 15 d -15 Y f black 1317 1086 m 20 -16 d 699 Y -20 15 d cl s 0.6 0.8 0
- c 1337 1769 m 23 6 d -20 15 d -23 -6 d f black 1337 1769 m 23 6 d -20 15 d -23
- -6 d cl s 0 0 0.8 c 1313 1064 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1337 1132 m
- 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 1337 1194 m 63 Y -24 -6 d -63 Y f 0 0.6 0.8 c
- 1337 1257 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 1337 1319 m 62 Y -24 -6 d -62 Y f
- 0 0.8 0.6 c 1337 1381 m 62 Y -24 -6 d -62 Y f 0 0.8 0.4 c 1337 1443 m 62 Y -24
- -6 d -62 Y f 0 0.8 0.2 c 1337 1505 m 49 Y -24 -6 d -49 Y f black 1313 1064 m 24
- 6 d 484 Y -24 -6 d cl s 0 0 0.8 c 1293 1080 m 20 -16 d 62 Y -20 16 d f 0 0.2
- 0.8 c 1313 1126 m 62 Y -20 16 d -62 Y f 0 0.4 0.8 c 1313 1188 m 63 Y -20 15 d
- -62 Y f 0 0.6 0.8 c 1313 1251 m 62 Y -20 15 d -62 Y f 0 0.8 0.8 c 1313 1313 m
- 62 Y -20 15 d -62 Y f 0 0.8 0.6 c 1313 1375 m 62 Y -20 16 d -63 Y f 0 0.8 0.4 c
- 1313 1437 m 62 Y -20 16 d -62 Y f 0 0.8 0.2 c 1313 1499 m 49 Y -20 15 d -48 Y f
- black 1293 1080 m 20 -16 d 484 Y -20 15 d cl s 0 0.8 0.2 c 1313 1548 m 24 6 d
- -20 15 d -24 -6 d f black 1313 1548 m 24 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c
- 1290 1058 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 1313 1126 m 62 Y -23 -6 d -62 Y
- f 0 0.4 0.8 c 1313 1188 m 63 Y -23 -6 d -63 Y f 0 0.6 0.8 c 1313 1251 m 62 Y
- -23 -6 d -62 Y f 0 0.8 0.8 c 1313 1313 m 62 Y -23 -6 d -62 Y f 0 0.8 0.6 c 1313
- 1375 m 62 Y -23 -6 d -62 Y f 0 0.8 0.4 c 1313 1437 m 62 Y -23 -6 d -62 Y f 0
- 0.8 0.2 c 1313 1499 m 62 Y -23 -6 d -62 Y f 0 0.8 0 c 1313 1561 m 54 Y -23 -6 d
- -54 Y f black 1290 1058 m 23 6 d 551 Y -23 -6 d cl s 0 0 0.8 c 1270 1074 m 20
- -16 d 62 Y -20 16 d f 0 0.2 0.8 c 1290 1120 m 62 Y -20 16 d -62 Y f 0 0.4 0.8 c
- 1290 1182 m 63 Y -20 15 d -62 Y f 0 0.6 0.8 c 1290 1245 m 62 Y -20 15 d -62 Y f
- 0 0.8 0.8 c 1290 1307 m 62 Y -20 15 d -62 Y f 0 0.8 0.6 c 1290 1369 m 62 Y -20
- 16 d -63 Y f 0 0.8 0.4 c 1290 1431 m 62 Y -20 16 d -62 Y f 0 0.8 0.2 c 1290
- 1493 m 62 Y -20 16 d -62 Y f 0 0.8 0 c 1290 1555 m 54 Y -20 16 d -54 Y f black
- 1270 1074 m 20 -16 d 551 Y -20 16 d cl s 0 0.8 0 c 1290 1609 m 23 6 d -20 16 d
- -23 -6 d f black 1290 1609 m 23 6 d -20 16 d -23 -6 d cl s 0 0 0.8 c 1266 1052
- m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1290 1120 m 62 Y -24 -6 d -62 Y f 0 0.4
- 0.8 c 1290 1182 m 63 Y -24 -6 d -63 Y f 0 0.6 0.8 c 1290 1245 m 62 Y -24 -6 d
- -62 Y f 0 0.8 0.8 c 1290 1307 m 62 Y -24 -6 d -62 Y f 0 0.8 0.6 c 1290 1369 m
- 62 Y -24 -6 d -62 Y f 0 0.8 0.4 c 1290 1431 m 62 Y -24 -6 d -62 Y f 0 0.8 0.2 c
- 1290 1493 m 62 Y -24 -6 d -62 Y f black 1266 1052 m 24 6 d 497 Y -24 -6 d cl s
- 0 0 0.8 c 1246 1068 m 20 -16 d 62 Y -20 16 d f 0 0.2 0.8 c 1266 1114 m 62 Y -20
- 16 d -62 Y f 0 0.4 0.8 c 1266 1176 m 63 Y -20 15 d -62 Y f 0 0.6 0.8 c 1266
- 1239 m 62 Y -20 15 d -62 Y f 0 0.8 0.8 c 1266 1301 m 62 Y -20 15 d -62 Y f 0
- 0.8 0.6 c 1266 1363 m 62 Y -20 16 d -63 Y f 0 0.8 0.4 c 1266 1425 m 62 Y -20 16
- d -62 Y f 0 0.8 0.2 c 1266 1487 m 62 Y -20 16 d -62 Y f black 1246 1068 m 20
- -16 d 497 Y -20 16 d cl s 0 0.8 0.2 c 1266 1549 m 24 6 d -20 16 d -24 -6 d f 0
- 0.8 0 c 1266 1549 m 24 6 d -20 16 d -24 -6 d f black 1266 1549 m 24 6 d -20 16
- d -24 -6 d cl s 0 0 0.8 c 1243 1046 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 1266
- 1114 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 1266 1176 m 63 Y -23 -6 d -63 Y f 0
- 0.6 0.8 c 1266 1239 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 1266 1301 m 62 Y -23 -6
- d -62 Y f 0 0.8 0.6 c 1266 1363 m 62 Y -23 -6 d -62 Y f 0 0.8 0.4 c 1266 1425 m
- 62 Y -23 -6 d -62 Y f 0 0.8 0.2 c 1266 1487 m 62 Y -23 -6 d -62 Y f 0 0.8 0 c
- 1266 1549 m 54 Y -23 -6 d -54 Y f black 1243 1046 m 23 6 d 551 Y -23 -6 d cl s
- 0 0 0.8 c 1223 1062 m 20 -16 d 62 Y -20 16 d f 0 0.2 0.8 c 1243 1108 m 62 Y -20
- 16 d -62 Y f 0 0.4 0.8 c 1243 1170 m 63 Y -20 15 d -62 Y f 0 0.6 0.8 c 1243
- 1233 m 62 Y -20 15 d -62 Y f 0 0.8 0.8 c 1243 1295 m 62 Y -20 15 d -62 Y f 0
- 0.8 0.6 c 1243 1357 m 62 Y -20 16 d -63 Y f 0 0.8 0.4 c 1243 1419 m 62 Y -20 16
- d -62 Y f 0 0.8 0.2 c 1243 1481 m 62 Y -20 16 d -62 Y f 0 0.8 0 c 1243 1543 m
- 54 Y -20 16 d -54 Y f black 1223 1062 m 20 -16 d 551 Y -20 16 d cl s 0 0.8 0 c
- 1243 1597 m 23 6 d -20 16 d -23 -6 d f black 1243 1597 m 23 6 d -20 16 d -23 -6
- d cl s 0 0 0.8 c 1220 1040 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 1243 1108 m 62
- Y -23 -5 d -63 Y f 0 0.4 0.8 c 1243 1170 m 63 Y -23 -6 d -62 Y f 0 0.6 0.8 c
- 1243 1233 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 1243 1295 m 62 Y -23 -6 d -62 Y f
- 0 0.8 0.6 c 1243 1357 m 62 Y -23 -6 d -62 Y f 0 0.8 0.4 c 1243 1419 m 44 Y -23
- -6 d -44 Y f black 1220 1040 m 23 6 d 417 Y -23 -6 d cl s 0 0 0.8 c 1199 1056 m
- 21 -16 d 62 Y -21 16 d f 0 0.2 0.8 c 1220 1102 m 63 Y -21 15 d -62 Y f 0 0.4
- 0.8 c 1220 1165 m 62 Y -21 15 d -62 Y f 0 0.6 0.8 c 1220 1227 m 62 Y -21 15 d
- -62 Y f 0 0.8 0.8 c 1220 1289 m 62 Y -21 15 d -62 Y f 0 0.8 0.6 c 1220 1351 m
- 62 Y -21 16 d -63 Y f 0 0.8 0.4 c 1220 1413 m 44 Y -21 15 d -43 Y f black 1199
- 1056 m 21 -16 d 417 Y -21 15 d cl s 0 0.8 0.4 c 1220 1457 m 23 6 d -20 15 d -24
- -6 d f black 1220 1457 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1196 1034 m 24
- 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1220 1102 m 63 Y -24 -6 d -63 Y f 0 0.4 0.8 c
- 1220 1165 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 1220 1227 m 62 Y -24 -6 d -62 Y f
- 0 0.8 0.8 c 1220 1289 m 62 Y -24 -6 d -62 Y f 0 0.8 0.6 c 1220 1351 m 62 Y -24
- -6 d -62 Y f 0 0.8 0.4 c 1220 1413 m 62 Y -24 -6 d -62 Y f 0 0.8 0.2 c 1220
- 1475 m 62 Y -24 -6 d -62 Y f 0 0.8 0 c 1220 1537 m 62 Y -24 -5 d -63 Y f 0.2
- 0.8 0 c 1220 1599 m 63 Y -24 -6 d -62 Y f 0.4 0.8 0 c 1220 1662 m 62 Y -24 -6 d
- -62 Y f 0.6 0.8 0 c 1220 1724 m 62 Y -24 -6 d -62 Y f 0.8 0.8 0 c 1220 1786 m
- 60 Y -24 -6 d -60 Y f black 1196 1034 m 24 6 d 806 Y -24 -6 d cl s 0 0 0.8 c
- 1176 1050 m 20 -16 d 62 Y -20 16 d f 0 0.2 0.8 c 1196 1096 m 63 Y -20 15 d -62
- Y f 0 0.4 0.8 c 1196 1159 m 62 Y -20 15 d -62 Y f 0 0.6 0.8 c 1196 1221 m 62 Y
- -20 15 d -62 Y f 0 0.8 0.8 c 1196 1283 m 62 Y -20 15 d -62 Y f 0 0.8 0.6 c 1196
- 1345 m 62 Y -20 16 d -63 Y f 0 0.8 0.4 c 1196 1407 m 62 Y -20 16 d -62 Y f 0
- 0.8 0.2 c 1196 1469 m 62 Y -20 16 d -62 Y f 0 0.8 0 c 1196 1531 m 63 Y -20 15 d
- -62 Y f 0.2 0.8 0 c 1196 1594 m 62 Y -20 15 d -62 Y f 0.4 0.8 0 c 1196 1656 m
- 62 Y -20 15 d -62 Y f 0.6 0.8 0 c 1196 1718 m 62 Y -20 15 d -62 Y f 0.8 0.8 0 c
- 1196 1780 m 60 Y -20 16 d -61 Y f black 1176 1050 m 20 -16 d 806 Y -20 16 d
- cl s 0.8 0.8 0 c 1196 1840 m 24 6 d -21 16 d -23 -6 d f black 1196 1840 m 24 6
- d -21 16 d -23 -6 d cl s 0 0 0.8 c 1173 1028 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8
- c 1196 1096 m 63 Y -23 -6 d -63 Y f 0 0.4 0.8 c 1196 1159 m 62 Y -23 -6 d -62 Y
- f 0 0.6 0.8 c 1196 1221 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 1196 1283 m 62 Y
- -23 -6 d -62 Y f 0 0.8 0.6 c 1196 1345 m 62 Y -23 -6 d -62 Y f 0 0.8 0.4 c 1196
- 1407 m 62 Y -23 -6 d -62 Y f 0 0.8 0.2 c 1196 1469 m 62 Y -23 -6 d -62 Y f 0
- 0.8 0 c 1196 1531 m 63 Y -23 -6 d -63 Y f 0.2 0.8 0 c 1196 1594 m 5 Y -23 -6 d
- -5 Y f black 1173 1028 m 23 6 d 565 Y -23 -6 d cl s 0 0 0.8 c 1152 1044 m 21
- -16 d 62 Y -21 16 d f 0 0.2 0.8 c 1173 1090 m 63 Y -21 15 d -62 Y f 0 0.4 0.8 c
- 1173 1153 m 62 Y -21 15 d -62 Y f 0 0.6 0.8 c 1173 1215 m 62 Y -21 15 d -62 Y f
- 0 0.8 0.8 c 1173 1277 m 62 Y -21 16 d -63 Y f 0 0.8 0.6 c 1173 1339 m 62 Y -21
- 16 d -62 Y f 0 0.8 0.4 c 1173 1401 m 62 Y -21 16 d -62 Y f 0 0.8 0.2 c 1173
- 1463 m 62 Y -21 16 d -62 Y f 0 0.8 0 c 1173 1525 m 63 Y -21 15 d -62 Y f 0.2
- 0.8 0 c 1173 1588 m 5 Y -21 15 d -5 Y f black 1152 1044 m 21 -16 d 565 Y -21 15
- d cl s 0.2 0.8 0 c 1173 1593 m 23 6 d -20 15 d -24 -6 d f black 1173 1593 m 23
- 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1149 1022 m 24 6 d 62 Y -24 -6 d f 0 0.2
- 0.8 c 1173 1090 m 63 Y -24 -6 d -63 Y f 0 0.4 0.8 c 1173 1153 m 62 Y -24 -6 d
- -62 Y f 0 0.6 0.8 c 1173 1215 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 1173 1277 m
- 62 Y -24 -6 d -62 Y f 0 0.8 0.6 c 1173 1339 m 62 Y -24 -6 d -62 Y f 0 0.8 0.4 c
- 1173 1401 m 62 Y -24 -6 d -62 Y f 0 0.8 0.2 c 1173 1463 m 62 Y -24 -6 d -62 Y f
- 0 0.8 0 c 1173 1525 m 63 Y -24 -6 d -63 Y f 0.2 0.8 0 c 1173 1588 m 45 Y -24 -6
- d -45 Y f black 1149 1022 m 24 6 d 605 Y -24 -6 d cl s 0 0 0.8 c 1129 1038 m 20
- -16 d 62 Y -20 16 d f 0 0.2 0.8 c 1149 1084 m 63 Y -20 15 d -62 Y f 0 0.4 0.8 c
- 1149 1147 m 62 Y -20 15 d -62 Y f 0 0.6 0.8 c 1149 1209 m 62 Y -20 15 d -62 Y f
- 0 0.8 0.8 c 1149 1271 m 62 Y -20 16 d -63 Y f 0 0.8 0.6 c 1149 1333 m 62 Y -20
- 16 d -62 Y f 0 0.8 0.4 c 1149 1395 m 62 Y -20 16 d -62 Y f 0 0.8 0.2 c 1149
- 1457 m 62 Y -20 16 d -62 Y f 0 0.8 0 c 1149 1519 m 63 Y -20 15 d -62 Y f 0.2
- 0.8 0 c 1149 1582 m 45 Y -20 15 d -45 Y f black 1129 1038 m 20 -16 d 605 Y -20
- 15 d cl s 0.2 0.8 0 c 1149 1627 m 24 6 d -21 15 d -23 -6 d f black 1149 1627 m
- 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 1126 1016 m 23 6 d 62 Y -23 -6 d f 0
- 0.2 0.8 c 1149 1084 m 63 Y -23 -6 d -63 Y f 0 0.4 0.8 c 1149 1147 m 62 Y -23 -6
- d -62 Y f 0 0.6 0.8 c 1149 1209 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 1149 1271 m
- 62 Y -23 -6 d -62 Y f 0 0.8 0.6 c 1149 1333 m 62 Y -23 -6 d -62 Y f 0 0.8 0.4 c
- 1149 1395 m 62 Y -23 -6 d -62 Y f 0 0.8 0.2 c 1149 1457 m 62 Y -23 -6 d -62 Y f
- 0 0.8 0 c 1149 1519 m 63 Y -23 -6 d -63 Y f 0.2 0.8 0 c 1149 1582 m 31 Y -23 -6
- d -31 Y f black 1126 1016 m 23 6 d 591 Y -23 -6 d cl s 0 0 0.8 c 1105 1032 m 21
- -16 d 62 Y -21 16 d f 0 0.2 0.8 c 1126 1078 m 63 Y -21 15 d -62 Y f 0 0.4 0.8 c
- 1126 1141 m 62 Y -21 15 d -62 Y f 0 0.6 0.8 c 1126 1203 m 62 Y -21 15 d -62 Y f
- 0 0.8 0.8 c 1126 1265 m 62 Y -21 16 d -63 Y f 0 0.8 0.6 c 1126 1327 m 62 Y -21
- 16 d -62 Y f 0 0.8 0.4 c 1126 1389 m 62 Y -21 16 d -62 Y f 0 0.8 0.2 c 1126
- 1451 m 62 Y -21 16 d -62 Y f 0 0.8 0 c 1126 1513 m 63 Y -21 15 d -62 Y f 0.2
- 0.8 0 c 1126 1576 m 31 Y -21 16 d -32 Y f black 1105 1032 m 21 -16 d 591 Y -21
- 16 d cl s 0.2 0.8 0 c 1126 1607 m 23 6 d -20 16 d -24 -6 d f black 1126 1607 m
- 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1102 1010 m 24 6 d 62 Y -24 -6 d f 0
- 0.2 0.8 c 1126 1078 m 63 Y -24 -6 d -63 Y f 0 0.4 0.8 c 1126 1141 m 62 Y -24 -6
- d -62 Y f 0 0.6 0.8 c 1126 1203 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 1126 1265 m
- 62 Y -24 -6 d -62 Y f 0 0.8 0.6 c 1126 1327 m 62 Y -24 -6 d -62 Y f 0 0.8 0.4 c
- 1126 1389 m 62 Y -24 -6 d -62 Y f 0 0.8 0.2 c 1126 1451 m 62 Y -24 -6 d -62 Y f
- 0 0.8 0 c 1126 1513 m 27 Y -24 -6 d -27 Y f black 1102 1010 m 24 6 d 524 Y -24
- -6 d cl s 0 0 0.8 c 1082 1026 m 20 -16 d 62 Y -20 16 d f 0 0.2 0.8 c 1102 1072
- m 63 Y -20 15 d -62 Y f 0 0.4 0.8 c 1102 1135 m 62 Y -20 15 d -62 Y f 0 0.6 0.8
- c 1102 1197 m 62 Y -20 15 d -62 Y f 0 0.8 0.8 c 1102 1259 m 62 Y -20 16 d -63 Y
- f 0 0.8 0.6 c 1102 1321 m 62 Y -20 16 d -62 Y f 0 0.8 0.4 c 1102 1383 m 62 Y
- -20 16 d -62 Y f 0 0.8 0.2 c 1102 1445 m 62 Y -20 16 d -62 Y f 0 0.8 0 c 1102
- 1507 m 27 Y -20 16 d -27 Y f black 1082 1026 m 20 -16 d 524 Y -20 16 d cl s 0
- 0.8 0 c 1102 1534 m 24 6 d -21 16 d -23 -6 d f black 1102 1534 m 24 6 d -21 16
- d -23 -6 d cl s 0 0 0.8 c 1079 1004 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 1102
- 1072 m 63 Y -23 -6 d -63 Y f 0 0.4 0.8 c 1102 1135 m 62 Y -23 -6 d -62 Y f 0
- 0.6 0.8 c 1102 1197 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 1102 1259 m 62 Y -23 -6
- d -62 Y f 0 0.8 0.6 c 1102 1321 m 62 Y -23 -6 d -62 Y f 0 0.8 0.4 c 1102 1383 m
- 62 Y -23 -6 d -62 Y f 0 0.8 0.2 c 1102 1445 m 62 Y -23 -6 d -62 Y f 0 0.8 0 c
- 1102 1507 m 63 Y -23 -6 d -63 Y f 0.2 0.8 0 c 1102 1570 m 5 Y -23 -6 d -5 Y f
- black 1079 1004 m 23 6 d 565 Y -23 -6 d cl s 0 0 0.8 c 1058 1020 m 21 -16 d 62
- Y -21 16 d f 0 0.2 0.8 c 1079 1066 m 63 Y -21 15 d -62 Y f 0 0.4 0.8 c 1079
- 1129 m 62 Y -21 15 d -62 Y f 0 0.6 0.8 c 1079 1191 m 62 Y -21 15 d -62 Y f 0
- 0.8 0.8 c 1079 1253 m 62 Y -21 16 d -63 Y f 0 0.8 0.6 c 1079 1315 m 62 Y -21 16
- d -62 Y f 0 0.8 0.4 c 1079 1377 m 62 Y -21 16 d -62 Y f 0 0.8 0.2 c 1079 1439 m
- 62 Y -21 16 d -62 Y f 0 0.8 0 c 1079 1501 m 63 Y -21 15 d -62 Y f 0.2 0.8 0 c
- 1079 1564 m 5 Y -21 15 d -5 Y f black 1058 1020 m 21 -16 d 565 Y -21 15 d cl s
- 0.2 0.8 0 c 1079 1569 m 23 6 d -20 15 d -24 -6 d f black 1079 1569 m 23 6 d -20
- 15 d -24 -6 d cl s 0 0 0.8 c 1055 998 m 24 6 d 62 Y -24 -5 d f 0 0.2 0.8 c 1079
- 1066 m 63 Y -24 -6 d -62 Y f 0 0.4 0.8 c 1079 1129 m 62 Y -24 -6 d -62 Y f 0
- 0.6 0.8 c 1079 1191 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 1079 1253 m 62 Y -24 -6
- d -62 Y f 0 0.8 0.6 c 1079 1315 m 62 Y -24 -6 d -62 Y f 0 0.8 0.4 c 1079 1377 m
- 62 Y -24 -6 d -62 Y f 0 0.8 0.2 c 1079 1439 m 62 Y -24 -6 d -62 Y f 0 0.8 0 c
- 1079 1501 m 63 Y -24 -6 d -63 Y f 0.2 0.8 0 c 1079 1564 m 18 Y -24 -6 d -18 Y f
- black 1055 998 m 24 6 d 578 Y -24 -6 d cl s 0 0 0.8 c 1035 1014 m 20 -16 d 63 Y
- -20 15 d f 0 0.2 0.8 c 1055 1061 m 62 Y -20 15 d -62 Y f 0 0.4 0.8 c 1055 1123
- m 62 Y -20 15 d -62 Y f 0 0.6 0.8 c 1055 1185 m 62 Y -20 15 d -62 Y f 0 0.8 0.8
- c 1055 1247 m 62 Y -20 16 d -63 Y f 0 0.8 0.6 c 1055 1309 m 62 Y -20 16 d -62 Y
- f 0 0.8 0.4 c 1055 1371 m 62 Y -20 16 d -62 Y f 0 0.8 0.2 c 1055 1433 m 62 Y
- -20 16 d -62 Y f 0 0.8 0 c 1055 1495 m 63 Y -20 15 d -62 Y f 0.2 0.8 0 c 1055
- 1558 m 18 Y -20 16 d -19 Y f black 1035 1014 m 20 -16 d 578 Y -20 16 d cl s 0.2
- 0.8 0 c 1055 1576 m 24 6 d -21 16 d -23 -6 d f black 1055 1576 m 24 6 d -21 16
- d -23 -6 d cl s 0 0 0.8 c 1032 992 m 23 6 d 63 Y -23 -6 d f 0 0.2 0.8 c 1055
- 1061 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 1055 1123 m 62 Y -23 -6 d -62 Y f 0
- 0.6 0.8 c 1055 1185 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 1055 1247 m 62 Y -23 -6
- d -62 Y f 0 0.8 0.6 c 1055 1309 m 62 Y -23 -6 d -62 Y f 0 0.8 0.4 c 1055 1371 m
- 62 Y -23 -6 d -62 Y f 0 0.8 0.2 c 1055 1433 m 62 Y -23 -5 d -63 Y f 0 0.8 0 c
- 1055 1495 m 63 Y -23 -6 d -62 Y f 0.2 0.8 0 c 1055 1558 m 62 Y -23 -6 d -62 Y f
- 0.4 0.8 0 c 1055 1620 m 62 Y -23 -6 d -62 Y f 0.6 0.8 0 c 1055 1682 m 62 Y -23
- -6 d -62 Y f 0.8 0.8 0 c 1055 1744 m 47 Y -23 -6 d -47 Y f black 1032 992 m 23
- 6 d 793 Y -23 -6 d cl s 0 0 0.8 c 1011 1008 m 21 -16 d 63 Y -21 15 d f 0 0.2
- 0.8 c 1032 1055 m 62 Y -21 15 d -62 Y f 0 0.4 0.8 c 1032 1117 m 62 Y -21 15 d
- -62 Y f 0 0.6 0.8 c 1032 1179 m 62 Y -21 15 d -62 Y f 0 0.8 0.8 c 1032 1241 m
- 62 Y -21 16 d -63 Y f 0 0.8 0.6 c 1032 1303 m 62 Y -21 16 d -62 Y f 0 0.8 0.4 c
- 1032 1365 m 62 Y -21 16 d -62 Y f 0 0.8 0.2 c 1032 1427 m 63 Y -21 15 d -62 Y f
- 0 0.8 0 c 1032 1490 m 62 Y -21 15 d -62 Y f 0.2 0.8 0 c 1032 1552 m 62 Y -21 15
- d -62 Y f 0.4 0.8 0 c 1032 1614 m 62 Y -21 15 d -62 Y f 0.6 0.8 0 c 1032 1676 m
- 62 Y -21 16 d -63 Y f 0.8 0.8 0 c 1032 1738 m 47 Y -21 16 d -47 Y f black 1011
- 1008 m 21 -16 d 793 Y -21 16 d cl s 0.8 0.8 0 c 1032 1785 m 23 6 d -20 16 d -24
- -6 d f black 1032 1785 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1008 986 m 24
- 6 d 63 Y -24 -6 d f 0 0.2 0.8 c 1032 1055 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c
- 1032 1117 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 1032 1179 m 62 Y -24 -6 d -62 Y f
- 0 0.8 0.8 c 1032 1241 m 62 Y -24 -6 d -62 Y f 0 0.8 0.6 c 1032 1303 m 62 Y -24
- -6 d -62 Y f 0 0.8 0.4 c 1032 1365 m 62 Y -24 -6 d -62 Y f 0 0.8 0.2 c 1032
- 1427 m 63 Y -24 -6 d -63 Y f 0 0.8 0 c 1032 1490 m 62 Y -24 -6 d -62 Y f 0.2
- 0.8 0 c 1032 1552 m 58 Y -24 -6 d -58 Y f black 1008 986 m 24 6 d 618 Y -24 -6
- d cl s 0 0 0.8 c 988 1002 m 20 -16 d 63 Y -20 15 d f 0 0.2 0.8 c 1008 1049 m 62
- Y -20 15 d -62 Y f 0 0.4 0.8 c 1008 1111 m 62 Y -20 15 d -62 Y f 0 0.6 0.8 c
- 1008 1173 m 62 Y -20 16 d -63 Y f 0 0.8 0.8 c 1008 1235 m 62 Y -20 16 d -62 Y f
- 0 0.8 0.6 c 1008 1297 m 62 Y -20 16 d -62 Y f 0 0.8 0.4 c 1008 1359 m 62 Y -20
- 16 d -62 Y f 0 0.8 0.2 c 1008 1421 m 63 Y -20 15 d -62 Y f 0 0.8 0 c 1008 1484
- m 62 Y -20 15 d -62 Y f 0.2 0.8 0 c 1008 1546 m 58 Y -20 16 d -59 Y f black 988
- 1002 m 20 -16 d 618 Y -20 16 d cl s 0.2 0.8 0 c 1008 1604 m 24 6 d -21 16 d -23
- -6 d f black 1008 1604 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 985 980 m 23 6
- d 63 Y -23 -6 d f 0 0.2 0.8 c 1008 1049 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c
- 1008 1111 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c 1008 1173 m 62 Y -23 -6 d -62 Y f
- 0 0.8 0.8 c 1008 1235 m 62 Y -23 -6 d -62 Y f 0 0.8 0.6 c 1008 1297 m 62 Y -23
- -6 d -62 Y f 0 0.8 0.4 c 1008 1359 m 62 Y -23 -6 d -62 Y f 0 0.8 0.2 c 1008
- 1421 m 63 Y -23 -6 d -63 Y f 0 0.8 0 c 1008 1484 m 62 Y -23 -6 d -62 Y f 0.2
- 0.8 0 c 1008 1546 m 62 Y -23 -6 d -62 Y f 0.4 0.8 0 c 1008 1608 m 62 Y -23 -6 d
- -62 Y f 0.6 0.8 0 c 1008 1670 m 55 Y -23 -6 d -55 Y f black 985 980 m 23 6 d
- 739 Y -23 -6 d cl s 0 0 0.8 c 964 996 m 21 -16 d 63 Y -21 15 d f 0 0.2 0.8 c
- 985 1043 m 62 Y -21 15 d -62 Y f 0 0.4 0.8 c 985 1105 m 62 Y -21 15 d -62 Y f 0
- 0.6 0.8 c 985 1167 m 62 Y -21 16 d -63 Y f 0 0.8 0.8 c 985 1229 m 62 Y -21 16 d
- -62 Y f 0 0.8 0.6 c 985 1291 m 62 Y -21 16 d -62 Y f 0 0.8 0.4 c 985 1353 m 62
- Y -21 16 d -62 Y f 0 0.8 0.2 c 985 1415 m 63 Y -21 15 d -62 Y f 0 0.8 0 c 985
- 1478 m 62 Y -21 15 d -62 Y f 0.2 0.8 0 c 985 1540 m 62 Y -21 15 d -62 Y f 0.4
- 0.8 0 c 985 1602 m 62 Y -21 16 d -63 Y f 0.6 0.8 0 c 985 1664 m 55 Y -21 16 d
- -55 Y f black 964 996 m 21 -16 d 739 Y -21 16 d cl s 0.6 0.8 0 c 985 1719 m 23
- 6 d -20 16 d -24 -6 d f black 985 1719 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8
- c 961 974 m 24 6 d 63 Y -24 -6 d f 0 0.2 0.8 c 985 1043 m 62 Y -24 -6 d -62 Y f
- 0 0.4 0.8 c 985 1105 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 985 1167 m 62 Y -24 -6
- d -62 Y f 0 0.8 0.8 c 985 1229 m 62 Y -24 -6 d -62 Y f 0 0.8 0.6 c 985 1291 m
- 62 Y -24 -6 d -62 Y f 0 0.8 0.4 c 985 1353 m 62 Y -24 -6 d -62 Y f 0 0.8 0.2 c
- 985 1415 m 63 Y -24 -6 d -63 Y f 0 0.8 0 c 985 1478 m 62 Y -24 -6 d -62 Y f 0.2
- 0.8 0 c 985 1540 m 62 Y -24 -6 d -62 Y f 0.4 0.8 0 c 985 1602 m 37 Y -24 -6 d
- -37 Y f black 961 974 m 24 6 d 659 Y -24 -6 d cl s 0 0 0.8 c 941 990 m 20 -16 d
- 63 Y -20 15 d f 0 0.2 0.8 c 961 1037 m 62 Y -20 15 d -62 Y f 0 0.4 0.8 c 961
- 1099 m 62 Y -20 15 d -62 Y f 0 0.6 0.8 c 961 1161 m 62 Y -20 16 d -63 Y f 0 0.8
- 0.8 c 961 1223 m 62 Y -20 16 d -62 Y f 0 0.8 0.6 c 961 1285 m 62 Y -20 16 d -62
- Y f 0 0.8 0.4 c 961 1347 m 62 Y -20 16 d -62 Y f 0 0.8 0.2 c 961 1409 m 63 Y
- -20 15 d -62 Y f 0 0.8 0 c 961 1472 m 62 Y -20 15 d -62 Y f 0.2 0.8 0 c 961
- 1534 m 62 Y -20 15 d -62 Y f 0.4 0.8 0 c 961 1596 m 37 Y -20 15 d -37 Y f black
- 941 990 m 20 -16 d 659 Y -20 15 d cl s 0.4 0.8 0 c 961 1633 m 24 6 d -21 15 d
- -23 -6 d f black 961 1633 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 938 968 m
- 23 6 d 63 Y -23 -6 d f 0 0.2 0.8 c 961 1037 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c
- 961 1099 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c 961 1161 m 62 Y -23 -6 d -62 Y f 0
- 0.8 0.8 c 961 1223 m 62 Y -23 -6 d -62 Y f 0 0.8 0.6 c 961 1285 m 62 Y -23 -6 d
- -62 Y f 0 0.8 0.4 c 961 1347 m 62 Y -23 -6 d -62 Y f 0 0.8 0.2 c 961 1409 m 63
- Y -23 -6 d -63 Y f 0 0.8 0 c 961 1472 m 62 Y -23 -6 d -62 Y f 0.2 0.8 0 c 961
- 1534 m 62 Y -23 -6 d -62 Y f 0.4 0.8 0 c 961 1596 m 10 Y -23 -6 d -10 Y f black
- 938 968 m 23 6 d 632 Y -23 -6 d cl s 0 0 0.8 c 917 984 m 21 -16 d 63 Y -21 15 d
- f 0 0.2 0.8 c 938 1031 m 62 Y -21 15 d -62 Y f 0 0.4 0.8 c 938 1093 m 62 Y -21
- 15 d -62 Y f 0 0.6 0.8 c 938 1155 m 62 Y -21 16 d -63 Y f 0 0.8 0.8 c 938 1217
- m 62 Y -21 16 d -62 Y f 0 0.8 0.6 c 938 1279 m 62 Y -21 16 d -62 Y f 0 0.8 0.4
- c 938 1341 m 62 Y -21 16 d -62 Y f 0 0.8 0.2 c 938 1403 m 63 Y -21 15 d -62 Y f
- 0 0.8 0 c 938 1466 m 62 Y -21 15 d -62 Y f 0.2 0.8 0 c 938 1528 m 62 Y -21 15 d
- -62 Y f 0.4 0.8 0 c 938 1590 m 10 Y -21 15 d -10 Y f black 917 984 m 21 -16 d
- 632 Y -21 15 d cl s 0.4 0.8 0 c 938 1600 m 23 6 d -20 15 d -24 -6 d f black 938
- 1600 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 914 962 m 24 6 d 63 Y -24 -6 d f
- 0 0.2 0.8 c 938 1031 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 938 1093 m 62 Y -24 -6
- d -62 Y f 0 0.6 0.8 c 938 1155 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 938 1217 m
- 62 Y -24 -6 d -62 Y f 0 0.8 0.6 c 938 1279 m 62 Y -24 -6 d -62 Y f 0 0.8 0.4 c
- 938 1341 m 62 Y -24 -6 d -62 Y f 0 0.8 0.2 c 938 1403 m 63 Y -24 -6 d -63 Y f 0
- 0.8 0 c 938 1466 m 62 Y -24 -6 d -62 Y f 0.2 0.8 0 c 938 1528 m 62 Y -24 -6 d
- -62 Y f 0.4 0.8 0 c 938 1590 m 62 Y -24 -6 d -62 Y f 0.6 0.8 0 c 938 1652 m 15
- Y -24 -6 d -15 Y f black 914 962 m 24 6 d 699 Y -24 -6 d cl s 0 0 0.8 c 894 978
- m 20 -16 d 63 Y -20 15 d f 0 0.2 0.8 c 914 1025 m 62 Y -20 15 d -62 Y f 0 0.4
- 0.8 c 914 1087 m 62 Y -20 15 d -62 Y f 0 0.6 0.8 c 914 1149 m 62 Y -20 16 d -63
- Y f 0 0.8 0.8 c 914 1211 m 62 Y -20 16 d -62 Y f 0 0.8 0.6 c 914 1273 m 62 Y
- -20 16 d -62 Y f 0 0.8 0.4 c 914 1335 m 62 Y -20 16 d -62 Y f 0 0.8 0.2 c 914
- 1397 m 63 Y -20 15 d -62 Y f 0 0.8 0 c 914 1460 m 62 Y -20 15 d -62 Y f 0.2 0.8
- 0 c 914 1522 m 62 Y -20 15 d -62 Y f 0.4 0.8 0 c 914 1584 m 62 Y -20 16 d -63 Y
- f 0.6 0.8 0 c 914 1646 m 15 Y -20 16 d -15 Y f black 894 978 m 20 -16 d 699 Y
- -20 16 d cl s 0.6 0.8 0 c 914 1661 m 24 6 d -21 16 d -23 -6 d f black 914 1661
- m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 891 957 m 23 5 d 63 Y -23 -6 d f 0
- 0.2 0.8 c 914 1025 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 914 1087 m 62 Y -23 -6 d
- -62 Y f 0 0.6 0.8 c 914 1149 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 914 1211 m 62
- Y -23 -6 d -62 Y f 0 0.8 0.6 c 914 1273 m 62 Y -23 -6 d -62 Y f 0 0.8 0.4 c 914
- 1335 m 62 Y -23 -6 d -62 Y f 0 0.8 0.2 c 914 1397 m 63 Y -23 -6 d -63 Y f 0 0.8
- 0 c 914 1460 m 62 Y -23 -6 d -62 Y f 0.2 0.8 0 c 914 1522 m 5 Y -23 -6 d -5 Y f
- black 891 957 m 23 5 d 565 Y -23 -6 d cl s 0 0 0.8 c 870 972 m 21 -15 d 62 Y
- -21 15 d f 0 0.2 0.8 c 891 1019 m 62 Y -21 15 d -62 Y f 0 0.4 0.8 c 891 1081 m
- 62 Y -21 15 d -62 Y f 0 0.6 0.8 c 891 1143 m 62 Y -21 16 d -63 Y f 0 0.8 0.8 c
- 891 1205 m 62 Y -21 16 d -62 Y f 0 0.8 0.6 c 891 1267 m 62 Y -21 16 d -62 Y f 0
- 0.8 0.4 c 891 1329 m 62 Y -21 16 d -62 Y f 0 0.8 0.2 c 891 1391 m 63 Y -21 15 d
- -62 Y f 0 0.8 0 c 891 1454 m 62 Y -21 15 d -62 Y f 0.2 0.8 0 c 891 1516 m 5 Y
- -21 15 d -5 Y f black 870 972 m 21 -15 d 564 Y -21 15 d cl s 0.2 0.8 0 c 891
- 1521 m 23 6 d -20 15 d -24 -6 d f black 891 1521 m 23 6 d -20 15 d -24 -6 d
- cl s 0 0 0.8 c 867 951 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 891 1019 m 62 Y -24
- -6 d -62 Y f 0 0.4 0.8 c 891 1081 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 891 1143
- m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 891 1205 m 62 Y -24 -6 d -62 Y f 0 0.8 0.6
- c 891 1267 m 62 Y -24 -6 d -62 Y f 0 0.8 0.4 c 891 1329 m 62 Y -24 -5 d -63 Y f
- 0 0.8 0.2 c 891 1391 m 63 Y -24 -6 d -62 Y f 0 0.8 0 c 891 1454 m 62 Y -24 -6 d
- -62 Y f 0.2 0.8 0 c 891 1516 m 59 Y -24 -6 d -59 Y f black 867 951 m 24 6 d 618
- Y -24 -6 d cl s 0 0 0.8 c 847 966 m 20 -15 d 62 Y -20 15 d f 0 0.2 0.8 c 867
- 1013 m 62 Y -20 15 d -62 Y f 0 0.4 0.8 c 867 1075 m 62 Y -20 15 d -62 Y f 0 0.6
- 0.8 c 867 1137 m 62 Y -20 16 d -63 Y f 0 0.8 0.8 c 867 1199 m 62 Y -20 16 d -62
- Y f 0 0.8 0.6 c 867 1261 m 62 Y -20 16 d -62 Y f 0 0.8 0.4 c 867 1323 m 63 Y
- -20 15 d -62 Y f 0 0.8 0.2 c 867 1386 m 62 Y -20 15 d -62 Y f 0 0.8 0 c 867
- 1448 m 62 Y -20 15 d -62 Y f 0.2 0.8 0 c 867 1510 m 59 Y -20 15 d -59 Y f black
- 847 966 m 20 -15 d 618 Y -20 15 d cl s 0.2 0.8 0 c 867 1569 m 24 6 d -21 15 d
- -23 -6 d f black 867 1569 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 844 945 m
- 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 867 1013 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c
- 867 1075 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c 867 1137 m 62 Y -23 -6 d -62 Y f 0
- 0.8 0.8 c 867 1199 m 62 Y -23 -6 d -62 Y f 0 0.8 0.6 c 867 1261 m 62 Y -23 -6 d
- -62 Y f 0 0.8 0.4 c 867 1323 m 63 Y -23 -6 d -63 Y f 0 0.8 0.2 c 867 1386 m 62
- Y -23 -6 d -62 Y f 0 0.8 0 c 867 1448 m 62 Y -23 -6 d -62 Y f 0.2 0.8 0 c 867
- 1510 m 45 Y -23 -6 d -45 Y f black 844 945 m 23 6 d 604 Y -23 -6 d cl s 0 0 0.8
- c 823 960 m 21 -15 d 62 Y -21 15 d f 0 0.2 0.8 c 844 1007 m 62 Y -21 15 d -62 Y
- f 0 0.4 0.8 c 844 1069 m 62 Y -21 16 d -63 Y f 0 0.6 0.8 c 844 1131 m 62 Y -21
- 16 d -62 Y f 0 0.8 0.8 c 844 1193 m 62 Y -21 16 d -62 Y f 0 0.8 0.6 c 844 1255
- m 62 Y -21 16 d -62 Y f 0 0.8 0.4 c 844 1317 m 63 Y -21 15 d -62 Y f 0 0.8 0.2
- c 844 1380 m 62 Y -21 15 d -62 Y f 0 0.8 0 c 844 1442 m 62 Y -21 15 d -62 Y f
- 0.2 0.8 0 c 844 1504 m 45 Y -21 16 d -46 Y f black 823 960 m 21 -15 d 604 Y -21
- 16 d cl s 0.2 0.8 0 c 844 1549 m 23 6 d -20 16 d -24 -6 d f black 844 1549 m 23
- 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 820 939 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8
- c 844 1007 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 844 1069 m 62 Y -24 -6 d -62 Y f
- 0 0.6 0.8 c 844 1131 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 844 1193 m 62 Y -24 -6
- d -62 Y f 0 0.8 0.6 c 844 1255 m 62 Y -24 -6 d -62 Y f 0 0.8 0.4 c 844 1317 m
- 63 Y -24 -6 d -63 Y f 0 0.8 0.2 c 844 1380 m 62 Y -24 -6 d -62 Y f 0 0.8 0 c
- 844 1442 m 62 Y -24 -6 d -62 Y f 0.2 0.8 0 c 844 1504 m 32 Y -24 -6 d -32 Y f
- black 820 939 m 24 6 d 591 Y -24 -6 d cl s 0 0 0.8 c 800 954 m 20 -15 d 62 Y
- -20 15 d f 0 0.2 0.8 c 820 1001 m 62 Y -20 15 d -62 Y f 0 0.4 0.8 c 820 1063 m
- 62 Y -20 16 d -63 Y f 0 0.6 0.8 c 820 1125 m 62 Y -20 16 d -62 Y f 0 0.8 0.8 c
- 820 1187 m 62 Y -20 16 d -62 Y f 0 0.8 0.6 c 820 1249 m 62 Y -20 16 d -62 Y f 0
- 0.8 0.4 c 820 1311 m 63 Y -20 15 d -62 Y f 0 0.8 0.2 c 820 1374 m 62 Y -20 15 d
- -62 Y f 0 0.8 0 c 820 1436 m 62 Y -20 15 d -62 Y f 0.2 0.8 0 c 820 1498 m 32 Y
- -20 15 d -32 Y f black 800 954 m 20 -15 d 591 Y -20 15 d cl s 0.2 0.8 0 c 820
- 1530 m 24 6 d -21 15 d -23 -6 d f black 820 1530 m 24 6 d -21 15 d -23 -6 d
- cl s 0 0 0.8 c 797 933 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 820 1001 m 62 Y -23
- -6 d -62 Y f 0 0.4 0.8 c 820 1063 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c 820 1125
- m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 820 1187 m 62 Y -23 -6 d -62 Y f 0 0.8 0.6
- c 820 1249 m 62 Y -23 -6 d -62 Y f 0 0.8 0.4 c 820 1311 m 63 Y -23 -6 d -63 Y f
- 0 0.8 0.2 c 820 1374 m 21 Y -23 -6 d -21 Y f black 797 933 m 23 6 d 456 Y -23
- -6 d cl s 0 0 0.8 c 776 948 m 21 -15 d 62 Y -21 15 d f 0 0.2 0.8 c 797 995 m 62
- Y -21 15 d -62 Y f 0 0.4 0.8 c 797 1057 m 62 Y -21 16 d -63 Y f 0 0.6 0.8 c 797
- 1119 m 62 Y -21 16 d -62 Y f 0 0.8 0.8 c 797 1181 m 62 Y -21 16 d -62 Y f 0 0.8
- 0.6 c 797 1243 m 62 Y -21 16 d -62 Y f 0 0.8 0.4 c 797 1305 m 63 Y -21 15 d -62
- Y f 0 0.8 0.2 c 797 1368 m 21 Y -21 16 d -22 Y f black 776 948 m 21 -15 d 456 Y
- -21 16 d cl s 0 0.8 0.2 c 797 1389 m 23 6 d -20 16 d -24 -6 d f black 797 1389
- m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 773 927 m 24 6 d 62 Y -24 -6 d f 0
- 0.2 0.8 c 797 995 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 797 1057 m 62 Y -24 -6 d
- -62 Y f 0 0.6 0.8 c 797 1119 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 797 1181 m 62
- Y -24 -6 d -62 Y f 0 0.8 0.6 c 797 1243 m 62 Y -24 -6 d -62 Y f 0 0.8 0.4 c 797
- 1305 m 63 Y -24 -6 d -63 Y f 0 0.8 0.2 c 797 1368 m 62 Y -24 -6 d -62 Y f 0 0.8
- 0 c 797 1430 m 62 Y -24 -6 d -62 Y f 0.2 0.8 0 c 797 1492 m 62 Y -24 -6 d -62 Y
- f 0.4 0.8 0 c 797 1554 m 62 Y -24 -6 d -62 Y f 0.6 0.8 0 c 797 1616 m 62 Y -24
- -6 d -62 Y f 0.8 0.8 0 c 797 1678 m 20 Y -24 -6 d -20 Y f black 773 927 m 24 6
- d 765 Y -24 -6 d cl s 0 0 0.8 c 753 942 m 20 -15 d 62 Y -20 15 d f 0 0.2 0.8 c
- 773 989 m 62 Y -20 15 d -62 Y f 0 0.4 0.8 c 773 1051 m 62 Y -20 16 d -63 Y f 0
- 0.6 0.8 c 773 1113 m 62 Y -20 16 d -62 Y f 0 0.8 0.8 c 773 1175 m 62 Y -20 16 d
- -62 Y f 0 0.8 0.6 c 773 1237 m 62 Y -20 16 d -62 Y f 0 0.8 0.4 c 773 1299 m 63
- Y -20 15 d -62 Y f 0 0.8 0.2 c 773 1362 m 62 Y -20 15 d -62 Y f 0 0.8 0 c 773
- 1424 m 62 Y -20 15 d -62 Y f 0.2 0.8 0 c 773 1486 m 62 Y -20 16 d -63 Y f 0.4
- 0.8 0 c 773 1548 m 62 Y -20 16 d -62 Y f 0.6 0.8 0 c 773 1610 m 62 Y -20 16 d
- -62 Y f 0.8 0.8 0 c 773 1672 m 20 Y -20 16 d -20 Y f black 753 942 m 20 -15 d
- 765 Y -20 16 d cl s 0.8 0.8 0 c 773 1692 m 24 6 d -21 16 d -23 -6 d f black 773
- 1692 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 750 921 m 23 6 d 62 Y -23 -6 d f
- 0 0.2 0.8 c 773 989 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 773 1051 m 62 Y -23 -6
- d -62 Y f 0 0.6 0.8 c 773 1113 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 773 1175 m
- 62 Y -23 -6 d -62 Y f 0 0.8 0.6 c 773 1237 m 62 Y -23 -6 d -62 Y f 0 0.8 0.4 c
- 773 1299 m 63 Y -23 -6 d -63 Y f 0 0.8 0.2 c 773 1362 m 62 Y -23 -6 d -62 Y f 0
- 0.8 0 c 773 1424 m 62 Y -23 -6 d -62 Y f 0.2 0.8 0 c 773 1486 m 62 Y -23 -6 d
- -62 Y f 0.4 0.8 0 c 773 1548 m 62 Y -23 -6 d -62 Y f 0.6 0.8 0 c 773 1610 m 2 Y
- -23 -6 d -2 Y f black 750 921 m 23 6 d 685 Y -23 -6 d cl s 0 0 0.8 c 729 936 m
- 21 -15 d 62 Y -21 15 d f 0 0.2 0.8 c 750 983 m 62 Y -21 15 d -62 Y f 0 0.4 0.8
- c 750 1045 m 62 Y -21 16 d -63 Y f 0 0.6 0.8 c 750 1107 m 62 Y -21 16 d -62 Y f
- 0 0.8 0.8 c 750 1169 m 62 Y -21 16 d -62 Y f 0 0.8 0.6 c 750 1231 m 62 Y -21 16
- d -62 Y f 0 0.8 0.4 c 750 1293 m 63 Y -21 15 d -62 Y f 0 0.8 0.2 c 750 1356 m
- 62 Y -21 15 d -62 Y f 0 0.8 0 c 750 1418 m 62 Y -21 15 d -62 Y f 0.2 0.8 0 c
- 750 1480 m 62 Y -21 16 d -63 Y f 0.4 0.8 0 c 750 1542 m 62 Y -21 16 d -62 Y f
- 0.6 0.8 0 c 750 1604 m 2 Y -21 15 d -1 Y f black 729 936 m 21 -15 d 685 Y -21
- 15 d cl s 0.6 0.8 0 c 750 1606 m 23 6 d -20 15 d -24 -6 d f black 750 1606 m 23
- 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 726 915 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8
- c 750 983 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 750 1045 m 62 Y -24 -6 d -62 Y f
- 0 0.6 0.8 c 750 1107 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 750 1169 m 62 Y -24 -6
- d -62 Y f 0 0.8 0.6 c 750 1231 m 62 Y -24 -6 d -62 Y f 0 0.8 0.4 c 750 1293 m
- 63 Y -24 -6 d -63 Y f 0 0.8 0.2 c 750 1356 m 62 Y -24 -6 d -62 Y f 0 0.8 0 c
- 750 1418 m 62 Y -24 -6 d -62 Y f 0.2 0.8 0 c 750 1480 m 32 Y -24 -6 d -32 Y f
- black 726 915 m 24 6 d 591 Y -24 -6 d cl s 0 0 0.8 c 706 930 m 20 -15 d 62 Y
- -20 15 d f 0 0.2 0.8 c 726 977 m 62 Y -20 15 d -62 Y f 0 0.4 0.8 c 726 1039 m
- 62 Y -20 16 d -63 Y f 0 0.6 0.8 c 726 1101 m 62 Y -20 16 d -62 Y f 0 0.8 0.8 c
- 726 1163 m 62 Y -20 16 d -62 Y f 0 0.8 0.6 c 726 1225 m 62 Y -20 16 d -62 Y f 0
- 0.8 0.4 c 726 1287 m 63 Y -20 15 d -62 Y f 0 0.8 0.2 c 726 1350 m 62 Y -20 15 d
- -62 Y f 0 0.8 0 c 726 1412 m 62 Y -20 15 d -62 Y f 0.2 0.8 0 c 726 1474 m 32 Y
- -20 15 d -32 Y f black 706 930 m 20 -15 d 591 Y -20 15 d cl s 0.2 0.8 0 c 726
- 1506 m 24 6 d -21 15 d -23 -6 d f black 726 1506 m 24 6 d -21 15 d -23 -6 d
- cl s 0 0 0.8 c 703 909 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 726 977 m 62 Y -23
- -6 d -62 Y f 0 0.4 0.8 c 726 1039 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c 726 1101
- m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 726 1163 m 62 Y -23 -6 d -62 Y f 0 0.8 0.6
- c 726 1225 m 62 Y -23 -5 d -63 Y f 0 0.8 0.4 c 726 1287 m 63 Y -23 -6 d -62 Y f
- 0 0.8 0.2 c 726 1350 m 62 Y -23 -6 d -62 Y f 0 0.8 0 c 726 1412 m 54 Y -23 -6 d
- -54 Y f black 703 909 m 23 6 d 551 Y -23 -6 d cl s 0 0 0.8 c 682 924 m 21 -15 d
- 62 Y -21 15 d f 0 0.2 0.8 c 703 971 m 62 Y -21 15 d -62 Y f 0 0.4 0.8 c 703
- 1033 m 62 Y -21 16 d -63 Y f 0 0.6 0.8 c 703 1095 m 62 Y -21 16 d -62 Y f 0 0.8
- 0.8 c 703 1157 m 62 Y -21 16 d -62 Y f 0 0.8 0.6 c 703 1219 m 63 Y -21 15 d -62
- Y f 0 0.8 0.4 c 703 1282 m 62 Y -21 15 d -62 Y f 0 0.8 0.2 c 703 1344 m 62 Y
- -21 15 d -62 Y f 0 0.8 0 c 703 1406 m 54 Y -21 15 d -54 Y f black 682 924 m 21
- -15 d 551 Y -21 15 d cl s 0 0.8 0 c 703 1460 m 23 6 d -20 15 d -24 -6 d f black
- 703 1460 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 679 903 m 24 6 d -21 15 d
- -23 -6 d f black 679 903 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 656 897 m 23
- 6 d -20 15 d -24 -6 d f black 656 897 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c
- 632 891 m 24 6 d -21 15 d -23 -6 d f black 632 891 m 24 6 d -21 15 d -23 -6 d
- cl s 0 0 0.8 c 609 885 m 23 6 d -20 15 d -24 -6 d f black 609 885 m 23 6 d -20
- 15 d -24 -6 d cl s 0 0 0.8 c 1733 1150 m 24 6 d -21 16 d -23 -6 d f black 1733
- 1150 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1710 1144 m 23 6 d -20 16 d -24
- -6 d f black 1710 1144 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1686 1138 m 24
- 6 d -21 16 d -23 -6 d f black 1686 1138 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8
- c 1663 1132 m 23 6 d -20 16 d -24 -6 d f black 1663 1132 m 23 6 d -20 16 d -24
- -6 d cl s 0 0 0.8 c 1639 1126 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1663 1194 m
- 63 Y -24 -6 d -63 Y f 0 0.4 0.8 c 1663 1257 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c
- 1663 1319 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 1663 1381 m 62 Y -24 -6 d -62 Y f
- 0 0.8 0.6 c 1663 1443 m 62 Y -24 -6 d -62 Y f 0 0.8 0.4 c 1663 1505 m 62 Y -24
- -6 d -62 Y f 0 0.8 0.2 c 1663 1567 m 62 Y -24 -6 d -62 Y f 0 0.8 0 c 1663 1629
- m 63 Y -24 -6 d -63 Y f 0.2 0.8 0 c 1663 1692 m 62 Y -24 -6 d -62 Y f 0.4 0.8 0
- c 1663 1754 m 10 Y -24 -6 d -10 Y f black 1639 1126 m 24 6 d 632 Y -24 -6 d
- cl s 0 0 0.8 c 1619 1142 m 20 -16 d 62 Y -20 16 d f 0 0.2 0.8 c 1639 1188 m 63
- Y -20 15 d -62 Y f 0 0.4 0.8 c 1639 1251 m 62 Y -20 15 d -62 Y f 0 0.6 0.8 c
- 1639 1313 m 62 Y -20 15 d -62 Y f 0 0.8 0.8 c 1639 1375 m 62 Y -20 16 d -63 Y f
- 0 0.8 0.6 c 1639 1437 m 62 Y -20 16 d -62 Y f 0 0.8 0.4 c 1639 1499 m 62 Y -20
- 16 d -62 Y f 0 0.8 0.2 c 1639 1561 m 62 Y -20 16 d -62 Y f 0 0.8 0 c 1639 1623
- m 63 Y -20 15 d -62 Y f 0.2 0.8 0 c 1639 1686 m 62 Y -20 15 d -62 Y f 0.4 0.8 0
- c 1639 1748 m 10 Y -20 15 d -10 Y f black 1619 1142 m 20 -16 d 632 Y -20 15 d
- cl s 0.4 0.8 0 c 1639 1758 m 24 6 d -21 15 d -23 -6 d f black 1639 1758 m 24 6
- d -21 15 d -23 -6 d cl s 0 0 0.8 c 1616 1120 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8
- c 1639 1188 m 63 Y -23 -6 d -63 Y f 0 0.4 0.8 c 1639 1251 m 62 Y -23 -6 d -62 Y
- f 0 0.6 0.8 c 1639 1313 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 1639 1375 m 62 Y
- -23 -6 d -62 Y f 0 0.8 0.6 c 1639 1437 m 62 Y -23 -6 d -62 Y f 0 0.8 0.4 c 1639
- 1499 m 62 Y -23 -6 d -62 Y f 0 0.8 0.2 c 1639 1561 m 62 Y -23 -6 d -62 Y f 0
- 0.8 0 c 1639 1623 m 54 Y -23 -6 d -54 Y f black 1616 1120 m 23 6 d 551 Y -23 -6
- d cl s 0 0 0.8 c 1595 1136 m 21 -16 d 62 Y -21 16 d f 0 0.2 0.8 c 1616 1182 m
- 63 Y -21 15 d -62 Y f 0 0.4 0.8 c 1616 1245 m 62 Y -21 15 d -62 Y f 0 0.6 0.8 c
- 1616 1307 m 62 Y -21 15 d -62 Y f 0 0.8 0.8 c 1616 1369 m 62 Y -21 16 d -63 Y f
- 0 0.8 0.6 c 1616 1431 m 62 Y -21 16 d -62 Y f 0 0.8 0.4 c 1616 1493 m 62 Y -21
- 16 d -62 Y f 0 0.8 0.2 c 1616 1555 m 62 Y -21 16 d -62 Y f 0 0.8 0 c 1616 1617
- m 54 Y -21 16 d -54 Y f black 1595 1136 m 21 -16 d 551 Y -21 16 d cl s 0 0.8 0
- c 1616 1671 m 23 6 d -20 16 d -24 -6 d f black 1616 1671 m 23 6 d -20 16 d -24
- -6 d cl s 0 0 0.8 c 1592 1114 m 24 6 d 62 Y -24 -5 d f 0 0.2 0.8 c 1616 1182 m
- 63 Y -24 -6 d -62 Y f 0 0.4 0.8 c 1616 1245 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c
- 1616 1307 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 1616 1369 m 62 Y -24 -6 d -62 Y f
- 0 0.8 0.6 c 1616 1431 m 62 Y -24 -6 d -62 Y f 0 0.8 0.4 c 1616 1493 m 57 Y -24
- -6 d -57 Y f black 1592 1114 m 24 6 d 430 Y -24 -6 d cl s 0 0 0.8 c 1572 1130 m
- 20 -16 d 63 Y -20 15 d f 0 0.2 0.8 c 1592 1177 m 62 Y -20 15 d -62 Y f 0 0.4
- 0.8 c 1592 1239 m 62 Y -20 15 d -62 Y f 0 0.6 0.8 c 1592 1301 m 62 Y -20 15 d
- -62 Y f 0 0.8 0.8 c 1592 1363 m 62 Y -20 16 d -63 Y f 0 0.8 0.6 c 1592 1425 m
- 62 Y -20 16 d -62 Y f 0 0.8 0.4 c 1592 1487 m 57 Y -20 16 d -57 Y f black 1572
- 1130 m 20 -16 d 430 Y -20 16 d cl s 0 0.8 0.4 c 1592 1544 m 24 6 d -21 16 d -23
- -6 d f black 1592 1544 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1569 1108 m 23
- 6 d 63 Y -23 -6 d f 0 0.2 0.8 c 1592 1177 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c
- 1592 1239 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c 1592 1301 m 62 Y -23 -6 d -62 Y f
- 0 0.8 0.8 c 1592 1363 m 62 Y -23 -6 d -62 Y f 0 0.8 0.6 c 1592 1425 m 62 Y -23
- -6 d -62 Y f 0 0.8 0.4 c 1592 1487 m 62 Y -23 -6 d -62 Y f 0 0.8 0.2 c 1592
- 1549 m 63 Y -23 -6 d -63 Y f 0 0.8 0 c 1592 1612 m 26 Y -23 -6 d -26 Y f black
- 1569 1108 m 23 6 d 524 Y -23 -6 d cl s 0 0 0.8 c 1548 1124 m 21 -16 d 63 Y -21
- 15 d f 0 0.2 0.8 c 1569 1171 m 62 Y -21 15 d -62 Y f 0 0.4 0.8 c 1569 1233 m 62
- Y -21 15 d -62 Y f 0 0.6 0.8 c 1569 1295 m 62 Y -21 16 d -63 Y f 0 0.8 0.8 c
- 1569 1357 m 62 Y -21 16 d -62 Y f 0 0.8 0.6 c 1569 1419 m 62 Y -21 16 d -62 Y f
- 0 0.8 0.4 c 1569 1481 m 62 Y -21 16 d -62 Y f 0 0.8 0.2 c 1569 1543 m 63 Y -21
- 15 d -62 Y f 0 0.8 0 c 1569 1606 m 26 Y -21 16 d -27 Y f black 1548 1124 m 21
- -16 d 524 Y -21 16 d cl s 0 0.8 0 c 1569 1632 m 23 6 d -20 16 d -24 -6 d f
- black 1569 1632 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1545 1102 m 24 6 d 63
- Y -24 -6 d f 0 0.2 0.8 c 1569 1171 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 1569
- 1233 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 1569 1295 m 62 Y -24 -6 d -62 Y f 0
- 0.8 0.8 c 1569 1357 m 62 Y -24 -6 d -62 Y f 0 0.8 0.6 c 1569 1419 m 62 Y -24 -6
- d -62 Y f 0 0.8 0.4 c 1569 1481 m 62 Y -24 -6 d -62 Y f 0 0.8 0.2 c 1569 1543 m
- 63 Y -24 -6 d -63 Y f 0 0.8 0 c 1569 1606 m 62 Y -24 -6 d -62 Y f 0.2 0.8 0 c
- 1569 1668 m 62 Y -24 -6 d -62 Y f 0.4 0.8 0 c 1569 1730 m 50 Y -24 -6 d -50 Y f
- black 1545 1102 m 24 6 d 672 Y -24 -6 d cl s 0 0 0.8 c 1525 1118 m 20 -16 d 63
- Y -20 15 d f 0 0.2 0.8 c 1545 1165 m 62 Y -20 15 d -62 Y f 0 0.4 0.8 c 1545
- 1227 m 62 Y -20 15 d -62 Y f 0 0.6 0.8 c 1545 1289 m 62 Y -20 16 d -63 Y f 0
- 0.8 0.8 c 1545 1351 m 62 Y -20 16 d -62 Y f 0 0.8 0.6 c 1545 1413 m 62 Y -20 16
- d -62 Y f 0 0.8 0.4 c 1545 1475 m 62 Y -20 16 d -62 Y f 0 0.8 0.2 c 1545 1537 m
- 63 Y -20 15 d -62 Y f 0 0.8 0 c 1545 1600 m 62 Y -20 15 d -62 Y f 0.2 0.8 0 c
- 1545 1662 m 62 Y -20 15 d -62 Y f 0.4 0.8 0 c 1545 1724 m 50 Y -20 16 d -51 Y f
- black 1525 1118 m 20 -16 d 672 Y -20 16 d cl s 0.4 0.8 0 c 1545 1774 m 24 6 d
- -21 16 d -23 -6 d f black 1545 1774 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c
- 1522 1096 m 23 6 d 63 Y -23 -6 d f 0 0.2 0.8 c 1545 1165 m 62 Y -23 -6 d -62 Y
- f 0 0.4 0.8 c 1545 1227 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c 1545 1289 m 62 Y
- -23 -6 d -62 Y f 0 0.8 0.8 c 1545 1351 m 62 Y -23 -6 d -62 Y f 0 0.8 0.6 c 1545
- 1413 m 62 Y -23 -6 d -62 Y f 0 0.8 0.4 c 1545 1475 m 62 Y -23 -6 d -62 Y f 0
- 0.8 0.2 c 1545 1537 m 63 Y -23 -6 d -63 Y f 0 0.8 0 c 1545 1600 m 53 Y -23 -6 d
- -53 Y f black 1522 1096 m 23 6 d 551 Y -23 -6 d cl s 0 0 0.8 c 1501 1112 m 21
- -16 d 63 Y -21 15 d f 0 0.2 0.8 c 1522 1159 m 62 Y -21 15 d -62 Y f 0 0.4 0.8 c
- 1522 1221 m 62 Y -21 15 d -62 Y f 0 0.6 0.8 c 1522 1283 m 62 Y -21 16 d -63 Y f
- 0 0.8 0.8 c 1522 1345 m 62 Y -21 16 d -62 Y f 0 0.8 0.6 c 1522 1407 m 62 Y -21
- 16 d -62 Y f 0 0.8 0.4 c 1522 1469 m 62 Y -21 16 d -62 Y f 0 0.8 0.2 c 1522
- 1531 m 63 Y -21 15 d -62 Y f 0 0.8 0 c 1522 1594 m 53 Y -21 16 d -54 Y f black
- 1501 1112 m 21 -16 d 551 Y -21 16 d cl s 0 0.8 0 c 1522 1647 m 23 6 d -20 16 d
- -24 -6 d f black 1522 1647 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1498 1090
- m 24 6 d 63 Y -24 -6 d f 0 0.2 0.8 c 1522 1159 m 62 Y -24 -6 d -62 Y f 0 0.4
- 0.8 c 1522 1221 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 1522 1283 m 62 Y -24 -6 d
- -62 Y f 0 0.8 0.8 c 1522 1345 m 62 Y -24 -6 d -62 Y f 0 0.8 0.6 c 1522 1407 m
- 52 Y -24 -6 d -52 Y f black 1498 1090 m 24 6 d 363 Y -24 -6 d cl s 0 0 0.8 c
- 1478 1106 m 20 -16 d 63 Y -20 15 d f 0 0.2 0.8 c 1498 1153 m 62 Y -20 15 d -62
- Y f 0 0.4 0.8 c 1498 1215 m 62 Y -20 15 d -62 Y f 0 0.6 0.8 c 1498 1277 m 62 Y
- -20 16 d -63 Y f 0 0.8 0.8 c 1498 1339 m 62 Y -20 16 d -62 Y f 0 0.8 0.6 c 1498
- 1401 m 52 Y -20 16 d -52 Y f black 1478 1106 m 20 -16 d 363 Y -20 16 d cl s 0
- 0.8 0.6 c 1498 1453 m 24 6 d -21 16 d -23 -6 d f black 1498 1453 m 24 6 d -21
- 16 d -23 -6 d cl s 0 0 0.8 c 1475 1084 m 23 6 d 63 Y -23 -6 d f 0 0.2 0.8 c
- 1498 1153 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 1498 1215 m 62 Y -23 -6 d -62 Y f
- 0 0.6 0.8 c 1498 1277 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 1498 1339 m 62 Y -23
- -6 d -62 Y f 0 0.8 0.6 c 1498 1401 m 62 Y -23 -6 d -62 Y f 0 0.8 0.4 c 1498
- 1463 m 62 Y -23 -6 d -62 Y f 0 0.8 0.2 c 1498 1525 m 63 Y -23 -6 d -63 Y f 0
- 0.8 0 c 1498 1588 m 40 Y -23 -6 d -40 Y f black 1475 1084 m 23 6 d 538 Y -23 -6
- d cl s 0 0 0.8 c 1454 1100 m 21 -16 d 63 Y -21 15 d f 0 0.2 0.8 c 1475 1147 m
- 62 Y -21 15 d -62 Y f 0 0.4 0.8 c 1475 1209 m 62 Y -21 15 d -62 Y f 0 0.6 0.8 c
- 1475 1271 m 62 Y -21 16 d -63 Y f 0 0.8 0.8 c 1475 1333 m 62 Y -21 16 d -62 Y f
- 0 0.8 0.6 c 1475 1395 m 62 Y -21 16 d -62 Y f 0 0.8 0.4 c 1475 1457 m 62 Y -21
- 16 d -62 Y f 0 0.8 0.2 c 1475 1519 m 63 Y -21 15 d -62 Y f 0 0.8 0 c 1475 1582
- m 40 Y -21 15 d -40 Y f black 1454 1100 m 21 -16 d 538 Y -21 15 d cl s 0 0.8 0
- c 1475 1622 m 23 6 d -20 15 d -24 -6 d f black 1475 1622 m 23 6 d -20 15 d -24
- -6 d cl s 0 0 0.8 c 1451 1079 m 24 5 d 63 Y -24 -6 d f 0 0.2 0.8 c 1475 1147 m
- 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 1475 1209 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c
- 1475 1271 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 1475 1333 m 62 Y -24 -6 d -62 Y f
- 0 0.8 0.6 c 1475 1395 m 62 Y -24 -6 d -62 Y f 0 0.8 0.4 c 1475 1457 m 62 Y -24
- -6 d -62 Y f 0 0.8 0.2 c 1475 1519 m 63 Y -24 -6 d -63 Y f 0 0.8 0 c 1475 1582
- m 62 Y -24 -6 d -62 Y f 0.2 0.8 0 c 1475 1644 m 45 Y -24 -6 d -45 Y f black
- 1451 1079 m 24 5 d 605 Y -24 -6 d cl s 0 0 0.8 c 1431 1094 m 20 -15 d 62 Y -20
- 15 d f 0 0.2 0.8 c 1451 1141 m 62 Y -20 15 d -62 Y f 0 0.4 0.8 c 1451 1203 m 62
- Y -20 15 d -62 Y f 0 0.6 0.8 c 1451 1265 m 62 Y -20 16 d -63 Y f 0 0.8 0.8 c
- 1451 1327 m 62 Y -20 16 d -62 Y f 0 0.8 0.6 c 1451 1389 m 62 Y -20 16 d -62 Y f
- 0 0.8 0.4 c 1451 1451 m 62 Y -20 16 d -62 Y f 0 0.8 0.2 c 1451 1513 m 63 Y -20
- 15 d -62 Y f 0 0.8 0 c 1451 1576 m 62 Y -20 15 d -62 Y f 0.2 0.8 0 c 1451 1638
- m 45 Y -20 16 d -46 Y f black 1431 1094 m 20 -15 d 604 Y -20 16 d cl s 0.2 0.8
- 0 c 1451 1683 m 24 6 d -21 16 d -23 -6 d f black 1451 1683 m 24 6 d -21 16 d
- -23 -6 d cl s 0 0 0.8 c 1428 1073 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 1451
- 1141 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 1451 1203 m 62 Y -23 -6 d -62 Y f 0
- 0.6 0.8 c 1451 1265 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 1451 1327 m 62 Y -23 -6
- d -62 Y f 0 0.8 0.6 c 1451 1389 m 62 Y -23 -6 d -62 Y f 0 0.8 0.4 c 1451 1451 m
- 62 Y -23 -5 d -63 Y f 0 0.8 0.2 c 1451 1513 m 36 Y -23 -6 d -35 Y f black 1428
- 1073 m 23 6 d 470 Y -23 -6 d cl s 0 0 0.8 c 1407 1088 m 21 -15 d 62 Y -21 15 d
- f 0 0.2 0.8 c 1428 1135 m 62 Y -21 15 d -62 Y f 0 0.4 0.8 c 1428 1197 m 62 Y
- -21 15 d -62 Y f 0 0.6 0.8 c 1428 1259 m 62 Y -21 16 d -63 Y f 0 0.8 0.8 c 1428
- 1321 m 62 Y -21 16 d -62 Y f 0 0.8 0.6 c 1428 1383 m 62 Y -21 16 d -62 Y f 0
- 0.8 0.4 c 1428 1445 m 63 Y -21 15 d -62 Y f 0 0.8 0.2 c 1428 1508 m 35 Y -21 15
- d -35 Y f black 1407 1088 m 21 -15 d 470 Y -21 15 d cl s 0 0.8 0.2 c 1428 1543
- m 23 6 d -20 15 d -24 -6 d f black 1428 1543 m 23 6 d -20 15 d -24 -6 d cl s 0
- 0 0.8 c 1404 1067 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1428 1135 m 62 Y -24 -6
- d -62 Y f 0 0.4 0.8 c 1428 1197 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 1428 1259 m
- 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 1428 1321 m 62 Y -24 -6 d -62 Y f 0 0.8 0.6 c
- 1428 1383 m 62 Y -24 -6 d -62 Y f 0 0.8 0.4 c 1428 1445 m 57 Y -24 -6 d -57 Y f
- black 1404 1067 m 24 6 d 429 Y -24 -6 d cl s 0 0 0.8 c 1384 1082 m 20 -15 d 62
- Y -20 15 d f 0 0.2 0.8 c 1404 1129 m 62 Y -20 15 d -62 Y f 0 0.4 0.8 c 1404
- 1191 m 62 Y -20 16 d -63 Y f 0 0.6 0.8 c 1404 1253 m 62 Y -20 16 d -62 Y f 0
- 0.8 0.8 c 1404 1315 m 62 Y -20 16 d -62 Y f 0 0.8 0.6 c 1404 1377 m 62 Y -20 16
- d -62 Y f 0 0.8 0.4 c 1404 1439 m 57 Y -20 16 d -57 Y f black 1384 1082 m 20
- -15 d 429 Y -20 16 d cl s 0 0.8 0.4 c 1404 1496 m 24 6 d -21 16 d -23 -6 d f
- black 1404 1496 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1381 1061 m 23 6 d 62
- Y -23 -6 d f 0 0.2 0.8 c 1404 1129 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 1404
- 1191 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c 1404 1253 m 62 Y -23 -6 d -62 Y f 0
- 0.8 0.8 c 1404 1315 m 62 Y -23 -6 d -62 Y f 0 0.8 0.6 c 1404 1377 m 62 Y -23 -6
- d -62 Y f 0 0.8 0.4 c 1404 1439 m 63 Y -23 -6 d -63 Y f 0 0.8 0.2 c 1404 1502 m
- 21 Y -23 -6 d -21 Y f black 1381 1061 m 23 6 d 456 Y -23 -6 d cl s 0 0 0.8 c
- 1360 1076 m 21 -15 d 62 Y -21 15 d f 0 0.2 0.8 c 1381 1123 m 62 Y -21 15 d -62
- Y f 0 0.4 0.8 c 1381 1185 m 62 Y -21 16 d -63 Y f 0 0.6 0.8 c 1381 1247 m 62 Y
- -21 16 d -62 Y f 0 0.8 0.8 c 1381 1309 m 62 Y -21 16 d -62 Y f 0 0.8 0.6 c 1381
- 1371 m 62 Y -21 16 d -62 Y f 0 0.8 0.4 c 1381 1433 m 63 Y -21 15 d -62 Y f 0
- 0.8 0.2 c 1381 1496 m 21 Y -21 16 d -22 Y f black 1360 1076 m 21 -15 d 456 Y
- -21 16 d cl s 0 0.8 0.2 c 1381 1517 m 23 6 d -20 16 d -24 -6 d f black 1381
- 1517 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1357 1055 m 24 6 d 62 Y -24 -6 d
- f 0 0.2 0.8 c 1381 1123 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 1381 1185 m 62 Y
- -24 -6 d -62 Y f 0 0.6 0.8 c 1381 1247 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 1381
- 1309 m 62 Y -24 -6 d -62 Y f 0 0.8 0.6 c 1381 1371 m 62 Y -24 -6 d -62 Y f 0
- 0.8 0.4 c 1381 1433 m 63 Y -24 -6 d -63 Y f 0 0.8 0.2 c 1381 1496 m 62 Y -24 -6
- d -62 Y f 0 0.8 0 c 1381 1558 m 40 Y -24 -6 d -40 Y f black 1357 1055 m 24 6 d
- 537 Y -24 -6 d cl s 0 0 0.8 c 1337 1070 m 20 -15 d 62 Y -20 15 d f 0 0.2 0.8 c
- 1357 1117 m 62 Y -20 15 d -62 Y f 0 0.4 0.8 c 1357 1179 m 62 Y -20 16 d -63 Y f
- 0 0.6 0.8 c 1357 1241 m 62 Y -20 16 d -62 Y f 0 0.8 0.8 c 1357 1303 m 62 Y -20
- 16 d -62 Y f 0 0.8 0.6 c 1357 1365 m 62 Y -20 16 d -62 Y f 0 0.8 0.4 c 1357
- 1427 m 63 Y -20 15 d -62 Y f 0 0.8 0.2 c 1357 1490 m 62 Y -20 15 d -62 Y f 0
- 0.8 0 c 1357 1552 m 40 Y -20 16 d -41 Y f black 1337 1070 m 20 -15 d 537 Y -20
- 16 d cl s 0 0.8 0 c 1357 1592 m 24 6 d -21 16 d -23 -6 d f black 1357 1592 m 24
- 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1334 1049 m 23 6 d 62 Y -23 -6 d f 0 0.2
- 0.8 c 1357 1117 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 1357 1179 m 62 Y -23 -6 d
- -62 Y f 0 0.6 0.8 c 1357 1241 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 1357 1303 m
- 62 Y -23 -6 d -62 Y f 0 0.8 0.6 c 1357 1365 m 62 Y -23 -6 d -62 Y f 0 0.8 0.4 c
- 1357 1427 m 63 Y -23 -6 d -63 Y f 0 0.8 0.2 c 1357 1490 m 21 Y -23 -6 d -21 Y f
- black 1334 1049 m 23 6 d 456 Y -23 -6 d cl s 0 0 0.8 c 1313 1064 m 21 -15 d 62
- Y -21 15 d f 0 0.2 0.8 c 1334 1111 m 62 Y -21 15 d -62 Y f 0 0.4 0.8 c 1334
- 1173 m 62 Y -21 16 d -63 Y f 0 0.6 0.8 c 1334 1235 m 62 Y -21 16 d -62 Y f 0
- 0.8 0.8 c 1334 1297 m 62 Y -21 16 d -62 Y f 0 0.8 0.6 c 1334 1359 m 62 Y -21 16
- d -62 Y f 0 0.8 0.4 c 1334 1421 m 63 Y -21 15 d -62 Y f 0 0.8 0.2 c 1334 1484 m
- 21 Y -21 16 d -22 Y f black 1313 1064 m 21 -15 d 456 Y -21 16 d cl s 0 0.8 0.2
- c 1334 1505 m 23 6 d -20 16 d -24 -6 d f black 1334 1505 m 23 6 d -20 16 d -24
- -6 d cl s 0 0 0.8 c 1310 1043 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1334 1111 m
- 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 1334 1173 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c
- 1334 1235 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 1334 1297 m 62 Y -24 -6 d -62 Y f
- 0 0.8 0.6 c 1334 1359 m 52 Y -24 -6 d -52 Y f black 1310 1043 m 24 6 d 362 Y
- -24 -6 d cl s 0 0 0.8 c 1290 1058 m 20 -15 d 62 Y -20 15 d f 0 0.2 0.8 c 1310
- 1105 m 62 Y -20 15 d -62 Y f 0 0.4 0.8 c 1310 1167 m 62 Y -20 16 d -63 Y f 0
- 0.6 0.8 c 1310 1229 m 62 Y -20 16 d -62 Y f 0 0.8 0.8 c 1310 1291 m 62 Y -20 16
- d -62 Y f 0 0.8 0.6 c 1310 1353 m 52 Y -20 16 d -52 Y f black 1290 1058 m 20
- -15 d 362 Y -20 16 d cl s 0 0.8 0.6 c 1310 1405 m 24 6 d -21 16 d -23 -6 d f
- black 1310 1405 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1287 1037 m 23 6 d 62
- Y -23 -6 d f 0 0.2 0.8 c 1310 1105 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 1310
- 1167 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c 1310 1229 m 62 Y -23 -6 d -62 Y f 0
- 0.8 0.8 c 1310 1291 m 62 Y -23 -6 d -62 Y f 0 0.8 0.6 c 1310 1353 m 62 Y -23 -6
- d -62 Y f 0 0.8 0.4 c 1310 1415 m 63 Y -23 -6 d -63 Y f 0 0.8 0.2 c 1310 1478 m
- 62 Y -23 -6 d -62 Y f 0 0.8 0 c 1310 1540 m 54 Y -23 -6 d -54 Y f black 1287
- 1037 m 23 6 d 551 Y -23 -6 d cl s 0 0 0.8 c 1266 1052 m 21 -15 d 62 Y -21 15 d
- f 0 0.2 0.8 c 1287 1099 m 62 Y -21 15 d -62 Y f 0 0.4 0.8 c 1287 1161 m 62 Y
- -21 16 d -63 Y f 0 0.6 0.8 c 1287 1223 m 62 Y -21 16 d -62 Y f 0 0.8 0.8 c 1287
- 1285 m 62 Y -21 16 d -62 Y f 0 0.8 0.6 c 1287 1347 m 62 Y -21 16 d -62 Y f 0
- 0.8 0.4 c 1287 1409 m 63 Y -21 15 d -62 Y f 0 0.8 0.2 c 1287 1472 m 62 Y -21 15
- d -62 Y f 0 0.8 0 c 1287 1534 m 54 Y -21 15 d -54 Y f black 1266 1052 m 21 -15
- d 551 Y -21 15 d cl s 0 0.8 0 c 1287 1588 m 23 6 d -20 15 d -24 -6 d f black
- 1287 1588 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1263 1031 m 24 6 d 62 Y -24
- -6 d f 0 0.2 0.8 c 1287 1099 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 1287 1161 m 62
- Y -24 -6 d -62 Y f 0 0.6 0.8 c 1287 1223 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c
- 1287 1285 m 62 Y -24 -6 d -62 Y f 0 0.8 0.6 c 1287 1347 m 62 Y -24 -5 d -63 Y f
- 0 0.8 0.4 c 1287 1409 m 63 Y -24 -6 d -62 Y f 0 0.8 0.2 c 1287 1472 m 62 Y -24
- -6 d -62 Y f black 1263 1031 m 24 6 d 497 Y -24 -6 d cl s 0 0 0.8 c 1243 1046 m
- 20 -15 d 62 Y -20 15 d f 0 0.2 0.8 c 1263 1093 m 62 Y -20 15 d -62 Y f 0 0.4
- 0.8 c 1263 1155 m 62 Y -20 16 d -63 Y f 0 0.6 0.8 c 1263 1217 m 62 Y -20 16 d
- -62 Y f 0 0.8 0.8 c 1263 1279 m 62 Y -20 16 d -62 Y f 0 0.8 0.6 c 1263 1341 m
- 63 Y -20 15 d -62 Y f 0 0.8 0.4 c 1263 1404 m 62 Y -20 15 d -62 Y f 0 0.8 0.2 c
- 1263 1466 m 62 Y -20 15 d -62 Y f black 1243 1046 m 20 -15 d 497 Y -20 15 d
- cl s 0 0.8 0.2 c 1263 1528 m 24 6 d -21 15 d -23 -6 d f 0 0.8 0 c 1263 1528 m
- 24 6 d -21 15 d -23 -6 d f black 1263 1528 m 24 6 d -21 15 d -23 -6 d cl s 0 0
- 0.8 c 1240 1025 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 1263 1093 m 62 Y -23 -6 d
- -62 Y f 0 0.4 0.8 c 1263 1155 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c 1263 1217 m
- 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 1263 1279 m 62 Y -23 -6 d -62 Y f 0 0.8 0.6 c
- 1263 1341 m 63 Y -23 -6 d -63 Y f 0 0.8 0.4 c 1263 1404 m 62 Y -23 -6 d -62 Y f
- 0 0.8 0.2 c 1263 1466 m 62 Y -23 -6 d -62 Y f black 1240 1025 m 23 6 d 497 Y
- -23 -6 d cl s 0 0 0.8 c 1220 1040 m 20 -15 d 62 Y -20 15 d f 0 0.2 0.8 c 1240
- 1087 m 62 Y -20 16 d -63 Y f 0 0.4 0.8 c 1240 1149 m 62 Y -20 16 d -62 Y f 0
- 0.6 0.8 c 1240 1211 m 62 Y -20 16 d -62 Y f 0 0.8 0.8 c 1240 1273 m 62 Y -20 16
- d -62 Y f 0 0.8 0.6 c 1240 1335 m 63 Y -20 15 d -62 Y f 0 0.8 0.4 c 1240 1398 m
- 62 Y -20 15 d -62 Y f 0 0.8 0.2 c 1240 1460 m 62 Y -20 15 d -62 Y f black 1220
- 1040 m 20 -15 d 497 Y -20 15 d cl s 0 0.8 0.2 c 1240 1522 m 23 6 d -20 15 d -23
- -6 d f 0 0.8 0 c 1240 1522 m 23 6 d -20 15 d -23 -6 d f black 1240 1522 m 23 6
- d -20 15 d -23 -6 d cl s 0 0 0.8 c 1216 1019 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8
- c 1240 1087 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 1240 1149 m 62 Y -24 -6 d -62 Y
- f 0 0.6 0.8 c 1240 1211 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 1240 1273 m 62 Y
- -24 -6 d -62 Y f 0 0.8 0.6 c 1240 1335 m 63 Y -24 -6 d -63 Y f 0 0.8 0.4 c 1240
- 1398 m 62 Y -24 -6 d -62 Y f 0 0.8 0.2 c 1240 1460 m 35 Y -24 -6 d -35 Y f
- black 1216 1019 m 24 6 d 470 Y -24 -6 d cl s 0 0 0.8 c 1196 1034 m 20 -15 d 62
- Y -20 15 d f 0 0.2 0.8 c 1216 1081 m 62 Y -20 16 d -63 Y f 0 0.4 0.8 c 1216
- 1143 m 62 Y -20 16 d -62 Y f 0 0.6 0.8 c 1216 1205 m 62 Y -20 16 d -62 Y f 0
- 0.8 0.8 c 1216 1267 m 62 Y -20 16 d -62 Y f 0 0.8 0.6 c 1216 1329 m 63 Y -20 15
- d -62 Y f 0 0.8 0.4 c 1216 1392 m 62 Y -20 15 d -62 Y f 0 0.8 0.2 c 1216 1454 m
- 35 Y -20 16 d -36 Y f black 1196 1034 m 20 -15 d 470 Y -20 16 d cl s 0 0.8 0.2
- c 1216 1489 m 24 6 d -20 15 d -24 -5 d f black 1216 1489 m 24 6 d -20 15 d -24
- -5 d cl s 0 0 0.8 c 1193 1013 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 1216 1081 m
- 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 1216 1143 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c
- 1216 1205 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 1216 1267 m 62 Y -23 -6 d -62 Y f
- 0 0.8 0.6 c 1216 1329 m 63 Y -23 -6 d -63 Y f 0 0.8 0.4 c 1216 1392 m 62 Y -23
- -6 d -62 Y f 0 0.8 0.2 c 1216 1454 m 62 Y -23 -6 d -62 Y f black 1193 1013 m 23
- 6 d 497 Y -23 -6 d cl s 0 0 0.8 c 1173 1028 m 20 -15 d 62 Y -20 15 d f 0 0.2
- 0.8 c 1193 1075 m 62 Y -20 16 d -63 Y f 0 0.4 0.8 c 1193 1137 m 62 Y -20 16 d
- -62 Y f 0 0.6 0.8 c 1193 1199 m 62 Y -20 16 d -62 Y f 0 0.8 0.8 c 1193 1261 m
- 62 Y -20 16 d -62 Y f 0 0.8 0.6 c 1193 1323 m 63 Y -20 15 d -62 Y f 0 0.8 0.4 c
- 1193 1386 m 62 Y -20 15 d -62 Y f 0 0.8 0.2 c 1193 1448 m 62 Y -20 15 d -62 Y f
- black 1173 1028 m 20 -15 d 497 Y -20 15 d cl s 0 0.8 0.2 c 1193 1510 m 23 6 d
- -20 15 d -23 -6 d f 0 0.8 0 c 1193 1510 m 23 6 d -20 15 d -23 -6 d f black 1193
- 1510 m 23 6 d -20 15 d -23 -6 d cl s 0 0 0.8 c 1169 1007 m 24 6 d 62 Y -24 -6 d
- f 0 0.2 0.8 c 1193 1075 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 1193 1137 m 62 Y
- -24 -6 d -62 Y f 0 0.6 0.8 c 1193 1199 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 1193
- 1261 m 62 Y -24 -6 d -62 Y f 0 0.8 0.6 c 1193 1323 m 63 Y -24 -6 d -63 Y f 0
- 0.8 0.4 c 1193 1386 m 57 Y -24 -6 d -57 Y f black 1169 1007 m 24 6 d 430 Y -24
- -6 d cl s 0 0 0.8 c 1149 1022 m 20 -15 d 62 Y -20 15 d f 0 0.2 0.8 c 1169 1069
- m 62 Y -20 16 d -63 Y f 0 0.4 0.8 c 1169 1131 m 62 Y -20 16 d -62 Y f 0 0.6 0.8
- c 1169 1193 m 62 Y -20 16 d -62 Y f 0 0.8 0.8 c 1169 1255 m 62 Y -20 16 d -62 Y
- f 0 0.8 0.6 c 1169 1317 m 63 Y -20 15 d -62 Y f 0 0.8 0.4 c 1169 1380 m 57 Y
- -20 15 d -57 Y f black 1149 1022 m 20 -15 d 430 Y -20 15 d cl s 0 0.8 0.4 c
- 1169 1437 m 24 6 d -20 15 d -24 -6 d f black 1169 1437 m 24 6 d -20 15 d -24 -6
- d cl s 0 0 0.8 c 1146 1001 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 1169 1069 m 62
- Y -23 -6 d -62 Y f 0 0.4 0.8 c 1169 1131 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c
- 1169 1193 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 1169 1255 m 62 Y -23 -6 d -62 Y f
- 0 0.8 0.6 c 1169 1317 m 63 Y -23 -6 d -63 Y f 0 0.8 0.4 c 1169 1380 m 62 Y -23
- -6 d -62 Y f 0 0.8 0.2 c 1169 1442 m 62 Y -23 -6 d -62 Y f black 1146 1001 m 23
- 6 d 497 Y -23 -6 d cl s 0 0 0.8 c 1126 1016 m 20 -15 d 62 Y -20 15 d f 0 0.2
- 0.8 c 1146 1063 m 62 Y -20 16 d -63 Y f 0 0.4 0.8 c 1146 1125 m 62 Y -20 16 d
- -62 Y f 0 0.6 0.8 c 1146 1187 m 62 Y -20 16 d -62 Y f 0 0.8 0.8 c 1146 1249 m
- 62 Y -20 16 d -62 Y f 0 0.8 0.6 c 1146 1311 m 63 Y -20 15 d -62 Y f 0 0.8 0.4 c
- 1146 1374 m 62 Y -20 15 d -62 Y f 0 0.8 0.2 c 1146 1436 m 62 Y -20 15 d -62 Y f
- black 1126 1016 m 20 -15 d 497 Y -20 15 d cl s 0 0.8 0.2 c 1146 1498 m 23 6 d
- -20 15 d -23 -6 d f 0 0.8 0 c 1146 1498 m 23 6 d -20 15 d -23 -6 d f black 1146
- 1498 m 23 6 d -20 15 d -23 -6 d cl s 0 0 0.8 c 1122 995 m 24 6 d 62 Y -24 -6 d
- f 0 0.2 0.8 c 1146 1063 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 1146 1125 m 62 Y
- -24 -6 d -62 Y f 0 0.6 0.8 c 1146 1187 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 1146
- 1249 m 62 Y -24 -6 d -62 Y f 0 0.8 0.6 c 1146 1311 m 53 Y -24 -6 d -53 Y f
- black 1122 995 m 24 6 d 363 Y -24 -6 d cl s 0 0 0.8 c 1102 1010 m 20 -15 d 62 Y
- -20 15 d f 0 0.2 0.8 c 1122 1057 m 62 Y -20 16 d -63 Y f 0 0.4 0.8 c 1122 1119
- m 62 Y -20 16 d -62 Y f 0 0.6 0.8 c 1122 1181 m 62 Y -20 16 d -62 Y f 0 0.8 0.8
- c 1122 1243 m 62 Y -20 16 d -62 Y f 0 0.8 0.6 c 1122 1305 m 53 Y -20 15 d -52 Y
- f black 1102 1010 m 20 -15 d 363 Y -20 15 d cl s 0 0.8 0.6 c 1122 1358 m 24 6 d
- -20 15 d -24 -6 d f black 1122 1358 m 24 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c
- 1099 989 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 1122 1057 m 62 Y -23 -6 d -62 Y f
- 0 0.4 0.8 c 1122 1119 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c 1122 1181 m 62 Y -23
- -6 d -62 Y f 0 0.8 0.8 c 1122 1243 m 62 Y -23 -5 d -63 Y f 0 0.8 0.6 c 1122
- 1305 m 63 Y -23 -6 d -62 Y f 0 0.8 0.4 c 1122 1368 m 62 Y -23 -6 d -62 Y f 0
- 0.8 0.2 c 1122 1430 m 22 Y -23 -6 d -22 Y f black 1099 989 m 23 6 d 457 Y -23
- -6 d cl s 0 0 0.8 c 1079 1004 m 20 -15 d 62 Y -20 15 d f 0 0.2 0.8 c 1099 1051
- m 62 Y -20 16 d -63 Y f 0 0.4 0.8 c 1099 1113 m 62 Y -20 16 d -62 Y f 0 0.6 0.8
- c 1099 1175 m 62 Y -20 16 d -62 Y f 0 0.8 0.8 c 1099 1237 m 63 Y -20 15 d -62 Y
- f 0 0.8 0.6 c 1099 1300 m 62 Y -20 15 d -62 Y f 0 0.8 0.4 c 1099 1362 m 62 Y
- -20 15 d -62 Y f 0 0.8 0.2 c 1099 1424 m 22 Y -20 15 d -22 Y f black 1079 1004
- m 20 -15 d 457 Y -20 15 d cl s 0 0.8 0.2 c 1099 1446 m 23 6 d -20 15 d -23 -6 d
- f black 1099 1446 m 23 6 d -20 15 d -23 -6 d cl s 0 0 0.8 c 1075 983 m 24 6 d
- 62 Y -24 -6 d f 0 0.2 0.8 c 1099 1051 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 1099
- 1113 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 1099 1175 m 62 Y -24 -6 d -62 Y f 0
- 0.8 0.8 c 1099 1237 m 63 Y -24 -6 d -63 Y f 0 0.8 0.6 c 1099 1300 m 62 Y -24 -6
- d -62 Y f 0 0.8 0.4 c 1099 1362 m 62 Y -24 -6 d -62 Y f 0 0.8 0.2 c 1099 1424 m
- 22 Y -24 -6 d -22 Y f black 1075 983 m 24 6 d 457 Y -24 -6 d cl s 0 0 0.8 c
- 1055 998 m 20 -15 d 62 Y -20 16 d f 0 0.2 0.8 c 1075 1045 m 62 Y -20 16 d -62 Y
- f 0 0.4 0.8 c 1075 1107 m 62 Y -20 16 d -62 Y f 0 0.6 0.8 c 1075 1169 m 62 Y
- -20 16 d -62 Y f 0 0.8 0.8 c 1075 1231 m 63 Y -20 15 d -62 Y f 0 0.8 0.6 c 1075
- 1294 m 62 Y -20 15 d -62 Y f 0 0.8 0.4 c 1075 1356 m 62 Y -20 15 d -62 Y f 0
- 0.8 0.2 c 1075 1418 m 22 Y -20 15 d -22 Y f black 1055 998 m 20 -15 d 457 Y -20
- 15 d cl s 0 0.8 0.2 c 1075 1440 m 24 6 d -20 15 d -24 -6 d f black 1075 1440 m
- 24 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1052 977 m 23 6 d 62 Y -23 -6 d f 0 0.2
- 0.8 c 1075 1045 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 1075 1107 m 62 Y -23 -6 d
- -62 Y f 0 0.6 0.8 c 1075 1169 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 1075 1231 m
- 63 Y -23 -6 d -63 Y f 0 0.8 0.6 c 1075 1294 m 62 Y -23 -6 d -62 Y f 0 0.8 0.4 c
- 1075 1356 m 62 Y -23 -6 d -62 Y f 0 0.8 0.2 c 1075 1418 m 62 Y -23 -6 d -62 Y f
- black 1052 977 m 23 6 d 497 Y -23 -6 d cl s 0 0 0.8 c 1032 992 m 20 -15 d 62 Y
- -20 16 d f 0 0.2 0.8 c 1052 1039 m 62 Y -20 16 d -62 Y f 0 0.4 0.8 c 1052 1101
- m 62 Y -20 16 d -62 Y f 0 0.6 0.8 c 1052 1163 m 62 Y -20 16 d -62 Y f 0 0.8 0.8
- c 1052 1225 m 63 Y -20 15 d -62 Y f 0 0.8 0.6 c 1052 1288 m 62 Y -20 15 d -62 Y
- f 0 0.8 0.4 c 1052 1350 m 62 Y -20 15 d -62 Y f 0 0.8 0.2 c 1052 1412 m 62 Y
- -20 16 d -63 Y f black 1032 992 m 20 -15 d 497 Y -20 16 d cl s 0 0.8 0.2 c 1052
- 1474 m 23 6 d -20 15 d -23 -5 d f 0 0.8 0 c 1052 1474 m 23 6 d -20 15 d -23 -5
- d f black 1052 1474 m 23 6 d -20 15 d -23 -5 d cl s 0 0 0.8 c 1028 971 m 24 6 d
- 62 Y -24 -6 d f 0 0.2 0.8 c 1052 1039 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 1052
- 1101 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 1052 1163 m 62 Y -24 -6 d -62 Y f 0
- 0.8 0.8 c 1052 1225 m 63 Y -24 -6 d -63 Y f 0 0.8 0.6 c 1052 1288 m 62 Y -24 -6
- d -62 Y f 0 0.8 0.4 c 1052 1350 m 62 Y -24 -6 d -62 Y f 0 0.8 0.2 c 1052 1412 m
- 62 Y -24 -6 d -62 Y f 0 0.8 0 c 1052 1474 m 62 Y -24 -6 d -62 Y f 0.2 0.8 0 c
- 1052 1536 m 62 Y -24 -6 d -62 Y f 0.4 0.8 0 c 1052 1598 m 10 Y -24 -6 d -10 Y f
- black 1028 971 m 24 6 d 631 Y -24 -6 d cl s 0 0 0.8 c 1008 986 m 20 -15 d 62 Y
- -20 16 d f 0 0.2 0.8 c 1028 1033 m 62 Y -20 16 d -62 Y f 0 0.4 0.8 c 1028 1095
- m 62 Y -20 16 d -62 Y f 0 0.6 0.8 c 1028 1157 m 62 Y -20 16 d -62 Y f 0 0.8 0.8
- c 1028 1219 m 63 Y -20 15 d -62 Y f 0 0.8 0.6 c 1028 1282 m 62 Y -20 15 d -62 Y
- f 0 0.8 0.4 c 1028 1344 m 62 Y -20 15 d -62 Y f 0 0.8 0.2 c 1028 1406 m 62 Y
- -20 16 d -63 Y f 0 0.8 0 c 1028 1468 m 62 Y -20 16 d -62 Y f 0.2 0.8 0 c 1028
- 1530 m 62 Y -20 16 d -62 Y f 0.4 0.8 0 c 1028 1592 m 10 Y -20 16 d -10 Y f
- black 1008 986 m 20 -15 d 631 Y -20 16 d cl s 0.4 0.8 0 c 1028 1602 m 24 6 d
- -20 16 d -24 -6 d f black 1028 1602 m 24 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c
- 1005 965 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 1028 1033 m 62 Y -23 -6 d -62 Y f
- 0 0.4 0.8 c 1028 1095 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c 1028 1157 m 62 Y -23
- -6 d -62 Y f 0 0.8 0.8 c 1028 1219 m 63 Y -23 -6 d -63 Y f 0 0.8 0.6 c 1028
- 1282 m 62 Y -23 -6 d -62 Y f 0 0.8 0.4 c 1028 1344 m 62 Y -23 -6 d -62 Y f 0
- 0.8 0.2 c 1028 1406 m 62 Y -23 -6 d -62 Y f black 1005 965 m 23 6 d 497 Y -23
- -6 d cl s 0 0 0.8 c 985 980 m 20 -15 d 62 Y -20 16 d f 0 0.2 0.8 c 1005 1027 m
- 62 Y -20 16 d -62 Y f 0 0.4 0.8 c 1005 1089 m 62 Y -20 16 d -62 Y f 0 0.6 0.8 c
- 1005 1151 m 62 Y -20 16 d -62 Y f 0 0.8 0.8 c 1005 1213 m 63 Y -20 15 d -62 Y f
- 0 0.8 0.6 c 1005 1276 m 62 Y -20 15 d -62 Y f 0 0.8 0.4 c 1005 1338 m 62 Y -20
- 15 d -62 Y f 0 0.8 0.2 c 1005 1400 m 62 Y -20 16 d -63 Y f black 985 980 m 20
- -15 d 497 Y -20 16 d cl s 0 0.8 0.2 c 1005 1462 m 23 6 d -20 16 d -23 -6 d f 0
- 0.8 0 c 1005 1462 m 23 6 d -20 16 d -23 -6 d f black 1005 1462 m 23 6 d -20 16
- d -23 -6 d cl s 0 0 0.8 c 981 959 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1005
- 1027 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 1005 1089 m 62 Y -24 -6 d -62 Y f 0
- 0.6 0.8 c 1005 1151 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 1005 1213 m 63 Y -24 -6
- d -63 Y f 0 0.8 0.6 c 1005 1276 m 62 Y -24 -6 d -62 Y f 0 0.8 0.4 c 1005 1338 m
- 62 Y -24 -6 d -62 Y f 0 0.8 0.2 c 1005 1400 m 62 Y -24 -6 d -62 Y f 0 0.8 0 c
- 1005 1462 m 40 Y -24 -6 d -40 Y f black 981 959 m 24 6 d 537 Y -24 -6 d cl s 0
- 0 0.8 c 961 974 m 20 -15 d 62 Y -20 16 d f 0 0.2 0.8 c 981 1021 m 62 Y -20 16 d
- -62 Y f 0 0.4 0.8 c 981 1083 m 62 Y -20 16 d -62 Y f 0 0.6 0.8 c 981 1145 m 62
- Y -20 16 d -62 Y f 0 0.8 0.8 c 981 1207 m 63 Y -20 15 d -62 Y f 0 0.8 0.6 c 981
- 1270 m 62 Y -20 15 d -62 Y f 0 0.8 0.4 c 981 1332 m 62 Y -20 15 d -62 Y f 0 0.8
- 0.2 c 981 1394 m 62 Y -20 16 d -63 Y f 0 0.8 0 c 981 1456 m 40 Y -20 16 d -40 Y
- f black 961 974 m 20 -15 d 537 Y -20 16 d cl s 0 0.8 0 c 981 1496 m 24 6 d -20
- 16 d -24 -6 d f black 981 1496 m 24 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 958
- 953 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 981 1021 m 62 Y -23 -6 d -62 Y f 0 0.4
- 0.8 c 981 1083 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c 981 1145 m 62 Y -23 -6 d -62
- Y f 0 0.8 0.8 c 981 1207 m 63 Y -23 -6 d -63 Y f 0 0.8 0.6 c 981 1270 m 62 Y
- -23 -6 d -62 Y f 0 0.8 0.4 c 981 1332 m 17 Y -23 -6 d -17 Y f black 958 953 m
- 23 6 d 390 Y -23 -6 d cl s 0 0 0.8 c 938 968 m 20 -15 d 62 Y -20 16 d f 0 0.2
- 0.8 c 958 1015 m 62 Y -20 16 d -62 Y f 0 0.4 0.8 c 958 1077 m 62 Y -20 16 d -62
- Y f 0 0.6 0.8 c 958 1139 m 62 Y -20 16 d -62 Y f 0 0.8 0.8 c 958 1201 m 63 Y
- -20 15 d -62 Y f 0 0.8 0.6 c 958 1264 m 62 Y -20 15 d -62 Y f 0 0.8 0.4 c 958
- 1326 m 17 Y -20 15 d -17 Y f black 938 968 m 20 -15 d 390 Y -20 15 d cl s 0 0.8
- 0.4 c 958 1343 m 23 6 d -20 15 d -23 -6 d f black 958 1343 m 23 6 d -20 15 d
- -23 -6 d cl s 0 0 0.8 c 935 947 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 958 1015 m
- 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 958 1077 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c
- 958 1139 m 62 Y -23 -5 d -63 Y f 0 0.8 0.8 c 958 1201 m 63 Y -23 -6 d -62 Y f 0
- 0.8 0.6 c 958 1264 m 62 Y -23 -6 d -62 Y f 0 0.8 0.4 c 958 1326 m 62 Y -23 -6 d
- -62 Y f 0 0.8 0.2 c 958 1388 m 22 Y -23 -6 d -22 Y f black 935 947 m 23 6 d 457
- Y -23 -6 d cl s 0 0 0.8 c 914 962 m 21 -15 d 62 Y -21 16 d f 0 0.2 0.8 c 935
- 1009 m 62 Y -21 16 d -62 Y f 0 0.4 0.8 c 935 1071 m 62 Y -21 16 d -62 Y f 0 0.6
- 0.8 c 935 1133 m 63 Y -21 15 d -62 Y f 0 0.8 0.8 c 935 1196 m 62 Y -21 15 d -62
- Y f 0 0.8 0.6 c 935 1258 m 62 Y -21 15 d -62 Y f 0 0.8 0.4 c 935 1320 m 62 Y
- -21 15 d -62 Y f 0 0.8 0.2 c 935 1382 m 22 Y -21 15 d -22 Y f black 914 962 m
- 21 -15 d 457 Y -21 15 d cl s 0 0.8 0.2 c 935 1404 m 23 6 d -20 15 d -24 -6 d f
- black 935 1404 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 911 941 m 24 6 d 62 Y
- -24 -6 d f 0 0.2 0.8 c 935 1009 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 935 1071 m
- 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 935 1133 m 63 Y -24 -6 d -63 Y f 0 0.8 0.8 c
- 935 1196 m 62 Y -24 -6 d -62 Y f 0 0.8 0.6 c 935 1258 m 62 Y -24 -6 d -62 Y f 0
- 0.8 0.4 c 935 1320 m 62 Y -24 -6 d -62 Y f 0 0.8 0.2 c 935 1382 m 62 Y -24 -6 d
- -62 Y f 0 0.8 0 c 935 1444 m 54 Y -24 -6 d -54 Y f black 911 941 m 24 6 d 551 Y
- -24 -6 d cl s 0 0 0.8 c 891 957 m 20 -16 d 62 Y -20 16 d f 0 0.2 0.8 c 911 1003
- m 62 Y -20 16 d -62 Y f 0 0.4 0.8 c 911 1065 m 62 Y -20 16 d -62 Y f 0 0.6 0.8
- c 911 1127 m 63 Y -20 15 d -62 Y f 0 0.8 0.8 c 911 1190 m 62 Y -20 15 d -62 Y f
- 0 0.8 0.6 c 911 1252 m 62 Y -20 15 d -62 Y f 0 0.8 0.4 c 911 1314 m 62 Y -20 15
- d -62 Y f 0 0.8 0.2 c 911 1376 m 62 Y -20 16 d -63 Y f 0 0.8 0 c 911 1438 m 54
- Y -20 15 d -53 Y f black 891 957 m 20 -16 d 551 Y -20 15 d cl s 0 0.8 0 c 911
- 1492 m 24 6 d -21 15 d -23 -6 d f black 911 1492 m 24 6 d -21 15 d -23 -6 d
- cl s 0 0 0.8 c 888 935 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 911 1003 m 62 Y -23
- -6 d -62 Y f 0 0.4 0.8 c 911 1065 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c 911 1127
- m 63 Y -23 -6 d -63 Y f 0 0.8 0.8 c 911 1190 m 62 Y -23 -6 d -62 Y f 0 0.8 0.6
- c 911 1252 m 62 Y -23 -6 d -62 Y f 0 0.8 0.4 c 911 1314 m 62 Y -23 -6 d -62 Y f
- 0 0.8 0.2 c 911 1376 m 62 Y -23 -6 d -62 Y f 0 0.8 0 c 911 1438 m 27 Y -23 -6 d
- -27 Y f black 888 935 m 23 6 d 524 Y -23 -6 d cl s 0 0 0.8 c 867 951 m 21 -16 d
- 62 Y -21 16 d f 0 0.2 0.8 c 888 997 m 62 Y -21 16 d -62 Y f 0 0.4 0.8 c 888
- 1059 m 62 Y -21 16 d -62 Y f 0 0.6 0.8 c 888 1121 m 63 Y -21 15 d -62 Y f 0 0.8
- 0.8 c 888 1184 m 62 Y -21 15 d -62 Y f 0 0.8 0.6 c 888 1246 m 62 Y -21 15 d -62
- Y f 0 0.8 0.4 c 888 1308 m 62 Y -21 16 d -63 Y f 0 0.8 0.2 c 888 1370 m 62 Y
- -21 16 d -62 Y f 0 0.8 0 c 888 1432 m 27 Y -21 16 d -27 Y f black 867 951 m 21
- -16 d 524 Y -21 16 d cl s 0 0.8 0 c 888 1459 m 23 6 d -20 16 d -24 -6 d f black
- 888 1459 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 864 929 m 24 6 d 62 Y -24 -6
- d f 0 0.2 0.8 c 888 997 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 888 1059 m 62 Y -24
- -6 d -62 Y f 0 0.6 0.8 c 888 1121 m 63 Y -24 -6 d -63 Y f 0 0.8 0.8 c 888 1184
- m 62 Y -24 -6 d -62 Y f 0 0.8 0.6 c 888 1246 m 62 Y -24 -6 d -62 Y f 0 0.8 0.4
- c 888 1308 m 57 Y -24 -6 d -57 Y f black 864 929 m 24 6 d 430 Y -24 -6 d cl s 0
- 0 0.8 c 844 945 m 20 -16 d 62 Y -20 16 d f 0 0.2 0.8 c 864 991 m 62 Y -20 16 d
- -62 Y f 0 0.4 0.8 c 864 1053 m 62 Y -20 16 d -62 Y f 0 0.6 0.8 c 864 1115 m 63
- Y -20 15 d -62 Y f 0 0.8 0.8 c 864 1178 m 62 Y -20 15 d -62 Y f 0 0.8 0.6 c 864
- 1240 m 62 Y -20 15 d -62 Y f 0 0.8 0.4 c 864 1302 m 57 Y -20 15 d -57 Y f black
- 844 945 m 20 -16 d 430 Y -20 15 d cl s 0 0.8 0.4 c 864 1359 m 24 6 d -21 15 d
- -23 -6 d f black 864 1359 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 841 923 m
- 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 864 991 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c
- 864 1053 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c 864 1115 m 63 Y -23 -6 d -63 Y f 0
- 0.8 0.8 c 864 1178 m 62 Y -23 -6 d -62 Y f 0 0.8 0.6 c 864 1240 m 62 Y -23 -6 d
- -62 Y f 0 0.8 0.4 c 864 1302 m 62 Y -23 -6 d -62 Y f 0 0.8 0.2 c 864 1364 m 62
- Y -23 -6 d -62 Y f 0 0.8 0 c 864 1426 m 54 Y -23 -6 d -54 Y f black 841 923 m
- 23 6 d 551 Y -23 -6 d cl s 0 0 0.8 c 820 939 m 21 -16 d 62 Y -21 16 d f 0 0.2
- 0.8 c 841 985 m 62 Y -21 16 d -62 Y f 0 0.4 0.8 c 841 1047 m 62 Y -21 16 d -62
- Y f 0 0.6 0.8 c 841 1109 m 63 Y -21 15 d -62 Y f 0 0.8 0.8 c 841 1172 m 62 Y
- -21 15 d -62 Y f 0 0.8 0.6 c 841 1234 m 62 Y -21 15 d -62 Y f 0 0.8 0.4 c 841
- 1296 m 62 Y -21 16 d -63 Y f 0 0.8 0.2 c 841 1358 m 62 Y -21 16 d -62 Y f 0 0.8
- 0 c 841 1420 m 54 Y -21 15 d -53 Y f black 820 939 m 21 -16 d 551 Y -21 15 d
- cl s 0 0.8 0 c 841 1474 m 23 6 d -20 15 d -24 -6 d f black 841 1474 m 23 6 d
- -20 15 d -24 -6 d cl s 0 0 0.8 c 817 917 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c
- 841 985 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 841 1047 m 62 Y -24 -6 d -62 Y f 0
- 0.6 0.8 c 841 1109 m 63 Y -24 -6 d -63 Y f 0 0.8 0.8 c 841 1172 m 62 Y -24 -6 d
- -62 Y f 0 0.8 0.6 c 841 1234 m 62 Y -24 -6 d -62 Y f 0 0.8 0.4 c 841 1296 m 62
- Y -24 -6 d -62 Y f 0 0.8 0.2 c 841 1358 m 62 Y -24 -6 d -62 Y f 0 0.8 0 c 841
- 1420 m 27 Y -24 -6 d -27 Y f black 817 917 m 24 6 d 524 Y -24 -6 d cl s 0 0 0.8
- c 797 933 m 20 -16 d 62 Y -20 16 d f 0 0.2 0.8 c 817 979 m 62 Y -20 16 d -62 Y
- f 0 0.4 0.8 c 817 1041 m 62 Y -20 16 d -62 Y f 0 0.6 0.8 c 817 1103 m 63 Y -20
- 15 d -62 Y f 0 0.8 0.8 c 817 1166 m 62 Y -20 15 d -62 Y f 0 0.8 0.6 c 817 1228
- m 62 Y -20 15 d -62 Y f 0 0.8 0.4 c 817 1290 m 62 Y -20 16 d -63 Y f 0 0.8 0.2
- c 817 1352 m 62 Y -20 16 d -62 Y f 0 0.8 0 c 817 1414 m 27 Y -20 16 d -27 Y f
- black 797 933 m 20 -16 d 524 Y -20 16 d cl s 0 0.8 0 c 817 1441 m 24 6 d -21 16
- d -23 -6 d f black 817 1441 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 794 911 m
- 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 817 979 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c
- 817 1041 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c 817 1103 m 63 Y -23 -6 d -63 Y f 0
- 0.8 0.8 c 817 1166 m 62 Y -23 -6 d -62 Y f 0 0.8 0.6 c 817 1228 m 62 Y -23 -6 d
- -62 Y f 0 0.8 0.4 c 817 1290 m 62 Y -23 -6 d -62 Y f 0 0.8 0.2 c 817 1352 m 35
- Y -23 -6 d -35 Y f black 794 911 m 23 6 d 470 Y -23 -6 d cl s 0 0 0.8 c 773 927
- m 21 -16 d 62 Y -21 16 d f 0 0.2 0.8 c 794 973 m 62 Y -21 16 d -62 Y f 0 0.4
- 0.8 c 794 1035 m 62 Y -21 16 d -62 Y f 0 0.6 0.8 c 794 1097 m 63 Y -21 15 d -62
- Y f 0 0.8 0.8 c 794 1160 m 62 Y -21 15 d -62 Y f 0 0.8 0.6 c 794 1222 m 62 Y
- -21 15 d -62 Y f 0 0.8 0.4 c 794 1284 m 62 Y -21 16 d -63 Y f 0 0.8 0.2 c 794
- 1346 m 35 Y -21 16 d -35 Y f black 773 927 m 21 -16 d 470 Y -21 16 d cl s 0 0.8
- 0.2 c 794 1381 m 23 6 d -20 16 d -24 -6 d f black 794 1381 m 23 6 d -20 16 d
- -24 -6 d cl s 0 0 0.8 c 770 905 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 794 973 m
- 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 794 1035 m 62 Y -24 -5 d -63 Y f 0 0.6 0.8 c
- 794 1097 m 63 Y -24 -6 d -62 Y f 0 0.8 0.8 c 794 1160 m 62 Y -24 -6 d -62 Y f 0
- 0.8 0.6 c 794 1222 m 62 Y -24 -6 d -62 Y f 0 0.8 0.4 c 794 1284 m 57 Y -24 -6 d
- -57 Y f black 770 905 m 24 6 d 430 Y -24 -6 d cl s 0 0 0.8 c 750 921 m 20 -16 d
- 62 Y -20 16 d f 0 0.2 0.8 c 770 967 m 62 Y -20 16 d -62 Y f 0 0.4 0.8 c 770
- 1029 m 63 Y -20 15 d -62 Y f 0 0.6 0.8 c 770 1092 m 62 Y -20 15 d -62 Y f 0 0.8
- 0.8 c 770 1154 m 62 Y -20 15 d -62 Y f 0 0.8 0.6 c 770 1216 m 62 Y -20 15 d -62
- Y f 0 0.8 0.4 c 770 1278 m 57 Y -20 16 d -58 Y f black 750 921 m 20 -16 d 430 Y
- -20 16 d cl s 0 0.8 0.4 c 770 1335 m 24 6 d -21 16 d -23 -6 d f black 770 1335
- m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 747 899 m 23 6 d 62 Y -23 -6 d f 0
- 0.2 0.8 c 770 967 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 770 1029 m 63 Y -23 -6 d
- -63 Y f 0 0.6 0.8 c 770 1092 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 770 1154 m 62
- Y -23 -6 d -62 Y f 0 0.8 0.6 c 770 1216 m 62 Y -23 -6 d -62 Y f 0 0.8 0.4 c 770
- 1278 m 62 Y -23 -6 d -62 Y f 0 0.8 0.2 c 770 1340 m 62 Y -23 -6 d -62 Y f 0 0.8
- 0 c 770 1402 m 62 Y -23 -6 d -62 Y f 0.2 0.8 0 c 770 1464 m 5 Y -23 -6 d -5 Y f
- black 747 899 m 23 6 d 564 Y -23 -6 d cl s 0 0 0.8 c 726 915 m 21 -16 d 62 Y
- -21 16 d f 0 0.2 0.8 c 747 961 m 62 Y -21 16 d -62 Y f 0 0.4 0.8 c 747 1023 m
- 63 Y -21 15 d -62 Y f 0 0.6 0.8 c 747 1086 m 62 Y -21 15 d -62 Y f 0 0.8 0.8 c
- 747 1148 m 62 Y -21 15 d -62 Y f 0 0.8 0.6 c 747 1210 m 62 Y -21 15 d -62 Y f 0
- 0.8 0.4 c 747 1272 m 62 Y -21 16 d -63 Y f 0 0.8 0.2 c 747 1334 m 62 Y -21 16 d
- -62 Y f 0 0.8 0 c 747 1396 m 62 Y -21 16 d -62 Y f 0.2 0.8 0 c 747 1458 m 5 Y
- -21 16 d -5 Y f black 726 915 m 21 -16 d 564 Y -21 16 d cl s 0.2 0.8 0 c 747
- 1463 m 23 6 d -20 16 d -24 -6 d f black 747 1463 m 23 6 d -20 16 d -24 -6 d
- cl s 0 0 0.8 c 723 893 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 747 961 m 62 Y -24
- -6 d -62 Y f 0 0.4 0.8 c 747 1023 m 63 Y -24 -6 d -63 Y f 0 0.6 0.8 c 747 1086
- m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 747 1148 m 62 Y -24 -6 d -62 Y f 0 0.8 0.6
- c 747 1210 m 62 Y -24 -6 d -62 Y f 0 0.8 0.4 c 747 1272 m 62 Y -24 -6 d -62 Y f
- 0 0.8 0.2 c 747 1334 m 49 Y -24 -6 d -49 Y f black 723 893 m 24 6 d 484 Y -24
- -6 d cl s 0 0 0.8 c 703 909 m 20 -16 d 62 Y -20 16 d f 0 0.2 0.8 c 723 955 m 62
- Y -20 16 d -62 Y f 0 0.4 0.8 c 723 1017 m 63 Y -20 15 d -62 Y f 0 0.6 0.8 c 723
- 1080 m 62 Y -20 15 d -62 Y f 0 0.8 0.8 c 723 1142 m 62 Y -20 15 d -62 Y f 0 0.8
- 0.6 c 723 1204 m 62 Y -20 16 d -63 Y f 0 0.8 0.4 c 723 1266 m 62 Y -20 16 d -62
- Y f 0 0.8 0.2 c 723 1328 m 49 Y -20 15 d -48 Y f black 703 909 m 20 -16 d 484 Y
- -20 15 d cl s 0 0.8 0.2 c 723 1377 m 24 6 d -21 15 d -23 -6 d f black 723 1377
- m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 700 887 m 23 6 d -20 16 d -24 -6 d f
- black 700 887 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 676 881 m 24 6 d -21 16
- d -23 -6 d f black 676 881 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 653 875 m
- 23 6 d -20 16 d -24 -6 d f black 653 875 m 23 6 d -20 16 d -24 -6 d cl s 0 0
- 0.8 c 629 869 m 24 6 d -21 16 d -23 -6 d f black 629 869 m 24 6 d -21 16 d -23
- -6 d cl s 0 0 0.8 c 1753 1135 m 24 6 d -20 15 d -24 -6 d f black 1753 1135 m 24
- 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1730 1129 m 23 6 d -20 15 d -23 -6 d f
- black 1730 1129 m 23 6 d -20 15 d -23 -6 d cl s 0 0 0.8 c 1706 1123 m 24 6 d
- -20 15 d -24 -6 d f black 1706 1123 m 24 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c
- 1683 1117 m 23 6 d -20 15 d -23 -6 d f black 1683 1117 m 23 6 d -20 15 d -23 -6
- d cl s 0 0 0.8 c 1660 1111 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 1683 1179 m 62
- Y -23 -6 d -62 Y f 0 0.4 0.8 c 1683 1241 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c
- 1683 1303 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 1683 1365 m 62 Y -23 -5 d -63 Y f
- 0 0.8 0.6 c 1683 1427 m 63 Y -23 -6 d -62 Y f 0 0.8 0.4 c 1683 1490 m 30 Y -23
- -6 d -30 Y f black 1660 1111 m 23 6 d 403 Y -23 -6 d cl s 0 0 0.8 c 1639 1126 m
- 21 -15 d 62 Y -21 15 d f 0 0.2 0.8 c 1660 1173 m 62 Y -21 16 d -63 Y f 0 0.4
- 0.8 c 1660 1235 m 62 Y -21 16 d -62 Y f 0 0.6 0.8 c 1660 1297 m 62 Y -21 16 d
- -62 Y f 0 0.8 0.8 c 1660 1359 m 63 Y -21 15 d -62 Y f 0 0.8 0.6 c 1660 1422 m
- 62 Y -21 15 d -62 Y f 0 0.8 0.4 c 1660 1484 m 30 Y -21 15 d -30 Y f black 1639
- 1126 m 21 -15 d 403 Y -21 15 d cl s 0 0.8 0.4 c 1660 1514 m 23 6 d -20 15 d -24
- -6 d f black 1660 1514 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1636 1105 m 24
- 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1660 1173 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c
- 1660 1235 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 1660 1297 m 62 Y -24 -6 d -62 Y f
- 0 0.8 0.8 c 1660 1359 m 61 Y -24 -6 d -61 Y f black 1636 1105 m 24 6 d 309 Y
- -24 -6 d cl s 0 0 0.8 c 1616 1120 m 20 -15 d 62 Y -20 15 d f 0 0.2 0.8 c 1636
- 1167 m 62 Y -20 16 d -63 Y f 0 0.4 0.8 c 1636 1229 m 62 Y -20 16 d -62 Y f 0
- 0.6 0.8 c 1636 1291 m 62 Y -20 16 d -62 Y f 0 0.8 0.8 c 1636 1353 m 61 Y -20 15
- d -60 Y f black 1616 1120 m 20 -15 d 309 Y -20 15 d cl s 0 0.8 0.8 c 1636 1414
- m 24 6 d -21 15 d -23 -6 d f black 1636 1414 m 24 6 d -21 15 d -23 -6 d cl s 0
- 0 0.8 c 1613 1099 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 1636 1167 m 62 Y -23 -6
- d -62 Y f 0 0.4 0.8 c 1636 1229 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c 1636 1291 m
- 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 1636 1353 m 61 Y -23 -6 d -61 Y f black 1613
- 1099 m 23 6 d 309 Y -23 -6 d cl s 0 0 0.8 c 1592 1114 m 21 -15 d 62 Y -21 16 d
- f 0 0.2 0.8 c 1613 1161 m 62 Y -21 16 d -62 Y f 0 0.4 0.8 c 1613 1223 m 62 Y
- -21 16 d -62 Y f 0 0.6 0.8 c 1613 1285 m 62 Y -21 16 d -62 Y f 0 0.8 0.8 c 1613
- 1347 m 61 Y -21 15 d -60 Y f black 1592 1114 m 21 -15 d 309 Y -21 15 d cl s 0
- 0.8 0.8 c 1613 1408 m 23 6 d -20 15 d -24 -6 d f black 1613 1408 m 23 6 d -20
- 15 d -24 -6 d cl s 0 0 0.8 c 1589 1093 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c
- 1613 1161 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 1613 1223 m 62 Y -24 -6 d -62 Y f
- 0 0.6 0.8 c 1613 1285 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 1613 1347 m 63 Y -24
- -6 d -63 Y f 0 0.8 0.6 c 1613 1410 m 62 Y -24 -6 d -62 Y f 0 0.8 0.4 c 1613
- 1472 m 3 Y -24 -6 d -3 Y f black 1589 1093 m 24 6 d 376 Y -24 -6 d cl s 0 0 0.8
- c 1569 1108 m 20 -15 d 62 Y -20 16 d f 0 0.2 0.8 c 1589 1155 m 62 Y -20 16 d
- -62 Y f 0 0.4 0.8 c 1589 1217 m 62 Y -20 16 d -62 Y f 0 0.6 0.8 c 1589 1279 m
- 62 Y -20 16 d -62 Y f 0 0.8 0.8 c 1589 1341 m 63 Y -20 15 d -62 Y f 0 0.8 0.6 c
- 1589 1404 m 62 Y -20 15 d -62 Y f 0 0.8 0.4 c 1589 1466 m 3 Y -20 16 d -4 Y f
- black 1569 1108 m 20 -15 d 376 Y -20 16 d cl s 0 0.8 0.4 c 1589 1469 m 24 6 d
- -21 16 d -23 -6 d f black 1589 1469 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c
- 1566 1087 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 1589 1155 m 62 Y -23 -6 d -62 Y
- f 0 0.4 0.8 c 1589 1217 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c 1589 1279 m 62 Y
- -23 -6 d -62 Y f 0 0.8 0.8 c 1589 1341 m 63 Y -23 -6 d -63 Y f 0 0.8 0.6 c 1589
- 1404 m 52 Y -23 -6 d -52 Y f black 1566 1087 m 23 6 d 363 Y -23 -6 d cl s 0 0
- 0.8 c 1545 1102 m 21 -15 d 62 Y -21 16 d f 0 0.2 0.8 c 1566 1149 m 62 Y -21 16
- d -62 Y f 0 0.4 0.8 c 1566 1211 m 62 Y -21 16 d -62 Y f 0 0.6 0.8 c 1566 1273 m
- 62 Y -21 16 d -62 Y f 0 0.8 0.8 c 1566 1335 m 63 Y -21 15 d -62 Y f 0 0.8 0.6 c
- 1566 1398 m 52 Y -21 15 d -52 Y f black 1545 1102 m 21 -15 d 363 Y -21 15 d
- cl s 0 0.8 0.6 c 1566 1450 m 23 6 d -20 15 d -24 -6 d f black 1566 1450 m 23 6
- d -20 15 d -24 -6 d cl s 0 0 0.8 c 1542 1081 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8
- c 1566 1149 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 1566 1211 m 62 Y -24 -6 d -62 Y
- f 0 0.6 0.8 c 1566 1273 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 1566 1335 m 63 Y
- -24 -6 d -63 Y f 0 0.8 0.6 c 1566 1398 m 25 Y -24 -6 d -25 Y f black 1542 1081
- m 24 6 d 336 Y -24 -6 d cl s 0 0 0.8 c 1522 1096 m 20 -15 d 62 Y -20 16 d f 0
- 0.2 0.8 c 1542 1143 m 62 Y -20 16 d -62 Y f 0 0.4 0.8 c 1542 1205 m 62 Y -20 16
- d -62 Y f 0 0.6 0.8 c 1542 1267 m 62 Y -20 16 d -62 Y f 0 0.8 0.8 c 1542 1329 m
- 63 Y -20 15 d -62 Y f 0 0.8 0.6 c 1542 1392 m 25 Y -20 15 d -25 Y f black 1522
- 1096 m 20 -15 d 336 Y -20 15 d cl s 0 0.8 0.6 c 1542 1417 m 24 6 d -21 15 d -23
- -6 d f black 1542 1417 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 1519 1075 m 23
- 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 1542 1143 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c
- 1542 1205 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c 1542 1267 m 62 Y -23 -6 d -62 Y f
- 0 0.8 0.8 c 1542 1329 m 63 Y -23 -6 d -63 Y f 0 0.8 0.6 c 1542 1392 m 62 Y -23
- -6 d -62 Y f 0 0.8 0.4 c 1542 1454 m 3 Y -23 -6 d -3 Y f black 1519 1075 m 23 6
- d 376 Y -23 -6 d cl s 0 0 0.8 c 1498 1090 m 21 -15 d 62 Y -21 16 d f 0 0.2 0.8
- c 1519 1137 m 62 Y -21 16 d -62 Y f 0 0.4 0.8 c 1519 1199 m 62 Y -21 16 d -62 Y
- f 0 0.6 0.8 c 1519 1261 m 62 Y -21 16 d -62 Y f 0 0.8 0.8 c 1519 1323 m 63 Y
- -21 15 d -62 Y f 0 0.8 0.6 c 1519 1386 m 62 Y -21 15 d -62 Y f 0 0.8 0.4 c 1519
- 1448 m 3 Y -21 16 d -4 Y f black 1498 1090 m 21 -15 d 376 Y -21 16 d cl s 0 0.8
- 0.4 c 1519 1451 m 23 6 d -20 16 d -24 -6 d f black 1519 1451 m 23 6 d -20 16 d
- -24 -6 d cl s 0 0 0.8 c 1495 1069 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1519
- 1137 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 1519 1199 m 62 Y -24 -6 d -62 Y f 0
- 0.6 0.8 c 1519 1261 m 62 Y -24 -5 d -63 Y f 0 0.8 0.8 c 1519 1323 m 63 Y -24 -6
- d -62 Y f 0 0.8 0.6 c 1519 1386 m 25 Y -24 -6 d -25 Y f black 1495 1069 m 24 6
- d 336 Y -24 -6 d cl s 0 0 0.8 c 1475 1084 m 20 -15 d 62 Y -20 16 d f 0 0.2 0.8
- c 1495 1131 m 62 Y -20 16 d -62 Y f 0 0.4 0.8 c 1495 1193 m 62 Y -20 16 d -62 Y
- f 0 0.6 0.8 c 1495 1255 m 63 Y -20 15 d -62 Y f 0 0.8 0.8 c 1495 1318 m 62 Y
- -20 15 d -62 Y f 0 0.8 0.6 c 1495 1380 m 25 Y -20 15 d -25 Y f black 1475 1084
- m 20 -15 d 336 Y -20 15 d cl s 0 0.8 0.6 c 1495 1405 m 24 6 d -21 15 d -23 -6 d
- f black 1495 1405 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 1472 1063 m 23 6 d
- 62 Y -23 -6 d f 0 0.2 0.8 c 1495 1131 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 1495
- 1193 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c 1495 1255 m 63 Y -23 -6 d -63 Y f 0
- 0.8 0.8 c 1495 1318 m 62 Y -23 -6 d -62 Y f 0 0.8 0.6 c 1495 1380 m 62 Y -23 -6
- d -62 Y f 0 0.8 0.4 c 1495 1442 m 3 Y -23 -6 d -3 Y f black 1472 1063 m 23 6 d
- 376 Y -23 -6 d cl s 0 0 0.8 c 1451 1079 m 21 -16 d 62 Y -21 16 d f 0 0.2 0.8 c
- 1472 1125 m 62 Y -21 16 d -62 Y f 0 0.4 0.8 c 1472 1187 m 62 Y -21 16 d -62 Y f
- 0 0.6 0.8 c 1472 1249 m 63 Y -21 15 d -62 Y f 0 0.8 0.8 c 1472 1312 m 62 Y -21
- 15 d -62 Y f 0 0.8 0.6 c 1472 1374 m 62 Y -21 15 d -62 Y f 0 0.8 0.4 c 1472
- 1436 m 3 Y -21 16 d -4 Y f black 1451 1079 m 21 -16 d 376 Y -21 16 d cl s 0 0.8
- 0.4 c 1472 1439 m 23 6 d -20 16 d -24 -6 d f black 1472 1439 m 23 6 d -20 16 d
- -24 -6 d cl s 0 0 0.8 c 1448 1057 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1472
- 1125 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 1472 1187 m 62 Y -24 -6 d -62 Y f 0
- 0.6 0.8 c 1472 1249 m 63 Y -24 -6 d -63 Y f 0 0.8 0.8 c 1472 1312 m 20 Y -24 -6
- d -20 Y f black 1448 1057 m 24 6 d 269 Y -24 -6 d cl s 0 0 0.8 c 1428 1073 m 20
- -16 d 62 Y -20 16 d f 0 0.2 0.8 c 1448 1119 m 62 Y -20 16 d -62 Y f 0 0.4 0.8 c
- 1448 1181 m 62 Y -20 16 d -62 Y f 0 0.6 0.8 c 1448 1243 m 63 Y -20 15 d -62 Y f
- 0 0.8 0.8 c 1448 1306 m 20 Y -20 15 d -20 Y f black 1428 1073 m 20 -16 d 269 Y
- -20 15 d cl s 0 0.8 0.8 c 1448 1326 m 24 6 d -21 15 d -23 -6 d f black 1448
- 1326 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 1425 1051 m 23 6 d 62 Y -23 -6 d
- f 0 0.2 0.8 c 1448 1119 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 1448 1181 m 62 Y
- -23 -6 d -62 Y f 0 0.6 0.8 c 1448 1243 m 63 Y -23 -6 d -63 Y f 0 0.8 0.8 c 1448
- 1306 m 62 Y -23 -6 d -62 Y f 0 0.8 0.6 c 1448 1368 m 25 Y -23 -6 d -25 Y f
- black 1425 1051 m 23 6 d 336 Y -23 -6 d cl s 0 0 0.8 c 1404 1067 m 21 -16 d 62
- Y -21 16 d f 0 0.2 0.8 c 1425 1113 m 62 Y -21 16 d -62 Y f 0 0.4 0.8 c 1425
- 1175 m 62 Y -21 16 d -62 Y f 0 0.6 0.8 c 1425 1237 m 63 Y -21 15 d -62 Y f 0
- 0.8 0.8 c 1425 1300 m 62 Y -21 15 d -62 Y f 0 0.8 0.6 c 1425 1362 m 25 Y -21 15
- d -25 Y f black 1404 1067 m 21 -16 d 336 Y -21 15 d cl s 0 0.8 0.6 c 1425 1387
- m 23 6 d -20 15 d -24 -6 d f black 1425 1387 m 23 6 d -20 15 d -24 -6 d cl s 0
- 0 0.8 c 1401 1045 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1425 1113 m 62 Y -24 -6
- d -62 Y f 0 0.4 0.8 c 1425 1175 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 1425 1237 m
- 63 Y -24 -6 d -63 Y f 0 0.8 0.8 c 1425 1300 m 60 Y -24 -6 d -60 Y f black 1401
- 1045 m 24 6 d 309 Y -24 -6 d cl s 0 0 0.8 c 1381 1061 m 20 -16 d 62 Y -20 16 d
- f 0 0.2 0.8 c 1401 1107 m 62 Y -20 16 d -62 Y f 0 0.4 0.8 c 1401 1169 m 62 Y
- -20 16 d -62 Y f 0 0.6 0.8 c 1401 1231 m 63 Y -20 15 d -62 Y f 0 0.8 0.8 c 1401
- 1294 m 60 Y -20 16 d -61 Y f black 1381 1061 m 20 -16 d 309 Y -20 16 d cl s 0
- 0.8 0.8 c 1401 1354 m 24 6 d -21 16 d -23 -6 d f black 1401 1354 m 24 6 d -21
- 16 d -23 -6 d cl s 0 0 0.8 c 1378 1039 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c
- 1401 1107 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 1401 1169 m 62 Y -23 -6 d -62 Y f
- 0 0.6 0.8 c 1401 1231 m 63 Y -23 -6 d -63 Y f 0 0.8 0.8 c 1401 1294 m 62 Y -23
- -6 d -62 Y f 0 0.8 0.6 c 1401 1356 m 52 Y -23 -6 d -52 Y f black 1378 1039 m 23
- 6 d 363 Y -23 -6 d cl s 0 0 0.8 c 1357 1055 m 21 -16 d 62 Y -21 16 d f 0 0.2
- 0.8 c 1378 1101 m 62 Y -21 16 d -62 Y f 0 0.4 0.8 c 1378 1163 m 62 Y -21 16 d
- -62 Y f 0 0.6 0.8 c 1378 1225 m 63 Y -21 15 d -62 Y f 0 0.8 0.8 c 1378 1288 m
- 62 Y -21 15 d -62 Y f 0 0.8 0.6 c 1378 1350 m 52 Y -21 15 d -52 Y f black 1357
- 1055 m 21 -16 d 363 Y -21 15 d cl s 0 0.8 0.6 c 1378 1402 m 23 6 d -20 15 d -24
- -6 d f black 1378 1402 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1354 1033 m 24
- 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1378 1101 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c
- 1378 1163 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 1378 1225 m 63 Y -24 -6 d -63 Y f
- 0 0.8 0.8 c 1378 1288 m 62 Y -24 -6 d -62 Y f 0 0.8 0.6 c 1378 1350 m 62 Y -24
- -6 d -62 Y f 0 0.8 0.4 c 1378 1412 m 17 Y -24 -6 d -17 Y f black 1354 1033 m 24
- 6 d 390 Y -24 -6 d cl s 0 0 0.8 c 1334 1049 m 20 -16 d 62 Y -20 16 d f 0 0.2
- 0.8 c 1354 1095 m 62 Y -20 16 d -62 Y f 0 0.4 0.8 c 1354 1157 m 62 Y -20 16 d
- -62 Y f 0 0.6 0.8 c 1354 1219 m 63 Y -20 15 d -62 Y f 0 0.8 0.8 c 1354 1282 m
- 62 Y -20 15 d -62 Y f 0 0.8 0.6 c 1354 1344 m 62 Y -20 15 d -62 Y f 0 0.8 0.4 c
- 1354 1406 m 17 Y -20 15 d -17 Y f black 1334 1049 m 20 -16 d 390 Y -20 15 d
- cl s 0 0.8 0.4 c 1354 1423 m 24 6 d -21 15 d -23 -6 d f black 1354 1423 m 24 6
- d -21 15 d -23 -6 d cl s 0 0 0.8 c 1331 1027 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8
- c 1354 1095 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 1354 1157 m 62 Y -23 -5 d -63 Y
- f 0 0.6 0.8 c 1354 1219 m 63 Y -23 -6 d -62 Y f 0 0.8 0.8 c 1354 1282 m 62 Y
- -23 -6 d -62 Y f 0 0.8 0.6 c 1354 1344 m 62 Y -23 -6 d -62 Y f 0 0.8 0.4 c 1354
- 1406 m 30 Y -23 -6 d -30 Y f black 1331 1027 m 23 6 d 403 Y -23 -6 d cl s 0 0
- 0.8 c 1310 1043 m 21 -16 d 62 Y -21 16 d f 0 0.2 0.8 c 1331 1089 m 62 Y -21 16
- d -62 Y f 0 0.4 0.8 c 1331 1151 m 63 Y -21 15 d -62 Y f 0 0.6 0.8 c 1331 1214 m
- 62 Y -21 15 d -62 Y f 0 0.8 0.8 c 1331 1276 m 62 Y -21 15 d -62 Y f 0 0.8 0.6 c
- 1331 1338 m 62 Y -21 15 d -62 Y f 0 0.8 0.4 c 1331 1400 m 30 Y -21 16 d -31 Y f
- black 1310 1043 m 21 -16 d 403 Y -21 16 d cl s 0 0.8 0.4 c 1331 1430 m 23 6 d
- -20 16 d -24 -6 d f black 1331 1430 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c
- 1307 1021 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1331 1089 m 62 Y -24 -6 d -62 Y
- f 0 0.4 0.8 c 1331 1151 m 63 Y -24 -6 d -63 Y f 0 0.6 0.8 c 1331 1214 m 62 Y
- -24 -6 d -62 Y f 0 0.8 0.8 c 1331 1276 m 62 Y -24 -6 d -62 Y f 0 0.8 0.6 c 1331
- 1338 m 62 Y -24 -6 d -62 Y f 0 0.8 0.4 c 1331 1400 m 17 Y -24 -6 d -17 Y f
- black 1307 1021 m 24 6 d 390 Y -24 -6 d cl s 0 0 0.8 c 1287 1037 m 20 -16 d 62
- Y -20 16 d f 0 0.2 0.8 c 1307 1083 m 62 Y -20 16 d -62 Y f 0 0.4 0.8 c 1307
- 1145 m 63 Y -20 15 d -62 Y f 0 0.6 0.8 c 1307 1208 m 62 Y -20 15 d -62 Y f 0
- 0.8 0.8 c 1307 1270 m 62 Y -20 15 d -62 Y f 0 0.8 0.6 c 1307 1332 m 62 Y -20 15
- d -62 Y f 0 0.8 0.4 c 1307 1394 m 17 Y -20 15 d -17 Y f black 1287 1037 m 20
- -16 d 390 Y -20 15 d cl s 0 0.8 0.4 c 1307 1411 m 24 6 d -21 15 d -23 -6 d f
- black 1307 1411 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 1284 1015 m 23 6 d 62
- Y -23 -6 d f 0 0.2 0.8 c 1307 1083 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 1307
- 1145 m 63 Y -23 -6 d -63 Y f 0 0.6 0.8 c 1307 1208 m 62 Y -23 -6 d -62 Y f 0
- 0.8 0.8 c 1307 1270 m 62 Y -23 -6 d -62 Y f 0 0.8 0.6 c 1307 1332 m 25 Y -23 -6
- d -25 Y f black 1284 1015 m 23 6 d 336 Y -23 -6 d cl s 0 0 0.8 c 1263 1031 m 21
- -16 d 62 Y -21 16 d f 0 0.2 0.8 c 1284 1077 m 62 Y -21 16 d -62 Y f 0 0.4 0.8 c
- 1284 1139 m 63 Y -21 15 d -62 Y f 0 0.6 0.8 c 1284 1202 m 62 Y -21 15 d -62 Y f
- 0 0.8 0.8 c 1284 1264 m 62 Y -21 15 d -62 Y f 0 0.8 0.6 c 1284 1326 m 25 Y -21
- 16 d -26 Y f black 1263 1031 m 21 -16 d 336 Y -21 16 d cl s 0 0.8 0.6 c 1284
- 1351 m 23 6 d -20 16 d -24 -6 d f black 1284 1351 m 23 6 d -20 16 d -24 -6 d
- cl s 0 0 0.8 c 1260 1009 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1284 1077 m 62 Y
- -24 -6 d -62 Y f 0 0.4 0.8 c 1284 1139 m 63 Y -24 -6 d -63 Y f 0 0.6 0.8 c 1284
- 1202 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 1284 1264 m 60 Y -24 -6 d -60 Y f
- black 1260 1009 m 24 6 d 309 Y -24 -6 d cl s 0 0 0.8 c 1240 1025 m 20 -16 d 62
- Y -20 16 d f 0 0.2 0.8 c 1260 1071 m 62 Y -20 16 d -62 Y f 0 0.4 0.8 c 1260
- 1133 m 63 Y -20 15 d -62 Y f 0 0.6 0.8 c 1260 1196 m 62 Y -20 15 d -62 Y f 0
- 0.8 0.8 c 1260 1258 m 60 Y -20 16 d -61 Y f black 1240 1025 m 20 -16 d 309 Y
- -20 16 d cl s 0 0.8 0.8 c 1260 1318 m 24 6 d -21 16 d -23 -6 d f black 1260
- 1318 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1237 1003 m 23 6 d 62 Y -23 -6 d
- f 0 0.2 0.8 c 1260 1071 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 1260 1133 m 63 Y
- -23 -6 d -63 Y f 0 0.6 0.8 c 1260 1196 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 1260
- 1258 m 20 Y -23 -6 d -20 Y f black 1237 1003 m 23 6 d 269 Y -23 -6 d cl s 0 0
- 0.8 c 1216 1019 m 21 -16 d 62 Y -21 16 d f 0 0.2 0.8 c 1237 1065 m 62 Y -21 16
- d -62 Y f 0 0.4 0.8 c 1237 1127 m 63 Y -21 15 d -62 Y f 0 0.6 0.8 c 1237 1190 m
- 62 Y -21 15 d -62 Y f 0 0.8 0.8 c 1237 1252 m 20 Y -21 15 d -20 Y f black 1216
- 1019 m 21 -16 d 269 Y -21 15 d cl s 0 0.8 0.8 c 1237 1272 m 23 6 d -20 15 d -24
- -6 d f black 1237 1272 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1213 997 m 24
- 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1237 1065 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c
- 1237 1127 m 63 Y -24 -6 d -63 Y f 0 0.6 0.8 c 1237 1190 m 62 Y -24 -6 d -62 Y f
- 0 0.8 0.8 c 1237 1252 m 62 Y -24 -6 d -62 Y f 0 0.8 0.6 c 1237 1314 m 62 Y -24
- -6 d -62 Y f 0 0.8 0.4 c 1237 1376 m 17 Y -24 -6 d -17 Y f black 1213 997 m 24
- 6 d 390 Y -24 -6 d cl s 0 0 0.8 c 1193 1013 m 20 -16 d 62 Y -20 16 d f 0 0.2
- 0.8 c 1213 1059 m 62 Y -20 16 d -62 Y f 0 0.4 0.8 c 1213 1121 m 63 Y -20 15 d
- -62 Y f 0 0.6 0.8 c 1213 1184 m 62 Y -20 15 d -62 Y f 0 0.8 0.8 c 1213 1246 m
- 62 Y -20 15 d -62 Y f 0 0.8 0.6 c 1213 1308 m 62 Y -20 16 d -63 Y f 0 0.8 0.4 c
- 1213 1370 m 17 Y -20 15 d -16 Y f black 1193 1013 m 20 -16 d 390 Y -20 15 d
- cl s 0 0.8 0.4 c 1213 1387 m 24 6 d -21 15 d -23 -6 d f black 1213 1387 m 24 6
- d -21 15 d -23 -6 d cl s 0 0 0.8 c 1190 991 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8
- c 1213 1059 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 1213 1121 m 63 Y -23 -6 d -63 Y
- f 0 0.6 0.8 c 1213 1184 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 1213 1246 m 62 Y
- -23 -6 d -62 Y f 0 0.8 0.6 c 1213 1308 m 62 Y -23 -6 d -62 Y f 0 0.8 0.4 c 1213
- 1370 m 62 Y -23 -6 d -62 Y f 0 0.8 0.2 c 1213 1432 m 9 Y -23 -6 d -9 Y f black
- 1190 991 m 23 6 d 444 Y -23 -6 d cl s 0 0 0.8 c 1169 1007 m 21 -16 d 62 Y -21
- 16 d f 0 0.2 0.8 c 1190 1053 m 62 Y -21 16 d -62 Y f 0 0.4 0.8 c 1190 1115 m 63
- Y -21 15 d -62 Y f 0 0.6 0.8 c 1190 1178 m 62 Y -21 15 d -62 Y f 0 0.8 0.8 c
- 1190 1240 m 62 Y -21 15 d -62 Y f 0 0.8 0.6 c 1190 1302 m 62 Y -21 16 d -63 Y f
- 0 0.8 0.4 c 1190 1364 m 62 Y -21 16 d -62 Y f 0 0.8 0.2 c 1190 1426 m 9 Y -21
- 15 d -8 Y f black 1169 1007 m 21 -16 d 444 Y -21 15 d cl s 0 0.8 0.2 c 1190
- 1435 m 23 6 d -20 15 d -24 -6 d f black 1190 1435 m 23 6 d -20 15 d -24 -6 d
- cl s 0 0 0.8 c 1166 985 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1190 1053 m 62 Y
- -24 -5 d -63 Y f 0 0.4 0.8 c 1190 1115 m 63 Y -24 -6 d -62 Y f 0 0.6 0.8 c 1190
- 1178 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 1190 1240 m 62 Y -24 -6 d -62 Y f 0
- 0.8 0.6 c 1190 1302 m 62 Y -24 -6 d -62 Y f 0 0.8 0.4 c 1190 1364 m 30 Y -24 -6
- d -30 Y f black 1166 985 m 24 6 d 403 Y -24 -6 d cl s 0 0 0.8 c 1146 1001 m 20
- -16 d 62 Y -20 16 d f 0 0.2 0.8 c 1166 1047 m 63 Y -20 15 d -62 Y f 0 0.4 0.8 c
- 1166 1110 m 62 Y -20 15 d -62 Y f 0 0.6 0.8 c 1166 1172 m 62 Y -20 15 d -62 Y f
- 0 0.8 0.8 c 1166 1234 m 62 Y -20 15 d -62 Y f 0 0.8 0.6 c 1166 1296 m 62 Y -20
- 16 d -63 Y f 0 0.8 0.4 c 1166 1358 m 30 Y -20 16 d -30 Y f black 1146 1001 m 20
- -16 d 403 Y -20 16 d cl s 0 0.8 0.4 c 1166 1388 m 24 6 d -21 16 d -23 -6 d f
- black 1166 1388 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1143 979 m 23 6 d 62
- Y -23 -6 d f 0 0.2 0.8 c 1166 1047 m 63 Y -23 -6 d -63 Y f 0 0.4 0.8 c 1166
- 1110 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c 1166 1172 m 62 Y -23 -6 d -62 Y f 0
- 0.8 0.8 c 1166 1234 m 62 Y -23 -6 d -62 Y f 0 0.8 0.6 c 1166 1296 m 39 Y -23 -6
- d -39 Y f black 1143 979 m 23 6 d 350 Y -23 -6 d cl s 0 0 0.8 c 1122 995 m 21
- -16 d 62 Y -21 16 d f 0 0.2 0.8 c 1143 1041 m 63 Y -21 15 d -62 Y f 0 0.4 0.8 c
- 1143 1104 m 62 Y -21 15 d -62 Y f 0 0.6 0.8 c 1143 1166 m 62 Y -21 15 d -62 Y f
- 0 0.8 0.8 c 1143 1228 m 62 Y -21 15 d -62 Y f 0 0.8 0.6 c 1143 1290 m 39 Y -21
- 15 d -39 Y f black 1122 995 m 21 -16 d 350 Y -21 15 d cl s 0 0.8 0.6 c 1143
- 1329 m 23 6 d -20 15 d -24 -6 d f black 1143 1329 m 23 6 d -20 15 d -24 -6 d
- cl s 0 0 0.8 c 1119 973 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1143 1041 m 63 Y
- -24 -6 d -63 Y f 0 0.4 0.8 c 1143 1104 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 1143
- 1166 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 1143 1228 m 62 Y -24 -6 d -62 Y f 0
- 0.8 0.6 c 1143 1290 m 52 Y -24 -6 d -52 Y f black 1119 973 m 24 6 d 363 Y -24
- -6 d cl s 0 0 0.8 c 1099 989 m 20 -16 d 62 Y -20 16 d f 0 0.2 0.8 c 1119 1035 m
- 63 Y -20 15 d -62 Y f 0 0.4 0.8 c 1119 1098 m 62 Y -20 15 d -62 Y f 0 0.6 0.8 c
- 1119 1160 m 62 Y -20 15 d -62 Y f 0 0.8 0.8 c 1119 1222 m 62 Y -20 16 d -63 Y f
- 0 0.8 0.6 c 1119 1284 m 52 Y -20 16 d -52 Y f black 1099 989 m 20 -16 d 363 Y
- -20 16 d cl s 0 0.8 0.6 c 1119 1336 m 24 6 d -21 16 d -23 -6 d f black 1119
- 1336 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1096 967 m 23 6 d 62 Y -23 -6 d
- f 0 0.2 0.8 c 1119 1035 m 63 Y -23 -6 d -63 Y f 0 0.4 0.8 c 1119 1098 m 62 Y
- -23 -6 d -62 Y f 0 0.6 0.8 c 1119 1160 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 1119
- 1222 m 62 Y -23 -6 d -62 Y f 0 0.8 0.6 c 1119 1284 m 62 Y -23 -6 d -62 Y f 0
- 0.8 0.4 c 1119 1346 m 17 Y -23 -6 d -17 Y f black 1096 967 m 23 6 d 390 Y -23
- -6 d cl s 0 0 0.8 c 1075 983 m 21 -16 d 62 Y -21 16 d f 0 0.2 0.8 c 1096 1029 m
- 63 Y -21 15 d -62 Y f 0 0.4 0.8 c 1096 1092 m 62 Y -21 15 d -62 Y f 0 0.6 0.8 c
- 1096 1154 m 62 Y -21 15 d -62 Y f 0 0.8 0.8 c 1096 1216 m 62 Y -21 16 d -63 Y f
- 0 0.8 0.6 c 1096 1278 m 62 Y -21 16 d -62 Y f 0 0.8 0.4 c 1096 1340 m 17 Y -21
- 15 d -16 Y f black 1075 983 m 21 -16 d 390 Y -21 15 d cl s 0 0.8 0.4 c 1096
- 1357 m 23 6 d -20 15 d -24 -6 d f black 1096 1357 m 23 6 d -20 15 d -24 -6 d
- cl s 0 0 0.8 c 1072 961 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1096 1029 m 63 Y
- -24 -6 d -63 Y f 0 0.4 0.8 c 1096 1092 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 1096
- 1154 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 1096 1216 m 62 Y -24 -6 d -62 Y f 0
- 0.8 0.6 c 1096 1278 m 62 Y -24 -6 d -62 Y f 0 0.8 0.4 c 1096 1340 m 4 Y -24 -6
- d -4 Y f black 1072 961 m 24 6 d 377 Y -24 -6 d cl s 0 0 0.8 c 1052 977 m 20
- -16 d 62 Y -20 16 d f 0 0.2 0.8 c 1072 1023 m 63 Y -20 15 d -62 Y f 0 0.4 0.8 c
- 1072 1086 m 62 Y -20 15 d -62 Y f 0 0.6 0.8 c 1072 1148 m 62 Y -20 15 d -62 Y f
- 0 0.8 0.8 c 1072 1210 m 62 Y -20 16 d -63 Y f 0 0.8 0.6 c 1072 1272 m 62 Y -20
- 16 d -62 Y f 0 0.8 0.4 c 1072 1334 m 4 Y -20 15 d -3 Y f black 1052 977 m 20
- -16 d 377 Y -20 15 d cl s 0 0.8 0.4 c 1072 1338 m 24 6 d -21 15 d -23 -6 d f
- black 1072 1338 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 1049 955 m 23 6 d 62
- Y -23 -6 d f 0 0.2 0.8 c 1072 1023 m 63 Y -23 -6 d -63 Y f 0 0.4 0.8 c 1072
- 1086 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c 1072 1148 m 62 Y -23 -6 d -62 Y f 0
- 0.8 0.8 c 1072 1210 m 62 Y -23 -6 d -62 Y f 0 0.8 0.6 c 1072 1272 m 52 Y -23 -6
- d -52 Y f black 1049 955 m 23 6 d 363 Y -23 -6 d cl s 0 0 0.8 c 1028 971 m 21
- -16 d 62 Y -21 16 d f 0 0.2 0.8 c 1049 1017 m 63 Y -21 15 d -62 Y f 0 0.4 0.8 c
- 1049 1080 m 62 Y -21 15 d -62 Y f 0 0.6 0.8 c 1049 1142 m 62 Y -21 15 d -62 Y f
- 0 0.8 0.8 c 1049 1204 m 62 Y -21 16 d -63 Y f 0 0.8 0.6 c 1049 1266 m 52 Y -21
- 16 d -52 Y f black 1028 971 m 21 -16 d 363 Y -21 16 d cl s 0 0.8 0.6 c 1049
- 1318 m 23 6 d -20 16 d -24 -6 d f black 1049 1318 m 23 6 d -20 16 d -24 -6 d
- cl s 0 0 0.8 c 1025 949 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1049 1017 m 63 Y
- -24 -6 d -63 Y f 0 0.4 0.8 c 1049 1080 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 1049
- 1142 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 1049 1204 m 62 Y -24 -6 d -62 Y f 0
- 0.8 0.6 c 1049 1266 m 62 Y -24 -6 d -62 Y f 0 0.8 0.4 c 1049 1328 m 17 Y -24 -6
- d -17 Y f black 1025 949 m 24 6 d 390 Y -24 -6 d cl s 0 0 0.8 c 1005 965 m 20
- -16 d 62 Y -20 16 d f 0 0.2 0.8 c 1025 1011 m 63 Y -20 15 d -62 Y f 0 0.4 0.8 c
- 1025 1074 m 62 Y -20 15 d -62 Y f 0 0.6 0.8 c 1025 1136 m 62 Y -20 15 d -62 Y f
- 0 0.8 0.8 c 1025 1198 m 62 Y -20 16 d -63 Y f 0 0.8 0.6 c 1025 1260 m 62 Y -20
- 16 d -62 Y f 0 0.8 0.4 c 1025 1322 m 17 Y -20 16 d -17 Y f black 1005 965 m 20
- -16 d 390 Y -20 16 d cl s 0 0.8 0.4 c 1025 1339 m 24 6 d -21 16 d -23 -6 d f
- black 1025 1339 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1002 943 m 23 6 d 62
- Y -23 -5 d f 0 0.2 0.8 c 1025 1011 m 63 Y -23 -6 d -62 Y f 0 0.4 0.8 c 1025
- 1074 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c 1025 1136 m 62 Y -23 -6 d -62 Y f 0
- 0.8 0.8 c 1025 1198 m 62 Y -23 -6 d -62 Y f 0 0.8 0.6 c 1025 1260 m 62 Y -23 -6
- d -62 Y f 0 0.8 0.4 c 1025 1322 m 62 Y -23 -6 d -62 Y f 0 0.8 0.2 c 1025 1384 m
- 9 Y -23 -6 d -9 Y f black 1002 943 m 23 6 d 444 Y -23 -6 d cl s 0 0 0.8 c 981
- 959 m 21 -16 d 63 Y -21 15 d f 0 0.2 0.8 c 1002 1006 m 62 Y -21 15 d -62 Y f 0
- 0.4 0.8 c 1002 1068 m 62 Y -21 15 d -62 Y f 0 0.6 0.8 c 1002 1130 m 62 Y -21 15
- d -62 Y f 0 0.8 0.8 c 1002 1192 m 62 Y -21 16 d -63 Y f 0 0.8 0.6 c 1002 1254 m
- 62 Y -21 16 d -62 Y f 0 0.8 0.4 c 1002 1316 m 62 Y -21 16 d -62 Y f 0 0.8 0.2 c
- 1002 1378 m 9 Y -21 15 d -8 Y f black 981 959 m 21 -16 d 444 Y -21 15 d cl s 0
- 0.8 0.2 c 1002 1387 m 23 6 d -20 15 d -24 -6 d f black 1002 1387 m 23 6 d -20
- 15 d -24 -6 d cl s 0 0 0.8 c 978 937 m 24 6 d 63 Y -24 -6 d f 0 0.2 0.8 c 1002
- 1006 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 1002 1068 m 62 Y -24 -6 d -62 Y f 0
- 0.6 0.8 c 1002 1130 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 1002 1192 m 62 Y -24 -6
- d -62 Y f 0 0.8 0.6 c 1002 1254 m 62 Y -24 -6 d -62 Y f 0 0.8 0.4 c 1002 1316 m
- 30 Y -24 -6 d -30 Y f black 978 937 m 24 6 d 403 Y -24 -6 d cl s 0 0 0.8 c 958
- 953 m 20 -16 d 63 Y -20 15 d f 0 0.2 0.8 c 978 1000 m 62 Y -20 15 d -62 Y f 0
- 0.4 0.8 c 978 1062 m 62 Y -20 15 d -62 Y f 0 0.6 0.8 c 978 1124 m 62 Y -20 15 d
- -62 Y f 0 0.8 0.8 c 978 1186 m 62 Y -20 16 d -63 Y f 0 0.8 0.6 c 978 1248 m 62
- Y -20 16 d -62 Y f 0 0.8 0.4 c 978 1310 m 30 Y -20 16 d -30 Y f black 958 953 m
- 20 -16 d 403 Y -20 16 d cl s 0 0.8 0.4 c 978 1340 m 24 6 d -21 16 d -23 -6 d f
- black 978 1340 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 955 931 m 23 6 d 63 Y
- -23 -6 d f 0 0.2 0.8 c 978 1000 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 978 1062 m
- 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c 978 1124 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c
- 978 1186 m 62 Y -23 -6 d -62 Y f 0 0.8 0.6 c 978 1248 m 62 Y -23 -6 d -62 Y f 0
- 0.8 0.4 c 978 1310 m 62 Y -23 -6 d -62 Y f 0 0.8 0.2 c 978 1372 m 36 Y -23 -6 d
- -36 Y f black 955 931 m 23 6 d 471 Y -23 -6 d cl s 0 0 0.8 c 935 947 m 20 -16 d
- 63 Y -20 15 d f 0 0.2 0.8 c 955 994 m 62 Y -20 15 d -62 Y f 0 0.4 0.8 c 955
- 1056 m 62 Y -20 15 d -62 Y f 0 0.6 0.8 c 955 1118 m 62 Y -20 16 d -63 Y f 0 0.8
- 0.8 c 955 1180 m 62 Y -20 16 d -62 Y f 0 0.8 0.6 c 955 1242 m 62 Y -20 16 d -62
- Y f 0 0.8 0.4 c 955 1304 m 62 Y -20 16 d -62 Y f 0 0.8 0.2 c 955 1366 m 36 Y
- -20 15 d -35 Y f black 935 947 m 20 -16 d 471 Y -20 15 d cl s 0 0.8 0.2 c 955
- 1402 m 23 6 d -20 15 d -23 -6 d f black 955 1402 m 23 6 d -20 15 d -23 -6 d
- cl s 0 0 0.8 c 931 925 m 24 6 d 63 Y -24 -6 d f 0 0.2 0.8 c 955 994 m 62 Y -24
- -6 d -62 Y f 0 0.4 0.8 c 955 1056 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 955 1118
- m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 955 1180 m 62 Y -24 -6 d -62 Y f 0 0.8 0.6
- c 955 1242 m 62 Y -24 -6 d -62 Y f 0 0.8 0.4 c 955 1304 m 17 Y -24 -6 d -17 Y f
- black 931 925 m 24 6 d 390 Y -24 -6 d cl s 0 0 0.8 c 911 941 m 20 -16 d 63 Y
- -20 15 d f 0 0.2 0.8 c 931 988 m 62 Y -20 15 d -62 Y f 0 0.4 0.8 c 931 1050 m
- 62 Y -20 15 d -62 Y f 0 0.6 0.8 c 931 1112 m 62 Y -20 16 d -63 Y f 0 0.8 0.8 c
- 931 1174 m 62 Y -20 16 d -62 Y f 0 0.8 0.6 c 931 1236 m 62 Y -20 16 d -62 Y f 0
- 0.8 0.4 c 931 1298 m 17 Y -20 16 d -17 Y f black 911 941 m 20 -16 d 390 Y -20
- 16 d cl s 0 0.8 0.4 c 931 1315 m 24 6 d -20 16 d -24 -6 d f black 931 1315 m 24
- 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 908 919 m 23 6 d 63 Y -23 -6 d f 0 0.2 0.8
- c 931 988 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 931 1050 m 62 Y -23 -6 d -62 Y f
- 0 0.6 0.8 c 931 1112 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 931 1174 m 34 Y -23 -6
- d -34 Y f black 908 919 m 23 6 d 283 Y -23 -6 d cl s 0 0 0.8 c 888 935 m 20 -16
- d 63 Y -20 15 d f 0 0.2 0.8 c 908 982 m 62 Y -20 15 d -62 Y f 0 0.4 0.8 c 908
- 1044 m 62 Y -20 15 d -62 Y f 0 0.6 0.8 c 908 1106 m 62 Y -20 16 d -63 Y f 0 0.8
- 0.8 c 908 1168 m 34 Y -20 15 d -33 Y f black 888 935 m 20 -16 d 283 Y -20 15 d
- cl s 0 0.8 0.8 c 908 1202 m 23 6 d -20 15 d -23 -6 d f black 908 1202 m 23 6 d
- -20 15 d -23 -6 d cl s 0 0 0.8 c 884 913 m 24 6 d 63 Y -24 -6 d f 0 0.2 0.8 c
- 908 982 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 908 1044 m 62 Y -24 -6 d -62 Y f 0
- 0.6 0.8 c 908 1106 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 908 1168 m 62 Y -24 -6 d
- -62 Y f 0 0.8 0.6 c 908 1230 m 62 Y -24 -6 d -62 Y f 0 0.8 0.4 c 908 1292 m 62
- Y -24 -6 d -62 Y f 0 0.8 0.2 c 908 1354 m 63 Y -24 -6 d -63 Y f 0 0.8 0 c 908
- 1417 m 13 Y -24 -6 d -13 Y f black 884 913 m 24 6 d 511 Y -24 -6 d cl s 0 0 0.8
- c 864 929 m 20 -16 d 63 Y -20 15 d f 0 0.2 0.8 c 884 976 m 62 Y -20 15 d -62 Y
- f 0 0.4 0.8 c 884 1038 m 62 Y -20 15 d -62 Y f 0 0.6 0.8 c 884 1100 m 62 Y -20
- 16 d -63 Y f 0 0.8 0.8 c 884 1162 m 62 Y -20 16 d -62 Y f 0 0.8 0.6 c 884 1224
- m 62 Y -20 16 d -62 Y f 0 0.8 0.4 c 884 1286 m 62 Y -20 16 d -62 Y f 0 0.8 0.2
- c 884 1348 m 63 Y -20 15 d -62 Y f 0 0.8 0 c 884 1411 m 13 Y -20 16 d -14 Y f
- black 864 929 m 20 -16 d 511 Y -20 16 d cl s 0 0.8 0 c 884 1424 m 24 6 d -20 16
- d -24 -6 d f black 884 1424 m 24 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 861 907 m
- 23 6 d 63 Y -23 -6 d f 0 0.2 0.8 c 884 976 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c
- 884 1038 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c 884 1100 m 62 Y -23 -6 d -62 Y f 0
- 0.8 0.8 c 884 1162 m 62 Y -23 -6 d -62 Y f 0 0.8 0.6 c 884 1224 m 62 Y -23 -6 d
- -62 Y f 0 0.8 0.4 c 884 1286 m 62 Y -23 -6 d -62 Y f 0 0.8 0.2 c 884 1348 m 63
- Y -23 -6 d -63 Y f black 861 907 m 23 6 d 498 Y -23 -6 d cl s 0 0 0.8 c 841 923
- m 20 -16 d 63 Y -20 15 d f 0 0.2 0.8 c 861 970 m 62 Y -20 15 d -62 Y f 0 0.4
- 0.8 c 861 1032 m 62 Y -20 15 d -62 Y f 0 0.6 0.8 c 861 1094 m 62 Y -20 16 d -63
- Y f 0 0.8 0.8 c 861 1156 m 62 Y -20 16 d -62 Y f 0 0.8 0.6 c 861 1218 m 62 Y
- -20 16 d -62 Y f 0 0.8 0.4 c 861 1280 m 62 Y -20 16 d -62 Y f 0 0.8 0.2 c 861
- 1342 m 63 Y -20 15 d -62 Y f black 841 923 m 20 -16 d 498 Y -20 15 d cl s 0 0.8
- 0.2 c 861 1405 m 23 6 d -20 15 d -23 -6 d f 0 0.8 0 c 861 1405 m 23 6 d -20 15
- d -23 -6 d f black 861 1405 m 23 6 d -20 15 d -23 -6 d cl s 0 0 0.8 c 837 902 m
- 24 5 d 63 Y -24 -6 d f 0 0.2 0.8 c 861 970 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c
- 861 1032 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 861 1094 m 62 Y -24 -6 d -62 Y f 0
- 0.8 0.8 c 861 1156 m 62 Y -24 -6 d -62 Y f 0 0.8 0.6 c 861 1218 m 62 Y -24 -6 d
- -62 Y f 0 0.8 0.4 c 861 1280 m 62 Y -24 -5 d -63 Y f 0 0.8 0.2 c 861 1342 m 49
- Y -24 -6 d -48 Y f black 837 902 m 24 5 d 484 Y -24 -6 d cl s 0 0 0.8 c 817 917
- m 20 -15 d 62 Y -20 15 d f 0 0.2 0.8 c 837 964 m 62 Y -20 15 d -62 Y f 0 0.4
- 0.8 c 837 1026 m 62 Y -20 15 d -62 Y f 0 0.6 0.8 c 837 1088 m 62 Y -20 16 d -63
- Y f 0 0.8 0.8 c 837 1150 m 62 Y -20 16 d -62 Y f 0 0.8 0.6 c 837 1212 m 62 Y
- -20 16 d -62 Y f 0 0.8 0.4 c 837 1274 m 63 Y -20 15 d -62 Y f 0 0.8 0.2 c 837
- 1337 m 48 Y -20 16 d -49 Y f black 817 917 m 20 -15 d 483 Y -20 16 d cl s 0 0.8
- 0.2 c 837 1385 m 24 6 d -20 16 d -24 -6 d f black 837 1385 m 24 6 d -20 16 d
- -24 -6 d cl s 0 0 0.8 c 814 896 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 837 964 m
- 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 837 1026 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c
- 837 1088 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 837 1150 m 62 Y -23 -6 d -62 Y f 0
- 0.8 0.6 c 837 1212 m 62 Y -23 -6 d -62 Y f 0 0.8 0.4 c 837 1274 m 17 Y -23 -6 d
- -17 Y f black 814 896 m 23 6 d 389 Y -23 -6 d cl s 0 0 0.8 c 794 911 m 20 -15 d
- 62 Y -20 15 d f 0 0.2 0.8 c 814 958 m 62 Y -20 15 d -62 Y f 0 0.4 0.8 c 814
- 1020 m 62 Y -20 15 d -62 Y f 0 0.6 0.8 c 814 1082 m 62 Y -20 16 d -63 Y f 0 0.8
- 0.8 c 814 1144 m 62 Y -20 16 d -62 Y f 0 0.8 0.6 c 814 1206 m 62 Y -20 16 d -62
- Y f 0 0.8 0.4 c 814 1268 m 17 Y -20 16 d -17 Y f black 794 911 m 20 -15 d 389 Y
- -20 16 d cl s 0 0.8 0.4 c 814 1285 m 23 6 d -20 16 d -23 -6 d f black 814 1285
- m 23 6 d -20 16 d -23 -6 d cl s 0 0 0.8 c 790 890 m 24 6 d 62 Y -24 -6 d f 0
- 0.2 0.8 c 814 958 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 814 1020 m 62 Y -24 -6 d
- -62 Y f 0 0.6 0.8 c 814 1082 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 814 1144 m 47
- Y -24 -6 d -47 Y f black 790 890 m 24 6 d 295 Y -24 -6 d cl s 0 0 0.8 c 770 905
- m 20 -15 d 62 Y -20 15 d f 0 0.2 0.8 c 790 952 m 62 Y -20 15 d -62 Y f 0 0.4
- 0.8 c 790 1014 m 62 Y -20 16 d -63 Y f 0 0.6 0.8 c 790 1076 m 62 Y -20 16 d -62
- Y f 0 0.8 0.8 c 790 1138 m 47 Y -20 16 d -47 Y f black 770 905 m 20 -15 d 295 Y
- -20 16 d cl s 0 0.8 0.8 c 790 1185 m 24 6 d -20 16 d -24 -6 d f black 790 1185
- m 24 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 767 884 m 23 6 d 62 Y -23 -6 d f 0
- 0.2 0.8 c 790 952 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 790 1014 m 62 Y -23 -6 d
- -62 Y f 0 0.6 0.8 c 790 1076 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 790 1138 m 62
- Y -23 -6 d -62 Y f 0 0.8 0.6 c 790 1200 m 62 Y -23 -6 d -62 Y f 0 0.8 0.4 c 790
- 1262 m 31 Y -23 -6 d -31 Y f black 767 884 m 23 6 d 403 Y -23 -6 d cl s 0 0 0.8
- c 747 899 m 20 -15 d 62 Y -20 15 d f 0 0.2 0.8 c 767 946 m 62 Y -20 15 d -62 Y
- f 0 0.4 0.8 c 767 1008 m 62 Y -20 16 d -63 Y f 0 0.6 0.8 c 767 1070 m 62 Y -20
- 16 d -62 Y f 0 0.8 0.8 c 767 1132 m 62 Y -20 16 d -62 Y f 0 0.8 0.6 c 767 1194
- m 62 Y -20 16 d -62 Y f 0 0.8 0.4 c 767 1256 m 31 Y -20 15 d -30 Y f black 747
- 899 m 20 -15 d 403 Y -20 15 d cl s 0 0.8 0.4 c 767 1287 m 23 6 d -20 15 d -23
- -6 d f black 767 1287 m 23 6 d -20 15 d -23 -6 d cl s 0 0 0.8 c 743 878 m 24 6
- d 62 Y -24 -6 d f 0 0.2 0.8 c 767 946 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 767
- 1008 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 767 1070 m 42 Y -24 -6 d -42 Y f black
- 743 878 m 24 6 d 228 Y -24 -6 d cl s 0 0 0.8 c 723 893 m 20 -15 d 62 Y -20 15 d
- f 0 0.2 0.8 c 743 940 m 62 Y -20 15 d -62 Y f 0 0.4 0.8 c 743 1002 m 62 Y -20
- 16 d -63 Y f 0 0.6 0.8 c 743 1064 m 42 Y -20 16 d -42 Y f black 723 893 m 20
- -15 d 228 Y -20 16 d cl s 0 0.6 0.8 c 743 1106 m 24 6 d -20 16 d -24 -6 d f
- black 743 1106 m 24 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 720 872 m 23 6 d -20
- 15 d -23 -6 d f black 720 872 m 23 6 d -20 15 d -23 -6 d cl s 0 0 0.8 c 696 866
- m 24 6 d -20 15 d -24 -6 d f black 696 866 m 24 6 d -20 15 d -24 -6 d cl s 0 0
- 0.8 c 673 860 m 23 6 d -20 15 d -23 -6 d f black 673 860 m 23 6 d -20 15 d -23
- -6 d cl s 0 0 0.8 c 649 854 m 24 6 d -20 15 d -24 -6 d f black 649 854 m 24 6 d
- -20 15 d -24 -6 d cl s 0 0 0.8 c 1774 1119 m 23 6 d -20 16 d -24 -6 d f black
- 1774 1119 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1750 1113 m 24 6 d -21 16 d
- -23 -6 d f black 1750 1113 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1727 1107
- m 23 6 d -20 16 d -24 -6 d f black 1727 1107 m 23 6 d -20 16 d -24 -6 d cl s 0
- 0 0.8 c 1703 1101 m 24 6 d -21 16 d -23 -6 d f black 1703 1101 m 24 6 d -21 16
- d -23 -6 d cl s 0 0 0.8 c 1680 1095 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 1703
- 1163 m 63 Y -23 -6 d -63 Y f 0 0.4 0.8 c 1703 1226 m 62 Y -23 -6 d -62 Y f 0
- 0.6 0.8 c 1703 1288 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 1703 1350 m 47 Y -23 -6
- d -47 Y f black 1680 1095 m 23 6 d 296 Y -23 -6 d cl s 0 0 0.8 c 1660 1111 m 20
- -16 d 62 Y -20 16 d f 0 0.2 0.8 c 1680 1157 m 63 Y -20 15 d -62 Y f 0 0.4 0.8 c
- 1680 1220 m 62 Y -20 15 d -62 Y f 0 0.6 0.8 c 1680 1282 m 62 Y -20 15 d -62 Y f
- 0 0.8 0.8 c 1680 1344 m 47 Y -20 15 d -47 Y f black 1660 1111 m 20 -16 d 296 Y
- -20 15 d cl s 0 0.8 0.8 c 1680 1391 m 23 6 d -20 15 d -23 -6 d f black 1680
- 1391 m 23 6 d -20 15 d -23 -6 d cl s 0 0 0.8 c 1656 1089 m 24 6 d 62 Y -24 -6 d
- f 0 0.2 0.8 c 1680 1157 m 63 Y -24 -6 d -63 Y f 0 0.4 0.8 c 1680 1220 m 62 Y
- -24 -6 d -62 Y f 0 0.6 0.8 c 1680 1282 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 1680
- 1344 m 62 Y -24 -6 d -62 Y f 0 0.8 0.6 c 1680 1406 m 39 Y -24 -6 d -39 Y f
- black 1656 1089 m 24 6 d 350 Y -24 -6 d cl s 0 0 0.8 c 1636 1105 m 20 -16 d 62
- Y -20 16 d f 0 0.2 0.8 c 1656 1151 m 63 Y -20 15 d -62 Y f 0 0.4 0.8 c 1656
- 1214 m 62 Y -20 15 d -62 Y f 0 0.6 0.8 c 1656 1276 m 62 Y -20 15 d -62 Y f 0
- 0.8 0.8 c 1656 1338 m 62 Y -20 16 d -63 Y f 0 0.8 0.6 c 1656 1400 m 39 Y -20 15
- d -38 Y f black 1636 1105 m 20 -16 d 350 Y -20 15 d cl s 0 0.8 0.6 c 1656 1439
- m 24 6 d -20 15 d -24 -6 d f black 1656 1439 m 24 6 d -20 15 d -24 -6 d cl s 0
- 0 0.8 c 1633 1083 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 1656 1151 m 63 Y -23 -6
- d -63 Y f 0 0.4 0.8 c 1656 1214 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c 1656 1276 m
- 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 1656 1338 m 62 Y -23 -6 d -62 Y f 0 0.8 0.6 c
- 1656 1400 m 12 Y -23 -6 d -12 Y f black 1633 1083 m 23 6 d 323 Y -23 -6 d cl s
- 0 0 0.8 c 1613 1099 m 20 -16 d 62 Y -20 16 d f 0 0.2 0.8 c 1633 1145 m 63 Y -20
- 15 d -62 Y f 0 0.4 0.8 c 1633 1208 m 62 Y -20 15 d -62 Y f 0 0.6 0.8 c 1633
- 1270 m 62 Y -20 15 d -62 Y f 0 0.8 0.8 c 1633 1332 m 62 Y -20 16 d -63 Y f 0
- 0.8 0.6 c 1633 1394 m 12 Y -20 15 d -11 Y f black 1613 1099 m 20 -16 d 323 Y
- -20 15 d cl s 0 0.8 0.6 c 1633 1406 m 23 6 d -20 15 d -23 -6 d f black 1633
- 1406 m 23 6 d -20 15 d -23 -6 d cl s 0 0 0.8 c 1609 1077 m 24 6 d 62 Y -24 -6 d
- f 0 0.2 0.8 c 1633 1145 m 63 Y -24 -6 d -63 Y f 0 0.4 0.8 c 1633 1208 m 50 Y
- -24 -6 d -50 Y f black 1609 1077 m 24 6 d 175 Y -24 -6 d cl s 0 0 0.8 c 1589
- 1093 m 20 -16 d 62 Y -20 16 d f 0 0.2 0.8 c 1609 1139 m 63 Y -20 15 d -62 Y f 0
- 0.4 0.8 c 1609 1202 m 50 Y -20 16 d -51 Y f black 1589 1093 m 20 -16 d 175 Y
- -20 16 d cl s 0 0.4 0.8 c 1609 1252 m 24 6 d -20 16 d -24 -6 d f black 1609
- 1252 m 24 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1586 1071 m 23 6 d 62 Y -23 -6 d
- f 0 0.2 0.8 c 1609 1139 m 63 Y -23 -6 d -63 Y f 0 0.4 0.8 c 1609 1202 m 62 Y
- -23 -6 d -62 Y f 0 0.6 0.8 c 1609 1264 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 1609
- 1326 m 47 Y -23 -6 d -47 Y f black 1586 1071 m 23 6 d 296 Y -23 -6 d cl s 0 0
- 0.8 c 1566 1087 m 20 -16 d 62 Y -20 16 d f 0 0.2 0.8 c 1586 1133 m 63 Y -20 15
- d -62 Y f 0 0.4 0.8 c 1586 1196 m 62 Y -20 15 d -62 Y f 0 0.6 0.8 c 1586 1258 m
- 62 Y -20 15 d -62 Y f 0 0.8 0.8 c 1586 1320 m 47 Y -20 15 d -47 Y f black 1566
- 1087 m 20 -16 d 296 Y -20 15 d cl s 0 0.8 0.8 c 1586 1367 m 23 6 d -20 15 d -23
- -6 d f black 1586 1367 m 23 6 d -20 15 d -23 -6 d cl s 0 0 0.8 c 1562 1065 m 24
- 6 d 62 Y -24 -5 d f 0 0.2 0.8 c 1586 1133 m 63 Y -24 -6 d -62 Y f 0 0.4 0.8 c
- 1586 1196 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 1586 1258 m 55 Y -24 -6 d -55 Y f
- black 1562 1065 m 24 6 d 242 Y -24 -6 d cl s 0 0 0.8 c 1542 1081 m 20 -16 d 63
- Y -20 15 d f 0 0.2 0.8 c 1562 1128 m 62 Y -20 15 d -62 Y f 0 0.4 0.8 c 1562
- 1190 m 62 Y -20 15 d -62 Y f 0 0.6 0.8 c 1562 1252 m 55 Y -20 16 d -56 Y f
- black 1542 1081 m 20 -16 d 242 Y -20 16 d cl s 0 0.6 0.8 c 1562 1307 m 24 6 d
- -20 16 d -24 -6 d f black 1562 1307 m 24 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c
- 1539 1059 m 23 6 d 63 Y -23 -6 d f 0 0.2 0.8 c 1562 1128 m 62 Y -23 -6 d -62 Y
- f 0 0.4 0.8 c 1562 1190 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c 1562 1252 m 15 Y
- -23 -6 d -15 Y f black 1539 1059 m 23 6 d 202 Y -23 -6 d cl s 0 0 0.8 c 1519
- 1075 m 20 -16 d 63 Y -20 15 d f 0 0.2 0.8 c 1539 1122 m 62 Y -20 15 d -62 Y f 0
- 0.4 0.8 c 1539 1184 m 62 Y -20 15 d -62 Y f 0 0.6 0.8 c 1539 1246 m 15 Y -20 15
- d -15 Y f black 1519 1075 m 20 -16 d 202 Y -20 15 d cl s 0 0.6 0.8 c 1539 1261
- m 23 6 d -20 15 d -23 -6 d f black 1539 1261 m 23 6 d -20 15 d -23 -6 d cl s 0
- 0 0.8 c 1515 1053 m 24 6 d 63 Y -24 -6 d f 0 0.2 0.8 c 1539 1122 m 62 Y -24 -6
- d -62 Y f 0 0.4 0.8 c 1539 1184 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 1539 1246 m
- 15 Y -24 -6 d -15 Y f black 1515 1053 m 24 6 d 202 Y -24 -6 d cl s 0 0 0.8 c
- 1495 1069 m 20 -16 d 63 Y -20 15 d f 0 0.2 0.8 c 1515 1116 m 62 Y -20 15 d -62
- Y f 0 0.4 0.8 c 1515 1178 m 62 Y -20 15 d -62 Y f 0 0.6 0.8 c 1515 1240 m 15 Y
- -20 15 d -15 Y f black 1495 1069 m 20 -16 d 202 Y -20 15 d cl s 0 0.6 0.8 c
- 1515 1255 m 24 6 d -20 15 d -24 -6 d f black 1515 1255 m 24 6 d -20 15 d -24 -6
- d cl s 0 0 0.8 c 1492 1047 m 23 6 d 63 Y -23 -6 d f 0 0.2 0.8 c 1515 1116 m 62
- Y -23 -6 d -62 Y f 0 0.4 0.8 c 1515 1178 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c
- 1515 1240 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 1515 1302 m 62 Y -23 -6 d -62 Y f
- 0 0.8 0.6 c 1515 1364 m 25 Y -23 -6 d -25 Y f black 1492 1047 m 23 6 d 336 Y
- -23 -6 d cl s 0 0 0.8 c 1472 1063 m 20 -16 d 63 Y -20 15 d f 0 0.2 0.8 c 1492
- 1110 m 62 Y -20 15 d -62 Y f 0 0.4 0.8 c 1492 1172 m 62 Y -20 15 d -62 Y f 0
- 0.6 0.8 c 1492 1234 m 62 Y -20 16 d -63 Y f 0 0.8 0.8 c 1492 1296 m 62 Y -20 16
- d -62 Y f 0 0.8 0.6 c 1492 1358 m 25 Y -20 16 d -25 Y f black 1472 1063 m 20
- -16 d 336 Y -20 16 d cl s 0 0.8 0.6 c 1492 1383 m 23 6 d -20 16 d -23 -6 d f
- black 1492 1383 m 23 6 d -20 16 d -23 -6 d cl s 0 0 0.8 c 1468 1041 m 24 6 d 63
- Y -24 -6 d f 0 0.2 0.8 c 1492 1110 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 1492
- 1172 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 1492 1234 m 62 Y -24 -6 d -62 Y f 0
- 0.8 0.8 c 1492 1296 m 60 Y -24 -6 d -60 Y f black 1468 1041 m 24 6 d 309 Y -24
- -6 d cl s 0 0 0.8 c 1448 1057 m 20 -16 d 63 Y -20 15 d f 0 0.2 0.8 c 1468 1104
- m 62 Y -20 15 d -62 Y f 0 0.4 0.8 c 1468 1166 m 62 Y -20 15 d -62 Y f 0 0.6 0.8
- c 1468 1228 m 62 Y -20 16 d -63 Y f 0 0.8 0.8 c 1468 1290 m 60 Y -20 16 d -60 Y
- f black 1448 1057 m 20 -16 d 309 Y -20 16 d cl s 0 0.8 0.8 c 1468 1350 m 24 6 d
- -20 16 d -24 -6 d f black 1468 1350 m 24 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c
- 1445 1035 m 23 6 d 63 Y -23 -6 d f 0 0.2 0.8 c 1468 1104 m 62 Y -23 -6 d -62 Y
- f 0 0.4 0.8 c 1468 1166 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c 1468 1228 m 62 Y
- -23 -6 d -62 Y f 0 0.8 0.8 c 1468 1290 m 62 Y -23 -6 d -62 Y f 0 0.8 0.6 c 1468
- 1352 m 39 Y -23 -6 d -39 Y f black 1445 1035 m 23 6 d 350 Y -23 -6 d cl s 0 0
- 0.8 c 1425 1051 m 20 -16 d 63 Y -20 15 d f 0 0.2 0.8 c 1445 1098 m 62 Y -20 15
- d -62 Y f 0 0.4 0.8 c 1445 1160 m 62 Y -20 15 d -62 Y f 0 0.6 0.8 c 1445 1222 m
- 62 Y -20 16 d -63 Y f 0 0.8 0.8 c 1445 1284 m 62 Y -20 16 d -62 Y f 0 0.8 0.6 c
- 1445 1346 m 39 Y -20 15 d -38 Y f black 1425 1051 m 20 -16 d 350 Y -20 15 d
- cl s 0 0.8 0.6 c 1445 1385 m 23 6 d -20 15 d -23 -6 d f black 1445 1385 m 23 6
- d -20 15 d -23 -6 d cl s 0 0 0.8 c 1421 1029 m 24 6 d 63 Y -24 -6 d f 0 0.2 0.8
- c 1445 1098 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 1445 1160 m 62 Y -24 -6 d -62 Y
- f 0 0.6 0.8 c 1445 1222 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 1445 1284 m 7 Y -24
- -6 d -7 Y f black 1421 1029 m 24 6 d 256 Y -24 -6 d cl s 0 0 0.8 c 1401 1045 m
- 20 -16 d 63 Y -20 15 d f 0 0.2 0.8 c 1421 1092 m 62 Y -20 15 d -62 Y f 0 0.4
- 0.8 c 1421 1154 m 62 Y -20 15 d -62 Y f 0 0.6 0.8 c 1421 1216 m 62 Y -20 16 d
- -63 Y f 0 0.8 0.8 c 1421 1278 m 7 Y -20 15 d -6 Y f black 1401 1045 m 20 -16 d
- 256 Y -20 15 d cl s 0 0.8 0.8 c 1421 1285 m 24 6 d -20 15 d -24 -6 d f black
- 1421 1285 m 24 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1398 1024 m 23 5 d 63 Y -23
- -6 d f 0 0.2 0.8 c 1421 1092 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 1421 1154 m 62
- Y -23 -6 d -62 Y f 0 0.6 0.8 c 1421 1216 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c
- 1421 1278 m 62 Y -23 -6 d -62 Y f 0 0.8 0.6 c 1421 1340 m 39 Y -23 -6 d -39 Y f
- black 1398 1024 m 23 5 d 350 Y -23 -6 d cl s 0 0 0.8 c 1378 1039 m 20 -15 d 62
- Y -20 15 d f 0 0.2 0.8 c 1398 1086 m 62 Y -20 15 d -62 Y f 0 0.4 0.8 c 1398
- 1148 m 62 Y -20 15 d -62 Y f 0 0.6 0.8 c 1398 1210 m 62 Y -20 16 d -63 Y f 0
- 0.8 0.8 c 1398 1272 m 62 Y -20 16 d -62 Y f 0 0.8 0.6 c 1398 1334 m 39 Y -20 15
- d -38 Y f black 1378 1039 m 20 -15 d 349 Y -20 15 d cl s 0 0.8 0.6 c 1398 1373
- m 23 6 d -20 15 d -23 -6 d f black 1398 1373 m 23 6 d -20 15 d -23 -6 d cl s 0
- 0 0.8 c 1374 1018 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1398 1086 m 62 Y -24 -6
- d -62 Y f 0 0.4 0.8 c 1398 1148 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 1398 1210 m
- 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 1398 1272 m 47 Y -24 -6 d -47 Y f black 1374
- 1018 m 24 6 d 295 Y -24 -6 d cl s 0 0 0.8 c 1354 1033 m 20 -15 d 62 Y -20 15 d
- f 0 0.2 0.8 c 1374 1080 m 62 Y -20 15 d -62 Y f 0 0.4 0.8 c 1374 1142 m 62 Y
- -20 15 d -62 Y f 0 0.6 0.8 c 1374 1204 m 62 Y -20 16 d -63 Y f 0 0.8 0.8 c 1374
- 1266 m 47 Y -20 16 d -47 Y f black 1354 1033 m 20 -15 d 295 Y -20 16 d cl s 0
- 0.8 0.8 c 1374 1313 m 24 6 d -20 16 d -24 -6 d f black 1374 1313 m 24 6 d -20
- 16 d -24 -6 d cl s 0 0 0.8 c 1351 1012 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c
- 1374 1080 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 1374 1142 m 62 Y -23 -6 d -62 Y f
- 0 0.6 0.8 c 1374 1204 m 55 Y -23 -6 d -55 Y f black 1351 1012 m 23 6 d 241 Y
- -23 -6 d cl s 0 0 0.8 c 1331 1027 m 20 -15 d 62 Y -20 15 d f 0 0.2 0.8 c 1351
- 1074 m 62 Y -20 15 d -62 Y f 0 0.4 0.8 c 1351 1136 m 62 Y -20 16 d -63 Y f 0
- 0.6 0.8 c 1351 1198 m 55 Y -20 16 d -55 Y f black 1331 1027 m 20 -15 d 241 Y
- -20 16 d cl s 0 0.6 0.8 c 1351 1253 m 23 6 d -20 16 d -23 -6 d f black 1351
- 1253 m 23 6 d -20 16 d -23 -6 d cl s 0 0 0.8 c 1328 1006 m 23 6 d 62 Y -23 -6 d
- f 0 0.2 0.8 c 1351 1074 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 1351 1136 m 62 Y
- -23 -6 d -62 Y f 0 0.6 0.8 c 1351 1198 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 1351
- 1260 m 62 Y -23 -6 d -62 Y f 0 0.8 0.6 c 1351 1322 m 39 Y -23 -6 d -39 Y f
- black 1328 1006 m 23 6 d 349 Y -23 -6 d cl s 0 0 0.8 c 1307 1021 m 21 -15 d 62
- Y -21 15 d f 0 0.2 0.8 c 1328 1068 m 62 Y -21 15 d -62 Y f 0 0.4 0.8 c 1328
- 1130 m 62 Y -21 16 d -63 Y f 0 0.6 0.8 c 1328 1192 m 62 Y -21 16 d -62 Y f 0
- 0.8 0.8 c 1328 1254 m 62 Y -21 16 d -62 Y f 0 0.8 0.6 c 1328 1316 m 39 Y -21 15
- d -38 Y f black 1307 1021 m 21 -15 d 349 Y -21 15 d cl s 0 0.8 0.6 c 1328 1355
- m 23 6 d -20 15 d -24 -6 d f black 1328 1355 m 23 6 d -20 15 d -24 -6 d cl s 0
- 0 0.8 c 1304 1000 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1328 1068 m 62 Y -24 -6
- d -62 Y f 0 0.4 0.8 c 1328 1130 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 1328 1192 m
- 55 Y -24 -6 d -55 Y f black 1304 1000 m 24 6 d 241 Y -24 -6 d cl s 0 0 0.8 c
- 1284 1015 m 20 -15 d 62 Y -20 15 d f 0 0.2 0.8 c 1304 1062 m 62 Y -20 15 d -62
- Y f 0 0.4 0.8 c 1304 1124 m 62 Y -20 16 d -63 Y f 0 0.6 0.8 c 1304 1186 m 55 Y
- -20 16 d -55 Y f black 1284 1015 m 20 -15 d 241 Y -20 16 d cl s 0 0.6 0.8 c
- 1304 1241 m 24 6 d -21 16 d -23 -6 d f black 1304 1241 m 24 6 d -21 16 d -23 -6
- d cl s 0 0 0.8 c 1281 994 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 1304 1062 m 62 Y
- -23 -6 d -62 Y f 0 0.4 0.8 c 1304 1124 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c 1304
- 1186 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 1304 1248 m 47 Y -23 -6 d -47 Y f
- black 1281 994 m 23 6 d 295 Y -23 -6 d cl s 0 0 0.8 c 1260 1009 m 21 -15 d 62 Y
- -21 15 d f 0 0.2 0.8 c 1281 1056 m 62 Y -21 15 d -62 Y f 0 0.4 0.8 c 1281 1118
- m 62 Y -21 16 d -63 Y f 0 0.6 0.8 c 1281 1180 m 62 Y -21 16 d -62 Y f 0 0.8 0.8
- c 1281 1242 m 47 Y -21 16 d -47 Y f black 1260 1009 m 21 -15 d 295 Y -21 16 d
- cl s 0 0.8 0.8 c 1281 1289 m 23 6 d -20 16 d -24 -6 d f black 1281 1289 m 23 6
- d -20 16 d -24 -6 d cl s 0 0 0.8 c 1257 988 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8
- c 1281 1056 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 1281 1118 m 62 Y -24 -6 d -62 Y
- f 0 0.6 0.8 c 1281 1180 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 1281 1242 m 7 Y -24
- -6 d -7 Y f black 1257 988 m 24 6 d 255 Y -24 -6 d cl s 0 0 0.8 c 1237 1003 m
- 20 -15 d 62 Y -20 15 d f 0 0.2 0.8 c 1257 1050 m 62 Y -20 15 d -62 Y f 0 0.4
- 0.8 c 1257 1112 m 62 Y -20 16 d -63 Y f 0 0.6 0.8 c 1257 1174 m 62 Y -20 16 d
- -62 Y f 0 0.8 0.8 c 1257 1236 m 7 Y -20 15 d -6 Y f black 1237 1003 m 20 -15 d
- 255 Y -20 15 d cl s 0 0.8 0.8 c 1257 1243 m 24 6 d -21 15 d -23 -6 d f black
- 1257 1243 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 1234 982 m 23 6 d 62 Y -23
- -6 d f 0 0.2 0.8 c 1257 1050 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 1257 1112 m 62
- Y -23 -6 d -62 Y f 0 0.6 0.8 c 1257 1174 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c
- 1257 1236 m 7 Y -23 -6 d -7 Y f black 1234 982 m 23 6 d 255 Y -23 -6 d cl s 0 0
- 0.8 c 1213 997 m 21 -15 d 62 Y -21 15 d f 0 0.2 0.8 c 1234 1044 m 62 Y -21 15 d
- -62 Y f 0 0.4 0.8 c 1234 1106 m 62 Y -21 16 d -63 Y f 0 0.6 0.8 c 1234 1168 m
- 62 Y -21 16 d -62 Y f 0 0.8 0.8 c 1234 1230 m 7 Y -21 15 d -6 Y f black 1213
- 997 m 21 -15 d 255 Y -21 15 d cl s 0 0.8 0.8 c 1234 1237 m 23 6 d -20 15 d -24
- -6 d f black 1234 1237 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1210 976 m 24
- 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1234 1044 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c
- 1234 1106 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 1234 1168 m 62 Y -24 -6 d -62 Y f
- 0 0.8 0.8 c 1234 1230 m 62 Y -24 -6 d -62 Y f 0 0.8 0.6 c 1234 1292 m 63 Y -24
- -6 d -63 Y f 0 0.8 0.4 c 1234 1355 m 62 Y -24 -6 d -62 Y f 0 0.8 0.2 c 1234
- 1417 m 8 Y -24 -6 d -8 Y f black 1210 976 m 24 6 d 443 Y -24 -6 d cl s 0 0 0.8
- c 1190 991 m 20 -15 d 62 Y -20 15 d f 0 0.2 0.8 c 1210 1038 m 62 Y -20 15 d -62
- Y f 0 0.4 0.8 c 1210 1100 m 62 Y -20 16 d -63 Y f 0 0.6 0.8 c 1210 1162 m 62 Y
- -20 16 d -62 Y f 0 0.8 0.8 c 1210 1224 m 62 Y -20 16 d -62 Y f 0 0.8 0.6 c 1210
- 1286 m 63 Y -20 15 d -62 Y f 0 0.8 0.4 c 1210 1349 m 62 Y -20 15 d -62 Y f 0
- 0.8 0.2 c 1210 1411 m 8 Y -20 16 d -9 Y f black 1190 991 m 20 -15 d 443 Y -20
- 16 d cl s 0 0.8 0.2 c 1210 1419 m 24 6 d -21 16 d -23 -6 d f black 1210 1419 m
- 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1187 970 m 23 6 d 62 Y -23 -6 d f 0 0.2
- 0.8 c 1210 1038 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 1210 1100 m 62 Y -23 -6 d
- -62 Y f 0 0.6 0.8 c 1210 1162 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 1210 1224 m
- 61 Y -23 -6 d -61 Y f black 1187 970 m 23 6 d 309 Y -23 -6 d cl s 0 0 0.8 c
- 1166 985 m 21 -15 d 62 Y -21 15 d f 0 0.2 0.8 c 1187 1032 m 62 Y -21 16 d -63 Y
- f 0 0.4 0.8 c 1187 1094 m 62 Y -21 16 d -62 Y f 0 0.6 0.8 c 1187 1156 m 62 Y
- -21 16 d -62 Y f 0 0.8 0.8 c 1187 1218 m 61 Y -21 15 d -60 Y f black 1166 985 m
- 21 -15 d 309 Y -21 15 d cl s 0 0.8 0.8 c 1187 1279 m 23 6 d -20 15 d -24 -6 d f
- black 1187 1279 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1163 964 m 24 6 d 62
- Y -24 -6 d f 0 0.2 0.8 c 1187 1032 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 1187
- 1094 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 1187 1156 m 62 Y -24 -6 d -62 Y f 0
- 0.8 0.8 c 1187 1218 m 20 Y -24 -6 d -20 Y f black 1163 964 m 24 6 d 268 Y -24
- -6 d cl s 0 0 0.8 c 1143 979 m 20 -15 d 62 Y -20 15 d f 0 0.2 0.8 c 1163 1026 m
- 62 Y -20 16 d -63 Y f 0 0.4 0.8 c 1163 1088 m 62 Y -20 16 d -62 Y f 0 0.6 0.8 c
- 1163 1150 m 62 Y -20 16 d -62 Y f 0 0.8 0.8 c 1163 1212 m 20 Y -20 16 d -20 Y f
- black 1143 979 m 20 -15 d 268 Y -20 16 d cl s 0 0.8 0.8 c 1163 1232 m 24 6 d
- -21 16 d -23 -6 d f black 1163 1232 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c
- 1140 958 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 1163 1026 m 62 Y -23 -6 d -62 Y f
- 0 0.4 0.8 c 1163 1088 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c 1163 1150 m 56 Y -23
- -6 d -56 Y f black 1140 958 m 23 6 d 242 Y -23 -6 d cl s 0 0 0.8 c 1119 973 m
- 21 -15 d 62 Y -21 15 d f 0 0.2 0.8 c 1140 1020 m 62 Y -21 16 d -63 Y f 0 0.4
- 0.8 c 1140 1082 m 62 Y -21 16 d -62 Y f 0 0.6 0.8 c 1140 1144 m 56 Y -21 15 d
- -55 Y f black 1119 973 m 21 -15 d 242 Y -21 15 d cl s 0 0.6 0.8 c 1140 1200 m
- 23 6 d -20 15 d -24 -6 d f black 1140 1200 m 23 6 d -20 15 d -24 -6 d cl s 0 0
- 0.8 c 1116 952 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1140 1020 m 62 Y -24 -6 d
- -62 Y f 0 0.4 0.8 c 1140 1082 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 1140 1144 m
- 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 1140 1206 m 20 Y -24 -6 d -20 Y f black 1116
- 952 m 24 6 d 268 Y -24 -6 d cl s 0 0 0.8 c 1096 967 m 20 -15 d 62 Y -20 15 d f
- 0 0.2 0.8 c 1116 1014 m 62 Y -20 16 d -63 Y f 0 0.4 0.8 c 1116 1076 m 62 Y -20
- 16 d -62 Y f 0 0.6 0.8 c 1116 1138 m 62 Y -20 16 d -62 Y f 0 0.8 0.8 c 1116
- 1200 m 20 Y -20 16 d -20 Y f black 1096 967 m 20 -15 d 268 Y -20 16 d cl s 0
- 0.8 0.8 c 1116 1220 m 24 6 d -21 16 d -23 -6 d f black 1116 1220 m 24 6 d -21
- 16 d -23 -6 d cl s 0 0 0.8 c 1093 946 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 1116
- 1014 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 1116 1076 m 62 Y -23 -6 d -62 Y f 0
- 0.6 0.8 c 1116 1138 m 2 Y -23 -6 d -2 Y f black 1093 946 m 23 6 d 188 Y -23 -6
- d cl s 0 0 0.8 c 1072 961 m 21 -15 d 62 Y -21 15 d f 0 0.2 0.8 c 1093 1008 m 62
- Y -21 16 d -63 Y f 0 0.4 0.8 c 1093 1070 m 62 Y -21 16 d -62 Y f 0 0.6 0.8 c
- 1093 1132 m 2 Y -21 15 d -1 Y f black 1072 961 m 21 -15 d 188 Y -21 15 d cl s 0
- 0.6 0.8 c 1093 1134 m 23 6 d -20 15 d -24 -6 d f black 1093 1134 m 23 6 d -20
- 15 d -24 -6 d cl s 0 0 0.8 c 1069 940 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1093
- 1008 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 1093 1070 m 62 Y -24 -6 d -62 Y f 0
- 0.6 0.8 c 1093 1132 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 1093 1194 m 62 Y -24 -5
- d -63 Y f 0 0.8 0.6 c 1093 1256 m 26 Y -24 -6 d -25 Y f black 1069 940 m 24 6 d
- 336 Y -24 -6 d cl s 0 0 0.8 c 1049 955 m 20 -15 d 62 Y -20 15 d f 0 0.2 0.8 c
- 1069 1002 m 62 Y -20 16 d -63 Y f 0 0.4 0.8 c 1069 1064 m 62 Y -20 16 d -62 Y f
- 0 0.6 0.8 c 1069 1126 m 62 Y -20 16 d -62 Y f 0 0.8 0.8 c 1069 1188 m 63 Y -20
- 15 d -62 Y f 0 0.8 0.6 c 1069 1251 m 25 Y -20 15 d -25 Y f black 1049 955 m 20
- -15 d 336 Y -20 15 d cl s 0 0.8 0.6 c 1069 1276 m 24 6 d -21 15 d -23 -6 d f
- black 1069 1276 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 1046 934 m 23 6 d 62
- Y -23 -6 d f 0 0.2 0.8 c 1069 1002 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 1069
- 1064 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c 1069 1126 m 62 Y -23 -6 d -62 Y f 0
- 0.8 0.8 c 1069 1188 m 63 Y -23 -6 d -63 Y f 0 0.8 0.6 c 1069 1251 m 62 Y -23 -6
- d -62 Y f 0 0.8 0.4 c 1069 1313 m 43 Y -23 -6 d -43 Y f black 1046 934 m 23 6 d
- 416 Y -23 -6 d cl s 0 0 0.8 c 1025 949 m 21 -15 d 62 Y -21 15 d f 0 0.2 0.8 c
- 1046 996 m 62 Y -21 16 d -63 Y f 0 0.4 0.8 c 1046 1058 m 62 Y -21 16 d -62 Y f
- 0 0.6 0.8 c 1046 1120 m 62 Y -21 16 d -62 Y f 0 0.8 0.8 c 1046 1182 m 63 Y -21
- 15 d -62 Y f 0 0.8 0.6 c 1046 1245 m 62 Y -21 15 d -62 Y f 0 0.8 0.4 c 1046
- 1307 m 43 Y -21 16 d -44 Y f black 1025 949 m 21 -15 d 416 Y -21 16 d cl s 0
- 0.8 0.4 c 1046 1350 m 23 6 d -20 16 d -24 -6 d f black 1046 1350 m 23 6 d -20
- 16 d -24 -6 d cl s 0 0 0.8 c 1022 928 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1046
- 996 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 1046 1058 m 62 Y -24 -6 d -62 Y f 0 0.6
- 0.8 c 1046 1120 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 1046 1182 m 47 Y -24 -6 d
- -47 Y f black 1022 928 m 24 6 d 295 Y -24 -6 d cl s 0 0 0.8 c 1002 943 m 20 -15
- d 62 Y -20 16 d f 0 0.2 0.8 c 1022 990 m 62 Y -20 16 d -62 Y f 0 0.4 0.8 c 1022
- 1052 m 62 Y -20 16 d -62 Y f 0 0.6 0.8 c 1022 1114 m 62 Y -20 16 d -62 Y f 0
- 0.8 0.8 c 1022 1176 m 47 Y -20 16 d -47 Y f black 1002 943 m 20 -15 d 295 Y -20
- 16 d cl s 0 0.8 0.8 c 1022 1223 m 24 6 d -21 16 d -23 -6 d f black 1022 1223 m
- 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 999 922 m 23 6 d 62 Y -23 -6 d f 0 0.2
- 0.8 c 1022 990 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 1022 1052 m 62 Y -23 -6 d
- -62 Y f 0 0.6 0.8 c 1022 1114 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 1022 1176 m
- 21 Y -23 -6 d -21 Y f black 999 922 m 23 6 d 269 Y -23 -6 d cl s 0 0 0.8 c 978
- 937 m 21 -15 d 62 Y -21 16 d f 0 0.2 0.8 c 999 984 m 62 Y -21 16 d -62 Y f 0
- 0.4 0.8 c 999 1046 m 62 Y -21 16 d -62 Y f 0 0.6 0.8 c 999 1108 m 62 Y -21 16 d
- -62 Y f 0 0.8 0.8 c 999 1170 m 21 Y -21 15 d -20 Y f black 978 937 m 21 -15 d
- 269 Y -21 15 d cl s 0 0.8 0.8 c 999 1191 m 23 6 d -20 15 d -24 -6 d f black 999
- 1191 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 975 916 m 24 6 d 62 Y -24 -6 d f
- 0 0.2 0.8 c 999 984 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 999 1046 m 62 Y -24 -6
- d -62 Y f 0 0.6 0.8 c 999 1108 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 999 1170 m
- 47 Y -24 -6 d -47 Y f black 975 916 m 24 6 d 295 Y -24 -6 d cl s 0 0 0.8 c 955
- 931 m 20 -15 d 62 Y -20 16 d f 0 0.2 0.8 c 975 978 m 62 Y -20 16 d -62 Y f 0
- 0.4 0.8 c 975 1040 m 62 Y -20 16 d -62 Y f 0 0.6 0.8 c 975 1102 m 62 Y -20 16 d
- -62 Y f 0 0.8 0.8 c 975 1164 m 47 Y -20 16 d -47 Y f black 955 931 m 20 -15 d
- 295 Y -20 16 d cl s 0 0.8 0.8 c 975 1211 m 24 6 d -21 16 d -23 -6 d f black 975
- 1211 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 952 910 m 23 6 d 62 Y -23 -6 d f
- 0 0.2 0.8 c 975 978 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 975 1040 m 62 Y -23 -6
- d -62 Y f 0 0.6 0.8 c 975 1102 m 42 Y -23 -6 d -42 Y f black 952 910 m 23 6 d
- 228 Y -23 -6 d cl s 0 0 0.8 c 931 925 m 21 -15 d 62 Y -21 16 d f 0 0.2 0.8 c
- 952 972 m 62 Y -21 16 d -62 Y f 0 0.4 0.8 c 952 1034 m 62 Y -21 16 d -62 Y f 0
- 0.6 0.8 c 952 1096 m 42 Y -21 16 d -42 Y f black 931 925 m 21 -15 d 228 Y -21
- 16 d cl s 0 0.6 0.8 c 952 1138 m 23 6 d -20 16 d -24 -6 d f black 952 1138 m 23
- 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 928 904 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8
- c 952 972 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 952 1034 m 62 Y -24 -6 d -62 Y f
- 0 0.6 0.8 c 952 1096 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 952 1158 m 21 Y -24 -6
- d -21 Y f black 928 904 m 24 6 d 269 Y -24 -6 d cl s 0 0 0.8 c 908 919 m 20 -15
- d 62 Y -20 16 d f 0 0.2 0.8 c 928 966 m 62 Y -20 16 d -62 Y f 0 0.4 0.8 c 928
- 1028 m 62 Y -20 16 d -62 Y f 0 0.6 0.8 c 928 1090 m 62 Y -20 16 d -62 Y f 0 0.8
- 0.8 c 928 1152 m 21 Y -20 15 d -20 Y f black 908 919 m 20 -15 d 269 Y -20 15 d
- cl s 0 0.8 0.8 c 928 1173 m 24 6 d -21 15 d -23 -6 d f black 928 1173 m 24 6 d
- -21 15 d -23 -6 d cl s 0 0 0.8 c 905 898 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c
- 928 966 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 928 1028 m 62 Y -23 -6 d -62 Y f 0
- 0.6 0.8 c 928 1090 m 62 Y -23 -5 d -63 Y f 0 0.8 0.8 c 928 1152 m 63 Y -23 -6 d
- -62 Y f 0 0.8 0.6 c 928 1215 m 25 Y -23 -6 d -25 Y f black 905 898 m 23 6 d 336
- Y -23 -6 d cl s 0 0 0.8 c 884 913 m 21 -15 d 62 Y -21 16 d f 0 0.2 0.8 c 905
- 960 m 62 Y -21 16 d -62 Y f 0 0.4 0.8 c 905 1022 m 62 Y -21 16 d -62 Y f 0 0.6
- 0.8 c 905 1084 m 63 Y -21 15 d -62 Y f 0 0.8 0.8 c 905 1147 m 62 Y -21 15 d -62
- Y f 0 0.8 0.6 c 905 1209 m 25 Y -21 15 d -25 Y f black 884 913 m 21 -15 d 336 Y
- -21 15 d cl s 0 0.8 0.6 c 905 1234 m 23 6 d -20 15 d -24 -6 d f black 905 1234
- m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 881 892 m 24 6 d 62 Y -24 -6 d f 0
- 0.2 0.8 c 905 960 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 905 1022 m 62 Y -24 -6 d
- -62 Y f 0 0.6 0.8 c 905 1084 m 63 Y -24 -6 d -63 Y f 0 0.8 0.8 c 905 1147 m 20
- Y -24 -6 d -20 Y f black 881 892 m 24 6 d 269 Y -24 -6 d cl s 0 0 0.8 c 861 907
- m 20 -15 d 62 Y -20 16 d f 0 0.2 0.8 c 881 954 m 62 Y -20 16 d -62 Y f 0 0.4
- 0.8 c 881 1016 m 62 Y -20 16 d -62 Y f 0 0.6 0.8 c 881 1078 m 63 Y -20 15 d -62
- Y f 0 0.8 0.8 c 881 1141 m 20 Y -20 15 d -20 Y f black 861 907 m 20 -15 d 269 Y
- -20 15 d cl s 0 0.8 0.8 c 881 1161 m 24 6 d -21 15 d -23 -6 d f black 881 1161
- m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 858 886 m 23 6 d 62 Y -23 -6 d f 0
- 0.2 0.8 c 881 954 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 881 1016 m 62 Y -23 -6 d
- -62 Y f 0 0.6 0.8 c 881 1078 m 63 Y -23 -6 d -63 Y f 0 0.8 0.8 c 881 1141 m 47
- Y -23 -6 d -47 Y f black 858 886 m 23 6 d 296 Y -23 -6 d cl s 0 0 0.8 c 837 902
- m 21 -16 d 62 Y -21 16 d f 0 0.2 0.8 c 858 948 m 62 Y -21 16 d -62 Y f 0 0.4
- 0.8 c 858 1010 m 62 Y -21 16 d -62 Y f 0 0.6 0.8 c 858 1072 m 63 Y -21 15 d -62
- Y f 0 0.8 0.8 c 858 1135 m 47 Y -21 15 d -47 Y f black 837 902 m 21 -16 d 296 Y
- -21 15 d cl s 0 0.8 0.8 c 858 1182 m 23 6 d -20 15 d -24 -6 d f black 858 1182
- m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 834 880 m 24 6 d 62 Y -24 -6 d f 0
- 0.2 0.8 c 858 948 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 858 1010 m 51 Y -24 -6 d
- -51 Y f black 834 880 m 24 6 d 175 Y -24 -6 d cl s 0 0 0.8 c 814 896 m 20 -16 d
- 62 Y -20 16 d f 0 0.2 0.8 c 834 942 m 62 Y -20 16 d -62 Y f 0 0.4 0.8 c 834
- 1004 m 51 Y -20 15 d -50 Y f black 814 896 m 20 -16 d 175 Y -20 15 d cl s 0 0.4
- 0.8 c 834 1055 m 24 6 d -21 15 d -23 -6 d f black 834 1055 m 24 6 d -21 15 d
- -23 -6 d cl s 0 0 0.8 c 811 874 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 834 942 m
- 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 834 1004 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c
- 834 1066 m 42 Y -23 -6 d -42 Y f black 811 874 m 23 6 d 228 Y -23 -6 d cl s 0 0
- 0.8 c 790 890 m 21 -16 d 62 Y -21 16 d f 0 0.2 0.8 c 811 936 m 62 Y -21 16 d
- -62 Y f 0 0.4 0.8 c 811 998 m 62 Y -21 16 d -62 Y f 0 0.6 0.8 c 811 1060 m 42 Y
- -21 16 d -42 Y f black 790 890 m 21 -16 d 228 Y -21 16 d cl s 0 0.6 0.8 c 811
- 1102 m 23 6 d -20 16 d -24 -6 d f black 811 1102 m 23 6 d -20 16 d -24 -6 d
- cl s 0 0 0.8 c 787 868 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 811 936 m 62 Y -24
- -6 d -62 Y f 0 0.4 0.8 c 811 998 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 811 1060 m
- 63 Y -24 -6 d -63 Y f 0 0.8 0.8 c 811 1123 m 60 Y -24 -6 d -60 Y f black 787
- 868 m 24 6 d 309 Y -24 -6 d cl s 0 0 0.8 c 767 884 m 20 -16 d 62 Y -20 16 d f 0
- 0.2 0.8 c 787 930 m 62 Y -20 16 d -62 Y f 0 0.4 0.8 c 787 992 m 62 Y -20 16 d
- -62 Y f 0 0.6 0.8 c 787 1054 m 63 Y -20 15 d -62 Y f 0 0.8 0.8 c 787 1117 m 60
- Y -20 16 d -61 Y f black 767 884 m 20 -16 d 309 Y -20 16 d cl s 0 0.8 0.8 c 787
- 1177 m 24 6 d -21 16 d -23 -6 d f black 787 1177 m 24 6 d -21 16 d -23 -6 d
- cl s 0 0 0.8 c 764 862 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 787 930 m 62 Y -23
- -6 d -62 Y f 0 0.4 0.8 c 787 992 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c 787 1054 m
- 63 Y -23 -6 d -63 Y f 0 0.8 0.8 c 787 1117 m 62 Y -23 -6 d -62 Y f 0 0.8 0.6 c
- 787 1179 m 52 Y -23 -6 d -52 Y f black 764 862 m 23 6 d 363 Y -23 -6 d cl s 0 0
- 0.8 c 743 878 m 21 -16 d 62 Y -21 16 d f 0 0.2 0.8 c 764 924 m 62 Y -21 16 d
- -62 Y f 0 0.4 0.8 c 764 986 m 62 Y -21 16 d -62 Y f 0 0.6 0.8 c 764 1048 m 63 Y
- -21 15 d -62 Y f 0 0.8 0.8 c 764 1111 m 62 Y -21 15 d -62 Y f 0 0.8 0.6 c 764
- 1173 m 52 Y -21 15 d -52 Y f black 743 878 m 21 -16 d 363 Y -21 15 d cl s 0 0.8
- 0.6 c 764 1225 m 23 6 d -20 15 d -24 -6 d f black 764 1225 m 23 6 d -20 15 d
- -24 -6 d cl s 0 0 0.8 c 740 856 m 24 6 d -21 16 d -23 -6 d f black 740 856 m 24
- 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 717 850 m 23 6 d -20 16 d -24 -6 d f black
- 717 850 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 693 844 m 24 6 d -21 16 d -23
- -6 d f black 693 844 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 670 838 m 23 6 d
- -20 16 d -24 -6 d f black 670 838 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c
- 1794 1104 m 24 6 d -21 15 d -23 -6 d f black 1794 1104 m 24 6 d -21 15 d -23 -6
- d cl s 0 0 0.8 c 1771 1098 m 23 6 d -20 15 d -24 -6 d f black 1771 1098 m 23 6
- d -20 15 d -24 -6 d cl s 0 0 0.8 c 1747 1092 m 24 6 d -21 15 d -23 -6 d f black
- 1747 1092 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 1724 1086 m 23 6 d -20 15 d
- -24 -6 d f black 1724 1086 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1700 1080
- m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1724 1148 m 62 Y -24 -6 d -62 Y f 0 0.4
- 0.8 c 1724 1210 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 1724 1272 m 15 Y -24 -6 d
- -15 Y f black 1700 1080 m 24 6 d 201 Y -24 -6 d cl s 0 0 0.8 c 1680 1095 m 20
- -15 d 62 Y -20 15 d f 0 0.2 0.8 c 1700 1142 m 62 Y -20 16 d -63 Y f 0 0.4 0.8 c
- 1700 1204 m 62 Y -20 16 d -62 Y f 0 0.6 0.8 c 1700 1266 m 15 Y -20 16 d -15 Y f
- black 1680 1095 m 20 -15 d 201 Y -20 16 d cl s 0 0.6 0.8 c 1700 1281 m 24 6 d
- -21 16 d -23 -6 d f black 1700 1281 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c
- 1677 1074 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 1700 1142 m 62 Y -23 -6 d -62 Y
- f 0 0.4 0.8 c 1700 1204 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c 1700 1266 m 2 Y -23
- -6 d -2 Y f black 1677 1074 m 23 6 d 188 Y -23 -6 d cl s 0 0 0.8 c 1656 1089 m
- 21 -15 d 62 Y -21 15 d f 0 0.2 0.8 c 1677 1136 m 62 Y -21 16 d -63 Y f 0 0.4
- 0.8 c 1677 1198 m 62 Y -21 16 d -62 Y f 0 0.6 0.8 c 1677 1260 m 2 Y -21 15 d -1
- Y f black 1656 1089 m 21 -15 d 188 Y -21 15 d cl s 0 0.6 0.8 c 1677 1262 m 23 6
- d -20 15 d -24 -6 d f black 1677 1262 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c
- 1653 1068 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1677 1136 m 62 Y -24 -6 d -62 Y
- f 0 0.4 0.8 c 1677 1198 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 1677 1260 m 42 Y
- -24 -6 d -42 Y f black 1653 1068 m 24 6 d 228 Y -24 -6 d cl s 0 0 0.8 c 1633
- 1083 m 20 -15 d 62 Y -20 15 d f 0 0.2 0.8 c 1653 1130 m 62 Y -20 16 d -63 Y f 0
- 0.4 0.8 c 1653 1192 m 62 Y -20 16 d -62 Y f 0 0.6 0.8 c 1653 1254 m 42 Y -20 16
- d -42 Y f black 1633 1083 m 20 -15 d 228 Y -20 16 d cl s 0 0.6 0.8 c 1653 1296
- m 24 6 d -21 16 d -23 -6 d f black 1653 1296 m 24 6 d -21 16 d -23 -6 d cl s 0
- 0 0.8 c 1630 1062 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 1653 1130 m 62 Y -23 -6
- d -62 Y f 0 0.4 0.8 c 1653 1192 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c 1653 1254 m
- 2 Y -23 -6 d -2 Y f black 1630 1062 m 23 6 d 188 Y -23 -6 d cl s 0 0 0.8 c 1609
- 1077 m 21 -15 d 62 Y -21 15 d f 0 0.2 0.8 c 1630 1124 m 62 Y -21 16 d -63 Y f 0
- 0.4 0.8 c 1630 1186 m 62 Y -21 16 d -62 Y f 0 0.6 0.8 c 1630 1248 m 2 Y -21 15
- d -1 Y f black 1609 1077 m 21 -15 d 188 Y -21 15 d cl s 0 0.6 0.8 c 1630 1250 m
- 23 6 d -20 15 d -24 -6 d f black 1630 1250 m 23 6 d -20 15 d -24 -6 d cl s 0 0
- 0.8 c 1606 1056 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1630 1124 m 62 Y -24 -6 d
- -62 Y f 0 0.4 0.8 c 1630 1186 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 1630 1248 m
- 56 Y -24 -6 d -56 Y f black 1606 1056 m 24 6 d 242 Y -24 -6 d cl s 0 0 0.8 c
- 1586 1071 m 20 -15 d 62 Y -20 15 d f 0 0.2 0.8 c 1606 1118 m 62 Y -20 16 d -63
- Y f 0 0.4 0.8 c 1606 1180 m 62 Y -20 16 d -62 Y f 0 0.6 0.8 c 1606 1242 m 56 Y
- -20 15 d -55 Y f black 1586 1071 m 20 -15 d 242 Y -20 15 d cl s 0 0.6 0.8 c
- 1606 1298 m 24 6 d -21 15 d -23 -6 d f black 1606 1298 m 24 6 d -21 15 d -23 -6
- d cl s 0 0 0.8 c 1583 1050 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 1606 1118 m 62
- Y -23 -6 d -62 Y f 0 0.4 0.8 c 1606 1180 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c
- 1606 1242 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 1606 1304 m 47 Y -23 -6 d -47 Y f
- black 1583 1050 m 23 6 d 295 Y -23 -6 d cl s 0 0 0.8 c 1562 1065 m 21 -15 d 62
- Y -21 16 d f 0 0.2 0.8 c 1583 1112 m 62 Y -21 16 d -62 Y f 0 0.4 0.8 c 1583
- 1174 m 62 Y -21 16 d -62 Y f 0 0.6 0.8 c 1583 1236 m 62 Y -21 16 d -62 Y f 0
- 0.8 0.8 c 1583 1298 m 47 Y -21 16 d -47 Y f black 1562 1065 m 21 -15 d 295 Y
- -21 16 d cl s 0 0.8 0.8 c 1583 1345 m 23 6 d -20 16 d -24 -6 d f black 1583
- 1345 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1559 1044 m 24 6 d 62 Y -24 -6 d
- f 0 0.2 0.8 c 1583 1112 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 1583 1174 m 62 Y
- -24 -6 d -62 Y f 0 0.6 0.8 c 1583 1236 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c 1583
- 1298 m 34 Y -24 -6 d -34 Y f black 1559 1044 m 24 6 d 282 Y -24 -6 d cl s 0 0
- 0.8 c 1539 1059 m 20 -15 d 62 Y -20 16 d f 0 0.2 0.8 c 1559 1106 m 62 Y -20 16
- d -62 Y f 0 0.4 0.8 c 1559 1168 m 62 Y -20 16 d -62 Y f 0 0.6 0.8 c 1559 1230 m
- 62 Y -20 16 d -62 Y f 0 0.8 0.8 c 1559 1292 m 34 Y -20 16 d -34 Y f black 1539
- 1059 m 20 -15 d 282 Y -20 16 d cl s 0 0.8 0.8 c 1559 1326 m 24 6 d -21 16 d -23
- -6 d f black 1559 1326 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1536 1038 m 23
- 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 1559 1106 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c
- 1559 1168 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c 1559 1230 m 56 Y -23 -6 d -56 Y f
- black 1536 1038 m 23 6 d 242 Y -23 -6 d cl s 0 0 0.8 c 1515 1053 m 21 -15 d 62
- Y -21 16 d f 0 0.2 0.8 c 1536 1100 m 62 Y -21 16 d -62 Y f 0 0.4 0.8 c 1536
- 1162 m 62 Y -21 16 d -62 Y f 0 0.6 0.8 c 1536 1224 m 56 Y -21 15 d -55 Y f
- black 1515 1053 m 21 -15 d 242 Y -21 15 d cl s 0 0.6 0.8 c 1536 1280 m 23 6 d
- -20 15 d -24 -6 d f black 1536 1280 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c
- 1512 1032 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1536 1100 m 62 Y -24 -6 d -62 Y
- f 0 0.4 0.8 c 1536 1162 m 51 Y -24 -6 d -51 Y f black 1512 1032 m 24 6 d 175 Y
- -24 -6 d cl s 0 0 0.8 c 1492 1047 m 20 -15 d 62 Y -20 16 d f 0 0.2 0.8 c 1512
- 1094 m 62 Y -20 16 d -62 Y f 0 0.4 0.8 c 1512 1156 m 51 Y -20 15 d -50 Y f
- black 1492 1047 m 20 -15 d 175 Y -20 15 d cl s 0 0.4 0.8 c 1512 1207 m 24 6 d
- -21 15 d -23 -6 d f black 1512 1207 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c
- 1489 1026 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 1512 1094 m 62 Y -23 -6 d -62 Y
- f 0 0.4 0.8 c 1512 1156 m 37 Y -23 -6 d -37 Y f black 1489 1026 m 23 6 d 161 Y
- -23 -6 d cl s 0 0 0.8 c 1468 1041 m 21 -15 d 62 Y -21 16 d f 0 0.2 0.8 c 1489
- 1088 m 62 Y -21 16 d -62 Y f 0 0.4 0.8 c 1489 1150 m 37 Y -21 16 d -37 Y f
- black 1468 1041 m 21 -15 d 161 Y -21 16 d cl s 0 0.4 0.8 c 1489 1187 m 23 6 d
- -20 16 d -24 -6 d f black 1489 1187 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c
- 1465 1020 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1489 1088 m 62 Y -24 -6 d -62 Y
- f 0 0.4 0.8 c 1489 1150 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 1489 1212 m 29 Y
- -24 -6 d -29 Y f black 1465 1020 m 24 6 d 215 Y -24 -6 d cl s 0 0 0.8 c 1445
- 1035 m 20 -15 d 62 Y -20 16 d f 0 0.2 0.8 c 1465 1082 m 62 Y -20 16 d -62 Y f 0
- 0.4 0.8 c 1465 1144 m 62 Y -20 16 d -62 Y f 0 0.6 0.8 c 1465 1206 m 29 Y -20 15
- d -28 Y f black 1445 1035 m 20 -15 d 215 Y -20 15 d cl s 0 0.6 0.8 c 1465 1235
- m 24 6 d -21 15 d -23 -6 d f black 1465 1235 m 24 6 d -21 15 d -23 -6 d cl s 0
- 0 0.8 c 1442 1014 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 1465 1082 m 62 Y -23 -6
- d -62 Y f 0 0.4 0.8 c 1465 1144 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c 1465 1206 m
- 15 Y -23 -6 d -15 Y f black 1442 1014 m 23 6 d 201 Y -23 -6 d cl s 0 0 0.8 c
- 1421 1029 m 21 -15 d 62 Y -21 16 d f 0 0.2 0.8 c 1442 1076 m 62 Y -21 16 d -62
- Y f 0 0.4 0.8 c 1442 1138 m 62 Y -21 16 d -62 Y f 0 0.6 0.8 c 1442 1200 m 15 Y
- -21 16 d -15 Y f black 1421 1029 m 21 -15 d 201 Y -21 16 d cl s 0 0.6 0.8 c
- 1442 1215 m 23 6 d -20 16 d -24 -6 d f black 1442 1215 m 23 6 d -20 16 d -24 -6
- d cl s 0 0 0.8 c 1418 1008 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1442 1076 m 62
- Y -24 -6 d -62 Y f 0 0.4 0.8 c 1442 1138 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c
- 1442 1200 m 42 Y -24 -6 d -42 Y f black 1418 1008 m 24 6 d 228 Y -24 -6 d cl s
- 0 0 0.8 c 1398 1024 m 20 -16 d 62 Y -20 16 d f 0 0.2 0.8 c 1418 1070 m 62 Y -20
- 16 d -62 Y f 0 0.4 0.8 c 1418 1132 m 62 Y -20 16 d -62 Y f 0 0.6 0.8 c 1418
- 1194 m 42 Y -20 16 d -42 Y f black 1398 1024 m 20 -16 d 228 Y -20 16 d cl s 0
- 0.6 0.8 c 1418 1236 m 24 6 d -21 16 d -23 -6 d f black 1418 1236 m 24 6 d -21
- 16 d -23 -6 d cl s 0 0 0.8 c 1395 1002 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c
- 1418 1070 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 1418 1132 m 62 Y -23 -6 d -62 Y f
- 0 0.6 0.8 c 1418 1194 m 16 Y -23 -6 d -16 Y f black 1395 1002 m 23 6 d 202 Y
- -23 -6 d cl s 0 0 0.8 c 1374 1018 m 21 -16 d 62 Y -21 16 d f 0 0.2 0.8 c 1395
- 1064 m 62 Y -21 16 d -62 Y f 0 0.4 0.8 c 1395 1126 m 62 Y -21 16 d -62 Y f 0
- 0.6 0.8 c 1395 1188 m 16 Y -21 15 d -15 Y f black 1374 1018 m 21 -16 d 202 Y
- -21 15 d cl s 0 0.6 0.8 c 1395 1204 m 23 6 d -20 15 d -24 -6 d f black 1395
- 1204 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1371 996 m 24 6 d 62 Y -24 -6 d
- f 0 0.2 0.8 c 1395 1064 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 1395 1126 m 62 Y
- -24 -6 d -62 Y f 0 0.6 0.8 c 1395 1188 m 2 Y -24 -6 d -2 Y f black 1371 996 m
- 24 6 d 188 Y -24 -6 d cl s 0 0 0.8 c 1351 1012 m 20 -16 d 62 Y -20 16 d f 0 0.2
- 0.8 c 1371 1058 m 62 Y -20 16 d -62 Y f 0 0.4 0.8 c 1371 1120 m 62 Y -20 16 d
- -62 Y f 0 0.6 0.8 c 1371 1182 m 2 Y -20 16 d -2 Y f black 1351 1012 m 20 -16 d
- 188 Y -20 16 d cl s 0 0.6 0.8 c 1371 1184 m 24 6 d -21 16 d -23 -6 d f black
- 1371 1184 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1348 990 m 23 6 d 62 Y -23
- -6 d f 0 0.2 0.8 c 1371 1058 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 1371 1120 m 62
- Y -23 -6 d -62 Y f 0 0.6 0.8 c 1371 1182 m 42 Y -23 -6 d -42 Y f black 1348 990
- m 23 6 d 228 Y -23 -6 d cl s 0 0 0.8 c 1328 1006 m 20 -16 d 62 Y -20 16 d f 0
- 0.2 0.8 c 1348 1052 m 62 Y -20 16 d -62 Y f 0 0.4 0.8 c 1348 1114 m 62 Y -20 16
- d -62 Y f 0 0.6 0.8 c 1348 1176 m 42 Y -20 16 d -42 Y f black 1328 1006 m 20
- -16 d 228 Y -20 16 d cl s 0 0.6 0.8 c 1348 1218 m 23 6 d -20 16 d -23 -6 d f
- black 1348 1218 m 23 6 d -20 16 d -23 -6 d cl s 0 0 0.8 c 1324 984 m 24 6 d 62
- Y -24 -6 d f 0 0.2 0.8 c 1348 1052 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 1348
- 1114 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 1348 1176 m 16 Y -24 -6 d -16 Y f
- black 1324 984 m 24 6 d 202 Y -24 -6 d cl s 0 0 0.8 c 1304 1000 m 20 -16 d 62 Y
- -20 16 d f 0 0.2 0.8 c 1324 1046 m 62 Y -20 16 d -62 Y f 0 0.4 0.8 c 1324 1108
- m 62 Y -20 16 d -62 Y f 0 0.6 0.8 c 1324 1170 m 16 Y -20 15 d -15 Y f black
- 1304 1000 m 20 -16 d 202 Y -20 15 d cl s 0 0.6 0.8 c 1324 1186 m 24 6 d -20 15
- d -24 -6 d f black 1324 1186 m 24 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1301 978
- m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 1324 1046 m 62 Y -23 -6 d -62 Y f 0 0.4
- 0.8 c 1324 1108 m 62 Y -23 -5 d -63 Y f 0 0.6 0.8 c 1324 1170 m 63 Y -23 -6 d
- -62 Y f 0 0.8 0.8 c 1324 1233 m 20 Y -23 -6 d -20 Y f black 1301 978 m 23 6 d
- 269 Y -23 -6 d cl s 0 0 0.8 c 1281 994 m 20 -16 d 62 Y -20 16 d f 0 0.2 0.8 c
- 1301 1040 m 62 Y -20 16 d -62 Y f 0 0.4 0.8 c 1301 1102 m 63 Y -20 15 d -62 Y f
- 0 0.6 0.8 c 1301 1165 m 62 Y -20 15 d -62 Y f 0 0.8 0.8 c 1301 1227 m 20 Y -20
- 15 d -20 Y f black 1281 994 m 20 -16 d 269 Y -20 15 d cl s 0 0.8 0.8 c 1301
- 1247 m 23 6 d -20 15 d -23 -6 d f black 1301 1247 m 23 6 d -20 15 d -23 -6 d
- cl s 0 0 0.8 c 1277 972 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1301 1040 m 62 Y
- -24 -6 d -62 Y f 0 0.4 0.8 c 1301 1102 m 63 Y -24 -6 d -63 Y f 0 0.6 0.8 c 1301
- 1165 m 15 Y -24 -6 d -15 Y f black 1277 972 m 24 6 d 202 Y -24 -6 d cl s 0 0
- 0.8 c 1257 988 m 20 -16 d 62 Y -20 16 d f 0 0.2 0.8 c 1277 1034 m 62 Y -20 16 d
- -62 Y f 0 0.4 0.8 c 1277 1096 m 63 Y -20 15 d -62 Y f 0 0.6 0.8 c 1277 1159 m
- 15 Y -20 15 d -15 Y f black 1257 988 m 20 -16 d 202 Y -20 15 d cl s 0 0.6 0.8 c
- 1277 1174 m 24 6 d -20 15 d -24 -6 d f black 1277 1174 m 24 6 d -20 15 d -24 -6
- d cl s 0 0 0.8 c 1254 966 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 1277 1034 m 62 Y
- -23 -6 d -62 Y f 0 0.4 0.8 c 1277 1096 m 63 Y -23 -6 d -63 Y f 0 0.6 0.8 c 1277
- 1159 m 28 Y -23 -6 d -28 Y f black 1254 966 m 23 6 d 215 Y -23 -6 d cl s 0 0
- 0.8 c 1234 982 m 20 -16 d 62 Y -20 16 d f 0 0.2 0.8 c 1254 1028 m 62 Y -20 16 d
- -62 Y f 0 0.4 0.8 c 1254 1090 m 63 Y -20 15 d -62 Y f 0 0.6 0.8 c 1254 1153 m
- 28 Y -20 16 d -29 Y f black 1234 982 m 20 -16 d 215 Y -20 16 d cl s 0 0.6 0.8 c
- 1254 1181 m 23 6 d -20 16 d -23 -6 d f black 1254 1181 m 23 6 d -20 16 d -23 -6
- d cl s 0 0 0.8 c 1230 960 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1254 1028 m 62 Y
- -24 -6 d -62 Y f 0 0.4 0.8 c 1254 1090 m 51 Y -24 -6 d -51 Y f black 1230 960 m
- 24 6 d 175 Y -24 -6 d cl s 0 0 0.8 c 1210 976 m 20 -16 d 62 Y -20 16 d f 0 0.2
- 0.8 c 1230 1022 m 62 Y -20 16 d -62 Y f 0 0.4 0.8 c 1230 1084 m 51 Y -20 15 d
- -50 Y f black 1210 976 m 20 -16 d 175 Y -20 15 d cl s 0 0.4 0.8 c 1230 1135 m
- 24 6 d -20 15 d -24 -6 d f black 1230 1135 m 24 6 d -20 15 d -24 -6 d cl s 0 0
- 0.8 c 1207 954 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 1230 1022 m 62 Y -23 -6 d
- -62 Y f 0 0.4 0.8 c 1230 1084 m 37 Y -23 -6 d -37 Y f black 1207 954 m 23 6 d
- 161 Y -23 -6 d cl s 0 0 0.8 c 1187 970 m 20 -16 d 62 Y -20 16 d f 0 0.2 0.8 c
- 1207 1016 m 62 Y -20 16 d -62 Y f 0 0.4 0.8 c 1207 1078 m 37 Y -20 16 d -37 Y f
- black 1187 970 m 20 -16 d 161 Y -20 16 d cl s 0 0.4 0.8 c 1207 1115 m 23 6 d
- -20 16 d -23 -6 d f black 1207 1115 m 23 6 d -20 16 d -23 -6 d cl s 0 0 0.8 c
- 1183 948 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1207 1016 m 62 Y -24 -6 d -62 Y f
- 0 0.4 0.8 c 1207 1078 m 51 Y -24 -6 d -51 Y f black 1183 948 m 24 6 d 175 Y -24
- -6 d cl s 0 0 0.8 c 1163 964 m 20 -16 d 62 Y -20 16 d f 0 0.2 0.8 c 1183 1010 m
- 62 Y -20 16 d -62 Y f 0 0.4 0.8 c 1183 1072 m 51 Y -20 15 d -50 Y f black 1163
- 964 m 20 -16 d 175 Y -20 15 d cl s 0 0.4 0.8 c 1183 1123 m 24 6 d -20 15 d -24
- -6 d f black 1183 1123 m 24 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1160 942 m 23
- 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 1183 1010 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c
- 1183 1072 m 37 Y -23 -6 d -37 Y f black 1160 942 m 23 6 d 161 Y -23 -6 d cl s 0
- 0 0.8 c 1140 958 m 20 -16 d 62 Y -20 16 d f 0 0.2 0.8 c 1160 1004 m 62 Y -20 16
- d -62 Y f 0 0.4 0.8 c 1160 1066 m 37 Y -20 16 d -37 Y f black 1140 958 m 20 -16
- d 161 Y -20 16 d cl s 0 0.4 0.8 c 1160 1103 m 23 6 d -20 16 d -23 -6 d f black
- 1160 1103 m 23 6 d -20 16 d -23 -6 d cl s 0 0 0.8 c 1136 936 m 24 6 d 62 Y -24
- -6 d f 0 0.2 0.8 c 1160 1004 m 62 Y -24 -5 d -63 Y f 0 0.4 0.8 c 1160 1066 m 63
- Y -24 -6 d -62 Y f 0 0.6 0.8 c 1160 1129 m 62 Y -24 -6 d -62 Y f 0 0.8 0.8 c
- 1160 1191 m 20 Y -24 -6 d -20 Y f black 1136 936 m 24 6 d 269 Y -24 -6 d cl s 0
- 0 0.8 c 1116 952 m 20 -16 d 62 Y -20 16 d f 0 0.2 0.8 c 1136 998 m 63 Y -20 15
- d -62 Y f 0 0.4 0.8 c 1136 1061 m 62 Y -20 15 d -62 Y f 0 0.6 0.8 c 1136 1123 m
- 62 Y -20 15 d -62 Y f 0 0.8 0.8 c 1136 1185 m 20 Y -20 15 d -20 Y f black 1116
- 952 m 20 -16 d 269 Y -20 15 d cl s 0 0.8 0.8 c 1136 1205 m 24 6 d -20 15 d -24
- -6 d f black 1136 1205 m 24 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1113 930 m 23
- 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 1136 998 m 63 Y -23 -6 d -63 Y f 0 0.4 0.8 c
- 1136 1061 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c 1136 1123 m 15 Y -23 -6 d -15 Y f
- black 1113 930 m 23 6 d 202 Y -23 -6 d cl s 0 0 0.8 c 1093 946 m 20 -16 d 62 Y
- -20 16 d f 0 0.2 0.8 c 1113 992 m 63 Y -20 15 d -62 Y f 0 0.4 0.8 c 1113 1055 m
- 62 Y -20 15 d -62 Y f 0 0.6 0.8 c 1113 1117 m 15 Y -20 15 d -15 Y f black 1093
- 946 m 20 -16 d 202 Y -20 15 d cl s 0 0.6 0.8 c 1113 1132 m 23 6 d -20 15 d -23
- -6 d f black 1113 1132 m 23 6 d -20 15 d -23 -6 d cl s 0 0 0.8 c 1089 924 m 24
- 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1113 992 m 59 Y -24 -6 d -59 Y f black 1089 924
- m 24 6 d 121 Y -24 -6 d cl s 0 0 0.8 c 1069 940 m 20 -16 d 62 Y -20 16 d f 0
- 0.2 0.8 c 1089 986 m 59 Y -20 16 d -59 Y f black 1069 940 m 20 -16 d 121 Y -20
- 16 d cl s 0 0.2 0.8 c 1089 1045 m 24 6 d -20 16 d -24 -6 d f black 1089 1045 m
- 24 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1066 918 m 23 6 d 62 Y -23 -6 d f 0 0.2
- 0.8 c 1089 986 m 63 Y -23 -6 d -63 Y f 0 0.4 0.8 c 1089 1049 m 23 Y -23 -6 d
- -23 Y f black 1066 918 m 23 6 d 148 Y -23 -6 d cl s 0 0 0.8 c 1046 934 m 20 -16
- d 62 Y -20 16 d f 0 0.2 0.8 c 1066 980 m 63 Y -20 15 d -62 Y f 0 0.4 0.8 c 1066
- 1043 m 23 Y -20 16 d -24 Y f black 1046 934 m 20 -16 d 148 Y -20 16 d cl s 0
- 0.4 0.8 c 1066 1066 m 23 6 d -20 16 d -23 -6 d f black 1066 1066 m 23 6 d -20
- 16 d -23 -6 d cl s 0 0 0.8 c 1043 912 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 1066
- 980 m 63 Y -23 -6 d -63 Y f 0 0.4 0.8 c 1066 1043 m 62 Y -23 -6 d -62 Y f 0 0.6
- 0.8 c 1066 1105 m 28 Y -23 -6 d -28 Y f black 1043 912 m 23 6 d 215 Y -23 -6 d
- cl s 0 0 0.8 c 1022 928 m 21 -16 d 62 Y -21 16 d f 0 0.2 0.8 c 1043 974 m 63 Y
- -21 15 d -62 Y f 0 0.4 0.8 c 1043 1037 m 62 Y -21 15 d -62 Y f 0 0.6 0.8 c 1043
- 1099 m 28 Y -21 16 d -29 Y f black 1022 928 m 21 -16 d 215 Y -21 16 d cl s 0
- 0.6 0.8 c 1043 1127 m 23 6 d -20 16 d -24 -6 d f black 1043 1127 m 23 6 d -20
- 16 d -24 -6 d cl s 0 0 0.8 c 1019 906 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1043
- 974 m 63 Y -24 -6 d -63 Y f 0 0.4 0.8 c 1043 1037 m 23 Y -24 -6 d -23 Y f black
- 1019 906 m 24 6 d 148 Y -24 -6 d cl s 0 0 0.8 c 999 922 m 20 -16 d 62 Y -20 16
- d f 0 0.2 0.8 c 1019 968 m 63 Y -20 15 d -62 Y f 0 0.4 0.8 c 1019 1031 m 23 Y
- -20 16 d -24 Y f black 999 922 m 20 -16 d 148 Y -20 16 d cl s 0 0.4 0.8 c 1019
- 1054 m 24 6 d -21 16 d -23 -6 d f black 1019 1054 m 24 6 d -21 16 d -23 -6 d
- cl s 0 0 0.8 c 996 900 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 1019 968 m 63 Y -23
- -6 d -63 Y f 0 0.4 0.8 c 1019 1031 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c 1019
- 1093 m 1 Y -23 -6 d -1 Y f black 996 900 m 23 6 d 188 Y -23 -6 d cl s 0 0 0.8 c
- 975 916 m 21 -16 d 62 Y -21 16 d f 0 0.2 0.8 c 996 962 m 63 Y -21 15 d -62 Y f
- 0 0.4 0.8 c 996 1025 m 62 Y -21 15 d -62 Y f 0 0.6 0.8 c 996 1087 m 1 Y -21 16
- d -2 Y f black 975 916 m 21 -16 d 188 Y -21 16 d cl s 0 0.6 0.8 c 996 1088 m 23
- 6 d -20 16 d -24 -6 d f black 996 1088 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8
- c 972 894 m 24 6 d 62 Y -24 -5 d f 0 0.2 0.8 c 996 962 m 63 Y -24 -6 d -62 Y f
- 0 0.4 0.8 c 996 1025 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 996 1087 m 15 Y -24 -6
- d -15 Y f black 972 894 m 24 6 d 202 Y -24 -6 d cl s 0 0 0.8 c 952 910 m 20 -16
- d 63 Y -20 15 d f 0 0.2 0.8 c 972 957 m 62 Y -20 15 d -62 Y f 0 0.4 0.8 c 972
- 1019 m 62 Y -20 15 d -62 Y f 0 0.6 0.8 c 972 1081 m 15 Y -20 15 d -15 Y f black
- 952 910 m 20 -16 d 202 Y -20 15 d cl s 0 0.6 0.8 c 972 1096 m 24 6 d -21 15 d
- -23 -6 d f black 972 1096 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 949 888 m
- 23 6 d 63 Y -23 -6 d f 0 0.2 0.8 c 972 957 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c
- 972 1019 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c 972 1081 m 62 Y -23 -6 d -62 Y f 0
- 0.8 0.8 c 972 1143 m 7 Y -23 -6 d -7 Y f black 949 888 m 23 6 d 256 Y -23 -6 d
- cl s 0 0 0.8 c 928 904 m 21 -16 d 63 Y -21 15 d f 0 0.2 0.8 c 949 951 m 62 Y
- -21 15 d -62 Y f 0 0.4 0.8 c 949 1013 m 62 Y -21 15 d -62 Y f 0 0.6 0.8 c 949
- 1075 m 62 Y -21 15 d -62 Y f 0 0.8 0.8 c 949 1137 m 7 Y -21 15 d -7 Y f black
- 928 904 m 21 -16 d 256 Y -21 15 d cl s 0 0.8 0.8 c 949 1144 m 23 6 d -20 15 d
- -24 -6 d f black 949 1144 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 925 882 m
- 24 6 d 63 Y -24 -6 d f 0 0.2 0.8 c 949 951 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c
- 949 1013 m 10 Y -24 -6 d -10 Y f black 925 882 m 24 6 d 135 Y -24 -6 d cl s 0 0
- 0.8 c 905 898 m 20 -16 d 63 Y -20 15 d f 0 0.2 0.8 c 925 945 m 62 Y -20 15 d
- -62 Y f 0 0.4 0.8 c 925 1007 m 10 Y -20 15 d -10 Y f black 905 898 m 20 -16 d
- 135 Y -20 15 d cl s 0 0.4 0.8 c 925 1017 m 24 6 d -21 15 d -23 -6 d f black 925
- 1017 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 902 876 m 23 6 d 63 Y -23 -6 d f
- 0 0.2 0.8 c 925 945 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 925 1007 m 62 Y -23 -6
- d -62 Y f 0 0.6 0.8 c 925 1069 m 62 Y -23 -6 d -62 Y f 0 0.8 0.8 c 925 1131 m 7
- Y -23 -6 d -7 Y f black 902 876 m 23 6 d 256 Y -23 -6 d cl s 0 0 0.8 c 881 892
- m 21 -16 d 63 Y -21 15 d f 0 0.2 0.8 c 902 939 m 62 Y -21 15 d -62 Y f 0 0.4
- 0.8 c 902 1001 m 62 Y -21 15 d -62 Y f 0 0.6 0.8 c 902 1063 m 62 Y -21 16 d -63
- Y f 0 0.8 0.8 c 902 1125 m 7 Y -21 15 d -6 Y f black 881 892 m 21 -16 d 256 Y
- -21 15 d cl s 0 0.8 0.8 c 902 1132 m 23 6 d -20 15 d -24 -6 d f black 902 1132
- m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 878 870 m 24 6 d 63 Y -24 -6 d f 0
- 0.2 0.8 c 902 939 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 902 1001 m 62 Y -24 -6 d
- -62 Y f 0 0.6 0.8 c 902 1063 m 2 Y -24 -6 d -2 Y f black 878 870 m 24 6 d 189 Y
- -24 -6 d cl s 0 0 0.8 c 858 886 m 20 -16 d 63 Y -20 15 d f 0 0.2 0.8 c 878 933
- m 62 Y -20 15 d -62 Y f 0 0.4 0.8 c 878 995 m 62 Y -20 15 d -62 Y f 0 0.6 0.8 c
- 878 1057 m 2 Y -20 15 d -2 Y f black 858 886 m 20 -16 d 189 Y -20 15 d cl s 0
- 0.6 0.8 c 878 1059 m 24 6 d -21 15 d -23 -6 d f black 878 1059 m 24 6 d -21 15
- d -23 -6 d cl s 0 0 0.8 c 855 864 m 23 6 d 63 Y -23 -6 d f 0 0.2 0.8 c 878 933
- m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 878 995 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c
- 878 1057 m 55 Y -23 -6 d -55 Y f black 855 864 m 23 6 d 242 Y -23 -6 d cl s 0 0
- 0.8 c 834 880 m 21 -16 d 63 Y -21 15 d f 0 0.2 0.8 c 855 927 m 62 Y -21 15 d
- -62 Y f 0 0.4 0.8 c 855 989 m 62 Y -21 15 d -62 Y f 0 0.6 0.8 c 855 1051 m 55 Y
- -21 16 d -56 Y f black 834 880 m 21 -16 d 242 Y -21 16 d cl s 0 0.6 0.8 c 855
- 1106 m 23 6 d -20 16 d -24 -6 d f black 855 1106 m 23 6 d -20 16 d -24 -6 d
- cl s 0 0 0.8 c 831 858 m 24 6 d 63 Y -24 -6 d f 0 0.2 0.8 c 855 927 m 62 Y -24
- -6 d -62 Y f 0 0.4 0.8 c 855 989 m 23 Y -24 -6 d -23 Y f black 831 858 m 24 6 d
- 148 Y -24 -6 d cl s 0 0 0.8 c 811 874 m 20 -16 d 63 Y -20 15 d f 0 0.2 0.8 c
- 831 921 m 62 Y -20 15 d -62 Y f 0 0.4 0.8 c 831 983 m 23 Y -20 16 d -24 Y f
- black 811 874 m 20 -16 d 148 Y -20 16 d cl s 0 0.4 0.8 c 831 1006 m 24 6 d -21
- 16 d -23 -6 d f black 831 1006 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 808
- 853 m 23 5 d 63 Y -23 -6 d f 0 0.2 0.8 c 831 921 m 62 Y -23 -6 d -62 Y f 0 0.4
- 0.8 c 831 983 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c 831 1045 m 15 Y -23 -6 d -15
- Y f black 808 853 m 23 5 d 202 Y -23 -6 d cl s 0 0 0.8 c 787 868 m 21 -15 d 62
- Y -21 15 d f 0 0.2 0.8 c 808 915 m 62 Y -21 15 d -62 Y f 0 0.4 0.8 c 808 977 m
- 62 Y -21 15 d -62 Y f 0 0.6 0.8 c 808 1039 m 15 Y -21 16 d -16 Y f black 787
- 868 m 21 -15 d 201 Y -21 16 d cl s 0 0.6 0.8 c 808 1054 m 23 6 d -20 16 d -24
- -6 d f black 808 1054 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 784 847 m 24 6
- d 62 Y -24 -6 d f 0 0.2 0.8 c 808 915 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 808
- 977 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 808 1039 m 62 Y -24 -6 d -62 Y f 0 0.8
- 0.8 c 808 1101 m 20 Y -24 -6 d -20 Y f black 784 847 m 24 6 d 268 Y -24 -6 d
- cl s 0 0 0.8 c 764 862 m 20 -15 d 62 Y -20 15 d f 0 0.2 0.8 c 784 909 m 62 Y
- -20 15 d -62 Y f 0 0.4 0.8 c 784 971 m 62 Y -20 15 d -62 Y f 0 0.6 0.8 c 784
- 1033 m 62 Y -20 16 d -63 Y f 0 0.8 0.8 c 784 1095 m 20 Y -20 16 d -20 Y f black
- 764 862 m 20 -15 d 268 Y -20 16 d cl s 0 0.8 0.8 c 784 1115 m 24 6 d -21 16 d
- -23 -6 d f black 784 1115 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 761 841 m
- 23 6 d -20 15 d -24 -6 d f black 761 841 m 23 6 d -20 15 d -24 -6 d cl s 0 0
- 0.8 c 737 835 m 24 6 d -21 15 d -23 -6 d f black 737 835 m 24 6 d -21 15 d -23
- -6 d cl s 0 0 0.8 c 714 829 m 23 6 d -20 15 d -24 -6 d f black 714 829 m 23 6 d
- -20 15 d -24 -6 d cl s 0 0 0.8 c 690 823 m 24 6 d -21 15 d -23 -6 d f black 690
- 823 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 1814 1088 m 24 6 d -20 16 d -24
- -6 d f black 1814 1088 m 24 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1791 1082 m 23
- 6 d -20 16 d -23 -6 d f black 1791 1082 m 23 6 d -20 16 d -23 -6 d cl s 0 0 0.8
- c 1768 1076 m 23 6 d -20 16 d -24 -6 d f black 1768 1076 m 23 6 d -20 16 d -24
- -6 d cl s 0 0 0.8 c 1744 1070 m 24 6 d -21 16 d -23 -6 d f black 1744 1070 m 24
- 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1721 1064 m 23 6 d 62 Y -23 -6 d f 0 0.2
- 0.8 c 1744 1132 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 1744 1194 m 24 Y -23 -6 d
- -24 Y f black 1721 1064 m 23 6 d 148 Y -23 -6 d cl s 0 0 0.8 c 1700 1080 m 21
- -16 d 62 Y -21 16 d f 0 0.2 0.8 c 1721 1126 m 62 Y -21 16 d -62 Y f 0 0.4 0.8 c
- 1721 1188 m 24 Y -21 16 d -24 Y f black 1700 1080 m 21 -16 d 148 Y -21 16 d
- cl s 0 0.4 0.8 c 1721 1212 m 23 6 d -20 16 d -24 -6 d f black 1721 1212 m 23 6
- d -20 16 d -24 -6 d cl s 0 0 0.8 c 1697 1058 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8
- c 1721 1126 m 59 Y -24 -6 d -59 Y f black 1697 1058 m 24 6 d 121 Y -24 -6 d
- cl s 0 0 0.8 c 1677 1074 m 20 -16 d 62 Y -20 16 d f 0 0.2 0.8 c 1697 1120 m 59
- Y -20 16 d -59 Y f black 1677 1074 m 20 -16 d 121 Y -20 16 d cl s 0 0.2 0.8 c
- 1697 1179 m 24 6 d -21 16 d -23 -6 d f black 1697 1179 m 24 6 d -21 16 d -23 -6
- d cl s 0 0 0.8 c 1674 1052 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 1697 1120 m 46
- Y -23 -6 d -46 Y f black 1674 1052 m 23 6 d 108 Y -23 -6 d cl s 0 0 0.8 c 1653
- 1068 m 21 -16 d 62 Y -21 16 d f 0 0.2 0.8 c 1674 1114 m 46 Y -21 15 d -45 Y f
- black 1653 1068 m 21 -16 d 108 Y -21 15 d cl s 0 0.2 0.8 c 1674 1160 m 23 6 d
- -20 15 d -24 -6 d f black 1674 1160 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c
- 1650 1046 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1674 1114 m 46 Y -24 -6 d -46 Y
- f black 1650 1046 m 24 6 d 108 Y -24 -6 d cl s 0 0 0.8 c 1630 1062 m 20 -16 d
- 62 Y -20 16 d f 0 0.2 0.8 c 1650 1108 m 46 Y -20 15 d -45 Y f black 1630 1062 m
- 20 -16 d 108 Y -20 15 d cl s 0 0.2 0.8 c 1650 1154 m 24 6 d -21 15 d -23 -6 d f
- black 1650 1154 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 1627 1040 m 23 6 d 62
- Y -23 -6 d f 0 0.2 0.8 c 1650 1108 m 63 Y -23 -6 d -63 Y f 0 0.4 0.8 c 1650
- 1171 m 36 Y -23 -5 d -37 Y f black 1627 1040 m 23 6 d 161 Y -23 -5 d cl s 0 0
- 0.8 c 1606 1056 m 21 -16 d 62 Y -21 16 d f 0 0.2 0.8 c 1627 1102 m 63 Y -21 15
- d -62 Y f 0 0.4 0.8 c 1627 1165 m 37 Y -21 15 d -37 Y f black 1606 1056 m 21
- -16 d 162 Y -21 15 d cl s 0 0.4 0.8 c 1627 1202 m 23 5 d -20 16 d -24 -6 d f
- black 1627 1202 m 23 5 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1603 1034 m 24 6 d 62
- Y -24 -6 d f 0 0.2 0.8 c 1627 1102 m 63 Y -24 -6 d -63 Y f 0 0.4 0.8 c 1627
- 1165 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 1627 1227 m 15 Y -24 -6 d -15 Y f
- black 1603 1034 m 24 6 d 202 Y -24 -6 d cl s 0 0 0.8 c 1583 1050 m 20 -16 d 62
- Y -20 16 d f 0 0.2 0.8 c 1603 1096 m 63 Y -20 15 d -62 Y f 0 0.4 0.8 c 1603
- 1159 m 62 Y -20 15 d -62 Y f 0 0.6 0.8 c 1603 1221 m 15 Y -20 15 d -15 Y f
- black 1583 1050 m 20 -16 d 202 Y -20 15 d cl s 0 0.6 0.8 c 1603 1236 m 24 6 d
- -21 15 d -23 -6 d f black 1603 1236 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c
- 1580 1028 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 1603 1096 m 32 Y -23 -6 d -32 Y
- f black 1580 1028 m 23 6 d 94 Y -23 -6 d cl s 0 0 0.8 c 1559 1044 m 21 -16 d 62
- Y -21 16 d f 0 0.2 0.8 c 1580 1090 m 32 Y -21 16 d -32 Y f black 1559 1044 m 21
- -16 d 94 Y -21 16 d cl s 0 0.2 0.8 c 1580 1122 m 23 6 d -20 16 d -24 -6 d f
- black 1580 1122 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1556 1022 m 24 6 d 62
- Y -24 -6 d f 0 0.2 0.8 c 1580 1090 m 63 Y -24 -6 d -63 Y f 0 0.4 0.8 c 1580
- 1153 m 23 Y -24 -6 d -23 Y f black 1556 1022 m 24 6 d 148 Y -24 -6 d cl s 0 0
- 0.8 c 1536 1038 m 20 -16 d 62 Y -20 16 d f 0 0.2 0.8 c 1556 1084 m 63 Y -20 15
- d -62 Y f 0 0.4 0.8 c 1556 1147 m 23 Y -20 16 d -24 Y f black 1536 1038 m 20
- -16 d 148 Y -20 16 d cl s 0 0.4 0.8 c 1556 1170 m 24 6 d -21 16 d -23 -6 d f
- black 1556 1170 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1533 1016 m 23 6 d 62
- Y -23 -5 d f 0 0.2 0.8 c 1556 1084 m 63 Y -23 -6 d -62 Y f 0 0.4 0.8 c 1556
- 1147 m 10 Y -23 -6 d -10 Y f black 1533 1016 m 23 6 d 135 Y -23 -6 d cl s 0 0
- 0.8 c 1512 1032 m 21 -16 d 63 Y -21 15 d f 0 0.2 0.8 c 1533 1079 m 62 Y -21 15
- d -62 Y f 0 0.4 0.8 c 1533 1141 m 10 Y -21 15 d -10 Y f black 1512 1032 m 21
- -16 d 135 Y -21 15 d cl s 0 0.4 0.8 c 1533 1151 m 23 6 d -20 15 d -24 -6 d f
- black 1533 1151 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1509 1010 m 24 6 d 63
- Y -24 -6 d f 0 0.2 0.8 c 1533 1079 m 45 Y -24 -6 d -45 Y f black 1509 1010 m 24
- 6 d 108 Y -24 -6 d cl s 0 0 0.8 c 1489 1026 m 20 -16 d 63 Y -20 15 d f 0 0.2
- 0.8 c 1509 1073 m 45 Y -20 15 d -45 Y f black 1489 1026 m 20 -16 d 108 Y -20 15
- d cl s 0 0.2 0.8 c 1509 1118 m 24 6 d -21 15 d -23 -6 d f black 1509 1118 m 24
- 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 1486 1004 m 23 6 d 63 Y -23 -6 d f 0 0.2
- 0.8 c 1509 1073 m 58 Y -23 -6 d -58 Y f black 1486 1004 m 23 6 d 121 Y -23 -6 d
- cl s 0 0 0.8 c 1465 1020 m 21 -16 d 63 Y -21 15 d f 0 0.2 0.8 c 1486 1067 m 58
- Y -21 16 d -59 Y f black 1465 1020 m 21 -16 d 121 Y -21 16 d cl s 0 0.2 0.8 c
- 1486 1125 m 23 6 d -20 16 d -24 -6 d f black 1486 1125 m 23 6 d -20 16 d -24 -6
- d cl s 0 0 0.8 c 1462 998 m 24 6 d 63 Y -24 -6 d f 0 0.2 0.8 c 1486 1067 m 62 Y
- -24 -6 d -62 Y f 0 0.4 0.8 c 1486 1129 m 23 Y -24 -6 d -23 Y f black 1462 998 m
- 24 6 d 148 Y -24 -6 d cl s 0 0 0.8 c 1442 1014 m 20 -16 d 63 Y -20 15 d f 0 0.2
- 0.8 c 1462 1061 m 62 Y -20 15 d -62 Y f 0 0.4 0.8 c 1462 1123 m 23 Y -20 16 d
- -24 Y f black 1442 1014 m 20 -16 d 148 Y -20 16 d cl s 0 0.4 0.8 c 1462 1146 m
- 24 6 d -21 16 d -23 -6 d f black 1462 1146 m 24 6 d -21 16 d -23 -6 d cl s 0 0
- 0.8 c 1439 992 m 23 6 d 54 Y -23 -6 d f black 1439 992 m 23 6 d 54 Y -23 -6 d
- cl s 0 0 0.8 c 1418 1008 m 21 -16 d 54 Y -21 16 d f black 1418 1008 m 21 -16 d
- 54 Y -21 16 d cl s 0 0 0.8 c 1439 1046 m 23 6 d -20 16 d -24 -6 d f black 1439
- 1046 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1415 986 m 24 6 d 63 Y -24 -6 d
- f 0 0.2 0.8 c 1439 1055 m 18 Y -24 -6 d -18 Y f black 1415 986 m 24 6 d 81 Y
- -24 -6 d cl s 0 0 0.8 c 1395 1002 m 20 -16 d 63 Y -20 15 d f 0 0.2 0.8 c 1415
- 1049 m 18 Y -20 16 d -19 Y f black 1395 1002 m 20 -16 d 81 Y -20 16 d cl s 0
- 0.2 0.8 c 1415 1067 m 24 6 d -21 16 d -23 -6 d f black 1415 1067 m 24 6 d -21
- 16 d -23 -6 d cl s 0 0 0.8 c 1392 980 m 23 6 d 63 Y -23 -6 d f 0 0.2 0.8 c 1415
- 1049 m 45 Y -23 -6 d -45 Y f black 1392 980 m 23 6 d 108 Y -23 -6 d cl s 0 0
- 0.8 c 1371 996 m 21 -16 d 63 Y -21 15 d f 0 0.2 0.8 c 1392 1043 m 45 Y -21 16 d
- -46 Y f black 1371 996 m 21 -16 d 108 Y -21 16 d cl s 0 0.2 0.8 c 1392 1088 m
- 23 6 d -20 15 d -24 -5 d f black 1392 1088 m 23 6 d -20 15 d -24 -5 d cl s 0 0
- 0.8 c 1368 975 m 24 5 d 54 Y -24 -6 d f black 1368 975 m 24 5 d 54 Y -24 -6 d
- cl s 0 0 0.8 c 1348 990 m 20 -15 d 53 Y -20 16 d f black 1348 990 m 20 -15 d 53
- Y -20 16 d cl s 0 0 0.8 c 1368 1028 m 24 6 d -21 16 d -23 -6 d f black 1368
- 1028 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1345 969 m 23 6 d 62 Y -23 -6 d
- f 0 0.2 0.8 c 1368 1037 m 32 Y -23 -6 d -32 Y f black 1345 969 m 23 6 d 94 Y
- -23 -6 d cl s 0 0 0.8 c 1324 984 m 21 -15 d 62 Y -21 15 d f 0 0.2 0.8 c 1345
- 1031 m 32 Y -21 15 d -32 Y f black 1324 984 m 21 -15 d 94 Y -21 15 d cl s 0 0.2
- 0.8 c 1345 1063 m 23 6 d -20 15 d -24 -6 d f black 1345 1063 m 23 6 d -20 15 d
- -24 -6 d cl s 0 0 0.8 c 1321 963 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1345 1031
- m 32 Y -24 -6 d -32 Y f black 1321 963 m 24 6 d 94 Y -24 -6 d cl s 0 0 0.8 c
- 1301 978 m 20 -15 d 62 Y -20 15 d f 0 0.2 0.8 c 1321 1025 m 32 Y -20 15 d -32 Y
- f black 1301 978 m 20 -15 d 94 Y -20 15 d cl s 0 0.2 0.8 c 1321 1057 m 24 6 d
- -21 15 d -23 -6 d f black 1321 1057 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c
- 1298 957 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 1321 1025 m 62 Y -23 -6 d -62 Y f
- 0 0.4 0.8 c 1321 1087 m 10 Y -23 -6 d -10 Y f black 1298 957 m 23 6 d 134 Y -23
- -6 d cl s 0 0 0.8 c 1277 972 m 21 -15 d 62 Y -21 15 d f 0 0.2 0.8 c 1298 1019 m
- 62 Y -21 15 d -62 Y f 0 0.4 0.8 c 1298 1081 m 10 Y -21 15 d -10 Y f black 1277
- 972 m 21 -15 d 134 Y -21 15 d cl s 0 0.4 0.8 c 1298 1091 m 23 6 d -20 15 d -24
- -6 d f black 1298 1091 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1274 951 m 24
- 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1298 1019 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c
- 1298 1081 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c 1298 1143 m 42 Y -24 -6 d -42 Y f
- black 1274 951 m 24 6 d 228 Y -24 -6 d cl s 0 0 0.8 c 1254 966 m 20 -15 d 62 Y
- -20 15 d f 0 0.2 0.8 c 1274 1013 m 62 Y -20 15 d -62 Y f 0 0.4 0.8 c 1274 1075
- m 62 Y -20 16 d -63 Y f 0 0.6 0.8 c 1274 1137 m 42 Y -20 16 d -42 Y f black
- 1254 966 m 20 -15 d 228 Y -20 16 d cl s 0 0.6 0.8 c 1274 1179 m 24 6 d -21 16 d
- -23 -6 d f black 1274 1179 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1251 945 m
- 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 1274 1013 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8
- c 1274 1075 m 37 Y -23 -6 d -37 Y f black 1251 945 m 23 6 d 161 Y -23 -6 d cl s
- 0 0 0.8 c 1230 960 m 21 -15 d 62 Y -21 15 d f 0 0.2 0.8 c 1251 1007 m 62 Y -21
- 15 d -62 Y f 0 0.4 0.8 c 1251 1069 m 37 Y -21 15 d -37 Y f black 1230 960 m 21
- -15 d 161 Y -21 15 d cl s 0 0.4 0.8 c 1251 1106 m 23 6 d -20 15 d -24 -6 d f
- black 1251 1106 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1227 939 m 24 6 d 62
- Y -24 -6 d f 0 0.2 0.8 c 1251 1007 m 32 Y -24 -6 d -32 Y f black 1227 939 m 24
- 6 d 94 Y -24 -6 d cl s 0 0 0.8 c 1207 954 m 20 -15 d 62 Y -20 15 d f 0 0.2 0.8
- c 1227 1001 m 32 Y -20 15 d -32 Y f black 1207 954 m 20 -15 d 94 Y -20 15 d
- cl s 0 0.2 0.8 c 1227 1033 m 24 6 d -21 15 d -23 -6 d f black 1227 1033 m 24 6
- d -21 15 d -23 -6 d cl s 0 0 0.8 c 1204 933 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8
- c 1227 1001 m 32 Y -23 -6 d -32 Y f black 1204 933 m 23 6 d 94 Y -23 -6 d cl s
- 0 0 0.8 c 1183 948 m 21 -15 d 62 Y -21 15 d f 0 0.2 0.8 c 1204 995 m 32 Y -21
- 15 d -32 Y f black 1183 948 m 21 -15 d 94 Y -21 15 d cl s 0 0.2 0.8 c 1204 1027
- m 23 6 d -20 15 d -24 -6 d f black 1204 1027 m 23 6 d -20 15 d -24 -6 d cl s 0
- 0 0.8 c 1180 927 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1204 995 m 62 Y -24 -6 d
- -62 Y f 0 0.4 0.8 c 1204 1057 m 37 Y -24 -6 d -37 Y f black 1180 927 m 24 6 d
- 161 Y -24 -6 d cl s 0 0 0.8 c 1160 942 m 20 -15 d 62 Y -20 15 d f 0 0.2 0.8 c
- 1180 989 m 62 Y -20 15 d -62 Y f 0 0.4 0.8 c 1180 1051 m 37 Y -20 15 d -37 Y f
- black 1160 942 m 20 -15 d 161 Y -20 15 d cl s 0 0.4 0.8 c 1180 1088 m 24 6 d
- -21 15 d -23 -6 d f black 1180 1088 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c
- 1157 921 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 1180 989 m 62 Y -23 -6 d -62 Y f
- 0 0.4 0.8 c 1180 1051 m 37 Y -23 -6 d -37 Y f black 1157 921 m 23 6 d 161 Y -23
- -6 d cl s 0 0 0.8 c 1136 936 m 21 -15 d 62 Y -21 15 d f 0 0.2 0.8 c 1157 983 m
- 62 Y -21 16 d -63 Y f 0 0.4 0.8 c 1157 1045 m 37 Y -21 15 d -36 Y f black 1136
- 936 m 21 -15 d 161 Y -21 15 d cl s 0 0.4 0.8 c 1157 1082 m 23 6 d -20 15 d -24
- -6 d f black 1157 1082 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1133 915 m 24
- 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1157 983 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c
- 1157 1045 m 50 Y -24 -6 d -50 Y f black 1133 915 m 24 6 d 174 Y -24 -6 d cl s 0
- 0 0.8 c 1113 930 m 20 -15 d 62 Y -20 15 d f 0 0.2 0.8 c 1133 977 m 62 Y -20 16
- d -63 Y f 0 0.4 0.8 c 1133 1039 m 50 Y -20 16 d -50 Y f black 1113 930 m 20 -15
- d 174 Y -20 16 d cl s 0 0.4 0.8 c 1133 1089 m 24 6 d -21 16 d -23 -6 d f black
- 1133 1089 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1110 909 m 23 6 d 62 Y -23
- -6 d f 0 0.2 0.8 c 1133 977 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 1133 1039 m 10
- Y -23 -6 d -10 Y f black 1110 909 m 23 6 d 134 Y -23 -6 d cl s 0 0 0.8 c 1089
- 924 m 21 -15 d 62 Y -21 15 d f 0 0.2 0.8 c 1110 971 m 62 Y -21 16 d -63 Y f 0
- 0.4 0.8 c 1110 1033 m 10 Y -21 16 d -10 Y f black 1089 924 m 21 -15 d 134 Y -21
- 16 d cl s 0 0.4 0.8 c 1110 1043 m 23 6 d -20 16 d -24 -6 d f black 1110 1043 m
- 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1086 903 m 24 6 d 62 Y -24 -6 d f 0 0.2
- 0.8 c 1110 971 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 1110 1033 m 10 Y -24 -6 d
- -10 Y f black 1086 903 m 24 6 d 134 Y -24 -6 d cl s 0 0 0.8 c 1066 918 m 20 -15
- d 62 Y -20 15 d f 0 0.2 0.8 c 1086 965 m 62 Y -20 16 d -63 Y f 0 0.4 0.8 c 1086
- 1027 m 10 Y -20 16 d -10 Y f black 1066 918 m 20 -15 d 134 Y -20 16 d cl s 0
- 0.4 0.8 c 1086 1037 m 24 6 d -21 16 d -23 -6 d f black 1086 1037 m 24 6 d -21
- 16 d -23 -6 d cl s 0 0 0.8 c 1063 897 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 1086
- 965 m 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 1086 1027 m 62 Y -23 -6 d -62 Y f 0 0.6
- 0.8 c 1086 1089 m 2 Y -23 -6 d -2 Y f black 1063 897 m 23 6 d 188 Y -23 -6 d
- cl s 0 0 0.8 c 1043 912 m 20 -15 d 62 Y -20 15 d f 0 0.2 0.8 c 1063 959 m 62 Y
- -20 16 d -63 Y f 0 0.4 0.8 c 1063 1021 m 62 Y -20 16 d -62 Y f 0 0.6 0.8 c 1063
- 1083 m 2 Y -20 15 d -1 Y f black 1043 912 m 20 -15 d 188 Y -20 15 d cl s 0 0.6
- 0.8 c 1063 1085 m 23 6 d -20 15 d -23 -6 d f black 1063 1085 m 23 6 d -20 15 d
- -23 -6 d cl s 0 0 0.8 c 1039 891 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1063 959
- m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 1063 1021 m 24 Y -24 -6 d -24 Y f black
- 1039 891 m 24 6 d 148 Y -24 -6 d cl s 0 0 0.8 c 1019 906 m 20 -15 d 62 Y -20 15
- d f 0 0.2 0.8 c 1039 953 m 62 Y -20 16 d -63 Y f 0 0.4 0.8 c 1039 1015 m 24 Y
- -20 15 d -23 Y f black 1019 906 m 20 -15 d 148 Y -20 15 d cl s 0 0.4 0.8 c 1039
- 1039 m 24 6 d -20 15 d -24 -6 d f black 1039 1039 m 24 6 d -20 15 d -24 -6 d
- cl s 0 0 0.8 c 1016 885 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 1039 953 m 62 Y
- -23 -6 d -62 Y f 0 0.4 0.8 c 1039 1015 m 62 Y -23 -6 d -62 Y f 0 0.6 0.8 c 1039
- 1077 m 15 Y -23 -6 d -15 Y f black 1016 885 m 23 6 d 201 Y -23 -6 d cl s 0 0
- 0.8 c 996 900 m 20 -15 d 62 Y -20 15 d f 0 0.2 0.8 c 1016 947 m 62 Y -20 16 d
- -63 Y f 0 0.4 0.8 c 1016 1009 m 62 Y -20 16 d -62 Y f 0 0.6 0.8 c 1016 1071 m
- 15 Y -20 16 d -15 Y f black 996 900 m 20 -15 d 201 Y -20 16 d cl s 0 0.6 0.8 c
- 1016 1086 m 23 6 d -20 16 d -23 -6 d f black 1016 1086 m 23 6 d -20 16 d -23 -6
- d cl s 0 0 0.8 c 992 879 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1016 947 m 45 Y
- -24 -6 d -45 Y f black 992 879 m 24 6 d 107 Y -24 -6 d cl s 0 0 0.8 c 972 894 m
- 20 -15 d 62 Y -20 16 d f 0 0.2 0.8 c 992 941 m 45 Y -20 16 d -45 Y f black 972
- 894 m 20 -15 d 107 Y -20 16 d cl s 0 0.2 0.8 c 992 986 m 24 6 d -20 16 d -24 -6
- d f black 992 986 m 24 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 969 873 m 23 6 d 62
- Y -23 -6 d f 0 0.2 0.8 c 992 941 m 45 Y -23 -6 d -45 Y f black 969 873 m 23 6 d
- 107 Y -23 -6 d cl s 0 0 0.8 c 949 888 m 20 -15 d 62 Y -20 16 d f 0 0.2 0.8 c
- 969 935 m 45 Y -20 16 d -45 Y f black 949 888 m 20 -15 d 107 Y -20 16 d cl s 0
- 0.2 0.8 c 969 980 m 23 6 d -20 16 d -23 -6 d f black 969 980 m 23 6 d -20 16 d
- -23 -6 d cl s 0 0 0.8 c 945 867 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 969 935 m
- 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 969 997 m 62 Y -24 -6 d -62 Y f 0 0.6 0.8 c
- 969 1059 m 2 Y -24 -6 d -2 Y f black 945 867 m 24 6 d 188 Y -24 -6 d cl s 0 0
- 0.8 c 925 882 m 20 -15 d 62 Y -20 16 d f 0 0.2 0.8 c 945 929 m 62 Y -20 16 d
- -62 Y f 0 0.4 0.8 c 945 991 m 62 Y -20 16 d -62 Y f 0 0.6 0.8 c 945 1053 m 2 Y
- -20 16 d -2 Y f black 925 882 m 20 -15 d 188 Y -20 16 d cl s 0 0.6 0.8 c 945
- 1055 m 24 6 d -20 15 d -24 -5 d f black 945 1055 m 24 6 d -20 15 d -24 -5 d
- cl s 0 0 0.8 c 922 861 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 945 929 m 32 Y -23
- -6 d -32 Y f black 922 861 m 23 6 d 94 Y -23 -6 d cl s 0 0 0.8 c 902 876 m 20
- -15 d 62 Y -20 16 d f 0 0.2 0.8 c 922 923 m 32 Y -20 15 d -31 Y f black 902 876
- m 20 -15 d 94 Y -20 15 d cl s 0 0.2 0.8 c 922 955 m 23 6 d -20 15 d -23 -6 d f
- black 922 955 m 23 6 d -20 15 d -23 -6 d cl s 0 0 0.8 c 898 855 m 24 6 d 62 Y
- -24 -6 d f 0 0.2 0.8 c 922 923 m 62 Y -24 -6 d -62 Y f 0 0.4 0.8 c 922 985 m 10
- Y -24 -6 d -10 Y f black 898 855 m 24 6 d 134 Y -24 -6 d cl s 0 0 0.8 c 878 870
- m 20 -15 d 62 Y -20 16 d f 0 0.2 0.8 c 898 917 m 62 Y -20 16 d -62 Y f 0 0.4
- 0.8 c 898 979 m 10 Y -20 16 d -10 Y f black 878 870 m 20 -15 d 134 Y -20 16 d
- cl s 0 0.4 0.8 c 898 989 m 24 6 d -20 16 d -24 -6 d f black 898 989 m 24 6 d
- -20 16 d -24 -6 d cl s 0 0 0.8 c 875 849 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c
- 898 917 m 59 Y -23 -6 d -59 Y f black 875 849 m 23 6 d 121 Y -23 -6 d cl s 0 0
- 0.8 c 855 864 m 20 -15 d 62 Y -20 16 d f 0 0.2 0.8 c 875 911 m 59 Y -20 15 d
- -58 Y f black 855 864 m 20 -15 d 121 Y -20 15 d cl s 0 0.2 0.8 c 875 970 m 23 6
- d -20 15 d -23 -6 d f black 875 970 m 23 6 d -20 15 d -23 -6 d cl s 0 0 0.8 c
- 851 843 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 875 911 m 32 Y -24 -6 d -32 Y f
- black 851 843 m 24 6 d 94 Y -24 -6 d cl s 0 0 0.8 c 831 858 m 20 -15 d 62 Y -20
- 16 d f 0 0.2 0.8 c 851 905 m 32 Y -20 16 d -32 Y f black 831 858 m 20 -15 d 94
- Y -20 16 d cl s 0 0.2 0.8 c 851 937 m 24 6 d -20 16 d -24 -6 d f black 851 937
- m 24 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 828 837 m 23 6 d 40 Y -23 -6 d f
- black 828 837 m 23 6 d 40 Y -23 -6 d cl s 0 0 0.8 c 808 853 m 20 -16 d 40 Y -20
- 16 d f black 808 853 m 20 -16 d 40 Y -20 16 d cl s 0 0 0.8 c 828 877 m 23 6 d
- -20 16 d -23 -6 d f black 828 877 m 23 6 d -20 16 d -23 -6 d cl s 0 0 0.8 c 804
- 831 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 828 899 m 59 Y -24 -6 d -59 Y f black
- 804 831 m 24 6 d 121 Y -24 -6 d cl s 0 0 0.8 c 784 847 m 20 -16 d 62 Y -20 16 d
- f 0 0.2 0.8 c 804 893 m 59 Y -20 15 d -58 Y f black 784 847 m 20 -16 d 121 Y
- -20 15 d cl s 0 0.2 0.8 c 804 952 m 24 6 d -20 15 d -24 -6 d f black 804 952 m
- 24 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 781 825 m 23 6 d -20 16 d -23 -6 d f
- black 781 825 m 23 6 d -20 16 d -23 -6 d cl s 0 0 0.8 c 757 819 m 24 6 d -20 16
- d -24 -6 d f black 757 819 m 24 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 734 813 m
- 23 6 d -20 16 d -23 -6 d f black 734 813 m 23 6 d -20 16 d -23 -6 d cl s 0 0
- 0.8 c 711 807 m 23 6 d -20 16 d -24 -6 d f black 711 807 m 23 6 d -20 16 d -24
- -6 d cl s 0 0 0.8 c 1835 1073 m 23 6 d -20 15 d -24 -6 d f black 1835 1073 m 23
- 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1811 1067 m 24 6 d -21 15 d -23 -6 d f
- black 1811 1067 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 1788 1061 m 23 6 d
- -20 15 d -23 -6 d f black 1788 1061 m 23 6 d -20 15 d -23 -6 d cl s 0 0 0.8 c
- 1764 1055 m 24 6 d -20 15 d -24 -6 d f black 1764 1055 m 24 6 d -20 15 d -24 -6
- d cl s 0 0 0.8 c 1741 1049 m 23 6 d 40 Y -23 -6 d f black 1741 1049 m 23 6 d 40
- Y -23 -6 d cl s 0 0 0.8 c 1721 1064 m 20 -15 d 40 Y -20 16 d f black 1721 1064
- m 20 -15 d 40 Y -20 16 d cl s 0 0 0.8 c 1741 1089 m 23 6 d -20 15 d -23 -5 d f
- black 1741 1089 m 23 6 d -20 15 d -23 -5 d cl s 0 0 0.8 c 1717 1043 m 24 6 d 53
- Y -24 -6 d f black 1717 1043 m 24 6 d 53 Y -24 -6 d cl s 0 0 0.8 c 1697 1058 m
- 20 -15 d 53 Y -20 16 d f black 1697 1058 m 20 -15 d 53 Y -20 16 d cl s 0 0 0.8
- c 1717 1096 m 24 6 d -20 16 d -24 -6 d f black 1717 1096 m 24 6 d -20 16 d -24
- -6 d cl s 0 0 0.8 c 1694 1037 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 1717 1105 m
- 62 Y -23 -6 d -62 Y f 0 0.4 0.8 c 1717 1167 m 50 Y -23 -6 d -50 Y f black 1694
- 1037 m 23 6 d 174 Y -23 -6 d cl s 0 0 0.8 c 1674 1052 m 20 -15 d 62 Y -20 15 d
- f 0 0.2 0.8 c 1694 1099 m 62 Y -20 16 d -63 Y f 0 0.4 0.8 c 1694 1161 m 50 Y
- -20 16 d -50 Y f black 1674 1052 m 20 -15 d 174 Y -20 16 d cl s 0 0.4 0.8 c
- 1694 1211 m 23 6 d -20 16 d -23 -6 d f black 1694 1211 m 23 6 d -20 16 d -23 -6
- d cl s 0 0 0.8 c 1670 1031 m 24 6 d 40 Y -24 -6 d f black 1670 1031 m 24 6 d 40
- Y -24 -6 d cl s 0 0 0.8 c 1650 1046 m 20 -15 d 40 Y -20 16 d f black 1650 1046
- m 20 -15 d 40 Y -20 16 d cl s 0 0 0.8 c 1670 1071 m 24 6 d -20 16 d -24 -6 d f
- black 1670 1071 m 24 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1647 1025 m 23 6 d 40
- Y -23 -6 d f black 1647 1025 m 23 6 d 40 Y -23 -6 d cl s 0 0 0.8 c 1627 1040 m
- 20 -15 d 40 Y -20 16 d f black 1627 1040 m 20 -15 d 40 Y -20 16 d cl s 0 0 0.8
- c 1647 1065 m 23 6 d -20 16 d -23 -6 d f black 1647 1065 m 23 6 d -20 16 d -23
- -6 d cl s 0 0 0.8 c 1623 1019 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1647 1087 m
- 5 Y -24 -6 d -5 Y f black 1623 1019 m 24 6 d 67 Y -24 -6 d cl s 0 0 0.8 c 1603
- 1034 m 20 -15 d 62 Y -20 15 d f 0 0.2 0.8 c 1623 1081 m 5 Y -20 15 d -5 Y f
- black 1603 1034 m 20 -15 d 67 Y -20 15 d cl s 0 0.2 0.8 c 1623 1086 m 24 6 d
- -20 15 d -24 -6 d f black 1623 1086 m 24 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c
- 1600 1013 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 1623 1081 m 18 Y -23 -6 d -18 Y
- f black 1600 1013 m 23 6 d 80 Y -23 -6 d cl s 0 0 0.8 c 1580 1028 m 20 -15 d 62
- Y -20 15 d f 0 0.2 0.8 c 1600 1075 m 18 Y -20 16 d -19 Y f black 1580 1028 m 20
- -15 d 80 Y -20 16 d cl s 0 0.2 0.8 c 1600 1093 m 23 6 d -20 16 d -23 -6 d f
- black 1600 1093 m 23 6 d -20 16 d -23 -6 d cl s 0 0 0.8 c 1576 1007 m 24 6 d 40
- Y -24 -6 d f black 1576 1007 m 24 6 d 40 Y -24 -6 d cl s 0 0 0.8 c 1556 1022 m
- 20 -15 d 40 Y -20 16 d f black 1556 1022 m 20 -15 d 40 Y -20 16 d cl s 0 0 0.8
- c 1576 1047 m 24 6 d -20 16 d -24 -6 d f black 1576 1047 m 24 6 d -20 16 d -24
- -6 d cl s 0 0 0.8 c 1553 1001 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 1576 1069 m
- 18 Y -23 -6 d -18 Y f black 1553 1001 m 23 6 d 80 Y -23 -6 d cl s 0 0 0.8 c
- 1533 1016 m 20 -15 d 62 Y -20 16 d f 0 0.2 0.8 c 1553 1063 m 18 Y -20 16 d -18
- Y f black 1533 1016 m 20 -15 d 80 Y -20 16 d cl s 0 0.2 0.8 c 1553 1081 m 23 6
- d -20 16 d -23 -6 d f black 1553 1081 m 23 6 d -20 16 d -23 -6 d cl s 0 0 0.8 c
- 1529 995 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1553 1063 m 32 Y -24 -6 d -32 Y f
- black 1529 995 m 24 6 d 94 Y -24 -6 d cl s 0 0 0.8 c 1509 1010 m 20 -15 d 62 Y
- -20 16 d f 0 0.2 0.8 c 1529 1057 m 32 Y -20 15 d -31 Y f black 1509 1010 m 20
- -15 d 94 Y -20 15 d cl s 0 0.2 0.8 c 1529 1089 m 24 6 d -20 15 d -24 -6 d f
- black 1529 1089 m 24 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1506 989 m 23 6 d 27
- Y -23 -6 d f black 1506 989 m 23 6 d 27 Y -23 -6 d cl s 0 0 0.8 c 1486 1004 m
- 20 -15 d 27 Y -20 15 d f black 1486 1004 m 20 -15 d 27 Y -20 15 d cl s 0 0 0.8
- c 1506 1016 m 23 6 d -20 15 d -23 -6 d f black 1506 1016 m 23 6 d -20 15 d -23
- -6 d cl s 0 0 0.8 c 1483 983 m 23 6 d 13 Y -23 -6 d f black 1483 983 m 23 6 d
- 13 Y -23 -6 d cl s 0 0 0.8 c 1462 998 m 21 -15 d 13 Y -21 16 d f black 1462 998
- m 21 -15 d 13 Y -21 16 d cl s 0 0 0.8 c 1483 996 m 23 6 d -20 16 d -24 -6 d f
- black 1483 996 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1459 977 m 24 6 d 62 Y
- -24 -6 d f 0 0.2 0.8 c 1483 1045 m 32 Y -24 -6 d -32 Y f black 1459 977 m 24 6
- d 94 Y -24 -6 d cl s 0 0 0.8 c 1439 992 m 20 -15 d 62 Y -20 16 d f 0 0.2 0.8 c
- 1459 1039 m 32 Y -20 15 d -31 Y f black 1439 992 m 20 -15 d 94 Y -20 15 d cl s
- 0 0.2 0.8 c 1459 1071 m 24 6 d -21 15 d -23 -6 d f black 1459 1071 m 24 6 d -21
- 15 d -23 -6 d cl s 0 0 0.8 c 1436 971 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 1459
- 1039 m 5 Y -23 -6 d -5 Y f black 1436 971 m 23 6 d 67 Y -23 -6 d cl s 0 0 0.8 c
- 1415 986 m 21 -15 d 62 Y -21 16 d f 0 0.2 0.8 c 1436 1033 m 5 Y -21 16 d -5 Y f
- black 1415 986 m 21 -15 d 67 Y -21 16 d cl s 0 0.2 0.8 c 1436 1038 m 23 6 d -20
- 16 d -24 -6 d f black 1436 1038 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1412
- 965 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1436 1033 m 59 Y -24 -6 d -59 Y f
- black 1412 965 m 24 6 d 121 Y -24 -6 d cl s 0 0 0.8 c 1392 980 m 20 -15 d 62 Y
- -20 16 d f 0 0.2 0.8 c 1412 1027 m 59 Y -20 15 d -58 Y f black 1392 980 m 20
- -15 d 121 Y -20 15 d cl s 0 0.2 0.8 c 1412 1086 m 24 6 d -21 15 d -23 -6 d f
- black 1412 1086 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 1389 959 m 23 6 d 40
- Y -23 -6 d f black 1389 959 m 23 6 d 40 Y -23 -6 d cl s 0 0 0.8 c 1368 975 m 21
- -16 d 40 Y -21 16 d f black 1368 975 m 21 -16 d 40 Y -21 16 d cl s 0 0 0.8 c
- 1389 999 m 23 6 d -20 16 d -24 -6 d f black 1389 999 m 23 6 d -20 16 d -24 -6 d
- cl s 0 0 0.8 c 1365 953 m 24 6 d 40 Y -24 -6 d f black 1365 953 m 24 6 d 40 Y
- -24 -6 d cl s 0 0 0.8 c 1345 969 m 20 -16 d 40 Y -20 16 d f black 1345 969 m 20
- -16 d 40 Y -20 16 d cl s 0 0 0.8 c 1365 993 m 24 6 d -21 16 d -23 -6 d f black
- 1365 993 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1342 947 m 23 6 d 62 Y -23
- -6 d f 0 0.2 0.8 c 1365 1015 m 5 Y -23 -6 d -5 Y f black 1342 947 m 23 6 d 67 Y
- -23 -6 d cl s 0 0 0.8 c 1321 963 m 21 -16 d 62 Y -21 16 d f 0 0.2 0.8 c 1342
- 1009 m 5 Y -21 16 d -5 Y f black 1321 963 m 21 -16 d 67 Y -21 16 d cl s 0 0.2
- 0.8 c 1342 1014 m 23 6 d -20 16 d -24 -6 d f black 1342 1014 m 23 6 d -20 16 d
- -24 -6 d cl s 0 0 0.8 c 1318 941 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1342 1009
- m 45 Y -24 -5 d -46 Y f black 1318 941 m 24 6 d 107 Y -24 -5 d cl s 0 0 0.8 c
- 1298 957 m 20 -16 d 62 Y -20 16 d f 0 0.2 0.8 c 1318 1003 m 46 Y -20 15 d -45 Y
- f black 1298 957 m 20 -16 d 108 Y -20 15 d cl s 0 0.2 0.8 c 1318 1049 m 24 5 d
- -21 16 d -23 -6 d f black 1318 1049 m 24 5 d -21 16 d -23 -6 d cl s 0 0 0.8 c
- 1295 935 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 1318 1003 m 32 Y -23 -6 d -32 Y f
- black 1295 935 m 23 6 d 94 Y -23 -6 d cl s 0 0 0.8 c 1274 951 m 21 -16 d 62 Y
- -21 16 d f 0 0.2 0.8 c 1295 997 m 32 Y -21 16 d -32 Y f black 1274 951 m 21 -16
- d 94 Y -21 16 d cl s 0 0.2 0.8 c 1295 1029 m 23 6 d -20 16 d -24 -6 d f black
- 1295 1029 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1271 929 m 24 6 d 62 Y -24
- -6 d f 0 0.2 0.8 c 1295 997 m 46 Y -24 -6 d -46 Y f black 1271 929 m 24 6 d 108
- Y -24 -6 d cl s 0 0 0.8 c 1251 945 m 20 -16 d 62 Y -20 16 d f 0 0.2 0.8 c 1271
- 991 m 46 Y -20 15 d -45 Y f black 1251 945 m 20 -16 d 108 Y -20 15 d cl s 0 0.2
- 0.8 c 1271 1037 m 24 6 d -21 15 d -23 -6 d f black 1271 1037 m 24 6 d -21 15 d
- -23 -6 d cl s 0 0 0.8 c 1248 923 m 23 6 d 40 Y -23 -6 d f black 1248 923 m 23 6
- d 40 Y -23 -6 d cl s 0 0 0.8 c 1227 939 m 21 -16 d 40 Y -21 16 d f black 1227
- 939 m 21 -16 d 40 Y -21 16 d cl s 0 0 0.8 c 1248 963 m 23 6 d -20 16 d -24 -6 d
- f black 1248 963 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1224 917 m 24 6 d 62
- Y -24 -6 d f 0 0.2 0.8 c 1248 985 m 32 Y -24 -6 d -32 Y f black 1224 917 m 24 6
- d 94 Y -24 -6 d cl s 0 0 0.8 c 1204 933 m 20 -16 d 62 Y -20 16 d f 0 0.2 0.8 c
- 1224 979 m 32 Y -20 16 d -32 Y f black 1204 933 m 20 -16 d 94 Y -20 16 d cl s 0
- 0.2 0.8 c 1224 1011 m 24 6 d -21 16 d -23 -6 d f black 1224 1011 m 24 6 d -21
- 16 d -23 -6 d cl s 0 0 0.8 c 1201 911 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 1224
- 979 m 46 Y -23 -6 d -46 Y f black 1201 911 m 23 6 d 108 Y -23 -6 d cl s 0 0 0.8
- c 1180 927 m 21 -16 d 62 Y -21 16 d f 0 0.2 0.8 c 1201 973 m 46 Y -21 15 d -45
- Y f black 1180 927 m 21 -16 d 108 Y -21 15 d cl s 0 0.2 0.8 c 1201 1019 m 23 6
- d -20 15 d -24 -6 d f black 1201 1019 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c
- 1177 905 m 24 6 d 27 Y -24 -6 d f black 1177 905 m 24 6 d 27 Y -24 -6 d cl s 0
- 0 0.8 c 1157 921 m 20 -16 d 27 Y -20 16 d f black 1157 921 m 20 -16 d 27 Y -20
- 16 d cl s 0 0 0.8 c 1177 932 m 24 6 d -21 16 d -23 -6 d f black 1177 932 m 24 6
- d -21 16 d -23 -6 d cl s 0 0 0.8 c 1154 899 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8
- c 1177 967 m 5 Y -23 -6 d -5 Y f black 1154 899 m 23 6 d 67 Y -23 -6 d cl s 0 0
- 0.8 c 1133 915 m 21 -16 d 62 Y -21 16 d f 0 0.2 0.8 c 1154 961 m 5 Y -21 16 d
- -5 Y f black 1133 915 m 21 -16 d 67 Y -21 16 d cl s 0 0.2 0.8 c 1154 966 m 23 6
- d -20 16 d -24 -6 d f black 1154 966 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c
- 1130 893 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1154 961 m 19 Y -24 -6 d -19 Y f
- black 1130 893 m 24 6 d 81 Y -24 -6 d cl s 0 0 0.8 c 1110 909 m 20 -16 d 62 Y
- -20 16 d f 0 0.2 0.8 c 1130 955 m 19 Y -20 15 d -18 Y f black 1110 909 m 20 -16
- d 81 Y -20 15 d cl s 0 0.2 0.8 c 1130 974 m 24 6 d -21 15 d -23 -6 d f black
- 1130 974 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 1107 887 m 23 6 d 62 Y -23
- -6 d f 0 0.2 0.8 c 1130 955 m 32 Y -23 -6 d -32 Y f black 1107 887 m 23 6 d 94
- Y -23 -6 d cl s 0 0 0.8 c 1086 903 m 21 -16 d 62 Y -21 16 d f 0 0.2 0.8 c 1107
- 949 m 32 Y -21 16 d -32 Y f black 1086 903 m 21 -16 d 94 Y -21 16 d cl s 0 0.2
- 0.8 c 1107 981 m 23 6 d -20 16 d -24 -6 d f black 1107 981 m 23 6 d -20 16 d
- -24 -6 d cl s 0 0 0.8 c 1083 881 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1107 949
- m 32 Y -24 -6 d -32 Y f black 1083 881 m 24 6 d 94 Y -24 -6 d cl s 0 0 0.8 c
- 1063 897 m 20 -16 d 62 Y -20 16 d f 0 0.2 0.8 c 1083 943 m 32 Y -20 16 d -32 Y
- f black 1063 897 m 20 -16 d 94 Y -20 16 d cl s 0 0.2 0.8 c 1083 975 m 24 6 d
- -21 16 d -23 -6 d f black 1083 975 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c
- 1060 875 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 1083 943 m 63 Y -23 -6 d -63 Y f
- 0 0.4 0.8 c 1083 1006 m 10 Y -23 -6 d -10 Y f black 1060 875 m 23 6 d 135 Y -23
- -6 d cl s 0 0 0.8 c 1039 891 m 21 -16 d 62 Y -21 16 d f 0 0.2 0.8 c 1060 937 m
- 63 Y -21 15 d -62 Y f 0 0.4 0.8 c 1060 1000 m 10 Y -21 15 d -10 Y f black 1039
- 891 m 21 -16 d 135 Y -21 15 d cl s 0 0.4 0.8 c 1060 1010 m 23 6 d -20 15 d -24
- -6 d f black 1060 1010 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1036 869 m 24
- 6 d 41 Y -24 -6 d f black 1036 869 m 24 6 d 41 Y -24 -6 d cl s 0 0 0.8 c 1016
- 885 m 20 -16 d 41 Y -20 15 d f black 1016 885 m 20 -16 d 41 Y -20 15 d cl s 0 0
- 0.8 c 1036 910 m 24 6 d -21 15 d -23 -6 d f black 1036 910 m 24 6 d -21 15 d
- -23 -6 d cl s 0 0 0.8 c 1013 863 m 23 6 d 27 Y -23 -6 d f black 1013 863 m 23 6
- d 27 Y -23 -6 d cl s 0 0 0.8 c 992 879 m 21 -16 d 27 Y -21 16 d f black 992 879
- m 21 -16 d 27 Y -21 16 d cl s 0 0 0.8 c 1013 890 m 23 6 d -20 16 d -24 -6 d f
- black 1013 890 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 989 857 m 24 6 d 62 Y
- -24 -6 d f 0 0.2 0.8 c 1013 925 m 59 Y -24 -6 d -59 Y f black 989 857 m 24 6 d
- 121 Y -24 -6 d cl s 0 0 0.8 c 969 873 m 20 -16 d 62 Y -20 16 d f 0 0.2 0.8 c
- 989 919 m 59 Y -20 16 d -59 Y f black 969 873 m 20 -16 d 121 Y -20 16 d cl s 0
- 0.2 0.8 c 989 978 m 24 6 d -21 16 d -23 -6 d f black 989 978 m 24 6 d -21 16 d
- -23 -6 d cl s 0 0 0.8 c 966 851 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 989 919 m
- 32 Y -23 -6 d -32 Y f black 966 851 m 23 6 d 94 Y -23 -6 d cl s 0 0 0.8 c 945
- 867 m 21 -16 d 62 Y -21 16 d f 0 0.2 0.8 c 966 913 m 32 Y -21 16 d -32 Y f
- black 945 867 m 21 -16 d 94 Y -21 16 d cl s 0 0.2 0.8 c 966 945 m 23 6 d -20 16
- d -24 -6 d f black 966 945 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 942 845 m
- 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 966 913 m 59 Y -24 -6 d -59 Y f black 942
- 845 m 24 6 d 121 Y -24 -6 d cl s 0 0 0.8 c 922 861 m 20 -16 d 62 Y -20 16 d f 0
- 0.2 0.8 c 942 907 m 59 Y -20 16 d -59 Y f black 922 861 m 20 -16 d 121 Y -20 16
- d cl s 0 0.2 0.8 c 942 966 m 24 6 d -21 16 d -23 -6 d f black 942 966 m 24 6 d
- -21 16 d -23 -6 d cl s 0 0 0.8 c 919 839 m 23 6 d 54 Y -23 -6 d f black 919 839
- m 23 6 d 54 Y -23 -6 d cl s 0 0 0.8 c 898 855 m 21 -16 d 54 Y -21 16 d f black
- 898 855 m 21 -16 d 54 Y -21 16 d cl s 0 0 0.8 c 919 893 m 23 6 d -20 16 d -24
- -6 d f black 919 893 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 895 833 m 24 6 d
- 41 Y -24 -6 d f black 895 833 m 24 6 d 41 Y -24 -6 d cl s 0 0 0.8 c 875 849 m
- 20 -16 d 41 Y -20 15 d f black 875 849 m 20 -16 d 41 Y -20 15 d cl s 0 0 0.8 c
- 895 874 m 24 6 d -21 15 d -23 -6 d f black 895 874 m 24 6 d -21 15 d -23 -6 d
- cl s 0 0 0.8 c 872 827 m 23 6 d 63 Y -23 -6 d f 0 0.2 0.8 c 895 896 m 5 Y -23
- -6 d -5 Y f black 872 827 m 23 6 d 68 Y -23 -6 d cl s 0 0 0.8 c 851 843 m 21
- -16 d 63 Y -21 15 d f 0 0.2 0.8 c 872 890 m 5 Y -21 15 d -5 Y f black 851 843 m
- 21 -16 d 68 Y -21 15 d cl s 0 0.2 0.8 c 872 895 m 23 6 d -20 15 d -24 -6 d f
- black 872 895 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 848 821 m 24 6 d 63 Y
- -24 -6 d f 0 0.2 0.8 c 872 890 m 18 Y -24 -6 d -18 Y f black 848 821 m 24 6 d
- 81 Y -24 -6 d cl s 0 0 0.8 c 828 837 m 20 -16 d 63 Y -20 15 d f 0 0.2 0.8 c 848
- 884 m 18 Y -20 16 d -19 Y f black 828 837 m 20 -16 d 81 Y -20 16 d cl s 0 0.2
- 0.8 c 848 902 m 24 6 d -21 16 d -23 -6 d f black 848 902 m 24 6 d -21 16 d -23
- -6 d cl s 0 0 0.8 c 825 815 m 23 6 d 54 Y -23 -6 d f black 825 815 m 23 6 d 54
- Y -23 -6 d cl s 0 0 0.8 c 804 831 m 21 -16 d 54 Y -21 16 d f black 804 831 m 21
- -16 d 54 Y -21 16 d cl s 0 0 0.8 c 825 869 m 23 6 d -20 16 d -24 -6 d f black
- 825 869 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 801 809 m 24 6 d -21 16 d -23
- -6 d f black 801 809 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 778 803 m 23 6 d
- -20 16 d -24 -6 d f black 778 803 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 754
- 798 m 24 5 d -21 16 d -23 -6 d f black 754 798 m 24 5 d -21 16 d -23 -6 d cl s
- 0 0 0.8 c 731 792 m 23 6 d -20 15 d -23 -6 d f black 731 792 m 23 6 d -20 15 d
- -23 -6 d cl s 0 0 0.8 c 1855 1057 m 24 6 d -21 16 d -23 -6 d f black 1855 1057
- m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1832 1051 m 23 6 d -20 16 d -24 -6 d
- f black 1832 1051 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1808 1045 m 24 6 d
- -21 16 d -23 -6 d f black 1808 1045 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c
- 1785 1039 m 23 6 d -20 16 d -24 -6 d f black 1785 1039 m 23 6 d -20 16 d -24 -6
- d cl s 0 0 0.8 c 1761 1033 m 24 6 d 54 Y -24 -6 d f black 1761 1033 m 24 6 d 54
- Y -24 -6 d cl s 0 0 0.8 c 1741 1049 m 20 -16 d 54 Y -20 15 d f black 1741 1049
- m 20 -16 d 54 Y -20 15 d cl s 0 0 0.8 c 1761 1087 m 24 6 d -21 15 d -23 -6 d f
- black 1761 1087 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 1738 1027 m 23 6 d 40
- Y -23 -6 d f black 1738 1027 m 23 6 d 40 Y -23 -6 d cl s 0 0 0.8 c 1717 1043 m
- 21 -16 d 40 Y -21 16 d f black 1717 1043 m 21 -16 d 40 Y -21 16 d cl s 0 0 0.8
- c 1738 1067 m 23 6 d -20 16 d -24 -6 d f black 1738 1067 m 23 6 d -20 16 d -24
- -6 d cl s 0 0 0.8 c 1714 1021 m 24 6 d 40 Y -24 -6 d f black 1714 1021 m 24 6 d
- 40 Y -24 -6 d cl s 0 0 0.8 c 1694 1037 m 20 -16 d 40 Y -20 16 d f black 1694
- 1037 m 20 -16 d 40 Y -20 16 d cl s 0 0 0.8 c 1714 1061 m 24 6 d -21 16 d -23 -6
- d f black 1714 1061 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1691 1015 m 23 6
- d 40 Y -23 -6 d f black 1691 1015 m 23 6 d 40 Y -23 -6 d cl s 0 0 0.8 c 1670
- 1031 m 21 -16 d 40 Y -21 16 d f black 1670 1031 m 21 -16 d 40 Y -21 16 d cl s 0
- 0 0.8 c 1691 1055 m 23 6 d -20 16 d -24 -6 d f black 1691 1055 m 23 6 d -20 16
- d -24 -6 d cl s 0 0 0.8 c 1667 1009 m 24 6 d 54 Y -24 -6 d f black 1667 1009 m
- 24 6 d 54 Y -24 -6 d cl s 0 0 0.8 c 1647 1025 m 20 -16 d 54 Y -20 15 d f black
- 1647 1025 m 20 -16 d 54 Y -20 15 d cl s 0 0 0.8 c 1667 1063 m 24 6 d -21 15 d
- -23 -6 d f black 1667 1063 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 1644 1003
- m 23 6 d 54 Y -23 -6 d f black 1644 1003 m 23 6 d 54 Y -23 -6 d cl s 0 0 0.8 c
- 1623 1019 m 21 -16 d 54 Y -21 16 d f black 1623 1019 m 21 -16 d 54 Y -21 16 d
- cl s 0 0 0.8 c 1644 1057 m 23 6 d -20 15 d -24 -5 d f black 1644 1057 m 23 6 d
- -20 15 d -24 -5 d cl s 0 0 0.8 c 1620 997 m 24 6 d 27 Y -24 -6 d f black 1620
- 997 m 24 6 d 27 Y -24 -6 d cl s 0 0 0.8 c 1600 1013 m 20 -16 d 27 Y -20 16 d f
- black 1600 1013 m 20 -16 d 27 Y -20 16 d cl s 0 0 0.8 c 1620 1024 m 24 6 d -21
- 16 d -23 -6 d f black 1620 1024 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1597
- 991 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 1620 1059 m 19 Y -23 -6 d -19 Y f
- black 1597 991 m 23 6 d 81 Y -23 -6 d cl s 0 0 0.8 c 1576 1007 m 21 -16 d 62 Y
- -21 16 d f 0 0.2 0.8 c 1597 1053 m 19 Y -21 15 d -18 Y f black 1576 1007 m 21
- -16 d 81 Y -21 15 d cl s 0 0.2 0.8 c 1597 1072 m 23 6 d -20 15 d -24 -6 d f
- black 1597 1072 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1573 985 m 24 6 d 54
- Y -24 -6 d f black 1573 985 m 24 6 d 54 Y -24 -6 d cl s 0 0 0.8 c 1553 1001 m
- 20 -16 d 54 Y -20 16 d f black 1553 1001 m 20 -16 d 54 Y -20 16 d cl s 0 0 0.8
- c 1573 1039 m 24 6 d -21 16 d -23 -6 d f black 1573 1039 m 24 6 d -21 16 d -23
- -6 d cl s 0 0 0.8 c 1550 979 m 23 6 d 27 Y -23 -6 d f black 1550 979 m 23 6 d
- 27 Y -23 -6 d cl s 0 0 0.8 c 1529 995 m 21 -16 d 27 Y -21 16 d f black 1529 995
- m 21 -16 d 27 Y -21 16 d cl s 0 0 0.8 c 1550 1006 m 23 6 d -20 16 d -24 -6 d f
- black 1550 1006 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1526 973 m 24 6 d 54
- Y -24 -6 d f black 1526 973 m 24 6 d 54 Y -24 -6 d cl s 0 0 0.8 c 1506 989 m 20
- -16 d 54 Y -20 16 d f black 1506 989 m 20 -16 d 54 Y -20 16 d cl s 0 0 0.8 c
- 1526 1027 m 24 6 d -21 16 d -23 -6 d f black 1526 1027 m 24 6 d -21 16 d -23 -6
- d cl s 0 0 0.8 c 1503 967 m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 1526 1035 m 19 Y
- -23 -6 d -19 Y f black 1503 967 m 23 6 d 81 Y -23 -6 d cl s 0 0 0.8 c 1483 983
- m 20 -16 d 62 Y -20 16 d f 0 0.2 0.8 c 1503 1029 m 19 Y -20 16 d -19 Y f black
- 1483 983 m 20 -16 d 81 Y -20 16 d cl s 0 0.2 0.8 c 1503 1048 m 23 6 d -20 15 d
- -23 -5 d f black 1503 1048 m 23 6 d -20 15 d -23 -5 d cl s 0 0 0.8 c 1479 961 m
- 24 6 d 27 Y -24 -6 d f black 1479 961 m 24 6 d 27 Y -24 -6 d cl s 0 0 0.8 c
- 1459 977 m 20 -16 d 27 Y -20 16 d f black 1459 977 m 20 -16 d 27 Y -20 16 d
- cl s 0 0 0.8 c 1479 988 m 24 6 d -20 16 d -24 -6 d f black 1479 988 m 24 6 d
- -20 16 d -24 -6 d cl s 0 0 0.8 c 1456 955 m 23 6 d 14 Y -23 -6 d f black 1456
- 955 m 23 6 d 14 Y -23 -6 d cl s 0 0 0.8 c 1436 971 m 20 -16 d 14 Y -20 15 d f
- black 1436 971 m 20 -16 d 14 Y -20 15 d cl s 0 0 0.8 c 1456 969 m 23 6 d -20 15
- d -23 -6 d f black 1456 969 m 23 6 d -20 15 d -23 -6 d cl s 0 0 0.8 c 1432 949
- m 24 6 d 27 Y -24 -6 d f black 1432 949 m 24 6 d 27 Y -24 -6 d cl s 0 0 0.8 c
- 1412 965 m 20 -16 d 27 Y -20 16 d f black 1412 965 m 20 -16 d 27 Y -20 16 d
- cl s 0 0 0.8 c 1432 976 m 24 6 d -20 16 d -24 -6 d f black 1432 976 m 24 6 d
- -20 16 d -24 -6 d cl s 0 0 0.8 c 1409 943 m 23 6 d 41 Y -23 -6 d f black 1409
- 943 m 23 6 d 41 Y -23 -6 d cl s 0 0 0.8 c 1389 959 m 20 -16 d 41 Y -20 15 d f
- black 1389 959 m 20 -16 d 41 Y -20 15 d cl s 0 0 0.8 c 1409 984 m 23 6 d -20 15
- d -23 -6 d f black 1409 984 m 23 6 d -20 15 d -23 -6 d cl s 0 0 0.8 c 1385 937
- m 24 6 d 27 Y -24 -6 d f black 1385 937 m 24 6 d 27 Y -24 -6 d cl s 0 0 0.8 c
- 1365 953 m 20 -16 d 27 Y -20 16 d f black 1365 953 m 20 -16 d 27 Y -20 16 d
- cl s 0 0 0.8 c 1385 964 m 24 6 d -20 16 d -24 -6 d f black 1385 964 m 24 6 d
- -20 16 d -24 -6 d cl s 0 0 0.8 c 1362 931 m 23 6 d 14 Y -23 -6 d f black 1362
- 931 m 23 6 d 14 Y -23 -6 d cl s 0 0 0.8 c 1342 947 m 20 -16 d 14 Y -20 15 d f
- black 1342 947 m 20 -16 d 14 Y -20 15 d cl s 0 0 0.8 c 1362 945 m 23 6 d -20 15
- d -23 -6 d f black 1362 945 m 23 6 d -20 15 d -23 -6 d cl s 0 0 0.8 c 1338 925
- m 24 6 d 54 Y -24 -6 d f black 1338 925 m 24 6 d 54 Y -24 -6 d cl s 0 0 0.8 c
- 1318 941 m 20 -16 d 54 Y -20 16 d f black 1318 941 m 20 -16 d 54 Y -20 16 d
- cl s 0 0 0.8 c 1338 979 m 24 6 d -20 16 d -24 -6 d f black 1338 979 m 24 6 d
- -20 16 d -24 -6 d cl s 0 0 0.8 c 1315 920 m 23 5 d 63 Y -23 -6 d f 0 0.2 0.8 c
- 1338 988 m 5 Y -23 -6 d -5 Y f black 1315 920 m 23 5 d 68 Y -23 -6 d cl s 0 0
- 0.8 c 1295 935 m 20 -15 d 62 Y -20 15 d f 0 0.2 0.8 c 1315 982 m 5 Y -20 15 d
- -5 Y f black 1295 935 m 20 -15 d 67 Y -20 15 d cl s 0 0.2 0.8 c 1315 987 m 23 6
- d -20 15 d -23 -6 d f black 1315 987 m 23 6 d -20 15 d -23 -6 d cl s 0 0 0.8 c
- 1291 914 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1315 982 m 5 Y -24 -6 d -5 Y f
- black 1291 914 m 24 6 d 67 Y -24 -6 d cl s 0 0 0.8 c 1271 929 m 20 -15 d 62 Y
- -20 15 d f 0 0.2 0.8 c 1291 976 m 5 Y -20 15 d -5 Y f black 1271 929 m 20 -15 d
- 67 Y -20 15 d cl s 0 0.2 0.8 c 1291 981 m 24 6 d -20 15 d -24 -6 d f black 1291
- 981 m 24 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1268 908 m 23 6 d 53 Y -23 -6 d f
- black 1268 908 m 23 6 d 53 Y -23 -6 d cl s 0 0 0.8 c 1248 923 m 20 -15 d 53 Y
- -20 16 d f black 1248 923 m 20 -15 d 53 Y -20 16 d cl s 0 0 0.8 c 1268 961 m 23
- 6 d -20 16 d -23 -6 d f black 1268 961 m 23 6 d -20 16 d -23 -6 d cl s 0 0 0.8
- c 1244 902 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8 c 1268 970 m 32 Y -24 -6 d -32 Y
- f black 1244 902 m 24 6 d 94 Y -24 -6 d cl s 0 0 0.8 c 1224 917 m 20 -15 d 62 Y
- -20 15 d f 0 0.2 0.8 c 1244 964 m 32 Y -20 15 d -32 Y f black 1224 917 m 20 -15
- d 94 Y -20 15 d cl s 0 0.2 0.8 c 1244 996 m 24 6 d -20 15 d -24 -6 d f black
- 1244 996 m 24 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1221 896 m 23 6 d 53 Y -23
- -6 d f black 1221 896 m 23 6 d 53 Y -23 -6 d cl s 0 0 0.8 c 1201 911 m 20 -15 d
- 53 Y -20 16 d f black 1201 911 m 20 -15 d 53 Y -20 16 d cl s 0 0 0.8 c 1221 949
- m 23 6 d -20 16 d -23 -6 d f black 1221 949 m 23 6 d -20 16 d -23 -6 d cl s 0 0
- 0.8 c 1197 890 m 24 6 d 13 Y -24 -6 d f black 1197 890 m 24 6 d 13 Y -24 -6 d
- cl s 0 0 0.8 c 1177 905 m 20 -15 d 13 Y -20 16 d f black 1177 905 m 20 -15 d 13
- Y -20 16 d cl s 0 0 0.8 c 1197 903 m 24 6 d -20 16 d -24 -6 d f black 1197 903
- m 24 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1174 884 m 23 6 d 13 Y -23 -6 d f
- black 1174 884 m 23 6 d 13 Y -23 -6 d cl s 0 0 0.8 c 1154 899 m 20 -15 d 13 Y
- -20 16 d f black 1154 899 m 20 -15 d 13 Y -20 16 d cl s 0 0 0.8 c 1174 897 m 23
- 6 d -20 16 d -23 -6 d f black 1174 897 m 23 6 d -20 16 d -23 -6 d cl s 0 0 0.8
- c 1151 878 m 23 6 d 40 Y -23 -6 d f black 1151 878 m 23 6 d 40 Y -23 -6 d cl s
- 0 0 0.8 c 1130 893 m 21 -15 d 40 Y -21 15 d f black 1130 893 m 21 -15 d 40 Y
- -21 15 d cl s 0 0 0.8 c 1151 918 m 23 6 d -20 15 d -24 -6 d f black 1151 918 m
- 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1127 872 m 24 6 d 40 Y -24 -6 d f black
- 1127 872 m 24 6 d 40 Y -24 -6 d cl s 0 0 0.8 c 1107 887 m 20 -15 d 40 Y -20 16
- d f black 1107 887 m 20 -15 d 40 Y -20 16 d cl s 0 0 0.8 c 1127 912 m 24 6 d
- -21 15 d -23 -5 d f black 1127 912 m 24 6 d -21 15 d -23 -5 d cl s 0 0 0.8 c
- 1104 866 m 23 6 d 53 Y -23 -6 d f black 1104 866 m 23 6 d 53 Y -23 -6 d cl s 0
- 0 0.8 c 1083 881 m 21 -15 d 53 Y -21 16 d f black 1083 881 m 21 -15 d 53 Y -21
- 16 d cl s 0 0 0.8 c 1104 919 m 23 6 d -20 16 d -24 -6 d f black 1104 919 m 23 6
- d -20 16 d -24 -6 d cl s 0 0 0.8 c 1080 860 m 24 6 d 62 Y -24 -6 d f 0 0.2 0.8
- c 1104 928 m 5 Y -24 -6 d -5 Y f black 1080 860 m 24 6 d 67 Y -24 -6 d cl s 0 0
- 0.8 c 1060 875 m 20 -15 d 62 Y -20 15 d f 0 0.2 0.8 c 1080 922 m 5 Y -20 15 d
- -5 Y f black 1060 875 m 20 -15 d 67 Y -20 15 d cl s 0 0.2 0.8 c 1080 927 m 24 6
- d -21 15 d -23 -6 d f black 1080 927 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c
- 1057 854 m 23 6 d 40 Y -23 -6 d f black 1057 854 m 23 6 d 40 Y -23 -6 d cl s 0
- 0 0.8 c 1036 869 m 21 -15 d 40 Y -21 16 d f black 1036 869 m 21 -15 d 40 Y -21
- 16 d cl s 0 0 0.8 c 1057 894 m 23 6 d -20 16 d -24 -6 d f black 1057 894 m 23 6
- d -20 16 d -24 -6 d cl s 0 0 0.8 c 1033 848 m 24 6 d 53 Y -24 -5 d f black 1033
- 848 m 24 6 d 53 Y -24 -5 d cl s 0 0 0.8 c 1013 863 m 20 -15 d 54 Y -20 15 d f
- black 1013 863 m 20 -15 d 54 Y -20 15 d cl s 0 0 0.8 c 1033 902 m 24 5 d -21 16
- d -23 -6 d f black 1033 902 m 24 5 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1010 842
- m 23 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 1033 910 m 5 Y -23 -6 d -5 Y f black 1010
- 842 m 23 6 d 67 Y -23 -6 d cl s 0 0 0.8 c 989 857 m 21 -15 d 62 Y -21 15 d f 0
- 0.2 0.8 c 1010 904 m 5 Y -21 15 d -5 Y f black 989 857 m 21 -15 d 67 Y -21 15 d
- cl s 0 0.2 0.8 c 1010 909 m 23 6 d -20 15 d -24 -6 d f black 1010 909 m 23 6 d
- -20 15 d -24 -6 d cl s 0 0 0.8 c 986 836 m 24 6 d 27 Y -24 -6 d f black 986 836
- m 24 6 d 27 Y -24 -6 d cl s 0 0 0.8 c 966 851 m 20 -15 d 27 Y -20 15 d f black
- 966 851 m 20 -15 d 27 Y -20 15 d cl s 0 0 0.8 c 986 863 m 24 6 d -21 15 d -23
- -6 d f black 986 863 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 963 830 m 23 6 d
- 13 Y -23 -6 d f black 963 830 m 23 6 d 13 Y -23 -6 d cl s 0 0 0.8 c 942 845 m
- 21 -15 d 13 Y -21 16 d f black 942 845 m 21 -15 d 13 Y -21 16 d cl s 0 0 0.8 c
- 963 843 m 23 6 d -20 16 d -24 -6 d f black 963 843 m 23 6 d -20 16 d -24 -6 d
- cl s 0 0 0.8 c 939 824 m 24 6 d 13 Y -24 -6 d f black 939 824 m 24 6 d 13 Y -24
- -6 d cl s 0 0 0.8 c 919 839 m 20 -15 d 13 Y -20 16 d f black 919 839 m 20 -15 d
- 13 Y -20 16 d cl s 0 0 0.8 c 939 837 m 24 6 d -21 16 d -23 -6 d f black 939 837
- m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 916 818 m 23 6 d 62 Y -23 -6 d f 0
- 0.2 0.8 c 939 886 m 5 Y -23 -6 d -5 Y f black 916 818 m 23 6 d 67 Y -23 -6 d
- cl s 0 0 0.8 c 895 833 m 21 -15 d 62 Y -21 16 d f 0 0.2 0.8 c 916 880 m 5 Y -21
- 16 d -5 Y f black 895 833 m 21 -15 d 67 Y -21 16 d cl s 0 0.2 0.8 c 916 885 m
- 23 6 d -20 16 d -24 -6 d f black 916 885 m 23 6 d -20 16 d -24 -6 d cl s 0 0
- 0.8 c 892 812 m 24 6 d 54 Y -24 -6 d f black 892 812 m 24 6 d 54 Y -24 -6 d
- cl s 0 0 0.8 c 872 827 m 20 -15 d 54 Y -20 15 d f black 872 827 m 20 -15 d 54 Y
- -20 15 d cl s 0 0 0.8 c 892 866 m 24 6 d -21 15 d -23 -6 d f black 892 866 m 24
- 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 869 806 m 23 6 d 40 Y -23 -6 d f black 869
- 806 m 23 6 d 40 Y -23 -6 d cl s 0 0 0.8 c 848 821 m 21 -15 d 40 Y -21 16 d f
- black 848 821 m 21 -15 d 40 Y -21 16 d cl s 0 0 0.8 c 869 846 m 23 6 d -20 16 d
- -24 -6 d f black 869 846 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 845 800 m 24
- 6 d 40 Y -24 -6 d f black 845 800 m 24 6 d 40 Y -24 -6 d cl s 0 0 0.8 c 825 815
- m 20 -15 d 40 Y -20 16 d f black 825 815 m 20 -15 d 40 Y -20 16 d cl s 0 0 0.8
- c 845 840 m 24 6 d -21 16 d -23 -6 d f black 845 840 m 24 6 d -21 16 d -23 -6 d
- cl s 0 0 0.8 c 822 794 m 23 6 d -20 15 d -24 -6 d f black 822 794 m 23 6 d -20
- 15 d -24 -6 d cl s 0 0 0.8 c 798 788 m 24 6 d -21 15 d -23 -6 d f black 798 788
- m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 775 782 m 23 6 d -20 15 d -24 -5 d f
- black 775 782 m 23 6 d -20 15 d -24 -5 d cl s 0 0 0.8 c 751 776 m 24 6 d -21 16
- d -23 -6 d f black 751 776 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1876 1042
- m 23 5 d -20 16 d -24 -6 d f black 1876 1042 m 23 5 d -20 16 d -24 -6 d cl s 0
- 0 0.8 c 1852 1036 m 24 6 d -21 15 d -23 -6 d f black 1852 1036 m 24 6 d -21 15
- d -23 -6 d cl s 0 0 0.8 c 1829 1030 m 23 6 d -20 15 d -24 -6 d f black 1829
- 1030 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1805 1024 m 24 6 d -21 15 d -23
- -6 d f black 1805 1024 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 1782 1018 m 23
- 6 d 62 Y -23 -6 d f 0 0.2 0.8 c 1805 1086 m 18 Y -23 -6 d -18 Y f black 1782
- 1018 m 23 6 d 80 Y -23 -6 d cl s 0 0 0.8 c 1761 1033 m 21 -15 d 62 Y -21 15 d f
- 0 0.2 0.8 c 1782 1080 m 18 Y -21 16 d -19 Y f black 1761 1033 m 21 -15 d 80 Y
- -21 16 d cl s 0 0.2 0.8 c 1782 1098 m 23 6 d -20 16 d -24 -6 d f black 1782
- 1098 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1758 1012 m 24 6 d -21 15 d -23
- -6 d f black 1758 1012 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 1735 1006 m 23
- 6 d -20 15 d -24 -6 d f black 1735 1006 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8
- c 1711 1000 m 24 6 d 40 Y -24 -6 d f black 1711 1000 m 24 6 d 40 Y -24 -6 d
- cl s 0 0 0.8 c 1691 1015 m 20 -15 d 40 Y -20 15 d f black 1691 1015 m 20 -15 d
- 40 Y -20 15 d cl s 0 0 0.8 c 1711 1040 m 24 6 d -21 15 d -23 -6 d f black 1711
- 1040 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 1688 994 m 23 6 d 13 Y -23 -6 d
- f black 1688 994 m 23 6 d 13 Y -23 -6 d cl s 0 0 0.8 c 1667 1009 m 21 -15 d 13
- Y -21 16 d f black 1667 1009 m 21 -15 d 13 Y -21 16 d cl s 0 0 0.8 c 1688 1007
- m 23 6 d -20 16 d -24 -6 d f black 1688 1007 m 23 6 d -20 16 d -24 -6 d cl s 0
- 0 0.8 c 1664 988 m 24 6 d -21 15 d -23 -6 d f black 1664 988 m 24 6 d -21 15 d
- -23 -6 d cl s 0 0 0.8 c 1641 982 m 23 6 d 40 Y -23 -6 d f black 1641 982 m 23 6
- d 40 Y -23 -6 d cl s 0 0 0.8 c 1620 997 m 21 -15 d 40 Y -21 16 d f black 1620
- 997 m 21 -15 d 40 Y -21 16 d cl s 0 0 0.8 c 1641 1022 m 23 6 d -20 16 d -24 -6
- d f black 1641 1022 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1617 976 m 24 6 d
- 27 Y -24 -6 d f black 1617 976 m 24 6 d 27 Y -24 -6 d cl s 0 0 0.8 c 1597 991 m
- 20 -15 d 27 Y -20 15 d f black 1597 991 m 20 -15 d 27 Y -20 15 d cl s 0 0 0.8 c
- 1617 1003 m 24 6 d -21 15 d -23 -6 d f black 1617 1003 m 24 6 d -21 15 d -23 -6
- d cl s 0 0 0.8 c 1594 970 m 23 6 d 13 Y -23 -6 d f black 1594 970 m 23 6 d 13 Y
- -23 -6 d cl s 0 0 0.8 c 1573 985 m 21 -15 d 13 Y -21 16 d f black 1573 985 m 21
- -15 d 13 Y -21 16 d cl s 0 0 0.8 c 1594 983 m 23 6 d -20 16 d -24 -6 d f black
- 1594 983 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1570 964 m 24 6 d 27 Y -24
- -6 d f black 1570 964 m 24 6 d 27 Y -24 -6 d cl s 0 0 0.8 c 1550 979 m 20 -15 d
- 27 Y -20 15 d f black 1550 979 m 20 -15 d 27 Y -20 15 d cl s 0 0 0.8 c 1570 991
- m 24 6 d -21 15 d -23 -6 d f black 1570 991 m 24 6 d -21 15 d -23 -6 d cl s 0 0
- 0.8 c 1547 958 m 23 6 d 27 Y -23 -6 d f black 1547 958 m 23 6 d 27 Y -23 -6 d
- cl s 0 0 0.8 c 1526 973 m 21 -15 d 27 Y -21 15 d f black 1526 973 m 21 -15 d 27
- Y -21 15 d cl s 0 0 0.8 c 1547 985 m 23 6 d -20 15 d -24 -6 d f black 1547 985
- m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1523 952 m 24 6 d -21 15 d -23 -6 d f
- black 1523 952 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 1500 946 m 23 6 d 13 Y
- -23 -6 d f black 1500 946 m 23 6 d 13 Y -23 -6 d cl s 0 0 0.8 c 1479 961 m 21
- -15 d 13 Y -21 16 d f black 1479 961 m 21 -15 d 13 Y -21 16 d cl s 0 0 0.8 c
- 1500 959 m 23 6 d -20 16 d -24 -6 d f black 1500 959 m 23 6 d -20 16 d -24 -6 d
- cl s 0 0 0.8 c 1476 940 m 24 6 d 27 Y -24 -6 d f black 1476 940 m 24 6 d 27 Y
- -24 -6 d cl s 0 0 0.8 c 1456 955 m 20 -15 d 27 Y -20 15 d f black 1456 955 m 20
- -15 d 27 Y -20 15 d cl s 0 0 0.8 c 1476 967 m 24 6 d -21 15 d -23 -6 d f black
- 1476 967 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 1453 934 m 23 6 d 13 Y -23
- -6 d f black 1453 934 m 23 6 d 13 Y -23 -6 d cl s 0 0 0.8 c 1432 949 m 21 -15 d
- 13 Y -21 16 d f black 1432 949 m 21 -15 d 13 Y -21 16 d cl s 0 0 0.8 c 1453 947
- m 23 6 d -20 16 d -24 -6 d f black 1453 947 m 23 6 d -20 16 d -24 -6 d cl s 0 0
- 0.8 c 1429 928 m 24 6 d 27 Y -24 -6 d f black 1429 928 m 24 6 d 27 Y -24 -6 d
- cl s 0 0 0.8 c 1409 943 m 20 -15 d 27 Y -20 15 d f black 1409 943 m 20 -15 d 27
- Y -20 15 d cl s 0 0 0.8 c 1429 955 m 24 6 d -21 15 d -23 -6 d f black 1429 955
- m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 1406 922 m 23 6 d -20 15 d -24 -6 d f
- black 1406 922 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1382 916 m 24 6 d 13 Y
- -24 -6 d f black 1382 916 m 24 6 d 13 Y -24 -6 d cl s 0 0 0.8 c 1362 931 m 20
- -15 d 13 Y -20 16 d f black 1362 931 m 20 -15 d 13 Y -20 16 d cl s 0 0 0.8 c
- 1382 929 m 24 6 d -21 16 d -23 -6 d f black 1382 929 m 24 6 d -21 16 d -23 -6 d
- cl s 0 0 0.8 c 1359 910 m 23 6 d 27 Y -23 -6 d f black 1359 910 m 23 6 d 27 Y
- -23 -6 d cl s 0 0 0.8 c 1338 925 m 21 -15 d 27 Y -21 15 d f black 1338 925 m 21
- -15 d 27 Y -21 15 d cl s 0 0 0.8 c 1359 937 m 23 6 d -20 15 d -24 -6 d f black
- 1359 937 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1335 904 m 24 6 d -21 15 d
- -23 -5 d f black 1335 904 m 24 6 d -21 15 d -23 -5 d cl s 0 0 0.8 c 1312 898 m
- 23 6 d 27 Y -23 -6 d f black 1312 898 m 23 6 d 27 Y -23 -6 d cl s 0 0 0.8 c
- 1291 914 m 21 -16 d 27 Y -21 15 d f black 1291 914 m 21 -16 d 27 Y -21 15 d
- cl s 0 0 0.8 c 1312 925 m 23 6 d -20 15 d -24 -6 d f black 1312 925 m 23 6 d
- -20 15 d -24 -6 d cl s 0 0 0.8 c 1288 892 m 24 6 d 13 Y -24 -6 d f black 1288
- 892 m 24 6 d 13 Y -24 -6 d cl s 0 0 0.8 c 1268 908 m 20 -16 d 13 Y -20 16 d f
- black 1268 908 m 20 -16 d 13 Y -20 16 d cl s 0 0 0.8 c 1288 905 m 24 6 d -21 16
- d -23 -6 d f black 1288 905 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1265 886
- m 23 6 d 13 Y -23 -6 d f black 1265 886 m 23 6 d 13 Y -23 -6 d cl s 0 0 0.8 c
- 1244 902 m 21 -16 d 13 Y -21 16 d f black 1244 902 m 21 -16 d 13 Y -21 16 d
- cl s 0 0 0.8 c 1265 899 m 23 6 d -20 16 d -24 -6 d f black 1265 899 m 23 6 d
- -20 16 d -24 -6 d cl s 0 0 0.8 c 1241 880 m 24 6 d 40 Y -24 -6 d f black 1241
- 880 m 24 6 d 40 Y -24 -6 d cl s 0 0 0.8 c 1221 896 m 20 -16 d 40 Y -20 16 d f
- black 1221 896 m 20 -16 d 40 Y -20 16 d cl s 0 0 0.8 c 1241 920 m 24 6 d -21 16
- d -23 -6 d f black 1241 920 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1218 874
- m 23 6 d 13 Y -23 -5 d f black 1218 874 m 23 6 d 13 Y -23 -5 d cl s 0 0 0.8 c
- 1197 890 m 21 -16 d 14 Y -21 15 d f black 1197 890 m 21 -16 d 14 Y -21 15 d
- cl s 0 0 0.8 c 1218 888 m 23 5 d -20 16 d -24 -6 d f black 1218 888 m 23 5 d
- -20 16 d -24 -6 d cl s 0 0 0.8 c 1194 868 m 24 6 d 27 Y -24 -6 d f black 1194
- 868 m 24 6 d 27 Y -24 -6 d cl s 0 0 0.8 c 1174 884 m 20 -16 d 27 Y -20 16 d f
- black 1174 884 m 20 -16 d 27 Y -20 16 d cl s 0 0 0.8 c 1194 895 m 24 6 d -21 15
- d -23 -5 d f black 1194 895 m 24 6 d -21 15 d -23 -5 d cl s 0 0 0.8 c 1171 862
- m 23 6 d 27 Y -23 -6 d f black 1171 862 m 23 6 d 27 Y -23 -6 d cl s 0 0 0.8 c
- 1151 878 m 20 -16 d 27 Y -20 16 d f black 1151 878 m 20 -16 d 27 Y -20 16 d
- cl s 0 0 0.8 c 1171 889 m 23 6 d -20 16 d -23 -6 d f black 1171 889 m 23 6 d
- -20 16 d -23 -6 d cl s 0 0 0.8 c 1147 856 m 24 6 d 14 Y -24 -6 d f black 1147
- 856 m 24 6 d 14 Y -24 -6 d cl s 0 0 0.8 c 1127 872 m 20 -16 d 14 Y -20 15 d f
- black 1127 872 m 20 -16 d 14 Y -20 15 d cl s 0 0 0.8 c 1147 870 m 24 6 d -20 15
- d -24 -6 d f black 1147 870 m 24 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1124 850
- m 23 6 d 27 Y -23 -6 d f black 1124 850 m 23 6 d 27 Y -23 -6 d cl s 0 0 0.8 c
- 1104 866 m 20 -16 d 27 Y -20 16 d f black 1104 866 m 20 -16 d 27 Y -20 16 d
- cl s 0 0 0.8 c 1124 877 m 23 6 d -20 16 d -23 -6 d f black 1124 877 m 23 6 d
- -20 16 d -23 -6 d cl s 0 0 0.8 c 1100 844 m 24 6 d 27 Y -24 -6 d f black 1100
- 844 m 24 6 d 27 Y -24 -6 d cl s 0 0 0.8 c 1080 860 m 20 -16 d 27 Y -20 16 d f
- black 1080 860 m 20 -16 d 27 Y -20 16 d cl s 0 0 0.8 c 1100 871 m 24 6 d -20 16
- d -24 -6 d f black 1100 871 m 24 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1077 838
- m 23 6 d 27 Y -23 -6 d f black 1077 838 m 23 6 d 27 Y -23 -6 d cl s 0 0 0.8 c
- 1057 854 m 20 -16 d 27 Y -20 16 d f black 1057 854 m 20 -16 d 27 Y -20 16 d
- cl s 0 0 0.8 c 1077 865 m 23 6 d -20 16 d -23 -6 d f black 1077 865 m 23 6 d
- -20 16 d -23 -6 d cl s 0 0 0.8 c 1053 832 m 24 6 d 27 Y -24 -6 d f black 1053
- 832 m 24 6 d 27 Y -24 -6 d cl s 0 0 0.8 c 1033 848 m 20 -16 d 27 Y -20 16 d f
- black 1033 848 m 20 -16 d 27 Y -20 16 d cl s 0 0 0.8 c 1053 859 m 24 6 d -20 16
- d -24 -6 d f black 1053 859 m 24 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1030 826
- m 23 6 d 27 Y -23 -6 d f black 1030 826 m 23 6 d 27 Y -23 -6 d cl s 0 0 0.8 c
- 1010 842 m 20 -16 d 27 Y -20 16 d f black 1010 842 m 20 -16 d 27 Y -20 16 d
- cl s 0 0 0.8 c 1030 853 m 23 6 d -20 16 d -23 -6 d f black 1030 853 m 23 6 d
- -20 16 d -23 -6 d cl s 0 0 0.8 c 1006 820 m 24 6 d 41 Y -24 -6 d f black 1006
- 820 m 24 6 d 41 Y -24 -6 d cl s 0 0 0.8 c 986 836 m 20 -16 d 41 Y -20 15 d f
- black 986 836 m 20 -16 d 41 Y -20 15 d cl s 0 0 0.8 c 1006 861 m 24 6 d -20 15
- d -24 -6 d f black 1006 861 m 24 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 983 814 m
- 23 6 d 27 Y -23 -6 d f black 983 814 m 23 6 d 27 Y -23 -6 d cl s 0 0 0.8 c 963
- 830 m 20 -16 d 27 Y -20 16 d f black 963 830 m 20 -16 d 27 Y -20 16 d cl s 0 0
- 0.8 c 983 841 m 23 6 d -20 16 d -23 -6 d f black 983 841 m 23 6 d -20 16 d -23
- -6 d cl s 0 0 0.8 c 959 808 m 24 6 d 41 Y -24 -6 d f black 959 808 m 24 6 d 41
- Y -24 -6 d cl s 0 0 0.8 c 939 824 m 20 -16 d 41 Y -20 15 d f black 939 824 m 20
- -16 d 41 Y -20 15 d cl s 0 0 0.8 c 959 849 m 24 6 d -20 15 d -24 -6 d f black
- 959 849 m 24 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 936 802 m 23 6 d 14 Y -23 -6
- d f black 936 802 m 23 6 d 14 Y -23 -6 d cl s 0 0 0.8 c 916 818 m 20 -16 d 14 Y
- -20 15 d f black 916 818 m 20 -16 d 14 Y -20 15 d cl s 0 0 0.8 c 936 816 m 23 6
- d -20 15 d -23 -6 d f black 936 816 m 23 6 d -20 15 d -23 -6 d cl s 0 0 0.8 c
- 912 796 m 24 6 d 14 Y -24 -6 d f black 912 796 m 24 6 d 14 Y -24 -6 d cl s 0 0
- 0.8 c 892 812 m 20 -16 d 14 Y -20 15 d f black 892 812 m 20 -16 d 14 Y -20 15 d
- cl s 0 0 0.8 c 912 810 m 24 6 d -20 15 d -24 -6 d f black 912 810 m 24 6 d -20
- 15 d -24 -6 d cl s 0 0 0.8 c 889 790 m 23 6 d 41 Y -23 -6 d f black 889 790 m
- 23 6 d 41 Y -23 -6 d cl s 0 0 0.8 c 869 806 m 20 -16 d 41 Y -20 15 d f black
- 869 806 m 20 -16 d 41 Y -20 15 d cl s 0 0 0.8 c 889 831 m 23 6 d -20 15 d -23
- -6 d f black 889 831 m 23 6 d -20 15 d -23 -6 d cl s 0 0 0.8 c 865 784 m 24 6 d
- 27 Y -24 -6 d f black 865 784 m 24 6 d 27 Y -24 -6 d cl s 0 0 0.8 c 845 800 m
- 20 -16 d 27 Y -20 16 d f black 845 800 m 20 -16 d 27 Y -20 16 d cl s 0 0 0.8 c
- 865 811 m 24 6 d -20 16 d -24 -6 d f black 865 811 m 24 6 d -20 16 d -24 -6 d
- cl s 0 0 0.8 c 842 778 m 23 6 d -20 16 d -23 -6 d f black 842 778 m 23 6 d -20
- 16 d -23 -6 d cl s 0 0 0.8 c 819 772 m 23 6 d -20 16 d -24 -6 d f black 819 772
- m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 795 766 m 24 6 d -21 16 d -23 -6 d f
- black 795 766 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 772 760 m 23 6 d -20 16
- d -24 -6 d f black 772 760 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1896 1026
- m 23 6 d -20 15 d -23 -5 d f black 1896 1026 m 23 6 d -20 15 d -23 -5 d cl s 0
- 0 0.8 c 1872 1020 m 24 6 d -20 16 d -24 -6 d f black 1872 1020 m 24 6 d -20 16
- d -24 -6 d cl s 0 0 0.8 c 1849 1014 m 23 6 d -20 16 d -23 -6 d f black 1849
- 1014 m 23 6 d -20 16 d -23 -6 d cl s 0 0 0.8 c 1825 1008 m 24 6 d -20 16 d -24
- -6 d f black 1825 1008 m 24 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1802 1002 m 23
- 6 d 13 Y -23 -6 d f black 1802 1002 m 23 6 d 13 Y -23 -6 d cl s 0 0 0.8 c 1782
- 1018 m 20 -16 d 13 Y -20 16 d f black 1782 1018 m 20 -16 d 13 Y -20 16 d cl s 0
- 0 0.8 c 1802 1015 m 23 6 d -20 16 d -23 -6 d f black 1802 1015 m 23 6 d -20 16
- d -23 -6 d cl s 0 0 0.8 c 1778 996 m 24 6 d 13 Y -24 -5 d f black 1778 996 m 24
- 6 d 13 Y -24 -5 d cl s 0 0 0.8 c 1758 1012 m 20 -16 d 14 Y -20 15 d f black
- 1758 1012 m 20 -16 d 14 Y -20 15 d cl s 0 0 0.8 c 1778 1010 m 24 5 d -20 16 d
- -24 -6 d f black 1778 1010 m 24 5 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1755 990 m
- 23 6 d -20 16 d -23 -6 d f black 1755 990 m 23 6 d -20 16 d -23 -6 d cl s 0 0
- 0.8 c 1731 984 m 24 6 d 14 Y -24 -6 d f black 1731 984 m 24 6 d 14 Y -24 -6 d
- cl s 0 0 0.8 c 1711 1000 m 20 -16 d 14 Y -20 15 d f black 1711 1000 m 20 -16 d
- 14 Y -20 15 d cl s 0 0 0.8 c 1731 998 m 24 6 d -20 15 d -24 -6 d f black 1731
- 998 m 24 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1708 978 m 23 6 d -20 16 d -23 -6
- d f black 1708 978 m 23 6 d -20 16 d -23 -6 d cl s 0 0 0.8 c 1684 972 m 24 6 d
- -20 16 d -24 -6 d f black 1684 972 m 24 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c
- 1661 966 m 23 6 d -20 16 d -23 -6 d f black 1661 966 m 23 6 d -20 16 d -23 -6 d
- cl s 0 0 0.8 c 1637 960 m 24 6 d -20 16 d -24 -6 d f black 1637 960 m 24 6 d
- -20 16 d -24 -6 d cl s 0 0 0.8 c 1614 954 m 23 6 d 14 Y -23 -6 d f black 1614
- 954 m 23 6 d 14 Y -23 -6 d cl s 0 0 0.8 c 1594 970 m 20 -16 d 14 Y -20 15 d f
- black 1594 970 m 20 -16 d 14 Y -20 15 d cl s 0 0 0.8 c 1614 968 m 23 6 d -20 15
- d -23 -6 d f black 1614 968 m 23 6 d -20 15 d -23 -6 d cl s 0 0 0.8 c 1591 948
- m 23 6 d 14 Y -23 -6 d f black 1591 948 m 23 6 d 14 Y -23 -6 d cl s 0 0 0.8 c
- 1570 964 m 21 -16 d 14 Y -21 15 d f black 1570 964 m 21 -16 d 14 Y -21 15 d
- cl s 0 0 0.8 c 1591 962 m 23 6 d -20 15 d -24 -6 d f black 1591 962 m 23 6 d
- -20 15 d -24 -6 d cl s 0 0 0.8 c 1567 942 m 24 6 d -21 16 d -23 -6 d f black
- 1567 942 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1544 936 m 23 6 d -20 16 d
- -24 -6 d f black 1544 936 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1520 930 m
- 24 6 d -21 16 d -23 -6 d f black 1520 930 m 24 6 d -21 16 d -23 -6 d cl s 0 0
- 0.8 c 1497 924 m 23 6 d -20 16 d -24 -6 d f black 1497 924 m 23 6 d -20 16 d
- -24 -6 d cl s 0 0 0.8 c 1473 918 m 24 6 d 14 Y -24 -6 d f black 1473 918 m 24 6
- d 14 Y -24 -6 d cl s 0 0 0.8 c 1453 934 m 20 -16 d 14 Y -20 15 d f black 1453
- 934 m 20 -16 d 14 Y -20 15 d cl s 0 0 0.8 c 1473 932 m 24 6 d -21 15 d -23 -6 d
- f black 1473 932 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 1450 912 m 23 6 d 14
- Y -23 -6 d f black 1450 912 m 23 6 d 14 Y -23 -6 d cl s 0 0 0.8 c 1429 928 m 21
- -16 d 14 Y -21 15 d f black 1429 928 m 21 -16 d 14 Y -21 15 d cl s 0 0 0.8 c
- 1450 926 m 23 6 d -20 15 d -24 -6 d f black 1450 926 m 23 6 d -20 15 d -24 -6 d
- cl s 0 0 0.8 c 1426 906 m 24 6 d -21 16 d -23 -6 d f black 1426 906 m 24 6 d
- -21 16 d -23 -6 d cl s 0 0 0.8 c 1403 900 m 23 6 d 14 Y -23 -6 d f black 1403
- 900 m 23 6 d 14 Y -23 -6 d cl s 0 0 0.8 c 1382 916 m 21 -16 d 14 Y -21 15 d f
- black 1382 916 m 21 -16 d 14 Y -21 15 d cl s 0 0 0.8 c 1403 914 m 23 6 d -20 15
- d -24 -6 d f black 1403 914 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1379 894
- m 24 6 d 41 Y -24 -6 d f black 1379 894 m 24 6 d 41 Y -24 -6 d cl s 0 0 0.8 c
- 1359 910 m 20 -16 d 41 Y -20 15 d f black 1359 910 m 20 -16 d 41 Y -20 15 d
- cl s 0 0 0.8 c 1379 935 m 24 6 d -21 15 d -23 -6 d f black 1379 935 m 24 6 d
- -21 15 d -23 -6 d cl s 0 0 0.8 c 1356 888 m 23 6 d 27 Y -23 -6 d f black 1356
- 888 m 23 6 d 27 Y -23 -6 d cl s 0 0 0.8 c 1335 904 m 21 -16 d 27 Y -21 16 d f
- black 1335 904 m 21 -16 d 27 Y -21 16 d cl s 0 0 0.8 c 1356 915 m 23 6 d -20 16
- d -24 -6 d f black 1356 915 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1332 882
- m 24 6 d 27 Y -24 -6 d f black 1332 882 m 24 6 d 27 Y -24 -6 d cl s 0 0 0.8 c
- 1312 898 m 20 -16 d 27 Y -20 16 d f black 1312 898 m 20 -16 d 27 Y -20 16 d
- cl s 0 0 0.8 c 1332 909 m 24 6 d -21 16 d -23 -6 d f black 1332 909 m 24 6 d
- -21 16 d -23 -6 d cl s 0 0 0.8 c 1309 876 m 23 6 d 41 Y -23 -6 d f black 1309
- 876 m 23 6 d 41 Y -23 -6 d cl s 0 0 0.8 c 1288 892 m 21 -16 d 41 Y -21 15 d f
- black 1288 892 m 21 -16 d 41 Y -21 15 d cl s 0 0 0.8 c 1309 917 m 23 6 d -20 15
- d -24 -6 d f black 1309 917 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1285 871
- m 24 5 d -21 16 d -23 -6 d f black 1285 871 m 24 5 d -21 16 d -23 -6 d cl s 0 0
- 0.8 c 1262 865 m 23 6 d 13 Y -23 -6 d f black 1262 865 m 23 6 d 13 Y -23 -6 d
- cl s 0 0 0.8 c 1241 880 m 21 -15 d 13 Y -21 15 d f black 1241 880 m 21 -15 d 13
- Y -21 15 d cl s 0 0 0.8 c 1262 878 m 23 6 d -20 15 d -24 -6 d f black 1262 878
- m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1238 859 m 24 6 d 13 Y -24 -6 d f
- black 1238 859 m 24 6 d 13 Y -24 -6 d cl s 0 0 0.8 c 1218 874 m 20 -15 d 13 Y
- -20 16 d f black 1218 874 m 20 -15 d 13 Y -20 16 d cl s 0 0 0.8 c 1238 872 m 24
- 6 d -21 15 d -23 -5 d f black 1238 872 m 24 6 d -21 15 d -23 -5 d cl s 0 0 0.8
- c 1215 853 m 23 6 d 13 Y -23 -6 d f black 1215 853 m 23 6 d 13 Y -23 -6 d cl s
- 0 0 0.8 c 1194 868 m 21 -15 d 13 Y -21 16 d f black 1194 868 m 21 -15 d 13 Y
- -21 16 d cl s 0 0 0.8 c 1215 866 m 23 6 d -20 16 d -24 -6 d f black 1215 866 m
- 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1191 847 m 24 6 d -21 15 d -23 -6 d f
- black 1191 847 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 1168 841 m 23 6 d -20
- 15 d -24 -6 d f black 1168 841 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1144
- 835 m 24 6 d 13 Y -24 -6 d f black 1144 835 m 24 6 d 13 Y -24 -6 d cl s 0 0 0.8
- c 1124 850 m 20 -15 d 13 Y -20 16 d f black 1124 850 m 20 -15 d 13 Y -20 16 d
- cl s 0 0 0.8 c 1144 848 m 24 6 d -21 16 d -23 -6 d f black 1144 848 m 24 6 d
- -21 16 d -23 -6 d cl s 0 0 0.8 c 1121 829 m 23 6 d 13 Y -23 -6 d f black 1121
- 829 m 23 6 d 13 Y -23 -6 d cl s 0 0 0.8 c 1100 844 m 21 -15 d 13 Y -21 16 d f
- black 1100 844 m 21 -15 d 13 Y -21 16 d cl s 0 0 0.8 c 1121 842 m 23 6 d -20 16
- d -24 -6 d f black 1121 842 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1097 823
- m 24 6 d -21 15 d -23 -6 d f black 1097 823 m 24 6 d -21 15 d -23 -6 d cl s 0 0
- 0.8 c 1074 817 m 23 6 d -20 15 d -24 -6 d f black 1074 817 m 23 6 d -20 15 d
- -24 -6 d cl s 0 0 0.8 c 1050 811 m 24 6 d 40 Y -24 -6 d f black 1050 811 m 24 6
- d 40 Y -24 -6 d cl s 0 0 0.8 c 1030 826 m 20 -15 d 40 Y -20 16 d f black 1030
- 826 m 20 -15 d 40 Y -20 16 d cl s 0 0 0.8 c 1050 851 m 24 6 d -21 16 d -23 -6 d
- f black 1050 851 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1027 805 m 23 6 d
- -20 15 d -24 -6 d f black 1027 805 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c
- 1003 799 m 24 6 d -21 15 d -23 -6 d f black 1003 799 m 24 6 d -21 15 d -23 -6 d
- cl s 0 0 0.8 c 980 793 m 23 6 d -20 15 d -24 -6 d f black 980 793 m 23 6 d -20
- 15 d -24 -6 d cl s 0 0 0.8 c 956 787 m 24 6 d -21 15 d -23 -6 d f black 956 787
- m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 933 781 m 23 6 d -20 15 d -24 -6 d f
- black 933 781 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 909 775 m 24 6 d -21 15
- d -23 -6 d f black 909 775 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 886 769 m
- 23 6 d -20 15 d -24 -6 d f black 886 769 m 23 6 d -20 15 d -24 -6 d cl s 0 0
- 0.8 c 862 763 m 24 6 d -21 15 d -23 -6 d f black 862 763 m 24 6 d -21 15 d -23
- -6 d cl s 0 0 0.8 c 839 757 m 23 6 d -20 15 d -23 -6 d f black 839 757 m 23 6 d
- -20 15 d -23 -6 d cl s 0 0 0.8 c 815 751 m 24 6 d -20 15 d -24 -6 d f black 815
- 751 m 24 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 792 745 m 23 6 d -20 15 d -23 -6
- d f black 792 745 m 23 6 d -20 15 d -23 -6 d cl s 0 0 0.8 c 1916 1010 m 24 6 d
- -21 16 d -23 -6 d f black 1916 1010 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c
- 1893 1004 m 23 6 d -20 16 d -24 -6 d f black 1893 1004 m 23 6 d -20 16 d -24 -6
- d cl s 0 0 0.8 c 1869 998 m 24 6 d -21 16 d -23 -6 d f black 1869 998 m 24 6 d
- -21 16 d -23 -6 d cl s 0 0 0.8 c 1846 992 m 23 6 d -20 16 d -24 -6 d f black
- 1846 992 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1822 987 m 24 5 d -21 16 d
- -23 -6 d f black 1822 987 m 24 5 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1799 981 m
- 23 6 d -20 15 d -24 -6 d f black 1799 981 m 23 6 d -20 15 d -24 -6 d cl s 0 0
- 0.8 c 1775 975 m 24 6 d 13 Y -24 -6 d f black 1775 975 m 24 6 d 13 Y -24 -6 d
- cl s 0 0 0.8 c 1755 990 m 20 -15 d 13 Y -20 16 d f black 1755 990 m 20 -15 d 13
- Y -20 16 d cl s 0 0 0.8 c 1775 988 m 24 6 d -21 16 d -23 -6 d f black 1775 988
- m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1752 969 m 23 6 d 13 Y -23 -6 d f
- black 1752 969 m 23 6 d 13 Y -23 -6 d cl s 0 0 0.8 c 1731 984 m 21 -15 d 13 Y
- -21 16 d f black 1731 984 m 21 -15 d 13 Y -21 16 d cl s 0 0 0.8 c 1752 982 m 23
- 6 d -20 16 d -24 -6 d f black 1752 982 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8
- c 1728 963 m 24 6 d -21 15 d -23 -6 d f black 1728 963 m 24 6 d -21 15 d -23 -6
- d cl s 0 0 0.8 c 1705 957 m 23 6 d -20 15 d -24 -6 d f black 1705 957 m 23 6 d
- -20 15 d -24 -6 d cl s 0 0 0.8 c 1681 951 m 24 6 d 26 Y -24 -5 d f black 1681
- 951 m 24 6 d 26 Y -24 -5 d cl s 0 0 0.8 c 1661 966 m 20 -15 d 27 Y -20 15 d f
- black 1661 966 m 20 -15 d 27 Y -20 15 d cl s 0 0 0.8 c 1681 978 m 24 5 d -21 16
- d -23 -6 d f black 1681 978 m 24 5 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1658 945
- m 23 6 d -20 15 d -24 -6 d f black 1658 945 m 23 6 d -20 15 d -24 -6 d cl s 0 0
- 0.8 c 1634 939 m 24 6 d -21 15 d -23 -6 d f black 1634 939 m 24 6 d -21 15 d
- -23 -6 d cl s 0 0 0.8 c 1611 933 m 23 6 d -20 15 d -23 -6 d f black 1611 933 m
- 23 6 d -20 15 d -23 -6 d cl s 0 0 0.8 c 1587 927 m 24 6 d -20 15 d -24 -6 d f
- black 1587 927 m 24 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1564 921 m 23 6 d -20
- 15 d -23 -6 d f black 1564 921 m 23 6 d -20 15 d -23 -6 d cl s 0 0 0.8 c 1540
- 915 m 24 6 d -20 15 d -24 -6 d f black 1540 915 m 24 6 d -20 15 d -24 -6 d cl s
- 0 0 0.8 c 1517 909 m 23 6 d 13 Y -23 -6 d f black 1517 909 m 23 6 d 13 Y -23 -6
- d cl s 0 0 0.8 c 1497 924 m 20 -15 d 13 Y -20 16 d f black 1497 924 m 20 -15 d
- 13 Y -20 16 d cl s 0 0 0.8 c 1517 922 m 23 6 d -20 16 d -23 -6 d f black 1517
- 922 m 23 6 d -20 16 d -23 -6 d cl s 0 0 0.8 c 1493 903 m 24 6 d -20 15 d -24 -6
- d f black 1493 903 m 24 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1470 897 m 23 6 d
- 13 Y -23 -6 d f black 1470 897 m 23 6 d 13 Y -23 -6 d cl s 0 0 0.8 c 1450 912 m
- 20 -15 d 13 Y -20 16 d f black 1450 912 m 20 -15 d 13 Y -20 16 d cl s 0 0 0.8 c
- 1470 910 m 23 6 d -20 16 d -23 -6 d f black 1470 910 m 23 6 d -20 16 d -23 -6 d
- cl s 0 0 0.8 c 1446 891 m 24 6 d -20 15 d -24 -6 d f black 1446 891 m 24 6 d
- -20 15 d -24 -6 d cl s 0 0 0.8 c 1423 885 m 23 6 d 13 Y -23 -6 d f black 1423
- 885 m 23 6 d 13 Y -23 -6 d cl s 0 0 0.8 c 1403 900 m 20 -15 d 13 Y -20 16 d f
- black 1403 900 m 20 -15 d 13 Y -20 16 d cl s 0 0 0.8 c 1423 898 m 23 6 d -20 16
- d -23 -6 d f black 1423 898 m 23 6 d -20 16 d -23 -6 d cl s 0 0 0.8 c 1399 879
- m 24 6 d 27 Y -24 -6 d f black 1399 879 m 24 6 d 27 Y -24 -6 d cl s 0 0 0.8 c
- 1379 894 m 20 -15 d 27 Y -20 15 d f black 1379 894 m 20 -15 d 27 Y -20 15 d
- cl s 0 0 0.8 c 1399 906 m 24 6 d -20 15 d -24 -6 d f black 1399 906 m 24 6 d
- -20 15 d -24 -6 d cl s 0 0 0.8 c 1376 873 m 23 6 d -20 15 d -23 -6 d f black
- 1376 873 m 23 6 d -20 15 d -23 -6 d cl s 0 0 0.8 c 1352 867 m 24 6 d -20 15 d
- -24 -6 d f black 1352 867 m 24 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1329 861 m
- 23 6 d -20 15 d -23 -6 d f black 1329 861 m 23 6 d -20 15 d -23 -6 d cl s 0 0
- 0.8 c 1305 855 m 24 6 d -20 15 d -24 -5 d f black 1305 855 m 24 6 d -20 15 d
- -24 -5 d cl s 0 0 0.8 c 1282 849 m 23 6 d -20 16 d -23 -6 d f black 1282 849 m
- 23 6 d -20 16 d -23 -6 d cl s 0 0 0.8 c 1259 843 m 23 6 d -20 16 d -24 -6 d f
- black 1259 843 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1235 837 m 24 6 d 13 Y
- -24 -6 d f black 1235 837 m 24 6 d 13 Y -24 -6 d cl s 0 0 0.8 c 1215 853 m 20
- -16 d 13 Y -20 16 d f black 1215 853 m 20 -16 d 13 Y -20 16 d cl s 0 0 0.8 c
- 1235 850 m 24 6 d -21 16 d -23 -6 d f black 1235 850 m 24 6 d -21 16 d -23 -6 d
- cl s 0 0 0.8 c 1212 831 m 23 6 d -20 16 d -24 -6 d f black 1212 831 m 23 6 d
- -20 16 d -24 -6 d cl s 0 0 0.8 c 1188 825 m 24 6 d -21 16 d -23 -6 d f black
- 1188 825 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1165 819 m 23 6 d 14 Y -23
- -6 d f black 1165 819 m 23 6 d 14 Y -23 -6 d cl s 0 0 0.8 c 1144 835 m 21 -16 d
- 14 Y -21 15 d f black 1144 835 m 21 -16 d 14 Y -21 15 d cl s 0 0 0.8 c 1165 833
- m 23 6 d -20 15 d -24 -6 d f black 1165 833 m 23 6 d -20 15 d -24 -6 d cl s 0 0
- 0.8 c 1141 813 m 24 6 d -21 16 d -23 -6 d f black 1141 813 m 24 6 d -21 16 d
- -23 -6 d cl s 0 0 0.8 c 1118 807 m 23 6 d -20 16 d -24 -6 d f black 1118 807 m
- 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1094 801 m 24 6 d -21 16 d -23 -6 d f
- black 1094 801 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1071 795 m 23 6 d 14 Y
- -23 -6 d f black 1071 795 m 23 6 d 14 Y -23 -6 d cl s 0 0 0.8 c 1050 811 m 21
- -16 d 14 Y -21 15 d f black 1050 811 m 21 -16 d 14 Y -21 15 d cl s 0 0 0.8 c
- 1071 809 m 23 6 d -20 15 d -24 -6 d f black 1071 809 m 23 6 d -20 15 d -24 -6 d
- cl s 0 0 0.8 c 1047 789 m 24 6 d -21 16 d -23 -6 d f black 1047 789 m 24 6 d
- -21 16 d -23 -6 d cl s 0 0 0.8 c 1024 783 m 23 6 d 14 Y -23 -6 d f black 1024
- 783 m 23 6 d 14 Y -23 -6 d cl s 0 0 0.8 c 1003 799 m 21 -16 d 14 Y -21 15 d f
- black 1003 799 m 21 -16 d 14 Y -21 15 d cl s 0 0 0.8 c 1024 797 m 23 6 d -20 15
- d -24 -6 d f black 1024 797 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1000 777
- m 24 6 d -21 16 d -23 -6 d f black 1000 777 m 24 6 d -21 16 d -23 -6 d cl s 0 0
- 0.8 c 977 771 m 23 6 d -20 16 d -24 -6 d f black 977 771 m 23 6 d -20 16 d -24
- -6 d cl s 0 0 0.8 c 953 765 m 24 6 d -21 16 d -23 -6 d f black 953 765 m 24 6 d
- -21 16 d -23 -6 d cl s 0 0 0.8 c 930 759 m 23 6 d -20 16 d -24 -6 d f black 930
- 759 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 906 753 m 24 6 d -21 16 d -23 -6
- d f black 906 753 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 883 747 m 23 6 d
- -20 16 d -24 -6 d f black 883 747 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 859
- 741 m 24 6 d -21 16 d -23 -6 d f black 859 741 m 24 6 d -21 16 d -23 -6 d cl s
- 0 0 0.8 c 836 735 m 23 6 d -20 16 d -24 -6 d f black 836 735 m 23 6 d -20 16 d
- -24 -6 d cl s 0 0 0.8 c 812 729 m 24 6 d -21 16 d -23 -6 d f black 812 729 m 24
- 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1937 995 m 23 6 d -20 15 d -24 -6 d f
- black 1937 995 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1913 989 m 24 6 d -21
- 15 d -23 -6 d f black 1913 989 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 1890
- 983 m 23 6 d -20 15 d -24 -6 d f black 1890 983 m 23 6 d -20 15 d -24 -6 d cl s
- 0 0 0.8 c 1866 977 m 24 6 d -21 15 d -23 -6 d f black 1866 977 m 24 6 d -21 15
- d -23 -6 d cl s 0 0 0.8 c 1843 971 m 23 6 d -20 15 d -24 -5 d f black 1843 971
- m 23 6 d -20 15 d -24 -5 d cl s 0 0 0.8 c 1819 965 m 24 6 d -21 16 d -23 -6 d f
- black 1819 965 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1796 959 m 23 6 d -20
- 16 d -24 -6 d f black 1796 959 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1772
- 953 m 24 6 d -21 16 d -23 -6 d f black 1772 953 m 24 6 d -21 16 d -23 -6 d cl s
- 0 0 0.8 c 1749 947 m 23 6 d 13 Y -23 -5 d f black 1749 947 m 23 6 d 13 Y -23 -5
- d cl s 0 0 0.8 c 1728 963 m 21 -16 d 14 Y -21 15 d f black 1728 963 m 21 -16 d
- 14 Y -21 15 d cl s 0 0 0.8 c 1749 961 m 23 5 d -20 16 d -24 -6 d f black 1749
- 961 m 23 5 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1725 941 m 24 6 d -21 16 d -23 -6
- d f black 1725 941 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1702 935 m 23 6 d
- -20 16 d -24 -6 d f black 1702 935 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c
- 1678 929 m 24 6 d -21 16 d -23 -6 d f black 1678 929 m 24 6 d -21 16 d -23 -6 d
- cl s 0 0 0.8 c 1655 923 m 23 6 d -20 16 d -24 -6 d f black 1655 923 m 23 6 d
- -20 16 d -24 -6 d cl s 0 0 0.8 c 1631 917 m 24 6 d -21 16 d -23 -6 d f black
- 1631 917 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1608 911 m 23 6 d -20 16 d
- -24 -6 d f black 1608 911 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1584 905 m
- 24 6 d -21 16 d -23 -6 d f black 1584 905 m 24 6 d -21 16 d -23 -6 d cl s 0 0
- 0.8 c 1561 899 m 23 6 d -20 16 d -24 -6 d f black 1561 899 m 23 6 d -20 16 d
- -24 -6 d cl s 0 0 0.8 c 1537 893 m 24 6 d -21 16 d -23 -6 d f black 1537 893 m
- 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1514 887 m 23 6 d -20 16 d -24 -6 d f
- black 1514 887 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1490 881 m 24 6 d -21
- 16 d -23 -6 d f black 1490 881 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1467
- 875 m 23 6 d -20 16 d -24 -6 d f black 1467 875 m 23 6 d -20 16 d -24 -6 d cl s
- 0 0 0.8 c 1443 869 m 24 6 d -21 16 d -23 -6 d f black 1443 869 m 24 6 d -21 16
- d -23 -6 d cl s 0 0 0.8 c 1420 863 m 23 6 d -20 16 d -24 -6 d f black 1420 863
- m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1396 857 m 24 6 d -21 16 d -23 -6 d f
- black 1396 857 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1373 851 m 23 6 d -20
- 16 d -24 -6 d f black 1373 851 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1349
- 845 m 24 6 d 14 Y -24 -6 d f black 1349 845 m 24 6 d 14 Y -24 -6 d cl s 0 0 0.8
- c 1329 861 m 20 -16 d 14 Y -20 15 d f black 1329 861 m 20 -16 d 14 Y -20 15 d
- cl s 0 0 0.8 c 1349 859 m 24 6 d -21 15 d -23 -6 d f black 1349 859 m 24 6 d
- -21 15 d -23 -6 d cl s 0 0 0.8 c 1326 839 m 23 6 d -20 16 d -24 -6 d f black
- 1326 839 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1302 833 m 24 6 d -21 16 d
- -23 -6 d f black 1302 833 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1279 827 m
- 23 6 d -20 16 d -23 -6 d f black 1279 827 m 23 6 d -20 16 d -23 -6 d cl s 0 0
- 0.8 c 1255 821 m 24 6 d 14 Y -24 -6 d f black 1255 821 m 24 6 d 14 Y -24 -6 d
- cl s 0 0 0.8 c 1235 837 m 20 -16 d 14 Y -20 15 d f black 1235 837 m 20 -16 d 14
- Y -20 15 d cl s 0 0 0.8 c 1255 835 m 24 6 d -20 15 d -24 -6 d f black 1255 835
- m 24 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1232 816 m 23 5 d -20 16 d -23 -6 d f
- black 1232 816 m 23 5 d -20 16 d -23 -6 d cl s 0 0 0.8 c 1208 810 m 24 6 d -20
- 15 d -24 -6 d f black 1208 810 m 24 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1185
- 804 m 23 6 d -20 15 d -23 -6 d f black 1185 804 m 23 6 d -20 15 d -23 -6 d cl s
- 0 0 0.8 c 1161 798 m 24 6 d -20 15 d -24 -6 d f black 1161 798 m 24 6 d -20 15
- d -24 -6 d cl s 0 0 0.8 c 1138 792 m 23 6 d -20 15 d -23 -6 d f black 1138 792
- m 23 6 d -20 15 d -23 -6 d cl s 0 0 0.8 c 1114 786 m 24 6 d -20 15 d -24 -6 d f
- black 1114 786 m 24 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1091 780 m 23 6 d -20
- 15 d -23 -6 d f black 1091 780 m 23 6 d -20 15 d -23 -6 d cl s 0 0 0.8 c 1067
- 774 m 24 6 d -20 15 d -24 -6 d f black 1067 774 m 24 6 d -20 15 d -24 -6 d cl s
- 0 0 0.8 c 1044 768 m 23 6 d -20 15 d -23 -6 d f black 1044 768 m 23 6 d -20 15
- d -23 -6 d cl s 0 0 0.8 c 1020 762 m 24 6 d -20 15 d -24 -6 d f black 1020 762
- m 24 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 997 756 m 23 6 d -20 15 d -23 -6 d f
- black 997 756 m 23 6 d -20 15 d -23 -6 d cl s 0 0 0.8 c 973 750 m 24 6 d -20 15
- d -24 -6 d f black 973 750 m 24 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 950 744 m
- 23 6 d -20 15 d -23 -6 d f black 950 744 m 23 6 d -20 15 d -23 -6 d cl s 0 0
- 0.8 c 927 738 m 23 6 d -20 15 d -24 -6 d f black 927 738 m 23 6 d -20 15 d -24
- -6 d cl s 0 0 0.8 c 903 732 m 24 6 d -21 15 d -23 -6 d f black 903 732 m 24 6 d
- -21 15 d -23 -6 d cl s 0 0 0.8 c 880 726 m 23 6 d -20 15 d -24 -6 d f black 880
- 726 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 856 720 m 24 6 d -21 15 d -23 -6
- d f black 856 720 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 833 714 m 23 6 d
- -20 15 d -24 -6 d f black 833 714 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c
- 1957 979 m 23 6 d -20 16 d -23 -6 d f black 1957 979 m 23 6 d -20 16 d -23 -6 d
- cl s 0 0 0.8 c 1933 973 m 24 6 d -20 16 d -24 -6 d f black 1933 973 m 24 6 d
- -20 16 d -24 -6 d cl s 0 0 0.8 c 1910 967 m 23 6 d -20 16 d -23 -6 d f black
- 1910 967 m 23 6 d -20 16 d -23 -6 d cl s 0 0 0.8 c 1886 961 m 24 6 d -20 16 d
- -24 -6 d f black 1886 961 m 24 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1863 955 m
- 23 6 d -20 16 d -23 -6 d f black 1863 955 m 23 6 d -20 16 d -23 -6 d cl s 0 0
- 0.8 c 1839 949 m 24 6 d -20 16 d -24 -6 d f black 1839 949 m 24 6 d -20 16 d
- -24 -6 d cl s 0 0 0.8 c 1816 943 m 23 6 d -20 16 d -23 -6 d f black 1816 943 m
- 23 6 d -20 16 d -23 -6 d cl s 0 0 0.8 c 1792 938 m 24 5 d -20 16 d -24 -6 d f
- black 1792 938 m 24 5 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1769 932 m 23 6 d -20
- 15 d -23 -6 d f black 1769 932 m 23 6 d -20 15 d -23 -6 d cl s 0 0 0.8 c 1745
- 926 m 24 6 d -20 15 d -24 -6 d f black 1745 926 m 24 6 d -20 15 d -24 -6 d cl s
- 0 0 0.8 c 1722 920 m 23 6 d -20 15 d -23 -6 d f black 1722 920 m 23 6 d -20 15
- d -23 -6 d cl s 0 0 0.8 c 1699 914 m 23 6 d -20 15 d -24 -6 d f black 1699 914
- m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1675 908 m 24 6 d -21 15 d -23 -6 d f
- black 1675 908 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 1652 902 m 23 6 d -20
- 15 d -24 -6 d f black 1652 902 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1628
- 896 m 24 6 d -21 15 d -23 -6 d f black 1628 896 m 24 6 d -21 15 d -23 -6 d cl s
- 0 0 0.8 c 1605 890 m 23 6 d -20 15 d -24 -6 d f black 1605 890 m 23 6 d -20 15
- d -24 -6 d cl s 0 0 0.8 c 1581 884 m 24 6 d -21 15 d -23 -6 d f black 1581 884
- m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 1558 878 m 23 6 d -20 15 d -24 -6 d f
- black 1558 878 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1534 872 m 24 6 d -21
- 15 d -23 -6 d f black 1534 872 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 1511
- 866 m 23 6 d -20 15 d -24 -6 d f black 1511 866 m 23 6 d -20 15 d -24 -6 d cl s
- 0 0 0.8 c 1487 860 m 24 6 d 13 Y -24 -6 d f black 1487 860 m 24 6 d 13 Y -24 -6
- d cl s 0 0 0.8 c 1467 875 m 20 -15 d 13 Y -20 16 d f black 1467 875 m 20 -15 d
- 13 Y -20 16 d cl s 0 0 0.8 c 1487 873 m 24 6 d -21 16 d -23 -6 d f black 1487
- 873 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1464 854 m 23 6 d -20 15 d -24 -6
- d f black 1464 854 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1440 848 m 24 6 d
- -21 15 d -23 -6 d f black 1440 848 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c
- 1417 842 m 23 6 d -20 15 d -24 -6 d f black 1417 842 m 23 6 d -20 15 d -24 -6 d
- cl s 0 0 0.8 c 1393 836 m 24 6 d -21 15 d -23 -6 d f black 1393 836 m 24 6 d
- -21 15 d -23 -6 d cl s 0 0 0.8 c 1370 830 m 23 6 d -20 15 d -24 -6 d f black
- 1370 830 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1346 824 m 24 6 d -21 15 d
- -23 -6 d f black 1346 824 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 1323 818 m
- 23 6 d -20 15 d -24 -6 d f black 1323 818 m 23 6 d -20 15 d -24 -6 d cl s 0 0
- 0.8 c 1299 812 m 24 6 d -21 15 d -23 -6 d f black 1299 812 m 24 6 d -21 15 d
- -23 -6 d cl s 0 0 0.8 c 1276 806 m 23 6 d -20 15 d -24 -6 d f black 1276 806 m
- 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1252 800 m 24 6 d -21 15 d -23 -5 d f
- black 1252 800 m 24 6 d -21 15 d -23 -5 d cl s 0 0 0.8 c 1229 794 m 23 6 d -20
- 16 d -24 -6 d f black 1229 794 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1205
- 788 m 24 6 d -21 16 d -23 -6 d f black 1205 788 m 24 6 d -21 16 d -23 -6 d cl s
- 0 0 0.8 c 1182 782 m 23 6 d -20 16 d -24 -6 d f black 1182 782 m 23 6 d -20 16
- d -24 -6 d cl s 0 0 0.8 c 1158 776 m 24 6 d -21 16 d -23 -6 d f black 1158 776
- m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1135 770 m 23 6 d -20 16 d -24 -6 d f
- black 1135 770 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1111 764 m 24 6 d -21
- 16 d -23 -6 d f black 1111 764 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1088
- 758 m 23 6 d -20 16 d -24 -6 d f black 1088 758 m 23 6 d -20 16 d -24 -6 d cl s
- 0 0 0.8 c 1064 752 m 24 6 d -21 16 d -23 -6 d f black 1064 752 m 24 6 d -21 16
- d -23 -6 d cl s 0 0 0.8 c 1041 746 m 23 6 d -20 16 d -24 -6 d f black 1041 746
- m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1017 740 m 24 6 d 14 Y -24 -6 d f
- black 1017 740 m 24 6 d 14 Y -24 -6 d cl s 0 0 0.8 c 997 756 m 20 -16 d 14 Y
- -20 15 d f black 997 756 m 20 -16 d 14 Y -20 15 d cl s 0 0 0.8 c 1017 754 m 24
- 6 d -21 15 d -23 -6 d f black 1017 754 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8
- c 994 734 m 23 6 d -20 16 d -24 -6 d f black 994 734 m 23 6 d -20 16 d -24 -6 d
- cl s 0 0 0.8 c 970 728 m 24 6 d -21 16 d -23 -6 d f black 970 728 m 24 6 d -21
- 16 d -23 -6 d cl s 0 0 0.8 c 947 722 m 23 6 d -20 16 d -23 -6 d f black 947 722
- m 23 6 d -20 16 d -23 -6 d cl s 0 0 0.8 c 923 716 m 24 6 d -20 16 d -24 -6 d f
- black 923 716 m 24 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 900 710 m 23 6 d -20 16
- d -23 -6 d f black 900 710 m 23 6 d -20 16 d -23 -6 d cl s 0 0 0.8 c 876 704 m
- 24 6 d -20 16 d -24 -6 d f black 876 704 m 24 6 d -20 16 d -24 -6 d cl s 0 0
- 0.8 c 853 698 m 23 6 d -20 16 d -23 -6 d f black 853 698 m 23 6 d -20 16 d -23
- -6 d cl s 0 0 0.8 c 1977 964 m 24 6 d -21 15 d -23 -6 d f black 1977 964 m 24 6
- d -21 15 d -23 -6 d cl s 0 0 0.8 c 1954 958 m 23 6 d -20 15 d -24 -6 d f black
- 1954 958 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1930 952 m 24 6 d -21 15 d
- -23 -6 d f black 1930 952 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 1907 946 m
- 23 6 d -20 15 d -24 -6 d f black 1907 946 m 23 6 d -20 15 d -24 -6 d cl s 0 0
- 0.8 c 1883 940 m 24 6 d -21 15 d -23 -6 d f black 1883 940 m 24 6 d -21 15 d
- -23 -6 d cl s 0 0 0.8 c 1860 934 m 23 6 d -20 15 d -24 -6 d f black 1860 934 m
- 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1836 928 m 24 6 d 13 Y -24 -6 d f black
- 1836 928 m 24 6 d 13 Y -24 -6 d cl s 0 0 0.8 c 1816 943 m 20 -15 d 13 Y -20 16
- d f black 1816 943 m 20 -15 d 13 Y -20 16 d cl s 0 0 0.8 c 1836 941 m 24 6 d
- -21 16 d -23 -6 d f black 1836 941 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c
- 1813 922 m 23 6 d -20 15 d -24 -5 d f black 1813 922 m 23 6 d -20 15 d -24 -5 d
- cl s 0 0 0.8 c 1789 916 m 24 6 d -21 16 d -23 -6 d f black 1789 916 m 24 6 d
- -21 16 d -23 -6 d cl s 0 0 0.8 c 1766 910 m 23 6 d -20 16 d -24 -6 d f black
- 1766 910 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1742 904 m 24 6 d -21 16 d
- -23 -6 d f black 1742 904 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1719 898 m
- 23 6 d -20 16 d -23 -6 d f black 1719 898 m 23 6 d -20 16 d -23 -6 d cl s 0 0
- 0.8 c 1695 892 m 24 6 d -20 16 d -24 -6 d f black 1695 892 m 24 6 d -20 16 d
- -24 -6 d cl s 0 0 0.8 c 1672 886 m 23 6 d -20 16 d -23 -6 d f black 1672 886 m
- 23 6 d -20 16 d -23 -6 d cl s 0 0 0.8 c 1648 880 m 24 6 d -20 16 d -24 -6 d f
- black 1648 880 m 24 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1625 874 m 23 6 d -20
- 16 d -23 -6 d f black 1625 874 m 23 6 d -20 16 d -23 -6 d cl s 0 0 0.8 c 1601
- 868 m 24 6 d -20 16 d -24 -6 d f black 1601 868 m 24 6 d -20 16 d -24 -6 d cl s
- 0 0 0.8 c 1578 862 m 23 6 d 14 Y -23 -6 d f black 1578 862 m 23 6 d 14 Y -23 -6
- d cl s 0 0 0.8 c 1558 878 m 20 -16 d 14 Y -20 15 d f black 1558 878 m 20 -16 d
- 14 Y -20 15 d cl s 0 0 0.8 c 1578 876 m 23 6 d -20 15 d -23 -6 d f black 1578
- 876 m 23 6 d -20 15 d -23 -6 d cl s 0 0 0.8 c 1554 856 m 24 6 d -20 16 d -24 -6
- d f black 1554 856 m 24 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1531 850 m 23 6 d
- -20 16 d -23 -6 d f black 1531 850 m 23 6 d -20 16 d -23 -6 d cl s 0 0 0.8 c
- 1507 844 m 24 6 d -20 16 d -24 -6 d f black 1507 844 m 24 6 d -20 16 d -24 -6 d
- cl s 0 0 0.8 c 1484 838 m 23 6 d -20 16 d -23 -6 d f black 1484 838 m 23 6 d
- -20 16 d -23 -6 d cl s 0 0 0.8 c 1460 832 m 24 6 d -20 16 d -24 -6 d f black
- 1460 832 m 24 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1437 826 m 23 6 d -20 16 d
- -23 -6 d f black 1437 826 m 23 6 d -20 16 d -23 -6 d cl s 0 0 0.8 c 1413 820 m
- 24 6 d -20 16 d -24 -6 d f black 1413 820 m 24 6 d -20 16 d -24 -6 d cl s 0 0
- 0.8 c 1390 814 m 23 6 d -20 16 d -23 -6 d f black 1390 814 m 23 6 d -20 16 d
- -23 -6 d cl s 0 0 0.8 c 1367 808 m 23 6 d -20 16 d -24 -6 d f black 1367 808 m
- 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1343 802 m 24 6 d -21 16 d -23 -6 d f
- black 1343 802 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1320 796 m 23 6 d -20
- 16 d -24 -6 d f black 1320 796 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1296
- 790 m 24 6 d -21 16 d -23 -6 d f black 1296 790 m 24 6 d -21 16 d -23 -6 d cl s
- 0 0 0.8 c 1273 784 m 23 6 d -20 16 d -24 -6 d f black 1273 784 m 23 6 d -20 16
- d -24 -6 d cl s 0 0 0.8 c 1249 778 m 24 6 d -21 16 d -23 -6 d f black 1249 778
- m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1226 772 m 23 6 d -20 16 d -24 -6 d f
- black 1226 772 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1202 767 m 24 5 d -21
- 16 d -23 -6 d f black 1202 767 m 24 5 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1179
- 761 m 23 6 d -20 15 d -24 -6 d f black 1179 761 m 23 6 d -20 15 d -24 -6 d cl s
- 0 0 0.8 c 1155 755 m 24 6 d -21 15 d -23 -6 d f black 1155 755 m 24 6 d -21 15
- d -23 -6 d cl s 0 0 0.8 c 1132 749 m 23 6 d -20 15 d -24 -6 d f black 1132 749
- m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1108 743 m 24 6 d -21 15 d -23 -6 d f
- black 1108 743 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 1085 737 m 23 6 d -20
- 15 d -24 -6 d f black 1085 737 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1061
- 731 m 24 6 d -21 15 d -23 -6 d f black 1061 731 m 24 6 d -21 15 d -23 -6 d cl s
- 0 0 0.8 c 1038 725 m 23 6 d -20 15 d -24 -6 d f black 1038 725 m 23 6 d -20 15
- d -24 -6 d cl s 0 0 0.8 c 1014 719 m 24 6 d -21 15 d -23 -6 d f black 1014 719
- m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 991 713 m 23 6 d -20 15 d -24 -6 d f
- black 991 713 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 967 707 m 24 6 d -21 15
- d -23 -6 d f black 967 707 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 944 701 m
- 23 6 d -20 15 d -24 -6 d f black 944 701 m 23 6 d -20 15 d -24 -6 d cl s 0 0
- 0.8 c 920 695 m 24 6 d -21 15 d -23 -6 d f black 920 695 m 24 6 d -21 15 d -23
- -6 d cl s 0 0 0.8 c 897 689 m 23 6 d -20 15 d -24 -6 d f black 897 689 m 23 6 d
- -20 15 d -24 -6 d cl s 0 0 0.8 c 873 683 m 24 6 d -21 15 d -23 -6 d f black 873
- 683 m 24 6 d -21 15 d -23 -6 d cl s 222 1180 m 651 -497 d s 873 683 m 994 Y s
- 222 2174 m 651 -497 d s 222 1180 m 994 Y s 873 683 m 1128 287 d s 2001 970 m
- 994 Y s 873 1677 m 1128 287 d s 873 1677 m cl s 873 683 m 1128 287 d s 967 673
- m 34 Y s 991 696 m 17 Y s 1014 702 m 17 Y s 1038 708 m 17 Y s 1061 714 m 17 Y s
- 1085 703 m 34 Y s 1108 726 m 17 Y s 1132 732 m 17 Y s 1155 738 m 17 Y s 1179
- 744 m 17 Y s 1202 733 m 34 Y s 1226 756 m 16 Y s 1249 762 m 16 Y s 1273 768 m
- 16 Y s 1296 774 m 16 Y s 1320 763 m 33 Y s 1343 786 m 16 Y s 1367 792 m 16 Y s
- 1390 798 m 16 Y s 1413 804 m 16 Y s 1437 793 m 33 Y s 1460 816 m 16 Y s 1484
- 822 m 16 Y s 1507 828 m 16 Y s 1531 834 m 16 Y s 1554 823 m 33 Y s 1578 846 m
- 16 Y s 1601 851 m 17 Y s 1625 857 m 17 Y s 1648 863 m 17 Y s 1672 853 m 33 Y s
- 1695 875 m 17 Y s 1719 881 m 17 Y s 1742 887 m 17 Y s 1766 893 m 17 Y s 1789
- 883 m 33 Y s 1813 905 m 17 Y s 1836 911 m 17 Y s 1860 917 m 17 Y s 1883 923 m
- 17 Y s 1907 913 m 33 Y s 967 673 m 34 Y s 944 684 m 17 Y s 920 678 m 17 Y s 897
- 672 m 17 Y s 873 666 m 17 Y s 1907 913 m 33 Y s 1930 935 m 17 Y s 1954 941 m 17
- Y s 1977 947 m 17 Y s 2001 953 m 17 Y s 970 654 m -5 -1 d -3 -4 d -1 -8 d -4 Y
- 1 -8 d 3 -4 d 5 -2 d 3 X 4 2 d 3 4 d 1 8 d 4 Y -1 8 d -3 4 d -4 1 d -3 X cl s
- 1061 684 m -4 -1 d -3 -5 d -1 -7 d -4 Y 1 -8 d 3 -4 d 4 -2 d 3 X 5 2 d 3 4 d 1
- 8 d 4 Y -1 7 d -3 5 d -5 1 d -3 X cl s 1085 656 m -1 -1 d 1 -2 d 2 2 d -2 1 d
- cl s 1099 677 m 1 Y 1 3 d 1 2 d 3 1 d 6 X 3 -1 d 2 -2 d 1 -3 d -3 Y -1 -2 d -3
- -5 d -15 -15 d 21 X s 1144 684 m -14 X -2 -13 d 2 2 d 4 1 d 5 X 4 -1 d 3 -3 d 1
- -5 d -3 Y -1 -4 d -3 -3 d -4 -2 d -5 X -4 2 d -2 1 d -1 3 d s 1190 714 m -5 -1
- d -3 -5 d -1 -7 d -5 Y 1 -7 d 3 -4 d 5 -2 d 3 X 4 2 d 3 4 d 2 7 d 5 Y -2 7 d -3
- 5 d -4 1 d -3 X cl s 1214 686 m -2 -1 d 2 -2 d 1 2 d -1 1 d cl s 1243 714 m -15
- X -1 -13 d 1 1 d 5 2 d 4 X 5 -2 d 3 -3 d 1 -4 d -3 Y -1 -4 d -3 -3 d -5 -2 d -4
- X -5 2 d -1 1 d -2 3 d s 1296 744 m -4 -1 d -3 -5 d -2 -7 d -5 Y 2 -7 d 3 -4 d
- 4 -2 d 3 X 5 2 d 3 4 d 1 7 d 5 Y -1 7 d -3 5 d -5 1 d -3 X cl s 1320 716 m -1
- -1 d 1 -2 d 2 2 d -2 1 d cl s 1353 744 m -15 -31 d s 1332 744 m 21 X s 1379 744
- m -14 X -2 -13 d 2 1 d 4 2 d 4 X 5 -2 d 3 -3 d 1 -4 d -3 Y -1 -5 d -3 -2 d -5
- -2 d -4 X -4 2 d -2 1 d -1 3 d s 1435 768 m 3 2 d 4 4 d -31 Y s 1527 798 m 3 2
- d 4 4 d -31 Y s 1555 776 m -2 -2 d 2 -1 d 1 1 d -1 2 d cl s 1568 797 m 1 Y 2 3
- d 1 1 d 3 2 d 6 X 3 -2 d 2 -1 d 1 -3 d -3 Y -1 -3 d -3 -4 d -15 -15 d 21 X s
- 1614 804 m -15 X -1 -13 d 1 1 d 5 2 d 4 X 5 -2 d 3 -3 d 1 -4 d -3 Y -1 -5 d -3
- -3 d -5 -1 d -4 X -5 1 d -1 2 d -2 3 d s 1655 828 m 3 1 d 5 5 d -31 Y s 1683
- 806 m -1 -2 d 1 -1 d 2 1 d -2 2 d cl s 1713 834 m -15 X -1 -13 d 1 1 d 5 1 d 4
- X 5 -1 d 3 -3 d 1 -4 d -3 Y -1 -5 d -3 -3 d -5 -1 d -4 X -5 1 d -1 2 d -2 3 d s
- 1762 858 m 3 1 d 4 5 d -31 Y s 1790 836 m -2 -2 d 2 -1 d 1 1 d -1 2 d cl s 1822
- 864 m -14 -31 d s 1802 864 m 20 X s 1849 864 m -15 X -1 -14 d 1 2 d 5 1 d 4 X 5
- -1 d 3 -3 d 1 -5 d -2 Y -1 -5 d -3 -3 d -5 -1 d -4 X -5 1 d -1 2 d -2 3 d s
- 1902 886 m 2 Y 1 3 d 2 1 d 3 2 d 6 X 3 -2 d 1 -1 d 1 -3 d -3 Y -1 -3 d -3 -5 d
- -15 -14 d 21 X s 873 683 m -651 497 d s 873 649 m 34 Y s 857 679 m 16 Y s 841
- 691 m 17 Y s 824 703 m 17 Y s 808 716 m 17 Y s 792 712 m 33 Y s 776 741 m 16 Y
- s 759 753 m 17 Y s 743 766 m 16 Y s 727 778 m 17 Y s 711 774 m 33 Y s 694 803 m
- 17 Y s 678 815 m 17 Y s 662 828 m 16 Y s 645 840 m 17 Y s 629 836 m 33 Y s 613
- 865 m 17 Y s 597 877 m 17 Y s 580 890 m 17 Y s 564 902 m 17 Y s 548 898 m 33 Y
- s 532 927 m 17 Y s 515 940 m 16 Y s 499 952 m 17 Y s 483 964 m 17 Y s 466 960 m
- 33 Y s 450 989 m 17 Y s 434 1002 m 16 Y s 418 1014 m 17 Y s 401 1027 m 16 Y s
- 385 1022 m 34 Y s 369 1051 m 17 Y s 352 1064 m 16 Y s 336 1076 m 17 Y s 320
- 1089 m 16 Y s 304 1084 m 34 Y s 287 1114 m 16 Y s 271 1126 m 17 Y s 255 1138 m
- 17 Y s 239 1151 m 16 Y s 222 1147 m 33 Y s 873 649 m 34 Y s 826 573 m 27 X s
- 865 583 m 2 Y 1 3 d 2 1 d 3 2 d 6 X 3 -2 d 1 -1 d 2 -3 d -3 Y -2 -3 d -3 -5 d
- -15 -15 d 21 X s 704 635 m 26 X s 745 647 m 3 1 d 5 5 d -31 Y s 773 625 m -1 -2
- d 1 -1 d 2 1 d -2 2 d cl s 803 653 m -15 X -1 -14 d 1 2 d 5 1 d 4 X 5 -1 d 2 -3
- d 2 -5 d -3 Y -2 -4 d -2 -3 d -5 -1 d -4 X -5 1 d -1 2 d -2 2 d s 663 697 m 27
- X s 705 709 m 3 1 d 4 5 d -31 Y s 541 759 m 27 X s 587 777 m -5 -2 d -2 -4 d -2
- -7 d -5 Y 2 -7 d 2 -5 d 5 -1 d 3 X 4 1 d 3 5 d 2 7 d 5 Y -2 7 d -3 4 d -4 2 d
- -3 X cl s 611 749 m -2 -2 d 2 -1 d 1 1 d -1 2 d cl s 640 777 m -15 X -1 -13 d 1
- 1 d 5 2 d 4 X 5 -2 d 3 -3 d 1 -4 d -3 Y -1 -5 d -3 -3 d -5 -1 d -4 X -5 1 d -1
- 2 d -2 3 d s 537 839 m -5 -1 d -3 -5 d -1 -7 d -5 Y 1 -7 d 3 -5 d 5 -1 d 3 X 4
- 1 d 3 5 d 2 7 d 5 Y -2 7 d -3 5 d -4 1 d -3 X cl s 414 901 m -4 -1 d -3 -5 d -2
- -7 d -5 Y 2 -7 d 3 -4 d 4 -2 d 3 X 5 2 d 3 4 d 1 7 d 5 Y -1 7 d -3 5 d -5 1 d
- -3 X cl s 438 873 m -1 -1 d 1 -2 d 2 2 d -2 1 d cl s 468 901 m -15 X -2 -13 d 2
- 1 d 4 2 d 5 X 4 -2 d 3 -3 d 2 -4 d -3 Y -2 -4 d -3 -3 d -4 -2 d -5 X -4 2 d -2
- 1 d -1 3 d s 370 957 m 3 2 d 4 4 d -31 Y s 247 1020 m 3 1 d 5 5 d -32 Y s 275
- 997 m -1 -1 d 1 -2 d 2 2 d -2 1 d cl s 305 1026 m -15 X -1 -14 d 1 2 d 5 1 d 4
- X 4 -1 d 3 -3 d 2 -5 d -3 Y -2 -4 d -3 -3 d -4 -2 d -4 X -5 2 d -1 1 d -2 3 d s
- 204 1080 m 2 Y 1 3 d 2 1 d 3 2 d 6 X 3 -2 d 1 -1 d 2 -3 d -3 Y -2 -3 d -3 -5 d
- -15 -14 d 21 X s 222 1180 m 994 Y s 189 1180 m 33 X s 206 1207 m 16 X s 206
- 1234 m 16 X s 206 1261 m 16 X s 206 1287 m 16 X s 189 1314 m 33 X s 206 1341 m
- 16 X s 206 1368 m 16 X s 206 1395 m 16 X s 206 1422 m 16 X s 189 1449 m 33 X s
- 206 1476 m 16 X s 206 1502 m 16 X s 206 1529 m 16 X s 206 1556 m 16 X s 189
- 1583 m 33 X s 206 1610 m 16 X s 206 1637 m 16 X s 206 1664 m 16 X s 206 1690 m
- 16 X s 189 1717 m 33 X s 206 1744 m 16 X s 206 1771 m 16 X s 206 1798 m 16 X s
- 206 1825 m 16 X s 189 1852 m 33 X s 206 1879 m 16 X s 206 1905 m 16 X s 206
- 1932 m 16 X s 206 1959 m 16 X s 189 1986 m 33 X s 206 2013 m 16 X s 206 2040 m
- 16 X s 206 2067 m 16 X s 206 2094 m 16 X s 189 2120 m 33 X s 189 2120 m 33 X s
- 206 2147 m 16 X s 150 1195 m -4 -1 d -3 -4 d -1 -8 d -4 Y 1 -8 d 3 -4 d 4 -2 d
- 3 X 5 2 d 3 4 d 1 8 d 4 Y -1 8 d -3 4 d -5 1 d -3 X cl s 116 1324 m 3 1 d 5 5 d
- -31 Y s 150 1330 m -4 -2 d -3 -4 d -1 -7 d -5 Y 1 -7 d 3 -5 d 4 -1 d 3 X 5 1 d
- 3 5 d 1 7 d 5 Y -1 7 d -3 4 d -5 2 d -3 X cl s 113 1457 m 1 Y 2 3 d 1 2 d 3 1 d
- 6 X 3 -1 d 2 -2 d 1 -3 d -3 Y -1 -3 d -3 -4 d -15 -15 d 21 X s 150 1464 m -4 -1
- d -3 -5 d -1 -7 d -5 Y 1 -7 d 3 -4 d 4 -2 d 3 X 5 2 d 3 4 d 1 7 d 5 Y -1 7 d -3
- 5 d -5 1 d -3 X cl s 115 1599 m 16 X -9 -12 d 5 X 3 -2 d 1 -1 d 2 -5 d -3 Y -2
- -4 d -3 -3 d -4 -2 d -5 X -4 2 d -2 1 d -1 3 d s 150 1599 m -4 -2 d -3 -4 d -1
- -8 d -4 Y 1 -8 d 3 -4 d 4 -2 d 3 X 5 2 d 3 4 d 1 8 d 4 Y -1 8 d -3 4 d -5 2 d
- -3 X cl s 127 1733 m -15 -21 d 22 X s 127 1733 m -31 Y s 150 1733 m -4 -2 d -3
- -4 d -1 -7 d -5 Y 1 -7 d 3 -5 d 4 -1 d 3 X 5 1 d 3 5 d 1 7 d 5 Y -1 7 d -3 4 d
- -5 2 d -3 X cl s 130 1867 m -15 X -2 -13 d 2 1 d 4 2 d 5 X 4 -2 d 3 -3 d 2 -4 d
- -3 Y -2 -4 d -3 -3 d -4 -2 d -5 X -4 2 d -2 1 d -1 3 d s 150 1867 m -4 -1 d -3
- -5 d -1 -7 d -4 Y 1 -8 d 3 -4 d 4 -2 d 3 X 5 2 d 3 4 d 1 8 d 4 Y -1 7 d -3 5 d
- -5 1 d -3 X cl s 131 1997 m -1 3 d -5 2 d -3 X -4 -2 d -3 -4 d -2 -8 d -7 Y 2
- -6 d 3 -3 d 4 -1 d 2 X 4 1 d 3 3 d 2 4 d 2 Y -2 4 d -3 3 d -4 2 d -2 X -4 -2 d
- -3 -3 d -2 -4 d s 150 2002 m -4 -2 d -3 -4 d -1 -8 d -4 Y 1 -8 d 3 -4 d 4 -1 d
- 3 X 5 1 d 3 4 d 1 8 d 4 Y -1 8 d -3 4 d -5 2 d -3 X cl s 133 2136 m -15 -31 d s
- 112 2136 m 21 X s 150 2136 m -4 -1 d -3 -5 d -1 -7 d -5 Y 1 -7 d 3 -5 d 4 -1 d
- 3 X 5 1 d 3 5 d 1 7 d 5 Y -1 7 d -3 5 d -5 1 d -3 X cl s 1040 539 m 9 -21 d s
- 1057 539 m -8 -21 d -3 -6 d -3 -3 d -3 -1 d -2 X s 1077 549 m 12 -31 d s 1100
- 549 m -11 -31 d s 1127 545 m -3 3 d -4 1 d -6 X -5 -1 d -3 -3 d -3 Y 2 -3 d 1
- -1 d 3 -2 d 9 -3 d 3 -1 d 2 -2 d 1 -3 d -4 Y -3 -3 d -4 -2 d -6 X -5 2 d -3 3 d
- s 1139 521 m -2 -1 d 2 -2 d 1 2 d -1 1 d cl s 1166 539 m 16 -21 d s 1182 539 m
- -16 -21 d s gr
-showpage
- gr
-%%Trailer
-%%Pages: 1
- gr gr
-%%EOF
diff --git a/src/pawlib/paw/testsuite/paw.commands/nt_pl_2d_line.ref.ps b/src/pawlib/paw/testsuite/paw.commands/nt_pl_2d_line.ref.ps
deleted file mode 100644
index 6e6ce24..0000000
--- a/src/pawlib/paw/testsuite/paw.commands/nt_pl_2d_line.ref.ps
+++ /dev/null
@@ -1,231 +0,0 @@
-%!PS-Adobe-2.0
-%%Title: /disk3/maartenb/cerncvs/paw/testsuite/tmp/nt_pl_2d_ (Portrait A 4)
-%%Pages: (atend)
-%%Creator: HIGZ Version 1.23/06
-%%CreationDate: 96/04/16 16.05
-%%EndComments
-%%BeginProlog
-/s {stroke} def /l {lineto} def /m {moveto} def /t {translate} def
-/sw {stringwidth} def /r {rotate} def /rl {roll} def /R {repeat} def
-/d {rlineto} def /rm {rmoveto} def /gr {grestore} def /f {eofill} def
-/c {setrgbcolor} def /lw {setlinewidth} def /sd {setdash} def
-/cl {closepath} def /sf {scalefont setfont} def /black {0 setgray} def
-/box {m dup 0 exch d exch 0 d 0 exch neg d cl} def
-/NC{systemdict begin initclip end}def/C{NC box clip newpath}def
-/bl {box s} def /bf {box f} def /Y { 0 exch d} def /X { 0 d} def
-/mp {newpath /y exch def /x exch def} def
-/side {[w .77 mul w .23 mul] .385 w mul sd w 0 l currentpoint t -144 r} def
-/mr {mp x y w2 0 360 arc} def /m24 {mr s} def /m20 {mr f} def
-/mb {mp x y w2 add m w2 neg 0 d 0 w neg d w 0 d 0 w d cl} def
-/mt {mp x y w2 add m w2 neg w neg d w 0 d cl} def
-/m21 {mb f} def /m25 {mb s} def /m22 {mt f} def /m26 {mt s} def
-/m23 {mp x y w2 sub m w2 w d w neg 0 d cl f} def
-/m27 {mp x y w2 add m w3 neg w2 neg d w3 w2 neg d w3 w2 d cl s} def
-/m28 {mp x w2 sub y w2 sub w3 add m w3 0 d 0 w3 neg d w3 0 d 0 w3 d w3 0 d
- 0 w3 d w3 neg 0 d 0 w3 d w3 neg 0 d
- 0 w3 neg d w3 neg 0 d cl s } def
-/m29 {mp gsave x w2 sub y w2 add w3 sub m currentpoint t
- 4 {side} repeat cl fill gr} def
-/m30 {mp gsave x w2 sub y w2 add w3 sub m currentpoint t
- 5 {side} repeat s gr} def
-/m31 {mp x y w2 sub m 0 w d x w2 sub y m w 0 d
- x w2 sub y w2 add m w w neg d x w2 sub y w2
- sub m w w d s} def
-/m2 {mp x y w2 sub m 0 w d x w2 sub y m w 0 d s} def
-/m5 {mp x w2 sub y w2 sub m w w d x w2 sub y w2 add m w w neg d s} def
-/DP {/PT exch def gsave 47.2 47.2 scale PT 1 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < AA AA 55 55 AA AA 55 55 AA AA 55 55 AA AA 55 55 AA AA 55 55 AA AA 55 55
-AA AA 55 55 AA AA 55 55 > } image } if PT 2 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < BB BB EE EE BB BB EE EE BB BB EE EE BB BB EE EE BB BB EE EE BB BB EE EE
-BB BB EE EE BB BB EE EE > } image } if PT 3 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < FF FF BB BB FF FF EE EE FF FF BB BB FF FF EE EE FF FF BB BB FF FF EE EE
-FF FF BB BB FF FF EE EE > } image } if PT 4 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < DF DF BF BF 7F 7F FE FE FD FD FB FB F7 F7 EF EF DF DF BF BF 7F 7F FE FE
-FD FD FB FB F7 F7 EF EF > } image } if PT 5 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < 7F 7F BF B F DF DF EF EF F7 F7 FB FB FD FD FE FE 7F 7F BF BF DF DF EF
-EF F7 F7 FB FB FD FD FE FE > } image } if PT 6 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB
-BB BB BB BB BB BB BB BB BB > } image } if PT 7 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < FF FF FF FF FF FF 00 00 FF FF FF FF FF FF 00 00 FF FF FF FF FF FF 00
-00 FF FF FF FF FF FF 00 00 > } image } if PT 8 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < EE EE 47 47 83 83 C5 C5 EE EE 5C 5C 38 38 74 74 EE EE 47 47 83 83 C5
-C5 EE EE 5C 5C 38 38 74 74 > } image } if PT 9 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < EF EF EF EF D7 D7 38 38 FE FE FE FE 7D 7D 83 83 EF EF EF EF D7 D7 38
-38 FE FE FE FE 7D 7D 83 83 > } image } if PT 10 eq { 16 16 1 [ 16 0 0 16 neg
-0 16 ] { < EF EF EF EF EF EF 00 00 FE FE FE FE FE FE 00 00 EF EF EF EF EF EF
-00 00 FE FE FE FE FE FE 00 00 > } image } if PT 11 eq { 16 16 1 [ 16 0 0 16
-neg 0 16 ] { < F7 F7 B6 B6 D5 D5 E3 E3 D5 D5 B6 B6 F7 F7 FF FF 7F 7F 6B 6B 5D
-5D 3E 3E 5D 5D 6B 6B 7F 7F FF FF > } image } if PT 12 eq { 16 16 1 [ 16 0 0
-16 neg 0 16 ] { < E3 E3 DD DD BE BE BE BE BE BE DD DD E3 E3 FF FF 3E 3E DD DD
-EB EB EB EB EB EB DD DD 3E 3E FF FF > } image } if PT 13 eq { 16 16 1 [ 16 0
-0 16 neg 0 16 ] { < FE FE 7D 7D BB BB D7 D7 EF EF D7 D7 BB BB 7D 7D FE FE 7D
-7D BB BB D7 D7 EF EF D7 D7 BB BB 7D 7D > } image } if PT 14 eq { 16 16 1 [ 16
-0 0 16 neg 0 16 ] { < 00 00 EE EF EE EF EE EF 0E E0 EE EE EE EE EE EE 00 EE
-FE EE FE EE FE EE 00 00 FE EF FE EF FE EF > } image } if PT 15 eq { 16 16 1 [
-16 0 0 16 neg 0 16 ] { < DD DD AA AA DD DD FF FF 77 77 AA AA 77 77 FF FF DD
-DD AA AA DD DD FF FF 77 77 AA AA 77 77 FF FF > } image } if PT 16 eq { 16 16
-1 [ 16 0 0 16 neg 0 16 ] { < F1 F1 EE EE 1F 1F FF FF F1 F1 EE EE 1F 1F FF FF
-F1 F1 EE EE 1F 1F FF FF F1 F1 EE EE 1F 1F FF FF > } image } if PT 17 eq { 16
-16 1 [ 16 0 0 16 neg 0 16 ] { < EE EE DD DD BB BB FF FF EE EE DD DD BB BB FF
- FF EE EE DD DD BB BB FF FF EE EE DD DD BB BB FF FF > } image } if PT 18 eq {
-16 16 1 [ 16 0 0 16 neg 0 16 ] { < BB BB DD DD EE EE FF FF BB BB DD DD EE EE
-FF FF BB BB DD DD EE EE FF FF BB BB DD DD EE EE FF FF > } image } if PT 19 eq
-{ 16 16 1 [ 16 0 0 16 neg 0 16 ] { < 1F FC 67 F3 7B EF BD DE BD DE DE BD E6
-B3 F8 0F E6 B3 DE BD BD DE BD DE 7B EF 67 F3 1F FC 7F FF > } image } if PT
-20 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < DD DD EE EE EE EE EE EE DD DD BB
-BB BB BB BB BB DD DD EE EE EE EE EE EE DD DD BB BB BB BB BB BB > } image }
-if PT 21 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < 0E 0E EF EF EF EF EF EF E0
-E0 FE FE FE FE FE FE 0E 0E EF EF EF EF EF EF E0 E0 FE FE FE FE FE FE > }
-image } if PT 22 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < 70 70 F7 F7 F7 F7 F7
-F7 07 07 7F 7F 7F 7F 7F 7F 70 70 F7 F7 F7 F7 F7 F7 07 07 7F 7F 7F 7F 7F 7F >
-} image } if PT 23 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < AA AA 55 55 A9 A9
-D1 D1 E1 E1 D1 D1 A9 A9 55 55 AA AA 55 55 A9 A9 D1 D1 E1 E1 D1 D1 A9 A9 55 55
-> } image } if PT 24 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < FF FE FF FC EA
-A8 D5 54 EA A8 D5 54 E8 28 D4 54 E8 E8 D4 D4 E8 EA 54 D5 A8 EA 54 D5 00 C0 00
-80 > } image } if PT 25 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < FF FE FF FC
-FF F8 FF F0 F0 00 F0 00 F0 20 F0 60 F0 E0 F1 E0 F3 E0 F0 00 E0 00 C0 00 80 00
-00 00 > } image } if gr } def /FA { /PT exch def gsave clip 0 0 translate 1 1
-54 { 1 sub 47.2 mul /Xcurr exch def 1 1 74 { 1 sub 47.2 mul /Ycurr exch def
-gsave Xcurr Ycurr translate PT DP gr } for } for gr } def
-/reencdict 24 dict def /ReEncode {reencdict begin /nco&na exch def
-/nfnam exch def /basefontname exch def /basefontdict basefontname findfont def
-/newfont basefontdict maxlength dict def basefontdict {exch dup /FID ne
-{dup /Encoding eq {exch dup length array copy newfont 3 1 roll put} {exch
-newfont 3 1 roll put} ifelse} {pop pop} ifelse } forall newfont
-/FontName nfnam put nco&na aload pop nco&na length 2 idiv {newfont
-/Encoding get 3 1 roll put} repeat nfnam newfont definefont pop end } def
-/accvec [ 176 /agrave 181 /Agrave 190 /acircumflex 192 /Acircumflex
-201 /adieresis 204 /Adieresis 209 /ccedilla 210 /Ccedilla 211 /eacute
-212 /Eacute 213 /egrave 214 /Egrave 215 /ecircumflex 216 /Ecircumflex
-217 /edieresis 218 /Edieresis 219 /icircumflex 220 /Icircumflex
-221 /idieresis 222 /Idieresis 223 /ntilde 224 /Ntilde 226 /ocircumflex
-228 /Ocircumflex 229 /odieresis 230 /Odieresis 231 /ucircumflex 236 /Ucircumflex
-237 /udieresis 238 /Udieresis 239 /aring 242 /Aring 243 /ydieresis
-244 /Ydieresis 246 /aacute 247 /Aacute 252 /ugrave 253 /Ugrave] def
-/Times-Roman /Times-Roman accvec ReEncode
-/Times-Italic /Times-Italic accvec ReEncode
-/Times-Bold /Times-Bold accvec ReEncode
-/Times-BoldItalic /Times-BoldItalic accvec ReEncode
-/Helvetica /Helvetica accvec ReEncode
-/Helvetica-Oblique /Helvetica-Oblique accvec ReEncode
-/Helvetica-Bold /Helvetica-Bold accvec ReEncode
-/Helvetica-BoldOblique /Helvetica-BoldOblique accvec ReEncode
-/Courier /Courier accvec ReEncode
-/Courier-Oblique /Courier-Oblique accvec ReEncode
-/Courier-Bold /Courier-Bold accvec ReEncode
-/Courier-BoldOblique /Courier-BoldOblique accvec ReEncode
-/oshow {gsave [] 0 sd true charpath stroke gr} def
-/stwn { /fs exch def /fn exch def /text exch def fn findfont fs sf
- text sw pop xs add /xs exch def} def
-/stwb { /fs exch def /fn exch def /nbas exch def /textf exch def
-textf length /tlen exch def nbas tlen gt {/nbas tlen def} if
-fn findfont fs sf textf dup length nbas sub nbas getinterval sw
-pop neg xs add /xs exch def} def
-/accspe [ 65 /plusminus 66 /bar 67 /existential 68 /universal
-69 /exclam 70 /numbersign 71 /greater 72 /question 73 /integral
-74 /colon 75 /semicolon 76 /less 77 /bracketleft 78 /bracketright
-79 /greaterequal 80 /braceleft 81 /braceright 82 /radical
-83 /spade 84 /heart 85 /diamond 86 /club 87 /lessequal
-88 /multiply 89 /percent 90 /infinity 48 /circlemultiply 49 /circleplus
-50 /emptyset 51 /lozenge 52 /bullet 53 /arrowright 54 /arrowup
-55 /arrowleft 56 /arrowdown 57 /arrowboth 48 /degree 44 /comma 43 /plus
- 45 /angle 42 /angleleft 47 /divide 61 /notequal 40 /equivalence 41 /second
- 97 /approxequal 98 /congruent 99 /perpendicular 100 /partialdiff 101 /florin
- 102 /intersection 103 /union 104 /propersuperset 105 /reflexsuperset
- 106 /notsubset 107 /propersubset 108 /reflexsubset 109 /element 110 /notelement
- 111 /gradient 112 /logicaland 113 /logicalor 114 /arrowdblboth
- 115 /arrowdblleft 116 /arrowdblup 117 /arrowdblright 118 /arrowdbldown
- 119 /ampersand 120 /omega1 121 /similar 122 /aleph ] def
-/Symbol /Special accspe ReEncode
-/Zone {/iy exch def /ix exch def ix 1 sub 2224 mul 1 iy sub 3144
- mul t} def
-%%EndProlog
- gsave 20 28 t .25 .25 scale gsave
-%%Page: number 1
- gsave
- 1 1 Zone
- gsave 0 0 t black [] 0 sd 1 lw 2223 2224 0 460 bl 2223 2224 0 460 C NC 1779
- 1778 222 683 bl 1779 1778 222 683 C NC 222 683 m 1778 Y s 256 683 m -34 X s 239
- 742 m -17 X s 239 801 m -17 X s 239 861 m -17 X s 239 920 m -17 X s 256 979 m
- -34 X s 239 1038 m -17 X s 239 1098 m -17 X s 239 1157 m -17 X s 239 1216 m -17
- X s 256 1276 m -34 X s 239 1335 m -17 X s 239 1394 m -17 X s 239 1453 m -17 X s
- 239 1513 m -17 X s 256 1572 m -34 X s 239 1631 m -17 X s 239 1691 m -17 X s 239
- 1750 m -17 X s 239 1809 m -17 X s 256 1868 m -34 X s 239 1928 m -17 X s 239
- 1987 m -17 X s 239 2046 m -17 X s 239 2106 m -17 X s 256 2165 m -34 X s 239
- 2224 m -17 X s 239 2283 m -17 X s 239 2343 m -17 X s 239 2402 m -17 X s 256
- 2461 m -34 X s 71 681 m 27 X s 113 692 m 3 2 d 4 4 d -31 Y s 141 670 m -2 -1 d
- 2 -2 d 1 2 d -1 1 d cl s 170 698 m -14 X -2 -13 d 2 1 d 4 2 d 5 X 4 -2 d 3 -2 d
- 1 -5 d -3 Y -1 -4 d -3 -3 d -4 -2 d -5 X -4 2 d -2 1 d -1 3 d s 116 977 m 26 X
- s 157 989 m 3 1 d 5 5 d -31 Y s 71 1273 m 27 X s 117 1291 m -4 -1 d -3 -5 d -2
- -7 d -5 Y 2 -7 d 3 -4 d 4 -2 d 3 X 4 2 d 3 4 d 2 7 d 5 Y -2 7 d -3 5 d -4 1 d
- -3 X cl s 141 1263 m -2 -1 d 2 -2 d 1 2 d -1 1 d cl s 170 1291 m -14 X -2 -13 d
- 2 1 d 4 2 d 5 X 4 -2 d 3 -3 d 1 -4 d -3 Y -1 -5 d -3 -2 d -4 -2 d -5 X -4 2 d
- -2 1 d -1 3 d s 162 1588 m -5 -2 d -3 -4 d -1 -8 d -4 Y 1 -8 d 3 -4 d 5 -2 d 3
- X 4 2 d 3 4 d 1 8 d 4 Y -1 8 d -3 4 d -4 2 d -3 X cl s 117 1884 m -4 -2 d -3 -4
- d -2 -7 d -5 Y 2 -7 d 3 -5 d 4 -1 d 3 X 4 1 d 3 5 d 2 7 d 5 Y -2 7 d -3 4 d -4
- 2 d -3 X cl s 141 1856 m -2 -2 d 2 -1 d 1 1 d -1 2 d cl s 170 1884 m -14 X -2
- -13 d 2 1 d 4 2 d 5 X 4 -2 d 3 -3 d 1 -4 d -3 Y -1 -5 d -3 -3 d -4 -1 d -5 X -4
- 1 d -2 2 d -1 3 d s 157 2174 m 3 2 d 5 4 d -31 Y s 113 2471 m 3 1 d 4 5 d -31 Y
- s 141 2449 m -2 -2 d 2 -1 d 1 1 d -1 2 d cl s 170 2477 m -14 X -2 -14 d 2 2 d 4
- 1 d 5 X 4 -1 d 3 -3 d 1 -4 d -3 Y -1 -5 d -3 -3 d -4 -1 d -5 X -4 1 d -2 2 d -1
- 3 d s 222 683 m 1779 X s 384 716 m -33 Y s 424 699 m -16 Y s 465 699 m -16 Y s
- 505 699 m -16 Y s 546 699 m -16 Y s 586 716 m -33 Y s 626 699 m -16 Y s 667 699
- m -16 Y s 707 699 m -16 Y s 748 699 m -16 Y s 788 716 m -33 Y s 829 699 m -16 Y
- s 869 699 m -16 Y s 909 699 m -16 Y s 950 699 m -16 Y s 990 716 m -33 Y s 1031
- 699 m -16 Y s 1071 699 m -16 Y s 1112 699 m -16 Y s 1152 699 m -16 Y s 1192 716
- m -33 Y s 1233 699 m -16 Y s 1273 699 m -16 Y s 1314 699 m -16 Y s 1354 699 m
- -16 Y s 1394 716 m -33 Y s 1435 699 m -16 Y s 1475 699 m -16 Y s 1516 699 m -16
- Y s 1556 699 m -16 Y s 1597 716 m -33 Y s 1637 699 m -16 Y s 1677 699 m -16 Y s
- 1718 699 m -16 Y s 1758 699 m -16 Y s 1799 716 m -33 Y s 1839 699 m -16 Y s
- 1879 699 m -16 Y s 1920 699 m -16 Y s 1960 699 m -16 Y s 2001 716 m -33 Y s 384
- 716 m -33 Y s 344 699 m -16 Y s 303 699 m -16 Y s 263 699 m -16 Y s 222 699 m
- -16 Y s 382 661 m -4 -2 d -3 -4 d -1 -8 d -4 Y 1 -8 d 3 -4 d 4 -2 d 3 X 5 2 d 3
- 4 d 1 8 d 4 Y -1 8 d -3 4 d -5 2 d -3 X cl s 548 661 m -5 -2 d -3 -4 d -1 -8 d
- -4 Y 1 -8 d 3 -4 d 5 -2 d 3 X 4 2 d 3 4 d 1 8 d 4 Y -1 8 d -3 4 d -4 2 d -3 X
- cl s 571 632 m -1 -1 d 1 -2 d 2 2 d -2 1 d cl s 585 653 m 2 Y 1 3 d 2 1 d 3 2 d
- 5 X 3 -2 d 2 -1 d 1 -3 d -3 Y -1 -3 d -3 -5 d -15 -15 d 21 X s 631 661 m -15 X
- -2 -14 d 2 2 d 4 1 d 5 X 4 -1 d 3 -3 d 1 -5 d -3 Y -1 -4 d -3 -3 d -4 -2 d -5 X
- -4 2 d -2 1 d -1 3 d s 764 661 m -4 -2 d -3 -4 d -1 -8 d -4 Y 1 -8 d 3 -4 d 4
- -2 d 3 X 5 2 d 3 4 d 1 8 d 4 Y -1 8 d -3 4 d -5 2 d -3 X cl s 788 632 m -1 -1 d
- 1 -2 d 2 2 d -2 1 d cl s 818 661 m -15 X -1 -14 d 1 2 d 4 1 d 5 X 4 -1 d 3 -3 d
- 2 -5 d -3 Y -2 -4 d -3 -3 d -4 -2 d -5 X -4 2 d -1 1 d -2 3 d s 952 661 m -5 -2
- d -3 -4 d -1 -8 d -4 Y 1 -8 d 3 -4 d 5 -2 d 3 X 4 2 d 3 4 d 2 8 d 4 Y -2 8 d -3
- 4 d -4 2 d -3 X cl s 975 632 m -1 -1 d 1 -2 d 2 2 d -2 1 d cl s 1008 661 m -15
- -32 d s 987 661 m 21 X s 1035 661 m -15 X -2 -14 d 2 2 d 4 1 d 5 X 4 -1 d 3 -3
- d 2 -5 d -3 Y -2 -4 d -3 -3 d -4 -2 d -5 X -4 2 d -2 1 d -1 3 d s 1186 655 m 3
- 1 d 5 5 d -32 Y s 1351 655 m 3 1 d 5 5 d -32 Y s 1380 632 m -2 -1 d 2 -2 d 1 2
- d -1 1 d cl s 1393 653 m 2 Y 1 3 d 2 1 d 3 2 d 6 X 3 -2 d 1 -1 d 2 -3 d -3 Y -2
- -3 d -3 -5 d -15 -15 d 21 X s 1439 661 m -15 X -1 -14 d 1 2 d 5 1 d 4 X 4 -1 d
- 3 -3 d 2 -5 d -3 Y -2 -4 d -3 -3 d -4 -2 d -4 X -5 2 d -1 1 d -2 3 d s 1568 655
- m 3 1 d 5 5 d -32 Y s 1597 632 m -2 -1 d 2 -2 d 1 2 d -1 1 d cl s 1626 661 m
- -15 X -1 -14 d 1 2 d 5 1 d 4 X 5 -1 d 3 -3 d 1 -5 d -3 Y -1 -4 d -3 -3 d -5 -2
- d -4 X -5 2 d -1 1 d -2 3 d s 1756 655 m 3 1 d 4 5 d -32 Y s 1784 632 m -2 -1 d
- 2 -2 d 1 2 d -1 1 d cl s 1816 661 m -14 -32 d s 1796 661 m 20 X s 1843 661 m
- -15 X -1 -14 d 1 2 d 5 1 d 4 X 5 -1 d 3 -3 d 1 -5 d -3 Y -1 -4 d -3 -3 d -5 -2
- d -4 X -5 2 d -1 1 d -2 3 d s 1992 653 m 2 Y 1 3 d 2 1 d 3 2 d 6 X 3 -2 d 1 -1
- d 2 -3 d -3 Y -2 -3 d -3 -5 d -15 -15 d 21 X s 1779 1778 222 683 C 2223 2224 0
- 460 C 1040 539 m 9 -21 d s 1057 539 m -8 -21 d -3 -6 d -3 -3 d -3 -1 d -2 X s
- 1077 549 m 12 -31 d s 1100 549 m -11 -31 d s 1127 545 m -3 3 d -4 1 d -6 X -5
- -1 d -3 -3 d -3 Y 2 -3 d 1 -1 d 3 -2 d 9 -3 d 3 -1 d 2 -2 d 1 -3 d -4 Y -3 -3 d
- -4 -2 d -6 X -5 2 d -3 3 d s 1139 521 m -2 -1 d 2 -2 d 1 2 d -1 1 d cl s 1166
- 539 m 16 -21 d s 1182 539 m -16 -21 d s 1779 1778 222 683 C 384 1048 m 918 460
- d 515 -32 d -332 -59 d 316 310 d -1284 176 d 406 -580 d -227 286 d 445 271 d
- 536 -256 d -309 379 d 586 -819 d -1085 -127 d 254 157 d 866 834 d -354 -656 d
- -251 230 d -290 -366 d -76 270 d -538 -217 d 1181 200 d -1261 -222 d 1034 301 d
- -1008 367 d 5 -1024 d 367 721 d 1178 -210 d -410 243 d 371 -287 d -789 632 d
- 479 -675 d -1099 333 d 228 -449 d -303 327 d 318 278 d 936 -566 d -622 -408 d
- -20 867 d 222 38 d -243 -671 d -18 26 d 815 217 d -1039 697 d -311 -539 d 59
- -164 d 393 148 d 116 451 d 463 -845 d -363 166 d 823 489 d -1129 -541 d 186 630
- d 755 -551 d -109 747 d 223 -268 d -1112 256 d 60 -791 d 321 603 d -472 -327 d
- 1052 -25 d -137 -350 d 264 552 d -324 -364 d -549 922 d -518 -498 d 791 -289 d
- 655 -28 d -73 537 d -868 -233 d 285 56 d -774 -118 d 702 64 d -68 -414 d -330
- 560 d -319 -594 d 1258 18 d -4 307 d -979 -355 d 1148 340 d -627 115 d -780 81
- d 615 -145 d 655 -568 d 41 801 d -564 -503 d -660 383 d 1174 236 d -646 -808 d
- 790 362 d -806 -177 d 711 301 d -406 -251 d -820 12 d 789 -193 d -543 832 d
- -332 -423 d 1315 227 d -1174 -552 d 1332 320 d -511 -118 d s gr
-showpage
- gr
-%%Trailer
-%%Pages: 1
- gr gr
-%%EOF
diff --git a/src/pawlib/paw/testsuite/paw.commands/nt_pl_2d_surf.ref.ps b/src/pawlib/paw/testsuite/paw.commands/nt_pl_2d_surf.ref.ps
deleted file mode 100644
index b899042..0000000
--- a/src/pawlib/paw/testsuite/paw.commands/nt_pl_2d_surf.ref.ps
+++ /dev/null
@@ -1,876 +0,0 @@
-%!PS-Adobe-2.0
-%%Title: /disk3/maartenb/cerncvs/paw/testsuite/tmp/nt_pl_2d_ (Portrait A 4)
-%%Pages: (atend)
-%%Creator: HIGZ Version 1.23/06
-%%CreationDate: 96/04/16 14.48
-%%EndComments
-%%BeginProlog
-/s {stroke} def /l {lineto} def /m {moveto} def /t {translate} def
-/sw {stringwidth} def /r {rotate} def /rl {roll} def /R {repeat} def
-/d {rlineto} def /rm {rmoveto} def /gr {grestore} def /f {eofill} def
-/c {setrgbcolor} def /lw {setlinewidth} def /sd {setdash} def
-/cl {closepath} def /sf {scalefont setfont} def /black {0 setgray} def
-/box {m dup 0 exch d exch 0 d 0 exch neg d cl} def
-/NC{systemdict begin initclip end}def/C{NC box clip newpath}def
-/bl {box s} def /bf {box f} def /Y { 0 exch d} def /X { 0 d} def
-/mp {newpath /y exch def /x exch def} def
-/side {[w .77 mul w .23 mul] .385 w mul sd w 0 l currentpoint t -144 r} def
-/mr {mp x y w2 0 360 arc} def /m24 {mr s} def /m20 {mr f} def
-/mb {mp x y w2 add m w2 neg 0 d 0 w neg d w 0 d 0 w d cl} def
-/mt {mp x y w2 add m w2 neg w neg d w 0 d cl} def
-/m21 {mb f} def /m25 {mb s} def /m22 {mt f} def /m26 {mt s} def
-/m23 {mp x y w2 sub m w2 w d w neg 0 d cl f} def
-/m27 {mp x y w2 add m w3 neg w2 neg d w3 w2 neg d w3 w2 d cl s} def
-/m28 {mp x w2 sub y w2 sub w3 add m w3 0 d 0 w3 neg d w3 0 d 0 w3 d w3 0 d
- 0 w3 d w3 neg 0 d 0 w3 d w3 neg 0 d
- 0 w3 neg d w3 neg 0 d cl s } def
-/m29 {mp gsave x w2 sub y w2 add w3 sub m currentpoint t
- 4 {side} repeat cl fill gr} def
-/m30 {mp gsave x w2 sub y w2 add w3 sub m currentpoint t
- 5 {side} repeat s gr} def
-/m31 {mp x y w2 sub m 0 w d x w2 sub y m w 0 d
- x w2 sub y w2 add m w w neg d x w2 sub y w2
- sub m w w d s} def
-/m2 {mp x y w2 sub m 0 w d x w2 sub y m w 0 d s} def
-/m5 {mp x w2 sub y w2 sub m w w d x w2 sub y w2 add m w w neg d s} def
-/DP {/PT exch def gsave 47.2 47.2 scale PT 1 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < AA AA 55 55 AA AA 55 55 AA AA 55 55 AA AA 55 55 AA AA 55 55 AA AA 55 55
-AA AA 55 55 AA AA 55 55 > } image } if PT 2 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < BB BB EE EE BB BB EE EE BB BB EE EE BB BB EE EE BB BB EE EE BB BB EE EE
-BB BB EE EE BB BB EE EE > } image } if PT 3 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < FF FF BB BB FF FF EE EE FF FF BB BB FF FF EE EE FF FF BB BB FF FF EE EE
-FF FF BB BB FF FF EE EE > } image } if PT 4 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < DF DF BF BF 7F 7F FE FE FD FD FB FB F7 F7 EF EF DF DF BF BF 7F 7F FE FE
-FD FD FB FB F7 F7 EF EF > } image } if PT 5 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < 7F 7F BF B F DF DF EF EF F7 F7 FB FB FD FD FE FE 7F 7F BF BF DF DF EF
-EF F7 F7 FB FB FD FD FE FE > } image } if PT 6 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB
-BB BB BB BB BB BB BB BB BB > } image } if PT 7 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < FF FF FF FF FF FF 00 00 FF FF FF FF FF FF 00 00 FF FF FF FF FF FF 00
-00 FF FF FF FF FF FF 00 00 > } image } if PT 8 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < EE EE 47 47 83 83 C5 C5 EE EE 5C 5C 38 38 74 74 EE EE 47 47 83 83 C5
-C5 EE EE 5C 5C 38 38 74 74 > } image } if PT 9 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < EF EF EF EF D7 D7 38 38 FE FE FE FE 7D 7D 83 83 EF EF EF EF D7 D7 38
-38 FE FE FE FE 7D 7D 83 83 > } image } if PT 10 eq { 16 16 1 [ 16 0 0 16 neg
-0 16 ] { < EF EF EF EF EF EF 00 00 FE FE FE FE FE FE 00 00 EF EF EF EF EF EF
-00 00 FE FE FE FE FE FE 00 00 > } image } if PT 11 eq { 16 16 1 [ 16 0 0 16
-neg 0 16 ] { < F7 F7 B6 B6 D5 D5 E3 E3 D5 D5 B6 B6 F7 F7 FF FF 7F 7F 6B 6B 5D
-5D 3E 3E 5D 5D 6B 6B 7F 7F FF FF > } image } if PT 12 eq { 16 16 1 [ 16 0 0
-16 neg 0 16 ] { < E3 E3 DD DD BE BE BE BE BE BE DD DD E3 E3 FF FF 3E 3E DD DD
-EB EB EB EB EB EB DD DD 3E 3E FF FF > } image } if PT 13 eq { 16 16 1 [ 16 0
-0 16 neg 0 16 ] { < FE FE 7D 7D BB BB D7 D7 EF EF D7 D7 BB BB 7D 7D FE FE 7D
-7D BB BB D7 D7 EF EF D7 D7 BB BB 7D 7D > } image } if PT 14 eq { 16 16 1 [ 16
-0 0 16 neg 0 16 ] { < 00 00 EE EF EE EF EE EF 0E E0 EE EE EE EE EE EE 00 EE
-FE EE FE EE FE EE 00 00 FE EF FE EF FE EF > } image } if PT 15 eq { 16 16 1 [
-16 0 0 16 neg 0 16 ] { < DD DD AA AA DD DD FF FF 77 77 AA AA 77 77 FF FF DD
-DD AA AA DD DD FF FF 77 77 AA AA 77 77 FF FF > } image } if PT 16 eq { 16 16
-1 [ 16 0 0 16 neg 0 16 ] { < F1 F1 EE EE 1F 1F FF FF F1 F1 EE EE 1F 1F FF FF
-F1 F1 EE EE 1F 1F FF FF F1 F1 EE EE 1F 1F FF FF > } image } if PT 17 eq { 16
-16 1 [ 16 0 0 16 neg 0 16 ] { < EE EE DD DD BB BB FF FF EE EE DD DD BB BB FF
- FF EE EE DD DD BB BB FF FF EE EE DD DD BB BB FF FF > } image } if PT 18 eq {
-16 16 1 [ 16 0 0 16 neg 0 16 ] { < BB BB DD DD EE EE FF FF BB BB DD DD EE EE
-FF FF BB BB DD DD EE EE FF FF BB BB DD DD EE EE FF FF > } image } if PT 19 eq
-{ 16 16 1 [ 16 0 0 16 neg 0 16 ] { < 1F FC 67 F3 7B EF BD DE BD DE DE BD E6
-B3 F8 0F E6 B3 DE BD BD DE BD DE 7B EF 67 F3 1F FC 7F FF > } image } if PT
-20 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < DD DD EE EE EE EE EE EE DD DD BB
-BB BB BB BB BB DD DD EE EE EE EE EE EE DD DD BB BB BB BB BB BB > } image }
-if PT 21 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < 0E 0E EF EF EF EF EF EF E0
-E0 FE FE FE FE FE FE 0E 0E EF EF EF EF EF EF E0 E0 FE FE FE FE FE FE > }
-image } if PT 22 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < 70 70 F7 F7 F7 F7 F7
-F7 07 07 7F 7F 7F 7F 7F 7F 70 70 F7 F7 F7 F7 F7 F7 07 07 7F 7F 7F 7F 7F 7F >
-} image } if PT 23 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < AA AA 55 55 A9 A9
-D1 D1 E1 E1 D1 D1 A9 A9 55 55 AA AA 55 55 A9 A9 D1 D1 E1 E1 D1 D1 A9 A9 55 55
-> } image } if PT 24 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < FF FE FF FC EA
-A8 D5 54 EA A8 D5 54 E8 28 D4 54 E8 E8 D4 D4 E8 EA 54 D5 A8 EA 54 D5 00 C0 00
-80 > } image } if PT 25 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < FF FE FF FC
-FF F8 FF F0 F0 00 F0 00 F0 20 F0 60 F0 E0 F1 E0 F3 E0 F0 00 E0 00 C0 00 80 00
-00 00 > } image } if gr } def /FA { /PT exch def gsave clip 0 0 translate 1 1
-54 { 1 sub 47.2 mul /Xcurr exch def 1 1 74 { 1 sub 47.2 mul /Ycurr exch def
-gsave Xcurr Ycurr translate PT DP gr } for } for gr } def
-/reencdict 24 dict def /ReEncode {reencdict begin /nco&na exch def
-/nfnam exch def /basefontname exch def /basefontdict basefontname findfont def
-/newfont basefontdict maxlength dict def basefontdict {exch dup /FID ne
-{dup /Encoding eq {exch dup length array copy newfont 3 1 roll put} {exch
-newfont 3 1 roll put} ifelse} {pop pop} ifelse } forall newfont
-/FontName nfnam put nco&na aload pop nco&na length 2 idiv {newfont
-/Encoding get 3 1 roll put} repeat nfnam newfont definefont pop end } def
-/accvec [ 176 /agrave 181 /Agrave 190 /acircumflex 192 /Acircumflex
-201 /adieresis 204 /Adieresis 209 /ccedilla 210 /Ccedilla 211 /eacute
-212 /Eacute 213 /egrave 214 /Egrave 215 /ecircumflex 216 /Ecircumflex
-217 /edieresis 218 /Edieresis 219 /icircumflex 220 /Icircumflex
-221 /idieresis 222 /Idieresis 223 /ntilde 224 /Ntilde 226 /ocircumflex
-228 /Ocircumflex 229 /odieresis 230 /Odieresis 231 /ucircumflex 236 /Ucircumflex
-237 /udieresis 238 /Udieresis 239 /aring 242 /Aring 243 /ydieresis
-244 /Ydieresis 246 /aacute 247 /Aacute 252 /ugrave 253 /Ugrave] def
-/Times-Roman /Times-Roman accvec ReEncode
-/Times-Italic /Times-Italic accvec ReEncode
-/Times-Bold /Times-Bold accvec ReEncode
-/Times-BoldItalic /Times-BoldItalic accvec ReEncode
-/Helvetica /Helvetica accvec ReEncode
-/Helvetica-Oblique /Helvetica-Oblique accvec ReEncode
-/Helvetica-Bold /Helvetica-Bold accvec ReEncode
-/Helvetica-BoldOblique /Helvetica-BoldOblique accvec ReEncode
-/Courier /Courier accvec ReEncode
-/Courier-Oblique /Courier-Oblique accvec ReEncode
-/Courier-Bold /Courier-Bold accvec ReEncode
-/Courier-BoldOblique /Courier-BoldOblique accvec ReEncode
-/oshow {gsave [] 0 sd true charpath stroke gr} def
-/stwn { /fs exch def /fn exch def /text exch def fn findfont fs sf
- text sw pop xs add /xs exch def} def
-/stwb { /fs exch def /fn exch def /nbas exch def /textf exch def
-textf length /tlen exch def nbas tlen gt {/nbas tlen def} if
-fn findfont fs sf textf dup length nbas sub nbas getinterval sw
-pop neg xs add /xs exch def} def
-/accspe [ 65 /plusminus 66 /bar 67 /existential 68 /universal
-69 /exclam 70 /numbersign 71 /greater 72 /question 73 /integral
-74 /colon 75 /semicolon 76 /less 77 /bracketleft 78 /bracketright
-79 /greaterequal 80 /braceleft 81 /braceright 82 /radical
-83 /spade 84 /heart 85 /diamond 86 /club 87 /lessequal
-88 /multiply 89 /percent 90 /infinity 48 /circlemultiply 49 /circleplus
-50 /emptyset 51 /lozenge 52 /bullet 53 /arrowright 54 /arrowup
-55 /arrowleft 56 /arrowdown 57 /arrowboth 48 /degree 44 /comma 43 /plus
- 45 /angle 42 /angleleft 47 /divide 61 /notequal 40 /equivalence 41 /second
- 97 /approxequal 98 /congruent 99 /perpendicular 100 /partialdiff 101 /florin
- 102 /intersection 103 /union 104 /propersuperset 105 /reflexsuperset
- 106 /notsubset 107 /propersubset 108 /reflexsubset 109 /element 110 /notelement
- 111 /gradient 112 /logicaland 113 /logicalor 114 /arrowdblboth
- 115 /arrowdblleft 116 /arrowdblup 117 /arrowdblright 118 /arrowdbldown
- 119 /ampersand 120 /omega1 121 /similar 122 /aleph ] def
-/Symbol /Special accspe ReEncode
-/Zone {/iy exch def /ix exch def ix 1 sub 2224 mul 1 iy sub 3144
- mul t} def
-%%EndProlog
- gsave 20 28 t .25 .25 scale gsave
-%%Page: number 1
- gsave
- 1 1 Zone
- gsave 0 0 t black [] 0 sd 1 lw 2223 2224 0 460 bl 2223 2224 0 460 C 1779 1778
- 222 683 C NC 875 694 m 23 6 d s 878 715 m 20 -15 d s 854 709 m 24 6 d s 854 709
- m 21 -15 d s 898 700 m 24 6 d s 901 721 m 21 -15 d s 878 715 m 23 6 d s 922 706
- m 23 5 d s 925 727 m 20 -16 d s 901 721 m 24 6 d s 945 711 m 24 6 d s 948 733 m
- 21 -16 d s 925 727 m 23 6 d s 969 717 m 23 6 d s 972 739 m 20 -16 d s 948 733 m
- 24 6 d s 992 723 m 24 6 d s 995 745 m 21 -16 d s 972 739 m 23 6 d s 1016 729 m
- 23 6 d s 1019 764 m 20 -29 d s 995 745 m 24 19 d s 1039 735 m 24 6 d s 1042 757
- m 21 -16 d s 1019 764 m 23 -7 d s 1063 741 m 23 6 d s 1066 763 m 20 -16 d s
- 1042 757 m 24 6 d s 1086 747 m 24 6 d s 1089 769 m 21 -16 d s 1066 763 m 23 6 d
- s 1110 753 m 23 6 d s 1113 775 m 20 -16 d s 1089 769 m 24 6 d s 1133 759 m 24 6
- d s 1136 781 m 21 -16 d s 1113 775 m 23 6 d s 1157 765 m 23 6 d s 1160 787 m 20
- -16 d s 1136 781 m 24 6 d s 1180 771 m 24 6 d s 1183 793 m 21 -16 d s 1160 787
- m 23 6 d s 1204 777 m 23 6 d s 1207 799 m 20 -16 d s 1183 793 m 24 6 d s 1227
- 783 m 24 6 d s 1230 805 m 21 -16 d s 1207 799 m 23 6 d s 1251 789 m 23 6 d s
- 1254 811 m 20 -16 d s 1230 805 m 24 6 d s 1274 795 m 24 6 d s 1277 817 m 21 -16
- d s 1254 811 m 23 6 d s 1298 801 m 23 6 d s 1301 823 m 20 -16 d s 1277 817 m 24
- 6 d s 1321 807 m 24 6 d s 1324 829 m 21 -16 d s 1301 823 m 23 6 d s 1345 813 m
- 23 6 d s 1348 835 m 20 -16 d s 1324 829 m 24 6 d s 1368 819 m 24 6 d s 1371 841
- m 21 -16 d s 1348 835 m 23 6 d s 1392 825 m 23 6 d s 1395 847 m 20 -16 d s 1371
- 841 m 24 6 d s 1415 831 m 24 6 d s 1418 853 m 21 -16 d s 1395 847 m 23 6 d s
- 1439 837 m 23 6 d s 1442 859 m 20 -16 d s 1418 853 m 24 6 d s 1462 843 m 24 6 d
- s 1465 865 m 21 -16 d s 1442 859 m 23 6 d s 1486 849 m 23 6 d s 1489 884 m 20
- -29 d s 1465 865 m 24 19 d s 1509 855 m 24 6 d s 1512 877 m 21 -16 d s 1489 884
- m 23 -7 d s 1533 861 m 23 6 d s 1536 882 m 20 -15 d s 1512 877 m 24 5 d s 1556
- 867 m 23 19 d s 1559 888 m 20 -2 d s 1536 882 m 23 6 d s 1579 886 m 24 -7 d s
- 1583 894 m 20 -15 d s 1559 888 m 24 6 d s 1603 879 m 23 6 d s 1606 900 m 20 -15
- d s 1583 894 m 23 6 d s 1626 885 m 24 6 d s 1630 906 m 20 -15 d s 1606 900 m 24
- 6 d s 1650 891 m 23 6 d s 1653 912 m 20 -15 d s 1630 906 m 23 6 d s 1673 897 m
- 24 6 d s 1677 918 m 20 -15 d s 1653 912 m 24 6 d s 1697 903 m 23 6 d s 1700 924
- m 20 -15 d s 1677 918 m 23 6 d s 1720 909 m 24 6 d s 1724 930 m 20 -15 d s 1700
- 924 m 24 6 d s 1744 915 m 23 6 d s 1747 936 m 20 -15 d s 1724 930 m 23 6 d s
- 1767 921 m 24 6 d s 1771 942 m 20 -15 d s 1747 936 m 24 6 d s 1791 927 m 23 6 d
- s 1794 948 m 20 -15 d s 1771 942 m 23 6 d s 1814 933 m 24 19 d s 1818 954 m 20
- -2 d s 1794 948 m 24 6 d s 1838 952 m 23 -7 d s 1841 960 m 20 -15 d s 1818 954
- m 23 6 d s 1861 945 m 24 6 d s 1865 966 m 20 -15 d s 1841 960 m 24 6 d s 1885
- 951 m 23 6 d s 1888 972 m 20 -15 d s 1865 966 m 23 6 d s 1908 957 m 24 6 d s
- 1911 978 m 21 -15 d s 1888 972 m 23 6 d s 1932 963 m 23 6 d s 1935 984 m 20 -15
- d s 1911 978 m 24 6 d s 1955 969 m 24 6 d s 1958 990 m 21 -15 d s 1935 984 m 23
- 6 d s 858 731 m 20 -16 d s 834 725 m 24 6 d s 834 725 m 20 -16 d s 881 737 m 20
- -16 d s 858 731 m 23 6 d s 905 743 m 20 -16 d s 881 737 m 24 6 d s 928 749 m 20
- -16 d s 905 743 m 23 6 d s 952 755 m 20 -16 d s 928 749 m 24 6 d s 975 760 m 20
- -15 d s 952 755 m 23 5 d s 999 766 m 20 -2 d s 975 760 m 24 6 d s 1022 772 m 20
- -15 d s 999 766 m 23 6 d s 1046 778 m 20 -15 d s 1022 772 m 24 6 d s 1069 784 m
- 20 -15 d s 1046 778 m 23 6 d s 1093 790 m 20 -15 d s 1069 784 m 24 6 d s 1116
- 796 m 20 -15 d s 1093 790 m 23 6 d s 1139 802 m 21 -15 d s 1116 796 m 23 6 d s
- 1163 808 m 20 -15 d s 1139 802 m 24 6 d s 1186 814 m 21 -15 d s 1163 808 m 23 6
- d s 1210 820 m 20 -15 d s 1186 814 m 24 6 d s 1233 826 m 21 -15 d s 1210 820 m
- 23 6 d s 1257 846 m 20 -29 d s 1233 826 m 24 20 d s 1280 838 m 21 -15 d s 1257
- 846 m 23 -8 d s 1304 844 m 20 -15 d s 1280 838 m 24 6 d s 1327 850 m 21 -15 d s
- 1304 844 m 23 6 d s 1351 870 m 20 -29 d s 1327 850 m 24 20 d s 1374 862 m 21
- -15 d s 1351 870 m 23 -8 d s 1398 868 m 20 -15 d s 1374 862 m 24 6 d s 1421 874
- m 21 -15 d s 1398 868 m 23 6 d s 1445 880 m 20 -15 d s 1421 874 m 24 6 d s 1468
- 886 m 21 -2 d s 1445 880 m 23 6 d s 1492 892 m 20 -15 d s 1468 886 m 24 6 d s
- 1515 898 m 21 -16 d s 1492 892 m 23 6 d s 1539 904 m 20 -16 d s 1515 898 m 24 6
- d s 1562 910 m 21 -16 d s 1539 904 m 23 6 d s 1586 916 m 20 -16 d s 1562 910 m
- 24 6 d s 1609 922 m 21 -16 d s 1586 916 m 23 6 d s 1633 928 m 20 -16 d s 1609
- 922 m 24 6 d s 1656 934 m 21 -16 d s 1633 928 m 23 6 d s 1680 940 m 20 -16 d s
- 1656 934 m 24 6 d s 1703 946 m 21 -16 d s 1680 940 m 23 6 d s 1727 952 m 20 -16
- d s 1703 946 m 24 6 d s 1750 971 m 21 -29 d s 1727 952 m 23 19 d s 1774 964 m
- 20 -16 d s 1750 971 m 24 -7 d s 1797 970 m 21 -16 d s 1774 964 m 23 6 d s 1821
- 976 m 20 -16 d s 1797 970 m 24 6 d s 1844 982 m 21 -16 d s 1821 976 m 23 6 d s
- 1868 988 m 20 -16 d s 1844 982 m 24 6 d s 1891 994 m 20 -16 d s 1868 988 m 23 6
- d s 1915 1000 m 20 -16 d s 1891 994 m 24 6 d s 1938 1006 m 20 -16 d s 1915 1000
- m 23 6 d s 837 746 m 21 -15 d s 814 740 m 23 6 d s 814 740 m 20 -15 d s 861 752
- m 20 -15 d s 837 746 m 24 6 d s 884 758 m 21 -15 d s 861 752 m 23 6 d s 908 764
- m 20 -15 d s 884 758 m 24 6 d s 931 770 m 21 -15 d s 908 764 m 23 6 d s 955 776
- m 20 -16 d s 931 770 m 24 6 d s 978 782 m 21 -16 d s 955 776 m 23 6 d s 1002
- 788 m 20 -16 d s 978 782 m 24 6 d s 1025 807 m 21 -29 d s 1002 788 m 23 19 d s
- 1049 800 m 20 -16 d s 1025 807 m 24 -7 d s 1072 819 m 21 -29 d s 1049 800 m 23
- 19 d s 1096 812 m 20 -16 d s 1072 819 m 24 -7 d s 1119 818 m 20 -16 d s 1096
- 812 m 23 6 d s 1143 824 m 20 -16 d s 1119 818 m 24 6 d s 1166 843 m 20 -29 d s
- 1143 824 m 23 19 d s 1190 836 m 20 -16 d s 1166 843 m 24 -7 d s 1213 842 m 20
- -16 d s 1190 836 m 23 6 d s 1237 861 m 20 -15 d s 1213 842 m 24 19 d s 1260 854
- m 20 -16 d s 1237 861 m 23 -7 d s 1284 860 m 20 -16 d s 1260 854 m 24 6 d s
- 1307 866 m 20 -16 d s 1284 860 m 23 6 d s 1331 872 m 20 -2 d s 1307 866 m 24 6
- d s 1354 878 m 20 -16 d s 1331 872 m 23 6 d s 1378 884 m 20 -16 d s 1354 878 m
- 24 6 d s 1401 917 m 20 -43 d s 1378 884 m 23 33 d s 1425 909 m 20 -29 d s 1401
- 917 m 24 -8 d s 1448 902 m 20 -16 d s 1425 909 m 23 -7 d s 1471 921 m 21 -29 d
- s 1448 902 m 23 19 d s 1495 914 m 20 -16 d s 1471 921 m 24 -7 d s 1518 933 m 21
- -29 d s 1495 914 m 23 19 d s 1542 926 m 20 -16 d s 1518 933 m 24 -7 d s 1565
- 932 m 21 -16 d s 1542 926 m 23 6 d s 1589 937 m 20 -15 d s 1565 932 m 24 5 d s
- 1612 943 m 21 -15 d s 1589 937 m 23 6 d s 1636 949 m 20 -15 d s 1612 943 m 24 6
- d s 1659 955 m 21 -15 d s 1636 949 m 23 6 d s 1683 988 m 20 -42 d s 1659 955 m
- 24 33 d s 1706 967 m 21 -15 d s 1683 988 m 23 -21 d s 1730 973 m 20 -2 d s 1706
- 967 m 24 6 d s 1753 993 m 21 -29 d s 1730 973 m 23 20 d s 1777 999 m 20 -29 d s
- 1753 993 m 24 6 d s 1800 991 m 21 -15 d s 1777 999 m 23 -8 d s 1824 997 m 20
- -15 d s 1800 991 m 24 6 d s 1847 1003 m 21 -15 d s 1824 997 m 23 6 d s 1871
- 1009 m 20 -15 d s 1847 1003 m 24 6 d s 1894 1015 m 21 -15 d s 1871 1009 m 23 6
- d s 1918 1021 m 20 -15 d s 1894 1015 m 24 6 d s 817 762 m 20 -16 d s 793 756 m
- 24 6 d s 793 756 m 21 -16 d s 840 768 m 21 -16 d s 817 762 m 23 6 d s 864 774 m
- 20 -16 d s 840 768 m 24 6 d s 887 780 m 21 -16 d s 864 774 m 23 6 d s 911 786 m
- 20 -16 d s 887 780 m 24 6 d s 934 792 m 21 -16 d s 911 786 m 23 6 d s 958 798 m
- 20 -16 d s 934 792 m 24 6 d s 981 804 m 21 -16 d s 958 798 m 23 6 d s 1005 810
- m 20 -3 d s 981 804 m 24 6 d s 1028 815 m 21 -15 d s 1005 810 m 23 5 d s 1052
- 862 m 20 -43 d s 1028 815 m 24 47 d s 1075 827 m 21 -15 d s 1052 862 m 23 -35 d
- s 1099 833 m 20 -15 d s 1075 827 m 24 6 d s 1122 853 m 21 -29 d s 1099 833 m 23
- 20 d s 1146 859 m 20 -16 d s 1122 853 m 24 6 d s 1169 851 m 21 -15 d s 1146 859
- m 23 -8 d s 1193 857 m 20 -15 d s 1169 851 m 24 6 d s 1216 877 m 21 -16 d s
- 1193 857 m 23 20 d s 1240 883 m 20 -29 d s 1216 877 m 24 6 d s 1263 889 m 21
- -29 d s 1240 883 m 23 6 d s 1287 881 m 20 -15 d s 1263 889 m 24 -8 d s 1310 928
- m 21 -56 d s 1287 881 m 23 47 d s 1334 920 m 20 -42 d s 1310 928 m 24 -8 d s
- 1357 926 m 21 -42 d s 1334 920 m 23 6 d s 1381 945 m 20 -28 d s 1357 926 m 24
- 19 d s 1404 925 m 21 -16 d s 1381 945 m 23 -20 d s 1428 917 m 20 -15 d s 1404
- 925 m 24 -8 d s 1451 937 m 20 -16 d s 1428 917 m 23 20 d s 1475 943 m 20 -29 d
- s 1451 937 m 24 6 d s 1498 935 m 20 -2 d s 1475 943 m 23 -8 d s 1522 941 m 20
- -15 d s 1498 935 m 24 6 d s 1545 947 m 20 -15 d s 1522 941 m 23 6 d s 1569 953
- m 20 -16 d s 1545 947 m 24 6 d s 1592 972 m 20 -29 d s 1569 953 m 23 19 d s
- 1616 978 m 20 -29 d s 1592 972 m 24 6 d s 1639 971 m 20 -16 d s 1616 978 m 23
- -7 d s 1663 977 m 20 11 d s 1639 971 m 24 6 d s 1710 989 m 20 -16 d s 1687 983
- m 23 6 d s 1733 1008 m 20 -15 d s 1710 989 m 23 19 d s 1757 1001 m 20 -2 d s
- 1733 1008 m 24 -7 d s 1780 1020 m 20 -29 d s 1757 1001 m 23 19 d s 1803 1026 m
- 21 -29 d s 1780 1020 m 23 6 d s 1827 1019 m 20 -16 d s 1803 1026 m 24 -7 d s
- 1850 1025 m 21 -16 d s 1827 1019 m 23 6 d s 1874 1031 m 20 -16 d s 1850 1025 m
- 24 6 d s 1897 1037 m 21 -16 d s 1874 1031 m 23 6 d s 797 777 m 20 -15 d s 773
- 771 m 24 6 d s 773 771 m 20 -15 d s 820 783 m 20 -15 d s 797 777 m 23 6 d s 844
- 789 m 20 -15 d s 820 783 m 24 6 d s 867 822 m 20 -42 d s 844 789 m 23 33 d s
- 891 841 m 20 -55 d s 867 822 m 24 19 d s 914 821 m 20 -29 d s 891 841 m 23 -20
- d s 938 827 m 20 -29 d s 914 821 m 24 6 d s 961 859 m 20 -55 d s 938 827 m 23
- 32 d s 985 852 m 20 -42 d s 961 859 m 24 -7 d s 1008 871 m 20 -56 d s 985 852 m
- 23 19 d s 1031 864 m 21 -2 d s 1008 871 m 23 -7 d s 1055 870 m 20 -43 d s 1031
- 864 m 24 6 d s 1078 876 m 21 -43 d s 1055 870 m 23 6 d s 1102 882 m 20 -29 d s
- 1078 876 m 24 6 d s 1125 888 m 21 -29 d s 1102 882 m 23 6 d s 1149 880 m 20 -29
- d s 1125 888 m 24 -8 d s 1172 900 m 21 -43 d s 1149 880 m 23 20 d s 1196 906 m
- 20 -29 d s 1172 900 m 24 6 d s 1219 898 m 21 -15 d s 1196 906 m 23 -8 d s 1243
- 931 m 20 -42 d s 1219 898 m 24 33 d s 1266 910 m 21 -29 d s 1243 931 m 23 -21 d
- s 1290 916 m 20 12 d s 1266 910 m 24 6 d s 1313 936 m 21 -16 d s 1290 916 m 23
- 20 d s 1360 948 m 21 -3 d s 1342 922 m 18 26 d s 1407 933 m 21 -16 d s 1389 938
- m 18 -5 d s 1431 966 m 20 -29 d s 1407 933 m 24 33 d s 1454 958 m 21 -15 d s
- 1431 966 m 23 -8 d s 1478 977 m 20 -42 d s 1454 958 m 24 19 d s 1501 970 m 21
- -29 d s 1478 977 m 23 -7 d s 1525 963 m 20 -16 d s 1501 970 m 24 -7 d s 1548
- 995 m 21 -42 d s 1525 963 m 23 32 d s 1572 1001 m 20 -29 d s 1548 995 m 24 6 d
- s 1595 994 m 21 -16 d s 1572 1001 m 23 -7 d s 1619 1013 m 20 -42 d s 1595 994 m
- 24 19 d s 1642 1033 m 21 -56 d s 1619 1013 m 23 20 d s 1666 998 m 14 -11 d s
- 1642 1033 m 24 -35 d s 1689 1018 m 21 -29 d s 1666 998 m 23 20 d s 1713 1051 m
- 20 -43 d s 1689 1018 m 24 33 d s 1736 1016 m 21 -15 d s 1713 1051 m 23 -35 d s
- 1760 1022 m 20 -2 d s 1736 1016 m 24 6 d s 1783 1109 m 20 -83 d s 1760 1022 m
- 23 87 d s 1807 1034 m 20 -15 d s 1783 1109 m 24 -75 d s 1830 1040 m 20 -15 d s
- 1807 1034 m 23 6 d s 1854 1046 m 20 -15 d s 1830 1040 m 24 6 d s 1877 1052 m 20
- -15 d s 1854 1046 m 23 6 d s 776 793 m 21 -16 d s 753 787 m 23 6 d s 753 787 m
- 20 -16 d s 800 799 m 20 -16 d s 776 793 m 24 6 d s 823 805 m 21 -16 d s 800 799
- m 23 6 d s 847 851 m 20 -29 d s 823 805 m 24 46 d s 870 857 m 21 -16 d s 847
- 851 m 23 6 d s 894 876 m 20 -55 d s 870 857 m 24 19 d s 917 896 m 21 -69 d s
- 894 876 m 23 20 d s 941 848 m 20 11 d s 917 896 m 24 -48 d s 988 873 m 20 -2 d
- s 968 857 m 20 16 d s 1011 920 m 20 -56 d s 988 873 m 23 47 d s 1035 912 m 20
- -42 d s 1011 920 m 24 -8 d s 1058 905 m 20 -29 d s 1035 912 m 23 -7 d s 1082
- 938 m 20 -56 d s 1058 905 m 24 33 d s 1105 930 m 20 -42 d s 1082 938 m 23 -8 d
- s 1129 923 m 20 -43 d s 1105 930 m 24 -7 d s 1152 929 m 20 -29 d s 1129 923 m
- 23 6 d s 1176 908 m 20 -2 d s 1152 929 m 24 -21 d s 1199 914 m 20 -16 d s 1176
- 908 m 23 6 d s 1223 960 m 20 -29 d s 1199 914 m 24 46 d s 1246 1006 m 20 -96 d
- s 1223 960 m 23 46 d s 1270 972 m 20 -56 d s 1246 1006 m 24 -34 d s 1293 991 m
- 20 -55 d s 1270 972 m 23 19 d s 1317 997 m 18 -77 d s 1293 991 m 24 6 d s 1340
- 990 m 20 -42 d s 1317 997 m 23 -7 d s 1363 956 m 13 -10 d s 1340 990 m 23 -34 d
- s 1387 975 m 20 -42 d s 1363 956 m 24 19 d s 1410 994 m 21 -28 d s 1387 975 m
- 23 19 d s 1434 987 m 20 -29 d s 1410 994 m 24 -7 d s 1457 980 m 21 -3 d s 1434
- 987 m 23 -7 d s 1481 999 m 20 -29 d s 1457 980 m 24 19 d s 1504 1059 m 21 -96 d
- s 1481 999 m 23 60 d s 1528 1038 m 20 -43 d s 1504 1059 m 24 -21 d s 1551 1017
- m 21 -16 d s 1528 1038 m 23 -21 d s 1575 1050 m 20 -56 d s 1551 1017 m 24 33 d
- s 1598 1083 m 21 -70 d s 1575 1050 m 23 33 d s 1622 1035 m 20 -2 d s 1598 1083
- m 24 -48 d s 1645 1068 m 21 -70 d s 1622 1035 m 23 33 d s 1669 1074 m 20 -56 d
- s 1645 1068 m 24 6 d s 1692 1066 m 21 -15 d s 1669 1074 m 23 -8 d s 1716 1072 m
- 20 -56 d s 1692 1066 m 24 6 d s 1739 1078 m 21 -56 d s 1716 1072 m 23 6 d s
- 1763 1098 m 20 11 d s 1739 1078 m 24 20 d s 1810 1056 m 20 -16 d s 1800 1053 m
- 10 3 d s 1833 1062 m 21 -16 d s 1810 1056 m 23 6 d s 1857 1068 m 20 -16 d s
- 1833 1062 m 24 6 d s 756 808 m 20 -15 d s 732 802 m 24 6 d s 732 802 m 21 -15 d
- s 779 814 m 21 -15 d s 756 808 m 23 6 d s 803 820 m 20 -15 d s 779 814 m 24 6 d
- s 826 880 m 21 -29 d s 803 820 m 23 60 d s 850 913 m 20 -56 d s 826 880 m 24 33
- d s 873 905 m 21 -29 d s 850 913 m 23 -8 d s 897 884 m 20 12 d s 873 905 m 24
- -21 d s 920 904 m 21 -56 d s 897 884 m 23 20 d s 944 977 m 19 -119 d s 920 904
- m 24 73 d s 967 956 m 21 -83 d s 944 977 m 23 -21 d s 991 989 m 20 -69 d s 967
- 956 m 24 33 d s 1038 920 m 20 -15 d s 1030 914 m 8 6 d s 1061 1020 m 21 -82 d s
- 1038 920 m 23 100 d s 1085 986 m 20 -56 d s 1061 1020 m 24 -34 d s 1108 992 m
- 21 -69 d s 1085 986 m 23 6 d s 1132 985 m 20 -56 d s 1108 992 m 24 -7 d s 1155
- 977 m 21 -69 d s 1132 985 m 23 -8 d s 1179 943 m 20 -29 d s 1155 977 m 24 -34 d
- s 1202 1029 m 21 -69 d s 1179 943 m 23 86 d s 1226 1022 m 20 -16 d s 1202 1029
- m 24 -7 d s 1273 1047 m 20 -56 d s 1255 992 m 18 55 d s 1296 1040 m 21 -43 d s
- 1273 1047 m 23 -7 d s 1320 1059 m 20 -69 d s 1296 1040 m 24 19 d s 1343 1025 m
- 20 -69 d s 1320 1059 m 23 -34 d s 1367 1004 m 20 -29 d s 1343 1025 m 24 -21 d s
- 1390 1010 m 20 -16 d s 1367 1004 m 23 6 d s 1414 1097 m 20 -110 d s 1390 1010 m
- 24 87 d s 1437 1049 m 20 -69 d s 1414 1097 m 23 -48 d s 1461 1082 m 20 -83 d s
- 1437 1049 m 24 33 d s 1484 1007 m 20 52 d s 1461 1082 m 23 -75 d s 1531 1100 m
- 20 -83 d s 1515 1049 m 16 51 d s 1555 1092 m 20 -42 d s 1531 1100 m 24 -8 d s
- 1578 1058 m 20 25 d s 1555 1092 m 23 -34 d s 1602 1104 m 20 -69 d s 1578 1058 m
- 24 46 d s 1625 1097 m 20 -29 d s 1602 1104 m 23 -7 d s 1648 1076 m 21 -2 d s
- 1625 1097 m 23 -21 d s 1672 1082 m 20 -16 d s 1648 1076 m 24 6 d s [4 8] 0 sd
- 1688 1180 m 14 -3 d s [] 0 sd 1695 1222 m 21 -150 d s 1672 1082 m 23 140 d s
- [4 8] 0 sd 1702 1177 m 1 7 d s [] 0 sd 1719 1107 m 20 -29 d s 1695 1222 m 24
- -115 d s 1742 1100 m 21 -2 d s 1719 1107 m 23 -7 d s 1797 1066 m 13 -10 d s
- 1813 1077 m 20 -15 d s 1795 1073 m 18 4 d s 1836 1083 m 21 -15 d s 1813 1077 m
- 23 6 d s 736 824 m 20 -16 d s 712 818 m 24 6 d s 712 818 m 20 -16 d s 759 830 m
- 20 -16 d s 736 824 m 23 6 d s 783 836 m 20 -16 d s 759 830 m 24 6 d s 806 963 m
- 20 -83 d s 783 836 m 23 127 d s 830 888 m 20 25 d s 806 963 m 24 -75 d s 853
- 948 m 20 -43 d s 830 888 m 23 60 d s 877 981 m 20 -97 d s 853 948 m 24 33 d s
- 900 1000 m 20 -96 d s 877 981 m 23 19 d s 923 966 m 21 11 d s 900 1000 m 23 -34
- d s [4 8] 0 sd 934 1009 m 25 -6 d s [] 0 sd 947 1066 m 20 -110 d s 923 966 m 24
- 100 d s [4 8] 0 sd 959 1006 m 4 10 d s [] 0 sd 970 991 m 21 -2 d s 947 1066 m
- 23 -75 d s 994 997 m 14 -65 d s 970 991 m 24 6 d s [4 8] 0 sd 1001 1026 m 25 -3
- d s [] 0 sd 1017 1097 m 21 -177 d s 994 997 m 23 100 d s [4 8] 0 sd 1027 1023 m
- 34 -3 d s [] 0 sd 1041 1049 m 20 -29 d s 1017 1097 m 24 -48 d s [4 8] 0 sd 1061
- 1020 m 15 13 d s [] 0 sd 1064 1096 m 21 -110 d s 1041 1049 m 23 47 d s
- [4 8] 0 sd 1076 1033 m 12 15 d s [] 0 sd 1088 1048 m 20 -56 d s 1064 1096 m 24
- -48 d s 1111 1054 m 21 -69 d s 1088 1048 m 23 6 d s [4 8] 0 sd 1111 1054 m 32 X
- s [] 0 sd 1135 1100 m 20 -123 d s 1111 1054 m 24 46 d s [4 8] 0 sd 1143 1054 m
- 19 9 d s [] 0 sd 1158 1093 m 21 -150 d s 1135 1100 m 23 -7 d s [4 8] 0 sd 1162
- 1063 m 30 1 d s [] 0 sd 1182 1099 m 20 -70 d s 1158 1093 m 24 6 d s [4 8] 0 sd
- 1192 1068 m -1 6 d s [] 0 sd 1205 1037 m 21 -15 d s 1182 1099 m 23 -62 d s 1229
- 1043 m 9 -31 d s 1205 1037 m 24 6 d s [4 8] 0 sd 1243 1087 m 20 -5 d s [] 0 sd
- 1252 1117 m 21 -70 d s 1229 1043 m 23 74 d s [4 8] 0 sd 1263 1082 m 27 3 d s
- [] 0 sd 1276 1190 m 20 -150 d s 1252 1117 m 24 73 d s [4 8] 0 sd 1290 1085 m 9
- 17 d s [] 0 sd 1299 1102 m 21 -43 d s 1276 1190 m 23 -88 d s 1323 1067 m 20 -42
- d s 1299 1102 m 24 -35 d s 1346 1073 m 21 -69 d s 1323 1067 m 23 6 d s 1370
- 1039 m 20 -29 d s 1346 1073 m 24 -34 d s 1393 1099 m 21 -2 d s 1370 1039 m 23
- 60 d s 1440 1057 m 21 25 d s 1427 1069 m 13 -12 d s [4 8] 0 sd 1460 1143 m 6 -1
- d s [] 0 sd 1464 1157 m 20 -150 d s 1440 1057 m 24 100 d s [4 8] 0 sd 1466 1142
- m 9 5 d s [] 0 sd 1487 1136 m 15 -80 d s 1464 1157 m 23 -21 d s 1511 1129 m 20
- -29 d s 1487 1136 m 24 -7 d s 1534 1161 m 21 -69 d s 1511 1129 m 23 32 d s
- [4 8] 0 sd 1534 1161 m 26 5 d s [] 0 sd 1558 1181 m 20 -123 d s 1534 1161 m 24
- 20 d s [4 8] 0 sd 1560 1166 m 4 3 d s [] 0 sd 1581 1133 m 21 -29 d s 1558 1181
- m 23 -48 d s [4 8] 0 sd 1590 1176 m 25 -4 d s [] 0 sd 1605 1247 m 20 -150 d s
- 1581 1133 m 24 114 d s [4 8] 0 sd 1615 1172 m 18 10 d s [] 0 sd 1628 1212 m 20
- -136 d s 1605 1247 m 23 -35 d s [4 8] 0 sd 1633 1182 m 7 6 d s [] 0 sd 1652
- 1165 m 20 -83 d s 1628 1212 m 24 -47 d s [4 8] 0 sd 1683 1191 m 4 -8 d s
- [] 0 sd 1675 1170 m 20 52 d s 1652 1165 m 23 5 d s [4 8] 0 sd 1701 1184 m 2 X s
- 1710 1206 m 15 1 d s [] 0 sd 1722 1223 m 20 -123 d s 1700 1192 m 22 31 d s
- [4 8] 0 sd 1725 1207 m -1 3 d s [] 0 sd 1722 1223 m 21 -123 d s 1793 1093 m 20
- -16 d s 1788 1092 m 5 1 d s 1816 1099 m 20 -16 d s 1793 1093 m 23 6 d s 715 839
- m 21 -15 d s 692 833 m 23 6 d s 692 833 m 20 -15 d s 739 845 m 20 -15 d s 715
- 839 m 24 6 d s 762 851 m 21 -15 d s 739 845 m 23 6 d s [4 8] 0 sd 774 989 m 30
- -11 d s [] 0 sd 786 1126 m 20 -163 d s 762 851 m 24 275 d s [4 8] 0 sd 805 978
- m 13 13 d s [] 0 sd 809 1065 m 21 -177 d s 786 1126 m 23 -61 d s [4 8] 0 sd 818
- 991 m 20 9 d s [] 0 sd 833 1017 m 20 -69 d s 809 1065 m 24 -48 d s [4 8] 0 sd
- 838 1000 m 36 -4 d s [] 0 sd 856 1117 m 21 -136 d s 833 1017 m 23 100 d s
- [4 8] 0 sd 875 996 m 25 4 d s [] 0 sd 880 1069 m 20 -69 d s 856 1117 m 24 -48 d
- s [4 8] 0 sd 900 1000 m 18 10 d s [] 0 sd 903 1142 m 20 -176 d s 880 1069 m 23
- 73 d s [4 8] 0 sd 927 1028 m 7 -19 d s [] 0 sd 927 1028 m 20 38 d s 903 1142 m
- 24 -114 d s [4 8] 0 sd 963 1016 m 4 5 d s [] 0 sd 950 1154 m 20 -163 d s 927
- 1028 m 23 126 d s [4 8] 0 sd 967 1021 m 21 7 d s [] 0 sd 974 1107 m 20 -110 d s
- 950 1154 m 24 -47 d s [4 8] 0 sd 989 1028 m 12 -2 d s [] 0 sd 997 1099 m 20 -2
- d s 974 1107 m 23 -8 d s 1044 1138 m 20 -42 d s 1026 1081 m 18 57 d s 1091 1056
- m 20 -2 d s 1077 1068 m 14 -12 d s [4 8] 0 sd 1095 1070 m 16 -16 d s [] 0 sd
- 1115 1143 m 20 -43 d s 1091 1056 m 24 87 d s 1138 1216 m 20 -123 d s 1115 1143
- m 23 73 d s 1162 1114 m 20 -15 d s 1138 1216 m 24 -102 d s [4 8] 0 sd 1191 1074
- m 4 12 d s [] 0 sd 1185 1134 m 20 -97 d s 1162 1114 m 23 20 d s [4 8] 0 sd 1195
- 1086 m 22 7 d s [] 0 sd 1209 1126 m 20 -83 d s 1185 1134 m 24 -8 d s [4 8] 0 sd
- 1217 1093 m 26 -6 d s [] 0 sd 1232 1146 m 20 -29 d s 1209 1126 m 23 20 d s 1255
- 1192 m 21 -2 d s 1232 1146 m 23 46 d s 1279 1184 m 20 -82 d s 1275 1186 m 4 -2
- d s [4 8] 0 sd 1299 1102 m 19 9 d s [] 0 sd 1302 1258 m 21 -191 d s 1279 1184 m
- 23 74 d s [4 8] 0 sd 1318 1111 m 21 8 d s [] 0 sd 1326 1196 m 20 -123 d s 1302
- 1258 m 24 -62 d s [4 8] 0 sd 1339 1119 m 21 8 d s [] 0 sd 1349 1229 m 21 -190 d
- s 1326 1196 m 23 33 d s [4 8] 0 sd 1361 1127 m 25 4 d s [] 0 sd 1373 1195 m 20
- -96 d s 1349 1229 m 24 -34 d s [4 8] 0 sd 1386 1131 m 22 7 d s [] 0 sd 1396
- 1214 m 18 -117 d s 1373 1195 m 23 19 d s [4 8] 0 sd 1409 1139 m 22 6 d s
- [] 0 sd 1420 1247 m 20 -190 d s 1396 1214 m 24 33 d s [4 8] 0 sd 1431 1145 m 29
- -2 d s [] 0 sd 1443 1226 m 21 -69 d s 1420 1247 m 23 -21 d s [4 8] 0 sd 1475
- 1147 m 9 5 d s [] 0 sd 1467 1246 m 20 -110 d s 1443 1226 m 24 20 d s [4 8] 0 sd
- 1484 1152 m 17 11 d s [] 0 sd 1490 1198 m 21 -69 d s 1467 1246 m 23 -48 d s
- [4 8] 0 sd 1501 1163 m 33 -2 d s [] 0 sd 1514 1217 m 20 -56 d s 1490 1198 m 24
- 19 d s 1537 1290 m 21 -109 d s 1514 1217 m 23 73 d s [4 8] 0 sd 1564 1169 m 13
- 8 d s 1553 1321 m 9 1 d s [] 0 sd 1561 1337 m 20 -204 d s 1537 1290 m 24 47 d s
- [4 8] 0 sd 1577 1177 m 12 -1 d s 1562 1322 m 28 3 d s [] 0 sd 1584 1356 m 21
- -109 d s 1561 1337 m 23 19 d s [4 8] 0 sd 1591 1326 m 5 6 d s [] 0 sd 1608 1308
- m 20 -96 d s 1584 1356 m 24 -48 d s [4 8] 0 sd 1640 1188 m 5 9 d s [] 0 sd 1631
- 1261 m 21 -96 d s 1608 1308 m 23 -47 d s [4 8] 0 sd 1646 1197 m 25 4 d s
- [] 0 sd 1655 1307 m 20 -137 d s 1631 1261 m 24 46 d s [4 8] 0 sd 1671 1201 m 17
- 4 d s [] 0 sd 1678 1273 m 14 -57 d s 1655 1307 m 23 -34 d s [4 8] 0 sd 1698
- 1206 m 12 X s [] 0 sd 1702 1292 m 20 -69 d s 1678 1273 m 24 19 d s [4 8] 0 sd
- 1724 1210 m s [] 0 sd 1749 1102 m 5 -3 d s 1744 1101 m 5 1 d s 1772 1108 m 5 -3
- d s 1787 1097 m 6 -4 d s 1749 1102 m 23 6 d s 1796 1114 m 20 -15 d s 1772 1108
- m 24 6 d s 695 855 m 20 -16 d s 671 849 m 24 6 d s 671 849 m 21 -16 d s 718 861
- m 21 -16 d s 695 855 m 23 6 d s 742 867 m 20 -16 d s 718 861 m 24 6 d s
- [4 8] 0 sd 751 1003 m 23 -14 d s 759 1140 m 27 -14 d s [] 0 sd 765 1236 m 21
- -110 d s 742 867 m 23 369 d s [4 8] 0 sd 786 1126 m 10 16 d s [] 0 sd 789 1188
- m 20 -123 d s 765 1236 m 24 -48 d s [4 8] 0 sd 796 1142 m 5 9 d s [] 0 sd 812
- 1113 m 21 -96 d s 789 1188 m 23 -75 d s 836 1065 m 20 52 d s 812 1113 m 24 -48
- d s [4 8] 0 sd 854 1164 m 10 -2 d s [] 0 sd 859 1192 m 21 -123 d s 836 1065 m
- 23 127 d s [4 8] 0 sd 865 1162 m 18 9 d s [] 0 sd 883 1171 m 20 -29 d s 859
- 1192 m 24 -21 d s [4 8] 0 sd 883 1171 m 30 1 d s [] 0 sd 906 1245 m 21 -217 d s
- 883 1171 m 23 74 d s [4 8] 0 sd 913 1172 m 17 11 d s [] 0 sd 930 1183 m 20 -29
- d s 906 1245 m 24 -62 d s [4 8] 0 sd 967 1193 m 15 -2 d s [] 0 sd 977 1222 m 20
- -123 d s 953 1149 m 24 73 d s [4 8] 0 sd 982 1191 m 18 10 d s [] 0 sd 1000 1201
- m 16 -104 d s 977 1222 m 23 -21 d s [4 8] 0 sd 1000 1201 m 31 1 d s [] 0 sd
- 1024 1234 m 20 -96 d s 1000 1201 m 24 33 d s [4 8] 0 sd 1032 1202 m 26 3 d s
- 1045 1347 m 3 X s [] 0 sd 1047 1361 m 19 -268 d s 1024 1234 m 23 127 d s
- [4 8] 0 sd 1079 1066 m 11 4 d s 1058 1205 m 19 9 d s 1049 1347 m 2 2 d s
- [] 0 sd 1071 1286 m 20 -230 d s 1047 1361 m 24 -75 d s [4 8] 0 sd 1091 1070 m 4
- X s 1078 1216 m 3 6 d s [] 0 sd 1094 1145 m 21 -2 d s 1071 1286 m 23 -141 d s
- 1118 1231 m 20 -15 d s 1094 1145 m 24 86 d s 1141 1210 m 21 -96 d s 1140 1212 m
- 1 -2 d s 1165 1243 m 20 -109 d s 1141 1210 m 24 33 d s [4 8] 0 sd 1165 1243 m
- 29 2 d s [] 0 sd 1188 1289 m 21 -163 d s 1165 1243 m 23 46 d s [4 8] 0 sd 1194
- 1245 m 31 X s 1205 1388 m 10 -1 d s [] 0 sd 1212 1430 m 20 -284 d s 1188 1289 m
- 24 141 d s [4 8] 0 sd 1225 1245 m 8 16 d s 1215 1387 m 2 4 d s [] 0 sd 1235
- 1248 m 20 -56 d s 1212 1430 m 23 -182 d s 1259 1254 m 20 -70 d s 1235 1248 m 24
- 6 d s [4 8] 0 sd 1266 1269 m 36 -11 d s [] 0 sd 1282 1300 m 20 -42 d s 1259
- 1254 m 23 46 d s [4 8] 0 sd 1294 1276 m 8 -18 d s [] 0 sd 1306 1252 m 20 -56 d
- s 1303 1257 m 3 -5 d s [4 8] 0 sd 1311 1281 m 32 -6 d s [] 0 sd 1329 1366 m 20
- -137 d s 1306 1252 m 23 114 d s [4 8] 0 sd 1343 1276 m 4 14 d s [] 0 sd 1353
- 1264 m 20 -69 d s 1329 1366 m 24 -102 d s [4 8] 0 sd 1364 1294 m 18 -1 d s
- [] 0 sd 1376 1324 m 20 -110 d s 1353 1264 m 23 60 d s [4 8] 0 sd 1383 1293 m 30
- X s [] 0 sd 1400 1384 m 20 -137 d s 1376 1324 m 24 60 d s [4 8] 0 sd 1413 1293
- m 7 15 d s [] 0 sd 1423 1296 m 20 -70 d s 1400 1384 m 23 -88 d s [4 8] 0 sd
- 1426 1310 m 33 -4 d s [] 0 sd 1447 1396 m 20 -150 d s 1423 1296 m 24 100 d s
- [4 8] 0 sd 1459 1306 m 17 11 d s [] 0 sd 1470 1361 m 20 -163 d s 1447 1396 m 23
- -35 d s [4 8] 0 sd 1476 1317 m 26 3 d s [] 0 sd 1494 1394 m 20 -177 d s 1470
- 1361 m 24 33 d s [4 8] 0 sd 1502 1322 m 3 8 d s [] 0 sd 1517 1266 m 20 24 d s
- 1494 1394 m 23 -128 d s [4 8] 0 sd 1553 1321 m s 1596 1334 m 2 9 d s [] 0 sd
- 1587 1378 m 21 -70 d s 1576 1349 m 11 29 d s [4 8] 0 sd 1598 1343 m s 1626 1361
- m 20 -7 d s [] 0 sd 1634 1417 m 21 -110 d s 1616 1294 m 18 123 d s [4 8] 0 sd
- 1646 1354 m 22 7 d s [] 0 sd 1658 1449 m 20 -176 d s 1634 1417 m 24 32 d s
- [4 8] 0 sd 1668 1361 m 19 9 d s [] 0 sd 1681 1402 m 21 -110 d s 1658 1449 m 23
- -47 d s 1742 1108 m 7 -6 d s 1752 1124 m 20 -16 d s 1739 1121 m 13 3 d s 1775
- 1130 m 21 -16 d s 1752 1124 m 23 6 d s 675 870 m 20 -15 d s 651 864 m 24 6 d s
- 651 864 m 20 -15 d s 698 876 m 20 -15 d s 675 870 m 23 6 d s 722 882 m 20 -15 d
- s 698 876 m 24 6 d s [4 8] 0 sd 735 1020 m 16 -17 d s 751 1152 m 7 -11 d s
- [] 0 sd 745 1117 m 20 119 d s 722 882 m 23 235 d s [4 8] 0 sd 750 1158 m 1 -3 d
- s [] 0 sd 769 1297 m 20 -109 d s 745 1117 m 24 180 d s [4 8] 0 sd 800 1163 m 1
- -12 d s [] 0 sd 792 1196 m 20 -83 d s 769 1297 m 23 -101 d s [4 8] 0 sd 801
- 1163 m 26 3 d s [] 0 sd 815 1296 m 21 -231 d s 792 1196 m 23 100 d s [4 8] 0 sd
- 828 1166 m 26 -2 d s 819 1310 m 29 -1 d s [] 0 sd 839 1396 m 20 -204 d s 815
- 1296 m 24 100 d s [4 8] 0 sd 848 1309 m 23 6 d s [] 0 sd 862 1415 m 21 -244 d s
- 839 1396 m 23 19 d s [4 8] 0 sd 872 1315 m 26 3 d s [] 0 sd 886 1435 m 20 -190
- d s 862 1415 m 24 20 d s [4 8] 0 sd 898 1318 m -1 12 d s [] 0 sd 886 1435 m 21
- -195 d s [4 8] 0 sd 930 1183 m 18 10 d s [] 0 sd 933 1326 m 20 -177 d s 912
- 1226 m 21 100 d s [4 8] 0 sd 948 1193 m 19 X s 937 1340 m 27 -1 d s [] 0 sd 956
- 1412 m 21 -190 d s 933 1326 m 23 86 d s [4 8] 0 sd 964 1339 m 16 12 d s [] 0 sd
- 980 1351 m 20 -150 d s 956 1412 m 24 -61 d s [4 8] 0 sd 980 1351 m 29 2 d s
- [] 0 sd 1003 1398 m 21 -164 d s 980 1351 m 23 47 d s [4 8] 0 sd 1037 1355 m 8
- -8 d s [] 0 sd 1027 1350 m 20 11 d s 1003 1398 m 24 -48 d s [4 8] 0 sd 1050
- 1349 m 1 X s 1082 1222 m 3 10 d s [] 0 sd 1074 1348 m 20 -203 d s 1057 1334 m
- 17 14 d s [4 8] 0 sd 1085 1232 m 33 -1 d s [] 0 sd 1097 1368 m 21 -137 d s 1074
- 1348 m 23 20 d s [4 8] 0 sd 1118 1231 m 19 10 d s [] 0 sd 1121 1347 m 20 -137 d
- s 1097 1368 m 24 -21 d s [4 8] 0 sd 1137 1241 m 28 2 d s [] 0 sd 1144 1339 m 21
- -96 d s 1121 1347 m 23 -8 d s 1168 1399 m 20 -110 d s 1144 1339 m 24 60 d s
- [4 8] 0 sd 1168 1399 m 35 -11 d s [] 0 sd 1191 1445 m 21 -15 d s 1168 1399 m 23
- 46 d s 1215 1398 m 20 -150 d s 1214 1399 m 1 -1 d s [4 8] 0 sd 1233 1264 m 5 19
- d s [] 0 sd 1238 1283 m 21 -29 d s 1215 1398 m 23 -115 d s [4 8] 0 sd 1238 1283
- m 28 -14 d s [] 0 sd 1262 1329 m 20 -29 d s 1238 1283 m 24 46 d s [4 8] 0 sd
- 1294 1276 m 6 8 d s [] 0 sd 1285 1362 m 21 -110 d s 1262 1329 m 23 33 d s
- [4 8] 0 sd 1300 1284 m 10 -3 d s [] 0 sd 1309 1422 m 20 -56 d s 1285 1362 m 24
- 60 d s [4 8] 0 sd 1347 1290 m 2 4 d s [] 0 sd 1332 1441 m 21 -177 d s 1309 1422
- m 23 19 d s [4 8] 0 sd 1349 1294 m 15 X s [] 0 sd 1356 1433 m 20 -109 d s 1332
- 1441 m 24 -8 d s 1379 1413 m 21 -29 d s 1356 1433 m 23 -20 d s [4 8] 0 sd 1418
- 1313 m 8 -3 d s [] 0 sd 1426 1398 m 21 -2 d s 1405 1368 m 21 30 d s 1473 1450 m
- 21 -56 d s 1459 1379 m 14 71 d s [4 8] 0 sd 1505 1330 m 2 11 d s [] 0 sd 1497
- 1416 m 20 -150 d s 1473 1450 m 24 -34 d s [4 8] 0 sd 1507 1341 m 26 4 d s
- [] 0 sd 1520 1462 m 18 -171 d s 1497 1416 m 23 46 d s [4 8] 0 sd 1533 1345 m 25
- 4 d s [] 0 sd 1544 1428 m 17 -93 d s 1520 1462 m 24 -34 d s [4 8] 0 sd 1558
- 1349 m 17 -1 d s [] 0 sd 1567 1460 m 20 -82 d s 1544 1428 m 23 32 d s
- [4 8] 0 sd 1594 1354 m 7 10 d s [] 0 sd 1591 1480 m 15 -163 d s 1567 1460 m 24
- 20 d s [4 8] 0 sd 1601 1364 m 25 -3 d s [] 0 sd 1614 1419 m 20 -2 d s 1591 1480
- m 23 -61 d s 1638 1425 m 20 24 d s 1614 1419 m 24 6 d s 1661 1525 m 20 -123 d s
- 1638 1425 m 23 100 d s 1737 1135 m 15 -11 d s 1755 1145 m 20 -15 d s 1736 1141
- m 19 4 d s 654 886 m 21 -16 d s 631 880 m 23 6 d s 631 880 m 20 -16 d s 678 892
- m 20 -16 d s 654 886 m 24 6 d s 701 898 m 21 -16 d s 678 892 m 23 6 d s
- [4 8] 0 sd 708 1034 m 27 -14 d s 714 1170 m 28 -10 d s 721 1306 m 10 -4 d s
- [] 0 sd 725 1388 m 20 -271 d s 701 898 m 24 490 d s [4 8] 0 sd 742 1160 m 8 -2
- d s 731 1302 m 38 -5 d s 740 1445 m 12 X s [] 0 sd 748 1474 m 21 -177 d s 725
- 1388 m 23 86 d s [4 8] 0 sd 769 1297 m 7 19 d s [] 0 sd 772 1346 m 20 -150 d s
- 748 1474 m 24 -128 d s [4 8] 0 sd 776 1316 m 36 -4 d s [] 0 sd 795 1392 m 20
- -96 d s 772 1346 m 23 46 d s [4 8] 0 sd 813 1312 m 6 -2 d s [] 0 sd 819 1452 m
- 20 -56 d s 795 1392 m 24 60 d s [4 8] 0 sd 830 1468 m 17 -1 d s [] 0 sd 842
- 1485 m 20 -70 d s 819 1452 m 23 33 d s [4 8] 0 sd 897 1330 m 2 11 d s [] 0 sd
- 889 1470 m 18 -232 d s 880 1429 m 9 41 d s [4 8] 0 sd 900 1341 m 31 X s 901
- 1486 m 13 2 d s [] 0 sd 913 1503 m 20 -177 d s 889 1470 m 24 33 d s [4 8] 0 sd
- 932 1341 m 4 -1 d s 915 1489 m 1 1 d s [] 0 sd 936 1415 m 20 -3 d s 913 1503 m
- 23 -88 d s 983 1507 m 20 -109 d s 965 1388 m 18 119 d s [4 8] 0 sd 1021 1362 m
- 3 3 d s [] 0 sd 1007 1473 m 20 -123 d s 983 1507 m 24 -34 d s [4 8] 0 sd 1024
- 1365 m 23 7 d s 1014 1515 m 23 -1 d s [] 0 sd 1030 1613 m 18 -253 d s 1007 1473
- m 23 140 d s [4 8] 0 sd 1047 1372 m 22 7 d s 1037 1514 m 9 9 d s [] 0 sd 1054
- 1485 m 20 -137 d s 1030 1613 m 24 -128 d s [4 8] 0 sd 1070 1379 m 23 5 d s
- [] 0 sd 1077 1450 m 20 -82 d s 1054 1485 m 23 -35 d s [4 8] 0 sd 1093 1384 m 19
- 10 d s [] 0 sd 1100 1456 m 21 -109 d s 1077 1450 m 23 6 d s [4 8] 0 sd 1113
- 1397 m 1 9 d s [] 0 sd 1124 1368 m 20 -29 d s 1100 1456 m 24 -88 d s [4 8] 0 sd
- 1131 1410 m 37 -11 d s [] 0 sd 1147 1509 m 21 -110 d s 1124 1368 m 23 141 d s
- 1171 1447 m 20 -2 d s 1147 1509 m 24 -62 d s [4 8] 0 sd 1212 1413 m s [] 0 sd
- 1194 1521 m 15 -90 d s 1171 1447 m 23 74 d s [4 8] 0 sd 1212 1413 m 13 14 d s
- [] 0 sd 1218 1500 m 20 -217 d s 1194 1521 m 24 -21 d s [4 8] 0 sd 1225 1427 m
- 27 4 d s [] 0 sd 1241 1533 m 21 -204 d s 1218 1500 m 23 33 d s [4 8] 0 sd 1253
- 1431 m 24 4 d s [] 0 sd 1265 1539 m 20 -177 d s 1241 1533 m 24 6 d s [4 8] 0 sd
- 1277 1435 m 30 1 d s 1283 1583 m 7 1 d s [] 0 sd 1288 1598 m 21 -176 d s 1265
- 1539 m 23 59 d s [4 8] 0 sd 1307 1455 m 25 -14 d s 1290 1584 m 1 Y s [] 0 sd
- 1288 1598 m 23 -175 d s [4 8] 0 sd 1332 1441 m 20 9 d s [] 0 sd 1335 1516 m 21
- -83 d s 1314 1425 m 21 91 d s [4 8] 0 sd 1352 1450 m 23 6 d s [] 0 sd 1359 1603
- m 20 -190 d s 1335 1516 m 24 87 d s [4 8] 0 sd 1375 1457 m 15 12 d s [] 0 sd
- 1382 1528 m 19 -146 d s 1359 1603 m 23 -75 d s [4 8] 0 sd 1390 1469 m 22 7 d s
- [] 0 sd 1406 1507 m 20 -109 d s 1382 1528 m 24 -21 d s [4 8] 0 sd 1412 1476 m
- 24 5 d s [] 0 sd 1429 1554 m 15 -158 d s 1406 1507 m 23 47 d s [4 8] 0 sd 1436
- 1481 m 35 -2 d s 1441 1624 m 18 -2 d s [] 0 sd 1453 1694 m 20 -244 d s 1429
- 1554 m 24 140 d s [4 8] 0 sd 1471 1479 m 19 9 d s 1460 1623 m 16 10 d s [] 0 sd
- 1476 1633 m 21 -217 d s 1453 1694 m 23 -61 d s [4 8] 0 sd 1490 1488 m 4 15 d s
- [] 0 sd 1500 1464 m 20 -2 d s 1476 1633 m 24 -169 d s [4 8] 0 sd 1505 1506 m 32
- -6 d s 1522 1644 m 3 X s [] 0 sd 1523 1658 m 21 -230 d s 1500 1464 m 23 194 d s
- [4 8] 0 sd 1537 1500 m 27 3 d s 1525 1644 m 31 X s [] 0 sd 1547 1785 m 20 -325
- d s 1523 1658 m 24 127 d s [4 8] 0 sd 1564 1503 m 23 7 d s 1556 1644 m 12 12 d
- s [] 0 sd 1570 1643 m 21 -163 d s 1547 1785 m 23 -142 d s [4 8] 0 sd 1587 1510
- m 11 15 d s [] 0 sd 1594 1555 m 20 -136 d s 1570 1643 m 24 -88 d s [4 8] 0 sd
- 1598 1525 m 32 X s 1615 1668 m 3 X s [] 0 sd 1617 1682 m 21 -257 d s 1594 1555
- m 23 127 d s [4 8] 0 sd 1630 1525 m 31 X s 1619 1668 m 30 X s [] 0 sd 1641 1769
- m 20 -244 d s 1617 1682 m 24 87 d s [4 8] 0 sd 1648 1669 m 1 -1 d s [] 0 sd
- 1735 1161 m 20 -16 d s 1733 1161 m 2 X s 634 901 m 20 -15 d s 610 896 m 24 5 d
- s 610 896 m 21 -16 d s 657 907 m 21 -15 d s 634 901 m 23 6 d s 681 913 m 20 -15
- d s 657 907 m 24 6 d s [4 8] 0 sd 687 1049 m 21 -15 d s 692 1185 m 22 -15 d s
- 698 1321 m 23 -15 d s 704 1457 m 4 -3 d s [] 0 sd 704 1470 m 21 -82 d s 681 913
- m 23 557 d s [4 8] 0 sd 710 1453 m 30 -8 d s [] 0 sd 728 1517 m 20 -43 d s 704
- 1470 m 24 47 d s [4 8] 0 sd 754 1450 m 9 10 d s 748 1602 m 4 X s [] 0 sd 751
- 1617 m 21 -271 d s 728 1517 m 23 100 d s [4 8] 0 sd 763 1460 m 28 3 d s 753
- 1602 m 28 2 d s [] 0 sd 775 1703 m 20 -311 d s 751 1617 m 24 86 d s [4 8] 0 sd
- 791 1463 m 1 16 d s 781 1604 m 1 7 d s [] 0 sd 775 1703 m 23 -300 d s
- [4 8] 0 sd 812 1484 m 18 -15 d s [] 0 sd 822 1541 m 20 -56 d s 799 1406 m 23
- 135 d s [4 8] 0 sd 846 1474 m 7 13 d s [] 0 sd 845 1560 m 15 -134 d s 822 1541
- m 23 19 d s [4 8] 0 sd 853 1487 m 33 -2 d s [] 0 sd 869 1579 m 20 -109 d s 845
- 1560 m 24 19 d s [4 8] 0 sd 886 1485 m 15 1 d s [] 0 sd 892 1532 m 21 -29 d s
- 869 1579 m 23 -47 d s [4 8] 0 sd 916 1490 m 13 10 d s 911 1644 m 7 -1 d s
- [] 0 sd 916 1672 m 20 -257 d s 892 1532 m 24 140 d s [4 8] 0 sd 929 1500 m 18
- 11 d s 918 1643 m 7 4 d s [] 0 sd 939 1611 m 16 -200 d s 916 1672 m 23 -61 d s
- [4 8] 0 sd 947 1511 m 36 -4 d s [] 0 sd 963 1644 m 20 -137 d s 939 1611 m 24 33
- d s [4 8] 0 sd 983 1507 m 20 9 d s 967 1658 m 25 1 d s [] 0 sd 986 1730 m 21
- -257 d s 963 1644 m 23 86 d s [4 8] 0 sd 1004 1516 m 9 -1 d s 992 1659 m 7 7 d
- s [] 0 sd 1010 1615 m 20 -2 d s 986 1730 m 24 -115 d s [4 8] 0 sd 1046 1523 m 5
- 4 d s 1017 1671 m 24 -2 d s [] 0 sd 1033 1796 m 21 -311 d s 1010 1615 m 23 181
- d s [4 8] 0 sd 1051 1527 m 12 14 d s 1041 1669 m 5 9 d s [] 0 sd 1057 1587 m 20
- -137 d s 1033 1796 m 24 -209 d s [4 8] 0 sd 1063 1541 m 22 8 d s [] 0 sd 1080
- 1579 m 20 -123 d s 1057 1587 m 23 -8 d s [4 8] 0 sd 1114 1406 m 5 7 d s 1086
- 1549 m 10 8 d s [] 0 sd 1104 1545 m 20 -177 d s 1080 1579 m 24 -34 d s
- [4 8] 0 sd 1119 1413 m 11 -2 d s 1108 1560 m 31 -4 d s [] 0 sd 1127 1618 m 20
- -109 d s 1104 1545 m 23 73 d s [4 8] 0 sd 1139 1556 m 19 9 d s [] 0 sd 1151
- 1638 m 20 -191 d s 1127 1618 m 24 20 d s [4 8] 0 sd 1159 1565 m 23 5 d s
- [] 0 sd 1174 1603 m 20 -82 d s 1151 1638 m 23 -35 d s [4 8] 0 sd 1182 1570 m 32
- X s 1185 1713 m 21 -2 d s [] 0 sd 1198 1851 m 20 -351 d s 1174 1603 m 24 248 d
- s 1198 1851 m 21 -350 d s [4 8] 0 sd 1242 1594 m 8 -3 d s [] 0 sd 1245 1608 m
- 20 -69 d s 1229 1516 m 16 92 d s [4 8] 0 sd 1283 1585 m 4 Y s [] 0 sd 1268 1560
- m 20 38 d s 1245 1608 m 23 -48 d s [4 8] 0 sd 1307 1455 m 1 5 d s 1290 1585 m 3
- 20 d s [] 0 sd 1292 1620 m 19 -191 d s 1268 1560 m 24 60 d s [4 8] 0 sd 1308
- 1460 m 14 -1 d s 1295 1606 m 1 2 d s [] 0 sd 1315 1559 m 20 -43 d s 1292 1620 m
- 23 -61 d s [4 8] 0 sd 1321 1614 m 38 -11 d s 1336 1752 m 6 -2 d s [] 0 sd 1339
- 1780 m 20 -177 d s 1315 1559 m 24 221 d s [4 8] 0 sd 1359 1603 m 13 14 d s 1343
- 1751 m 3 4 d s [] 0 sd 1362 1705 m 20 -177 d s 1339 1780 m 23 -75 d s
- [4 8] 0 sd 1372 1617 m 3 11 d s [] 0 sd 1386 1563 m 20 -56 d s 1362 1705 m 24
- -142 d s [4 8] 0 sd 1396 1633 m 24 -5 d s [] 0 sd 1409 1717 m 20 -163 d s 1386
- 1563 m 23 154 d s [4 8] 0 sd 1421 1628 m 20 -4 d s [] 0 sd 1432 1669 m 21 25 d
- s 1409 1717 m 23 -48 d s [4 8] 0 sd 1495 1509 m 10 -3 d s 1499 1659 m 23 -15 d
- s [] 0 sd 1503 1674 m 20 -16 d s 1482 1597 m 21 77 d s 1526 1706 m 21 79 d s
- 1503 1674 m 23 32 d s [4 8] 0 sd 1568 1657 m 1 Y s [] 0 sd 1550 1793 m 20 -150
- d s 1546 1779 m 4 14 d s [4 8] 0 sd 1569 1659 m 4 19 d s [] 0 sd 1573 1678 m 21
- -123 d s 1550 1793 m 23 -115 d s [4 8] 0 sd 1614 1669 m 2 Y s [] 0 sd 1597 1617
- m 20 65 d s 1573 1678 m 24 -61 d s 614 917 m 20 -16 d s 590 911 m 24 6 d s 590
- 911 m 20 -15 d s 637 923 m 20 -16 d s 614 917 m 23 6 d s 660 929 m 21 -16 d s
- 637 923 m 23 6 d s [4 8] 0 sd 665 1065 m 20 -15 d s 670 1200 m 22 -15 d s 674
- 1336 m 24 -15 d s 679 1471 m 24 -14 d s 684 1607 m 2 -2 d s [] 0 sd 684 1620 m
- 20 -150 d s 660 929 m 24 691 d s [4 8] 0 sd 686 1607 m s [] 0 sd 707 1478 m 21
- 39 d s 684 1620 m 23 -142 d s [4 8] 0 sd 727 1618 m 21 -16 d s [] 0 sd 731 1646
- m 20 -29 d s 707 1478 m 24 168 d s [4 8] 0 sd 751 1617 m s 792 1489 m 20 -5 d s
- [] 0 sd 801 1623 m 21 -82 d s 785 1562 m 16 61 d s [4 8] 0 sd 806 1638 m 28 -2
- d s [] 0 sd 825 1696 m 20 -136 d s 801 1623 m 24 73 d s [4 8] 0 sd 834 1636 m
- 18 10 d s [] 0 sd 848 1662 m 21 -83 d s 825 1696 m 23 -34 d s [4 8] 0 sd 852
- 1648 m -2 Y s [] 0 sd 848 1662 m 24 -87 d s [4 8] 0 sd 911 1644 m 5 Y s [] 0 sd
- 895 1580 m 21 92 d s 872 1574 m 23 6 d s [4 8] 0 sd 911 1649 m cl s 925 1647 m
- s [] 0 sd 939 1611 m s 942 1632 m 21 12 d s 930 1636 m 12 -4 d s [4 8] 0 sd 998
- 1666 m 1 X s 1013 1690 m 4 -18 d s [] 0 sd 1013 1690 m 20 106 d s 1005 1637 m 8
- 53 d s [4 8] 0 sd 1045 1679 m 1 -1 d s 1096 1557 m 7 2 d s 1070 1705 m 25 -6 d
- s 1079 1842 m 8 -2 d s [] 0 sd 1083 1910 m 21 -365 d s 1062 1585 m 21 325 d s
- [4 8] 0 sd 1103 1559 m 5 1 d s 1096 1703 m 3 9 d s 1088 1842 m 1 2 d s [] 0 sd
- 1107 1620 m 20 -2 d s 1083 1910 m 24 -290 d s 1130 1694 m 21 -56 d s 1107 1620
- m 23 74 d s 1154 1659 m 20 -56 d s 1130 1694 m 24 -35 d s [4 8] 0 sd 1182 1729
- m 3 -16 d s [] 0 sd 1177 1692 m 21 159 d s 1154 1659 m 23 33 d s [4 8] 0 sd
- 1213 1594 m 29 X s 1206 1736 m 26 2 d s [] 0 sd 1224 1825 m 21 -217 d s 1202
- 1793 m 22 32 d s [4 8] 0 sd 1251 1596 m 13 7 d s 1232 1738 m 21 9 d s [] 0 sd
- 1248 1804 m 20 -244 d s 1224 1825 m 24 -21 d s [4 8] 0 sd 1264 1603 m 22 2 d s
- 1253 1747 m 26 3 d s [] 0 sd 1271 1837 m 21 -217 d s 1248 1804 m 23 33 d s
- [4 8] 0 sd 1298 1609 m 11 8 d s 1279 1750 m 16 12 d s [] 0 sd 1295 1762 m 20
- -203 d s 1271 1837 m 24 -75 d s [4 8] 0 sd 1309 1617 m 12 -3 d s 1333 1757 m 3
- -5 d s [] 0 sd 1318 1701 m 21 79 d s 1295 1762 m 23 -61 d s [4 8] 0 sd 1333
- 1757 m 1 X s 1375 1628 m 4 7 d s 1359 1779 m 7 X s [] 0 sd 1365 1794 m 21 -231
- d s 1348 1750 m 17 44 d s [4 8] 0 sd 1379 1635 m 16 -2 d s 1366 1779 m 37 -4 d
- s [] 0 sd 1389 1921 m 20 -204 d s 1365 1794 m 24 127 d s [4 8] 0 sd 1403 1775 m
- 17 11 d s [] 0 sd 1412 1859 m 20 -190 d s 1389 1921 m 23 -62 d s [4 8] 0 sd
- 1420 1786 m 22 8 d s [] 0 sd 1436 1906 m 11 -219 d s 1412 1859 m 24 47 d s
- [4 8] 0 sd 1468 1657 m 6 1 d s 1443 1794 m 20 7 d s [] 0 sd 1459 1858 m 17 -222
- d s 1436 1906 m 23 -48 d s [4 8] 0 sd 1493 1668 m 6 -9 d s 1463 1801 m 2 5 d s
- [] 0 sd 1483 1662 m 20 12 d s 1459 1858 m 24 -196 d s [4 8] 0 sd 1484 1676 m 9
- -8 d s 1498 1814 m 17 -5 d s [] 0 sd 1506 1897 m 20 -191 d s 1483 1662 m 23 235
- d s [4 8] 0 sd 1515 1809 m 33 -1 d s [] 0 sd 1530 1930 m 20 -137 d s 1506 1897
- m 24 33 d s [4 8] 0 sd 1548 1808 m 17 11 d s 1539 1959 m 17 1 d s [] 0 sd 1553
- 2003 m 20 -325 d s 1530 1930 m 23 73 d s [4 8] 0 sd 1573 1678 m 9 17 d s 1565
- 1819 m 3 13 d s 1556 1962 m 1 Y s [] 0 sd 1577 1726 m 20 -109 d s 1553 2003 m
- 24 -277 d s [4 8] 0 sd 1582 1695 m 33 -1 d s 1588 1837 m 19 -2 d s [] 0 sd 1600
- 1947 m 16 -272 d s 1577 1726 m 23 221 d s [4 8] 0 sd 1614 1696 m 1 -2 d s 1606
- 1836 m 1 -1 d s [] 0 sd 593 933 m 21 -16 d s 570 927 m 23 6 d s 570 927 m 20
- -16 d s 617 939 m 20 -16 d s 593 933 m 24 6 d s 640 945 m 20 -16 d s 617 939 m
- 23 6 d s [4 8] 0 sd 645 1080 m 20 -15 d s 650 1216 m 20 -16 d s 655 1351 m 19
- -15 d s 660 1487 m 19 -16 d s 679 1611 m 5 -4 d s [] 0 sd 664 1582 m 20 38 d s
- 640 945 m 24 637 d s [4 8] 0 sd 686 1608 m -1 Y s [] 0 sd 707 1478 m s
- [4 8] 0 sd 694 1630 m 33 -12 d s [] 0 sd 711 1701 m 20 -55 d s 687 1603 m 24 98
- d s 783 1589 m 18 34 d s 848 1662 m s 875 1663 m 20 -83 d s 856 1635 m 19 28 d
- s 899 1642 m 10 -1 d s 875 1663 m 24 -21 d s [4 8] 0 sd 913 1686 m 17 -4 d s
- [] 0 sd 922 1715 m 20 -83 d s 899 1642 m 23 73 d s [4 8] 0 sd 931 1682 m 21 7 d
- s [] 0 sd 946 1748 m 11 -108 d s 922 1715 m 24 33 d s [4 8] 0 sd 952 1689 m 21
- 8 d s [] 0 sd 969 1740 m 5 -50 d s 946 1748 m 23 -8 d s [4 8] 0 sd 975 1697 m 2
- -1 d s 993 1694 m 20 -4 d s [] 0 sd 992 1787 m 21 -97 d s 969 1740 m 23 47 d s
- 1016 1793 m 7 -46 d s 992 1787 m 24 6 d s [4 8] 0 sd 1042 1711 m 3 3 d s
- [] 0 sd 1039 1772 m 16 -168 d s 1016 1793 m 14 -13 d s 1035 1776 m 4 -4 d s
- [4 8] 0 sd 1045 1714 m 25 -9 d s 1075 1849 m 4 -7 d s [] 0 sd 1063 1751 m 20
- 159 d s 1039 1772 m 24 -21 d s [4 8] 0 sd 1075 1849 m 2 -1 d s [] 0 sd 1107
- 1620 m s [4 8] 0 sd 1098 1733 m 25 -7 d s [] 0 sd 1110 1790 m 20 -96 d s 1098
- 1733 m 12 57 d s 1157 1694 m 20 -2 d s 1148 1668 m 9 26 d s [4 8] 0 sd 1169
- 1751 m 14 -13 d s [] 0 sd 1180 1808 m 12 -9 d s 1157 1694 m 23 114 d s
- [4 8] 0 sd 1221 1899 m 16 -6 d s [] 0 sd 1227 1967 m 21 -163 d s 1212 1809 m 15
- 158 d s [4 8] 0 sd 1238 1893 m 24 5 d s [] 0 sd 1251 1973 m 20 -136 d s 1227
- 1967 m 24 6 d s [4 8] 0 sd 1261 1900 m 1 -2 d s 1295 1762 m 16 11 d s [] 0 sd
- 1298 1918 m 20 -217 d s 1287 1786 m 11 132 d s [4 8] 0 sd 1311 1773 m 25 6 d s
- [] 0 sd 1321 1884 m 16 -113 d s 1298 1918 m 23 -34 d s [4 8] 0 sd 1337 1779 m 3
- X s 1341 1779 m 18 X s [] 0 sd 1345 1863 m 20 -69 d s 1321 1884 m 24 -21 d s
- [4 8] 0 sd 1351 1932 m 38 -11 d s 1363 2069 m 11 -3 d s [] 0 sd 1368 2124 m 21
- -203 d s 1345 1863 m 23 261 d s 1415 1867 m 21 39 d s 1410 1866 m 5 1 d s
- [4 8] 0 sd 1465 1806 m 10 10 d s 1454 1958 m 13 -2 d s [] 0 sd 1462 2054 m 21
- -392 d s 1448 1881 m 14 173 d s [4 8] 0 sd 1483 1676 m 1 X s 1498 1819 m -1 4 d
- s 1468 1957 m 1 5 d s [] 0 sd 1486 1724 m 20 173 d s 1462 2054 m 24 -330 d s
- [4 8] 0 sd 1495 1834 m 2 -8 d s 1507 1971 m 12 -7 d s [] 0 sd 1509 1999 m 21
- -69 d s 1486 1724 m 23 275 d s [4 8] 0 sd 1539 1959 m 2 3 d s 1567 1832 m 1 X s
- [] 0 sd 1600 1947 m s 573 948 m 20 -15 d s 549 942 m 24 6 d s 549 942 m 21 -15
- d s 596 954 m 21 -15 d s 573 948 m 23 6 d s 620 960 m 20 -15 d s 596 954 m 24 6
- d s [4 8] 0 sd 625 1096 m 20 -16 d s 631 1232 m 19 -16 d s 637 1367 m 17 -15 d
- s 642 1503 m 17 -15 d s [] 0 sd 643 1530 m 21 52 d s 620 960 m 23 570 d s
- [4 8] 0 sd 653 1640 m 31 -10 d s 664 1778 m 6 -2 d s [] 0 sd 667 1805 m 19 -196
- d s 643 1530 m 24 275 d s [4 8] 0 sd 728 1657 m 22 -5 d s [] 0 sd 737 1796 m 16
- -178 d s 723 1666 m 14 130 d s [4 8] 0 sd 750 1652 m 14 13 d s [] 0 sd 761 1681
- m 3 -14 d s 737 1796 m 24 -115 d s 784 1647 m 9 -41 d s 761 1681 m 5 -7 d s 778
- 1656 m 6 -9 d s 784 1647 m 22 -7 d s 855 1692 m 20 -29 d s 844 1670 m 11 22 d s
- [4 8] 0 sd 855 1692 m 33 -2 d s [] 0 sd 878 1738 m 21 -96 d s 855 1692 m 23 46
- d s 949 1810 m 20 -70 d s 944 1744 m 5 66 d s 996 1808 m 20 -15 d s 986 1773 m
- 10 35 d s [4 8] 0 sd 1098 1739 m 6 Y s [] 0 sd 1098 1745 m 12 45 d s [4 8] 0 sd
- 1119 1745 m 2 6 d s [] 0 sd 1113 1838 m 11 -115 d s 1097 1749 m 16 89 d s
- [4 8] 0 sd 1122 1751 m 28 2 d s [] 0 sd 1137 1871 m 20 -177 d s 1113 1838 m 24
- 33 d s [4 8] 0 sd 1150 1753 m 19 -2 d s [] 0 sd 1160 1796 m 20 12 d s 1137 1871
- m 23 -75 d s 1184 1829 m 5 -27 d s 1160 1796 m 24 33 d s [4 8] 0 sd 1221 1899 m
- 6 Y s [] 0 sd 1184 1829 m 7 -25 d s [4 8] 0 sd 1221 1905 m 2 X s [] 0 sd 1279
- 1809 m 19 109 d s [4 8] 0 sd 1365 2072 m 1 Y s 1365 2073 m s 1444 1974 m 10 -16
- d s [] 0 sd 1442 1962 m 20 92 d s 1432 1898 m 10 64 d s [4 8] 0 sd 1478 1830 m
- s 1468 1962 m 1 X s 1507 1971 m 1 Y s [] 0 sd 1559 1911 m 18 -164 d s 1559 1911
- m s 552 964 m 21 -16 d s 529 958 m 23 6 d s 529 958 m 20 -16 d s 576 970 m 20
- -16 d s 552 964 m 24 6 d s 599 976 m 21 -16 d s 576 970 m 23 6 d s [4 8] 0 sd
- 604 1111 m 21 -15 d s 608 1247 m 23 -15 d s 613 1382 m 22 -14 d s 617 1517 m 24
- -13 d s 621 1653 m 9 -5 d s [] 0 sd 623 1707 m 20 -177 d s 599 976 m 24 731 d s
- [4 8] 0 sd 653 1640 m -1 15 d s 664 1778 m 2 Y s [] 0 sd 646 1606 m 21 199 d s
- 623 1707 m 23 -101 d s 686 1622 m 3 -14 d s [4 8] 0 sd 777 1673 m 5 2 d s 749
- 1820 m 23 -3 d s [] 0 sd 764 1931 m 20 -284 d s 743 1771 m 21 160 d s
- [4 8] 0 sd 783 1675 m 21 7 d s 773 1818 m 19 8 d s [] 0 sd 787 1883 m 20 -237 d
- s 764 1931 m 23 -48 d s [4 8] 0 sd 805 1683 m 14 12 d s 792 1826 m 3 6 d s
- [] 0 sd 811 1728 m 10 -40 d s 787 1883 m 24 -155 d s [4 8] 0 sd 817 1702 m 38
- -10 d s [] 0 sd 905 1725 m 4 -48 d s 883 1719 m 22 6 d s 937 1735 m 12 75 d s
- 905 1725 m 13 -26 d s [4 8] 0 sd 1097 1753 m 1 2 d s [] 0 sd 1281 1861 m 10 12
- d s 1271 1836 m 10 25 d s [4 8] 0 sd 1341 1970 m 13 -2 d s [] 0 sd 1351 2067 m
- 5 -71 d s 1331 1876 m 20 191 d s 1492 1848 m 5 10 d s 1477 1853 m 15 -5 d s 532
- 979 m 20 -15 d s 509 973 m 23 6 d s 509 973 m 20 -15 d s 556 985 m 20 -15 d s
- 532 979 m 24 6 d s 579 991 m 20 -15 d s 556 985 m 23 6 d s [4 8] 0 sd 583 1127
- m 21 -16 d s 588 1262 m 20 -15 d s 592 1397 m 21 -15 d s 596 1533 m 20 -15 d s
- 600 1668 m 21 -15 d s [] 0 sd 603 1736 m 20 -29 d s 579 991 m 24 745 d s 683
- 1652 m 7 -39 d s 682 1663 m 8 -50 d s 861 1735 m 11 -9 d s 858 1700 m 3 35 d s
- [4 8] 0 sd 927 1751 m 10 -2 d s [] 0 sd 931 1793 m 7 -53 d s 923 1713 m 8 80 d
- s [4 8] 0 sd 937 1749 m 3 3 d s [] 0 sd 931 1793 m 11 -27 d s 1190 1818 m 2 -8
- d s 1188 1812 m 2 6 d s [4 8] 0 sd 1341 1970 m 1 3 d s [] 0 sd 1351 2067 m s
- 1519 1983 m 14 -49 d s 1517 1973 m 2 10 d s 512 995 m 20 -16 d s 488 989 m 24 6
- d s 488 989 m 21 -16 d s 535 1001 m 21 -16 d s 512 995 m 23 6 d s 559 1007 m 20
- -16 d s 535 1001 m 24 6 d s [4 8] 0 sd 568 1143 m 15 -16 d s 577 1280 m 10 -17
- d s 585 1414 m 6 -14 d s 592 1543 m 4 -10 d s 599 1672 m 1 -4 d s [] 0 sd 582
- 1362 m 21 374 d s 559 1007 m 23 355 d s [4 8] 0 sd 585 1414 m s 599 1672 m 2 X
- s [] 0 sd 491 1010 m 21 -15 d s 468 1004 m 23 6 d s 468 1004 m 20 -15 d s 515
- 1016 m 20 -15 d s 491 1010 m 24 6 d s 538 1022 m 21 -15 d s 515 1016 m 23 6 d s
- [4 8] 0 sd 549 1159 m 18 -15 d s 560 1296 m 17 -16 d s [] 0 sd 562 1324 m 20 38
- d s 538 1022 m 24 302 d s 562 1324 m 22 56 d s 471 1026 m 20 -16 d s 448 1020 m
- 23 6 d s 448 1020 m 20 -16 d s 495 1032 m 20 -16 d s 471 1026 m 24 6 d s 518
- 1038 m 20 -16 d s 495 1032 m 23 6 d s [4 8] 0 sd 531 1175 m 18 -16 d s 552 1305
- m 6 -7 d s [] 0 sd 542 1286 m 20 38 d s 518 1038 m 24 248 d s [4 8] 0 sd 545
- 1313 m 7 -8 d s 562 1452 m 10 -4 d s [] 0 sd 565 1480 m 19 -89 d s 542 1286 m
- 23 194 d s 451 1041 m 20 -15 d s 427 1035 m 24 6 d s 427 1035 m 21 -15 d s 474
- 1047 m 21 -15 d s 451 1041 m 23 6 d s 498 1053 m 20 -15 d s 474 1047 m 24 6 d s
- [4 8] 0 sd 519 1193 m 12 -18 d s [] 0 sd 521 1207 m 21 79 d s 498 1053 m 23 154
- d s [4 8] 0 sd 562 1452 m 2 Y s [] 0 sd 430 1057 m 21 -16 d s 407 1051 m 23 6 d
- s 407 1051 m 20 -16 d s 454 1063 m 20 -16 d s 430 1057 m 24 6 d s 477 1069 m 21
- -16 d s 454 1063 m 23 6 d s [4 8] 0 sd 499 1209 m 20 -16 d s [] 0 sd 501 1223 m
- 20 -16 d s 477 1069 m 24 154 d s [4 8] 0 sd 514 1212 m 8 X s [] 0 sd 410 1072 m
- 20 -15 d s 387 1066 m 23 6 d s 387 1066 m 20 -15 d s 434 1078 m 20 -15 d s 410
- 1072 m 24 6 d s 457 1084 m 20 -15 d s 434 1078 m 23 6 d s [4 8] 0 sd 496 1213 m
- 3 -4 d s [] 0 sd 481 1184 m 20 39 d s 457 1084 m 24 100 d s 390 1088 m 20 -16 d
- s 366 1082 m 24 6 d s 366 1082 m 21 -16 d s 413 1094 m 21 -16 d s 390 1088 m 23
- 6 d s 437 1100 m 20 -16 d s 413 1094 m 24 6 d s 460 1119 m 21 65 d s 437 1100 m
- 23 19 d s 484 1192 m 1 -1 d s 460 1119 m 24 73 d s 369 1103 m 21 -15 d s 346
- 1097 m 23 6 d s 346 1097 m 20 -15 d s 393 1109 m 20 -15 d s 369 1103 m 24 6 d s
- 416 1115 m 21 -15 d s 393 1109 m 23 6 d s 440 1175 m 20 -56 d s 416 1115 m 24
- 60 d s 463 1141 m 21 51 d s 440 1175 m 23 -34 d s 349 1119 m 20 -16 d s 326
- 1113 m 23 6 d s 326 1113 m 20 -16 d s 373 1125 m 20 -16 d s 349 1119 m 24 6 d s
- 396 1131 m 20 -16 d s 373 1125 m 23 6 d s 420 1137 m 20 38 d s 396 1131 m 24 6
- d s 467 1162 m 11 14 d s 452 1159 m 15 3 d s 329 1135 m 20 -16 d s 305 1129 m
- 24 6 d s 305 1129 m 21 -16 d s 352 1140 m 21 -15 d s 329 1135 m 23 5 d s 376
- 1146 m 20 -15 d s 352 1140 m 24 6 d s 399 1152 m 21 -15 d s 376 1146 m 23 6 d s
- 423 1172 m 11 -9 d s 399 1152 m 24 20 d s 447 1164 m 20 -2 d s 423 1172 m 13 -4
- d s 470 1184 m 9 -7 d s 447 1165 m 23 19 d s 470 1184 m 9 -3 d s 308 1150 m 21
- -15 d s 285 1144 m 23 6 d s 285 1144 m 20 -15 d s 332 1156 m 20 -16 d s 308
- 1150 m 24 6 d s 355 1162 m 21 -16 d s 332 1156 m 23 6 d s 379 1168 m 20 -16 d s
- 355 1162 m 24 6 d s 402 1187 m 21 -15 d s 379 1168 m 23 19 d s 426 1180 m 11 -8
- d s 402 1187 m 24 -7 d s 449 1186 m 21 -2 d s 426 1180 m 23 6 d s 473 1192 m 7
- -6 d s 449 1186 m 24 6 d s 473 1192 m 14 3 d s 288 1166 m 20 -16 d s 265 1160 m
- 23 6 d s 265 1160 m 20 -16 d s 312 1172 m 20 -16 d s 288 1166 m 24 6 d s 335
- 1178 m 20 -16 d s 312 1172 m 23 6 d s 359 1184 m 20 -16 d s 335 1178 m 24 6 d s
- 382 1190 m 20 -3 d s 359 1184 m 23 6 d s 405 1195 m 21 -15 d s 382 1190 m 23 5
- d s 429 1201 m 20 -15 d s 405 1195 m 24 6 d s 452 1207 m 21 -15 d s 429 1201 m
- 23 6 d s 476 1213 m 15 -11 d s 452 1207 m 24 6 d s 499 1219 m 1 X s 476 1213 m
- 23 6 d s 523 1225 m 2 X s 504 1221 m 19 4 d s 523 1225 m 3 3 d s 268 1181 m 20
- -15 d s 244 1175 m 24 6 d s 244 1175 m 21 -15 d s 291 1187 m 21 -15 d s 268
- 1181 m 23 6 d s 315 1193 m 20 -15 d s 291 1187 m 24 6 d s 338 1199 m 21 -15 d s
- 315 1193 m 23 6 d s 362 1205 m 20 -15 d s 338 1199 m 24 6 d s 385 1211 m 20 -16
- d s 362 1205 m 23 6 d s 409 1217 m 20 -16 d s 385 1211 m 24 6 d s 432 1223 m 20
- -16 d s 409 1217 m 23 6 d s 456 1229 m 20 -16 d s 432 1223 m 24 6 d s 479 1235
- m 20 -16 d s 456 1229 m 23 6 d s 503 1241 m 20 -16 d s 479 1235 m 24 6 d s 526
- 1260 m 7 -5 d s 503 1241 m 23 19 d s 526 1260 m 8 -2 d s [4 8] 0 sd 222 1314 m
- 333 85 d s 580 1405 m 4 1 d s 222 1449 m 370 94 d s 222 1583 m 377 96 d s 627
- 1686 m 29 7 d s 677 1699 m 51 13 d s 810 1733 m 117 29 d s 960 1771 m 27 7 d s
- 1022 1787 m 9 2 d s 1033 1789 m 35 9 d s 1092 1804 m 16 4 d s 1153 1820 m 29 7
- d s 1184 1828 m 12 3 d s 1199 1832 m 16 4 d s 1268 1849 m 9 2 d s 222 1717 m
- 531 135 d s 789 1862 m 556 141 d s 222 1852 m 1128 287 d s 222 1986 m 1128 287
- d s 222 2120 m 1128 287 d s [] 0 sd 222 1180 m 298 76 d s 531 1258 m 2 1 d s
- 1350 2045 m 416 Y s 222 2174 m 1128 287 d s 222 1180 m 994 Y s [4 8] 0 sd 1694
- 1338 m 307 -234 d s 1668 1493 m 333 -254 d s 1652 1639 m 349 -266 d s 1384 1978
- m 54 -41 d s 1472 1911 m 28 -21 d s 1569 1837 m 18 -14 d s 1609 1807 m 392 -300
- d s 1350 2139 m 20 -15 d s 1370 2124 m 91 -71 d s 1462 2053 m 87 -66 d s 1555
- 1982 m 46 -35 d s 1601 1947 m 400 -305 d s 1350 2273 m 651 -497 d s 1350 2407 m
- 651 -497 d s [] 0 sd 1731 1176 m 270 -206 d s 2001 970 m 994 Y s 1350 2461 m
- 651 -497 d s 222 1180 m 651 -497 d s 873 683 m 994 Y s 222 2174 m 651 -497 d s
- 222 1180 m 994 Y s 873 683 m 1128 287 d s 2001 970 m 994 Y s 873 1677 m 1128
- 287 d s 873 1677 m cl s 873 683 m 1128 287 d s 967 673 m 34 Y s 991 696 m 17 Y
- s 1014 702 m 17 Y s 1038 708 m 17 Y s 1061 714 m 17 Y s 1085 703 m 34 Y s 1108
- 726 m 17 Y s 1132 732 m 17 Y s 1155 738 m 17 Y s 1179 744 m 17 Y s 1202 733 m
- 34 Y s 1226 756 m 16 Y s 1249 762 m 16 Y s 1273 768 m 16 Y s 1296 774 m 16 Y s
- 1320 763 m 33 Y s 1343 786 m 16 Y s 1367 792 m 16 Y s 1390 798 m 16 Y s 1413
- 804 m 16 Y s 1437 793 m 33 Y s 1460 816 m 16 Y s 1484 822 m 16 Y s 1507 828 m
- 16 Y s 1531 834 m 16 Y s 1554 823 m 33 Y s 1578 846 m 16 Y s 1601 851 m 17 Y s
- 1625 857 m 17 Y s 1648 863 m 17 Y s 1672 853 m 33 Y s 1695 875 m 17 Y s 1719
- 881 m 17 Y s 1742 887 m 17 Y s 1766 893 m 17 Y s 1789 883 m 33 Y s 1813 905 m
- 17 Y s 1836 911 m 17 Y s 1860 917 m 17 Y s 1883 923 m 17 Y s 1907 913 m 33 Y s
- 967 673 m 34 Y s 944 684 m 17 Y s 920 678 m 17 Y s 897 672 m 17 Y s 873 666 m
- 17 Y s 1907 913 m 33 Y s 1930 935 m 17 Y s 1954 941 m 17 Y s 1977 947 m 17 Y s
- 2001 953 m 17 Y s 970 654 m -5 -1 d -3 -4 d -1 -8 d -4 Y 1 -8 d 3 -4 d 5 -2 d 3
- X 4 2 d 3 4 d 1 8 d 4 Y -1 8 d -3 4 d -4 1 d -3 X cl s 1061 684 m -4 -1 d -3 -5
- d -1 -7 d -4 Y 1 -8 d 3 -4 d 4 -2 d 3 X 5 2 d 3 4 d 1 8 d 4 Y -1 7 d -3 5 d -5
- 1 d -3 X cl s 1085 656 m -1 -1 d 1 -2 d 2 2 d -2 1 d cl s 1099 677 m 1 Y 1 3 d
- 1 2 d 3 1 d 6 X 3 -1 d 2 -2 d 1 -3 d -3 Y -1 -2 d -3 -5 d -15 -15 d 21 X s 1144
- 684 m -14 X -2 -13 d 2 2 d 4 1 d 5 X 4 -1 d 3 -3 d 1 -5 d -3 Y -1 -4 d -3 -3 d
- -4 -2 d -5 X -4 2 d -2 1 d -1 3 d s 1190 714 m -5 -1 d -3 -5 d -1 -7 d -5 Y 1
- -7 d 3 -4 d 5 -2 d 3 X 4 2 d 3 4 d 2 7 d 5 Y -2 7 d -3 5 d -4 1 d -3 X cl s
- 1214 686 m -2 -1 d 2 -2 d 1 2 d -1 1 d cl s 1243 714 m -15 X -1 -13 d 1 1 d 5 2
- d 4 X 5 -2 d 3 -3 d 1 -4 d -3 Y -1 -4 d -3 -3 d -5 -2 d -4 X -5 2 d -1 1 d -2 3
- d s 1296 744 m -4 -1 d -3 -5 d -2 -7 d -5 Y 2 -7 d 3 -4 d 4 -2 d 3 X 5 2 d 3 4
- d 1 7 d 5 Y -1 7 d -3 5 d -5 1 d -3 X cl s 1320 716 m -1 -1 d 1 -2 d 2 2 d -2 1
- d cl s 1353 744 m -15 -31 d s 1332 744 m 21 X s 1379 744 m -14 X -2 -13 d 2 1 d
- 4 2 d 4 X 5 -2 d 3 -3 d 1 -4 d -3 Y -1 -5 d -3 -2 d -5 -2 d -4 X -4 2 d -2 1 d
- -1 3 d s 1435 768 m 3 2 d 4 4 d -31 Y s 1527 798 m 3 2 d 4 4 d -31 Y s 1555 776
- m -2 -2 d 2 -1 d 1 1 d -1 2 d cl s 1568 797 m 1 Y 2 3 d 1 1 d 3 2 d 6 X 3 -2 d
- 2 -1 d 1 -3 d -3 Y -1 -3 d -3 -4 d -15 -15 d 21 X s 1614 804 m -15 X -1 -13 d 1
- 1 d 5 2 d 4 X 5 -2 d 3 -3 d 1 -4 d -3 Y -1 -5 d -3 -3 d -5 -1 d -4 X -5 1 d -1
- 2 d -2 3 d s 1655 828 m 3 1 d 5 5 d -31 Y s 1683 806 m -1 -2 d 1 -1 d 2 1 d -2
- 2 d cl s 1713 834 m -15 X -1 -13 d 1 1 d 5 1 d 4 X 5 -1 d 3 -3 d 1 -4 d -3 Y -1
- -5 d -3 -3 d -5 -1 d -4 X -5 1 d -1 2 d -2 3 d s 1762 858 m 3 1 d 4 5 d -31 Y s
- 1790 836 m -2 -2 d 2 -1 d 1 1 d -1 2 d cl s 1822 864 m -14 -31 d s 1802 864 m
- 20 X s 1849 864 m -15 X -1 -14 d 1 2 d 5 1 d 4 X 5 -1 d 3 -3 d 1 -5 d -2 Y -1
- -5 d -3 -3 d -5 -1 d -4 X -5 1 d -1 2 d -2 3 d s 1902 886 m 2 Y 1 3 d 2 1 d 3 2
- d 6 X 3 -2 d 1 -1 d 1 -3 d -3 Y -1 -3 d -3 -5 d -15 -14 d 21 X s 873 683 m -651
- 497 d s 873 649 m 34 Y s 857 679 m 16 Y s 841 691 m 17 Y s 824 703 m 17 Y s 808
- 716 m 17 Y s 792 712 m 33 Y s 776 741 m 16 Y s 759 753 m 17 Y s 743 766 m 16 Y
- s 727 778 m 17 Y s 711 774 m 33 Y s 694 803 m 17 Y s 678 815 m 17 Y s 662 828 m
- 16 Y s 645 840 m 17 Y s 629 836 m 33 Y s 613 865 m 17 Y s 597 877 m 17 Y s 580
- 890 m 17 Y s 564 902 m 17 Y s 548 898 m 33 Y s 532 927 m 17 Y s 515 940 m 16 Y
- s 499 952 m 17 Y s 483 964 m 17 Y s 466 960 m 33 Y s 450 989 m 17 Y s 434 1002
- m 16 Y s 418 1014 m 17 Y s 401 1027 m 16 Y s 385 1022 m 34 Y s 369 1051 m 17 Y
- s 352 1064 m 16 Y s 336 1076 m 17 Y s 320 1089 m 16 Y s 304 1084 m 34 Y s 287
- 1114 m 16 Y s 271 1126 m 17 Y s 255 1138 m 17 Y s 239 1151 m 16 Y s 222 1147 m
- 33 Y s 873 649 m 34 Y s 826 573 m 27 X s 865 583 m 2 Y 1 3 d 2 1 d 3 2 d 6 X 3
- -2 d 1 -1 d 2 -3 d -3 Y -2 -3 d -3 -5 d -15 -15 d 21 X s 704 635 m 26 X s 745
- 647 m 3 1 d 5 5 d -31 Y s 773 625 m -1 -2 d 1 -1 d 2 1 d -2 2 d cl s 803 653 m
- -15 X -1 -14 d 1 2 d 5 1 d 4 X 5 -1 d 2 -3 d 2 -5 d -3 Y -2 -4 d -2 -3 d -5 -1
- d -4 X -5 1 d -1 2 d -2 2 d s 663 697 m 27 X s 705 709 m 3 1 d 4 5 d -31 Y s
- 541 759 m 27 X s 587 777 m -5 -2 d -2 -4 d -2 -7 d -5 Y 2 -7 d 2 -5 d 5 -1 d 3
- X 4 1 d 3 5 d 2 7 d 5 Y -2 7 d -3 4 d -4 2 d -3 X cl s 611 749 m -2 -2 d 2 -1 d
- 1 1 d -1 2 d cl s 640 777 m -15 X -1 -13 d 1 1 d 5 2 d 4 X 5 -2 d 3 -3 d 1 -4 d
- -3 Y -1 -5 d -3 -3 d -5 -1 d -4 X -5 1 d -1 2 d -2 3 d s 537 839 m -5 -1 d -3
- -5 d -1 -7 d -5 Y 1 -7 d 3 -5 d 5 -1 d 3 X 4 1 d 3 5 d 2 7 d 5 Y -2 7 d -3 5 d
- -4 1 d -3 X cl s 414 901 m -4 -1 d -3 -5 d -2 -7 d -5 Y 2 -7 d 3 -4 d 4 -2 d 3
- X 5 2 d 3 4 d 1 7 d 5 Y -1 7 d -3 5 d -5 1 d -3 X cl s 438 873 m -1 -1 d 1 -2 d
- 2 2 d -2 1 d cl s 468 901 m -15 X -2 -13 d 2 1 d 4 2 d 5 X 4 -2 d 3 -3 d 2 -4 d
- -3 Y -2 -4 d -3 -3 d -4 -2 d -5 X -4 2 d -2 1 d -1 3 d s 370 957 m 3 2 d 4 4 d
- -31 Y s 247 1020 m 3 1 d 5 5 d -32 Y s 275 997 m -1 -1 d 1 -2 d 2 2 d -2 1 d cl
- s 305 1026 m -15 X -1 -14 d 1 2 d 5 1 d 4 X 4 -1 d 3 -3 d 2 -5 d -3 Y -2 -4 d
- -3 -3 d -4 -2 d -4 X -5 2 d -1 1 d -2 3 d s 204 1080 m 2 Y 1 3 d 2 1 d 3 2 d 6
- X 3 -2 d 1 -1 d 2 -3 d -3 Y -2 -3 d -3 -5 d -15 -14 d 21 X s 222 1180 m 994 Y s
- 189 1180 m 33 X s 206 1207 m 16 X s 206 1234 m 16 X s 206 1261 m 16 X s 206
- 1287 m 16 X s 189 1314 m 33 X s 206 1341 m 16 X s 206 1368 m 16 X s 206 1395 m
- 16 X s 206 1422 m 16 X s 189 1449 m 33 X s 206 1476 m 16 X s 206 1502 m 16 X s
- 206 1529 m 16 X s 206 1556 m 16 X s 189 1583 m 33 X s 206 1610 m 16 X s 206
- 1637 m 16 X s 206 1664 m 16 X s 206 1690 m 16 X s 189 1717 m 33 X s 206 1744 m
- 16 X s 206 1771 m 16 X s 206 1798 m 16 X s 206 1825 m 16 X s 189 1852 m 33 X s
- 206 1879 m 16 X s 206 1905 m 16 X s 206 1932 m 16 X s 206 1959 m 16 X s 189
- 1986 m 33 X s 206 2013 m 16 X s 206 2040 m 16 X s 206 2067 m 16 X s 206 2094 m
- 16 X s 189 2120 m 33 X s 189 2120 m 33 X s 206 2147 m 16 X s 150 1195 m -4 -1 d
- -3 -4 d -1 -8 d -4 Y 1 -8 d 3 -4 d 4 -2 d 3 X 5 2 d 3 4 d 1 8 d 4 Y -1 8 d -3 4
- d -5 1 d -3 X cl s 116 1324 m 3 1 d 5 5 d -31 Y s 150 1330 m -4 -2 d -3 -4 d -1
- -7 d -5 Y 1 -7 d 3 -5 d 4 -1 d 3 X 5 1 d 3 5 d 1 7 d 5 Y -1 7 d -3 4 d -5 2 d
- -3 X cl s 113 1457 m 1 Y 2 3 d 1 2 d 3 1 d 6 X 3 -1 d 2 -2 d 1 -3 d -3 Y -1 -3
- d -3 -4 d -15 -15 d 21 X s 150 1464 m -4 -1 d -3 -5 d -1 -7 d -5 Y 1 -7 d 3 -4
- d 4 -2 d 3 X 5 2 d 3 4 d 1 7 d 5 Y -1 7 d -3 5 d -5 1 d -3 X cl s 115 1599 m 16
- X -9 -12 d 5 X 3 -2 d 1 -1 d 2 -5 d -3 Y -2 -4 d -3 -3 d -4 -2 d -5 X -4 2 d -2
- 1 d -1 3 d s 150 1599 m -4 -2 d -3 -4 d -1 -8 d -4 Y 1 -8 d 3 -4 d 4 -2 d 3 X 5
- 2 d 3 4 d 1 8 d 4 Y -1 8 d -3 4 d -5 2 d -3 X cl s 127 1733 m -15 -21 d 22 X s
- 127 1733 m -31 Y s 150 1733 m -4 -2 d -3 -4 d -1 -7 d -5 Y 1 -7 d 3 -5 d 4 -1 d
- 3 X 5 1 d 3 5 d 1 7 d 5 Y -1 7 d -3 4 d -5 2 d -3 X cl s 130 1867 m -15 X -2
- -13 d 2 1 d 4 2 d 5 X 4 -2 d 3 -3 d 2 -4 d -3 Y -2 -4 d -3 -3 d -4 -2 d -5 X -4
- 2 d -2 1 d -1 3 d s 150 1867 m -4 -1 d -3 -5 d -1 -7 d -4 Y 1 -8 d 3 -4 d 4 -2
- d 3 X 5 2 d 3 4 d 1 8 d 4 Y -1 7 d -3 5 d -5 1 d -3 X cl s 131 1997 m -1 3 d -5
- 2 d -3 X -4 -2 d -3 -4 d -2 -8 d -7 Y 2 -6 d 3 -3 d 4 -1 d 2 X 4 1 d 3 3 d 2 4
- d 2 Y -2 4 d -3 3 d -4 2 d -2 X -4 -2 d -3 -3 d -2 -4 d s 150 2002 m -4 -2 d -3
- -4 d -1 -8 d -4 Y 1 -8 d 3 -4 d 4 -1 d 3 X 5 1 d 3 4 d 1 8 d 4 Y -1 8 d -3 4 d
- -5 2 d -3 X cl s 133 2136 m -15 -31 d s 112 2136 m 21 X s 150 2136 m -4 -1 d -3
- -5 d -1 -7 d -5 Y 1 -7 d 3 -5 d 4 -1 d 3 X 5 1 d 3 5 d 1 7 d 5 Y -1 7 d -3 5 d
- -5 1 d -3 X cl s 1040 539 m 9 -21 d s 1057 539 m -8 -21 d -3 -6 d -3 -3 d -3 -1
- d -2 X s 1077 549 m 12 -31 d s 1100 549 m -11 -31 d s 1127 545 m -3 3 d -4 1 d
- -6 X -5 -1 d -3 -3 d -3 Y 2 -3 d 1 -1 d 3 -2 d 9 -3 d 3 -1 d 2 -2 d 1 -3 d -4 Y
- -3 -3 d -4 -2 d -6 X -5 2 d -3 3 d s 1139 521 m -2 -1 d 2 -2 d 1 2 d -1 1 d cl
- s 1166 539 m 16 -21 d s 1182 539 m -16 -21 d s gr
-showpage
- gr
-%%Trailer
-%%Pages: 1
- gr gr
-%%EOF
diff --git a/src/pawlib/paw/testsuite/paw.commands/nt_pl_2d_surf1.ref.ps b/src/pawlib/paw/testsuite/paw.commands/nt_pl_2d_surf1.ref.ps
deleted file mode 100644
index a338a19..0000000
--- a/src/pawlib/paw/testsuite/paw.commands/nt_pl_2d_surf1.ref.ps
+++ /dev/null
@@ -1,3508 +0,0 @@
-%!PS-Adobe-2.0
-%%Title: /disk3/maartenb/cerncvs/paw/testsuite/tmp/nt_pl_2d_ (Portrait A 4)
-%%Pages: (atend)
-%%Creator: HIGZ Version 1.23/06
-%%CreationDate: 96/04/16 14.49
-%%EndComments
-%%BeginProlog
-/s {stroke} def /l {lineto} def /m {moveto} def /t {translate} def
-/sw {stringwidth} def /r {rotate} def /rl {roll} def /R {repeat} def
-/d {rlineto} def /rm {rmoveto} def /gr {grestore} def /f {eofill} def
-/c {setrgbcolor} def /lw {setlinewidth} def /sd {setdash} def
-/cl {closepath} def /sf {scalefont setfont} def /black {0 setgray} def
-/box {m dup 0 exch d exch 0 d 0 exch neg d cl} def
-/NC{systemdict begin initclip end}def/C{NC box clip newpath}def
-/bl {box s} def /bf {box f} def /Y { 0 exch d} def /X { 0 d} def
-/mp {newpath /y exch def /x exch def} def
-/side {[w .77 mul w .23 mul] .385 w mul sd w 0 l currentpoint t -144 r} def
-/mr {mp x y w2 0 360 arc} def /m24 {mr s} def /m20 {mr f} def
-/mb {mp x y w2 add m w2 neg 0 d 0 w neg d w 0 d 0 w d cl} def
-/mt {mp x y w2 add m w2 neg w neg d w 0 d cl} def
-/m21 {mb f} def /m25 {mb s} def /m22 {mt f} def /m26 {mt s} def
-/m23 {mp x y w2 sub m w2 w d w neg 0 d cl f} def
-/m27 {mp x y w2 add m w3 neg w2 neg d w3 w2 neg d w3 w2 d cl s} def
-/m28 {mp x w2 sub y w2 sub w3 add m w3 0 d 0 w3 neg d w3 0 d 0 w3 d w3 0 d
- 0 w3 d w3 neg 0 d 0 w3 d w3 neg 0 d
- 0 w3 neg d w3 neg 0 d cl s } def
-/m29 {mp gsave x w2 sub y w2 add w3 sub m currentpoint t
- 4 {side} repeat cl fill gr} def
-/m30 {mp gsave x w2 sub y w2 add w3 sub m currentpoint t
- 5 {side} repeat s gr} def
-/m31 {mp x y w2 sub m 0 w d x w2 sub y m w 0 d
- x w2 sub y w2 add m w w neg d x w2 sub y w2
- sub m w w d s} def
-/m2 {mp x y w2 sub m 0 w d x w2 sub y m w 0 d s} def
-/m5 {mp x w2 sub y w2 sub m w w d x w2 sub y w2 add m w w neg d s} def
-/DP {/PT exch def gsave 47.2 47.2 scale PT 1 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < AA AA 55 55 AA AA 55 55 AA AA 55 55 AA AA 55 55 AA AA 55 55 AA AA 55 55
-AA AA 55 55 AA AA 55 55 > } image } if PT 2 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < BB BB EE EE BB BB EE EE BB BB EE EE BB BB EE EE BB BB EE EE BB BB EE EE
-BB BB EE EE BB BB EE EE > } image } if PT 3 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < FF FF BB BB FF FF EE EE FF FF BB BB FF FF EE EE FF FF BB BB FF FF EE EE
-FF FF BB BB FF FF EE EE > } image } if PT 4 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < DF DF BF BF 7F 7F FE FE FD FD FB FB F7 F7 EF EF DF DF BF BF 7F 7F FE FE
-FD FD FB FB F7 F7 EF EF > } image } if PT 5 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < 7F 7F BF B F DF DF EF EF F7 F7 FB FB FD FD FE FE 7F 7F BF BF DF DF EF
-EF F7 F7 FB FB FD FD FE FE > } image } if PT 6 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB
-BB BB BB BB BB BB BB BB BB > } image } if PT 7 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < FF FF FF FF FF FF 00 00 FF FF FF FF FF FF 00 00 FF FF FF FF FF FF 00
-00 FF FF FF FF FF FF 00 00 > } image } if PT 8 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < EE EE 47 47 83 83 C5 C5 EE EE 5C 5C 38 38 74 74 EE EE 47 47 83 83 C5
-C5 EE EE 5C 5C 38 38 74 74 > } image } if PT 9 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < EF EF EF EF D7 D7 38 38 FE FE FE FE 7D 7D 83 83 EF EF EF EF D7 D7 38
-38 FE FE FE FE 7D 7D 83 83 > } image } if PT 10 eq { 16 16 1 [ 16 0 0 16 neg
-0 16 ] { < EF EF EF EF EF EF 00 00 FE FE FE FE FE FE 00 00 EF EF EF EF EF EF
-00 00 FE FE FE FE FE FE 00 00 > } image } if PT 11 eq { 16 16 1 [ 16 0 0 16
-neg 0 16 ] { < F7 F7 B6 B6 D5 D5 E3 E3 D5 D5 B6 B6 F7 F7 FF FF 7F 7F 6B 6B 5D
-5D 3E 3E 5D 5D 6B 6B 7F 7F FF FF > } image } if PT 12 eq { 16 16 1 [ 16 0 0
-16 neg 0 16 ] { < E3 E3 DD DD BE BE BE BE BE BE DD DD E3 E3 FF FF 3E 3E DD DD
-EB EB EB EB EB EB DD DD 3E 3E FF FF > } image } if PT 13 eq { 16 16 1 [ 16 0
-0 16 neg 0 16 ] { < FE FE 7D 7D BB BB D7 D7 EF EF D7 D7 BB BB 7D 7D FE FE 7D
-7D BB BB D7 D7 EF EF D7 D7 BB BB 7D 7D > } image } if PT 14 eq { 16 16 1 [ 16
-0 0 16 neg 0 16 ] { < 00 00 EE EF EE EF EE EF 0E E0 EE EE EE EE EE EE 00 EE
-FE EE FE EE FE EE 00 00 FE EF FE EF FE EF > } image } if PT 15 eq { 16 16 1 [
-16 0 0 16 neg 0 16 ] { < DD DD AA AA DD DD FF FF 77 77 AA AA 77 77 FF FF DD
-DD AA AA DD DD FF FF 77 77 AA AA 77 77 FF FF > } image } if PT 16 eq { 16 16
-1 [ 16 0 0 16 neg 0 16 ] { < F1 F1 EE EE 1F 1F FF FF F1 F1 EE EE 1F 1F FF FF
-F1 F1 EE EE 1F 1F FF FF F1 F1 EE EE 1F 1F FF FF > } image } if PT 17 eq { 16
-16 1 [ 16 0 0 16 neg 0 16 ] { < EE EE DD DD BB BB FF FF EE EE DD DD BB BB FF
- FF EE EE DD DD BB BB FF FF EE EE DD DD BB BB FF FF > } image } if PT 18 eq {
-16 16 1 [ 16 0 0 16 neg 0 16 ] { < BB BB DD DD EE EE FF FF BB BB DD DD EE EE
-FF FF BB BB DD DD EE EE FF FF BB BB DD DD EE EE FF FF > } image } if PT 19 eq
-{ 16 16 1 [ 16 0 0 16 neg 0 16 ] { < 1F FC 67 F3 7B EF BD DE BD DE DE BD E6
-B3 F8 0F E6 B3 DE BD BD DE BD DE 7B EF 67 F3 1F FC 7F FF > } image } if PT
-20 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < DD DD EE EE EE EE EE EE DD DD BB
-BB BB BB BB BB DD DD EE EE EE EE EE EE DD DD BB BB BB BB BB BB > } image }
-if PT 21 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < 0E 0E EF EF EF EF EF EF E0
-E0 FE FE FE FE FE FE 0E 0E EF EF EF EF EF EF E0 E0 FE FE FE FE FE FE > }
-image } if PT 22 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < 70 70 F7 F7 F7 F7 F7
-F7 07 07 7F 7F 7F 7F 7F 7F 70 70 F7 F7 F7 F7 F7 F7 07 07 7F 7F 7F 7F 7F 7F >
-} image } if PT 23 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < AA AA 55 55 A9 A9
-D1 D1 E1 E1 D1 D1 A9 A9 55 55 AA AA 55 55 A9 A9 D1 D1 E1 E1 D1 D1 A9 A9 55 55
-> } image } if PT 24 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < FF FE FF FC EA
-A8 D5 54 EA A8 D5 54 E8 28 D4 54 E8 E8 D4 D4 E8 EA 54 D5 A8 EA 54 D5 00 C0 00
-80 > } image } if PT 25 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < FF FE FF FC
-FF F8 FF F0 F0 00 F0 00 F0 20 F0 60 F0 E0 F1 E0 F3 E0 F0 00 E0 00 C0 00 80 00
-00 00 > } image } if gr } def /FA { /PT exch def gsave clip 0 0 translate 1 1
-54 { 1 sub 47.2 mul /Xcurr exch def 1 1 74 { 1 sub 47.2 mul /Ycurr exch def
-gsave Xcurr Ycurr translate PT DP gr } for } for gr } def
-/reencdict 24 dict def /ReEncode {reencdict begin /nco&na exch def
-/nfnam exch def /basefontname exch def /basefontdict basefontname findfont def
-/newfont basefontdict maxlength dict def basefontdict {exch dup /FID ne
-{dup /Encoding eq {exch dup length array copy newfont 3 1 roll put} {exch
-newfont 3 1 roll put} ifelse} {pop pop} ifelse } forall newfont
-/FontName nfnam put nco&na aload pop nco&na length 2 idiv {newfont
-/Encoding get 3 1 roll put} repeat nfnam newfont definefont pop end } def
-/accvec [ 176 /agrave 181 /Agrave 190 /acircumflex 192 /Acircumflex
-201 /adieresis 204 /Adieresis 209 /ccedilla 210 /Ccedilla 211 /eacute
-212 /Eacute 213 /egrave 214 /Egrave 215 /ecircumflex 216 /Ecircumflex
-217 /edieresis 218 /Edieresis 219 /icircumflex 220 /Icircumflex
-221 /idieresis 222 /Idieresis 223 /ntilde 224 /Ntilde 226 /ocircumflex
-228 /Ocircumflex 229 /odieresis 230 /Odieresis 231 /ucircumflex 236 /Ucircumflex
-237 /udieresis 238 /Udieresis 239 /aring 242 /Aring 243 /ydieresis
-244 /Ydieresis 246 /aacute 247 /Aacute 252 /ugrave 253 /Ugrave] def
-/Times-Roman /Times-Roman accvec ReEncode
-/Times-Italic /Times-Italic accvec ReEncode
-/Times-Bold /Times-Bold accvec ReEncode
-/Times-BoldItalic /Times-BoldItalic accvec ReEncode
-/Helvetica /Helvetica accvec ReEncode
-/Helvetica-Oblique /Helvetica-Oblique accvec ReEncode
-/Helvetica-Bold /Helvetica-Bold accvec ReEncode
-/Helvetica-BoldOblique /Helvetica-BoldOblique accvec ReEncode
-/Courier /Courier accvec ReEncode
-/Courier-Oblique /Courier-Oblique accvec ReEncode
-/Courier-Bold /Courier-Bold accvec ReEncode
-/Courier-BoldOblique /Courier-BoldOblique accvec ReEncode
-/oshow {gsave [] 0 sd true charpath stroke gr} def
-/stwn { /fs exch def /fn exch def /text exch def fn findfont fs sf
- text sw pop xs add /xs exch def} def
-/stwb { /fs exch def /fn exch def /nbas exch def /textf exch def
-textf length /tlen exch def nbas tlen gt {/nbas tlen def} if
-fn findfont fs sf textf dup length nbas sub nbas getinterval sw
-pop neg xs add /xs exch def} def
-/accspe [ 65 /plusminus 66 /bar 67 /existential 68 /universal
-69 /exclam 70 /numbersign 71 /greater 72 /question 73 /integral
-74 /colon 75 /semicolon 76 /less 77 /bracketleft 78 /bracketright
-79 /greaterequal 80 /braceleft 81 /braceright 82 /radical
-83 /spade 84 /heart 85 /diamond 86 /club 87 /lessequal
-88 /multiply 89 /percent 90 /infinity 48 /circlemultiply 49 /circleplus
-50 /emptyset 51 /lozenge 52 /bullet 53 /arrowright 54 /arrowup
-55 /arrowleft 56 /arrowdown 57 /arrowboth 48 /degree 44 /comma 43 /plus
- 45 /angle 42 /angleleft 47 /divide 61 /notequal 40 /equivalence 41 /second
- 97 /approxequal 98 /congruent 99 /perpendicular 100 /partialdiff 101 /florin
- 102 /intersection 103 /union 104 /propersuperset 105 /reflexsuperset
- 106 /notsubset 107 /propersubset 108 /reflexsubset 109 /element 110 /notelement
- 111 /gradient 112 /logicaland 113 /logicalor 114 /arrowdblboth
- 115 /arrowdblleft 116 /arrowdblup 117 /arrowdblright 118 /arrowdbldown
- 119 /ampersand 120 /omega1 121 /similar 122 /aleph ] def
-/Symbol /Special accspe ReEncode
-/Zone {/iy exch def /ix exch def ix 1 sub 2224 mul 1 iy sub 3144
- mul t} def
-%%EndProlog
- gsave 20 28 t .25 .25 scale gsave
-%%Page: number 1
- gsave
- 1 1 Zone
- gsave 0 0 t black [] 0 sd 1 lw 2223 2224 0 460 bl 2223 2224 0 460 C 1779 1778
- 222 683 C NC [4 8] 0 sd 222 1314 m 1128 287 d s 222 1449 m 1128 287 d s 222
- 1583 m 1128 287 d s 222 1717 m 1128 287 d s 222 1852 m 1128 287 d s 222 1986 m
- 1128 287 d s 222 2120 m 1128 287 d s [] 0 sd 222 1180 m 1128 287 d s 1350 1467
- m 994 Y s 222 2174 m 1128 287 d s 222 1180 m 994 Y s [4 8] 0 sd 1350 1601 m 651
- -497 d s 1350 1736 m 651 -497 d s 1350 1870 m 651 -497 d s 1350 2004 m 651 -497
- d s 1350 2139 m 651 -497 d s 1350 2273 m 651 -497 d s 1350 2407 m 651 -497 d s
- [] 0 sd 1350 1467 m 651 -497 d s 2001 970 m 994 Y s 1350 2461 m 651 -497 d s
- 1350 1467 m cl s 0 0 0.8 c 1345 1435 m 24 6 d -21 15 d -23 -6 d f black 1345
- 1435 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 1322 1429 m 23 6 d -20 15 d -24
- -6 d f black 1322 1429 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1298 1423 m 24
- 6 d -21 15 d -23 -6 d f black 1298 1423 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8
- c 1275 1417 m 23 6 d -20 15 d -24 -6 d f black 1275 1417 m 23 6 d -20 15 d -24
- -6 d cl s 0 0 0.8 c 1251 1411 m 24 6 d -21 15 d -23 -6 d f black 1251 1411 m 24
- 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 1228 1405 m 23 6 d -20 15 d -24 -6 d f
- black 1228 1405 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1204 1399 m 24 6 d
- -21 15 d -23 -6 d f black 1204 1399 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c
- 1181 1393 m 23 6 d -20 15 d -24 -6 d f black 1181 1393 m 23 6 d -20 15 d -24 -6
- d cl s 0 0 0.8 c 1157 1387 m 24 6 d -21 15 d -23 -6 d f black 1157 1387 m 24 6
- d -21 15 d -23 -6 d cl s 0 0 0.8 c 1134 1381 m 23 6 d -20 15 d -24 -6 d f black
- 1134 1381 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1110 1375 m 24 6 d -21 15 d
- -23 -6 d f black 1110 1375 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 1087 1369
- m 23 6 d -20 15 d -24 -6 d f black 1087 1369 m 23 6 d -20 15 d -24 -6 d cl s 0
- 0 0.8 c 1063 1363 m 24 6 d -21 15 d -23 -6 d f black 1063 1363 m 24 6 d -21 15
- d -23 -6 d cl s 0 0 0.8 c 1040 1357 m 23 6 d -20 15 d -24 -6 d f black 1040
- 1357 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1016 1351 m 24 6 d -21 15 d -23
- -6 d f black 1016 1351 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 993 1345 m 23
- 6 d -20 15 d -24 -5 d f black 993 1345 m 23 6 d -20 15 d -24 -5 d cl s 0 0 0.8
- c 969 1339 m 24 6 d -21 16 d -23 -6 d f black 969 1339 m 24 6 d -21 16 d -23 -6
- d cl s 0 0 0.8 c 946 1333 m 23 6 d -20 16 d -24 -6 d f black 946 1333 m 23 6 d
- -20 16 d -24 -6 d cl s 0 0 0.8 c 922 1327 m 24 6 d -21 16 d -23 -6 d f black
- 922 1327 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 899 1321 m 23 6 d -20 16 d
- -24 -6 d f black 899 1321 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 875 1315 m
- 24 6 d -21 16 d -23 -6 d f black 875 1315 m 24 6 d -21 16 d -23 -6 d cl s 0 0
- 0.8 c 852 1309 m 23 6 d -20 16 d -24 -6 d f black 852 1309 m 23 6 d -20 16 d
- -24 -6 d cl s 0 0 0.8 c 828 1303 m 24 6 d -21 16 d -23 -6 d f black 828 1303 m
- 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 805 1297 m 23 6 d -20 16 d -24 -6 d f
- black 805 1297 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 781 1291 m 24 6 d -21
- 16 d -23 -6 d f black 781 1291 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 758
- 1285 m 23 6 d -20 16 d -24 -6 d f black 758 1285 m 23 6 d -20 16 d -24 -6 d
- cl s 0 0 0.8 c 734 1279 m 24 6 d -21 16 d -23 -6 d f black 734 1279 m 24 6 d
- -21 16 d -23 -6 d cl s 0 0 0.8 c 711 1273 m 23 6 d -20 16 d -23 -6 d f black
- 711 1273 m 23 6 d -20 16 d -23 -6 d cl s 0 0 0.8 c 687 1267 m 24 6 d -20 16 d
- -24 -6 d f black 687 1267 m 24 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 664 1261 m
- 23 6 d -20 16 d -23 -6 d f black 664 1261 m 23 6 d -20 16 d -23 -6 d cl s 0 0
- 0.8 c 640 1255 m 24 6 d -20 16 d -24 -6 d f black 640 1255 m 24 6 d -20 16 d
- -24 -6 d cl s 0 0 0.8 c 617 1249 m 23 6 d -20 16 d -23 -6 d f black 617 1249 m
- 23 6 d -20 16 d -23 -6 d cl s 0 0 0.8 c 593 1257 m 24 -8 d -20 16 d -24 -6 d f
- black 593 1257 m 24 -8 d -20 16 d -24 -6 d cl s 0 0 0.8 c 570 1237 m 23 20 d
- -20 2 d -23 -6 d f black 570 1237 m 23 20 d -20 2 d -23 -6 d cl s 0 0 0.8 c 546
- 1245 m 24 -8 d -20 16 d -24 7 d f black 546 1245 m 24 -8 d -20 16 d -24 7 d
- cl s 0 0 0.8 c 523 1225 m 23 20 d -20 15 d -23 -19 d f black 523 1225 m 23 20 d
- -20 15 d -23 -19 d cl s 0 0 0.8 c 499 1219 m 24 6 d -20 16 d -24 -6 d f black
- 499 1219 m 24 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 476 1213 m 23 6 d -20 16 d
- -23 -6 d f black 476 1213 m 23 6 d -20 16 d -23 -6 d cl s 0 0 0.8 c 452 1207 m
- 24 6 d -20 16 d -24 -6 d f black 452 1207 m 24 6 d -20 16 d -24 -6 d cl s 0 0
- 0.8 c 429 1201 m 23 6 d -20 16 d -23 -6 d f black 429 1201 m 23 6 d -20 16 d
- -23 -6 d cl s 0 0 0.8 c 405 1195 m 24 6 d -20 16 d -24 -6 d f black 405 1195 m
- 24 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 382 1190 m 23 5 d -20 16 d -23 -6 d f
- black 382 1190 m 23 5 d -20 16 d -23 -6 d cl s 0 0 0.8 c 359 1184 m 23 6 d -20
- 15 d -24 -6 d f black 359 1184 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 335
- 1178 m 24 6 d -21 15 d -23 -6 d f black 335 1178 m 24 6 d -21 15 d -23 -6 d
- cl s 0 0 0.8 c 312 1172 m 23 6 d -20 15 d -24 -6 d f black 312 1172 m 23 6 d
- -20 15 d -24 -6 d cl s 0 0 0.8 c 288 1166 m 24 6 d -21 15 d -23 -6 d f black
- 288 1166 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 265 1160 m 23 6 d -20 15 d
- -24 -6 d f black 265 1160 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1365 1419 m
- 24 6 d -20 16 d -24 -6 d f black 1365 1419 m 24 6 d -20 16 d -24 -6 d cl s 0 0
- 0.8 c 1342 1413 m 23 6 d -20 16 d -23 -6 d f black 1342 1413 m 23 6 d -20 16 d
- -23 -6 d cl s 0 0 0.8 c 1318 1407 m 24 6 d -20 16 d -24 -6 d f black 1318 1407
- m 24 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1295 1401 m 23 6 d -20 16 d -23 -6 d
- f black 1295 1401 m 23 6 d -20 16 d -23 -6 d cl s 0 0 0.8 c 1271 1395 m 24 6 d
- -20 16 d -24 -6 d f black 1271 1395 m 24 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c
- 1248 1389 m 23 6 d -20 16 d -23 -6 d f black 1248 1389 m 23 6 d -20 16 d -23 -6
- d cl s 0 0 0.8 c 1224 1383 m 24 6 d -20 16 d -24 -6 d f black 1224 1383 m 24 6
- d -20 16 d -24 -6 d cl s 0 0 0.8 c 1201 1377 m 23 6 d -20 16 d -23 -6 d f black
- 1201 1377 m 23 6 d -20 16 d -23 -6 d cl s 0 0 0.8 c 1177 1371 m 24 6 d -20 16 d
- -24 -6 d f black 1177 1371 m 24 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1154 1365
- m 23 6 d -20 16 d -23 -6 d f black 1154 1365 m 23 6 d -20 16 d -23 -6 d cl s 0
- 0 0.8 c 1131 1359 m 23 6 d -20 16 d -24 -6 d f black 1131 1359 m 23 6 d -20 16
- d -24 -6 d cl s 0 0 0.8 c 1107 1353 m 24 6 d -21 16 d -23 -6 d f black 1107
- 1353 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1084 1347 m 23 6 d -20 16 d -24
- -6 d f black 1084 1347 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1060 1341 m 24
- 6 d -21 16 d -23 -6 d f black 1060 1341 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8
- c 1037 1335 m 23 6 d -20 16 d -24 -6 d f black 1037 1335 m 23 6 d -20 16 d -24
- -6 d cl s 0 0 0.8 c 1013 1329 m 24 6 d -21 16 d -23 -6 d f black 1013 1329 m 24
- 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 990 1323 m 23 6 d -20 16 d -24 -6 d f
- black 990 1323 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 966 1317 m 24 6 d -21
- 16 d -23 -6 d f black 966 1317 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 943
- 1312 m 23 5 d -20 16 d -24 -6 d f black 943 1312 m 23 5 d -20 16 d -24 -6 d
- cl s 0 0 0.8 c 919 1306 m 24 6 d -21 15 d -23 -6 d f black 919 1306 m 24 6 d
- -21 15 d -23 -6 d cl s 0 0 0.8 c 896 1300 m 23 6 d -20 15 d -24 -6 d f black
- 896 1300 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 872 1294 m 24 6 d -21 15 d
- -23 -6 d f black 872 1294 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 849 1288 m
- 23 6 d -20 15 d -24 -6 d f black 849 1288 m 23 6 d -20 15 d -24 -6 d cl s 0 0
- 0.8 c 825 1282 m 24 6 d -21 15 d -23 -6 d f black 825 1282 m 24 6 d -21 15 d
- -23 -6 d cl s 0 0 0.8 c 802 1276 m 23 6 d -20 15 d -24 -6 d f black 802 1276 m
- 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 778 1270 m 24 6 d -21 15 d -23 -6 d f
- black 778 1270 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 755 1264 m 23 6 d -20
- 15 d -24 -6 d f black 755 1264 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 731
- 1258 m 24 6 d -21 15 d -23 -6 d f black 731 1258 m 24 6 d -21 15 d -23 -6 d
- cl s 0 0 0.8 c 708 1252 m 23 6 d -20 15 d -24 -6 d f black 708 1252 m 23 6 d
- -20 15 d -24 -6 d cl s 0 0 0.8 c 684 1246 m 24 6 d -21 15 d -23 -6 d f black
- 684 1246 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 661 1240 m 23 6 d -20 15 d
- -24 -6 d f black 661 1240 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 637 1234 m
- 24 6 d -21 15 d -23 -6 d f black 637 1234 m 24 6 d -21 15 d -23 -6 d cl s 0 0
- 0.8 c 614 1228 m 23 6 d -20 15 d -24 8 d f black 614 1228 m 23 6 d -20 15 d -24
- 8 d cl s 0 0 0.8 c 590 1235 m 24 -7 d -21 29 d -23 -20 d f black 590 1235 m 24
- -7 d -21 29 d -23 -20 d cl s 0 0 0.8 c 567 1216 m 23 19 d -20 2 d -24 8 d f
- black 567 1216 m 23 19 d -20 2 d -24 8 d cl s 0 0 0.8 c 543 1223 m 24 -7 d -21
- 29 d -23 -20 d f black 543 1223 m 24 -7 d -21 29 d -23 -20 d cl s 0 0 0.8 c 520
- 1204 m 23 19 d -20 2 d -24 -6 d f black 520 1204 m 23 19 d -20 2 d -24 -6 d
- cl s 0 0 0.8 c 496 1198 m 24 6 d -21 15 d -23 -6 d f black 496 1198 m 24 6 d
- -21 15 d -23 -6 d cl s 0 0 0.8 c 473 1192 m 23 6 d -20 15 d -24 -6 d f black
- 473 1192 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 449 1186 m 24 6 d -21 15 d
- -23 -6 d f black 449 1186 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 426 1180 m
- 23 6 d -20 15 d -24 -6 d f black 426 1180 m 23 6 d -20 15 d -24 -6 d cl s 0 0
- 0.8 c 402 1187 m 24 -7 d -21 15 d -23 -5 d f black 402 1187 m 24 -7 d -21 15 d
- -23 -5 d cl s 0 0 0.8 c 379 1168 m 23 19 d -20 3 d -23 -6 d f black 379 1168 m
- 23 19 d -20 3 d -23 -6 d cl s 0 0 0.8 c 355 1162 m 24 6 d -20 16 d -24 -6 d f
- black 355 1162 m 24 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 332 1156 m 23 6 d -20
- 16 d -23 -6 d f black 332 1156 m 23 6 d -20 16 d -23 -6 d cl s 0 0 0.8 c 308
- 1150 m 24 6 d -20 16 d -24 -6 d f black 308 1150 m 24 6 d -20 16 d -24 -6 d
- cl s 0 0 0.8 c 285 1144 m 23 6 d -20 16 d -23 -6 d f black 285 1144 m 23 6 d
- -20 16 d -23 -6 d cl s 0 0 0.8 c 1386 1404 m 23 6 d -20 15 d -24 -6 d f black
- 1386 1404 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1362 1398 m 24 6 d -21 15 d
- -23 -6 d f black 1362 1398 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 1339 1392
- m 23 6 d -20 15 d -24 -6 d f black 1339 1392 m 23 6 d -20 15 d -24 -6 d cl s 0
- 0 0.8 c 1315 1399 m 24 -7 d -21 15 d -23 -6 d f black 1315 1399 m 24 -7 d -21
- 15 d -23 -6 d cl s 0 0 0.8 c 1292 1380 m 23 19 d -20 2 d -24 -6 d f black 1292
- 1380 m 23 19 d -20 2 d -24 -6 d cl s 0 0 0.8 c 1268 1374 m 24 6 d -21 15 d -23
- -6 d f black 1268 1374 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 1245 1368 m 23
- 6 d -20 15 d -24 -6 d f black 1245 1368 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8
- c 1221 1362 m 24 6 d -21 15 d -23 -6 d f black 1221 1362 m 24 6 d -21 15 d -23
- -6 d cl s 0 0 0.8 c 1198 1356 m 23 6 d -20 15 d -24 -6 d f black 1198 1356 m 23
- 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1174 1350 m 24 6 d -21 15 d -23 -6 d f
- black 1174 1350 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 1151 1344 m 23 6 d
- -20 15 d -23 -6 d f black 1151 1344 m 23 6 d -20 15 d -23 -6 d cl s 0 0 0.8 c
- 1127 1338 m 24 6 d -20 15 d -24 -6 d f black 1127 1338 m 24 6 d -20 15 d -24 -6
- d cl s 0 0 0.8 c 1104 1332 m 23 6 d -20 15 d -23 -6 d f black 1104 1332 m 23 6
- d -20 15 d -23 -6 d cl s 0 0 0.8 c 1080 1326 m 24 6 d -20 15 d -24 -6 d f black
- 1080 1326 m 24 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1057 1320 m 23 6 d -20 15 d
- -23 -6 d f black 1057 1320 m 23 6 d -20 15 d -23 -6 d cl s 0 0 0.8 c 1033 1314
- m 24 6 d -20 15 d -24 -6 d f black 1033 1314 m 24 6 d -20 15 d -24 -6 d cl s 0
- 0 0.8 c 1010 1321 m 23 -7 d -20 15 d -23 -6 d f black 1010 1321 m 23 -7 d -20
- 15 d -23 -6 d cl s 0 0 0.8 c 986 1302 m 24 19 d -20 2 d -24 -6 d f black 986
- 1302 m 24 19 d -20 2 d -24 -6 d cl s 0 0 0.8 c 963 1309 m 23 -7 d -20 15 d -23
- -5 d f black 963 1309 m 23 -7 d -20 15 d -23 -5 d cl s 0 0 0.8 c 939 1290 m 24
- 19 d -20 3 d -24 -6 d f black 939 1290 m 24 19 d -20 3 d -24 -6 d cl s 0 0 0.8
- c 916 1284 m 23 6 d -20 16 d -23 -6 d f black 916 1284 m 23 6 d -20 16 d -23 -6
- d cl s 0 0 0.8 c 892 1278 m 24 6 d -20 16 d -24 -6 d f black 892 1278 m 24 6 d
- -20 16 d -24 -6 d cl s 0 0 0.8 c 869 1272 m 23 6 d -20 16 d -23 -6 d f black
- 869 1272 m 23 6 d -20 16 d -23 -6 d cl s 0 0 0.8 c 845 1280 m 24 -8 d -20 16 d
- -24 -6 d f black 845 1280 m 24 -8 d -20 16 d -24 -6 d cl s 0 0 0.8 c 822 1274 m
- 23 6 d -20 2 d -23 -6 d f black 822 1274 m 23 6 d -20 2 d -23 -6 d cl s 0 0 0.8
- c 799 1254 m 23 20 d -20 2 d -24 -6 d f black 799 1254 m 23 20 d -20 2 d -24 -6
- d cl s 0 0 0.8 c 775 1248 m 24 6 d -21 16 d -23 -6 d f black 775 1248 m 24 6 d
- -21 16 d -23 -6 d cl s 0 0 0.8 c 752 1242 m 23 6 d -20 16 d -24 -6 d f black
- 752 1242 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 728 1236 m 24 6 d -21 16 d
- -23 -6 d f black 728 1236 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 705 1230 m
- 23 6 d -20 16 d -24 -6 d f black 705 1230 m 23 6 d -20 16 d -24 -6 d cl s 0 0
- 0.8 c 681 1224 m 24 6 d -21 16 d -23 -6 d f black 681 1224 m 24 6 d -21 16 d
- -23 -6 d cl s 0 0 0.8 c 658 1218 m 23 6 d -20 16 d -24 -6 d f black 658 1218 m
- 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 634 1212 m 24 6 d -21 16 d -23 -6 d f
- black 634 1212 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 611 1220 m 23 -8 d -20
- 16 d -24 7 d f black 611 1220 m 23 -8 d -20 16 d -24 7 d cl s 0 0 0.8 c 587
- 1200 m 24 20 d -21 15 d -23 -19 d f black 587 1200 m 24 20 d -21 15 d -23 -19 d
- cl s 0 0 0.8 c 564 1208 m 23 -8 d -20 16 d -24 7 d f black 564 1208 m 23 -8 d
- -20 16 d -24 7 d cl s 0 0 0.8 c 540 1188 m 24 20 d -21 15 d -23 -19 d f black
- 540 1188 m 24 20 d -21 15 d -23 -19 d cl s 0 0 0.8 c 517 1182 m 23 6 d -20 16 d
- -24 -6 d f black 517 1182 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 493 1176 m
- 24 6 d -21 16 d -23 -6 d f black 493 1176 m 24 6 d -21 16 d -23 -6 d cl s 0 0
- 0.8 c 470 1184 m 23 -8 d -20 16 d -24 -6 d f black 470 1184 m 23 -8 d -20 16 d
- -24 -6 d cl s 0 0 0.8 c 446 1164 m 24 20 d -21 2 d -23 -6 d f black 446 1164 m
- 24 20 d -21 2 d -23 -6 d cl s 0 0 0.8 c 423 1172 m 23 -8 d -20 16 d -24 7 d f
- black 423 1172 m 23 -8 d -20 16 d -24 7 d cl s 0 0 0.8 c 399 1152 m 24 20 d -21
- 15 d -23 -19 d f black 399 1152 m 24 20 d -21 15 d -23 -19 d cl s 0 0 0.8 c 376
- 1146 m 23 6 d -20 16 d -24 -6 d f black 376 1146 m 23 6 d -20 16 d -24 -6 d
- cl s 0 0 0.8 c 352 1140 m 24 6 d -21 16 d -23 -6 d f black 352 1140 m 24 6 d
- -21 16 d -23 -6 d cl s 0 0 0.8 c 329 1135 m 23 5 d -20 16 d -24 -6 d f black
- 329 1135 m 23 5 d -20 16 d -24 -6 d cl s 0 0 0.8 c 305 1129 m 24 6 d -21 15 d
- -23 -6 d f black 305 1129 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 1406 1388 m
- 24 6 d -21 16 d -23 -6 d f black 1406 1388 m 24 6 d -21 16 d -23 -6 d cl s 0 0
- 0.8 c 1383 1382 m 23 6 d -20 16 d -24 -6 d f black 1383 1382 m 23 6 d -20 16 d
- -24 -6 d cl s 0 0 0.8 c 1359 1376 m 24 6 d -21 16 d -23 -6 d f black 1359 1376
- m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1336 1384 m 23 -8 d -20 16 d -24 7 d
- f black 1336 1384 m 23 -8 d -20 16 d -24 7 d cl s 0 0 0.8 c 1312 1364 m 24 20 d
- -21 15 d -23 -19 d f black 1312 1364 m 24 20 d -21 15 d -23 -19 d cl s 0 0 0.8
- c 1289 1358 m 23 6 d -20 16 d -24 -6 d f black 1289 1358 m 23 6 d -20 16 d -24
- -6 d cl s 0 0 0.8 c 1265 1366 m 24 -8 d -21 16 d -23 -6 d f black 1265 1366 m
- 24 -8 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1242 1346 m 23 20 d -20 2 d -24 -6 d f
- black 1242 1346 m 23 20 d -20 2 d -24 -6 d cl s 0 0 0.8 c 1218 1354 m 24 -8 d
- -21 16 d -23 -6 d f black 1218 1354 m 24 -8 d -21 16 d -23 -6 d cl s 0 0 0.8 c
- 1195 1348 m 23 6 d -20 2 d -24 -6 d f black 1195 1348 m 23 6 d -20 2 d -24 -6 d
- cl s 0 0 0.8 c 1171 1355 m 24 -7 d -21 2 d -23 -6 d f black 1171 1355 m 24 -7 d
- -21 2 d -23 -6 d cl s 0 0 0.8 c 1148 1349 m 23 6 d -20 -11 d -24 -6 d f black
- 1148 1349 m 23 6 d -20 -11 d -24 -6 d cl s 0 0 0.8 c 1124 1330 m 24 19 d -21
- -11 d -23 -6 d f black 1124 1330 m 24 19 d -21 -11 d -23 -6 d cl s 0 0 0.8 c
- 1101 1324 m 23 6 d -20 2 d -24 -6 d f black 1101 1324 m 23 6 d -20 2 d -24 -6 d
- cl s 0 0 0.8 c 1077 1304 m 24 20 d -21 2 d -23 -6 d f black 1077 1304 m 24 20 d
- -21 2 d -23 -6 d cl s 0 0 0.8 c 1054 1298 m 23 6 d -20 16 d -24 -6 d f black
- 1054 1298 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1030 1306 m 24 -8 d -21 16
- d -23 7 d f black 1030 1306 m 24 -8 d -21 16 d -23 7 d cl s 0 0 0.8 c 1007 1327
- m 23 -21 d -20 15 d -24 -19 d f black 1007 1327 m 23 -21 d -20 15 d -24 -19 d
- cl s 0 0 0.8 c 983 1280 m 24 47 d -21 -25 d -23 7 d f black 983 1280 m 24 47 d
- -21 -25 d -23 7 d cl s 0 0 0.8 c 960 1301 m 23 -21 d -20 29 d -24 -19 d f black
- 960 1301 m 23 -21 d -20 29 d -24 -19 d cl s 0 0 0.8 c 936 1295 m 24 6 d -21 -11
- d -23 -6 d f black 936 1295 m 24 6 d -21 -11 d -23 -6 d cl s 0 0 0.8 c 913 1289
- m 23 6 d -20 -11 d -24 -6 d f black 913 1289 m 23 6 d -20 -11 d -24 -6 d cl s 0
- 0 0.8 c 889 1283 m 24 6 d -21 -11 d -23 -6 d f black 889 1283 m 24 6 d -21 -11
- d -23 -6 d cl s 0 0 0.8 c 866 1264 m 23 19 d -20 -11 d -24 8 d f black 866 1264
- m 23 19 d -20 -11 d -24 8 d cl s 0 0 0.8 c 842 1245 m 24 19 d -21 16 d -23 -6 d
- f black 842 1245 m 24 19 d -21 16 d -23 -6 d cl s 0 0 0.8 c 819 1265 m 23 -20 d
- -20 29 d -23 -20 d f black 819 1265 m 23 -20 d -20 29 d -23 -20 d cl s 0 0 0.8
- c 795 1233 m 24 32 d -20 -11 d -24 -6 d f black 795 1233 m 24 32 d -20 -11 d
- -24 -6 d cl s 0 0 0.8 c 772 1253 m 23 -20 d -20 15 d -23 -6 d f black 772 1253
- m 23 -20 d -20 15 d -23 -6 d cl s 0 0 0.8 c 748 1221 m 24 32 d -20 -11 d -24 -6
- d f black 748 1221 m 24 32 d -20 -11 d -24 -6 d cl s 0 0 0.8 c 725 1242 m 23
- -21 d -20 15 d -23 -6 d f black 725 1242 m 23 -21 d -20 15 d -23 -6 d cl s 0 0
- 0.8 c 701 1209 m 24 33 d -20 -12 d -24 -6 d f black 701 1209 m 24 33 d -20 -12
- d -24 -6 d cl s 0 0 0.8 c 678 1216 m 23 -7 d -20 15 d -23 -6 d f black 678 1216
- m 23 -7 d -20 15 d -23 -6 d cl s 0 0 0.8 c 654 1224 m 24 -8 d -20 2 d -24 -6 d
- f black 654 1224 m 24 -8 d -20 2 d -24 -6 d cl s 0 0 0.8 c 631 1191 m 23 33 d
- -20 -12 d -23 8 d f black 631 1191 m 23 33 d -20 -12 d -23 8 d cl s 0 0 0.8 c
- 607 1212 m 24 -21 d -20 29 d -24 -20 d f black 607 1212 m 24 -21 d -20 29 d -24
- -20 d cl s 0 0 0.8 c 584 1192 m 23 20 d -20 -12 d -23 8 d f black 584 1192 m 23
- 20 d -20 -12 d -23 8 d cl s 0 0 0.8 c 560 1186 m 24 6 d -20 16 d -24 -20 d f
- black 560 1186 m 24 6 d -20 16 d -24 -20 d cl s 0 0 0.8 c 537 1167 m 23 19 d
- -20 2 d -23 -6 d f black 537 1167 m 23 19 d -20 2 d -23 -6 d cl s 0 0 0.8 c 513
- 1161 m 24 6 d -20 15 d -24 -6 d f black 513 1161 m 24 6 d -20 15 d -24 -6 d
- cl s 0 0 0.8 c 490 1168 m 23 -7 d -20 15 d -23 8 d f black 490 1168 m 23 -7 d
- -20 15 d -23 8 d cl s 0 0 0.8 c 467 1162 m 23 6 d -20 16 d -24 -20 d f black
- 467 1162 m 23 6 d -20 16 d -24 -20 d cl s 0 0 0.8 c 443 1156 m 24 6 d -21 2 d
- -23 8 d f black 443 1156 m 24 6 d -21 2 d -23 8 d cl s 0 0 0.8 c 420 1137 m 23
- 19 d -20 16 d -24 -20 d f black 420 1137 m 23 19 d -20 16 d -24 -20 d cl s 0 0
- 0.8 c 396 1131 m 24 6 d -21 15 d -23 -6 d f black 396 1131 m 24 6 d -21 15 d
- -23 -6 d cl s 0 0 0.8 c 373 1125 m 23 6 d -20 15 d -24 -6 d f black 373 1125 m
- 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 349 1119 m 24 6 d -21 15 d -23 -5 d f
- black 349 1119 m 24 6 d -21 15 d -23 -5 d cl s 0 0 0.8 c 326 1113 m 23 6 d -20
- 16 d -24 -6 d f black 326 1113 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1426
- 1373 m 24 6 d -20 15 d -24 -6 d f black 1426 1373 m 24 6 d -20 15 d -24 -6 d
- cl s 0 0 0.8 c 1403 1367 m 23 6 d -20 15 d -23 -6 d f black 1403 1367 m 23 6 d
- -20 15 d -23 -6 d cl s 0 0 0.8 c 1379 1361 m 24 6 d -20 15 d -24 -6 d f black
- 1379 1361 m 24 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1356 1381 m 23 -20 d -20 15
- d -23 8 d f black 1356 1381 m 23 -20 d -20 15 d -23 8 d cl s 0 0 0.8 c 1332
- 1402 m 24 -21 d -20 3 d -24 -20 d f black 1332 1402 m 24 -21 d -20 3 d -24 -20
- d cl s 0 0 0.8 c 1309 1343 m 23 59 d -20 -38 d -23 -6 d f black 1309 1343 m 23
- 59 d -20 -38 d -23 -6 d cl s 0 0 0.8 c 1285 1377 m 24 -34 d -20 15 d -24 8 d f
- black 1285 1377 m 24 -34 d -20 15 d -24 8 d cl s 0 0 0.8 c 1262 1344 m 23 33 d
- -20 -11 d -23 -20 d f black 1262 1344 m 23 33 d -20 -11 d -23 -20 d cl s 0 0
- 0.8 c 1239 1338 m 23 6 d -20 2 d -24 8 d f black 1239 1338 m 23 6 d -20 2 d -24
- 8 d cl s 0 0 0.8 c 1215 1346 m 24 -8 d -21 16 d -23 -6 d f black 1215 1346 m 24
- -8 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1192 1353 m 23 -7 d -20 2 d -24 7 d f
- black 1192 1353 m 23 -7 d -20 2 d -24 7 d cl s 0 0 0.8 c 1168 1347 m 24 6 d -21
- 2 d -23 -6 d f black 1168 1347 m 24 6 d -21 2 d -23 -6 d cl s 0 0 0.8 c 1145
- 1328 m 23 19 d -20 2 d -24 -19 d f black 1145 1328 m 23 19 d -20 2 d -24 -19 d
- cl s 0 0 0.8 c 1121 1335 m 24 -7 d -21 2 d -23 -6 d f black 1121 1335 m 24 -7 d
- -21 2 d -23 -6 d cl s 0 0 0.8 c 1098 1289 m 23 46 d -20 -11 d -24 -20 d f black
- 1098 1289 m 23 46 d -20 -11 d -24 -20 d cl s 0 0 0.8 c 1074 1283 m 24 6 d -21
- 15 d -23 -6 d f black 1074 1283 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 1051
- 1290 m 23 -7 d -20 15 d -24 8 d f black 1051 1290 m 23 -7 d -20 15 d -24 8 d
- cl s 0 0 0.8 c 1027 1284 m 24 6 d -21 16 d -23 21 d f black 1027 1284 m 24 6 d
- -21 16 d -23 21 d cl s 0 0 0.8 c 1004 1265 m 23 19 d -20 43 d -24 -47 d f black
- 1004 1265 m 23 19 d -20 43 d -24 -47 d cl s 0 0 0.8 c 980 1272 m 24 -7 d -21 15
- d -23 21 d f black 980 1272 m 24 -7 d -21 15 d -23 21 d cl s 0 0 0.8 c 957 1253
- m 23 19 d -20 29 d -24 -6 d f black 957 1253 m 23 19 d -20 29 d -24 -6 d cl s 0
- 0 0.8 c 933 1247 m 24 6 d -21 42 d -23 -6 d f black 933 1247 m 24 6 d -21 42 d
- -23 -6 d cl s 0 0 0.8 c 910 1268 m 23 -21 d -20 42 d -24 -6 d f black 910 1268
- m 23 -21 d -20 42 d -24 -6 d cl s 0 0 0.8 c 886 1248 m 24 20 d -21 15 d -23 -19
- d f black 886 1248 m 24 20 d -21 15 d -23 -19 d cl s 0 0 0.8 c 863 1256 m 23 -8
- d -20 16 d -24 -19 d f black 863 1256 m 23 -8 d -20 16 d -24 -19 d cl s 0 0 0.8
- c 839 1250 m 24 6 d -21 -11 d -23 20 d f black 839 1250 m 24 6 d -21 -11 d -23
- 20 d cl s 0 0 0.8 c 816 1271 m 23 -21 d -20 15 d -24 -32 d f black 816 1271 m
- 23 -21 d -20 15 d -24 -32 d cl s 0 0 0.8 c 792 1225 m 24 46 d -21 -38 d -23 20
- d f black 792 1225 m 24 46 d -21 -38 d -23 20 d cl s 0 0 0.8 c 769 1205 m 23 20
- d -20 28 d -24 -32 d f black 769 1205 m 23 20 d -20 28 d -24 -32 d cl s 0 0 0.8
- c 745 1213 m 24 -8 d -21 16 d -23 21 d f black 745 1213 m 24 -8 d -21 16 d -23
- 21 d cl s 0 0 0.8 c 722 1193 m 23 20 d -20 29 d -24 -33 d f black 722 1193 m 23
- 20 d -20 29 d -24 -33 d cl s 0 0 0.8 c 698 1214 m 24 -21 d -21 16 d -23 7 d f
- black 698 1214 m 24 -21 d -21 16 d -23 7 d cl s 0 0 0.8 c 675 1195 m 23 19 d
- -20 2 d -24 8 d f black 675 1195 m 23 19 d -20 2 d -24 8 d cl s 0 0 0.8 c 651
- 1216 m 24 -21 d -21 29 d -23 -33 d f black 651 1216 m 24 -21 d -21 29 d -23 -33
- d cl s 0 0 0.8 c 628 1196 m 23 20 d -20 -25 d -24 21 d f black 628 1196 m 23 20
- d -20 -25 d -24 21 d cl s 0 0 0.8 c 604 1177 m 24 19 d -21 16 d -23 -20 d f
- black 604 1177 m 24 19 d -21 16 d -23 -20 d cl s 0 0 0.8 c 581 1184 m 23 -7 d
- -20 15 d -24 -6 d f black 581 1184 m 23 -7 d -20 15 d -24 -6 d cl s 0 0 0.8 c
- 557 1151 m 24 33 d -21 2 d -23 -19 d f black 557 1151 m 24 33 d -21 2 d -23 -19
- d cl s 0 0 0.8 c 534 1172 m 23 -21 d -20 16 d -24 -6 d f black 534 1172 m 23
- -21 d -20 16 d -24 -6 d cl s 0 0 0.8 c 510 1193 m 24 -21 d -21 -11 d -23 7 d f
- black 510 1193 m 24 -21 d -21 -11 d -23 7 d cl s 0 0 0.8 c 487 1187 m 23 6 d
- -20 -25 d -23 -6 d f black 487 1187 m 23 6 d -20 -25 d -23 -6 d cl s 0 0 0.8 c
- 463 1141 m 24 46 d -20 -25 d -24 -6 d f black 463 1141 m 24 46 d -20 -25 d -24
- -6 d cl s 0 0 0.8 c 440 1175 m 23 -34 d -20 15 d -23 -19 d f black 440 1175 m
- 23 -34 d -20 15 d -23 -19 d cl s 0 0 0.8 c 416 1115 m 24 60 d -20 -38 d -24 -6
- d f black 416 1115 m 24 60 d -20 -38 d -24 -6 d cl s 0 0 0.8 c 393 1109 m 23 6
- d -20 16 d -23 -6 d f black 393 1109 m 23 6 d -20 16 d -23 -6 d cl s 0 0 0.8 c
- 369 1103 m 24 6 d -20 16 d -24 -6 d f black 369 1103 m 24 6 d -20 16 d -24 -6 d
- cl s 0 0 0.8 c 346 1097 m 23 6 d -20 16 d -23 -6 d f black 346 1097 m 23 6 d
- -20 16 d -23 -6 d cl s 0 0 0.8 c 1447 1357 m 23 6 d -20 16 d -24 -6 d f black
- 1447 1357 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1423 1351 m 24 6 d -21 16 d
- -23 -6 d f black 1423 1351 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1400 1345
- m 23 6 d -20 16 d -24 -6 d f black 1400 1345 m 23 6 d -20 16 d -24 -6 d cl s 0
- 0 0.8 c 1378 1402 m 22 -57 d -21 16 d -23 20 d 18 22 d f 0 0.2 0.8 c 1376 1406
- m 2 -4 d -4 1 d f black 1376 1406 m 24 -61 d -21 16 d -23 20 d cl s 0 0 0.8 c
- 1353 1333 m 22 68 d -1 2 d -18 -22 d -24 21 d f 0 0.2 0.8 c 1375 1401 m 1 5 d
- -2 -3 d f black 1353 1333 m 23 73 d -20 -25 d -24 21 d cl s 0 0 0.8 c 1329 1341
- m 24 -8 d -21 69 d -23 -59 d f black 1329 1341 m 24 -8 d -21 69 d -23 -59 d
- cl s 0 0 0.8 c 1306 1361 m 23 -20 d -20 2 d -24 34 d f black 1306 1361 m 23 -20
- d -20 2 d -24 34 d cl s 0 0 0.8 c 1282 1369 m 24 -8 d -21 16 d -23 -33 d f
- black 1282 1369 m 24 -8 d -21 16 d -23 -33 d cl s 0 0 0.8 c 1259 1323 m 23 46 d
- -20 -25 d -23 -6 d f black 1259 1323 m 23 46 d -20 -25 d -23 -6 d cl s 0 0 0.8
- c 1242 1367 m 17 -44 d -20 15 d -24 8 d 13 25 d f 0 0.2 0.8 c 1235 1384 m 7 -17
- d -14 4 d f black 1235 1384 m 24 -61 d -20 15 d -24 8 d cl s 0 0 0.8 c 1228
- 1371 m -13 -25 d -23 7 d 6 17 d f 0 0.2 0.8 c 1212 1405 m 23 -21 d -7 -13 d -30
- -1 d f black 1212 1405 m 23 -21 d -20 -38 d -23 7 d cl s 0 0 0.8 c 1188 1305 m
- 13 51 d -3 14 d -6 -17 d -24 -6 d f 0 0.2 0.8 c 1201 1356 m 11 49 d -14 -35 d f
- black 1188 1305 m 24 100 d -20 -52 d -24 -6 d cl s 0 0 0.8 c 1167 1348 m 21 -43
- d -20 42 d -23 -19 d 17 21 d f 0 0.2 0.8 c 1165 1352 m 2 -4 d -5 1 d f black
- 1165 1352 m 23 -47 d -20 42 d -23 -19 d cl s 0 0 0.8 c 1141 1333 m 15 12 d 6 4
- d -17 -21 d -24 7 d f 0 0.2 0.8 c 1156 1345 m 9 7 d -3 -3 d f black 1141 1333 m
- 24 19 d -20 -24 d -24 7 d cl s 0 0 0.8 c 1118 1327 m 23 6 d -20 2 d -23 -46 d f
- black 1118 1327 m 23 6 d -20 2 d -23 -46 d cl s 0 0 0.8 c 1094 1308 m 24 19 d
- -20 -38 d -24 -6 d f black 1094 1308 m 24 19 d -20 -38 d -24 -6 d cl s 0 0 0.8
- c 1087 1327 m 7 -19 d -20 -25 d -23 7 d 10 41 d f 0 0.2 0.8 c 1071 1369 m 16
- -42 d -26 4 d f black 1071 1369 m 23 -61 d -20 -25 d -23 7 d cl s 0 0 0.8 c
- 1047 1296 m 8 23 d 6 12 d -10 -41 d -24 -6 d f 0 0.2 0.8 c 1055 1319 m 16 50 d
- -10 -38 d f black 1047 1296 m 24 73 d -20 -79 d -24 -6 d cl s 0 0 0.8 c 1024
- 1276 m 23 20 d -20 -12 d -23 -19 d f black 1024 1276 m 23 20 d -20 -12 d -23
- -19 d cl s 0 0 0.8 c 1000 1297 m 24 -21 d -20 -11 d -24 7 d f black 1000 1297 m
- 24 -21 d -20 -11 d -24 7 d cl s 0 0 0.8 c 977 1251 m 23 46 d -20 -25 d -23 -19
- d f black 977 1251 m 23 46 d -20 -25 d -23 -19 d cl s 0 0 0.8 c 956 1294 m 21
- -43 d -20 2 d -24 -6 d 19 48 d f 0 0.2 0.8 c 953 1299 m 3 -5 d -4 1 d f black
- 953 1299 m 24 -48 d -20 2 d -24 -6 d cl s 0 0 0.8 c 952 1295 m -19 -48 d -23 21
- d 17 22 d f 0 0.2 0.8 c 930 1293 m 23 6 d -1 -4 d -25 -5 d f black 930 1293 m
- 23 6 d -20 -52 d -23 21 d cl s 0 0 0.8 c 927 1290 m -17 -22 d -24 -20 d 19 35 d
- f 0 0.2 0.8 c 907 1287 m 23 6 d -3 -3 d -22 -7 d f black 907 1287 m 23 6 d -20
- -25 d -24 -20 d cl s 0 0 0.8 c 883 1240 m 21 41 d 1 2 d -19 -35 d -23 8 d f 0
- 0.2 0.8 c 904 1281 m 3 6 d -2 -4 d f black 883 1240 m 24 47 d -21 -39 d -23 8 d
- cl s 0 0 0.8 c 860 1261 m 23 -21 d -20 16 d -24 -6 d f black 860 1261 m 23 -21
- d -20 16 d -24 -6 d cl s 0 0 0.8 c 852 1268 m 8 -7 d -21 -11 d -23 21 d 6 3 d f
- 0 0.2 0.8 c 836 1282 m 16 -14 d -30 6 d f black 836 1282 m 24 -21 d -21 -11 d
- -23 21 d cl s 0 0 0.8 c 822 1274 m -6 -3 d -24 -46 d 13 39 d f 0 0.2 0.8 c 813
- 1290 m 23 -8 d -14 -8 d -17 -10 d f black 813 1290 m 23 -8 d -20 -11 d -24 -46
- d cl s 0 0 0.8 c 789 1216 m 12 39 d 4 9 d -13 -39 d -23 -20 d f 0 0.2 0.8 c 801
- 1255 m 12 35 d -8 -26 d f black 789 1216 m 24 74 d -21 -65 d -23 -20 d cl s 0 0
- 0.8 c 766 1224 m 23 -8 d -20 -11 d -24 8 d f black 766 1224 m 23 -8 d -20 -11 d
- -24 8 d cl s 0 0 0.8 c 742 1204 m 24 20 d -21 -11 d -23 -20 d f black 742 1204
- m 24 20 d -21 -11 d -23 -20 d cl s 0 0 0.8 c 719 1185 m 23 19 d -20 -11 d -24
- 21 d f black 719 1185 m 23 19 d -20 -11 d -24 21 d cl s 0 0 0.8 c 704 1230 m 15
- -45 d -21 29 d -23 -19 d 12 39 d f 0 0.2 0.8 c 695 1260 m 9 -30 d -17 4 d f
- black 695 1260 m 24 -75 d -21 29 d -23 -19 d cl s 0 0 0.8 c 672 1200 m 9 24 d 6
- 10 d -12 -39 d -24 21 d f 0 0.2 0.8 c 681 1224 m 14 36 d -8 -26 d f black 672
- 1200 m 23 60 d -20 -65 d -24 21 d cl s 0 0 0.8 c 648 1207 m 24 -7 d -21 16 d
- -23 -20 d f black 648 1207 m 24 -7 d -21 16 d -23 -20 d cl s 0 0 0.8 c 625 1201
- m 23 6 d -20 -11 d -24 -19 d f black 625 1201 m 23 6 d -20 -11 d -24 -19 d cl s
- 0 0 0.8 c 601 1169 m 24 32 d -21 -24 d -23 7 d f black 601 1169 m 24 32 d -21
- -24 d -23 7 d cl s 0 0 0.8 c 578 1163 m 23 6 d -20 15 d -24 -33 d f black 578
- 1163 m 23 6 d -20 15 d -24 -33 d cl s 0 0 0.8 c 554 1170 m 24 -7 d -21 -12 d
- -23 21 d f black 554 1170 m 24 -7 d -21 -12 d -23 21 d cl s 0 0 0.8 c 531 1164
- m 23 6 d -20 2 d -24 21 d f black 531 1164 m 23 6 d -20 2 d -24 21 d cl s 0 0
- 0.8 c 507 1172 m 24 -8 d -21 29 d -23 -6 d f black 507 1172 m 24 -8 d -21 29 d
- -23 -6 d cl s 0 0 0.8 c 500 1178 m 7 -6 d -20 15 d -24 -46 d 15 37 d f 0 0.2
- 0.8 c 484 1192 m 16 -14 d -22 X f black 484 1192 m 23 -20 d -20 15 d -24 -46 d
- cl s 0 0 0.8 c 460 1119 m 17 53 d 1 6 d -15 -37 d -23 34 d f 0 0.2 0.8 c 477
- 1172 m 7 20 d -6 -14 d f black 460 1119 m 24 73 d -21 -51 d -23 34 d cl s 0 0
- 0.8 c 437 1100 m 23 19 d -20 56 d -24 -60 d f black 437 1100 m 23 19 d -20 56 d
- -24 -60 d cl s 0 0 0.8 c 413 1094 m 24 6 d -21 15 d -23 -6 d f black 413 1094 m
- 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 390 1088 m 23 6 d -20 15 d -24 -6 d f
- black 390 1088 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 366 1082 m 24 6 d -21
- 15 d -23 -6 d f black 366 1082 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 1467
- 1341 m 24 6 d -21 16 d -23 -6 d f black 1467 1341 m 24 6 d -21 16 d -23 -6 d
- cl s 0 0 0.8 c 1444 1335 m 23 6 d -20 16 d -24 -6 d f black 1444 1335 m 23 6 d
- -20 16 d -24 -6 d cl s 0 0 0.8 c 1420 1329 m 24 6 d -21 16 d -23 -6 d f black
- 1420 1329 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1397 1377 m 23 -48 d -20 16
- d -22 57 d 6 -7 d f 0 0.2 0.8 c 1378 1402 m -2 4 d 8 -11 d f black 1397 1377 m
- 23 -48 d -20 16 d -24 61 d cl s 0 0 0.8 c 1373 1371 m 24 6 d -13 18 d -9 6 d
- -22 -68 d f 0 0.2 0.8 c 1384 1395 m -8 11 d -1 -5 d f black 1373 1371 m 24 6 d
- -21 29 d -23 -73 d cl s 0 0 0.8 c 1368 1378 m 5 -7 d -20 -38 d -24 8 d 13 39 d
- f 0 0.2 0.8 c 1350 1406 m 18 -28 d -26 2 d f black 1350 1406 m 23 -35 d -20 -38
- d -24 8 d cl s 0 0 0.8 c 1342 1380 m -13 -39 d -23 20 d 8 16 d f 0 0.2 0.8 c
- 1326 1400 m 24 6 d -8 -26 d -28 -3 d f black 1326 1400 m 24 6 d -21 -65 d -23
- 20 d cl s 0 0 0.8 c 1303 1326 m 12 39 d -1 12 d -8 -16 d -24 8 d f 0 0.2 0.8 c
- 1315 1365 m 11 35 d -12 -23 d f black 1303 1326 m 23 74 d -20 -39 d -24 8 d
- cl s 0 0 0.8 c 1290 1359 m 13 -33 d -21 43 d -23 -46 d 12 39 d f 0 0.2 0.8 c
- 1279 1388 m 11 -29 d -19 3 d f black 1279 1388 m 24 -62 d -21 43 d -23 -46 d
- cl s 0 0 0.8 c 1271 1362 m -12 -39 d -17 44 d f 0 0.2 0.8 c 1256 1395 m 23 -7 d
- -8 -26 d -29 5 d -7 17 d f black 1256 1395 m 23 -7 d -20 -65 d -24 61 d cl s 0
- 0.2 0.8 c 1232 1362 m 24 33 d -21 -11 d -23 21 d f black 1232 1362 m 24 33 d
- -21 -11 d -23 21 d cl s 0 0 0.8 c 1201 1356 m -13 -51 d 15 37 d f 0 0.2 0.8 c
- 1209 1356 m 23 6 d -20 43 d -11 -49 d 2 -14 d f black 1209 1356 m 23 6 d -20 43
- d -24 -100 d cl s 0 0 0.8 c 1203 1342 m -15 -37 d -21 43 d f 0 0.2 0.8 c 1185
- 1350 m 24 6 d -6 -14 d -36 6 d -2 4 d f black 1185 1350 m 24 6 d -21 -51 d -23
- 47 d cl s 0 0 0.8 c 1162 1304 m 12 25 d -18 16 d -15 -12 d f 0 0.2 0.8 c 1174
- 1329 m 11 21 d -20 2 d -9 -7 d f black 1162 1304 m 23 46 d -20 2 d -24 -19 d
- cl s 0 0 0.8 c 1138 1311 m 24 -7 d -21 29 d -23 -6 d f black 1138 1311 m 24 -7
- d -21 29 d -23 -6 d cl s 0 0 0.8 c 1115 1306 m 23 5 d -20 16 d -24 -19 d f
- black 1115 1306 m 23 5 d -20 16 d -24 -19 d cl s 0 0 0.8 c 1112 1313 m 3 -7 d
- -21 2 d -7 19 d f 0 0.2 0.8 c 1094 1371 m 18 -58 d -25 14 d -16 42 d 13 7 d f 0
- 0.4 0.8 c 1091 1380 m 3 -9 d -10 5 d f black 1091 1380 m 24 -74 d -21 2 d -23
- 61 d cl s 0 0 0.8 c 1055 1319 m -8 -23 d 9 15 d f 0 0.2 0.8 c 1068 1334 m 17 35
- d -1 7 d -13 -7 d -16 -50 d 1 -8 d f 0 0.4 0.8 c 1085 1369 m 6 11 d -7 -4 d f
- black 1068 1334 m 23 46 d -20 -11 d -24 -73 d cl s 0 0 0.8 c 1044 1288 m 5 9 d
- 7 14 d -9 -15 d -23 -20 d f 0 0.2 0.8 c 1049 1297 m 19 37 d -12 -23 d f black
- 1044 1288 m 24 46 d -21 -38 d -23 -20 d cl s 0 0 0.8 c 1037 1294 m 7 -6 d -20
- -12 d -24 21 d 7 4 d f 0 0.2 0.8 c 1021 1308 m 16 -14 d -30 7 d f black 1021
- 1308 m 23 -20 d -20 -12 d -24 21 d cl s 0 0 0.8 c 997 1249 m 16 39 d -6 13 d -7
- -4 d -23 -46 d f 0 0.2 0.8 c 1013 1288 m 8 20 d -14 -7 d f black 997 1249 m 24
- 59 d -21 -11 d -23 -46 d cl s 0 0 0.8 c 987 1281 m 10 -32 d -20 2 d -21 43 d f
- 0 0.2 0.8 c 974 1323 m 13 -42 d -31 13 d -3 5 d f black 974 1323 m 23 -74 d -20
- 2 d -24 48 d cl s 0 0.2 0.8 c 950 1317 m 24 6 d -21 -24 d -23 -6 d f black 950
- 1317 m 24 6 d -21 -24 d -23 -6 d cl s 0 0.2 0.8 c 927 1325 m 23 -8 d -20 -24 d
- -23 -6 d f black 927 1325 m 23 -8 d -20 -24 d -23 -6 d cl s 0 0 0.8 c 903 1225
- m 9 37 d -8 19 d -21 -41 d f 0 0.2 0.8 c 912 1262 m 15 63 d -20 -38 d -3 -6 d f
- black 903 1225 m 24 100 d -20 -38 d -24 -47 d cl s 0 0 0.8 c 883 1255 m 20 -30
- d -20 15 d -23 21 d 12 -1 d f 0 0.2 0.8 c 880 1259 m 3 -4 d -11 5 d f black 880
- 1259 m 23 -34 d -20 15 d -23 21 d cl s 0 0 0.8 c 856 1213 m 21 40 d -5 7 d -12
- 1 d -8 7 d -9 -10 d f 0 0.2 0.8 c 877 1253 m 3 6 d -8 1 d -20 8 d -16 14 d 7
- -24 d f black 856 1213 m 24 46 d -20 2 d -24 21 d cl s 0 0 0.8 c 833 1220 m 23
- -7 d -13 45 d -18 -10 d f 0 0.2 0.8 c 843 1258 m -7 24 d -23 8 d 12 -42 d f
- black 833 1220 m 23 -7 d -20 69 d -23 8 d cl s 0 0 0.8 c 814 1237 m 19 -17 d -8
- 28 d -24 7 d -12 -39 d 18 22 d f 0 0.2 0.8 c 809 1241 m 5 -4 d 11 11 d -12 42 d
- -12 -35 d 6 -17 d f black 809 1241 m 24 -21 d -20 70 d -24 -74 d cl s 0 0 0.8 c
- 807 1238 m -18 -22 d -23 8 d 11 13 d f 0 0.2 0.8 c 786 1249 m 23 -8 d -2 -3 d
- -30 -1 d f black 786 1249 m 23 -8 d -20 -25 d -23 8 d cl s 0 0 0.8 c 777 1237 m
- -11 -13 d -24 -20 d 13 26 d f 0 0.2 0.8 c 762 1243 m 24 6 d -9 -12 d -22 -7 d f
- black 762 1243 m 24 6 d -20 -25 d -24 -20 d cl s 0 0 0.8 c 739 1183 m 15 39 d 1
- 8 d -13 -26 d -23 -19 d f 0 0.2 0.8 c 754 1222 m 8 21 d -7 -13 d f black 739
- 1183 m 23 60 d -20 -39 d -23 -19 d cl s 0 0 0.8 c 715 1190 m 24 -7 d -20 2 d
- -15 45 d 3 -11 d f 0 0.2 0.8 c 704 1230 m -9 30 d 12 -41 d f black 715 1190 m
- 24 -7 d -20 2 d -24 75 d cl s 0 0 0.8 c 703 1209 m 12 -19 d -8 29 d -26 5 d -9
- -24 d 11 13 d f 0 0.2 0.8 c 692 1225 m 11 -16 d 4 10 d -12 41 d -14 -36 d 2 -11
- d f black 692 1225 m 23 -35 d -20 70 d -23 -60 d cl s 0 0 0.8 c 668 1178 m 13
- 26 d 2 9 d -11 -13 d -24 7 d f 0 0.2 0.8 c 681 1204 m 11 21 d -9 -12 d f black
- 668 1178 m 24 47 d -20 -25 d -24 7 d cl s 0 0 0.8 c 645 1186 m 23 -8 d -20 29 d
- -23 -6 d f black 645 1186 m 23 -8 d -20 29 d -23 -6 d cl s 0 0 0.8 c 640 1193 m
- 5 -7 d -20 15 d -24 -32 d 11 27 d f 0 0.2 0.8 c 622 1220 m 18 -27 d -28 3 d f
- black 622 1220 m 23 -34 d -20 15 d -24 -32 d cl s 0 0 0.8 c 612 1196 m -11 -27
- d -23 -6 d 9 28 d f 0 0.2 0.8 c 598 1228 m 24 -8 d -10 -24 d -25 -5 d f black
- 598 1228 m 24 -8 d -21 -51 d -23 -6 d cl s 0 0 0.8 c 587 1191 m -9 -28 d -24 7
- d 17 9 d f 0 0.2 0.8 c 575 1181 m 23 47 d -11 -37 d -16 -12 d f black 575 1181
- m 23 47 d -20 -65 d -24 7 d cl s 0 0 0.8 c 571 1179 m -17 -9 d -23 -6 d 6 17 d
- f 0 0.2 0.8 c 551 1216 m 24 -35 d -4 -2 d -34 2 d f black 551 1216 m 24 -35 d
- -21 -11 d -23 -6 d cl s 0 0 0.8 c 537 1181 m -6 -17 d -24 8 d 3 6 d f 0 0.2 0.8
- c 528 1210 m 23 6 d -14 -35 d -27 -3 d f black 528 1210 m 23 6 d -20 -52 d -24
- 8 d cl s 0 0 0.8 c 504 1150 m 4 9 d 2 19 d -3 -6 d -7 6 d -2 -15 d f 0 0.2 0.8
- c 508 1159 m 20 51 d -18 -32 d -10 X -16 14 d 14 -29 d f black 504 1150 m 24 60
- d -21 -38 d -23 20 d cl s 0 0 0.8 c 499 1157 m 5 -7 d -6 13 d -21 9 d -17 -53 d
- 13 40 d f 0 0.2 0.8 c 481 1184 m 18 -27 d -1 6 d -14 29 d -7 -20 d -4 -13 d f
- black 481 1184 m 23 -34 d -20 42 d -24 -73 d cl s 0 0 0.8 c 457 1084 m 16 66 d
- 9 Y -13 -40 d -23 -19 d f 0 0.2 0.8 c 473 1150 m 8 34 d -8 -25 d f black 457
- 1084 m 24 100 d -21 -65 d -23 -19 d cl s 0 0 0.8 c 434 1078 m 23 6 d -20 16 d
- -24 -6 d f black 434 1078 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 410 1072 m
- 24 6 d -21 16 d -23 -6 d f black 410 1072 m 24 6 d -21 16 d -23 -6 d cl s 0 0
- 0.8 c 387 1066 m 23 6 d -20 16 d -24 -6 d f black 387 1066 m 23 6 d -20 16 d
- -24 -6 d cl s 0 0 0.8 c 1487 1326 m 24 6 d -20 15 d -24 -6 d f black 1487 1326
- m 24 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1464 1320 m 23 6 d -20 15 d -23 -6 d
- f black 1464 1320 m 23 6 d -20 15 d -23 -6 d cl s 0 0 0.8 c 1440 1314 m 24 6 d
- -20 15 d -24 -6 d f black 1440 1314 m 24 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c
- 1430 1373 m 10 -59 d -20 15 d -23 48 d 2 7 d f 0 0.2 0.8 c 1419 1433 m 11 -60 d
- -31 11 d 15 50 d f 0 0.4 0.8 c 1417 1442 m 2 -9 d -5 1 d f black 1417 1442 m 23
- -128 d -20 15 d -23 48 d cl s 0 0 0.8 c 1399 1384 m -2 -7 d -24 -6 d 2 7 d f 0
- 0.2 0.8 c 1414 1434 m -15 -50 d -24 -6 d 13 52 d f 0 0.4 0.8 c 1393 1450 m 24
- -8 d -3 -8 d -26 -4 d f black 1393 1450 m 24 -8 d -20 -65 d -24 -6 d cl s 0 0
- 0.8 c 1375 1378 m -2 -7 d -5 7 d f 0 0.2 0.8 c 1388 1430 m -13 -52 d -7 X -18
- 28 d 15 18 d f 0 0.4 0.8 c 1370 1430 m 23 20 d -5 -20 d -23 -6 d f black 1370
- 1430 m 23 20 d -20 -79 d -23 35 d cl s 0 0.2 0.8 c 1347 1411 m 5 5 d 13 8 d -15
- -18 d -24 -6 d f 0 0.4 0.8 c 1352 1416 m 18 14 d -5 -6 d f black 1347 1411 m 23
- 19 d -20 -24 d -24 -6 d cl s 0 0 0.8 c 1315 1365 m -12 -39 d 5 32 d f 0 0.2 0.8
- c 1345 1414 m 2 -3 d -21 -11 d -11 -35 d -7 -7 d 9 55 d f 0 0.4 0.8 c 1323 1445
- m 22 -31 d -28 -1 d f black 1323 1445 m 24 -34 d -21 -11 d -23 -74 d cl s 0 0
- 0.8 c 1300 1318 m 4 23 d 4 17 d -5 -32 d -13 33 d 1 -12 d f 0 0.2 0.8 c 1304
- 1341 m 12 66 d 1 6 d -9 -55 d -18 1 d -11 29 d 12 -41 d f 0 0.4 0.8 c 1316 1407
- m 7 38 d -6 -32 d f black 1300 1318 m 23 127 d -20 -119 d -24 62 d cl s 0 0 0.8
- c 1276 1312 m 24 6 d -9 29 d -22 -8 d f 0 0.2 0.8 c 1291 1347 m -12 41 d -23 7
- d 13 -56 d f black 1276 1312 m 24 6 d -21 70 d -23 7 d cl s 0 0 0.8 c 1270 1333
- m 6 -21 d -7 27 d f 0 0.2 0.8 c 1253 1387 m 17 -54 d -1 6 d -13 56 d -24 -33 d
- f black 1253 1387 m 23 -75 d -20 83 d -24 -33 d cl s 0 0.2 0.8 c 1247 1389 m 6
- -2 d -21 -25 d -23 -6 d 16 31 d f 0 0.4 0.8 c 1229 1395 m 18 -6 d -22 -2 d f
- black 1229 1395 m 24 -8 d -21 -25 d -23 -6 d cl s 0 0.2 0.8 c 1206 1348 m 17 35
- d 2 4 d -16 -31 d -24 -6 d f 0 0.4 0.8 c 1223 1383 m 6 12 d -4 -8 d f black
- 1206 1348 m 23 47 d -20 -39 d -24 -6 d cl s 0 0 0.8 c 1174 1329 m -12 -25 d 5
- 18 d f 0 0.2 0.8 c 1182 1369 m 24 -21 d -21 2 d -11 -21 d -7 -7 d f black 1182
- 1369 m 24 -21 d -21 2 d -23 -46 d cl s 0 0 0.8 c 1167 1322 m -5 -18 d -24 7 d 7
- 4 d f 0 0.2 0.8 c 1159 1323 m 23 46 d -15 -47 d -22 -7 d f black 1159 1323 m 23
- 46 d -20 -65 d -24 7 d cl s 0 0 0.8 c 1135 1263 m 16 39 d -6 13 d -7 -4 d -23
- -5 d f 0 0.2 0.8 c 1151 1302 m 8 21 d -14 -8 d f black 1135 1263 m 24 60 d -21
- -12 d -23 -5 d cl s 0 0 0.8 c 1120 1294 m 15 -31 d -20 43 d -3 7 d f 0 0.2 0.8
- c 1112 1311 m 8 -17 d -8 19 d -18 58 d 1 -4 d f 0 0.4 0.8 c 1094 1371 m -3 9 d
- 4 -13 d f black 1112 1311 m 23 -48 d -20 43 d -24 74 d cl s 0 0.2 0.8 c 1088
- 1318 m 24 -7 d -17 56 d -10 2 d -17 -35 d f 0 0.4 0.8 c 1095 1367 m -4 13 d -6
- -11 d f black 1088 1318 m 24 -7 d -21 69 d -23 -46 d cl s 0 0 0.8 c 1049 1297 m
- -5 -9 d 1 7 d f 0 0.2 0.8 c 1082 1347 m 6 -29 d -20 16 d -19 -37 d -4 -2 d 9 56
- d f 0 0.4 0.8 c 1068 1406 m 14 -59 d -28 4 d 9 55 d f 0 0.6 0.8 c 1065 1420 m 3
- -14 d -5 X f black 1065 1420 m 23 -102 d -20 16 d -24 -46 d cl s 0 0 0.8 c 1045
- 1295 m -1 -7 d -7 6 d f 0 0.2 0.8 c 1041 1293 m 9 46 d 4 12 d -9 -56 d -8 -1 d
- -16 14 d f 0 0.4 0.8 c 1050 1339 m 12 65 d 1 2 d -9 -55 d f 0 0.6 0.8 c 1062
- 1404 m 3 16 d -2 -14 d f black 1041 1293 m 24 127 d -21 -132 d -23 20 d cl s 0
- 0 0.8 c 1013 1288 m -16 -39 d 6 31 d f 0 0.2 0.8 c 1028 1333 m 13 -40 d -20 15
- d -8 -20 d -10 -8 d 9 55 d f 0 0.4 0.8 c 1018 1368 m 10 -35 d -16 2 d f black
- 1018 1368 m 23 -75 d -20 15 d -24 -59 d cl s 0 0 0.8 c 1003 1280 m -6 -31 d -10
- 32 d f 0 0.2 0.8 c 1012 1335 m -9 -55 d -16 1 d -13 42 d 13 7 d f 0 0.4 0.8 c
- 994 1335 m 24 33 d -6 -33 d -25 -5 d f black 994 1335 m 24 33 d -21 -119 d -23
- 74 d cl s 0 0.2 0.8 c 971 1262 m 20 62 d -4 6 d -13 -7 d -24 -6 d f 0 0.4 0.8 c
- 991 1324 m 3 11 d -7 -5 d f black 971 1262 m 23 73 d -20 -12 d -24 -6 d cl s 0
- 0.2 0.8 c 947 1269 m 24 -7 d -21 55 d -23 8 d f black 947 1269 m 24 -7 d -21 55
- d -23 8 d cl s 0 0 0.8 c 912 1262 m -9 -37 d 6 31 d f 0 0.2 0.8 c 932 1309 m 15
- -40 d -20 56 d -15 -63 d -3 -6 d 11 54 d f 0 0.4 0.8 c 924 1330 m 8 -21 d -12 1
- d f black 924 1330 m 23 -61 d -20 56 d -24 -100 d cl s 0 0 0.8 c 909 1256 m -6
- -31 d -20 30 d f 0 0.2 0.8 c 920 1310 m -11 -54 d -26 -1 d -3 4 d 17 44 d f 0
- 0.4 0.8 c 900 1311 m 24 19 d -4 -20 d -23 -7 d f black 900 1311 m 24 19 d -21
- -105 d -23 34 d cl s 0 0 0.8 c 877 1253 m -21 -40 d 14 25 d f 0 0.2 0.8 c 877
- 1251 m 19 49 d 1 3 d -17 -44 d -3 -6 d -7 -15 d f 0 0.4 0.8 c 896 1300 m 4 11 d
- -3 -8 d f black 877 1251 m 23 60 d -20 -52 d -24 -46 d cl s 0 0 0.8 c 870 1238
- m -14 -25 d -23 7 d 2 20 d f 0 0.2 0.8 c 870 1293 m 7 -42 d -7 -13 d -35 2 d 7
- 57 d f 0 0.4 0.8 c 860 1353 m 10 -60 d -28 4 d 7 57 d f 0 0.6 0.8 c 853 1393 m
- 7 -40 d -11 1 d f black 853 1393 m 24 -142 d -21 -38 d -23 7 d cl s 0 0 0.8 c
- 835 1240 m -2 -20 d -19 17 d f 0 0.2 0.8 c 842 1297 m -7 -57 d -21 -3 d -5 4 d
- 10 50 d f 0 0.4 0.8 c 849 1354 m -7 -57 d -23 -6 d 10 54 d f 0 0.6 0.8 c 830
- 1347 m 23 46 d -4 -39 d -20 -9 d f black 830 1347 m 23 46 d -20 -173 d -24 21 d
- cl s 0 0.2 0.8 c 819 1291 m -10 -50 d -23 8 d 8 37 d f 0 0.4 0.8 c 829 1345 m
- -10 -54 d -25 -5 d 12 53 d f 0 0.6 0.8 c 806 1341 m 24 6 d -1 -2 d -23 -6 d f
- black 806 1341 m 24 6 d -21 -106 d -23 8 d cl s 0 0.2 0.8 c 794 1286 m -8 -37 d
- -24 -6 d 11 35 d f 0 0.4 0.8 c 783 1308 m 22 31 d 1 X -12 -53 d -21 -8 d f 0
- 0.6 0.8 c 805 1339 m 1 2 d -2 Y f black 783 1308 m 23 33 d -20 -92 d -24 -6 d
- cl s 0 0 0.8 c 754 1222 m -15 -39 d 6 31 d f 0 0.2 0.8 c 773 1278 m -11 -35 d
- -8 -21 d -9 -8 d 10 54 d f 0 0.4 0.8 c 759 1288 m 24 20 d -10 -30 d -18 -10 d f
- black 759 1288 m 24 20 d -21 -65 d -23 -60 d cl s 0 0 0.8 c 745 1214 m -6 -31 d
- -24 7 d 6 18 d f 0 0.2 0.8 c 736 1256 m 3 4 d 16 8 d -10 -54 d -24 -6 d f 0 0.4
- 0.8 c 739 1260 m 20 28 d -4 -20 d f black 736 1256 m 23 32 d -20 -105 d -24 7 d
- cl s 0 0 0.8 c 721 1208 m -6 -18 d -12 19 d f 0 0.2 0.8 c 734 1258 m 2 -2 d -15
- -48 d -18 1 d -11 16 d 9 36 d f 0 0.4 0.8 c 712 1303 m 22 -45 d -33 3 d f black
- 712 1303 m 24 -47 d -21 -66 d -23 35 d cl s 0 0 0.8 c 681 1204 m -13 -26 d 3 20
- d f 0 0.2 0.8 c 701 1261 m -9 -36 d -11 -21 d -10 -6 d 7 57 d f 0 0.4 0.8 c 705
- 1313 m 7 -10 d -11 -42 d -23 -6 d 7 57 d f 0 0.6 0.8 c 689 1338 m 16 -25 d -20
- -1 d f black 689 1338 m 23 -35 d -20 -78 d -24 -47 d cl s 0 0 0.8 c 671 1198 m
- -3 -20 d -23 8 d 2 7 d f 0 0.2 0.8 c 678 1255 m -7 -57 d -24 -5 d 13 52 d f 0
- 0.4 0.8 c 665 1264 m 14 43 d 6 5 d -7 -57 d -18 -10 d f 0 0.6 0.8 c 679 1307 m
- 10 31 d -4 -26 d f black 665 1264 m 24 74 d -21 -160 d -23 8 d cl s 0 0 0.8 c
- 647 1193 m -2 -7 d -5 7 d f 0 0.2 0.8 c 660 1245 m -13 -52 d -7 X -18 27 d 11
- 22 d f 0 0.4 0.8 c 642 1258 m 23 6 d -5 -19 d -27 -3 d f black 642 1258 m 23 6
- d -20 -78 d -23 34 d cl s 0 0.2 0.8 c 618 1199 m 14 33 d 1 10 d -11 -22 d -24 8
- d f 0 0.4 0.8 c 632 1232 m 10 26 d -9 -16 d f black 618 1199 m 24 59 d -20 -38
- d -24 8 d cl s 0 0.2 0.8 c 608 1226 m 10 -27 d -20 29 d -23 -47 d 12 48 d f 0
- 0.4 0.8 c 595 1260 m 13 -34 d -21 3 d f black 595 1260 m 23 -61 d -20 29 d -23
- -47 d cl s 0 0.2 0.8 c 571 1160 m 15 61 d 1 8 d -12 -48 d -24 35 d f 0 0.4 0.8
- c 586 1221 m 9 39 d -8 -31 d f black 571 1160 m 24 100 d -20 -79 d -24 35 d
- cl s 0 0.2 0.8 c 548 1181 m 23 -21 d -20 56 d -23 -6 d f black 548 1181 m 23
- -21 d -20 56 d -23 -6 d cl s 0 0 0.8 c 508 1159 m -4 -9 d 3 6 d f 0 0.2 0.8 c
- 524 1202 m 24 -21 d -20 29 d -20 -51 d -1 -3 d f black 524 1202 m 24 -21 d -20
- 29 d -24 -60 d cl s 0 0 0.8 c 507 1156 m -3 -6 d -5 7 d f 0 0.2 0.8 c 521 1204
- m 3 -2 d -17 -46 d -8 1 d -18 27 d 11 22 d f 0 0.4 0.8 c 501 1223 m 20 -19 d
- -29 2 d f black 501 1223 m 23 -21 d -20 -52 d -23 34 d cl s 0 0 0.8 c 477 1069
- m 10 64 d -14 17 d -16 -66 d f 0 0.2 0.8 c 487 1133 m 10 65 d -5 8 d -11 -22 d
- -8 -34 d f 0 0.4 0.8 c 497 1198 m 4 25 d -9 -17 d f black 477 1069 m 24 154 d
- -20 -39 d -24 -100 d cl s 0 0 0.8 c 454 1063 m 23 6 d -20 15 d -23 -6 d f black
- 454 1063 m 23 6 d -20 15 d -23 -6 d cl s 0 0 0.8 c 430 1057 m 24 6 d -20 15 d
- -24 -6 d f black 430 1057 m 24 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 407 1051 m
- 23 6 d -20 15 d -23 -6 d f black 407 1051 m 23 6 d -20 15 d -23 -6 d cl s 0 0
- 0.8 c 1508 1310 m 23 6 d -20 16 d -24 -6 d f black 1508 1310 m 23 6 d -20 16 d
- -24 -6 d cl s 0 0 0.8 c 1484 1304 m 24 6 d -21 16 d -23 -6 d f black 1484 1304
- m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1461 1298 m 23 6 d -20 16 d -24 -6 d
- f black 1461 1298 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1456 1359 m 5 -61 d
- -21 16 d -10 59 d f 0 0.2 0.8 c 1451 1420 m 5 -61 d -26 14 d -11 60 d f 0 0.4
- 0.8 c 1446 1481 m 5 -61 d -32 13 d -2 9 d 7 47 d f 0 0.6 0.8 c 1441 1542 m 5
- -61 d -22 8 d 7 57 d f 0 0.8 0.8 c 1437 1588 m 4 -46 d -10 4 d f black 1437
- 1588 m 24 -290 d -21 16 d -23 128 d cl s 0 0.4 0.8 c 1424 1489 m -7 -47 d -24 8
- d 20 24 d f 0 0.6 0.8 c 1414 1475 m 13 63 d 4 8 d -7 -57 d -11 -15 d f 0 0.8
- 0.8 c 1427 1538 m 10 50 d -6 -42 d f black 1414 1475 m 23 113 d -20 -146 d -24
- 8 d cl s 0 0.4 0.8 c 1413 1474 m -20 -24 d -23 -20 d 8 46 d f 0 0.6 0.8 c 1396
- 1531 m 18 -56 d -1 -1 d -35 2 d 9 55 d f 0 0.8 0.8 c 1390 1549 m 6 -18 d -9 X f
- black 1390 1549 m 24 -74 d -21 -25 d -23 -20 d cl s 0 0.2 0.8 c 1352 1416 m -5
- -5 d 1 2 d f 0 0.4 0.8 c 1367 1436 m 5 26 d 6 14 d -8 -46 d -18 -14 d -4 -3 d f
- 0 0.6 0.8 c 1372 1462 m 14 66 d 1 3 d -9 -55 d f 0 0.8 0.8 c 1386 1528 m 4 21 d
- -3 -18 d f black 1367 1436 m 23 113 d -20 -119 d -23 -19 d cl s 0 0.2 0.8 c
- 1343 1363 m 11 33 d -6 17 d -1 -2 d -2 3 d -11 -14 d f 0 0.4 0.8 c 1354 1396 m
- 13 40 d -19 -23 d -3 1 d -22 31 d 11 -45 d f black 1343 1363 m 24 73 d -20 -25
- d -24 34 d cl s 0 0 0.8 c 1304 1341 m -4 -23 d 5 18 d f 0 0.2 0.8 c 1320 1383 m
- 23 -20 d -9 37 d -18 7 d -12 -66 d 1 -5 d f 0 0.4 0.8 c 1334 1400 m -11 45 d -7
- -38 d f black 1320 1383 m 23 -20 d -20 82 d -23 -127 d cl s 0 0 0.8 c 1305 1336
- m -5 -18 d -24 -6 d 3 20 d f 0 0.2 0.8 c 1318 1386 m 2 -3 d -15 -47 d -26 -4 d
- 10 55 d f 0 0.4 0.8 c 1296 1431 m 22 -45 d -29 1 d f black 1296 1431 m 24 -48 d
- -20 -65 d -24 -6 d cl s 0 0 0.8 c 1279 1332 m -3 -20 d -6 21 d f 0 0.2 0.8 c
- 1289 1387 m -10 -55 d -9 1 d -17 54 d 3 Y f 0 0.4 0.8 c 1293 1442 m 3 -11 d -7
- -44 d -36 3 d 9 55 d f 0 0.6 0.8 c 1275 1500 m 18 -58 d -31 3 d 10 55 d f 0 0.8
- 0.8 c 1273 1506 m 2 -6 d -3 X f black 1273 1506 m 23 -75 d -20 -119 d -23 75 d
- cl s 0 0.2 0.8 c 1253 1390 m -3 Y -6 2 d f 0 0.4 0.8 c 1262 1445 m -9 -55 d -6
- -1 d -18 6 d 13 42 d f 0 0.6 0.8 c 1249 1460 m 20 38 d 3 2 d -10 -55 d -20 -8 d
- f 0 0.8 0.8 c 1269 1498 m 4 8 d -1 -6 d f black 1249 1460 m 24 46 d -20 -119 d
- -24 8 d cl s 0 0.2 0.8 c 1223 1383 m -17 -35 d 6 25 d f 0 0.4 0.8 c 1242 1437 m
- -13 -42 d -6 -12 d -11 -10 d 14 52 d f 0 0.6 0.8 c 1226 1427 m 23 33 d -7 -23 d
- -16 -12 d f black 1226 1427 m 23 33 d -20 -65 d -23 -47 d cl s 0 0.2 0.8 c 1202
- 1354 m 2 3 d 8 16 d -6 -25 d -24 21 d f 0 0.4 0.8 c 1204 1357 m 21 68 d 1 X -14
- -52 d f 0 0.6 0.8 c 1225 1425 m 1 2 d -2 Y f black 1202 1354 m 24 73 d -20 -79
- d -24 21 d cl s 0 0.2 0.8 c 1200 1356 m 2 -2 d -20 15 d -23 -46 d 11 35 d f 0
- 0.4 0.8 c 1179 1388 m 21 -32 d -30 2 d f black 1179 1388 m 23 -34 d -20 15 d
- -23 -46 d cl s 0 0 0.8 c 1151 1302 m -16 -39 d 6 31 d f 0 0.2 0.8 c 1170 1358 m
- -11 -35 d -8 -21 d -10 -8 d 10 54 d f 0 0.4 0.8 c 1155 1368 m 24 20 d -9 -30 d
- -19 -10 d f black 1155 1368 m 24 20 d -20 -65 d -24 -60 d cl s 0 0 0.8 c 1141
- 1294 m -6 -31 d -15 31 d f 0 0.2 0.8 c 1151 1348 m -10 -54 d -21 X -8 17 d 7 38
- d f 0 0.4 0.8 c 1139 1403 m 16 -35 d -4 -20 d -32 1 d 10 54 d f 0 0.6 0.8 c
- 1132 1416 m 7 -13 d -10 X f black 1132 1416 m 23 -48 d -20 -105 d -23 48 d cl s
- 0 0.2 0.8 c 1119 1349 m -7 -38 d -24 7 d 5 27 d f 0 0.4 0.8 c 1129 1403 m -10
- -54 d -26 -4 d 11 54 d f 0 0.6 0.8 c 1108 1424 m 24 -8 d -3 -13 d -25 -4 d f
- black 1108 1424 m 24 -8 d -20 -105 d -24 7 d cl s 0 0.2 0.8 c 1093 1345 m -5
- -27 d -6 29 d f 0 0.4 0.8 c 1085 1377 m 7 14 d 12 8 d -11 -54 d -11 2 d -14 59
- d 8 -10 d f 0 0.6 0.8 c 1092 1391 m 16 33 d -4 -25 d -36 7 d -3 14 d 11 -24 d f
- black 1085 1377 m 23 47 d -20 -106 d -23 102 d cl s 0 0.2 0.8 c 1050 1339 m -9
- -46 d 8 38 d f 0 0.4 0.8 c 1075 1387 m 10 -10 d -9 19 d -14 8 d -12 -65 d -1 -8
- d 10 54 d f 0 0.6 0.8 c 1061 1398 m 14 -11 d 1 9 d -11 24 d -3 -16 d -3 -19 d f
- black 1061 1398 m 24 -21 d -20 43 d -24 -127 d cl s 0 0.2 0.8 c 1049 1331 m -8
- -38 d -13 40 d f 0 0.4 0.8 c 1038 1365 m 10 15 d 11 5 d -10 -54 d -21 2 d -10
- 35 d f 0 0.6 0.8 c 1048 1380 m 13 18 d -2 -13 d f black 1038 1365 m 23 33 d -20
- -105 d -23 75 d cl s 0 0.4 0.8 c 1015 1359 m 23 6 d -20 3 d -24 -33 d f black
- 1015 1359 m 23 6 d -20 3 d -24 -33 d cl s 0 0.2 0.8 c 991 1324 m -20 -62 d 14
- 46 d f 0 0.4 0.8 c 991 1327 m 24 32 d -21 -24 d -3 -11 d -6 -16 d f black 991
- 1327 m 24 32 d -21 -24 d -23 -73 d cl s 0 0.2 0.8 c 985 1308 m -14 -46 d -24 7
- d 5 40 d f 0 0.4 0.8 c 983 1363 m 8 -36 d -6 -19 d -33 1 d 8 56 d f 0 0.6 0.8 c
- 969 1422 m 14 -59 d -23 2 d 7 57 d f 0 0.8 0.8 c 968 1428 m 1 -6 d -2 X f black
- 968 1428 m 23 -101 d -20 -65 d -24 7 d cl s 0 0.2 0.8 c 952 1309 m -5 -40 d -15
- 40 d f 0 0.4 0.8 c 960 1365 m -8 -56 d -20 X -8 21 d 14 28 d f 0 0.6 0.8 c 944
- 1368 m 21 53 d 2 1 d -7 -57 d -22 -7 d f 0 0.8 0.8 c 965 1421 m 3 7 d -1 -6 d f
- black 944 1368 m 24 60 d -21 -159 d -23 61 d cl s 0 0.4 0.8 c 921 1336 m 10 14
- d 7 8 d -14 -28 d -24 -19 d f 0 0.6 0.8 c 931 1350 m 13 18 d -6 -10 d f black
- 921 1336 m 23 32 d -20 -38 d -24 -19 d cl s 0 0.2 0.8 c 896 1300 m -19 -49 d 11
- 35 d f 0 0.4 0.8 c 897 1316 m 24 20 d -21 -25 d -4 -11 d -8 -14 d f black 897
- 1316 m 24 20 d -21 -25 d -23 -60 d cl s 0 0.2 0.8 c 888 1286 m -11 -35 d -7 42
- d f 0 0.4 0.8 c 874 1297 m 23 19 d -9 -30 d -18 7 d -10 60 d 4 -10 d f 0 0.6
- 0.8 c 860 1353 m -7 40 d 11 -50 d f black 874 1297 m 23 19 d -20 -65 d -24 142
- d cl s 0 0.4 0.8 c 850 1291 m 24 6 d -10 46 d -33 1 d f 0 0.6 0.8 c 864 1343 m
- -11 50 d -23 -46 d 1 -3 d f black 850 1291 m 24 6 d -21 96 d -23 -46 d cl s 0
- 0.4 0.8 c 827 1298 m 23 -7 d -19 53 d -23 -6 d f 0 0.6 0.8 c 831 1344 m -1 3 d
- -24 -6 d 2 -3 d f black 827 1298 m 23 -7 d -20 56 d -24 -6 d cl s 0 0.4 0.8 c
- 803 1279 m 24 19 d -19 40 d -3 1 d -22 -31 d f 0 0.6 0.8 c 808 1338 m -2 3 d -1
- -2 d f black 803 1279 m 24 19 d -21 43 d -23 -33 d cl s 0 0.4 0.8 c 781 1312 m
- 22 -33 d -20 29 d -24 -20 d 20 24 d f 0 0.6 0.8 c 780 1313 m 1 -1 d -2 X f
- black 780 1313 m 23 -34 d -20 29 d -24 -20 d cl s 0 0.2 0.8 c 739 1260 m -3 -4
- d 5 -1 d f 0 0.4 0.8 c 756 1253 m 23 58 d 1 Y -20 -24 d -20 -28 d 2 -5 d f 0
- 0.6 0.8 c 779 1311 m 1 2 d -1 -1 d f black 756 1253 m 24 60 d -21 -25 d -23 -32
- d cl s 0 0.2 0.8 c 741 1255 m -5 1 d -2 2 d f 0 0.4 0.8 c 745 1303 m 11 -50 d
- -15 2 d -7 3 d -22 45 d 4 9 d f 0 0.6 0.8 c 733 1355 m 12 -52 d -29 9 d f black
- 733 1355 m 23 -102 d -20 3 d -24 47 d cl s 0 0.4 0.8 c 716 1312 m -4 -9 d -7 10
- d f 0 0.6 0.8 c 709 1349 m 24 6 d -17 -43 d -11 1 d -16 25 d f black 709 1349 m
- 24 6 d -21 -52 d -23 35 d cl s 0 0.4 0.8 c 686 1249 m 9 41 d -16 17 d -14 -43 d
- f 0 0.6 0.8 c 695 1290 m 14 59 d -20 -11 d -10 -31 d f black 686 1249 m 23 100
- d -20 -11 d -24 -74 d cl s 0 0.4 0.8 c 663 1282 m 23 -33 d -21 15 d -23 -6 d 19
- 24 d f 0 0.6 0.8 c 662 1283 m 1 -1 d -2 X f black 662 1283 m 24 -34 d -21 15 d
- -23 -6 d cl s 0 0.2 0.8 c 632 1232 m -14 -33 d 5 26 d f 0 0.4 0.8 c 661 1282 m
- -19 -24 d -10 -26 d -9 -7 d 11 54 d f 0 0.6 0.8 c 639 1304 m 23 -21 d -1 -1 d
- -27 -3 d f black 639 1304 m 23 -21 d -20 -25 d -24 -59 d cl s 0 0.2 0.8 c 623
- 1225 m -5 -26 d -10 27 d f 0 0.4 0.8 c 634 1279 m -11 -54 d -15 1 d -13 34 d 7
- 19 d f 0 0.6 0.8 c 615 1312 m 24 -8 d -5 -25 d -32 X f black 615 1312 m 24 -8 d
- -21 -105 d -23 61 d cl s 0 0.2 0.8 c 586 1221 m -15 -61 d 18 44 d f 0 0.4 0.8 c
- 592 1212 m 13 55 d -3 12 d -7 -19 d -9 -39 d 3 -17 d f 0 0.6 0.8 c 605 1267 m
- 10 45 d -13 -33 d f black 592 1212 m 23 100 d -20 -52 d -24 -100 d cl s 0 0.2
- 0.8 c 589 1204 m -18 -44 d -23 21 d 4 27 d f 0 0.4 0.8 c 579 1260 m 13 -48 d -3
- -8 d -37 4 d 10 54 d f 0 0.6 0.8 c 568 1300 m 11 -40 d -17 2 d f black 568 1300
- m 24 -88 d -21 -52 d -23 21 d cl s 0 0.2 0.8 c 552 1208 m -4 -27 d -24 21 d 1 2
- d f 0 0.4 0.8 c 562 1262 m -10 -54 d -27 -4 d 19 48 d f 0 0.6 0.8 c 545 1253 m
- 23 47 d -6 -38 d -18 -10 d f black 545 1253 m 23 47 d -20 -119 d -24 21 d cl s
- 0 0.2 0.8 c 525 1204 m -1 -2 d -3 2 d f 0 0.4 0.8 c 521 1207 m 23 44 d 1 Y -19
- -48 d -4 X -20 19 d f 0 0.6 0.8 c 544 1251 m 1 2 d -1 -1 d f black 521 1207 m
- 24 46 d -21 -51 d -23 21 d cl s 0 0 0.8 c 498 1053 m 10 65 d -21 15 d -10 -64 d
- f 0 0.2 0.8 c 508 1118 m 10 65 d -21 15 d -10 -65 d f 0 0.4 0.8 c 518 1183 m 3
- 24 d -20 16 d -4 -25 d f black 498 1053 m 23 154 d -20 16 d -24 -154 d cl s 0 0
- 0.8 c 474 1047 m 24 6 d -21 16 d -23 -6 d f black 474 1047 m 24 6 d -21 16 d
- -23 -6 d cl s 0 0 0.8 c 451 1041 m 23 6 d -20 16 d -24 -6 d f black 451 1041 m
- 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 427 1035 m 24 6 d -21 16 d -23 -6 d f
- black 427 1035 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1528 1295 m 24 6 d -21
- 15 d -23 -6 d f black 1528 1295 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 1505
- 1289 m 23 6 d -20 15 d -24 -6 d f black 1505 1289 m 23 6 d -20 15 d -24 -6 d
- cl s 0 0 0.8 c 1481 1283 m 24 6 d -21 15 d -23 -6 d f black 1481 1283 m 24 6 d
- -21 15 d -23 -6 d cl s 0 0 0.8 c 1477 1344 m 4 -61 d -20 15 d -5 61 d f 0 0.2
- 0.8 c 1472 1405 m 5 -61 d -21 15 d -5 61 d f 0 0.4 0.8 c 1468 1466 m 4 -61 d
- -21 15 d -5 61 d f 0 0.6 0.8 c 1464 1527 m 4 -61 d -22 15 d -5 61 d f 0 0.8 0.8
- c 1459 1588 m 5 -61 d -23 15 d -4 46 d 8 9 d f 0 0.8 0.6 c 1458 1613 m 1 -25 d
- -14 9 d f black 1458 1613 m 23 -330 d -20 15 d -24 290 d cl s 0 0.6 0.8 c 1427
- 1538 m -13 -63 d 18 46 d f 0 0.8 0.8 c 1434 1526 m 16 60 d -5 11 d -8 -9 d -10
- -50 d 5 -17 d f 0 0.8 0.6 c 1450 1586 m 8 27 d -13 -16 d f black 1434 1526 m 24
- 87 d -21 -25 d -23 -113 d cl s 0 0.6 0.8 c 1432 1521 m -18 -46 d -18 56 d f 0
- 0.8 0.8 c 1423 1579 m 11 -53 d -2 -5 d -36 10 d -6 18 d 8 36 d f 0 0.8 0.6 c
- 1411 1638 m 12 -59 d -25 6 d 12 53 d f 0 0.8 0.4 c 1411 1641 m -3 Y -1 X f
- black 1411 1641 m 23 -115 d -20 -51 d -24 74 d cl s 0 0.4 0.8 c 1372 1462 m -5
- -26 d 3 22 d f 0 0.6 0.8 c 1386 1528 m -14 -66 d -2 -4 d 9 56 d f 0 0.8 0.8 c
- 1387 1568 m 1 2 d 10 15 d -8 -36 d -4 -21 d -7 -14 d f 0 0.8 0.6 c 1388 1570 m
- 22 68 d -12 -53 d f 0 0.8 0.4 c 1410 1638 m 1 3 d -1 -3 d f black 1387 1568 m
- 24 73 d -21 -92 d -23 -113 d cl s 0 0.2 0.8 c 1354 1396 m -11 -33 d 3 28 d f 0
- 0.4 0.8 c 1370 1458 m -3 -22 d -13 -40 d -8 -5 d 6 58 d f 0 0.6 0.8 c 1379 1514
- m -9 -56 d -18 -9 d 5 58 d f 0 0.8 0.8 c 1384 1569 m 3 -1 d -8 -54 d -22 -7 d 6
- 58 d f 0 0.8 0.6 c 1364 1575 m 20 -6 d -21 -4 d f black 1364 1575 m 23 -7 d -20
- -132 d -24 -73 d cl s 0 0.2 0.8 c 1346 1391 m -3 -28 d -23 20 d 1 3 d f 0 0.4
- 0.8 c 1352 1449 m -6 -58 d -25 -5 d 13 52 d f 0 0.6 0.8 c 1340 1462 m 8 35 d 9
- 10 d -5 -58 d -18 -11 d f 0 0.8 0.8 c 1348 1497 m 13 66 d 2 2 d -6 -58 d f 0
- 0.8 0.6 c 1361 1563 m 3 12 d -1 -10 d f black 1340 1462 m 24 113 d -21 -212 d
- -23 20 d cl s 0 0.2 0.8 c 1321 1386 m -1 -3 d -2 3 d f 0 0.4 0.8 c 1334 1438 m
- -13 -52 d -3 X -22 45 d 5 9 d f 0 0.6 0.8 c 1317 1469 m 23 -7 d -6 -24 d -33 2
- d f black 1317 1469 m 23 -7 d -20 -79 d -24 48 d cl s 0 0.4 0.8 c 1293 1383 m
- 11 41 d -3 16 d -5 -9 d -3 11 d -7 -15 d f 0 0.6 0.8 c 1304 1424 m 13 45 d -16
- -29 d -8 2 d -18 58 d -1 -2 d 12 -71 d f 0 0.8 0.8 c 1275 1500 m -2 6 d 1 -8 d
- f black 1293 1383 m 24 86 d -21 -38 d -23 75 d cl s 0 0.4 0.8 c 1270 1390 m 23
- -7 d -7 44 d -26 -4 d f 0 0.6 0.8 c 1286 1427 m -12 71 d -5 X -20 -38 d 11 -37
- d f 0 0.8 0.8 c 1274 1498 m -1 8 d -4 -8 d f black 1270 1390 m 23 -7 d -20 123
- d -24 -46 d cl s 0 0.4 0.8 c 1266 1415 m 4 -25 d -10 33 d f 0 0.6 0.8 c 1257
- 1474 m 9 -59 d -6 8 d -11 37 d -23 -33 d 9 53 d f 0 0.8 0.8 c 1248 1534 m 9 -60
- d -22 6 d 9 55 d f 0 0.8 0.6 c 1246 1546 m 2 -12 d -4 1 d f black 1246 1546 m
- 24 -156 d -21 70 d -23 -33 d cl s 0 0.2 0.8 c 1204 1357 m -2 -3 d 1 3 d f 0 0.4
- 0.8 c 1225 1425 m -21 -68 d -1 X 9 55 d f 0 0.6 0.8 c 1235 1480 m -9 -53 d -1
- -2 d -13 -13 d 10 54 d f 0 0.8 0.8 c 1223 1472 m 19 61 d 2 2 d -9 -55 d -13 -14
- d f 0 0.8 0.6 c 1242 1533 m 4 13 d -2 -11 d f black 1223 1472 m 23 74 d -20
- -119 d -24 -73 d cl s 0 0.2 0.8 c 1203 1357 m -1 -3 d -2 2 d f 0 0.4 0.8 c 1212
- 1412 m -9 -55 d -3 -1 d -21 32 d 3 23 d f 0 0.6 0.8 c 1222 1466 m -10 -54 d -30
- -1 d 7 56 d f 0 0.8 0.8 c 1207 1524 m 16 -52 d -1 -6 d -33 1 d 7 57 d f 0 0.8
- 0.6 c 1199 1547 m 8 -23 d -11 X f black 1199 1547 m 24 -75 d -21 -118 d -23 34
- d cl s 0 0.4 0.8 c 1182 1411 m -3 -23 d -24 -20 d 4 37 d f 0 0.6 0.8 c 1189
- 1467 m -7 -56 d -23 -6 d 5 58 d f 0 0.8 0.8 c 1196 1524 m -7 -57 d -25 -4 d 5
- 58 d f 0 0.8 0.6 c 1183 1580 m 16 -33 d -3 -23 d -27 -3 d 5 58 d f 0 0.8 0.4 c
- 1176 1595 m 7 -15 d -9 -1 d f black 1176 1595 m 23 -48 d -20 -159 d -24 -20 d
- cl s 0 0.4 0.8 c 1159 1405 m -4 -37 d -16 35 d f 0 0.6 0.8 c 1164 1463 m -5 -58
- d -20 -2 d -7 13 d 18 34 d f 0 0.8 0.8 c 1152 1454 m 10 58 d 7 9 d -5 -58 d -14
- -13 d f 0 0.8 0.6 c 1162 1512 m 11 65 d 1 2 d -5 -58 d f 0 0.8 0.4 c 1173 1577
- m 3 18 d -2 -16 d f black 1152 1454 m 24 141 d -21 -227 d -23 48 d cl s 0 0.6
- 0.8 c 1150 1450 m -18 -34 d -24 8 d 11 26 d f 0 0.8 0.8 c 1129 1475 m 23 -21 d
- -2 -4 d -31 X f black 1129 1475 m 23 -21 d -20 -38 d -24 8 d cl s 0 0.4 0.8 c
- 1092 1391 m -7 -14 d 2 11 d f 0 0.6 0.8 c 1119 1450 m -11 -26 d -16 -33 d -5 -3
- d 9 55 d f 0 0.8 0.8 c 1105 1496 m 24 -21 d -10 -25 d -23 -7 d f black 1105
- 1496 m 24 -21 d -21 -51 d -23 -47 d cl s 0 0.4 0.8 c 1087 1388 m -2 -11 d -10
- 10 d f 0 0.6 0.8 c 1096 1443 m -9 -55 d -12 -1 d -14 11 d 15 36 d f 0 0.8 0.8 c
- 1082 1450 m 23 46 d -9 -53 d -20 -9 d f black 1082 1450 m 23 46 d -20 -119 d
- -24 21 d cl s 0 0.4 0.8 c 1048 1380 m -10 -15 d 2 11 d f 0 0.6 0.8 c 1076 1434
- m -15 -36 d -13 -18 d -8 -4 d 8 56 d f 0 0.8 0.8 c 1063 1487 m 19 -37 d -6 -16
- d -28 -2 d 9 55 d f 0 0.8 0.6 c 1058 1498 m 5 -11 d -6 X f black 1058 1498 m 24
- -48 d -21 -52 d -23 -33 d cl s 0 0.4 0.8 c 1040 1376 m -2 -11 d -23 -6 d 12 Y f
- 0 0.6 0.8 c 1048 1432 m -8 -56 d -25 -5 d 5 58 d f 0 0.8 0.8 c 1057 1487 m -9
- -55 d -28 -3 d 5 59 d f 0 0.8 0.6 c 1049 1546 m 9 -48 d -1 -11 d -32 1 d 5 58 d
- f 0 0.8 0.4 c 1036 1605 m 13 -59 d -19 X 4 59 d f 0 0.8 0.2 c 1035 1613 m 1 -8
- d -2 X f black 1035 1613 m 23 -115 d -20 -133 d -23 -6 d cl s 0 0.4 0.8 c 1011
- 1338 m 1 12 d 3 21 d -12 Y -24 -32 d f 0 0.6 0.8 c 1012 1350 m 6 64 d 2 15 d -5
- -58 d f 0 0.8 0.8 c 1018 1414 m 5 63 d 2 11 d -5 -59 d f 0 0.8 0.6 c 1023 1477
- m 6 64 d 1 5 d -5 -58 d f 0 0.8 0.4 c 1029 1541 m 5 63 d 1 Y -4 -59 d f 0 0.8
- 0.2 c 1034 1604 m 1 9 d -1 -8 d f black 1011 1338 m 24 275 d -20 -254 d -24 -32
- d cl s 0 0.4 0.8 c 1009 1349 m 2 -11 d -20 -11 d -8 36 d f 0 0.6 0.8 c 998 1409
- m 11 -60 d -26 14 d -14 59 d f 0 0.8 0.8 c 988 1466 m 10 -57 d -29 13 d -1 6 d
- f black 988 1466 m 23 -128 d -20 -11 d -23 101 d cl s 0 0.6 0.8 c 965 1421 m
- -21 -53 d 9 41 d f 0 0.8 0.8 c 964 1460 m 24 6 d -20 -38 d -3 -7 d -12 -12 d f
- black 964 1460 m 24 6 d -20 -38 d -24 -60 d cl s 0 0.4 0.8 c 931 1350 m -10 -14
- d 3 9 d f 0 0.6 0.8 c 953 1409 m -9 -41 d -13 -18 d -7 -5 d 15 50 d f 0 0.8 0.8
- c 941 1401 m 23 59 d -11 -51 d -14 -14 d f black 941 1401 m 23 59 d -20 -92 d
- -23 -32 d cl s 0 0.4 0.8 c 924 1345 m -3 -9 d -24 -20 d 6 20 d f 0 0.6 0.8 c
- 917 1381 m 12 10 d 10 4 d -15 -50 d -21 -9 d f 0 0.8 0.8 c 929 1391 m 12 10 d
- -2 -6 d f black 917 1381 m 24 20 d -20 -65 d -24 -20 d cl s 0 0.4 0.8 c 903
- 1336 m -6 -20 d -23 -19 d 6 33 d f 0 0.6 0.8 c 912 1386 m 5 -5 d -14 -45 d -23
- -6 d 11 55 d f 0 0.8 0.8 c 894 1402 m 18 -16 d -21 -1 d f black 894 1402 m 23
- -21 d -20 -65 d -23 -19 d cl s 0 0.4 0.8 c 880 1330 m -6 -33 d -24 -6 d 7 33 d
- f 0 0.6 0.8 c 891 1385 m -11 -55 d -23 -6 d 10 55 d f 0 0.8 0.8 c 870 1396 m 24
- 6 d -3 -17 d -24 -6 d f black 870 1396 m 24 6 d -20 -105 d -24 -6 d cl s 0 0.4
- 0.8 c 857 1324 m -7 -33 d -23 7 d 4 22 d f 0 0.6 0.8 c 867 1379 m -10 -55 d -26
- -4 d 12 53 d f 0 0.8 0.8 c 847 1390 m 23 6 d -3 -17 d -24 -6 d f black 847 1390
- m 23 6 d -20 -105 d -23 7 d cl s 0 0.4 0.8 c 831 1320 m -4 -22 d -24 -19 d 4 35
- d f 0 0.6 0.8 c 843 1373 m -12 -53 d -24 -6 d 7 57 d f 0 0.8 0.8 c 832 1428 m
- 15 -38 d -4 -17 d -29 -2 d 7 57 d f 0 0.8 0.6 c 823 1451 m 9 -23 d -11 X f
- black 823 1451 m 24 -61 d -20 -92 d -24 -19 d cl s 0 0.4 0.8 c 807 1314 m -4
- -35 d -22 33 d f 0 0.6 0.8 c 800 1338 m 4 21 d 10 12 d -7 -57 d -26 -2 d -1 1 d
- f 0 0.8 0.8 c 804 1359 m 14 66 d 3 3 d -7 -57 d f 0 0.8 0.6 c 818 1425 m 5 26 d
- -2 -23 d f black 800 1338 m 23 113 d -20 -172 d -23 34 d cl s 0 0.4 0.8 c 779
- 1311 m -23 -58 d 5 49 d f 0 0.6 0.8 c 796 1357 m 4 -19 d -20 -25 d -1 -2 d -18
- -9 d 6 57 d f 0 0.8 0.8 c 784 1416 m 12 -59 d -29 2 d 6 58 d f 0 0.8 0.6 c 776
- 1453 m 8 -37 d -11 1 d f black 776 1453 m 24 -115 d -20 -25 d -24 -60 d cl s 0
- 0.4 0.8 c 761 1302 m -5 -49 d -11 50 d f 0 0.6 0.8 c 767 1359 m -6 -57 d -16 1
- d -12 52 d 1 5 d f 0 0.8 0.8 c 773 1417 m -6 -58 d -33 1 d 16 51 d f 0 0.8 0.6
- c 753 1420 m 23 33 d -3 -36 d -23 -6 d f black 753 1420 m 23 33 d -20 -200 d
- -23 102 d cl s 0 0.6 0.8 c 734 1360 m -1 -5 d -24 -6 d 5 3 d f 0 0.8 0.8 c 730
- 1360 m 18 47 d 2 4 d -16 -51 d -20 -8 d f 0 0.8 0.6 c 748 1407 m 5 13 d -3 -9 d
- f black 730 1360 m 23 60 d -20 -65 d -24 -6 d cl s 0 0.4 0.8 c 695 1290 m -9
- -41 d 19 24 d f 0 0.6 0.8 c 706 1274 m 18 65 d -10 13 d -5 -3 d -14 -59 d 10
- -17 d f 0 0.8 0.8 c 724 1339 m 6 21 d -16 -8 d f black 706 1274 m 24 86 d -21
- -11 d -23 -100 d cl s 0 0.4 0.8 c 705 1273 m -19 -24 d -23 33 d f 0 0.6 0.8 c
- 696 1332 m 10 -58 d -1 -1 d -42 9 d -1 1 d 9 54 d f 0 0.8 0.8 c 687 1391 m 9
- -59 d -25 5 d 8 56 d f 0 0.8 0.6 c 683 1415 m 4 -24 d -8 2 d f black 683 1415 m
- 23 -141 d -20 -25 d -24 34 d cl s 0 0.6 0.8 c 671 1337 m -9 -54 d -23 21 d 6 29
- d f 0 0.8 0.8 c 679 1393 m -8 -56 d -26 -4 d 12 53 d f 0 0.8 0.6 c 659 1396 m
- 24 19 d -4 -22 d -22 -7 d f black 659 1396 m 24 19 d -21 -132 d -23 21 d cl s 0
- 0.4 0.8 c 636 1215 m 5 40 d -15 6 d f 0 0.6 0.8 c 641 1255 m 8 65 d -4 13 d -6
- -29 d -24 8 d 11 -51 d f 0 0.8 0.8 c 649 1320 m 8 64 d 2 Y -12 -53 d f 0 0.8
- 0.6 c 657 1384 m 2 12 d -2 -10 d f black 636 1215 m 23 181 d -20 -92 d -24 8 d
- cl s 0 0.4 0.8 c 631 1253 m 5 -38 d -10 46 d -21 6 d -13 -55 d 4 48 d f 0 0.6
- 0.8 c 625 1313 m 6 -60 d -5 8 d -11 51 d -10 -45 d -9 -7 d 6 58 d f 0 0.8 0.8 c
- 618 1374 m 7 -61 d -23 5 d 5 58 d f 0 0.8 0.6 c 612 1424 m 6 -50 d -11 2 d f
- black 612 1424 m 24 -209 d -21 97 d -23 -100 d cl s 0 0.4 0.8 c 596 1260 m -4
- -48 d -13 48 d f 0 0.6 0.8 c 602 1318 m -6 -58 d -17 X -11 40 d 15 8 d f 0 0.8
- 0.8 c 589 1311 m 12 58 d 6 7 d -5 -58 d -19 -10 d f 0 0.8 0.6 c 601 1369 m 11
- 55 d -5 -48 d f black 589 1311 m 23 113 d -20 -212 d -24 88 d cl s 0 0.6 0.8 c
- 583 1308 m -15 -8 d -23 -47 d 5 57 d f 0 0.8 0.8 c 581 1364 m 8 -53 d -6 -3 d
- -33 2 d 5 58 d f 0 0.8 0.6 c 573 1424 m 8 -60 d -26 4 d 5 58 d f 0 0.8 0.4 c
- 565 1480 m 8 -56 d -13 2 d f black 565 1480 m 24 -169 d -21 -11 d -23 -47 d
- cl s 0 0.4 0.8 c 544 1251 m -23 -44 d 9 32 d f 0 0.6 0.8 c 542 1286 m 6 Y 8 18
- d -5 -57 d -1 -2 d -14 -12 d f 0 0.8 0.8 c 542 1292 m 8 65 d 5 11 d -5 -58 d f
- 0 0.8 0.6 c 550 1357 m 8 64 d 2 5 d -5 -58 d f 0 0.8 0.4 c 558 1421 m 7 59 d -5
- -54 d f black 542 1286 m 23 194 d -20 -227 d -24 -46 d cl s 0 0 0.8 c 518 1038
- m 6 63 d -16 17 d -10 -65 d f 0 0.2 0.8 c 524 1101 m 6 64 d -12 18 d -10 -65 d
- f 0 0.4 0.8 c 530 1165 m 6 64 d -6 10 d -9 -32 d -3 -24 d f 0 0.6 0.8 c 536
- 1229 m 6 57 d -12 -47 d f black 518 1038 m 24 248 d -21 -79 d -23 -154 d cl s 0
- 0 0.8 c 495 1032 m 23 6 d -20 15 d -24 -6 d f black 495 1032 m 23 6 d -20 15 d
- -24 -6 d cl s 0 0 0.8 c 471 1026 m 24 6 d -21 15 d -23 -6 d f black 471 1026 m
- 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 448 1020 m 23 6 d -20 15 d -24 -6 d f
- black 448 1020 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1548 1279 m 24 6 d -20
- 16 d -24 -6 d f black 1548 1279 m 24 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1525
- 1273 m 23 6 d -20 16 d -23 -6 d f black 1525 1273 m 23 6 d -20 16 d -23 -6 d
- cl s 0 0 0.8 c 1501 1267 m 24 6 d -20 16 d -24 -6 d f black 1501 1267 m 24 6 d
- -20 16 d -24 -6 d cl s 0 0 0.8 c 1497 1328 m 4 -61 d -20 16 d -4 61 d f 0 0.2
- 0.8 c 1492 1389 m 5 -61 d -20 16 d -5 61 d f 0 0.4 0.8 c 1487 1450 m 5 -61 d
- -20 16 d -4 61 d f 0 0.6 0.8 c 1482 1511 m 5 -61 d -19 16 d -4 61 d f 0 0.8 0.8
- c 1478 1557 m 4 -46 d -18 16 d -5 61 d 11 -10 d f 0 0.8 0.6 c 1459 1588 m -1 25
- d 12 -35 d f black 1478 1557 m 23 -290 d -20 16 d -23 330 d cl s 0 0.8 0.8 c
- 1455 1551 m 23 6 d -8 21 d -20 8 d -16 -60 d f 0 0.8 0.6 c 1470 1578 m -12 35 d
- -8 -27 d f black 1455 1551 m 23 6 d -20 56 d -24 -87 d cl s 0 0.8 0.8 c 1451
- 1565 m 4 -14 d -21 -25 d -11 53 d f 0 0.8 0.6 c 1435 1623 m 16 -58 d -28 14 d
- -12 59 d f 0 0.8 0.4 c 1431 1639 m 4 -16 d -24 15 d 3 Y f black 1431 1639 m 24
- -88 d -21 -25 d -23 115 d cl s 0 0.8 0.8 c 1388 1570 m -1 -2 d 1 1 d f 0 0.8
- 0.6 c 1408 1579 m 16 41 d -14 18 d -22 -68 d -1 Y f 0 0.8 0.4 c 1424 1620 m 7
- 19 d -20 2 d -1 -3 d f black 1408 1579 m 23 60 d -20 2 d -24 -73 d cl s 0 0.8
- 0.8 c 1384 1533 m 9 17 d -5 19 d -1 -1 d -3 1 d -11 -12 d f 0 0.8 0.6 c 1393
- 1550 m 15 29 d -20 -10 d -4 X -20 6 d 9 -18 d f black 1384 1533 m 24 46 d -21
- -11 d -23 7 d cl s 0 0.6 0.8 c 1348 1497 m -8 -35 d 4 31 d f 0 0.8 0.8 c 1380
- 1547 m 4 -14 d -11 24 d -12 6 d -13 -66 d -4 -4 d 7 56 d f 0 0.8 0.6 c 1365
- 1605 m 15 -58 d -7 10 d -9 18 d -3 -12 d -10 -14 d 8 57 d f 0 0.8 0.4 c 1361
- 1621 m 4 -16 d -6 1 d f black 1361 1621 m 23 -88 d -20 42 d -24 -113 d cl s 0
- 0.6 0.8 c 1344 1493 m -4 -31 d -23 7 d 10 13 d f 0 0.8 0.8 c 1337 1494 m 8 44 d
- 6 11 d -7 -56 d -17 -11 d f 0 0.8 0.6 c 1345 1538 m 12 65 d 2 3 d -8 -57 d f 0
- 0.8 0.4 c 1357 1603 m 4 18 d -2 -15 d f black 1337 1494 m 24 127 d -21 -159 d
- -23 7 d cl s 0 0.4 0.8 c 1304 1424 m -11 -41 d 3 36 d f 0 0.6 0.8 c 1327 1482 m
- -10 -13 d -13 -45 d -8 -5 d 5 58 d f 0 0.8 0.8 c 1330 1534 m 7 -40 d -10 -12 d
- -26 -5 d 5 59 d f 0 0.8 0.6 c 1319 1594 m 11 -60 d -24 2 d 5 58 d f 0 0.8 0.4 c
- 1314 1623 m 5 -29 d -8 X f black 1314 1623 m 23 -129 d -20 -25 d -24 -86 d cl s
- 0 0.4 0.8 c 1296 1419 m -3 -36 d -23 7 d 4 22 d f 0 0.6 0.8 c 1301 1477 m -5
- -58 d -22 -7 d 10 54 d f 0 0.8 0.8 c 1290 1496 m 6 30 d 10 10 d -5 -59 d -17
- -11 d f 0 0.8 0.6 c 1296 1526 m 12 65 d 3 3 d -5 -58 d f 0 0.8 0.4 c 1308 1591
- m 6 32 d -3 -29 d f black 1290 1496 m 24 127 d -21 -240 d -23 7 d cl s 0 0.4
- 0.8 c 1274 1412 m -4 -22 d -4 25 d f 0 0.6 0.8 c 1284 1466 m -10 -54 d -8 3 d
- -9 59 d f 0 0.8 0.8 c 1267 1517 m 23 -21 d -6 -30 d -27 8 d -9 60 d 16 -14 d f
- 0 0.8 0.6 c 1248 1534 m -2 12 d 18 -26 d f black 1267 1517 m 23 -21 d -20 -106
- d -24 156 d cl s 0 0.8 0.8 c 1266 1518 m 1 -1 d -3 3 d -22 13 d -19 -61 d 7 50
- d f 0 0.8 0.6 c 1251 1576 m 15 -58 d -2 2 d -18 26 d -4 -13 d -12 -11 d 9 56 d
- f 0 0.8 0.4 c 1243 1605 m 8 -29 d -12 2 d f black 1243 1605 m 24 -88 d -21 29 d
- -23 -74 d cl s 0 0.8 0.8 c 1230 1522 m -7 -50 d -16 52 d f 0 0.8 0.6 c 1239
- 1578 m -9 -56 d -23 2 d -8 23 d 19 23 d f 0 0.8 0.4 c 1220 1572 m 23 33 d -4
- -27 d -21 -8 d f black 1220 1572 m 23 33 d -20 -133 d -24 75 d cl s 0 0.6 0.8 c
- 1196 1418 m 3 21 d -5 1 d f 0 0.8 0.8 c 1199 1439 m 10 65 d -23 4 d 8 -68 d f 0
- 0.8 0.6 c 1209 1504 m 10 64 d -1 2 d -19 -23 d -16 33 d -5 -4 d 8 -68 d f 0 0.8
- 0.4 c 1219 1568 m 1 4 d -2 -2 d -35 10 d -7 15 d 2 -19 d f black 1196 1418 m 24
- 154 d -21 -25 d -23 48 d cl s 0 0.6 0.8 c 1192 1437 m 4 -19 d -2 22 d f 0 0.8
- 0.8 c 1180 1496 m 12 -59 d 2 3 d -8 68 d -24 4 d -10 -58 d 12 47 d f 0 0.8 0.6
- c 1173 1533 m 7 -37 d 6 12 d -8 68 d -5 1 d -11 -65 d 2 -11 d f 0 0.8 0.4 c
- 1178 1576 m -2 19 d -3 -18 d f black 1173 1533 m 23 -115 d -20 177 d -24 -141 d
- cl s 0 0.8 0.8 c 1164 1501 m -12 -47 d -23 21 d 8 22 d f 0 0.8 0.6 c 1149 1527
- m 24 6 d -9 -32 d -27 -4 d f black 1149 1527 m 24 6 d -21 -79 d -23 21 d cl s 0
- 0.8 0.8 c 1137 1497 m -8 -22 d -24 21 d 3 X f 0 0.8 0.6 c 1126 1494 m 23 33 d
- -12 -30 d -29 -1 d f black 1126 1494 m 23 33 d -20 -52 d -24 21 d cl s 0 0.8
- 0.8 c 1108 1496 m -3 X -23 -46 d 9 35 d f 0 0.8 0.6 c 1102 1528 m 24 -34 d -18
- 2 d -17 -11 d f black 1102 1528 m 24 -34 d -21 2 d -23 -46 d cl s 0 0.8 0.8 c
- 1091 1485 m -9 -35 d -19 37 d f 0 0.8 0.6 c 1098 1537 m 4 -9 d -11 -43 d -28 2
- d -5 11 d 11 42 d f 0 0.8 0.4 c 1079 1576 m 19 -39 d -29 3 d f black 1079 1576
- m 23 -48 d -20 -78 d -24 48 d cl s 0 0.8 0.8 c 1055 1409 m 8 58 d -14 2 d f 0
- 0.8 0.6 c 1063 1467 m 9 64 d -3 9 d -11 -42 d -9 48 d -7 -10 d 7 -67 d f 0 0.8
- 0.4 c 1072 1531 m 7 45 d -10 -36 d -20 6 d -13 59 d -1 Y 6 -68 d f 0 0.8 0.2 c
- 1036 1605 m -1 8 d 1 -9 d f black 1055 1409 m 24 167 d -21 -78 d -23 115 d cl s
- 0 0.4 0.8 c 1012 1350 m -1 -12 d 1 11 d f 0 0.6 0.8 c 1018 1414 m -6 -64 d -1 Y
- 5 58 d f 0 0.8 0.8 c 1048 1463 m 7 -54 d -6 60 d -26 8 d -5 -63 d -1 -7 d 5 59
- d f 0 0.8 0.6 c 1039 1523 m 9 -60 d 1 6 d -7 67 d -13 5 d -6 -64 d -1 -11 d 5
- 58 d f 0 0.8 0.4 c 1032 1578 m 7 -55 d 3 13 d -6 68 d -2 X -5 -63 d -2 -17 d f
- 0 0.8 0.2 c 1036 1604 m -1 9 d -1 -9 d f black 1032 1578 m 23 -169 d -20 204 d
- -24 -275 d cl s 0 0.4 0.8 c 1012 1349 m -1 -11 d -2 11 d f 0 0.6 0.8 c 1017
- 1407 m -5 -58 d -3 X -11 60 d f 0 0.8 0.8 c 1008 1451 m 1 2 d 13 13 d -5 -59 d
- -19 2 d -10 57 d f 0 0.8 0.6 c 1009 1453 m 12 65 d 6 6 d -5 -58 d f 0 0.8 0.4 c
- 1021 1518 m 11 60 d -5 -54 d f black 1008 1451 m 24 127 d -21 -240 d -23 128 d
- cl s 0 0.8 0.8 c 1008 1452 m -1 Y -20 15 d -24 -6 d 1 2 d f 0 0.8 0.6 c 996
- 1511 m 12 -59 d -43 10 d 10 54 d f 0 0.8 0.4 c 985 1566 m 11 -55 d -21 5 d f
- black 985 1566 m 23 -115 d -20 15 d -24 -6 d cl s 0 0.8 0.8 c 961 1439 m 1 2 d
- 3 21 d -1 -2 d -23 -59 d f 0 0.8 0.6 c 962 1441 m 12 65 d 1 10 d -10 -54 d f 0
- 0.8 0.4 c 974 1506 m 11 60 d -10 -50 d f black 961 1439 m 24 127 d -21 -106 d
- -23 -59 d cl s 0 0.6 0.8 c 929 1391 m -12 -10 d 1 6 d f 0 0.8 0.8 c 961 1440 m
- -1 Y -20 -38 d -12 -10 d -11 -4 d 8 56 d f 0 0.8 0.6 c 945 1499 m 16 -59 d -35
- 3 d 8 57 d f 0 0.8 0.4 c 938 1527 m 7 -28 d -11 1 d f black 938 1527 m 23 -88 d
- -20 -38 d -24 -20 d cl s 0 0.6 0.8 c 918 1387 m -1 -6 d -5 5 d f 0 0.8 0.8 c
- 926 1443 m -8 -56 d -6 -1 d -18 16 d 5 38 d f 0 0.8 0.6 c 934 1500 m -8 -57 d
- -27 -3 d 8 56 d f 0 0.8 0.4 c 914 1548 m 24 -21 d -4 -27 d -27 -4 d f black 914
- 1548 m 24 -21 d -21 -146 d -23 21 d cl s 0 0.8 0.8 c 899 1440 m -5 -38 d -24 -6
- d 8 37 d f 0 0.8 0.6 c 907 1496 m -8 -56 d -21 -7 d 10 54 d f 0 0.8 0.4 c 891
- 1502 m 23 46 d -7 -52 d -19 -9 d f black 891 1502 m 23 46 d -20 -146 d -24 -6 d
- cl s 0 0.8 0.8 c 878 1433 m -8 -37 d -23 -6 d 7 37 d f 0 0.8 0.6 c 888 1487 m
- -10 -54 d -24 -6 d 10 54 d f 0 0.8 0.4 c 867 1496 m 24 6 d -3 -15 d -24 -6 d f
- black 867 1496 m 24 6 d -21 -106 d -23 -6 d cl s 0 0.8 0.8 c 854 1427 m -7 -37
- d -15 38 d f 0 0.8 0.6 c 864 1481 m -10 -54 d -22 1 d -9 23 d 5 34 d f 0 0.8
- 0.4 c 857 1538 m 10 -42 d -3 -15 d -36 4 d 8 56 d f 0 0.8 0.2 c 844 1597 m 13
- -59 d -21 3 d f black 844 1597 m 23 -101 d -20 -106 d -24 61 d cl s 0 0.6 0.8 c
- 804 1359 m -4 -21 d 6 15 d f 0 0.8 0.8 c 820 1390 m 2 15 d -4 20 d -14 -66 d 2
- -6 d f 0 0.8 0.6 c 822 1405 m 7 64 d -1 16 d -5 -34 d -5 -26 d f 0 0.8 0.4 c
- 829 1469 m 8 64 d -1 8 d -8 -56 d f 0 0.8 0.2 c 837 1533 m 7 64 d -8 -56 d f
- black 820 1390 m 24 207 d -21 -146 d -23 -113 d cl s 0 0.6 0.8 c 806 1353 m -6
- -15 d -4 19 d f 0 0.8 0.8 c 818 1404 m 2 -14 d -14 -37 d -10 4 d -12 59 d f 0
- 0.8 0.6 c 811 1464 m 7 -60 d -34 12 d -8 37 d 4 21 d f 0 0.8 0.4 c 803 1525 m 8
- -61 d -31 10 d 9 55 d f 0 0.8 0.2 c 797 1572 m 6 -47 d -14 4 d f black 797 1572
- m 23 -182 d -20 -52 d -24 115 d cl s 0 0.8 0.6 c 780 1474 m -4 -21 d -23 -33 d
- 5 46 d f 0 0.8 0.4 c 789 1529 m -9 -55 d -22 -8 d 7 57 d f 0 0.8 0.2 c 785 1582
- m 12 -10 d -8 -43 d -24 -6 d 7 57 d f 0 0.8 0 c 773 1593 m 12 -11 d -13 -2 d f
- black 773 1593 m 24 -21 d -21 -119 d -23 -33 d cl s 0 0.8 0.8 c 748 1407 m -18
- -47 d 7 36 d f 0 0.8 0.6 c 758 1466 m -5 -46 d -5 -13 d -11 -11 d 12 53 d f 0
- 0.8 0.4 c 750 1452 m 10 62 d 5 9 d -7 -57 d -9 -17 d f 0 0.8 0.2 c 760 1514 m
- 11 65 d 1 1 d -7 -57 d f 0 0.8 0 c 771 1579 m 2 14 d -1 -13 d f black 750 1452
- m 23 141 d -20 -173 d -23 -60 d cl s 0 0.6 0.8 c 724 1339 m -18 -65 d 9 53 d f
- 0 0.8 0.8 c 737 1396 m -7 -36 d -6 -21 d -9 -12 d 10 55 d f 0 0.8 0.6 c 726
- 1392 m 22 56 d 1 1 d -12 -53 d -12 -14 d f 0 0.8 0.4 c 748 1448 m 2 4 d -1 -3 d
- f black 726 1392 m 24 60 d -20 -92 d -24 -86 d cl s 0 0.6 0.8 c 715 1327 m -9
- -53 d -10 58 d f 0 0.8 0.8 c 703 1373 m 3 3 d 19 6 d -10 -55 d -19 5 d -9 59 d
- 15 -15 d f 0 0.8 0.6 c 706 1376 m 20 16 d -1 -10 d -38 9 d -4 24 d 19 -39 d f
- black 703 1373 m 23 19 d -20 -118 d -23 141 d cl s 0 0.8 0.8 c 703 1375 m -2 Y
- -1 3 d f 0 0.8 0.6 c 693 1434 m 10 -59 d -1 1 d -19 39 d -24 -19 d 8 45 d f 0
- 0.8 0.4 c 683 1494 m 10 -60 d -26 7 d 9 55 d f 0 0.8 0.2 c 679 1515 m 4 -21 d
- -7 2 d f black 679 1515 m 24 -142 d -20 42 d -24 -19 d cl s 0 0.4 0.8 c 641
- 1255 m -5 -40 d 2 37 d f 0 0.6 0.8 c 649 1320 m -8 -65 d -3 -3 d 4 59 d f 0 0.8
- 0.8 c 657 1384 m -8 -64 d -7 -9 d 4 59 d f 0 0.8 0.6 c 667 1441 m -8 -45 d -2
- -12 d -11 -14 d 4 60 d f 0 0.8 0.4 c 676 1496 m -9 -55 d -17 -11 d 4 59 d f 0
- 0.8 0.2 c 656 1522 m 23 -7 d -3 -19 d -22 -7 d f black 656 1522 m 23 -7 d -20
- -119 d -23 -181 d cl s 0 0.4 0.8 c 638 1252 m -2 -37 d -5 38 d f 0 0.6 0.8 c
- 642 1311 m -4 -59 d -7 1 d -6 60 d f 0 0.8 0.8 c 646 1370 m -4 -59 d -17 2 d -7
- 61 d f 0 0.8 0.6 c 650 1430 m -4 -60 d -28 4 d -6 50 d 3 8 d f 0 0.8 0.4 c 632
- 1476 m 3 6 d 19 7 d -4 -59 d -35 2 d f 0 0.8 0.2 c 635 1482 m 21 40 d -2 -33 d
- f black 632 1476 m 24 46 d -20 -307 d -24 209 d cl s 0 0.8 0.8 c 601 1369 m -12
- -58 d 16 43 d f 0 0.8 0.6 c 609 1363 m 11 53 d -5 16 d -3 -8 d -11 -55 d 4 -15
- d f 0 0.8 0.4 c 620 1416 m 12 60 d -17 -44 d f black 609 1363 m 23 113 d -20
- -52 d -23 -113 d cl s 0 0.8 0.8 c 605 1354 m -16 -43 d -8 53 d f 0 0.8 0.6 c
- 585 1383 m 24 -20 d -4 -9 d -24 10 d -8 60 d 6 -12 d f 0 0.8 0.4 c 573 1424 m
- -8 56 d 14 -68 d f black 585 1383 m 24 -20 d -20 -52 d -24 169 d cl s 0 0.6 0.8
- c 542 1292 m -6 Y 2 4 d f 0 0.8 0.8 c 562 1324 m 7 17 d -19 16 d -8 -65 d 2 -2
- d f 0 0.8 0.6 c 569 1341 m 16 42 d -6 29 d -21 9 d -8 -64 d f 0 0.8 0.4 c 579
- 1412 m -14 68 d -7 -59 d f black 562 1324 m 23 59 d -20 97 d -23 -194 d cl s 0
- 0 0.8 c 538 1022 m 5 64 d -19 15 d -6 -63 d f 0 0.2 0.8 c 543 1086 m 5 63 d -18
- 16 d -6 -64 d f 0 0.4 0.8 c 548 1149 m 5 63 d -17 17 d -6 -64 d f 0 0.6 0.8 c
- 553 1212 m 5 64 d -14 14 d -2 -4 d -6 -57 d f 0 0.8 0.8 c 558 1276 m 4 48 d -18
- -34 d f black 538 1022 m 24 302 d -20 -38 d -24 -248 d cl s 0 0 0.8 c 515 1016
- m 23 6 d -20 16 d -23 -6 d f black 515 1016 m 23 6 d -20 16 d -23 -6 d cl s 0 0
- 0.8 c 491 1010 m 24 6 d -20 16 d -24 -6 d f black 491 1010 m 24 6 d -20 16 d
- -24 -6 d cl s 0 0 0.8 c 468 1004 m 23 6 d -20 16 d -23 -6 d f black 468 1004 m
- 23 6 d -20 16 d -23 -6 d cl s 0 0 0.8 c 1569 1264 m 23 6 d -20 15 d -24 -6 d f
- black 1569 1264 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1545 1258 m 24 6 d
- -21 15 d -23 -6 d f black 1545 1258 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c
- 1522 1252 m 23 6 d -20 15 d -24 -6 d f black 1522 1252 m 23 6 d -20 15 d -24 -6
- d cl s 0 0 0.8 c 1519 1313 m 3 -61 d -21 15 d -4 61 d f 0 0.2 0.8 c 1516 1375 m
- 3 -62 d -22 15 d -5 61 d f 0 0.4 0.8 c 1513 1436 m 3 -61 d -24 14 d -5 61 d f 0
- 0.6 0.8 c 1510 1497 m 3 -61 d -26 14 d -5 61 d f 0 0.8 0.8 c 1508 1559 m 2 -62
- d -28 14 d -4 46 d 1 14 d f 0 0.8 0.6 c 1505 1620 m 3 -61 d -29 12 d 6 58 d f 0
- 0.8 0.4 c 1502 1682 m 3 -62 d -20 9 d 6 57 d f 0 0.8 0.2 c 1499 1743 m 3 -61 d
- -11 4 d 6 58 d f 0 0.8 0 c 1498 1756 m 1 -13 d -2 1 d f black 1498 1756 m 24
- -504 d -21 15 d -23 290 d cl s 0 0.8 0.8 c 1479 1571 m -1 -14 d -23 -6 d 1 14 d
- f 0 0.8 0.6 c 1485 1629 m -6 -58 d -23 -6 d 6 58 d f 0 0.8 0.4 c 1491 1686 m -6
- -57 d -23 -6 d 6 57 d f 0 0.8 0.2 c 1497 1744 m -6 -58 d -23 -6 d 6 58 d f 0
- 0.8 0 c 1475 1750 m 23 6 d -1 -12 d -23 -6 d f black 1475 1750 m 23 6 d -20
- -199 d -23 -6 d cl s 0 0.8 0.8 c 1456 1565 m -1 -14 d -4 14 d f 0 0.8 0.6 c
- 1462 1623 m -6 -58 d -5 X -16 58 d f 0 0.8 0.4 c 1468 1680 m -6 -57 d -27 X -4
- 16 d 4 42 d f 0 0.8 0.2 c 1474 1738 m -6 -58 d -33 1 d 5 59 d f 0 0.8 0 c 1465
- 1797 m 10 -47 d -1 -12 d -34 2 d 5 58 d f 0.2 0.8 0 c 1453 1856 m 12 -59 d -20
- 1 d 6 58 d f 0.4 0.8 0 c 1451 1865 m 2 -9 d -2 X f black 1451 1865 m 24 -115 d
- -20 -199 d -24 88 d cl s 0 0.8 0.6 c 1424 1620 m -16 -41 d 6 33 d f 0 0.8 0.4 c
- 1435 1681 m -4 -42 d -7 -19 d -10 -8 d 10 54 d f 0 0.8 0.2 c 1428 1685 m 5 41 d
- 7 14 d -5 -59 d -11 -15 d f 0 0.8 0 c 1433 1726 m 9 65 d 3 7 d -5 -58 d f 0.2
- 0.8 0 c 1442 1791 m 8 64 d 1 1 d -6 -58 d f 0.4 0.8 0 c 1450 1855 m 1 10 d -9 Y
- f black 1428 1685 m 23 180 d -20 -226 d -23 -60 d cl s 0 0.8 0.8 c 1393 1550 m
- -9 -17 d 3 13 d f 0 0.8 0.6 c 1414 1612 m -6 -33 d -15 -29 d -6 -4 d 14 52 d f
- 0 0.8 0.4 c 1404 1612 m 16 49 d 4 5 d -10 -54 d -13 -14 d f 0 0.8 0.2 c 1420
- 1661 m 8 24 d -4 -19 d f black 1404 1612 m 24 73 d -20 -106 d -24 -46 d cl s 0
- 0.8 0.8 c 1387 1546 m -3 -13 d -4 14 d f 0 0.8 0.6 c 1401 1598 m -14 -52 d -7 1
- d -15 58 d f 0 0.8 0.4 c 1393 1654 m 11 -42 d -3 -14 d -36 7 d -4 16 d 9 38 d f
- 0 0.8 0.2 c 1381 1700 m 12 -46 d -23 5 d f black 1381 1700 m 23 -88 d -20 -79 d
- -23 88 d cl s 0 0.8 0.8 c 1345 1538 m -8 -44 d 3 40 d f 0 0.8 0.6 c 1357 1603 m
- -12 -65 d -5 -4 d 4 59 d f 0 0.8 0.4 c 1370 1659 m -9 -38 d -4 -18 d -13 -10 d
- 5 59 d f 0 0.8 0.2 c 1377 1712 m 4 -12 d -11 -41 d -21 -7 d 4 59 d f 0 0.8 0 c
- 1359 1770 m 18 -58 d -24 -1 d 4 59 d f 0.2 0.8 0 c 1357 1774 m 2 -4 d -2 X f
- black 1357 1774 m 24 -74 d -20 -79 d -24 -127 d cl s 0 0.8 0.8 c 1340 1534 m -3
- -40 d -7 40 d f 0 0.8 0.6 c 1344 1593 m -4 -59 d -10 X -11 60 d f 0 0.8 0.4 c
- 1349 1652 m -5 -59 d -25 1 d -5 29 d 8 25 d f 0 0.8 0.2 c 1334 1688 m 4 14 d 15
- 9 d -4 -59 d -27 -4 d f 0 0.8 0 c 1338 1702 m 18 67 d 1 1 d -4 -59 d f 0.2 0.8
- 0 c 1356 1769 m 1 5 d -4 Y f black 1334 1688 m 23 86 d -20 -280 d -23 129 d
- cl s 0 0.8 0.8 c 1296 1526 m -6 -30 d 3 26 d f 0 0.8 0.6 c 1308 1591 m -12 -65
- d -3 -4 d 6 58 d f 0 0.8 0.4 c 1322 1648 m -8 -25 d -6 -32 d -9 -11 d 6 57 d f
- 0 0.8 0.2 c 1310 1695 m 24 -7 d -12 -40 d -17 -11 d f black 1310 1695 m 24 -7 d
- -20 -65 d -24 -127 d cl s 0 0.8 0.8 c 1293 1522 m -3 -26 d -23 21 d 1 Y f 0 0.8
- 0.6 c 1299 1580 m -6 -58 d -26 -4 d 6 58 d f 0 0.8 0.4 c 1305 1637 m -6 -57 d
- -26 -4 d 6 57 d f 0 0.8 0.2 c 1310 1695 m -5 -58 d -26 -4 d 5 58 d f 0 0.8 0 c
- 1287 1716 m 23 -21 d -26 -4 d f black 1287 1716 m 23 -21 d -20 -199 d -23 21 d
- cl s 0 0.8 0.8 c 1267 1518 m -1 Y -1 1 d f 0 0.8 0.6 c 1273 1576 m -6 -58 d -1
- X -15 58 d f 0 0.8 0.4 c 1263 1616 m 2 5 d 14 12 d -6 -57 d -22 X -8 29 d f 0
- 0.8 0.2 c 1265 1621 m 15 66 d 4 4 d -5 -58 d f 0 0.8 0 c 1280 1687 m 7 29 d -3
- -25 d f black 1263 1616 m 24 100 d -20 -199 d -24 88 d cl s 0 0.8 0.4 c 1262
- 1621 m 1 -5 d -20 -11 d -23 -33 d 8 52 d f 0 0.8 0.2 c 1247 1679 m 15 -58 d -34
- 3 d 8 56 d f 0 0.8 0 c 1240 1704 m 7 -25 d -11 1 d f black 1240 1704 m 23 -88 d
- -20 -11 d -23 -33 d cl s 0 0.6 0.8 c 1199 1439 m -3 -21 d 2 18 d f 0 0.8 0.8 c
- 1209 1504 m -10 -65 d -1 -3 d 8 57 d f 0 0.8 0.6 c 1219 1568 m -10 -64 d -3 -11
- d 7 57 d f 0 0.8 0.4 c 1216 1577 m 7 34 d 5 13 d -8 -52 d -1 -4 d -6 -18 d f 0
- 0.8 0.2 c 1223 1611 m 12 65 d 1 4 d -8 -56 d f 0 0.8 0 c 1235 1676 m 5 28 d -4
- -24 d f black 1216 1577 m 24 127 d -20 -132 d -24 -154 d cl s 0 0.6 0.8 c 1198
- 1436 m -2 -18 d -4 19 d f 0 0.8 0.8 c 1206 1493 m -8 -57 d -6 1 d -12 59 d f 0
- 0.8 0.6 c 1213 1550 m -7 -57 d -26 3 d -7 37 d 6 19 d f 0 0.8 0.4 c 1193 1598 m
- 23 -21 d -3 -27 d -34 2 d f black 1193 1598 m 23 -21 d -20 -159 d -23 115 d
- cl s 0 0.8 0.6 c 1179 1552 m -6 -19 d -24 -6 d 2 22 d f 0 0.8 0.4 c 1192 1603 m
- 1 -5 d -14 -46 d -28 -3 d 6 58 d f 0 0.8 0.2 c 1182 1663 m 10 -60 d -35 4 d 5
- 58 d f 0 0.8 0 c 1172 1722 m 10 -59 d -20 2 d 6 58 d f 0.2 0.8 0 c 1170 1740 m
- 2 -18 d -4 1 d f black 1170 1740 m 23 -142 d -20 -65 d -24 -6 d cl s 0 0.8 0.6
- c 1151 1549 m -2 -22 d -23 -33 d 19 36 d f 0 0.8 0.4 c 1146 1532 m 7 61 d 4 14
- d -6 -58 d -6 -19 d f 0 0.8 0.2 c 1153 1593 m 7 64 d 2 8 d -5 -58 d f 0 0.8 0 c
- 1160 1657 m 7 64 d 1 2 d -6 -58 d f 0.2 0.8 0 c 1167 1721 m 3 19 d -2 -17 d f
- black 1146 1532 m 24 208 d -21 -213 d -23 -33 d cl s 0 0.8 0.6 c 1145 1530 m
- -19 -36 d -24 34 d 2 9 d f 0 0.8 0.4 c 1135 1588 m 11 -56 d -1 -2 d -41 7 d 9
- 55 d f 0 0.8 0.2 c 1123 1647 m 12 -59 d -22 4 d f black 1123 1647 m 23 -115 d
- -20 -38 d -24 34 d cl s 0 0.8 0.6 c 1104 1537 m -2 -9 d -4 9 d f 0 0.8 0.4 c
- 1099 1547 m 8 34 d 6 11 d -9 -55 d -6 X -19 39 d f 0 0.8 0.2 c 1107 1581 m 16
- 66 d -10 -55 d f black 1099 1547 m 24 100 d -21 -119 d -23 48 d cl s 0 0.8 0.8
- c 1063 1467 m -8 -58 d 3 53 d f 0 0.8 0.6 c 1072 1531 m -9 -64 d -5 -5 d 4 60 d
- f 0 0.8 0.4 c 1096 1578 m 3 -31 d -20 29 d -7 -45 d -10 -9 d 3 59 d f 0 0.8 0.2
- c 1089 1639 m 7 -61 d -31 3 d 4 60 d f 0 0.8 0 c 1082 1699 m 7 -60 d -20 2 d 3
- 59 d f 0.2 0.8 0 c 1076 1756 m 6 -57 d -10 1 d f black 1076 1756 m 23 -209 d
- -20 29 d -24 -167 d cl s 0 0.8 0.8 c 1058 1462 m -3 -53 d -7 54 d f 0 0.8 0.6 c
- 1062 1522 m -4 -60 d -10 1 d -9 60 d f 0 0.8 0.4 c 1065 1581 m -3 -59 d -23 1 d
- -7 55 d 2 3 d f 0 0.8 0.2 c 1052 1602 m 4 28 d 13 11 d -4 -60 d -31 X f 0 0.8 0
- c 1056 1630 m 10 65 d 6 5 d -3 -59 d f 0.2 0.8 0 c 1066 1695 m 10 61 d -4 -56 d
- f black 1052 1602 m 24 154 d -21 -347 d -23 169 d cl s 0 0.8 0.8 c 1009 1453 m
- -1 -2 d 1 1 d f 0 0.8 0.6 c 1021 1518 m -12 -65 d -1 Y 11 53 d f 0 0.8 0.4 c
- 1029 1543 m 8 20 d -3 18 d -2 -3 d -11 -60 d -1 -13 d f 0 0.8 0.2 c 1037 1563 m
- 15 39 d -18 -21 d f black 1029 1543 m 23 59 d -20 -24 d -24 -127 d cl s 0 0.8
- 0.8 c 1009 1452 m -1 -1 d 1 Y f 0 0.8 0.6 c 1020 1505 m -11 -53 d -1 X -12 59 d
- f 0 0.8 0.4 c 1012 1557 m 17 -14 d -9 -38 d -24 6 d -11 55 d 7 -1 d f 0 0.8 0.2
- c 1005 1564 m 7 -7 d -20 8 d f black 1005 1564 m 24 -21 d -21 -92 d -23 115 d
- cl s 0 0.8 0.8 c 962 1441 m -1 -2 d 1 1 d f 0 0.8 0.6 c 974 1506 m -12 -65 d -1
- Y 11 53 d f 0 0.8 0.4 c 982 1531 m 16 22 d -6 12 d -7 1 d -11 -60 d -1 -13 d f
- 0 0.8 0.2 c 998 1553 m 7 11 d -13 1 d f black 982 1531 m 23 33 d -20 2 d -24
- -127 d cl s 0 0.8 0.8 c 962 1440 m -1 -1 d 1 Y f 0 0.8 0.6 c 973 1493 m -11 -53
- d -1 X -16 59 d f 0 0.8 0.4 c 979 1549 m 3 -18 d -9 -38 d -28 6 d -7 28 d 4 29
- d f 0 0.8 0.2 c 969 1608 m 10 -59 d -37 7 d 8 56 d f 0 0.8 0 c 959 1668 m 10
- -60 d -19 4 d 7 56 d f 0.2 0.8 0 c 958 1673 m 1 -5 d -2 X f black 958 1673 m 24
- -142 d -21 -92 d -23 88 d cl s 0 0.8 0.4 c 935 1492 m 6 47 d 1 17 d -4 -29 d
- -24 21 d f 0 0.8 0.2 c 941 1539 m 8 64 d 1 9 d -8 -56 d f 0 0.8 0 c 949 1603 m
- 8 64 d 1 Y -7 -56 d f 0.2 0.8 0 c 957 1667 m 1 6 d -1 -5 d f black 935 1492 m
- 23 181 d -20 -146 d -24 21 d cl s 0 0.8 0.6 c 911 1432 m 16 41 d -30 7 d f 0
- 0.8 0.4 c 927 1473 m 8 19 d -21 56 d -23 -46 d 6 -22 d f black 911 1432 m 24 60
- d -21 56 d -23 -46 d cl s 0 0.8 0.6 c 898 1466 m 13 -34 d -14 48 d f 0 0.8 0.4
- c 888 1493 m 10 -27 d -1 14 d -6 22 d -24 -6 d f black 888 1493 m 23 -61 d -20
- 70 d -24 -6 d cl s 0 0.8 0.4 c 881 1524 m 7 -31 d -21 3 d -10 42 d f 0 0.8 0.2
- c 869 1583 m 12 -59 d -24 14 d -13 59 d f 0 0.8 0 c 864 1608 m 5 -25 d -25 14 d
- f black 864 1608 m 24 -115 d -21 3 d -23 101 d cl s 0 0.8 0.8 c 822 1405 m -2
- -15 d 3 12 d f 0 0.8 0.6 c 829 1469 m -7 -64 d 1 -3 d 12 54 d f 0 0.8 0.4 c 841
- 1481 m 6 34 d -10 18 d -8 -64 d 6 -13 d f 0 0.8 0.2 c 847 1515 m 12 65 d -15 17
- d -7 -64 d f 0 0.8 0 c 859 1580 m 5 28 d -20 -11 d f black 841 1481 m 23 127 d
- -20 -11 d -24 -207 d cl s 0 0.8 0.8 c 823 1402 m -3 -12 d -2 14 d f 0 0.8 0.6 c
- 835 1456 m -12 -54 d -5 2 d -7 60 d f 0 0.8 0.4 c 835 1512 m 6 -31 d -6 -25 d
- -24 8 d -8 61 d f 0 0.8 0.2 c 824 1571 m 11 -59 d -32 13 d -6 47 d 5 9 d f 0
- 0.8 0 c 817 1610 m 7 -39 d -22 10 d f black 817 1610 m 24 -129 d -21 -91 d -23
- 182 d cl s 0 0.8 0.2 c 802 1581 m -5 -9 d -12 10 d f 0 0.8 0 c 811 1630 m 6 -20
- d -15 -29 d -17 1 d -12 11 d 10 41 d f 0.2 0.8 0 c 794 1685 m 17 -55 d -28 4 d
- f black 794 1685 m 23 -75 d -20 -38 d -24 21 d cl s 0 0.8 0.4 c 760 1514 m -10
- -62 d 9 52 d f 0 0.8 0.2 c 771 1579 m -11 -65 d -1 -10 d 9 55 d f 0 0.8 0 c 770
- 1571 m 11 51 d 2 12 d -10 -41 d -2 -14 d -3 -20 d f 0.2 0.8 0 c 781 1622 m 13
- 63 d -11 -51 d f black 770 1571 m 24 114 d -21 -92 d -23 -141 d cl s 0 0.8 0.6
- c 748 1448 m -22 -56 d 7 46 d f 0 0.8 0.4 c 759 1504 m -9 -52 d -2 -4 d -15 -10
- d 8 56 d f 0 0.8 0.2 c 747 1538 m 11 17 d 10 4 d -9 -55 d -18 -10 d f 0 0.8 0 c
- 758 1555 m 12 16 d -2 -12 d f black 747 1538 m 23 33 d -20 -119 d -24 -60 d
- cl s 0 0.8 0.8 c 706 1376 m -3 -3 d 1 1 d f 0 0.8 0.6 c 723 1384 m 6 39 d 4 15
- d -7 -46 d -20 -16 d -2 -2 d f 0 0.8 0.4 c 729 1423 m 10 65 d 2 6 d -8 -56 d f
- 0 0.8 0.2 c 739 1488 m 8 50 d -6 -44 d f black 723 1384 m 24 154 d -21 -146 d
- -23 -19 d cl s 0 0.8 0.8 c 704 1374 m -1 -1 d 2 Y f 0 0.8 0.6 c 710 1418 m 13
- -34 d -19 -10 d -1 1 d -10 59 d f 0 0.8 0.4 c 700 1446 m 10 -28 d -17 16 d -10
- 60 d 5 -7 d f 0 0.8 0.2 c 683 1494 m -4 21 d 9 -28 d f black 700 1446 m 23 -62
- d -20 -11 d -24 142 d cl s 0 0.8 0.4 c 695 1476 m 5 -30 d -12 41 d f 0 0.8 0.2
- c 687 1536 m 8 -60 d -7 11 d -9 28 d -23 7 d 5 23 d f 0 0.8 0 c 679 1596 m 8
- -60 d -26 9 d 12 54 d f 0.2 0.8 0 c 676 1614 m 3 -18 d -6 3 d f black 676 1614
- m 24 -168 d -21 69 d -23 7 d cl s 0 0.8 0.4 c 635 1482 m -3 -6 d 1 4 d f 0 0.8
- 0.2 c 661 1545 m -5 -23 d -21 -40 d -2 -2 d 12 54 d f 0 0.8 0 c 653 1568 m 12
- 25 d 8 6 d -12 -54 d -16 -11 d f 0.2 0.8 0 c 665 1593 m 11 21 d -3 -15 d f
- black 653 1568 m 23 46 d -20 -92 d -24 -46 d cl s 0 0.8 0.6 c 620 1416 m -11
- -53 d 8 44 d f 0 0.8 0.4 c 633 1480 m -1 -4 d -12 -60 d -3 -9 d 11 54 d f 0 0.8
- 0.2 c 629 1468 m 14 57 d 2 9 d -12 -54 d -5 -19 d f 0 0.8 0 c 643 1525 m 10 43
- d -8 -34 d f black 629 1468 m 24 100 d -21 -92 d -23 -113 d cl s 0 0.8 0.6 c
- 617 1407 m -8 -44 d -24 20 d 3 22 d f 0 0.8 0.4 c 628 1461 m -11 -54 d -29 -2 d
- 6 58 d f 0 0.8 0.2 c 619 1519 m 10 -51 d -1 -7 d -34 2 d 5 58 d f 0 0.8 0 c 607
- 1578 m 12 -59 d -20 2 d 6 57 d f 0.2 0.8 0 c 606 1583 m 1 -5 d -2 X f black 606
- 1583 m 23 -115 d -20 -105 d -24 20 d cl s 0 0.8 0.8 c 569 1341 m -7 -17 d 6 11
- d f 0 0.8 0.6 c 582 1362 m 3 24 d 3 19 d -3 -22 d -16 -42 d -1 -6 d f 0 0.8 0.4
- c 585 1386 m 7 64 d 2 13 d -6 -58 d f 0 0.8 0.2 c 592 1450 m 6 64 d 1 7 d -5
- -58 d f 0 0.8 0 c 598 1514 m 7 64 d -6 -57 d f 0.2 0.8 0 c 605 1578 m 1 5 d -1
- -5 d f black 582 1362 m 24 221 d -21 -200 d -23 -59 d cl s 0 0 0.8 c 559 1007 m
- 4 63 d -20 16 d -5 -64 d f 0 0.2 0.8 c 563 1070 m 4 63 d -19 16 d -5 -63 d f 0
- 0.4 0.8 c 567 1133 m 4 63 d -18 16 d -5 -63 d f 0 0.6 0.8 c 571 1196 m 5 63 d
- -18 17 d -5 -64 d f 0 0.8 0.8 c 576 1259 m 4 64 d -12 12 d -6 -11 d -4 -48 d f
- 0 0.8 0.6 c 580 1323 m 2 39 d -14 -27 d f black 559 1007 m 23 355 d -20 -38 d
- -24 -302 d cl s 0 0 0.8 c 535 1001 m 24 6 d -21 15 d -23 -6 d f black 535 1001
- m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 512 995 m 23 6 d -20 15 d -24 -6 d f
- black 512 995 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 488 989 m 24 6 d -21 15
- d -23 -6 d f black 488 989 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 1589 1248
- m 24 6 d -21 16 d -23 -6 d f black 1589 1248 m 24 6 d -21 16 d -23 -6 d cl s 0
- 0 0.8 c 1566 1242 m 23 6 d -20 16 d -24 -6 d f black 1566 1242 m 23 6 d -20 16
- d -24 -6 d cl s 0 0 0.8 c 1542 1236 m 24 6 d -21 16 d -23 -6 d f black 1542
- 1236 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1540 1298 m 2 -62 d -20 16 d -3
- 61 d f 0 0.2 0.8 c 1538 1360 m 2 -62 d -21 15 d -3 62 d f 0 0.4 0.8 c 1536 1421
- m 2 -61 d -22 15 d -3 61 d f 0 0.6 0.8 c 1534 1483 m 2 -62 d -23 15 d -3 61 d f
- 0 0.8 0.8 c 1532 1545 m 2 -62 d -24 14 d -2 62 d f 0 0.8 0.6 c 1531 1606 m 1
- -61 d -24 14 d -3 61 d f 0 0.8 0.4 c 1529 1668 m 2 -62 d -26 14 d -3 62 d f 0
- 0.8 0.2 c 1527 1729 m 2 -61 d -27 14 d -3 61 d f 0 0.8 0 c 1525 1791 m 2 -62 d
- -28 14 d -1 13 d 4 46 d f 0.2 0.8 0 c 1523 1853 m 2 -62 d -23 11 d 6 58 d f 0.4
- 0.8 0 c 1521 1914 m 2 -61 d -15 7 d 5 58 d f 0.6 0.8 0 c 1519 1976 m 2 -62 d -8
- 4 d 5 58 d f 0.8 0.8 0 c 1519 1983 m -7 Y -1 X f black 1519 1983 m 23 -747 d
- -20 16 d -24 504 d cl s 0 0.8 0 c 1502 1802 m -4 -46 d -23 -6 d 10 41 d f 0.2
- 0.8 0 c 1495 1829 m 3 17 d 10 14 d -6 -58 d -17 -11 d f 0.4 0.8 0 c 1498 1846 m
- 10 65 d 5 7 d -5 -58 d f 0.6 0.8 0 c 1508 1911 m 10 65 d -5 -58 d f 0.8 0.8 0 c
- 1518 1976 m 1 7 d -1 -7 d f black 1495 1829 m 24 154 d -21 -227 d -23 -6 d cl s
- 0 0.8 0 c 1485 1791 m -10 -41 d -10 47 d f 0.2 0.8 0 c 1481 1842 m 14 -13 d -10
- -38 d -20 6 d -12 59 d f 0.4 0.8 0 c 1472 1850 m 9 -8 d -28 14 d -2 9 d f black
- 1472 1850 m 23 -21 d -20 -79 d -24 115 d cl s 0 0.8 0.6 c 1448 1562 m 2 24 d -6
- 3 d f 0 0.8 0.4 c 1450 1586 m 5 63 d -23 11 d 12 -71 d f 0 0.8 0.2 c 1455 1649
- m 6 64 d -28 13 d -5 -41 d 4 -25 d f 0 0.8 0 c 1461 1713 m 5 63 d -24 15 d -9
- -65 d f 0.2 0.8 0 c 1466 1776 m 5 64 d -21 15 d -8 -64 d f 0.4 0.8 0 c 1471
- 1840 m 1 10 d -21 15 d -1 -10 d f black 1448 1562 m 24 288 d -21 15 d -23 -180
- d cl s 0 0.8 0.6 c 1446 1585 m 2 -23 d -4 27 d f 0 0.8 0.4 c 1442 1646 m 4 -61
- d -2 4 d -12 71 d -12 1 d -16 -49 d 4 42 d f 0 0.8 0.2 c 1437 1707 m 5 -61 d
- -10 14 d -4 25 d -8 -24 d -12 -7 d 5 59 d f 0 0.8 0 c 1432 1768 m 5 -61 d -24 6
- d 4 58 d f 0.2 0.8 0 c 1428 1829 m 4 -61 d -15 3 d 5 59 d f 0.4 0.8 0 c 1425
- 1865 m 3 -36 d -6 1 d f black 1425 1865 m 23 -303 d -20 123 d -24 -73 d cl s 0
- 0.8 0.4 c 1401 1630 m 1 6 d 6 18 d -4 -42 d -11 42 d 6 -17 d f 0 0.8 0.2 c 1402
- 1636 m 6 63 d 5 14 d -5 -59 d -15 X -12 46 d 18 -63 d f 0 0.8 0 c 1408 1699 m 7
- 64 d 2 8 d -4 -58 d f 0.2 0.8 0 c 1415 1763 m 6 64 d 1 3 d -5 -59 d f 0.4 0.8 0
- c 1421 1827 m 4 38 d -3 -35 d f black 1401 1630 m 24 235 d -21 -253 d -23 88 d
- cl s 0 0.8 0.4 c 1401 1635 m -5 Y -2 7 d f 0 0.8 0.2 c 1394 1696 m 7 -61 d -2 2
- d -18 63 d -4 12 d f 0 0.8 0 c 1387 1756 m 7 -60 d -17 16 d -18 58 d f 0.2 0.8
- 0 c 1380 1817 m 7 -61 d -28 14 d -2 4 d 15 46 d f 0.4 0.8 0 c 1378 1839 m 2 -22
- d -8 3 d f black 1378 1839 m 23 -209 d -20 70 d -24 74 d cl s 0 0.8 0.2 c 1338
- 1702 m -4 -14 d 2 11 d f 0 0.8 0 c 1356 1769 m -18 -67 d -2 -3 d 11 55 d f 0.2
- 0.8 0 c 1354 1793 m 10 19 d 8 8 d -15 -46 d -1 -5 d -9 -15 d f 0.4 0.8 0 c 1364
- 1812 m 14 27 d -6 -19 d f black 1354 1793 m 24 46 d -21 -65 d -23 -86 d cl s 0
- 0.8 0.2 c 1336 1699 m -2 -11 d -24 7 d f 0 0.8 0 c 1347 1754 m -11 -55 d -26 -4
- d 11 54 d f 0.2 0.8 0 c 1331 1801 m 23 -8 d -7 -39 d -26 -5 d f black 1331 1801
- m 23 -8 d -20 -105 d -24 7 d cl s 0 0.8 0 c 1321 1749 m -11 -54 d -23 21 d 9 29
- d f 0.2 0.8 0 c 1307 1781 m 24 20 d -10 -52 d -25 -4 d f black 1307 1781 m 24
- 20 d -21 -106 d -23 21 d cl s 0 0.8 0.4 c 1265 1621 m -2 -5 d 4 2 d f 0 0.8 0.2
- c 1284 1627 m 6 42 d -10 18 d -15 -66 d 2 -3 d f 0 0.8 0 c 1290 1669 m 10 65 d
- -4 11 d -9 -29 d -7 -29 d f 0.2 0.8 0 c 1300 1734 m 7 47 d -11 -36 d f black
- 1284 1627 m 23 154 d -20 -65 d -24 -100 d cl s 0 0.8 0.4 c 1267 1618 m -4 -2 d
- -1 5 d f 0 0.8 0.2 c 1260 1608 m 24 19 d -17 -9 d -5 3 d -15 58 d -7 Y f 0 0.8
- 0 c 1247 1679 m -7 25 d 7 -32 d f black 1260 1608 m 24 19 d -21 -11 d -23 88 d
- cl s 0 0.8 0.4 c 1223 1611 m -7 -34 d 4 29 d f 0 0.8 0.2 c 1251 1659 m 9 -51 d
- -13 64 d -12 4 d -12 -65 d -3 -5 d 7 57 d f 0 0.8 0 c 1240 1719 m 11 -60 d -4
- 13 d -7 32 d -5 -28 d -8 -13 d 8 56 d f 0.2 0.8 0 c 1237 1736 m 3 -17 d -5 X f
- black 1237 1736 m 23 -128 d -20 96 d -24 -127 d cl s 0 0.8 0.4 c 1220 1606 m -4
- -29 d -23 21 d 3 3 d f 0 0.8 0.2 c 1213 1623 m 6 28 d 8 12 d -7 -57 d -24 -5 d
- f 0 0.8 0 c 1219 1651 m 14 66 d 2 2 d -8 -56 d f 0.2 0.8 0 c 1233 1717 m 4 19 d
- -2 -17 d f black 1213 1623 m 24 113 d -21 -159 d -23 21 d cl s 0 0.8 0.4 c 1196
- 1601 m -3 -3 d -1 5 d f 0 0.8 0.2 c 1210 1649 m 3 -26 d -17 -22 d -4 2 d -10 60
- d f 0 0.8 0 c 1203 1709 m 7 -60 d -28 14 d -10 59 d f 0.2 0.8 0 c 1196 1770 m 7
- -61 d -31 13 d -2 18 d 9 36 d f 0.4 0.8 0 c 1190 1818 m 6 -48 d -17 6 d f black
- 1190 1818 m 23 -195 d -20 -25 d -23 142 d cl s 0 0.8 0.4 c 1153 1593 m -7 -61 d
- 6 55 d f 0 0.8 0.2 c 1160 1657 m -7 -64 d -1 -6 d 6 57 d f 0 0.8 0 c 1167 1721
- m -7 -64 d -2 -13 d 6 57 d f 0.2 0.8 0 c 1166 1718 m 11 47 d 2 11 d -9 -36 d -3
- -19 d -3 -20 d f 0.4 0.8 0 c 1177 1765 m 13 53 d -11 -42 d f black 1166 1718 m
- 24 100 d -20 -78 d -24 -208 d cl s 0 0.8 0.4 c 1143 1551 m 3 19 d 6 17 d -6 -55
- d -11 56 d 3 -15 d f 0 0.8 0.2 c 1146 1570 m 9 65 d 3 9 d -6 -57 d -17 1 d -12
- 59 d 15 -74 d f 0 0.8 0 c 1155 1635 m 9 64 d 2 Y -6 -57 d -35 3 d f 0.2 0.8 0 c
- 1164 1699 m 2 19 d -2 -17 d f black 1143 1551 m 23 167 d -20 -186 d -23 115 d
- cl s 0 0.8 0.4 c 1139 1569 m 4 -18 d -5 22 d -31 8 d -8 -34 d 5 28 d f 0 0.8
- 0.2 c 1125 1627 m 14 -58 d -1 4 d -15 74 d -16 -66 d -3 -6 d 11 54 d f 0 0.8 0
- c 1119 1653 m 6 -26 d -2 20 d -8 -18 d f black 1119 1653 m 24 -102 d -20 96 d
- -24 -100 d cl s 0 0.8 0.4 c 1104 1575 m -5 -28 d -3 31 d f 0 0.8 0.2 c 1115
- 1629 m -11 -54 d -8 3 d -7 61 d f 0 0.8 0 c 1104 1684 m 15 -31 d -4 -24 d -26
- 10 d -7 60 d f 0.2 0.8 0 c 1096 1700 m 8 -16 d -22 15 d -6 57 d f black 1096
- 1700 m 23 -47 d -20 -106 d -23 209 d cl s 0 0.8 0.2 c 1056 1630 m -4 -28 d 14
- 17 d f 0 0.8 0 c 1072 1627 m 17 53 d -23 15 d -10 -65 d 10 -11 d f 0.2 0.8 0 c
- 1089 1680 m 7 20 d -20 56 d -10 -61 d f black 1072 1627 m 24 73 d -20 56 d -24
- -154 d cl s 0 0.8 0.4 c 1037 1563 m -8 -20 d 1 17 d f 0 0.8 0.2 c 1066 1619 m
- -14 -17 d -15 -39 d -7 -3 d 6 58 d f 0 0.8 0 c 1063 1674 m 9 -47 d -6 -8 d -30
- -1 d 6 57 d f 0.2 0.8 0 c 1051 1733 m 12 -59 d -21 1 d 6 58 d f 0.4 0.8 0 c
- 1049 1742 m 2 -9 d -3 X f black 1049 1742 m 23 -115 d -20 -25 d -23 -59 d cl s
- 0 0.8 0.4 c 1030 1560 m -1 -17 d -17 14 d f 0 0.8 0.2 c 1025 1588 m 3 14 d 8 16
- d -6 -58 d -18 -3 d -7 7 d f 0 0.8 0 c 1028 1602 m 9 65 d 5 8 d -6 -57 d f 0.2
- 0.8 0 c 1037 1667 m 10 65 d 1 1 d -6 -58 d f 0.4 0.8 0 c 1047 1732 m 2 10 d -1
- -9 d f black 1025 1588 m 24 154 d -20 -199 d -24 21 d cl s 0 0.8 0.4 c 998 1553
- m -16 -22 d 7 13 d f 0 0.8 0.2 c 1002 1569 m 23 19 d -20 -24 d -7 -11 d -9 -9 d
- f black 1002 1569 m 23 19 d -20 -24 d -23 -33 d cl s 0 0.8 0.4 c 989 1544 m -7
- -13 d -3 18 d f 0 0.8 0.2 c 986 1592 m 16 -23 d -13 -25 d -10 5 d -10 59 d f 0
- 0.8 0 c 978 1603 m 8 -11 d -17 16 d -10 60 d 1 -2 d f 0.2 0.8 0 c 959 1668 m -1
- 5 d 2 -7 d f black 978 1603 m 24 -34 d -20 -38 d -24 142 d cl s 0 0.8 0.4 c 941
- 1539 m -6 -47 d 3 43 d f 0 0.8 0.2 c 949 1603 m -8 -64 d -3 -4 d 5 58 d f 0 0.8
- 0 c 970 1650 m 8 -47 d -18 63 d -3 1 d -8 -64 d -6 -10 d 5 58 d f 0.2 0.8 0 c
- 959 1709 m 11 -59 d -10 16 d -2 7 d -1 -6 d -9 -16 d 5 59 d f 0.4 0.8 0 c 955
- 1732 m 4 -23 d -6 1 d f black 955 1732 m 23 -129 d -20 70 d -23 -181 d cl s 0
- 0.8 0.6 c 927 1473 m -16 -41 d 2 36 d f 0 0.8 0.4 c 938 1535 m -3 -43 d -8 -19
- d -14 -5 d 3 59 d f 0 0.8 0.2 c 943 1593 m -5 -58 d -22 -8 d 4 60 d f 0 0.8 0 c
- 948 1651 m -5 -58 d -23 -6 d 3 59 d f 0.2 0.8 0 c 953 1710 m -5 -59 d -25 -5 d
- 4 60 d f 0.4 0.8 0 c 941 1767 m 14 -35 d -2 -22 d -26 -4 d 3 60 d f 0.6 0.8 0 c
- 931 1793 m 10 -26 d -11 -1 d f black 931 1793 m 24 -61 d -20 -240 d -24 -60 d
- cl s 0 0.8 0.6 c 913 1468 m -2 -36 d -13 34 d f 0 0.8 0.4 c 916 1527 m -3 -59 d
- -15 -2 d -10 27 d 7 27 d f 0 0.8 0.2 c 908 1572 m 12 15 d -4 -60 d -21 -7 d f 0
- 0.8 0 c 908 1572 m 7 64 d 8 10 d -3 -59 d f 0.2 0.8 0 c 915 1636 m 7 64 d 5 6 d
- -4 -60 d f 0.4 0.8 0 c 922 1700 m 6 64 d 2 2 d -3 -60 d f 0.6 0.8 0 c 928 1764
- m 3 29 d -1 -27 d f black 908 1572 m 23 221 d -20 -361 d -23 61 d cl s 0 0.8
- 0.4 c 895 1520 m -7 -27 d -7 31 d f 0 0.8 0.2 c 908 1572 m -13 -52 d -14 4 d
- -12 59 d f 0 0.8 0 c 884 1606 m 24 -34 d -39 11 d -5 25 d f black 884 1606 m 24
- -34 d -20 -79 d -24 115 d cl s 0 0.8 0.4 c 847 1515 m -6 -34 d 2 31 d f 0 0.8
- 0.2 c 859 1580 m -12 -65 d -4 -3 d 5 58 d f 0 0.8 0 c 881 1627 m 3 -21 d -20 2
- d -5 -28 d -11 -10 d 4 59 d f 0.2 0.8 0 c 870 1687 m 11 -60 d -29 2 d 5 58 d f
- 0.4 0.8 0 c 861 1735 m 9 -48 d -13 X f black 861 1735 m 23 -129 d -20 2 d -23
- -127 d cl s 0 0.8 0.4 c 838 1460 m 2 33 d 3 19 d -2 -31 d -6 31 d -2 -16 d f 0
- 0.8 0.2 c 840 1493 m 6 63 d 2 14 d -5 -58 d -8 X -11 59 d -1 -6 d 10 -69 d f 0
- 0.8 0 c 846 1556 m 5 64 d 1 9 d -4 -59 d -24 1 d -7 39 d 6 -45 d f 0.2 0.8 0 c
- 851 1620 m 6 63 d 4 Y -5 -58 d f 0.4 0.8 0 c 857 1683 m 4 52 d -4 -48 d f black
- 838 1460 m 23 275 d -20 -254 d -24 129 d cl s 0 0.8 0.4 c 833 1491 m 5 -31 d -5
- 36 d f 0 0.8 0.2 c 825 1551 m 8 -60 d 5 Y -10 69 d f 0 0.8 0 c 817 1611 m 8 -60
- d -2 14 d -6 45 d -6 20 d f 0.2 0.8 0 c 814 1629 m 3 -18 d -6 19 d -17 55 d f
- black 814 1629 m 24 -169 d -21 150 d -23 75 d cl s 0 0.8 0 c 791 1582 m 12 25 d
- -22 15 d -11 -51 d f 0.2 0.8 0 c 803 1607 m 11 22 d -20 56 d -13 -63 d f black
- 791 1582 m 23 47 d -20 56 d -24 -114 d cl s 0 0.8 0.2 c 758 1555 m -11 -17 d 1
- 13 d f 0 0.8 0 c 788 1604 m 3 -22 d -21 -11 d -12 -16 d -10 -4 d 5 58 d f 0.2
- 0.8 0 c 781 1664 m 7 -60 d -35 5 d 5 59 d f 0.4 0.8 0 c 774 1724 m 7 -60 d -23
- 4 d 5 58 d f 0.6 0.8 0 c 767 1778 m 7 -54 d -11 2 d f black 767 1778 m 24 -196
- d -21 -11 d -23 -33 d cl s 0 0.8 0.6 c 729 1423 m -6 -39 d 3 35 d f 0 0.8 0.4 c
- 739 1488 m -10 -65 d -3 -4 d 5 58 d f 0 0.8 0.2 c 748 1551 m -1 -13 d -8 -50 d
- -8 -11 d 5 59 d f 0 0.8 0 c 753 1609 m -5 -58 d -12 -15 d 5 58 d f 0.2 0.8 0 c
- 744 1624 m 4 32 d 10 12 d -5 -59 d -12 -15 d f 0.4 0.8 0 c 748 1656 m 10 64 d 5
- 6 d -5 -58 d f 0.6 0.8 0 c 758 1720 m 9 58 d -4 -52 d f black 744 1624 m 23 154
- d -20 -240 d -24 -154 d cl s 0 0.8 0.6 c 726 1419 m -3 -35 d -13 34 d f 0 0.8
- 0.4 c 731 1477 m -5 -58 d -16 -1 d -10 28 d 7 26 d f 0 0.8 0.2 c 720 1524 m 16
- 12 d -5 -59 d -24 -5 d f 0 0.8 0 c 720 1524 m 16 66 d 5 4 d -5 -58 d f 0.2 0.8
- 0 c 736 1590 m 8 34 d -3 -30 d f black 720 1524 m 24 100 d -21 -240 d -23 62 d
- cl s 0 0.8 0.4 c 707 1472 m -7 -26 d -5 30 d f 0 0.8 0.2 c 720 1524 m -13 -52 d
- -12 4 d -8 60 d f 0 0.8 0 c 697 1572 m 23 -48 d -33 12 d -8 60 d 11 -11 d f 0.2
- 0.8 0 c 679 1596 m -3 18 d 14 -29 d f black 697 1572 m 23 -48 d -20 -78 d -24
- 168 d cl s 0 0.8 0 c 695 1580 m 2 -8 d -7 13 d -25 8 d -12 -25 d 3 20 d f 0.2
- 0.8 0 c 685 1640 m 10 -60 d -5 5 d -14 29 d -11 -21 d -9 -5 d 7 56 d f 0.4 0.8
- 0 c 675 1699 m 10 -59 d -22 4 d 8 56 d f 0.6 0.8 0 c 673 1714 m 2 -15 d -4 1 d
- f black 673 1714 m 24 -142 d -21 42 d -23 -46 d cl s 0 0.8 0.2 c 643 1525 m -14
- -57 d 8 48 d f 0 0.8 0 c 656 1588 m -3 -20 d -10 -43 d -6 -9 d 10 54 d f 0.2
- 0.8 0 c 650 1587 m 8 46 d 5 11 d -7 -56 d -9 -18 d f 0.4 0.8 0 c 658 1633 m 12
- 65 d 1 2 d -8 -56 d f 0.6 0.8 0 c 670 1698 m 3 16 d -2 -14 d f black 650 1587 m
- 23 127 d -20 -146 d -24 -100 d cl s 0 0.8 0.2 c 637 1516 m -8 -48 d -10 51 d f
- 0 0.8 0 c 647 1570 m -10 -54 d -18 3 d -12 59 d f 0.2 0.8 0 c 640 1628 m 10 -41
- d -3 -17 d -40 8 d -1 5 d 9 50 d f 0.4 0.8 0 c 626 1687 m 14 -59 d -25 5 d 11
- 54 d f 0.6 0.8 0 c 626 1688 m -1 Y f black 626 1688 m 24 -101 d -21 -119 d -23
- 115 d cl s 0 0.8 0.6 c 585 1386 m -3 -24 d 2 23 d f 0 0.8 0.4 c 592 1450 m -7
- -64 d -1 -1 d 3 59 d f 0 0.8 0.2 c 598 1514 m -6 -64 d -5 -6 d 3 60 d f 0 0.8 0
- c 605 1578 m -7 -64 d -8 -10 d 3 60 d f 0.2 0.8 0 c 615 1633 m -9 -50 d -1 -5 d
- -12 -14 d 3 59 d f 0.4 0.8 0 c 626 1687 m -11 -54 d -19 -10 d 4 60 d f 0.6 0.8
- 0 c 603 1736 m 23 -48 d -1 Y -26 -4 d f black 603 1736 m 23 -48 d -20 -105 d
- -24 -221 d cl s 0 0 0.8 c 579 991 m 2 63 d -18 16 d -4 -63 d f 0 0.2 0.8 c 581
- 1054 m 2 62 d -16 17 d -4 -63 d f 0 0.4 0.8 c 583 1116 m 2 63 d -14 17 d -4 -63
- d f 0 0.6 0.8 c 585 1179 m 2 63 d -11 17 d -5 -63 d f 0 0.8 0.8 c 587 1242 m 2
- 62 d -9 19 d -4 -64 d f 0 0.8 0.6 c 589 1304 m 2 63 d -7 18 d -2 -23 d -2 -39 d
- f 0 0.8 0.4 c 591 1367 m 2 63 d -6 14 d -3 -59 d f 0 0.8 0.2 c 593 1430 m 2 62
- d -5 12 d -3 -60 d f 0 0.8 0 c 595 1492 m 2 63 d -4 9 d -3 -60 d f 0.2 0.8 0 c
- 597 1555 m 2 63 d -3 5 d -3 -59 d f 0.4 0.8 0 c 599 1618 m 2 62 d -1 3 d -4 -60
- d f 0.6 0.8 0 c 601 1680 m 2 56 d -3 -53 d f black 579 991 m 24 745 d -21 -374
- d -23 -355 d cl s 0 0 0.8 c 556 985 m 23 6 d -20 16 d -24 -6 d f black 556 985
- m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 532 979 m 24 6 d -21 16 d -23 -6 d f
- black 532 979 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 509 973 m 23 6 d -20 16
- d -24 -6 d f black 509 973 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1610 1233
- m 23 6 d -20 15 d -24 -6 d f black 1610 1233 m 23 6 d -20 15 d -24 -6 d cl s 0
- 0 0.8 c 1586 1227 m 24 6 d -21 15 d -23 -6 d f black 1586 1227 m 24 6 d -21 15
- d -23 -6 d cl s 0 0 0.8 c 1563 1221 m 23 6 d -20 15 d -24 -6 d f black 1563
- 1221 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1560 1282 m 3 -61 d -21 15 d -2
- 62 d f 0 0.2 0.8 c 1558 1344 m 2 -62 d -20 16 d -2 62 d f 0 0.4 0.8 c 1556 1406
- m 2 -62 d -20 16 d -2 61 d f 0 0.6 0.8 c 1554 1467 m 2 -61 d -20 15 d -2 62 d f
- 0 0.8 0.8 c 1552 1529 m 2 -62 d -20 16 d -2 62 d f 0 0.8 0.6 c 1550 1590 m 2
- -61 d -20 16 d -1 61 d f 0 0.8 0.4 c 1548 1652 m 2 -62 d -19 16 d -2 62 d f 0
- 0.8 0.2 c 1546 1714 m 2 -62 d -19 16 d -2 61 d f 0 0.8 0 c 1544 1775 m 2 -61 d
- -19 15 d -2 62 d f 0.2 0.8 0 c 1542 1837 m 2 -62 d -19 16 d -2 62 d f 0.4 0.8 0
- c 1540 1898 m 2 -61 d -19 16 d -2 61 d f 0.6 0.8 0 c 1539 1913 m 1 -15 d -19 16
- d -2 62 d 2 -2 d f 0.8 0.8 0 c 1519 1976 m 7 Y 2 -9 d f black 1539 1913 m 24
- -692 d -21 15 d -23 747 d cl s 0.2 0.8 0 c 1498 1846 m -3 -17 d 13 7 d f 0.4
- 0.8 0 c 1516 1840 m 18 57 d -26 14 d -10 -65 d 10 -10 d f 0.6 0.8 0 c 1534 1897
- m 5 16 d -18 61 d -3 2 d -10 -65 d f 0.8 0.8 0 c 1521 1974 m -2 9 d -1 -7 d f
- black 1516 1840 m 23 73 d -20 70 d -24 -154 d cl s 0.2 0.8 0 c 1508 1836 m -13
- -7 d -14 13 d f 0.4 0.8 0 c 1492 1848 m 24 -8 d -8 -4 d -27 6 d -9 8 d f black
- 1492 1848 m 24 -8 d -21 -11 d -23 21 d cl s 0 0.8 0.6 c 1450 1586 m -2 -24 d 2
- 22 d f 0 0.8 0.4 c 1455 1649 m -5 -63 d -2 Y 4 59 d f 0 0.8 0.2 c 1461 1713 m
- -6 -64 d -1 -6 d 4 59 d f 0 0.8 0 c 1466 1776 m -5 -63 d -3 -11 d 4 59 d f 0.2
- 0.8 0 c 1471 1840 m -5 -64 d -4 -15 d 4 59 d f 0.4 0.8 0 c 1469 1855 m 23 -7 d
- -20 2 d -1 -10 d -5 -20 d f black 1469 1855 m 23 -7 d -20 2 d -24 -288 d cl s 0
- 0.8 0.6 c 1450 1584 m -2 -22 d -2 23 d f 0 0.8 0.4 c 1454 1643 m -4 -59 d -4 1
- d -4 61 d f 0 0.8 0.2 c 1458 1702 m -4 -59 d -12 3 d -5 61 d f 0 0.8 0 c 1445
- 1728 m 4 23 d 13 10 d -4 -59 d -21 5 d -5 61 d 9 -15 d f 0.2 0.8 0 c 1449 1751
- m 12 65 d 5 4 d -4 -59 d -30 7 d -4 61 d 3 -6 d 10 -70 d f 0.4 0.8 0 c 1461
- 1816 m 8 39 d -3 -35 d -38 9 d -3 36 d 6 -42 d f black 1445 1728 m 24 127 d -21
- -293 d -23 303 d cl s 0 0.8 0.4 c 1402 1636 m -1 -6 d 1 5 d f 0 0.8 0.2 c 1408
- 1699 m -6 -63 d -1 Y 7 57 d f 0 0.8 0 c 1437 1748 m 8 -20 d -4 25 d -26 10 d -7
- -64 d 1 -7 d 7 56 d f 0.2 0.8 0 c 1422 1789 m 15 -41 d 4 5 d -10 70 d -10 4 d
- -6 -64 d 1 -15 d f 0.4 0.8 0 c 1431 1823 m -6 42 d -4 -38 d f black 1422 1789 m
- 23 -61 d -20 137 d -24 -235 d cl s 0 0.8 0.4 c 1402 1635 m -1 -5 d 5 Y f 0 0.8
- 0.2 c 1409 1692 m -7 -57 d -1 X -7 61 d f 0 0.8 0 c 1416 1748 m -7 -56 d -15 4
- d -7 60 d f 0.2 0.8 0 c 1398 1784 m 24 5 d -6 -41 d -29 8 d -7 61 d 10 -10 d f
- 0.4 0.8 0 c 1380 1817 m -2 22 d 12 -32 d f black 1398 1784 m 24 5 d -21 -159 d
- -23 209 d cl s 0 0.8 0 c 1375 1670 m 13 66 d -25 5 d f 0.2 0.8 0 c 1388 1736 m
- 10 48 d -8 23 d -26 5 d -10 -19 d 9 -52 d f 0.4 0.8 0 c 1390 1807 m -12 32 d
- -14 -27 d f black 1375 1670 m 23 114 d -20 55 d -24 -46 d cl s 0 0.8 0 c 1371
- 1731 m 4 -61 d -12 71 d f 0.2 0.8 0 c 1367 1792 m 4 -61 d -8 10 d -9 52 d -23 8
- d 3 Y f 0.4 0.8 0 c 1364 1854 m 3 -62 d -36 12 d 5 58 d f 0.6 0.8 0 c 1360 1915
- m 4 -61 d -28 8 d 4 59 d f 0.8 0.8 0 c 1357 1976 m 3 -61 d -20 6 d 4 59 d f 0.8
- 0.6 0 c 1353 2037 m 4 -61 d -13 4 d 5 59 d f 0.8 0.4 0 c 1351 2067 m 2 -30 d -4
- 2 d f black 1351 2067 m 24 -397 d -21 123 d -23 8 d cl s 0.2 0.8 0 c 1331 1804
- m -3 Y -24 -20 d 5 14 d f 0.4 0.8 0 c 1336 1862 m -5 -58 d -19 -9 d 15 50 d f
- 0.6 0.8 0 c 1328 1846 m 6 62 d 6 13 d -4 -59 d -9 -17 d f 0.8 0.8 0 c 1334 1908
- m 7 64 d 3 8 d -4 -59 d f 0.8 0.6 0 c 1341 1972 m 7 64 d 1 3 d -5 -59 d f 0.8
- 0.4 0 c 1348 2036 m 3 31 d -2 -28 d f black 1328 1846 m 23 221 d -20 -266 d -24
- -20 d cl s 0 0.8 0.2 c 1290 1669 m -6 -42 d 4 38 d f 0 0.8 0 c 1300 1734 m -10
- -65 d -2 -4 d 5 57 d f 0.2 0.8 0 c 1312 1795 m -5 -14 d -7 -47 d -7 -12 d 6 58
- d f 0.4 0.8 0 c 1304 1827 m 21 17 d 2 1 d -15 -50 d -13 -15 d f 0.6 0.8 0 c
- 1325 1844 m 3 2 d -1 -1 d f black 1304 1827 m 24 19 d -21 -65 d -23 -154 d cl s
- 0 0.8 0.2 c 1288 1665 m -4 -38 d -24 -19 d 4 51 d f 0 0.8 0 c 1293 1722 m -5
- -57 d -24 -6 d 5 58 d f 0.2 0.8 0 c 1299 1780 m -6 -58 d -24 -5 d 5 59 d f 0.4
- 0.8 0 c 1297 1837 m 7 -10 d -5 -47 d -25 -4 d 4 58 d f 0.6 0.8 0 c 1281 1861 m
- 16 -24 d -19 -3 d f black 1281 1861 m 23 -34 d -20 -200 d -24 -19 d cl s 0 0.8
- 0.2 c 1264 1659 m -4 -51 d -9 51 d f 0 0.8 0 c 1269 1717 m -5 -58 d -13 X -11
- 60 d f 0.2 0.8 0 c 1274 1776 m -5 -59 d -29 2 d -3 17 d 11 36 d f 0.4 0.8 0 c
- 1257 1801 m 11 28 d 10 5 d -4 -58 d -26 -4 d f 0.6 0.8 0 c 1268 1829 m 13 32 d
- -3 -27 d f black 1257 1801 m 24 60 d -21 -253 d -23 128 d cl s 0 0.8 0.2 c 1219
- 1651 m -6 -28 d 3 25 d f 0 0.8 0 c 1233 1717 m -14 -66 d -3 -3 d 5 58 d f 0.2
- 0.8 0 c 1248 1772 m -11 -36 d -4 -19 d -12 -11 d 6 58 d f 0.4 0.8 0 c 1242 1823
- m 15 -22 d -9 -29 d -21 -8 d 5 58 d f 0.6 0.8 0 c 1234 1836 m 8 -13 d -10 -1 d
- f black 1234 1836 m 23 -35 d -20 -65 d -24 -113 d cl s 0 0.8 0.2 c 1216 1648 m
- -3 -25 d -3 26 d f 0 0.8 0 c 1221 1706 m -5 -58 d -6 1 d -7 60 d f 0.2 0.8 0 c
- 1210 1736 m 4 18 d 13 10 d -6 -58 d -18 3 d -7 61 d 9 -14 d f 0.4 0.8 0 c 1214
- 1754 m 16 66 d 2 2 d -5 -58 d -31 6 d -6 48 d 15 -62 d f 0.6 0.8 0 c 1230 1820
- m 4 16 d -2 -14 d f black 1210 1736 m 24 100 d -21 -213 d -23 195 d cl s 0 0.8
- 0.2 c 1187 1595 m 4 28 d -9 3 d f 0 0.8 0 c 1191 1623 m 11 65 d -32 9 d 12 -71
- d f 0.2 0.8 0 c 1202 1688 m 8 48 d -5 20 d -28 9 d -11 -47 d 4 -21 d f 0.4 0.8
- 0 c 1205 1756 m -15 62 d -13 -53 d f black 1187 1595 m 23 141 d -20 82 d -24
- -100 d cl s 0 0.8 0.4 c 1146 1570 m -3 -19 d 2 17 d f 0 0.8 0.2 c 1181 1621 m 6
- -26 d -5 31 d -27 9 d -9 -65 d -1 -2 d 8 56 d f 0 0.8 0 c 1167 1679 m 14 -58 d
- 1 5 d -12 71 d -6 2 d -9 -64 d -2 -11 d 8 56 d f 0.2 0.8 0 c 1163 1697 m 4 -18
- d 3 18 d -4 21 d -2 -19 d -3 -19 d f black 1163 1697 m 24 -102 d -21 123 d -23
- -167 d cl s 0 0.8 0.4 c 1145 1568 m -2 -17 d -4 18 d f 0 0.8 0.2 c 1153 1624 m
- -8 -56 d -6 1 d -14 58 d f 0 0.8 0 c 1161 1680 m -8 -56 d -28 3 d -6 26 d 7 30
- d f 0.2 0.8 0 c 1144 1736 m 19 -39 d -2 -17 d -35 3 d 12 53 d f 0.4 0.8 0 c
- 1140 1745 m 4 -9 d -6 X f black 1140 1745 m 23 -48 d -20 -146 d -24 102 d cl s
- 0 0.8 0 c 1126 1683 m -7 -30 d -15 31 d f 0.2 0.8 0 c 1138 1736 m -12 -53 d -22
- 1 d -8 16 d 11 36 d f 0.4 0.8 0 c 1116 1766 m 24 -21 d -2 -9 d -31 X f black
- 1116 1766 m 24 -21 d -21 -92 d -23 47 d cl s 0 0.8 0 c 1089 1680 m -17 -53 d 15
- 38 d f 0.2 0.8 0 c 1093 1679 m 12 47 d 2 10 d -11 -36 d -7 -20 d -2 -15 d f 0.4
- 0.8 0 c 1105 1726 m 11 40 d -9 -30 d f black 1093 1679 m 23 87 d -20 -66 d -24
- -73 d cl s 0 0.8 0 c 1087 1665 m -15 -38 d -9 47 d f 0.2 0.8 0 c 1069 1700 m 24
- -21 d -6 -14 d -24 9 d -12 59 d 6 -7 d f 0.4 0.8 0 c 1051 1733 m -2 9 d 8 -16 d
- f black 1069 1700 m 24 -21 d -21 -52 d -23 115 d cl s 0 0.8 0.2 c 1028 1602 m
- -3 -14 d 2 13 d f 0 0.8 0 c 1037 1667 m -9 -65 d -1 -1 d 8 56 d f 0.2 0.8 0 c
- 1059 1714 m 10 -14 d -12 26 d -10 6 d -10 -65 d -2 -10 d 8 56 d f 0.4 0.8 0 c
- 1046 1734 m 13 -20 d -2 12 d -8 16 d -2 -10 d -4 -19 d f black 1046 1734 m 23
- -34 d -20 42 d -24 -154 d cl s 0 0.8 0.2 c 1027 1601 m -2 -13 d -23 -19 d 8 21
- d f 0 0.8 0 c 1022 1621 m 5 23 d 8 13 d -8 -56 d -17 -11 d f 0.2 0.8 0 c 1027
- 1644 m 14 65 d 2 4 d -8 -56 d f 0.4 0.8 0 c 1041 1709 m 5 25 d -3 -21 d f black
- 1022 1621 m 24 113 d -21 -146 d -23 -19 d cl s 0 0.8 0.2 c 1010 1590 m -8 -21 d
- -16 23 d f 0 0.8 0 c 1019 1642 m 3 -21 d -12 -31 d -24 2 d -8 11 d 6 45 d f 0.2
- 0.8 0 c 1010 1702 m 9 -60 d -35 6 d 6 57 d f 0.4 0.8 0 c 1001 1761 m 9 -59 d
- -20 3 d 7 57 d f 0.6 0.8 0 c 999 1776 m 2 -15 d -4 1 d f black 999 1776 m 23
- -155 d -20 -52 d -24 34 d cl s 0 0.8 0 c 975 1622 m 2 9 d 7 17 d -6 -45 d -8 47
- d 3 -18 d f 0.2 0.8 0 c 977 1631 m 10 65 d 3 9 d -6 -57 d -14 2 d -11 59 d 1 -5
- d 13 -72 d f 0.4 0.8 0 c 987 1696 m 9 64 d 1 2 d -7 -57 d -31 4 d -4 23 d 5 -28
- d f 0.6 0.8 0 c 996 1760 m 3 16 d -2 -14 d f black 975 1622 m 24 154 d -21 -173
- d -23 129 d cl s 0 0.8 0 c 952 1616 m 23 6 d -2 10 d -22 -7 d f 0.2 0.8 0 c 973
- 1632 m -13 72 d -17 -11 d 8 -68 d f 0.4 0.8 0 c 960 1704 m -5 28 d -14 35 d -6
- -5 d 8 -69 d f 0.6 0.8 0 c 941 1767 m -10 26 d 4 -31 d f black 952 1616 m 23 6
- d -20 110 d -24 61 d cl s 0 0.8 0 c 949 1624 m 3 -8 d -1 9 d -36 11 d -7 -64 d
- 10 54 d f 0.2 0.8 0 c 928 1677 m 21 -53 d 2 1 d -8 68 d -21 7 d -7 -64 d 3 -10
- d f 0.4 0.8 0 c 943 1693 m -8 69 d -7 2 d -6 -64 d f 0.6 0.8 0 c 935 1762 m -4
- 31 d -3 -29 d f black 928 1677 m 24 -61 d -21 177 d -23 -221 d cl s 0 0.8 0 c
- 918 1626 m -10 -54 d -24 34 d 4 20 d f 0.2 0.8 0 c 927 1680 m 1 -3 d -10 -51 d
- -30 X 9 55 d f 0.4 0.8 0 c 905 1725 m 22 -45 d -30 1 d f black 905 1725 m 23
- -48 d -20 -105 d -24 34 d cl s 0 0.8 0 c 888 1626 m -4 -20 d -3 21 d f 0.2 0.8
- 0 c 897 1681 m -9 -55 d -7 1 d -11 60 d f 0.4 0.8 0 c 881 1719 m 24 6 d -8 -44
- d -27 6 d -9 48 d f black 881 1719 m 24 6 d -21 -119 d -23 129 d cl s 0 0.8 0.4
- c 840 1493 m -2 -33 d 2 30 d f 0 0.8 0.2 c 846 1556 m -6 -63 d -3 Y 5 58 d f 0
- 0.8 0 c 851 1620 m -5 -64 d -1 -8 d 5 59 d f 0.2 0.8 0 c 857 1683 m -6 -63 d -1
- -13 d 5 58 d f 0.4 0.8 0 c 858 1700 m 23 19 d -20 16 d -4 -52 d -2 -18 d f
- black 858 1700 m 23 19 d -20 16 d -23 -275 d cl s 0 0.8 0.4 c 840 1490 m -2 -30
- d -5 31 d f 0 0.8 0.2 c 845 1548 m -5 -58 d -7 1 d -8 60 d f 0 0.8 0 c 850 1607
- m -5 -59 d -20 3 d -8 60 d f 0.2 0.8 0 c 834 1613 m 13 47 d 8 5 d -5 -58 d -33
- 4 d -3 18 d f 0.4 0.8 0 c 847 1660 m 11 40 d -3 -35 d f black 834 1613 m 24 87
- d -20 -240 d -24 169 d cl s 0 0.8 0 c 803 1607 m -12 -25 d 2 20 d f 0.2 0.8 0 c
- 826 1655 m 8 -42 d -20 16 d -11 -22 d -10 -5 d 8 56 d f 0.4 0.8 0 c 814 1714 m
- 12 -59 d -25 3 d 8 56 d f 0.6 0.8 0 c 811 1728 m 3 -14 d -5 X f black 811 1728
- m 23 -115 d -20 16 d -23 -47 d cl s 0 0.8 0 c 793 1602 m -2 -20 d -3 22 d f 0.2
- 0.8 0 c 801 1658 m -8 -56 d -5 2 d -7 60 d f 0.4 0.8 0 c 809 1714 m -8 -56 d
- -20 6 d -7 60 d f 0.6 0.8 0 c 804 1773 m 7 -45 d -2 -14 d -35 10 d -7 54 d 1 6
- d f 0.8 0.8 0 c 795 1833 m 9 -60 d -36 11 d 11 54 d f 0.8 0.6 0 c 787 1883 m 8
- -50 d -16 5 d f black 787 1883 m 24 -155 d -20 -146 d -24 196 d cl s 0.2 0.8 0
- c 748 1656 m -4 -32 d 1 29 d f 0.4 0.8 0 c 758 1720 m -10 -64 d -3 -3 d 4 59 d
- f 0.6 0.8 0 c 768 1784 m -1 -6 d -9 -58 d -9 -8 d 4 59 d f 0.8 0.8 0 c 779 1838
- m -11 -54 d -15 -13 d 4 59 d f 0.8 0.6 0 c 783 1892 m 4 -9 d -8 -45 d -22 -8 d
- 4 60 d f 0.8 0.4 0 c 764 1931 m 19 -39 d -22 -2 d f black 764 1931 m 23 -48 d
- -20 -105 d -23 -154 d cl s 0 0.8 0 c 736 1590 m -16 -66 d 5 58 d f 0.2 0.8 0 c
- 745 1653 m -1 -29 d -8 -34 d -11 -8 d 6 58 d f 0.4 0.8 0 c 749 1712 m -4 -59 d
- -14 -13 d 5 59 d f 0.6 0.8 0 c 740 1750 m 1 7 d 12 14 d -4 -59 d -13 -13 d f
- 0.8 0.8 0 c 741 1757 m 9 65 d 7 8 d -4 -59 d f 0.8 0.6 0 c 750 1822 m 8 64 d 3
- 4 d -4 -60 d f 0.8 0.4 0 c 758 1886 m 6 45 d -3 -41 d f black 740 1750 m 24 181
- d -20 -307 d -24 -100 d cl s 0 0.8 0 c 717 1556 m 1 9 d 7 17 d -5 -58 d -23 48
- d f 0.2 0.8 0 c 718 1565 m 8 64 d 5 11 d -6 -58 d f 0.4 0.8 0 c 726 1629 m 7 64
- d 3 6 d -5 -59 d f 0.6 0.8 0 c 733 1693 m 7 57 d -4 -51 d f black 717 1556 m 23
- 194 d -20 -226 d -23 48 d cl s 0 0.8 0 c 712 1564 m 5 -8 d -20 16 d -2 8 d f
- 0.2 0.8 0 c 693 1591 m 19 -27 d -17 16 d -10 60 d 3 -15 d f 0.4 0.8 0 c 685
- 1640 m -10 59 d 1 -3 d 12 -71 d f 0.6 0.8 0 c 675 1699 m -2 15 d 3 -18 d f
- black 693 1591 m 24 -35 d -20 16 d -24 142 d cl s 0.2 0.8 0 c 687 1619 m 6 -28
- d -5 34 d -30 8 d -8 -46 d 7 38 d f 0.4 0.8 0 c 673 1678 m 14 -59 d 1 6 d -12
- 71 d -6 2 d -12 -65 d -1 -8 d 10 54 d f 0.6 0.8 0 c 670 1692 m 3 -14 d 3 18 d
- -3 18 d -3 -16 d -3 -19 d f black 670 1692 m 23 -101 d -20 123 d -23 -127 d
- cl s 0.2 0.8 0 c 646 1606 m 1 3 d 10 16 d -7 -38 d -10 41 d 5 -18 d f 0.4 0.8 0
- c 647 1609 m 19 67 d 1 3 d -10 -54 d -17 3 d -14 59 d 1 -1 d 18 -76 d f 0.6 0.8
- 0 c 666 1676 m 4 16 d -3 -13 d -41 8 d 1 Y 1 -2 d f black 646 1606 m 24 86 d
- -20 -105 d -24 101 d cl s 0.2 0.8 0 c 646 1609 m -3 Y -1 4 d f 0.4 0.8 0 c 632
- 1667 m 14 -58 d -1 1 d -18 76 d f 0.6 0.8 0 c 623 1707 m 9 -40 d -5 19 d -1 2 d
- -23 48 d f black 623 1707 m 23 -101 d -20 82 d -23 48 d cl s 0 0 0.8 c 599 976
- m 2 62 d -20 16 d -2 -63 d f 0 0.2 0.8 c 601 1038 m 2 63 d -20 15 d -2 -62 d f
- 0 0.4 0.8 c 603 1101 m 3 63 d -21 15 d -2 -63 d f 0 0.6 0.8 c 606 1164 m 2 62 d
- -21 16 d -2 -63 d f 0 0.8 0.8 c 608 1226 m 2 63 d -21 15 d -2 -62 d f 0 0.8 0.6
- c 610 1289 m 2 63 d -21 15 d -2 -63 d f 0 0.8 0.4 c 612 1352 m 2 62 d -21 16 d
- -2 -63 d f 0 0.8 0.2 c 614 1414 m 2 63 d -21 15 d -2 -62 d f 0 0.8 0 c 616 1477
- m 2 62 d -21 16 d -2 -63 d f 0.2 0.8 0 c 618 1539 m 2 63 d -21 16 d -2 -63 d f
- 0.4 0.8 0 c 620 1602 m 2 63 d -21 15 d -2 -62 d f 0.6 0.8 0 c 622 1665 m 1 42 d
- -20 29 d -2 -56 d f black 599 976 m 24 731 d -20 29 d -24 -745 d cl s 0 0 0.8 c
- 576 970 m 23 6 d -20 15 d -23 -6 d f black 576 970 m 23 6 d -20 15 d -23 -6 d
- cl s 0 0 0.8 c 552 964 m 24 6 d -20 15 d -24 -6 d f black 552 964 m 24 6 d -20
- 15 d -24 -6 d cl s 0 0 0.8 c 529 958 m 23 6 d -20 15 d -23 -6 d f black 529 958
- m 23 6 d -20 15 d -23 -6 d cl s 0 0 0.8 c 1630 1217 m 23 6 d -20 16 d -23 -6 d
- f black 1630 1217 m 23 6 d -20 16 d -23 -6 d cl s 0 0 0.8 c 1606 1211 m 24 6 d
- -20 16 d -24 -6 d f black 1606 1211 m 24 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c
- 1583 1205 m 23 6 d -20 16 d -23 -6 d f black 1583 1205 m 23 6 d -20 16 d -23 -6
- d cl s 0 0 0.8 c 1581 1267 m 2 -62 d -20 16 d -3 61 d f 0 0.2 0.8 c 1579 1328 m
- 2 -61 d -21 15 d -2 62 d f 0 0.4 0.8 c 1577 1390 m 2 -62 d -21 16 d -2 62 d f 0
- 0.6 0.8 c 1575 1452 m 2 -62 d -21 16 d -2 61 d f 0 0.8 0.8 c 1573 1513 m 2 -61
- d -21 15 d -2 62 d f 0 0.8 0.6 c 1571 1575 m 2 -62 d -21 16 d -2 61 d f 0 0.8
- 0.4 c 1569 1637 m 2 -62 d -21 15 d -2 62 d f 0 0.8 0.2 c 1566 1698 m 3 -61 d
- -21 15 d -2 62 d f 0 0.8 0 c 1564 1760 m 2 -62 d -20 16 d -2 61 d f 0.2 0.8 0 c
- 1562 1821 m 2 -61 d -20 15 d -2 62 d f 0.4 0.8 0 c 1560 1883 m 2 -62 d -20 16 d
- -2 61 d f 0.6 0.8 0 c 1559 1911 m 1 -28 d -20 15 d -1 15 d f black 1559 1911 m
- 24 -706 d -20 16 d -24 692 d cl s 0.4 0.8 0 c 1534 1897 m -18 -57 d 19 37 d f
- 0.6 0.8 0 c 1536 1878 m 23 33 d -20 2 d -5 -16 d 1 -20 d f black 1536 1878 m 23
- 33 d -20 2 d -23 -73 d cl s 0.4 0.8 0 c 1535 1877 m -19 -37 d -24 8 d 15 27 d f
- 0.6 0.8 0 c 1512 1886 m 24 -8 d -1 -1 d -28 -2 d f black 1512 1886 m 24 -8 d
- -20 -38 d -24 8 d cl s 0 0.8 0 c 1489 1705 m 5 37 d -10 3 d f 0.2 0.8 0 c 1494
- 1742 m 8 64 d -28 8 d 10 -69 d f 0.4 0.8 0 c 1502 1806 m 8 64 d -3 5 d -15 -27
- d -23 7 d 5 -41 d f 0.6 0.8 0 c 1510 1870 m 2 16 d -5 -11 d f black 1489 1705 m
- 23 181 d -20 -38 d -23 7 d cl s 0 0.8 0 c 1479 1738 m 10 -33 d -5 40 d -35 6 d
- -4 -23 d 7 17 d f 0.2 0.8 0 c 1465 1780 m 14 -42 d 5 7 d -10 69 d -13 2 d -12
- -65 d 3 -6 d f 0.4 0.8 0 c 1474 1814 m -5 41 d -8 -39 d f black 1465 1780 m 24
- -75 d -20 150 d -24 -127 d cl s 0 0.8 0 c 1452 1745 m -7 -17 d -8 20 d f 0.2
- 0.8 0 c 1463 1796 m 2 -16 d -13 -35 d -15 3 d -15 41 d 1 16 d f 0.4 0.8 0 c
- 1456 1856 m 7 -60 d -40 9 d 7 57 d f 0.6 0.8 0 c 1448 1917 m 8 -61 d -26 6 d 7
- 57 d f 0.8 0.8 0 c 1442 1962 m 6 -45 d -11 2 d f black 1442 1962 m 23 -182 d
- -20 -52 d -23 61 d cl s 0.2 0.8 0 c 1423 1805 m -1 -16 d -24 -5 d 9 10 d f 0.4
- 0.8 0 c 1418 1808 m 7 40 d 5 14 d -7 -57 d -16 -11 d f 0.6 0.8 0 c 1425 1848 m
- 9 65 d 3 6 d -7 -57 d f 0.8 0.8 0 c 1434 1913 m 8 49 d -5 -43 d f black 1418
- 1808 m 24 154 d -20 -173 d -24 -5 d cl s 0 0.8 0 c 1388 1736 m -13 -66 d 6 57 d
- f 0.2 0.8 0 c 1407 1794 m -9 -10 d -10 -48 d -7 -9 d 6 58 d f 0.4 0.8 0 c 1402
- 1843 m 16 -35 d -11 -14 d -20 -9 d 6 57 d f 0.6 0.8 0 c 1395 1856 m 7 -13 d -9
- -1 d f black 1395 1856 m 23 -48 d -20 -24 d -23 -114 d cl s 0 0.8 0 c 1381 1727
- m -6 -57 d -4 61 d f 0.2 0.8 0 c 1387 1785 m -6 -58 d -10 4 d -4 61 d f 0.4 0.8
- 0 c 1371 1796 m 17 43 d 5 3 d -6 -57 d -20 7 d -3 62 d 4 -17 d f 0.6 0.8 0 c
- 1388 1839 m 7 17 d -2 -14 d -29 12 d -4 61 d 3 -12 d 5 -66 d f 0.8 0.8 0 c 1360
- 1915 m -3 61 d 1 -7 d 5 -66 d f 0.8 0.6 0 c 1357 1976 m -4 61 d 1 -2 d 4 -66 d
- f 0.8 0.4 0 c 1353 2037 m -2 30 d 3 -32 d f black 1371 1796 m 24 60 d -20 -186
- d -24 397 d cl s 0.2 0.8 0 c 1348 1763 m 3 5 d -4 X f 0.4 0.8 0 c 1351 1768 m
- 20 28 d -3 41 d -40 7 d 19 -76 d f 0.6 0.8 0 c 1368 1837 m -5 66 d -29 5 d -6
- -62 d -2 Y f 0.8 0.8 0 c 1363 1903 m -5 66 d -17 3 d -7 -64 d f 0.8 0.6 0 c
- 1358 1969 m -4 66 d -6 1 d -7 -64 d f 0.8 0.4 0 c 1354 2035 m -3 32 d -3 -31 d
- f black 1348 1763 m 23 33 d -20 271 d -23 -221 d cl s 0.2 0.8 0 c 1346 1766 m 2
- -3 d -1 5 d f 0.4 0.8 0 c 1324 1798 m 22 -32 d 1 2 d -19 76 d -3 X -21 -17 d f
- 0.6 0.8 0 c 1328 1844 m 2 Y -3 -2 d f black 1324 1798 m 24 -35 d -20 83 d -24
- -19 d cl s 0.4 0.8 0 c 1318 1821 m 6 -23 d -20 29 d -7 10 d f 0.6 0.8 0 c 1303
- 1880 m 15 -59 d -21 16 d -16 24 d 17 21 d f 0.8 0.8 0 c 1301 1886 m 2 -6 d -5 2
- d f black 1301 1886 m 23 -88 d -20 29 d -23 34 d cl s 0.4 0.8 0 c 1278 1799 m 3
- 13 d -13 17 d -11 -28 d f 0.6 0.8 0 c 1281 1812 m 18 67 d -1 3 d -17 -21 d -13
- -32 d f 0.8 0.8 0 c 1299 1879 m 2 7 d -3 -4 d f black 1278 1799 m 23 87 d -20
- -25 d -24 -60 d cl s 0.4 0.8 0 c 1254 1793 m 24 6 d -21 2 d -15 22 d 3 -11 d f
- 0.6 0.8 0 c 1242 1823 m -8 13 d 11 -24 d f black 1254 1793 m 24 6 d -21 2 d -23
- 35 d cl s 0.2 0.8 0 c 1231 1680 m 12 60 d -29 14 d -4 -18 d f 0.4 0.8 0 c 1243
- 1740 m 11 53 d -9 19 d -15 8 d -16 -66 d f 0.6 0.8 0 c 1245 1812 m -11 24 d -4
- -16 d f black 1231 1680 m 23 113 d -20 43 d -24 -100 d cl s 0 0.8 0.2 c 1191
- 1623 m -4 -28 d 3 25 d f 0 0.8 0 c 1202 1688 m -11 -65 d -1 -3 d 7 56 d f 0.2
- 0.8 0 c 1214 1733 m 17 -53 d -21 56 d -8 -48 d -5 -12 d 7 57 d f 0.4 0.8 0 c
- 1207 1754 m 7 -21 d -10 X f black 1207 1754 m 24 -74 d -21 56 d -23 -141 d cl s
- 0 0.8 0.2 c 1190 1620 m -3 -25 d -6 26 d f 0 0.8 0 c 1197 1676 m -7 -56 d -9 1
- d -14 58 d f 0.2 0.8 0 c 1204 1733 m -7 -57 d -30 3 d -4 18 d 6 39 d f 0.4 0.8
- 0 c 1196 1790 m 11 -36 d -3 -21 d -35 3 d 9 56 d f 0.6 0.8 0 c 1184 1829 m 12
- -39 d -18 2 d f black 1184 1829 m 23 -75 d -20 -159 d -24 102 d cl s 0.2 0.8 0
- c 1169 1736 m -6 -39 d -19 39 d f 0.4 0.8 0 c 1178 1792 m -9 -56 d -25 X -4 9 d
- 15 40 d f 0.6 0.8 0 c 1160 1796 m 24 33 d -6 -37 d -23 -7 d f black 1160 1796 m
- 24 33 d -21 -132 d -23 48 d cl s 0.4 0.8 0 c 1155 1785 m -15 -40 d -24 21 d 4
- 21 d f 0.6 0.8 0 c 1146 1840 m 14 -44 d -5 -11 d -35 2 d 11 55 d f 0.8 0.8 0 c
- 1137 1871 m 9 -31 d -15 2 d f black 1137 1871 m 23 -75 d -20 -51 d -24 21 d
- cl s 0.2 0.8 0 c 1105 1726 m -12 -47 d 5 40 d f 0.4 0.8 0 c 1120 1787 m -4 -21
- d -11 -40 d -7 -7 d 7 56 d f 0.6 0.8 0 c 1131 1842 m -11 -55 d -15 -12 d 7 57 d
- f 0.8 0.8 0 c 1113 1838 m 24 33 d -6 -29 d -19 -10 d f black 1113 1838 m 24 33
- d -21 -105 d -23 -87 d cl s 0.2 0.8 0 c 1098 1719 m -5 -40 d -24 21 d 13 7 d f
- 0.4 0.8 0 c 1090 1711 m 10 55 d 5 9 d -7 -56 d -16 -12 d f 0.6 0.8 0 c 1100
- 1766 m 12 65 d 1 Y -7 -57 d f 0.8 0.8 0 c 1112 1831 m 1 7 d -1 -6 d f black
- 1090 1711 m 23 127 d -20 -159 d -24 21 d cl s 0.2 0.8 0 c 1066 1638 m 20 62 d
- -4 7 d -13 -7 d -10 14 d -7 -8 d f 0.4 0.8 0 c 1086 1700 m 4 11 d -8 -4 d -23 7
- d -13 20 d 6 -28 d f black 1066 1638 m 24 73 d -21 -11 d -23 34 d cl s 0 0.8 0
- c 1027 1644 m -5 -23 d 7 16 d f 0.2 0.8 0 c 1043 1672 m 23 -34 d -14 68 d -11 3
- d -14 -65 d 2 -7 d f 0.4 0.8 0 c 1052 1706 m -6 28 d -5 -25 d f black 1043 1672
- m 23 -34 d -20 96 d -24 -113 d cl s 0 0.8 0 c 1029 1637 m -7 -16 d -3 21 d f
- 0.2 0.8 0 c 1038 1688 m 5 -16 d -14 -35 d -10 5 d -9 60 d f 0.4 0.8 0 c 1023
- 1746 m 15 -58 d -28 14 d -9 59 d f 0.6 0.8 0 c 1019 1760 m 4 -14 d -22 15 d -2
- 15 d f black 1019 1760 m 24 -88 d -21 -51 d -23 155 d cl s 0 0.8 0 c 977 1631 m
- -2 -9 d 1 8 d f 0.2 0.8 0 c 987 1696 m -10 -65 d -1 -1 d 6 57 d f 0.4 0.8 0 c
- 996 1760 m -9 -64 d -5 -9 d 7 58 d f 0.6 0.8 0 c 999 1802 m 20 -42 d -20 16 d
- -3 -16 d -7 -15 d 6 57 d f 0.8 0.8 0 c 996 1808 m 3 -6 d -4 X f black 996 1808
- m 23 -48 d -20 16 d -24 -154 d cl s 0 0.8 0 c 976 1630 m -1 -8 d -23 -6 d 1 7 d
- f 0.2 0.8 0 c 982 1687 m -6 -57 d -23 -7 d 11 55 d f 0.4 0.8 0 c 972 1722 m 4
- 12 d 13 11 d -7 -58 d -18 -9 d f 0.6 0.8 0 c 976 1734 m 18 67 d 1 1 d -6 -57 d
- f 0.8 0.8 0 c 994 1801 m 2 7 d -1 -6 d f black 972 1722 m 24 86 d -21 -186 d
- -23 -6 d cl s 0 0.8 0 c 953 1623 m -1 -7 d -3 8 d f 0.2 0.8 0 c 964 1678 m -11
- -55 d -4 1 d -21 53 d 1 3 d f 0.4 0.8 0 c 969 1733 m 3 -11 d -8 -44 d -35 2 d 8
- 56 d f 0.6 0.8 0 c 954 1791 m 15 -58 d -32 3 d 9 56 d f 0.8 0.8 0 c 949 1810 m
- 5 -19 d -8 1 d f black 949 1810 m 23 -88 d -20 -106 d -24 61 d cl s 0 0.8 0.2 c
- 925 1508 m 2 27 d -5 2 d f 0 0.8 0 c 927 1535 m 5 64 d -16 5 d 6 -67 d f 0.2
- 0.8 0 c 932 1599 m 5 63 d -8 18 d -1 -3 d -1 3 d -17 -9 d 6 -67 d f 0.4 0.8 0 c
- 937 1662 m 5 64 d -5 10 d -8 -56 d -2 X -22 45 d 5 -54 d f 0.6 0.8 0 c 942 1726
- m 5 63 d -1 3 d -9 -56 d f 0.8 0.8 0 c 947 1789 m 2 21 d -3 -18 d f black 925
- 1508 m 24 302 d -21 -133 d -23 48 d cl s 0 0.8 0.2 c 919 1533 m 6 -25 d -3 29 d
- f 0 0.8 0 c 906 1592 m 13 -59 d 3 4 d -6 67 d f 0.2 0.8 0 c 902 1610 m 4 -18 d
- 10 12 d -6 67 d -18 -11 d f 0.4 0.8 0 c 910 1671 m -5 54 d -24 -6 d 11 -59 d f
- black 902 1610 m 23 -102 d -20 217 d -24 -6 d cl s 0.2 0.8 0 c 894 1651 m 8 -41
- d -10 50 d f 0.4 0.8 0 c 883 1711 m 11 -60 d -2 9 d -11 59 d -23 -19 d 9 18 d f
- 0.6 0.8 0 c 878 1738 m 5 -27 d -16 7 d f black 878 1738 m 24 -128 d -21 109 d
- -23 -19 d cl s 0.2 0.8 0 c 847 1660 m -13 -47 d 10 37 d f 0.4 0.8 0 c 855 1692
- m 7 13 d 5 13 d -9 -18 d -11 -40 d -3 -10 d f 0.6 0.8 0 c 862 1705 m 16 33 d
- -11 -20 d f black 855 1692 m 23 46 d -20 -38 d -24 -87 d cl s 0.2 0.8 0 c 844
- 1650 m -10 -37 d -8 42 d f 0.4 0.8 0 c 831 1645 m 24 47 d -11 -42 d -18 5 d -12
- 59 d 1 -5 d f 0.6 0.8 0 c 814 1714 m -3 14 d 4 -19 d f black 831 1645 m 24 47 d
- -21 -79 d -23 115 d cl s 0.4 0.8 0 c 808 1639 m 23 6 d -16 64 d -12 -14 d f 0.6
- 0.8 0 c 815 1709 m -4 19 d -7 45 d -6 -12 d 5 -66 d f 0.8 0.8 0 c 804 1773 m -9
- 60 d -3 -5 d 6 -67 d f 0.8 0.6 0 c 795 1833 m -8 50 d 5 -55 d f black 808 1639
- m 23 6 d -20 83 d -24 155 d cl s 0.4 0.8 0 c 784 1647 m 24 -8 d -5 56 d -22 -7
- d f 0.6 0.8 0 c 803 1695 m -5 66 d -21 -8 d 4 -65 d f 0.8 0.8 0 c 798 1761 m -6
- 67 d -20 -9 d 5 -66 d f 0.8 0.6 0 c 792 1828 m -5 55 d -4 9 d -16 -7 d 5 -66 d
- f 0.8 0.4 0 c 783 1892 m -19 39 d 3 -46 d f black 784 1647 m 24 -8 d -21 244 d
- -23 48 d cl s 0.4 0.8 0 c 762 1680 m 22 -33 d -3 41 d f 0.6 0.8 0 c 761 1681 m
- 1 -1 d 19 8 d -4 65 d -36 4 d -1 -7 d f 0.8 0.8 0 c 777 1753 m -5 66 d -22 3 d
- -9 -65 d f 0.8 0.6 0 c 772 1819 m -5 66 d -9 1 d -8 -64 d f 0.8 0.4 0 c 767
- 1885 m -3 46 d -6 -45 d f black 761 1681 m 23 -34 d -20 284 d -24 -181 d cl s 0
- 0.8 0 c 718 1565 m -1 -9 d 1 8 d f 0.2 0.8 0 c 726 1629 m -8 -64 d -1 Y 5 59 d
- f 0.4 0.8 0 c 733 1693 m -7 -64 d -3 -6 d 4 58 d f 0.6 0.8 0 c 749 1739 m 12
- -58 d -21 69 d -7 -57 d -6 -12 d 5 58 d f 0.8 0.8 0 c 737 1796 m 12 -57 d -17 X
- f black 737 1796 m 24 -115 d -21 69 d -23 -194 d cl s 0 0.8 0 c 718 1564 m -1
- -8 d -5 8 d f 0.2 0.8 0 c 714 1575 m 3 31 d 6 17 d -5 -59 d -6 X -19 27 d f 0.4
- 0.8 0 c 717 1606 m 7 64 d 3 11 d -4 -58 d f 0.6 0.8 0 c 724 1670 m 7 64 d 1 5 d
- -5 -58 d f 0.8 0.8 0 c 731 1734 m 6 62 d -5 -57 d f black 714 1575 m 23 221 d
- -20 -240 d -24 35 d cl s 0.2 0.8 0 c 690 1569 m 24 6 d -21 16 d -6 28 d -2 -15
- d f 0.4 0.8 0 c 687 1619 m -14 59 d -3 Y 12 -71 d f 0.6 0.8 0 c 673 1678 m -3
- 14 d 3 -17 d f black 690 1569 m 24 6 d -21 16 d -23 101 d cl s 0.2 0.8 0 c 687
- 1599 m 3 -30 d -5 35 d -38 5 d -1 -3 d 1 3 d f 0.4 0.8 0 c 681 1659 m 6 -60 d
- -2 5 d -12 71 d -7 1 d -19 -67 d 6 57 d f 0.6 0.8 0 c 675 1720 m 6 -61 d -8 16
- d -3 17 d -4 -16 d -13 -10 d 6 58 d f 0.8 0.8 0 c 669 1780 m 6 -60 d -16 4 d 5
- 58 d f 0.8 0.6 0 c 667 1805 m 2 -25 d -5 2 d f black 667 1805 m 23 -236 d -20
- 123 d -24 -86 d cl s 0.2 0.8 0 c 643 1530 m 5 59 d -1 20 d -1 -3 d 3 Y -10 -16
- d f 0.4 0.8 0 c 648 1589 m 6 63 d -1 14 d -6 -57 d -1 X -14 58 d -4 -6 d 8 -68
- d f 0.6 0.8 0 c 654 1652 m 5 64 d 8 Y -6 -58 d -21 1 d -9 40 d 5 -46 d f 0.8
- 0.8 0 c 659 1716 m 6 63 d -1 3 d -5 -58 d f 0.8 0.6 0 c 665 1779 m 2 26 d -3
- -23 d f black 643 1530 m 24 275 d -21 -199 d -23 101 d cl s 0 0 0.8 c 620 960 m
- 2 63 d -21 15 d -2 -62 d f 0 0.2 0.8 c 622 1023 m 3 63 d -22 15 d -2 -63 d f 0
- 0.4 0.8 c 625 1086 m 3 62 d -22 16 d -3 -63 d f 0 0.6 0.8 c 628 1148 m 2 63 d
- -22 15 d -2 -62 d f 0 0.8 0.8 c 630 1211 m 3 63 d -23 15 d -2 -63 d f 0 0.8 0.6
- c 633 1274 m 2 63 d -23 15 d -2 -63 d f 0 0.8 0.4 c 635 1337 m 3 63 d -24 14 d
- -2 -62 d f 0 0.8 0.2 c 638 1400 m 3 62 d -25 15 d -2 -63 d f 0 0.8 0 c 641 1462
- m 2 63 d -25 14 d -2 -62 d f 0.2 0.8 0 c 643 1525 m 5 Y -7 63 d -16 9 d -2 -63
- d f 0.4 0.8 0 c 636 1593 m -8 68 d -6 4 d -2 -63 d f 0.6 0.8 0 c 628 1661 m -5
- 46 d -1 -42 d f black 620 960 m 23 570 d -20 177 d -24 -731 d cl s 0 0 0.8 c
- 596 954 m 24 6 d -21 16 d -23 -6 d f black 596 954 m 24 6 d -21 16 d -23 -6 d
- cl s 0 0 0.8 c 573 948 m 23 6 d -20 16 d -24 -6 d f black 573 948 m 23 6 d -20
- 16 d -24 -6 d cl s 0 0 0.8 c 549 942 m 24 6 d -21 16 d -23 -6 d f black 549 942
- m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1650 1202 m 24 6 d -21 15 d -23 -6 d
- f black 1650 1202 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 1627 1196 m 23 6 d
- -20 15 d -24 -6 d f black 1627 1196 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c
- 1603 1190 m 24 6 d -21 15 d -23 -6 d f black 1603 1190 m 24 6 d -21 15 d -23 -6
- d cl s 0 0 0.8 c 1600 1251 m 3 -61 d -20 15 d -2 62 d f 0 0.2 0.8 c 1598 1313 m
- 2 -62 d -19 16 d -2 61 d f 0 0.4 0.8 c 1595 1374 m 3 -61 d -19 15 d -2 62 d f 0
- 0.6 0.8 c 1592 1435 m 3 -61 d -18 16 d -2 62 d f 0 0.8 0.8 c 1590 1497 m 2 -62
- d -17 17 d -2 61 d f 0 0.8 0.6 c 1587 1558 m 3 -61 d -17 16 d -2 62 d f 0 0.8
- 0.4 c 1584 1620 m 3 -62 d -16 17 d -2 62 d f 0 0.8 0.2 c 1581 1681 m 3 -61 d
- -15 17 d -3 61 d f 0 0.8 0 c 1580 1721 m 1 -40 d -15 17 d -2 62 d 13 -15 d f
- 0.2 0.8 0 c 1564 1760 m -2 61 d 8 -8 d 7 -68 d f 0.4 0.8 0 c 1562 1821 m -2 62
- d 3 -3 d 7 -67 d f 0.6 0.8 0 c 1560 1883 m -1 28 d 4 -31 d f black 1580 1721 m
- 23 -531 d -20 15 d -24 706 d cl s 0 0.8 0.4 c 1556 1567 m 7 48 d -10 X f 0 0.8
- 0.2 c 1563 1615 m 10 64 d -24 2 d 4 -66 d f 0 0.8 0 c 1573 1679 m 7 42 d -3 24
- d -32 1 d 4 -65 d f 0.2 0.8 0 c 1577 1745 m -7 68 d -30 -2 d 5 -65 d f 0.4 0.8
- 0 c 1570 1813 m -7 67 d -27 -3 d 4 -66 d f 0.6 0.8 0 c 1563 1880 m -4 31 d -23
- -33 d -1 Y f black 1556 1567 m 24 154 d -21 190 d -23 -33 d cl s 0 0.8 0.4 c
- 1553 1612 m 3 -45 d -3 48 d f 0 0.8 0.2 c 1549 1673 m 4 -61 d 3 Y -4 66 d f 0
- 0.8 0 c 1544 1734 m 5 -61 d 8 Y -4 65 d f 0.2 0.8 0 c 1540 1795 m 4 -61 d 1 12
- d -5 65 d f 0.4 0.8 0 c 1536 1856 m 4 -61 d 16 Y -4 66 d f 0.6 0.8 0 c 1533
- 1897 m 3 -41 d 22 Y -24 8 d f black 1533 1897 m 23 -330 d -20 311 d -24 8 d
- cl s 0 0.8 0 c 1494 1742 m -5 -37 d 2 34 d f 0.2 0.8 0 c 1502 1806 m -8 -64 d
- -3 -3 d 4 59 d f 0.4 0.8 0 c 1510 1870 m -8 -64 d -7 -8 d 4 59 d f 0.6 0.8 0 c
- 1528 1916 m 5 -19 d -21 -11 d -2 -16 d -11 -13 d 5 59 d f 0.8 0.8 0 c 1515 1975
- m 13 -59 d -24 X 4 59 d f 0.8 0.6 0 c 1509 1999 m 6 -24 d -7 X f black 1509
- 1999 m 24 -102 d -21 -11 d -23 -181 d cl s 0 0.8 0 c 1491 1739 m -2 -34 d -10
- 33 d f 0.2 0.8 0 c 1486 1724 m 5 58 d 4 16 d -4 -59 d -12 -1 d -14 42 d f 0.4
- 0.8 0 c 1491 1782 m 5 64 d 3 11 d -4 -59 d f 0.6 0.8 0 c 1496 1846 m 6 64 d 2 6
- d -5 -59 d f 0.8 0.8 0 c 1502 1910 m 5 63 d 1 2 d -4 -59 d f 0.8 0.6 0 c 1507
- 1973 m 2 26 d -1 -24 d f black 1486 1724 m 23 275 d -20 -294 d -24 75 d cl s
- 0.2 0.8 0 c 1482 1780 m 4 -56 d -21 56 d -2 16 d f 0.4 0.8 0 c 1477 1841 m 5
- -61 d -19 16 d -7 60 d f 0.6 0.8 0 c 1473 1902 m 4 -61 d -21 15 d -8 61 d f 0.8
- 0.8 0 c 1469 1963 m 4 -61 d -25 15 d -6 45 d 3 13 d f 0.8 0.6 0 c 1464 2024 m 5
- -61 d -24 12 d 12 53 d f 0.8 0.4 0 c 1462 2054 m 2 -30 d -7 4 d f black 1462
- 2054 m 24 -330 d -21 56 d -23 182 d cl s 0.2 0.8 0 c 1439 1766 m 3 Y -3 2 d f
- 0.4 0.8 0 c 1439 1769 m 5 64 d -19 15 d -7 -40 d 18 -37 d f 0.6 0.8 0 c 1444
- 1833 m 5 63 d -15 17 d -9 -65 d f 0.8 0.8 0 c 1449 1896 m 6 64 d -10 15 d -3
- -13 d -8 -49 d f 0.8 0.6 0 c 1455 1960 m 5 63 d -3 5 d -12 -53 d f 0.8 0.4 0 c
- 1460 2023 m 2 31 d -5 -26 d f black 1439 1766 m 23 288 d -20 -92 d -24 -154 d
- cl s 0.2 0.8 0 c 1438 1769 m 1 -3 d -3 5 d f 0.4 0.8 0 c 1424 1828 m 14 -59 d
- -2 2 d -18 37 d -16 35 d f 0.6 0.8 0 c 1415 1867 m 9 -39 d -22 15 d -7 13 d f
- black 1415 1867 m 24 -101 d -21 42 d -23 48 d cl s 0.4 0.8 0 c 1388 1839 m -17
- -43 d 10 32 d f 0.6 0.8 0 c 1392 1861 m 23 6 d -20 -11 d -7 -17 d -7 -11 d f
- black 1392 1861 m 23 6 d -20 -11 d -24 -60 d cl s 0.2 0.8 0 c 1351 1768 m -3 -5
- d 4 Y f 0.4 0.8 0 c 1381 1828 m -10 -32 d -20 -28 d -3 -1 d 4 59 d f 0.6 0.8 0
- c 1390 1881 m 2 -20 d -11 -33 d -29 -2 d 3 60 d f 0.8 0.8 0 c 1385 1942 m 5 -61
- d -35 5 d 3 59 d f 0.8 0.6 0 c 1379 2003 m 6 -61 d -27 3 d 4 60 d f 0.8 0.4 0 c
- 1374 2063 m 5 -60 d -17 2 d 3 60 d f 0.8 0.2 0 c 1368 2124 m 6 -61 d -9 2 d f
- black 1368 2124 m 24 -263 d -21 -65 d -23 -33 d cl s 0.2 0.8 0 c 1348 1767 m -4
- Y -2 3 d f 0.4 0.8 0 c 1352 1826 m -4 -59 d -2 -1 d -22 32 d 7 20 d f 0.6 0.8 0
- c 1345 1863 m 7 Y 10 16 d -3 -60 d -21 -8 d f 0.8 0.8 0 c 1345 1870 m 6 63 d 7
- 12 d -3 -59 d f 0.8 0.6 0 c 1351 1933 m 6 64 d 5 8 d -4 -60 d f 0.8 0.4 0 c
- 1357 1997 m 6 64 d 2 4 d -3 -60 d f 0.8 0.2 0 c 1363 2061 m 5 63 d -3 -59 d f
- black 1345 1863 m 23 261 d -20 -361 d -24 35 d cl s 0.4 0.8 0 c 1331 1818 m -7
- -20 d -6 23 d f 0.6 0.8 0 c 1339 1868 m 6 -5 d -14 -45 d -13 3 d -15 59 d f 0.8
- 0.8 0 c 1321 1884 m 18 -16 d -36 12 d -2 6 d f black 1321 1884 m 24 -21 d -21
- -65 d -23 88 d cl s 0.4 0.8 0 c 1281 1812 m -3 -13 d 1 11 d f 0.6 0.8 0 c 1299
- 1879 m -18 -67 d -2 -2 d 10 55 d f 0.8 0.8 0 c 1298 1918 m 23 -34 d -20 2 d -2
- -7 d -10 -14 d f black 1298 1918 m 23 -34 d -20 2 d -23 -87 d cl s 0 0.8 0 c
- 1274 1630 m 3 36 d -7 3 d f 0.2 0.8 0 c 1277 1666 m 5 63 d -21 9 d 9 -69 d f
- 0.4 0.8 0 c 1282 1729 m 6 64 d -9 17 d -1 -11 d -24 -6 d 7 -55 d f 0.6 0.8 0 c
- 1288 1793 m 5 63 d -4 9 d -10 -55 d f 0.8 0.8 0 c 1293 1856 m 5 62 d -9 -53 d f
- black 1274 1630 m 24 288 d -20 -119 d -24 -6 d cl s 0 0.8 0 c 1272 1665 m 2 -35
- d -4 39 d f 0.2 0.8 0 c 1268 1726 m 4 -61 d -2 4 d -9 69 d -18 2 d -12 -60 d 3
- 54 d f 0.4 0.8 0 c 1264 1787 m 4 -61 d -7 12 d -7 55 d -11 -53 d -9 -6 d 4 59 d
- f 0.6 0.8 0 c 1259 1848 m 5 -61 d -26 6 d 4 59 d f 0.8 0.8 0 c 1255 1909 m 4
- -61 d -17 4 d 5 59 d f 0.8 0.6 0 c 1251 1970 m 4 -61 d -8 2 d 4 59 d f 0.8 0.4
- 0 c 1251 1973 m -3 Y f black 1251 1973 m 23 -343 d -20 163 d -23 -113 d cl s
- 0.2 0.8 0 c 1234 1734 m -3 -54 d -17 53 d f 0.4 0.8 0 c 1238 1793 m -4 -59 d
- -20 -1 d -7 21 d 3 36 d f 0.6 0.8 0 c 1242 1852 m -4 -59 d -28 -3 d 6 58 d f
- 0.8 0.8 0 c 1247 1911 m -5 -59 d -26 -4 d 6 58 d f 0.8 0.6 0 c 1251 1970 m -4
- -59 d -25 -5 d 5 58 d f 0.8 0.4 0 c 1227 1967 m 24 6 d -3 Y -24 -6 d f black
- 1227 1967 m 24 6 d -20 -293 d -24 74 d cl s 0.4 0.8 0 c 1204 1720 m 5 53 d 1 17
- d -3 -36 d -11 36 d -3 -10 d f 0.6 0.8 0 c 1209 1773 m 6 64 d 1 11 d -6 -58 d
- -14 X -12 39 d 9 -49 d f 0.8 0.8 0 c 1215 1837 m 6 63 d 1 6 d -6 -58 d f 0.8
- 0.6 0 c 1221 1900 m 6 64 d -5 -58 d f 0.8 0.4 0 c 1227 1964 m 3 Y -3 Y f black
- 1204 1720 m 23 247 d -20 -213 d -23 75 d cl s 0.4 0.8 0 c 1191 1768 m 13 -48 d
- -11 60 d f 0.6 0.8 0 c 1180 1808 m 11 -40 d 2 12 d -9 49 d -24 -33 d f black
- 1180 1808 m 24 -88 d -20 109 d -24 -33 d cl s 0.2 0.8 0 c 1157 1694 m 1 4 d -2
- X f 0.4 0.8 0 c 1158 1698 m 13 65 d -22 3 d 7 -68 d f 0.6 0.8 0 c 1171 1763 m 9
- 45 d -20 -12 d -14 44 d -5 -6 d 8 -68 d f 0.8 0.8 0 c 1146 1840 m -9 31 d 4 -37
- d f black 1157 1694 m 23 114 d -20 -12 d -23 75 d cl s 0 0.8 0 c 1133 1621 m 3
- 9 d -3 X f 0.2 0.8 0 c 1136 1630 m 21 64 d -1 4 d -30 -1 d 7 -67 d f 0.4 0.8 0
- c 1156 1698 m -7 68 d -29 -2 d 6 -67 d f 0.6 0.8 0 c 1149 1766 m -8 68 d -27 -3
- d 6 -67 d f 0.8 0.8 0 c 1141 1834 m -4 37 d -24 -33 d 1 -7 d f black 1133 1621
- m 24 73 d -20 177 d -24 -33 d cl s 0 0.8 0 c 1132 1629 m 1 -8 d 9 Y f 0.2 0.8 0
- c 1124 1689 m 8 -60 d 1 1 d -7 67 d f 0.4 0.8 0 c 1116 1749 m 8 -60 d 2 8 d -6
- 67 d -20 2 d -10 -55 d 11 44 d f 0.6 0.8 0 c 1110 1790 m 6 -41 d 4 15 d -6 67 d
- -2 X -12 -65 d 1 -11 d f 0.8 0.8 0 c 1114 1831 m -1 7 d -1 -7 d f black 1110
- 1790 m 23 -169 d -20 217 d -23 -127 d cl s 0.2 0.8 0 c 1086 1676 m 1 4 d -1 20
- d -20 -62 d f 0.4 0.8 0 c 1087 1680 m 14 65 d 10 Y -11 -44 d -4 -11 d f 0.6 0.8
- 0 c 1101 1745 m 9 45 d -9 -35 d f black 1086 1676 m 24 114 d -20 -79 d -24 -73
- d cl s 0.2 0.8 0 c 1085 1679 m 1 -3 d -20 -38 d -23 34 d 3 14 d f 0.4 0.8 0 c
- 1067 1737 m 18 -58 d -39 7 d 14 52 d f 0.6 0.8 0 c 1063 1751 m 4 -14 d -7 1 d f
- black 1063 1751 m 23 -75 d -20 -38 d -23 34 d cl s 0.2 0.8 0 c 1046 1686 m -3
- -14 d -5 16 d f 0.4 0.8 0 c 1060 1738 m -14 -52 d -8 2 d -15 58 d f 0.6 0.8 0 c
- 1039 1772 m 24 -21 d -3 -13 d -37 8 d -4 14 d f black 1039 1772 m 24 -21 d -20
- -79 d -24 88 d cl s 0.6 0.8 0 c 1022 1787 m 17 -15 d -20 -12 d -20 42 d f 0.8
- 0.8 0 c 1016 1793 m 6 -6 d -23 15 d -3 6 d f black 1016 1793 m 23 -21 d -20 -12
- d -23 48 d cl s 0.4 0.8 0 c 976 1734 m -4 -12 d 3 9 d f 0.6 0.8 0 c 994 1801 m
- -18 -67 d -1 -3 d 16 50 d f 0.8 0.8 0 c 992 1787 m 24 6 d -20 15 d -2 -7 d -3
- -20 d f black 992 1787 m 24 6 d -20 15 d -24 -86 d cl s 0.4 0.8 0 c 975 1731 m
- -3 -9 d -3 11 d f 0.6 0.8 0 c 969 1740 m 20 39 d 2 2 d -16 -50 d -6 2 d -15 58
- d 2 -7 d f 0.8 0.8 0 c 989 1779 m 3 8 d -1 -6 d -37 10 d -5 19 d 7 -26 d f
- black 969 1740 m 23 47 d -20 -65 d -23 88 d cl s 0 0.8 0.2 c 927 1535 m -2 -27
- d 2 25 d f 0 0.8 0 c 932 1599 m -5 -64 d -2 Y 5 59 d f 0.2 0.8 0 c 937 1662 m
- -5 -63 d -7 Y 5 58 d f 0.4 0.8 0 c 942 1726 m -5 -64 d -12 Y 5 58 d f 0.6 0.8 0
- c 946 1748 m 23 -8 d -13 44 d -9 5 d -5 -63 d -18 Y f 0.8 0.8 0 c 956 1784 m -7
- 26 d -2 -21 d f black 946 1748 m 23 -8 d -20 70 d -24 -302 d cl s 0 0.8 0.2 c
- 927 1533 m -2 -25 d -6 25 d f 0 0.8 0 c 932 1592 m -5 -59 d -8 X -13 59 d f 0.2
- 0.8 0 c 937 1650 m -5 -58 d -26 X -4 18 d 7 38 d f 0.4 0.8 0 c 942 1708 m -5
- -58 d -28 -2 d 10 54 d f 0.6 0.8 0 c 922 1715 m 24 33 d -4 -40 d -23 -6 d f
- black 922 1715 m 24 33 d -21 -240 d -23 102 d cl s 0.2 0.8 0 c 909 1648 m -7
- -38 d -8 41 d f 0.4 0.8 0 c 899 1642 m 18 56 d 2 4 d -10 -54 d -15 3 d -11 60 d
- 2 -7 d f 0.6 0.8 0 c 917 1698 m 5 17 d -3 -13 d -36 9 d -5 27 d 7 -34 d f black
- 899 1642 m 23 73 d -20 -105 d -24 128 d cl s 0.4 0.8 0 c 875 1663 m 24 -21 d
- -14 62 d -23 1 d -7 -13 d f 0.6 0.8 0 c 885 1704 m -7 34 d -16 -33 d f black
- 875 1663 m 24 -21 d -21 96 d -23 -46 d cl s 0.4 0.8 0 c 852 1630 m 23 33 d -20
- 29 d -24 -47 d f black 852 1630 m 23 33 d -20 29 d -24 -47 d cl s 0 0.8 0 c 828
- 1503 m 10 51 d -18 4 d f 0.2 0.8 0 c 838 1554 m 12 65 d -41 9 d 11 -70 d f 0.4
- 0.8 0 c 850 1619 m 2 11 d -21 15 d -23 -6 d 1 -11 d f black 828 1503 m 24 127 d
- -21 15 d -23 -6 d cl s 0 0.8 0 c 807 1546 m 21 -43 d -8 55 d f 0.2 0.8 0 c 805
- 1551 m 2 -5 d 13 12 d -11 70 d -19 -9 d f 0.4 0.8 0 c 809 1628 m -1 11 d -24 8
- d 6 -28 d f black 805 1551 m 23 -48 d -20 136 d -24 8 d cl s 0.2 0.8 0 c 781
- 1585 m 24 -34 d -15 68 d -13 -14 d f 0.4 0.8 0 c 790 1619 m -6 28 d -22 33 d -1
- -1 d 16 -74 d f 0.6 0.8 0 c 762 1680 m -1 1 d -2 Y f black 781 1585 m 24 -34 d
- -21 96 d -23 34 d cl s 0.2 0.8 0 c 758 1566 m 23 19 d -4 20 d -22 -7 d f 0.4
- 0.8 0 c 777 1605 m -16 74 d -12 -14 d 6 -67 d f 0.6 0.8 0 c 761 1679 m 2 Y -12
- 58 d -6 -8 d 6 -66 d f 0.8 0.8 0 c 749 1739 m -12 57 d 6 -65 d f black 758 1566
- m 23 19 d -20 96 d -24 115 d cl s 0.2 0.8 0 c 734 1546 m 24 20 d -3 32 d -38 8
- d -3 -31 d f 0.4 0.8 0 c 755 1598 m -6 67 d -25 5 d -7 -64 d f 0.6 0.8 0 c 749
- 1665 m -6 66 d -12 3 d -7 -64 d f 0.8 0.8 0 c 743 1731 m -6 65 d -6 -62 d f
- black 734 1546 m 24 20 d -21 230 d -23 -221 d cl s 0.2 0.8 0 c 728 1588 m 6 -42
- d -20 29 d -24 -6 d 4 27 d f 0.4 0.8 0 c 719 1648 m 9 -60 d -34 8 d 9 56 d f
- 0.6 0.8 0 c 711 1701 m 8 -53 d -16 4 d f black 711 1701 m 23 -155 d -20 29 d
- -24 -6 d cl s 0.2 0.8 0 c 694 1596 m -4 -27 d -3 30 d f 0.4 0.8 0 c 687 1601 m
- 10 41 d 6 10 d -9 -56 d -7 3 d -6 60 d 2 -16 d f 0.6 0.8 0 c 697 1642 m 14 59 d
- -8 -49 d -22 7 d -6 61 d 1 -10 d 7 -67 d f 0.8 0.8 0 c 675 1720 m -6 60 d 1 -2
- d 6 -68 d f 0.8 0.6 0 c 669 1780 m -2 25 d 3 -27 d f black 687 1601 m 24 100 d
- -21 -132 d -23 236 d cl s 0.2 0.8 0 c 648 1589 m -5 -59 d 18 44 d f 0.4 0.8 0 c
- 664 1582 m 23 19 d -4 42 d -29 9 d -6 -63 d 13 -15 d f 0.6 0.8 0 c 683 1643 m
- -7 67 d -17 6 d -5 -64 d f 0.8 0.8 0 c 676 1710 m -6 68 d -5 1 d -6 -63 d f 0.8
- 0.6 0 c 670 1778 m -3 27 d -2 -26 d f black 664 1582 m 23 19 d -20 204 d -24
- -275 d cl s 0 0 0.8 c 640 945 m 2 62 d -20 16 d -2 -63 d f 0 0.2 0.8 c 642 1007
- m 3 63 d -20 16 d -3 -63 d f 0 0.4 0.8 c 645 1070 m 2 63 d -19 15 d -3 -62 d f
- 0 0.6 0.8 c 647 1133 m 2 62 d -19 16 d -2 -63 d f 0 0.8 0.8 c 649 1195 m 3 63 d
- -19 16 d -3 -63 d f 0 0.8 0.6 c 652 1258 m 2 63 d -19 16 d -2 -63 d f 0 0.8 0.4
- c 654 1321 m 2 63 d -18 16 d -3 -63 d f 0 0.8 0.2 c 656 1384 m 3 62 d -18 16 d
- -3 -62 d f 0 0.8 0 c 659 1446 m 2 63 d -18 16 d -2 -63 d f 0.2 0.8 0 c 661 1509
- m 2 63 d -2 2 d -18 -44 d -5 Y f 0.4 0.8 0 c 663 1572 m 1 10 d -3 -8 d f black
- 640 945 m 24 637 d -21 -52 d -23 -570 d cl s 0 0 0.8 c 617 939 m 23 6 d -20 15
- d -24 -6 d f black 617 939 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 593 933 m
- 24 6 d -21 15 d -23 -6 d f black 593 933 m 24 6 d -21 15 d -23 -6 d cl s 0 0
- 0.8 c 570 927 m 23 6 d -20 15 d -24 -6 d f black 570 927 m 23 6 d -20 15 d -24
- -6 d cl s 0 0 0.8 c 1671 1186 m 23 6 d -20 16 d -24 -6 d f black 1671 1186 m 23
- 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1647 1180 m 24 6 d -21 16 d -23 -6 d f
- black 1647 1180 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1624 1174 m 23 6 d
- -20 16 d -24 -6 d f black 1624 1174 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c
- 1622 1236 m 2 -62 d -21 16 d -3 61 d f 0 0.2 0.8 c 1620 1297 m 2 -61 d -22 15 d
- -2 62 d f 0 0.4 0.8 c 1618 1359 m 2 -62 d -22 16 d -3 61 d f 0 0.6 0.8 c 1616
- 1421 m 2 -62 d -23 15 d -3 61 d f 0 0.8 0.8 c 1614 1482 m 2 -61 d -24 14 d -2
- 62 d f 0 0.8 0.6 c 1612 1544 m 2 -62 d -24 15 d -3 61 d f 0 0.8 0.4 c 1610 1606
- m 2 -62 d -25 14 d -3 62 d f 0 0.8 0.2 c 1609 1667 m 1 -61 d -26 14 d -3 61 d f
- 0 0.8 0 c 1607 1729 m 2 -62 d -28 14 d -1 40 d 2 21 d f 0.2 0.8 0 c 1605 1791 m
- 2 -62 d -25 13 d 5 58 d f 0.4 0.8 0 c 1603 1852 m 2 -61 d -18 9 d 5 58 d f 0.6
- 0.8 0 c 1601 1914 m 2 -62 d -11 6 d 5 58 d f 0.8 0.8 0 c 1600 1947 m 1 -33 d -4
- 2 d f black 1600 1947 m 24 -773 d -21 16 d -23 531 d cl s 0 0.8 0.4 c 1563 1615
- m -7 -48 d 6 42 d f 0 0.8 0.2 c 1573 1679 m -10 -64 d -1 -6 d 7 56 d f 0 0.8 0
- c 1582 1742 m -2 -21 d -7 -42 d -4 -14 d 7 57 d f 0.2 0.8 0 c 1577 1726 m 6 59
- d 4 15 d -5 -58 d -6 -20 d f 0.4 0.8 0 c 1583 1785 m 7 64 d 2 9 d -5 -58 d f
- 0.6 0.8 0 c 1590 1849 m 6 64 d 1 3 d -5 -58 d f 0.8 0.8 0 c 1596 1913 m 4 34 d
- -3 -31 d f black 1577 1726 m 23 221 d -20 -226 d -24 -154 d cl s 0 0.8 0.4 c
- 1562 1609 m -6 -42 d -3 45 d f 0 0.8 0.2 c 1569 1665 m -7 -56 d -9 3 d -4 61 d
- f 0 0.8 0 c 1576 1722 m -7 -57 d -20 8 d -5 61 d f 0.2 0.8 0 c 1572 1782 m 5
- -56 d -1 -4 d -32 12 d -4 61 d f 0.4 0.8 0 c 1567 1843 m 5 -61 d -32 13 d -4 61
- d f 0.6 0.8 0 c 1561 1904 m 6 -61 d -31 13 d -3 41 d 3 18 d f 0.8 0.8 0 c 1556
- 1965 m 5 -61 d -25 11 d 11 54 d f 0.8 0.6 0 c 1553 2003 m 3 -38 d -9 4 d f
- black 1553 2003 m 24 -277 d -21 -159 d -23 330 d cl s 0.6 0.8 0 c 1536 1915 m
- -3 -18 d -5 19 d f 0.8 0.8 0 c 1530 1930 m 10 31 d 7 8 d -11 -54 d -8 1 d -13
- 59 d 4 -9 d f 0.8 0.6 0 c 1540 1961 m 13 42 d -6 -34 d -32 6 d -6 24 d 10 -33 d
- f black 1530 1930 m 23 73 d -20 -106 d -24 102 d cl s 0.2 0.8 0 c 1491 1782 m
- -5 -58 d 6 52 d f 0.4 0.8 0 c 1496 1846 m -5 -64 d 1 -6 d 7 57 d f 0.6 0.8 0 c
- 1502 1910 m -6 -64 d 3 -13 d 6 58 d f 0.8 0.8 0 c 1506 1897 m 24 33 d -11 36 d
- -12 7 d -5 -63 d 3 -19 d f 0.8 0.6 0 c 1519 1966 m -10 33 d -2 -26 d f black
- 1506 1897 m 24 33 d -21 69 d -23 -275 d cl s 0 0.8 0 c 1483 1662 m 3 36 d -5 1
- d f 0.2 0.8 0 c 1486 1698 m 7 64 d -1 14 d -6 -52 d -4 56 d -5 -16 d 4 -65 d f
- 0.4 0.8 0 c 1493 1762 m 6 64 d 7 Y -7 -57 d -10 4 d -5 61 d -3 -13 d 3 -64 d f
- 0.6 0.8 0 c 1499 1826 m 6 64 d 1 Y -6 -58 d -22 8 d -4 61 d -2 -9 d 3 -65 d f
- 0.8 0.8 0 c 1505 1890 m 1 7 d -1 -6 d -32 11 d -4 61 d -2 -5 d 4 -65 d f 0.8
- 0.6 0 c 1469 1963 m -5 61 d -1 Y 3 -65 d f 0.8 0.4 0 c 1464 2024 m -2 30 d 2
- -31 d f black 1483 1662 m 23 235 d -20 -173 d -24 330 d cl s 0 0.8 0 c 1479
- 1696 m 4 -34 d -2 37 d f 0.2 0.8 0 c 1471 1757 m 8 -61 d 2 3 d -4 65 d -38 5 d
- -3 Y 3 Y f 0.4 0.8 0 c 1464 1817 m 7 -60 d 6 7 d -3 64 d -30 5 d -5 -64 d 12 53
- d f 0.6 0.8 0 c 1459 1858 m 5 -41 d 10 11 d -3 65 d -22 3 d -5 -63 d 7 -11 d f
- 0.8 0.8 0 c 1471 1893 m -4 65 d -12 2 d -6 -64 d f 0.8 0.6 0 c 1467 1958 m -3
- 65 d -4 X -5 -63 d f 0.8 0.4 0 c 1464 2023 m -2 31 d -2 -31 d f black 1459 1858
- m 24 -196 d -21 392 d -23 -288 d cl s 0.2 0.8 0 c 1439 1769 m -3 Y -1 3 d f 0.4
- 0.8 0 c 1451 1822 m -12 -53 d -1 X -14 59 d f 0.6 0.8 0 c 1450 1876 m 9 -18 d
- -8 -36 d -27 6 d -9 39 d 8 15 d f 0.8 0.8 0 c 1436 1906 m 14 -30 d -27 6 d f
- black 1436 1906 m 23 -48 d -20 -92 d -24 101 d cl s 0.6 0.8 0 c 1412 1859 m 4 8
- d 7 15 d -8 -15 d -23 -6 d f 0.8 0.8 0 c 1416 1867 m 20 39 d -13 -24 d f black
- 1412 1859 m 24 47 d -21 -39 d -23 -6 d cl s 0.6 0.8 0 c 1410 1865 m 2 -6 d -20
- 2 d -2 20 d f 0.8 0.8 0 c 1389 1921 m 21 -56 d -20 16 d -5 61 d 3 -20 d f 0.8
- 0.6 0 c 1385 1942 m -6 61 d 3 -13 d 6 -68 d f 0.8 0.4 0 c 1379 2003 m -5 60 d 1
- -6 d 7 -67 d f 0.8 0.2 0 c 1374 2063 m -6 61 d 7 -67 d f black 1389 1921 m 23
- -62 d -20 2 d -24 263 d cl s 0.6 0.8 0 c 1365 1794 m 12 63 d -32 13 d -7 Y f
- 0.8 0.8 0 c 1377 1857 m 12 64 d -1 1 d -37 11 d -6 -63 d f 0.8 0.6 0 c 1388
- 1922 m -6 68 d -25 7 d -6 -64 d f 0.8 0.4 0 c 1382 1990 m -7 67 d -12 4 d -6
- -64 d f 0.8 0.2 0 c 1375 2057 m -7 67 d -5 -63 d f black 1365 1794 m 24 127 d
- -21 203 d -23 -261 d cl s 0.4 0.8 0 c 1342 1734 m 22 58 d -30 X f 0.6 0.8 0 c
- 1364 1792 m 1 2 d -20 69 d -6 5 d -15 -7 d 10 -69 d f 0.8 0.8 0 c 1339 1868 m
- -18 16 d 3 -23 d f black 1342 1734 m 23 60 d -20 69 d -24 21 d cl s 0.2 0.8 0 c
- 1318 1701 m 15 21 d -17 -3 d f 0.4 0.8 0 c 1333 1722 m 9 12 d -8 58 d -24 -6 d
- 6 -67 d f 0.6 0.8 0 c 1334 1792 m -10 69 d -20 -8 d 6 -67 d f 0.8 0.8 0 c 1324
- 1861 m -3 23 d -23 34 d 6 -65 d f black 1318 1701 m 24 33 d -21 150 d -23 34 d
- cl s 0 0.8 0 c 1277 1666 m -3 -36 d 5 32 d f 0.2 0.8 0 c 1312 1716 m 6 -15 d -2
- 18 d -34 10 d -5 -63 d 2 -4 d 9 55 d f 0.4 0.8 0 c 1295 1762 m 17 -46 d 4 3 d
- -6 67 d -22 7 d -6 -64 d 6 -12 d f 0.6 0.8 0 c 1310 1786 m -6 67 d -11 3 d -5
- -63 d f 0.8 0.8 0 c 1304 1853 m -6 65 d -5 -62 d f black 1295 1762 m 23 -61 d
- -20 217 d -24 -288 d cl s 0 0.8 0 c 1279 1662 m -5 -32 d -2 35 d f 0.2 0.8 0 c
- 1288 1717 m -9 -55 d -7 3 d -4 61 d f 0.4 0.8 0 c 1291 1773 m 4 -11 d -7 -45 d
- -20 9 d -4 61 d f 0.6 0.8 0 c 1273 1831 m 18 -58 d -27 14 d -5 61 d f 0.8 0.8 0
- c 1271 1837 m 2 -6 d -14 17 d -4 61 d 7 -10 d f 0.8 0.6 0 c 1255 1909 m -4 61 d
- 11 -71 d f 0.8 0.4 0 c 1251 1970 m 3 Y -3 Y f black 1271 1837 m 24 -75 d -21
- -132 d -23 343 d cl s 0.6 0.8 0 c 1248 1804 m 17 25 d -20 -3 d f 0.8 0.8 0 c
- 1265 1829 m 6 8 d -9 62 d -26 -4 d 9 -69 d f 0.8 0.6 0 c 1262 1899 m -11 71 d
- -23 -6 d 8 -69 d f 0.8 0.4 0 c 1251 1970 m 3 Y -24 -6 d 1 -3 d f black 1248
- 1804 m 23 33 d -20 136 d -24 -6 d cl s 0.4 0.8 0 c 1209 1773 m -5 -53 d 9 45 d
- f 0.6 0.8 0 c 1230 1820 m 18 -16 d -3 22 d -30 11 d -6 -64 d 4 -8 d 10 54 d f
- 0.8 0.8 0 c 1224 1825 m 6 -5 d 15 6 d -9 69 d -15 5 d -6 -63 d 8 -18 d f 0.8
- 0.6 0 c 1236 1895 m -8 69 d -1 X -6 -64 d f 0.8 0.4 0 c 1228 1964 m -1 3 d -3 Y
- f black 1224 1825 m 24 -21 d -21 163 d -23 -247 d cl s 0.4 0.8 0 c 1213 1765 m
- -9 -45 d -13 48 d f 0.6 0.8 0 c 1201 1792 m 17 25 d 5 2 d -10 -54 d -22 3 d -11
- 40 d f 0.8 0.8 0 c 1218 1817 m 6 8 d -1 -6 d f black 1201 1792 m 23 33 d -20
- -105 d -24 88 d cl s 0.2 0.8 0 c 1158 1698 m -1 -4 d 5 X f 0.4 0.8 0 c 1177
- 1692 m 13 55 d -19 16 d -13 -65 d 4 -4 d f 0.6 0.8 0 c 1190 1747 m 11 45 d -21
- 16 d -9 -45 d f black 1177 1692 m 24 100 d -21 16 d -23 -114 d cl s 0 0.8 0 c
- 1136 1630 m -3 -9 d 4 6 d f 0.2 0.8 0 c 1154 1659 m 14 21 d -6 14 d -5 X -21
- -64 d 1 -3 d f 0.4 0.8 0 c 1168 1680 m 9 12 d -15 2 d f black 1154 1659 m 23 33
- d -20 2 d -24 -73 d cl s 0 0.8 0 c 1137 1627 m -4 -6 d -1 8 d f 0.2 0.8 0 c
- 1144 1673 m 10 -14 d -17 -32 d -5 2 d -8 60 d f 0.4 0.8 0 c 1130 1694 m 14 -21
- d -20 16 d -8 60 d 5 -9 d f 0.6 0.8 0 c 1116 1749 m -6 41 d 11 -50 d f black
- 1130 1694 m 24 -35 d -21 -38 d -23 169 d cl s 0.2 0.8 0 c 1107 1620 m 15 48 d
- -35 12 d -1 -4 d f 0.4 0.8 0 c 1122 1668 m 8 26 d -9 46 d -20 5 d -14 -65 d f
- 0.6 0.8 0 c 1121 1740 m -11 50 d -9 -45 d f black 1107 1620 m 23 74 d -20 96 d
- -24 -114 d cl s 0.2 0.8 0 c 1103 1663 m 4 -43 d -21 56 d -1 3 d f 0.4 0.8 0 c
- 1098 1724 m 5 -61 d -18 16 d -18 58 d f 0.6 0.8 0 c 1093 1785 m 5 -61 d -31 13
- d -4 14 d 5 43 d f 0.8 0.8 0 c 1089 1846 m 4 -61 d -25 9 d 8 56 d f 0.8 0.6 0 c
- 1084 1907 m 5 -61 d -13 4 d 7 57 d f 0.8 0.4 0 c 1083 1910 m 1 -3 d -1 X f
- black 1083 1910 m 24 -290 d -21 56 d -23 75 d cl s 0 0.8 0 c 1060 1555 m 2 36 d
- -6 2 d f 0.2 0.8 0 c 1062 1591 m 4 63 d -16 6 d 6 -67 d f 0.4 0.8 0 c 1066 1654
- m 5 63 d -27 9 d 6 -66 d f 0.6 0.8 0 c 1071 1717 m 4 63 d -7 14 d -5 -43 d -24
- 21 d 5 -46 d f 0.8 0.8 0 c 1075 1780 m 4 63 d -3 7 d -8 -56 d f 0.8 0.6 0 c
- 1079 1843 m 4 64 d -7 -57 d f 0.8 0.4 0 c 1083 1907 m 3 Y -3 Y f black 1060
- 1555 m 23 355 d -20 -159 d -24 21 d cl s 0 0.8 0 c 1053 1588 m 7 -33 d -4 38 d
- f 0.2 0.8 0 c 1041 1647 m 12 -59 d 3 5 d -6 67 d f 0.4 0.8 0 c 1036 1670 m 5
- -23 d 9 13 d -6 66 d -15 -12 d f 0.6 0.8 0 c 1044 1726 m -5 46 d -17 15 d -5 -2
- d 12 -71 d f 0.8 0.8 0 c 1022 1787 m -6 6 d 1 -8 d f black 1036 1670 m 24 -115
- d -21 217 d -23 21 d cl s 0.4 0.8 0 c 1013 1690 m 23 -20 d -7 44 d -19 -10 d f
- 0.6 0.8 0 c 1029 1714 m -12 71 d -23 -6 d 16 -75 d f 0.8 0.8 0 c 1017 1785 m -1
- 8 d -24 -6 d 2 -8 d f black 1013 1690 m 23 -20 d -20 123 d -24 -6 d cl s 0 0.8
- 0 c 989 1523 m 7 51 d -12 2 d f 0.2 0.8 0 c 996 1574 m 9 64 d -27 5 d 6 -67 d f
- 0.4 0.8 0 c 1005 1638 m 8 52 d -3 14 d -38 6 d 6 -67 d f 0.6 0.8 0 c 1010 1704
- m -16 75 d -5 X -20 -39 d 3 -30 d f 0.8 0.8 0 c 994 1779 m -2 8 d -3 -8 d f
- black 989 1523 m 24 167 d -21 97 d -23 -47 d cl s 0 0.8 0 c 966 1558 m 23 -35 d
- -5 53 d -19 -9 d f 0.2 0.8 0 c 984 1576 m -6 67 d -20 -9 d 7 -67 d f 0.4 0.8 0
- c 978 1643 m -6 67 d -22 -8 d 8 -68 d f 0.6 0.8 0 c 972 1710 m -3 30 d -23 8 d
- 4 -46 d f black 966 1558 m 23 -35 d -20 217 d -23 8 d cl s 0 0.8 0 c 963 1565 m
- 3 -7 d -1 9 d f 0.2 0.8 0 c 945 1623 m 18 -58 d 2 2 d -7 67 d f 0.4 0.8 0 c 942
- 1632 m 3 -9 d 13 11 d -8 68 d -23 -6 d f 0.6 0.8 0 c 950 1702 m -4 46 d -24 -33
- d 5 -19 d f black 942 1632 m 24 -74 d -20 190 d -24 -33 d cl s 0.4 0.8 0 c 919
- 1640 m 23 -8 d -15 64 d -10 2 d -18 -56 d f 0.6 0.8 0 c 927 1696 m -5 19 d -5
- -17 d f black 919 1640 m 23 -8 d -20 83 d -23 -73 d cl s 0.2 0.8 0 c 895 1580 m
- 14 34 d -23 3 d f 0.4 0.8 0 c 909 1614 m 10 26 d -20 2 d -24 21 d 11 -46 d f
- black 895 1580 m 24 60 d -20 2 d -24 21 d cl s 0.2 0.8 0 c 872 1574 m 23 6 d -9
- 37 d -29 -1 d f 0.4 0.8 0 c 886 1617 m -11 46 d -23 -33 d 5 -14 d f black 872
- 1574 m 23 6 d -20 83 d -23 -33 d cl s 0 0.8 0 c 838 1554 m -10 -51 d 6 44 d f
- 0.2 0.8 0 c 864 1602 m 8 -28 d -15 42 d -7 3 d -12 -65 d -4 -7 d 7 57 d f 0.4
- 0.8 0 c 849 1660 m 15 -58 d -7 14 d -5 14 d -2 -11 d -9 -15 d 7 57 d f 0.6 0.8
- 0 c 848 1662 m 1 -2 d -1 1 d f black 848 1662 m 24 -88 d -20 56 d -24 -127 d
- cl s 0 0.8 0 c 834 1547 m -6 -44 d -21 43 d f 0.2 0.8 0 c 841 1604 m -7 -57 d
- -27 -1 d -2 5 d 7 51 d f 0.4 0.8 0 c 848 1661 m -7 -57 d -29 -2 d 8 56 d f 0.6
- 0.8 0 c 825 1696 m 23 -34 d -1 Y -28 -3 d f black 825 1696 m 23 -34 d -20 -159
- d -23 48 d cl s 0.2 0.8 0 c 812 1602 m -7 -51 d -24 34 d 6 12 d f 0.4 0.8 0 c
- 801 1623 m 9 28 d 10 7 d -8 -56 d -25 -5 d f 0.6 0.8 0 c 810 1651 m 15 45 d -5
- -38 d f black 801 1623 m 24 73 d -20 -145 d -24 34 d cl s 0.2 0.8 0 c 778 1537
- m 13 47 d -4 13 d -6 -12 d -23 -19 d f 0.4 0.8 0 c 791 1584 m 10 39 d -14 -26 d
- f black 778 1537 m 23 86 d -20 -38 d -23 -19 d cl s 0 0.8 0.2 c 754 1410 m 8 42
- d -14 3 d f 0 0.8 0 c 762 1452 m 12 65 d -37 8 d 11 -70 d f 0.2 0.8 0 c 774
- 1517 m 4 20 d -20 29 d -24 -20 d 3 -21 d f black 754 1410 m 24 127 d -20 29 d
- -24 -20 d cl s 0 0.8 0.2 c 751 1449 m 3 -39 d -6 45 d f 0 0.8 0 c 745 1510 m 6
- -61 d -3 6 d -11 70 d f 0.2 0.8 0 c 738 1570 m 7 -60 d -8 15 d -3 21 d -6 42 d
- f 0.4 0.8 0 c 732 1631 m 6 -61 d -10 18 d -9 60 d f 0.6 0.8 0 c 731 1646 m 1
- -15 d -13 17 d -8 53 d f black 731 1646 m 23 -236 d -20 136 d -23 155 d cl s 0
- 0.8 0 c 707 1478 m 4 23 d -8 2 d f 0.2 0.8 0 c 711 1501 m 9 64 d -28 9 d 11 -71
- d f 0.4 0.8 0 c 720 1565 m 9 65 d -32 12 d -10 -41 d 5 -27 d f 0.6 0.8 0 c 729
- 1630 m 2 16 d -20 55 d -14 -59 d f black 707 1478 m 24 168 d -20 55 d -24 -100
- d cl s 0 0.8 0 c 704 1499 m 3 -21 d -4 25 d f 0.2 0.8 0 c 694 1559 m 10 -60 d
- -1 4 d -11 71 d f 0.4 0.8 0 c 684 1619 m 10 -60 d -2 15 d -5 27 d -23 -19 d 19
- 37 d f 0.6 0.8 0 c 684 1620 m -1 Y -1 X f black 684 1620 m 23 -142 d -20 123 d
- -23 -19 d cl s 0 0 0.8 c 660 929 m 3 63 d -21 15 d -2 -62 d f 0 0.2 0.8 c 663
- 992 m 2 62 d -20 16 d -3 -63 d f 0 0.4 0.8 c 665 1054 m 2 63 d -20 16 d -2 -63
- d f 0 0.6 0.8 c 667 1117 m 2 63 d -20 15 d -2 -62 d f 0 0.8 0.8 c 669 1180 m 2
- 62 d -19 16 d -3 -63 d f 0 0.8 0.6 c 671 1242 m 2 63 d -19 16 d -2 -63 d f 0
- 0.8 0.4 c 673 1305 m 2 63 d -19 16 d -2 -63 d f 0 0.8 0.2 c 675 1368 m 3 62 d
- -19 16 d -3 -62 d f 0 0.8 0 c 678 1430 m 2 63 d -19 16 d -2 -63 d f 0.2 0.8 0 c
- 680 1493 m 2 63 d -19 16 d -2 -63 d f 0.4 0.8 0 c 682 1556 m 2 63 d -1 X -19
- -37 d -1 -10 d f 0.6 0.8 0 c 684 1619 m 1 Y -1 -1 d f black 660 929 m 24 691 d
- -20 -38 d -24 -637 d cl s 0 0 0.8 c 637 923 m 23 6 d -20 16 d -23 -6 d f black
- 637 923 m 23 6 d -20 16 d -23 -6 d cl s 0 0 0.8 c 614 917 m 23 6 d -20 16 d -24
- -6 d f black 614 917 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 590 911 m 24 6 d
- -21 16 d -23 -6 d f black 590 911 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c
- 1691 1171 m 23 6 d -20 15 d -23 -6 d f black 1691 1171 m 23 6 d -20 15 d -23 -6
- d cl s 0 0 0.8 c 1667 1165 m 24 6 d -20 15 d -24 -6 d f black 1667 1165 m 24 6
- d -20 15 d -24 -6 d cl s 0 0 0.8 c 1644 1159 m 23 6 d -20 15 d -23 -6 d f black
- 1644 1159 m 23 6 d -20 15 d -23 -6 d cl s 0 0 0.8 c 1641 1220 m 3 -61 d -20 15
- d -2 62 d f 0 0.2 0.8 c 1637 1281 m 4 -61 d -19 16 d -2 61 d f 0 0.4 0.8 c 1634
- 1343 m 3 -62 d -17 16 d -2 62 d f 0 0.6 0.8 c 1631 1404 m 3 -61 d -16 16 d -2
- 62 d f 0 0.8 0.8 c 1627 1465 m 4 -61 d -15 17 d -2 61 d f 0 0.8 0.6 c 1624 1526
- m 3 -61 d -13 17 d -2 62 d f 0 0.8 0.4 c 1621 1588 m 3 -62 d -12 18 d -2 62 d f
- 0 0.8 0.2 c 1620 1596 m 1 -8 d -11 18 d -1 61 d 8 -15 d f 0 0.8 0 c 1609 1667 m
- -2 62 d 6 -12 d 4 -65 d f 0.2 0.8 0 c 1607 1729 m -2 62 d 5 -9 d 3 -65 d f 0.4
- 0.8 0 c 1605 1791 m -2 61 d 3 -5 d 4 -65 d f 0.6 0.8 0 c 1603 1852 m -2 62 d 1
- -2 d 4 -65 d f 0.8 0.8 0 c 1601 1914 m -1 33 d 2 -35 d f black 1620 1596 m 24
- -437 d -20 15 d -24 773 d cl s 0 0.8 0.2 c 1597 1617 m 23 -21 d -3 56 d -26 -4
- d f 0 0.8 0 c 1617 1652 m -4 65 d -35 4 d 13 -73 d f 0.2 0.8 0 c 1613 1717 m -3
- 65 d -27 3 d -6 -59 d 1 -5 d f 0.4 0.8 0 c 1610 1782 m -4 65 d -16 2 d -7 -64 d
- f 0.6 0.8 0 c 1606 1847 m -4 65 d -6 1 d -6 -64 d f 0.8 0.8 0 c 1602 1912 m -2
- 35 d -4 -34 d f black 1597 1617 m 23 -21 d -20 351 d -23 -221 d cl s 0 0.8 0.2
- c 1588 1641 m 9 -24 d -6 31 d f 0 0.8 0 c 1573 1678 m 15 -37 d 3 7 d -13 73 d
- -6 -20 d f 0.2 0.8 0 c 1578 1721 m -1 5 d -5 56 d -4 -16 d 4 -65 d f 0.4 0.8 0
- c 1572 1782 m -5 61 d -3 -11 d 4 -66 d f 0.6 0.8 0 c 1567 1843 m -6 61 d -1 -7
- d 4 -65 d f 0.8 0.8 0 c 1561 1904 m -5 61 d -3 Y 4 -65 d f 0.8 0.6 0 c 1556
- 1965 m -3 38 d 3 -41 d f black 1573 1678 m 24 -61 d -20 109 d -24 277 d cl s 0
- 0.8 0 c 1569 1699 m 4 -21 d -1 23 d f 0.2 0.8 0 c 1557 1758 m 12 -59 d 3 2 d -4
- 65 d f 0.4 0.8 0 c 1550 1793 m 7 -35 d 11 8 d -4 66 d -18 -11 d f 0.6 0.8 0 c
- 1564 1832 m -4 65 d -25 -5 d 11 -71 d f 0.8 0.8 0 c 1560 1897 m -4 65 d -16 -1
- d -10 -31 d 5 -38 d f 0.8 0.6 0 c 1556 1962 m -3 41 d -13 -42 d f black 1550
- 1793 m 23 -115 d -20 325 d -23 -73 d cl s 0.2 0.8 0 c 1526 1706 m 13 47 d -18 1
- d f 0.4 0.8 0 c 1539 1753 m 11 40 d -4 28 d -32 1 d 7 -68 d f 0.6 0.8 0 c 1546
- 1821 m -11 71 d -28 -3 d 7 -67 d f 0.8 0.8 0 c 1535 1892 m -5 38 d -24 -33 d 1
- -8 d f black 1526 1706 m 24 87 d -20 137 d -24 -33 d cl s 0 0.8 0 c 1503 1674 m
- 7 10 d -24 14 d -3 -36 d f 0.2 0.8 0 c 1510 1684 m 16 22 d -5 48 d -28 8 d -7
- -64 d f 0.4 0.8 0 c 1521 1754 m -7 68 d -15 4 d -6 -64 d f 0.6 0.8 0 c 1514
- 1822 m -7 67 d -2 1 d -6 -64 d f 0.8 0.8 0 c 1507 1889 m -1 8 d -1 -7 d f black
- 1503 1674 m 23 32 d -20 191 d -23 -235 d cl s 0 0.8 0.2 c 1479 1587 m 8 29 d
- -10 X f 0 0.8 0 c 1487 1616 m 16 58 d -20 -12 d -4 34 d -7 -15 d 5 -65 d f 0.2
- 0.8 0 c 1479 1696 m -8 61 d -4 -10 d 5 -66 d f 0.4 0.8 0 c 1471 1757 m -7 60 d
- -2 -4 d 5 -66 d f 0.6 0.8 0 c 1464 1817 m -5 41 d 3 -45 d f black 1479 1587 m
- 24 87 d -20 -12 d -24 196 d cl s 0 0.8 0.4 c 1456 1527 m 8 21 d -9 -1 d f 0 0.8
- 0.2 c 1464 1548 m 15 39 d -2 29 d -26 -5 d 4 -64 d f 0 0.8 0 c 1477 1616 m -5
- 65 d -24 -5 d 3 -65 d f 0.2 0.8 0 c 1472 1681 m -5 66 d -23 -6 d 4 -65 d f 0.4
- 0.8 0 c 1467 1747 m -5 66 d -21 -7 d 3 -65 d f 0.6 0.8 0 c 1462 1813 m -3 45 d
- -9 18 d -12 -5 d 3 -65 d f 0.8 0.8 0 c 1450 1876 m -14 30 d 2 -35 d f black
- 1456 1527 m 23 60 d -20 271 d -23 48 d cl s 0 0.8 0.4 c 1453 1545 m 3 -18 d -1
- 20 d f 0 0.8 0.2 c 1443 1605 m 10 -60 d 2 2 d -4 64 d f 0 0.8 0 c 1433 1664 m
- 10 -59 d 8 6 d -3 65 d f 0.2 0.8 0 c 1432 1669 m 1 -5 d 15 12 d -4 65 d -18 -10
- d f 0.4 0.8 0 c 1444 1741 m -3 65 d -22 -7 d 7 -68 d f 0.6 0.8 0 c 1441 1806 m
- -3 65 d -22 -4 d -4 -8 d 7 -60 d f 0.8 0.8 0 c 1438 1871 m -2 35 d -20 -39 d f
- black 1432 1669 m 24 -142 d -20 379 d -24 -47 d cl s 0.2 0.8 0 c 1409 1717 m 23
- -48 d -6 62 d -17 -10 d f 0.4 0.8 0 c 1426 1731 m -7 68 d -17 -11 d 7 -67 d f
- 0.6 0.8 0 c 1419 1799 m -7 60 d -2 6 d -15 -10 d 7 -67 d f 0.8 0.8 0 c 1410
- 1865 m -21 56 d 6 -66 d f black 1409 1717 m 23 -48 d -20 190 d -23 62 d cl s 0
- 0.8 0.2 c 1386 1563 m 4 28 d -7 1 d f 0 0.8 0 c 1390 1591 m 10 65 d -23 3 d 6
- -67 d f 0.2 0.8 0 c 1400 1656 m 9 61 d 4 Y -38 4 d 6 -66 d f 0.4 0.8 0 c 1409
- 1721 m -7 67 d -37 4 d 6 -67 d f 0.6 0.8 0 c 1402 1788 m -7 67 d -18 2 d -12
- -63 d -2 Y f 0.8 0.8 0 c 1395 1855 m -6 66 d -12 -64 d f black 1386 1563 m 23
- 154 d -20 204 d -24 -127 d cl s 0 0.8 0.2 c 1381 1589 m 5 -26 d -3 29 d f 0 0.8
- 0 c 1371 1649 m 10 -60 d 2 3 d -6 67 d f 0.2 0.8 0 c 1362 1705 m 9 -56 d 6 10 d
- -6 66 d -14 -13 d f 0.4 0.8 0 c 1371 1725 m -6 67 d -1 X -22 -58 d 15 -22 d f
- 0.6 0.8 0 c 1365 1792 m 2 Y -1 -2 d f black 1362 1705 m 24 -142 d -21 231 d -23
- -60 d cl s 0.2 0.8 0 c 1361 1708 m 1 -3 d -5 7 d -24 10 d -15 -21 d 4 14 d f
- 0.4 0.8 0 c 1343 1766 m 18 -58 d -4 4 d -15 22 d -9 -12 d -11 -7 d 13 52 d f
- 0.6 0.8 0 c 1339 1780 m 4 -14 d -8 1 d f black 1339 1780 m 23 -75 d -20 29 d
- -24 -33 d cl s 0 0.8 0.2 c 1315 1559 m 2 13 d -3 1 d f 0 0.8 0 c 1317 1572 m 6
- 64 d -16 4 d 7 -67 d f 0.2 0.8 0 c 1323 1636 m 7 64 d -8 15 d -4 -14 d -6 15 d
- -12 -8 d 7 -68 d f 0.4 0.8 0 c 1330 1700 m 7 64 d -2 3 d -13 -52 d -10 1 d -17
- 46 d 5 -54 d f 0.6 0.8 0 c 1337 1764 m 2 16 d -4 -13 d f black 1315 1559 m 24
- 221 d -21 -79 d -23 61 d cl s 0 0.8 0.2 c 1310 1571 m 5 -12 d -1 14 d f 0 0.8 0
- c 1292 1620 m 18 -49 d 4 2 d -7 67 d -16 -11 d f 0.2 0.8 0 c 1307 1640 m -7 68
- d -16 -12 d 7 -67 d f 0.4 0.8 0 c 1300 1708 m -5 54 d -4 11 d -13 -10 d 6 -67 d
- f 0.6 0.8 0 c 1291 1773 m -18 58 d -1 -1 d 6 -67 d f 0.8 0.8 0 c 1273 1831 m -2
- 6 d 1 -7 d f black 1292 1620 m 23 -61 d -20 203 d -24 75 d cl s 0 0.8 0 c 1268
- 1560 m 24 60 d -1 9 d -28 -3 d f 0.2 0.8 0 c 1291 1629 m -7 67 d -27 -3 d 6 -67
- d f 0.4 0.8 0 c 1284 1696 m -6 67 d -27 -4 d 6 -66 d f 0.6 0.8 0 c 1278 1763 m
- -6 67 d -7 -1 d -17 -25 d 3 -45 d f 0.8 0.8 0 c 1272 1830 m -1 7 d -6 -8 d f
- black 1268 1560 m 24 60 d -21 217 d -23 -33 d cl s 0 0.8 0 c 1245 1608 m 23 -48
- d -5 66 d -19 -9 d f 0.2 0.8 0 c 1263 1626 m -6 67 d -20 -9 d 7 -67 d f 0.4 0.8
- 0 c 1257 1693 m -6 66 d -20 -8 d 6 -67 d f 0.6 0.8 0 c 1251 1759 m -3 45 d -18
- 16 d -5 -2 d 6 -67 d f 0.8 0.8 0 c 1230 1820 m -6 5 d 1 -7 d f black 1245 1608
- m 23 -48 d -20 244 d -24 21 d cl s 0 0.8 0.4 c 1221 1467 m 3 20 d -4 X f 0 0.8
- 0.2 c 1224 1487 m 11 65 d -19 X 4 -65 d f 0 0.8 0 c 1235 1552 m 10 56 d -1 9 d
- -32 X 4 -65 d f 0.2 0.8 0 c 1244 1617 m -7 67 d -29 -1 d 4 -66 d f 0.4 0.8 0 c
- 1237 1684 m -6 67 d -27 -3 d 4 -65 d f 0.6 0.8 0 c 1231 1751 m -6 67 d -7 -1 d
- -17 -25 d 3 -44 d f 0.8 0.8 0 c 1225 1818 m -1 7 d -6 -8 d f black 1221 1467 m
- 24 141 d -21 217 d -23 -33 d cl s 0 0.8 0.4 c 1220 1486 m 1 -19 d -1 20 d f 0
- 0.8 0.2 c 1216 1547 m 4 -61 d 1 Y -4 65 d f 0 0.8 0 c 1212 1608 m 4 -61 d 5 Y
- -4 65 d f 0.2 0.8 0 c 1209 1669 m 3 -61 d 9 Y -4 66 d f 0.4 0.8 0 c 1205 1730 m
- 4 -61 d -1 14 d -4 65 d -14 -1 d -13 -55 d 6 47 d f 0.6 0.8 0 c 1201 1792 m 4
- -62 d -1 18 d -3 44 d -11 -45 d -7 -8 d 8 57 d f 0.8 0.8 0 c 1198 1851 m 3 -59
- d -10 4 d f black 1198 1851 m 23 -384 d -20 325 d -24 -100 d cl s 0.2 0.8 0 c
- 1174 1603 m 6 59 d -12 18 d -14 -21 d f 0.4 0.8 0 c 1180 1662 m 6 64 d -3 13 d
- -6 -47 d -9 -12 d f 0.6 0.8 0 c 1186 1726 m 6 63 d -1 7 d -8 -57 d f 0.8 0.8 0
- c 1192 1789 m 6 62 d -7 -55 d f black 1174 1603 m 24 248 d -21 -159 d -23 -33 d
- cl s 0.2 0.8 0 c 1151 1638 m 23 -35 d -20 56 d -10 14 d -2 -12 d f 0.4 0.8 0 c
- 1144 1673 m -14 21 d 12 -33 d f black 1151 1638 m 23 -35 d -20 56 d -24 35 d
- cl s 0.2 0.8 0 c 1127 1618 m 24 20 d -9 23 d -20 7 d -15 -48 d f 0.4 0.8 0 c
- 1142 1661 m -12 33 d -8 -26 d f black 1127 1618 m 24 20 d -21 56 d -23 -74 d
- cl s 0 0.8 0 c 1104 1545 m 12 38 d -14 -1 d f 0.2 0.8 0 c 1116 1583 m 11 35 d
- -20 2 d -4 43 d -5 -16 d 4 -65 d f 0.4 0.8 0 c 1103 1663 m -5 61 d -4 -12 d 4
- -65 d f 0.6 0.8 0 c 1098 1724 m -5 61 d -2 -8 d 3 -65 d f 0.8 0.8 0 c 1093 1785
- m -4 61 d -2 -4 d 4 -65 d f 0.8 0.6 0 c 1089 1846 m -5 61 d -1 -1 d 4 -64 d f
- 0.8 0.4 0 c 1084 1907 m -1 3 d -4 Y f black 1104 1545 m 23 73 d -20 2 d -24 290
- d cl s 0 0.8 0 c 1083 1575 m 21 -30 d -2 37 d -40 9 d -2 -36 d 18 21 d f 0.2
- 0.8 0 c 1080 1579 m 3 -4 d 19 7 d -4 65 d -32 7 d -4 -63 d 16 -15 d f 0.4 0.8 0
- c 1098 1647 m -4 65 d -23 5 d -5 -63 d f 0.6 0.8 0 c 1094 1712 m -3 65 d -16 3
- d -4 -63 d f 0.8 0.8 0 c 1091 1777 m -4 65 d -8 1 d -4 -63 d f 0.8 0.6 0 c 1087
- 1842 m -4 64 d 1 Y -4 -64 d f 0.8 0.4 0 c 1083 1906 m 4 Y -3 Y f black 1080
- 1579 m 24 -34 d -21 365 d -23 -355 d cl s 0 0.8 0 c 1078 1576 m -18 -21 d -7 33
- d f 0.2 0.8 0 c 1057 1587 m 23 -8 d -2 -3 d -25 12 d -12 59 d 2 -6 d f 0.4 0.8
- 0 c 1041 1647 m -5 23 d 7 -29 d f black 1057 1587 m 23 -8 d -20 -24 d -24 115 d
- cl s 0.2 0.8 0 c 1052 1629 m 5 -42 d -14 54 d f 0.4 0.8 0 c 1045 1690 m 7 -61 d
- -9 12 d -7 29 d -23 20 d 2 11 d f 0.6 0.8 0 c 1038 1750 m 7 -60 d -30 11 d 10
- 54 d f 0.8 0.8 0 c 1033 1796 m 5 -46 d -13 5 d f black 1033 1796 m 24 -209 d
- -21 83 d -23 20 d cl s 0 0.8 0 c 996 1574 m -7 -51 d 10 42 d f 0.2 0.8 0 c 1010
- 1615 m 4 Y -5 19 d -9 -64 d 3 -9 d f 0.4 0.8 0 c 1010 1619 m 8 64 d -3 18 d -2
- -11 d -8 -52 d f 0.6 0.8 0 c 1018 1683 m 9 64 d -2 8 d -10 -54 d f 0.8 0.8 0 c
- 1027 1747 m 6 49 d -8 -41 d f black 1010 1615 m 23 181 d -20 -106 d -24 -167 d
- cl s 0 0.8 0 c 999 1565 m -10 -42 d -23 35 d 1 7 d f 0.2 0.8 0 c 1009 1618 m 1
- -3 d -11 -50 d -32 X 6 57 d f 0.4 0.8 0 c 997 1677 m 12 -59 d -36 4 d 7 57 d f
- 0.6 0.8 0 c 986 1730 m 11 -53 d -17 2 d f black 986 1730 m 24 -115 d -21 -92 d
- -23 35 d cl s 0 0.8 0 c 967 1565 m -1 -7 d -3 7 d f 0.2 0.8 0 c 973 1622 m -6
- -57 d -4 X -18 58 d f 0.4 0.8 0 c 963 1644 m 7 27 d 10 8 d -7 -57 d -28 1 d -3
- 9 d f 0.6 0.8 0 c 970 1671 m 16 59 d -6 -51 d f black 963 1644 m 23 86 d -20
- -172 d -24 74 d cl s 0.4 0.8 0 c 939 1611 m 24 33 d -21 -12 d -23 8 d f black
- 939 1611 m 24 33 d -21 -12 d -23 8 d cl s 0.2 0.8 0 c 909 1614 m -14 -34 d 6 26
- d f 0.4 0.8 0 c 921 1658 m 18 -47 d -20 29 d -10 -26 d -8 -8 d 12 53 d f 0.6
- 0.8 0 c 916 1672 m 5 -14 d -8 1 d f black 916 1672 m 23 -61 d -20 29 d -24 -60
- d cl s 0.2 0.8 0 c 892 1532 m 10 59 d -1 15 d -6 -26 d -23 -6 d f 0.4 0.8 0 c
- 902 1591 m 11 65 d 3 Y -12 -53 d f 0.6 0.8 0 c 913 1656 m 3 16 d -3 -13 d f
- black 892 1532 m 24 140 d -21 -92 d -23 -6 d cl s 0.2 0.8 0 c 869 1579 m 23 -47
- d -20 42 d -8 28 d 4 -19 d f 0.4 0.8 0 c 864 1602 m -15 58 d 19 -77 d f 0.6 0.8
- 0 c 849 1660 m -1 2 d 1 -2 d f black 869 1579 m 23 -47 d -20 42 d -24 88 d cl s
- 0.2 0.8 0 c 845 1560 m 24 19 d -1 4 d -26 -4 d f 0.4 0.8 0 c 868 1583 m -19 77
- d -17 -11 d 10 -70 d f 0.6 0.8 0 c 849 1660 m -1 2 d -23 34 d 7 -47 d f black
- 845 1560 m 24 19 d -21 83 d -23 34 d cl s 0.2 0.8 0 c 822 1541 m 23 19 d -3 19
- d -29 -1 d f 0.4 0.8 0 c 842 1579 m -10 70 d -22 2 d -9 -28 d 12 -45 d f 0.6
- 0.8 0 c 832 1649 m -7 47 d -15 -45 d f black 822 1541 m 23 19 d -20 136 d -24
- -73 d cl s 0 0.8 0.2 c 798 1400 m 7 42 d -13 4 d f 0 0.8 0 c 805 1442 m 11 65 d
- -35 9 d 11 -70 d f 0.2 0.8 0 c 816 1507 m 6 34 d -9 37 d -22 6 d -13 -47 d 3
- -21 d f 0.4 0.8 0 c 813 1578 m -12 45 d -10 -39 d f black 798 1400 m 24 141 d
- -21 82 d -23 -86 d cl s 0 0.8 0.2 c 795 1440 m 3 -40 d -6 46 d -30 6 d -8 -42 d
- 3 38 d f 0 0.8 0 c 790 1501 m 5 -61 d -3 6 d -11 70 d -7 1 d -12 -65 d -5 -4 d
- 4 59 d f 0.2 0.8 0 c 786 1562 m 4 -61 d -9 15 d -3 21 d -4 -20 d -13 -10 d 4 59
- d f 0.4 0.8 0 c 781 1623 m 5 -61 d -21 4 d 4 59 d f 0.6 0.8 0 c 776 1683 m 5
- -60 d -12 2 d 4 59 d f 0.8 0.8 0 c 775 1703 m 1 -20 d -3 1 d f black 775 1703 m
- 23 -303 d -20 137 d -24 -127 d cl s 0 0.8 0.2 c 757 1448 m -3 -38 d -3 39 d f 0
- 0.8 0 c 761 1507 m -4 -59 d -6 1 d -6 61 d f 0.2 0.8 0 c 765 1566 m -4 -59 d
- -16 3 d -7 60 d f 0.4 0.8 0 c 769 1625 m -4 -59 d -27 4 d -6 61 d f 0.6 0.8 0 c
- 751 1617 m 18 65 d 4 2 d -4 -59 d -37 6 d -1 15 d f 0.8 0.8 0 c 769 1682 m 6 21
- d -2 -19 d f black 751 1617 m 24 86 d -21 -293 d -23 236 d cl s 0 0.8 0 c 711
- 1501 m -4 -23 d 9 16 d f 0.2 0.8 0 c 728 1517 m 7 32 d -15 16 d -9 -64 d 5 -7 d
- f 0.4 0.8 0 c 735 1549 m 16 66 d -22 15 d -9 -65 d f 0.6 0.8 0 c 751 1615 m 2 Y
- -20 29 d -2 -16 d f black 728 1517 m 23 100 d -20 29 d -24 -168 d cl s 0 0.8 0
- c 704 1470 m 5 10 d 7 14 d -9 -16 d -3 21 d -1 -19 d f 0.2 0.8 0 c 709 1480 m
- 19 37 d -12 -23 d -12 5 d -10 60 d -10 Y 9 -69 d f 0.4 0.8 0 c 694 1559 m -10
- 60 d -1 Y 10 -69 d f 0.6 0.8 0 c 684 1619 m 1 Y -2 Y f black 704 1470 m 24 47 d
- -21 -39 d -23 142 d cl s 0 0 0.8 c 681 913 m 2 63 d -20 16 d -3 -63 d f 0 0.2
- 0.8 c 683 976 m 3 63 d -21 15 d -2 -62 d f 0 0.4 0.8 c 686 1039 m 3 63 d -22 15
- d -2 -63 d f 0 0.6 0.8 c 689 1102 m 2 63 d -22 15 d -2 -63 d f 0 0.8 0.8 c 691
- 1165 m 3 63 d -23 14 d -2 -62 d f 0 0.8 0.6 c 694 1228 m 3 62 d -24 15 d -2 -63
- d f 0 0.8 0.4 c 697 1290 m 2 63 d -24 15 d -2 -63 d f 0 0.8 0.2 c 699 1353 m 3
- 63 d -24 14 d -3 -62 d f 0 0.8 0 c 702 1416 m 2 54 d -1 10 d -23 13 d -2 -63 d
- f 0.2 0.8 0 c 703 1480 m -9 69 d -12 7 d -2 -63 d f 0.4 0.8 0 c 694 1549 m -10
- 69 d 1 Y -2 -63 d f 0.6 0.8 0 c 684 1618 m 2 Y -1 Y f black 681 913 m 23 557 d
- -20 150 d -24 -691 d cl s 0 0 0.8 c 657 907 m 24 6 d -21 16 d -23 -6 d f black
- 657 907 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 634 901 m 23 6 d -20 16 d -23
- -6 d f black 634 901 m 23 6 d -20 16 d -23 -6 d cl s 0 0 0.8 c 610 896 m 24 5 d
- -20 16 d -24 -6 d f black 610 896 m 24 5 d -20 16 d -24 -6 d cl s 0 0 0.8 c
- 1711 1155 m 24 6 d -21 16 d -23 -6 d f black 1711 1155 m 24 6 d -21 16 d -23 -6
- d cl s 0 0 0.8 c 1688 1149 m 23 6 d -20 16 d -24 -6 d f black 1688 1149 m 23 6
- d -20 16 d -24 -6 d cl s 0 0 0.8 c 1664 1143 m 24 6 d -21 16 d -23 -6 d f black
- 1664 1143 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1662 1205 m 2 -62 d -20 16
- d -3 61 d f 0 0.2 0.8 c 1660 1266 m 2 -61 d -21 15 d -4 61 d f 0 0.4 0.8 c 1657
- 1328 m 3 -62 d -23 15 d -3 62 d f 0 0.6 0.8 c 1655 1389 m 2 -61 d -23 15 d -3
- 61 d f 0 0.8 0.8 c 1653 1451 m 2 -62 d -24 15 d -4 61 d f 0 0.8 0.6 c 1650 1512
- m 3 -61 d -26 14 d -3 61 d f 0 0.8 0.4 c 1648 1574 m 2 -62 d -26 14 d -3 62 d f
- 0 0.8 0.2 c 1646 1636 m 2 -62 d -27 14 d -1 8 d 6 49 d f 0 0.8 0 c 1643 1697 m
- 3 -61 d -20 9 d 7 57 d f 0.2 0.8 0 c 1641 1759 m 2 -62 d -10 5 d 7 57 d f 0.4
- 0.8 0 c 1641 1769 m -10 Y -1 X f black 1641 1769 m 23 -626 d -20 16 d -24 437 d
- cl s 0 0.8 0.2 c 1626 1645 m -6 -49 d -23 21 d 7 22 d f 0 0.8 0 c 1617 1682 m 3
- 9 d 13 11 d -7 -57 d -22 -6 d f 0.2 0.8 0 c 1620 1691 m 18 67 d 2 1 d -7 -57 d
- f 0.4 0.8 0 c 1638 1758 m 3 11 d -1 -10 d f black 1617 1682 m 24 87 d -21 -173
- d -23 21 d cl s 0 0.8 0.4 c 1594 1555 m 1 5 d -2 1 d f 0 0.8 0.2 c 1595 1560 m
- 12 66 d -3 13 d -7 -22 d -9 24 d -7 -9 d 12 -71 d f 0 0.8 0 c 1607 1626 m 10 56
- d -13 -43 d -16 2 d -15 37 d 8 -46 d f black 1594 1555 m 23 127 d -20 -65 d -24
- 61 d cl s 0 0.8 0.4 c 1593 1560 m 1 -5 d -1 6 d f 0 0.8 0.2 c 1577 1618 m 16
- -58 d 1 Y -12 71 d f 0 0.8 0 c 1570 1643 m 7 -25 d 4 14 d -8 46 d -4 21 d -4
- -16 d f 0.2 0.8 0 c 1569 1699 m -12 59 d -1 -6 d 9 -69 d f 0.4 0.8 0 c 1557
- 1758 m -7 35 d 6 -41 d f black 1570 1643 m 24 -88 d -21 123 d -23 115 d cl s 0
- 0.8 0 c 1565 1677 m 5 -34 d -5 40 d f 0.2 0.8 0 c 1555 1737 m 10 -60 d 6 Y -9
- 69 d -17 1 d -13 -47 d 10 37 d f 0.4 0.8 0 c 1547 1785 m 8 -48 d 1 15 d -6 41 d
- -11 -40 d -3 -10 d f black 1547 1785 m 23 -142 d -20 150 d -24 -87 d cl s 0 0.8
- 0 c 1523 1658 m 2 9 d -15 17 d -7 -10 d f 0.2 0.8 0 c 1525 1667 m 12 65 d -1 11
- d -10 -37 d -16 -22 d f 0.4 0.8 0 c 1537 1732 m 10 53 d -11 -42 d f black 1523
- 1658 m 24 127 d -21 -79 d -23 -32 d cl s 0 0.8 0.6 c 1500 1464 m 1 10 d -3 2 d
- f 0 0.8 0.4 c 1501 1474 m 8 65 d -23 8 d 12 -71 d f 0 0.8 0.2 c 1509 1539 m 8
- 64 d -30 13 d -8 -29 d 7 -40 d f 0 0.8 0 c 1517 1603 m 6 55 d -20 16 d -16 -58
- d f black 1500 1464 m 23 194 d -20 16 d -24 -87 d cl s 0 0.8 0.6 c 1498 1474 m
- 2 -10 d -2 12 d f 0 0.8 0.4 c 1490 1534 m 8 -60 d 2 Y -12 71 d -22 1 d -8 -21 d
- 3 16 d f 0 0.8 0.2 c 1482 1594 m 8 -60 d -4 13 d -7 40 d -15 -39 d -5 -5 d 11
- 55 d f 0 0.8 0 c 1476 1633 m 6 -39 d -12 4 d f black 1476 1633 m 24 -169 d -21
- 123 d -23 -60 d cl s 0 0.8 0.4 c 1459 1543 m -3 -16 d -3 18 d f 0 0.8 0.2 c
- 1470 1598 m -11 -55 d -6 2 d -10 60 d f 0 0.8 0 c 1469 1653 m 7 -20 d -6 -35 d
- -27 7 d -10 59 d f 0.2 0.8 0 c 1453 1694 m 16 -41 d -36 11 d -1 5 d f black
- 1453 1694 m 23 -61 d -20 -106 d -24 142 d cl s 0 0.8 0.2 c 1429 1554 m 5 28 d
- -8 1 d f 0 0.8 0 c 1434 1582 m 11 65 d -28 5 d 9 -69 d f 0.2 0.8 0 c 1445 1647
- m 8 47 d -21 -25 d -23 48 d 8 -65 d f black 1429 1554 m 24 140 d -21 -25 d -23
- 48 d cl s 0 0.8 0.4 c 1406 1507 m 3 6 d -6 1 d f 0 0.8 0.2 c 1409 1513 m 20 41
- d -3 29 d -36 8 d -4 -28 d 17 -49 d f 0 0.8 0 c 1426 1583 m -9 69 d -17 4 d -10
- -65 d f 0.2 0.8 0 c 1417 1652 m -8 65 d -9 -61 d f black 1406 1507 m 23 47 d
- -20 163 d -23 -154 d cl s 0 0.8 0.4 c 1401 1511 m 5 -4 d -3 7 d f 0 0.8 0.2 c
- 1382 1528 m 19 -17 d 2 3 d -17 49 d -5 26 d -4 -17 d f 0 0.8 0 c 1381 1589 m
- -10 60 d -2 -9 d 8 -68 d f 0.2 0.8 0 c 1371 1649 m -9 56 d 7 -65 d f black 1382
- 1528 m 24 -21 d -20 56 d -24 142 d cl s 0 0.8 0.2 c 1371 1565 m 11 -37 d -5 44
- d f 0 0.8 0 c 1359 1603 m 12 -38 d 6 7 d -8 68 d -13 -13 d f 0.2 0.8 0 c 1369
- 1640 m -7 65 d -1 3 d -13 -13 d 8 -68 d f 0.4 0.8 0 c 1361 1708 m -18 58 d -3
- -3 d 8 -68 d f 0.6 0.8 0 c 1343 1766 m -4 14 d 1 -17 d f black 1359 1603 m 23
- -75 d -20 177 d -23 75 d cl s 0 0.8 0.2 c 1335 1516 m 12 43 d -30 13 d -2 -13 d
- f 0 0.8 0 c 1347 1559 m 12 44 d -3 24 d -33 9 d -6 -64 d f 0.2 0.8 0 c 1356
- 1627 m -8 68 d -18 5 d -7 -64 d f 0.4 0.8 0 c 1348 1695 m -8 68 d -3 1 d -7 -64
- d f 0.6 0.8 0 c 1340 1763 m -1 17 d -2 -16 d f black 1335 1516 m 24 87 d -20
- 177 d -24 -221 d cl s 0 0.8 0.6 c 1312 1416 m 2 11 d -3 X f 0 0.8 0.4 c 1314
- 1427 m 16 66 d -26 1 d 7 -67 d f 0 0.8 0.2 c 1330 1493 m 5 23 d -20 43 d -5 12
- d -13 -9 d 7 -68 d f 0 0.8 0 c 1310 1571 m -18 49 d 5 -58 d f black 1312 1416 m
- 23 100 d -20 43 d -23 61 d cl s 0 0.8 0.6 c 1311 1426 m 1 -10 d -1 11 d f 0 0.8
- 0.4 c 1303 1486 m 8 -60 d 1 Y -7 67 d f 0 0.8 0.2 c 1295 1546 m 8 -60 d 1 8 d
- -7 68 d -29 -2 d f 0 0.8 0 c 1288 1598 m 7 -52 d 2 16 d -5 58 d -24 -60 d f
- black 1288 1598 m 24 -182 d -20 204 d -24 -60 d cl s 0 0.8 0 c 1265 1539 m 23
- 59 d -20 -38 d -23 48 d f black 1265 1539 m 23 59 d -20 -38 d -23 48 d cl s 0
- 0.8 0.4 c 1224 1487 m -3 -20 d 5 15 d f 0 0.8 0.2 c 1241 1533 m 24 6 d -30 13 d
- -11 -65 d 2 -5 d f 0 0.8 0 c 1241 1533 m 24 6 d -20 69 d -10 -56 d f black 1241
- 1533 m 24 6 d -20 69 d -24 -141 d cl s 0 0.8 0.4 c 1226 1482 m -5 -15 d -1 19 d
- f 0 0.8 0.2 c 1218 1500 m 23 33 d -15 -51 d -6 4 d -4 61 d -19 Y f 0 0.8 0 c
- 1241 1533 m -25 14 d -4 61 d 1 -15 d 3 -65 d f 0.2 0.8 0 c 1212 1608 m -3 61 d
- -11 Y 4 -65 d f 0.4 0.8 0 c 1209 1669 m -4 61 d -7 Y 4 -65 d f 0.6 0.8 0 c 1205
- 1730 m -4 62 d -4 Y 4 -65 d f 0.8 0.8 0 c 1201 1792 m -3 59 d 3 -63 d f black
- 1218 1500 m 23 33 d -20 -66 d -23 384 d cl s 0 0.8 0.2 c 1194 1521 m 24 -21 d
- -2 28 d f 0 0.8 0 c 1194 1521 m 22 7 d -3 65 d -37 4 d f 0.2 0.8 0 c 1213 1593
- m -4 65 d -29 4 d -6 -59 d 2 -6 d f 0.4 0.8 0 c 1209 1658 m -4 65 d -19 3 d -6
- -64 d f 0.6 0.8 0 c 1205 1723 m -4 65 d -9 1 d -6 -63 d f 0.8 0.8 0 c 1201 1788
- m -3 63 d -6 -62 d f black 1194 1521 m 24 -21 d -20 351 d -24 -248 d cl s 0 0.8
- 0.4 c 1171 1447 m 2 6 d -3 X f 0 0.8 0.2 c 1173 1453 m 21 68 d -31 X 7 -68 d f
- 0 0.8 0 c 1194 1521 m -18 76 d -20 -9 d 7 -67 d f 0.2 0.8 0 c 1176 1597 m -2 6
- d -23 35 d 5 -50 d f black 1171 1447 m 23 74 d -20 82 d -23 35 d cl s 0 0.8 0.4
- c 1169 1452 m 2 -5 d -1 6 d f 0 0.8 0.2 c 1147 1509 m 22 -57 d 1 1 d -7 68 d f
- 0 0.8 0 c 1147 1509 m 16 12 d -7 67 d -22 -7 d f 0.2 0.8 0 c 1156 1588 m -5 50
- d -24 -20 d 7 -37 d f black 1147 1509 m 24 -62 d -20 191 d -24 -20 d cl s 0 0.8
- 0.6 c 1124 1368 m 2 11 d -3 X f 0 0.8 0.4 c 1126 1379 m 11 65 d -22 3 d 8 -68 d
- f 0 0.8 0.2 c 1137 1444 m 10 65 d -40 7 d 8 -69 d f 0 0.8 0 c 1147 1509 m -13
- 72 d -18 2 d -12 -38 d 3 -29 d f 0.2 0.8 0 c 1134 1581 m -7 37 d -11 -35 d f
- black 1124 1368 m 23 141 d -20 109 d -23 -73 d cl s 0 0.8 0.6 c 1121 1378 m 3
- -10 d -1 11 d f 0 0.8 0.4 c 1106 1436 m 15 -58 d 2 1 d -8 68 d f 0 0.8 0.2 c
- 1100 1456 m 6 -20 d 9 11 d -8 69 d -14 -13 d f 0 0.8 0 c 1107 1516 m -3 29 d
- -21 30 d -2 -1 d 12 -71 d f 0.2 0.8 0 c 1083 1575 m -3 4 d 1 -5 d f black 1100
- 1456 m 24 -88 d -20 177 d -24 34 d cl s 0 0.8 0.2 c 1077 1450 m 23 6 d -7 47 d
- -23 -7 d f 0 0.8 0 c 1093 1503 m -12 71 d -21 -8 d 10 -70 d f 0.2 0.8 0 c 1081
- 1574 m -1 5 d -23 8 d 3 -21 d f black 1077 1450 m 23 6 d -20 123 d -23 8 d cl s
- 0 0.8 0.2 c 1054 1485 m 23 -35 d -7 46 d f 0 0.8 0 c 1054 1485 m 16 11 d -10 70
- d -11 -16 d f 0.2 0.8 0 c 1060 1566 m -3 21 d -5 42 d -7 -13 d 4 -66 d f 0.4
- 0.8 0 c 1052 1629 m -7 61 d -4 -9 d 4 -65 d f 0.6 0.8 0 c 1045 1690 m -7 60 d
- -2 -4 d 5 -65 d f 0.8 0.8 0 c 1038 1750 m -5 46 d 3 -50 d f black 1054 1485 m
- 23 -35 d -20 137 d -24 209 d cl s 0 0.8 0 c 1043 1544 m 11 -59 d -5 65 d f 0.2
- 0.8 0 c 1032 1603 m 11 -59 d 6 6 d -4 66 d -35 3 d -4 Y 5 X f 0.4 0.8 0 c 1030
- 1613 m 2 -10 d 13 13 d -4 65 d -23 2 d -8 -64 d 5 -4 d f 0.6 0.8 0 c 1041 1681
- m -5 65 d -9 1 d -9 -64 d f 0.8 0.8 0 c 1036 1746 m -3 50 d -6 -49 d f black
- 1030 1613 m 24 -128 d -21 311 d -23 -181 d cl s 0 0.8 0 c 1007 1473 m 10 65 d
- -16 1 d f 0.2 0.8 0 c 1017 1538 m 11 65 d -13 12 d -5 X -1 3 d -13 -13 d 5 -66
- d f 0.4 0.8 0 c 1028 1603 m 2 10 d -15 2 d -6 3 d -12 59 d -6 -6 d 5 -66 d f
- 0.6 0.8 0 c 997 1677 m -11 53 d 5 -59 d f black 1007 1473 m 23 140 d -20 2 d
- -24 115 d cl s 0 0.8 0 c 983 1507 m 24 -34 d -6 66 d -22 -7 d f 0.2 0.8 0 c
- 1001 1539 m -5 66 d -27 -3 d 10 -70 d f 0.4 0.8 0 c 996 1605 m -5 66 d -21 X -7
- -27 d 6 -42 d f 0.6 0.8 0 c 991 1671 m -5 59 d -16 -59 d f black 983 1507 m 24
- -34 d -21 257 d -23 -86 d cl s 0 0.8 0.4 c 960 1353 m 7 48 d -11 1 d f 0 0.8
- 0.2 c 967 1401 m 10 64 d -26 3 d 5 -66 d f 0 0.8 0 c 977 1465 m 6 42 d -4 25 d
- -34 2 d 6 -66 d f 0.2 0.8 0 c 979 1532 m -10 70 d -29 -2 d 5 -66 d f 0.4 0.8 0
- c 969 1602 m -6 42 d -24 -33 d 1 -11 d f black 960 1353 m 23 154 d -20 137 d
- -24 -33 d cl s 0 0.8 0.4 c 944 1395 m 16 -42 d -4 49 d f 0 0.8 0.2 c 936 1415 m
- 8 -20 d 12 7 d -5 66 d -18 -11 d f 0 0.8 0 c 951 1468 m -6 66 d -18 -10 d 6 -67
- d f 0.2 0.8 0 c 945 1534 m -5 66 d -18 -10 d 5 -66 d f 0.4 0.8 0 c 940 1600 m
- -1 11 d -18 47 d -4 -2 d 5 -66 d f 0.6 0.8 0 c 921 1658 m -5 14 d 1 -16 d f
- black 936 1415 m 24 -62 d -21 258 d -23 61 d cl s 0 0.8 0.2 c 926 1452 m 10 -37
- d -3 42 d f 0 0.8 0 c 913 1503 m 13 -51 d 7 5 d -6 67 d -27 -3 d f 0.2 0.8 0 c
- 927 1524 m -5 66 d -20 1 d -10 -59 d 8 -11 d f 0.4 0.8 0 c 922 1590 m -5 66 d
- -4 X -11 -65 d f 0.6 0.8 0 c 917 1656 m -1 16 d -3 -16 d f black 913 1503 m 23
- -88 d -20 257 d -24 -140 d cl s 0 0.8 0 c 889 1470 m 24 33 d -13 18 d -19 -10 d
- f 0.2 0.8 0 c 900 1521 m -8 11 d -23 47 d 12 -68 d f black 889 1470 m 24 33 d
- -21 29 d -23 47 d cl s 0 0.8 0.4 c 866 1370 m 1 5 d -2 X f 0 0.8 0.2 c 867 1375
- m 15 66 d -24 2 d 7 -68 d f 0 0.8 0 c 882 1441 m 7 29 d -8 41 d -30 X 7 -68 d f
- 0.2 0.8 0 c 881 1511 m -12 68 d -24 -19 d 6 -49 d f black 866 1370 m 23 100 d
- -20 109 d -24 -19 d cl s 0 0.8 0.4 c 865 1375 m 1 -5 d -1 5 d f 0 0.8 0.2 c 853
- 1434 m 12 -59 d -7 68 d f 0 0.8 0 c 842 1485 m 11 -51 d 5 9 d -7 68 d -13 -15 d
- f 0.2 0.8 0 c 851 1511 m -6 49 d -23 -19 d 16 -45 d f black 842 1485 m 24 -115
- d -21 190 d -23 -19 d cl s 0 0.8 0.2 c 805 1442 m -7 -42 d 12 31 d f 0 0.8 0 c
- 819 1452 m 23 33 d -4 11 d -22 11 d -11 -65 d 5 -11 d f 0.2 0.8 0 c 838 1496 m
- -16 45 d -6 -34 d f black 819 1452 m 23 33 d -20 56 d -24 -141 d cl s 0 0.8 0.2
- c 795 1392 m 12 30 d 3 9 d -12 -31 d -3 40 d -2 -20 d f 0 0.8 0 c 807 1422 m 12
- 30 d -9 -21 d -15 9 d -5 61 d -1 -15 d 4 -66 d f 0.2 0.8 0 c 790 1501 m -4 61 d
- -1 -11 d 4 -65 d f 0.4 0.8 0 c 786 1562 m -5 61 d -1 -6 d 5 -66 d f 0.6 0.8 0 c
- 781 1623 m -5 60 d -1 Y 4 -65 d f 0.8 0.8 0 c 776 1683 m -1 20 d 1 -21 d f
- black 795 1392 m 24 60 d -21 -52 d -23 303 d cl s 0 0.8 0.4 c 772 1346 m 3 6 d
- -4 -1 d f 0 0.8 0.2 c 775 1352 m 20 40 d -2 28 d -27 -3 d 5 -66 d f 0 0.8 0 c
- 793 1420 m -4 66 d -28 -3 d 5 -66 d f 0.2 0.8 0 c 789 1486 m -4 65 d -29 -2 d 5
- -66 d f 0.4 0.8 0 c 785 1551 m -5 66 d -29 -2 d 5 -66 d f 0.6 0.8 0 c 780 1617
- m -4 65 d -7 X -18 -65 d -2 Y f 0.8 0.8 0 c 776 1682 m -1 21 d -6 -21 d f black
- 772 1346 m 23 46 d -20 311 d -24 -86 d cl s 0 0.8 0.4 c 771 1351 m 1 -5 d -1 5
- d f 0 0.8 0.2 c 760 1410 m 11 -59 d -5 66 d f 0 0.8 0 c 749 1469 m 11 -59 d 6 7
- d -5 66 d f 0.2 0.8 0 c 748 1474 m 1 -5 d 12 14 d -5 66 d -21 X -7 -32 d f 0.4
- 0.8 0 c 756 1549 m -5 66 d -16 -66 d f 0.6 0.8 0 c 751 1615 m 2 Y -2 Y f black
- 748 1474 m 24 -128 d -21 271 d -23 -100 d cl s 0 0.8 0.2 c 725 1388 m 4 14 d -8
- 2 d f 0 0.8 0 c 729 1402 m 18 67 d -38 11 d -5 -10 d 17 -66 d f 0.2 0.8 0 c 747
- 1469 m 1 5 d -20 43 d -19 -37 d f black 725 1388 m 23 86 d -20 43 d -24 -47 d
- cl s 0 0 0.8 c 701 898 m 3 63 d -21 15 d -2 -63 d f 0 0.2 0.8 c 704 961 m 3 63
- d -21 15 d -3 -63 d f 0 0.4 0.8 c 707 1024 m 3 63 d -21 15 d -3 -63 d f 0 0.6
- 0.8 c 710 1087 m 3 63 d -22 15 d -2 -63 d f 0 0.8 0.8 c 713 1150 m 3 62 d -22
- 16 d -3 -63 d f 0 0.8 0.6 c 716 1212 m 3 63 d -22 15 d -3 -62 d f 0 0.8 0.4 c
- 719 1275 m 3 63 d -23 15 d -2 -63 d f 0 0.8 0.2 c 722 1338 m 3 50 d -4 16 d -19
- 12 d -3 -63 d f 0 0.8 0 c 721 1404 m -17 66 d -2 -54 d f black 701 898 m 24 490
- d -21 82 d -23 -557 d cl s 0 0 0.8 c 678 892 m 23 6 d -20 15 d -24 -6 d f black
- 678 892 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 654 886 m 24 6 d -21 15 d -23
- -6 d f black 654 886 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 631 880 m 23 6 d
- -20 15 d -24 -5 d f black 631 880 m 23 6 d -20 15 d -24 -5 d cl s 0 0 0.8 c
- 1732 1139 m 23 6 d -20 16 d -24 -6 d f black 1732 1139 m 23 6 d -20 16 d -24 -6
- d cl s 0 0 0.8 c 1708 1134 m 24 5 d -21 16 d -23 -6 d f black 1708 1134 m 24 5
- d -21 16 d -23 -6 d cl s 0 0 0.8 c 1685 1128 m 23 6 d -20 15 d -24 -6 d f black
- 1685 1128 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1681 1189 m 4 -61 d -21 15
- d -2 62 d f 0 0.2 0.8 c 1677 1250 m 4 -61 d -19 16 d -2 61 d f 0 0.4 0.8 c 1674
- 1311 m 3 -61 d -17 16 d -3 62 d f 0 0.6 0.8 c 1670 1372 m 4 -61 d -17 17 d -2
- 61 d f 0 0.8 0.8 c 1666 1434 m 4 -62 d -15 17 d -2 62 d f 0 0.8 0.6 c 1663 1495
- m 3 -61 d -13 17 d -3 61 d f 0 0.8 0.4 c 1661 1525 m 2 -30 d -13 17 d -2 62 d
- 10 -15 d f 0 0.8 0.2 c 1648 1574 m -2 62 d 7 -11 d 5 -66 d f 0 0.8 0 c 1646
- 1636 m -3 61 d 4 -6 d 6 -66 d f 0.2 0.8 0 c 1643 1697 m -2 62 d 1 -1 d 5 -67 d
- f 0.4 0.8 0 c 1641 1759 m 10 Y 1 -11 d f black 1661 1525 m 24 -397 d -21 15 d
- -23 626 d cl s 0 0.8 0.8 c 1638 1425 m 1 Y -1 X f 0 0.8 0.6 c 1638 1426 m 16 66
- d -22 1 d 5 -67 d f 0 0.8 0.4 c 1654 1492 m 7 33 d -3 34 d -31 X 5 -66 d f 0
- 0.8 0.2 c 1658 1559 m -5 66 d -31 X 5 -66 d f 0 0.8 0 c 1653 1625 m -6 66 d -27
- X -3 -9 d 5 -57 d f 0.2 0.8 0 c 1647 1691 m -5 67 d -4 X -18 -67 d f 0.4 0.8 0
- c 1642 1758 m -1 11 d -3 -11 d f black 1638 1425 m 23 100 d -20 244 d -24 -87 d
- cl s 0 0.8 0.8 c 1614 1419 m 24 6 d -1 1 d -23 -5 d f 0 0.8 0.6 c 1637 1426 m
- -5 67 d -29 -2 d 11 -70 d f 0 0.8 0.4 c 1632 1493 m -5 66 d -32 1 d -1 -5 d 9
- -64 d f 0 0.8 0.2 c 1627 1559 m -5 66 d -15 1 d -12 -66 d f 0 0.8 0 c 1622 1625
- m -5 57 d -10 -56 d f black 1614 1419 m 24 6 d -21 257 d -23 -127 d cl s 0 0.8
- 0.8 c 1614 1420 m -1 Y 2 Y f 0 0.8 0.6 c 1592 1477 m 22 -57 d 1 Y -11 70 d f 0
- 0.8 0.4 c 1591 1480 m 1 -3 d 11 14 d -9 64 d -1 5 d -10 -15 d f 0 0.8 0.2 c
- 1593 1560 m -16 58 d -3 -5 d 9 -68 d f 0 0.8 0 c 1577 1618 m -7 25 d 4 -30 d f
- black 1591 1480 m 23 -61 d -20 136 d -24 88 d cl s 0 0.8 0.6 c 1567 1460 m 18
- 15 d -19 -4 d f 0 0.8 0.4 c 1585 1475 m 6 5 d -8 65 d -21 -9 d 4 -65 d f 0 0.8
- 0.2 c 1583 1545 m -9 68 d -16 -11 d 4 -66 d f 0 0.8 0 c 1574 1613 m -4 30 d -5
- 34 d -11 -10 d 4 -65 d f 0.2 0.8 0 c 1565 1677 m -10 60 d -5 -5 d 4 -65 d f 0.4
- 0.8 0 c 1555 1737 m -8 48 d 3 -53 d f black 1567 1460 m 24 20 d -21 163 d -23
- 142 d cl s 0 0.8 0.6 c 1544 1428 m 23 32 d -1 11 d -26 -4 d f 0 0.8 0.4 c 1566
- 1471 m -4 65 d -28 -2 d 6 -67 d f 0 0.8 0.2 c 1562 1536 m -4 66 d -30 -2 d 6
- -66 d f 0 0.8 0 c 1558 1602 m -4 65 d -29 X -2 -9 d 5 -58 d f 0.2 0.8 0 c 1554
- 1667 m -4 65 d -13 X -12 -65 d f 0.4 0.8 0 c 1550 1732 m -3 53 d -10 -53 d f
- black 1544 1428 m 23 32 d -20 325 d -24 -127 d cl s 0 0.8 0.6 c 1522 1459 m 22
- -31 d -4 39 d -39 7 d -1 -10 d 15 -2 d f 0 0.8 0.4 c 1520 1462 m 2 -3 d 18 8 d
- -6 67 d -25 5 d -8 -65 d 14 -12 d f 0 0.8 0.2 c 1534 1534 m -6 66 d -11 3 d -8
- -64 d f 0 0.8 0 c 1528 1600 m -5 58 d -6 -55 d f black 1520 1462 m 24 -34 d -21
- 230 d -23 -194 d cl s 0 0.8 0.6 c 1497 1416 m 21 42 d -3 4 d -15 2 d -2 10 d -5
- -19 d f 0 0.8 0.4 c 1518 1458 m 2 4 d -5 X -17 12 d -8 60 d -3 -12 d 6 -67 d f
- 0 0.8 0.2 c 1490 1534 m -8 60 d -2 -5 d 7 -67 d f 0 0.8 0 c 1482 1594 m -6 39 d
- 4 -44 d f black 1497 1416 m 23 46 d -20 2 d -24 169 d cl s 0 0.8 0.6 c 1475
- 1447 m 22 -31 d -4 39 d f 0 0.8 0.4 c 1473 1450 m 2 -3 d 18 8 d -6 67 d -19 -9
- d f 0 0.8 0.2 c 1487 1522 m -7 67 d -18 -10 d 6 -66 d f 0 0.8 0 c 1480 1589 m
- -4 44 d -7 20 d -12 -8 d 5 -66 d f 0.2 0.8 0 c 1469 1653 m -16 41 d 4 -49 d f
- black 1473 1450 m 24 -34 d -21 217 d -23 61 d cl s 0 0.8 0.8 c 1450 1336 m 9 45
- d -14 1 d f 0 0.8 0.6 c 1459 1381 m 13 65 d -33 3 d 6 -67 d f 0 0.8 0.4 c 1472
- 1446 m 1 4 d -5 63 d -35 3 d 6 -67 d f 0 0.8 0.2 c 1468 1513 m -6 66 d -28 3 d
- -5 -28 d 4 -38 d f 0 0.8 0 c 1462 1579 m -5 66 d -12 2 d -11 -65 d f 0.2 0.8 0
- c 1457 1645 m -4 49 d -8 -47 d f black 1450 1336 m 23 114 d -20 244 d -24 -140
- d cl s 0 0.8 0.8 c 1435 1375 m 15 -39 d -5 46 d f 0 0.8 0.6 c 1426 1398 m 9 -23
- d 10 7 d -6 67 d -21 -8 d f 0 0.8 0.4 c 1439 1449 m -6 67 d -24 -3 d -3 -6 d 12
- -66 d f 0 0.8 0.2 c 1433 1516 m -4 38 d -20 -41 d f black 1426 1398 m 24 -62 d
- -21 218 d -23 -47 d cl s 0 0.8 0.8 c 1403 1365 m 1 2 d -2 X f 0 0.8 0.6 c 1404
- 1367 m 22 31 d -8 43 d -24 -6 d 8 -68 d f 0 0.8 0.4 c 1418 1441 m -12 66 d -5 4
- d -16 -7 d 9 -69 d f 0 0.8 0.2 c 1401 1511 m -19 17 d 3 -24 d f black 1403 1365
- m 23 33 d -20 109 d -24 21 d cl s 0 0.8 0.8 c 1402 1366 m 1 -1 d -1 2 d f 0 0.8
- 0.6 c 1379 1413 m 23 -47 d 1 Y -8 68 d -16 -11 d f 0 0.8 0.4 c 1394 1435 m -9
- 69 d -14 -13 d 7 -67 d f 0 0.8 0.2 c 1385 1504 m -3 24 d -11 37 d -7 -6 d 7 -68
- d f 0 0.8 0 c 1371 1565 m -12 38 d 5 -44 d f black 1379 1413 m 24 -48 d -21 163
- d -23 75 d cl s 0 0.8 0.6 c 1370 1420 m 9 -7 d -1 11 d f 0 0.8 0.4 c 1356 1433
- m 14 -13 d 8 4 d -7 67 d -29 -2 d f 0 0.8 0.2 c 1371 1491 m -7 68 d -17 X -12
- -43 d 7 -27 d f 0 0.8 0 c 1364 1559 m -5 44 d -12 -44 d f black 1356 1433 m 23
- -20 d -20 190 d -24 -87 d cl s 0 0.8 0.6 c 1314 1427 m -2 -11 d 5 6 d f 0 0.8
- 0.4 c 1332 1441 m 24 -8 d -14 56 d -12 4 d -16 -66 d 3 -5 d f 0 0.8 0.2 c 1342
- 1489 m -7 27 d -5 -23 d f black 1332 1441 m 24 -8 d -21 83 d -23 -100 d cl s 0
- 0.8 0.6 c 1317 1422 m -5 -6 d -1 10 d f 0 0.8 0.4 c 1309 1422 m 23 19 d -15 -19
- d -6 4 d -8 60 d -15 Y f 0 0.8 0.2 c 1303 1486 m -8 60 d -7 Y 8 -68 d f 0 0.8 0
- c 1295 1546 m -7 52 d 7 -59 d f black 1309 1422 m 23 19 d -20 -25 d -24 182 d
- cl s 0 0.8 0.6 c 1285 1362 m 16 41 d -20 -1 d f 0 0.8 0.4 c 1301 1403 m 8 19 d
- -6 49 d -30 -1 d 8 -68 d f 0 0.8 0.2 c 1303 1471 m -8 68 d -30 X 8 -69 d f 0
- 0.8 0 c 1295 1539 m -7 59 d -23 -59 d f black 1285 1362 m 24 60 d -21 176 d -23
- -59 d cl s 0 0.8 0.8 c 1262 1329 m 1 2 d -1 X f 0 0.8 0.6 c 1263 1331 m 22 31 d
- -4 40 d -26 -4 d 7 -67 d f 0 0.8 0.4 c 1281 1402 m -8 68 d -25 -5 d 7 -67 d f 0
- 0.8 0.2 c 1273 1470 m -8 69 d -24 -6 d 7 -68 d f black 1262 1329 m 23 33 d -20
- 177 d -24 -6 d cl s 0 0.8 0.8 c 1238 1283 m 24 46 d 2 Y -28 -3 d f 0 0.8 0.6 c
- 1262 1331 m -7 67 d -27 -3 d 6 -67 d f 0 0.8 0.4 c 1255 1398 m -7 67 d -26 -3 d
- 6 -67 d f 0 0.8 0.2 c 1248 1465 m -7 68 d -23 -33 d 4 -38 d f black 1238 1283 m
- 24 46 d -21 204 d -23 -33 d cl s 0 0.8 0.8 c 1230 1323 m 8 -40 d -4 45 d f 0
- 0.8 0.6 c 1218 1382 m 12 -59 d 4 5 d -6 67 d f 0 0.8 0.4 c 1215 1398 m 3 -16 d
- 10 13 d -6 67 d -16 -13 d f 0 0.8 0.2 c 1222 1462 m -4 38 d -24 21 d 12 -72 d f
- black 1215 1398 m 23 -115 d -20 217 d -24 21 d cl s 0 0.8 0.4 c 1195 1438 m 20
- -40 d -9 51 d -33 4 d -2 -6 d 8 X f 0 0.8 0.2 c 1191 1445 m 4 -7 d 11 11 d -12
- 72 d -21 -68 d 6 -6 d f black 1191 1445 m 24 -47 d -21 123 d -23 -74 d cl s 0
- 0.8 0.4 c 1168 1399 m 18 37 d -7 11 d -8 X -2 5 d -8 -16 d f 0 0.8 0.2 c 1186
- 1436 m 5 9 d -12 2 d -10 5 d -22 57 d 14 -73 d f black 1168 1399 m 23 46 d -20
- 2 d -24 62 d cl s 0 0.8 0.6 c 1144 1339 m 11 26 d -29 14 d -2 -11 d f 0 0.8 0.4
- c 1155 1365 m 13 34 d -7 37 d -24 8 d -11 -65 d f 0 0.8 0.2 c 1161 1436 m -14
- 73 d -10 -65 d f black 1144 1339 m 24 60 d -21 110 d -23 -141 d cl s 0 0.8 0.6
- c 1121 1347 m 23 -8 d -20 29 d -3 10 d -2 -19 d f 0 0.8 0.4 c 1121 1378 m -15
- 58 d -1 -5 d 14 -72 d f 0 0.8 0.2 c 1106 1436 m -6 20 d 5 -25 d f black 1121
- 1347 m 23 -8 d -20 29 d -24 88 d cl s 0 0.8 0.6 c 1112 1355 m 9 -8 d -2 12 d f
- 0 0.8 0.4 c 1097 1368 m 15 -13 d 7 4 d -14 72 d -21 -7 d f 0 0.8 0.2 c 1105
- 1431 m -5 25 d -23 -6 d 7 -26 d f black 1097 1368 m 24 -21 d -21 109 d -23 -6 d
- cl s 0 0.8 0.4 c 1074 1348 m 23 20 d -13 56 d -20 -9 d f 0 0.8 0.2 c 1084 1424
- m -7 26 d -23 35 d 10 -70 d f black 1074 1348 m 23 20 d -20 82 d -23 35 d cl s
- 0 0.8 0.6 c 1050 1329 m 18 14 d -18 -3 d f 0 0.8 0.4 c 1068 1343 m 6 5 d -10 67
- d -19 -10 d 5 -65 d f 0 0.8 0.2 c 1064 1415 m -10 70 d -14 -14 d 5 -66 d f 0
- 0.8 0 c 1054 1485 m -11 59 d -8 -7 d 5 -66 d f 0.2 0.8 0 c 1043 1544 m -11 59 d
- -1 -1 d 4 -65 d f 0.4 0.8 0 c 1032 1603 m -2 10 d 1 -11 d f black 1050 1329 m
- 24 19 d -20 137 d -24 128 d cl s 0 0.8 0.6 c 1042 1337 m 8 -8 d 11 Y f 0 0.8
- 0.4 c 1027 1350 m 15 -13 d 8 3 d -5 65 d -27 -3 d f 0 0.8 0.2 c 1045 1405 m -5
- 66 d -33 2 d 11 -71 d f 0 0.8 0 c 1040 1471 m -5 66 d -18 1 d -10 -65 d f 0.2
- 0.8 0 c 1035 1537 m -4 65 d -3 1 d -11 -65 d f 0.4 0.8 0 c 1031 1602 m -1 11 d
- -2 -10 d f black 1027 1350 m 23 -21 d -20 284 d -23 -140 d cl s 0 0.8 0.4 c
- 1007 1390 m 20 -40 d -9 52 d f 0 0.8 0.2 c 1003 1398 m 4 -8 d 11 12 d -11 71 d
- -15 -13 d f 0 0.8 0 c 1007 1473 m -24 34 d 9 -47 d f black 1003 1398 m 24 -48 d
- -20 123 d -24 34 d cl s 0 0.8 0.4 c 980 1351 m 19 37 d -32 13 d -7 -48 d f 0
- 0.8 0.2 c 999 1388 m 4 10 d -11 62 d -15 5 d -10 -64 d f 0 0.8 0 c 992 1460 m
- -9 47 d -6 -42 d f black 980 1351 m 23 47 d -20 109 d -23 -154 d cl s 0 0.8 0.4
- c 969 1380 m 11 -29 d -20 2 d -16 42 d f 0 0.8 0.2 c 956 1412 m 13 -32 d -25 15
- d -8 20 d f black 956 1412 m 24 -61 d -20 2 d -24 62 d cl s 0 0.8 0.4 c 933
- 1326 m 13 49 d -19 1 d f 0 0.8 0.2 c 946 1375 m 10 37 d -20 3 d -10 37 d -7 -8
- d 8 -68 d f 0 0.8 0 c 926 1452 m -13 51 d 6 -59 d f black 933 1326 m 23 86 d
- -20 3 d -23 88 d cl s 0 0.8 0.8 c 909 1212 m 7 31 d -9 X f 0 0.8 0.6 c 916 1243
- m 13 65 d -27 1 d 5 -66 d f 0 0.8 0.4 c 929 1308 m 4 18 d -6 50 d -30 -1 d 5
- -66 d f 0 0.8 0.2 c 927 1376 m -8 68 d -28 -3 d 6 -66 d f 0 0.8 0 c 919 1444 m
- -6 59 d -24 -33 d 2 -29 d f black 909 1212 m 24 114 d -20 177 d -24 -33 d cl s
- 0 0.8 0.8 c 907 1240 m 2 -28 d -2 31 d f 0 0.8 0.6 c 900 1301 m 7 -61 d 3 Y -5
- 66 d f 0 0.8 0.4 c 894 1361 m 6 -60 d 2 8 d -5 66 d -30 X -1 -5 d 1 4 d f 0 0.8
- 0.2 c 887 1422 m 7 -61 d 3 14 d -6 66 d -9 X -15 -66 d -1 Y 16 50 d f 0 0.8 0 c
- 886 1435 m 1 -13 d 4 19 d -2 29 d -7 -29 d 1 -17 d f black 886 1435 m 23 -223 d
- -20 258 d -23 -100 d cl s 0 0.8 0.4 c 867 1374 m -1 -4 d -1 5 d f 0 0.8 0.2 c
- 862 1415 m 21 9 d -16 -50 d -2 1 d -12 59 d f 0 0.8 0 c 862 1415 m 24 20 d -3
- -11 d -30 10 d -11 51 d f black 862 1415 m 24 20 d -20 -65 d -24 115 d cl s 0
- 0.8 0.2 c 839 1396 m 23 19 d -30 X f 0 0.8 0 c 862 1415 m -20 70 d -23 -33 d 13
- -37 d f black 839 1396 m 23 19 d -20 70 d -23 -33 d cl s 0 0.8 0.4 c 815 1296 m
- 12 48 d -23 6 d f 0 0.8 0.2 c 827 1344 m 12 52 d -7 19 d -25 7 d -12 -30 d 9
- -42 d f 0 0.8 0 c 832 1415 m -13 37 d -12 -30 d f black 815 1296 m 24 100 d -20
- 56 d -24 -60 d cl s 0 0.8 0.8 c 792 1196 m 4 16 d -6 1 d f 0 0.8 0.6 c 796 1212
- m 15 66 d -31 4 d 10 -69 d f 0 0.8 0.4 c 811 1278 m 4 18 d -11 54 d -29 2 d -3
- -6 d 8 -64 d f 0 0.8 0.2 c 804 1350 m -9 42 d -20 -40 d f black 792 1196 m 23
- 100 d -20 96 d -23 -46 d cl s 0 0.8 0.8 c 789 1210 m 3 -14 d -2 17 d f 0 0.8
- 0.6 c 775 1269 m 14 -59 d 1 3 d -10 69 d f 0 0.8 0.4 c 769 1297 m 6 -28 d 5 13
- d -8 64 d -1 5 d -7 -19 d f 0 0.8 0.2 c 771 1351 m -11 59 d -3 -9 d 7 -69 d f 0
- 0.8 0 c 760 1410 m -11 59 d 8 -68 d f 0.2 0.8 0 c 749 1469 m -1 5 d 1 -5 d f
- black 769 1297 m 23 -101 d -20 150 d -24 128 d cl s 0 0.6 0.8 c 745 1117 m 3 21
- d -5 X f 0 0.8 0.8 c 748 1138 m 8 64 d -18 2 d 5 -66 d f 0 0.8 0.6 c 756 1202 m
- 8 64 d -30 4 d 4 -66 d f 0 0.8 0.4 c 764 1266 m 5 31 d -5 35 d -35 4 d 5 -66 d
- f 0 0.8 0.2 c 764 1332 m -7 69 d -28 1 d -4 -14 d 4 -52 d f 0 0.8 0 c 757 1401
- m -8 68 d -2 X -18 -67 d f 0.2 0.8 0 c 749 1469 m -1 5 d -1 -5 d f black 745
- 1117 m 24 180 d -21 177 d -23 -86 d cl s 0 0 0.8 c 722 882 m 6 64 d -24 15 d -3
- -63 d f 0 0.2 0.8 c 728 946 m 6 64 d -27 14 d -3 -63 d f 0 0.4 0.8 c 734 1010 m
- 7 64 d -31 13 d -3 -63 d f 0 0.6 0.8 c 741 1074 m 4 43 d -2 21 d -30 12 d -3
- -63 d f 0 0.8 0.8 c 743 1138 m -5 66 d -22 8 d -3 -62 d f 0 0.8 0.6 c 738 1204
- m -4 66 d -15 5 d -3 -63 d f 0 0.8 0.4 c 734 1270 m -5 66 d -7 2 d -3 -63 d f 0
- 0.8 0.2 c 729 1336 m -4 52 d -3 -50 d f black 722 882 m 23 235 d -20 271 d -24
- -490 d cl s 0 0 0.8 c 698 876 m 24 6 d -21 16 d -23 -6 d f black 698 876 m 24 6
- d -21 16 d -23 -6 d cl s 0 0 0.8 c 675 870 m 23 6 d -20 16 d -24 -6 d f black
- 675 870 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 651 864 m 24 6 d -21 16 d -23
- -6 d f black 651 864 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1752 1124 m 23 6
- d -20 15 d -23 -6 d f black 1752 1124 m 23 6 d -20 15 d -23 -6 d cl s 0 0 0.8 c
- 1728 1118 m 24 6 d -20 15 d -24 -5 d f black 1728 1118 m 24 6 d -20 15 d -24 -5
- d cl s 0 0 0.8 c 1705 1112 m 23 6 d -20 16 d -23 -6 d f black 1705 1112 m 23 6
- d -20 16 d -23 -6 d cl s 0 0 0.8 c 1700 1173 m 5 -61 d -20 16 d -4 61 d f 0 0.2
- 0.8 c 1695 1234 m 5 -61 d -19 16 d -4 61 d f 0 0.4 0.8 c 1690 1295 m 5 -61 d
- -18 16 d -3 61 d f 0 0.6 0.8 c 1685 1356 m 5 -61 d -16 16 d -4 61 d f 0 0.8 0.8
- c 1681 1402 m 4 -46 d -15 16 d -4 62 d 13 -15 d f 0 0.8 0.6 c 1666 1434 m -3 61
- d 4 -5 d 12 -71 d f 0 0.8 0.4 c 1663 1495 m -2 30 d 6 -35 d f black 1681 1402 m
- 24 -290 d -20 16 d -24 397 d cl s 0 0.8 0.8 c 1675 1415 m 6 -13 d -2 17 d -41 7
- d -1 Y 1 Y f 0 0.8 0.6 c 1658 1449 m 17 -34 d 4 4 d -12 71 d -13 2 d -16 -66 d
- f 0 0.8 0.4 c 1667 1490 m -6 35 d -7 -33 d f black 1658 1449 m 23 -47 d -20 123
- d -23 -100 d cl s 0 0.8 0.8 c 1638 1426 m -1 Y -24 -6 d 3 -1 d f 0 0.8 0.6 c
- 1634 1417 m 24 32 d -20 -23 d -21 -8 d f black 1634 1417 m 24 32 d -20 -24 d
- -24 -6 d cl s 0 0.4 0.8 c 1611 1263 m 2 12 d -3 X f 0 0.6 0.8 c 1613 1275 m 10
- 65 d -19 2 d 6 -67 d f 0 0.8 0.8 c 1623 1340 m 10 64 d -16 14 d -3 1 d 1 Y -17
- -11 d 7 -67 d f 0 0.8 0.6 c 1633 1404 m 1 13 d -17 1 d -3 2 d -22 57 d -1 -1 d
- 6 -67 d f 0 0.8 0.4 c 1592 1477 m -1 3 d -4 Y f black 1611 1263 m 23 154 d -20
- 2 d -23 61 d cl s 0 0.4 0.8 c 1609 1274 m 2 -11 d -1 12 d f 0 0.6 0.8 c 1597
- 1333 m 12 -59 d 1 1 d -6 67 d f 0 0.8 0.8 c 1587 1378 m 10 -45 d 7 9 d -7 67 d
- -14 -13 d f 0 0.8 0.6 c 1597 1409 m -6 67 d -6 -1 d -18 -15 d 16 -64 d f 0 0.8
- 0.4 c 1591 1476 m 4 Y -6 -5 d f black 1587 1378 m 24 -115 d -20 217 d -24 -20 d
- cl s 0 0.6 0.8 c 1564 1318 m 3 7 d -4 1 d f 0 0.8 0.8 c 1567 1325 m 20 53 d -4
- 18 d -34 2 d 14 -72 d f 0 0.8 0.6 c 1583 1396 m -16 64 d -23 -32 d 5 -30 d f
- black 1564 1318 m 23 60 d -20 82 d -23 -32 d cl s 0 0.6 0.8 c 1540 1272 m 24 46
- d -1 8 d -28 -3 d f 0 0.8 0.8 c 1563 1326 m -14 72 d -21 -7 d 7 -68 d f 0 0.8
- 0.6 c 1549 1398 m -5 30 d -22 31 d -1 -1 d 7 -67 d f 0 0.8 0.4 c 1522 1459 m -2
- 3 d 1 -4 d f black 1540 1272 m 24 46 d -20 110 d -24 34 d cl s 0 0.6 0.8 c 1517
- 1266 m 23 6 d -5 51 d -25 -5 d f 0 0.8 0.8 c 1535 1323 m -7 68 d -28 -4 d 10
- -69 d f 0 0.8 0.6 c 1528 1391 m -7 67 d -3 X -21 -42 d 3 -29 d f 0 0.8 0.4 c
- 1521 1458 m -1 4 d -2 -4 d f black 1517 1266 m 23 6 d -20 190 d -23 -46 d cl s
- 0 0.6 0.8 c 1509 1311 m 8 -45 d -7 52 d f 0 0.8 0.8 c 1498 1370 m 11 -59 d 1 7
- d -10 69 d f 0 0.8 0.6 c 1494 1394 m 4 -24 d 2 17 d -3 29 d -22 31 d -2 Y f 0
- 0.8 0.4 c 1475 1447 m -2 3 d 2 -5 d f black 1494 1394 m 23 -128 d -20 150 d -24
- 34 d cl s 0 0.8 0.8 c 1470 1361 m 1 2 d -12 18 d -9 -45 d f 0 0.8 0.6 c 1471
- 1363 m 23 31 d -19 51 d -3 1 d -13 -65 d f 0 0.8 0.4 c 1475 1445 m -2 5 d -1 -4
- d f black 1470 1361 m 24 33 d -21 56 d -23 -114 d cl s 0 0.8 0.8 c 1469 1363 m
- 1 -2 d -20 -25 d -15 39 d f 0 0.8 0.6 c 1447 1396 m 22 -33 d -34 12 d -9 23 d f
- black 1447 1396 m 23 -35 d -20 -25 d -24 62 d cl s 0 0.8 0.8 c 1423 1296 m 14
- 58 d -33 13 d -1 -2 d f 0 0.8 0.6 c 1437 1354 m 10 42 d -21 2 d -22 -31 d f
- black 1423 1296 m 24 100 d -21 2 d -23 -33 d cl s 0 0.8 0.8 c 1409 1347 m 14
- -51 d -20 69 d -1 1 d f 0 0.8 0.6 c 1400 1384 m 9 -37 d -7 19 d -23 47 d f
- black 1400 1384 m 23 -88 d -20 69 d -24 48 d cl s 0 0.8 0.8 c 1376 1324 m 7 17
- d -10 X f 0 0.8 0.6 c 1383 1341 m 17 43 d -21 29 d -9 7 d -11 -6 d 14 -73 d f 0
- 0.8 0.4 c 1370 1420 m -14 13 d 3 -19 d f black 1376 1324 m 24 60 d -21 29 d -23
- 20 d cl s 0 0.6 0.8 c 1353 1264 m 3 8 d -4 X f 0 0.8 0.8 c 1356 1272 m 20 52 d
- -3 17 d -29 -1 d 8 -68 d f 0 0.8 0.6 c 1373 1341 m -14 73 d -23 -6 d 8 -68 d f
- 0 0.8 0.4 c 1359 1414 m -3 19 d -24 8 d 4 -33 d f black 1353 1264 m 23 60 d -20
- 109 d -24 8 d cl s 0 0.6 0.8 c 1351 1271 m 2 -7 d -1 8 d f 0 0.8 0.8 c 1338
- 1329 m 13 -58 d 1 1 d -8 68 d f 0 0.8 0.6 c 1329 1366 m 9 -37 d 6 11 d -8 68 d
- -19 -10 d f 0 0.8 0.4 c 1336 1408 m -4 33 d -23 -19 d 8 -24 d f black 1329 1366
- m 24 -102 d -21 177 d -23 -19 d cl s 0 0.6 0.8 c 1306 1252 m 1 7 d -3 1 d f 0
- 0.8 0.8 c 1307 1259 m 14 66 d -30 7 d 13 -72 d f 0 0.8 0.6 c 1321 1325 m 8 41 d
- -12 32 d -16 5 d -16 -41 d 6 -30 d f 0 0.8 0.4 c 1317 1398 m -8 24 d -8 -19 d f
- black 1306 1252 m 23 114 d -20 56 d -24 -60 d cl s 0 0.6 0.8 c 1303 1258 m 3 -6
- d -2 8 d f 0 0.8 0.8 c 1282 1300 m 21 -42 d 1 2 d -13 72 d -28 -1 d -1 -2 d f 0
- 0.8 0.6 c 1291 1332 m -6 30 d -22 -31 d f black 1282 1300 m 24 -48 d -21 110 d
- -23 -33 d cl s 0 0.8 0.8 c 1259 1254 m 23 46 d -20 29 d -24 -46 d f black 1259
- 1254 m 23 46 d -20 29 d -24 -46 d cl s 0 0.8 0.8 c 1235 1248 m 24 6 d -21 29 d
- -8 40 d -3 -13 d f 0 0.8 0.6 c 1230 1323 m -12 59 d -1 -3 d 10 -69 d f 0 0.8
- 0.4 c 1218 1382 m -3 16 d 2 -19 d f black 1235 1248 m 24 6 d -21 29 d -23 115 d
- cl s 0 0.8 0.8 c 1228 1301 m 7 -53 d -8 62 d f 0 0.8 0.6 c 1220 1362 m 8 -61 d
- -1 9 d -10 69 d f 0 0.8 0.4 c 1213 1422 m 7 -60 d -3 17 d -2 19 d -20 40 d f 0
- 0.8 0.2 c 1212 1430 m 1 -8 d -18 16 d -4 7 d f black 1212 1430 m 23 -182 d -20
- 150 d -24 47 d cl s 0 0.8 0.8 c 1188 1289 m 2 Y f 0 0.8 0.6 c 1188 1291 m 11 65
- d -25 8 d 14 -73 d f 0 0.8 0.4 c 1199 1356 m 11 65 d -24 15 d -18 -37 d 6 -35 d
- f 0 0.8 0.2 c 1210 1421 m 2 9 d -21 15 d -5 -9 d f black 1188 1289 m 24 141 d
- -21 15 d -23 -46 d cl s 0 0.8 0.8 c 1165 1243 m 23 46 d 2 Y -34 2 d f 0 0.8 0.6
- c 1188 1291 m -14 73 d -19 1 d -11 -26 d 10 -46 d f 0 0.8 0.4 c 1174 1364 m -6
- 35 d -13 -34 d f black 1165 1243 m 23 46 d -20 110 d -24 -60 d cl s 0 0.6 0.8 c
- 1141 1210 m 6 9 d -7 -1 d f 0 0.8 0.8 c 1147 1219 m 18 24 d -11 50 d -24 -5 d
- 10 -70 d f 0 0.8 0.6 c 1154 1293 m -10 46 d -23 8 d 9 -59 d f black 1141 1210 m
- 24 33 d -21 96 d -23 8 d cl s 0 0.6 0.8 c 1135 1216 m 6 -6 d -1 8 d f 0 0.8 0.8
- c 1118 1231 m 17 -15 d 5 2 d -10 70 d -19 -9 d f 0 0.8 0.6 c 1130 1288 m -9 59
- d -9 8 d -12 -6 d 11 -70 d f 0 0.8 0.4 c 1112 1355 m -15 13 d 3 -19 d f black
- 1118 1231 m 23 -21 d -20 137 d -24 21 d cl s 0 0.6 0.8 c 1094 1145 m 18 65 d
- -24 X f 0 0.8 0.8 c 1112 1210 m 6 21 d -7 48 d -30 -2 d 7 -67 d f 0 0.8 0.6 c
- 1111 1279 m -11 70 d -26 -4 d 7 -68 d f 0 0.8 0.4 c 1100 1349 m -3 19 d -23 -20
- d -3 Y f black 1094 1145 m 24 86 d -21 137 d -23 -20 d cl s 0 0.6 0.8 c 1085
- 1203 m 9 -58 d -6 65 d f 0 0.8 0.8 c 1075 1262 m 10 -59 d 3 7 d -7 67 d f 0 0.8
- 0.6 c 1071 1286 m 4 -24 d 6 15 d -7 68 d -6 -2 d -18 -14 d f 0 0.8 0.4 c 1074
- 1345 m 3 Y -6 -5 d f black 1071 1286 m 23 -141 d -20 203 d -24 -19 d cl s 0 0.8
- 0.6 c 1060 1321 m 11 -35 d -21 43 d -8 8 d f 0 0.8 0.4 c 1047 1361 m 13 -40 d
- -18 16 d -15 13 d f black 1047 1361 m 24 -75 d -21 43 d -23 21 d cl s 0 0.8 0.8
- c 1024 1234 m 3 16 d -5 1 d f 0 0.8 0.6 c 1027 1250 m 12 65 d -26 5 d 9 -69 d f
- 0 0.8 0.4 c 1039 1315 m 8 46 d -20 -11 d -20 40 d -2 -2 d 8 -68 d f 0 0.8 0.2 c
- 1007 1390 m -4 8 d 2 -10 d f black 1024 1234 m 23 127 d -20 -11 d -24 48 d cl s
- 0 0.8 0.8 c 1000 1201 m 24 33 d -2 17 d -28 -3 d f 0 0.8 0.6 c 1022 1251 m -9
- 69 d -29 -2 d 10 -70 d f 0 0.8 0.4 c 1013 1320 m -8 68 d -6 X -19 -37 d 4 -33 d
- f 0 0.8 0.2 c 1005 1388 m -2 10 d -4 -10 d f black 1000 1201 m 24 33 d -21 164
- d -23 -47 d cl s 0 0.8 0.8 c 977 1222 m 23 -21 d -6 47 d -19 -9 d f 0 0.8 0.6 c
- 994 1248 m -10 70 d -16 -12 d 7 -67 d f 0 0.8 0.4 c 984 1318 m -4 33 d -11 29 d
- -8 -6 d 7 -68 d f 0 0.8 0.2 c 969 1380 m -13 32 d 5 -38 d f black 977 1222 m 23
- -21 d -20 150 d -24 61 d cl s 0 0.6 0.8 c 953 1149 m 7 22 d -9 X f 0 0.8 0.8 c
- 960 1171 m 17 51 d -2 17 d -32 X 8 -68 d f 0 0.8 0.6 c 975 1239 m -7 67 d -33 1
- d 8 -68 d f 0 0.8 0.4 c 968 1306 m -7 68 d -15 1 d -13 -49 d 2 -19 d f 0 0.8
- 0.2 c 961 1374 m -5 38 d -10 -37 d f black 953 1149 m 24 73 d -21 190 d -23 -86
- d cl s 0 0.6 0.8 c 942 1166 m 11 -17 d -2 22 d f 0 0.8 0.8 c 930 1183 m 12 -17
- d 9 5 d -8 68 d -27 4 d -7 -31 d f 0 0.8 0.6 c 943 1239 m -8 68 d -6 1 d -13
- -65 d f 0 0.8 0.4 c 935 1307 m -2 19 d -4 -18 d f black 930 1183 m 23 -34 d -20
- 177 d -24 -114 d cl s 0 0.8 0.8 c 915 1222 m 15 -39 d -21 29 d -2 28 d f 0 0.8
- 0.6 c 906 1245 m 9 -23 d -8 18 d -7 61 d 2 -16 d f 0 0.8 0.4 c 900 1301 m -6 60
- d 1 -8 d 7 -68 d f 0 0.8 0.2 c 894 1361 m -7 61 d 1 -2 d 7 -67 d f 0 0.8 0 c
- 887 1422 m -1 13 d 2 -15 d f black 906 1245 m 24 -62 d -21 29 d -23 223 d cl s
- 0 0.8 0.8 c 883 1171 m 14 46 d -18 -1 d f 0 0.8 0.6 c 897 1217 m 9 28 d -4 40 d
- -28 -2 d 5 -67 d f 0 0.8 0.4 c 902 1285 m -7 68 d -27 -4 d 6 -66 d f 0 0.8 0.2
- c 895 1353 m -7 67 d -26 -5 d 6 -66 d f 0 0.8 0 c 888 1420 m -2 15 d -24 -20 d
- f black 883 1171 m 23 74 d -20 190 d -24 -20 d cl s 0 0.8 0.8 c 859 1192 m 24
- -21 d -4 45 d -21 -7 d f 0 0.8 0.6 c 879 1216 m -5 67 d -23 -7 d 7 -67 d f 0
- 0.8 0.4 c 874 1283 m -6 66 d -24 -6 d 7 -67 d f 0 0.8 0.2 c 868 1349 m -6 66 d
- -23 -19 d 5 -53 d f black 859 1192 m 24 -21 d -21 244 d -23 -19 d cl s 0 0.4
- 0.8 c 836 1065 m 2 13 d -3 X f 0 0.6 0.8 c 838 1078 m 12 65 d -21 2 d 6 -67 d f
- 0 0.8 0.8 c 850 1143 m 9 49 d -1 17 d -35 2 d 6 -66 d f 0 0.8 0.6 c 858 1209 m
- -7 67 d -34 2 d 6 -67 d f 0 0.8 0.4 c 851 1276 m -7 67 d -17 1 d -12 -48 d 2
- -18 d f 0 0.8 0.2 c 844 1343 m -5 53 d -12 -52 d f black 836 1065 m 23 127 d
- -20 204 d -24 -100 d cl s 0 0.4 0.8 c 831 1076 m 5 -11 d -1 13 d f 0 0.6 0.8 c
- 812 1113 m 19 -37 d 4 2 d -6 67 d -23 -7 d f 0 0.8 0.8 c 829 1145 m -6 66 d -27
- 1 d -4 -16 d 14 -58 d f 0 0.8 0.6 c 823 1211 m -6 67 d -6 X -15 -66 d f 0 0.8
- 0.4 c 817 1278 m -2 18 d -4 -18 d f black 812 1113 m 24 -48 d -21 231 d -23
- -100 d cl s 0 0.6 0.8 c 806 1132 m 6 -19 d -6 25 d f 0 0.8 0.8 c 789 1188 m 17
- -56 d 6 Y -14 58 d -3 14 d -1 -20 d f 0 0.8 0.6 c 789 1210 m -14 59 d -7 Y 13
- -72 d f 0 0.8 0.4 c 775 1269 m -6 28 d 6 -35 d f black 789 1188 m 23 -75 d -20
- 83 d -23 101 d cl s 0 0.6 0.8 c 748 1138 m -3 -21 d 3 18 d f 0 0.8 0.8 c 788
- 1189 m 1 -1 d -1 2 d -32 12 d -8 -64 d -3 Y 9 55 d f 0 0.8 0.6 c 765 1236 m 23
- -47 d 1 Y -13 72 d -11 4 d -8 -64 d 1 -12 d f 0 0.8 0.4 c 775 1262 m -6 35 d -5
- -31 d f black 765 1236 m 24 -48 d -20 109 d -24 -180 d cl s 0 0 0.8 c 742 867 m
- 4 63 d -18 16 d -6 -64 d f 0 0.2 0.8 c 746 930 m 4 63 d -16 17 d -6 -64 d f 0
- 0.4 0.8 c 750 993 m 4 63 d -13 18 d -7 -64 d f 0 0.6 0.8 c 754 1056 m 4 64 d
- -10 15 d -3 -18 d -4 -43 d f 0 0.8 0.8 c 758 1120 m 4 63 d -5 7 d -9 -55 d f 0
- 0.8 0.6 c 762 1183 m 3 53 d -8 -46 d f black 742 867 m 23 369 d -20 -119 d -23
- -235 d cl s 0 0 0.8 c 718 861 m 24 6 d -20 15 d -24 -6 d f black 718 861 m 24 6
- d -20 15 d -24 -6 d cl s 0 0 0.8 c 695 855 m 23 6 d -20 15 d -23 -6 d f black
- 695 855 m 23 6 d -20 15 d -23 -6 d cl s 0 0 0.8 c 671 849 m 24 6 d -20 15 d -24
- -6 d f black 671 849 m 24 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1772 1108 m 24 6
- d -21 16 d -23 -6 d f black 1772 1108 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c
- 1749 1102 m 23 6 d -20 16 d -24 -6 d f black 1749 1102 m 23 6 d -20 16 d -24 -6
- d cl s 0 0 0.8 c 1725 1096 m 24 6 d -21 16 d -23 -6 d f black 1725 1096 m 24 6
- d -21 16 d -23 -6 d cl s 0 0 0.8 c 1718 1157 m 7 -61 d -20 16 d -5 61 d f 0 0.2
- 0.8 c 1711 1217 m 7 -60 d -18 16 d -5 61 d f 0 0.4 0.8 c 1704 1277 m 7 -60 d
- -16 17 d -5 61 d f 0 0.6 0.8 c 1702 1292 m 2 -15 d -14 18 d -5 61 d 7 -9 d f 0
- 0.8 0.8 c 1685 1356 m -4 46 d 11 -55 d f black 1702 1292 m 23 -196 d -20 16 d
- -24 290 d cl s 0 0.6 0.8 c 1678 1273 m 24 19 d -10 55 d -21 -8 d f 0 0.8 0.8 c
- 1692 1347 m -11 55 d -6 13 d -12 -8 d 8 -68 d f 0 0.8 0.6 c 1675 1415 m -17 34
- d 5 -42 d f black 1678 1273 m 24 19 d -21 110 d -23 47 d cl s 0 0.6 0.8 c 1655
- 1307 m 23 -34 d -7 66 d -21 -9 d f 0 0.8 0.8 c 1671 1339 m -8 68 d -26 -4 d 13
- -73 d f 0 0.8 0.6 c 1663 1407 m -5 42 d -24 -32 d 3 -14 d f black 1655 1307 m
- 23 -34 d -20 176 d -24 -32 d cl s 0 0.4 0.8 c 1613 1275 m -2 -12 d 18 -2 d f 0
- 0.6 0.8 c 1631 1261 m 24 46 d -5 23 d -27 10 d -10 -65 d 16 -14 d f 0 0.8 0.8 c
- 1650 1330 m -13 73 d -4 1 d -10 -64 d f 0 0.8 0.6 c 1637 1403 m -3 14 d -1 -13
- d f black 1631 1261 m 24 46 d -21 110 d -23 -154 d cl s 0 0.4 0.8 c 1629 1261 m
- -18 2 d -2 11 d f 0 0.6 0.8 c 1608 1308 m 23 -47 d -2 X -20 13 d -12 59 d 8 -16
- d f 0 0.8 0.8 c 1597 1333 m -10 45 d 18 -61 d f black 1608 1308 m 23 -47 d -20
- 2 d -24 115 d cl s 0 0.6 0.8 c 1605 1314 m 3 -6 d -3 9 d -38 8 d -3 -7 d 3 5 d
- f 0 0.8 0.8 c 1584 1356 m 21 -42 d 3 Y -18 61 d -20 -53 d -2 Y f black 1584
- 1356 m 24 -48 d -21 70 d -23 -60 d cl s 0 0.6 0.8 c 1567 1323 m -3 -5 d -24 -46
- d 12 38 d f 0 0.8 0.8 c 1561 1337 m 23 19 d -17 -33 d -15 -13 d f black 1561
- 1337 m 23 19 d -20 -38 d -24 -46 d cl s 0 0.6 0.8 c 1537 1290 m 4 8 d 11 12 d
- -12 -38 d -23 -6 d f 0 0.8 0.8 c 1541 1298 m 20 39 d -9 -27 d f black 1537 1290
- m 24 47 d -21 -65 d -23 -6 d cl s 0 0.4 0.8 c 1514 1217 m 4 13 d -6 X f 0 0.6
- 0.8 c 1518 1230 m 19 60 d -20 -24 d -8 45 d -4 -13 d 7 -68 d f 0 0.8 0.8 c 1509
- 1311 m -11 59 d -1 -4 d 8 -68 d f 0 0.8 0.6 c 1498 1370 m -4 24 d 3 -28 d f
- black 1514 1217 m 23 73 d -20 -24 d -23 128 d cl s 0 0.4 0.8 c 1490 1198 m 24
- 19 d -2 13 d -25 -4 d f 0 0.6 0.8 c 1512 1230 m -7 68 d -27 -4 d 9 -68 d f 0
- 0.8 0.8 c 1505 1298 m -8 68 d -26 -3 d -1 -2 d 8 -67 d f 0 0.8 0.6 c 1497 1366
- m -3 28 d -23 -31 d f black 1490 1198 m 24 19 d -20 177 d -24 -33 d cl s 0 0.4
- 0.8 c 1479 1220 m 11 -22 d -3 28 d f 0 0.6 0.8 c 1467 1246 m 12 -26 d 8 6 d -9
- 68 d -16 -11 d f 0 0.8 0.8 c 1478 1294 m -8 67 d -1 2 d -17 -11 d 10 -69 d f 0
- 0.8 0.6 c 1469 1363 m -22 33 d 5 -44 d f black 1467 1246 m 23 -48 d -20 163 d
- -23 35 d cl s 0 0.6 0.8 c 1443 1226 m 24 20 d -5 37 d -36 4 d f 0 0.8 0.8 c
- 1462 1283 m -10 69 d -15 2 d -14 -58 d 3 -9 d f 0 0.8 0.6 c 1452 1352 m -5 44 d
- -10 -42 d f black 1443 1226 m 24 20 d -20 150 d -24 -100 d cl s 0 0.6 0.8 c
- 1420 1247 m 23 -21 d -17 61 d -9 -17 d f 0 0.8 0.8 c 1426 1287 m -3 9 d -14 51
- d -3 -7 d 11 -70 d f 0 0.8 0.6 c 1409 1347 m -9 37 d 6 -44 d f black 1420 1247
- m 23 -21 d -20 70 d -23 88 d cl s 0 0.6 0.8 c 1396 1214 m 24 33 d -3 23 d -31
- -1 d f 0 0.8 0.8 c 1417 1270 m -11 70 d -23 1 d -7 -17 d 10 -55 d f 0 0.8 0.6 c
- 1406 1340 m -6 44 d -17 -43 d f black 1396 1214 m 24 33 d -20 137 d -24 -60 d
- cl s 0 0.6 0.8 c 1373 1195 m 23 19 d -10 55 d -30 3 d -3 -8 d f 0 0.8 0.8 c
- 1386 1269 m -10 55 d -20 -52 d f black 1373 1195 m 23 19 d -20 110 d -23 -60 d
- cl s 0 0.6 0.8 c 1349 1229 m 24 -34 d -20 69 d -2 7 d -5 -19 d f 0 0.8 0.8 c
- 1351 1271 m -13 58 d -2 -7 d 10 -70 d f 0 0.8 0.6 c 1338 1329 m -9 37 d 7 -44 d
- f black 1349 1229 m 24 -34 d -20 69 d -24 102 d cl s 0 0.6 0.8 c 1326 1196 m 23
- 33 d -3 23 d -39 7 d -1 -7 d f 0 0.8 0.8 c 1346 1252 m -10 70 d -15 3 d -14 -66
- d f 0 0.8 0.6 c 1336 1322 m -7 44 d -8 -41 d f black 1326 1196 m 23 33 d -20
- 137 d -23 -114 d cl s 0 0.6 0.8 c 1310 1239 m 16 -43 d -20 56 d -3 6 d f 0 0.8
- 0.8 c 1302 1258 m 8 -19 d -7 19 d -21 42 d f black 1302 1258 m 24 -62 d -20 56
- d -24 48 d cl s 0 0.6 0.8 c 1279 1184 m 16 52 d -34 9 d f 0 0.8 0.8 c 1295 1236
- m 7 22 d -20 42 d -23 -46 d 2 -9 d f black 1279 1184 m 23 74 d -20 42 d -23 -46
- d cl s 0 0.6 0.8 c 1255 1192 m 24 -8 d -18 61 d -22 -7 d f 0 0.8 0.8 c 1261
- 1245 m -2 9 d -24 -6 d 4 -10 d f black 1255 1192 m 24 -8 d -20 70 d -24 -6 d
- cl s 0 0.4 0.8 c 1232 1146 m 7 13 d -8 -1 d f 0 0.6 0.8 c 1239 1159 m 16 33 d
- -16 46 d -13 -14 d 5 -66 d f 0 0.8 0.8 c 1239 1238 m -4 10 d -7 53 d -6 -12 d 4
- -65 d f 0 0.8 0.6 c 1228 1301 m -8 61 d -3 -7 d 5 -66 d f 0 0.8 0.4 c 1220 1362
- m -7 60 d -1 -1 d 5 -66 d f 0 0.8 0.2 c 1213 1422 m -1 8 d -9 Y f black 1232
- 1146 m 23 46 d -20 56 d -23 182 d cl s 0 0.4 0.8 c 1209 1126 m 23 20 d -1 12 d
- -26 -4 d f 0 0.6 0.8 c 1231 1158 m -5 66 d -30 -1 d 9 -69 d f 0 0.8 0.8 c 1226
- 1224 m -4 65 d -34 2 d -2 Y 8 -66 d f 0 0.8 0.6 c 1222 1289 m -5 66 d -18 1 d
- -11 -65 d f 0 0.8 0.4 c 1217 1355 m -5 66 d -2 X -11 -65 d f 0 0.8 0.2 c 1212
- 1421 m 9 Y -2 -9 d f black 1209 1126 m 23 20 d -20 284 d -24 -141 d cl s 0 0.4
- 0.8 c 1185 1134 m 24 -8 d -4 28 d -23 -7 d f 0 0.6 0.8 c 1205 1154 m -9 69 d
- -27 -3 d 13 -73 d f 0 0.8 0.8 c 1196 1223 m -8 66 d -23 -46 d 4 -23 d f black
- 1185 1134 m 24 -8 d -21 163 d -23 -46 d cl s 0 0.4 0.8 c 1162 1114 m 23 20 d -3
- 13 d -27 -3 d f 0 0.6 0.8 c 1182 1147 m -13 73 d -22 -1 d -6 -9 d 14 -66 d f 0
- 0.8 0.8 c 1169 1220 m -4 23 d -18 -24 d f black 1162 1114 m 23 20 d -20 109 d
- -24 -33 d cl s 0 0.4 0.8 c 1156 1138 m 6 -24 d -7 30 d f 0 0.6 0.8 c 1142 1197
- m 14 -59 d -1 6 d -14 66 d -6 6 d f 0 0.8 0.8 c 1138 1216 m 4 -19 d -7 19 d -17
- 15 d f black 1138 1216 m 24 -102 d -21 96 d -23 21 d cl s 0 0.6 0.8 c 1115 1143
- m 16 51 d -19 16 d -18 -65 d f 0 0.8 0.8 c 1131 1194 m 7 22 d -20 15 d -6 -21 d
- f black 1115 1143 m 23 73 d -20 15 d -24 -86 d cl s 0 0.2 0.8 c 1091 1056 m 1 4
- d -1 X f 0 0.4 0.8 c 1092 1060 m 18 66 d -25 X 6 -66 d f 0 0.6 0.8 c 1110 1126
- m 5 17 d -21 2 d -9 58 d -6 -10 d 6 -67 d f 0 0.8 0.8 c 1085 1203 m -10 59 d -2
- -3 d 6 -66 d f 0 0.8 0.6 c 1075 1262 m -4 24 d 2 -27 d f black 1091 1056 m 24
- 87 d -21 2 d -23 141 d cl s 0 0.2 0.8 c 1088 1059 m 3 -3 d 4 Y f 0 0.4 0.8 c
- 1068 1077 m 20 -18 d 3 1 d -6 66 d -20 -8 d f 0 0.6 0.8 c 1085 1126 m -6 67 d
- -19 -10 d 5 -65 d f 0 0.8 0.8 c 1079 1193 m -6 66 d -18 -10 d 5 -66 d f 0 0.8
- 0.6 c 1073 1259 m -2 27 d -11 35 d -9 -6 d 4 -66 d f 0 0.8 0.4 c 1060 1321 m
- -13 40 d 4 -46 d f black 1068 1077 m 23 -21 d -20 230 d -24 75 d cl s 0 0.4 0.8
- c 1054 1112 m 14 -35 d -3 41 d f 0 0.6 0.8 c 1044 1138 m 10 -26 d 11 6 d -5 65
- d -24 -5 d f 0 0.8 0.8 c 1060 1183 m -5 66 d -28 1 d -3 -16 d 12 -56 d f 0 0.8
- 0.6 c 1055 1249 m -4 66 d -12 X -12 -65 d f 0 0.8 0.4 c 1051 1315 m -4 46 d -8
- -46 d f black 1044 1138 m 24 -61 d -21 284 d -23 -127 d cl s 0 0.4 0.8 c 1021
- 1065 m 13 42 d -20 1 d f 0 0.6 0.8 c 1034 1107 m 10 31 d -8 40 d -32 1 d 10 -71
- d f 0 0.8 0.8 c 1036 1178 m -12 56 d -24 -33 d 4 -22 d f black 1021 1065 m 23
- 73 d -20 96 d -24 -33 d cl s 0 0.4 0.8 c 998 1098 m 23 -33 d -7 43 d f 0 0.6
- 0.8 c 997 1099 m 1 -1 d 16 10 d -10 71 d -18 -11 d f 0 0.8 0.8 c 1004 1179 m -4
- 22 d -23 21 d 9 -54 d f black 997 1099 m 24 -34 d -21 136 d -23 21 d cl s 0 0.6
- 0.8 c 974 1107 m 23 -8 d -11 69 d -26 3 d -7 -22 d f 0 0.8 0.8 c 986 1168 m -9
- 54 d -17 -51 d f black 974 1107 m 23 -8 d -20 123 d -24 -73 d cl s 0 0.6 0.8 c
- 953 1148 m 21 -41 d -21 42 d -11 17 d f 0 0.8 0.8 c 950 1154 m 3 -6 d -11 18 d
- -12 17 d f black 950 1154 m 24 -47 d -21 42 d -23 34 d cl s 0 0.4 0.8 c 927
- 1028 m 10 54 d -16 2 d f 0 0.6 0.8 c 937 1082 m 12 65 d -34 4 d 6 -67 d f 0 0.8
- 0.8 c 949 1147 m 1 7 d -20 29 d -15 39 d -6 -5 d 6 -66 d f 0 0.8 0.6 c 915 1222
- m -9 23 d 3 -28 d f black 927 1028 m 23 126 d -20 29 d -24 62 d cl s 0 0.4 0.8
- c 917 1077 m 10 -49 d -6 56 d f 0 0.6 0.8 c 904 1136 m 13 -59 d 4 7 d -6 67 d f
- 0 0.8 0.8 c 903 1142 m 1 -6 d 11 15 d -6 66 d -12 X -14 -46 d f 0 0.8 0.6 c 909
- 1217 m -3 28 d -9 -28 d f black 903 1142 m 24 -114 d -21 217 d -23 -74 d cl s 0
- 0.6 0.8 c 880 1069 m 21 66 d -33 4 d f 0 0.8 0.8 c 901 1135 m 2 7 d -20 29 d
- -24 21 d 9 -53 d f black 880 1069 m 23 73 d -20 29 d -24 21 d cl s 0 0.4 0.8 c
- 838 1078 m -2 -13 d 3 9 d f 0 0.6 0.8 c 856 1117 m 24 -48 d -12 70 d -18 4 d
- -12 -65 d 1 -4 d f 0 0.8 0.8 c 868 1139 m -9 53 d -9 -49 d f black 856 1117 m
- 24 -48 d -21 123 d -23 -127 d cl s 0 0.4 0.8 c 833 1017 m 9 41 d -3 16 d -3 -9
- d -5 11 d -8 -13 d f 0 0.6 0.8 c 842 1058 m 14 59 d -17 -43 d -8 2 d -19 37 d
- 11 -50 d f black 833 1017 m 23 100 d -20 -52 d -24 48 d cl s 0 0.4 0.8 c 816
- 1051 m 17 -34 d -10 46 d f 0 0.6 0.8 c 809 1065 m 7 -14 d 7 12 d -11 50 d -6 19
- d -6 -13 d f 0 0.8 0.8 c 806 1132 m -17 56 d 11 -69 d f black 809 1065 m 24 -48
- d -21 96 d -23 75 d cl s 0 0.6 0.8 c 793 1108 m 16 -43 d -9 54 d f 0 0.8 0.8 c
- 786 1126 m 7 -18 d 7 11 d -11 69 d -1 1 d -11 -14 d f 0 0.8 0.6 c 788 1189 m
- -23 47 d 12 -61 d f black 786 1126 m 23 -61 d -20 123 d -24 48 d cl s 0 0 0.8 c
- 762 851 m 6 64 d -22 15 d -4 -63 d f 0 0.2 0.8 c 768 915 m 5 63 d -23 15 d -4
- -63 d f 0 0.4 0.8 c 773 978 m 6 64 d -25 14 d -4 -63 d f 0 0.6 0.8 c 779 1042 m
- 5 63 d -26 15 d -4 -64 d f 0 0.8 0.8 c 784 1105 m 2 21 d -9 49 d -15 8 d -4 -63
- d f 0 0.8 0.6 c 777 1175 m -12 61 d -3 -53 d f black 762 851 m 24 275 d -21 110
- d -23 -369 d cl s 0 0 0.8 c 739 845 m 23 6 d -20 16 d -24 -6 d f black 739 845
- m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 715 839 m 24 6 d -21 16 d -23 -6 d f
- black 715 839 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 692 833 m 23 6 d -20 16
- d -24 -6 d f black 692 833 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1793 1093
- m 23 6 d -20 15 d -24 -6 d f black 1793 1093 m 23 6 d -20 15 d -24 -6 d cl s 0
- 0 0.8 c 1769 1087 m 24 6 d -21 15 d -23 -6 d f black 1769 1087 m 24 6 d -21 15
- d -23 -6 d cl s 0 0 0.8 c 1746 1081 m 23 6 d -20 15 d -24 -6 d f black 1746
- 1081 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1736 1141 m 10 -60 d -21 15 d -7
- 61 d f 0 0.2 0.8 c 1726 1200 m 10 -59 d -18 16 d -7 60 d f 0 0.4 0.8 c 1722
- 1223 m 4 -23 d -15 17 d -7 60 d 3 -4 d f 0 0.6 0.8 c 1704 1277 m -2 15 d 5 -19
- d f black 1722 1223 m 24 -142 d -21 15 d -23 196 d cl s 0 0.2 0.8 c 1699 1190 m
- 3 4 d -4 X f 0 0.4 0.8 c 1702 1194 m 20 29 d -15 50 d -28 -2 d 19 -77 d f 0 0.6
- 0.8 c 1707 1273 m -5 19 d -24 -19 d 1 -2 d f black 1699 1190 m 23 33 d -20 69 d
- -24 -19 d cl s 0 0.2 0.8 c 1675 1170 m 24 20 d -1 4 d -26 -5 d f 0 0.4 0.8 c
- 1698 1194 m -19 77 d -17 -11 d 10 -71 d f 0 0.6 0.8 c 1679 1271 m -1 2 d -23 34
- d 7 -47 d f black 1675 1170 m 24 20 d -21 83 d -23 34 d cl s 0 0.2 0.8 c 1652
- 1165 m 23 5 d -3 19 d -25 -4 d f 0 0.4 0.8 c 1672 1189 m -10 71 d -30 -1 d 15
- -74 d f 0 0.6 0.8 c 1662 1260 m -7 47 d -24 -46 d 1 -2 d f black 1652 1165 m 23
- 5 d -20 137 d -24 -46 d cl s 0 0.2 0.8 c 1644 1179 m 8 -14 d -5 20 d f 0 0.4
- 0.8 c 1628 1212 m 16 -33 d 3 6 d -15 74 d -10 -17 d f 0 0.6 0.8 c 1632 1259 m
- -1 2 d -23 47 d 14 -66 d f black 1628 1212 m 24 -47 d -21 96 d -23 47 d cl s 0
- 0.4 0.8 c 1613 1234 m 15 -22 d -6 30 d f 0 0.6 0.8 c 1605 1247 m 8 -13 d 9 8 d
- -14 66 d -3 6 d -11 -13 d f 0 0.8 0.8 c 1605 1314 m -21 42 d 10 -55 d f black
- 1605 1247 m 23 -35 d -20 96 d -24 48 d cl s 0 0.2 0.8 c 1581 1133 m 7 32 d -10
- 1 d f 0 0.4 0.8 c 1588 1165 m 13 66 d -30 2 d 7 -67 d f 0 0.6 0.8 c 1601 1231 m
- 4 16 d -11 54 d -30 -1 d 7 -67 d f 0 0.8 0.8 c 1594 1301 m -10 55 d -23 -19 d 3
- -37 d f black 1581 1133 m 24 114 d -21 109 d -23 -19 d cl s 0 0.2 0.8 c 1568
- 1160 m 13 -27 d -3 33 d f 0 0.4 0.8 c 1558 1181 m 10 -21 d 10 6 d -7 67 d -22
- -7 d f 0 0.6 0.8 c 1571 1233 m -7 67 d -23 -2 d -4 -8 d 12 -64 d f 0 0.8 0.8 c
- 1564 1300 m -3 37 d -20 -39 d f black 1558 1181 m 23 -48 d -20 204 d -24 -47 d
- cl s 0 0.4 0.8 c 1534 1161 m 24 20 d -9 45 d -31 4 d -4 -13 d f 0 0.6 0.8 c
- 1549 1226 m -12 64 d -19 -60 d f black 1534 1161 m 24 20 d -21 109 d -23 -73 d
- cl s 0 0.2 0.8 c 1511 1129 m 14 20 d -21 1 d f 0 0.4 0.8 c 1525 1149 m 9 12 d
- -20 56 d -24 -19 d 14 -48 d f black 1511 1129 m 23 32 d -20 56 d -24 -19 d cl s
- 0 0.2 0.8 c 1487 1136 m 24 -7 d -7 21 d -18 -10 d f 0 0.4 0.8 c 1504 1150 m -14
- 48 d -11 22 d -6 -8 d 13 -72 d f 0 0.6 0.8 c 1479 1220 m -12 26 d 6 -34 d f
- black 1487 1136 m 24 -7 d -21 69 d -23 48 d cl s 0 0.2 0.8 c 1484 1139 m 3 -3 d
- -1 4 d f 0 0.4 0.8 c 1464 1157 m 20 -18 d 2 1 d -13 72 d -24 -5 d f 0 0.6 0.8 c
- 1473 1212 m -6 34 d -24 -20 d 6 -19 d f black 1464 1157 m 23 -21 d -20 110 d
- -24 -20 d cl s 0 0 0.8 c 1440 1057 m 2 9 d -3 X f 0 0.2 0.8 c 1442 1066 m 16 66
- d -26 2 d 7 -68 d f 0 0.4 0.8 c 1458 1132 m 6 25 d -15 50 d -24 -6 d 7 -67 d f
- 0 0.6 0.8 c 1449 1207 m -6 19 d -23 21 d 5 -46 d f black 1440 1057 m 24 100 d
- -21 69 d -23 21 d cl s 0 0 0.8 c 1433 1063 m 7 -6 d -1 9 d f 0 0.2 0.8 c 1417
- 1078 m 16 -15 d 6 3 d -7 68 d -23 -7 d f 0 0.4 0.8 c 1432 1134 m -7 67 d -26 -4
- d 10 -70 d f 0 0.6 0.8 c 1425 1201 m -5 46 d -24 -33 d 3 -17 d f black 1417
- 1078 m 23 -21 d -20 190 d -24 -33 d cl s 0 0.2 0.8 c 1393 1099 m 24 -21 d -8 49
- d -20 -8 d f 0 0.4 0.8 c 1409 1127 m -10 70 d -26 -4 d 16 -74 d f 0 0.6 0.8 c
- 1399 1197 m -3 17 d -23 -19 d -2 Y f black 1393 1099 m 24 -21 d -21 136 d -23
- -19 d cl s 0 0 0.8 c 1370 1039 m 3 9 d -4 X f 0 0.2 0.8 c 1373 1048 m 20 51 d
- -4 20 d -27 -3 d 7 -68 d f 0 0.4 0.8 c 1389 1119 m -16 74 d -19 -10 d 8 -67 d f
- 0 0.6 0.8 c 1373 1193 m 2 Y -24 34 d 5 -46 d f black 1370 1039 m 23 60 d -20 96
- d -24 34 d cl s 0 0 0.8 c 1365 1046 m 5 -7 d -1 9 d f 0 0.2 0.8 c 1346 1073 m
- 19 -27 d 4 2 d -7 68 d -21 -8 d f 0 0.4 0.8 c 1362 1116 m -8 67 d -25 -4 d 12
- -71 d f 0 0.6 0.8 c 1354 1183 m -5 46 d -23 -33 d 3 -17 d f black 1346 1073 m
- 24 -34 d -21 190 d -23 -33 d cl s 0 0.2 0.8 c 1323 1067 m 23 6 d -5 35 d -22 -8
- d f 0 0.4 0.8 c 1341 1108 m -12 71 d -17 -11 d 7 -68 d f 0 0.6 0.8 c 1329 1179
- m -3 17 d -16 43 d -5 -3 d 7 -68 d f 0 0.8 0.8 c 1310 1239 m -8 19 d 3 -22 d f
- black 1323 1067 m 23 6 d -20 123 d -24 62 d cl s 0 0.2 0.8 c 1305 1093 m 18 -26
- d -4 33 d f 0 0.4 0.8 c 1299 1102 m 6 -9 d 14 7 d -7 68 d -28 -2 d f 0 0.6 0.8
- c 1312 1168 m -7 68 d -10 X -16 -52 d 5 -18 d f 0 0.8 0.8 c 1305 1236 m -3 22 d
- -7 -22 d f black 1299 1102 m 24 -35 d -21 191 d -23 -74 d cl s 0 0.4 0.8 c 1286
- 1150 m 13 -48 d -15 64 d f 0 0.6 0.8 c 1276 1190 m 10 -40 d -2 16 d -5 18 d -24
- 8 d f black 1276 1190 m 23 -88 d -20 82 d -24 8 d cl s 0 0.4 0.8 c 1252 1117 m
- 9 27 d -22 15 d -7 -13 d f 0 0.6 0.8 c 1261 1144 m 15 46 d -21 2 d -16 -33 d f
- black 1252 1117 m 24 73 d -21 2 d -23 -46 d cl s 0 0.2 0.8 c 1229 1043 m 10 33
- d -19 5 d f 0 0.4 0.8 c 1239 1076 m 13 41 d -20 29 d -23 -20 d 11 -45 d f black
- 1229 1043 m 23 74 d -20 29 d -23 -20 d cl s 0 0.2 0.8 c 1205 1037 m 24 6 d -9
- 38 d -22 -7 d f 0 0.4 0.8 c 1220 1081 m -11 45 d -24 8 d 13 -60 d f black 1205
- 1037 m 24 6 d -20 83 d -24 8 d cl s 0 0.2 0.8 c 1195 1065 m 10 -28 d -7 37 d f
- 0 0.4 0.8 c 1182 1099 m 13 -34 d 3 9 d -13 60 d -23 -20 d f black 1182 1099 m
- 23 -62 d -20 97 d -23 -20 d cl s 0 0.4 0.8 c 1158 1093 m 24 6 d -20 15 d -6 24
- d -2 -16 d f 0 0.6 0.8 c 1156 1138 m -14 59 d -4 Y 12 -71 d f 0 0.8 0.8 c 1142
- 1197 m -4 19 d 4 -23 d f black 1158 1093 m 24 6 d -20 15 d -24 102 d cl s 0 0.4
- 0.8 c 1135 1100 m 23 -7 d -4 29 d -28 -3 d f 0 0.6 0.8 c 1154 1122 m -12 71 d
- -11 1 d -16 -51 d 11 -24 d f 0 0.8 0.8 c 1142 1193 m -4 23 d -7 -22 d f black
- 1135 1100 m 23 -7 d -20 123 d -23 -73 d cl s 0 0.2 0.8 c 1092 1060 m -1 -4 d 5
- -1 d f 0 0.4 0.8 c 1111 1054 m 24 46 d -9 19 d -16 7 d -18 -66 d 4 -5 d f 0 0.6
- 0.8 c 1126 1119 m -11 24 d -5 -17 d f black 1111 1054 m 24 46 d -20 43 d -24
- -87 d cl s 0 0.2 0.8 c 1096 1055 m -5 1 d -3 3 d f 0 0.4 0.8 c 1088 1048 m 23 6
- d -15 1 d -8 4 d -20 18 d f black 1088 1048 m 23 6 d -20 2 d -23 21 d cl s 0
- 0.4 0.8 c 1065 1094 m 23 -46 d -20 29 d -14 35 d f 0 0.6 0.8 c 1064 1096 m 1 -2
- d -11 18 d -10 26 d f black 1064 1096 m 24 -48 d -20 29 d -24 61 d cl s 0 0.4
- 0.8 c 1041 1049 m 22 45 d -29 13 d -13 -42 d f 0 0.6 0.8 c 1063 1094 m 1 2 d
- -20 42 d -10 -31 d f black 1041 1049 m 23 47 d -20 42 d -23 -73 d cl s 0 0.4
- 0.8 c 1024 1084 m 17 -35 d -20 16 d -23 33 d f 0 0.6 0.8 c 1017 1097 m 7 -13 d
- -26 14 d -1 1 d f black 1017 1097 m 24 -48 d -20 16 d -24 34 d cl s 0 0.2 0.8 c
- 994 997 m 4 18 d -8 2 d f 0 0.4 0.8 c 998 1015 m 16 66 d -37 8 d 13 -72 d f 0
- 0.6 0.8 c 1014 1081 m 3 16 d -20 2 d -23 8 d 3 -18 d f black 994 997 m 23 100 d
- -20 2 d -23 8 d cl s 0 0.2 0.8 c 970 991 m 24 6 d -4 20 d -22 -7 d f 0 0.4 0.8
- c 990 1017 m -13 72 d -17 -11 d 8 -68 d f 0 0.6 0.8 c 977 1089 m -3 18 d -21 41
- d -2 -1 d 9 -69 d f 0 0.8 0.8 c 953 1148 m -3 6 d 1 -7 d f black 970 991 m 24 6
- d -20 110 d -24 47 d cl s 0 0.2 0.8 c 966 1007 m 4 -16 d -2 19 d f 0 0.4 0.8 c
- 947 1064 m 19 -57 d 2 3 d -8 68 d -23 4 d -10 -54 d 19 37 d f 0 0.6 0.8 c 947
- 1066 m -2 Y 13 14 d -9 69 d -2 X -12 -65 d 9 -17 d f 0 0.8 0.8 c 951 1147 m -1
- 7 d -1 -7 d f black 947 1066 m 23 -75 d -20 163 d -23 -126 d cl s 0 0.2 0.8 c
- 923 966 m 8 32 d -11 1 d f 0 0.4 0.8 c 931 998 m 16 66 d -1 1 d -19 -37 d -10
- 49 d -5 -10 d 8 -68 d f 0 0.6 0.8 c 947 1064 m 2 Y -1 -1 d -29 12 d -13 59 d -1
- Y 8 -68 d f 0 0.8 0.8 c 904 1136 m -1 6 d 1 -7 d f black 923 966 m 24 100 d -20
- -38 d -24 114 d cl s 0 0.2 0.8 c 906 991 m 17 -25 d -3 33 d f 0 0.4 0.8 c 900
- 1000 m 6 -9 d 14 8 d -8 68 d -32 X f 0 0.6 0.8 c 912 1067 m -8 68 d -3 X -21
- -66 d -2 Y f 0 0.8 0.8 c 904 1135 m -1 7 d -2 -7 d f black 900 1000 m 23 -34 d
- -20 176 d -23 -73 d cl s 0 0.2 0.8 c 877 981 m 5 4 d -6 -1 d f 0 0.4 0.8 c 882
- 985 m 18 15 d -20 67 d -15 -12 d 11 -71 d f 0 0.6 0.8 c 880 1067 m 2 Y -24 48 d
- 9 -62 d f black 877 981 m 23 19 d -20 69 d -24 48 d cl s 0 0.2 0.8 c 853 948 m
- 24 33 d -1 3 d -34 3 d f 0 0.4 0.8 c 876 984 m -11 71 d -23 3 d -9 -41 d 9 -30
- d f 0 0.6 0.8 c 865 1055 m -9 62 d -14 -59 d f black 853 948 m 24 33 d -21 136
- d -23 -100 d cl s 0 0 0.8 c 830 888 m 9 24 d -12 X f 0 0.2 0.8 c 839 912 m 14
- 36 d -11 39 d -23 -7 d 8 -68 d f 0 0.4 0.8 c 842 987 m -9 30 d -17 34 d -5 -3 d
- 8 -68 d f 0 0.6 0.8 c 816 1051 m -7 14 d 2 -17 d f black 830 888 m 23 60 d -20
- 69 d -24 48 d cl s 0 0 0.8 c 823 908 m 7 -20 d -3 24 d f 0 0.2 0.8 c 806 963 m
- 17 -55 d 4 4 d -8 68 d -13 -14 d f 0 0.4 0.8 c 819 980 m -8 68 d -14 -13 d 9
- -69 d f 0 0.6 0.8 c 811 1048 m -2 17 d -16 43 d -5 -4 d 9 -69 d f 0 0.8 0.8 c
- 793 1108 m -7 18 d 2 -22 d f black 806 963 m 24 -75 d -21 177 d -23 61 d cl s 0
- 0 0.8 c 783 836 m 12 65 d -27 14 d -6 -64 d f 0 0.2 0.8 c 795 901 m 11 62 d 3 Y
- -33 12 d -5 -63 d f 0 0.4 0.8 c 806 966 m -9 69 d -18 7 d -6 -64 d f 0 0.6 0.8
- c 797 1035 m -9 69 d -4 1 d -5 -63 d f 0 0.8 0.8 c 788 1104 m -2 22 d -2 -21 d
- f black 783 836 m 23 127 d -20 163 d -24 -275 d cl s 0 0 0.8 c 759 830 m 24 6 d
- -21 15 d -23 -6 d f black 759 830 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 736
- 824 m 23 6 d -20 15 d -24 -6 d f black 736 824 m 23 6 d -20 15 d -24 -6 d cl s
- 0 0 0.8 c 712 818 m 24 6 d -21 15 d -23 -6 d f black 712 818 m 24 6 d -21 15 d
- -23 -6 d cl s 0 0 0.8 c 1813 1077 m 23 6 d -20 16 d -23 -6 d f black 1813 1077
- m 23 6 d -20 16 d -23 -6 d cl s 0 0 0.8 c 1789 1071 m 24 6 d -20 16 d -24 -6 d
- f black 1789 1071 m 24 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1766 1065 m 23 6 d
- -20 16 d -23 -6 d f black 1766 1065 m 23 6 d -20 16 d -23 -6 d cl s 0 0 0.8 c
- 1742 1100 m 24 -35 d -20 16 d -10 60 d 2 -16 d f 0 0.2 0.8 c 1736 1141 m -10 59
- d 1 -4 d 11 -71 d f 0 0.4 0.8 c 1726 1200 m -4 23 d 5 -27 d f black 1742 1100 m
- 24 -35 d -20 16 d -24 142 d cl s 0 0 0.8 c 1719 1107 m 23 -7 d -4 25 d -22 -7 d
- f 0 0.2 0.8 c 1738 1125 m -11 71 d -25 -2 d -3 -4 d 17 -72 d f 0 0.4 0.8 c 1727
- 1196 m -5 27 d -20 -29 d f black 1719 1107 m 23 -7 d -20 123 d -23 -33 d cl s 0
- 0 0.8 c 1717 1115 m 2 -8 d -3 11 d f 0 0.2 0.8 c 1705 1174 m 12 -59 d -1 3 d
- -17 72 d -24 -20 d 5 13 d f 0 0.4 0.8 c 1695 1222 m 10 -48 d -25 9 d f black
- 1695 1222 m 24 -115 d -20 83 d -24 -20 d cl s 0 0 0.8 c 1672 1082 m 4 23 d -11
- 4 d f 0 0.2 0.8 c 1676 1105 m 11 64 d -7 14 d -5 -13 d -23 -5 d 13 -56 d f 0
- 0.4 0.8 c 1687 1169 m 8 53 d -15 -39 d f black 1672 1082 m 23 140 d -20 -52 d
- -23 -5 d cl s 0 0 0.8 c 1648 1076 m 24 6 d -7 27 d -20 -9 d f 0 0.2 0.8 c 1665
- 1109 m -13 56 d -8 14 d -10 -8 d 11 -71 d f 0 0.4 0.8 c 1644 1179 m -16 33 d 6
- -41 d f black 1648 1076 m 24 6 d -20 83 d -24 47 d cl s 0 0 0.8 c 1629 1093 m
- 19 -17 d -3 24 d f 0 0.2 0.8 c 1625 1097 m 4 -4 d 16 7 d -11 71 d -18 -11 d f 0
- 0.4 0.8 c 1634 1171 m -6 41 d -15 22 d -6 -4 d 9 -70 d f 0 0.6 0.8 c 1613 1234
- m -8 13 d 2 -17 d f black 1625 1097 m 23 -21 d -20 136 d -23 35 d cl s 0 0.2
- 0.8 c 1602 1104 m 23 -7 d -9 63 d -28 5 d -7 -32 d f 0 0.4 0.8 c 1616 1160 m -9
- 70 d -6 1 d -13 -66 d f 0 0.6 0.8 c 1607 1230 m -2 17 d -4 -16 d f black 1602
- 1104 m 23 -7 d -20 150 d -24 -114 d cl s 0 0 0.8 c 1578 1058 m 13 25 d -17 X f
- 0 0.2 0.8 c 1591 1083 m 11 21 d -21 29 d -13 27 d -6 -6 d 12 -71 d f 0 0.4 0.8
- c 1568 1160 m -10 21 d 4 -27 d f black 1578 1058 m 24 46 d -21 29 d -23 48 d
- cl s 0 0 0.8 c 1565 1076 m 13 -18 d -4 25 d f 0 0.2 0.8 c 1555 1092 m 10 -16 d
- 9 7 d -12 71 d -24 -6 d f 0 0.4 0.8 c 1562 1154 m -4 27 d -24 -20 d 4 -13 d f
- black 1555 1092 m 23 -34 d -20 123 d -24 -20 d cl s 0 0.2 0.8 c 1531 1100 m 24
- -8 d -17 56 d -13 1 d -14 -20 d f 0 0.4 0.8 c 1538 1148 m -4 13 d -9 -12 d f
- black 1531 1100 m 24 -8 d -21 69 d -23 -32 d cl s 0 0 0.8 c 1508 1026 m 12 39 d
- -20 3 d f 0 0.2 0.8 c 1520 1065 m 11 35 d -20 29 d -24 7 d 13 -68 d f black
- 1508 1026 m 23 74 d -20 29 d -24 7 d cl s 0 0 0.8 c 1484 1007 m 24 19 d -8 42 d
- -23 -7 d f 0 0.2 0.8 c 1500 1068 m -13 68 d -3 3 d -17 -8 d 10 -70 d f 0 0.4
- 0.8 c 1484 1139 m -20 18 d 3 -26 d f black 1484 1007 m 24 19 d -21 110 d -23 21
- d cl s 0 0 0.8 c 1470 1052 m 14 -45 d -7 54 d -35 5 d -2 -9 d 4 5 d f 0 0.2 0.8
- c 1461 1082 m 9 -30 d 7 9 d -10 70 d -9 1 d -16 -66 d 2 -4 d f 0 0.4 0.8 c 1467
- 1131 m -3 26 d -6 -25 d f black 1461 1082 m 23 -75 d -20 150 d -24 -100 d cl s
- 0 0 0.8 c 1444 1062 m -4 -5 d -7 6 d f 0 0.2 0.8 c 1437 1049 m 24 33 d -17 -20
- d -11 1 d -16 15 d f black 1437 1049 m 24 33 d -21 -25 d -23 21 d cl s 0 0.2
- 0.8 c 1414 1097 m 23 -48 d -20 29 d -24 21 d f black 1414 1097 m 23 -48 d -20
- 29 d -24 21 d cl s 0 0 0.8 c 1390 1010 m 6 23 d -23 15 d -3 -9 d f 0 0.2 0.8 c
- 1396 1033 m 18 64 d -21 2 d -20 -51 d f black 1390 1010 m 24 87 d -21 2 d -23
- -60 d cl s 0 0 0.8 c 1367 1004 m 23 6 d -20 29 d -5 7 d -7 -14 d f 0 0.2 0.8 c
- 1365 1046 m -19 27 d 12 -41 d f black 1367 1004 m 23 6 d -20 29 d -24 34 d cl s
- 0 0 0.8 c 1348 1021 m 19 -17 d -9 28 d f 0 0.2 0.8 c 1343 1025 m 5 -4 d 10 11 d
- -12 41 d -23 -6 d f black 1343 1025 m 24 -21 d -21 69 d -23 -6 d cl s 0 0.2 0.8
- c 1320 1059 m 23 -34 d -20 42 d -18 26 d 2 -7 d f 0 0.4 0.8 c 1305 1093 m -6 9
- d 8 -16 d f black 1320 1059 m 23 -34 d -20 42 d -24 35 d cl s 0 0.2 0.8 c 1296
- 1040 m 24 19 d -13 27 d -15 -12 d f 0 0.4 0.8 c 1307 1086 m -8 16 d -13 48 d -4
- -7 d 10 -69 d f 0 0.6 0.8 c 1286 1150 m -10 40 d 6 -47 d f black 1296 1040 m 24
- 19 d -21 43 d -23 88 d cl s 0 0.2 0.8 c 1273 1047 m 23 -7 d -4 34 d -26 -5 d f
- 0 0.4 0.8 c 1292 1074 m -10 69 d -21 1 d -9 -27 d 14 -48 d f 0 0.6 0.8 c 1282
- 1143 m -6 47 d -15 -46 d f black 1273 1047 m 23 -7 d -20 150 d -24 -73 d cl s 0
- 0 0.8 c 1249 974 m 8 24 d -16 4 d f 0 0.2 0.8 c 1257 998 m 16 49 d -7 22 d -27
- 7 d -10 -33 d 12 -41 d f 0 0.4 0.8 c 1266 1069 m -14 48 d -13 -41 d f black
- 1249 974 m 24 73 d -21 70 d -23 -74 d cl s 0 0 0.8 c 1240 994 m 9 -20 d -8 28 d
- f 0 0.2 0.8 c 1226 1022 m 14 -28 d 1 8 d -12 41 d -24 -6 d f black 1226 1022 m
- 23 -48 d -20 69 d -24 -6 d cl s 0 0.2 0.8 c 1202 1029 m 24 -7 d -21 15 d -10 28
- d 1 -14 d f 0 0.4 0.8 c 1195 1065 m -13 34 d 14 -48 d f black 1202 1029 m 24 -7
- d -21 15 d -23 62 d cl s 0 0 0.8 c 1179 943 m 10 38 d -16 1 d f 0 0.2 0.8 c
- 1189 981 m 13 48 d -6 22 d -32 X 9 -69 d f 0 0.4 0.8 c 1196 1051 m -14 48 d -24
- -6 d 6 -42 d f black 1179 943 m 23 86 d -20 70 d -24 -6 d cl s 0 0 0.8 c 1158
- 973 m 21 -30 d -6 39 d f 0 0.2 0.8 c 1155 977 m 3 -4 d 15 9 d -9 69 d -20 -9 d
- f 0 0.4 0.8 c 1164 1051 m -6 42 d -23 7 d 9 -58 d f black 1155 977 m 24 -34 d
- -21 150 d -23 7 d cl s 0 0.2 0.8 c 1132 985 m 23 -8 d -11 65 d -29 -1 d f 0 0.4
- 0.8 c 1144 1042 m -9 58 d -24 -46 d 4 -13 d f black 1132 985 m 23 -8 d -20 123
- d -24 -46 d cl s 0 0.2 0.8 c 1108 992 m 24 -7 d -17 56 d -22 -7 d f 0 0.4 0.8 c
- 1115 1041 m -4 13 d -23 -6 d 5 -14 d f black 1108 992 m 24 -7 d -21 69 d -23 -6
- d cl s 0 0.2 0.8 c 1085 986 m 23 6 d -15 42 d -15 -13 d f 0 0.4 0.8 c 1093 1034
- m -5 14 d -23 46 d 13 -73 d f 0 0.6 0.8 c 1065 1094 m -1 2 d 1 -2 d f black
- 1085 986 m 23 6 d -20 56 d -24 48 d cl s 0 0.2 0.8 c 1067 1012 m 18 -26 d -7 35
- d f 0 0.4 0.8 c 1061 1020 m 6 -8 d 11 9 d -13 73 d -2 X -22 -45 d f 0 0.6 0.8 c
- 1065 1094 m -1 2 d -1 -2 d f black 1061 1020 m 24 -34 d -21 110 d -23 -47 d
- cl s 0 0 0.8 c 1038 920 m 5 24 d -8 X f 0 0.2 0.8 c 1043 944 m 16 66 d -32 2 d
- 8 -68 d f 0 0.4 0.8 c 1059 1010 m 2 10 d -20 29 d -17 35 d -5 -3 d 8 -69 d f 0
- 0.6 0.8 c 1024 1084 m -7 13 d 2 -16 d f black 1038 920 m 23 100 d -20 29 d -24
- 48 d cl s 0 0 0.8 c 1014 901 m 24 19 d -3 24 d -30 -1 d f 0 0.2 0.8 c 1035 944
- m -8 68 d -29 3 d -4 -18 d 11 -54 d f 0 0.4 0.8 c 1027 1012 m -8 69 d -5 X -16
- -66 d f 0 0.6 0.8 c 1019 1081 m -2 16 d -3 -16 d f black 1014 901 m 24 19 d -21
- 177 d -23 -100 d cl s 0 0 0.8 c 1005 934 m 9 -33 d -9 42 d f 0 0.2 0.8 c 991
- 989 m 14 -55 d 9 Y -11 54 d -24 -6 d f black 991 989 m 23 -88 d -20 96 d -24 -6
- d cl s 0 0.2 0.8 c 967 956 m 24 33 d -21 2 d -4 16 d -5 -16 d f 0 0.4 0.8 c 966
- 1007 m -19 57 d 14 -73 d f 0 0.6 0.8 c 947 1064 m 2 Y -2 Y f black 967 956 m 24
- 33 d -21 2 d -23 75 d cl s 0 0.2 0.8 c 944 977 m 23 -21 d -6 35 d -30 7 d -8
- -32 d f 0 0.4 0.8 c 961 991 m -14 73 d -16 -66 d f 0 0.6 0.8 c 947 1064 m 2 Y
- -2 Y f black 944 977 m 23 -21 d -20 110 d -24 -100 d cl s 0 0 0.8 c 920 904 m 3
- 9 d -5 1 d f 0 0.2 0.8 c 923 913 m 21 64 d -21 -11 d -17 25 d -3 -3 d 15 -74 d
- f 0 0.4 0.8 c 906 991 m -6 9 d 3 -12 d f black 920 904 m 24 73 d -21 -11 d -23
- 34 d cl s 0 0 0.8 c 897 884 m 23 20 d -2 10 d -27 -3 d f 0 0.2 0.8 c 918 914 m
- -15 74 d -21 -3 d -5 -4 d 14 -70 d f 0 0.4 0.8 c 903 988 m -3 12 d -18 -15 d f
- black 897 884 m 23 20 d -20 96 d -23 -19 d cl s 0 0 0.8 c 878 901 m 19 -17 d -6
- 27 d f 0 0.2 0.8 c 873 905 m 5 -4 d 13 10 d -14 70 d -24 -33 d f black 873 905
- m 24 -21 d -20 97 d -24 -33 d cl s 0 0 0.8 c 839 912 m -9 -24 d 11 13 d f 0 0.2
- 0.8 c 850 913 m 23 -8 d -20 43 d -14 -36 d 2 -11 d f black 850 913 m 23 -8 d
- -20 43 d -23 -60 d cl s 0 0 0.8 c 826 880 m 8 10 d 7 11 d -11 -13 d -7 20 d 1
- -18 d f 0 0.2 0.8 c 834 890 m 16 23 d -9 -12 d -18 7 d -17 55 d 18 -73 d f
- black 826 880 m 24 33 d -20 -25 d -24 75 d cl s 0 0 0.8 c 803 820 m 23 60 d -2
- 10 d -29 11 d -12 -65 d f 0 0.2 0.8 c 824 890 m -18 73 d -11 -62 d f black 803
- 820 m 23 60 d -20 83 d -23 -127 d cl s 0 0 0.8 c 779 814 m 24 6 d -20 16 d -24
- -6 d f black 779 814 m 24 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 756 808 m 23 6 d
- -20 16 d -23 -6 d f black 756 808 m 23 6 d -20 16 d -23 -6 d cl s 0 0 0.8 c 732
- 802 m 24 6 d -20 16 d -24 -6 d f black 732 802 m 24 6 d -20 16 d -24 -6 d cl s
- 0 0 0.8 c 1833 1062 m 24 6 d -21 15 d -23 -6 d f black 1833 1062 m 24 6 d -21
- 15 d -23 -6 d cl s 0 0 0.8 c 1810 1056 m 23 6 d -20 15 d -24 -6 d f black 1810
- 1056 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1786 1050 m 24 6 d -21 15 d -23
- -6 d f black 1786 1050 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 1763 1098 m 23
- -48 d -20 15 d -24 35 d f black 1763 1098 m 23 -48 d -20 15 d -24 35 d cl s 0 0
- 0.8 c 1739 1078 m 24 20 d -21 2 d -23 7 d f black 1739 1078 m 24 20 d -21 2 d
- -23 7 d cl s 0 0 0.8 c 1716 1072 m 23 6 d -20 29 d -2 8 d -4 -18 d f 0 0.2 0.8
- c 1717 1115 m -12 59 d -2 -8 d 10 -69 d f 0 0.4 0.8 c 1705 1174 m -10 48 d 8
- -56 d f black 1716 1072 m 23 6 d -20 29 d -24 115 d cl s 0 0 0.8 c 1692 1066 m
- 24 6 d -3 25 d -37 8 d -4 -23 d f 0 0.2 0.8 c 1713 1097 m -10 69 d -16 3 d -11
- -64 d f 0 0.4 0.8 c 1703 1166 m -8 56 d -8 -53 d f black 1692 1066 m 24 6 d -21
- 150 d -23 -140 d cl s 0 0 0.8 c 1669 1074 m 23 -8 d -20 16 d -24 -6 d f black
- 1669 1074 m 23 -8 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1645 1068 m 24 6 d -21 2 d
- -19 17 d 4 -7 d f 0 0.2 0.8 c 1629 1093 m -4 4 d 8 -11 d f black 1645 1068 m 24
- 6 d -21 2 d -23 21 d cl s 0 0 0.8 c 1622 1035 m 23 33 d -12 18 d -24 -6 d f 0
- 0.2 0.8 c 1633 1086 m -8 11 d -23 7 d 7 -24 d f black 1622 1035 m 23 33 d -20
- 29 d -23 7 d cl s 0 0 0.8 c 1606 1066 m 16 -31 d -13 45 d -18 3 d -13 -25 d 11
- 13 d f 0 0.2 0.8 c 1598 1083 m 8 -17 d 3 14 d -7 24 d -11 -21 d -2 -12 d f
- black 1598 1083 m 24 -48 d -20 69 d -24 -46 d cl s 0 0 0.8 c 1575 1050 m 7 10 d
- 7 11 d -11 -13 d -13 18 d 4 -13 d f 0 0.2 0.8 c 1582 1060 m 16 23 d -9 -12 d
- -24 5 d -10 16 d 14 -29 d f black 1575 1050 m 23 33 d -20 -25 d -23 34 d cl s 0
- 0 0.8 c 1551 1017 m 24 33 d -6 13 d -28 -3 d f 0 0.2 0.8 c 1569 1063 m -14 29 d
- -24 8 d 10 -40 d f black 1551 1017 m 24 33 d -20 42 d -24 8 d cl s 0 0 0.8 c
- 1528 1038 m 23 -21 d -10 43 d -21 5 d -12 -39 d f 0 0.2 0.8 c 1541 1060 m -10
- 40 d -11 -35 d f black 1528 1038 m 23 -21 d -20 83 d -23 -74 d cl s 0 0 0.8 c
- 1521 1044 m 7 -6 d -20 -12 d -24 -19 d 15 38 d f 0 0.2 0.8 c 1504 1059 m 17 -15
- d -22 1 d f black 1504 1059 m 24 -21 d -20 -12 d -24 -19 d cl s 0 0 0.8 c 1481
- 999 m 15 39 d 3 7 d -15 -38 d -14 45 d -10 Y f 0 0.2 0.8 c 1496 1038 m 8 21 d
- -5 -14 d -29 7 d -9 30 d 9 -40 d f black 1481 999 m 23 60 d -20 -52 d -23 75 d
- cl s 0 0 0.8 c 1457 980 m 24 19 d -11 43 d -31 X f 0 0.2 0.8 c 1470 1042 m -9
- 40 d -24 -33 d 2 -7 d f black 1457 980 m 24 19 d -20 83 d -24 -33 d cl s 0 0
- 0.8 c 1434 987 m 23 -7 d -18 62 d -13 -14 d f 0 0.2 0.8 c 1439 1042 m -2 7 d
- -23 48 d 12 -69 d f black 1434 987 m 23 -7 d -20 69 d -23 48 d cl s 0 0 0.8 c
- 1410 994 m 24 -7 d -8 41 d -30 5 d -6 -23 d f 0 0.2 0.8 c 1426 1028 m -12 69 d
- -18 -64 d f black 1410 994 m 24 -7 d -20 110 d -24 -87 d cl s 0 0 0.8 c 1387
- 975 m 23 19 d -20 16 d -23 -6 d f black 1387 975 m 23 19 d -20 16 d -23 -6 d
- cl s 0 0 0.8 c 1363 956 m 24 19 d -20 29 d -19 17 d -3 -3 d f 0 0.2 0.8 c 1348
- 1021 m -5 4 d 2 -7 d f black 1363 956 m 24 19 d -20 29 d -24 21 d cl s 0 0 0.8
- c 1340 990 m 23 -34 d -18 62 d -8 -17 d f 0 0.2 0.8 c 1345 1018 m -2 7 d -23 34
- d 17 -58 d f black 1340 990 m 23 -34 d -20 69 d -23 34 d cl s 0 0 0.8 c 1325
- 995 m 15 -5 d -3 11 d f 0 0.2 0.8 c 1317 997 m 8 -2 d 12 6 d -17 58 d -24 -19 d
- f black 1317 997 m 23 -7 d -20 69 d -24 -19 d cl s 0 0.2 0.8 c 1293 991 m 24 6
- d -21 43 d -23 7 d f black 1293 991 m 24 6 d -21 43 d -23 7 d cl s 0 0 0.8 c
- 1270 972 m 14 12 d -27 14 d -8 -24 d f 0 0.2 0.8 c 1284 984 m 9 7 d -20 56 d
- -16 -49 d f black 1270 972 m 23 19 d -20 56 d -24 -73 d cl s 0 0 0.8 c 1265 979
- m 5 -7 d -21 2 d -9 20 d f 0 0.2 0.8 c 1246 1006 m 19 -27 d -25 15 d -14 28 d f
- black 1246 1006 m 24 -34 d -21 2 d -23 48 d cl s 0 0 0.8 c 1223 960 m 4 10 d -8
- 1 d f 0 0.2 0.8 c 1227 970 m 19 36 d -20 16 d -24 7 d 17 -58 d f black 1223 960
- m 23 46 d -20 16 d -24 7 d cl s 0 0 0.8 c 1199 914 m 24 46 d -4 11 d -30 10 d
- -10 -38 d f 0 0.2 0.8 c 1219 971 m -17 58 d -13 -48 d f black 1199 914 m 24 46
- d -21 69 d -23 -86 d cl s 0 0 0.8 c 1176 908 m 23 6 d -20 29 d -21 30 d -1 -2 d
- f 0 0.2 0.8 c 1158 973 m -3 4 d 2 -6 d f black 1176 908 m 23 6 d -20 29 d -24
- 34 d cl s 0 0 0.8 c 1152 929 m 24 -21 d -19 63 d -16 -12 d f 0 0.2 0.8 c 1157
- 971 m -2 6 d -23 8 d 9 -26 d f black 1152 929 m 24 -21 d -21 69 d -23 8 d cl s
- 0 0 0.8 c 1129 923 m 23 6 d -11 30 d -21 -8 d f 0 0.2 0.8 c 1141 959 m -9 26 d
- -24 7 d 12 -41 d f black 1129 923 m 23 6 d -20 56 d -24 7 d cl s 0 0 0.8 c 1105
- 930 m 24 -7 d -9 28 d -19 -9 d f 0 0.2 0.8 c 1120 951 m -12 41 d -23 -6 d 16
- -44 d f black 1105 930 m 24 -7 d -21 69 d -23 -6 d cl s 0 0 0.8 c 1090 935 m 15
- -5 d -4 12 d f 0 0.2 0.8 c 1082 938 m 8 -3 d 11 7 d -16 44 d -18 26 d -3 -4 d f
- 0 0.4 0.8 c 1067 1012 m -6 8 d 3 -12 d f black 1082 938 m 23 -8 d -20 56 d -24
- 34 d cl s 0 0 0.8 c 1058 905 m 19 26 d -34 13 d -5 -24 d f 0 0.2 0.8 c 1077 931
- m 5 7 d -18 70 d -5 2 d -16 -66 d f 0 0.4 0.8 c 1064 1008 m -3 12 d -2 -10 d f
- black 1058 905 m 24 33 d -21 82 d -23 -100 d cl s 0 0 0.8 c 1035 912 m 23 -7 d
- -20 15 d -24 -19 d f black 1035 912 m 23 -7 d -20 15 d -24 -19 d cl s 0 0 0.8 c
- 1020 917 m 15 -5 d -21 -11 d -9 33 d f 0 0.2 0.8 c 1011 920 m 9 -3 d -15 17 d
- -14 55 d f black 1011 920 m 24 -8 d -21 -11 d -23 88 d cl s 0 0 0.8 c 988 873 m
- 20 41 d -31 3 d f 0 0.2 0.8 c 1008 914 m 3 6 d -20 69 d -24 -33 d 10 -39 d f
- black 988 873 m 23 47 d -20 69 d -24 -33 d cl s 0 0 0.8 c 964 854 m 24 19 d -11
- 44 d -22 -7 d f 0 0.2 0.8 c 977 917 m -10 39 d -23 21 d 11 -67 d f black 964
- 854 m 24 19 d -21 83 d -23 21 d cl s 0 0 0.8 c 941 848 m 23 6 d -9 56 d -32 3 d
- -3 -9 d f 0 0.2 0.8 c 955 910 m -11 67 d -21 -64 d f black 941 848 m 23 6 d -20
- 123 d -24 -73 d cl s 0 0 0.8 c 919 891 m 22 -43 d -21 56 d -23 -20 d 16 10 d f
- 0 0.2 0.8 c 917 896 m 2 -5 d -6 3 d f black 917 896 m 24 -48 d -21 56 d -23 -20
- d cl s 0 0 0.8 c 894 876 m 14 13 d 5 5 d -16 -10 d -19 17 d 3 -7 d f 0 0.2 0.8
- c 908 889 m 9 7 d -4 -2 d -35 7 d -5 4 d 8 -11 d f black 894 876 m 23 20 d -20
- -12 d -24 21 d cl s 0 0 0.8 c 870 857 m 24 19 d -13 18 d -22 -7 d f 0 0.2 0.8 c
- 881 894 m -8 11 d -23 8 d 9 -26 d f black 870 857 m 24 19 d -21 29 d -23 8 d
- cl s 0 0 0.8 c 847 851 m 23 6 d -11 30 d -25 3 d -8 -10 d f 0 0.2 0.8 c 859 887
- m -9 26 d -16 -23 d f black 847 851 m 23 6 d -20 56 d -24 -33 d cl s 0 0 0.8 c
- 823 805 m 24 46 d -21 29 d -23 -60 d f black 823 805 m 24 46 d -21 29 d -23 -60
- d cl s 0 0 0.8 c 800 799 m 23 6 d -20 15 d -24 -6 d f black 800 799 m 23 6 d
- -20 15 d -24 -6 d cl s 0 0 0.8 c 776 793 m 24 6 d -21 15 d -23 -6 d f black 776
- 793 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 753 787 m 23 6 d -20 15 d -24 -6
- d f black 753 787 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1854 1046 m 23 6 d
- -20 16 d -24 -6 d f black 1854 1046 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c
- 1830 1040 m 24 6 d -21 16 d -23 -6 d f black 1830 1040 m 24 6 d -21 16 d -23 -6
- d cl s 0 0 0.8 c 1807 1034 m 23 6 d -20 16 d -24 -6 d f black 1807 1034 m 23 6
- d -20 16 d -24 -6 d cl s 0 0 0.8 c 1789 1092 m 18 -58 d -21 16 d -23 48 d 6 3 d
- f 0 0.2 0.8 c 1783 1109 m 6 -17 d -20 9 d f black 1783 1109 m 24 -75 d -21 16 d
- -23 48 d cl s 0 0 0.8 c 1760 1022 m 18 67 d -9 12 d -6 -3 d -24 -20 d f 0 0.2
- 0.8 c 1778 1089 m 5 20 d -14 -8 d f black 1760 1022 m 23 87 d -20 -11 d -24 -20
- d cl s 0 0 0.8 c 1736 1016 m 24 6 d -21 56 d -23 -6 d f black 1736 1016 m 24 6
- d -21 56 d -23 -6 d cl s 0 0 0.8 c 1713 1051 m 23 -35 d -20 56 d -24 -6 d f
- black 1713 1051 m 23 -35 d -20 56 d -24 -6 d cl s 0 0 0.8 c 1689 1018 m 24 33 d
- -21 15 d -23 8 d f black 1689 1018 m 24 33 d -21 15 d -23 8 d cl s 0 0 0.8 c
- 1666 998 m 23 20 d -20 56 d -24 -6 d f black 1666 998 m 23 20 d -20 56 d -24 -6
- d cl s 0 0 0.8 c 1642 1033 m 24 -35 d -21 70 d -23 -33 d f black 1642 1033 m 24
- -35 d -21 70 d -23 -33 d cl s 0 0 0.8 c 1619 1013 m 23 20 d -20 2 d -16 31 d -1
- -7 d f 0 0.2 0.8 c 1606 1066 m -8 17 d 7 -24 d f black 1619 1013 m 23 20 d -20
- 2 d -24 48 d cl s 0 0 0.8 c 1595 994 m 24 19 d -14 46 d -23 1 d -7 -10 d f 0
- 0.2 0.8 c 1605 1059 m -7 24 d -16 -23 d f black 1595 994 m 24 19 d -21 70 d -23
- -33 d cl s 0 0 0.8 c 1572 1001 m 23 -7 d -20 56 d -24 -33 d f black 1572 1001 m
- 23 -7 d -20 56 d -24 -33 d cl s 0 0 0.8 c 1548 995 m 24 6 d -21 16 d -23 21 d f
- black 1548 995 m 24 6 d -21 16 d -23 21 d cl s 0 0 0.8 c 1525 963 m 23 32 d -20
- 43 d -7 6 d -12 -7 d f 0 0.2 0.8 c 1521 1044 m -17 15 d 5 -22 d f black 1525
- 963 m 23 32 d -20 43 d -24 21 d cl s 0 0 0.8 c 1501 970 m 24 -7 d -16 74 d -13
- 1 d -15 -39 d f 0 0.2 0.8 c 1509 1037 m -5 22 d -8 -21 d f black 1501 970 m 24
- -7 d -21 96 d -23 -60 d cl s 0 0 0.8 c 1478 977 m 23 -7 d -20 29 d -24 -19 d f
- black 1478 977 m 23 -7 d -20 29 d -24 -19 d cl s 0 0 0.8 c 1454 958 m 24 19 d
- -21 3 d -23 7 d f black 1454 958 m 24 19 d -21 3 d -23 7 d cl s 0 0 0.8 c 1431
- 966 m 23 -8 d -20 29 d -24 7 d f black 1431 966 m 23 -8 d -20 29 d -24 7 d cl s
- 0 0 0.8 c 1407 933 m 24 33 d -21 28 d -23 -19 d f black 1407 933 m 24 33 d -21
- 28 d -23 -19 d cl s 0 0 0.8 c 1384 940 m 23 -7 d -20 42 d -24 -19 d f black
- 1384 940 m 23 -7 d -20 42 d -24 -19 d cl s 0 0 0.8 c 1360 948 m 24 -8 d -21 16
- d -23 34 d f black 1360 948 m 24 -8 d -21 16 d -23 34 d cl s 0 0 0.8 c 1337 915
- m 23 33 d -20 42 d -15 5 d -7 -4 d f 0 0.2 0.8 c 1325 995 m -8 2 d 1 -6 d f
- black 1337 915 m 23 33 d -20 42 d -23 7 d cl s 0 0 0.8 c 1313 936 m 24 -21 d
- -19 76 d -22 -7 d f 0 0.2 0.8 c 1318 991 m -1 6 d -24 -6 d 3 -7 d f black 1313
- 936 m 24 -21 d -20 82 d -24 -6 d cl s 0 0 0.8 c 1290 916 m 23 20 d -17 48 d -12
- X -14 -12 d f 0 0.2 0.8 c 1296 984 m -3 7 d -9 -7 d f black 1290 916 m 23 20 d
- -20 55 d -23 -19 d cl s 0 0 0.8 c 1266 910 m 24 6 d -20 56 d -5 7 d -11 -11 d f
- 0 0.2 0.8 c 1265 979 m -19 27 d 8 -38 d f black 1266 910 m 24 6 d -20 56 d -24
- 34 d cl s 0 0 0.8 c 1243 931 m 23 -21 d -12 58 d -27 2 d -4 -10 d f 0 0.2 0.8 c
- 1254 968 m -8 38 d -19 -36 d f black 1243 931 m 23 -21 d -20 96 d -23 -46 d
- cl s 0 0 0.8 c 1219 898 m 24 33 d -20 29 d -24 -46 d f black 1219 898 m 24 33 d
- -20 29 d -24 -46 d cl s 0 0 0.8 c 1196 906 m 23 -8 d -20 16 d -23 -6 d f black
- 1196 906 m 23 -8 d -20 16 d -23 -6 d cl s 0 0 0.8 c 1172 900 m 24 6 d -20 2 d
- -24 21 d f black 1172 900 m 24 6 d -20 2 d -24 21 d cl s 0 0 0.8 c 1149 880 m
- 23 20 d -20 29 d -23 -6 d f black 1149 880 m 23 20 d -20 29 d -23 -6 d cl s 0 0
- 0.8 c 1125 888 m 24 -8 d -20 43 d -24 7 d f black 1125 888 m 24 -8 d -20 43 d
- -24 7 d cl s 0 0 0.8 c 1102 882 m 23 6 d -20 42 d -15 5 d -6 -4 d f 0 0.2 0.8 c
- 1090 935 m -8 3 d 2 -7 d f black 1102 882 m 23 6 d -20 42 d -23 8 d cl s 0 0
- 0.8 c 1078 876 m 24 6 d -18 49 d -7 X -19 -26 d f 0 0.2 0.8 c 1084 931 m -2 7 d
- -5 -7 d f black 1078 876 m 24 6 d -20 56 d -24 -33 d cl s 0 0 0.8 c 1055 870 m
- 23 6 d -20 29 d -23 7 d f black 1055 870 m 23 6 d -20 29 d -23 7 d cl s 0 0 0.8
- c 1031 864 m 24 6 d -20 42 d -15 5 d -6 -4 d f 0 0.2 0.8 c 1020 917 m -9 3 d 3
- -7 d f black 1031 864 m 24 6 d -20 42 d -24 8 d cl s 0 0 0.8 c 1008 871 m 23 -7
- d -17 49 d -6 1 d -20 -41 d f 0 0.2 0.8 c 1014 913 m -3 7 d -3 -6 d f black
- 1008 871 m 23 -7 d -20 56 d -23 -47 d cl s 0 0 0.8 c 985 852 m 23 19 d -20 2 d
- -24 -19 d f black 985 852 m 23 19 d -20 2 d -24 -19 d cl s 0 0 0.8 c 961 859 m
- 24 -7 d -21 2 d -23 -6 d f black 961 859 m 24 -7 d -21 2 d -23 -6 d cl s 0 0
- 0.8 c 938 827 m 23 32 d -20 -11 d -22 43 d -2 Y f 0 0.2 0.8 c 919 891 m -2 5 d
- 2 -7 d f black 938 827 m 23 32 d -20 -11 d -24 48 d cl s 0 0 0.8 c 914 821 m 24
- 6 d -19 62 d -11 X -14 -13 d f 0 0.2 0.8 c 919 889 m -2 7 d -9 -7 d f black 914
- 821 m 24 6 d -21 69 d -23 -20 d cl s 0 0 0.8 c 891 841 m 23 -20 d -20 55 d -24
- -19 d f black 891 841 m 23 -20 d -20 55 d -24 -19 d cl s 0 0 0.8 c 867 822 m 24
- 19 d -21 16 d -23 -6 d f black 867 822 m 24 19 d -21 16 d -23 -6 d cl s 0 0 0.8
- c 844 789 m 23 33 d -20 29 d -24 -46 d f black 844 789 m 23 33 d -20 29 d -24
- -46 d cl s 0 0 0.8 c 820 783 m 24 6 d -21 16 d -23 -6 d f black 820 783 m 24 6
- d -21 16 d -23 -6 d cl s 0 0 0.8 c 797 777 m 23 6 d -20 16 d -24 -6 d f black
- 797 777 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 773 771 m 24 6 d -21 16 d -23
- -6 d f black 773 771 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1874 1031 m 23 6
- d -20 15 d -23 -6 d f black 1874 1031 m 23 6 d -20 15 d -23 -6 d cl s 0 0 0.8 c
- 1850 1025 m 24 6 d -20 15 d -24 -6 d f black 1850 1025 m 24 6 d -20 15 d -24 -6
- d cl s 0 0 0.8 c 1827 1019 m 23 6 d -20 15 d -23 -6 d f black 1827 1019 m 23 6
- d -20 15 d -23 -6 d cl s 0 0 0.8 c 1803 1026 m 24 -7 d -20 15 d -18 58 d -6 Y f
- 0 0.2 0.8 c 1789 1092 m -6 17 d 6 -23 d f black 1803 1026 m 24 -7 d -20 15 d
- -24 75 d cl s 0 0 0.8 c 1780 1020 m 23 6 d -14 60 d -11 3 d -18 -67 d f 0 0.2
- 0.8 c 1789 1086 m -6 23 d -5 -20 d f black 1780 1020 m 23 6 d -20 83 d -23 -87
- d cl s 0 0 0.8 c 1757 1001 m 23 19 d -20 2 d -24 -6 d f black 1757 1001 m 23 19
- d -20 2 d -24 -6 d cl s 0 0 0.8 c 1733 1008 m 24 -7 d -21 15 d -23 35 d f black
- 1733 1008 m 24 -7 d -21 15 d -23 35 d cl s 0 0 0.8 c 1710 989 m 23 19 d -20 43
- d -24 -33 d f black 1710 989 m 23 19 d -20 43 d -24 -33 d cl s 0 0 0.8 c 1686
- 983 m 24 6 d -21 29 d -23 -20 d f black 1686 983 m 24 6 d -21 29 d -23 -20 d
- cl s 0 0 0.8 c 1663 977 m 23 6 d -20 15 d -24 35 d f black 1663 977 m 23 6 d
- -20 15 d -24 35 d cl s 0 0 0.8 c 1639 971 m 24 6 d -21 56 d -23 -20 d f black
- 1639 971 m 24 6 d -21 56 d -23 -20 d cl s 0 0 0.8 c 1616 978 m 23 -7 d -20 42 d
- -24 -19 d f black 1616 978 m 23 -7 d -20 42 d -24 -19 d cl s 0 0 0.8 c 1592 972
- m 24 6 d -21 16 d -23 7 d f black 1592 972 m 24 6 d -21 16 d -23 7 d cl s 0 0
- 0.8 c 1569 953 m 23 19 d -20 29 d -24 -6 d f black 1569 953 m 23 19 d -20 29 d
- -24 -6 d cl s 0 0 0.8 c 1545 947 m 24 6 d -21 42 d -23 -32 d f black 1545 947 m
- 24 6 d -21 42 d -23 -32 d cl s 0 0 0.8 c 1522 941 m 23 6 d -20 16 d -24 7 d f
- black 1522 941 m 23 6 d -20 16 d -24 7 d cl s 0 0 0.8 c 1498 935 m 24 6 d -21
- 29 d -23 7 d f black 1498 935 m 24 6 d -21 29 d -23 7 d cl s 0 0 0.8 c 1475 943
- m 23 -8 d -20 42 d -24 -19 d f black 1475 943 m 23 -8 d -20 42 d -24 -19 d cl s
- 0 0 0.8 c 1451 937 m 24 6 d -21 15 d -23 8 d f black 1451 937 m 24 6 d -21 15 d
- -23 8 d cl s 0 0 0.8 c 1428 917 m 23 20 d -20 29 d -24 -33 d f black 1428 917 m
- 23 20 d -20 29 d -24 -33 d cl s 0 0 0.8 c 1404 925 m 24 -8 d -21 16 d -23 7 d f
- black 1404 925 m 24 -8 d -21 16 d -23 7 d cl s 0 0 0.8 c 1381 945 m 23 -20 d
- -20 15 d -24 8 d f black 1381 945 m 23 -20 d -20 15 d -24 8 d cl s 0 0 0.8 c
- 1357 926 m 24 19 d -21 3 d -23 -33 d f black 1357 926 m 24 19 d -21 3 d -23 -33
- d cl s 0 0 0.8 c 1334 920 m 23 6 d -20 -11 d -24 21 d f black 1334 920 m 23 6 d
- -20 -11 d -24 21 d cl s 0 0 0.8 c 1310 928 m 24 -8 d -21 16 d -23 -20 d f black
- 1310 928 m 24 -8 d -21 16 d -23 -20 d cl s 0 0 0.8 c 1287 881 m 23 47 d -20 -12
- d -24 -6 d f black 1287 881 m 23 47 d -20 -12 d -24 -6 d cl s 0 0 0.8 c 1263
- 889 m 24 -8 d -21 29 d -23 21 d f black 1263 889 m 24 -8 d -21 29 d -23 21 d
- cl s 0 0 0.8 c 1240 883 m 23 6 d -20 42 d -24 -33 d f black 1240 883 m 23 6 d
- -20 42 d -24 -33 d cl s 0 0 0.8 c 1216 877 m 24 6 d -21 15 d -23 8 d f black
- 1216 877 m 24 6 d -21 15 d -23 8 d cl s 0 0 0.8 c 1193 857 m 23 20 d -20 29 d
- -24 -6 d f black 1193 857 m 23 20 d -20 29 d -24 -6 d cl s 0 0 0.8 c 1169 851 m
- 24 6 d -21 43 d -23 -20 d f black 1169 851 m 24 6 d -21 43 d -23 -20 d cl s 0 0
- 0.8 c 1146 859 m 23 -8 d -20 29 d -24 8 d f black 1146 859 m 23 -8 d -20 29 d
- -24 8 d cl s 0 0 0.8 c 1122 853 m 24 6 d -21 29 d -23 -6 d f black 1122 853 m
- 24 6 d -21 29 d -23 -6 d cl s 0 0 0.8 c 1099 833 m 23 20 d -20 29 d -24 -6 d f
- black 1099 833 m 23 20 d -20 29 d -24 -6 d cl s 0 0 0.8 c 1075 827 m 24 6 d -21
- 43 d -23 -6 d f black 1075 827 m 24 6 d -21 43 d -23 -6 d cl s 0 0 0.8 c 1052
- 862 m 23 -35 d -20 43 d -24 -6 d f black 1052 862 m 23 -35 d -20 43 d -24 -6 d
- cl s 0 0 0.8 c 1028 815 m 24 47 d -21 2 d -23 7 d f black 1028 815 m 24 47 d
- -21 2 d -23 7 d cl s 0 0 0.8 c 1005 810 m 23 5 d -20 56 d -23 -19 d f black
- 1005 810 m 23 5 d -20 56 d -23 -19 d cl s 0 0 0.8 c 981 804 m 24 6 d -20 42 d
- -24 7 d f black 981 804 m 24 6 d -20 42 d -24 7 d cl s 0 0 0.8 c 958 798 m 23 6
- d -20 55 d -23 -32 d f black 958 798 m 23 6 d -20 55 d -23 -32 d cl s 0 0 0.8 c
- 934 792 m 24 6 d -20 29 d -24 -6 d f black 934 792 m 24 6 d -20 29 d -24 -6 d
- cl s 0 0 0.8 c 911 786 m 23 6 d -20 29 d -23 20 d f black 911 786 m 23 6 d -20
- 29 d -23 20 d cl s 0 0 0.8 c 887 780 m 24 6 d -20 55 d -24 -19 d f black 887
- 780 m 24 6 d -20 55 d -24 -19 d cl s 0 0 0.8 c 864 774 m 23 6 d -20 42 d -23
- -33 d f black 864 774 m 23 6 d -20 42 d -23 -33 d cl s 0 0 0.8 c 840 768 m 24 6
- d -20 15 d -24 -6 d f black 840 768 m 24 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c
- 817 762 m 23 6 d -20 15 d -23 -6 d f black 817 762 m 23 6 d -20 15 d -23 -6 d
- cl s 0 0 0.8 c 793 756 m 24 6 d -20 15 d -24 -6 d f black 793 756 m 24 6 d -20
- 15 d -24 -6 d cl s 0 0 0.8 c 1894 1015 m 24 6 d -21 16 d -23 -6 d f black 1894
- 1015 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1871 1009 m 23 6 d -20 16 d -24
- -6 d f black 1871 1009 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1847 1003 m 24
- 6 d -21 16 d -23 -6 d f black 1847 1003 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8
- c 1824 997 m 23 6 d -20 16 d -24 7 d f black 1824 997 m 23 6 d -20 16 d -24 7 d
- cl s 0 0 0.8 c 1800 991 m 24 6 d -21 29 d -23 -6 d f black 1800 991 m 24 6 d
- -21 29 d -23 -6 d cl s 0 0 0.8 c 1777 999 m 23 -8 d -20 29 d -23 -19 d f black
- 1777 999 m 23 -8 d -20 29 d -23 -19 d cl s 0 0 0.8 c 1753 993 m 24 6 d -20 2 d
- -24 7 d f black 1753 993 m 24 6 d -20 2 d -24 7 d cl s 0 0 0.8 c 1730 973 m 23
- 20 d -20 15 d -23 -19 d f black 1730 973 m 23 20 d -20 15 d -23 -19 d cl s 0 0
- 0.8 c 1706 967 m 24 6 d -20 16 d -24 -6 d f black 1706 967 m 24 6 d -20 16 d
- -24 -6 d cl s 0 0 0.8 c 1683 988 m 23 -21 d -20 16 d -23 -6 d f black 1683 988
- m 23 -21 d -20 16 d -23 -6 d cl s 0 0 0.8 c 1659 955 m 24 33 d -20 -11 d -24 -6
- d f black 1659 955 m 24 33 d -20 -11 d -24 -6 d cl s 0 0 0.8 c 1636 949 m 23 6
- d -20 16 d -23 7 d f black 1636 949 m 23 6 d -20 16 d -23 7 d cl s 0 0 0.8 c
- 1612 943 m 24 6 d -20 29 d -24 -6 d f black 1612 943 m 24 6 d -20 29 d -24 -6 d
- cl s 0 0 0.8 c 1589 937 m 23 6 d -20 29 d -23 -19 d f black 1589 937 m 23 6 d
- -20 29 d -23 -19 d cl s 0 0 0.8 c 1565 932 m 24 5 d -20 16 d -24 -6 d f black
- 1565 932 m 24 5 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1542 926 m 23 6 d -20 15 d
- -23 -6 d f black 1542 926 m 23 6 d -20 15 d -23 -6 d cl s 0 0 0.8 c 1518 933 m
- 24 -7 d -20 15 d -24 -6 d f black 1518 933 m 24 -7 d -20 15 d -24 -6 d cl s 0 0
- 0.8 c 1495 914 m 23 19 d -20 2 d -23 8 d f black 1495 914 m 23 19 d -20 2 d -23
- 8 d cl s 0 0 0.8 c 1471 921 m 24 -7 d -20 29 d -24 -6 d f black 1471 921 m 24
- -7 d -20 29 d -24 -6 d cl s 0 0 0.8 c 1448 902 m 23 19 d -20 16 d -23 -20 d f
- black 1448 902 m 23 19 d -20 16 d -23 -20 d cl s 0 0 0.8 c 1425 909 m 23 -7 d
- -20 15 d -24 8 d f black 1425 909 m 23 -7 d -20 15 d -24 8 d cl s 0 0 0.8 c
- 1401 917 m 24 -8 d -21 16 d -23 20 d f black 1401 917 m 24 -8 d -21 16 d -23 20
- d cl s 0 0 0.8 c 1378 884 m 23 33 d -20 28 d -24 -19 d f black 1378 884 m 23 33
- d -20 28 d -24 -19 d cl s 0 0 0.8 c 1354 878 m 24 6 d -21 42 d -23 -6 d f black
- 1354 878 m 24 6 d -21 42 d -23 -6 d cl s 0 0 0.8 c 1331 872 m 23 6 d -20 42 d
- -24 8 d f black 1331 872 m 23 6 d -20 42 d -24 8 d cl s 0 0 0.8 c 1307 866 m 24
- 6 d -21 56 d -23 -47 d f black 1307 866 m 24 6 d -21 56 d -23 -47 d cl s 0 0
- 0.8 c 1284 860 m 23 6 d -20 15 d -24 8 d f black 1284 860 m 23 6 d -20 15 d -24
- 8 d cl s 0 0 0.8 c 1260 854 m 24 6 d -21 29 d -23 -6 d f black 1260 854 m 24 6
- d -21 29 d -23 -6 d cl s 0 0 0.8 c 1237 861 m 23 -7 d -20 29 d -24 -6 d f black
- 1237 861 m 23 -7 d -20 29 d -24 -6 d cl s 0 0 0.8 c 1213 842 m 24 19 d -21 16 d
- -23 -20 d f black 1213 842 m 24 19 d -21 16 d -23 -20 d cl s 0 0 0.8 c 1190 836
- m 23 6 d -20 15 d -24 -6 d f black 1190 836 m 23 6 d -20 15 d -24 -6 d cl s 0 0
- 0.8 c 1166 843 m 24 -7 d -21 15 d -23 8 d f black 1166 843 m 24 -7 d -21 15 d
- -23 8 d cl s 0 0 0.8 c 1143 824 m 23 19 d -20 16 d -24 -6 d f black 1143 824 m
- 23 19 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1119 818 m 24 6 d -21 29 d -23 -20 d f
- black 1119 818 m 24 6 d -21 29 d -23 -20 d cl s 0 0 0.8 c 1096 812 m 23 6 d -20
- 15 d -24 -6 d f black 1096 812 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1072
- 819 m 24 -7 d -21 15 d -23 35 d f black 1072 819 m 24 -7 d -21 15 d -23 35 d
- cl s 0 0 0.8 c 1049 800 m 23 19 d -20 43 d -24 -47 d f black 1049 800 m 23 19 d
- -20 43 d -24 -47 d cl s 0 0 0.8 c 1025 807 m 24 -7 d -21 15 d -23 -5 d f black
- 1025 807 m 24 -7 d -21 15 d -23 -5 d cl s 0 0 0.8 c 1002 788 m 23 19 d -20 3 d
- -24 -6 d f black 1002 788 m 23 19 d -20 3 d -24 -6 d cl s 0 0 0.8 c 978 782 m
- 24 6 d -21 16 d -23 -6 d f black 978 782 m 24 6 d -21 16 d -23 -6 d cl s 0 0
- 0.8 c 955 776 m 23 6 d -20 16 d -24 -6 d f black 955 776 m 23 6 d -20 16 d -24
- -6 d cl s 0 0 0.8 c 931 770 m 24 6 d -21 16 d -23 -6 d f black 931 770 m 24 6 d
- -21 16 d -23 -6 d cl s 0 0 0.8 c 908 764 m 23 6 d -20 16 d -24 -6 d f black 908
- 764 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 884 758 m 24 6 d -21 16 d -23 -6
- d f black 884 758 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 861 752 m 23 6 d
- -20 16 d -24 -6 d f black 861 752 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 837
- 746 m 24 6 d -21 16 d -23 -6 d f black 837 746 m 24 6 d -21 16 d -23 -6 d cl s
- 0 0 0.8 c 814 740 m 23 6 d -20 16 d -24 -6 d f black 814 740 m 23 6 d -20 16 d
- -24 -6 d cl s 0 0 0.8 c 1915 1000 m 23 6 d -20 15 d -24 -6 d f black 1915 1000
- m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1891 994 m 24 6 d -21 15 d -23 -6 d f
- black 1891 994 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 1868 988 m 23 6 d -20
- 15 d -24 -6 d f black 1868 988 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1844
- 982 m 24 6 d -21 15 d -23 -6 d f black 1844 982 m 24 6 d -21 15 d -23 -6 d cl s
- 0 0 0.8 c 1821 976 m 23 6 d -20 15 d -24 -6 d f black 1821 976 m 23 6 d -20 15
- d -24 -6 d cl s 0 0 0.8 c 1797 970 m 24 6 d -21 15 d -23 8 d f black 1797 970 m
- 24 6 d -21 15 d -23 8 d cl s 0 0 0.8 c 1774 964 m 23 6 d -20 29 d -24 -6 d f
- black 1774 964 m 23 6 d -20 29 d -24 -6 d cl s 0 0 0.8 c 1750 971 m 24 -7 d -21
- 29 d -23 -20 d f black 1750 971 m 24 -7 d -21 29 d -23 -20 d cl s 0 0 0.8 c
- 1727 952 m 23 19 d -20 2 d -24 -6 d f black 1727 952 m 23 19 d -20 2 d -24 -6 d
- cl s 0 0 0.8 c 1703 946 m 24 6 d -21 15 d -23 21 d f black 1703 946 m 24 6 d
- -21 15 d -23 21 d cl s 0 0 0.8 c 1680 940 m 23 6 d -20 42 d -24 -33 d f black
- 1680 940 m 23 6 d -20 42 d -24 -33 d cl s 0 0 0.8 c 1656 934 m 24 6 d -21 15 d
- -23 -6 d f black 1656 934 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 1633 928 m
- 23 6 d -20 15 d -24 -6 d f black 1633 928 m 23 6 d -20 15 d -24 -6 d cl s 0 0
- 0.8 c 1609 922 m 24 6 d -21 15 d -23 -6 d f black 1609 922 m 24 6 d -21 15 d
- -23 -6 d cl s 0 0 0.8 c 1586 916 m 23 6 d -20 15 d -24 -5 d f black 1586 916 m
- 23 6 d -20 15 d -24 -5 d cl s 0 0 0.8 c 1562 910 m 24 6 d -21 16 d -23 -6 d f
- black 1562 910 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1539 904 m 23 6 d -20
- 16 d -24 7 d f black 1539 904 m 23 6 d -20 16 d -24 7 d cl s 0 0 0.8 c 1515 898
- m 24 6 d -21 29 d -23 -19 d f black 1515 898 m 24 6 d -21 29 d -23 -19 d cl s 0
- 0 0.8 c 1492 892 m 23 6 d -20 16 d -24 7 d f black 1492 892 m 23 6 d -20 16 d
- -24 7 d cl s 0 0 0.8 c 1468 886 m 24 6 d -21 29 d -23 -19 d f black 1468 886 m
- 24 6 d -21 29 d -23 -19 d cl s 0 0 0.8 c 1445 880 m 23 6 d -20 16 d -23 7 d f
- black 1445 880 m 23 6 d -20 16 d -23 7 d cl s 0 0 0.8 c 1421 874 m 24 6 d -20
- 29 d -24 8 d f black 1421 874 m 24 6 d -20 29 d -24 8 d cl s 0 0 0.8 c 1398 868
- m 23 6 d -20 43 d -23 -33 d f black 1398 868 m 23 6 d -20 43 d -23 -33 d cl s 0
- 0 0.8 c 1374 862 m 24 6 d -20 16 d -24 -6 d f black 1374 862 m 24 6 d -20 16 d
- -24 -6 d cl s 0 0 0.8 c 1351 870 m 23 -8 d -20 16 d -23 -6 d f black 1351 870 m
- 23 -8 d -20 16 d -23 -6 d cl s 0 0 0.8 c 1327 850 m 24 20 d -20 2 d -24 -6 d f
- black 1327 850 m 24 20 d -20 2 d -24 -6 d cl s 0 0 0.8 c 1304 844 m 23 6 d -20
- 16 d -23 -6 d f black 1304 844 m 23 6 d -20 16 d -23 -6 d cl s 0 0 0.8 c 1280
- 838 m 24 6 d -20 16 d -24 -6 d f black 1280 838 m 24 6 d -20 16 d -24 -6 d cl s
- 0 0 0.8 c 1257 846 m 23 -8 d -20 16 d -23 7 d f black 1257 846 m 23 -8 d -20 16
- d -23 7 d cl s 0 0 0.8 c 1233 826 m 24 20 d -20 15 d -24 -19 d f black 1233 826
- m 24 20 d -20 15 d -24 -19 d cl s 0 0 0.8 c 1210 820 m 23 6 d -20 16 d -23 -6 d
- f black 1210 820 m 23 6 d -20 16 d -23 -6 d cl s 0 0 0.8 c 1186 814 m 24 6 d
- -20 16 d -24 7 d f black 1186 814 m 24 6 d -20 16 d -24 7 d cl s 0 0 0.8 c 1163
- 808 m 23 6 d -20 29 d -23 -19 d f black 1163 808 m 23 6 d -20 29 d -23 -19 d
- cl s 0 0 0.8 c 1139 802 m 24 6 d -20 16 d -24 -6 d f black 1139 802 m 24 6 d
- -20 16 d -24 -6 d cl s 0 0 0.8 c 1116 796 m 23 6 d -20 16 d -23 -6 d f black
- 1116 796 m 23 6 d -20 16 d -23 -6 d cl s 0 0 0.8 c 1093 790 m 23 6 d -20 16 d
- -24 7 d f black 1093 790 m 23 6 d -20 16 d -24 7 d cl s 0 0 0.8 c 1069 784 m 24
- 6 d -21 29 d -23 -19 d f black 1069 784 m 24 6 d -21 29 d -23 -19 d cl s 0 0
- 0.8 c 1046 778 m 23 6 d -20 16 d -24 7 d f black 1046 778 m 23 6 d -20 16 d -24
- 7 d cl s 0 0 0.8 c 1022 772 m 24 6 d -21 29 d -23 -19 d f black 1022 772 m 24 6
- d -21 29 d -23 -19 d cl s 0 0 0.8 c 999 766 m 23 6 d -20 16 d -24 -6 d f black
- 999 766 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 975 760 m 24 6 d -21 16 d -23
- -6 d f black 975 760 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 952 755 m 23 5 d
- -20 16 d -24 -6 d f black 952 755 m 23 5 d -20 16 d -24 -6 d cl s 0 0 0.8 c 928
- 749 m 24 6 d -21 15 d -23 -6 d f black 928 749 m 24 6 d -21 15 d -23 -6 d cl s
- 0 0 0.8 c 905 743 m 23 6 d -20 15 d -24 -6 d f black 905 743 m 23 6 d -20 15 d
- -24 -6 d cl s 0 0 0.8 c 881 737 m 24 6 d -21 15 d -23 -6 d f black 881 737 m 24
- 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 858 731 m 23 6 d -20 15 d -24 -6 d f black
- 858 731 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 834 725 m 24 6 d -21 15 d -23
- -6 d f black 834 725 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 1935 984 m 23 6
- d -20 16 d -23 -6 d f black 1935 984 m 23 6 d -20 16 d -23 -6 d cl s 0 0 0.8 c
- 1911 978 m 24 6 d -20 16 d -24 -6 d f black 1911 978 m 24 6 d -20 16 d -24 -6 d
- cl s 0 0 0.8 c 1888 972 m 23 6 d -20 16 d -23 -6 d f black 1888 972 m 23 6 d
- -20 16 d -23 -6 d cl s 0 0 0.8 c 1865 966 m 23 6 d -20 16 d -24 -6 d f black
- 1865 966 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1841 960 m 24 6 d -21 16 d
- -23 -6 d f black 1841 960 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1818 954 m
- 23 6 d -20 16 d -24 -6 d f black 1818 954 m 23 6 d -20 16 d -24 -6 d cl s 0 0
- 0.8 c 1794 948 m 24 6 d -21 16 d -23 -6 d f black 1794 948 m 24 6 d -21 16 d
- -23 -6 d cl s 0 0 0.8 c 1771 942 m 23 6 d -20 16 d -24 7 d f black 1771 942 m
- 23 6 d -20 16 d -24 7 d cl s 0 0 0.8 c 1747 936 m 24 6 d -21 29 d -23 -19 d f
- black 1747 936 m 24 6 d -21 29 d -23 -19 d cl s 0 0 0.8 c 1724 930 m 23 6 d -20
- 16 d -24 -6 d f black 1724 930 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1700
- 924 m 24 6 d -21 16 d -23 -6 d f black 1700 924 m 24 6 d -21 16 d -23 -6 d cl s
- 0 0 0.8 c 1677 918 m 23 6 d -20 16 d -24 -6 d f black 1677 918 m 23 6 d -20 16
- d -24 -6 d cl s 0 0 0.8 c 1653 912 m 24 6 d -21 16 d -23 -6 d f black 1653 912
- m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1630 906 m 23 6 d -20 16 d -24 -6 d f
- black 1630 906 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1606 900 m 24 6 d -21
- 16 d -23 -6 d f black 1606 900 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1583
- 894 m 23 6 d -20 16 d -24 -6 d f black 1583 894 m 23 6 d -20 16 d -24 -6 d cl s
- 0 0 0.8 c 1559 888 m 24 6 d -21 16 d -23 -6 d f black 1559 888 m 24 6 d -21 16
- d -23 -6 d cl s 0 0 0.8 c 1536 882 m 23 6 d -20 16 d -24 -6 d f black 1536 882
- m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1512 877 m 24 5 d -21 16 d -23 -6 d f
- black 1512 877 m 24 5 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1489 884 m 23 -7 d -20
- 15 d -24 -6 d f black 1489 884 m 23 -7 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1465
- 865 m 24 19 d -21 2 d -23 -6 d f black 1465 865 m 24 19 d -21 2 d -23 -6 d cl s
- 0 0 0.8 c 1442 859 m 23 6 d -20 15 d -24 -6 d f black 1442 859 m 23 6 d -20 15
- d -24 -6 d cl s 0 0 0.8 c 1418 853 m 24 6 d -21 15 d -23 -6 d f black 1418 853
- m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 1395 847 m 23 6 d -20 15 d -24 -6 d f
- black 1395 847 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1371 841 m 24 6 d -21
- 15 d -23 8 d f black 1371 841 m 24 6 d -21 15 d -23 8 d cl s 0 0 0.8 c 1348 835
- m 23 6 d -20 29 d -24 -20 d f black 1348 835 m 23 6 d -20 29 d -24 -20 d cl s 0
- 0 0.8 c 1324 829 m 24 6 d -21 15 d -23 -6 d f black 1324 829 m 24 6 d -21 15 d
- -23 -6 d cl s 0 0 0.8 c 1301 823 m 23 6 d -20 15 d -24 -6 d f black 1301 823 m
- 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1277 817 m 24 6 d -21 15 d -23 8 d f
- black 1277 817 m 24 6 d -21 15 d -23 8 d cl s 0 0 0.8 c 1254 811 m 23 6 d -20
- 29 d -24 -20 d f black 1254 811 m 23 6 d -20 29 d -24 -20 d cl s 0 0 0.8 c 1230
- 805 m 24 6 d -21 15 d -23 -6 d f black 1230 805 m 24 6 d -21 15 d -23 -6 d cl s
- 0 0 0.8 c 1207 799 m 23 6 d -20 15 d -24 -6 d f black 1207 799 m 23 6 d -20 15
- d -24 -6 d cl s 0 0 0.8 c 1183 793 m 24 6 d -21 15 d -23 -6 d f black 1183 793
- m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 1160 787 m 23 6 d -20 15 d -24 -6 d f
- black 1160 787 m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1136 781 m 24 6 d -21
- 15 d -23 -6 d f black 1136 781 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 1113
- 775 m 23 6 d -20 15 d -23 -6 d f black 1113 775 m 23 6 d -20 15 d -23 -6 d cl s
- 0 0 0.8 c 1089 769 m 24 6 d -20 15 d -24 -6 d f black 1089 769 m 24 6 d -20 15
- d -24 -6 d cl s 0 0 0.8 c 1066 763 m 23 6 d -20 15 d -23 -6 d f black 1066 763
- m 23 6 d -20 15 d -23 -6 d cl s 0 0 0.8 c 1042 757 m 24 6 d -20 15 d -24 -6 d f
- black 1042 757 m 24 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1019 764 m 23 -7 d -20
- 15 d -23 -6 d f black 1019 764 m 23 -7 d -20 15 d -23 -6 d cl s 0 0 0.8 c 995
- 745 m 24 19 d -20 2 d -24 -6 d f black 995 745 m 24 19 d -20 2 d -24 -6 d cl s
- 0 0 0.8 c 972 739 m 23 6 d -20 15 d -23 -5 d f black 972 739 m 23 6 d -20 15 d
- -23 -5 d cl s 0 0 0.8 c 948 733 m 24 6 d -20 16 d -24 -6 d f black 948 733 m 24
- 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 925 727 m 23 6 d -20 16 d -23 -6 d f black
- 925 727 m 23 6 d -20 16 d -23 -6 d cl s 0 0 0.8 c 901 721 m 24 6 d -20 16 d -24
- -6 d f black 901 721 m 24 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 878 715 m 23 6 d
- -20 16 d -23 -6 d f black 878 715 m 23 6 d -20 16 d -23 -6 d cl s 0 0 0.8 c 854
- 709 m 24 6 d -20 16 d -24 -6 d f black 854 709 m 24 6 d -20 16 d -24 -6 d cl s
- 0 0 0.8 c 1955 969 m 24 6 d -21 15 d -23 -6 d f black 1955 969 m 24 6 d -21 15
- d -23 -6 d cl s 0 0 0.8 c 1932 963 m 23 6 d -20 15 d -24 -6 d f black 1932 963
- m 23 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1908 957 m 24 6 d -21 15 d -23 -6 d f
- black 1908 957 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 1885 951 m 23 6 d -20
- 15 d -23 -6 d f black 1885 951 m 23 6 d -20 15 d -23 -6 d cl s 0 0 0.8 c 1861
- 945 m 24 6 d -20 15 d -24 -6 d f black 1861 945 m 24 6 d -20 15 d -24 -6 d cl s
- 0 0 0.8 c 1838 952 m 23 -7 d -20 15 d -23 -6 d f black 1838 952 m 23 -7 d -20
- 15 d -23 -6 d cl s 0 0 0.8 c 1814 933 m 24 19 d -20 2 d -24 -6 d f black 1814
- 933 m 24 19 d -20 2 d -24 -6 d cl s 0 0 0.8 c 1791 927 m 23 6 d -20 15 d -23 -6
- d f black 1791 927 m 23 6 d -20 15 d -23 -6 d cl s 0 0 0.8 c 1767 921 m 24 6 d
- -20 15 d -24 -6 d f black 1767 921 m 24 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c
- 1744 915 m 23 6 d -20 15 d -23 -6 d f black 1744 915 m 23 6 d -20 15 d -23 -6 d
- cl s 0 0 0.8 c 1720 909 m 24 6 d -20 15 d -24 -6 d f black 1720 909 m 24 6 d
- -20 15 d -24 -6 d cl s 0 0 0.8 c 1697 903 m 23 6 d -20 15 d -23 -6 d f black
- 1697 903 m 23 6 d -20 15 d -23 -6 d cl s 0 0 0.8 c 1673 897 m 24 6 d -20 15 d
- -24 -6 d f black 1673 897 m 24 6 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1650 891 m
- 23 6 d -20 15 d -23 -6 d f black 1650 891 m 23 6 d -20 15 d -23 -6 d cl s 0 0
- 0.8 c 1626 885 m 24 6 d -20 15 d -24 -6 d f black 1626 885 m 24 6 d -20 15 d
- -24 -6 d cl s 0 0 0.8 c 1603 879 m 23 6 d -20 15 d -23 -6 d f black 1603 879 m
- 23 6 d -20 15 d -23 -6 d cl s 0 0 0.8 c 1579 886 m 24 -7 d -20 15 d -24 -6 d f
- black 1579 886 m 24 -7 d -20 15 d -24 -6 d cl s 0 0 0.8 c 1556 867 m 23 19 d
- -20 2 d -23 -6 d f black 1556 867 m 23 19 d -20 2 d -23 -6 d cl s 0 0 0.8 c
- 1533 861 m 23 6 d -20 15 d -24 -5 d f black 1533 861 m 23 6 d -20 15 d -24 -5 d
- cl s 0 0 0.8 c 1509 855 m 24 6 d -21 16 d -23 7 d f black 1509 855 m 24 6 d -21
- 16 d -23 7 d cl s 0 0 0.8 c 1486 849 m 23 6 d -20 29 d -24 -19 d f black 1486
- 849 m 23 6 d -20 29 d -24 -19 d cl s 0 0 0.8 c 1462 843 m 24 6 d -21 16 d -23
- -6 d f black 1462 843 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1439 837 m 23 6
- d -20 16 d -24 -6 d f black 1439 837 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c
- 1415 831 m 24 6 d -21 16 d -23 -6 d f black 1415 831 m 24 6 d -21 16 d -23 -6 d
- cl s 0 0 0.8 c 1392 825 m 23 6 d -20 16 d -24 -6 d f black 1392 825 m 23 6 d
- -20 16 d -24 -6 d cl s 0 0 0.8 c 1368 819 m 24 6 d -21 16 d -23 -6 d f black
- 1368 819 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1345 813 m 23 6 d -20 16 d
- -24 -6 d f black 1345 813 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1321 807 m
- 24 6 d -21 16 d -23 -6 d f black 1321 807 m 24 6 d -21 16 d -23 -6 d cl s 0 0
- 0.8 c 1298 801 m 23 6 d -20 16 d -24 -6 d f black 1298 801 m 23 6 d -20 16 d
- -24 -6 d cl s 0 0 0.8 c 1274 795 m 24 6 d -21 16 d -23 -6 d f black 1274 795 m
- 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1251 789 m 23 6 d -20 16 d -24 -6 d f
- black 1251 789 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1227 783 m 24 6 d -21
- 16 d -23 -6 d f black 1227 783 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1204
- 777 m 23 6 d -20 16 d -24 -6 d f black 1204 777 m 23 6 d -20 16 d -24 -6 d cl s
- 0 0 0.8 c 1180 771 m 24 6 d -21 16 d -23 -6 d f black 1180 771 m 24 6 d -21 16
- d -23 -6 d cl s 0 0 0.8 c 1157 765 m 23 6 d -20 16 d -24 -6 d f black 1157 765
- m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1133 759 m 24 6 d -21 16 d -23 -6 d f
- black 1133 759 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 1110 753 m 23 6 d -20
- 16 d -24 -6 d f black 1110 753 m 23 6 d -20 16 d -24 -6 d cl s 0 0 0.8 c 1086
- 747 m 24 6 d -21 16 d -23 -6 d f black 1086 747 m 24 6 d -21 16 d -23 -6 d cl s
- 0 0 0.8 c 1063 741 m 23 6 d -20 16 d -24 -6 d f black 1063 741 m 23 6 d -20 16
- d -24 -6 d cl s 0 0 0.8 c 1039 735 m 24 6 d -21 16 d -23 7 d f black 1039 735 m
- 24 6 d -21 16 d -23 7 d cl s 0 0 0.8 c 1016 729 m 23 6 d -20 29 d -24 -19 d f
- black 1016 729 m 23 6 d -20 29 d -24 -19 d cl s 0 0 0.8 c 992 723 m 24 6 d -21
- 16 d -23 -6 d f black 992 723 m 24 6 d -21 16 d -23 -6 d cl s 0 0 0.8 c 969 717
- m 23 6 d -20 16 d -24 -6 d f black 969 717 m 23 6 d -20 16 d -24 -6 d cl s 0 0
- 0.8 c 945 711 m 24 6 d -21 16 d -23 -6 d f black 945 711 m 24 6 d -21 16 d -23
- -6 d cl s 0 0 0.8 c 922 706 m 23 5 d -20 16 d -24 -6 d f black 922 706 m 23 5 d
- -20 16 d -24 -6 d cl s 0 0 0.8 c 898 700 m 24 6 d -21 15 d -23 -6 d f black 898
- 700 m 24 6 d -21 15 d -23 -6 d cl s 0 0 0.8 c 875 694 m 23 6 d -20 15 d -24 -6
- d f black 875 694 m 23 6 d -20 15 d -24 -6 d cl s 222 1180 m 651 -497 d s 873
- 683 m 994 Y s 222 2174 m 651 -497 d s 222 1180 m 994 Y s 873 683 m 1128 287 d s
- 2001 970 m 994 Y s 873 1677 m 1128 287 d s 873 1677 m cl s 873 683 m 1128 287 d
- s 967 673 m 34 Y s 991 696 m 17 Y s 1014 702 m 17 Y s 1038 708 m 17 Y s 1061
- 714 m 17 Y s 1085 703 m 34 Y s 1108 726 m 17 Y s 1132 732 m 17 Y s 1155 738 m
- 17 Y s 1179 744 m 17 Y s 1202 733 m 34 Y s 1226 756 m 16 Y s 1249 762 m 16 Y s
- 1273 768 m 16 Y s 1296 774 m 16 Y s 1320 763 m 33 Y s 1343 786 m 16 Y s 1367
- 792 m 16 Y s 1390 798 m 16 Y s 1413 804 m 16 Y s 1437 793 m 33 Y s 1460 816 m
- 16 Y s 1484 822 m 16 Y s 1507 828 m 16 Y s 1531 834 m 16 Y s 1554 823 m 33 Y s
- 1578 846 m 16 Y s 1601 851 m 17 Y s 1625 857 m 17 Y s 1648 863 m 17 Y s 1672
- 853 m 33 Y s 1695 875 m 17 Y s 1719 881 m 17 Y s 1742 887 m 17 Y s 1766 893 m
- 17 Y s 1789 883 m 33 Y s 1813 905 m 17 Y s 1836 911 m 17 Y s 1860 917 m 17 Y s
- 1883 923 m 17 Y s 1907 913 m 33 Y s 967 673 m 34 Y s 944 684 m 17 Y s 920 678 m
- 17 Y s 897 672 m 17 Y s 873 666 m 17 Y s 1907 913 m 33 Y s 1930 935 m 17 Y s
- 1954 941 m 17 Y s 1977 947 m 17 Y s 2001 953 m 17 Y s 970 654 m -5 -1 d -3 -4 d
- -1 -8 d -4 Y 1 -8 d 3 -4 d 5 -2 d 3 X 4 2 d 3 4 d 1 8 d 4 Y -1 8 d -3 4 d -4 1
- d -3 X cl s 1061 684 m -4 -1 d -3 -5 d -1 -7 d -4 Y 1 -8 d 3 -4 d 4 -2 d 3 X 5
- 2 d 3 4 d 1 8 d 4 Y -1 7 d -3 5 d -5 1 d -3 X cl s 1085 656 m -1 -1 d 1 -2 d 2
- 2 d -2 1 d cl s 1099 677 m 1 Y 1 3 d 1 2 d 3 1 d 6 X 3 -1 d 2 -2 d 1 -3 d -3 Y
- -1 -2 d -3 -5 d -15 -15 d 21 X s 1144 684 m -14 X -2 -13 d 2 2 d 4 1 d 5 X 4 -1
- d 3 -3 d 1 -5 d -3 Y -1 -4 d -3 -3 d -4 -2 d -5 X -4 2 d -2 1 d -1 3 d s 1190
- 714 m -5 -1 d -3 -5 d -1 -7 d -5 Y 1 -7 d 3 -4 d 5 -2 d 3 X 4 2 d 3 4 d 2 7 d 5
- Y -2 7 d -3 5 d -4 1 d -3 X cl s 1214 686 m -2 -1 d 2 -2 d 1 2 d -1 1 d cl s
- 1243 714 m -15 X -1 -13 d 1 1 d 5 2 d 4 X 5 -2 d 3 -3 d 1 -4 d -3 Y -1 -4 d -3
- -3 d -5 -2 d -4 X -5 2 d -1 1 d -2 3 d s 1296 744 m -4 -1 d -3 -5 d -2 -7 d -5
- Y 2 -7 d 3 -4 d 4 -2 d 3 X 5 2 d 3 4 d 1 7 d 5 Y -1 7 d -3 5 d -5 1 d -3 X cl s
- 1320 716 m -1 -1 d 1 -2 d 2 2 d -2 1 d cl s 1353 744 m -15 -31 d s 1332 744 m
- 21 X s 1379 744 m -14 X -2 -13 d 2 1 d 4 2 d 4 X 5 -2 d 3 -3 d 1 -4 d -3 Y -1
- -5 d -3 -2 d -5 -2 d -4 X -4 2 d -2 1 d -1 3 d s 1435 768 m 3 2 d 4 4 d -31 Y s
- 1527 798 m 3 2 d 4 4 d -31 Y s 1555 776 m -2 -2 d 2 -1 d 1 1 d -1 2 d cl s 1568
- 797 m 1 Y 2 3 d 1 1 d 3 2 d 6 X 3 -2 d 2 -1 d 1 -3 d -3 Y -1 -3 d -3 -4 d -15
- -15 d 21 X s 1614 804 m -15 X -1 -13 d 1 1 d 5 2 d 4 X 5 -2 d 3 -3 d 1 -4 d -3
- Y -1 -5 d -3 -3 d -5 -1 d -4 X -5 1 d -1 2 d -2 3 d s 1655 828 m 3 1 d 5 5 d
- -31 Y s 1683 806 m -1 -2 d 1 -1 d 2 1 d -2 2 d cl s 1713 834 m -15 X -1 -13 d 1
- 1 d 5 1 d 4 X 5 -1 d 3 -3 d 1 -4 d -3 Y -1 -5 d -3 -3 d -5 -1 d -4 X -5 1 d -1
- 2 d -2 3 d s 1762 858 m 3 1 d 4 5 d -31 Y s 1790 836 m -2 -2 d 2 -1 d 1 1 d -1
- 2 d cl s 1822 864 m -14 -31 d s 1802 864 m 20 X s 1849 864 m -15 X -1 -14 d 1 2
- d 5 1 d 4 X 5 -1 d 3 -3 d 1 -5 d -2 Y -1 -5 d -3 -3 d -5 -1 d -4 X -5 1 d -1 2
- d -2 3 d s 1902 886 m 2 Y 1 3 d 2 1 d 3 2 d 6 X 3 -2 d 1 -1 d 1 -3 d -3 Y -1 -3
- d -3 -5 d -15 -14 d 21 X s 873 683 m -651 497 d s 873 649 m 34 Y s 857 679 m 16
- Y s 841 691 m 17 Y s 824 703 m 17 Y s 808 716 m 17 Y s 792 712 m 33 Y s 776 741
- m 16 Y s 759 753 m 17 Y s 743 766 m 16 Y s 727 778 m 17 Y s 711 774 m 33 Y s
- 694 803 m 17 Y s 678 815 m 17 Y s 662 828 m 16 Y s 645 840 m 17 Y s 629 836 m
- 33 Y s 613 865 m 17 Y s 597 877 m 17 Y s 580 890 m 17 Y s 564 902 m 17 Y s 548
- 898 m 33 Y s 532 927 m 17 Y s 515 940 m 16 Y s 499 952 m 17 Y s 483 964 m 17 Y
- s 466 960 m 33 Y s 450 989 m 17 Y s 434 1002 m 16 Y s 418 1014 m 17 Y s 401
- 1027 m 16 Y s 385 1022 m 34 Y s 369 1051 m 17 Y s 352 1064 m 16 Y s 336 1076 m
- 17 Y s 320 1089 m 16 Y s 304 1084 m 34 Y s 287 1114 m 16 Y s 271 1126 m 17 Y s
- 255 1138 m 17 Y s 239 1151 m 16 Y s 222 1147 m 33 Y s 873 649 m 34 Y s 826 573
- m 27 X s 865 583 m 2 Y 1 3 d 2 1 d 3 2 d 6 X 3 -2 d 1 -1 d 2 -3 d -3 Y -2 -3 d
- -3 -5 d -15 -15 d 21 X s 704 635 m 26 X s 745 647 m 3 1 d 5 5 d -31 Y s 773 625
- m -1 -2 d 1 -1 d 2 1 d -2 2 d cl s 803 653 m -15 X -1 -14 d 1 2 d 5 1 d 4 X 5
- -1 d 2 -3 d 2 -5 d -3 Y -2 -4 d -2 -3 d -5 -1 d -4 X -5 1 d -1 2 d -2 2 d s 663
- 697 m 27 X s 705 709 m 3 1 d 4 5 d -31 Y s 541 759 m 27 X s 587 777 m -5 -2 d
- -2 -4 d -2 -7 d -5 Y 2 -7 d 2 -5 d 5 -1 d 3 X 4 1 d 3 5 d 2 7 d 5 Y -2 7 d -3 4
- d -4 2 d -3 X cl s 611 749 m -2 -2 d 2 -1 d 1 1 d -1 2 d cl s 640 777 m -15 X
- -1 -13 d 1 1 d 5 2 d 4 X 5 -2 d 3 -3 d 1 -4 d -3 Y -1 -5 d -3 -3 d -5 -1 d -4 X
- -5 1 d -1 2 d -2 3 d s 537 839 m -5 -1 d -3 -5 d -1 -7 d -5 Y 1 -7 d 3 -5 d 5
- -1 d 3 X 4 1 d 3 5 d 2 7 d 5 Y -2 7 d -3 5 d -4 1 d -3 X cl s 414 901 m -4 -1 d
- -3 -5 d -2 -7 d -5 Y 2 -7 d 3 -4 d 4 -2 d 3 X 5 2 d 3 4 d 1 7 d 5 Y -1 7 d -3 5
- d -5 1 d -3 X cl s 438 873 m -1 -1 d 1 -2 d 2 2 d -2 1 d cl s 468 901 m -15 X
- -2 -13 d 2 1 d 4 2 d 5 X 4 -2 d 3 -3 d 2 -4 d -3 Y -2 -4 d -3 -3 d -4 -2 d -5 X
- -4 2 d -2 1 d -1 3 d s 370 957 m 3 2 d 4 4 d -31 Y s 247 1020 m 3 1 d 5 5 d -32
- Y s 275 997 m -1 -1 d 1 -2 d 2 2 d -2 1 d cl s 305 1026 m -15 X -1 -14 d 1 2 d
- 5 1 d 4 X 4 -1 d 3 -3 d 2 -5 d -3 Y -2 -4 d -3 -3 d -4 -2 d -4 X -5 2 d -1 1 d
- -2 3 d s 204 1080 m 2 Y 1 3 d 2 1 d 3 2 d 6 X 3 -2 d 1 -1 d 2 -3 d -3 Y -2 -3 d
- -3 -5 d -15 -14 d 21 X s 222 1180 m 994 Y s 189 1180 m 33 X s 206 1207 m 16 X s
- 206 1234 m 16 X s 206 1261 m 16 X s 206 1287 m 16 X s 189 1314 m 33 X s 206
- 1341 m 16 X s 206 1368 m 16 X s 206 1395 m 16 X s 206 1422 m 16 X s 189 1449 m
- 33 X s 206 1476 m 16 X s 206 1502 m 16 X s 206 1529 m 16 X s 206 1556 m 16 X s
- 189 1583 m 33 X s 206 1610 m 16 X s 206 1637 m 16 X s 206 1664 m 16 X s 206
- 1690 m 16 X s 189 1717 m 33 X s 206 1744 m 16 X s 206 1771 m 16 X s 206 1798 m
- 16 X s 206 1825 m 16 X s 189 1852 m 33 X s 206 1879 m 16 X s 206 1905 m 16 X s
- 206 1932 m 16 X s 206 1959 m 16 X s 189 1986 m 33 X s 206 2013 m 16 X s 206
- 2040 m 16 X s 206 2067 m 16 X s 206 2094 m 16 X s 189 2120 m 33 X s 189 2120 m
- 33 X s 206 2147 m 16 X s 150 1195 m -4 -1 d -3 -4 d -1 -8 d -4 Y 1 -8 d 3 -4 d
- 4 -2 d 3 X 5 2 d 3 4 d 1 8 d 4 Y -1 8 d -3 4 d -5 1 d -3 X cl s 116 1324 m 3 1
- d 5 5 d -31 Y s 150 1330 m -4 -2 d -3 -4 d -1 -7 d -5 Y 1 -7 d 3 -5 d 4 -1 d 3
- X 5 1 d 3 5 d 1 7 d 5 Y -1 7 d -3 4 d -5 2 d -3 X cl s 113 1457 m 1 Y 2 3 d 1 2
- d 3 1 d 6 X 3 -1 d 2 -2 d 1 -3 d -3 Y -1 -3 d -3 -4 d -15 -15 d 21 X s 150 1464
- m -4 -1 d -3 -5 d -1 -7 d -5 Y 1 -7 d 3 -4 d 4 -2 d 3 X 5 2 d 3 4 d 1 7 d 5 Y
- -1 7 d -3 5 d -5 1 d -3 X cl s 115 1599 m 16 X -9 -12 d 5 X 3 -2 d 1 -1 d 2 -5
- d -3 Y -2 -4 d -3 -3 d -4 -2 d -5 X -4 2 d -2 1 d -1 3 d s 150 1599 m -4 -2 d
- -3 -4 d -1 -8 d -4 Y 1 -8 d 3 -4 d 4 -2 d 3 X 5 2 d 3 4 d 1 8 d 4 Y -1 8 d -3 4
- d -5 2 d -3 X cl s 127 1733 m -15 -21 d 22 X s 127 1733 m -31 Y s 150 1733 m -4
- -2 d -3 -4 d -1 -7 d -5 Y 1 -7 d 3 -5 d 4 -1 d 3 X 5 1 d 3 5 d 1 7 d 5 Y -1 7 d
- -3 4 d -5 2 d -3 X cl s 130 1867 m -15 X -2 -13 d 2 1 d 4 2 d 5 X 4 -2 d 3 -3 d
- 2 -4 d -3 Y -2 -4 d -3 -3 d -4 -2 d -5 X -4 2 d -2 1 d -1 3 d s 150 1867 m -4
- -1 d -3 -5 d -1 -7 d -4 Y 1 -8 d 3 -4 d 4 -2 d 3 X 5 2 d 3 4 d 1 8 d 4 Y -1 7 d
- -3 5 d -5 1 d -3 X cl s 131 1997 m -1 3 d -5 2 d -3 X -4 -2 d -3 -4 d -2 -8 d
- -7 Y 2 -6 d 3 -3 d 4 -1 d 2 X 4 1 d 3 3 d 2 4 d 2 Y -2 4 d -3 3 d -4 2 d -2 X
- -4 -2 d -3 -3 d -2 -4 d s 150 2002 m -4 -2 d -3 -4 d -1 -8 d -4 Y 1 -8 d 3 -4 d
- 4 -1 d 3 X 5 1 d 3 4 d 1 8 d 4 Y -1 8 d -3 4 d -5 2 d -3 X cl s 133 2136 m -15
- -31 d s 112 2136 m 21 X s 150 2136 m -4 -1 d -3 -5 d -1 -7 d -5 Y 1 -7 d 3 -5 d
- 4 -1 d 3 X 5 1 d 3 5 d 1 7 d 5 Y -1 7 d -3 5 d -5 1 d -3 X cl s 1040 539 m 9
- -21 d s 1057 539 m -8 -21 d -3 -6 d -3 -3 d -3 -1 d -2 X s 1077 549 m 12 -31 d
- s 1100 549 m -11 -31 d s 1127 545 m -3 3 d -4 1 d -6 X -5 -1 d -3 -3 d -3 Y 2
- -3 d 1 -1 d 3 -2 d 9 -3 d 3 -1 d 2 -2 d 1 -3 d -4 Y -3 -3 d -4 -2 d -6 X -5 2 d
- -3 3 d s 1139 521 m -2 -1 d 2 -2 d 1 2 d -1 1 d cl s 1166 539 m 16 -21 d s 1182
- 539 m -16 -21 d s gr
-showpage
- gr
-%%Trailer
-%%Pages: 1
- gr gr
-%%EOF
diff --git a/src/pawlib/paw/testsuite/paw.commands/nt_pl_2d_surf2.ref.ps b/src/pawlib/paw/testsuite/paw.commands/nt_pl_2d_surf2.ref.ps
deleted file mode 100644
index cfa0268..0000000
--- a/src/pawlib/paw/testsuite/paw.commands/nt_pl_2d_surf2.ref.ps
+++ /dev/null
@@ -1,2512 +0,0 @@
-%!PS-Adobe-2.0
-%%Title: /disk3/maartenb/cerncvs/paw/testsuite/tmp/nt_pl_2d_ (Portrait A 4)
-%%Pages: (atend)
-%%Creator: HIGZ Version 1.23/06
-%%CreationDate: 96/04/16 14.49
-%%EndComments
-%%BeginProlog
-/s {stroke} def /l {lineto} def /m {moveto} def /t {translate} def
-/sw {stringwidth} def /r {rotate} def /rl {roll} def /R {repeat} def
-/d {rlineto} def /rm {rmoveto} def /gr {grestore} def /f {eofill} def
-/c {setrgbcolor} def /lw {setlinewidth} def /sd {setdash} def
-/cl {closepath} def /sf {scalefont setfont} def /black {0 setgray} def
-/box {m dup 0 exch d exch 0 d 0 exch neg d cl} def
-/NC{systemdict begin initclip end}def/C{NC box clip newpath}def
-/bl {box s} def /bf {box f} def /Y { 0 exch d} def /X { 0 d} def
-/mp {newpath /y exch def /x exch def} def
-/side {[w .77 mul w .23 mul] .385 w mul sd w 0 l currentpoint t -144 r} def
-/mr {mp x y w2 0 360 arc} def /m24 {mr s} def /m20 {mr f} def
-/mb {mp x y w2 add m w2 neg 0 d 0 w neg d w 0 d 0 w d cl} def
-/mt {mp x y w2 add m w2 neg w neg d w 0 d cl} def
-/m21 {mb f} def /m25 {mb s} def /m22 {mt f} def /m26 {mt s} def
-/m23 {mp x y w2 sub m w2 w d w neg 0 d cl f} def
-/m27 {mp x y w2 add m w3 neg w2 neg d w3 w2 neg d w3 w2 d cl s} def
-/m28 {mp x w2 sub y w2 sub w3 add m w3 0 d 0 w3 neg d w3 0 d 0 w3 d w3 0 d
- 0 w3 d w3 neg 0 d 0 w3 d w3 neg 0 d
- 0 w3 neg d w3 neg 0 d cl s } def
-/m29 {mp gsave x w2 sub y w2 add w3 sub m currentpoint t
- 4 {side} repeat cl fill gr} def
-/m30 {mp gsave x w2 sub y w2 add w3 sub m currentpoint t
- 5 {side} repeat s gr} def
-/m31 {mp x y w2 sub m 0 w d x w2 sub y m w 0 d
- x w2 sub y w2 add m w w neg d x w2 sub y w2
- sub m w w d s} def
-/m2 {mp x y w2 sub m 0 w d x w2 sub y m w 0 d s} def
-/m5 {mp x w2 sub y w2 sub m w w d x w2 sub y w2 add m w w neg d s} def
-/DP {/PT exch def gsave 47.2 47.2 scale PT 1 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < AA AA 55 55 AA AA 55 55 AA AA 55 55 AA AA 55 55 AA AA 55 55 AA AA 55 55
-AA AA 55 55 AA AA 55 55 > } image } if PT 2 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < BB BB EE EE BB BB EE EE BB BB EE EE BB BB EE EE BB BB EE EE BB BB EE EE
-BB BB EE EE BB BB EE EE > } image } if PT 3 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < FF FF BB BB FF FF EE EE FF FF BB BB FF FF EE EE FF FF BB BB FF FF EE EE
-FF FF BB BB FF FF EE EE > } image } if PT 4 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < DF DF BF BF 7F 7F FE FE FD FD FB FB F7 F7 EF EF DF DF BF BF 7F 7F FE FE
-FD FD FB FB F7 F7 EF EF > } image } if PT 5 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < 7F 7F BF B F DF DF EF EF F7 F7 FB FB FD FD FE FE 7F 7F BF BF DF DF EF
-EF F7 F7 FB FB FD FD FE FE > } image } if PT 6 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB
-BB BB BB BB BB BB BB BB BB > } image } if PT 7 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < FF FF FF FF FF FF 00 00 FF FF FF FF FF FF 00 00 FF FF FF FF FF FF 00
-00 FF FF FF FF FF FF 00 00 > } image } if PT 8 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < EE EE 47 47 83 83 C5 C5 EE EE 5C 5C 38 38 74 74 EE EE 47 47 83 83 C5
-C5 EE EE 5C 5C 38 38 74 74 > } image } if PT 9 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < EF EF EF EF D7 D7 38 38 FE FE FE FE 7D 7D 83 83 EF EF EF EF D7 D7 38
-38 FE FE FE FE 7D 7D 83 83 > } image } if PT 10 eq { 16 16 1 [ 16 0 0 16 neg
-0 16 ] { < EF EF EF EF EF EF 00 00 FE FE FE FE FE FE 00 00 EF EF EF EF EF EF
-00 00 FE FE FE FE FE FE 00 00 > } image } if PT 11 eq { 16 16 1 [ 16 0 0 16
-neg 0 16 ] { < F7 F7 B6 B6 D5 D5 E3 E3 D5 D5 B6 B6 F7 F7 FF FF 7F 7F 6B 6B 5D
-5D 3E 3E 5D 5D 6B 6B 7F 7F FF FF > } image } if PT 12 eq { 16 16 1 [ 16 0 0
-16 neg 0 16 ] { < E3 E3 DD DD BE BE BE BE BE BE DD DD E3 E3 FF FF 3E 3E DD DD
-EB EB EB EB EB EB DD DD 3E 3E FF FF > } image } if PT 13 eq { 16 16 1 [ 16 0
-0 16 neg 0 16 ] { < FE FE 7D 7D BB BB D7 D7 EF EF D7 D7 BB BB 7D 7D FE FE 7D
-7D BB BB D7 D7 EF EF D7 D7 BB BB 7D 7D > } image } if PT 14 eq { 16 16 1 [ 16
-0 0 16 neg 0 16 ] { < 00 00 EE EF EE EF EE EF 0E E0 EE EE EE EE EE EE 00 EE
-FE EE FE EE FE EE 00 00 FE EF FE EF FE EF > } image } if PT 15 eq { 16 16 1 [
-16 0 0 16 neg 0 16 ] { < DD DD AA AA DD DD FF FF 77 77 AA AA 77 77 FF FF DD
-DD AA AA DD DD FF FF 77 77 AA AA 77 77 FF FF > } image } if PT 16 eq { 16 16
-1 [ 16 0 0 16 neg 0 16 ] { < F1 F1 EE EE 1F 1F FF FF F1 F1 EE EE 1F 1F FF FF
-F1 F1 EE EE 1F 1F FF FF F1 F1 EE EE 1F 1F FF FF > } image } if PT 17 eq { 16
-16 1 [ 16 0 0 16 neg 0 16 ] { < EE EE DD DD BB BB FF FF EE EE DD DD BB BB FF
- FF EE EE DD DD BB BB FF FF EE EE DD DD BB BB FF FF > } image } if PT 18 eq {
-16 16 1 [ 16 0 0 16 neg 0 16 ] { < BB BB DD DD EE EE FF FF BB BB DD DD EE EE
-FF FF BB BB DD DD EE EE FF FF BB BB DD DD EE EE FF FF > } image } if PT 19 eq
-{ 16 16 1 [ 16 0 0 16 neg 0 16 ] { < 1F FC 67 F3 7B EF BD DE BD DE DE BD E6
-B3 F8 0F E6 B3 DE BD BD DE BD DE 7B EF 67 F3 1F FC 7F FF > } image } if PT
-20 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < DD DD EE EE EE EE EE EE DD DD BB
-BB BB BB BB BB DD DD EE EE EE EE EE EE DD DD BB BB BB BB BB BB > } image }
-if PT 21 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < 0E 0E EF EF EF EF EF EF E0
-E0 FE FE FE FE FE FE 0E 0E EF EF EF EF EF EF E0 E0 FE FE FE FE FE FE > }
-image } if PT 22 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < 70 70 F7 F7 F7 F7 F7
-F7 07 07 7F 7F 7F 7F 7F 7F 70 70 F7 F7 F7 F7 F7 F7 07 07 7F 7F 7F 7F 7F 7F >
-} image } if PT 23 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < AA AA 55 55 A9 A9
-D1 D1 E1 E1 D1 D1 A9 A9 55 55 AA AA 55 55 A9 A9 D1 D1 E1 E1 D1 D1 A9 A9 55 55
-> } image } if PT 24 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < FF FE FF FC EA
-A8 D5 54 EA A8 D5 54 E8 28 D4 54 E8 E8 D4 D4 E8 EA 54 D5 A8 EA 54 D5 00 C0 00
-80 > } image } if PT 25 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < FF FE FF FC
-FF F8 FF F0 F0 00 F0 00 F0 20 F0 60 F0 E0 F1 E0 F3 E0 F0 00 E0 00 C0 00 80 00
-00 00 > } image } if gr } def /FA { /PT exch def gsave clip 0 0 translate 1 1
-54 { 1 sub 47.2 mul /Xcurr exch def 1 1 74 { 1 sub 47.2 mul /Ycurr exch def
-gsave Xcurr Ycurr translate PT DP gr } for } for gr } def
-/reencdict 24 dict def /ReEncode {reencdict begin /nco&na exch def
-/nfnam exch def /basefontname exch def /basefontdict basefontname findfont def
-/newfont basefontdict maxlength dict def basefontdict {exch dup /FID ne
-{dup /Encoding eq {exch dup length array copy newfont 3 1 roll put} {exch
-newfont 3 1 roll put} ifelse} {pop pop} ifelse } forall newfont
-/FontName nfnam put nco&na aload pop nco&na length 2 idiv {newfont
-/Encoding get 3 1 roll put} repeat nfnam newfont definefont pop end } def
-/accvec [ 176 /agrave 181 /Agrave 190 /acircumflex 192 /Acircumflex
-201 /adieresis 204 /Adieresis 209 /ccedilla 210 /Ccedilla 211 /eacute
-212 /Eacute 213 /egrave 214 /Egrave 215 /ecircumflex 216 /Ecircumflex
-217 /edieresis 218 /Edieresis 219 /icircumflex 220 /Icircumflex
-221 /idieresis 222 /Idieresis 223 /ntilde 224 /Ntilde 226 /ocircumflex
-228 /Ocircumflex 229 /odieresis 230 /Odieresis 231 /ucircumflex 236 /Ucircumflex
-237 /udieresis 238 /Udieresis 239 /aring 242 /Aring 243 /ydieresis
-244 /Ydieresis 246 /aacute 247 /Aacute 252 /ugrave 253 /Ugrave] def
-/Times-Roman /Times-Roman accvec ReEncode
-/Times-Italic /Times-Italic accvec ReEncode
-/Times-Bold /Times-Bold accvec ReEncode
-/Times-BoldItalic /Times-BoldItalic accvec ReEncode
-/Helvetica /Helvetica accvec ReEncode
-/Helvetica-Oblique /Helvetica-Oblique accvec ReEncode
-/Helvetica-Bold /Helvetica-Bold accvec ReEncode
-/Helvetica-BoldOblique /Helvetica-BoldOblique accvec ReEncode
-/Courier /Courier accvec ReEncode
-/Courier-Oblique /Courier-Oblique accvec ReEncode
-/Courier-Bold /Courier-Bold accvec ReEncode
-/Courier-BoldOblique /Courier-BoldOblique accvec ReEncode
-/oshow {gsave [] 0 sd true charpath stroke gr} def
-/stwn { /fs exch def /fn exch def /text exch def fn findfont fs sf
- text sw pop xs add /xs exch def} def
-/stwb { /fs exch def /fn exch def /nbas exch def /textf exch def
-textf length /tlen exch def nbas tlen gt {/nbas tlen def} if
-fn findfont fs sf textf dup length nbas sub nbas getinterval sw
-pop neg xs add /xs exch def} def
-/accspe [ 65 /plusminus 66 /bar 67 /existential 68 /universal
-69 /exclam 70 /numbersign 71 /greater 72 /question 73 /integral
-74 /colon 75 /semicolon 76 /less 77 /bracketleft 78 /bracketright
-79 /greaterequal 80 /braceleft 81 /braceright 82 /radical
-83 /spade 84 /heart 85 /diamond 86 /club 87 /lessequal
-88 /multiply 89 /percent 90 /infinity 48 /circlemultiply 49 /circleplus
-50 /emptyset 51 /lozenge 52 /bullet 53 /arrowright 54 /arrowup
-55 /arrowleft 56 /arrowdown 57 /arrowboth 48 /degree 44 /comma 43 /plus
- 45 /angle 42 /angleleft 47 /divide 61 /notequal 40 /equivalence 41 /second
- 97 /approxequal 98 /congruent 99 /perpendicular 100 /partialdiff 101 /florin
- 102 /intersection 103 /union 104 /propersuperset 105 /reflexsuperset
- 106 /notsubset 107 /propersubset 108 /reflexsubset 109 /element 110 /notelement
- 111 /gradient 112 /logicaland 113 /logicalor 114 /arrowdblboth
- 115 /arrowdblleft 116 /arrowdblup 117 /arrowdblright 118 /arrowdbldown
- 119 /ampersand 120 /omega1 121 /similar 122 /aleph ] def
-/Symbol /Special accspe ReEncode
-/Zone {/iy exch def /ix exch def ix 1 sub 2224 mul 1 iy sub 3144
- mul t} def
-%%EndProlog
- gsave 20 28 t .25 .25 scale gsave
-%%Page: number 1
- gsave
- 1 1 Zone
- gsave 0 0 t black [] 0 sd 1 lw 2223 2224 0 460 bl 2223 2224 0 460 C 1779 1778
- 222 683 C NC [4 8] 0 sd 222 1314 m 1128 287 d s 222 1449 m 1128 287 d s 222
- 1583 m 1128 287 d s 222 1717 m 1128 287 d s 222 1852 m 1128 287 d s 222 1986 m
- 1128 287 d s 222 2120 m 1128 287 d s [] 0 sd 222 1180 m 1128 287 d s 1350 1467
- m 994 Y s 222 2174 m 1128 287 d s 222 1180 m 994 Y s [4 8] 0 sd 1350 1601 m 651
- -497 d s 1350 1736 m 651 -497 d s 1350 1870 m 651 -497 d s 1350 2004 m 651 -497
- d s 1350 2139 m 651 -497 d s 1350 2273 m 651 -497 d s 1350 2407 m 651 -497 d s
- [] 0 sd 1350 1467 m 651 -497 d s 2001 970 m 994 Y s 1350 2461 m 651 -497 d s
- 1350 1467 m cl s 0 0 0.8 c 1345 1435 m 24 6 d -21 15 d -23 -6 d f 1322 1429 m
- 23 6 d -20 15 d -24 -6 d f 1298 1423 m 24 6 d -21 15 d -23 -6 d f 1275 1417 m
- 23 6 d -20 15 d -24 -6 d f 1251 1411 m 24 6 d -21 15 d -23 -6 d f 1228 1405 m
- 23 6 d -20 15 d -24 -6 d f 1204 1399 m 24 6 d -21 15 d -23 -6 d f 1181 1393 m
- 23 6 d -20 15 d -24 -6 d f 1157 1387 m 24 6 d -21 15 d -23 -6 d f 1134 1381 m
- 23 6 d -20 15 d -24 -6 d f 1110 1375 m 24 6 d -21 15 d -23 -6 d f 1087 1369 m
- 23 6 d -20 15 d -24 -6 d f 1063 1363 m 24 6 d -21 15 d -23 -6 d f 1040 1357 m
- 23 6 d -20 15 d -24 -6 d f 1016 1351 m 24 6 d -21 15 d -23 -6 d f 993 1345 m 23
- 6 d -20 15 d -24 -5 d f 969 1339 m 24 6 d -21 16 d -23 -6 d f 946 1333 m 23 6 d
- -20 16 d -24 -6 d f 922 1327 m 24 6 d -21 16 d -23 -6 d f 899 1321 m 23 6 d -20
- 16 d -24 -6 d f 875 1315 m 24 6 d -21 16 d -23 -6 d f 852 1309 m 23 6 d -20 16
- d -24 -6 d f 828 1303 m 24 6 d -21 16 d -23 -6 d f 805 1297 m 23 6 d -20 16 d
- -24 -6 d f 781 1291 m 24 6 d -21 16 d -23 -6 d f 758 1285 m 23 6 d -20 16 d -24
- -6 d f 734 1279 m 24 6 d -21 16 d -23 -6 d f 711 1273 m 23 6 d -20 16 d -23 -6
- d f 687 1267 m 24 6 d -20 16 d -24 -6 d f 664 1261 m 23 6 d -20 16 d -23 -6 d f
- 640 1255 m 24 6 d -20 16 d -24 -6 d f 617 1249 m 23 6 d -20 16 d -23 -6 d f 593
- 1257 m 24 -8 d -20 16 d -24 -6 d f 570 1237 m 23 20 d -20 2 d -23 -6 d f 546
- 1245 m 24 -8 d -20 16 d -24 7 d f 523 1225 m 23 20 d -20 15 d -23 -19 d f 499
- 1219 m 24 6 d -20 16 d -24 -6 d f 476 1213 m 23 6 d -20 16 d -23 -6 d f 452
- 1207 m 24 6 d -20 16 d -24 -6 d f 429 1201 m 23 6 d -20 16 d -23 -6 d f 405
- 1195 m 24 6 d -20 16 d -24 -6 d f 382 1190 m 23 5 d -20 16 d -23 -6 d f 359
- 1184 m 23 6 d -20 15 d -24 -6 d f 335 1178 m 24 6 d -21 15 d -23 -6 d f 312
- 1172 m 23 6 d -20 15 d -24 -6 d f 288 1166 m 24 6 d -21 15 d -23 -6 d f 265
- 1160 m 23 6 d -20 15 d -24 -6 d f 1365 1419 m 24 6 d -20 16 d -24 -6 d f 1342
- 1413 m 23 6 d -20 16 d -23 -6 d f 1318 1407 m 24 6 d -20 16 d -24 -6 d f 1295
- 1401 m 23 6 d -20 16 d -23 -6 d f 1271 1395 m 24 6 d -20 16 d -24 -6 d f 1248
- 1389 m 23 6 d -20 16 d -23 -6 d f 1224 1383 m 24 6 d -20 16 d -24 -6 d f 1201
- 1377 m 23 6 d -20 16 d -23 -6 d f 1177 1371 m 24 6 d -20 16 d -24 -6 d f 1154
- 1365 m 23 6 d -20 16 d -23 -6 d f 1131 1359 m 23 6 d -20 16 d -24 -6 d f 1107
- 1353 m 24 6 d -21 16 d -23 -6 d f 1084 1347 m 23 6 d -20 16 d -24 -6 d f 1060
- 1341 m 24 6 d -21 16 d -23 -6 d f 1037 1335 m 23 6 d -20 16 d -24 -6 d f 1013
- 1329 m 24 6 d -21 16 d -23 -6 d f 990 1323 m 23 6 d -20 16 d -24 -6 d f 966
- 1317 m 24 6 d -21 16 d -23 -6 d f 943 1312 m 23 5 d -20 16 d -24 -6 d f 919
- 1306 m 24 6 d -21 15 d -23 -6 d f 896 1300 m 23 6 d -20 15 d -24 -6 d f 872
- 1294 m 24 6 d -21 15 d -23 -6 d f 849 1288 m 23 6 d -20 15 d -24 -6 d f 825
- 1282 m 24 6 d -21 15 d -23 -6 d f 802 1276 m 23 6 d -20 15 d -24 -6 d f 778
- 1270 m 24 6 d -21 15 d -23 -6 d f 755 1264 m 23 6 d -20 15 d -24 -6 d f 731
- 1258 m 24 6 d -21 15 d -23 -6 d f 708 1252 m 23 6 d -20 15 d -24 -6 d f 684
- 1246 m 24 6 d -21 15 d -23 -6 d f 661 1240 m 23 6 d -20 15 d -24 -6 d f 637
- 1234 m 24 6 d -21 15 d -23 -6 d f 614 1228 m 23 6 d -20 15 d -24 8 d f 590 1235
- m 24 -7 d -21 29 d -23 -20 d f 567 1216 m 23 19 d -20 2 d -24 8 d f 543 1223 m
- 24 -7 d -21 29 d -23 -20 d f 520 1204 m 23 19 d -20 2 d -24 -6 d f 496 1198 m
- 24 6 d -21 15 d -23 -6 d f 473 1192 m 23 6 d -20 15 d -24 -6 d f 449 1186 m 24
- 6 d -21 15 d -23 -6 d f 426 1180 m 23 6 d -20 15 d -24 -6 d f 402 1187 m 24 -7
- d -21 15 d -23 -5 d f 379 1168 m 23 19 d -20 3 d -23 -6 d f 355 1162 m 24 6 d
- -20 16 d -24 -6 d f 332 1156 m 23 6 d -20 16 d -23 -6 d f 308 1150 m 24 6 d -20
- 16 d -24 -6 d f 285 1144 m 23 6 d -20 16 d -23 -6 d f 1386 1404 m 23 6 d -20 15
- d -24 -6 d f 1362 1398 m 24 6 d -21 15 d -23 -6 d f 1339 1392 m 23 6 d -20 15 d
- -24 -6 d f 1315 1399 m 24 -7 d -21 15 d -23 -6 d f 1292 1380 m 23 19 d -20 2 d
- -24 -6 d f 1268 1374 m 24 6 d -21 15 d -23 -6 d f 1245 1368 m 23 6 d -20 15 d
- -24 -6 d f 1221 1362 m 24 6 d -21 15 d -23 -6 d f 1198 1356 m 23 6 d -20 15 d
- -24 -6 d f 1174 1350 m 24 6 d -21 15 d -23 -6 d f 1151 1344 m 23 6 d -20 15 d
- -23 -6 d f 1127 1338 m 24 6 d -20 15 d -24 -6 d f 1104 1332 m 23 6 d -20 15 d
- -23 -6 d f 1080 1326 m 24 6 d -20 15 d -24 -6 d f 1057 1320 m 23 6 d -20 15 d
- -23 -6 d f 1033 1314 m 24 6 d -20 15 d -24 -6 d f 1010 1321 m 23 -7 d -20 15 d
- -23 -6 d f 986 1302 m 24 19 d -20 2 d -24 -6 d f 963 1309 m 23 -7 d -20 15 d
- -23 -5 d f 939 1290 m 24 19 d -20 3 d -24 -6 d f 916 1284 m 23 6 d -20 16 d -23
- -6 d f 892 1278 m 24 6 d -20 16 d -24 -6 d f 869 1272 m 23 6 d -20 16 d -23 -6
- d f 845 1280 m 24 -8 d -20 16 d -24 -6 d f 822 1274 m 23 6 d -20 2 d -23 -6 d f
- 799 1254 m 23 20 d -20 2 d -24 -6 d f 775 1248 m 24 6 d -21 16 d -23 -6 d f 752
- 1242 m 23 6 d -20 16 d -24 -6 d f 728 1236 m 24 6 d -21 16 d -23 -6 d f 705
- 1230 m 23 6 d -20 16 d -24 -6 d f 681 1224 m 24 6 d -21 16 d -23 -6 d f 658
- 1218 m 23 6 d -20 16 d -24 -6 d f 634 1212 m 24 6 d -21 16 d -23 -6 d f 611
- 1220 m 23 -8 d -20 16 d -24 7 d f 587 1200 m 24 20 d -21 15 d -23 -19 d f 564
- 1208 m 23 -8 d -20 16 d -24 7 d f 540 1188 m 24 20 d -21 15 d -23 -19 d f 517
- 1182 m 23 6 d -20 16 d -24 -6 d f 493 1176 m 24 6 d -21 16 d -23 -6 d f 470
- 1184 m 23 -8 d -20 16 d -24 -6 d f 446 1164 m 24 20 d -21 2 d -23 -6 d f 423
- 1172 m 23 -8 d -20 16 d -24 7 d f 399 1152 m 24 20 d -21 15 d -23 -19 d f 376
- 1146 m 23 6 d -20 16 d -24 -6 d f 352 1140 m 24 6 d -21 16 d -23 -6 d f 329
- 1135 m 23 5 d -20 16 d -24 -6 d f 305 1129 m 24 6 d -21 15 d -23 -6 d f 1406
- 1388 m 24 6 d -21 16 d -23 -6 d f 1383 1382 m 23 6 d -20 16 d -24 -6 d f 1359
- 1376 m 24 6 d -21 16 d -23 -6 d f 1336 1384 m 23 -8 d -20 16 d -24 7 d f 1312
- 1364 m 24 20 d -21 15 d -23 -19 d f 1289 1358 m 23 6 d -20 16 d -24 -6 d f 1265
- 1366 m 24 -8 d -21 16 d -23 -6 d f 1242 1346 m 23 20 d -20 2 d -24 -6 d f 1218
- 1354 m 24 -8 d -21 16 d -23 -6 d f 1195 1348 m 23 6 d -20 2 d -24 -6 d f 1171
- 1355 m 24 -7 d -21 2 d -23 -6 d f 1148 1349 m 23 6 d -20 -11 d -24 -6 d f 1124
- 1330 m 24 19 d -21 -11 d -23 -6 d f 1101 1324 m 23 6 d -20 2 d -24 -6 d f 1077
- 1304 m 24 20 d -21 2 d -23 -6 d f 1054 1298 m 23 6 d -20 16 d -24 -6 d f 1030
- 1306 m 24 -8 d -21 16 d -23 7 d f 1007 1327 m 23 -21 d -20 15 d -24 -19 d f 983
- 1280 m 24 47 d -21 -25 d -23 7 d f 960 1301 m 23 -21 d -20 29 d -24 -19 d f 936
- 1295 m 24 6 d -21 -11 d -23 -6 d f 913 1289 m 23 6 d -20 -11 d -24 -6 d f 889
- 1283 m 24 6 d -21 -11 d -23 -6 d f 866 1264 m 23 19 d -20 -11 d -24 8 d f 842
- 1245 m 24 19 d -21 16 d -23 -6 d f 819 1265 m 23 -20 d -20 29 d -23 -20 d f 795
- 1233 m 24 32 d -20 -11 d -24 -6 d f 772 1253 m 23 -20 d -20 15 d -23 -6 d f 748
- 1221 m 24 32 d -20 -11 d -24 -6 d f 725 1242 m 23 -21 d -20 15 d -23 -6 d f 701
- 1209 m 24 33 d -20 -12 d -24 -6 d f 678 1216 m 23 -7 d -20 15 d -23 -6 d f 654
- 1224 m 24 -8 d -20 2 d -24 -6 d f 631 1191 m 23 33 d -20 -12 d -23 8 d f 607
- 1212 m 24 -21 d -20 29 d -24 -20 d f 584 1192 m 23 20 d -20 -12 d -23 8 d f 560
- 1186 m 24 6 d -20 16 d -24 -20 d f 537 1167 m 23 19 d -20 2 d -23 -6 d f 513
- 1161 m 24 6 d -20 15 d -24 -6 d f 490 1168 m 23 -7 d -20 15 d -23 8 d f 467
- 1162 m 23 6 d -20 16 d -24 -20 d f 443 1156 m 24 6 d -21 2 d -23 8 d f 420 1137
- m 23 19 d -20 16 d -24 -20 d f 396 1131 m 24 6 d -21 15 d -23 -6 d f 373 1125 m
- 23 6 d -20 15 d -24 -6 d f 349 1119 m 24 6 d -21 15 d -23 -5 d f 326 1113 m 23
- 6 d -20 16 d -24 -6 d f 1426 1373 m 24 6 d -20 15 d -24 -6 d f 1403 1367 m 23 6
- d -20 15 d -23 -6 d f 1379 1361 m 24 6 d -20 15 d -24 -6 d f 1356 1381 m 23 -20
- d -20 15 d -23 8 d f 1332 1402 m 24 -21 d -20 3 d -24 -20 d f 1309 1343 m 23 59
- d -20 -38 d -23 -6 d f 1285 1377 m 24 -34 d -20 15 d -24 8 d f 1262 1344 m 23
- 33 d -20 -11 d -23 -20 d f 1239 1338 m 23 6 d -20 2 d -24 8 d f 1215 1346 m 24
- -8 d -21 16 d -23 -6 d f 1192 1353 m 23 -7 d -20 2 d -24 7 d f 1168 1347 m 24 6
- d -21 2 d -23 -6 d f 1145 1328 m 23 19 d -20 2 d -24 -19 d f 1121 1335 m 24 -7
- d -21 2 d -23 -6 d f 1098 1289 m 23 46 d -20 -11 d -24 -20 d f 1074 1283 m 24 6
- d -21 15 d -23 -6 d f 1051 1290 m 23 -7 d -20 15 d -24 8 d f 1027 1284 m 24 6 d
- -21 16 d -23 21 d f 1004 1265 m 23 19 d -20 43 d -24 -47 d f 980 1272 m 24 -7 d
- -21 15 d -23 21 d f 957 1253 m 23 19 d -20 29 d -24 -6 d f 933 1247 m 24 6 d
- -21 42 d -23 -6 d f 910 1268 m 23 -21 d -20 42 d -24 -6 d f 886 1248 m 24 20 d
- -21 15 d -23 -19 d f 863 1256 m 23 -8 d -20 16 d -24 -19 d f 839 1250 m 24 6 d
- -21 -11 d -23 20 d f 816 1271 m 23 -21 d -20 15 d -24 -32 d f 792 1225 m 24 46
- d -21 -38 d -23 20 d f 769 1205 m 23 20 d -20 28 d -24 -32 d f 745 1213 m 24 -8
- d -21 16 d -23 21 d f 722 1193 m 23 20 d -20 29 d -24 -33 d f 698 1214 m 24 -21
- d -21 16 d -23 7 d f 675 1195 m 23 19 d -20 2 d -24 8 d f 651 1216 m 24 -21 d
- -21 29 d -23 -33 d f 628 1196 m 23 20 d -20 -25 d -24 21 d f 604 1177 m 24 19 d
- -21 16 d -23 -20 d f 581 1184 m 23 -7 d -20 15 d -24 -6 d f 557 1151 m 24 33 d
- -21 2 d -23 -19 d f 534 1172 m 23 -21 d -20 16 d -24 -6 d f 510 1193 m 24 -21 d
- -21 -11 d -23 7 d f 487 1187 m 23 6 d -20 -25 d -23 -6 d f 463 1141 m 24 46 d
- -20 -25 d -24 -6 d f 440 1175 m 23 -34 d -20 15 d -23 -19 d f 416 1115 m 24 60
- d -20 -38 d -24 -6 d f 393 1109 m 23 6 d -20 16 d -23 -6 d f 369 1103 m 24 6 d
- -20 16 d -24 -6 d f 346 1097 m 23 6 d -20 16 d -23 -6 d f 1447 1357 m 23 6 d
- -20 16 d -24 -6 d f 1423 1351 m 24 6 d -21 16 d -23 -6 d f 1400 1345 m 23 6 d
- -20 16 d -24 -6 d f 1378 1402 m 22 -57 d -21 16 d -23 20 d 18 22 d f 0 0.2 0.8
- c 1376 1406 m 2 -4 d -4 1 d f 0 0 0.8 c 1353 1333 m 22 68 d -1 2 d -18 -22 d
- -24 21 d f 0 0.2 0.8 c 1375 1401 m 1 5 d -2 -3 d f 0 0 0.8 c 1329 1341 m 24 -8
- d -21 69 d -23 -59 d f 1306 1361 m 23 -20 d -20 2 d -24 34 d f 1282 1369 m 24
- -8 d -21 16 d -23 -33 d f 1259 1323 m 23 46 d -20 -25 d -23 -6 d f 1242 1367 m
- 17 -44 d -20 15 d -24 8 d 13 25 d f 0 0.2 0.8 c 1235 1384 m 7 -17 d -14 4 d f 0
- 0 0.8 c 1228 1371 m -13 -25 d -23 7 d 6 17 d f 0 0.2 0.8 c 1212 1405 m 23 -21 d
- -7 -13 d -30 -1 d f 0 0 0.8 c 1188 1305 m 13 51 d -3 14 d -6 -17 d -24 -6 d f 0
- 0.2 0.8 c 1201 1356 m 11 49 d -14 -35 d f 0 0 0.8 c 1167 1348 m 21 -43 d -20 42
- d -23 -19 d 17 21 d f 0 0.2 0.8 c 1165 1352 m 2 -4 d -5 1 d f 0 0 0.8 c 1141
- 1333 m 15 12 d 6 4 d -17 -21 d -24 7 d f 0 0.2 0.8 c 1156 1345 m 9 7 d -3 -3 d
- f 0 0 0.8 c 1118 1327 m 23 6 d -20 2 d -23 -46 d f 1094 1308 m 24 19 d -20 -38
- d -24 -6 d f 1087 1327 m 7 -19 d -20 -25 d -23 7 d 10 41 d f 0 0.2 0.8 c 1071
- 1369 m 16 -42 d -26 4 d f 0 0 0.8 c 1047 1296 m 8 23 d 6 12 d -10 -41 d -24 -6
- d f 0 0.2 0.8 c 1055 1319 m 16 50 d -10 -38 d f 0 0 0.8 c 1024 1276 m 23 20 d
- -20 -12 d -23 -19 d f 1000 1297 m 24 -21 d -20 -11 d -24 7 d f 977 1251 m 23 46
- d -20 -25 d -23 -19 d f 956 1294 m 21 -43 d -20 2 d -24 -6 d 19 48 d f 0 0.2
- 0.8 c 953 1299 m 3 -5 d -4 1 d f 0 0 0.8 c 952 1295 m -19 -48 d -23 21 d 17 22
- d f 0 0.2 0.8 c 930 1293 m 23 6 d -1 -4 d -25 -5 d f 0 0 0.8 c 927 1290 m -17
- -22 d -24 -20 d 19 35 d f 0 0.2 0.8 c 907 1287 m 23 6 d -3 -3 d -22 -7 d f 0 0
- 0.8 c 883 1240 m 21 41 d 1 2 d -19 -35 d -23 8 d f 0 0.2 0.8 c 904 1281 m 3 6 d
- -2 -4 d f 0 0 0.8 c 860 1261 m 23 -21 d -20 16 d -24 -6 d f 852 1268 m 8 -7 d
- -21 -11 d -23 21 d 6 3 d f 0 0.2 0.8 c 836 1282 m 16 -14 d -30 6 d f 0 0 0.8 c
- 822 1274 m -6 -3 d -24 -46 d 13 39 d f 0 0.2 0.8 c 813 1290 m 23 -8 d -14 -8 d
- -17 -10 d f 0 0 0.8 c 789 1216 m 12 39 d 4 9 d -13 -39 d -23 -20 d f 0 0.2 0.8
- c 801 1255 m 12 35 d -8 -26 d f 0 0 0.8 c 766 1224 m 23 -8 d -20 -11 d -24 8 d
- f 742 1204 m 24 20 d -21 -11 d -23 -20 d f 719 1185 m 23 19 d -20 -11 d -24 21
- d f 704 1230 m 15 -45 d -21 29 d -23 -19 d 12 39 d f 0 0.2 0.8 c 695 1260 m 9
- -30 d -17 4 d f 0 0 0.8 c 672 1200 m 9 24 d 6 10 d -12 -39 d -24 21 d f 0 0.2
- 0.8 c 681 1224 m 14 36 d -8 -26 d f 0 0 0.8 c 648 1207 m 24 -7 d -21 16 d -23
- -20 d f 625 1201 m 23 6 d -20 -11 d -24 -19 d f 601 1169 m 24 32 d -21 -24 d
- -23 7 d f 578 1163 m 23 6 d -20 15 d -24 -33 d f 554 1170 m 24 -7 d -21 -12 d
- -23 21 d f 531 1164 m 23 6 d -20 2 d -24 21 d f 507 1172 m 24 -8 d -21 29 d -23
- -6 d f 500 1178 m 7 -6 d -20 15 d -24 -46 d 15 37 d f 0 0.2 0.8 c 484 1192 m 16
- -14 d -22 X f 0 0 0.8 c 460 1119 m 17 53 d 1 6 d -15 -37 d -23 34 d f 0 0.2 0.8
- c 477 1172 m 7 20 d -6 -14 d f 0 0 0.8 c 437 1100 m 23 19 d -20 56 d -24 -60 d
- f 413 1094 m 24 6 d -21 15 d -23 -6 d f 390 1088 m 23 6 d -20 15 d -24 -6 d f
- 366 1082 m 24 6 d -21 15 d -23 -6 d f 1467 1341 m 24 6 d -21 16 d -23 -6 d f
- 1444 1335 m 23 6 d -20 16 d -24 -6 d f 1420 1329 m 24 6 d -21 16 d -23 -6 d f
- 1397 1377 m 23 -48 d -20 16 d -22 57 d 6 -7 d f 0 0.2 0.8 c 1378 1402 m -2 4 d
- 8 -11 d f 0 0 0.8 c 1373 1371 m 24 6 d -13 18 d -9 6 d -22 -68 d f 0 0.2 0.8 c
- 1384 1395 m -8 11 d -1 -5 d f 0 0 0.8 c 1368 1378 m 5 -7 d -20 -38 d -24 8 d 13
- 39 d f 0 0.2 0.8 c 1350 1406 m 18 -28 d -26 2 d f 0 0 0.8 c 1342 1380 m -13 -39
- d -23 20 d 8 16 d f 0 0.2 0.8 c 1326 1400 m 24 6 d -8 -26 d -28 -3 d f 0 0 0.8
- c 1303 1326 m 12 39 d -1 12 d -8 -16 d -24 8 d f 0 0.2 0.8 c 1315 1365 m 11 35
- d -12 -23 d f 0 0 0.8 c 1290 1359 m 13 -33 d -21 43 d -23 -46 d 12 39 d f 0 0.2
- 0.8 c 1279 1388 m 11 -29 d -19 3 d f 0 0 0.8 c 1271 1362 m -12 -39 d -17 44 d f
- 0 0.2 0.8 c 1256 1395 m 23 -7 d -8 -26 d -29 5 d -7 17 d f 1232 1362 m 24 33 d
- -21 -11 d -23 21 d f 0 0 0.8 c 1201 1356 m -13 -51 d 15 37 d f 0 0.2 0.8 c 1209
- 1356 m 23 6 d -20 43 d -11 -49 d 2 -14 d f 0 0 0.8 c 1203 1342 m -15 -37 d -21
- 43 d f 0 0.2 0.8 c 1185 1350 m 24 6 d -6 -14 d -36 6 d -2 4 d f 0 0 0.8 c 1162
- 1304 m 12 25 d -18 16 d -15 -12 d f 0 0.2 0.8 c 1174 1329 m 11 21 d -20 2 d -9
- -7 d f 0 0 0.8 c 1138 1311 m 24 -7 d -21 29 d -23 -6 d f 1115 1306 m 23 5 d -20
- 16 d -24 -19 d f 1112 1313 m 3 -7 d -21 2 d -7 19 d f 0 0.2 0.8 c 1094 1371 m
- 18 -58 d -25 14 d -16 42 d 13 7 d f 0 0.4 0.8 c 1091 1380 m 3 -9 d -10 5 d f 0
- 0 0.8 c 1055 1319 m -8 -23 d 9 15 d f 0 0.2 0.8 c 1068 1334 m 17 35 d -1 7 d
- -13 -7 d -16 -50 d 1 -8 d f 0 0.4 0.8 c 1085 1369 m 6 11 d -7 -4 d f 0 0 0.8 c
- 1044 1288 m 5 9 d 7 14 d -9 -15 d -23 -20 d f 0 0.2 0.8 c 1049 1297 m 19 37 d
- -12 -23 d f 0 0 0.8 c 1037 1294 m 7 -6 d -20 -12 d -24 21 d 7 4 d f 0 0.2 0.8 c
- 1021 1308 m 16 -14 d -30 7 d f 0 0 0.8 c 997 1249 m 16 39 d -6 13 d -7 -4 d -23
- -46 d f 0 0.2 0.8 c 1013 1288 m 8 20 d -14 -7 d f 0 0 0.8 c 987 1281 m 10 -32 d
- -20 2 d -21 43 d f 0 0.2 0.8 c 974 1323 m 13 -42 d -31 13 d -3 5 d f 950 1317 m
- 24 6 d -21 -24 d -23 -6 d f 927 1325 m 23 -8 d -20 -24 d -23 -6 d f 0 0 0.8 c
- 903 1225 m 9 37 d -8 19 d -21 -41 d f 0 0.2 0.8 c 912 1262 m 15 63 d -20 -38 d
- -3 -6 d f 0 0 0.8 c 883 1255 m 20 -30 d -20 15 d -23 21 d 12 -1 d f 0 0.2 0.8 c
- 880 1259 m 3 -4 d -11 5 d f 0 0 0.8 c 856 1213 m 21 40 d -5 7 d -12 1 d -8 7 d
- -9 -10 d f 0 0.2 0.8 c 877 1253 m 3 6 d -8 1 d -20 8 d -16 14 d 7 -24 d f 0 0
- 0.8 c 833 1220 m 23 -7 d -13 45 d -18 -10 d f 0 0.2 0.8 c 843 1258 m -7 24 d
- -23 8 d 12 -42 d f 0 0 0.8 c 814 1237 m 19 -17 d -8 28 d -24 7 d -12 -39 d 18
- 22 d f 0 0.2 0.8 c 809 1241 m 5 -4 d 11 11 d -12 42 d -12 -35 d 6 -17 d f 0 0
- 0.8 c 807 1238 m -18 -22 d -23 8 d 11 13 d f 0 0.2 0.8 c 786 1249 m 23 -8 d -2
- -3 d -30 -1 d f 0 0 0.8 c 777 1237 m -11 -13 d -24 -20 d 13 26 d f 0 0.2 0.8 c
- 762 1243 m 24 6 d -9 -12 d -22 -7 d f 0 0 0.8 c 739 1183 m 15 39 d 1 8 d -13
- -26 d -23 -19 d f 0 0.2 0.8 c 754 1222 m 8 21 d -7 -13 d f 0 0 0.8 c 715 1190 m
- 24 -7 d -20 2 d -15 45 d 3 -11 d f 0 0.2 0.8 c 704 1230 m -9 30 d 12 -41 d f 0
- 0 0.8 c 703 1209 m 12 -19 d -8 29 d -26 5 d -9 -24 d 11 13 d f 0 0.2 0.8 c 692
- 1225 m 11 -16 d 4 10 d -12 41 d -14 -36 d 2 -11 d f 0 0 0.8 c 668 1178 m 13 26
- d 2 9 d -11 -13 d -24 7 d f 0 0.2 0.8 c 681 1204 m 11 21 d -9 -12 d f 0 0 0.8 c
- 645 1186 m 23 -8 d -20 29 d -23 -6 d f 640 1193 m 5 -7 d -20 15 d -24 -32 d 11
- 27 d f 0 0.2 0.8 c 622 1220 m 18 -27 d -28 3 d f 0 0 0.8 c 612 1196 m -11 -27 d
- -23 -6 d 9 28 d f 0 0.2 0.8 c 598 1228 m 24 -8 d -10 -24 d -25 -5 d f 0 0 0.8 c
- 587 1191 m -9 -28 d -24 7 d 17 9 d f 0 0.2 0.8 c 575 1181 m 23 47 d -11 -37 d
- -16 -12 d f 0 0 0.8 c 571 1179 m -17 -9 d -23 -6 d 6 17 d f 0 0.2 0.8 c 551
- 1216 m 24 -35 d -4 -2 d -34 2 d f 0 0 0.8 c 537 1181 m -6 -17 d -24 8 d 3 6 d f
- 0 0.2 0.8 c 528 1210 m 23 6 d -14 -35 d -27 -3 d f 0 0 0.8 c 504 1150 m 4 9 d 2
- 19 d -3 -6 d -7 6 d -2 -15 d f 0 0.2 0.8 c 508 1159 m 20 51 d -18 -32 d -10 X
- -16 14 d 14 -29 d f 0 0 0.8 c 499 1157 m 5 -7 d -6 13 d -21 9 d -17 -53 d 13 40
- d f 0 0.2 0.8 c 481 1184 m 18 -27 d -1 6 d -14 29 d -7 -20 d -4 -13 d f 0 0 0.8
- c 457 1084 m 16 66 d 9 Y -13 -40 d -23 -19 d f 0 0.2 0.8 c 473 1150 m 8 34 d -8
- -25 d f 0 0 0.8 c 434 1078 m 23 6 d -20 16 d -24 -6 d f 410 1072 m 24 6 d -21
- 16 d -23 -6 d f 387 1066 m 23 6 d -20 16 d -24 -6 d f 1487 1326 m 24 6 d -20 15
- d -24 -6 d f 1464 1320 m 23 6 d -20 15 d -23 -6 d f 1440 1314 m 24 6 d -20 15 d
- -24 -6 d f 1430 1373 m 10 -59 d -20 15 d -23 48 d 2 7 d f 0 0.2 0.8 c 1419 1433
- m 11 -60 d -31 11 d 15 50 d f 0 0.4 0.8 c 1417 1442 m 2 -9 d -5 1 d f 0 0 0.8 c
- 1399 1384 m -2 -7 d -24 -6 d 2 7 d f 0 0.2 0.8 c 1414 1434 m -15 -50 d -24 -6 d
- 13 52 d f 0 0.4 0.8 c 1393 1450 m 24 -8 d -3 -8 d -26 -4 d f 0 0 0.8 c 1375
- 1378 m -2 -7 d -5 7 d f 0 0.2 0.8 c 1388 1430 m -13 -52 d -7 X -18 28 d 15 18 d
- f 0 0.4 0.8 c 1370 1430 m 23 20 d -5 -20 d -23 -6 d f 0 0.2 0.8 c 1347 1411 m 5
- 5 d 13 8 d -15 -18 d -24 -6 d f 0 0.4 0.8 c 1352 1416 m 18 14 d -5 -6 d f 0 0
- 0.8 c 1315 1365 m -12 -39 d 5 32 d f 0 0.2 0.8 c 1345 1414 m 2 -3 d -21 -11 d
- -11 -35 d -7 -7 d 9 55 d f 0 0.4 0.8 c 1323 1445 m 22 -31 d -28 -1 d f 0 0 0.8
- c 1300 1318 m 4 23 d 4 17 d -5 -32 d -13 33 d 1 -12 d f 0 0.2 0.8 c 1304 1341 m
- 12 66 d 1 6 d -9 -55 d -18 1 d -11 29 d 12 -41 d f 0 0.4 0.8 c 1316 1407 m 7 38
- d -6 -32 d f 0 0 0.8 c 1276 1312 m 24 6 d -9 29 d -22 -8 d f 0 0.2 0.8 c 1291
- 1347 m -12 41 d -23 7 d 13 -56 d f 0 0 0.8 c 1270 1333 m 6 -21 d -7 27 d f 0
- 0.2 0.8 c 1253 1387 m 17 -54 d -1 6 d -13 56 d -24 -33 d f 1247 1389 m 6 -2 d
- -21 -25 d -23 -6 d 16 31 d f 0 0.4 0.8 c 1229 1395 m 18 -6 d -22 -2 d f 0 0.2
- 0.8 c 1206 1348 m 17 35 d 2 4 d -16 -31 d -24 -6 d f 0 0.4 0.8 c 1223 1383 m 6
- 12 d -4 -8 d f 0 0 0.8 c 1174 1329 m -12 -25 d 5 18 d f 0 0.2 0.8 c 1182 1369 m
- 24 -21 d -21 2 d -11 -21 d -7 -7 d f 0 0 0.8 c 1167 1322 m -5 -18 d -24 7 d 7 4
- d f 0 0.2 0.8 c 1159 1323 m 23 46 d -15 -47 d -22 -7 d f 0 0 0.8 c 1135 1263 m
- 16 39 d -6 13 d -7 -4 d -23 -5 d f 0 0.2 0.8 c 1151 1302 m 8 21 d -14 -8 d f 0
- 0 0.8 c 1120 1294 m 15 -31 d -20 43 d -3 7 d f 0 0.2 0.8 c 1112 1311 m 8 -17 d
- -8 19 d -18 58 d 1 -4 d f 0 0.4 0.8 c 1094 1371 m -3 9 d 4 -13 d f 0 0.2 0.8 c
- 1088 1318 m 24 -7 d -17 56 d -10 2 d -17 -35 d f 0 0.4 0.8 c 1095 1367 m -4 13
- d -6 -11 d f 0 0 0.8 c 1049 1297 m -5 -9 d 1 7 d f 0 0.2 0.8 c 1082 1347 m 6
- -29 d -20 16 d -19 -37 d -4 -2 d 9 56 d f 0 0.4 0.8 c 1068 1406 m 14 -59 d -28
- 4 d 9 55 d f 0 0.6 0.8 c 1065 1420 m 3 -14 d -5 X f 0 0 0.8 c 1045 1295 m -1 -7
- d -7 6 d f 0 0.2 0.8 c 1041 1293 m 9 46 d 4 12 d -9 -56 d -8 -1 d -16 14 d f 0
- 0.4 0.8 c 1050 1339 m 12 65 d 1 2 d -9 -55 d f 0 0.6 0.8 c 1062 1404 m 3 16 d
- -2 -14 d f 0 0 0.8 c 1013 1288 m -16 -39 d 6 31 d f 0 0.2 0.8 c 1028 1333 m 13
- -40 d -20 15 d -8 -20 d -10 -8 d 9 55 d f 0 0.4 0.8 c 1018 1368 m 10 -35 d -16
- 2 d f 0 0 0.8 c 1003 1280 m -6 -31 d -10 32 d f 0 0.2 0.8 c 1012 1335 m -9 -55
- d -16 1 d -13 42 d 13 7 d f 0 0.4 0.8 c 994 1335 m 24 33 d -6 -33 d -25 -5 d f
- 0 0.2 0.8 c 971 1262 m 20 62 d -4 6 d -13 -7 d -24 -6 d f 0 0.4 0.8 c 991 1324
- m 3 11 d -7 -5 d f 0 0.2 0.8 c 947 1269 m 24 -7 d -21 55 d -23 8 d f 0 0 0.8 c
- 912 1262 m -9 -37 d 6 31 d f 0 0.2 0.8 c 932 1309 m 15 -40 d -20 56 d -15 -63 d
- -3 -6 d 11 54 d f 0 0.4 0.8 c 924 1330 m 8 -21 d -12 1 d f 0 0 0.8 c 909 1256 m
- -6 -31 d -20 30 d f 0 0.2 0.8 c 920 1310 m -11 -54 d -26 -1 d -3 4 d 17 44 d f
- 0 0.4 0.8 c 900 1311 m 24 19 d -4 -20 d -23 -7 d f 0 0 0.8 c 877 1253 m -21 -40
- d 14 25 d f 0 0.2 0.8 c 877 1251 m 19 49 d 1 3 d -17 -44 d -3 -6 d -7 -15 d f 0
- 0.4 0.8 c 896 1300 m 4 11 d -3 -8 d f 0 0 0.8 c 870 1238 m -14 -25 d -23 7 d 2
- 20 d f 0 0.2 0.8 c 870 1293 m 7 -42 d -7 -13 d -35 2 d 7 57 d f 0 0.4 0.8 c 860
- 1353 m 10 -60 d -28 4 d 7 57 d f 0 0.6 0.8 c 853 1393 m 7 -40 d -11 1 d f 0 0
- 0.8 c 835 1240 m -2 -20 d -19 17 d f 0 0.2 0.8 c 842 1297 m -7 -57 d -21 -3 d
- -5 4 d 10 50 d f 0 0.4 0.8 c 849 1354 m -7 -57 d -23 -6 d 10 54 d f 0 0.6 0.8 c
- 830 1347 m 23 46 d -4 -39 d -20 -9 d f 0 0.2 0.8 c 819 1291 m -10 -50 d -23 8 d
- 8 37 d f 0 0.4 0.8 c 829 1345 m -10 -54 d -25 -5 d 12 53 d f 0 0.6 0.8 c 806
- 1341 m 24 6 d -1 -2 d -23 -6 d f 0 0.2 0.8 c 794 1286 m -8 -37 d -24 -6 d 11 35
- d f 0 0.4 0.8 c 783 1308 m 22 31 d 1 X -12 -53 d -21 -8 d f 0 0.6 0.8 c 805
- 1339 m 1 2 d -2 Y f 0 0 0.8 c 754 1222 m -15 -39 d 6 31 d f 0 0.2 0.8 c 773
- 1278 m -11 -35 d -8 -21 d -9 -8 d 10 54 d f 0 0.4 0.8 c 759 1288 m 24 20 d -10
- -30 d -18 -10 d f 0 0 0.8 c 745 1214 m -6 -31 d -24 7 d 6 18 d f 0 0.2 0.8 c
- 736 1256 m 3 4 d 16 8 d -10 -54 d -24 -6 d f 0 0.4 0.8 c 739 1260 m 20 28 d -4
- -20 d f 0 0 0.8 c 721 1208 m -6 -18 d -12 19 d f 0 0.2 0.8 c 734 1258 m 2 -2 d
- -15 -48 d -18 1 d -11 16 d 9 36 d f 0 0.4 0.8 c 712 1303 m 22 -45 d -33 3 d f 0
- 0 0.8 c 681 1204 m -13 -26 d 3 20 d f 0 0.2 0.8 c 701 1261 m -9 -36 d -11 -21 d
- -10 -6 d 7 57 d f 0 0.4 0.8 c 705 1313 m 7 -10 d -11 -42 d -23 -6 d 7 57 d f 0
- 0.6 0.8 c 689 1338 m 16 -25 d -20 -1 d f 0 0 0.8 c 671 1198 m -3 -20 d -23 8 d
- 2 7 d f 0 0.2 0.8 c 678 1255 m -7 -57 d -24 -5 d 13 52 d f 0 0.4 0.8 c 665 1264
- m 14 43 d 6 5 d -7 -57 d -18 -10 d f 0 0.6 0.8 c 679 1307 m 10 31 d -4 -26 d f
- 0 0 0.8 c 647 1193 m -2 -7 d -5 7 d f 0 0.2 0.8 c 660 1245 m -13 -52 d -7 X -18
- 27 d 11 22 d f 0 0.4 0.8 c 642 1258 m 23 6 d -5 -19 d -27 -3 d f 0 0.2 0.8 c
- 618 1199 m 14 33 d 1 10 d -11 -22 d -24 8 d f 0 0.4 0.8 c 632 1232 m 10 26 d -9
- -16 d f 0 0.2 0.8 c 608 1226 m 10 -27 d -20 29 d -23 -47 d 12 48 d f 0 0.4 0.8
- c 595 1260 m 13 -34 d -21 3 d f 0 0.2 0.8 c 571 1160 m 15 61 d 1 8 d -12 -48 d
- -24 35 d f 0 0.4 0.8 c 586 1221 m 9 39 d -8 -31 d f 0 0.2 0.8 c 548 1181 m 23
- -21 d -20 56 d -23 -6 d f 0 0 0.8 c 508 1159 m -4 -9 d 3 6 d f 0 0.2 0.8 c 524
- 1202 m 24 -21 d -20 29 d -20 -51 d -1 -3 d f 0 0 0.8 c 507 1156 m -3 -6 d -5 7
- d f 0 0.2 0.8 c 521 1204 m 3 -2 d -17 -46 d -8 1 d -18 27 d 11 22 d f 0 0.4 0.8
- c 501 1223 m 20 -19 d -29 2 d f 0 0 0.8 c 477 1069 m 10 64 d -14 17 d -16 -66 d
- f 0 0.2 0.8 c 487 1133 m 10 65 d -5 8 d -11 -22 d -8 -34 d f 0 0.4 0.8 c 497
- 1198 m 4 25 d -9 -17 d f 0 0 0.8 c 454 1063 m 23 6 d -20 15 d -23 -6 d f 430
- 1057 m 24 6 d -20 15 d -24 -6 d f 407 1051 m 23 6 d -20 15 d -23 -6 d f 1508
- 1310 m 23 6 d -20 16 d -24 -6 d f 1484 1304 m 24 6 d -21 16 d -23 -6 d f 1461
- 1298 m 23 6 d -20 16 d -24 -6 d f 1456 1359 m 5 -61 d -21 16 d -10 59 d f 0 0.2
- 0.8 c 1451 1420 m 5 -61 d -26 14 d -11 60 d f 0 0.4 0.8 c 1446 1481 m 5 -61 d
- -32 13 d -2 9 d 7 47 d f 0 0.6 0.8 c 1441 1542 m 5 -61 d -22 8 d 7 57 d f 0 0.8
- 0.8 c 1437 1588 m 4 -46 d -10 4 d f 0 0.4 0.8 c 1424 1489 m -7 -47 d -24 8 d 20
- 24 d f 0 0.6 0.8 c 1414 1475 m 13 63 d 4 8 d -7 -57 d -11 -15 d f 0 0.8 0.8 c
- 1427 1538 m 10 50 d -6 -42 d f 0 0.4 0.8 c 1413 1474 m -20 -24 d -23 -20 d 8 46
- d f 0 0.6 0.8 c 1396 1531 m 18 -56 d -1 -1 d -35 2 d 9 55 d f 0 0.8 0.8 c 1390
- 1549 m 6 -18 d -9 X f 0 0.2 0.8 c 1352 1416 m -5 -5 d 1 2 d f 0 0.4 0.8 c 1367
- 1436 m 5 26 d 6 14 d -8 -46 d -18 -14 d -4 -3 d f 0 0.6 0.8 c 1372 1462 m 14 66
- d 1 3 d -9 -55 d f 0 0.8 0.8 c 1386 1528 m 4 21 d -3 -18 d f 0 0.2 0.8 c 1343
- 1363 m 11 33 d -6 17 d -1 -2 d -2 3 d -11 -14 d f 0 0.4 0.8 c 1354 1396 m 13 40
- d -19 -23 d -3 1 d -22 31 d 11 -45 d f 0 0 0.8 c 1304 1341 m -4 -23 d 5 18 d f
- 0 0.2 0.8 c 1320 1383 m 23 -20 d -9 37 d -18 7 d -12 -66 d 1 -5 d f 0 0.4 0.8 c
- 1334 1400 m -11 45 d -7 -38 d f 0 0 0.8 c 1305 1336 m -5 -18 d -24 -6 d 3 20 d
- f 0 0.2 0.8 c 1318 1386 m 2 -3 d -15 -47 d -26 -4 d 10 55 d f 0 0.4 0.8 c 1296
- 1431 m 22 -45 d -29 1 d f 0 0 0.8 c 1279 1332 m -3 -20 d -6 21 d f 0 0.2 0.8 c
- 1289 1387 m -10 -55 d -9 1 d -17 54 d 3 Y f 0 0.4 0.8 c 1293 1442 m 3 -11 d -7
- -44 d -36 3 d 9 55 d f 0 0.6 0.8 c 1275 1500 m 18 -58 d -31 3 d 10 55 d f 0 0.8
- 0.8 c 1273 1506 m 2 -6 d -3 X f 0 0.2 0.8 c 1253 1390 m -3 Y -6 2 d f 0 0.4 0.8
- c 1262 1445 m -9 -55 d -6 -1 d -18 6 d 13 42 d f 0 0.6 0.8 c 1249 1460 m 20 38
- d 3 2 d -10 -55 d -20 -8 d f 0 0.8 0.8 c 1269 1498 m 4 8 d -1 -6 d f 0 0.2 0.8
- c 1223 1383 m -17 -35 d 6 25 d f 0 0.4 0.8 c 1242 1437 m -13 -42 d -6 -12 d -11
- -10 d 14 52 d f 0 0.6 0.8 c 1226 1427 m 23 33 d -7 -23 d -16 -12 d f 0 0.2 0.8
- c 1202 1354 m 2 3 d 8 16 d -6 -25 d -24 21 d f 0 0.4 0.8 c 1204 1357 m 21 68 d
- 1 X -14 -52 d f 0 0.6 0.8 c 1225 1425 m 1 2 d -2 Y f 0 0.2 0.8 c 1200 1356 m 2
- -2 d -20 15 d -23 -46 d 11 35 d f 0 0.4 0.8 c 1179 1388 m 21 -32 d -30 2 d f 0
- 0 0.8 c 1151 1302 m -16 -39 d 6 31 d f 0 0.2 0.8 c 1170 1358 m -11 -35 d -8 -21
- d -10 -8 d 10 54 d f 0 0.4 0.8 c 1155 1368 m 24 20 d -9 -30 d -19 -10 d f 0 0
- 0.8 c 1141 1294 m -6 -31 d -15 31 d f 0 0.2 0.8 c 1151 1348 m -10 -54 d -21 X
- -8 17 d 7 38 d f 0 0.4 0.8 c 1139 1403 m 16 -35 d -4 -20 d -32 1 d 10 54 d f 0
- 0.6 0.8 c 1132 1416 m 7 -13 d -10 X f 0 0.2 0.8 c 1119 1349 m -7 -38 d -24 7 d
- 5 27 d f 0 0.4 0.8 c 1129 1403 m -10 -54 d -26 -4 d 11 54 d f 0 0.6 0.8 c 1108
- 1424 m 24 -8 d -3 -13 d -25 -4 d f 0 0.2 0.8 c 1093 1345 m -5 -27 d -6 29 d f 0
- 0.4 0.8 c 1085 1377 m 7 14 d 12 8 d -11 -54 d -11 2 d -14 59 d 8 -10 d f 0 0.6
- 0.8 c 1092 1391 m 16 33 d -4 -25 d -36 7 d -3 14 d 11 -24 d f 0 0.2 0.8 c 1050
- 1339 m -9 -46 d 8 38 d f 0 0.4 0.8 c 1075 1387 m 10 -10 d -9 19 d -14 8 d -12
- -65 d -1 -8 d 10 54 d f 0 0.6 0.8 c 1061 1398 m 14 -11 d 1 9 d -11 24 d -3 -16
- d -3 -19 d f 0 0.2 0.8 c 1049 1331 m -8 -38 d -13 40 d f 0 0.4 0.8 c 1038 1365
- m 10 15 d 11 5 d -10 -54 d -21 2 d -10 35 d f 0 0.6 0.8 c 1048 1380 m 13 18 d
- -2 -13 d f 0 0.4 0.8 c 1015 1359 m 23 6 d -20 3 d -24 -33 d f 0 0.2 0.8 c 991
- 1324 m -20 -62 d 14 46 d f 0 0.4 0.8 c 991 1327 m 24 32 d -21 -24 d -3 -11 d -6
- -16 d f 0 0.2 0.8 c 985 1308 m -14 -46 d -24 7 d 5 40 d f 0 0.4 0.8 c 983 1363
- m 8 -36 d -6 -19 d -33 1 d 8 56 d f 0 0.6 0.8 c 969 1422 m 14 -59 d -23 2 d 7
- 57 d f 0 0.8 0.8 c 968 1428 m 1 -6 d -2 X f 0 0.2 0.8 c 952 1309 m -5 -40 d -15
- 40 d f 0 0.4 0.8 c 960 1365 m -8 -56 d -20 X -8 21 d 14 28 d f 0 0.6 0.8 c 944
- 1368 m 21 53 d 2 1 d -7 -57 d -22 -7 d f 0 0.8 0.8 c 965 1421 m 3 7 d -1 -6 d f
- 0 0.4 0.8 c 921 1336 m 10 14 d 7 8 d -14 -28 d -24 -19 d f 0 0.6 0.8 c 931 1350
- m 13 18 d -6 -10 d f 0 0.2 0.8 c 896 1300 m -19 -49 d 11 35 d f 0 0.4 0.8 c 897
- 1316 m 24 20 d -21 -25 d -4 -11 d -8 -14 d f 0 0.2 0.8 c 888 1286 m -11 -35 d
- -7 42 d f 0 0.4 0.8 c 874 1297 m 23 19 d -9 -30 d -18 7 d -10 60 d 4 -10 d f 0
- 0.6 0.8 c 860 1353 m -7 40 d 11 -50 d f 0 0.4 0.8 c 850 1291 m 24 6 d -10 46 d
- -33 1 d f 0 0.6 0.8 c 864 1343 m -11 50 d -23 -46 d 1 -3 d f 0 0.4 0.8 c 827
- 1298 m 23 -7 d -19 53 d -23 -6 d f 0 0.6 0.8 c 831 1344 m -1 3 d -24 -6 d 2 -3
- d f 0 0.4 0.8 c 803 1279 m 24 19 d -19 40 d -3 1 d -22 -31 d f 0 0.6 0.8 c 808
- 1338 m -2 3 d -1 -2 d f 0 0.4 0.8 c 781 1312 m 22 -33 d -20 29 d -24 -20 d 20
- 24 d f 0 0.6 0.8 c 780 1313 m 1 -1 d -2 X f 0 0.2 0.8 c 739 1260 m -3 -4 d 5 -1
- d f 0 0.4 0.8 c 756 1253 m 23 58 d 1 Y -20 -24 d -20 -28 d 2 -5 d f 0 0.6 0.8 c
- 779 1311 m 1 2 d -1 -1 d f 0 0.2 0.8 c 741 1255 m -5 1 d -2 2 d f 0 0.4 0.8 c
- 745 1303 m 11 -50 d -15 2 d -7 3 d -22 45 d 4 9 d f 0 0.6 0.8 c 733 1355 m 12
- -52 d -29 9 d f 0 0.4 0.8 c 716 1312 m -4 -9 d -7 10 d f 0 0.6 0.8 c 709 1349 m
- 24 6 d -17 -43 d -11 1 d -16 25 d f 0 0.4 0.8 c 686 1249 m 9 41 d -16 17 d -14
- -43 d f 0 0.6 0.8 c 695 1290 m 14 59 d -20 -11 d -10 -31 d f 0 0.4 0.8 c 663
- 1282 m 23 -33 d -21 15 d -23 -6 d 19 24 d f 0 0.6 0.8 c 662 1283 m 1 -1 d -2 X
- f 0 0.2 0.8 c 632 1232 m -14 -33 d 5 26 d f 0 0.4 0.8 c 661 1282 m -19 -24 d
- -10 -26 d -9 -7 d 11 54 d f 0 0.6 0.8 c 639 1304 m 23 -21 d -1 -1 d -27 -3 d f
- 0 0.2 0.8 c 623 1225 m -5 -26 d -10 27 d f 0 0.4 0.8 c 634 1279 m -11 -54 d -15
- 1 d -13 34 d 7 19 d f 0 0.6 0.8 c 615 1312 m 24 -8 d -5 -25 d -32 X f 0 0.2 0.8
- c 586 1221 m -15 -61 d 18 44 d f 0 0.4 0.8 c 592 1212 m 13 55 d -3 12 d -7 -19
- d -9 -39 d 3 -17 d f 0 0.6 0.8 c 605 1267 m 10 45 d -13 -33 d f 0 0.2 0.8 c 589
- 1204 m -18 -44 d -23 21 d 4 27 d f 0 0.4 0.8 c 579 1260 m 13 -48 d -3 -8 d -37
- 4 d 10 54 d f 0 0.6 0.8 c 568 1300 m 11 -40 d -17 2 d f 0 0.2 0.8 c 552 1208 m
- -4 -27 d -24 21 d 1 2 d f 0 0.4 0.8 c 562 1262 m -10 -54 d -27 -4 d 19 48 d f 0
- 0.6 0.8 c 545 1253 m 23 47 d -6 -38 d -18 -10 d f 0 0.2 0.8 c 525 1204 m -1 -2
- d -3 2 d f 0 0.4 0.8 c 521 1207 m 23 44 d 1 Y -19 -48 d -4 X -20 19 d f 0 0.6
- 0.8 c 544 1251 m 1 2 d -1 -1 d f 0 0 0.8 c 498 1053 m 10 65 d -21 15 d -10 -64
- d f 0 0.2 0.8 c 508 1118 m 10 65 d -21 15 d -10 -65 d f 0 0.4 0.8 c 518 1183 m
- 3 24 d -20 16 d -4 -25 d f 0 0 0.8 c 474 1047 m 24 6 d -21 16 d -23 -6 d f 451
- 1041 m 23 6 d -20 16 d -24 -6 d f 427 1035 m 24 6 d -21 16 d -23 -6 d f 1528
- 1295 m 24 6 d -21 15 d -23 -6 d f 1505 1289 m 23 6 d -20 15 d -24 -6 d f 1481
- 1283 m 24 6 d -21 15 d -23 -6 d f 1477 1344 m 4 -61 d -20 15 d -5 61 d f 0 0.2
- 0.8 c 1472 1405 m 5 -61 d -21 15 d -5 61 d f 0 0.4 0.8 c 1468 1466 m 4 -61 d
- -21 15 d -5 61 d f 0 0.6 0.8 c 1464 1527 m 4 -61 d -22 15 d -5 61 d f 0 0.8 0.8
- c 1459 1588 m 5 -61 d -23 15 d -4 46 d 8 9 d f 0 0.8 0.6 c 1458 1613 m 1 -25 d
- -14 9 d f 0 0.6 0.8 c 1427 1538 m -13 -63 d 18 46 d f 0 0.8 0.8 c 1434 1526 m
- 16 60 d -5 11 d -8 -9 d -10 -50 d 5 -17 d f 0 0.8 0.6 c 1450 1586 m 8 27 d -13
- -16 d f 0 0.6 0.8 c 1432 1521 m -18 -46 d -18 56 d f 0 0.8 0.8 c 1423 1579 m 11
- -53 d -2 -5 d -36 10 d -6 18 d 8 36 d f 0 0.8 0.6 c 1411 1638 m 12 -59 d -25 6
- d 12 53 d f 0 0.8 0.4 c 1411 1641 m -3 Y -1 X f 0 0.4 0.8 c 1372 1462 m -5 -26
- d 3 22 d f 0 0.6 0.8 c 1386 1528 m -14 -66 d -2 -4 d 9 56 d f 0 0.8 0.8 c 1387
- 1568 m 1 2 d 10 15 d -8 -36 d -4 -21 d -7 -14 d f 0 0.8 0.6 c 1388 1570 m 22 68
- d -12 -53 d f 0 0.8 0.4 c 1410 1638 m 1 3 d -1 -3 d f 0 0.2 0.8 c 1354 1396 m
- -11 -33 d 3 28 d f 0 0.4 0.8 c 1370 1458 m -3 -22 d -13 -40 d -8 -5 d 6 58 d f
- 0 0.6 0.8 c 1379 1514 m -9 -56 d -18 -9 d 5 58 d f 0 0.8 0.8 c 1384 1569 m 3 -1
- d -8 -54 d -22 -7 d 6 58 d f 0 0.8 0.6 c 1364 1575 m 20 -6 d -21 -4 d f 0 0.2
- 0.8 c 1346 1391 m -3 -28 d -23 20 d 1 3 d f 0 0.4 0.8 c 1352 1449 m -6 -58 d
- -25 -5 d 13 52 d f 0 0.6 0.8 c 1340 1462 m 8 35 d 9 10 d -5 -58 d -18 -11 d f 0
- 0.8 0.8 c 1348 1497 m 13 66 d 2 2 d -6 -58 d f 0 0.8 0.6 c 1361 1563 m 3 12 d
- -1 -10 d f 0 0.2 0.8 c 1321 1386 m -1 -3 d -2 3 d f 0 0.4 0.8 c 1334 1438 m -13
- -52 d -3 X -22 45 d 5 9 d f 0 0.6 0.8 c 1317 1469 m 23 -7 d -6 -24 d -33 2 d f
- 0 0.4 0.8 c 1293 1383 m 11 41 d -3 16 d -5 -9 d -3 11 d -7 -15 d f 0 0.6 0.8 c
- 1304 1424 m 13 45 d -16 -29 d -8 2 d -18 58 d -1 -2 d 12 -71 d f 0 0.8 0.8 c
- 1275 1500 m -2 6 d 1 -8 d f 0 0.4 0.8 c 1270 1390 m 23 -7 d -7 44 d -26 -4 d f
- 0 0.6 0.8 c 1286 1427 m -12 71 d -5 X -20 -38 d 11 -37 d f 0 0.8 0.8 c 1274
- 1498 m -1 8 d -4 -8 d f 0 0.4 0.8 c 1266 1415 m 4 -25 d -10 33 d f 0 0.6 0.8 c
- 1257 1474 m 9 -59 d -6 8 d -11 37 d -23 -33 d 9 53 d f 0 0.8 0.8 c 1248 1534 m
- 9 -60 d -22 6 d 9 55 d f 0 0.8 0.6 c 1246 1546 m 2 -12 d -4 1 d f 0 0.2 0.8 c
- 1204 1357 m -2 -3 d 1 3 d f 0 0.4 0.8 c 1225 1425 m -21 -68 d -1 X 9 55 d f 0
- 0.6 0.8 c 1235 1480 m -9 -53 d -1 -2 d -13 -13 d 10 54 d f 0 0.8 0.8 c 1223
- 1472 m 19 61 d 2 2 d -9 -55 d -13 -14 d f 0 0.8 0.6 c 1242 1533 m 4 13 d -2 -11
- d f 0 0.2 0.8 c 1203 1357 m -1 -3 d -2 2 d f 0 0.4 0.8 c 1212 1412 m -9 -55 d
- -3 -1 d -21 32 d 3 23 d f 0 0.6 0.8 c 1222 1466 m -10 -54 d -30 -1 d 7 56 d f 0
- 0.8 0.8 c 1207 1524 m 16 -52 d -1 -6 d -33 1 d 7 57 d f 0 0.8 0.6 c 1199 1547 m
- 8 -23 d -11 X f 0 0.4 0.8 c 1182 1411 m -3 -23 d -24 -20 d 4 37 d f 0 0.6 0.8 c
- 1189 1467 m -7 -56 d -23 -6 d 5 58 d f 0 0.8 0.8 c 1196 1524 m -7 -57 d -25 -4
- d 5 58 d f 0 0.8 0.6 c 1183 1580 m 16 -33 d -3 -23 d -27 -3 d 5 58 d f 0 0.8
- 0.4 c 1176 1595 m 7 -15 d -9 -1 d f 0 0.4 0.8 c 1159 1405 m -4 -37 d -16 35 d f
- 0 0.6 0.8 c 1164 1463 m -5 -58 d -20 -2 d -7 13 d 18 34 d f 0 0.8 0.8 c 1152
- 1454 m 10 58 d 7 9 d -5 -58 d -14 -13 d f 0 0.8 0.6 c 1162 1512 m 11 65 d 1 2 d
- -5 -58 d f 0 0.8 0.4 c 1173 1577 m 3 18 d -2 -16 d f 0 0.6 0.8 c 1150 1450 m
- -18 -34 d -24 8 d 11 26 d f 0 0.8 0.8 c 1129 1475 m 23 -21 d -2 -4 d -31 X f 0
- 0.4 0.8 c 1092 1391 m -7 -14 d 2 11 d f 0 0.6 0.8 c 1119 1450 m -11 -26 d -16
- -33 d -5 -3 d 9 55 d f 0 0.8 0.8 c 1105 1496 m 24 -21 d -10 -25 d -23 -7 d f 0
- 0.4 0.8 c 1087 1388 m -2 -11 d -10 10 d f 0 0.6 0.8 c 1096 1443 m -9 -55 d -12
- -1 d -14 11 d 15 36 d f 0 0.8 0.8 c 1082 1450 m 23 46 d -9 -53 d -20 -9 d f 0
- 0.4 0.8 c 1048 1380 m -10 -15 d 2 11 d f 0 0.6 0.8 c 1076 1434 m -15 -36 d -13
- -18 d -8 -4 d 8 56 d f 0 0.8 0.8 c 1063 1487 m 19 -37 d -6 -16 d -28 -2 d 9 55
- d f 0 0.8 0.6 c 1058 1498 m 5 -11 d -6 X f 0 0.4 0.8 c 1040 1376 m -2 -11 d -23
- -6 d 12 Y f 0 0.6 0.8 c 1048 1432 m -8 -56 d -25 -5 d 5 58 d f 0 0.8 0.8 c 1057
- 1487 m -9 -55 d -28 -3 d 5 59 d f 0 0.8 0.6 c 1049 1546 m 9 -48 d -1 -11 d -32
- 1 d 5 58 d f 0 0.8 0.4 c 1036 1605 m 13 -59 d -19 X 4 59 d f 0 0.8 0.2 c 1035
- 1613 m 1 -8 d -2 X f 0 0.4 0.8 c 1011 1338 m 1 12 d 3 21 d -12 Y -24 -32 d f 0
- 0.6 0.8 c 1012 1350 m 6 64 d 2 15 d -5 -58 d f 0 0.8 0.8 c 1018 1414 m 5 63 d 2
- 11 d -5 -59 d f 0 0.8 0.6 c 1023 1477 m 6 64 d 1 5 d -5 -58 d f 0 0.8 0.4 c
- 1029 1541 m 5 63 d 1 Y -4 -59 d f 0 0.8 0.2 c 1034 1604 m 1 9 d -1 -8 d f 0 0.4
- 0.8 c 1009 1349 m 2 -11 d -20 -11 d -8 36 d f 0 0.6 0.8 c 998 1409 m 11 -60 d
- -26 14 d -14 59 d f 0 0.8 0.8 c 988 1466 m 10 -57 d -29 13 d -1 6 d f 0 0.6 0.8
- c 965 1421 m -21 -53 d 9 41 d f 0 0.8 0.8 c 964 1460 m 24 6 d -20 -38 d -3 -7 d
- -12 -12 d f 0 0.4 0.8 c 931 1350 m -10 -14 d 3 9 d f 0 0.6 0.8 c 953 1409 m -9
- -41 d -13 -18 d -7 -5 d 15 50 d f 0 0.8 0.8 c 941 1401 m 23 59 d -11 -51 d -14
- -14 d f 0 0.4 0.8 c 924 1345 m -3 -9 d -24 -20 d 6 20 d f 0 0.6 0.8 c 917 1381
- m 12 10 d 10 4 d -15 -50 d -21 -9 d f 0 0.8 0.8 c 929 1391 m 12 10 d -2 -6 d f
- 0 0.4 0.8 c 903 1336 m -6 -20 d -23 -19 d 6 33 d f 0 0.6 0.8 c 912 1386 m 5 -5
- d -14 -45 d -23 -6 d 11 55 d f 0 0.8 0.8 c 894 1402 m 18 -16 d -21 -1 d f 0 0.4
- 0.8 c 880 1330 m -6 -33 d -24 -6 d 7 33 d f 0 0.6 0.8 c 891 1385 m -11 -55 d
- -23 -6 d 10 55 d f 0 0.8 0.8 c 870 1396 m 24 6 d -3 -17 d -24 -6 d f 0 0.4 0.8
- c 857 1324 m -7 -33 d -23 7 d 4 22 d f 0 0.6 0.8 c 867 1379 m -10 -55 d -26 -4
- d 12 53 d f 0 0.8 0.8 c 847 1390 m 23 6 d -3 -17 d -24 -6 d f 0 0.4 0.8 c 831
- 1320 m -4 -22 d -24 -19 d 4 35 d f 0 0.6 0.8 c 843 1373 m -12 -53 d -24 -6 d 7
- 57 d f 0 0.8 0.8 c 832 1428 m 15 -38 d -4 -17 d -29 -2 d 7 57 d f 0 0.8 0.6 c
- 823 1451 m 9 -23 d -11 X f 0 0.4 0.8 c 807 1314 m -4 -35 d -22 33 d f 0 0.6 0.8
- c 800 1338 m 4 21 d 10 12 d -7 -57 d -26 -2 d -1 1 d f 0 0.8 0.8 c 804 1359 m
- 14 66 d 3 3 d -7 -57 d f 0 0.8 0.6 c 818 1425 m 5 26 d -2 -23 d f 0 0.4 0.8 c
- 779 1311 m -23 -58 d 5 49 d f 0 0.6 0.8 c 796 1357 m 4 -19 d -20 -25 d -1 -2 d
- -18 -9 d 6 57 d f 0 0.8 0.8 c 784 1416 m 12 -59 d -29 2 d 6 58 d f 0 0.8 0.6 c
- 776 1453 m 8 -37 d -11 1 d f 0 0.4 0.8 c 761 1302 m -5 -49 d -11 50 d f 0 0.6
- 0.8 c 767 1359 m -6 -57 d -16 1 d -12 52 d 1 5 d f 0 0.8 0.8 c 773 1417 m -6
- -58 d -33 1 d 16 51 d f 0 0.8 0.6 c 753 1420 m 23 33 d -3 -36 d -23 -6 d f 0
- 0.6 0.8 c 734 1360 m -1 -5 d -24 -6 d 5 3 d f 0 0.8 0.8 c 730 1360 m 18 47 d 2
- 4 d -16 -51 d -20 -8 d f 0 0.8 0.6 c 748 1407 m 5 13 d -3 -9 d f 0 0.4 0.8 c
- 695 1290 m -9 -41 d 19 24 d f 0 0.6 0.8 c 706 1274 m 18 65 d -10 13 d -5 -3 d
- -14 -59 d 10 -17 d f 0 0.8 0.8 c 724 1339 m 6 21 d -16 -8 d f 0 0.4 0.8 c 705
- 1273 m -19 -24 d -23 33 d f 0 0.6 0.8 c 696 1332 m 10 -58 d -1 -1 d -42 9 d -1
- 1 d 9 54 d f 0 0.8 0.8 c 687 1391 m 9 -59 d -25 5 d 8 56 d f 0 0.8 0.6 c 683
- 1415 m 4 -24 d -8 2 d f 0 0.6 0.8 c 671 1337 m -9 -54 d -23 21 d 6 29 d f 0 0.8
- 0.8 c 679 1393 m -8 -56 d -26 -4 d 12 53 d f 0 0.8 0.6 c 659 1396 m 24 19 d -4
- -22 d -22 -7 d f 0 0.4 0.8 c 636 1215 m 5 40 d -15 6 d f 0 0.6 0.8 c 641 1255 m
- 8 65 d -4 13 d -6 -29 d -24 8 d 11 -51 d f 0 0.8 0.8 c 649 1320 m 8 64 d 2 Y
- -12 -53 d f 0 0.8 0.6 c 657 1384 m 2 12 d -2 -10 d f 0 0.4 0.8 c 631 1253 m 5
- -38 d -10 46 d -21 6 d -13 -55 d 4 48 d f 0 0.6 0.8 c 625 1313 m 6 -60 d -5 8 d
- -11 51 d -10 -45 d -9 -7 d 6 58 d f 0 0.8 0.8 c 618 1374 m 7 -61 d -23 5 d 5 58
- d f 0 0.8 0.6 c 612 1424 m 6 -50 d -11 2 d f 0 0.4 0.8 c 596 1260 m -4 -48 d
- -13 48 d f 0 0.6 0.8 c 602 1318 m -6 -58 d -17 X -11 40 d 15 8 d f 0 0.8 0.8 c
- 589 1311 m 12 58 d 6 7 d -5 -58 d -19 -10 d f 0 0.8 0.6 c 601 1369 m 11 55 d -5
- -48 d f 0 0.6 0.8 c 583 1308 m -15 -8 d -23 -47 d 5 57 d f 0 0.8 0.8 c 581 1364
- m 8 -53 d -6 -3 d -33 2 d 5 58 d f 0 0.8 0.6 c 573 1424 m 8 -60 d -26 4 d 5 58
- d f 0 0.8 0.4 c 565 1480 m 8 -56 d -13 2 d f 0 0.4 0.8 c 544 1251 m -23 -44 d 9
- 32 d f 0 0.6 0.8 c 542 1286 m 6 Y 8 18 d -5 -57 d -1 -2 d -14 -12 d f 0 0.8 0.8
- c 542 1292 m 8 65 d 5 11 d -5 -58 d f 0 0.8 0.6 c 550 1357 m 8 64 d 2 5 d -5
- -58 d f 0 0.8 0.4 c 558 1421 m 7 59 d -5 -54 d f 0 0 0.8 c 518 1038 m 6 63 d
- -16 17 d -10 -65 d f 0 0.2 0.8 c 524 1101 m 6 64 d -12 18 d -10 -65 d f 0 0.4
- 0.8 c 530 1165 m 6 64 d -6 10 d -9 -32 d -3 -24 d f 0 0.6 0.8 c 536 1229 m 6 57
- d -12 -47 d f 0 0 0.8 c 495 1032 m 23 6 d -20 15 d -24 -6 d f 471 1026 m 24 6 d
- -21 15 d -23 -6 d f 448 1020 m 23 6 d -20 15 d -24 -6 d f 1548 1279 m 24 6 d
- -20 16 d -24 -6 d f 1525 1273 m 23 6 d -20 16 d -23 -6 d f 1501 1267 m 24 6 d
- -20 16 d -24 -6 d f 1497 1328 m 4 -61 d -20 16 d -4 61 d f 0 0.2 0.8 c 1492
- 1389 m 5 -61 d -20 16 d -5 61 d f 0 0.4 0.8 c 1487 1450 m 5 -61 d -20 16 d -4
- 61 d f 0 0.6 0.8 c 1482 1511 m 5 -61 d -19 16 d -4 61 d f 0 0.8 0.8 c 1478 1557
- m 4 -46 d -18 16 d -5 61 d 11 -10 d f 0 0.8 0.6 c 1459 1588 m -1 25 d 12 -35 d
- f 0 0.8 0.8 c 1455 1551 m 23 6 d -8 21 d -20 8 d -16 -60 d f 0 0.8 0.6 c 1470
- 1578 m -12 35 d -8 -27 d f 0 0.8 0.8 c 1451 1565 m 4 -14 d -21 -25 d -11 53 d f
- 0 0.8 0.6 c 1435 1623 m 16 -58 d -28 14 d -12 59 d f 0 0.8 0.4 c 1431 1639 m 4
- -16 d -24 15 d 3 Y f 0 0.8 0.8 c 1388 1570 m -1 -2 d 1 1 d f 0 0.8 0.6 c 1408
- 1579 m 16 41 d -14 18 d -22 -68 d -1 Y f 0 0.8 0.4 c 1424 1620 m 7 19 d -20 2 d
- -1 -3 d f 0 0.8 0.8 c 1384 1533 m 9 17 d -5 19 d -1 -1 d -3 1 d -11 -12 d f 0
- 0.8 0.6 c 1393 1550 m 15 29 d -20 -10 d -4 X -20 6 d 9 -18 d f 0 0.6 0.8 c 1348
- 1497 m -8 -35 d 4 31 d f 0 0.8 0.8 c 1380 1547 m 4 -14 d -11 24 d -12 6 d -13
- -66 d -4 -4 d 7 56 d f 0 0.8 0.6 c 1365 1605 m 15 -58 d -7 10 d -9 18 d -3 -12
- d -10 -14 d 8 57 d f 0 0.8 0.4 c 1361 1621 m 4 -16 d -6 1 d f 0 0.6 0.8 c 1344
- 1493 m -4 -31 d -23 7 d 10 13 d f 0 0.8 0.8 c 1337 1494 m 8 44 d 6 11 d -7 -56
- d -17 -11 d f 0 0.8 0.6 c 1345 1538 m 12 65 d 2 3 d -8 -57 d f 0 0.8 0.4 c 1357
- 1603 m 4 18 d -2 -15 d f 0 0.4 0.8 c 1304 1424 m -11 -41 d 3 36 d f 0 0.6 0.8 c
- 1327 1482 m -10 -13 d -13 -45 d -8 -5 d 5 58 d f 0 0.8 0.8 c 1330 1534 m 7 -40
- d -10 -12 d -26 -5 d 5 59 d f 0 0.8 0.6 c 1319 1594 m 11 -60 d -24 2 d 5 58 d f
- 0 0.8 0.4 c 1314 1623 m 5 -29 d -8 X f 0 0.4 0.8 c 1296 1419 m -3 -36 d -23 7 d
- 4 22 d f 0 0.6 0.8 c 1301 1477 m -5 -58 d -22 -7 d 10 54 d f 0 0.8 0.8 c 1290
- 1496 m 6 30 d 10 10 d -5 -59 d -17 -11 d f 0 0.8 0.6 c 1296 1526 m 12 65 d 3 3
- d -5 -58 d f 0 0.8 0.4 c 1308 1591 m 6 32 d -3 -29 d f 0 0.4 0.8 c 1274 1412 m
- -4 -22 d -4 25 d f 0 0.6 0.8 c 1284 1466 m -10 -54 d -8 3 d -9 59 d f 0 0.8 0.8
- c 1267 1517 m 23 -21 d -6 -30 d -27 8 d -9 60 d 16 -14 d f 0 0.8 0.6 c 1248
- 1534 m -2 12 d 18 -26 d f 0 0.8 0.8 c 1266 1518 m 1 -1 d -3 3 d -22 13 d -19
- -61 d 7 50 d f 0 0.8 0.6 c 1251 1576 m 15 -58 d -2 2 d -18 26 d -4 -13 d -12
- -11 d 9 56 d f 0 0.8 0.4 c 1243 1605 m 8 -29 d -12 2 d f 0 0.8 0.8 c 1230 1522
- m -7 -50 d -16 52 d f 0 0.8 0.6 c 1239 1578 m -9 -56 d -23 2 d -8 23 d 19 23 d
- f 0 0.8 0.4 c 1220 1572 m 23 33 d -4 -27 d -21 -8 d f 0 0.6 0.8 c 1196 1418 m 3
- 21 d -5 1 d f 0 0.8 0.8 c 1199 1439 m 10 65 d -23 4 d 8 -68 d f 0 0.8 0.6 c
- 1209 1504 m 10 64 d -1 2 d -19 -23 d -16 33 d -5 -4 d 8 -68 d f 0 0.8 0.4 c
- 1219 1568 m 1 4 d -2 -2 d -35 10 d -7 15 d 2 -19 d f 0 0.6 0.8 c 1192 1437 m 4
- -19 d -2 22 d f 0 0.8 0.8 c 1180 1496 m 12 -59 d 2 3 d -8 68 d -24 4 d -10 -58
- d 12 47 d f 0 0.8 0.6 c 1173 1533 m 7 -37 d 6 12 d -8 68 d -5 1 d -11 -65 d 2
- -11 d f 0 0.8 0.4 c 1178 1576 m -2 19 d -3 -18 d f 0 0.8 0.8 c 1164 1501 m -12
- -47 d -23 21 d 8 22 d f 0 0.8 0.6 c 1149 1527 m 24 6 d -9 -32 d -27 -4 d f 0
- 0.8 0.8 c 1137 1497 m -8 -22 d -24 21 d 3 X f 0 0.8 0.6 c 1126 1494 m 23 33 d
- -12 -30 d -29 -1 d f 0 0.8 0.8 c 1108 1496 m -3 X -23 -46 d 9 35 d f 0 0.8 0.6
- c 1102 1528 m 24 -34 d -18 2 d -17 -11 d f 0 0.8 0.8 c 1091 1485 m -9 -35 d -19
- 37 d f 0 0.8 0.6 c 1098 1537 m 4 -9 d -11 -43 d -28 2 d -5 11 d 11 42 d f 0 0.8
- 0.4 c 1079 1576 m 19 -39 d -29 3 d f 0 0.8 0.8 c 1055 1409 m 8 58 d -14 2 d f 0
- 0.8 0.6 c 1063 1467 m 9 64 d -3 9 d -11 -42 d -9 48 d -7 -10 d 7 -67 d f 0 0.8
- 0.4 c 1072 1531 m 7 45 d -10 -36 d -20 6 d -13 59 d -1 Y 6 -68 d f 0 0.8 0.2 c
- 1036 1605 m -1 8 d 1 -9 d f 0 0.4 0.8 c 1012 1350 m -1 -12 d 1 11 d f 0 0.6 0.8
- c 1018 1414 m -6 -64 d -1 Y 5 58 d f 0 0.8 0.8 c 1048 1463 m 7 -54 d -6 60 d
- -26 8 d -5 -63 d -1 -7 d 5 59 d f 0 0.8 0.6 c 1039 1523 m 9 -60 d 1 6 d -7 67 d
- -13 5 d -6 -64 d -1 -11 d 5 58 d f 0 0.8 0.4 c 1032 1578 m 7 -55 d 3 13 d -6 68
- d -2 X -5 -63 d -2 -17 d f 0 0.8 0.2 c 1036 1604 m -1 9 d -1 -9 d f 0 0.4 0.8 c
- 1012 1349 m -1 -11 d -2 11 d f 0 0.6 0.8 c 1017 1407 m -5 -58 d -3 X -11 60 d f
- 0 0.8 0.8 c 1008 1451 m 1 2 d 13 13 d -5 -59 d -19 2 d -10 57 d f 0 0.8 0.6 c
- 1009 1453 m 12 65 d 6 6 d -5 -58 d f 0 0.8 0.4 c 1021 1518 m 11 60 d -5 -54 d f
- 0 0.8 0.8 c 1008 1452 m -1 Y -20 15 d -24 -6 d 1 2 d f 0 0.8 0.6 c 996 1511 m
- 12 -59 d -43 10 d 10 54 d f 0 0.8 0.4 c 985 1566 m 11 -55 d -21 5 d f 0 0.8 0.8
- c 961 1439 m 1 2 d 3 21 d -1 -2 d -23 -59 d f 0 0.8 0.6 c 962 1441 m 12 65 d 1
- 10 d -10 -54 d f 0 0.8 0.4 c 974 1506 m 11 60 d -10 -50 d f 0 0.6 0.8 c 929
- 1391 m -12 -10 d 1 6 d f 0 0.8 0.8 c 961 1440 m -1 Y -20 -38 d -12 -10 d -11 -4
- d 8 56 d f 0 0.8 0.6 c 945 1499 m 16 -59 d -35 3 d 8 57 d f 0 0.8 0.4 c 938
- 1527 m 7 -28 d -11 1 d f 0 0.6 0.8 c 918 1387 m -1 -6 d -5 5 d f 0 0.8 0.8 c
- 926 1443 m -8 -56 d -6 -1 d -18 16 d 5 38 d f 0 0.8 0.6 c 934 1500 m -8 -57 d
- -27 -3 d 8 56 d f 0 0.8 0.4 c 914 1548 m 24 -21 d -4 -27 d -27 -4 d f 0 0.8 0.8
- c 899 1440 m -5 -38 d -24 -6 d 8 37 d f 0 0.8 0.6 c 907 1496 m -8 -56 d -21 -7
- d 10 54 d f 0 0.8 0.4 c 891 1502 m 23 46 d -7 -52 d -19 -9 d f 0 0.8 0.8 c 878
- 1433 m -8 -37 d -23 -6 d 7 37 d f 0 0.8 0.6 c 888 1487 m -10 -54 d -24 -6 d 10
- 54 d f 0 0.8 0.4 c 867 1496 m 24 6 d -3 -15 d -24 -6 d f 0 0.8 0.8 c 854 1427 m
- -7 -37 d -15 38 d f 0 0.8 0.6 c 864 1481 m -10 -54 d -22 1 d -9 23 d 5 34 d f 0
- 0.8 0.4 c 857 1538 m 10 -42 d -3 -15 d -36 4 d 8 56 d f 0 0.8 0.2 c 844 1597 m
- 13 -59 d -21 3 d f 0 0.6 0.8 c 804 1359 m -4 -21 d 6 15 d f 0 0.8 0.8 c 820
- 1390 m 2 15 d -4 20 d -14 -66 d 2 -6 d f 0 0.8 0.6 c 822 1405 m 7 64 d -1 16 d
- -5 -34 d -5 -26 d f 0 0.8 0.4 c 829 1469 m 8 64 d -1 8 d -8 -56 d f 0 0.8 0.2 c
- 837 1533 m 7 64 d -8 -56 d f 0 0.6 0.8 c 806 1353 m -6 -15 d -4 19 d f 0 0.8
- 0.8 c 818 1404 m 2 -14 d -14 -37 d -10 4 d -12 59 d f 0 0.8 0.6 c 811 1464 m 7
- -60 d -34 12 d -8 37 d 4 21 d f 0 0.8 0.4 c 803 1525 m 8 -61 d -31 10 d 9 55 d
- f 0 0.8 0.2 c 797 1572 m 6 -47 d -14 4 d f 0 0.8 0.6 c 780 1474 m -4 -21 d -23
- -33 d 5 46 d f 0 0.8 0.4 c 789 1529 m -9 -55 d -22 -8 d 7 57 d f 0 0.8 0.2 c
- 785 1582 m 12 -10 d -8 -43 d -24 -6 d 7 57 d f 0 0.8 0 c 773 1593 m 12 -11 d
- -13 -2 d f 0 0.8 0.8 c 748 1407 m -18 -47 d 7 36 d f 0 0.8 0.6 c 758 1466 m -5
- -46 d -5 -13 d -11 -11 d 12 53 d f 0 0.8 0.4 c 750 1452 m 10 62 d 5 9 d -7 -57
- d -9 -17 d f 0 0.8 0.2 c 760 1514 m 11 65 d 1 1 d -7 -57 d f 0 0.8 0 c 771 1579
- m 2 14 d -1 -13 d f 0 0.6 0.8 c 724 1339 m -18 -65 d 9 53 d f 0 0.8 0.8 c 737
- 1396 m -7 -36 d -6 -21 d -9 -12 d 10 55 d f 0 0.8 0.6 c 726 1392 m 22 56 d 1 1
- d -12 -53 d -12 -14 d f 0 0.8 0.4 c 748 1448 m 2 4 d -1 -3 d f 0 0.6 0.8 c 715
- 1327 m -9 -53 d -10 58 d f 0 0.8 0.8 c 703 1373 m 3 3 d 19 6 d -10 -55 d -19 5
- d -9 59 d 15 -15 d f 0 0.8 0.6 c 706 1376 m 20 16 d -1 -10 d -38 9 d -4 24 d 19
- -39 d f 0 0.8 0.8 c 703 1375 m -2 Y -1 3 d f 0 0.8 0.6 c 693 1434 m 10 -59 d -1
- 1 d -19 39 d -24 -19 d 8 45 d f 0 0.8 0.4 c 683 1494 m 10 -60 d -26 7 d 9 55 d
- f 0 0.8 0.2 c 679 1515 m 4 -21 d -7 2 d f 0 0.4 0.8 c 641 1255 m -5 -40 d 2 37
- d f 0 0.6 0.8 c 649 1320 m -8 -65 d -3 -3 d 4 59 d f 0 0.8 0.8 c 657 1384 m -8
- -64 d -7 -9 d 4 59 d f 0 0.8 0.6 c 667 1441 m -8 -45 d -2 -12 d -11 -14 d 4 60
- d f 0 0.8 0.4 c 676 1496 m -9 -55 d -17 -11 d 4 59 d f 0 0.8 0.2 c 656 1522 m
- 23 -7 d -3 -19 d -22 -7 d f 0 0.4 0.8 c 638 1252 m -2 -37 d -5 38 d f 0 0.6 0.8
- c 642 1311 m -4 -59 d -7 1 d -6 60 d f 0 0.8 0.8 c 646 1370 m -4 -59 d -17 2 d
- -7 61 d f 0 0.8 0.6 c 650 1430 m -4 -60 d -28 4 d -6 50 d 3 8 d f 0 0.8 0.4 c
- 632 1476 m 3 6 d 19 7 d -4 -59 d -35 2 d f 0 0.8 0.2 c 635 1482 m 21 40 d -2
- -33 d f 0 0.8 0.8 c 601 1369 m -12 -58 d 16 43 d f 0 0.8 0.6 c 609 1363 m 11 53
- d -5 16 d -3 -8 d -11 -55 d 4 -15 d f 0 0.8 0.4 c 620 1416 m 12 60 d -17 -44 d
- f 0 0.8 0.8 c 605 1354 m -16 -43 d -8 53 d f 0 0.8 0.6 c 585 1383 m 24 -20 d -4
- -9 d -24 10 d -8 60 d 6 -12 d f 0 0.8 0.4 c 573 1424 m -8 56 d 14 -68 d f 0 0.6
- 0.8 c 542 1292 m -6 Y 2 4 d f 0 0.8 0.8 c 562 1324 m 7 17 d -19 16 d -8 -65 d 2
- -2 d f 0 0.8 0.6 c 569 1341 m 16 42 d -6 29 d -21 9 d -8 -64 d f 0 0.8 0.4 c
- 579 1412 m -14 68 d -7 -59 d f 0 0 0.8 c 538 1022 m 5 64 d -19 15 d -6 -63 d f
- 0 0.2 0.8 c 543 1086 m 5 63 d -18 16 d -6 -64 d f 0 0.4 0.8 c 548 1149 m 5 63 d
- -17 17 d -6 -64 d f 0 0.6 0.8 c 553 1212 m 5 64 d -14 14 d -2 -4 d -6 -57 d f 0
- 0.8 0.8 c 558 1276 m 4 48 d -18 -34 d f 0 0 0.8 c 515 1016 m 23 6 d -20 16 d
- -23 -6 d f 491 1010 m 24 6 d -20 16 d -24 -6 d f 468 1004 m 23 6 d -20 16 d -23
- -6 d f 1569 1264 m 23 6 d -20 15 d -24 -6 d f 1545 1258 m 24 6 d -21 15 d -23
- -6 d f 1522 1252 m 23 6 d -20 15 d -24 -6 d f 1519 1313 m 3 -61 d -21 15 d -4
- 61 d f 0 0.2 0.8 c 1516 1375 m 3 -62 d -22 15 d -5 61 d f 0 0.4 0.8 c 1513 1436
- m 3 -61 d -24 14 d -5 61 d f 0 0.6 0.8 c 1510 1497 m 3 -61 d -26 14 d -5 61 d f
- 0 0.8 0.8 c 1508 1559 m 2 -62 d -28 14 d -4 46 d 1 14 d f 0 0.8 0.6 c 1505 1620
- m 3 -61 d -29 12 d 6 58 d f 0 0.8 0.4 c 1502 1682 m 3 -62 d -20 9 d 6 57 d f 0
- 0.8 0.2 c 1499 1743 m 3 -61 d -11 4 d 6 58 d f 0 0.8 0 c 1498 1756 m 1 -13 d -2
- 1 d f 0 0.8 0.8 c 1479 1571 m -1 -14 d -23 -6 d 1 14 d f 0 0.8 0.6 c 1485 1629
- m -6 -58 d -23 -6 d 6 58 d f 0 0.8 0.4 c 1491 1686 m -6 -57 d -23 -6 d 6 57 d f
- 0 0.8 0.2 c 1497 1744 m -6 -58 d -23 -6 d 6 58 d f 0 0.8 0 c 1475 1750 m 23 6 d
- -1 -12 d -23 -6 d f 0 0.8 0.8 c 1456 1565 m -1 -14 d -4 14 d f 0 0.8 0.6 c 1462
- 1623 m -6 -58 d -5 X -16 58 d f 0 0.8 0.4 c 1468 1680 m -6 -57 d -27 X -4 16 d
- 4 42 d f 0 0.8 0.2 c 1474 1738 m -6 -58 d -33 1 d 5 59 d f 0 0.8 0 c 1465 1797
- m 10 -47 d -1 -12 d -34 2 d 5 58 d f 0.2 0.8 0 c 1453 1856 m 12 -59 d -20 1 d 6
- 58 d f 0.4 0.8 0 c 1451 1865 m 2 -9 d -2 X f 0 0.8 0.6 c 1424 1620 m -16 -41 d
- 6 33 d f 0 0.8 0.4 c 1435 1681 m -4 -42 d -7 -19 d -10 -8 d 10 54 d f 0 0.8 0.2
- c 1428 1685 m 5 41 d 7 14 d -5 -59 d -11 -15 d f 0 0.8 0 c 1433 1726 m 9 65 d 3
- 7 d -5 -58 d f 0.2 0.8 0 c 1442 1791 m 8 64 d 1 1 d -6 -58 d f 0.4 0.8 0 c 1450
- 1855 m 1 10 d -9 Y f 0 0.8 0.8 c 1393 1550 m -9 -17 d 3 13 d f 0 0.8 0.6 c 1414
- 1612 m -6 -33 d -15 -29 d -6 -4 d 14 52 d f 0 0.8 0.4 c 1404 1612 m 16 49 d 4 5
- d -10 -54 d -13 -14 d f 0 0.8 0.2 c 1420 1661 m 8 24 d -4 -19 d f 0 0.8 0.8 c
- 1387 1546 m -3 -13 d -4 14 d f 0 0.8 0.6 c 1401 1598 m -14 -52 d -7 1 d -15 58
- d f 0 0.8 0.4 c 1393 1654 m 11 -42 d -3 -14 d -36 7 d -4 16 d 9 38 d f 0 0.8
- 0.2 c 1381 1700 m 12 -46 d -23 5 d f 0 0.8 0.8 c 1345 1538 m -8 -44 d 3 40 d f
- 0 0.8 0.6 c 1357 1603 m -12 -65 d -5 -4 d 4 59 d f 0 0.8 0.4 c 1370 1659 m -9
- -38 d -4 -18 d -13 -10 d 5 59 d f 0 0.8 0.2 c 1377 1712 m 4 -12 d -11 -41 d -21
- -7 d 4 59 d f 0 0.8 0 c 1359 1770 m 18 -58 d -24 -1 d 4 59 d f 0.2 0.8 0 c 1357
- 1774 m 2 -4 d -2 X f 0 0.8 0.8 c 1340 1534 m -3 -40 d -7 40 d f 0 0.8 0.6 c
- 1344 1593 m -4 -59 d -10 X -11 60 d f 0 0.8 0.4 c 1349 1652 m -5 -59 d -25 1 d
- -5 29 d 8 25 d f 0 0.8 0.2 c 1334 1688 m 4 14 d 15 9 d -4 -59 d -27 -4 d f 0
- 0.8 0 c 1338 1702 m 18 67 d 1 1 d -4 -59 d f 0.2 0.8 0 c 1356 1769 m 1 5 d -4 Y
- f 0 0.8 0.8 c 1296 1526 m -6 -30 d 3 26 d f 0 0.8 0.6 c 1308 1591 m -12 -65 d
- -3 -4 d 6 58 d f 0 0.8 0.4 c 1322 1648 m -8 -25 d -6 -32 d -9 -11 d 6 57 d f 0
- 0.8 0.2 c 1310 1695 m 24 -7 d -12 -40 d -17 -11 d f 0 0.8 0.8 c 1293 1522 m -3
- -26 d -23 21 d 1 Y f 0 0.8 0.6 c 1299 1580 m -6 -58 d -26 -4 d 6 58 d f 0 0.8
- 0.4 c 1305 1637 m -6 -57 d -26 -4 d 6 57 d f 0 0.8 0.2 c 1310 1695 m -5 -58 d
- -26 -4 d 5 58 d f 0 0.8 0 c 1287 1716 m 23 -21 d -26 -4 d f 0 0.8 0.8 c 1267
- 1518 m -1 Y -1 1 d f 0 0.8 0.6 c 1273 1576 m -6 -58 d -1 X -15 58 d f 0 0.8 0.4
- c 1263 1616 m 2 5 d 14 12 d -6 -57 d -22 X -8 29 d f 0 0.8 0.2 c 1265 1621 m 15
- 66 d 4 4 d -5 -58 d f 0 0.8 0 c 1280 1687 m 7 29 d -3 -25 d f 0 0.8 0.4 c 1262
- 1621 m 1 -5 d -20 -11 d -23 -33 d 8 52 d f 0 0.8 0.2 c 1247 1679 m 15 -58 d -34
- 3 d 8 56 d f 0 0.8 0 c 1240 1704 m 7 -25 d -11 1 d f 0 0.6 0.8 c 1199 1439 m -3
- -21 d 2 18 d f 0 0.8 0.8 c 1209 1504 m -10 -65 d -1 -3 d 8 57 d f 0 0.8 0.6 c
- 1219 1568 m -10 -64 d -3 -11 d 7 57 d f 0 0.8 0.4 c 1216 1577 m 7 34 d 5 13 d
- -8 -52 d -1 -4 d -6 -18 d f 0 0.8 0.2 c 1223 1611 m 12 65 d 1 4 d -8 -56 d f 0
- 0.8 0 c 1235 1676 m 5 28 d -4 -24 d f 0 0.6 0.8 c 1198 1436 m -2 -18 d -4 19 d
- f 0 0.8 0.8 c 1206 1493 m -8 -57 d -6 1 d -12 59 d f 0 0.8 0.6 c 1213 1550 m -7
- -57 d -26 3 d -7 37 d 6 19 d f 0 0.8 0.4 c 1193 1598 m 23 -21 d -3 -27 d -34 2
- d f 0 0.8 0.6 c 1179 1552 m -6 -19 d -24 -6 d 2 22 d f 0 0.8 0.4 c 1192 1603 m
- 1 -5 d -14 -46 d -28 -3 d 6 58 d f 0 0.8 0.2 c 1182 1663 m 10 -60 d -35 4 d 5
- 58 d f 0 0.8 0 c 1172 1722 m 10 -59 d -20 2 d 6 58 d f 0.2 0.8 0 c 1170 1740 m
- 2 -18 d -4 1 d f 0 0.8 0.6 c 1151 1549 m -2 -22 d -23 -33 d 19 36 d f 0 0.8 0.4
- c 1146 1532 m 7 61 d 4 14 d -6 -58 d -6 -19 d f 0 0.8 0.2 c 1153 1593 m 7 64 d
- 2 8 d -5 -58 d f 0 0.8 0 c 1160 1657 m 7 64 d 1 2 d -6 -58 d f 0.2 0.8 0 c 1167
- 1721 m 3 19 d -2 -17 d f 0 0.8 0.6 c 1145 1530 m -19 -36 d -24 34 d 2 9 d f 0
- 0.8 0.4 c 1135 1588 m 11 -56 d -1 -2 d -41 7 d 9 55 d f 0 0.8 0.2 c 1123 1647 m
- 12 -59 d -22 4 d f 0 0.8 0.6 c 1104 1537 m -2 -9 d -4 9 d f 0 0.8 0.4 c 1099
- 1547 m 8 34 d 6 11 d -9 -55 d -6 X -19 39 d f 0 0.8 0.2 c 1107 1581 m 16 66 d
- -10 -55 d f 0 0.8 0.8 c 1063 1467 m -8 -58 d 3 53 d f 0 0.8 0.6 c 1072 1531 m
- -9 -64 d -5 -5 d 4 60 d f 0 0.8 0.4 c 1096 1578 m 3 -31 d -20 29 d -7 -45 d -10
- -9 d 3 59 d f 0 0.8 0.2 c 1089 1639 m 7 -61 d -31 3 d 4 60 d f 0 0.8 0 c 1082
- 1699 m 7 -60 d -20 2 d 3 59 d f 0.2 0.8 0 c 1076 1756 m 6 -57 d -10 1 d f 0 0.8
- 0.8 c 1058 1462 m -3 -53 d -7 54 d f 0 0.8 0.6 c 1062 1522 m -4 -60 d -10 1 d
- -9 60 d f 0 0.8 0.4 c 1065 1581 m -3 -59 d -23 1 d -7 55 d 2 3 d f 0 0.8 0.2 c
- 1052 1602 m 4 28 d 13 11 d -4 -60 d -31 X f 0 0.8 0 c 1056 1630 m 10 65 d 6 5 d
- -3 -59 d f 0.2 0.8 0 c 1066 1695 m 10 61 d -4 -56 d f 0 0.8 0.8 c 1009 1453 m
- -1 -2 d 1 1 d f 0 0.8 0.6 c 1021 1518 m -12 -65 d -1 Y 11 53 d f 0 0.8 0.4 c
- 1029 1543 m 8 20 d -3 18 d -2 -3 d -11 -60 d -1 -13 d f 0 0.8 0.2 c 1037 1563 m
- 15 39 d -18 -21 d f 0 0.8 0.8 c 1009 1452 m -1 -1 d 1 Y f 0 0.8 0.6 c 1020 1505
- m -11 -53 d -1 X -12 59 d f 0 0.8 0.4 c 1012 1557 m 17 -14 d -9 -38 d -24 6 d
- -11 55 d 7 -1 d f 0 0.8 0.2 c 1005 1564 m 7 -7 d -20 8 d f 0 0.8 0.8 c 962 1441
- m -1 -2 d 1 1 d f 0 0.8 0.6 c 974 1506 m -12 -65 d -1 Y 11 53 d f 0 0.8 0.4 c
- 982 1531 m 16 22 d -6 12 d -7 1 d -11 -60 d -1 -13 d f 0 0.8 0.2 c 998 1553 m 7
- 11 d -13 1 d f 0 0.8 0.8 c 962 1440 m -1 -1 d 1 Y f 0 0.8 0.6 c 973 1493 m -11
- -53 d -1 X -16 59 d f 0 0.8 0.4 c 979 1549 m 3 -18 d -9 -38 d -28 6 d -7 28 d 4
- 29 d f 0 0.8 0.2 c 969 1608 m 10 -59 d -37 7 d 8 56 d f 0 0.8 0 c 959 1668 m 10
- -60 d -19 4 d 7 56 d f 0.2 0.8 0 c 958 1673 m 1 -5 d -2 X f 0 0.8 0.4 c 935
- 1492 m 6 47 d 1 17 d -4 -29 d -24 21 d f 0 0.8 0.2 c 941 1539 m 8 64 d 1 9 d -8
- -56 d f 0 0.8 0 c 949 1603 m 8 64 d 1 Y -7 -56 d f 0.2 0.8 0 c 957 1667 m 1 6 d
- -1 -5 d f 0 0.8 0.6 c 911 1432 m 16 41 d -30 7 d f 0 0.8 0.4 c 927 1473 m 8 19
- d -21 56 d -23 -46 d 6 -22 d f 0 0.8 0.6 c 898 1466 m 13 -34 d -14 48 d f 0 0.8
- 0.4 c 888 1493 m 10 -27 d -1 14 d -6 22 d -24 -6 d f 881 1524 m 7 -31 d -21 3 d
- -10 42 d f 0 0.8 0.2 c 869 1583 m 12 -59 d -24 14 d -13 59 d f 0 0.8 0 c 864
- 1608 m 5 -25 d -25 14 d f 0 0.8 0.8 c 822 1405 m -2 -15 d 3 12 d f 0 0.8 0.6 c
- 829 1469 m -7 -64 d 1 -3 d 12 54 d f 0 0.8 0.4 c 841 1481 m 6 34 d -10 18 d -8
- -64 d 6 -13 d f 0 0.8 0.2 c 847 1515 m 12 65 d -15 17 d -7 -64 d f 0 0.8 0 c
- 859 1580 m 5 28 d -20 -11 d f 0 0.8 0.8 c 823 1402 m -3 -12 d -2 14 d f 0 0.8
- 0.6 c 835 1456 m -12 -54 d -5 2 d -7 60 d f 0 0.8 0.4 c 835 1512 m 6 -31 d -6
- -25 d -24 8 d -8 61 d f 0 0.8 0.2 c 824 1571 m 11 -59 d -32 13 d -6 47 d 5 9 d
- f 0 0.8 0 c 817 1610 m 7 -39 d -22 10 d f 0 0.8 0.2 c 802 1581 m -5 -9 d -12 10
- d f 0 0.8 0 c 811 1630 m 6 -20 d -15 -29 d -17 1 d -12 11 d 10 41 d f 0.2 0.8 0
- c 794 1685 m 17 -55 d -28 4 d f 0 0.8 0.4 c 760 1514 m -10 -62 d 9 52 d f 0 0.8
- 0.2 c 771 1579 m -11 -65 d -1 -10 d 9 55 d f 0 0.8 0 c 770 1571 m 11 51 d 2 12
- d -10 -41 d -2 -14 d -3 -20 d f 0.2 0.8 0 c 781 1622 m 13 63 d -11 -51 d f 0
- 0.8 0.6 c 748 1448 m -22 -56 d 7 46 d f 0 0.8 0.4 c 759 1504 m -9 -52 d -2 -4 d
- -15 -10 d 8 56 d f 0 0.8 0.2 c 747 1538 m 11 17 d 10 4 d -9 -55 d -18 -10 d f 0
- 0.8 0 c 758 1555 m 12 16 d -2 -12 d f 0 0.8 0.8 c 706 1376 m -3 -3 d 1 1 d f 0
- 0.8 0.6 c 723 1384 m 6 39 d 4 15 d -7 -46 d -20 -16 d -2 -2 d f 0 0.8 0.4 c 729
- 1423 m 10 65 d 2 6 d -8 -56 d f 0 0.8 0.2 c 739 1488 m 8 50 d -6 -44 d f 0 0.8
- 0.8 c 704 1374 m -1 -1 d 2 Y f 0 0.8 0.6 c 710 1418 m 13 -34 d -19 -10 d -1 1 d
- -10 59 d f 0 0.8 0.4 c 700 1446 m 10 -28 d -17 16 d -10 60 d 5 -7 d f 0 0.8 0.2
- c 683 1494 m -4 21 d 9 -28 d f 0 0.8 0.4 c 695 1476 m 5 -30 d -12 41 d f 0 0.8
- 0.2 c 687 1536 m 8 -60 d -7 11 d -9 28 d -23 7 d 5 23 d f 0 0.8 0 c 679 1596 m
- 8 -60 d -26 9 d 12 54 d f 0.2 0.8 0 c 676 1614 m 3 -18 d -6 3 d f 0 0.8 0.4 c
- 635 1482 m -3 -6 d 1 4 d f 0 0.8 0.2 c 661 1545 m -5 -23 d -21 -40 d -2 -2 d 12
- 54 d f 0 0.8 0 c 653 1568 m 12 25 d 8 6 d -12 -54 d -16 -11 d f 0.2 0.8 0 c 665
- 1593 m 11 21 d -3 -15 d f 0 0.8 0.6 c 620 1416 m -11 -53 d 8 44 d f 0 0.8 0.4 c
- 633 1480 m -1 -4 d -12 -60 d -3 -9 d 11 54 d f 0 0.8 0.2 c 629 1468 m 14 57 d 2
- 9 d -12 -54 d -5 -19 d f 0 0.8 0 c 643 1525 m 10 43 d -8 -34 d f 0 0.8 0.6 c
- 617 1407 m -8 -44 d -24 20 d 3 22 d f 0 0.8 0.4 c 628 1461 m -11 -54 d -29 -2 d
- 6 58 d f 0 0.8 0.2 c 619 1519 m 10 -51 d -1 -7 d -34 2 d 5 58 d f 0 0.8 0 c 607
- 1578 m 12 -59 d -20 2 d 6 57 d f 0.2 0.8 0 c 606 1583 m 1 -5 d -2 X f 0 0.8 0.8
- c 569 1341 m -7 -17 d 6 11 d f 0 0.8 0.6 c 582 1362 m 3 24 d 3 19 d -3 -22 d
- -16 -42 d -1 -6 d f 0 0.8 0.4 c 585 1386 m 7 64 d 2 13 d -6 -58 d f 0 0.8 0.2 c
- 592 1450 m 6 64 d 1 7 d -5 -58 d f 0 0.8 0 c 598 1514 m 7 64 d -6 -57 d f 0.2
- 0.8 0 c 605 1578 m 1 5 d -1 -5 d f 0 0 0.8 c 559 1007 m 4 63 d -20 16 d -5 -64
- d f 0 0.2 0.8 c 563 1070 m 4 63 d -19 16 d -5 -63 d f 0 0.4 0.8 c 567 1133 m 4
- 63 d -18 16 d -5 -63 d f 0 0.6 0.8 c 571 1196 m 5 63 d -18 17 d -5 -64 d f 0
- 0.8 0.8 c 576 1259 m 4 64 d -12 12 d -6 -11 d -4 -48 d f 0 0.8 0.6 c 580 1323 m
- 2 39 d -14 -27 d f 0 0 0.8 c 535 1001 m 24 6 d -21 15 d -23 -6 d f 512 995 m 23
- 6 d -20 15 d -24 -6 d f 488 989 m 24 6 d -21 15 d -23 -6 d f 1589 1248 m 24 6 d
- -21 16 d -23 -6 d f 1566 1242 m 23 6 d -20 16 d -24 -6 d f 1542 1236 m 24 6 d
- -21 16 d -23 -6 d f 1540 1298 m 2 -62 d -20 16 d -3 61 d f 0 0.2 0.8 c 1538
- 1360 m 2 -62 d -21 15 d -3 62 d f 0 0.4 0.8 c 1536 1421 m 2 -61 d -22 15 d -3
- 61 d f 0 0.6 0.8 c 1534 1483 m 2 -62 d -23 15 d -3 61 d f 0 0.8 0.8 c 1532 1545
- m 2 -62 d -24 14 d -2 62 d f 0 0.8 0.6 c 1531 1606 m 1 -61 d -24 14 d -3 61 d f
- 0 0.8 0.4 c 1529 1668 m 2 -62 d -26 14 d -3 62 d f 0 0.8 0.2 c 1527 1729 m 2
- -61 d -27 14 d -3 61 d f 0 0.8 0 c 1525 1791 m 2 -62 d -28 14 d -1 13 d 4 46 d
- f 0.2 0.8 0 c 1523 1853 m 2 -62 d -23 11 d 6 58 d f 0.4 0.8 0 c 1521 1914 m 2
- -61 d -15 7 d 5 58 d f 0.6 0.8 0 c 1519 1976 m 2 -62 d -8 4 d 5 58 d f 0.8 0.8
- 0 c 1519 1983 m -7 Y -1 X f 0 0.8 0 c 1502 1802 m -4 -46 d -23 -6 d 10 41 d f
- 0.2 0.8 0 c 1495 1829 m 3 17 d 10 14 d -6 -58 d -17 -11 d f 0.4 0.8 0 c 1498
- 1846 m 10 65 d 5 7 d -5 -58 d f 0.6 0.8 0 c 1508 1911 m 10 65 d -5 -58 d f 0.8
- 0.8 0 c 1518 1976 m 1 7 d -1 -7 d f 0 0.8 0 c 1485 1791 m -10 -41 d -10 47 d f
- 0.2 0.8 0 c 1481 1842 m 14 -13 d -10 -38 d -20 6 d -12 59 d f 0.4 0.8 0 c 1472
- 1850 m 9 -8 d -28 14 d -2 9 d f 0 0.8 0.6 c 1448 1562 m 2 24 d -6 3 d f 0 0.8
- 0.4 c 1450 1586 m 5 63 d -23 11 d 12 -71 d f 0 0.8 0.2 c 1455 1649 m 6 64 d -28
- 13 d -5 -41 d 4 -25 d f 0 0.8 0 c 1461 1713 m 5 63 d -24 15 d -9 -65 d f 0.2
- 0.8 0 c 1466 1776 m 5 64 d -21 15 d -8 -64 d f 0.4 0.8 0 c 1471 1840 m 1 10 d
- -21 15 d -1 -10 d f 0 0.8 0.6 c 1446 1585 m 2 -23 d -4 27 d f 0 0.8 0.4 c 1442
- 1646 m 4 -61 d -2 4 d -12 71 d -12 1 d -16 -49 d 4 42 d f 0 0.8 0.2 c 1437 1707
- m 5 -61 d -10 14 d -4 25 d -8 -24 d -12 -7 d 5 59 d f 0 0.8 0 c 1432 1768 m 5
- -61 d -24 6 d 4 58 d f 0.2 0.8 0 c 1428 1829 m 4 -61 d -15 3 d 5 59 d f 0.4 0.8
- 0 c 1425 1865 m 3 -36 d -6 1 d f 0 0.8 0.4 c 1401 1630 m 1 6 d 6 18 d -4 -42 d
- -11 42 d 6 -17 d f 0 0.8 0.2 c 1402 1636 m 6 63 d 5 14 d -5 -59 d -15 X -12 46
- d 18 -63 d f 0 0.8 0 c 1408 1699 m 7 64 d 2 8 d -4 -58 d f 0.2 0.8 0 c 1415
- 1763 m 6 64 d 1 3 d -5 -59 d f 0.4 0.8 0 c 1421 1827 m 4 38 d -3 -35 d f 0 0.8
- 0.4 c 1401 1635 m -5 Y -2 7 d f 0 0.8 0.2 c 1394 1696 m 7 -61 d -2 2 d -18 63 d
- -4 12 d f 0 0.8 0 c 1387 1756 m 7 -60 d -17 16 d -18 58 d f 0.2 0.8 0 c 1380
- 1817 m 7 -61 d -28 14 d -2 4 d 15 46 d f 0.4 0.8 0 c 1378 1839 m 2 -22 d -8 3 d
- f 0 0.8 0.2 c 1338 1702 m -4 -14 d 2 11 d f 0 0.8 0 c 1356 1769 m -18 -67 d -2
- -3 d 11 55 d f 0.2 0.8 0 c 1354 1793 m 10 19 d 8 8 d -15 -46 d -1 -5 d -9 -15 d
- f 0.4 0.8 0 c 1364 1812 m 14 27 d -6 -19 d f 0 0.8 0.2 c 1336 1699 m -2 -11 d
- -24 7 d f 0 0.8 0 c 1347 1754 m -11 -55 d -26 -4 d 11 54 d f 0.2 0.8 0 c 1331
- 1801 m 23 -8 d -7 -39 d -26 -5 d f 0 0.8 0 c 1321 1749 m -11 -54 d -23 21 d 9
- 29 d f 0.2 0.8 0 c 1307 1781 m 24 20 d -10 -52 d -25 -4 d f 0 0.8 0.4 c 1265
- 1621 m -2 -5 d 4 2 d f 0 0.8 0.2 c 1284 1627 m 6 42 d -10 18 d -15 -66 d 2 -3 d
- f 0 0.8 0 c 1290 1669 m 10 65 d -4 11 d -9 -29 d -7 -29 d f 0.2 0.8 0 c 1300
- 1734 m 7 47 d -11 -36 d f 0 0.8 0.4 c 1267 1618 m -4 -2 d -1 5 d f 0 0.8 0.2 c
- 1260 1608 m 24 19 d -17 -9 d -5 3 d -15 58 d -7 Y f 0 0.8 0 c 1247 1679 m -7 25
- d 7 -32 d f 0 0.8 0.4 c 1223 1611 m -7 -34 d 4 29 d f 0 0.8 0.2 c 1251 1659 m 9
- -51 d -13 64 d -12 4 d -12 -65 d -3 -5 d 7 57 d f 0 0.8 0 c 1240 1719 m 11 -60
- d -4 13 d -7 32 d -5 -28 d -8 -13 d 8 56 d f 0.2 0.8 0 c 1237 1736 m 3 -17 d -5
- X f 0 0.8 0.4 c 1220 1606 m -4 -29 d -23 21 d 3 3 d f 0 0.8 0.2 c 1213 1623 m 6
- 28 d 8 12 d -7 -57 d -24 -5 d f 0 0.8 0 c 1219 1651 m 14 66 d 2 2 d -8 -56 d f
- 0.2 0.8 0 c 1233 1717 m 4 19 d -2 -17 d f 0 0.8 0.4 c 1196 1601 m -3 -3 d -1 5
- d f 0 0.8 0.2 c 1210 1649 m 3 -26 d -17 -22 d -4 2 d -10 60 d f 0 0.8 0 c 1203
- 1709 m 7 -60 d -28 14 d -10 59 d f 0.2 0.8 0 c 1196 1770 m 7 -61 d -31 13 d -2
- 18 d 9 36 d f 0.4 0.8 0 c 1190 1818 m 6 -48 d -17 6 d f 0 0.8 0.4 c 1153 1593 m
- -7 -61 d 6 55 d f 0 0.8 0.2 c 1160 1657 m -7 -64 d -1 -6 d 6 57 d f 0 0.8 0 c
- 1167 1721 m -7 -64 d -2 -13 d 6 57 d f 0.2 0.8 0 c 1166 1718 m 11 47 d 2 11 d
- -9 -36 d -3 -19 d -3 -20 d f 0.4 0.8 0 c 1177 1765 m 13 53 d -11 -42 d f 0 0.8
- 0.4 c 1143 1551 m 3 19 d 6 17 d -6 -55 d -11 56 d 3 -15 d f 0 0.8 0.2 c 1146
- 1570 m 9 65 d 3 9 d -6 -57 d -17 1 d -12 59 d 15 -74 d f 0 0.8 0 c 1155 1635 m
- 9 64 d 2 Y -6 -57 d -35 3 d f 0.2 0.8 0 c 1164 1699 m 2 19 d -2 -17 d f 0 0.8
- 0.4 c 1139 1569 m 4 -18 d -5 22 d -31 8 d -8 -34 d 5 28 d f 0 0.8 0.2 c 1125
- 1627 m 14 -58 d -1 4 d -15 74 d -16 -66 d -3 -6 d 11 54 d f 0 0.8 0 c 1119 1653
- m 6 -26 d -2 20 d -8 -18 d f 0 0.8 0.4 c 1104 1575 m -5 -28 d -3 31 d f 0 0.8
- 0.2 c 1115 1629 m -11 -54 d -8 3 d -7 61 d f 0 0.8 0 c 1104 1684 m 15 -31 d -4
- -24 d -26 10 d -7 60 d f 0.2 0.8 0 c 1096 1700 m 8 -16 d -22 15 d -6 57 d f 0
- 0.8 0.2 c 1056 1630 m -4 -28 d 14 17 d f 0 0.8 0 c 1072 1627 m 17 53 d -23 15 d
- -10 -65 d 10 -11 d f 0.2 0.8 0 c 1089 1680 m 7 20 d -20 56 d -10 -61 d f 0 0.8
- 0.4 c 1037 1563 m -8 -20 d 1 17 d f 0 0.8 0.2 c 1066 1619 m -14 -17 d -15 -39 d
- -7 -3 d 6 58 d f 0 0.8 0 c 1063 1674 m 9 -47 d -6 -8 d -30 -1 d 6 57 d f 0.2
- 0.8 0 c 1051 1733 m 12 -59 d -21 1 d 6 58 d f 0.4 0.8 0 c 1049 1742 m 2 -9 d -3
- X f 0 0.8 0.4 c 1030 1560 m -1 -17 d -17 14 d f 0 0.8 0.2 c 1025 1588 m 3 14 d
- 8 16 d -6 -58 d -18 -3 d -7 7 d f 0 0.8 0 c 1028 1602 m 9 65 d 5 8 d -6 -57 d f
- 0.2 0.8 0 c 1037 1667 m 10 65 d 1 1 d -6 -58 d f 0.4 0.8 0 c 1047 1732 m 2 10 d
- -1 -9 d f 0 0.8 0.4 c 998 1553 m -16 -22 d 7 13 d f 0 0.8 0.2 c 1002 1569 m 23
- 19 d -20 -24 d -7 -11 d -9 -9 d f 0 0.8 0.4 c 989 1544 m -7 -13 d -3 18 d f 0
- 0.8 0.2 c 986 1592 m 16 -23 d -13 -25 d -10 5 d -10 59 d f 0 0.8 0 c 978 1603 m
- 8 -11 d -17 16 d -10 60 d 1 -2 d f 0.2 0.8 0 c 959 1668 m -1 5 d 2 -7 d f 0 0.8
- 0.4 c 941 1539 m -6 -47 d 3 43 d f 0 0.8 0.2 c 949 1603 m -8 -64 d -3 -4 d 5 58
- d f 0 0.8 0 c 970 1650 m 8 -47 d -18 63 d -3 1 d -8 -64 d -6 -10 d 5 58 d f 0.2
- 0.8 0 c 959 1709 m 11 -59 d -10 16 d -2 7 d -1 -6 d -9 -16 d 5 59 d f 0.4 0.8 0
- c 955 1732 m 4 -23 d -6 1 d f 0 0.8 0.6 c 927 1473 m -16 -41 d 2 36 d f 0 0.8
- 0.4 c 938 1535 m -3 -43 d -8 -19 d -14 -5 d 3 59 d f 0 0.8 0.2 c 943 1593 m -5
- -58 d -22 -8 d 4 60 d f 0 0.8 0 c 948 1651 m -5 -58 d -23 -6 d 3 59 d f 0.2 0.8
- 0 c 953 1710 m -5 -59 d -25 -5 d 4 60 d f 0.4 0.8 0 c 941 1767 m 14 -35 d -2
- -22 d -26 -4 d 3 60 d f 0.6 0.8 0 c 931 1793 m 10 -26 d -11 -1 d f 0 0.8 0.6 c
- 913 1468 m -2 -36 d -13 34 d f 0 0.8 0.4 c 916 1527 m -3 -59 d -15 -2 d -10 27
- d 7 27 d f 0 0.8 0.2 c 908 1572 m 12 15 d -4 -60 d -21 -7 d f 0 0.8 0 c 908
- 1572 m 7 64 d 8 10 d -3 -59 d f 0.2 0.8 0 c 915 1636 m 7 64 d 5 6 d -4 -60 d f
- 0.4 0.8 0 c 922 1700 m 6 64 d 2 2 d -3 -60 d f 0.6 0.8 0 c 928 1764 m 3 29 d -1
- -27 d f 0 0.8 0.4 c 895 1520 m -7 -27 d -7 31 d f 0 0.8 0.2 c 908 1572 m -13
- -52 d -14 4 d -12 59 d f 0 0.8 0 c 884 1606 m 24 -34 d -39 11 d -5 25 d f 0 0.8
- 0.4 c 847 1515 m -6 -34 d 2 31 d f 0 0.8 0.2 c 859 1580 m -12 -65 d -4 -3 d 5
- 58 d f 0 0.8 0 c 881 1627 m 3 -21 d -20 2 d -5 -28 d -11 -10 d 4 59 d f 0.2 0.8
- 0 c 870 1687 m 11 -60 d -29 2 d 5 58 d f 0.4 0.8 0 c 861 1735 m 9 -48 d -13 X f
- 0 0.8 0.4 c 838 1460 m 2 33 d 3 19 d -2 -31 d -6 31 d -2 -16 d f 0 0.8 0.2 c
- 840 1493 m 6 63 d 2 14 d -5 -58 d -8 X -11 59 d -1 -6 d 10 -69 d f 0 0.8 0 c
- 846 1556 m 5 64 d 1 9 d -4 -59 d -24 1 d -7 39 d 6 -45 d f 0.2 0.8 0 c 851 1620
- m 6 63 d 4 Y -5 -58 d f 0.4 0.8 0 c 857 1683 m 4 52 d -4 -48 d f 0 0.8 0.4 c
- 833 1491 m 5 -31 d -5 36 d f 0 0.8 0.2 c 825 1551 m 8 -60 d 5 Y -10 69 d f 0
- 0.8 0 c 817 1611 m 8 -60 d -2 14 d -6 45 d -6 20 d f 0.2 0.8 0 c 814 1629 m 3
- -18 d -6 19 d -17 55 d f 0 0.8 0 c 791 1582 m 12 25 d -22 15 d -11 -51 d f 0.2
- 0.8 0 c 803 1607 m 11 22 d -20 56 d -13 -63 d f 0 0.8 0.2 c 758 1555 m -11 -17
- d 1 13 d f 0 0.8 0 c 788 1604 m 3 -22 d -21 -11 d -12 -16 d -10 -4 d 5 58 d f
- 0.2 0.8 0 c 781 1664 m 7 -60 d -35 5 d 5 59 d f 0.4 0.8 0 c 774 1724 m 7 -60 d
- -23 4 d 5 58 d f 0.6 0.8 0 c 767 1778 m 7 -54 d -11 2 d f 0 0.8 0.6 c 729 1423
- m -6 -39 d 3 35 d f 0 0.8 0.4 c 739 1488 m -10 -65 d -3 -4 d 5 58 d f 0 0.8 0.2
- c 748 1551 m -1 -13 d -8 -50 d -8 -11 d 5 59 d f 0 0.8 0 c 753 1609 m -5 -58 d
- -12 -15 d 5 58 d f 0.2 0.8 0 c 744 1624 m 4 32 d 10 12 d -5 -59 d -12 -15 d f
- 0.4 0.8 0 c 748 1656 m 10 64 d 5 6 d -5 -58 d f 0.6 0.8 0 c 758 1720 m 9 58 d
- -4 -52 d f 0 0.8 0.6 c 726 1419 m -3 -35 d -13 34 d f 0 0.8 0.4 c 731 1477 m -5
- -58 d -16 -1 d -10 28 d 7 26 d f 0 0.8 0.2 c 720 1524 m 16 12 d -5 -59 d -24 -5
- d f 0 0.8 0 c 720 1524 m 16 66 d 5 4 d -5 -58 d f 0.2 0.8 0 c 736 1590 m 8 34 d
- -3 -30 d f 0 0.8 0.4 c 707 1472 m -7 -26 d -5 30 d f 0 0.8 0.2 c 720 1524 m -13
- -52 d -12 4 d -8 60 d f 0 0.8 0 c 697 1572 m 23 -48 d -33 12 d -8 60 d 11 -11 d
- f 0.2 0.8 0 c 679 1596 m -3 18 d 14 -29 d f 0 0.8 0 c 695 1580 m 2 -8 d -7 13 d
- -25 8 d -12 -25 d 3 20 d f 0.2 0.8 0 c 685 1640 m 10 -60 d -5 5 d -14 29 d -11
- -21 d -9 -5 d 7 56 d f 0.4 0.8 0 c 675 1699 m 10 -59 d -22 4 d 8 56 d f 0.6 0.8
- 0 c 673 1714 m 2 -15 d -4 1 d f 0 0.8 0.2 c 643 1525 m -14 -57 d 8 48 d f 0 0.8
- 0 c 656 1588 m -3 -20 d -10 -43 d -6 -9 d 10 54 d f 0.2 0.8 0 c 650 1587 m 8 46
- d 5 11 d -7 -56 d -9 -18 d f 0.4 0.8 0 c 658 1633 m 12 65 d 1 2 d -8 -56 d f
- 0.6 0.8 0 c 670 1698 m 3 16 d -2 -14 d f 0 0.8 0.2 c 637 1516 m -8 -48 d -10 51
- d f 0 0.8 0 c 647 1570 m -10 -54 d -18 3 d -12 59 d f 0.2 0.8 0 c 640 1628 m 10
- -41 d -3 -17 d -40 8 d -1 5 d 9 50 d f 0.4 0.8 0 c 626 1687 m 14 -59 d -25 5 d
- 11 54 d f 0.6 0.8 0 c 626 1688 m -1 Y f 0 0.8 0.6 c 585 1386 m -3 -24 d 2 23 d
- f 0 0.8 0.4 c 592 1450 m -7 -64 d -1 -1 d 3 59 d f 0 0.8 0.2 c 598 1514 m -6
- -64 d -5 -6 d 3 60 d f 0 0.8 0 c 605 1578 m -7 -64 d -8 -10 d 3 60 d f 0.2 0.8
- 0 c 615 1633 m -9 -50 d -1 -5 d -12 -14 d 3 59 d f 0.4 0.8 0 c 626 1687 m -11
- -54 d -19 -10 d 4 60 d f 0.6 0.8 0 c 603 1736 m 23 -48 d -1 Y -26 -4 d f 0 0
- 0.8 c 579 991 m 2 63 d -18 16 d -4 -63 d f 0 0.2 0.8 c 581 1054 m 2 62 d -16 17
- d -4 -63 d f 0 0.4 0.8 c 583 1116 m 2 63 d -14 17 d -4 -63 d f 0 0.6 0.8 c 585
- 1179 m 2 63 d -11 17 d -5 -63 d f 0 0.8 0.8 c 587 1242 m 2 62 d -9 19 d -4 -64
- d f 0 0.8 0.6 c 589 1304 m 2 63 d -7 18 d -2 -23 d -2 -39 d f 0 0.8 0.4 c 591
- 1367 m 2 63 d -6 14 d -3 -59 d f 0 0.8 0.2 c 593 1430 m 2 62 d -5 12 d -3 -60 d
- f 0 0.8 0 c 595 1492 m 2 63 d -4 9 d -3 -60 d f 0.2 0.8 0 c 597 1555 m 2 63 d
- -3 5 d -3 -59 d f 0.4 0.8 0 c 599 1618 m 2 62 d -1 3 d -4 -60 d f 0.6 0.8 0 c
- 601 1680 m 2 56 d -3 -53 d f 0 0 0.8 c 556 985 m 23 6 d -20 16 d -24 -6 d f 532
- 979 m 24 6 d -21 16 d -23 -6 d f 509 973 m 23 6 d -20 16 d -24 -6 d f 1610 1233
- m 23 6 d -20 15 d -24 -6 d f 1586 1227 m 24 6 d -21 15 d -23 -6 d f 1563 1221 m
- 23 6 d -20 15 d -24 -6 d f 1560 1282 m 3 -61 d -21 15 d -2 62 d f 0 0.2 0.8 c
- 1558 1344 m 2 -62 d -20 16 d -2 62 d f 0 0.4 0.8 c 1556 1406 m 2 -62 d -20 16 d
- -2 61 d f 0 0.6 0.8 c 1554 1467 m 2 -61 d -20 15 d -2 62 d f 0 0.8 0.8 c 1552
- 1529 m 2 -62 d -20 16 d -2 62 d f 0 0.8 0.6 c 1550 1590 m 2 -61 d -20 16 d -1
- 61 d f 0 0.8 0.4 c 1548 1652 m 2 -62 d -19 16 d -2 62 d f 0 0.8 0.2 c 1546 1714
- m 2 -62 d -19 16 d -2 61 d f 0 0.8 0 c 1544 1775 m 2 -61 d -19 15 d -2 62 d f
- 0.2 0.8 0 c 1542 1837 m 2 -62 d -19 16 d -2 62 d f 0.4 0.8 0 c 1540 1898 m 2
- -61 d -19 16 d -2 61 d f 0.6 0.8 0 c 1539 1913 m 1 -15 d -19 16 d -2 62 d 2 -2
- d f 0.8 0.8 0 c 1519 1976 m 7 Y 2 -9 d f 0.2 0.8 0 c 1498 1846 m -3 -17 d 13 7
- d f 0.4 0.8 0 c 1516 1840 m 18 57 d -26 14 d -10 -65 d 10 -10 d f 0.6 0.8 0 c
- 1534 1897 m 5 16 d -18 61 d -3 2 d -10 -65 d f 0.8 0.8 0 c 1521 1974 m -2 9 d
- -1 -7 d f 0.2 0.8 0 c 1508 1836 m -13 -7 d -14 13 d f 0.4 0.8 0 c 1492 1848 m
- 24 -8 d -8 -4 d -27 6 d -9 8 d f 0 0.8 0.6 c 1450 1586 m -2 -24 d 2 22 d f 0
- 0.8 0.4 c 1455 1649 m -5 -63 d -2 Y 4 59 d f 0 0.8 0.2 c 1461 1713 m -6 -64 d
- -1 -6 d 4 59 d f 0 0.8 0 c 1466 1776 m -5 -63 d -3 -11 d 4 59 d f 0.2 0.8 0 c
- 1471 1840 m -5 -64 d -4 -15 d 4 59 d f 0.4 0.8 0 c 1469 1855 m 23 -7 d -20 2 d
- -1 -10 d -5 -20 d f 0 0.8 0.6 c 1450 1584 m -2 -22 d -2 23 d f 0 0.8 0.4 c 1454
- 1643 m -4 -59 d -4 1 d -4 61 d f 0 0.8 0.2 c 1458 1702 m -4 -59 d -12 3 d -5 61
- d f 0 0.8 0 c 1445 1728 m 4 23 d 13 10 d -4 -59 d -21 5 d -5 61 d 9 -15 d f 0.2
- 0.8 0 c 1449 1751 m 12 65 d 5 4 d -4 -59 d -30 7 d -4 61 d 3 -6 d 10 -70 d f
- 0.4 0.8 0 c 1461 1816 m 8 39 d -3 -35 d -38 9 d -3 36 d 6 -42 d f 0 0.8 0.4 c
- 1402 1636 m -1 -6 d 1 5 d f 0 0.8 0.2 c 1408 1699 m -6 -63 d -1 Y 7 57 d f 0
- 0.8 0 c 1437 1748 m 8 -20 d -4 25 d -26 10 d -7 -64 d 1 -7 d 7 56 d f 0.2 0.8 0
- c 1422 1789 m 15 -41 d 4 5 d -10 70 d -10 4 d -6 -64 d 1 -15 d f 0.4 0.8 0 c
- 1431 1823 m -6 42 d -4 -38 d f 0 0.8 0.4 c 1402 1635 m -1 -5 d 5 Y f 0 0.8 0.2
- c 1409 1692 m -7 -57 d -1 X -7 61 d f 0 0.8 0 c 1416 1748 m -7 -56 d -15 4 d -7
- 60 d f 0.2 0.8 0 c 1398 1784 m 24 5 d -6 -41 d -29 8 d -7 61 d 10 -10 d f 0.4
- 0.8 0 c 1380 1817 m -2 22 d 12 -32 d f 0 0.8 0 c 1375 1670 m 13 66 d -25 5 d f
- 0.2 0.8 0 c 1388 1736 m 10 48 d -8 23 d -26 5 d -10 -19 d 9 -52 d f 0.4 0.8 0 c
- 1390 1807 m -12 32 d -14 -27 d f 0 0.8 0 c 1371 1731 m 4 -61 d -12 71 d f 0.2
- 0.8 0 c 1367 1792 m 4 -61 d -8 10 d -9 52 d -23 8 d 3 Y f 0.4 0.8 0 c 1364 1854
- m 3 -62 d -36 12 d 5 58 d f 0.6 0.8 0 c 1360 1915 m 4 -61 d -28 8 d 4 59 d f
- 0.8 0.8 0 c 1357 1976 m 3 -61 d -20 6 d 4 59 d f 0.8 0.6 0 c 1353 2037 m 4 -61
- d -13 4 d 5 59 d f 0.8 0.4 0 c 1351 2067 m 2 -30 d -4 2 d f 0.2 0.8 0 c 1331
- 1804 m -3 Y -24 -20 d 5 14 d f 0.4 0.8 0 c 1336 1862 m -5 -58 d -19 -9 d 15 50
- d f 0.6 0.8 0 c 1328 1846 m 6 62 d 6 13 d -4 -59 d -9 -17 d f 0.8 0.8 0 c 1334
- 1908 m 7 64 d 3 8 d -4 -59 d f 0.8 0.6 0 c 1341 1972 m 7 64 d 1 3 d -5 -59 d f
- 0.8 0.4 0 c 1348 2036 m 3 31 d -2 -28 d f 0 0.8 0.2 c 1290 1669 m -6 -42 d 4 38
- d f 0 0.8 0 c 1300 1734 m -10 -65 d -2 -4 d 5 57 d f 0.2 0.8 0 c 1312 1795 m -5
- -14 d -7 -47 d -7 -12 d 6 58 d f 0.4 0.8 0 c 1304 1827 m 21 17 d 2 1 d -15 -50
- d -13 -15 d f 0.6 0.8 0 c 1325 1844 m 3 2 d -1 -1 d f 0 0.8 0.2 c 1288 1665 m
- -4 -38 d -24 -19 d 4 51 d f 0 0.8 0 c 1293 1722 m -5 -57 d -24 -6 d 5 58 d f
- 0.2 0.8 0 c 1299 1780 m -6 -58 d -24 -5 d 5 59 d f 0.4 0.8 0 c 1297 1837 m 7
- -10 d -5 -47 d -25 -4 d 4 58 d f 0.6 0.8 0 c 1281 1861 m 16 -24 d -19 -3 d f 0
- 0.8 0.2 c 1264 1659 m -4 -51 d -9 51 d f 0 0.8 0 c 1269 1717 m -5 -58 d -13 X
- -11 60 d f 0.2 0.8 0 c 1274 1776 m -5 -59 d -29 2 d -3 17 d 11 36 d f 0.4 0.8 0
- c 1257 1801 m 11 28 d 10 5 d -4 -58 d -26 -4 d f 0.6 0.8 0 c 1268 1829 m 13 32
- d -3 -27 d f 0 0.8 0.2 c 1219 1651 m -6 -28 d 3 25 d f 0 0.8 0 c 1233 1717 m
- -14 -66 d -3 -3 d 5 58 d f 0.2 0.8 0 c 1248 1772 m -11 -36 d -4 -19 d -12 -11 d
- 6 58 d f 0.4 0.8 0 c 1242 1823 m 15 -22 d -9 -29 d -21 -8 d 5 58 d f 0.6 0.8 0
- c 1234 1836 m 8 -13 d -10 -1 d f 0 0.8 0.2 c 1216 1648 m -3 -25 d -3 26 d f 0
- 0.8 0 c 1221 1706 m -5 -58 d -6 1 d -7 60 d f 0.2 0.8 0 c 1210 1736 m 4 18 d 13
- 10 d -6 -58 d -18 3 d -7 61 d 9 -14 d f 0.4 0.8 0 c 1214 1754 m 16 66 d 2 2 d
- -5 -58 d -31 6 d -6 48 d 15 -62 d f 0.6 0.8 0 c 1230 1820 m 4 16 d -2 -14 d f 0
- 0.8 0.2 c 1187 1595 m 4 28 d -9 3 d f 0 0.8 0 c 1191 1623 m 11 65 d -32 9 d 12
- -71 d f 0.2 0.8 0 c 1202 1688 m 8 48 d -5 20 d -28 9 d -11 -47 d 4 -21 d f 0.4
- 0.8 0 c 1205 1756 m -15 62 d -13 -53 d f 0 0.8 0.4 c 1146 1570 m -3 -19 d 2 17
- d f 0 0.8 0.2 c 1181 1621 m 6 -26 d -5 31 d -27 9 d -9 -65 d -1 -2 d 8 56 d f 0
- 0.8 0 c 1167 1679 m 14 -58 d 1 5 d -12 71 d -6 2 d -9 -64 d -2 -11 d 8 56 d f
- 0.2 0.8 0 c 1163 1697 m 4 -18 d 3 18 d -4 21 d -2 -19 d -3 -19 d f 0 0.8 0.4 c
- 1145 1568 m -2 -17 d -4 18 d f 0 0.8 0.2 c 1153 1624 m -8 -56 d -6 1 d -14 58 d
- f 0 0.8 0 c 1161 1680 m -8 -56 d -28 3 d -6 26 d 7 30 d f 0.2 0.8 0 c 1144 1736
- m 19 -39 d -2 -17 d -35 3 d 12 53 d f 0.4 0.8 0 c 1140 1745 m 4 -9 d -6 X f 0
- 0.8 0 c 1126 1683 m -7 -30 d -15 31 d f 0.2 0.8 0 c 1138 1736 m -12 -53 d -22 1
- d -8 16 d 11 36 d f 0.4 0.8 0 c 1116 1766 m 24 -21 d -2 -9 d -31 X f 0 0.8 0 c
- 1089 1680 m -17 -53 d 15 38 d f 0.2 0.8 0 c 1093 1679 m 12 47 d 2 10 d -11 -36
- d -7 -20 d -2 -15 d f 0.4 0.8 0 c 1105 1726 m 11 40 d -9 -30 d f 0 0.8 0 c 1087
- 1665 m -15 -38 d -9 47 d f 0.2 0.8 0 c 1069 1700 m 24 -21 d -6 -14 d -24 9 d
- -12 59 d 6 -7 d f 0.4 0.8 0 c 1051 1733 m -2 9 d 8 -16 d f 0 0.8 0.2 c 1028
- 1602 m -3 -14 d 2 13 d f 0 0.8 0 c 1037 1667 m -9 -65 d -1 -1 d 8 56 d f 0.2
- 0.8 0 c 1059 1714 m 10 -14 d -12 26 d -10 6 d -10 -65 d -2 -10 d 8 56 d f 0.4
- 0.8 0 c 1046 1734 m 13 -20 d -2 12 d -8 16 d -2 -10 d -4 -19 d f 0 0.8 0.2 c
- 1027 1601 m -2 -13 d -23 -19 d 8 21 d f 0 0.8 0 c 1022 1621 m 5 23 d 8 13 d -8
- -56 d -17 -11 d f 0.2 0.8 0 c 1027 1644 m 14 65 d 2 4 d -8 -56 d f 0.4 0.8 0 c
- 1041 1709 m 5 25 d -3 -21 d f 0 0.8 0.2 c 1010 1590 m -8 -21 d -16 23 d f 0 0.8
- 0 c 1019 1642 m 3 -21 d -12 -31 d -24 2 d -8 11 d 6 45 d f 0.2 0.8 0 c 1010
- 1702 m 9 -60 d -35 6 d 6 57 d f 0.4 0.8 0 c 1001 1761 m 9 -59 d -20 3 d 7 57 d
- f 0.6 0.8 0 c 999 1776 m 2 -15 d -4 1 d f 0 0.8 0 c 975 1622 m 2 9 d 7 17 d -6
- -45 d -8 47 d 3 -18 d f 0.2 0.8 0 c 977 1631 m 10 65 d 3 9 d -6 -57 d -14 2 d
- -11 59 d 1 -5 d 13 -72 d f 0.4 0.8 0 c 987 1696 m 9 64 d 1 2 d -7 -57 d -31 4 d
- -4 23 d 5 -28 d f 0.6 0.8 0 c 996 1760 m 3 16 d -2 -14 d f 0 0.8 0 c 952 1616 m
- 23 6 d -2 10 d -22 -7 d f 0.2 0.8 0 c 973 1632 m -13 72 d -17 -11 d 8 -68 d f
- 0.4 0.8 0 c 960 1704 m -5 28 d -14 35 d -6 -5 d 8 -69 d f 0.6 0.8 0 c 941 1767
- m -10 26 d 4 -31 d f 0 0.8 0 c 949 1624 m 3 -8 d -1 9 d -36 11 d -7 -64 d 10 54
- d f 0.2 0.8 0 c 928 1677 m 21 -53 d 2 1 d -8 68 d -21 7 d -7 -64 d 3 -10 d f
- 0.4 0.8 0 c 943 1693 m -8 69 d -7 2 d -6 -64 d f 0.6 0.8 0 c 935 1762 m -4 31 d
- -3 -29 d f 0 0.8 0 c 918 1626 m -10 -54 d -24 34 d 4 20 d f 0.2 0.8 0 c 927
- 1680 m 1 -3 d -10 -51 d -30 X 9 55 d f 0.4 0.8 0 c 905 1725 m 22 -45 d -30 1 d
- f 0 0.8 0 c 888 1626 m -4 -20 d -3 21 d f 0.2 0.8 0 c 897 1681 m -9 -55 d -7 1
- d -11 60 d f 0.4 0.8 0 c 881 1719 m 24 6 d -8 -44 d -27 6 d -9 48 d f 0 0.8 0.4
- c 840 1493 m -2 -33 d 2 30 d f 0 0.8 0.2 c 846 1556 m -6 -63 d -3 Y 5 58 d f 0
- 0.8 0 c 851 1620 m -5 -64 d -1 -8 d 5 59 d f 0.2 0.8 0 c 857 1683 m -6 -63 d -1
- -13 d 5 58 d f 0.4 0.8 0 c 858 1700 m 23 19 d -20 16 d -4 -52 d -2 -18 d f 0
- 0.8 0.4 c 840 1490 m -2 -30 d -5 31 d f 0 0.8 0.2 c 845 1548 m -5 -58 d -7 1 d
- -8 60 d f 0 0.8 0 c 850 1607 m -5 -59 d -20 3 d -8 60 d f 0.2 0.8 0 c 834 1613
- m 13 47 d 8 5 d -5 -58 d -33 4 d -3 18 d f 0.4 0.8 0 c 847 1660 m 11 40 d -3
- -35 d f 0 0.8 0 c 803 1607 m -12 -25 d 2 20 d f 0.2 0.8 0 c 826 1655 m 8 -42 d
- -20 16 d -11 -22 d -10 -5 d 8 56 d f 0.4 0.8 0 c 814 1714 m 12 -59 d -25 3 d 8
- 56 d f 0.6 0.8 0 c 811 1728 m 3 -14 d -5 X f 0 0.8 0 c 793 1602 m -2 -20 d -3
- 22 d f 0.2 0.8 0 c 801 1658 m -8 -56 d -5 2 d -7 60 d f 0.4 0.8 0 c 809 1714 m
- -8 -56 d -20 6 d -7 60 d f 0.6 0.8 0 c 804 1773 m 7 -45 d -2 -14 d -35 10 d -7
- 54 d 1 6 d f 0.8 0.8 0 c 795 1833 m 9 -60 d -36 11 d 11 54 d f 0.8 0.6 0 c 787
- 1883 m 8 -50 d -16 5 d f 0.2 0.8 0 c 748 1656 m -4 -32 d 1 29 d f 0.4 0.8 0 c
- 758 1720 m -10 -64 d -3 -3 d 4 59 d f 0.6 0.8 0 c 768 1784 m -1 -6 d -9 -58 d
- -9 -8 d 4 59 d f 0.8 0.8 0 c 779 1838 m -11 -54 d -15 -13 d 4 59 d f 0.8 0.6 0
- c 783 1892 m 4 -9 d -8 -45 d -22 -8 d 4 60 d f 0.8 0.4 0 c 764 1931 m 19 -39 d
- -22 -2 d f 0 0.8 0 c 736 1590 m -16 -66 d 5 58 d f 0.2 0.8 0 c 745 1653 m -1
- -29 d -8 -34 d -11 -8 d 6 58 d f 0.4 0.8 0 c 749 1712 m -4 -59 d -14 -13 d 5 59
- d f 0.6 0.8 0 c 740 1750 m 1 7 d 12 14 d -4 -59 d -13 -13 d f 0.8 0.8 0 c 741
- 1757 m 9 65 d 7 8 d -4 -59 d f 0.8 0.6 0 c 750 1822 m 8 64 d 3 4 d -4 -60 d f
- 0.8 0.4 0 c 758 1886 m 6 45 d -3 -41 d f 0 0.8 0 c 717 1556 m 1 9 d 7 17 d -5
- -58 d -23 48 d f 0.2 0.8 0 c 718 1565 m 8 64 d 5 11 d -6 -58 d f 0.4 0.8 0 c
- 726 1629 m 7 64 d 3 6 d -5 -59 d f 0.6 0.8 0 c 733 1693 m 7 57 d -4 -51 d f 0
- 0.8 0 c 712 1564 m 5 -8 d -20 16 d -2 8 d f 0.2 0.8 0 c 693 1591 m 19 -27 d -17
- 16 d -10 60 d 3 -15 d f 0.4 0.8 0 c 685 1640 m -10 59 d 1 -3 d 12 -71 d f 0.6
- 0.8 0 c 675 1699 m -2 15 d 3 -18 d f 0.2 0.8 0 c 687 1619 m 6 -28 d -5 34 d -30
- 8 d -8 -46 d 7 38 d f 0.4 0.8 0 c 673 1678 m 14 -59 d 1 6 d -12 71 d -6 2 d -12
- -65 d -1 -8 d 10 54 d f 0.6 0.8 0 c 670 1692 m 3 -14 d 3 18 d -3 18 d -3 -16 d
- -3 -19 d f 0.2 0.8 0 c 646 1606 m 1 3 d 10 16 d -7 -38 d -10 41 d 5 -18 d f 0.4
- 0.8 0 c 647 1609 m 19 67 d 1 3 d -10 -54 d -17 3 d -14 59 d 1 -1 d 18 -76 d f
- 0.6 0.8 0 c 666 1676 m 4 16 d -3 -13 d -41 8 d 1 Y 1 -2 d f 0.2 0.8 0 c 646
- 1609 m -3 Y -1 4 d f 0.4 0.8 0 c 632 1667 m 14 -58 d -1 1 d -18 76 d f 0.6 0.8
- 0 c 623 1707 m 9 -40 d -5 19 d -1 2 d -23 48 d f 0 0 0.8 c 599 976 m 2 62 d -20
- 16 d -2 -63 d f 0 0.2 0.8 c 601 1038 m 2 63 d -20 15 d -2 -62 d f 0 0.4 0.8 c
- 603 1101 m 3 63 d -21 15 d -2 -63 d f 0 0.6 0.8 c 606 1164 m 2 62 d -21 16 d -2
- -63 d f 0 0.8 0.8 c 608 1226 m 2 63 d -21 15 d -2 -62 d f 0 0.8 0.6 c 610 1289
- m 2 63 d -21 15 d -2 -63 d f 0 0.8 0.4 c 612 1352 m 2 62 d -21 16 d -2 -63 d f
- 0 0.8 0.2 c 614 1414 m 2 63 d -21 15 d -2 -62 d f 0 0.8 0 c 616 1477 m 2 62 d
- -21 16 d -2 -63 d f 0.2 0.8 0 c 618 1539 m 2 63 d -21 16 d -2 -63 d f 0.4 0.8 0
- c 620 1602 m 2 63 d -21 15 d -2 -62 d f 0.6 0.8 0 c 622 1665 m 1 42 d -20 29 d
- -2 -56 d f 0 0 0.8 c 576 970 m 23 6 d -20 15 d -23 -6 d f 552 964 m 24 6 d -20
- 15 d -24 -6 d f 529 958 m 23 6 d -20 15 d -23 -6 d f 1630 1217 m 23 6 d -20 16
- d -23 -6 d f 1606 1211 m 24 6 d -20 16 d -24 -6 d f 1583 1205 m 23 6 d -20 16 d
- -23 -6 d f 1581 1267 m 2 -62 d -20 16 d -3 61 d f 0 0.2 0.8 c 1579 1328 m 2 -61
- d -21 15 d -2 62 d f 0 0.4 0.8 c 1577 1390 m 2 -62 d -21 16 d -2 62 d f 0 0.6
- 0.8 c 1575 1452 m 2 -62 d -21 16 d -2 61 d f 0 0.8 0.8 c 1573 1513 m 2 -61 d
- -21 15 d -2 62 d f 0 0.8 0.6 c 1571 1575 m 2 -62 d -21 16 d -2 61 d f 0 0.8 0.4
- c 1569 1637 m 2 -62 d -21 15 d -2 62 d f 0 0.8 0.2 c 1566 1698 m 3 -61 d -21 15
- d -2 62 d f 0 0.8 0 c 1564 1760 m 2 -62 d -20 16 d -2 61 d f 0.2 0.8 0 c 1562
- 1821 m 2 -61 d -20 15 d -2 62 d f 0.4 0.8 0 c 1560 1883 m 2 -62 d -20 16 d -2
- 61 d f 0.6 0.8 0 c 1559 1911 m 1 -28 d -20 15 d -1 15 d f 0.4 0.8 0 c 1534 1897
- m -18 -57 d 19 37 d f 0.6 0.8 0 c 1536 1878 m 23 33 d -20 2 d -5 -16 d 1 -20 d
- f 0.4 0.8 0 c 1535 1877 m -19 -37 d -24 8 d 15 27 d f 0.6 0.8 0 c 1512 1886 m
- 24 -8 d -1 -1 d -28 -2 d f 0 0.8 0 c 1489 1705 m 5 37 d -10 3 d f 0.2 0.8 0 c
- 1494 1742 m 8 64 d -28 8 d 10 -69 d f 0.4 0.8 0 c 1502 1806 m 8 64 d -3 5 d -15
- -27 d -23 7 d 5 -41 d f 0.6 0.8 0 c 1510 1870 m 2 16 d -5 -11 d f 0 0.8 0 c
- 1479 1738 m 10 -33 d -5 40 d -35 6 d -4 -23 d 7 17 d f 0.2 0.8 0 c 1465 1780 m
- 14 -42 d 5 7 d -10 69 d -13 2 d -12 -65 d 3 -6 d f 0.4 0.8 0 c 1474 1814 m -5
- 41 d -8 -39 d f 0 0.8 0 c 1452 1745 m -7 -17 d -8 20 d f 0.2 0.8 0 c 1463 1796
- m 2 -16 d -13 -35 d -15 3 d -15 41 d 1 16 d f 0.4 0.8 0 c 1456 1856 m 7 -60 d
- -40 9 d 7 57 d f 0.6 0.8 0 c 1448 1917 m 8 -61 d -26 6 d 7 57 d f 0.8 0.8 0 c
- 1442 1962 m 6 -45 d -11 2 d f 0.2 0.8 0 c 1423 1805 m -1 -16 d -24 -5 d 9 10 d
- f 0.4 0.8 0 c 1418 1808 m 7 40 d 5 14 d -7 -57 d -16 -11 d f 0.6 0.8 0 c 1425
- 1848 m 9 65 d 3 6 d -7 -57 d f 0.8 0.8 0 c 1434 1913 m 8 49 d -5 -43 d f 0 0.8
- 0 c 1388 1736 m -13 -66 d 6 57 d f 0.2 0.8 0 c 1407 1794 m -9 -10 d -10 -48 d
- -7 -9 d 6 58 d f 0.4 0.8 0 c 1402 1843 m 16 -35 d -11 -14 d -20 -9 d 6 57 d f
- 0.6 0.8 0 c 1395 1856 m 7 -13 d -9 -1 d f 0 0.8 0 c 1381 1727 m -6 -57 d -4 61
- d f 0.2 0.8 0 c 1387 1785 m -6 -58 d -10 4 d -4 61 d f 0.4 0.8 0 c 1371 1796 m
- 17 43 d 5 3 d -6 -57 d -20 7 d -3 62 d 4 -17 d f 0.6 0.8 0 c 1388 1839 m 7 17 d
- -2 -14 d -29 12 d -4 61 d 3 -12 d 5 -66 d f 0.8 0.8 0 c 1360 1915 m -3 61 d 1
- -7 d 5 -66 d f 0.8 0.6 0 c 1357 1976 m -4 61 d 1 -2 d 4 -66 d f 0.8 0.4 0 c
- 1353 2037 m -2 30 d 3 -32 d f 0.2 0.8 0 c 1348 1763 m 3 5 d -4 X f 0.4 0.8 0 c
- 1351 1768 m 20 28 d -3 41 d -40 7 d 19 -76 d f 0.6 0.8 0 c 1368 1837 m -5 66 d
- -29 5 d -6 -62 d -2 Y f 0.8 0.8 0 c 1363 1903 m -5 66 d -17 3 d -7 -64 d f 0.8
- 0.6 0 c 1358 1969 m -4 66 d -6 1 d -7 -64 d f 0.8 0.4 0 c 1354 2035 m -3 32 d
- -3 -31 d f 0.2 0.8 0 c 1346 1766 m 2 -3 d -1 5 d f 0.4 0.8 0 c 1324 1798 m 22
- -32 d 1 2 d -19 76 d -3 X -21 -17 d f 0.6 0.8 0 c 1328 1844 m 2 Y -3 -2 d f 0.4
- 0.8 0 c 1318 1821 m 6 -23 d -20 29 d -7 10 d f 0.6 0.8 0 c 1303 1880 m 15 -59 d
- -21 16 d -16 24 d 17 21 d f 0.8 0.8 0 c 1301 1886 m 2 -6 d -5 2 d f 0.4 0.8 0 c
- 1278 1799 m 3 13 d -13 17 d -11 -28 d f 0.6 0.8 0 c 1281 1812 m 18 67 d -1 3 d
- -17 -21 d -13 -32 d f 0.8 0.8 0 c 1299 1879 m 2 7 d -3 -4 d f 0.4 0.8 0 c 1254
- 1793 m 24 6 d -21 2 d -15 22 d 3 -11 d f 0.6 0.8 0 c 1242 1823 m -8 13 d 11 -24
- d f 0.2 0.8 0 c 1231 1680 m 12 60 d -29 14 d -4 -18 d f 0.4 0.8 0 c 1243 1740 m
- 11 53 d -9 19 d -15 8 d -16 -66 d f 0.6 0.8 0 c 1245 1812 m -11 24 d -4 -16 d f
- 0 0.8 0.2 c 1191 1623 m -4 -28 d 3 25 d f 0 0.8 0 c 1202 1688 m -11 -65 d -1 -3
- d 7 56 d f 0.2 0.8 0 c 1214 1733 m 17 -53 d -21 56 d -8 -48 d -5 -12 d 7 57 d f
- 0.4 0.8 0 c 1207 1754 m 7 -21 d -10 X f 0 0.8 0.2 c 1190 1620 m -3 -25 d -6 26
- d f 0 0.8 0 c 1197 1676 m -7 -56 d -9 1 d -14 58 d f 0.2 0.8 0 c 1204 1733 m -7
- -57 d -30 3 d -4 18 d 6 39 d f 0.4 0.8 0 c 1196 1790 m 11 -36 d -3 -21 d -35 3
- d 9 56 d f 0.6 0.8 0 c 1184 1829 m 12 -39 d -18 2 d f 0.2 0.8 0 c 1169 1736 m
- -6 -39 d -19 39 d f 0.4 0.8 0 c 1178 1792 m -9 -56 d -25 X -4 9 d 15 40 d f 0.6
- 0.8 0 c 1160 1796 m 24 33 d -6 -37 d -23 -7 d f 0.4 0.8 0 c 1155 1785 m -15 -40
- d -24 21 d 4 21 d f 0.6 0.8 0 c 1146 1840 m 14 -44 d -5 -11 d -35 2 d 11 55 d f
- 0.8 0.8 0 c 1137 1871 m 9 -31 d -15 2 d f 0.2 0.8 0 c 1105 1726 m -12 -47 d 5
- 40 d f 0.4 0.8 0 c 1120 1787 m -4 -21 d -11 -40 d -7 -7 d 7 56 d f 0.6 0.8 0 c
- 1131 1842 m -11 -55 d -15 -12 d 7 57 d f 0.8 0.8 0 c 1113 1838 m 24 33 d -6 -29
- d -19 -10 d f 0.2 0.8 0 c 1098 1719 m -5 -40 d -24 21 d 13 7 d f 0.4 0.8 0 c
- 1090 1711 m 10 55 d 5 9 d -7 -56 d -16 -12 d f 0.6 0.8 0 c 1100 1766 m 12 65 d
- 1 Y -7 -57 d f 0.8 0.8 0 c 1112 1831 m 1 7 d -1 -6 d f 0.2 0.8 0 c 1066 1638 m
- 20 62 d -4 7 d -13 -7 d -10 14 d -7 -8 d f 0.4 0.8 0 c 1086 1700 m 4 11 d -8 -4
- d -23 7 d -13 20 d 6 -28 d f 0 0.8 0 c 1027 1644 m -5 -23 d 7 16 d f 0.2 0.8 0
- c 1043 1672 m 23 -34 d -14 68 d -11 3 d -14 -65 d 2 -7 d f 0.4 0.8 0 c 1052
- 1706 m -6 28 d -5 -25 d f 0 0.8 0 c 1029 1637 m -7 -16 d -3 21 d f 0.2 0.8 0 c
- 1038 1688 m 5 -16 d -14 -35 d -10 5 d -9 60 d f 0.4 0.8 0 c 1023 1746 m 15 -58
- d -28 14 d -9 59 d f 0.6 0.8 0 c 1019 1760 m 4 -14 d -22 15 d -2 15 d f 0 0.8 0
- c 977 1631 m -2 -9 d 1 8 d f 0.2 0.8 0 c 987 1696 m -10 -65 d -1 -1 d 6 57 d f
- 0.4 0.8 0 c 996 1760 m -9 -64 d -5 -9 d 7 58 d f 0.6 0.8 0 c 999 1802 m 20 -42
- d -20 16 d -3 -16 d -7 -15 d 6 57 d f 0.8 0.8 0 c 996 1808 m 3 -6 d -4 X f 0
- 0.8 0 c 976 1630 m -1 -8 d -23 -6 d 1 7 d f 0.2 0.8 0 c 982 1687 m -6 -57 d -23
- -7 d 11 55 d f 0.4 0.8 0 c 972 1722 m 4 12 d 13 11 d -7 -58 d -18 -9 d f 0.6
- 0.8 0 c 976 1734 m 18 67 d 1 1 d -6 -57 d f 0.8 0.8 0 c 994 1801 m 2 7 d -1 -6
- d f 0 0.8 0 c 953 1623 m -1 -7 d -3 8 d f 0.2 0.8 0 c 964 1678 m -11 -55 d -4 1
- d -21 53 d 1 3 d f 0.4 0.8 0 c 969 1733 m 3 -11 d -8 -44 d -35 2 d 8 56 d f 0.6
- 0.8 0 c 954 1791 m 15 -58 d -32 3 d 9 56 d f 0.8 0.8 0 c 949 1810 m 5 -19 d -8
- 1 d f 0 0.8 0.2 c 925 1508 m 2 27 d -5 2 d f 0 0.8 0 c 927 1535 m 5 64 d -16 5
- d 6 -67 d f 0.2 0.8 0 c 932 1599 m 5 63 d -8 18 d -1 -3 d -1 3 d -17 -9 d 6 -67
- d f 0.4 0.8 0 c 937 1662 m 5 64 d -5 10 d -8 -56 d -2 X -22 45 d 5 -54 d f 0.6
- 0.8 0 c 942 1726 m 5 63 d -1 3 d -9 -56 d f 0.8 0.8 0 c 947 1789 m 2 21 d -3
- -18 d f 0 0.8 0.2 c 919 1533 m 6 -25 d -3 29 d f 0 0.8 0 c 906 1592 m 13 -59 d
- 3 4 d -6 67 d f 0.2 0.8 0 c 902 1610 m 4 -18 d 10 12 d -6 67 d -18 -11 d f 0.4
- 0.8 0 c 910 1671 m -5 54 d -24 -6 d 11 -59 d f 0.2 0.8 0 c 894 1651 m 8 -41 d
- -10 50 d f 0.4 0.8 0 c 883 1711 m 11 -60 d -2 9 d -11 59 d -23 -19 d 9 18 d f
- 0.6 0.8 0 c 878 1738 m 5 -27 d -16 7 d f 0.2 0.8 0 c 847 1660 m -13 -47 d 10 37
- d f 0.4 0.8 0 c 855 1692 m 7 13 d 5 13 d -9 -18 d -11 -40 d -3 -10 d f 0.6 0.8
- 0 c 862 1705 m 16 33 d -11 -20 d f 0.2 0.8 0 c 844 1650 m -10 -37 d -8 42 d f
- 0.4 0.8 0 c 831 1645 m 24 47 d -11 -42 d -18 5 d -12 59 d 1 -5 d f 0.6 0.8 0 c
- 814 1714 m -3 14 d 4 -19 d f 0.4 0.8 0 c 808 1639 m 23 6 d -16 64 d -12 -14 d f
- 0.6 0.8 0 c 815 1709 m -4 19 d -7 45 d -6 -12 d 5 -66 d f 0.8 0.8 0 c 804 1773
- m -9 60 d -3 -5 d 6 -67 d f 0.8 0.6 0 c 795 1833 m -8 50 d 5 -55 d f 0.4 0.8 0
- c 784 1647 m 24 -8 d -5 56 d -22 -7 d f 0.6 0.8 0 c 803 1695 m -5 66 d -21 -8 d
- 4 -65 d f 0.8 0.8 0 c 798 1761 m -6 67 d -20 -9 d 5 -66 d f 0.8 0.6 0 c 792
- 1828 m -5 55 d -4 9 d -16 -7 d 5 -66 d f 0.8 0.4 0 c 783 1892 m -19 39 d 3 -46
- d f 0.4 0.8 0 c 762 1680 m 22 -33 d -3 41 d f 0.6 0.8 0 c 761 1681 m 1 -1 d 19
- 8 d -4 65 d -36 4 d -1 -7 d f 0.8 0.8 0 c 777 1753 m -5 66 d -22 3 d -9 -65 d f
- 0.8 0.6 0 c 772 1819 m -5 66 d -9 1 d -8 -64 d f 0.8 0.4 0 c 767 1885 m -3 46 d
- -6 -45 d f 0 0.8 0 c 718 1565 m -1 -9 d 1 8 d f 0.2 0.8 0 c 726 1629 m -8 -64 d
- -1 Y 5 59 d f 0.4 0.8 0 c 733 1693 m -7 -64 d -3 -6 d 4 58 d f 0.6 0.8 0 c 749
- 1739 m 12 -58 d -21 69 d -7 -57 d -6 -12 d 5 58 d f 0.8 0.8 0 c 737 1796 m 12
- -57 d -17 X f 0 0.8 0 c 718 1564 m -1 -8 d -5 8 d f 0.2 0.8 0 c 714 1575 m 3 31
- d 6 17 d -5 -59 d -6 X -19 27 d f 0.4 0.8 0 c 717 1606 m 7 64 d 3 11 d -4 -58 d
- f 0.6 0.8 0 c 724 1670 m 7 64 d 1 5 d -5 -58 d f 0.8 0.8 0 c 731 1734 m 6 62 d
- -5 -57 d f 0.2 0.8 0 c 690 1569 m 24 6 d -21 16 d -6 28 d -2 -15 d f 0.4 0.8 0
- c 687 1619 m -14 59 d -3 Y 12 -71 d f 0.6 0.8 0 c 673 1678 m -3 14 d 3 -17 d f
- 0.2 0.8 0 c 687 1599 m 3 -30 d -5 35 d -38 5 d -1 -3 d 1 3 d f 0.4 0.8 0 c 681
- 1659 m 6 -60 d -2 5 d -12 71 d -7 1 d -19 -67 d 6 57 d f 0.6 0.8 0 c 675 1720 m
- 6 -61 d -8 16 d -3 17 d -4 -16 d -13 -10 d 6 58 d f 0.8 0.8 0 c 669 1780 m 6
- -60 d -16 4 d 5 58 d f 0.8 0.6 0 c 667 1805 m 2 -25 d -5 2 d f 0.2 0.8 0 c 643
- 1530 m 5 59 d -1 20 d -1 -3 d 3 Y -10 -16 d f 0.4 0.8 0 c 648 1589 m 6 63 d -1
- 14 d -6 -57 d -1 X -14 58 d -4 -6 d 8 -68 d f 0.6 0.8 0 c 654 1652 m 5 64 d 8 Y
- -6 -58 d -21 1 d -9 40 d 5 -46 d f 0.8 0.8 0 c 659 1716 m 6 63 d -1 3 d -5 -58
- d f 0.8 0.6 0 c 665 1779 m 2 26 d -3 -23 d f 0 0 0.8 c 620 960 m 2 63 d -21 15
- d -2 -62 d f 0 0.2 0.8 c 622 1023 m 3 63 d -22 15 d -2 -63 d f 0 0.4 0.8 c 625
- 1086 m 3 62 d -22 16 d -3 -63 d f 0 0.6 0.8 c 628 1148 m 2 63 d -22 15 d -2 -62
- d f 0 0.8 0.8 c 630 1211 m 3 63 d -23 15 d -2 -63 d f 0 0.8 0.6 c 633 1274 m 2
- 63 d -23 15 d -2 -63 d f 0 0.8 0.4 c 635 1337 m 3 63 d -24 14 d -2 -62 d f 0
- 0.8 0.2 c 638 1400 m 3 62 d -25 15 d -2 -63 d f 0 0.8 0 c 641 1462 m 2 63 d -25
- 14 d -2 -62 d f 0.2 0.8 0 c 643 1525 m 5 Y -7 63 d -16 9 d -2 -63 d f 0.4 0.8 0
- c 636 1593 m -8 68 d -6 4 d -2 -63 d f 0.6 0.8 0 c 628 1661 m -5 46 d -1 -42 d
- f 0 0 0.8 c 596 954 m 24 6 d -21 16 d -23 -6 d f 573 948 m 23 6 d -20 16 d -24
- -6 d f 549 942 m 24 6 d -21 16 d -23 -6 d f 1650 1202 m 24 6 d -21 15 d -23 -6
- d f 1627 1196 m 23 6 d -20 15 d -24 -6 d f 1603 1190 m 24 6 d -21 15 d -23 -6 d
- f 1600 1251 m 3 -61 d -20 15 d -2 62 d f 0 0.2 0.8 c 1598 1313 m 2 -62 d -19 16
- d -2 61 d f 0 0.4 0.8 c 1595 1374 m 3 -61 d -19 15 d -2 62 d f 0 0.6 0.8 c 1592
- 1435 m 3 -61 d -18 16 d -2 62 d f 0 0.8 0.8 c 1590 1497 m 2 -62 d -17 17 d -2
- 61 d f 0 0.8 0.6 c 1587 1558 m 3 -61 d -17 16 d -2 62 d f 0 0.8 0.4 c 1584 1620
- m 3 -62 d -16 17 d -2 62 d f 0 0.8 0.2 c 1581 1681 m 3 -61 d -15 17 d -3 61 d f
- 0 0.8 0 c 1580 1721 m 1 -40 d -15 17 d -2 62 d 13 -15 d f 0.2 0.8 0 c 1564 1760
- m -2 61 d 8 -8 d 7 -68 d f 0.4 0.8 0 c 1562 1821 m -2 62 d 3 -3 d 7 -67 d f 0.6
- 0.8 0 c 1560 1883 m -1 28 d 4 -31 d f 0 0.8 0.4 c 1556 1567 m 7 48 d -10 X f 0
- 0.8 0.2 c 1563 1615 m 10 64 d -24 2 d 4 -66 d f 0 0.8 0 c 1573 1679 m 7 42 d -3
- 24 d -32 1 d 4 -65 d f 0.2 0.8 0 c 1577 1745 m -7 68 d -30 -2 d 5 -65 d f 0.4
- 0.8 0 c 1570 1813 m -7 67 d -27 -3 d 4 -66 d f 0.6 0.8 0 c 1563 1880 m -4 31 d
- -23 -33 d -1 Y f 0 0.8 0.4 c 1553 1612 m 3 -45 d -3 48 d f 0 0.8 0.2 c 1549
- 1673 m 4 -61 d 3 Y -4 66 d f 0 0.8 0 c 1544 1734 m 5 -61 d 8 Y -4 65 d f 0.2
- 0.8 0 c 1540 1795 m 4 -61 d 1 12 d -5 65 d f 0.4 0.8 0 c 1536 1856 m 4 -61 d 16
- Y -4 66 d f 0.6 0.8 0 c 1533 1897 m 3 -41 d 22 Y -24 8 d f 0 0.8 0 c 1494 1742
- m -5 -37 d 2 34 d f 0.2 0.8 0 c 1502 1806 m -8 -64 d -3 -3 d 4 59 d f 0.4 0.8 0
- c 1510 1870 m -8 -64 d -7 -8 d 4 59 d f 0.6 0.8 0 c 1528 1916 m 5 -19 d -21 -11
- d -2 -16 d -11 -13 d 5 59 d f 0.8 0.8 0 c 1515 1975 m 13 -59 d -24 X 4 59 d f
- 0.8 0.6 0 c 1509 1999 m 6 -24 d -7 X f 0 0.8 0 c 1491 1739 m -2 -34 d -10 33 d
- f 0.2 0.8 0 c 1486 1724 m 5 58 d 4 16 d -4 -59 d -12 -1 d -14 42 d f 0.4 0.8 0
- c 1491 1782 m 5 64 d 3 11 d -4 -59 d f 0.6 0.8 0 c 1496 1846 m 6 64 d 2 6 d -5
- -59 d f 0.8 0.8 0 c 1502 1910 m 5 63 d 1 2 d -4 -59 d f 0.8 0.6 0 c 1507 1973 m
- 2 26 d -1 -24 d f 0.2 0.8 0 c 1482 1780 m 4 -56 d -21 56 d -2 16 d f 0.4 0.8 0
- c 1477 1841 m 5 -61 d -19 16 d -7 60 d f 0.6 0.8 0 c 1473 1902 m 4 -61 d -21 15
- d -8 61 d f 0.8 0.8 0 c 1469 1963 m 4 -61 d -25 15 d -6 45 d 3 13 d f 0.8 0.6 0
- c 1464 2024 m 5 -61 d -24 12 d 12 53 d f 0.8 0.4 0 c 1462 2054 m 2 -30 d -7 4 d
- f 0.2 0.8 0 c 1439 1766 m 3 Y -3 2 d f 0.4 0.8 0 c 1439 1769 m 5 64 d -19 15 d
- -7 -40 d 18 -37 d f 0.6 0.8 0 c 1444 1833 m 5 63 d -15 17 d -9 -65 d f 0.8 0.8
- 0 c 1449 1896 m 6 64 d -10 15 d -3 -13 d -8 -49 d f 0.8 0.6 0 c 1455 1960 m 5
- 63 d -3 5 d -12 -53 d f 0.8 0.4 0 c 1460 2023 m 2 31 d -5 -26 d f 0.2 0.8 0 c
- 1438 1769 m 1 -3 d -3 5 d f 0.4 0.8 0 c 1424 1828 m 14 -59 d -2 2 d -18 37 d
- -16 35 d f 0.6 0.8 0 c 1415 1867 m 9 -39 d -22 15 d -7 13 d f 0.4 0.8 0 c 1388
- 1839 m -17 -43 d 10 32 d f 0.6 0.8 0 c 1392 1861 m 23 6 d -20 -11 d -7 -17 d -7
- -11 d f 0.2 0.8 0 c 1351 1768 m -3 -5 d 4 Y f 0.4 0.8 0 c 1381 1828 m -10 -32 d
- -20 -28 d -3 -1 d 4 59 d f 0.6 0.8 0 c 1390 1881 m 2 -20 d -11 -33 d -29 -2 d 3
- 60 d f 0.8 0.8 0 c 1385 1942 m 5 -61 d -35 5 d 3 59 d f 0.8 0.6 0 c 1379 2003 m
- 6 -61 d -27 3 d 4 60 d f 0.8 0.4 0 c 1374 2063 m 5 -60 d -17 2 d 3 60 d f 0.8
- 0.2 0 c 1368 2124 m 6 -61 d -9 2 d f 0.2 0.8 0 c 1348 1767 m -4 Y -2 3 d f 0.4
- 0.8 0 c 1352 1826 m -4 -59 d -2 -1 d -22 32 d 7 20 d f 0.6 0.8 0 c 1345 1863 m
- 7 Y 10 16 d -3 -60 d -21 -8 d f 0.8 0.8 0 c 1345 1870 m 6 63 d 7 12 d -3 -59 d
- f 0.8 0.6 0 c 1351 1933 m 6 64 d 5 8 d -4 -60 d f 0.8 0.4 0 c 1357 1997 m 6 64
- d 2 4 d -3 -60 d f 0.8 0.2 0 c 1363 2061 m 5 63 d -3 -59 d f 0.4 0.8 0 c 1331
- 1818 m -7 -20 d -6 23 d f 0.6 0.8 0 c 1339 1868 m 6 -5 d -14 -45 d -13 3 d -15
- 59 d f 0.8 0.8 0 c 1321 1884 m 18 -16 d -36 12 d -2 6 d f 0.4 0.8 0 c 1281 1812
- m -3 -13 d 1 11 d f 0.6 0.8 0 c 1299 1879 m -18 -67 d -2 -2 d 10 55 d f 0.8 0.8
- 0 c 1298 1918 m 23 -34 d -20 2 d -2 -7 d -10 -14 d f 0 0.8 0 c 1274 1630 m 3 36
- d -7 3 d f 0.2 0.8 0 c 1277 1666 m 5 63 d -21 9 d 9 -69 d f 0.4 0.8 0 c 1282
- 1729 m 6 64 d -9 17 d -1 -11 d -24 -6 d 7 -55 d f 0.6 0.8 0 c 1288 1793 m 5 63
- d -4 9 d -10 -55 d f 0.8 0.8 0 c 1293 1856 m 5 62 d -9 -53 d f 0 0.8 0 c 1272
- 1665 m 2 -35 d -4 39 d f 0.2 0.8 0 c 1268 1726 m 4 -61 d -2 4 d -9 69 d -18 2 d
- -12 -60 d 3 54 d f 0.4 0.8 0 c 1264 1787 m 4 -61 d -7 12 d -7 55 d -11 -53 d -9
- -6 d 4 59 d f 0.6 0.8 0 c 1259 1848 m 5 -61 d -26 6 d 4 59 d f 0.8 0.8 0 c 1255
- 1909 m 4 -61 d -17 4 d 5 59 d f 0.8 0.6 0 c 1251 1970 m 4 -61 d -8 2 d 4 59 d f
- 0.8 0.4 0 c 1251 1973 m -3 Y f 0.2 0.8 0 c 1234 1734 m -3 -54 d -17 53 d f 0.4
- 0.8 0 c 1238 1793 m -4 -59 d -20 -1 d -7 21 d 3 36 d f 0.6 0.8 0 c 1242 1852 m
- -4 -59 d -28 -3 d 6 58 d f 0.8 0.8 0 c 1247 1911 m -5 -59 d -26 -4 d 6 58 d f
- 0.8 0.6 0 c 1251 1970 m -4 -59 d -25 -5 d 5 58 d f 0.8 0.4 0 c 1227 1967 m 24 6
- d -3 Y -24 -6 d f 0.4 0.8 0 c 1204 1720 m 5 53 d 1 17 d -3 -36 d -11 36 d -3
- -10 d f 0.6 0.8 0 c 1209 1773 m 6 64 d 1 11 d -6 -58 d -14 X -12 39 d 9 -49 d f
- 0.8 0.8 0 c 1215 1837 m 6 63 d 1 6 d -6 -58 d f 0.8 0.6 0 c 1221 1900 m 6 64 d
- -5 -58 d f 0.8 0.4 0 c 1227 1964 m 3 Y -3 Y f 0.4 0.8 0 c 1191 1768 m 13 -48 d
- -11 60 d f 0.6 0.8 0 c 1180 1808 m 11 -40 d 2 12 d -9 49 d -24 -33 d f 0.2 0.8
- 0 c 1157 1694 m 1 4 d -2 X f 0.4 0.8 0 c 1158 1698 m 13 65 d -22 3 d 7 -68 d f
- 0.6 0.8 0 c 1171 1763 m 9 45 d -20 -12 d -14 44 d -5 -6 d 8 -68 d f 0.8 0.8 0 c
- 1146 1840 m -9 31 d 4 -37 d f 0 0.8 0 c 1133 1621 m 3 9 d -3 X f 0.2 0.8 0 c
- 1136 1630 m 21 64 d -1 4 d -30 -1 d 7 -67 d f 0.4 0.8 0 c 1156 1698 m -7 68 d
- -29 -2 d 6 -67 d f 0.6 0.8 0 c 1149 1766 m -8 68 d -27 -3 d 6 -67 d f 0.8 0.8 0
- c 1141 1834 m -4 37 d -24 -33 d 1 -7 d f 0 0.8 0 c 1132 1629 m 1 -8 d 9 Y f 0.2
- 0.8 0 c 1124 1689 m 8 -60 d 1 1 d -7 67 d f 0.4 0.8 0 c 1116 1749 m 8 -60 d 2 8
- d -6 67 d -20 2 d -10 -55 d 11 44 d f 0.6 0.8 0 c 1110 1790 m 6 -41 d 4 15 d -6
- 67 d -2 X -12 -65 d 1 -11 d f 0.8 0.8 0 c 1114 1831 m -1 7 d -1 -7 d f 0.2 0.8
- 0 c 1086 1676 m 1 4 d -1 20 d -20 -62 d f 0.4 0.8 0 c 1087 1680 m 14 65 d 10 Y
- -11 -44 d -4 -11 d f 0.6 0.8 0 c 1101 1745 m 9 45 d -9 -35 d f 0.2 0.8 0 c 1085
- 1679 m 1 -3 d -20 -38 d -23 34 d 3 14 d f 0.4 0.8 0 c 1067 1737 m 18 -58 d -39
- 7 d 14 52 d f 0.6 0.8 0 c 1063 1751 m 4 -14 d -7 1 d f 0.2 0.8 0 c 1046 1686 m
- -3 -14 d -5 16 d f 0.4 0.8 0 c 1060 1738 m -14 -52 d -8 2 d -15 58 d f 0.6 0.8
- 0 c 1039 1772 m 24 -21 d -3 -13 d -37 8 d -4 14 d f 1022 1787 m 17 -15 d -20
- -12 d -20 42 d f 0.8 0.8 0 c 1016 1793 m 6 -6 d -23 15 d -3 6 d f 0.4 0.8 0 c
- 976 1734 m -4 -12 d 3 9 d f 0.6 0.8 0 c 994 1801 m -18 -67 d -1 -3 d 16 50 d f
- 0.8 0.8 0 c 992 1787 m 24 6 d -20 15 d -2 -7 d -3 -20 d f 0.4 0.8 0 c 975 1731
- m -3 -9 d -3 11 d f 0.6 0.8 0 c 969 1740 m 20 39 d 2 2 d -16 -50 d -6 2 d -15
- 58 d 2 -7 d f 0.8 0.8 0 c 989 1779 m 3 8 d -1 -6 d -37 10 d -5 19 d 7 -26 d f 0
- 0.8 0.2 c 927 1535 m -2 -27 d 2 25 d f 0 0.8 0 c 932 1599 m -5 -64 d -2 Y 5 59
- d f 0.2 0.8 0 c 937 1662 m -5 -63 d -7 Y 5 58 d f 0.4 0.8 0 c 942 1726 m -5 -64
- d -12 Y 5 58 d f 0.6 0.8 0 c 946 1748 m 23 -8 d -13 44 d -9 5 d -5 -63 d -18 Y
- f 0.8 0.8 0 c 956 1784 m -7 26 d -2 -21 d f 0 0.8 0.2 c 927 1533 m -2 -25 d -6
- 25 d f 0 0.8 0 c 932 1592 m -5 -59 d -8 X -13 59 d f 0.2 0.8 0 c 937 1650 m -5
- -58 d -26 X -4 18 d 7 38 d f 0.4 0.8 0 c 942 1708 m -5 -58 d -28 -2 d 10 54 d f
- 0.6 0.8 0 c 922 1715 m 24 33 d -4 -40 d -23 -6 d f 0.2 0.8 0 c 909 1648 m -7
- -38 d -8 41 d f 0.4 0.8 0 c 899 1642 m 18 56 d 2 4 d -10 -54 d -15 3 d -11 60 d
- 2 -7 d f 0.6 0.8 0 c 917 1698 m 5 17 d -3 -13 d -36 9 d -5 27 d 7 -34 d f 0.4
- 0.8 0 c 875 1663 m 24 -21 d -14 62 d -23 1 d -7 -13 d f 0.6 0.8 0 c 885 1704 m
- -7 34 d -16 -33 d f 0.4 0.8 0 c 852 1630 m 23 33 d -20 29 d -24 -47 d f 0 0.8 0
- c 828 1503 m 10 51 d -18 4 d f 0.2 0.8 0 c 838 1554 m 12 65 d -41 9 d 11 -70 d
- f 0.4 0.8 0 c 850 1619 m 2 11 d -21 15 d -23 -6 d 1 -11 d f 0 0.8 0 c 807 1546
- m 21 -43 d -8 55 d f 0.2 0.8 0 c 805 1551 m 2 -5 d 13 12 d -11 70 d -19 -9 d f
- 0.4 0.8 0 c 809 1628 m -1 11 d -24 8 d 6 -28 d f 0.2 0.8 0 c 781 1585 m 24 -34
- d -15 68 d -13 -14 d f 0.4 0.8 0 c 790 1619 m -6 28 d -22 33 d -1 -1 d 16 -74 d
- f 0.6 0.8 0 c 762 1680 m -1 1 d -2 Y f 0.2 0.8 0 c 758 1566 m 23 19 d -4 20 d
- -22 -7 d f 0.4 0.8 0 c 777 1605 m -16 74 d -12 -14 d 6 -67 d f 0.6 0.8 0 c 761
- 1679 m 2 Y -12 58 d -6 -8 d 6 -66 d f 0.8 0.8 0 c 749 1739 m -12 57 d 6 -65 d f
- 0.2 0.8 0 c 734 1546 m 24 20 d -3 32 d -38 8 d -3 -31 d f 0.4 0.8 0 c 755 1598
- m -6 67 d -25 5 d -7 -64 d f 0.6 0.8 0 c 749 1665 m -6 66 d -12 3 d -7 -64 d f
- 0.8 0.8 0 c 743 1731 m -6 65 d -6 -62 d f 0.2 0.8 0 c 728 1588 m 6 -42 d -20 29
- d -24 -6 d 4 27 d f 0.4 0.8 0 c 719 1648 m 9 -60 d -34 8 d 9 56 d f 0.6 0.8 0 c
- 711 1701 m 8 -53 d -16 4 d f 0.2 0.8 0 c 694 1596 m -4 -27 d -3 30 d f 0.4 0.8
- 0 c 687 1601 m 10 41 d 6 10 d -9 -56 d -7 3 d -6 60 d 2 -16 d f 0.6 0.8 0 c 697
- 1642 m 14 59 d -8 -49 d -22 7 d -6 61 d 1 -10 d 7 -67 d f 0.8 0.8 0 c 675 1720
- m -6 60 d 1 -2 d 6 -68 d f 0.8 0.6 0 c 669 1780 m -2 25 d 3 -27 d f 0.2 0.8 0 c
- 648 1589 m -5 -59 d 18 44 d f 0.4 0.8 0 c 664 1582 m 23 19 d -4 42 d -29 9 d -6
- -63 d 13 -15 d f 0.6 0.8 0 c 683 1643 m -7 67 d -17 6 d -5 -64 d f 0.8 0.8 0 c
- 676 1710 m -6 68 d -5 1 d -6 -63 d f 0.8 0.6 0 c 670 1778 m -3 27 d -2 -26 d f
- 0 0 0.8 c 640 945 m 2 62 d -20 16 d -2 -63 d f 0 0.2 0.8 c 642 1007 m 3 63 d
- -20 16 d -3 -63 d f 0 0.4 0.8 c 645 1070 m 2 63 d -19 15 d -3 -62 d f 0 0.6 0.8
- c 647 1133 m 2 62 d -19 16 d -2 -63 d f 0 0.8 0.8 c 649 1195 m 3 63 d -19 16 d
- -3 -63 d f 0 0.8 0.6 c 652 1258 m 2 63 d -19 16 d -2 -63 d f 0 0.8 0.4 c 654
- 1321 m 2 63 d -18 16 d -3 -63 d f 0 0.8 0.2 c 656 1384 m 3 62 d -18 16 d -3 -62
- d f 0 0.8 0 c 659 1446 m 2 63 d -18 16 d -2 -63 d f 0.2 0.8 0 c 661 1509 m 2 63
- d -2 2 d -18 -44 d -5 Y f 0.4 0.8 0 c 663 1572 m 1 10 d -3 -8 d f 0 0 0.8 c 617
- 939 m 23 6 d -20 15 d -24 -6 d f 593 933 m 24 6 d -21 15 d -23 -6 d f 570 927 m
- 23 6 d -20 15 d -24 -6 d f 1671 1186 m 23 6 d -20 16 d -24 -6 d f 1647 1180 m
- 24 6 d -21 16 d -23 -6 d f 1624 1174 m 23 6 d -20 16 d -24 -6 d f 1622 1236 m 2
- -62 d -21 16 d -3 61 d f 0 0.2 0.8 c 1620 1297 m 2 -61 d -22 15 d -2 62 d f 0
- 0.4 0.8 c 1618 1359 m 2 -62 d -22 16 d -3 61 d f 0 0.6 0.8 c 1616 1421 m 2 -62
- d -23 15 d -3 61 d f 0 0.8 0.8 c 1614 1482 m 2 -61 d -24 14 d -2 62 d f 0 0.8
- 0.6 c 1612 1544 m 2 -62 d -24 15 d -3 61 d f 0 0.8 0.4 c 1610 1606 m 2 -62 d
- -25 14 d -3 62 d f 0 0.8 0.2 c 1609 1667 m 1 -61 d -26 14 d -3 61 d f 0 0.8 0 c
- 1607 1729 m 2 -62 d -28 14 d -1 40 d 2 21 d f 0.2 0.8 0 c 1605 1791 m 2 -62 d
- -25 13 d 5 58 d f 0.4 0.8 0 c 1603 1852 m 2 -61 d -18 9 d 5 58 d f 0.6 0.8 0 c
- 1601 1914 m 2 -62 d -11 6 d 5 58 d f 0.8 0.8 0 c 1600 1947 m 1 -33 d -4 2 d f 0
- 0.8 0.4 c 1563 1615 m -7 -48 d 6 42 d f 0 0.8 0.2 c 1573 1679 m -10 -64 d -1 -6
- d 7 56 d f 0 0.8 0 c 1582 1742 m -2 -21 d -7 -42 d -4 -14 d 7 57 d f 0.2 0.8 0
- c 1577 1726 m 6 59 d 4 15 d -5 -58 d -6 -20 d f 0.4 0.8 0 c 1583 1785 m 7 64 d
- 2 9 d -5 -58 d f 0.6 0.8 0 c 1590 1849 m 6 64 d 1 3 d -5 -58 d f 0.8 0.8 0 c
- 1596 1913 m 4 34 d -3 -31 d f 0 0.8 0.4 c 1562 1609 m -6 -42 d -3 45 d f 0 0.8
- 0.2 c 1569 1665 m -7 -56 d -9 3 d -4 61 d f 0 0.8 0 c 1576 1722 m -7 -57 d -20
- 8 d -5 61 d f 0.2 0.8 0 c 1572 1782 m 5 -56 d -1 -4 d -32 12 d -4 61 d f 0.4
- 0.8 0 c 1567 1843 m 5 -61 d -32 13 d -4 61 d f 0.6 0.8 0 c 1561 1904 m 6 -61 d
- -31 13 d -3 41 d 3 18 d f 0.8 0.8 0 c 1556 1965 m 5 -61 d -25 11 d 11 54 d f
- 0.8 0.6 0 c 1553 2003 m 3 -38 d -9 4 d f 0.6 0.8 0 c 1536 1915 m -3 -18 d -5 19
- d f 0.8 0.8 0 c 1530 1930 m 10 31 d 7 8 d -11 -54 d -8 1 d -13 59 d 4 -9 d f
- 0.8 0.6 0 c 1540 1961 m 13 42 d -6 -34 d -32 6 d -6 24 d 10 -33 d f 0.2 0.8 0 c
- 1491 1782 m -5 -58 d 6 52 d f 0.4 0.8 0 c 1496 1846 m -5 -64 d 1 -6 d 7 57 d f
- 0.6 0.8 0 c 1502 1910 m -6 -64 d 3 -13 d 6 58 d f 0.8 0.8 0 c 1506 1897 m 24 33
- d -11 36 d -12 7 d -5 -63 d 3 -19 d f 0.8 0.6 0 c 1519 1966 m -10 33 d -2 -26 d
- f 0 0.8 0 c 1483 1662 m 3 36 d -5 1 d f 0.2 0.8 0 c 1486 1698 m 7 64 d -1 14 d
- -6 -52 d -4 56 d -5 -16 d 4 -65 d f 0.4 0.8 0 c 1493 1762 m 6 64 d 7 Y -7 -57 d
- -10 4 d -5 61 d -3 -13 d 3 -64 d f 0.6 0.8 0 c 1499 1826 m 6 64 d 1 Y -6 -58 d
- -22 8 d -4 61 d -2 -9 d 3 -65 d f 0.8 0.8 0 c 1505 1890 m 1 7 d -1 -6 d -32 11
- d -4 61 d -2 -5 d 4 -65 d f 0.8 0.6 0 c 1469 1963 m -5 61 d -1 Y 3 -65 d f 0.8
- 0.4 0 c 1464 2024 m -2 30 d 2 -31 d f 0 0.8 0 c 1479 1696 m 4 -34 d -2 37 d f
- 0.2 0.8 0 c 1471 1757 m 8 -61 d 2 3 d -4 65 d -38 5 d -3 Y 3 Y f 0.4 0.8 0 c
- 1464 1817 m 7 -60 d 6 7 d -3 64 d -30 5 d -5 -64 d 12 53 d f 0.6 0.8 0 c 1459
- 1858 m 5 -41 d 10 11 d -3 65 d -22 3 d -5 -63 d 7 -11 d f 0.8 0.8 0 c 1471 1893
- m -4 65 d -12 2 d -6 -64 d f 0.8 0.6 0 c 1467 1958 m -3 65 d -4 X -5 -63 d f
- 0.8 0.4 0 c 1464 2023 m -2 31 d -2 -31 d f 0.2 0.8 0 c 1439 1769 m -3 Y -1 3 d
- f 0.4 0.8 0 c 1451 1822 m -12 -53 d -1 X -14 59 d f 0.6 0.8 0 c 1450 1876 m 9
- -18 d -8 -36 d -27 6 d -9 39 d 8 15 d f 0.8 0.8 0 c 1436 1906 m 14 -30 d -27 6
- d f 0.6 0.8 0 c 1412 1859 m 4 8 d 7 15 d -8 -15 d -23 -6 d f 0.8 0.8 0 c 1416
- 1867 m 20 39 d -13 -24 d f 0.6 0.8 0 c 1410 1865 m 2 -6 d -20 2 d -2 20 d f 0.8
- 0.8 0 c 1389 1921 m 21 -56 d -20 16 d -5 61 d 3 -20 d f 0.8 0.6 0 c 1385 1942 m
- -6 61 d 3 -13 d 6 -68 d f 0.8 0.4 0 c 1379 2003 m -5 60 d 1 -6 d 7 -67 d f 0.8
- 0.2 0 c 1374 2063 m -6 61 d 7 -67 d f 0.6 0.8 0 c 1365 1794 m 12 63 d -32 13 d
- -7 Y f 0.8 0.8 0 c 1377 1857 m 12 64 d -1 1 d -37 11 d -6 -63 d f 0.8 0.6 0 c
- 1388 1922 m -6 68 d -25 7 d -6 -64 d f 0.8 0.4 0 c 1382 1990 m -7 67 d -12 4 d
- -6 -64 d f 0.8 0.2 0 c 1375 2057 m -7 67 d -5 -63 d f 0.4 0.8 0 c 1342 1734 m
- 22 58 d -30 X f 0.6 0.8 0 c 1364 1792 m 1 2 d -20 69 d -6 5 d -15 -7 d 10 -69 d
- f 0.8 0.8 0 c 1339 1868 m -18 16 d 3 -23 d f 0.2 0.8 0 c 1318 1701 m 15 21 d
- -17 -3 d f 0.4 0.8 0 c 1333 1722 m 9 12 d -8 58 d -24 -6 d 6 -67 d f 0.6 0.8 0
- c 1334 1792 m -10 69 d -20 -8 d 6 -67 d f 0.8 0.8 0 c 1324 1861 m -3 23 d -23
- 34 d 6 -65 d f 0 0.8 0 c 1277 1666 m -3 -36 d 5 32 d f 0.2 0.8 0 c 1312 1716 m
- 6 -15 d -2 18 d -34 10 d -5 -63 d 2 -4 d 9 55 d f 0.4 0.8 0 c 1295 1762 m 17
- -46 d 4 3 d -6 67 d -22 7 d -6 -64 d 6 -12 d f 0.6 0.8 0 c 1310 1786 m -6 67 d
- -11 3 d -5 -63 d f 0.8 0.8 0 c 1304 1853 m -6 65 d -5 -62 d f 0 0.8 0 c 1279
- 1662 m -5 -32 d -2 35 d f 0.2 0.8 0 c 1288 1717 m -9 -55 d -7 3 d -4 61 d f 0.4
- 0.8 0 c 1291 1773 m 4 -11 d -7 -45 d -20 9 d -4 61 d f 0.6 0.8 0 c 1273 1831 m
- 18 -58 d -27 14 d -5 61 d f 0.8 0.8 0 c 1271 1837 m 2 -6 d -14 17 d -4 61 d 7
- -10 d f 0.8 0.6 0 c 1255 1909 m -4 61 d 11 -71 d f 0.8 0.4 0 c 1251 1970 m 3 Y
- -3 Y f 0.6 0.8 0 c 1248 1804 m 17 25 d -20 -3 d f 0.8 0.8 0 c 1265 1829 m 6 8 d
- -9 62 d -26 -4 d 9 -69 d f 0.8 0.6 0 c 1262 1899 m -11 71 d -23 -6 d 8 -69 d f
- 0.8 0.4 0 c 1251 1970 m 3 Y -24 -6 d 1 -3 d f 0.4 0.8 0 c 1209 1773 m -5 -53 d
- 9 45 d f 0.6 0.8 0 c 1230 1820 m 18 -16 d -3 22 d -30 11 d -6 -64 d 4 -8 d 10
- 54 d f 0.8 0.8 0 c 1224 1825 m 6 -5 d 15 6 d -9 69 d -15 5 d -6 -63 d 8 -18 d f
- 0.8 0.6 0 c 1236 1895 m -8 69 d -1 X -6 -64 d f 0.8 0.4 0 c 1228 1964 m -1 3 d
- -3 Y f 0.4 0.8 0 c 1213 1765 m -9 -45 d -13 48 d f 0.6 0.8 0 c 1201 1792 m 17
- 25 d 5 2 d -10 -54 d -22 3 d -11 40 d f 0.8 0.8 0 c 1218 1817 m 6 8 d -1 -6 d f
- 0.2 0.8 0 c 1158 1698 m -1 -4 d 5 X f 0.4 0.8 0 c 1177 1692 m 13 55 d -19 16 d
- -13 -65 d 4 -4 d f 0.6 0.8 0 c 1190 1747 m 11 45 d -21 16 d -9 -45 d f 0 0.8 0
- c 1136 1630 m -3 -9 d 4 6 d f 0.2 0.8 0 c 1154 1659 m 14 21 d -6 14 d -5 X -21
- -64 d 1 -3 d f 0.4 0.8 0 c 1168 1680 m 9 12 d -15 2 d f 0 0.8 0 c 1137 1627 m
- -4 -6 d -1 8 d f 0.2 0.8 0 c 1144 1673 m 10 -14 d -17 -32 d -5 2 d -8 60 d f
- 0.4 0.8 0 c 1130 1694 m 14 -21 d -20 16 d -8 60 d 5 -9 d f 0.6 0.8 0 c 1116
- 1749 m -6 41 d 11 -50 d f 0.2 0.8 0 c 1107 1620 m 15 48 d -35 12 d -1 -4 d f
- 0.4 0.8 0 c 1122 1668 m 8 26 d -9 46 d -20 5 d -14 -65 d f 0.6 0.8 0 c 1121
- 1740 m -11 50 d -9 -45 d f 0.2 0.8 0 c 1103 1663 m 4 -43 d -21 56 d -1 3 d f
- 0.4 0.8 0 c 1098 1724 m 5 -61 d -18 16 d -18 58 d f 0.6 0.8 0 c 1093 1785 m 5
- -61 d -31 13 d -4 14 d 5 43 d f 0.8 0.8 0 c 1089 1846 m 4 -61 d -25 9 d 8 56 d
- f 0.8 0.6 0 c 1084 1907 m 5 -61 d -13 4 d 7 57 d f 0.8 0.4 0 c 1083 1910 m 1 -3
- d -1 X f 0 0.8 0 c 1060 1555 m 2 36 d -6 2 d f 0.2 0.8 0 c 1062 1591 m 4 63 d
- -16 6 d 6 -67 d f 0.4 0.8 0 c 1066 1654 m 5 63 d -27 9 d 6 -66 d f 0.6 0.8 0 c
- 1071 1717 m 4 63 d -7 14 d -5 -43 d -24 21 d 5 -46 d f 0.8 0.8 0 c 1075 1780 m
- 4 63 d -3 7 d -8 -56 d f 0.8 0.6 0 c 1079 1843 m 4 64 d -7 -57 d f 0.8 0.4 0 c
- 1083 1907 m 3 Y -3 Y f 0 0.8 0 c 1053 1588 m 7 -33 d -4 38 d f 0.2 0.8 0 c 1041
- 1647 m 12 -59 d 3 5 d -6 67 d f 0.4 0.8 0 c 1036 1670 m 5 -23 d 9 13 d -6 66 d
- -15 -12 d f 0.6 0.8 0 c 1044 1726 m -5 46 d -17 15 d -5 -2 d 12 -71 d f 0.8 0.8
- 0 c 1022 1787 m -6 6 d 1 -8 d f 0.4 0.8 0 c 1013 1690 m 23 -20 d -7 44 d -19
- -10 d f 0.6 0.8 0 c 1029 1714 m -12 71 d -23 -6 d 16 -75 d f 0.8 0.8 0 c 1017
- 1785 m -1 8 d -24 -6 d 2 -8 d f 0 0.8 0 c 989 1523 m 7 51 d -12 2 d f 0.2 0.8 0
- c 996 1574 m 9 64 d -27 5 d 6 -67 d f 0.4 0.8 0 c 1005 1638 m 8 52 d -3 14 d
- -38 6 d 6 -67 d f 0.6 0.8 0 c 1010 1704 m -16 75 d -5 X -20 -39 d 3 -30 d f 0.8
- 0.8 0 c 994 1779 m -2 8 d -3 -8 d f 0 0.8 0 c 966 1558 m 23 -35 d -5 53 d -19
- -9 d f 0.2 0.8 0 c 984 1576 m -6 67 d -20 -9 d 7 -67 d f 0.4 0.8 0 c 978 1643 m
- -6 67 d -22 -8 d 8 -68 d f 0.6 0.8 0 c 972 1710 m -3 30 d -23 8 d 4 -46 d f 0
- 0.8 0 c 963 1565 m 3 -7 d -1 9 d f 0.2 0.8 0 c 945 1623 m 18 -58 d 2 2 d -7 67
- d f 0.4 0.8 0 c 942 1632 m 3 -9 d 13 11 d -8 68 d -23 -6 d f 0.6 0.8 0 c 950
- 1702 m -4 46 d -24 -33 d 5 -19 d f 0.4 0.8 0 c 919 1640 m 23 -8 d -15 64 d -10
- 2 d -18 -56 d f 0.6 0.8 0 c 927 1696 m -5 19 d -5 -17 d f 0.2 0.8 0 c 895 1580
- m 14 34 d -23 3 d f 0.4 0.8 0 c 909 1614 m 10 26 d -20 2 d -24 21 d 11 -46 d f
- 0.2 0.8 0 c 872 1574 m 23 6 d -9 37 d -29 -1 d f 0.4 0.8 0 c 886 1617 m -11 46
- d -23 -33 d 5 -14 d f 0 0.8 0 c 838 1554 m -10 -51 d 6 44 d f 0.2 0.8 0 c 864
- 1602 m 8 -28 d -15 42 d -7 3 d -12 -65 d -4 -7 d 7 57 d f 0.4 0.8 0 c 849 1660
- m 15 -58 d -7 14 d -5 14 d -2 -11 d -9 -15 d 7 57 d f 0.6 0.8 0 c 848 1662 m 1
- -2 d -1 1 d f 0 0.8 0 c 834 1547 m -6 -44 d -21 43 d f 0.2 0.8 0 c 841 1604 m
- -7 -57 d -27 -1 d -2 5 d 7 51 d f 0.4 0.8 0 c 848 1661 m -7 -57 d -29 -2 d 8 56
- d f 0.6 0.8 0 c 825 1696 m 23 -34 d -1 Y -28 -3 d f 0.2 0.8 0 c 812 1602 m -7
- -51 d -24 34 d 6 12 d f 0.4 0.8 0 c 801 1623 m 9 28 d 10 7 d -8 -56 d -25 -5 d
- f 0.6 0.8 0 c 810 1651 m 15 45 d -5 -38 d f 0.2 0.8 0 c 778 1537 m 13 47 d -4
- 13 d -6 -12 d -23 -19 d f 0.4 0.8 0 c 791 1584 m 10 39 d -14 -26 d f 0 0.8 0.2
- c 754 1410 m 8 42 d -14 3 d f 0 0.8 0 c 762 1452 m 12 65 d -37 8 d 11 -70 d f
- 0.2 0.8 0 c 774 1517 m 4 20 d -20 29 d -24 -20 d 3 -21 d f 0 0.8 0.2 c 751 1449
- m 3 -39 d -6 45 d f 0 0.8 0 c 745 1510 m 6 -61 d -3 6 d -11 70 d f 0.2 0.8 0 c
- 738 1570 m 7 -60 d -8 15 d -3 21 d -6 42 d f 0.4 0.8 0 c 732 1631 m 6 -61 d -10
- 18 d -9 60 d f 0.6 0.8 0 c 731 1646 m 1 -15 d -13 17 d -8 53 d f 0 0.8 0 c 707
- 1478 m 4 23 d -8 2 d f 0.2 0.8 0 c 711 1501 m 9 64 d -28 9 d 11 -71 d f 0.4 0.8
- 0 c 720 1565 m 9 65 d -32 12 d -10 -41 d 5 -27 d f 0.6 0.8 0 c 729 1630 m 2 16
- d -20 55 d -14 -59 d f 0 0.8 0 c 704 1499 m 3 -21 d -4 25 d f 0.2 0.8 0 c 694
- 1559 m 10 -60 d -1 4 d -11 71 d f 0.4 0.8 0 c 684 1619 m 10 -60 d -2 15 d -5 27
- d -23 -19 d 19 37 d f 0.6 0.8 0 c 684 1620 m -1 Y -1 X f 0 0 0.8 c 660 929 m 3
- 63 d -21 15 d -2 -62 d f 0 0.2 0.8 c 663 992 m 2 62 d -20 16 d -3 -63 d f 0 0.4
- 0.8 c 665 1054 m 2 63 d -20 16 d -2 -63 d f 0 0.6 0.8 c 667 1117 m 2 63 d -20
- 15 d -2 -62 d f 0 0.8 0.8 c 669 1180 m 2 62 d -19 16 d -3 -63 d f 0 0.8 0.6 c
- 671 1242 m 2 63 d -19 16 d -2 -63 d f 0 0.8 0.4 c 673 1305 m 2 63 d -19 16 d -2
- -63 d f 0 0.8 0.2 c 675 1368 m 3 62 d -19 16 d -3 -62 d f 0 0.8 0 c 678 1430 m
- 2 63 d -19 16 d -2 -63 d f 0.2 0.8 0 c 680 1493 m 2 63 d -19 16 d -2 -63 d f
- 0.4 0.8 0 c 682 1556 m 2 63 d -1 X -19 -37 d -1 -10 d f 0.6 0.8 0 c 684 1619 m
- 1 Y -1 -1 d f 0 0 0.8 c 637 923 m 23 6 d -20 16 d -23 -6 d f 614 917 m 23 6 d
- -20 16 d -24 -6 d f 590 911 m 24 6 d -21 16 d -23 -6 d f 1691 1171 m 23 6 d -20
- 15 d -23 -6 d f 1667 1165 m 24 6 d -20 15 d -24 -6 d f 1644 1159 m 23 6 d -20
- 15 d -23 -6 d f 1641 1220 m 3 -61 d -20 15 d -2 62 d f 0 0.2 0.8 c 1637 1281 m
- 4 -61 d -19 16 d -2 61 d f 0 0.4 0.8 c 1634 1343 m 3 -62 d -17 16 d -2 62 d f 0
- 0.6 0.8 c 1631 1404 m 3 -61 d -16 16 d -2 62 d f 0 0.8 0.8 c 1627 1465 m 4 -61
- d -15 17 d -2 61 d f 0 0.8 0.6 c 1624 1526 m 3 -61 d -13 17 d -2 62 d f 0 0.8
- 0.4 c 1621 1588 m 3 -62 d -12 18 d -2 62 d f 0 0.8 0.2 c 1620 1596 m 1 -8 d -11
- 18 d -1 61 d 8 -15 d f 0 0.8 0 c 1609 1667 m -2 62 d 6 -12 d 4 -65 d f 0.2 0.8
- 0 c 1607 1729 m -2 62 d 5 -9 d 3 -65 d f 0.4 0.8 0 c 1605 1791 m -2 61 d 3 -5 d
- 4 -65 d f 0.6 0.8 0 c 1603 1852 m -2 62 d 1 -2 d 4 -65 d f 0.8 0.8 0 c 1601
- 1914 m -1 33 d 2 -35 d f 0 0.8 0.2 c 1597 1617 m 23 -21 d -3 56 d -26 -4 d f 0
- 0.8 0 c 1617 1652 m -4 65 d -35 4 d 13 -73 d f 0.2 0.8 0 c 1613 1717 m -3 65 d
- -27 3 d -6 -59 d 1 -5 d f 0.4 0.8 0 c 1610 1782 m -4 65 d -16 2 d -7 -64 d f
- 0.6 0.8 0 c 1606 1847 m -4 65 d -6 1 d -6 -64 d f 0.8 0.8 0 c 1602 1912 m -2 35
- d -4 -34 d f 0 0.8 0.2 c 1588 1641 m 9 -24 d -6 31 d f 0 0.8 0 c 1573 1678 m 15
- -37 d 3 7 d -13 73 d -6 -20 d f 0.2 0.8 0 c 1578 1721 m -1 5 d -5 56 d -4 -16 d
- 4 -65 d f 0.4 0.8 0 c 1572 1782 m -5 61 d -3 -11 d 4 -66 d f 0.6 0.8 0 c 1567
- 1843 m -6 61 d -1 -7 d 4 -65 d f 0.8 0.8 0 c 1561 1904 m -5 61 d -3 Y 4 -65 d f
- 0.8 0.6 0 c 1556 1965 m -3 38 d 3 -41 d f 0 0.8 0 c 1569 1699 m 4 -21 d -1 23 d
- f 0.2 0.8 0 c 1557 1758 m 12 -59 d 3 2 d -4 65 d f 0.4 0.8 0 c 1550 1793 m 7
- -35 d 11 8 d -4 66 d -18 -11 d f 0.6 0.8 0 c 1564 1832 m -4 65 d -25 -5 d 11
- -71 d f 0.8 0.8 0 c 1560 1897 m -4 65 d -16 -1 d -10 -31 d 5 -38 d f 0.8 0.6 0
- c 1556 1962 m -3 41 d -13 -42 d f 0.2 0.8 0 c 1526 1706 m 13 47 d -18 1 d f 0.4
- 0.8 0 c 1539 1753 m 11 40 d -4 28 d -32 1 d 7 -68 d f 0.6 0.8 0 c 1546 1821 m
- -11 71 d -28 -3 d 7 -67 d f 0.8 0.8 0 c 1535 1892 m -5 38 d -24 -33 d 1 -8 d f
- 0 0.8 0 c 1503 1674 m 7 10 d -24 14 d -3 -36 d f 0.2 0.8 0 c 1510 1684 m 16 22
- d -5 48 d -28 8 d -7 -64 d f 0.4 0.8 0 c 1521 1754 m -7 68 d -15 4 d -6 -64 d f
- 0.6 0.8 0 c 1514 1822 m -7 67 d -2 1 d -6 -64 d f 0.8 0.8 0 c 1507 1889 m -1 8
- d -1 -7 d f 0 0.8 0.2 c 1479 1587 m 8 29 d -10 X f 0 0.8 0 c 1487 1616 m 16 58
- d -20 -12 d -4 34 d -7 -15 d 5 -65 d f 0.2 0.8 0 c 1479 1696 m -8 61 d -4 -10 d
- 5 -66 d f 0.4 0.8 0 c 1471 1757 m -7 60 d -2 -4 d 5 -66 d f 0.6 0.8 0 c 1464
- 1817 m -5 41 d 3 -45 d f 0 0.8 0.4 c 1456 1527 m 8 21 d -9 -1 d f 0 0.8 0.2 c
- 1464 1548 m 15 39 d -2 29 d -26 -5 d 4 -64 d f 0 0.8 0 c 1477 1616 m -5 65 d
- -24 -5 d 3 -65 d f 0.2 0.8 0 c 1472 1681 m -5 66 d -23 -6 d 4 -65 d f 0.4 0.8 0
- c 1467 1747 m -5 66 d -21 -7 d 3 -65 d f 0.6 0.8 0 c 1462 1813 m -3 45 d -9 18
- d -12 -5 d 3 -65 d f 0.8 0.8 0 c 1450 1876 m -14 30 d 2 -35 d f 0 0.8 0.4 c
- 1453 1545 m 3 -18 d -1 20 d f 0 0.8 0.2 c 1443 1605 m 10 -60 d 2 2 d -4 64 d f
- 0 0.8 0 c 1433 1664 m 10 -59 d 8 6 d -3 65 d f 0.2 0.8 0 c 1432 1669 m 1 -5 d
- 15 12 d -4 65 d -18 -10 d f 0.4 0.8 0 c 1444 1741 m -3 65 d -22 -7 d 7 -68 d f
- 0.6 0.8 0 c 1441 1806 m -3 65 d -22 -4 d -4 -8 d 7 -60 d f 0.8 0.8 0 c 1438
- 1871 m -2 35 d -20 -39 d f 0.2 0.8 0 c 1409 1717 m 23 -48 d -6 62 d -17 -10 d f
- 0.4 0.8 0 c 1426 1731 m -7 68 d -17 -11 d 7 -67 d f 0.6 0.8 0 c 1419 1799 m -7
- 60 d -2 6 d -15 -10 d 7 -67 d f 0.8 0.8 0 c 1410 1865 m -21 56 d 6 -66 d f 0
- 0.8 0.2 c 1386 1563 m 4 28 d -7 1 d f 0 0.8 0 c 1390 1591 m 10 65 d -23 3 d 6
- -67 d f 0.2 0.8 0 c 1400 1656 m 9 61 d 4 Y -38 4 d 6 -66 d f 0.4 0.8 0 c 1409
- 1721 m -7 67 d -37 4 d 6 -67 d f 0.6 0.8 0 c 1402 1788 m -7 67 d -18 2 d -12
- -63 d -2 Y f 0.8 0.8 0 c 1395 1855 m -6 66 d -12 -64 d f 0 0.8 0.2 c 1381 1589
- m 5 -26 d -3 29 d f 0 0.8 0 c 1371 1649 m 10 -60 d 2 3 d -6 67 d f 0.2 0.8 0 c
- 1362 1705 m 9 -56 d 6 10 d -6 66 d -14 -13 d f 0.4 0.8 0 c 1371 1725 m -6 67 d
- -1 X -22 -58 d 15 -22 d f 0.6 0.8 0 c 1365 1792 m 2 Y -1 -2 d f 0.2 0.8 0 c
- 1361 1708 m 1 -3 d -5 7 d -24 10 d -15 -21 d 4 14 d f 0.4 0.8 0 c 1343 1766 m
- 18 -58 d -4 4 d -15 22 d -9 -12 d -11 -7 d 13 52 d f 0.6 0.8 0 c 1339 1780 m 4
- -14 d -8 1 d f 0 0.8 0.2 c 1315 1559 m 2 13 d -3 1 d f 0 0.8 0 c 1317 1572 m 6
- 64 d -16 4 d 7 -67 d f 0.2 0.8 0 c 1323 1636 m 7 64 d -8 15 d -4 -14 d -6 15 d
- -12 -8 d 7 -68 d f 0.4 0.8 0 c 1330 1700 m 7 64 d -2 3 d -13 -52 d -10 1 d -17
- 46 d 5 -54 d f 0.6 0.8 0 c 1337 1764 m 2 16 d -4 -13 d f 0 0.8 0.2 c 1310 1571
- m 5 -12 d -1 14 d f 0 0.8 0 c 1292 1620 m 18 -49 d 4 2 d -7 67 d -16 -11 d f
- 0.2 0.8 0 c 1307 1640 m -7 68 d -16 -12 d 7 -67 d f 0.4 0.8 0 c 1300 1708 m -5
- 54 d -4 11 d -13 -10 d 6 -67 d f 0.6 0.8 0 c 1291 1773 m -18 58 d -1 -1 d 6 -67
- d f 0.8 0.8 0 c 1273 1831 m -2 6 d 1 -7 d f 0 0.8 0 c 1268 1560 m 24 60 d -1 9
- d -28 -3 d f 0.2 0.8 0 c 1291 1629 m -7 67 d -27 -3 d 6 -67 d f 0.4 0.8 0 c
- 1284 1696 m -6 67 d -27 -4 d 6 -66 d f 0.6 0.8 0 c 1278 1763 m -6 67 d -7 -1 d
- -17 -25 d 3 -45 d f 0.8 0.8 0 c 1272 1830 m -1 7 d -6 -8 d f 0 0.8 0 c 1245
- 1608 m 23 -48 d -5 66 d -19 -9 d f 0.2 0.8 0 c 1263 1626 m -6 67 d -20 -9 d 7
- -67 d f 0.4 0.8 0 c 1257 1693 m -6 66 d -20 -8 d 6 -67 d f 0.6 0.8 0 c 1251
- 1759 m -3 45 d -18 16 d -5 -2 d 6 -67 d f 0.8 0.8 0 c 1230 1820 m -6 5 d 1 -7 d
- f 0 0.8 0.4 c 1221 1467 m 3 20 d -4 X f 0 0.8 0.2 c 1224 1487 m 11 65 d -19 X 4
- -65 d f 0 0.8 0 c 1235 1552 m 10 56 d -1 9 d -32 X 4 -65 d f 0.2 0.8 0 c 1244
- 1617 m -7 67 d -29 -1 d 4 -66 d f 0.4 0.8 0 c 1237 1684 m -6 67 d -27 -3 d 4
- -65 d f 0.6 0.8 0 c 1231 1751 m -6 67 d -7 -1 d -17 -25 d 3 -44 d f 0.8 0.8 0 c
- 1225 1818 m -1 7 d -6 -8 d f 0 0.8 0.4 c 1220 1486 m 1 -19 d -1 20 d f 0 0.8
- 0.2 c 1216 1547 m 4 -61 d 1 Y -4 65 d f 0 0.8 0 c 1212 1608 m 4 -61 d 5 Y -4 65
- d f 0.2 0.8 0 c 1209 1669 m 3 -61 d 9 Y -4 66 d f 0.4 0.8 0 c 1205 1730 m 4 -61
- d -1 14 d -4 65 d -14 -1 d -13 -55 d 6 47 d f 0.6 0.8 0 c 1201 1792 m 4 -62 d
- -1 18 d -3 44 d -11 -45 d -7 -8 d 8 57 d f 0.8 0.8 0 c 1198 1851 m 3 -59 d -10
- 4 d f 0.2 0.8 0 c 1174 1603 m 6 59 d -12 18 d -14 -21 d f 0.4 0.8 0 c 1180 1662
- m 6 64 d -3 13 d -6 -47 d -9 -12 d f 0.6 0.8 0 c 1186 1726 m 6 63 d -1 7 d -8
- -57 d f 0.8 0.8 0 c 1192 1789 m 6 62 d -7 -55 d f 0.2 0.8 0 c 1151 1638 m 23
- -35 d -20 56 d -10 14 d -2 -12 d f 0.4 0.8 0 c 1144 1673 m -14 21 d 12 -33 d f
- 0.2 0.8 0 c 1127 1618 m 24 20 d -9 23 d -20 7 d -15 -48 d f 0.4 0.8 0 c 1142
- 1661 m -12 33 d -8 -26 d f 0 0.8 0 c 1104 1545 m 12 38 d -14 -1 d f 0.2 0.8 0 c
- 1116 1583 m 11 35 d -20 2 d -4 43 d -5 -16 d 4 -65 d f 0.4 0.8 0 c 1103 1663 m
- -5 61 d -4 -12 d 4 -65 d f 0.6 0.8 0 c 1098 1724 m -5 61 d -2 -8 d 3 -65 d f
- 0.8 0.8 0 c 1093 1785 m -4 61 d -2 -4 d 4 -65 d f 0.8 0.6 0 c 1089 1846 m -5 61
- d -1 -1 d 4 -64 d f 0.8 0.4 0 c 1084 1907 m -1 3 d -4 Y f 0 0.8 0 c 1083 1575 m
- 21 -30 d -2 37 d -40 9 d -2 -36 d 18 21 d f 0.2 0.8 0 c 1080 1579 m 3 -4 d 19 7
- d -4 65 d -32 7 d -4 -63 d 16 -15 d f 0.4 0.8 0 c 1098 1647 m -4 65 d -23 5 d
- -5 -63 d f 0.6 0.8 0 c 1094 1712 m -3 65 d -16 3 d -4 -63 d f 0.8 0.8 0 c 1091
- 1777 m -4 65 d -8 1 d -4 -63 d f 0.8 0.6 0 c 1087 1842 m -4 64 d 1 Y -4 -64 d f
- 0.8 0.4 0 c 1083 1906 m 4 Y -3 Y f 0 0.8 0 c 1078 1576 m -18 -21 d -7 33 d f
- 0.2 0.8 0 c 1057 1587 m 23 -8 d -2 -3 d -25 12 d -12 59 d 2 -6 d f 0.4 0.8 0 c
- 1041 1647 m -5 23 d 7 -29 d f 0.2 0.8 0 c 1052 1629 m 5 -42 d -14 54 d f 0.4
- 0.8 0 c 1045 1690 m 7 -61 d -9 12 d -7 29 d -23 20 d 2 11 d f 0.6 0.8 0 c 1038
- 1750 m 7 -60 d -30 11 d 10 54 d f 0.8 0.8 0 c 1033 1796 m 5 -46 d -13 5 d f 0
- 0.8 0 c 996 1574 m -7 -51 d 10 42 d f 0.2 0.8 0 c 1010 1615 m 4 Y -5 19 d -9
- -64 d 3 -9 d f 0.4 0.8 0 c 1010 1619 m 8 64 d -3 18 d -2 -11 d -8 -52 d f 0.6
- 0.8 0 c 1018 1683 m 9 64 d -2 8 d -10 -54 d f 0.8 0.8 0 c 1027 1747 m 6 49 d -8
- -41 d f 0 0.8 0 c 999 1565 m -10 -42 d -23 35 d 1 7 d f 0.2 0.8 0 c 1009 1618 m
- 1 -3 d -11 -50 d -32 X 6 57 d f 0.4 0.8 0 c 997 1677 m 12 -59 d -36 4 d 7 57 d
- f 0.6 0.8 0 c 986 1730 m 11 -53 d -17 2 d f 0 0.8 0 c 967 1565 m -1 -7 d -3 7 d
- f 0.2 0.8 0 c 973 1622 m -6 -57 d -4 X -18 58 d f 0.4 0.8 0 c 963 1644 m 7 27 d
- 10 8 d -7 -57 d -28 1 d -3 9 d f 0.6 0.8 0 c 970 1671 m 16 59 d -6 -51 d f 0.4
- 0.8 0 c 939 1611 m 24 33 d -21 -12 d -23 8 d f 0.2 0.8 0 c 909 1614 m -14 -34 d
- 6 26 d f 0.4 0.8 0 c 921 1658 m 18 -47 d -20 29 d -10 -26 d -8 -8 d 12 53 d f
- 0.6 0.8 0 c 916 1672 m 5 -14 d -8 1 d f 0.2 0.8 0 c 892 1532 m 10 59 d -1 15 d
- -6 -26 d -23 -6 d f 0.4 0.8 0 c 902 1591 m 11 65 d 3 Y -12 -53 d f 0.6 0.8 0 c
- 913 1656 m 3 16 d -3 -13 d f 0.2 0.8 0 c 869 1579 m 23 -47 d -20 42 d -8 28 d 4
- -19 d f 0.4 0.8 0 c 864 1602 m -15 58 d 19 -77 d f 0.6 0.8 0 c 849 1660 m -1 2
- d 1 -2 d f 0.2 0.8 0 c 845 1560 m 24 19 d -1 4 d -26 -4 d f 0.4 0.8 0 c 868
- 1583 m -19 77 d -17 -11 d 10 -70 d f 0.6 0.8 0 c 849 1660 m -1 2 d -23 34 d 7
- -47 d f 0.2 0.8 0 c 822 1541 m 23 19 d -3 19 d -29 -1 d f 0.4 0.8 0 c 842 1579
- m -10 70 d -22 2 d -9 -28 d 12 -45 d f 0.6 0.8 0 c 832 1649 m -7 47 d -15 -45 d
- f 0 0.8 0.2 c 798 1400 m 7 42 d -13 4 d f 0 0.8 0 c 805 1442 m 11 65 d -35 9 d
- 11 -70 d f 0.2 0.8 0 c 816 1507 m 6 34 d -9 37 d -22 6 d -13 -47 d 3 -21 d f
- 0.4 0.8 0 c 813 1578 m -12 45 d -10 -39 d f 0 0.8 0.2 c 795 1440 m 3 -40 d -6
- 46 d -30 6 d -8 -42 d 3 38 d f 0 0.8 0 c 790 1501 m 5 -61 d -3 6 d -11 70 d -7
- 1 d -12 -65 d -5 -4 d 4 59 d f 0.2 0.8 0 c 786 1562 m 4 -61 d -9 15 d -3 21 d
- -4 -20 d -13 -10 d 4 59 d f 0.4 0.8 0 c 781 1623 m 5 -61 d -21 4 d 4 59 d f 0.6
- 0.8 0 c 776 1683 m 5 -60 d -12 2 d 4 59 d f 0.8 0.8 0 c 775 1703 m 1 -20 d -3 1
- d f 0 0.8 0.2 c 757 1448 m -3 -38 d -3 39 d f 0 0.8 0 c 761 1507 m -4 -59 d -6
- 1 d -6 61 d f 0.2 0.8 0 c 765 1566 m -4 -59 d -16 3 d -7 60 d f 0.4 0.8 0 c 769
- 1625 m -4 -59 d -27 4 d -6 61 d f 0.6 0.8 0 c 751 1617 m 18 65 d 4 2 d -4 -59 d
- -37 6 d -1 15 d f 0.8 0.8 0 c 769 1682 m 6 21 d -2 -19 d f 0 0.8 0 c 711 1501 m
- -4 -23 d 9 16 d f 0.2 0.8 0 c 728 1517 m 7 32 d -15 16 d -9 -64 d 5 -7 d f 0.4
- 0.8 0 c 735 1549 m 16 66 d -22 15 d -9 -65 d f 0.6 0.8 0 c 751 1615 m 2 Y -20
- 29 d -2 -16 d f 0 0.8 0 c 704 1470 m 5 10 d 7 14 d -9 -16 d -3 21 d -1 -19 d f
- 0.2 0.8 0 c 709 1480 m 19 37 d -12 -23 d -12 5 d -10 60 d -10 Y 9 -69 d f 0.4
- 0.8 0 c 694 1559 m -10 60 d -1 Y 10 -69 d f 0.6 0.8 0 c 684 1619 m 1 Y -2 Y f 0
- 0 0.8 c 681 913 m 2 63 d -20 16 d -3 -63 d f 0 0.2 0.8 c 683 976 m 3 63 d -21
- 15 d -2 -62 d f 0 0.4 0.8 c 686 1039 m 3 63 d -22 15 d -2 -63 d f 0 0.6 0.8 c
- 689 1102 m 2 63 d -22 15 d -2 -63 d f 0 0.8 0.8 c 691 1165 m 3 63 d -23 14 d -2
- -62 d f 0 0.8 0.6 c 694 1228 m 3 62 d -24 15 d -2 -63 d f 0 0.8 0.4 c 697 1290
- m 2 63 d -24 15 d -2 -63 d f 0 0.8 0.2 c 699 1353 m 3 63 d -24 14 d -3 -62 d f
- 0 0.8 0 c 702 1416 m 2 54 d -1 10 d -23 13 d -2 -63 d f 0.2 0.8 0 c 703 1480 m
- -9 69 d -12 7 d -2 -63 d f 0.4 0.8 0 c 694 1549 m -10 69 d 1 Y -2 -63 d f 0.6
- 0.8 0 c 684 1618 m 2 Y -1 Y f 0 0 0.8 c 657 907 m 24 6 d -21 16 d -23 -6 d f
- 634 901 m 23 6 d -20 16 d -23 -6 d f 610 896 m 24 5 d -20 16 d -24 -6 d f 1711
- 1155 m 24 6 d -21 16 d -23 -6 d f 1688 1149 m 23 6 d -20 16 d -24 -6 d f 1664
- 1143 m 24 6 d -21 16 d -23 -6 d f 1662 1205 m 2 -62 d -20 16 d -3 61 d f 0 0.2
- 0.8 c 1660 1266 m 2 -61 d -21 15 d -4 61 d f 0 0.4 0.8 c 1657 1328 m 3 -62 d
- -23 15 d -3 62 d f 0 0.6 0.8 c 1655 1389 m 2 -61 d -23 15 d -3 61 d f 0 0.8 0.8
- c 1653 1451 m 2 -62 d -24 15 d -4 61 d f 0 0.8 0.6 c 1650 1512 m 3 -61 d -26 14
- d -3 61 d f 0 0.8 0.4 c 1648 1574 m 2 -62 d -26 14 d -3 62 d f 0 0.8 0.2 c 1646
- 1636 m 2 -62 d -27 14 d -1 8 d 6 49 d f 0 0.8 0 c 1643 1697 m 3 -61 d -20 9 d 7
- 57 d f 0.2 0.8 0 c 1641 1759 m 2 -62 d -10 5 d 7 57 d f 0.4 0.8 0 c 1641 1769 m
- -10 Y -1 X f 0 0.8 0.2 c 1626 1645 m -6 -49 d -23 21 d 7 22 d f 0 0.8 0 c 1617
- 1682 m 3 9 d 13 11 d -7 -57 d -22 -6 d f 0.2 0.8 0 c 1620 1691 m 18 67 d 2 1 d
- -7 -57 d f 0.4 0.8 0 c 1638 1758 m 3 11 d -1 -10 d f 0 0.8 0.4 c 1594 1555 m 1
- 5 d -2 1 d f 0 0.8 0.2 c 1595 1560 m 12 66 d -3 13 d -7 -22 d -9 24 d -7 -9 d
- 12 -71 d f 0 0.8 0 c 1607 1626 m 10 56 d -13 -43 d -16 2 d -15 37 d 8 -46 d f 0
- 0.8 0.4 c 1593 1560 m 1 -5 d -1 6 d f 0 0.8 0.2 c 1577 1618 m 16 -58 d 1 Y -12
- 71 d f 0 0.8 0 c 1570 1643 m 7 -25 d 4 14 d -8 46 d -4 21 d -4 -16 d f 0.2 0.8
- 0 c 1569 1699 m -12 59 d -1 -6 d 9 -69 d f 0.4 0.8 0 c 1557 1758 m -7 35 d 6
- -41 d f 0 0.8 0 c 1565 1677 m 5 -34 d -5 40 d f 0.2 0.8 0 c 1555 1737 m 10 -60
- d 6 Y -9 69 d -17 1 d -13 -47 d 10 37 d f 0.4 0.8 0 c 1547 1785 m 8 -48 d 1 15
- d -6 41 d -11 -40 d -3 -10 d f 0 0.8 0 c 1523 1658 m 2 9 d -15 17 d -7 -10 d f
- 0.2 0.8 0 c 1525 1667 m 12 65 d -1 11 d -10 -37 d -16 -22 d f 0.4 0.8 0 c 1537
- 1732 m 10 53 d -11 -42 d f 0 0.8 0.6 c 1500 1464 m 1 10 d -3 2 d f 0 0.8 0.4 c
- 1501 1474 m 8 65 d -23 8 d 12 -71 d f 0 0.8 0.2 c 1509 1539 m 8 64 d -30 13 d
- -8 -29 d 7 -40 d f 0 0.8 0 c 1517 1603 m 6 55 d -20 16 d -16 -58 d f 0 0.8 0.6
- c 1498 1474 m 2 -10 d -2 12 d f 0 0.8 0.4 c 1490 1534 m 8 -60 d 2 Y -12 71 d
- -22 1 d -8 -21 d 3 16 d f 0 0.8 0.2 c 1482 1594 m 8 -60 d -4 13 d -7 40 d -15
- -39 d -5 -5 d 11 55 d f 0 0.8 0 c 1476 1633 m 6 -39 d -12 4 d f 0 0.8 0.4 c
- 1459 1543 m -3 -16 d -3 18 d f 0 0.8 0.2 c 1470 1598 m -11 -55 d -6 2 d -10 60
- d f 0 0.8 0 c 1469 1653 m 7 -20 d -6 -35 d -27 7 d -10 59 d f 0.2 0.8 0 c 1453
- 1694 m 16 -41 d -36 11 d -1 5 d f 0 0.8 0.2 c 1429 1554 m 5 28 d -8 1 d f 0 0.8
- 0 c 1434 1582 m 11 65 d -28 5 d 9 -69 d f 0.2 0.8 0 c 1445 1647 m 8 47 d -21
- -25 d -23 48 d 8 -65 d f 0 0.8 0.4 c 1406 1507 m 3 6 d -6 1 d f 0 0.8 0.2 c
- 1409 1513 m 20 41 d -3 29 d -36 8 d -4 -28 d 17 -49 d f 0 0.8 0 c 1426 1583 m
- -9 69 d -17 4 d -10 -65 d f 0.2 0.8 0 c 1417 1652 m -8 65 d -9 -61 d f 0 0.8
- 0.4 c 1401 1511 m 5 -4 d -3 7 d f 0 0.8 0.2 c 1382 1528 m 19 -17 d 2 3 d -17 49
- d -5 26 d -4 -17 d f 0 0.8 0 c 1381 1589 m -10 60 d -2 -9 d 8 -68 d f 0.2 0.8 0
- c 1371 1649 m -9 56 d 7 -65 d f 0 0.8 0.2 c 1371 1565 m 11 -37 d -5 44 d f 0
- 0.8 0 c 1359 1603 m 12 -38 d 6 7 d -8 68 d -13 -13 d f 0.2 0.8 0 c 1369 1640 m
- -7 65 d -1 3 d -13 -13 d 8 -68 d f 0.4 0.8 0 c 1361 1708 m -18 58 d -3 -3 d 8
- -68 d f 0.6 0.8 0 c 1343 1766 m -4 14 d 1 -17 d f 0 0.8 0.2 c 1335 1516 m 12 43
- d -30 13 d -2 -13 d f 0 0.8 0 c 1347 1559 m 12 44 d -3 24 d -33 9 d -6 -64 d f
- 0.2 0.8 0 c 1356 1627 m -8 68 d -18 5 d -7 -64 d f 0.4 0.8 0 c 1348 1695 m -8
- 68 d -3 1 d -7 -64 d f 0.6 0.8 0 c 1340 1763 m -1 17 d -2 -16 d f 0 0.8 0.6 c
- 1312 1416 m 2 11 d -3 X f 0 0.8 0.4 c 1314 1427 m 16 66 d -26 1 d 7 -67 d f 0
- 0.8 0.2 c 1330 1493 m 5 23 d -20 43 d -5 12 d -13 -9 d 7 -68 d f 0 0.8 0 c 1310
- 1571 m -18 49 d 5 -58 d f 0 0.8 0.6 c 1311 1426 m 1 -10 d -1 11 d f 0 0.8 0.4 c
- 1303 1486 m 8 -60 d 1 Y -7 67 d f 0 0.8 0.2 c 1295 1546 m 8 -60 d 1 8 d -7 68 d
- -29 -2 d f 0 0.8 0 c 1288 1598 m 7 -52 d 2 16 d -5 58 d -24 -60 d f 1265 1539 m
- 23 59 d -20 -38 d -23 48 d f 0 0.8 0.4 c 1224 1487 m -3 -20 d 5 15 d f 0 0.8
- 0.2 c 1241 1533 m 24 6 d -30 13 d -11 -65 d 2 -5 d f 0 0.8 0 c 1241 1533 m 24 6
- d -20 69 d -10 -56 d f 0 0.8 0.4 c 1226 1482 m -5 -15 d -1 19 d f 0 0.8 0.2 c
- 1218 1500 m 23 33 d -15 -51 d -6 4 d -4 61 d -19 Y f 0 0.8 0 c 1241 1533 m -25
- 14 d -4 61 d 1 -15 d 3 -65 d f 0.2 0.8 0 c 1212 1608 m -3 61 d -11 Y 4 -65 d f
- 0.4 0.8 0 c 1209 1669 m -4 61 d -7 Y 4 -65 d f 0.6 0.8 0 c 1205 1730 m -4 62 d
- -4 Y 4 -65 d f 0.8 0.8 0 c 1201 1792 m -3 59 d 3 -63 d f 0 0.8 0.2 c 1194 1521
- m 24 -21 d -2 28 d f 0 0.8 0 c 1194 1521 m 22 7 d -3 65 d -37 4 d f 0.2 0.8 0 c
- 1213 1593 m -4 65 d -29 4 d -6 -59 d 2 -6 d f 0.4 0.8 0 c 1209 1658 m -4 65 d
- -19 3 d -6 -64 d f 0.6 0.8 0 c 1205 1723 m -4 65 d -9 1 d -6 -63 d f 0.8 0.8 0
- c 1201 1788 m -3 63 d -6 -62 d f 0 0.8 0.4 c 1171 1447 m 2 6 d -3 X f 0 0.8 0.2
- c 1173 1453 m 21 68 d -31 X 7 -68 d f 0 0.8 0 c 1194 1521 m -18 76 d -20 -9 d 7
- -67 d f 0.2 0.8 0 c 1176 1597 m -2 6 d -23 35 d 5 -50 d f 0 0.8 0.4 c 1169 1452
- m 2 -5 d -1 6 d f 0 0.8 0.2 c 1147 1509 m 22 -57 d 1 1 d -7 68 d f 0 0.8 0 c
- 1147 1509 m 16 12 d -7 67 d -22 -7 d f 0.2 0.8 0 c 1156 1588 m -5 50 d -24 -20
- d 7 -37 d f 0 0.8 0.6 c 1124 1368 m 2 11 d -3 X f 0 0.8 0.4 c 1126 1379 m 11 65
- d -22 3 d 8 -68 d f 0 0.8 0.2 c 1137 1444 m 10 65 d -40 7 d 8 -69 d f 0 0.8 0 c
- 1147 1509 m -13 72 d -18 2 d -12 -38 d 3 -29 d f 0.2 0.8 0 c 1134 1581 m -7 37
- d -11 -35 d f 0 0.8 0.6 c 1121 1378 m 3 -10 d -1 11 d f 0 0.8 0.4 c 1106 1436 m
- 15 -58 d 2 1 d -8 68 d f 0 0.8 0.2 c 1100 1456 m 6 -20 d 9 11 d -8 69 d -14 -13
- d f 0 0.8 0 c 1107 1516 m -3 29 d -21 30 d -2 -1 d 12 -71 d f 0.2 0.8 0 c 1083
- 1575 m -3 4 d 1 -5 d f 0 0.8 0.2 c 1077 1450 m 23 6 d -7 47 d -23 -7 d f 0 0.8
- 0 c 1093 1503 m -12 71 d -21 -8 d 10 -70 d f 0.2 0.8 0 c 1081 1574 m -1 5 d -23
- 8 d 3 -21 d f 0 0.8 0.2 c 1054 1485 m 23 -35 d -7 46 d f 0 0.8 0 c 1054 1485 m
- 16 11 d -10 70 d -11 -16 d f 0.2 0.8 0 c 1060 1566 m -3 21 d -5 42 d -7 -13 d 4
- -66 d f 0.4 0.8 0 c 1052 1629 m -7 61 d -4 -9 d 4 -65 d f 0.6 0.8 0 c 1045 1690
- m -7 60 d -2 -4 d 5 -65 d f 0.8 0.8 0 c 1038 1750 m -5 46 d 3 -50 d f 0 0.8 0 c
- 1043 1544 m 11 -59 d -5 65 d f 0.2 0.8 0 c 1032 1603 m 11 -59 d 6 6 d -4 66 d
- -35 3 d -4 Y 5 X f 0.4 0.8 0 c 1030 1613 m 2 -10 d 13 13 d -4 65 d -23 2 d -8
- -64 d 5 -4 d f 0.6 0.8 0 c 1041 1681 m -5 65 d -9 1 d -9 -64 d f 0.8 0.8 0 c
- 1036 1746 m -3 50 d -6 -49 d f 0 0.8 0 c 1007 1473 m 10 65 d -16 1 d f 0.2 0.8
- 0 c 1017 1538 m 11 65 d -13 12 d -5 X -1 3 d -13 -13 d 5 -66 d f 0.4 0.8 0 c
- 1028 1603 m 2 10 d -15 2 d -6 3 d -12 59 d -6 -6 d 5 -66 d f 0.6 0.8 0 c 997
- 1677 m -11 53 d 5 -59 d f 0 0.8 0 c 983 1507 m 24 -34 d -6 66 d -22 -7 d f 0.2
- 0.8 0 c 1001 1539 m -5 66 d -27 -3 d 10 -70 d f 0.4 0.8 0 c 996 1605 m -5 66 d
- -21 X -7 -27 d 6 -42 d f 0.6 0.8 0 c 991 1671 m -5 59 d -16 -59 d f 0 0.8 0.4 c
- 960 1353 m 7 48 d -11 1 d f 0 0.8 0.2 c 967 1401 m 10 64 d -26 3 d 5 -66 d f 0
- 0.8 0 c 977 1465 m 6 42 d -4 25 d -34 2 d 6 -66 d f 0.2 0.8 0 c 979 1532 m -10
- 70 d -29 -2 d 5 -66 d f 0.4 0.8 0 c 969 1602 m -6 42 d -24 -33 d 1 -11 d f 0
- 0.8 0.4 c 944 1395 m 16 -42 d -4 49 d f 0 0.8 0.2 c 936 1415 m 8 -20 d 12 7 d
- -5 66 d -18 -11 d f 0 0.8 0 c 951 1468 m -6 66 d -18 -10 d 6 -67 d f 0.2 0.8 0
- c 945 1534 m -5 66 d -18 -10 d 5 -66 d f 0.4 0.8 0 c 940 1600 m -1 11 d -18 47
- d -4 -2 d 5 -66 d f 0.6 0.8 0 c 921 1658 m -5 14 d 1 -16 d f 0 0.8 0.2 c 926
- 1452 m 10 -37 d -3 42 d f 0 0.8 0 c 913 1503 m 13 -51 d 7 5 d -6 67 d -27 -3 d
- f 0.2 0.8 0 c 927 1524 m -5 66 d -20 1 d -10 -59 d 8 -11 d f 0.4 0.8 0 c 922
- 1590 m -5 66 d -4 X -11 -65 d f 0.6 0.8 0 c 917 1656 m -1 16 d -3 -16 d f 0 0.8
- 0 c 889 1470 m 24 33 d -13 18 d -19 -10 d f 0.2 0.8 0 c 900 1521 m -8 11 d -23
- 47 d 12 -68 d f 0 0.8 0.4 c 866 1370 m 1 5 d -2 X f 0 0.8 0.2 c 867 1375 m 15
- 66 d -24 2 d 7 -68 d f 0 0.8 0 c 882 1441 m 7 29 d -8 41 d -30 X 7 -68 d f 0.2
- 0.8 0 c 881 1511 m -12 68 d -24 -19 d 6 -49 d f 0 0.8 0.4 c 865 1375 m 1 -5 d
- -1 5 d f 0 0.8 0.2 c 853 1434 m 12 -59 d -7 68 d f 0 0.8 0 c 842 1485 m 11 -51
- d 5 9 d -7 68 d -13 -15 d f 0.2 0.8 0 c 851 1511 m -6 49 d -23 -19 d 16 -45 d f
- 0 0.8 0.2 c 805 1442 m -7 -42 d 12 31 d f 0 0.8 0 c 819 1452 m 23 33 d -4 11 d
- -22 11 d -11 -65 d 5 -11 d f 0.2 0.8 0 c 838 1496 m -16 45 d -6 -34 d f 0 0.8
- 0.2 c 795 1392 m 12 30 d 3 9 d -12 -31 d -3 40 d -2 -20 d f 0 0.8 0 c 807 1422
- m 12 30 d -9 -21 d -15 9 d -5 61 d -1 -15 d 4 -66 d f 0.2 0.8 0 c 790 1501 m -4
- 61 d -1 -11 d 4 -65 d f 0.4 0.8 0 c 786 1562 m -5 61 d -1 -6 d 5 -66 d f 0.6
- 0.8 0 c 781 1623 m -5 60 d -1 Y 4 -65 d f 0.8 0.8 0 c 776 1683 m -1 20 d 1 -21
- d f 0 0.8 0.4 c 772 1346 m 3 6 d -4 -1 d f 0 0.8 0.2 c 775 1352 m 20 40 d -2 28
- d -27 -3 d 5 -66 d f 0 0.8 0 c 793 1420 m -4 66 d -28 -3 d 5 -66 d f 0.2 0.8 0
- c 789 1486 m -4 65 d -29 -2 d 5 -66 d f 0.4 0.8 0 c 785 1551 m -5 66 d -29 -2 d
- 5 -66 d f 0.6 0.8 0 c 780 1617 m -4 65 d -7 X -18 -65 d -2 Y f 0.8 0.8 0 c 776
- 1682 m -1 21 d -6 -21 d f 0 0.8 0.4 c 771 1351 m 1 -5 d -1 5 d f 0 0.8 0.2 c
- 760 1410 m 11 -59 d -5 66 d f 0 0.8 0 c 749 1469 m 11 -59 d 6 7 d -5 66 d f 0.2
- 0.8 0 c 748 1474 m 1 -5 d 12 14 d -5 66 d -21 X -7 -32 d f 0.4 0.8 0 c 756 1549
- m -5 66 d -16 -66 d f 0.6 0.8 0 c 751 1615 m 2 Y -2 Y f 0 0.8 0.2 c 725 1388 m
- 4 14 d -8 2 d f 0 0.8 0 c 729 1402 m 18 67 d -38 11 d -5 -10 d 17 -66 d f 0.2
- 0.8 0 c 747 1469 m 1 5 d -20 43 d -19 -37 d f 0 0 0.8 c 701 898 m 3 63 d -21 15
- d -2 -63 d f 0 0.2 0.8 c 704 961 m 3 63 d -21 15 d -3 -63 d f 0 0.4 0.8 c 707
- 1024 m 3 63 d -21 15 d -3 -63 d f 0 0.6 0.8 c 710 1087 m 3 63 d -22 15 d -2 -63
- d f 0 0.8 0.8 c 713 1150 m 3 62 d -22 16 d -3 -63 d f 0 0.8 0.6 c 716 1212 m 3
- 63 d -22 15 d -3 -62 d f 0 0.8 0.4 c 719 1275 m 3 63 d -23 15 d -2 -63 d f 0
- 0.8 0.2 c 722 1338 m 3 50 d -4 16 d -19 12 d -3 -63 d f 0 0.8 0 c 721 1404 m
- -17 66 d -2 -54 d f 0 0 0.8 c 678 892 m 23 6 d -20 15 d -24 -6 d f 654 886 m 24
- 6 d -21 15 d -23 -6 d f 631 880 m 23 6 d -20 15 d -24 -5 d f 1732 1139 m 23 6 d
- -20 16 d -24 -6 d f 1708 1134 m 24 5 d -21 16 d -23 -6 d f 1685 1128 m 23 6 d
- -20 15 d -24 -6 d f 1681 1189 m 4 -61 d -21 15 d -2 62 d f 0 0.2 0.8 c 1677
- 1250 m 4 -61 d -19 16 d -2 61 d f 0 0.4 0.8 c 1674 1311 m 3 -61 d -17 16 d -3
- 62 d f 0 0.6 0.8 c 1670 1372 m 4 -61 d -17 17 d -2 61 d f 0 0.8 0.8 c 1666 1434
- m 4 -62 d -15 17 d -2 62 d f 0 0.8 0.6 c 1663 1495 m 3 -61 d -13 17 d -3 61 d f
- 0 0.8 0.4 c 1661 1525 m 2 -30 d -13 17 d -2 62 d 10 -15 d f 0 0.8 0.2 c 1648
- 1574 m -2 62 d 7 -11 d 5 -66 d f 0 0.8 0 c 1646 1636 m -3 61 d 4 -6 d 6 -66 d f
- 0.2 0.8 0 c 1643 1697 m -2 62 d 1 -1 d 5 -67 d f 0.4 0.8 0 c 1641 1759 m 10 Y 1
- -11 d f 0 0.8 0.8 c 1638 1425 m 1 Y -1 X f 0 0.8 0.6 c 1638 1426 m 16 66 d -22
- 1 d 5 -67 d f 0 0.8 0.4 c 1654 1492 m 7 33 d -3 34 d -31 X 5 -66 d f 0 0.8 0.2
- c 1658 1559 m -5 66 d -31 X 5 -66 d f 0 0.8 0 c 1653 1625 m -6 66 d -27 X -3 -9
- d 5 -57 d f 0.2 0.8 0 c 1647 1691 m -5 67 d -4 X -18 -67 d f 0.4 0.8 0 c 1642
- 1758 m -1 11 d -3 -11 d f 0 0.8 0.8 c 1614 1419 m 24 6 d -1 1 d -23 -5 d f 0
- 0.8 0.6 c 1637 1426 m -5 67 d -29 -2 d 11 -70 d f 0 0.8 0.4 c 1632 1493 m -5 66
- d -32 1 d -1 -5 d 9 -64 d f 0 0.8 0.2 c 1627 1559 m -5 66 d -15 1 d -12 -66 d f
- 0 0.8 0 c 1622 1625 m -5 57 d -10 -56 d f 0 0.8 0.8 c 1614 1420 m -1 Y 2 Y f 0
- 0.8 0.6 c 1592 1477 m 22 -57 d 1 Y -11 70 d f 0 0.8 0.4 c 1591 1480 m 1 -3 d 11
- 14 d -9 64 d -1 5 d -10 -15 d f 0 0.8 0.2 c 1593 1560 m -16 58 d -3 -5 d 9 -68
- d f 0 0.8 0 c 1577 1618 m -7 25 d 4 -30 d f 0 0.8 0.6 c 1567 1460 m 18 15 d -19
- -4 d f 0 0.8 0.4 c 1585 1475 m 6 5 d -8 65 d -21 -9 d 4 -65 d f 0 0.8 0.2 c
- 1583 1545 m -9 68 d -16 -11 d 4 -66 d f 0 0.8 0 c 1574 1613 m -4 30 d -5 34 d
- -11 -10 d 4 -65 d f 0.2 0.8 0 c 1565 1677 m -10 60 d -5 -5 d 4 -65 d f 0.4 0.8
- 0 c 1555 1737 m -8 48 d 3 -53 d f 0 0.8 0.6 c 1544 1428 m 23 32 d -1 11 d -26
- -4 d f 0 0.8 0.4 c 1566 1471 m -4 65 d -28 -2 d 6 -67 d f 0 0.8 0.2 c 1562 1536
- m -4 66 d -30 -2 d 6 -66 d f 0 0.8 0 c 1558 1602 m -4 65 d -29 X -2 -9 d 5 -58
- d f 0.2 0.8 0 c 1554 1667 m -4 65 d -13 X -12 -65 d f 0.4 0.8 0 c 1550 1732 m
- -3 53 d -10 -53 d f 0 0.8 0.6 c 1522 1459 m 22 -31 d -4 39 d -39 7 d -1 -10 d
- 15 -2 d f 0 0.8 0.4 c 1520 1462 m 2 -3 d 18 8 d -6 67 d -25 5 d -8 -65 d 14 -12
- d f 0 0.8 0.2 c 1534 1534 m -6 66 d -11 3 d -8 -64 d f 0 0.8 0 c 1528 1600 m -5
- 58 d -6 -55 d f 0 0.8 0.6 c 1497 1416 m 21 42 d -3 4 d -15 2 d -2 10 d -5 -19 d
- f 0 0.8 0.4 c 1518 1458 m 2 4 d -5 X -17 12 d -8 60 d -3 -12 d 6 -67 d f 0 0.8
- 0.2 c 1490 1534 m -8 60 d -2 -5 d 7 -67 d f 0 0.8 0 c 1482 1594 m -6 39 d 4 -44
- d f 0 0.8 0.6 c 1475 1447 m 22 -31 d -4 39 d f 0 0.8 0.4 c 1473 1450 m 2 -3 d
- 18 8 d -6 67 d -19 -9 d f 0 0.8 0.2 c 1487 1522 m -7 67 d -18 -10 d 6 -66 d f 0
- 0.8 0 c 1480 1589 m -4 44 d -7 20 d -12 -8 d 5 -66 d f 0.2 0.8 0 c 1469 1653 m
- -16 41 d 4 -49 d f 0 0.8 0.8 c 1450 1336 m 9 45 d -14 1 d f 0 0.8 0.6 c 1459
- 1381 m 13 65 d -33 3 d 6 -67 d f 0 0.8 0.4 c 1472 1446 m 1 4 d -5 63 d -35 3 d
- 6 -67 d f 0 0.8 0.2 c 1468 1513 m -6 66 d -28 3 d -5 -28 d 4 -38 d f 0 0.8 0 c
- 1462 1579 m -5 66 d -12 2 d -11 -65 d f 0.2 0.8 0 c 1457 1645 m -4 49 d -8 -47
- d f 0 0.8 0.8 c 1435 1375 m 15 -39 d -5 46 d f 0 0.8 0.6 c 1426 1398 m 9 -23 d
- 10 7 d -6 67 d -21 -8 d f 0 0.8 0.4 c 1439 1449 m -6 67 d -24 -3 d -3 -6 d 12
- -66 d f 0 0.8 0.2 c 1433 1516 m -4 38 d -20 -41 d f 0 0.8 0.8 c 1403 1365 m 1 2
- d -2 X f 0 0.8 0.6 c 1404 1367 m 22 31 d -8 43 d -24 -6 d 8 -68 d f 0 0.8 0.4 c
- 1418 1441 m -12 66 d -5 4 d -16 -7 d 9 -69 d f 0 0.8 0.2 c 1401 1511 m -19 17 d
- 3 -24 d f 0 0.8 0.8 c 1402 1366 m 1 -1 d -1 2 d f 0 0.8 0.6 c 1379 1413 m 23
- -47 d 1 Y -8 68 d -16 -11 d f 0 0.8 0.4 c 1394 1435 m -9 69 d -14 -13 d 7 -67 d
- f 0 0.8 0.2 c 1385 1504 m -3 24 d -11 37 d -7 -6 d 7 -68 d f 0 0.8 0 c 1371
- 1565 m -12 38 d 5 -44 d f 0 0.8 0.6 c 1370 1420 m 9 -7 d -1 11 d f 0 0.8 0.4 c
- 1356 1433 m 14 -13 d 8 4 d -7 67 d -29 -2 d f 0 0.8 0.2 c 1371 1491 m -7 68 d
- -17 X -12 -43 d 7 -27 d f 0 0.8 0 c 1364 1559 m -5 44 d -12 -44 d f 0 0.8 0.6 c
- 1314 1427 m -2 -11 d 5 6 d f 0 0.8 0.4 c 1332 1441 m 24 -8 d -14 56 d -12 4 d
- -16 -66 d 3 -5 d f 0 0.8 0.2 c 1342 1489 m -7 27 d -5 -23 d f 0 0.8 0.6 c 1317
- 1422 m -5 -6 d -1 10 d f 0 0.8 0.4 c 1309 1422 m 23 19 d -15 -19 d -6 4 d -8 60
- d -15 Y f 0 0.8 0.2 c 1303 1486 m -8 60 d -7 Y 8 -68 d f 0 0.8 0 c 1295 1546 m
- -7 52 d 7 -59 d f 0 0.8 0.6 c 1285 1362 m 16 41 d -20 -1 d f 0 0.8 0.4 c 1301
- 1403 m 8 19 d -6 49 d -30 -1 d 8 -68 d f 0 0.8 0.2 c 1303 1471 m -8 68 d -30 X
- 8 -69 d f 0 0.8 0 c 1295 1539 m -7 59 d -23 -59 d f 0 0.8 0.8 c 1262 1329 m 1 2
- d -1 X f 0 0.8 0.6 c 1263 1331 m 22 31 d -4 40 d -26 -4 d 7 -67 d f 0 0.8 0.4 c
- 1281 1402 m -8 68 d -25 -5 d 7 -67 d f 0 0.8 0.2 c 1273 1470 m -8 69 d -24 -6 d
- 7 -68 d f 0 0.8 0.8 c 1238 1283 m 24 46 d 2 Y -28 -3 d f 0 0.8 0.6 c 1262 1331
- m -7 67 d -27 -3 d 6 -67 d f 0 0.8 0.4 c 1255 1398 m -7 67 d -26 -3 d 6 -67 d f
- 0 0.8 0.2 c 1248 1465 m -7 68 d -23 -33 d 4 -38 d f 0 0.8 0.8 c 1230 1323 m 8
- -40 d -4 45 d f 0 0.8 0.6 c 1218 1382 m 12 -59 d 4 5 d -6 67 d f 0 0.8 0.4 c
- 1215 1398 m 3 -16 d 10 13 d -6 67 d -16 -13 d f 0 0.8 0.2 c 1222 1462 m -4 38 d
- -24 21 d 12 -72 d f 0 0.8 0.4 c 1195 1438 m 20 -40 d -9 51 d -33 4 d -2 -6 d 8
- X f 0 0.8 0.2 c 1191 1445 m 4 -7 d 11 11 d -12 72 d -21 -68 d 6 -6 d f 0 0.8
- 0.4 c 1168 1399 m 18 37 d -7 11 d -8 X -2 5 d -8 -16 d f 0 0.8 0.2 c 1186 1436
- m 5 9 d -12 2 d -10 5 d -22 57 d 14 -73 d f 0 0.8 0.6 c 1144 1339 m 11 26 d -29
- 14 d -2 -11 d f 0 0.8 0.4 c 1155 1365 m 13 34 d -7 37 d -24 8 d -11 -65 d f 0
- 0.8 0.2 c 1161 1436 m -14 73 d -10 -65 d f 0 0.8 0.6 c 1121 1347 m 23 -8 d -20
- 29 d -3 10 d -2 -19 d f 0 0.8 0.4 c 1121 1378 m -15 58 d -1 -5 d 14 -72 d f 0
- 0.8 0.2 c 1106 1436 m -6 20 d 5 -25 d f 0 0.8 0.6 c 1112 1355 m 9 -8 d -2 12 d
- f 0 0.8 0.4 c 1097 1368 m 15 -13 d 7 4 d -14 72 d -21 -7 d f 0 0.8 0.2 c 1105
- 1431 m -5 25 d -23 -6 d 7 -26 d f 0 0.8 0.4 c 1074 1348 m 23 20 d -13 56 d -20
- -9 d f 0 0.8 0.2 c 1084 1424 m -7 26 d -23 35 d 10 -70 d f 0 0.8 0.6 c 1050
- 1329 m 18 14 d -18 -3 d f 0 0.8 0.4 c 1068 1343 m 6 5 d -10 67 d -19 -10 d 5
- -65 d f 0 0.8 0.2 c 1064 1415 m -10 70 d -14 -14 d 5 -66 d f 0 0.8 0 c 1054
- 1485 m -11 59 d -8 -7 d 5 -66 d f 0.2 0.8 0 c 1043 1544 m -11 59 d -1 -1 d 4
- -65 d f 0.4 0.8 0 c 1032 1603 m -2 10 d 1 -11 d f 0 0.8 0.6 c 1042 1337 m 8 -8
- d 11 Y f 0 0.8 0.4 c 1027 1350 m 15 -13 d 8 3 d -5 65 d -27 -3 d f 0 0.8 0.2 c
- 1045 1405 m -5 66 d -33 2 d 11 -71 d f 0 0.8 0 c 1040 1471 m -5 66 d -18 1 d
- -10 -65 d f 0.2 0.8 0 c 1035 1537 m -4 65 d -3 1 d -11 -65 d f 0.4 0.8 0 c 1031
- 1602 m -1 11 d -2 -10 d f 0 0.8 0.4 c 1007 1390 m 20 -40 d -9 52 d f 0 0.8 0.2
- c 1003 1398 m 4 -8 d 11 12 d -11 71 d -15 -13 d f 0 0.8 0 c 1007 1473 m -24 34
- d 9 -47 d f 0 0.8 0.4 c 980 1351 m 19 37 d -32 13 d -7 -48 d f 0 0.8 0.2 c 999
- 1388 m 4 10 d -11 62 d -15 5 d -10 -64 d f 0 0.8 0 c 992 1460 m -9 47 d -6 -42
- d f 0 0.8 0.4 c 969 1380 m 11 -29 d -20 2 d -16 42 d f 0 0.8 0.2 c 956 1412 m
- 13 -32 d -25 15 d -8 20 d f 0 0.8 0.4 c 933 1326 m 13 49 d -19 1 d f 0 0.8 0.2
- c 946 1375 m 10 37 d -20 3 d -10 37 d -7 -8 d 8 -68 d f 0 0.8 0 c 926 1452 m
- -13 51 d 6 -59 d f 0 0.8 0.8 c 909 1212 m 7 31 d -9 X f 0 0.8 0.6 c 916 1243 m
- 13 65 d -27 1 d 5 -66 d f 0 0.8 0.4 c 929 1308 m 4 18 d -6 50 d -30 -1 d 5 -66
- d f 0 0.8 0.2 c 927 1376 m -8 68 d -28 -3 d 6 -66 d f 0 0.8 0 c 919 1444 m -6
- 59 d -24 -33 d 2 -29 d f 0 0.8 0.8 c 907 1240 m 2 -28 d -2 31 d f 0 0.8 0.6 c
- 900 1301 m 7 -61 d 3 Y -5 66 d f 0 0.8 0.4 c 894 1361 m 6 -60 d 2 8 d -5 66 d
- -30 X -1 -5 d 1 4 d f 0 0.8 0.2 c 887 1422 m 7 -61 d 3 14 d -6 66 d -9 X -15
- -66 d -1 Y 16 50 d f 0 0.8 0 c 886 1435 m 1 -13 d 4 19 d -2 29 d -7 -29 d 1 -17
- d f 0 0.8 0.4 c 867 1374 m -1 -4 d -1 5 d f 0 0.8 0.2 c 862 1415 m 21 9 d -16
- -50 d -2 1 d -12 59 d f 0 0.8 0 c 862 1415 m 24 20 d -3 -11 d -30 10 d -11 51 d
- f 0 0.8 0.2 c 839 1396 m 23 19 d -30 X f 0 0.8 0 c 862 1415 m -20 70 d -23 -33
- d 13 -37 d f 0 0.8 0.4 c 815 1296 m 12 48 d -23 6 d f 0 0.8 0.2 c 827 1344 m 12
- 52 d -7 19 d -25 7 d -12 -30 d 9 -42 d f 0 0.8 0 c 832 1415 m -13 37 d -12 -30
- d f 0 0.8 0.8 c 792 1196 m 4 16 d -6 1 d f 0 0.8 0.6 c 796 1212 m 15 66 d -31 4
- d 10 -69 d f 0 0.8 0.4 c 811 1278 m 4 18 d -11 54 d -29 2 d -3 -6 d 8 -64 d f 0
- 0.8 0.2 c 804 1350 m -9 42 d -20 -40 d f 0 0.8 0.8 c 789 1210 m 3 -14 d -2 17 d
- f 0 0.8 0.6 c 775 1269 m 14 -59 d 1 3 d -10 69 d f 0 0.8 0.4 c 769 1297 m 6 -28
- d 5 13 d -8 64 d -1 5 d -7 -19 d f 0 0.8 0.2 c 771 1351 m -11 59 d -3 -9 d 7
- -69 d f 0 0.8 0 c 760 1410 m -11 59 d 8 -68 d f 0.2 0.8 0 c 749 1469 m -1 5 d 1
- -5 d f 0 0.6 0.8 c 745 1117 m 3 21 d -5 X f 0 0.8 0.8 c 748 1138 m 8 64 d -18 2
- d 5 -66 d f 0 0.8 0.6 c 756 1202 m 8 64 d -30 4 d 4 -66 d f 0 0.8 0.4 c 764
- 1266 m 5 31 d -5 35 d -35 4 d 5 -66 d f 0 0.8 0.2 c 764 1332 m -7 69 d -28 1 d
- -4 -14 d 4 -52 d f 0 0.8 0 c 757 1401 m -8 68 d -2 X -18 -67 d f 0.2 0.8 0 c
- 749 1469 m -1 5 d -1 -5 d f 0 0 0.8 c 722 882 m 6 64 d -24 15 d -3 -63 d f 0
- 0.2 0.8 c 728 946 m 6 64 d -27 14 d -3 -63 d f 0 0.4 0.8 c 734 1010 m 7 64 d
- -31 13 d -3 -63 d f 0 0.6 0.8 c 741 1074 m 4 43 d -2 21 d -30 12 d -3 -63 d f 0
- 0.8 0.8 c 743 1138 m -5 66 d -22 8 d -3 -62 d f 0 0.8 0.6 c 738 1204 m -4 66 d
- -15 5 d -3 -63 d f 0 0.8 0.4 c 734 1270 m -5 66 d -7 2 d -3 -63 d f 0 0.8 0.2 c
- 729 1336 m -4 52 d -3 -50 d f 0 0 0.8 c 698 876 m 24 6 d -21 16 d -23 -6 d f
- 675 870 m 23 6 d -20 16 d -24 -6 d f 651 864 m 24 6 d -21 16 d -23 -6 d f 1752
- 1124 m 23 6 d -20 15 d -23 -6 d f 1728 1118 m 24 6 d -20 15 d -24 -5 d f 1705
- 1112 m 23 6 d -20 16 d -23 -6 d f 1700 1173 m 5 -61 d -20 16 d -4 61 d f 0 0.2
- 0.8 c 1695 1234 m 5 -61 d -19 16 d -4 61 d f 0 0.4 0.8 c 1690 1295 m 5 -61 d
- -18 16 d -3 61 d f 0 0.6 0.8 c 1685 1356 m 5 -61 d -16 16 d -4 61 d f 0 0.8 0.8
- c 1681 1402 m 4 -46 d -15 16 d -4 62 d 13 -15 d f 0 0.8 0.6 c 1666 1434 m -3 61
- d 4 -5 d 12 -71 d f 0 0.8 0.4 c 1663 1495 m -2 30 d 6 -35 d f 0 0.8 0.8 c 1675
- 1415 m 6 -13 d -2 17 d -41 7 d -1 Y 1 Y f 0 0.8 0.6 c 1658 1449 m 17 -34 d 4 4
- d -12 71 d -13 2 d -16 -66 d f 0 0.8 0.4 c 1667 1490 m -6 35 d -7 -33 d f 0 0.8
- 0.8 c 1638 1426 m -1 Y -24 -6 d 3 -1 d f 0 0.8 0.6 c 1634 1417 m 24 32 d -20
- -23 d -21 -8 d f 0 0.4 0.8 c 1611 1263 m 2 12 d -3 X f 0 0.6 0.8 c 1613 1275 m
- 10 65 d -19 2 d 6 -67 d f 0 0.8 0.8 c 1623 1340 m 10 64 d -16 14 d -3 1 d 1 Y
- -17 -11 d 7 -67 d f 0 0.8 0.6 c 1633 1404 m 1 13 d -17 1 d -3 2 d -22 57 d -1
- -1 d 6 -67 d f 0 0.8 0.4 c 1592 1477 m -1 3 d -4 Y f 0 0.4 0.8 c 1609 1274 m 2
- -11 d -1 12 d f 0 0.6 0.8 c 1597 1333 m 12 -59 d 1 1 d -6 67 d f 0 0.8 0.8 c
- 1587 1378 m 10 -45 d 7 9 d -7 67 d -14 -13 d f 0 0.8 0.6 c 1597 1409 m -6 67 d
- -6 -1 d -18 -15 d 16 -64 d f 0 0.8 0.4 c 1591 1476 m 4 Y -6 -5 d f 0 0.6 0.8 c
- 1564 1318 m 3 7 d -4 1 d f 0 0.8 0.8 c 1567 1325 m 20 53 d -4 18 d -34 2 d 14
- -72 d f 0 0.8 0.6 c 1583 1396 m -16 64 d -23 -32 d 5 -30 d f 0 0.6 0.8 c 1540
- 1272 m 24 46 d -1 8 d -28 -3 d f 0 0.8 0.8 c 1563 1326 m -14 72 d -21 -7 d 7
- -68 d f 0 0.8 0.6 c 1549 1398 m -5 30 d -22 31 d -1 -1 d 7 -67 d f 0 0.8 0.4 c
- 1522 1459 m -2 3 d 1 -4 d f 0 0.6 0.8 c 1517 1266 m 23 6 d -5 51 d -25 -5 d f 0
- 0.8 0.8 c 1535 1323 m -7 68 d -28 -4 d 10 -69 d f 0 0.8 0.6 c 1528 1391 m -7 67
- d -3 X -21 -42 d 3 -29 d f 0 0.8 0.4 c 1521 1458 m -1 4 d -2 -4 d f 0 0.6 0.8 c
- 1509 1311 m 8 -45 d -7 52 d f 0 0.8 0.8 c 1498 1370 m 11 -59 d 1 7 d -10 69 d f
- 0 0.8 0.6 c 1494 1394 m 4 -24 d 2 17 d -3 29 d -22 31 d -2 Y f 0 0.8 0.4 c 1475
- 1447 m -2 3 d 2 -5 d f 0 0.8 0.8 c 1470 1361 m 1 2 d -12 18 d -9 -45 d f 0 0.8
- 0.6 c 1471 1363 m 23 31 d -19 51 d -3 1 d -13 -65 d f 0 0.8 0.4 c 1475 1445 m
- -2 5 d -1 -4 d f 0 0.8 0.8 c 1469 1363 m 1 -2 d -20 -25 d -15 39 d f 0 0.8 0.6
- c 1447 1396 m 22 -33 d -34 12 d -9 23 d f 0 0.8 0.8 c 1423 1296 m 14 58 d -33
- 13 d -1 -2 d f 0 0.8 0.6 c 1437 1354 m 10 42 d -21 2 d -22 -31 d f 0 0.8 0.8 c
- 1409 1347 m 14 -51 d -20 69 d -1 1 d f 0 0.8 0.6 c 1400 1384 m 9 -37 d -7 19 d
- -23 47 d f 0 0.8 0.8 c 1376 1324 m 7 17 d -10 X f 0 0.8 0.6 c 1383 1341 m 17 43
- d -21 29 d -9 7 d -11 -6 d 14 -73 d f 0 0.8 0.4 c 1370 1420 m -14 13 d 3 -19 d
- f 0 0.6 0.8 c 1353 1264 m 3 8 d -4 X f 0 0.8 0.8 c 1356 1272 m 20 52 d -3 17 d
- -29 -1 d 8 -68 d f 0 0.8 0.6 c 1373 1341 m -14 73 d -23 -6 d 8 -68 d f 0 0.8
- 0.4 c 1359 1414 m -3 19 d -24 8 d 4 -33 d f 0 0.6 0.8 c 1351 1271 m 2 -7 d -1 8
- d f 0 0.8 0.8 c 1338 1329 m 13 -58 d 1 1 d -8 68 d f 0 0.8 0.6 c 1329 1366 m 9
- -37 d 6 11 d -8 68 d -19 -10 d f 0 0.8 0.4 c 1336 1408 m -4 33 d -23 -19 d 8
- -24 d f 0 0.6 0.8 c 1306 1252 m 1 7 d -3 1 d f 0 0.8 0.8 c 1307 1259 m 14 66 d
- -30 7 d 13 -72 d f 0 0.8 0.6 c 1321 1325 m 8 41 d -12 32 d -16 5 d -16 -41 d 6
- -30 d f 0 0.8 0.4 c 1317 1398 m -8 24 d -8 -19 d f 0 0.6 0.8 c 1303 1258 m 3 -6
- d -2 8 d f 0 0.8 0.8 c 1282 1300 m 21 -42 d 1 2 d -13 72 d -28 -1 d -1 -2 d f 0
- 0.8 0.6 c 1291 1332 m -6 30 d -22 -31 d f 0 0.8 0.8 c 1259 1254 m 23 46 d -20
- 29 d -24 -46 d f 1235 1248 m 24 6 d -21 29 d -8 40 d -3 -13 d f 0 0.8 0.6 c
- 1230 1323 m -12 59 d -1 -3 d 10 -69 d f 0 0.8 0.4 c 1218 1382 m -3 16 d 2 -19 d
- f 0 0.8 0.8 c 1228 1301 m 7 -53 d -8 62 d f 0 0.8 0.6 c 1220 1362 m 8 -61 d -1
- 9 d -10 69 d f 0 0.8 0.4 c 1213 1422 m 7 -60 d -3 17 d -2 19 d -20 40 d f 0 0.8
- 0.2 c 1212 1430 m 1 -8 d -18 16 d -4 7 d f 0 0.8 0.8 c 1188 1289 m 2 Y f 0 0.8
- 0.6 c 1188 1291 m 11 65 d -25 8 d 14 -73 d f 0 0.8 0.4 c 1199 1356 m 11 65 d
- -24 15 d -18 -37 d 6 -35 d f 0 0.8 0.2 c 1210 1421 m 2 9 d -21 15 d -5 -9 d f 0
- 0.8 0.8 c 1165 1243 m 23 46 d 2 Y -34 2 d f 0 0.8 0.6 c 1188 1291 m -14 73 d
- -19 1 d -11 -26 d 10 -46 d f 0 0.8 0.4 c 1174 1364 m -6 35 d -13 -34 d f 0 0.6
- 0.8 c 1141 1210 m 6 9 d -7 -1 d f 0 0.8 0.8 c 1147 1219 m 18 24 d -11 50 d -24
- -5 d 10 -70 d f 0 0.8 0.6 c 1154 1293 m -10 46 d -23 8 d 9 -59 d f 0 0.6 0.8 c
- 1135 1216 m 6 -6 d -1 8 d f 0 0.8 0.8 c 1118 1231 m 17 -15 d 5 2 d -10 70 d -19
- -9 d f 0 0.8 0.6 c 1130 1288 m -9 59 d -9 8 d -12 -6 d 11 -70 d f 0 0.8 0.4 c
- 1112 1355 m -15 13 d 3 -19 d f 0 0.6 0.8 c 1094 1145 m 18 65 d -24 X f 0 0.8
- 0.8 c 1112 1210 m 6 21 d -7 48 d -30 -2 d 7 -67 d f 0 0.8 0.6 c 1111 1279 m -11
- 70 d -26 -4 d 7 -68 d f 0 0.8 0.4 c 1100 1349 m -3 19 d -23 -20 d -3 Y f 0 0.6
- 0.8 c 1085 1203 m 9 -58 d -6 65 d f 0 0.8 0.8 c 1075 1262 m 10 -59 d 3 7 d -7
- 67 d f 0 0.8 0.6 c 1071 1286 m 4 -24 d 6 15 d -7 68 d -6 -2 d -18 -14 d f 0 0.8
- 0.4 c 1074 1345 m 3 Y -6 -5 d f 0 0.8 0.6 c 1060 1321 m 11 -35 d -21 43 d -8 8
- d f 0 0.8 0.4 c 1047 1361 m 13 -40 d -18 16 d -15 13 d f 0 0.8 0.8 c 1024 1234
- m 3 16 d -5 1 d f 0 0.8 0.6 c 1027 1250 m 12 65 d -26 5 d 9 -69 d f 0 0.8 0.4 c
- 1039 1315 m 8 46 d -20 -11 d -20 40 d -2 -2 d 8 -68 d f 0 0.8 0.2 c 1007 1390 m
- -4 8 d 2 -10 d f 0 0.8 0.8 c 1000 1201 m 24 33 d -2 17 d -28 -3 d f 0 0.8 0.6 c
- 1022 1251 m -9 69 d -29 -2 d 10 -70 d f 0 0.8 0.4 c 1013 1320 m -8 68 d -6 X
- -19 -37 d 4 -33 d f 0 0.8 0.2 c 1005 1388 m -2 10 d -4 -10 d f 0 0.8 0.8 c 977
- 1222 m 23 -21 d -6 47 d -19 -9 d f 0 0.8 0.6 c 994 1248 m -10 70 d -16 -12 d 7
- -67 d f 0 0.8 0.4 c 984 1318 m -4 33 d -11 29 d -8 -6 d 7 -68 d f 0 0.8 0.2 c
- 969 1380 m -13 32 d 5 -38 d f 0 0.6 0.8 c 953 1149 m 7 22 d -9 X f 0 0.8 0.8 c
- 960 1171 m 17 51 d -2 17 d -32 X 8 -68 d f 0 0.8 0.6 c 975 1239 m -7 67 d -33 1
- d 8 -68 d f 0 0.8 0.4 c 968 1306 m -7 68 d -15 1 d -13 -49 d 2 -19 d f 0 0.8
- 0.2 c 961 1374 m -5 38 d -10 -37 d f 0 0.6 0.8 c 942 1166 m 11 -17 d -2 22 d f
- 0 0.8 0.8 c 930 1183 m 12 -17 d 9 5 d -8 68 d -27 4 d -7 -31 d f 0 0.8 0.6 c
- 943 1239 m -8 68 d -6 1 d -13 -65 d f 0 0.8 0.4 c 935 1307 m -2 19 d -4 -18 d f
- 0 0.8 0.8 c 915 1222 m 15 -39 d -21 29 d -2 28 d f 0 0.8 0.6 c 906 1245 m 9 -23
- d -8 18 d -7 61 d 2 -16 d f 0 0.8 0.4 c 900 1301 m -6 60 d 1 -8 d 7 -68 d f 0
- 0.8 0.2 c 894 1361 m -7 61 d 1 -2 d 7 -67 d f 0 0.8 0 c 887 1422 m -1 13 d 2
- -15 d f 0 0.8 0.8 c 883 1171 m 14 46 d -18 -1 d f 0 0.8 0.6 c 897 1217 m 9 28 d
- -4 40 d -28 -2 d 5 -67 d f 0 0.8 0.4 c 902 1285 m -7 68 d -27 -4 d 6 -66 d f 0
- 0.8 0.2 c 895 1353 m -7 67 d -26 -5 d 6 -66 d f 0 0.8 0 c 888 1420 m -2 15 d
- -24 -20 d f 0 0.8 0.8 c 859 1192 m 24 -21 d -4 45 d -21 -7 d f 0 0.8 0.6 c 879
- 1216 m -5 67 d -23 -7 d 7 -67 d f 0 0.8 0.4 c 874 1283 m -6 66 d -24 -6 d 7 -67
- d f 0 0.8 0.2 c 868 1349 m -6 66 d -23 -19 d 5 -53 d f 0 0.4 0.8 c 836 1065 m 2
- 13 d -3 X f 0 0.6 0.8 c 838 1078 m 12 65 d -21 2 d 6 -67 d f 0 0.8 0.8 c 850
- 1143 m 9 49 d -1 17 d -35 2 d 6 -66 d f 0 0.8 0.6 c 858 1209 m -7 67 d -34 2 d
- 6 -67 d f 0 0.8 0.4 c 851 1276 m -7 67 d -17 1 d -12 -48 d 2 -18 d f 0 0.8 0.2
- c 844 1343 m -5 53 d -12 -52 d f 0 0.4 0.8 c 831 1076 m 5 -11 d -1 13 d f 0 0.6
- 0.8 c 812 1113 m 19 -37 d 4 2 d -6 67 d -23 -7 d f 0 0.8 0.8 c 829 1145 m -6 66
- d -27 1 d -4 -16 d 14 -58 d f 0 0.8 0.6 c 823 1211 m -6 67 d -6 X -15 -66 d f 0
- 0.8 0.4 c 817 1278 m -2 18 d -4 -18 d f 0 0.6 0.8 c 806 1132 m 6 -19 d -6 25 d
- f 0 0.8 0.8 c 789 1188 m 17 -56 d 6 Y -14 58 d -3 14 d -1 -20 d f 0 0.8 0.6 c
- 789 1210 m -14 59 d -7 Y 13 -72 d f 0 0.8 0.4 c 775 1269 m -6 28 d 6 -35 d f 0
- 0.6 0.8 c 748 1138 m -3 -21 d 3 18 d f 0 0.8 0.8 c 788 1189 m 1 -1 d -1 2 d -32
- 12 d -8 -64 d -3 Y 9 55 d f 0 0.8 0.6 c 765 1236 m 23 -47 d 1 Y -13 72 d -11 4
- d -8 -64 d 1 -12 d f 0 0.8 0.4 c 775 1262 m -6 35 d -5 -31 d f 0 0 0.8 c 742
- 867 m 4 63 d -18 16 d -6 -64 d f 0 0.2 0.8 c 746 930 m 4 63 d -16 17 d -6 -64 d
- f 0 0.4 0.8 c 750 993 m 4 63 d -13 18 d -7 -64 d f 0 0.6 0.8 c 754 1056 m 4 64
- d -10 15 d -3 -18 d -4 -43 d f 0 0.8 0.8 c 758 1120 m 4 63 d -5 7 d -9 -55 d f
- 0 0.8 0.6 c 762 1183 m 3 53 d -8 -46 d f 0 0 0.8 c 718 861 m 24 6 d -20 15 d
- -24 -6 d f 695 855 m 23 6 d -20 15 d -23 -6 d f 671 849 m 24 6 d -20 15 d -24
- -6 d f 1772 1108 m 24 6 d -21 16 d -23 -6 d f 1749 1102 m 23 6 d -20 16 d -24
- -6 d f 1725 1096 m 24 6 d -21 16 d -23 -6 d f 1718 1157 m 7 -61 d -20 16 d -5
- 61 d f 0 0.2 0.8 c 1711 1217 m 7 -60 d -18 16 d -5 61 d f 0 0.4 0.8 c 1704 1277
- m 7 -60 d -16 17 d -5 61 d f 0 0.6 0.8 c 1702 1292 m 2 -15 d -14 18 d -5 61 d 7
- -9 d f 0 0.8 0.8 c 1685 1356 m -4 46 d 11 -55 d f 0 0.6 0.8 c 1678 1273 m 24 19
- d -10 55 d -21 -8 d f 0 0.8 0.8 c 1692 1347 m -11 55 d -6 13 d -12 -8 d 8 -68 d
- f 0 0.8 0.6 c 1675 1415 m -17 34 d 5 -42 d f 0 0.6 0.8 c 1655 1307 m 23 -34 d
- -7 66 d -21 -9 d f 0 0.8 0.8 c 1671 1339 m -8 68 d -26 -4 d 13 -73 d f 0 0.8
- 0.6 c 1663 1407 m -5 42 d -24 -32 d 3 -14 d f 0 0.4 0.8 c 1613 1275 m -2 -12 d
- 18 -2 d f 0 0.6 0.8 c 1631 1261 m 24 46 d -5 23 d -27 10 d -10 -65 d 16 -14 d f
- 0 0.8 0.8 c 1650 1330 m -13 73 d -4 1 d -10 -64 d f 0 0.8 0.6 c 1637 1403 m -3
- 14 d -1 -13 d f 0 0.4 0.8 c 1629 1261 m -18 2 d -2 11 d f 0 0.6 0.8 c 1608 1308
- m 23 -47 d -2 X -20 13 d -12 59 d 8 -16 d f 0 0.8 0.8 c 1597 1333 m -10 45 d 18
- -61 d f 0 0.6 0.8 c 1605 1314 m 3 -6 d -3 9 d -38 8 d -3 -7 d 3 5 d f 0 0.8 0.8
- c 1584 1356 m 21 -42 d 3 Y -18 61 d -20 -53 d -2 Y f 0 0.6 0.8 c 1567 1323 m -3
- -5 d -24 -46 d 12 38 d f 0 0.8 0.8 c 1561 1337 m 23 19 d -17 -33 d -15 -13 d f
- 0 0.6 0.8 c 1537 1290 m 4 8 d 11 12 d -12 -38 d -23 -6 d f 0 0.8 0.8 c 1541
- 1298 m 20 39 d -9 -27 d f 0 0.4 0.8 c 1514 1217 m 4 13 d -6 X f 0 0.6 0.8 c
- 1518 1230 m 19 60 d -20 -24 d -8 45 d -4 -13 d 7 -68 d f 0 0.8 0.8 c 1509 1311
- m -11 59 d -1 -4 d 8 -68 d f 0 0.8 0.6 c 1498 1370 m -4 24 d 3 -28 d f 0 0.4
- 0.8 c 1490 1198 m 24 19 d -2 13 d -25 -4 d f 0 0.6 0.8 c 1512 1230 m -7 68 d
- -27 -4 d 9 -68 d f 0 0.8 0.8 c 1505 1298 m -8 68 d -26 -3 d -1 -2 d 8 -67 d f 0
- 0.8 0.6 c 1497 1366 m -3 28 d -23 -31 d f 0 0.4 0.8 c 1479 1220 m 11 -22 d -3
- 28 d f 0 0.6 0.8 c 1467 1246 m 12 -26 d 8 6 d -9 68 d -16 -11 d f 0 0.8 0.8 c
- 1478 1294 m -8 67 d -1 2 d -17 -11 d 10 -69 d f 0 0.8 0.6 c 1469 1363 m -22 33
- d 5 -44 d f 0 0.6 0.8 c 1443 1226 m 24 20 d -5 37 d -36 4 d f 0 0.8 0.8 c 1462
- 1283 m -10 69 d -15 2 d -14 -58 d 3 -9 d f 0 0.8 0.6 c 1452 1352 m -5 44 d -10
- -42 d f 0 0.6 0.8 c 1420 1247 m 23 -21 d -17 61 d -9 -17 d f 0 0.8 0.8 c 1426
- 1287 m -3 9 d -14 51 d -3 -7 d 11 -70 d f 0 0.8 0.6 c 1409 1347 m -9 37 d 6 -44
- d f 0 0.6 0.8 c 1396 1214 m 24 33 d -3 23 d -31 -1 d f 0 0.8 0.8 c 1417 1270 m
- -11 70 d -23 1 d -7 -17 d 10 -55 d f 0 0.8 0.6 c 1406 1340 m -6 44 d -17 -43 d
- f 0 0.6 0.8 c 1373 1195 m 23 19 d -10 55 d -30 3 d -3 -8 d f 0 0.8 0.8 c 1386
- 1269 m -10 55 d -20 -52 d f 0 0.6 0.8 c 1349 1229 m 24 -34 d -20 69 d -2 7 d -5
- -19 d f 0 0.8 0.8 c 1351 1271 m -13 58 d -2 -7 d 10 -70 d f 0 0.8 0.6 c 1338
- 1329 m -9 37 d 7 -44 d f 0 0.6 0.8 c 1326 1196 m 23 33 d -3 23 d -39 7 d -1 -7
- d f 0 0.8 0.8 c 1346 1252 m -10 70 d -15 3 d -14 -66 d f 0 0.8 0.6 c 1336 1322
- m -7 44 d -8 -41 d f 0 0.6 0.8 c 1310 1239 m 16 -43 d -20 56 d -3 6 d f 0 0.8
- 0.8 c 1302 1258 m 8 -19 d -7 19 d -21 42 d f 0 0.6 0.8 c 1279 1184 m 16 52 d
- -34 9 d f 0 0.8 0.8 c 1295 1236 m 7 22 d -20 42 d -23 -46 d 2 -9 d f 0 0.6 0.8
- c 1255 1192 m 24 -8 d -18 61 d -22 -7 d f 0 0.8 0.8 c 1261 1245 m -2 9 d -24 -6
- d 4 -10 d f 0 0.4 0.8 c 1232 1146 m 7 13 d -8 -1 d f 0 0.6 0.8 c 1239 1159 m 16
- 33 d -16 46 d -13 -14 d 5 -66 d f 0 0.8 0.8 c 1239 1238 m -4 10 d -7 53 d -6
- -12 d 4 -65 d f 0 0.8 0.6 c 1228 1301 m -8 61 d -3 -7 d 5 -66 d f 0 0.8 0.4 c
- 1220 1362 m -7 60 d -1 -1 d 5 -66 d f 0 0.8 0.2 c 1213 1422 m -1 8 d -9 Y f 0
- 0.4 0.8 c 1209 1126 m 23 20 d -1 12 d -26 -4 d f 0 0.6 0.8 c 1231 1158 m -5 66
- d -30 -1 d 9 -69 d f 0 0.8 0.8 c 1226 1224 m -4 65 d -34 2 d -2 Y 8 -66 d f 0
- 0.8 0.6 c 1222 1289 m -5 66 d -18 1 d -11 -65 d f 0 0.8 0.4 c 1217 1355 m -5 66
- d -2 X -11 -65 d f 0 0.8 0.2 c 1212 1421 m 9 Y -2 -9 d f 0 0.4 0.8 c 1185 1134
- m 24 -8 d -4 28 d -23 -7 d f 0 0.6 0.8 c 1205 1154 m -9 69 d -27 -3 d 13 -73 d
- f 0 0.8 0.8 c 1196 1223 m -8 66 d -23 -46 d 4 -23 d f 0 0.4 0.8 c 1162 1114 m
- 23 20 d -3 13 d -27 -3 d f 0 0.6 0.8 c 1182 1147 m -13 73 d -22 -1 d -6 -9 d 14
- -66 d f 0 0.8 0.8 c 1169 1220 m -4 23 d -18 -24 d f 0 0.4 0.8 c 1156 1138 m 6
- -24 d -7 30 d f 0 0.6 0.8 c 1142 1197 m 14 -59 d -1 6 d -14 66 d -6 6 d f 0 0.8
- 0.8 c 1138 1216 m 4 -19 d -7 19 d -17 15 d f 0 0.6 0.8 c 1115 1143 m 16 51 d
- -19 16 d -18 -65 d f 0 0.8 0.8 c 1131 1194 m 7 22 d -20 15 d -6 -21 d f 0 0.2
- 0.8 c 1091 1056 m 1 4 d -1 X f 0 0.4 0.8 c 1092 1060 m 18 66 d -25 X 6 -66 d f
- 0 0.6 0.8 c 1110 1126 m 5 17 d -21 2 d -9 58 d -6 -10 d 6 -67 d f 0 0.8 0.8 c
- 1085 1203 m -10 59 d -2 -3 d 6 -66 d f 0 0.8 0.6 c 1075 1262 m -4 24 d 2 -27 d
- f 0 0.2 0.8 c 1088 1059 m 3 -3 d 4 Y f 0 0.4 0.8 c 1068 1077 m 20 -18 d 3 1 d
- -6 66 d -20 -8 d f 0 0.6 0.8 c 1085 1126 m -6 67 d -19 -10 d 5 -65 d f 0 0.8
- 0.8 c 1079 1193 m -6 66 d -18 -10 d 5 -66 d f 0 0.8 0.6 c 1073 1259 m -2 27 d
- -11 35 d -9 -6 d 4 -66 d f 0 0.8 0.4 c 1060 1321 m -13 40 d 4 -46 d f 0 0.4 0.8
- c 1054 1112 m 14 -35 d -3 41 d f 0 0.6 0.8 c 1044 1138 m 10 -26 d 11 6 d -5 65
- d -24 -5 d f 0 0.8 0.8 c 1060 1183 m -5 66 d -28 1 d -3 -16 d 12 -56 d f 0 0.8
- 0.6 c 1055 1249 m -4 66 d -12 X -12 -65 d f 0 0.8 0.4 c 1051 1315 m -4 46 d -8
- -46 d f 0 0.4 0.8 c 1021 1065 m 13 42 d -20 1 d f 0 0.6 0.8 c 1034 1107 m 10 31
- d -8 40 d -32 1 d 10 -71 d f 0 0.8 0.8 c 1036 1178 m -12 56 d -24 -33 d 4 -22 d
- f 0 0.4 0.8 c 998 1098 m 23 -33 d -7 43 d f 0 0.6 0.8 c 997 1099 m 1 -1 d 16 10
- d -10 71 d -18 -11 d f 0 0.8 0.8 c 1004 1179 m -4 22 d -23 21 d 9 -54 d f 0 0.6
- 0.8 c 974 1107 m 23 -8 d -11 69 d -26 3 d -7 -22 d f 0 0.8 0.8 c 986 1168 m -9
- 54 d -17 -51 d f 0 0.6 0.8 c 953 1148 m 21 -41 d -21 42 d -11 17 d f 0 0.8 0.8
- c 950 1154 m 3 -6 d -11 18 d -12 17 d f 0 0.4 0.8 c 927 1028 m 10 54 d -16 2 d
- f 0 0.6 0.8 c 937 1082 m 12 65 d -34 4 d 6 -67 d f 0 0.8 0.8 c 949 1147 m 1 7 d
- -20 29 d -15 39 d -6 -5 d 6 -66 d f 0 0.8 0.6 c 915 1222 m -9 23 d 3 -28 d f 0
- 0.4 0.8 c 917 1077 m 10 -49 d -6 56 d f 0 0.6 0.8 c 904 1136 m 13 -59 d 4 7 d
- -6 67 d f 0 0.8 0.8 c 903 1142 m 1 -6 d 11 15 d -6 66 d -12 X -14 -46 d f 0 0.8
- 0.6 c 909 1217 m -3 28 d -9 -28 d f 0 0.6 0.8 c 880 1069 m 21 66 d -33 4 d f 0
- 0.8 0.8 c 901 1135 m 2 7 d -20 29 d -24 21 d 9 -53 d f 0 0.4 0.8 c 838 1078 m
- -2 -13 d 3 9 d f 0 0.6 0.8 c 856 1117 m 24 -48 d -12 70 d -18 4 d -12 -65 d 1
- -4 d f 0 0.8 0.8 c 868 1139 m -9 53 d -9 -49 d f 0 0.4 0.8 c 833 1017 m 9 41 d
- -3 16 d -3 -9 d -5 11 d -8 -13 d f 0 0.6 0.8 c 842 1058 m 14 59 d -17 -43 d -8
- 2 d -19 37 d 11 -50 d f 0 0.4 0.8 c 816 1051 m 17 -34 d -10 46 d f 0 0.6 0.8 c
- 809 1065 m 7 -14 d 7 12 d -11 50 d -6 19 d -6 -13 d f 0 0.8 0.8 c 806 1132 m
- -17 56 d 11 -69 d f 0 0.6 0.8 c 793 1108 m 16 -43 d -9 54 d f 0 0.8 0.8 c 786
- 1126 m 7 -18 d 7 11 d -11 69 d -1 1 d -11 -14 d f 0 0.8 0.6 c 788 1189 m -23 47
- d 12 -61 d f 0 0 0.8 c 762 851 m 6 64 d -22 15 d -4 -63 d f 0 0.2 0.8 c 768 915
- m 5 63 d -23 15 d -4 -63 d f 0 0.4 0.8 c 773 978 m 6 64 d -25 14 d -4 -63 d f 0
- 0.6 0.8 c 779 1042 m 5 63 d -26 15 d -4 -64 d f 0 0.8 0.8 c 784 1105 m 2 21 d
- -9 49 d -15 8 d -4 -63 d f 0 0.8 0.6 c 777 1175 m -12 61 d -3 -53 d f 0 0 0.8 c
- 739 845 m 23 6 d -20 16 d -24 -6 d f 715 839 m 24 6 d -21 16 d -23 -6 d f 692
- 833 m 23 6 d -20 16 d -24 -6 d f 1793 1093 m 23 6 d -20 15 d -24 -6 d f 1769
- 1087 m 24 6 d -21 15 d -23 -6 d f 1746 1081 m 23 6 d -20 15 d -24 -6 d f 1736
- 1141 m 10 -60 d -21 15 d -7 61 d f 0 0.2 0.8 c 1726 1200 m 10 -59 d -18 16 d -7
- 60 d f 0 0.4 0.8 c 1722 1223 m 4 -23 d -15 17 d -7 60 d 3 -4 d f 0 0.6 0.8 c
- 1704 1277 m -2 15 d 5 -19 d f 0 0.2 0.8 c 1699 1190 m 3 4 d -4 X f 0 0.4 0.8 c
- 1702 1194 m 20 29 d -15 50 d -28 -2 d 19 -77 d f 0 0.6 0.8 c 1707 1273 m -5 19
- d -24 -19 d 1 -2 d f 0 0.2 0.8 c 1675 1170 m 24 20 d -1 4 d -26 -5 d f 0 0.4
- 0.8 c 1698 1194 m -19 77 d -17 -11 d 10 -71 d f 0 0.6 0.8 c 1679 1271 m -1 2 d
- -23 34 d 7 -47 d f 0 0.2 0.8 c 1652 1165 m 23 5 d -3 19 d -25 -4 d f 0 0.4 0.8
- c 1672 1189 m -10 71 d -30 -1 d 15 -74 d f 0 0.6 0.8 c 1662 1260 m -7 47 d -24
- -46 d 1 -2 d f 0 0.2 0.8 c 1644 1179 m 8 -14 d -5 20 d f 0 0.4 0.8 c 1628 1212
- m 16 -33 d 3 6 d -15 74 d -10 -17 d f 0 0.6 0.8 c 1632 1259 m -1 2 d -23 47 d
- 14 -66 d f 0 0.4 0.8 c 1613 1234 m 15 -22 d -6 30 d f 0 0.6 0.8 c 1605 1247 m 8
- -13 d 9 8 d -14 66 d -3 6 d -11 -13 d f 0 0.8 0.8 c 1605 1314 m -21 42 d 10 -55
- d f 0 0.2 0.8 c 1581 1133 m 7 32 d -10 1 d f 0 0.4 0.8 c 1588 1165 m 13 66 d
- -30 2 d 7 -67 d f 0 0.6 0.8 c 1601 1231 m 4 16 d -11 54 d -30 -1 d 7 -67 d f 0
- 0.8 0.8 c 1594 1301 m -10 55 d -23 -19 d 3 -37 d f 0 0.2 0.8 c 1568 1160 m 13
- -27 d -3 33 d f 0 0.4 0.8 c 1558 1181 m 10 -21 d 10 6 d -7 67 d -22 -7 d f 0
- 0.6 0.8 c 1571 1233 m -7 67 d -23 -2 d -4 -8 d 12 -64 d f 0 0.8 0.8 c 1564 1300
- m -3 37 d -20 -39 d f 0 0.4 0.8 c 1534 1161 m 24 20 d -9 45 d -31 4 d -4 -13 d
- f 0 0.6 0.8 c 1549 1226 m -12 64 d -19 -60 d f 0 0.2 0.8 c 1511 1129 m 14 20 d
- -21 1 d f 0 0.4 0.8 c 1525 1149 m 9 12 d -20 56 d -24 -19 d 14 -48 d f 0 0.2
- 0.8 c 1487 1136 m 24 -7 d -7 21 d -18 -10 d f 0 0.4 0.8 c 1504 1150 m -14 48 d
- -11 22 d -6 -8 d 13 -72 d f 0 0.6 0.8 c 1479 1220 m -12 26 d 6 -34 d f 0 0.2
- 0.8 c 1484 1139 m 3 -3 d -1 4 d f 0 0.4 0.8 c 1464 1157 m 20 -18 d 2 1 d -13 72
- d -24 -5 d f 0 0.6 0.8 c 1473 1212 m -6 34 d -24 -20 d 6 -19 d f 0 0 0.8 c 1440
- 1057 m 2 9 d -3 X f 0 0.2 0.8 c 1442 1066 m 16 66 d -26 2 d 7 -68 d f 0 0.4 0.8
- c 1458 1132 m 6 25 d -15 50 d -24 -6 d 7 -67 d f 0 0.6 0.8 c 1449 1207 m -6 19
- d -23 21 d 5 -46 d f 0 0 0.8 c 1433 1063 m 7 -6 d -1 9 d f 0 0.2 0.8 c 1417
- 1078 m 16 -15 d 6 3 d -7 68 d -23 -7 d f 0 0.4 0.8 c 1432 1134 m -7 67 d -26 -4
- d 10 -70 d f 0 0.6 0.8 c 1425 1201 m -5 46 d -24 -33 d 3 -17 d f 0 0.2 0.8 c
- 1393 1099 m 24 -21 d -8 49 d -20 -8 d f 0 0.4 0.8 c 1409 1127 m -10 70 d -26 -4
- d 16 -74 d f 0 0.6 0.8 c 1399 1197 m -3 17 d -23 -19 d -2 Y f 0 0 0.8 c 1370
- 1039 m 3 9 d -4 X f 0 0.2 0.8 c 1373 1048 m 20 51 d -4 20 d -27 -3 d 7 -68 d f
- 0 0.4 0.8 c 1389 1119 m -16 74 d -19 -10 d 8 -67 d f 0 0.6 0.8 c 1373 1193 m 2
- Y -24 34 d 5 -46 d f 0 0 0.8 c 1365 1046 m 5 -7 d -1 9 d f 0 0.2 0.8 c 1346
- 1073 m 19 -27 d 4 2 d -7 68 d -21 -8 d f 0 0.4 0.8 c 1362 1116 m -8 67 d -25 -4
- d 12 -71 d f 0 0.6 0.8 c 1354 1183 m -5 46 d -23 -33 d 3 -17 d f 0 0.2 0.8 c
- 1323 1067 m 23 6 d -5 35 d -22 -8 d f 0 0.4 0.8 c 1341 1108 m -12 71 d -17 -11
- d 7 -68 d f 0 0.6 0.8 c 1329 1179 m -3 17 d -16 43 d -5 -3 d 7 -68 d f 0 0.8
- 0.8 c 1310 1239 m -8 19 d 3 -22 d f 0 0.2 0.8 c 1305 1093 m 18 -26 d -4 33 d f
- 0 0.4 0.8 c 1299 1102 m 6 -9 d 14 7 d -7 68 d -28 -2 d f 0 0.6 0.8 c 1312 1168
- m -7 68 d -10 X -16 -52 d 5 -18 d f 0 0.8 0.8 c 1305 1236 m -3 22 d -7 -22 d f
- 0 0.4 0.8 c 1286 1150 m 13 -48 d -15 64 d f 0 0.6 0.8 c 1276 1190 m 10 -40 d -2
- 16 d -5 18 d -24 8 d f 0 0.4 0.8 c 1252 1117 m 9 27 d -22 15 d -7 -13 d f 0 0.6
- 0.8 c 1261 1144 m 15 46 d -21 2 d -16 -33 d f 0 0.2 0.8 c 1229 1043 m 10 33 d
- -19 5 d f 0 0.4 0.8 c 1239 1076 m 13 41 d -20 29 d -23 -20 d 11 -45 d f 0 0.2
- 0.8 c 1205 1037 m 24 6 d -9 38 d -22 -7 d f 0 0.4 0.8 c 1220 1081 m -11 45 d
- -24 8 d 13 -60 d f 0 0.2 0.8 c 1195 1065 m 10 -28 d -7 37 d f 0 0.4 0.8 c 1182
- 1099 m 13 -34 d 3 9 d -13 60 d -23 -20 d f 1158 1093 m 24 6 d -20 15 d -6 24 d
- -2 -16 d f 0 0.6 0.8 c 1156 1138 m -14 59 d -4 Y 12 -71 d f 0 0.8 0.8 c 1142
- 1197 m -4 19 d 4 -23 d f 0 0.4 0.8 c 1135 1100 m 23 -7 d -4 29 d -28 -3 d f 0
- 0.6 0.8 c 1154 1122 m -12 71 d -11 1 d -16 -51 d 11 -24 d f 0 0.8 0.8 c 1142
- 1193 m -4 23 d -7 -22 d f 0 0.2 0.8 c 1092 1060 m -1 -4 d 5 -1 d f 0 0.4 0.8 c
- 1111 1054 m 24 46 d -9 19 d -16 7 d -18 -66 d 4 -5 d f 0 0.6 0.8 c 1126 1119 m
- -11 24 d -5 -17 d f 0 0.2 0.8 c 1096 1055 m -5 1 d -3 3 d f 0 0.4 0.8 c 1088
- 1048 m 23 6 d -15 1 d -8 4 d -20 18 d f 1065 1094 m 23 -46 d -20 29 d -14 35 d
- f 0 0.6 0.8 c 1064 1096 m 1 -2 d -11 18 d -10 26 d f 0 0.4 0.8 c 1041 1049 m 22
- 45 d -29 13 d -13 -42 d f 0 0.6 0.8 c 1063 1094 m 1 2 d -20 42 d -10 -31 d f 0
- 0.4 0.8 c 1024 1084 m 17 -35 d -20 16 d -23 33 d f 0 0.6 0.8 c 1017 1097 m 7
- -13 d -26 14 d -1 1 d f 0 0.2 0.8 c 994 997 m 4 18 d -8 2 d f 0 0.4 0.8 c 998
- 1015 m 16 66 d -37 8 d 13 -72 d f 0 0.6 0.8 c 1014 1081 m 3 16 d -20 2 d -23 8
- d 3 -18 d f 0 0.2 0.8 c 970 991 m 24 6 d -4 20 d -22 -7 d f 0 0.4 0.8 c 990
- 1017 m -13 72 d -17 -11 d 8 -68 d f 0 0.6 0.8 c 977 1089 m -3 18 d -21 41 d -2
- -1 d 9 -69 d f 0 0.8 0.8 c 953 1148 m -3 6 d 1 -7 d f 0 0.2 0.8 c 966 1007 m 4
- -16 d -2 19 d f 0 0.4 0.8 c 947 1064 m 19 -57 d 2 3 d -8 68 d -23 4 d -10 -54 d
- 19 37 d f 0 0.6 0.8 c 947 1066 m -2 Y 13 14 d -9 69 d -2 X -12 -65 d 9 -17 d f
- 0 0.8 0.8 c 951 1147 m -1 7 d -1 -7 d f 0 0.2 0.8 c 923 966 m 8 32 d -11 1 d f
- 0 0.4 0.8 c 931 998 m 16 66 d -1 1 d -19 -37 d -10 49 d -5 -10 d 8 -68 d f 0
- 0.6 0.8 c 947 1064 m 2 Y -1 -1 d -29 12 d -13 59 d -1 Y 8 -68 d f 0 0.8 0.8 c
- 904 1136 m -1 6 d 1 -7 d f 0 0.2 0.8 c 906 991 m 17 -25 d -3 33 d f 0 0.4 0.8 c
- 900 1000 m 6 -9 d 14 8 d -8 68 d -32 X f 0 0.6 0.8 c 912 1067 m -8 68 d -3 X
- -21 -66 d -2 Y f 0 0.8 0.8 c 904 1135 m -1 7 d -2 -7 d f 0 0.2 0.8 c 877 981 m
- 5 4 d -6 -1 d f 0 0.4 0.8 c 882 985 m 18 15 d -20 67 d -15 -12 d 11 -71 d f 0
- 0.6 0.8 c 880 1067 m 2 Y -24 48 d 9 -62 d f 0 0.2 0.8 c 853 948 m 24 33 d -1 3
- d -34 3 d f 0 0.4 0.8 c 876 984 m -11 71 d -23 3 d -9 -41 d 9 -30 d f 0 0.6 0.8
- c 865 1055 m -9 62 d -14 -59 d f 0 0 0.8 c 830 888 m 9 24 d -12 X f 0 0.2 0.8 c
- 839 912 m 14 36 d -11 39 d -23 -7 d 8 -68 d f 0 0.4 0.8 c 842 987 m -9 30 d -17
- 34 d -5 -3 d 8 -68 d f 0 0.6 0.8 c 816 1051 m -7 14 d 2 -17 d f 0 0 0.8 c 823
- 908 m 7 -20 d -3 24 d f 0 0.2 0.8 c 806 963 m 17 -55 d 4 4 d -8 68 d -13 -14 d
- f 0 0.4 0.8 c 819 980 m -8 68 d -14 -13 d 9 -69 d f 0 0.6 0.8 c 811 1048 m -2
- 17 d -16 43 d -5 -4 d 9 -69 d f 0 0.8 0.8 c 793 1108 m -7 18 d 2 -22 d f 0 0
- 0.8 c 783 836 m 12 65 d -27 14 d -6 -64 d f 0 0.2 0.8 c 795 901 m 11 62 d 3 Y
- -33 12 d -5 -63 d f 0 0.4 0.8 c 806 966 m -9 69 d -18 7 d -6 -64 d f 0 0.6 0.8
- c 797 1035 m -9 69 d -4 1 d -5 -63 d f 0 0.8 0.8 c 788 1104 m -2 22 d -2 -21 d
- f 0 0 0.8 c 759 830 m 24 6 d -21 15 d -23 -6 d f 736 824 m 23 6 d -20 15 d -24
- -6 d f 712 818 m 24 6 d -21 15 d -23 -6 d f 1813 1077 m 23 6 d -20 16 d -23 -6
- d f 1789 1071 m 24 6 d -20 16 d -24 -6 d f 1766 1065 m 23 6 d -20 16 d -23 -6 d
- f 1742 1100 m 24 -35 d -20 16 d -10 60 d 2 -16 d f 0 0.2 0.8 c 1736 1141 m -10
- 59 d 1 -4 d 11 -71 d f 0 0.4 0.8 c 1726 1200 m -4 23 d 5 -27 d f 0 0 0.8 c 1719
- 1107 m 23 -7 d -4 25 d -22 -7 d f 0 0.2 0.8 c 1738 1125 m -11 71 d -25 -2 d -3
- -4 d 17 -72 d f 0 0.4 0.8 c 1727 1196 m -5 27 d -20 -29 d f 0 0 0.8 c 1717 1115
- m 2 -8 d -3 11 d f 0 0.2 0.8 c 1705 1174 m 12 -59 d -1 3 d -17 72 d -24 -20 d 5
- 13 d f 0 0.4 0.8 c 1695 1222 m 10 -48 d -25 9 d f 0 0 0.8 c 1672 1082 m 4 23 d
- -11 4 d f 0 0.2 0.8 c 1676 1105 m 11 64 d -7 14 d -5 -13 d -23 -5 d 13 -56 d f
- 0 0.4 0.8 c 1687 1169 m 8 53 d -15 -39 d f 0 0 0.8 c 1648 1076 m 24 6 d -7 27 d
- -20 -9 d f 0 0.2 0.8 c 1665 1109 m -13 56 d -8 14 d -10 -8 d 11 -71 d f 0 0.4
- 0.8 c 1644 1179 m -16 33 d 6 -41 d f 0 0 0.8 c 1629 1093 m 19 -17 d -3 24 d f 0
- 0.2 0.8 c 1625 1097 m 4 -4 d 16 7 d -11 71 d -18 -11 d f 0 0.4 0.8 c 1634 1171
- m -6 41 d -15 22 d -6 -4 d 9 -70 d f 0 0.6 0.8 c 1613 1234 m -8 13 d 2 -17 d f
- 0 0.2 0.8 c 1602 1104 m 23 -7 d -9 63 d -28 5 d -7 -32 d f 0 0.4 0.8 c 1616
- 1160 m -9 70 d -6 1 d -13 -66 d f 0 0.6 0.8 c 1607 1230 m -2 17 d -4 -16 d f 0
- 0 0.8 c 1578 1058 m 13 25 d -17 X f 0 0.2 0.8 c 1591 1083 m 11 21 d -21 29 d
- -13 27 d -6 -6 d 12 -71 d f 0 0.4 0.8 c 1568 1160 m -10 21 d 4 -27 d f 0 0 0.8
- c 1565 1076 m 13 -18 d -4 25 d f 0 0.2 0.8 c 1555 1092 m 10 -16 d 9 7 d -12 71
- d -24 -6 d f 0 0.4 0.8 c 1562 1154 m -4 27 d -24 -20 d 4 -13 d f 0 0.2 0.8 c
- 1531 1100 m 24 -8 d -17 56 d -13 1 d -14 -20 d f 0 0.4 0.8 c 1538 1148 m -4 13
- d -9 -12 d f 0 0 0.8 c 1508 1026 m 12 39 d -20 3 d f 0 0.2 0.8 c 1520 1065 m 11
- 35 d -20 29 d -24 7 d 13 -68 d f 0 0 0.8 c 1484 1007 m 24 19 d -8 42 d -23 -7 d
- f 0 0.2 0.8 c 1500 1068 m -13 68 d -3 3 d -17 -8 d 10 -70 d f 0 0.4 0.8 c 1484
- 1139 m -20 18 d 3 -26 d f 0 0 0.8 c 1470 1052 m 14 -45 d -7 54 d -35 5 d -2 -9
- d 4 5 d f 0 0.2 0.8 c 1461 1082 m 9 -30 d 7 9 d -10 70 d -9 1 d -16 -66 d 2 -4
- d f 0 0.4 0.8 c 1467 1131 m -3 26 d -6 -25 d f 0 0 0.8 c 1444 1062 m -4 -5 d -7
- 6 d f 0 0.2 0.8 c 1437 1049 m 24 33 d -17 -20 d -11 1 d -16 15 d f 1414 1097 m
- 23 -48 d -20 29 d -24 21 d f 0 0 0.8 c 1390 1010 m 6 23 d -23 15 d -3 -9 d f 0
- 0.2 0.8 c 1396 1033 m 18 64 d -21 2 d -20 -51 d f 0 0 0.8 c 1367 1004 m 23 6 d
- -20 29 d -5 7 d -7 -14 d f 0 0.2 0.8 c 1365 1046 m -19 27 d 12 -41 d f 0 0 0.8
- c 1348 1021 m 19 -17 d -9 28 d f 0 0.2 0.8 c 1343 1025 m 5 -4 d 10 11 d -12 41
- d -23 -6 d f 1320 1059 m 23 -34 d -20 42 d -18 26 d 2 -7 d f 0 0.4 0.8 c 1305
- 1093 m -6 9 d 8 -16 d f 0 0.2 0.8 c 1296 1040 m 24 19 d -13 27 d -15 -12 d f 0
- 0.4 0.8 c 1307 1086 m -8 16 d -13 48 d -4 -7 d 10 -69 d f 0 0.6 0.8 c 1286 1150
- m -10 40 d 6 -47 d f 0 0.2 0.8 c 1273 1047 m 23 -7 d -4 34 d -26 -5 d f 0 0.4
- 0.8 c 1292 1074 m -10 69 d -21 1 d -9 -27 d 14 -48 d f 0 0.6 0.8 c 1282 1143 m
- -6 47 d -15 -46 d f 0 0 0.8 c 1249 974 m 8 24 d -16 4 d f 0 0.2 0.8 c 1257 998
- m 16 49 d -7 22 d -27 7 d -10 -33 d 12 -41 d f 0 0.4 0.8 c 1266 1069 m -14 48 d
- -13 -41 d f 0 0 0.8 c 1240 994 m 9 -20 d -8 28 d f 0 0.2 0.8 c 1226 1022 m 14
- -28 d 1 8 d -12 41 d -24 -6 d f 1202 1029 m 24 -7 d -21 15 d -10 28 d 1 -14 d f
- 0 0.4 0.8 c 1195 1065 m -13 34 d 14 -48 d f 0 0 0.8 c 1179 943 m 10 38 d -16 1
- d f 0 0.2 0.8 c 1189 981 m 13 48 d -6 22 d -32 X 9 -69 d f 0 0.4 0.8 c 1196
- 1051 m -14 48 d -24 -6 d 6 -42 d f 0 0 0.8 c 1158 973 m 21 -30 d -6 39 d f 0
- 0.2 0.8 c 1155 977 m 3 -4 d 15 9 d -9 69 d -20 -9 d f 0 0.4 0.8 c 1164 1051 m
- -6 42 d -23 7 d 9 -58 d f 0 0.2 0.8 c 1132 985 m 23 -8 d -11 65 d -29 -1 d f 0
- 0.4 0.8 c 1144 1042 m -9 58 d -24 -46 d 4 -13 d f 0 0.2 0.8 c 1108 992 m 24 -7
- d -17 56 d -22 -7 d f 0 0.4 0.8 c 1115 1041 m -4 13 d -23 -6 d 5 -14 d f 0 0.2
- 0.8 c 1085 986 m 23 6 d -15 42 d -15 -13 d f 0 0.4 0.8 c 1093 1034 m -5 14 d
- -23 46 d 13 -73 d f 0 0.6 0.8 c 1065 1094 m -1 2 d 1 -2 d f 0 0.2 0.8 c 1067
- 1012 m 18 -26 d -7 35 d f 0 0.4 0.8 c 1061 1020 m 6 -8 d 11 9 d -13 73 d -2 X
- -22 -45 d f 0 0.6 0.8 c 1065 1094 m -1 2 d -1 -2 d f 0 0 0.8 c 1038 920 m 5 24
- d -8 X f 0 0.2 0.8 c 1043 944 m 16 66 d -32 2 d 8 -68 d f 0 0.4 0.8 c 1059 1010
- m 2 10 d -20 29 d -17 35 d -5 -3 d 8 -69 d f 0 0.6 0.8 c 1024 1084 m -7 13 d 2
- -16 d f 0 0 0.8 c 1014 901 m 24 19 d -3 24 d -30 -1 d f 0 0.2 0.8 c 1035 944 m
- -8 68 d -29 3 d -4 -18 d 11 -54 d f 0 0.4 0.8 c 1027 1012 m -8 69 d -5 X -16
- -66 d f 0 0.6 0.8 c 1019 1081 m -2 16 d -3 -16 d f 0 0 0.8 c 1005 934 m 9 -33 d
- -9 42 d f 0 0.2 0.8 c 991 989 m 14 -55 d 9 Y -11 54 d -24 -6 d f 967 956 m 24
- 33 d -21 2 d -4 16 d -5 -16 d f 0 0.4 0.8 c 966 1007 m -19 57 d 14 -73 d f 0
- 0.6 0.8 c 947 1064 m 2 Y -2 Y f 0 0.2 0.8 c 944 977 m 23 -21 d -6 35 d -30 7 d
- -8 -32 d f 0 0.4 0.8 c 961 991 m -14 73 d -16 -66 d f 0 0.6 0.8 c 947 1064 m 2
- Y -2 Y f 0 0 0.8 c 920 904 m 3 9 d -5 1 d f 0 0.2 0.8 c 923 913 m 21 64 d -21
- -11 d -17 25 d -3 -3 d 15 -74 d f 0 0.4 0.8 c 906 991 m -6 9 d 3 -12 d f 0 0
- 0.8 c 897 884 m 23 20 d -2 10 d -27 -3 d f 0 0.2 0.8 c 918 914 m -15 74 d -21
- -3 d -5 -4 d 14 -70 d f 0 0.4 0.8 c 903 988 m -3 12 d -18 -15 d f 0 0 0.8 c 878
- 901 m 19 -17 d -6 27 d f 0 0.2 0.8 c 873 905 m 5 -4 d 13 10 d -14 70 d -24 -33
- d f 0 0 0.8 c 839 912 m -9 -24 d 11 13 d f 0 0.2 0.8 c 850 913 m 23 -8 d -20 43
- d -14 -36 d 2 -11 d f 0 0 0.8 c 826 880 m 8 10 d 7 11 d -11 -13 d -7 20 d 1 -18
- d f 0 0.2 0.8 c 834 890 m 16 23 d -9 -12 d -18 7 d -17 55 d 18 -73 d f 0 0 0.8
- c 803 820 m 23 60 d -2 10 d -29 11 d -12 -65 d f 0 0.2 0.8 c 824 890 m -18 73 d
- -11 -62 d f 0 0 0.8 c 779 814 m 24 6 d -20 16 d -24 -6 d f 756 808 m 23 6 d -20
- 16 d -23 -6 d f 732 802 m 24 6 d -20 16 d -24 -6 d f 1833 1062 m 24 6 d -21 15
- d -23 -6 d f 1810 1056 m 23 6 d -20 15 d -24 -6 d f 1786 1050 m 24 6 d -21 15 d
- -23 -6 d f 1763 1098 m 23 -48 d -20 15 d -24 35 d f 1739 1078 m 24 20 d -21 2 d
- -23 7 d f 1716 1072 m 23 6 d -20 29 d -2 8 d -4 -18 d f 0 0.2 0.8 c 1717 1115 m
- -12 59 d -2 -8 d 10 -69 d f 0 0.4 0.8 c 1705 1174 m -10 48 d 8 -56 d f 0 0 0.8
- c 1692 1066 m 24 6 d -3 25 d -37 8 d -4 -23 d f 0 0.2 0.8 c 1713 1097 m -10 69
- d -16 3 d -11 -64 d f 0 0.4 0.8 c 1703 1166 m -8 56 d -8 -53 d f 0 0 0.8 c 1669
- 1074 m 23 -8 d -20 16 d -24 -6 d f 1645 1068 m 24 6 d -21 2 d -19 17 d 4 -7 d f
- 0 0.2 0.8 c 1629 1093 m -4 4 d 8 -11 d f 0 0 0.8 c 1622 1035 m 23 33 d -12 18 d
- -24 -6 d f 0 0.2 0.8 c 1633 1086 m -8 11 d -23 7 d 7 -24 d f 0 0 0.8 c 1606
- 1066 m 16 -31 d -13 45 d -18 3 d -13 -25 d 11 13 d f 0 0.2 0.8 c 1598 1083 m 8
- -17 d 3 14 d -7 24 d -11 -21 d -2 -12 d f 0 0 0.8 c 1575 1050 m 7 10 d 7 11 d
- -11 -13 d -13 18 d 4 -13 d f 0 0.2 0.8 c 1582 1060 m 16 23 d -9 -12 d -24 5 d
- -10 16 d 14 -29 d f 0 0 0.8 c 1551 1017 m 24 33 d -6 13 d -28 -3 d f 0 0.2 0.8
- c 1569 1063 m -14 29 d -24 8 d 10 -40 d f 0 0 0.8 c 1528 1038 m 23 -21 d -10 43
- d -21 5 d -12 -39 d f 0 0.2 0.8 c 1541 1060 m -10 40 d -11 -35 d f 0 0 0.8 c
- 1521 1044 m 7 -6 d -20 -12 d -24 -19 d 15 38 d f 0 0.2 0.8 c 1504 1059 m 17 -15
- d -22 1 d f 0 0 0.8 c 1481 999 m 15 39 d 3 7 d -15 -38 d -14 45 d -10 Y f 0 0.2
- 0.8 c 1496 1038 m 8 21 d -5 -14 d -29 7 d -9 30 d 9 -40 d f 0 0 0.8 c 1457 980
- m 24 19 d -11 43 d -31 X f 0 0.2 0.8 c 1470 1042 m -9 40 d -24 -33 d 2 -7 d f 0
- 0 0.8 c 1434 987 m 23 -7 d -18 62 d -13 -14 d f 0 0.2 0.8 c 1439 1042 m -2 7 d
- -23 48 d 12 -69 d f 0 0 0.8 c 1410 994 m 24 -7 d -8 41 d -30 5 d -6 -23 d f 0
- 0.2 0.8 c 1426 1028 m -12 69 d -18 -64 d f 0 0 0.8 c 1387 975 m 23 19 d -20 16
- d -23 -6 d f 1363 956 m 24 19 d -20 29 d -19 17 d -3 -3 d f 0 0.2 0.8 c 1348
- 1021 m -5 4 d 2 -7 d f 0 0 0.8 c 1340 990 m 23 -34 d -18 62 d -8 -17 d f 0 0.2
- 0.8 c 1345 1018 m -2 7 d -23 34 d 17 -58 d f 0 0 0.8 c 1325 995 m 15 -5 d -3 11
- d f 0 0.2 0.8 c 1317 997 m 8 -2 d 12 6 d -17 58 d -24 -19 d f 1293 991 m 24 6 d
- -21 43 d -23 7 d f 0 0 0.8 c 1270 972 m 14 12 d -27 14 d -8 -24 d f 0 0.2 0.8 c
- 1284 984 m 9 7 d -20 56 d -16 -49 d f 0 0 0.8 c 1265 979 m 5 -7 d -21 2 d -9 20
- d f 0 0.2 0.8 c 1246 1006 m 19 -27 d -25 15 d -14 28 d f 0 0 0.8 c 1223 960 m 4
- 10 d -8 1 d f 0 0.2 0.8 c 1227 970 m 19 36 d -20 16 d -24 7 d 17 -58 d f 0 0
- 0.8 c 1199 914 m 24 46 d -4 11 d -30 10 d -10 -38 d f 0 0.2 0.8 c 1219 971 m
- -17 58 d -13 -48 d f 0 0 0.8 c 1176 908 m 23 6 d -20 29 d -21 30 d -1 -2 d f 0
- 0.2 0.8 c 1158 973 m -3 4 d 2 -6 d f 0 0 0.8 c 1152 929 m 24 -21 d -19 63 d -16
- -12 d f 0 0.2 0.8 c 1157 971 m -2 6 d -23 8 d 9 -26 d f 0 0 0.8 c 1129 923 m 23
- 6 d -11 30 d -21 -8 d f 0 0.2 0.8 c 1141 959 m -9 26 d -24 7 d 12 -41 d f 0 0
- 0.8 c 1105 930 m 24 -7 d -9 28 d -19 -9 d f 0 0.2 0.8 c 1120 951 m -12 41 d -23
- -6 d 16 -44 d f 0 0 0.8 c 1090 935 m 15 -5 d -4 12 d f 0 0.2 0.8 c 1082 938 m 8
- -3 d 11 7 d -16 44 d -18 26 d -3 -4 d f 0 0.4 0.8 c 1067 1012 m -6 8 d 3 -12 d
- f 0 0 0.8 c 1058 905 m 19 26 d -34 13 d -5 -24 d f 0 0.2 0.8 c 1077 931 m 5 7 d
- -18 70 d -5 2 d -16 -66 d f 0 0.4 0.8 c 1064 1008 m -3 12 d -2 -10 d f 0 0 0.8
- c 1035 912 m 23 -7 d -20 15 d -24 -19 d f 1020 917 m 15 -5 d -21 -11 d -9 33 d
- f 0 0.2 0.8 c 1011 920 m 9 -3 d -15 17 d -14 55 d f 0 0 0.8 c 988 873 m 20 41 d
- -31 3 d f 0 0.2 0.8 c 1008 914 m 3 6 d -20 69 d -24 -33 d 10 -39 d f 0 0 0.8 c
- 964 854 m 24 19 d -11 44 d -22 -7 d f 0 0.2 0.8 c 977 917 m -10 39 d -23 21 d
- 11 -67 d f 0 0 0.8 c 941 848 m 23 6 d -9 56 d -32 3 d -3 -9 d f 0 0.2 0.8 c 955
- 910 m -11 67 d -21 -64 d f 0 0 0.8 c 919 891 m 22 -43 d -21 56 d -23 -20 d 16
- 10 d f 0 0.2 0.8 c 917 896 m 2 -5 d -6 3 d f 0 0 0.8 c 894 876 m 14 13 d 5 5 d
- -16 -10 d -19 17 d 3 -7 d f 0 0.2 0.8 c 908 889 m 9 7 d -4 -2 d -35 7 d -5 4 d
- 8 -11 d f 0 0 0.8 c 870 857 m 24 19 d -13 18 d -22 -7 d f 0 0.2 0.8 c 881 894 m
- -8 11 d -23 8 d 9 -26 d f 0 0 0.8 c 847 851 m 23 6 d -11 30 d -25 3 d -8 -10 d
- f 0 0.2 0.8 c 859 887 m -9 26 d -16 -23 d f 0 0 0.8 c 823 805 m 24 46 d -21 29
- d -23 -60 d f 800 799 m 23 6 d -20 15 d -24 -6 d f 776 793 m 24 6 d -21 15 d
- -23 -6 d f 753 787 m 23 6 d -20 15 d -24 -6 d f 1854 1046 m 23 6 d -20 16 d -24
- -6 d f 1830 1040 m 24 6 d -21 16 d -23 -6 d f 1807 1034 m 23 6 d -20 16 d -24
- -6 d f 1789 1092 m 18 -58 d -21 16 d -23 48 d 6 3 d f 0 0.2 0.8 c 1783 1109 m 6
- -17 d -20 9 d f 0 0 0.8 c 1760 1022 m 18 67 d -9 12 d -6 -3 d -24 -20 d f 0 0.2
- 0.8 c 1778 1089 m 5 20 d -14 -8 d f 0 0 0.8 c 1736 1016 m 24 6 d -21 56 d -23
- -6 d f 1713 1051 m 23 -35 d -20 56 d -24 -6 d f 1689 1018 m 24 33 d -21 15 d
- -23 8 d f 1666 998 m 23 20 d -20 56 d -24 -6 d f 1642 1033 m 24 -35 d -21 70 d
- -23 -33 d f 1619 1013 m 23 20 d -20 2 d -16 31 d -1 -7 d f 0 0.2 0.8 c 1606
- 1066 m -8 17 d 7 -24 d f 0 0 0.8 c 1595 994 m 24 19 d -14 46 d -23 1 d -7 -10 d
- f 0 0.2 0.8 c 1605 1059 m -7 24 d -16 -23 d f 0 0 0.8 c 1572 1001 m 23 -7 d -20
- 56 d -24 -33 d f 1548 995 m 24 6 d -21 16 d -23 21 d f 1525 963 m 23 32 d -20
- 43 d -7 6 d -12 -7 d f 0 0.2 0.8 c 1521 1044 m -17 15 d 5 -22 d f 0 0 0.8 c
- 1501 970 m 24 -7 d -16 74 d -13 1 d -15 -39 d f 0 0.2 0.8 c 1509 1037 m -5 22 d
- -8 -21 d f 0 0 0.8 c 1478 977 m 23 -7 d -20 29 d -24 -19 d f 1454 958 m 24 19 d
- -21 3 d -23 7 d f 1431 966 m 23 -8 d -20 29 d -24 7 d f 1407 933 m 24 33 d -21
- 28 d -23 -19 d f 1384 940 m 23 -7 d -20 42 d -24 -19 d f 1360 948 m 24 -8 d -21
- 16 d -23 34 d f 1337 915 m 23 33 d -20 42 d -15 5 d -7 -4 d f 0 0.2 0.8 c 1325
- 995 m -8 2 d 1 -6 d f 0 0 0.8 c 1313 936 m 24 -21 d -19 76 d -22 -7 d f 0 0.2
- 0.8 c 1318 991 m -1 6 d -24 -6 d 3 -7 d f 0 0 0.8 c 1290 916 m 23 20 d -17 48 d
- -12 X -14 -12 d f 0 0.2 0.8 c 1296 984 m -3 7 d -9 -7 d f 0 0 0.8 c 1266 910 m
- 24 6 d -20 56 d -5 7 d -11 -11 d f 0 0.2 0.8 c 1265 979 m -19 27 d 8 -38 d f 0
- 0 0.8 c 1243 931 m 23 -21 d -12 58 d -27 2 d -4 -10 d f 0 0.2 0.8 c 1254 968 m
- -8 38 d -19 -36 d f 0 0 0.8 c 1219 898 m 24 33 d -20 29 d -24 -46 d f 1196 906
- m 23 -8 d -20 16 d -23 -6 d f 1172 900 m 24 6 d -20 2 d -24 21 d f 1149 880 m
- 23 20 d -20 29 d -23 -6 d f 1125 888 m 24 -8 d -20 43 d -24 7 d f 1102 882 m 23
- 6 d -20 42 d -15 5 d -6 -4 d f 0 0.2 0.8 c 1090 935 m -8 3 d 2 -7 d f 0 0 0.8 c
- 1078 876 m 24 6 d -18 49 d -7 X -19 -26 d f 0 0.2 0.8 c 1084 931 m -2 7 d -5 -7
- d f 0 0 0.8 c 1055 870 m 23 6 d -20 29 d -23 7 d f 1031 864 m 24 6 d -20 42 d
- -15 5 d -6 -4 d f 0 0.2 0.8 c 1020 917 m -9 3 d 3 -7 d f 0 0 0.8 c 1008 871 m
- 23 -7 d -17 49 d -6 1 d -20 -41 d f 0 0.2 0.8 c 1014 913 m -3 7 d -3 -6 d f 0 0
- 0.8 c 985 852 m 23 19 d -20 2 d -24 -19 d f 961 859 m 24 -7 d -21 2 d -23 -6 d
- f 938 827 m 23 32 d -20 -11 d -22 43 d -2 Y f 0 0.2 0.8 c 919 891 m -2 5 d 2 -7
- d f 0 0 0.8 c 914 821 m 24 6 d -19 62 d -11 X -14 -13 d f 0 0.2 0.8 c 919 889 m
- -2 7 d -9 -7 d f 0 0 0.8 c 891 841 m 23 -20 d -20 55 d -24 -19 d f 867 822 m 24
- 19 d -21 16 d -23 -6 d f 844 789 m 23 33 d -20 29 d -24 -46 d f 820 783 m 24 6
- d -21 16 d -23 -6 d f 797 777 m 23 6 d -20 16 d -24 -6 d f 773 771 m 24 6 d -21
- 16 d -23 -6 d f 1874 1031 m 23 6 d -20 15 d -23 -6 d f 1850 1025 m 24 6 d -20
- 15 d -24 -6 d f 1827 1019 m 23 6 d -20 15 d -23 -6 d f 1803 1026 m 24 -7 d -20
- 15 d -18 58 d -6 Y f 0 0.2 0.8 c 1789 1092 m -6 17 d 6 -23 d f 0 0 0.8 c 1780
- 1020 m 23 6 d -14 60 d -11 3 d -18 -67 d f 0 0.2 0.8 c 1789 1086 m -6 23 d -5
- -20 d f 0 0 0.8 c 1757 1001 m 23 19 d -20 2 d -24 -6 d f 1733 1008 m 24 -7 d
- -21 15 d -23 35 d f 1710 989 m 23 19 d -20 43 d -24 -33 d f 1686 983 m 24 6 d
- -21 29 d -23 -20 d f 1663 977 m 23 6 d -20 15 d -24 35 d f 1639 971 m 24 6 d
- -21 56 d -23 -20 d f 1616 978 m 23 -7 d -20 42 d -24 -19 d f 1592 972 m 24 6 d
- -21 16 d -23 7 d f 1569 953 m 23 19 d -20 29 d -24 -6 d f 1545 947 m 24 6 d -21
- 42 d -23 -32 d f 1522 941 m 23 6 d -20 16 d -24 7 d f 1498 935 m 24 6 d -21 29
- d -23 7 d f 1475 943 m 23 -8 d -20 42 d -24 -19 d f 1451 937 m 24 6 d -21 15 d
- -23 8 d f 1428 917 m 23 20 d -20 29 d -24 -33 d f 1404 925 m 24 -8 d -21 16 d
- -23 7 d f 1381 945 m 23 -20 d -20 15 d -24 8 d f 1357 926 m 24 19 d -21 3 d -23
- -33 d f 1334 920 m 23 6 d -20 -11 d -24 21 d f 1310 928 m 24 -8 d -21 16 d -23
- -20 d f 1287 881 m 23 47 d -20 -12 d -24 -6 d f 1263 889 m 24 -8 d -21 29 d -23
- 21 d f 1240 883 m 23 6 d -20 42 d -24 -33 d f 1216 877 m 24 6 d -21 15 d -23 8
- d f 1193 857 m 23 20 d -20 29 d -24 -6 d f 1169 851 m 24 6 d -21 43 d -23 -20 d
- f 1146 859 m 23 -8 d -20 29 d -24 8 d f 1122 853 m 24 6 d -21 29 d -23 -6 d f
- 1099 833 m 23 20 d -20 29 d -24 -6 d f 1075 827 m 24 6 d -21 43 d -23 -6 d f
- 1052 862 m 23 -35 d -20 43 d -24 -6 d f 1028 815 m 24 47 d -21 2 d -23 7 d f
- 1005 810 m 23 5 d -20 56 d -23 -19 d f 981 804 m 24 6 d -20 42 d -24 7 d f 958
- 798 m 23 6 d -20 55 d -23 -32 d f 934 792 m 24 6 d -20 29 d -24 -6 d f 911 786
- m 23 6 d -20 29 d -23 20 d f 887 780 m 24 6 d -20 55 d -24 -19 d f 864 774 m 23
- 6 d -20 42 d -23 -33 d f 840 768 m 24 6 d -20 15 d -24 -6 d f 817 762 m 23 6 d
- -20 15 d -23 -6 d f 793 756 m 24 6 d -20 15 d -24 -6 d f 1894 1015 m 24 6 d -21
- 16 d -23 -6 d f 1871 1009 m 23 6 d -20 16 d -24 -6 d f 1847 1003 m 24 6 d -21
- 16 d -23 -6 d f 1824 997 m 23 6 d -20 16 d -24 7 d f 1800 991 m 24 6 d -21 29 d
- -23 -6 d f 1777 999 m 23 -8 d -20 29 d -23 -19 d f 1753 993 m 24 6 d -20 2 d
- -24 7 d f 1730 973 m 23 20 d -20 15 d -23 -19 d f 1706 967 m 24 6 d -20 16 d
- -24 -6 d f 1683 988 m 23 -21 d -20 16 d -23 -6 d f 1659 955 m 24 33 d -20 -11 d
- -24 -6 d f 1636 949 m 23 6 d -20 16 d -23 7 d f 1612 943 m 24 6 d -20 29 d -24
- -6 d f 1589 937 m 23 6 d -20 29 d -23 -19 d f 1565 932 m 24 5 d -20 16 d -24 -6
- d f 1542 926 m 23 6 d -20 15 d -23 -6 d f 1518 933 m 24 -7 d -20 15 d -24 -6 d
- f 1495 914 m 23 19 d -20 2 d -23 8 d f 1471 921 m 24 -7 d -20 29 d -24 -6 d f
- 1448 902 m 23 19 d -20 16 d -23 -20 d f 1425 909 m 23 -7 d -20 15 d -24 8 d f
- 1401 917 m 24 -8 d -21 16 d -23 20 d f 1378 884 m 23 33 d -20 28 d -24 -19 d f
- 1354 878 m 24 6 d -21 42 d -23 -6 d f 1331 872 m 23 6 d -20 42 d -24 8 d f 1307
- 866 m 24 6 d -21 56 d -23 -47 d f 1284 860 m 23 6 d -20 15 d -24 8 d f 1260 854
- m 24 6 d -21 29 d -23 -6 d f 1237 861 m 23 -7 d -20 29 d -24 -6 d f 1213 842 m
- 24 19 d -21 16 d -23 -20 d f 1190 836 m 23 6 d -20 15 d -24 -6 d f 1166 843 m
- 24 -7 d -21 15 d -23 8 d f 1143 824 m 23 19 d -20 16 d -24 -6 d f 1119 818 m 24
- 6 d -21 29 d -23 -20 d f 1096 812 m 23 6 d -20 15 d -24 -6 d f 1072 819 m 24 -7
- d -21 15 d -23 35 d f 1049 800 m 23 19 d -20 43 d -24 -47 d f 1025 807 m 24 -7
- d -21 15 d -23 -5 d f 1002 788 m 23 19 d -20 3 d -24 -6 d f 978 782 m 24 6 d
- -21 16 d -23 -6 d f 955 776 m 23 6 d -20 16 d -24 -6 d f 931 770 m 24 6 d -21
- 16 d -23 -6 d f 908 764 m 23 6 d -20 16 d -24 -6 d f 884 758 m 24 6 d -21 16 d
- -23 -6 d f 861 752 m 23 6 d -20 16 d -24 -6 d f 837 746 m 24 6 d -21 16 d -23
- -6 d f 814 740 m 23 6 d -20 16 d -24 -6 d f 1915 1000 m 23 6 d -20 15 d -24 -6
- d f 1891 994 m 24 6 d -21 15 d -23 -6 d f 1868 988 m 23 6 d -20 15 d -24 -6 d f
- 1844 982 m 24 6 d -21 15 d -23 -6 d f 1821 976 m 23 6 d -20 15 d -24 -6 d f
- 1797 970 m 24 6 d -21 15 d -23 8 d f 1774 964 m 23 6 d -20 29 d -24 -6 d f 1750
- 971 m 24 -7 d -21 29 d -23 -20 d f 1727 952 m 23 19 d -20 2 d -24 -6 d f 1703
- 946 m 24 6 d -21 15 d -23 21 d f 1680 940 m 23 6 d -20 42 d -24 -33 d f 1656
- 934 m 24 6 d -21 15 d -23 -6 d f 1633 928 m 23 6 d -20 15 d -24 -6 d f 1609 922
- m 24 6 d -21 15 d -23 -6 d f 1586 916 m 23 6 d -20 15 d -24 -5 d f 1562 910 m
- 24 6 d -21 16 d -23 -6 d f 1539 904 m 23 6 d -20 16 d -24 7 d f 1515 898 m 24 6
- d -21 29 d -23 -19 d f 1492 892 m 23 6 d -20 16 d -24 7 d f 1468 886 m 24 6 d
- -21 29 d -23 -19 d f 1445 880 m 23 6 d -20 16 d -23 7 d f 1421 874 m 24 6 d -20
- 29 d -24 8 d f 1398 868 m 23 6 d -20 43 d -23 -33 d f 1374 862 m 24 6 d -20 16
- d -24 -6 d f 1351 870 m 23 -8 d -20 16 d -23 -6 d f 1327 850 m 24 20 d -20 2 d
- -24 -6 d f 1304 844 m 23 6 d -20 16 d -23 -6 d f 1280 838 m 24 6 d -20 16 d -24
- -6 d f 1257 846 m 23 -8 d -20 16 d -23 7 d f 1233 826 m 24 20 d -20 15 d -24
- -19 d f 1210 820 m 23 6 d -20 16 d -23 -6 d f 1186 814 m 24 6 d -20 16 d -24 7
- d f 1163 808 m 23 6 d -20 29 d -23 -19 d f 1139 802 m 24 6 d -20 16 d -24 -6 d
- f 1116 796 m 23 6 d -20 16 d -23 -6 d f 1093 790 m 23 6 d -20 16 d -24 7 d f
- 1069 784 m 24 6 d -21 29 d -23 -19 d f 1046 778 m 23 6 d -20 16 d -24 7 d f
- 1022 772 m 24 6 d -21 29 d -23 -19 d f 999 766 m 23 6 d -20 16 d -24 -6 d f 975
- 760 m 24 6 d -21 16 d -23 -6 d f 952 755 m 23 5 d -20 16 d -24 -6 d f 928 749 m
- 24 6 d -21 15 d -23 -6 d f 905 743 m 23 6 d -20 15 d -24 -6 d f 881 737 m 24 6
- d -21 15 d -23 -6 d f 858 731 m 23 6 d -20 15 d -24 -6 d f 834 725 m 24 6 d -21
- 15 d -23 -6 d f 1935 984 m 23 6 d -20 16 d -23 -6 d f 1911 978 m 24 6 d -20 16
- d -24 -6 d f 1888 972 m 23 6 d -20 16 d -23 -6 d f 1865 966 m 23 6 d -20 16 d
- -24 -6 d f 1841 960 m 24 6 d -21 16 d -23 -6 d f 1818 954 m 23 6 d -20 16 d -24
- -6 d f 1794 948 m 24 6 d -21 16 d -23 -6 d f 1771 942 m 23 6 d -20 16 d -24 7 d
- f 1747 936 m 24 6 d -21 29 d -23 -19 d f 1724 930 m 23 6 d -20 16 d -24 -6 d f
- 1700 924 m 24 6 d -21 16 d -23 -6 d f 1677 918 m 23 6 d -20 16 d -24 -6 d f
- 1653 912 m 24 6 d -21 16 d -23 -6 d f 1630 906 m 23 6 d -20 16 d -24 -6 d f
- 1606 900 m 24 6 d -21 16 d -23 -6 d f 1583 894 m 23 6 d -20 16 d -24 -6 d f
- 1559 888 m 24 6 d -21 16 d -23 -6 d f 1536 882 m 23 6 d -20 16 d -24 -6 d f
- 1512 877 m 24 5 d -21 16 d -23 -6 d f 1489 884 m 23 -7 d -20 15 d -24 -6 d f
- 1465 865 m 24 19 d -21 2 d -23 -6 d f 1442 859 m 23 6 d -20 15 d -24 -6 d f
- 1418 853 m 24 6 d -21 15 d -23 -6 d f 1395 847 m 23 6 d -20 15 d -24 -6 d f
- 1371 841 m 24 6 d -21 15 d -23 8 d f 1348 835 m 23 6 d -20 29 d -24 -20 d f
- 1324 829 m 24 6 d -21 15 d -23 -6 d f 1301 823 m 23 6 d -20 15 d -24 -6 d f
- 1277 817 m 24 6 d -21 15 d -23 8 d f 1254 811 m 23 6 d -20 29 d -24 -20 d f
- 1230 805 m 24 6 d -21 15 d -23 -6 d f 1207 799 m 23 6 d -20 15 d -24 -6 d f
- 1183 793 m 24 6 d -21 15 d -23 -6 d f 1160 787 m 23 6 d -20 15 d -24 -6 d f
- 1136 781 m 24 6 d -21 15 d -23 -6 d f 1113 775 m 23 6 d -20 15 d -23 -6 d f
- 1089 769 m 24 6 d -20 15 d -24 -6 d f 1066 763 m 23 6 d -20 15 d -23 -6 d f
- 1042 757 m 24 6 d -20 15 d -24 -6 d f 1019 764 m 23 -7 d -20 15 d -23 -6 d f
- 995 745 m 24 19 d -20 2 d -24 -6 d f 972 739 m 23 6 d -20 15 d -23 -5 d f 948
- 733 m 24 6 d -20 16 d -24 -6 d f 925 727 m 23 6 d -20 16 d -23 -6 d f 901 721 m
- 24 6 d -20 16 d -24 -6 d f 878 715 m 23 6 d -20 16 d -23 -6 d f 854 709 m 24 6
- d -20 16 d -24 -6 d f 1955 969 m 24 6 d -21 15 d -23 -6 d f 1932 963 m 23 6 d
- -20 15 d -24 -6 d f 1908 957 m 24 6 d -21 15 d -23 -6 d f 1885 951 m 23 6 d -20
- 15 d -23 -6 d f 1861 945 m 24 6 d -20 15 d -24 -6 d f 1838 952 m 23 -7 d -20 15
- d -23 -6 d f 1814 933 m 24 19 d -20 2 d -24 -6 d f 1791 927 m 23 6 d -20 15 d
- -23 -6 d f 1767 921 m 24 6 d -20 15 d -24 -6 d f 1744 915 m 23 6 d -20 15 d -23
- -6 d f 1720 909 m 24 6 d -20 15 d -24 -6 d f 1697 903 m 23 6 d -20 15 d -23 -6
- d f 1673 897 m 24 6 d -20 15 d -24 -6 d f 1650 891 m 23 6 d -20 15 d -23 -6 d f
- 1626 885 m 24 6 d -20 15 d -24 -6 d f 1603 879 m 23 6 d -20 15 d -23 -6 d f
- 1579 886 m 24 -7 d -20 15 d -24 -6 d f 1556 867 m 23 19 d -20 2 d -23 -6 d f
- 1533 861 m 23 6 d -20 15 d -24 -5 d f 1509 855 m 24 6 d -21 16 d -23 7 d f 1486
- 849 m 23 6 d -20 29 d -24 -19 d f 1462 843 m 24 6 d -21 16 d -23 -6 d f 1439
- 837 m 23 6 d -20 16 d -24 -6 d f 1415 831 m 24 6 d -21 16 d -23 -6 d f 1392 825
- m 23 6 d -20 16 d -24 -6 d f 1368 819 m 24 6 d -21 16 d -23 -6 d f 1345 813 m
- 23 6 d -20 16 d -24 -6 d f 1321 807 m 24 6 d -21 16 d -23 -6 d f 1298 801 m 23
- 6 d -20 16 d -24 -6 d f 1274 795 m 24 6 d -21 16 d -23 -6 d f 1251 789 m 23 6 d
- -20 16 d -24 -6 d f 1227 783 m 24 6 d -21 16 d -23 -6 d f 1204 777 m 23 6 d -20
- 16 d -24 -6 d f 1180 771 m 24 6 d -21 16 d -23 -6 d f 1157 765 m 23 6 d -20 16
- d -24 -6 d f 1133 759 m 24 6 d -21 16 d -23 -6 d f 1110 753 m 23 6 d -20 16 d
- -24 -6 d f 1086 747 m 24 6 d -21 16 d -23 -6 d f 1063 741 m 23 6 d -20 16 d -24
- -6 d f 1039 735 m 24 6 d -21 16 d -23 7 d f 1016 729 m 23 6 d -20 29 d -24 -19
- d f 992 723 m 24 6 d -21 16 d -23 -6 d f 969 717 m 23 6 d -20 16 d -24 -6 d f
- 945 711 m 24 6 d -21 16 d -23 -6 d f 922 706 m 23 5 d -20 16 d -24 -6 d f 898
- 700 m 24 6 d -21 15 d -23 -6 d f 875 694 m 23 6 d -20 15 d -24 -6 d f black 222
- 1180 m 651 -497 d s 873 683 m 994 Y s 222 2174 m 651 -497 d s 222 1180 m 994 Y
- s 873 683 m 1128 287 d s 2001 970 m 994 Y s 873 1677 m 1128 287 d s 873 1677 m
- cl s 873 683 m 1128 287 d s 967 673 m 34 Y s 991 696 m 17 Y s 1014 702 m 17 Y s
- 1038 708 m 17 Y s 1061 714 m 17 Y s 1085 703 m 34 Y s 1108 726 m 17 Y s 1132
- 732 m 17 Y s 1155 738 m 17 Y s 1179 744 m 17 Y s 1202 733 m 34 Y s 1226 756 m
- 16 Y s 1249 762 m 16 Y s 1273 768 m 16 Y s 1296 774 m 16 Y s 1320 763 m 33 Y s
- 1343 786 m 16 Y s 1367 792 m 16 Y s 1390 798 m 16 Y s 1413 804 m 16 Y s 1437
- 793 m 33 Y s 1460 816 m 16 Y s 1484 822 m 16 Y s 1507 828 m 16 Y s 1531 834 m
- 16 Y s 1554 823 m 33 Y s 1578 846 m 16 Y s 1601 851 m 17 Y s 1625 857 m 17 Y s
- 1648 863 m 17 Y s 1672 853 m 33 Y s 1695 875 m 17 Y s 1719 881 m 17 Y s 1742
- 887 m 17 Y s 1766 893 m 17 Y s 1789 883 m 33 Y s 1813 905 m 17 Y s 1836 911 m
- 17 Y s 1860 917 m 17 Y s 1883 923 m 17 Y s 1907 913 m 33 Y s 967 673 m 34 Y s
- 944 684 m 17 Y s 920 678 m 17 Y s 897 672 m 17 Y s 873 666 m 17 Y s 1907 913 m
- 33 Y s 1930 935 m 17 Y s 1954 941 m 17 Y s 1977 947 m 17 Y s 2001 953 m 17 Y s
- 970 654 m -5 -1 d -3 -4 d -1 -8 d -4 Y 1 -8 d 3 -4 d 5 -2 d 3 X 4 2 d 3 4 d 1 8
- d 4 Y -1 8 d -3 4 d -4 1 d -3 X cl s 1061 684 m -4 -1 d -3 -5 d -1 -7 d -4 Y 1
- -8 d 3 -4 d 4 -2 d 3 X 5 2 d 3 4 d 1 8 d 4 Y -1 7 d -3 5 d -5 1 d -3 X cl s
- 1085 656 m -1 -1 d 1 -2 d 2 2 d -2 1 d cl s 1099 677 m 1 Y 1 3 d 1 2 d 3 1 d 6
- X 3 -1 d 2 -2 d 1 -3 d -3 Y -1 -2 d -3 -5 d -15 -15 d 21 X s 1144 684 m -14 X
- -2 -13 d 2 2 d 4 1 d 5 X 4 -1 d 3 -3 d 1 -5 d -3 Y -1 -4 d -3 -3 d -4 -2 d -5 X
- -4 2 d -2 1 d -1 3 d s 1190 714 m -5 -1 d -3 -5 d -1 -7 d -5 Y 1 -7 d 3 -4 d 5
- -2 d 3 X 4 2 d 3 4 d 2 7 d 5 Y -2 7 d -3 5 d -4 1 d -3 X cl s 1214 686 m -2 -1
- d 2 -2 d 1 2 d -1 1 d cl s 1243 714 m -15 X -1 -13 d 1 1 d 5 2 d 4 X 5 -2 d 3
- -3 d 1 -4 d -3 Y -1 -4 d -3 -3 d -5 -2 d -4 X -5 2 d -1 1 d -2 3 d s 1296 744 m
- -4 -1 d -3 -5 d -2 -7 d -5 Y 2 -7 d 3 -4 d 4 -2 d 3 X 5 2 d 3 4 d 1 7 d 5 Y -1
- 7 d -3 5 d -5 1 d -3 X cl s 1320 716 m -1 -1 d 1 -2 d 2 2 d -2 1 d cl s 1353
- 744 m -15 -31 d s 1332 744 m 21 X s 1379 744 m -14 X -2 -13 d 2 1 d 4 2 d 4 X 5
- -2 d 3 -3 d 1 -4 d -3 Y -1 -5 d -3 -2 d -5 -2 d -4 X -4 2 d -2 1 d -1 3 d s
- 1435 768 m 3 2 d 4 4 d -31 Y s 1527 798 m 3 2 d 4 4 d -31 Y s 1555 776 m -2 -2
- d 2 -1 d 1 1 d -1 2 d cl s 1568 797 m 1 Y 2 3 d 1 1 d 3 2 d 6 X 3 -2 d 2 -1 d 1
- -3 d -3 Y -1 -3 d -3 -4 d -15 -15 d 21 X s 1614 804 m -15 X -1 -13 d 1 1 d 5 2
- d 4 X 5 -2 d 3 -3 d 1 -4 d -3 Y -1 -5 d -3 -3 d -5 -1 d -4 X -5 1 d -1 2 d -2 3
- d s 1655 828 m 3 1 d 5 5 d -31 Y s 1683 806 m -1 -2 d 1 -1 d 2 1 d -2 2 d cl s
- 1713 834 m -15 X -1 -13 d 1 1 d 5 1 d 4 X 5 -1 d 3 -3 d 1 -4 d -3 Y -1 -5 d -3
- -3 d -5 -1 d -4 X -5 1 d -1 2 d -2 3 d s 1762 858 m 3 1 d 4 5 d -31 Y s 1790
- 836 m -2 -2 d 2 -1 d 1 1 d -1 2 d cl s 1822 864 m -14 -31 d s 1802 864 m 20 X s
- 1849 864 m -15 X -1 -14 d 1 2 d 5 1 d 4 X 5 -1 d 3 -3 d 1 -5 d -2 Y -1 -5 d -3
- -3 d -5 -1 d -4 X -5 1 d -1 2 d -2 3 d s 1902 886 m 2 Y 1 3 d 2 1 d 3 2 d 6 X 3
- -2 d 1 -1 d 1 -3 d -3 Y -1 -3 d -3 -5 d -15 -14 d 21 X s 873 683 m -651 497 d s
- 873 649 m 34 Y s 857 679 m 16 Y s 841 691 m 17 Y s 824 703 m 17 Y s 808 716 m
- 17 Y s 792 712 m 33 Y s 776 741 m 16 Y s 759 753 m 17 Y s 743 766 m 16 Y s 727
- 778 m 17 Y s 711 774 m 33 Y s 694 803 m 17 Y s 678 815 m 17 Y s 662 828 m 16 Y
- s 645 840 m 17 Y s 629 836 m 33 Y s 613 865 m 17 Y s 597 877 m 17 Y s 580 890 m
- 17 Y s 564 902 m 17 Y s 548 898 m 33 Y s 532 927 m 17 Y s 515 940 m 16 Y s 499
- 952 m 17 Y s 483 964 m 17 Y s 466 960 m 33 Y s 450 989 m 17 Y s 434 1002 m 16 Y
- s 418 1014 m 17 Y s 401 1027 m 16 Y s 385 1022 m 34 Y s 369 1051 m 17 Y s 352
- 1064 m 16 Y s 336 1076 m 17 Y s 320 1089 m 16 Y s 304 1084 m 34 Y s 287 1114 m
- 16 Y s 271 1126 m 17 Y s 255 1138 m 17 Y s 239 1151 m 16 Y s 222 1147 m 33 Y s
- 873 649 m 34 Y s 826 573 m 27 X s 865 583 m 2 Y 1 3 d 2 1 d 3 2 d 6 X 3 -2 d 1
- -1 d 2 -3 d -3 Y -2 -3 d -3 -5 d -15 -15 d 21 X s 704 635 m 26 X s 745 647 m 3
- 1 d 5 5 d -31 Y s 773 625 m -1 -2 d 1 -1 d 2 1 d -2 2 d cl s 803 653 m -15 X -1
- -14 d 1 2 d 5 1 d 4 X 5 -1 d 2 -3 d 2 -5 d -3 Y -2 -4 d -2 -3 d -5 -1 d -4 X -5
- 1 d -1 2 d -2 2 d s 663 697 m 27 X s 705 709 m 3 1 d 4 5 d -31 Y s 541 759 m 27
- X s 587 777 m -5 -2 d -2 -4 d -2 -7 d -5 Y 2 -7 d 2 -5 d 5 -1 d 3 X 4 1 d 3 5 d
- 2 7 d 5 Y -2 7 d -3 4 d -4 2 d -3 X cl s 611 749 m -2 -2 d 2 -1 d 1 1 d -1 2 d
- cl s 640 777 m -15 X -1 -13 d 1 1 d 5 2 d 4 X 5 -2 d 3 -3 d 1 -4 d -3 Y -1 -5 d
- -3 -3 d -5 -1 d -4 X -5 1 d -1 2 d -2 3 d s 537 839 m -5 -1 d -3 -5 d -1 -7 d
- -5 Y 1 -7 d 3 -5 d 5 -1 d 3 X 4 1 d 3 5 d 2 7 d 5 Y -2 7 d -3 5 d -4 1 d -3 X
- cl s 414 901 m -4 -1 d -3 -5 d -2 -7 d -5 Y 2 -7 d 3 -4 d 4 -2 d 3 X 5 2 d 3 4
- d 1 7 d 5 Y -1 7 d -3 5 d -5 1 d -3 X cl s 438 873 m -1 -1 d 1 -2 d 2 2 d -2 1
- d cl s 468 901 m -15 X -2 -13 d 2 1 d 4 2 d 5 X 4 -2 d 3 -3 d 2 -4 d -3 Y -2 -4
- d -3 -3 d -4 -2 d -5 X -4 2 d -2 1 d -1 3 d s 370 957 m 3 2 d 4 4 d -31 Y s 247
- 1020 m 3 1 d 5 5 d -32 Y s 275 997 m -1 -1 d 1 -2 d 2 2 d -2 1 d cl s 305 1026
- m -15 X -1 -14 d 1 2 d 5 1 d 4 X 4 -1 d 3 -3 d 2 -5 d -3 Y -2 -4 d -3 -3 d -4
- -2 d -4 X -5 2 d -1 1 d -2 3 d s 204 1080 m 2 Y 1 3 d 2 1 d 3 2 d 6 X 3 -2 d 1
- -1 d 2 -3 d -3 Y -2 -3 d -3 -5 d -15 -14 d 21 X s 222 1180 m 994 Y s 189 1180 m
- 33 X s 206 1207 m 16 X s 206 1234 m 16 X s 206 1261 m 16 X s 206 1287 m 16 X s
- 189 1314 m 33 X s 206 1341 m 16 X s 206 1368 m 16 X s 206 1395 m 16 X s 206
- 1422 m 16 X s 189 1449 m 33 X s 206 1476 m 16 X s 206 1502 m 16 X s 206 1529 m
- 16 X s 206 1556 m 16 X s 189 1583 m 33 X s 206 1610 m 16 X s 206 1637 m 16 X s
- 206 1664 m 16 X s 206 1690 m 16 X s 189 1717 m 33 X s 206 1744 m 16 X s 206
- 1771 m 16 X s 206 1798 m 16 X s 206 1825 m 16 X s 189 1852 m 33 X s 206 1879 m
- 16 X s 206 1905 m 16 X s 206 1932 m 16 X s 206 1959 m 16 X s 189 1986 m 33 X s
- 206 2013 m 16 X s 206 2040 m 16 X s 206 2067 m 16 X s 206 2094 m 16 X s 189
- 2120 m 33 X s 189 2120 m 33 X s 206 2147 m 16 X s 150 1195 m -4 -1 d -3 -4 d -1
- -8 d -4 Y 1 -8 d 3 -4 d 4 -2 d 3 X 5 2 d 3 4 d 1 8 d 4 Y -1 8 d -3 4 d -5 1 d
- -3 X cl s 116 1324 m 3 1 d 5 5 d -31 Y s 150 1330 m -4 -2 d -3 -4 d -1 -7 d -5
- Y 1 -7 d 3 -5 d 4 -1 d 3 X 5 1 d 3 5 d 1 7 d 5 Y -1 7 d -3 4 d -5 2 d -3 X cl s
- 113 1457 m 1 Y 2 3 d 1 2 d 3 1 d 6 X 3 -1 d 2 -2 d 1 -3 d -3 Y -1 -3 d -3 -4 d
- -15 -15 d 21 X s 150 1464 m -4 -1 d -3 -5 d -1 -7 d -5 Y 1 -7 d 3 -4 d 4 -2 d 3
- X 5 2 d 3 4 d 1 7 d 5 Y -1 7 d -3 5 d -5 1 d -3 X cl s 115 1599 m 16 X -9 -12 d
- 5 X 3 -2 d 1 -1 d 2 -5 d -3 Y -2 -4 d -3 -3 d -4 -2 d -5 X -4 2 d -2 1 d -1 3 d
- s 150 1599 m -4 -2 d -3 -4 d -1 -8 d -4 Y 1 -8 d 3 -4 d 4 -2 d 3 X 5 2 d 3 4 d
- 1 8 d 4 Y -1 8 d -3 4 d -5 2 d -3 X cl s 127 1733 m -15 -21 d 22 X s 127 1733 m
- -31 Y s 150 1733 m -4 -2 d -3 -4 d -1 -7 d -5 Y 1 -7 d 3 -5 d 4 -1 d 3 X 5 1 d
- 3 5 d 1 7 d 5 Y -1 7 d -3 4 d -5 2 d -3 X cl s 130 1867 m -15 X -2 -13 d 2 1 d
- 4 2 d 5 X 4 -2 d 3 -3 d 2 -4 d -3 Y -2 -4 d -3 -3 d -4 -2 d -5 X -4 2 d -2 1 d
- -1 3 d s 150 1867 m -4 -1 d -3 -5 d -1 -7 d -4 Y 1 -8 d 3 -4 d 4 -2 d 3 X 5 2 d
- 3 4 d 1 8 d 4 Y -1 7 d -3 5 d -5 1 d -3 X cl s 131 1997 m -1 3 d -5 2 d -3 X -4
- -2 d -3 -4 d -2 -8 d -7 Y 2 -6 d 3 -3 d 4 -1 d 2 X 4 1 d 3 3 d 2 4 d 2 Y -2 4 d
- -3 3 d -4 2 d -2 X -4 -2 d -3 -3 d -2 -4 d s 150 2002 m -4 -2 d -3 -4 d -1 -8 d
- -4 Y 1 -8 d 3 -4 d 4 -1 d 3 X 5 1 d 3 4 d 1 8 d 4 Y -1 8 d -3 4 d -5 2 d -3 X
- cl s 133 2136 m -15 -31 d s 112 2136 m 21 X s 150 2136 m -4 -1 d -3 -5 d -1 -7
- d -5 Y 1 -7 d 3 -5 d 4 -1 d 3 X 5 1 d 3 5 d 1 7 d 5 Y -1 7 d -3 5 d -5 1 d -3 X
- cl s 1040 539 m 9 -21 d s 1057 539 m -8 -21 d -3 -6 d -3 -3 d -3 -1 d -2 X s
- 1077 549 m 12 -31 d s 1100 549 m -11 -31 d s 1127 545 m -3 3 d -4 1 d -6 X -5
- -1 d -3 -3 d -3 Y 2 -3 d 1 -1 d 3 -2 d 9 -3 d 3 -1 d 2 -2 d 1 -3 d -4 Y -3 -3 d
- -4 -2 d -6 X -5 2 d -3 3 d s 1139 521 m -2 -1 d 2 -2 d 1 2 d -1 1 d cl s 1166
- 539 m 16 -21 d s 1182 539 m -16 -21 d s gr
-showpage
- gr
-%%Trailer
-%%Pages: 1
- gr gr
-%%EOF
diff --git a/src/pawlib/paw/testsuite/paw.commands/nt_pl_2d_surf3.ref.ps b/src/pawlib/paw/testsuite/paw.commands/nt_pl_2d_surf3.ref.ps
deleted file mode 100644
index b76b305..0000000
--- a/src/pawlib/paw/testsuite/paw.commands/nt_pl_2d_surf3.ref.ps
+++ /dev/null
@@ -1,3041 +0,0 @@
-%!PS-Adobe-2.0
-%%Title: /disk3/maartenb/cerncvs/paw/testsuite/tmp/nt_pl_2d_ (Portrait A 4)
-%%Pages: (atend)
-%%Creator: HIGZ Version 1.23/06
-%%CreationDate: 96/04/16 14.50
-%%EndComments
-%%BeginProlog
-/s {stroke} def /l {lineto} def /m {moveto} def /t {translate} def
-/sw {stringwidth} def /r {rotate} def /rl {roll} def /R {repeat} def
-/d {rlineto} def /rm {rmoveto} def /gr {grestore} def /f {eofill} def
-/c {setrgbcolor} def /lw {setlinewidth} def /sd {setdash} def
-/cl {closepath} def /sf {scalefont setfont} def /black {0 setgray} def
-/box {m dup 0 exch d exch 0 d 0 exch neg d cl} def
-/NC{systemdict begin initclip end}def/C{NC box clip newpath}def
-/bl {box s} def /bf {box f} def /Y { 0 exch d} def /X { 0 d} def
-/mp {newpath /y exch def /x exch def} def
-/side {[w .77 mul w .23 mul] .385 w mul sd w 0 l currentpoint t -144 r} def
-/mr {mp x y w2 0 360 arc} def /m24 {mr s} def /m20 {mr f} def
-/mb {mp x y w2 add m w2 neg 0 d 0 w neg d w 0 d 0 w d cl} def
-/mt {mp x y w2 add m w2 neg w neg d w 0 d cl} def
-/m21 {mb f} def /m25 {mb s} def /m22 {mt f} def /m26 {mt s} def
-/m23 {mp x y w2 sub m w2 w d w neg 0 d cl f} def
-/m27 {mp x y w2 add m w3 neg w2 neg d w3 w2 neg d w3 w2 d cl s} def
-/m28 {mp x w2 sub y w2 sub w3 add m w3 0 d 0 w3 neg d w3 0 d 0 w3 d w3 0 d
- 0 w3 d w3 neg 0 d 0 w3 d w3 neg 0 d
- 0 w3 neg d w3 neg 0 d cl s } def
-/m29 {mp gsave x w2 sub y w2 add w3 sub m currentpoint t
- 4 {side} repeat cl fill gr} def
-/m30 {mp gsave x w2 sub y w2 add w3 sub m currentpoint t
- 5 {side} repeat s gr} def
-/m31 {mp x y w2 sub m 0 w d x w2 sub y m w 0 d
- x w2 sub y w2 add m w w neg d x w2 sub y w2
- sub m w w d s} def
-/m2 {mp x y w2 sub m 0 w d x w2 sub y m w 0 d s} def
-/m5 {mp x w2 sub y w2 sub m w w d x w2 sub y w2 add m w w neg d s} def
-/DP {/PT exch def gsave 47.2 47.2 scale PT 1 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < AA AA 55 55 AA AA 55 55 AA AA 55 55 AA AA 55 55 AA AA 55 55 AA AA 55 55
-AA AA 55 55 AA AA 55 55 > } image } if PT 2 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < BB BB EE EE BB BB EE EE BB BB EE EE BB BB EE EE BB BB EE EE BB BB EE EE
-BB BB EE EE BB BB EE EE > } image } if PT 3 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < FF FF BB BB FF FF EE EE FF FF BB BB FF FF EE EE FF FF BB BB FF FF EE EE
-FF FF BB BB FF FF EE EE > } image } if PT 4 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < DF DF BF BF 7F 7F FE FE FD FD FB FB F7 F7 EF EF DF DF BF BF 7F 7F FE FE
-FD FD FB FB F7 F7 EF EF > } image } if PT 5 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < 7F 7F BF B F DF DF EF EF F7 F7 FB FB FD FD FE FE 7F 7F BF BF DF DF EF
-EF F7 F7 FB FB FD FD FE FE > } image } if PT 6 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB
-BB BB BB BB BB BB BB BB BB > } image } if PT 7 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < FF FF FF FF FF FF 00 00 FF FF FF FF FF FF 00 00 FF FF FF FF FF FF 00
-00 FF FF FF FF FF FF 00 00 > } image } if PT 8 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < EE EE 47 47 83 83 C5 C5 EE EE 5C 5C 38 38 74 74 EE EE 47 47 83 83 C5
-C5 EE EE 5C 5C 38 38 74 74 > } image } if PT 9 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < EF EF EF EF D7 D7 38 38 FE FE FE FE 7D 7D 83 83 EF EF EF EF D7 D7 38
-38 FE FE FE FE 7D 7D 83 83 > } image } if PT 10 eq { 16 16 1 [ 16 0 0 16 neg
-0 16 ] { < EF EF EF EF EF EF 00 00 FE FE FE FE FE FE 00 00 EF EF EF EF EF EF
-00 00 FE FE FE FE FE FE 00 00 > } image } if PT 11 eq { 16 16 1 [ 16 0 0 16
-neg 0 16 ] { < F7 F7 B6 B6 D5 D5 E3 E3 D5 D5 B6 B6 F7 F7 FF FF 7F 7F 6B 6B 5D
-5D 3E 3E 5D 5D 6B 6B 7F 7F FF FF > } image } if PT 12 eq { 16 16 1 [ 16 0 0
-16 neg 0 16 ] { < E3 E3 DD DD BE BE BE BE BE BE DD DD E3 E3 FF FF 3E 3E DD DD
-EB EB EB EB EB EB DD DD 3E 3E FF FF > } image } if PT 13 eq { 16 16 1 [ 16 0
-0 16 neg 0 16 ] { < FE FE 7D 7D BB BB D7 D7 EF EF D7 D7 BB BB 7D 7D FE FE 7D
-7D BB BB D7 D7 EF EF D7 D7 BB BB 7D 7D > } image } if PT 14 eq { 16 16 1 [ 16
-0 0 16 neg 0 16 ] { < 00 00 EE EF EE EF EE EF 0E E0 EE EE EE EE EE EE 00 EE
-FE EE FE EE FE EE 00 00 FE EF FE EF FE EF > } image } if PT 15 eq { 16 16 1 [
-16 0 0 16 neg 0 16 ] { < DD DD AA AA DD DD FF FF 77 77 AA AA 77 77 FF FF DD
-DD AA AA DD DD FF FF 77 77 AA AA 77 77 FF FF > } image } if PT 16 eq { 16 16
-1 [ 16 0 0 16 neg 0 16 ] { < F1 F1 EE EE 1F 1F FF FF F1 F1 EE EE 1F 1F FF FF
-F1 F1 EE EE 1F 1F FF FF F1 F1 EE EE 1F 1F FF FF > } image } if PT 17 eq { 16
-16 1 [ 16 0 0 16 neg 0 16 ] { < EE EE DD DD BB BB FF FF EE EE DD DD BB BB FF
- FF EE EE DD DD BB BB FF FF EE EE DD DD BB BB FF FF > } image } if PT 18 eq {
-16 16 1 [ 16 0 0 16 neg 0 16 ] { < BB BB DD DD EE EE FF FF BB BB DD DD EE EE
-FF FF BB BB DD DD EE EE FF FF BB BB DD DD EE EE FF FF > } image } if PT 19 eq
-{ 16 16 1 [ 16 0 0 16 neg 0 16 ] { < 1F FC 67 F3 7B EF BD DE BD DE DE BD E6
-B3 F8 0F E6 B3 DE BD BD DE BD DE 7B EF 67 F3 1F FC 7F FF > } image } if PT
-20 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < DD DD EE EE EE EE EE EE DD DD BB
-BB BB BB BB BB DD DD EE EE EE EE EE EE DD DD BB BB BB BB BB BB > } image }
-if PT 21 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < 0E 0E EF EF EF EF EF EF E0
-E0 FE FE FE FE FE FE 0E 0E EF EF EF EF EF EF E0 E0 FE FE FE FE FE FE > }
-image } if PT 22 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < 70 70 F7 F7 F7 F7 F7
-F7 07 07 7F 7F 7F 7F 7F 7F 70 70 F7 F7 F7 F7 F7 F7 07 07 7F 7F 7F 7F 7F 7F >
-} image } if PT 23 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < AA AA 55 55 A9 A9
-D1 D1 E1 E1 D1 D1 A9 A9 55 55 AA AA 55 55 A9 A9 D1 D1 E1 E1 D1 D1 A9 A9 55 55
-> } image } if PT 24 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < FF FE FF FC EA
-A8 D5 54 EA A8 D5 54 E8 28 D4 54 E8 E8 D4 D4 E8 EA 54 D5 A8 EA 54 D5 00 C0 00
-80 > } image } if PT 25 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < FF FE FF FC
-FF F8 FF F0 F0 00 F0 00 F0 20 F0 60 F0 E0 F1 E0 F3 E0 F0 00 E0 00 C0 00 80 00
-00 00 > } image } if gr } def /FA { /PT exch def gsave clip 0 0 translate 1 1
-54 { 1 sub 47.2 mul /Xcurr exch def 1 1 74 { 1 sub 47.2 mul /Ycurr exch def
-gsave Xcurr Ycurr translate PT DP gr } for } for gr } def
-/reencdict 24 dict def /ReEncode {reencdict begin /nco&na exch def
-/nfnam exch def /basefontname exch def /basefontdict basefontname findfont def
-/newfont basefontdict maxlength dict def basefontdict {exch dup /FID ne
-{dup /Encoding eq {exch dup length array copy newfont 3 1 roll put} {exch
-newfont 3 1 roll put} ifelse} {pop pop} ifelse } forall newfont
-/FontName nfnam put nco&na aload pop nco&na length 2 idiv {newfont
-/Encoding get 3 1 roll put} repeat nfnam newfont definefont pop end } def
-/accvec [ 176 /agrave 181 /Agrave 190 /acircumflex 192 /Acircumflex
-201 /adieresis 204 /Adieresis 209 /ccedilla 210 /Ccedilla 211 /eacute
-212 /Eacute 213 /egrave 214 /Egrave 215 /ecircumflex 216 /Ecircumflex
-217 /edieresis 218 /Edieresis 219 /icircumflex 220 /Icircumflex
-221 /idieresis 222 /Idieresis 223 /ntilde 224 /Ntilde 226 /ocircumflex
-228 /Ocircumflex 229 /odieresis 230 /Odieresis 231 /ucircumflex 236 /Ucircumflex
-237 /udieresis 238 /Udieresis 239 /aring 242 /Aring 243 /ydieresis
-244 /Ydieresis 246 /aacute 247 /Aacute 252 /ugrave 253 /Ugrave] def
-/Times-Roman /Times-Roman accvec ReEncode
-/Times-Italic /Times-Italic accvec ReEncode
-/Times-Bold /Times-Bold accvec ReEncode
-/Times-BoldItalic /Times-BoldItalic accvec ReEncode
-/Helvetica /Helvetica accvec ReEncode
-/Helvetica-Oblique /Helvetica-Oblique accvec ReEncode
-/Helvetica-Bold /Helvetica-Bold accvec ReEncode
-/Helvetica-BoldOblique /Helvetica-BoldOblique accvec ReEncode
-/Courier /Courier accvec ReEncode
-/Courier-Oblique /Courier-Oblique accvec ReEncode
-/Courier-Bold /Courier-Bold accvec ReEncode
-/Courier-BoldOblique /Courier-BoldOblique accvec ReEncode
-/oshow {gsave [] 0 sd true charpath stroke gr} def
-/stwn { /fs exch def /fn exch def /text exch def fn findfont fs sf
- text sw pop xs add /xs exch def} def
-/stwb { /fs exch def /fn exch def /nbas exch def /textf exch def
-textf length /tlen exch def nbas tlen gt {/nbas tlen def} if
-fn findfont fs sf textf dup length nbas sub nbas getinterval sw
-pop neg xs add /xs exch def} def
-/accspe [ 65 /plusminus 66 /bar 67 /existential 68 /universal
-69 /exclam 70 /numbersign 71 /greater 72 /question 73 /integral
-74 /colon 75 /semicolon 76 /less 77 /bracketleft 78 /bracketright
-79 /greaterequal 80 /braceleft 81 /braceright 82 /radical
-83 /spade 84 /heart 85 /diamond 86 /club 87 /lessequal
-88 /multiply 89 /percent 90 /infinity 48 /circlemultiply 49 /circleplus
-50 /emptyset 51 /lozenge 52 /bullet 53 /arrowright 54 /arrowup
-55 /arrowleft 56 /arrowdown 57 /arrowboth 48 /degree 44 /comma 43 /plus
- 45 /angle 42 /angleleft 47 /divide 61 /notequal 40 /equivalence 41 /second
- 97 /approxequal 98 /congruent 99 /perpendicular 100 /partialdiff 101 /florin
- 102 /intersection 103 /union 104 /propersuperset 105 /reflexsuperset
- 106 /notsubset 107 /propersubset 108 /reflexsubset 109 /element 110 /notelement
- 111 /gradient 112 /logicaland 113 /logicalor 114 /arrowdblboth
- 115 /arrowdblleft 116 /arrowdblup 117 /arrowdblright 118 /arrowdbldown
- 119 /ampersand 120 /omega1 121 /similar 122 /aleph ] def
-/Symbol /Special accspe ReEncode
-/Zone {/iy exch def /ix exch def ix 1 sub 2224 mul 1 iy sub 3144
- mul t} def
-%%EndProlog
- gsave 20 28 t .25 .25 scale gsave
-%%Page: number 1
- gsave
- 1 1 Zone
- gsave 0 0 t black [] 0 sd 1 lw 2223 2224 0 460 bl 2223 2224 0 460 C 1779 1778
- 222 683 C NC 0 0 0.8 c 1345 2429 m 24 6 d -21 15 d -23 -6 d f 1322 2423 m 23 6
- d -20 15 d -24 -6 d f 1298 2417 m 24 6 d -21 15 d -23 -5 d f 1275 2411 m 23 6 d
- -20 16 d -24 -6 d f 1251 2405 m 24 6 d -21 16 d -23 -6 d f 1228 2399 m 23 6 d
- -20 16 d -24 -6 d f 1204 2393 m 24 6 d -21 16 d -23 -6 d f 1181 2387 m 23 6 d
- -20 16 d -24 -6 d f 1157 2381 m 24 6 d -21 16 d -23 -6 d f 1134 2375 m 23 6 d
- -20 16 d -24 -6 d f 1110 2369 m 24 6 d -21 16 d -23 -6 d f 1087 2363 m 23 6 d
- -20 16 d -24 -6 d f 1063 2357 m 24 6 d -21 16 d -23 -6 d f 1040 2351 m 23 6 d
- -20 16 d -24 -6 d f 1016 2345 m 24 6 d -21 16 d -23 -6 d f 993 2339 m 23 6 d
- -20 16 d -24 -6 d f 969 2333 m 24 6 d -21 16 d -23 -6 d f 946 2327 m 23 6 d -20
- 16 d -24 -6 d f 922 2321 m 24 6 d -21 16 d -23 -6 d f 899 2315 m 23 6 d -20 16
- d -24 -6 d f 875 2309 m 24 6 d -21 16 d -23 -6 d f 852 2303 m 23 6 d -20 16 d
- -24 -6 d f 828 2297 m 24 6 d -21 16 d -23 -6 d f 805 2291 m 23 6 d -20 16 d -24
- -6 d f 781 2285 m 24 6 d -21 16 d -23 -6 d f 758 2279 m 23 6 d -20 16 d -24 -6
- d f 734 2273 m 24 6 d -21 16 d -23 -6 d f 711 2267 m 23 6 d -20 16 d -23 -6 d f
- 687 2262 m 24 5 d -20 16 d -24 -6 d f 664 2256 m 23 6 d -20 15 d -23 -6 d f 640
- 2250 m 24 6 d -20 15 d -24 -6 d f 617 2244 m 23 6 d -20 15 d -23 -6 d f 593
- 2238 m 24 6 d -20 15 d -24 -6 d f 570 2232 m 23 6 d -20 15 d -23 -6 d f 546
- 2226 m 24 6 d -20 15 d -24 -6 d f 523 2220 m 23 6 d -20 15 d -23 -6 d f 499
- 2214 m 24 6 d -20 15 d -24 -6 d f 476 2208 m 23 6 d -20 15 d -23 -6 d f 452
- 2202 m 24 6 d -20 15 d -24 -6 d f 429 2196 m 23 6 d -20 15 d -23 -6 d f 405
- 2190 m 24 6 d -20 15 d -24 -6 d f 382 2184 m 23 6 d -20 15 d -23 -6 d f 359
- 2178 m 23 6 d -20 15 d -24 -6 d f 335 2172 m 24 6 d -21 15 d -23 -6 d f 312
- 2166 m 23 6 d -20 15 d -24 -6 d f 288 2160 m 24 6 d -21 15 d -23 -6 d f 265
- 2154 m 23 6 d -20 15 d -24 -6 d f 1365 2413 m 24 6 d -20 16 d -24 -6 d f 1342
- 2407 m 23 6 d -20 16 d -23 -6 d f 1318 2401 m 24 6 d -20 16 d -24 -6 d f 1295
- 2395 m 23 6 d -20 16 d -23 -6 d f 1271 2389 m 24 6 d -20 16 d -24 -6 d f 1248
- 2384 m 23 5 d -20 16 d -23 -6 d f 1224 2378 m 24 6 d -20 15 d -24 -6 d f 1201
- 2372 m 23 6 d -20 15 d -23 -6 d f 1177 2366 m 24 6 d -20 15 d -24 -6 d f 1154
- 2360 m 23 6 d -20 15 d -23 -6 d f 1131 2354 m 23 6 d -20 15 d -24 -6 d f 1107
- 2348 m 24 6 d -21 15 d -23 -6 d f 1084 2342 m 23 6 d -20 15 d -24 -6 d f 1060
- 2336 m 24 6 d -21 15 d -23 -6 d f 1037 2330 m 23 6 d -20 15 d -24 -6 d f 1013
- 2324 m 24 6 d -21 15 d -23 -6 d f 990 2318 m 23 6 d -20 15 d -24 -6 d f 966
- 2312 m 24 6 d -21 15 d -23 -6 d f 943 2306 m 23 6 d -20 15 d -24 -6 d f 919
- 2300 m 24 6 d -21 15 d -23 -6 d f 896 2294 m 23 6 d -20 15 d -24 -6 d f 872
- 2288 m 24 6 d -21 15 d -23 -6 d f 849 2282 m 23 6 d -20 15 d -24 -6 d f 825
- 2276 m 24 6 d -21 15 d -23 -6 d f 802 2270 m 23 6 d -20 15 d -24 -6 d f 778
- 2264 m 24 6 d -21 15 d -23 -6 d f 755 2258 m 23 6 d -20 15 d -24 -6 d f 731
- 2252 m 24 6 d -21 15 d -23 -6 d f 708 2246 m 23 6 d -20 15 d -24 -5 d f 684
- 2240 m 24 6 d -21 16 d -23 -6 d f 661 2234 m 23 6 d -20 16 d -24 -6 d f 637
- 2228 m 24 6 d -21 16 d -23 -6 d f 614 2222 m 23 6 d -20 16 d -24 -6 d f 590
- 2216 m 24 6 d -21 16 d -23 -6 d f 567 2210 m 23 6 d -20 16 d -24 -6 d f 543
- 2204 m 24 6 d -21 16 d -23 -6 d f 520 2198 m 23 6 d -20 16 d -24 -6 d f 496
- 2192 m 24 6 d -21 16 d -23 -6 d f 473 2186 m 23 6 d -20 16 d -24 -6 d f 449
- 2180 m 24 6 d -21 16 d -23 -6 d f 426 2174 m 23 6 d -20 16 d -24 -6 d f 402
- 2168 m 24 6 d -21 16 d -23 -6 d f 379 2162 m 23 6 d -20 16 d -23 -6 d f 355
- 2156 m 24 6 d -20 16 d -24 -6 d f 332 2150 m 23 6 d -20 16 d -23 -6 d f 308
- 2144 m 24 6 d -20 16 d -24 -6 d f 285 2138 m 23 6 d -20 16 d -23 -6 d f 1386
- 2398 m 23 6 d -20 15 d -24 -6 d f 1362 2392 m 24 6 d -21 15 d -23 -6 d f 1339
- 2386 m 23 6 d -20 15 d -24 -6 d f 1315 2380 m 24 6 d -21 15 d -23 -6 d f 1292
- 2374 m 23 6 d -20 15 d -24 -6 d f 1268 2368 m 24 6 d -21 15 d -23 -5 d f 1245
- 2362 m 23 6 d -20 16 d -24 -6 d f 1221 2356 m 24 6 d -21 16 d -23 -6 d f 1198
- 2350 m 23 6 d -20 16 d -24 -6 d f 1174 2344 m 24 6 d -21 16 d -23 -6 d f 1151
- 2338 m 23 6 d -20 16 d -23 -6 d f 1127 2332 m 24 6 d -20 16 d -24 -6 d f 1104
- 2326 m 23 6 d -20 16 d -23 -6 d f 1080 2320 m 24 6 d -20 16 d -24 -6 d f 1057
- 2314 m 23 6 d -20 16 d -23 -6 d f 1033 2308 m 24 6 d -20 16 d -24 -6 d f 1010
- 2302 m 23 6 d -20 16 d -23 -6 d f 986 2296 m 24 6 d -20 16 d -24 -6 d f 963
- 2290 m 23 6 d -20 16 d -23 -6 d f 939 2284 m 24 6 d -20 16 d -24 -6 d f 916
- 2278 m 23 6 d -20 16 d -23 -6 d f 892 2272 m 24 6 d -20 16 d -24 -6 d f 869
- 2266 m 23 6 d -20 16 d -23 -6 d f 845 2260 m 24 6 d -20 16 d -24 -6 d f 822
- 2254 m 23 6 d -20 16 d -23 -6 d f 799 2248 m 23 6 d -20 16 d -24 -6 d f 775
- 2242 m 24 6 d -21 16 d -23 -6 d f 752 2236 m 23 6 d -20 16 d -24 -6 d f 728
- 2230 m 24 6 d -21 16 d -23 -6 d f 705 2224 m 23 6 d -20 16 d -24 -6 d f 681
- 2218 m 24 6 d -21 16 d -23 -6 d f 658 2212 m 23 6 d -20 16 d -24 -6 d f 634
- 2207 m 24 5 d -21 16 d -23 -6 d f 611 2201 m 23 6 d -20 15 d -24 -6 d f 587
- 2195 m 24 6 d -21 15 d -23 -6 d f 564 2189 m 23 6 d -20 15 d -24 -6 d f 540
- 2183 m 24 6 d -21 15 d -23 -6 d f 517 2177 m 23 6 d -20 15 d -24 -6 d f 493
- 2171 m 24 6 d -21 15 d -23 -6 d f 470 2165 m 23 6 d -20 15 d -24 -6 d f 446
- 2159 m 24 6 d -21 15 d -23 -6 d f 423 2153 m 23 6 d -20 15 d -24 -6 d f 399
- 2147 m 24 6 d -21 15 d -23 -6 d f 376 2141 m 23 6 d -20 15 d -24 -6 d f 352
- 2135 m 24 6 d -21 15 d -23 -6 d f 329 2129 m 23 6 d -20 15 d -24 -6 d f 305
- 2123 m 24 6 d -21 15 d -23 -6 d f 1406 2382 m 24 6 d -21 16 d -23 -6 d f 1383
- 2376 m 23 6 d -20 16 d -24 -6 d f 1359 2370 m 24 6 d -21 16 d -23 -6 d f 1336
- 2364 m 23 6 d -20 16 d -24 -6 d f 1312 2358 m 24 6 d -21 16 d -23 -6 d f 1289
- 2352 m 23 6 d -20 16 d -24 -6 d f 1265 2346 m 24 6 d -21 16 d -23 -6 d f 1242
- 2340 m 23 6 d -20 16 d -24 -6 d f 1218 2334 m 24 6 d -21 16 d -23 -6 d f 1195
- 2329 m 23 5 d -20 16 d -24 -6 d f 1171 2323 m 24 6 d -21 15 d -23 -6 d f 1148
- 2317 m 23 6 d -20 15 d -24 -6 d f 1124 2311 m 24 6 d -21 15 d -23 -6 d f 1101
- 2305 m 23 6 d -20 15 d -24 -6 d f 1077 2299 m 24 6 d -21 15 d -23 -6 d f 1054
- 2293 m 23 6 d -20 15 d -24 -6 d f 1030 2287 m 24 6 d -21 15 d -23 -6 d f 1007
- 2281 m 23 6 d -20 15 d -24 -6 d f 983 2275 m 24 6 d -21 15 d -23 -6 d f 960
- 2269 m 23 6 d -20 15 d -24 -6 d f 936 2263 m 24 6 d -21 15 d -23 -6 d f 913
- 2257 m 23 6 d -20 15 d -24 -6 d f 889 2251 m 24 6 d -21 15 d -23 -6 d f 866
- 2245 m 23 6 d -20 15 d -24 -6 d f 842 2239 m 24 6 d -21 15 d -23 -6 d f 819
- 2233 m 23 6 d -20 15 d -23 -6 d f 795 2227 m 24 6 d -20 15 d -24 -6 d f 772
- 2221 m 23 6 d -20 15 d -23 -6 d f 748 2215 m 24 6 d -20 15 d -24 -6 d f 725
- 2209 m 23 6 d -20 15 d -23 -6 d f 701 2203 m 24 6 d -20 15 d -24 -6 d f 678
- 2197 m 23 6 d -20 15 d -23 -6 d f 654 2191 m 24 6 d -20 15 d -24 -5 d f 631
- 2185 m 23 6 d -20 16 d -23 -6 d f 607 2179 m 24 6 d -20 16 d -24 -6 d f 584
- 2173 m 23 6 d -20 16 d -23 -6 d f 560 2167 m 24 6 d -20 16 d -24 -6 d f 537
- 2161 m 23 6 d -20 16 d -23 -6 d f 513 2155 m 24 6 d -20 16 d -24 -6 d f 490
- 2149 m 23 6 d -20 16 d -23 -6 d f 467 2143 m 23 6 d -20 16 d -24 -6 d f 443
- 2137 m 24 6 d -21 16 d -23 -6 d f 420 2131 m 23 6 d -20 16 d -24 -6 d f 396
- 2125 m 24 6 d -21 16 d -23 -6 d f 373 2119 m 23 6 d -20 16 d -24 -6 d f 349
- 2113 m 24 6 d -21 16 d -23 -6 d f 326 2107 m 23 6 d -20 16 d -24 -6 d f 1426
- 2367 m 24 6 d -20 15 d -24 -6 d f 1403 2361 m 23 6 d -20 15 d -23 -6 d f 1379
- 2355 m 24 6 d -20 15 d -24 -6 d f 1356 2349 m 23 6 d -20 15 d -23 -6 d f 1332
- 2343 m 24 6 d -20 15 d -24 -6 d f 1309 2337 m 23 6 d -20 15 d -23 -6 d f 1285
- 2331 m 24 6 d -20 15 d -24 -6 d f 1262 2325 m 23 6 d -20 15 d -23 -6 d f 1239
- 2319 m 23 6 d -20 15 d -24 -6 d f 1215 2313 m 24 6 d -21 15 d -23 -5 d f 1192
- 2307 m 23 6 d -20 16 d -24 -6 d f 1168 2301 m 24 6 d -21 16 d -23 -6 d f 1145
- 2295 m 23 6 d -20 16 d -24 -6 d f 1121 2289 m 24 6 d -21 16 d -23 -6 d f 1098
- 2283 m 23 6 d -20 16 d -24 -6 d f 1074 2277 m 24 6 d -21 16 d -23 -6 d f 1051
- 2271 m 23 6 d -20 16 d -24 -6 d f 1027 2265 m 24 6 d -21 16 d -23 -6 d f 1004
- 2259 m 23 6 d -20 16 d -24 -6 d f 980 2253 m 24 6 d -21 16 d -23 -6 d f 957
- 2247 m 23 6 d -20 16 d -24 -6 d f 933 2241 m 24 6 d -21 16 d -23 -6 d f 910
- 2235 m 23 6 d -20 16 d -24 -6 d f 886 2229 m 24 6 d -21 16 d -23 -6 d f 863
- 2223 m 23 6 d -20 16 d -24 -6 d f 839 2217 m 24 6 d -21 16 d -23 -6 d f 816
- 2211 m 23 6 d -20 16 d -24 -6 d f 792 2205 m 24 6 d -21 16 d -23 -6 d f 769
- 2199 m 23 6 d -20 16 d -24 -6 d f 745 2193 m 24 6 d -21 16 d -23 -6 d f 722
- 2187 m 23 6 d -20 16 d -24 -6 d f 698 2181 m 24 6 d -21 16 d -23 -6 d f 675
- 2175 m 23 6 d -20 16 d -24 -6 d f 651 2169 m 24 6 d -21 16 d -23 -6 d f 628
- 2163 m 23 6 d -20 16 d -24 -6 d f 604 2158 m 24 5 d -21 16 d -23 -6 d f 581
- 2152 m 23 6 d -20 15 d -24 -6 d f 557 2146 m 24 6 d -21 15 d -23 -6 d f 534
- 2140 m 23 6 d -20 15 d -24 -6 d f 510 2134 m 24 6 d -21 15 d -23 -6 d f 487
- 2128 m 23 6 d -20 15 d -23 -6 d f 463 2122 m 24 6 d -20 15 d -24 -6 d f 440
- 2116 m 23 6 d -20 15 d -23 -6 d f 416 2110 m 24 6 d -20 15 d -24 -6 d f 393
- 2104 m 23 6 d -20 15 d -23 -6 d f 369 2098 m 24 6 d -20 15 d -24 -6 d f 346
- 2092 m 23 6 d -20 15 d -23 -6 d f 1447 2351 m 23 6 d -20 16 d -24 -6 d f 1423
- 2345 m 24 6 d -21 16 d -23 -6 d f 1400 2339 m 23 6 d -20 16 d -24 -6 d f 1378
- 2334 m 22 5 d -21 16 d -23 -6 d 18 -14 d f 0 0.2 0.8 c 1376 2333 m 2 1 d -4 1 d
- f 0 0 0.8 c 1353 2327 m 22 6 d -1 2 d -18 14 d -24 -6 d f 0 0.2 0.8 c 1375 2333
- m 1 X -2 2 d f 0 0 0.8 c 1329 2321 m 24 6 d -21 16 d -23 -6 d f 1306 2315 m 23
- 6 d -20 16 d -24 -6 d f 1282 2309 m 24 6 d -21 16 d -23 -6 d f 1259 2303 m 23 6
- d -20 16 d -23 -6 d f 1242 2299 m 17 4 d -20 16 d -24 -6 d 13 -10 d f 0 0.2 0.8
- c 1235 2297 m 7 2 d -14 4 d f 0 0 0.8 c 1228 2303 m -13 10 d -23 -6 d 6 -5 d f
- 0 0.2 0.8 c 1212 2291 m 23 6 d -7 6 d -30 -1 d f 0 0 0.8 c 1188 2285 m 13 4 d
- -3 13 d -6 5 d -24 -6 d f 0 0.2 0.8 c 1201 2289 m 11 2 d -14 11 d f 0 0 0.8 c
- 1167 2280 m 21 5 d -20 16 d -23 -6 d 17 -14 d f 0 0.2 0.8 c 1165 2280 m 2 X -5
- 1 d f 0 0 0.8 c 1141 2274 m 15 3 d 6 4 d -17 14 d -24 -6 d f 0 0.2 0.8 c 1156
- 2277 m 9 3 d -3 1 d f 0 0 0.8 c 1118 2268 m 23 6 d -20 15 d -23 -6 d f 1094
- 2262 m 24 6 d -20 15 d -24 -6 d f 1087 2260 m 7 2 d -20 15 d -23 -6 d 10 -8 d f
- 0 0.2 0.8 c 1071 2256 m 16 4 d -26 3 d f 0 0 0.8 c 1047 2250 m 8 2 d 6 11 d -10
- 8 d -24 -6 d f 0 0.2 0.8 c 1055 2252 m 16 4 d -10 7 d f 0 0 0.8 c 1024 2244 m
- 23 6 d -20 15 d -23 -6 d f 1000 2238 m 24 6 d -20 15 d -24 -6 d f 977 2232 m 23
- 6 d -20 15 d -23 -6 d f 956 2226 m 21 6 d -20 15 d -24 -6 d 19 -14 d f 0 0.2
- 0.8 c 953 2226 m 3 X -4 1 d f 0 0 0.8 c 952 2227 m -19 14 d -23 -6 d 17 -13 d f
- 0 0.2 0.8 c 930 2220 m 23 6 d -1 1 d -25 -5 d f 0 0 0.8 c 927 2222 m -17 13 d
- -24 -6 d 19 -14 d f 0 0.2 0.8 c 907 2214 m 23 6 d -3 2 d -22 -7 d f 0 0 0.8 c
- 883 2208 m 21 5 d 1 2 d -19 14 d -23 -6 d f 0 0.2 0.8 c 904 2213 m 3 1 d -2 1 d
- f 0 0 0.8 c 860 2202 m 23 6 d -20 15 d -24 -6 d f 852 2200 m 8 2 d -21 15 d -23
- -6 d 6 -5 d f 0 0.2 0.8 c 836 2196 m 16 4 d -30 6 d f 0 0 0.8 c 822 2206 m -6 5
- d -24 -6 d 13 -9 d f 0 0.2 0.8 c 813 2190 m 23 6 d -14 10 d -17 -10 d f 0 0 0.8
- c 789 2184 m 12 3 d 4 9 d -13 9 d -23 -6 d f 0 0.2 0.8 c 801 2187 m 12 3 d -8 6
- d f 0 0 0.8 c 766 2178 m 23 6 d -20 15 d -24 -6 d f 742 2172 m 24 6 d -21 15 d
- -23 -6 d f 719 2166 m 23 6 d -20 15 d -24 -6 d f 704 2162 m 15 4 d -21 15 d -23
- -6 d 12 -9 d f 0 0.2 0.8 c 695 2160 m 9 2 d -17 4 d f 0 0 0.8 c 672 2154 m 9 2
- d 6 10 d -12 9 d -24 -6 d f 0 0.2 0.8 c 681 2156 m 14 4 d -8 6 d f 0 0 0.8 c
- 648 2148 m 24 6 d -21 15 d -23 -6 d f 625 2142 m 23 6 d -20 15 d -24 -5 d f 601
- 2136 m 24 6 d -21 16 d -23 -6 d f 578 2130 m 23 6 d -20 16 d -24 -6 d f 554
- 2124 m 24 6 d -21 16 d -23 -6 d f 531 2118 m 23 6 d -20 16 d -24 -6 d f 507
- 2112 m 24 6 d -21 16 d -23 -6 d f 500 2110 m 7 2 d -20 16 d -24 -6 d 15 -12 d f
- 0 0.2 0.8 c 484 2106 m 16 4 d -22 X f 0 0 0.8 c 460 2100 m 17 4 d 1 6 d -15 12
- d -23 -6 d f 0 0.2 0.8 c 477 2104 m 7 2 d -6 4 d f 0 0 0.8 c 437 2094 m 23 6 d
- -20 16 d -24 -6 d f 413 2088 m 24 6 d -21 16 d -23 -6 d f 390 2082 m 23 6 d -20
- 16 d -24 -6 d f 366 2076 m 24 6 d -21 16 d -23 -6 d f 1467 2336 m 24 6 d -21 15
- d -23 -6 d f 1444 2330 m 23 6 d -20 15 d -24 -6 d f 1420 2324 m 24 6 d -21 15 d
- -23 -6 d f 1397 2318 m 23 6 d -20 15 d -22 -5 d 6 -7 d f 0 0.2 0.8 c 1378 2334
- m -2 -1 d 8 -6 d f 0 0 0.8 c 1373 2312 m 24 6 d -13 9 d -9 6 d -22 -6 d f 0 0.2
- 0.8 c 1384 2327 m -8 6 d -1 X f 0 0 0.8 c 1368 2311 m 5 1 d -20 15 d -24 -6 d
- 13 -9 d f 0 0.2 0.8 c 1350 2306 m 18 5 d -26 1 d f 0 0 0.8 c 1342 2312 m -13 9
- d -23 -6 d 8 -6 d f 0 0.2 0.8 c 1326 2300 m 24 6 d -8 6 d -28 -3 d f 0 0 0.8 c
- 1303 2294 m 12 3 d -1 12 d -8 6 d -24 -6 d f 0 0.2 0.8 c 1315 2297 m 11 3 d -12
- 9 d f 0 0 0.8 c 1290 2291 m 13 3 d -21 15 d -23 -6 d 12 -9 d f 0 0.2 0.8 c 1279
- 2288 m 11 3 d -19 3 d f 0 0 0.8 c 1271 2294 m -12 9 d -17 -4 d f 0 0.2 0.8 c
- 1256 2282 m 23 6 d -8 6 d -29 5 d -7 -2 d f 1232 2276 m 24 6 d -21 15 d -23 -6
- d f 0 0 0.8 c 1201 2289 m -13 -4 d 15 -11 d f 0 0.2 0.8 c 1209 2270 m 23 6 d
- -20 15 d -11 -2 d 2 -15 d f 0 0 0.8 c 1203 2274 m -15 11 d -21 -5 d f 0 0.2 0.8
- c 1185 2264 m 24 6 d -6 4 d -36 6 d -2 X f 0 0 0.8 c 1162 2258 m 12 3 d -18 16
- d -15 -3 d f 0 0.2 0.8 c 1174 2261 m 11 3 d -20 16 d -9 -3 d f 0 0 0.8 c 1138
- 2252 m 24 6 d -21 16 d -23 -6 d f 1115 2246 m 23 6 d -20 16 d -24 -6 d f 1112
- 2245 m 3 1 d -21 16 d -7 -2 d f 0 0.2 0.8 c 1094 2241 m 18 4 d -25 15 d -16 -4
- d 13 -10 d f 0 0.4 0.8 c 1091 2240 m 3 1 d -10 5 d f 0 0 0.8 c 1055 2252 m -8
- -2 d 9 -7 d f 0 0.2 0.8 c 1068 2234 m 17 5 d -1 7 d -13 10 d -16 -4 d 1 -9 d f
- 0 0.4 0.8 c 1085 2239 m 6 1 d -7 6 d f 0 0 0.8 c 1044 2228 m 5 1 d 7 14 d -9 7
- d -23 -6 d f 0 0.2 0.8 c 1049 2229 m 19 5 d -12 9 d f 0 0 0.8 c 1037 2226 m 7 2
- d -20 16 d -24 -6 d 7 -5 d f 0 0.2 0.8 c 1021 2222 m 16 4 d -30 7 d f 0 0 0.8 c
- 997 2216 m 16 4 d -6 13 d -7 5 d -23 -6 d f 0 0.2 0.8 c 1013 2220 m 8 2 d -14
- 11 d f 0 0 0.8 c 987 2214 m 10 2 d -20 16 d -21 -6 d f 0 0.2 0.8 c 974 2210 m
- 13 4 d -31 12 d -3 X f 950 2204 m 24 6 d -21 16 d -23 -6 d f 927 2198 m 23 6 d
- -20 16 d -23 -6 d f 0 0 0.8 c 903 2192 m 9 2 d -8 19 d -21 -5 d f 0 0.2 0.8 c
- 912 2194 m 15 4 d -20 16 d -3 -1 d f 0 0 0.8 c 883 2187 m 20 5 d -20 16 d -23
- -6 d 12 -10 d f 0 0.2 0.8 c 880 2186 m 3 1 d -11 5 d f 0 0 0.8 c 856 2180 m 21
- 5 d -5 7 d -12 10 d -8 -2 d -9 -10 d f 0 0.2 0.8 c 877 2185 m 3 1 d -8 6 d -20
- 8 d -16 -4 d 7 -6 d f 0 0 0.8 c 833 2174 m 23 6 d -13 10 d -18 -9 d f 0 0.2 0.8
- c 843 2190 m -7 6 d -23 -6 d 12 -9 d f 0 0 0.8 c 814 2169 m 19 5 d -8 7 d -24 6
- d -12 -3 d 18 -14 d f 0 0.2 0.8 c 809 2168 m 5 1 d 11 12 d -12 9 d -12 -3 d 6
- -17 d f 0 0 0.8 c 807 2170 m -18 14 d -23 -6 d 11 -9 d f 0 0.2 0.8 c 786 2162 m
- 23 6 d -2 2 d -30 -1 d f 0 0 0.8 c 777 2169 m -11 9 d -24 -6 d 13 -10 d f 0 0.2
- 0.8 c 762 2156 m 24 6 d -9 7 d -22 -7 d f 0 0 0.8 c 739 2150 m 15 4 d 1 8 d -13
- 10 d -23 -6 d f 0 0.2 0.8 c 754 2154 m 8 2 d -7 6 d f 0 0 0.8 c 715 2144 m 24 6
- d -20 16 d -15 -4 d 3 -11 d f 0 0.2 0.8 c 704 2162 m -9 -2 d 12 -9 d f 0 0 0.8
- c 703 2141 m 12 3 d -8 7 d -26 5 d -9 -2 d 11 -8 d f 0 0.2 0.8 c 692 2138 m 11
- 3 d 4 10 d -12 9 d -14 -4 d 2 -10 d f 0 0 0.8 c 668 2132 m 13 4 d 2 10 d -11 8
- d -24 -6 d f 0 0.2 0.8 c 681 2136 m 11 2 d -9 8 d f 0 0 0.8 c 645 2126 m 23 6 d
- -20 16 d -23 -6 d f 640 2125 m 5 1 d -20 16 d -24 -6 d 11 -8 d f 0 0.2 0.8 c
- 622 2120 m 18 5 d -28 3 d f 0 0 0.8 c 612 2128 m -11 8 d -23 -6 d 9 -7 d f 0
- 0.2 0.8 c 598 2114 m 24 6 d -10 8 d -25 -5 d f 0 0 0.8 c 587 2123 m -9 7 d -24
- -6 d 17 -13 d f 0 0.2 0.8 c 575 2109 m 23 5 d -11 9 d -16 -12 d f 0 0 0.8 c 571
- 2111 m -17 13 d -23 -6 d 6 -5 d f 0 0.2 0.8 c 551 2103 m 24 6 d -4 2 d -34 2 d
- f 0 0 0.8 c 537 2113 m -6 5 d -24 -6 d 3 -2 d f 0 0.2 0.8 c 528 2097 m 23 6 d
- -14 10 d -27 -3 d f 0 0 0.8 c 504 2091 m 4 X 2 19 d -3 2 d -7 -2 d -2 -15 d f 0
- 0.2 0.8 c 508 2091 m 20 6 d -18 13 d -10 X -16 -4 d 14 -11 d f 0 0 0.8 c 499
- 2089 m 5 2 d -6 4 d -21 9 d -17 -4 d 13 -9 d f 0 0.2 0.8 c 481 2085 m 18 4 d -1
- 6 d -14 11 d -7 -2 d -4 -13 d f 0 0 0.8 c 457 2079 m 16 4 d 8 Y -13 9 d -23 -6
- d f 0 0.2 0.8 c 473 2083 m 8 2 d -8 6 d f 0 0 0.8 c 434 2073 m 23 6 d -20 15 d
- -24 -6 d f 410 2067 m 24 6 d -21 15 d -23 -6 d f 387 2061 m 23 6 d -20 15 d -24
- -6 d f 1487 2320 m 24 6 d -20 16 d -24 -6 d f 1464 2314 m 23 6 d -20 16 d -23
- -6 d f 1440 2308 m 24 6 d -20 16 d -24 -6 d f 1430 2305 m 10 3 d -20 16 d -23
- -6 d 2 -2 d f 0 0.2 0.8 c 1419 2303 m 11 2 d -31 11 d 15 -12 d f 0 0.4 0.8 c
- 1417 2302 m 2 1 d -5 1 d f 0 0 0.8 c 1399 2316 m -2 2 d -24 -6 d 2 -2 d f 0 0.2
- 0.8 c 1414 2304 m -15 12 d -24 -6 d 13 -10 d f 0 0.4 0.8 c 1393 2296 m 24 6 d
- -3 2 d -26 -4 d f 0 0 0.8 c 1375 2310 m -2 2 d -5 -1 d f 0 0.2 0.8 c 1388 2300
- m -13 10 d -7 1 d -18 -5 d 15 -12 d f 0 0.4 0.8 c 1370 2290 m 23 6 d -5 4 d -23
- -6 d f 0 0.2 0.8 c 1347 2284 m 5 2 d 13 8 d -15 12 d -24 -6 d f 0 0.4 0.8 c
- 1352 2286 m 18 4 d -5 4 d f 0 0 0.8 c 1315 2297 m -12 -3 d 5 -4 d f 0 0.2 0.8 c
- 1345 2284 m 2 X -21 16 d -11 -3 d -7 -7 d 9 -7 d f 0 0.4 0.8 c 1323 2278 m 22 6
- d -28 -1 d f 0 0 0.8 c 1300 2272 m 4 1 d 4 17 d -5 4 d -13 -3 d 1 -12 d f 0 0.2
- 0.8 c 1304 2273 m 12 4 d 1 6 d -9 7 d -18 1 d -11 -3 d 12 -9 d f 0 0.4 0.8 c
- 1316 2277 m 7 1 d -6 5 d f 0 0 0.8 c 1276 2266 m 24 6 d -9 7 d -22 -8 d f 0 0.2
- 0.8 c 1291 2279 m -12 9 d -23 -6 d 13 -11 d f 0 0 0.8 c 1270 2265 m 6 1 d -7 5
- d f 0 0.2 0.8 c 1253 2260 m 17 5 d -1 6 d -13 11 d -24 -6 d f 1247 2259 m 6 1 d
- -21 16 d -23 -6 d 16 -13 d f 0 0.4 0.8 c 1229 2254 m 18 5 d -22 -2 d f 0 0.2
- 0.8 c 1206 2248 m 17 5 d 2 4 d -16 13 d -24 -6 d f 0 0.4 0.8 c 1223 2253 m 6 1
- d -4 3 d f 0 0 0.8 c 1174 2261 m -12 -3 d 5 -4 d f 0 0.2 0.8 c 1182 2242 m 24 6
- d -21 16 d -11 -3 d -7 -7 d f 0 0 0.8 c 1167 2254 m -5 4 d -24 -6 d 7 -5 d f 0
- 0.2 0.8 c 1159 2236 m 23 6 d -15 12 d -22 -7 d f 0 0 0.8 c 1135 2230 m 16 4 d
- -6 13 d -7 5 d -23 -6 d f 0 0.2 0.8 c 1151 2234 m 8 2 d -14 11 d f 0 0 0.8 c
- 1120 2227 m 15 3 d -20 16 d -3 -1 d f 0 0.2 0.8 c 1112 2225 m 8 2 d -8 18 d -18
- -4 d 1 -4 d f 0 0.4 0.8 c 1094 2241 m -3 -1 d 4 -3 d f 0 0.2 0.8 c 1088 2219 m
- 24 6 d -17 12 d -10 2 d -17 -5 d f 0 0.4 0.8 c 1095 2237 m -4 3 d -6 -1 d f 0 0
- 0.8 c 1049 2229 m -5 -1 d 1 -1 d f 0 0.2 0.8 c 1082 2217 m 6 2 d -20 15 d -19
- -5 d -4 -2 d 9 -6 d f 0 0.4 0.8 c 1068 2213 m 14 4 d -28 4 d 9 -7 d f 0 0.6 0.8
- c 1065 2213 m 3 X -5 1 d f 0 0 0.8 c 1045 2227 m -1 1 d -7 -2 d f 0 0.2 0.8 c
- 1041 2207 m 9 2 d 4 12 d -9 6 d -8 -1 d -16 -4 d f 0 0.4 0.8 c 1050 2209 m 12 3
- d 1 2 d -9 7 d f 0 0.6 0.8 c 1062 2212 m 3 1 d -2 1 d f 0 0 0.8 c 1013 2220 m
- -16 -4 d 6 -4 d f 0 0.2 0.8 c 1028 2203 m 13 4 d -20 15 d -8 -2 d -10 -8 d 9 -7
- d f 0 0.4 0.8 c 1018 2201 m 10 2 d -16 2 d f 0 0 0.8 c 1003 2212 m -6 4 d -10
- -2 d f 0 0.2 0.8 c 1012 2205 m -9 7 d -16 2 d -13 -4 d 13 -10 d f 0 0.4 0.8 c
- 994 2195 m 24 6 d -6 4 d -25 -5 d f 0 0.2 0.8 c 971 2189 m 20 5 d -4 6 d -13 10
- d -24 -6 d f 0 0.4 0.8 c 991 2194 m 3 1 d -7 5 d f 0 0.2 0.8 c 947 2183 m 24 6
- d -21 15 d -23 -6 d f 0 0 0.8 c 912 2194 m -9 -2 d 6 -4 d f 0 0.2 0.8 c 932
- 2179 m 15 4 d -20 15 d -15 -4 d -3 -6 d 11 -8 d f 0 0.4 0.8 c 924 2177 m 8 2 d
- -12 1 d f 0 0 0.8 c 909 2188 m -6 4 d -20 -5 d f 0 0.2 0.8 c 920 2180 m -11 8 d
- -26 -1 d -3 -1 d 17 -13 d f 0 0.4 0.8 c 900 2171 m 24 6 d -4 3 d -23 -7 d f 0 0
- 0.8 c 877 2185 m -21 -5 d 14 -10 d f 0 0.2 0.8 c 877 2165 m 19 5 d 1 3 d -17 13
- d -3 -1 d -7 -15 d f 0 0.4 0.8 c 896 2170 m 4 1 d -3 2 d f 0 0 0.8 c 870 2170 m
- -14 10 d -23 -6 d 2 -2 d f 0 0.2 0.8 c 870 2163 m 7 2 d -7 5 d -35 2 d 7 -5 d f
- 0 0.4 0.8 c 860 2160 m 10 3 d -28 4 d 7 -5 d f 0 0.6 0.8 c 853 2159 m 7 1 d -11
- 2 d f 0 0 0.8 c 835 2172 m -2 2 d -19 -5 d f 0 0.2 0.8 c 842 2167 m -7 5 d -21
- -3 d -5 -1 d 10 -7 d f 0 0.4 0.8 c 849 2162 m -7 5 d -23 -6 d 10 -8 d f 0 0.6
- 0.8 c 830 2153 m 23 6 d -4 3 d -20 -9 d f 0 0.2 0.8 c 819 2161 m -10 7 d -23 -6
- d 8 -6 d f 0 0.4 0.8 c 829 2153 m -10 8 d -25 -5 d 12 -9 d f 0 0.6 0.8 c 806
- 2147 m 24 6 d -1 X -23 -6 d f 0 0.2 0.8 c 794 2156 m -8 6 d -24 -6 d 11 -8 d f
- 0 0.4 0.8 c 783 2141 m 22 5 d 1 1 d -12 9 d -21 -8 d f 0 0.6 0.8 c 805 2146 m 1
- 1 d f 0 0 0.8 c 754 2154 m -15 -4 d 6 -4 d f 0 0.2 0.8 c 773 2148 m -11 8 d -8
- -2 d -9 -8 d 10 -8 d f 0 0.4 0.8 c 759 2135 m 24 6 d -10 7 d -18 -10 d f 0 0
- 0.8 c 745 2146 m -6 4 d -24 -6 d 6 -4 d f 0 0.2 0.8 c 736 2129 m 3 1 d 16 8 d
- -10 8 d -24 -6 d f 0 0.4 0.8 c 739 2130 m 20 5 d -4 3 d f 0 0 0.8 c 721 2140 m
- -6 4 d -12 -3 d f 0 0.2 0.8 c 734 2128 m 2 1 d -15 11 d -18 1 d -11 -3 d 9 -7 d
- f 0 0.4 0.8 c 712 2123 m 22 5 d -33 3 d f 0 0 0.8 c 681 2136 m -13 -4 d 3 -2 d
- f 0 0.2 0.8 c 701 2131 m -9 7 d -11 -2 d -10 -6 d 7 -5 d f 0 0.4 0.8 c 705 2121
- m 7 2 d -11 8 d -23 -6 d 7 -6 d f 0 0.6 0.8 c 689 2117 m 16 4 d -20 -2 d f 0 0
- 0.8 c 671 2130 m -3 2 d -23 -6 d 2 -1 d f 0 0.2 0.8 c 678 2125 m -7 5 d -24 -5
- d 13 -10 d f 0 0.4 0.8 c 665 2111 m 14 3 d 6 5 d -7 6 d -18 -10 d f 0 0.6 0.8 c
- 679 2114 m 10 3 d -4 2 d f 0 0 0.8 c 647 2125 m -2 1 d -5 -1 d f 0 0.2 0.8 c
- 660 2115 m -13 10 d -7 X -18 -5 d 11 -8 d f 0 0.4 0.8 c 642 2105 m 23 6 d -5 4
- d -27 -3 d f 0 0.2 0.8 c 618 2099 m 14 3 d 1 10 d -11 8 d -24 -6 d f 0 0.4 0.8
- c 632 2102 m 10 3 d -9 7 d f 0 0.2 0.8 c 608 2096 m 10 3 d -20 15 d -23 -5 d 12
- -10 d f 0 0.4 0.8 c 595 2093 m 13 3 d -21 3 d f 0 0.2 0.8 c 571 2087 m 15 4 d 1
- 8 d -12 10 d -24 -6 d f 0 0.4 0.8 c 586 2091 m 9 2 d -8 6 d f 0 0.2 0.8 c 548
- 2081 m 23 6 d -20 16 d -23 -6 d f 0 0 0.8 c 508 2091 m -4 X 3 -2 d f 0 0.2 0.8
- c 524 2075 m 24 6 d -20 16 d -20 -6 d -1 -2 d f 0 0 0.8 c 507 2089 m -3 2 d -5
- -2 d f 0 0.2 0.8 c 521 2074 m 3 1 d -17 14 d -8 X -18 -4 d 11 -9 d f 0 0.4 0.8
- c 501 2069 m 20 5 d -29 2 d f 0 0 0.8 c 477 2063 m 10 3 d -14 17 d -16 -4 d f 0
- 0.2 0.8 c 487 2066 m 10 2 d -5 8 d -11 9 d -8 -2 d f 0 0.4 0.8 c 497 2068 m 4 1
- d -9 7 d f 0 0 0.8 c 454 2057 m 23 6 d -20 16 d -23 -6 d f 430 2051 m 24 6 d
- -20 16 d -24 -6 d f 407 2045 m 23 6 d -20 16 d -23 -6 d f 1508 2305 m 23 6 d
- -20 15 d -24 -6 d f 1484 2299 m 24 6 d -21 15 d -23 -6 d f 1461 2293 m 23 6 d
- -20 15 d -24 -6 d f 1456 2291 m 5 2 d -21 15 d -10 -3 d f 0 0.2 0.8 c 1451 2290
- m 5 1 d -26 14 d -11 -2 d f 0 0.4 0.8 c 1446 2289 m 5 1 d -32 13 d -2 -1 d 7 -5
- d f 0 0.6 0.8 c 1441 2288 m 5 1 d -22 8 d 7 -6 d f 0 0.8 0.8 c 1437 2287 m 4 1
- d -10 3 d f 0 0.4 0.8 c 1424 2297 m -7 5 d -24 -6 d 20 -15 d f 0 0.6 0.8 c 1414
- 2281 m 13 3 d 4 7 d -7 6 d -11 -16 d f 0 0.8 0.8 c 1427 2284 m 10 3 d -6 4 d f
- 0 0.4 0.8 c 1413 2281 m -20 15 d -23 -6 d 8 -6 d f 0 0.6 0.8 c 1396 2276 m 18 5
- d -1 X -35 3 d 9 -7 d f 0 0.8 0.8 c 1390 2275 m 6 1 d -9 1 d f 0 0.2 0.8 c 1352
- 2286 m -5 -2 d 1 -1 d f 0 0.4 0.8 c 1367 2269 m 5 1 d 6 14 d -8 6 d -18 -4 d -4
- -3 d f 0 0.6 0.8 c 1372 2270 m 14 4 d 1 3 d -9 7 d f 0 0.8 0.8 c 1386 2274 m 4
- 1 d -3 2 d f 0 0.2 0.8 c 1343 2263 m 11 2 d -6 18 d -1 1 d -2 X -11 -14 d f 0
- 0.4 0.8 c 1354 2265 m 13 4 d -19 14 d -3 1 d -22 -6 d 11 -8 d f 0 0 0.8 c 1304
- 2273 m -4 -1 d 5 -4 d f 0 0.2 0.8 c 1320 2257 m 23 6 d -9 7 d -18 7 d -12 -4 d
- 1 -5 d f 0 0.4 0.8 c 1334 2270 m -11 8 d -7 -1 d f 0 0 0.8 c 1305 2268 m -5 4 d
- -24 -6 d 3 -2 d f 0 0.2 0.8 c 1318 2256 m 2 1 d -15 11 d -26 -4 d 10 -7 d f 0
- 0.4 0.8 c 1296 2251 m 22 5 d -29 1 d f 0 0 0.8 c 1279 2264 m -3 2 d -6 -1 d f 0
- 0.2 0.8 c 1289 2257 m -10 7 d -9 1 d -17 -5 d f 0 0.4 0.8 c 1293 2250 m 3 1 d
- -7 6 d -36 3 d 9 -7 d f 0 0.6 0.8 c 1275 2245 m 18 5 d -31 3 d 10 -7 d f 0 0.8
- 0.8 c 1273 2245 m 2 X -3 1 d f 0 0.2 0.8 c 1253 2260 m -6 -1 d f 0 0.4 0.8 c
- 1262 2253 m -9 7 d -6 -1 d -18 -5 d 13 -10 d f 0 0.6 0.8 c 1249 2239 m 20 5 d 3
- 2 d -10 7 d -20 -9 d f 0 0.8 0.8 c 1269 2244 m 4 1 d -1 1 d f 0 0.2 0.8 c 1223
- 2253 m -17 -5 d 6 -5 d f 0 0.4 0.8 c 1242 2244 m -13 10 d -6 -1 d -11 -10 d 14
- -10 d f 0 0.6 0.8 c 1226 2233 m 23 6 d -7 5 d -16 -11 d f 0 0.2 0.8 c 1202 2227
- m 2 X 8 16 d -6 5 d -24 -6 d f 0 0.4 0.8 c 1204 2227 m 21 6 d 1 X -14 10 d f 0
- 0.6 0.8 c 1225 2233 m 1 X f 0 0.2 0.8 c 1200 2226 m 2 1 d -20 15 d -23 -6 d 11
- -8 d f 0 0.4 0.8 c 1179 2221 m 21 5 d -30 2 d f 0 0 0.8 c 1151 2234 m -16 -4 d
- 6 -4 d f 0 0.2 0.8 c 1170 2228 m -11 8 d -8 -2 d -10 -8 d 10 -8 d f 0 0.4 0.8 c
- 1155 2215 m 24 6 d -9 7 d -19 -10 d f 0 0 0.8 c 1141 2226 m -6 4 d -15 -3 d f 0
- 0.2 0.8 c 1151 2218 m -10 8 d -21 1 d -8 -2 d 7 -6 d f 0 0.4 0.8 c 1139 2211 m
- 16 4 d -4 3 d -32 1 d 10 -8 d f 0 0.6 0.8 c 1132 2209 m 7 2 d -10 X f 0 0.2 0.8
- c 1119 2219 m -7 6 d -24 -6 d 5 -4 d f 0 0.4 0.8 c 1129 2211 m -10 8 d -26 -4 d
- 11 -8 d f 0 0.6 0.8 c 1108 2203 m 24 6 d -3 2 d -25 -4 d f 0 0.2 0.8 c 1093
- 2215 m -5 4 d -6 -2 d f 0 0.4 0.8 c 1085 2197 m 7 2 d 12 8 d -11 8 d -11 2 d
- -14 -4 d 8 -9 d f 0 0.6 0.8 c 1092 2199 m 16 4 d -4 4 d -36 6 d -3 X 11 -9 d f
- 0 0.2 0.8 c 1050 2209 m -9 -2 d 8 -6 d f 0 0.4 0.8 c 1075 2194 m 10 3 d -9 7 d
- -14 8 d -12 -3 d -1 -8 d 10 -8 d f 0 0.6 0.8 c 1061 2191 m 14 3 d 1 10 d -11 9
- d -3 -1 d -3 -19 d f 0 0.2 0.8 c 1049 2201 m -8 6 d -13 -4 d f 0 0.4 0.8 c 1038
- 2185 m 10 3 d 11 5 d -10 8 d -21 2 d -10 -2 d f 0 0.6 0.8 c 1048 2188 m 13 3 d
- -2 2 d f 0 0.4 0.8 c 1015 2179 m 23 6 d -20 16 d -24 -6 d f 0 0.2 0.8 c 991
- 2194 m -20 -5 d 14 -11 d f 0 0.4 0.8 c 991 2173 m 24 6 d -21 16 d -3 -1 d -6
- -16 d f 0 0.2 0.8 c 985 2178 m -14 11 d -24 -6 d 5 -4 d f 0 0.4 0.8 c 983 2171
- m 8 2 d -6 5 d -33 1 d 8 -6 d f 0 0.6 0.8 c 969 2167 m 14 4 d -23 2 d 7 -5 d f
- 0 0.8 0.8 c 968 2167 m 1 X -2 1 d f 0 0.2 0.8 c 952 2179 m -5 4 d -15 -4 d f 0
- 0.4 0.8 c 960 2173 m -8 6 d -20 X -8 -2 d 14 -11 d f 0 0.6 0.8 c 944 2161 m 21
- 5 d 2 2 d -7 5 d -22 -7 d f 0 0.8 0.8 c 965 2166 m 3 1 d -1 1 d f 0 0.4 0.8 c
- 921 2155 m 10 3 d 7 8 d -14 11 d -24 -6 d f 0 0.6 0.8 c 931 2158 m 13 3 d -6 5
- d f 0 0.2 0.8 c 896 2170 m -19 -5 d 11 -9 d f 0 0.4 0.8 c 897 2149 m 24 6 d -21
- 16 d -4 -1 d -8 -14 d f 0 0.2 0.8 c 888 2156 m -11 9 d -7 -2 d f 0 0.4 0.8 c
- 874 2143 m 23 6 d -9 7 d -18 7 d -10 -3 d 4 -9 d f 0 0.6 0.8 c 860 2160 m -7 -1
- d 11 -8 d f 0 0.4 0.8 c 850 2137 m 24 6 d -10 8 d -33 1 d f 0 0.6 0.8 c 864
- 2151 m -11 8 d -23 -6 d 1 -1 d f 0 0.4 0.8 c 827 2131 m 23 6 d -19 15 d -23 -6
- d f 0 0.6 0.8 c 831 2152 m -1 1 d -24 -6 d 2 -1 d f 0 0.4 0.8 c 803 2125 m 24 6
- d -19 15 d -3 X -22 -5 d f 0 0.6 0.8 c 808 2146 m -2 1 d -1 -1 d f 0 0.4 0.8 c
- 781 2120 m 22 5 d -20 16 d -24 -6 d 20 -15 d f 0 0.6 0.8 c 780 2119 m 1 1 d -2
- X f 0 0.2 0.8 c 739 2130 m -3 -1 d 5 -4 d f 0 0.4 0.8 c 756 2113 m 23 6 d 1 Y
- -20 15 d -20 -5 d 2 -5 d f 0 0.6 0.8 c 779 2119 m 1 X -1 1 d f 0 0.2 0.8 c 741
- 2125 m -5 4 d -2 -1 d f 0 0.4 0.8 c 745 2110 m 11 3 d -15 12 d -7 3 d -22 -5 d
- 4 -3 d f 0 0.6 0.8 c 733 2107 m 12 3 d -29 10 d f 0 0.4 0.8 c 716 2120 m -4 3 d
- -7 -2 d f 0 0.6 0.8 c 709 2101 m 24 6 d -17 13 d -11 1 d -16 -4 d f 0 0.4 0.8 c
- 686 2095 m 9 3 d -16 16 d -14 -3 d f 0 0.6 0.8 c 695 2098 m 14 3 d -20 16 d -10
- -3 d f 0 0.4 0.8 c 663 2090 m 23 5 d -21 16 d -23 -6 d 19 -15 d f 0 0.6 0.8 c
- 662 2089 m 1 1 d -2 X f 0 0.2 0.8 c 632 2102 m -14 -3 d 5 -4 d f 0 0.4 0.8 c
- 661 2090 m -19 15 d -10 -3 d -9 -7 d 11 -8 d f 0 0.6 0.8 c 639 2083 m 23 6 d -1
- 1 d -27 -3 d f 0 0.2 0.8 c 623 2095 m -5 4 d -10 -3 d f 0 0.4 0.8 c 634 2087 m
- -11 8 d -15 1 d -13 -3 d 7 -6 d f 0 0.6 0.8 c 615 2077 m 24 6 d -5 4 d -32 X f
- 0 0.2 0.8 c 586 2091 m -15 -4 d 18 -13 d f 0 0.4 0.8 c 592 2071 m 13 4 d -3 12
- d -7 6 d -9 -2 d 3 -17 d f 0 0.6 0.8 c 605 2075 m 10 2 d -13 10 d f 0 0.2 0.8 c
- 589 2074 m -18 13 d -23 -6 d 4 -3 d f 0 0.4 0.8 c 579 2068 m 13 3 d -3 3 d -37
- 4 d 10 -8 d f 0 0.6 0.8 c 568 2065 m 11 3 d -17 2 d f 0 0.2 0.8 c 552 2078 m -4
- 3 d -24 -6 d 1 -1 d f 0 0.4 0.8 c 562 2070 m -10 8 d -27 -4 d 19 -14 d f 0 0.6
- 0.8 c 545 2059 m 23 6 d -6 5 d -18 -10 d f 0 0.2 0.8 c 525 2074 m -1 1 d -3 -1
- d f 0 0.4 0.8 c 521 2054 m 23 5 d 1 Y -19 14 d -4 X -20 -5 d f 0 0.6 0.8 c 544
- 2059 m 1 X -1 1 d f 0 0 0.8 c 498 2048 m 10 2 d -21 16 d -10 -3 d f 0 0.2 0.8 c
- 508 2050 m 10 3 d -21 15 d -10 -2 d f 0 0.4 0.8 c 518 2053 m 3 1 d -20 15 d -4
- -1 d f 0 0 0.8 c 474 2042 m 24 6 d -21 15 d -23 -6 d f 451 2036 m 23 6 d -20 15
- d -24 -6 d f 427 2030 m 24 6 d -21 15 d -23 -6 d f 1528 2289 m 24 6 d -21 16 d
- -23 -6 d f 1505 2283 m 23 6 d -20 16 d -24 -6 d f 1481 2277 m 24 6 d -21 16 d
- -23 -6 d f 1477 2276 m 4 1 d -20 16 d -5 -2 d f 0 0.2 0.8 c 1472 2275 m 5 1 d
- -21 15 d -5 -1 d f 0 0.4 0.8 c 1468 2274 m 4 1 d -21 15 d -5 -1 d f 0 0.6 0.8 c
- 1464 2273 m 4 1 d -22 15 d -5 -1 d f 0 0.8 0.8 c 1459 2272 m 5 1 d -23 15 d -4
- -1 d 8 -6 d f 0 0.8 0.6 c 1458 2271 m 1 1 d -14 9 d f 0 0.6 0.8 c 1427 2284 m
- -13 -3 d 18 -14 d f 0 0.8 0.8 c 1434 2265 m 16 4 d -5 12 d -8 6 d -10 -3 d 5
- -17 d f 0 0.8 0.6 c 1450 2269 m 8 2 d -13 10 d f 0 0.6 0.8 c 1432 2267 m -18 14
- d -18 -5 d f 0 0.8 0.8 c 1423 2262 m 11 3 d -2 2 d -36 9 d -6 -1 d 8 -6 d f 0
- 0.8 0.6 c 1411 2259 m 12 3 d -25 7 d 12 -9 d f 0 0.8 0.4 c 1411 2259 m -1 1 d f
- 0 0.4 0.8 c 1372 2270 m -5 -1 d 3 -3 d f 0 0.6 0.8 c 1386 2274 m -14 -4 d -2 -4
- d 9 -6 d f 0 0.8 0.8 c 1387 2253 m 1 X 10 16 d -8 6 d -4 -1 d -7 -14 d f 0 0.8
- 0.6 c 1388 2253 m 22 6 d 1 Y -12 9 d f 0 0.8 0.4 c 1410 2259 m 1 X -1 1 d f 0
- 0.2 0.8 c 1354 2265 m -11 -2 d 3 -2 d f 0 0.4 0.8 c 1370 2266 m -3 3 d -13 -4 d
- -8 -4 d 6 -4 d f 0 0.6 0.8 c 1379 2260 m -9 6 d -18 -9 d 5 -5 d f 0 0.8 0.8 c
- 1384 2252 m 3 1 d -8 7 d -22 -8 d 6 -4 d f 0 0.8 0.6 c 1364 2247 m 20 5 d -21
- -4 d f 0 0.2 0.8 c 1346 2261 m -3 2 d -23 -6 d 1 -1 d f 0 0.4 0.8 c 1352 2257 m
- -6 4 d -25 -5 d 13 -10 d f 0 0.6 0.8 c 1340 2241 m 8 2 d 9 9 d -5 5 d -18 -11 d
- f 0 0.8 0.8 c 1348 2243 m 13 4 d 2 1 d -6 4 d f 0 0.8 0.6 c 1361 2247 m 3 X -1
- 1 d f 0 0.2 0.8 c 1321 2256 m -1 1 d -2 -1 d f 0 0.4 0.8 c 1334 2246 m -13 10 d
- -3 X -22 -5 d 5 -4 d f 0 0.6 0.8 c 1317 2235 m 23 6 d -6 5 d -33 1 d f 0 0.4
- 0.8 c 1293 2229 m 11 3 d -3 15 d -5 4 d -3 -1 d -7 -15 d f 0 0.6 0.8 c 1304
- 2232 m 13 3 d -16 12 d -8 3 d -18 -5 d -1 -1 d 12 -9 d f 0 0.8 0.8 c 1275 2245
- m -2 X 1 -1 d f 0 0.4 0.8 c 1270 2223 m 23 6 d -7 6 d -26 -4 d f 0 0.6 0.8 c
- 1286 2235 m -12 9 d -5 X -20 -5 d 11 -8 d f 0 0.8 0.8 c 1274 2244 m -1 1 d -4
- -1 d f 0 0.4 0.8 c 1266 2222 m 4 1 d -10 8 d f 0 0.6 0.8 c 1257 2220 m 9 2 d -6
- 9 d -11 8 d -23 -6 d 9 -7 d f 0 0.8 0.8 c 1248 2218 m 9 2 d -22 6 d 9 -7 d f 0
- 0.8 0.6 c 1246 2217 m 2 1 d -4 1 d f 0 0.2 0.8 c 1204 2227 m -2 X 1 X f 0 0.4
- 0.8 c 1225 2233 m -21 -6 d -1 X 9 -8 d f 0 0.6 0.8 c 1235 2226 m -9 7 d -1 X
- -13 -14 d 10 -7 d f 0 0.8 0.8 c 1223 2211 m 19 5 d 2 3 d -9 7 d -13 -14 d f 0
- 0.8 0.6 c 1242 2216 m 4 1 d -2 2 d f 0 0.2 0.8 c 1203 2227 m -1 X -2 -1 d f 0
- 0.4 0.8 c 1212 2219 m -9 8 d -3 -1 d -21 -5 d 3 -2 d f 0 0.6 0.8 c 1222 2212 m
- -10 7 d -30 X 7 -6 d f 0 0.8 0.8 c 1207 2207 m 16 4 d -1 1 d -33 1 d 7 -5 d f 0
- 0.8 0.6 c 1199 2205 m 8 2 d -11 1 d f 0 0.4 0.8 c 1182 2219 m -3 2 d -24 -6 d 4
- -3 d f 0 0.6 0.8 c 1189 2213 m -7 6 d -23 -7 d 5 -4 d f 0 0.8 0.8 c 1196 2208 m
- -7 5 d -25 -5 d 5 -4 d f 0 0.8 0.6 c 1183 2201 m 16 4 d -3 3 d -27 -4 d 5 -3 d
- f 0 0.8 0.4 c 1176 2199 m 7 2 d -9 X f 0 0.4 0.8 c 1159 2212 m -4 3 d -16 -4 d
- f 0 0.6 0.8 c 1164 2208 m -5 4 d -20 -1 d -7 -2 d 18 -14 d f 0 0.8 0.8 c 1152
- 2193 m 10 3 d 7 8 d -5 4 d -14 -13 d f 0 0.8 0.6 c 1162 2196 m 11 3 d 1 2 d -5
- 3 d f 0 0.8 0.4 c 1173 2199 m 3 X -2 2 d f 0 0.6 0.8 c 1150 2195 m -18 14 d -24
- -6 d 11 -8 d f 0 0.8 0.8 c 1129 2187 m 23 6 d -2 2 d -31 X f 0 0.4 0.8 c 1092
- 2199 m -7 -2 d 2 -1 d f 0 0.6 0.8 c 1119 2195 m -11 8 d -16 -4 d -5 -3 d 9 -8 d
- f 0 0.8 0.8 c 1105 2181 m 24 6 d -10 8 d -23 -7 d f 0 0.4 0.8 c 1087 2196 m -2
- 1 d -10 -3 d f 0 0.6 0.8 c 1096 2188 m -9 8 d -12 -2 d -14 -3 d 15 -11 d f 0
- 0.8 0.8 c 1082 2176 m 23 5 d -9 7 d -20 -8 d f 0 0.4 0.8 c 1048 2188 m -10 -3 d
- 2 -1 d f 0 0.6 0.8 c 1076 2180 m -15 11 d -13 -3 d -8 -4 d 8 -7 d f 0 0.8 0.8 c
- 1063 2171 m 19 5 d -6 4 d -28 -3 d 9 -6 d f 0 0.8 0.6 c 1058 2170 m 5 1 d -6 X
- f 0 0.4 0.8 c 1040 2184 m -2 1 d -23 -6 d -1 Y f 0 0.6 0.8 c 1048 2177 m -8 7 d
- -25 -6 d 5 -3 d f 0 0.8 0.8 c 1057 2171 m -9 6 d -28 -2 d 5 -4 d f 0 0.8 0.6 c
- 1049 2167 m 9 3 d -1 1 d -32 X 5 -3 d f 0 0.8 0.4 c 1036 2164 m 13 3 d -19 1 d
- 4 -4 d f 0 0.8 0.2 c 1035 2164 m 1 X -2 X f 0 0.4 0.8 c 1011 2158 m 1 X 3 20 d
- 1 Y -24 -6 d f 0 0.6 0.8 c 1012 2158 m 6 1 d 2 16 d -5 3 d f 0 0.8 0.8 c 1018
- 2159 m 5 2 d 2 10 d -5 4 d f 0 0.8 0.6 c 1023 2161 m 6 1 d 1 6 d -5 3 d f 0 0.8
- 0.4 c 1029 2162 m 5 1 d 1 Y -4 4 d f 0 0.8 0.2 c 1034 2163 m 1 1 d -1 X f 0 0.4
- 0.8 c 1009 2157 m 2 1 d -20 15 d -8 -2 d f 0 0.6 0.8 c 998 2154 m 11 3 d -26 14
- d -14 -4 d f 0 0.8 0.8 c 988 2152 m 10 2 d -29 13 d -1 X f 0 0.6 0.8 c 965 2166
- m -21 -5 d 9 -7 d f 0 0.8 0.8 c 964 2146 m 24 6 d -20 15 d -3 -1 d -12 -12 d f
- 0 0.4 0.8 c 931 2158 m -10 -3 d 3 -2 d f 0 0.6 0.8 c 953 2154 m -9 7 d -13 -3 d
- -7 -5 d 15 -12 d f 0 0.8 0.8 c 941 2140 m 23 6 d -11 8 d -14 -13 d f 0 0.4 0.8
- c 924 2153 m -3 2 d -24 -6 d 6 -5 d f 0 0.6 0.8 c 917 2134 m 12 3 d 10 4 d -15
- 12 d -21 -9 d f 0 0.8 0.8 c 929 2137 m 12 3 d -2 1 d f 0 0.4 0.8 c 903 2144 m
- -6 5 d -23 -6 d 6 -5 d f 0 0.6 0.8 c 912 2132 m 5 2 d -14 10 d -23 -6 d 11 -8 d
- f 0 0.8 0.8 c 894 2128 m 18 4 d -21 -2 d f 0 0.4 0.8 c 880 2138 m -6 5 d -24 -6
- d 7 -5 d f 0 0.6 0.8 c 891 2130 m -11 8 d -23 -6 d 10 -8 d f 0 0.8 0.8 c 870
- 2122 m 24 6 d -3 2 d -24 -6 d f 0 0.4 0.8 c 857 2132 m -7 5 d -23 -6 d 4 -3 d f
- 0 0.6 0.8 c 867 2124 m -10 8 d -26 -4 d 12 -9 d f 0 0.8 0.8 c 847 2116 m 23 6 d
- -3 2 d -24 -5 d f 0 0.4 0.8 c 831 2128 m -4 3 d -24 -6 d 4 -3 d f 0 0.6 0.8 c
- 843 2119 m -12 9 d -24 -6 d 7 -5 d f 0 0.8 0.8 c 832 2112 m 15 4 d -4 3 d -29
- -2 d 7 -5 d f 0 0.8 0.6 c 823 2110 m 9 2 d -11 X f 0 0.4 0.8 c 807 2122 m -4 3
- d -22 -5 d f 0 0.6 0.8 c 800 2104 m 4 1 d 10 12 d -7 5 d -26 -2 d -1 -1 d f 0
- 0.8 0.8 c 804 2105 m 14 3 d 3 4 d -7 5 d f 0 0.8 0.6 c 818 2108 m 5 2 d -2 2 d
- f 0 0.4 0.8 c 779 2119 m -23 -6 d 5 -3 d f 0 0.6 0.8 c 796 2103 m 4 1 d -20 15
- d -1 X -18 -9 d 6 -5 d f 0 0.8 0.8 c 784 2100 m 12 3 d -29 2 d 6 -4 d f 0 0.8
- 0.6 c 776 2098 m 8 2 d -11 1 d f 0 0.4 0.8 c 761 2110 m -5 3 d -11 -3 d f 0 0.6
- 0.8 c 767 2105 m -6 5 d -16 X -12 -3 d 1 -1 d f 0 0.8 0.8 c 773 2101 m -6 4 d
- -33 1 d 16 -12 d f 0 0.8 0.6 c 753 2092 m 23 6 d -3 3 d -23 -7 d f 0 0.6 0.8 c
- 734 2106 m -1 1 d -24 -6 d 5 -4 d f 0 0.8 0.8 c 730 2086 m 18 4 d 2 4 d -16 12
- d -20 -9 d f 0 0.8 0.6 c 748 2090 m 5 2 d -3 2 d f 0 0.4 0.8 c 695 2098 m -9 -3
- d 19 -15 d f 0 0.6 0.8 c 706 2080 m 18 4 d -10 13 d -5 4 d -14 -3 d 10 -18 d f
- 0 0.8 0.8 c 724 2084 m 6 2 d -16 11 d f 0 0.4 0.8 c 705 2080 m -19 15 d -23 -5
- d f 0 0.6 0.8 c 696 2077 m 10 3 d -1 X -42 10 d -1 -1 d 9 -6 d f 0 0.8 0.8 c
- 687 2075 m 9 2 d -25 6 d 8 -6 d f 0 0.8 0.6 c 683 2074 m 4 1 d -8 2 d f 0 0.6
- 0.8 c 671 2083 m -9 6 d -23 -6 d 6 -4 d f 0 0.8 0.8 c 679 2077 m -8 6 d -26 -4
- d 12 -9 d f 0 0.8 0.6 c 659 2068 m 24 6 d -4 3 d -22 -7 d f 0 0.4 0.8 c 636
- 2062 m 5 1 d -15 6 d f 0 0.6 0.8 c 641 2063 m 8 2 d -4 14 d -6 4 d -24 -6 d 11
- -8 d f 0 0.8 0.8 c 649 2065 m 8 2 d 3 Y -12 9 d f 0 0.8 0.6 c 657 2067 m 2 1 d
- -2 2 d f 0 0.4 0.8 c 631 2061 m 5 1 d -10 7 d -21 6 d -13 -4 d 4 -3 d f 0 0.6
- 0.8 c 625 2059 m 6 2 d -5 8 d -11 8 d -10 -2 d -9 -7 d 6 -4 d f 0 0.8 0.8 c 618
- 2057 m 7 2 d -23 5 d 5 -5 d f 0 0.8 0.6 c 612 2056 m 6 1 d -11 2 d f 0 0.4 0.8
- c 596 2068 m -4 3 d -13 -3 d f 0 0.6 0.8 c 602 2064 m -6 4 d -17 X -11 -3 d 15
- -11 d f 0 0.8 0.8 c 589 2050 m 12 3 d 6 6 d -5 5 d -19 -10 d f 0 0.8 0.6 c 601
- 2053 m 11 3 d -5 3 d f 0 0.6 0.8 c 583 2054 m -15 11 d -23 -6 d 5 -3 d f 0 0.8
- 0.8 c 581 2048 m 8 2 d -6 4 d -33 2 d 5 -4 d f 0 0.8 0.6 c 573 2046 m 8 2 d -26
- 4 d 5 -4 d f 0 0.8 0.4 c 565 2044 m 8 2 d -13 2 d f 0 0.4 0.8 c 544 2059 m -23
- -5 d 9 -7 d f 0 0.6 0.8 c 542 2038 m 8 18 d -5 3 d -1 X -14 -12 d f 0 0.8 0.8 c
- 542 2038 m 8 2 d 5 12 d -5 4 d f 0 0.8 0.6 c 550 2040 m 8 2 d 2 6 d -5 4 d f 0
- 0.8 0.4 c 558 2042 m 7 2 d -5 4 d f 0 0 0.8 c 518 2032 m 6 2 d -16 16 d -10 -2
- d f 0 0.2 0.8 c 524 2034 m 6 1 d -12 18 d -10 -3 d f 0 0.4 0.8 c 530 2035 m 6 2
- d -6 10 d -9 7 d -3 -1 d f 0 0.6 0.8 c 536 2037 m 6 1 d -12 9 d f 0 0 0.8 c 495
- 2026 m 23 6 d -20 16 d -24 -6 d f 471 2020 m 24 6 d -21 16 d -23 -6 d f 448
- 2014 m 23 6 d -20 16 d -24 -6 d f 1548 2274 m 24 6 d -20 15 d -24 -6 d f 1525
- 2268 m 23 6 d -20 15 d -23 -6 d f 1501 2262 m 24 6 d -20 15 d -24 -6 d f 1497
- 2260 m 4 2 d -20 15 d -4 -1 d f 0 0.2 0.8 c 1492 2259 m 5 1 d -20 16 d -5 -1 d
- f 0 0.4 0.8 c 1487 2258 m 5 1 d -20 16 d -4 -1 d f 0 0.6 0.8 c 1482 2257 m 5 1
- d -19 16 d -4 -1 d f 0 0.8 0.8 c 1478 2256 m 4 1 d -18 16 d -5 -1 d 11 -11 d f
- 0 0.8 0.6 c 1459 2272 m -1 -1 d 12 -10 d f 0 0.8 0.8 c 1455 2250 m 23 6 d -8 5
- d -20 8 d -16 -4 d f 0 0.8 0.6 c 1470 2261 m -12 10 d -8 -2 d f 0 0.8 0.8 c
- 1451 2249 m 4 1 d -21 15 d -11 -3 d f 0 0.8 0.6 c 1435 2245 m 16 4 d -28 13 d
- -12 -3 d f 0 0.8 0.4 c 1431 2244 m 4 1 d -24 14 d f 0 0.8 0.8 c 1388 2253 m -1
- X 1 -1 d f 0 0.8 0.6 c 1408 2238 m 16 4 d -14 17 d -22 -6 d -1 Y f 0 0.8 0.4 c
- 1424 2242 m 7 2 d -20 15 d -1 X f 0 0.8 0.8 c 1384 2232 m 9 2 d -5 18 d -1 1 d
- -3 -1 d -11 -12 d f 0 0.8 0.6 c 1393 2234 m 15 4 d -20 14 d -4 X -20 -5 d 9 -7
- d f 0 0.6 0.8 c 1348 2243 m -8 -2 d 4 -3 d f 0 0.8 0.8 c 1380 2231 m 4 1 d -11
- 8 d -12 7 d -13 -4 d -4 -5 d 7 -5 d f 0 0.8 0.6 c 1365 2227 m 15 4 d -7 9 d -9
- 7 d -3 X -10 -14 d 8 -6 d f 0 0.8 0.4 c 1361 2226 m 4 1 d -6 X f 0 0.6 0.8 c
- 1344 2238 m -4 3 d -23 -6 d 10 -7 d f 0 0.8 0.8 c 1337 2220 m 8 2 d 6 11 d -7 5
- d -17 -10 d f 0 0.8 0.6 c 1345 2222 m 12 3 d 2 2 d -8 6 d f 0 0.8 0.4 c 1357
- 2225 m 4 1 d -2 1 d f 0 0.4 0.8 c 1304 2232 m -11 -3 d 3 -2 d f 0 0.6 0.8 c
- 1327 2228 m -10 7 d -13 -3 d -8 -5 d 5 -4 d f 0 0.8 0.8 c 1330 2218 m 7 2 d -10
- 8 d -26 -5 d 5 -4 d f 0 0.8 0.6 c 1319 2215 m 11 3 d -24 1 d 5 -3 d f 0 0.8 0.4
- c 1314 2214 m 5 1 d -8 1 d f 0 0.4 0.8 c 1296 2227 m -3 2 d -23 -6 d 4 -3 d f 0
- 0.6 0.8 c 1301 2223 m -5 4 d -22 -7 d 10 -8 d f 0 0.8 0.8 c 1290 2208 m 6 1 d
- 10 10 d -5 4 d -17 -11 d f 0 0.8 0.6 c 1296 2209 m 12 3 d 3 4 d -5 3 d f 0 0.8
- 0.4 c 1308 2212 m 6 2 d -3 2 d f 0 0.4 0.8 c 1274 2220 m -4 3 d -4 -1 d f 0 0.6
- 0.8 c 1284 2212 m -10 8 d -8 2 d -9 -2 d f 0 0.8 0.8 c 1267 2202 m 23 6 d -6 4
- d -27 8 d -9 -2 d 16 -14 d f 0 0.8 0.6 c 1248 2218 m -2 -1 d 18 -13 d f 0 0.8
- 0.8 c 1266 2202 m 1 X -3 2 d -22 12 d -19 -5 d 7 -5 d f 0 0.8 0.6 c 1251 2198 m
- 15 4 d -2 2 d -18 13 d -4 -1 d -12 -10 d 9 -7 d f 0 0.8 0.4 c 1243 2196 m 8 2 d
- -12 1 d f 0 0.8 0.8 c 1230 2206 m -7 5 d -16 -4 d f 0 0.8 0.6 c 1239 2199 m -9
- 7 d -23 1 d -8 -2 d 19 -14 d f 0 0.8 0.4 c 1220 2190 m 23 6 d -4 3 d -21 -8 d f
- 0 0.6 0.8 c 1196 2184 m 3 1 d -5 1 d f 0 0.8 0.8 c 1199 2185 m 10 2 d -23 5 d 8
- -6 d f 0 0.8 0.6 c 1209 2187 m 10 3 d -1 1 d -19 14 d -16 -4 d -5 -3 d 8 -6 d f
- 0 0.8 0.4 c 1219 2190 m 1 X -2 1 d -35 10 d -7 -2 d 2 -1 d f 0 0.6 0.8 c 1192
- 2183 m 4 1 d -2 2 d f 0 0.8 0.8 c 1180 2180 m 12 3 d 2 3 d -8 6 d -24 4 d -10
- -3 d 12 -9 d f 0 0.8 0.6 c 1173 2178 m 7 2 d 6 12 d -8 6 d -5 1 d -11 -3 d 2
- -12 d f 0 0.8 0.4 c 1178 2198 m -2 1 d -3 X f 0 0.8 0.8 c 1164 2184 m -12 9 d
- -23 -6 d 8 -6 d f 0 0.8 0.6 c 1149 2172 m 24 6 d -9 6 d -27 -3 d f 0 0.8 0.8 c
- 1137 2181 m -8 6 d -24 -6 d 3 -1 d f 0 0.8 0.6 c 1126 2166 m 23 6 d -12 9 d -29
- -1 d f 0 0.8 0.8 c 1108 2180 m -3 1 d -23 -5 d 9 -7 d f 0 0.8 0.6 c 1102 2160 m
- 24 6 d -18 14 d -17 -11 d f 0 0.8 0.8 c 1091 2169 m -9 7 d -19 -5 d f 0 0.8 0.6
- c 1098 2159 m 4 1 d -11 9 d -28 2 d -5 -1 d 11 -9 d f 0 0.8 0.4 c 1079 2154 m
- 19 5 d -29 2 d f 0 0.8 0.8 c 1055 2148 m 8 2 d -14 3 d f 0 0.8 0.6 c 1063 2150
- m 9 2 d -3 9 d -11 9 d -9 -3 d -7 -9 d 7 -5 d f 0 0.8 0.4 c 1072 2152 m 7 2 d
- -10 7 d -20 6 d -13 -3 d -1 Y 6 -5 d f 0 0.8 0.2 c 1036 2164 m -1 X 1 -1 d f 0
- 0.4 0.8 c 1012 2158 m -1 X 1 -1 d f 0 0.6 0.8 c 1018 2159 m -6 -1 d -1 Y 5 -4 d
- f 0 0.8 0.8 c 1048 2146 m 7 2 d -6 5 d -26 8 d -5 -2 d -1 -6 d 5 -4 d f 0 0.8
- 0.6 c 1039 2144 m 9 2 d 1 7 d -7 5 d -13 4 d -6 -1 d -1 -12 d 5 -3 d f 0 0.8
- 0.4 c 1032 2142 m 7 2 d 3 14 d -6 5 d -2 X -5 -1 d -2 -16 d f 0 0.8 0.2 c 1036
- 2163 m -1 1 d -1 -1 d f 0 0.4 0.8 c 1012 2157 m -1 1 d -2 -1 d f 0 0.6 0.8 c
- 1017 2153 m -5 4 d -3 X -11 -3 d f 0 0.8 0.8 c 1008 2136 m 1 X 13 13 d -5 4 d
- -19 1 d -10 -2 d f 0 0.8 0.6 c 1009 2136 m 12 3 d 6 7 d -5 3 d f 0 0.8 0.4 c
- 1021 2139 m 11 3 d -5 4 d f 0 0.8 0.8 c 1008 2136 m -20 16 d -24 -6 d 1 -1 d f
- 0 0.8 0.6 c 996 2133 m 12 3 d -43 9 d 10 -8 d f 0 0.8 0.4 c 985 2130 m 11 3 d
- -21 4 d f 0 0.8 0.8 c 961 2124 m 1 X 3 21 d -1 1 d -23 -6 d f 0 0.8 0.6 c 962
- 2124 m 12 3 d 1 10 d -10 8 d f 0 0.8 0.4 c 974 2127 m 11 3 d -10 7 d f 0 0.6
- 0.8 c 929 2137 m -12 -3 d 1 -1 d f 0 0.8 0.8 c 961 2124 m -20 16 d -12 -3 d -11
- -4 d 8 -6 d f 0 0.8 0.6 c 945 2120 m 16 4 d -35 3 d 8 -6 d f 0 0.8 0.4 c 938
- 2118 m 7 2 d -11 1 d f 0 0.6 0.8 c 918 2133 m -1 1 d -5 -2 d f 0 0.8 0.8 c 926
- 2127 m -8 6 d -6 -1 d -18 -4 d 5 -4 d f 0 0.8 0.6 c 934 2121 m -8 6 d -27 -3 d
- 8 -6 d f 0 0.8 0.4 c 914 2112 m 24 6 d -4 3 d -27 -3 d f 0 0.8 0.8 c 899 2124 m
- -5 4 d -24 -6 d 8 -6 d f 0 0.8 0.6 c 907 2118 m -8 6 d -21 -8 d 10 -8 d f 0 0.8
- 0.4 c 891 2106 m 23 6 d -7 6 d -19 -10 d f 0 0.8 0.8 c 878 2116 m -8 6 d -23 -6
- d 7 -6 d f 0 0.8 0.6 c 888 2108 m -10 8 d -24 -6 d 10 -8 d f 0 0.8 0.4 c 867
- 2100 m 24 6 d -3 2 d -24 -6 d f 0 0.8 0.8 c 854 2110 m -7 6 d -15 -4 d f 0 0.8
- 0.6 c 864 2102 m -10 8 d -22 2 d -9 -2 d 5 -4 d f 0 0.8 0.4 c 857 2098 m 10 2 d
- -3 2 d -36 4 d 8 -6 d f 0 0.8 0.2 c 844 2094 m 13 4 d -21 2 d f 0 0.6 0.8 c 804
- 2105 m -4 -1 d 6 -5 d f 0 0.8 0.8 c 820 2088 m 2 1 d -4 19 d -14 -3 d 2 -6 d f
- 0 0.8 0.6 c 822 2089 m 7 2 d -1 15 d -5 4 d -5 -2 d f 0 0.8 0.4 c 829 2091 m 8
- 1 d -1 8 d -8 6 d f 0 0.8 0.2 c 837 2092 m 7 2 d -8 6 d f 0 0.6 0.8 c 806 2099
- m -6 5 d -4 -1 d f 0 0.8 0.8 c 818 2088 m 2 X -14 11 d -10 4 d -12 -3 d f 0 0.8
- 0.6 c 811 2086 m 7 2 d -34 12 d -8 -2 d 4 -3 d f 0 0.8 0.4 c 803 2084 m 8 2 d
- -31 9 d 9 -7 d f 0 0.8 0.2 c 797 2082 m 6 2 d -14 4 d f 0 0.8 0.6 c 780 2095 m
- -4 3 d -23 -6 d 5 -4 d f 0 0.8 0.4 c 789 2088 m -9 7 d -22 -7 d 7 -6 d f 0 0.8
- 0.2 c 785 2079 m 12 3 d -8 6 d -24 -6 d 7 -5 d f 0 0.8 0 c 773 2076 m 12 3 d
- -13 -2 d f 0 0.8 0.8 c 748 2090 m -18 -4 d 7 -6 d f 0 0.8 0.6 c 758 2088 m -5 4
- d -5 -2 d -11 -10 d 12 -9 d f 0 0.8 0.4 c 750 2070 m 10 3 d 5 9 d -7 6 d -9 -17
- d f 0 0.8 0.2 c 760 2073 m 11 3 d 1 1 d -7 5 d f 0 0.8 0 c 771 2076 m 2 X -1 1
- d f 0 0.6 0.8 c 724 2084 m -18 -4 d 9 -7 d f 0 0.8 0.8 c 737 2080 m -7 6 d -6
- -2 d -9 -11 d 10 -7 d f 0 0.8 0.6 c 726 2064 m 22 6 d 1 1 d -12 9 d -12 -14 d f
- 0 0.8 0.4 c 748 2070 m 2 X -1 1 d f 0 0.6 0.8 c 715 2073 m -9 7 d -10 -3 d f 0
- 0.8 0.8 c 703 2058 m 3 1 d 19 7 d -10 7 d -19 4 d -9 -2 d 15 -16 d f 0 0.8 0.6
- c 706 2059 m 20 5 d -1 2 d -38 9 d -4 -1 d 19 -15 d f 0 0.8 0.8 c 703 2058 m -1
- 1 d f 0 0.8 0.6 c 693 2056 m 10 2 d -1 1 d -19 15 d -24 -6 d 8 -6 d f 0 0.8 0.4
- c 683 2053 m 10 3 d -26 6 d 9 -7 d f 0 0.8 0.2 c 679 2052 m 4 1 d -7 2 d f 0
- 0.4 0.8 c 641 2063 m -5 -1 d 2 -2 d f 0 0.6 0.8 c 649 2065 m -8 -2 d -3 -3 d 4
- -3 d f 0 0.8 0.8 c 657 2067 m -8 -2 d -7 -8 d 4 -3 d f 0 0.8 0.6 c 667 2062 m
- -8 6 d -2 -1 d -11 -13 d 4 -3 d f 0 0.8 0.4 c 676 2055 m -9 7 d -17 -11 d 4 -3
- d f 0 0.8 0.2 c 656 2046 m 23 6 d -3 3 d -22 -7 d f 0 0.4 0.8 c 638 2060 m -2 2
- d -5 -1 d f 0 0.6 0.8 c 642 2057 m -4 3 d -7 1 d -6 -2 d f 0 0.8 0.8 c 646 2054
- m -4 3 d -17 2 d -7 -2 d f 0 0.8 0.6 c 650 2051 m -4 3 d -28 3 d -6 -1 d 3 -2 d
- f 0 0.8 0.4 c 632 2040 m 3 1 d 19 7 d -4 3 d -35 3 d f 0 0.8 0.2 c 635 2041 m
- 21 5 d -2 2 d f 0 0.8 0.8 c 601 2053 m -12 -3 d 16 -13 d f 0 0.8 0.6 c 609 2034
- m 11 3 d -5 17 d -3 2 d -11 -3 d 4 -16 d f 0 0.8 0.4 c 620 2037 m 12 3 d -17 14
- d f 0 0.8 0.8 c 605 2037 m -16 13 d -8 -2 d f 0 0.8 0.6 c 585 2028 m 24 6 d -4
- 3 d -24 11 d -8 -2 d 6 -13 d f 0 0.8 0.4 c 573 2046 m -8 -2 d 14 -11 d f 0 0.6
- 0.8 c 542 2038 m 2 -2 d f 0 0.8 0.8 c 562 2022 m 7 2 d -19 16 d -8 -2 d 2 -2 d
- f 0 0.8 0.6 c 569 2024 m 16 4 d -6 5 d -21 9 d -8 -2 d f 0 0.8 0.4 c 579 2033 m
- -14 11 d -7 -2 d f 0 0 0.8 c 538 2016 m 5 2 d -19 16 d -6 -2 d f 0 0.2 0.8 c
- 543 2018 m 5 1 d -18 16 d -6 -1 d f 0 0.4 0.8 c 548 2019 m 5 1 d -17 17 d -6 -2
- d f 0 0.6 0.8 c 553 2020 m 5 1 d -14 15 d -2 2 d -6 -1 d f 0 0.8 0.8 c 558 2021
- m 4 1 d -18 14 d f 0 0 0.8 c 515 2010 m 23 6 d -20 16 d -23 -6 d f 491 2005 m
- 24 5 d -20 16 d -24 -6 d f 468 1999 m 23 6 d -20 15 d -23 -6 d f 1569 2258 m 23
- 6 d -20 16 d -24 -6 d f 1545 2252 m 24 6 d -21 16 d -23 -6 d f 1522 2246 m 23 6
- d -20 16 d -24 -6 d f 1519 2245 m 3 1 d -21 16 d -4 -2 d f 0 0.2 0.8 c 1516
- 2245 m 3 X -22 15 d -5 -1 d f 0 0.4 0.8 c 1513 2244 m 3 1 d -24 14 d -5 -1 d f
- 0 0.6 0.8 c 1510 2243 m 3 1 d -26 14 d -5 -1 d f 0 0.8 0.8 c 1508 2242 m 2 1 d
- -28 14 d -4 -1 d 1 -1 d f 0 0.8 0.6 c 1505 2242 m 3 X -29 13 d 6 -5 d f 0 0.8
- 0.4 c 1502 2241 m 3 1 d -20 8 d 6 -4 d f 0 0.8 0.2 c 1499 2240 m 3 1 d -11 5 d
- 6 -5 d f 0 0.8 0 c 1498 2240 m 1 X -2 1 d f 0 0.8 0.8 c 1479 2255 m -1 1 d -23
- -6 d 1 -1 d f 0 0.8 0.6 c 1485 2250 m -6 5 d -23 -6 d 6 -5 d f 0 0.8 0.4 c 1491
- 2246 m -6 4 d -23 -6 d 6 -4 d f 0 0.8 0.2 c 1497 2241 m -6 5 d -23 -6 d 6 -5 d
- f 0 0.8 0 c 1475 2234 m 23 6 d -1 1 d -23 -6 d f 0 0.8 0.8 c 1456 2249 m -1 1 d
- -4 -1 d f 0 0.8 0.6 c 1462 2244 m -6 5 d -5 X -16 -4 d f 0 0.8 0.4 c 1468 2240
- m -6 4 d -27 1 d -4 -1 d 4 -3 d f 0 0.8 0.2 c 1474 2235 m -6 5 d -33 1 d 5 -4 d
- f 0 0.8 0 c 1465 2232 m 10 2 d -1 1 d -34 2 d 5 -4 d f 0.2 0.8 0 c 1453 2229 m
- 12 3 d -20 1 d 6 -4 d f 0.4 0.8 0 c 1451 2228 m 2 1 d -2 X f 0 0.8 0.6 c 1424
- 2242 m -16 -4 d 6 -5 d f 0 0.8 0.4 c 1435 2241 m -4 3 d -7 -2 d -10 -9 d 10 -8
- d f 0 0.8 0.2 c 1428 2222 m 5 2 d 7 13 d -5 4 d -11 -16 d f 0 0.8 0 c 1433 2224
- m 9 2 d 3 7 d -5 4 d f 0.2 0.8 0 c 1442 2226 m 8 2 d 1 1 d -6 4 d f 0.4 0.8 0 c
- 1450 2228 m 1 X 1 Y f 0 0.8 0.8 c 1393 2234 m -9 -2 d 3 -3 d f 0 0.8 0.6 c 1414
- 2233 m -6 5 d -15 -4 d -6 -5 d 14 -10 d f 0 0.8 0.4 c 1404 2216 m 16 4 d 4 5 d
- -10 8 d -13 -14 d f 0 0.8 0.2 c 1420 2220 m 8 2 d -4 3 d f 0 0.8 0.8 c 1387
- 2229 m -3 3 d -4 -1 d f 0 0.8 0.6 c 1401 2219 m -14 10 d -7 2 d -15 -4 d f 0
- 0.8 0.4 c 1393 2213 m 11 3 d -3 3 d -36 8 d -4 -1 d 9 -8 d f 0 0.8 0.2 c 1381
- 2210 m 12 3 d -23 5 d f 0 0.8 0.8 c 1345 2222 m -8 -2 d 3 -2 d f 0 0.8 0.6 c
- 1357 2225 m -12 -3 d -5 -4 d 4 -4 d f 0 0.8 0.4 c 1370 2218 m -9 8 d -4 -1 d
- -13 -11 d 5 -3 d f 0 0.8 0.2 c 1377 2209 m 4 1 d -11 8 d -21 -7 d 4 -3 d f 0
- 0.8 0 c 1359 2205 m 18 4 d -24 -1 d 4 -4 d f 0.2 0.8 0 c 1357 2204 m 2 1 d -2
- -1 d f 0 0.8 0.8 c 1340 2218 m -3 2 d -7 -2 d f 0 0.8 0.6 c 1344 2214 m -4 4 d
- -10 X -11 -3 d f 0 0.8 0.4 c 1349 2211 m -5 3 d -25 1 d -5 -1 d 8 -6 d f 0 0.8
- 0.2 c 1334 2198 m 4 1 d 15 9 d -4 3 d -27 -3 d f 0 0.8 0 c 1338 2199 m 18 5 d 1
- X -4 4 d f 0.2 0.8 0 c 1356 2204 m 1 X f 0 0.8 0.8 c 1296 2209 m -6 -1 d 3 -2 d
- f 0 0.8 0.6 c 1308 2212 m -12 -3 d -3 -3 d 6 -5 d f 0 0.8 0.4 c 1322 2208 m -8
- 6 d -6 -2 d -9 -11 d 6 -4 d f 0 0.8 0.2 c 1310 2192 m 24 6 d -12 10 d -17 -11 d
- f 0 0.8 0.8 c 1293 2206 m -3 2 d -23 -6 d f 0 0.8 0.6 c 1299 2201 m -6 5 d -26
- -4 d 6 -5 d f 0 0.8 0.4 c 1305 2197 m -6 4 d -26 -4 d 6 -4 d f 0 0.8 0.2 c 1310
- 2192 m -5 5 d -26 -4 d 5 -5 d f 0 0.8 0 c 1287 2186 m 23 6 d -26 -4 d f 0 0.8
- 0.8 c 1267 2202 m -1 X f 0 0.8 0.6 c 1273 2197 m -6 5 d -1 X -15 -4 d f 0 0.8
- 0.4 c 1263 2180 m 2 1 d 14 12 d -6 4 d -22 1 d -8 -2 d f 0 0.8 0.2 c 1265 2181
- m 15 4 d 4 3 d -5 5 d f 0 0.8 0 c 1280 2185 m 7 1 d -3 2 d f 0 0.8 0.4 c 1262
- 2180 m 1 X -20 16 d -23 -6 d 8 -6 d f 0 0.8 0.2 c 1247 2176 m 15 4 d -34 4 d 8
- -7 d f 0 0.8 0 c 1240 2174 m 7 2 d -11 1 d f 0 0.6 0.8 c 1199 2185 m -3 -1 d 2
- -2 d f 0 0.8 0.8 c 1209 2187 m -10 -2 d -1 -3 d 8 -5 d f 0 0.8 0.6 c 1219 2190
- m -10 -3 d -3 -10 d 7 -6 d f 0 0.8 0.4 c 1216 2168 m 7 2 d 5 14 d -8 6 d -1 X
- -6 -19 d f 0 0.8 0.2 c 1223 2170 m 12 3 d 1 4 d -8 7 d f 0 0.8 0 c 1235 2173 m
- 5 1 d -4 3 d f 0 0.6 0.8 c 1198 2182 m -2 2 d -4 -1 d f 0 0.8 0.8 c 1206 2177 m
- -8 5 d -6 1 d -12 -3 d f 0 0.8 0.6 c 1213 2171 m -7 6 d -26 3 d -7 -2 d 6 -5 d
- f 0 0.8 0.4 c 1193 2162 m 23 6 d -3 3 d -34 2 d f 0 0.8 0.6 c 1179 2173 m -6 5
- d -24 -6 d 2 -2 d f 0 0.8 0.4 c 1192 2162 m 1 X -14 11 d -28 -3 d 6 -4 d f 0
- 0.8 0.2 c 1182 2160 m 10 2 d -35 4 d 5 -4 d f 0 0.8 0 c 1172 2157 m 10 3 d -20
- 2 d 6 -4 d f 0.2 0.8 0 c 1170 2156 m 2 1 d -4 1 d f 0 0.8 0.6 c 1151 2170 m -2
- 2 d -23 -6 d 19 -15 d f 0 0.8 0.4 c 1146 2150 m 7 2 d 4 14 d -6 4 d -6 -19 d f
- 0 0.8 0.2 c 1153 2152 m 7 2 d 2 8 d -5 4 d f 0 0.8 0 c 1160 2154 m 7 2 d 1 2 d
- -6 4 d f 0.2 0.8 0 c 1167 2156 m 3 X -2 2 d f 0 0.8 0.6 c 1145 2151 m -19 15 d
- -24 -6 d 2 -1 d f 0 0.8 0.4 c 1135 2148 m 11 2 d -1 1 d -41 8 d 9 -7 d f 0 0.8
- 0.2 c 1123 2144 m 12 4 d -22 4 d f 0 0.8 0.6 c 1104 2159 m -2 1 d -4 -1 d f 0
- 0.8 0.4 c 1099 2138 m 8 2 d 6 12 d -9 7 d -6 X -19 -5 d f 0 0.8 0.2 c 1107 2140
- m 16 4 d -10 8 d f 0 0.8 0.8 c 1063 2150 m -8 -2 d 3 -2 d f 0 0.8 0.6 c 1072
- 2152 m -9 -2 d -5 -4 d 4 -3 d f 0 0.8 0.4 c 1096 2138 m 3 X -20 16 d -7 -2 d
- -10 -9 d 3 -3 d f 0 0.8 0.2 c 1089 2136 m 7 2 d -31 2 d 4 -2 d f 0 0.8 0 c 1082
- 2134 m 7 2 d -20 2 d 3 -3 d f 0.2 0.8 0 c 1076 2132 m 6 2 d -10 1 d f 0 0.8 0.8
- c 1058 2146 m -3 2 d -7 -2 d f 0 0.8 0.6 c 1062 2143 m -4 3 d -10 X -9 -2 d f 0
- 0.8 0.4 c 1065 2140 m -3 3 d -23 1 d -7 -2 d 2 -2 d f 0 0.8 0.2 c 1052 2126 m 4
- 2 d 13 10 d -4 2 d -31 X f 0 0.8 0 c 1056 2128 m 10 2 d 6 5 d -3 3 d f 0.2 0.8
- 0 c 1066 2130 m 10 2 d -4 3 d f 0 0.8 0.8 c 1009 2136 m -1 X 1 X f 0 0.8 0.6 c
- 1021 2139 m -12 -3 d 11 -9 d f 0 0.8 0.4 c 1029 2121 m 8 2 d -3 17 d -2 2 d -11
- -3 d -1 -12 d f 0 0.8 0.2 c 1037 2123 m 15 3 d -18 14 d f 0 0.8 0.8 c 1009 2136
- m -1 X f 0 0.8 0.6 c 1020 2127 m -11 9 d -1 X -12 -3 d f 0 0.8 0.4 c 1012 2116
- m 17 5 d -9 6 d -24 6 d -11 -3 d 7 -6 d f 0 0.8 0.2 c 1005 2115 m 7 1 d -20 8 d
- f 0 0.8 0.8 c 962 2124 m -1 X 1 X f 0 0.8 0.6 c 974 2127 m -12 -3 d 11 -9 d f 0
- 0.8 0.4 c 982 2109 m 16 4 d -6 11 d -7 6 d -11 -3 d -1 -12 d f 0 0.8 0.2 c 998
- 2113 m 7 2 d -13 9 d f 0 0.8 0.8 c 962 2124 m -1 X f 0 0.8 0.6 c 973 2115 m -11
- 9 d -1 X -16 -4 d f 0 0.8 0.4 c 979 2108 m 3 1 d -9 6 d -28 5 d -7 -2 d 4 -3 d
- f 0 0.8 0.2 c 969 2105 m 10 3 d -37 7 d 8 -6 d f 0 0.8 0 c 959 2103 m 10 2 d
- -19 4 d 7 -6 d f 0.2 0.8 0 c 958 2103 m 1 X -2 X f 0 0.8 0.4 c 935 2097 m 6 1 d
- 1 17 d -4 3 d -24 -6 d f 0 0.8 0.2 c 941 2098 m 8 2 d 1 9 d -8 6 d f 0 0.8 0 c
- 949 2100 m 8 2 d 1 Y -7 6 d f 0.2 0.8 0 c 957 2102 m 1 1 d -1 X f 0 0.8 0.6 c
- 911 2091 m 16 4 d -30 6 d f 0 0.8 0.4 c 927 2095 m 8 2 d -21 15 d -23 -6 d 6 -5
- d f 0 0.8 0.6 c 898 2087 m 13 4 d -14 10 d f 0 0.8 0.4 c 888 2085 m 10 2 d -1
- 14 d -6 5 d -24 -6 d f 881 2083 m 7 2 d -21 15 d -10 -2 d f 0 0.8 0.2 c 869
- 2080 m 12 3 d -24 15 d -13 -4 d f 0 0.8 0 c 864 2079 m 5 1 d -25 14 d f 0 0.8
- 0.8 c 822 2089 m -2 -1 d 3 -2 d f 0 0.8 0.6 c 829 2091 m -7 -2 d 1 -3 d 12 -9 d
- f 0 0.8 0.4 c 841 2073 m 6 1 d -10 18 d -8 -1 d 6 -14 d f 0 0.8 0.2 c 847 2074
- m 12 3 d -15 17 d -7 -2 d f 0 0.8 0 c 859 2077 m 5 2 d -20 15 d f 0 0.8 0.8 c
- 823 2086 m -3 2 d -2 X f 0 0.8 0.6 c 835 2077 m -12 9 d -5 2 d -7 -2 d f 0 0.8
- 0.4 c 835 2071 m 6 2 d -6 4 d -24 9 d -8 -2 d f 0 0.8 0.2 c 824 2068 m 11 3 d
- -32 13 d -6 -2 d 5 -4 d f 0 0.8 0 c 817 2067 m 7 1 d -22 10 d f 0 0.8 0.2 c 802
- 2078 m -5 4 d -12 -3 d f 0 0.8 0 c 811 2065 m 6 2 d -15 11 d -17 1 d -12 -3 d
- 10 -7 d f 0.2 0.8 0 c 794 2061 m 17 4 d -28 4 d f 0 0.8 0.4 c 760 2073 m -10 -3
- d 9 -7 d f 0 0.8 0.2 c 771 2076 m -11 -3 d -1 -10 d 9 -7 d f 0 0.8 0 c 770 2055
- m 11 2 d 2 12 d -10 7 d -2 X -3 -20 d f 0.2 0.8 0 c 781 2057 m 13 4 d -11 8 d f
- 0 0.8 0.6 c 748 2070 m -22 -6 d 7 -5 d f 0 0.8 0.4 c 759 2063 m -9 7 d -2 X -15
- -11 d 8 -6 d f 0 0.8 0.2 c 747 2049 m 11 3 d 10 4 d -9 7 d -18 -10 d f 0 0.8 0
- c 758 2052 m 12 3 d -2 1 d f 0 0.8 0.8 c 706 2059 m -3 -1 d 1 -1 d f 0 0.8 0.6
- c 723 2043 m 6 1 d 4 15 d -7 5 d -20 -5 d -2 -2 d f 0 0.8 0.4 c 729 2044 m 10 3
- d 2 6 d -8 6 d f 0 0.8 0.2 c 739 2047 m 8 2 d -6 4 d f 0 0.8 0.8 c 704 2057 m
- -1 1 d f 0 0.8 0.6 c 710 2039 m 13 4 d -19 14 d -1 1 d -10 -2 d f 0 0.8 0.4 c
- 700 2037 m 10 2 d -17 17 d -10 -3 d 5 -7 d f 0 0.8 0.2 c 683 2053 m -4 -1 d 9
- -6 d f 0 0.8 0.4 c 695 2036 m 5 1 d -12 9 d f 0 0.8 0.2 c 687 2034 m 8 2 d -7
- 10 d -9 6 d -23 -6 d 5 -4 d f 0 0.8 0 c 679 2031 m 8 3 d -26 8 d 12 -9 d f 0.2
- 0.8 0 c 676 2031 m 3 X -6 2 d f 0 0.8 0.4 c 635 2041 m -3 -1 d 1 X f 0 0.8 0.2
- c 661 2042 m -5 4 d -21 -5 d -2 -1 d 12 -9 d f 0 0.8 0 c 653 2025 m 12 3 d 8 5
- d -12 9 d -16 -11 d f 0.2 0.8 0 c 665 2028 m 11 3 d -3 2 d f 0 0.8 0.6 c 620
- 2037 m -11 -3 d 8 -6 d f 0 0.8 0.4 c 633 2040 m -1 X -12 -3 d -3 -9 d 11 -8 d f
- 0 0.8 0.2 c 629 2019 m 14 3 d 2 9 d -12 9 d -5 -20 d f 0 0.8 0 c 643 2022 m 10
- 3 d -8 6 d f 0 0.8 0.6 c 617 2028 m -8 6 d -24 -6 d 3 -1 d f 0 0.8 0.4 c 628
- 2020 m -11 8 d -29 -1 d 6 -5 d f 0 0.8 0.2 c 619 2016 m 10 3 d -1 1 d -34 2 d 5
- -4 d f 0 0.8 0 c 607 2013 m 12 3 d -20 2 d 6 -5 d f 0.2 0.8 0 c 606 2013 m 1 X
- -2 X f 0 0.8 0.8 c 569 2024 m -7 -2 d 6 -4 d f 0 0.8 0.6 c 582 2007 m 3 1 d 3
- 19 d -3 1 d -16 -4 d -1 -6 d f 0 0.8 0.4 c 585 2008 m 7 1 d 2 13 d -6 5 d f 0
- 0.8 0.2 c 592 2009 m 6 2 d 1 7 d -5 4 d f 0 0.8 0 c 598 2011 m 7 2 d -6 5 d f
- 0.2 0.8 0 c 605 2013 m 1 X -1 X f 0 0 0.8 c 559 2001 m 4 1 d -20 16 d -5 -2 d f
- 0 0.2 0.8 c 563 2002 m 4 1 d -19 16 d -5 -1 d f 0 0.4 0.8 c 567 2003 m 4 1 d
- -18 16 d -5 -1 d f 0 0.6 0.8 c 571 2004 m 5 1 d -18 16 d -5 -1 d f 0 0.8 0.8 c
- 576 2005 m 4 1 d -12 12 d -6 4 d -4 -1 d f 0 0.8 0.6 c 580 2006 m 2 1 d -14 11
- d f 0 0 0.8 c 535 1995 m 24 6 d -21 15 d -23 -6 d f 512 1989 m 23 6 d -20 15 d
- -24 -5 d f 488 1983 m 24 6 d -21 16 d -23 -6 d f 1589 2243 m 24 5 d -21 16 d
- -23 -6 d f 1566 2237 m 23 6 d -20 15 d -24 -6 d f 1542 2231 m 24 6 d -21 15 d
- -23 -6 d f 1540 2230 m 2 1 d -20 15 d -3 -1 d f 0 0.2 0.8 c 1538 2230 m 2 X -21
- 15 d -3 X f 0 0.4 0.8 c 1536 2229 m 2 1 d -22 15 d -3 -1 d f 0 0.6 0.8 c 1534
- 2229 m 2 X -23 15 d -3 -1 d f 0 0.8 0.8 c 1532 2228 m 2 1 d -24 14 d -2 -1 d f
- 0 0.8 0.6 c 1531 2228 m 1 X -24 14 d -3 X f 0 0.8 0.4 c 1529 2227 m 2 1 d -26
- 14 d -3 -1 d f 0 0.8 0.2 c 1527 2227 m 2 X -27 14 d -3 -1 d f 0 0.8 0 c 1525
- 2226 m 2 1 d -28 13 d -1 X 4 -3 d f 0.2 0.8 0 c 1523 2226 m 2 X -23 11 d 6 -4 d
- f 0.4 0.8 0 c 1521 2225 m 2 1 d -15 7 d 5 -4 d f 0.6 0.8 0 c 1519 2225 m 2 X -8
- 4 d 5 -4 d f 0.8 0.8 0 c 1519 2225 m -1 X f 0 0.8 0 c 1502 2237 m -4 3 d -23 -6
- d 10 -8 d f 0.2 0.8 0 c 1495 2219 m 3 X 10 14 d -6 4 d -17 -11 d f 0.4 0.8 0 c
- 1498 2219 m 10 3 d 5 7 d -5 4 d f 0.6 0.8 0 c 1508 2222 m 10 2 d 1 Y -5 4 d f
- 0.8 0.8 0 c 1518 2224 m 1 1 d -1 X f 0 0.8 0 c 1485 2226 m -10 8 d -10 -2 d f
- 0.2 0.8 0 c 1481 2215 m 14 4 d -10 7 d -20 6 d -12 -3 d f 0.4 0.8 0 c 1472 2213
- m 9 2 d -28 14 d -2 -1 d f 0 0.8 0.6 c 1448 2207 m 2 X -6 3 d f 0 0.8 0.4 c
- 1450 2207 m 5 1 d -23 11 d 12 -9 d f 0 0.8 0.2 c 1455 2208 m 6 2 d -28 14 d -5
- -2 d 4 -3 d f 0 0.8 0 c 1461 2210 m 5 1 d -24 15 d -9 -2 d f 0.2 0.8 0 c 1466
- 2211 m 5 1 d -21 16 d -8 -2 d f 0.4 0.8 0 c 1471 2212 m 1 1 d -21 15 d -1 X f 0
- 0.8 0.6 c 1446 2206 m 2 1 d -4 3 d f 0 0.8 0.4 c 1442 2205 m 4 1 d -2 4 d -12 9
- d -12 1 d -16 -4 d 4 -2 d f 0 0.8 0.2 c 1437 2204 m 5 1 d -10 14 d -4 3 d -8 -2
- d -12 -6 d 5 -4 d f 0 0.8 0 c 1432 2203 m 5 1 d -24 6 d 4 -4 d f 0.2 0.8 0 c
- 1428 2201 m 4 2 d -15 3 d 5 -3 d f 0.4 0.8 0 c 1425 2201 m 3 X -6 2 d f 0 0.8
- 0.4 c 1401 2195 m 1 X 6 19 d -4 2 d -11 -3 d 6 -17 d f 0 0.8 0.2 c 1402 2195 m
- 6 1 d 5 14 d -5 4 d -15 -1 d -12 -3 d 18 -14 d f 0 0.8 0 c 1408 2196 m 7 2 d 2
- 8 d -4 4 d f 0.2 0.8 0 c 1415 2198 m 6 2 d 1 3 d -5 3 d f 0.4 0.8 0 c 1421 2200
- m 4 1 d -3 2 d f 0 0.8 0.4 c 1401 2195 m -2 1 d f 0 0.8 0.2 c 1394 2193 m 7 2 d
- -2 1 d -18 14 d -4 -1 d f 0 0.8 0 c 1387 2191 m 7 2 d -17 16 d -18 -4 d f 0.2
- 0.8 0 c 1380 2189 m 7 2 d -28 14 d -2 -1 d 15 -11 d f 0.4 0.8 0 c 1378 2189 m 2
- X -8 4 d f 0 0.8 0.2 c 1338 2199 m -4 -1 d 2 -1 d f 0 0.8 0 c 1356 2204 m -18
- -5 d -2 -2 d 11 -8 d f 0.2 0.8 0 c 1354 2183 m 10 2 d 8 8 d -15 11 d -1 X -9
- -15 d f 0.4 0.8 0 c 1364 2185 m 14 4 d -6 4 d f 0 0.8 0.2 c 1336 2197 m -2 1 d
- -24 -6 d f 0 0.8 0 c 1347 2189 m -11 8 d -26 -5 d 11 -8 d f 0.2 0.8 0 c 1331
- 2177 m 23 6 d -7 6 d -26 -5 d f 0 0.8 0 c 1321 2184 m -11 8 d -23 -6 d 9 -7 d f
- 0.2 0.8 0 c 1307 2171 m 24 6 d -10 7 d -25 -5 d f 0 0.8 0.4 c 1265 2181 m -2 -1
- d 4 -3 d f 0 0.8 0.2 c 1284 2165 m 6 1 d -10 19 d -15 -4 d 2 -4 d f 0 0.8 0 c
- 1290 2166 m 10 3 d -4 10 d -9 7 d -7 -1 d f 0.2 0.8 0 c 1300 2169 m 7 2 d -11 8
- d f 0 0.8 0.4 c 1267 2177 m -4 3 d -1 X f 0 0.8 0.2 c 1260 2159 m 24 6 d -17 12
- d -5 3 d -15 -4 d -7 Y f 0 0.8 0 c 1247 2176 m -7 -2 d 7 -5 d f 0 0.8 0.4 c
- 1223 2170 m -7 -2 d 4 -2 d f 0 0.8 0.2 c 1251 2156 m 9 3 d -13 10 d -12 4 d -12
- -3 d -3 -4 d 7 -6 d f 0 0.8 0 c 1240 2154 m 11 2 d -4 13 d -7 5 d -5 -1 d -8
- -13 d 8 -6 d f 0.2 0.8 0 c 1237 2153 m 3 1 d -5 X f 0 0.8 0.4 c 1220 2166 m -4
- 2 d -23 -6 d 3 -2 d f 0 0.8 0.2 c 1213 2147 m 6 1 d 8 12 d -7 6 d -24 -6 d f 0
- 0.8 0 c 1219 2148 m 14 4 d 2 2 d -8 6 d f 0.2 0.8 0 c 1233 2152 m 4 1 d -2 1 d
- f 0 0.8 0.4 c 1196 2160 m -3 2 d -1 X f 0 0.8 0.2 c 1210 2146 m 3 1 d -17 13 d
- -4 2 d -10 -2 d f 0 0.8 0 c 1203 2144 m 7 2 d -28 14 d -10 -3 d f 0.2 0.8 0 c
- 1196 2142 m 7 2 d -31 13 d -2 -1 d 9 -7 d f 0.4 0.8 0 c 1190 2141 m 6 1 d -17 7
- d f 0 0.8 0.4 c 1153 2152 m -7 -2 d 6 -4 d f 0 0.8 0.2 c 1160 2154 m -7 -2 d -1
- -6 d 6 -5 d f 0 0.8 0 c 1167 2156 m -7 -2 d -2 -13 d 6 -5 d f 0.2 0.8 0 c 1166
- 2135 m 11 3 d 2 11 d -9 7 d -3 X -3 -20 d f 0.4 0.8 0 c 1177 2138 m 13 3 d -11
- 8 d f 0 0.8 0.4 c 1143 2129 m 3 1 d 6 16 d -6 4 d -11 -2 d 3 -16 d f 0 0.8 0.2
- c 1146 2130 m 9 2 d 3 9 d -6 5 d -17 2 d -12 -4 d 15 -12 d f 0 0.8 0 c 1155
- 2132 m 9 2 d 2 Y -6 5 d -35 3 d f 0.2 0.8 0 c 1164 2134 m 2 1 d -2 1 d f 0 0.8
- 0.4 c 1139 2128 m 4 1 d -5 3 d -31 8 d -8 -2 d 5 -4 d f 0 0.8 0.2 c 1125 2124 m
- 14 4 d -1 4 d -15 12 d -16 -4 d -3 -6 d 11 -8 d f 0 0.8 0 c 1119 2123 m 6 1 d
- -2 20 d -8 -18 d f 0 0.8 0.4 c 1104 2134 m -5 4 d -3 X f 0 0.8 0.2 c 1115 2126
- m -11 8 d -8 4 d -7 -2 d f 0 0.8 0 c 1104 2119 m 15 4 d -4 3 d -26 10 d -7 -2 d
- f 0.2 0.8 0 c 1096 2117 m 8 2 d -22 15 d -6 -2 d f 0 0.8 0.2 c 1056 2128 m -4
- -2 d 14 -10 d f 0 0.8 0 c 1072 2111 m 17 4 d -23 15 d -10 -2 d 10 -12 d f 0.2
- 0.8 0 c 1089 2115 m 7 2 d -20 15 d -10 -2 d f 0 0.8 0.4 c 1037 2123 m -8 -2 d 1
- -2 d f 0 0.8 0.2 c 1066 2116 m -14 10 d -15 -3 d -7 -4 d 6 -4 d f 0 0.8 0 c
- 1063 2109 m 9 2 d -6 5 d -30 -1 d 6 -5 d f 0.2 0.8 0 c 1051 2105 m 12 4 d -21 1
- d 6 -4 d f 0.4 0.8 0 c 1049 2105 m 2 X -3 1 d f 0 0.8 0.4 c 1030 2119 m -1 2 d
- -17 -5 d f 0 0.8 0.2 c 1025 2099 m 3 1 d 8 15 d -6 4 d -18 -3 d -7 -1 d f 0 0.8
- 0 c 1028 2100 m 9 2 d 5 8 d -6 5 d f 0.2 0.8 0 c 1037 2102 m 10 3 d 1 1 d -6 4
- d f 0.4 0.8 0 c 1047 2105 m 2 X -1 1 d f 0 0.8 0.4 c 998 2113 m -16 -4 d 7 -6 d
- f 0 0.8 0.2 c 1002 2093 m 23 6 d -20 16 d -7 -2 d -9 -10 d f 0 0.8 0.4 c 989
- 2103 m -7 6 d -3 -1 d f 0 0.8 0.2 c 986 2089 m 16 4 d -13 10 d -10 5 d -10 -3 d
- f 0 0.8 0 c 978 2087 m 8 2 d -17 16 d -10 -2 d 1 -2 d f 0.2 0.8 0 c 959 2103 m
- -1 X 2 -2 d f 0 0.8 0.4 c 941 2098 m -6 -1 d 3 -3 d f 0 0.8 0.2 c 949 2100 m -8
- -2 d -3 -4 d 5 -4 d f 0 0.8 0 c 970 2085 m 8 2 d -18 14 d -3 1 d -8 -2 d -6 -10
- d 5 -4 d f 0.2 0.8 0 c 959 2082 m 11 3 d -10 16 d -2 2 d -1 -1 d -9 -16 d 5 -4
- d f 0.4 0.8 0 c 955 2081 m 4 1 d -6 X f 0 0.8 0.6 c 927 2095 m -16 -4 d 2 -2 d
- f 0 0.8 0.4 c 938 2094 m -3 3 d -8 -2 d -14 -6 d 3 -2 d f 0 0.8 0.2 c 943 2090
- m -5 4 d -22 -7 d 4 -3 d f 0 0.8 0 c 948 2086 m -5 4 d -23 -6 d 3 -3 d f 0.2
- 0.8 0 c 953 2082 m -5 4 d -25 -5 d 4 -2 d f 0.4 0.8 0 c 941 2078 m 14 3 d -2 1
- d -26 -3 d 3 -3 d f 0.6 0.8 0 c 931 2075 m 10 3 d -11 -2 d f 0 0.8 0.6 c 913
- 2089 m -2 2 d -13 -4 d f 0 0.8 0.4 c 916 2087 m -3 2 d -15 -2 d -10 -2 d 7 -6 d
- f 0 0.8 0.2 c 908 2069 m 12 15 d -4 3 d -21 -8 d f 0 0.8 0 c 908 2069 m 7 2 d 8
- 10 d -3 3 d f 0.2 0.8 0 c 915 2071 m 7 2 d 5 6 d -4 2 d f 0.4 0.8 0 c 922 2073
- m 6 1 d 2 2 d -3 3 d f 0.6 0.8 0 c 928 2074 m 3 1 d -1 1 d f 0 0.8 0.4 c 895
- 2079 m -7 6 d -7 -2 d f 0 0.8 0.2 c 908 2069 m -13 10 d -14 4 d -12 -3 d f 0
- 0.8 0 c 884 2063 m 24 6 d -39 11 d -5 -1 d f 0 0.8 0.4 c 847 2074 m -6 -1 d 2
- -2 d f 0 0.8 0.2 c 859 2077 m -12 -3 d -4 -3 d 5 -4 d f 0 0.8 0 c 881 2062 m 3
- 1 d -20 16 d -5 -2 d -11 -10 d 4 -3 d f 0.2 0.8 0 c 870 2059 m 11 3 d -29 2 d 5
- -4 d f 0.4 0.8 0 c 861 2057 m 9 2 d -13 1 d f 0 0.8 0.4 c 838 2051 m 2 1 d 3 19
- d -2 2 d -6 -2 d -2 -16 d f 0 0.8 0.2 c 840 2052 m 6 1 d 2 14 d -5 4 d -8 X -11
- -3 d -1 -6 d 10 -7 d f 0 0.8 0 c 846 2053 m 5 2 d 1 9 d -4 3 d -24 1 d -7 -1 d
- 6 -5 d f 0.2 0.8 0 c 851 2055 m 6 1 d 4 Y -5 4 d f 0.4 0.8 0 c 857 2056 m 4 1 d
- -4 3 d f 0 0.8 0.4 c 833 2050 m 5 1 d -5 4 d f 0 0.8 0.2 c 825 2048 m 8 2 d 5 Y
- -10 7 d f 0 0.8 0 c 817 2046 m 8 2 d -2 14 d -6 5 d -6 -2 d f 0.2 0.8 0 c 814
- 2045 m 3 1 d -6 19 d -17 -4 d f 0 0.8 0 c 791 2039 m 12 3 d -22 15 d -11 -2 d f
- 0.2 0.8 0 c 803 2042 m 11 3 d -20 16 d -13 -4 d f 0 0.8 0.2 c 758 2052 m -11 -3
- d 1 -1 d f 0 0.8 0 c 788 2039 m 3 X -21 16 d -12 -3 d -10 -4 d 5 -4 d f 0.2 0.8
- 0 c 781 2037 m 7 2 d -35 5 d 5 -4 d f 0.4 0.8 0 c 774 2035 m 7 2 d -23 3 d 5 -3
- d f 0.6 0.8 0 c 767 2033 m 7 2 d -11 2 d f 0 0.8 0.6 c 729 2044 m -6 -1 d 3 -2
- d f 0 0.8 0.4 c 739 2047 m -10 -3 d -3 -3 d 5 -4 d f 0 0.8 0.2 c 748 2048 m -1
- 1 d -8 -2 d -8 -10 d 5 -4 d f 0 0.8 0 c 753 2044 m -5 4 d -12 -15 d 5 -4 d f
- 0.2 0.8 0 c 744 2027 m 4 1 d 10 12 d -5 4 d -12 -15 d f 0.4 0.8 0 c 748 2028 m
- 10 3 d 5 6 d -5 3 d f 0.6 0.8 0 c 758 2031 m 9 2 d -4 4 d f 0 0.8 0.6 c 726
- 2041 m -3 2 d -13 -4 d f 0 0.8 0.4 c 731 2037 m -5 4 d -16 -2 d -10 -2 d 7 -5 d
- f 0 0.8 0.2 c 720 2021 m 16 12 d -5 4 d -24 -5 d f 0 0.8 0 c 720 2021 m 16 4 d
- 5 4 d -5 4 d f 0.2 0.8 0 c 736 2025 m 8 2 d -3 2 d f 0 0.8 0.4 c 707 2032 m -7
- 5 d -5 -1 d f 0 0.8 0.2 c 720 2021 m -13 11 d -12 4 d -8 -2 d f 0 0.8 0 c 697
- 2015 m 23 6 d -33 13 d -8 -3 d 11 -11 d f 0.2 0.8 0 c 679 2031 m -3 X 14 -11 d
- f 0 0.8 0 c 695 2015 m 2 X -7 5 d -25 8 d -12 -3 d 3 -2 d f 0.2 0.8 0 c 685
- 2012 m 10 3 d -5 5 d -14 11 d -11 -3 d -9 -5 d 7 -6 d f 0.4 0.8 0 c 675 2010 m
- 10 2 d -22 5 d 8 -6 d f 0.6 0.8 0 c 673 2009 m 2 1 d -4 1 d f 0 0.8 0.2 c 643
- 2022 m -14 -3 d 8 -6 d f 0 0.8 0 c 656 2023 m -3 2 d -10 -3 d -6 -9 d 10 -8 d f
- 0.2 0.8 0 c 650 2003 m 8 2 d 5 12 d -7 6 d -9 -18 d f 0.4 0.8 0 c 658 2005 m 12
- 4 d 1 2 d -8 6 d f 0.6 0.8 0 c 670 2009 m 3 X -2 2 d f 0 0.8 0.2 c 637 2013 m
- -8 6 d -10 -3 d f 0 0.8 0 c 647 2005 m -10 8 d -18 3 d -12 -3 d f 0.2 0.8 0 c
- 640 2001 m 10 2 d -3 2 d -40 8 d -1 X 9 -7 d f 0.4 0.8 0 c 626 1997 m 14 4 d
- -25 5 d 11 -8 d f 0.6 0.8 0 c 626 1997 m 1 Y f 0 0.8 0.6 c 585 2008 m -3 -1 d 2
- -1 d f 0 0.8 0.4 c 592 2009 m -7 -1 d -1 -2 d 3 -3 d f 0 0.8 0.2 c 598 2011 m
- -6 -2 d -5 -6 d 3 -2 d f 0 0.8 0 c 605 2013 m -7 -2 d -8 -10 d 3 -2 d f 0.2 0.8
- 0 c 615 2006 m -9 7 d -1 X -12 -14 d 3 -3 d f 0.4 0.8 0 c 626 1998 m -11 8 d
- -19 -10 d 4 -2 d f 0.6 0.8 0 c 603 1991 m 23 6 d 1 Y -26 -4 d f 0 0 0.8 c 579
- 1985 m 2 1 d -18 16 d -4 -1 d f 0 0.2 0.8 c 581 1986 m 2 X -16 17 d -4 -1 d f 0
- 0.4 0.8 c 583 1986 m 2 1 d -14 17 d -4 -1 d f 0 0.6 0.8 c 585 1987 m 2 X -11 18
- d -5 -1 d f 0 0.8 0.8 c 587 1987 m 2 1 d -9 18 d -4 -1 d f 0 0.8 0.6 c 589 1988
- m 2 X -7 18 d -2 1 d -2 -1 d f 0 0.8 0.4 c 591 1988 m 2 1 d -6 14 d -3 3 d f 0
- 0.8 0.2 c 593 1989 m 2 X -5 12 d -3 2 d f 0 0.8 0 c 595 1989 m 2 1 d -4 9 d -3
- 2 d f 0.2 0.8 0 c 597 1990 m 2 X -3 6 d -3 3 d f 0.4 0.8 0 c 599 1990 m 2 1 d
- -1 3 d -4 2 d f 0.6 0.8 0 c 601 1991 m 2 X -3 3 d f 0 0 0.8 c 556 1979 m 23 6 d
- -20 16 d -24 -6 d f 532 1973 m 24 6 d -21 16 d -23 -6 d f 509 1967 m 23 6 d -20
- 16 d -24 -6 d f 1610 2227 m 23 6 d -20 15 d -24 -5 d f 1586 2221 m 24 6 d -21
- 16 d -23 -6 d f 1563 2215 m 23 6 d -20 16 d -24 -6 d f 1560 2214 m 3 1 d -21 16
- d -2 -1 d f 0 0.2 0.8 c 1558 2214 m 2 X -20 16 d -2 X f 0 0.4 0.8 c 1556 2213 m
- 2 1 d -20 16 d -2 -1 d f 0 0.6 0.8 c 1554 2213 m 2 X -20 16 d -2 X f 0 0.8 0.8
- c 1552 2212 m 2 1 d -20 16 d -2 -1 d f 0 0.8 0.6 c 1550 2212 m 2 X -20 16 d -1
- X f 0 0.8 0.4 c 1548 2211 m 2 1 d -19 16 d -2 -1 d f 0 0.8 0.2 c 1546 2211 m 2
- X -19 16 d -2 X f 0 0.8 0 c 1544 2210 m 2 1 d -19 16 d -2 -1 d f 0.2 0.8 0 c
- 1542 2210 m 2 X -19 16 d -2 X f 0.4 0.8 0 c 1540 2209 m 2 1 d -19 16 d -2 -1 d
- f 0.6 0.8 0 c 1539 2209 m 1 X -19 16 d -2 X 2 -2 d f 0.8 0.8 0 c 1519 2225 m 2
- -2 d f 0.2 0.8 0 c 1498 2219 m -3 X 13 -10 d f 0.4 0.8 0 c 1516 2203 m 18 5 d
- -26 14 d -10 -3 d 10 -10 d f 0.6 0.8 0 c 1534 2208 m 5 1 d -18 14 d -3 1 d -10
- -2 d f 0.8 0.8 0 c 1521 2223 m -2 2 d -1 -1 d f 0.2 0.8 0 c 1508 2209 m -13 10
- d -14 -4 d f 0.4 0.8 0 c 1492 2197 m 24 6 d -8 6 d -27 6 d -9 -2 d f 0 0.8 0.6
- c 1450 2207 m -2 X 2 -2 d f 0 0.8 0.4 c 1455 2208 m -5 -1 d -2 Y 4 -3 d f 0 0.8
- 0.2 c 1461 2210 m -6 -2 d -1 -6 d 4 -3 d f 0 0.8 0 c 1466 2211 m -5 -1 d -3 -11
- d 4 -3 d f 0.2 0.8 0 c 1471 2212 m -5 -1 d -4 -15 d 4 -3 d f 0.4 0.8 0 c 1469
- 2191 m 23 6 d -20 16 d -1 -1 d -5 -19 d f 0 0.8 0.6 c 1450 2205 m -2 2 d -2 -1
- d f 0 0.8 0.4 c 1454 2202 m -4 3 d -4 1 d -4 -1 d f 0 0.8 0.2 c 1458 2199 m -4
- 3 d -12 3 d -5 -1 d f 0 0.8 0 c 1445 2185 m 4 1 d 13 10 d -4 3 d -21 5 d -5 -1
- d 9 -15 d f 0.2 0.8 0 c 1449 2186 m 12 3 d 5 4 d -4 3 d -30 7 d -4 -2 d 3 -5 d
- 10 -8 d f 0.4 0.8 0 c 1461 2189 m 8 2 d -3 2 d -38 8 d -3 X 6 -5 d f 0 0.8 0.4
- c 1402 2195 m -1 X 1 -1 d f 0 0.8 0.2 c 1408 2196 m -6 -1 d -1 Y 7 -5 d f 0 0.8
- 0 c 1437 2183 m 8 2 d -4 3 d -26 10 d -7 -2 d 1 -7 d 7 -6 d f 0.2 0.8 0 c 1422
- 2179 m 15 4 d 4 5 d -10 8 d -10 4 d -6 -2 d 1 -15 d f 0.4 0.8 0 c 1431 2196 m
- -6 5 d -4 -1 d f 0 0.8 0.4 c 1402 2194 m -1 1 d f 0 0.8 0.2 c 1409 2189 m -7 5
- d -1 1 d -7 -2 d f 0 0.8 0 c 1416 2183 m -7 6 d -15 4 d -7 -2 d f 0.2 0.8 0 c
- 1398 2173 m 24 6 d -6 4 d -29 8 d -7 -2 d 10 -9 d f 0.4 0.8 0 c 1380 2189 m -2
- X 12 -9 d f 0 0.8 0 c 1375 2167 m 13 4 d -25 5 d f 0.2 0.8 0 c 1388 2171 m 10 2
- d -8 7 d -26 5 d -10 -2 d 9 -7 d f 0.4 0.8 0 c 1390 2180 m -12 9 d -14 -4 d f 0
- 0.8 0 c 1371 2166 m 4 1 d -12 9 d f 0.2 0.8 0 c 1367 2165 m 4 1 d -8 10 d -9 7
- d -23 -6 d f 0.4 0.8 0 c 1364 2164 m 3 1 d -36 12 d 5 -4 d f 0.6 0.8 0 c 1360
- 2163 m 4 1 d -28 9 d 4 -3 d f 0.8 0.8 0 c 1357 2163 m 3 X -20 7 d 4 -4 d f 0.8
- 0.6 0 c 1353 2162 m 4 1 d -13 3 d 5 -3 d f 0.8 0.4 0 c 1351 2161 m 2 1 d -4 1 d
- f 0.2 0.8 0 c 1331 2177 m -24 -6 d 5 -3 d f 0.4 0.8 0 c 1336 2173 m -5 4 d -19
- -9 d 15 -12 d f 0.6 0.8 0 c 1328 2155 m 6 2 d 6 13 d -4 3 d -9 -17 d f 0.8 0.8
- 0 c 1334 2157 m 7 2 d 3 7 d -4 4 d f 0.8 0.6 0 c 1341 2159 m 7 1 d 1 3 d -5 3 d
- f 0.8 0.4 0 c 1348 2160 m 3 1 d -2 2 d f 0 0.8 0.2 c 1290 2166 m -6 -1 d 4 -3 d
- f 0 0.8 0 c 1300 2169 m -10 -3 d -2 -4 d 5 -5 d f 0.2 0.8 0 c 1312 2168 m -5 3
- d -7 -2 d -7 -12 d 6 -4 d f 0.4 0.8 0 c 1304 2149 m 21 5 d 2 2 d -15 12 d -13
- -15 d f 0.6 0.8 0 c 1325 2154 m 3 1 d -1 1 d f 0 0.8 0.2 c 1288 2162 m -4 3 d
- -24 -6 d 4 -3 d f 0 0.8 0 c 1293 2157 m -5 5 d -24 -6 d 5 -4 d f 0.2 0.8 0 c
- 1299 2153 m -6 4 d -24 -5 d 5 -3 d f 0.4 0.8 0 c 1297 2147 m 7 2 d -5 4 d -25
- -4 d 4 -4 d f 0.6 0.8 0 c 1281 2143 m 16 4 d -19 -2 d f 0 0.8 0.2 c 1264 2156 m
- -4 3 d -9 -3 d f 0 0.8 0 c 1269 2152 m -5 4 d -13 X -11 -2 d f 0.2 0.8 0 c 1274
- 2149 m -5 3 d -29 2 d -3 -1 d 11 -9 d f 0.4 0.8 0 c 1257 2137 m 11 3 d 10 5 d
- -4 4 d -26 -5 d f 0.6 0.8 0 c 1268 2140 m 13 3 d -3 2 d f 0 0.8 0.2 c 1219 2148
- m -6 -1 d 3 -2 d f 0 0.8 0 c 1233 2152 m -14 -4 d -3 -3 d 5 -4 d f 0.2 0.8 0 c
- 1248 2144 m -11 9 d -4 -1 d -12 -11 d 6 -4 d f 0.4 0.8 0 c 1242 2134 m 15 3 d
- -9 7 d -21 -7 d 5 -5 d f 0.6 0.8 0 c 1234 2131 m 8 3 d -10 -2 d f 0 0.8 0.2 c
- 1216 2145 m -3 2 d -3 -1 d f 0 0.8 0 c 1221 2141 m -5 4 d -6 1 d -7 -2 d f 0.2
- 0.8 0 c 1210 2125 m 4 1 d 13 11 d -6 4 d -18 3 d -7 -2 d 9 -13 d f 0.4 0.8 0 c
- 1214 2126 m 16 4 d 2 2 d -5 5 d -31 5 d -6 -1 d 15 -12 d f 0.6 0.8 0 c 1230
- 2130 m 4 1 d -2 1 d f 0 0.8 0.2 c 1187 2119 m 4 2 d -9 2 d f 0 0.8 0 c 1191
- 2121 m 11 2 d -32 9 d 12 -9 d f 0.2 0.8 0 c 1202 2123 m 8 2 d -5 4 d -28 9 d
- -11 -3 d 4 -3 d f 0.4 0.8 0 c 1205 2129 m -15 12 d -13 -3 d f 0 0.8 0.4 c 1146
- 2130 m -3 -1 d 2 -2 d f 0 0.8 0.2 c 1181 2118 m 6 1 d -5 4 d -27 9 d -9 -2 d -1
- -3 d 8 -6 d f 0 0.8 0 c 1167 2114 m 14 4 d 1 5 d -12 9 d -6 2 d -9 -2 d -2 -11
- d 8 -6 d f 0.2 0.8 0 c 1163 2113 m 4 1 d 3 18 d -4 3 d -2 -1 d -3 -19 d f 0 0.8
- 0.4 c 1145 2127 m -2 2 d -4 -1 d f 0 0.8 0.2 c 1153 2121 m -8 6 d -6 1 d -14 -4
- d f 0 0.8 0 c 1161 2115 m -8 6 d -28 3 d -6 -1 d 7 -5 d f 0.2 0.8 0 c 1144 2109
- m 19 4 d -2 2 d -35 3 d 12 -9 d f 0.4 0.8 0 c 1140 2107 m 4 2 d -6 X f 0 0.8 0
- c 1126 2118 m -7 5 d -15 -4 d f 0.2 0.8 0 c 1138 2109 m -12 9 d -22 1 d -8 -2 d
- 11 -8 d f 0.4 0.8 0 c 1116 2101 m 24 6 d -2 2 d -31 X f 0 0.8 0 c 1089 2115 m
- -17 -4 d 15 -11 d f 0.2 0.8 0 c 1093 2095 m 12 4 d 2 10 d -11 8 d -7 -2 d -2
- -15 d f 0.4 0.8 0 c 1105 2099 m 11 2 d -9 8 d f 0 0.8 0 c 1087 2100 m -15 11 d
- -9 -2 d f 0.2 0.8 0 c 1069 2089 m 24 6 d -6 5 d -24 9 d -12 -4 d 6 -6 d f 0.4
- 0.8 0 c 1051 2105 m -2 X 8 -6 d f 0 0.8 0.2 c 1028 2100 m -3 -1 d 2 -1 d f 0
- 0.8 0 c 1037 2102 m -9 -2 d -1 -2 d 8 -6 d f 0.2 0.8 0 c 1059 2087 m 10 2 d -12
- 10 d -10 6 d -10 -3 d -2 -10 d 8 -6 d f 0.4 0.8 0 c 1046 2083 m 13 4 d -2 12 d
- -8 6 d -2 X -4 -19 d f 0 0.8 0.2 c 1027 2098 m -2 1 d -23 -6 d 8 -6 d f 0 0.8 0
- c 1022 2077 m 5 2 d 8 13 d -8 6 d -17 -11 d f 0.2 0.8 0 c 1027 2079 m 14 3 d 2
- 4 d -8 6 d f 0.4 0.8 0 c 1041 2082 m 5 1 d -3 3 d f 0 0.8 0.2 c 1010 2087 m -8
- 6 d -16 -4 d f 0 0.8 0 c 1019 2077 m 3 X -12 10 d -24 2 d -8 -2 d 6 -4 d f 0.2
- 0.8 0 c 1010 2074 m 9 3 d -35 6 d 6 -5 d f 0.4 0.8 0 c 1001 2072 m 9 2 d -20 4
- d 7 -5 d f 0.6 0.8 0 c 999 2072 m 2 X -4 1 d f 0 0.8 0 c 975 2066 m 2 X 7 17 d
- -6 4 d -8 -2 d 3 -18 d f 0.2 0.8 0 c 977 2066 m 10 2 d 3 10 d -6 5 d -14 2 d
- -11 -3 d 1 -5 d 13 -10 d f 0.4 0.8 0 c 987 2068 m 9 3 d 1 2 d -7 5 d -31 4 d -4
- -1 d 5 -4 d f 0.6 0.8 0 c 996 2071 m 3 1 d -2 1 d f 0 0.8 0 c 952 2060 m 23 6 d
- -2 1 d -22 -7 d f 0.2 0.8 0 c 973 2067 m -13 10 d -17 -11 d 8 -6 d f 0.4 0.8 0
- c 960 2077 m -5 4 d -14 -3 d -6 -6 d 8 -6 d f 0.6 0.8 0 c 941 2078 m -10 -3 d 4
- -3 d f 0 0.8 0 c 949 2059 m 3 1 d -1 X -36 11 d -7 -2 d 10 -8 d f 0.2 0.8 0 c
- 928 2054 m 21 5 d 2 1 d -8 6 d -21 7 d -7 -2 d 3 -10 d f 0.4 0.8 0 c 943 2066 m
- -8 6 d -7 2 d -6 -1 d f 0.6 0.8 0 c 935 2072 m -4 3 d -3 -1 d f 0 0.8 0 c 918
- 2061 m -10 8 d -24 -6 d 4 -2 d f 0.2 0.8 0 c 927 2053 m 1 1 d -10 7 d -30 X 9
- -8 d f 0.4 0.8 0 c 905 2048 m 22 5 d -30 X f 0 0.8 0 c 888 2061 m -4 2 d -3 -1
- d f 0.2 0.8 0 c 897 2053 m -9 8 d -7 1 d -11 -3 d f 0.4 0.8 0 c 881 2042 m 24 6
- d -8 5 d -27 6 d -9 -2 d f 0 0.8 0.4 c 840 2052 m -2 -1 d 2 -2 d f 0 0.8 0.2 c
- 846 2053 m -6 -1 d -3 Y 5 -4 d f 0 0.8 0 c 851 2055 m -5 -2 d -1 -8 d 5 -3 d f
- 0.2 0.8 0 c 857 2056 m -6 -1 d -1 -13 d 5 -4 d f 0.4 0.8 0 c 858 2036 m 23 6 d
- -20 15 d -4 -1 d -2 -18 d f 0 0.8 0.4 c 840 2049 m -2 2 d -5 -1 d f 0 0.8 0.2 c
- 845 2045 m -5 4 d -7 1 d -8 -2 d f 0 0.8 0 c 850 2042 m -5 3 d -20 3 d -8 -2 d
- f 0.2 0.8 0 c 834 2030 m 13 3 d 8 5 d -5 4 d -33 4 d -3 -1 d f 0.4 0.8 0 c 847
- 2033 m 11 3 d -3 2 d f 0 0.8 0 c 803 2042 m -12 -3 d 2 -2 d f 0.2 0.8 0 c 826
- 2027 m 8 3 d -20 15 d -11 -3 d -10 -5 d 8 -6 d f 0.4 0.8 0 c 814 2024 m 12 3 d
- -25 4 d 8 -6 d f 0.6 0.8 0 c 811 2024 m 3 X -5 1 d f 0 0.8 0 c 793 2037 m -2 2
- d -3 X f 0.2 0.8 0 c 801 2031 m -8 6 d -5 2 d -7 -2 d f 0.4 0.8 0 c 809 2025 m
- -8 6 d -20 6 d -7 -2 d f 0.6 0.8 0 c 804 2022 m 7 2 d -2 1 d -35 10 d -7 -2 d 1
- -1 d f 0.8 0.8 0 c 795 2020 m 9 2 d -36 10 d 11 -8 d f 0.8 0.6 0 c 787 2018 m 8
- 2 d -16 4 d f 0.2 0.8 0 c 748 2028 m -4 -1 d 1 -1 d f 0.4 0.8 0 c 758 2031 m
- -10 -3 d -3 -2 d 4 -3 d f 0.6 0.8 0 c 768 2032 m -1 1 d -9 -2 d -9 -8 d 4 -3 d
- f 0.8 0.8 0 c 779 2024 m -11 8 d -15 -12 d 4 -3 d f 0.8 0.6 0 c 783 2017 m 4 1
- d -8 6 d -22 -7 d 4 -3 d f 0.8 0.4 0 c 764 2012 m 19 5 d -22 -3 d f 0 0.8 0 c
- 736 2025 m -16 -4 d 5 -4 d f 0.2 0.8 0 c 745 2026 m -1 1 d -8 -2 d -11 -8 d 6
- -4 d f 0.4 0.8 0 c 749 2023 m -4 3 d -14 -13 d 5 -4 d f 0.6 0.8 0 c 740 2006 m
- 1 X 12 14 d -4 3 d -13 -14 d f 0.8 0.8 0 c 741 2006 m 9 2 d 7 9 d -4 3 d f 0.8
- 0.6 0 c 750 2008 m 8 2 d 3 4 d -4 3 d f 0.8 0.4 0 c 758 2010 m 6 2 d -3 2 d f 0
- 0.8 0 c 717 2000 m 1 X 7 17 d -5 4 d -23 -6 d f 0.2 0.8 0 c 718 2000 m 8 2 d 5
- 11 d -6 4 d f 0.4 0.8 0 c 726 2002 m 7 2 d 3 5 d -5 4 d f 0.6 0.8 0 c 733 2004
- m 7 2 d -4 3 d f 0 0.8 0 c 712 1999 m 5 1 d -20 15 d -2 X f 0.2 0.8 0 c 693
- 1994 m 19 5 d -17 16 d -10 -3 d 3 -14 d f 0.4 0.8 0 c 685 2012 m -10 -2 d 1 -3
- d 12 -9 d f 0.6 0.8 0 c 675 2010 m -2 -1 d 3 -2 d f 0.2 0.8 0 c 687 1992 m 6 2
- d -5 4 d -30 7 d -8 -2 d 7 -5 d f 0.4 0.8 0 c 673 1989 m 14 3 d 1 6 d -12 9 d
- -6 2 d -12 -4 d -1 -7 d 10 -8 d f 0.6 0.8 0 c 670 1988 m 3 1 d 3 18 d -3 2 d -3
- X -3 -19 d f 0.2 0.8 0 c 646 1982 m 1 X 10 16 d -7 5 d -10 -2 d 5 -18 d f 0.4
- 0.8 0 c 647 1982 m 19 5 d 1 3 d -10 8 d -17 3 d -14 -4 d 1 X 18 -14 d f 0.6 0.8
- 0 c 666 1987 m 4 1 d -3 2 d -41 7 d 1 X f 0.2 0.8 0 c 646 1982 m -1 1 d f 0.4
- 0.8 0 c 632 1978 m 14 4 d -1 1 d -18 14 d f 0.6 0.8 0 c 623 1976 m 9 2 d -5 19
- d -1 X -23 -6 d f 0 0 0.8 c 599 1970 m 2 X -20 16 d -2 -1 d f 0 0.2 0.8 c 601
- 1970 m 2 1 d -20 15 d -2 X f 0 0.4 0.8 c 603 1971 m 3 X -21 16 d -2 -1 d f 0
- 0.6 0.8 c 606 1971 m 2 1 d -21 15 d -2 X f 0 0.8 0.8 c 608 1972 m 2 X -21 16 d
- -2 -1 d f 0 0.8 0.6 c 610 1972 m 2 1 d -21 15 d -2 X f 0 0.8 0.4 c 612 1973 m 2
- X -21 16 d -2 -1 d f 0 0.8 0.2 c 614 1973 m 2 1 d -21 15 d -2 X f 0 0.8 0 c 616
- 1974 m 2 X -21 16 d -2 -1 d f 0.2 0.8 0 c 618 1974 m 2 1 d -21 15 d -2 X f 0.4
- 0.8 0 c 620 1975 m 2 X -21 16 d -2 -1 d f 0.6 0.8 0 c 622 1975 m 1 1 d -20 15 d
- -2 X f 0 0 0.8 c 576 1964 m 23 6 d -20 15 d -23 -6 d f 552 1958 m 24 6 d -20 15
- d -24 -6 d f 529 1952 m 23 6 d -20 15 d -23 -6 d f 1630 2211 m 23 6 d -20 16 d
- -23 -6 d f 1606 2205 m 24 6 d -20 16 d -24 -6 d f 1583 2199 m 23 6 d -20 16 d
- -23 -6 d f 1581 2199 m 2 X -20 16 d -3 -1 d f 0 0.2 0.8 c 1579 2198 m 2 1 d -21
- 15 d -2 X f 0 0.4 0.8 c 1577 2198 m 2 X -21 16 d -2 -1 d f 0 0.6 0.8 c 1575
- 2197 m 2 1 d -21 15 d -2 X f 0 0.8 0.8 c 1573 2197 m 2 X -21 16 d -2 -1 d f 0
- 0.8 0.6 c 1571 2196 m 2 1 d -21 15 d -2 X f 0 0.8 0.4 c 1569 2196 m 2 X -21 16
- d -2 -1 d f 0 0.8 0.2 c 1566 2195 m 3 1 d -21 15 d -2 X f 0 0.8 0 c 1564 2195 m
- 2 X -20 16 d -2 -1 d f 0.2 0.8 0 c 1562 2194 m 2 1 d -20 15 d -2 X f 0.4 0.8 0
- c 1560 2194 m 2 X -20 16 d -2 -1 d f 0.6 0.8 0 c 1559 2194 m 1 X -20 15 d -1 X
- f 0.4 0.8 0 c 1534 2208 m -18 -5 d 19 -15 d f 0.6 0.8 0 c 1536 2188 m 23 6 d
- -20 15 d -5 -1 d 1 -20 d f 0.4 0.8 0 c 1535 2188 m -19 15 d -24 -6 d 15 -11 d f
- 0.6 0.8 0 c 1512 2182 m 24 6 d -1 X -28 -2 d f 0 0.8 0 c 1489 2176 m 5 1 d -10
- 3 d f 0.2 0.8 0 c 1494 2177 m 8 2 d -28 8 d 10 -7 d f 0.4 0.8 0 c 1502 2179 m 8
- 2 d -3 5 d -15 11 d -23 -6 d 5 -4 d f 0.6 0.8 0 c 1510 2181 m 2 1 d -5 4 d f 0
- 0.8 0 c 1479 2173 m 10 3 d -5 4 d -35 6 d -4 -1 d 7 -5 d f 0.2 0.8 0 c 1465
- 2170 m 14 3 d 5 7 d -10 7 d -13 2 d -12 -3 d 3 -6 d f 0.4 0.8 0 c 1474 2187 m
- -5 4 d -8 -2 d f 0 0.8 0 c 1452 2180 m -7 5 d -8 -2 d f 0.2 0.8 0 c 1463 2169 m
- 2 1 d -13 10 d -15 3 d -15 -4 d 1 -1 d f 0.4 0.8 0 c 1456 2167 m 7 2 d -40 9 d
- 7 -5 d f 0.6 0.8 0 c 1448 2165 m 8 2 d -26 6 d 7 -6 d f 0.8 0.8 0 c 1442 2164 m
- 6 1 d -11 2 d f 0.2 0.8 0 c 1423 2178 m -1 1 d -24 -6 d 9 -6 d f 0.4 0.8 0 c
- 1418 2158 m 7 1 d 5 14 d -7 5 d -16 -11 d f 0.6 0.8 0 c 1425 2159 m 9 3 d 3 5 d
- -7 6 d f 0.8 0.8 0 c 1434 2162 m 8 2 d -5 3 d f 0 0.8 0 c 1388 2171 m -13 -4 d
- 6 -5 d f 0.2 0.8 0 c 1407 2167 m -9 6 d -10 -2 d -7 -9 d 6 -4 d f 0.4 0.8 0 c
- 1402 2153 m 16 5 d -11 9 d -20 -9 d 6 -5 d f 0.6 0.8 0 c 1395 2152 m 7 1 d -9 X
- f 0 0.8 0 c 1381 2162 m -6 5 d -4 -1 d f 0.2 0.8 0 c 1387 2158 m -6 4 d -10 4 d
- -4 -1 d f 0.4 0.8 0 c 1371 2146 m 17 4 d 5 3 d -6 5 d -20 7 d -3 -1 d 4 -16 d f
- 0.6 0.8 0 c 1388 2150 m 7 2 d -2 1 d -29 11 d -4 -1 d 3 -11 d 5 -4 d f 0.8 0.8
- 0 c 1360 2163 m -3 X 1 -7 d 5 -4 d f 0.8 0.6 0 c 1357 2163 m -4 -1 d 1 -3 d 4
- -3 d f 0.8 0.4 0 c 1353 2162 m -2 -1 d 3 -2 d f 0.2 0.8 0 c 1348 2140 m 3 X -4
- X f 0.4 0.8 0 c 1351 2140 m 20 6 d -3 2 d -40 7 d 19 -15 d f 0.6 0.8 0 c 1368
- 2148 m -5 4 d -29 5 d -6 -2 d f 0.8 0.8 0 c 1363 2152 m -5 4 d -17 3 d -7 -2 d
- f 0.8 0.6 0 c 1358 2156 m -4 3 d -6 1 d -7 -1 d f 0.8 0.4 0 c 1354 2159 m -3 2
- d -3 -1 d f 0.2 0.8 0 c 1346 2139 m 2 1 d -1 X f 0.4 0.8 0 c 1324 2134 m 22 5 d
- 1 1 d -19 15 d -3 -1 d -21 -5 d f 0.6 0.8 0 c 1328 2155 m -3 -1 d f 0.4 0.8 0 c
- 1318 2132 m 6 2 d -20 15 d -7 -2 d f 0.6 0.8 0 c 1303 2128 m 15 4 d -21 15 d
- -16 -4 d 17 -13 d f 0.8 0.8 0 c 1301 2128 m 2 X -5 2 d f 0.4 0.8 0 c 1278 2122
- m 3 1 d -13 17 d -11 -3 d f 0.6 0.8 0 c 1281 2123 m 18 4 d -1 3 d -17 13 d -13
- -3 d f 0.8 0.8 0 c 1299 2127 m 2 1 d -3 2 d f 0.4 0.8 0 c 1254 2116 m 24 6 d
- -21 15 d -15 -3 d 3 -11 d f 0.6 0.8 0 c 1242 2134 m -8 -3 d 11 -8 d f 0.2 0.8 0
- c 1231 2110 m 12 3 d -29 13 d -4 -1 d f 0.4 0.8 0 c 1243 2113 m 11 3 d -9 7 d
- -15 7 d -16 -4 d f 0.6 0.8 0 c 1245 2123 m -11 8 d -4 -1 d f 0 0.8 0.2 c 1191
- 2121 m -4 -2 d 3 -2 d f 0 0.8 0 c 1202 2123 m -11 -2 d -1 -4 d 7 -6 d f 0.2 0.8
- 0 c 1214 2106 m 17 4 d -21 15 d -8 -2 d -5 -12 d 7 -5 d f 0.4 0.8 0 c 1207 2104
- m 7 2 d -10 X f 0 0.8 0.2 c 1190 2117 m -3 2 d -6 -1 d f 0 0.8 0 c 1197 2111 m
- -7 6 d -9 1 d -14 -4 d f 0.2 0.8 0 c 1204 2106 m -7 5 d -30 3 d -4 -1 d 6 -4 d
- f 0.4 0.8 0 c 1196 2101 m 11 3 d -3 2 d -35 3 d 9 -7 d f 0.6 0.8 0 c 1184 2098
- m 12 3 d -18 1 d f 0.2 0.8 0 c 1169 2109 m -6 4 d -19 -4 d f 0.4 0.8 0 c 1178
- 2102 m -9 7 d -25 X -4 -2 d 15 -12 d f 0.6 0.8 0 c 1160 2092 m 24 6 d -6 4 d
- -23 -7 d f 0.4 0.8 0 c 1155 2095 m -15 12 d -24 -6 d 4 -3 d f 0.6 0.8 0 c 1146
- 2088 m 14 4 d -5 3 d -35 3 d 11 -8 d f 0.8 0.8 0 c 1137 2086 m 9 2 d -15 2 d f
- 0.2 0.8 0 c 1105 2099 m -12 -4 d 5 -3 d f 0.4 0.8 0 c 1120 2098 m -4 3 d -11 -2
- d -7 -7 d 7 -6 d f 0.6 0.8 0 c 1131 2090 m -11 8 d -15 -12 d 7 -6 d f 0.8 0.8 0
- c 1113 2080 m 24 6 d -6 4 d -19 -10 d f 0.2 0.8 0 c 1098 2092 m -5 3 d -24 -6 d
- 13 -9 d f 0.4 0.8 0 c 1090 2074 m 10 2 d 5 10 d -7 6 d -16 -12 d f 0.6 0.8 0 c
- 1100 2076 m 12 4 d -7 6 d f 0.8 0.8 0 c 1112 2080 m 1 X -1 X f 0.2 0.8 0 c 1066
- 2068 m 20 5 d -4 7 d -13 9 d -10 -2 d -7 -8 d f 0.4 0.8 0 c 1086 2073 m 4 1 d
- -8 6 d -23 7 d -13 -4 d 6 -4 d f 0 0.8 0 c 1027 2079 m -5 -2 d 7 -5 d f 0.2 0.8
- 0 c 1043 2062 m 23 6 d -14 11 d -11 3 d -14 -3 d 2 -7 d f 0.4 0.8 0 c 1052 2079
- m -6 4 d -5 -1 d f 0 0.8 0 c 1029 2072 m -7 5 d -3 X f 0.2 0.8 0 c 1038 2061 m
- 5 1 d -14 10 d -10 5 d -9 -3 d f 0.4 0.8 0 c 1023 2057 m 15 4 d -28 13 d -9 -2
- d f 0.6 0.8 0 c 1019 2056 m 4 1 d -22 15 d -2 X f 0 0.8 0 c 977 2066 m -2 X 1
- -1 d f 0.2 0.8 0 c 987 2068 m -10 -2 d -1 -1 d 6 -5 d f 0.4 0.8 0 c 996 2071 m
- -9 -3 d -5 -8 d 7 -5 d f 0.6 0.8 0 c 999 2051 m 20 5 d -20 16 d -3 -1 d -7 -16
- d 6 -4 d f 0.8 0.8 0 c 996 2050 m 3 1 d -4 X f 0 0.8 0 c 976 2065 m -1 1 d -23
- -6 d 1 -2 d f 0.2 0.8 0 c 982 2060 m -6 5 d -23 -7 d 11 -8 d f 0.4 0.8 0 c 972
- 2044 m 4 1 d 13 10 d -7 5 d -18 -10 d f 0.6 0.8 0 c 976 2045 m 18 4 d 1 2 d -6
- 4 d f 0.8 0.8 0 c 994 2049 m 2 1 d -1 1 d f 0 0.8 0 c 953 2058 m -1 2 d -3 -1 d
- f 0.2 0.8 0 c 964 2050 m -11 8 d -4 1 d -21 -5 d 1 -1 d f 0.4 0.8 0 c 969 2043
- m 3 1 d -8 6 d -35 3 d 8 -6 d f 0.6 0.8 0 c 954 2039 m 15 4 d -32 4 d 9 -7 d f
- 0.8 0.8 0 c 949 2038 m 5 1 d -8 1 d f 0 0.8 0.2 c 925 2032 m 2 1 d -5 1 d f 0
- 0.8 0 c 927 2033 m 5 1 d -16 5 d 6 -5 d f 0.2 0.8 0 c 932 2034 m 5 1 d -8 18 d
- -1 1 d -1 -1 d -17 -9 d 6 -5 d f 0.4 0.8 0 c 937 2035 m 5 1 d -5 11 d -8 6 d -2
- X -22 -5 d 5 -4 d f 0.6 0.8 0 c 942 2036 m 5 2 d -1 2 d -9 7 d f 0.8 0.8 0 c
- 947 2038 m 2 X -3 2 d f 0 0.8 0.2 c 919 2031 m 6 1 d -3 2 d f 0 0.8 0 c 906
- 2027 m 13 4 d 3 3 d -6 5 d f 0.2 0.8 0 c 902 2026 m 4 1 d 10 12 d -6 5 d -18
- -11 d f 0.4 0.8 0 c 910 2044 m -5 4 d -24 -6 d 11 -9 d f 0.2 0.8 0 c 894 2024 m
- 8 2 d -10 7 d f 0.4 0.8 0 c 883 2021 m 11 3 d -2 9 d -11 9 d -23 -6 d 9 -8 d f
- 0.6 0.8 0 c 878 2020 m 5 1 d -16 7 d f 0.2 0.8 0 c 847 2033 m -13 -3 d 10 -8 d
- f 0.4 0.8 0 c 855 2014 m 7 2 d 5 12 d -9 8 d -11 -3 d -3 -11 d f 0.6 0.8 0 c
- 862 2016 m 16 4 d -11 8 d f 0.2 0.8 0 c 844 2022 m -10 8 d -8 -3 d f 0.4 0.8 0
- c 831 2008 m 24 6 d -11 8 d -18 5 d -12 -3 d 1 -4 d f 0.6 0.8 0 c 814 2024 m -3
- X 4 -4 d f 0.4 0.8 0 c 808 2002 m 23 6 d -16 12 d -12 -14 d f 0.6 0.8 0 c 815
- 2020 m -4 4 d -7 -2 d -6 -12 d 5 -4 d f 0.8 0.8 0 c 804 2022 m -9 -2 d -3 -6 d
- 6 -4 d f 0.8 0.6 0 c 795 2020 m -8 -2 d 5 -4 d f 0.4 0.8 0 c 784 1996 m 24 6 d
- -5 4 d -22 -8 d f 0.6 0.8 0 c 803 2006 m -5 4 d -21 -8 d 4 -4 d f 0.8 0.8 0 c
- 798 2010 m -6 4 d -20 -8 d 5 -4 d f 0.8 0.6 0 c 792 2014 m -5 4 d -4 -1 d -16
- -8 d 5 -3 d f 0.8 0.4 0 c 783 2017 m -19 -5 d 3 -3 d f 0.4 0.8 0 c 762 1990 m
- 22 6 d -3 2 d f 0.6 0.8 0 c 761 1990 m 1 X 19 8 d -4 4 d -36 4 d -1 X f 0.8 0.8
- 0 c 777 2002 m -5 4 d -22 2 d -9 -2 d f 0.8 0.6 0 c 772 2006 m -5 3 d -9 1 d -8
- -2 d f 0.8 0.4 0 c 767 2009 m -3 3 d -6 -2 d f 0 0.8 0 c 718 2000 m -1 X 1 -1 d
- f 0.2 0.8 0 c 726 2002 m -8 -2 d -1 Y 5 -4 d f 0.4 0.8 0 c 733 2004 m -7 -2 d
- -3 -7 d 4 -3 d f 0.6 0.8 0 c 749 1987 m 12 3 d -21 16 d -7 -2 d -6 -12 d 5 -4 d
- f 0.8 0.8 0 c 737 1984 m 12 3 d -17 1 d f 0 0.8 0 c 718 1999 m -1 1 d -5 -1 d f
- 0.2 0.8 0 c 714 1978 m 3 1 d 6 16 d -5 4 d -6 X -19 -5 d f 0.4 0.8 0 c 717 1979
- m 7 2 d 3 11 d -4 3 d f 0.6 0.8 0 c 724 1981 m 7 2 d 1 5 d -5 4 d f 0.8 0.8 0 c
- 731 1983 m 6 1 d -5 4 d f 0.2 0.8 0 c 690 1972 m 24 6 d -21 16 d -6 -2 d -2 -15
- d f 0.4 0.8 0 c 687 1992 m -14 -3 d -3 Y 12 -9 d f 0.6 0.8 0 c 673 1989 m -3 -1
- d 3 -2 d f 0.2 0.8 0 c 687 1972 m 3 X -5 5 d -38 5 d -1 X 1 X f 0.4 0.8 0 c 681
- 1970 m 6 2 d -2 5 d -12 9 d -7 1 d -19 -5 d 6 -5 d f 0.6 0.8 0 c 675 1968 m 6 2
- d -8 16 d -3 2 d -4 -1 d -13 -10 d 6 -4 d f 0.8 0.8 0 c 669 1967 m 6 1 d -16 5
- d 5 -5 d f 0.8 0.6 0 c 667 1966 m 2 1 d -5 1 d f 0.2 0.8 0 c 643 1960 m 5 2 d
- -1 20 d -1 X -10 -16 d f 0.4 0.8 0 c 648 1962 m 6 1 d -1 14 d -6 5 d -1 X -14
- -4 d -4 -6 d 8 -6 d f 0.6 0.8 0 c 654 1963 m 5 1 d 9 Y -6 4 d -21 1 d -9 -2 d 5
- -4 d f 0.8 0.8 0 c 659 1964 m 6 2 d -1 2 d -5 5 d f 0.8 0.6 0 c 665 1966 m 2 X
- -3 2 d f 0 0 0.8 c 620 1954 m 2 1 d -21 15 d -2 X f 0 0.2 0.8 c 622 1955 m 3 1
- d -22 15 d -2 -1 d f 0 0.4 0.8 c 625 1956 m 3 X -22 15 d -3 X f 0 0.6 0.8 c 628
- 1956 m 2 1 d -22 15 d -2 -1 d f 0 0.8 0.8 c 630 1957 m 3 1 d -23 14 d -2 X f 0
- 0.8 0.6 c 633 1958 m 2 X -23 15 d -2 -1 d f 0 0.8 0.4 c 635 1958 m 3 1 d -24 14
- d -2 X f 0 0.8 0.2 c 638 1959 m 3 1 d -25 14 d -2 -1 d f 0 0.8 0 c 641 1960 m 2
- X -25 14 d -2 X f 0.2 0.8 0 c 643 1960 m -7 6 d -16 9 d -2 -1 d f 0.4 0.8 0 c
- 636 1966 m -8 6 d -6 3 d -2 X f 0.6 0.8 0 c 628 1972 m -5 4 d -1 -1 d f 0 0 0.8
- c 596 1948 m 24 6 d -21 16 d -23 -6 d f 573 1942 m 23 6 d -20 16 d -24 -6 d f
- 549 1936 m 24 6 d -21 16 d -23 -6 d f 1650 2196 m 24 6 d -21 15 d -23 -6 d f
- 1627 2190 m 23 6 d -20 15 d -24 -6 d f 1603 2184 m 24 6 d -21 15 d -23 -6 d f
- 1600 2183 m 3 1 d -20 15 d -2 X f 0 0.2 0.8 c 1598 2183 m 2 X -19 16 d -2 -1 d
- f 0 0.4 0.8 c 1595 2182 m 3 1 d -19 15 d -2 X f 0 0.6 0.8 c 1592 2181 m 3 1 d
- -18 16 d -2 -1 d f 0 0.8 0.8 c 1590 2180 m 2 1 d -17 16 d -2 X f 0 0.8 0.6 c
- 1587 2180 m 3 X -17 17 d -2 -1 d f 0 0.8 0.4 c 1584 2179 m 3 1 d -16 16 d -2 X
- f 0 0.8 0.2 c 1581 2178 m 3 1 d -15 17 d -3 -1 d f 0 0.8 0 c 1580 2178 m 1 X
- -15 17 d -2 X 13 -15 d f 0.2 0.8 0 c 1564 2195 m -2 -1 d 8 -9 d 7 -5 d f 0.4
- 0.8 0 c 1562 2194 m -2 X 3 -3 d 7 -6 d f 0.6 0.8 0 c 1560 2194 m -1 X 4 -3 d f
- 0 0.8 0.4 c 1556 2172 m 7 2 d -10 X f 0 0.8 0.2 c 1563 2174 m 10 2 d -24 2 d 4
- -4 d f 0 0.8 0 c 1573 2176 m 7 2 d -3 2 d -32 1 d 4 -3 d f 0.2 0.8 0 c 1577
- 2180 m -7 5 d -30 -1 d 5 -3 d f 0.4 0.8 0 c 1570 2185 m -7 6 d -27 -4 d 4 -3 d
- f 0.6 0.8 0 c 1563 2191 m -4 3 d -23 -6 d -1 Y f 0 0.8 0.4 c 1553 2171 m 3 1 d
- -3 2 d f 0 0.8 0.2 c 1549 2170 m 4 1 d 3 Y -4 4 d f 0 0.8 0 c 1544 2169 m 5 1 d
- 8 Y -4 3 d f 0.2 0.8 0 c 1540 2168 m 4 1 d 1 12 d -5 3 d f 0.4 0.8 0 c 1536
- 2167 m 4 1 d 16 Y -4 3 d f 0.6 0.8 0 c 1533 2166 m 3 1 d 21 Y -24 -6 d f 0 0.8
- 0 c 1494 2177 m -5 -1 d 2 -2 d f 0.2 0.8 0 c 1502 2179 m -8 -2 d -3 -3 d 4 -3 d
- f 0.4 0.8 0 c 1510 2181 m -8 -2 d -7 -8 d 4 -3 d f 0.6 0.8 0 c 1528 2165 m 5 1
- d -21 16 d -2 -1 d -11 -13 d 5 -4 d f 0.8 0.8 0 c 1515 2161 m 13 4 d -24 -1 d 4
- -3 d f 0.8 0.6 0 c 1509 2160 m 6 1 d -7 X f 0 0.8 0 c 1491 2174 m -2 2 d -10 -3
- d f 0.2 0.8 0 c 1486 2154 m 5 1 d 4 16 d -4 3 d -12 -1 d -14 -3 d f 0.4 0.8 0 c
- 1491 2155 m 5 2 d 3 11 d -4 3 d f 0.6 0.8 0 c 1496 2157 m 6 1 d 2 6 d -5 4 d f
- 0.8 0.8 0 c 1502 2158 m 5 1 d 1 2 d -4 3 d f 0.8 0.6 0 c 1507 2159 m 2 1 d -1 1
- d f 0.2 0.8 0 c 1482 2153 m 4 1 d -21 16 d -2 -1 d f 0.4 0.8 0 c 1477 2152 m 5
- 1 d -19 16 d -7 -2 d f 0.6 0.8 0 c 1473 2151 m 4 1 d -21 15 d -8 -2 d f 0.8 0.8
- 0 c 1469 2150 m 4 1 d -25 14 d -6 -1 d 3 -3 d f 0.8 0.6 0 c 1464 2149 m 5 1 d
- -24 11 d 12 -9 d f 0.8 0.4 0 c 1462 2148 m 2 1 d -7 3 d f 0.2 0.8 0 c 1439 2142
- m -3 2 d f 0.4 0.8 0 c 1439 2142 m 5 1 d -19 16 d -7 -1 d 18 -14 d f 0.6 0.8 0
- c 1444 2143 m 5 2 d -15 17 d -9 -3 d f 0.8 0.8 0 c 1449 2145 m 6 1 d -10 15 d
- -3 3 d -8 -2 d f 0.8 0.6 0 c 1455 2146 m 5 1 d -3 5 d -12 9 d f 0.8 0.4 0 c
- 1460 2147 m 2 1 d -5 4 d f 0.2 0.8 0 c 1438 2142 m 1 X -3 2 d f 0.4 0.8 0 c
- 1424 2138 m 14 4 d -2 2 d -18 14 d -16 -5 d f 0.6 0.8 0 c 1415 2136 m 9 2 d -22
- 15 d -7 -1 d f 0.4 0.8 0 c 1388 2150 m -17 -4 d 10 -8 d f 0.6 0.8 0 c 1392 2130
- m 23 6 d -20 16 d -7 -2 d -7 -12 d f 0.2 0.8 0 c 1351 2140 m -3 X f 0.4 0.8 0 c
- 1381 2138 m -10 8 d -20 -6 d -3 X 4 -3 d f 0.6 0.8 0 c 1390 2130 m 2 X -11 8 d
- -29 -1 d 3 -3 d f 0.8 0.8 0 c 1385 2128 m 5 2 d -35 4 d 3 -2 d f 0.8 0.6 0 c
- 1379 2127 m 6 1 d -27 4 d 4 -3 d f 0.8 0.4 0 c 1374 2126 m 5 1 d -17 2 d 3 -2 d
- f 0.8 0.2 0 c 1368 2124 m 6 2 d -9 1 d f 0.2 0.8 0 c 1348 2140 m -2 -1 d f 0.4
- 0.8 0 c 1352 2137 m -4 3 d -2 -1 d -22 -5 d 7 -5 d f 0.6 0.8 0 c 1345 2118 m 10
- 16 d -3 3 d -21 -8 d f 0.8 0.8 0 c 1345 2118 m 6 2 d 7 12 d -3 2 d f 0.8 0.6 0
- c 1351 2120 m 6 1 d 5 8 d -4 3 d f 0.8 0.4 0 c 1357 2121 m 6 2 d 2 4 d -3 2 d f
- 0.8 0.2 0 c 1363 2123 m 5 1 d -3 3 d f 0.4 0.8 0 c 1331 2129 m -7 5 d -6 -2 d f
- 0.6 0.8 0 c 1339 2117 m 6 1 d -14 11 d -13 3 d -15 -4 d f 0.8 0.8 0 c 1321 2112
- m 18 5 d -36 11 d -2 X f 0.4 0.8 0 c 1281 2123 m -3 -1 d 1 -2 d f 0.6 0.8 0 c
- 1299 2127 m -18 -4 d -2 -3 d 10 -7 d f 0.8 0.8 0 c 1298 2106 m 23 6 d -20 16 d
- -2 -1 d -10 -14 d f 0 0.8 0 c 1274 2100 m 3 1 d -7 3 d f 0.2 0.8 0 c 1277 2101
- m 5 1 d -21 8 d 9 -6 d f 0.4 0.8 0 c 1282 2102 m 6 2 d -9 16 d -1 2 d -24 -6 d
- 7 -6 d f 0.6 0.8 0 c 1288 2104 m 5 1 d -4 8 d -10 7 d f 0.8 0.8 0 c 1293 2105 m
- 5 1 d -9 7 d f 0 0.8 0 c 1272 2100 m 2 X -4 4 d f 0.2 0.8 0 c 1268 2099 m 4 1 d
- -2 4 d -9 6 d -18 3 d -12 -3 d 3 -3 d f 0.4 0.8 0 c 1264 2098 m 4 1 d -7 11 d
- -7 6 d -11 -3 d -9 -6 d 4 -3 d f 0.6 0.8 0 c 1259 2096 m 5 2 d -26 6 d 4 -3 d f
- 0.8 0.8 0 c 1255 2095 m 4 1 d -17 5 d 5 -3 d f 0.8 0.6 0 c 1251 2094 m 4 1 d -8
- 3 d 4 -4 d f 0.8 0.4 0 c 1251 2094 m f 0.2 0.8 0 c 1234 2107 m -3 3 d -17 -4 d
- f 0.4 0.8 0 c 1238 2104 m -4 3 d -20 -1 d -7 -2 d 3 -3 d f 0.6 0.8 0 c 1242
- 2101 m -4 3 d -28 -3 d 6 -4 d f 0.8 0.8 0 c 1247 2098 m -5 3 d -26 -4 d 6 -4 d
- f 0.8 0.6 0 c 1251 2094 m -4 4 d -25 -5 d 5 -4 d f 0.8 0.4 0 c 1227 2088 m 24 6
- d -24 -5 d f 0.4 0.8 0 c 1204 2082 m 5 2 d 1 17 d -3 3 d -11 -3 d -3 -10 d f
- 0.6 0.8 0 c 1209 2084 m 6 1 d 1 12 d -6 4 d -14 X -12 -3 d 9 -7 d f 0.8 0.8 0 c
- 1215 2085 m 6 2 d 1 6 d -6 4 d f 0.8 0.6 0 c 1221 2087 m 6 1 d 1 Y -5 4 d f 0.8
- 0.4 0 c 1227 2088 m 1 Y f 0.4 0.8 0 c 1191 2079 m 13 3 d -11 9 d f 0.6 0.8 0 c
- 1180 2076 m 11 3 d 2 12 d -9 7 d -24 -6 d f 0.2 0.8 0 c 1157 2070 m 1 1 d -2 X
- f 0.4 0.8 0 c 1158 2071 m 13 3 d -22 3 d 7 -6 d f 0.6 0.8 0 c 1171 2074 m 9 2 d
- -20 16 d -14 -4 d -5 -5 d 8 -6 d f 0.8 0.8 0 c 1146 2088 m -9 -2 d 4 -3 d f 0
- 0.8 0 c 1133 2064 m 3 1 d -3 X f 0.2 0.8 0 c 1136 2065 m 21 5 d -1 1 d -30 -1 d
- 7 -5 d f 0.4 0.8 0 c 1156 2071 m -7 6 d -29 -2 d 6 -5 d f 0.6 0.8 0 c 1149 2077
- m -8 6 d -27 -4 d 6 -4 d f 0.8 0.8 0 c 1141 2083 m -4 3 d -24 -6 d 1 -1 d f 0
- 0.8 0 c 1132 2064 m 1 X 1 Y f 0.2 0.8 0 c 1124 2062 m 8 2 d 1 1 d -7 5 d f 0.4
- 0.8 0 c 1116 2060 m 8 2 d 2 8 d -6 5 d -20 1 d -10 -2 d 11 -9 d f 0.6 0.8 0 c
- 1110 2058 m 6 2 d 4 15 d -6 4 d -2 1 d -12 -4 d 1 -11 d f 0.8 0.8 0 c 1114 2079
- m -1 1 d -1 X f 0.2 0.8 0 c 1086 2052 m 1 1 d -1 20 d -20 -5 d f 0.4 0.8 0 c
- 1087 2053 m 14 3 d 9 Y -11 9 d -4 -1 d f 0.6 0.8 0 c 1101 2056 m 9 2 d -9 7 d f
- 0.2 0.8 0 c 1085 2052 m 1 X -20 16 d -23 -6 d 3 -3 d f 0.4 0.8 0 c 1067 2048 m
- 18 4 d -39 7 d 14 -10 d f 0.6 0.8 0 c 1063 2046 m 4 2 d -7 1 d f 0.2 0.8 0 c
- 1046 2059 m -3 3 d -5 -1 d f 0.4 0.8 0 c 1060 2049 m -14 10 d -8 2 d -15 -4 d f
- 0.6 0.8 0 c 1039 2040 m 24 6 d -3 3 d -37 8 d -4 -1 d f 1022 2036 m 17 4 d -20
- 16 d -20 -5 d f 0.8 0.8 0 c 1016 2034 m 6 2 d -23 15 d -3 -1 d f 0.4 0.8 0 c
- 976 2045 m -4 -1 d 3 -2 d f 0.6 0.8 0 c 994 2049 m -18 -4 d -1 -3 d 16 -12 d f
- 0.8 0.8 0 c 992 2028 m 24 6 d -20 16 d -2 -1 d -3 -19 d f 0.4 0.8 0 c 975 2042
- m -3 2 d -3 -1 d f 0.6 0.8 0 c 969 2022 m 20 5 d 2 3 d -16 12 d -6 1 d -15 -4 d
- 2 -7 d f 0.8 0.8 0 c 989 2027 m 3 1 d -1 2 d -37 9 d -5 -1 d 7 -6 d f 0 0.8 0.2
- c 927 2033 m -2 -1 d 2 -2 d f 0 0.8 0 c 932 2034 m -5 -1 d -3 Y 5 -3 d f 0.2
- 0.8 0 c 937 2035 m -5 -1 d -7 Y 5 -4 d f 0.4 0.8 0 c 942 2036 m -5 -1 d -12 Y 5
- -4 d f 0.6 0.8 0 c 946 2017 m 23 5 d -13 10 d -9 6 d -5 -2 d -17 Y f 0.8 0.8 0
- c 956 2032 m -7 6 d -2 X f 0 0.8 0.2 c 927 2030 m -2 2 d -6 -1 d f 0 0.8 0 c
- 932 2027 m -5 3 d -8 1 d -13 -4 d f 0.2 0.8 0 c 937 2023 m -5 4 d -26 X -4 -1 d
- 7 -6 d f 0.4 0.8 0 c 942 2019 m -5 4 d -28 -3 d 10 -8 d f 0.6 0.8 0 c 922 2011
- m 24 6 d -4 2 d -23 -7 d f 0.2 0.8 0 c 909 2020 m -7 6 d -8 -2 d f 0.4 0.8 0 c
- 899 2005 m 18 4 d 2 3 d -10 8 d -15 4 d -11 -3 d 2 -6 d f 0.6 0.8 0 c 917 2009
- m 5 2 d -3 1 d -36 9 d -5 -1 d 7 -5 d f 0.4 0.8 0 c 875 1999 m 24 6 d -14 10 d
- -23 1 d -7 -2 d f 0.6 0.8 0 c 885 2015 m -7 5 d -16 -4 d f 0.4 0.8 0 c 852 1993
- m 23 6 d -20 15 d -24 -6 d f 0 0.8 0 c 828 1987 m 10 2 d -18 4 d f 0.2 0.8 0 c
- 838 1989 m 12 3 d -41 9 d 11 -8 d f 0.4 0.8 0 c 850 1992 m 2 1 d -21 15 d -23
- -6 d 1 -1 d f 0 0.8 0 c 807 1981 m 21 6 d -8 6 d f 0.2 0.8 0 c 805 1981 m 2 X
- 13 12 d -11 8 d -19 -9 d f 0.4 0.8 0 c 809 2001 m -1 1 d -24 -6 d 6 -4 d f 0.2
- 0.8 0 c 781 1975 m 24 6 d -15 11 d -13 -14 d f 0.4 0.8 0 c 790 1992 m -6 4 d
- -22 -6 d -1 X 16 -12 d f 0.6 0.8 0 c 762 1990 m -1 X f 0.2 0.8 0 c 758 1969 m
- 23 6 d -4 3 d -22 -7 d f 0.4 0.8 0 c 777 1978 m -16 12 d -12 -15 d 6 -4 d f 0.6
- 0.8 0 c 761 1990 m -12 -3 d -6 -7 d 6 -5 d f 0.8 0.8 0 c 749 1987 m -12 -3 d 6
- -4 d f 0.2 0.8 0 c 734 1963 m 24 6 d -3 2 d -38 8 d -3 -1 d f 0.4 0.8 0 c 755
- 1971 m -6 4 d -25 6 d -7 -2 d f 0.6 0.8 0 c 749 1975 m -6 5 d -12 3 d -7 -2 d f
- 0.8 0.8 0 c 743 1980 m -6 4 d -6 -1 d f 0.2 0.8 0 c 728 1961 m 6 2 d -20 15 d
- -24 -6 d 4 -3 d f 0.4 0.8 0 c 719 1959 m 9 2 d -34 8 d 9 -6 d f 0.6 0.8 0 c 711
- 1957 m 8 2 d -16 4 d f 0.2 0.8 0 c 694 1969 m -4 3 d -3 X f 0.4 0.8 0 c 687
- 1951 m 10 2 d 6 10 d -9 6 d -7 3 d -6 -2 d 2 -16 d f 0.6 0.8 0 c 697 1953 m 14
- 4 d -8 6 d -22 7 d -6 -2 d 1 -9 d 7 -5 d f 0.8 0.8 0 c 675 1968 m -6 -1 d 1 -3
- d 6 -5 d f 0.8 0.6 0 c 669 1967 m -2 -1 d 3 -2 d f 0.2 0.8 0 c 648 1962 m -5 -2
- d 18 -13 d f 0.4 0.8 0 c 664 1945 m 23 6 d -4 3 d -29 9 d -6 -1 d 13 -15 d f
- 0.6 0.8 0 c 683 1954 m -7 5 d -17 5 d -5 -1 d f 0.8 0.8 0 c 676 1959 m -6 5 d
- -5 2 d -6 -2 d f 0.8 0.6 0 c 670 1964 m -3 2 d -2 X f 0 0 0.8 c 640 1939 m 2 X
- -20 16 d -2 -1 d f 0 0.2 0.8 c 642 1939 m 3 1 d -20 16 d -3 -1 d f 0 0.4 0.8 c
- 645 1940 m 2 1 d -19 15 d -3 X f 0 0.6 0.8 c 647 1941 m 2 X -19 16 d -2 -1 d f
- 0 0.8 0.8 c 649 1941 m 3 1 d -19 16 d -3 -1 d f 0 0.8 0.6 c 652 1942 m 2 X -19
- 16 d -2 X f 0 0.8 0.4 c 654 1942 m 2 1 d -18 16 d -3 -1 d f 0 0.8 0.2 c 656
- 1943 m 3 X -18 17 d -3 -1 d f 0 0.8 0 c 659 1943 m 2 1 d -18 16 d -2 X f 0.2
- 0.8 0 c 661 1944 m 2 1 d -2 2 d -18 13 d f 0.4 0.8 0 c 663 1945 m 1 X -3 2 d f
- 0 0 0.8 c 617 1933 m 23 6 d -20 15 d -24 -6 d f 593 1927 m 24 6 d -21 15 d -23
- -6 d f 570 1921 m 23 6 d -20 15 d -24 -6 d f 1671 2180 m 23 6 d -20 16 d -24 -6
- d f 1647 2174 m 24 6 d -21 16 d -23 -6 d f 1624 2168 m 23 6 d -20 16 d -24 -6 d
- f 1622 2168 m 2 X -21 16 d -3 -1 d f 0 0.2 0.8 c 1620 2167 m 2 1 d -22 15 d -2
- X f 0 0.4 0.8 c 1618 2167 m 2 X -22 16 d -3 -1 d f 0 0.6 0.8 c 1616 2167 m 2 X
- -23 15 d -3 -1 d f 0 0.8 0.8 c 1614 2166 m 2 1 d -24 14 d -2 -1 d f 0 0.8 0.6 c
- 1612 2166 m 2 X -24 14 d -3 X f 0 0.8 0.4 c 1610 2165 m 2 1 d -25 14 d -3 -1 d
- f 0 0.8 0.2 c 1609 2165 m 1 X -26 14 d -3 -1 d f 0 0.8 0 c 1607 2164 m 2 1 d
- -28 13 d -1 X 2 -1 d f 0.2 0.8 0 c 1605 2164 m 2 X -25 13 d 5 -4 d f 0.4 0.8 0
- c 1603 2163 m 2 1 d -18 9 d 5 -4 d f 0.6 0.8 0 c 1601 2163 m 2 X -11 6 d 5 -4 d
- f 0.8 0.8 0 c 1600 2162 m 1 1 d -4 2 d f 0 0.8 0.4 c 1563 2174 m -7 -2 d 6 -4 d
- f 0 0.8 0.2 c 1573 2176 m -10 -2 d -1 -6 d 7 -6 d f 0 0.8 0 c 1582 2177 m -2 1
- d -7 -2 d -4 -14 d 7 -5 d f 0.2 0.8 0 c 1577 2156 m 6 2 d 4 15 d -5 4 d -6 -20
- d f 0.4 0.8 0 c 1583 2158 m 7 2 d 2 9 d -5 4 d f 0.6 0.8 0 c 1590 2160 m 6 1 d
- 1 4 d -5 4 d f 0.8 0.8 0 c 1596 2161 m 4 1 d -3 3 d f 0 0.8 0.4 c 1562 2168 m
- -6 4 d -3 -1 d f 0 0.8 0.2 c 1569 2162 m -7 6 d -9 3 d -4 -1 d f 0 0.8 0 c 1576
- 2157 m -7 5 d -20 8 d -5 -1 d f 0.2 0.8 0 c 1572 2155 m 5 1 d -1 1 d -32 12 d
- -4 -1 d f 0.4 0.8 0 c 1567 2154 m 5 1 d -32 13 d -4 -1 d f 0.6 0.8 0 c 1561
- 2153 m 6 1 d -31 13 d -3 -1 d 3 -3 d f 0.8 0.8 0 c 1556 2151 m 5 2 d -25 10 d
- 11 -8 d f 0.8 0.6 0 c 1553 2150 m 3 1 d -9 4 d f 0.6 0.8 0 c 1536 2163 m -3 3 d
- -5 -1 d f 0.8 0.8 0 c 1530 2144 m 10 3 d 7 8 d -11 8 d -8 2 d -13 -4 d 4 -8 d f
- 0.8 0.6 0 c 1540 2147 m 13 3 d -6 5 d -32 6 d -6 -1 d 10 -7 d f 0.2 0.8 0 c
- 1491 2155 m -5 -1 d 6 -5 d f 0.4 0.8 0 c 1496 2157 m -5 -2 d 1 -6 d 7 -5 d f
- 0.6 0.8 0 c 1502 2158 m -6 -1 d 3 -13 d 6 -5 d f 0.8 0.8 0 c 1506 2139 m 24 5 d
- -11 9 d -12 6 d -5 -1 d 3 -19 d f 0.8 0.6 0 c 1519 2153 m -10 7 d -2 -1 d f 0
- 0.8 0 c 1483 2133 m 3 X -5 1 d f 0.2 0.8 0 c 1486 2133 m 7 2 d -1 14 d -6 5 d
- -4 -1 d -5 -16 d 4 -3 d f 0.4 0.8 0 c 1493 2135 m 6 2 d 7 Y -7 5 d -10 4 d -5
- -1 d -3 -13 d 3 -2 d f 0.6 0.8 0 c 1499 2137 m 6 1 d 1 Y -6 5 d -22 8 d -4 -1 d
- -2 -9 d 3 -3 d f 0.8 0.8 0 c 1505 2138 m 1 1 d -1 X -32 12 d -4 -1 d -2 -6 d 4
- -2 d f 0.8 0.6 0 c 1469 2150 m -5 -1 d -2 Y 3 -3 d f 0.8 0.4 0 c 1464 2149 m -2
- -1 d 2 -1 d f 0 0.8 0 c 1479 2131 m 4 2 d -2 1 d f 0.2 0.8 0 c 1471 2130 m 8 1
- d 2 3 d -4 3 d -38 5 d f 0.4 0.8 0 c 1464 2128 m 7 2 d 6 7 d -3 2 d -30 4 d -5
- -1 d 12 -9 d f 0.6 0.8 0 c 1459 2127 m 5 1 d 10 11 d -3 3 d -22 3 d -5 -2 d 7
- -10 d f 0.8 0.8 0 c 1471 2142 m -4 2 d -12 2 d -6 -1 d f 0.8 0.6 0 c 1467 2144
- m -3 3 d -4 X -5 -1 d f 0.8 0.4 0 c 1464 2147 m -2 1 d -2 -1 d f 0.2 0.8 0 c
- 1439 2142 m -1 X f 0.4 0.8 0 c 1451 2133 m -12 9 d -1 X -14 -4 d f 0.6 0.8 0 c
- 1450 2124 m 9 3 d -8 6 d -27 5 d -9 -2 d 8 -6 d f 0.8 0.8 0 c 1436 2121 m 14 3
- d -27 6 d f 0.6 0.8 0 c 1412 2115 m 4 1 d 7 14 d -8 6 d -23 -6 d f 0.8 0.8 0 c
- 1416 2116 m 20 5 d -13 9 d f 0.6 0.8 0 c 1410 2114 m 2 1 d -20 15 d -2 X f 0.8
- 0.8 0 c 1389 2109 m 21 5 d -20 16 d -5 -2 d 3 -19 d f 0.8 0.6 0 c 1385 2128 m
- -6 -1 d 3 -13 d 6 -5 d f 0.8 0.4 0 c 1379 2127 m -5 -1 d 1 -7 d 7 -5 d f 0.8
- 0.2 0 c 1374 2126 m -6 -2 d 7 -5 d f 0.6 0.8 0 c 1365 2103 m 12 3 d -32 12 d f
- 0.8 0.8 0 c 1377 2106 m 12 3 d -1 X -37 11 d -6 -2 d f 0.8 0.6 0 c 1388 2109 m
- -6 5 d -25 7 d -6 -1 d f 0.8 0.4 0 c 1382 2114 m -7 5 d -12 4 d -6 -2 d f 0.8
- 0.2 0 c 1375 2119 m -7 5 d -5 -1 d f 0.4 0.8 0 c 1342 2097 m 22 5 d -30 1 d f
- 0.6 0.8 0 c 1364 2102 m 1 1 d -20 15 d -6 -1 d -15 -7 d 10 -7 d f 0.8 0.8 0 c
- 1339 2117 m -18 -5 d 3 -2 d f 0.2 0.8 0 c 1318 2091 m 15 3 d -17 -2 d f 0.4 0.8
- 0 c 1333 2094 m 9 3 d -8 6 d -24 -6 d 6 -5 d f 0.6 0.8 0 c 1334 2103 m -10 7 d
- -20 -8 d 6 -5 d f 0.8 0.8 0 c 1324 2110 m -3 2 d -23 -6 d 6 -4 d f 0 0.8 0 c
- 1277 2101 m -3 -1 d 5 -3 d f 0.2 0.8 0 c 1312 2089 m 6 2 d -2 1 d -34 10 d -5
- -1 d 2 -4 d 9 -7 d f 0.4 0.8 0 c 1295 2085 m 17 4 d 4 3 d -6 5 d -22 7 d -6 -2
- d 6 -12 d f 0.6 0.8 0 c 1310 2097 m -6 5 d -11 3 d -5 -1 d f 0.8 0.8 0 c 1304
- 2102 m -6 4 d -5 -1 d f 0 0.8 0 c 1279 2097 m -5 3 d -2 X f 0.2 0.8 0 c 1288
- 2090 m -9 7 d -7 3 d -4 -1 d f 0.4 0.8 0 c 1291 2084 m 4 1 d -7 5 d -20 9 d -4
- -1 d f 0.6 0.8 0 c 1273 2079 m 18 5 d -27 14 d -5 -2 d f 0.8 0.8 0 c 1271 2079
- m 2 X -14 17 d -4 -1 d 7 -9 d f 0.8 0.6 0 c 1255 2095 m -4 -1 d 11 -8 d f 0.8
- 0.4 0 c 1251 2094 m f 0.6 0.8 0 c 1248 2073 m 17 4 d -20 -2 d f 0.8 0.8 0 c
- 1265 2077 m 6 2 d -9 7 d -26 -5 d 9 -6 d f 0.8 0.6 0 c 1262 2086 m -11 8 d -23
- -6 d 8 -7 d f 0.8 0.4 0 c 1251 2094 m -24 -6 d 1 X f 0.4 0.8 0 c 1209 2084 m -5
- -2 d 9 -6 d f 0.6 0.8 0 c 1230 2068 m 18 5 d -3 2 d -30 10 d -6 -1 d 4 -8 d 10
- -8 d f 0.8 0.8 0 c 1224 2067 m 6 1 d 15 7 d -9 6 d -15 6 d -6 -2 d 8 -17 d f
- 0.8 0.6 0 c 1236 2081 m -8 7 d -1 X -6 -1 d f 0.8 0.4 0 c 1228 2088 m -1 X f
- 0.4 0.8 0 c 1213 2076 m -9 6 d -13 -3 d f 0.6 0.8 0 c 1201 2061 m 17 4 d 5 3 d
- -10 8 d -22 3 d -11 -3 d f 0.8 0.8 0 c 1218 2065 m 6 2 d -1 1 d f 0.2 0.8 0 c
- 1158 2071 m -1 -1 d 5 -4 d f 0.4 0.8 0 c 1177 2055 m 13 3 d -19 16 d -13 -3 d 4
- -5 d f 0.6 0.8 0 c 1190 2058 m 11 3 d -21 15 d -9 -2 d f 0 0.8 0 c 1136 2065 m
- -3 -1 d 4 -2 d f 0.2 0.8 0 c 1154 2049 m 14 4 d -6 13 d -5 4 d -21 -5 d 1 -3 d
- f 0.4 0.8 0 c 1168 2053 m 9 2 d -15 11 d f 0 0.8 0 c 1137 2062 m -4 2 d -1 X f
- 0.2 0.8 0 c 1144 2046 m 10 3 d -17 13 d -5 2 d -8 -2 d f 0.4 0.8 0 c 1130 2043
- m 14 3 d -20 16 d -8 -2 d 5 -10 d f 0.6 0.8 0 c 1116 2060 m -6 -2 d 11 -8 d f
- 0.2 0.8 0 c 1107 2037 m 15 4 d -35 12 d -1 -1 d f 0.4 0.8 0 c 1122 2041 m 8 2 d
- -9 7 d -20 6 d -14 -3 d f 0.6 0.8 0 c 1121 2050 m -11 8 d -9 -2 d f 0.2 0.8 0 c
- 1103 2036 m 4 1 d -21 15 d -1 X f 0.4 0.8 0 c 1098 2035 m 5 1 d -18 16 d -18 -4
- d f 0.6 0.8 0 c 1093 2033 m 5 2 d -31 13 d -4 -2 d 5 -4 d f 0.8 0.8 0 c 1089
- 2032 m 4 1 d -25 9 d 8 -5 d f 0.8 0.6 0 c 1084 2031 m 5 1 d -13 5 d 7 -6 d f
- 0.8 0.4 0 c 1083 2031 m 1 X -1 X f 0 0.8 0 c 1060 2025 m 2 1 d -6 2 d f 0.2 0.8
- 0 c 1062 2026 m 4 1 d -16 5 d 6 -4 d f 0.4 0.8 0 c 1066 2027 m 5 1 d -27 9 d 6
- -5 d f 0.6 0.8 0 c 1071 2028 m 4 1 d -7 13 d -5 4 d -24 -6 d 5 -3 d f 0.8 0.8 0
- c 1075 2029 m 4 1 d -3 7 d -8 5 d f 0.8 0.6 0 c 1079 2030 m 4 1 d -7 6 d f 0.8
- 0.4 0 c 1083 2031 m f 0 0.8 0 c 1053 2023 m 7 2 d -4 3 d f 0.2 0.8 0 c 1041
- 2020 m 12 3 d 3 5 d -6 4 d f 0.4 0.8 0 c 1036 2019 m 5 1 d 9 12 d -6 5 d -15
- -12 d f 0.6 0.8 0 c 1044 2037 m -5 3 d -17 -4 d -5 -3 d 12 -8 d f 0.8 0.8 0 c
- 1022 2036 m -6 -2 d 1 -1 d f 0.4 0.8 0 c 1013 2013 m 23 6 d -7 6 d -19 -10 d f
- 0.6 0.8 0 c 1029 2025 m -12 8 d -23 -6 d 16 -12 d f 0.8 0.8 0 c 1017 2033 m -1
- 1 d -24 -6 d 2 -1 d f 0 0.8 0 c 989 2007 m 7 2 d -12 2 d f 0.2 0.8 0 c 996 2009
- m 9 2 d -27 5 d 6 -5 d f 0.4 0.8 0 c 1005 2011 m 8 2 d -3 2 d -38 5 d 6 -4 d f
- 0.6 0.8 0 c 1010 2015 m -16 12 d -5 X -20 -5 d 3 -2 d f 0.8 0.8 0 c 994 2027 m
- -2 1 d -3 -1 d f 0 0.8 0 c 966 2001 m 23 6 d -5 4 d -19 -9 d f 0.2 0.8 0 c 984
- 2011 m -6 5 d -20 -9 d 7 -5 d f 0.4 0.8 0 c 978 2016 m -6 4 d -22 -7 d 8 -6 d f
- 0.6 0.8 0 c 972 2020 m -3 2 d -23 -5 d 4 -4 d f 0 0.8 0 c 963 2000 m 3 1 d -1 1
- d f 0.2 0.8 0 c 945 1996 m 18 4 d 2 2 d -7 5 d f 0.4 0.8 0 c 942 1995 m 3 1 d
- 13 11 d -8 6 d -23 -6 d f 0.6 0.8 0 c 950 2013 m -4 4 d -24 -6 d 5 -4 d f 0.4
- 0.8 0 c 919 1989 m 23 6 d -15 12 d -10 2 d -18 -4 d f 0.6 0.8 0 c 927 2007 m -5
- 4 d -5 -2 d f 0.2 0.8 0 c 895 1983 m 14 3 d -23 4 d f 0.4 0.8 0 c 909 1986 m 10
- 3 d -20 16 d -24 -6 d 11 -9 d f 0.2 0.8 0 c 872 1977 m 23 6 d -9 7 d -29 -1 d f
- 0.4 0.8 0 c 886 1990 m -11 9 d -23 -6 d 5 -4 d f 0 0.8 0 c 838 1989 m -10 -2 d
- 6 -5 d f 0.2 0.8 0 c 864 1975 m 8 2 d -15 12 d -7 3 d -12 -3 d -4 -7 d 7 -5 d f
- 0.4 0.8 0 c 849 1971 m 15 4 d -7 14 d -5 4 d -2 -1 d -9 -15 d 7 -6 d f 0.6 0.8
- 0 c 848 1971 m 1 X -1 X f 0 0.8 0 c 834 1982 m -6 5 d -21 -6 d f 0.2 0.8 0 c
- 841 1977 m -7 5 d -27 -1 d -2 X 7 -6 d f 0.4 0.8 0 c 848 1971 m -7 6 d -29 -2 d
- 8 -6 d f 0.6 0.8 0 c 825 1965 m 23 6 d -28 -2 d f 0.2 0.8 0 c 812 1975 m -7 6 d
- -24 -6 d 6 -5 d f 0.4 0.8 0 c 801 1959 m 9 2 d 10 8 d -8 6 d -25 -5 d f 0.6 0.8
- 0 c 810 1961 m 15 4 d -5 4 d f 0.2 0.8 0 c 778 1953 m 13 3 d -4 14 d -6 5 d -23
- -6 d f 0.4 0.8 0 c 791 1956 m 10 3 d -14 11 d f 0 0.8 0.2 c 754 1947 m 8 2 d
- -14 3 d f 0 0.8 0 c 762 1949 m 12 3 d -37 8 d 11 -8 d f 0.2 0.8 0 c 774 1952 m
- 4 1 d -20 16 d -24 -6 d 3 -3 d f 0 0.8 0.2 c 751 1946 m 3 1 d -6 5 d f 0 0.8 0
- c 745 1945 m 6 1 d -3 6 d -11 8 d f 0.2 0.8 0 c 738 1943 m 7 2 d -8 15 d -3 3 d
- -6 -2 d f 0.4 0.8 0 c 732 1942 m 6 1 d -10 18 d -9 -2 d f 0.6 0.8 0 c 731 1941
- m 1 1 d -13 17 d -8 -2 d f 0 0.8 0 c 707 1935 m 4 1 d -8 2 d f 0.2 0.8 0 c 711
- 1936 m 9 2 d -28 9 d 11 -9 d f 0.4 0.8 0 c 720 1938 m 9 3 d -32 12 d -10 -2 d 5
- -4 d f 0.6 0.8 0 c 729 1941 m 2 X -20 16 d -14 -4 d f 0 0.8 0 c 704 1934 m 3 1
- d -4 3 d f 0.2 0.8 0 c 694 1932 m 10 2 d -1 4 d -11 9 d f 0.4 0.8 0 c 684 1929
- m 10 3 d -2 15 d -5 4 d -23 -6 d 19 -15 d f 0.6 0.8 0 c 684 1929 m -1 1 d f 0 0
- 0.8 c 660 1923 m 3 1 d -21 15 d -2 X f 0 0.2 0.8 c 663 1924 m 2 X -20 16 d -3
- -1 d f 0 0.4 0.8 c 665 1924 m 2 1 d -20 16 d -2 -1 d f 0 0.6 0.8 c 667 1925 m 2
- X -20 16 d -2 X f 0 0.8 0.8 c 669 1925 m 2 1 d -19 16 d -3 -1 d f 0 0.8 0.6 c
- 671 1926 m 2 1 d -19 15 d -2 X f 0 0.8 0.4 c 673 1927 m 2 X -19 16 d -2 -1 d f
- 0 0.8 0.2 c 675 1927 m 3 1 d -19 15 d -3 X f 0 0.8 0 c 678 1928 m 2 X -19 16 d
- -2 -1 d f 0.2 0.8 0 c 680 1928 m 2 1 d -19 16 d -2 -1 d f 0.4 0.8 0 c 682 1929
- m 2 X -1 1 d -19 15 d -1 X f 0.6 0.8 0 c 684 1929 m -1 1 d f 0 0 0.8 c 637 1917
- m 23 6 d -20 16 d -23 -6 d f 614 1911 m 23 6 d -20 16 d -24 -6 d f 590 1905 m
- 24 6 d -21 16 d -23 -6 d f 1691 2165 m 23 6 d -20 15 d -23 -6 d f 1667 2159 m
- 24 6 d -20 15 d -24 -6 d f 1644 2153 m 23 6 d -20 15 d -23 -6 d f 1641 2152 m 3
- 1 d -20 15 d -2 X f 0 0.2 0.8 c 1637 2151 m 4 1 d -19 16 d -2 -1 d f 0 0.4 0.8
- c 1634 2150 m 3 1 d -17 16 d -2 X f 0 0.6 0.8 c 1631 2150 m 3 X -16 17 d -2 X f
- 0 0.8 0.8 c 1627 2149 m 4 1 d -15 17 d -2 -1 d f 0 0.8 0.6 c 1624 2148 m 3 1 d
- -13 17 d -2 X f 0 0.8 0.4 c 1621 2147 m 3 1 d -12 18 d -2 -1 d f 0 0.8 0.2 c
- 1620 2147 m 1 X -11 18 d -1 X 8 -16 d f 0 0.8 0 c 1609 2165 m -2 -1 d 6 -12 d 4
- -3 d f 0.2 0.8 0 c 1607 2164 m -2 X 5 -9 d 3 -3 d f 0.4 0.8 0 c 1605 2164 m -2
- -1 d 3 -5 d 4 -3 d f 0.6 0.8 0 c 1603 2163 m -2 X 1 -2 d 4 -3 d f 0.8 0.8 0 c
- 1601 2163 m -1 -1 d 2 -1 d f 0 0.8 0.2 c 1597 2141 m 23 6 d -3 2 d -26 -4 d f 0
- 0.8 0 c 1617 2149 m -4 3 d -35 4 d 13 -11 d f 0.2 0.8 0 c 1613 2152 m -3 3 d
- -27 3 d -6 -2 d 1 X f 0.4 0.8 0 c 1610 2155 m -4 3 d -16 2 d -7 -2 d f 0.6 0.8
- 0 c 1606 2158 m -4 3 d -6 X -6 -1 d f 0.8 0.8 0 c 1602 2161 m -2 1 d -4 -1 d f
- 0 0.8 0.2 c 1588 2139 m 9 2 d -6 4 d f 0 0.8 0 c 1573 2135 m 15 4 d 3 6 d -13
- 11 d -6 -20 d f 0.2 0.8 0 c 1578 2156 m -1 X -5 -1 d -4 -16 d 4 -3 d f 0.4 0.8
- 0 c 1572 2155 m -5 -1 d -3 -12 d 4 -3 d f 0.6 0.8 0 c 1567 2154 m -6 -1 d -1 -8
- d 4 -3 d f 0.8 0.8 0 c 1561 2153 m -5 -2 d -2 Y 4 -4 d f 0.8 0.6 0 c 1556 2151
- m -3 -1 d 3 -1 d f 0 0.8 0 c 1569 2134 m 4 1 d -1 1 d f 0.2 0.8 0 c 1557 2131 m
- 12 3 d 3 2 d -4 3 d f 0.4 0.8 0 c 1550 2129 m 7 2 d 11 8 d -4 3 d -18 -10 d f
- 0.6 0.8 0 c 1564 2142 m -4 3 d -25 -5 d 11 -8 d f 0.8 0.8 0 c 1560 2145 m -4 4
- d -16 -2 d -10 -3 d 5 -4 d f 0.8 0.6 0 c 1556 2149 m -3 1 d -13 -3 d f 0.2 0.8
- 0 c 1526 2123 m 13 3 d -18 1 d f 0.4 0.8 0 c 1539 2126 m 11 3 d -4 3 d -32 X 7
- -5 d f 0.6 0.8 0 c 1546 2132 m -11 8 d -28 -2 d 7 -6 d f 0.8 0.8 0 c 1535 2140
- m -5 4 d -24 -5 d 1 -1 d f 0 0.8 0 c 1503 2117 m 7 2 d -24 14 d -3 X f 0.2 0.8
- 0 c 1510 2119 m 16 4 d -5 4 d -28 8 d -7 -2 d f 0.4 0.8 0 c 1521 2127 m -7 5 d
- -15 5 d -6 -2 d f 0.6 0.8 0 c 1514 2132 m -7 6 d -2 X -6 -1 d f 0.8 0.8 0 c
- 1507 2138 m -1 1 d -1 -1 d f 0 0.8 0.2 c 1479 2111 m 8 2 d -10 X f 0 0.8 0 c
- 1487 2113 m 16 4 d -20 16 d -4 -2 d -7 -15 d 5 -3 d f 0.2 0.8 0 c 1479 2131 m
- -8 -1 d -4 -10 d 5 -4 d f 0.4 0.8 0 c 1471 2130 m -7 -2 d -2 -4 d 5 -4 d f 0.6
- 0.8 0 c 1464 2128 m -5 -1 d 3 -3 d f 0 0.8 0.4 c 1456 2105 m 8 2 d -9 -1 d f 0
- 0.8 0.2 c 1464 2107 m 15 4 d -2 2 d -26 -5 d 4 -2 d f 0 0.8 0 c 1477 2113 m -5
- 3 d -24 -5 d 3 -3 d f 0.2 0.8 0 c 1472 2116 m -5 4 d -23 -6 d 4 -3 d f 0.4 0.8
- 0 c 1467 2120 m -5 4 d -21 -8 d 3 -2 d f 0.6 0.8 0 c 1462 2124 m -3 3 d -9 -3 d
- -12 -5 d 3 -3 d f 0.8 0.8 0 c 1450 2124 m -14 -3 d 2 -2 d f 0 0.8 0.4 c 1453
- 2104 m 3 1 d -1 1 d f 0 0.8 0.2 c 1443 2102 m 10 2 d 2 2 d -4 2 d f 0 0.8 0 c
- 1433 2099 m 10 3 d 8 6 d -3 3 d f 0.2 0.8 0 c 1432 2099 m 1 X 15 12 d -4 3 d
- -18 -10 d f 0.4 0.8 0 c 1444 2114 m -3 2 d -22 -6 d 7 -6 d f 0.6 0.8 0 c 1441
- 2116 m -3 3 d -22 -3 d -4 -1 d 7 -5 d f 0.8 0.8 0 c 1438 2119 m -2 2 d -20 -5 d
- f 0.2 0.8 0 c 1409 2093 m 23 6 d -6 5 d -17 -11 d f 0.4 0.8 0 c 1426 2104 m -7
- 6 d -17 -12 d 7 -5 d f 0.6 0.8 0 c 1419 2110 m -7 5 d -2 -1 d -15 -10 d 7 -6 d
- f 0.8 0.8 0 c 1410 2114 m -21 -5 d 6 -5 d f 0 0.8 0.2 c 1386 2087 m 4 1 d -7 1
- d f 0 0.8 0 c 1390 2088 m 10 3 d -23 3 d 6 -5 d f 0.2 0.8 0 c 1400 2091 m 9 2 d
- -38 5 d 6 -4 d f 0.4 0.8 0 c 1409 2093 m -7 5 d -37 5 d 6 -5 d f 0.6 0.8 0 c
- 1402 2098 m -7 6 d -18 2 d -12 -3 d f 0.8 0.8 0 c 1395 2104 m -6 5 d -12 -3 d f
- 0 0.8 0.2 c 1381 2086 m 5 1 d -3 2 d f 0 0.8 0 c 1371 2083 m 10 3 d 2 3 d -6 5
- d f 0.2 0.8 0 c 1362 2081 m 9 2 d 6 11 d -6 4 d -14 -13 d f 0.4 0.8 0 c 1371
- 2098 m -6 5 d -1 -1 d -22 -5 d 15 -12 d f 0.6 0.8 0 c 1365 2103 m -1 -1 d f 0.2
- 0.8 0 c 1361 2081 m 1 X -5 4 d -24 9 d -15 -3 d 4 -3 d f 0.4 0.8 0 c 1343 2076
- m 18 5 d -4 4 d -15 12 d -9 -3 d -11 -6 d 13 -10 d f 0.6 0.8 0 c 1339 2075 m 4
- 1 d -8 2 d f 0 0.8 0.2 c 1315 2069 m 2 1 d -3 X f 0 0.8 0 c 1317 2070 m 6 1 d
- -16 4 d 7 -5 d f 0.2 0.8 0 c 1323 2071 m 7 2 d -8 15 d -4 3 d -6 -2 d -12 -8 d
- 7 -6 d f 0.4 0.8 0 c 1330 2073 m 7 2 d -2 3 d -13 10 d -10 1 d -17 -4 d 5 -4 d
- f 0.6 0.8 0 c 1337 2075 m 2 X -4 3 d f 0 0.8 0.2 c 1310 2068 m 5 1 d -1 1 d f 0
- 0.8 0 c 1292 2063 m 18 5 d 4 2 d -7 5 d -16 -11 d f 0.2 0.8 0 c 1307 2075 m -7
- 6 d -16 -12 d 7 -5 d f 0.4 0.8 0 c 1300 2081 m -5 4 d -4 -1 d -13 -11 d 6 -4 d
- f 0.6 0.8 0 c 1291 2084 m -18 -5 d -1 -1 d 6 -5 d f 0.8 0.8 0 c 1273 2079 m -2
- X 1 -1 d f 0 0.8 0 c 1268 2057 m 24 6 d -1 1 d -28 -3 d f 0.2 0.8 0 c 1291 2064
- m -7 5 d -27 -3 d 6 -5 d f 0.4 0.8 0 c 1284 2069 m -6 4 d -27 -3 d 6 -4 d f 0.6
- 0.8 0 c 1278 2073 m -6 5 d -7 -1 d -17 -4 d 3 -3 d f 0.8 0.8 0 c 1272 2078 m -1
- 1 d -6 -2 d f 0 0.8 0 c 1245 2051 m 23 6 d -5 4 d -19 -9 d f 0.2 0.8 0 c 1263
- 2061 m -6 5 d -20 -9 d 7 -5 d f 0.4 0.8 0 c 1257 2066 m -6 4 d -20 -9 d 6 -4 d
- f 0.6 0.8 0 c 1251 2070 m -3 3 d -18 -5 d -5 -2 d 6 -5 d f 0.8 0.8 0 c 1230
- 2068 m -6 -1 d 1 -1 d f 0 0.8 0.4 c 1221 2045 m 3 1 d -4 X f 0 0.8 0.2 c 1224
- 2046 m 11 3 d -19 X 4 -3 d f 0 0.8 0 c 1235 2049 m 10 2 d -1 1 d -32 X 4 -3 d f
- 0.2 0.8 0 c 1244 2052 m -7 5 d -29 -1 d 4 -4 d f 0.4 0.8 0 c 1237 2057 m -6 4 d
- -27 -2 d 4 -3 d f 0.6 0.8 0 c 1231 2061 m -6 5 d -7 -1 d -17 -4 d 3 -2 d f 0.8
- 0.8 0 c 1225 2066 m -1 1 d -6 -2 d f 0 0.8 0.4 c 1220 2045 m 1 X -1 1 d f 0 0.8
- 0.2 c 1216 2044 m 4 1 d 1 Y -4 3 d f 0 0.8 0 c 1212 2043 m 4 1 d 5 Y -4 3 d f
- 0.2 0.8 0 c 1209 2042 m 3 1 d 9 Y -4 4 d f 0.4 0.8 0 c 1205 2041 m 4 1 d -1 14
- d -4 3 d -14 -1 d -13 -3 d 6 -5 d f 0.6 0.8 0 c 1201 2040 m 4 1 d -1 18 d -3 2
- d -11 -3 d -7 -8 d 8 -5 d f 0.8 0.8 0 c 1198 2039 m 3 1 d -10 5 d f 0.2 0.8 0 c
- 1174 2033 m 6 2 d -12 18 d -14 -4 d f 0.4 0.8 0 c 1180 2035 m 6 1 d -3 14 d -6
- 5 d -9 -2 d f 0.6 0.8 0 c 1186 2036 m 6 2 d -1 7 d -8 5 d f 0.8 0.8 0 c 1192
- 2038 m 6 1 d -7 6 d f 0.2 0.8 0 c 1151 2027 m 23 6 d -20 16 d -10 -3 d -2 -12 d
- f 0.4 0.8 0 c 1144 2046 m -14 -3 d 12 -9 d f 0.2 0.8 0 c 1127 2021 m 24 6 d -9
- 7 d -20 7 d -15 -4 d f 0.4 0.8 0 c 1142 2034 m -12 9 d -8 -2 d f 0 0.8 0 c 1104
- 2015 m 12 3 d -14 -1 d f 0.2 0.8 0 c 1116 2018 m 11 3 d -20 16 d -4 -1 d -5 -16
- d 4 -3 d f 0.4 0.8 0 c 1103 2036 m -5 -1 d -4 -13 d 4 -2 d f 0.6 0.8 0 c 1098
- 2035 m -5 -2 d -2 -8 d 3 -3 d f 0.8 0.8 0 c 1093 2033 m -4 -1 d -2 -4 d 4 -3 d
- f 0.8 0.6 0 c 1089 2032 m -5 -1 d -1 X 4 -3 d f 0.8 0.4 0 c 1084 2031 m -1 X f
- 0 0.8 0 c 1083 2010 m 21 5 d -2 2 d -40 9 d -2 -1 d 18 -14 d f 0.2 0.8 0 c 1080
- 2009 m 3 1 d 19 7 d -4 3 d -32 7 d -4 -1 d 16 -15 d f 0.4 0.8 0 c 1098 2020 m
- -4 2 d -23 6 d -5 -1 d f 0.6 0.8 0 c 1094 2022 m -3 3 d -16 4 d -4 -1 d f 0.8
- 0.8 0 c 1091 2025 m -4 3 d -8 2 d -4 -1 d f 0.8 0.6 0 c 1087 2028 m -4 3 d -4
- -1 d f 0.8 0.4 0 c 1083 2031 m f 0 0.8 0 c 1078 2011 m -18 14 d -7 -2 d f 0.2
- 0.8 0 c 1057 2003 m 23 6 d -2 2 d -25 12 d -12 -3 d 2 -7 d f 0.4 0.8 0 c 1041
- 2020 m -5 -1 d 7 -6 d f 0.2 0.8 0 c 1052 2002 m 5 1 d -14 10 d f 0.4 0.8 0 c
- 1045 2000 m 7 2 d -9 11 d -7 6 d -23 -6 d 2 -2 d f 0.6 0.8 0 c 1038 1999 m 7 1
- d -30 11 d 10 -8 d f 0.8 0.8 0 c 1033 1997 m 5 2 d -13 4 d f 0 0.8 0 c 996 2009
- m -7 -2 d 10 -7 d f 0.2 0.8 0 c 1010 1991 m 1 Y -5 19 d -9 -2 d 3 -9 d f 0.4
- 0.8 0 c 1010 1992 m 8 2 d -3 17 d -2 2 d -8 -2 d f 0.6 0.8 0 c 1018 1994 m 9 2
- d -2 7 d -10 8 d f 0.8 0.8 0 c 1027 1996 m 6 1 d -8 6 d f 0 0.8 0 c 999 2000 m
- -10 7 d -23 -6 d 1 -1 d f 0.2 0.8 0 c 1009 1991 m 1 X -11 9 d -32 X 6 -5 d f
- 0.4 0.8 0 c 997 1988 m 12 3 d -36 4 d 7 -5 d f 0.6 0.8 0 c 986 1985 m 11 3 d
- -17 2 d f 0 0.8 0 c 967 2000 m -1 1 d -3 -1 d f 0.2 0.8 0 c 973 1995 m -6 5 d
- -4 X -18 -4 d f 0.4 0.8 0 c 963 1979 m 7 2 d 10 9 d -7 5 d -28 1 d -3 -1 d f
- 0.6 0.8 0 c 970 1981 m 16 4 d -6 5 d f 0.4 0.8 0 c 939 1973 m 24 6 d -21 16 d
- -23 -6 d f 0.2 0.8 0 c 909 1986 m -14 -3 d 6 -4 d f 0.4 0.8 0 c 921 1969 m 18 4
- d -20 16 d -10 -3 d -8 -7 d 12 -9 d f 0.6 0.8 0 c 916 1968 m 5 1 d -8 1 d f 0.2
- 0.8 0 c 892 1962 m 10 2 d -1 15 d -6 4 d -23 -6 d f 0.4 0.8 0 c 902 1964 m 11 3
- d 3 Y -12 9 d f 0.6 0.8 0 c 913 1967 m 3 1 d -3 2 d f 0.2 0.8 0 c 869 1956 m 23
- 6 d -20 15 d -8 -2 d 4 -19 d f 0.4 0.8 0 c 864 1975 m -15 -4 d 19 -15 d f 0.6
- 0.8 0 c 849 1971 m -1 X 1 X f 0.2 0.8 0 c 845 1950 m 24 6 d -1 X -26 -4 d f 0.4
- 0.8 0 c 868 1956 m -19 15 d -17 -11 d 10 -8 d f 0.6 0.8 0 c 849 1971 m -1 X -23
- -6 d 7 -5 d f 0.2 0.8 0 c 822 1944 m 23 6 d -3 2 d -29 -1 d f 0.4 0.8 0 c 842
- 1952 m -10 8 d -22 1 d -9 -2 d 12 -8 d f 0.6 0.8 0 c 832 1960 m -7 5 d -15 -4 d
- f 0 0.8 0.2 c 798 1938 m 7 1 d -13 4 d f 0 0.8 0 c 805 1939 m 11 3 d -35 9 d 11
- -8 d f 0.2 0.8 0 c 816 1942 m 6 2 d -9 7 d -22 5 d -13 -3 d 3 -2 d f 0.4 0.8 0
- c 813 1951 m -12 8 d -10 -3 d f 0 0.8 0.2 c 795 1937 m 3 1 d -6 5 d -30 6 d -8
- -2 d 3 -2 d f 0 0.8 0 c 790 1936 m 5 1 d -3 6 d -11 8 d -7 1 d -12 -3 d -5 -4 d
- 4 -3 d f 0.2 0.8 0 c 786 1934 m 4 2 d -9 15 d -3 2 d -4 -1 d -13 -10 d 4 -3 d f
- 0.4 0.8 0 c 781 1933 m 5 1 d -21 5 d 4 -3 d f 0.6 0.8 0 c 776 1932 m 5 1 d -12
- 3 d 4 -3 d f 0.8 0.8 0 c 775 1932 m 1 X -3 1 d f 0 0.8 0.2 c 757 1945 m -3 2 d
- -3 -1 d f 0 0.8 0 c 761 1942 m -4 3 d -6 1 d -6 -1 d f 0.2 0.8 0 c 765 1939 m
- -4 3 d -16 3 d -7 -2 d f 0.4 0.8 0 c 769 1936 m -4 3 d -27 4 d -6 -1 d f 0.6
- 0.8 0 c 751 1926 m 18 4 d 4 3 d -4 3 d -37 6 d -1 -1 d f 0.8 0.8 0 c 769 1930 m
- 6 2 d -2 1 d f 0 0.8 0 c 711 1936 m -4 -1 d 9 -6 d f 0.2 0.8 0 c 728 1920 m 7 2
- d -15 16 d -9 -2 d 5 -7 d f 0.4 0.8 0 c 735 1922 m 16 4 d -22 15 d -9 -3 d f
- 0.6 0.8 0 c 751 1926 m -20 15 d -2 X f 0 0.8 0 c 704 1914 m 5 1 d 7 14 d -9 6 d
- -3 -1 d -1 -19 d f 0.2 0.8 0 c 709 1915 m 19 5 d -12 9 d -12 5 d -10 -2 d -10 Y
- 9 -7 d f 0.4 0.8 0 c 694 1932 m -10 -3 d 10 -7 d f 0.6 0.8 0 c 684 1929 m f 0 0
- 0.8 c 681 1908 m 2 X -20 16 d -3 -1 d f 0 0.2 0.8 c 683 1908 m 3 1 d -21 15 d
- -2 X f 0 0.4 0.8 c 686 1909 m 3 1 d -22 15 d -2 -1 d f 0 0.6 0.8 c 689 1910 m 2
- X -22 15 d -2 X f 0 0.8 0.8 c 691 1910 m 3 1 d -23 15 d -2 -1 d f 0 0.8 0.6 c
- 694 1911 m 3 1 d -24 15 d -2 -1 d f 0 0.8 0.4 c 697 1912 m 2 X -24 15 d -2 X f
- 0 0.8 0.2 c 699 1912 m 3 1 d -24 15 d -3 -1 d f 0 0.8 0 c 702 1913 m 2 1 d -1 1
- d -23 13 d -2 X f 0.2 0.8 0 c 703 1915 m -9 7 d -12 7 d -2 -1 d f 0.4 0.8 0 c
- 694 1922 m -10 7 d -2 X f 0.6 0.8 0 c 684 1929 m f 0 0 0.8 c 657 1902 m 24 6 d
- -21 15 d -23 -6 d f 634 1896 m 23 6 d -20 15 d -23 -6 d f 610 1890 m 24 6 d -20
- 15 d -24 -6 d f 1711 2149 m 24 6 d -21 16 d -23 -6 d f 1688 2143 m 23 6 d -20
- 16 d -24 -6 d f 1664 2137 m 24 6 d -21 16 d -23 -6 d f 1662 2137 m 2 X -20 16 d
- -3 -1 d f 0 0.2 0.8 c 1660 2136 m 2 1 d -21 15 d -4 -1 d f 0 0.4 0.8 c 1657
- 2136 m 3 X -23 15 d -3 -1 d f 0 0.6 0.8 c 1655 2135 m 2 1 d -23 14 d -3 X f 0
- 0.8 0.8 c 1653 2134 m 2 1 d -24 15 d -4 -1 d f 0 0.8 0.6 c 1650 2134 m 3 X -26
- 15 d -3 -1 d f 0 0.8 0.4 c 1648 2133 m 2 1 d -26 14 d -3 -1 d f 0 0.8 0.2 c
- 1646 2133 m 2 X -27 14 d -1 X 6 -5 d f 0 0.8 0 c 1643 2132 m 3 1 d -20 9 d 7 -5
- d f 0.2 0.8 0 c 1641 2131 m 2 1 d -10 5 d 7 -5 d f 0.4 0.8 0 c 1641 2131 m -1 1
- d f 0 0.8 0.2 c 1626 2142 m -6 5 d -23 -6 d 7 -5 d f 0 0.8 0 c 1617 2125 m 3 1
- d 13 11 d -7 5 d -22 -6 d f 0.2 0.8 0 c 1620 2126 m 18 5 d 2 1 d -7 5 d f 0.4
- 0.8 0 c 1638 2131 m 3 X -1 1 d f 0 0.8 0.4 c 1594 2119 m 1 1 d -2 X f 0 0.8 0.2
- c 1595 2120 m 12 3 d -3 13 d -7 5 d -9 -2 d -7 -10 d 12 -9 d f 0 0.8 0 c 1607
- 2123 m 10 2 d -13 11 d -16 3 d -15 -4 d 8 -6 d f 0 0.8 0.4 c 1593 2119 m 1 X -1
- 1 d f 0 0.8 0.2 c 1577 2115 m 16 4 d 1 Y -12 9 d f 0 0.8 0 c 1570 2113 m 7 2 d
- 4 14 d -8 6 d -4 -1 d -4 -16 d f 0.2 0.8 0 c 1569 2134 m -12 -3 d -1 -6 d 9 -7
- d f 0.4 0.8 0 c 1557 2131 m -7 -2 d 6 -4 d f 0 0.8 0 c 1565 2112 m 5 1 d -5 5 d
- f 0.2 0.8 0 c 1555 2109 m 10 3 d 6 Y -9 7 d -17 1 d -13 -3 d 10 -7 d f 0.4 0.8
- 0 c 1547 2107 m 8 2 d 1 16 d -6 4 d -11 -3 d -3 -10 d f 0 0.8 0 c 1523 2101 m 2
- 1 d -15 17 d -7 -2 d f 0.2 0.8 0 c 1525 2102 m 12 3 d -1 11 d -10 7 d -16 -4 d
- f 0.4 0.8 0 c 1537 2105 m 10 2 d -11 9 d f 0 0.8 0.6 c 1500 2095 m 1 1 d -3 1 d
- f 0 0.8 0.4 c 1501 2096 m 8 2 d -23 8 d 12 -9 d f 0 0.8 0.2 c 1509 2098 m 8 2 d
- -30 13 d -8 -2 d 7 -5 d f 0 0.8 0 c 1517 2100 m 6 1 d -20 16 d -16 -4 d f 0 0.8
- 0.6 c 1498 2095 m 2 X -2 2 d f 0 0.8 0.4 c 1490 2093 m 8 2 d 2 Y -12 9 d -22 1
- d -8 -2 d 3 -2 d f 0 0.8 0.2 c 1482 2091 m 8 2 d -4 13 d -7 5 d -15 -4 d -5 -4
- d 11 -8 d f 0 0.8 0 c 1476 2090 m 6 1 d -12 4 d f 0 0.8 0.4 c 1459 2103 m -3 2
- d -3 -1 d f 0 0.8 0.2 c 1470 2095 m -11 8 d -6 1 d -10 -2 d f 0 0.8 0 c 1469
- 2088 m 7 2 d -6 5 d -27 7 d -10 -3 d f 0.2 0.8 0 c 1453 2084 m 16 4 d -36 11 d
- -1 X f 0 0.8 0.2 c 1429 2078 m 5 1 d -8 1 d f 0 0.8 0 c 1434 2079 m 11 3 d -28
- 5 d 9 -7 d f 0.2 0.8 0 c 1445 2082 m 8 2 d -21 15 d -23 -6 d 8 -6 d f 0 0.8 0.4
- c 1406 2072 m 3 X -6 2 d f 0 0.8 0.2 c 1409 2072 m 20 6 d -3 2 d -36 8 d -4 -1
- d 17 -13 d f 0 0.8 0 c 1426 2080 m -9 7 d -17 4 d -10 -3 d f 0.2 0.8 0 c 1417
- 2087 m -8 6 d -9 -2 d f 0 0.8 0.4 c 1401 2070 m 5 2 d -3 2 d f 0 0.8 0.2 c 1382
- 2066 m 19 4 d 2 4 d -17 13 d -5 -1 d -4 -17 d f 0 0.8 0 c 1381 2086 m -10 -3 d
- -2 -8 d 8 -6 d f 0.2 0.8 0 c 1371 2083 m -9 -2 d 7 -6 d f 0 0.8 0.2 c 1371 2063
- m 11 3 d -5 3 d f 0 0.8 0 c 1359 2060 m 12 3 d 6 6 d -8 6 d -13 -13 d f 0.2 0.8
- 0 c 1369 2075 m -7 6 d -1 X -13 -13 d 8 -6 d f 0.4 0.8 0 c 1361 2081 m -18 -5 d
- -3 -2 d 8 -6 d f 0.6 0.8 0 c 1343 2076 m -4 -1 d 1 -1 d f 0 0.8 0.2 c 1335 2054
- m 12 3 d -30 13 d -2 -1 d f 0 0.8 0 c 1347 2057 m 12 3 d -3 2 d -33 9 d -6 -1 d
- f 0.2 0.8 0 c 1356 2062 m -8 6 d -18 5 d -7 -2 d f 0.4 0.8 0 c 1348 2068 m -8 6
- d -3 1 d -7 -2 d f 0.6 0.8 0 c 1340 2074 m -1 1 d -2 X f 0 0.8 0.6 c 1312 2048
- m 2 X -3 X f 0 0.8 0.4 c 1314 2048 m 16 4 d -26 2 d 7 -6 d f 0 0.8 0.2 c 1330
- 2052 m 5 2 d -20 15 d -5 -1 d -13 -9 d 7 -5 d f 0 0.8 0 c 1310 2068 m -18 -5 d
- 5 -4 d f 0 0.8 0.6 c 1311 2047 m 1 1 d -1 X f 0 0.8 0.4 c 1303 2045 m 8 2 d 1 Y
- -7 6 d f 0 0.8 0.2 c 1295 2043 m 8 2 d 1 9 d -7 5 d -29 -2 d f 0 0.8 0 c 1288
- 2042 m 7 1 d 2 16 d -5 4 d -24 -6 d f 1265 2036 m 23 6 d -20 15 d -23 -6 d f 0
- 0.8 0.4 c 1224 2046 m -3 -1 d 5 -3 d f 0 0.8 0.2 c 1241 2030 m 24 6 d -30 13 d
- -11 -3 d 2 -4 d f 0 0.8 0 c 1241 2030 m 24 6 d -20 15 d -10 -2 d f 0 0.8 0.4 c
- 1226 2042 m -5 3 d -1 X f 0 0.8 0.2 c 1218 2024 m 23 6 d -15 12 d -6 3 d -4 -1
- d -19 Y f 0 0.8 0 c 1241 2030 m -25 14 d -4 -1 d 1 -15 d 3 -3 d f 0.2 0.8 0 c
- 1212 2043 m -3 -1 d -11 Y 4 -3 d f 0.4 0.8 0 c 1209 2042 m -4 -1 d -7 Y 4 -3 d
- f 0.6 0.8 0 c 1205 2041 m -4 -1 d -4 Y 4 -2 d f 0.8 0.8 0 c 1201 2040 m -3 -1 d
- 3 -3 d f 0 0.8 0.2 c 1194 2018 m 24 6 d -2 1 d f 0 0.8 0 c 1194 2018 m 22 7 d
- -3 3 d -37 4 d f 0.2 0.8 0 c 1213 2028 m -4 3 d -29 4 d -6 -2 d 2 -1 d f 0.4
- 0.8 0 c 1209 2031 m -4 3 d -19 2 d -6 -1 d f 0.6 0.8 0 c 1205 2034 m -4 2 d -9
- 2 d -6 -2 d f 0.8 0.8 0 c 1201 2036 m -3 3 d -6 -1 d f 0 0.8 0.4 c 1171 2012 m
- 2 X -3 X f 0 0.8 0.2 c 1173 2012 m 21 6 d -31 X 7 -6 d f 0 0.8 0 c 1194 2018 m
- -18 14 d -20 -9 d 7 -5 d f 0.2 0.8 0 c 1176 2032 m -2 1 d -23 -6 d 5 -4 d f 0
- 0.8 0.4 c 1169 2011 m 2 1 d -1 X f 0 0.8 0.2 c 1147 2006 m 22 5 d 1 1 d -7 6 d
- f 0 0.8 0 c 1147 2006 m 16 12 d -7 5 d -22 -7 d f 0.2 0.8 0 c 1156 2023 m -5 4
- d -24 -6 d 7 -5 d f 0 0.8 0.6 c 1124 2000 m 2 X -3 1 d f 0 0.8 0.4 c 1126 2000
- m 11 3 d -22 4 d 8 -6 d f 0 0.8 0.2 c 1137 2003 m 10 3 d -40 7 d 8 -6 d f 0 0.8
- 0 c 1147 2006 m -13 10 d -18 2 d -12 -3 d 3 -2 d f 0.2 0.8 0 c 1134 2016 m -7 5
- d -11 -3 d f 0 0.8 0.6 c 1121 1999 m 3 1 d -1 1 d f 0 0.8 0.4 c 1106 1995 m 15
- 4 d 2 2 d -8 6 d f 0 0.8 0.2 c 1100 1994 m 6 1 d 9 12 d -8 6 d -14 -13 d f 0
- 0.8 0 c 1107 2013 m -3 2 d -21 -5 d -2 -1 d 12 -9 d f 0.2 0.8 0 c 1083 2010 m
- -3 -1 d 1 X f 0 0.8 0.2 c 1077 1988 m 23 6 d -7 6 d -23 -7 d f 0 0.8 0 c 1093
- 2000 m -12 9 d -21 -8 d 10 -8 d f 0.2 0.8 0 c 1081 2009 m -1 X -23 -6 d 3 -2 d
- f 0 0.8 0.2 c 1054 1982 m 23 6 d -7 5 d f 0 0.8 0 c 1054 1982 m 16 11 d -10 8 d
- -11 -16 d f 0.2 0.8 0 c 1060 2001 m -3 2 d -5 -1 d -7 -14 d 4 -3 d f 0.4 0.8 0
- c 1052 2002 m -7 -2 d -4 -8 d 4 -4 d f 0.6 0.8 0 c 1045 2000 m -7 -1 d -2 -4 d
- 5 -3 d f 0.8 0.8 0 c 1038 1999 m -5 -2 d 3 -2 d f 0 0.8 0 c 1043 1979 m 11 3 d
- -5 3 d f 0.2 0.8 0 c 1032 1976 m 11 3 d 6 6 d -4 3 d -35 4 d -1 Y 5 -3 d f 0.4
- 0.8 0 c 1030 1976 m 2 X 13 12 d -4 4 d -23 2 d -8 -2 d 5 -4 d f 0.6 0.8 0 c
- 1041 1992 m -5 3 d -9 1 d -9 -2 d f 0.8 0.8 0 c 1036 1995 m -3 2 d -6 -1 d f 0
- 0.8 0 c 1007 1970 m 10 3 d -16 1 d f 0.2 0.8 0 c 1017 1973 m 11 2 d -13 13 d -5
- 3 d -1 X -13 -13 d 5 -4 d f 0.4 0.8 0 c 1028 1975 m 2 1 d -15 12 d -6 3 d -12
- -3 d -6 -6 d 5 -4 d f 0.6 0.8 0 c 997 1988 m -11 -3 d 5 -3 d f 0 0.8 0 c 983
- 1964 m 24 6 d -6 4 d -22 -7 d f 0.2 0.8 0 c 1001 1974 m -5 4 d -27 -3 d 10 -8 d
- f 0.4 0.8 0 c 996 1978 m -5 4 d -21 -1 d -7 -2 d 6 -4 d f 0.6 0.8 0 c 991 1982
- m -5 3 d -16 -4 d f 0 0.8 0.4 c 960 1958 m 7 2 d -11 1 d f 0 0.8 0.2 c 967 1960
- m 10 2 d -26 3 d 5 -4 d f 0 0.8 0 c 977 1962 m 6 2 d -4 3 d -34 2 d 6 -4 d f
- 0.2 0.8 0 c 979 1967 m -10 8 d -29 -2 d 5 -4 d f 0.4 0.8 0 c 969 1975 m -6 4 d
- -24 -6 d 1 X f 0 0.8 0.4 c 944 1954 m 16 4 d -4 3 d f 0 0.8 0.2 c 936 1952 m 8
- 2 d 12 7 d -5 4 d -18 -10 d f 0 0.8 0 c 951 1965 m -6 4 d -18 -10 d 6 -4 d f
- 0.2 0.8 0 c 945 1969 m -5 4 d -18 -10 d 5 -4 d f 0.4 0.8 0 c 940 1973 m -1 X
- -18 -4 d -4 -2 d 5 -4 d f 0.6 0.8 0 c 921 1969 m -5 -1 d 1 -1 d f 0 0.8 0.2 c
- 926 1949 m 10 3 d -3 3 d f 0 0.8 0 c 913 1946 m 13 3 d 7 6 d -6 4 d -27 -3 d f
- 0.2 0.8 0 c 927 1959 m -5 4 d -20 1 d -10 -2 d 8 -6 d f 0.4 0.8 0 c 922 1963 m
- -5 4 d -4 X -11 -3 d f 0.6 0.8 0 c 917 1967 m -1 1 d -3 -1 d f 0 0.8 0 c 889
- 1940 m 24 6 d -13 10 d -19 -10 d f 0.2 0.8 0 c 900 1956 m -8 6 d -23 -6 d 12
- -10 d f 0 0.8 0.4 c 866 1934 m 1 X -2 X f 0 0.8 0.2 c 867 1934 m 15 4 d -24 2 d
- 7 -6 d f 0 0.8 0 c 882 1938 m 7 2 d -8 6 d -30 X 7 -6 d f 0.2 0.8 0 c 881 1946
- m -12 10 d -24 -6 d 6 -4 d f 0 0.8 0.4 c 865 1934 m 1 X -1 X f 0 0.8 0.2 c 853
- 1931 m 12 3 d -7 6 d f 0 0.8 0 c 842 1928 m 11 3 d 5 9 d -7 6 d -13 -15 d f 0.2
- 0.8 0 c 851 1946 m -6 4 d -23 -6 d 16 -13 d f 0 0.8 0.2 c 805 1939 m -7 -1 d 12
- -10 d f 0 0.8 0 c 819 1922 m 23 6 d -4 3 d -22 11 d -11 -3 d 5 -11 d f 0.2 0.8
- 0 c 838 1931 m -16 13 d -6 -2 d f 0 0.8 0.2 c 795 1916 m 12 3 d 3 9 d -12 10 d
- -3 -1 d -2 -19 d f 0 0.8 0 c 807 1919 m 12 3 d -9 6 d -15 9 d -5 -1 d -1 -15 d
- 4 -3 d f 0.2 0.8 0 c 790 1936 m -4 -2 d -1 -10 d 4 -3 d f 0.4 0.8 0 c 786 1934
- m -5 -1 d -1 -6 d 5 -3 d f 0.6 0.8 0 c 781 1933 m -5 -1 d -1 Y 4 -4 d f 0.8 0.8
- 0 c 776 1932 m -1 X 1 -1 d f 0 0.8 0.4 c 772 1910 m 3 1 d -4 -1 d f 0 0.8 0.2 c
- 775 1911 m 20 5 d -2 2 d -27 -4 d 5 -4 d f 0 0.8 0 c 793 1918 m -4 3 d -28 -3 d
- 5 -4 d f 0.2 0.8 0 c 789 1921 m -4 3 d -29 -2 d 5 -4 d f 0.4 0.8 0 c 785 1924 m
- -5 3 d -29 -1 d 5 -4 d f 0.6 0.8 0 c 780 1927 m -4 4 d -7 -1 d -18 -4 d f 0.8
- 0.8 0 c 776 1931 m -1 1 d -6 -2 d f 0 0.8 0.4 c 771 1910 m 1 X -1 X f 0 0.8 0.2
- c 760 1907 m 11 3 d -5 4 d f 0 0.8 0 c 749 1904 m 11 3 d 6 7 d -5 4 d f 0.2 0.8
- 0 c 748 1904 m 1 X 12 14 d -5 4 d -21 X -7 -2 d f 0.4 0.8 0 c 756 1922 m -5 4 d
- -16 -4 d f 0.6 0.8 0 c 751 1926 m f 0 0.8 0.2 c 725 1898 m 4 1 d -8 2 d f 0 0.8
- 0 c 729 1899 m 18 5 d -38 11 d -5 -1 d 17 -13 d f 0.2 0.8 0 c 747 1904 m 1 X
- -20 16 d -19 -5 d f 0 0 0.8 c 701 1892 m 3 1 d -21 15 d -2 X f 0 0.2 0.8 c 704
- 1893 m 3 1 d -21 15 d -3 -1 d f 0 0.4 0.8 c 707 1894 m 3 X -21 16 d -3 -1 d f 0
- 0.6 0.8 c 710 1894 m 3 1 d -22 15 d -2 X f 0 0.8 0.8 c 713 1895 m 3 1 d -22 15
- d -3 -1 d f 0 0.8 0.6 c 716 1896 m 3 1 d -22 15 d -3 -1 d f 0 0.8 0.4 c 719
- 1897 m 3 1 d -23 14 d -2 X f 0 0.8 0.2 c 722 1898 m 3 X -4 3 d -19 12 d -3 -1 d
- f 0 0.8 0 c 721 1901 m -17 13 d -2 -1 d f 0 0 0.8 c 678 1886 m 23 6 d -20 16 d
- -24 -6 d f 654 1880 m 24 6 d -21 16 d -23 -6 d f 631 1874 m 23 6 d -20 16 d -24
- -6 d f 1732 2134 m 23 6 d -20 15 d -24 -6 d f 1708 2128 m 24 6 d -21 15 d -23
- -6 d f 1685 2122 m 23 6 d -20 15 d -24 -6 d f 1681 2121 m 4 1 d -21 15 d -2 X f
- 0 0.2 0.8 c 1677 2120 m 4 1 d -19 16 d -2 -1 d f 0 0.4 0.8 c 1674 2119 m 3 1 d
- -17 16 d -3 X f 0 0.6 0.8 c 1670 2118 m 4 1 d -17 17 d -2 -1 d f 0 0.8 0.8 c
- 1666 2117 m 4 1 d -15 17 d -2 -1 d f 0 0.8 0.6 c 1663 2116 m 3 1 d -13 17 d -3
- X f 0 0.8 0.4 c 1661 2116 m 2 X -13 18 d -2 -1 d 10 -15 d f 0 0.8 0.2 c 1648
- 2133 m -2 X 7 -11 d 5 -4 d f 0 0.8 0 c 1646 2133 m -3 -1 d 4 -6 d 6 -4 d f 0.2
- 0.8 0 c 1643 2132 m -2 -1 d 1 X 5 -5 d f 0.4 0.8 0 c 1641 2131 m 1 X f 0 0.8
- 0.8 c 1638 2110 m -1 X f 0 0.8 0.6 c 1638 2110 m 16 4 d -22 X 5 -4 d f 0 0.8
- 0.4 c 1654 2114 m 7 2 d -3 2 d -31 X 5 -4 d f 0 0.8 0.2 c 1658 2118 m -5 4 d
- -31 X 5 -4 d f 0 0.8 0 c 1653 2122 m -6 4 d -27 X -3 -1 d 5 -3 d f 0.2 0.8 0 c
- 1647 2126 m -5 5 d -4 X -18 -5 d f 0.4 0.8 0 c 1642 2131 m -4 X f 0 0.8 0.8 c
- 1614 2104 m 24 6 d -1 X -23 -6 d f 0 0.8 0.6 c 1637 2110 m -5 4 d -29 -2 d 11
- -8 d f 0 0.8 0.4 c 1632 2114 m -5 4 d -32 2 d -1 -1 d 9 -7 d f 0 0.8 0.2 c 1627
- 2118 m -5 4 d -15 1 d -12 -3 d f 0 0.8 0 c 1622 2122 m -5 3 d -10 -2 d f 0 0.8
- 0.8 c 1614 2104 m f 0 0.8 0.6 c 1592 2098 m 22 6 d -11 8 d f 0 0.8 0.4 c 1591
- 2098 m 1 X 11 14 d -9 7 d -1 X -10 -15 d f 0 0.8 0.2 c 1593 2119 m -16 -4 d -3
- -4 d 9 -7 d f 0 0.8 0 c 1577 2115 m -7 -2 d 4 -2 d f 0 0.8 0.6 c 1567 2092 m 18
- 4 d -19 -4 d f 0 0.8 0.4 c 1585 2096 m 6 2 d -8 6 d -21 -8 d 4 -4 d f 0 0.8 0.2
- c 1583 2104 m -9 7 d -16 -12 d 4 -3 d f 0 0.8 0 c 1574 2111 m -4 2 d -5 -1 d
- -11 -10 d 4 -3 d f 0.2 0.8 0 c 1565 2112 m -10 -3 d -5 -4 d 4 -3 d f 0.4 0.8 0
- c 1555 2109 m -8 -2 d 3 -2 d f 0 0.8 0.6 c 1544 2086 m 23 6 d -1 X -26 -3 d f 0
- 0.8 0.4 c 1566 2092 m -4 4 d -28 -3 d 6 -4 d f 0 0.8 0.2 c 1562 2096 m -4 3 d
- -30 -1 d 6 -5 d f 0 0.8 0 c 1558 2099 m -4 3 d -29 X -2 -1 d 5 -3 d f 0.2 0.8 0
- c 1554 2102 m -4 3 d -13 X -12 -3 d f 0.4 0.8 0 c 1550 2105 m -3 2 d -10 -2 d f
- 0 0.8 0.6 c 1522 2080 m 22 6 d -4 3 d -39 7 d -1 -1 d 15 -11 d f 0 0.8 0.4 c
- 1520 2080 m 2 X 18 9 d -6 4 d -25 5 d -8 -2 d 14 -12 d f 0 0.8 0.2 c 1534 2093
- m -6 5 d -11 2 d -8 -2 d f 0 0.8 0 c 1528 2098 m -5 3 d -6 -1 d f 0 0.8 0.6 c
- 1497 2074 m 21 5 d -3 5 d -15 11 d -2 X -5 -18 d f 0 0.8 0.4 c 1518 2079 m 2 1
- d -5 4 d -17 11 d -8 -2 d -3 -11 d 6 -5 d f 0 0.8 0.2 c 1490 2093 m -8 -2 d -2
- -5 d 7 -4 d f 0 0.8 0 c 1482 2091 m -6 -1 d 4 -4 d f 0 0.8 0.6 c 1475 2068 m 22
- 6 d -4 3 d f 0 0.8 0.4 c 1473 2068 m 2 X 18 9 d -6 5 d -19 -10 d f 0 0.8 0.2 c
- 1487 2082 m -7 4 d -18 -10 d 6 -4 d f 0 0.8 0 c 1480 2086 m -4 4 d -7 -2 d -12
- -8 d 5 -4 d f 0.2 0.8 0 c 1469 2088 m -16 -4 d 4 -4 d f 0 0.8 0.8 c 1450 2062 m
- 9 2 d -14 1 d f 0 0.8 0.6 c 1459 2064 m 13 4 d -33 2 d 6 -5 d f 0 0.8 0.4 c
- 1472 2068 m 1 X -5 4 d -35 3 d 6 -5 d f 0 0.8 0.2 c 1468 2072 m -6 4 d -28 3 d
- -5 -1 d 4 -3 d f 0 0.8 0 c 1462 2076 m -5 4 d -12 2 d -11 -3 d f 0.2 0.8 0 c
- 1457 2080 m -4 4 d -8 -2 d f 0 0.8 0.8 c 1435 2058 m 15 4 d -5 3 d f 0 0.8 0.6
- c 1426 2056 m 9 2 d 10 7 d -6 5 d -21 -8 d f 0 0.8 0.4 c 1439 2070 m -6 5 d -24
- -3 d -3 X 12 -10 d f 0 0.8 0.2 c 1433 2075 m -4 3 d -20 -6 d f 0 0.8 0.8 c 1403
- 2050 m 1 X -2 X f 0 0.8 0.6 c 1404 2050 m 22 6 d -8 6 d -24 -5 d 8 -7 d f 0 0.8
- 0.4 c 1418 2062 m -12 10 d -5 -2 d -16 -7 d 9 -6 d f 0 0.8 0.2 c 1401 2070 m
- -19 -4 d 3 -3 d f 0 0.8 0.8 c 1402 2050 m 1 X -1 X f 0 0.8 0.6 c 1379 2044 m 23
- 6 d -8 7 d -16 -12 d f 0 0.8 0.4 c 1394 2057 m -9 6 d -14 -13 d 7 -5 d f 0 0.8
- 0.2 c 1385 2063 m -3 3 d -11 -3 d -7 -7 d 7 -6 d f 0 0.8 0 c 1371 2063 m -12 -3
- d 5 -4 d f 0 0.8 0.6 c 1370 2042 m 9 2 d -1 1 d f 0 0.8 0.4 c 1356 2038 m 14 4
- d 8 3 d -7 5 d -29 -1 d f 0 0.8 0.2 c 1371 2050 m -7 6 d -17 1 d -12 -3 d 7 -5
- d f 0 0.8 0 c 1364 2056 m -5 4 d -12 -3 d f 0 0.8 0.6 c 1314 2048 m -2 X 5 -4 d
- f 0 0.8 0.4 c 1332 2032 m 24 6 d -14 11 d -12 3 d -16 -4 d 3 -4 d f 0 0.8 0.2 c
- 1342 2049 m -7 5 d -5 -2 d f 0 0.8 0.6 c 1317 2044 m -5 4 d -1 -1 d f 0 0.8 0.4
- c 1309 2026 m 23 6 d -15 12 d -6 3 d -8 -2 d -14 Y f 0 0.8 0.2 c 1303 2045 m -8
- -2 d -7 Y 8 -5 d f 0 0.8 0 c 1295 2043 m -7 -1 d 7 -6 d f 0 0.8 0.6 c 1285 2020
- m 16 4 d -20 X f 0 0.8 0.4 c 1301 2024 m 8 2 d -6 5 d -30 -1 d 8 -6 d f 0 0.8
- 0.2 c 1303 2031 m -8 5 d -30 X 8 -6 d f 0 0.8 0 c 1295 2036 m -7 6 d -23 -6 d f
- 0 0.8 0.8 c 1262 2014 m 1 1 d -1 -1 d f 0 0.8 0.6 c 1263 2015 m 22 5 d -4 4 d
- -26 -5 d 7 -5 d f 0 0.8 0.4 c 1281 2024 m -8 6 d -25 -5 d 7 -6 d f 0 0.8 0.2 c
- 1273 2030 m -8 6 d -24 -6 d 7 -5 d f 0 0.8 0.8 c 1238 2008 m 24 6 d -28 -3 d f
- 0 0.8 0.6 c 1262 2014 m -7 5 d -27 -3 d 6 -5 d f 0 0.8 0.4 c 1255 2019 m -7 6 d
- -26 -4 d 6 -5 d f 0 0.8 0.2 c 1248 2025 m -7 5 d -23 -6 d 4 -3 d f 0 0.8 0.8 c
- 1230 2006 m 8 2 d -4 3 d f 0 0.8 0.6 c 1218 2003 m 12 3 d 4 5 d -6 5 d f 0 0.8
- 0.4 c 1215 2002 m 3 1 d 10 13 d -6 5 d -16 -12 d f 0 0.8 0.2 c 1222 2021 m -4 3
- d -24 -6 d 12 -9 d f 0 0.8 0.4 c 1195 1997 m 20 5 d -9 7 d -33 3 d -2 X 8 -6 d
- f 0 0.8 0.2 c 1191 1996 m 4 1 d 11 12 d -12 9 d -21 -6 d 6 -6 d f 0 0.8 0.4 c
- 1168 1990 m 18 5 d -7 11 d -8 6 d -2 -1 d -8 -15 d f 0 0.8 0.2 c 1186 1995 m 5
- 1 d -12 10 d -10 5 d -22 -5 d 14 -10 d f 0 0.8 0.6 c 1144 1984 m 11 3 d -29 13
- d -2 X f 0 0.8 0.4 c 1155 1987 m 13 3 d -7 6 d -24 7 d -11 -3 d f 0 0.8 0.2 c
- 1161 1996 m -14 10 d -10 -3 d f 0 0.8 0.6 c 1121 1978 m 23 6 d -20 16 d -3 -1 d
- -2 -19 d f 0 0.8 0.4 c 1121 1999 m -15 -4 d -1 -5 d 14 -10 d f 0 0.8 0.2 c 1106
- 1995 m -6 -1 d 5 -4 d f 0 0.8 0.6 c 1112 1976 m 9 2 d -2 2 d f 0 0.8 0.4 c 1097
- 1972 m 15 4 d 7 4 d -14 10 d -21 -7 d f 0 0.8 0.2 c 1105 1990 m -5 4 d -23 -6 d
- 7 -5 d f 0 0.8 0.4 c 1074 1966 m 23 6 d -13 11 d -20 -9 d f 0 0.8 0.2 c 1084
- 1983 m -7 5 d -23 -6 d 10 -8 d f 0 0.8 0.6 c 1050 1960 m 18 5 d -18 -4 d f 0
- 0.8 0.4 c 1068 1965 m 6 1 d -10 8 d -19 -9 d 5 -4 d f 0 0.8 0.2 c 1064 1974 m
- -10 8 d -14 -14 d 5 -3 d f 0 0.8 0 c 1054 1982 m -11 -3 d -8 -7 d 5 -4 d f 0.2
- 0.8 0 c 1043 1979 m -11 -3 d -1 -1 d 4 -3 d f 0.4 0.8 0 c 1032 1976 m -2 X 1 -1
- d f 0 0.8 0.6 c 1042 1958 m 8 2 d 1 Y f 0 0.8 0.4 c 1027 1954 m 15 4 d 8 3 d -5
- 4 d -27 -4 d f 0 0.8 0.2 c 1045 1965 m -5 3 d -33 2 d 11 -9 d f 0 0.8 0 c 1040
- 1968 m -5 4 d -18 1 d -10 -3 d f 0.2 0.8 0 c 1035 1972 m -4 3 d -3 X -11 -2 d f
- 0.4 0.8 0 c 1031 1975 m -1 1 d -2 -1 d f 0 0.8 0.4 c 1007 1949 m 20 5 d -9 7 d
- f 0 0.8 0.2 c 1003 1948 m 4 1 d 11 12 d -11 9 d -15 -13 d f 0 0.8 0 c 1007 1970
- m -24 -6 d 9 -7 d f 0 0.8 0.4 c 980 1942 m 19 5 d -32 13 d -7 -2 d f 0 0.8 0.2
- c 999 1947 m 4 1 d -11 9 d -15 5 d -10 -2 d f 0 0.8 0 c 992 1957 m -9 7 d -6 -2
- d f 0 0.8 0.4 c 969 1940 m 11 2 d -20 16 d -16 -4 d f 0 0.8 0.2 c 956 1936 m 13
- 4 d -25 14 d -8 -2 d f 0 0.8 0.4 c 933 1930 m 13 4 d -19 1 d f 0 0.8 0.2 c 946
- 1934 m 10 2 d -20 16 d -10 -3 d -7 -8 d 8 -6 d f 0 0.8 0 c 926 1949 m -13 -3 d
- 6 -5 d f 0 0.8 0.8 c 909 1924 m 7 2 d -9 X f 0 0.8 0.6 c 916 1926 m 13 4 d -27
- X 5 -4 d f 0 0.8 0.4 c 929 1930 m 4 X -6 5 d -30 -1 d 5 -4 d f 0 0.8 0.2 c 927
- 1935 m -8 6 d -28 -3 d 6 -4 d f 0 0.8 0 c 919 1941 m -6 5 d -24 -6 d 2 -2 d f 0
- 0.8 0.8 c 907 1924 m 2 X -2 2 d f 0 0.8 0.6 c 900 1922 m 7 2 d 2 Y -5 4 d f 0
- 0.8 0.4 c 894 1920 m 6 2 d 2 8 d -5 4 d -31 X 1 -1 d f 0 0.8 0.2 c 887 1919 m 7
- 1 d 3 14 d -6 4 d -9 X -15 -4 d -1 Y 16 -12 d f 0 0.8 0 c 886 1918 m 1 1 d 4 19
- d -2 2 d -7 -2 d 1 -17 d f 0 0.8 0.4 c 867 1933 m -1 1 d -1 X f 0 0.8 0.2 c 862
- 1913 m 21 8 d -16 12 d -2 1 d -12 -3 d f 0 0.8 0 c 862 1913 m 24 5 d -3 3 d -30
- 10 d -11 -3 d f 0 0.8 0.2 c 839 1907 m 23 6 d -30 -1 d f 0 0.8 0 c 862 1913 m
- -20 15 d -23 -6 d 13 -10 d f 0 0.8 0.4 c 815 1901 m 12 2 d -23 6 d f 0 0.8 0.2
- c 827 1903 m 12 4 d -7 5 d -25 7 d -12 -3 d 9 -7 d f 0 0.8 0 c 832 1912 m -13
- 10 d -12 -3 d f 0 0.8 0.8 c 792 1895 m 4 1 d -6 X f 0 0.8 0.6 c 796 1896 m 15 3
- d -31 5 d 10 -8 d f 0 0.8 0.4 c 811 1899 m 4 2 d -11 8 d -29 2 d -3 -1 d 8 -6 d
- f 0 0.8 0.2 c 804 1909 m -9 7 d -20 -5 d f 0 0.8 0.8 c 789 1894 m 3 1 d -2 1 d
- f 0 0.8 0.6 c 775 1890 m 14 4 d 1 2 d -10 8 d f 0 0.8 0.4 c 769 1889 m 6 1 d 5
- 14 d -8 6 d -1 X -7 -18 d f 0 0.8 0.2 c 771 1910 m -11 -3 d -3 -9 d 7 -6 d f 0
- 0.8 0 c 760 1907 m -11 -3 d 8 -6 d f 0.2 0.8 0 c 749 1904 m -1 X 1 X f 0 0.6
- 0.8 c 745 1883 m 3 X -5 1 d f 0 0.8 0.8 c 748 1883 m 8 2 d -18 3 d 5 -4 d f 0
- 0.8 0.6 c 756 1885 m 8 3 d -30 3 d 4 -3 d f 0 0.8 0.4 c 764 1888 m 5 1 d -5 3 d
- -35 3 d 5 -4 d f 0 0.8 0.2 c 764 1892 m -7 6 d -28 1 d -4 -1 d 4 -3 d f 0 0.8 0
- c 757 1898 m -8 6 d -2 X -18 -5 d f 0.2 0.8 0 c 749 1904 m -2 X f 0 0 0.8 c 722
- 1877 m 6 1 d -24 15 d -3 -1 d f 0 0.2 0.8 c 728 1878 m 6 2 d -27 14 d -3 -1 d f
- 0 0.4 0.8 c 734 1880 m 7 2 d -31 12 d -3 X f 0 0.6 0.8 c 741 1882 m 4 1 d -2 1
- d -30 11 d -3 -1 d f 0 0.8 0.8 c 743 1884 m -5 4 d -22 8 d -3 -1 d f 0 0.8 0.6
- c 738 1888 m -4 3 d -15 6 d -3 -1 d f 0 0.8 0.4 c 734 1891 m -5 4 d -7 3 d -3
- -1 d f 0 0.8 0.2 c 729 1895 m -4 3 d -3 X f 0 0 0.8 c 698 1871 m 24 6 d -21 15
- d -23 -6 d f 675 1865 m 23 6 d -20 15 d -24 -6 d f 651 1859 m 24 6 d -21 15 d
- -23 -6 d f 1752 2118 m 23 6 d -20 16 d -23 -6 d f 1728 2112 m 24 6 d -20 16 d
- -24 -6 d f 1705 2106 m 23 6 d -20 16 d -23 -6 d f 1700 2105 m 5 1 d -20 16 d -4
- -1 d f 0 0.2 0.8 c 1695 2104 m 5 1 d -19 16 d -4 -1 d f 0 0.4 0.8 c 1690 2102 m
- 5 2 d -18 16 d -3 -1 d f 0 0.6 0.8 c 1685 2101 m 5 1 d -16 17 d -4 -1 d f 0 0.8
- 0.8 c 1681 2100 m 4 1 d -15 17 d -4 -1 d 13 -15 d f 0 0.8 0.6 c 1666 2117 m -3
- -1 d 4 -5 d 12 -9 d f 0 0.8 0.4 c 1663 2116 m -2 X 6 -5 d f 0 0.8 0.8 c 1675
- 2099 m 6 1 d -2 2 d -41 8 d -1 Y f 0 0.8 0.6 c 1658 2094 m 17 5 d 4 3 d -12 9 d
- -13 3 d -16 -4 d -1 Y f 0 0.8 0.4 c 1667 2111 m -6 5 d -7 -2 d f 0 0.8 0.8 c
- 1638 2109 m 1 Y -24 -6 d 3 -2 d f 0 0.8 0.6 c 1634 2088 m 24 6 d -20 15 d -21
- -7 d f 0 0.4 0.8 c 1611 2082 m 2 1 d -3 X f 0 0.6 0.8 c 1613 2083 m 10 2 d -19
- 3 d 6 -5 d f 0 0.8 0.8 c 1623 2085 m 10 3 d -16 14 d -3 2 d -17 -11 d 7 -5 d f
- 0 0.8 0.6 c 1633 2088 m 1 X -17 14 d -3 2 d -22 -6 d -1 X 6 -5 d f 0 0.8 0.4 c
- 1592 2098 m -1 X f 0 0.4 0.8 c 1609 2082 m 2 X -1 1 d f 0 0.6 0.8 c 1597 2079 m
- 12 3 d 1 1 d -6 5 d f 0 0.8 0.8 c 1587 2076 m 10 3 d 7 9 d -7 5 d -14 -13 d f 0
- 0.8 0.6 c 1597 2093 m -6 5 d -6 -2 d -18 -4 d 16 -12 d f 0 0.8 0.4 c 1591 2098
- m -6 -2 d f 0 0.6 0.8 c 1564 2070 m 3 1 d -4 1 d f 0 0.8 0.8 c 1567 2071 m 20 5
- d -4 4 d -34 2 d 14 -10 d f 0 0.8 0.6 c 1583 2080 m -16 12 d -23 -6 d 5 -4 d f
- 0 0.6 0.8 c 1540 2064 m 24 6 d -1 2 d -28 -3 d f 0 0.8 0.8 c 1563 2072 m -14 10
- d -21 -8 d 7 -5 d f 0 0.8 0.6 c 1549 2082 m -5 4 d -22 -6 d -1 X 7 -6 d f 0 0.8
- 0.4 c 1522 2080 m -2 X 1 X f 0 0.6 0.8 c 1517 2058 m 23 6 d -5 5 d -25 -5 d f 0
- 0.8 0.8 c 1535 2069 m -7 5 d -28 -3 d 10 -7 d f 0 0.8 0.6 c 1528 2074 m -7 6 d
- -3 -1 d -21 -5 d 3 -3 d f 0 0.8 0.4 c 1521 2080 m -1 X -2 -1 d f 0 0.6 0.8 c
- 1509 2056 m 8 2 d -7 6 d f 0 0.8 0.8 c 1498 2054 m 11 2 d 1 8 d -10 7 d f 0 0.8
- 0.6 c 1494 2052 m 4 2 d 2 17 d -3 3 d -22 -6 d -1 Y f 0 0.8 0.4 c 1475 2068 m
- -2 X 2 -1 d f 0 0.8 0.8 c 1470 2046 m 1 1 d -12 17 d -9 -2 d f 0 0.8 0.6 c 1471
- 2047 m 23 5 d -19 15 d -3 1 d -13 -4 d f 0 0.8 0.4 c 1475 2067 m -2 1 d -1 X f
- 0 0.8 0.8 c 1469 2046 m 1 X -20 16 d -15 -4 d f 0 0.8 0.6 c 1447 2040 m 22 6 d
- -34 12 d -9 -2 d f 0 0.8 0.8 c 1423 2035 m 14 3 d -33 12 d -1 X f 0 0.8 0.6 c
- 1437 2038 m 10 2 d -21 16 d -22 -6 d f 0 0.8 0.8 c 1409 2031 m 14 4 d -20 15 d
- -1 X f 0 0.8 0.6 c 1400 2029 m 9 2 d -7 19 d -23 -6 d f 0 0.8 0.8 c 1376 2023 m
- 7 1 d -10 1 d f 0 0.8 0.6 c 1383 2024 m 17 5 d -21 15 d -9 -2 d -11 -7 d 14 -10
- d f 0 0.8 0.4 c 1370 2042 m -14 -4 d 3 -3 d f 0 0.6 0.8 c 1353 2017 m 3 X -4 X
- f 0 0.8 0.8 c 1356 2017 m 20 6 d -3 2 d -29 -2 d 8 -6 d f 0 0.8 0.6 c 1373 2025
- m -14 10 d -23 -6 d 8 -6 d f 0 0.8 0.4 c 1359 2035 m -3 3 d -24 -6 d 4 -3 d f 0
- 0.6 0.8 c 1351 2016 m 2 1 d -1 X f 0 0.8 0.8 c 1338 2013 m 13 3 d 1 1 d -8 6 d
- f 0 0.8 0.6 c 1329 2011 m 9 2 d 6 10 d -8 6 d -19 -9 d f 0 0.8 0.4 c 1336 2029
- m -4 3 d -23 -6 d 8 -6 d f 0 0.6 0.8 c 1306 2005 m 1 X -3 1 d f 0 0.8 0.8 c
- 1307 2005 m 14 3 d -30 8 d 13 -10 d f 0 0.8 0.6 c 1321 2008 m 8 3 d -12 9 d -16
- 4 d -16 -4 d 6 -4 d f 0 0.8 0.4 c 1317 2020 m -8 6 d -8 -2 d f 0 0.6 0.8 c 1303
- 2004 m 3 1 d -2 1 d f 0 0.8 0.8 c 1282 1999 m 21 5 d 1 2 d -13 10 d -28 -1 d -1
- -1 d f 0 0.8 0.6 c 1291 2016 m -6 4 d -22 -5 d f 0 0.8 0.8 c 1259 1993 m 23 6 d
- -20 15 d -24 -6 d f 1235 1987 m 24 6 d -21 15 d -8 -2 d -3 -13 d f 0 0.8 0.6 c
- 1230 2006 m -12 -3 d -1 -3 d 10 -7 d f 0 0.8 0.4 c 1218 2003 m -3 -1 d 2 -2 d f
- 0 0.8 0.8 c 1228 1985 m 7 2 d -8 6 d f 0 0.8 0.6 c 1220 1983 m 8 2 d -1 8 d -10
- 7 d f 0 0.8 0.4 c 1213 1981 m 7 2 d -3 17 d -2 2 d -20 -5 d f 0 0.8 0.2 c 1212
- 1981 m 1 X -18 16 d -4 -1 d f 0 0.8 0.8 c 1188 1975 m f 0 0.8 0.6 c 1188 1975 m
- 11 3 d -25 7 d 14 -10 d f 0 0.8 0.4 c 1199 1978 m 11 2 d -24 15 d -18 -5 d 6 -5
- d f 0 0.8 0.2 c 1210 1980 m 2 1 d -21 15 d -5 -1 d f 0 0.8 0.8 c 1165 1969 m 23
- 6 d -34 2 d f 0 0.8 0.6 c 1188 1975 m -14 10 d -19 2 d -11 -3 d 10 -7 d f 0 0.8
- 0.4 c 1174 1985 m -6 5 d -13 -3 d f 0 0.6 0.8 c 1141 1963 m 6 1 d -7 X f 0 0.8
- 0.8 c 1147 1964 m 18 5 d -11 8 d -24 -5 d 10 -8 d f 0 0.8 0.6 c 1154 1977 m -10
- 7 d -23 -6 d 9 -6 d f 0 0.6 0.8 c 1135 1961 m 6 2 d -1 1 d f 0 0.8 0.8 c 1118
- 1957 m 17 4 d 5 3 d -10 8 d -19 -10 d f 0 0.8 0.6 c 1130 1972 m -9 6 d -9 -2 d
- -12 -6 d 11 -8 d f 0 0.8 0.4 c 1112 1976 m -15 -4 d 3 -2 d f 0 0.6 0.8 c 1094
- 1951 m 18 4 d -24 1 d f 0 0.8 0.8 c 1112 1955 m 6 2 d -7 5 d -30 -1 d 7 -5 d f
- 0 0.8 0.6 c 1111 1962 m -11 8 d -26 -4 d 7 -5 d f 0 0.8 0.4 c 1100 1970 m -3 2
- d -23 -6 d f 0 0.6 0.8 c 1085 1948 m 9 3 d -6 5 d f 0 0.8 0.8 c 1075 1946 m 10
- 2 d 3 8 d -7 5 d f 0 0.8 0.6 c 1071 1945 m 4 1 d 6 15 d -7 5 d -6 -1 d -18 -5 d
- f 0 0.8 0.4 c 1074 1966 m -6 -1 d f 0 0.8 0.6 c 1060 1942 m 11 3 d -21 15 d -8
- -2 d f 0 0.8 0.4 c 1047 1939 m 13 3 d -18 16 d -15 -4 d f 0 0.8 0.8 c 1024 1933
- m 3 1 d -5 X f 0 0.8 0.6 c 1027 1934 m 12 3 d -26 4 d 9 -7 d f 0 0.8 0.4 c 1039
- 1937 m 8 2 d -20 15 d -20 -5 d -2 -1 d 8 -7 d f 0 0.8 0.2 c 1007 1949 m -4 -1 d
- 2 X f 0 0.8 0.8 c 1000 1927 m 24 6 d -2 1 d -28 -2 d f 0 0.8 0.6 c 1022 1934 m
- -9 7 d -29 -2 d 10 -7 d f 0 0.8 0.4 c 1013 1941 m -8 7 d -6 -1 d -19 -5 d 4 -3
- d f 0 0.8 0.2 c 1005 1948 m -2 X -4 -1 d f 0 0.8 0.8 c 977 1921 m 23 6 d -6 5 d
- -19 -10 d f 0 0.8 0.6 c 994 1932 m -10 7 d -16 -11 d 7 -6 d f 0 0.8 0.4 c 984
- 1939 m -4 3 d -11 -2 d -8 -7 d 7 -5 d f 0 0.8 0.2 c 969 1940 m -13 -4 d 5 -3 d
- f 0 0.6 0.8 c 953 1915 m 7 2 d -9 X f 0 0.8 0.8 c 960 1917 m 17 4 d -2 1 d -32
- 1 d 8 -6 d f 0 0.8 0.6 c 975 1922 m -7 6 d -33 1 d 8 -6 d f 0 0.8 0.4 c 968
- 1928 m -7 5 d -15 1 d -13 -4 d 2 -1 d f 0 0.8 0.2 c 961 1933 m -5 3 d -10 -2 d
- f 0 0.6 0.8 c 942 1912 m 11 3 d -2 2 d f 0 0.8 0.8 c 930 1909 m 12 3 d 9 5 d -8
- 6 d -27 3 d -7 -2 d f 0 0.8 0.6 c 943 1923 m -8 6 d -6 1 d -13 -4 d f 0 0.8 0.4
- c 935 1929 m -2 1 d -4 X f 0 0.8 0.8 c 915 1905 m 15 4 d -21 15 d -2 X f 0 0.8
- 0.6 c 906 1903 m 9 2 d -8 19 d -7 -2 d 2 -16 d f 0 0.8 0.4 c 900 1922 m -6 -2 d
- 1 -8 d 7 -6 d f 0 0.8 0.2 c 894 1920 m -7 -1 d 1 -2 d 7 -5 d f 0 0.8 0 c 887
- 1919 m -1 -1 d 2 -1 d f 0 0.8 0.8 c 883 1897 m 14 4 d -18 -1 d f 0 0.8 0.6 c
- 897 1901 m 9 2 d -4 3 d -28 -2 d 5 -4 d f 0 0.8 0.4 c 902 1906 m -7 6 d -27 -4
- d 6 -4 d f 0 0.8 0.2 c 895 1912 m -7 5 d -26 -4 d 6 -5 d f 0 0.8 0 c 888 1917 m
- -2 1 d -24 -5 d f 0 0.8 0.8 c 859 1891 m 24 6 d -4 3 d -21 -8 d f 0 0.8 0.6 c
- 879 1900 m -5 4 d -23 -7 d 7 -5 d f 0 0.8 0.4 c 874 1904 m -6 4 d -24 -5 d 7 -6
- d f 0 0.8 0.2 c 868 1908 m -6 5 d -23 -6 d 5 -4 d f 0 0.4 0.8 c 836 1885 m 2 1
- d -3 X f 0 0.6 0.8 c 838 1886 m 12 3 d -21 1 d 6 -4 d f 0 0.8 0.8 c 850 1889 m
- 9 2 d -1 1 d -35 3 d 6 -5 d f 0 0.8 0.6 c 858 1892 m -7 5 d -34 2 d 6 -4 d f 0
- 0.8 0.4 c 851 1897 m -7 6 d -17 X -12 -2 d 2 -2 d f 0 0.8 0.2 c 844 1903 m -5 4
- d -12 -4 d f 0 0.4 0.8 c 831 1884 m 5 1 d -1 1 d f 0 0.6 0.8 c 812 1879 m 19 5
- d 4 2 d -6 4 d -23 -6 d f 0 0.8 0.8 c 829 1890 m -6 5 d -27 1 d -4 -1 d 14 -11
- d f 0 0.8 0.6 c 823 1895 m -6 4 d -6 X -15 -3 d f 0 0.8 0.4 c 817 1899 m -2 2 d
- -4 -2 d f 0 0.6 0.8 c 806 1878 m 6 1 d -6 5 d f 0 0.8 0.8 c 789 1873 m 17 5 d 6
- Y -14 11 d -3 -1 d -1 -21 d f 0 0.8 0.6 c 789 1894 m -14 -4 d -6 Y 13 -11 d f 0
- 0.8 0.4 c 775 1890 m -6 -1 d 6 -5 d f 0 0.6 0.8 c 748 1883 m -3 X 3 -3 d f 0
- 0.8 0.8 c 788 1873 m 1 X -1 X -32 12 d -8 -2 d -3 Y 9 -7 d f 0 0.8 0.6 c 765
- 1867 m 23 6 d -13 11 d -11 4 d -8 -3 d 1 -12 d f 0 0.8 0.4 c 775 1884 m -6 5 d
- -5 -1 d f 0 0 0.8 c 742 1861 m 4 1 d -18 16 d -6 -1 d f 0 0.2 0.8 c 746 1862 m
- 4 1 d -16 17 d -6 -2 d f 0 0.4 0.8 c 750 1863 m 4 1 d -13 18 d -7 -2 d f 0 0.6
- 0.8 c 754 1864 m 4 1 d -10 15 d -3 3 d -4 -1 d f 0 0.8 0.8 c 758 1865 m 4 1 d
- -5 7 d -9 7 d f 0 0.8 0.6 c 762 1866 m 3 1 d -8 6 d f 0 0 0.8 c 718 1855 m 24 6
- d -20 16 d -24 -6 d f 695 1849 m 23 6 d -20 16 d -23 -6 d f 671 1843 m 24 6 d
- -20 16 d -24 -6 d f 1772 2103 m 24 6 d -21 15 d -23 -6 d f 1749 2097 m 23 6 d
- -20 15 d -24 -6 d f 1725 2091 m 24 6 d -21 15 d -23 -6 d f 1718 2089 m 7 2 d
- -20 15 d -5 -1 d f 0 0.2 0.8 c 1711 2087 m 7 2 d -18 16 d -5 -1 d f 0 0.4 0.8 c
- 1704 2085 m 7 2 d -16 17 d -5 -2 d f 0 0.6 0.8 c 1702 2085 m 2 X -14 17 d -5 -1
- d 7 -8 d f 0 0.8 0.8 c 1685 2101 m -4 -1 d 11 -7 d f 0 0.6 0.8 c 1678 2079 m 24
- 6 d -10 8 d -21 -8 d f 0 0.8 0.8 c 1692 2093 m -11 7 d -6 -1 d -12 -8 d 8 -6 d
- f 0 0.8 0.6 c 1675 2099 m -17 -5 d 5 -3 d f 0 0.6 0.8 c 1655 2073 m 23 6 d -7 6
- d -21 -9 d f 0 0.8 0.8 c 1671 2085 m -8 6 d -26 -5 d 13 -10 d f 0 0.8 0.6 c
- 1663 2091 m -5 3 d -24 -6 d 3 -2 d f 0 0.4 0.8 c 1613 2083 m -2 -1 d 18 -13 d f
- 0 0.6 0.8 c 1631 2067 m 24 6 d -5 3 d -27 9 d -10 -2 d 16 -14 d f 0 0.8 0.8 c
- 1650 2076 m -13 10 d -4 2 d -10 -3 d f 0 0.8 0.6 c 1637 2086 m -3 2 d -1 X f 0
- 0.4 0.8 c 1629 2069 m -18 13 d -2 X f 0 0.6 0.8 c 1608 2061 m 23 6 d -2 2 d -20
- 13 d -12 -3 d 8 -16 d f 0 0.8 0.8 c 1597 2079 m -10 -3 d 18 -13 d f 0 0.6 0.8 c
- 1605 2060 m 3 1 d -3 2 d -38 8 d -3 -1 d 3 -2 d f 0 0.8 0.8 c 1584 2055 m 21 5
- d 3 Y -18 13 d -20 -5 d -3 Y f 0 0.6 0.8 c 1567 2068 m -3 2 d -24 -6 d 12 -9 d
- f 0 0.8 0.8 c 1561 2049 m 23 6 d -17 13 d -15 -13 d f 0 0.6 0.8 c 1537 2043 m 4
- 1 d 11 11 d -12 9 d -23 -6 d f 0 0.8 0.8 c 1541 2044 m 20 5 d -9 6 d f 0 0.4
- 0.8 c 1514 2037 m 4 1 d -6 X f 0 0.6 0.8 c 1518 2038 m 19 5 d -20 15 d -8 -2 d
- -4 -12 d 7 -6 d f 0 0.8 0.8 c 1509 2056 m -11 -2 d -1 -4 d 8 -6 d f 0 0.8 0.6 c
- 1498 2054 m -4 -2 d 3 -2 d f 0 0.4 0.8 c 1490 2031 m 24 6 d -2 1 d -25 -4 d f 0
- 0.6 0.8 c 1512 2038 m -7 6 d -27 -4 d 9 -6 d f 0 0.8 0.8 c 1505 2044 m -8 6 d
- -26 -3 d -1 -1 d 8 -6 d f 0 0.8 0.6 c 1497 2050 m -3 2 d -23 -5 d f 0 0.4 0.8 c
- 1479 2028 m 11 3 d -3 3 d f 0 0.6 0.8 c 1467 2025 m 12 3 d 8 6 d -9 6 d -16 -11
- d f 0 0.8 0.8 c 1478 2040 m -8 6 d -1 X -17 -10 d 10 -7 d f 0 0.8 0.6 c 1469
- 2046 m -22 -6 d 5 -4 d f 0 0.6 0.8 c 1443 2019 m 24 6 d -5 4 d -36 4 d f 0 0.8
- 0.8 c 1462 2029 m -10 7 d -15 2 d -14 -3 d 3 -2 d f 0 0.8 0.6 c 1452 2036 m -5
- 4 d -10 -2 d f 0 0.6 0.8 c 1420 2013 m 23 6 d -17 14 d -9 -17 d f 0 0.8 0.8 c
- 1426 2033 m -3 2 d -14 -4 d -3 -7 d 11 -8 d f 0 0.8 0.6 c 1409 2031 m -9 -2 d 6
- -5 d f 0 0.6 0.8 c 1396 2007 m 24 6 d -3 3 d -31 -1 d f 0 0.8 0.8 c 1417 2016 m
- -11 8 d -23 X -7 -1 d 10 -8 d f 0 0.8 0.6 c 1406 2024 m -6 5 d -17 -5 d f 0 0.6
- 0.8 c 1373 2001 m 23 6 d -10 8 d -30 2 d -3 X f 0 0.8 0.8 c 1386 2015 m -10 8 d
- -20 -6 d f 0 0.6 0.8 c 1349 1995 m 24 6 d -20 16 d -2 -1 d -5 -18 d f 0 0.8 0.8
- c 1351 2016 m -13 -3 d -2 -7 d 10 -8 d f 0 0.8 0.6 c 1338 2013 m -9 -2 d 7 -5 d
- f 0 0.6 0.8 c 1326 1989 m 23 6 d -3 3 d -39 7 d -1 X f 0 0.8 0.8 c 1346 1998 m
- -10 8 d -15 2 d -14 -3 d f 0 0.8 0.6 c 1336 2006 m -7 5 d -8 -3 d f 0 0.6 0.8 c
- 1310 1985 m 16 4 d -20 16 d -3 -1 d f 0 0.8 0.8 c 1302 1983 m 8 2 d -7 19 d -21
- -5 d f 0 0.6 0.8 c 1279 1977 m 16 4 d -34 10 d f 0 0.8 0.8 c 1295 1981 m 7 2 d
- -20 16 d -23 -6 d 2 -2 d f 0 0.6 0.8 c 1255 1971 m 24 6 d -18 14 d -22 -7 d f 0
- 0.8 0.8 c 1261 1991 m -2 2 d -24 -6 d 4 -3 d f 0 0.4 0.8 c 1232 1965 m 7 2 d -8
- -1 d f 0 0.6 0.8 c 1239 1967 m 16 4 d -16 13 d -13 -15 d 5 -3 d f 0 0.8 0.8 c
- 1239 1984 m -4 3 d -7 -2 d -6 -12 d 4 -4 d f 0 0.8 0.6 c 1228 1985 m -8 -2 d -3
- -6 d 5 -4 d f 0 0.8 0.4 c 1220 1983 m -7 -2 d -1 -1 d 5 -3 d f 0 0.8 0.2 c 1213
- 1981 m -1 X -1 Y f 0 0.4 0.8 c 1209 1959 m 23 6 d -1 1 d -26 -4 d f 0 0.6 0.8 c
- 1231 1966 m -5 3 d -30 -1 d 9 -6 d f 0 0.8 0.8 c 1226 1969 m -4 4 d -34 2 d 8
- -7 d f 0 0.8 0.6 c 1222 1973 m -5 4 d -18 1 d -11 -3 d f 0 0.8 0.4 c 1217 1977
- m -5 3 d -2 X -11 -2 d f 0 0.8 0.2 c 1212 1980 m 1 Y -2 -1 d f 0 0.4 0.8 c 1185
- 1953 m 24 6 d -4 3 d -23 -7 d f 0 0.6 0.8 c 1205 1962 m -9 6 d -27 -3 d 13 -10
- d f 0 0.8 0.8 c 1196 1968 m -8 7 d -23 -6 d 4 -4 d f 0 0.4 0.8 c 1162 1947 m 23
- 6 d -3 2 d -27 -3 d f 0 0.6 0.8 c 1182 1955 m -13 10 d -22 -1 d -6 -1 d 14 -11
- d f 0 0.8 0.8 c 1169 1965 m -4 4 d -18 -5 d f 0 0.4 0.8 c 1156 1946 m 6 1 d -7
- 5 d f 0 0.6 0.8 c 1142 1942 m 14 4 d -1 6 d -14 11 d -6 -2 d f 0 0.8 0.8 c 1138
- 1941 m 4 1 d -7 19 d -17 -4 d f 0 0.6 0.8 c 1115 1935 m 16 4 d -19 16 d -18 -4
- d f 0 0.8 0.8 c 1131 1939 m 7 2 d -20 16 d -6 -2 d f 0 0.2 0.8 c 1091 1929 m 1
- 1 d -1 X f 0 0.4 0.8 c 1092 1930 m 18 4 d -25 X 6 -4 d f 0 0.6 0.8 c 1110 1934
- m 5 1 d -21 16 d -9 -3 d -6 -9 d 6 -5 d f 0 0.8 0.8 c 1085 1948 m -10 -2 d -2
- -3 d 6 -4 d f 0 0.8 0.6 c 1075 1946 m -4 -1 d 2 -2 d f 0 0.2 0.8 c 1088 1929 m
- 3 X 1 Y f 0 0.4 0.8 c 1068 1923 m 20 6 d 3 1 d -6 4 d -20 -8 d f 0 0.6 0.8 c
- 1085 1934 m -6 5 d -19 -10 d 5 -3 d f 0 0.8 0.8 c 1079 1939 m -6 4 d -18 -10 d
- 5 -4 d f 0 0.8 0.6 c 1073 1943 m -2 2 d -11 -3 d -9 -6 d 4 -3 d f 0 0.8 0.4 c
- 1060 1942 m -13 -3 d 4 -3 d f 0 0.4 0.8 c 1054 1920 m 14 3 d -3 3 d f 0 0.6 0.8
- c 1044 1917 m 10 3 d 11 6 d -5 3 d -24 -5 d f 0 0.8 0.8 c 1060 1929 m -5 4 d
- -28 1 d -3 -1 d 12 -9 d f 0 0.8 0.6 c 1055 1933 m -4 3 d -12 1 d -12 -3 d f 0
- 0.8 0.4 c 1051 1936 m -4 3 d -8 -2 d f 0 0.4 0.8 c 1021 1911 m 13 4 d -20 1 d f
- 0 0.6 0.8 c 1034 1915 m 10 2 d -8 7 d -32 X 10 -8 d f 0 0.8 0.8 c 1036 1924 m
- -12 9 d -24 -6 d 4 -3 d f 0 0.4 0.8 c 998 1906 m 23 5 d -7 5 d f 0 0.6 0.8 c
- 997 1905 m 1 1 d 16 10 d -10 8 d -18 -10 d f 0 0.8 0.8 c 1004 1924 m -4 3 d -23
- -6 d 9 -7 d f 0 0.6 0.8 c 974 1899 m 23 6 d -11 9 d -26 3 d -7 -2 d f 0 0.8 0.8
- c 986 1914 m -9 7 d -17 -4 d f 0 0.6 0.8 c 953 1894 m 21 5 d -21 16 d -11 -3 d
- f 0 0.8 0.8 c 950 1893 m 3 1 d -11 18 d -12 -3 d f 0 0.4 0.8 c 927 1887 m 10 3
- d -16 1 d f 0 0.6 0.8 c 937 1890 m 12 3 d -34 3 d 6 -5 d f 0 0.8 0.8 c 949 1893
- m 1 X -20 16 d -15 -4 d -6 -4 d 6 -5 d f 0 0.8 0.6 c 915 1905 m -9 -2 d 3 -2 d
- f 0 0.4 0.8 c 917 1885 m 10 2 d -6 4 d f 0 0.6 0.8 c 904 1882 m 13 3 d 4 6 d -6
- 5 d f 0 0.8 0.8 c 903 1881 m 1 1 d 11 14 d -6 5 d -12 X -14 -4 d f 0 0.8 0.6 c
- 909 1901 m -3 2 d -9 -2 d f 0 0.6 0.8 c 880 1875 m 21 6 d -33 3 d f 0 0.8 0.8 c
- 901 1881 m 2 X -20 16 d -24 -6 d 9 -7 d f 0 0.4 0.8 c 838 1886 m -2 -1 d 3 -3 d
- f 0 0.6 0.8 c 856 1869 m 24 6 d -12 9 d -18 5 d -12 -3 d 1 -4 d f 0 0.8 0.8 c
- 868 1884 m -9 7 d -9 -2 d f 0 0.4 0.8 c 833 1864 m 9 2 d -3 16 d -3 3 d -5 -1 d
- -8 -13 d f 0 0.6 0.8 c 842 1866 m 14 3 d -17 13 d -8 2 d -19 -5 d 11 -8 d f 0
- 0.4 0.8 c 816 1859 m 17 5 d -10 7 d f 0 0.6 0.8 c 809 1858 m 7 1 d 7 12 d -11 8
- d -6 -1 d -6 -14 d f 0 0.8 0.8 c 806 1878 m -17 -5 d 11 -9 d f 0 0.6 0.8 c 793
- 1853 m 16 5 d -9 6 d f 0 0.8 0.8 c 786 1852 m 7 1 d 7 11 d -11 9 d -1 X -11 -15
- d f 0 0.8 0.6 c 788 1873 m -23 -6 d 12 -9 d f 0 0 0.8 c 762 1846 m 6 1 d -22 15
- d -4 -1 d f 0 0.2 0.8 c 768 1847 m 5 1 d -23 15 d -4 -1 d f 0 0.4 0.8 c 773
- 1848 m 6 2 d -25 14 d -4 -1 d f 0 0.6 0.8 c 779 1850 m 5 1 d -26 14 d -4 -1 d f
- 0 0.8 0.8 c 784 1851 m 2 1 d -9 6 d -15 8 d -4 -1 d f 0 0.8 0.6 c 777 1858 m
- -12 9 d -3 -1 d f 0 0 0.8 c 739 1840 m 23 6 d -20 15 d -24 -6 d f 715 1834 m 24
- 6 d -21 15 d -23 -6 d f 692 1828 m 23 6 d -20 15 d -24 -6 d f 1793 2087 m 23 6
- d -20 16 d -24 -6 d f 1769 2081 m 24 6 d -21 16 d -23 -6 d f 1746 2075 m 23 6 d
- -20 16 d -24 -6 d f 1736 2073 m 10 2 d -21 16 d -7 -2 d f 0 0.2 0.8 c 1726 2070
- m 10 3 d -18 16 d -7 -2 d f 0 0.4 0.8 c 1722 2069 m 4 1 d -15 17 d -7 -2 d 3 -5
- d f 0 0.6 0.8 c 1704 2085 m -2 X 5 -5 d f 0 0.2 0.8 c 1699 2063 m 3 1 d -4 X f
- 0 0.4 0.8 c 1702 2064 m 20 5 d -15 11 d -28 -2 d 19 -14 d f 0 0.6 0.8 c 1707
- 2080 m -5 5 d -24 -6 d 1 -1 d f 0 0.2 0.8 c 1675 2057 m 24 6 d -1 1 d -26 -5 d
- f 0 0.4 0.8 c 1698 2064 m -19 14 d -17 -11 d 10 -8 d f 0 0.6 0.8 c 1679 2078 m
- -1 1 d -23 -6 d 7 -6 d f 0 0.2 0.8 c 1652 2051 m 23 6 d -3 2 d -25 -4 d f 0 0.4
- 0.8 c 1672 2059 m -10 8 d -30 -1 d 15 -11 d f 0 0.6 0.8 c 1662 2067 m -7 6 d
- -24 -6 d 1 -1 d f 0 0.2 0.8 c 1644 2049 m 8 2 d -5 4 d f 0 0.4 0.8 c 1628 2045
- m 16 4 d 3 6 d -15 11 d -10 -16 d f 0 0.6 0.8 c 1632 2066 m -1 1 d -23 -6 d 14
- -11 d f 0 0.4 0.8 c 1613 2042 m 15 3 d -6 5 d f 0 0.6 0.8 c 1605 2039 m 8 3 d 9
- 8 d -14 11 d -3 -1 d -11 -13 d f 0 0.8 0.8 c 1605 2060 m -21 -5 d 10 -8 d f 0
- 0.2 0.8 c 1581 2033 m 7 2 d -10 1 d f 0 0.4 0.8 c 1588 2035 m 13 3 d -30 3 d 7
- -5 d f 0 0.6 0.8 c 1601 2038 m 4 1 d -11 8 d -30 -1 d 7 -5 d f 0 0.8 0.8 c 1594
- 2047 m -10 8 d -23 -6 d 3 -3 d f 0 0.2 0.8 c 1568 2030 m 13 3 d -3 3 d f 0 0.4
- 0.8 c 1558 2027 m 10 3 d 10 6 d -7 5 d -22 -7 d f 0 0.6 0.8 c 1571 2041 m -7 5
- d -23 -2 d -4 -1 d 12 -9 d f 0 0.8 0.8 c 1564 2046 m -3 3 d -20 -5 d f 0 0.4
- 0.8 c 1534 2021 m 24 6 d -9 7 d -31 4 d -4 -1 d f 0 0.6 0.8 c 1549 2034 m -12 9
- d -19 -5 d f 0 0.2 0.8 c 1511 2015 m 14 4 d -21 1 d f 0 0.4 0.8 c 1525 2019 m 9
- 2 d -20 16 d -24 -6 d 14 -11 d f 0 0.2 0.8 c 1487 2009 m 24 6 d -7 5 d -18 -10
- d f 0 0.4 0.8 c 1504 2020 m -14 11 d -11 -3 d -6 -8 d 13 -10 d f 0 0.6 0.8 c
- 1479 2028 m -12 -3 d 6 -5 d f 0 0.2 0.8 c 1484 2009 m 3 X -1 1 d f 0 0.4 0.8 c
- 1464 2003 m 20 6 d 2 1 d -13 10 d -24 -5 d f 0 0.6 0.8 c 1473 2020 m -6 5 d -24
- -6 d 6 -4 d f 0 0 0.8 c 1440 1997 m 2 1 d -3 X f 0 0.2 0.8 c 1442 1998 m 16 4 d
- -26 2 d 7 -6 d f 0 0.4 0.8 c 1458 2002 m 6 1 d -15 12 d -24 -6 d 7 -5 d f 0 0.6
- 0.8 c 1449 2015 m -6 4 d -23 -6 d 5 -4 d f 0 0 0.8 c 1433 1996 m 7 1 d -1 1 d f
- 0 0.2 0.8 c 1417 1991 m 16 5 d 6 2 d -7 6 d -23 -7 d f 0 0.4 0.8 c 1432 2004 m
- -7 5 d -26 -4 d 10 -8 d f 0 0.6 0.8 c 1425 2009 m -5 4 d -24 -6 d 3 -2 d f 0
- 0.2 0.8 c 1393 1986 m 24 5 d -8 6 d -20 -8 d f 0 0.4 0.8 c 1409 1997 m -10 8 d
- -26 -4 d 16 -12 d f 0 0.6 0.8 c 1399 2005 m -3 2 d -23 -6 d f 0 0 0.8 c 1370
- 1980 m 3 X -4 X f 0 0.2 0.8 c 1373 1980 m 20 6 d -4 3 d -27 -3 d 7 -6 d f 0 0.4
- 0.8 c 1389 1989 m -16 12 d -19 -10 d 8 -5 d f 0 0.6 0.8 c 1373 2001 m -24 -6 d
- 5 -4 d f 0 0 0.8 c 1365 1978 m 5 2 d -1 X f 0 0.2 0.8 c 1346 1974 m 19 4 d 4 2
- d -7 6 d -21 -8 d f 0 0.4 0.8 c 1362 1986 m -8 5 d -25 -4 d 12 -9 d f 0 0.6 0.8
- c 1354 1991 m -5 4 d -23 -6 d 3 -2 d f 0 0.2 0.8 c 1323 1968 m 23 6 d -5 4 d
- -22 -8 d f 0 0.4 0.8 c 1341 1978 m -12 9 d -17 -11 d 7 -6 d f 0 0.6 0.8 c 1329
- 1987 m -3 2 d -16 -4 d -5 -4 d 7 -5 d f 0 0.8 0.8 c 1310 1985 m -8 -2 d 3 -2 d
- f 0 0.2 0.8 c 1305 1963 m 18 5 d -4 2 d f 0 0.4 0.8 c 1299 1962 m 6 1 d 14 7 d
- -7 6 d -28 -2 d f 0 0.6 0.8 c 1312 1976 m -7 5 d -10 X -16 -4 d 5 -3 d f 0 0.8
- 0.8 c 1305 1981 m -3 2 d -7 -2 d f 0 0.4 0.8 c 1286 1958 m 13 4 d -15 12 d f 0
- 0.6 0.8 c 1276 1956 m 10 2 d -2 16 d -5 3 d -24 -6 d f 0 0.4 0.8 c 1252 1950 m
- 9 2 d -22 15 d -7 -2 d f 0 0.6 0.8 c 1261 1952 m 15 4 d -21 15 d -16 -4 d f 0
- 0.2 0.8 c 1229 1944 m 10 2 d -19 5 d f 0 0.4 0.8 c 1239 1946 m 13 4 d -20 15 d
- -23 -6 d 11 -8 d f 0 0.2 0.8 c 1205 1938 m 24 6 d -9 7 d -22 -8 d f 0 0.4 0.8 c
- 1220 1951 m -11 8 d -24 -6 d 13 -10 d f 0 0.2 0.8 c 1195 1935 m 10 3 d -7 5 d f
- 0 0.4 0.8 c 1182 1932 m 13 3 d 3 8 d -13 10 d -23 -6 d f 1158 1926 m 24 6 d -20
- 15 d -6 -1 d -2 -17 d f 0 0.6 0.8 c 1156 1946 m -14 -4 d -4 Y 12 -9 d f 0 0.8
- 0.8 c 1142 1942 m -4 -1 d 4 -3 d f 0 0.4 0.8 c 1135 1920 m 23 6 d -4 3 d -28 -2
- d f 0 0.6 0.8 c 1154 1929 m -12 9 d -11 1 d -16 -4 d 11 -8 d f 0 0.8 0.8 c 1142
- 1938 m -4 3 d -7 -2 d f 0 0.2 0.8 c 1092 1930 m -1 -1 d 5 -4 d f 0 0.4 0.8 c
- 1111 1914 m 24 6 d -9 7 d -16 7 d -18 -4 d 4 -5 d f 0 0.6 0.8 c 1126 1927 m -11
- 8 d -5 -1 d f 0 0.2 0.8 c 1096 1925 m -5 4 d -3 X f 0 0.4 0.8 c 1088 1908 m 23
- 6 d -15 11 d -8 4 d -20 -6 d f 1065 1902 m 23 6 d -20 15 d -14 -3 d f 0 0.6 0.8
- c 1064 1902 m 1 X -11 18 d -10 -3 d f 0 0.4 0.8 c 1041 1896 m 22 6 d -29 13 d
- -13 -4 d f 0 0.6 0.8 c 1063 1902 m 1 X -20 15 d -10 -2 d f 0 0.4 0.8 c 1024
- 1892 m 17 4 d -20 15 d -23 -5 d f 0 0.6 0.8 c 1017 1890 m 7 2 d -26 14 d -1 -1
- d f 0 0.2 0.8 c 994 1884 m 4 1 d -8 2 d f 0 0.4 0.8 c 998 1885 m 16 4 d -37 8 d
- 13 -10 d f 0 0.6 0.8 c 1014 1889 m 3 1 d -20 15 d -23 -6 d 3 -2 d f 0 0.2 0.8 c
- 970 1878 m 24 6 d -4 3 d -22 -7 d f 0 0.4 0.8 c 990 1887 m -13 10 d -17 -11 d 8
- -6 d f 0 0.6 0.8 c 977 1897 m -3 2 d -21 -5 d -2 -1 d 9 -7 d f 0 0.8 0.8 c 953
- 1894 m -3 -1 d 1 X f 0 0.2 0.8 c 966 1877 m 4 1 d -2 2 d f 0 0.4 0.8 c 947 1872
- m 19 5 d 2 3 d -8 6 d -23 4 d -10 -3 d 19 -15 d f 0 0.6 0.8 c 947 1872 m 13 14
- d -9 7 d -2 X -12 -3 d 9 -18 d f 0 0.8 0.8 c 951 1893 m -2 X f 0 0.2 0.8 c 923
- 1866 m 8 2 d -11 1 d f 0 0.4 0.8 c 931 1868 m 16 4 d -1 X -19 15 d -10 -2 d -5
- -10 d 8 -6 d f 0 0.6 0.8 c 947 1872 m -1 X -29 13 d -13 -3 d -1 Y 8 -6 d f 0
- 0.8 0.8 c 904 1882 m -1 -1 d 1 X f 0 0.2 0.8 c 906 1861 m 17 5 d -3 3 d f 0 0.4
- 0.8 c 900 1860 m 6 1 d 14 8 d -8 6 d -32 X f 0 0.6 0.8 c 912 1875 m -8 6 d -3 X
- -21 -6 d f 0 0.8 0.8 c 904 1881 m -3 X f 0 0.2 0.8 c 877 1854 m 5 1 d -6 -1 d f
- 0 0.4 0.8 c 882 1855 m 18 5 d -20 15 d -15 -13 d 11 -8 d f 0 0.6 0.8 c 880 1875
- m -24 -6 d 9 -7 d f 0 0.2 0.8 c 853 1848 m 24 6 d -1 X -34 3 d f 0 0.4 0.8 c
- 876 1854 m -11 8 d -23 4 d -9 -2 d 9 -7 d f 0 0.6 0.8 c 865 1862 m -9 7 d -14
- -3 d f 0 0 0.8 c 830 1842 m 9 2 d -12 X f 0 0.2 0.8 c 839 1844 m 14 4 d -11 9 d
- -23 -7 d 8 -6 d f 0 0.4 0.8 c 842 1857 m -9 7 d -17 -5 d -5 -3 d 8 -6 d f 0 0.6
- 0.8 c 816 1859 m -7 -1 d 2 -2 d f 0 0 0.8 c 823 1840 m 7 2 d -3 2 d f 0 0.2 0.8
- c 806 1836 m 17 4 d 4 4 d -8 6 d -13 -14 d f 0 0.4 0.8 c 819 1850 m -8 6 d -14
- -13 d 9 -7 d f 0 0.6 0.8 c 811 1856 m -2 2 d -16 -5 d -5 -4 d 9 -6 d f 0 0.8
- 0.8 c 793 1853 m -7 -1 d 2 -3 d f 0 0 0.8 c 783 1830 m 12 3 d -27 14 d -6 -1 d
- f 0 0.2 0.8 c 795 1833 m 11 3 d -33 12 d -5 -1 d f 0 0.4 0.8 c 806 1836 m -9 7
- d -18 7 d -6 -2 d f 0 0.6 0.8 c 797 1843 m -9 6 d -4 2 d -5 -1 d f 0 0.8 0.8 c
- 788 1849 m -2 3 d -2 -1 d f 0 0 0.8 c 759 1824 m 24 6 d -21 16 d -23 -6 d f 736
- 1818 m 23 6 d -20 16 d -24 -6 d f 712 1812 m 24 6 d -21 16 d -23 -6 d f 1813
- 2072 m 23 6 d -20 15 d -23 -6 d f 1789 2066 m 24 6 d -20 15 d -24 -6 d f 1766
- 2060 m 23 6 d -20 15 d -23 -6 d f 1742 2054 m 24 6 d -20 15 d -10 -2 d 2 -16 d
- f 0 0.2 0.8 c 1736 2073 m -10 -3 d 1 -4 d 11 -9 d f 0 0.4 0.8 c 1726 2070 m -4
- -1 d 5 -3 d f 0 0 0.8 c 1719 2048 m 23 6 d -4 3 d -22 -7 d f 0 0.2 0.8 c 1738
- 2057 m -11 9 d -25 -2 d -3 -1 d 17 -13 d f 0 0.4 0.8 c 1727 2066 m -5 3 d -20
- -5 d f 0 0 0.8 c 1717 2047 m 2 1 d -3 2 d f 0 0.2 0.8 c 1705 2044 m 12 3 d -1 3
- d -17 13 d -24 -6 d 5 -4 d f 0 0.4 0.8 c 1695 2042 m 10 2 d -25 9 d f 0 0 0.8 c
- 1672 2036 m 4 1 d -11 4 d f 0 0.2 0.8 c 1676 2037 m 11 2 d -7 14 d -5 4 d -23
- -6 d 13 -10 d f 0 0.4 0.8 c 1687 2039 m 8 3 d -15 11 d f 0 0 0.8 c 1648 2030 m
- 24 6 d -7 5 d -20 -8 d f 0 0.2 0.8 c 1665 2041 m -13 10 d -8 -2 d -10 -8 d 11
- -8 d f 0 0.4 0.8 c 1644 2049 m -16 -4 d 6 -4 d f 0 0 0.8 c 1629 2025 m 19 5 d
- -3 3 d f 0 0.2 0.8 c 1625 2024 m 4 1 d 16 8 d -11 8 d -18 -11 d f 0 0.4 0.8 c
- 1634 2041 m -6 4 d -15 -3 d -6 -4 d 9 -8 d f 0 0.6 0.8 c 1613 2042 m -8 -3 d 2
- -1 d f 0 0.2 0.8 c 1602 2018 m 23 6 d -9 6 d -28 5 d -7 -2 d f 0 0.4 0.8 c 1616
- 2030 m -9 8 d -6 X -13 -3 d f 0 0.6 0.8 c 1607 2038 m -2 1 d -4 -1 d f 0 0 0.8
- c 1578 2012 m 13 3 d -17 X f 0 0.2 0.8 c 1591 2015 m 11 3 d -21 15 d -13 -3 d
- -6 -6 d 12 -9 d f 0 0.4 0.8 c 1568 2030 m -10 -3 d 4 -3 d f 0 0 0.8 c 1565 2009
- m 13 3 d -4 3 d f 0 0.2 0.8 c 1555 2006 m 10 3 d 9 6 d -12 9 d -24 -6 d f 0 0.4
- 0.8 c 1562 2024 m -4 3 d -24 -6 d 4 -3 d f 0 0.2 0.8 c 1531 2000 m 24 6 d -17
- 12 d -13 1 d -14 -4 d f 0 0.4 0.8 c 1538 2018 m -4 3 d -9 -2 d f 0 0 0.8 c 1508
- 1994 m 12 3 d -20 3 d f 0 0.2 0.8 c 1520 1997 m 11 3 d -20 15 d -24 -6 d 13 -9
- d f 0 0 0.8 c 1484 1988 m 24 6 d -8 6 d -23 -6 d f 0 0.2 0.8 c 1500 2000 m -13
- 9 d -3 X -17 -8 d 10 -7 d f 0 0.4 0.8 c 1484 2009 m -20 -6 d 3 -2 d f 0 0 0.8 c
- 1470 1984 m 14 4 d -7 6 d -35 4 d -2 -1 d 4 -3 d f 0 0.2 0.8 c 1461 1982 m 9 2
- d 7 10 d -10 7 d -9 1 d -16 -4 d 2 -4 d f 0 0.4 0.8 c 1467 2001 m -3 2 d -6 -1
- d f 0 0 0.8 c 1444 1994 m -4 3 d -7 -1 d f 0 0.2 0.8 c 1437 1976 m 24 6 d -17
- 12 d -11 2 d -16 -5 d f 1414 1970 m 23 6 d -20 15 d -24 -5 d f 0 0 0.8 c 1390
- 1964 m 6 2 d -23 14 d -3 X f 0 0.2 0.8 c 1396 1966 m 18 4 d -21 16 d -20 -6 d f
- 0 0 0.8 c 1367 1958 m 23 6 d -20 16 d -5 -2 d -7 -14 d f 0 0.2 0.8 c 1365 1978
- m -19 -4 d 12 -10 d f 0 0 0.8 c 1348 1953 m 19 5 d -9 6 d f 0 0.2 0.8 c 1343
- 1952 m 5 1 d 10 11 d -12 10 d -23 -6 d f 1320 1946 m 23 6 d -20 16 d -18 -5 d 2
- -7 d f 0 0.4 0.8 c 1305 1963 m -6 -1 d 8 -6 d f 0 0.2 0.8 c 1296 1940 m 24 6 d
- -13 10 d -15 -12 d f 0 0.4 0.8 c 1307 1956 m -8 6 d -13 -4 d -4 -7 d 10 -7 d f
- 0 0.6 0.8 c 1286 1958 m -10 -2 d 6 -5 d f 0 0.2 0.8 c 1273 1934 m 23 6 d -4 4 d
- -26 -5 d f 0 0.4 0.8 c 1292 1944 m -10 7 d -21 1 d -9 -2 d 14 -11 d f 0 0.6 0.8
- c 1282 1951 m -6 5 d -15 -4 d f 0 0 0.8 c 1249 1928 m 8 2 d -16 4 d f 0 0.2 0.8
- c 1257 1930 m 16 4 d -7 5 d -27 7 d -10 -2 d 12 -10 d f 0 0.4 0.8 c 1266 1939 m
- -14 11 d -13 -4 d f 0 0 0.8 c 1240 1926 m 9 2 d -8 6 d f 0 0.2 0.8 c 1226 1922
- m 14 4 d 1 8 d -12 10 d -24 -6 d f 1202 1916 m 24 6 d -21 16 d -10 -3 d 1 -14 d
- f 0 0.4 0.8 c 1195 1935 m -13 -3 d 14 -11 d f 0 0 0.8 c 1179 1910 m 10 3 d -16
- 1 d f 0 0.2 0.8 c 1189 1913 m 13 3 d -6 5 d -32 X 9 -7 d f 0 0.4 0.8 c 1196
- 1921 m -14 11 d -24 -6 d 6 -5 d f 0 0 0.8 c 1158 1905 m 21 5 d -6 4 d f 0 0.2
- 0.8 c 1155 1904 m 3 1 d 15 9 d -9 7 d -20 -9 d f 0 0.4 0.8 c 1164 1921 m -6 5 d
- -23 -6 d 9 -8 d f 0 0.2 0.8 c 1132 1898 m 23 6 d -11 8 d -29 -1 d f 0 0.4 0.8 c
- 1144 1912 m -9 8 d -24 -6 d 4 -3 d f 0 0.2 0.8 c 1108 1892 m 24 6 d -17 13 d
- -22 -7 d f 0 0.4 0.8 c 1115 1911 m -4 3 d -23 -6 d 5 -4 d f 0 0.2 0.8 c 1085
- 1886 m 23 6 d -15 12 d -15 -13 d f 0 0.4 0.8 c 1093 1904 m -5 4 d -23 -6 d 13
- -11 d f 0 0.6 0.8 c 1065 1902 m -1 X 1 X f 0 0.2 0.8 c 1067 1882 m 18 4 d -7 5
- d f 0 0.4 0.8 c 1061 1880 m 6 2 d 11 9 d -13 11 d -2 X -22 -6 d f 0 0.6 0.8 c
- 1065 1902 m -2 X f 0 0 0.8 c 1038 1874 m 5 2 d -8 X f 0 0.2 0.8 c 1043 1876 m
- 16 4 d -32 2 d 8 -6 d f 0 0.4 0.8 c 1059 1880 m 2 X -20 16 d -17 -4 d -5 -4 d 8
- -6 d f 0 0.6 0.8 c 1024 1892 m -7 -2 d 2 -2 d f 0 0 0.8 c 1014 1868 m 24 6 d -3
- 2 d -30 -1 d f 0 0.2 0.8 c 1035 1876 m -8 6 d -29 3 d -4 -1 d 11 -9 d f 0 0.4
- 0.8 c 1027 1882 m -8 6 d -5 1 d -16 -4 d f 0 0.6 0.8 c 1019 1888 m -2 2 d -3 -1
- d f 0 0 0.8 c 1005 1866 m 9 2 d -9 7 d f 0 0.2 0.8 c 991 1862 m 14 4 d 9 Y -11
- 9 d -24 -6 d f 967 1856 m 24 6 d -21 16 d -4 -1 d -5 -16 d f 0 0.4 0.8 c 966
- 1877 m -19 -5 d 14 -11 d f 0 0.6 0.8 c 947 1872 m f 0 0.2 0.8 c 944 1850 m 23 6
- d -6 5 d -30 7 d -8 -2 d f 0 0.4 0.8 c 961 1861 m -14 11 d -16 -4 d f 0 0.6 0.8
- c 947 1872 m f 0 0 0.8 c 920 1844 m 3 1 d -5 1 d f 0 0.2 0.8 c 923 1845 m 21 5
- d -21 16 d -17 -5 d -3 -3 d 15 -12 d f 0 0.4 0.8 c 906 1861 m -6 -1 d 3 -2 d f
- 0 0 0.8 c 897 1838 m 23 6 d -2 2 d -27 -3 d f 0 0.2 0.8 c 918 1846 m -15 12 d
- -21 -3 d -5 -1 d 14 -11 d f 0 0.4 0.8 c 903 1858 m -3 2 d -18 -5 d f 0 0 0.8 c
- 878 1834 m 19 4 d -6 5 d f 0 0.2 0.8 c 873 1832 m 5 2 d 13 9 d -14 11 d -24 -6
- d f 0 0 0.8 c 839 1844 m -9 -2 d 11 -8 d f 0 0.2 0.8 c 850 1826 m 23 6 d -20 16
- d -14 -4 d 2 -10 d f 0 0 0.8 c 826 1820 m 8 2 d 7 12 d -11 8 d -7 -2 d 1 -18 d
- f 0 0.2 0.8 c 834 1822 m 16 4 d -9 8 d -18 6 d -17 -4 d 18 -14 d f 0 0 0.8 c
- 803 1815 m 23 5 d -2 2 d -29 11 d -12 -3 d f 0 0.2 0.8 c 824 1822 m -18 14 d
- -11 -3 d f 0 0 0.8 c 779 1809 m 24 6 d -20 15 d -24 -6 d f 756 1803 m 23 6 d
- -20 15 d -23 -6 d f 732 1797 m 24 6 d -20 15 d -24 -6 d f 1833 2056 m 24 6 d
- -21 16 d -23 -6 d f 1810 2050 m 23 6 d -20 16 d -24 -6 d f 1786 2044 m 24 6 d
- -21 16 d -23 -6 d f 1763 2038 m 23 6 d -20 16 d -24 -6 d f 1739 2032 m 24 6 d
- -21 16 d -23 -6 d f 1716 2026 m 23 6 d -20 16 d -2 -1 d -4 -18 d f 0 0.2 0.8 c
- 1717 2047 m -12 -3 d -2 -8 d 10 -7 d f 0 0.4 0.8 c 1705 2044 m -10 -2 d 8 -6 d
- f 0 0 0.8 c 1692 2020 m 24 6 d -3 3 d -37 8 d -4 -1 d f 0 0.2 0.8 c 1713 2029 m
- -10 7 d -16 3 d -11 -2 d f 0 0.4 0.8 c 1703 2036 m -8 6 d -8 -3 d f 0 0 0.8 c
- 1669 2014 m 23 6 d -20 16 d -24 -6 d f 1645 2008 m 24 6 d -21 16 d -19 -5 d 4
- -7 d f 0 0.2 0.8 c 1629 2025 m -4 -1 d 8 -6 d f 0 0 0.8 c 1622 2002 m 23 6 d
- -12 10 d -24 -6 d f 0 0.2 0.8 c 1633 2018 m -8 6 d -23 -6 d 7 -6 d f 0 0 0.8 c
- 1606 1998 m 16 4 d -13 10 d -18 3 d -13 -3 d 11 -9 d f 0 0.2 0.8 c 1598 1996 m
- 8 2 d 3 14 d -7 6 d -11 -3 d -2 -12 d f 0 0 0.8 c 1575 1990 m 7 2 d 7 11 d -11
- 9 d -13 -3 d 4 -14 d f 0 0.2 0.8 c 1582 1992 m 16 4 d -9 7 d -24 6 d -10 -3 d
- 14 -11 d f 0 0 0.8 c 1551 1984 m 24 6 d -6 5 d -28 -3 d f 0 0.2 0.8 c 1569 1995
- m -14 11 d -24 -6 d 10 -8 d f 0 0 0.8 c 1528 1978 m 23 6 d -10 8 d -21 5 d -12
- -3 d f 0 0.2 0.8 c 1541 1992 m -10 8 d -11 -3 d f 0 0 0.8 c 1521 1976 m 7 2 d
- -20 16 d -24 -6 d 15 -11 d f 0 0.2 0.8 c 1504 1972 m 17 4 d -22 1 d f 0 0 0.8 c
- 1481 1966 m 15 4 d 3 7 d -15 11 d -14 -4 d -9 Y f 0 0.2 0.8 c 1496 1970 m 8 2 d
- -5 5 d -29 7 d -9 -2 d 9 -7 d f 0 0 0.8 c 1457 1960 m 24 6 d -11 9 d -31 -1 d f
- 0 0.2 0.8 c 1470 1975 m -9 7 d -24 -6 d 2 -2 d f 0 0 0.8 c 1434 1954 m 23 6 d
- -18 14 d -13 -14 d f 0 0.2 0.8 c 1439 1974 m -2 2 d -23 -6 d 12 -10 d f 0 0 0.8
- c 1410 1948 m 24 6 d -8 6 d -30 6 d -6 -2 d f 0 0.2 0.8 c 1426 1960 m -12 10 d
- -18 -4 d f 0 0 0.8 c 1387 1942 m 23 6 d -20 16 d -23 -6 d f 1363 1936 m 24 6 d
- -20 16 d -19 -5 d -3 -2 d f 0 0.2 0.8 c 1348 1953 m -5 -1 d 2 -1 d f 0 0 0.8 c
- 1340 1931 m 23 5 d -18 15 d -8 -18 d f 0 0.2 0.8 c 1345 1951 m -2 1 d -23 -6 d
- 17 -13 d f 0 0 0.8 c 1325 1927 m 15 4 d -3 2 d f 0 0.2 0.8 c 1317 1925 m 8 2 d
- 12 6 d -17 13 d -24 -6 d f 1293 1919 m 24 6 d -21 15 d -23 -6 d f 0 0 0.8 c
- 1270 1913 m 14 3 d -27 14 d -8 -2 d f 0 0.2 0.8 c 1284 1916 m 9 3 d -20 15 d
- -16 -4 d f 0 0 0.8 c 1265 1911 m 5 2 d -21 15 d -9 -2 d f 0 0.2 0.8 c 1246 1907
- m 19 4 d -25 15 d -14 -4 d f 0 0 0.8 c 1223 1901 m 4 1 d -8 1 d f 0 0.2 0.8 c
- 1227 1902 m 19 5 d -20 15 d -24 -6 d 17 -13 d f 0 0 0.8 c 1199 1895 m 24 6 d -4
- 2 d -30 10 d -10 -3 d f 0 0.2 0.8 c 1219 1903 m -17 13 d -13 -3 d f 0 0 0.8 c
- 1176 1889 m 23 6 d -20 15 d -21 -5 d -1 -2 d f 0 0.2 0.8 c 1158 1905 m -3 -1 d
- 2 -1 d f 0 0 0.8 c 1152 1883 m 24 6 d -19 14 d -16 -12 d f 0 0.2 0.8 c 1157
- 1903 m -2 1 d -23 -6 d 9 -7 d f 0 0 0.8 c 1129 1877 m 23 6 d -11 8 d -21 -8 d f
- 0 0.2 0.8 c 1141 1891 m -9 7 d -24 -6 d 12 -9 d f 0 0 0.8 c 1105 1871 m 24 6 d
- -9 6 d -19 -9 d f 0 0.2 0.8 c 1120 1883 m -12 9 d -23 -6 d 16 -12 d f 0 0 0.8 c
- 1090 1867 m 15 4 d -4 3 d f 0 0.2 0.8 c 1082 1865 m 8 2 d 11 7 d -16 12 d -18
- -4 d -3 -4 d f 0 0.4 0.8 c 1067 1882 m -6 -2 d 3 -2 d f 0 0 0.8 c 1058 1859 m
- 19 5 d -34 12 d -5 -2 d f 0 0.2 0.8 c 1077 1864 m 5 1 d -18 13 d -5 2 d -16 -4
- d f 0 0.4 0.8 c 1064 1878 m -3 2 d -2 X f 0 0 0.8 c 1035 1853 m 23 6 d -20 15 d
- -24 -6 d f 1020 1849 m 15 4 d -21 15 d -9 -2 d f 0 0.2 0.8 c 1011 1847 m 9 2 d
- -15 17 d -14 -4 d f 0 0 0.8 c 988 1841 m 20 5 d -31 3 d f 0 0.2 0.8 c 1008 1846
- m 3 1 d -20 15 d -24 -6 d 10 -7 d f 0 0 0.8 c 964 1835 m 24 6 d -11 8 d -22 -7
- d f 0 0.2 0.8 c 977 1849 m -10 7 d -23 -6 d 11 -8 d f 0 0 0.8 c 941 1829 m 23 6
- d -9 7 d -32 3 d -3 -1 d f 0 0.2 0.8 c 955 1842 m -11 8 d -21 -5 d f 0 0 0.8 c
- 919 1823 m 22 6 d -21 15 d -23 -6 d 16 -12 d f 0 0.2 0.8 c 917 1823 m 2 X -6 3
- d f 0 0 0.8 c 894 1817 m 14 4 d 5 5 d -16 12 d -19 -4 d 3 -7 d f 0 0.2 0.8 c
- 908 1821 m 9 2 d -4 3 d -35 8 d -5 -2 d 8 -5 d f 0 0 0.8 c 870 1811 m 24 6 d
- -13 10 d -22 -8 d f 0 0.2 0.8 c 881 1827 m -8 5 d -23 -6 d 9 -7 d f 0 0 0.8 c
- 847 1805 m 23 6 d -11 8 d -25 3 d -8 -2 d f 0 0.2 0.8 c 859 1819 m -9 7 d -16
- -4 d f 0 0 0.8 c 823 1799 m 24 6 d -21 15 d -23 -5 d f 800 1793 m 23 6 d -20 16
- d -24 -6 d f 776 1787 m 24 6 d -21 16 d -23 -6 d f 753 1781 m 23 6 d -20 16 d
- -24 -6 d f 1854 2041 m 23 6 d -20 15 d -24 -6 d f 1830 2035 m 24 6 d -21 15 d
- -23 -6 d f 1807 2029 m 23 6 d -20 15 d -24 -6 d f 1789 2024 m 18 5 d -21 15 d
- -23 -6 d 6 -5 d f 0 0.2 0.8 c 1783 2023 m 6 1 d -20 9 d f 0 0 0.8 c 1760 2017 m
- 18 4 d -9 12 d -6 5 d -24 -6 d f 0 0.2 0.8 c 1778 2021 m 5 2 d -14 10 d f 0 0
- 0.8 c 1736 2011 m 24 6 d -21 15 d -23 -6 d f 1713 2005 m 23 6 d -20 15 d -24 -6
- d f 1689 1999 m 24 6 d -21 15 d -23 -6 d f 1666 1993 m 23 6 d -20 15 d -24 -6 d
- f 1642 1987 m 24 6 d -21 15 d -23 -6 d f 1619 1981 m 23 6 d -20 15 d -16 -4 d
- -1 -7 d f 0 0.2 0.8 c 1606 1998 m -8 -2 d 7 -5 d f 0 0 0.8 c 1595 1975 m 24 6 d
- -14 10 d -23 1 d -7 -2 d f 0 0.2 0.8 c 1605 1991 m -7 5 d -16 -4 d f 0 0 0.8 c
- 1572 1969 m 23 6 d -20 15 d -24 -6 d f 1548 1963 m 24 6 d -21 15 d -23 -6 d f
- 1525 1957 m 23 6 d -20 15 d -7 -2 d -12 -7 d f 0 0.2 0.8 c 1521 1976 m -17 -4 d
- 5 -3 d f 0 0 0.8 c 1501 1951 m 24 6 d -16 12 d -13 1 d -15 -4 d f 0 0.2 0.8 c
- 1509 1969 m -5 3 d -8 -2 d f 0 0 0.8 c 1478 1945 m 23 6 d -20 15 d -24 -6 d f
- 1454 1939 m 24 6 d -21 15 d -23 -6 d f 1431 1933 m 23 6 d -20 15 d -24 -6 d f
- 1407 1927 m 24 6 d -21 15 d -23 -6 d f 1384 1921 m 23 6 d -20 15 d -24 -6 d f
- 1360 1915 m 24 6 d -21 15 d -23 -5 d f 1337 1909 m 23 6 d -20 16 d -15 -4 d -7
- -4 d f 0 0.2 0.8 c 1325 1927 m -8 -2 d 1 -2 d f 0 0 0.8 c 1313 1903 m 24 6 d
- -19 14 d -22 -6 d f 0 0.2 0.8 c 1318 1923 m -1 2 d -24 -6 d 3 -2 d f 0 0 0.8 c
- 1290 1897 m 23 6 d -17 14 d -12 -1 d -14 -3 d f 0 0.2 0.8 c 1296 1917 m -3 2 d
- -9 -3 d f 0 0 0.8 c 1266 1891 m 24 6 d -20 16 d -5 -2 d -11 -11 d f 0 0.2 0.8 c
- 1265 1911 m -19 -4 d 8 -7 d f 0 0 0.8 c 1243 1885 m 23 6 d -12 9 d -27 2 d -4
- -1 d f 0 0.2 0.8 c 1254 1900 m -8 7 d -19 -5 d f 0 0 0.8 c 1219 1879 m 24 6 d
- -20 16 d -24 -6 d f 1196 1873 m 23 6 d -20 16 d -23 -6 d f 1172 1867 m 24 6 d
- -20 16 d -24 -6 d f 1149 1861 m 23 6 d -20 16 d -23 -6 d f 1125 1855 m 24 6 d
- -20 16 d -24 -6 d f 1102 1849 m 23 6 d -20 16 d -15 -4 d -6 -4 d f 0 0.2 0.8 c
- 1090 1867 m -8 -2 d 2 -2 d f 0 0 0.8 c 1078 1843 m 24 6 d -18 14 d -7 1 d -19
- -5 d f 0 0.2 0.8 c 1084 1863 m -2 2 d -5 -1 d f 0 0 0.8 c 1055 1837 m 23 6 d
- -20 16 d -23 -6 d f 1031 1831 m 24 6 d -20 16 d -15 -4 d -6 -4 d f 0 0.2 0.8 c
- 1020 1849 m -9 -2 d 3 -2 d f 0 0 0.8 c 1008 1825 m 23 6 d -17 14 d -6 1 d -20
- -5 d f 0 0.2 0.8 c 1014 1845 m -3 2 d -3 -1 d f 0 0 0.8 c 985 1819 m 23 6 d -20
- 16 d -24 -6 d f 961 1813 m 24 6 d -21 16 d -23 -6 d f 938 1807 m 23 6 d -20 16
- d -22 -6 d -2 Y f 0 0.2 0.8 c 919 1823 m -2 X 2 -2 d f 0 0 0.8 c 914 1801 m 24
- 6 d -19 14 d -11 X -14 -4 d f 0 0.2 0.8 c 919 1821 m -2 2 d -9 -2 d f 0 0 0.8 c
- 891 1795 m 23 6 d -20 16 d -24 -6 d f 867 1789 m 24 6 d -21 16 d -23 -6 d f 844
- 1783 m 23 6 d -20 16 d -24 -6 d f 820 1777 m 24 6 d -21 16 d -23 -6 d f 797
- 1771 m 23 6 d -20 16 d -24 -6 d f 773 1765 m 24 6 d -21 16 d -23 -6 d f 1874
- 2025 m 23 6 d -20 16 d -23 -6 d f 1850 2019 m 24 6 d -20 16 d -24 -6 d f 1827
- 2013 m 23 6 d -20 16 d -23 -6 d f 1803 2007 m 24 6 d -20 16 d -18 -5 d -6 Y f 0
- 0.2 0.8 c 1789 2024 m -6 -1 d 6 -5 d f 0 0 0.8 c 1780 2001 m 23 6 d -14 11 d
- -11 3 d -18 -4 d f 0 0.2 0.8 c 1789 2018 m -6 5 d -5 -2 d f 0 0 0.8 c 1757 1995
- m 23 6 d -20 16 d -24 -6 d f 1733 1989 m 24 6 d -21 16 d -23 -6 d f 1710 1983 m
- 23 6 d -20 16 d -24 -6 d f 1686 1977 m 24 6 d -21 16 d -23 -6 d f 1663 1971 m
- 23 6 d -20 16 d -24 -6 d f 1639 1965 m 24 6 d -21 16 d -23 -6 d f 1616 1959 m
- 23 6 d -20 16 d -24 -6 d f 1592 1953 m 24 6 d -21 16 d -23 -6 d f 1569 1947 m
- 23 6 d -20 16 d -24 -6 d f 1545 1941 m 24 6 d -21 16 d -23 -6 d f 1522 1935 m
- 23 6 d -20 16 d -24 -6 d f 1498 1929 m 24 6 d -21 16 d -23 -6 d f 1475 1923 m
- 23 6 d -20 16 d -24 -6 d f 1451 1917 m 24 6 d -21 16 d -23 -6 d f 1428 1911 m
- 23 6 d -20 16 d -24 -6 d f 1404 1905 m 24 6 d -21 16 d -23 -6 d f 1381 1899 m
- 23 6 d -20 16 d -24 -6 d f 1357 1893 m 24 6 d -21 16 d -23 -6 d f 1334 1887 m
- 23 6 d -20 16 d -24 -6 d f 1310 1882 m 24 5 d -21 16 d -23 -6 d f 1287 1876 m
- 23 6 d -20 15 d -24 -6 d f 1263 1870 m 24 6 d -21 15 d -23 -6 d f 1240 1864 m
- 23 6 d -20 15 d -24 -6 d f 1216 1858 m 24 6 d -21 15 d -23 -6 d f 1193 1852 m
- 23 6 d -20 15 d -24 -6 d f 1169 1846 m 24 6 d -21 15 d -23 -6 d f 1146 1840 m
- 23 6 d -20 15 d -24 -6 d f 1122 1834 m 24 6 d -21 15 d -23 -6 d f 1099 1828 m
- 23 6 d -20 15 d -24 -6 d f 1075 1822 m 24 6 d -21 15 d -23 -6 d f 1052 1816 m
- 23 6 d -20 15 d -24 -6 d f 1028 1810 m 24 6 d -21 15 d -23 -6 d f 1005 1804 m
- 23 6 d -20 15 d -23 -6 d f 981 1798 m 24 6 d -20 15 d -24 -6 d f 958 1792 m 23
- 6 d -20 15 d -23 -6 d f 934 1786 m 24 6 d -20 15 d -24 -6 d f 911 1780 m 23 6 d
- -20 15 d -23 -6 d f 887 1774 m 24 6 d -20 15 d -24 -6 d f 864 1768 m 23 6 d -20
- 15 d -23 -6 d f 840 1762 m 24 6 d -20 15 d -24 -6 d f 817 1756 m 23 6 d -20 15
- d -23 -6 d f 793 1750 m 24 6 d -20 15 d -24 -6 d f 1894 2009 m 24 6 d -21 16 d
- -23 -6 d f 1871 2004 m 23 5 d -20 16 d -24 -6 d f 1847 1998 m 24 6 d -21 15 d
- -23 -6 d f 1824 1992 m 23 6 d -20 15 d -24 -6 d f 1800 1986 m 24 6 d -21 15 d
- -23 -6 d f 1777 1980 m 23 6 d -20 15 d -23 -6 d f 1753 1974 m 24 6 d -20 15 d
- -24 -6 d f 1730 1968 m 23 6 d -20 15 d -23 -6 d f 1706 1962 m 24 6 d -20 15 d
- -24 -6 d f 1683 1956 m 23 6 d -20 15 d -23 -6 d f 1659 1950 m 24 6 d -20 15 d
- -24 -6 d f 1636 1944 m 23 6 d -20 15 d -23 -6 d f 1612 1938 m 24 6 d -20 15 d
- -24 -6 d f 1589 1932 m 23 6 d -20 15 d -23 -6 d f 1565 1926 m 24 6 d -20 15 d
- -24 -6 d f 1542 1920 m 23 6 d -20 15 d -23 -6 d f 1518 1914 m 24 6 d -20 15 d
- -24 -6 d f 1495 1908 m 23 6 d -20 15 d -23 -6 d f 1471 1902 m 24 6 d -20 15 d
- -24 -6 d f 1448 1896 m 23 6 d -20 15 d -23 -6 d f 1425 1890 m 23 6 d -20 15 d
- -24 -6 d f 1401 1884 m 24 6 d -21 15 d -23 -6 d f 1378 1878 m 23 6 d -20 15 d
- -24 -6 d f 1354 1872 m 24 6 d -21 15 d -23 -6 d f 1331 1866 m 23 6 d -20 15 d
- -24 -5 d f 1307 1860 m 24 6 d -21 16 d -23 -6 d f 1284 1854 m 23 6 d -20 16 d
- -24 -6 d f 1260 1848 m 24 6 d -21 16 d -23 -6 d f 1237 1842 m 23 6 d -20 16 d
- -24 -6 d f 1213 1836 m 24 6 d -21 16 d -23 -6 d f 1190 1830 m 23 6 d -20 16 d
- -24 -6 d f 1166 1824 m 24 6 d -21 16 d -23 -6 d f 1143 1818 m 23 6 d -20 16 d
- -24 -6 d f 1119 1812 m 24 6 d -21 16 d -23 -6 d f 1096 1806 m 23 6 d -20 16 d
- -24 -6 d f 1072 1800 m 24 6 d -21 16 d -23 -6 d f 1049 1794 m 23 6 d -20 16 d
- -24 -6 d f 1025 1788 m 24 6 d -21 16 d -23 -6 d f 1002 1782 m 23 6 d -20 16 d
- -24 -6 d f 978 1776 m 24 6 d -21 16 d -23 -6 d f 955 1770 m 23 6 d -20 16 d -24
- -6 d f 931 1764 m 24 6 d -21 16 d -23 -6 d f 908 1758 m 23 6 d -20 16 d -24 -6
- d f 884 1752 m 24 6 d -21 16 d -23 -6 d f 861 1746 m 23 6 d -20 16 d -24 -6 d f
- 837 1740 m 24 6 d -21 16 d -23 -6 d f 814 1734 m 23 6 d -20 16 d -24 -6 d f
- 1915 1994 m 23 6 d -20 15 d -24 -6 d f 1891 1988 m 24 6 d -21 15 d -23 -5 d f
- 1868 1982 m 23 6 d -20 16 d -24 -6 d f 1844 1976 m 24 6 d -21 16 d -23 -6 d f
- 1821 1970 m 23 6 d -20 16 d -24 -6 d f 1797 1964 m 24 6 d -21 16 d -23 -6 d f
- 1774 1958 m 23 6 d -20 16 d -24 -6 d f 1750 1952 m 24 6 d -21 16 d -23 -6 d f
- 1727 1946 m 23 6 d -20 16 d -24 -6 d f 1703 1940 m 24 6 d -21 16 d -23 -6 d f
- 1680 1934 m 23 6 d -20 16 d -24 -6 d f 1656 1928 m 24 6 d -21 16 d -23 -6 d f
- 1633 1922 m 23 6 d -20 16 d -24 -6 d f 1609 1916 m 24 6 d -21 16 d -23 -6 d f
- 1586 1910 m 23 6 d -20 16 d -24 -6 d f 1562 1904 m 24 6 d -21 16 d -23 -6 d f
- 1539 1898 m 23 6 d -20 16 d -24 -6 d f 1515 1892 m 24 6 d -21 16 d -23 -6 d f
- 1492 1886 m 23 6 d -20 16 d -24 -6 d f 1468 1880 m 24 6 d -21 16 d -23 -6 d f
- 1445 1874 m 23 6 d -20 16 d -23 -6 d f 1421 1868 m 24 6 d -20 16 d -24 -6 d f
- 1398 1862 m 23 6 d -20 16 d -23 -6 d f 1374 1856 m 24 6 d -20 16 d -24 -6 d f
- 1351 1850 m 23 6 d -20 16 d -23 -6 d f 1327 1844 m 24 6 d -20 16 d -24 -6 d f
- 1304 1838 m 23 6 d -20 16 d -23 -6 d f 1280 1832 m 24 6 d -20 16 d -24 -6 d f
- 1257 1827 m 23 5 d -20 16 d -23 -6 d f 1233 1821 m 24 6 d -20 15 d -24 -6 d f
- 1210 1815 m 23 6 d -20 15 d -23 -6 d f 1186 1809 m 24 6 d -20 15 d -24 -6 d f
- 1163 1803 m 23 6 d -20 15 d -23 -6 d f 1139 1797 m 24 6 d -20 15 d -24 -6 d f
- 1116 1791 m 23 6 d -20 15 d -23 -6 d f 1093 1785 m 23 6 d -20 15 d -24 -6 d f
- 1069 1779 m 24 6 d -21 15 d -23 -6 d f 1046 1773 m 23 6 d -20 15 d -24 -6 d f
- 1022 1767 m 24 6 d -21 15 d -23 -6 d f 999 1761 m 23 6 d -20 15 d -24 -6 d f
- 975 1755 m 24 6 d -21 15 d -23 -6 d f 952 1749 m 23 6 d -20 15 d -24 -6 d f 928
- 1743 m 24 6 d -21 15 d -23 -6 d f 905 1737 m 23 6 d -20 15 d -24 -6 d f 881
- 1731 m 24 6 d -21 15 d -23 -6 d f 858 1725 m 23 6 d -20 15 d -24 -6 d f 834
- 1719 m 24 6 d -21 15 d -23 -6 d f 1935 1978 m 23 6 d -20 16 d -23 -6 d f 1911
- 1972 m 24 6 d -20 16 d -24 -6 d f 1888 1966 m 23 6 d -20 16 d -23 -6 d f 1865
- 1960 m 23 6 d -20 16 d -24 -6 d f 1841 1954 m 24 6 d -21 16 d -23 -6 d f 1818
- 1949 m 23 5 d -20 16 d -24 -6 d f 1794 1943 m 24 6 d -21 15 d -23 -6 d f 1771
- 1937 m 23 6 d -20 15 d -24 -6 d f 1747 1931 m 24 6 d -21 15 d -23 -6 d f 1724
- 1925 m 23 6 d -20 15 d -24 -6 d f 1700 1919 m 24 6 d -21 15 d -23 -6 d f 1677
- 1913 m 23 6 d -20 15 d -24 -6 d f 1653 1907 m 24 6 d -21 15 d -23 -6 d f 1630
- 1901 m 23 6 d -20 15 d -24 -6 d f 1606 1895 m 24 6 d -21 15 d -23 -6 d f 1583
- 1889 m 23 6 d -20 15 d -24 -6 d f 1559 1883 m 24 6 d -21 15 d -23 -6 d f 1536
- 1877 m 23 6 d -20 15 d -24 -6 d f 1512 1871 m 24 6 d -21 15 d -23 -6 d f 1489
- 1865 m 23 6 d -20 15 d -24 -6 d f 1465 1859 m 24 6 d -21 15 d -23 -6 d f 1442
- 1853 m 23 6 d -20 15 d -24 -6 d f 1418 1847 m 24 6 d -21 15 d -23 -6 d f 1395
- 1841 m 23 6 d -20 15 d -24 -6 d f 1371 1835 m 24 6 d -21 15 d -23 -6 d f 1348
- 1829 m 23 6 d -20 15 d -24 -6 d f 1324 1823 m 24 6 d -21 15 d -23 -6 d f 1301
- 1817 m 23 6 d -20 15 d -24 -6 d f 1277 1811 m 24 6 d -21 15 d -23 -5 d f 1254
- 1805 m 23 6 d -20 16 d -24 -6 d f 1230 1799 m 24 6 d -21 16 d -23 -6 d f 1207
- 1793 m 23 6 d -20 16 d -24 -6 d f 1183 1787 m 24 6 d -21 16 d -23 -6 d f 1160
- 1781 m 23 6 d -20 16 d -24 -6 d f 1136 1775 m 24 6 d -21 16 d -23 -6 d f 1113
- 1769 m 23 6 d -20 16 d -23 -6 d f 1089 1763 m 24 6 d -20 16 d -24 -6 d f 1066
- 1757 m 23 6 d -20 16 d -23 -6 d f 1042 1751 m 24 6 d -20 16 d -24 -6 d f 1019
- 1745 m 23 6 d -20 16 d -23 -6 d f 995 1739 m 24 6 d -20 16 d -24 -6 d f 972
- 1733 m 23 6 d -20 16 d -23 -6 d f 948 1727 m 24 6 d -20 16 d -24 -6 d f 925
- 1721 m 23 6 d -20 16 d -23 -6 d f 901 1715 m 24 6 d -20 16 d -24 -6 d f 878
- 1709 m 23 6 d -20 16 d -23 -6 d f 854 1703 m 24 6 d -20 16 d -24 -6 d f 1955
- 1963 m 24 6 d -21 15 d -23 -6 d f 1932 1957 m 23 6 d -20 15 d -24 -6 d f 1908
- 1951 m 24 6 d -21 15 d -23 -6 d f 1885 1945 m 23 6 d -20 15 d -23 -6 d f 1861
- 1939 m 24 6 d -20 15 d -24 -6 d f 1838 1933 m 23 6 d -20 15 d -23 -5 d f 1814
- 1927 m 24 6 d -20 16 d -24 -6 d f 1791 1921 m 23 6 d -20 16 d -23 -6 d f 1767
- 1915 m 24 6 d -20 16 d -24 -6 d f 1744 1909 m 23 6 d -20 16 d -23 -6 d f 1720
- 1903 m 24 6 d -20 16 d -24 -6 d f 1697 1897 m 23 6 d -20 16 d -23 -6 d f 1673
- 1891 m 24 6 d -20 16 d -24 -6 d f 1650 1885 m 23 6 d -20 16 d -23 -6 d f 1626
- 1879 m 24 6 d -20 16 d -24 -6 d f 1603 1873 m 23 6 d -20 16 d -23 -6 d f 1579
- 1867 m 24 6 d -20 16 d -24 -6 d f 1556 1861 m 23 6 d -20 16 d -23 -6 d f 1533
- 1855 m 23 6 d -20 16 d -24 -6 d f 1509 1849 m 24 6 d -21 16 d -23 -6 d f 1486
- 1843 m 23 6 d -20 16 d -24 -6 d f 1462 1837 m 24 6 d -21 16 d -23 -6 d f 1439
- 1831 m 23 6 d -20 16 d -24 -6 d f 1415 1825 m 24 6 d -21 16 d -23 -6 d f 1392
- 1819 m 23 6 d -20 16 d -24 -6 d f 1368 1813 m 24 6 d -21 16 d -23 -6 d f 1345
- 1807 m 23 6 d -20 16 d -24 -6 d f 1321 1801 m 24 6 d -21 16 d -23 -6 d f 1298
- 1795 m 23 6 d -20 16 d -24 -6 d f 1274 1789 m 24 6 d -21 16 d -23 -6 d f 1251
- 1783 m 23 6 d -20 16 d -24 -6 d f 1227 1778 m 24 5 d -21 16 d -23 -6 d f 1204
- 1772 m 23 6 d -20 15 d -24 -6 d f 1180 1766 m 24 6 d -21 15 d -23 -6 d f 1157
- 1760 m 23 6 d -20 15 d -24 -6 d f 1133 1754 m 24 6 d -21 15 d -23 -6 d f 1110
- 1748 m 23 6 d -20 15 d -24 -6 d f 1086 1742 m 24 6 d -21 15 d -23 -6 d f 1063
- 1736 m 23 6 d -20 15 d -24 -6 d f 1039 1730 m 24 6 d -21 15 d -23 -6 d f 1016
- 1724 m 23 6 d -20 15 d -24 -6 d f 992 1718 m 24 6 d -21 15 d -23 -6 d f 969
- 1712 m 23 6 d -20 15 d -24 -6 d f 945 1706 m 24 6 d -21 15 d -23 -6 d f 922
- 1700 m 23 6 d -20 15 d -24 -6 d f 898 1694 m 24 6 d -21 15 d -23 -6 d f 875
- 1688 m 23 6 d -20 15 d -24 -6 d f black 875 694 m 23 6 d s 878 715 m 20 -15 d s
- 854 709 m 24 6 d s 854 709 m 21 -15 d s 898 700 m 24 6 d s 901 721 m 21 -15 d s
- 878 715 m 23 6 d s 922 706 m 23 5 d s 925 727 m 20 -16 d s 901 721 m 24 6 d s
- 945 711 m 24 6 d s 948 733 m 21 -16 d s 925 727 m 23 6 d s 969 717 m 23 6 d s
- 972 739 m 20 -16 d s 948 733 m 24 6 d s 992 723 m 24 6 d s 995 745 m 21 -16 d s
- 972 739 m 23 6 d s 1016 729 m 23 6 d s 1019 764 m 20 -29 d s 995 745 m 24 19 d
- s 1039 735 m 24 6 d s 1042 757 m 21 -16 d s 1019 764 m 23 -7 d s 1063 741 m 23
- 6 d s 1066 763 m 20 -16 d s 1042 757 m 24 6 d s 1086 747 m 24 6 d s 1089 769 m
- 21 -16 d s 1066 763 m 23 6 d s 1110 753 m 23 6 d s 1113 775 m 20 -16 d s 1089
- 769 m 24 6 d s 1133 759 m 24 6 d s 1136 781 m 21 -16 d s 1113 775 m 23 6 d s
- 1157 765 m 23 6 d s 1160 787 m 20 -16 d s 1136 781 m 24 6 d s 1180 771 m 24 6 d
- s 1183 793 m 21 -16 d s 1160 787 m 23 6 d s 1204 777 m 23 6 d s 1207 799 m 20
- -16 d s 1183 793 m 24 6 d s 1227 783 m 24 6 d s 1230 805 m 21 -16 d s 1207 799
- m 23 6 d s 1251 789 m 23 6 d s 1254 811 m 20 -16 d s 1230 805 m 24 6 d s 1274
- 795 m 24 6 d s 1277 817 m 21 -16 d s 1254 811 m 23 6 d s 1298 801 m 23 6 d s
- 1301 823 m 20 -16 d s 1277 817 m 24 6 d s 1321 807 m 24 6 d s 1324 829 m 21 -16
- d s 1301 823 m 23 6 d s 1345 813 m 23 6 d s 1348 835 m 20 -16 d s 1324 829 m 24
- 6 d s 1368 819 m 24 6 d s 1371 841 m 21 -16 d s 1348 835 m 23 6 d s 1392 825 m
- 23 6 d s 1395 847 m 20 -16 d s 1371 841 m 24 6 d s 1415 831 m 24 6 d s 1418 853
- m 21 -16 d s 1395 847 m 23 6 d s 1439 837 m 23 6 d s 1442 859 m 20 -16 d s 1418
- 853 m 24 6 d s 1462 843 m 24 6 d s 1465 865 m 21 -16 d s 1442 859 m 23 6 d s
- 1486 849 m 23 6 d s 1489 884 m 20 -29 d s 1465 865 m 24 19 d s 1509 855 m 24 6
- d s 1512 877 m 21 -16 d s 1489 884 m 23 -7 d s 1533 861 m 23 6 d s 1536 882 m
- 20 -15 d s 1512 877 m 24 5 d s 1556 867 m 23 19 d s 1559 888 m 20 -2 d s 1536
- 882 m 23 6 d s 1579 886 m 24 -7 d s 1583 894 m 20 -15 d s 1559 888 m 24 6 d s
- 1603 879 m 23 6 d s 1606 900 m 20 -15 d s 1583 894 m 23 6 d s 1626 885 m 24 6 d
- s 1630 906 m 20 -15 d s 1606 900 m 24 6 d s 1650 891 m 23 6 d s 1653 912 m 20
- -15 d s 1630 906 m 23 6 d s 1673 897 m 24 6 d s 1677 918 m 20 -15 d s 1653 912
- m 24 6 d s 1697 903 m 23 6 d s 1700 924 m 20 -15 d s 1677 918 m 23 6 d s 1720
- 909 m 24 6 d s 1724 930 m 20 -15 d s 1700 924 m 24 6 d s 1744 915 m 23 6 d s
- 1747 936 m 20 -15 d s 1724 930 m 23 6 d s 1767 921 m 24 6 d s 1771 942 m 20 -15
- d s 1747 936 m 24 6 d s 1791 927 m 23 6 d s 1794 948 m 20 -15 d s 1771 942 m 23
- 6 d s 1814 933 m 24 19 d s 1818 954 m 20 -2 d s 1794 948 m 24 6 d s 1838 952 m
- 23 -7 d s 1841 960 m 20 -15 d s 1818 954 m 23 6 d s 1861 945 m 24 6 d s 1865
- 966 m 20 -15 d s 1841 960 m 24 6 d s 1885 951 m 23 6 d s 1888 972 m 20 -15 d s
- 1865 966 m 23 6 d s 1908 957 m 24 6 d s 1911 978 m 21 -15 d s 1888 972 m 23 6 d
- s 1932 963 m 23 6 d s 1935 984 m 20 -15 d s 1911 978 m 24 6 d s 1955 969 m 24 6
- d s 1958 990 m 21 -15 d s 1935 984 m 23 6 d s 858 731 m 20 -16 d s 834 725 m 24
- 6 d s 834 725 m 20 -16 d s 881 737 m 20 -16 d s 858 731 m 23 6 d s 905 743 m 20
- -16 d s 881 737 m 24 6 d s 928 749 m 20 -16 d s 905 743 m 23 6 d s 952 755 m 20
- -16 d s 928 749 m 24 6 d s 975 760 m 20 -15 d s 952 755 m 23 5 d s 999 766 m 20
- -2 d s 975 760 m 24 6 d s 1022 772 m 20 -15 d s 999 766 m 23 6 d s 1046 778 m
- 20 -15 d s 1022 772 m 24 6 d s 1069 784 m 20 -15 d s 1046 778 m 23 6 d s 1093
- 790 m 20 -15 d s 1069 784 m 24 6 d s 1116 796 m 20 -15 d s 1093 790 m 23 6 d s
- 1139 802 m 21 -15 d s 1116 796 m 23 6 d s 1163 808 m 20 -15 d s 1139 802 m 24 6
- d s 1186 814 m 21 -15 d s 1163 808 m 23 6 d s 1210 820 m 20 -15 d s 1186 814 m
- 24 6 d s 1233 826 m 21 -15 d s 1210 820 m 23 6 d s 1257 846 m 20 -29 d s 1233
- 826 m 24 20 d s 1280 838 m 21 -15 d s 1257 846 m 23 -8 d s 1304 844 m 20 -15 d
- s 1280 838 m 24 6 d s 1327 850 m 21 -15 d s 1304 844 m 23 6 d s 1351 870 m 20
- -29 d s 1327 850 m 24 20 d s 1374 862 m 21 -15 d s 1351 870 m 23 -8 d s 1398
- 868 m 20 -15 d s 1374 862 m 24 6 d s 1421 874 m 21 -15 d s 1398 868 m 23 6 d s
- 1445 880 m 20 -15 d s 1421 874 m 24 6 d s 1468 886 m 21 -2 d s 1445 880 m 23 6
- d s 1492 892 m 20 -15 d s 1468 886 m 24 6 d s 1515 898 m 21 -16 d s 1492 892 m
- 23 6 d s 1539 904 m 20 -16 d s 1515 898 m 24 6 d s 1562 910 m 21 -16 d s 1539
- 904 m 23 6 d s 1586 916 m 20 -16 d s 1562 910 m 24 6 d s 1609 922 m 21 -16 d s
- 1586 916 m 23 6 d s 1633 928 m 20 -16 d s 1609 922 m 24 6 d s 1656 934 m 21 -16
- d s 1633 928 m 23 6 d s 1680 940 m 20 -16 d s 1656 934 m 24 6 d s 1703 946 m 21
- -16 d s 1680 940 m 23 6 d s 1727 952 m 20 -16 d s 1703 946 m 24 6 d s 1750 971
- m 21 -29 d s 1727 952 m 23 19 d s 1774 964 m 20 -16 d s 1750 971 m 24 -7 d s
- 1797 970 m 21 -16 d s 1774 964 m 23 6 d s 1821 976 m 20 -16 d s 1797 970 m 24 6
- d s 1844 982 m 21 -16 d s 1821 976 m 23 6 d s 1868 988 m 20 -16 d s 1844 982 m
- 24 6 d s 1891 994 m 20 -16 d s 1868 988 m 23 6 d s 1915 1000 m 20 -16 d s 1891
- 994 m 24 6 d s 1938 1006 m 20 -16 d s 1915 1000 m 23 6 d s 837 746 m 21 -15 d s
- 814 740 m 23 6 d s 814 740 m 20 -15 d s 861 752 m 20 -15 d s 837 746 m 24 6 d s
- 884 758 m 21 -15 d s 861 752 m 23 6 d s 908 764 m 20 -15 d s 884 758 m 24 6 d s
- 931 770 m 21 -15 d s 908 764 m 23 6 d s 955 776 m 20 -16 d s 931 770 m 24 6 d s
- 978 782 m 21 -16 d s 955 776 m 23 6 d s 1002 788 m 20 -16 d s 978 782 m 24 6 d
- s 1025 807 m 21 -29 d s 1002 788 m 23 19 d s 1049 800 m 20 -16 d s 1025 807 m
- 24 -7 d s 1072 819 m 21 -29 d s 1049 800 m 23 19 d s 1096 812 m 20 -16 d s 1072
- 819 m 24 -7 d s 1119 818 m 20 -16 d s 1096 812 m 23 6 d s 1143 824 m 20 -16 d s
- 1119 818 m 24 6 d s 1166 843 m 20 -29 d s 1143 824 m 23 19 d s 1190 836 m 20
- -16 d s 1166 843 m 24 -7 d s 1213 842 m 20 -16 d s 1190 836 m 23 6 d s 1237 861
- m 20 -15 d s 1213 842 m 24 19 d s 1260 854 m 20 -16 d s 1237 861 m 23 -7 d s
- 1284 860 m 20 -16 d s 1260 854 m 24 6 d s 1307 866 m 20 -16 d s 1284 860 m 23 6
- d s 1331 872 m 20 -2 d s 1307 866 m 24 6 d s 1354 878 m 20 -16 d s 1331 872 m
- 23 6 d s 1378 884 m 20 -16 d s 1354 878 m 24 6 d s 1401 917 m 20 -43 d s 1378
- 884 m 23 33 d s 1425 909 m 20 -29 d s 1401 917 m 24 -8 d s 1448 902 m 20 -16 d
- s 1425 909 m 23 -7 d s 1471 921 m 21 -29 d s 1448 902 m 23 19 d s 1495 914 m 20
- -16 d s 1471 921 m 24 -7 d s 1518 933 m 21 -29 d s 1495 914 m 23 19 d s 1542
- 926 m 20 -16 d s 1518 933 m 24 -7 d s 1565 932 m 21 -16 d s 1542 926 m 23 6 d s
- 1589 937 m 20 -15 d s 1565 932 m 24 5 d s 1612 943 m 21 -15 d s 1589 937 m 23 6
- d s 1636 949 m 20 -15 d s 1612 943 m 24 6 d s 1659 955 m 21 -15 d s 1636 949 m
- 23 6 d s 1683 988 m 20 -42 d s 1659 955 m 24 33 d s 1706 967 m 21 -15 d s 1683
- 988 m 23 -21 d s 1730 973 m 20 -2 d s 1706 967 m 24 6 d s 1753 993 m 21 -29 d s
- 1730 973 m 23 20 d s 1777 999 m 20 -29 d s 1753 993 m 24 6 d s 1800 991 m 21
- -15 d s 1777 999 m 23 -8 d s 1824 997 m 20 -15 d s 1800 991 m 24 6 d s 1847
- 1003 m 21 -15 d s 1824 997 m 23 6 d s 1871 1009 m 20 -15 d s 1847 1003 m 24 6 d
- s 1894 1015 m 21 -15 d s 1871 1009 m 23 6 d s 1918 1021 m 20 -15 d s 1894 1015
- m 24 6 d s 817 762 m 20 -16 d s 793 756 m 24 6 d s 793 756 m 21 -16 d s 840 768
- m 21 -16 d s 817 762 m 23 6 d s 864 774 m 20 -16 d s 840 768 m 24 6 d s 887 780
- m 21 -16 d s 864 774 m 23 6 d s 911 786 m 20 -16 d s 887 780 m 24 6 d s 934 792
- m 21 -16 d s 911 786 m 23 6 d s 958 798 m 20 -16 d s 934 792 m 24 6 d s 981 804
- m 21 -16 d s 958 798 m 23 6 d s 1005 810 m 20 -3 d s 981 804 m 24 6 d s 1028
- 815 m 21 -15 d s 1005 810 m 23 5 d s 1052 862 m 20 -43 d s 1028 815 m 24 47 d s
- 1075 827 m 21 -15 d s 1052 862 m 23 -35 d s 1099 833 m 20 -15 d s 1075 827 m 24
- 6 d s 1122 853 m 21 -29 d s 1099 833 m 23 20 d s 1146 859 m 20 -16 d s 1122 853
- m 24 6 d s 1169 851 m 21 -15 d s 1146 859 m 23 -8 d s 1193 857 m 20 -15 d s
- 1169 851 m 24 6 d s 1216 877 m 21 -16 d s 1193 857 m 23 20 d s 1240 883 m 20
- -29 d s 1216 877 m 24 6 d s 1263 889 m 21 -29 d s 1240 883 m 23 6 d s 1287 881
- m 20 -15 d s 1263 889 m 24 -8 d s 1310 928 m 21 -56 d s 1287 881 m 23 47 d s
- 1334 920 m 20 -42 d s 1310 928 m 24 -8 d s 1357 926 m 21 -42 d s 1334 920 m 23
- 6 d s 1381 945 m 20 -28 d s 1357 926 m 24 19 d s 1404 925 m 21 -16 d s 1381 945
- m 23 -20 d s 1428 917 m 20 -15 d s 1404 925 m 24 -8 d s 1451 937 m 20 -16 d s
- 1428 917 m 23 20 d s 1475 943 m 20 -29 d s 1451 937 m 24 6 d s 1498 935 m 20 -2
- d s 1475 943 m 23 -8 d s 1522 941 m 20 -15 d s 1498 935 m 24 6 d s 1545 947 m
- 20 -15 d s 1522 941 m 23 6 d s 1569 953 m 20 -16 d s 1545 947 m 24 6 d s 1592
- 972 m 20 -29 d s 1569 953 m 23 19 d s 1616 978 m 20 -29 d s 1592 972 m 24 6 d s
- 1639 971 m 20 -16 d s 1616 978 m 23 -7 d s 1663 977 m 20 11 d s 1639 971 m 24 6
- d s 1710 989 m 20 -16 d s 1687 983 m 23 6 d s 1733 1008 m 20 -15 d s 1710 989 m
- 23 19 d s 1757 1001 m 20 -2 d s 1733 1008 m 24 -7 d s 1780 1020 m 20 -29 d s
- 1757 1001 m 23 19 d s 1803 1026 m 21 -29 d s 1780 1020 m 23 6 d s 1827 1019 m
- 20 -16 d s 1803 1026 m 24 -7 d s 1850 1025 m 21 -16 d s 1827 1019 m 23 6 d s
- 1874 1031 m 20 -16 d s 1850 1025 m 24 6 d s 1897 1037 m 21 -16 d s 1874 1031 m
- 23 6 d s 797 777 m 20 -15 d s 773 771 m 24 6 d s 773 771 m 20 -15 d s 820 783 m
- 20 -15 d s 797 777 m 23 6 d s 844 789 m 20 -15 d s 820 783 m 24 6 d s 867 822 m
- 20 -42 d s 844 789 m 23 33 d s 891 841 m 20 -55 d s 867 822 m 24 19 d s 914 821
- m 20 -29 d s 891 841 m 23 -20 d s 938 827 m 20 -29 d s 914 821 m 24 6 d s 961
- 859 m 20 -55 d s 938 827 m 23 32 d s 985 852 m 20 -42 d s 961 859 m 24 -7 d s
- 1008 871 m 20 -56 d s 985 852 m 23 19 d s 1031 864 m 21 -2 d s 1008 871 m 23 -7
- d s 1055 870 m 20 -43 d s 1031 864 m 24 6 d s 1078 876 m 21 -43 d s 1055 870 m
- 23 6 d s 1102 882 m 20 -29 d s 1078 876 m 24 6 d s 1125 888 m 21 -29 d s 1102
- 882 m 23 6 d s 1149 880 m 20 -29 d s 1125 888 m 24 -8 d s 1172 900 m 21 -43 d s
- 1149 880 m 23 20 d s 1196 906 m 20 -29 d s 1172 900 m 24 6 d s 1219 898 m 21
- -15 d s 1196 906 m 23 -8 d s 1243 931 m 20 -42 d s 1219 898 m 24 33 d s 1266
- 910 m 21 -29 d s 1243 931 m 23 -21 d s 1290 916 m 20 12 d s 1266 910 m 24 6 d s
- 1313 936 m 21 -16 d s 1290 916 m 23 20 d s 1360 948 m 21 -3 d s 1342 922 m 18
- 26 d s 1407 933 m 21 -16 d s 1389 938 m 18 -5 d s 1431 966 m 20 -29 d s 1407
- 933 m 24 33 d s 1454 958 m 21 -15 d s 1431 966 m 23 -8 d s 1478 977 m 20 -42 d
- s 1454 958 m 24 19 d s 1501 970 m 21 -29 d s 1478 977 m 23 -7 d s 1525 963 m 20
- -16 d s 1501 970 m 24 -7 d s 1548 995 m 21 -42 d s 1525 963 m 23 32 d s 1572
- 1001 m 20 -29 d s 1548 995 m 24 6 d s 1595 994 m 21 -16 d s 1572 1001 m 23 -7 d
- s 1619 1013 m 20 -42 d s 1595 994 m 24 19 d s 1642 1033 m 21 -56 d s 1619 1013
- m 23 20 d s 1666 998 m 14 -11 d s 1642 1033 m 24 -35 d s 1689 1018 m 21 -29 d s
- 1666 998 m 23 20 d s 1713 1051 m 20 -43 d s 1689 1018 m 24 33 d s 1736 1016 m
- 21 -15 d s 1713 1051 m 23 -35 d s 1760 1022 m 20 -2 d s 1736 1016 m 24 6 d s
- 1783 1109 m 20 -83 d s 1760 1022 m 23 87 d s 1807 1034 m 20 -15 d s 1783 1109 m
- 24 -75 d s 1830 1040 m 20 -15 d s 1807 1034 m 23 6 d s 1854 1046 m 20 -15 d s
- 1830 1040 m 24 6 d s 1877 1052 m 20 -15 d s 1854 1046 m 23 6 d s 776 793 m 21
- -16 d s 753 787 m 23 6 d s 753 787 m 20 -16 d s 800 799 m 20 -16 d s 776 793 m
- 24 6 d s 823 805 m 21 -16 d s 800 799 m 23 6 d s 847 851 m 20 -29 d s 823 805 m
- 24 46 d s 870 857 m 21 -16 d s 847 851 m 23 6 d s 894 876 m 20 -55 d s 870 857
- m 24 19 d s 917 896 m 21 -69 d s 894 876 m 23 20 d s 941 848 m 20 11 d s 917
- 896 m 24 -48 d s 988 873 m 20 -2 d s 968 857 m 20 16 d s 1011 920 m 20 -56 d s
- 988 873 m 23 47 d s 1035 912 m 20 -42 d s 1011 920 m 24 -8 d s 1058 905 m 20
- -29 d s 1035 912 m 23 -7 d s 1082 938 m 20 -56 d s 1058 905 m 24 33 d s 1105
- 930 m 20 -42 d s 1082 938 m 23 -8 d s 1129 923 m 20 -43 d s 1105 930 m 24 -7 d
- s 1152 929 m 20 -29 d s 1129 923 m 23 6 d s 1176 908 m 20 -2 d s 1152 929 m 24
- -21 d s 1199 914 m 20 -16 d s 1176 908 m 23 6 d s 1223 960 m 20 -29 d s 1199
- 914 m 24 46 d s 1246 1006 m 20 -96 d s 1223 960 m 23 46 d s 1270 972 m 20 -56 d
- s 1246 1006 m 24 -34 d s 1293 991 m 20 -55 d s 1270 972 m 23 19 d s 1317 997 m
- 18 -77 d s 1293 991 m 24 6 d s 1340 990 m 20 -42 d s 1317 997 m 23 -7 d s 1363
- 956 m 13 -10 d s 1340 990 m 23 -34 d s 1387 975 m 20 -42 d s 1363 956 m 24 19 d
- s 1410 994 m 21 -28 d s 1387 975 m 23 19 d s 1434 987 m 20 -29 d s 1410 994 m
- 24 -7 d s 1457 980 m 21 -3 d s 1434 987 m 23 -7 d s 1481 999 m 20 -29 d s 1457
- 980 m 24 19 d s 1504 1059 m 21 -96 d s 1481 999 m 23 60 d s 1528 1038 m 20 -43
- d s 1504 1059 m 24 -21 d s 1551 1017 m 21 -16 d s 1528 1038 m 23 -21 d s 1575
- 1050 m 20 -56 d s 1551 1017 m 24 33 d s 1598 1083 m 21 -70 d s 1575 1050 m 23
- 33 d s 1622 1035 m 20 -2 d s 1598 1083 m 24 -48 d s 1645 1068 m 21 -70 d s 1622
- 1035 m 23 33 d s 1669 1074 m 20 -56 d s 1645 1068 m 24 6 d s 1692 1066 m 21 -15
- d s 1669 1074 m 23 -8 d s 1716 1072 m 20 -56 d s 1692 1066 m 24 6 d s 1739 1078
- m 21 -56 d s 1716 1072 m 23 6 d s 1763 1098 m 20 11 d s 1739 1078 m 24 20 d s
- 1810 1056 m 20 -16 d s 1800 1053 m 10 3 d s 1833 1062 m 21 -16 d s 1810 1056 m
- 23 6 d s 1857 1068 m 20 -16 d s 1833 1062 m 24 6 d s 756 808 m 20 -15 d s 732
- 802 m 24 6 d s 732 802 m 21 -15 d s 779 814 m 21 -15 d s 756 808 m 23 6 d s 803
- 820 m 20 -15 d s 779 814 m 24 6 d s 826 880 m 21 -29 d s 803 820 m 23 60 d s
- 850 913 m 20 -56 d s 826 880 m 24 33 d s 873 905 m 21 -29 d s 850 913 m 23 -8 d
- s 897 884 m 20 12 d s 873 905 m 24 -21 d s 920 904 m 21 -56 d s 897 884 m 23 20
- d s 944 977 m 19 -119 d s 920 904 m 24 73 d s 967 956 m 21 -83 d s 944 977 m 23
- -21 d s 991 989 m 20 -69 d s 967 956 m 24 33 d s 1038 920 m 20 -15 d s 1030 914
- m 8 6 d s 1061 1020 m 21 -82 d s 1038 920 m 23 100 d s 1085 986 m 20 -56 d s
- 1061 1020 m 24 -34 d s 1108 992 m 21 -69 d s 1085 986 m 23 6 d s 1132 985 m 20
- -56 d s 1108 992 m 24 -7 d s 1155 977 m 21 -69 d s 1132 985 m 23 -8 d s 1179
- 943 m 20 -29 d s 1155 977 m 24 -34 d s 1202 1029 m 21 -69 d s 1179 943 m 23 86
- d s 1226 1022 m 20 -16 d s 1202 1029 m 24 -7 d s 1273 1047 m 20 -56 d s 1255
- 992 m 18 55 d s 1296 1040 m 21 -43 d s 1273 1047 m 23 -7 d s 1320 1059 m 20 -69
- d s 1296 1040 m 24 19 d s 1343 1025 m 20 -69 d s 1320 1059 m 23 -34 d s 1367
- 1004 m 20 -29 d s 1343 1025 m 24 -21 d s 1390 1010 m 20 -16 d s 1367 1004 m 23
- 6 d s 1414 1097 m 20 -110 d s 1390 1010 m 24 87 d s 1437 1049 m 20 -69 d s 1414
- 1097 m 23 -48 d s 1461 1082 m 20 -83 d s 1437 1049 m 24 33 d s 1484 1007 m 20
- 52 d s 1461 1082 m 23 -75 d s 1531 1100 m 20 -83 d s 1515 1049 m 16 51 d s 1555
- 1092 m 20 -42 d s 1531 1100 m 24 -8 d s 1578 1058 m 20 25 d s 1555 1092 m 23
- -34 d s 1602 1104 m 20 -69 d s 1578 1058 m 24 46 d s 1625 1097 m 20 -29 d s
- 1602 1104 m 23 -7 d s 1648 1076 m 21 -2 d s 1625 1097 m 23 -21 d s 1672 1082 m
- 20 -16 d s 1648 1076 m 24 6 d s [4 8] 0 sd 1688 1180 m 14 -3 d s [] 0 sd 1695
- 1222 m 21 -150 d s 1672 1082 m 23 140 d s [4 8] 0 sd 1702 1177 m 1 7 d s
- [] 0 sd 1719 1107 m 20 -29 d s 1695 1222 m 24 -115 d s 1742 1100 m 21 -2 d s
- 1719 1107 m 23 -7 d s 1797 1066 m 13 -10 d s 1813 1077 m 20 -15 d s 1795 1073 m
- 18 4 d s 1836 1083 m 21 -15 d s 1813 1077 m 23 6 d s 736 824 m 20 -16 d s 712
- 818 m 24 6 d s 712 818 m 20 -16 d s 759 830 m 20 -16 d s 736 824 m 23 6 d s 783
- 836 m 20 -16 d s 759 830 m 24 6 d s 806 963 m 20 -83 d s 783 836 m 23 127 d s
- 830 888 m 20 25 d s 806 963 m 24 -75 d s 853 948 m 20 -43 d s 830 888 m 23 60 d
- s 877 981 m 20 -97 d s 853 948 m 24 33 d s 900 1000 m 20 -96 d s 877 981 m 23
- 19 d s 923 966 m 21 11 d s 900 1000 m 23 -34 d s [4 8] 0 sd 934 1009 m 25 -6 d
- s [] 0 sd 947 1066 m 20 -110 d s 923 966 m 24 100 d s [4 8] 0 sd 959 1006 m 4
- 10 d s [] 0 sd 970 991 m 21 -2 d s 947 1066 m 23 -75 d s 994 997 m 14 -65 d s
- 970 991 m 24 6 d s [4 8] 0 sd 1001 1026 m 25 -3 d s [] 0 sd 1017 1097 m 21 -177
- d s 994 997 m 23 100 d s [4 8] 0 sd 1027 1023 m 34 -3 d s [] 0 sd 1041 1049 m
- 20 -29 d s 1017 1097 m 24 -48 d s [4 8] 0 sd 1061 1020 m 15 13 d s [] 0 sd 1064
- 1096 m 21 -110 d s 1041 1049 m 23 47 d s [4 8] 0 sd 1076 1033 m 12 15 d s
- [] 0 sd 1088 1048 m 20 -56 d s 1064 1096 m 24 -48 d s 1111 1054 m 21 -69 d s
- 1088 1048 m 23 6 d s [4 8] 0 sd 1111 1054 m 32 X s [] 0 sd 1135 1100 m 20 -123
- d s 1111 1054 m 24 46 d s [4 8] 0 sd 1143 1054 m 19 9 d s [] 0 sd 1158 1093 m
- 21 -150 d s 1135 1100 m 23 -7 d s [4 8] 0 sd 1162 1063 m 30 1 d s [] 0 sd 1182
- 1099 m 20 -70 d s 1158 1093 m 24 6 d s [4 8] 0 sd 1192 1068 m -1 6 d s [] 0 sd
- 1205 1037 m 21 -15 d s 1182 1099 m 23 -62 d s 1229 1043 m 9 -31 d s 1205 1037 m
- 24 6 d s [4 8] 0 sd 1243 1087 m 20 -5 d s [] 0 sd 1252 1117 m 21 -70 d s 1229
- 1043 m 23 74 d s [4 8] 0 sd 1263 1082 m 27 3 d s [] 0 sd 1276 1190 m 20 -150 d
- s 1252 1117 m 24 73 d s [4 8] 0 sd 1290 1085 m 9 17 d s [] 0 sd 1299 1102 m 21
- -43 d s 1276 1190 m 23 -88 d s 1323 1067 m 20 -42 d s 1299 1102 m 24 -35 d s
- 1346 1073 m 21 -69 d s 1323 1067 m 23 6 d s 1370 1039 m 20 -29 d s 1346 1073 m
- 24 -34 d s 1393 1099 m 21 -2 d s 1370 1039 m 23 60 d s 1440 1057 m 21 25 d s
- 1427 1069 m 13 -12 d s [4 8] 0 sd 1460 1143 m 6 -1 d s [] 0 sd 1464 1157 m 20
- -150 d s 1440 1057 m 24 100 d s [4 8] 0 sd 1466 1142 m 9 5 d s [] 0 sd 1487
- 1136 m 15 -80 d s 1464 1157 m 23 -21 d s 1511 1129 m 20 -29 d s 1487 1136 m 24
- -7 d s 1534 1161 m 21 -69 d s 1511 1129 m 23 32 d s [4 8] 0 sd 1534 1161 m 26 5
- d s [] 0 sd 1558 1181 m 20 -123 d s 1534 1161 m 24 20 d s [4 8] 0 sd 1560 1166
- m 4 3 d s [] 0 sd 1581 1133 m 21 -29 d s 1558 1181 m 23 -48 d s [4 8] 0 sd 1590
- 1176 m 25 -4 d s [] 0 sd 1605 1247 m 20 -150 d s 1581 1133 m 24 114 d s
- [4 8] 0 sd 1615 1172 m 18 10 d s [] 0 sd 1628 1212 m 20 -136 d s 1605 1247 m 23
- -35 d s [4 8] 0 sd 1633 1182 m 7 6 d s [] 0 sd 1652 1165 m 20 -83 d s 1628 1212
- m 24 -47 d s [4 8] 0 sd 1683 1191 m 4 -8 d s [] 0 sd 1675 1170 m 20 52 d s 1652
- 1165 m 23 5 d s [4 8] 0 sd 1701 1184 m 2 X s 1710 1206 m 15 1 d s [] 0 sd 1722
- 1223 m 20 -123 d s 1700 1192 m 22 31 d s [4 8] 0 sd 1725 1207 m -1 3 d s
- [] 0 sd 1722 1223 m 21 -123 d s 1793 1093 m 20 -16 d s 1788 1092 m 5 1 d s 1816
- 1099 m 20 -16 d s 1793 1093 m 23 6 d s 715 839 m 21 -15 d s 692 833 m 23 6 d s
- 692 833 m 20 -15 d s 739 845 m 20 -15 d s 715 839 m 24 6 d s 762 851 m 21 -15 d
- s 739 845 m 23 6 d s [4 8] 0 sd 774 989 m 30 -11 d s [] 0 sd 786 1126 m 20 -163
- d s 762 851 m 24 275 d s [4 8] 0 sd 805 978 m 13 13 d s [] 0 sd 809 1065 m 21
- -177 d s 786 1126 m 23 -61 d s [4 8] 0 sd 818 991 m 20 9 d s [] 0 sd 833 1017 m
- 20 -69 d s 809 1065 m 24 -48 d s [4 8] 0 sd 838 1000 m 36 -4 d s [] 0 sd 856
- 1117 m 21 -136 d s 833 1017 m 23 100 d s [4 8] 0 sd 875 996 m 25 4 d s [] 0 sd
- 880 1069 m 20 -69 d s 856 1117 m 24 -48 d s [4 8] 0 sd 900 1000 m 18 10 d s
- [] 0 sd 903 1142 m 20 -176 d s 880 1069 m 23 73 d s [4 8] 0 sd 927 1028 m 7 -19
- d s [] 0 sd 927 1028 m 20 38 d s 903 1142 m 24 -114 d s [4 8] 0 sd 963 1016 m 4
- 5 d s [] 0 sd 950 1154 m 20 -163 d s 927 1028 m 23 126 d s [4 8] 0 sd 967 1021
- m 21 7 d s [] 0 sd 974 1107 m 20 -110 d s 950 1154 m 24 -47 d s [4 8] 0 sd 989
- 1028 m 12 -2 d s [] 0 sd 997 1099 m 20 -2 d s 974 1107 m 23 -8 d s 1044 1138 m
- 20 -42 d s 1026 1081 m 18 57 d s 1091 1056 m 20 -2 d s 1077 1068 m 14 -12 d s
- [4 8] 0 sd 1095 1070 m 16 -16 d s [] 0 sd 1115 1143 m 20 -43 d s 1091 1056 m 24
- 87 d s 1138 1216 m 20 -123 d s 1115 1143 m 23 73 d s 1162 1114 m 20 -15 d s
- 1138 1216 m 24 -102 d s [4 8] 0 sd 1191 1074 m 4 12 d s [] 0 sd 1185 1134 m 20
- -97 d s 1162 1114 m 23 20 d s [4 8] 0 sd 1195 1086 m 22 7 d s [] 0 sd 1209 1126
- m 20 -83 d s 1185 1134 m 24 -8 d s [4 8] 0 sd 1217 1093 m 26 -6 d s [] 0 sd
- 1232 1146 m 20 -29 d s 1209 1126 m 23 20 d s 1255 1192 m 21 -2 d s 1232 1146 m
- 23 46 d s 1279 1184 m 20 -82 d s 1275 1186 m 4 -2 d s [4 8] 0 sd 1299 1102 m 19
- 9 d s [] 0 sd 1302 1258 m 21 -191 d s 1279 1184 m 23 74 d s [4 8] 0 sd 1318
- 1111 m 21 8 d s [] 0 sd 1326 1196 m 20 -123 d s 1302 1258 m 24 -62 d s
- [4 8] 0 sd 1339 1119 m 21 8 d s [] 0 sd 1349 1229 m 21 -190 d s 1326 1196 m 23
- 33 d s [4 8] 0 sd 1361 1127 m 25 4 d s [] 0 sd 1373 1195 m 20 -96 d s 1349 1229
- m 24 -34 d s [4 8] 0 sd 1386 1131 m 22 7 d s [] 0 sd 1396 1214 m 18 -117 d s
- 1373 1195 m 23 19 d s [4 8] 0 sd 1409 1139 m 22 6 d s [] 0 sd 1420 1247 m 20
- -190 d s 1396 1214 m 24 33 d s [4 8] 0 sd 1431 1145 m 29 -2 d s [] 0 sd 1443
- 1226 m 21 -69 d s 1420 1247 m 23 -21 d s [4 8] 0 sd 1475 1147 m 9 5 d s [] 0 sd
- 1467 1246 m 20 -110 d s 1443 1226 m 24 20 d s [4 8] 0 sd 1484 1152 m 17 11 d s
- [] 0 sd 1490 1198 m 21 -69 d s 1467 1246 m 23 -48 d s [4 8] 0 sd 1501 1163 m 33
- -2 d s [] 0 sd 1514 1217 m 20 -56 d s 1490 1198 m 24 19 d s 1537 1290 m 21 -109
- d s 1514 1217 m 23 73 d s [4 8] 0 sd 1564 1169 m 13 8 d s 1553 1321 m 9 1 d s
- [] 0 sd 1561 1337 m 20 -204 d s 1537 1290 m 24 47 d s [4 8] 0 sd 1577 1177 m 12
- -1 d s 1562 1322 m 28 3 d s [] 0 sd 1584 1356 m 21 -109 d s 1561 1337 m 23 19 d
- s [4 8] 0 sd 1591 1326 m 5 6 d s [] 0 sd 1608 1308 m 20 -96 d s 1584 1356 m 24
- -48 d s [4 8] 0 sd 1640 1188 m 5 9 d s [] 0 sd 1631 1261 m 21 -96 d s 1608 1308
- m 23 -47 d s [4 8] 0 sd 1646 1197 m 25 4 d s [] 0 sd 1655 1307 m 20 -137 d s
- 1631 1261 m 24 46 d s [4 8] 0 sd 1671 1201 m 17 4 d s [] 0 sd 1678 1273 m 14
- -57 d s 1655 1307 m 23 -34 d s [4 8] 0 sd 1698 1206 m 12 X s [] 0 sd 1702 1292
- m 20 -69 d s 1678 1273 m 24 19 d s [4 8] 0 sd 1724 1210 m s [] 0 sd 1749 1102 m
- 5 -3 d s 1744 1101 m 5 1 d s 1772 1108 m 5 -3 d s 1787 1097 m 6 -4 d s 1749
- 1102 m 23 6 d s 1796 1114 m 20 -15 d s 1772 1108 m 24 6 d s 695 855 m 20 -16 d
- s 671 849 m 24 6 d s 671 849 m 21 -16 d s 718 861 m 21 -16 d s 695 855 m 23 6 d
- s 742 867 m 20 -16 d s 718 861 m 24 6 d s [4 8] 0 sd 751 1003 m 23 -14 d s 759
- 1140 m 27 -14 d s [] 0 sd 765 1236 m 21 -110 d s 742 867 m 23 369 d s
- [4 8] 0 sd 786 1126 m 10 16 d s [] 0 sd 789 1188 m 20 -123 d s 765 1236 m 24
- -48 d s [4 8] 0 sd 796 1142 m 5 9 d s [] 0 sd 812 1113 m 21 -96 d s 789 1188 m
- 23 -75 d s 836 1065 m 20 52 d s 812 1113 m 24 -48 d s [4 8] 0 sd 854 1164 m 10
- -2 d s [] 0 sd 859 1192 m 21 -123 d s 836 1065 m 23 127 d s [4 8] 0 sd 865 1162
- m 18 9 d s [] 0 sd 883 1171 m 20 -29 d s 859 1192 m 24 -21 d s [4 8] 0 sd 883
- 1171 m 30 1 d s [] 0 sd 906 1245 m 21 -217 d s 883 1171 m 23 74 d s [4 8] 0 sd
- 913 1172 m 17 11 d s [] 0 sd 930 1183 m 20 -29 d s 906 1245 m 24 -62 d s
- [4 8] 0 sd 967 1193 m 15 -2 d s [] 0 sd 977 1222 m 20 -123 d s 953 1149 m 24 73
- d s [4 8] 0 sd 982 1191 m 18 10 d s [] 0 sd 1000 1201 m 16 -104 d s 977 1222 m
- 23 -21 d s [4 8] 0 sd 1000 1201 m 31 1 d s [] 0 sd 1024 1234 m 20 -96 d s 1000
- 1201 m 24 33 d s [4 8] 0 sd 1032 1202 m 26 3 d s 1045 1347 m 3 X s [] 0 sd 1047
- 1361 m 19 -268 d s 1024 1234 m 23 127 d s [4 8] 0 sd 1079 1066 m 11 4 d s 1058
- 1205 m 19 9 d s 1049 1347 m 2 2 d s [] 0 sd 1071 1286 m 20 -230 d s 1047 1361 m
- 24 -75 d s [4 8] 0 sd 1091 1070 m 4 X s 1078 1216 m 3 6 d s [] 0 sd 1094 1145 m
- 21 -2 d s 1071 1286 m 23 -141 d s 1118 1231 m 20 -15 d s 1094 1145 m 24 86 d s
- 1141 1210 m 21 -96 d s 1140 1212 m 1 -2 d s 1165 1243 m 20 -109 d s 1141 1210 m
- 24 33 d s [4 8] 0 sd 1165 1243 m 29 2 d s [] 0 sd 1188 1289 m 21 -163 d s 1165
- 1243 m 23 46 d s [4 8] 0 sd 1194 1245 m 31 X s 1205 1388 m 10 -1 d s [] 0 sd
- 1212 1430 m 20 -284 d s 1188 1289 m 24 141 d s [4 8] 0 sd 1225 1245 m 8 16 d s
- 1215 1387 m 2 4 d s [] 0 sd 1235 1248 m 20 -56 d s 1212 1430 m 23 -182 d s 1259
- 1254 m 20 -70 d s 1235 1248 m 24 6 d s [4 8] 0 sd 1266 1269 m 36 -11 d s
- [] 0 sd 1282 1300 m 20 -42 d s 1259 1254 m 23 46 d s [4 8] 0 sd 1294 1276 m 8
- -18 d s [] 0 sd 1306 1252 m 20 -56 d s 1303 1257 m 3 -5 d s [4 8] 0 sd 1311
- 1281 m 32 -6 d s [] 0 sd 1329 1366 m 20 -137 d s 1306 1252 m 23 114 d s
- [4 8] 0 sd 1343 1276 m 4 14 d s [] 0 sd 1353 1264 m 20 -69 d s 1329 1366 m 24
- -102 d s [4 8] 0 sd 1364 1294 m 18 -1 d s [] 0 sd 1376 1324 m 20 -110 d s 1353
- 1264 m 23 60 d s [4 8] 0 sd 1383 1293 m 30 X s [] 0 sd 1400 1384 m 20 -137 d s
- 1376 1324 m 24 60 d s [4 8] 0 sd 1413 1293 m 7 15 d s [] 0 sd 1423 1296 m 20
- -70 d s 1400 1384 m 23 -88 d s [4 8] 0 sd 1426 1310 m 33 -4 d s [] 0 sd 1447
- 1396 m 20 -150 d s 1423 1296 m 24 100 d s [4 8] 0 sd 1459 1306 m 17 11 d s
- [] 0 sd 1470 1361 m 20 -163 d s 1447 1396 m 23 -35 d s [4 8] 0 sd 1476 1317 m
- 26 3 d s [] 0 sd 1494 1394 m 20 -177 d s 1470 1361 m 24 33 d s [4 8] 0 sd 1502
- 1322 m 3 8 d s [] 0 sd 1517 1266 m 20 24 d s 1494 1394 m 23 -128 d s [4 8] 0 sd
- 1553 1321 m s 1596 1334 m 2 9 d s [] 0 sd 1587 1378 m 21 -70 d s 1576 1349 m 11
- 29 d s [4 8] 0 sd 1598 1343 m s 1626 1361 m 20 -7 d s [] 0 sd 1634 1417 m 21
- -110 d s 1616 1294 m 18 123 d s [4 8] 0 sd 1646 1354 m 22 7 d s [] 0 sd 1658
- 1449 m 20 -176 d s 1634 1417 m 24 32 d s [4 8] 0 sd 1668 1361 m 19 9 d s
- [] 0 sd 1681 1402 m 21 -110 d s 1658 1449 m 23 -47 d s 1742 1108 m 7 -6 d s
- 1752 1124 m 20 -16 d s 1739 1121 m 13 3 d s 1775 1130 m 21 -16 d s 1752 1124 m
- 23 6 d s 675 870 m 20 -15 d s 651 864 m 24 6 d s 651 864 m 20 -15 d s 698 876 m
- 20 -15 d s 675 870 m 23 6 d s 722 882 m 20 -15 d s 698 876 m 24 6 d s
- [4 8] 0 sd 735 1020 m 16 -17 d s 751 1152 m 7 -11 d s [] 0 sd 745 1117 m 20 119
- d s 722 882 m 23 235 d s [4 8] 0 sd 750 1158 m 1 -3 d s [] 0 sd 769 1297 m 20
- -109 d s 745 1117 m 24 180 d s [4 8] 0 sd 800 1163 m 1 -12 d s [] 0 sd 792 1196
- m 20 -83 d s 769 1297 m 23 -101 d s [4 8] 0 sd 801 1163 m 26 3 d s [] 0 sd 815
- 1296 m 21 -231 d s 792 1196 m 23 100 d s [4 8] 0 sd 828 1166 m 26 -2 d s 819
- 1310 m 29 -1 d s [] 0 sd 839 1396 m 20 -204 d s 815 1296 m 24 100 d s
- [4 8] 0 sd 848 1309 m 23 6 d s [] 0 sd 862 1415 m 21 -244 d s 839 1396 m 23 19
- d s [4 8] 0 sd 872 1315 m 26 3 d s [] 0 sd 886 1435 m 20 -190 d s 862 1415 m 24
- 20 d s [4 8] 0 sd 898 1318 m -1 12 d s [] 0 sd 886 1435 m 21 -195 d s
- [4 8] 0 sd 930 1183 m 18 10 d s [] 0 sd 933 1326 m 20 -177 d s 912 1226 m 21
- 100 d s [4 8] 0 sd 948 1193 m 19 X s 937 1340 m 27 -1 d s [] 0 sd 956 1412 m 21
- -190 d s 933 1326 m 23 86 d s [4 8] 0 sd 964 1339 m 16 12 d s [] 0 sd 980 1351
- m 20 -150 d s 956 1412 m 24 -61 d s [4 8] 0 sd 980 1351 m 29 2 d s [] 0 sd 1003
- 1398 m 21 -164 d s 980 1351 m 23 47 d s [4 8] 0 sd 1037 1355 m 8 -8 d s [] 0 sd
- 1027 1350 m 20 11 d s 1003 1398 m 24 -48 d s [4 8] 0 sd 1050 1349 m 1 X s 1082
- 1222 m 3 10 d s [] 0 sd 1074 1348 m 20 -203 d s 1057 1334 m 17 14 d s
- [4 8] 0 sd 1085 1232 m 33 -1 d s [] 0 sd 1097 1368 m 21 -137 d s 1074 1348 m 23
- 20 d s [4 8] 0 sd 1118 1231 m 19 10 d s [] 0 sd 1121 1347 m 20 -137 d s 1097
- 1368 m 24 -21 d s [4 8] 0 sd 1137 1241 m 28 2 d s [] 0 sd 1144 1339 m 21 -96 d
- s 1121 1347 m 23 -8 d s 1168 1399 m 20 -110 d s 1144 1339 m 24 60 d s
- [4 8] 0 sd 1168 1399 m 35 -11 d s [] 0 sd 1191 1445 m 21 -15 d s 1168 1399 m 23
- 46 d s 1215 1398 m 20 -150 d s 1214 1399 m 1 -1 d s [4 8] 0 sd 1233 1264 m 5 19
- d s [] 0 sd 1238 1283 m 21 -29 d s 1215 1398 m 23 -115 d s [4 8] 0 sd 1238 1283
- m 28 -14 d s [] 0 sd 1262 1329 m 20 -29 d s 1238 1283 m 24 46 d s [4 8] 0 sd
- 1294 1276 m 6 8 d s [] 0 sd 1285 1362 m 21 -110 d s 1262 1329 m 23 33 d s
- [4 8] 0 sd 1300 1284 m 10 -3 d s [] 0 sd 1309 1422 m 20 -56 d s 1285 1362 m 24
- 60 d s [4 8] 0 sd 1347 1290 m 2 4 d s [] 0 sd 1332 1441 m 21 -177 d s 1309 1422
- m 23 19 d s [4 8] 0 sd 1349 1294 m 15 X s [] 0 sd 1356 1433 m 20 -109 d s 1332
- 1441 m 24 -8 d s 1379 1413 m 21 -29 d s 1356 1433 m 23 -20 d s [4 8] 0 sd 1418
- 1313 m 8 -3 d s [] 0 sd 1426 1398 m 21 -2 d s 1405 1368 m 21 30 d s 1473 1450 m
- 21 -56 d s 1459 1379 m 14 71 d s [4 8] 0 sd 1505 1330 m 2 11 d s [] 0 sd 1497
- 1416 m 20 -150 d s 1473 1450 m 24 -34 d s [4 8] 0 sd 1507 1341 m 26 4 d s
- [] 0 sd 1520 1462 m 18 -171 d s 1497 1416 m 23 46 d s [4 8] 0 sd 1533 1345 m 25
- 4 d s [] 0 sd 1544 1428 m 17 -93 d s 1520 1462 m 24 -34 d s [4 8] 0 sd 1558
- 1349 m 17 -1 d s [] 0 sd 1567 1460 m 20 -82 d s 1544 1428 m 23 32 d s
- [4 8] 0 sd 1594 1354 m 7 10 d s [] 0 sd 1591 1480 m 15 -163 d s 1567 1460 m 24
- 20 d s [4 8] 0 sd 1601 1364 m 25 -3 d s [] 0 sd 1614 1419 m 20 -2 d s 1591 1480
- m 23 -61 d s 1638 1425 m 20 24 d s 1614 1419 m 24 6 d s 1661 1525 m 20 -123 d s
- 1638 1425 m 23 100 d s 1737 1135 m 15 -11 d s 1755 1145 m 20 -15 d s 1736 1141
- m 19 4 d s 654 886 m 21 -16 d s 631 880 m 23 6 d s 631 880 m 20 -16 d s 678 892
- m 20 -16 d s 654 886 m 24 6 d s 701 898 m 21 -16 d s 678 892 m 23 6 d s
- [4 8] 0 sd 708 1034 m 27 -14 d s 714 1170 m 28 -10 d s 721 1306 m 10 -4 d s
- [] 0 sd 725 1388 m 20 -271 d s 701 898 m 24 490 d s [4 8] 0 sd 742 1160 m 8 -2
- d s 731 1302 m 38 -5 d s 740 1445 m 12 X s [] 0 sd 748 1474 m 21 -177 d s 725
- 1388 m 23 86 d s [4 8] 0 sd 769 1297 m 7 19 d s [] 0 sd 772 1346 m 20 -150 d s
- 748 1474 m 24 -128 d s [4 8] 0 sd 776 1316 m 36 -4 d s [] 0 sd 795 1392 m 20
- -96 d s 772 1346 m 23 46 d s [4 8] 0 sd 813 1312 m 6 -2 d s [] 0 sd 819 1452 m
- 20 -56 d s 795 1392 m 24 60 d s [4 8] 0 sd 830 1468 m 17 -1 d s [] 0 sd 842
- 1485 m 20 -70 d s 819 1452 m 23 33 d s [4 8] 0 sd 897 1330 m 2 11 d s [] 0 sd
- 889 1470 m 18 -232 d s 880 1429 m 9 41 d s [4 8] 0 sd 900 1341 m 31 X s 901
- 1486 m 13 2 d s [] 0 sd 913 1503 m 20 -177 d s 889 1470 m 24 33 d s [4 8] 0 sd
- 932 1341 m 4 -1 d s 915 1489 m 1 1 d s [] 0 sd 936 1415 m 20 -3 d s 913 1503 m
- 23 -88 d s 983 1507 m 20 -109 d s 965 1388 m 18 119 d s [4 8] 0 sd 1021 1362 m
- 3 3 d s [] 0 sd 1007 1473 m 20 -123 d s 983 1507 m 24 -34 d s [4 8] 0 sd 1024
- 1365 m 23 7 d s 1014 1515 m 23 -1 d s [] 0 sd 1030 1613 m 18 -253 d s 1007 1473
- m 23 140 d s [4 8] 0 sd 1047 1372 m 22 7 d s 1037 1514 m 9 9 d s [] 0 sd 1054
- 1485 m 20 -137 d s 1030 1613 m 24 -128 d s [4 8] 0 sd 1070 1379 m 23 5 d s
- [] 0 sd 1077 1450 m 20 -82 d s 1054 1485 m 23 -35 d s [4 8] 0 sd 1093 1384 m 19
- 10 d s [] 0 sd 1100 1456 m 21 -109 d s 1077 1450 m 23 6 d s [4 8] 0 sd 1113
- 1397 m 1 9 d s [] 0 sd 1124 1368 m 20 -29 d s 1100 1456 m 24 -88 d s [4 8] 0 sd
- 1131 1410 m 37 -11 d s [] 0 sd 1147 1509 m 21 -110 d s 1124 1368 m 23 141 d s
- 1171 1447 m 20 -2 d s 1147 1509 m 24 -62 d s [4 8] 0 sd 1212 1413 m s [] 0 sd
- 1194 1521 m 15 -90 d s 1171 1447 m 23 74 d s [4 8] 0 sd 1212 1413 m 13 14 d s
- [] 0 sd 1218 1500 m 20 -217 d s 1194 1521 m 24 -21 d s [4 8] 0 sd 1225 1427 m
- 27 4 d s [] 0 sd 1241 1533 m 21 -204 d s 1218 1500 m 23 33 d s [4 8] 0 sd 1253
- 1431 m 24 4 d s [] 0 sd 1265 1539 m 20 -177 d s 1241 1533 m 24 6 d s [4 8] 0 sd
- 1277 1435 m 30 1 d s 1283 1583 m 7 1 d s [] 0 sd 1288 1598 m 21 -176 d s 1265
- 1539 m 23 59 d s [4 8] 0 sd 1307 1455 m 25 -14 d s 1290 1584 m 1 Y s [] 0 sd
- 1288 1598 m 23 -175 d s [4 8] 0 sd 1332 1441 m 20 9 d s [] 0 sd 1335 1516 m 21
- -83 d s 1314 1425 m 21 91 d s [4 8] 0 sd 1352 1450 m 23 6 d s [] 0 sd 1359 1603
- m 20 -190 d s 1335 1516 m 24 87 d s [4 8] 0 sd 1375 1457 m 15 12 d s [] 0 sd
- 1382 1528 m 19 -146 d s 1359 1603 m 23 -75 d s [4 8] 0 sd 1390 1469 m 22 7 d s
- [] 0 sd 1406 1507 m 20 -109 d s 1382 1528 m 24 -21 d s [4 8] 0 sd 1412 1476 m
- 24 5 d s [] 0 sd 1429 1554 m 15 -158 d s 1406 1507 m 23 47 d s [4 8] 0 sd 1436
- 1481 m 35 -2 d s 1441 1624 m 18 -2 d s [] 0 sd 1453 1694 m 20 -244 d s 1429
- 1554 m 24 140 d s [4 8] 0 sd 1471 1479 m 19 9 d s 1460 1623 m 16 10 d s [] 0 sd
- 1476 1633 m 21 -217 d s 1453 1694 m 23 -61 d s [4 8] 0 sd 1490 1488 m 4 15 d s
- [] 0 sd 1500 1464 m 20 -2 d s 1476 1633 m 24 -169 d s [4 8] 0 sd 1505 1506 m 32
- -6 d s 1522 1644 m 3 X s [] 0 sd 1523 1658 m 21 -230 d s 1500 1464 m 23 194 d s
- [4 8] 0 sd 1537 1500 m 27 3 d s 1525 1644 m 31 X s [] 0 sd 1547 1785 m 20 -325
- d s 1523 1658 m 24 127 d s [4 8] 0 sd 1564 1503 m 23 7 d s 1556 1644 m 12 12 d
- s [] 0 sd 1570 1643 m 21 -163 d s 1547 1785 m 23 -142 d s [4 8] 0 sd 1587 1510
- m 11 15 d s [] 0 sd 1594 1555 m 20 -136 d s 1570 1643 m 24 -88 d s [4 8] 0 sd
- 1598 1525 m 32 X s 1615 1668 m 3 X s [] 0 sd 1617 1682 m 21 -257 d s 1594 1555
- m 23 127 d s [4 8] 0 sd 1630 1525 m 31 X s 1619 1668 m 30 X s [] 0 sd 1641 1769
- m 20 -244 d s 1617 1682 m 24 87 d s [4 8] 0 sd 1648 1669 m 1 -1 d s [] 0 sd
- 1735 1161 m 20 -16 d s 1733 1161 m 2 X s 634 901 m 20 -15 d s 610 896 m 24 5 d
- s 610 896 m 21 -16 d s 657 907 m 21 -15 d s 634 901 m 23 6 d s 681 913 m 20 -15
- d s 657 907 m 24 6 d s [4 8] 0 sd 687 1049 m 21 -15 d s 692 1185 m 22 -15 d s
- 698 1321 m 23 -15 d s 704 1457 m 4 -3 d s [] 0 sd 704 1470 m 21 -82 d s 681 913
- m 23 557 d s [4 8] 0 sd 710 1453 m 30 -8 d s [] 0 sd 728 1517 m 20 -43 d s 704
- 1470 m 24 47 d s [4 8] 0 sd 754 1450 m 9 10 d s 748 1602 m 4 X s [] 0 sd 751
- 1617 m 21 -271 d s 728 1517 m 23 100 d s [4 8] 0 sd 763 1460 m 28 3 d s 753
- 1602 m 28 2 d s [] 0 sd 775 1703 m 20 -311 d s 751 1617 m 24 86 d s [4 8] 0 sd
- 791 1463 m 1 16 d s 781 1604 m 1 7 d s [] 0 sd 775 1703 m 23 -300 d s
- [4 8] 0 sd 812 1484 m 18 -15 d s [] 0 sd 822 1541 m 20 -56 d s 799 1406 m 23
- 135 d s [4 8] 0 sd 846 1474 m 7 13 d s [] 0 sd 845 1560 m 15 -134 d s 822 1541
- m 23 19 d s [4 8] 0 sd 853 1487 m 33 -2 d s [] 0 sd 869 1579 m 20 -109 d s 845
- 1560 m 24 19 d s [4 8] 0 sd 886 1485 m 15 1 d s [] 0 sd 892 1532 m 21 -29 d s
- 869 1579 m 23 -47 d s [4 8] 0 sd 916 1490 m 13 10 d s 911 1644 m 7 -1 d s
- [] 0 sd 916 1672 m 20 -257 d s 892 1532 m 24 140 d s [4 8] 0 sd 929 1500 m 18
- 11 d s 918 1643 m 7 4 d s [] 0 sd 939 1611 m 16 -200 d s 916 1672 m 23 -61 d s
- [4 8] 0 sd 947 1511 m 36 -4 d s [] 0 sd 963 1644 m 20 -137 d s 939 1611 m 24 33
- d s [4 8] 0 sd 983 1507 m 20 9 d s 967 1658 m 25 1 d s [] 0 sd 986 1730 m 21
- -257 d s 963 1644 m 23 86 d s [4 8] 0 sd 1004 1516 m 9 -1 d s 992 1659 m 7 7 d
- s [] 0 sd 1010 1615 m 20 -2 d s 986 1730 m 24 -115 d s [4 8] 0 sd 1046 1523 m 5
- 4 d s 1017 1671 m 24 -2 d s [] 0 sd 1033 1796 m 21 -311 d s 1010 1615 m 23 181
- d s [4 8] 0 sd 1051 1527 m 12 14 d s 1041 1669 m 5 9 d s [] 0 sd 1057 1587 m 20
- -137 d s 1033 1796 m 24 -209 d s [4 8] 0 sd 1063 1541 m 22 8 d s [] 0 sd 1080
- 1579 m 20 -123 d s 1057 1587 m 23 -8 d s [4 8] 0 sd 1114 1406 m 5 7 d s 1086
- 1549 m 10 8 d s [] 0 sd 1104 1545 m 20 -177 d s 1080 1579 m 24 -34 d s
- [4 8] 0 sd 1119 1413 m 11 -2 d s 1108 1560 m 31 -4 d s [] 0 sd 1127 1618 m 20
- -109 d s 1104 1545 m 23 73 d s [4 8] 0 sd 1139 1556 m 19 9 d s [] 0 sd 1151
- 1638 m 20 -191 d s 1127 1618 m 24 20 d s [4 8] 0 sd 1159 1565 m 23 5 d s
- [] 0 sd 1174 1603 m 20 -82 d s 1151 1638 m 23 -35 d s [4 8] 0 sd 1182 1570 m 32
- X s 1185 1713 m 21 -2 d s [] 0 sd 1198 1851 m 20 -351 d s 1174 1603 m 24 248 d
- s 1198 1851 m 21 -350 d s [4 8] 0 sd 1242 1594 m 8 -3 d s [] 0 sd 1245 1608 m
- 20 -69 d s 1229 1516 m 16 92 d s [4 8] 0 sd 1283 1585 m 4 Y s [] 0 sd 1268 1560
- m 20 38 d s 1245 1608 m 23 -48 d s [4 8] 0 sd 1307 1455 m 1 5 d s 1290 1585 m 3
- 20 d s [] 0 sd 1292 1620 m 19 -191 d s 1268 1560 m 24 60 d s [4 8] 0 sd 1308
- 1460 m 14 -1 d s 1295 1606 m 1 2 d s [] 0 sd 1315 1559 m 20 -43 d s 1292 1620 m
- 23 -61 d s [4 8] 0 sd 1321 1614 m 38 -11 d s 1336 1752 m 6 -2 d s [] 0 sd 1339
- 1780 m 20 -177 d s 1315 1559 m 24 221 d s [4 8] 0 sd 1359 1603 m 13 14 d s 1343
- 1751 m 3 4 d s [] 0 sd 1362 1705 m 20 -177 d s 1339 1780 m 23 -75 d s
- [4 8] 0 sd 1372 1617 m 3 11 d s [] 0 sd 1386 1563 m 20 -56 d s 1362 1705 m 24
- -142 d s [4 8] 0 sd 1396 1633 m 24 -5 d s [] 0 sd 1409 1717 m 20 -163 d s 1386
- 1563 m 23 154 d s [4 8] 0 sd 1421 1628 m 20 -4 d s [] 0 sd 1432 1669 m 21 25 d
- s 1409 1717 m 23 -48 d s [4 8] 0 sd 1495 1509 m 10 -3 d s 1499 1659 m 23 -15 d
- s [] 0 sd 1503 1674 m 20 -16 d s 1482 1597 m 21 77 d s 1526 1706 m 21 79 d s
- 1503 1674 m 23 32 d s [4 8] 0 sd 1568 1657 m 1 Y s [] 0 sd 1550 1793 m 20 -150
- d s 1546 1779 m 4 14 d s [4 8] 0 sd 1569 1659 m 4 19 d s [] 0 sd 1573 1678 m 21
- -123 d s 1550 1793 m 23 -115 d s [4 8] 0 sd 1614 1669 m 2 Y s [] 0 sd 1597 1617
- m 20 65 d s 1573 1678 m 24 -61 d s 614 917 m 20 -16 d s 590 911 m 24 6 d s 590
- 911 m 20 -15 d s 637 923 m 20 -16 d s 614 917 m 23 6 d s 660 929 m 21 -16 d s
- 637 923 m 23 6 d s [4 8] 0 sd 665 1065 m 20 -15 d s 670 1200 m 22 -15 d s 674
- 1336 m 24 -15 d s 679 1471 m 24 -14 d s 684 1607 m 2 -2 d s [] 0 sd 684 1620 m
- 20 -150 d s 660 929 m 24 691 d s [4 8] 0 sd 686 1607 m s [] 0 sd 707 1478 m 21
- 39 d s 684 1620 m 23 -142 d s [4 8] 0 sd 727 1618 m 21 -16 d s [] 0 sd 731 1646
- m 20 -29 d s 707 1478 m 24 168 d s [4 8] 0 sd 751 1617 m s 792 1489 m 20 -5 d s
- [] 0 sd 801 1623 m 21 -82 d s 785 1562 m 16 61 d s [4 8] 0 sd 806 1638 m 28 -2
- d s [] 0 sd 825 1696 m 20 -136 d s 801 1623 m 24 73 d s [4 8] 0 sd 834 1636 m
- 18 10 d s [] 0 sd 848 1662 m 21 -83 d s 825 1696 m 23 -34 d s [4 8] 0 sd 852
- 1648 m -2 Y s [] 0 sd 848 1662 m 24 -87 d s [4 8] 0 sd 911 1644 m 5 Y s [] 0 sd
- 895 1580 m 21 92 d s 872 1574 m 23 6 d s [4 8] 0 sd 911 1649 m cl s 925 1647 m
- s [] 0 sd 939 1611 m s 942 1632 m 21 12 d s 930 1636 m 12 -4 d s [4 8] 0 sd 998
- 1666 m 1 X s 1013 1690 m 4 -18 d s [] 0 sd 1013 1690 m 20 106 d s 1005 1637 m 8
- 53 d s [4 8] 0 sd 1045 1679 m 1 -1 d s 1096 1557 m 7 2 d s 1070 1705 m 25 -6 d
- s 1079 1842 m 8 -2 d s [] 0 sd 1083 1910 m 21 -365 d s 1062 1585 m 21 325 d s
- [4 8] 0 sd 1103 1559 m 5 1 d s 1096 1703 m 3 9 d s 1088 1842 m 1 2 d s [] 0 sd
- 1107 1620 m 20 -2 d s 1083 1910 m 24 -290 d s 1130 1694 m 21 -56 d s 1107 1620
- m 23 74 d s 1154 1659 m 20 -56 d s 1130 1694 m 24 -35 d s [4 8] 0 sd 1182 1729
- m 3 -16 d s [] 0 sd 1177 1692 m 21 159 d s 1154 1659 m 23 33 d s [4 8] 0 sd
- 1213 1594 m 29 X s 1206 1736 m 26 2 d s [] 0 sd 1224 1825 m 21 -217 d s 1202
- 1793 m 22 32 d s [4 8] 0 sd 1251 1596 m 13 7 d s 1232 1738 m 21 9 d s [] 0 sd
- 1248 1804 m 20 -244 d s 1224 1825 m 24 -21 d s [4 8] 0 sd 1264 1603 m 22 2 d s
- 1253 1747 m 26 3 d s [] 0 sd 1271 1837 m 21 -217 d s 1248 1804 m 23 33 d s
- [4 8] 0 sd 1298 1609 m 11 8 d s 1279 1750 m 16 12 d s [] 0 sd 1295 1762 m 20
- -203 d s 1271 1837 m 24 -75 d s [4 8] 0 sd 1309 1617 m 12 -3 d s 1333 1757 m 3
- -5 d s [] 0 sd 1318 1701 m 21 79 d s 1295 1762 m 23 -61 d s [4 8] 0 sd 1333
- 1757 m 1 X s 1375 1628 m 4 7 d s 1359 1779 m 7 X s [] 0 sd 1365 1794 m 21 -231
- d s 1348 1750 m 17 44 d s [4 8] 0 sd 1379 1635 m 16 -2 d s 1366 1779 m 37 -4 d
- s [] 0 sd 1389 1921 m 20 -204 d s 1365 1794 m 24 127 d s [4 8] 0 sd 1403 1775 m
- 17 11 d s [] 0 sd 1412 1859 m 20 -190 d s 1389 1921 m 23 -62 d s [4 8] 0 sd
- 1420 1786 m 22 8 d s [] 0 sd 1436 1906 m 11 -219 d s 1412 1859 m 24 47 d s
- [4 8] 0 sd 1468 1657 m 6 1 d s 1443 1794 m 20 7 d s [] 0 sd 1459 1858 m 17 -222
- d s 1436 1906 m 23 -48 d s [4 8] 0 sd 1493 1668 m 6 -9 d s 1463 1801 m 2 5 d s
- [] 0 sd 1483 1662 m 20 12 d s 1459 1858 m 24 -196 d s [4 8] 0 sd 1484 1676 m 9
- -8 d s 1498 1814 m 17 -5 d s [] 0 sd 1506 1897 m 20 -191 d s 1483 1662 m 23 235
- d s [4 8] 0 sd 1515 1809 m 33 -1 d s [] 0 sd 1530 1930 m 20 -137 d s 1506 1897
- m 24 33 d s [4 8] 0 sd 1548 1808 m 17 11 d s 1539 1959 m 17 1 d s [] 0 sd 1553
- 2003 m 20 -325 d s 1530 1930 m 23 73 d s [4 8] 0 sd 1573 1678 m 9 17 d s 1565
- 1819 m 3 13 d s 1556 1962 m 1 Y s [] 0 sd 1577 1726 m 20 -109 d s 1553 2003 m
- 24 -277 d s [4 8] 0 sd 1582 1695 m 33 -1 d s 1588 1837 m 19 -2 d s [] 0 sd 1600
- 1947 m 16 -272 d s 1577 1726 m 23 221 d s [4 8] 0 sd 1614 1696 m 1 -2 d s 1606
- 1836 m 1 -1 d s [] 0 sd 593 933 m 21 -16 d s 570 927 m 23 6 d s 570 927 m 20
- -16 d s 617 939 m 20 -16 d s 593 933 m 24 6 d s 640 945 m 20 -16 d s 617 939 m
- 23 6 d s [4 8] 0 sd 645 1080 m 20 -15 d s 650 1216 m 20 -16 d s 655 1351 m 19
- -15 d s 660 1487 m 19 -16 d s 679 1611 m 5 -4 d s [] 0 sd 664 1582 m 20 38 d s
- 640 945 m 24 637 d s [4 8] 0 sd 686 1608 m -1 Y s [] 0 sd 707 1478 m s
- [4 8] 0 sd 694 1630 m 33 -12 d s [] 0 sd 711 1701 m 20 -55 d s 687 1603 m 24 98
- d s 783 1589 m 18 34 d s 848 1662 m s 875 1663 m 20 -83 d s 856 1635 m 19 28 d
- s 899 1642 m 10 -1 d s 875 1663 m 24 -21 d s [4 8] 0 sd 913 1686 m 17 -4 d s
- [] 0 sd 922 1715 m 20 -83 d s 899 1642 m 23 73 d s [4 8] 0 sd 931 1682 m 21 7 d
- s [] 0 sd 946 1748 m 11 -108 d s 922 1715 m 24 33 d s [4 8] 0 sd 952 1689 m 21
- 8 d s [] 0 sd 969 1740 m 5 -50 d s 946 1748 m 23 -8 d s [4 8] 0 sd 975 1697 m 2
- -1 d s 993 1694 m 20 -4 d s [] 0 sd 992 1787 m 21 -97 d s 969 1740 m 23 47 d s
- 1016 1793 m 7 -46 d s 992 1787 m 24 6 d s [4 8] 0 sd 1042 1711 m 3 3 d s
- [] 0 sd 1039 1772 m 16 -168 d s 1016 1793 m 14 -13 d s 1035 1776 m 4 -4 d s
- [4 8] 0 sd 1045 1714 m 25 -9 d s 1075 1849 m 4 -7 d s [] 0 sd 1063 1751 m 20
- 159 d s 1039 1772 m 24 -21 d s [4 8] 0 sd 1075 1849 m 2 -1 d s [] 0 sd 1107
- 1620 m s [4 8] 0 sd 1098 1733 m 25 -7 d s [] 0 sd 1110 1790 m 20 -96 d s 1098
- 1733 m 12 57 d s 1157 1694 m 20 -2 d s 1148 1668 m 9 26 d s [4 8] 0 sd 1169
- 1751 m 14 -13 d s [] 0 sd 1180 1808 m 12 -9 d s 1157 1694 m 23 114 d s
- [4 8] 0 sd 1221 1899 m 16 -6 d s [] 0 sd 1227 1967 m 21 -163 d s 1212 1809 m 15
- 158 d s [4 8] 0 sd 1238 1893 m 24 5 d s [] 0 sd 1251 1973 m 20 -136 d s 1227
- 1967 m 24 6 d s [4 8] 0 sd 1261 1900 m 1 -2 d s 1295 1762 m 16 11 d s [] 0 sd
- 1298 1918 m 20 -217 d s 1287 1786 m 11 132 d s [4 8] 0 sd 1311 1773 m 25 6 d s
- [] 0 sd 1321 1884 m 16 -113 d s 1298 1918 m 23 -34 d s [4 8] 0 sd 1337 1779 m 3
- X s 1341 1779 m 18 X s [] 0 sd 1345 1863 m 20 -69 d s 1321 1884 m 24 -21 d s
- [4 8] 0 sd 1351 1932 m 38 -11 d s 1363 2069 m 11 -3 d s [] 0 sd 1368 2124 m 21
- -203 d s 1345 1863 m 23 261 d s 1415 1867 m 21 39 d s 1410 1866 m 5 1 d s
- [4 8] 0 sd 1465 1806 m 10 10 d s 1454 1958 m 13 -2 d s [] 0 sd 1462 2054 m 21
- -392 d s 1448 1881 m 14 173 d s [4 8] 0 sd 1483 1676 m 1 X s 1498 1819 m -1 4 d
- s 1468 1957 m 1 5 d s [] 0 sd 1486 1724 m 20 173 d s 1462 2054 m 24 -330 d s
- [4 8] 0 sd 1495 1834 m 2 -8 d s 1507 1971 m 12 -7 d s [] 0 sd 1509 1999 m 21
- -69 d s 1486 1724 m 23 275 d s [4 8] 0 sd 1539 1959 m 2 3 d s 1567 1832 m 1 X s
- [] 0 sd 1600 1947 m s 573 948 m 20 -15 d s 549 942 m 24 6 d s 549 942 m 21 -15
- d s 596 954 m 21 -15 d s 573 948 m 23 6 d s 620 960 m 20 -15 d s 596 954 m 24 6
- d s [4 8] 0 sd 625 1096 m 20 -16 d s 631 1232 m 19 -16 d s 637 1367 m 17 -15 d
- s 642 1503 m 17 -15 d s [] 0 sd 643 1530 m 21 52 d s 620 960 m 23 570 d s
- [4 8] 0 sd 653 1640 m 31 -10 d s 664 1778 m 6 -2 d s [] 0 sd 667 1805 m 19 -196
- d s 643 1530 m 24 275 d s [4 8] 0 sd 728 1657 m 22 -5 d s [] 0 sd 737 1796 m 16
- -178 d s 723 1666 m 14 130 d s [4 8] 0 sd 750 1652 m 14 13 d s [] 0 sd 761 1681
- m 3 -14 d s 737 1796 m 24 -115 d s 784 1647 m 9 -41 d s 761 1681 m 5 -7 d s 778
- 1656 m 6 -9 d s 784 1647 m 22 -7 d s 855 1692 m 20 -29 d s 844 1670 m 11 22 d s
- [4 8] 0 sd 855 1692 m 33 -2 d s [] 0 sd 878 1738 m 21 -96 d s 855 1692 m 23 46
- d s 949 1810 m 20 -70 d s 944 1744 m 5 66 d s 996 1808 m 20 -15 d s 986 1773 m
- 10 35 d s [4 8] 0 sd 1098 1739 m 6 Y s [] 0 sd 1098 1745 m 12 45 d s [4 8] 0 sd
- 1119 1745 m 2 6 d s [] 0 sd 1113 1838 m 11 -115 d s 1097 1749 m 16 89 d s
- [4 8] 0 sd 1122 1751 m 28 2 d s [] 0 sd 1137 1871 m 20 -177 d s 1113 1838 m 24
- 33 d s [4 8] 0 sd 1150 1753 m 19 -2 d s [] 0 sd 1160 1796 m 20 12 d s 1137 1871
- m 23 -75 d s 1184 1829 m 5 -27 d s 1160 1796 m 24 33 d s [4 8] 0 sd 1221 1899 m
- 6 Y s [] 0 sd 1184 1829 m 7 -25 d s [4 8] 0 sd 1221 1905 m 2 X s [] 0 sd 1279
- 1809 m 19 109 d s [4 8] 0 sd 1365 2072 m 1 Y s 1365 2073 m s 1444 1974 m 10 -16
- d s [] 0 sd 1442 1962 m 20 92 d s 1432 1898 m 10 64 d s [4 8] 0 sd 1478 1830 m
- s 1468 1962 m 1 X s 1507 1971 m 1 Y s [] 0 sd 1559 1911 m 18 -164 d s 1559 1911
- m s 552 964 m 21 -16 d s 529 958 m 23 6 d s 529 958 m 20 -16 d s 576 970 m 20
- -16 d s 552 964 m 24 6 d s 599 976 m 21 -16 d s 576 970 m 23 6 d s [4 8] 0 sd
- 604 1111 m 21 -15 d s 608 1247 m 23 -15 d s 613 1382 m 22 -14 d s 617 1517 m 24
- -13 d s 621 1653 m 9 -5 d s [] 0 sd 623 1707 m 20 -177 d s 599 976 m 24 731 d s
- [4 8] 0 sd 653 1640 m -1 15 d s 664 1778 m 2 Y s [] 0 sd 646 1606 m 21 199 d s
- 623 1707 m 23 -101 d s 686 1622 m 3 -14 d s [4 8] 0 sd 777 1673 m 5 2 d s 749
- 1820 m 23 -3 d s [] 0 sd 764 1931 m 20 -284 d s 743 1771 m 21 160 d s
- [4 8] 0 sd 783 1675 m 21 7 d s 773 1818 m 19 8 d s [] 0 sd 787 1883 m 20 -237 d
- s 764 1931 m 23 -48 d s [4 8] 0 sd 805 1683 m 14 12 d s 792 1826 m 3 6 d s
- [] 0 sd 811 1728 m 10 -40 d s 787 1883 m 24 -155 d s [4 8] 0 sd 817 1702 m 38
- -10 d s [] 0 sd 905 1725 m 4 -48 d s 883 1719 m 22 6 d s 937 1735 m 12 75 d s
- 905 1725 m 13 -26 d s [4 8] 0 sd 1097 1753 m 1 2 d s [] 0 sd 1281 1861 m 10 12
- d s 1271 1836 m 10 25 d s [4 8] 0 sd 1341 1970 m 13 -2 d s [] 0 sd 1351 2067 m
- 5 -71 d s 1331 1876 m 20 191 d s 1492 1848 m 5 10 d s 1477 1853 m 15 -5 d s 532
- 979 m 20 -15 d s 509 973 m 23 6 d s 509 973 m 20 -15 d s 556 985 m 20 -15 d s
- 532 979 m 24 6 d s 579 991 m 20 -15 d s 556 985 m 23 6 d s [4 8] 0 sd 583 1127
- m 21 -16 d s 588 1262 m 20 -15 d s 592 1397 m 21 -15 d s 596 1533 m 20 -15 d s
- 600 1668 m 21 -15 d s [] 0 sd 603 1736 m 20 -29 d s 579 991 m 24 745 d s 683
- 1652 m 7 -39 d s 682 1663 m 8 -50 d s 861 1735 m 11 -9 d s 858 1700 m 3 35 d s
- [4 8] 0 sd 927 1751 m 10 -2 d s [] 0 sd 931 1793 m 7 -53 d s 923 1713 m 8 80 d
- s [4 8] 0 sd 937 1749 m 3 3 d s [] 0 sd 931 1793 m 11 -27 d s 1190 1818 m 2 -8
- d s 1188 1812 m 2 6 d s [4 8] 0 sd 1341 1970 m 1 3 d s [] 0 sd 1351 2067 m s
- 1519 1983 m 14 -49 d s 1517 1973 m 2 10 d s 512 995 m 20 -16 d s 488 989 m 24 6
- d s 488 989 m 21 -16 d s 535 1001 m 21 -16 d s 512 995 m 23 6 d s 559 1007 m 20
- -16 d s 535 1001 m 24 6 d s [4 8] 0 sd 568 1143 m 15 -16 d s 577 1280 m 10 -17
- d s 585 1414 m 6 -14 d s 592 1543 m 4 -10 d s 599 1672 m 1 -4 d s [] 0 sd 582
- 1362 m 21 374 d s 559 1007 m 23 355 d s [4 8] 0 sd 585 1414 m s 599 1672 m 2 X
- s [] 0 sd 491 1010 m 21 -15 d s 468 1004 m 23 6 d s 468 1004 m 20 -15 d s 515
- 1016 m 20 -15 d s 491 1010 m 24 6 d s 538 1022 m 21 -15 d s 515 1016 m 23 6 d s
- [4 8] 0 sd 549 1159 m 18 -15 d s 560 1296 m 17 -16 d s [] 0 sd 562 1324 m 20 38
- d s 538 1022 m 24 302 d s 562 1324 m 22 56 d s 471 1026 m 20 -16 d s 448 1020 m
- 23 6 d s 448 1020 m 20 -16 d s 495 1032 m 20 -16 d s 471 1026 m 24 6 d s 518
- 1038 m 20 -16 d s 495 1032 m 23 6 d s [4 8] 0 sd 531 1175 m 18 -16 d s 552 1305
- m 6 -7 d s [] 0 sd 542 1286 m 20 38 d s 518 1038 m 24 248 d s [4 8] 0 sd 545
- 1313 m 7 -8 d s 562 1452 m 10 -4 d s [] 0 sd 565 1480 m 19 -89 d s 542 1286 m
- 23 194 d s 451 1041 m 20 -15 d s 427 1035 m 24 6 d s 427 1035 m 21 -15 d s 474
- 1047 m 21 -15 d s 451 1041 m 23 6 d s 498 1053 m 20 -15 d s 474 1047 m 24 6 d s
- [4 8] 0 sd 519 1193 m 12 -18 d s [] 0 sd 521 1207 m 21 79 d s 498 1053 m 23 154
- d s [4 8] 0 sd 562 1452 m 2 Y s [] 0 sd 430 1057 m 21 -16 d s 407 1051 m 23 6 d
- s 407 1051 m 20 -16 d s 454 1063 m 20 -16 d s 430 1057 m 24 6 d s 477 1069 m 21
- -16 d s 454 1063 m 23 6 d s [4 8] 0 sd 499 1209 m 20 -16 d s [] 0 sd 501 1223 m
- 20 -16 d s 477 1069 m 24 154 d s [4 8] 0 sd 514 1212 m 8 X s [] 0 sd 410 1072 m
- 20 -15 d s 387 1066 m 23 6 d s 387 1066 m 20 -15 d s 434 1078 m 20 -15 d s 410
- 1072 m 24 6 d s 457 1084 m 20 -15 d s 434 1078 m 23 6 d s [4 8] 0 sd 496 1213 m
- 3 -4 d s [] 0 sd 481 1184 m 20 39 d s 457 1084 m 24 100 d s 390 1088 m 20 -16 d
- s 366 1082 m 24 6 d s 366 1082 m 21 -16 d s 413 1094 m 21 -16 d s 390 1088 m 23
- 6 d s 437 1100 m 20 -16 d s 413 1094 m 24 6 d s 460 1119 m 21 65 d s 437 1100 m
- 23 19 d s 484 1192 m 1 -1 d s 460 1119 m 24 73 d s 369 1103 m 21 -15 d s 346
- 1097 m 23 6 d s 346 1097 m 20 -15 d s 393 1109 m 20 -15 d s 369 1103 m 24 6 d s
- 416 1115 m 21 -15 d s 393 1109 m 23 6 d s 440 1175 m 20 -56 d s 416 1115 m 24
- 60 d s 463 1141 m 21 51 d s 440 1175 m 23 -34 d s 349 1119 m 20 -16 d s 326
- 1113 m 23 6 d s 326 1113 m 20 -16 d s 373 1125 m 20 -16 d s 349 1119 m 24 6 d s
- 396 1131 m 20 -16 d s 373 1125 m 23 6 d s 420 1137 m 20 38 d s 396 1131 m 24 6
- d s 467 1162 m 11 14 d s 452 1159 m 15 3 d s 329 1135 m 20 -16 d s 305 1129 m
- 24 6 d s 305 1129 m 21 -16 d s 352 1140 m 21 -15 d s 329 1135 m 23 5 d s 376
- 1146 m 20 -15 d s 352 1140 m 24 6 d s 399 1152 m 21 -15 d s 376 1146 m 23 6 d s
- 423 1172 m 11 -9 d s 399 1152 m 24 20 d s 447 1164 m 20 -2 d s 423 1172 m 13 -4
- d s 470 1184 m 9 -7 d s 447 1165 m 23 19 d s 470 1184 m 9 -3 d s 308 1150 m 21
- -15 d s 285 1144 m 23 6 d s 285 1144 m 20 -15 d s 332 1156 m 20 -16 d s 308
- 1150 m 24 6 d s 355 1162 m 21 -16 d s 332 1156 m 23 6 d s 379 1168 m 20 -16 d s
- 355 1162 m 24 6 d s 402 1187 m 21 -15 d s 379 1168 m 23 19 d s 426 1180 m 11 -8
- d s 402 1187 m 24 -7 d s 449 1186 m 21 -2 d s 426 1180 m 23 6 d s 473 1192 m 7
- -6 d s 449 1186 m 24 6 d s 473 1192 m 14 3 d s 288 1166 m 20 -16 d s 265 1160 m
- 23 6 d s 265 1160 m 20 -16 d s 312 1172 m 20 -16 d s 288 1166 m 24 6 d s 335
- 1178 m 20 -16 d s 312 1172 m 23 6 d s 359 1184 m 20 -16 d s 335 1178 m 24 6 d s
- 382 1190 m 20 -3 d s 359 1184 m 23 6 d s 405 1195 m 21 -15 d s 382 1190 m 23 5
- d s 429 1201 m 20 -15 d s 405 1195 m 24 6 d s 452 1207 m 21 -15 d s 429 1201 m
- 23 6 d s 476 1213 m 15 -11 d s 452 1207 m 24 6 d s 499 1219 m 1 X s 476 1213 m
- 23 6 d s 523 1225 m 2 X s 504 1221 m 19 4 d s 523 1225 m 3 3 d s 268 1181 m 20
- -15 d s 244 1175 m 24 6 d s 244 1175 m 21 -15 d s 291 1187 m 21 -15 d s 268
- 1181 m 23 6 d s 315 1193 m 20 -15 d s 291 1187 m 24 6 d s 338 1199 m 21 -15 d s
- 315 1193 m 23 6 d s 362 1205 m 20 -15 d s 338 1199 m 24 6 d s 385 1211 m 20 -16
- d s 362 1205 m 23 6 d s 409 1217 m 20 -16 d s 385 1211 m 24 6 d s 432 1223 m 20
- -16 d s 409 1217 m 23 6 d s 456 1229 m 20 -16 d s 432 1223 m 24 6 d s 479 1235
- m 20 -16 d s 456 1229 m 23 6 d s 503 1241 m 20 -16 d s 479 1235 m 24 6 d s 526
- 1260 m 7 -5 d s 503 1241 m 23 19 d s 526 1260 m 8 -2 d s [4 8] 0 sd 222 1314 m
- 333 85 d s 580 1405 m 4 1 d s 222 1449 m 370 94 d s 222 1583 m 377 96 d s 627
- 1686 m 29 7 d s 677 1699 m 51 13 d s 810 1733 m 117 29 d s 960 1771 m 27 7 d s
- 1022 1787 m 9 2 d s 1033 1789 m 35 9 d s 1092 1804 m 16 4 d s 1153 1820 m 29 7
- d s 1184 1828 m 12 3 d s 1199 1832 m 16 4 d s 1268 1849 m 9 2 d s 222 1717 m
- 531 135 d s 789 1862 m 556 141 d s 222 1852 m 1128 287 d s 222 1986 m 1128 287
- d s 222 2120 m 1128 287 d s [] 0 sd 222 1180 m 298 76 d s 531 1258 m 2 1 d s
- 1350 2045 m 416 Y s 222 2174 m 1128 287 d s 222 1180 m 994 Y s [4 8] 0 sd 1694
- 1338 m 307 -234 d s 1668 1493 m 333 -254 d s 1652 1639 m 349 -266 d s 1384 1978
- m 54 -41 d s 1472 1911 m 28 -21 d s 1569 1837 m 18 -14 d s 1609 1807 m 392 -300
- d s 1350 2139 m 20 -15 d s 1370 2124 m 91 -71 d s 1462 2053 m 87 -66 d s 1555
- 1982 m 46 -35 d s 1601 1947 m 400 -305 d s 1350 2273 m 651 -497 d s 1350 2407 m
- 651 -497 d s [] 0 sd 1731 1176 m 270 -206 d s 2001 970 m 994 Y s 1350 2461 m
- 651 -497 d s 222 1180 m 651 -497 d s 873 683 m 994 Y s 222 2174 m 651 -497 d s
- 222 1180 m 994 Y s 873 683 m 1128 287 d s 2001 970 m 994 Y s 873 1677 m 1128
- 287 d s 873 1677 m cl s 873 683 m 1128 287 d s 967 673 m 34 Y s 991 696 m 17 Y
- s 1014 702 m 17 Y s 1038 708 m 17 Y s 1061 714 m 17 Y s 1085 703 m 34 Y s 1108
- 726 m 17 Y s 1132 732 m 17 Y s 1155 738 m 17 Y s 1179 744 m 17 Y s 1202 733 m
- 34 Y s 1226 756 m 16 Y s 1249 762 m 16 Y s 1273 768 m 16 Y s 1296 774 m 16 Y s
- 1320 763 m 33 Y s 1343 786 m 16 Y s 1367 792 m 16 Y s 1390 798 m 16 Y s 1413
- 804 m 16 Y s 1437 793 m 33 Y s 1460 816 m 16 Y s 1484 822 m 16 Y s 1507 828 m
- 16 Y s 1531 834 m 16 Y s 1554 823 m 33 Y s 1578 846 m 16 Y s 1601 851 m 17 Y s
- 1625 857 m 17 Y s 1648 863 m 17 Y s 1672 853 m 33 Y s 1695 875 m 17 Y s 1719
- 881 m 17 Y s 1742 887 m 17 Y s 1766 893 m 17 Y s 1789 883 m 33 Y s 1813 905 m
- 17 Y s 1836 911 m 17 Y s 1860 917 m 17 Y s 1883 923 m 17 Y s 1907 913 m 33 Y s
- 967 673 m 34 Y s 944 684 m 17 Y s 920 678 m 17 Y s 897 672 m 17 Y s 873 666 m
- 17 Y s 1907 913 m 33 Y s 1930 935 m 17 Y s 1954 941 m 17 Y s 1977 947 m 17 Y s
- 2001 953 m 17 Y s 970 654 m -5 -1 d -3 -4 d -1 -8 d -4 Y 1 -8 d 3 -4 d 5 -2 d 3
- X 4 2 d 3 4 d 1 8 d 4 Y -1 8 d -3 4 d -4 1 d -3 X cl s 1061 684 m -4 -1 d -3 -5
- d -1 -7 d -4 Y 1 -8 d 3 -4 d 4 -2 d 3 X 5 2 d 3 4 d 1 8 d 4 Y -1 7 d -3 5 d -5
- 1 d -3 X cl s 1085 656 m -1 -1 d 1 -2 d 2 2 d -2 1 d cl s 1099 677 m 1 Y 1 3 d
- 1 2 d 3 1 d 6 X 3 -1 d 2 -2 d 1 -3 d -3 Y -1 -2 d -3 -5 d -15 -15 d 21 X s 1144
- 684 m -14 X -2 -13 d 2 2 d 4 1 d 5 X 4 -1 d 3 -3 d 1 -5 d -3 Y -1 -4 d -3 -3 d
- -4 -2 d -5 X -4 2 d -2 1 d -1 3 d s 1190 714 m -5 -1 d -3 -5 d -1 -7 d -5 Y 1
- -7 d 3 -4 d 5 -2 d 3 X 4 2 d 3 4 d 2 7 d 5 Y -2 7 d -3 5 d -4 1 d -3 X cl s
- 1214 686 m -2 -1 d 2 -2 d 1 2 d -1 1 d cl s 1243 714 m -15 X -1 -13 d 1 1 d 5 2
- d 4 X 5 -2 d 3 -3 d 1 -4 d -3 Y -1 -4 d -3 -3 d -5 -2 d -4 X -5 2 d -1 1 d -2 3
- d s 1296 744 m -4 -1 d -3 -5 d -2 -7 d -5 Y 2 -7 d 3 -4 d 4 -2 d 3 X 5 2 d 3 4
- d 1 7 d 5 Y -1 7 d -3 5 d -5 1 d -3 X cl s 1320 716 m -1 -1 d 1 -2 d 2 2 d -2 1
- d cl s 1353 744 m -15 -31 d s 1332 744 m 21 X s 1379 744 m -14 X -2 -13 d 2 1 d
- 4 2 d 4 X 5 -2 d 3 -3 d 1 -4 d -3 Y -1 -5 d -3 -2 d -5 -2 d -4 X -4 2 d -2 1 d
- -1 3 d s 1435 768 m 3 2 d 4 4 d -31 Y s 1527 798 m 3 2 d 4 4 d -31 Y s 1555 776
- m -2 -2 d 2 -1 d 1 1 d -1 2 d cl s 1568 797 m 1 Y 2 3 d 1 1 d 3 2 d 6 X 3 -2 d
- 2 -1 d 1 -3 d -3 Y -1 -3 d -3 -4 d -15 -15 d 21 X s 1614 804 m -15 X -1 -13 d 1
- 1 d 5 2 d 4 X 5 -2 d 3 -3 d 1 -4 d -3 Y -1 -5 d -3 -3 d -5 -1 d -4 X -5 1 d -1
- 2 d -2 3 d s 1655 828 m 3 1 d 5 5 d -31 Y s 1683 806 m -1 -2 d 1 -1 d 2 1 d -2
- 2 d cl s 1713 834 m -15 X -1 -13 d 1 1 d 5 1 d 4 X 5 -1 d 3 -3 d 1 -4 d -3 Y -1
- -5 d -3 -3 d -5 -1 d -4 X -5 1 d -1 2 d -2 3 d s 1762 858 m 3 1 d 4 5 d -31 Y s
- 1790 836 m -2 -2 d 2 -1 d 1 1 d -1 2 d cl s 1822 864 m -14 -31 d s 1802 864 m
- 20 X s 1849 864 m -15 X -1 -14 d 1 2 d 5 1 d 4 X 5 -1 d 3 -3 d 1 -5 d -2 Y -1
- -5 d -3 -3 d -5 -1 d -4 X -5 1 d -1 2 d -2 3 d s 1902 886 m 2 Y 1 3 d 2 1 d 3 2
- d 6 X 3 -2 d 1 -1 d 1 -3 d -3 Y -1 -3 d -3 -5 d -15 -14 d 21 X s 873 683 m -651
- 497 d s 873 649 m 34 Y s 857 679 m 16 Y s 841 691 m 17 Y s 824 703 m 17 Y s 808
- 716 m 17 Y s 792 712 m 33 Y s 776 741 m 16 Y s 759 753 m 17 Y s 743 766 m 16 Y
- s 727 778 m 17 Y s 711 774 m 33 Y s 694 803 m 17 Y s 678 815 m 17 Y s 662 828 m
- 16 Y s 645 840 m 17 Y s 629 836 m 33 Y s 613 865 m 17 Y s 597 877 m 17 Y s 580
- 890 m 17 Y s 564 902 m 17 Y s 548 898 m 33 Y s 532 927 m 17 Y s 515 940 m 16 Y
- s 499 952 m 17 Y s 483 964 m 17 Y s 466 960 m 33 Y s 450 989 m 17 Y s 434 1002
- m 16 Y s 418 1014 m 17 Y s 401 1027 m 16 Y s 385 1022 m 34 Y s 369 1051 m 17 Y
- s 352 1064 m 16 Y s 336 1076 m 17 Y s 320 1089 m 16 Y s 304 1084 m 34 Y s 287
- 1114 m 16 Y s 271 1126 m 17 Y s 255 1138 m 17 Y s 239 1151 m 16 Y s 222 1147 m
- 33 Y s 873 649 m 34 Y s 826 573 m 27 X s 865 583 m 2 Y 1 3 d 2 1 d 3 2 d 6 X 3
- -2 d 1 -1 d 2 -3 d -3 Y -2 -3 d -3 -5 d -15 -15 d 21 X s 704 635 m 26 X s 745
- 647 m 3 1 d 5 5 d -31 Y s 773 625 m -1 -2 d 1 -1 d 2 1 d -2 2 d cl s 803 653 m
- -15 X -1 -14 d 1 2 d 5 1 d 4 X 5 -1 d 2 -3 d 2 -5 d -3 Y -2 -4 d -2 -3 d -5 -1
- d -4 X -5 1 d -1 2 d -2 2 d s 663 697 m 27 X s 705 709 m 3 1 d 4 5 d -31 Y s
- 541 759 m 27 X s 587 777 m -5 -2 d -2 -4 d -2 -7 d -5 Y 2 -7 d 2 -5 d 5 -1 d 3
- X 4 1 d 3 5 d 2 7 d 5 Y -2 7 d -3 4 d -4 2 d -3 X cl s 611 749 m -2 -2 d 2 -1 d
- 1 1 d -1 2 d cl s 640 777 m -15 X -1 -13 d 1 1 d 5 2 d 4 X 5 -2 d 3 -3 d 1 -4 d
- -3 Y -1 -5 d -3 -3 d -5 -1 d -4 X -5 1 d -1 2 d -2 3 d s 537 839 m -5 -1 d -3
- -5 d -1 -7 d -5 Y 1 -7 d 3 -5 d 5 -1 d 3 X 4 1 d 3 5 d 2 7 d 5 Y -2 7 d -3 5 d
- -4 1 d -3 X cl s 414 901 m -4 -1 d -3 -5 d -2 -7 d -5 Y 2 -7 d 3 -4 d 4 -2 d 3
- X 5 2 d 3 4 d 1 7 d 5 Y -1 7 d -3 5 d -5 1 d -3 X cl s 438 873 m -1 -1 d 1 -2 d
- 2 2 d -2 1 d cl s 468 901 m -15 X -2 -13 d 2 1 d 4 2 d 5 X 4 -2 d 3 -3 d 2 -4 d
- -3 Y -2 -4 d -3 -3 d -4 -2 d -5 X -4 2 d -2 1 d -1 3 d s 370 957 m 3 2 d 4 4 d
- -31 Y s 247 1020 m 3 1 d 5 5 d -32 Y s 275 997 m -1 -1 d 1 -2 d 2 2 d -2 1 d cl
- s 305 1026 m -15 X -1 -14 d 1 2 d 5 1 d 4 X 4 -1 d 3 -3 d 2 -5 d -3 Y -2 -4 d
- -3 -3 d -4 -2 d -4 X -5 2 d -1 1 d -2 3 d s 204 1080 m 2 Y 1 3 d 2 1 d 3 2 d 6
- X 3 -2 d 1 -1 d 2 -3 d -3 Y -2 -3 d -3 -5 d -15 -14 d 21 X s 222 1180 m 994 Y s
- 189 1180 m 33 X s 206 1207 m 16 X s 206 1234 m 16 X s 206 1261 m 16 X s 206
- 1287 m 16 X s 189 1314 m 33 X s 206 1341 m 16 X s 206 1368 m 16 X s 206 1395 m
- 16 X s 206 1422 m 16 X s 189 1449 m 33 X s 206 1476 m 16 X s 206 1502 m 16 X s
- 206 1529 m 16 X s 206 1556 m 16 X s 189 1583 m 33 X s 206 1610 m 16 X s 206
- 1637 m 16 X s 206 1664 m 16 X s 206 1690 m 16 X s 189 1717 m 33 X s 206 1744 m
- 16 X s 206 1771 m 16 X s 206 1798 m 16 X s 206 1825 m 16 X s 189 1852 m 33 X s
- 206 1879 m 16 X s 206 1905 m 16 X s 206 1932 m 16 X s 206 1959 m 16 X s 189
- 1986 m 33 X s 206 2013 m 16 X s 206 2040 m 16 X s 206 2067 m 16 X s 206 2094 m
- 16 X s 189 2120 m 33 X s 189 2120 m 33 X s 206 2147 m 16 X s 150 1195 m -4 -1 d
- -3 -4 d -1 -8 d -4 Y 1 -8 d 3 -4 d 4 -2 d 3 X 5 2 d 3 4 d 1 8 d 4 Y -1 8 d -3 4
- d -5 1 d -3 X cl s 116 1324 m 3 1 d 5 5 d -31 Y s 150 1330 m -4 -2 d -3 -4 d -1
- -7 d -5 Y 1 -7 d 3 -5 d 4 -1 d 3 X 5 1 d 3 5 d 1 7 d 5 Y -1 7 d -3 4 d -5 2 d
- -3 X cl s 113 1457 m 1 Y 2 3 d 1 2 d 3 1 d 6 X 3 -1 d 2 -2 d 1 -3 d -3 Y -1 -3
- d -3 -4 d -15 -15 d 21 X s 150 1464 m -4 -1 d -3 -5 d -1 -7 d -5 Y 1 -7 d 3 -4
- d 4 -2 d 3 X 5 2 d 3 4 d 1 7 d 5 Y -1 7 d -3 5 d -5 1 d -3 X cl s 115 1599 m 16
- X -9 -12 d 5 X 3 -2 d 1 -1 d 2 -5 d -3 Y -2 -4 d -3 -3 d -4 -2 d -5 X -4 2 d -2
- 1 d -1 3 d s 150 1599 m -4 -2 d -3 -4 d -1 -8 d -4 Y 1 -8 d 3 -4 d 4 -2 d 3 X 5
- 2 d 3 4 d 1 8 d 4 Y -1 8 d -3 4 d -5 2 d -3 X cl s 127 1733 m -15 -21 d 22 X s
- 127 1733 m -31 Y s 150 1733 m -4 -2 d -3 -4 d -1 -7 d -5 Y 1 -7 d 3 -5 d 4 -1 d
- 3 X 5 1 d 3 5 d 1 7 d 5 Y -1 7 d -3 4 d -5 2 d -3 X cl s 130 1867 m -15 X -2
- -13 d 2 1 d 4 2 d 5 X 4 -2 d 3 -3 d 2 -4 d -3 Y -2 -4 d -3 -3 d -4 -2 d -5 X -4
- 2 d -2 1 d -1 3 d s 150 1867 m -4 -1 d -3 -5 d -1 -7 d -4 Y 1 -8 d 3 -4 d 4 -2
- d 3 X 5 2 d 3 4 d 1 8 d 4 Y -1 7 d -3 5 d -5 1 d -3 X cl s 131 1997 m -1 3 d -5
- 2 d -3 X -4 -2 d -3 -4 d -2 -8 d -7 Y 2 -6 d 3 -3 d 4 -1 d 2 X 4 1 d 3 3 d 2 4
- d 2 Y -2 4 d -3 3 d -4 2 d -2 X -4 -2 d -3 -3 d -2 -4 d s 150 2002 m -4 -2 d -3
- -4 d -1 -8 d -4 Y 1 -8 d 3 -4 d 4 -1 d 3 X 5 1 d 3 4 d 1 8 d 4 Y -1 8 d -3 4 d
- -5 2 d -3 X cl s 133 2136 m -15 -31 d s 112 2136 m 21 X s 150 2136 m -4 -1 d -3
- -5 d -1 -7 d -5 Y 1 -7 d 3 -5 d 4 -1 d 3 X 5 1 d 3 5 d 1 7 d 5 Y -1 7 d -3 5 d
- -5 1 d -3 X cl s 1040 539 m 9 -21 d s 1057 539 m -8 -21 d -3 -6 d -3 -3 d -3 -1
- d -2 X s 1077 549 m 12 -31 d s 1100 549 m -11 -31 d s 1127 545 m -3 3 d -4 1 d
- -6 X -5 -1 d -3 -3 d -3 Y 2 -3 d 1 -1 d 3 -2 d 9 -3 d 3 -1 d 2 -2 d 1 -3 d -4 Y
- -3 -3 d -4 -2 d -6 X -5 2 d -3 3 d s 1139 521 m -2 -1 d 2 -2 d 1 2 d -1 1 d cl
- s 1166 539 m 16 -21 d s 1182 539 m -16 -21 d s gr
-showpage
- gr
-%%Trailer
-%%Pages: 1
- gr gr
-%%EOF
diff --git a/src/pawlib/paw/testsuite/paw.commands/nt_pl_2d_surf4.ref.ps b/src/pawlib/paw/testsuite/paw.commands/nt_pl_2d_surf4.ref.ps
deleted file mode 100644
index 75817c0..0000000
--- a/src/pawlib/paw/testsuite/paw.commands/nt_pl_2d_surf4.ref.ps
+++ /dev/null
@@ -1,5396 +0,0 @@
-%!PS-Adobe-2.0
-%%Title: /disk3/maartenb/cerncvs/paw/testsuite/tmp/nt_pl_2d_ (Portrait A 4)
-%%Pages: (atend)
-%%Creator: HIGZ Version 1.23/06
-%%CreationDate: 96/04/16 14.51
-%%EndComments
-%%BeginProlog
-/s {stroke} def /l {lineto} def /m {moveto} def /t {translate} def
-/sw {stringwidth} def /r {rotate} def /rl {roll} def /R {repeat} def
-/d {rlineto} def /rm {rmoveto} def /gr {grestore} def /f {eofill} def
-/c {setrgbcolor} def /lw {setlinewidth} def /sd {setdash} def
-/cl {closepath} def /sf {scalefont setfont} def /black {0 setgray} def
-/box {m dup 0 exch d exch 0 d 0 exch neg d cl} def
-/NC{systemdict begin initclip end}def/C{NC box clip newpath}def
-/bl {box s} def /bf {box f} def /Y { 0 exch d} def /X { 0 d} def
-/mp {newpath /y exch def /x exch def} def
-/side {[w .77 mul w .23 mul] .385 w mul sd w 0 l currentpoint t -144 r} def
-/mr {mp x y w2 0 360 arc} def /m24 {mr s} def /m20 {mr f} def
-/mb {mp x y w2 add m w2 neg 0 d 0 w neg d w 0 d 0 w d cl} def
-/mt {mp x y w2 add m w2 neg w neg d w 0 d cl} def
-/m21 {mb f} def /m25 {mb s} def /m22 {mt f} def /m26 {mt s} def
-/m23 {mp x y w2 sub m w2 w d w neg 0 d cl f} def
-/m27 {mp x y w2 add m w3 neg w2 neg d w3 w2 neg d w3 w2 d cl s} def
-/m28 {mp x w2 sub y w2 sub w3 add m w3 0 d 0 w3 neg d w3 0 d 0 w3 d w3 0 d
- 0 w3 d w3 neg 0 d 0 w3 d w3 neg 0 d
- 0 w3 neg d w3 neg 0 d cl s } def
-/m29 {mp gsave x w2 sub y w2 add w3 sub m currentpoint t
- 4 {side} repeat cl fill gr} def
-/m30 {mp gsave x w2 sub y w2 add w3 sub m currentpoint t
- 5 {side} repeat s gr} def
-/m31 {mp x y w2 sub m 0 w d x w2 sub y m w 0 d
- x w2 sub y w2 add m w w neg d x w2 sub y w2
- sub m w w d s} def
-/m2 {mp x y w2 sub m 0 w d x w2 sub y m w 0 d s} def
-/m5 {mp x w2 sub y w2 sub m w w d x w2 sub y w2 add m w w neg d s} def
-/DP {/PT exch def gsave 47.2 47.2 scale PT 1 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < AA AA 55 55 AA AA 55 55 AA AA 55 55 AA AA 55 55 AA AA 55 55 AA AA 55 55
-AA AA 55 55 AA AA 55 55 > } image } if PT 2 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < BB BB EE EE BB BB EE EE BB BB EE EE BB BB EE EE BB BB EE EE BB BB EE EE
-BB BB EE EE BB BB EE EE > } image } if PT 3 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < FF FF BB BB FF FF EE EE FF FF BB BB FF FF EE EE FF FF BB BB FF FF EE EE
-FF FF BB BB FF FF EE EE > } image } if PT 4 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < DF DF BF BF 7F 7F FE FE FD FD FB FB F7 F7 EF EF DF DF BF BF 7F 7F FE FE
-FD FD FB FB F7 F7 EF EF > } image } if PT 5 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < 7F 7F BF B F DF DF EF EF F7 F7 FB FB FD FD FE FE 7F 7F BF BF DF DF EF
-EF F7 F7 FB FB FD FD FE FE > } image } if PT 6 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB
-BB BB BB BB BB BB BB BB BB > } image } if PT 7 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < FF FF FF FF FF FF 00 00 FF FF FF FF FF FF 00 00 FF FF FF FF FF FF 00
-00 FF FF FF FF FF FF 00 00 > } image } if PT 8 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < EE EE 47 47 83 83 C5 C5 EE EE 5C 5C 38 38 74 74 EE EE 47 47 83 83 C5
-C5 EE EE 5C 5C 38 38 74 74 > } image } if PT 9 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < EF EF EF EF D7 D7 38 38 FE FE FE FE 7D 7D 83 83 EF EF EF EF D7 D7 38
-38 FE FE FE FE 7D 7D 83 83 > } image } if PT 10 eq { 16 16 1 [ 16 0 0 16 neg
-0 16 ] { < EF EF EF EF EF EF 00 00 FE FE FE FE FE FE 00 00 EF EF EF EF EF EF
-00 00 FE FE FE FE FE FE 00 00 > } image } if PT 11 eq { 16 16 1 [ 16 0 0 16
-neg 0 16 ] { < F7 F7 B6 B6 D5 D5 E3 E3 D5 D5 B6 B6 F7 F7 FF FF 7F 7F 6B 6B 5D
-5D 3E 3E 5D 5D 6B 6B 7F 7F FF FF > } image } if PT 12 eq { 16 16 1 [ 16 0 0
-16 neg 0 16 ] { < E3 E3 DD DD BE BE BE BE BE BE DD DD E3 E3 FF FF 3E 3E DD DD
-EB EB EB EB EB EB DD DD 3E 3E FF FF > } image } if PT 13 eq { 16 16 1 [ 16 0
-0 16 neg 0 16 ] { < FE FE 7D 7D BB BB D7 D7 EF EF D7 D7 BB BB 7D 7D FE FE 7D
-7D BB BB D7 D7 EF EF D7 D7 BB BB 7D 7D > } image } if PT 14 eq { 16 16 1 [ 16
-0 0 16 neg 0 16 ] { < 00 00 EE EF EE EF EE EF 0E E0 EE EE EE EE EE EE 00 EE
-FE EE FE EE FE EE 00 00 FE EF FE EF FE EF > } image } if PT 15 eq { 16 16 1 [
-16 0 0 16 neg 0 16 ] { < DD DD AA AA DD DD FF FF 77 77 AA AA 77 77 FF FF DD
-DD AA AA DD DD FF FF 77 77 AA AA 77 77 FF FF > } image } if PT 16 eq { 16 16
-1 [ 16 0 0 16 neg 0 16 ] { < F1 F1 EE EE 1F 1F FF FF F1 F1 EE EE 1F 1F FF FF
-F1 F1 EE EE 1F 1F FF FF F1 F1 EE EE 1F 1F FF FF > } image } if PT 17 eq { 16
-16 1 [ 16 0 0 16 neg 0 16 ] { < EE EE DD DD BB BB FF FF EE EE DD DD BB BB FF
- FF EE EE DD DD BB BB FF FF EE EE DD DD BB BB FF FF > } image } if PT 18 eq {
-16 16 1 [ 16 0 0 16 neg 0 16 ] { < BB BB DD DD EE EE FF FF BB BB DD DD EE EE
-FF FF BB BB DD DD EE EE FF FF BB BB DD DD EE EE FF FF > } image } if PT 19 eq
-{ 16 16 1 [ 16 0 0 16 neg 0 16 ] { < 1F FC 67 F3 7B EF BD DE BD DE DE BD E6
-B3 F8 0F E6 B3 DE BD BD DE BD DE 7B EF 67 F3 1F FC 7F FF > } image } if PT
-20 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < DD DD EE EE EE EE EE EE DD DD BB
-BB BB BB BB BB DD DD EE EE EE EE EE EE DD DD BB BB BB BB BB BB > } image }
-if PT 21 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < 0E 0E EF EF EF EF EF EF E0
-E0 FE FE FE FE FE FE 0E 0E EF EF EF EF EF EF E0 E0 FE FE FE FE FE FE > }
-image } if PT 22 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < 70 70 F7 F7 F7 F7 F7
-F7 07 07 7F 7F 7F 7F 7F 7F 70 70 F7 F7 F7 F7 F7 F7 07 07 7F 7F 7F 7F 7F 7F >
-} image } if PT 23 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < AA AA 55 55 A9 A9
-D1 D1 E1 E1 D1 D1 A9 A9 55 55 AA AA 55 55 A9 A9 D1 D1 E1 E1 D1 D1 A9 A9 55 55
-> } image } if PT 24 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < FF FE FF FC EA
-A8 D5 54 EA A8 D5 54 E8 28 D4 54 E8 E8 D4 D4 E8 EA 54 D5 A8 EA 54 D5 00 C0 00
-80 > } image } if PT 25 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < FF FE FF FC
-FF F8 FF F0 F0 00 F0 00 F0 20 F0 60 F0 E0 F1 E0 F3 E0 F0 00 E0 00 C0 00 80 00
-00 00 > } image } if gr } def /FA { /PT exch def gsave clip 0 0 translate 1 1
-54 { 1 sub 47.2 mul /Xcurr exch def 1 1 74 { 1 sub 47.2 mul /Ycurr exch def
-gsave Xcurr Ycurr translate PT DP gr } for } for gr } def
-/reencdict 24 dict def /ReEncode {reencdict begin /nco&na exch def
-/nfnam exch def /basefontname exch def /basefontdict basefontname findfont def
-/newfont basefontdict maxlength dict def basefontdict {exch dup /FID ne
-{dup /Encoding eq {exch dup length array copy newfont 3 1 roll put} {exch
-newfont 3 1 roll put} ifelse} {pop pop} ifelse } forall newfont
-/FontName nfnam put nco&na aload pop nco&na length 2 idiv {newfont
-/Encoding get 3 1 roll put} repeat nfnam newfont definefont pop end } def
-/accvec [ 176 /agrave 181 /Agrave 190 /acircumflex 192 /Acircumflex
-201 /adieresis 204 /Adieresis 209 /ccedilla 210 /Ccedilla 211 /eacute
-212 /Eacute 213 /egrave 214 /Egrave 215 /ecircumflex 216 /Ecircumflex
-217 /edieresis 218 /Edieresis 219 /icircumflex 220 /Icircumflex
-221 /idieresis 222 /Idieresis 223 /ntilde 224 /Ntilde 226 /ocircumflex
-228 /Ocircumflex 229 /odieresis 230 /Odieresis 231 /ucircumflex 236 /Ucircumflex
-237 /udieresis 238 /Udieresis 239 /aring 242 /Aring 243 /ydieresis
-244 /Ydieresis 246 /aacute 247 /Aacute 252 /ugrave 253 /Ugrave] def
-/Times-Roman /Times-Roman accvec ReEncode
-/Times-Italic /Times-Italic accvec ReEncode
-/Times-Bold /Times-Bold accvec ReEncode
-/Times-BoldItalic /Times-BoldItalic accvec ReEncode
-/Helvetica /Helvetica accvec ReEncode
-/Helvetica-Oblique /Helvetica-Oblique accvec ReEncode
-/Helvetica-Bold /Helvetica-Bold accvec ReEncode
-/Helvetica-BoldOblique /Helvetica-BoldOblique accvec ReEncode
-/Courier /Courier accvec ReEncode
-/Courier-Oblique /Courier-Oblique accvec ReEncode
-/Courier-Bold /Courier-Bold accvec ReEncode
-/Courier-BoldOblique /Courier-BoldOblique accvec ReEncode
-/oshow {gsave [] 0 sd true charpath stroke gr} def
-/stwn { /fs exch def /fn exch def /text exch def fn findfont fs sf
- text sw pop xs add /xs exch def} def
-/stwb { /fs exch def /fn exch def /nbas exch def /textf exch def
-textf length /tlen exch def nbas tlen gt {/nbas tlen def} if
-fn findfont fs sf textf dup length nbas sub nbas getinterval sw
-pop neg xs add /xs exch def} def
-/accspe [ 65 /plusminus 66 /bar 67 /existential 68 /universal
-69 /exclam 70 /numbersign 71 /greater 72 /question 73 /integral
-74 /colon 75 /semicolon 76 /less 77 /bracketleft 78 /bracketright
-79 /greaterequal 80 /braceleft 81 /braceright 82 /radical
-83 /spade 84 /heart 85 /diamond 86 /club 87 /lessequal
-88 /multiply 89 /percent 90 /infinity 48 /circlemultiply 49 /circleplus
-50 /emptyset 51 /lozenge 52 /bullet 53 /arrowright 54 /arrowup
-55 /arrowleft 56 /arrowdown 57 /arrowboth 48 /degree 44 /comma 43 /plus
- 45 /angle 42 /angleleft 47 /divide 61 /notequal 40 /equivalence 41 /second
- 97 /approxequal 98 /congruent 99 /perpendicular 100 /partialdiff 101 /florin
- 102 /intersection 103 /union 104 /propersuperset 105 /reflexsuperset
- 106 /notsubset 107 /propersubset 108 /reflexsubset 109 /element 110 /notelement
- 111 /gradient 112 /logicaland 113 /logicalor 114 /arrowdblboth
- 115 /arrowdblleft 116 /arrowdblup 117 /arrowdblright 118 /arrowdbldown
- 119 /ampersand 120 /omega1 121 /similar 122 /aleph ] def
-/Symbol /Special accspe ReEncode
-/Zone {/iy exch def /ix exch def ix 1 sub 2224 mul 1 iy sub 3144
- mul t} def
-%%EndProlog
- gsave 20 28 t .25 .25 scale gsave
-%%Page: number 1
- gsave
- 1 1 Zone
- gsave 0 0 t black [] 0 sd 1 lw 2223 2224 0 460 bl 2223 2224 0 460 C 1779 1778
- 222 683 C NC [4 8] 0 sd 222 1314 m 1128 287 d s 222 1449 m 1128 287 d s 222
- 1583 m 1128 287 d s 222 1717 m 1128 287 d s 222 1852 m 1128 287 d s 222 1986 m
- 1128 287 d s 222 2120 m 1128 287 d s [] 0 sd 222 1180 m 1128 287 d s 1350 1467
- m 994 Y s 222 2174 m 1128 287 d s 222 1180 m 994 Y s [4 8] 0 sd 1350 1601 m 651
- -497 d s 1350 1736 m 651 -497 d s 1350 1870 m 651 -497 d s 1350 2004 m 651 -497
- d s 1350 2139 m 651 -497 d s 1350 2273 m 651 -497 d s 1350 2407 m 651 -497 d s
- [] 0 sd 1350 1467 m 651 -497 d s 2001 970 m 994 Y s 1350 2461 m 651 -497 d s
- 1350 1467 m cl s 0.55 0.55 0.55 c 1345 1435 m 24 6 d -21 15 d -23 -6 d f 1322
- 1429 m 23 6 d -20 15 d -24 -6 d f 1298 1423 m 24 6 d -21 15 d -23 -6 d f 1275
- 1417 m 23 6 d -20 15 d -24 -6 d f 1251 1411 m 24 6 d -21 15 d -23 -6 d f 1228
- 1405 m 23 6 d -20 15 d -24 -6 d f 1204 1399 m 24 6 d -21 15 d -23 -6 d f 1181
- 1393 m 23 6 d -20 15 d -24 -6 d f 1157 1387 m 24 6 d -21 15 d -23 -6 d f 1134
- 1381 m 23 6 d -20 15 d -24 -6 d f 1110 1375 m 24 6 d -21 15 d -23 -6 d f 1087
- 1369 m 23 6 d -20 15 d -24 -6 d f 1063 1363 m 24 6 d -21 15 d -23 -6 d f 1040
- 1357 m 23 6 d -20 15 d -24 -6 d f 1016 1351 m 24 6 d -21 15 d -23 -6 d f 993
- 1345 m 23 6 d -20 15 d -24 -5 d f 969 1339 m 24 6 d -21 16 d -23 -6 d f 946
- 1333 m 23 6 d -20 16 d -24 -6 d f 922 1327 m 24 6 d -21 16 d -23 -6 d f 899
- 1321 m 23 6 d -20 16 d -24 -6 d f 875 1315 m 24 6 d -21 16 d -23 -6 d f 852
- 1309 m 23 6 d -20 16 d -24 -6 d f 828 1303 m 24 6 d -21 16 d -23 -6 d f 805
- 1297 m 23 6 d -20 16 d -24 -6 d f 781 1291 m 24 6 d -21 16 d -23 -6 d f 758
- 1285 m 23 6 d -20 16 d -24 -6 d f 734 1279 m 24 6 d -21 16 d -23 -6 d f 711
- 1273 m 23 6 d -20 16 d -23 -6 d f 687 1267 m 24 6 d -20 16 d -24 -6 d f 664
- 1261 m 23 6 d -20 16 d -23 -6 d f 640 1255 m 24 6 d -20 16 d -24 -6 d f 617
- 1249 m 23 6 d -20 16 d -23 -6 d f 0.475 0.475 0.475 c 580 1261 m -7 -2 d 6 -1 d
- f 0.5 0.5 0.5 c 587 1262 m -7 -1 d -1 -3 d 6 X f 0.525 0.525 0.525 c 594 1264 m
- -7 -2 d -2 -4 d 6 -1 d f 0.55 0.55 0.55 c 593 1257 m 24 -8 d -20 16 d -3 -1 d
- -3 -7 d f 0.475 0.475 0.475 c 579 1258 m -6 1 d -23 -6 d 4 -3 d f 0.5 0.5 0.5 c
- 585 1258 m -6 X -25 -8 d 6 -5 d f 0.525 0.525 0.525 c 591 1257 m -6 1 d -25 -13
- d 6 -4 d f 0.55 0.55 0.55 c 570 1237 m 23 20 d -2 X -25 -16 d f 0.475 0.475
- 0.475 c 554 1250 m -4 3 d -5 1 d f 0.5 0.5 0.5 c 560 1245 m -6 5 d -9 4 d -6 2
- d f 0.525 0.525 0.525 c 566 1241 m -6 4 d -21 11 d -7 2 d f 0.55 0.55 0.55 c
- 546 1245 m 24 -8 d -4 4 d -34 17 d -6 2 d f 523 1225 m 23 20 d -20 15 d -3 -2 d
- -14 -22 d f 0.575 0.575 0.575 c 523 1258 m -20 -17 d 6 -5 d f 0.55 0.55 0.55 c
- 499 1219 m 24 6 d -14 11 d -27 X -3 -1 d f 0.575 0.575 0.575 c 509 1236 m -6 5
- d -21 -5 d f 0.55 0.55 0.55 c 476 1213 m 23 6 d -20 16 d -23 -6 d f 452 1207 m
- 24 6 d -20 16 d -24 -6 d f 429 1201 m 23 6 d -20 16 d -23 -6 d f 405 1195 m 24
- 6 d -20 16 d -24 -6 d f 382 1190 m 23 5 d -20 16 d -23 -6 d f 359 1184 m 23 6 d
- -20 15 d -24 -6 d f 335 1178 m 24 6 d -21 15 d -23 -6 d f 312 1172 m 23 6 d -20
- 15 d -24 -6 d f 288 1166 m 24 6 d -21 15 d -23 -6 d f 265 1160 m 23 6 d -20 15
- d -24 -6 d f 1365 1419 m 24 6 d -20 16 d -24 -6 d f 1342 1413 m 23 6 d -20 16 d
- -23 -6 d f 1318 1407 m 24 6 d -20 16 d -24 -6 d f 1295 1401 m 23 6 d -20 16 d
- -23 -6 d f 1271 1395 m 24 6 d -20 16 d -24 -6 d f 1248 1389 m 23 6 d -20 16 d
- -23 -6 d f 1224 1383 m 24 6 d -20 16 d -24 -6 d f 1201 1377 m 23 6 d -20 16 d
- -23 -6 d f 1177 1371 m 24 6 d -20 16 d -24 -6 d f 1154 1365 m 23 6 d -20 16 d
- -23 -6 d f 1131 1359 m 23 6 d -20 16 d -24 -6 d f 1107 1353 m 24 6 d -21 16 d
- -23 -6 d f 1084 1347 m 23 6 d -20 16 d -24 -6 d f 1060 1341 m 24 6 d -21 16 d
- -23 -6 d f 1037 1335 m 23 6 d -20 16 d -24 -6 d f 1013 1329 m 24 6 d -21 16 d
- -23 -6 d f 990 1323 m 23 6 d -20 16 d -24 -6 d f 966 1317 m 24 6 d -21 16 d -23
- -6 d f 943 1312 m 23 5 d -20 16 d -24 -6 d f 919 1306 m 24 6 d -21 15 d -23 -6
- d f 896 1300 m 23 6 d -20 15 d -24 -6 d f 872 1294 m 24 6 d -21 15 d -23 -6 d f
- 849 1288 m 23 6 d -20 15 d -24 -6 d f 0.525 0.525 0.525 c 825 1282 m 1 X -1 X f
- 0.55 0.55 0.55 c 826 1282 m 23 6 d -21 15 d -23 -6 d 20 -15 d f 0.525 0.525
- 0.525 c 818 1280 m 7 2 d f 0.55 0.55 0.55 c 802 1276 m 16 4 d 7 2 d -20 15 d
- -24 -6 d f 778 1270 m 24 6 d -21 15 d -23 -6 d f 755 1264 m 23 6 d -20 15 d -24
- -6 d f 731 1258 m 24 6 d -21 15 d -23 -6 d f 708 1252 m 23 6 d -20 15 d -24 -6
- d f 684 1246 m 24 6 d -21 15 d -23 -6 d f 661 1240 m 23 6 d -20 15 d -24 -6 d f
- 659 1239 m 2 1 d -21 15 d -23 -6 d 9 -7 d f 0.575 0.575 0.575 c 637 1234 m 22 5
- d -33 3 d f 0.55 0.55 0.55 c 626 1242 m -9 7 d -24 8 d 17 -23 d f 0.575 0.575
- 0.575 c 614 1228 m 23 6 d -11 8 d -16 -8 d f 0.55 0.55 0.55 c 590 1235 m 2 X 18
- -1 d -17 23 d -23 -20 d f 0.575 0.575 0.575 c 592 1235 m 22 -7 d -4 6 d f 0.55
- 0.55 0.55 c 567 1216 m 23 19 d -20 2 d -24 8 d f 543 1223 m 24 -7 d -21 29 d
- -23 -20 d f 520 1204 m 23 19 d -20 2 d -24 -6 d f 496 1198 m 24 6 d -21 15 d
- -23 -6 d f 473 1192 m 23 6 d -20 15 d -24 -6 d f 449 1186 m 24 6 d -21 15 d -23
- -6 d f 0.525 0.525 0.525 c 426 1180 m 3 1 d -5 X f 0.55 0.55 0.55 c 429 1181 m
- 20 5 d -20 15 d -24 -6 d 19 -14 d f 0.475 0.475 0.475 c 402 1187 m 7 -2 d -11 3
- d f 0.5 0.5 0.5 c 409 1185 m 9 -2 d -27 6 d 7 -1 d f 0.525 0.525 0.525 c 418
- 1183 m 8 -3 d -2 1 d -39 8 d 6 X f 0.55 0.55 0.55 c 424 1181 m -19 14 d -23 -5
- d 3 -1 d f 0.475 0.475 0.475 c 397 1183 m 5 4 d -4 1 d f 0.5 0.5 0.5 c 391 1178
- m 6 5 d 1 5 d -7 1 d f 0.525 0.525 0.525 c 384 1172 m 7 6 d 11 Y -6 X f 0.55
- 0.55 0.55 c 379 1168 m 5 4 d 1 17 d -3 1 d -23 -6 d f 355 1162 m 24 6 d -20 16
- d -24 -6 d f 332 1156 m 23 6 d -20 16 d -23 -6 d f 308 1150 m 24 6 d -20 16 d
- -24 -6 d f 285 1144 m 23 6 d -20 16 d -23 -6 d f 1386 1404 m 23 6 d -20 15 d
- -24 -6 d f 1362 1398 m 24 6 d -21 15 d -23 -6 d f 1339 1392 m 23 6 d -20 15 d
- -24 -6 d f 0.475 0.475 0.475 c 1315 1399 m 6 -2 d -11 3 d f 0.5 0.5 0.5 c 1321
- 1397 m 7 -2 d -24 5 d 6 X f 0.525 0.525 0.525 c 1328 1395 m 7 -2 d -37 8 d 6 -1
- d f 0.55 0.55 0.55 c 1335 1393 m 4 -1 d -21 15 d -23 -6 d 3 X f 0.475 0.475
- 0.475 c 1310 1395 m 5 4 d -5 1 d f 0.5 0.5 0.5 c 1304 1390 m 6 5 d 5 Y -6 X f
- 0.525 0.525 0.525 c 1297 1384 m 7 6 d 10 Y -6 1 d f 0.55 0.55 0.55 c 1292 1380
- m 5 4 d 1 17 d -3 X -24 -6 d f 1268 1374 m 24 6 d -21 15 d -23 -6 d f 1245 1368
- m 23 6 d -20 15 d -24 -6 d f 1221 1362 m 24 6 d -21 15 d -23 -6 d f 0.525 0.525
- 0.525 c 1198 1356 m 1 X -2 X f 0.55 0.55 0.55 c 1199 1356 m 22 6 d -20 15 d -24
- -6 d 20 -15 d f 0.525 0.525 0.525 c 1174 1350 m 24 6 d -1 X -28 -2 d f 0.55
- 0.55 0.55 c 1197 1356 m -20 15 d -23 -6 d 15 -11 d f 0.525 0.525 0.525 c 1151
- 1344 m 23 6 d -5 4 d -24 -6 d f 0.55 0.55 0.55 c 1169 1354 m -15 11 d -23 -6 d
- 14 -11 d f 0.525 0.525 0.525 c 1127 1338 m 24 6 d -6 4 d -22 -7 d f 0.55 0.55
- 0.55 c 1145 1348 m -14 11 d -24 -6 d 16 -12 d f 0.525 0.525 0.525 c 1104 1332 m
- 23 6 d -4 3 d -23 -6 d f 0.55 0.55 0.55 c 1123 1341 m -16 12 d -23 -6 d 16 -12
- d f 0.525 0.525 0.525 c 1086 1327 m 18 5 d -4 3 d f 0.55 0.55 0.55 c 1080 1326
- m 6 1 d 14 8 d -16 12 d -24 -6 d f 1057 1320 m 23 6 d -20 15 d -23 -6 d f 1033
- 1314 m 24 6 d -20 15 d -24 -6 d f 0.475 0.475 0.475 c 1010 1321 m 6 -1 d -11 2
- d f 0.5 0.5 0.5 c 1016 1320 m 6 -3 d -23 6 d 6 -1 d f 0.525 0.525 0.525 c 1022
- 1317 m 7 -2 d -37 8 d 7 X f 0.55 0.55 0.55 c 1029 1315 m 4 -1 d -20 15 d -23 -6
- d 2 X f 0.45 0.45 0.45 c 986 1302 m 13 10 d -14 -9 d f 0.475 0.475 0.475 c 999
- 1312 m 11 9 d -5 1 d -25 -15 d 5 -4 d f 0.5 0.5 0.5 c 1005 1322 m -6 1 d -25
- -12 d 6 -4 d f 0.525 0.525 0.525 c 999 1323 m -7 X -23 -7 d 5 -5 d f 0.55 0.55
- 0.55 c 992 1323 m -2 X -24 -6 d 3 -1 d f 0.45 0.45 0.45 c 967 1308 m 19 -6 d -1
- 1 d f 0.475 0.475 0.475 c 963 1309 m 4 -1 d 18 -5 d -5 4 d -23 3 d f 0.5 0.5
- 0.5 c 980 1307 m -6 4 d -23 X 6 -1 d f 0.525 0.525 0.525 c 974 1311 m -5 5 d
- -24 -5 d 6 X f 0.55 0.55 0.55 c 969 1316 m -3 1 d -23 -5 d 2 -1 d f 0.475 0.475
- 0.475 c 950 1299 m 13 10 d -6 1 d f 0.5 0.5 0.5 c 939 1290 m 11 9 d 7 11 d -6 1
- d -14 -19 d f 0.525 0.525 0.525 c 951 1311 m -6 X -18 -12 d 10 -7 d f 0.55 0.55
- 0.55 c 945 1311 m -2 1 d -24 -6 d 8 -7 d f 0.5 0.5 0.5 c 933 1288 m 6 2 d -2 2
- d f 0.525 0.525 0.525 c 916 1284 m 17 4 d 4 4 d -10 7 d -18 -10 d f 0.55 0.55
- 0.55 c 927 1299 m -8 7 d -23 -6 d 13 -11 d f 0.525 0.525 0.525 c 892 1278 m 24
- 6 d -7 5 d -23 -6 d f 0.55 0.55 0.55 c 909 1289 m -13 11 d -24 -6 d 14 -11 d f
- 0.475 0.475 0.475 c 869 1272 m f 0.5 0.5 0.5 c 869 1272 m 16 4 d -23 2 d 7 -6 d
- f 0.525 0.525 0.525 c 885 1276 m 7 2 d -6 5 d -32 X 8 -5 d f 0.55 0.55 0.55 c
- 886 1283 m -14 11 d -23 -6 d 5 -5 d f 0.475 0.475 0.475 c 845 1280 m 24 -8 d
- -30 8 d f 0.5 0.5 0.5 c 869 1272 m -7 6 d -30 3 d 7 -1 d f 0.525 0.525 0.525 c
- 862 1278 m -8 5 d -28 -1 d -1 X 7 -1 d f 0.55 0.55 0.55 c 854 1283 m -5 5 d -23
- -6 d f 0.475 0.475 0.475 c 822 1274 m 23 6 d -6 X -23 -6 d f 0.5 0.5 0.5 c 839
- 1280 m -7 1 d -23 -6 d 7 -1 d f 0.525 0.525 0.525 c 832 1281 m -7 1 d -7 -2 d
- -16 -4 d 7 -1 d f 0.55 0.55 0.55 c 818 1280 m -16 -4 d f 0.475 0.475 0.475 c
- 813 1266 m 9 8 d -6 X f 0.5 0.5 0.5 c 804 1259 m 9 7 d 3 8 d -7 1 d f 0.525
- 0.525 0.525 c 799 1254 m 5 5 d 5 16 d -7 1 d -10 -17 d f 0.55 0.55 0.55 c 802
- 1276 m -24 -6 d 14 -11 d f 0.525 0.525 0.525 c 788 1251 m 11 3 d -7 5 d f 0.55
- 0.55 0.55 c 775 1248 m 13 3 d 4 8 d -14 11 d -23 -6 d f 752 1242 m 23 6 d -20
- 16 d -24 -6 d f 728 1236 m 24 6 d -21 16 d -23 -6 d f 705 1230 m 23 6 d -20 16
- d -24 -6 d f 681 1224 m 24 6 d -21 16 d -23 -6 d f 658 1218 m 23 6 d -20 16 d
- -2 -1 d -19 -7 d f 0.575 0.575 0.575 c 659 1239 m -22 -5 d 3 -2 d f 0.525 0.525
- 0.525 c 634 1212 m 21 6 d -28 -1 d f 0.55 0.55 0.55 c 655 1218 m 3 X -18 14 d
- -25 -5 d 12 -10 d f 0.575 0.575 0.575 c 640 1232 m -3 2 d -23 -6 d 1 -1 d f
- 0.475 0.475 0.475 c 611 1220 m 8 -3 d -13 6 d f 0.5 0.5 0.5 c 619 1217 m 10 -3
- d -28 13 d 5 -4 d f 0.525 0.525 0.525 c 629 1214 m 5 -2 d -7 5 d -31 14 d 5 -4
- d f 0.55 0.55 0.55 c 627 1217 m -12 10 d -23 8 d -2 X 6 -4 d f 0.575 0.575
- 0.575 c 615 1227 m -1 1 d -22 7 d f 0.475 0.475 0.475 c 587 1200 m 24 20 d -5 3
- d -23 -19 d f 0.5 0.5 0.5 c 606 1223 m -5 4 d -24 -19 d 6 -4 d f 0.525 0.525
- 0.525 c 601 1227 m -5 4 d -24 -19 d 5 -4 d f 0.55 0.55 0.55 c 596 1231 m -6 4 d
- -23 -19 d 5 -4 d f 0.45 0.45 0.45 c 564 1208 m 5 -2 d -6 2 d f 0.475 0.475
- 0.475 c 569 1206 m 18 -6 d -4 4 d -25 8 d 5 -4 d f 0.5 0.5 0.5 c 583 1204 m -6
- 4 d -25 9 d 6 -5 d f 0.525 0.525 0.525 c 577 1208 m -5 4 d -25 9 d 5 -4 d f
- 0.55 0.55 0.55 c 572 1212 m -5 4 d -24 7 d 4 -2 d f 0.45 0.45 0.45 c 563 1207 m
- 1 1 d -1 X f 0.475 0.475 0.475 c 556 1201 m 7 6 d 1 Y -5 4 d f 0.5 0.5 0.5 c
- 549 1196 m 7 5 d 2 11 d -6 5 d f 0.525 0.525 0.525 c 542 1190 m 7 6 d 3 21 d -5
- 4 d f 0.55 0.55 0.55 c 540 1188 m 2 2 d 5 31 d -4 2 d -23 -19 d f 517 1182 m 23
- 6 d -20 16 d -24 -6 d f 493 1176 m 24 6 d -21 16 d -23 -6 d f 0.475 0.475 0.475
- c 470 1184 m 5 -2 d -10 2 d f 0.5 0.5 0.5 c 475 1182 m 7 -2 d -24 5 d 7 -1 d f
- 0.525 0.525 0.525 c 482 1180 m 7 -2 d -37 8 d 6 -1 d f 0.55 0.55 0.55 c 489
- 1178 m 4 -2 d -20 16 d -24 -6 d 3 X f 0.475 0.475 0.475 c 446 1164 m 24 20 d -5
- X -25 -15 d f 0.5 0.5 0.5 c 465 1184 m -7 1 d -25 -10 d 7 -6 d f 0.525 0.525
- 0.525 c 458 1185 m -6 1 d -23 -5 d -3 -1 d 7 -5 d f 0.55 0.55 0.55 c 452 1186 m
- -3 X -20 -5 d f 0.475 0.475 0.475 c 433 1169 m 13 -5 d -6 5 d -31 16 d -7 2 d
- 12 -8 d f 0.5 0.5 0.5 c 423 1172 m 10 -3 d 7 X -7 6 d -15 8 d -9 2 d 5 -6 d f
- 0.525 0.525 0.525 c 433 1175 m -7 5 d -8 3 d f 0.475 0.475 0.475 c 414 1179 m
- -12 8 d -5 -4 d f 0.5 0.5 0.5 c 419 1169 m 4 3 d -9 7 d -17 4 d -6 -5 d f 0.525
- 0.525 0.525 c 410 1161 m 9 8 d -28 9 d -7 -6 d f 0.55 0.55 0.55 c 400 1153 m 10
- 8 d -26 11 d -5 -4 d 14 -11 d f 0.575 0.575 0.575 c 399 1152 m 1 1 d -7 4 d f
- 0.55 0.55 0.55 c 376 1146 m 2 1 d 15 10 d -14 11 d -24 -6 d f 0.575 0.575 0.575
- c 378 1147 m 21 5 d -6 5 d f 0.55 0.55 0.55 c 352 1140 m 24 6 d -21 16 d -23 -6
- d f 329 1135 m 23 5 d -20 16 d -24 -6 d f 305 1129 m 24 6 d -21 15 d -23 -6 d f
- 1406 1388 m 24 6 d -21 16 d -23 -6 d f 1383 1382 m 23 6 d -20 16 d -24 -6 d f
- 1359 1376 m 24 6 d -21 16 d -23 -6 d f 0.475 0.475 0.475 c 1336 1384 m 5 -2 d
- -20 15 d -6 2 d f 0.5 0.5 0.5 c 1341 1382 m 7 -2 d -20 15 d -7 2 d f 0.525
- 0.525 0.525 c 1348 1380 m 6 -2 d -19 15 d -7 2 d f 0.55 0.55 0.55 c 1354 1378 m
- 5 -2 d -20 16 d -4 1 d f 0.475 0.475 0.475 c 1327 1376 m 9 8 d -21 15 d -5 -4 d
- f 0.5 0.5 0.5 c 1316 1367 m 11 9 d -17 19 d -6 -5 d f 0.525 0.525 0.525 c 1312
- 1364 m 4 3 d -12 23 d -7 -6 d 6 -13 d f 0.55 0.55 0.55 c 1297 1384 m -5 -4 d 11
- -9 d f 0.525 0.525 0.525 c 1289 1358 m 23 6 d -9 7 d -22 -7 d f 0.55 0.55 0.55
- c 1303 1371 m -11 9 d -24 -6 d 13 -10 d f 0.45 0.45 0.45 c 1265 1366 m 1 X -1 X
- f 0.475 0.475 0.475 c 1266 1366 m 8 -3 d -15 3 d 6 X f 0.5 0.5 0.5 c 1274 1363
- m 9 -3 d -30 7 d 6 -1 d f 0.525 0.525 0.525 c 1283 1360 m 6 -2 d -8 6 d -34 3 d
- 6 X f 0.55 0.55 0.55 c 1281 1364 m -13 10 d -23 -6 d 2 -1 d f 0.45 0.45 0.45 c
- 1248 1352 m 17 14 d f 0.475 0.475 0.475 c 1242 1346 m 6 6 d 17 14 d -6 X -23
- -15 d f 0.5 0.5 0.5 c 1259 1366 m -6 1 d -23 -12 d 6 -4 d f 0.525 0.525 0.525 c
- 1253 1367 m -6 X -23 -7 d 6 -5 d f 0.55 0.55 0.55 c 1247 1367 m -2 1 d -24 -6 d
- 3 -2 d f 0.475 0.475 0.475 c 1218 1354 m 24 -8 d -6 5 d -24 3 d f 0.5 0.5 0.5 c
- 1236 1351 m -6 4 d -25 X 7 -1 d f 0.525 0.525 0.525 c 1230 1355 m -6 5 d -25 -4
- d -1 X 7 -1 d f 0.55 0.55 0.55 c 1224 1360 m -3 2 d -22 -6 d f 0.45 0.45 0.45 c
- 1195 1348 m 5 1 d -6 -1 d f 0.475 0.475 0.475 c 1200 1349 m 18 5 d -6 X -25 -6
- d 7 X f 0.5 0.5 0.5 c 1212 1354 m -7 1 d -26 -6 d 8 -1 d f 0.525 0.525 0.525 c
- 1205 1355 m -7 1 d -24 -6 d 5 -1 d f 0.425 0.425 0.425 c 1171 1355 m 12 -4 d
- -16 2 d f 0.45 0.45 0.45 c 1183 1351 m 12 -3 d -1 X -32 2 d 5 3 d f 0.475 0.475
- 0.475 c 1194 1348 m -36 X 4 2 d f 0.5 0.5 0.5 c 1187 1348 m -8 1 d -25 -4 d 4 3
- d f 0.525 0.525 0.525 c 1179 1349 m -5 1 d -23 -6 d 3 1 d f 0.425 0.425 0.425 c
- 1152 1350 m 19 5 d -4 -2 d f 0.45 0.45 0.45 c 1148 1349 m 4 1 d 15 3 d -5 -3 d
- -19 -3 d f 0.475 0.475 0.475 c 1162 1350 m -4 -2 d -21 -5 d 6 4 d f 0.5 0.5 0.5
- c 1158 1348 m -4 -3 d -22 -5 d 5 3 d f 0.525 0.525 0.525 c 1154 1345 m -3 -1 d
- -24 -6 d 5 2 d f 0.45 0.45 0.45 c 1124 1330 m 24 19 d -5 -2 d -23 -17 d f 0.475
- 0.475 0.475 c 1143 1347 m -6 -4 d -23 -12 d 6 -1 d f 0.5 0.5 0.5 c 1137 1343 m
- -5 -3 d -24 -9 d 6 X f 0.525 0.525 0.525 c 1132 1340 m -5 -2 d -23 -6 d 4 -1 d
- f 0.45 0.45 0.45 c 1101 1324 m 23 6 d -4 X -22 -6 d f 0.475 0.475 0.475 c 1120
- 1330 m -6 1 d -22 -6 d 6 -1 d f 0.5 0.5 0.5 c 1114 1331 m -6 X -21 -6 d 5 X f
- 0.525 0.525 0.525 c 1108 1331 m -4 1 d -18 -5 d -5 -1 d 6 -1 d f 0.55 0.55 0.55
- c 1086 1327 m -6 -1 d 1 X f 0.45 0.45 0.45 c 1098 1322 m 3 2 d -3 X f 0.475
- 0.475 0.475 c 1092 1317 m 6 5 d 2 Y -6 1 d f 0.5 0.5 0.5 c 1087 1312 m 5 5 d 8
- Y -5 X f 0.525 0.525 0.525 c 1081 1307 m 6 5 d 13 Y -6 1 d f 0.55 0.55 0.55 c
- 1077 1304 m 4 3 d 19 Y -1 X -23 -6 d f 1054 1298 m 23 6 d -20 16 d -24 -6 d f
- 0.475 0.475 0.475 c 1030 1306 m 3 -1 d -17 15 d -6 1 d f 0.5 0.5 0.5 c 1033
- 1305 m 7 -2 d -18 14 d -6 3 d f 0.525 0.525 0.525 c 1040 1303 m 8 -3 d -19 15 d
- -7 2 d f 0.55 0.55 0.55 c 1048 1300 m 6 -2 d -21 16 d -4 1 d f 0.45 0.45 0.45 c
- 999 1312 m -13 -10 d 13 16 d f 0.475 0.475 0.475 c 1007 1327 m 23 -21 d -20 15
- d -11 -9 d 6 Y f 0.45 0.45 0.45 c 999 1318 m -13 -16 d -19 6 d f 0.475 0.475
- 0.475 c 983 1280 m 24 47 d -8 -9 d -32 -10 d -4 1 d f 960 1301 m 23 -21 d -20
- 29 d -13 -10 d 2 -2 d f 0.5 0.5 0.5 c 950 1299 m -11 -9 d 13 7 d f 0.475 0.475
- 0.475 c 954 1300 m 6 1 d -8 -4 d f 0.5 0.5 0.5 c 944 1297 m 10 3 d -2 -3 d -13
- -7 d -6 -2 d f 0.525 0.525 0.525 c 936 1295 m 8 2 d -11 -9 d -17 -4 d f 0.475
- 0.475 0.475 c 913 1289 m 6 2 d -12 -5 d f 0.5 0.5 0.5 c 919 1291 m 10 3 d -32
- -13 d 10 5 d f 0.525 0.525 0.525 c 929 1294 m 7 1 d -20 -11 d -24 -6 d 5 3 d f
- 0.45 0.45 0.45 c 889 1283 m 5 2 d -6 -3 d f 0.475 0.475 0.475 c 894 1285 m 19 4
- d -6 -3 d -38 -14 d 19 10 d f 0.5 0.5 0.5 c 907 1286 m -10 -5 d -12 -5 d -16 -4
- d f 0.525 0.525 0.525 c 897 1281 m -5 -3 d -7 -2 d f 0.45 0.45 0.45 c 866 1264
- m 23 19 d -1 -1 d -38 -6 d f 0.475 0.475 0.475 c 888 1282 m -19 -10 d -24 8 d 5
- -4 d f 0.45 0.45 0.45 c 857 1257 m 9 7 d -16 12 d f 0.475 0.475 0.475 c 842
- 1245 m 15 12 d -7 19 d -5 4 d -23 -6 d f 0.45 0.45 0.45 c 819 1265 m 13 -11 d
- -15 10 d f 0.475 0.475 0.475 c 832 1254 m 10 -9 d -20 29 d -9 -8 d -3 -5 d 7 3
- d f 0.5 0.5 0.5 c 813 1266 m -9 -7 d -1 -2 d 7 4 d f 0.525 0.525 0.525 c 804
- 1259 m -5 -5 d 4 3 d f 0.45 0.45 0.45 c 795 1233 m 24 32 d -2 -1 d -25 -29 d f
- 0.475 0.475 0.475 c 817 1264 m -7 -3 d -23 -22 d 5 -4 d f 0.5 0.5 0.5 c 810
- 1261 m -7 -4 d -21 -14 d 5 -4 d f 0.525 0.525 0.525 c 803 1257 m -4 -3 d -11 -3
- d -11 -4 d 5 -4 d f 0.55 0.55 0.55 c 788 1251 m -13 -3 d 2 -1 d f 0.45 0.45
- 0.45 c 772 1253 m 23 -20 d -3 2 d -23 17 d f 0.475 0.475 0.475 c 792 1235 m -5
- 4 d -23 10 d 5 3 d f 0.5 0.5 0.5 c 787 1239 m -5 4 d -23 3 d 5 3 d f 0.525
- 0.525 0.525 c 782 1243 m -5 4 d -23 -4 d 5 3 d f 0.55 0.55 0.55 c 777 1247 m -2
- 1 d -23 -6 d 2 1 d f 0.45 0.45 0.45 c 754 1229 m 18 24 d -3 -1 d f 0.475 0.475
- 0.475 c 748 1221 m 6 8 d 15 23 d -5 -3 d -21 -25 d f 0.5 0.5 0.5 c 764 1249 m
- -5 -3 d -22 -17 d 6 -5 d f 0.525 0.525 0.525 c 759 1246 m -5 -3 d -23 -9 d 6 -5
- d f 0.55 0.55 0.55 c 754 1243 m -2 -1 d -24 -6 d 3 -2 d f 0.475 0.475 0.475 c
- 725 1242 m 23 -21 d -5 3 d -23 15 d f 0.5 0.5 0.5 c 743 1224 m -6 5 d -23 6 d 6
- 4 d f 0.525 0.525 0.525 c 737 1229 m -6 5 d -24 -2 d 7 3 d f 0.55 0.55 0.55 c
- 731 1234 m -3 2 d -23 -6 d 2 2 d f 0.475 0.475 0.475 c 701 1209 m 24 33 d -5 -3
- d -24 -26 d f 0.5 0.5 0.5 c 720 1239 m -6 -4 d -24 -18 d 6 -4 d f 0.525 0.525
- 0.525 c 714 1235 m -7 -3 d -23 -10 d 6 -5 d f 0.55 0.55 0.55 c 707 1232 m -2 -2
- d -24 -6 d 3 -2 d f 0.475 0.475 0.475 c 690 1212 m 11 -3 d -5 4 d f 0.5 0.5 0.5
- c 678 1216 m 12 -4 d 6 1 d -6 4 d -13 -1 d f 0.525 0.525 0.525 c 690 1217 m -6
- 5 d -25 -4 d 18 -2 d f 0.55 0.55 0.55 c 684 1222 m -3 2 d -23 -6 d 1 X f 0.5
- 0.5 0.5 c 654 1224 m 24 -8 d -1 X -34 1 d f 0.525 0.525 0.525 c 677 1216 m -18
- 2 d -4 X -21 -6 d 9 5 d f 0.55 0.55 0.55 c 659 1218 m -4 X f 0.45 0.45 0.45 c
- 631 1191 m 2 2 d -9 8 d f 0.475 0.475 0.475 c 633 1193 m 15 22 d -29 2 d -8 3 d
- 13 -19 d f 0.5 0.5 0.5 c 648 1215 m 6 9 d -11 -7 d -14 -3 d -10 3 d f 0.525
- 0.525 0.525 c 643 1217 m -9 -5 d -5 2 d f 0.45 0.45 0.45 c 607 1212 m 24 -21 d
- -7 10 d -24 7 d f 0.475 0.475 0.475 c 624 1201 m -13 19 d -24 -20 d 13 8 d f
- 0.45 0.45 0.45 c 584 1192 m 23 20 d -7 -4 d -31 -2 d -5 2 d f 0.475 0.475 0.475
- c 600 1208 m -13 -8 d -18 6 d f 0.45 0.45 0.45 c 560 1186 m 24 6 d -20 16 d -1
- -1 d -4 -21 d f 0.475 0.475 0.475 c 563 1207 m -7 -6 d -3 -14 d 6 -1 d f 0.5
- 0.5 0.5 c 556 1201 m -7 -5 d -2 -8 d 6 -1 d f 0.525 0.525 0.525 c 549 1196 m -7
- -6 d -1 -2 d 6 X f 0.55 0.55 0.55 c 542 1190 m -2 -2 d 1 X f 0.45 0.45 0.45 c
- 559 1185 m 1 1 d -1 X f 0.475 0.475 0.475 c 552 1179 m 7 6 d 1 Y -6 1 d f 0.5
- 0.5 0.5 c 544 1173 m 8 6 d 1 8 d -6 1 d f 0.525 0.525 0.525 c 537 1167 m 7 6 d
- 3 15 d -6 X -6 -20 d f 0.55 0.55 0.55 c 541 1188 m -1 X -23 -6 d 18 -14 d f
- 0.525 0.525 0.525 c 513 1161 m 24 6 d -2 1 d -33 1 d f 0.55 0.55 0.55 c 535
- 1168 m -18 14 d -24 -6 d 9 -7 d f 0.45 0.45 0.45 c 490 1168 m 3 -1 d -16 11 d f
- 0.475 0.475 0.475 c 493 1167 m 9 -2 d -27 17 d -5 2 d 7 -6 d f 0.5 0.5 0.5 c
- 502 1165 m 9 -3 d -29 18 d -7 2 d f 0.525 0.525 0.525 c 511 1162 m 2 -1 d -11 8
- d -13 9 d -7 2 d f 0.55 0.55 0.55 c 502 1169 m -9 7 d -4 2 d f 0.45 0.45 0.45 c
- 467 1162 m 23 6 d -13 10 d -26 -14 d f 0.475 0.475 0.475 c 477 1178 m -7 6 d
- -24 -20 d 5 X f 0.45 0.45 0.45 c 443 1156 m 24 6 d -16 2 d -10 -6 d f 0.475
- 0.475 0.475 c 451 1164 m -5 X -13 5 d -3 -2 d 11 -9 d f 0.5 0.5 0.5 c 433 1169
- m -10 3 d 7 -5 d f 0.45 0.45 0.45 c 441 1155 m 2 1 d -2 2 d f 0.475 0.475 0.475
- c 433 1148 m 8 7 d 3 Y -11 9 d f 0.5 0.5 0.5 c 425 1142 m 8 6 d -3 19 d -7 5 d
- -4 -3 d f 0.525 0.525 0.525 c 420 1137 m 5 5 d -6 27 d -9 -8 d 5 -21 d f 0.55
- 0.55 0.55 c 410 1161 m -10 -8 d -1 Y 15 -12 d f 0.575 0.575 0.575 c 400 1153 m
- -1 -1 d 1 X f 0.525 0.525 0.525 c 413 1135 m 7 2 d -5 3 d f 0.55 0.55 0.55 c
- 396 1131 m 17 4 d 2 5 d -15 12 d -22 -5 d -2 -1 d f 0.575 0.575 0.575 c 400
- 1152 m -1 X -21 -5 d f 0.55 0.55 0.55 c 373 1125 m 23 6 d -20 15 d -24 -6 d f
- 349 1119 m 24 6 d -21 15 d -23 -5 d f 326 1113 m 23 6 d -20 16 d -24 -6 d f
- 1426 1373 m 24 6 d -20 15 d -24 -6 d f 1403 1367 m 23 6 d -20 15 d -23 -6 d f
- 1379 1361 m 24 6 d -20 15 d -24 -6 d f 0.425 0.425 0.425 c 1356 1381 m 4 -3 d
- -13 4 d f 0.45 0.45 0.45 c 1360 1378 m 4 -4 d -27 9 d 10 -1 d f 0.475 0.475
- 0.475 c 1364 1374 m 4 -4 d -27 12 d -5 2 d 1 -1 d f 0.5 0.5 0.5 c 1368 1370 m 5
- -3 d -25 13 d -7 2 d f 0.525 0.525 0.525 c 1373 1367 m 4 -4 d -23 15 d -6 2 d f
- 0.55 0.55 0.55 c 1377 1363 m 2 -2 d -20 15 d -5 2 d f 0.425 0.425 0.425 c 1334
- 1401 m 22 -20 d -9 1 d f 0.45 0.45 0.45 c 1332 1402 m 2 -1 d 13 -19 d -10 1 d
- -10 8 d f 0.475 0.475 0.475 c 1337 1383 m -1 1 d -9 -8 d -7 4 d 7 11 d f 0.5
- 0.5 0.5 c 1327 1376 m -11 -9 d -2 1 d 6 12 d f 0.525 0.525 0.525 c 1316 1367 m
- -4 -3 d 2 4 d f 0.45 0.45 0.45 c 1314 1356 m 18 46 d -5 -11 d f 0.475 0.475
- 0.475 c 1309 1343 m 5 13 d 13 35 d -7 -11 d -17 -32 d f 0.5 0.5 0.5 c 1320 1380
- m -6 -12 d -20 -14 d 9 -6 d f 0.525 0.525 0.525 c 1314 1368 m -2 -4 d -23 -6 d
- 5 -4 d f 0.45 0.45 0.45 c 1285 1377 m 15 -22 d -34 11 d -1 X f 0.475 0.475
- 0.475 c 1300 1355 m 9 -12 d -6 5 d -29 15 d -8 3 d f 0.5 0.5 0.5 c 1303 1348 m
- -9 6 d -11 6 d -9 3 d f 0.525 0.525 0.525 c 1294 1354 m -5 4 d -6 2 d f 0.45
- 0.45 0.45 c 1262 1344 m 23 33 d -20 -11 d -17 -14 d -6 -6 d f 0.475 0.475 0.475
- c 1248 1352 m -6 -6 d f 0.45 0.45 0.45 c 1243 1339 m 19 5 d -20 2 d f 0.475
- 0.475 0.475 c 1239 1338 m 4 1 d -1 7 d -24 8 d f 0.425 0.425 0.425 c 1215 1346
- m 11 -4 d -21 5 d f 0.45 0.45 0.45 c 1226 1342 m 11 -3 d -37 10 d -5 -1 d 10 -1
- d f 0.475 0.475 0.475 c 1237 1339 m 2 -1 d -21 16 d -18 -5 d f 0.425 0.425
- 0.425 c 1199 1351 m 16 -5 d -10 1 d -22 4 d -12 4 d 14 -1 d f 0.45 0.45 0.45 c
- 1192 1353 m 7 -2 d 6 -4 d -10 1 d -12 3 d 2 3 d f 0.425 0.425 0.425 c 1185 1354
- m -14 1 d -19 -5 d f 0.45 0.45 0.45 c 1168 1347 m 24 6 d -7 1 d -33 -4 d -4 -1
- d f 1145 1328 m 23 19 d -20 2 d -24 -19 d f 0.425 0.425 0.425 c 1121 1335 m 6
- -2 d -10 X f 0.45 0.45 0.45 c 1127 1333 m 18 -5 d -21 2 d -23 -6 d 16 9 d f
- 0.425 0.425 0.425 c 1120 1333 m 1 2 d -4 -2 d f 0.45 0.45 0.45 c 1112 1316 m 8
- 17 d -3 X -16 -9 d -3 -2 d f 0.475 0.475 0.475 c 1103 1300 m 9 16 d -14 6 d -6
- -5 d f 0.5 0.5 0.5 c 1098 1289 m 5 11 d -11 17 d -5 -5 d 8 -21 d f 0.525 0.525
- 0.525 c 1087 1312 m -6 -5 d 3 -8 d 11 -8 d f 0.55 0.55 0.55 c 1081 1307 m -4 -3
- d 7 -5 d f 0.5 0.5 0.5 c 1074 1283 m 24 6 d -3 2 d -24 -6 d f 0.525 0.525 0.525
- c 1095 1291 m -11 8 d -22 -7 d 9 -7 d f 0.55 0.55 0.55 c 1084 1299 m -7 5 d -23
- -6 d 8 -6 d f 0.475 0.475 0.475 c 1051 1290 m 12 -4 d -30 19 d -3 1 d f 0.5 0.5
- 0.5 c 1063 1286 m 11 -3 d -3 2 d -31 18 d -7 2 d f 0.525 0.525 0.525 c 1071
- 1285 m -9 7 d -14 8 d -8 3 d f 0.55 0.55 0.55 c 1062 1292 m -8 6 d -6 2 d f
- 0.45 0.45 0.45 c 1027 1284 m 17 5 d -34 32 d f 0.475 0.475 0.475 c 1044 1289 m
- 7 1 d -21 16 d -23 21 d 3 -6 d f 0.45 0.45 0.45 c 1004 1265 m 23 19 d -17 37 d
- -11 -53 d f 0.475 0.475 0.475 c 1010 1321 m -3 6 d -24 -47 d 16 -12 d f 0.45
- 0.45 0.45 c 1002 1265 m 2 X -5 3 d f 0.475 0.475 0.475 c 996 1267 m 6 -2 d -3 3
- d -16 12 d -23 21 d 3 -5 d f 0.5 0.5 0.5 c 989 1269 m 7 -2 d -33 29 d 7 -10 d f
- 0.525 0.525 0.525 c 983 1271 m 6 -2 d -19 17 d 7 -9 d f 0.55 0.55 0.55 c 980
- 1272 m 3 -1 d -6 6 d f 0.475 0.475 0.475 c 963 1296 m -3 5 d -6 -1 d f 0.5 0.5
- 0.5 c 970 1286 m -7 10 d -9 4 d -10 -3 d f 0.525 0.525 0.525 c 977 1277 m -7 9
- d -26 11 d -8 -2 d 1 -1 d f 0.55 0.55 0.55 c 978 1271 m 2 1 d -3 5 d -40 17 d 2
- -5 d f 0.575 0.575 0.575 c 975 1268 m 3 3 d -39 18 d 3 -5 d f 0.6 0.6 0.6 c 972
- 1266 m 3 2 d -33 16 d 2 -5 d f 0.625 0.625 0.625 c 969 1263 m 3 3 d -28 13 d 3
- -5 d f 0.65 0.65 0.65 c 966 1261 m 3 2 d -22 11 d 2 -5 d f 0.675 0.675 0.675 c
- 963 1258 m 3 3 d -17 8 d 2 -5 d f 0.7 0.7 0.7 c 960 1256 m 3 2 d -12 6 d 3 -5 d
- f 0.725 0.725 0.725 c 957 1253 m 3 3 d -6 3 d 2 -5 d f 0.75 0.75 0.75 c 957
- 1253 m -1 1 d f 0.475 0.475 0.475 c 933 1247 m 1 X -15 44 d -6 -2 d f 0.5 0.5
- 0.5 c 934 1247 m 2 1 d -7 46 d -10 -3 d f 0.525 0.525 0.525 c 936 1248 m 2 X -1
- 46 d -1 1 d -7 -1 d f 0.55 0.55 0.55 c 938 1248 m 2 1 d -1 40 d -2 5 d f 0.575
- 0.575 0.575 c 940 1249 m 3 X -1 35 d -3 5 d f 0.6 0.6 0.6 c 943 1249 m 2 1 d -1
- 29 d -2 5 d f 0.625 0.625 0.625 c 945 1250 m 2 1 d 23 Y -3 5 d f 0.65 0.65 0.65
- c 947 1251 m 2 X 18 Y -2 5 d f 0.675 0.675 0.675 c 949 1251 m 3 1 d -1 12 d -2
- 5 d f 0.7 0.7 0.7 c 952 1252 m 2 X 7 Y -3 5 d f 0.725 0.725 0.725 c 954 1252 m
- 2 1 d 1 Y -2 5 d f 0.75 0.75 0.75 c 956 1253 m 1 X -1 1 d f 0.45 0.45 0.45 c
- 910 1268 m 8 -7 d -24 24 d -5 -2 d f 0.475 0.475 0.475 c 918 1261 m 15 -14 d
- -20 42 d -19 -4 d f 0.45 0.45 0.45 c 886 1248 m 24 20 d -21 15 d -23 -19 d f
- 863 1256 m 23 -8 d -20 16 d -9 -7 d -6 -8 d f 0.475 0.475 0.475 c 857 1257 m
- -15 -12 d 9 4 d f 0.425 0.425 0.425 c 839 1250 m 14 3 d -25 6 d f 0.45 0.45
- 0.45 c 853 1253 m 10 3 d -12 -7 d -19 5 d -13 11 d 9 -6 d f 0.475 0.475 0.475 c
- 851 1249 m -9 -4 d -10 9 d f 0.425 0.425 0.425 c 816 1271 m 23 -21 d -11 9 d
- -29 -20 d f 0.45 0.45 0.45 c 828 1259 m -9 6 d -24 -32 d 4 6 d f 0.425 0.425
- 0.425 c 792 1225 m 24 46 d -17 -32 d -20 4 d f 0.45 0.45 0.45 c 799 1239 m -4
- -6 d -23 20 d 7 -10 d f 0.425 0.425 0.425 c 781 1215 m 11 10 d -13 18 d f 0.45
- 0.45 0.45 c 769 1205 m 12 10 d -2 28 d -7 10 d -18 -24 d 4 -15 d f 0.475 0.475
- 0.475 c 754 1229 m -6 -8 d 10 -7 d f 0.45 0.45 0.45 c 745 1213 m 24 -8 d -11 9
- d -23 13 d f 0.475 0.475 0.475 c 758 1214 m -10 7 d -23 21 d 10 -15 d f 0.45
- 0.45 0.45 c 724 1195 m 21 18 d -10 14 d f 0.475 0.475 0.475 c 722 1193 m 2 2 d
- 11 32 d -10 15 d -24 -33 d f 712 1202 m 10 -9 d -21 16 d -11 3 d f 0.5 0.5 0.5
- c 702 1211 m 10 -9 d -22 10 d -12 4 d 2 X f 0.525 0.525 0.525 c 698 1214 m 4 -3
- d -22 5 d f 0.5 0.5 0.5 c 675 1195 m 16 13 d -11 8 d -2 X -24 8 d f 0.525 0.525
- 0.525 c 691 1208 m 7 6 d -18 2 d f 0.45 0.45 0.45 c 651 1216 m 8 -7 d -26 -16 d
- -2 -2 d f 0.475 0.475 0.475 c 659 1209 m 14 -13 d -25 19 d -15 -22 d f 0.5 0.5
- 0.5 c 673 1196 m 2 -1 d -21 29 d -6 -9 d f 0.45 0.45 0.45 c 628 1196 m 23 20 d
- -20 -25 d -24 21 d f 604 1177 m 24 19 d -21 16 d -23 -20 d f 581 1184 m 23 -7 d
- -20 15 d -24 -6 d f 557 1151 m 24 33 d -21 2 d -1 -1 d -4 -32 d f 0.475 0.475
- 0.475 c 559 1185 m -7 -6 d -3 -21 d 6 -5 d f 0.5 0.5 0.5 c 552 1179 m -8 -6 d
- -1 -11 d 6 -4 d f 0.525 0.525 0.525 c 544 1173 m -7 -6 d 6 -5 d f 0.425 0.425
- 0.425 c 534 1172 m 14 -12 d -19 10 d f 0.45 0.45 0.45 c 548 1160 m 9 -9 d -2 2
- d -31 14 d 5 3 d f 0.475 0.475 0.475 c 555 1153 m -6 5 d -29 6 d 4 3 d f 0.5
- 0.5 0.5 c 549 1158 m -6 4 d -28 X 5 2 d f 0.525 0.525 0.525 c 543 1162 m -6 5 d
- -24 -6 d 2 1 d f 0.425 0.425 0.425 c 523 1181 m 11 -9 d -5 -2 d f 0.45 0.45
- 0.45 c 513 1191 m 10 -10 d 6 -11 d -5 -3 d -31 X -3 1 d 11 14 d f 0.475 0.475
- 0.475 c 510 1193 m 3 -2 d 11 -24 d -4 -3 d -18 1 d -9 2 d 8 15 d f 0.5 0.5 0.5
- c 520 1164 m -5 -2 d -4 X -9 3 d f 0.525 0.525 0.525 c 515 1162 m -2 -1 d -2 1
- d f 0.45 0.45 0.45 c 487 1187 m 16 4 d -2 -9 d -11 -14 d -23 -6 d f 0.475 0.475
- 0.475 c 503 1191 m 7 2 d -9 -11 d f 0.425 0.425 0.425 c 463 1141 m 8 15 d -12
- -12 d f 0.45 0.45 0.45 c 471 1156 m 16 31 d -20 -25 d -24 -6 d 16 -12 d f 0.425
- 0.425 0.425 c 440 1175 m 23 -34 d -4 3 d -20 30 d f 0.45 0.45 0.45 c 459 1144 m
- -16 12 d -2 -1 d -7 9 d 5 10 d f 0.475 0.475 0.475 c 441 1155 m -8 -7 d -4 6 d
- 5 10 d f 0.5 0.5 0.5 c 433 1148 m -8 -6 d -2 2 d 6 10 d f 0.525 0.525 0.525 c
- 425 1142 m -5 -5 d 3 7 d f 0.425 0.425 0.425 c 439 1174 m 1 1 d -1 -1 d f 0.45
- 0.45 0.45 c 435 1162 m 4 12 d -5 -10 d f 0.475 0.475 0.475 c 430 1151 m 5 11 d
- -1 2 d -5 -10 d f 0.5 0.5 0.5 c 426 1139 m 4 12 d -1 3 d -6 -10 d f 0.525 0.525
- 0.525 c 421 1127 m 5 12 d -3 5 d -3 -7 d -7 -2 d f 0.55 0.55 0.55 c 416 1115 m
- 5 12 d -8 8 d -17 -4 d f 393 1109 m 23 6 d -20 16 d -23 -6 d f 369 1103 m 24 6
- d -20 16 d -24 -6 d f 346 1097 m 23 6 d -20 16 d -23 -6 d f 1447 1357 m 23 6 d
- -20 16 d -24 -6 d f 1423 1351 m 24 6 d -21 16 d -23 -6 d f 1400 1345 m 23 6 d
- -20 16 d -24 -6 d f 0.425 0.425 0.425 c 1360 1378 m -4 3 d 9 12 d f 0.45 0.45
- 0.45 c 1364 1374 m -4 4 d 5 15 d 9 11 d f 0.475 0.475 0.475 c 1376 1406 m 5 -13
- d -13 -23 d -4 4 d 10 30 d f 0.5 0.5 0.5 c 1381 1393 m 7 -18 d -15 -8 d -5 3 d
- f 0.525 0.525 0.525 c 1388 1375 m 7 -17 d -18 5 d -4 4 d f 0.55 0.55 0.55 c
- 1395 1358 m 5 -13 d -21 16 d -2 2 d f 0.425 0.425 0.425 c 1365 1393 m -9 -12 d
- -22 20 d f 0.45 0.45 0.45 c 1353 1333 m 19 60 d 2 11 d -9 -11 d -31 8 d -2 1 d
- f 0.475 0.475 0.475 c 1372 1393 m 4 13 d -2 -2 d f 0.425 0.425 0.425 c 1329
- 1341 m 24 -8 d -33 8 d f 0.45 0.45 0.45 c 1353 1333 m -21 69 d -18 -46 d -3 -14
- d 9 -1 d f 0.475 0.475 0.475 c 1314 1356 m -5 -13 d 2 -1 d f 0.425 0.425 0.425
- c 1306 1361 m 23 -20 d -9 X -27 30 d f 0.45 0.45 0.45 c 1320 1341 m -9 1 d -11
- 13 d -15 22 d 8 -6 d f 0.475 0.475 0.475 c 1311 1342 m -2 1 d -9 12 d f 0.425
- 0.425 0.425 c 1282 1369 m 24 -8 d -13 10 d -18 -11 d f 0.45 0.45 0.45 c 1293
- 1371 m -8 6 d -23 -33 d 13 16 d f 0.425 0.425 0.425 c 1259 1323 m 23 46 d -7 -9
- d -26 -30 d f 0.45 0.45 0.45 c 1275 1360 m -13 -16 d -19 -5 d -3 -2 d 9 -7 d f
- 0.475 0.475 0.475 c 1243 1339 m -4 -1 d 1 -1 d f 0.425 0.425 0.425 c 1252 1341
- m 7 -18 d -10 7 d -23 12 d -11 4 d 6 11 d f 0.45 0.45 0.45 c 1245 1359 m 7 -18
- d -3 -11 d -9 7 d -3 2 d -11 3 d -5 15 d 6 11 d f 0.475 0.475 0.475 c 1238 1377
- m 7 -18 d -5 -22 d -1 1 d -2 1 d -10 29 d 6 12 d f 0.5 0.5 0.5 c 1235 1384 m 3
- -7 d -5 3 d f 0.425 0.425 0.425 c 1221 1357 m -6 -11 d -16 5 d f 0.45 0.45 0.45
- c 1227 1368 m -6 -11 d -22 -6 d -7 2 d 3 10 d f 0.475 0.475 0.475 c 1233 1380 m
- -6 -12 d -32 -5 d 7 17 d f 0.5 0.5 0.5 c 1222 1396 m 13 -12 d -2 -4 d -31 X 7
- 17 d f 0.525 0.525 0.525 c 1212 1405 m 10 -9 d -13 1 d f 0.45 0.45 0.45 c 1188
- 1305 m 6 24 d 1 34 d -3 -10 d -24 -6 d f 0.475 0.475 0.475 c 1194 1329 m 7 31 d
- 1 20 d -7 -17 d f 0.5 0.5 0.5 c 1201 1360 m 8 31 d 6 Y -7 -17 d f 0.525 0.525
- 0.525 c 1209 1391 m 3 14 d -3 -8 d f 0.425 0.425 0.425 c 1165 1352 m 19 -39 d
- -33 23 d f 0.45 0.45 0.45 c 1184 1313 m 4 -8 d -20 42 d -23 -19 d 6 8 d f 0.425
- 0.425 0.425 c 1151 1341 m 14 11 d -14 -16 d -24 -3 d -6 2 d 4 X f 0.45 0.45
- 0.45 c 1141 1333 m 10 8 d -5 Y -6 -8 d -18 5 d -2 2 d f 0.425 0.425 0.425 c
- 1125 1335 m -4 X -1 -2 d f 0.45 0.45 0.45 c 1118 1327 m 23 6 d -16 2 d -5 -2 d
- -8 -17 d 3 5 d f 0.475 0.475 0.475 c 1112 1316 m -9 -16 d 2 2 d 10 19 d f 0.5
- 0.5 0.5 c 1103 1300 m -5 -11 d 7 13 d f 0.425 0.425 0.425 c 1094 1308 m 14 11 d
- -19 -18 d f 0.45 0.45 0.45 c 1108 1319 m 10 8 d -3 -6 d -32 -27 d 6 7 d f 0.475
- 0.475 0.475 c 1115 1321 m -10 -19 d -27 -15 d 5 7 d f 0.5 0.5 0.5 c 1105 1302 m
- -7 -13 d -24 -6 d 4 4 d f 0.425 0.425 0.425 c 1071 1369 m 23 -61 d -5 -7 d -27
- 33 d f 0.45 0.45 0.45 c 1089 1301 m -6 -7 d -30 4 d 9 36 d f 0.475 0.475 0.475
- c 1083 1294 m -5 -7 d -15 -1 d -12 4 d 2 8 d f 0.5 0.5 0.5 c 1078 1287 m -4 -4
- d -11 3 d f 0.425 0.425 0.425 c 1047 1296 m 24 73 d -9 -35 d -29 -47 d f 0.45
- 0.45 0.45 c 1062 1334 m -9 -36 d -9 -9 d -17 -5 d 6 3 d f 0.475 0.475 0.475 c
- 1053 1298 m -2 -8 d -7 -1 d f 0.425 0.425 0.425 c 1024 1276 m 23 20 d -14 -9 d
- -20 -17 d f 0.45 0.45 0.45 c 1033 1287 m -6 -3 d -23 -19 d 9 5 d f 0.425 0.425
- 0.425 c 1000 1297 m 24 -21 d -11 -6 d -16 23 d f 0.45 0.45 0.45 c 1013 1270 m
- -9 -5 d -2 X -9 23 d 4 5 d f 0.475 0.475 0.475 c 1002 1265 m -6 2 d -7 16 d 4 5
- d f 0.5 0.5 0.5 c 996 1267 m -7 2 d -3 10 d 3 4 d f 0.525 0.525 0.525 c 989
- 1269 m -6 2 d -1 3 d 4 5 d f 0.55 0.55 0.55 c 983 1271 m -3 1 d 2 2 d f 0.425
- 0.425 0.425 c 977 1251 m 23 46 d -3 -4 d -22 -42 d f 0.45 0.45 0.45 c 997 1293
- m -4 -5 d -19 -37 d 1 X f 0.475 0.475 0.475 c 993 1288 m -4 -5 d -17 -32 d 2 X
- f 0.5 0.5 0.5 c 989 1283 m -3 -4 d -15 -28 d 1 X f 0.525 0.525 0.525 c 986 1279
- m -4 -5 d -13 -22 d 2 -1 d f 0.55 0.55 0.55 c 982 1274 m -2 -2 d -2 -1 d -10
- -19 d 1 X f 0.575 0.575 0.575 c 978 1271 m -3 -3 d -9 -16 d 2 X f 0.6 0.6 0.6 c
- 975 1268 m -3 -2 d -7 -14 d 1 X f 0.625 0.625 0.625 c 972 1266 m -3 -3 d -6 -11
- d 2 X f 0.65 0.65 0.65 c 969 1263 m -3 -2 d -4 -9 d 1 X f 0.675 0.675 0.675 c
- 966 1261 m -3 -3 d -3 -5 d 2 -1 d f 0.7 0.7 0.7 c 963 1258 m -3 -2 d -2 -3 d 2
- X f 0.725 0.725 0.725 c 960 1256 m -3 -3 d 1 X f 0.75 0.75 0.75 c 957 1253 m f
- 0.425 0.425 0.425 c 953 1299 m 24 -48 d -2 X -29 29 d f 0.45 0.45 0.45 c 975
- 1251 m -1 X -35 10 d 7 19 d f 0.475 0.475 0.475 c 974 1251 m -2 X -38 -4 d -1 X
- 6 14 d f 0.5 0.5 0.5 c 972 1251 m -1 X -35 -3 d -2 -1 d f 0.525 0.525 0.525 c
- 971 1251 m -2 1 d -31 -4 d -2 X f 0.55 0.55 0.55 c 969 1252 m -1 X -28 -3 d -2
- -1 d f 0.575 0.575 0.575 c 968 1252 m -2 X -23 -3 d -3 X f 0.6 0.6 0.6 c 966
- 1252 m -1 X -20 -2 d -2 -1 d f 0.625 0.625 0.625 c 965 1252 m -2 X -16 -1 d -2
- -1 d f 0.65 0.65 0.65 c 963 1252 m -1 X -13 -1 d -2 X f 0.675 0.675 0.675 c 962
- 1252 m -2 1 d -8 -1 d -3 -1 d f 0.7 0.7 0.7 c 960 1253 m -2 X -4 -1 d -2 X f
- 0.725 0.725 0.725 c 958 1253 m -2 X -2 -1 d f 0.75 0.75 0.75 c 957 1253 m -1 X
- f 0.425 0.425 0.425 c 930 1293 m 23 6 d -7 -19 d -29 -3 d f 0.45 0.45 0.45 c
- 946 1280 m -7 -19 d -21 X -8 7 d 7 9 d f 0.475 0.475 0.475 c 939 1261 m -6 -14
- d -15 14 d f 0.425 0.425 0.425 c 907 1287 m 23 6 d -13 -16 d -29 -25 d f 0.45
- 0.45 0.45 c 917 1277 m -7 -9 d -24 -20 d 2 4 d f 0.425 0.425 0.425 c 890 1255 m
- 17 32 d -19 -35 d f 0.45 0.45 0.45 c 883 1240 m 7 15 d -2 -3 d -2 -4 d -23 8 d
- f 0.425 0.425 0.425 c 853 1253 m -14 -3 d 8 4 d f 0.45 0.45 0.45 c 873 1249 m
- 10 -9 d -20 16 d -10 -3 d -6 1 d 7 4 d f 0.475 0.475 0.475 c 860 1261 m 13 -12
- d -19 9 d f 0.425 0.425 0.425 c 847 1254 m -8 -4 d -23 21 d 2 1 d f 0.45 0.45
- 0.45 c 854 1258 m -7 -4 d -29 18 d 2 1 d f 0.475 0.475 0.475 c 859 1262 m 1 -1
- d -6 -3 d -34 15 d 2 1 d f 0.5 0.5 0.5 c 855 1265 m 4 -3 d -37 12 d 2 1 d f
- 0.525 0.525 0.525 c 852 1268 m 3 -3 d -31 10 d 2 1 d f 0.55 0.55 0.55 c 849
- 1271 m 3 -3 d -26 8 d 2 2 d f 0.575 0.575 0.575 c 846 1274 m 3 -3 d -21 7 d 2 1
- d f 0.6 0.6 0.6 c 842 1276 m 4 -2 d -16 5 d 2 1 d f 0.625 0.625 0.625 c 839
- 1279 m 3 -3 d -10 4 d 2 1 d f 0.65 0.65 0.65 c 836 1282 m 3 -3 d -5 2 d f 0.425
- 0.425 0.425 c 818 1272 m -2 -1 d -24 -46 d 15 48 d f 0.45 0.45 0.45 c 813 1290
- m 2 -1 d 5 -16 d -2 -1 d -11 1 d f 0.475 0.475 0.475 c 815 1289 m 2 -1 d 5 -14
- d -2 -1 d f 0.5 0.5 0.5 c 817 1288 m 3 -1 d 4 -12 d -2 -1 d f 0.525 0.525 0.525
- c 820 1287 m 3 -1 d 3 -10 d -2 -1 d f 0.55 0.55 0.55 c 823 1286 m 2 X 3 -8 d -2
- -2 d f 0.575 0.575 0.575 c 825 1286 m 3 -1 d 2 -6 d -2 -1 d f 0.6 0.6 0.6 c 828
- 1285 m 3 -1 d 1 -4 d -2 -1 d f 0.625 0.625 0.625 c 831 1284 m 2 -1 d 1 -2 d -2
- -1 d f 0.65 0.65 0.65 c 833 1283 m 3 -1 d -2 -1 d f 0.425 0.425 0.425 c 789
- 1216 m 19 60 d -1 -3 d -15 -48 d -11 -10 d -3 -5 d f 0.45 0.45 0.45 c 808 1276
- m 5 14 d -6 -17 d -26 -58 d -12 -10 d 9 5 d f 0.425 0.425 0.425 c 766 1224 m 23
- -8 d -11 -6 d -24 8 d f 0.45 0.45 0.45 c 778 1210 m -9 -5 d -24 8 d 9 5 d f
- 0.425 0.425 0.425 c 742 1204 m 24 20 d -12 -6 d -12 -14 d f 0.45 0.45 0.45 c
- 754 1218 m -9 -5 d -21 -18 d -2 -2 d 20 11 d f 0.475 0.475 0.475 c 724 1195 m
- -2 -2 d f 0.425 0.425 0.425 c 742 1204 m f 0.45 0.45 0.45 c 722 1188 m 20 16 d
- -20 -11 d f 0.475 0.475 0.475 c 719 1185 m 3 3 d 5 Y -10 9 d -1 -6 d f 0.5 0.5
- 0.5 c 712 1202 m -10 9 d -2 Y 9 -13 d f 0.525 0.525 0.525 c 702 1211 m -4 3 d 4
- -5 d f 0.475 0.475 0.475 c 695 1260 m 24 -75 d -8 11 d -34 6 d f 0.5 0.5 0.5 c
- 711 1196 m -9 13 d -11 -1 d -16 -13 d 2 7 d f 0.525 0.525 0.525 c 702 1209 m -4
- 5 d -7 -6 d f 0.45 0.45 0.45 c 672 1200 m 16 42 d -29 -33 d -8 7 d f 0.475
- 0.475 0.475 c 688 1242 m 7 18 d -18 -58 d -4 -6 d -14 13 d f 0.5 0.5 0.5 c 677
- 1202 m -2 -7 d -2 1 d f 0.45 0.45 0.45 c 648 1207 m 24 -7 d -21 16 d -23 -20 d
- f 625 1201 m 23 6 d -20 -11 d -24 -19 d f 0.425 0.425 0.425 c 601 1169 m 15 20
- d -28 -10 d f 0.45 0.45 0.45 c 616 1189 m 9 12 d -21 -24 d -23 7 d 7 -5 d f
- 0.425 0.425 0.425 c 578 1163 m 23 6 d -13 10 d -23 -23 d f 0.45 0.45 0.45 c 588
- 1179 m -7 5 d -24 -33 d 8 5 d f 0.425 0.425 0.425 c 554 1170 m 24 -7 d -44 9 d
- f 554 1170 m 24 -7 d -13 -7 d -17 4 d -14 12 d f 0.45 0.45 0.45 c 565 1156 m -8
- -5 d -9 9 d f 0.425 0.425 0.425 c 543 1167 m 11 3 d -20 2 d -11 9 d f 0.45 0.45
- 0.45 c 533 1165 m 10 2 d -20 14 d -10 10 d f 0.475 0.475 0.475 c 531 1164 m 2 1
- d -20 26 d -3 2 d f 0.45 0.45 0.45 c 507 1172 m 17 -6 d -21 25 d -16 -4 d f
- 0.475 0.475 0.475 c 524 1166 m 7 -2 d -21 29 d -7 -2 d f 0.425 0.425 0.425 c
- 484 1192 m 10 -9 d -23 -27 d -8 -15 d f 0.45 0.45 0.45 c 494 1183 m 13 -11 d
- -20 15 d -16 -31 d f 0.425 0.425 0.425 c 460 1119 m 24 73 d -21 -51 d -23 34 d
- f 457 1117 m 3 2 d -20 56 d -1 -1 d f 0.45 0.45 0.45 c 453 1114 m 4 3 d -18 57
- d -4 -12 d f 0.475 0.475 0.475 c 449 1110 m 4 4 d -18 48 d -5 -11 d f 0.5 0.5
- 0.5 c 445 1107 m 4 3 d -19 41 d -4 -12 d f 0.525 0.525 0.525 c 441 1103 m 4 4 d
- -19 32 d -5 -12 d f 0.55 0.55 0.55 c 437 1100 m 4 3 d -20 24 d -5 -12 d 9 -6 d
- f 0.575 0.575 0.575 c 437 1100 m -12 9 d f 0.55 0.55 0.55 c 413 1094 m 5 1 d 7
- 14 d -9 6 d -23 -6 d f 0.575 0.575 0.575 c 418 1095 m 19 5 d -12 9 d f 0.55
- 0.55 0.55 c 390 1088 m 23 6 d -20 15 d -24 -6 d f 366 1082 m 24 6 d -21 15 d
- -23 -6 d f 1467 1341 m 24 6 d -21 16 d -23 -6 d f 1444 1335 m 23 6 d -20 16 d
- -24 -6 d f 1420 1329 m 24 6 d -21 16 d -23 -6 d f 0.425 0.425 0.425 c 1397 1377
- m 4 -8 d -14 21 d f 0.45 0.45 0.45 c 1401 1369 m 4 -8 d -27 42 d 9 -13 d f
- 0.475 0.475 0.475 c 1405 1361 m 4 -9 d -28 41 d -5 13 d 2 -3 d f 0.5 0.5 0.5 c
- 1409 1352 m 4 -8 d -25 31 d -7 18 d f 0.525 0.525 0.525 c 1413 1344 m 4 -8 d
- -22 22 d -7 17 d f 0.55 0.55 0.55 c 1417 1336 m 3 -7 d -20 16 d -5 13 d f 0.425
- 0.425 0.425 c 1373 1371 m 24 6 d -10 13 d -34 -56 d f 0.45 0.45 0.45 c 1387
- 1390 m -9 13 d -6 -10 d -19 -60 d 1 Y f 0.475 0.475 0.475 c 1378 1403 m -2 3 d
- -4 -13 d f 0.425 0.425 0.425 c 1350 1406 m 23 -35 d -20 -37 d -1 Y -24 8 d f
- 0.45 0.45 0.45 c 1353 1334 m -1 Y f 0.425 0.425 0.425 c 1350 1406 m -21 -65 d
- -23 20 d f 1326 1400 m 24 6 d -21 -65 d -23 20 d f 1303 1326 m 23 74 d -20 -39
- d -24 8 d f 1292 1355 m 11 -29 d -21 43 d -23 -46 d 9 30 d f 0.45 0.45 0.45 c
- 1281 1384 m 11 -29 d -24 -2 d 10 30 d f 0.475 0.475 0.475 c 1279 1388 m 2 -4 d
- -3 -1 d f 0.425 0.425 0.425 c 1268 1353 m -9 -30 d -7 18 d f 0.45 0.45 0.45 c
- 1278 1383 m -10 -30 d -16 -12 d -7 18 d f 0.475 0.475 0.475 c 1275 1389 m 4 -1
- d -1 -5 d -33 -24 d -7 18 d f 0.5 0.5 0.5 c 1270 1391 m 5 -2 d -37 -12 d -3 7 d
- 4 2 d f 0.525 0.525 0.525 c 1264 1392 m 6 -1 d -31 -5 d 6 3 d f 0.55 0.55 0.55
- c 1259 1394 m 5 -2 d -19 -3 d 6 4 d f 0.575 0.575 0.575 c 1256 1395 m 3 -1 d -8
- -1 d f 0.5 0.5 0.5 c 1239 1386 m -4 -2 d -13 12 d f 0.525 0.525 0.525 c 1232
- 1362 m 5 6 d 8 21 d -6 -3 d -17 10 d -10 9 d f 0.55 0.55 0.55 c 1237 1368 m 11
- 16 d 3 9 d -6 -4 d f 0.575 0.575 0.575 c 1248 1384 m 8 11 d -5 -2 d f 0.425
- 0.425 0.425 c 1209 1356 m 5 2 d -22 -44 d f 0.45 0.45 0.45 c 1214 1358 m 5 1 d
- -25 -30 d -6 -24 d 4 9 d f 0.475 0.475 0.475 c 1219 1359 m 5 1 d -23 X -7 -31 d
- f 0.5 0.5 0.5 c 1224 1360 m 5 1 d -20 30 d -8 -31 d f 0.525 0.525 0.525 c 1229
- 1361 m 3 1 d -20 43 d -3 -14 d f 0.425 0.425 0.425 c 1185 1350 m 24 6 d -44 -4
- d f 1185 1350 m 24 6 d -17 -42 d -8 -1 d -19 39 d f 0.45 0.45 0.45 c 1192 1314
- m -4 -9 d -4 8 d f 0.425 0.425 0.425 c 1169 1319 m 16 31 d -20 2 d -14 -11 d f
- 0.45 0.45 0.45 c 1162 1304 m 7 15 d -18 22 d -10 -8 d f 1138 1311 m 24 -7 d -21
- 29 d -23 -6 d f 0.425 0.425 0.425 c 1108 1319 m -14 -11 d 7 -1 d f 0.45 0.45
- 0.45 c 1135 1311 m 3 X -20 16 d -10 -8 d -7 -12 d 6 -1 d f 0.475 0.475 0.475 c
- 1117 1306 m 18 5 d -28 -5 d 7 X f 0.5 0.5 0.5 c 1115 1306 m 2 X -3 X f 0.425
- 0.425 0.425 c 1101 1307 m -7 1 d -23 61 d 1 1 d f 0.45 0.45 0.45 c 1107 1306 m
- -6 1 d -29 63 d 2 X f 0.475 0.475 0.475 c 1114 1306 m -7 X -33 64 d 1 1 d f 0.5
- 0.5 0.5 c 1113 1311 m 2 -5 d -1 X -39 65 d 2 1 d f 0.525 0.525 0.525 c 1111
- 1318 m 2 -7 d -36 61 d 1 1 d f 0.55 0.55 0.55 c 1109 1324 m 2 -6 d -33 55 d 1 1
- d f 0.575 0.575 0.575 c 1107 1331 m 2 -7 d -30 50 d 2 X f 0.6 0.6 0.6 c 1105
- 1338 m 2 -7 d -26 43 d 1 1 d f 0.625 0.625 0.625 c 1103 1344 m 2 -6 d -23 37 d
- 2 1 d f 0.65 0.65 0.65 c 1100 1351 m 3 -7 d -19 32 d 1 1 d f 0.675 0.675 0.675
- c 1098 1357 m 2 -6 d -15 26 d 1 X f 0.7 0.7 0.7 c 1096 1364 m 2 -7 d -12 20 d 2
- 1 d f 0.725 0.725 0.725 c 1094 1371 m 2 -7 d -8 14 d 1 1 d f 0.75 0.75 0.75 c
- 1092 1377 m 2 -6 d -5 8 d 2 1 d f 0.775 0.775 0.775 c 1091 1380 m 1 -3 d -1 3 d
- f 0.425 0.425 0.425 c 1068 1334 m 1 Y 4 35 d -1 -1 d -24 -73 d f 0.45 0.45 0.45
- c 1068 1335 m 2 3 d 4 32 d -2 X f 0.475 0.475 0.475 c 1070 1338 m 2 4 d 3 29 d
- -1 -1 d f 0.5 0.5 0.5 c 1072 1342 m 2 3 d 3 27 d -2 -1 d f 0.525 0.525 0.525 c
- 1074 1345 m 1 3 d 3 25 d -1 -1 d f 0.55 0.55 0.55 c 1075 1348 m 2 4 d 2 22 d -1
- -1 d f 0.575 0.575 0.575 c 1077 1352 m 2 3 d 2 19 d -2 X f 0.6 0.6 0.6 c 1079
- 1355 m 1 4 d 2 16 d -1 -1 d f 0.625 0.625 0.625 c 1080 1359 m 2 3 d 2 14 d -2
- -1 d f 0.65 0.65 0.65 c 1082 1362 m 2 3 d 1 12 d -1 -1 d f 0.675 0.675 0.675 c
- 1084 1365 m 1 4 d 1 8 d -1 X f 0.7 0.7 0.7 c 1085 1369 m 2 3 d 1 6 d -2 -1 d f
- 0.725 0.725 0.725 c 1087 1372 m 2 3 d 4 Y -1 -1 d f 0.75 0.75 0.75 c 1089 1375
- m 2 4 d 1 Y -2 -1 d f 0.775 0.775 0.775 c 1091 1379 m 1 Y f 0.425 0.425 0.425 c
- 1044 1288 m 3 8 d -23 -20 d f 1044 1288 m 24 46 d -21 -38 d -23 -20 d f 1021
- 1308 m 23 -20 d -20 -12 d -24 21 d f 1021 1308 m 23 -20 d -20 -12 d -24 21 d f
- 997 1249 m 24 59 d -21 -11 d -23 -46 d f 997 1249 m 24 59 d -21 -11 d -23 -46 d
- f 974 1323 m 23 -74 d -20 2 d -24 48 d f 974 1323 m 23 -74 d -20 2 d -24 48 d f
- 974 1323 m -21 -24 d -23 -6 d f 959 1320 m 15 3 d -21 -24 d -23 -6 d 13 15 d f
- 0.45 0.45 0.45 c 950 1317 m 9 3 d -16 -12 d f 0.425 0.425 0.425 c 943 1308 m
- -13 -15 d -23 -6 d 16 31 d f 0.45 0.45 0.45 c 927 1325 m 23 -8 d -7 -9 d -20 10
- d f 0.425 0.425 0.425 c 903 1225 m 20 82 d 11 Y -16 -31 d -17 -32 d -1 -19 d f
- 0.45 0.45 0.45 c 923 1307 m 4 18 d -4 -7 d -33 -63 d -7 -15 d 6 -4 d f 0.425
- 0.425 0.425 c 890 1244 m 13 -19 d -14 11 d f 0.45 0.45 0.45 c 880 1259 m 10 -15
- d -1 -8 d -6 4 d -10 9 d 2 11 d f 0.475 0.475 0.475 c 873 1249 m -13 12 d 15 -1
- d f 0.45 0.45 0.45 c 879 1258 m 1 1 d -5 1 d f 0.475 0.475 0.475 c 878 1255 m 1
- 3 d -4 2 d -15 1 d -1 1 d f 0.5 0.5 0.5 c 876 1251 m 2 4 d -19 7 d -4 3 d f
- 0.525 0.525 0.525 c 874 1247 m 2 4 d -21 14 d -3 3 d f 0.55 0.55 0.55 c 872
- 1243 m 2 4 d -22 21 d -3 3 d f 0.575 0.575 0.575 c 870 1240 m 2 3 d -23 28 d -3
- 3 d f 0.6 0.6 0.6 c 868 1236 m 2 4 d -24 34 d -4 2 d f 0.625 0.625 0.625 c 866
- 1232 m 2 4 d -26 40 d -3 3 d f 0.65 0.65 0.65 c 864 1228 m 2 4 d -27 47 d -3 3
- d -1 Y f 0.675 0.675 0.675 c 862 1225 m 2 3 d -28 53 d 5 -16 d f 0.7 0.7 0.7 c
- 860 1221 m 2 4 d -21 40 d 5 -17 d f 0.725 0.725 0.725 c 859 1217 m 1 4 d -14 27
- d 5 -16 d f 0.75 0.75 0.75 c 857 1213 m 2 4 d -8 15 d 5 -17 d f 0.775 0.775
- 0.775 c 856 1213 m 1 X -1 2 d f 0.45 0.45 0.45 c 833 1220 m -18 69 d -2 1 d f
- 0.475 0.475 0.475 c 833 1220 m 2 X -18 68 d -2 1 d f 0.5 0.5 0.5 c 835 1220 m 2
- -1 d -17 68 d -3 1 d f 0.525 0.525 0.525 c 837 1219 m 2 -1 d -16 68 d -3 1 d f
- 0.55 0.55 0.55 c 839 1218 m 2 X -16 68 d -2 X f 0.575 0.575 0.575 c 841 1218 m
- 2 -1 d -15 68 d -3 1 d f 0.6 0.6 0.6 c 843 1217 m 2 X -14 67 d -3 1 d f 0.625
- 0.625 0.625 c 845 1217 m 1 -1 d -13 67 d -2 1 d f 0.65 0.65 0.65 c 846 1216 m 2
- -1 d -12 66 d 1 Y -3 1 d f 0.675 0.675 0.675 c 848 1215 m 2 X -9 50 d -5 16 d f
- 0.7 0.7 0.7 c 850 1215 m 2 -1 d -6 34 d -5 17 d f 0.725 0.725 0.725 c 852 1214
- m 2 X -3 18 d -5 16 d f 0.75 0.75 0.75 c 854 1214 m 2 -1 d 2 Y -5 17 d f 0.775
- 0.775 0.775 c 856 1213 m 2 Y f 0.425 0.425 0.425 c 809 1241 m 13 -11 d -14 46 d
- -19 -60 d f 0.45 0.45 0.45 c 822 1230 m 11 -10 d -20 70 d -5 -14 d f 0.425
- 0.425 0.425 c 809 1241 m -20 -25 d -23 8 d f 786 1249 m 23 -8 d -20 -25 d -23 8
- d f 762 1243 m 24 6 d -20 -25 d -24 -20 d f 739 1183 m 23 60 d -20 -39 d -11
- -20 d f 0.45 0.45 0.45 c 742 1204 m -20 -16 d -2 -3 d 11 -1 d f 0.475 0.475
- 0.475 c 722 1188 m -3 -3 d 1 X f 0.425 0.425 0.425 c 728 1186 m 11 -3 d -8 1 d
- f 0.45 0.45 0.45 c 715 1190 m 13 -4 d 3 -2 d -11 1 d -13 33 d f 0.475 0.475
- 0.475 c 720 1185 m -1 X -24 75 d 12 -42 d f 0.45 0.45 0.45 c 692 1225 m 23 -35
- d -8 28 d -19 24 d -16 -42 d f 0.475 0.475 0.475 c 707 1218 m -12 42 d -7 -18 d
- f 0.45 0.45 0.45 c 668 1178 m 24 47 d -20 -25 d -24 7 d f 0.425 0.425 0.425 c
- 645 1186 m 20 -6 d -33 15 d f 0.45 0.45 0.45 c 665 1180 m 3 -2 d -20 29 d -23
- -6 d 7 -6 d f 0.425 0.425 0.425 c 622 1220 m 23 -34 d -44 -17 d f 622 1220 m 23
- -34 d -13 9 d -16 -6 d -15 -20 d f 0.45 0.45 0.45 c 632 1195 m -7 6 d -9 -12 d
- f 0.425 0.425 0.425 c 598 1228 m 24 -8 d -21 -51 d -23 -6 d f 598 1228 m 24 -8
- d -21 -51 d -23 -6 d f 575 1181 m 23 47 d -20 -65 d -24 7 d f 575 1181 m 23 47
- d -20 -65 d -24 7 d f 551 1216 m 24 -35 d -21 -11 d f 551 1216 m 24 -35 d -21
- -11 d -11 -3 d -1 25 d f 0.45 0.45 0.45 c 543 1167 m -10 -2 d -1 3 d 10 24 d f
- 0.475 0.475 0.475 c 533 1165 m -2 -1 d 1 4 d f 0.425 0.425 0.425 c 535 1212 m
- 16 4 d -9 -24 d f 0.45 0.45 0.45 c 528 1210 m 7 2 d 7 -20 d -10 -24 d -8 -2 d
- -17 6 d f 0.475 0.475 0.475 c 532 1168 m -1 -4 d -7 2 d f 0.425 0.425 0.425 c
- 504 1150 m 12 31 d -22 2 d -10 9 d f 0.45 0.45 0.45 c 516 1181 m 12 29 d -21
- -38 d -13 11 d f 0.425 0.425 0.425 c 481 1184 m 23 -34 d -20 42 d -24 -73 d f
- 477 1170 m 4 14 d -21 -65 d -3 -2 d f 0.45 0.45 0.45 c 473 1152 m 4 18 d -20
- -53 d -4 -3 d f 0.475 0.475 0.475 c 469 1134 m 4 18 d -20 -38 d -4 -4 d f 0.5
- 0.5 0.5 c 465 1116 m 4 18 d -20 -24 d -4 -3 d f 0.525 0.525 0.525 c 460 1098 m
- 5 18 d -20 -9 d -4 -4 d f 0.55 0.55 0.55 c 457 1084 m 3 14 d -19 5 d -4 -3 d 3
- -3 d f 0.575 0.575 0.575 c 437 1100 m 3 -3 d f 0.55 0.55 0.55 c 434 1078 m 23 6
- d -17 13 d -22 -2 d -5 -1 d f 0.575 0.575 0.575 c 440 1097 m -3 3 d -19 -5 d f
- 0.55 0.55 0.55 c 410 1072 m 24 6 d -21 16 d -23 -6 d f 387 1066 m 23 6 d -20 16
- d -24 -6 d f 1487 1326 m 24 6 d -20 15 d -24 -6 d f 1464 1320 m 23 6 d -20 15 d
- -23 -6 d f 1440 1314 m 24 6 d -20 15 d -24 -6 d f 0.425 0.425 0.425 c 1417 1442
- m 4 -22 d -20 -51 d -4 8 d f 0.45 0.45 0.45 c 1421 1420 m 4 -23 d -20 -36 d -4
- 8 d f 0.475 0.475 0.475 c 1425 1397 m 5 -23 d -21 -22 d -4 9 d f 0.5 0.5 0.5 c
- 1430 1374 m 4 -23 d -21 -7 d -4 8 d f 0.525 0.525 0.525 c 1434 1351 m 4 -23 d
- -21 8 d -4 8 d f 0.55 0.55 0.55 c 1438 1328 m 2 -14 d -20 15 d -3 7 d f 0.425
- 0.425 0.425 c 1393 1450 m 24 -8 d -20 -65 d -24 -6 d f 1370 1430 m 23 20 d -20
- -79 d -23 35 d f 1347 1411 m 23 19 d -20 -24 d -24 -6 d f 1323 1445 m 24 -34 d
- -21 -11 d -23 -74 d f 1305 1349 m 18 96 d -20 -119 d -11 29 d f 0.45 0.45 0.45
- c 1300 1318 m 5 31 d -13 6 d -11 29 d 1 -7 d f 0.475 0.475 0.475 c 1281 1384 m
- -2 4 d 3 -11 d f 0.425 0.425 0.425 c 1276 1312 m 19 5 d -22 8 d f 0.45 0.45
- 0.45 c 1295 1317 m 5 1 d -18 59 d -12 -40 d 3 -12 d f 0.475 0.475 0.475 c 1282
- 1377 m -3 11 d -4 1 d -8 -39 d 3 -13 d f 0.5 0.5 0.5 c 1275 1389 m -5 2 d -6
- -29 d 3 -12 d f 0.525 0.525 0.525 c 1270 1391 m -6 1 d -3 -18 d 3 -12 d f 0.55
- 0.55 0.55 c 1264 1392 m -5 2 d -1 -7 d 3 -13 d f 0.575 0.575 0.575 c 1259 1394
- m -3 1 d 2 -8 d f 0.425 0.425 0.425 c 1253 1387 m 23 -75 d -3 13 d -25 57 d f
- 0.45 0.45 0.45 c 1273 1325 m -3 12 d -26 39 d 4 6 d f 0.475 0.475 0.475 c 1270
- 1337 m -3 13 d -28 21 d 5 5 d f 0.5 0.5 0.5 c 1267 1350 m -3 12 d -29 4 d 4 5 d
- f 0.525 0.525 0.525 c 1264 1362 m -3 12 d -24 -6 d -5 -6 d 3 4 d f 0.55 0.55
- 0.55 c 1261 1374 m -3 13 d -10 -3 d -11 -16 d f 0.575 0.575 0.575 c 1258 1387 m
- -2 8 d -8 -11 d f 0.425 0.425 0.425 c 1229 1395 m 24 -8 d -5 -5 d -34 -24 d -5
- -2 d f 0.45 0.45 0.45 c 1248 1382 m -4 -6 d -25 -17 d -5 -1 d f 0.475 0.475
- 0.475 c 1244 1376 m -5 -5 d -15 -11 d -5 -1 d f 0.5 0.5 0.5 c 1239 1371 m -4 -5
- d -6 -5 d -5 -1 d f 0.525 0.525 0.525 c 1235 1366 m -3 -4 d -3 -1 d f 0.425
- 0.425 0.425 c 1206 1348 m 23 47 d -20 -39 d -24 -6 d f 1182 1369 m 24 -21 d -21
- 2 d -16 -31 d 8 Y f 0.45 0.45 0.45 c 1169 1319 m -7 -15 d 7 23 d f 0.425 0.425
- 0.425 c 1159 1323 m 23 46 d -13 -42 d -20 -10 d f 0.45 0.45 0.45 c 1169 1327 m
- -7 -23 d -24 7 d 11 6 d f 0.425 0.425 0.425 c 1135 1263 m 24 60 d -10 -6 d -20
- -40 d f 0.45 0.45 0.45 c 1149 1317 m -11 -6 d -3 X -13 -21 d 7 -13 d f 0.475
- 0.475 0.475 c 1135 1311 m -18 -5 d -1 -2 d 6 -14 d f 0.5 0.5 0.5 c 1117 1306 m
- -2 X 1 -2 d f 0.425 0.425 0.425 c 1112 1311 m 23 -48 d -6 14 d -19 39 d f 0.45
- 0.45 0.45 c 1129 1277 m -7 13 d -13 30 d 1 -4 d f 0.475 0.475 0.475 c 1122 1290
- m -6 14 d -9 21 d 2 -5 d f 0.5 0.5 0.5 c 1116 1304 m -1 2 d -2 5 d -7 19 d 1 -5
- d f 0.525 0.525 0.525 c 1113 1311 m -2 7 d -6 17 d 1 -5 d f 0.55 0.55 0.55 c
- 1111 1318 m -2 6 d -6 16 d 2 -5 d f 0.575 0.575 0.575 c 1109 1324 m -2 7 d -5
- 13 d 1 -4 d f 0.6 0.6 0.6 c 1107 1331 m -2 7 d -5 11 d 2 -5 d f 0.625 0.625
- 0.625 c 1105 1338 m -2 6 d -4 10 d 1 -5 d f 0.65 0.65 0.65 c 1103 1344 m -3 7 d
- -2 8 d 1 -5 d f 0.675 0.675 0.675 c 1100 1351 m -2 6 d -2 7 d 2 -5 d f 0.7 0.7
- 0.7 c 1098 1357 m -2 7 d -1 4 d 1 -4 d f 0.725 0.725 0.725 c 1096 1364 m -2 7 d
- -1 2 d 2 -5 d f 0.75 0.75 0.75 c 1094 1371 m -2 6 d 1 Y 1 -5 d f 0.775 0.775
- 0.775 c 1092 1377 m -1 3 d 1 -2 d f 0.425 0.425 0.425 c 1088 1318 m 24 -7 d -2
- 5 d -42 19 d -1 Y f 0.45 0.45 0.45 c 1110 1316 m -1 4 d -39 18 d -2 -3 d f
- 0.475 0.475 0.475 c 1109 1320 m -2 5 d -35 17 d -2 -4 d f 0.5 0.5 0.5 c 1107
- 1325 m -1 5 d -32 15 d -2 -3 d f 0.525 0.525 0.525 c 1106 1330 m -1 5 d -30 13
- d -1 -3 d f 0.55 0.55 0.55 c 1105 1335 m -2 5 d -26 12 d -2 -4 d f 0.575 0.575
- 0.575 c 1103 1340 m -1 4 d -23 11 d -2 -3 d f 0.6 0.6 0.6 c 1102 1344 m -2 5 d
- -20 10 d -1 -4 d f 0.625 0.625 0.625 c 1100 1349 m -1 5 d -17 8 d -2 -3 d f
- 0.65 0.65 0.65 c 1099 1354 m -1 5 d -14 6 d -2 -3 d f 0.675 0.675 0.675 c 1098
- 1359 m -2 5 d -11 5 d -1 -4 d f 0.7 0.7 0.7 c 1096 1364 m -1 4 d -8 4 d -2 -3 d
- f 0.725 0.725 0.725 c 1095 1368 m -2 5 d -4 2 d -2 -3 d f 0.75 0.75 0.75 c 1093
- 1373 m -1 5 d -1 1 d -2 -4 d f 0.775 0.775 0.775 c 1092 1378 m -1 2 d -1 Y f
- 0.425 0.425 0.425 c 1065 1420 m 23 -102 d -20 16 d -24 -46 d f 1041 1293 m 24
- 127 d -21 -132 d -23 20 d f 1018 1368 m 3 -60 d -24 -59 d f 1018 1368 m 23 -75
- d -20 15 d -24 -59 d f 994 1335 m 24 33 d -21 -119 d -23 74 d f 994 1335 m 24
- 33 d -21 -119 d -23 74 d f 981 1295 m 13 40 d -20 -12 d -15 -3 d f 0.45 0.45
- 0.45 c 971 1262 m 10 33 d -22 25 d -9 -3 d f 0.425 0.425 0.425 c 947 1269 m 13
- -4 d -30 50 d f 0.45 0.45 0.45 c 960 1265 m 11 -3 d -21 55 d -23 8 d 3 -10 d f
- 0.425 0.425 0.425 c 924 1330 m 23 -61 d -17 46 d -7 -8 d -20 -82 d f 0.45 0.45
- 0.45 c 930 1315 m -3 10 d -4 -18 d f 0.425 0.425 0.425 c 900 1311 m 24 19 d -21
- -105 d -13 19 d 5 53 d f 0.45 0.45 0.45 c 890 1244 m -10 15 d 15 38 d f 0.425
- 0.425 0.425 c 877 1251 m 23 60 d -5 -14 d -20 -49 d f 0.45 0.45 0.45 c 895 1297
- m -15 -38 d -1 -1 d -5 -12 d 1 2 d f 0.475 0.475 0.475 c 879 1258 m -1 -3 d -6
- -12 d 2 3 d f 0.5 0.5 0.5 c 878 1255 m -2 -4 d -5 -11 d 1 3 d f 0.525 0.525
- 0.525 c 876 1251 m -2 -4 d -4 -9 d 1 2 d f 0.55 0.55 0.55 c 874 1247 m -2 -4 d
- -4 -8 d 2 3 d f 0.575 0.575 0.575 c 872 1243 m -2 -3 d -3 -8 d 1 3 d f 0.6 0.6
- 0.6 c 870 1240 m -2 -4 d -3 -6 d 2 2 d f 0.625 0.625 0.625 c 868 1236 m -2 -4 d
- -2 -5 d 1 3 d f 0.65 0.65 0.65 c 866 1232 m -2 -4 d -2 -4 d 2 3 d f 0.675 0.675
- 0.675 c 864 1228 m -2 -3 d -1 -4 d 1 3 d f 0.7 0.7 0.7 c 862 1225 m -2 -4 d -2
- Y 1 2 d f 0.725 0.725 0.725 c 860 1221 m -1 -4 d -1 -1 d 2 3 d f 0.75 0.75 0.75
- c 859 1217 m -2 -4 d 1 3 d f 0.775 0.775 0.775 c 857 1213 m -1 X 1 X f 0.425
- 0.425 0.425 c 853 1393 m 24 -142 d -2 -3 d -32 55 d f 0.45 0.45 0.45 c 875 1248
- m -1 -2 d -41 -26 d 10 83 d f 0.475 0.475 0.475 c 874 1246 m -2 -3 d -37 -23 d
- -2 X f 0.5 0.5 0.5 c 872 1243 m -1 -3 d -34 -21 d -2 1 d f 0.525 0.525 0.525 c
- 871 1240 m -1 -2 d -31 -20 d -2 1 d f 0.55 0.55 0.55 c 870 1238 m -2 -3 d -27
- -17 d -2 X f 0.575 0.575 0.575 c 868 1235 m -1 -3 d -24 -15 d -2 1 d f 0.6 0.6
- 0.6 c 867 1232 m -2 -2 d -20 -13 d -2 X f 0.625 0.625 0.625 c 865 1230 m -1 -3
- d -18 -11 d -1 1 d f 0.65 0.65 0.65 c 864 1227 m -2 -3 d -14 -9 d -2 1 d f
- 0.675 0.675 0.675 c 862 1224 m -1 -3 d -11 -6 d -2 X f 0.7 0.7 0.7 c 861 1221 m
- -1 -2 d -8 -5 d -2 1 d f 0.725 0.725 0.725 c 860 1219 m -2 -3 d -4 -2 d -2 X f
- 0.75 0.75 0.75 c 858 1216 m -1 -3 d -1 X -2 1 d f 0.775 0.775 0.775 c 857 1213
- m -1 X f 0.425 0.425 0.425 c 842 1371 m 11 22 d -10 -90 d -21 -73 d -13 11 d 10
- 51 d f 0.45 0.45 0.45 c 831 1348 m 11 23 d 1 -68 d -10 -83 d -11 10 d -3 62 d
- 10 51 d f 0.475 0.475 0.475 c 830 1347 m 1 1 d -2 -5 d f 0.425 0.425 0.425 c
- 819 1292 m -10 -51 d -23 8 d 11 52 d f 0.45 0.45 0.45 c 806 1341 m 20 5 d 3 -3
- d -10 -51 d -22 9 d f 0.475 0.475 0.475 c 826 1346 m 4 1 d -1 -4 d f 0.425
- 0.425 0.425 c 783 1308 m 14 20 d -27 Y -11 -52 d -24 -6 d f 0.45 0.45 0.45 c
- 797 1328 m 9 13 d -9 -40 d f 0.425 0.425 0.425 c 759 1288 m 24 20 d -21 -65 d
- -23 -60 d f 736 1256 m 23 32 d -20 -105 d -11 3 d -3 36 d f 0.45 0.45 0.45 c
- 728 1186 m -13 4 d 10 32 d f 0.425 0.425 0.425 c 712 1303 m 24 -47 d -11 -34 d
- -29 18 d f 0.45 0.45 0.45 c 725 1222 m -10 -32 d -23 35 d 4 15 d f 0.425 0.425
- 0.425 c 689 1338 m 23 -35 d -16 -63 d -20 -4 d f 0.45 0.45 0.45 c 696 1240 m -4
- -15 d -24 -47 d 8 58 d f 0.425 0.425 0.425 c 665 1264 m 24 74 d -13 -102 d -11
- -56 d -20 6 d f 0.45 0.45 0.45 c 676 1236 m -8 -58 d -3 2 d f 0.425 0.425 0.425
- c 642 1258 m 23 6 d -20 -78 d -23 34 d f 642 1258 m 23 6 d -20 -78 d -23 34 d f
- 618 1199 m 24 59 d -20 -38 d -24 8 d f 618 1199 m 24 59 d -20 -38 d -24 8 d f
- 618 1199 m -20 29 d -23 -47 d f 595 1260 m 23 -61 d -20 29 d -23 -47 d f 580
- 1198 m 15 62 d -20 -79 d -24 35 d 13 -35 d f 0.45 0.45 0.45 c 571 1160 m 9 38 d
- -16 -17 d f 0.425 0.425 0.425 c 548 1181 m 15 -13 d 1 13 d -13 35 d -16 -4 d -1
- -11 d f 0.45 0.45 0.45 c 563 1168 m 8 -8 d -7 21 d -29 31 d -7 -2 d 6 -9 d f
- 0.425 0.425 0.425 c 524 1202 m 24 -21 d -14 20 d -18 -20 d -12 -31 d f 0.45
- 0.45 0.45 c 534 1201 m -6 9 d -12 -29 d f 0.425 0.425 0.425 c 501 1223 m 23 -21
- d -20 -52 d -23 34 d f 497 1200 m 4 23 d -20 -39 d -4 -14 d f 0.45 0.45 0.45 c
- 493 1174 m 4 26 d -20 -30 d -4 -18 d f 0.475 0.475 0.475 c 489 1147 m 4 27 d
- -20 -22 d -4 -18 d f 0.5 0.5 0.5 c 485 1121 m 4 26 d -20 -13 d -4 -18 d f 0.525
- 0.525 0.525 c 481 1095 m 4 26 d -20 -5 d -5 -18 d f 0.55 0.55 0.55 c 477 1069 m
- 4 26 d -21 3 d -3 -14 d 19 -14 d f 0.575 0.575 0.575 c 477 1069 m -1 1 d f 0.55
- 0.55 0.55 c 454 1063 m 9 2 d 13 5 d -19 14 d -23 -6 d f 0.575 0.575 0.575 c 463
- 1065 m 14 4 d -1 1 d f 0.55 0.55 0.55 c 430 1057 m 24 6 d -20 15 d -24 -6 d f
- 407 1051 m 23 6 d -20 15 d -23 -6 d f 1508 1310 m 23 6 d -20 16 d -24 -6 d f
- 1484 1304 m 24 6 d -21 16 d -23 -6 d f 1461 1298 m 23 6 d -20 16 d -24 -6 d f
- 0.425 0.425 0.425 c 1437 1588 m 3 -39 d -19 -129 d -4 22 d f 0.45 0.45 0.45 c
- 1440 1549 m 5 -53 d -20 -99 d -4 23 d f 0.475 0.475 0.475 c 1445 1496 m 4 -53 d
- -19 -69 d -5 23 d f 0.5 0.5 0.5 c 1449 1443 m 4 -53 d -19 -39 d -4 23 d f 0.525
- 0.525 0.525 c 1453 1390 m 5 -53 d -20 -9 d -4 23 d f 0.55 0.55 0.55 c 1458 1337
- m 3 -39 d -21 16 d -2 14 d f 0.425 0.425 0.425 c 1414 1475 m 23 113 d -20 -146
- d -24 8 d f 1390 1549 m 24 -74 d -21 -25 d -23 -20 d f 1367 1436 m 23 113 d -20
- -119 d -23 -19 d f 1343 1363 m 24 73 d -20 -25 d -24 34 d f 1320 1383 m 23 -20
- d -20 82 d -18 -96 d 2 -8 d f 0.45 0.45 0.45 c 1305 1349 m -5 -31 d 7 23 d f
- 0.425 0.425 0.425 c 1296 1431 m 24 -48 d -13 -42 d -12 -24 d -19 -5 d f 0.45
- 0.45 0.45 c 1307 1341 m -7 -23 d -5 -1 d f 0.425 0.425 0.425 c 1296 1431 m -20
- -119 d -23 75 d f 1294 1438 m 2 -7 d -20 -119 d -23 75 d 1 10 d f 0.45 0.45
- 0.45 c 1292 1444 m 2 -6 d -40 -41 d 2 10 d f 0.475 0.475 0.475 c 1290 1450 m 2
- -6 d -36 -37 d 2 11 d f 0.5 0.5 0.5 c 1288 1457 m 2 -7 d -32 -32 d 2 10 d f
- 0.525 0.525 0.525 c 1286 1463 m 2 -6 d -28 -29 d 1 10 d f 0.55 0.55 0.55 c 1284
- 1470 m 2 -7 d -25 -25 d 2 10 d f 0.575 0.575 0.575 c 1282 1476 m 2 -6 d -21 -22
- d 2 10 d f 0.6 0.6 0.6 c 1280 1482 m 2 -6 d -17 -18 d 1 10 d f 0.625 0.625
- 0.625 c 1278 1489 m 2 -7 d -14 -14 d 2 11 d f 0.65 0.65 0.65 c 1276 1495 m 2 -6
- d -10 -10 d 2 10 d f 0.675 0.675 0.675 c 1274 1502 m 2 -7 d -6 -6 d 2 10 d f
- 0.7 0.7 0.7 c 1273 1506 m 1 -4 d -2 -3 d f 0.425 0.425 0.425 c 1249 1460 m 2 4
- d 3 -67 d -1 -10 d -24 8 d f 0.45 0.45 0.45 c 1251 1464 m 2 4 d 3 -61 d -2 -10
- d f 0.475 0.475 0.475 c 1253 1468 m 2 3 d 3 -53 d -2 -11 d f 0.5 0.5 0.5 c 1255
- 1471 m 2 4 d 3 -47 d -2 -10 d f 0.525 0.525 0.525 c 1257 1475 m 2 4 d 2 -41 d
- -1 -10 d f 0.55 0.55 0.55 c 1259 1479 m 2 4 d 2 -35 d -2 -10 d f 0.575 0.575
- 0.575 c 1261 1483 m 2 4 d 2 -29 d -2 -10 d f 0.6 0.6 0.6 c 1263 1487 m 3 4 d
- -23 Y -1 -10 d f 0.625 0.625 0.625 c 1266 1491 m 2 4 d -16 Y -2 -11 d f 0.65
- 0.65 0.65 c 1268 1495 m 2 4 d -10 Y -2 -10 d f 0.675 0.675 0.675 c 1270 1499 m
- 2 4 d -4 Y -2 -10 d f 0.7 0.7 0.7 c 1272 1503 m 1 3 d -1 -7 d f 0.425 0.425
- 0.425 c 1226 1427 m 23 33 d -20 -65 d -23 -47 d f 1202 1354 m 24 73 d -20 -79 d
- -24 21 d f 1179 1388 m 23 -34 d -20 15 d -23 -46 d f 1155 1368 m 24 20 d -20
- -65 d -24 -60 d f 1132 1416 m 23 -48 d -20 -105 d -23 48 d f 1108 1424 m 24 -8
- d -20 -105 d -24 7 d f 1085 1377 m 23 47 d -20 -106 d -23 102 d f 1061 1398 m
- 24 -21 d -20 43 d -24 -127 d f 1038 1365 m 23 33 d -20 -105 d -23 75 d f 1015
- 1359 m 23 6 d -20 3 d -24 -33 d f 991 1327 m 24 32 d -21 -24 d -13 -40 d 3 10 d
- f 0.45 0.45 0.45 c 981 1295 m -10 -33 d 13 43 d f 0.425 0.425 0.425 c 968 1428
- m 23 -101 d -7 -22 d -24 -40 d -13 4 d f 0.45 0.45 0.45 c 984 1305 m -13 -43 d
- -11 3 d f 0.425 0.425 0.425 c 944 1368 m 24 60 d -21 -159 d -23 61 d f 921 1336
- m 23 32 d -20 -38 d -24 -19 d f 897 1316 m 24 20 d -21 -25 d -23 -60 d f 874
- 1297 m 23 19 d -20 -65 d -24 142 d f 863 1294 m 11 3 d -21 96 d -11 -22 d f
- 0.45 0.45 0.45 c 852 1291 m 11 3 d -21 77 d -11 -23 d f 0.475 0.475 0.475 c 850
- 1291 m 2 X -21 57 d -1 -1 d f 0.45 0.45 0.45 c 827 1298 m 11 -3 d -12 51 d -20
- -5 d f 0.475 0.475 0.475 c 838 1295 m 12 -4 d -20 56 d -4 -1 d f 0.425 0.425
- 0.425 c 803 1279 m 13 10 d -19 39 d -14 -20 d f 0.45 0.45 0.45 c 816 1289 m 11
- 9 d -21 43 d -9 -13 d f 0.425 0.425 0.425 c 780 1313 m 23 -34 d -20 29 d -24
- -20 d f 780 1313 m 23 -34 d -20 29 d -24 -20 d f 756 1253 m 24 60 d -21 -25 d
- -23 -32 d f 733 1355 m 23 -102 d -20 3 d -24 47 d f 709 1349 m 24 6 d -21 -52 d
- -23 35 d f 686 1249 m 23 100 d -20 -11 d -24 -74 d f 662 1283 m 24 -34 d -21 15
- d -23 -6 d f 662 1283 m 24 -34 d -21 15 d -23 -6 d f 662 1283 m -20 -25 d -24
- -59 d f 639 1304 m 23 -21 d -20 -25 d -24 -59 d f 615 1312 m 24 -8 d -21 -105 d
- -23 61 d f 592 1212 m 23 100 d -20 -52 d -15 -62 d 2 -11 d f 0.45 0.45 0.45 c
- 580 1198 m -9 -38 d 11 27 d f 0.425 0.425 0.425 c 568 1300 m 24 -88 d -10 -25 d
- -19 -19 d -15 13 d f 0.45 0.45 0.45 c 582 1187 m -11 -27 d -8 8 d f 0.425 0.425
- 0.425 c 545 1253 m 23 47 d -20 -119 d -24 21 d f 521 1207 m 24 46 d -21 -51 d
- -23 21 d f 517 1181 m 4 26 d -20 16 d -4 -23 d f 0.45 0.45 0.45 c 513 1156 m 4
- 25 d -20 19 d -4 -26 d f 0.475 0.475 0.475 c 510 1130 m 3 26 d -20 18 d -4 -27
- d f 0.5 0.5 0.5 c 506 1105 m 4 25 d -21 17 d -4 -26 d f 0.525 0.525 0.525 c 502
- 1079 m 4 26 d -21 16 d -4 -26 d f 0.55 0.55 0.55 c 498 1054 m 4 25 d -21 16 d
- -4 -26 d f 0.575 0.575 0.575 c 498 1053 m 1 Y -21 15 d f 0.55 0.55 0.55 c 474
- 1047 m 13 3 d -24 15 d -9 -2 d f 0.575 0.575 0.575 c 487 1050 m 11 3 d -21 16 d
- -14 -4 d f 0.55 0.55 0.55 c 451 1041 m 23 6 d -20 16 d -24 -6 d f 427 1035 m 24
- 6 d -21 16 d -23 -6 d f 1528 1295 m 24 6 d -21 15 d -23 -6 d f 1505 1289 m 23 6
- d -20 15 d -24 -6 d f 1481 1283 m 24 6 d -21 15 d -23 -6 d f 0.425 0.425 0.425
- c 1440 1549 m -3 39 d 11 13 d f 0.45 0.45 0.45 c 1458 1613 m 1 -23 d -14 -94 d
- -5 53 d 8 52 d f 0.475 0.475 0.475 c 1459 1590 m 6 -80 d -16 -67 d -4 53 d f
- 0.5 0.5 0.5 c 1465 1510 m 6 -80 d -18 -40 d -4 53 d f 0.525 0.525 0.525 c 1471
- 1430 m 5 -79 d -18 -14 d -5 53 d f 0.55 0.55 0.55 c 1476 1351 m 5 -68 d -20 15
- d -3 39 d f 0.425 0.425 0.425 c 1434 1526 m 14 51 d 24 Y -11 -13 d -23 -113 d f
- 0.45 0.45 0.45 c 1448 1577 m 10 36 d -10 -12 d f 0.425 0.425 0.425 c 1411 1641
- m 23 -115 d -20 -51 d -24 74 d f 1387 1568 m 24 73 d -21 -92 d -23 -113 d f
- 1387 1568 m -20 -132 d -24 -73 d f 1364 1575 m 23 -7 d -20 -132 d -24 -73 d f
- 1340 1462 m 24 113 d -21 -212 d -23 20 d f 1317 1469 m 23 -7 d -20 -79 d -24 48
- d f 1314 1460 m 3 9 d -21 -38 d -2 7 d f 0.45 0.45 0.45 c 1311 1450 m 3 10 d
- -20 -22 d -2 6 d f 0.475 0.475 0.475 c 1309 1440 m 2 10 d -19 -6 d -2 6 d f 0.5
- 0.5 0.5 c 1306 1430 m 3 10 d -19 10 d -2 7 d f 0.525 0.525 0.525 c 1304 1421 m
- 2 9 d -18 27 d -2 6 d f 0.55 0.55 0.55 c 1301 1411 m 3 10 d -18 42 d -2 7 d f
- 0.575 0.575 0.575 c 1298 1401 m 3 10 d -17 59 d -2 6 d f 0.6 0.6 0.6 c 1296
- 1391 m 2 10 d -16 75 d -2 6 d f 0.625 0.625 0.625 c 1293 1383 m 3 8 d -16 91 d
- -2 7 d 14 -101 d f 0.65 0.65 0.65 c 1278 1489 m -2 6 d 9 -63 d 7 -44 d f 0.675
- 0.675 0.675 c 1276 1495 m -2 7 d 4 -26 d 7 -44 d f 0.7 0.7 0.7 c 1274 1502 m -1
- 4 d 5 -30 d f 0.425 0.425 0.425 c 1270 1390 m 2 -1 d -21 75 d -2 -4 d f 0.45
- 0.45 0.45 c 1272 1389 m 3 X -22 79 d -2 -4 d f 0.475 0.475 0.475 c 1275 1389 m
- 3 -1 d -23 83 d -2 -3 d f 0.5 0.5 0.5 c 1278 1388 m 2 -1 d -23 88 d -2 -4 d f
- 0.525 0.525 0.525 c 1280 1387 m 3 -1 d -24 93 d -2 -4 d f 0.55 0.55 0.55 c 1283
- 1386 m 3 -1 d -25 98 d -2 -4 d f 0.575 0.575 0.575 c 1286 1385 m 2 -1 d -25 103
- d -2 -4 d f 0.6 0.6 0.6 c 1288 1384 m 3 X -25 107 d -3 -4 d f 0.625 0.625 0.625
- c 1291 1384 m 2 -1 d -1 5 d -24 107 d -2 -4 d f 0.65 0.65 0.65 c 1292 1388 m -7
- 44 d -15 67 d -2 -4 d f 0.675 0.675 0.675 c 1285 1432 m -7 44 d -6 27 d -2 -4 d
- f 0.7 0.7 0.7 c 1278 1476 m -5 30 d -1 -3 d f 0.425 0.425 0.425 c 1246 1546 m
- 24 -156 d -21 70 d f 1246 1546 m 24 -156 d -21 70 d -23 -33 d f 1223 1472 m 23
- 74 d -20 -119 d -24 -73 d f 1199 1547 m 24 -75 d -21 -118 d -23 34 d f 1176
- 1595 m 23 -48 d -20 -159 d -24 -20 d f 1152 1454 m 24 141 d -21 -227 d -23 48 d
- f 1129 1475 m 23 -21 d -20 -38 d -24 8 d f 1105 1496 m 24 -21 d -21 -51 d -23
- -47 d f 1082 1450 m 23 46 d -20 -119 d -24 21 d f 1058 1498 m 24 -48 d -21 -52
- d -23 -33 d f 1035 1613 m 23 -115 d -20 -133 d -23 -6 d f 1011 1338 m 24 275 d
- -20 -254 d -24 -32 d f 988 1466 m 23 -128 d -20 -11 d -23 101 d f 964 1460 m 24
- 6 d -20 -38 d -24 -60 d f 941 1401 m 23 59 d -20 -92 d -23 -32 d f 917 1381 m
- 24 20 d -20 -65 d -24 -20 d f 894 1402 m 23 -21 d -20 -65 d -23 -19 d f 870
- 1396 m 24 6 d -20 -105 d -11 -3 d 5 91 d f 0.45 0.45 0.45 c 863 1294 m -11 -3 d
- 11 Y 16 83 d f 0.475 0.475 0.475 c 852 1291 m -2 X 2 11 d f 0.425 0.425 0.425 c
- 847 1390 m 23 6 d -2 -11 d -28 -26 d f 0.45 0.45 0.45 c 868 1385 m -16 -83 d
- -14 -7 d -11 3 d 13 61 d f 0.475 0.475 0.475 c 852 1302 m -2 -11 d -12 4 d f
- 0.425 0.425 0.425 c 823 1451 m 24 -61 d -7 -31 d -24 -70 d -13 -10 d f 0.45
- 0.45 0.45 c 840 1359 m -13 -61 d -11 -9 d f 0.425 0.425 0.425 c 800 1338 m 23
- 113 d -20 -172 d -23 34 d f 776 1453 m 24 -115 d -20 -25 d -24 -60 d f 753 1420
- m 23 33 d -20 -200 d -23 102 d f 751 1416 m 2 4 d -20 -65 d -24 -6 d 15 8 d f
- 0.45 0.45 0.45 c 730 1360 m 21 56 d -27 -59 d f 0.425 0.425 0.425 c 706 1274 m
- 18 66 d 17 Y -15 -8 d -23 -100 d f 0.45 0.45 0.45 c 724 1340 m 6 20 d -6 -3 d f
- 0.425 0.425 0.425 c 683 1415 m 3 -166 d -24 34 d f 683 1415 m 23 -141 d -20 -25
- d -24 34 d f 659 1396 m 24 19 d -21 -132 d -23 21 d f 636 1215 m 23 181 d -20
- -92 d -24 8 d f 612 1424 m 24 -209 d -21 97 d -23 -100 d f 589 1311 m 23 113 d
- -20 -212 d -24 88 d f 565 1480 m 24 -169 d -21 -11 d -23 -47 d f 542 1286 m 23
- 194 d -20 -227 d -24 -46 d f 538 1244 m 4 42 d -21 -79 d -4 -26 d f 0.45 0.45
- 0.45 c 534 1203 m 4 41 d -21 -63 d -4 -25 d f 0.475 0.475 0.475 c 530 1161 m 4
- 42 d -21 -47 d -3 -26 d f 0.5 0.5 0.5 c 526 1120 m 4 41 d -20 -31 d -4 -25 d f
- 0.525 0.525 0.525 c 522 1078 m 4 42 d -20 -15 d -4 -26 d f 0.55 0.55 0.55 c 518
- 1038 m 4 40 d -20 1 d -4 -25 d 6 -5 d f 0.575 0.575 0.575 c 498 1054 m -1 Y 6
- -4 d f 0.55 0.55 0.55 c 495 1032 m 23 6 d -14 11 d -17 1 d -13 -3 d f 0.575
- 0.575 0.575 c 504 1049 m -6 4 d -11 -3 d f 0.55 0.55 0.55 c 471 1026 m 24 6 d
- -21 15 d -23 -6 d f 448 1020 m 23 6 d -20 15 d -24 -6 d f 1548 1279 m 24 6 d
- -20 16 d -24 -6 d f 1525 1273 m 23 6 d -20 16 d -23 -6 d f 1501 1267 m 24 6 d
- -20 16 d -24 -6 d f 0.425 0.425 0.425 c 1478 1557 m 4 -50 d -16 83 d f 0.45
- 0.45 0.45 c 1482 1507 m 4 -50 d -27 133 d -1 23 d 8 -23 d f 0.475 0.475 0.475 c
- 1486 1457 m 4 -50 d -25 103 d -6 80 d f 0.5 0.5 0.5 c 1490 1407 m 4 -50 d -23
- 73 d -6 80 d f 0.525 0.525 0.525 c 1494 1357 m 4 -50 d -22 44 d -5 79 d f 0.55
- 0.55 0.55 c 1498 1307 m 3 -40 d -20 16 d -5 68 d f 0.425 0.425 0.425 c 1455
- 1551 m 23 6 d -12 33 d -18 -13 d -14 -51 d f 0.45 0.45 0.45 c 1466 1590 m -8 23
- d -10 -36 d f 0.425 0.425 0.425 c 1431 1639 m 24 -88 d -21 -25 d -23 115 d f
- 1408 1579 m 23 60 d -20 2 d -24 -73 d f 1384 1533 m 24 46 d -21 -11 d f 1384
- 1533 m 24 46 d -21 -11 d -23 7 d f 1361 1621 m 23 -88 d -20 42 d -24 -113 d f
- 1340 1508 m 21 113 d -21 -159 d -23 7 d 20 25 d f 0.45 0.45 0.45 c 1337 1494 m
- 3 14 d -3 -14 d f 0.425 0.425 0.425 c 1337 1494 m -20 -25 d -3 -9 d f 0.45 0.45
- 0.45 c 1314 1623 m 23 -129 d -23 -34 d -3 -10 d 145 Y f 0.475 0.475 0.475 c
- 1311 1450 m -2 -10 d 124 Y 2 31 d f 0.5 0.5 0.5 c 1309 1440 m -3 -10 d 103 Y 3
- 31 d f 0.525 0.525 0.525 c 1306 1430 m -2 -9 d -1 81 d 3 31 d f 0.55 0.55 0.55
- c 1304 1421 m -3 -10 d 61 Y 2 30 d f 0.575 0.575 0.575 c 1301 1411 m -3 -10 d
- 40 Y 3 31 d f 0.6 0.6 0.6 c 1298 1401 m -2 -10 d 19 Y 2 31 d f 0.625 0.625
- 0.625 c 1296 1391 m -3 -8 d 3 27 d f 0.425 0.425 0.425 c 1290 1496 m 8 44 d -26
- -151 d -2 1 d f 0.45 0.45 0.45 c 1298 1540 m 16 83 d -3 -28 d -36 -206 d -3 X f
- 0.475 0.475 0.475 c 1311 1595 m -2 -31 d -31 -176 d -3 1 d f 0.5 0.5 0.5 c 1309
- 1564 m -3 -31 d -26 -146 d -2 1 d f 0.525 0.525 0.525 c 1306 1533 m -3 -31 d
- -20 -116 d -3 1 d f 0.55 0.55 0.55 c 1303 1502 m -2 -30 d -15 -87 d -3 1 d f
- 0.575 0.575 0.575 c 1301 1472 m -3 -31 d -10 -57 d -2 1 d f 0.6 0.6 0.6 c 1298
- 1441 m -2 -31 d -5 -26 d -3 X f 0.625 0.625 0.625 c 1296 1410 m -3 -27 d -2 1 d
- f 0.425 0.425 0.425 c 1267 1517 m 23 -21 d -20 -106 d -24 156 d f 1243 1605 m
- 24 -88 d -21 29 d -23 -74 d f 1220 1572 m 23 33 d -20 -133 d -24 75 d f 1217
- 1554 m 3 18 d -21 -25 d -23 48 d -5 Y f 0.45 0.45 0.45 c 1213 1529 m 4 25 d -41
- 36 d 4 -32 d f 0.475 0.475 0.475 c 1209 1504 m 4 25 d -33 29 d 4 -32 d f 0.5
- 0.5 0.5 c 1205 1478 m 4 26 d -25 22 d 3 -32 d f 0.525 0.525 0.525 c 1201 1453 m
- 4 25 d -18 16 d 4 -32 d f 0.55 0.55 0.55 c 1198 1428 m 3 25 d -10 9 d 4 -32 d f
- 0.575 0.575 0.575 c 1196 1418 m 2 10 d -3 2 d f 0.425 0.425 0.425 c 1173 1533 m
- 3 -18 d 80 Y -24 -141 d f 0.45 0.45 0.45 c 1176 1515 m 4 -18 d 61 Y -4 32 d f
- 0.475 0.475 0.475 c 1180 1497 m 4 -18 d 47 Y -4 32 d f 0.5 0.5 0.5 c 1184 1479
- m 3 -18 d 33 Y -3 32 d f 0.525 0.525 0.525 c 1187 1461 m 4 -18 d 19 Y -4 32 d f
- 0.55 0.55 0.55 c 1191 1443 m 4 -18 d 5 Y -4 32 d f 0.575 0.575 0.575 c 1195
- 1425 m 1 -7 d -1 12 d f 0.425 0.425 0.425 c 1149 1527 m 24 6 d -21 -79 d -23 21
- d f 1126 1494 m 23 33 d -20 -52 d -24 21 d f 1102 1528 m 24 -34 d -21 2 d -23
- -46 d f 1079 1576 m 23 -48 d -20 -78 d -24 48 d f 1079 1576 m -21 -78 d -23 115
- d f 1055 1409 m 24 167 d -21 -78 d -23 115 d f 1034 1562 m 21 -153 d -20 204 d
- -24 -275 d 16 182 d f 0.45 0.45 0.45 c 1032 1578 m 2 -16 d -7 -42 d f 0.425
- 0.425 0.425 c 1008 1451 m 22 117 d -3 -48 d -16 -182 d -23 128 d f 0.45 0.45
- 0.45 c 1030 1568 m 2 10 d -5 -58 d f 0.425 0.425 0.425 c 985 1566 m 23 -115 d
- -20 15 d -24 -6 d f 961 1439 m 24 127 d -21 -106 d -23 -59 d f 938 1527 m 23
- -88 d -20 -38 d -24 -20 d f 914 1548 m 24 -21 d -21 -146 d -23 21 d f 891 1502
- m 23 46 d -20 -146 d -24 -6 d f 867 1496 m 24 6 d -21 -106 d -23 -6 d f 844
- 1597 m 23 -101 d -20 -106 d -24 61 d f 820 1390 m 24 207 d -21 -146 d -23 -113
- d f 797 1572 m 23 -182 d -20 -52 d -24 115 d f 775 1591 m 22 -19 d -21 -119 d
- -23 -33 d 3 26 d f 0.45 0.45 0.45 c 773 1593 m 2 -2 d -19 -145 d f 0.425 0.425
- 0.425 c 756 1446 m -3 -26 d -2 -4 d f 0.45 0.45 0.45 c 750 1452 m 23 141 d -17
- -147 d -5 -30 d -21 -56 d f 0.425 0.425 0.425 c 724 1340 m -18 -66 d 18 105 d f
- 0.45 0.45 0.45 c 726 1392 m 24 60 d -20 -92 d -6 -20 d 39 Y f 0.425 0.425 0.425
- c 703 1373 m 22 18 d -1 -12 d -18 -105 d -23 141 d f 0.45 0.45 0.45 c 725 1391
- m 1 1 d -2 -13 d f 0.425 0.425 0.425 c 679 1515 m 24 -142 d -20 42 d f 679 1515
- m 24 -142 d -20 42 d -24 -19 d f 656 1522 m 23 -7 d -20 -119 d -23 -181 d f 644
- 1499 m 12 23 d -20 -307 d -24 209 d 12 31 d f 0.45 0.45 0.45 c 632 1476 m 12 23
- d -20 -44 d f 0.425 0.425 0.425 c 609 1363 m 14 66 d 1 26 d -12 -31 d -23 -113
- d f 0.45 0.45 0.45 c 623 1429 m 9 47 d -8 -21 d f 0.425 0.425 0.425 c 585 1383
- m 24 -20 d -20 -52 d -24 169 d f 562 1324 m 23 59 d -20 97 d -23 -194 d f 558
- 1274 m 4 50 d -20 -38 d -4 -42 d f 0.45 0.45 0.45 c 554 1224 m 4 50 d -20 -30 d
- -4 -41 d f 0.475 0.475 0.475 c 550 1174 m 4 50 d -20 -21 d -4 -42 d f 0.5 0.5
- 0.5 c 546 1124 m 4 50 d -20 -13 d -4 -41 d f 0.525 0.525 0.525 c 542 1074 m 4
- 50 d -20 -4 d -4 -42 d f 0.55 0.55 0.55 c 539 1024 m 3 50 d -20 4 d -4 -40 d 9
- -7 d f 0.575 0.575 0.575 c 538 1022 m 1 2 d -12 7 d f 0.55 0.55 0.55 c 515 1016
- m 6 2 d 6 13 d -9 7 d -23 -6 d f 0.575 0.575 0.575 c 521 1018 m 17 4 d -11 9 d
- f 0.55 0.55 0.55 c 491 1010 m 24 6 d -20 16 d -24 -6 d f 468 1004 m 23 6 d -20
- 16 d -23 -6 d f 1569 1264 m 23 6 d -20 15 d -24 -6 d f 1545 1258 m 24 6 d -21
- 15 d -23 -6 d f 1522 1252 m 23 6 d -20 15 d -24 -6 d f 0.425 0.425 0.425 c 1498
- 1756 m 3 -48 d -19 -201 d -4 50 d f 0.45 0.45 0.45 c 1501 1708 m 4 -97 d -19
- -154 d -4 50 d f 0.475 0.475 0.475 c 1505 1611 m 5 -96 d -20 -108 d -4 50 d f
- 0.5 0.5 0.5 c 1510 1515 m 4 -97 d -20 -61 d -4 50 d f 0.525 0.525 0.525 c 1514
- 1418 m 5 -97 d -21 -14 d -4 50 d f 0.55 0.55 0.55 c 1519 1321 m 3 -69 d -21 15
- d -3 40 d f 0.425 0.425 0.425 c 1475 1750 m 23 6 d -20 -199 d -23 -6 d f 1451
- 1865 m 24 -115 d -20 -199 d -24 88 d f 1440 1778 m 11 87 d -20 -226 d -23 -60 d
- 16 85 d f 0.45 0.45 0.45 c 1428 1685 m 12 93 d -16 -114 d f 0.425 0.425 0.425 c
- 1404 1612 m 15 46 d 5 6 d -16 -85 d -24 -46 d f 0.45 0.45 0.45 c 1419 1658 m 9
- 27 d -4 -21 d f 0.425 0.425 0.425 c 1381 1700 m 23 -88 d -20 -79 d -23 88 d f
- 1357 1774 m 24 -74 d -20 -79 d -21 -113 d 22 Y f 0.45 0.45 0.45 c 1340 1508 m
- -3 -14 d 3 36 d f 0.425 0.425 0.425 c 1341 1714 m 16 60 d -17 -244 d f 0.45
- 0.45 0.45 c 1334 1688 m 7 26 d -1 -184 d -3 -36 d -23 129 d f 0.425 0.425 0.425
- c 1310 1695 m 15 -5 d -27 -150 d -8 -44 d f 0.45 0.45 0.45 c 1325 1690 m 9 -2 d
- -20 -65 d -16 -83 d f 0.425 0.425 0.425 c 1287 1716 m 23 -21 d -20 -199 d -23
- 21 d f 1263 1616 m 24 100 d -20 -199 d -24 88 d f 1240 1704 m 23 -88 d -20 -11
- d -23 -33 d f 1216 1577 m 24 127 d -20 -132 d -3 -18 d -2 12 d f 0.45 0.45 0.45
- c 1217 1554 m -4 -25 d -2 9 d 4 28 d f 0.475 0.475 0.475 c 1213 1529 m -4 -25 d
- -1 7 d 3 27 d f 0.5 0.5 0.5 c 1209 1504 m -4 -26 d -1 5 d 4 28 d f 0.525 0.525
- 0.525 c 1205 1478 m -4 -25 d 3 Y 3 27 d f 0.55 0.55 0.55 c 1201 1453 m -3 -25 d
- -1 1 d 4 27 d f 0.575 0.575 0.575 c 1198 1428 m -2 -10 d 1 11 d f 0.425 0.425
- 0.425 c 1193 1598 m 23 -21 d -1 -11 d -39 -51 d -3 18 d f 0.45 0.45 0.45 c 1215
- 1566 m -4 -28 d -31 -41 d -4 18 d f 0.475 0.475 0.475 c 1211 1538 m -3 -27 d
- -24 -32 d -4 18 d f 0.5 0.5 0.5 c 1208 1511 m -4 -28 d -17 -22 d -3 18 d f
- 0.525 0.525 0.525 c 1204 1483 m -3 -27 d -10 -13 d -4 18 d f 0.55 0.55 0.55 c
- 1201 1456 m -4 -27 d -2 -4 d -4 18 d f 0.575 0.575 0.575 c 1197 1429 m -1 -11 d
- -1 7 d f 0.425 0.425 0.425 c 1170 1740 m 23 -142 d -20 -65 d -24 -6 d f 1149
- 1562 m 21 178 d -21 -213 d -23 -33 d 20 38 d f 0.45 0.45 0.45 c 1146 1532 m 3
- 30 d -3 -30 d f 0.425 0.425 0.425 c 1123 1647 m 23 -113 d -2 Y -20 -38 d -24 34
- d f 0.45 0.45 0.45 c 1146 1534 m -2 Y f 0.425 0.425 0.425 c 1099 1547 m 24 100
- d -44 -71 d f 1099 1547 m 24 100 d -21 -119 d -23 48 d f 1076 1756 m 23 -209 d
- -20 29 d -24 -167 d f 1057 1635 m 19 121 d -21 -347 d -21 153 d f 0.45 0.45
- 0.45 c 1052 1602 m 5 33 d -23 -73 d -2 16 d f 0.425 0.425 0.425 c 1029 1543 m
- 16 43 d -15 -18 d -22 -117 d f 0.45 0.45 0.45 c 1045 1586 m 7 16 d -20 -24 d -2
- -10 d f 0.425 0.425 0.425 c 1005 1564 m 24 -21 d -21 -92 d -23 115 d f 982 1531
- m 23 33 d -20 2 d -24 -127 d f 958 1673 m 24 -142 d -21 -92 d -23 88 d f 935
- 1496 m 23 177 d -20 -146 d -24 21 d 17 -45 d f 0.45 0.45 0.45 c 935 1492 m 4 Y
- -4 7 d f 0.425 0.425 0.425 c 911 1432 m 23 59 d -3 12 d -17 45 d -23 -46 d f
- 0.45 0.45 0.45 c 934 1491 m 1 1 d -4 11 d f 0.425 0.425 0.425 c 888 1493 m 3 9
- d -24 -6 d f 888 1493 m 23 -61 d -20 70 d -24 -6 d f 864 1608 m 24 -115 d -21 3
- d -23 101 d f 841 1481 m 23 127 d -20 -11 d -24 -207 d f 817 1610 m 24 -129 d
- -21 -91 d -23 182 d f 794 1685 m 23 -75 d -20 -38 d f 794 1685 m 23 -75 d -20
- -38 d -22 19 d 9 Y f 0.45 0.45 0.45 c 775 1591 m -2 2 d 2 7 d f 0.425 0.425
- 0.425 c 773 1586 m 21 99 d -19 -85 d f 0.45 0.45 0.45 c 770 1571 m 3 15 d 2 14
- d -2 -7 d -23 -141 d f 747 1538 m 23 33 d -20 -119 d -24 -60 d f 0.425 0.425
- 0.425 c 725 1391 m -22 -18 d 18 10 d f 0.45 0.45 0.45 c 723 1384 m 24 154 d -21
- -146 d -1 -1 d -4 -8 d f 0.425 0.425 0.425 c 700 1446 m 3 -73 d -24 142 d f 700
- 1446 m 21 -56 d -7 Y -18 -10 d -24 142 d f 0.45 0.45 0.45 c 721 1390 m 2 -6 d
- -2 -1 d f 0.425 0.425 0.425 c 676 1614 m 24 -168 d -21 69 d f 676 1614 m 24
- -168 d -21 69 d -23 7 d f 655 1573 m 21 41 d -20 -92 d -12 -23 d f 0.45 0.45
- 0.45 c 653 1568 m 2 5 d -11 -74 d -12 -23 d f 0.425 0.425 0.425 c 629 1468 m 6
- 26 d -12 -65 d -14 -66 d f 0.45 0.45 0.45 c 635 1494 m 18 74 d -21 -92 d -9 -47
- d f 0.425 0.425 0.425 c 606 1583 m 23 -115 d -20 -105 d -24 20 d f 582 1362 m
- 24 221 d -21 -200 d -23 -59 d f 578 1302 m 4 60 d -20 -38 d -4 -50 d f 0.45
- 0.45 0.45 c 574 1242 m 4 60 d -20 -28 d -4 -50 d f 0.475 0.475 0.475 c 570 1183
- m 4 59 d -20 -18 d -4 -50 d f 0.5 0.5 0.5 c 566 1123 m 4 60 d -20 -9 d -4 -50 d
- f 0.525 0.525 0.525 c 563 1063 m 3 60 d -20 1 d -4 -50 d f 0.55 0.55 0.55 c 559
- 1007 m 4 56 d -21 11 d -3 -50 d 6 -7 d f 0.575 0.575 0.575 c 539 1024 m -1 -2 d
- 7 -5 d f 0.55 0.55 0.55 c 535 1001 m 24 6 d -14 10 d -24 1 d -6 -2 d f 0.575
- 0.575 0.575 c 545 1017 m -7 5 d -17 -4 d f 0.55 0.55 0.55 c 512 995 m 23 6 d
- -20 15 d -24 -6 d f 488 989 m 24 6 d -21 15 d -23 -6 d f 1589 1248 m 24 6 d -21
- 16 d -23 -6 d f 1566 1242 m 23 6 d -20 16 d -24 -6 d f 1542 1236 m 24 6 d -21
- 16 d -23 -6 d f 0.425 0.425 0.425 c 1519 1983 m 3 -109 d -21 -166 d -3 48 d f
- 0.45 0.45 0.45 c 1522 1874 m 4 -133 d -21 -130 d -4 97 d f 0.475 0.475 0.475 c
- 1526 1741 m 4 -133 d -20 -93 d -5 96 d f 0.5 0.5 0.5 c 1530 1608 m 5 -132 d -21
- -58 d -4 97 d f 0.525 0.525 0.525 c 1535 1476 m 4 -133 d -20 -22 d -5 97 d f
- 0.55 0.55 0.55 c 1539 1343 m 3 -107 d -20 16 d -3 69 d f 0.425 0.425 0.425 c
- 1495 1829 m 24 154 d -21 -227 d -23 -6 d f 1472 1850 m 23 -21 d -20 -79 d -24
- 115 d f 1448 1562 m 24 288 d -21 15 d -11 -87 d -5 -135 d f 0.45 0.45 0.45 c
- 1440 1778 m -12 -93 d 7 -42 d f 0.425 0.425 0.425 c 1425 1865 m 23 -303 d -13
- 81 d -16 15 d -15 -46 d f 0.45 0.45 0.45 c 1435 1643 m -7 42 d -9 -27 d f 0.425
- 0.425 0.425 c 1401 1630 m 24 235 d -21 -253 d -23 88 d f 1378 1839 m 23 -209 d
- -20 70 d -24 74 d f 1354 1793 m 24 46 d -21 -65 d -16 -60 d -4 -12 d f 0.45
- 0.45 0.45 c 1341 1714 m -7 -26 d 3 14 d f 0.425 0.425 0.425 c 1331 1801 m 23 -8
- d -17 -91 d -12 -12 d -15 5 d f 0.45 0.45 0.45 c 1337 1702 m -3 -14 d -9 2 d f
- 0.425 0.425 0.425 c 1318 1790 m 13 11 d -21 -106 d -23 21 d 4 12 d f 0.45 0.45
- 0.45 c 1307 1781 m 11 9 d -27 -62 d f 0.425 0.425 0.425 c 1284 1627 m 12 80 d
- -5 21 d -4 -12 d -24 -100 d f 0.45 0.45 0.45 c 1296 1707 m 11 74 d -16 -53 d f
- 0.425 0.425 0.425 c 1260 1608 m 3 8 d -23 88 d f 1260 1608 m 24 19 d -21 -11 d
- -23 88 d f 1237 1736 m 23 -128 d -20 96 d -24 -127 d f 1213 1623 m 24 113 d -21
- -159 d -23 21 d f 1190 1818 m 23 -195 d -20 -25 d -23 142 d f 1166 1718 m 24
- 100 d -20 -78 d -21 -178 d -3 -27 d f 0.45 0.45 0.45 c 1149 1562 m -3 -30 d 3 Y
- f 0.425 0.425 0.425 c 1143 1551 m 23 167 d -43 -71 d f 1143 1551 m 23 167 d -20
- -183 d -1 Y -23 113 d f 0.45 0.45 0.45 c 1146 1535 m -3 Y 2 Y f 0.425 0.425
- 0.425 c 1119 1653 m 24 -102 d -20 96 d -24 -100 d f 1119 1653 m 24 -102 d -20
- 96 d -24 -100 d f 1096 1700 m 23 -47 d -20 -106 d -23 209 d f 1072 1627 m 24 73
- d -20 56 d -19 -121 d -2 -29 d f 0.45 0.45 0.45 c 1057 1635 m -5 -33 d 3 4 d f
- 0.425 0.425 0.425 c 1049 1742 m 23 -115 d -17 -21 d -10 -20 d -16 -43 d f 0.45
- 0.45 0.45 c 1055 1606 m -3 -4 d -7 -16 d f 0.425 0.425 0.425 c 1029 1613 m 20
- 129 d -20 -199 d -24 21 d 16 19 d f 0.45 0.45 0.45 c 1025 1588 m 4 25 d -8 -30
- d f 0.425 0.425 0.425 c 1002 1569 m 22 18 d -3 -4 d -16 -19 d -23 -33 d f 0.45
- 0.45 0.45 c 1024 1587 m 1 1 d -4 -5 d f 0.425 0.425 0.425 c 978 1603 m 24 -34 d
- -20 -38 d -24 142 d f 955 1732 m 23 -129 d -20 70 d -23 -177 d 1 Y f 0.45 0.45
- 0.45 c 935 1496 m -4 Y 5 Y f 0.425 0.425 0.425 c 931 1793 m 24 -61 d -20 -235 d
- -1 -6 d -23 -59 d f 0.45 0.45 0.45 c 935 1497 m -5 Y -1 -1 d f 0.425 0.425
- 0.425 c 908 1572 m 23 221 d -20 -361 d -23 61 d f 884 1606 m 24 -34 d -20 -79 d
- -24 115 d f 861 1735 m 23 -129 d -20 2 d -23 -127 d f 838 1460 m 23 275 d -20
- -254 d -24 129 d f 814 1629 m 3 -19 d -23 75 d f 814 1629 m 24 -169 d -21 150 d
- -23 75 d f 791 1582 m 23 47 d -20 56 d f 791 1582 m 23 47 d -20 56 d -21 -99 d
- -13 Y f 0.45 0.45 0.45 c 773 1586 m -3 -15 d 3 2 d f 0.425 0.425 0.425 c 767
- 1778 m 24 -196 d -18 -9 d -12 138 d f 0.45 0.45 0.45 c 773 1573 m -3 -2 d -23
- -33 d 14 173 d f 0.425 0.425 0.425 c 763 1750 m 4 28 d -6 -67 d f 0.45 0.45
- 0.45 c 744 1624 m 19 126 d -2 -39 d -14 -173 d -24 -154 d f 0.425 0.425 0.425 c
- 721 1390 m -21 56 d 18 69 d f 0.45 0.45 0.45 c 720 1524 m 24 100 d -21 -240 d
- -2 6 d -3 125 d f 0.425 0.425 0.425 c 697 1572 m 3 -126 d -24 168 d f 697 1572
- m 20 -42 d 1 -15 d -18 -69 d -24 168 d f 0.45 0.45 0.45 c 717 1530 m 3 -6 d -2
- -9 d f 0.425 0.425 0.425 c 682 1663 m 15 -91 d -21 42 d -21 -41 d f 0.45 0.45
- 0.45 c 673 1714 m 9 -51 d -27 -90 d -2 -5 d f 0.425 0.425 0.425 c 650 1587 m 15
- 81 d -30 -174 d -6 -26 d f 0.45 0.45 0.45 c 665 1668 m 8 46 d -20 -146 d -18
- -74 d f 0.425 0.425 0.425 c 626 1688 m 24 -101 d -21 -119 d -23 115 d f 603
- 1736 m 23 -48 d -44 -326 d f 603 1736 m 23 -48 d -20 -105 d -24 -221 d f 599
- 1611 m 4 125 d -21 -374 d -4 -60 d f 0.45 0.45 0.45 c 595 1487 m 4 124 d -21
- -309 d -4 -60 d f 0.475 0.475 0.475 c 591 1362 m 4 125 d -21 -245 d -4 -59 d f
- 0.5 0.5 0.5 c 587 1237 m 4 125 d -21 -179 d -4 -60 d f 0.525 0.525 0.525 c 583
- 1113 m 4 124 d -21 -114 d -3 -60 d f 0.55 0.55 0.55 c 579 991 m 4 122 d -20 -50
- d -4 -56 d f 556 985 m 23 6 d -20 16 d -24 -6 d f 532 979 m 24 6 d -21 16 d -23
- -6 d f 509 973 m 23 6 d -20 16 d -24 -6 d f 1610 1233 m 23 6 d -20 15 d -24 -6
- d f 1586 1227 m 24 6 d -21 15 d -23 -6 d f 1563 1221 m 23 6 d -20 15 d -24 -6 d
- f 0.425 0.425 0.425 c 1522 1874 m -3 109 d 12 -42 d f 0.45 0.45 0.45 c 1539
- 1913 m 2 -71 d -15 -101 d -4 133 d 9 67 d f 0.475 0.475 0.475 c 1541 1842 m 6
- -161 d -17 -73 d -4 133 d f 0.5 0.5 0.5 c 1547 1681 m 5 -161 d -17 -44 d -5 132
- d f 0.525 0.525 0.525 c 1552 1520 m 6 -161 d -19 -16 d -4 133 d f 0.55 0.55
- 0.55 c 1558 1359 m 5 -138 d -21 15 d -3 107 d f 0.425 0.425 0.425 c 1516 1840 m
- 15 47 d 54 Y -12 42 d -24 -154 d f 0.45 0.45 0.45 c 1531 1887 m 8 26 d -8 28 d
- f 0.425 0.425 0.425 c 1492 1848 m 24 -8 d -21 -11 d -23 21 d f 1492 1848 m 24
- -8 d -21 -11 d -23 21 d f 1469 1855 m 23 -7 d -20 2 d -24 -288 d f 1460 1810 m
- 9 45 d -21 -293 d -23 303 d 8 -57 d f 0.45 0.45 0.45 c 1445 1728 m 15 82 d -27
- -2 d f 0.425 0.425 0.425 c 1422 1789 m 9 -24 d 2 43 d -8 57 d -24 -235 d f 0.45
- 0.45 0.45 c 1431 1765 m 14 -37 d -12 80 d f 0.425 0.425 0.425 c 1398 1784 m 24
- 5 d -21 -159 d -23 209 d f 1375 1670 m 23 114 d -20 55 d -24 -46 d f 1351 2067
- m 24 -397 d -21 123 d -23 8 d f 1328 1846 m 23 221 d -20 -266 d -13 -11 d -1 23
- d f 0.45 0.45 0.45 c 1318 1790 m -11 -9 d 10 32 d f 0.425 0.425 0.425 c 1304
- 1827 m 24 19 d -11 -33 d -21 -106 d -12 -80 d f 0.45 0.45 0.45 c 1317 1813 m
- -10 -32 d -11 -74 d f 0.425 0.425 0.425 c 1281 1861 m 23 -34 d -20 -200 d -24
- -19 d f 1257 1801 m 24 60 d -21 -253 d -23 128 d f 1234 1836 m 23 -35 d -20 -65
- d -24 -113 d f 1210 1736 m 24 100 d -21 -213 d -23 195 d f 1187 1595 m 23 141 d
- -20 82 d -24 -100 d f 1163 1697 m 24 -102 d -21 123 d -23 -167 d f 1140 1745 m
- 23 -48 d -20 -146 d -24 102 d f 1116 1766 m 24 -21 d -21 -92 d -23 47 d f 1093
- 1679 m 23 87 d -20 -66 d -24 -73 d f 1069 1700 m 24 -21 d -21 -52 d -23 115 d f
- 1046 1734 m 23 -34 d -20 42 d -20 -129 d -2 -12 d f 0.45 0.45 0.45 c 1029 1613
- m -4 -25 d 2 13 d f 0.425 0.425 0.425 c 1022 1621 m 24 113 d -19 -133 d -3 -14
- d -22 -18 d f 0.45 0.45 0.45 c 1027 1601 m -2 -13 d -1 -1 d f 0.425 0.425 0.425
- c 999 1776 m 23 -155 d -20 -52 d -24 34 d f 975 1622 m 24 154 d -21 -173 d -23
- 129 d f 953 1616 m 22 6 d -20 110 d -24 61 d 19 -161 d f 0.45 0.45 0.45 c 952
- 1616 m 1 X -3 16 d f 0.425 0.425 0.425 c 928 1677 m 22 -56 d 11 Y -19 161 d -23
- -221 d f 0.45 0.45 0.45 c 950 1621 m 2 -5 d -2 16 d f 0.425 0.425 0.425 c 905
- 1725 m 23 -48 d -20 -105 d -24 34 d f 881 1719 m 24 6 d -21 -119 d f 881 1719 m
- 24 6 d -21 -119 d -23 129 d f 858 1700 m 23 19 d -20 16 d -23 -275 d f 834 1613
- m 24 87 d -20 -240 d -24 169 d f 811 1728 m 23 -115 d -20 16 d -23 -47 d f 811
- 1728 m 23 -115 d -20 16 d -23 -47 d f 801 1790 m 10 -62 d -20 -146 d -24 196 d
- 1 7 d f 0.45 0.45 0.45 c 792 1853 m 9 -63 d -33 -5 d 13 66 d f 0.475 0.475
- 0.475 c 787 1883 m 5 -30 d -11 -2 d f 0.425 0.425 0.425 c 764 1931 m 9 -18 d -5
- -128 d -1 -7 d -4 -28 d -12 -18 d f 0.45 0.45 0.45 c 773 1913 m 10 -20 d -2 -42
- d -13 -66 d -5 -35 d -19 -126 d 7 108 d f 0.475 0.475 0.475 c 783 1893 m 4 -10
- d -6 -32 d f 0.425 0.425 0.425 c 740 1750 m 24 181 d -13 -199 d -28 -180 d f
- 0.45 0.45 0.45 c 751 1732 m -7 -108 d -24 -100 d 3 28 d f 0.425 0.425 0.425 c
- 717 1556 m 23 194 d -17 -198 d -6 -22 d -20 42 d f 0.45 0.45 0.45 c 723 1552 m
- -3 -28 d -3 6 d f 0.425 0.425 0.425 c 716 1558 m 1 -2 d -20 16 d -15 91 d f
- 0.45 0.45 0.45 c 699 1583 m 17 -25 d -34 105 d -9 51 d 12 -74 d f 0.475 0.475
- 0.475 c 693 1591 m 6 -8 d -14 57 d f 0.425 0.425 0.425 c 665 1668 m -15 -81 d 9
- 47 d f 0.45 0.45 0.45 c 685 1640 m -12 74 d -8 -46 d -6 -34 d 9 48 d f 0.475
- 0.475 0.475 c 670 1692 m 23 -101 d -8 49 d -17 42 d f 0.425 0.425 0.425 c 646
- 1606 m 4 -19 d -24 101 d f 646 1606 m 11 39 d 2 -11 d -9 -47 d -24 101 d f 0.45
- 0.45 0.45 c 657 1645 m 11 39 d -2 Y -9 -48 d f 0.475 0.475 0.475 c 668 1684 m 2
- 8 d -2 -10 d f 0.425 0.425 0.425 c 623 1707 m 23 -101 d -20 82 d -23 48 d f 623
- 1707 m 23 -101 d -20 82 d -23 48 d f 619 1588 m 4 119 d -20 29 d -4 -125 d f
- 0.45 0.45 0.45 c 615 1468 m 4 120 d -20 23 d -4 -124 d f 0.475 0.475 0.475 c
- 611 1349 m 4 119 d -20 19 d -4 -125 d f 0.5 0.5 0.5 c 608 1229 m 3 120 d -20 13
- d -4 -125 d f 0.525 0.525 0.525 c 604 1110 m 4 119 d -21 8 d -4 -124 d f 0.55
- 0.55 0.55 c 600 991 m 4 119 d -21 3 d -4 -122 d 3 -2 d f 0.575 0.575 0.575 c
- 599 976 m 1 15 d -18 -2 d f 0.55 0.55 0.55 c 576 970 m 2 X 4 19 d -3 2 d -23 -6
- d f 0.575 0.575 0.575 c 578 970 m 21 6 d -17 13 d f 0.55 0.55 0.55 c 552 964 m
- 24 6 d -20 15 d -24 -6 d f 529 958 m 23 6 d -20 15 d -23 -6 d f 1630 1217 m 23
- 6 d -20 16 d -23 -6 d f 1606 1211 m 24 6 d -20 16 d -24 -6 d f 1583 1205 m 23 6
- d -20 16 d -23 -6 d f 0.45 0.45 0.45 c 1541 1842 m -2 71 d 1 X f 0.475 0.475
- 0.475 c 1547 1681 m -6 161 d -1 71 d 1 X f 0.5 0.5 0.5 c 1552 1520 m -5 161 d
- -6 232 d 2 X f 0.525 0.525 0.525 c 1558 1359 m -6 161 d -9 393 d 1 X f 0.55
- 0.55 0.55 c 1583 1213 m -8 Y -20 16 d -5 138 d -14 554 d 1 X f 0.575 0.575
- 0.575 c 1580 1286 m 3 -73 d -38 700 d 2 X f 0.6 0.6 0.6 c 1578 1358 m 2 -72 d
- -33 627 d 1 -1 d f 0.625 0.625 0.625 c 1575 1431 m 3 -73 d -30 554 d 2 X f 0.65
- 0.65 0.65 c 1573 1504 m 2 -73 d -25 481 d 1 X f 0.675 0.675 0.675 c 1571 1576 m
- 2 -72 d -22 408 d 2 X f 0.7 0.7 0.7 c 1568 1649 m 3 -73 d -18 336 d 1 X f 0.725
- 0.725 0.725 c 1566 1722 m 2 -73 d -14 263 d 2 X f 0.75 0.75 0.75 c 1563 1795 m
- 3 -73 d -10 190 d 1 X f 0.775 0.775 0.775 c 1561 1867 m 2 -72 d -6 117 d 1 -1 d
- f 0.8 0.8 0.8 c 1559 1911 m 2 -44 d -3 44 d f 0.425 0.425 0.425 c 1531 1887 m
- -15 -47 d 6 12 d f 0.45 0.45 0.45 c 1540 1913 m -1 X -8 -26 d -9 -35 d 6 13 d f
- 0.475 0.475 0.475 c 1541 1913 m -1 X -12 -48 d 7 12 d f 0.5 0.5 0.5 c 1536 1878
- m 1 3 d 6 32 d -2 X -6 -36 d f 0.525 0.525 0.525 c 1537 1881 m 2 2 d 5 30 d -1
- X f 0.55 0.55 0.55 c 1539 1883 m 2 3 d 4 27 d -1 X f 0.575 0.575 0.575 c 1541
- 1886 m 2 3 d 4 24 d -2 X f 0.6 0.6 0.6 c 1543 1889 m 2 2 d 3 21 d -1 1 d f
- 0.625 0.625 0.625 c 1545 1891 m 2 3 d 3 18 d -2 X f 0.65 0.65 0.65 c 1547 1894
- m 2 3 d 2 15 d -1 X f 0.675 0.675 0.675 c 1549 1897 m 2 2 d 2 13 d -2 X f 0.7
- 0.7 0.7 c 1551 1899 m 2 3 d 1 10 d -1 X f 0.725 0.725 0.725 c 1553 1902 m 1 2 d
- 2 8 d -2 X f 0.75 0.75 0.75 c 1554 1904 m 2 3 d 1 5 d -1 X f 0.775 0.775 0.775
- c 1556 1907 m 2 3 d 1 Y -1 1 d f 0.8 0.8 0.8 c 1558 1910 m 1 1 d -1 X f 0.425
- 0.425 0.425 c 1512 1886 m 4 -46 d -24 8 d f 1512 1886 m 8 -2 d 2 -32 d -6 -12 d
- -24 8 d f 0.45 0.45 0.45 c 1520 1884 m 7 -3 d 1 -16 d -6 -13 d f 0.475 0.475
- 0.475 c 1527 1881 m 8 -2 d -2 Y -7 -12 d f 0.5 0.5 0.5 c 1535 1879 m 1 -1 d -1
- -1 d f 0.425 0.425 0.425 c 1489 1705 m 23 181 d -20 -38 d f 1489 1705 m 23 181
- d -20 -38 d -23 7 d f 1476 1748 m 13 -43 d -20 150 d -9 -45 d f 0.45 0.45 0.45
- c 1465 1780 m 11 -32 d -16 62 d -15 -82 d f 0.425 0.425 0.425 c 1442 1962 m 8
- -65 d -19 -132 d -9 24 d f 0.45 0.45 0.45 c 1450 1897 m 15 -117 d -20 -52 d -14
- 37 d f 0.425 0.425 0.425 c 1418 1808 m 24 154 d -20 -173 d -24 -5 d f 1395 1856
- m 23 -48 d -20 -24 d -23 -114 d f 1371 1796 m 24 60 d -20 -186 d -24 397 d f
- 1371 1796 m 24 60 d -20 -186 d -24 397 d f 1367 1791 m 4 5 d -20 271 d -23 -221
- d 1 -5 d f 0.45 0.45 0.45 c 1363 1785 m 4 6 d -38 50 d 4 -17 d f 0.475 0.475
- 0.475 c 1359 1779 m 4 6 d -30 39 d 4 -16 d f 0.5 0.5 0.5 c 1355 1773 m 4 6 d
- -22 29 d 4 -17 d f 0.525 0.525 0.525 c 1351 1767 m 4 6 d -14 18 d 4 -16 d f
- 0.55 0.55 0.55 c 1348 1763 m 3 4 d -6 8 d f 0.425 0.425 0.425 c 1324 1798 m 5
- -6 d 49 Y -1 5 d -24 -19 d f 0.45 0.45 0.45 c 1329 1792 m 4 -6 d 38 Y -4 17 d f
- 0.475 0.475 0.475 c 1333 1786 m 4 -6 d 28 Y -4 16 d f 0.5 0.5 0.5 c 1337 1780 m
- 4 -6 d 17 Y -4 17 d f 0.525 0.525 0.525 c 1341 1774 m 4 -6 d 7 Y -4 16 d f 0.55
- 0.55 0.55 c 1345 1768 m 3 -5 d -3 12 d f 0.425 0.425 0.425 c 1301 1886 m 23 -88
- d -20 29 d f 1301 1886 m 23 -88 d -20 29 d -23 34 d f 1278 1799 m 23 87 d -20
- -25 d -24 -60 d f 1275 1799 m 3 X -21 2 d -23 35 d 3 -6 d f 0.45 0.45 0.45 c
- 1272 1798 m 3 1 d -38 31 d 3 -7 d f 0.475 0.475 0.475 c 1268 1797 m 4 1 d -32
- 25 d 3 -6 d f 0.5 0.5 0.5 c 1264 1796 m 4 1 d -25 20 d 3 -6 d f 0.525 0.525
- 0.525 c 1261 1795 m 3 1 d -18 15 d 2 -6 d f 0.55 0.55 0.55 c 1257 1794 m 4 1 d
- -13 10 d 3 -6 d f 0.575 0.575 0.575 c 1254 1793 m 3 1 d -6 5 d f 0.425 0.425
- 0.425 c 1231 1680 m 1 6 d 5 144 d -3 6 d -24 -100 d f 0.45 0.45 0.45 c 1232
- 1686 m 4 18 d 4 119 d -3 7 d f 0.475 0.475 0.475 c 1236 1704 m 3 19 d 4 94 d -3
- 6 d f 0.5 0.5 0.5 c 1239 1723 m 4 18 d 3 70 d -3 6 d f 0.525 0.525 0.525 c 1243
- 1741 m 4 18 d 1 46 d -2 6 d f 0.55 0.55 0.55 c 1247 1759 m 4 18 d 22 Y -3 6 d f
- 0.575 0.575 0.575 c 1251 1777 m 3 16 d -3 6 d f 0.425 0.425 0.425 c 1207 1754 m
- 24 -74 d -21 56 d -23 -141 d f 1184 1829 m 23 -75 d -20 -159 d -24 102 d f 1160
- 1796 m 24 33 d -21 -132 d -23 48 d f 1158 1803 m 2 -7 d -20 -51 d -24 21 d 1 3
- d f 0.45 0.45 0.45 c 1156 1810 m 2 -7 d -41 -34 d 2 10 d f 0.475 0.475 0.475 c
- 1154 1816 m 2 -6 d -37 -31 d 2 10 d f 0.5 0.5 0.5 c 1152 1823 m 2 -7 d -33 -27
- d 2 10 d f 0.525 0.525 0.525 c 1149 1830 m 3 -7 d -29 -24 d 2 10 d f 0.55 0.55
- 0.55 c 1147 1837 m 2 -7 d -24 -21 d 2 10 d f 0.575 0.575 0.575 c 1145 1843 m 2
- -6 d -20 -18 d 2 11 d f 0.6 0.6 0.6 c 1143 1850 m 2 -7 d -16 -13 d 2 10 d f
- 0.625 0.625 0.625 c 1141 1857 m 2 -7 d -12 -10 d 2 10 d f 0.65 0.65 0.65 c 1139
- 1864 m 2 -7 d -8 -7 d 1 10 d f 0.675 0.675 0.675 c 1137 1870 m 2 -6 d -5 -4 d 2
- 10 d f 0.7 0.7 0.7 c 1137 1871 m -1 Y -1 X f 0.425 0.425 0.425 c 1117 1769 m -1
- -3 d -23 -87 d 2 19 d f 0.45 0.45 0.45 c 1113 1838 m 2 3 d 4 -62 d -2 -10 d -22
- -71 d f 0.475 0.475 0.475 c 1115 1841 m 2 3 d 4 -55 d -2 -10 d f 0.5 0.5 0.5 c
- 1117 1844 m 3 3 d 3 -48 d -2 -10 d f 0.525 0.525 0.525 c 1120 1847 m 2 4 d 3
- -42 d -2 -10 d f 0.55 0.55 0.55 c 1122 1851 m 3 3 d 2 -35 d -2 -10 d f 0.575
- 0.575 0.575 c 1125 1854 m 2 3 d 2 -27 d -2 -11 d f 0.6 0.6 0.6 c 1127 1857 m 2
- 4 d 2 -21 d -2 -10 d f 0.625 0.625 0.625 c 1129 1861 m 3 3 d 1 -14 d -2 -10 d f
- 0.65 0.65 0.65 c 1132 1864 m 2 3 d -7 Y -1 -10 d f 0.675 0.675 0.675 c 1134
- 1867 m 2 4 d -1 Y -2 -10 d f 0.7 0.7 0.7 c 1136 1871 m 1 X -1 -1 d f 0.425
- 0.425 0.425 c 1095 1698 m -2 -19 d -24 21 d 2 1 d f 0.45 0.45 0.45 c 1107 1803
- m 6 35 d -18 -140 d -24 3 d 6 3 d f 0.475 0.475 0.475 c 1099 1759 m 8 44 d -30
- -99 d 6 3 d f 0.5 0.5 0.5 c 1090 1716 m 9 43 d -16 -52 d 6 4 d f 0.525 0.525
- 0.525 c 1090 1711 m 5 Y -1 -5 d f 0.425 0.425 0.425 c 1071 1701 m -2 -1 d -23
- 34 d 17 -81 d f 0.45 0.45 0.45 c 1066 1638 m 7 21 d 4 45 d -6 -3 d -8 -48 d f
- 0.475 0.475 0.475 c 1073 1659 m 8 25 d 2 23 d -6 -3 d f 0.5 0.5 0.5 c 1081 1684
- m 8 25 d 2 Y -6 -4 d f 0.525 0.525 0.525 c 1089 1709 m 1 2 d -1 X f 0.425 0.425
- 0.425 c 1043 1672 m 20 -30 d 11 Y -17 81 d -24 -113 d f 0.45 0.45 0.45 c 1063
- 1642 m 3 -4 d -3 15 d f 0.425 0.425 0.425 c 1019 1760 m 24 -88 d -21 -51 d f
- 1019 1760 m 24 -88 d -21 -51 d -23 155 d f 996 1808 m 23 -48 d -20 16 d -24
- -154 d f 972 1722 m 24 86 d -21 -186 d -22 -6 d 5 Y f 0.45 0.45 0.45 c 953 1616
- m -1 X 1 5 d f 0.425 0.425 0.425 c 949 1810 m 23 -88 d -19 -101 d -3 X -22 56 d
- f 0.45 0.45 0.45 c 953 1621 m -1 -5 d -2 5 d f 0.425 0.425 0.425 c 925 1508 m
- 24 302 d -21 -133 d -23 48 d f 902 1610 m 3 115 d -24 -6 d f 902 1610 m 23 -102
- d -20 217 d -24 -6 d f 899 1622 m 3 -12 d -21 109 d -23 -19 d 1 2 d f 0.45 0.45
- 0.45 c 897 1634 m 2 -12 d -40 80 d 2 4 d f 0.475 0.475 0.475 c 895 1646 m 2 -12
- d -36 72 d 2 4 d f 0.5 0.5 0.5 c 893 1658 m 2 -12 d -32 64 d 2 3 d f 0.525
- 0.525 0.525 c 891 1670 m 2 -12 d -28 55 d 2 4 d f 0.55 0.55 0.55 c 888 1682 m 3
- -12 d -24 47 d 2 4 d f 0.575 0.575 0.575 c 886 1695 m 2 -13 d -19 39 d 2 4 d f
- 0.6 0.6 0.6 c 884 1707 m 2 -12 d -15 30 d 2 3 d f 0.625 0.625 0.625 c 882 1719
- m 2 -12 d -11 21 d 2 4 d f 0.65 0.65 0.65 c 879 1731 m 3 -12 d -7 13 d 2 4 d f
- 0.675 0.675 0.675 c 878 1738 m 1 -7 d -2 5 d f 0.425 0.425 0.425 c 859 1702 m
- -1 -2 d -24 -87 d 2 8 d f 0.45 0.45 0.45 c 861 1706 m -2 -4 d -23 -81 d 3 9 d f
- 0.475 0.475 0.475 c 863 1710 m -2 -4 d -22 -76 d 2 8 d f 0.5 0.5 0.5 c 865 1713
- m -2 -3 d -22 -72 d 2 8 d f 0.525 0.525 0.525 c 867 1717 m -2 -4 d -22 -67 d 2
- 8 d f 0.55 0.55 0.55 c 869 1721 m -2 -4 d -22 -63 d 2 8 d f 0.575 0.575 0.575 c
- 871 1725 m -2 -4 d -22 -59 d 2 9 d f 0.6 0.6 0.6 c 873 1728 m -2 -3 d -22 -54 d
- 2 8 d f 0.625 0.625 0.625 c 875 1732 m -2 -4 d -22 -49 d 3 8 d f 0.65 0.65 0.65
- c 855 1692 m 10 20 d 12 24 d -2 -4 d -21 -45 d f 0.675 0.675 0.675 c 865 1712 m
- 13 26 d -1 -2 d f 0.425 0.425 0.425 c 836 1621 m -2 -8 d -23 115 d 1 -4 d f
- 0.45 0.45 0.45 c 839 1630 m -3 -9 d -24 103 d 1 -4 d f 0.475 0.475 0.475 c 841
- 1638 m -2 -8 d -26 90 d 1 -5 d f 0.5 0.5 0.5 c 843 1646 m -2 -8 d -27 77 d 1 -4
- d f 0.525 0.525 0.525 c 845 1654 m -2 -8 d -28 65 d 1 -4 d f 0.55 0.55 0.55 c
- 847 1662 m -2 -8 d -29 53 d 1 -5 d f 0.575 0.575 0.575 c 849 1671 m -2 -9 d -30
- 40 d 1 -4 d f 0.6 0.6 0.6 c 851 1679 m -2 -8 d -31 27 d 1 -4 d f 0.625 0.625
- 0.625 c 854 1687 m -3 -8 d -32 15 d 1 -4 d f 0.65 0.65 0.65 c 854 1690 m 1 2 d
- -1 -5 d -34 3 d 1 -5 d f 0.675 0.675 0.675 c 851 1685 m 3 5 d -33 -5 d 1 -4 d f
- 0.7 0.7 0.7 c 849 1680 m 2 5 d -29 -4 d 1 -4 d f 0.725 0.725 0.725 c 846 1675 m
- 3 5 d -26 -3 d 2 -4 d f 0.75 0.75 0.75 c 844 1671 m 2 4 d -21 -2 d 1 -5 d f
- 0.775 0.775 0.775 c 842 1666 m 2 5 d -18 -3 d 1 -4 d f 0.8 0.8 0.8 c 839 1661 m
- 3 5 d -15 -2 d 1 -4 d f 0.825 0.825 0.825 c 837 1657 m 2 4 d -11 -1 d 1 -5 d f
- 0.85 0.85 0.85 c 834 1652 m 3 5 d -8 -2 d 1 -4 d f 0.875 0.875 0.875 c 832 1647
- m 2 5 d -4 -1 d 1 -4 d f 0.9 0.9 0.9 c 831 1645 m 1 2 d -1 X f 0.425 0.425
- 0.425 c 812 1724 m -1 4 d -10 62 d f 0.45 0.45 0.45 c 813 1720 m -1 4 d -11 66
- d -9 63 d f 0.475 0.475 0.475 c 814 1715 m -1 5 d -21 133 d -5 30 d 2 -15 d f
- 0.5 0.5 0.5 c 815 1711 m -1 4 d -25 153 d 2 -31 d f 0.525 0.525 0.525 c 816
- 1707 m -1 4 d -24 126 d 3 -30 d f 0.55 0.55 0.55 c 817 1702 m -1 5 d -22 100 d
- 2 -30 d f 0.575 0.575 0.575 c 818 1698 m -1 4 d -21 75 d 3 -31 d f 0.6 0.6 0.6
- c 819 1694 m -1 4 d -19 48 d 2 -30 d f 0.625 0.625 0.625 c 820 1690 m -1 4 d
- -18 22 d 3 -31 d f 0.65 0.65 0.65 c 821 1685 m -1 5 d -16 -5 d 2 -30 d f 0.675
- 0.675 0.675 c 808 1639 m 1 1 d 13 41 d -1 4 d -15 -30 d f 0.7 0.7 0.7 c 809
- 1640 m 3 X 11 37 d -1 4 d f 0.725 0.725 0.725 c 812 1640 m 2 1 d 11 32 d -2 4 d
- f 0.75 0.75 0.75 c 814 1641 m 3 1 d 9 26 d -1 5 d f 0.775 0.775 0.775 c 817
- 1642 m 3 X 7 22 d -1 4 d f 0.8 0.8 0.8 c 820 1642 m 2 1 d 6 17 d -1 4 d f 0.825
- 0.825 0.825 c 822 1643 m 3 1 d 4 11 d -1 5 d f 0.85 0.85 0.85 c 825 1644 m 3 X
- 2 7 d -1 4 d f 0.875 0.875 0.875 c 828 1644 m 2 1 d 1 2 d -1 4 d f 0.9 0.9 0.9
- c 830 1645 m 1 X 2 Y f 0.425 0.425 0.425 c 773 1913 m -9 18 d 2 -26 d f 0.45
- 0.45 0.45 c 783 1893 m -10 20 d -7 -8 d 2 -28 d f 0.475 0.475 0.475 c 789 1868
- m -2 15 d -4 10 d -15 -16 d 2 -28 d f 0.5 0.5 0.5 c 791 1837 m -2 31 d -19 -19
- d 2 -29 d f 0.525 0.525 0.525 c 794 1807 m -3 30 d -19 -17 d 2 -28 d f 0.55
- 0.55 0.55 c 796 1777 m -2 30 d -20 -15 d 2 -28 d f 0.575 0.575 0.575 c 799 1746
- m -3 31 d -20 -13 d 2 -28 d f 0.6 0.6 0.6 c 801 1716 m -2 30 d -21 -10 d 2 -28
- d f 0.625 0.625 0.625 c 804 1685 m -3 31 d -21 -8 d 2 -28 d f 0.65 0.65 0.65 c
- 806 1655 m -2 30 d -22 -5 d 2 -28 d f 0.675 0.675 0.675 c 784 1647 m 24 -8 d -2
- 16 d -22 -3 d f 0.425 0.425 0.425 c 766 1905 m -2 26 d -24 -181 d 2 -4 d f 0.45
- 0.45 0.45 c 768 1877 m -2 28 d -24 -159 d 1 -4 d f 0.475 0.475 0.475 c 770 1849
- m -2 28 d -25 -135 d 1 -4 d f 0.5 0.5 0.5 c 772 1820 m -2 29 d -26 -111 d 1 -4
- d f 0.525 0.525 0.525 c 774 1792 m -2 28 d -27 -86 d 1 -4 d f 0.55 0.55 0.55 c
- 776 1764 m -2 28 d -28 -62 d 2 -4 d f 0.575 0.575 0.575 c 778 1736 m -2 28 d
- -28 -38 d 1 -4 d f 0.6 0.6 0.6 c 780 1708 m -2 28 d -29 -14 d 1 -4 d f 0.625
- 0.625 0.625 c 782 1680 m -2 28 d -30 10 d 1 -4 d f 0.65 0.65 0.65 c 784 1652 m
- -2 28 d -31 34 d 1 -4 d f 0.675 0.675 0.675 c 782 1651 m 2 -4 d 5 Y -32 58 d 1
- -4 d f 0.7 0.7 0.7 c 778 1656 m 4 -5 d -29 55 d 2 -4 d f 0.725 0.725 0.725 c
- 775 1661 m 3 -5 d -23 46 d 1 -4 d f 0.75 0.75 0.75 c 771 1666 m 4 -5 d -19 37 d
- 1 -4 d f 0.775 0.775 0.775 c 768 1670 m 3 -4 d -14 28 d 1 -4 d f 0.8 0.8 0.8 c
- 765 1675 m 3 -5 d -10 20 d 1 -4 d f 0.825 0.825 0.825 c 761 1680 m 4 -5 d -6 11
- d 2 -4 d f 0.85 0.85 0.85 c 761 1681 m -1 Y 2 Y f 0.425 0.425 0.425 c 737 1796
- m 2 -7 d 3 -43 d -2 4 d -23 -194 d f 0.45 0.45 0.45 c 739 1789 m 1 -6 d 3 -41 d
- -1 4 d f 0.475 0.475 0.475 c 740 1783 m 1 -7 d 3 -38 d -1 4 d f 0.5 0.5 0.5 c
- 741 1776 m 2 -7 d 2 -35 d -1 4 d f 0.525 0.525 0.525 c 743 1769 m 1 -6 d 2 -33
- d -1 4 d f 0.55 0.55 0.55 c 744 1763 m 1 -7 d 3 -30 d -2 4 d f 0.575 0.575
- 0.575 c 745 1756 m 2 -7 d 2 -27 d -1 4 d f 0.6 0.6 0.6 c 747 1749 m 1 -6 d 2
- -25 d -1 4 d f 0.625 0.625 0.625 c 748 1743 m 2 -7 d 1 -22 d -1 4 d f 0.65 0.65
- 0.65 c 750 1736 m 1 -7 d 1 -19 d -1 4 d f 0.675 0.675 0.675 c 751 1729 m 1 -6 d
- 1 -17 d -1 4 d f 0.7 0.7 0.7 c 752 1723 m 2 -7 d 1 -14 d -2 4 d f 0.725 0.725
- 0.725 c 754 1716 m 1 -7 d 1 -11 d -1 4 d f 0.75 0.75 0.75 c 755 1709 m 1 -7 d 1
- -8 d -1 4 d f 0.775 0.775 0.775 c 756 1702 m 2 -6 d -6 Y -1 4 d f 0.8 0.8 0.8 c
- 758 1696 m 1 -7 d -3 Y -1 4 d f 0.825 0.825 0.825 c 759 1689 m 1 -7 d 1 X -2 4
- d f 0.85 0.85 0.85 c 760 1682 m 1 -1 d 1 Y f 0.425 0.425 0.425 c 727 1702 m 10
- 94 d -20 -240 d -1 2 d f 0.45 0.45 0.45 c 717 1608 m 10 94 d -11 -144 d -17 25
- d f 0.475 0.475 0.475 c 714 1575 m 3 33 d -18 -25 d -6 8 d f 0.425 0.425 0.425
- c 690 1569 m 10 3 d -19 53 d f 0.45 0.45 0.45 c 700 1572 m 10 2 d -38 106 d 9
- -55 d f 0.475 0.475 0.475 c 710 1574 m 4 1 d -21 16 d -23 101 d 2 -12 d f 0.425
- 0.425 0.425 c 679 1681 m 11 -112 d -9 56 d -24 20 d -11 -39 d 10 94 d f 0.45
- 0.45 0.45 c 668 1794 m 11 -113 d 2 -56 d -9 55 d -4 4 d -11 -39 d -1 55 d 10 95
- d f 0.475 0.475 0.475 c 667 1805 m 1 -11 d 4 -114 d -2 12 d -2 -8 d -2 111 d f
- 0.425 0.425 0.425 c 643 1530 m 3 76 d -23 101 d f 643 1530 m 11 131 d 2 39 d
- -10 -94 d -23 101 d f 0.45 0.45 0.45 c 654 1661 m 12 131 d 3 Y -10 -95 d f
- 0.475 0.475 0.475 c 666 1792 m 1 13 d -1 -10 d f 0.425 0.425 0.425 c 639 1437 m
- 4 93 d -20 177 d -4 -119 d f 0.45 0.45 0.45 c 636 1344 m 3 93 d -20 151 d -4
- -120 d f 0.475 0.475 0.475 c 632 1250 m 4 94 d -21 124 d -4 -119 d f 0.5 0.5
- 0.5 c 628 1157 m 4 93 d -21 99 d -3 -120 d f 0.525 0.525 0.525 c 624 1063 m 4
- 94 d -20 72 d -4 -119 d f 0.55 0.55 0.55 c 620 970 m 4 93 d -20 47 d -4 -119 d
- f 0.575 0.575 0.575 c 620 960 m 10 Y -20 21 d -1 -15 d f 0.55 0.55 0.55 c 596
- 954 m 2 1 d -20 15 d -2 X f 0.575 0.575 0.575 c 598 955 m 22 5 d -21 16 d -21
- -6 d f 0.55 0.55 0.55 c 573 948 m 23 6 d -20 16 d -24 -6 d f 549 942 m 24 6 d
- -21 16 d -23 -6 d f 1650 1202 m 24 6 d -21 15 d -23 -6 d f 1627 1196 m 23 6 d
- -20 15 d -24 -6 d f 1603 1190 m 24 6 d -21 15 d -23 -6 d f 1602 1224 m 1 -34 d
- -20 15 d 8 Y f 0.575 0.575 0.575 c 1592 1435 m 10 -211 d -19 -11 d -3 73 d f
- 0.6 0.6 0.6 c 1583 1646 m 9 -211 d -12 -149 d -2 72 d f 0.625 0.625 0.625 c
- 1580 1721 m 3 -75 d -5 -288 d -3 73 d 3 307 d f 0.65 0.65 0.65 c 1575 1431 m -2
- 73 d 2 260 d 3 -26 d f 0.675 0.675 0.675 c 1573 1504 m -2 72 d 1 214 d 3 -26 d
- f 0.7 0.7 0.7 c 1571 1576 m -3 73 d 1 168 d 3 -27 d f 0.725 0.725 0.725 c 1568
- 1649 m -2 73 d 1 121 d 2 -26 d f 0.75 0.75 0.75 c 1566 1722 m -3 73 d 1 74 d 3
- -26 d f 0.775 0.775 0.775 c 1563 1795 m -2 72 d 28 Y 3 -26 d f 0.8 0.8 0.8 c
- 1561 1867 m -2 44 d 2 -16 d f 0.5 0.5 0.5 c 1537 1881 m -1 -3 d 2 -25 d f 0.525
- 0.525 0.525 c 1539 1883 m -2 -2 d 1 -28 d 2 -31 d f 0.55 0.55 0.55 c 1541 1886
- m -2 -3 d 1 -61 d 2 -31 d f 0.575 0.575 0.575 c 1543 1889 m -2 -3 d 1 -95 d 2
- -30 d f 0.6 0.6 0.6 c 1545 1891 m -2 -2 d 1 -128 d 2 -31 d f 0.625 0.625 0.625
- c 1577 1701 m 3 20 d -2 17 d -31 156 d -2 -3 d 1 -161 d 2 -30 d f 0.65 0.65
- 0.65 c 1572 1670 m 5 31 d 1 37 d -3 26 d -26 133 d -2 -3 d 1 -194 d 2 -31 d f
- 0.675 0.675 0.675 c 1567 1639 m 5 31 d 3 94 d -3 26 d -21 109 d -2 -2 d 1 -228
- d 2 -31 d f 0.7 0.7 0.7 c 1562 1608 m 5 31 d 5 151 d -3 27 d -16 85 d -2 -3 d 1
- -261 d 2 -30 d f 0.725 0.725 0.725 c 1558 1577 m 4 31 d 7 209 d -2 26 d -13 61
- d -1 -2 d 1 -294 d 2 -31 d f 0.75 0.75 0.75 c 1556 1567 m 2 10 d 9 266 d -3 26
- d -8 38 d -2 -3 d 2 -327 d f 0.775 0.775 0.775 c 1564 1869 m -3 26 d -3 15 d -2
- -3 d f 0.8 0.8 0.8 c 1561 1895 m -2 16 d -1 -1 d f 0.425 0.425 0.425 c 1533
- 1897 m 2 -24 d -15 11 d -8 2 d f 0.45 0.45 0.45 c 1535 1873 m 1 -25 d -9 33 d
- -7 3 d f 0.475 0.475 0.475 c 1536 1848 m 2 -25 d -3 56 d -8 2 d f 0.5 0.5 0.5 c
- 1538 1823 m 2 -25 d -2 55 d -2 25 d -1 1 d f 0.525 0.525 0.525 c 1540 1798 m 2
- -25 d -2 49 d -2 31 d f 0.55 0.55 0.55 c 1542 1773 m 1 -24 d -1 42 d -2 31 d f
- 0.575 0.575 0.575 c 1543 1749 m 2 -25 d -1 37 d -2 30 d f 0.6 0.6 0.6 c 1545
- 1724 m 2 -25 d -1 31 d -2 31 d f 0.625 0.625 0.625 c 1547 1699 m 2 -25 d -1 26
- d -2 30 d f 0.65 0.65 0.65 c 1549 1674 m 1 -24 d 19 Y -2 31 d f 0.675 0.675
- 0.675 c 1550 1650 m 2 -25 d 13 Y -2 31 d f 0.7 0.7 0.7 c 1552 1625 m 2 -25 d 8
- Y -2 30 d f 0.725 0.725 0.725 c 1554 1600 m 2 -25 d 2 Y -2 31 d f 0.75 0.75
- 0.75 c 1556 1575 m -8 Y 10 Y f 0.425 0.425 0.425 c 1533 1897 m -21 -11 d -23
- -181 d f 1509 1999 m 24 -102 d -21 -11 d -23 -181 d f 1505 1951 m 4 48 d -20
- -294 d -13 43 d f 0.45 0.45 0.45 c 1486 1724 m 19 227 d -29 -203 d -11 32 d f
- 0.425 0.425 0.425 c 1450 1897 m -8 65 d 1 3 d f 0.45 0.45 0.45 c 1485 1730 m 1
- -6 d -21 56 d -15 117 d -7 68 d 1 7 d f 0.475 0.475 0.475 c 1483 1758 m 2 -28 d
- -41 242 d 2 7 d f 0.5 0.5 0.5 c 1481 1785 m 2 -27 d -37 221 d 1 7 d f 0.525
- 0.525 0.525 c 1479 1812 m 2 -27 d -34 201 d 2 7 d f 0.55 0.55 0.55 c 1478 1840
- m 1 -28 d -30 181 d 1 7 d f 0.575 0.575 0.575 c 1476 1867 m 2 -27 d -28 160 d 2
- 7 d f 0.6 0.6 0.6 c 1474 1895 m 2 -28 d -24 140 d 1 7 d f 0.625 0.625 0.625 c
- 1472 1922 m 2 -27 d -21 119 d 2 7 d f 0.65 0.65 0.65 c 1470 1950 m 2 -28 d -17
- 99 d 1 7 d f 0.675 0.675 0.675 c 1468 1977 m 2 -27 d -14 78 d 2 7 d f 0.7 0.7
- 0.7 c 1466 2004 m 2 -27 d -10 58 d 1 6 d f 0.725 0.725 0.725 c 1464 2032 m 2
- -28 d -7 37 d 2 7 d f 0.75 0.75 0.75 c 1462 2054 m 2 -22 d -3 16 d f 0.425
- 0.425 0.425 c 1443 1965 m -1 -3 d -24 -154 d f 0.45 0.45 0.45 c 1444 1972 m -1
- -7 d -25 -157 d 2 -3 d f 0.475 0.475 0.475 c 1446 1979 m -2 -7 d -24 -167 d 1
- -3 d f 0.5 0.5 0.5 c 1447 1986 m -1 -7 d -25 -177 d 2 -3 d f 0.525 0.525 0.525
- c 1449 1993 m -2 -7 d -24 -187 d 1 -2 d f 0.55 0.55 0.55 c 1450 2000 m -1 -7 d
- -25 -196 d 1 -3 d f 0.575 0.575 0.575 c 1452 2007 m -2 -7 d -25 -206 d 2 -3 d f
- 0.6 0.6 0.6 c 1453 2014 m -1 -7 d -25 -216 d 1 -3 d f 0.625 0.625 0.625 c 1455
- 2021 m -2 -7 d -25 -226 d 2 -3 d f 0.65 0.65 0.65 c 1456 2028 m -1 -7 d -25
- -236 d 1 -3 d f 0.675 0.675 0.675 c 1458 2035 m -2 -7 d -25 -246 d 1 -3 d f 0.7
- 0.7 0.7 c 1459 2041 m -1 -6 d -26 -256 d 2 -3 d f 0.725 0.725 0.725 c 1461 2048
- m -2 -7 d -25 -265 d 1 -3 d f 0.75 0.75 0.75 c 1460 2021 m 2 33 d -1 -6 d -26
- -275 d 2 -3 d f 0.775 0.775 0.775 c 1446 1853 m 14 168 d -23 -251 d 1 -3 d f
- 0.8 0.8 0.8 c 1439 1766 m 7 87 d -8 -86 d f 0.425 0.425 0.425 c 1415 1867 m 2
- -6 d 1 -53 d -23 48 d f 0.45 0.45 0.45 c 1417 1861 m 1 -7 d 2 -49 d -2 3 d f
- 0.475 0.475 0.475 c 1418 1854 m 2 -6 d 1 -46 d -1 3 d f 0.5 0.5 0.5 c 1420 1848
- m 1 -7 d 2 -42 d -2 3 d f 0.525 0.525 0.525 c 1421 1841 m 2 -6 d 1 -38 d -1 2 d
- f 0.55 0.55 0.55 c 1423 1835 m 1 -7 d 1 -34 d -1 3 d f 0.575 0.575 0.575 c 1424
- 1828 m 2 -6 d 1 -31 d -2 3 d f 0.6 0.6 0.6 c 1426 1822 m 1 -7 d 1 -27 d -1 3 d
- f 0.625 0.625 0.625 c 1427 1815 m 2 -6 d 1 -24 d -2 3 d f 0.65 0.65 0.65 c 1429
- 1809 m 1 -7 d 1 -20 d -1 3 d f 0.675 0.675 0.675 c 1430 1802 m 2 -7 d -16 Y -1
- 3 d f 0.7 0.7 0.7 c 1432 1795 m 1 -6 d 1 -13 d -2 3 d f 0.725 0.725 0.725 c
- 1433 1789 m 2 -7 d -9 Y -1 3 d f 0.75 0.75 0.75 c 1435 1782 m 1 -6 d 1 -6 d -2
- 3 d f 0.775 0.775 0.775 c 1436 1776 m 2 -7 d -2 Y -1 3 d f 0.8 0.8 0.8 c 1438
- 1769 m 1 -3 d -1 1 d f 0.425 0.425 0.425 c 1392 1861 m 23 6 d -20 -11 d -24 -60
- d f 1392 1861 m 23 6 d -20 -11 d -24 -60 d f 1368 2124 m 24 -263 d -21 -65 d -4
- -5 d -1 295 d f 0.45 0.45 0.45 c 1367 1791 m -4 -6 d -1 232 d 4 69 d f 0.475
- 0.475 0.475 c 1363 1785 m -4 -6 d -1 170 d 4 68 d f 0.5 0.5 0.5 c 1359 1779 m
- -4 -6 d 107 Y 3 69 d f 0.525 0.525 0.525 c 1355 1773 m -4 -6 d 44 Y 4 69 d f
- 0.55 0.55 0.55 c 1351 1767 m -3 -4 d 3 48 d f 0.425 0.425 0.425 c 1361 2042 m 7
- 82 d -2 -38 d -37 -294 d -5 6 d 10 29 d f 0.45 0.45 0.45 c 1347 1893 m 14 149 d
- 5 44 d -4 -69 d -29 -231 d -4 6 d 5 35 d 9 30 d f 0.475 0.475 0.475 c 1345 1863
- m 2 30 d 15 124 d -4 -68 d -21 -169 d -4 6 d 10 71 d f 0.5 0.5 0.5 c 1358 1949
- m -3 -69 d -14 -106 d -4 6 d f 0.525 0.525 0.525 c 1355 1880 m -4 -69 d -6 -43
- d -4 6 d f 0.55 0.55 0.55 c 1351 1811 m -3 -48 d -3 5 d f 0.425 0.425 0.425 c
- 1334 1827 m -10 -29 d -23 88 d 1 X f 0.45 0.45 0.45 c 1343 1857 m -9 -30 d -32
- 59 d 1 X f 0.475 0.475 0.475 c 1344 1864 m 1 -1 d -2 -6 d -40 29 d 1 X f 0.5
- 0.5 0.5 c 1342 1865 m 2 -1 d -40 22 d 1 -1 d f 0.525 0.525 0.525 c 1341 1866 m
- 1 -1 d -37 20 d 1 X f 0.55 0.55 0.55 c 1340 1868 m 1 -2 d -35 19 d 1 X f 0.575
- 0.575 0.575 c 1338 1869 m 2 -1 d -33 17 d 1 X f 0.6 0.6 0.6 c 1337 1870 m 1 -1
- d -30 16 d 2 X f 0.625 0.625 0.625 c 1335 1871 m 2 -1 d -27 15 d 1 X f 0.65
- 0.65 0.65 c 1334 1873 m 1 -2 d -24 14 d 1 X f 0.675 0.675 0.675 c 1333 1874 m 1
- -1 d -22 12 d 1 X f 0.7 0.7 0.7 c 1331 1875 m 2 -1 d -20 11 d 1 X f 0.725 0.725
- 0.725 c 1330 1876 m 1 -1 d -17 10 d 1 -1 d f 0.75 0.75 0.75 c 1328 1878 m 2 -2
- d -15 8 d 1 X f 0.775 0.775 0.775 c 1327 1879 m 1 -1 d -12 6 d 1 X f 0.8 0.8
- 0.8 c 1326 1880 m 1 -1 d -10 5 d 1 X f 0.825 0.825 0.825 c 1324 1881 m 2 -1 d
- -8 4 d 1 X f 0.85 0.85 0.85 c 1323 1882 m 1 -1 d -5 3 d 1 X f 0.875 0.875 0.875
- c 1321 1884 m 2 -2 d -3 2 d 1 X f 0.9 0.9 0.9 c 1321 1884 m f 0.425 0.425 0.425
- c 1298 1918 m 1 -1 d 3 -31 d -1 X -23 -87 d f 0.45 0.45 0.45 c 1299 1917 m 1 -2
- d 3 -29 d -1 X f 0.475 0.475 0.475 c 1300 1915 m 1 -2 d 3 -27 d -1 X f 0.5 0.5
- 0.5 c 1301 1913 m 2 -2 d 2 -26 d -1 1 d f 0.525 0.525 0.525 c 1303 1911 m 1 -2
- d 2 -24 d -1 X f 0.55 0.55 0.55 c 1304 1909 m 1 -1 d 2 -23 d -1 X f 0.575 0.575
- 0.575 c 1305 1908 m 1 -2 d 2 -21 d -1 X f 0.6 0.6 0.6 c 1306 1906 m 2 -2 d 2
- -19 d -2 X f 0.625 0.625 0.625 c 1308 1904 m 1 -2 d 2 -17 d -1 X f 0.65 0.65
- 0.65 c 1309 1902 m 1 -2 d 2 -15 d -1 X f 0.675 0.675 0.675 c 1310 1900 m 1 -2 d
- 2 -13 d -1 X f 0.7 0.7 0.7 c 1311 1898 m 2 -1 d 1 -12 d -1 X f 0.725 0.725
- 0.725 c 1313 1897 m 1 -2 d 1 -11 d -1 1 d f 0.75 0.75 0.75 c 1314 1895 m 1 -2 d
- 1 -9 d -1 X f 0.775 0.775 0.775 c 1315 1893 m 1 -2 d 1 -7 d -1 X f 0.8 0.8 0.8
- c 1316 1891 m 2 -2 d -5 Y -1 X f 0.825 0.825 0.825 c 1318 1889 m 1 -1 d -4 Y -1
- X f 0.85 0.85 0.85 c 1319 1888 m 1 -2 d -2 Y -1 X f 0.875 0.875 0.875 c 1320
- 1886 m 1 -2 d -1 X f 0.9 0.9 0.9 c 1321 1884 m f 0.425 0.425 0.425 c 1285 1755
- m 13 163 d -20 -119 d -3 X f 0.45 0.45 0.45 c 1274 1630 m 11 125 d -10 44 d -3
- -1 d 1 -155 d f 0.475 0.475 0.475 c 1272 1798 m -4 -1 d 1 -123 d 4 -31 d f 0.5
- 0.5 0.5 c 1268 1797 m -4 -1 d 1 -91 d 4 -31 d f 0.525 0.525 0.525 c 1264 1796 m
- -3 -1 d -59 Y 4 -31 d f 0.55 0.55 0.55 c 1261 1795 m -4 -1 d -27 Y 4 -31 d f
- 0.575 0.575 0.575 c 1257 1794 m -3 -1 d 3 -26 d f 0.425 0.425 0.425 c 1251 1973
- m 15 -217 d -34 -70 d -1 -6 d f 0.45 0.45 0.45 c 1266 1756 m 8 -126 d -1 13 d
- -37 61 d -4 -18 d f 0.475 0.475 0.475 c 1273 1643 m -4 31 d -30 49 d -3 -19 d f
- 0.5 0.5 0.5 c 1269 1674 m -4 31 d -22 36 d -4 -18 d f 0.525 0.525 0.525 c 1265
- 1705 m -4 31 d -14 23 d -4 -18 d f 0.55 0.55 0.55 c 1261 1736 m -4 31 d -6 10 d
- -4 -18 d f 0.575 0.575 0.575 c 1257 1767 m -3 26 d -3 -16 d f 0.425 0.425 0.425
- c 1227 1967 m 24 6 d -20 -293 d -24 74 d f 1210 1781 m 17 186 d -20 -213 d -23
- 75 d 15 -82 d f 0.45 0.45 0.45 c 1204 1720 m 6 61 d -11 -34 d f 0.425 0.425
- 0.425 c 1199 1747 m -15 82 d -24 -33 d 1 1 d f 0.45 0.45 0.45 c 1203 1723 m 1
- -3 d -5 27 d -38 50 d 1 1 d f 0.475 0.475 0.475 c 1201 1729 m 2 -6 d -41 75 d 2
- X f 0.5 0.5 0.5 c 1200 1734 m 1 -5 d -37 69 d 1 1 d f 0.525 0.525 0.525 c 1198
- 1740 m 2 -6 d -35 65 d 1 1 d f 0.55 0.55 0.55 c 1197 1746 m 1 -6 d -32 60 d 1 X
- f 0.575 0.575 0.575 c 1195 1751 m 2 -5 d -30 54 d 1 1 d f 0.6 0.6 0.6 c 1194
- 1757 m 1 -6 d -27 50 d 2 1 d f 0.625 0.625 0.625 c 1192 1762 m 2 -5 d -24 45 d
- 1 X f 0.65 0.65 0.65 c 1191 1768 m 1 -6 d -21 40 d 1 1 d f 0.675 0.675 0.675 c
- 1189 1774 m 2 -6 d -19 35 d 1 1 d f 0.7 0.7 0.7 c 1188 1779 m 1 -5 d -16 30 d 1
- X f 0.725 0.725 0.725 c 1186 1785 m 2 -6 d -14 25 d 2 1 d f 0.75 0.75 0.75 c
- 1185 1790 m 1 -5 d -10 20 d 1 1 d f 0.775 0.775 0.775 c 1183 1796 m 2 -6 d -8
- 16 d 1 X f 0.8 0.8 0.8 c 1182 1802 m 1 -6 d -5 10 d 1 1 d f 0.825 0.825 0.825 c
- 1180 1807 m 2 -5 d -3 5 d 1 1 d f 0.85 0.85 0.85 c 1180 1808 m -1 Y 1 Y f 0.425
- 0.425 0.425 c 1157 1694 m 1 Y 4 102 d -1 -1 d -2 7 d -1 -107 d f 0.45 0.45 0.45
- c 1157 1695 m 2 7 d 3 96 d -1 -1 d -3 6 d -2 7 d -1 -97 d 2 -17 d f 0.475 0.475
- 0.475 c 1159 1702 m 1 7 d 4 89 d -2 X -6 12 d -2 6 d -1 -85 d 2 -18 d f 0.5 0.5
- 0.5 c 1160 1709 m 1 7 d 4 83 d -1 -1 d -10 18 d -2 7 d -1 -75 d 2 -17 d f 0.525
- 0.525 0.525 c 1161 1716 m 2 7 d 3 77 d -1 -1 d -13 24 d -3 7 d -65 Y 2 -17 d f
- 0.55 0.55 0.55 c 1163 1723 m 1 7 d 3 70 d -1 X -17 30 d -2 7 d -54 Y 2 -18 d f
- 0.575 0.575 0.575 c 1164 1730 m 2 7 d 2 64 d -1 -1 d -20 37 d -2 6 d -43 Y 2
- -17 d f 0.6 0.6 0.6 c 1166 1737 m 1 7 d 3 58 d -2 -1 d -23 42 d -2 7 d -32 Y 2
- -18 d f 0.625 0.625 0.625 c 1167 1744 m 2 7 d 2 51 d -1 X -27 48 d -2 7 d -22 Y
- 2 -17 d f 0.65 0.65 0.65 c 1169 1751 m 1 7 d 2 45 d -1 -1 d -30 55 d -2 7 d -12
- Y 2 -17 d f 0.675 0.675 0.675 c 1170 1758 m 2 7 d 1 39 d -1 -1 d -33 61 d -2 6
- d 2 -18 d f 0.7 0.7 0.7 c 1172 1765 m 1 7 d 1 32 d -1 X -36 66 d 1 Y -1 Y f
- 0.725 0.725 0.725 c 1173 1772 m 1 7 d 2 26 d -2 -1 d f 0.75 0.75 0.75 c 1174
- 1779 m 2 7 d 1 20 d -1 -1 d f 0.775 0.775 0.775 c 1176 1786 m 1 7 d 1 13 d -1 X
- f 0.8 0.8 0.8 c 1177 1793 m 2 7 d 7 Y -1 -1 d f 0.825 0.825 0.825 c 1179 1800 m
- 1 7 d 1 Y -1 -1 d f 0.85 0.85 0.85 c 1180 1807 m 1 Y f 0.425 0.425 0.425 c 1157
- 1694 m 2 Y f 0.45 0.45 0.45 c 1155 1689 m 2 5 d 2 Y -2 17 d -40 128 d -2 -3 d 1
- -10 d f 0.475 0.475 0.475 c 1154 1685 m 1 4 d 24 Y -2 18 d -36 113 d -2 -3 d -1
- -13 d 1 -13 d f 0.5 0.5 0.5 c 1153 1681 m 1 4 d -1 46 d -2 17 d -31 99 d -3 -3
- d -2 -29 d 1 -13 d f 0.525 0.525 0.525 c 1151 1677 m 2 4 d -2 67 d -2 17 d -27
- 86 d -2 -4 d -4 -45 d 2 -13 d f 0.55 0.55 0.55 c 1150 1672 m 1 5 d -2 88 d -2
- 18 d -22 71 d -3 -3 d -4 -62 d 1 -13 d f 0.575 0.575 0.575 c 1149 1668 m 1 4 d
- -3 111 d -2 17 d -18 57 d -2 -3 d -6 -78 d 1 -13 d f 0.6 0.6 0.6 c 1147 1664 m
- 2 4 d -4 132 d -2 18 d -14 43 d -2 -4 d -7 -94 d 1 -13 d f 0.625 0.625 0.625 c
- 1146 1659 m 1 5 d -4 154 d -2 17 d -9 29 d -3 -3 d -8 -111 d 2 -13 d f 0.65
- 0.65 0.65 c 1144 1655 m 2 4 d -5 176 d -2 17 d -5 15 d -2 -3 d -9 -127 d 1 -13
- d f 0.675 0.675 0.675 c 1143 1651 m 1 4 d -5 197 d -2 18 d -1 1 d -2 -4 d -10
- -143 d 1 -13 d f 0.7 0.7 0.7 c 1142 1647 m 1 4 d -6 219 d 1 Y -1 X -11 -160 d 1
- -13 d f 0.725 0.725 0.725 c 1140 1642 m 2 5 d -16 51 d 1 -13 d f 0.75 0.75 0.75
- c 1139 1638 m 1 4 d -13 43 d 2 -13 d f 0.775 0.775 0.775 c 1138 1634 m 1 4 d
- -10 34 d 1 -13 d f 0.8 0.8 0.8 c 1136 1629 m 2 5 d -8 25 d 1 -12 d f 0.825
- 0.825 0.825 c 1135 1625 m 1 4 d -5 18 d 1 -13 d f 0.85 0.85 0.85 c 1133 1621 m
- 2 4 d -3 9 d f 0.45 0.45 0.45 c 1114 1828 m -1 10 d -6 -35 d f 0.475 0.475
- 0.475 c 1115 1815 m -1 13 d -7 -25 d -8 -44 d f 0.5 0.5 0.5 c 1116 1802 m -1 13
- d -16 -56 d -9 -43 d f 0.525 0.525 0.525 c 1118 1789 m -2 13 d -26 -86 d -5 Y 1
- 5 d f 0.55 0.55 0.55 c 1119 1776 m -1 13 d -27 -73 d 1 5 d f 0.575 0.575 0.575
- c 1120 1763 m -1 13 d -27 -55 d 2 5 d f 0.6 0.6 0.6 c 1121 1750 m -1 13 d -26
- -37 d 1 5 d f 0.625 0.625 0.625 c 1123 1737 m -2 13 d -26 -19 d 1 6 d f 0.65
- 0.65 0.65 c 1124 1724 m -1 13 d -27 X 2 5 d f 0.675 0.675 0.675 c 1125 1711 m
- -1 13 d -26 18 d 1 5 d f 0.7 0.7 0.7 c 1126 1698 m -1 13 d -26 36 d 1 5 d f
- 0.725 0.725 0.725 c 1127 1685 m -1 13 d -26 54 d 2 5 d f 0.75 0.75 0.75 c 1129
- 1672 m -2 13 d -25 72 d 1 6 d f 0.775 0.775 0.775 c 1130 1659 m -1 13 d -26 91
- d 1 5 d f 0.8 0.8 0.8 c 1131 1647 m -1 12 d -26 109 d 2 5 d f 0.825 0.825 0.825
- c 1132 1634 m -1 13 d -25 126 d 1 5 d f 0.85 0.85 0.85 c 1133 1625 m -4 Y -1 13
- d -25 144 d 1 5 d f 0.875 0.875 0.875 c 1114 1763 m 19 -138 d -25 158 d 2 6 d f
- 0.9 0.9 0.9 c 1110 1790 m 4 -27 d -4 26 d f 0.425 0.425 0.425 c 1086 1676 m 2 6
- d -19 -39 d f 0.45 0.45 0.45 c 1088 1682 m 1 6 d -16 -29 d -7 -21 d 3 5 d f
- 0.475 0.475 0.475 c 1089 1688 m 1 6 d -9 -10 d -8 -25 d f 0.5 0.5 0.5 c 1090
- 1694 m 1 6 d -2 9 d -8 -25 d f 0.525 0.525 0.525 c 1091 1700 m 2 6 d -2 10 d -1
- -5 d -1 -2 d f 0.55 0.55 0.55 c 1093 1706 m 1 6 d -2 9 d -1 -5 d f 0.575 0.575
- 0.575 c 1094 1712 m 1 6 d -1 8 d -2 -5 d f 0.6 0.6 0.6 c 1095 1718 m 1 5 d -1 8
- d -1 -5 d f 0.625 0.625 0.625 c 1096 1723 m 1 6 d -1 8 d -1 -6 d f 0.65 0.65
- 0.65 c 1097 1729 m 2 6 d -1 7 d -2 -5 d f 0.675 0.675 0.675 c 1099 1735 m 1 6 d
- -1 6 d -1 -5 d f 0.7 0.7 0.7 c 1100 1741 m 1 6 d -1 5 d -1 -5 d f 0.725 0.725
- 0.725 c 1101 1747 m 1 6 d 4 Y -2 -5 d f 0.75 0.75 0.75 c 1102 1753 m 2 6 d -1 4
- d -1 -6 d f 0.775 0.775 0.775 c 1104 1759 m 1 6 d -1 3 d -1 -5 d f 0.8 0.8 0.8
- c 1105 1765 m 1 6 d 2 Y -2 -5 d f 0.825 0.825 0.825 c 1106 1771 m 1 6 d 1 Y -1
- -5 d f 0.85 0.85 0.85 c 1107 1777 m 1 6 d -1 -5 d f 0.875 0.875 0.875 c 1108
- 1783 m 2 6 d -2 -6 d f 0.9 0.9 0.9 c 1110 1789 m 1 Y -1 Y f 0.425 0.425 0.425 c
- 1063 1751 m 23 -75 d -43 -4 d f 1063 1751 m 23 -75 d -17 -33 d -6 -1 d -20 30 d
- f 0.45 0.45 0.45 c 1069 1643 m -3 -5 d -3 4 d f 0.425 0.425 0.425 c 1063 1751 m
- -20 -79 d -24 88 d f 1054 1759 m 9 -8 d -20 -79 d -24 88 d 8 5 d f 0.45 0.45
- 0.45 c 1045 1767 m 9 -8 d -27 6 d 8 4 d f 0.475 0.475 0.475 c 1039 1772 m 6 -5
- d -10 2 d f 0.425 0.425 0.425 c 1027 1765 m -8 -5 d -23 48 d f 0.45 0.45 0.45 c
- 1035 1769 m -8 -4 d -31 43 d 2 -2 d f 0.475 0.475 0.475 c 1039 1772 m -4 -3 d
- -37 37 d 1 -1 d f 0.5 0.5 0.5 c 1036 1774 m 3 -2 d -40 33 d 2 -1 d f 0.525
- 0.525 0.525 c 1034 1776 m 2 -2 d -35 30 d 2 -1 d f 0.55 0.55 0.55 c 1032 1778 m
- 2 -2 d -31 27 d 1 -1 d f 0.575 0.575 0.575 c 1030 1780 m 2 -2 d -28 24 d 2 -2 d
- f 0.6 0.6 0.6 c 1028 1782 m 2 -2 d -24 20 d 1 -1 d f 0.625 0.625 0.625 c 1026
- 1784 m 2 -2 d -21 17 d 2 -1 d f 0.65 0.65 0.65 c 1023 1786 m 3 -2 d -17 14 d 1
- -1 d f 0.675 0.675 0.675 c 1021 1788 m 2 -2 d -13 11 d 2 -1 d f 0.7 0.7 0.7 c
- 1019 1790 m 2 -2 d -9 8 d 2 -2 d f 0.725 0.725 0.725 c 1017 1792 m 2 -2 d -5 4
- d 1 -1 d f 0.75 0.75 0.75 c 1016 1793 m 1 -1 d -2 1 d f 0.425 0.425 0.425 c 996
- 1808 m -24 -86 d 1 3 d f 0.45 0.45 0.45 c 998 1806 m -2 2 d -23 -83 d 1 4 d f
- 0.475 0.475 0.475 c 999 1805 m -1 1 d -24 -77 d 2 3 d f 0.5 0.5 0.5 c 1001 1804
- m -2 1 d -23 -73 d 1 4 d f 0.525 0.525 0.525 c 1003 1803 m -2 1 d -24 -68 d 1 4
- d f 0.55 0.55 0.55 c 1004 1802 m -1 1 d -25 -63 d 1 3 d f 0.575 0.575 0.575 c
- 1006 1800 m -2 2 d -25 -59 d 1 4 d f 0.6 0.6 0.6 c 1007 1799 m -1 1 d -26 -53 d
- 1 3 d f 0.625 0.625 0.625 c 1009 1798 m -2 1 d -26 -49 d 1 4 d f 0.65 0.65 0.65
- c 1010 1797 m -1 1 d -27 -44 d 1 4 d f 0.675 0.675 0.675 c 1012 1796 m -2 1 d
- -27 -39 d 2 3 d f 0.7 0.7 0.7 c 1014 1794 m -2 2 d -27 -35 d 1 4 d f 0.725
- 0.725 0.725 c 1015 1793 m -1 1 d -28 -29 d 1 4 d f 0.75 0.75 0.75 c 1013 1792 m
- 3 1 d -1 X -28 -24 d 1 3 d f 0.775 0.775 0.775 c 1008 1791 m 5 1 d -25 -20 d 1
- 4 d f 0.8 0.8 0.8 c 1003 1789 m 5 2 d -19 -15 d 1 3 d f 0.825 0.825 0.825 c 998
- 1788 m 5 1 d -13 -10 d 1 4 d f 0.85 0.85 0.85 c 992 1787 m 6 1 d -7 -5 d f
- 0.425 0.425 0.425 c 973 1725 m -1 -3 d -23 88 d 1 -4 d f 0.45 0.45 0.45 c 974
- 1729 m -1 -4 d -23 81 d 1 -5 d f 0.475 0.475 0.475 c 976 1732 m -2 -3 d -23 72
- d 1 -4 d f 0.5 0.5 0.5 c 977 1736 m -1 -4 d -24 65 d 1 -4 d f 0.525 0.525 0.525
- c 978 1740 m -1 -4 d -24 57 d 2 -4 d f 0.55 0.55 0.55 c 979 1743 m -1 -3 d -23
- 49 d 1 -4 d f 0.575 0.575 0.575 c 980 1747 m -1 -4 d -23 42 d 1 -4 d f 0.6 0.6
- 0.6 c 981 1750 m -1 -3 d -23 34 d 1 -4 d f 0.625 0.625 0.625 c 982 1754 m -1 -4
- d -23 27 d 1 -4 d f 0.65 0.65 0.65 c 983 1758 m -1 -4 d -23 19 d 2 -4 d f 0.675
- 0.675 0.675 c 985 1761 m -2 -3 d -22 11 d 1 -4 d f 0.7 0.7 0.7 c 986 1765 m -1
- -4 d -23 4 d 1 -4 d f 0.725 0.725 0.725 c 987 1769 m -1 -4 d -23 -4 d 1 -4 d f
- 0.75 0.75 0.75 c 988 1772 m -1 -3 d -23 -12 d 1 -5 d f 0.775 0.775 0.775 c 989
- 1776 m -1 -4 d -23 -20 d 2 -4 d f 0.8 0.8 0.8 c 990 1779 m -1 -3 d -22 -28 d 1
- -4 d f 0.825 0.825 0.825 c 969 1740 m 1 2 d 21 41 d -1 -4 d -22 -35 d f 0.85
- 0.85 0.85 c 970 1742 m 22 45 d -1 -4 d f 0.425 0.425 0.425 c 950 1806 m -1 4 d
- -24 -302 d 1 12 d f 0.45 0.45 0.45 c 951 1801 m -1 5 d -24 -286 d 1 13 d f
- 0.475 0.475 0.475 c 952 1797 m -1 4 d -24 -268 d 1 14 d f 0.5 0.5 0.5 c 953
- 1793 m -1 4 d -24 -250 d 2 13 d f 0.525 0.525 0.525 c 955 1789 m -2 4 d -23
- -233 d 1 14 d f 0.55 0.55 0.55 c 956 1785 m -1 4 d -24 -215 d 1 13 d f 0.575
- 0.575 0.575 c 957 1781 m -1 4 d -24 -198 d 1 14 d f 0.6 0.6 0.6 c 958 1777 m -1
- 4 d -24 -180 d 1 14 d f 0.625 0.625 0.625 c 959 1773 m -1 4 d -24 -162 d 1 13 d
- f 0.65 0.65 0.65 c 961 1769 m -2 4 d -24 -145 d 2 14 d f 0.675 0.675 0.675 c
- 962 1765 m -1 4 d -24 -127 d 1 13 d f 0.7 0.7 0.7 c 963 1761 m -1 4 d -24 -110
- d 1 14 d f 0.725 0.725 0.725 c 964 1757 m -1 4 d -24 -92 d 1 14 d f 0.75 0.75
- 0.75 c 965 1752 m -1 5 d -24 -74 d 1 13 d f 0.775 0.775 0.775 c 967 1748 m -2 4
- d -24 -56 d 1 14 d f 0.8 0.8 0.8 c 968 1744 m -1 4 d -25 -38 d 1 13 d f 0.825
- 0.825 0.825 c 968 1741 m 1 -1 d -1 4 d -25 -21 d 2 14 d f 0.85 0.85 0.85 c 946
- 1748 m 22 -7 d -23 -4 d f 0.425 0.425 0.425 c 926 1520 m -1 -12 d -23 102 d 6
- 34 d f 0.45 0.45 0.45 c 927 1533 m -1 -13 d -18 124 d 7 34 d f 0.475 0.475
- 0.475 c 928 1547 m -1 -14 d -12 145 d 7 35 d f 0.5 0.5 0.5 c 922 1715 m 2 2 d 6
- -157 d -2 -13 d -6 166 d f 0.525 0.525 0.525 c 924 1717 m 1 2 d 6 -145 d -1 -14
- d f 0.55 0.55 0.55 c 925 1719 m 2 2 d 5 -134 d -1 -13 d f 0.575 0.575 0.575 c
- 927 1721 m 1 3 d 5 -123 d -1 -14 d f 0.6 0.6 0.6 c 928 1724 m 2 2 d 4 -111 d -1
- -14 d f 0.625 0.625 0.625 c 930 1726 m 1 2 d 4 -100 d -1 -13 d f 0.65 0.65 0.65
- c 931 1728 m 2 2 d 4 -88 d -2 -14 d f 0.675 0.675 0.675 c 933 1730 m 2 3 d 3
- -78 d -1 -13 d f 0.7 0.7 0.7 c 935 1733 m 1 2 d 3 -66 d -1 -14 d f 0.725 0.725
- 0.725 c 936 1735 m 2 2 d 2 -54 d -1 -14 d f 0.75 0.75 0.75 c 938 1737 m 1 2 d 2
- -43 d -1 -13 d f 0.775 0.775 0.775 c 939 1739 m 2 3 d 1 -32 d -1 -14 d f 0.8
- 0.8 0.8 c 941 1742 m 2 2 d -21 Y -1 -13 d f 0.825 0.825 0.825 c 943 1744 m 1 2
- d 1 -9 d -2 -14 d f 0.85 0.85 0.85 c 944 1746 m 2 2 d -1 -11 d f 0.425 0.425
- 0.425 c 908 1644 m -6 -34 d -3 12 d f 0.45 0.45 0.45 c 915 1678 m -7 -34 d -9
- -22 d -2 12 d f 0.475 0.475 0.475 c 922 1713 m -7 -35 d -18 -44 d -2 12 d f 0.5
- 0.5 0.5 c 921 1710 m 1 5 d -2 Y -27 -67 d -2 12 d f 0.525 0.525 0.525 c 919
- 1705 m 2 5 d -28 -52 d -2 12 d f 0.55 0.55 0.55 c 917 1700 m 2 5 d -28 -35 d -3
- 12 d f 0.575 0.575 0.575 c 916 1695 m 1 5 d -29 -18 d -2 13 d f 0.6 0.6 0.6 c
- 914 1690 m 2 5 d -30 X -2 12 d f 0.625 0.625 0.625 c 912 1685 m 2 5 d -30 17 d
- -2 12 d f 0.65 0.65 0.65 c 911 1680 m 1 5 d -30 34 d -3 12 d f 0.675 0.675
- 0.675 c 909 1675 m 2 5 d -32 51 d -1 7 d 1 -6 d f 0.7 0.7 0.7 c 908 1670 m 1 5
- d -30 57 d 3 -13 d f 0.725 0.725 0.725 c 906 1665 m 2 5 d -26 49 d 3 -14 d f
- 0.75 0.75 0.75 c 904 1660 m 2 5 d -21 40 d 3 -13 d f 0.775 0.775 0.775 c 903
- 1655 m 1 5 d -16 32 d 3 -14 d f 0.8 0.8 0.8 c 901 1650 m 2 5 d -12 23 d 3 -13 d
- f 0.825 0.825 0.825 c 900 1645 m 1 5 d -7 15 d 3 -14 d f 0.85 0.85 0.85 c 899
- 1642 m 1 3 d -3 6 d f 0.65 0.65 0.65 c 865 1712 m -10 -20 d 2 -4 d f 0.675
- 0.675 0.675 c 879 1732 m -1 6 d -13 -26 d -8 -24 d 7 -9 d f 0.7 0.7 0.7 c 882
- 1719 m -3 13 d -15 -53 d 6 -9 d f 0.725 0.725 0.725 c 875 1663 m 1 -1 d 9 43 d
- -3 14 d -12 -49 d f 0.75 0.75 0.75 c 876 1662 m 5 -4 d 7 34 d -3 13 d f 0.775
- 0.775 0.775 c 881 1658 m 4 -5 d 6 25 d -3 14 d f 0.8 0.8 0.8 c 885 1653 m 5 -4
- d 4 16 d -3 13 d f 0.825 0.825 0.825 c 890 1649 m 5 -4 d 2 6 d -3 14 d f 0.85
- 0.85 0.85 c 895 1645 m 4 -3 d -2 9 d f 0.425 0.425 0.425 c 852 1630 m -1 X f
- 0.45 0.45 0.45 c 852 1630 m 2 3 d -4 -2 d 1 -1 d f 0.475 0.475 0.475 c 854 1633
- m 2 3 d -7 -4 d 1 -1 d f 0.5 0.5 0.5 c 856 1636 m 2 2 d -10 -6 d 1 X f 0.525
- 0.525 0.525 c 858 1638 m 2 3 d -13 -8 d 1 -1 d f 0.55 0.55 0.55 c 860 1641 m 2
- 3 d -16 -10 d 1 -1 d f 0.575 0.575 0.575 c 862 1644 m 2 3 d -19 -12 d 1 -1 d f
- 0.6 0.6 0.6 c 864 1647 m 2 2 d -22 -13 d 1 -1 d f 0.625 0.625 0.625 c 866 1649
- m 1 3 d -24 -15 d 1 -1 d f 0.65 0.65 0.65 c 867 1652 m 2 3 d -12 33 d -2 4 d -1
- -2 d -12 -53 d 1 X f 0.675 0.675 0.675 c 869 1655 m 2 3 d -7 21 d -7 9 d -3 2 d
- -3 -5 d -11 -47 d 2 -1 d f 0.7 0.7 0.7 c 871 1658 m 2 2 d -3 10 d -6 9 d -13 6
- d -2 -5 d -10 -41 d 1 -1 d f 0.725 0.725 0.725 c 873 1660 m 2 3 d -5 7 d -21 10
- d -3 -5 d -8 -35 d 1 -1 d f 0.75 0.75 0.75 c 846 1675 m -2 -4 d -7 -30 d 1 -1 d
- f 0.775 0.775 0.775 c 844 1671 m -2 -5 d -6 -24 d 1 -1 d f 0.8 0.8 0.8 c 842
- 1666 m -3 -5 d -4 -18 d 1 -1 d f 0.825 0.825 0.825 c 839 1661 m -2 -4 d -3 -14
- d 1 X f 0.85 0.85 0.85 c 837 1657 m -3 -5 d -1 -8 d 1 -1 d f 0.875 0.875 0.875
- c 834 1652 m -2 -5 d -2 Y 1 -1 d f 0.9 0.9 0.9 c 832 1647 m -1 -2 d 1 X f 0.425
- 0.425 0.425 c 845 1595 m 7 35 d -1 X f 0.45 0.45 0.45 c 828 1503 m 17 92 d 6 35
- d -1 1 d -24 -118 d f 0.475 0.475 0.475 c 850 1631 m -1 1 d -25 -104 d 2 -15 d
- f 0.5 0.5 0.5 c 849 1632 m -1 X -26 -89 d 2 -15 d f 0.525 0.525 0.525 c 848
- 1632 m -1 1 d -27 -75 d 2 -15 d f 0.55 0.55 0.55 c 847 1633 m -1 1 d -28 -61 d
- 2 -15 d f 0.575 0.575 0.575 c 846 1634 m -1 1 d -30 -48 d 3 -14 d f 0.6 0.6 0.6
- c 845 1635 m -1 1 d -31 -34 d 2 -15 d f 0.625 0.625 0.625 c 844 1636 m -1 1 d
- -32 -20 d 2 -15 d f 0.65 0.65 0.65 c 843 1637 m -1 X -33 -5 d 2 -15 d f 0.675
- 0.675 0.675 c 842 1637 m -2 1 d -31 2 d -1 -1 d 1 -7 d f 0.7 0.7 0.7 c 840 1638
- m -1 1 d -27 1 d -3 X f 0.725 0.725 0.725 c 839 1639 m -1 1 d -24 1 d -2 -1 d f
- 0.75 0.75 0.75 c 838 1640 m -1 1 d -20 1 d -3 -1 d f 0.775 0.775 0.775 c 837
- 1641 m -1 1 d -19 X f 0.8 0.8 0.8 c 836 1642 m -1 1 d -13 X -2 -1 d f 0.825
- 0.825 0.825 c 835 1643 m -1 X -9 1 d -3 -1 d f 0.85 0.85 0.85 c 834 1643 m -1 1
- d -8 X f 0.875 0.875 0.875 c 833 1644 m -1 1 d -2 X -2 -1 d f 0.9 0.9 0.9 c 832
- 1645 m -2 X f 0.425 0.425 0.425 c 805 1551 m 18 -37 d -20 46 d f 0.45 0.45 0.45
- c 823 1514 m 5 -11 d -2 10 d -25 57 d 2 -10 d f 0.475 0.475 0.475 c 826 1513 m
- -2 15 d -25 51 d 2 -9 d f 0.5 0.5 0.5 c 824 1528 m -2 15 d -25 45 d 2 -9 d f
- 0.525 0.525 0.525 c 822 1543 m -2 15 d -25 40 d 2 -10 d f 0.55 0.55 0.55 c 820
- 1558 m -2 15 d -25 34 d 2 -9 d f 0.575 0.575 0.575 c 818 1573 m -3 14 d -24 30
- d 2 -10 d f 0.6 0.6 0.6 c 815 1587 m -2 15 d -24 24 d 2 -9 d f 0.625 0.625
- 0.625 c 813 1602 m -2 15 d -24 19 d 2 -10 d f 0.65 0.65 0.65 c 811 1617 m -2 15
- d -24 13 d 2 -9 d f 0.675 0.675 0.675 c 809 1632 m -1 7 d -24 8 d 1 -2 d f
- 0.425 0.425 0.425 c 803 1553 m 2 -2 d -2 9 d f 0.45 0.45 0.45 c 801 1556 m 2 -3
- d 7 Y -2 10 d f 0.475 0.475 0.475 c 799 1559 m 2 -3 d 14 Y -2 9 d f 0.5 0.5 0.5
- c 797 1562 m 2 -3 d 20 Y -2 9 d f 0.525 0.525 0.525 c 795 1565 m 2 -3 d 26 Y -2
- 10 d f 0.55 0.55 0.55 c 793 1567 m 2 -2 d 33 Y -2 9 d f 0.575 0.575 0.575 c 791
- 1570 m 2 -3 d 40 Y -2 10 d f 0.6 0.6 0.6 c 789 1573 m 2 -3 d 47 Y -2 9 d f
- 0.625 0.625 0.625 c 787 1576 m 2 -3 d 53 Y -2 10 d f 0.65 0.65 0.65 c 786 1579
- m 1 -3 d 60 Y -2 9 d f 0.675 0.675 0.675 c 784 1581 m 2 -2 d -1 66 d -1 2 d -2
- 4 d f 0.7 0.7 0.7 c 782 1584 m 2 -3 d -2 70 d -4 5 d f 0.725 0.725 0.725 c 781
- 1585 m 1 -1 d -4 72 d -3 5 d 3 -62 d f 0.75 0.75 0.75 c 775 1661 m -4 5 d 3 -48
- d 4 -19 d f 0.775 0.775 0.775 c 771 1666 m -3 4 d 2 -32 d 4 -20 d f 0.8 0.8 0.8
- c 768 1670 m -3 5 d 1 -17 d 4 -20 d f 0.825 0.825 0.825 c 765 1675 m -4 5 d 1
- -2 d 4 -20 d f 0.85 0.85 0.85 c 761 1680 m 1 Y 1 -3 d f 0.425 0.425 0.425 c 739
- 1789 m -2 7 d 11 -119 d f 0.45 0.45 0.45 c 758 1566 m -18 217 d -1 6 d 9 -112 d
- f 0.475 0.475 0.475 c 758 1566 m 2 2 d -19 208 d -1 7 d f 0.5 0.5 0.5 c 760
- 1568 m 2 1 d -19 200 d -2 7 d f 0.525 0.525 0.525 c 762 1569 m 3 2 d -21 192 d
- -1 6 d f 0.55 0.55 0.55 c 765 1571 m 2 2 d -22 183 d -1 7 d f 0.575 0.575 0.575
- c 767 1573 m 2 2 d -22 174 d -2 7 d f 0.6 0.6 0.6 c 769 1575 m 2 2 d -23 166 d
- -1 6 d f 0.625 0.625 0.625 c 771 1577 m 3 2 d -24 157 d -2 7 d f 0.65 0.65 0.65
- c 774 1579 m 2 2 d -25 148 d -1 7 d f 0.675 0.675 0.675 c 776 1581 m 2 2 d -26
- 140 d -1 6 d f 0.7 0.7 0.7 c 778 1583 m 2 1 d -26 132 d -2 7 d f 0.725 0.725
- 0.725 c 780 1584 m 1 1 d -3 14 d -23 110 d -1 7 d f 0.75 0.75 0.75 c 778 1599 m
- -4 19 d -18 84 d -1 7 d f 0.775 0.775 0.775 c 774 1618 m -4 20 d -12 58 d -2 6
- d f 0.8 0.8 0.8 c 770 1638 m -4 20 d -7 31 d -1 7 d f 0.825 0.825 0.825 c 766
- 1658 m -4 20 d -2 4 d -1 7 d f 0.85 0.85 0.85 c 762 1678 m -1 3 d -1 1 d f
- 0.425 0.425 0.425 c 748 1677 m -11 119 d -10 -94 d f 0.45 0.45 0.45 c 758 1566
- m -10 111 d -21 25 d -10 -94 d f 0.475 0.475 0.475 c 756 1564 m 2 2 d -41 42 d
- -3 -33 d 1 -1 d f 0.5 0.5 0.5 c 755 1563 m 1 1 d -41 10 d 1 -2 d f 0.525 0.525
- 0.525 c 753 1562 m 2 1 d -39 9 d 1 -1 d f 0.55 0.55 0.55 c 752 1561 m 1 1 d -36
- 9 d 1 -2 d f 0.575 0.575 0.575 c 751 1560 m 1 1 d -34 8 d 2 -2 d f 0.6 0.6 0.6
- c 749 1559 m 2 1 d -31 7 d 1 -2 d f 0.625 0.625 0.625 c 748 1557 m 1 2 d -28 6
- d 1 -2 d f 0.65 0.65 0.65 c 746 1556 m 2 1 d -26 6 d 1 -1 d f 0.675 0.675 0.675
- c 745 1555 m 1 1 d -23 6 d 1 -2 d f 0.7 0.7 0.7 c 744 1554 m 1 1 d -21 5 d 2 -2
- d f 0.725 0.725 0.725 c 742 1553 m 2 1 d -18 4 d 1 -2 d f 0.75 0.75 0.75 c 741
- 1552 m 1 1 d -15 3 d 1 -1 d f 0.775 0.775 0.775 c 739 1551 m 2 1 d -13 3 d 1 -2
- d f 0.8 0.8 0.8 c 738 1549 m 1 2 d -10 2 d 2 -2 d f 0.825 0.825 0.825 c 737
- 1548 m 1 1 d -7 2 d 1 -2 d f 0.85 0.85 0.85 c 735 1547 m 2 1 d -5 1 d 1 -1 d f
- 0.875 0.875 0.875 c 734 1546 m 1 1 d -2 1 d f 0.425 0.425 0.425 c 711 1701 m 1
- -8 d -12 -121 d -10 -3 d f 0.45 0.45 0.45 c 712 1693 m 1 -8 d -3 -111 d -10 -2
- d f 0.475 0.475 0.475 c 713 1685 m 1 -8 d 1 -103 d -1 1 d -4 -1 d f 0.5 0.5 0.5
- c 714 1677 m 2 -8 d -97 Y -1 2 d f 0.525 0.525 0.525 c 716 1669 m 1 -9 d -89 Y
- -1 1 d f 0.55 0.55 0.55 c 717 1660 m 1 -8 d -83 Y -1 2 d f 0.575 0.575 0.575 c
- 718 1652 m 1 -8 d 1 -77 d -2 2 d f 0.6 0.6 0.6 c 719 1644 m 2 -8 d -71 Y -1 2 d
- f 0.625 0.625 0.625 c 721 1636 m 1 -9 d -64 Y -1 2 d f 0.65 0.65 0.65 c 722
- 1627 m 1 -8 d -57 Y -1 1 d f 0.675 0.675 0.675 c 723 1619 m 1 -8 d -51 Y -1 2 d
- f 0.7 0.7 0.7 c 724 1611 m 2 -8 d -45 Y -2 2 d f 0.725 0.725 0.725 c 726 1603 m
- 1 -9 d -38 Y -1 2 d f 0.75 0.75 0.75 c 727 1594 m 1 -8 d -31 Y -1 1 d f 0.775
- 0.775 0.775 c 728 1586 m 1 -8 d -25 Y -1 2 d f 0.8 0.8 0.8 c 729 1578 m 2 -8 d
- -19 Y -2 2 d f 0.825 0.825 0.825 c 731 1570 m 1 -9 d -12 Y -1 2 d f 0.85 0.85
- 0.85 c 732 1561 m 1 -8 d -5 Y -1 1 d f 0.875 0.875 0.875 c 733 1553 m 1 -7 d -1
- 2 d f 0.425 0.425 0.425 c 709 1696 m 2 5 d -21 -132 d -11 112 d f 0.45 0.45
- 0.45 c 708 1691 m 1 5 d -30 -15 d -11 113 d f 0.475 0.475 0.475 c 707 1686 m 1
- 5 d -40 103 d -1 11 d 1 -11 d f 0.5 0.5 0.5 c 706 1680 m 1 6 d -39 108 d 1 -12
- d f 0.525 0.525 0.525 c 704 1675 m 2 5 d -37 102 d 1 -12 d f 0.55 0.55 0.55 c
- 703 1670 m 1 5 d -34 95 d 2 -12 d f 0.575 0.575 0.575 c 702 1664 m 1 6 d -31 88
- d 1 -12 d f 0.6 0.6 0.6 c 701 1659 m 1 5 d -29 82 d 1 -13 d f 0.625 0.625 0.625
- c 699 1654 m 2 5 d -27 74 d 1 -12 d f 0.65 0.65 0.65 c 698 1648 m 1 6 d -24 67
- d 1 -12 d f 0.675 0.675 0.675 c 697 1643 m 1 5 d -22 61 d 2 -12 d f 0.7 0.7 0.7
- c 696 1638 m 1 5 d -19 54 d 1 -12 d f 0.725 0.725 0.725 c 694 1633 m 2 5 d -17
- 47 d 1 -12 d f 0.75 0.75 0.75 c 693 1627 m 1 6 d -14 40 d 1 -12 d f 0.775 0.775
- 0.775 c 692 1622 m 1 5 d -12 34 d 1 -13 d f 0.8 0.8 0.8 c 691 1617 m 1 5 d -10
- 26 d 2 -12 d f 0.825 0.825 0.825 c 689 1611 m 2 6 d -7 19 d 1 -12 d f 0.85 0.85
- 0.85 c 688 1606 m 1 5 d -4 13 d 1 -12 d f 0.875 0.875 0.875 c 687 1601 m 1 5 d
- -2 6 d f 0.425 0.425 0.425 c 664 1582 m 1 1 d -11 78 d -11 -131 d f 0.45 0.45
- 0.45 c 665 1583 m 1 1 d 208 Y -12 -131 d f 0.475 0.475 0.475 c 666 1584 m 1 1 d
- 1 209 d -1 11 d -1 -13 d f 0.5 0.5 0.5 c 667 1585 m 2 1 d 196 Y -1 12 d f 0.525
- 0.525 0.525 c 669 1586 m 1 1 d 183 Y -1 12 d f 0.55 0.55 0.55 c 670 1587 m 1 1
- d 1 170 d -2 12 d f 0.575 0.575 0.575 c 671 1588 m 1 1 d 1 157 d -1 12 d f 0.6
- 0.6 0.6 c 672 1589 m 2 1 d 143 Y -1 13 d f 0.625 0.625 0.625 c 674 1590 m 1 1 d
- 130 Y -1 12 d f 0.65 0.65 0.65 c 675 1591 m 1 1 d 117 Y -1 12 d f 0.675 0.675
- 0.675 c 676 1592 m 1 1 d 1 104 d -2 12 d f 0.7 0.7 0.7 c 677 1593 m 2 1 d 91 Y
- -1 12 d f 0.725 0.725 0.725 c 679 1594 m 1 1 d 78 Y -1 12 d f 0.75 0.75 0.75 c
- 680 1595 m 1 1 d 65 Y -1 12 d f 0.775 0.775 0.775 c 681 1596 m 1 1 d 51 Y -1 13
- d f 0.8 0.8 0.8 c 682 1597 m 2 1 d 38 Y -2 12 d f 0.825 0.825 0.825 c 684 1598
- m 1 1 d 25 Y -1 12 d f 0.85 0.85 0.85 c 685 1599 m 1 2 d 11 Y -1 12 d f 0.875
- 0.875 0.875 c 686 1601 m 1 X -1 11 d f 0.425 0.425 0.425 c 660 1477 m 4 105 d
- -21 -52 d -4 -93 d f 0.45 0.45 0.45 c 656 1371 m 4 106 d -21 -40 d -3 -93 d f
- 0.475 0.475 0.475 c 652 1266 m 4 105 d -20 -27 d -4 -94 d f 0.5 0.5 0.5 c 648
- 1161 m 4 105 d -20 -16 d -4 -93 d f 0.525 0.525 0.525 c 644 1056 m 4 105 d -20
- -4 d -4 -94 d f 0.55 0.55 0.55 c 640 950 m 4 106 d -20 7 d -4 -93 d f 0.575
- 0.575 0.575 c 640 945 m 5 Y -20 20 d -10 Y f 0.55 0.55 0.55 c 617 939 m 3 X -22
- 16 d -2 -1 d f 0.575 0.575 0.575 c 620 939 m 20 6 d -20 15 d -22 -5 d f 0.55
- 0.55 0.55 c 593 933 m 24 6 d -21 15 d -23 -6 d f 570 927 m 23 6 d -20 15 d -24
- -6 d f 1671 1186 m 23 6 d -20 16 d -24 -6 d f 1647 1180 m 24 6 d -21 16 d -23
- -6 d f 1624 1174 m 23 6 d -20 16 d -24 -6 d f 1623 1194 m 1 -20 d -21 16 d -1
- 34 d f 0.575 0.575 0.575 c 1618 1365 m 5 -171 d -21 30 d -10 211 d f 0.6 0.6
- 0.6 c 1613 1536 m 5 -171 d -26 70 d -9 211 d f 0.625 0.625 0.625 c 1607 1708 m
- 6 -172 d -30 110 d -3 75 d 6 71 d f 0.65 0.65 0.65 c 1602 1879 m 5 -171 d -21
- 84 d 10 111 d f 0.675 0.675 0.675 c 1600 1947 m 2 -68 d -6 24 d f 0.625 0.625
- 0.625 c 1586 1792 m -6 -71 d -3 -20 d f 0.65 0.65 0.65 c 1596 1903 m -10 -111 d
- -9 -91 d -5 -31 d f 0.675 0.675 0.675 c 1597 1918 m 3 29 d -4 -44 d -24 -233 d
- -5 -31 d f 0.7 0.7 0.7 c 1592 1869 m 5 49 d -30 -279 d -5 -31 d f 0.725 0.725
- 0.725 c 1587 1820 m 5 49 d -30 -261 d -4 -31 d f 0.75 0.75 0.75 c 1581 1771 m 6
- 49 d -29 -243 d -2 -10 d 9 68 d f 0.775 0.775 0.775 c 1577 1726 m 4 45 d -16
- -136 d f 0.425 0.425 0.425 c 1535 1873 m -2 24 d 8 44 d f 0.45 0.45 0.45 c 1536
- 1848 m -1 25 d 6 68 d 8 43 d f 0.475 0.475 0.475 c 1553 2003 m 1 -13 d -16 -167
- d -2 25 d 13 136 d f 0.5 0.5 0.5 c 1554 1990 m 2 -22 d -16 -170 d -2 25 d f
- 0.525 0.525 0.525 c 1556 1968 m 2 -22 d -16 -173 d -2 25 d f 0.55 0.55 0.55 c
- 1558 1946 m 2 -22 d -17 -175 d -1 24 d f 0.575 0.575 0.575 c 1560 1924 m 2 -22
- d -17 -178 d -2 25 d f 0.6 0.6 0.6 c 1562 1902 m 2 -22 d -17 -181 d -2 25 d f
- 0.625 0.625 0.625 c 1564 1880 m 1 -23 d -16 -183 d -2 25 d f 0.65 0.65 0.65 c
- 1565 1857 m 2 -22 d -17 -185 d -1 24 d f 0.675 0.675 0.675 c 1567 1835 m 2 -22
- d -17 -188 d -2 25 d f 0.7 0.7 0.7 c 1569 1813 m 2 -22 d -17 -191 d -2 25 d f
- 0.725 0.725 0.725 c 1571 1791 m 2 -22 d -17 -194 d -2 25 d f 0.75 0.75 0.75 c
- 1573 1769 m 2 -22 d -10 -112 d -9 -68 d 8 Y f 0.775 0.775 0.775 c 1575 1747 m 2
- -21 d -12 -91 d f 0.425 0.425 0.425 c 1541 1941 m -8 -44 d -24 102 d -1 Y f
- 0.45 0.45 0.45 c 1549 1984 m -8 -43 d -32 57 d 2 -4 d f 0.475 0.475 0.475 c
- 1552 2000 m 1 3 d -4 -19 d -38 10 d 1 -4 d f 0.5 0.5 0.5 c 1551 1995 m 1 5 d
- -40 -10 d 1 -4 d f 0.525 0.525 0.525 c 1549 1990 m 2 5 d -38 -9 d 1 -5 d f 0.55
- 0.55 0.55 c 1547 1985 m 2 5 d -35 -9 d 2 -4 d f 0.575 0.575 0.575 c 1546 1980 m
- 1 5 d -31 -8 d 1 -4 d f 0.6 0.6 0.6 c 1544 1976 m 2 4 d -29 -7 d 1 -4 d f 0.625
- 0.625 0.625 c 1543 1971 m 1 5 d -26 -7 d 1 -4 d f 0.65 0.65 0.65 c 1541 1966 m
- 2 5 d -24 -6 d 1 -4 d f 0.675 0.675 0.675 c 1540 1961 m 1 5 d -21 -5 d 2 -5 d f
- 0.7 0.7 0.7 c 1538 1956 m 2 5 d -18 -5 d 1 -4 d f 0.725 0.725 0.725 c 1537 1951
- m 1 5 d -15 -4 d 1 -4 d f 0.75 0.75 0.75 c 1535 1946 m 2 5 d -13 -3 d 1 -4 d f
- 0.775 0.775 0.775 c 1533 1941 m 2 5 d -10 -2 d 2 -4 d f 0.8 0.8 0.8 c 1532 1936
- m 1 5 d -6 -1 d 1 -5 d f 0.825 0.825 0.825 c 1530 1932 m 2 4 d -4 -1 d 1 -4 d f
- 0.85 0.85 0.85 c 1530 1930 m 2 Y -1 -1 d f 0.425 0.425 0.425 c 1509 1998 m 1 Y
- -4 -48 d f 0.45 0.45 0.45 c 1511 1994 m -2 4 d -4 -47 d -19 -227 d 6 53 d f
- 0.475 0.475 0.475 c 1506 1897 m 1 1 d 5 92 d -1 4 d -19 -217 d f 0.5 0.5 0.5 c
- 1507 1898 m 1 2 d 5 86 d -1 4 d f 0.525 0.525 0.525 c 1508 1900 m 2 2 d 4 79 d
- -1 5 d f 0.55 0.55 0.55 c 1510 1902 m 2 2 d 4 73 d -2 4 d f 0.575 0.575 0.575 c
- 1512 1904 m 1 3 d 4 66 d -1 4 d f 0.6 0.6 0.6 c 1513 1907 m 2 2 d 3 60 d -1 4 d
- f 0.625 0.625 0.625 c 1515 1909 m 1 2 d 3 54 d -1 4 d f 0.65 0.65 0.65 c 1516
- 1911 m 2 2 d 2 48 d -1 4 d f 0.675 0.675 0.675 c 1518 1913 m 1 2 d 3 41 d -2 5
- d f 0.7 0.7 0.7 c 1519 1915 m 2 3 d 2 34 d -1 4 d f 0.725 0.725 0.725 c 1521
- 1918 m 2 2 d 1 28 d -1 4 d f 0.75 0.75 0.75 c 1523 1920 m 1 2 d 1 22 d -1 4 d f
- 0.775 0.775 0.775 c 1524 1922 m 2 2 d 1 16 d -2 4 d f 0.8 0.8 0.8 c 1526 1924 m
- 1 2 d 1 9 d -1 5 d f 0.825 0.825 0.825 c 1527 1926 m 2 3 d 2 Y -1 4 d f 0.85
- 0.85 0.85 c 1529 1929 m 1 1 d -1 1 d f 0.45 0.45 0.45 c 1492 1777 m -6 -53 d -1
- 6 d f 0.475 0.475 0.475 c 1505 1884 m 1 13 d -14 -120 d -7 -47 d -2 28 d f 0.5
- 0.5 0.5 c 1502 1859 m 3 25 d -22 -126 d -2 27 d f 0.525 0.525 0.525 c 1500 1833
- m 2 26 d -21 -74 d -2 27 d f 0.55 0.55 0.55 c 1497 1808 m 3 25 d -21 -21 d -1
- 28 d f 0.575 0.575 0.575 c 1495 1782 m 2 26 d -19 32 d -2 27 d f 0.6 0.6 0.6 c
- 1492 1757 m 3 25 d -19 85 d -2 28 d f 0.625 0.625 0.625 c 1490 1732 m 2 25 d
- -18 138 d -2 27 d f 0.65 0.65 0.65 c 1487 1706 m 3 26 d -18 190 d -2 28 d f
- 0.675 0.675 0.675 c 1484 1681 m 3 25 d -17 244 d -2 27 d f 0.7 0.7 0.7 c 1483
- 1662 m 1 19 d -16 296 d -2 27 d 14 -291 d f 0.725 0.725 0.725 c 1466 2004 m -2
- 28 d 6 -130 d 10 -189 d f 0.75 0.75 0.75 c 1464 2032 m -2 22 d 8 -152 d f 0.675
- 0.675 0.675 c 1459 1858 m 12 -101 d -15 87 d f 0.7 0.7 0.7 c 1471 1757 m 12 -95
- d -3 51 d -28 114 d 4 17 d f 0.725 0.725 0.725 c 1480 1713 m -10 189 d -22 -92
- d 4 17 d f 0.75 0.75 0.75 c 1470 1902 m -8 152 d -2 -33 d -15 -229 d 3 18 d f
- 0.775 0.775 0.775 c 1460 2021 m -14 -168 d -5 -78 d 4 17 d f 0.8 0.8 0.8 c 1446
- 1853 m -7 -87 d 2 9 d f 0.425 0.425 0.425 c 1417 1861 m -2 6 d 1 3 d f 0.45
- 0.45 0.45 c 1418 1854 m -1 7 d -1 9 d 2 2 d f 0.475 0.475 0.475 c 1420 1848 m
- -2 6 d 18 Y 1 2 d f 0.5 0.5 0.5 c 1421 1841 m -1 7 d -1 26 d 1 2 d f 0.525
- 0.525 0.525 c 1423 1835 m -2 6 d -1 35 d 1 2 d f 0.55 0.55 0.55 c 1424 1828 m
- -1 7 d -2 43 d 1 3 d f 0.575 0.575 0.575 c 1426 1822 m -2 6 d -2 53 d 2 2 d f
- 0.6 0.6 0.6 c 1427 1815 m -1 7 d -2 61 d 1 2 d f 0.625 0.625 0.625 c 1429 1809
- m -2 6 d -2 70 d 1 2 d f 0.65 0.65 0.65 c 1430 1802 m -1 7 d -3 78 d 1 2 d f
- 0.675 0.675 0.675 c 1457 1863 m 2 -5 d -3 -14 d -24 -49 d -2 7 d -3 87 d 1 3 d
- f 0.7 0.7 0.7 c 1453 1870 m 4 -7 d -1 -19 d -4 -17 d -19 -38 d -1 6 d -4 97 d 1
- 2 d f 0.725 0.725 0.725 c 1450 1877 m 3 -7 d -1 -43 d -4 -17 d -13 -28 d -2 7 d
- -4 105 d 2 2 d f 0.75 0.75 0.75 c 1447 1883 m 3 -6 d -2 -67 d -3 -18 d -9 -16 d
- -1 6 d -4 114 d 1 2 d f 0.775 0.775 0.775 c 1443 1890 m 4 -7 d -2 -91 d -4 -17
- d -3 -6 d -2 7 d -4 122 d 1 2 d f 0.8 0.8 0.8 c 1440 1897 m 3 -7 d -2 -115 d -2
- -9 d -1 3 d -5 131 d 1 3 d f 0.825 0.825 0.825 c 1437 1904 m 3 -7 d -6 6 d 1 2
- d f 0.85 0.85 0.85 c 1436 1906 m 1 -2 d -2 1 d f 0.425 0.425 0.425 c 1416 1870
- m -1 -3 d -23 -6 d 1 X f 0.45 0.45 0.45 c 1418 1872 m -2 -2 d -23 -9 d 2 X f
- 0.475 0.475 0.475 c 1419 1874 m -1 -2 d -23 -11 d 2 X f 0.5 0.5 0.5 c 1420 1876
- m -1 -2 d -22 -13 d 1 X f 0.525 0.525 0.525 c 1421 1878 m -1 -2 d -22 -15 d 2 X
- f 0.55 0.55 0.55 c 1422 1881 m -1 -3 d -21 -17 d 2 -1 d f 0.575 0.575 0.575 c
- 1424 1883 m -2 -2 d -20 -21 d 2 X f 0.6 0.6 0.6 c 1425 1885 m -1 -2 d -20 -23 d
- 1 X f 0.625 0.625 0.625 c 1426 1887 m -1 -2 d -20 -25 d 2 X f 0.65 0.65 0.65 c
- 1427 1889 m -1 -2 d -19 -27 d 2 X f 0.675 0.675 0.675 c 1428 1892 m -1 -3 d -18
- -29 d 1 X f 0.7 0.7 0.7 c 1429 1894 m -1 -2 d -18 -32 d 2 -1 d f 0.725 0.725
- 0.725 c 1412 1859 m 4 8 d 15 29 d -2 -2 d -17 -35 d f 0.75 0.75 0.75 c 1416
- 1867 m 5 9 d 11 22 d -1 -2 d f 0.775 0.775 0.775 c 1421 1876 m 4 9 d 8 15 d -1
- -2 d f 0.8 0.8 0.8 c 1425 1885 m 5 9 d 4 9 d -1 -3 d f 0.825 0.825 0.825 c 1430
- 1894 m 4 9 d 1 2 d -1 -2 d f 0.85 0.85 0.85 c 1434 1903 m 2 3 d -1 -1 d f 0.425
- 0.425 0.425 c 1393 1861 m -1 X -24 263 d 2 -13 d f 0.45 0.45 0.45 c 1395 1861 m
- -2 X -23 250 d 2 -23 d f 0.475 0.475 0.475 c 1397 1861 m -2 X -23 227 d 2 -24 d
- f 0.5 0.5 0.5 c 1398 1861 m -1 X -23 203 d 3 -23 d f 0.525 0.525 0.525 c 1400
- 1861 m -2 X -21 180 d 2 -24 d f 0.55 0.55 0.55 c 1402 1860 m -2 1 d -21 156 d 2
- -23 d f 0.575 0.575 0.575 c 1404 1860 m -2 X -21 134 d 3 -24 d f 0.6 0.6 0.6 c
- 1405 1860 m -1 X -20 110 d 2 -23 d f 0.625 0.625 0.625 c 1407 1860 m -2 X -19
- 87 d 2 -24 d f 0.65 0.65 0.65 c 1389 1921 m 6 -18 d 14 -43 d -2 X -19 63 d f
- 0.675 0.675 0.675 c 1395 1903 m 8 -20 d 7 -23 d -1 X f 0.7 0.7 0.7 c 1403 1883
- m 8 -20 d 1 -4 d -2 1 d f 0.725 0.725 0.725 c 1411 1863 m 1 -4 d f 0.425 0.425
- 0.425 c 1370 2111 m -2 13 d -7 -82 d f 0.45 0.45 0.45 c 1372 2088 m -2 23 d -9
- -69 d -14 -149 d f 0.475 0.475 0.475 c 1374 2064 m -2 24 d -25 -195 d -2 -30 d
- 3 -11 d f 0.5 0.5 0.5 c 1377 2041 m -3 23 d -26 -212 d 4 -13 d f 0.525 0.525
- 0.525 c 1379 2017 m -2 24 d -25 -202 d 4 -13 d f 0.55 0.55 0.55 c 1381 1994 m
- -2 23 d -23 -191 d 3 -13 d f 0.575 0.575 0.575 c 1384 1970 m -3 24 d -22 -181 d
- 4 -13 d f 0.6 0.6 0.6 c 1365 1794 m 7 38 d 14 115 d -2 23 d -21 -170 d f 0.625
- 0.625 0.625 c 1372 1832 m 15 79 d 1 12 d -2 24 d f 0.65 0.65 0.65 c 1387 1911 m
- 2 10 d -1 2 d f 0.475 0.475 0.475 c 1348 1852 m -3 11 d -1 1 d f 0.5 0.5 0.5 c
- 1352 1839 m -4 13 d -4 12 d -2 1 d f 0.525 0.525 0.525 c 1356 1826 m -4 13 d
- -10 26 d -1 1 d f 0.55 0.55 0.55 c 1359 1813 m -3 13 d -15 40 d -1 2 d f 0.575
- 0.575 0.575 c 1363 1800 m -4 13 d -19 55 d -2 1 d f 0.6 0.6 0.6 c 1363 1789 m 2
- 5 d -2 6 d -25 69 d -1 1 d f 0.625 0.625 0.625 c 1359 1779 m 4 10 d -26 81 d -2
- 1 d f 0.65 0.65 0.65 c 1355 1769 m 4 10 d -24 92 d -1 2 d f 0.675 0.675 0.675 c
- 1352 1759 m 3 10 d -21 104 d -1 1 d f 0.7 0.7 0.7 c 1348 1749 m 4 10 d -19 115
- d -2 1 d f 0.725 0.725 0.725 c 1344 1739 m 4 10 d -17 126 d -1 1 d f 0.75 0.75
- 0.75 c 1342 1734 m 2 5 d -14 137 d -2 2 d 12 -131 d f 0.775 0.775 0.775 c 1328
- 1878 m -1 1 d 9 -105 d 4 -27 d f 0.8 0.8 0.8 c 1327 1879 m -1 1 d 7 -79 d 3 -27
- d f 0.825 0.825 0.825 c 1326 1880 m -2 1 d 5 -53 d 4 -27 d f 0.85 0.85 0.85 c
- 1324 1881 m -1 1 d 2 -27 d 4 -27 d f 0.875 0.875 0.875 c 1323 1882 m -2 2 d 1
- -1 d 3 -28 d f 0.9 0.9 0.9 c 1321 1884 m 1 -1 d f 0.425 0.425 0.425 c 1299 1917
- m -1 1 d 1 -13 d f 0.45 0.45 0.45 c 1300 1915 m -1 2 d -12 Y 2 -18 d f 0.475
- 0.475 0.475 c 1301 1913 m -1 2 d 1 -28 d 1 -17 d f 0.5 0.5 0.5 c 1303 1911 m -2
- 2 d 1 -43 d 2 -18 d f 0.525 0.525 0.525 c 1304 1909 m -1 2 d 1 -59 d 2 -17 d f
- 0.55 0.55 0.55 c 1305 1908 m -1 1 d 2 -74 d 1 -18 d f 0.575 0.575 0.575 c 1306
- 1906 m -1 2 d 2 -91 d 2 -18 d f 0.6 0.6 0.6 c 1308 1904 m -2 2 d 3 -107 d 2 -17
- d f 0.625 0.625 0.625 c 1309 1902 m -1 2 d 3 -122 d 1 -18 d f 0.65 0.65 0.65 c
- 1310 1900 m -1 2 d 3 -138 d 2 -17 d f 0.675 0.675 0.675 c 1311 1898 m -1 2 d 4
- -153 d 2 -18 d f 0.7 0.7 0.7 c 1313 1897 m -2 1 d 5 -169 d 1 -17 d f 0.725
- 0.725 0.725 c 1318 1701 m 10 14 d -14 180 d -1 2 d 4 -185 d f 0.75 0.75 0.75 c
- 1328 1715 m 14 19 d -2 13 d -25 146 d -1 2 d f 0.775 0.775 0.775 c 1340 1747 m
- -4 27 d -20 117 d -1 2 d f 0.8 0.8 0.8 c 1336 1774 m -3 27 d -15 88 d -2 2 d f
- 0.825 0.825 0.825 c 1333 1801 m -4 27 d -10 60 d -1 1 d f 0.85 0.85 0.85 c 1329
- 1828 m -4 27 d -5 31 d -1 2 d f 0.875 0.875 0.875 c 1325 1855 m -3 28 d -1 1 d
- -1 2 d f 0.9 0.9 0.9 c 1322 1883 m -1 1 d f 0.425 0.425 0.425 c 1299 1905 m -1
- 13 d -13 -163 d f 0.45 0.45 0.45 c 1301 1887 m -2 18 d -14 -150 d -11 -125 d 1
- 5 d f 0.475 0.475 0.475 c 1302 1870 m -1 17 d -26 -252 d 2 10 d f 0.5 0.5 0.5 c
- 1304 1852 m -2 18 d -25 -225 d 1 11 d f 0.525 0.525 0.525 c 1306 1835 m -2 17 d
- -26 -196 d 2 11 d f 0.55 0.55 0.55 c 1307 1817 m -1 18 d -26 -168 d 2 11 d f
- 0.575 0.575 0.575 c 1309 1799 m -2 18 d -25 -139 d 1 10 d f 0.6 0.6 0.6 c 1311
- 1782 m -2 17 d -26 -111 d 2 11 d f 0.625 0.625 0.625 c 1312 1764 m -1 18 d -26
- -83 d 2 11 d f 0.65 0.65 0.65 c 1314 1747 m -2 17 d -25 -54 d 1 11 d f 0.675
- 0.675 0.675 c 1316 1729 m -2 18 d -26 -26 d 2 11 d f 0.7 0.7 0.7 c 1317 1712 m
- -1 17 d -26 3 d 2 10 d f 0.725 0.725 0.725 c 1311 1721 m 7 -20 d -1 11 d -25 30
- d 1 11 d f 0.75 0.75 0.75 c 1295 1762 m 16 -41 d -18 32 d f 0.425 0.425 0.425 c
- 1266 1756 m -15 217 d 2 -15 d f 0.45 0.45 0.45 c 1275 1635 m -1 -5 d -8 126 d
- -13 202 d 2 -15 d f 0.475 0.475 0.475 c 1277 1645 m -2 -10 d -20 308 d 3 -15 d
- f 0.5 0.5 0.5 c 1278 1656 m -1 -11 d -19 283 d 2 -15 d f 0.525 0.525 0.525 c
- 1280 1667 m -2 -11 d -18 257 d 2 -15 d f 0.55 0.55 0.55 c 1282 1678 m -2 -11 d
- -18 231 d 2 -15 d f 0.575 0.575 0.575 c 1283 1688 m -1 -10 d -18 205 d 3 -15 d
- f 0.6 0.6 0.6 c 1285 1699 m -2 -11 d -16 180 d 2 -15 d f 0.625 0.625 0.625 c
- 1287 1710 m -2 -11 d -16 154 d 2 -15 d f 0.65 0.65 0.65 c 1271 1837 m 5 -14 d
- 12 -102 d -1 -11 d -16 128 d f 0.675 0.675 0.675 c 1276 1823 m 5 -16 d 9 -75 d
- -2 -11 d f 0.7 0.7 0.7 c 1281 1807 m 5 -16 d 6 -49 d -2 -10 d f 0.725 0.725
- 0.725 c 1286 1791 m 5 -15 d 2 -23 d -1 -11 d f 0.75 0.75 0.75 c 1291 1776 m 4
- -14 d -2 -9 d f 0.425 0.425 0.425 c 1253 1958 m -2 15 d -24 -6 d 3 -21 d f 0.45
- 0.45 0.45 c 1255 1943 m -2 15 d -23 -12 d 3 -22 d f 0.475 0.475 0.475 c 1258
- 1928 m -3 15 d -22 -19 d 3 -22 d f 0.5 0.5 0.5 c 1260 1913 m -2 15 d -22 -26 d
- 2 -22 d f 0.525 0.525 0.525 c 1262 1898 m -2 15 d -22 -33 d 3 -21 d f 0.55 0.55
- 0.55 c 1264 1883 m -2 15 d -21 -39 d 3 -22 d f 0.575 0.575 0.575 c 1267 1868 m
- -3 15 d -20 -46 d 2 -22 d f 0.6 0.6 0.6 c 1248 1804 m 7 10 d 14 39 d -2 15 d
- -21 -53 d f 0.625 0.625 0.625 c 1255 1814 m 15 21 d 1 3 d -2 15 d f 0.65 0.65
- 0.65 c 1270 1835 m 1 2 d 1 Y f 0.425 0.425 0.425 c 1230 1946 m -3 21 d -17 -186
- d f 0.45 0.45 0.45 c 1233 1924 m -3 22 d -20 -165 d -6 -61 d 1 4 d f 0.475
- 0.475 0.475 c 1236 1902 m -3 22 d -28 -200 d 1 8 d f 0.5 0.5 0.5 c 1238 1880 m
- -2 22 d -30 -170 d 2 7 d f 0.525 0.525 0.525 c 1241 1859 m -3 21 d -30 -141 d 1
- 8 d f 0.55 0.55 0.55 c 1244 1837 m -3 22 d -32 -112 d 2 7 d f 0.575 0.575 0.575
- c 1246 1815 m -2 22 d -33 -83 d 1 8 d f 0.6 0.6 0.6 c 1246 1805 m 2 -1 d -2 11
- d -34 -53 d 1 7 d f 0.625 0.625 0.625 c 1243 1808 m 3 -3 d -33 -36 d 2 7 d f
- 0.65 0.65 0.65 c 1240 1811 m 3 -3 d -28 -32 d 1 8 d f 0.675 0.675 0.675 c 1237
- 1813 m 3 -2 d -24 -27 d 2 7 d f 0.7 0.7 0.7 c 1235 1816 m 2 -3 d -19 -22 d 1 8
- d f 0.725 0.725 0.725 c 1232 1818 m 3 -2 d -16 -17 d 2 7 d f 0.75 0.75 0.75 c
- 1229 1821 m 3 -3 d -11 -12 d 1 8 d f 0.775 0.775 0.775 c 1226 1824 m 3 -3 d -7
- -7 d 1 7 d f 0.8 0.8 0.8 c 1224 1825 m 2 -1 d -3 -3 d f 0.45 0.45 0.45 c 1205
- 1724 m -1 -4 d -1 3 d f 0.475 0.475 0.475 c 1206 1732 m -1 -8 d -2 -1 d -2 6 d
- f 0.5 0.5 0.5 c 1208 1739 m -2 -7 d -5 -3 d -1 5 d f 0.525 0.525 0.525 c 1209
- 1747 m -1 -8 d -8 -5 d -2 6 d f 0.55 0.55 0.55 c 1211 1754 m -2 -7 d -11 -7 d
- -1 6 d f 0.575 0.575 0.575 c 1212 1762 m -1 -8 d -14 -8 d -2 5 d f 0.6 0.6 0.6
- c 1213 1769 m -1 -7 d -17 -11 d -1 6 d f 0.625 0.625 0.625 c 1215 1776 m -2 -7
- d -19 -12 d -2 5 d f 0.65 0.65 0.65 c 1216 1784 m -1 -8 d -23 -14 d -1 6 d f
- 0.675 0.675 0.675 c 1218 1791 m -2 -7 d -25 -16 d -2 6 d f 0.7 0.7 0.7 c 1219
- 1799 m -1 -8 d -29 -17 d -1 5 d f 0.725 0.725 0.725 c 1221 1806 m -2 -7 d -31
- -20 d -2 6 d f 0.75 0.75 0.75 c 1222 1814 m -1 -8 d -35 -21 d -1 5 d f 0.775
- 0.775 0.775 c 1223 1821 m -1 -7 d -37 -24 d -2 6 d f 0.8 0.8 0.8 c 1217 1815 m
- 7 10 d -1 -4 d -40 -25 d -1 6 d f 0.825 0.825 0.825 c 1203 1795 m 14 20 d -35
- -13 d -2 5 d f 0.85 0.85 0.85 c 1201 1792 m 2 3 d -23 12 d 1 Y f 0.425 0.425
- 0.425 c 1177 1692 m 2 6 d -22 -3 d -1 Y f 0.45 0.45 0.45 c 1179 1698 m 1 6 d
- -21 -2 d -2 -7 d f 0.475 0.475 0.475 c 1180 1704 m 1 6 d -21 -1 d -1 -7 d f 0.5
- 0.5 0.5 c 1181 1710 m 2 5 d -22 1 d -1 -7 d f 0.525 0.525 0.525 c 1183 1715 m 1
- 6 d -21 2 d -2 -7 d f 0.55 0.55 0.55 c 1184 1721 m 1 6 d -21 3 d -1 -7 d f
- 0.575 0.575 0.575 c 1185 1727 m 2 6 d -21 4 d -2 -7 d f 0.6 0.6 0.6 c 1187 1733
- m 1 6 d -21 5 d -1 -7 d f 0.625 0.625 0.625 c 1188 1739 m 2 5 d -21 7 d -2 -7 d
- f 0.65 0.65 0.65 c 1190 1744 m 1 6 d -21 8 d -1 -7 d f 0.675 0.675 0.675 c 1191
- 1750 m 1 6 d -20 9 d -2 -7 d f 0.7 0.7 0.7 c 1192 1756 m 2 6 d -21 10 d -1 -7 d
- f 0.725 0.725 0.725 c 1194 1762 m 1 6 d -21 11 d -1 -7 d f 0.75 0.75 0.75 c
- 1195 1768 m 1 6 d -20 12 d -2 -7 d f 0.775 0.775 0.775 c 1196 1774 m 2 5 d -21
- 14 d -1 -7 d f 0.8 0.8 0.8 c 1198 1779 m 1 6 d -20 15 d -2 -7 d f 0.825 0.825
- 0.825 c 1199 1785 m 2 6 d -21 16 d -1 -7 d f 0.85 0.85 0.85 c 1201 1791 m 1 Y
- -21 16 d -1 Y f 0.425 0.425 0.425 c 1172 1684 m 5 8 d -20 2 d f 0.45 0.45 0.45
- c 1166 1676 m 6 8 d -15 10 d -2 -5 d f 0.475 0.475 0.475 c 1160 1668 m 6 8 d
- -11 13 d -1 -4 d f 0.5 0.5 0.5 c 1154 1660 m 6 8 d -6 17 d -1 -4 d f 0.525
- 0.525 0.525 c 1154 1659 m 1 Y -1 21 d -2 -4 d 1 -20 d f 0.55 0.55 0.55 c 1151
- 1677 m -1 -5 d 1 -18 d 1 3 d f 0.575 0.575 0.575 c 1150 1672 m -1 -4 d 1 -17 d
- 1 3 d f 0.6 0.6 0.6 c 1149 1668 m -2 -4 d 1 -16 d 2 3 d f 0.625 0.625 0.625 c
- 1147 1664 m -1 -5 d 1 -13 d 1 2 d f 0.65 0.65 0.65 c 1146 1659 m -2 -4 d 1 -12
- d 2 3 d f 0.675 0.675 0.675 c 1144 1655 m -1 -4 d 1 -11 d 1 3 d f 0.7 0.7 0.7 c
- 1143 1651 m -1 -4 d -10 Y 2 3 d f 0.725 0.725 0.725 c 1142 1647 m -2 -5 d 1 -7
- d 1 2 d f 0.75 0.75 0.75 c 1140 1642 m -1 -4 d -6 Y 2 3 d f 0.775 0.775 0.775 c
- 1139 1638 m -1 -4 d -5 Y 1 3 d f 0.8 0.8 0.8 c 1138 1634 m -2 -5 d -3 Y 2 3 d f
- 0.825 0.825 0.825 c 1136 1629 m -1 -4 d -1 Y 1 2 d f 0.85 0.85 0.85 c 1135 1625
- m -2 -4 d 2 3 d f 0.525 0.525 0.525 c 1152 1661 m 2 -2 d -2 -2 d f 0.55 0.55
- 0.55 c 1151 1663 m 1 -2 d -4 Y -1 -3 d f 0.575 0.575 0.575 c 1149 1666 m 2 -3 d
- -9 Y -1 -3 d f 0.6 0.6 0.6 c 1148 1668 m 1 -2 d 1 -15 d -2 -3 d f 0.625 0.625
- 0.625 c 1146 1670 m 2 -2 d -20 Y -1 -2 d f 0.65 0.65 0.65 c 1145 1672 m 1 -2 d
- 1 -24 d -2 -3 d f 0.675 0.675 0.675 c 1143 1675 m 2 -3 d -29 Y -1 -3 d f 0.7
- 0.7 0.7 c 1142 1677 m 1 -2 d 1 -35 d -2 -3 d f 0.725 0.725 0.725 c 1140 1679 m
- 2 -2 d -40 Y -1 -2 d f 0.75 0.75 0.75 c 1139 1681 m 1 -2 d 1 -44 d -2 -3 d f
- 0.775 0.775 0.775 c 1137 1684 m 2 -3 d -49 Y -1 -3 d f 0.8 0.8 0.8 c 1136 1686
- m 1 -2 d 1 -55 d -2 -3 d f 0.825 0.825 0.825 c 1134 1688 m 2 -2 d -60 Y -1 -2 d
- f 0.85 0.85 0.85 c 1132 1690 m 2 -2 d 1 -64 d -2 -3 d 4 Y f 0.875 0.875 0.875 c
- 1131 1693 m 1 -3 d 1 -65 d -19 138 d f 0.9 0.9 0.9 c 1130 1694 m 1 -1 d -17 70
- d -4 27 d f 0.425 0.425 0.425 c 1088 1682 m -2 -6 d 2 -3 d f 0.45 0.45 0.45 c
- 1089 1688 m -1 -6 d -9 Y 1 -3 d f 0.475 0.475 0.475 c 1090 1694 m -1 -6 d -18 Y
- 1 -3 d f 0.5 0.5 0.5 c 1091 1700 m -1 -6 d -27 Y 1 -3 d f 0.525 0.525 0.525 c
- 1093 1706 m -2 -6 d -36 Y 1 -3 d f 0.55 0.55 0.55 c 1094 1712 m -1 -6 d -1 -45
- d 1 -3 d f 0.575 0.575 0.575 c 1095 1718 m -1 -6 d -1 -54 d 1 -3 d f 0.6 0.6
- 0.6 c 1096 1723 m -1 -5 d -1 -63 d 1 -3 d f 0.625 0.625 0.625 c 1097 1729 m -1
- -6 d -1 -71 d 1 -3 d f 0.65 0.65 0.65 c 1099 1735 m -2 -6 d -1 -80 d 1 -3 d f
- 0.675 0.675 0.675 c 1100 1741 m -1 -6 d -2 -89 d 1 -3 d f 0.7 0.7 0.7 c 1101
- 1747 m -1 -6 d -2 -98 d 2 -3 d f 0.725 0.725 0.725 c 1102 1753 m -1 -6 d -1
- -107 d 1 -3 d f 0.75 0.75 0.75 c 1104 1759 m -2 -6 d -1 -116 d 1 -3 d f 0.775
- 0.775 0.775 c 1105 1765 m -1 -6 d -2 -125 d 1 -3 d f 0.8 0.8 0.8 c 1106 1771 m
- -1 -6 d -2 -134 d 1 -3 d f 0.825 0.825 0.825 c 1107 1777 m -1 -6 d -2 -143 d 1
- -3 d f 0.85 0.85 0.85 c 1108 1783 m -1 -6 d -2 -152 d 1 -3 d f 0.875 0.875
- 0.875 c 1107 1620 m 11 34 d -8 135 d -2 -6 d -2 -161 d f 0.9 0.9 0.9 c 1118
- 1654 m 12 40 d -20 96 d -1 Y f 0.425 0.425 0.425 c 1088 1673 m -2 3 d -23 75 d
- 1 11 d f 0.45 0.45 0.45 c 1089 1670 m -1 3 d -24 89 d 2 12 d f 0.475 0.475
- 0.475 c 1090 1667 m -1 3 d -23 104 d 1 11 d f 0.5 0.5 0.5 c 1091 1664 m -1 3 d
- -23 118 d 2 11 d f 0.525 0.525 0.525 c 1092 1661 m -1 3 d -22 132 d 1 12 d f
- 0.55 0.55 0.55 c 1093 1658 m -1 3 d -22 147 d 2 11 d f 0.575 0.575 0.575 c 1094
- 1655 m -1 3 d -21 161 d 1 11 d f 0.6 0.6 0.6 c 1095 1652 m -1 3 d -21 175 d 2
- 12 d f 0.625 0.625 0.625 c 1096 1649 m -1 3 d -20 190 d 1 11 d f 0.65 0.65 0.65
- c 1097 1646 m -1 3 d -20 204 d 1 11 d f 0.675 0.675 0.675 c 1098 1643 m -1 3 d
- -20 218 d 2 12 d f 0.7 0.7 0.7 c 1100 1640 m -2 3 d -19 233 d 1 11 d f 0.725
- 0.725 0.725 c 1101 1637 m -1 3 d -20 247 d 2 11 d f 0.75 0.75 0.75 c 1102 1634
- m -1 3 d -19 261 d 1 12 d f 0.775 0.775 0.775 c 1083 1910 m 5 -62 d 15 -217 d
- -1 3 d -19 276 d f 0.8 0.8 0.8 c 1088 1848 m 5 -63 d 11 -157 d -1 3 d f 0.825
- 0.825 0.825 c 1093 1785 m 6 -63 d 6 -97 d -1 3 d f 0.85 0.85 0.85 c 1099 1722 m
- 5 -63 d 2 -37 d -1 3 d f 0.875 0.875 0.875 c 1104 1659 m 3 -39 d -1 2 d f 0.425
- 0.425 0.425 c 1064 1762 m -1 -11 d -9 8 d f 0.45 0.45 0.45 c 1066 1774 m -2 -12
- d -10 -3 d -9 8 d f 0.475 0.475 0.475 c 1067 1785 m -1 -11 d -21 -7 d -6 5 d 1
- -8 d f 0.5 0.5 0.5 c 1069 1796 m -2 -11 d -27 -21 d 2 -19 d f 0.525 0.525 0.525
- c 1070 1808 m -1 -12 d -27 -51 d 2 -19 d f 0.55 0.55 0.55 c 1072 1819 m -2 -11
- d -26 -82 d 2 -19 d f 0.575 0.575 0.575 c 1073 1830 m -1 -11 d -26 -112 d 1 -19
- d f 0.6 0.6 0.6 c 1075 1842 m -2 -12 d -26 -142 d 2 -19 d f 0.625 0.625 0.625 c
- 1076 1853 m -1 -11 d -26 -173 d 2 -19 d f 0.65 0.65 0.65 c 1077 1864 m -1 -11 d
- -25 -203 d 2 -19 d f 0.675 0.675 0.675 c 1079 1876 m -2 -12 d -24 -233 d 1 -19
- d f 0.7 0.7 0.7 c 1080 1887 m -1 -11 d -25 -264 d 2 -19 d f 0.725 0.725 0.725 c
- 1082 1898 m -2 -11 d -24 -294 d 2 -19 d f 0.75 0.75 0.75 c 1083 1910 m -1 -12 d
- -24 -324 d 2 -18 d f 0.775 0.775 0.775 c 1060 1555 m 23 355 d -23 -354 d f
- 0.475 0.475 0.475 c 1036 1670 m 1 -5 d 3 99 d -1 8 d -4 -97 d f 0.5 0.5 0.5 c
- 1037 1665 m 2 -10 d 3 90 d -2 19 d -1 8 d -3 2 d -2 -88 d 1 -11 d f 0.525 0.525
- 0.525 c 1039 1655 m 2 -10 d 3 81 d -2 19 d -6 29 d -2 2 d -2 -79 d 2 -11 d f
- 0.55 0.55 0.55 c 1041 1645 m 2 -10 d 3 72 d -2 19 d -10 50 d -2 2 d -2 -69 d 2
- -12 d f 0.575 0.575 0.575 c 1043 1635 m 2 -10 d 2 63 d -1 19 d -14 71 d -2 2 d
- -2 -60 d 2 -11 d f 0.6 0.6 0.6 c 1045 1625 m 2 -10 d 2 54 d -2 19 d -17 92 d -2
- 2 d -2 -51 d 2 -11 d f 0.625 0.625 0.625 c 1047 1615 m 3 -10 d 1 45 d -2 19 d
- -21 113 d -2 2 d -2 -42 d 2 -11 d f 0.65 0.65 0.65 c 1050 1605 m 2 -10 d 1 36 d
- -2 19 d -25 134 d -3 2 d -1 -32 d 2 -12 d f 0.675 0.675 0.675 c 1052 1595 m 2
- -10 d 27 Y -1 19 d -30 155 d -2 2 d -23 Y 1 -11 d f 0.7 0.7 0.7 c 1054 1585 m 2
- -10 d 18 Y -2 19 d -33 176 d -2 2 d -14 Y 2 -11 d f 0.725 0.725 0.725 c 1056
- 1575 m 2 -10 d 9 Y -2 19 d -37 197 d -2 2 d -5 Y 2 -11 d f 0.75 0.75 0.75 c
- 1058 1565 m 2 -10 d 1 Y -2 18 d -41 218 d -1 1 d 1 -6 d f 0.775 0.775 0.775 c
- 1060 1555 m 1 Y f 0.475 0.475 0.475 c 1035 1670 m 1 X -1 5 d f 0.5 0.5 0.5 c
- 1033 1672 m 2 -2 d 5 Y -1 11 d f 0.525 0.525 0.525 c 1031 1674 m 2 -2 d 1 14 d
- -2 11 d f 0.55 0.55 0.55 c 1029 1676 m 2 -2 d 1 23 d -2 12 d f 0.575 0.575
- 0.575 c 1028 1677 m 1 -1 d 1 33 d -2 11 d f 0.6 0.6 0.6 c 1026 1679 m 2 -2 d 43
- Y -2 11 d f 0.625 0.625 0.625 c 1024 1681 m 2 -2 d 52 Y -2 11 d f 0.65 0.65
- 0.65 c 1022 1683 m 2 -2 d 61 Y -2 12 d f 0.675 0.675 0.675 c 1020 1684 m 2 -1 d
- 71 Y -1 11 d f 0.7 0.7 0.7 c 1018 1686 m 2 -2 d 1 81 d -2 11 d f 0.725 0.725
- 0.725 c 1016 1688 m 2 -2 d 1 90 d -2 11 d f 0.75 0.75 0.75 c 1014 1690 m 2 -2 d
- 1 99 d -1 6 d -3 -1 d f 0.775 0.775 0.775 c 1013 1690 m 1 X -1 102 d -5 -1 d 2
- -86 d f 0.8 0.8 0.8 c 1008 1791 m -5 -2 d 1 -57 d 6 -27 d f 0.825 0.825 0.825 c
- 1003 1789 m -5 -1 d -28 Y 6 -28 d f 0.85 0.85 0.85 c 998 1788 m -6 -1 d 6 -27 d
- f 0.675 0.675 0.675 c 989 1523 m 3 21 d -4 -4 d f 0.7 0.7 0.7 c 992 1544 m 6 42
- d -13 -13 d 3 -33 d f 0.725 0.725 0.725 c 998 1586 m 6 42 d -22 -21 d 3 -34 d f
- 0.75 0.75 0.75 c 1004 1628 m 6 43 d -32 -31 d 4 -33 d f 0.775 0.775 0.775 c
- 1010 1671 m 3 19 d -3 15 d -35 -31 d 3 -34 d f 0.8 0.8 0.8 c 1010 1705 m -6 27
- d -32 -24 d 3 -34 d f 0.825 0.825 0.825 c 1004 1732 m -6 28 d -28 -18 d -1 -2 d
- 3 -32 d f 0.85 0.85 0.85 c 998 1760 m -6 27 d -22 -45 d f 0.475 0.475 0.475 c
- 966 1558 m 1 -2 d -2 5 d f 0.5 0.5 0.5 c 967 1556 m 3 -4 d -6 22 d 1 -13 d f
- 0.525 0.525 0.525 c 970 1552 m 3 -4 d -10 38 d 1 -12 d f 0.55 0.55 0.55 c 973
- 1548 m 3 -5 d -15 56 d 2 -13 d f 0.575 0.575 0.575 c 976 1543 m 3 -4 d -19 72 d
- 1 -12 d f 0.6 0.6 0.6 c 979 1539 m 3 -5 d -23 90 d 1 -13 d f 0.625 0.625 0.625
- c 982 1534 m 3 -4 d -28 107 d 2 -13 d f 0.65 0.65 0.65 c 985 1530 m 3 -4 d -32
- 123 d 1 -12 d f 0.675 0.675 0.675 c 988 1526 m 1 -3 d -1 17 d -33 122 d 1 -13 d
- f 0.7 0.7 0.7 c 988 1540 m -3 33 d -32 102 d 2 -13 d f 0.725 0.725 0.725 c 985
- 1573 m -3 34 d -30 80 d 1 -12 d f 0.75 0.75 0.75 c 982 1607 m -4 33 d -27 60 d
- 1 -13 d f 0.775 0.775 0.775 c 978 1640 m -3 34 d -26 39 d 2 -13 d f 0.8 0.8 0.8
- c 975 1674 m -3 34 d -24 17 d 1 -12 d f 0.825 0.825 0.825 c 972 1708 m -3 32 d
- -1 1 d -21 -3 d 1 -13 d f 0.85 0.85 0.85 c 968 1741 m -22 7 d 1 -10 d f 0.475
- 0.475 0.475 c 961 1573 m 5 -15 d -1 3 d f 0.5 0.5 0.5 c 943 1631 m 18 -58 d 4
- -12 d -1 13 d -40 143 d -2 -2 d 20 -81 d f 0.525 0.525 0.525 c 942 1632 m 1 -1
- d 21 -57 d -1 12 d -38 133 d -1 -2 d 18 -83 d f 0.55 0.55 0.55 c 963 1586 m -2
- 13 d -34 122 d -2 -2 d f 0.575 0.575 0.575 c 961 1599 m -1 12 d -32 113 d -1 -3
- d f 0.6 0.6 0.6 c 960 1611 m -1 13 d -29 102 d -2 -2 d f 0.625 0.625 0.625 c
- 959 1624 m -2 13 d -26 91 d -1 -2 d f 0.65 0.65 0.65 c 957 1637 m -1 12 d -23
- 81 d -2 -2 d f 0.675 0.675 0.675 c 956 1649 m -1 13 d -20 71 d -2 -3 d f 0.7
- 0.7 0.7 c 955 1662 m -2 13 d -17 60 d -1 -2 d f 0.725 0.725 0.725 c 953 1675 m
- -1 12 d -14 50 d -2 -2 d f 0.75 0.75 0.75 c 952 1687 m -1 13 d -12 39 d -1 -2 d
- f 0.775 0.775 0.775 c 951 1700 m -2 13 d -8 29 d -2 -3 d f 0.8 0.8 0.8 c 949
- 1713 m -1 12 d -5 19 d -2 -2 d f 0.825 0.825 0.825 c 948 1725 m -1 13 d -3 8 d
- -1 -2 d f 0.85 0.85 0.85 c 947 1738 m -1 10 d -2 -2 d f 0.475 0.475 0.475 c 919
- 1640 m 10 -3 d -11 3 d f 0.5 0.5 0.5 c 929 1637 m 13 -5 d 2 Y -20 81 d -1 -5 d
- -4 -70 d 1 X f 0.525 0.525 0.525 c 942 1632 m 2 Y -21 76 d -2 -5 d -4 -65 d 2 X
- f 0.55 0.55 0.55 c 919 1705 m -2 -5 d -3 -60 d 1 X f 0.575 0.575 0.575 c 917
- 1700 m -1 -5 d -3 -55 d 1 X f 0.6 0.6 0.6 c 916 1695 m -2 -5 d -3 -50 d 2 X f
- 0.625 0.625 0.625 c 914 1690 m -2 -5 d -2 -44 d 1 -1 d f 0.65 0.65 0.65 c 912
- 1685 m -1 -5 d -2 -39 d 1 X f 0.675 0.675 0.675 c 911 1680 m -2 -5 d -2 -34 d 2
- X f 0.7 0.7 0.7 c 909 1675 m -1 -5 d -2 -29 d 1 X f 0.725 0.725 0.725 c 908
- 1670 m -2 -5 d -1 -24 d 1 X f 0.75 0.75 0.75 c 906 1665 m -2 -5 d -1 -19 d 2 X
- f 0.775 0.775 0.775 c 904 1660 m -1 -5 d -1 -14 d 1 X f 0.8 0.8 0.8 c 903 1655
- m -2 -5 d -8 Y 1 -1 d f 0.825 0.825 0.825 c 901 1650 m -1 -5 d -1 -3 d 2 X f
- 0.85 0.85 0.85 c 900 1645 m -1 -3 d f 0.475 0.475 0.475 c 913 1626 m 6 14 d -1
- X f 0.5 0.5 0.5 c 906 1607 m 7 19 d 5 14 d -1 X f 0.525 0.525 0.525 c 898 1587
- m 8 20 d 11 33 d -2 X f 0.55 0.55 0.55 c 895 1580 m 3 7 d 17 53 d -1 X -20 -53
- d f 0.575 0.575 0.575 c 914 1640 m -1 X -22 -42 d 3 -11 d f 0.6 0.6 0.6 c 913
- 1640 m -2 X -23 -31 d 3 -11 d f 0.625 0.625 0.625 c 911 1640 m -1 1 d -24 -21 d
- 2 -11 d f 0.65 0.65 0.65 c 910 1641 m -1 X -26 -10 d 3 -11 d f 0.675 0.675
- 0.675 c 909 1641 m -2 X -27 1 d 3 -11 d f 0.7 0.7 0.7 c 907 1641 m -1 X -29 12
- d 3 -11 d f 0.725 0.725 0.725 c 906 1641 m -1 X -29 21 d -1 1 d 2 -10 d f 0.75
- 0.75 0.75 c 905 1641 m -2 X -22 17 d -5 4 d f 0.775 0.775 0.775 c 903 1641 m -1
- X -17 12 d -4 5 d f 0.8 0.8 0.8 c 902 1641 m -1 1 d -11 7 d -5 4 d f 0.825
- 0.825 0.825 c 901 1642 m -2 X -4 3 d -5 4 d f 0.85 0.85 0.85 c 899 1642 m -4 3
- d f 0.425 0.425 0.425 c 852 1630 m 1 -3 d f 0.45 0.45 0.45 c 854 1633 m -2 -3 d
- 1 -3 d 9 -26 d f 0.475 0.475 0.475 c 856 1636 m -2 -3 d 8 -32 d 9 -26 d f 0.5
- 0.5 0.5 c 872 1574 m 9 2 d -23 62 d -2 -2 d 15 -61 d f 0.525 0.525 0.525 c 881
- 1576 m 10 3 d -31 62 d -2 -3 d f 0.55 0.55 0.55 c 891 1579 m 4 1 d -1 7 d -32
- 57 d -2 -3 d f 0.575 0.575 0.575 c 894 1587 m -3 11 d -27 49 d -2 -3 d f 0.6
- 0.6 0.6 c 891 1598 m -3 11 d -22 40 d -2 -2 d f 0.625 0.625 0.625 c 888 1609 m
- -2 11 d -19 32 d -1 -3 d f 0.65 0.65 0.65 c 886 1620 m -3 11 d -14 24 d -2 -3 d
- f 0.675 0.675 0.675 c 883 1631 m -3 11 d -9 16 d -2 -3 d f 0.7 0.7 0.7 c 880
- 1642 m -3 11 d -4 7 d -2 -2 d f 0.725 0.725 0.725 c 877 1653 m -2 10 d -2 -3 d
- f 0.425 0.425 0.425 c 848 1662 m 8 -29 d -3 -6 d -1 3 d -7 -35 d -12 -57 d f
- 0.45 0.45 0.45 c 856 1633 m 8 -29 d -2 -3 d -9 26 d -8 -32 d -17 -92 d 5 35 d f
- 0.475 0.475 0.475 c 864 1604 m 8 -29 d -1 X -9 26 d f 0.5 0.5 0.5 c 872 1575 m
- -1 Y -1 1 d f 0.425 0.425 0.425 c 837 1678 m 11 -16 d -15 -124 d -10 -24 d -18
- 37 d 9 69 d f 0.45 0.45 0.45 c 826 1695 m 11 -17 d -4 -140 d -5 -35 d -5 11 d
- -9 106 d 10 69 d f 0.475 0.475 0.475 c 825 1696 m 1 -1 d -2 -6 d f 0.425 0.425
- 0.425 c 801 1623 m 12 35 d 1 -38 d -9 -69 d -2 2 d -3 67 d f 0.45 0.45 0.45 c
- 813 1658 m 11 34 d -3 Y -10 -69 d -11 -67 d -2 3 d -3 61 d 2 3 d f 0.475 0.475
- 0.475 c 824 1692 m 1 4 d -1 -7 d -23 -133 d -2 3 d -3 55 d 2 3 d f 0.5 0.5 0.5
- c 799 1559 m -2 3 d -2 49 d 1 3 d f 0.525 0.525 0.525 c 797 1562 m -2 3 d -2 43
- d 2 3 d f 0.55 0.55 0.55 c 795 1565 m -2 2 d -1 38 d 1 3 d f 0.575 0.575 0.575
- c 793 1567 m -2 3 d -1 32 d 2 3 d f 0.6 0.6 0.6 c 791 1570 m -2 3 d -1 25 d 2 4
- d f 0.625 0.625 0.625 c 789 1573 m -2 3 d 19 Y 1 3 d f 0.65 0.65 0.65 c 787
- 1576 m -1 3 d -1 13 d 2 3 d f 0.675 0.675 0.675 c 786 1579 m -2 2 d -1 8 d 2 3
- d f 0.7 0.7 0.7 c 784 1581 m -2 3 d 2 Y 1 3 d f 0.725 0.725 0.725 c 782 1584 m
- -1 1 d 1 1 d f 0.425 0.425 0.425 c 778 1537 m 23 86 d -1 -3 d -31 -71 d f 0.45
- 0.45 0.45 c 800 1620 m -2 -3 d -40 -51 d 11 -17 d f 0.475 0.475 0.475 c 798
- 1617 m -2 -3 d -36 -46 d -2 -2 d f 0.5 0.5 0.5 c 796 1614 m -1 -3 d -33 -42 d
- -2 -1 d f 0.525 0.525 0.525 c 795 1611 m -2 -3 d -28 -37 d -3 -2 d f 0.55 0.55
- 0.55 c 793 1608 m -1 -3 d -25 -32 d -2 -2 d f 0.575 0.575 0.575 c 792 1605 m -2
- -3 d -21 -27 d -2 -2 d f 0.6 0.6 0.6 c 790 1602 m -2 -4 d -17 -21 d -2 -2 d f
- 0.625 0.625 0.625 c 788 1598 m -1 -3 d -13 -16 d -3 -2 d f 0.65 0.65 0.65 c 787
- 1595 m -2 -3 d -9 -11 d -2 -2 d f 0.675 0.675 0.675 c 785 1592 m -2 -3 d -5 -6
- d -2 -2 d f 0.7 0.7 0.7 c 783 1589 m -1 -3 d -2 -2 d -2 -1 d f 0.725 0.725
- 0.725 c 782 1586 m -1 -1 d -1 -1 d f 0.425 0.425 0.425 c 754 1410 m 24 127 d -9
- 12 d -16 -132 d f 0.45 0.45 0.45 c 769 1549 m -11 17 d -6 -142 d 1 -7 d f 0.475
- 0.475 0.475 c 758 1566 m -2 -2 d -5 -133 d 1 -7 d f 0.5 0.5 0.5 c 756 1564 m -1
- -1 d -5 -124 d 1 -8 d f 0.525 0.525 0.525 c 755 1563 m -2 -1 d -4 -116 d 1 -7 d
- f 0.55 0.55 0.55 c 753 1562 m -1 -1 d -4 -108 d 1 -7 d f 0.575 0.575 0.575 c
- 752 1561 m -1 -1 d -4 -100 d 1 -7 d f 0.6 0.6 0.6 c 751 1560 m -2 -1 d -3 -91 d
- 1 -8 d f 0.625 0.625 0.625 c 749 1559 m -1 -2 d -3 -82 d 1 -7 d f 0.65 0.65
- 0.65 c 748 1557 m -2 -1 d -2 -74 d 1 -7 d f 0.675 0.675 0.675 c 746 1556 m -1
- -1 d -2 -66 d 1 -7 d f 0.7 0.7 0.7 c 745 1555 m -1 -1 d -2 -57 d 1 -8 d f 0.725
- 0.725 0.725 c 744 1554 m -2 -1 d -2 -49 d 2 -7 d f 0.75 0.75 0.75 c 742 1553 m
- -1 -1 d -2 -41 d 1 -7 d f 0.775 0.775 0.775 c 741 1552 m -2 -1 d -1 -33 d 1 -7
- d f 0.8 0.8 0.8 c 739 1551 m -1 -2 d -1 -23 d 1 -8 d f 0.825 0.825 0.825 c 738
- 1549 m -1 -1 d -1 -15 d 1 -7 d f 0.85 0.85 0.85 c 737 1548 m -2 -1 d -7 Y 1 -7
- d f 0.875 0.875 0.875 c 735 1547 m -1 -1 d 1 -6 d f 0.425 0.425 0.425 c 731
- 1646 m 23 -236 d -1 7 d -41 276 d -1 8 d f 0.45 0.45 0.45 c 753 1417 m -1 7 d
- -39 261 d -1 8 d f 0.475 0.475 0.475 c 752 1424 m -1 7 d -37 246 d -1 8 d f 0.5
- 0.5 0.5 c 751 1431 m -1 8 d -34 230 d -2 8 d f 0.525 0.525 0.525 c 750 1439 m
- -1 7 d -32 214 d -1 9 d f 0.55 0.55 0.55 c 749 1446 m -1 7 d -30 199 d -1 8 d f
- 0.575 0.575 0.575 c 748 1453 m -1 7 d -28 184 d -1 8 d f 0.6 0.6 0.6 c 747 1460
- m -1 8 d -25 168 d -2 8 d f 0.625 0.625 0.625 c 746 1468 m -1 7 d -23 152 d -1
- 9 d f 0.65 0.65 0.65 c 745 1475 m -1 7 d -21 137 d -1 8 d f 0.675 0.675 0.675 c
- 744 1482 m -1 7 d -19 122 d -1 8 d f 0.7 0.7 0.7 c 743 1489 m -1 8 d -16 106 d
- -2 8 d f 0.725 0.725 0.725 c 742 1497 m -2 7 d -13 90 d -1 9 d f 0.75 0.75 0.75
- c 740 1504 m -1 7 d -11 75 d -1 8 d f 0.775 0.775 0.775 c 739 1511 m -1 7 d -9
- 60 d -1 8 d f 0.8 0.8 0.8 c 738 1518 m -1 8 d -6 44 d -2 8 d f 0.825 0.825
- 0.825 c 737 1526 m -1 7 d -4 28 d -1 9 d f 0.85 0.85 0.85 c 736 1533 m -1 7 d
- -2 13 d -1 8 d f 0.875 0.875 0.875 c 735 1540 m -1 6 d -1 7 d f 0.425 0.425
- 0.425 c 731 1644 m 2 Y -20 55 d -2 -5 d f 0.45 0.45 0.45 c 729 1635 m 2 9 d -22
- 52 d -1 -5 d f 0.475 0.475 0.475 c 728 1626 m 1 9 d -21 56 d -1 -5 d f 0.5 0.5
- 0.5 c 727 1617 m 1 9 d -21 60 d -1 -6 d f 0.525 0.525 0.525 c 726 1608 m 1 9 d
- -21 63 d -2 -5 d f 0.55 0.55 0.55 c 724 1599 m 2 9 d -22 67 d -1 -5 d f 0.575
- 0.575 0.575 c 723 1590 m 1 9 d -21 71 d -1 -6 d f 0.6 0.6 0.6 c 722 1581 m 1 9
- d -21 74 d -1 -5 d f 0.625 0.625 0.625 c 721 1572 m 1 9 d -21 78 d -2 -5 d f
- 0.65 0.65 0.65 c 719 1563 m 2 9 d -22 82 d -1 -6 d f 0.675 0.675 0.675 c 718
- 1554 m 1 9 d -21 85 d -1 -5 d f 0.7 0.7 0.7 c 717 1545 m 1 9 d -21 89 d -1 -5 d
- f 0.725 0.725 0.725 c 716 1536 m 1 9 d -21 93 d -2 -5 d f 0.75 0.75 0.75 c 714
- 1527 m 2 9 d -22 97 d -1 -6 d f 0.775 0.775 0.775 c 713 1518 m 1 9 d -21 100 d
- -1 -5 d f 0.8 0.8 0.8 c 712 1509 m 1 9 d -21 104 d -1 -5 d f 0.825 0.825 0.825
- c 711 1500 m 1 9 d -21 108 d -2 -6 d f 0.85 0.85 0.85 c 709 1491 m 2 9 d -22
- 111 d -1 -5 d f 0.875 0.875 0.875 c 708 1482 m 1 9 d -21 115 d -1 -5 d 5 -30 d
- f 0.9 0.9 0.9 c 707 1478 m 1 4 d -16 89 d f 0.425 0.425 0.425 c 665 1583 m -1
- -1 d 1 2 d f 0.45 0.45 0.45 c 666 1584 m -1 -1 d 1 Y 1 2 d f 0.475 0.475 0.475
- c 667 1585 m -1 -1 d 2 Y 1 2 d f 0.5 0.5 0.5 c 669 1586 m -2 -1 d 3 Y 1 2 d f
- 0.525 0.525 0.525 c 670 1587 m -1 -1 d -1 4 d 1 2 d f 0.55 0.55 0.55 c 671 1588
- m -1 -1 d -1 5 d 1 2 d f 0.575 0.575 0.575 c 672 1589 m -1 -1 d -1 6 d 1 2 d f
- 0.6 0.6 0.6 c 674 1590 m -2 -1 d -1 7 d 1 2 d f 0.625 0.625 0.625 c 675 1591 m
- -1 -1 d -2 8 d 1 2 d f 0.65 0.65 0.65 c 676 1592 m -1 -1 d -2 9 d 1 2 d f 0.675
- 0.675 0.675 c 677 1593 m -1 -1 d -2 10 d 1 2 d f 0.7 0.7 0.7 c 679 1594 m -2 -1
- d -2 11 d 1 2 d f 0.725 0.725 0.725 c 680 1595 m -1 -1 d -3 12 d 1 2 d f 0.75
- 0.75 0.75 c 681 1596 m -1 -1 d -3 13 d 1 2 d f 0.775 0.775 0.775 c 682 1597 m
- -1 -1 d -3 14 d 2 2 d f 0.8 0.8 0.8 c 684 1598 m -2 -1 d -2 15 d 1 2 d f 0.825
- 0.825 0.825 c 685 1599 m -1 -1 d -3 16 d 1 2 d f 0.85 0.85 0.85 c 686 1601 m -1
- -2 d -3 17 d 1 2 d f 0.875 0.875 0.875 c 692 1571 m -5 30 d -1 X -3 17 d 1 2 d
- f 0.9 0.9 0.9 c 684 1620 m 23 -142 d -15 93 d -8 49 d f 0.425 0.425 0.425 c 665
- 1584 m -1 -2 d -4 -105 d f 0.45 0.45 0.45 c 666 1586 m -1 -2 d -5 -107 d -4
- -106 d f 0.475 0.475 0.475 c 667 1588 m -1 -2 d -10 -215 d -4 -105 d f 0.5 0.5
- 0.5 c 668 1590 m -1 -2 d -15 -322 d -4 -105 d f 0.525 0.525 0.525 c 669 1592 m
- -1 -2 d -20 -429 d -4 -105 d f 0.55 0.55 0.55 c 670 1594 m -1 -2 d -25 -536 d
- -4 -106 d f 0.575 0.575 0.575 c 660 929 m 2 47 d 9 620 d -1 -2 d -30 -644 d -5
- Y f 0.6 0.6 0.6 c 662 976 m 2 53 d 8 569 d -1 -2 d f 0.625 0.625 0.625 c 664
- 1029 m 2 52 d 7 519 d -1 -2 d f 0.65 0.65 0.65 c 666 1081 m 1 53 d 7 468 d -1
- -2 d f 0.675 0.675 0.675 c 667 1134 m 2 52 d 6 418 d -1 -2 d f 0.7 0.7 0.7 c
- 669 1186 m 2 53 d 5 367 d -1 -2 d f 0.725 0.725 0.725 c 671 1239 m 2 53 d 4 316
- d -1 -2 d f 0.75 0.75 0.75 c 673 1292 m 2 52 d 3 266 d -1 -2 d f 0.775 0.775
- 0.775 c 675 1344 m 1 53 d 4 215 d -2 -2 d f 0.8 0.8 0.8 c 676 1397 m 2 53 d 3
- 164 d -1 -2 d f 0.825 0.825 0.825 c 678 1450 m 2 52 d 2 114 d -1 -2 d f 0.85
- 0.85 0.85 c 680 1502 m 2 53 d 1 63 d -1 -2 d f 0.875 0.875 0.875 c 682 1555 m 2
- 52 d 13 Y -1 -2 d f 0.9 0.9 0.9 c 684 1607 m 13 Y f 0.55 0.55 0.55 c 637 923 m
- 2 1 d -19 15 d -3 X f 0.575 0.575 0.575 c 639 924 m 21 5 d -20 16 d -20 -6 d f
- 0.55 0.55 0.55 c 614 917 m 23 6 d -20 16 d -24 -6 d f 590 911 m 24 6 d -21 16 d
- -23 -6 d f 1691 1171 m 23 6 d -20 15 d -23 -6 d f 1667 1165 m 24 6 d -20 15 d
- -24 -6 d f 1644 1159 m 23 6 d -20 15 d -23 -6 d f 0.425 0.425 0.425 c 1620 1596
- m 4 -74 d -6 108 d f 0.45 0.45 0.45 c 1624 1522 m 4 -75 d -12 217 d 2 -34 d f
- 0.475 0.475 0.475 c 1628 1447 m 4 -74 d -17 324 d 1 -33 d f 0.5 0.5 0.5 c 1632
- 1373 m 4 -74 d -23 432 d 2 -34 d f 0.525 0.525 0.525 c 1636 1299 m 4 -75 d -29
- 541 d 2 -34 d f 0.55 0.55 0.55 c 1640 1224 m 4 -65 d -20 15 d -1 20 d -14 605 d
- 2 -34 d f 0.575 0.575 0.575 c 1623 1194 m -5 171 d -11 467 d 2 -33 d f 0.6 0.6
- 0.6 c 1618 1365 m -5 171 d -8 330 d 2 -34 d f 0.625 0.625 0.625 c 1613 1536 m
- -6 172 d -4 192 d 2 -34 d f 0.65 0.65 0.65 c 1607 1708 m -5 171 d -1 55 d 2 -34
- d f 0.675 0.675 0.675 c 1602 1879 m -2 68 d 1 -13 d f 0.425 0.425 0.425 c 1616
- 1600 m 4 -4 d -2 34 d f 0.45 0.45 0.45 c 1611 1604 m 5 -4 d 2 30 d -2 34 d f
- 0.475 0.475 0.475 c 1606 1609 m 5 -5 d 5 60 d -1 33 d f 0.5 0.5 0.5 c 1602 1613
- m 4 -4 d 9 88 d -2 34 d f 0.525 0.525 0.525 c 1597 1617 m 5 -4 d 11 118 d -2 34
- d f 0.55 0.55 0.55 c 1597 1617 m 14 148 d -2 34 d -14 -171 d f 0.575 0.575
- 0.575 c 1609 1799 m -2 33 d -14 -193 d 2 -11 d f 0.6 0.6 0.6 c 1607 1832 m -2
- 34 d -14 -216 d 2 -11 d f 0.625 0.625 0.625 c 1605 1866 m -2 34 d -14 -239 d 2
- -11 d f 0.65 0.65 0.65 c 1603 1900 m -2 34 d -14 -262 d 2 -11 d f 0.675 0.675
- 0.675 c 1601 1934 m -1 13 d -3 -29 d -12 -235 d 2 -11 d f 0.7 0.7 0.7 c 1597
- 1918 m -5 -49 d -9 -175 d 2 -11 d f 0.725 0.725 0.725 c 1592 1869 m -5 -49 d -6
- -115 d 2 -11 d f 0.75 0.75 0.75 c 1587 1820 m -6 -49 d -3 -55 d 3 -11 d f 0.775
- 0.775 0.775 c 1581 1771 m -4 -45 d 1 -10 d f 0.475 0.475 0.475 c 1554 1990 m -1
- 13 d 1 -20 d f 0.5 0.5 0.5 c 1556 1968 m -2 22 d -7 Y 2 -34 d f 0.525 0.525
- 0.525 c 1558 1946 m -2 22 d -19 Y 3 -34 d f 0.55 0.55 0.55 c 1594 1626 m 3 -9 d
- -2 11 d -35 296 d -2 22 d 1 -31 d 2 -34 d f 0.575 0.575 0.575 c 1590 1634 m 4
- -8 d 1 2 d -2 11 d -31 263 d -2 22 d 1 -43 d 2 -34 d f 0.6 0.6 0.6 c 1587 1643
- m 3 -9 d 3 5 d -2 11 d -27 230 d -2 22 d 1 -55 d 2 -35 d f 0.625 0.625 0.625 c
- 1583 1652 m 4 -9 d 4 7 d -2 11 d -24 196 d -1 23 d 1 -68 d 2 -34 d f 0.65 0.65
- 0.65 c 1580 1661 m 3 -9 d 6 9 d -2 11 d -20 163 d -2 22 d 2 -79 d 2 -34 d f
- 0.675 0.675 0.675 c 1577 1670 m 3 -9 d 7 11 d -2 11 d -16 130 d -2 22 d 2 -91 d
- 2 -34 d f 0.7 0.7 0.7 c 1573 1678 m 4 -8 d 8 13 d -2 11 d -12 97 d -2 22 d 2
- -103 d f 0.725 0.725 0.725 c 1583 1694 m -2 11 d -8 64 d -2 22 d f 0.75 0.75
- 0.75 c 1581 1705 m -3 11 d -3 31 d -2 22 d f 0.775 0.775 0.775 c 1578 1716 m -1
- 10 d -2 21 d f 0.475 0.475 0.475 c 1554 1983 m -1 20 d -1 -3 d f 0.5 0.5 0.5 c
- 1556 1949 m -2 34 d -2 17 d -1 -5 d f 0.525 0.525 0.525 c 1559 1915 m -3 34 d
- -5 46 d -2 -5 d f 0.55 0.55 0.55 c 1561 1881 m -2 34 d -10 75 d -2 -5 d f 0.575
- 0.575 0.575 c 1563 1847 m -2 34 d -14 104 d -1 -5 d f 0.6 0.6 0.6 c 1565 1812 m
- -2 35 d -17 133 d -2 -4 d f 0.625 0.625 0.625 c 1567 1778 m -2 34 d -21 164 d
- -1 -5 d f 0.65 0.65 0.65 c 1569 1744 m -2 34 d -24 193 d -2 -5 d f 0.675 0.675
- 0.675 c 1550 1793 m 11 -52 d 10 -31 d -2 34 d -28 222 d -1 -5 d 8 -154 d f 0.7
- 0.7 0.7 c 1561 1741 m 12 -63 d -2 32 d -31 251 d -2 -5 d 7 -130 d 3 -19 d f
- 0.725 0.725 0.725 c 1538 1956 m -1 -5 d 5 -106 d 3 -19 d f 0.75 0.75 0.75 c
- 1537 1951 m -2 -5 d 4 -82 d 3 -19 d f 0.775 0.775 0.775 c 1535 1946 m -2 -5 d 3
- -58 d 3 -19 d f 0.8 0.8 0.8 c 1533 1941 m -1 -5 d 2 -34 d 2 -19 d f 0.825 0.825
- 0.825 c 1532 1936 m -2 -4 d 1 -10 d 3 -20 d f 0.85 0.85 0.85 c 1530 1932 m -2 Y
- 1 -8 d f 0.475 0.475 0.475 c 1507 1898 m -1 -1 d 4 -32 d f 0.5 0.5 0.5 c 1508
- 1900 m -1 -2 d 3 -33 d 6 -64 d f 0.525 0.525 0.525 c 1510 1902 m -2 -2 d 8 -99
- d 7 -64 d f 0.55 0.55 0.55 c 1526 1706 m 3 10 d -17 188 d -2 -2 d 13 -165 d f
- 0.575 0.575 0.575 c 1529 1716 m 5 18 d -21 173 d -1 -3 d f 0.6 0.6 0.6 c 1534
- 1734 m 5 18 d -24 157 d -2 -2 d f 0.625 0.625 0.625 c 1539 1752 m 5 18 d -28
- 141 d -1 -2 d f 0.65 0.65 0.65 c 1544 1770 m 5 19 d -31 124 d -2 -2 d f 0.675
- 0.675 0.675 c 1549 1789 m 1 4 d -2 14 d -29 108 d -1 -2 d f 0.7 0.7 0.7 c 1548
- 1807 m -3 19 d -24 92 d -2 -3 d f 0.725 0.725 0.725 c 1545 1826 m -3 19 d -19
- 75 d -2 -2 d f 0.75 0.75 0.75 c 1542 1845 m -3 19 d -15 58 d -1 -2 d f 0.775
- 0.775 0.775 c 1539 1864 m -3 19 d -10 41 d -2 -2 d f 0.8 0.8 0.8 c 1536 1883 m
- -2 19 d -7 24 d -1 -2 d f 0.825 0.825 0.825 c 1534 1902 m -3 20 d -2 7 d -2 -3
- d f 0.85 0.85 0.85 c 1531 1922 m -1 8 d -1 -1 d f 0.425 0.425 0.425 c 1503 1674
- m 2 3 d -3 -4 d f 0.45 0.45 0.45 c 1505 1677 m 5 7 d -10 -12 d 2 1 d f 0.475
- 0.475 0.475 c 1510 1684 m 5 6 d -5 175 d -4 32 d -1 -13 d -7 -213 d 2 1 d f 0.5
- 0.5 0.5 c 1515 1690 m 4 7 d -3 104 d -6 64 d -5 19 d -3 -25 d -5 -189 d 1 1 d f
- 0.525 0.525 0.525 c 1519 1697 m 5 6 d -1 34 d -7 64 d -14 58 d -2 -26 d -5 -164
- d 2 1 d f 0.55 0.55 0.55 c 1524 1703 m 2 3 d -3 31 d -23 96 d -3 -25 d -4 -140
- d 2 1 d f 0.575 0.575 0.575 c 1497 1808 m -2 -26 d -4 -115 d 2 1 d f 0.6 0.6
- 0.6 c 1495 1782 m -3 -25 d -3 -91 d 2 1 d f 0.625 0.625 0.625 c 1492 1757 m -2
- -25 d -2 -67 d 1 1 d f 0.65 0.65 0.65 c 1490 1732 m -3 -26 d -1 -42 d 2 1 d f
- 0.675 0.675 0.675 c 1487 1706 m -3 -25 d -18 Y 2 1 d f 0.7 0.7 0.7 c 1484 1681
- m -1 -19 d 1 1 d f 0.425 0.425 0.425 c 1502 1670 m 1 4 d -1 -1 d f 0.45 0.45
- 0.45 c 1500 1662 m 2 8 d 3 Y -2 -1 d f 0.475 0.475 0.475 c 1498 1654 m 2 8 d 10
- Y -2 -1 d f 0.5 0.5 0.5 c 1495 1646 m 3 8 d 17 Y -1 -1 d f 0.525 0.525 0.525 c
- 1493 1638 m 2 8 d 2 24 d -2 -1 d f 0.55 0.55 0.55 c 1491 1630 m 2 8 d 2 31 d -2
- -1 d f 0.575 0.575 0.575 c 1489 1622 m 2 8 d 2 38 d -2 -1 d f 0.6 0.6 0.6 c
- 1487 1614 m 2 8 d 2 45 d -2 -1 d f 0.625 0.625 0.625 c 1485 1607 m 2 7 d 2 52 d
- -1 -1 d f 0.65 0.65 0.65 c 1483 1599 m 2 8 d 3 58 d -2 -1 d f 0.675 0.675 0.675
- c 1480 1591 m 3 8 d 3 65 d -2 -1 d -13 94 d -12 101 d 13 -168 d f 0.7 0.7 0.7 c
- 1479 1587 m 1 4 d 4 72 d -1 -1 d -12 95 d 1 -67 d f 0.475 0.475 0.475 c 1456
- 1527 m 1 4 d -2 10 d f 0.5 0.5 0.5 c 1457 1531 m 3 6 d -6 29 d 1 -25 d f 0.525
- 0.525 0.525 c 1460 1537 m 3 7 d -10 48 d 1 -26 d f 0.55 0.55 0.55 c 1463 1544 m
- 2 7 d -14 66 d 2 -25 d f 0.575 0.575 0.575 c 1465 1551 m 3 6 d -18 86 d 1 -26 d
- f 0.6 0.6 0.6 c 1468 1557 m 2 7 d -22 104 d 2 -25 d f 0.625 0.625 0.625 c 1470
- 1564 m 3 7 d -26 123 d 1 -26 d f 0.65 0.65 0.65 c 1473 1571 m 3 6 d -30 142 d 1
- -25 d f 0.675 0.675 0.675 c 1476 1577 m 2 7 d -6 106 d -13 168 d -2 5 d -13
- -118 d 2 -26 d f 0.7 0.7 0.7 c 1478 1584 m 1 3 d -7 103 d -15 173 d -4 7 d -10
- -100 d 1 -25 d f 0.725 0.725 0.725 c 1453 1870 m -3 7 d -8 -81 d 1 -26 d f 0.75
- 0.75 0.75 c 1450 1877 m -3 6 d -7 -62 d 2 -25 d f 0.775 0.775 0.775 c 1447 1883
- m -4 7 d -4 -43 d 1 -26 d f 0.8 0.8 0.8 c 1443 1890 m -3 7 d -3 -25 d 2 -25 d f
- 0.825 0.825 0.825 c 1440 1897 m -3 7 d -1 -6 d 1 -26 d f 0.85 0.85 0.85 c 1437
- 1904 m -1 2 d -8 Y f 0.475 0.475 0.475 c 1454 1537 m 2 -10 d -1 14 d f 0.5 0.5
- 0.5 c 1452 1554 m 2 -17 d 1 4 d -1 25 d f 0.525 0.525 0.525 c 1449 1572 m 3 -18
- d 2 12 d -1 26 d f 0.55 0.55 0.55 c 1446 1589 m 3 -17 d 4 20 d -2 25 d f 0.575
- 0.575 0.575 c 1443 1607 m 3 -18 d 5 28 d -1 26 d f 0.6 0.6 0.6 c 1440 1624 m 3
- -17 d 7 36 d -2 25 d f 0.625 0.625 0.625 c 1437 1642 m 3 -18 d 8 44 d -1 26 d f
- 0.65 0.65 0.65 c 1434 1659 m 3 -17 d 10 52 d -1 25 d f 0.675 0.675 0.675 c 1432
- 1669 m 2 -10 d 12 60 d -2 26 d -17 -24 d f 0.7 0.7 0.7 c 1444 1745 m -1 25 d
- -29 70 d 13 -119 d f 0.725 0.725 0.725 c 1443 1770 m -1 26 d -26 71 d -4 -8 d 2
- -19 d f 0.75 0.75 0.75 c 1442 1796 m -2 25 d -19 55 d -5 -9 d f 0.775 0.775
- 0.775 c 1440 1821 m -1 26 d -14 38 d -4 -9 d f 0.8 0.8 0.8 c 1439 1847 m -2 25
- d -7 22 d -5 -9 d f 0.825 0.825 0.825 c 1437 1872 m -1 26 d -2 5 d -4 -9 d f
- 0.85 0.85 0.85 c 1436 1898 m 8 Y -2 -3 d f 0.525 0.525 0.525 c 1409 1717 m 3 -5
- d -6 34 d f 0.55 0.55 0.55 c 1412 1712 m 3 -8 d -13 84 d 4 -42 d f 0.575 0.575
- 0.575 c 1415 1704 m 4 -8 d -21 135 d 4 -43 d f 0.6 0.6 0.6 c 1419 1696 m 4 -7 d
- -30 184 d 5 -42 d f 0.625 0.625 0.625 c 1423 1689 m 4 -8 d -38 235 d 4 -43 d f
- 0.65 0.65 0.65 c 1427 1681 m 3 -8 d -35 230 d -6 18 d -5 Y f 0.675 0.675 0.675
- c 1430 1673 m 2 -4 d -5 52 d -24 162 d -8 20 d f 0.7 0.7 0.7 c 1427 1721 m -13
- 119 d -3 23 d -8 20 d f 0.725 0.725 0.725 c 1414 1840 m -2 19 d -1 4 d f 0.525
- 0.525 0.525 c 1407 1701 m 2 16 d -3 29 d f 0.55 0.55 0.55 c 1403 1677 m 4 24 d
- -1 45 d -4 42 d f 0.575 0.575 0.575 c 1399 1654 m 4 23 d -1 111 d -4 43 d f 0.6
- 0.6 0.6 c 1396 1630 m 3 24 d -1 177 d -5 42 d -21 -41 d -7 -38 d 3 -34 d f
- 0.625 0.625 0.625 c 1392 1606 m 4 24 d -3 243 d -4 43 d -2 -5 d -15 -79 d -4
- -72 d 6 -69 d f 0.65 0.65 0.65 c 1389 1583 m 3 23 d -3 310 d 5 Y -2 -10 d -13
- -220 d 6 -70 d f 0.675 0.675 0.675 c 1386 1563 m 3 20 d -9 38 d f 0.475 0.475
- 0.475 c 1362 1705 m 1 -8 d -2 9 d f 0.5 0.5 0.5 c 1363 1697 m 3 -17 d -7 29 d 2
- -3 d f 0.525 0.525 0.525 c 1366 1680 m 3 -17 d -12 48 d 2 -2 d f 0.55 0.55 0.55
- c 1369 1663 m 3 -17 d -16 68 d 1 -3 d f 0.575 0.575 0.575 c 1372 1646 m 3 -17 d
- -21 88 d 2 -3 d f 0.6 0.6 0.6 c 1375 1629 m 2 -17 d -9 148 d -3 34 d -2 -5 d
- -11 -70 d 2 -2 d f 0.625 0.625 0.625 c 1377 1612 m 3 -17 d -6 96 d -6 69 d -5
- 29 d -4 -10 d -9 -57 d 2 -3 d f 0.65 0.65 0.65 c 1380 1595 m 3 -18 d -3 44 d -6
- 70 d -15 88 d -4 -10 d -7 -44 d 2 -3 d f 0.675 0.675 0.675 c 1383 1577 m 3 -14
- d -6 58 d -25 148 d -3 -10 d -6 -32 d 2 -2 d f 0.7 0.7 0.7 c 1352 1759 m -4 -10
- d -3 -19 d 1 -3 d f 0.725 0.725 0.725 c 1348 1749 m -4 -10 d -1 -7 d 2 -2 d f
- 0.75 0.75 0.75 c 1344 1739 m -2 -5 d 1 -2 d f 0.475 0.475 0.475 c 1361 1707 m 1
- -2 d -1 1 d f 0.5 0.5 0.5 c 1360 1712 m 1 -5 d -1 Y -2 3 d f 0.525 0.525 0.525
- c 1358 1716 m 2 -4 d -1 -3 d -2 2 d f 0.55 0.55 0.55 c 1357 1721 m 1 -5 d -1 -5
- d -1 3 d f 0.575 0.575 0.575 c 1355 1726 m 2 -5 d -1 -7 d -2 3 d f 0.6 0.6 0.6
- c 1354 1731 m 1 -5 d -1 -9 d -2 2 d f 0.625 0.625 0.625 c 1352 1735 m 2 -4 d -2
- -12 d -2 3 d f 0.65 0.65 0.65 c 1351 1740 m 1 -5 d -2 -13 d -2 3 d f 0.675
- 0.675 0.675 c 1349 1745 m 2 -5 d -3 -15 d -2 2 d f 0.7 0.7 0.7 c 1348 1750 m 1
- -5 d -3 -18 d -1 3 d f 0.725 0.725 0.725 c 1346 1754 m 2 -4 d -3 -20 d -2 2 d
- -15 -17 d -10 -14 d 2 6 d f 0.75 0.75 0.75 c 1345 1759 m 1 -5 d -3 -22 d -1 2 d
- -14 -19 d -8 -8 d 3 13 d f 0.775 0.775 0.775 c 1343 1764 m 2 -5 d -22 -39 d 4
- 14 d f 0.8 0.8 0.8 c 1342 1769 m 1 -5 d -16 -30 d 3 14 d f 0.825 0.825 0.825 c
- 1340 1773 m 2 -4 d -12 -21 d 4 14 d f 0.85 0.85 0.85 c 1339 1778 m 1 -5 d -6
- -11 d 3 14 d f 0.875 0.875 0.875 c 1339 1780 m -2 Y -2 -2 d f 0.6 0.6 0.6 c
- 1315 1559 m 2 18 d -5 10 d f 0.625 0.625 0.625 c 1317 1577 m 2 20 d -10 20 d 3
- -30 d f 0.65 0.65 0.65 c 1319 1597 m 2 20 d -15 30 d 3 -30 d f 0.675 0.675
- 0.675 c 1321 1617 m 2 19 d -20 41 d 3 -30 d f 0.7 0.7 0.7 c 1323 1636 m 2 20 d
- -25 51 d 3 -30 d f 0.725 0.725 0.725 c 1325 1656 m 2 20 d -7 31 d -2 -6 d -7 20
- d -14 16 d 3 -30 d f 0.75 0.75 0.75 c 1327 1676 m 3 19 d -7 25 d -3 -13 d -9 14
- d -16 41 d 2 -25 d f 0.775 0.775 0.775 c 1330 1695 m 2 20 d -5 19 d -4 -14 d f
- 0.8 0.8 0.8 c 1332 1715 m 2 20 d -4 13 d -3 -14 d f 0.825 0.825 0.825 c 1334
- 1735 m 2 19 d -2 8 d -4 -14 d f 0.85 0.85 0.85 c 1336 1754 m 2 20 d -1 2 d -3
- -14 d f 0.875 0.875 0.875 c 1338 1774 m 1 6 d -2 -4 d f 0.6 0.6 0.6 c 1308 1577
- m 7 -18 d -3 28 d f 0.625 0.625 0.625 c 1300 1597 m 8 -20 d 4 10 d -3 30 d f
- 0.65 0.65 0.65 c 1293 1617 m 7 -20 d 9 20 d -3 30 d -30 176 d -5 14 d 17 -183 d
- f 0.675 0.675 0.675 c 1292 1620 m 1 -3 d 13 30 d -3 30 d -22 130 d -5 16 d 12
- -169 d f 0.7 0.7 0.7 c 1303 1677 m -3 30 d -14 84 d -5 16 d f 0.725 0.725 0.725
- c 1300 1707 m -3 30 d -6 39 d -5 15 d f 0.75 0.75 0.75 c 1297 1737 m -2 25 d -4
- 14 d f 0.6 0.6 0.6 c 1255 1814 m -7 -10 d 6 -73 d f 0.625 0.625 0.625 c 1270
- 1835 m -15 -21 d -1 -83 d 12 -149 d f 0.65 0.65 0.65 c 1268 1560 m 20 50 d 44 Y
- -17 183 d -1 -2 d -4 -253 d f 0.675 0.675 0.675 c 1288 1610 m 4 10 d -4 34 d f
- 0.6 0.6 0.6 c 1254 1731 m -6 73 d -2 1 d f 0.625 0.625 0.625 c 1245 1608 m 17
- -37 d 4 11 d -12 149 d -8 74 d -3 3 d -185 Y f 0.65 0.65 0.65 c 1262 1571 m 6
- -11 d -2 22 d -23 226 d -3 3 d -157 Y 3 -31 d f 0.675 0.675 0.675 c 1240 1811 m
- -3 2 d -128 Y 3 -31 d f 0.7 0.7 0.7 c 1237 1813 m -2 3 d -1 -100 d 3 -31 d f
- 0.725 0.725 0.725 c 1235 1816 m -3 2 d -71 Y 2 -31 d f 0.75 0.75 0.75 c 1232
- 1818 m -3 3 d -43 Y 3 -31 d f 0.775 0.775 0.775 c 1229 1821 m -3 3 d -15 Y 3
- -31 d f 0.8 0.8 0.8 c 1226 1824 m -2 1 d 2 -16 d f 0.625 0.625 0.625 c 1242
- 1594 m 3 14 d -2 15 d f 0.65 0.65 0.65 c 1237 1564 m 5 30 d 1 29 d -3 31 d f
- 0.675 0.675 0.675 c 1232 1534 m 5 30 d 3 90 d -3 31 d f 0.7 0.7 0.7 c 1227 1505
- m 5 29 d 5 151 d -3 31 d f 0.725 0.725 0.725 c 1222 1475 m 5 30 d 7 211 d -2 31
- d f 0.75 0.75 0.75 c 1221 1467 m 1 8 d 10 272 d -3 31 d -12 -249 d f 0.775
- 0.775 0.775 c 1229 1778 m -3 31 d -14 -197 d 5 -83 d f 0.8 0.8 0.8 c 1226 1809
- m -2 16 d -7 -10 d -10 -120 d 5 -83 d f 0.825 0.825 0.825 c 1217 1815 m -14 -20
- d -1 -17 d 5 -83 d f 0.85 0.85 0.85 c 1203 1795 m -2 -3 d 1 -14 d f 0.425 0.425
- 0.425 c 1179 1698 m -2 -6 d 2 12 d f 0.45 0.45 0.45 c 1180 1704 m -1 -6 d 6 Y 1
- 11 d f 0.475 0.475 0.475 c 1181 1710 m -1 -6 d 11 Y 2 11 d f 0.5 0.5 0.5 c 1183
- 1715 m -2 -5 d 1 16 d 1 12 d f 0.525 0.525 0.525 c 1184 1721 m -1 -6 d 23 Y 2
- 11 d f 0.55 0.55 0.55 c 1185 1727 m -1 -6 d 1 28 d 1 12 d f 0.575 0.575 0.575 c
- 1187 1733 m -2 -6 d 1 34 d 2 11 d f 0.6 0.6 0.6 c 1188 1739 m -1 -6 d 1 39 d 1
- 12 d f 0.625 0.625 0.625 c 1190 1744 m -2 -5 d 1 45 d 1 11 d f 0.65 0.65 0.65 c
- 1191 1750 m -1 -6 d 51 Y 2 12 d f 0.675 0.675 0.675 c 1192 1756 m -1 -6 d 1 57
- d 1 11 d f 0.7 0.7 0.7 c 1194 1762 m -2 -6 d 1 62 d 2 12 d f 0.725 0.725 0.725
- c 1195 1768 m -1 -6 d 1 68 d 1 11 d f 0.75 0.75 0.75 c 1198 1851 m 23 -384 d -4
- 62 d -21 245 d -1 -6 d 1 73 d f 0.775 0.775 0.775 c 1217 1529 m -5 83 d -14 167
- d -2 -5 d f 0.8 0.8 0.8 c 1212 1612 m -5 83 d -8 90 d -1 -6 d f 0.825 0.825
- 0.825 c 1207 1695 m -5 83 d -1 13 d -2 -6 d f 0.85 0.85 0.85 c 1202 1778 m -1
- 14 d -1 Y f 0.425 0.425 0.425 c 1179 1704 m -2 -12 d -5 -8 d f 0.45 0.45 0.45 c
- 1180 1715 m -1 -11 d -7 -20 d -6 -8 d f 0.475 0.475 0.475 c 1182 1726 m -2 -11
- d -14 -39 d -6 -8 d f 0.5 0.5 0.5 c 1183 1738 m -1 -12 d -22 -58 d -6 -8 d f
- 0.525 0.525 0.525 c 1185 1749 m -2 -11 d -29 -78 d -1 Y 3 -8 d f 0.55 0.55 0.55
- c 1186 1761 m -1 -12 d -28 -98 d 3 -9 d f 0.575 0.575 0.575 c 1188 1772 m -2
- -11 d -26 -119 d 3 -8 d f 0.6 0.6 0.6 c 1189 1784 m -1 -12 d -25 -138 d 3 -9 d
- f 0.625 0.625 0.625 c 1190 1795 m -1 -11 d -23 -159 d 4 -9 d f 0.65 0.65 0.65 c
- 1192 1807 m -2 -12 d -20 -179 d 3 -9 d f 0.675 0.675 0.675 c 1174 1603 m 4 41 d
- 15 174 d -1 -11 d -19 -200 d f 0.7 0.7 0.7 c 1178 1644 m 7 73 d 10 113 d -2 -12
- d f 0.725 0.725 0.725 c 1185 1717 m 7 72 d 4 52 d -1 -11 d f 0.75 0.75 0.75 c
- 1192 1789 m 6 62 d -2 -10 d f 0.525 0.525 0.525 c 1157 1651 m -3 8 d -2 2 d f
- 0.55 0.55 0.55 c 1160 1642 m -3 9 d -5 10 d -1 2 d f 0.575 0.575 0.575 c 1163
- 1634 m -3 8 d -9 21 d -2 3 d f 0.6 0.6 0.6 c 1166 1625 m -3 9 d -14 32 d -1 2 d
- f 0.625 0.625 0.625 c 1170 1616 m -4 9 d -18 43 d -2 2 d f 0.65 0.65 0.65 c
- 1173 1607 m -3 9 d -24 54 d -1 2 d f 0.675 0.675 0.675 c 1171 1608 m 3 -5 d -1
- 4 d -28 65 d -2 3 d f 0.7 0.7 0.7 c 1166 1615 m 5 -7 d -28 67 d -1 2 d f 0.725
- 0.725 0.725 c 1161 1623 m 5 -8 d -24 62 d -2 2 d f 0.75 0.75 0.75 c 1156 1630 m
- 5 -7 d -21 56 d -1 2 d f 0.775 0.775 0.775 c 1151 1638 m 5 -8 d -17 51 d -2 3 d
- 14 -46 d f 0.8 0.8 0.8 c 1137 1684 m -1 2 d 10 -36 d 5 -12 d f 0.825 0.825
- 0.825 c 1136 1686 m -2 2 d 7 -25 d 5 -13 d f 0.85 0.85 0.85 c 1134 1688 m -2 2
- d 5 -15 d 4 -12 d f 0.875 0.875 0.875 c 1132 1690 m -1 3 d 1 -5 d 5 -13 d f 0.9
- 0.9 0.9 c 1131 1693 m -1 1 d 2 -6 d f 0.725 0.725 0.725 c 1127 1618 m 7 6 d -9
- -6 d f 0.75 0.75 0.75 c 1134 1624 m 8 7 d -20 -12 d 3 -1 d f 0.775 0.775 0.775
- c 1142 1631 m 9 7 d -33 -19 d 4 X f 0.8 0.8 0.8 c 1151 1638 m -5 12 d -31 -31 d
- 3 X f 0.825 0.825 0.825 c 1146 1650 m -5 13 d -29 -43 d 3 -1 d f 0.85 0.85 0.85
- c 1141 1663 m -4 12 d -28 -55 d 3 X f 0.875 0.875 0.875 c 1137 1675 m -5 13 d
- -14 -34 d -11 -34 d 2 X f 0.9 0.9 0.9 c 1132 1688 m -2 6 d -12 -40 d f 0.65
- 0.65 0.65 c 1104 1545 m 3 10 d -5 19 d f 0.675 0.675 0.675 c 1107 1555 m 9 28 d
- -19 74 d 5 -83 d f 0.7 0.7 0.7 c 1116 1583 m 9 28 d -32 130 d 4 -84 d f 0.725
- 0.725 0.725 c 1125 1611 m 2 7 d -2 X -37 207 d 5 -84 d f 0.75 0.75 0.75 c 1125
- 1618 m -3 1 d -39 289 d 5 -83 d f 0.775 0.775 0.775 c 1122 1619 m -4 X -30 229
- d -5 62 d -2 Y f 0.8 0.8 0.8 c 1118 1619 m -3 X -22 166 d -5 63 d f 0.825 0.825
- 0.825 c 1115 1619 m -3 1 d -13 102 d -6 63 d f 0.85 0.85 0.85 c 1112 1620 m -3
- X -5 39 d -5 63 d f 0.875 0.875 0.875 c 1109 1620 m -2 X -3 39 d f 0.65 0.65
- 0.65 c 1099 1552 m 5 -7 d -2 29 d f 0.675 0.675 0.675 c 1085 1572 m 14 -20 d 3
- 22 d -5 83 d f 0.7 0.7 0.7 c 1080 1579 m 5 -7 d 12 85 d -4 84 d -17 -167 d f
- 0.725 0.725 0.725 c 1093 1741 m -5 84 d -20 -261 d 8 10 d f 0.75 0.75 0.75 c
- 1088 1825 m -5 83 d -23 -353 d 8 9 d f 0.775 0.775 0.775 c 1083 1908 m 2 Y -23
- -355 d f 0.475 0.475 0.475 c 1057 1587 m 1 -1 d -21 79 d -1 5 d f 0.5 0.5 0.5 c
- 1058 1586 m 3 X -22 69 d -2 10 d f 0.525 0.525 0.525 c 1061 1586 m 2 -1 d -22
- 60 d -2 10 d f 0.55 0.55 0.55 c 1063 1585 m 3 -1 d -23 51 d -2 10 d f 0.575
- 0.575 0.575 c 1066 1584 m 3 -1 d -24 42 d -2 10 d f 0.6 0.6 0.6 c 1069 1583 m 2
- -1 d -24 33 d -2 10 d f 0.625 0.625 0.625 c 1071 1582 m 3 -1 d -24 24 d -3 10 d
- f 0.65 0.65 0.65 c 1074 1581 m 2 X -24 14 d -2 10 d f 0.675 0.675 0.675 c 1076
- 1581 m 3 -1 d -25 5 d -2 10 d f 0.7 0.7 0.7 c 1079 1580 m 1 -1 d -4 -5 d -20 1
- d -2 10 d f 0.725 0.725 0.725 c 1076 1574 m -8 -10 d -10 1 d -2 10 d f 0.75
- 0.75 0.75 c 1068 1564 m -8 -9 d -2 10 d f 0.775 0.775 0.775 c 1060 1555 m f
- 0.475 0.475 0.475 c 1055 1597 m 2 -10 d -21 83 d -1 X f 0.5 0.5 0.5 c 1053 1617
- m 2 -20 d -20 73 d -2 2 d f 0.525 0.525 0.525 c 1051 1637 m 2 -20 d -20 55 d -2
- 2 d f 0.55 0.55 0.55 c 1049 1657 m 2 -20 d -20 37 d -2 2 d f 0.575 0.575 0.575
- c 1047 1676 m 2 -19 d -20 19 d -1 1 d f 0.6 0.6 0.6 c 1044 1696 m 3 -20 d -19 1
- d -2 2 d f 0.625 0.625 0.625 c 1042 1716 m 2 -20 d -18 -17 d -2 2 d f 0.65 0.65
- 0.65 c 1040 1736 m 2 -20 d -18 -35 d -2 2 d f 0.675 0.675 0.675 c 1038 1755 m 2
- -19 d -18 -53 d -2 1 d f 0.7 0.7 0.7 c 1035 1775 m 3 -20 d -18 -71 d -2 2 d f
- 0.725 0.725 0.725 c 1033 1795 m 2 -20 d -17 -89 d -2 2 d f 0.75 0.75 0.75 c
- 1033 1796 m -1 Y -17 -107 d -2 2 d 6 35 d f 0.775 0.775 0.775 c 1014 1690 m -1
- X 7 35 d f 0.675 0.675 0.675 c 992 1544 m -3 -21 d 3 12 d f 0.7 0.7 0.7 c 998
- 1586 m -6 -42 d -9 Y 5 23 d f 0.725 0.725 0.725 c 1004 1628 m -6 -42 d -1 -28 d
- 5 23 d f 0.75 0.75 0.75 c 1018 1676 m 15 120 d -13 -71 d -10 -54 d -6 -43 d -2
- -47 d 5 23 d f 0.775 0.775 0.775 c 1010 1615 m 8 61 d 2 49 d -7 -35 d -3 -19 d
- -3 -67 d f 0.475 0.475 0.475 c 967 1556 m -1 2 d 4 Y f 0.5 0.5 0.5 c 970 1552 m
- -3 4 d -1 6 d 2 15 d f 0.525 0.525 0.525 c 973 1548 m -3 4 d -2 25 d 2 16 d f
- 0.55 0.55 0.55 c 976 1543 m -3 5 d -3 45 d 2 16 d f 0.575 0.575 0.575 c 979
- 1539 m -3 4 d -4 66 d 2 15 d f 0.6 0.6 0.6 c 982 1534 m -3 5 d -5 85 d 2 16 d f
- 0.625 0.625 0.625 c 985 1530 m -3 4 d -6 106 d 1 15 d f 0.65 0.65 0.65 c 988
- 1526 m -3 4 d -8 125 d 2 16 d f 0.675 0.675 0.675 c 992 1535 m -3 -12 d -1 3 d
- -9 145 d 2 15 d f 0.7 0.7 0.7 c 997 1558 m -5 -23 d -11 151 d 2 16 d f 0.725
- 0.725 0.725 c 1002 1581 m -5 -23 d -14 144 d 2 16 d f 0.75 0.75 0.75 c 986 1730
- m 7 -33 d 14 -93 d -5 -23 d -17 137 d f 0.775 0.775 0.775 c 993 1697 m 17 -82 d
- -3 -11 d f 0.475 0.475 0.475 c 966 1562 m -4 Y -5 15 d f 0.5 0.5 0.5 c 968 1577
- m -2 -15 d -5 11 d -18 58 d f 0.525 0.525 0.525 c 970 1593 m -2 -16 d -25 54 d
- -1 1 d 15 9 d f 0.55 0.55 0.55 c 963 1644 m 2 6 d 7 -41 d -2 -16 d -13 48 d f
- 0.575 0.575 0.575 c 965 1650 m 2 11 d 7 -37 d -2 -15 d f 0.6 0.6 0.6 c 967 1661
- m 3 10 d 6 -31 d -2 -16 d f 0.625 0.625 0.625 c 970 1671 m 3 10 d 4 -26 d -1
- -15 d f 0.65 0.65 0.65 c 973 1681 m 3 10 d 3 -20 d -2 -16 d f 0.675 0.675 0.675
- c 976 1691 m 2 10 d 3 -15 d -2 -15 d f 0.7 0.7 0.7 c 978 1701 m 3 11 d 2 -10 d
- -2 -16 d f 0.725 0.725 0.725 c 981 1712 m 3 10 d 1 -4 d -2 -16 d f 0.75 0.75
- 0.75 c 984 1722 m 2 8 d -1 -12 d f 0.475 0.475 0.475 c 929 1637 m -10 3 d 3 -4
- d f 0.5 0.5 0.5 c 942 1632 m -13 5 d -7 -1 d 4 -6 d f 0.525 0.525 0.525 c 957
- 1641 m -15 -9 d -16 -2 d 3 -5 d f 0.55 0.55 0.55 c 956 1634 m 7 10 d -6 -3 d
- -28 -16 d 4 -6 d f 0.575 0.575 0.575 c 945 1619 m 11 15 d -23 -15 d 4 -5 d f
- 0.6 0.6 0.6 c 939 1611 m 6 8 d -8 -5 d f 0.475 0.475 0.475 c 922 1636 m -3 4 d
- -6 -14 d f 0.5 0.5 0.5 c 926 1630 m -4 6 d -9 -10 d -7 -19 d f 0.525 0.525
- 0.525 c 929 1625 m -3 5 d -20 -23 d -8 -20 d f 0.55 0.55 0.55 c 933 1619 m -4 6
- d -31 -38 d -3 -7 d 2 5 d f 0.575 0.575 0.575 c 937 1614 m -4 5 d -36 -34 d 1 9
- d f 0.6 0.6 0.6 c 938 1614 m 1 -3 d -2 3 d -39 -20 d 2 8 d f 0.625 0.625 0.625
- c 935 1621 m 3 -7 d -38 -12 d 2 8 d f 0.65 0.65 0.65 c 933 1628 m 2 -7 d -33
- -11 d 2 9 d f 0.675 0.675 0.675 c 930 1635 m 3 -7 d -29 -9 d 2 8 d f 0.7 0.7
- 0.7 c 927 1642 m 3 -7 d -24 -8 d 2 8 d f 0.725 0.725 0.725 c 925 1649 m 2 -7 d
- -19 -7 d 2 9 d f 0.75 0.75 0.75 c 922 1656 m 3 -7 d -15 -5 d 1 8 d f 0.775
- 0.775 0.775 c 919 1663 m 3 -7 d -11 -4 d 2 9 d f 0.8 0.8 0.8 c 917 1670 m 2 -7
- d -6 -2 d 2 8 d f 0.825 0.825 0.825 c 916 1672 m 1 -2 d -2 -1 d f 0.5 0.5 0.5 c
- 881 1576 m -9 -2 d 1 -3 d f 0.525 0.525 0.525 c 891 1579 m -10 -3 d -8 -5 d 2
- -3 d f 0.55 0.55 0.55 c 897 1585 m -2 -5 d -4 -1 d -16 -11 d 1 -3 d f 0.575
- 0.575 0.575 c 898 1594 m -1 -9 d -21 -20 d 2 -3 d f 0.6 0.6 0.6 c 900 1602 m -2
- -8 d -20 -32 d 1 -3 d f 0.625 0.625 0.625 c 902 1610 m -2 -8 d -21 -43 d 1 -3 d
- f 0.65 0.65 0.65 c 904 1619 m -2 -9 d -22 -54 d 2 -3 d f 0.675 0.675 0.675 c
- 906 1627 m -2 -8 d -22 -66 d 1 -3 d f 0.7 0.7 0.7 c 908 1635 m -2 -8 d -23 -77
- d 2 -3 d f 0.725 0.725 0.725 c 910 1644 m -2 -9 d -23 -88 d 1 -3 d f 0.75 0.75
- 0.75 c 911 1652 m -1 -8 d -24 -100 d 2 -3 d f 0.775 0.775 0.775 c 913 1661 m -2
- -9 d -23 -111 d 1 -3 d f 0.8 0.8 0.8 c 915 1669 m -2 -8 d -24 -123 d 2 -3 d f
- 0.825 0.825 0.825 c 896 1555 m 20 117 d -1 -3 d -24 -134 d 1 -3 d f 0.85 0.85
- 0.85 c 892 1532 m 4 23 d -4 -23 d f 0.425 0.425 0.425 c 856 1633 m -8 29 d 2 -6
- d f 0.45 0.45 0.45 c 864 1604 m -8 29 d -6 23 d 1 -6 d f 0.475 0.475 0.475 c
- 872 1575 m -8 29 d -13 46 d 2 -6 d f 0.5 0.5 0.5 c 873 1571 m -1 3 d 1 Y -19 69
- d 1 -7 d f 0.525 0.525 0.525 c 875 1568 m -2 3 d -19 66 d 2 -6 d f 0.55 0.55
- 0.55 c 876 1565 m -1 3 d -19 63 d 1 -6 d f 0.575 0.575 0.575 c 878 1562 m -2 3
- d -19 60 d 2 -6 d f 0.6 0.6 0.6 c 879 1559 m -1 3 d -19 57 d 2 -6 d f 0.625
- 0.625 0.625 c 880 1556 m -1 3 d -18 54 d 1 -6 d f 0.65 0.65 0.65 c 882 1553 m
- -2 3 d -18 51 d 2 -6 d f 0.675 0.675 0.675 c 883 1550 m -1 3 d -18 48 d 1 -7 d
- f 0.7 0.7 0.7 c 885 1547 m -2 3 d -18 44 d 2 -6 d f 0.725 0.725 0.725 c 886
- 1544 m -1 3 d -18 41 d 1 -6 d f 0.75 0.75 0.75 c 869 1579 m 3 -7 d 16 -31 d -2
- 3 d -18 38 d f 0.775 0.775 0.775 c 872 1572 m 7 -13 d 10 -21 d -1 3 d f 0.8 0.8
- 0.8 c 879 1559 m 6 -13 d 6 -11 d -2 3 d f 0.825 0.825 0.825 c 885 1546 m 6 -13
- d 1 -1 d -1 3 d f 0.85 0.85 0.85 c 891 1533 m 1 -1 d f 0.425 0.425 0.425 c 850
- 1656 m -2 6 d -11 16 d f 0.45 0.45 0.45 c 851 1650 m -1 6 d -13 22 d -11 17 d f
- 0.475 0.475 0.475 c 853 1644 m -2 6 d -25 45 d -1 1 d 2 -12 d f 0.5 0.5 0.5 c
- 854 1637 m -1 7 d -26 40 d 2 -15 d f 0.525 0.525 0.525 c 856 1631 m -2 6 d -25
- 32 d 2 -14 d f 0.55 0.55 0.55 c 857 1625 m -1 6 d -25 24 d 2 -14 d f 0.575
- 0.575 0.575 c 859 1619 m -2 6 d -24 16 d 2 -14 d f 0.6 0.6 0.6 c 861 1613 m -2
- 6 d -24 8 d 2 -15 d f 0.625 0.625 0.625 c 862 1607 m -1 6 d -24 -1 d 3 -14 d f
- 0.65 0.65 0.65 c 864 1601 m -2 6 d -22 -9 d 2 -14 d f 0.675 0.675 0.675 c 865
- 1594 m -1 7 d -22 -17 d 2 -14 d f 0.7 0.7 0.7 c 845 1560 m 5 3 d 17 25 d -2 6 d
- -21 -24 d f 0.725 0.725 0.725 c 850 1563 m 13 11 d 5 8 d -1 6 d f 0.75 0.75
- 0.75 c 863 1574 m 6 5 d -1 3 d f 0.425 0.425 0.425 c 813 1658 m -12 -35 d 5 -17
- d f 0.45 0.45 0.45 c 824 1692 m -11 -34 d -7 -52 d 4 -18 d f 0.475 0.475 0.475
- c 827 1684 m -2 12 d -1 -4 d -14 -104 d 4 -18 d f 0.5 0.5 0.5 c 829 1669 m -2
- 15 d -13 -114 d 5 -18 d f 0.525 0.525 0.525 c 822 1541 m 1 X 8 114 d -2 14 d
- -10 -117 d f 0.55 0.55 0.55 c 823 1541 m 3 3 d 7 97 d -2 14 d f 0.575 0.575
- 0.575 c 826 1544 m 4 3 d 5 80 d -2 14 d f 0.6 0.6 0.6 c 830 1547 m 3 3 d 4 62 d
- -2 15 d f 0.625 0.625 0.625 c 833 1550 m 3 3 d 4 45 d -3 14 d f 0.65 0.65 0.65
- c 836 1553 m 4 2 d 2 29 d -2 14 d f 0.675 0.675 0.675 c 840 1555 m 3 3 d 1 12 d
- -2 14 d f 0.7 0.7 0.7 c 843 1558 m 2 2 d -1 10 d f 0.425 0.425 0.425 c 806 1606
- m -5 17 d -23 -86 d 1 -6 d f 0.45 0.45 0.45 c 810 1588 m -4 18 d -27 -75 d 1 -8
- d f 0.475 0.475 0.475 c 814 1570 m -4 18 d -30 -65 d 1 -8 d f 0.5 0.5 0.5 c 819
- 1552 m -5 18 d -33 -55 d 1 -9 d f 0.525 0.525 0.525 c 821 1537 m 1 4 d -3 11 d
- -37 -46 d 2 -8 d f 0.55 0.55 0.55 c 819 1525 m 2 12 d -37 -39 d 1 -8 d f 0.575
- 0.575 0.575 c 817 1514 m 2 11 d -34 -35 d 1 -8 d f 0.6 0.6 0.6 c 815 1502 m 2
- 12 d -31 -32 d 1 -9 d f 0.625 0.625 0.625 c 813 1491 m 2 11 d -28 -29 d 2 -8 d
- f 0.65 0.65 0.65 c 812 1479 m 1 12 d -24 -26 d 1 -8 d f 0.675 0.675 0.675 c 810
- 1468 m 2 11 d -22 -22 d 1 -9 d f 0.7 0.7 0.7 c 808 1456 m 2 12 d -19 -20 d 1 -8
- d f 0.725 0.725 0.725 c 806 1445 m 2 11 d -16 -16 d 2 -8 d f 0.75 0.75 0.75 c
- 804 1433 m 2 12 d -12 -13 d 1 -8 d f 0.775 0.775 0.775 c 802 1421 m 2 12 d -9
- -9 d 1 -9 d f 0.8 0.8 0.8 c 800 1410 m 2 11 d -6 -6 d 1 -8 d f 0.825 0.825
- 0.825 c 798 1400 m 2 10 d -3 -3 d f 0.425 0.425 0.425 c 775 1703 m 1 -18 d 3
- -154 d -1 6 d -24 -127 d f 0.45 0.45 0.45 c 776 1685 m 2 -18 d 2 -144 d -1 8 d
- f 0.475 0.475 0.475 c 778 1667 m 1 -18 d 2 -134 d -1 8 d f 0.5 0.5 0.5 c 779
- 1649 m 1 -18 d 2 -125 d -1 9 d f 0.525 0.525 0.525 c 780 1631 m 2 -18 d 2 -115
- d -2 8 d f 0.55 0.55 0.55 c 782 1613 m 1 -18 d 2 -105 d -1 8 d f 0.575 0.575
- 0.575 c 783 1595 m 2 -18 d 1 -95 d -1 8 d f 0.6 0.6 0.6 c 785 1577 m 1 -18 d 1
- -86 d -1 9 d f 0.625 0.625 0.625 c 786 1559 m 1 -18 d 2 -76 d -2 8 d f 0.65
- 0.65 0.65 c 787 1541 m 2 -18 d 1 -66 d -1 8 d f 0.675 0.675 0.675 c 789 1523 m
- 1 -18 d 1 -57 d -1 9 d f 0.7 0.7 0.7 c 790 1505 m 2 -18 d -47 Y -1 8 d f 0.725
- 0.725 0.725 c 792 1487 m 1 -18 d 1 -37 d -2 8 d f 0.75 0.75 0.75 c 793 1469 m 1
- -18 d 1 -27 d -1 8 d f 0.775 0.775 0.775 c 794 1451 m 2 -18 d -18 Y -1 9 d f
- 0.8 0.8 0.8 c 796 1433 m 1 -18 d -8 Y -1 8 d f 0.825 0.825 0.825 c 797 1415 m 1
- -15 d -1 7 d f 0.425 0.425 0.425 c 773 1697 m 2 6 d -21 -293 d -23 236 d -1 Y f
- 0.45 0.45 0.45 c 771 1691 m 2 6 d -42 -52 d 2 -2 d f 0.475 0.475 0.475 c 770
- 1685 m 1 6 d -38 -48 d 1 -2 d f 0.5 0.5 0.5 c 768 1679 m 2 6 d -36 -44 d 2 -2 d
- f 0.525 0.525 0.525 c 766 1673 m 2 6 d -32 -40 d 1 -2 d f 0.55 0.55 0.55 c 765
- 1666 m 1 7 d -29 -36 d 2 -3 d f 0.575 0.575 0.575 c 763 1660 m 2 6 d -26 -32 d
- 1 -2 d f 0.6 0.6 0.6 c 761 1654 m 2 6 d -23 -28 d 2 -2 d f 0.625 0.625 0.625 c
- 760 1648 m 1 6 d -19 -24 d 1 -2 d f 0.65 0.65 0.65 c 758 1642 m 2 6 d -17 -20 d
- 2 -2 d f 0.675 0.675 0.675 c 756 1636 m 2 6 d -13 -16 d 2 -3 d f 0.7 0.7 0.7 c
- 755 1630 m 1 6 d -9 -13 d 1 -2 d f 0.725 0.725 0.725 c 753 1623 m 2 7 d -7 -9 d
- 2 -2 d f 0.75 0.75 0.75 c 751 1617 m 2 6 d -3 -4 d 1 -2 d f 0.775 0.775 0.775 c
- 751 1617 m f 0.425 0.425 0.425 c 731 1645 m 1 Y -2 Y f 0.45 0.45 0.45 c 733
- 1643 m -2 2 d -1 Y -2 -9 d f 0.475 0.475 0.475 c 734 1641 m -1 2 d -4 -8 d -1
- -9 d f 0.5 0.5 0.5 c 736 1639 m -2 2 d -6 -15 d -1 -9 d f 0.525 0.525 0.525 c
- 737 1637 m -1 2 d -9 -22 d -1 -9 d f 0.55 0.55 0.55 c 739 1634 m -2 3 d -11 -29
- d -2 -9 d f 0.575 0.575 0.575 c 740 1632 m -1 2 d -15 -35 d -1 -9 d f 0.6 0.6
- 0.6 c 742 1630 m -2 2 d -17 -42 d -1 -9 d f 0.625 0.625 0.625 c 743 1628 m -1 2
- d -20 -49 d -1 -9 d f 0.65 0.65 0.65 c 745 1626 m -2 2 d -22 -56 d -2 -9 d f
- 0.675 0.675 0.675 c 747 1623 m -2 3 d -26 -63 d -1 -9 d f 0.7 0.7 0.7 c 748
- 1621 m -1 2 d -29 -69 d -1 -9 d f 0.725 0.725 0.725 c 750 1619 m -2 2 d -31 -76
- d -1 -9 d f 0.75 0.75 0.75 c 728 1517 m 17 71 d 6 29 d -1 2 d -34 -83 d -2 -9 d
- 13 -12 d f 0.775 0.775 0.775 c 745 1588 m 6 29 d -37 -90 d -1 -9 d 10 -10 d 4 7
- d f 0.8 0.8 0.8 c 713 1518 m -1 -9 d 8 -8 d 3 7 d f 0.825 0.825 0.825 c 712
- 1509 m -1 -9 d 5 -6 d 4 7 d f 0.85 0.85 0.85 c 711 1500 m -2 -9 d 3 -3 d 4 6 d
- f 0.875 0.875 0.875 c 709 1491 m -1 -9 d 1 -1 d 3 7 d f 0.9 0.9 0.9 c 708 1482
- m -1 -4 d 2 3 d f 0.425 0.425 0.425 c 704 1470 m 1 2 d -1 3 d f 0.45 0.45 0.45
- c 705 1472 m 2 4 d -4 7 d 1 -8 d f 0.475 0.475 0.475 c 707 1476 m 2 3 d -7 12 d
- 1 -8 d f 0.5 0.5 0.5 c 709 1479 m 2 4 d -11 16 d 2 -8 d f 0.525 0.525 0.525 c
- 711 1483 m 1 3 d -13 21 d 1 -8 d f 0.55 0.55 0.55 c 712 1486 m 2 4 d -16 25 d 1
- -8 d f 0.575 0.575 0.575 c 714 1490 m 2 3 d -19 30 d 1 -8 d f 0.6 0.6 0.6 c 716
- 1493 m 2 4 d -22 34 d 1 -8 d f 0.625 0.625 0.625 c 718 1497 m 1 3 d -24 39 d 1
- -8 d f 0.65 0.65 0.65 c 719 1500 m 2 4 d -27 43 d 1 -8 d f 0.675 0.675 0.675 c
- 721 1504 m 2 3 d -30 47 d 1 -7 d f 0.7 0.7 0.7 c 723 1507 m 2 4 d -33 51 d 1 -8
- d f 0.725 0.725 0.725 c 725 1511 m 2 3 d -36 56 d 1 -8 d f 0.75 0.75 0.75 c 727
- 1514 m 1 3 d -1 -2 d -37 63 d 1 -8 d f 0.775 0.775 0.775 c 727 1515 m -4 -7 d
- -34 78 d 1 -8 d f 0.8 0.8 0.8 c 723 1508 m -3 -7 d -33 93 d 2 -8 d f 0.825
- 0.825 0.825 c 720 1501 m -4 -7 d -30 108 d 1 -8 d f 0.85 0.85 0.85 c 716 1494 m
- -4 -6 d -27 122 d 1 -8 d f 0.875 0.875 0.875 c 712 1488 m -3 -7 d -25 137 d 1
- -8 d f 0.9 0.9 0.9 c 709 1481 m -2 -3 d -23 142 d -2 Y f 0.425 0.425 0.425 c
- 702 1415 m 2 55 d 5 Y f 0.45 0.45 0.45 c 698 1318 m 4 97 d 2 60 d -1 8 d f
- 0.475 0.475 0.475 c 694 1220 m 4 98 d 5 165 d -1 8 d f 0.5 0.5 0.5 c 690 1122 m
- 4 98 d 8 271 d -2 8 d f 0.525 0.525 0.525 c 686 1025 m 4 97 d 10 377 d -1 8 d f
- 0.55 0.55 0.55 c 681 927 m 5 98 d 13 482 d -1 8 d f 0.575 0.575 0.575 c 681 913
- m 14 Y 17 588 d -1 8 d -35 -547 d -2 -47 d f 0.6 0.6 0.6 c 697 1523 m -1 8 d
- -32 -502 d -2 -53 d f 0.625 0.625 0.625 c 696 1531 m -1 8 d -29 -458 d -2 -52 d
- f 0.65 0.65 0.65 c 695 1539 m -1 8 d -27 -413 d -1 -53 d f 0.675 0.675 0.675 c
- 694 1547 m -1 7 d -24 -368 d -2 -52 d f 0.7 0.7 0.7 c 693 1554 m -1 8 d -21
- -323 d -2 -53 d f 0.725 0.725 0.725 c 692 1562 m -1 8 d -18 -278 d -2 -53 d f
- 0.75 0.75 0.75 c 691 1570 m -1 8 d -15 -234 d -2 -52 d f 0.775 0.775 0.775 c
- 690 1578 m -1 8 d -13 -189 d -1 -53 d f 0.8 0.8 0.8 c 689 1586 m -2 8 d -9 -144
- d -2 -53 d f 0.825 0.825 0.825 c 687 1594 m -1 8 d -6 -100 d -2 -52 d f 0.85
- 0.85 0.85 c 686 1602 m -1 8 d -3 -55 d -2 -53 d f 0.875 0.875 0.875 c 685 1610
- m -1 8 d -11 Y -2 -52 d f 0.9 0.9 0.9 c 684 1618 m 2 Y -13 Y f 0.55 0.55 0.55 c
- 657 907 m 2 1 d -20 16 d -2 -1 d f 0.575 0.575 0.575 c 659 908 m 22 5 d -21 16
- d -21 -5 d f 0.55 0.55 0.55 c 634 901 m 23 6 d -20 16 d -23 -6 d f 610 896 m 24
- 5 d -20 16 d -24 -6 d f 1711 1155 m 24 6 d -21 16 d -23 -6 d f 1688 1149 m 23 6
- d -20 16 d -24 -6 d f 1664 1143 m 24 6 d -21 16 d -23 -6 d f 0.425 0.425 0.425
- c 1641 1769 m 4 -107 d -21 -140 d -4 74 d f 0.45 0.45 0.45 c 1645 1662 m 4 -107
- d -21 -108 d -4 75 d f 0.475 0.475 0.475 c 1649 1555 m 4 -106 d -21 -76 d -4 74
- d f 0.5 0.5 0.5 c 1653 1449 m 4 -107 d -21 -43 d -4 74 d f 0.525 0.525 0.525 c
- 1657 1342 m 4 -106 d -21 -12 d -4 75 d f 0.55 0.55 0.55 c 1661 1236 m 3 -93 d
- -20 16 d -4 65 d f 0.425 0.425 0.425 c 1617 1682 m 24 87 d -21 -173 d -4 4 d 77
- Y f 0.45 0.45 0.45 c 1616 1600 m -5 4 d 58 Y 5 15 d f 0.475 0.475 0.475 c 1611
- 1604 m -5 5 d 38 Y 5 15 d f 0.5 0.5 0.5 c 1606 1609 m -4 4 d 19 Y 4 15 d f
- 0.525 0.525 0.525 c 1602 1613 m -5 4 d 5 15 d f 0.55 0.55 0.55 c 1597 1617 m f
- 0.425 0.425 0.425 c 1617 1679 m 3 Y -1 -5 d f 0.45 0.45 0.45 c 1615 1670 m 2 9
- d -1 -2 d -5 -15 d f 0.475 0.475 0.475 c 1613 1661 m 2 9 d -4 -8 d -5 -15 d f
- 0.5 0.5 0.5 c 1612 1652 m 1 9 d -7 -14 d -4 -15 d f 0.525 0.525 0.525 c 1610
- 1643 m 2 9 d -10 -20 d -5 -15 d f 0.55 0.55 0.55 c 1608 1634 m 2 9 d -13 -26 d
- -3 9 d f 0.575 0.575 0.575 c 1607 1625 m 1 9 d -14 -8 d -4 8 d f 0.6 0.6 0.6 c
- 1605 1615 m 2 10 d -17 9 d -3 9 d f 0.625 0.625 0.625 c 1603 1606 m 2 9 d -18
- 28 d -4 9 d f 0.65 0.65 0.65 c 1602 1597 m 1 9 d -20 46 d -3 9 d f 0.675 0.675
- 0.675 c 1600 1588 m 2 9 d -22 64 d -3 9 d f 0.7 0.7 0.7 c 1598 1579 m 2 9 d -23
- 82 d -4 8 d 1 -3 d f 0.725 0.725 0.725 c 1597 1570 m 1 9 d -24 96 d 7 -45 d f
- 0.75 0.75 0.75 c 1595 1561 m 2 9 d -16 60 d 8 -45 d f 0.775 0.775 0.775 c 1594
- 1555 m 1 6 d -6 24 d f 0.475 0.475 0.475 c 1570 1643 m 1 -4 d -2 15 d f 0.5 0.5
- 0.5 c 1571 1639 m 2 -7 d -7 41 d 3 -19 d f 0.525 0.525 0.525 c 1573 1632 m 2 -7
- d -11 67 d 2 -19 d f 0.55 0.55 0.55 c 1575 1625 m 2 -7 d -16 93 d 3 -19 d f
- 0.575 0.575 0.575 c 1577 1618 m 2 -8 d -21 121 d 3 -20 d f 0.6 0.6 0.6 c 1579
- 1610 m 2 -7 d -25 147 d 2 -19 d f 0.625 0.625 0.625 c 1581 1603 m 2 -7 d -30
- 173 d 3 -19 d f 0.65 0.65 0.65 c 1583 1596 m 2 -7 d -34 199 d 2 -19 d f 0.675
- 0.675 0.675 c 1585 1589 m 2 -7 d -26 159 d -11 52 d 1 -5 d f 0.7 0.7 0.7 c 1587
- 1582 m 2 -8 d -15 101 d -1 3 d -12 63 d f 0.725 0.725 0.725 c 1589 1574 m 2 -7
- d -10 63 d -7 45 d f 0.75 0.75 0.75 c 1591 1567 m 1 -7 d -3 25 d -8 45 d f
- 0.775 0.775 0.775 c 1592 1560 m 2 -5 d -5 30 d f 0.475 0.475 0.475 c 1569 1649
- m 1 -6 d -1 11 d f 0.5 0.5 0.5 c 1567 1660 m 2 -11 d 5 Y -3 19 d f 0.525 0.525
- 0.525 c 1566 1672 m 1 -12 d -1 13 d -2 19 d f 0.55 0.55 0.55 c 1564 1683 m 2
- -11 d -2 20 d -3 19 d -32 5 d -3 -10 d 2 5 d f 0.575 0.575 0.575 c 1562 1694 m
- 2 -11 d -3 28 d -3 20 d -24 3 d -5 -18 d -1 -5 d 2 8 d f 0.6 0.6 0.6 c 1560
- 1705 m 2 -11 d -4 37 d -2 19 d -17 2 d -5 -18 d -4 -15 d 2 8 d f 0.625 0.625
- 0.625 c 1558 1716 m 2 -11 d -4 45 d -3 19 d -9 1 d -5 -18 d -7 -25 d 2 8 d f
- 0.65 0.65 0.65 c 1556 1727 m 2 -11 d -5 53 d -2 19 d -2 1 d -5 -19 d -10 -35 d
- 2 8 d f 0.675 0.675 0.675 c 1554 1739 m 2 -12 d -5 61 d -1 5 d -1 -4 d -13 -46
- d 2 8 d f 0.7 0.7 0.7 c 1553 1750 m 1 -11 d -16 12 d 2 8 d f 0.725 0.725 0.725
- c 1551 1761 m 2 -11 d -13 9 d 2 9 d f 0.75 0.75 0.75 c 1549 1772 m 2 -11 d -9 7
- d 2 8 d f 0.775 0.775 0.775 c 1547 1783 m 2 -11 d -5 4 d 2 8 d f 0.8 0.8 0.8 c
- 1547 1785 m -2 Y -1 1 d f 0.425 0.425 0.425 c 1523 1658 m 2 7 d -20 12 d -2 -3
- d f 0.45 0.45 0.45 c 1525 1665 m 1 8 d -16 11 d -5 -7 d f 0.475 0.475 0.475 c
- 1526 1673 m 2 9 d -13 8 d -5 -6 d f 0.5 0.5 0.5 c 1528 1682 m 1 8 d -10 7 d -4
- -7 d f 0.525 0.525 0.525 c 1529 1690 m 2 9 d -7 4 d -5 -6 d f 0.55 0.55 0.55 c
- 1531 1699 m 1 8 d -4 4 d -2 -5 d -2 -3 d f 0.575 0.575 0.575 c 1532 1707 m 2 9
- d -4 3 d -2 -8 d f 0.6 0.6 0.6 c 1534 1716 m 2 8 d -4 3 d -2 -8 d f 0.625 0.625
- 0.625 c 1536 1724 m 1 9 d -3 2 d -2 -8 d f 0.65 0.65 0.65 c 1537 1733 m 2 8 d
- -3 2 d -2 -8 d f 0.675 0.675 0.675 c 1539 1741 m 1 9 d -2 1 d -2 -8 d f 0.7 0.7
- 0.7 c 1540 1750 m 2 8 d -2 1 d -2 -8 d f 0.725 0.725 0.725 c 1542 1758 m 1 9 d
- -1 1 d -2 -9 d f 0.75 0.75 0.75 c 1543 1767 m 2 8 d -1 1 d -2 -8 d f 0.775
- 0.775 0.775 c 1545 1775 m 2 9 d -1 X -2 -8 d f 0.8 0.8 0.8 c 1547 1784 m 1 Y -1
- -1 d f 0.425 0.425 0.425 c 1522 1649 m 1 9 d -20 16 d -1 -4 d f 0.45 0.45 0.45
- c 1521 1637 m 1 12 d -20 21 d -2 -8 d f 0.475 0.475 0.475 c 1519 1625 m 2 12 d
- -21 25 d -2 -8 d f 0.5 0.5 0.5 c 1518 1614 m 1 11 d -21 29 d -3 -8 d f 0.525
- 0.525 0.525 c 1516 1602 m 2 12 d -23 32 d -2 -8 d f 0.55 0.55 0.55 c 1515 1590
- m 1 12 d -23 36 d -2 -8 d f 0.575 0.575 0.575 c 1514 1578 m 1 12 d -24 40 d -2
- -8 d f 0.6 0.6 0.6 c 1512 1567 m 2 11 d -25 44 d -2 -8 d f 0.625 0.625 0.625 c
- 1511 1555 m 1 12 d -25 47 d -2 -7 d f 0.65 0.65 0.65 c 1509 1543 m 2 12 d -26
- 52 d -2 -8 d f 0.675 0.675 0.675 c 1508 1531 m 1 12 d -26 56 d -3 -8 d f 0.7
- 0.7 0.7 c 1507 1520 m 1 11 d -28 60 d -1 -4 d 2 -12 d f 0.725 0.725 0.725 c
- 1505 1508 m 2 12 d -26 55 d 4 -23 d f 0.75 0.75 0.75 c 1504 1496 m 1 12 d -20
- 44 d 4 -24 d f 0.775 0.775 0.775 c 1502 1485 m 2 11 d -15 32 d 4 -23 d f 0.8
- 0.8 0.8 c 1501 1473 m 1 12 d -9 20 d 4 -23 d f 0.825 0.825 0.825 c 1500 1464 m
- 1 9 d -4 9 d f 0.475 0.475 0.475 c 1476 1633 m 1 -8 d -20 -94 d -1 -4 d f 0.5
- 0.5 0.5 c 1477 1625 m 2 -12 d -19 -76 d -3 -6 d f 0.525 0.525 0.525 c 1479 1613
- m 2 -11 d -18 -58 d -3 -7 d f 0.55 0.55 0.55 c 1481 1602 m 1 -12 d -17 -39 d -2
- -7 d f 0.575 0.575 0.575 c 1482 1590 m 2 -12 d -16 -21 d -3 -6 d f 0.6 0.6 0.6
- c 1484 1578 m 2 -12 d -16 -2 d -2 -7 d f 0.625 0.625 0.625 c 1486 1566 m 1 -11
- d -14 16 d -3 -7 d f 0.65 0.65 0.65 c 1487 1555 m 2 -12 d -13 34 d -3 -6 d f
- 0.675 0.675 0.675 c 1489 1543 m 1 -12 d -12 53 d -2 -7 d f 0.7 0.7 0.7 c 1490
- 1531 m 2 -11 d -11 55 d -2 12 d -1 -3 d f 0.725 0.725 0.725 c 1492 1520 m 2 -12
- d -9 44 d -4 23 d f 0.75 0.75 0.75 c 1494 1508 m 1 -12 d -6 32 d -4 24 d f
- 0.775 0.775 0.775 c 1495 1496 m 2 -11 d -4 20 d -4 23 d f 0.8 0.8 0.8 c 1497
- 1485 m 2 -12 d -2 9 d -4 23 d f 0.825 0.825 0.825 c 1499 1473 m 1 -9 d -3 18 d
- f 0.475 0.475 0.475 c 1475 1636 m 1 -3 d -20 -106 d -2 10 d f 0.5 0.5 0.5 c
- 1473 1642 m 2 -6 d -21 -99 d -2 17 d f 0.525 0.525 0.525 c 1471 1648 m 2 -6 d
- -21 -88 d -3 18 d f 0.55 0.55 0.55 c 1468 1653 m 3 -5 d -22 -76 d -3 17 d f
- 0.575 0.575 0.575 c 1466 1659 m 2 -6 d -22 -64 d -3 18 d f 0.6 0.6 0.6 c 1464
- 1665 m 2 -6 d -23 -52 d -3 17 d f 0.625 0.625 0.625 c 1462 1670 m 2 -5 d -24
- -41 d -3 18 d f 0.65 0.65 0.65 c 1460 1676 m 2 -6 d -25 -28 d -3 17 d f 0.675
- 0.675 0.675 c 1457 1682 m 3 -6 d -26 -17 d -2 10 d 4 4 d f 0.7 0.7 0.7 c 1455
- 1687 m 2 -5 d -21 -9 d 8 10 d f 0.725 0.725 0.725 c 1453 1693 m 2 -6 d -11 -4 d
- 8 10 d f 0.75 0.75 0.75 c 1453 1694 m -1 Y -1 X f 0.5 0.5 0.5 c 1429 1554 m 1 2
- d -8 60 d f 0.525 0.525 0.525 c 1430 1556 m 2 16 d -20 140 d -3 5 d 13 -101 d f
- 0.55 0.55 0.55 c 1432 1572 m 3 15 d -20 117 d -3 8 d f 0.575 0.575 0.575 c 1435
- 1587 m 2 15 d -18 94 d -4 8 d f 0.6 0.6 0.6 c 1437 1602 m 3 15 d -17 72 d -4 7
- d f 0.625 0.625 0.625 c 1440 1617 m 2 15 d -15 49 d -4 8 d f 0.65 0.65 0.65 c
- 1442 1632 m 3 15 d -15 26 d -3 8 d f 0.675 0.675 0.675 c 1445 1647 m 2 15 d -11
- 11 d -4 -4 d -2 4 d f 0.7 0.7 0.7 c 1447 1662 m 3 15 d -6 6 d -8 -10 d f 0.725
- 0.725 0.725 c 1450 1677 m 2 15 d 1 Y -8 -10 d f 0.75 0.75 0.75 c 1452 1692 m 1
- 2 d -1 -1 d f 0.5 0.5 0.5 c 1429 1552 m 2 Y -7 62 d f 0.525 0.525 0.525 c 1425
- 1546 m 4 6 d -7 64 d -13 101 d -2 -16 d f 0.55 0.55 0.55 c 1422 1540 m 3 6 d
- -18 155 d -4 -24 d f 0.575 0.575 0.575 c 1419 1533 m 3 7 d -19 137 d -4 -23 d f
- 0.6 0.6 0.6 c 1416 1527 m 3 6 d -20 121 d -3 -24 d f 0.625 0.625 0.625 c 1413
- 1520 m 3 7 d -20 103 d -4 -24 d f 0.65 0.65 0.65 c 1409 1514 m 4 6 d -21 86 d
- -3 -23 d f 0.675 0.675 0.675 c 1406 1508 m 3 6 d -20 69 d -3 -20 d 15 -41 d f
- 0.7 0.7 0.7 c 1406 1507 m 1 Y -5 14 d f 0.475 0.475 0.475 c 1363 1697 m -1 8 d
- 2 -20 d f 0.5 0.5 0.5 c 1366 1680 m -3 17 d 1 -12 d 5 -45 d f 0.525 0.525 0.525
- c 1369 1663 m -3 17 d 3 -40 d 6 -44 d f 0.55 0.55 0.55 c 1372 1646 m -3 17 d 6
- -67 d 5 -45 d f 0.575 0.575 0.575 c 1382 1528 m 3 -2 d -10 103 d -3 17 d 8 -95
- d f 0.6 0.6 0.6 c 1385 1526 m 5 -5 d -13 91 d -2 17 d f 0.625 0.625 0.625 c
- 1390 1521 m 5 -4 d -15 78 d -3 17 d f 0.65 0.65 0.65 c 1395 1517 m 5 -5 d -17
- 65 d -3 18 d f 0.675 0.675 0.675 c 1400 1512 m 6 -4 d -5 14 d -15 41 d -3 14 d
- f 0.7 0.7 0.7 c 1406 1508 m -1 Y -5 15 d f 0.475 0.475 0.475 c 1364 1685 m -2
- 20 d -1 2 d f 0.5 0.5 0.5 c 1369 1640 m -5 45 d -3 22 d -1 5 d f 0.525 0.525
- 0.525 c 1375 1596 m -6 44 d -9 72 d -2 4 d f 0.55 0.55 0.55 c 1380 1551 m -5 45
- d -17 120 d -1 5 d f 0.575 0.575 0.575 c 1379 1538 m 3 -10 d -2 23 d -23 170 d
- -2 5 d f 0.6 0.6 0.6 c 1373 1558 m 6 -20 d -24 188 d -1 5 d f 0.625 0.625 0.625
- c 1367 1577 m 6 -19 d -19 173 d -2 4 d f 0.65 0.65 0.65 c 1361 1597 m 6 -20 d
- -15 158 d -1 5 d f 0.675 0.675 0.675 c 1359 1603 m 2 -6 d -10 143 d -2 5 d 8
- -126 d f 0.7 0.7 0.7 c 1349 1745 m -1 5 d 7 -109 d 2 -22 d f 0.725 0.725 0.725
- c 1348 1750 m -2 4 d 6 -91 d 3 -22 d f 0.75 0.75 0.75 c 1346 1754 m -1 5 d 4
- -74 d 3 -22 d f 0.775 0.775 0.775 c 1345 1759 m -2 5 d 4 -57 d 2 -22 d f 0.8
- 0.8 0.8 c 1343 1764 m -1 5 d 2 -40 d 3 -22 d f 0.825 0.825 0.825 c 1342 1769 m
- -2 4 d 2 -22 d 2 -22 d f 0.85 0.85 0.85 c 1340 1773 m -1 5 d -5 Y 3 -22 d f
- 0.875 0.875 0.875 c 1339 1778 m 2 Y -7 Y f 0.5 0.5 0.5 c 1335 1516 m 1 3 d -2 X
- f 0.525 0.525 0.525 c 1336 1519 m 4 13 d -12 X 6 -13 d f 0.55 0.55 0.55 c 1340
- 1532 m 3 14 d -21 -1 d 6 -13 d f 0.575 0.575 0.575 c 1343 1546 m 4 13 d -32 -1
- d 7 -13 d f 0.6 0.6 0.6 c 1347 1559 m 4 13 d -34 5 d -2 -18 d -1 Y f 0.625
- 0.625 0.625 c 1351 1572 m 3 14 d -35 11 d -2 -20 d f 0.65 0.65 0.65 c 1354 1586
- m 4 13 d -37 18 d -2 -20 d f 0.675 0.675 0.675 c 1358 1599 m 1 4 d -2 16 d -34
- 17 d -2 -19 d f 0.7 0.7 0.7 c 1357 1619 m -2 22 d -30 15 d -2 -20 d f 0.725
- 0.725 0.725 c 1355 1641 m -3 22 d -25 13 d -2 -20 d f 0.75 0.75 0.75 c 1352
- 1663 m -3 22 d -19 10 d -3 -19 d f 0.775 0.775 0.775 c 1349 1685 m -2 22 d -15
- 8 d -2 -20 d f 0.8 0.8 0.8 c 1347 1707 m -3 22 d -10 6 d -2 -20 d f 0.825 0.825
- 0.825 c 1344 1729 m -2 22 d -6 3 d -2 -19 d f 0.85 0.85 0.85 c 1342 1751 m -3
- 22 d -1 1 d -2 -20 d f 0.875 0.875 0.875 c 1339 1773 m 7 Y -1 -6 d f 0.5 0.5
- 0.5 c 1335 1514 m 2 Y -1 3 d f 0.525 0.525 0.525 c 1333 1506 m 2 8 d -1 5 d -6
- 13 d f 0.55 0.55 0.55 c 1331 1497 m 2 9 d -5 26 d -6 13 d f 0.575 0.575 0.575 c
- 1329 1489 m 2 8 d -9 48 d -7 13 d f 0.6 0.6 0.6 c 1327 1480 m 2 9 d -14 69 d 1
- Y -7 18 d f 0.625 0.625 0.625 c 1325 1471 m 2 9 d -19 97 d -8 20 d f 0.65 0.65
- 0.65 c 1323 1463 m 2 8 d -25 126 d -7 20 d f 0.675 0.675 0.675 c 1321 1454 m 2
- 9 d -30 154 d -1 3 d 3 -32 d f 0.7 0.7 0.7 c 1319 1446 m 2 8 d -26 134 d 4 -39
- d f 0.725 0.725 0.725 c 1317 1437 m 2 9 d -20 103 d 3 -38 d f 0.75 0.75 0.75 c
- 1315 1429 m 2 8 d -15 74 d 4 -39 d f 0.775 0.775 0.775 c 1313 1420 m 2 9 d -9
- 43 d 4 -39 d f 0.8 0.8 0.8 c 1312 1416 m 1 4 d -3 13 d f 0.6 0.6 0.6 c 1288
- 1598 m 1 -1 d -1 X f 0.625 0.625 0.625 c 1289 1597 m 3 -24 d -21 -8 d 17 32 d f
- 0.65 0.65 0.65 c 1292 1573 m 3 -24 d -7 61 d -20 -50 d 3 5 d f 0.675 0.675
- 0.675 c 1295 1549 m 3 -25 d -3 64 d -3 32 d -4 -10 d f 0.7 0.7 0.7 c 1298 1524
- m 3 -24 d -2 49 d -4 39 d f 0.725 0.725 0.725 c 1301 1500 m 3 -24 d -2 35 d -3
- 38 d f 0.75 0.75 0.75 c 1304 1476 m 3 -25 d -1 21 d -4 39 d f 0.775 0.775 0.775
- c 1307 1451 m 4 -24 d -1 6 d -4 39 d f 0.8 0.8 0.8 c 1311 1427 m 1 -11 d -2 17
- d f 0.6 0.6 0.6 c 1287 1594 m 1 4 d -1 Y f 0.625 0.625 0.625 c 1265 1539 m 22
- 55 d 1 3 d -17 -32 d -9 6 d -17 37 d f 0.65 0.65 0.65 c 1271 1565 m -3 -5 d -6
- 11 d f 0.625 0.625 0.625 c 1259 1537 m 6 2 d -20 69 d -3 -14 d f 0.65 0.65 0.65
- c 1244 1533 m 15 4 d -17 57 d -5 -30 d f 0.675 0.675 0.675 c 1241 1533 m 3 X -7
- 31 d -5 -30 d 4 -19 d f 0.7 0.7 0.7 c 1232 1534 m -5 -29 d 2 -11 d 7 21 d f
- 0.725 0.725 0.725 c 1227 1505 m -5 -30 d 1 -2 d 6 21 d f 0.75 0.75 0.75 c 1222
- 1475 m -1 -8 d 2 6 d f 0.625 0.625 0.625 c 1218 1500 m 1 2 d -1 3 d f 0.65 0.65
- 0.65 c 1219 1502 m 20 27 d -26 48 d 5 -72 d f 0.675 0.675 0.675 c 1239 1529 m 2
- 4 d -5 -18 d -27 133 d 4 -71 d f 0.7 0.7 0.7 c 1236 1515 m -7 -21 d -24 225 d 4
- -71 d f 0.725 0.725 0.725 c 1229 1494 m -6 -21 d -22 317 d 4 -71 d f 0.75 0.75
- 0.75 c 1223 1473 m -2 -6 d -23 384 d 3 -61 d f 0.625 0.625 0.625 c 1217 1500 m
- 1 X 5 Y f 0.65 0.65 0.65 c 1211 1506 m 6 -6 d 1 5 d -5 72 d f 0.675 0.675 0.675
- c 1204 1512 m 7 -6 d 2 71 d -4 71 d -31 -4 d -4 -41 d 6 -23 d f 0.7 0.7 0.7 c
- 1197 1518 m 7 -6 d 5 136 d -4 71 d -20 -2 d -7 -73 d 2 -64 d 10 -42 d f 0.725
- 0.725 0.725 c 1194 1521 m 3 -3 d 8 201 d -4 71 d -9 -1 d -7 -72 d 5 -179 d f
- 0.75 0.75 0.75 c 1201 1790 m -3 61 d -6 -62 d f 0.675 0.675 0.675 c 1180 1580 m
- -6 23 d -3 5 d f 0.7 0.7 0.7 c 1190 1538 m -10 42 d -9 28 d -5 7 d f 0.725
- 0.725 0.725 c 1190 1506 m 4 15 d -4 17 d -24 77 d -5 8 d f 0.75 0.75 0.75 c
- 1182 1481 m 8 25 d -29 117 d -5 7 d f 0.775 0.775 0.775 c 1174 1457 m 8 24 d
- -26 149 d -5 8 d -3 Y f 0.8 0.8 0.8 c 1171 1447 m 3 10 d -23 178 d f 0.725
- 0.725 0.725 c 1134 1624 m -7 -6 d 11 -58 d f 0.75 0.75 0.75 c 1147 1509 m 5 -12
- d -10 134 d -8 -7 d 4 -64 d f 0.775 0.775 0.775 c 1152 1497 m 14 -36 d -15 174
- d 3 Y -9 -7 d f 0.8 0.8 0.8 c 1166 1461 m 5 -14 d -20 188 d f 0.65 0.65 0.65 c
- 1107 1555 m -3 -10 d 2 -18 d f 0.675 0.675 0.675 c 1116 1583 m -9 -28 d -1 -28
- d 6 -51 d f 0.7 0.7 0.7 c 1125 1611 m -9 -28 d -4 -107 d 6 -52 d f 0.725 0.725
- 0.725 c 1138 1560 m -11 58 d -2 -7 d -7 -187 d 5 -51 d f 0.75 0.75 0.75 c 1124
- 1368 m 23 141 d -9 51 d -15 -187 d f 0.65 0.65 0.65 c 1100 1456 m 4 -12 d 2 83
- d -2 18 d -5 7 d -4 -63 d f 0.675 0.675 0.675 c 1104 1444 m 6 -24 d 2 56 d -6
- 51 d -7 25 d -14 20 d -1 -18 d 11 -65 d f 0.7 0.7 0.7 c 1110 1420 m 7 -25 d 1
- 29 d -6 52 d -27 96 d -5 7 d 4 -25 d f 0.725 0.725 0.725 c 1117 1395 m 6 -25 d
- 3 Y -5 51 d f 0.75 0.75 0.75 c 1123 1370 m 1 -2 d -1 5 d f 0.475 0.475 0.475 c
- 1058 1586 m -1 1 d 1 -9 d f 0.5 0.5 0.5 c 1061 1586 m -3 X -8 Y 2 -16 d f 0.525
- 0.525 0.525 c 1063 1585 m -2 1 d -1 -24 d 3 -17 d f 0.55 0.55 0.55 c 1066 1584
- m -3 1 d -40 Y 2 -16 d f 0.575 0.575 0.575 c 1069 1583 m -3 1 d -1 -55 d 3 -17
- d f 0.6 0.6 0.6 c 1071 1582 m -2 1 d -1 -71 d 2 -17 d f 0.625 0.625 0.625 c
- 1074 1581 m -3 1 d -1 -87 d 3 -16 d f 0.65 0.65 0.65 c 1091 1454 m 9 2 d -5 33
- d -19 92 d -2 X -1 -102 d 2 -17 d f 0.675 0.675 0.675 c 1077 1450 m 14 4 d 4 35
- d -11 65 d -5 26 d -3 1 d -1 -119 d f 0.7 0.7 0.7 c 1084 1554 m -4 25 d -1 1 d
- f 0.475 0.475 0.475 c 1058 1578 m -1 9 d -2 10 d f 0.5 0.5 0.5 c 1060 1562 m -2
- 16 d -3 19 d -2 20 d f 0.525 0.525 0.525 c 1063 1545 m -3 17 d -7 55 d -2 20 d
- f 0.55 0.55 0.55 c 1065 1529 m -2 16 d -12 92 d -2 20 d f 0.575 0.575 0.575 c
- 1068 1512 m -3 17 d -16 128 d -2 19 d f 0.6 0.6 0.6 c 1070 1495 m -2 17 d -21
- 164 d -3 20 d f 0.625 0.625 0.625 c 1073 1479 m -3 16 d -26 201 d -2 20 d f
- 0.65 0.65 0.65 c 1054 1485 m 11 -17 d 10 -6 d -2 17 d -31 237 d -2 20 d 10 -195
- d f 0.675 0.675 0.675 c 1065 1468 m 12 -18 d -2 12 d -35 274 d -2 19 d 6 -130 d
- 6 -84 d f 0.7 0.7 0.7 c 1038 1755 m -3 20 d 4 -67 d 5 -83 d f 0.725 0.725 0.725
- c 1035 1775 m -2 20 d -3 Y 6 -84 d f 0.75 0.75 0.75 c 1033 1795 m 1 Y -4 Y f
- 0.65 0.65 0.65 c 1030 1613 m 24 -128 d -4 56 d -23 72 d f 0.675 0.675 0.675 c
- 1050 1541 m -6 84 d -21 -11 d 4 -1 d f 0.7 0.7 0.7 c 1044 1625 m -5 83 d -20
- -94 d 4 X f 0.725 0.725 0.725 c 1039 1708 m -6 84 d -17 -177 d 3 -1 d f 0.75
- 0.75 0.75 c 1033 1792 m 4 Y -15 -120 d -6 -61 d 4 X f 0.775 0.775 0.775 c 1018
- 1676 m -8 -61 d 2 X f 0.65 0.65 0.65 c 1007 1473 m 23 140 d -3 X -21 -138 d f
- 0.675 0.675 0.675 c 1027 1613 m -4 1 d -22 -72 d 5 -67 d f 0.7 0.7 0.7 c 1023
- 1614 m -4 X -23 -5 d 5 -67 d f 0.725 0.725 0.725 c 1019 1614 m -3 1 d -26 61 d
- 6 -67 d f 0.75 0.75 0.75 c 1016 1615 m -4 X -19 82 d -7 33 d 4 -54 d f 0.775
- 0.775 0.775 c 1012 1615 m -2 X -17 82 d f 0.55 0.55 0.55 c 965 1650 m -2 -6 d 5
- -37 d f 0.575 0.575 0.575 c 967 1661 m -2 -11 d 3 -43 d 8 -56 d f 0.6 0.6 0.6 c
- 983 1507 m 2 -3 d -15 167 d -3 -10 d 9 -110 d f 0.625 0.625 0.625 c 985 1504 m
- 11 -16 d -23 193 d -3 -10 d f 0.65 0.65 0.65 c 996 1488 m 11 -15 d -1 2 d -30
- 216 d -3 -10 d f 0.675 0.675 0.675 c 1006 1475 m -5 67 d -23 159 d -2 -10 d f
- 0.7 0.7 0.7 c 1001 1542 m -5 67 d -15 103 d -3 -11 d f 0.725 0.725 0.725 c 996
- 1609 m -6 67 d -6 46 d -3 -10 d f 0.75 0.75 0.75 c 990 1676 m -4 54 d -2 -8 d f
- 0.55 0.55 0.55 c 968 1607 m -5 37 d -7 -10 d f 0.575 0.575 0.575 c 976 1551 m
- -8 56 d -12 27 d -11 -15 d f 0.6 0.6 0.6 c 982 1501 m 1 6 d -7 44 d -31 68 d -6
- -8 d 2 -22 d f 0.625 0.625 0.625 c 977 1469 m 5 32 d -41 88 d 4 -51 d f 0.65
- 0.65 0.65 c 972 1437 m 5 32 d -32 69 d 4 -51 d f 0.675 0.675 0.675 c 968 1406 m
- 4 31 d -23 50 d 4 -50 d f 0.7 0.7 0.7 c 963 1374 m 5 32 d -15 31 d 4 -51 d f
- 0.725 0.725 0.725 c 960 1353 m 3 21 d -6 12 d f 0.6 0.6 0.6 c 941 1589 m -2 22
- d -1 3 d f 0.625 0.625 0.625 c 945 1538 m -4 51 d -3 25 d -3 7 d f 0.65 0.65
- 0.65 c 949 1487 m -4 51 d -10 83 d -2 7 d f 0.675 0.675 0.675 c 953 1437 m -4
- 50 d -16 141 d -3 7 d f 0.7 0.7 0.7 c 936 1415 m 10 -26 d 11 -3 d -4 51 d -23
- 198 d -3 7 d 7 -202 d f 0.725 0.725 0.725 c 946 1389 m 14 -36 d -3 33 d -30 256
- d -2 7 d 5 -156 d 4 -53 d f 0.75 0.75 0.75 c 925 1649 m -3 7 d 4 -109 d 4 -54 d
- f 0.775 0.775 0.775 c 922 1656 m -3 7 d 2 -63 d 5 -53 d f 0.8 0.8 0.8 c 919
- 1663 m -2 7 d -16 Y 4 -54 d f 0.825 0.825 0.825 c 917 1670 m -1 2 d 1 -18 d f
- 0.7 0.7 0.7 c 929 1442 m 7 -27 d -2 25 d f 0.725 0.725 0.725 c 913 1499 m 16
- -57 d 5 -2 d -4 53 d f 0.75 0.75 0.75 c 913 1503 m -4 Y 17 -6 d -4 54 d -18 -38
- d f 0.775 0.775 0.775 c 926 1547 m -5 53 d -18 -84 d 5 -7 d f 0.8 0.8 0.8 c 921
- 1600 m -4 54 d -19 -130 d 5 -8 d f 0.825 0.825 0.825 c 917 1654 m -1 18 d -20
- -117 d -3 -24 d 5 -7 d f 0.85 0.85 0.85 c 896 1555 m -4 -23 d 1 -1 d f 0.725
- 0.725 0.725 c 889 1470 m 10 13 d -12 -5 d f 0.75 0.75 0.75 c 899 1483 m 14 20 d
- -5 6 d -36 63 d -3 7 d 18 -101 d f 0.775 0.775 0.775 c 908 1509 m -5 7 d -24 43
- d -7 13 d f 0.8 0.8 0.8 c 903 1516 m -5 8 d -13 22 d -6 13 d f 0.825 0.825
- 0.825 c 898 1524 m -5 7 d -2 2 d -6 13 d f 0.85 0.85 0.85 c 893 1531 m -1 1 d
- -1 1 d f 0.6 0.6 0.6 c 866 1370 m 2 11 d -5 16 d f 0.625 0.625 0.625 c 868 1381
- m 4 18 d -14 42 d 5 -44 d f 0.65 0.65 0.65 c 872 1399 m 5 18 d -24 69 d 5 -45 d
- f 0.675 0.675 0.675 c 877 1417 m 4 18 d -33 95 d 5 -44 d f 0.7 0.7 0.7 c 881
- 1435 m 4 18 d -35 110 d -5 -3 d 3 -30 d f 0.725 0.725 0.725 c 885 1453 m 4 17 d
- -2 8 d -24 96 d -13 -11 d f 0.75 0.75 0.75 c 887 1478 m -18 101 d -6 -5 d f
- 0.525 0.525 0.525 c 823 1541 m -1 X -2 Y f 0.55 0.55 0.55 c 826 1544 m -3 -3 d
- -1 -2 d 2 -4 d f 0.575 0.575 0.575 c 830 1547 m -4 -3 d -2 -9 d 1 -3 d f 0.6
- 0.6 0.6 c 864 1376 m 2 -6 d -3 27 d -30 153 d -3 -3 d -5 -15 d 1 -4 d f 0.625
- 0.625 0.625 c 862 1385 m 2 -9 d -1 21 d -5 44 d -22 112 d -3 -3 d -7 -22 d 2 -4
- d f 0.65 0.65 0.65 c 860 1395 m 2 -10 d -4 56 d -5 45 d -13 69 d -4 -2 d -8 -29
- d 1 -4 d f 0.675 0.675 0.675 c 858 1405 m 2 -10 d -7 91 d -5 44 d -5 28 d -3 -3
- d -11 -35 d 2 -4 d f 0.7 0.7 0.7 c 856 1415 m 2 -10 d -10 125 d -3 30 d -2 -2 d
- -12 -42 d 1 -4 d f 0.725 0.725 0.725 c 854 1424 m 2 -9 d -24 97 d 1 -3 d f 0.75
- 0.75 0.75 c 852 1434 m 2 -10 d -21 85 d 2 -4 d f 0.775 0.775 0.775 c 850 1444 m
- 2 -10 d -17 71 d 1 -4 d f 0.8 0.8 0.8 c 848 1453 m 2 -9 d -14 57 d 2 -4 d f
- 0.825 0.825 0.825 c 847 1463 m 1 -10 d -10 44 d 1 -4 d f 0.85 0.85 0.85 c 845
- 1473 m 2 -10 d -8 30 d 1 -4 d f 0.875 0.875 0.875 c 843 1483 m 2 -10 d -5 16 d
- 2 -4 d f 0.9 0.9 0.9 c 842 1485 m 1 -2 d -1 2 d f 0.525 0.525 0.525 c 822 1539
- m 2 Y -1 -4 d f 0.55 0.55 0.55 c 824 1535 m -2 4 d -1 -2 d -2 -12 d f 0.575
- 0.575 0.575 c 825 1532 m -1 3 d -5 -10 d -2 -11 d f 0.6 0.6 0.6 c 819 1452 m 1
- 2 d 6 74 d -1 4 d -8 -18 d -2 -12 d 2 -55 d f 0.625 0.625 0.625 c 820 1454 m 2
- 3 d 6 67 d -2 4 d -11 -26 d -2 -11 d 2 -49 d 2 5 d f 0.65 0.65 0.65 c 822 1457
- m 2 3 d 5 60 d -1 4 d -15 -33 d -1 -12 d 1 -42 d 2 5 d f 0.675 0.675 0.675 c
- 824 1460 m 2 2 d 5 54 d -2 4 d -17 -41 d -2 -11 d 1 -37 d 2 6 d f 0.7 0.7 0.7 c
- 826 1462 m 2 3 d 4 47 d -1 4 d -21 -48 d -2 -12 d -30 Y 3 5 d f 0.725 0.725
- 0.725 c 828 1465 m 2 3 d 3 41 d -1 3 d -24 -56 d -2 -11 d -24 Y 2 5 d f 0.75
- 0.75 0.75 c 830 1468 m 2 2 d 3 35 d -2 4 d -27 -64 d -2 -12 d -18 Y 2 6 d f
- 0.775 0.775 0.775 c 832 1470 m 2 3 d 2 28 d -1 4 d -31 -72 d -2 -12 d -11 Y 2 5
- d f 0.8 0.8 0.8 c 834 1473 m 2 3 d 2 21 d -2 4 d -34 -80 d -2 -11 d -5 Y 2 5 d
- f 0.825 0.825 0.825 c 836 1476 m 2 3 d 1 14 d -1 4 d -38 -87 d -2 -10 d 2 5 d f
- 0.85 0.85 0.85 c 838 1479 m 2 2 d 8 Y -1 4 d f 0.875 0.875 0.875 c 840 1481 m 2
- 3 d 1 Y -2 4 d f 0.9 0.9 0.9 c 842 1484 m 1 Y f 0.425 0.425 0.425 c 776 1685 m
- -1 18 d 3 -48 d f 0.45 0.45 0.45 c 778 1667 m -2 18 d 2 -30 d 3 -47 d f 0.475
- 0.475 0.475 c 779 1649 m -1 18 d 3 -59 d 3 -48 d f 0.5 0.5 0.5 c 780 1631 m -1
- 18 d 5 -89 d 3 -48 d f 0.525 0.525 0.525 c 782 1613 m -2 18 d 7 -119 d 3 -47 d
- f 0.55 0.55 0.55 c 783 1595 m -1 18 d 8 -148 d 4 -48 d f 0.575 0.575 0.575 c
- 795 1392 m 18 44 d -28 141 d -2 18 d 11 -178 d f 0.6 0.6 0.6 c 813 1436 m 6 16
- d -2 -5 d -31 112 d -1 18 d f 0.625 0.625 0.625 c 817 1447 m -2 -5 d -28 99 d
- -1 18 d f 0.65 0.65 0.65 c 815 1442 m -2 -5 d -24 86 d -2 18 d f 0.675 0.675
- 0.675 c 813 1437 m -2 -6 d -21 74 d -1 18 d f 0.7 0.7 0.7 c 811 1431 m -3 -5 d
- -16 61 d -2 18 d f 0.725 0.725 0.725 c 808 1426 m -2 -5 d -13 48 d -1 18 d f
- 0.75 0.75 0.75 c 806 1421 m -2 -6 d -10 36 d -1 18 d f 0.775 0.775 0.775 c 804
- 1415 m -2 -5 d -6 23 d -2 18 d f 0.8 0.8 0.8 c 802 1410 m -2 -5 d -3 10 d -1 18
- d f 0.825 0.825 0.825 c 800 1405 m -2 -5 d -1 15 d f 0.425 0.425 0.425 c 778
- 1655 m -3 48 d -2 -6 d f 0.45 0.45 0.45 c 781 1608 m -3 47 d -5 42 d -2 -6 d f
- 0.475 0.475 0.475 c 784 1560 m -3 48 d -10 83 d -1 -6 d f 0.5 0.5 0.5 c 787
- 1512 m -3 48 d -14 125 d -2 -6 d f 0.525 0.525 0.525 c 790 1465 m -3 47 d -19
- 167 d -2 -6 d f 0.55 0.55 0.55 c 794 1417 m -4 48 d -24 208 d -1 -7 d f 0.575
- 0.575 0.575 c 791 1384 m 4 8 d -1 25 d -29 249 d -2 -6 d f 0.6 0.6 0.6 c 783
- 1368 m 8 16 d -28 276 d -2 -6 d f 0.625 0.625 0.625 c 774 1351 m 9 17 d -22 286
- d -1 -6 d f 0.65 0.65 0.65 c 772 1346 m 2 5 d -14 297 d -2 -6 d 11 -259 d f
- 0.675 0.675 0.675 c 758 1642 m -2 -6 d 9 -196 d 4 -57 d f 0.7 0.7 0.7 c 756
- 1636 m -1 -6 d 5 -133 d 5 -57 d f 0.725 0.725 0.725 c 755 1630 m -2 -7 d 3 -70
- d 4 -56 d f 0.75 0.75 0.75 c 753 1623 m -2 -6 d 1 -7 d 4 -57 d f 0.775 0.775
- 0.775 c 751 1617 m 1 -7 d f 0.65 0.65 0.65 c 750 1463 m 22 -117 d -3 37 d f
- 0.675 0.675 0.675 c 748 1474 m 2 -11 d 19 -80 d -4 57 d -22 45 d f 0.7 0.7 0.7
- c 765 1440 m -5 57 d -23 X 6 -12 d f 0.725 0.725 0.725 c 760 1497 m -4 56 d -24
- -45 d 5 -11 d f 0.75 0.75 0.75 c 756 1553 m -4 57 d -7 -22 d -17 -71 d 4 -9 d f
- 0.775 0.775 0.775 c 752 1610 m -1 7 d -6 -29 d f 0.425 0.425 0.425 c 725 1388 m
- 2 8 d -22 76 d -1 -2 d f 0.45 0.45 0.45 c 727 1396 m 2 9 d -22 71 d -2 -4 d f
- 0.475 0.475 0.475 c 729 1405 m 3 8 d -23 66 d -2 -3 d f 0.5 0.5 0.5 c 732 1413
- m 2 9 d -23 61 d -2 -4 d f 0.525 0.525 0.525 c 734 1422 m 2 9 d -24 55 d -1 -3
- d f 0.55 0.55 0.55 c 736 1431 m 3 8 d -25 51 d -2 -4 d f 0.575 0.575 0.575 c
- 739 1439 m 2 9 d -25 45 d -2 -3 d f 0.6 0.6 0.6 c 741 1448 m 2 8 d -25 41 d -2
- -4 d f 0.625 0.625 0.625 c 743 1456 m 3 9 d -27 35 d -1 -3 d f 0.65 0.65 0.65 c
- 746 1465 m 2 9 d -27 30 d -2 -4 d f 0.675 0.675 0.675 c 748 1474 m -5 11 d -20
- 22 d -2 -3 d f 0.7 0.7 0.7 c 743 1485 m -6 12 d -12 14 d -2 -4 d f 0.725 0.725
- 0.725 c 737 1497 m -5 11 d -5 6 d -2 -3 d f 0.75 0.75 0.75 c 732 1508 m -4 9 d
- -1 -3 d f 0.425 0.425 0.425 c 721 1309 m 4 79 d -21 82 d -2 -55 d f 0.45 0.45
- 0.45 c 717 1230 m 4 79 d -19 106 d -4 -97 d f 0.475 0.475 0.475 c 713 1151 m 4
- 79 d -19 88 d -4 -98 d f 0.5 0.5 0.5 c 710 1072 m 3 79 d -19 69 d -4 -98 d f
- 0.525 0.525 0.525 c 706 994 m 4 78 d -20 50 d -4 -97 d f 0.55 0.55 0.55 c 702
- 915 m 4 79 d -20 31 d -5 -98 d f 0.575 0.575 0.575 c 701 898 m 1 17 d -21 12 d
- -14 Y f 0.55 0.55 0.55 c 678 892 m 1 X -20 16 d -2 -1 d f 0.575 0.575 0.575 c
- 679 892 m 22 6 d -20 15 d -22 -5 d f 0.55 0.55 0.55 c 654 886 m 24 6 d -21 15 d
- -23 -6 d f 631 880 m 23 6 d -20 15 d -24 -5 d f 1732 1139 m 23 6 d -20 16 d -24
- -6 d f 1708 1134 m 24 5 d -21 16 d -23 -6 d f 1685 1128 m 23 6 d -20 15 d -24
- -6 d f 0.425 0.425 0.425 c 1645 1662 m -4 107 d 1 -17 d f 0.45 0.45 0.45 c 1649
- 1555 m -4 107 d -3 90 d 2 -16 d f 0.475 0.475 0.475 c 1653 1449 m -4 106 d -5
- 181 d 1 -17 d f 0.5 0.5 0.5 c 1657 1342 m -4 107 d -8 270 d 1 -17 d f 0.525
- 0.525 0.525 c 1661 1236 m -4 106 d -11 360 d 2 -16 d f 0.55 0.55 0.55 c 1684
- 1129 m 1 -1 d -21 15 d -3 93 d -13 450 d 1 -17 d f 0.575 0.575 0.575 c 1682
- 1174 m 2 -45 d -35 540 d 1 -16 d f 0.6 0.6 0.6 c 1679 1219 m 3 -45 d -32 479 d
- 2 -17 d f 0.625 0.625 0.625 c 1676 1265 m 3 -46 d -27 417 d 1 -16 d f 0.65 0.65
- 0.65 c 1674 1310 m 2 -45 d -23 355 d 2 -17 d f 0.675 0.675 0.675 c 1671 1355 m
- 3 -45 d -19 293 d 1 -16 d f 0.7 0.7 0.7 c 1668 1400 m 3 -45 d -15 232 d 1 -17 d
- f 0.725 0.725 0.725 c 1666 1445 m 2 -45 d -11 170 d 2 -16 d f 0.75 0.75 0.75 c
- 1663 1491 m 3 -46 d -7 109 d 1 -17 d f 0.775 0.775 0.775 c 1661 1525 m 2 -34 d
- -3 46 d f 0.425 0.425 0.425 c 1642 1752 m -1 17 d -24 -87 d 2 -20 d f 0.45 0.45
- 0.45 c 1644 1736 m -2 16 d -23 -90 d 5 -59 d f 0.475 0.475 0.475 c 1645 1719 m
- -1 17 d -20 -133 d 4 -59 d f 0.5 0.5 0.5 c 1646 1702 m -1 17 d -17 -175 d 5 -59
- d f 0.525 0.525 0.525 c 1648 1686 m -2 16 d -13 -217 d 4 -59 d f 0.55 0.55 0.55
- c 1638 1425 m 2 10 d 9 234 d -1 17 d -11 -260 d f 0.575 0.575 0.575 c 1640 1435
- m 2 10 d 8 208 d -1 16 d f 0.6 0.6 0.6 c 1642 1445 m 3 10 d 7 181 d -2 17 d f
- 0.625 0.625 0.625 c 1645 1455 m 2 10 d 6 155 d -1 16 d f 0.65 0.65 0.65 c 1647
- 1465 m 3 11 d 5 127 d -2 17 d f 0.675 0.675 0.675 c 1650 1476 m 2 10 d 4 101 d
- -1 16 d f 0.7 0.7 0.7 c 1652 1486 m 2 10 d 3 74 d -1 17 d f 0.725 0.725 0.725 c
- 1654 1496 m 3 11 d 2 47 d -2 16 d f 0.75 0.75 0.75 c 1657 1507 m 2 10 d 1 20 d
- -1 17 d f 0.775 0.775 0.775 c 1659 1517 m 2 8 d -1 12 d f 0.425 0.425 0.425 c
- 1619 1662 m -2 20 d -3 Y f 0.45 0.45 0.45 c 1624 1603 m -5 59 d -2 17 d -2 -9 d
- f 0.475 0.475 0.475 c 1628 1544 m -4 59 d -9 67 d -2 -9 d f 0.5 0.5 0.5 c 1633
- 1485 m -5 59 d -15 117 d -1 -9 d f 0.525 0.525 0.525 c 1637 1426 m -4 59 d -21
- 167 d -2 -9 d f 0.55 0.55 0.55 c 1635 1424 m 3 1 d -1 1 d -27 217 d -2 -9 d f
- 0.575 0.575 0.575 c 1632 1423 m 3 1 d -27 210 d -1 -9 d f 0.6 0.6 0.6 c 1630
- 1423 m 2 X -25 202 d -2 -10 d f 0.625 0.625 0.625 c 1627 1422 m 3 1 d -25 192 d
- -2 -9 d f 0.65 0.65 0.65 c 1624 1421 m 3 1 d -24 184 d -1 -9 d f 0.675 0.675
- 0.675 c 1622 1421 m 2 X -22 176 d -2 -9 d f 0.7 0.7 0.7 c 1619 1420 m 3 1 d -22
- 167 d -2 -9 d f 0.725 0.725 0.725 c 1616 1419 m 3 1 d -21 159 d -1 -9 d f 0.75
- 0.75 0.75 c 1614 1419 m 2 X -19 151 d -2 -9 d 14 -108 d f 0.775 0.775 0.775 c
- 1595 1561 m -1 -6 d 15 -102 d f 0.475 0.475 0.475 c 1571 1639 m -1 4 d 2 -13 d
- f 0.5 0.5 0.5 c 1573 1632 m -2 7 d 1 -9 d 3 -25 d f 0.525 0.525 0.525 c 1575
- 1625 m -2 7 d 2 -27 d 3 -25 d f 0.55 0.55 0.55 c 1577 1618 m -2 7 d 3 -45 d 3
- -24 d f 0.575 0.575 0.575 c 1579 1610 m -2 8 d 4 -62 d 3 -25 d f 0.6 0.6 0.6 c
- 1581 1603 m -2 7 d 5 -79 d 3 -25 d f 0.625 0.625 0.625 c 1583 1596 m -2 7 d 6
- -97 d 3 -24 d f 0.65 0.65 0.65 c 1591 1480 m 4 -12 d -10 121 d -2 7 d 7 -114 d
- f 0.675 0.675 0.675 c 1595 1468 m 5 -13 d -13 127 d -2 7 d f 0.7 0.7 0.7 c 1600
- 1455 m 5 -13 d -16 132 d -2 8 d f 0.725 0.725 0.725 c 1605 1442 m 5 -13 d -19
- 138 d -2 7 d f 0.75 0.75 0.75 c 1610 1429 m 4 -10 d -5 34 d -17 107 d -1 7 d f
- 0.775 0.775 0.775 c 1609 1453 m -15 102 d -2 5 d f 0.475 0.475 0.475 c 1572
- 1630 m -2 13 d -1 6 d f 0.5 0.5 0.5 c 1575 1605 m -3 25 d -3 19 d -2 11 d f
- 0.525 0.525 0.525 c 1578 1580 m -3 25 d -8 55 d -1 12 d f 0.55 0.55 0.55 c 1581
- 1556 m -3 24 d -12 92 d -2 11 d f 0.575 0.575 0.575 c 1584 1531 m -3 25 d -17
- 127 d -2 11 d f 0.6 0.6 0.6 c 1587 1506 m -3 25 d -22 163 d -2 11 d f 0.625
- 0.625 0.625 c 1590 1482 m -3 24 d -27 199 d -2 11 d f 0.65 0.65 0.65 c 1567
- 1460 m 24 20 d -1 2 d -32 234 d -2 11 d 10 -243 d f 0.675 0.675 0.675 c 1556
- 1727 m -2 12 d 8 -197 d 4 -58 d f 0.7 0.7 0.7 c 1554 1739 m -1 11 d 5 -149 d 4
- -59 d f 0.725 0.725 0.725 c 1553 1750 m -2 11 d 4 -102 d 3 -58 d f 0.75 0.75
- 0.75 c 1551 1761 m -2 11 d 2 -54 d 4 -59 d f 0.775 0.775 0.775 c 1549 1772 m -2
- 11 d -7 Y 4 -58 d f 0.8 0.8 0.8 c 1547 1783 m 2 Y -9 Y f 0.425 0.425 0.425 c
- 1525 1665 m -2 -7 d 3 -36 d f 0.45 0.45 0.45 c 1526 1673 m -1 -8 d 1 -43 d 4
- -45 d f 0.475 0.475 0.475 c 1528 1682 m -2 -9 d 4 -96 d 4 -45 d f 0.5 0.5 0.5 c
- 1529 1690 m -1 -8 d 6 -150 d 4 -45 d f 0.525 0.525 0.525 c 1531 1699 m -2 -9 d
- 9 -203 d 4 -45 d f 0.55 0.55 0.55 c 1544 1428 m 3 5 d -15 274 d -1 -8 d 11 -257
- d f 0.575 0.575 0.575 c 1547 1433 m 6 7 d -19 276 d -2 -9 d f 0.6 0.6 0.6 c
- 1553 1440 m 5 8 d -22 276 d -2 -8 d f 0.625 0.625 0.625 c 1558 1448 m 6 8 d -27
- 277 d -1 -9 d f 0.65 0.65 0.65 c 1564 1456 m 3 4 d -1 24 d -27 257 d -2 -8 d f
- 0.675 0.675 0.675 c 1566 1484 m -4 58 d -22 208 d -1 -9 d f 0.7 0.7 0.7 c 1562
- 1542 m -4 59 d -16 157 d -2 -8 d f 0.725 0.725 0.725 c 1558 1601 m -3 58 d -12
- 108 d -1 -9 d f 0.75 0.75 0.75 c 1555 1659 m -4 59 d -6 57 d -2 -8 d f 0.775
- 0.775 0.775 c 1551 1718 m -4 58 d 8 Y -2 -9 d f 0.8 0.8 0.8 c 1547 1776 m 9 Y
- -1 Y f 0.425 0.425 0.425 c 1526 1622 m -3 36 d -1 -9 d f 0.45 0.45 0.45 c 1530
- 1577 m -4 45 d -4 27 d -1 -12 d f 0.475 0.475 0.475 c 1534 1532 m -4 45 d -9 60
- d -2 -12 d f 0.5 0.5 0.5 c 1538 1487 m -4 45 d -15 93 d -1 -11 d f 0.525 0.525
- 0.525 c 1542 1442 m -4 45 d -20 127 d -2 -12 d f 0.55 0.55 0.55 c 1541 1432 m 3
- -4 d -2 14 d -26 160 d -1 -12 d f 0.575 0.575 0.575 c 1536 1439 m 5 -7 d -26
- 158 d -1 -12 d f 0.6 0.6 0.6 c 1532 1445 m 4 -6 d -22 139 d -2 -11 d f 0.625
- 0.625 0.625 c 1527 1452 m 5 -7 d -20 122 d -1 -12 d f 0.65 0.65 0.65 c 1522
- 1459 m 5 -7 d -16 103 d -2 -12 d f 0.675 0.675 0.675 c 1520 1462 m 2 -3 d -13
- 84 d -1 -12 d 11 -69 d f 0.7 0.7 0.7 c 1508 1531 m -1 -11 d 8 -58 d 4 X f 0.725
- 0.725 0.725 c 1507 1520 m -2 -12 d 7 -45 d 3 -1 d f 0.75 0.75 0.75 c 1505 1508
- m -1 -12 d 5 -33 d 3 X f 0.775 0.775 0.775 c 1504 1496 m -2 -11 d 4 -22 d 3 X f
- 0.8 0.8 0.8 c 1502 1485 m -1 -12 d 1 -9 d 4 -1 d f 0.825 0.825 0.825 c 1501
- 1473 m -1 -9 d 2 X f 0.475 0.475 0.475 c 1477 1625 m -1 8 d 3 -29 d f 0.5 0.5
- 0.5 c 1479 1613 m -2 12 d 2 -21 d 4 -43 d f 0.525 0.525 0.525 c 1481 1602 m -2
- 11 d 4 -52 d 4 -43 d f 0.55 0.55 0.55 c 1482 1590 m -1 12 d 6 -84 d 4 -44 d f
- 0.575 0.575 0.575 c 1484 1578 m -2 12 d 9 -116 d 4 -43 d f 0.6 0.6 0.6 c 1497
- 1416 m 4 9 d -15 141 d -2 12 d 11 -147 d f 0.625 0.625 0.625 c 1501 1425 m 8 15
- d -22 115 d -1 11 d f 0.65 0.65 0.65 c 1509 1440 m 7 15 d -27 88 d -2 12 d f
- 0.675 0.675 0.675 c 1516 1455 m 4 7 d -1 X -29 69 d -1 12 d f 0.7 0.7 0.7 c
- 1519 1462 m -4 X -23 58 d -2 11 d f 0.725 0.725 0.725 c 1515 1462 m -3 1 d -18
- 45 d -2 12 d f 0.75 0.75 0.75 c 1512 1463 m -3 X -14 33 d -1 12 d f 0.775 0.775
- 0.775 c 1509 1463 m -3 X -9 22 d -2 11 d f 0.8 0.8 0.8 c 1506 1463 m -4 1 d -3
- 9 d -2 12 d f 0.825 0.825 0.825 c 1502 1464 m -2 X -1 9 d f 0.475 0.475 0.475 c
- 1479 1604 m -3 29 d -1 3 d f 0.5 0.5 0.5 c 1483 1561 m -4 43 d -4 32 d -2 6 d f
- 0.525 0.525 0.525 c 1487 1518 m -4 43 d -10 81 d -2 6 d f 0.55 0.55 0.55 c 1491
- 1474 m -4 44 d -16 130 d -3 5 d f 0.575 0.575 0.575 c 1495 1431 m -4 43 d -23
- 179 d -2 6 d f 0.6 0.6 0.6 c 1493 1421 m 4 -5 d -2 15 d -29 228 d -2 6 d f
- 0.625 0.625 0.625 c 1486 1431 m 7 -10 d -29 244 d -2 5 d f 0.65 0.65 0.65 c
- 1480 1440 m 6 -9 d -24 239 d -2 6 d f 0.675 0.675 0.675 c 1474 1449 m 6 -9 d
- -20 236 d -3 6 d f 0.7 0.7 0.7 c 1473 1450 m 1 -1 d -17 233 d -2 5 d 9 -131 d f
- 0.725 0.725 0.725 c 1455 1687 m -2 6 d 1 -16 d 10 -121 d f 0.75 0.75 0.75 c
- 1453 1693 m 1 Y 1 -17 d f 0.5 0.5 0.5 c 1430 1556 m -1 -2 d 1 -5 d f 0.525
- 0.525 0.525 c 1432 1572 m -2 -16 d -7 Y 2 -21 d f 0.55 0.55 0.55 c 1435 1587 m
- -3 -15 d -44 Y 2 -21 d f 0.575 0.575 0.575 c 1437 1602 m -2 -15 d -1 -80 d 2
- -21 d f 0.6 0.6 0.6 c 1440 1617 m -3 -15 d -1 -116 d 2 -21 d f 0.625 0.625
- 0.625 c 1442 1632 m -2 -15 d -2 -152 d 2 -21 d f 0.65 0.65 0.65 c 1445 1647 m
- -3 -15 d -2 -188 d 2 -21 d f 0.675 0.675 0.675 c 1447 1662 m -2 -15 d -3 -224 d
- 2 -22 d f 0.7 0.7 0.7 c 1466 1416 m 7 34 d -9 106 d -14 121 d -3 -15 d -3 -261
- d 2 -21 d f 0.725 0.725 0.725 c 1458 1378 m 8 38 d -2 140 d -10 121 d -2 15 d
- -2 -15 d -4 -297 d 2 -21 d f 0.75 0.75 0.75 c 1450 1339 m 8 39 d -4 299 d -1 17
- d -1 -2 d -4 -333 d 2 -21 d f 0.775 0.775 0.775 c 1450 1336 m 3 Y -1 Y f 0.5
- 0.5 0.5 c 1430 1549 m -1 5 d -2 Y f 0.525 0.525 0.525 c 1432 1528 m -2 21 d -1
- 3 d -4 -6 d f 0.55 0.55 0.55 c 1434 1507 m -2 21 d -7 18 d -3 -6 d f 0.575
- 0.575 0.575 c 1436 1486 m -2 21 d -12 33 d -3 -7 d f 0.6 0.6 0.6 c 1438 1465 m
- -2 21 d -17 47 d -3 -6 d f 0.625 0.625 0.625 c 1440 1444 m -2 21 d -22 62 d -3
- -7 d f 0.65 0.65 0.65 c 1442 1423 m -2 21 d -27 76 d -4 -6 d f 0.675 0.675
- 0.675 c 1444 1401 m -2 22 d -33 91 d -3 -6 d f 0.7 0.7 0.7 c 1446 1380 m -2 21
- d -38 107 d -1 Y 4 -24 d f 0.725 0.725 0.725 c 1448 1359 m -2 21 d -36 103 d 5
- -25 d f 0.75 0.75 0.75 c 1450 1338 m -2 21 d -33 99 d 5 -25 d f 0.775 0.775
- 0.775 c 1433 1380 m 17 -44 d 2 Y -30 95 d 4 -26 d f 0.8 0.8 0.8 c 1426 1398 m 7
- -18 d -9 27 d f 0.575 0.575 0.575 c 1385 1526 m -3 2 d 2 -12 d f 0.6 0.6 0.6 c
- 1390 1521 m -5 5 d -1 -10 d 3 -25 d f 0.625 0.625 0.625 c 1395 1517 m -5 4 d -3
- -30 d 3 -24 d f 0.65 0.65 0.65 c 1400 1512 m -5 5 d -5 -50 d 3 -25 d f 0.675
- 0.675 0.675 c 1406 1508 m -6 4 d -7 -70 d 3 -25 d f 0.7 0.7 0.7 c 1410 1483 m
- -4 24 d 1 Y -10 -91 d 3 -24 d f 0.725 0.725 0.725 c 1415 1458 m -5 25 d -11 -90
- d 3 -25 d f 0.75 0.75 0.75 c 1403 1365 m 9 13 d 8 55 d -5 25 d -13 -90 d f
- 0.775 0.775 0.775 c 1412 1378 m 10 14 d 2 15 d -4 26 d f 0.8 0.8 0.8 c 1422
- 1392 m 4 6 d -2 9 d f 0.575 0.575 0.575 c 1384 1516 m -2 12 d -3 10 d f 0.6 0.6
- 0.6 c 1387 1491 m -3 25 d -5 22 d -6 20 d f 0.625 0.625 0.625 c 1390 1467 m -3
- 24 d -14 67 d -6 19 d f 0.65 0.65 0.65 c 1393 1442 m -3 25 d -23 110 d -6 20 d
- f 0.675 0.675 0.675 c 1396 1417 m -3 25 d -32 155 d -2 6 d 4 -40 d f 0.7 0.7
- 0.7 c 1399 1393 m -3 24 d -33 146 d 6 -56 d f 0.725 0.725 0.725 c 1402 1368 m
- -3 25 d -30 114 d 6 -55 d f 0.75 0.75 0.75 c 1379 1413 m 24 -48 d -1 3 d -27 84
- d f 0.5 0.5 0.5 c 1336 1519 m -1 -3 d 1 -3 d f 0.525 0.525 0.525 c 1340 1532 m
- -4 -13 d -6 Y 4 -16 d f 0.55 0.55 0.55 c 1343 1546 m -3 -14 d -35 Y 4 -16 d f
- 0.575 0.575 0.575 c 1347 1559 m -4 -13 d 1 -65 d 4 -16 d f 0.6 0.6 0.6 c 1351
- 1572 m -4 -13 d 1 -94 d 4 -16 d f 0.625 0.625 0.625 c 1356 1433 m -2 153 d -3
- -14 d 1 -123 d f 0.65 0.65 0.65 c 1356 1433 m 5 -4 d -3 170 d -4 -13 d f 0.675
- 0.675 0.675 c 1361 1429 m 5 -4 d -3 138 d -4 40 d -1 -4 d f 0.7 0.7 0.7 c 1366
- 1425 m 5 -5 d -2 87 d -6 56 d f 0.725 0.725 0.725 c 1371 1420 m 5 -4 d -1 36 d
- -6 55 d f 0.75 0.75 0.75 c 1376 1416 m 3 -3 d -4 39 d f 0.5 0.5 0.5 c 1336 1513
- m -1 3 d -2 Y f 0.525 0.525 0.525 c 1340 1497 m -4 16 d -1 1 d -2 -8 d f 0.55
- 0.55 0.55 c 1344 1481 m -4 16 d -7 9 d -2 -9 d f 0.575 0.575 0.575 c 1348 1465
- m -4 16 d -13 16 d -2 -8 d f 0.6 0.6 0.6 c 1352 1449 m -4 16 d -19 24 d -2 -9 d
- f 0.625 0.625 0.625 c 1356 1434 m -1 Y -4 16 d -25 31 d -2 -9 d f 0.65 0.65
- 0.65 c 1352 1435 m 4 -1 d -31 37 d -2 -8 d f 0.675 0.675 0.675 c 1348 1436 m 4
- -1 d -29 28 d -2 -9 d f 0.7 0.7 0.7 c 1344 1437 m 4 -1 d -27 18 d -2 -8 d f
- 0.725 0.725 0.725 c 1340 1439 m 4 -2 d -25 9 d -2 -9 d f 0.75 0.75 0.75 c 1335
- 1440 m 5 -1 d -23 -2 d -2 -8 d f 0.775 0.775 0.775 c 1332 1441 m 3 -1 d -20 -11
- d -2 -9 d 13 13 d f 0.8 0.8 0.8 c 1313 1420 m -1 -4 d 14 17 d f 0.6 0.6 0.6 c
- 1289 1597 m -1 1 d 1 -2 d f 0.625 0.625 0.625 c 1292 1573 m -3 24 d -1 Y 4 -39
- d f 0.65 0.65 0.65 c 1295 1549 m -3 24 d 1 -16 d 5 -40 d f 0.675 0.675 0.675 c
- 1298 1524 m -3 25 d 3 -32 d 4 -39 d f 0.7 0.7 0.7 c 1301 1500 m -3 24 d 4 -46 d
- 5 -40 d f 0.725 0.725 0.725 c 1309 1422 m 5 4 d -10 50 d -3 24 d 6 -62 d f 0.75
- 0.75 0.75 c 1314 1426 m 10 8 d -17 17 d -3 25 d f 0.775 0.775 0.775 c 1324 1434
- m 8 7 d -6 -8 d -15 -6 d -4 24 d f 0.8 0.8 0.8 c 1326 1433 m -14 -17 d -1 11 d
- f 0.6 0.6 0.6 c 1289 1596 m -1 2 d -1 -4 d f 0.625 0.625 0.625 c 1293 1557 m -4
- 39 d -2 -2 d -22 -55 d 4 -35 d f 0.65 0.65 0.65 c 1298 1517 m -5 40 d -24 -53 d
- 11 -92 d f 0.675 0.675 0.675 c 1285 1362 m 6 14 d 11 102 d -4 39 d -18 -105 d f
- 0.7 0.7 0.7 c 1291 1376 m 12 32 d 4 30 d -5 40 d f 0.725 0.725 0.725 c 1303
- 1408 m 6 14 d -2 16 d f 0.625 0.625 0.625 c 1269 1504 m -4 35 d -6 -2 d f 0.65
- 0.65 0.65 c 1280 1412 m -11 92 d -10 33 d -15 -4 d f 0.675 0.675 0.675 c 1279
- 1353 m 6 9 d -5 50 d -36 121 d -3 X 8 -80 d f 0.7 0.7 0.7 c 1266 1335 m 13 18 d
- -30 100 d 10 -93 d f 0.725 0.725 0.725 c 1262 1329 m 4 6 d -7 25 d f 0.625
- 0.625 0.625 c 1219 1502 m -1 -2 d -4 Y f 0.65 0.65 0.65 c 1239 1529 m -20 -27 d
- -1 -6 d 5 -49 d f 0.675 0.675 0.675 c 1249 1453 m -8 80 d -2 -4 d -16 -82 d 4
- -49 d f 0.7 0.7 0.7 c 1259 1360 m -10 93 d -22 -55 d 5 -49 d f 0.725 0.725
- 0.725 c 1247 1299 m 15 30 d -3 31 d -27 -11 d 5 -49 d f 0.75 0.75 0.75 c 1238
- 1283 m 9 16 d -10 1 d f 0.625 0.625 0.625 c 1218 1496 m 4 Y -1 X f 0.65 0.65
- 0.65 c 1215 1398 m 4 -23 d 4 72 d -5 49 d -1 4 d -6 6 d -1 -77 d f 0.675 0.675
- 0.675 c 1219 1375 m 6 -28 d 2 51 d -4 49 d -12 59 d -7 6 d -1 -45 d 7 -38 d f
- 0.7 0.7 0.7 c 1225 1347 m 6 -27 d 1 29 d -5 49 d -23 114 d -7 6 d -13 Y 6 -38 d
- f 0.725 0.725 0.725 c 1231 1320 m 5 -27 d 1 7 d -5 49 d -35 169 d -3 3 d 3 -16
- d f 0.75 0.75 0.75 c 1236 1293 m 2 -10 d -1 17 d f 0.65 0.65 0.65 c 1213 1402 m
- 2 -4 d -5 31 d f 0.675 0.675 0.675 c 1210 1408 m 3 -6 d -3 27 d -7 38 d f 0.7
- 0.7 0.7 c 1207 1413 m 3 -5 d -7 59 d -6 38 d f 0.725 0.725 0.725 c 1205 1418 m
- 2 -5 d -10 92 d -3 16 d -4 -15 d f 0.75 0.75 0.75 c 1202 1424 m 3 -6 d -15 88 d
- -8 -25 d f 0.775 0.775 0.775 c 1199 1429 m 3 -5 d -20 57 d -8 -24 d f 0.8 0.8
- 0.8 c 1197 1435 m 2 -6 d -25 28 d -3 -10 d 5 X f 0.825 0.825 0.825 c 1194 1440
- m 3 -5 d -21 12 d 8 -1 d f 0.85 0.85 0.85 c 1191 1445 m 3 -5 d -10 6 d f 0.625
- 0.625 0.625 c 1168 1399 m 2 4 d -6 15 d f 0.65 0.65 0.65 c 1170 1403 m 2 5 d
- -11 29 d 3 -19 d f 0.675 0.675 0.675 c 1172 1408 m 3 5 d -18 44 d 4 -20 d f 0.7
- 0.7 0.7 c 1175 1413 m 2 5 d -23 58 d 3 -19 d f 0.725 0.725 0.725 c 1177 1418 m
- 3 4 d -30 74 d 4 -20 d f 0.75 0.75 0.75 c 1180 1422 m 2 5 d -30 70 d -5 12 d 3
- -13 d f 0.775 0.775 0.775 c 1182 1427 m 2 5 d -18 29 d -14 36 d f 0.8 0.8 0.8 c
- 1184 1432 m 3 4 d -11 11 d -5 X -5 14 d f 0.825 0.825 0.825 c 1187 1436 m 2 5 d
- -5 5 d -8 1 d f 0.85 0.85 0.85 c 1189 1441 m 2 4 d -7 1 d f 0.625 0.625 0.625 c
- 1162 1384 m 6 15 d -4 19 d f 0.65 0.65 0.65 c 1155 1367 m 7 17 d 2 34 d -3 19 d
- f 0.675 0.675 0.675 c 1149 1351 m 6 16 d 6 70 d -4 20 d f 0.7 0.7 0.7 c 1144
- 1339 m 5 12 d 8 106 d -3 19 d -14 -130 d f 0.725 0.725 0.725 c 1154 1476 m -4
- 20 d -25 -130 d 15 -20 d f 0.75 0.75 0.75 c 1150 1496 m -3 13 d -23 -141 d 1 -2
- d f 0.65 0.65 0.65 c 1104 1444 m -4 12 d 5 -25 d f 0.675 0.675 0.675 c 1110
- 1420 m -6 24 d 1 -13 d 10 -52 d f 0.7 0.7 0.7 c 1121 1347 m 23 -8 d -4 7 d -23
- 49 d -7 25 d 5 -41 d f 0.725 0.725 0.725 c 1140 1346 m -15 20 d -2 4 d -6 25 d
- f 0.75 0.75 0.75 c 1125 1366 m -1 2 d -1 2 d f 0.65 0.65 0.65 c 1105 1431 m -5
- 25 d -9 -2 d f 0.675 0.675 0.675 c 1115 1379 m -10 52 d -14 23 d -14 -4 d 5 -18
- d f 0.7 0.7 0.7 c 1097 1368 m 24 -21 d -6 32 d -33 53 d f 0.65 0.65 0.65 c 1065
- 1468 m -11 17 d 17 -117 d f 0.675 0.675 0.675 c 1074 1348 m 11 10 d -3 74 d -5
- 18 d -12 18 d 6 -100 d f 0.7 0.7 0.7 c 1085 1358 m 12 10 d -15 64 d f 0.6 0.6
- 0.6 c 1050 1329 m 1 1 d -2 18 d f 0.625 0.625 0.625 c 1051 1330 m 11 9 d -27
- 211 d 14 -202 d f 0.65 0.65 0.65 c 1062 1339 m 11 8 d -2 21 d -17 117 d -24 128
- d 5 -63 d f 0.675 0.675 0.675 c 1073 1347 m 1 1 d -3 20 d f 0.6 0.6 0.6 c 1050
- 1329 m -1 19 d f 0.625 0.625 0.625 c 1046 1332 m 4 -3 d -1 19 d -14 202 d f
- 0.65 0.65 0.65 c 1043 1335 m 3 -3 d -11 218 d -5 63 d -23 -140 d -1 Y f 0.675
- 0.675 0.675 c 1039 1339 m 4 -4 d -36 137 d 4 -27 d f 0.7 0.7 0.7 c 1036 1342 m
- 3 -3 d -28 106 d 5 -27 d f 0.725 0.725 0.725 c 1032 1345 m 4 -3 d -20 76 d 4
- -27 d f 0.75 0.75 0.75 c 1029 1348 m 3 -3 d -12 46 d 5 -27 d f 0.775 0.775
- 0.775 c 1027 1350 m 2 -2 d -4 16 d f 0.6 0.6 0.6 c 985 1504 m -2 3 d 4 -19 d f
- 0.625 0.625 0.625 c 1003 1398 m 1 -1 d -8 91 d -11 16 d 2 -16 d f 0.65 0.65
- 0.65 c 1004 1397 m 4 -8 d -1 83 d 1 Y -11 15 d f 0.675 0.675 0.675 c 1008 1389
- m 4 -9 d -1 65 d -4 27 d f 0.7 0.7 0.7 c 1012 1380 m 4 -9 d 47 Y -5 27 d f
- 0.725 0.725 0.725 c 1016 1371 m 4 -8 d 28 Y -4 27 d f 0.75 0.75 0.75 c 1020
- 1363 m 5 -9 d 10 Y -5 27 d f 0.775 0.775 0.775 c 1025 1354 m 2 -4 d -2 14 d f
- 0.6 0.6 0.6 c 987 1488 m -4 19 d -1 -6 d f 0.625 0.625 0.625 c 1003 1397 m 1 Y
- -16 90 d -5 13 d -5 -32 d f 0.65 0.65 0.65 c 998 1388 m 5 9 d -26 72 d -5 -32 d
- f 0.675 0.675 0.675 c 994 1378 m 4 10 d -26 49 d -4 -31 d f 0.7 0.7 0.7 c 989
- 1369 m 5 9 d -26 28 d -5 -32 d f 0.725 0.725 0.725 c 984 1359 m 5 10 d -26 5 d
- -3 -21 d 6 X f 0.75 0.75 0.75 c 980 1351 m 4 8 d -18 -6 d f 0.7 0.7 0.7 c 946
- 1389 m -10 26 d 10 -2 d f 0.725 0.725 0.725 c 956 1412 m 10 -24 d -35 Y -6 X
- -14 36 d 24 Y f 0.75 0.75 0.75 c 966 1388 m 14 -37 d -14 2 d f 0.625 0.625
- 0.625 c 933 1326 m 4 17 d -8 13 d f 0.65 0.65 0.65 c 937 1343 m 6 20 d -18 29 d
- 4 -36 d f 0.675 0.675 0.675 c 943 1363 m 5 20 d -27 45 d 4 -36 d f 0.7 0.7 0.7
- c 948 1383 m 6 20 d -8 10 d -10 2 d -7 27 d -12 22 d 4 -36 d f 0.725 0.725
- 0.725 c 954 1403 m 2 9 d -10 1 d -17 29 d -16 57 d 2 Y 4 -37 d f 0.75 0.75 0.75
- c 913 1499 m 4 Y -2 Y f 0.625 0.625 0.625 c 927 1298 m 6 28 d -4 30 d f 0.65
- 0.65 0.65 c 920 1265 m 7 33 d 2 58 d -4 36 d f 0.675 0.675 0.675 c 913 1232 m 7
- 33 d 5 127 d -4 36 d f 0.7 0.7 0.7 c 909 1212 m 4 20 d 8 196 d -4 36 d -14 -173
- d f 0.725 0.725 0.725 c 917 1464 m -4 37 d -14 -18 d -10 -13 d 14 -179 d f 0.75
- 0.75 0.75 c 913 1501 m 2 Y -14 -20 d f 0.475 0.475 0.475 c 886 1435 m 1 -6 d -2
- 3 d f 0.5 0.5 0.5 c 887 1429 m 2 -25 d -8 13 d 4 15 d f 0.525 0.525 0.525 c 889
- 1404 m 3 -25 d -16 24 d 5 14 d f 0.55 0.55 0.55 c 892 1379 m 3 -26 d -23 36 d 4
- 14 d f 0.575 0.575 0.575 c 895 1353 m 2 -25 d -30 47 d 5 14 d f 0.6 0.6 0.6 c
- 897 1328 m 3 -25 d -32 78 d -2 -11 d 1 5 d f 0.625 0.625 0.625 c 900 1303 m 3
- -26 d -31 122 d -4 -18 d f 0.65 0.65 0.65 c 903 1277 m 2 -25 d -28 165 d -5 -18
- d f 0.675 0.675 0.675 c 905 1252 m 3 -25 d -27 208 d -4 -18 d f 0.7 0.7 0.7 c
- 908 1227 m 1 -15 d -6 79 d -18 162 d -4 -18 d f 0.725 0.725 0.725 c 903 1291 m
- -14 179 d -4 -17 d f 0.475 0.475 0.475 c 885 1434 m 1 1 d -1 -3 d f 0.5 0.5 0.5
- c 883 1433 m 2 1 d -2 Y -4 -15 d f 0.525 0.525 0.525 c 881 1431 m 2 2 d -2 -16
- d -5 -14 d f 0.55 0.55 0.55 c 879 1429 m 2 2 d -5 -28 d -4 -14 d f 0.575 0.575
- 0.575 c 877 1427 m 2 2 d -7 -40 d -5 -14 d f 0.6 0.6 0.6 c 875 1426 m 2 1 d -10
- -52 d -1 -5 d -2 6 d f 0.625 0.625 0.625 c 873 1424 m 2 2 d -11 -50 d -2 9 d f
- 0.65 0.65 0.65 c 871 1422 m 2 2 d -11 -39 d -2 10 d f 0.675 0.675 0.675 c 869
- 1420 m 2 2 d -11 -27 d -2 10 d f 0.7 0.7 0.7 c 866 1419 m 3 1 d -11 -15 d -2 10
- d f 0.725 0.725 0.725 c 864 1417 m 2 2 d -10 -4 d -2 9 d f 0.75 0.75 0.75 c 862
- 1415 m 2 2 d -10 7 d -2 10 d 10 -17 d f 0.775 0.775 0.775 c 852 1434 m -2 10 d
- 8 -14 d 4 -13 d f 0.8 0.8 0.8 c 850 1444 m -2 9 d 6 -10 d 4 -13 d f 0.825 0.825
- 0.825 c 848 1453 m -1 10 d 4 -7 d 3 -13 d f 0.85 0.85 0.85 c 847 1463 m -2 10 d
- 2 -4 d 4 -13 d f 0.875 0.875 0.875 c 845 1473 m -2 10 d -1 Y 4 -13 d f 0.9 0.9
- 0.9 c 843 1483 m -1 2 d 1 -3 d f 0.55 0.55 0.55 c 839 1396 m 1 1 d -6 13 d f
- 0.575 0.575 0.575 c 840 1397 m 3 2 d -22 47 d 13 -36 d f 0.6 0.6 0.6 c 843 1399
- m 3 3 d -26 52 d -1 -2 d 2 -6 d f 0.625 0.625 0.625 c 846 1402 m 3 2 d -27 53 d
- -2 -3 d f 0.65 0.65 0.65 c 849 1404 m 2 2 d -27 54 d -2 -3 d f 0.675 0.675
- 0.675 c 851 1406 m 3 3 d -28 53 d -2 -2 d f 0.7 0.7 0.7 c 854 1409 m 3 2 d -29
- 54 d -2 -3 d f 0.725 0.725 0.725 c 857 1411 m 3 2 d -30 55 d -2 -3 d f 0.75
- 0.75 0.75 c 860 1413 m 2 2 d 2 Y -30 53 d -2 -2 d f 0.775 0.775 0.775 c 862
- 1417 m -4 13 d -24 43 d -2 -3 d f 0.8 0.8 0.8 c 858 1430 m -4 13 d -18 33 d -2
- -3 d f 0.825 0.825 0.825 c 854 1443 m -3 13 d -13 23 d -2 -3 d f 0.85 0.85 0.85
- c 851 1456 m -4 13 d -7 12 d -2 -2 d f 0.875 0.875 0.875 c 847 1469 m -4 13 d
- -1 2 d -2 -3 d f 0.9 0.9 0.9 c 843 1482 m -1 3 d -1 Y f 0.425 0.425 0.425 c 815
- 1296 m 1 1 d -1 X f 0.45 0.45 0.45 c 816 1297 m 5 21 d -9 -4 d 3 -17 d f 0.475
- 0.475 0.475 c 821 1318 m 5 22 d -18 -9 d 4 -17 d f 0.5 0.5 0.5 c 826 1340 m 5
- 21 d -27 -12 d 4 -18 d f 0.525 0.525 0.525 c 831 1361 m 5 22 d -35 -17 d 3 -17
- d f 0.55 0.55 0.55 c 836 1383 m 3 13 d -5 14 d -37 -27 d 4 -17 d f 0.575 0.575
- 0.575 c 834 1410 m -13 36 d -8 -10 d -18 -44 d 2 -9 d f 0.6 0.6 0.6 c 821 1446
- m -2 6 d -6 -16 d f 0.425 0.425 0.425 c 815 1295 m 2 Y f 0.45 0.45 0.45 c 813
- 1285 m 2 10 d 2 Y -3 17 d f 0.475 0.475 0.475 c 811 1275 m 2 10 d -1 29 d -4 17
- d f 0.5 0.5 0.5 c 808 1265 m 3 10 d -3 56 d -4 18 d f 0.525 0.525 0.525 c 806
- 1255 m 2 10 d -4 84 d -3 17 d f 0.55 0.55 0.55 c 803 1244 m 3 11 d -5 111 d -4
- 17 d f 0.575 0.575 0.575 c 801 1234 m 2 10 d -6 139 d -2 9 d -4 -8 d f 0.6 0.6
- 0.6 c 799 1224 m 2 10 d -10 150 d -8 -16 d f 0.625 0.625 0.625 c 796 1214 m 3
- 10 d -16 144 d -9 -17 d f 0.65 0.65 0.65 c 794 1204 m 2 10 d -22 137 d -2 -5 d
- 9 -70 d f 0.675 0.675 0.675 c 792 1196 m 2 8 d -13 72 d f 0.65 0.65 0.65 c 781
- 1276 m -9 70 d -22 117 d f 0.675 0.675 0.675 c 791 1202 m 1 -6 d -11 80 d -31
- 187 d -2 11 d 4 -36 d f 0.7 0.7 0.7 c 785 1228 m 6 -26 d -39 236 d 5 -38 d f
- 0.725 0.725 0.725 c 779 1254 m 6 -26 d -28 172 d 4 -38 d f 0.75 0.75 0.75 c 773
- 1280 m 6 -26 d -18 108 d 5 -39 d f 0.775 0.775 0.775 c 769 1297 m 4 -17 d -7 43
- d f 0.425 0.425 0.425 c 745 1117 m 2 12 d -20 267 d -2 -8 d f 0.45 0.45 0.45 c
- 747 1129 m 1 12 d -19 264 d -2 -9 d f 0.475 0.475 0.475 c 748 1141 m 2 13 d -18
- 259 d -3 -8 d f 0.5 0.5 0.5 c 750 1154 m 1 12 d -17 256 d -2 -9 d f 0.525 0.525
- 0.525 c 751 1166 m 2 12 d -17 253 d -2 -9 d f 0.55 0.55 0.55 c 753 1178 m 2 13
- d -16 248 d -3 -8 d f 0.575 0.575 0.575 c 755 1191 m 1 12 d -15 245 d -2 -9 d f
- 0.6 0.6 0.6 c 756 1203 m 2 12 d -15 241 d -2 -8 d f 0.625 0.625 0.625 c 758
- 1215 m 1 13 d -13 237 d -3 -9 d f 0.65 0.65 0.65 c 759 1228 m 2 12 d -13 234 d
- -2 -9 d f 0.675 0.675 0.675 c 761 1240 m 2 12 d -11 186 d -4 36 d f 0.7 0.7 0.7
- c 763 1252 m 1 12 d -7 136 d -5 38 d f 0.725 0.725 0.725 c 764 1264 m 2 13 d -5
- 85 d -4 38 d f 0.75 0.75 0.75 c 766 1277 m 1 12 d -1 34 d -5 39 d f 0.775 0.775
- 0.775 c 767 1289 m 2 8 d -3 26 d f 0.425 0.425 0.425 c 741 1078 m 4 39 d -20
- 271 d -4 -79 d f 0.45 0.45 0.45 c 737 1040 m 4 38 d -20 231 d -4 -79 d f 0.475
- 0.475 0.475 c 734 1002 m 3 38 d -20 190 d -4 -79 d f 0.5 0.5 0.5 c 730 964 m 4
- 38 d -21 149 d -3 -79 d f 0.525 0.525 0.525 c 726 925 m 4 39 d -20 108 d -4 -78
- d f 0.55 0.55 0.55 c 722 887 m 4 38 d -20 69 d -4 -79 d f 0.575 0.575 0.575 c
- 722 882 m 5 Y -20 28 d -1 -17 d f 0.55 0.55 0.55 c 698 876 m 2 1 d -21 15 d -1
- X f 0.575 0.575 0.575 c 700 877 m 22 5 d -21 16 d -22 -6 d f 0.55 0.55 0.55 c
- 675 870 m 23 6 d -20 16 d -24 -6 d f 651 864 m 24 6 d -21 16 d -23 -6 d f 1752
- 1124 m 23 6 d -20 15 d -23 -6 d f 1728 1118 m 24 6 d -20 15 d -24 -5 d f 1705
- 1112 m 23 6 d -20 16 d -23 -6 d f 1705 1114 m -2 Y -20 16 d -1 1 d f 0.575
- 0.575 0.575 c 1700 1176 m 5 -62 d -21 15 d -2 45 d f 0.6 0.6 0.6 c 1695 1237 m
- 5 -61 d -18 -2 d -3 45 d f 0.625 0.625 0.625 c 1690 1299 m 5 -62 d -16 -18 d -3
- 46 d f 0.65 0.65 0.65 c 1685 1361 m 5 -62 d -14 -34 d -2 45 d f 0.675 0.675
- 0.675 c 1681 1402 m 4 -41 d -11 -51 d -3 45 d 9 57 d f 0.7 0.7 0.7 c 1671 1355
- m -3 45 d 7 42 d 5 -30 d f 0.725 0.725 0.725 c 1668 1400 m -2 45 d 4 27 d 5 -30
- d f 0.75 0.75 0.75 c 1666 1445 m -3 46 d 2 11 d 5 -30 d f 0.775 0.775 0.775 c
- 1663 1491 m -2 34 d 4 -23 d f 0.55 0.55 0.55 c 1640 1435 m -2 -10 d 1 2 d f
- 0.575 0.575 0.575 c 1642 1445 m -2 -10 d -1 -8 d 2 2 d f 0.6 0.6 0.6 c 1645
- 1455 m -3 -10 d -1 -16 d 2 2 d f 0.625 0.625 0.625 c 1647 1465 m -2 -10 d -2
- -24 d 1 2 d f 0.65 0.65 0.65 c 1650 1476 m -3 -11 d -3 -32 d 2 2 d f 0.675
- 0.675 0.675 c 1680 1404 m 1 -2 d -1 10 d -28 74 d -2 -10 d -4 -41 d 2 2 d f 0.7
- 0.7 0.7 c 1677 1412 m 3 -8 d 8 Y -5 30 d -21 54 d -2 -10 d -4 -49 d 1 2 d f
- 0.725 0.725 0.725 c 1673 1419 m 4 -7 d -2 30 d -5 30 d -13 35 d -3 -11 d -5 -57
- d 2 2 d f 0.75 0.75 0.75 c 1669 1427 m 4 -8 d -3 53 d -5 30 d -6 15 d -2 -10 d
- -6 -66 d 2 2 d f 0.775 0.775 0.775 c 1665 1434 m 4 -7 d -4 75 d -4 23 d -2 -8 d
- -6 -74 d 1 2 d f 0.8 0.8 0.8 c 1662 1442 m 3 -8 d -11 11 d 2 2 d f 0.825 0.825
- 0.825 c 1658 1449 m 4 -7 d -6 5 d 2 2 d f 0.85 0.85 0.85 c 1658 1449 m f 0.55
- 0.55 0.55 c 1639 1427 m -1 -2 d -3 -1 d f 0.575 0.575 0.575 c 1634 1417 m 2 1 d
- 5 11 d -2 -2 d -4 -3 d -3 -1 d 1 -6 d f 0.6 0.6 0.6 c 1636 1418 m 2 3 d 5 10 d
- -2 -2 d -9 -6 d -2 X -6 Y 3 X f 0.625 0.625 0.625 c 1638 1421 m 2 3 d 4 9 d -1
- -2 d -13 -8 d -3 -1 d -5 Y 3 X f 0.65 0.65 0.65 c 1640 1424 m 2 3 d 4 8 d -2 -2
- d -17 -11 d -3 -1 d 1 -3 d 2 -1 d f 0.675 0.675 0.675 c 1642 1427 m 2 4 d 4 6 d
- -2 -2 d -22 -14 d -2 X -3 Y 3 X f 0.7 0.7 0.7 c 1644 1431 m 3 3 d 2 5 d -1 -2 d
- -26 -16 d -3 -1 d -2 Y 3 X f 0.725 0.725 0.725 c 1647 1434 m 2 3 d 2 4 d -2 -2
- d -30 -19 d -3 -1 d -1 Y 3 X f 0.75 0.75 0.75 c 1649 1437 m 2 3 d 2 3 d -2 -2 d
- -35 -22 d -2 X 2 -1 d f 0.775 0.775 0.775 c 1651 1440 m 2 3 d 1 2 d -1 -2 d f
- 0.8 0.8 0.8 c 1653 1443 m 3 3 d 1 Y -2 -2 d f 0.825 0.825 0.825 c 1656 1446 m 2
- 3 d -2 -2 d f 0.85 0.85 0.85 c 1658 1449 m f 0.575 0.575 0.575 c 1633 1407 m 1
- 10 d -1 X f 0.6 0.6 0.6 c 1630 1386 m 3 21 d 10 Y -3 X f 0.625 0.625 0.625 c
- 1627 1366 m 3 20 d 31 Y -3 X f 0.65 0.65 0.65 c 1624 1346 m 3 20 d 51 Y -2 1 d
- -30 50 d -4 12 d 3 -40 d f 0.675 0.675 0.675 c 1621 1326 m 3 20 d 1 72 d -3 X
- -22 37 d -5 13 d -1 -28 d 4 -42 d f 0.7 0.7 0.7 c 1618 1306 m 3 20 d 1 92 d -3
- X -14 24 d -5 13 d -2 -57 d 4 -43 d f 0.725 0.725 0.725 c 1615 1286 m 3 20 d 1
- 112 d -3 X -6 11 d -5 13 d -3 -87 d 4 -43 d f 0.75 0.75 0.75 c 1611 1266 m 4 20
- d 1 132 d -2 1 d -4 10 d -4 -117 d 4 -43 d f 0.775 0.775 0.775 c 1611 1263 m 3
- Y -1 3 d f 0.625 0.625 0.625 c 1587 1378 m 4 -19 d -16 70 d f 0.65 0.65 0.65 c
- 1591 1359 m 4 -18 d -1 99 d -3 40 d -24 -20 d 8 -31 d f 0.675 0.675 0.675 c
- 1595 1341 m 4 -19 d -1 76 d -4 42 d f 0.7 0.7 0.7 c 1599 1322 m 4 -19 d -1 52 d
- -4 43 d f 0.725 0.725 0.725 c 1603 1303 m 4 -19 d -1 28 d -4 43 d f 0.75 0.75
- 0.75 c 1607 1284 m 3 -18 d 3 Y -4 43 d f 0.775 0.775 0.775 c 1610 1266 m 1 -3 d
- -1 6 d f 0.55 0.55 0.55 c 1547 1433 m -3 -5 d 6 -35 d f 0.575 0.575 0.575 c
- 1553 1440 m -6 -7 d 3 -40 d 9 -51 d f 0.6 0.6 0.6 c 1564 1318 m 23 57 d -29 73
- d -5 -8 d 6 -98 d f 0.625 0.625 0.625 c 1587 1375 m 3 Y -12 51 d -11 27 d -6 -8
- d f 0.65 0.65 0.65 c 1575 1429 m -8 31 d -3 -4 d f 0.55 0.55 0.55 c 1540 1272 m
- 10 18 d 103 Y -6 35 d -3 4 d -4 -126 d f 0.575 0.575 0.575 c 1550 1290 m 9 19 d
- 33 Y -9 51 d -9 39 d -5 7 d -3 -98 d 4 -35 d f 0.6 0.6 0.6 c 1559 1309 m 5 9 d
- -5 24 d -23 97 d -4 6 d -3 -70 d 4 -34 d f 0.625 0.625 0.625 c 1532 1445 m -5 7
- d -1 -42 d 3 -35 d f 0.65 0.65 0.65 c 1527 1452 m -5 7 d -14 Y 4 -35 d f 0.675
- 0.675 0.675 c 1522 1459 m -2 3 d 2 -17 d f 0.55 0.55 0.55 c 1538 1271 m 2 1 d
- -3 34 d f 0.575 0.575 0.575 c 1536 1271 m 2 X -1 35 d -4 35 d f 0.6 0.6 0.6 c
- 1534 1270 m 2 1 d -3 70 d -4 34 d -28 50 d -4 -9 d 1 -11 d f 0.625 0.625 0.625
- c 1532 1270 m 2 X -5 105 d -3 35 d -17 30 d -8 -15 d -3 -20 d 2 -17 d f 0.65
- 0.65 0.65 c 1530 1269 m 2 1 d -6 140 d -4 35 d -6 10 d -7 -15 d -9 -52 d 3 -16
- d f 0.675 0.675 0.675 c 1528 1269 m 2 X -8 176 d -2 17 d -4 -7 d -13 -83 d 2
- -17 d f 0.7 0.7 0.7 c 1526 1268 m 2 1 d -23 86 d 2 -16 d f 0.725 0.725 0.725 c
- 1524 1267 m 2 1 d -19 71 d 2 -17 d f 0.75 0.75 0.75 c 1522 1267 m 2 X -15 55 d
- 3 -16 d f 0.775 0.775 0.775 c 1520 1266 m 2 1 d -10 39 d 2 -17 d f 0.8 0.8 0.8
- c 1518 1266 m 2 X -6 23 d 2 -16 d f 0.825 0.825 0.825 c 1517 1266 m 1 X -2 7 d
- f 0.6 0.6 0.6 c 1498 1405 m -1 11 d -4 5 d f 0.625 0.625 0.625 c 1500 1388 m -2
- 17 d -5 16 d -7 10 d f 0.65 0.65 0.65 c 1503 1372 m -3 16 d -14 43 d -6 9 d f
- 0.675 0.675 0.675 c 1505 1355 m -2 17 d -23 68 d -6 9 d f 0.7 0.7 0.7 c 1507
- 1339 m -2 16 d -31 94 d -1 1 d 6 -15 d f 0.725 0.725 0.725 c 1509 1322 m -2 17
- d -28 96 d 6 -17 d f 0.75 0.75 0.75 c 1512 1306 m -3 16 d -24 96 d 6 -16 d f
- 0.775 0.775 0.775 c 1494 1394 m 6 -36 d 14 -69 d -2 17 d -21 96 d f 0.8 0.8 0.8
- c 1500 1358 m 12 -66 d 4 -19 d -2 16 d f 0.825 0.825 0.825 c 1512 1292 m 5 -26
- d -1 7 d f 0.7 0.7 0.7 c 1479 1435 m -6 15 d -7 -34 d f 0.725 0.725 0.725 c
- 1485 1418 m -6 17 d -13 -19 d -8 -38 d f 0.75 0.75 0.75 c 1491 1402 m -6 16 d
- -27 -40 d -8 -39 d f 0.775 0.775 0.775 c 1484 1381 m 10 13 d -3 8 d -41 -63 d
- -3 Y 10 13 d f 0.8 0.8 0.8 c 1470 1361 m 14 20 d -24 -32 d f 0.775 0.775 0.775
- c 1460 1349 m -10 -13 d -17 44 d f 0.8 0.8 0.8 c 1467 1365 m 3 -4 d -10 -12 d
- -27 31 d -7 18 d 7 -1 d f 0.825 0.825 0.825 c 1449 1392 m 18 -27 d -34 32 d 12
- -1 d f 0.85 0.85 0.85 c 1447 1396 m 2 -4 d -4 4 d f 0.75 0.75 0.75 c 1412 1378
- m -9 -13 d 5 -19 d f 0.775 0.775 0.775 c 1422 1392 m -10 -14 d -4 -32 d 6 -21 d
- f 0.8 0.8 0.8 c 1433 1397 m -7 1 d -4 -6 d -8 -67 d 7 -21 d f 0.825 0.825 0.825
- c 1423 1296 m 19 80 d 3 20 d -12 1 d -12 -93 d f 0.85 0.85 0.85 c 1442 1376 m 5
- 20 d -2 X f 0.75 0.75 0.75 c 1408 1346 m -5 19 d -24 48 d 5 -7 d f 0.775 0.775
- 0.775 c 1400 1384 m 1 -5 d 13 -54 d -6 21 d -24 60 d f 0.8 0.8 0.8 c 1401 1379
- m 16 -60 d 4 -15 d -7 21 d f 0.825 0.825 0.825 c 1417 1319 m 6 -23 d -2 8 d f
- 0.625 0.625 0.625 c 1376 1324 m 1 2 d -21 107 d f 0.65 0.65 0.65 c 1377 1326 m
- 4 9 d -20 94 d -5 4 d f 0.675 0.675 0.675 c 1381 1335 m 3 10 d -18 80 d -5 4 d
- f 0.7 0.7 0.7 c 1384 1345 m 4 10 d -17 65 d -5 5 d f 0.725 0.725 0.725 c 1388
- 1355 m 4 10 d -16 51 d -5 4 d f 0.75 0.75 0.75 c 1392 1365 m 4 10 d -12 31 d -5
- 7 d -3 3 d f 0.775 0.775 0.775 c 1396 1375 m 4 9 d -16 22 d f 0.625 0.625 0.625
- c 1375 1321 m 1 3 d -20 109 d 1 Y f 0.65 0.65 0.65 c 1368 1304 m 7 17 d -19 113
- d -4 1 d f 0.675 0.675 0.675 c 1362 1288 m 6 16 d -16 131 d -4 1 d f 0.7 0.7
- 0.7 c 1355 1271 m 7 17 d -14 148 d -4 1 d f 0.725 0.725 0.725 c 1353 1264 m 2 7
- d -11 166 d -4 2 d 8 -133 d f 0.75 0.75 0.75 c 1340 1439 m -5 1 d 4 -59 d 9 -75
- d f 0.775 0.775 0.775 c 1335 1440 m -3 1 d 7 -60 d f 0.725 0.725 0.725 c 1335
- 1339 m 18 -75 d -5 42 d -34 120 d -5 -4 d 15 -42 d f 0.75 0.75 0.75 c 1329 1366
- m 6 -27 d 13 -33 d -9 75 d -15 53 d -10 -8 d 10 -46 d f 0.775 0.775 0.775 c
- 1339 1381 m -7 60 d -8 -7 d f 0.675 0.675 0.675 c 1291 1376 m -6 -14 d 2 -9 d f
- 0.7 0.7 0.7 c 1303 1408 m -12 -32 d -4 -23 d 3 -19 d f 0.725 0.725 0.725 c 1324
- 1380 m -15 42 d -6 -14 d -13 -74 d 4 -20 d f 0.75 0.75 0.75 c 1323 1336 m 6 30
- d -5 14 d -30 -66 d 4 -19 d f 0.775 0.775 0.775 c 1315 1298 m 8 38 d -25 -41 d
- 3 -19 d f 0.8 0.8 0.8 c 1307 1260 m 8 38 d -14 -22 d 4 -20 d f 0.825 0.825
- 0.825 c 1306 1252 m 1 8 d -2 -4 d f 0.675 0.675 0.675 c 1287 1353 m -2 9 d -6
- -9 d f 0.7 0.7 0.7 c 1290 1334 m -3 19 d -8 X -13 -18 d f 0.725 0.725 0.725 c
- 1294 1314 m -4 20 d -24 1 d -4 -6 d 2 -3 d f 0.75 0.75 0.75 c 1298 1295 m -4 19
- d -30 12 d 3 -5 d f 0.775 0.775 0.775 c 1301 1276 m -3 19 d -31 26 d 4 -5 d f
- 0.8 0.8 0.8 c 1305 1256 m -4 20 d -30 40 d 3 -5 d f 0.825 0.825 0.825 c 1297
- 1271 m 9 -19 d -1 4 d -31 55 d 4 -5 d f 0.85 0.85 0.85 c 1285 1294 m 12 -23 d
- -19 35 d 3 -5 d f 0.875 0.875 0.875 c 1282 1300 m 3 -6 d -4 7 d f 0.725 0.725
- 0.725 c 1264 1326 m -2 3 d -15 -30 d f 0.75 0.75 0.75 c 1267 1321 m -3 5 d -17
- -27 d -9 -16 d 4 -5 d f 0.775 0.775 0.775 c 1271 1316 m -4 5 d -25 -43 d 5 -8 d
- f 0.8 0.8 0.8 c 1274 1311 m -3 5 d -24 -46 d 5 -7 d f 0.825 0.825 0.825 c 1278
- 1306 m -4 5 d -22 -48 d 6 -8 d f 0.85 0.85 0.85 c 1259 1254 m 17 35 d 5 12 d -3
- 5 d -20 -51 d f 0.875 0.875 0.875 c 1276 1289 m 6 11 d -1 1 d f 0.575 0.575
- 0.575 c 1235 1248 m 2 X -7 40 d f 0.6 0.6 0.6 c 1237 1248 m 2 1 d -16 90 d 7
- -51 d f 0.625 0.625 0.625 c 1239 1249 m 2 X -25 140 d 7 -50 d f 0.65 0.65 0.65
- c 1241 1249 m 2 1 d -24 125 d -4 23 d 1 -9 d f 0.675 0.675 0.675 c 1243 1250 m
- 2 X -20 97 d -6 28 d f 0.7 0.7 0.7 c 1245 1250 m 3 1 d -17 69 d -6 27 d f 0.725
- 0.725 0.725 c 1248 1251 m 2 X -14 42 d -5 27 d f 0.75 0.75 0.75 c 1250 1251 m 2
- 1 d -10 26 d -4 5 d -2 10 d f 0.775 0.775 0.775 c 1252 1252 m 2 X -7 18 d -5 8
- d f 0.8 0.8 0.8 c 1254 1252 m 2 1 d -4 10 d -5 7 d f 0.825 0.825 0.825 c 1256
- 1253 m 2 1 d 1 Y -6 8 d f 0.85 0.85 0.85 c 1258 1254 m 1 X -1 1 d f 0.575 0.575
- 0.575 c 1231 1277 m 4 -29 d -5 40 d f 0.6 0.6 0.6 c 1227 1313 m 4 -36 d -1 11 d
- -7 51 d f 0.625 0.625 0.625 c 1222 1350 m 5 -37 d -4 26 d -7 50 d f 0.65 0.65
- 0.65 c 1217 1386 m 5 -36 d -6 39 d -1 9 d -2 4 d f 0.675 0.675 0.675 c 1213
- 1423 m 4 -37 d -4 16 d -3 6 d f 0.7 0.7 0.7 c 1212 1430 m 1 -7 d -3 -15 d -3 5
- d 2 19 d f 0.725 0.725 0.725 c 1207 1413 m -2 5 d 1 16 d 3 -2 d f 0.75 0.75
- 0.75 c 1205 1418 m -3 6 d 1 12 d 3 -2 d f 0.775 0.775 0.775 c 1202 1424 m -3 5
- d 1 10 d 3 -3 d f 0.8 0.8 0.8 c 1199 1429 m -2 6 d 6 Y 3 -2 d f 0.825 0.825
- 0.825 c 1197 1435 m -3 5 d 3 Y 3 -2 d f 0.85 0.85 0.85 c 1194 1440 m -3 5 d 3
- -2 d f 0.475 0.475 0.475 c 1188 1289 m 1 Y f 0.5 0.5 0.5 c 1188 1290 m 3 17 d
- -7 5 d 4 -22 d f 0.525 0.525 0.525 c 1191 1307 m 3 17 d -14 9 d 4 -21 d f 0.55
- 0.55 0.55 c 1194 1324 m 3 17 d -21 14 d 4 -22 d f 0.575 0.575 0.575 c 1197 1341
- m 3 17 d -28 18 d 4 -21 d f 0.6 0.6 0.6 c 1200 1358 m 3 17 d -35 23 d 4 -22 d f
- 0.625 0.625 0.625 c 1203 1375 m 2 17 d -35 11 d -2 -4 d -1 Y f 0.65 0.65 0.65 c
- 1205 1392 m 3 17 d -36 -1 d -2 -5 d f 0.675 0.675 0.675 c 1208 1409 m 3 17 d
- -36 -13 d -3 -5 d f 0.7 0.7 0.7 c 1211 1426 m 1 4 d -3 2 d -32 -14 d -2 -5 d f
- 0.725 0.725 0.725 c 1209 1432 m -3 2 d -26 -12 d -3 -4 d f 0.75 0.75 0.75 c
- 1206 1434 m -3 2 d -21 -9 d -2 -5 d f 0.775 0.775 0.775 c 1203 1436 m -3 3 d
- -16 -7 d -2 -5 d f 0.8 0.8 0.8 c 1200 1439 m -3 2 d -10 -5 d -3 -4 d f 0.825
- 0.825 0.825 c 1197 1441 m -3 2 d -5 -2 d -2 -5 d f 0.85 0.85 0.85 c 1194 1443 m
- -3 2 d -2 -4 d f 0.475 0.475 0.475 c 1188 1289 m 1 Y f 0.5 0.5 0.5 c 1184 1282
- m 4 7 d 1 Y -4 22 d f 0.525 0.525 0.525 c 1181 1275 m 3 7 d 30 Y -4 21 d f 0.55
- 0.55 0.55 c 1177 1268 m 4 7 d -1 58 d -4 22 d f 0.575 0.575 0.575 c 1174 1261 m
- 3 7 d -1 87 d -4 21 d f 0.6 0.6 0.6 c 1170 1254 m 4 7 d -2 115 d -4 22 d f
- 0.625 0.625 0.625 c 1167 1247 m 3 7 d -2 144 d 1 Y -6 -15 d f 0.65 0.65 0.65 c
- 1165 1243 m 2 4 d -5 137 d -7 -17 d 5 -102 d f 0.675 0.675 0.675 c 1155 1367 m
- -6 -16 d 2 -42 d 9 -44 d f 0.7 0.7 0.7 c 1149 1351 m -5 -12 d 7 -30 d f 0.65
- 0.65 0.65 c 1161 1238 m 4 5 d -5 22 d f 0.675 0.675 0.675 c 1154 1228 m 7 10 d
- -1 27 d -9 44 d f 0.7 0.7 0.7 c 1147 1218 m 7 10 d -3 81 d -7 30 d -23 8 d 7
- -46 d f 0.725 0.725 0.725 c 1141 1210 m 6 8 d -19 83 d f 0.7 0.7 0.7 c 1128
- 1301 m -7 46 d -24 21 d 1 -3 d f 0.725 0.725 0.725 c 1136 1215 m 5 -5 d -13 91
- d -30 64 d 11 -72 d f 0.75 0.75 0.75 c 1118 1231 m 18 -16 d -27 78 d f 0.675
- 0.675 0.675 c 1085 1358 m -11 -10 d 6 -63 d f 0.7 0.7 0.7 c 1098 1365 m -1 3 d
- -12 -10 d -5 -73 d 7 -71 d f 0.725 0.725 0.725 c 1094 1145 m 1 1 d 14 147 d -11
- 72 d -11 -151 d f 0.75 0.75 0.75 c 1095 1146 m 23 85 d -9 62 d f 0.525 0.525
- 0.525 c 1071 1286 m 2 -14 d -7 25 d f 0.55 0.55 0.55 c 1073 1272 m 3 -16 d -16
- 52 d 6 -11 d f 0.575 0.575 0.575 c 1076 1256 m 2 -16 d -23 79 d 5 -11 d f 0.6
- 0.6 0.6 c 1078 1240 m 3 -16 d -30 106 d -1 -1 d 5 -10 d f 0.625 0.625 0.625 c
- 1081 1224 m 3 -16 d -22 131 d -11 -9 d f 0.65 0.65 0.65 c 1084 1208 m 2 -16 d
- -13 155 d -11 -8 d f 0.675 0.675 0.675 c 1086 1192 m 3 -16 d -9 109 d -6 63 d
- -1 -1 d f 0.7 0.7 0.7 c 1089 1176 m 3 -16 d -5 54 d -7 71 d f 0.725 0.725 0.725
- c 1092 1160 m 2 -15 d -7 69 d f 0.525 0.525 0.525 c 1068 1294 m 3 -8 d -5 11 d
- f 0.55 0.55 0.55 c 1066 1303 m 2 -9 d -2 3 d -6 11 d f 0.575 0.575 0.575 c 1063
- 1311 m 3 -8 d -6 5 d -5 11 d f 0.6 0.6 0.6 c 1060 1320 m 3 -9 d -8 8 d -5 10 d
- f 0.625 0.625 0.625 c 1058 1328 m 2 -8 d -10 9 d -4 3 d f 0.65 0.65 0.65 c 1055
- 1336 m 3 -8 d -12 4 d -3 3 d f 0.675 0.675 0.675 c 1052 1345 m 3 -9 d -12 -1 d
- -4 4 d f 0.7 0.7 0.7 c 1050 1353 m 2 -8 d -13 -6 d -3 3 d f 0.725 0.725 0.725 c
- 1047 1361 m 3 -8 d -14 -11 d -4 3 d 14 16 d f 0.75 0.75 0.75 c 1032 1345 m -3 3
- d 5 5 d 12 8 d f 0.775 0.775 0.775 c 1029 1348 m -2 2 d 7 3 d f 0.55 0.55 0.55
- c 1024 1234 m 3 Y -1 6 d f 0.575 0.575 0.575 c 1024 1237 m 4 18 d -12 40 d 7
- -52 d f 0.6 0.6 0.6 c 1028 1255 m 3 18 d -21 75 d 6 -53 d f 0.625 0.625 0.625 c
- 1031 1273 m 3 18 d -30 106 d -1 1 d 7 -50 d f 0.65 0.65 0.65 c 1034 1291 m 4 18
- d -30 80 d -4 8 d f 0.675 0.675 0.675 c 1038 1309 m 3 18 d -29 53 d -4 9 d f
- 0.7 0.7 0.7 c 1041 1327 m 3 18 d -28 26 d -4 9 d f 0.725 0.725 0.725 c 1044
- 1345 m 3 16 d -1 X -26 2 d -4 8 d f 0.75 0.75 0.75 c 1046 1361 m -12 -8 d -9 1
- d -5 9 d f 0.775 0.775 0.775 c 1034 1353 m -7 -3 d -2 4 d f 0.55 0.55 0.55 c
- 1023 1233 m 1 1 d -1 9 d f 0.575 0.575 0.575 c 1018 1226 m 5 7 d 10 Y -7 52 d f
- 0.6 0.6 0.6 c 1013 1219 m 5 7 d -2 69 d -6 53 d f 0.625 0.625 0.625 c 1008 1213
- m 5 6 d -3 129 d -7 50 d -1 Y f 0.65 0.65 0.65 c 1003 1206 m 5 7 d -5 184 d -5
- -9 d f 0.675 0.675 0.675 c 1000 1201 m 3 5 d -5 182 d -4 -10 d 4 -160 d f 0.7
- 0.7 0.7 c 994 1378 m -5 -9 d 3 -104 d 6 -47 d f 0.725 0.725 0.725 c 989 1369 m
- -5 -10 d 1 -47 d 7 -47 d f 0.75 0.75 0.75 c 984 1359 m -4 -8 d 5 -39 d f 0.675
- 0.675 0.675 c 987 1213 m 13 -12 d -2 17 d f 0.7 0.7 0.7 c 977 1222 m 10 -9 d 11
- 5 d -6 47 d -28 74 d f 0.725 0.725 0.725 c 992 1265 m -7 47 d -19 76 d -10 24 d
- 8 -73 d f 0.75 0.75 0.75 c 985 1312 m -5 39 d -14 37 d f 0.625 0.625 0.625 c
- 937 1343 m -4 -17 d 4 -39 d f 0.65 0.65 0.65 c 943 1363 m -6 -20 d -56 Y 6 -46
- d f 0.675 0.675 0.675 c 948 1383 m -5 -20 d -122 Y 5 -46 d f 0.7 0.7 0.7 c 953
- 1149 m 24 73 d -13 117 d -10 64 d -6 -20 d -188 Y f 0.725 0.725 0.725 c 964
- 1339 m -8 73 d -2 -9 d f 0.625 0.625 0.625 c 937 1287 m -4 39 d -6 -28 d f 0.65
- 0.65 0.65 c 943 1241 m -6 46 d -10 11 d -7 -33 d f 0.675 0.675 0.675 c 948 1195
- m -5 46 d -23 24 d -7 -33 d f 0.7 0.7 0.7 c 953 1149 m -5 46 d -35 37 d -4 -20
- d 4 -5 d f 0.725 0.725 0.725 c 941 1167 m 12 -18 d -40 58 d 9 -12 d f 0.75 0.75
- 0.75 c 930 1183 m 11 -16 d -19 28 d f 0.475 0.475 0.475 c 887 1429 m -1 6 d 1
- -6 d f 0.5 0.5 0.5 c 889 1404 m -2 25 d 2 -23 d f 0.525 0.525 0.525 c 892 1379
- m -3 25 d 2 Y 3 -24 d f 0.55 0.55 0.55 c 895 1353 m -3 26 d 3 Y 2 -24 d f 0.575
- 0.575 0.575 c 897 1328 m -2 25 d -1 5 d 3 -23 d f 0.6 0.6 0.6 c 900 1303 m -3
- 25 d 7 Y 2 -24 d f 0.625 0.625 0.625 c 903 1277 m -3 26 d -1 8 d 3 -24 d f 0.65
- 0.65 0.65 c 905 1252 m -2 25 d -1 10 d 2 -23 d f 0.675 0.675 0.675 c 906 1245 m
- 2 -4 d -14 Y -3 25 d -1 12 d f 0.7 0.7 0.7 c 908 1241 m 7 -20 d -2 -14 d -4 5 d
- -1 15 d f 0.725 0.725 0.725 c 915 1221 m 8 -20 d -1 -6 d -9 12 d f 0.75 0.75
- 0.75 c 923 1201 m 7 -18 d -8 12 d f 0.475 0.475 0.475 c 887 1429 m -1 6 d -1 -1
- d f 0.5 0.5 0.5 c 889 1406 m -2 23 d -2 5 d -2 -1 d f 0.525 0.525 0.525 c 892
- 1382 m -3 24 d -6 27 d -2 -2 d f 0.55 0.55 0.55 c 894 1358 m -2 24 d -11 49 d
- -2 -2 d f 0.575 0.575 0.575 c 897 1335 m -3 23 d -15 71 d -2 -2 d f 0.6 0.6 0.6
- c 899 1311 m -2 24 d -20 92 d -2 -1 d f 0.625 0.625 0.625 c 902 1287 m -3 24 d
- -24 115 d -2 -2 d f 0.65 0.65 0.65 c 904 1264 m -2 23 d -29 137 d -2 -2 d f
- 0.675 0.675 0.675 c 883 1171 m 23 74 d -2 19 d -33 158 d -2 -2 d 12 -228 d f
- 0.7 0.7 0.7 c 869 1420 m -3 -1 d 9 -151 d 6 -76 d f 0.725 0.725 0.725 c 866
- 1419 m -2 -2 d 4 -72 d 7 -77 d f 0.75 0.75 0.75 c 864 1417 m -2 -2 d 6 -70 d f
- 0.55 0.55 0.55 c 840 1397 m -1 -1 d 5 -50 d f 0.575 0.575 0.575 c 843 1399 m -3
- -2 d 4 -51 d 13 -134 d f 0.6 0.6 0.6 c 859 1192 m 6 -5 d -19 215 d -3 -3 d 14
- -187 d f 0.625 0.625 0.625 c 865 1187 m 6 -5 d -22 222 d -3 -2 d f 0.65 0.65
- 0.65 c 871 1182 m 7 -6 d -27 230 d -2 -2 d f 0.675 0.675 0.675 c 878 1176 m 5
- -5 d -2 21 d -27 217 d -3 -3 d f 0.7 0.7 0.7 c 881 1192 m -6 76 d -18 143 d -3
- -2 d f 0.725 0.725 0.725 c 875 1268 m -7 77 d -8 68 d -3 -2 d f 0.75 0.75 0.75
- c 868 1345 m -6 70 d -2 -2 d f 0.425 0.425 0.425 c 816 1297 m -1 -1 d 1 -3 d f
- 0.45 0.45 0.45 c 821 1318 m -5 -21 d -4 Y 6 -66 d f 0.475 0.475 0.475 c 826
- 1340 m -5 -22 d 1 -91 d 5 -66 d f 0.5 0.5 0.5 c 831 1361 m -5 -21 d 1 -179 d 6
- -66 d f 0.525 0.525 0.525 c 836 1065 m 5 26 d -5 292 d -5 -22 d 2 -266 d f 0.55
- 0.55 0.55 c 841 1091 m 8 47 d -5 208 d -5 50 d -3 -13 d f 0.575 0.575 0.575 c
- 849 1138 m 9 47 d -1 27 d -13 134 d f 0.6 0.6 0.6 c 858 1185 m 1 7 d -2 20 d f
- 0.425 0.425 0.425 c 816 1293 m -1 3 d -1 Y f 0.45 0.45 0.45 c 822 1227 m -6 66
- d -1 2 d -2 -10 d f 0.475 0.475 0.475 c 827 1161 m -5 66 d -9 58 d -2 -10 d f
- 0.5 0.5 0.5 c 833 1095 m -6 66 d -16 114 d -3 -10 d f 0.525 0.525 0.525 c 835
- 1068 m 1 -3 d -3 30 d -25 170 d -2 -10 d f 0.55 0.55 0.55 c 833 1071 m 2 -3 d
- -29 187 d -3 -11 d f 0.575 0.575 0.575 c 831 1075 m 2 -4 d -30 173 d -2 -10 d f
- 0.6 0.6 0.6 c 829 1079 m 2 -4 d -30 159 d -2 -10 d f 0.625 0.625 0.625 c 827
- 1083 m 2 -4 d -30 145 d -3 -10 d f 0.65 0.65 0.65 c 825 1087 m 2 -4 d -31 131 d
- -2 -10 d f 0.675 0.675 0.675 c 823 1091 m 2 -4 d -31 117 d -2 -8 d 1 -3 d f 0.7
- 0.7 0.7 c 821 1095 m 2 -4 d -30 102 d 3 -14 d f 0.725 0.725 0.725 c 819 1099 m
- 2 -4 d -25 84 d 4 -14 d f 0.75 0.75 0.75 c 818 1103 m 1 -4 d -19 66 d 3 -14 d f
- 0.775 0.775 0.775 c 816 1107 m 2 -4 d -15 48 d 4 -14 d f 0.8 0.8 0.8 c 814 1110
- m 2 -3 d -9 30 d 3 -14 d f 0.825 0.825 0.825 c 812 1113 m 2 -3 d -4 13 d f 0.6
- 0.6 0.6 c 789 1188 m 2 -8 d -5 21 d f 0.625 0.625 0.625 c 791 1180 m 3 -7 d -10
- 43 d 2 -15 d f 0.65 0.65 0.65 c 794 1173 m 2 -8 d -15 65 d 3 -14 d f 0.675
- 0.675 0.675 c 796 1165 m 2 -8 d -5 36 d -1 3 d -1 6 d -13 43 d 3 -15 d f 0.7
- 0.7 0.7 c 798 1157 m 3 -7 d -5 29 d -3 14 d -2 9 d -6 26 d -9 31 d 2 -14 d f
- 0.725 0.725 0.725 c 801 1150 m 2 -8 d -3 23 d -4 14 d -11 49 d -6 26 d -6 19 d
- 3 -14 d f 0.75 0.75 0.75 c 803 1142 m 3 -8 d -3 17 d -3 14 d -21 89 d -6 26 d
- -3 8 d 3 -15 d f 0.775 0.775 0.775 c 806 1134 m 2 -8 d -1 11 d -4 14 d -30 129
- d -4 17 d 1 -9 d f 0.8 0.8 0.8 c 808 1126 m 3 -7 d -1 4 d -3 14 d f 0.825 0.825
- 0.825 c 811 1119 m 1 -6 d -2 10 d f 0.425 0.425 0.425 c 765 1236 m 3 -7 d -21
- -100 d -2 -12 d f 0.45 0.45 0.45 c 768 1229 m 4 -7 d -24 -81 d -1 -12 d f 0.475
- 0.475 0.475 c 772 1222 m 3 -6 d -25 -62 d -2 -13 d f 0.5 0.5 0.5 c 775 1216 m 4
- -7 d -28 -43 d -1 -12 d f 0.525 0.525 0.525 c 779 1209 m 3 -7 d -29 -24 d -2
- -12 d f 0.55 0.55 0.55 c 782 1202 m 3 -7 d -30 -4 d -2 -13 d f 0.575 0.575
- 0.575 c 785 1195 m 4 -7 d -33 15 d -1 -12 d f 0.6 0.6 0.6 c 789 1188 m -3 13 d
- -28 14 d -2 -12 d f 0.625 0.625 0.625 c 786 1201 m -2 15 d -25 12 d -1 -13 d f
- 0.65 0.65 0.65 c 784 1216 m -3 14 d -20 10 d -2 -12 d f 0.675 0.675 0.675 c 781
- 1230 m -3 15 d -15 7 d -2 -12 d f 0.7 0.7 0.7 c 778 1245 m -2 14 d -12 5 d -1
- -12 d f 0.725 0.725 0.725 c 776 1259 m -3 14 d -7 4 d -2 -13 d f 0.75 0.75 0.75
- c 773 1273 m -3 15 d -3 1 d -1 -12 d f 0.775 0.775 0.775 c 770 1288 m -1 9 d -2
- -8 d f 0.425 0.425 0.425 c 762 1179 m 3 57 d -20 -119 d -4 -39 d f 0.45 0.45
- 0.45 c 758 1117 m 4 62 d -21 -101 d -4 -38 d f 0.475 0.475 0.475 c 754 1055 m 4
- 62 d -21 -77 d -3 -38 d f 0.5 0.5 0.5 c 750 994 m 4 61 d -20 -53 d -4 -38 d f
- 0.525 0.525 0.525 c 746 932 m 4 62 d -20 -30 d -4 -39 d f 0.55 0.55 0.55 c 742
- 871 m 4 61 d -20 -7 d -4 -38 d f 0.575 0.575 0.575 c 742 867 m 4 Y -20 16 d -5
- Y f 0.55 0.55 0.55 c 718 861 m 4 1 d -22 15 d -2 -1 d f 0.575 0.575 0.575 c 722
- 862 m 20 5 d -20 15 d -22 -5 d f 0.55 0.55 0.55 c 695 855 m 23 6 d -20 15 d -23
- -6 d f 671 849 m 24 6 d -20 15 d -24 -6 d f 1772 1108 m 24 6 d -21 16 d -23 -6
- d f 1749 1102 m 23 6 d -20 16 d -24 -6 d f 1725 1096 m 24 6 d -21 16 d -23 -6 d
- f 1725 1099 m -3 Y -20 16 d 2 Y f 0.575 0.575 0.575 c 1718 1161 m 7 -62 d -20
- 15 d -5 62 d f 0.6 0.6 0.6 c 1710 1222 m 8 -61 d -18 15 d -5 61 d f 0.625 0.625
- 0.625 c 1703 1284 m 7 -62 d -15 15 d -5 62 d f 0.65 0.65 0.65 c 1702 1292 m 1
- -8 d -13 15 d -5 62 d 5 -7 d f 0.675 0.675 0.675 c 1685 1361 m -4 41 d 9 -48 d
- f 0.65 0.65 0.65 c 1696 1287 m 6 5 d -12 62 d f 0.675 0.675 0.675 c 1689 1282 m
- 7 5 d -6 67 d -9 48 d -1 2 d f 0.7 0.7 0.7 c 1682 1276 m 7 6 d -9 122 d -3 8 d
- f 0.725 0.725 0.725 c 1678 1273 m 4 3 d -5 136 d -4 7 d 3 -130 d f 0.75 0.75
- 0.75 c 1673 1419 m -4 8 d 3 -98 d 4 -40 d f 0.775 0.775 0.775 c 1669 1427 m -4
- 7 d 2 -65 d 5 -40 d f 0.8 0.8 0.8 c 1665 1434 m -3 8 d 1 -34 d 4 -39 d f 0.825
- 0.825 0.825 c 1662 1442 m -4 7 d -1 Y 5 -40 d f 0.85 0.85 0.85 c 1658 1449 m -1
- Y f 0.575 0.575 0.575 c 1636 1418 m -2 -1 d 3 -12 d f 0.6 0.6 0.6 c 1638 1421 m
- -2 -3 d 1 -13 d 4 -24 d f 0.625 0.625 0.625 c 1640 1424 m -2 -3 d 3 -40 d 4 -24
- d f 0.65 0.65 0.65 c 1642 1427 m -2 -3 d 5 -67 d 5 -24 d f 0.675 0.675 0.675 c
- 1644 1431 m -2 -4 d 8 -94 d 4 -24 d f 0.7 0.7 0.7 c 1655 1307 m 14 -21 d -22
- 148 d -3 -3 d 10 -122 d f 0.725 0.725 0.725 c 1669 1286 m 9 -13 d -2 16 d -27
- 148 d -2 -3 d f 0.75 0.75 0.75 c 1676 1289 m -4 40 d -21 111 d -2 -3 d f 0.775
- 0.775 0.775 c 1672 1329 m -5 40 d -14 74 d -2 -3 d f 0.8 0.8 0.8 c 1667 1369 m
- -4 39 d -7 38 d -3 -3 d f 0.825 0.825 0.825 c 1663 1408 m -5 40 d 1 Y -2 -3 d f
- 0.85 0.85 0.85 c 1658 1448 m 1 Y f 0.575 0.575 0.575 c 1637 1405 m -3 12 d -1
- -10 d f 0.6 0.6 0.6 c 1641 1381 m -4 24 d -4 2 d -3 -21 d f 0.625 0.625 0.625 c
- 1645 1357 m -4 24 d -11 5 d -3 -20 d f 0.65 0.65 0.65 c 1650 1333 m -5 24 d -18
- 9 d -3 -20 d f 0.675 0.675 0.675 c 1654 1309 m -4 24 d -26 13 d -3 -20 d f 0.7
- 0.7 0.7 c 1649 1296 m 6 11 d -1 2 d -33 17 d -3 -20 d f 0.725 0.725 0.725 c
- 1643 1283 m 6 13 d -31 10 d -3 -20 d f 0.75 0.75 0.75 c 1636 1270 m 7 13 d -28
- 3 d -4 -20 d f 0.775 0.775 0.775 c 1631 1261 m 5 9 d -25 -4 d -3 Y f 0.6 0.6
- 0.6 c 1608 1308 m 2 -4 d -22 71 d f 0.625 0.625 0.625 c 1610 1304 m 3 -6 d -22
- 61 d -4 19 d 1 -3 d f 0.65 0.65 0.65 c 1613 1298 m 3 -7 d -21 50 d -4 18 d f
- 0.675 0.675 0.675 c 1616 1291 m 3 -6 d -20 37 d -4 19 d f 0.7 0.7 0.7 c 1619
- 1285 m 4 -6 d -20 24 d -4 19 d f 0.725 0.725 0.725 c 1623 1279 m 3 -7 d -19 12
- d -4 19 d f 0.75 0.75 0.75 c 1626 1272 m 3 -6 d -19 X -3 18 d f 0.775 0.775
- 0.775 c 1629 1266 m 2 -5 d -20 2 d -1 3 d f 0.575 0.575 0.575 c 1584 1356 m 5
- -9 d -8 3 d f 0.6 0.6 0.6 c 1589 1347 m 19 -39 d -20 67 d -1 X -23 -57 d 17 32
- d f 0.625 0.625 0.625 c 1588 1375 m -1 3 d -3 Y f 0.425 0.425 0.425 c 1561 1337
- m -1 Y f 0.45 0.45 0.45 c 1561 1337 m 4 3 d -9 -20 d 5 16 d f 0.475 0.475 0.475
- c 1565 1340 m 4 3 d -18 -39 d 5 16 d f 0.5 0.5 0.5 c 1569 1343 m 4 4 d -27 -59
- d 5 16 d f 0.525 0.525 0.525 c 1573 1347 m 4 3 d -36 -78 d 5 16 d f 0.55 0.55
- 0.55 c 1577 1350 m 4 3 d -31 -63 d -10 -18 d 1 X f 0.575 0.575 0.575 c 1581
- 1353 m 3 3 d -3 -6 d -22 -41 d -9 -19 d f 0.6 0.6 0.6 c 1581 1350 m -17 -32 d
- -5 -9 d f 0.425 0.425 0.425 c 1561 1337 m -1 Y f 0.45 0.45 0.45 c 1559 1334 m 2
- 3 d -1 Y -5 -16 d f 0.475 0.475 0.475 c 1558 1331 m 1 3 d -3 -14 d -5 -16 d f
- 0.5 0.5 0.5 c 1557 1328 m 1 3 d -7 -27 d -5 -16 d f 0.525 0.525 0.525 c 1555
- 1326 m 2 2 d -11 -40 d -5 -16 d f 0.55 0.55 0.55 c 1554 1323 m 1 3 d -14 -54 d
- -1 X -2 -1 d f 0.575 0.575 0.575 c 1552 1320 m 2 3 d -16 -52 d -2 X f 0.6 0.6
- 0.6 c 1551 1318 m 1 2 d -16 -49 d -2 -1 d f 0.625 0.625 0.625 c 1550 1315 m 1 3
- d -17 -48 d -2 X f 0.65 0.65 0.65 c 1548 1312 m 2 3 d -18 -45 d -2 -1 d f 0.675
- 0.675 0.675 c 1547 1309 m 1 3 d -18 -43 d -2 X f 0.7 0.7 0.7 c 1546 1307 m 1 2
- d -19 -40 d -2 -1 d f 0.725 0.725 0.725 c 1544 1304 m 2 3 d -20 -39 d -2 -1 d f
- 0.75 0.75 0.75 c 1543 1301 m 1 3 d -20 -37 d -2 X f 0.775 0.775 0.775 c 1541
- 1299 m 2 2 d -21 -34 d -2 -1 d f 0.8 0.8 0.8 c 1540 1296 m 1 3 d -21 -33 d -2 X
- f 0.825 0.825 0.825 c 1539 1293 m 1 3 d -22 -30 d -1 X 8 9 d f 0.85 0.85 0.85 c
- 1537 1290 m 2 3 d -14 -18 d f 0.75 0.75 0.75 c 1514 1217 m 4 14 d -18 105 d f
- 0.775 0.775 0.775 c 1518 1231 m 5 15 d -23 112 d -6 36 d 6 -58 d f 0.8 0.8 0.8
- c 1523 1246 m 5 15 d -16 31 d -12 66 d f 0.825 0.825 0.825 c 1528 1261 m 5 15 d
- -8 -1 d -8 -9 d -5 26 d f 0.85 0.85 0.85 c 1533 1276 m 4 14 d -12 -15 d f 0.75
- 0.75 0.75 c 1490 1198 m 24 19 d -14 119 d -15 -93 d f 0.775 0.775 0.775 c 1500
- 1336 m -6 58 d -10 -13 d -7 -74 d 8 -64 d f 0.8 0.8 0.8 c 1484 1381 m -14 -20 d
- 7 -54 d f 0.725 0.725 0.725 c 1467 1246 m 5 -10 d -5 12 d f 0.75 0.75 0.75 c
- 1472 1236 m 18 -38 d -5 45 d -23 41 d 5 -36 d f 0.775 0.775 0.775 c 1485 1243 m
- -8 64 d -20 12 d 5 -35 d f 0.8 0.8 0.8 c 1477 1307 m -7 54 d -3 4 d -15 -10 d 5
- -36 d f 0.825 0.825 0.825 c 1467 1365 m -18 27 d -2 -2 d 5 -35 d f 0.85 0.85
- 0.85 c 1449 1392 m -2 4 d -6 Y f 0.725 0.725 0.725 c 1443 1226 m 24 20 d 2 Y
- -25 -19 d f 0.75 0.75 0.75 c 1467 1248 m -5 36 d -25 -35 d 5 -20 d f 0.775
- 0.775 0.775 c 1462 1284 m -5 35 d -26 -51 d 6 -19 d f 0.8 0.8 0.8 c 1457 1319 m
- -5 36 d -27 -67 d 6 -20 d f 0.825 0.825 0.825 c 1452 1355 m -5 35 d -5 -14 d
- -19 -80 d 2 -8 d f 0.85 0.85 0.85 c 1447 1390 m 6 Y -5 -20 d f 0.675 0.675
- 0.675 c 1420 1247 m 1 -1 d -2 5 d f 0.7 0.7 0.7 c 1421 1246 m 12 -11 d -19 50 d
- 5 -34 d f 0.725 0.725 0.725 c 1433 1235 m 10 -9 d -1 3 d -33 90 d 5 -34 d f
- 0.75 0.75 0.75 c 1442 1229 m -5 20 d -33 103 d 5 -33 d f 0.775 0.775 0.775 c
- 1437 1249 m -6 19 d -30 111 d -1 5 d 4 -32 d f 0.8 0.8 0.8 c 1431 1268 m -6 20
- d -8 31 d -16 60 d f 0.825 0.825 0.825 c 1425 1288 m -2 8 d -6 23 d f 0.625
- 0.625 0.625 c 1377 1326 m -1 -2 d 3 -15 d f 0.65 0.65 0.65 c 1381 1335 m -4 -9
- d 2 -17 d 15 -81 d f 0.675 0.675 0.675 c 1396 1214 m 24 33 d -1 4 d -35 94 d -3
- -10 d 13 -107 d f 0.7 0.7 0.7 c 1419 1251 m -5 34 d -26 70 d -4 -10 d f 0.725
- 0.725 0.725 c 1414 1285 m -5 34 d -17 46 d -4 -10 d f 0.75 0.75 0.75 c 1409
- 1319 m -5 33 d -8 23 d -4 -10 d f 0.775 0.775 0.775 c 1404 1352 m -4 32 d -4 -9
- d f 0.625 0.625 0.625 c 1379 1309 m -3 15 d -1 -3 d f 0.65 0.65 0.65 c 1394
- 1228 m -15 81 d -4 12 d -7 -17 d f 0.675 0.675 0.675 c 1388 1207 m 8 7 d -2 14
- d -26 76 d -6 -16 d f 0.7 0.7 0.7 c 1378 1199 m 10 8 d -26 81 d -7 -17 d f
- 0.725 0.725 0.725 c 1373 1195 m 5 4 d -23 72 d -2 -7 d f 0.7 0.7 0.7 c 1349
- 1229 m 14 -19 d -21 67 d f 0.725 0.725 0.725 c 1363 1210 m 10 -15 d -20 69 d
- -18 75 d -4 12 d 11 -74 d f 0.75 0.75 0.75 c 1335 1339 m -6 27 d 2 -15 d f 0.7
- 0.7 0.7 c 1326 1196 m 23 33 d -7 48 d -16 -80 d f 0.725 0.725 0.725 c 1342 1277
- m -11 74 d -10 -141 d 5 -13 d f 0.75 0.75 0.75 c 1331 1351 m -2 15 d -6 -30 d
- -7 -113 d 5 -13 d f 0.775 0.775 0.775 c 1323 1336 m -8 -38 d -4 -62 d 5 -13 d f
- 0.8 0.8 0.8 c 1315 1298 m -8 -38 d -11 Y 4 -13 d f 0.825 0.825 0.825 c 1307
- 1260 m -1 -8 d 1 -3 d f 0.7 0.7 0.7 c 1326 1197 m -1 Y 1 Y f 0.725 0.725 0.725
- c 1311 1235 m 15 -38 d -5 13 d f 0.75 0.75 0.75 c 1302 1258 m 9 -23 d 10 -25 d
- -5 13 d -15 38 d f 0.775 0.775 0.775 c 1316 1223 m -5 13 d -15 34 d 5 -9 d f
- 0.8 0.8 0.8 c 1311 1236 m -4 13 d -15 31 d 4 -10 d f 0.825 0.825 0.825 c 1307
- 1249 m -1 3 d -9 19 d -9 18 d 4 -9 d f 0.85 0.85 0.85 c 1297 1271 m -12 23 d -2
- 4 d 5 -9 d f 0.875 0.875 0.875 c 1285 1294 m -3 6 d 1 -2 d f 0.75 0.75 0.75 c
- 1299 1248 m 3 10 d -1 3 d f 0.775 0.775 0.775 c 1292 1224 m 7 24 d 2 13 d -5 9
- d f 0.8 0.8 0.8 c 1284 1200 m 8 24 d 4 46 d -4 10 d f 0.825 0.825 0.825 c 1279
- 1184 m 5 16 d 8 80 d -4 9 d -22 -61 d f 0.85 0.85 0.85 c 1288 1289 m -5 9 d -7
- -9 d -17 -35 d 7 -26 d f 0.875 0.875 0.875 c 1283 1298 m -1 2 d -6 -11 d f
- 0.575 0.575 0.575 c 1237 1248 m -2 X 2 -5 d f 0.6 0.6 0.6 c 1239 1249 m -2 -1 d
- -5 Y 2 -6 d f 0.625 0.625 0.625 c 1241 1249 m -2 X -12 Y 2 -6 d f 0.65 0.65
- 0.65 c 1243 1250 m -2 -1 d -18 Y 2 -6 d f 0.675 0.675 0.675 c 1245 1250 m -2 X
- -25 Y 2 -6 d f 0.7 0.7 0.7 c 1248 1251 m -3 -1 d -31 Y 3 -6 d f 0.725 0.725
- 0.725 c 1250 1251 m -2 X -38 Y 2 -5 d f 0.75 0.75 0.75 c 1252 1252 m -2 -1 d
- -43 Y 2 -6 d f 0.775 0.775 0.775 c 1254 1252 m -2 X -50 Y 2 -6 d f 0.8 0.8 0.8
- c 1255 1192 m 9 -3 d -8 64 d -2 -1 d -56 Y f 0.825 0.825 0.825 c 1264 1189 m 15
- -5 d -13 44 d -8 26 d -2 -1 d f 0.85 0.85 0.85 c 1266 1228 m -7 26 d -1 X f
- 0.575 0.575 0.575 c 1232 1146 m 1 2 d 4 95 d -2 5 d -4 29 d -1 -107 d f 0.6 0.6
- 0.6 c 1233 1148 m 3 5 d 3 84 d -2 6 d -6 34 d -4 36 d -1 -81 d 4 -62 d f 0.625
- 0.625 0.625 c 1236 1153 m 2 5 d 3 73 d -2 6 d -12 76 d -5 37 d -1 -56 d 5 -62 d
- f 0.65 0.65 0.65 c 1238 1158 m 3 5 d 2 62 d -2 6 d -19 119 d -5 36 d -30 Y 4
- -62 d f 0.675 0.675 0.675 c 1241 1163 m 2 5 d 2 51 d -2 6 d -26 161 d -4 37 d
- -5 Y 4 -62 d f 0.7 0.7 0.7 c 1243 1168 m 3 5 d 2 40 d -3 6 d -32 204 d -1 7 d 1
- -12 d f 0.725 0.725 0.725 c 1246 1173 m 3 5 d 1 30 d -2 5 d f 0.75 0.75 0.75 c
- 1249 1178 m 2 5 d 1 19 d -2 6 d f 0.775 0.775 0.775 c 1251 1183 m 3 6 d 7 Y -2
- 6 d f 0.8 0.8 0.8 c 1254 1189 m 1 3 d -1 4 d f 0.475 0.475 0.475 c 1188 1290 m
- -2 Y f 0.5 0.5 0.5 c 1191 1307 m -3 -17 d -2 Y 3 -23 d f 0.525 0.525 0.525 c
- 1194 1324 m -3 -17 d -42 Y 3 -23 d f 0.55 0.55 0.55 c 1197 1341 m -3 -17 d -82
- Y 3 -23 d f 0.575 0.575 0.575 c 1229 1143 m 3 3 d -2 24 d -30 188 d -3 -17 d
- -122 Y 3 -23 d f 0.6 0.6 0.6 c 1222 1138 m 7 5 d 1 27 d -4 62 d -23 143 d -3
- -17 d -162 Y 3 -24 d f 0.625 0.625 0.625 c 1215 1132 m 7 6 d 4 94 d -5 62 d -16
- 98 d -2 -17 d -203 Y 3 -23 d f 0.65 0.65 0.65 c 1209 1126 m 6 6 d 6 162 d -4 62
- d -9 53 d -3 -17 d 1 -243 d f 0.675 0.675 0.675 c 1217 1356 m -4 62 d -2 8 d -3
- -17 d f 0.7 0.7 0.7 c 1213 1418 m -1 12 d -1 -4 d f 0.475 0.475 0.475 c 1188
- 1288 m 1 Y f 0.5 0.5 0.5 c 1191 1265 m -3 23 d 1 Y -4 -7 d f 0.525 0.525 0.525
- c 1194 1242 m -3 23 d -7 17 d -3 -7 d f 0.55 0.55 0.55 c 1197 1219 m -3 23 d
- -13 33 d -4 -7 d f 0.575 0.575 0.575 c 1200 1196 m -3 23 d -20 49 d -3 -7 d f
- 0.6 0.6 0.6 c 1203 1172 m -3 24 d -26 65 d -4 -7 d f 0.625 0.625 0.625 c 1206
- 1149 m -3 23 d -33 82 d -3 -7 d f 0.65 0.65 0.65 c 1208 1126 m 1 X -3 23 d -39
- 98 d -2 -4 d 2 -11 d f 0.675 0.675 0.675 c 1203 1128 m 5 -2 d -41 106 d 4 -22 d
- f 0.7 0.7 0.7 c 1198 1130 m 5 -2 d -32 82 d 4 -23 d f 0.725 0.725 0.725 c 1192
- 1131 m 6 -1 d -23 57 d 4 -22 d f 0.75 0.75 0.75 c 1187 1133 m 5 -2 d -13 34 d 4
- -22 d f 0.775 0.775 0.775 c 1185 1134 m 2 -1 d -4 10 d f 0.65 0.65 0.65 c 1162
- 1114 m 3 3 d 2 115 d -2 11 d -4 -5 d -3 -105 d f 0.675 0.675 0.675 c 1165 1117
- m 4 4 d 2 89 d -4 22 d -6 6 d -7 -10 d -2 -67 d 6 -28 d f 0.7 0.7 0.7 c 1169
- 1121 m 5 3 d 1 63 d -4 23 d -17 18 d -7 -10 d -1 -29 d 6 -28 d f 0.725 0.725
- 0.725 c 1174 1124 m 5 4 d 37 Y -4 22 d -28 31 d -6 -8 d 5 -21 d f 0.75 0.75
- 0.75 c 1179 1128 m 4 4 d 11 Y -4 22 d f 0.775 0.775 0.775 c 1183 1132 m 2 2 d
- -2 9 d f 0.65 0.65 0.65 c 1160 1122 m 2 -8 d -4 19 d f 0.675 0.675 0.675 c 1157
- 1133 m 3 -11 d -2 11 d -6 28 d f 0.7 0.7 0.7 c 1154 1145 m 3 -12 d -5 28 d -6
- 28 d f 0.725 0.725 0.725 c 1152 1157 m 2 -12 d -8 44 d -5 21 d -5 5 d f 0.75
- 0.75 0.75 c 1149 1168 m 3 -11 d -16 58 d -18 16 d f 0.775 0.775 0.775 c 1146
- 1180 m 3 -12 d -31 63 d 5 -4 d f 0.8 0.8 0.8 c 1144 1192 m 2 -12 d -23 47 d 5
- -4 d f 0.825 0.825 0.825 c 1141 1203 m 3 -11 d -16 31 d 5 -3 d f 0.85 0.85 0.85
- c 1138 1215 m 3 -12 d -8 17 d 5 -4 d f 0.875 0.875 0.875 c 1138 1216 m -1 Y 1 Y
- f 0.575 0.575 0.575 c 1115 1143 m 1 4 d -4 -4 d f 0.6 0.6 0.6 c 1116 1147 m 2 6
- d -9 -10 d 3 X f 0.625 0.625 0.625 c 1118 1153 m 2 6 d -14 -16 d 3 X f 0.65
- 0.65 0.65 c 1120 1159 m 2 7 d -19 -22 d 3 -1 d f 0.675 0.675 0.675 c 1122 1166
- m 2 6 d -24 -28 d 3 X f 0.7 0.7 0.7 c 1124 1172 m 2 6 d -29 -34 d 3 X f 0.725
- 0.725 0.725 c 1126 1178 m 2 6 d -33 -38 d -1 -1 d 3 -1 d f 0.75 0.75 0.75 c
- 1128 1184 m 2 6 d -12 41 d -23 -85 d f 0.775 0.775 0.775 c 1130 1190 m 2 7 d -9
- 30 d -5 4 d f 0.8 0.8 0.8 c 1132 1197 m 2 6 d -6 20 d -5 4 d f 0.825 0.825
- 0.825 c 1134 1203 m 2 6 d -3 11 d -5 3 d f 0.85 0.85 0.85 c 1136 1209 m 2 6 d 1
- Y -5 4 d f 0.875 0.875 0.875 c 1138 1215 m 1 Y f 0.525 0.525 0.525 c 1073 1272
- m -2 14 d 1 -17 d f 0.55 0.55 0.55 c 1076 1256 m -3 16 d -1 -3 d 2 -18 d f
- 0.575 0.575 0.575 c 1113 1137 m 2 6 d -3 X -34 97 d -2 16 d -2 -5 d 1 -19 d f
- 0.6 0.6 0.6 c 1111 1128 m 2 9 d -1 6 d -3 X -28 81 d -3 16 d -3 -8 d 2 -18 d f
- 0.625 0.625 0.625 c 1108 1120 m 3 8 d -2 15 d -3 X -22 65 d -3 16 d -4 -10 d 2
- -19 d f 0.65 0.65 0.65 c 1106 1111 m 2 9 d -2 23 d -3 1 d -17 48 d -2 16 d -5
- -13 d 1 -18 d f 0.675 0.675 0.675 c 1104 1103 m 2 8 d -3 33 d -3 X -11 32 d -3
- 16 d -6 -15 d 2 -19 d f 0.7 0.7 0.7 c 1101 1094 m 3 9 d -4 41 d -3 X -5 16 d -3
- 16 d -7 -18 d 2 -18 d f 0.725 0.725 0.725 c 1099 1086 m 2 8 d -4 50 d -3 1 d -2
- 15 d -8 -20 d 1 -19 d f 0.75 0.75 0.75 c 1097 1077 m 2 9 d -14 35 d 2 -18 d f
- 0.775 0.775 0.775 c 1095 1069 m 2 8 d -10 26 d 2 -19 d f 0.8 0.8 0.8 c 1092
- 1060 m 3 9 d -6 15 d 1 -18 d f 0.825 0.825 0.825 c 1091 1056 m 1 4 d -2 6 d f
- 0.525 0.525 0.525 c 1072 1269 m -1 17 d -3 8 d f 0.55 0.55 0.55 c 1074 1251 m
- -2 18 d -4 25 d -2 9 d f 0.575 0.575 0.575 c 1075 1232 m -1 19 d -8 52 d -3 8 d
- f 0.6 0.6 0.6 c 1077 1214 m -2 18 d -12 79 d -3 9 d f 0.625 0.625 0.625 c 1079
- 1195 m -2 19 d -17 106 d -2 8 d f 0.65 0.65 0.65 c 1080 1177 m -1 18 d -21 133
- d -3 8 d f 0.675 0.675 0.675 c 1082 1158 m -2 19 d -25 159 d -3 9 d f 0.7 0.7
- 0.7 c 1068 1077 m 1 -1 d 15 64 d -2 18 d -30 187 d -2 8 d 13 -206 d f 0.725
- 0.725 0.725 c 1069 1076 m 5 -5 d 11 50 d -1 19 d -34 213 d -3 8 d 16 -214 d f
- 0.75 0.75 0.75 c 1074 1071 m 5 -4 d 8 36 d -2 18 d f 0.775 0.775 0.775 c 1079
- 1067 m 5 -4 d 5 21 d -2 19 d f 0.8 0.8 0.8 c 1084 1063 m 4 -5 d 2 8 d -1 18 d f
- 0.825 0.825 0.825 c 1088 1058 m 3 -2 d -1 10 d f 0.55 0.55 0.55 c 1024 1237 m
- -6 Y f 0.575 0.575 0.575 c 1028 1255 m -4 -18 d -6 Y 4 -18 d f 0.6 0.6 0.6 c
- 1031 1273 m -3 -18 d -42 Y 4 -17 d f 0.625 0.625 0.625 c 1034 1291 m -3 -18 d 1
- -77 d 4 -18 d f 0.65 0.65 0.65 c 1038 1309 m -4 -18 d 2 -113 d 3 -18 d f 0.675
- 0.675 0.675 c 1041 1327 m -3 -18 d 1 -149 d 4 -17 d f 0.7 0.7 0.7 c 1044 1138 m
- 24 -61 d -5 70 d -19 198 d -3 -18 d 2 -184 d f 0.725 0.725 0.725 c 1063 1147 m
- -16 214 d -3 -16 d f 0.55 0.55 0.55 c 1024 1231 m 3 Y -1 -1 d f 0.575 0.575
- 0.575 c 1028 1213 m -4 18 d -1 2 d -5 -7 d f 0.6 0.6 0.6 c 1032 1196 m -4 17 d
- -10 13 d -5 -7 d f 0.625 0.625 0.625 c 1036 1178 m -4 18 d -19 23 d -5 -6 d f
- 0.65 0.65 0.65 c 1039 1160 m -3 18 d -28 35 d -5 -7 d f 0.675 0.675 0.675 c
- 1043 1143 m -4 17 d -36 46 d -3 -5 d 1 -7 d f 0.7 0.7 0.7 c 1041 1129 m 3 9 d
- -1 5 d -42 51 d 3 -21 d f 0.725 0.725 0.725 c 1037 1117 m 4 12 d -37 44 d 4 -21
- d f 0.75 0.75 0.75 c 1033 1104 m 4 13 d -29 35 d 3 -21 d f 0.775 0.775 0.775 c
- 1029 1092 m 4 12 d -22 27 d 3 -21 d f 0.8 0.8 0.8 c 1025 1079 m 4 13 d -15 18 d
- 3 -21 d f 0.825 0.825 0.825 c 1021 1067 m 4 12 d -8 10 d 3 -21 d f 0.85 0.85
- 0.85 c 1021 1065 m 2 Y -1 1 d f 0.675 0.675 0.675 c 1001 1194 m -1 7 d -13 12 d
- f 0.7 0.7 0.7 c 1004 1173 m -3 21 d -14 19 d -10 9 d 2 -15 d f 0.725 0.725
- 0.725 c 1008 1152 m -4 21 d -25 34 d 4 -20 d f 0.75 0.75 0.75 c 1011 1131 m -3
- 21 d -25 35 d 3 -21 d f 0.775 0.775 0.775 c 1014 1110 m -3 21 d -25 35 d 4 -21
- d f 0.8 0.8 0.8 c 1017 1089 m -3 21 d -24 35 d 3 -21 d f 0.825 0.825 0.825 c
- 1020 1068 m -3 21 d -24 35 d 3 -20 d f 0.85 0.85 0.85 c 997 1099 m 24 -34 d -1
- 3 d -24 36 d f 0.7 0.7 0.7 c 979 1207 m -2 15 d -24 -73 d f 0.725 0.725 0.725 c
- 983 1187 m -4 20 d -26 -58 d 5 -11 d f 0.75 0.75 0.75 c 986 1166 m -3 21 d -25
- -49 d 5 -10 d f 0.775 0.775 0.775 c 990 1145 m -4 21 d -23 -38 d 5 -10 d f 0.8
- 0.8 0.8 c 993 1124 m -3 21 d -22 -27 d 5 -11 d f 0.825 0.825 0.825 c 974 1107 m
- 19 -6 d 3 3 d -3 20 d -20 -17 d f 0.85 0.85 0.85 c 993 1101 m 4 -2 d -1 5 d f
- 0.7 0.7 0.7 c 953 1149 m f 0.725 0.725 0.725 c 958 1138 m -5 11 d -12 18 d f
- 0.75 0.75 0.75 c 963 1128 m -5 10 d -17 29 d -11 16 d 1 -1 d f 0.775 0.775
- 0.775 c 968 1118 m -5 10 d -32 54 d 15 -22 d f 0.8 0.8 0.8 c 950 1154 m 22 -45
- d 1 -2 d -5 11 d -22 42 d f 0.825 0.825 0.825 c 972 1109 m 2 -2 d -1 X f 0.675
- 0.675 0.675 c 908 1241 m -2 4 d 1 -10 d f 0.7 0.7 0.7 c 915 1221 m -7 20 d -1
- -6 d 5 -54 d f 0.725 0.725 0.725 c 923 1201 m -8 20 d -3 -40 d 5 -54 d f 0.75
- 0.75 0.75 c 931 1182 m -1 1 d -7 18 d -6 -74 d 5 -53 d f 0.775 0.775 0.775 c
- 927 1028 m 8 42 d 11 90 d -15 22 d -9 -108 d f 0.8 0.8 0.8 c 935 1070 m 15 84 d
- -4 6 d f 0.675 0.675 0.675 c 907 1235 m -1 10 d -23 -74 d 1 -2 d f 0.7 0.7 0.7
- c 912 1181 m -5 54 d -23 -66 d 6 -8 d f 0.725 0.725 0.725 c 917 1127 m -5 54 d
- -22 -20 d 5 -7 d f 0.75 0.75 0.75 c 922 1074 m -5 53 d -22 27 d 6 -8 d f 0.775
- 0.775 0.775 c 903 1142 m 24 -114 d -5 46 d -21 72 d f 0.6 0.6 0.6 c 865 1187 m
- -6 5 d 3 -18 d f 0.625 0.625 0.625 c 871 1182 m -6 5 d -3 -13 d 4 -21 d f 0.65
- 0.65 0.65 c 878 1176 m -7 6 d -5 -29 d 3 -21 d f 0.675 0.675 0.675 c 884 1169 m
- -1 2 d -5 5 d -9 -44 d 4 -21 d f 0.7 0.7 0.7 c 890 1161 m -6 8 d -11 -58 d 3
- -21 d f 0.725 0.725 0.725 c 880 1069 m 2 Y 15 83 d -5 7 d -14 -71 d f 0.75 0.75
- 0.75 c 880 1071 m 17 51 d 4 24 d -6 8 d f 0.775 0.775 0.775 c 897 1122 m 6 20 d
- -2 4 d f 0.525 0.525 0.525 c 841 1091 m -5 -26 d 2 6 d f 0.55 0.55 0.55 c 849
- 1138 m -8 -47 d -3 -20 d 4 10 d f 0.575 0.575 0.575 c 858 1185 m -9 -47 d -7
- -57 d 4 10 d f 0.6 0.6 0.6 c 862 1174 m -3 18 d -1 -7 d -12 -94 d 4 10 d f
- 0.625 0.625 0.625 c 866 1153 m -4 21 d -12 -73 d 4 10 d f 0.65 0.65 0.65 c 856
- 1117 m 3 -6 d 10 21 d -3 21 d -12 -42 d f 0.675 0.675 0.675 c 859 1111 m 7 -14
- d 7 14 d -4 21 d f 0.7 0.7 0.7 c 866 1097 m 7 -14 d 3 7 d -3 21 d f 0.725 0.725
- 0.725 c 873 1083 m 7 -14 d -4 21 d f 0.525 0.525 0.525 c 838 1071 m -2 -6 d -1
- 3 d f 0.55 0.55 0.55 c 842 1081 m -4 -10 d -3 -3 d -2 3 d f 0.575 0.575 0.575 c
- 846 1091 m -4 -10 d -9 -10 d -2 4 d f 0.6 0.6 0.6 c 850 1101 m -4 -10 d -15 -16
- d -2 4 d f 0.625 0.625 0.625 c 854 1111 m -4 -10 d -21 -22 d -2 4 d f 0.65 0.65
- 0.65 c 854 1110 m 2 7 d -2 -6 d -27 -28 d -2 4 d f 0.675 0.675 0.675 c 850 1091
- m 4 19 d -29 -23 d -2 4 d f 0.7 0.7 0.7 c 846 1073 m 4 18 d -27 X -2 4 d f
- 0.725 0.725 0.725 c 841 1054 m 5 19 d -25 22 d -2 4 d f 0.75 0.75 0.75 c 837
- 1036 m 4 18 d -22 45 d -1 4 d f 0.775 0.775 0.775 c 833 1017 m 4 19 d -19 67 d
- -2 4 d f 0.8 0.8 0.8 c 833 1017 m -17 90 d -2 3 d 7 -37 d f 0.825 0.825 0.825 c
- 814 1110 m -2 3 d 9 -40 d f 0.6 0.6 0.6 c 809 1065 m 3 -6 d -21 121 d -2 8 d f
- 0.625 0.625 0.625 c 812 1059 m 3 -6 d -21 120 d -3 7 d f 0.65 0.65 0.65 c 815
- 1053 m 3 -6 d -22 118 d -2 8 d f 0.675 0.675 0.675 c 818 1047 m 3 -6 d -23 116
- d -2 8 d f 0.7 0.7 0.7 c 821 1041 m 3 -6 d -23 115 d -3 7 d f 0.725 0.725 0.725
- c 824 1035 m 3 -6 d -24 113 d -2 8 d f 0.75 0.75 0.75 c 827 1029 m 3 -6 d -24
- 111 d -3 8 d f 0.775 0.775 0.775 c 830 1023 m 3 -6 d -25 109 d -2 8 d f 0.8 0.8
- 0.8 c 833 1017 m -12 56 d -10 46 d -3 7 d f 0.825 0.825 0.825 c 821 1073 m -9
- 40 d -1 6 d f 0.425 0.425 0.425 c 768 1229 m -3 7 d 2 -10 d f 0.45 0.45 0.45 c
- 772 1222 m -4 7 d -1 -3 d 2 -10 d f 0.475 0.475 0.475 c 775 1216 m -3 6 d -3 -6
- d 2 -11 d f 0.5 0.5 0.5 c 779 1209 m -4 7 d -4 -11 d 2 -10 d f 0.525 0.525
- 0.525 c 782 1202 m -3 7 d -6 -14 d 2 -11 d f 0.55 0.55 0.55 c 785 1195 m -3 7 d
- -7 -18 d 2 -10 d f 0.575 0.575 0.575 c 789 1188 m -4 7 d -8 -21 d 2 -11 d f 0.6
- 0.6 0.6 c 803 1081 m 6 -16 d -20 123 d -10 -25 d 2 -10 d f 0.625 0.625 0.625 c
- 796 1098 m 7 -17 d -22 72 d 2 -10 d f 0.65 0.65 0.65 c 790 1116 m 6 -18 d -13
- 45 d 2 -11 d f 0.675 0.675 0.675 c 786 1126 m 4 -10 d -5 16 d f 0.425 0.425
- 0.425 c 767 1226 m -2 10 d -3 -57 d f 0.45 0.45 0.45 c 769 1216 m -2 10 d -5
- -47 d -4 -62 d f 0.475 0.475 0.475 c 771 1205 m -2 11 d -11 -99 d -4 -62 d f
- 0.5 0.5 0.5 c 773 1195 m -2 10 d -17 -150 d -4 -61 d f 0.525 0.525 0.525 c 775
- 1184 m -2 11 d -23 -201 d -4 -62 d f 0.55 0.55 0.55 c 777 1174 m -2 10 d -29
- -252 d -4 -61 d f 0.575 0.575 0.575 c 762 851 m 4 48 d 13 264 d -2 11 d -35
- -303 d -4 Y f 0.6 0.6 0.6 c 766 899 m 6 63 d 9 191 d -2 10 d f 0.625 0.625
- 0.625 c 772 962 m 5 64 d 6 117 d -2 10 d f 0.65 0.65 0.65 c 777 1026 m 6 63 d 2
- 43 d -2 11 d f 0.675 0.675 0.675 c 783 1089 m 3 37 d -1 6 d f 0.55 0.55 0.55 c
- 739 845 m 1 1 d -18 16 d -4 -1 d f 0.575 0.575 0.575 c 740 846 m 22 5 d -20 16
- d -20 -5 d f 0.55 0.55 0.55 c 715 839 m 24 6 d -21 16 d -23 -6 d f 692 833 m 23
- 6 d -20 16 d -24 -6 d f 1793 1093 m 23 6 d -20 15 d -24 -6 d f 1769 1087 m 24 6
- d -21 15 d -23 -6 d f 1766 1086 m 3 1 d -20 15 d -24 -6 d 7 -5 d f 0.575 0.575
- 0.575 c 1746 1081 m 20 5 d -34 5 d f 0.55 0.55 0.55 c 1732 1091 m -7 5 d 3 Y f
- 0.575 0.575 0.575 c 1743 1099 m 3 -18 d -14 10 d -7 8 d -7 62 d f 0.6 0.6 0.6 c
- 1739 1118 m 4 -19 d -25 62 d -8 61 d f 0.625 0.625 0.625 c 1736 1138 m 3 -20 d
- -29 104 d -7 62 d f 0.65 0.65 0.65 c 1733 1157 m 3 -19 d -33 146 d -1 8 d 4 -14
- d f 0.675 0.675 0.675 c 1730 1177 m 3 -20 d -27 121 d 5 -17 d f 0.7 0.7 0.7 c
- 1727 1196 m 3 -19 d -19 84 d 5 -16 d f 0.725 0.725 0.725 c 1723 1216 m 4 -20 d
- -11 49 d 4 -16 d f 0.75 0.75 0.75 c 1722 1223 m 1 -7 d -3 13 d f 0.65 0.65 0.65
- c 1706 1278 m -4 14 d -6 -5 d f 0.675 0.675 0.675 c 1711 1261 m -5 17 d -10 9 d
- -7 -5 d f 0.7 0.7 0.7 c 1716 1245 m -5 16 d -22 21 d -7 -6 d f 0.725 0.725
- 0.725 c 1720 1229 m -4 16 d -34 31 d -4 -3 d 3 -12 d f 0.75 0.75 0.75 c 1715
- 1213 m 7 10 d -2 6 d -39 32 d 7 -29 d f 0.775 0.775 0.775 c 1704 1197 m 11 16 d
- -27 19 d 7 -29 d f 0.8 0.8 0.8 c 1699 1190 m 5 7 d -9 6 d f 0.7 0.7 0.7 c 1669
- 1286 m -14 21 d 3 -23 d f 0.725 0.725 0.725 c 1681 1261 m -3 12 d -9 13 d -11
- -2 d 4 -25 d f 0.75 0.75 0.75 c 1688 1232 m -7 29 d -19 -2 d 4 -26 d f 0.775
- 0.775 0.775 c 1695 1203 m -7 29 d -22 1 d 4 -25 d f 0.8 0.8 0.8 c 1686 1179 m
- 13 11 d -4 13 d -25 5 d 3 -25 d f 0.825 0.825 0.825 c 1675 1170 m 11 9 d -13 4
- d f 0.7 0.7 0.7 c 1658 1284 m -3 23 d -6 -11 d f 0.725 0.725 0.725 c 1662 1259
- m -4 25 d -9 12 d -6 -13 d f 0.75 0.75 0.75 c 1666 1233 m -4 26 d -19 24 d -7
- -13 d f 0.775 0.775 0.775 c 1652 1165 m 6 1 d 12 42 d -4 25 d -30 37 d -5 -9 d
- f 0.8 0.8 0.8 c 1658 1166 m 11 3 d 4 14 d -3 25 d f 0.825 0.825 0.825 c 1669
- 1169 m 6 1 d -2 13 d f 0.575 0.575 0.575 c 1628 1212 m 2 Y f 0.6 0.6 0.6 c 1628
- 1212 m 3 -6 d -21 98 d -2 4 d 20 -94 d f 0.625 0.625 0.625 c 1631 1206 m 3 -7 d
- -21 99 d -3 6 d f 0.65 0.65 0.65 c 1634 1199 m 4 -6 d -22 98 d -3 7 d f 0.675
- 0.675 0.675 c 1638 1193 m 3 -6 d -22 98 d -3 6 d f 0.7 0.7 0.7 c 1641 1187 m 3
- -7 d -21 99 d -4 6 d f 0.725 0.725 0.725 c 1644 1180 m 3 -6 d -21 98 d -3 7 d f
- 0.75 0.75 0.75 c 1647 1174 m 3 -6 d -21 98 d -3 6 d f 0.775 0.775 0.775 c 1650
- 1168 m 2 -3 d -21 96 d -2 5 d f 0.575 0.575 0.575 c 1628 1212 m 2 Y -39 133 d
- -5 9 d 1 -2 d f 0.6 0.6 0.6 c 1623 1220 m 5 -8 d 2 Y -20 94 d -19 39 d -4 7 d 4
- -22 d f 0.625 0.625 0.625 c 1618 1227 m 5 -7 d -34 112 d 4 -23 d f 0.65 0.65
- 0.65 c 1613 1234 m 5 -7 d -25 82 d 4 -23 d f 0.675 0.675 0.675 c 1608 1241 m 5
- -7 d -16 52 d 4 -22 d f 0.7 0.7 0.7 c 1605 1247 m 3 -6 d -7 23 d f 0.425 0.425
- 0.425 c 1561 1337 m -1 Y f 0.45 0.45 0.45 c 1565 1340 m -4 -3 d -1 Y 2 -20 d f
- 0.475 0.475 0.475 c 1569 1343 m -4 -3 d -2 -24 d 2 -20 d f 0.5 0.5 0.5 c 1573
- 1347 m -4 -4 d -4 -47 d 2 -19 d f 0.525 0.525 0.525 c 1577 1350 m -4 -3 d -6
- -70 d 2 -20 d f 0.55 0.55 0.55 c 1581 1353 m -4 -3 d -8 -93 d 2 -20 d f 0.575
- 0.575 0.575 c 1585 1354 m -1 2 d -3 -3 d -10 -116 d 2 -20 d f 0.6 0.6 0.6 c
- 1589 1332 m -4 22 d -12 -137 d 2 -19 d f 0.625 0.625 0.625 c 1593 1309 m -4 23
- d -14 -134 d 2 -20 d f 0.65 0.65 0.65 c 1597 1286 m -4 23 d -16 -131 d 2 -20 d
- f 0.675 0.675 0.675 c 1601 1264 m -4 22 d -18 -128 d 2 -20 d f 0.7 0.7 0.7 c
- 1581 1133 m 24 114 d -4 17 d -20 -126 d f 0.425 0.425 0.425 c 1561 1336 m 1 Y f
- 0.45 0.45 0.45 c 1563 1316 m -2 20 d 1 Y -2 -3 d f 0.475 0.475 0.475 c 1565
- 1296 m -2 20 d -4 18 d -1 -3 d f 0.5 0.5 0.5 c 1567 1277 m -2 19 d -7 35 d -1
- -3 d f 0.525 0.525 0.525 c 1569 1257 m -2 20 d -10 51 d -2 -2 d f 0.55 0.55
- 0.55 c 1571 1237 m -2 20 d -14 69 d -1 -3 d f 0.575 0.575 0.575 c 1573 1217 m
- -2 20 d -17 86 d -2 -3 d f 0.6 0.6 0.6 c 1575 1198 m -2 19 d -21 103 d -1 -2 d
- f 0.625 0.625 0.625 c 1577 1178 m -2 20 d -24 120 d -1 -3 d f 0.65 0.65 0.65 c
- 1579 1158 m -2 20 d -27 137 d -2 -3 d f 0.675 0.675 0.675 c 1581 1138 m -2 20 d
- -31 154 d -1 -3 d f 0.7 0.7 0.7 c 1575 1147 m 6 -14 d 5 Y -34 171 d -1 -2 d f
- 0.725 0.725 0.725 c 1565 1165 m 10 -18 d -29 160 d -2 -3 d f 0.75 0.75 0.75 c
- 1558 1181 m 7 -16 d -21 139 d -1 -3 d 14 -116 d f 0.775 0.775 0.775 c 1543 1301
- m -2 -2 d 11 -88 d 5 -26 d f 0.8 0.8 0.8 c 1541 1299 m -1 -3 d 7 -58 d 5 -27 d
- f 0.825 0.825 0.825 c 1540 1296 m -1 -3 d 3 -29 d 5 -26 d f 0.85 0.85 0.85 c
- 1539 1293 m -2 -3 d 5 -26 d f 0.75 0.75 0.75 c 1555 1178 m 3 3 d -1 4 d -39 46
- d -4 -14 d 10 -27 d f 0.775 0.775 0.775 c 1534 1161 m 21 17 d 2 7 d -5 26 d -29
- 35 d -5 -15 d 6 -41 d f 0.8 0.8 0.8 c 1552 1211 m -5 27 d -19 23 d -5 -15 d f
- 0.825 0.825 0.825 c 1547 1238 m -5 26 d -9 12 d -5 -15 d f 0.85 0.85 0.85 c
- 1542 1264 m -5 26 d -4 -14 d f 0.75 0.75 0.75 c 1524 1190 m -10 27 d -24 -19 d
- 5 -16 d f 0.775 0.775 0.775 c 1533 1160 m 1 1 d -10 29 d -29 -8 d 7 -23 d f 0.8
- 0.8 0.8 c 1517 1137 m 16 23 d -31 -1 d 6 -22 d f 0.825 0.825 0.825 c 1511 1129
- m 6 8 d -9 X f 0.725 0.725 0.725 c 1472 1236 m -5 10 d 1 -6 d f 0.75 0.75 0.75
- c 1495 1182 m -5 16 d -18 38 d -4 4 d 15 -80 d f 0.775 0.775 0.775 c 1487 1136
- m 8 -2 d 7 25 d -7 23 d -12 -22 d f 0.8 0.8 0.8 c 1495 1134 m 12 -4 d 1 7 d -6
- 22 d f 0.825 0.825 0.825 c 1507 1130 m 4 -1 d -3 8 d f 0.725 0.725 0.725 c 1468
- 1240 m -1 6 d -24 -20 d 3 -10 d f 0.75 0.75 0.75 c 1464 1157 m 3 -3 d 16 6 d
- -15 80 d -22 -24 d f 0.775 0.775 0.775 c 1467 1154 m 20 -18 d -4 24 d f 0.675
- 0.675 0.675 c 1421 1246 m -1 1 d -4 Y f 0.7 0.7 0.7 c 1433 1235 m -12 11 d -1
- -3 d 4 -31 d f 0.725 0.725 0.725 c 1446 1216 m -3 10 d -10 9 d -9 -23 d 3 -31 d
- f 0.75 0.75 0.75 c 1463 1156 m 1 1 d -18 59 d -19 -35 d 3 -31 d f 0.775 0.775
- 0.775 c 1456 1123 m 7 33 d -33 -6 d 4 -31 d f 0.8 0.8 0.8 c 1448 1090 m 8 33 d
- -22 -4 d 3 -31 d f 0.825 0.825 0.825 c 1440 1057 m 8 33 d -11 -2 d 3 -31 d f
- 0.85 0.85 0.85 c 1440 1057 m f 0.675 0.675 0.675 c 1420 1243 m 4 Y -24 -33 d 8
- -49 d f 0.7 0.7 0.7 c 1424 1212 m -4 31 d -16 -78 d 9 -59 d f 0.725 0.725 0.725
- c 1417 1078 m 3 -3 d 7 106 d -3 31 d -11 -106 d f 0.75 0.75 0.75 c 1420 1075 m
- 5 -4 d 5 79 d -3 31 d f 0.775 0.775 0.775 c 1425 1071 m 5 -5 d 4 53 d -4 31 d f
- 0.8 0.8 0.8 c 1430 1066 m 5 -4 d 2 26 d -3 31 d f 0.825 0.825 0.825 c 1435 1062
- m 5 -5 d -3 31 d f 0.85 0.85 0.85 c 1440 1057 m f 0.675 0.675 0.675 c 1404 1165
- m -8 49 d -8 -7 d f 0.7 0.7 0.7 c 1413 1106 m -9 59 d -16 42 d -10 -8 d f 0.725
- 0.725 0.725 c 1413 1081 m 4 -3 d -4 28 d -35 93 d -5 -4 d 3 -13 d f 0.75 0.75
- 0.75 c 1407 1086 m 6 -5 d -37 101 d 5 -26 d f 0.775 0.775 0.775 c 1401 1092 m 6
- -6 d -26 70 d 5 -25 d f 0.8 0.8 0.8 c 1395 1097 m 6 -5 d -15 39 d 6 -25 d f
- 0.825 0.825 0.825 c 1393 1099 m 2 -2 d -3 9 d f 0.7 0.7 0.7 c 1363 1210 m -14
- 19 d 4 -33 d f 0.725 0.725 0.725 c 1376 1182 m -3 13 d -10 15 d -10 -14 d 5 -51
- d f 0.75 0.75 0.75 c 1381 1156 m -5 26 d -18 -37 d 6 -51 d f 0.775 0.775 0.775
- c 1386 1131 m -5 25 d -17 -62 d 5 -52 d f 0.8 0.8 0.8 c 1370 1039 m 18 46 d 4
- 21 d -6 25 d -17 -89 d f 0.825 0.825 0.825 c 1388 1085 m 5 14 d -1 7 d f 0.7
- 0.7 0.7 c 1353 1196 m -4 33 d -23 -33 d -1 Y f 0.725 0.725 0.725 c 1346 1073 m
- 3 -3 d 9 75 d -5 51 d -27 -1 d f 0.75 0.75 0.75 c 1349 1070 m 10 -15 d 5 39 d
- -6 51 d f 0.775 0.775 0.775 c 1359 1055 m 10 -15 d 2 Y -5 52 d f 0.8 0.8 0.8 c
- 1369 1040 m 1 -1 d -1 3 d f 0.7 0.7 0.7 c 1326 1195 m 2 Y f 0.725 0.725 0.725 c
- 1323 1067 m 23 6 d -20 122 d 2 Y -15 38 d 5 -105 d f 0.75 0.75 0.75 c 1311 1235
- m -9 23 d 14 -128 d f 0.6 0.6 0.6 c 1299 1102 m 1 -1 d -1 2 d f 0.625 0.625
- 0.625 c 1300 1101 m 5 -7 d -8 18 d 2 -9 d f 0.65 0.65 0.65 c 1305 1094 m 5 -7 d
- -16 35 d 3 -10 d f 0.675 0.675 0.675 c 1310 1087 m 4 -7 d -22 51 d 2 -9 d f 0.7
- 0.7 0.7 c 1314 1080 m 5 -8 d -29 68 d 2 -9 d f 0.725 0.725 0.725 c 1319 1072 m
- 4 -5 d -7 63 d -29 20 d 3 -10 d f 0.75 0.75 0.75 c 1316 1130 m -14 128 d -3 -10
- d -14 -89 d 2 -9 d f 0.775 0.775 0.775 c 1299 1248 m -7 -24 d -9 -55 d 2 -10 d
- f 0.8 0.8 0.8 c 1292 1224 m -8 -24 d -3 -22 d 2 -9 d f 0.825 0.825 0.825 c 1284
- 1200 m -5 -16 d 2 -6 d f 0.6 0.6 0.6 c 1299 1103 m -1 Y 1 Y f 0.625 0.625 0.625
- c 1297 1112 m 2 -9 d -2 9 d f 0.65 0.65 0.65 c 1294 1122 m 3 -10 d -3 10 d f
- 0.675 0.675 0.675 c 1291 1131 m 3 -9 d -2 9 d f 0.7 0.7 0.7 c 1289 1141 m 2 -10
- d 1 X -2 9 d f 0.725 0.725 0.725 c 1286 1150 m 3 -9 d 1 -1 d -3 10 d f 0.75
- 0.75 0.75 c 1284 1160 m 2 -10 d 1 X -2 9 d f 0.775 0.775 0.775 c 1281 1169 m 3
- -9 d 1 -1 d -2 10 d f 0.8 0.8 0.8 c 1279 1179 m 2 -10 d 2 X -2 9 d -17 11 d -9
- 3 d 5 -1 d f 0.825 0.825 0.825 c 1276 1189 m 3 -10 d 2 -1 d -2 6 d -15 5 d -4 2
- d 14 -1 d f 0.85 0.85 0.85 c 1276 1190 m -1 Y -2 1 d f 0.425 0.425 0.425 c 1252
- 1117 m 1 1 d -2 X f 0.45 0.45 0.45 c 1253 1118 m 1 4 d -6 1 d 3 -5 d f 0.475
- 0.475 0.475 c 1254 1122 m 2 5 d -12 1 d 4 -5 d f 0.5 0.5 0.5 c 1256 1127 m 1 4
- d -16 2 d 3 -5 d f 0.525 0.525 0.525 c 1257 1131 m 1 5 d -20 2 d 3 -5 d f 0.55
- 0.55 0.55 c 1258 1136 m 2 4 d -26 3 d 4 -5 d f 0.575 0.575 0.575 c 1260 1140 m
- 1 5 d -28 3 d -1 -2 d 2 -3 d f 0.6 0.6 0.6 c 1261 1145 m 2 4 d -27 4 d -3 -5 d
- f 0.625 0.625 0.625 c 1263 1149 m 1 4 d -26 5 d -2 -5 d f 0.65 0.65 0.65 c 1264
- 1153 m 2 5 d -25 5 d -3 -5 d f 0.675 0.675 0.675 c 1266 1158 m 1 4 d -24 6 d -2
- -5 d f 0.7 0.7 0.7 c 1267 1162 m 1 5 d -22 6 d -3 -5 d f 0.725 0.725 0.725 c
- 1268 1167 m 2 4 d -21 7 d -3 -5 d f 0.75 0.75 0.75 c 1270 1171 m 1 5 d -20 7 d
- -2 -5 d f 0.775 0.775 0.775 c 1271 1176 m 2 4 d -19 9 d -3 -6 d f 0.8 0.8 0.8 c
- 1273 1180 m 1 5 d -14 6 d -5 1 d -1 -3 d f 0.825 0.825 0.825 c 1274 1185 m 2 4
- d -2 1 d -14 1 d f 0.85 0.85 0.85 c 1276 1189 m 1 Y -2 X f 0.425 0.425 0.425 c
- 1252 1115 m 2 Y -1 1 d f 0.45 0.45 0.45 c 1250 1111 m 2 4 d -1 3 d -3 5 d f
- 0.475 0.475 0.475 c 1249 1106 m 1 5 d -2 12 d -4 5 d f 0.5 0.5 0.5 c 1247 1101
- m 2 5 d -5 22 d -3 5 d f 0.525 0.525 0.525 c 1246 1097 m 1 4 d -6 32 d -3 5 d f
- 0.55 0.55 0.55 c 1244 1092 m 2 5 d -8 41 d -4 5 d f 0.575 0.575 0.575 c 1243
- 1087 m 1 5 d -10 51 d -2 3 d -3 -3 d f 0.6 0.6 0.6 c 1241 1083 m 2 4 d -14 56 d
- -7 -5 d f 0.625 0.625 0.625 c 1240 1078 m 1 5 d -19 55 d -7 -6 d f 0.65 0.65
- 0.65 c 1238 1074 m 2 4 d -25 54 d -6 -6 d f 0.675 0.675 0.675 c 1237 1069 m 1 5
- d -29 52 d 3 -13 d f 0.7 0.7 0.7 c 1236 1064 m 1 5 d -25 44 d 3 -12 d f 0.725
- 0.725 0.725 c 1234 1060 m 2 4 d -21 37 d 3 -13 d f 0.75 0.75 0.75 c 1233 1055 m
- 1 5 d -16 28 d 3 -13 d f 0.775 0.775 0.775 c 1231 1050 m 2 5 d -12 20 d 3 -13 d
- f 0.8 0.8 0.8 c 1230 1046 m 1 4 d -7 12 d 3 -13 d f 0.825 0.825 0.825 c 1229
- 1043 m 1 3 d -3 3 d f 0.625 0.625 0.625 c 1205 1037 m 2 1 d -3 6 d f 0.65 0.65
- 0.65 c 1207 1038 m 3 1 d -1 87 d -1 X -8 -65 d 4 -17 d f 0.675 0.675 0.675 c
- 1210 1039 m 3 X -1 74 d -3 13 d -1 X -5 2 d -6 -51 d 3 -16 d f 0.7 0.7 0.7 c
- 1213 1039 m 3 1 d -1 61 d -3 12 d -9 15 d -5 2 d -5 -36 d 4 -17 d f 0.725 0.725
- 0.725 c 1216 1040 m 3 1 d -1 47 d -3 13 d -17 29 d -6 1 d -2 -21 d 3 -16 d f
- 0.75 0.75 0.75 c 1219 1041 m 2 1 d 33 Y -3 13 d -26 43 d -5 2 d -1 -6 d 4 -17 d
- f 0.775 0.775 0.775 c 1221 1042 m 3 X 20 Y -3 13 d -34 58 d -2 1 d 1 -7 d f 0.8
- 0.8 0.8 c 1224 1042 m 3 1 d 6 Y -3 13 d f 0.825 0.825 0.825 c 1227 1043 m 2 X
- -2 6 d f 0.625 0.625 0.625 c 1200 1051 m 5 -14 d -1 7 d f 0.65 0.65 0.65 c 1188
- 1083 m 12 -32 d 4 -7 d -4 17 d -35 56 d -3 -3 d 11 -9 d f 0.675 0.675 0.675 c
- 1182 1099 m 6 -16 d 12 -22 d -3 16 d -28 44 d -4 -4 d 8 -12 d f 0.7 0.7 0.7 c
- 1197 1077 m -4 17 d -19 30 d -5 -3 d f 0.725 0.725 0.725 c 1193 1094 m -3 16 d
- -11 18 d -5 -4 d f 0.75 0.75 0.75 c 1190 1110 m -4 17 d -3 5 d -4 -4 d f 0.775
- 0.775 0.775 c 1186 1127 m -1 7 d -2 -2 d f 0.65 0.65 0.65 c 1173 1105 m -11 9 d
- -2 8 d f 0.675 0.675 0.675 c 1178 1098 m 4 1 d -9 6 d -13 17 d -3 11 d f 0.7
- 0.7 0.7 c 1171 1096 m 7 2 d -21 35 d -3 12 d f 0.725 0.725 0.725 c 1163 1094 m
- 8 2 d -17 49 d -2 12 d f 0.75 0.75 0.75 c 1158 1093 m 5 1 d -11 63 d -3 11 d 8
- -66 d f 0.775 0.775 0.775 c 1149 1168 m -3 12 d 6 -50 d 5 -28 d f 0.8 0.8 0.8 c
- 1146 1180 m -2 12 d 4 -34 d 4 -28 d f 0.825 0.825 0.825 c 1144 1192 m -3 11 d 2
- -17 d 5 -28 d f 0.85 0.85 0.85 c 1141 1203 m -3 12 d -1 Y 5 -28 d f 0.875 0.875
- 0.875 c 1138 1215 m 1 Y -2 Y f 0.575 0.575 0.575 c 1116 1147 m -1 -4 d 3 -7 d f
- 0.6 0.6 0.6 c 1118 1153 m -2 -6 d 2 -11 d 4 -9 d f 0.625 0.625 0.625 c 1120
- 1159 m -2 -6 d 4 -26 d 4 -8 d f 0.65 0.65 0.65 c 1122 1166 m -2 -7 d 6 -40 d 4
- -9 d f 0.675 0.675 0.675 c 1124 1172 m -2 -6 d 8 -56 d 5 -9 d f 0.7 0.7 0.7 c
- 1135 1100 m 8 -3 d -17 81 d -2 -6 d 11 -71 d f 0.725 0.725 0.725 c 1143 1097 m
- 9 -2 d -24 89 d -2 -6 d f 0.75 0.75 0.75 c 1152 1095 m 6 -2 d -1 9 d -27 88 d
- -2 -6 d f 0.775 0.775 0.775 c 1157 1102 m -5 28 d -20 67 d -2 -7 d f 0.8 0.8
- 0.8 c 1152 1130 m -4 28 d -14 45 d -2 -6 d f 0.825 0.825 0.825 c 1148 1158 m -5
- 28 d -7 23 d -2 -6 d f 0.85 0.85 0.85 c 1143 1186 m -5 28 d 1 Y -2 -6 d f 0.875
- 0.875 0.875 c 1138 1214 m 2 Y -1 Y f 0.575 0.575 0.575 c 1118 1136 m -3 7 d -2
- -6 d f 0.6 0.6 0.6 c 1122 1127 m -4 9 d -5 1 d -2 -9 d f 0.625 0.625 0.625 c
- 1126 1119 m -4 8 d -11 1 d -3 -8 d f 0.65 0.65 0.65 c 1130 1110 m -4 9 d -18 1
- d -2 -9 d f 0.675 0.675 0.675 c 1135 1101 m -5 9 d -24 1 d -2 -8 d f 0.7 0.7
- 0.7 c 1132 1095 m 3 5 d 1 Y -31 2 d -3 -9 d f 0.725 0.725 0.725 c 1129 1089 m 3
- 6 d -31 -1 d -2 -8 d f 0.75 0.75 0.75 c 1127 1084 m 2 5 d -30 -3 d -2 -9 d f
- 0.775 0.775 0.775 c 1124 1078 m 3 6 d -30 -7 d -2 -8 d f 0.8 0.8 0.8 c 1121
- 1073 m 3 5 d -29 -9 d -3 -9 d f 0.825 0.825 0.825 c 1118 1067 m 3 6 d -29 -13 d
- -1 -4 d 3 X f 0.85 0.85 0.85 c 1115 1062 m 3 5 d -24 -11 d 7 -1 d f 0.875 0.875
- 0.875 c 1113 1056 m 2 6 d -14 -7 d 7 -1 d f 0.9 0.9 0.9 c 1111 1054 m 2 2 d -5
- -2 d f 0.65 0.65 0.65 c 1088 1048 m 2 X -9 10 d f 0.675 0.675 0.675 c 1090 1048
- m 2 1 d -19 20 d 8 -11 d f 0.7 0.7 0.7 c 1092 1049 m 3 1 d -26 26 d -1 1 d 5 -8
- d f 0.725 0.725 0.725 c 1095 1050 m 2 X -23 21 d -5 5 d f 0.75 0.75 0.75 c 1097
- 1050 m 2 1 d -20 16 d -5 4 d f 0.775 0.775 0.775 c 1099 1051 m 2 X -17 12 d -5
- 4 d f 0.8 0.8 0.8 c 1101 1051 m 3 1 d -16 6 d -4 5 d f 0.825 0.825 0.825 c 1104
- 1052 m 2 X -12 4 d -3 X -3 2 d f 0.85 0.85 0.85 c 1106 1052 m 2 1 d -7 2 d -7 1
- d f 0.875 0.875 0.875 c 1108 1053 m 2 1 d -2 X -7 1 d f 0.9 0.9 0.9 c 1110 1054
- m 1 X -3 X f 0.65 0.65 0.65 c 1085 1053 m 3 -5 d -7 10 d f 0.675 0.675 0.675 c
- 1082 1059 m 3 -6 d -4 5 d -8 11 d f 0.7 0.7 0.7 c 1080 1065 m 2 -6 d -9 10 d -5
- 8 d -24 61 d 3 -5 d f 0.725 0.725 0.725 c 1077 1071 m 3 -6 d -33 68 d 3 -7 d f
- 0.75 0.75 0.75 c 1074 1076 m 3 -5 d -27 55 d 3 -7 d f 0.775 0.775 0.775 c 1071
- 1082 m 3 -6 d -21 43 d 4 -7 d f 0.8 0.8 0.8 c 1068 1088 m 3 -6 d -14 30 d 3 -7
- d f 0.825 0.825 0.825 c 1065 1094 m 3 -6 d -8 17 d 3 -7 d f 0.85 0.85 0.85 c
- 1064 1096 m 1 -2 d -2 4 d f 0.7 0.7 0.7 c 1047 1133 m -3 5 d -3 -9 d f 0.725
- 0.725 0.725 c 1050 1126 m -3 7 d -6 -4 d -4 -12 d f 0.75 0.75 0.75 c 1053 1119
- m -3 7 d -13 -9 d -4 -13 d f 0.775 0.775 0.775 c 1057 1112 m -4 7 d -20 -15 d
- -4 -12 d f 0.8 0.8 0.8 c 1060 1105 m -3 7 d -28 -20 d -4 -13 d f 0.825 0.825
- 0.825 c 1063 1098 m -3 7 d -35 -26 d -4 -12 d f 0.85 0.85 0.85 c 1041 1049 m 23
- 47 d -1 2 d -42 -31 d -2 Y f 0.75 0.75 0.75 c 1017 1097 m 5 -9 d -9 10 d f
- 0.775 0.775 0.775 c 1022 1088 m 5 -10 d -19 20 d 5 X f 0.8 0.8 0.8 c 1027 1078
- m 5 -10 d -29 31 d 5 -1 d f 0.825 0.825 0.825 c 1032 1068 m 5 -11 d -39 42 d 5
- X f 0.85 0.85 0.85 c 1037 1057 m 4 -8 d -20 16 d -24 34 d 1 X f 0.75 0.75 0.75
- c 1002 1033 m 15 64 d -4 1 d f 0.775 0.775 0.775 c 994 997 m 8 36 d 11 65 d -5
- X -21 -64 d f 0.8 0.8 0.8 c 1008 1098 m -5 1 d -29 5 d 13 -70 d f 0.825 0.825
- 0.825 c 1003 1099 m -5 X -5 2 d -19 6 d -3 Y f 0.85 0.85 0.85 c 998 1099 m -1 X
- -4 2 d f 0.75 0.75 0.75 c 970 991 m 3 1 d -4 7 d f 0.775 0.775 0.775 c 973 992
- m 21 5 d -7 37 d -33 88 d 15 -123 d f 0.8 0.8 0.8 c 987 1034 m -13 70 d -2 5 d
- -22 45 d 4 -32 d f 0.825 0.825 0.825 c 974 1104 m 3 Y -2 2 d f 0.75 0.75 0.75 c
- 970 992 m -1 Y -1 8 d f 0.775 0.775 0.775 c 964 1011 m 6 -19 d -1 7 d -15 123 d
- -19 -52 d -8 -42 d 1 1 d f 0.8 0.8 0.8 c 959 1029 m 5 -18 d -10 111 d -4 32 d
- -15 -84 d -7 -41 d 6 12 d f 0.825 0.825 0.825 c 953 1047 m 6 -18 d -25 12 d 6
- 12 d f 0.85 0.85 0.85 c 947 1065 m 6 -18 d -13 6 d 7 13 d f 0.875 0.875 0.875 c
- 947 1066 m -1 Y 1 Y f 0.775 0.775 0.775 c 928 1029 m -1 -1 d -24 114 d 12 -103
- d f 0.8 0.8 0.8 c 923 966 m 6 22 d 5 53 d -6 -12 d -13 10 d f 0.825 0.825 0.825
- c 929 988 m 9 39 d 2 26 d -6 -12 d f 0.85 0.85 0.85 c 938 1027 m 9 38 d 1 Y -7
- -13 d f 0.875 0.875 0.875 c 947 1065 m 1 Y f 0.725 0.725 0.725 c 880 1071 m -3
- Y f 0.75 0.75 0.75 c 897 1122 m -17 -51 d -3 Y 11 -37 d f 0.775 0.775 0.775 c
- 900 1000 m 7 -10 d 8 49 d -12 103 d -6 -20 d -6 -91 d f 0.8 0.8 0.8 c 907 990 m
- 16 -24 d -8 73 d f 0.65 0.65 0.65 c 859 1111 m -3 6 d 2 -12 d f 0.675 0.675
- 0.675 c 866 1097 m -7 14 d -1 -6 d 5 -31 d f 0.7 0.7 0.7 c 873 1083 m -7 14 d
- -3 -23 d 4 -31 d f 0.725 0.725 0.725 c 880 1068 m 1 Y -7 14 d -6 -40 d 5 -30 d
- f 0.75 0.75 0.75 c 891 1031 m -11 37 d -8 -55 d 4 -31 d f 0.775 0.775 0.775 c
- 877 981 m 23 19 d -9 31 d -15 -49 d f 0.65 0.65 0.65 c 858 1105 m -2 12 d -2 -7
- d f 0.675 0.675 0.675 c 863 1074 m -5 31 d -4 5 d -4 -19 d f 0.7 0.7 0.7 c 867
- 1043 m -4 31 d -13 17 d -4 -18 d f 0.725 0.725 0.725 c 872 1013 m -5 30 d -21
- 30 d -5 -19 d f 0.75 0.75 0.75 c 853 948 m 21 29 d 2 5 d -4 31 d -31 41 d -4
- -18 d 11 -71 d f 0.775 0.775 0.775 c 874 977 m 3 4 d -1 1 d -39 54 d -4 -19 d
- -1 Y 15 -51 d f 0.8 0.8 0.8 c 833 1017 m -1 Y f 0.6 0.6 0.6 c 812 1059 m -3 6 d
- 2 -15 d f 0.625 0.625 0.625 c 815 1053 m -3 6 d -1 -9 d 2 -17 d f 0.65 0.65
- 0.65 c 818 1047 m -3 6 d -2 -20 d 2 -16 d f 0.675 0.675 0.675 c 821 1041 m -3 6
- d -3 -30 d 2 -16 d f 0.7 0.7 0.7 c 824 1035 m -3 6 d -4 -40 d 1 -16 d f 0.725
- 0.725 0.725 c 827 1029 m -3 6 d -6 -50 d 2 -17 d f 0.75 0.75 0.75 c 851 943 m 2
- 5 d -5 17 d -18 58 d -3 6 d -7 -61 d 2 -16 d f 0.775 0.775 0.775 c 846 929 m 5
- 14 d -3 22 d -15 51 d 1 Y -3 6 d -8 -71 d 2 -16 d f 0.8 0.8 0.8 c 840 915 m 6
- 14 d -13 87 d 1 Y -9 -81 d 2 -16 d f 0.825 0.825 0.825 c 835 901 m 5 14 d -14 5
- d 2 -17 d f 0.85 0.85 0.85 c 830 888 m 5 13 d -7 2 d f 0.6 0.6 0.6 c 811 1050 m
- -2 15 d -6 16 d f 0.625 0.625 0.625 c 813 1033 m -2 17 d -8 31 d -7 17 d f 0.65
- 0.65 0.65 c 815 1017 m -2 16 d -17 65 d -6 18 d f 0.675 0.675 0.675 c 817 1001
- m -2 16 d -25 99 d -4 10 d 1 -10 d f 0.7 0.7 0.7 c 818 985 m -1 16 d -30 115 d
- 3 -22 d f 0.725 0.725 0.725 c 820 968 m -2 17 d -28 109 d 3 -23 d f 0.75 0.75
- 0.75 c 822 952 m -2 16 d -27 103 d 2 -23 d f 0.775 0.775 0.775 c 824 936 m -2
- 16 d -27 96 d 3 -23 d f 0.8 0.8 0.8 c 826 920 m -2 16 d -26 89 d 3 -23 d f
- 0.825 0.825 0.825 c 828 903 m -2 17 d -25 82 d 3 -23 d f 0.85 0.85 0.85 c 806
- 963 m 24 -75 d -2 15 d -24 76 d f 0.575 0.575 0.575 c 783 836 m 1 7 d -18 56 d
- -4 -48 d f 0.6 0.6 0.6 c 784 843 m 2 12 d -14 107 d -6 -63 d f 0.625 0.625
- 0.625 c 786 855 m 2 11 d -11 160 d -5 -64 d f 0.65 0.65 0.65 c 788 866 m 2 11 d
- -7 212 d -6 -63 d f 0.675 0.675 0.675 c 790 877 m 2 11 d -5 228 d -1 10 d -3
- -37 d f 0.7 0.7 0.7 c 792 888 m 2 11 d -4 195 d -3 22 d f 0.725 0.725 0.725 c
- 794 899 m 2 11 d -3 161 d -3 23 d f 0.75 0.75 0.75 c 796 910 m 2 11 d -3 127 d
- -2 23 d f 0.775 0.775 0.775 c 798 921 m 2 12 d -2 92 d -3 23 d f 0.8 0.8 0.8 c
- 800 933 m 3 11 d -2 58 d -3 23 d f 0.825 0.825 0.825 c 803 944 m 2 11 d -1 24 d
- -3 23 d f 0.85 0.85 0.85 c 805 955 m 1 8 d -2 16 d f 0.55 0.55 0.55 c 759 830 m
- 1 X -20 16 d -1 -1 d f 0.575 0.575 0.575 c 760 830 m 23 6 d -21 15 d -22 -5 d f
- 0.55 0.55 0.55 c 736 824 m 23 6 d -20 15 d -24 -6 d f 712 818 m 24 6 d -21 15 d
- -23 -6 d f 1813 1077 m 23 6 d -20 16 d -23 -6 d f 1789 1071 m 24 6 d -20 16 d
- -24 -6 d f 1766 1065 m 23 6 d -20 16 d -3 -1 d -3 -18 d f 0.575 0.575 0.575 c
- 1766 1086 m -20 -5 d 17 -13 d f 0.55 0.55 0.55 c 1766 1066 m -1 Y -3 3 d f
- 0.575 0.575 0.575 c 1750 1089 m 16 -23 d -3 2 d -17 13 d -3 18 d f 0.6 0.6 0.6
- c 1742 1100 m 8 -11 d -7 10 d -4 19 d 2 -7 d f 0.625 0.625 0.625 c 1739 1118 m
- -3 20 d 1 -6 d 4 -21 d f 0.65 0.65 0.65 c 1736 1138 m -3 19 d 1 -4 d 3 -21 d f
- 0.675 0.675 0.675 c 1733 1157 m -3 20 d -3 Y 4 -21 d f 0.7 0.7 0.7 c 1730 1177
- m -3 19 d -2 Y 3 -20 d f 0.725 0.725 0.725 c 1727 1196 m -4 20 d -1 Y 4 -21 d f
- 0.75 0.75 0.75 c 1723 1216 m -1 7 d 1 -8 d f 0.6 0.6 0.6 c 1719 1107 m 23 -7 d
- -1 11 d -22 -2 d f 0.625 0.625 0.625 c 1741 1111 m -4 21 d -21 -12 d 3 -11 d f
- 0.65 0.65 0.65 c 1737 1132 m -3 21 d -21 -23 d 3 -10 d f 0.675 0.675 0.675 c
- 1734 1153 m -4 21 d -19 -33 d 2 -11 d f 0.7 0.7 0.7 c 1730 1174 m -3 20 d -19
- -42 d 3 -11 d f 0.725 0.725 0.725 c 1727 1194 m -4 21 d -18 -52 d 3 -11 d f
- 0.75 0.75 0.75 c 1723 1215 m -1 8 d -7 -10 d -13 -39 d 3 -11 d f 0.775 0.775
- 0.775 c 1715 1213 m -11 -16 d -4 -12 d 2 -11 d f 0.8 0.8 0.8 c 1704 1197 m -5
- -7 d 1 -5 d f 0.6 0.6 0.6 c 1719 1108 m -1 Y 2 Y f 0.625 0.625 0.625 c 1717
- 1118 m 2 -10 d 1 Y -3 11 d f 0.65 0.65 0.65 c 1715 1129 m 2 -11 d -1 2 d -3 10
- d f 0.675 0.675 0.675 c 1713 1139 m 2 -10 d -2 1 d -2 11 d f 0.7 0.7 0.7 c 1711
- 1149 m 2 -10 d -2 2 d -3 11 d f 0.725 0.725 0.725 c 1708 1159 m 3 -10 d -3 3 d
- -3 11 d f 0.75 0.75 0.75 c 1706 1169 m 2 -10 d -3 4 d -3 11 d f 0.775 0.775
- 0.775 c 1704 1179 m 2 -10 d -4 5 d -2 11 d f 0.8 0.8 0.8 c 1702 1189 m 2 -10 d
- -4 6 d -1 5 d -13 -11 d f 0.825 0.825 0.825 c 1700 1199 m 2 -10 d -16 -10 d -11
- -9 d 4 10 d f 0.85 0.85 0.85 c 1698 1209 m 2 -10 d -21 -19 d 7 18 d f 0.875
- 0.875 0.875 c 1696 1219 m 2 -10 d -12 -11 d 7 18 d f 0.9 0.9 0.9 c 1695 1222 m
- 1 -3 d -3 -3 d f 0.775 0.775 0.775 c 1672 1082 m 1 9 d -15 75 d -6 -1 d f 0.8
- 0.8 0.8 c 1673 1091 m 6 30 d -10 48 d -11 -3 d f 0.825 0.825 0.825 c 1679 1121
- m 5 30 d -5 29 d -4 -10 d -6 -1 d f 0.85 0.85 0.85 c 1684 1151 m 5 30 d -3 17 d
- -7 -18 d f 0.875 0.875 0.875 c 1689 1181 m 5 30 d -1 5 d -7 -18 d f 0.9 0.9 0.9
- c 1694 1211 m 1 11 d -2 -6 d f 0.575 0.575 0.575 c 1628 1212 m f 0.6 0.6 0.6 c
- 1631 1206 m -3 6 d 17 -110 d f 0.625 0.625 0.625 c 1648 1076 m 3 1 d -17 122 d
- -3 7 d 14 -104 d f 0.65 0.65 0.65 c 1651 1077 m 4 X -17 116 d -4 6 d f 0.675
- 0.675 0.675 c 1655 1077 m 4 1 d -18 109 d -3 6 d f 0.7 0.7 0.7 c 1659 1078 m 3
- 1 d -18 101 d -3 7 d f 0.725 0.725 0.725 c 1662 1079 m 4 1 d -19 94 d -3 6 d f
- 0.75 0.75 0.75 c 1666 1080 m 3 1 d -19 87 d -3 6 d f 0.775 0.775 0.775 c 1669
- 1081 m 3 1 d -20 83 d -2 3 d f 0.575 0.575 0.575 c 1628 1212 m f 0.6 0.6 0.6 c
- 1645 1102 m -17 110 d -5 8 d f 0.625 0.625 0.625 c 1647 1077 m 1 -1 d -3 26 d
- -22 118 d -5 7 d f 0.65 0.65 0.65 c 1645 1079 m 2 -2 d -29 150 d -5 7 d f 0.675
- 0.675 0.675 c 1643 1081 m 2 -2 d -32 155 d -5 7 d f 0.7 0.7 0.7 c 1641 1083 m 2
- -2 d -35 160 d -3 6 d -5 Y f 0.725 0.725 0.725 c 1638 1085 m 3 -2 d -36 159 d 3
- -20 d f 0.75 0.75 0.75 c 1636 1087 m 2 -2 d -30 137 d 3 -20 d f 0.775 0.775
- 0.775 c 1634 1089 m 2 -2 d -25 115 d 2 -20 d f 0.8 0.8 0.8 c 1632 1090 m 2 -1 d
- -21 93 d 3 -20 d f 0.825 0.825 0.825 c 1630 1092 m 2 -2 d -16 72 d 3 -19 d f
- 0.85 0.85 0.85 c 1628 1094 m 2 -2 d -11 51 d 2 -20 d f 0.875 0.875 0.875 c 1626
- 1096 m 2 -2 d -7 29 d 3 -20 d f 0.9 0.9 0.9 c 1625 1097 m 1 -1 d -2 7 d f 0.7
- 0.7 0.7 c 1605 1242 m 5 Y -24 -114 d 2 -2 d f 0.725 0.725 0.725 c 1608 1222 m
- -3 20 d -22 -111 d 3 -4 d f 0.75 0.75 0.75 c 1611 1202 m -3 20 d -22 -95 d 2 -4
- d f 0.775 0.775 0.775 c 1613 1182 m -2 20 d -23 -79 d 3 -3 d f 0.8 0.8 0.8 c
- 1616 1162 m -3 20 d -22 -62 d 2 -4 d f 0.825 0.825 0.825 c 1619 1143 m -3 19 d
- -23 -46 d 3 -3 d f 0.85 0.85 0.85 c 1621 1123 m -2 20 d -23 -30 d 2 -4 d f
- 0.875 0.875 0.875 c 1624 1103 m -3 20 d -23 -14 d 3 -3 d f 0.9 0.9 0.9 c 1602
- 1104 m 23 -7 d -1 6 d -23 3 d f 0.7 0.7 0.7 c 1583 1131 m -2 2 d -6 14 d f
- 0.725 0.725 0.725 c 1578 1058 m 8 69 d -3 4 d -8 16 d -10 18 d 12 -103 d f 0.75
- 0.75 0.75 c 1578 1058 m 4 7 d 6 58 d -2 4 d -21 38 d -7 16 d 19 -119 d f 0.775
- 0.775 0.775 c 1582 1065 m 3 7 d 6 48 d -3 3 d f 0.8 0.8 0.8 c 1585 1072 m 4 8 d
- 4 36 d -2 4 d f 0.825 0.825 0.825 c 1589 1080 m 4 7 d 3 26 d -3 3 d f 0.85 0.85
- 0.85 c 1593 1087 m 3 7 d 2 15 d -2 4 d f 0.875 0.875 0.875 c 1596 1094 m 4 7 d
- 1 5 d -3 3 d f 0.9 0.9 0.9 c 1600 1101 m 2 3 d -1 2 d f 0.725 0.725 0.725 c
- 1578 1058 m -1 4 d f 0.75 0.75 0.75 c 1574 1064 m 4 -6 d -1 4 d -19 119 d -3 -3
- d f 0.775 0.775 0.775 c 1569 1070 m 5 -6 d -19 114 d -21 -17 d 1 -1 d f 0.8 0.8
- 0.8 c 1565 1077 m 4 -7 d -34 90 d 5 -19 d f 0.825 0.825 0.825 c 1561 1083 m 4
- -6 d -25 64 d 6 -19 d f 0.85 0.85 0.85 c 1557 1089 m 4 -6 d -15 39 d 6 -19 d f
- 0.875 0.875 0.875 c 1555 1092 m 2 -3 d -5 14 d f 0.775 0.775 0.775 c 1531 1100
- m 4 -2 d 62 Y -1 1 d -1 -1 d -9 -50 d f 0.8 0.8 0.8 c 1535 1098 m 6 -1 d -1 44
- d -5 19 d -2 X -16 -23 d -3 -13 d 10 -14 d f 0.825 0.825 0.825 c 1541 1097 m 5
- -2 d 27 Y -6 19 d -23 -4 d -6 -8 d 3 -5 d f 0.85 0.85 0.85 c 1546 1095 m 6 -2 d
- 10 Y -6 19 d f 0.875 0.875 0.875 c 1552 1093 m 3 -1 d -3 11 d f 0.775 0.775
- 0.775 c 1508 1026 m 23 74 d -7 10 d -29 24 d -8 2 d f 0.8 0.8 0.8 c 1524 1110 m
- -10 14 d -7 6 d -12 4 d f 0.825 0.825 0.825 c 1514 1124 m -3 5 d -4 1 d f 0.75
- 0.75 0.75 c 1484 1007 m 10 8 d -27 139 d -3 3 d f 0.775 0.775 0.775 c 1494 1015
- m 14 11 d -21 110 d -20 18 d f 0.675 0.675 0.675 c 1461 1082 m 2 -9 d -3 8 d f
- 0.7 0.7 0.7 c 1463 1073 m 9 -27 d -16 31 d 4 4 d f 0.725 0.725 0.725 c 1472
- 1046 m 9 -28 d -28 55 d 3 4 d f 0.75 0.75 0.75 c 1481 1018 m 3 -11 d -20 150 d
- -1 -1 d -13 -87 d 3 4 d f 0.775 0.775 0.775 c 1463 1156 m -7 -33 d -9 -58 d 3 4
- d f 0.8 0.8 0.8 c 1456 1123 m -8 -33 d -4 -29 d 3 4 d f 0.825 0.825 0.825 c
- 1448 1090 m -8 -33 d 4 4 d f 0.85 0.85 0.85 c 1440 1057 m f 0.625 0.625 0.625 c
- 1437 1049 m 8 10 d -12 -5 d f 0.65 0.65 0.65 c 1445 1059 m 9 13 d -25 -11 d 4
- -7 d f 0.675 0.675 0.675 c 1454 1072 m 7 10 d -1 -1 d -36 -13 d 5 -7 d f 0.7
- 0.7 0.7 c 1460 1081 m -4 -4 d -37 -2 d 5 -7 d f 0.725 0.725 0.725 c 1456 1077 m
- -3 -4 d -33 2 d -3 3 d 2 -3 d f 0.75 0.75 0.75 c 1453 1073 m -3 -4 d -25 2 d -5
- 4 d f 0.775 0.775 0.775 c 1450 1069 m -3 -4 d -17 1 d -5 5 d f 0.8 0.8 0.8 c
- 1447 1065 m -3 -4 d -9 1 d -5 4 d f 0.825 0.825 0.825 c 1444 1061 m -4 -4 d -5
- 5 d f 0.85 0.85 0.85 c 1440 1057 m f 0.625 0.625 0.625 c 1435 1052 m 2 -3 d -4
- 5 d f 0.65 0.65 0.65 c 1433 1057 m 2 -5 d -2 2 d -4 7 d f 0.675 0.675 0.675 c
- 1431 1061 m 2 -4 d -4 4 d -5 7 d f 0.7 0.7 0.7 c 1429 1065 m 2 -4 d -7 7 d -5 7
- d f 0.725 0.725 0.725 c 1427 1069 m 2 -4 d -10 10 d -2 3 d -4 3 d f 0.75 0.75
- 0.75 c 1425 1074 m 2 -5 d -14 12 d -6 5 d f 0.775 0.775 0.775 c 1423 1078 m 2
- -4 d -18 12 d -6 6 d f 0.8 0.8 0.8 c 1421 1082 m 2 -4 d -22 14 d -6 5 d f 0.825
- 0.825 0.825 c 1418 1087 m 3 -5 d -26 15 d -2 2 d 5 -1 d f 0.85 0.85 0.85 c 1416
- 1091 m 2 -4 d -20 11 d 7 X f 0.875 0.875 0.875 c 1414 1095 m 2 -4 d -11 7 d 7
- -1 d f 0.9 0.9 0.9 c 1414 1097 m -2 Y -2 2 d f 0.75 0.75 0.75 c 1390 1010 m 1 2
- d -3 1 d f 0.775 0.775 0.775 c 1391 1012 m 4 16 d -24 9 d 17 -24 d f 0.8 0.8
- 0.8 c 1395 1028 m 4 16 d -11 41 d -18 -46 d 1 -2 d f 0.825 0.825 0.825 c 1399
- 1044 m 5 16 d -6 38 d -5 1 d -5 -14 d f 0.85 0.85 0.85 c 1404 1060 m 4 16 d -3
- 22 d -7 X f 0.875 0.875 0.875 c 1408 1076 m 4 16 d 5 Y -7 1 d f 0.9 0.9 0.9 c
- 1412 1092 m 2 5 d -2 X f 0.725 0.725 0.725 c 1349 1070 m -3 3 d 1 -2 d f 0.75
- 0.75 0.75 c 1389 1010 m 1 X -2 3 d -29 42 d -10 15 d -2 1 d 4 -13 d f 0.775
- 0.775 0.775 c 1384 1008 m 5 2 d -1 3 d -17 24 d -2 3 d -10 15 d -8 3 d 4 -13 d
- f 0.8 0.8 0.8 c 1379 1007 m 5 1 d -13 29 d -1 2 d -1 1 d -14 5 d 3 -12 d f
- 0.825 0.825 0.825 c 1373 1006 m 6 1 d -21 26 d 4 -13 d f 0.85 0.85 0.85 c 1368
- 1004 m 5 2 d -11 14 d 4 -13 d f 0.875 0.875 0.875 c 1367 1004 m 1 X -2 3 d f
- 0.7 0.7 0.7 c 1343 1025 m 3 -2 d -13 23 d f 0.725 0.725 0.725 c 1346 1023 m 3
- -3 d -2 51 d -1 2 d -23 -6 d 10 -21 d f 0.75 0.75 0.75 c 1349 1020 m 3 -3 d -1
- 41 d -4 13 d f 0.775 0.775 0.775 c 1352 1017 m 4 -3 d -1 31 d -4 13 d f 0.8 0.8
- 0.8 c 1356 1014 m 3 -3 d -1 22 d -3 12 d f 0.825 0.825 0.825 c 1359 1011 m 3 -3
- d 12 Y -4 13 d f 0.85 0.85 0.85 c 1362 1008 m 4 -3 d 2 Y -4 13 d f 0.875 0.875
- 0.875 c 1366 1005 m 1 -1 d -1 3 d f 0.6 0.6 0.6 c 1300 1101 m -1 1 d 1 -2 d f
- 0.625 0.625 0.625 c 1305 1094 m -5 7 d -1 Y 7 -14 d f 0.65 0.65 0.65 c 1310
- 1087 m -5 7 d 2 -8 d 6 -14 d f 0.675 0.675 0.675 c 1320 1059 m 6 -8 d -12 29 d
- -4 7 d 3 -15 d f 0.7 0.7 0.7 c 1326 1051 m 17 -26 d -10 21 d -14 26 d -5 8 d f
- 0.725 0.725 0.725 c 1333 1046 m -10 21 d -4 5 d f 0.6 0.6 0.6 c 1300 1100 m -1
- 2 d 1 Y f 0.625 0.625 0.625 c 1307 1086 m -7 14 d -1 3 d -2 9 d f 0.65 0.65
- 0.65 c 1313 1072 m -6 14 d -10 26 d -3 10 d f 0.675 0.675 0.675 c 1319 1059 m 1
- X -7 13 d -19 50 d -3 9 d f 0.7 0.7 0.7 c 1316 1056 m 3 3 d -28 72 d -2 10 d f
- 0.725 0.725 0.725 c 1312 1053 m 4 3 d -27 85 d -3 9 d f 0.75 0.75 0.75 c 1308
- 1050 m 4 3 d -26 97 d -2 10 d f 0.775 0.775 0.775 c 1305 1047 m 3 3 d -24 110 d
- -3 9 d f 0.8 0.8 0.8 c 1301 1044 m 4 3 d -24 122 d -2 10 d f 0.825 0.825 0.825
- c 1298 1041 m 3 3 d -22 135 d -3 10 d f 0.85 0.85 0.85 c 1296 1040 m 2 1 d -22
- 148 d 1 Y f 0.425 0.425 0.425 c 1253 1118 m -1 -1 d 1 -2 d f 0.45 0.45 0.45 c
- 1254 1122 m -1 -4 d -3 Y 2 -6 d f 0.475 0.475 0.475 c 1256 1127 m -2 -5 d 1 -13
- d 1 -6 d f 0.5 0.5 0.5 c 1257 1131 m -1 -4 d -24 Y 2 -6 d f 0.525 0.525 0.525 c
- 1258 1136 m -1 -5 d 1 -34 d 2 -6 d f 0.55 0.55 0.55 c 1260 1140 m -2 -4 d 2 -45
- d 2 -6 d f 0.575 0.575 0.575 c 1261 1145 m -1 -5 d 2 -55 d 1 -6 d f 0.6 0.6 0.6
- c 1263 1149 m -2 -4 d 2 -66 d 2 -6 d f 0.625 0.625 0.625 c 1264 1153 m -1 -4 d
- 2 -76 d 2 -6 d f 0.65 0.65 0.65 c 1266 1158 m -2 -5 d 3 -86 d 2 -6 d f 0.675
- 0.675 0.675 c 1267 1162 m -1 -4 d 3 -97 d 1 -6 d f 0.7 0.7 0.7 c 1268 1167 m -1
- -5 d 3 -107 d 2 -6 d f 0.725 0.725 0.725 c 1273 1047 m 3 -1 d -6 125 d -2 -4 d
- 4 -118 d f 0.75 0.75 0.75 c 1276 1046 m 5 -1 d -10 131 d -1 -5 d f 0.775 0.775
- 0.775 c 1281 1045 m 4 -2 d -12 137 d -2 -4 d f 0.8 0.8 0.8 c 1285 1043 m 5 -1 d
- -16 143 d -1 -5 d f 0.825 0.825 0.825 c 1290 1042 m 4 -2 d -18 149 d -2 -4 d f
- 0.85 0.85 0.85 c 1294 1040 m 2 X -20 150 d -1 Y f 0.425 0.425 0.425 c 1253 1115
- m -1 2 d -2 Y f 0.45 0.45 0.45 c 1255 1109 m -2 6 d -1 X -2 -4 d f 0.475 0.475
- 0.475 c 1256 1103 m -1 6 d -5 2 d -1 -5 d f 0.5 0.5 0.5 c 1258 1097 m -2 6 d -7
- 3 d -2 -5 d f 0.525 0.525 0.525 c 1260 1091 m -2 6 d -11 4 d -1 -4 d f 0.55
- 0.55 0.55 c 1262 1085 m -2 6 d -14 6 d -2 -5 d f 0.575 0.575 0.575 c 1263 1079
- m -1 6 d -18 7 d -1 -5 d f 0.6 0.6 0.6 c 1265 1073 m -2 6 d -20 8 d -2 -4 d f
- 0.625 0.625 0.625 c 1267 1067 m -2 6 d -24 10 d -1 -5 d f 0.65 0.65 0.65 c 1269
- 1061 m -2 6 d -27 11 d -2 -4 d f 0.675 0.675 0.675 c 1270 1055 m -1 6 d -31 13
- d -1 -5 d f 0.7 0.7 0.7 c 1272 1049 m -2 6 d -33 14 d -1 -5 d f 0.725 0.725
- 0.725 c 1270 1038 m 3 9 d -1 2 d -36 15 d -2 -4 d f 0.75 0.75 0.75 c 1266 1027
- m 4 11 d -36 22 d -1 -5 d f 0.775 0.775 0.775 c 1262 1015 m 4 12 d -33 28 d -2
- -5 d f 0.8 0.8 0.8 c 1259 1004 m 3 11 d -31 35 d -1 -4 d f 0.825 0.825 0.825 c
- 1255 992 m 4 12 d -29 42 d -1 -3 d 5 -18 d f 0.85 0.85 0.85 c 1251 980 m 4 12 d
- -21 33 d 10 -33 d f 0.875 0.875 0.875 c 1249 974 m 2 6 d -7 12 d f 0.625 0.625
- 0.625 c 1207 1038 m -2 -1 d 8 -5 d f 0.65 0.65 0.65 c 1226 1022 m -2 Y -16 19 d
- -3 -1 d 6 -6 d f 0.675 0.675 0.675 c 1226 1020 m 3 -5 d -16 24 d -3 X f 0.7 0.7
- 0.7 c 1229 1015 m 3 -5 d -16 30 d -3 -1 d f 0.725 0.725 0.725 c 1232 1010 m 2
- -6 d -15 37 d -3 -1 d f 0.75 0.75 0.75 c 1234 1004 m 3 -5 d -16 43 d -2 -1 d f
- 0.775 0.775 0.775 c 1237 999 m 3 -6 d -16 49 d -3 X f 0.8 0.8 0.8 c 1240 993 m
- 2 -5 d -15 55 d -3 -1 d f 0.825 0.825 0.825 c 1242 988 m 3 -6 d -11 43 d -5 18
- d -2 X f 0.85 0.85 0.85 c 1245 982 m 3 -5 d -4 15 d -10 33 d f 0.875 0.875
- 0.875 c 1248 977 m 1 -3 d -5 18 d f 0.625 0.625 0.625 c 1213 1032 m -8 5 d -5
- 14 d f 0.65 0.65 0.65 c 1224 1022 m 2 X -13 10 d -13 19 d -12 32 d f 0.675
- 0.675 0.675 c 1219 1024 m 5 -2 d -36 61 d -6 16 d 3 -10 d f 0.7 0.7 0.7 c 1214
- 1026 m 5 -2 d -34 65 d 5 -19 d f 0.725 0.725 0.725 c 1208 1027 m 6 -1 d -24 44
- d 6 -19 d f 0.75 0.75 0.75 c 1203 1029 m 5 -2 d -12 24 d 5 -18 d f 0.775 0.775
- 0.775 c 1202 1029 m 1 X -2 4 d f 0.675 0.675 0.675 c 1185 1089 m -3 10 d -4 -1
- d f 0.7 0.7 0.7 c 1190 1070 m -5 19 d -7 9 d -7 -2 d f 0.725 0.725 0.725 c 1196
- 1051 m -6 19 d -19 26 d -8 -2 d f 0.75 0.75 0.75 c 1201 1033 m -5 18 d -33 43 d
- -5 -1 d 4 -27 d f 0.775 0.775 0.775 c 1188 975 m 14 54 d -1 4 d -39 33 d 11 -82
- d f 0.8 0.8 0.8 c 1179 943 m 9 32 d -15 9 d f 0.7 0.7 0.7 c 1143 1097 m -8 3 d
- 6 -37 d f 0.725 0.725 0.725 c 1152 1095 m -9 2 d -2 -34 d 7 -40 d f 0.75 0.75
- 0.75 c 1162 1066 m -4 27 d -6 2 d -4 -72 d 6 -40 d f 0.775 0.775 0.775 c 1155
- 977 m 15 -22 d 3 29 d -11 82 d -8 -83 d f 0.8 0.8 0.8 c 1170 955 m 9 -12 d -6
- 41 d f 0.7 0.7 0.7 c 1141 1063 m -6 37 d -3 -5 d f 0.725 0.725 0.725 c 1148
- 1023 m -7 40 d -9 32 d -3 -6 d f 0.75 0.75 0.75 c 1154 983 m -6 40 d -19 66 d
- -2 -5 d f 0.775 0.775 0.775 c 1147 980 m 8 -3 d -1 6 d -27 101 d -3 -6 d f 0.8
- 0.8 0.8 c 1138 983 m 9 -3 d -23 98 d -3 -5 d f 0.825 0.825 0.825 c 1132 985 m 6
- -2 d -17 90 d -3 -6 d 11 -73 d f 0.85 0.85 0.85 c 1118 1067 m -3 -5 d 7 -44 d 7
- -24 d f 0.875 0.875 0.875 c 1115 1062 m -2 -6 d 2 -13 d 7 -25 d f 0.9 0.9 0.9 c
- 1113 1056 m -2 -2 d 4 -11 d f 0.65 0.65 0.65 c 1090 1048 m -2 X 3 -8 d f 0.675
- 0.675 0.675 c 1092 1049 m -2 -1 d 1 -8 d 3 -8 d f 0.7 0.7 0.7 c 1095 1050 m -3
- -1 d 2 -17 d 3 -8 d f 0.725 0.725 0.725 c 1097 1050 m -2 X 2 -26 d 3 -8 d f
- 0.75 0.75 0.75 c 1099 1051 m -2 -1 d 3 -34 d 2 -8 d f 0.775 0.775 0.775 c 1101
- 1051 m -2 X 3 -43 d 3 -8 d f 0.8 0.8 0.8 c 1108 992 m 2 X -6 60 d -3 -1 d 4 -51
- d f 0.825 0.825 0.825 c 1110 992 m 22 -7 d -3 9 d -23 58 d -2 X f 0.85 0.85
- 0.85 c 1129 994 m -7 24 d -14 35 d -2 -1 d f 0.875 0.875 0.875 c 1122 1018 m -7
- 25 d -5 11 d -2 -1 d f 0.9 0.9 0.9 c 1115 1043 m -4 11 d -1 X f 0.65 0.65 0.65
- c 1091 1040 m -3 8 d -3 5 d f 0.675 0.675 0.675 c 1094 1032 m -3 8 d -6 13 d -3
- 6 d f 0.7 0.7 0.7 c 1097 1024 m -3 8 d -12 27 d -2 6 d f 0.725 0.725 0.725 c
- 1100 1016 m -3 8 d -17 41 d -3 6 d f 0.75 0.75 0.75 c 1102 1008 m -2 8 d -23 55
- d -3 5 d f 0.775 0.775 0.775 c 1085 986 m 1 X 19 14 d -3 8 d -28 68 d -3 6 d 13
- -94 d f 0.8 0.8 0.8 c 1086 986 m 22 6 d -3 8 d -34 82 d -3 6 d 8 -53 d 8 -47 d
- f 0.825 0.825 0.825 c 1068 1088 m -3 6 d 2 -13 d 9 -46 d f 0.85 0.85 0.85 c
- 1065 1094 m -1 2 d 3 -15 d f 0.775 0.775 0.775 c 1084 988 m 1 -2 d -1 2 d f 0.8
- 0.8 0.8 c 1061 1020 m 23 -32 d -8 47 d -18 -10 d f 0.825 0.825 0.825 c 1076
- 1035 m -9 46 d -19 -42 d 10 -14 d f 0.85 0.85 0.85 c 1067 1081 m -3 15 d -23
- -47 d 7 -10 d f 0.65 0.65 0.65 c 1038 920 m 2 8 d -5 16 d f 0.675 0.675 0.675 c
- 1040 928 m 4 17 d -15 48 d 6 -49 d f 0.7 0.7 0.7 c 1044 945 m 3 16 d -23 80 d 5
- -48 d f 0.725 0.725 0.725 c 1047 961 m 4 16 d -33 113 d 6 -49 d f 0.75 0.75
- 0.75 c 1051 977 m 4 17 d -33 94 d -5 9 d 1 -7 d f 0.775 0.775 0.775 c 1055 994
- m 4 16 d -32 68 d -5 10 d f 0.8 0.8 0.8 c 1059 1010 m 2 10 d -3 5 d -26 43 d -5
- 10 d f 0.825 0.825 0.825 c 1058 1025 m -10 14 d -11 18 d -5 11 d f 0.85 0.85
- 0.85 c 1048 1039 m -7 10 d -4 8 d f 0.525 0.525 0.525 c 1014 901 m 3 2 d -4 3 d
- f 0.55 0.55 0.55 c 1017 903 m 4 4 d -10 8 d 2 -9 d f 0.575 0.575 0.575 c 1021
- 907 m 5 4 d -17 14 d 2 -10 d f 0.6 0.6 0.6 c 1026 911 m 5 4 d -24 20 d 2 -10 d
- f 0.625 0.625 0.625 c 1031 915 m 4 3 d -30 26 d 2 -9 d f 0.65 0.65 0.65 c 1035
- 918 m 3 2 d -3 24 d -32 10 d 2 -10 d f 0.675 0.675 0.675 c 1035 944 m -6 49 d
- -28 -29 d 2 -10 d f 0.7 0.7 0.7 c 1029 993 m -5 48 d -25 -68 d 2 -9 d f 0.725
- 0.725 0.725 c 1024 1041 m -6 49 d -21 -107 d 2 -10 d f 0.75 0.75 0.75 c 1018
- 1090 m -1 7 d -15 -64 d -7 -40 d 2 -10 d f 0.775 0.775 0.775 c 1002 1033 m -8
- -36 d 1 -4 d f 0.525 0.525 0.525 c 1012 909 m 2 -8 d -1 5 d f 0.55 0.55 0.55 c
- 1008 926 m 4 -17 d 1 -3 d -2 9 d f 0.575 0.575 0.575 c 1003 943 m 5 -17 d 3 -11
- d -2 10 d f 0.6 0.6 0.6 c 999 960 m 4 -17 d 6 -18 d -2 10 d f 0.625 0.625 0.625
- c 994 977 m 5 -17 d 8 -25 d -2 9 d f 0.65 0.65 0.65 c 991 989 m 3 -12 d 11 -33
- d -2 10 d -13 35 d f 0.675 0.675 0.675 c 1003 954 m -2 10 d -16 26 d 5 -1 d f
- 0.7 0.7 0.7 c 1001 964 m -2 9 d -19 17 d 5 X f 0.725 0.725 0.725 c 999 973 m -2
- 10 d -22 8 d 5 -1 d f 0.75 0.75 0.75 c 997 983 m -2 10 d -22 -1 d -3 -1 d 5 X f
- 0.775 0.775 0.775 c 995 993 m -1 4 d -21 -5 d f 0.65 0.65 0.65 c 990 988 m 1 1
- d -1 X f 0.675 0.675 0.675 c 986 982 m 4 6 d 1 Y -5 1 d f 0.7 0.7 0.7 c 982 977
- m 4 5 d -1 8 d -5 X f 0.725 0.725 0.725 c 978 972 m 4 5 d -2 13 d -5 1 d f 0.75
- 0.75 0.75 c 975 966 m 3 6 d -3 19 d -5 X 1 Y f 0.775 0.775 0.775 c 971 961 m 4
- 5 d -5 26 d -6 19 d f 0.8 0.8 0.8 c 967 956 m 4 5 d -7 50 d -5 18 d 8 -70 d f
- 0.825 0.825 0.825 c 959 1029 m -6 18 d 4 -35 d 10 -53 d f 0.85 0.85 0.85 c 953
- 1047 m -6 18 d 10 -53 d f 0.875 0.875 0.875 c 947 1065 m 1 Y -1 Y f 0.725 0.725
- 0.725 c 944 977 m 5 -5 d -10 2 d f 0.75 0.75 0.75 c 949 972 m 6 -5 d -23 4 d 7
- 3 d f 0.775 0.775 0.775 c 955 967 m 6 -6 d -35 6 d 6 4 d f 0.8 0.8 0.8 c 961
- 961 m 6 -5 d 3 Y -38 29 d -6 -22 d 3 1 d f 0.825 0.825 0.825 c 967 959 m -10 53
- d -19 15 d -9 -39 d f 0.85 0.85 0.85 c 957 1012 m -10 53 d -9 -38 d f 0.875
- 0.875 0.875 c 947 1065 m 1 Y -1 Y f 0.725 0.725 0.725 c 940 966 m 4 11 d -5 -3
- d f 0.75 0.75 0.75 c 936 953 m 4 13 d -1 8 d -7 -3 d f 0.775 0.775 0.775 c 932
- 941 m 4 12 d -4 18 d -6 -4 d -19 23 d -7 10 d 1 -5 d f 0.8 0.8 0.8 c 928 928 m
- 4 13 d -6 26 d -3 -1 d -16 24 d -6 5 d 7 -32 d f 0.825 0.825 0.825 c 924 915 m
- 4 13 d -20 35 d 6 -31 d f 0.85 0.85 0.85 c 920 904 m 4 11 d -10 17 d f 0.775
- 0.775 0.775 c 901 995 m -1 5 d -23 -19 d 17 -84 d f 0.8 0.8 0.8 c 897 884 m 7 6
- d 4 73 d -7 32 d -7 -98 d f 0.825 0.825 0.825 c 904 890 m 9 8 d 1 34 d -6 31 d
- f 0.85 0.85 0.85 c 913 898 m 7 6 d -6 28 d f 0.75 0.75 0.75 c 874 977 m -21 -29
- d 5 -10 d f 0.775 0.775 0.775 c 894 897 m -17 84 d -3 -4 d -16 -39 d 13 -28 d f
- 0.8 0.8 0.8 c 873 905 m 24 -21 d -3 13 d -23 13 d f 0.75 0.75 0.75 c 858 938 m
- -5 10 d -2 -5 d f 0.775 0.775 0.775 c 871 910 m -13 28 d -7 5 d -5 -14 d f 0.8
- 0.8 0.8 c 865 908 m 8 -3 d -2 5 d -25 19 d -6 -14 d f 0.825 0.825 0.825 c 855
- 911 m 10 -3 d -25 7 d -5 -14 d f 0.85 0.85 0.85 c 850 913 m 5 -2 d -20 -10 d -5
- -13 d f 0.7 0.7 0.7 c 826 880 m 4 5 d -7 7 d f 0.725 0.725 0.725 c 830 885 m 3
- 5 d -13 14 d 3 -12 d f 0.75 0.75 0.75 c 833 890 m 4 5 d -20 22 d 3 -13 d f
- 0.775 0.775 0.775 c 837 895 m 4 5 d -27 29 d 3 -12 d f 0.8 0.8 0.8 c 841 900 m
- 3 5 d -33 36 d 3 -12 d f 0.825 0.825 0.825 c 844 905 m 4 5 d -40 44 d 3 -13 d f
- 0.85 0.85 0.85 c 848 910 m 2 3 d -20 -25 d -24 75 d 2 -9 d f 0.575 0.575 0.575
- c 803 820 m 4 10 d -23 13 d -1 -7 d f 0.6 0.6 0.6 c 807 830 m 4 12 d -25 13 d
- -2 -12 d f 0.625 0.625 0.625 c 811 842 m 5 12 d -28 12 d -2 -11 d f 0.65 0.65
- 0.65 c 816 854 m 5 13 d -31 10 d -2 -11 d f 0.675 0.675 0.675 c 821 867 m 5 12
- d -34 9 d -2 -11 d f 0.7 0.7 0.7 c 826 879 m 1 Y -3 12 d -29 7 d -2 -11 d f
- 0.725 0.725 0.725 c 823 892 m -3 12 d -24 6 d -2 -11 d f 0.75 0.75 0.75 c 820
- 904 m -3 13 d -19 4 d -2 -11 d f 0.775 0.775 0.775 c 817 917 m -3 12 d -14 4 d
- -2 -12 d f 0.8 0.8 0.8 c 814 929 m -3 12 d -8 3 d -3 -11 d f 0.825 0.825 0.825
- c 811 941 m -3 13 d -3 1 d -2 -11 d f 0.85 0.85 0.85 c 808 954 m -2 9 d -1 -8 d
- f 0.55 0.55 0.55 c 779 814 m 1 X -20 16 d -1 X f 0.575 0.575 0.575 c 780 814 m
- 23 6 d -20 16 d -23 -6 d f 0.55 0.55 0.55 c 756 808 m 23 6 d -20 16 d -23 -6 d
- f 732 802 m 24 6 d -20 16 d -24 -6 d f 1833 1062 m 24 6 d -21 15 d -23 -6 d f
- 1810 1056 m 23 6 d -20 15 d -24 -6 d f 1786 1050 m 24 6 d -21 15 d -23 -6 d f
- 1763 1098 m 23 -48 d -20 15 d 1 Y -6 32 d f 0.575 0.575 0.575 c 1766 1066 m -16
- 23 d -2 10 d 12 -1 d f 0.6 0.6 0.6 c 1750 1089 m -8 11 d 6 -1 d f 0.55 0.55
- 0.55 c 1760 1096 m 3 2 d -3 X f 0.575 0.575 0.575 c 1751 1088 m 9 8 d 2 Y -12 1
- d f 0.6 0.6 0.6 c 1741 1080 m 10 8 d -3 11 d -6 1 d -23 7 d 9 -12 d f 0.625
- 0.625 0.625 c 1739 1078 m 2 2 d -13 15 d f 0.6 0.6 0.6 c 1728 1095 m -9 12 d 1
- Y f 0.625 0.625 0.625 c 1737 1078 m 2 X -11 17 d -9 13 d -2 10 d f 0.65 0.65
- 0.65 c 1735 1077 m 2 1 d -20 40 d -2 11 d f 0.675 0.675 0.675 c 1732 1076 m 3 1
- d -20 52 d -2 10 d f 0.7 0.7 0.7 c 1730 1076 m 2 X -19 63 d -2 10 d f 0.725
- 0.725 0.725 c 1727 1075 m 3 1 d -19 73 d -3 10 d f 0.75 0.75 0.75 c 1725 1075 m
- 2 X -19 84 d -2 10 d f 0.775 0.775 0.775 c 1722 1074 m 3 1 d -19 94 d -2 10 d f
- 0.8 0.8 0.8 c 1720 1073 m 2 1 d -18 105 d -2 10 d f 0.825 0.825 0.825 c 1717
- 1073 m 3 X -18 116 d -2 10 d f 0.85 0.85 0.85 c 1716 1072 m 1 1 d -17 126 d -2
- 10 d 14 -108 d f 0.875 0.875 0.875 c 1698 1209 m -2 10 d 4 -28 d 12 -90 d f 0.9
- 0.9 0.9 c 1696 1219 m -1 3 d 5 -31 d f 0.75 0.75 0.75 c 1692 1066 m 1 X -3 2 d
- f 0.775 0.775 0.775 c 1693 1066 m 6 2 d -26 23 d -1 -9 d 18 -14 d f 0.8 0.8 0.8
- c 1699 1068 m 6 2 d -26 51 d -6 -30 d f 0.825 0.825 0.825 c 1705 1070 m 7 1 d
- -28 80 d -5 -30 d f 0.85 0.85 0.85 c 1712 1071 m 4 1 d -4 29 d -23 80 d -5 -30
- d f 0.875 0.875 0.875 c 1712 1101 m -12 90 d -6 20 d -5 -30 d f 0.9 0.9 0.9 c
- 1700 1191 m -5 31 d -1 -11 d f 0.625 0.625 0.625 c 1651 1077 m -3 -1 d 4 -1 d f
- 0.65 0.65 0.65 c 1655 1077 m -4 X 1 -2 d 4 X f 0.675 0.675 0.675 c 1659 1078 m
- -4 -1 d 1 -2 d 4 X f 0.7 0.7 0.7 c 1662 1079 m -3 -1 d 1 -3 d 4 -1 d f 0.725
- 0.725 0.725 c 1666 1080 m -4 -1 d 2 -5 d 4 X f 0.75 0.75 0.75 c 1669 1074 m 23
- -8 d -2 2 d -21 13 d -3 -1 d 2 -6 d f 0.775 0.775 0.775 c 1690 1068 m -18 14 d
- -3 -1 d f 0.625 0.625 0.625 c 1652 1075 m -4 1 d -1 1 d f 0.65 0.65 0.65 c 1656
- 1075 m -4 X -5 2 d -2 2 d f 0.675 0.675 0.675 c 1660 1075 m -4 X -11 4 d -2 2 d
- f 0.7 0.7 0.7 c 1664 1074 m -4 1 d -17 6 d -2 2 d f 0.725 0.725 0.725 c 1668
- 1074 m -4 X -23 9 d -3 2 d f 0.75 0.75 0.75 c 1665 1073 m 4 1 d -1 X -30 11 d
- -2 2 d f 0.775 0.775 0.775 c 1661 1072 m 4 1 d -29 14 d -2 2 d f 0.8 0.8 0.8 c
- 1656 1071 m 5 1 d -27 17 d -2 1 d f 0.825 0.825 0.825 c 1652 1069 m 4 2 d -24
- 19 d -2 2 d f 0.85 0.85 0.85 c 1648 1068 m 4 1 d -22 23 d -2 2 d f 0.875 0.875
- 0.875 c 1645 1068 m 3 X -20 26 d -2 2 d 7 -11 d f 0.9 0.9 0.9 c 1626 1096 m -1
- 1 d 8 -12 d f 0.8 0.8 0.8 c 1622 1035 m 3 4 d -5 3 d f 0.825 0.825 0.825 c 1625
- 1039 m 8 11 d -19 10 d 6 -18 d f 0.85 0.85 0.85 c 1633 1050 m 8 12 d -32 16 d 5
- -18 d f 0.875 0.875 0.875 c 1641 1062 m 4 6 d -12 17 d -29 12 d 5 -19 d f 0.9
- 0.9 0.9 c 1633 1085 m -8 12 d -23 7 d 2 -7 d f 0.65 0.65 0.65 c 1598 1083 m 1
- -1 d -1 X f 0.675 0.675 0.675 c 1599 1082 m 4 -8 d -12 X 7 8 d f 0.7 0.7 0.7 c
- 1603 1074 m 4 -9 d -22 1 d 6 8 d f 0.725 0.725 0.725 c 1607 1065 m 4 -8 d -33 1
- d 7 8 d f 0.75 0.75 0.75 c 1611 1057 m 4 -8 d -33 16 d -4 -7 d f 0.775 0.775
- 0.775 c 1615 1049 m 4 -9 d -34 32 d -3 -7 d f 0.8 0.8 0.8 c 1619 1040 m 3 -5 d
- -2 7 d -31 38 d -4 -8 d f 0.825 0.825 0.825 c 1620 1042 m -6 18 d -21 27 d -4
- -7 d f 0.85 0.85 0.85 c 1614 1060 m -5 18 d -13 16 d -3 -7 d f 0.875 0.875
- 0.875 c 1609 1078 m -5 19 d -4 4 d -4 -7 d f 0.9 0.9 0.9 c 1604 1097 m -2 7 d
- -2 -3 d f 0.65 0.65 0.65 c 1598 1082 m 1 Y -1 Y f 0.675 0.675 0.675 c 1595 1078
- m 3 4 d -7 -8 d f 0.7 0.7 0.7 c 1592 1073 m 3 5 d -4 -4 d -6 -8 d f 0.725 0.725
- 0.725 c 1588 1069 m 4 4 d -7 -7 d -7 -8 d f 0.75 0.75 0.75 c 1585 1064 m 3 5 d
- -10 -11 d -4 6 d f 0.775 0.775 0.775 c 1582 1059 m 3 5 d -11 X -5 6 d f 0.8 0.8
- 0.8 c 1578 1055 m 4 4 d -13 11 d -4 7 d f 0.825 0.825 0.825 c 1575 1050 m 3 5 d
- -13 22 d -4 6 d f 0.85 0.85 0.85 c 1575 1050 m -14 33 d -4 6 d 5 -13 d f 0.875
- 0.875 0.875 c 1557 1089 m -2 3 d 7 -16 d f 0.775 0.775 0.775 c 1535 1098 m -4 2
- d 4 -15 d f 0.8 0.8 0.8 c 1541 1097 m -6 1 d -13 Y 4 -19 d f 0.825 0.825 0.825
- c 1546 1095 m -5 2 d -2 -31 d 5 -19 d f 0.85 0.85 0.85 c 1561 1030 m 14 20 d
- -13 26 d -10 17 d -6 2 d -2 -48 d 5 -19 d f 0.875 0.875 0.875 c 1551 1017 m 10
- 13 d 1 46 d -7 16 d -3 1 d -3 -65 d f 0.75 0.75 0.75 c 1528 1038 m 2 -2 d -9 -2
- d f 0.775 0.775 0.775 c 1530 1036 m 5 -4 d 53 Y -4 15 d -23 -74 d 13 8 d f 0.8
- 0.8 0.8 c 1535 1032 m 4 -4 d 38 Y -4 19 d f 0.825 0.825 0.825 c 1539 1028 m 5
- -4 d 23 Y -5 19 d f 0.85 0.85 0.85 c 1544 1024 m 5 -5 d 9 Y -5 19 d f 0.875
- 0.875 0.875 c 1549 1019 m 2 -2 d -2 11 d f 0.725 0.725 0.725 c 1504 1059 m 9 -8
- d -17 -15 d f 0.75 0.75 0.75 c 1513 1051 m 15 -13 d -7 -4 d -27 -19 d -10 -8 d
- 12 29 d f 0.775 0.775 0.775 c 1521 1034 m -13 -8 d -14 -11 d f 0.625 0.625
- 0.625 c 1481 999 m 5 12 d -12 17 d f 0.65 0.65 0.65 c 1486 1011 m 5 13 d -25 36
- d 8 -32 d f 0.675 0.675 0.675 c 1491 1024 m 5 13 d -33 36 d -2 9 d 5 -22 d f
- 0.7 0.7 0.7 c 1496 1037 m 5 13 d -29 -4 d -9 27 d f 0.725 0.725 0.725 c 1501
- 1050 m 3 9 d -8 -23 d -15 -18 d -9 28 d f 0.75 0.75 0.75 c 1496 1036 m -12 -29
- d -3 11 d f 0.6 0.6 0.6 c 1457 980 m 22 17 d -38 39 d f 0.625 0.625 0.625 c
- 1479 997 m 2 2 d -7 29 d -29 31 d -8 -10 d 4 -13 d f 0.65 0.65 0.65 c 1474 1028
- m -8 32 d -12 12 d -9 -13 d f 0.675 0.675 0.675 c 1466 1060 m -5 22 d -7 -10 d
- f 0.6 0.6 0.6 c 1436 986 m 21 -6 d -16 56 d f 0.625 0.625 0.625 c 1434 987 m 2
- -1 d 5 50 d -4 13 d -2 3 d -3 -56 d f 0.65 0.65 0.65 c 1435 1052 m -2 5 d -3
- -51 d 2 -10 d f 0.675 0.675 0.675 c 1433 1057 m -2 4 d -2 -45 d 1 -10 d f 0.7
- 0.7 0.7 c 1431 1061 m -2 4 d -2 -40 d 2 -9 d f 0.725 0.725 0.725 c 1429 1065 m
- -2 4 d -2 -34 d 2 -10 d f 0.75 0.75 0.75 c 1427 1069 m -2 5 d -2 -29 d 2 -10 d
- f 0.775 0.775 0.775 c 1425 1074 m -2 4 d -2 -23 d 2 -10 d f 0.8 0.8 0.8 c 1423
- 1078 m -2 4 d -1 -18 d 1 -9 d f 0.825 0.825 0.825 c 1421 1082 m -3 5 d -13 Y 2
- -10 d f 0.85 0.85 0.85 c 1418 1087 m -2 4 d -7 Y 2 -10 d f 0.875 0.875 0.875 c
- 1416 1091 m -2 4 d -1 Y 2 -10 d f 0.9 0.9 0.9 c 1414 1095 m 2 Y -3 Y f 0.625
- 0.625 0.625 c 1431 988 m 3 -1 d -2 9 d f 0.65 0.65 0.65 c 1427 989 m 4 -1 d 1 8
- d -2 10 d f 0.675 0.675 0.675 c 1424 990 m 3 -1 d 3 17 d -1 10 d f 0.7 0.7 0.7
- c 1420 991 m 4 -1 d 5 26 d -2 9 d f 0.725 0.725 0.725 c 1417 992 m 3 -1 d 7 34
- d -2 10 d f 0.75 0.75 0.75 c 1413 994 m 4 -2 d 8 43 d -2 10 d -32 -33 d -1 -2 d
- 3 -2 d f 0.775 0.775 0.775 c 1410 994 m 3 X 10 51 d -2 10 d -26 -27 d -4 -16 d
- 2 -4 d f 0.8 0.8 0.8 c 1421 1055 m -1 9 d -21 -20 d -4 -16 d f 0.825 0.825
- 0.825 c 1420 1064 m -2 10 d -14 -14 d -5 -16 d f 0.85 0.85 0.85 c 1418 1074 m
- -2 10 d -8 -8 d -4 -16 d f 0.875 0.875 0.875 c 1416 1084 m -2 10 d -2 -2 d -4
- -16 d f 0.9 0.9 0.9 c 1414 1094 m 3 Y -2 -5 d f 0.75 0.75 0.75 c 1393 1008 m -3
- 2 d -1 X f 0.775 0.775 0.775 c 1409 993 m 1 1 d -17 14 d -4 2 d -5 -2 d f 0.8
- 0.8 0.8 c 1395 982 m 14 11 d -25 15 d -5 -1 d f 0.825 0.825 0.825 c 1387 975 m
- 8 7 d -16 25 d -6 -1 d 9 -24 d f 0.85 0.85 0.85 c 1373 1006 m -5 -2 d 2 -5 d 12
- -17 d f 0.875 0.875 0.875 c 1368 1004 m -1 X 3 -5 d f 0.7 0.7 0.7 c 1346 1023 m
- -3 2 d 4 -12 d f 0.725 0.725 0.725 c 1349 1020 m -3 3 d 1 -10 d 4 -15 d f 0.75
- 0.75 0.75 c 1352 1017 m -3 3 d 2 -22 d 5 -16 d f 0.775 0.775 0.775 c 1356 1014
- m -4 3 d 4 -35 d 4 -15 d f 0.8 0.8 0.8 c 1363 956 m 8 6 d -12 49 d -3 3 d 4 -47
- d f 0.825 0.825 0.825 c 1371 962 m 16 13 d -5 7 d -20 26 d -3 3 d f 0.85 0.85
- 0.85 c 1382 982 m -12 17 d -4 6 d -4 3 d f 0.875 0.875 0.875 c 1370 999 m -3 5
- d -1 1 d f 0.675 0.675 0.675 c 1326 1051 m -6 8 d -1 Y f 0.7 0.7 0.7 c 1347
- 1013 m -4 12 d -17 26 d -6 7 d 3 -12 d f 0.725 0.725 0.725 c 1351 998 m -4 15 d
- -24 33 d 4 -11 d f 0.75 0.75 0.75 c 1356 982 m -5 16 d -24 37 d 3 -12 d f 0.775
- 0.775 0.775 c 1360 967 m -4 15 d -26 41 d 4 -12 d f 0.8 0.8 0.8 c 1357 965 m 6
- -9 d -3 11 d -26 44 d 3 -12 d f 0.825 0.825 0.825 c 1340 990 m 17 -25 d -20 34
- d f 0.675 0.675 0.675 c 1320 1058 m 1 Y -1 X f 0.7 0.7 0.7 c 1323 1046 m -3 12
- d -1 1 d -3 -3 d f 0.725 0.725 0.725 c 1327 1035 m -4 11 d -7 10 d -4 -3 d f
- 0.75 0.75 0.75 c 1330 1023 m -3 12 d -15 18 d -4 -3 d f 0.775 0.775 0.775 c
- 1334 1011 m -4 12 d -22 27 d -3 -3 d f 0.8 0.8 0.8 c 1337 999 m -3 12 d -29 36
- d -4 -3 d f 0.825 0.825 0.825 c 1337 991 m 3 -1 d -3 9 d -36 45 d -3 -3 d f
- 0.85 0.85 0.85 c 1321 996 m 16 -5 d -39 50 d -2 -1 d 14 -28 d f 0.875 0.875
- 0.875 c 1317 997 m 4 -1 d -11 16 d f 0.725 0.725 0.725 c 1276 1046 m -3 1 d 2
- -6 d f 0.75 0.75 0.75 c 1281 1045 m -5 1 d -1 -5 d 3 -9 d f 0.775 0.775 0.775 c
- 1285 1043 m -4 2 d -3 -13 d 4 -9 d f 0.8 0.8 0.8 c 1290 1042 m -5 1 d -3 -20 d
- 3 -9 d f 0.825 0.825 0.825 c 1294 1040 m -4 2 d -5 -28 d 3 -9 d f 0.85 0.85
- 0.85 c 1310 1012 m -14 28 d -2 X -6 -35 d 3 -9 d f 0.875 0.875 0.875 c 1293 991
- m 24 6 d -7 15 d -19 -16 d f 0.725 0.725 0.725 c 1275 1041 m -2 6 d -3 -9 d f
- 0.75 0.75 0.75 c 1278 1032 m -3 9 d -5 -3 d -4 -11 d f 0.775 0.775 0.775 c 1282
- 1023 m -4 9 d -12 -5 d -4 -12 d f 0.8 0.8 0.8 c 1285 1014 m -3 9 d -20 -8 d -3
- -11 d f 0.825 0.825 0.825 c 1288 1005 m -3 9 d -26 -10 d -4 -12 d f 0.85 0.85
- 0.85 c 1291 996 m -3 9 d -33 -13 d -4 -12 d f 0.875 0.875 0.875 c 1280 981 m 13
- 10 d -2 5 d -40 -16 d -2 -6 d 11 -1 d f 0.9 0.9 0.9 c 1270 972 m 10 9 d -20 -8
- d f 0.65 0.65 0.65 c 1226 1020 m 2 Y -1 Y f 0.675 0.675 0.675 c 1229 1015 m -3
- 5 d 1 Y 3 -1 d f 0.7 0.7 0.7 c 1232 1010 m -3 5 d 5 Y 2 -2 d f 0.725 0.725
- 0.725 c 1234 1004 m -2 6 d -1 8 d 2 -2 d f 0.75 0.75 0.75 c 1237 999 m -3 5 d
- -1 12 d 2 -1 d f 0.775 0.775 0.775 c 1240 993 m -3 6 d -2 16 d 2 -2 d f 0.8 0.8
- 0.8 c 1242 988 m -2 5 d -3 20 d 3 -2 d f 0.825 0.825 0.825 c 1245 982 m -3 6 d
- -2 23 d 2 -1 d f 0.85 0.85 0.85 c 1248 977 m -3 5 d -3 28 d 2 -2 d f 0.875
- 0.875 0.875 c 1246 1006 m 6 -8 d 8 -25 d -11 1 d -1 3 d -4 31 d f 0.9 0.9 0.9 c
- 1252 998 m 18 -26 d -10 1 d f 0.625 0.625 0.625 c 1223 960 m 1 2 d -3 5 d f
- 0.65 0.65 0.65 c 1224 962 m 2 5 d 55 Y -2 X -7 -43 d 4 -12 d f 0.675 0.675
- 0.675 c 1226 967 m 2 4 d 1 49 d -3 1 d -2 1 d -5 2 d -5 -33 d 3 -12 d f 0.7 0.7
- 0.7 c 1228 971 m 3 5 d 42 Y -2 2 d -10 4 d -5 2 d -4 -23 d 4 -12 d f 0.725
- 0.725 0.725 c 1231 976 m 2 4 d 36 Y -2 2 d -17 8 d -6 1 d -2 -12 d 4 -12 d f
- 0.75 0.75 0.75 c 1233 980 m 2 5 d 30 Y -2 1 d -25 11 d -5 2 d -2 Y 3 -12 d f
- 0.775 0.775 0.775 c 1235 985 m 2 4 d 24 Y -2 2 d -32 14 d -1 X 1 -2 d f 0.8 0.8
- 0.8 c 1237 989 m 3 5 d 17 Y -3 2 d f 0.825 0.825 0.825 c 1240 994 m 2 4 d 12 Y
- -2 1 d f 0.85 0.85 0.85 c 1242 998 m 2 5 d 5 Y -2 2 d f 0.875 0.875 0.875 c
- 1244 1003 m 2 3 d -2 2 d f 0.625 0.625 0.625 c 1217 950 m 6 10 d -2 7 d f 0.65
- 0.65 0.65 c 1208 931 m 9 19 d 4 17 d -4 12 d f 0.675 0.675 0.675 c 1199 914 m 9
- 17 d 9 48 d -3 12 d -16 -76 d f 0.7 0.7 0.7 c 1214 991 m -4 12 d -16 -82 d 4 -6
- d f 0.725 0.725 0.725 c 1210 1003 m -4 12 d -16 -88 d 4 -6 d f 0.75 0.75 0.75 c
- 1206 1015 m -3 12 d -18 -94 d 5 -6 d f 0.775 0.775 0.775 c 1203 1027 m -1 2 d
- -14 -54 d -7 -35 d 4 -7 d f 0.8 0.8 0.8 c 1188 975 m -9 -32 d 2 -3 d f 0.525
- 0.525 0.525 c 1176 908 m -1 X f 0.55 0.55 0.55 c 1176 908 m 4 1 d -7 7 d 2 -8 d
- f 0.575 0.575 0.575 c 1180 909 m 4 1 d -13 13 d 2 -7 d f 0.6 0.6 0.6 c 1184 910
- m 4 1 d -19 20 d 2 -8 d f 0.625 0.625 0.625 c 1188 911 m 4 1 d -25 26 d 2 -7 d
- f 0.65 0.65 0.65 c 1192 912 m 4 1 d -32 33 d 3 -8 d f 0.675 0.675 0.675 c 1196
- 913 m 3 1 d -1 1 d -36 38 d 2 -7 d f 0.7 0.7 0.7 c 1198 915 m -4 6 d -34 40 d 2
- -8 d f 0.725 0.725 0.725 c 1194 921 m -4 6 d -32 42 d 2 -8 d f 0.75 0.75 0.75 c
- 1190 927 m -5 6 d -29 43 d 2 -7 d f 0.775 0.775 0.775 c 1185 933 m -4 7 d -11
- 15 d -15 22 d 1 -1 d f 0.8 0.8 0.8 c 1181 940 m -2 3 d -9 12 d f 0.525 0.525
- 0.525 c 1176 908 m -1 X f 0.55 0.55 0.55 c 1174 910 m 2 -2 d -1 X -2 8 d f
- 0.575 0.575 0.575 c 1172 911 m 2 -1 d -1 6 d -2 7 d f 0.6 0.6 0.6 c 1170 913 m
- 2 -2 d -1 12 d -2 8 d f 0.625 0.625 0.625 c 1168 915 m 2 -2 d -1 18 d -2 7 d f
- 0.65 0.65 0.65 c 1166 916 m 2 -1 d -1 23 d -3 8 d f 0.675 0.675 0.675 c 1164
- 918 m 2 -2 d -2 30 d -2 7 d f 0.7 0.7 0.7 c 1162 920 m 2 -2 d -2 35 d -2 8 d f
- 0.725 0.725 0.725 c 1161 921 m 1 -1 d -2 41 d -2 8 d f 0.75 0.75 0.75 c 1159
- 923 m 2 -2 d -3 48 d -2 7 d f 0.775 0.775 0.775 c 1157 925 m 2 -2 d -3 53 d -1
- 1 d -8 3 d f 0.8 0.8 0.8 c 1155 926 m 2 -1 d -10 55 d -9 3 d f 0.825 0.825
- 0.825 c 1153 928 m 2 -2 d -17 57 d -6 2 d 8 -24 d f 0.85 0.85 0.85 c 1152 929 m
- 1 -1 d -13 33 d f 0.8 0.8 0.8 c 1110 992 m -2 X 1 -1 d f 0.825 0.825 0.825 c
- 1140 961 m -8 24 d -22 7 d -1 -1 d 6 -23 d f 0.85 0.85 0.85 c 1145 927 m 7 2 d
- -12 32 d -25 7 d 7 -22 d f 0.875 0.875 0.875 c 1129 923 m 16 4 d -23 19 d 7 -23
- d f 0.9 0.9 0.9 c 1129 923 m f 0.775 0.775 0.775 c 1086 986 m -1 X 1 -4 d f 0.8
- 0.8 0.8 c 1105 930 m 3 -1 d 1 62 d -1 1 d -22 -6 d -4 Y f 0.825 0.825 0.825 c
- 1108 929 m 7 -2 d 41 Y -6 23 d f 0.85 0.85 0.85 c 1115 927 m 7 -2 d 21 Y -7 22
- d f 0.875 0.875 0.875 c 1122 925 m 7 -2 d -7 23 d f 0.9 0.9 0.9 c 1129 923 m f
- 0.775 0.775 0.775 c 1086 982 m -1 4 d -1 2 d f 0.8 0.8 0.8 c 1102 931 m 3 -1 d
- -19 52 d -2 6 d -23 32 d 3 -9 d f 0.825 0.825 0.825 c 1095 934 m 7 -3 d -38 80
- d 6 -26 d f 0.85 0.85 0.85 c 1088 936 m 7 -2 d -25 51 d 6 -25 d f 0.875 0.875
- 0.875 c 1082 938 m 6 -2 d -12 24 d f 0.65 0.65 0.65 c 1058 905 m 1 X -19 23 d
- -2 -8 d f 0.675 0.675 0.675 c 1059 905 m 2 4 d -17 36 d -4 -17 d f 0.7 0.7 0.7
- c 1061 909 m 3 4 d -17 48 d -3 -16 d f 0.725 0.725 0.725 c 1064 913 m 2 3 d -15
- 61 d -4 -16 d f 0.75 0.75 0.75 c 1066 916 m 3 4 d -14 74 d -4 -17 d f 0.775
- 0.775 0.775 c 1069 920 m 3 4 d -13 86 d -4 -16 d f 0.8 0.8 0.8 c 1072 924 m 2 3
- d -10 84 d -3 9 d -2 -10 d f 0.825 0.825 0.825 c 1074 927 m 3 4 d -7 54 d -6 26
- d f 0.85 0.85 0.85 c 1077 931 m 2 3 d -3 26 d -6 25 d f 0.875 0.875 0.875 c
- 1079 934 m 3 4 d -6 22 d f 0.525 0.525 0.525 c 1017 903 m -3 -2 d 3 1 d f 0.55
- 0.55 0.55 c 1021 907 m -4 -4 d -1 Y 5 3 d f 0.575 0.575 0.575 c 1026 911 m -5
- -4 d 1 -2 d 6 3 d f 0.6 0.6 0.6 c 1031 915 m -5 -4 d 2 -3 d 5 3 d f 0.625 0.625
- 0.625 c 1035 912 m 11 -3 d -11 9 d -4 -3 d 2 -4 d f 0.65 0.65 0.65 c 1046 909 m
- 12 -4 d -20 15 d -3 -2 d f 0.525 0.525 0.525 c 1017 902 m -3 -1 d -2 8 d f 0.55
- 0.55 0.55 c 1022 905 m -5 -3 d -5 7 d -4 17 d f 0.575 0.575 0.575 c 1028 908 m
- -6 -3 d -14 21 d -5 17 d f 0.6 0.6 0.6 c 1033 911 m -5 -3 d -25 35 d -4 17 d f
- 0.625 0.625 0.625 c 1033 913 m 2 -1 d -2 -1 d -34 49 d -5 17 d f 0.65 0.65 0.65
- c 1031 913 m 2 X -39 64 d -3 12 d -2 Y f 0.675 0.675 0.675 c 1029 914 m 2 -1 d
- -40 74 d 2 -7 d f 0.7 0.7 0.7 c 1027 915 m 2 -1 d -36 66 d 3 -7 d f 0.725 0.725
- 0.725 c 1025 915 m 2 X -31 58 d 2 -8 d f 0.75 0.75 0.75 c 1022 916 m 3 -1 d -27
- 50 d 2 -7 d f 0.775 0.775 0.775 c 1020 917 m 2 -1 d -22 42 d 2 -7 d f 0.8 0.8
- 0.8 c 1018 917 m 2 X -18 34 d 2 -7 d f 0.825 0.825 0.825 c 1016 918 m 2 -1 d
- -14 27 d 2 -7 d f 0.85 0.85 0.85 c 1014 919 m 2 -1 d -10 19 d 2 -8 d f 0.875
- 0.875 0.875 c 1012 919 m 2 X -6 10 d 2 -7 d f 0.9 0.9 0.9 c 1011 920 m 1 -1 d
- -2 3 d f 0.65 0.65 0.65 c 991 987 m 2 Y -1 -1 d f 0.675 0.675 0.675 c 993 980 m
- -2 7 d -1 1 d -4 -6 d f 0.7 0.7 0.7 c 996 973 m -3 7 d -7 2 d -4 -5 d f 0.725
- 0.725 0.725 c 988 873 m 3 7 d 7 85 d -2 8 d -14 4 d -4 -5 d 5 -78 d f 0.75 0.75
- 0.75 c 991 880 m 3 6 d 6 72 d -2 7 d -20 7 d -3 -6 d 2 -51 d 6 -21 d f 0.775
- 0.775 0.775 c 994 886 m 3 6 d 5 59 d -2 7 d -25 8 d -4 -5 d 1 -25 d 5 -21 d f
- 0.8 0.8 0.8 c 997 892 m 3 7 d 4 45 d -2 7 d -31 10 d -4 -5 d 5 -20 d f 0.825
- 0.825 0.825 c 1000 899 m 4 6 d 2 32 d -2 7 d f 0.85 0.85 0.85 c 1004 905 m 3 6
- d 1 18 d -2 8 d f 0.875 0.875 0.875 c 1007 911 m 3 7 d 4 Y -2 7 d f 0.9 0.9 0.9
- c 1010 918 m 1 2 d -1 2 d f 0.675 0.675 0.675 c 964 854 m 3 2 d -5 9 d f 0.7
- 0.7 0.7 c 967 856 m 20 17 d -41 89 d 16 -97 d f 0.725 0.725 0.725 c 987 873 m 1
- X -5 21 d -34 78 d -5 5 d 2 -15 d f 0.75 0.75 0.75 c 983 894 m -6 21 d -22 52 d
- -6 5 d f 0.775 0.775 0.775 c 977 915 m -5 21 d -11 25 d -6 6 d f 0.8 0.8 0.8 c
- 972 936 m -5 20 d -6 5 d f 0.575 0.575 0.575 c 941 848 m 4 1 d -6 4 d f 0.6 0.6
- 0.6 c 945 849 m 5 1 d -13 7 d 2 -4 d f 0.625 0.625 0.625 c 950 850 m 5 2 d -19
- 10 d 1 -5 d f 0.65 0.65 0.65 c 955 852 m 5 1 d -26 14 d 2 -5 d f 0.675 0.675
- 0.675 c 960 853 m 4 1 d -2 11 d -30 7 d 2 -5 d f 0.7 0.7 0.7 c 962 865 m -16 97
- d -16 -86 d 2 -4 d f 0.725 0.725 0.725 c 946 962 m -2 15 d -4 -11 d -11 -85 d 1
- -5 d f 0.75 0.75 0.75 c 940 966 m -4 -13 d -9 -67 d 2 -5 d f 0.775 0.775 0.775
- c 936 953 m -4 -12 d -7 -51 d 2 -4 d f 0.8 0.8 0.8 c 932 941 m -4 -13 d -4 -33
- d 1 -5 d f 0.825 0.825 0.825 c 928 928 m -4 -13 d -2 -15 d 2 -5 d f 0.85 0.85
- 0.85 c 924 915 m -4 -11 d 2 -4 d f 0.575 0.575 0.575 c 933 863 m 8 -15 d -2 5 d
- f 0.6 0.6 0.6 c 926 879 m 7 -16 d 6 -10 d -2 4 d f 0.625 0.625 0.625 c 918 894
- m 8 -15 d 11 -22 d -1 5 d f 0.65 0.65 0.65 c 917 896 m 1 -2 d 18 -32 d -2 5 d
- -20 27 d f 0.675 0.675 0.675 c 934 867 m -2 5 d -21 20 d 3 2 d f 0.7 0.7 0.7 c
- 932 872 m -2 4 d -23 14 d 4 2 d f 0.725 0.725 0.725 c 930 876 m -1 5 d -25 8 d
- 3 1 d f 0.75 0.75 0.75 c 929 881 m -2 5 d -26 1 d 3 2 d f 0.775 0.775 0.775 c
- 927 886 m -2 4 d -28 -5 d 4 2 d f 0.8 0.8 0.8 c 925 890 m -1 5 d -20 -5 d -7 -6
- d 1 Y f 0.825 0.825 0.825 c 924 895 m -2 5 d -9 -2 d -9 -8 d f 0.85 0.85 0.85 c
- 922 900 m -2 4 d -7 -6 d f 0.65 0.65 0.65 c 914 893 m 3 3 d -3 -2 d f 0.675
- 0.675 0.675 c 911 891 m 3 2 d 1 Y -3 -2 d f 0.7 0.7 0.7 c 908 888 m 3 3 d 1 Y
- -4 -2 d f 0.725 0.725 0.725 c 905 885 m 3 3 d -1 2 d -3 -1 d f 0.75 0.75 0.75 c
- 901 883 m 4 2 d -1 4 d -3 -2 d f 0.775 0.775 0.775 c 898 880 m 3 3 d 4 Y -4 -2
- d f 0.8 0.8 0.8 c 895 877 m 3 3 d -1 5 d -1 Y -24 21 d 15 -21 d f 0.825 0.825
- 0.825 c 894 876 m 1 1 d -7 7 d f 0.8 0.8 0.8 c 888 884 m -15 21 d -8 3 d f
- 0.825 0.825 0.825 c 883 867 m 11 9 d -6 8 d -23 24 d -10 3 d f 0.85 0.85 0.85 c
- 870 857 m 13 10 d -28 44 d -5 2 d f 0.575 0.575 0.575 c 847 851 m -1 1 d f 0.6
- 0.6 0.6 c 847 851 m 2 1 d -8 7 d 5 -7 d f 0.625 0.625 0.625 c 849 852 m 2 X -15
- 14 d 5 -7 d f 0.65 0.65 0.65 c 851 852 m 3 1 d -23 20 d 5 -7 d f 0.675 0.675
- 0.675 c 854 853 m 2 X -29 27 d 4 -7 d f 0.7 0.7 0.7 c 856 853 m 2 1 d -28 31 d
- -4 -5 d 1 X f 0.725 0.725 0.725 c 858 854 m 2 X -27 36 d -3 -5 d f 0.75 0.75
- 0.75 c 860 854 m 2 1 d -25 40 d -4 -5 d f 0.775 0.775 0.775 c 862 855 m 2 X -23
- 45 d -4 -5 d f 0.8 0.8 0.8 c 864 855 m 2 1 d -22 49 d -3 -5 d f 0.825 0.825
- 0.825 c 866 856 m 3 1 d -21 53 d -4 -5 d f 0.85 0.85 0.85 c 869 857 m 1 X -20
- 56 d -2 -3 d f 0.575 0.575 0.575 c 823 805 m 24 46 d -1 1 d -39 -22 d -4 -10 d
- f 0.6 0.6 0.6 c 846 852 m -5 7 d -30 -17 d -4 -12 d f 0.625 0.625 0.625 c 841
- 859 m -5 7 d -20 -12 d -5 -12 d f 0.65 0.65 0.65 c 836 866 m -5 7 d -10 -6 d -5
- -13 d f 0.675 0.675 0.675 c 831 873 m -4 7 d -1 -1 d -5 -12 d f 0.7 0.7 0.7 c
- 827 880 m -1 X -1 Y f 0.55 0.55 0.55 c 800 799 m 1 X -21 15 d -1 X f 0.575
- 0.575 0.575 c 801 799 m 22 6 d -20 15 d -23 -6 d f 0.55 0.55 0.55 c 776 793 m
- 24 6 d -21 15 d -23 -6 d f 753 787 m 23 6 d -20 15 d -24 -6 d f 1854 1046 m 23
- 6 d -20 16 d -24 -6 d f 1830 1040 m 24 6 d -21 16 d -23 -6 d f 1818 1037 m 12 3
- d -20 16 d -24 -6 d 20 -15 d f 0.575 0.575 0.575 c 1807 1034 m 11 3 d -12 -2 d
- f 0.55 0.55 0.55 c 1806 1035 m -20 15 d -23 48 d f 0.575 0.575 0.575 c 1805
- 1041 m 2 -7 d -1 1 d -43 63 d 2 1 d f 0.6 0.6 0.6 c 1802 1048 m 3 -7 d -40 58 d
- 2 1 d f 0.625 0.625 0.625 c 1800 1054 m 2 -6 d -35 52 d 2 1 d f 0.65 0.65 0.65
- c 1798 1061 m 2 -7 d -31 47 d 1 1 d f 0.675 0.675 0.675 c 1796 1067 m 2 -6 d
- -28 41 d 2 1 d f 0.7 0.7 0.7 c 1794 1074 m 2 -7 d -24 36 d 2 1 d f 0.725 0.725
- 0.725 c 1792 1081 m 2 -7 d -20 30 d 2 1 d f 0.75 0.75 0.75 c 1790 1087 m 2 -6 d
- -16 24 d 1 1 d f 0.775 0.775 0.775 c 1788 1094 m 2 -7 d -13 19 d 2 1 d f 0.8
- 0.8 0.8 c 1786 1100 m 2 -6 d -9 13 d 2 1 d f 0.825 0.825 0.825 c 1784 1107 m 2
- -7 d -5 8 d 2 1 d f 0.85 0.85 0.85 c 1783 1109 m 1 -2 d -1 2 d f 0.55 0.55 0.55
- c 1763 1098 m -3 -2 d f 0.575 0.575 0.575 c 1765 1099 m -2 -1 d -3 -2 d -9 -8 d
- f 0.6 0.6 0.6 c 1767 1100 m -2 -1 d -14 -11 d -10 -8 d f 0.625 0.625 0.625 c
- 1760 1022 m 1 5 d 8 74 d -2 -1 d -26 -20 d -2 -2 d f 0.65 0.65 0.65 c 1761 1027
- m 3 10 d 6 65 d -1 -1 d f 0.675 0.675 0.675 c 1764 1037 m 2 10 d 6 56 d -2 -1 d
- f 0.7 0.7 0.7 c 1766 1047 m 3 9 d 5 48 d -2 -1 d f 0.725 0.725 0.725 c 1769
- 1056 m 3 10 d 4 39 d -2 -1 d f 0.75 0.75 0.75 c 1772 1066 m 2 10 d 3 30 d -1 -1
- d f 0.775 0.775 0.775 c 1774 1076 m 3 10 d 2 21 d -2 -1 d f 0.8 0.8 0.8 c 1777
- 1086 m 3 10 d 1 12 d -2 -1 d f 0.825 0.825 0.825 c 1780 1096 m 2 10 d 1 3 d -2
- -1 d f 0.85 0.85 0.85 c 1782 1106 m 1 3 d f 0.625 0.625 0.625 c 1758 1022 m 2 X
- -21 56 d -2 X f 0.65 0.65 0.65 c 1753 1021 m 5 1 d -21 56 d -2 -1 d f 0.675
- 0.675 0.675 c 1748 1019 m 5 2 d -18 56 d -3 -1 d f 0.7 0.7 0.7 c 1743 1018 m 5
- 1 d -16 57 d -2 X f 0.725 0.725 0.725 c 1739 1017 m 4 1 d -13 58 d -3 -1 d f
- 0.75 0.75 0.75 c 1736 1016 m 3 1 d -12 58 d -2 X 9 -53 d f 0.775 0.775 0.775 c
- 1725 1075 m -3 -1 d 7 -38 d 5 -14 d f 0.8 0.8 0.8 c 1722 1074 m -2 -1 d 4 -23 d
- 5 -14 d f 0.825 0.825 0.825 c 1720 1073 m -3 X 2 -10 d 5 -13 d f 0.85 0.85 0.85
- c 1717 1073 m -1 -1 d 3 -9 d f 0.75 0.75 0.75 c 1734 1020 m 2 -4 d -2 6 d -41
- 44 d -1 X 1 X f 0.775 0.775 0.775 c 1729 1027 m 5 -7 d 2 Y -5 14 d -30 32 d -6
- -2 d 5 -4 d f 0.8 0.8 0.8 c 1724 1035 m 5 -8 d 9 Y -5 14 d -19 20 d -6 -2 d -1
- -6 d 4 -3 d f 0.825 0.825 0.825 c 1718 1042 m 6 -7 d 15 Y -5 13 d -7 8 d -7 -1
- d -3 -11 d 5 -4 d f 0.85 0.85 0.85 c 1713 1050 m 5 -8 d 1 21 d -3 9 d -4 -1 d
- -5 -16 d 5 -4 d f 0.875 0.875 0.875 c 1713 1051 m -1 Y -1 1 d f 0.75 0.75 0.75
- c 1693 1066 m -1 X -23 8 d 9 -27 d f 0.775 0.775 0.775 c 1689 1018 m 9 44 d -5
- 4 d -15 -19 d f 0.8 0.8 0.8 c 1689 1018 m 8 11 d 5 30 d -4 3 d f 0.825 0.825
- 0.825 c 1697 1029 m 7 10 d 3 16 d -5 4 d f 0.85 0.85 0.85 c 1704 1039 m 8 10 d
- 2 Y -5 4 d f 0.875 0.875 0.875 c 1712 1049 m 1 2 d -1 X f 0.75 0.75 0.75 c 1678
- 1047 m -9 27 d -4 -1 d f 0.775 0.775 0.775 c 1689 1018 m -11 29 d -13 26 d -4
- -1 d f 0.8 0.8 0.8 c 1682 1012 m 7 6 d -28 54 d -5 -1 d f 0.825 0.825 0.825 c
- 1674 1005 m 8 7 d -26 59 d -4 -2 d f 0.85 0.85 0.85 c 1666 999 m 8 6 d -22 64 d
- -4 -1 d f 0.875 0.875 0.875 c 1666 998 m 1 Y -18 69 d -3 X f 0.8 0.8 0.8 c 1625
- 1039 m -3 -4 d 16 -2 d f 0.825 0.825 0.825 c 1642 1033 m 11 -16 d -20 33 d -8
- -11 d 13 -6 d f 0.85 0.85 0.85 c 1653 1017 m 11 -17 d -23 62 d -8 -12 d f 0.875
- 0.875 0.875 c 1664 1000 m 2 -2 d -21 70 d -4 -6 d f 0.65 0.65 0.65 c 1599 1082
- m -1 1 d 1 -1 d f 0.675 0.675 0.675 c 1603 1074 m -4 8 d 2 -8 d f 0.7 0.7 0.7 c
- 1607 1065 m -4 9 d -2 X 2 -7 d f 0.725 0.725 0.725 c 1611 1057 m -4 8 d -4 2 d
- 2 -8 d f 0.75 0.75 0.75 c 1615 1049 m -4 8 d -6 2 d 3 -8 d f 0.775 0.775 0.775
- c 1619 1040 m -4 9 d -7 2 d 2 -7 d f 0.8 0.8 0.8 c 1638 1033 m -16 2 d -3 5 d
- -9 4 d 2 -8 d f 0.825 0.825 0.825 c 1635 1027 m 7 6 d -4 X -26 3 d 2 -8 d f
- 0.85 0.85 0.85 c 1627 1020 m 8 7 d -21 1 d 3 -7 d f 0.875 0.875 0.875 c 1619
- 1013 m 8 7 d -10 1 d f 0.65 0.65 0.65 c 1599 1082 m -1 1 d -1 Y f 0.675 0.675
- 0.675 c 1601 1074 m -2 8 d -1 X -3 -4 d f 0.7 0.7 0.7 c 1603 1067 m -2 7 d -6 4
- d -3 -5 d f 0.725 0.725 0.725 c 1605 1059 m -2 8 d -11 6 d -4 -4 d f 0.75 0.75
- 0.75 c 1608 1051 m -3 8 d -17 10 d -3 -5 d f 0.775 0.775 0.775 c 1610 1044 m -2
- 7 d -23 13 d -3 -5 d f 0.8 0.8 0.8 c 1612 1036 m -2 8 d -28 15 d -4 -4 d f
- 0.825 0.825 0.825 c 1614 1028 m -2 8 d -34 19 d -3 -5 d f 0.85 0.85 0.85 c 1595
- 994 m 11 9 d 11 18 d -3 7 d -39 22 d f 0.875 0.875 0.875 c 1606 1003 m 13 10 d
- -2 8 d f 0.825 0.825 0.825 c 1572 1001 m 18 -6 d -24 11 d f 0.85 0.85 0.85 c
- 1590 995 m 5 -1 d -20 56 d -14 -20 d -4 -17 d 9 -7 d f 0.875 0.875 0.875 c 1561
- 1030 m -10 -13 d 6 -4 d f 0.75 0.75 0.75 c 1530 1036 m -2 2 d 2 -4 d f 0.775
- 0.775 0.775 c 1535 1032 m -5 4 d -2 Y 3 -8 d f 0.8 0.8 0.8 c 1539 1028 m -4 4 d
- -2 -6 d 4 -8 d f 0.825 0.825 0.825 c 1566 1000 m 6 1 d -6 5 d -22 18 d -5 4 d
- -2 -10 d 4 -8 d f 0.85 0.85 0.85 c 1556 997 m 10 3 d 6 Y -9 7 d -8 6 d -5 5 d
- -3 -14 d 4 -8 d f 0.875 0.875 0.875 c 1548 995 m 8 2 d 1 16 d -6 4 d -2 2 d -4
- -17 d f 0.725 0.725 0.725 c 1513 1051 m -9 8 d 1 -5 d f 0.75 0.75 0.75 c 1530
- 1034 m -2 4 d -15 13 d -8 3 d 4 -17 d f 0.775 0.775 0.775 c 1533 1026 m -3 8 d
- -21 3 d 3 -16 d f 0.8 0.8 0.8 c 1537 1018 m -4 8 d -21 -5 d 4 -17 d f 0.825
- 0.825 0.825 c 1541 1010 m -4 8 d -21 -14 d 3 -16 d f 0.85 0.85 0.85 c 1545 1002
- m -4 8 d -22 -22 d 4 -17 d f 0.875 0.875 0.875 c 1525 963 m 23 32 d -3 7 d -22
- -31 d f 0.625 0.625 0.625 c 1501 970 m 2 X -17 41 d -5 -12 d f 0.65 0.65 0.65 c
- 1503 970 m 2 -1 d -14 55 d -5 -13 d f 0.675 0.675 0.675 c 1505 969 m 2 -1 d -11
- 69 d -5 -13 d f 0.7 0.7 0.7 c 1507 968 m 3 -1 d -9 83 d -5 -13 d f 0.725 0.725
- 0.725 c 1510 967 m 2 X -7 87 d -1 5 d -3 -9 d f 0.75 0.75 0.75 c 1512 967 m 2
- -1 d -5 71 d -4 17 d f 0.775 0.775 0.775 c 1514 966 m 3 -1 d -5 56 d -3 16 d f
- 0.8 0.8 0.8 c 1517 965 m 2 -1 d -3 40 d -4 17 d f 0.825 0.825 0.825 c 1519 964
- m 2 X -2 24 d -3 16 d f 0.85 0.85 0.85 c 1521 964 m 3 -1 d -1 8 d -4 17 d f
- 0.875 0.875 0.875 c 1524 963 m 1 X -2 8 d f 0.6 0.6 0.6 c 1478 977 m 17 -5 d
- -16 25 d -22 -17 d f 0.625 0.625 0.625 c 1495 972 m 6 -2 d -20 29 d -2 -2 d f
- 0.6 0.6 0.6 c 1454 958 m 24 19 d -21 3 d -21 6 d 8 -13 d f 0.625 0.625 0.625 c
- 1436 986 m -2 1 d 10 -14 d f 0.6 0.6 0.6 c 1454 958 m -10 15 d f 0.625 0.625
- 0.625 c 1450 959 m 4 -1 d -10 15 d -10 14 d -3 1 d f 0.65 0.65 0.65 c 1447 960
- m 3 -1 d -19 29 d -4 1 d f 0.675 0.675 0.675 c 1443 962 m 4 -2 d -20 29 d -3 1
- d f 0.7 0.7 0.7 c 1440 963 m 3 -1 d -19 28 d -4 1 d f 0.725 0.725 0.725 c 1436
- 964 m 4 -1 d -20 28 d -3 1 d f 0.75 0.75 0.75 c 1432 965 m 4 -1 d -19 28 d -4 2
- d f 0.775 0.775 0.775 c 1431 966 m 1 -1 d -19 29 d -3 X f 1407 933 m 24 33 d
- -21 28 d -1 -1 d -7 -50 d f 0.8 0.8 0.8 c 1409 993 m -14 -11 d -2 -19 d 9 -20 d
- f 0.825 0.825 0.825 c 1395 982 m -8 -7 d 6 -12 d f 0.6 0.6 0.6 c 1384 940 m f
- 0.625 0.625 0.625 c 1384 940 m 4 -1 d -7 3 d 3 -2 d f 0.65 0.65 0.65 c 1388 939
- m 3 -1 d -13 6 d 3 -2 d f 0.675 0.675 0.675 c 1391 938 m 4 -1 d -19 9 d 2 -2 d
- f 0.7 0.7 0.7 c 1395 937 m 3 -1 d -25 12 d 3 -2 d f 0.725 0.725 0.725 c 1398
- 936 m 4 -2 d -31 16 d 2 -2 d f 0.75 0.75 0.75 c 1402 934 m 4 -1 d -38 19 d 3 -2
- d f 0.775 0.775 0.775 c 1406 933 m 1 X -5 10 d -37 11 d 3 -2 d f 0.8 0.8 0.8 c
- 1402 943 m -9 20 d -22 -1 d -8 -6 d 2 -2 d f 0.825 0.825 0.825 c 1393 963 m -6
- 12 d -16 -13 d f 0.6 0.6 0.6 c 1384 940 m f 0.625 0.625 0.625 c 1378 942 m 6 -2
- d -3 2 d f 0.65 0.65 0.65 c 1372 944 m 6 -2 d 3 X -3 2 d f 0.675 0.675 0.675 c
- 1366 946 m 6 -2 d 6 X -2 2 d f 0.7 0.7 0.7 c 1361 947 m 5 -1 d 10 X -3 2 d f
- 0.725 0.725 0.725 c 1360 948 m 1 -1 d 12 1 d -2 2 d -15 6 d f 0.75 0.75 0.75 c
- 1371 950 m -3 2 d -16 13 d 4 -9 d f 0.775 0.775 0.775 c 1368 952 m -3 2 d -17
- 20 d 4 -9 d f 0.8 0.8 0.8 c 1365 954 m -2 2 d -6 9 d -14 18 d 5 -9 d f 0.825
- 0.825 0.825 c 1357 965 m -17 25 d 3 -7 d f 0.725 0.725 0.725 c 1354 939 m 6 9 d
- -4 8 d f 0.75 0.75 0.75 c 1348 930 m 6 9 d 2 17 d -4 9 d f 0.775 0.775 0.775 c
- 1342 921 m 6 9 d 4 35 d -4 9 d f 0.8 0.8 0.8 c 1337 915 m 5 6 d 6 53 d -5 9 d
- -8 -60 d f 0.825 0.825 0.825 c 1343 983 m -3 7 d -3 1 d -10 -36 d 8 -32 d f
- 0.85 0.85 0.85 c 1337 991 m -16 5 d -2 -9 d 8 -32 d f 0.875 0.875 0.875 c 1321
- 996 m -4 1 d 2 -10 d f 0.6 0.6 0.6 c 1313 936 m 3 -3 d -4 7 d f 0.625 0.625
- 0.625 c 1316 933 m 3 -2 d -9 14 d 2 -5 d f 0.65 0.65 0.65 c 1319 931 m 2 -2 d
- -13 21 d 2 -5 d f 0.675 0.675 0.675 c 1321 929 m 3 -3 d -18 29 d 2 -5 d f 0.7
- 0.7 0.7 c 1324 926 m 3 -2 d -22 36 d 1 -5 d f 0.725 0.725 0.725 c 1327 924 m 2
- -3 d -26 44 d 2 -5 d f 0.75 0.75 0.75 c 1329 921 m 3 -2 d -31 50 d 2 -4 d f
- 0.775 0.775 0.775 c 1332 919 m 3 -2 d -36 57 d 2 -5 d f 0.8 0.8 0.8 c 1335 917
- m 2 -2 d -2 8 d -37 56 d 1 -5 d f 0.825 0.825 0.825 c 1335 923 m -8 32 d -31 29
- d 2 -5 d f 0.85 0.85 0.85 c 1327 955 m -8 32 d -25 2 d 2 -5 d f 0.875 0.875
- 0.875 c 1319 987 m -2 10 d -24 -6 d 1 -2 d f 0.6 0.6 0.6 c 1302 926 m 11 10 d
- -1 4 d f 0.625 0.625 0.625 c 1290 916 m 12 10 d 10 14 d -2 5 d -20 -29 d f 0.65
- 0.65 0.65 c 1310 945 m -2 5 d -20 -28 d 2 -6 d f 0.675 0.675 0.675 c 1308 950 m
- -2 5 d -20 -28 d 2 -5 d f 0.7 0.7 0.7 c 1306 955 m -1 5 d -21 -28 d 2 -5 d f
- 0.725 0.725 0.725 c 1305 960 m -2 5 d -21 -27 d 2 -6 d f 0.75 0.75 0.75 c 1303
- 965 m -2 4 d -21 -26 d 2 -5 d f 0.775 0.775 0.775 c 1301 969 m -2 5 d -21 -25 d
- 2 -6 d f 0.8 0.8 0.8 c 1299 974 m -1 5 d -22 -25 d 2 -5 d f 0.825 0.825 0.825 c
- 1298 979 m -2 5 d -22 -25 d 2 -5 d f 0.85 0.85 0.85 c 1296 984 m -2 5 d -22 -24
- d 2 -6 d f 0.875 0.875 0.875 c 1294 989 m -1 2 d -13 -10 d -10 -11 d 2 -5 d f
- 0.9 0.9 0.9 c 1280 981 m -10 -9 d -2 Y f 0.625 0.625 0.625 c 1290 916 m f 0.65
- 0.65 0.65 c 1288 916 m 2 X -2 6 d f 0.675 0.675 0.675 c 1285 915 m 3 1 d 6 Y -2
- 5 d f 0.7 0.7 0.7 c 1283 914 m 2 1 d 1 12 d -2 5 d f 0.725 0.725 0.725 c 1281
- 914 m 2 X 1 18 d -2 6 d f 0.75 0.75 0.75 c 1278 913 m 3 1 d 1 24 d -2 5 d f
- 0.775 0.775 0.775 c 1276 913 m 2 X 2 30 d -2 6 d f 0.8 0.8 0.8 c 1274 912 m 2 1
- d 2 36 d -2 5 d f 0.825 0.825 0.825 c 1272 912 m 2 X 2 42 d -2 5 d f 0.85 0.85
- 0.85 c 1269 911 m 3 1 d 2 47 d -2 6 d f 0.875 0.875 0.875 c 1267 910 m 2 1 d 3
- 54 d -2 5 d -18 28 d -6 8 d 6 -26 d f 0.9 0.9 0.9 c 1266 910 m 1 X 3 60 d 2 Y
- -18 26 d -18 Y f 0.625 0.625 0.625 c 1224 962 m -1 -2 d 1 -2 d f 0.65 0.65 0.65
- c 1226 967 m -2 -5 d -4 Y 2 -3 d f 0.675 0.675 0.675 c 1228 971 m -2 -4 d -12 Y
- 3 -3 d f 0.7 0.7 0.7 c 1231 976 m -3 -5 d 1 -19 d 2 -4 d f 0.725 0.725 0.725 c
- 1233 980 m -2 -4 d -28 Y 2 -3 d f 0.75 0.75 0.75 c 1235 985 m -2 -5 d -35 Y 3
- -4 d f 0.775 0.775 0.775 c 1237 989 m -2 -4 d 1 -44 d 2 -3 d f 0.8 0.8 0.8 c
- 1240 994 m -3 -5 d 1 -51 d 2 -3 d f 0.825 0.825 0.825 c 1242 998 m -2 -4 d -59
- Y 3 -4 d f 0.85 0.85 0.85 c 1243 931 m 10 -8 d -9 80 d -2 -5 d 1 -67 d f 0.875
- 0.875 0.875 c 1253 923 m 10 -10 d -11 67 d -6 26 d -2 -3 d f 0.9 0.9 0.9 c 1263
- 913 m 3 -3 d -14 70 d f 0.625 0.625 0.625 c 1219 898 m 1 1 d 4 59 d -1 2 d -6
- -10 d -50 Y f 0.65 0.65 0.65 c 1220 899 m 3 4 d 3 52 d -2 3 d -7 -8 d -9 -19 d
- -24 Y 9 -7 d f 0.675 0.675 0.675 c 1223 903 m 3 4 d 3 45 d -3 3 d -18 -24 d -9
- -17 d 9 -7 d f 0.7 0.7 0.7 c 1226 907 m 3 4 d 2 37 d -2 4 d f 0.725 0.725 0.725
- c 1229 911 m 2 4 d 2 30 d -2 3 d f 0.75 0.75 0.75 c 1231 915 m 3 4 d 2 22 d -3
- 4 d f 0.775 0.775 0.775 c 1234 919 m 3 4 d 1 15 d -2 3 d f 0.8 0.8 0.8 c 1237
- 923 m 3 4 d 8 Y -2 3 d f 0.825 0.825 0.825 c 1240 927 m 3 4 d -3 4 d f 0.85
- 0.85 0.85 c 1243 931 m f 0.525 0.525 0.525 c 1176 908 m f 0.55 0.55 0.55 c 1180
- 909 m -4 -1 d 7 -1 d f 0.575 0.575 0.575 c 1184 910 m -4 -1 d 3 -2 d 7 -1 d f
- 0.6 0.6 0.6 c 1196 906 m 2 -1 d -10 6 d -4 -1 d 6 -4 d f 0.625 0.625 0.625 c
- 1198 905 m 21 -7 d -2 2 d -25 12 d -4 -1 d f 0.65 0.65 0.65 c 1217 900 m -9 7 d
- -12 6 d -4 -1 d f 0.675 0.675 0.675 c 1208 907 m -9 7 d -3 -1 d f 0.525 0.525
- 0.525 c 1176 908 m f 0.55 0.55 0.55 c 1183 907 m -7 1 d -2 2 d f 0.575 0.575
- 0.575 c 1190 906 m -7 1 d -9 3 d -2 1 d f 0.6 0.6 0.6 c 1196 906 m -6 X -18 5 d
- -2 2 d f 0.625 0.625 0.625 c 1193 905 m 3 1 d -26 7 d -2 2 d f 0.65 0.65 0.65 c
- 1191 904 m 2 1 d -25 10 d -2 1 d f 0.675 0.675 0.675 c 1188 904 m 3 X -25 12 d
- -2 2 d f 0.7 0.7 0.7 c 1186 903 m 2 1 d -24 14 d -2 2 d f 0.725 0.725 0.725 c
- 1183 902 m 3 1 d -24 17 d -1 1 d f 0.75 0.75 0.75 c 1180 902 m 3 X -22 19 d -2
- 2 d f 0.775 0.775 0.775 c 1178 901 m 2 1 d -21 21 d -2 2 d f 0.8 0.8 0.8 c 1175
- 900 m 3 1 d -21 24 d -2 1 d f 0.825 0.825 0.825 c 1173 900 m 2 X -20 26 d -2 2
- d f 0.85 0.85 0.85 c 1172 900 m 1 X -20 28 d -1 1 d f 1156 886 m 16 14 d -20 29
- d -7 -2 d f 0.875 0.875 0.875 c 1149 880 m 7 6 d -11 41 d -16 -4 d -1 Y f 0.9
- 0.9 0.9 c 1129 923 m -1 Y f 0.8 0.8 0.8 c 1108 929 m -3 1 d 12 -24 d f 0.825
- 0.825 0.825 c 1125 888 m 8 -3 d -18 42 d -7 2 d 9 -23 d f 0.85 0.85 0.85 c 1133
- 885 m 12 -3 d -23 43 d -7 2 d f 0.875 0.875 0.875 c 1145 882 m 4 -2 d -20 42 d
- 1 Y -7 2 d f 0.9 0.9 0.9 c 1129 922 m 1 Y f 0.8 0.8 0.8 c 1117 906 m -12 24 d
- -3 1 d f 0.825 0.825 0.825 c 1118 886 m 7 2 d -8 18 d -15 25 d -7 3 d f 0.85
- 0.85 0.85 c 1107 883 m 11 3 d -23 48 d -7 2 d f 0.875 0.875 0.875 c 1102 882 m
- 5 1 d -19 53 d -6 2 d f 0.65 0.65 0.65 c 1059 905 m -1 X -1 Y f 0.675 0.675
- 0.675 c 1061 909 m -2 -4 d -1 -1 d 3 -3 d f 0.7 0.7 0.7 c 1064 913 m -3 -4 d -8
- Y 2 -3 d f 0.725 0.725 0.725 c 1066 916 m -2 -3 d -1 -15 d 2 -3 d f 0.75 0.75
- 0.75 c 1069 920 m -3 -4 d -1 -21 d 2 -3 d f 0.775 0.775 0.775 c 1072 924 m -3
- -4 d -2 -28 d 3 -4 d f 0.8 0.8 0.8 c 1074 927 m -2 -3 d -2 -36 d 2 -3 d f 0.825
- 0.825 0.825 c 1077 931 m -3 -4 d -2 -42 d 2 -3 d f 0.85 0.85 0.85 c 1079 934 m
- -2 -3 d -3 -49 d 2 -3 d f 0.875 0.875 0.875 c 1078 876 m 24 6 d -20 56 d -3 -4
- d -3 -55 d f 0.625 0.625 0.625 c 1046 909 m -11 3 d 1 -3 d f 0.65 0.65 0.65 c
- 1058 904 m 1 Y -12 4 d -10 X 3 -5 d f 0.675 0.675 0.675 c 1061 901 m -3 3 d -19
- X 2 -5 d f 0.7 0.7 0.7 c 1063 898 m -2 3 d -20 -2 d 3 -5 d f 0.725 0.725 0.725
- c 1065 895 m -2 3 d -19 -4 d 2 -5 d f 0.75 0.75 0.75 c 1067 892 m -2 3 d -19 -6
- d 2 -5 d f 0.775 0.775 0.775 c 1070 888 m -3 4 d -19 -8 d 3 -5 d f 0.8 0.8 0.8
- c 1072 885 m -2 3 d -19 -9 d 2 -5 d f 0.825 0.825 0.825 c 1055 870 m 3 1 d 16
- 11 d -2 3 d -19 -11 d f 0.85 0.85 0.85 c 1058 871 m 11 2 d 7 6 d -2 3 d f 0.875
- 0.875 0.875 c 1069 873 m 9 3 d -2 3 d f 0.625 0.625 0.625 c 1036 909 m -1 3 d
- -2 1 d f 0.65 0.65 0.65 c 1039 904 m -3 5 d -3 4 d -2 X f 0.675 0.675 0.675 c
- 1041 899 m -2 5 d -8 9 d -2 1 d f 0.7 0.7 0.7 c 1044 894 m -3 5 d -12 15 d -2 1
- d f 0.725 0.725 0.725 c 1046 889 m -2 5 d -17 21 d -2 X f 0.75 0.75 0.75 c 1048
- 884 m -2 5 d -21 26 d -3 1 d f 0.775 0.775 0.775 c 1051 879 m -3 5 d -26 32 d
- -2 1 d f 0.8 0.8 0.8 c 1053 874 m -2 5 d -31 38 d -2 X f 0.825 0.825 0.825 c
- 1049 868 m 6 2 d -2 4 d -35 43 d -2 1 d f 0.85 0.85 0.85 c 1031 864 m 18 4 d
- -33 50 d -2 1 d 15 -48 d f 0.875 0.875 0.875 c 1014 919 m -2 X 4 -12 d 13 -36 d
- f 0.9 0.9 0.9 c 1012 919 m -1 1 d 5 -13 d f 0.65 0.65 0.65 c 1008 871 m 1 X -5
- 1 d f 0.675 0.675 0.675 c 1009 871 m 3 -1 d -16 3 d 8 -1 d f 0.7 0.7 0.7 c 1012
- 870 m 3 -1 d -27 4 d 8 X f 0.725 0.725 0.725 c 1015 869 m 3 -1 d -27 12 d -3 -7
- d f 0.75 0.75 0.75 c 1018 868 m 3 -1 d -27 19 d -3 -6 d f 0.775 0.775 0.775 c
- 1021 867 m 3 -1 d -27 26 d -3 -6 d f 0.8 0.8 0.8 c 1024 866 m 2 -1 d -26 34 d
- -3 -7 d f 0.825 0.825 0.825 c 1026 865 m 3 X -25 40 d -4 -6 d f 0.85 0.85 0.85
- c 1029 865 m 2 -1 d -2 7 d -22 40 d -3 -6 d f 0.875 0.875 0.875 c 1029 871 m
- -13 36 d -6 11 d -3 -7 d f 0.9 0.9 0.9 c 1016 907 m -5 13 d -1 -2 d f 0.65 0.65
- 0.65 c 1001 865 m 7 6 d -4 1 d f 0.675 0.675 0.675 c 985 852 m 16 13 d 3 7 d -8
- 1 d -29 -17 d -3 -2 d f 0.7 0.7 0.7 c 996 873 m -9 X -20 -17 d f 0.725 0.725
- 0.725 c 988 873 m -1 X f 0.575 0.575 0.575 c 945 849 m -4 -1 d 3 2 d f 0.6 0.6
- 0.6 c 950 850 m -5 -1 d -1 1 d 3 1 d f 0.625 0.625 0.625 c 955 852 m -5 -2 d -3
- 1 d 3 2 d f 0.65 0.65 0.65 c 960 853 m -5 -1 d -5 1 d 3 2 d f 0.675 0.675 0.675
- c 984 852 m 1 X -21 2 d -4 -1 d -7 2 d 3 2 d f 0.7 0.7 0.7 c 969 857 m 15 -5 d
- -28 5 d 3 1 d f 0.725 0.725 0.725 c 961 859 m 8 -2 d -10 1 d f 0.575 0.575
- 0.575 c 944 850 m -3 -2 d -8 15 d f 0.6 0.6 0.6 c 947 851 m -3 -1 d -11 13 d -7
- 16 d f 0.625 0.625 0.625 c 950 853 m -3 -2 d -21 28 d -8 15 d f 0.65 0.65 0.65
- c 953 855 m -3 -2 d -32 41 d -1 2 d 2 -7 d f 0.675 0.675 0.675 c 956 857 m -3
- -2 d -34 34 d 2 -7 d f 0.7 0.7 0.7 c 959 858 m -3 -1 d -35 25 d 2 -7 d f 0.725
- 0.725 0.725 c 959 857 m 2 2 d -2 -1 d -36 17 d 2 -7 d f 0.75 0.75 0.75 c 955
- 852 m 4 5 d -34 11 d 3 -8 d f 0.775 0.775 0.775 c 952 846 m 3 6 d -27 8 d 2 -7
- d f 0.8 0.8 0.8 c 948 841 m 4 5 d -22 7 d 2 -7 d f 0.825 0.825 0.825 c 944 835
- m 4 6 d -16 5 d 2 -8 d f 0.85 0.85 0.85 c 940 830 m 4 5 d -10 3 d 2 -7 d f
- 0.875 0.875 0.875 c 938 827 m 2 3 d -4 1 d f 0.65 0.65 0.65 c 919 889 m -2 7 d
- -3 -3 d f 0.675 0.675 0.675 c 921 882 m -2 7 d -5 4 d -3 -2 d f 0.7 0.7 0.7 c
- 923 875 m -2 7 d -10 9 d -3 -3 d f 0.725 0.725 0.725 c 925 868 m -2 7 d -15 13
- d -3 -3 d f 0.75 0.75 0.75 c 928 860 m -3 8 d -20 17 d -4 -2 d f 0.775 0.775
- 0.775 c 930 853 m -2 7 d -27 23 d -3 -3 d f 0.8 0.8 0.8 c 932 846 m -2 7 d -32
- 27 d -3 -3 d f 0.825 0.825 0.825 c 934 838 m -2 8 d -37 31 d -1 -1 d 7 -18 d f
- 0.85 0.85 0.85 c 936 831 m -2 7 d -33 20 d 10 -28 d f 0.875 0.875 0.875 c 914
- 821 m 24 6 d -2 4 d -25 -1 d f 0.825 0.825 0.825 c 901 858 m -7 18 d -11 -9 d f
- 0.85 0.85 0.85 c 911 830 m -10 28 d -18 9 d -13 -10 d 12 -9 d f 0.875 0.875
- 0.875 c 891 841 m 23 -20 d -3 9 d -29 18 d f 0.575 0.575 0.575 c 847 851 m -1 Y
- f 0.6 0.6 0.6 c 849 852 m -2 -1 d -1 Y 5 -6 d f 0.625 0.625 0.625 c 851 852 m
- -2 X 3 -8 d 4 -6 d f 0.65 0.65 0.65 c 854 853 m -3 -1 d 5 -14 d 4 -6 d f 0.675
- 0.675 0.675 c 856 853 m -2 X 6 -21 d 5 -7 d f 0.7 0.7 0.7 c 867 822 m 2 1 d -11
- 31 d -2 -1 d 9 -28 d f 0.725 0.725 0.725 c 869 823 m 3 3 d -12 28 d -2 X f 0.75
- 0.75 0.75 c 872 826 m 4 3 d -14 26 d -2 -1 d f 0.775 0.775 0.775 c 876 829 m 3
- 3 d -15 23 d -2 X f 0.8 0.8 0.8 c 879 832 m 4 3 d -17 21 d -2 -1 d f 0.825
- 0.825 0.825 c 883 835 m 3 3 d -17 19 d -3 -1 d f 0.85 0.85 0.85 c 886 838 m 4 3
- d -8 7 d -12 9 d -1 X f 0.875 0.875 0.875 c 890 841 m 1 X -9 7 d f 0.575 0.575
- 0.575 c 844 789 m 2 4 d 1 57 d 1 Y -24 -46 d f 0.6 0.6 0.6 c 846 793 m 5 6 d 1
- 45 d -5 6 d f 0.625 0.625 0.625 c 851 799 m 4 7 d 1 32 d -4 6 d f 0.65 0.65
- 0.65 c 855 806 m 5 6 d 20 Y -4 6 d f 0.675 0.675 0.675 c 860 812 m 5 6 d 7 Y -5
- 7 d f 0.7 0.7 0.7 c 865 818 m 2 4 d -2 3 d f 0.55 0.55 0.55 c 820 783 m 1 X -20
- 16 d -1 X f 0.575 0.575 0.575 c 821 783 m 23 6 d -21 16 d -22 -6 d f 0.55 0.55
- 0.55 c 797 777 m 23 6 d -20 16 d -24 -6 d f 773 771 m 24 6 d -21 16 d -23 -6 d
- f 1874 1031 m 23 6 d -20 15 d -23 -6 d f 1850 1025 m 24 6 d -20 15 d -24 -6 d f
- 1850 1025 m -20 15 d -12 -3 d f 0.575 0.575 0.575 c 1827 1019 m 23 6 d -32 12 d
- -11 -3 d f 1825 1019 m 2 X -20 15 d -2 7 d f 0.6 0.6 0.6 c 1823 1020 m 2 -1 d
- -20 22 d -3 7 d f 0.625 0.625 0.625 c 1820 1021 m 3 -1 d -21 28 d -2 6 d f 0.65
- 0.65 0.65 c 1817 1022 m 3 -1 d -20 33 d -2 7 d f 0.675 0.675 0.675 c 1815 1023
- m 2 -1 d -19 39 d -2 6 d f 0.7 0.7 0.7 c 1812 1023 m 3 X -19 44 d -2 7 d f
- 0.725 0.725 0.725 c 1810 1024 m 2 -1 d -18 51 d -2 7 d f 0.75 0.75 0.75 c 1807
- 1025 m 3 -1 d -18 57 d -2 6 d f 0.775 0.775 0.775 c 1804 1026 m 3 -1 d -17 62 d
- -2 7 d f 0.8 0.8 0.8 c 1803 1026 m 1 X -16 68 d -2 6 d 11 -46 d f 0.825 0.825
- 0.825 c 1786 1100 m -2 7 d 2 -10 d 11 -43 d f 0.85 0.85 0.85 c 1784 1107 m -1 2
- d 3 -12 d f 0.6 0.6 0.6 c 1780 1020 m 2 1 d -14 X f 0.625 0.625 0.625 c 1782
- 1021 m 3 1 d -24 5 d -1 -5 d 8 -1 d f 0.65 0.65 0.65 c 1785 1022 m 3 X -24 15 d
- -3 -10 d f 0.675 0.675 0.675 c 1788 1022 m 3 1 d -25 24 d -2 -10 d f 0.7 0.7
- 0.7 c 1791 1023 m 3 1 d -25 32 d -3 -9 d f 0.725 0.725 0.725 c 1794 1024 m 3 1
- d -25 41 d -3 -10 d f 0.75 0.75 0.75 c 1797 1025 m 3 X -26 51 d -2 -10 d f
- 0.775 0.775 0.775 c 1800 1025 m 2 1 d -25 60 d -3 -10 d f 0.8 0.8 0.8 c 1802
- 1026 m 1 X -6 28 d -17 42 d -3 -10 d f 0.825 0.825 0.825 c 1797 1054 m -11 43 d
- -4 9 d -2 -10 d f 0.85 0.85 0.85 c 1786 1097 m -3 12 d -1 -3 d f 0.55 0.55 0.55
- c 1757 1001 m 9 8 d -12 -7 d f 0.575 0.575 0.575 c 1766 1009 m 11 9 d -25 -14 d
- 2 -2 d f 0.6 0.6 0.6 c 1777 1018 m 3 2 d -12 1 d -18 -15 d 2 -2 d f 0.625 0.625
- 0.625 c 1768 1021 m -8 1 d -2 X -11 -14 d 3 -2 d f 0.65 0.65 0.65 c 1758 1022 m
- -5 -1 d -8 -11 d 2 -2 d f 0.675 0.675 0.675 c 1753 1021 m -5 -2 d -6 -7 d 3 -2
- d f 0.7 0.7 0.7 c 1748 1019 m -5 -1 d -3 -5 d 2 -1 d f 0.725 0.725 0.725 c 1743
- 1018 m -4 -1 d -1 -2 d 2 -2 d f 0.75 0.75 0.75 c 1739 1017 m -3 -1 d 2 -1 d f
- 0.55 0.55 0.55 c 1748 1003 m 9 -2 d -3 1 d f 0.575 0.575 0.575 c 1739 1007 m 9
- -4 d 6 -1 d -2 2 d f 0.6 0.6 0.6 c 1733 1008 m 6 -1 d 13 -3 d -2 2 d -18 4 d f
- 0.625 0.625 0.625 c 1750 1006 m -3 2 d -17 6 d 2 -4 d f 0.65 0.65 0.65 c 1747
- 1008 m -2 2 d -17 8 d 2 -4 d f 0.675 0.675 0.675 c 1745 1010 m -3 2 d -16 10 d
- 2 -4 d f 0.7 0.7 0.7 c 1742 1012 m -2 1 d -16 13 d 2 -4 d f 0.725 0.725 0.725 c
- 1740 1013 m -2 2 d -15 15 d 1 -4 d f 0.75 0.75 0.75 c 1738 1015 m -2 1 d -2 4 d
- -13 14 d 2 -4 d f 0.775 0.775 0.775 c 1734 1020 m -5 7 d -10 11 d 2 -4 d f 0.8
- 0.8 0.8 c 1729 1027 m -5 8 d -7 7 d 2 -4 d f 0.825 0.825 0.825 c 1724 1035 m -6
- 7 d -3 4 d 2 -4 d f 0.85 0.85 0.85 c 1718 1042 m -5 8 d 2 -4 d f 0.875 0.875
- 0.875 c 1713 1050 m 1 Y -1 Y f 0.6 0.6 0.6 c 1710 989 m 23 19 d -1 2 d -25 -18
- d f 0.625 0.625 0.625 c 1732 1010 m -2 4 d -25 -18 d 2 -4 d f 0.65 0.65 0.65 c
- 1730 1014 m -2 4 d -26 -18 d 3 -4 d f 0.675 0.675 0.675 c 1728 1018 m -2 4 d
- -27 -19 d 3 -3 d f 0.7 0.7 0.7 c 1726 1022 m -2 4 d -27 -19 d 2 -4 d f 0.725
- 0.725 0.725 c 1724 1026 m -1 4 d -29 -19 d 3 -4 d f 0.75 0.75 0.75 c 1723 1030
- m -2 4 d -29 -20 d 2 -3 d f 0.775 0.775 0.775 c 1721 1034 m -2 4 d -30 -20 d 3
- -4 d f 0.8 0.8 0.8 c 1719 1038 m -2 4 d -20 -13 d -8 -11 d f 0.825 0.825 0.825
- c 1717 1042 m -2 4 d -11 -7 d -7 -10 d f 0.85 0.85 0.85 c 1715 1046 m -2 4 d -1
- -1 d -8 -10 d f 0.875 0.875 0.875 c 1713 1050 m 1 Y -1 -2 d f 0.575 0.575 0.575
- c 1686 983 m 20 5 d -21 -4 d f 0.6 0.6 0.6 c 1706 988 m 4 1 d -3 3 d -24 -7 d 2
- -1 d f 0.625 0.625 0.625 c 1707 992 m -2 4 d -24 -10 d 2 -1 d f 0.65 0.65 0.65
- c 1705 996 m -3 4 d -22 -12 d 1 -2 d f 0.675 0.675 0.675 c 1702 1000 m -3 3 d
- -21 -14 d 2 -1 d f 0.7 0.7 0.7 c 1699 1003 m -2 4 d -21 -17 d 2 -1 d f 0.725
- 0.725 0.725 c 1697 1007 m -3 4 d -19 -19 d 1 -2 d f 0.75 0.75 0.75 c 1694 1011
- m -2 3 d -19 -21 d 2 -1 d f 0.775 0.775 0.775 c 1692 1014 m -3 4 d -18 -24 d 2
- -1 d f 0.8 0.8 0.8 c 1689 1018 m -7 -6 d -13 -16 d 2 -2 d f 0.825 0.825 0.825 c
- 1682 1012 m -8 -7 d -6 -8 d 1 -1 d f 0.85 0.85 0.85 c 1674 1005 m -8 -6 d -1 Y
- 2 -1 d f 0.875 0.875 0.875 c 1666 999 m -1 Y f 0.575 0.575 0.575 c 1682 982 m 4
- 1 d -1 1 d f 0.6 0.6 0.6 c 1676 980 m 6 2 d 3 2 d -2 1 d f 0.625 0.625 0.625 c
- 1670 979 m 6 1 d 7 5 d -2 1 d f 0.65 0.65 0.65 c 1664 977 m 6 2 d 11 7 d -1 2 d
- f 0.675 0.675 0.675 c 1663 977 m 1 X 16 11 d -2 1 d -18 -4 d f 0.7 0.7 0.7 c
- 1678 989 m -2 1 d -20 4 d 4 -9 d f 0.725 0.725 0.725 c 1676 990 m -1 2 d -22 12
- d 3 -10 d f 0.75 0.75 0.75 c 1675 992 m -2 1 d -24 20 d 4 -9 d f 0.775 0.775
- 0.775 c 1673 993 m -2 1 d -25 28 d 3 -9 d f 0.8 0.8 0.8 c 1671 994 m -2 2 d -26
- 36 d 3 -10 d f 0.825 0.825 0.825 c 1669 996 m -1 1 d -15 20 d -11 16 d 1 -1 d f
- 0.85 0.85 0.85 c 1668 997 m -2 1 d -2 2 d -11 17 d f 0.875 0.875 0.875 c 1666
- 998 m -2 2 d f 0.675 0.675 0.675 c 1658 976 m 5 1 d -3 8 d f 0.7 0.7 0.7 c 1653
- 974 m 5 2 d 2 9 d -4 9 d f 0.725 0.725 0.725 c 1647 973 m 6 1 d 3 20 d -3 10 d
- f 0.75 0.75 0.75 c 1642 972 m 5 1 d 6 31 d -4 9 d f 0.775 0.775 0.775 c 1639
- 971 m 3 1 d 7 41 d -3 9 d -9 -46 d f 0.8 0.8 0.8 c 1646 1022 m -3 10 d -11 -47
- d 5 -9 d f 0.825 0.825 0.825 c 1643 1032 m -1 1 d -7 -6 d -7 -32 d 4 -10 d f
- 0.85 0.85 0.85 c 1635 1027 m -8 -7 d -4 -16 d 5 -9 d f 0.875 0.875 0.875 c 1627
- 1020 m -8 -7 d 4 -9 d f 0.75 0.75 0.75 c 1616 978 m 6 -2 d -8 3 d f 0.775 0.775
- 0.775 c 1622 976 m 17 -5 d -2 5 d -29 8 d 6 -5 d f 0.8 0.8 0.8 c 1637 976 m -5
- 9 d -30 4 d 6 -5 d f 0.825 0.825 0.825 c 1632 985 m -4 10 d -32 -2 d 6 -4 d f
- 0.85 0.85 0.85 c 1628 995 m -5 9 d -17 -1 d -11 -9 d 1 -1 d f 0.875 0.875 0.875
- c 1623 1004 m -4 9 d -13 -10 d f 0.75 0.75 0.75 c 1612 978 m 4 X -2 1 d f 0.775
- 0.775 0.775 c 1593 973 m 19 5 d 2 1 d -6 5 d f 0.8 0.8 0.8 c 1592 972 m 1 1 d
- 15 11 d -6 5 d -24 4 d f 0.825 0.825 0.825 c 1602 989 m -6 4 d -6 2 d -18 6 d 6
- -8 d f 0.85 0.85 0.85 c 1596 993 m -1 1 d -5 1 d f 0.625 0.625 0.625 c 1569 953
- m 3 3 d -5 1 d f 0.65 0.65 0.65 c 1572 956 m 3 2 d -10 3 d 2 -4 d f 0.675 0.675
- 0.675 c 1575 958 m 3 3 d -15 4 d 2 -4 d f 0.7 0.7 0.7 c 1578 961 m 4 3 d -21 5
- d 2 -4 d f 0.725 0.725 0.725 c 1582 964 m 3 3 d -26 5 d 2 -3 d f 0.75 0.75 0.75
- c 1585 967 m 4 2 d -32 7 d 2 -4 d f 0.775 0.775 0.775 c 1589 969 m 3 3 d -37 8
- d 2 -4 d f 0.8 0.8 0.8 c 1592 972 m -14 21 d -24 -9 d 1 -4 d f 0.825 0.825
- 0.825 c 1578 993 m -6 8 d -6 -1 d -14 -12 d 2 -4 d f 0.85 0.85 0.85 c 1566 1000
- m -10 -3 d -6 -5 d 2 -4 d f 0.875 0.875 0.875 c 1556 997 m -8 -2 d 2 -3 d f
- 0.575 0.575 0.575 c 1545 947 m 7 2 d -8 -1 d f 0.6 0.6 0.6 c 1552 949 m 16 4 d
- -25 -4 d 1 -1 d f 0.625 0.625 0.625 c 1568 953 m 1 X -2 4 d -26 -7 d 2 -1 d f
- 0.65 0.65 0.65 c 1567 957 m -2 4 d -26 -9 d 2 -2 d f 0.675 0.675 0.675 c 1565
- 961 m -2 4 d -25 -12 d 1 -1 d f 0.7 0.7 0.7 c 1563 965 m -2 4 d -25 -15 d 2 -1
- d f 0.725 0.725 0.725 c 1561 969 m -2 3 d -25 -17 d 2 -1 d f 0.75 0.75 0.75 c
- 1559 972 m -2 4 d -25 -19 d 2 -2 d f 0.775 0.775 0.775 c 1557 976 m -2 4 d -24
- -22 d 1 -1 d f 0.8 0.8 0.8 c 1555 980 m -1 4 d -25 -25 d 2 -1 d f 0.825 0.825
- 0.825 c 1554 984 m -2 4 d -25 -27 d 2 -2 d f 0.85 0.85 0.85 c 1552 988 m -2 4 d
- -24 -30 d 1 -1 d f 0.875 0.875 0.875 c 1550 992 m -2 3 d -23 -32 d 1 -1 d f
- 0.575 0.575 0.575 c 1522 941 m 23 6 d -1 1 d -27 -1 d f 0.6 0.6 0.6 c 1544 948
- m -1 1 d -38 16 d 12 -18 d f 0.625 0.625 0.625 c 1543 949 m -2 1 d -38 20 d -2
- X 4 -5 d f 0.65 0.65 0.65 c 1541 950 m -2 2 d -34 17 d -2 1 d f 0.675 0.675
- 0.675 c 1539 952 m -1 1 d -31 15 d -2 1 d f 0.7 0.7 0.7 c 1538 953 m -2 1 d -26
- 13 d -3 1 d f 0.725 0.725 0.725 c 1536 954 m -2 1 d -22 12 d -2 X f 0.75 0.75
- 0.75 c 1534 955 m -2 2 d -18 9 d -2 1 d f 0.775 0.775 0.775 c 1532 957 m -1 1 d
- -14 7 d -3 1 d f 0.8 0.8 0.8 c 1531 958 m -2 1 d -10 5 d -2 1 d f 0.825 0.825
- 0.825 c 1529 959 m -2 2 d -6 3 d -2 X f 0.85 0.85 0.85 c 1527 961 m -1 1 d -2 1
- d -3 1 d f 0.875 0.875 0.875 c 1526 962 m -1 1 d -1 X f 0.575 0.575 0.575 c
- 1512 939 m 10 2 d -5 6 d f 0.6 0.6 0.6 c 1498 935 m 14 4 d 5 8 d -12 18 d -10 7
- d -17 5 d f 0.625 0.625 0.625 c 1505 965 m -4 5 d -6 2 d f 0.6 0.6 0.6 c 1475
- 943 m 23 -8 d -20 42 d -24 -19 d f 1473 942 m 2 1 d -21 15 d f 0.625 0.625
- 0.625 c 1466 940 m 7 2 d -19 16 d -4 1 d f 0.65 0.65 0.65 c 1458 938 m 8 2 d
- -16 19 d -3 1 d f 0.675 0.675 0.675 c 1451 937 m 7 1 d -11 22 d -4 2 d 8 -25 d
- f 0.7 0.7 0.7 c 1443 962 m -3 1 d 5 -18 d 6 -8 d f 0.725 0.725 0.725 c 1440 963
- m -4 1 d 3 -10 d 6 -9 d f 0.75 0.75 0.75 c 1436 964 m -4 1 d 1 -3 d 6 -8 d f
- 0.775 0.775 0.775 c 1432 965 m -1 1 d 2 -4 d f 0.6 0.6 0.6 c 1428 917 m 5 5 d
- -8 -3 d f 0.625 0.625 0.625 c 1433 922 m 6 5 d -17 -6 d 3 -2 d f 0.65 0.65 0.65
- c 1439 927 m 6 5 d -25 -9 d 2 -2 d f 0.675 0.675 0.675 c 1445 932 m 6 5 d -34
- -12 d 3 -2 d f 0.7 0.7 0.7 c 1451 937 m -6 8 d -31 -18 d 3 -2 d f 0.725 0.725
- 0.725 c 1445 945 m -6 9 d -28 -24 d 3 -3 d f 0.75 0.75 0.75 c 1439 954 m -6 8 d
- -24 -30 d 2 -2 d f 0.775 0.775 0.775 c 1433 962 m -2 4 d -24 -33 d 2 -1 d f
- 0.475 0.475 0.475 c 1404 925 m 2 -1 d -3 1 d f 0.5 0.5 0.5 c 1406 924 m 5 -2 d
- -12 6 d 4 -3 d f 0.525 0.525 0.525 c 1411 922 m 5 -1 d -21 10 d 4 -3 d f 0.55
- 0.55 0.55 c 1416 921 m 6 -2 d -31 15 d 4 -3 d f 0.575 0.575 0.575 c 1422 919 m
- 5 -2 d -39 20 d 3 -3 d f 0.6 0.6 0.6 c 1427 917 m 1 X -3 2 d -41 21 d 4 -3 d f
- 0.625 0.625 0.625 c 1425 919 m -3 2 d -34 18 d -4 1 d f 0.65 0.65 0.65 c 1422
- 921 m -2 2 d -29 15 d -3 1 d f 0.675 0.675 0.675 c 1420 923 m -3 2 d -22 12 d
- -4 1 d f 0.7 0.7 0.7 c 1417 925 m -3 2 d -16 9 d -3 1 d f 0.725 0.725 0.725 c
- 1414 927 m -3 3 d -9 4 d -4 2 d f 0.75 0.75 0.75 c 1411 930 m -2 2 d -3 1 d -4
- 1 d f 0.775 0.775 0.775 c 1409 932 m -2 1 d -1 X f 0.475 0.475 0.475 c 1402 927
- m 2 -2 d -1 X f 0.5 0.5 0.5 c 1395 933 m 7 -6 d 1 -2 d -4 3 d f 0.525 0.525
- 0.525 c 1387 940 m 8 -7 d 4 -5 d -4 3 d f 0.55 0.55 0.55 c 1381 945 m 6 -5 d 8
- -9 d -4 3 d -11 12 d f 0.575 0.575 0.575 c 1391 934 m -3 3 d -11 9 d 3 X f 0.6
- 0.6 0.6 c 1388 937 m -4 3 d -10 6 d 3 X f 0.625 0.625 0.625 c 1384 940 m -6 2 d
- -8 5 d 4 -1 d f 0.65 0.65 0.65 c 1378 942 m -6 2 d -5 3 d 3 X f 0.675 0.675
- 0.675 c 1372 944 m -6 2 d -2 1 d 3 X f 0.7 0.7 0.7 c 1366 946 m -5 1 d 1 Y 3 -1
- d f 0.725 0.725 0.725 c 1361 947 m -1 1 d 1 X f 0.55 0.55 0.55 c 1380 945 m 1 X
- -1 1 d f 0.575 0.575 0.575 c 1376 941 m 4 4 d 1 Y -3 X f 0.6 0.6 0.6 c 1371 938
- m 5 3 d 1 5 d -3 X f 0.625 0.625 0.625 c 1367 934 m 4 4 d 3 8 d -4 1 d f 0.65
- 0.65 0.65 c 1362 930 m 5 4 d 3 13 d -3 X f 0.675 0.675 0.675 c 1358 927 m 4 3 d
- 5 17 d -3 X f 0.7 0.7 0.7 c 1357 926 m 1 1 d 6 20 d -3 1 d -7 -24 d f 0.725
- 0.725 0.725 c 1361 948 m -1 X -6 -9 d -5 -17 d 5 2 d f 0.75 0.75 0.75 c 1354
- 939 m -6 -9 d -3 -11 d 4 3 d f 0.775 0.775 0.775 c 1348 930 m -6 -9 d -2 -4 d 5
- 2 d f 0.8 0.8 0.8 c 1342 921 m -5 -6 d 3 2 d f 0.6 0.6 0.6 c 1334 920 m 1 X -19
- 13 d -3 3 d f 0.625 0.625 0.625 c 1335 920 m 7 2 d -23 9 d -3 2 d f 0.65 0.65
- 0.65 c 1342 922 m 7 2 d -28 5 d -2 2 d f 0.675 0.675 0.675 c 1349 924 m 7 2 d
- -32 X -3 3 d f 0.7 0.7 0.7 c 1356 926 m 1 X -3 -2 d -27 X -3 2 d f 0.725 0.725
- 0.725 c 1354 924 m -5 -2 d -20 -1 d -2 3 d f 0.75 0.75 0.75 c 1349 922 m -4 -3
- d -13 X -3 2 d f 0.775 0.775 0.775 c 1345 919 m -5 -2 d -5 X -3 2 d f 0.8 0.8
- 0.8 c 1340 917 m -3 -2 d -2 2 d f 0.575 0.575 0.575 c 1310 928 m 5 -2 d -7 X f
- 0.6 0.6 0.6 c 1315 926 m 19 -6 d -21 16 d -11 -10 d -3 -5 d 9 5 d f 0.625 0.625
- 0.625 c 1302 926 m -12 -10 d 9 5 d f 0.575 0.575 0.575 c 1309 926 m 1 2 d -2 -2
- d f 0.6 0.6 0.6 c 1306 919 m 3 7 d -1 X -9 -5 d f 0.625 0.625 0.625 c 1302 912
- m 4 7 d -7 2 d -9 -5 d f 0.65 0.65 0.65 c 1299 905 m 3 7 d -12 4 d -2 X f 0.675
- 0.675 0.675 c 1295 898 m 4 7 d -11 11 d -3 -1 d f 0.7 0.7 0.7 c 1292 891 m 3 7
- d -10 17 d -2 -1 d f 0.725 0.725 0.725 c 1288 884 m 4 7 d -9 23 d -2 X f 0.75
- 0.75 0.75 c 1287 881 m 1 3 d -7 30 d -3 -1 d 7 -29 d f 0.775 0.775 0.775 c 1278
- 913 m -2 X 5 -24 d 4 -5 d f 0.8 0.8 0.8 c 1276 913 m -2 -1 d 4 -18 d 3 -5 d f
- 0.825 0.825 0.825 c 1274 912 m -2 X 2 -13 d 4 -5 d f 0.85 0.85 0.85 c 1272 912
- m -3 -1 d 2 -7 d 3 -5 d f 0.875 0.875 0.875 c 1269 911 m -2 -1 d 1 -1 d 3 -5 d
- f 0.9 0.9 0.9 c 1267 910 m -1 X 2 -1 d f 0.75 0.75 0.75 c 1278 884 m 9 -3 d -2
- 3 d f 0.775 0.775 0.775 c 1263 889 m 15 -5 d 7 X -4 5 d f 0.8 0.8 0.8 c 1263
- 889 m 18 X -3 5 d -25 15 d f 0.825 0.825 0.825 c 1278 894 m -4 5 d -31 31 d 10
- -21 d f 0.85 0.85 0.85 c 1274 899 m -3 5 d -18 19 d -10 8 d -1 Y f 0.875 0.875
- 0.875 c 1271 904 m -3 5 d -5 4 d -10 10 d f 0.9 0.9 0.9 c 1268 909 m -2 1 d -3
- 3 d f 0.625 0.625 0.625 c 1220 899 m -1 -1 d 1 X f 0.65 0.65 0.65 c 1223 903 m
- -3 -4 d -1 Y 4 -3 d f 0.675 0.675 0.675 c 1226 907 m -3 -4 d 1 -8 d 4 -4 d f
- 0.7 0.7 0.7 c 1229 911 m -3 -4 d 2 -16 d 4 -3 d f 0.725 0.725 0.725 c 1231 915
- m -2 -4 d 3 -23 d 4 -3 d f 0.75 0.75 0.75 c 1240 883 m 3 1 d -9 35 d -3 -4 d 5
- -30 d f 0.775 0.775 0.775 c 1243 884 m 20 5 d -26 34 d -3 -4 d f 0.8 0.8 0.8 c
- 1263 889 m -10 20 d -13 18 d -3 -4 d f 0.825 0.825 0.825 c 1253 909 m -10 21 d
- 1 Y -3 -4 d f 0.85 0.85 0.85 c 1243 930 m 1 Y f 0.6 0.6 0.6 c 1198 905 m -2 1 d
- -1 Y f 0.625 0.625 0.625 c 1220 898 m -1 X -21 7 d -2 X 4 -5 d f 0.65 0.65 0.65
- c 1224 895 m -4 3 d -20 2 d 4 -6 d f 0.675 0.675 0.675 c 1228 891 m -4 4 d -20
- -1 d 4 -5 d f 0.7 0.7 0.7 c 1232 888 m -4 3 d -20 -2 d 4 -6 d f 0.725 0.725
- 0.725 c 1236 885 m -4 3 d -20 -5 d 4 -6 d f 0.75 0.75 0.75 c 1216 877 m 24 6 d
- -4 2 d -20 -8 d f 0.6 0.6 0.6 c 1196 905 m 1 Y f 0.625 0.625 0.625 c 1193 857 m
- 4 4 d 3 39 d -4 5 d 1 Y -3 -1 d -2 -44 d f 0.65 0.65 0.65 c 1197 861 m 5 4 d 2
- 29 d -4 6 d -7 5 d -2 -1 d -2 -38 d 2 -5 d f 0.675 0.675 0.675 c 1202 865 m 4 3
- d 2 21 d -4 5 d -13 10 d -3 X -2 -33 d 3 -5 d f 0.7 0.7 0.7 c 1206 868 m 5 4 d
- 1 11 d -4 6 d -20 15 d -2 -1 d -2 -27 d 2 -5 d f 0.725 0.725 0.725 c 1211 872 m
- 5 4 d 1 Y -4 6 d -26 20 d -3 -1 d -1 -22 d 2 -4 d f 0.75 0.75 0.75 c 1216 876 m
- 1 Y -33 25 d -3 X -17 Y 2 -5 d f 0.775 0.775 0.775 c 1180 902 m -2 -1 d -1 -11
- d 3 -5 d f 0.8 0.8 0.8 c 1178 901 m -3 -1 d -6 Y 2 -4 d f 0.825 0.825 0.825 c
- 1175 900 m -2 X -1 Y 2 -5 d f 0.85 0.85 0.85 c 1173 900 m -1 X 1 -1 d f 0.6 0.6
- 0.6 c 1169 851 m 20 5 d -21 -3 d f 0.625 0.625 0.625 c 1189 856 m 4 1 d -2 4 d
- -25 -5 d 2 -3 d f 0.65 0.65 0.65 c 1191 861 m -2 5 d -25 -8 d 2 -2 d f 0.675
- 0.675 0.675 c 1189 866 m -3 5 d -23 -10 d 1 -3 d f 0.7 0.7 0.7 c 1186 871 m -2
- 5 d -23 -12 d 2 -3 d f 0.725 0.725 0.725 c 1184 876 m -2 4 d -23 -14 d 2 -2 d f
- 0.75 0.75 0.75 c 1182 880 m -2 5 d -23 -16 d 2 -3 d f 0.775 0.775 0.775 c 1180
- 885 m -3 5 d -22 -19 d 2 -2 d f 0.8 0.8 0.8 c 1177 890 m -2 4 d -22 -20 d 2 -3
- d f 0.825 0.825 0.825 c 1175 894 m -2 5 d -22 -22 d 2 -3 d f 0.85 0.85 0.85 c
- 1173 899 m -1 1 d -16 -14 d -6 -7 d 1 -2 d f 0.875 0.875 0.875 c 1156 886 m -7
- -6 d 1 -1 d f 0.6 0.6 0.6 c 1167 852 m 2 -1 d -1 2 d f 0.625 0.625 0.625 c 1163
- 853 m 4 -1 d 1 1 d -2 3 d f 0.65 0.65 0.65 c 1159 855 m 4 -2 d 3 3 d -2 2 d f
- 0.675 0.675 0.675 c 1155 856 m 4 -1 d 5 3 d -1 3 d f 0.7 0.7 0.7 c 1151 857 m 4
- -1 d 8 5 d -2 3 d f 0.725 0.725 0.725 c 1147 858 m 4 -1 d 10 7 d -2 2 d f 0.75
- 0.75 0.75 c 1146 859 m 1 -1 d 12 8 d -2 3 d -16 -3 d f 0.775 0.775 0.775 c 1157
- 869 m -2 2 d -21 4 d 7 -9 d f 0.8 0.8 0.8 c 1155 871 m -2 3 d -25 10 d 6 -9 d f
- 0.825 0.825 0.825 c 1153 874 m -2 3 d -18 8 d -8 3 d 3 -4 d f 0.85 0.85 0.85 c
- 1151 877 m -1 2 d -5 3 d -12 3 d f 0.875 0.875 0.875 c 1150 879 m -1 1 d -4 2 d
- f 0.75 0.75 0.75 c 1129 855 m 17 4 d -5 7 d f 0.775 0.775 0.775 c 1122 853 m 7
- 2 d 12 11 d -7 9 d -15 -17 d f 0.8 0.8 0.8 c 1134 875 m -6 9 d -14 -19 d 5 -7 d
- f 0.825 0.825 0.825 c 1128 884 m -3 4 d -7 -2 d -9 -14 d 5 -7 d f 0.85 0.85
- 0.85 c 1118 886 m -11 -3 d -3 -4 d 5 -7 d f 0.875 0.875 0.875 c 1107 883 m -5
- -1 d 2 -3 d f 0.625 0.625 0.625 c 1099 833 m 1 1 d -2 X f 0.65 0.65 0.65 c 1100
- 834 m 4 4 d -8 X 2 -4 d f 0.675 0.675 0.675 c 1104 838 m 4 3 d -14 2 d 2 -5 d f
- 0.7 0.7 0.7 c 1108 841 m 4 4 d -20 2 d 2 -4 d f 0.725 0.725 0.725 c 1112 845 m
- 5 3 d -27 3 d 2 -4 d f 0.75 0.75 0.75 c 1117 848 m 4 4 d -33 3 d 2 -4 d f 0.775
- 0.775 0.775 c 1121 852 m 1 1 d -3 5 d -33 1 d 2 -4 d f 0.8 0.8 0.8 c 1119 858 m
- -5 7 d -30 -1 d 2 -5 d f 0.825 0.825 0.825 c 1114 865 m -5 7 d -27 -4 d 2 -4 d
- f 0.85 0.85 0.85 c 1109 872 m -5 7 d -24 -7 d 2 -4 d f 0.875 0.875 0.875 c 1104
- 879 m -2 3 d -24 -6 d 2 -4 d f 0.6 0.6 0.6 c 1075 827 m 9 3 d -10 -1 d f 0.625
- 0.625 0.625 c 1084 830 m 15 3 d -1 1 d -26 X 2 -5 d f 0.65 0.65 0.65 c 1098 834
- m -2 4 d -26 1 d 2 -5 d f 0.675 0.675 0.675 c 1096 838 m -2 5 d -26 X 2 -4 d f
- 0.7 0.7 0.7 c 1094 843 m -2 4 d -27 1 d 3 -5 d f 0.725 0.725 0.725 c 1092 847 m
- -2 4 d -27 2 d 2 -5 d f 0.75 0.75 0.75 c 1090 851 m -2 4 d -27 2 d 2 -4 d f
- 0.775 0.775 0.775 c 1088 855 m -2 4 d -27 3 d 2 -5 d f 0.8 0.8 0.8 c 1086 859 m
- -2 5 d -27 2 d 2 -4 d f 0.825 0.825 0.825 c 1084 864 m -2 4 d -24 3 d -3 -1 d 2
- -4 d f 0.85 0.85 0.85 c 1082 868 m -2 4 d -11 1 d -11 -2 d f 0.875 0.875 0.875
- c 1080 872 m -2 4 d -9 -3 d f 0.6 0.6 0.6 c 1074 829 m 1 -2 d -1 2 d f 0.625
- 0.625 0.625 c 1071 834 m 3 -5 d -2 5 d f 0.65 0.65 0.65 c 1068 838 m 3 -4 d 1 X
- -2 5 d f 0.675 0.675 0.675 c 1065 843 m 3 -5 d 2 1 d -2 4 d f 0.7 0.7 0.7 c
- 1062 847 m 3 -4 d 3 X -3 5 d f 0.725 0.725 0.725 c 1059 852 m 3 -5 d 3 1 d -2 5
- d f 0.75 0.75 0.75 c 1056 856 m 3 -4 d 4 1 d -2 4 d f 0.775 0.775 0.775 c 1053
- 861 m 3 -5 d 5 1 d -2 5 d f 0.8 0.8 0.8 c 1052 862 m 1 -1 d 6 1 d -2 4 d -11 -4
- d f 0.825 0.825 0.825 c 1057 866 m -2 4 d -6 -2 d -11 -5 d 8 -1 d f 0.85 0.85
- 0.85 c 1049 868 m -18 -4 d 7 -1 d f 0.65 0.65 0.65 c 1009 871 m -1 X 3 -7 d f
- 0.675 0.675 0.675 c 1012 870 m -3 1 d 2 -7 d 6 -18 d f 0.7 0.7 0.7 c 1015 869 m
- -3 1 d 5 -24 d 7 -17 d f 0.725 0.725 0.725 c 1028 815 m 3 5 d -13 48 d -3 1 d 9
- -40 d f 0.75 0.75 0.75 c 1031 820 m 9 19 d -19 28 d -3 1 d f 0.775 0.775 0.775
- c 1040 839 m 9 18 d -25 9 d -3 1 d f 0.8 0.8 0.8 c 1049 857 m 3 5 d -6 X -20 3
- d -2 1 d f 0.825 0.825 0.825 c 1046 862 m -8 1 d -9 2 d -3 X f 0.85 0.85 0.85 c
- 1038 863 m -7 1 d -2 1 d f 0.65 0.65 0.65 c 1011 864 m -3 7 d -7 -6 d f 0.675
- 0.675 0.675 c 1017 846 m -6 18 d -10 1 d -16 -13 d 1 -3 d f 0.7 0.7 0.7 c 1005
- 810 m 7 1 d 12 18 d -7 17 d -31 3 d f 0.725 0.725 0.725 c 1012 811 m 16 4 d -4
- 14 d f 0.6 0.6 0.6 c 981 804 m 3 X -4 4 d f 0.625 0.625 0.625 c 984 804 m 5 2 d
- -13 13 d 4 -11 d f 0.65 0.65 0.65 c 989 806 m 6 1 d -23 24 d 4 -12 d f 0.675
- 0.675 0.675 c 995 807 m 6 2 d -15 40 d -1 3 d -1 X -17 -10 d 5 -11 d f 0.7 0.7
- 0.7 c 1001 809 m 4 1 d -19 39 d -2 3 d -15 5 d -6 -4 d 4 -11 d f 0.725 0.725
- 0.725 c 969 857 m -8 2 d 2 -6 d f 0.6 0.6 0.6 c 958 798 m 23 6 d -1 4 d -24 -8
- d f 0.625 0.625 0.625 c 980 808 m -4 11 d -21 -17 d 1 -2 d f 0.65 0.65 0.65 c
- 976 819 m -4 12 d -19 -26 d 2 -3 d f 0.675 0.675 0.675 c 972 831 m -5 11 d -16
- -35 d 2 -2 d f 0.7 0.7 0.7 c 967 842 m -4 11 d -14 -43 d 2 -3 d f 0.725 0.725
- 0.725 c 963 853 m -2 6 d -2 -2 d -11 -45 d 1 -2 d f 0.75 0.75 0.75 c 959 857 m
- -4 -5 d -9 -37 d 2 -3 d f 0.775 0.775 0.775 c 955 852 m -3 -6 d -8 -29 d 2 -2 d
- f 0.8 0.8 0.8 c 952 846 m -4 -5 d -6 -21 d 2 -3 d f 0.825 0.825 0.825 c 948 841
- m -4 -6 d -4 -13 d 2 -2 d f 0.85 0.85 0.85 c 944 835 m -4 -5 d -1 -5 d 1 -3 d f
- 0.875 0.875 0.875 c 940 830 m -2 -3 d 1 -2 d f 0.6 0.6 0.6 c 934 792 m 24 6 d
- -2 2 d -23 -6 d f 0.625 0.625 0.625 c 956 800 m -1 2 d -24 -6 d 2 -2 d f 0.65
- 0.65 0.65 c 955 802 m -2 3 d -24 -6 d 2 -3 d f 0.675 0.675 0.675 c 953 805 m -2
- 2 d -24 -5 d 2 -3 d f 0.7 0.7 0.7 c 951 807 m -2 3 d -23 -6 d 1 -2 d f 0.725
- 0.725 0.725 c 949 810 m -1 2 d -24 -5 d 2 -3 d f 0.75 0.75 0.75 c 948 812 m -2
- 3 d -24 -6 d 2 -2 d f 0.775 0.775 0.775 c 946 815 m -2 2 d -24 -5 d 2 -3 d f
- 0.8 0.8 0.8 c 944 817 m -2 3 d -24 -6 d 2 -2 d f 0.825 0.825 0.825 c 942 820 m
- -2 2 d -24 -5 d 2 -3 d f 0.85 0.85 0.85 c 940 822 m -1 3 d -24 -5 d 1 -3 d f
- 0.875 0.875 0.875 c 939 825 m -1 2 d -24 -6 d 1 -1 d f 0.6 0.6 0.6 c 911 786 m
- 23 6 d -1 2 d -24 -4 d f 0.625 0.625 0.625 c 933 794 m -2 2 d -24 -1 d 2 -5 d f
- 0.65 0.65 0.65 c 931 796 m -2 3 d -23 1 d 1 -5 d f 0.675 0.675 0.675 c 929 799
- m -2 3 d -23 3 d 2 -5 d f 0.7 0.7 0.7 c 927 802 m -1 2 d -24 6 d 2 -5 d f 0.725
- 0.725 0.725 c 926 804 m -2 3 d -24 8 d 2 -5 d f 0.75 0.75 0.75 c 924 807 m -2 2
- d -24 11 d 2 -5 d f 0.775 0.775 0.775 c 922 809 m -2 3 d -24 13 d 2 -5 d f 0.8
- 0.8 0.8 c 920 812 m -2 2 d -23 16 d 1 -5 d f 0.825 0.825 0.825 c 918 814 m -2 3
- d -23 18 d 2 -5 d f 0.85 0.85 0.85 c 916 817 m -1 3 d -24 21 d 2 -6 d f 0.875
- 0.875 0.875 c 915 820 m -1 1 d -23 20 d f 0.6 0.6 0.6 c 887 780 m 24 6 d -2 4 d
- -26 -1 d f 0.625 0.625 0.625 c 909 790 m -2 5 d -29 3 d 5 -9 d f 0.65 0.65 0.65
- c 907 795 m -1 5 d -32 8 d 4 -10 d f 0.675 0.675 0.675 c 906 800 m -2 5 d -34
- 12 d 4 -9 d f 0.7 0.7 0.7 c 904 805 m -2 5 d -33 13 d -2 -1 d 3 -5 d f 0.725
- 0.725 0.725 c 902 810 m -2 5 d -28 11 d -3 -3 d f 0.75 0.75 0.75 c 900 815 m -2
- 5 d -22 9 d -4 -3 d f 0.775 0.775 0.775 c 898 820 m -2 5 d -17 7 d -3 -3 d f
- 0.8 0.8 0.8 c 896 825 m -1 5 d -12 5 d -4 -3 d f 0.825 0.825 0.825 c 895 830 m
- -2 5 d -7 3 d -3 -3 d f 0.85 0.85 0.85 c 893 835 m -2 6 d -1 X -4 -3 d f 0.875
- 0.875 0.875 c 891 841 m -1 X f 0.575 0.575 0.575 c 864 774 m 23 6 d -41 13 d -2
- -4 d f 0.6 0.6 0.6 c 887 780 m -4 9 d -32 10 d -5 -6 d f 0.625 0.625 0.625 c
- 883 789 m -5 9 d -23 8 d -4 -7 d f 0.65 0.65 0.65 c 878 798 m -4 10 d -14 4 d
- -5 -6 d f 0.675 0.675 0.675 c 874 808 m -4 9 d -5 1 d -5 -6 d f 0.7 0.7 0.7 c
- 870 817 m -3 5 d -2 -4 d f 0.55 0.55 0.55 c 840 768 m 1 X -20 15 d -1 X f 0.575
- 0.575 0.575 c 841 768 m 23 6 d -20 15 d -23 -6 d f 0.55 0.55 0.55 c 817 762 m
- 23 6 d -20 15 d -23 -6 d f 793 756 m 24 6 d -20 15 d -24 -6 d f 1894 1015 m 24
- 6 d -21 16 d -23 -6 d f 1871 1009 m 23 6 d -20 16 d -24 -6 d f 1869 1009 m 2 X
- -21 16 d f 0.575 0.575 0.575 c 1847 1003 m 22 6 d -19 16 d -23 -6 d f 1824 997
- m 23 6 d -20 16 d -2 X -1 -21 d f 0.6 0.6 0.6 c 1825 1019 m -2 1 d -2 -19 d 3
- -3 d f 0.625 0.625 0.625 c 1823 1020 m -3 1 d -1 -17 d 2 -3 d f 0.65 0.65 0.65
- c 1820 1021 m -3 1 d -1 -14 d 3 -4 d f 0.675 0.675 0.675 c 1817 1022 m -2 1 d
- -1 -12 d 2 -3 d f 0.7 0.7 0.7 c 1815 1023 m -3 X -8 Y 2 -4 d f 0.725 0.725
- 0.725 c 1812 1023 m -2 1 d -1 -6 d 3 -3 d f 0.75 0.75 0.75 c 1810 1024 m -3 1 d
- -3 Y 2 -4 d f 0.775 0.775 0.775 c 1807 1025 m -3 1 d -1 Y 3 -3 d f 0.8 0.8 0.8
- c 1804 1026 m -1 X 1 -1 d f 0.575 0.575 0.575 c 1800 991 m 24 6 d 1 Y -30 2 d f
- 0.6 0.6 0.6 c 1824 998 m -3 3 d -39 20 d -2 -1 d 14 -20 d f 0.625 0.625 0.625 c
- 1821 1001 m -2 3 d -34 18 d -3 -1 d f 0.65 0.65 0.65 c 1819 1004 m -3 4 d -28
- 14 d -3 X f 0.675 0.675 0.675 c 1816 1008 m -2 3 d -23 12 d -3 -1 d f 0.7 0.7
- 0.7 c 1814 1011 m -2 4 d -18 9 d -3 -1 d f 0.725 0.725 0.725 c 1812 1015 m -3 3
- d -12 7 d -3 -1 d f 0.75 0.75 0.75 c 1809 1018 m -2 4 d -7 3 d -3 X f 0.775
- 0.775 0.775 c 1807 1022 m -3 3 d -2 1 d -2 -1 d f 0.8 0.8 0.8 c 1804 1025 m -1
- 1 d -1 X f 0.55 0.55 0.55 c 1766 1009 m -9 -8 d 9 -1 d f 0.575 0.575 0.575 c
- 1777 999 m 23 -8 d -6 9 d -17 18 d -11 -9 d -9 Y f 0.6 0.6 0.6 c 1794 1000 m
- -14 20 d -3 -2 d f 0.55 0.55 0.55 c 1766 1000 m -9 1 d -9 2 d f 0.575 0.575
- 0.575 c 1753 993 m 24 6 d -11 1 d -18 3 d -9 4 d 8 -10 d f 0.6 0.6 0.6 c 1739
- 1007 m -6 1 d 14 -11 d f 0.55 0.55 0.55 c 1730 973 m 5 4 d -8 -1 d f 0.575
- 0.575 0.575 c 1735 977 m 18 16 d -6 4 d -36 -10 d 16 -11 d f 0.6 0.6 0.6 c 1747
- 997 m -14 11 d -23 -19 d 1 -2 d f 0.55 0.55 0.55 c 1706 967 m 24 6 d -3 3 d -33
- 1 d f 0.575 0.575 0.575 c 1727 976 m -16 11 d -5 1 d -20 -5 d 8 -6 d f 0.6 0.6
- 0.6 c 1711 987 m -1 2 d -4 -1 d f 0.55 0.55 0.55 c 1683 988 m 23 -21 d -12 10 d
- -11 11 d f 0.575 0.575 0.575 c 1694 977 m -8 6 d -4 -1 d -4 4 d 5 2 d f 0.6 0.6
- 0.6 c 1682 982 m -6 -2 d -3 3 d 5 3 d f 0.625 0.625 0.625 c 1676 980 m -6 -1 d
- -2 1 d 5 3 d f 0.65 0.65 0.65 c 1670 979 m -6 -2 d -1 X 5 3 d f 0.675 0.675
- 0.675 c 1664 977 m -1 X f 0.55 0.55 0.55 c 1682 988 m 1 X f 0.575 0.575 0.575 c
- 1659 955 m 23 33 d 1 X -5 -2 d -20 -30 d f 0.6 0.6 0.6 c 1678 986 m -5 -3 d -17
- -25 d 2 -2 d f 0.625 0.625 0.625 c 1673 983 m -5 -3 d -15 -20 d 3 -2 d f 0.65
- 0.65 0.65 c 1668 980 m -5 -3 d -12 -15 d 2 -2 d f 0.675 0.675 0.675 c 1663 977
- m -5 -1 d -10 -12 d 3 -2 d f 0.7 0.7 0.7 c 1658 976 m -5 -2 d -8 -8 d 3 -2 d f
- 0.725 0.725 0.725 c 1653 974 m -6 -1 d -4 -5 d 2 -2 d f 0.75 0.75 0.75 c 1647
- 973 m -5 -1 d -2 -2 d 3 -2 d f 0.775 0.775 0.775 c 1642 972 m -3 -1 d 1 -1 d f
- 0.575 0.575 0.575 c 1636 949 m 23 6 d -1 1 d -22 -6 d f 0.6 0.6 0.6 c 1658 956
- m -2 2 d -23 -4 d 3 -4 d f 0.625 0.625 0.625 c 1656 958 m -3 2 d -23 -2 d 3 -4
- d f 0.65 0.65 0.65 c 1653 960 m -2 2 d -24 X 3 -4 d f 0.675 0.675 0.675 c 1651
- 962 m -3 2 d -24 3 d 3 -5 d f 0.7 0.7 0.7 c 1648 964 m -3 2 d -24 5 d 3 -4 d f
- 0.725 0.725 0.725 c 1645 966 m -2 2 d -25 7 d 3 -4 d f 0.75 0.75 0.75 c 1643
- 968 m -3 2 d -18 6 d -6 2 d 2 -3 d f 0.775 0.775 0.775 c 1640 970 m -1 1 d -17
- 5 d f 0.575 0.575 0.575 c 1612 943 m 24 6 d 1 Y -24 -7 d f 0.6 0.6 0.6 c 1636
- 950 m -3 4 d -23 -7 d 2 -4 d f 0.625 0.625 0.625 c 1633 954 m -3 4 d -23 -7 d 3
- -4 d f 0.65 0.65 0.65 c 1630 958 m -3 4 d -22 -8 d 2 -3 d f 0.675 0.675 0.675 c
- 1627 962 m -3 5 d -22 -9 d 3 -4 d f 0.7 0.7 0.7 c 1624 967 m -3 4 d -21 -10 d 2
- -3 d f 0.725 0.725 0.725 c 1621 971 m -3 4 d -21 -10 d 3 -4 d f 0.75 0.75 0.75
- c 1618 975 m -2 3 d -4 X -17 -9 d 2 -4 d f 0.775 0.775 0.775 c 1612 978 m -19
- -5 d -1 -1 d 3 -3 d f 0.8 0.8 0.8 c 1593 973 m -1 -1 d f 0.575 0.575 0.575 c
- 1589 937 m 23 6 d -32 1 d f 0.6 0.6 0.6 c 1612 943 m -2 4 d -41 5 d 11 -8 d f
- 0.625 0.625 0.625 c 1610 947 m -3 4 d -35 5 d -3 -3 d -1 Y f 0.65 0.65 0.65 c
- 1607 951 m -2 3 d -30 4 d -3 -2 d f 0.675 0.675 0.675 c 1605 954 m -3 4 d -24 3
- d -3 -3 d f 0.7 0.7 0.7 c 1602 958 m -2 3 d -18 3 d -4 -3 d f 0.725 0.725 0.725
- c 1600 961 m -3 4 d -12 2 d -3 -3 d f 0.75 0.75 0.75 c 1597 965 m -2 4 d -6 X
- -4 -2 d f 0.775 0.775 0.775 c 1595 969 m -3 3 d -3 -3 d f 0.8 0.8 0.8 c 1592
- 972 m f 0.55 0.55 0.55 c 1565 932 m 2 X -2 X f 0.575 0.575 0.575 c 1567 932 m
- 22 5 d -9 7 d -28 5 d -7 -2 d 20 -15 d f 0.6 0.6 0.6 c 1580 944 m -11 8 d -1 1
- d -16 -4 d f 0.625 0.625 0.625 c 1569 952 m 1 Y -1 X f 0.55 0.55 0.55 c 1542
- 926 m 23 6 d -26 -4 d f 0.575 0.575 0.575 c 1565 932 m -20 15 d -23 -6 d 17 -13
- d f 0.55 0.55 0.55 c 1536 927 m 6 -1 d -3 2 d f 0.575 0.575 0.575 c 1518 933 m
- 18 -6 d 3 1 d -17 13 d -10 -2 d -5 -5 d f 0.6 0.6 0.6 c 1512 939 m -14 -4 d 9
- -1 d f 0.575 0.575 0.575 c 1502 919 m 16 14 d -11 1 d f 0.6 0.6 0.6 c 1495 914
- m 7 5 d 5 15 d -9 1 d -23 8 d f 1490 915 m 5 -1 d -20 29 d -2 -1 d f 0.625
- 0.625 0.625 c 1484 917 m 6 -2 d -17 27 d -7 -2 d f 0.65 0.65 0.65 c 1478 919 m
- 6 -2 d -18 23 d -8 -2 d f 0.675 0.675 0.675 c 1472 921 m 6 -2 d -20 19 d -7 -1
- d 10 -8 d f 0.7 0.7 0.7 c 1471 921 m 1 X -11 8 d f 0.6 0.6 0.6 c 1433 922 m -5
- -5 d 6 -5 d f 0.625 0.625 0.625 c 1439 927 m -6 -5 d 1 -10 d 7 -5 d f 0.65 0.65
- 0.65 c 1448 902 m 1 1 d -4 29 d -6 -5 d 2 -20 d f 0.675 0.675 0.675 c 1449 903
- m 21 17 d -9 9 d -10 8 d -6 -5 d f 0.7 0.7 0.7 c 1470 920 m 1 1 d -10 8 d f
- 0.475 0.475 0.475 c 1406 924 m -2 1 d 1 -1 d f 0.5 0.5 0.5 c 1411 922 m -5 2 d
- -1 X 4 -3 d f 0.525 0.525 0.525 c 1416 921 m -5 1 d -2 -1 d 4 -4 d f 0.55 0.55
- 0.55 c 1422 919 m -6 2 d -3 -4 d 5 -3 d f 0.575 0.575 0.575 c 1427 917 m -5 2 d
- -4 -5 d 4 -3 d f 0.6 0.6 0.6 c 1425 909 m 2 -1 d 7 4 d -6 5 d -1 X -5 -6 d f
- 0.625 0.625 0.625 c 1427 908 m 11 -3 d 3 2 d -7 5 d f 0.65 0.65 0.65 c 1438 905
- m 10 -3 d -7 5 d f 0.475 0.475 0.475 c 1405 924 m -1 1 d -2 2 d f 0.5 0.5 0.5 c
- 1409 921 m -4 3 d -3 3 d -7 6 d f 0.525 0.525 0.525 c 1413 917 m -4 4 d -14 12
- d -8 7 d f 0.55 0.55 0.55 c 1418 914 m -5 3 d -26 23 d -6 5 d f 0.575 0.575
- 0.575 c 1422 911 m -4 3 d -37 31 d 2 -2 d f 0.6 0.6 0.6 c 1424 909 m 1 X -3 2 d
- -39 32 d 1 -3 d f 0.625 0.625 0.625 c 1421 910 m 3 -1 d -40 31 d 2 -2 d f 0.65
- 0.65 0.65 c 1419 911 m 2 -1 d -35 28 d 2 -3 d f 0.675 0.675 0.675 c 1416 912 m
- 3 -1 d -31 24 d 2 -3 d f 0.7 0.7 0.7 c 1414 912 m 2 X -26 20 d 2 -2 d f 0.725
- 0.725 0.725 c 1412 913 m 2 -1 d -22 18 d 1 -3 d f 0.75 0.75 0.75 c 1409 914 m 3
- -1 d -19 14 d 2 -2 d f 0.775 0.775 0.775 c 1407 915 m 2 -1 d -14 11 d 2 -3 d f
- 0.8 0.8 0.8 c 1404 916 m 3 -1 d -10 7 d 2 -2 d f 0.825 0.825 0.825 c 1402 916 m
- 2 X -5 4 d 2 -3 d f 0.85 0.85 0.85 c 1401 917 m 1 -1 d -1 1 d f 0.55 0.55 0.55
- c 1381 945 m -1 X f 0.575 0.575 0.575 c 1383 943 m -2 2 d -1 X -4 -4 d f 0.6
- 0.6 0.6 c 1384 940 m -1 3 d -7 -2 d -5 -3 d f 0.625 0.625 0.625 c 1378 884 m 1
- 2 d 7 52 d -2 2 d -13 -2 d -4 -4 d 7 -42 d f 0.65 0.65 0.65 c 1379 886 m 3 3 d
- 6 46 d -2 3 d -19 -4 d -5 -4 d 4 -23 d 8 -15 d f 0.675 0.675 0.675 c 1382 889 m
- 2 4 d 6 39 d -2 3 d -26 -5 d -4 -3 d 1 -4 d 7 -16 d f 0.7 0.7 0.7 c 1384 893 m
- 3 4 d 5 33 d -2 2 d -32 -5 d -1 -1 d 2 -3 d f 0.725 0.725 0.725 c 1387 897 m 3
- 4 d 3 26 d -1 3 d f 0.75 0.75 0.75 c 1390 901 m 2 3 d 3 21 d -2 2 d f 0.775
- 0.775 0.775 c 1392 904 m 3 4 d 2 14 d -2 3 d f 0.8 0.8 0.8 c 1395 908 m 3 4 d 1
- 8 d -2 2 d f 0.825 0.825 0.825 c 1398 912 m 2 3 d 1 2 d -2 3 d f 0.85 0.85 0.85
- c 1400 915 m 1 2 d f 0.6 0.6 0.6 c 1354 878 m 7 1 d -26 41 d -1 X f 0.625 0.625
- 0.625 c 1361 879 m 17 5 d -4 8 d -32 30 d -7 -2 d f 0.65 0.65 0.65 c 1374 892 m
- -8 15 d -17 17 d -7 -2 d f 0.675 0.675 0.675 c 1366 907 m -7 16 d -3 3 d -7 -2
- d f 0.7 0.7 0.7 c 1359 923 m -2 3 d -1 X f 0.575 0.575 0.575 c 1315 926 m -5 2
- d 2 -6 d f 0.6 0.6 0.6 c 1351 877 m 3 1 d -20 42 d -19 6 d -3 -4 d 9 -23 d f
- 0.625 0.625 0.625 c 1334 873 m 17 4 d -30 22 d 8 -23 d f 0.65 0.65 0.65 c 1331
- 872 m 3 1 d -5 3 d f 0.575 0.575 0.575 c 1307 866 m 4 1 d 1 55 d -2 6 d -1 -2 d
- -3 -59 d f 0.6 0.6 0.6 c 1311 867 m 9 2 d 1 30 d -9 23 d -3 4 d -3 -7 d -3 -50
- d 3 -2 d f 0.625 0.625 0.625 c 1320 869 m 9 2 d 5 Y -8 23 d -15 20 d -4 -7 d -2
- -41 d 3 -2 d f 0.65 0.65 0.65 c 1329 871 m 2 1 d -2 4 d -27 36 d -3 -7 d -2 -31
- d 3 -3 d f 0.675 0.675 0.675 c 1299 905 m -4 -7 d -1 -22 d 3 -2 d f 0.7 0.7 0.7
- c 1295 898 m -3 -7 d -1 -13 d 3 -2 d f 0.725 0.725 0.725 c 1292 891 m -4 -7 d
- -4 Y 3 -2 d f 0.75 0.75 0.75 c 1288 884 m -1 -3 d 1 -1 d f 0.575 0.575 0.575 c
- 1284 860 m 23 6 d -1 1 d -23 -7 d f 0.6 0.6 0.6 c 1306 867 m -3 2 d -22 -5 d 2
- -4 d f 0.625 0.625 0.625 c 1303 869 m -3 2 d -22 -4 d 3 -3 d f 0.65 0.65 0.65 c
- 1300 871 m -3 3 d -21 -3 d 2 -4 d f 0.675 0.675 0.675 c 1297 874 m -3 2 d -21
- -2 d 3 -3 d f 0.7 0.7 0.7 c 1294 876 m -3 2 d -20 X 2 -4 d f 0.725 0.725 0.725
- c 1291 878 m -3 2 d -20 2 d 3 -4 d f 0.75 0.75 0.75 c 1288 880 m -1 1 d -9 3 d
- -12 1 d 2 -3 d f 0.775 0.775 0.775 c 1278 884 m -15 5 d 3 -4 d f 0.8 0.8 0.8 c
- 1263 889 m f 0.575 0.575 0.575 c 1279 859 m 5 1 d -1 X f 0.6 0.6 0.6 c 1260 854
- m 19 5 d 4 1 d -2 4 d -23 -8 d f 0.625 0.625 0.625 c 1281 864 m -3 3 d -23 -6 d
- 3 -5 d f 0.65 0.65 0.65 c 1278 867 m -2 4 d -24 -6 d 3 -4 d f 0.675 0.675 0.675
- c 1276 871 m -3 3 d -24 -4 d 3 -5 d f 0.7 0.7 0.7 c 1273 874 m -2 4 d -25 -4 d
- 3 -4 d f 0.725 0.725 0.725 c 1271 878 m -3 4 d -26 -3 d 4 -5 d f 0.75 0.75 0.75
- c 1268 882 m -2 3 d -23 -1 d -3 -1 d 2 -4 d f 0.775 0.775 0.775 c 1266 885 m -3
- 4 d -20 -5 d f 0.8 0.8 0.8 c 1263 889 m f 0.6 0.6 0.6 c 1246 858 m 14 -4 d -2 2
- d f 0.625 0.625 0.625 c 1237 861 m 9 -3 d 12 -2 d -3 5 d -21 2 d f 0.65 0.65
- 0.65 c 1255 861 m -3 4 d -22 2 d 4 -4 d f 0.675 0.675 0.675 c 1252 865 m -3 5 d
- -24 X 5 -3 d f 0.7 0.7 0.7 c 1249 870 m -3 4 d -25 -1 d 4 -3 d f 0.725 0.725
- 0.725 c 1246 874 m -4 5 d -25 -3 d 4 -3 d f 0.75 0.75 0.75 c 1242 879 m -2 4 d
- -24 -6 d 1 -1 d f 0.575 0.575 0.575 c 1213 842 m 9 8 d -18 -1 d f 0.6 0.6 0.6 c
- 1222 850 m 11 8 d -39 -2 d 10 -7 d f 0.625 0.625 0.625 c 1233 858 m 4 3 d -3 2
- d -37 -2 d -4 -4 d 1 -1 d f 0.65 0.65 0.65 c 1234 863 m -4 4 d -28 -2 d -5 -4 d
- f 0.675 0.675 0.675 c 1230 867 m -5 3 d -19 -2 d -4 -3 d f 0.7 0.7 0.7 c 1225
- 870 m -4 3 d -10 -1 d -5 -4 d f 0.725 0.725 0.725 c 1221 873 m -4 3 d -1 X -5
- -4 d f 0.75 0.75 0.75 c 1217 876 m -1 1 d -1 Y f 0.575 0.575 0.575 c 1190 836 m
- 23 6 d -9 7 d -29 -2 d f 0.6 0.6 0.6 c 1204 849 m -10 7 d -5 X -20 -5 d 6 -4 d
- f 0.625 0.625 0.625 c 1194 856 m -1 1 d -4 -1 d f 0.575 0.575 0.575 c 1185 837
- m 5 -1 d -15 11 d f 0.6 0.6 0.6 c 1181 839 m 4 -2 d -10 10 d -6 4 d -2 1 d f
- 0.625 0.625 0.625 c 1176 840 m 5 -1 d -14 13 d -4 1 d f 0.65 0.65 0.65 c 1171
- 842 m 5 -2 d -13 13 d -4 2 d f 0.675 0.675 0.675 c 1166 843 m 5 -1 d -12 13 d
- -4 1 d f 0.7 0.7 0.7 c 1166 843 m -11 13 d -4 1 d 6 -7 d f 0.725 0.725 0.725 c
- 1151 857 m -4 1 d 1 -1 d 9 -7 d f 0.75 0.75 0.75 c 1147 858 m -1 1 d 2 -2 d f
- 0.6 0.6 0.6 c 1143 824 m 3 3 d -5 -1 d f 0.625 0.625 0.625 c 1146 827 m 7 5 d
- -15 -2 d 3 -4 d f 0.65 0.65 0.65 c 1153 832 m 6 6 d -24 -3 d 3 -5 d f 0.675
- 0.675 0.675 c 1159 838 m 7 5 d -34 -4 d 3 -4 d f 0.7 0.7 0.7 c 1166 843 m -9 7
- d -28 -7 d 3 -4 d f 0.725 0.725 0.725 c 1157 850 m -9 7 d -22 -10 d 3 -4 d f
- 0.75 0.75 0.75 c 1148 857 m -2 2 d -17 -4 d -6 -3 d 3 -5 d f 0.775 0.775 0.775
- c 1129 855 m -7 -2 d 1 -1 d f 0.575 0.575 0.575 c 1119 818 m 15 4 d -21 1 d f
- 0.6 0.6 0.6 c 1134 822 m 9 2 d -2 2 d -36 3 d 8 -6 d f 0.625 0.625 0.625 c 1141
- 826 m -3 4 d -38 4 d -1 -1 d 6 -4 d f 0.65 0.65 0.65 c 1138 830 m -3 5 d -31 3
- d -4 -4 d f 0.675 0.675 0.675 c 1135 835 m -3 4 d -24 2 d -4 -3 d f 0.7 0.7 0.7
- c 1132 839 m -3 4 d -17 2 d -4 -4 d f 0.725 0.725 0.725 c 1129 843 m -3 4 d -9
- 1 d -5 -3 d f 0.75 0.75 0.75 c 1126 847 m -3 5 d -2 X -4 -4 d f 0.775 0.775
- 0.775 c 1123 852 m -1 1 d -1 -1 d f 0.575 0.575 0.575 c 1096 812 m 23 6 d -6 5
- d -29 -2 d f 0.6 0.6 0.6 c 1113 823 m -8 6 d -21 1 d -9 -3 d 9 -6 d f 0.625
- 0.625 0.625 c 1105 829 m -6 4 d -15 -3 d f 0.575 0.575 0.575 c 1093 813 m 3 -1
- d -12 9 d f 0.6 0.6 0.6 c 1090 814 m 3 -1 d -9 8 d -9 6 d -1 2 d f 0.625 0.625
- 0.625 c 1086 815 m 4 -1 d -16 15 d -3 5 d f 0.65 0.65 0.65 c 1083 816 m 3 -1 d
- -15 19 d -3 4 d f 0.675 0.675 0.675 c 1079 817 m 4 -1 d -15 22 d -3 5 d f 0.7
- 0.7 0.7 c 1076 818 m 3 -1 d -14 26 d -3 4 d f 0.725 0.725 0.725 c 1072 819 m 4
- -1 d -14 29 d -3 5 d 13 -32 d f 0.75 0.75 0.75 c 1059 852 m -3 4 d 7 -17 d 9
- -19 d f 0.775 0.775 0.775 c 1056 856 m -3 5 d 1 -4 d 9 -18 d f 0.8 0.8 0.8 c
- 1053 861 m -1 1 d 2 -5 d f 0.625 0.625 0.625 c 1049 800 m -1 X f 0.65 0.65 0.65
- c 1049 800 m 6 5 d -12 -1 d 5 -4 d f 0.675 0.675 0.675 c 1055 805 m 6 5 d -23
- -2 d 5 -4 d f 0.7 0.7 0.7 c 1061 810 m 6 5 d -35 -3 d 6 -4 d f 0.725 0.725
- 0.725 c 1067 815 m 5 4 d 1 Y -41 X -3 -5 d 4 -3 d f 0.75 0.75 0.75 c 1072 820 m
- -9 19 d -23 X -9 -19 d f 0.775 0.775 0.775 c 1063 839 m -9 18 d -5 X -9 -18 d f
- 0.8 0.8 0.8 c 1054 857 m -2 5 d -3 -5 d f 0.55 0.55 0.55 c 1025 807 m f 0.575
- 0.575 0.575 c 1025 807 m 8 -2 d -11 3 d 3 -1 d f 0.6 0.6 0.6 c 1033 805 m 8 -3
- d -23 6 d 4 X f 0.625 0.625 0.625 c 1041 802 m 8 -2 d -1 X -34 9 d 4 -1 d f
- 0.65 0.65 0.65 c 1048 800 m -5 4 d -32 5 d 3 X f 0.675 0.675 0.675 c 1043 804 m
- -5 4 d -31 1 d 4 X f 0.7 0.7 0.7 c 1038 808 m -6 4 d -20 -1 d -7 -1 d 2 -1 d f
- 0.725 0.725 0.725 c 1032 812 m -4 3 d -16 -4 d f 0.55 0.55 0.55 c 1022 805 m 3
- 2 d f 0.575 0.575 0.575 c 1002 788 m 20 17 d 3 2 d -3 1 d -33 -11 d f 0.6 0.6
- 0.6 c 1022 808 m -4 X -34 -4 d -3 X 8 -7 d f 0.625 0.625 0.625 c 1018 808 m -4
- 1 d -25 -3 d -5 -2 d f 0.65 0.65 0.65 c 1014 809 m -3 X -16 -2 d -6 -1 d f
- 0.675 0.675 0.675 c 1011 809 m -10 X -6 -2 d f 0.7 0.7 0.7 c 1007 809 m -2 1 d
- -4 -1 d f 0.55 0.55 0.55 c 978 782 m 3 1 d -3 -1 d f 0.575 0.575 0.575 c 981
- 783 m 21 5 d -13 9 d -28 -2 d 17 -13 d f 0.6 0.6 0.6 c 989 797 m -8 7 d -23 -6
- d 3 -3 d f 0.55 0.55 0.55 c 955 776 m 23 6 d -23 -6 d f 0.575 0.575 0.575 c 978
- 782 m -17 13 d -25 -5 d 19 -14 d f 0.6 0.6 0.6 c 961 795 m -3 3 d -24 -6 d 2 -2
- d f 0.55 0.55 0.55 c 931 770 m 24 6 d -24 -6 d f 0.575 0.575 0.575 c 955 776 m
- -19 14 d -23 -6 d 18 -14 d f 0.6 0.6 0.6 c 936 790 m -2 2 d -23 -6 d 2 -2 d f
- 0.55 0.55 0.55 c 908 764 m 23 6 d -23 -6 d f 0.575 0.575 0.575 c 931 770 m -18
- 14 d -26 -4 d 21 -16 d f 0.6 0.6 0.6 c 913 784 m -2 2 d -24 -6 d f 0.55 0.55
- 0.55 c 884 758 m 24 6 d -25 -5 d f 0.575 0.575 0.575 c 908 764 m -21 16 d -23
- -6 d 19 -15 d f 0.6 0.6 0.6 c 887 780 m f 0.55 0.55 0.55 c 861 752 m 23 6 d -1
- 1 d -42 9 d -1 X f 0.575 0.575 0.575 c 883 759 m -19 15 d -23 -6 d f 0.55 0.55
- 0.55 c 837 746 m 24 6 d -21 16 d -23 -6 d f 814 740 m 23 6 d -20 16 d -24 -6 d
- f 1915 1000 m 23 6 d -20 15 d -24 -6 d f 1891 994 m 24 6 d -21 15 d -23 -6 d f
- 1868 988 m 23 6 d -20 15 d -2 X -3 -20 d f 0.575 0.575 0.575 c 1869 1009 m -22
- -6 d 19 -14 d f 0.55 0.55 0.55 c 1844 982 m 24 6 d -2 1 d -22 -7 d f 0.575
- 0.575 0.575 c 1866 989 m -19 14 d -23 -6 d 20 -15 d f 0.55 0.55 0.55 c 1843 981
- m 1 1 d f 0.575 0.575 0.575 c 1821 976 m 22 5 d 1 1 d -20 15 d -24 -6 d f 1797
- 970 m 24 6 d -21 15 d -23 8 d f 1774 964 m 23 6 d -20 29 d -24 -6 d f 0.55 0.55
- 0.55 c 1735 977 m -5 -4 d 5 X f 0.575 0.575 0.575 c 1750 971 m 24 -7 d -21 29 d
- -18 -16 d -4 Y f 0.55 0.55 0.55 c 1735 973 m -5 X -24 -6 d 11 -8 d f 0.575
- 0.575 0.575 c 1727 952 m 23 19 d -15 2 d -18 -14 d f 0.55 0.55 0.55 c 1717 959
- m -11 8 d -23 21 d -1 Y f 0.575 0.575 0.575 c 1703 946 m 24 6 d -10 7 d -34 28
- d f 0.55 0.55 0.55 c 1683 987 m 1 Y -1 X f 0.575 0.575 0.575 c 1680 940 m 23 6
- d -20 41 d -1 1 d -23 -33 d f 0.55 0.55 0.55 c 1656 934 m 1 X -1 X f 0.575
- 0.575 0.575 c 1657 934 m 23 6 d -21 15 d -23 -6 d 20 -15 d f 0.55 0.55 0.55 c
- 1633 928 m 23 6 d -23 -6 d f 0.575 0.575 0.575 c 1656 934 m -20 15 d -24 -6 d
- 21 -15 d f 0.55 0.55 0.55 c 1609 922 m 24 6 d -25 -5 d f 0.575 0.575 0.575 c
- 1633 928 m -21 15 d -23 -6 d 19 -14 d f 0.55 0.55 0.55 c 1586 916 m 23 6 d -1 1
- d -41 9 d -2 X f 0.575 0.575 0.575 c 1608 923 m -19 14 d -22 -5 d f 0.55 0.55
- 0.55 c 1584 916 m 2 X -21 16 d -23 -6 d 9 -8 d f 0.575 0.575 0.575 c 1562 910 m
- 22 6 d -33 2 d f 0.55 0.55 0.55 c 1551 918 m -9 8 d -6 1 d f 0.575 0.575 0.575
- c 1539 904 m 23 6 d -11 8 d -15 9 d -18 6 d f 1515 898 m 24 6 d -21 29 d -16
- -14 d -11 Y f 0.6 0.6 0.6 c 1502 919 m -7 -5 d 7 -6 d f 0.575 0.575 0.575 c
- 1492 892 m 23 6 d -13 10 d -13 -12 d f 0.6 0.6 0.6 c 1502 908 m -7 6 d -5 1 d
- -5 -13 d 4 -6 d f 0.625 0.625 0.625 c 1490 915 m -6 2 d -4 -9 d 5 -6 d f 0.65
- 0.65 0.65 c 1484 917 m -6 2 d -2 -5 d 4 -6 d f 0.675 0.675 0.675 c 1478 919 m
- -6 2 d 4 -7 d f 0.7 0.7 0.7 c 1472 921 m -1 X 1 X f 0.55 0.55 0.55 c 1468 886 m
- 1 X -1 X f 0.575 0.575 0.575 c 1469 886 m 23 6 d -3 4 d -26 -6 d 5 -4 d f 0.6
- 0.6 0.6 c 1489 896 m -4 6 d -27 -8 d 5 -4 d f 0.625 0.625 0.625 c 1485 902 m -5
- 6 d -27 -10 d 5 -4 d f 0.65 0.65 0.65 c 1480 908 m -4 6 d -27 -11 d -1 -1 d 5
- -4 d f 0.675 0.675 0.675 c 1476 914 m -4 7 d -2 -1 d -21 -17 d f 0.7 0.7 0.7 c
- 1472 921 m -1 X -1 -1 d f 0.55 0.55 0.55 c 1468 886 m f 0.575 0.575 0.575 c
- 1445 880 m 23 6 d -5 4 d -21 -6 d f 0.6 0.6 0.6 c 1463 890 m -5 4 d -31 14 d -2
- 1 d 17 -25 d f 0.625 0.625 0.625 c 1458 894 m -5 4 d -15 7 d -11 3 d f 0.65
- 0.65 0.65 c 1453 898 m -5 4 d -10 3 d f 0.575 0.575 0.575 c 1421 874 m 24 6 d
- -3 4 d -21 -9 d f 0.6 0.6 0.6 c 1442 884 m -17 25 d -1 X -5 -30 d 2 -4 d f
- 0.625 0.625 0.625 c 1424 909 m -3 1 d -4 -27 d 2 -4 d f 0.65 0.65 0.65 c 1421
- 910 m -2 1 d -4 -24 d 2 -4 d f 0.675 0.675 0.675 c 1419 911 m -3 1 d -3 -21 d 2
- -4 d f 0.7 0.7 0.7 c 1416 912 m -2 X -3 -17 d 2 -4 d f 0.725 0.725 0.725 c 1414
- 912 m -2 1 d -3 -14 d 2 -4 d f 0.75 0.75 0.75 c 1412 913 m -3 1 d -2 -11 d 2 -4
- d f 0.775 0.775 0.775 c 1409 914 m -2 1 d -2 -8 d 2 -4 d f 0.8 0.8 0.8 c 1407
- 915 m -3 1 d -5 Y 1 -4 d f 0.825 0.825 0.825 c 1404 916 m -2 X -1 Y 2 -4 d f
- 0.85 0.85 0.85 c 1402 916 m -1 1 d 1 -2 d f 0.575 0.575 0.575 c 1398 868 m 23 6
- d 1 Y -30 -1 d f 0.6 0.6 0.6 c 1421 875 m -2 4 d -37 1 d 9 -6 d f 0.625 0.625
- 0.625 c 1419 879 m -2 4 d -38 3 d -1 -2 d 4 -4 d f 0.65 0.65 0.65 c 1417 883 m
- -2 4 d -33 2 d -3 -3 d f 0.675 0.675 0.675 c 1415 887 m -2 4 d -29 2 d -2 -4 d
- f 0.7 0.7 0.7 c 1413 891 m -2 4 d -24 2 d -3 -4 d f 0.725 0.725 0.725 c 1411
- 895 m -2 4 d -19 2 d -3 -4 d f 0.75 0.75 0.75 c 1409 899 m -2 4 d -15 1 d -2 -3
- d f 0.775 0.775 0.775 c 1407 903 m -2 4 d -10 1 d -3 -4 d f 0.8 0.8 0.8 c 1405
- 907 m -1 4 d -6 1 d -3 -4 d f 0.825 0.825 0.825 c 1404 911 m -2 4 d -2 X -2 -3
- d f 0.85 0.85 0.85 c 1402 915 m -1 2 d -1 -2 d f 0.55 0.55 0.55 c 1374 862 m 9
- 2 d -10 -1 d f 0.575 0.575 0.575 c 1383 864 m 15 4 d -7 6 d -28 -3 d 10 -8 d f
- 0.6 0.6 0.6 c 1391 874 m -9 6 d -21 -1 d -7 -1 d 9 -7 d f 0.625 0.625 0.625 c
- 1382 880 m -4 4 d -17 -5 d f 0.55 0.55 0.55 c 1351 870 m 23 -8 d -1 1 d -22 7 d
- f 0.575 0.575 0.575 c 1373 863 m -10 8 d -19 -1 d 7 X f 0.6 0.6 0.6 c 1363 871
- m -9 7 d -3 -1 d -13 -6 d 6 -1 d f 0.625 0.625 0.625 c 1351 877 m -17 -4 d -2
- -1 d 6 -1 d f 0.65 0.65 0.65 c 1334 873 m -3 -1 d 1 X f 0.55 0.55 0.55 c 1348
- 867 m 3 3 d f 0.575 0.575 0.575 c 1327 850 m 21 17 d 3 3 d -7 X -33 -3 d -4 -1
- d f 0.6 0.6 0.6 c 1344 870 m -6 1 d -18 -2 d -9 -2 d f 0.625 0.625 0.625 c 1338
- 871 m -6 1 d -3 -1 d -9 -2 d f 0.65 0.65 0.65 c 1332 872 m -1 X -2 -1 d f 0.55
- 0.55 0.55 c 1304 844 m 3 1 d -3 -1 d f 0.575 0.575 0.575 c 1307 845 m 20 5 d
- -20 16 d -23 -6 d 20 -16 d f 0.55 0.55 0.55 c 1302 844 m 2 X f 0.575 0.575
- 0.575 c 1280 838 m 22 6 d 2 X -20 16 d -5 -1 d -12 -11 d f 0.6 0.6 0.6 c 1279
- 859 m -19 -5 d 7 -6 d f 0.575 0.575 0.575 c 1275 840 m 5 -2 d -13 10 d f 0.6
- 0.6 0.6 c 1269 842 m 6 -2 d -8 8 d -7 6 d -14 4 d f 0.625 0.625 0.625 c 1263
- 844 m 6 -2 d -23 16 d -9 3 d 8 -6 d f 0.65 0.65 0.65 c 1257 846 m 6 -2 d -18 11
- d f 0.575 0.575 0.575 c 1233 826 m 5 4 d -16 20 d -9 -8 d f 0.6 0.6 0.6 c 1238
- 830 m 6 5 d -11 23 d -11 -8 d f 0.625 0.625 0.625 c 1244 835 m 7 6 d -6 14 d -8
- 6 d -4 -3 d f 0.65 0.65 0.65 c 1251 841 m 6 5 d -12 9 d f 0.575 0.575 0.575 c
- 1210 820 m 23 6 d -20 16 d -23 -6 d f 1186 814 m 24 6 d -20 16 d -5 1 d -1 -20
- d f 0.6 0.6 0.6 c 1185 837 m -4 2 d -1 -15 d 4 -7 d f 0.625 0.625 0.625 c 1181
- 839 m -5 1 d -1 -10 d 5 -6 d f 0.65 0.65 0.65 c 1176 840 m -5 2 d -5 Y 4 -7 d f
- 0.675 0.675 0.675 c 1171 842 m -5 1 d 5 -6 d f 0.7 0.7 0.7 c 1166 843 m f 0.575
- 0.575 0.575 c 1163 808 m 23 6 d -2 3 d -34 1 d f 0.6 0.6 0.6 c 1184 817 m -4 7
- d -34 3 d -3 -3 d 7 -6 d f 0.625 0.625 0.625 c 1180 824 m -5 6 d -22 2 d -7 -5
- d f 0.65 0.65 0.65 c 1175 830 m -4 7 d -12 1 d -6 -6 d f 0.675 0.675 0.675 c
- 1171 837 m -5 6 d -7 -5 d f 0.7 0.7 0.7 c 1166 843 m f 0.55 0.55 0.55 c 1139
- 802 m 2 1 d -2 X f 0.575 0.575 0.575 c 1141 803 m 22 5 d -13 10 d -16 4 d -15
- -4 d 20 -15 d f 0.6 0.6 0.6 c 1150 818 m -7 6 d -9 -2 d f 0.55 0.55 0.55 c 1138
- 802 m 1 X 1 Y f 0.575 0.575 0.575 c 1116 796 m 22 6 d 1 1 d -20 15 d -23 -6 d f
- 1093 790 m 23 6 d -20 16 d -3 1 d -2 -20 d f 0.6 0.6 0.6 c 1093 813 m -3 1 d -2
- -17 d 3 -4 d f 0.625 0.625 0.625 c 1090 814 m -4 1 d -1 -13 d 3 -5 d f 0.65
- 0.65 0.65 c 1086 815 m -3 1 d -1 -10 d 3 -4 d f 0.675 0.675 0.675 c 1083 816 m
- -4 1 d -1 -6 d 4 -5 d f 0.7 0.7 0.7 c 1079 817 m -3 1 d -1 -3 d 3 -4 d f 0.725
- 0.725 0.725 c 1076 818 m -4 1 d 3 -4 d f 0.575 0.575 0.575 c 1069 784 m 24 6 d
- -2 3 d -26 -5 d f 0.6 0.6 0.6 c 1091 793 m -3 4 d -32 -3 d 9 -6 d f 0.625 0.625
- 0.625 c 1088 797 m -3 5 d -36 -2 d 7 -6 d f 0.65 0.65 0.65 c 1085 802 m -3 4 d
- -27 -1 d -6 -5 d f 0.675 0.675 0.675 c 1082 806 m -4 5 d -17 -1 d -6 -5 d f 0.7
- 0.7 0.7 c 1078 811 m -3 4 d -8 X -6 -5 d f 0.725 0.725 0.725 c 1075 815 m -3 4
- d -5 -4 d f 0.55 0.55 0.55 c 1025 807 m 1 X f 0.575 0.575 0.575 c 1046 778 m 23
- 6 d -4 4 d -32 17 d -8 2 d 1 X f 0.6 0.6 0.6 c 1065 788 m -9 6 d -15 8 d -8 3 d
- f 0.625 0.625 0.625 c 1056 794 m -7 6 d -8 2 d f 0.55 0.55 0.55 c 1022 772 m 1
- 1 d 3 34 d -1 X -3 -2 d -2 -31 d f 0.575 0.575 0.575 c 1023 773 m 23 5 d -20 29
- d -4 -2 d -20 -17 d 18 -14 d f 0.55 0.55 0.55 c 999 766 m 23 6 d -2 2 d -39 9 d
- -3 -1 d f 0.575 0.575 0.575 c 1020 774 m -18 14 d -21 -5 d f 0.55 0.55 0.55 c
- 975 760 m 24 6 d -21 16 d -23 -6 d f 952 755 m 23 5 d -20 16 d -24 -6 d f 928
- 749 m 24 6 d -21 15 d -23 -6 d f 905 743 m 23 6 d -20 15 d -24 -6 d f 881 737 m
- 24 6 d -21 15 d -23 -6 d f 858 731 m 23 6 d -20 15 d -24 -6 d f 834 725 m 24 6
- d -21 15 d -23 -6 d f 1935 984 m 23 6 d -20 16 d -23 -6 d f 1911 978 m 24 6 d
- -20 16 d -24 -6 d f 1888 972 m 23 6 d -20 16 d -23 -6 d f 1865 966 m 23 6 d -20
- 16 d -24 -6 d f 1841 960 m 24 6 d -21 16 d -1 -1 d -15 -11 d f 0.575 0.575
- 0.575 c 1843 981 m -22 -5 d 7 -6 d f 0.55 0.55 0.55 c 1818 954 m 23 6 d -13 10
- d -18 -10 d f 0.575 0.575 0.575 c 1828 970 m -7 6 d -24 -6 d 13 -10 d f 0.55
- 0.55 0.55 c 1794 948 m 24 6 d -8 6 d -16 -12 d f 0.575 0.575 0.575 c 1810 960 m
- -13 10 d -23 -6 d 20 -16 d f 0.55 0.55 0.55 c 1794 948 m f 0.575 0.575 0.575 c
- 1771 942 m 23 6 d -20 16 d -24 7 d f 1747 936 m 24 6 d -21 29 d -23 -19 d f
- 0.55 0.55 0.55 c 1724 930 m 1 1 d -2 X f 0.575 0.575 0.575 c 1725 931 m 22 5 d
- -20 16 d -24 -6 d 20 -15 d f 0.55 0.55 0.55 c 1700 924 m 24 6 d -1 1 d -24 -6 d
- f 0.575 0.575 0.575 c 1723 931 m -20 15 d -23 -6 d 19 -15 d f 0.55 0.55 0.55 c
- 1677 918 m 23 6 d -1 1 d -42 9 d -1 X f 0.575 0.575 0.575 c 1699 925 m -19 15 d
- -23 -6 d f 0.55 0.55 0.55 c 1653 912 m 24 6 d -21 16 d -23 -6 d f 1630 906 m 23
- 6 d -20 16 d -24 -6 d f 1606 900 m 24 6 d -21 16 d -23 -6 d f 1583 894 m 23 6 d
- -20 16 d -2 X -14 -12 d f 0.575 0.575 0.575 c 1584 916 m -22 -6 d 8 -6 d f 0.55
- 0.55 0.55 c 1559 888 m 24 6 d -13 10 d -21 -8 d f 0.575 0.575 0.575 c 1570 904
- m -8 6 d -23 -6 d 10 -8 d f 0.55 0.55 0.55 c 1536 882 m 23 6 d -10 8 d -18 -10
- d f 0.575 0.575 0.575 c 1549 896 m -10 8 d -24 -6 d 16 -12 d f 0.55 0.55 0.55 c
- 1512 877 m 24 5 d -5 4 d -24 -5 d f 0.575 0.575 0.575 c 1531 886 m -16 12 d -23
- -6 d 15 -11 d f 0.55 0.55 0.55 c 1489 884 m 23 -7 d -5 4 d -38 5 d -1 X f 0.575
- 0.575 0.575 c 1507 881 m -15 11 d -23 -6 d f 0.55 0.55 0.55 c 1486 882 m 3 2 d
- -21 2 d f 0.575 0.575 0.575 c 1465 865 m 21 17 d -18 4 d -23 -6 d f 0.55 0.55
- 0.55 c 1442 859 m 3 X -4 X f 0.575 0.575 0.575 c 1445 859 m 20 6 d -20 15 d -24
- -6 d 20 -15 d f 0.55 0.55 0.55 c 1418 853 m 24 6 d -1 X -24 -6 d f 0.575 0.575
- 0.575 c 1441 859 m -20 15 d -23 -6 d 19 -15 d f 0.55 0.55 0.55 c 1417 852 m 1 1
- d -1 X -34 11 d -9 -2 d 10 -7 d f 0.575 0.575 0.575 c 1395 847 m 22 5 d 1 Y -19
- 15 d -15 -4 d 1 -9 d f 0.55 0.55 0.55 c 1384 855 m -10 7 d -23 8 d -1 Y f 0.575
- 0.575 0.575 c 1371 841 m 24 6 d -11 8 d -33 14 d f 0.55 0.55 0.55 c 1351 869 m
- 1 Y -3 -3 d f 0.575 0.575 0.575 c 1348 835 m 23 6 d -20 28 d -3 -2 d -21 -17 d
- f 0.55 0.55 0.55 c 1324 829 m 1 X -18 16 d -3 -1 d f 0.575 0.575 0.575 c 1325
- 829 m 23 6 d -21 15 d -20 -5 d f 0.55 0.55 0.55 c 1323 828 m 1 1 d -20 15 d -2
- X f 0.575 0.575 0.575 c 1301 823 m 22 5 d -21 16 d -22 -6 d f 1277 817 m 24 6 d
- -21 15 d -5 2 d -1 -19 d f 0.6 0.6 0.6 c 1275 840 m -6 2 d -1 -13 d 6 -8 d f
- 0.625 0.625 0.625 c 1269 842 m -6 2 d -6 Y 5 -9 d f 0.65 0.65 0.65 c 1263 844 m
- -6 2 d 6 -8 d f 0.575 0.575 0.575 c 1254 811 m 23 6 d -3 4 d -36 9 d -5 -4 d f
- 0.6 0.6 0.6 c 1274 821 m -6 8 d -24 6 d -6 -5 d f 0.625 0.625 0.625 c 1268 829
- m -5 9 d -12 3 d -7 -6 d f 0.65 0.65 0.65 c 1263 838 m -6 8 d -6 -5 d f 0.55
- 0.55 0.55 c 1230 805 m 1 X -2 1 d f 0.575 0.575 0.575 c 1231 805 m 23 6 d -21
- 15 d -23 -6 d 19 -14 d f 0.55 0.55 0.55 c 1207 799 m 23 6 d -1 1 d -23 -7 d f
- 0.575 0.575 0.575 c 1229 806 m -19 14 d -24 -6 d 20 -15 d f 0.55 0.55 0.55 c
- 1183 793 m 24 6 d -1 X -24 -5 d f 0.575 0.575 0.575 c 1206 799 m -20 15 d -23
- -6 d 19 -14 d f 0.55 0.55 0.55 c 1160 787 m 23 6 d -1 1 d -41 9 d -2 -1 d f
- 0.575 0.575 0.575 c 1182 794 m -19 14 d -22 -5 d f 0.55 0.55 0.55 c 1136 781 m
- 24 6 d -21 15 d -1 X -3 -20 d f 0.575 0.575 0.575 c 1138 802 m -22 -6 d 19 -14
- d f 0.55 0.55 0.55 c 1113 775 m 23 6 d -1 1 d -23 -7 d f 0.575 0.575 0.575 c
- 1135 782 m -19 14 d -23 -6 d 19 -15 d f 0.55 0.55 0.55 c 1089 769 m 24 6 d -1 X
- -23 -6 d f 0.575 0.575 0.575 c 1112 775 m -19 15 d -24 -6 d 20 -15 d f 0.55
- 0.55 0.55 c 1066 763 m 23 6 d -24 -6 d f 0.575 0.575 0.575 c 1089 769 m -20 15
- d -23 -6 d 19 -15 d f 0.55 0.55 0.55 c 1042 757 m 24 6 d -1 X -42 10 d -1 -1 d
- f 0.575 0.575 0.575 c 1065 763 m -19 15 d -23 -5 d f 0.55 0.55 0.55 c 1019 764
- m 23 -7 d -20 15 d -23 -6 d f 1016 762 m 3 2 d -20 2 d -24 -6 d 14 -10 d f
- 0.575 0.575 0.575 c 995 745 m 21 17 d -27 -12 d f 0.55 0.55 0.55 c 972 739 m 3
- 1 d 14 10 d -14 10 d -23 -5 d f 0.575 0.575 0.575 c 975 740 m 20 5 d -6 5 d f
- 0.55 0.55 0.55 c 948 733 m 24 6 d -20 16 d -24 -6 d f 925 727 m 23 6 d -20 16 d
- -23 -6 d f 901 721 m 24 6 d -20 16 d -24 -6 d f 878 715 m 23 6 d -20 16 d -23
- -6 d f 854 709 m 24 6 d -20 16 d -24 -6 d f 1955 969 m 24 6 d -21 15 d -23 -6 d
- f 1932 963 m 23 6 d -20 15 d -24 -6 d f 1908 957 m 24 6 d -21 15 d -23 -6 d f
- 1885 951 m 23 6 d -20 15 d -23 -6 d f 1861 945 m 24 6 d -20 15 d -24 -6 d f
- 0.475 0.475 0.475 c 1838 952 m 6 -2 d -12 3 d f 0.5 0.5 0.5 c 1844 950 m 8 -2 d
- -26 5 d 6 X f 0.525 0.525 0.525 c 1852 948 m 7 -3 d -39 9 d 6 -1 d f 0.55 0.55
- 0.55 c 1859 945 m 2 X -20 15 d -23 -6 d 2 X f 0.475 0.475 0.475 c 1832 947 m 6
- 5 d -6 1 d f 0.5 0.5 0.5 c 1825 941 m 7 6 d 6 Y -6 X f 0.525 0.525 0.525 c 1818
- 936 m 7 5 d 1 12 d -6 1 d f 0.55 0.55 0.55 c 1814 933 m 4 3 d 2 18 d -2 X -24
- -6 d f 1791 927 m 23 6 d -20 15 d -3 -21 d f 0.575 0.575 0.575 c 1794 948 m -23
- -6 d 20 -15 d f 0.55 0.55 0.55 c 1767 921 m 24 6 d -25 -6 d f 0.575 0.575 0.575
- c 1791 927 m -20 15 d -24 -6 d 19 -15 d f 0.55 0.55 0.55 c 1744 915 m 23 6 d -1
- X -41 10 d -1 -1 d f 0.575 0.575 0.575 c 1766 921 m -19 15 d -22 -5 d f 0.55
- 0.55 0.55 c 1720 909 m 24 6 d -20 15 d -24 -6 d f 1697 903 m 23 6 d -20 15 d
- -23 -6 d f 1673 897 m 24 6 d -20 15 d -24 -6 d f 1650 891 m 23 6 d -20 15 d -23
- -6 d f 1626 885 m 24 6 d -20 15 d -24 -6 d f 1603 879 m 23 6 d -20 15 d -23 -6
- d f 0.475 0.475 0.475 c 1579 886 m 7 -2 d -12 3 d f 0.5 0.5 0.5 c 1586 884 m 7
- -2 d -25 6 d 6 -1 d f 0.525 0.525 0.525 c 1593 882 m 7 -2 d -38 8 d 6 X f 0.55
- 0.55 0.55 c 1600 880 m 3 -1 d -20 15 d -24 -6 d 3 X f 0.475 0.475 0.475 c 1573
- 881 m 6 5 d -5 1 d f 0.5 0.5 0.5 c 1567 876 m 6 5 d 1 6 d -6 1 d f 0.525 0.525
- 0.525 c 1560 870 m 7 6 d 1 12 d -6 X f 0.55 0.55 0.55 c 1556 867 m 4 3 d 2 18 d
- -3 X -23 -6 d f 1544 864 m 12 3 d -20 15 d -24 -5 d 5 -4 d f 0.575 0.575 0.575
- c 1533 861 m 11 3 d -27 9 d f 0.55 0.55 0.55 c 1517 873 m -5 4 d -23 7 d f
- 0.575 0.575 0.575 c 1530 860 m 3 1 d -16 12 d -28 11 d 3 -5 d f 0.6 0.6 0.6 c
- 1526 859 m 4 1 d -38 19 d 4 -5 d f 0.625 0.625 0.625 c 1521 858 m 5 1 d -30 15
- d 3 -5 d f 0.65 0.65 0.65 c 1517 857 m 4 1 d -22 11 d 4 -5 d f 0.675 0.675
- 0.675 c 1513 856 m 4 1 d -14 7 d 3 -5 d f 0.7 0.7 0.7 c 1509 855 m 4 1 d -7 3 d
- f 0.55 0.55 0.55 c 1489 884 m -3 -2 d f 0.575 0.575 0.575 c 1486 849 m 1 X 5 30
- d -3 5 d -3 -2 d -21 -17 d f 0.6 0.6 0.6 c 1487 849 m 5 2 d 4 23 d -4 5 d f
- 0.625 0.625 0.625 c 1492 851 m 4 1 d 3 17 d -3 5 d f 0.65 0.65 0.65 c 1496 852
- m 5 1 d 2 11 d -4 5 d f 0.675 0.675 0.675 c 1501 853 m 4 1 d 1 5 d -3 5 d f 0.7
- 0.7 0.7 c 1505 854 m 4 1 d -3 4 d f 0.55 0.55 0.55 c 1462 843 m -17 16 d -3 X f
- 0.575 0.575 0.575 c 1462 843 m 24 6 d -21 16 d -20 -6 d f 0.55 0.55 0.55 c 1439
- 837 m 23 6 d -20 16 d -24 -6 d f 1415 831 m 24 6 d -21 16 d -1 -1 d -3 -20 d f
- 0.575 0.575 0.575 c 1417 852 m -22 -5 d 19 -15 d f 0.55 0.55 0.55 c 1392 825 m
- 23 6 d -1 1 d -23 -7 d f 0.575 0.575 0.575 c 1414 832 m -19 15 d -24 -6 d 20
- -16 d f 0.55 0.55 0.55 c 1368 819 m 24 6 d -1 X -24 -5 d f 0.575 0.575 0.575 c
- 1391 825 m -20 16 d -23 -6 d 19 -15 d f 0.55 0.55 0.55 c 1345 813 m 23 6 d -1 1
- d -42 9 d -1 X f 0.575 0.575 0.575 c 1367 820 m -19 15 d -23 -6 d f 0.55 0.55
- 0.55 c 1321 807 m 24 6 d -21 16 d -1 -1 d -3 -20 d f 0.575 0.575 0.575 c 1323
- 828 m -22 -5 d 19 -15 d f 0.55 0.55 0.55 c 1298 801 m 23 6 d -1 1 d -23 -7 d f
- 0.575 0.575 0.575 c 1320 808 m -19 15 d -24 -6 d 20 -16 d f 0.55 0.55 0.55 c
- 1274 795 m 24 6 d -1 X -24 -5 d f 0.575 0.575 0.575 c 1297 801 m -20 16 d -23
- -6 d 19 -15 d f 0.55 0.55 0.55 c 1251 789 m 23 6 d -1 1 d -42 9 d -1 X f 0.575
- 0.575 0.575 c 1273 796 m -19 15 d -23 -6 d f 0.55 0.55 0.55 c 1227 783 m 24 6 d
- -21 16 d -23 -6 d f 1204 777 m 23 6 d -20 16 d -24 -6 d f 1180 771 m 24 6 d -21
- 16 d -23 -6 d f 1157 765 m 23 6 d -20 16 d -24 -6 d f 1133 759 m 24 6 d -21 16
- d -23 -6 d f 1110 753 m 23 6 d -20 16 d -24 -6 d f 1086 747 m 24 6 d -21 16 d
- -23 -6 d f 1086 747 m -20 16 d -24 -6 d 5 -4 d f 0.575 0.575 0.575 c 1063 741 m
- 23 6 d -39 6 d f 0.55 0.55 0.55 c 1047 753 m -5 4 d -23 7 d f 0.575 0.575 0.575
- c 1060 741 m 3 X -16 12 d -28 11 d 3 -5 d f 0.6 0.6 0.6 c 1056 740 m 4 1 d -38
- 18 d 4 -5 d f 0.625 0.625 0.625 c 1052 739 m 4 1 d -30 14 d 3 -4 d f 0.65 0.65
- 0.65 c 1047 737 m 5 2 d -23 11 d 4 -5 d f 0.675 0.675 0.675 c 1043 736 m 4 1 d
- -14 8 d 3 -5 d f 0.7 0.7 0.7 c 1039 735 m 4 1 d -7 4 d f 0.55 0.55 0.55 c 1019
- 764 m -3 -2 d f 0.575 0.575 0.575 c 1016 729 m 2 1 d 4 29 d -3 5 d -3 -2 d -21
- -17 d f 0.6 0.6 0.6 c 1018 730 m 4 1 d 4 23 d -4 5 d f 0.625 0.625 0.625 c 1022
- 731 m 4 1 d 3 18 d -3 4 d f 0.65 0.65 0.65 c 1026 732 m 5 1 d 2 12 d -4 5 d f
- 0.675 0.675 0.675 c 1031 733 m 4 1 d 1 6 d -3 5 d f 0.7 0.7 0.7 c 1035 734 m 4
- 1 d -3 5 d f 0.55 0.55 0.55 c 992 723 m 1 1 d -18 16 d -3 -1 d f 0.575 0.575
- 0.575 c 993 724 m 23 5 d -21 16 d -20 -5 d f 0.55 0.55 0.55 c 969 717 m 23 6 d
- -20 16 d -24 -6 d f 945 711 m 24 6 d -21 16 d -23 -6 d f 922 706 m 23 5 d -20
- 16 d -24 -6 d f 898 700 m 24 6 d -21 15 d -23 -6 d f 875 694 m 23 6 d -20 15 d
- -24 -6 d f black 222 1180 m 651 -497 d s 873 683 m 994 Y s 222 2174 m 651 -497
- d s 222 1180 m 994 Y s 873 683 m 1128 287 d s 2001 970 m 994 Y s 873 1677 m
- 1128 287 d s 873 1677 m cl s 873 683 m 1128 287 d s 967 673 m 34 Y s 991 696 m
- 17 Y s 1014 702 m 17 Y s 1038 708 m 17 Y s 1061 714 m 17 Y s 1085 703 m 34 Y s
- 1108 726 m 17 Y s 1132 732 m 17 Y s 1155 738 m 17 Y s 1179 744 m 17 Y s 1202
- 733 m 34 Y s 1226 756 m 16 Y s 1249 762 m 16 Y s 1273 768 m 16 Y s 1296 774 m
- 16 Y s 1320 763 m 33 Y s 1343 786 m 16 Y s 1367 792 m 16 Y s 1390 798 m 16 Y s
- 1413 804 m 16 Y s 1437 793 m 33 Y s 1460 816 m 16 Y s 1484 822 m 16 Y s 1507
- 828 m 16 Y s 1531 834 m 16 Y s 1554 823 m 33 Y s 1578 846 m 16 Y s 1601 851 m
- 17 Y s 1625 857 m 17 Y s 1648 863 m 17 Y s 1672 853 m 33 Y s 1695 875 m 17 Y s
- 1719 881 m 17 Y s 1742 887 m 17 Y s 1766 893 m 17 Y s 1789 883 m 33 Y s 1813
- 905 m 17 Y s 1836 911 m 17 Y s 1860 917 m 17 Y s 1883 923 m 17 Y s 1907 913 m
- 33 Y s 967 673 m 34 Y s 944 684 m 17 Y s 920 678 m 17 Y s 897 672 m 17 Y s 873
- 666 m 17 Y s 1907 913 m 33 Y s 1930 935 m 17 Y s 1954 941 m 17 Y s 1977 947 m
- 17 Y s 2001 953 m 17 Y s 970 654 m -5 -1 d -3 -4 d -1 -8 d -4 Y 1 -8 d 3 -4 d 5
- -2 d 3 X 4 2 d 3 4 d 1 8 d 4 Y -1 8 d -3 4 d -4 1 d -3 X cl s 1061 684 m -4 -1
- d -3 -5 d -1 -7 d -4 Y 1 -8 d 3 -4 d 4 -2 d 3 X 5 2 d 3 4 d 1 8 d 4 Y -1 7 d -3
- 5 d -5 1 d -3 X cl s 1085 656 m -1 -1 d 1 -2 d 2 2 d -2 1 d cl s 1099 677 m 1 Y
- 1 3 d 1 2 d 3 1 d 6 X 3 -1 d 2 -2 d 1 -3 d -3 Y -1 -2 d -3 -5 d -15 -15 d 21 X
- s 1144 684 m -14 X -2 -13 d 2 2 d 4 1 d 5 X 4 -1 d 3 -3 d 1 -5 d -3 Y -1 -4 d
- -3 -3 d -4 -2 d -5 X -4 2 d -2 1 d -1 3 d s 1190 714 m -5 -1 d -3 -5 d -1 -7 d
- -5 Y 1 -7 d 3 -4 d 5 -2 d 3 X 4 2 d 3 4 d 2 7 d 5 Y -2 7 d -3 5 d -4 1 d -3 X
- cl s 1214 686 m -2 -1 d 2 -2 d 1 2 d -1 1 d cl s 1243 714 m -15 X -1 -13 d 1 1
- d 5 2 d 4 X 5 -2 d 3 -3 d 1 -4 d -3 Y -1 -4 d -3 -3 d -5 -2 d -4 X -5 2 d -1 1
- d -2 3 d s 1296 744 m -4 -1 d -3 -5 d -2 -7 d -5 Y 2 -7 d 3 -4 d 4 -2 d 3 X 5 2
- d 3 4 d 1 7 d 5 Y -1 7 d -3 5 d -5 1 d -3 X cl s 1320 716 m -1 -1 d 1 -2 d 2 2
- d -2 1 d cl s 1353 744 m -15 -31 d s 1332 744 m 21 X s 1379 744 m -14 X -2 -13
- d 2 1 d 4 2 d 4 X 5 -2 d 3 -3 d 1 -4 d -3 Y -1 -5 d -3 -2 d -5 -2 d -4 X -4 2 d
- -2 1 d -1 3 d s 1435 768 m 3 2 d 4 4 d -31 Y s 1527 798 m 3 2 d 4 4 d -31 Y s
- 1555 776 m -2 -2 d 2 -1 d 1 1 d -1 2 d cl s 1568 797 m 1 Y 2 3 d 1 1 d 3 2 d 6
- X 3 -2 d 2 -1 d 1 -3 d -3 Y -1 -3 d -3 -4 d -15 -15 d 21 X s 1614 804 m -15 X
- -1 -13 d 1 1 d 5 2 d 4 X 5 -2 d 3 -3 d 1 -4 d -3 Y -1 -5 d -3 -3 d -5 -1 d -4 X
- -5 1 d -1 2 d -2 3 d s 1655 828 m 3 1 d 5 5 d -31 Y s 1683 806 m -1 -2 d 1 -1 d
- 2 1 d -2 2 d cl s 1713 834 m -15 X -1 -13 d 1 1 d 5 1 d 4 X 5 -1 d 3 -3 d 1 -4
- d -3 Y -1 -5 d -3 -3 d -5 -1 d -4 X -5 1 d -1 2 d -2 3 d s 1762 858 m 3 1 d 4 5
- d -31 Y s 1790 836 m -2 -2 d 2 -1 d 1 1 d -1 2 d cl s 1822 864 m -14 -31 d s
- 1802 864 m 20 X s 1849 864 m -15 X -1 -14 d 1 2 d 5 1 d 4 X 5 -1 d 3 -3 d 1 -5
- d -2 Y -1 -5 d -3 -3 d -5 -1 d -4 X -5 1 d -1 2 d -2 3 d s 1902 886 m 2 Y 1 3 d
- 2 1 d 3 2 d 6 X 3 -2 d 1 -1 d 1 -3 d -3 Y -1 -3 d -3 -5 d -15 -14 d 21 X s 873
- 683 m -651 497 d s 873 649 m 34 Y s 857 679 m 16 Y s 841 691 m 17 Y s 824 703 m
- 17 Y s 808 716 m 17 Y s 792 712 m 33 Y s 776 741 m 16 Y s 759 753 m 17 Y s 743
- 766 m 16 Y s 727 778 m 17 Y s 711 774 m 33 Y s 694 803 m 17 Y s 678 815 m 17 Y
- s 662 828 m 16 Y s 645 840 m 17 Y s 629 836 m 33 Y s 613 865 m 17 Y s 597 877 m
- 17 Y s 580 890 m 17 Y s 564 902 m 17 Y s 548 898 m 33 Y s 532 927 m 17 Y s 515
- 940 m 16 Y s 499 952 m 17 Y s 483 964 m 17 Y s 466 960 m 33 Y s 450 989 m 17 Y
- s 434 1002 m 16 Y s 418 1014 m 17 Y s 401 1027 m 16 Y s 385 1022 m 34 Y s 369
- 1051 m 17 Y s 352 1064 m 16 Y s 336 1076 m 17 Y s 320 1089 m 16 Y s 304 1084 m
- 34 Y s 287 1114 m 16 Y s 271 1126 m 17 Y s 255 1138 m 17 Y s 239 1151 m 16 Y s
- 222 1147 m 33 Y s 873 649 m 34 Y s 826 573 m 27 X s 865 583 m 2 Y 1 3 d 2 1 d 3
- 2 d 6 X 3 -2 d 1 -1 d 2 -3 d -3 Y -2 -3 d -3 -5 d -15 -15 d 21 X s 704 635 m 26
- X s 745 647 m 3 1 d 5 5 d -31 Y s 773 625 m -1 -2 d 1 -1 d 2 1 d -2 2 d cl s
- 803 653 m -15 X -1 -14 d 1 2 d 5 1 d 4 X 5 -1 d 2 -3 d 2 -5 d -3 Y -2 -4 d -2
- -3 d -5 -1 d -4 X -5 1 d -1 2 d -2 2 d s 663 697 m 27 X s 705 709 m 3 1 d 4 5 d
- -31 Y s 541 759 m 27 X s 587 777 m -5 -2 d -2 -4 d -2 -7 d -5 Y 2 -7 d 2 -5 d 5
- -1 d 3 X 4 1 d 3 5 d 2 7 d 5 Y -2 7 d -3 4 d -4 2 d -3 X cl s 611 749 m -2 -2 d
- 2 -1 d 1 1 d -1 2 d cl s 640 777 m -15 X -1 -13 d 1 1 d 5 2 d 4 X 5 -2 d 3 -3 d
- 1 -4 d -3 Y -1 -5 d -3 -3 d -5 -1 d -4 X -5 1 d -1 2 d -2 3 d s 537 839 m -5 -1
- d -3 -5 d -1 -7 d -5 Y 1 -7 d 3 -5 d 5 -1 d 3 X 4 1 d 3 5 d 2 7 d 5 Y -2 7 d -3
- 5 d -4 1 d -3 X cl s 414 901 m -4 -1 d -3 -5 d -2 -7 d -5 Y 2 -7 d 3 -4 d 4 -2
- d 3 X 5 2 d 3 4 d 1 7 d 5 Y -1 7 d -3 5 d -5 1 d -3 X cl s 438 873 m -1 -1 d 1
- -2 d 2 2 d -2 1 d cl s 468 901 m -15 X -2 -13 d 2 1 d 4 2 d 5 X 4 -2 d 3 -3 d 2
- -4 d -3 Y -2 -4 d -3 -3 d -4 -2 d -5 X -4 2 d -2 1 d -1 3 d s 370 957 m 3 2 d 4
- 4 d -31 Y s 247 1020 m 3 1 d 5 5 d -32 Y s 275 997 m -1 -1 d 1 -2 d 2 2 d -2 1
- d cl s 305 1026 m -15 X -1 -14 d 1 2 d 5 1 d 4 X 4 -1 d 3 -3 d 2 -5 d -3 Y -2
- -4 d -3 -3 d -4 -2 d -4 X -5 2 d -1 1 d -2 3 d s 204 1080 m 2 Y 1 3 d 2 1 d 3 2
- d 6 X 3 -2 d 1 -1 d 2 -3 d -3 Y -2 -3 d -3 -5 d -15 -14 d 21 X s 222 1180 m 994
- Y s 189 1180 m 33 X s 206 1207 m 16 X s 206 1234 m 16 X s 206 1261 m 16 X s 206
- 1287 m 16 X s 189 1314 m 33 X s 206 1341 m 16 X s 206 1368 m 16 X s 206 1395 m
- 16 X s 206 1422 m 16 X s 189 1449 m 33 X s 206 1476 m 16 X s 206 1502 m 16 X s
- 206 1529 m 16 X s 206 1556 m 16 X s 189 1583 m 33 X s 206 1610 m 16 X s 206
- 1637 m 16 X s 206 1664 m 16 X s 206 1690 m 16 X s 189 1717 m 33 X s 206 1744 m
- 16 X s 206 1771 m 16 X s 206 1798 m 16 X s 206 1825 m 16 X s 189 1852 m 33 X s
- 206 1879 m 16 X s 206 1905 m 16 X s 206 1932 m 16 X s 206 1959 m 16 X s 189
- 1986 m 33 X s 206 2013 m 16 X s 206 2040 m 16 X s 206 2067 m 16 X s 206 2094 m
- 16 X s 189 2120 m 33 X s 189 2120 m 33 X s 206 2147 m 16 X s 150 1195 m -4 -1 d
- -3 -4 d -1 -8 d -4 Y 1 -8 d 3 -4 d 4 -2 d 3 X 5 2 d 3 4 d 1 8 d 4 Y -1 8 d -3 4
- d -5 1 d -3 X cl s 116 1324 m 3 1 d 5 5 d -31 Y s 150 1330 m -4 -2 d -3 -4 d -1
- -7 d -5 Y 1 -7 d 3 -5 d 4 -1 d 3 X 5 1 d 3 5 d 1 7 d 5 Y -1 7 d -3 4 d -5 2 d
- -3 X cl s 113 1457 m 1 Y 2 3 d 1 2 d 3 1 d 6 X 3 -1 d 2 -2 d 1 -3 d -3 Y -1 -3
- d -3 -4 d -15 -15 d 21 X s 150 1464 m -4 -1 d -3 -5 d -1 -7 d -5 Y 1 -7 d 3 -4
- d 4 -2 d 3 X 5 2 d 3 4 d 1 7 d 5 Y -1 7 d -3 5 d -5 1 d -3 X cl s 115 1599 m 16
- X -9 -12 d 5 X 3 -2 d 1 -1 d 2 -5 d -3 Y -2 -4 d -3 -3 d -4 -2 d -5 X -4 2 d -2
- 1 d -1 3 d s 150 1599 m -4 -2 d -3 -4 d -1 -8 d -4 Y 1 -8 d 3 -4 d 4 -2 d 3 X 5
- 2 d 3 4 d 1 8 d 4 Y -1 8 d -3 4 d -5 2 d -3 X cl s 127 1733 m -15 -21 d 22 X s
- 127 1733 m -31 Y s 150 1733 m -4 -2 d -3 -4 d -1 -7 d -5 Y 1 -7 d 3 -5 d 4 -1 d
- 3 X 5 1 d 3 5 d 1 7 d 5 Y -1 7 d -3 4 d -5 2 d -3 X cl s 130 1867 m -15 X -2
- -13 d 2 1 d 4 2 d 5 X 4 -2 d 3 -3 d 2 -4 d -3 Y -2 -4 d -3 -3 d -4 -2 d -5 X -4
- 2 d -2 1 d -1 3 d s 150 1867 m -4 -1 d -3 -5 d -1 -7 d -4 Y 1 -8 d 3 -4 d 4 -2
- d 3 X 5 2 d 3 4 d 1 8 d 4 Y -1 7 d -3 5 d -5 1 d -3 X cl s 131 1997 m -1 3 d -5
- 2 d -3 X -4 -2 d -3 -4 d -2 -8 d -7 Y 2 -6 d 3 -3 d 4 -1 d 2 X 4 1 d 3 3 d 2 4
- d 2 Y -2 4 d -3 3 d -4 2 d -2 X -4 -2 d -3 -3 d -2 -4 d s 150 2002 m -4 -2 d -3
- -4 d -1 -8 d -4 Y 1 -8 d 3 -4 d 4 -1 d 3 X 5 1 d 3 4 d 1 8 d 4 Y -1 8 d -3 4 d
- -5 2 d -3 X cl s 133 2136 m -15 -31 d s 112 2136 m 21 X s 150 2136 m -4 -1 d -3
- -5 d -1 -7 d -5 Y 1 -7 d 3 -5 d 4 -1 d 3 X 5 1 d 3 5 d 1 7 d 5 Y -1 7 d -3 5 d
- -5 1 d -3 X cl s 1040 539 m 9 -21 d s 1057 539 m -8 -21 d -3 -6 d -3 -3 d -3 -1
- d -2 X s 1077 549 m 12 -31 d s 1100 549 m -11 -31 d s 1127 545 m -3 3 d -4 1 d
- -6 X -5 -1 d -3 -3 d -3 Y 2 -3 d 1 -1 d 3 -2 d 9 -3 d 3 -1 d 2 -2 d 1 -3 d -4 Y
- -3 -3 d -4 -2 d -6 X -5 2 d -3 3 d s 1139 521 m -2 -1 d 2 -2 d 1 2 d -1 1 d cl
- s 1166 539 m 16 -21 d s 1182 539 m -16 -21 d s gr
-showpage
- gr
-%%Trailer
-%%Pages: 1
- gr gr
-%%EOF
diff --git a/src/pawlib/paw/testsuite/paw.commands/nt_pl_3d_1.ref.ps b/src/pawlib/paw/testsuite/paw.commands/nt_pl_3d_1.ref.ps
deleted file mode 100644
index 30ef215..0000000
--- a/src/pawlib/paw/testsuite/paw.commands/nt_pl_3d_1.ref.ps
+++ /dev/null
@@ -1,2889 +0,0 @@
-%!PS-Adobe-2.0
-%%Title: /disk3/maartenb/cerncvs/paw/testsuite/tmp/nt_pl_3d_ (Portrait A 4)
-%%Pages: (atend)
-%%Creator: HIGZ Version 1.23/06
-%%CreationDate: 96/04/16 16.05
-%%EndComments
-%%BeginProlog
-/s {stroke} def /l {lineto} def /m {moveto} def /t {translate} def
-/sw {stringwidth} def /r {rotate} def /rl {roll} def /R {repeat} def
-/d {rlineto} def /rm {rmoveto} def /gr {grestore} def /f {eofill} def
-/c {setrgbcolor} def /lw {setlinewidth} def /sd {setdash} def
-/cl {closepath} def /sf {scalefont setfont} def /black {0 setgray} def
-/box {m dup 0 exch d exch 0 d 0 exch neg d cl} def
-/NC{systemdict begin initclip end}def/C{NC box clip newpath}def
-/bl {box s} def /bf {box f} def /Y { 0 exch d} def /X { 0 d} def
-/mp {newpath /y exch def /x exch def} def
-/side {[w .77 mul w .23 mul] .385 w mul sd w 0 l currentpoint t -144 r} def
-/mr {mp x y w2 0 360 arc} def /m24 {mr s} def /m20 {mr f} def
-/mb {mp x y w2 add m w2 neg 0 d 0 w neg d w 0 d 0 w d cl} def
-/mt {mp x y w2 add m w2 neg w neg d w 0 d cl} def
-/m21 {mb f} def /m25 {mb s} def /m22 {mt f} def /m26 {mt s} def
-/m23 {mp x y w2 sub m w2 w d w neg 0 d cl f} def
-/m27 {mp x y w2 add m w3 neg w2 neg d w3 w2 neg d w3 w2 d cl s} def
-/m28 {mp x w2 sub y w2 sub w3 add m w3 0 d 0 w3 neg d w3 0 d 0 w3 d w3 0 d
- 0 w3 d w3 neg 0 d 0 w3 d w3 neg 0 d
- 0 w3 neg d w3 neg 0 d cl s } def
-/m29 {mp gsave x w2 sub y w2 add w3 sub m currentpoint t
- 4 {side} repeat cl fill gr} def
-/m30 {mp gsave x w2 sub y w2 add w3 sub m currentpoint t
- 5 {side} repeat s gr} def
-/m31 {mp x y w2 sub m 0 w d x w2 sub y m w 0 d
- x w2 sub y w2 add m w w neg d x w2 sub y w2
- sub m w w d s} def
-/m2 {mp x y w2 sub m 0 w d x w2 sub y m w 0 d s} def
-/m5 {mp x w2 sub y w2 sub m w w d x w2 sub y w2 add m w w neg d s} def
-/DP {/PT exch def gsave 47.2 47.2 scale PT 1 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < AA AA 55 55 AA AA 55 55 AA AA 55 55 AA AA 55 55 AA AA 55 55 AA AA 55 55
-AA AA 55 55 AA AA 55 55 > } image } if PT 2 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < BB BB EE EE BB BB EE EE BB BB EE EE BB BB EE EE BB BB EE EE BB BB EE EE
-BB BB EE EE BB BB EE EE > } image } if PT 3 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < FF FF BB BB FF FF EE EE FF FF BB BB FF FF EE EE FF FF BB BB FF FF EE EE
-FF FF BB BB FF FF EE EE > } image } if PT 4 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < DF DF BF BF 7F 7F FE FE FD FD FB FB F7 F7 EF EF DF DF BF BF 7F 7F FE FE
-FD FD FB FB F7 F7 EF EF > } image } if PT 5 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < 7F 7F BF B F DF DF EF EF F7 F7 FB FB FD FD FE FE 7F 7F BF BF DF DF EF
-EF F7 F7 FB FB FD FD FE FE > } image } if PT 6 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB
-BB BB BB BB BB BB BB BB BB > } image } if PT 7 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < FF FF FF FF FF FF 00 00 FF FF FF FF FF FF 00 00 FF FF FF FF FF FF 00
-00 FF FF FF FF FF FF 00 00 > } image } if PT 8 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < EE EE 47 47 83 83 C5 C5 EE EE 5C 5C 38 38 74 74 EE EE 47 47 83 83 C5
-C5 EE EE 5C 5C 38 38 74 74 > } image } if PT 9 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < EF EF EF EF D7 D7 38 38 FE FE FE FE 7D 7D 83 83 EF EF EF EF D7 D7 38
-38 FE FE FE FE 7D 7D 83 83 > } image } if PT 10 eq { 16 16 1 [ 16 0 0 16 neg
-0 16 ] { < EF EF EF EF EF EF 00 00 FE FE FE FE FE FE 00 00 EF EF EF EF EF EF
-00 00 FE FE FE FE FE FE 00 00 > } image } if PT 11 eq { 16 16 1 [ 16 0 0 16
-neg 0 16 ] { < F7 F7 B6 B6 D5 D5 E3 E3 D5 D5 B6 B6 F7 F7 FF FF 7F 7F 6B 6B 5D
-5D 3E 3E 5D 5D 6B 6B 7F 7F FF FF > } image } if PT 12 eq { 16 16 1 [ 16 0 0
-16 neg 0 16 ] { < E3 E3 DD DD BE BE BE BE BE BE DD DD E3 E3 FF FF 3E 3E DD DD
-EB EB EB EB EB EB DD DD 3E 3E FF FF > } image } if PT 13 eq { 16 16 1 [ 16 0
-0 16 neg 0 16 ] { < FE FE 7D 7D BB BB D7 D7 EF EF D7 D7 BB BB 7D 7D FE FE 7D
-7D BB BB D7 D7 EF EF D7 D7 BB BB 7D 7D > } image } if PT 14 eq { 16 16 1 [ 16
-0 0 16 neg 0 16 ] { < 00 00 EE EF EE EF EE EF 0E E0 EE EE EE EE EE EE 00 EE
-FE EE FE EE FE EE 00 00 FE EF FE EF FE EF > } image } if PT 15 eq { 16 16 1 [
-16 0 0 16 neg 0 16 ] { < DD DD AA AA DD DD FF FF 77 77 AA AA 77 77 FF FF DD
-DD AA AA DD DD FF FF 77 77 AA AA 77 77 FF FF > } image } if PT 16 eq { 16 16
-1 [ 16 0 0 16 neg 0 16 ] { < F1 F1 EE EE 1F 1F FF FF F1 F1 EE EE 1F 1F FF FF
-F1 F1 EE EE 1F 1F FF FF F1 F1 EE EE 1F 1F FF FF > } image } if PT 17 eq { 16
-16 1 [ 16 0 0 16 neg 0 16 ] { < EE EE DD DD BB BB FF FF EE EE DD DD BB BB FF
- FF EE EE DD DD BB BB FF FF EE EE DD DD BB BB FF FF > } image } if PT 18 eq {
-16 16 1 [ 16 0 0 16 neg 0 16 ] { < BB BB DD DD EE EE FF FF BB BB DD DD EE EE
-FF FF BB BB DD DD EE EE FF FF BB BB DD DD EE EE FF FF > } image } if PT 19 eq
-{ 16 16 1 [ 16 0 0 16 neg 0 16 ] { < 1F FC 67 F3 7B EF BD DE BD DE DE BD E6
-B3 F8 0F E6 B3 DE BD BD DE BD DE 7B EF 67 F3 1F FC 7F FF > } image } if PT
-20 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < DD DD EE EE EE EE EE EE DD DD BB
-BB BB BB BB BB DD DD EE EE EE EE EE EE DD DD BB BB BB BB BB BB > } image }
-if PT 21 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < 0E 0E EF EF EF EF EF EF E0
-E0 FE FE FE FE FE FE 0E 0E EF EF EF EF EF EF E0 E0 FE FE FE FE FE FE > }
-image } if PT 22 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < 70 70 F7 F7 F7 F7 F7
-F7 07 07 7F 7F 7F 7F 7F 7F 70 70 F7 F7 F7 F7 F7 F7 07 07 7F 7F 7F 7F 7F 7F >
-} image } if PT 23 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < AA AA 55 55 A9 A9
-D1 D1 E1 E1 D1 D1 A9 A9 55 55 AA AA 55 55 A9 A9 D1 D1 E1 E1 D1 D1 A9 A9 55 55
-> } image } if PT 24 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < FF FE FF FC EA
-A8 D5 54 EA A8 D5 54 E8 28 D4 54 E8 E8 D4 D4 E8 EA 54 D5 A8 EA 54 D5 00 C0 00
-80 > } image } if PT 25 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < FF FE FF FC
-FF F8 FF F0 F0 00 F0 00 F0 20 F0 60 F0 E0 F1 E0 F3 E0 F0 00 E0 00 C0 00 80 00
-00 00 > } image } if gr } def /FA { /PT exch def gsave clip 0 0 translate 1 1
-54 { 1 sub 47.2 mul /Xcurr exch def 1 1 74 { 1 sub 47.2 mul /Ycurr exch def
-gsave Xcurr Ycurr translate PT DP gr } for } for gr } def
-/reencdict 24 dict def /ReEncode {reencdict begin /nco&na exch def
-/nfnam exch def /basefontname exch def /basefontdict basefontname findfont def
-/newfont basefontdict maxlength dict def basefontdict {exch dup /FID ne
-{dup /Encoding eq {exch dup length array copy newfont 3 1 roll put} {exch
-newfont 3 1 roll put} ifelse} {pop pop} ifelse } forall newfont
-/FontName nfnam put nco&na aload pop nco&na length 2 idiv {newfont
-/Encoding get 3 1 roll put} repeat nfnam newfont definefont pop end } def
-/accvec [ 176 /agrave 181 /Agrave 190 /acircumflex 192 /Acircumflex
-201 /adieresis 204 /Adieresis 209 /ccedilla 210 /Ccedilla 211 /eacute
-212 /Eacute 213 /egrave 214 /Egrave 215 /ecircumflex 216 /Ecircumflex
-217 /edieresis 218 /Edieresis 219 /icircumflex 220 /Icircumflex
-221 /idieresis 222 /Idieresis 223 /ntilde 224 /Ntilde 226 /ocircumflex
-228 /Ocircumflex 229 /odieresis 230 /Odieresis 231 /ucircumflex 236 /Ucircumflex
-237 /udieresis 238 /Udieresis 239 /aring 242 /Aring 243 /ydieresis
-244 /Ydieresis 246 /aacute 247 /Aacute 252 /ugrave 253 /Ugrave] def
-/Times-Roman /Times-Roman accvec ReEncode
-/Times-Italic /Times-Italic accvec ReEncode
-/Times-Bold /Times-Bold accvec ReEncode
-/Times-BoldItalic /Times-BoldItalic accvec ReEncode
-/Helvetica /Helvetica accvec ReEncode
-/Helvetica-Oblique /Helvetica-Oblique accvec ReEncode
-/Helvetica-Bold /Helvetica-Bold accvec ReEncode
-/Helvetica-BoldOblique /Helvetica-BoldOblique accvec ReEncode
-/Courier /Courier accvec ReEncode
-/Courier-Oblique /Courier-Oblique accvec ReEncode
-/Courier-Bold /Courier-Bold accvec ReEncode
-/Courier-BoldOblique /Courier-BoldOblique accvec ReEncode
-/oshow {gsave [] 0 sd true charpath stroke gr} def
-/stwn { /fs exch def /fn exch def /text exch def fn findfont fs sf
- text sw pop xs add /xs exch def} def
-/stwb { /fs exch def /fn exch def /nbas exch def /textf exch def
-textf length /tlen exch def nbas tlen gt {/nbas tlen def} if
-fn findfont fs sf textf dup length nbas sub nbas getinterval sw
-pop neg xs add /xs exch def} def
-/accspe [ 65 /plusminus 66 /bar 67 /existential 68 /universal
-69 /exclam 70 /numbersign 71 /greater 72 /question 73 /integral
-74 /colon 75 /semicolon 76 /less 77 /bracketleft 78 /bracketright
-79 /greaterequal 80 /braceleft 81 /braceright 82 /radical
-83 /spade 84 /heart 85 /diamond 86 /club 87 /lessequal
-88 /multiply 89 /percent 90 /infinity 48 /circlemultiply 49 /circleplus
-50 /emptyset 51 /lozenge 52 /bullet 53 /arrowright 54 /arrowup
-55 /arrowleft 56 /arrowdown 57 /arrowboth 48 /degree 44 /comma 43 /plus
- 45 /angle 42 /angleleft 47 /divide 61 /notequal 40 /equivalence 41 /second
- 97 /approxequal 98 /congruent 99 /perpendicular 100 /partialdiff 101 /florin
- 102 /intersection 103 /union 104 /propersuperset 105 /reflexsuperset
- 106 /notsubset 107 /propersubset 108 /reflexsubset 109 /element 110 /notelement
- 111 /gradient 112 /logicaland 113 /logicalor 114 /arrowdblboth
- 115 /arrowdblleft 116 /arrowdblup 117 /arrowdblright 118 /arrowdbldown
- 119 /ampersand 120 /omega1 121 /similar 122 /aleph ] def
-/Symbol /Special accspe ReEncode
-/Zone {/iy exch def /ix exch def ix 1 sub 2224 mul 1 iy sub 3144
- mul t} def
-%%EndProlog
- gsave 20 28 t .25 .25 scale gsave
-%%Page: number 1
- gsave
- 1 1 Zone
- gsave 0 0 t black [] 0 sd 1 lw 2223 2224 0 460 bl 2223 2224 0 460 C 1779 1778
- 222 683 C NC [4 8] 0 sd 222 1290 m 1128 287 d s 222 1401 m 1128 287 d s 222
- 1511 m 1128 287 d s 222 1622 m 1128 287 d s 222 1732 m 1128 287 d s 222 1843 m
- 1128 287 d s 222 1953 m 1128 287 d s 222 2064 m 1128 287 d s [] 0 sd 222 1180 m
- 1128 287 d s 1350 1467 m 994 Y s 222 2174 m 1128 287 d s 222 1180 m 994 Y s
- [4 8] 0 sd 1350 1577 m 651 -497 d s 1350 1688 m 651 -497 d s 1350 1798 m 651
- -497 d s 1350 1909 m 651 -497 d s 1350 2019 m 651 -497 d s 1350 2130 m 651 -497
- d s 1350 2240 m 651 -497 d s 1350 2351 m 651 -497 d s [] 0 sd 1350 1467 m 651
- -497 d s 2001 970 m 994 Y s 1350 2461 m 651 -497 d s 1350 1467 m cl s 994 539 m
- -16 -21 d s 978 539 m 16 X s 978 518 m 16 X s 1015 549 m 12 -31 d s 1039 549 m
- -12 -31 d s 1066 545 m -3 3 d -5 1 d -6 X -4 -1 d -3 -3 d -3 Y 1 -3 d 2 -1 d 3
- -2 d 9 -3 d 3 -1 d 1 -2 d 2 -3 d -4 Y -3 -3 d -5 -2 d -6 X -4 2 d -3 3 d s 1077
- 521 m -1 -1 d 1 -2 d 2 2 d -2 1 d cl s 1103 539 m 9 -21 d s 1120 539 m -8 -21 d
- -3 -6 d -3 -3 d -3 -1 d -2 X s 1140 549 m 12 -31 d s 1163 549 m -11 -31 d s
- 1190 545 m -3 3 d -4 1 d -6 X -5 -1 d -3 -3 d -3 Y 2 -3 d 1 -1 d 3 -2 d 9 -3 d
- 3 -1 d 2 -2 d 1 -3 d -4 Y -3 -3 d -4 -2 d -6 X -5 2 d -3 3 d s 1202 521 m -2 -1
- d 2 -2 d 1 2 d -1 1 d cl s 1229 539 m 16 -21 d s 1245 539 m -16 -21 d s /w 2
- def /w2 {w 2 div} def /w3 {w 3 div} def 786 1042 1193 1332 1501 1608 1324 1409
- 1423 1655 628 1192 1023 1162 813 1137 997 1369 1379 1552 1095 1523 1661 1681
- 1065 1153 1169 1232 1444 1909 1418 1488 1209 1394 1141 1221 1023 1218 770 1048
- 1401 1518 729 1034 1248 1411 561 1199 845 1068 860 1175 1603 1708 1297 1504
- 1592 1676 960 1440 1424 1480 694 1119 950 1109 683 1075 792 1229 1491 1523 1242
- 1260 992 1288 1111 1393 1154 1208 1136 1199 1550 1609 755 1326 722 1071 802
- 1063 990 1186 933 1362 1434 1425 1177 1247 1521 1781 1014 1138 949 1313 1539
- 1576 1271 1709 1474 1737 757 1314 1009 1138 1030 1366 846 1119 1464 1571 1480
- 1475 1483 1696 1394 1441 822 1507 658 1130 1197 1316 1585 1681 1395 1787 954
- 1262 1105 1395 688 1111 1078 1346 1152 1243 806 1255 784 1050 1510 1551 1423
- 1590 952 1113 1526 1695 1130 1374 654 1149 1052 1286 1588 1575 1392 1722 1203
- 1295 714 1155 1331 1742 1178 1234 1537 1684 1118 1233 1448 1651 1281 1373 801
- 1081 1313 1347 769 1353 692 1105 1394 1723 863 1084 1550 1751 1285 1417 100 {
- m20} R 1215 1337 770 1051 729 1053 854 1107 1438 1522 937 1153 1158 1289 1470
- 1511 836 1146 1388 1480 1168 1324 740 1147 1266 1275 906 1211 754 1400 1299
- 1701 660 1095 889 1486 764 1176 805 1244 1672 1699 952 1136 1426 1931 1577 1658
- 538 1205 1002 1144 1006 1141 1099 1309 711 1130 1522 1795 1195 1566 695 1258
- 759 1098 1185 1369 611 1108 1309 1433 1360 1473 1041 1330 1486 1488 888 1201
- 1352 1598 1558 1730 1396 1612 772 1141 1213 1760 1401 1697 1389 1734 1103 1390
- 896 1198 927 1126 1293 1314 1480 1721 1287 1363 828 1054 1577 1744 653 1094 947
- 1100 898 1664 668 1053 1073 1275 1513 1534 1208 1293 1099 1212 915 1113 625
- 1222 990 1139 1068 1163 1151 1202 876 1155 1250 1293 1193 1384 1247 1311 963
- 1104 1300 1361 1213 1307 617 1230 1144 1467 1011 1196 1546 1646 1365 1373 453
- 1506 1350 1565 650 1079 1128 1327 679 1163 687 1088 901 1097 871 1238 987 1245
- 802 1110 1241 1327 960 1325 620 1609 1544 1774 1045 1684 655 1060 998 1131 812
- 1148 1613 1610 1614 1700 100 { m20} R 954 1119 796 1083 1753 1733 1364 1559 614
- 1119 1259 1686 870 1326 1121 1184 1227 1368 638 1301 811 1298 1306 1394 748
- 1136 1366 1396 1402 1674 1245 1755 1247 1382 1122 1288 1519 1660 840 1145 886
- 1255 677 1053 999 1174 758 1232 998 1180 811 1125 893 1205 1124 1373 835 1055
- 1420 1836 1093 1317 1450 1743 989 1154 1407 1472 755 1176 1233 1297 981 1350
- 1233 1345 1129 1285 709 1135 981 1273 1508 1682 1300 1393 686 1049 1032 1145
- 1009 1134 1422 1518 1355 1388 1519 1732 979 1142 853 1456 1630 1676 1384 1522
- 981 1117 688 1044 1529 1559 1130 1189 1108 1326 1546 1673 1309 1409 915 1199
- 1023 1185 1048 1413 1168 1234 947 1132 1170 1258 1247 1264 995 1125 1333 1406
- 1120 1258 1627 1635 1370 1605 1221 1501 772 1201 1165 1328 1239 1257 630 1195
- 964 1105 838 1165 1104 1284 830 1110 838 1337 1240 1306 876 1327 1266 1457 1529
- 1610 1454 1424 1467 1526 1042 1378 1304 1319 1347 1626 1204 1365 1069 1263 1096
- 1226 1058 1157 1263 1637 861 1110 1397 1455 596 1393 638 1341 100 { m20} R 1463
- 1619 991 1176 596 1322 1505 1635 1361 1450 1154 1263 1344 1607 1344 1337 860
- 1346 995 1260 1352 1697 1470 1509 642 1097 1000 1229 1208 1309 1111 1205 1514
- 1694 1135 1316 1413 1493 998 1225 1111 1227 1229 1497 1469 1540 794 1045 1074
- 1296 920 1099 1303 1833 1585 1630 900 1253 1381 1538 1303 1403 733 1204 778
- 1038 907 1211 856 1434 770 1210 1563 1706 1562 1656 616 1115 681 1207 1435 1603
- 1007 1237 1062 1353 1565 1693 979 1397 1600 1610 701 1199 685 1343 1065 1332
- 1282 1338 1398 1519 1059 1384 611 1205 680 1198 1044 1530 699 1218 873 1141
- 1429 1933 859 1065 1417 1597 950 1202 1024 1452 1186 1317 978 1157 933 1128
- 1093 1272 691 1053 745 1064 597 1274 1292 1494 895 1303 668 1184 938 1281 777
- 1119 885 1074 779 1139 1358 1637 897 1143 1412 1498 1113 1204 939 1122 865 1096
- 1439 1755 1474 1492 813 1052 1009 1205 760 1078 1301 1430 1150 1369 1167 1268
- 1180 1362 599 1134 1089 1270 1465 1516 1272 1284 1682 1706 918 1099 499 1362
- 1326 1545 1367 1387 100 { m20} R 798 1097 1490 1479 927 1229 1496 1461 1661
- 1701 623 1201 798 1161 1153 1219 846 1078 1413 1748 1269 1371 726 1072 962 1103
- 910 1221 1099 1400 1458 1495 1294 1442 1485 1613 1329 1638 892 1077 1310 1580
- 939 1213 1308 1556 955 1210 855 1106 688 1136 1328 1470 1461 1675 1316 1442
- 1237 1448 973 1107 770 1145 907 1080 812 1251 485 1336 1019 1129 1540 1557 1169
- 1521 704 1106 1498 1686 688 1129 726 1100 793 1248 632 1216 1170 1737 1353 1491
- 1093 1569 1187 1481 977 1152 644 1080 693 1097 832 1155 1538 1634 1058 1180
- 1193 1478 1174 1438 1269 1344 1256 1536 1525 1618 1402 1498 988 1477 912 1088
- 981 1321 811 1127 1343 1440 1204 1311 681 1170 1307 1508 773 1102 675 1288 1493
- 1812 974 1134 794 1066 942 1210 763 1261 601 1104 1447 1759 1023 1142 1440 1522
- 633 1128 859 1224 996 1332 1532 1678 610 1196 1110 1225 1075 1301 821 1063 766
- 1254 920 1248 1053 1181 1204 1531 1270 1387 1285 1289 551 1179 1275 1517 1643
- 1684 1073 1157 1306 1532 1022 1469 1130 1366 100 { m20} R 970 1447 855 1064
- 1447 1497 794 1204 715 1136 1016 1347 930 1432 1115 1181 1528 1573 1153 1374
- 1270 1433 786 1212 1146 1467 1269 1478 1234 1443 1493 1751 1158 1499 976 1112
- 1087 1188 1159 1234 1062 1155 781 1239 1489 1567 661 1180 1429 1423 889 1075
- 1035 1242 1636 1676 807 1433 1199 1700 1309 1765 1139 1529 1231 1358 1431 1409
- 935 1424 877 1141 1057 1309 1217 1382 935 1172 880 1166 982 1146 1100 1195 1091
- 1368 1238 1390 1258 1606 731 1270 883 1142 1280 1581 1108 1265 1631 1592 1221
- 1247 1570 1715 1451 1575 1065 1220 1332 1581 692 1050 676 1083 1309 1353 1214
- 1672 801 1045 1484 1670 657 1086 777 1206 1620 1602 998 1252 1504 1616 1056
- 1160 1127 1299 1252 1267 1276 1299 1144 1429 780 1135 818 1098 1088 1293 901
- 1266 1125 1288 1065 1152 1154 1253 1301 1598 1243 1644 883 1080 628 1149 1158
- 1343 1608 1725 1403 1464 1583 1628 1399 1510 980 1110 1455 1442 1325 1472 638
- 1119 706 1136 1056 1386 1440 1467 736 1143 782 1046 852 1126 1500 1713 1023
- 1227 1378 1694 100 { m20} R 1493 1673 622 1165 939 1298 669 1082 876 1157 1388
- 1755 1016 1135 646 1099 1395 1696 1306 1610 1519 1617 915 1300 786 1110 1191
- 1273 1096 1233 1241 1317 1314 1533 1438 1822 1312 1355 977 1755 878 1196 1158
- 1362 1440 1441 1065 1306 1014 1147 1364 1447 1255 1673 1582 1566 1276 1341 552
- 1169 1177 1240 891 1075 1375 1451 1361 1420 1052 1228 1356 1829 1173 1531 1255
- 1572 1150 1201 1285 1318 1315 1943 1621 1666 1454 1728 809 1087 1535 1654 1475
- 1499 1513 1636 1191 1335 1472 1564 1342 1655 689 1040 999 1207 1096 1424 1089
- 1213 1161 1805 1005 1414 991 1188 1155 1404 784 1056 1280 1295 946 1169 982
- 1131 1207 1410 827 1155 798 1081 1148 1310 1200 1359 1055 1197 936 1298 1170
- 1369 1506 1537 887 1329 1026 1403 1312 1469 736 1248 1156 1472 771 1087 1711
- 1710 625 1167 1512 1499 1543 1776 774 1064 845 1100 1183 1308 689 1130 1506
- 1680 1532 1585 1563 1726 1082 1199 1455 1806 1009 1223 1221 1499 1242 1402 1275
- 1446 1132 1249 729 1044 1377 1748 805 1236 608 1137 1472 1774 100 { m20} R 1241
- 1390 791 1166 949 1195 876 1170 840 1117 687 1141 784 1055 1177 1469 910 1479
- 668 1187 1439 1518 1261 1598 1384 1529 933 1230 1109 1303 1185 1344 1024 1319
- 1495 1704 918 1126 1591 1664 1300 1477 1372 1479 1450 1825 1121 1276 811 1068
- 1213 1391 911 1443 1313 1589 1060 1535 917 1242 659 1239 1054 1276 1124 1189
- 738 1032 739 1098 773 1058 1466 1791 1043 1239 679 1128 951 1152 744 1044 1435
- 1644 772 1042 1152 1571 981 1329 872 1178 780 1189 1059 1189 737 1141 829 1137
- 1428 1779 662 1206 948 1272 1032 1220 1780 1757 659 1491 1045 1458 947 1241 833
- 1249 726 1063 1174 1255 1150 1348 957 1107 867 1221 1130 1435 1273 1629 682
- 1063 1508 1625 1570 1754 956 1180 1463 1494 1092 1231 1229 1274 1049 1176 815
- 1133 740 1033 1311 1445 1108 1180 1582 1720 1030 1209 787 1295 1270 1494 1318
- 1574 1247 1458 1292 1361 1013 1196 848 1128 913 1216 918 1164 1318 1360 926
- 1274 1236 1502 1309 1339 946 1407 785 1197 1525 1651 1408 1416 774 1067 857
- 1300 1455 1770 100 { m20} R 1265 1554 995 1232 1509 1525 1574 1631 1099 1267
- 637 1128 946 1243 805 1326 808 1154 1188 1285 1460 1683 834 1067 1430 1679 1537
- 1645 727 1107 1413 1672 1176 1664 1213 1253 1191 1521 1014 1178 656 1087 1375
- 1488 1509 1631 741 1043 1150 1203 819 1245 1606 1588 1546 1759 1402 1427 783
- 1067 1090 1235 1067 1319 1318 1391 1494 1513 1284 1310 942 1102 1341 1466 1470
- 1476 1423 1531 1171 1314 1047 1634 883 1216 687 1172 729 1129 898 1078 1167
- 1388 1354 1601 1516 1610 1394 1574 1092 1471 993 1523 1476 1647 1424 1425 1685
- 1684 1248 1552 904 1082 1279 1316 1443 1589 718 1090 1428 1442 1391 1371 1569
- 1642 1001 1331 888 1180 1057 1205 1118 1559 742 1054 1342 1711 1488 1808 1539
- 1730 775 1078 1385 1555 807 1265 1633 1688 1547 1533 530 1204 1398 1761 1049
- 1402 1126 1190 1101 1236 1001 1232 1590 1694 1508 1620 1053 1158 1385 1859 1041
- 1156 761 1035 1182 1234 1349 1373 1492 1643 1458 1430 776 1059 1014 1223 1208
- 1245 1259 1439 599 1142 1145 1316 879 1071 1172 1265 1013 1130 100 { m20} R 826
- 1160 1675 1657 1184 1397 1081 1263 1188 1488 928 1321 609 1234 879 1126 1211
- 1238 1413 1662 1489 1561 1469 1466 1348 1352 743 1233 814 1516 942 1100 1335
- 1332 1326 1582 1128 1339 769 1135 1110 1284 997 1129 1014 1206 778 1039 997
- 1193 1403 1560 1443 1529 1088 1202 1339 1518 887 1470 568 1198 903 1459 1069
- 1389 1013 1143 1106 1365 1217 1363 856 1234 1057 1411 1613 1668 917 1100 1021
- 1192 1002 1348 1212 1476 801 1214 913 1262 1270 1440 655 1205 1314 1652 1455
- 1660 1530 1592 1441 1613 860 1193 1231 1406 1250 1369 781 1099 1296 1363 629
- 1207 579 1171 807 1271 894 1078 1395 1473 1467 1616 764 1081 1591 1587 1369
- 1398 1131 1323 966 1420 814 1069 1168 1285 1569 1566 938 1223 1607 1618 1360
- 1630 1110 1354 1194 1296 1255 1278 644 1126 1195 1325 1266 1379 748 1374 1329
- 1459 1193 1302 616 1178 986 1238 1321 1443 662 1132 1263 1520 844 1401 1186
- 1477 1175 1383 685 1086 989 1242 1011 1158 739 1191 911 1096 1118 1336 871 1068
- 1252 1520 977 1262 1465 1675 100 { m20} R 1257 1436 1534 1587 821 1163 1501
- 1700 1458 1571 1299 1337 781 1154 862 1107 777 1358 1055 1362 991 1140 1349
- 1533 932 1162 1124 1328 1118 1201 1620 1663 1102 1239 854 1207 1363 1414 736
- 1062 1058 1272 580 1567 1534 1502 1388 1468 865 1312 697 1144 1164 1240 1574
- 1630 1296 1327 824 1230 722 1164 1375 1523 830 1085 1021 1181 1250 1396 618
- 1203 1310 1654 1297 1502 562 1183 1385 1864 905 1111 1167 1591 1067 1337 1079
- 1175 768 1089 595 1131 1239 1292 1108 1220 1479 1781 991 1286 1316 1313 785
- 1155 903 1349 767 1179 957 1142 644 1076 1386 1848 1107 1707 1028 1195 819 1201
- 1125 1340 698 1039 1082 1288 1057 1346 1468 1639 1280 1527 660 1088 843 1138
- 1007 1193 1371 1630 1426 1495 934 1189 1167 1429 1274 1451 913 1450 1460 1590
- 1040 1266 1376 1532 1359 1398 1364 1643 1238 1291 1149 1658 868 1211 1439 1460
- 1246 1373 956 1236 1258 1270 1049 1464 907 1488 823 1320 1281 1329 1319 1484
- 1335 1491 764 1082 1089 1242 1017 1375 1337 1454 873 1168 978 1160 998 1318 100
- { m20} R 926 1127 1145 1317 1212 1284 1590 1663 1443 1657 1230 1443 1366 1433
- 1049 1191 1329 1540 1098 1445 952 1107 856 1163 1251 1425 1284 1473 724 1234
- 1232 1270 1283 1353 991 1321 969 1474 1629 1703 1231 1520 1256 1329 1522 1630
- 1562 1625 1353 1502 1141 1217 938 1489 1397 1417 620 1252 954 1149 868 1190
- 1221 1775 1184 1461 1503 1677 1116 1282 1105 1228 1189 1510 1003 1158 1039 1204
- 1478 1678 772 1037 678 1055 1052 1264 1312 1382 1118 1523 706 1447 1625 1713
- 1414 1608 1639 1603 1500 1528 1074 1238 1586 1693 1635 1653 761 1127 683 1067
- 875 1116 1655 1679 1357 1478 1261 1484 895 1085 1374 1589 832 1246 1433 1510
- 1607 1636 1163 1208 1494 1729 705 1466 1125 1387 921 1262 858 1200 1428 1896
- 1223 1314 1373 1437 1406 1442 1166 1401 1293 1671 1015 1180 857 1139 762 1252
- 1554 1600 1357 1518 751 1120 735 1286 1050 1260 765 1174 672 1089 1301 1552
- 1041 1181 625 1126 831 1279 767 1038 1188 1511 1574 1677 1656 1690 863 1382 972
- 1162 1182 1515 1232 1467 1525 1691 928 1159 100 { m20} R 892 1127 820 1067 1349
- 1726 1203 1857 1459 1489 694 1081 798 1047 1045 1186 1352 1574 1298 1402 596
- 1157 1070 1181 878 1348 1531 1693 1580 1617 1672 1682 868 1099 896 1146 1427
- 1461 930 1103 836 1090 886 1221 1013 1292 739 1062 1346 1841 880 1238 1044 1206
- 858 1311 1479 1563 900 1080 1138 1267 661 1081 1184 1342 1381 1789 1279 1358
- 1042 1235 1148 1202 1581 1591 1513 1672 796 1054 1256 1285 589 1253 861 1066
- 1243 1411 803 1063 1178 1229 1125 1257 1234 1383 1293 1698 1305 1434 1173 1329
- 1130 1189 1470 1438 1349 1569 775 1042 1607 1581 1294 1384 1086 1239 1484 1474
- 1538 1672 1066 1252 893 1142 692 1130 1398 1458 949 1128 1023 1245 1347 1568
- 1045 1283 1069 1284 729 1155 1169 1461 889 1144 1511 1711 1517 1724 1616 1661
- 1096 1363 939 1329 1122 1532 1421 1441 1308 1757 766 1068 802 1385 930 1119 730
- 1143 1016 1420 782 1420 971 1199 1044 1151 784 1040 1146 1330 913 1199 853 1118
- 962 1137 1564 1723 1459 1558 808 1230 1025 1358 1294 1425 1213 1304 1412 1630
- 100 { m20} R 741 1162 955 1276 689 1042 1037 1148 1154 1506 901 1289 1399 1492
- 1048 1144 1027 1297 1428 1812 1522 1589 1598 1610 1288 1306 1217 1942 785 1261
- 908 1380 1614 1600 623 1218 885 1189 1364 1602 968 1152 1243 1618 1012 1406 975
- 1253 752 1046 1544 1550 892 1101 1012 1233 1375 1672 1093 1238 1459 1572 776
- 1110 678 1046 620 1151 982 1232 693 1247 964 1276 1530 1569 723 1113 840 1323
- 1121 1502 1634 1679 683 1248 876 1291 1030 1228 952 1313 1417 1720 1341 1572
- 622 1083 1448 1763 938 1463 1547 1558 1469 1460 1305 1661 1458 1723 1504 1786
- 1333 1587 1270 1451 1590 1710 1054 1270 1247 1422 1485 1526 899 1422 1323 1408
- 797 1069 1510 1501 717 1162 1504 1723 986 1185 1087 1402 754 1144 878 1129 948
- 1097 1188 1256 698 1142 1581 1706 1501 1549 1424 1804 638 1190 1208 1472 1584
- 1590 1410 1409 848 1099 746 1165 1256 1272 1329 1879 765 1141 893 1093 1506
- 1619 1149 1307 659 1100 957 1180 1099 1319 1654 1616 859 1189 590 1259 1529
- 1681 1053 1345 929 1150 763 1180 100 { m20} R 1304 1566 887 1227 832 1412 905
- 1284 1364 1367 794 1164 1534 1681 1416 1880 874 1193 1159 1281 1173 1476 933
- 1635 776 1175 862 1447 1238 1381 1032 1489 967 1256 874 1107 1013 1158 847 1526
- 1669 1687 1666 1653 1090 1245 590 1215 910 1082 810 1348 701 1068 794 1167 866
- 1091 927 1317 1190 1230 1079 1181 731 1041 902 1106 692 1168 1306 1609 1039
- 1200 759 1226 1112 1370 1025 1165 1413 1445 866 1175 1377 1684 969 1113 923
- 1174 1637 1701 1440 1664 1309 1751 839 1072 1308 1311 616 1116 890 1109 1016
- 1136 884 1340 1132 1211 535 1465 1246 1327 1023 1267 1450 1657 692 1305 733
- 1161 1454 1505 1515 1707 1028 1186 878 1080 765 1237 796 1045 1475 1694 1524
- 1659 1610 1594 1186 1355 1280 1365 566 1236 965 1308 1282 1573 1123 1418 816
- 1132 1240 1585 747 1149 1128 1382 961 1372 1539 1650 737 1052 827 1128 693 1057
- 758 1046 1466 1450 1398 1784 1192 1295 1371 1538 658 1241 738 1259 918 1346 583
- 1130 1103 1172 1294 1624 1148 1401 1544 1617 1034 1137 1007 1172 100 { m20} R
- 1016 1264 1003 1178 900 1096 554 1187 1057 1172 1604 1575 1175 1216 1363 1385
- 1443 1479 774 1119 1109 1586 1255 1423 1120 1282 1491 1816 1093 1213 1175 1225
- 717 1212 1391 1574 1488 1579 822 1133 720 1067 684 1274 1184 1258 877 1086 1344
- 1493 1384 1510 1427 1491 1506 1529 1277 1286 1100 1429 880 1100 960 1219 1324
- 1806 907 1233 1587 1580 1206 1247 812 1311 1111 1867 653 1107 1381 1421 1576
- 1609 1362 1484 1236 1813 629 1083 1101 1171 974 1284 822 1090 1304 1757 836
- 1097 1281 1287 1258 1380 1250 1397 989 1328 1183 1491 790 1117 732 1138 1259
- 1280 1648 1707 800 1224 1551 1695 968 1336 897 1255 1144 1474 1483 1515 1320
- 1320 1277 1476 1381 1650 1282 1292 1182 1330 1392 1459 881 1253 1222 1401 1499
- 1569 944 1095 871 1218 1669 1702 1155 1382 961 1209 1079 1221 1522 1757 1086
- 1212 895 1233 1221 1361 1129 1194 1100 1316 1095 1331 758 1455 1360 1527 969
- 1144 1512 1639 890 1229 795 1053 862 1200 1139 1570 1633 1684 1206 1355 666
- 1247 831 1288 1298 1460 1493 1771 100 { m20} R 847 1072 850 1232 736 1212 661
- 1079 1016 1527 939 1112 512 1265 1434 1508 901 1142 1149 1505 1098 1240 1317
- 1818 979 1143 1344 1415 1757 1741 910 1214 1541 1733 1061 1327 998 1635 954
- 1418 1254 1654 1269 1298 1371 1467 1051 1432 1422 1459 1512 1502 1551 1640 1030
- 1182 1649 1713 1126 1261 1230 1266 846 1074 1362 1705 1060 1204 766 1035 1510
- 1758 735 1136 985 1123 986 1129 1467 1531 1318 1418 860 1072 1287 1513 1011
- 1168 1517 1790 825 1123 1476 1531 1097 1173 1100 1171 1388 1604 1481 1600 859
- 1451 842 1143 1318 1487 1567 1594 1131 1421 907 1147 1409 1402 1058 1225 732
- 1036 919 1135 1406 1824 705 1122 954 1128 1470 1470 1160 1416 1022 1161 805
- 1105 1028 1238 1044 1240 917 1114 1411 1513 1118 1374 1556 1526 730 1056 835
- 1104 1566 1587 1475 1615 1548 1763 1023 1226 1361 1401 1304 1413 822 1190 1113
- 1212 1624 1677 719 1300 1392 1398 1347 1491 603 1150 1386 1559 1300 1596 1044
- 1182 660 1102 920 1178 779 1039 974 1144 1247 1338 988 1261 1369 1674 1511 1653
- 100 { m20} R 1196 1346 998 1192 598 1167 1495 1815 904 1116 1486 1695 1277 1724
- 1496 1724 1347 1396 1339 1473 697 1160 1009 1195 874 1135 737 1306 770 1039
- 1411 1610 1119 1339 983 1435 1192 1278 1105 1437 1561 1543 987 1434 857 1401
- 1105 1367 1199 1235 1565 1644 1114 1286 1192 1838 913 1132 1326 1620 511 1253
- 1130 1375 1416 1555 1262 1503 1307 1484 935 1093 690 1053 686 1159 887 1077
- 1471 1439 756 1148 1078 1327 1056 1157 1458 1600 1200 1434 856 1239 671 1141
- 1550 1646 1318 1600 1283 1411 1371 1471 1019 1169 1439 1582 604 1244 1065 1157
- 1115 1495 1136 1515 1089 1375 585 1207 1041 1182 987 1186 1119 1214 1283 1644
- 1038 1545 904 1098 647 1112 1164 1499 1247 1479 1406 1580 1023 1183 877 1270
- 1402 1816 1265 1431 1293 1353 958 1113 1375 1713 1481 1849 1191 1316 815 1285
- 1130 1208 1304 1522 783 1042 764 1036 697 1152 858 1160 1275 1437 1324 1490
- 1700 1674 1477 1468 1772 1747 838 1248 784 1074 1242 1374 1245 1434 785 1189
- 757 1157 1168 1218 1291 1364 1149 1255 840 1063 100 { m20} R 1163 1572 1477
- 1707 825 1061 778 1126 938 1533 1214 1395 1116 1276 1244 1400 1452 1504 858
- 1170 617 1189 1328 1470 1136 1193 1364 1466 790 1220 1319 1572 1537 1530 1376
- 1390 599 1191 1300 1534 1505 1825 1466 1606 718 1246 1254 1365 1271 1358 1048
- 1235 1652 1682 1282 1406 1569 1617 1317 1345 694 1081 826 1176 1242 1407 914
- 1263 1423 1454 805 1073 1384 1429 1135 1296 735 1046 981 1233 954 1328 1302
- 1352 1065 1164 631 1381 633 1142 643 1088 997 1250 1201 1232 951 1197 1421 1589
- 1662 1629 1160 1214 1047 1183 1036 1278 1240 1374 685 1042 816 1063 1380 1815
- 1327 1559 725 1335 1399 1407 649 1133 982 1278 1129 1370 1311 1446 844 1066
- 1024 1140 1230 1323 740 1055 1326 1439 1537 1628 911 1135 1095 1545 1263 1438
- 987 1177 1479 1554 702 1120 1245 1523 689 1061 1224 1479 1432 1817 940 1221
- 1293 2023 475 1338 1268 1432 707 1128 1028 1212 1047 1275 1483 1486 743 1055
- 1253 1802 1176 1274 1247 1420 960 1283 1203 1373 661 1096 1495 1700 1175 1410
- 912 1145 1015 1161 100 { m20} R 700 1195 1463 1698 1257 1570 782 1118 1305 1318
- 1428 1485 1413 1701 1195 1276 1343 1598 926 1114 1201 1260 1017 1282 1018 1205
- 808 1077 977 1287 1126 1266 832 1151 1012 1158 1141 1219 1377 1610 1408 1437
- 1439 1607 787 1042 995 1395 1332 1359 1105 1727 1429 1486 1071 1271 1349 1377
- 1244 1416 1171 1298 1068 1155 1247 1593 1303 1332 1315 1458 1386 1463 1482 1674
- 1021 1514 1312 1382 914 1129 1289 1418 1276 1741 1474 1635 1067 1338 654 1172
- 879 1253 1400 1386 827 1106 1363 1421 1005 1123 1319 1369 1468 1544 706 1266
- 946 1422 913 1133 835 1270 1327 1571 1092 1177 1331 1927 1445 1735 1527 1634
- 848 1317 1632 1668 1418 1661 1071 1247 998 1171 888 1350 868 1227 861 1238 1218
- 1381 1189 1588 1422 1912 736 1151 949 1164 1512 1566 1339 1359 822 1211 819
- 1051 646 1149 1783 1758 1469 1538 882 1425 1367 1478 848 1067 762 1050 769 1130
- 1180 1308 989 1268 1430 1577 1464 1450 1473 1686 753 1085 1368 1816 1029 1299
- 1559 1651 1307 1457 837 1293 1493 1494 1359 1553 1327 1670 100 { m20} R 1593
- 1700 1320 1338 728 1101 1355 1572 1096 1238 618 1171 1551 1660 1037 1393 1176
- 1694 870 1080 876 1284 1166 1760 666 1180 1284 1392 1587 1586 651 1136 1285
- 1413 690 1132 667 1241 1196 1284 1220 1485 1498 1755 954 1143 1259 1300 1427
- 1516 894 1104 803 1131 1042 1172 1510 1812 1052 1605 1176 1319 1557 1757 1485
- 1671 649 1092 1505 1615 883 1178 643 1065 1068 1525 1385 1690 877 1069 1436
- 1532 1147 1257 444 1401 1084 1238 1140 1201 1187 1608 927 1094 1087 1239 48 {
- m20} R 956 1183 1584 1625 1158 1235 1436 1836 1314 1453 1378 1759 755 1182 1361
- 1482 946 1260 1181 1291 1054 1212 1004 1194 1459 1499 1558 1586 834 1109 743
- 1459 1479 1666 1071 1260 1642 1702 1064 1201 1533 1693 839 1119 995 1280 1646
- 1652 686 1045 1403 1787 931 1146 1063 1265 1155 1443 1399 1818 907 1080 1332
- 1490 666 1250 574 1229 684 1164 1242 1716 1282 1361 919 1109 778 1125 882 1141
- 831 1097 1358 1369 964 1104 1183 1465 750 1144 1139 1360 1010 1221 628 1179 769
- 1243 1129 1236 1175 1276 1162 1413 896 1121 872 1277 861 1077 1606 1573 1310
- 1310 591 1179 848 1125 1306 1438 870 1084 765 1157 1427 1544 970 1394 1273 1387
- 758 1041 1298 1392 1130 1190 1566 1685 1280 1334 689 1166 1274 1283 1249 1267
- 952 1167 1332 1607 1514 1548 808 1108 1044 1197 1259 1425 1283 1500 957 1132
- 1462 1822 760 1045 1067 1228 1323 1492 757 1041 1275 1515 987 1378 1534 1739
- 1263 1345 735 1066 1499 1650 1166 1421 1064 1210 1657 1689 1524 1713 1347 1339
- 994 1297 1212 1261 1415 1437 100 { m20} R 1563 1695 681 1112 598 1164 1510 1686
- 1065 1377 890 1137 678 1160 860 1107 1039 1347 1511 1558 1544 1511 1420 1502
- 1287 1559 955 1261 950 1195 834 1130 800 1055 649 1111 766 1152 969 1215 898
- 1502 1030 1463 735 1249 1261 1432 1514 1779 1148 1416 771 1083 897 1237 1067
- 1601 1416 1463 1037 1324 965 1122 939 1261 1121 1224 1554 1643 1068 1304 943
- 1095 983 1121 1184 1255 1041 1153 817 1193 1274 1401 1151 1437 976 1138 1570
- 1612 1626 1661 1394 1639 1022 1263 1016 1281 1527 1761 1173 1470 1379 1676 703
- 1146 1421 1534 1441 1771 1226 1391 860 1395 820 1414 746 1154 1316 1634 905
- 1083 828 1053 1045 1603 864 1228 992 1289 1439 1796 1102 1319 1215 1251 592
- 1328 1238 1291 1666 1677 1218 1292 962 1195 874 1070 1559 1555 1345 1655 882
- 1104 765 1085 1297 1934 731 1163 1537 1605 944 1100 758 1138 1124 1233 857 1102
- 1295 1687 725 1062 1165 1249 745 1184 1382 1558 948 1182 767 1280 655 1189 1142
- 1248 1106 1364 588 1151 1316 1599 1512 1621 891 1081 854 1067 100 { m20} R 1374
- 1505 1335 1451 701 1116 753 1120 1362 1614 673 1343 757 1061 752 1038 526 1389
- 1680 1694 1157 1280 765 1038 707 1064 1341 1567 1272 1841 1507 1766 826 1067
- 1264 1381 1067 1159 776 1140 1181 1320 849 1201 1127 1315 712 1097 1309 1430
- 920 1427 909 1086 872 1138 1295 1598 1149 1470 1189 1345 742 1095 775 1045 1529
- 1765 884 1117 640 1161 1214 1354 941 1236 1225 1505 1269 1415 835 1155 1305
- 1623 1469 1585 1065 1224 1695 1711 567 1367 777 1185 1043 1146 1160 1243 1410
- 1517 1188 1316 1401 1491 1219 1400 653 1200 1544 1680 836 1408 864 1201 1511
- 1573 1433 1736 1062 1250 901 1347 837 1317 1238 1449 1544 1603 869 1267 621
- 1140 1188 1278 1437 1440 656 1259 599 1309 812 1127 827 1130 1325 1665 1132
- 1392 1150 1390 736 1112 1176 1314 1105 1478 1242 1546 1374 1778 1572 1587 1526
- 1604 1287 1502 1259 1399 1499 1570 1101 1223 883 1102 981 1136 883 1184 1625
- 1692 853 1092 1434 1543 1381 1425 986 1153 850 1141 833 1139 1263 1325 940 1094
- 1028 1153 797 1046 100 { m20} R 1246 1543 1067 1298 1111 1177 751 1033 992 1233
- 1223 1458 1146 1268 670 1281 1528 1667 672 1107 1321 1398 1290 1630 1266 1496
- 1302 1550 1240 1443 791 1333 673 1212 1503 1753 1143 1401 1342 1619 1489 1681
- 775 1137 1108 1247 1186 1289 835 1081 793 1078 1516 1496 617 1286 1367 1388
- 1579 1644 796 1234 1260 1605 1059 1305 1344 1819 1356 1412 1571 1664 1196 1303
- 1087 1434 1068 1155 1009 1129 1383 1384 716 1300 757 1337 1030 1262 1402 1521
- 994 1391 1380 1501 874 1459 709 1073 1328 1467 1534 1781 1420 1515 874 1179
- 1016 1240 1411 1453 1319 1731 1487 1742 1701 1710 909 1129 948 1205 1355 1448
- 841 1227 1239 1413 1585 1600 762 1041 980 1124 1528 1776 1190 1499 1016 1244
- 1189 1336 1200 1288 800 1329 1566 1589 1272 1590 1483 1528 827 1055 1613 1599
- 1628 1613 969 1131 1262 1552 1621 1699 1566 1642 1641 1635 732 1113 1587 1716
- 1449 1474 1040 1235 1306 1403 1184 1437 826 1202 1401 1489 756 1114 1316 1402
- 665 1094 1316 1721 1102 1319 750 1064 923 1302 1333 1767 898 1117 100 { m20} R
- 1585 1605 1496 1473 1544 1557 1213 1240 1550 1663 1166 1494 1045 1278 1383 1460
- 863 1135 755 1057 1253 1317 632 1092 782 1161 1299 1407 775 1050 1040 1212 982
- 1276 990 1389 1046 1306 1394 1671 1213 1425 609 1130 869 1271 1101 1240 639
- 1110 1483 1653 1137 1543 1266 1436 848 1218 1122 1227 1185 1268 1003 1484 1206
- 1458 1340 1463 897 1106 923 1141 977 1218 1580 1663 1251 1478 886 1150 1293
- 1492 634 1235 746 1109 1438 1528 1560 1539 1384 1603 515 1360 1352 1467 950
- 1238 851 1072 965 1174 1622 1675 1485 1759 1446 1710 1223 1296 1269 1391 1088
- 1640 1448 1589 1175 1687 1198 1308 870 1275 564 1195 1111 1438 1483 1743 1515
- 1610 1381 1510 996 1188 1499 1499 675 1139 1403 1649 1174 1539 987 1187 937
- 1207 692 1068 885 1245 968 1313 610 1118 1390 1480 1339 1652 1479 1785 839 1202
- 1562 1634 1542 1562 1332 1417 1529 1700 1691 1681 872 1275 1005 1275 1241 1648
- 1547 1687 813 1193 1392 1763 905 1223 738 1070 633 1240 1531 1583 1524 1562
- 1295 1524 1265 1315 746 1111 100 { m20} R 652 1280 1120 1182 905 1114 1382 1555
- 576 1211 675 1075 771 1039 1254 1333 1500 1469 818 1148 711 1047 1489 1763 1516
- 1722 881 1355 849 1062 1326 1746 800 1057 1254 1294 1172 1396 1063 1195 760
- 1056 1360 1486 870 1135 1347 1344 681 1215 1152 1205 1277 1405 1061 1217 840
- 1168 955 1129 1046 1308 804 1057 1266 1280 1564 1553 1087 1360 1036 1138 720
- 1052 1169 1451 784 1055 1073 1250 1457 1484 617 1088 807 1078 1198 1244 1406
- 1710 1201 1514 779 1069 580 1322 1521 1778 1300 1384 1407 1739 1360 1579 673
- 1167 1512 1608 975 1355 1172 1336 947 1141 772 1146 989 1239 1544 1654 805 1072
- 1417 1615 758 1040 1411 1555 1130 1251 1397 1461 1307 1411 1042 1366 1016 1314
- 969 1208 1143 1196 748 1076 1131 1407 1573 1740 1185 1370 1604 1716 1549 1734
- 1227 1340 1151 1228 1578 1718 1106 1179 648 1066 685 1297 1361 2042 1189 1290
- 1071 1214 1450 1534 1443 1426 1214 1407 1470 1692 975 1461 1549 1649 1505 1757
- 855 1132 1272 1635 1518 1630 673 1209 1455 1564 1343 1633 1160 1281 100 { m20
-} R 931 1206 1054 1163 1509 1659 1082 1320 788 1081 1327 1492 1318 1388 702 1243
- 1285 1643 941 1156 713 1055 1334 1797 1476 1616 1212 1350 964 1151 1422 1553
- 1419 1590 772 1265 1027 1160 1064 1164 1294 1523 1237 1301 1065 1328 1286 1341
- 656 1229 1177 1244 894 1086 1379 1473 973 1390 1222 1259 822 1164 708 1256 934
- 1093 955 1189 1381 1423 811 1055 1162 1436 1096 1249 928 1158 814 1256 957 1469
- 961 1322 982 1316 917 1188 1524 1640 747 1053 1306 1622 609 1187 1722 1692 985
- 1250 1352 1381 1186 1371 584 1125 1443 1601 1496 1603 1406 1507 771 1417 1178
- 1461 762 1108 1111 1198 1022 1302 1544 1631 1437 1555 1327 1465 1291 1522 1197
- 1457 708 1371 1135 1297 879 1318 1251 1514 1316 1354 791 1075 626 1111 1311
- 1380 1104 1223 589 1126 843 1117 1012 1400 824 1564 1219 1403 738 1127 900 1221
- 669 1184 920 1095 960 1173 668 1054 1385 1378 1085 1459 1263 1412 1582 1639
- 1533 1516 1119 1415 1366 1619 737 1069 1422 1605 1114 1386 893 1166 1275 1345
- 1496 1650 869 1124 100 { m20} R 884 1230 926 1287 1319 1443 733 1116 918 1087
- 956 1263 1028 1183 1228 1251 949 1273 787 1058 1486 1530 1380 1402 1496 1795
- 1681 1704 991 1225 1034 1191 1281 1501 1213 1347 679 1223 1097 1175 1361 1522
- 1013 1275 979 1226 782 1229 1594 1583 1430 1432 1352 1570 846 1082 822 1083
- 1515 1593 985 1175 773 1137 1564 1600 1026 1167 1070 1676 1395 1604 1341 1426
- 1645 1642 1197 1233 928 1090 1004 1494 836 1084 885 1073 1255 1790 1130 1454
- 868 1091 1062 1496 700 1123 1052 1251 1104 1537 1578 1562 1088 1361 900 1202
- 1224 1256 1014 1128 1010 1126 1406 1538 680 1082 1185 1271 903 1112 1485 1714
- 1023 1131 760 1217 909 1208 1060 1286 1139 1251 752 1044 1155 1325 1057 1265
- 1371 1661 1419 1777 977 1235 1008 1309 702 1076 1091 1400 1425 1762 1376 1575
- 927 1255 680 1127 1081 1192 1463 1694 491 1471 1177 1237 1278 1296 1189 1282
- 1102 1344 1000 1120 1270 1546 777 1284 1022 1406 1291 1464 1561 1554 1213 1725
- 911 1394 973 1123 961 1181 620 1085 1099 1171 1546 1659 830 1404 100 { m20} R
- 1306 1327 1362 1530 903 1304 1214 1276 1008 1245 1126 1300 1552 1610 904 1090
- 1220 1506 1562 1592 1342 1445 556 1253 723 1623 1063 1234 1392 1686 1367 1463
- 1021 1311 1269 1336 1631 1682 871 1330 850 1319 792 1157 1031 1331 669 1063 944
- 1108 713 1073 1287 1517 1673 1682 1216 1285 839 1067 1576 1592 979 1225 1169
- 1628 867 1373 1277 1299 783 1115 1151 1591 1317 1494 956 1153 1486 1485 704
- 1048 1451 1557 1154 1509 1009 1213 846 1064 1195 1454 994 1437 1006 1291 1571
- 1732 813 1297 1054 1428 1069 1169 1358 1466 818 1643 965 1138 704 1099 1091
- 1252 703 1097 1453 1687 1454 1483 1482 1458 1094 1237 1502 1466 1056 1192 851
- 1060 1216 1763 1345 1371 1346 1355 899 1358 617 1113 1167 1331 1338 1424 730
- 1224 1584 1724 1361 1380 994 1216 1119 1207 922 1143 1047 1313 1385 1602 1179
- 1305 1110 1226 1005 1129 1220 1356 1216 1262 1395 1801 1562 1721 1159 1386 1500
- 1627 731 1061 777 1203 915 1333 923 1116 833 1188 945 1122 1301 1317 1476 1600
- 891 1139 684 1041 801 1100 100 { m20} R 971 1111 781 1116 1541 1611 991 1128
- 1385 1633 1273 1324 859 1125 1513 1586 1365 1524 1600 1642 914 1109 884 1099
- 1219 1584 658 1266 1256 1369 880 1197 1484 1489 698 1093 939 1124 763 1049 960
- 1103 1416 1565 854 1324 851 1087 737 1195 1145 1374 1526 1557 1572 1537 1105
- 1183 834 1097 802 1066 1222 1596 1101 1270 805 1186 849 1379 1391 1531 860 1066
- 728 1298 1316 1583 821 1163 1201 1520 1340 1907 1537 1577 1426 1545 1158 1286
- 1259 1402 1054 1234 1280 1423 840 1172 1525 1641 759 1095 801 1127 1118 1411
- 889 1297 1428 1794 1115 1248 1029 1222 1113 1336 1452 1615 1502 1595 792 1213
- 994 1189 872 1186 929 1282 1411 1603 866 1269 910 1377 1435 1619 1131 1429 1055
- 1257 702 1036 1459 1556 990 1119 800 1152 665 1092 812 1237 1120 1297 1127 1239
- 712 1047 1229 1252 1274 1283 759 1201 1481 1572 1587 1567 1380 1514 1342 1380
- 995 1213 792 1170 1418 1750 757 1042 1467 1555 971 1273 1397 1579 1308 1497
- 1076 1243 742 1316 1116 1736 1218 1346 980 1209 1451 1596 100 { m20} R 1399
- 1488 1283 1292 923 1088 1031 1163 1252 1335 934 1480 1004 1416 1067 1199 1096
- 1475 940 1239 1509 1731 919 1154 893 1138 618 1145 1546 1712 1402 1443 694 1165
- 700 1172 1598 1697 745 1087 712 1057 1273 1796 1267 1558 1296 1341 1197 1232
- 882 1116 1303 1447 609 1205 725 1081 686 1313 751 1032 660 1127 924 1281 1552
- 1762 951 1164 1210 1313 749 1114 1317 1523 840 1077 1386 1431 1336 1464 1343
- 1399 1017 1246 1266 1460 987 1121 1225 1814 1244 1341 1243 1341 725 1070 1345
- 1564 927 1392 849 1077 1375 1477 734 1223 1479 1617 1229 1817 1379 1424 696
- 1089 1446 1821 1114 1271 636 1106 1177 1429 1448 1774 1517 1800 757 1049 946
- 1123 663 1129 781 1069 639 1172 1670 1645 1625 1640 1154 1237 739 1261 993 1308
- 815 1167 1152 1211 745 1206 1075 1344 1614 1675 836 1113 922 1186 1524 1774
- 1226 1379 1350 1610 1427 1444 1560 1629 1566 1611 1498 1500 1367 1648 1071 1169
- 863 1280 1190 1413 1382 1606 1587 1601 797 1200 922 1204 695 1064 1427 1901
- 1470 1478 1438 1532 100 { m20} R 1539 1626 1506 1483 761 1064 1549 1743 1528
- 1730 1230 1591 1447 1450 732 1066 1084 1180 1174 1216 789 1275 1331 1940 618
- 1086 667 1116 1101 1508 951 1470 1244 1438 868 1077 942 1263 1442 1499 658 1167
- 1537 1760 1223 1348 1209 1452 1126 1261 792 1129 1210 1468 772 1037 733 1079
- 1330 1384 805 1119 1338 1546 1428 1531 808 1052 1033 1158 1442 1751 932 1203
- 682 1055 659 1283 1457 1846 821 1077 937 1121 1097 1407 719 1062 1299 1409 1102
- 1231 740 1096 1068 1449 758 1172 1069 1157 1181 1266 1188 1263 819 1054 1282
- 1708 1211 1267 1333 1345 744 1066 883 1088 1013 1247 692 1169 1001 1255 1384
- 1662 1626 1642 787 1232 834 1131 801 1178 1285 1401 1403 1425 1531 1586 1366
- 1378 1346 1450 1185 1574 1024 1147 1222 1296 752 1174 1415 1404 895 1130 1186
- 1449 618 1124 1430 1664 673 1085 1485 1697 959 1545 1199 1424 727 1037 909 1135
- 747 1099 839 1057 1202 1251 587 1221 883 1206 1307 1447 1426 1893 1270 1376 918
- 1288 677 1076 1346 1468 1164 1565 699 1148 1399 1452 100 { m20} R 1384 1579 900
- 1160 1129 1200 1151 1270 881 1140 1176 1392 663 1129 961 1108 1302 1433 1280
- 1558 1150 1402 1501 1505 791 1047 1222 1328 617 1157 1034 1296 1184 1364 864
- 1077 1504 1522 865 1157 1378 1702 733 1126 940 1255 947 1348 1218 1515 1348
- 1412 1568 1731 1451 1893 798 1138 744 1183 675 1049 1674 1669 888 1193 1050
- 1327 1010 1379 1211 1330 1595 1627 1194 1325 1266 1481 1420 1552 1709 1675 1564
- 1573 1056 1241 1027 1305 837 1083 1236 1537 922 1142 1481 1709 1519 1652 1106
- 1306 1229 1417 1265 1561 1163 1313 1497 1637 867 1096 923 1205 1523 1725 1266
- 1448 962 1225 1466 1463 1498 1578 1234 1597 747 1239 773 1118 951 1147 994 1230
- 1098 1414 771 1267 1302 1439 790 1147 1570 1564 435 1535 879 1076 1622 1641 977
- 1183 1455 1597 723 1178 1118 1613 1580 1720 1454 1604 917 1110 1549 1644 899
- 1077 1553 1636 1258 1357 870 1076 976 1204 877 1133 908 1102 900 1123 1446 1500
- 1259 1396 1451 1804 1032 1137 1522 1681 1236 1312 1025 1524 915 1327 1191 1260
- 1347 1599 100 { m20} R 585 1167 1315 1380 762 1035 1339 1378 1247 1376 1123
- 1322 1657 1686 835 1077 1431 1584 1187 1223 1117 1285 1111 1387 990 1157 1096
- 1260 984 1260 1544 1652 605 1196 788 1159 1373 1552 1007 1192 1364 1421 851
- 1078 854 1180 1510 1778 862 1262 747 1216 1099 1350 909 1168 530 1231 1423 1608
- 1284 1606 1221 1261 1465 1659 606 1230 1131 1586 1424 1398 1209 1802 742 1085
- 897 1098 1128 1289 1294 1373 1203 1438 1059 1270 1140 1334 590 1117 580 1411
- 1513 1767 729 1119 1249 1285 806 1120 908 1140 1089 1353 858 1351 972 1150 766
- 1159 1033 1157 679 1357 1184 1247 1156 1365 1495 1602 727 1239 601 1198 1319
- 1561 618 1090 854 1146 732 1131 720 1108 882 1162 1450 1450 743 1175 1002 1216
- 1013 1338 1111 1359 1177 1261 1062 1197 1435 1578 1329 1442 1021 1221 1178 1544
- 903 1226 1010 1493 1232 1436 1182 1314 1073 1424 1457 1601 1183 1633 1217 1249
- 771 1313 1168 1338 1433 1497 1538 1674 1488 1647 867 1109 1504 1788 1099 1327
- 770 1087 1546 1635 811 1178 866 1189 1138 1236 100 { m20} R 865 1127 1460 1747
- 817 1348 1232 1641 1376 1450 1260 1389 912 1265 720 1342 1469 1664 1200 1579
- 737 1301 1075 1317 1002 1312 626 1269 689 1068 1005 1174 1481 1490 949 1239 930
- 1419 692 1161 572 1332 596 1202 838 1086 1283 1338 1320 1450 902 1301 891 1170
- 1477 1781 1490 1771 1616 1654 645 1082 841 1102 1508 1577 1331 1716 760 1215
- 1036 1333 1046 1271 644 1106 867 1070 789 1063 1457 1477 1230 1731 860 1064 865
- 1084 1379 1655 1569 1551 1415 1660 687 1142 1509 1727 747 1101 1375 1763 785
- 1100 1613 1726 822 1079 1278 1348 1011 1333 1107 1240 1225 1431 1332 1383 829
- 1359 840 1086 682 1068 851 1456 869 1067 738 1034 1118 1419 570 1332 1520 1776
- 1202 1256 658 1061 1194 1412 924 1116 1137 1546 1482 1530 1645 1624 910 1146
- 1429 1451 1087 1563 1117 1223 786 1172 1507 1586 1248 1272 931 1091 1322 1432
- 1163 1229 1378 1664 929 1095 1548 1759 1305 1515 803 1151 1188 1392 1221 1376
- 1526 1545 1209 1256 929 1345 913 1267 1307 1399 616 1090 1096 1292 1576 1693
- 100 { m20} R 646 1077 687 1054 1395 1533 1121 1187 1293 1572 868 1263 928 1098
- 1386 1526 1535 1749 1623 1648 1081 1416 776 1233 1009 1245 710 1147 847 1191
- 1373 1795 1319 1460 673 1285 1171 1671 791 1500 1070 1361 858 1287 1540 1510
- 1209 1843 884 1214 1044 1177 1398 1521 830 1638 748 1138 1215 1325 1020 1232
- 863 1185 1587 1662 1223 1668 1316 1580 845 1146 1286 1477 1525 1704 925 1174
- 1589 1552 1281 1419 1617 1677 1523 1631 1240 1508 1021 1273 688 1103 664 1207
- 892 1135 783 1083 1371 1505 1402 1508 834 1186 1189 1224 1327 1379 1464 1767
- 790 1126 807 1122 1182 1388 866 1154 967 1190 1564 1549 1195 1444 1171 1317
- 1429 1741 1211 1509 1529 1625 1223 1293 884 1072 856 1124 781 1046 1303 1459
- 768 1502 1537 1524 1520 1648 947 1129 1565 1601 1388 1706 1344 1565 1376 1577
- 1251 1403 1044 1398 1287 1464 1126 1217 1125 1310 799 1262 990 1157 1360 1438
- 1521 1649 1054 1369 1202 1375 1178 1512 1336 1624 1343 1349 807 1192 658 1077
- 1485 1684 1097 1221 815 1211 1307 1473 938 1256 100 { m20} R 1323 1365 795 1081
- 974 1225 1164 1314 1476 1515 967 1215 1330 1670 985 1281 1151 1504 1404 1817
- 1361 1498 1288 1310 1300 1424 1001 1450 952 1106 896 1091 1414 1643 996 1257
- 879 1140 1348 1337 1434 1557 1368 1641 1448 1595 1460 1444 1168 1211 1303 1532
- 775 1056 793 1191 1351 1612 874 1537 671 1054 741 1062 1199 1924 1549 1612 1038
- 1305 1400 1493 792 1349 1475 1522 1155 1220 1457 1531 1470 1622 1466 1681 969
- 1107 1016 1418 845 1134 1013 1167 923 1087 934 1094 1436 1759 850 1268 991 1189
- 817 1392 1353 1691 599 1341 840 1227 1335 1446 862 1289 684 1212 920 1351 1006
- 1228 921 1086 792 1081 1404 1448 1381 1388 1194 1383 1103 1361 834 1366 652
- 1066 1293 1723 985 1175 1602 1638 709 1040 842 1217 734 1217 1252 1278 1151
- 1294 933 1200 1133 1426 1370 1697 652 1299 995 1145 961 1177 1128 1430 851 1085
- 804 1231 773 1042 794 1140 1379 1616 806 1117 1528 1749 1056 1347 1368 1357
- 1639 1661 1353 1437 1595 1700 682 1061 1281 1419 974 1143 1274 1526 637 1176
- 100 { m20} R 1451 1544 1034 1176 902 1191 1324 1464 1166 1350 1548 1514 1372
- 1396 798 1161 667 1268 1076 1453 1402 1814 1315 1512 1350 1345 652 1184 1299
- 1437 1416 1540 1537 1784 1570 1637 1401 1644 1125 1361 882 1154 1778 1754 1137
- 1396 862 1209 838 1058 1079 1323 1503 1539 1226 1318 769 1159 1058 1169 1203
- 1348 1031 1137 1037 1330 1202 1270 499 1296 1131 1577 726 1142 977 1382 1257
- 1530 1249 1383 781 1040 1006 1637 911 1107 784 1164 1517 1622 981 1248 1607
- 1695 1304 1336 1418 1537 605 1214 882 1173 1241 1464 1261 1364 1204 1294 1230
- 1277 1450 1700 957 1126 1034 1317 939 1167 1546 1697 1216 1365 758 1127 995
- 1133 1415 1517 1424 1580 1247 1702 773 1181 1441 1580 1398 1575 811 1084 908
- 1319 1466 1508 715 1040 766 1129 833 1333 1024 1354 1534 1662 1240 1386 766
- 1161 810 1166 774 1119 1141 1280 1313 1485 1385 1436 1440 1534 1192 1325 976
- 1274 1358 1451 679 1081 1112 1191 844 1190 1301 1639 1054 1213 1234 1749 1434
- 1434 1239 1282 1451 1603 1082 1404 1416 1682 1354 1350 100 { m20} R 1472 1483
- 1534 1665 1182 1316 609 1109 1498 1570 1128 1463 979 1149 1072 1223 730 1449
- 1265 1765 680 1295 620 1180 871 1309 1453 1618 753 1045 737 1123 1266 1699 975
- 1263 677 1053 1140 1243 869 1173 1244 1425 689 1088 1382 1708 1490 1676 702
- 1091 1073 1247 1231 1568 1379 1431 1680 1683 890 1090 1269 1479 1235 1350 1081
- 1243 745 1077 1363 1467 1544 1529 1402 1474 1005 1123 1279 1361 849 1087 906
- 1126 719 1298 1517 1570 843 1170 740 1044 1406 1398 1470 1728 1094 1342 835
- 1057 591 1125 1770 1744 1619 1704 939 1297 911 1154 936 1445 901 1090 1017 1347
- 1712 1715 1593 1648 1577 1639 950 1204 1109 1362 816 1072 1059 1266 1341 1422
- 988 1194 1094 1291 1548 1573 743 1063 823 1193 1376 1446 726 1115 1073 1270
- 1442 1791 1361 1377 1518 1778 1242 1544 815 1348 1016 1195 1250 1389 1172 1517
- 699 1069 1438 1593 1341 1574 772 1304 1433 1887 747 1062 957 1164 1396 1563 931
- 1162 1475 1702 1501 1634 1396 1431 1433 1559 578 1263 1067 1332 884 1243 785
- 1065 713 1102 100 { m20} R 889 1111 1453 1513 834 1161 1149 1205 912 1218 895
- 1091 544 1188 838 1056 1025 1184 1613 1573 1116 1432 1320 1582 1390 1659 1351
- 1494 1132 1302 776 1103 1176 1554 1276 1362 774 1232 969 1256 900 1204 1616
- 1647 1578 1611 1448 1487 960 1105 1124 1304 1086 1606 1210 1338 902 1199 958
- 1213 851 1074 655 1062 1377 1479 1238 1490 845 1071 1237 1463 1565 1618 963
- 1305 1075 1237 699 1086 691 1347 1254 1632 802 1045 1124 1441 1088 1273 1083
- 1163 913 1157 1378 1621 929 1114 987 1188 734 1086 1294 1318 1518 1794 1551
- 1689 1306 1435 1532 1755 913 1163 959 1283 925 1166 957 1138 1189 1347 1002
- 1144 1043 1166 749 1070 636 1106 1256 1336 1404 1850 1469 1883 1403 1447 1095
- 1192 1180 1358 1590 1603 1123 1240 1285 1599 1158 1207 1323 1317 1146 1231 930
- 1544 1477 1858 1100 1236 1128 1276 1455 1723 1519 1530 1351 1497 915 1181 1146
- 1332 737 1055 1332 1576 1299 1770 900 1078 768 1138 1512 1563 1312 1722 1339
- 1740 972 1244 783 1321 790 1091 1255 1510 879 1072 1287 1383 100 { m20} R 724
- 1312 1608 1635 1421 1673 1141 1329 830 1104 1321 1656 1326 1644 1692 1668 1342
- 1588 1651 1666 1033 1373 1264 1329 1587 1719 1075 1174 1387 1384 1454 1686 616
- 1423 1401 1647 941 1318 950 1398 1355 1567 1268 1565 1265 1386 1326 1385 1036
- 1304 1408 1569 1477 1529 1365 1744 618 1141 1304 1450 1555 1593 1430 1608 1296
- 1535 908 1559 967 1125 983 1149 827 1232 1076 1497 1543 1737 781 1273 904 1449
- 694 1071 1215 1500 1026 1238 1071 1377 799 1252 1078 1733 1428 1716 48 { m20} R
- 1103 1211 962 1442 879 1186 1353 1542 1263 1724 1219 1412 1109 1204 1520 1720
- 1191 1415 1207 1516 681 1048 1292 1415 1669 1659 1066 1226 1272 1724 870 1198
- 1609 1665 1319 1318 1248 1302 667 1070 869 1148 928 1268 1277 1398 1321 1408
- 980 1147 915 1179 1242 1264 734 1155 746 1172 1341 1438 945 1193 634 1093 1328
- 1447 1521 1598 1235 1464 1273 1348 1118 1181 1634 1699 1141 1215 981 1207 1215
- 1428 1032 1274 903 1120 1238 1341 1597 1732 1102 1425 955 1242 934 1101 1294
- 1472 636 1081 1162 1288 928 1240 1114 1305 1246 1421 1482 1840 559 1236 654
- 1164 875 1160 958 1346 1153 1260 1492 1671 919 1380 679 1102 1087 1273 910 1571
- 674 1173 700 1038 1276 1288 995 1274 687 1158 756 1143 1674 1643 859 1138 668
- 1148 1294 1473 816 1446 762 1057 1418 1705 1216 1738 901 1081 1594 1688 1190
- 1280 1581 1617 1280 1339 1362 1632 1572 1562 1569 1742 1187 1540 650 1187 934
- 1121 775 1086 738 1095 1121 1477 1160 1345 1045 1474 1252 1289 720 1036 1356
- 1622 1084 1166 1176 1256 100 { m20} R 1435 1572 829 1094 1160 1285 921 1185 637
- 1176 889 1214 1536 1582 1301 1309 1411 1762 1072 1199 1459 1449 1490 1594 913
- 1113 624 1105 737 1163 1463 1506 825 1314 1178 1378 570 1223 1252 1457 1335
- 1518 1033 1607 1248 1266 1428 1718 1184 1252 1645 1659 638 1097 1220 1517 904
- 1196 1245 1324 1544 1595 1565 1548 745 1084 1368 1428 660 1180 1441 1590 958
- 1388 1339 1596 1147 1226 1367 1430 832 1280 1637 1707 1160 1265 1142 1248 1533
- 1726 951 1219 721 1048 832 1108 1155 1242 783 1195 1453 1750 826 1053 1024 1136
- 1338 1524 1328 1376 1099 1446 655 1105 1445 1676 887 1151 875 1141 1016 1127
- 1196 1377 1427 1420 763 1046 1333 1443 1230 1563 709 1155 1113 1263 739 1037
- 1544 1626 1392 1562 1419 1586 1198 1391 817 1222 1337 1715 817 1250 1350 1358
- 1435 1477 1641 1701 1488 1670 1388 1798 1600 1571 1496 1538 1081 1195 1598 1695
- 1519 1750 820 1125 1314 1503 1124 1322 1045 1178 1319 1341 598 1172 1117 1270
- 1293 1336 1342 1383 1642 1666 1135 1192 910 1322 1210 1349 1138 1254 100 { m20
-} R 1330 1511 1526 1538 883 1117 1421 1818 927 1372 1072 1527 1133 1209 1202
- 1582 1207 1355 1481 1486 944 1189 1020 1209 540 1391 1192 1452 1502 1495 813
- 1144 1153 1584 1324 1466 921 1263 1082 1225 1236 1380 1512 1543 1360 1479 1287
- 1567 1402 1417 852 1153 1492 1457 1334 1448 1023 1240 940 1231 740 1226 986
- 1271 711 1084 778 1055 975 1117 726 1041 1123 1251 1165 1240 1435 1577 1372
- 1451 1193 1583 1378 1475 1331 1696 1155 1283 1287 1342 1165 1436 865 1105 1504
- 1718 1483 1564 1392 1505 1278 1459 806 1201 1654 1648 1187 1282 1104 1212 733
- 1075 1018 1365 1139 1337 968 1122 986 1120 724 1113 1247 1853 1182 1288 1248
- 1356 1502 1785 1320 1338 761 1079 738 1035 1394 1392 765 1083 877 1260 1056
- 1396 1389 1518 1427 1665 1135 1205 1324 1556 1404 1384 1071 1632 1470 1484 1498
- 1532 1409 1593 785 1061 885 1272 1263 1478 1236 1326 760 1189 1547 1588 1139
- 1387 1176 1352 596 1150 1736 1727 723 1089 939 1214 781 1065 1552 1628 1413
- 1818 1290 1301 758 1143 724 1244 953 1110 100 { m20} R 1268 1278 661 1443 648
- 1105 598 1126 1353 1418 1567 1697 1594 1667 865 1149 1673 1644 683 1045 1080
- 1358 1417 1872 1257 1529 719 1201 1579 1636 982 1277 1118 1368 946 1261 890
- 1448 1212 1268 1535 1599 1377 1479 813 1132 1340 1381 696 1056 1324 1560 1260
- 1338 592 1310 847 1260 854 1226 1094 1341 1438 1477 949 1274 635 1510 1452 1702
- 1174 1555 980 1267 1193 1240 975 1210 728 1350 1191 1885 721 1365 749 1095 1254
- 1306 874 1322 936 1239 1094 1539 809 1394 863 1157 814 1229 1041 1347 677 1431
- 1288 1587 661 1076 1088 1167 1458 1771 1596 1692 1212 1484 1182 1345 891 1123
- 745 1037 1109 1374 1016 1187 897 1341 1297 1316 1177 1232 960 1114 777 1075
- 1246 1290 1056 1241 1563 1534 902 1081 484 1291 1080 1220 1019 1202 1034 1307
- 652 1096 1202 1382 1234 1295 1447 1625 1307 1507 1418 1608 1506 1743 1236 1327
- 1718 1717 786 1101 829 1084 1291 1344 975 1377 1124 1185 1420 1425 1611 1710
- 964 1318 1048 1236 1416 1471 956 1187 1451 1665 1572 1604 1401 1407 1459 1642
- 100 { m20} R 731 1066 1307 1433 736 1068 1478 1452 736 1225 1199 1461 711 1264
- 1282 1305 961 1186 809 1111 1131 1253 794 1090 882 1134 1388 1763 519 1248 1426
- 1552 895 1076 1271 1484 1093 1278 1174 1266 851 1151 667 1109 1294 1341 1391
- 2043 775 1174 1034 1217 907 1208 1393 1421 716 1046 1537 1686 770 1137 895 1141
- 848 1335 1477 1702 879 1083 1145 1312 1086 1233 950 1108 1039 1206 1377 1422
- 1358 1357 1357 1404 1450 1591 1481 1692 852 1169 712 1085 841 1057 1222 1431
- 1184 1338 1569 1754 1539 1598 1274 1344 935 1184 1395 1537 1282 1428 1309 1648
- 640 1094 1240 1668 1482 1471 1339 1488 1248 1506 1171 1404 623 1110 1448 1912
- 1054 1147 1568 1723 1613 1716 705 1083 1107 1370 1501 1602 812 1093 1102 1248
- 739 1189 883 1211 687 1077 1630 1681 1616 1657 1393 1656 1168 1232 1390 1400
- 1378 1711 1387 1855 806 1149 1532 1555 683 1157 1133 1191 1633 1662 626 1139
- 1448 1736 1316 1337 1502 1573 1010 1541 966 1250 1343 1472 1015 1141 916 1116
- 728 1094 472 1428 1010 1208 1419 1643 100 { m20} R 711 1077 1307 1381 902 1341
- 902 1152 1061 1336 751 1118 641 1085 1498 1580 855 1235 1463 1485 758 1036 643
- 1104 1449 1711 709 1084 790 1463 875 1120 1091 1185 1159 1431 739 1199 829 1262
- 1062 1355 1088 1216 734 1114 1501 1613 1650 1613 1241 1817 1075 1397 895 1326
- 1432 1560 851 1074 642 1093 931 1140 1183 1229 1388 1743 1239 1344 1129 1397
- 1147 1439 1392 1496 826 1080 804 1198 960 1128 859 1230 1041 1423 1002 1237 862
- 1143 790 1135 1082 1365 1227 1636 1005 1521 1520 1613 1112 1451 1527 1794 1241
- 1361 662 1091 1118 1796 1025 1185 1051 1202 1310 1441 966 1158 1514 1659 1312
- 1452 970 1305 1538 1671 732 1343 874 1123 1452 1745 1281 1576 811 1355 1215
- 1430 719 1148 1190 1274 1279 1334 1565 1620 703 1036 598 1190 718 1160 1049
- 1175 1443 1652 1639 1693 1437 1619 1252 1694 1139 1313 1478 1755 710 1297 1495
- 1617 757 1131 990 1234 1218 1374 1224 1455 1511 1514 1284 1444 1217 1328 948
- 1145 1276 1586 1420 1430 1512 1580 1237 1435 1330 1650 1326 1358 1083 1169 100
- { m20} R 1437 1745 955 1165 1014 1170 1064 1403 1317 1312 1167 1394 708 1069
- 748 1032 1002 1227 1430 1734 1572 1716 1039 1533 1194 1303 1204 1256 939 1251
- 894 1214 1232 1567 774 1039 1007 1248 1552 1717 877 1298 966 1388 944 1333 725
- 1060 934 1099 881 1134 926 1185 1449 1569 718 1198 1324 1485 774 1091 962 1111
- 1471 1489 1433 1595 1420 1626 963 1387 1128 1367 664 1069 1179 1261 1328 1529
- 1594 1598 792 1428 1013 1295 1469 1766 1369 1514 924 1090 844 1163 1093 1343
- 718 1066 636 1089 1161 1367 760 1087 1062 1368 1248 1311 1319 1360 1044 1141
- 1554 1719 1443 1560 1288 1436 1327 1363 661 1198 1061 1357 703 1122 716 1045
- 1086 1366 1521 1763 1067 1161 1367 1405 1305 1516 1024 1324 1427 1404 902 1560
- 1317 1375 1114 1195 1521 1496 1076 1488 1235 1328 866 1072 713 1088 1129 1315
- 1113 1606 770 1070 1031 1190 784 1081 1144 1384 1111 1252 1277 1484 973 1126
- 758 1256 681 1066 1528 1682 1402 1456 1340 1527 1158 1889 778 1168 1044 1196
- 821 1052 878 1149 1234 1309 964 1127 100 { m20} R 1474 1697 1241 1281 577 1143
- 1197 1634 1266 1562 975 1428 1035 1196 658 1422 1320 1415 1106 1311 1147 1242
- 1485 1463 932 1095 768 1266 1595 1652 1192 1383 779 1086 691 1160 950 1181 984
- 1263 617 1143 1158 1571 1004 1149 1181 1257 838 1272 936 1162 761 1081 1334
- 1352 1041 1833 766 1110 929 1563 1286 1969 794 1055 849 1121 1346 1400 1033
- 1278 1416 1662 1241 1287 951 1164 986 1250 861 1104 1479 1494 1322 1612 1250
- 1689 1321 1633 1492 1664 995 1291 815 1169 1028 1134 979 1300 1077 1284 1004
- 1222 1415 1470 1372 1391 1261 1355 740 1031 1273 1283 1317 1587 1541 1609 864
- 1115 981 1221 728 1106 932 1217 1161 1712 634 1173 567 1278 703 1154 1320 1454
- 1341 1384 1378 1380 1299 1343 857 1319 741 1274 788 1267 931 1114 1317 1319
- 1127 1273 832 1246 769 1036 959 1103 1433 1660 1429 1874 1423 1602 1070 1451
- 1353 1611 734 1037 1305 1377 1292 1439 849 1232 665 1089 1247 1654 793 1059
- 1105 1300 1149 1372 1490 1466 827 1181 1169 1372 927 1151 917 1186 957 1102 100
- { m20} R 952 1104 721 1177 1679 1644 1544 1506 1496 1576 1116 1253 1010 1282
- 1157 1367 1278 2006 1125 1410 945 1265 1106 1187 1082 1230 1365 1669 651 1087
- 1623 1670 760 1097 1184 1431 1661 1679 1406 1792 1082 1209 1112 1420 1340 1591
- 1221 1286 1474 1669 851 1317 1150 1352 1600 1661 1344 1516 1415 1454 738 1053
- 958 1237 741 1098 1487 1479 953 1442 1456 1541 1405 1850 1260 1434 1152 1239
- 1317 1568 845 1061 943 1103 1574 1558 705 1116 1164 1333 1565 1602 686 1105
- 1264 1471 1106 1209 1081 1251 1286 1362 971 1114 971 1366 817 1573 966 1111
- 1413 1493 891 1195 1470 1735 1216 1362 831 1317 753 1091 874 1073 673 1058 1453
- 1468 1342 1389 952 1287 1462 1483 970 1289 795 1120 1274 1345 1044 1439 1294
- 1508 1132 1426 642 1119 1637 1633 1345 1405 684 1556 618 1094 1601 1685 715
- 1071 867 1108 1113 1269 888 1249 1306 1376 1517 1736 1230 1272 1331 1419 833
- 1085 866 1084 1113 1297 1692 1706 1010 1149 645 1090 816 1063 1294 1489 1174
- 1473 1263 1343 1614 1600 1030 1237 758 1086 100 { m20} R 712 1047 869 1118 1618
- 1594 1026 1160 966 1209 1044 1160 1047 1516 1544 1584 719 1167 1507 1644 1039
- 1277 1622 1720 1232 1382 577 1136 1106 1268 1487 1496 1100 1350 796 1536 1555
- 1638 784 1071 1633 1718 1000 1298 1187 1317 926 1160 1372 1355 756 1322 907
- 1136 1091 1682 1690 1699 980 1357 995 1198 1224 1310 739 1116 1170 1477 1017
- 1243 1297 1457 795 1202 1477 1656 1386 1573 1184 1570 1328 1423 1644 1691 1288
- 1370 1041 1143 1430 1794 1275 1473 1260 1545 1574 1615 936 1218 941 1094 1040
- 1386 1260 1358 1557 1761 1180 1477 1258 1566 1170 1291 673 1088 1017 1214 669
- 1095 839 1485 1165 1325 630 1162 1417 1722 1501 1645 942 1117 800 1208 1185
- 1504 1343 1559 754 1183 578 1136 996 1137 1007 1128 659 1143 1153 1295 862 1069
- 727 1073 1526 1744 685 1105 961 1270 1111 1347 1659 1661 611 1147 682 1098 1135
- 1327 1435 1944 1356 1407 1124 1508 679 1058 1109 1273 1136 1242 975 1158 901
- 1320 895 1314 1033 1397 1217 1540 797 1107 1459 1548 1348 1639 1149 1202 692
- 1075 100 { m20} R 601 1109 782 1439 828 1195 787 1205 1613 1713 716 1081 1498
- 1560 711 1116 693 1103 1359 1371 982 1128 676 1194 1092 1410 791 1100 1101 1233
- 837 1327 655 1111 952 1164 1062 1263 1593 1717 850 1153 1516 1612 1163 1273 763
- 1282 751 1329 1076 1216 1117 1342 1549 1567 1014 1126 1517 1690 1153 1238 1397
- 1724 1307 1789 1330 1539 916 1415 1457 1768 1106 1516 799 1195 973 1197 1025
- 1165 604 1350 1101 1374 1238 1259 892 1465 1144 1198 1203 1404 1028 1246 1256
- 1558 910 1084 1546 1713 826 1146 1254 1322 1131 1260 1164 1256 1082 1353 1064
- 1206 1078 1315 1619 1641 862 1169 1237 1533 935 1239 938 1260 1168 1235 960
- 1102 856 1184 878 1251 1229 1266 1043 1193 538 1209 1073 1219 1492 1617 993
- 1144 758 1085 1289 1727 1249 1372 1362 1394 1253 1377 965 1204 931 1227 1251
- 1833 1078 1200 1445 1532 1359 1564 1065 1171 1303 1314 1309 1489 1392 1709 1280
- 1410 956 1124 1080 1229 957 1251 1116 1186 527 1240 1128 1473 1082 1394 1113
- 1294 1406 1802 1325 1441 1062 1177 1273 1567 100 { m20} R 971 1442 959 1125
- 1493 1801 1274 1466 1218 1274 888 1089 1591 1652 1120 1428 1134 1339 1411 1467
- 982 1160 623 1118 1436 1646 1286 1311 789 1144 1510 1664 1040 1380 1375 1506
- 1277 1392 1307 1305 1085 1189 1361 1477 1380 1688 968 1145 1300 1699 1238 1573
- 620 1114 984 1310 716 1062 783 1155 1514 1584 1395 1551 1094 1179 1556 1559
- 1340 1430 1385 1664 1232 1301 1004 1264 1420 1636 1123 1248 583 1140 954 1152
- 1088 1167 1081 1219 1067 1224 1449 1590 674 1295 1044 1188 757 1217 1242 1501
- 859 1344 881 1270 1481 1567 1285 1308 1297 1340 1398 1447 1258 1474 796 1044
- 816 1176 1303 1402 987 1295 511 1326 1022 1631 763 1036 1394 1553 1336 1342
- 1146 1217 1124 1229 821 1067 800 1265 1150 1270 1486 1722 1036 1140 691 1049
- 1550 1617 697 1144 754 1054 1178 1263 800 1165 1524 1564 1633 1620 1140 1318
- 1178 1377 839 1123 1201 1323 857 1233 743 1038 1397 1475 1494 1541 914 1121 636
- 1083 806 1132 1600 1719 984 1131 1443 1487 806 1190 1580 1713 625 1149 998 1268
- 1400 1845 100 { m20} R 1193 1228 691 1054 1001 1492 1327 1469 984 1128 1195
- 1871 1248 1518 1468 1671 1502 1732 798 1220 1249 1447 1664 1677 946 1178 1082
- 1326 1327 1493 1289 1498 1396 1727 869 1075 1004 1234 1236 1260 1227 1262 963
- 1162 1169 1441 804 1048 808 1328 1446 1912 983 1114 921 1166 794 1265 866 1118
- 1265 1504 983 1324 1223 1414 1079 1301 649 1130 622 1118 1528 1603 1333 1432
- 1282 1409 1388 1897 1091 1220 857 1443 987 1178 955 1123 1420 1817 757 1056 704
- 1412 929 1314 962 1466 814 1165 1011 1167 955 1113 770 1055 1565 1642 831 1121
- 1184 1276 900 1236 1639 1673 789 1156 797 1153 1489 1589 1513 1594 760 1036 842
- 1109 1647 1677 1322 1438 1536 1600 672 1100 591 1183 1324 1887 701 1084 1296
- 1500 1280 1456 1542 1709 824 1243 1118 1399 695 1252 832 1111 621 1200 1586
- 1693 1537 1553 1594 1736 1671 1689 552 1221 621 1120 1299 1413 1126 1362 1175
- 1341 624 1409 1450 1658 1260 1446 816 1089 1179 1236 1277 1285 1425 1531 891
- 1596 1546 1561 701 1088 1341 1401 696 1136 100 { m20} R 1244 1397 1474 1569 671
- 1245 568 1172 1318 1502 1189 1538 1458 1588 1157 1277 1074 1330 882 1261 1242
- 1572 1068 1247 789 1173 1159 1517 807 1288 1348 1775 884 1087 1304 1354 1419
- 1447 1446 1607 965 1123 1452 1613 784 1300 677 1195 897 1087 666 1073 1096 1189
- 963 1117 1265 1380 900 1101 1303 1314 1206 1658 965 1105 1522 1740 1176 1557
- 719 1347 1462 1520 1190 1258 874 1269 1391 1413 1125 1302 1581 1542 963 1278
- 1550 1686 693 1128 1312 1415 856 1063 1069 1349 1388 1470 1563 1558 1319 1515
- 869 1093 883 1152 1280 1289 1125 1186 996 1259 1345 1369 712 1228 897 1167 658
- 1065 885 1121 873 1087 1351 1439 1052 1596 1175 1429 1138 1316 610 1109 1312
- 1443 711 1075 770 1036 874 1341 745 1273 708 1068 1368 1419 1303 1505 1125 1185
- 919 1178 1435 1412 979 1110 1448 1566 1369 1696 878 1193 579 1216 697 1085 1129
- 1349 915 1255 819 1250 1009 1589 1106 1240 1448 1626 996 1388 1204 1338 938
- 1216 947 1537 896 1165 811 1287 935 1214 660 1241 732 1156 864 1220 100 { m20
-} R 1534 1569 849 1303 909 1138 1263 1736 528 1463 997 1164 1411 1452 1150 1530
- 996 1358 776 1110 1060 1302 1567 1602 1223 1630 1176 1226 959 1161 765 1113
- 1008 1483 1378 1462 1343 1396 1096 1278 1244 1304 729 1079 685 1136 600 1133
- 1279 1520 1268 1286 861 1187 1431 1536 1454 1508 987 1197 1054 1147 688 1054
- 977 1115 1409 1716 727 1095 830 1146 1452 1666 642 1206 774 1256 746 1239 490
- 1395 1487 1847 1186 1352 1082 1339 1013 1159 1311 1323 1369 1644 1174 1386 859
- 1241 919 1106 1343 1417 1350 1452 899 1090 1299 1354 1380 1586 1065 1292 1382
- 1828 1086 1400 1575 1615 763 1261 995 1205 1501 1725 1020 1131 797 1045 1616
- 1643 1420 1459 1174 1287 912 1274 1311 1372 1427 1782 1065 1326 1458 1451 570
- 1196 756 1034 1630 1627 1070 1191 1342 1423 1231 1455 928 1277 862 1232 1099
- 1187 932 1209 903 1163 690 1069 1159 1477 1215 1345 1432 1486 908 1086 594 1122
- 897 1211 1457 1589 1358 1555 921 1226 824 1255 1256 1660 1088 1415 1256 1454
- 1212 1517 1198 1291 1103 1660 100 { m20} R 1183 1403 929 1129 994 1266 1651
- 1702 1469 1585 1544 1652 1126 1220 661 1073 1326 1689 1471 1478 1233 1253 683
- 1130 713 1100 1365 1485 1199 1501 920 1100 1131 1426 1296 1398 853 1158 1030
- 1164 1617 1616 941 1150 1442 1605 806 1159 1083 1428 948 1140 628 1368 640 1139
- 570 1180 1552 1639 1216 1917 778 1102 1465 1482 916 1213 1531 1597 1097 1227
- 830 1124 1279 1315 829 1141 1551 1733 865 1101 865 1277 653 1172 1367 1477 1313
- 1380 677 1151 1358 1487 1496 1657 958 1243 547 1213 1320 1443 865 1178 1316
- 1446 891 1198 931 1270 969 1618 747 1121 1184 1410 808 1047 1217 1422 981 1233
- 1230 1471 1002 1121 1202 1420 1364 1516 873 1188 1276 1576 1060 1274 1435 1737
- 1218 1324 696 1264 1553 1734 1168 1448 1368 1484 1060 1168 677 1133 902 1148
- 1299 1904 1188 1432 694 1117 1163 1467 882 1095 1505 1540 751 1322 1135 1244
- 1438 1726 1198 1299 850 1127 1407 1399 1024 1290 1284 1469 1120 1385 1300 1412
- 683 1239 1214 1379 1496 1591 1195 1258 924 1459 1375 1591 1137 1459 100 { m20
-} R 1517 1665 678 1161 1184 1364 897 1334 812 1094 481 1309 1414 1554 1296 1496
- 1492 1551 918 1126 734 1061 811 1173 836 1065 853 1520 1467 1465 1337 1679 718
- 1096 704 1387 891 1105 1066 1297 1080 1712 958 1163 769 1148 1439 1528 781 1134
- 1189 1320 1556 1617 1232 1540 1523 1684 1069 1271 1126 1365 988 1265 790 1101
- 877 1170 1118 1365 1200 1236 691 1054 1083 1228 830 1069 635 1110 1029 1430
- 1382 1460 738 1209 656 1248 780 1404 669 1132 843 1137 1290 1517 1255 1436 920
- 1378 707 1324 723 1235 1023 1244 1382 1379 625 1196 753 1050 1535 1599 1049
- 1263 1310 1434 565 1223 1270 1534 1036 1338 1577 1574 704 1149 947 1248 1062
- 1247 1083 1168 852 1061 1272 1386 1110 1411 1244 1289 1255 1513 728 1067 1533
- 1728 654 1075 1377 1498 1079 1289 969 1570 585 1365 816 1081 1465 1655 1156
- 1296 1381 1476 627 1096 683 1072 926 1515 921 1090 951 1511 874 1151 795 1056
- 1254 1641 621 1116 1413 1643 1026 1183 1070 1360 792 1108 953 1194 1137 1210
- 1442 1595 785 1165 100 { m20} R 1624 1584 872 1212 1023 1203 1048 1459 1171
- 1777 955 1154 1079 1160 1217 1262 775 1203 785 1040 1572 1677 1528 1500 1506
- 1740 844 1224 609 1159 1437 1541 720 1116 1204 1407 1319 1503 768 1102 934 1128
- 908 1152 951 1170 1418 1872 902 1085 1475 1710 1156 1412 1082 1213 1159 1384
- 1431 1501 1212 1530 1279 1503 1264 1837 1618 1582 1240 1338 1407 1576 738 1128
- 1031 1146 803 1050 1281 1472 1111 1224 701 1088 1127 1246 724 1355 1072 1284
- 618 1109 509 1293 1164 1409 999 1140 742 1196 1162 1252 1554 1680 1455 1755
- 1612 1716 830 1060 942 1370 1522 1720 811 1056 1345 1417 812 1216 1179 1380
- 1374 1592 1124 1274 859 1092 1473 1652 841 1183 815 1086 1499 1651 737 1123 884
- 1472 1120 1589 1604 1566 956 1117 1287 1868 1023 1175 763 1124 1463 1667 1178
- 1315 1069 1197 1210 1331 1126 1592 1080 1353 903 1622 1197 1276 925 1238 1225
- 1442 850 1220 751 1108 1010 1216 690 1203 603 1259 893 1360 1324 1375 1440 1571
- 1429 1661 1377 1496 990 1153 1232 1355 1252 1332 1090 1262 100 { m20} R 820
- 1070 835 1206 850 1291 1028 1242 1198 1872 907 1096 740 1238 1013 1397 855 1061
- 974 1120 1332 1350 1513 1521 1481 1828 984 1360 1114 1551 1135 1245 1316 1471
- 633 1335 769 1103 1448 1777 673 1061 1414 1673 1232 1437 862 1581 652 1088 899
- 1077 1289 1395 976 1130 810 1067 1439 1451 936 1375 1509 1545 922 1302 765 1075
- 1081 1166 1041 1237 1416 1438 968 1145 1069 1182 1497 1655 776 1121 650 1157
- 922 1307 586 1145 1250 1540 680 1101 1504 1641 1046 1237 1043 1166 877 1543
- 1176 1249 1256 1655 813 1082 1523 1683 1362 1498 1115 1248 1401 1798 746 1054
- 1187 1344 949 1149 981 1390 1292 1622 1156 1496 885 1078 1015 1182 754 1125
- 1296 1656 1256 1411 984 1214 955 1145 643 1328 796 1085 1082 1491 1292 1624
- 1511 1615 1485 1542 1620 1696 1259 1324 833 1417 1300 1644 1111 1262 629 1102
- 888 1080 1131 1280 927 1094 1467 1637 1360 1786 1516 1689 1209 1443 683 1050
- 1156 1203 1027 1143 1167 1211 750 1057 703 1055 1037 1327 1051 1260 1557 1579
- 1340 1461 1075 1577 100 { m20} R 1288 1358 1238 1362 1417 1734 914 1119 1235
- 1525 776 1042 1294 1464 1006 1178 851 1077 1599 1708 1461 1738 575 1251 1649
- 1669 1437 1601 1161 1357 1294 1540 627 1093 1305 1323 955 1204 1593 1678 1076
- 1543 838 1226 1002 1322 869 1070 973 1222 1560 1662 1502 1484 1360 1432 1084
- 1455 841 1108 680 1046 1419 1854 1344 1388 1402 1749 1051 1226 880 1134 757
- 1277 1604 1570 1145 1200 797 1058 1176 1301 1331 1361 1431 1549 1397 1648 731
- 1033 600 1754 1151 1281 1432 1608 1039 1152 864 1186 1266 1276 1444 1541 1153
- 1308 1081 1395 1247 1506 931 1104 794 1125 1615 1682 1306 1374 1392 1379 765
- 1267 1049 1664 1233 1374 1112 1315 768 1085 1634 1656 762 1272 918 1343 1021
- 1194 1275 1448 1221 1486 851 1130 1291 1409 1242 1392 1379 1561 1199 1299 1231
- 1302 928 1132 1470 1694 1234 1299 928 1121 1555 1658 853 1149 1297 1432 1034
- 1416 1044 1363 765 1061 969 1118 1167 1588 1580 1704 1138 1514 1317 1339 1025
- 1227 976 1272 1318 1381 994 1130 852 1109 576 1261 969 1235 1424 1636 100 { m20
-} R 1411 1583 764 1181 1189 1271 825 1147 1239 1347 846 1157 776 1067 1278 1417
- 1490 1538 1194 1668 1559 1630 1454 1580 1338 1627 1013 1327 742 1037 1408 1552
- 951 1136 1524 1698 810 1244 1215 1419 1592 1643 1312 1312 740 1128 939 1248
- 1369 1529 1275 1287 1250 1419 1461 1571 961 1200 1264 1331 1409 1467 722 1095
- 1115 1312 931 1258 965 1582 1177 1782 1467 1563 1370 1821 794 1100 1342 1705
- 1263 1288 759 1283 1387 1672 1325 1433 1490 1511 1485 1676 641 1071 1549 1514
- 48 { m20} R 939 1095 593 1126 828 1053 946 1215 1692 1698 762 1066 1136 1244
- 1293 1328 860 1066 1300 1416 1252 1546 1535 1582 1325 1547 1397 1461 698 1218
- 1142 1266 822 1051 981 1165 981 1401 777 1158 959 1262 1288 1322 1524 1719 1142
- 1332 740 1174 1150 1381 1109 1440 1426 1551 999 1566 1362 1510 1409 1478 840
- 1180 1268 1388 1507 1594 1536 1697 1168 1334 691 1261 661 1109 825 1074 1333
- 1336 1140 1269 1002 1127 1586 1690 1328 2039 1142 1248 1213 1387 1554 1670 1489
- 1760 677 1083 1397 1489 1610 1721 1645 1648 811 1209 824 1573 1115 1189 802
- 1197 1571 1750 1407 1702 672 1209 811 1298 1537 1503 859 1091 930 1100 1408
- 1528 720 1120 1346 1392 950 1218 1246 1525 741 1216 665 1052 811 1245 1096 1488
- 925 1222 811 1091 1308 1473 1200 1252 767 1225 1202 1343 822 1121 1119 1523 863
- 1065 1369 1544 957 1406 1507 1502 924 1088 1323 1550 1493 1616 1124 1330 894
- 1102 1265 1469 1341 1350 966 1188 1236 1469 779 1134 860 1070 927 1140 1165
- 1273 1352 1606 1659 1671 798 1470 100 { m20} R 950 1426 1390 1548 1427 1620 840
- 1195 1432 1492 1198 1330 639 1152 656 1104 1561 1699 1342 1496 1144 1481 896
- 1357 1270 1393 1100 1279 684 1114 576 1187 1573 1582 1310 1689 1157 1205 1366
- 1434 1163 1444 888 1266 1093 1432 1591 1567 1553 1583 587 1137 893 1395 665
- 1185 947 1181 1247 1272 1441 1715 887 1324 1038 1188 975 1338 766 1258 1482
- 1535 1176 1650 1409 1509 841 1118 1358 1407 973 1126 1524 1641 582 1175 1334
- 1528 1127 1315 1479 1607 743 1057 859 1235 1139 1195 853 1178 777 1424 797 1074
- 1252 1396 933 1320 905 1255 843 1074 1119 1195 923 1255 1652 1691 1042 1160 737
- 1032 1338 1547 1613 1720 676 1057 1538 1547 940 1097 874 1105 1040 1306 1387
- 1705 1406 1690 599 1107 1297 1520 806 1062 1165 1272 954 1303 1179 1275 950
- 1129 1306 1459 674 1209 1022 1382 1468 1663 1291 1324 921 1106 1645 1681 1418
- 1521 1199 1304 917 1091 1153 1204 917 1410 1268 1335 984 1343 925 1434 782 1126
- 1128 1336 1270 1325 1182 1220 1215 1577 1436 1522 1010 1424 822 1125 100 { m20
-} R 1592 1637 954 1133 1293 1300 1138 1374 1312 1441 554 1218 1087 1364 1222
- 1281 991 1166 1039 1317 1640 1689 1005 1170 1432 1663 1280 1430 957 1105 785
- 1119 1038 1258 793 1414 1329 1718 978 1219 993 1176 571 1252 1006 1154 1521
- 1653 1412 1899 940 1153 1249 1701 1260 1388 1069 1288 1448 1593 1522 1806 739
- 1049 1531 1634 962 1269 1396 1465 1549 1527 1411 1499 1042 1474 1042 1241 1278
- 1296 1414 1586 1029 1144 831 1093 1725 1703 1165 1327 1462 1507 1150 1364 967
- 1205 613 1158 841 1450 1482 1767 1389 1527 926 1200 831 1460 584 1193 1359 1502
- 1158 1205 1321 1684 991 1120 1259 1319 1484 1500 678 1332 560 1244 1370 1734
- 1098 1501 887 1076 1628 1706 1117 1465 1363 1530 1264 1374 763 1091 722 1093
- 1106 1185 768 1191 1546 1627 749 1132 1050 1513 1378 1727 1175 1276 726 1076
- 1411 1535 1244 1382 1445 1583 593 1119 887 1181 1178 1441 1178 1492 1054 1365
- 1210 1372 1157 1349 1351 1633 879 1081 1052 1296 1130 1530 1401 1393 860 1240
- 1040 1141 815 1168 1412 1666 788 1212 100 { m20} R 1189 1290 1064 1157 1033
- 1155 853 1207 1081 1162 623 1105 811 1510 1103 1492 1077 1159 952 1242 1372
- 1584 771 1186 1329 1363 1451 1616 684 1160 855 1287 938 1386 1259 1633 1026
- 1462 827 1413 1038 1187 1378 1652 1602 1580 816 1244 749 1059 1260 1317 1495
- 1639 877 1200 831 1144 1476 1631 1587 1616 1278 1709 1502 1607 1115 1490 1038
- 1288 1382 1576 1481 1785 1358 1633 1427 1493 1373 1874 807 1094 757 1186 1405
- 1489 1029 1140 1176 1305 827 1412 1267 1600 1211 1351 684 1144 1348 1545 1504
- 1527 1487 1489 830 1542 1609 1663 958 1223 878 1321 607 1174 1501 1805 1645
- 1681 1673 1692 705 1052 1541 1675 1122 1215 1041 1236 1353 1605 1547 1618 997
- 1411 1474 1611 1413 1457 755 1044 656 1059 1326 1346 1120 1190 1141 1201 1396
- 1602 1130 1226 1001 1386 1282 1592 1457 1887 1327 1321 837 1136 824 1056 1665
- 1643 788 1162 1459 1470 666 1072 1363 1510 974 1403 1242 1370 1009 1131 1153
- 1420 730 1109 1051 1151 793 1062 860 1280 797 1113 1024 1279 690 1058 832 1199
- 849 1110 100 { m20} R 1229 1530 1455 1668 833 1067 1210 1380 697 1356 1392 1782
- 1520 1498 1601 1650 1100 1265 843 1083 670 1073 991 1122 559 1178 1470 1449
- 1234 1328 781 1100 1010 1165 1256 1435 1266 1366 765 1051 1441 1756 1222 1286
- 731 1137 1017 1608 495 1450 929 1173 688 1119 1354 1548 1140 1335 785 1127 975
- 1481 1632 1653 667 1115 1404 1451 1075 1160 643 1161 1025 1178 1316 1823 1417
- 1609 940 1325 693 1508 1080 1164 1148 1246 738 1351 1247 1269 1448 1459 845
- 1097 1204 1277 762 1205 1170 1354 1463 1606 848 1148 667 1299 1276 1431 1461
- 1601 1464 1461 1614 1683 1419 1470 1014 1852 1005 1127 755 1041 1136 1194 1037
- 1227 1481 1822 1130 1441 1190 1388 1408 1519 1308 1407 1277 1334 858 1091 925
- 1347 1451 1502 870 1180 698 1255 1341 1487 1340 1330 633 1110 1079 1235 1074
- 1335 936 1292 749 1269 1227 1529 849 1398 1127 1687 1438 1707 1546 1643 779
- 1091 1474 1526 1482 1627 842 1100 1043 1485 977 1446 1293 1847 825 1057 1520
- 1603 1307 1564 1168 1283 1383 1387 1531 1786 1569 1692 100 { m20} R 853 1074
- 1200 1307 1002 1555 1565 1560 1543 1628 1018 1231 838 1057 881 1078 1076 1709
- 1191 1545 1380 1504 1227 1530 1064 1207 1125 1387 769 1076 1032 1136 942 1200
- 933 1099 1286 1315 1483 1698 1015 1366 1279 1404 1333 1630 1481 1714 1600 1601
- 777 1054 1026 1154 1214 1425 950 1374 1409 1808 1562 1603 1082 1207 1514 1559
- 1438 1662 819 1234 914 1474 899 1471 820 1205 1061 1258 1347 1351 1228 1504 765
- 1240 890 1079 1416 1431 1103 1291 620 1138 1287 1302 1576 1668 1339 1528 1611
- 1615 759 1334 850 1455 660 1087 1519 1545 813 1187 1016 1313 910 1105 1137 1228
- 586 1288 1601 1582 1419 1532 1365 1640 1339 1346 1062 1294 888 1091 669 1141
- 1088 1302 925 1224 746 1081 1154 1515 866 1322 1323 1525 1375 1772 661 1085
- 1245 1263 907 1228 1133 1219 940 1140 1351 1448 1256 1567 734 1081 1071 1387
- 1660 1649 1288 1318 812 1331 1254 1445 979 1274 739 1040 964 1415 781 1162 953
- 1606 1661 1671 954 1292 727 1066 1522 1725 934 1174 803 1092 717 1082 1316 1524
- 1433 1511 100 { m20} R 1341 1343 764 1374 942 1108 786 1282 662 1060 1186 1306
- 1078 1349 1509 1733 688 1049 704 1162 996 1216 1442 1558 998 1237 1421 1412 681
- 1055 1573 1737 1173 1588 1139 1214 689 1114 1280 1381 1199 1313 1407 1385 1308
- 1438 1290 1652 1015 1138 889 1147 1142 1265 1142 1347 1473 1600 1038 1326 1364
- 1439 1247 1593 875 1136 840 1081 1377 1497 870 1098 1359 1684 667 1134 1089
- 1192 1262 1299 887 1203 1430 1439 1621 1632 1017 1495 1158 1361 728 1046 1615
- 1640 1618 1674 1051 1149 906 1312 930 1166 845 1075 1086 1182 1180 1241 1297
- 1301 762 1034 1453 1661 1442 1906 1000 1203 1318 1488 952 1133 836 1413 792
- 1329 1397 1402 697 1045 1453 1849 763 1060 813 1099 1448 1440 767 1046 1295
- 1351 750 1034 887 1274 1058 1427 1311 1309 1372 1692 896 1080 1199 1272 709
- 1090 1195 1312 978 1445 1339 1381 1348 1604 1244 1333 1400 1863 1364 1548 1289
- 1961 762 1143 1033 1335 1201 1424 1249 1594 1255 1555 956 1115 1161 1601 1262
- 1410 837 1067 1150 1440 801 1128 1028 1401 1101 1205 100 { m20} R 1027 1319
- 1013 1279 902 1118 1186 1631 1310 1412 1138 1339 1262 1533 870 1682 774 1042
- 1074 1397 741 1053 706 1080 751 1153 1492 1605 976 1228 1144 1438 1113 1392
- 1170 1352 1517 1661 860 1167 1279 1477 1087 1217 710 1049 1459 1625 1607 1720
- 1354 1554 1393 1613 1419 1648 852 1281 1222 1493 984 1351 747 1043 1249 1585
- 1416 1767 1003 1450 974 1733 677 1124 1509 1722 1320 1325 1139 1420 1038 1438
- 1118 1301 1365 1402 1246 1633 1105 1477 1362 1647 782 1254 848 1079 882 1247
- 855 1126 718 1412 1450 1711 1362 1473 1019 1302 1200 1343 699 1199 1600 1627
- 1232 1322 993 1118 1411 1464 1303 1504 834 1165 1346 1492 1613 1682 456 1466
- 1070 1270 1544 1584 834 1092 642 1116 472 1339 758 1051 704 1047 831 1099 914
- 1125 796 1157 769 1199 777 1066 1587 1715 1064 1484 922 1192 1365 1410 1236
- 1303 1241 1528 552 1186 1108 1176 1597 1612 880 1272 1461 1691 1194 1370 1377
- 1570 1261 1410 1037 1141 1163 1339 1473 1455 846 1064 827 1090 1422 1647 934
- 1312 1031 1183 670 1359 100 { m20} R 1291 1343 1074 1166 1561 1643 903 1220
- 1503 1782 1174 1805 866 1112 1380 1545 710 1053 697 1095 1671 1708 1271 1291
- 1065 1329 1530 1657 1151 1544 1581 1605 1074 1165 742 1199 1364 1675 1424 1618
- 811 1319 703 1049 810 1318 1072 1257 715 1041 775 1488 755 1103 1230 1262 1057
- 1693 1406 1950 745 1184 933 1246 1540 1618 965 1278 716 1211 560 1261 1010 1380
- 1513 1772 1545 1591 1538 1664 1369 1621 1139 1258 768 1120 1416 1631 1351 1630
- 1303 1381 1555 1657 625 1214 1177 1310 762 1273 944 1171 1128 1212 1356 1409
- 1173 1375 919 1183 888 1087 1035 1334 977 1123 780 1245 1461 1830 1344 1581
- 1253 1334 1448 1740 1024 1180 1751 1727 1219 1243 1282 1334 545 1369 665 1121
- 1334 1441 1558 1653 1066 1176 778 1317 1339 1508 938 1234 1096 1472 988 1401
- 1263 1336 1039 1399 1304 1344 1132 1482 1541 1544 1498 1592 888 1395 1633 1700
- 916 1273 951 1099 836 1082 1404 1388 1237 1365 923 1378 1251 1285 1263 1366 746
- 1219 1671 1663 958 1109 1002 1219 981 1575 791 1168 603 1247 100 { m20} R 849
- 1096 1215 1433 1333 1455 551 1549 1401 1509 1483 1505 900 1101 1468 1772 1035
- 1143 969 1110 1201 1296 1398 1416 1073 1191 787 1052 735 1062 705 1100 886 1205
- 1062 1379 1474 1657 886 1312 1535 1782 652 1100 1291 1502 862 1074 1016 1134
- 1227 1337 1021 1142 666 1107 655 1129 1066 1174 1266 1312 1441 1801 1688 1656
- 1196 1458 861 1106 1438 1722 543 1263 889 1217 1094 1214 822 1252 1459 1872
- 1201 1411 1015 1139 916 1140 1092 1313 1255 1504 1060 1302 1236 1310 1148 1254
- 1490 1829 1382 1414 1392 1421 1290 1516 636 1087 1331 1323 1276 1366 1108 1334
- 1545 1571 1026 1145 1436 1487 1597 1718 1158 1570 831 1058 1223 1313 820 1052
- 1631 1639 700 1077 1242 1279 1276 1288 1456 1561 956 1441 657 1096 1530 1616
- 656 1120 1020 1293 1125 1493 703 1184 1500 1539 1214 1247 1225 1334 670 1226
- 638 1082 1267 1415 1271 1347 600 1109 826 1179 1269 1702 1297 1437 1369 1374
- 1256 1478 704 1471 1062 1358 596 1168 1205 1588 737 1376 1036 1228 1052 1325
- 1212 1431 1197 1420 791 1147 100 { m20} R 1009 1273 792 1094 1168 1320 1252
- 1270 1057 1152 1193 1286 752 1244 772 1042 865 1159 899 1321 891 1195 1083 1304
- 783 1089 937 1204 737 1123 1606 1703 1298 1435 1139 1217 1362 1490 1131 1598
- 911 1082 1211 1695 866 1097 1539 1625 1235 1516 954 1470 1385 1406 1120 1285
- 1364 1768 945 1155 1628 1687 608 1135 1027 1343 648 1175 949 1172 777 1196 865
- 1213 1447 1538 1637 1619 1153 1396 1569 1529 1369 1639 664 1143 1477 1520 749
- 1254 1190 1275 1206 1379 741 1144 1048 1179 853 1079 1384 1638 909 1599 1131
- 1285 753 1043 1193 1405 719 1101 485 1290 1406 1385 941 1144 728 1230 736 1122
- 1345 1340 1443 1496 1435 1740 861 1091 1507 1632 1457 1768 762 1059 1649 1698
- 1262 1312 795 1216 1341 1399 1191 1225 1558 1728 1053 1166 1283 2053 855 1236
- 1522 1666 1217 1601 689 1212 1459 1652 1539 1682 519 1420 841 1590 1474 1584
- 834 1308 800 1084 1037 1476 789 1216 926 1446 683 1137 964 1178 1289 1537 643
- 1310 1090 1257 1671 1649 1429 1643 1632 1694 635 1088 938 1216 100 { m20} R
- 1315 1342 1531 1534 629 1274 593 1118 980 1415 1255 1471 988 1168 830 1254 1165
- 1471 1400 1526 1101 1524 1592 1712 771 1166 1132 1334 1114 1287 1490 1787 1237
- 1496 1076 1188 885 1372 1176 1405 1552 1630 910 1236 1016 1216 988 1115 686
- 1067 1181 1347 1486 1736 1539 1618 825 1306 1536 1722 1168 1425 685 1077 1428
- 1480 1258 1369 1041 1140 882 1103 886 1073 1360 1488 1358 1630 1380 1556 1425
- 1532 1522 1619 866 1251 925 1124 1131 1385 979 1258 695 1125 978 1426 904 1200
- 1092 1515 965 1204 1546 1712 1319 1330 968 1325 932 1175 726 1044 1486 1622
- 1001 1228 1544 1550 1377 1615 1473 1799 1106 1293 1085 1163 1070 1326 992 1347
- 713 1057 714 1128 1212 1828 1148 1484 1508 1646 1683 1661 1271 1688 1071 1610
- 1117 1243 1346 1373 1254 1421 939 1210 861 1183 1626 1665 572 1259 1186 1294
- 848 1075 932 1092 1343 1442 1322 1605 1340 1502 1307 1580 1549 1599 1555 1708
- 1041 1245 1010 1133 903 1097 1552 1636 895 1076 993 1361 643 1320 1184 1253 962
- 1151 1321 1405 1608 1723 100 { m20} R 1054 1252 1377 1467 851 1093 708 1054
- 1153 1553 1254 1298 856 1072 799 1044 1411 1766 713 1185 1320 1615 660 1341 707
- 1136 957 1495 1725 1707 1028 1235 1300 1890 1061 1260 709 1085 1125 1295 1305
- 1498 537 1218 1159 1297 670 1217 1209 1249 631 1090 696 1246 1165 1352 1508
- 1764 998 1150 1223 1678 1180 1458 1418 1531 1445 1582 1259 1348 1027 1208 1482
- 1648 1337 1495 913 1186 769 1130 867 1117 813 1178 1273 1355 1023 1266 940 1147
- 1483 1463 1288 1522 1351 1408 732 1097 1333 1324 1249 1290 1038 1373 1425 1502
- 1103 1478 1342 1423 1397 1386 936 1149 1196 1453 1252 1569 1258 1438 800 1113
- 952 1157 1649 1695 764 1060 1049 1148 1388 1663 1015 1175 1113 1401 1479 1701
- 949 1164 801 1046 398 1588 1162 1306 825 1111 1354 1823 771 1061 846 1059 558
- 1345 1189 1445 1475 1687 927 1274 1491 1522 737 1039 681 1254 693 1094 737 1208
- 1510 1602 1391 1370 960 1146 1063 1243 1401 1484 966 1106 942 1178 1573 1570
- 724 1300 889 1168 691 1301 1399 1507 1557 1717 1042 1332 100 { m20} R 818 1152
- 1091 1395 1129 1296 749 1083 1419 1461 1156 1296 1518 1574 1311 1842 1548 1551
- 651 1280 1057 1378 1036 1194 1074 1235 831 1182 1162 1222 735 1038 1066 1169
- 860 1149 1060 1176 1234 1443 727 1154 1129 1195 1101 1618 814 1429 1536 1730
- 676 1115 1245 1945 1269 1380 1036 1167 860 1066 1033 1244 1205 1492 1535 1721
- 1409 1586 1451 1582 1373 1606 602 1132 989 1164 784 1269 964 1426 1150 1241
- 1093 1227 933 1113 1013 1318 1288 1485 1085 1230 588 1176 1470 1496 1214 1356
- 1119 1189 1170 1275 704 1348 1037 1247 1189 1278 1438 1537 1439 1524 915 1131
- 717 1076 1160 1262 882 1159 777 1162 922 1227 1353 1477 853 1333 650 1239 1360
- 1398 1161 1412 815 1146 1327 1440 1507 1596 775 1165 793 1090 1389 1487 1248
- 1478 1292 1452 1070 1225 1126 1232 1436 1451 1453 1596 643 1213 1210 1416 1154
- 1313 1294 1313 823 1101 996 1167 1015 1244 987 1141 1450 1462 1318 1313 1218
- 1453 836 1413 1381 1580 743 1178 866 1077 962 1217 1266 1280 1453 1580 1086
- 1300 1654 1659 1223 1476 100 { m20} R 1592 1609 1331 1725 1297 1309 897 1107
- 1331 1365 1101 1199 1501 1786 835 1143 1217 1363 1044 1172 1419 1585 1348 1411
- 1136 1579 1459 1655 1185 1418 1186 1238 646 1472 1117 1302 841 1057 835 1145
- 711 1147 1088 1217 911 1173 1361 1664 797 1236 768 1078 821 1090 1210 1633 810
- 1090 1138 1214 1123 1335 1532 1703 653 1287 940 1176 1137 1270 1323 1505 939
- 1352 640 1220 635 1145 1268 1568 647 1103 1503 1792 595 1265 925 1166 717 1108
- 970 1162 1039 1144 1638 1626 1182 1350 1208 1368 1427 1492 1399 1454 1055 1235
- 1477 1525 886 1351 1353 1491 1516 1579 1564 1738 620 1205 1574 1651 763 1051
- 1493 1683 757 1261 1069 1154 1479 1469 878 1150 976 1183 1590 1566 1523 1582
- 1494 1685 1242 1481 921 1141 1094 1288 1206 1418 1468 1632 620 1109 962 1121
- 1185 1300 1296 1588 1284 1288 1427 1552 1621 1677 766 1086 684 1098 1439 1850
- 1492 1503 657 1219 623 1294 717 1041 1241 1297 1282 1378 1411 1622 1616 1688
- 825 1305 1130 1202 1256 1311 889 1159 634 1105 1328 1452 1031 1148 100 { m20} R
- 1080 1332 1531 1585 1436 1574 957 1124 1248 1579 1372 1783 1333 1593 1226 1266
- 944 1206 1523 1563 1035 1254 1637 1656 1113 1455 1360 1455 1190 1450 957 1121
- 1490 1841 1153 1209 902 1331 1457 1590 1376 1454 703 1073 1388 1525 1115 1353
- 951 1364 714 1049 722 1256 1474 1699 1298 1330 783 1286 825 1077 1696 1662 1173
- 1240 1071 1220 939 1182 1020 1192 1281 1394 1151 1202 1222 1260 934 1361 875
- 1189 1145 1436 1389 1561 1467 1710 1557 1550 1317 1905 873 1297 1432 1556 1397
- 1837 1454 1758 1280 1423 1011 1370 1247 1472 805 1079 1352 1555 1156 1276 670
- 1175 681 1151 751 1267 955 1100 842 1297 1285 1375 1008 1809 1428 1798 1311
- 1547 1310 1547 1575 1615 1313 1754 1043 1226 1173 1446 1457 1476 1281 1715 1476
- 1690 585 1166 939 1175 1007 1231 1042 1209 1257 1384 1204 1249 944 1204 958
- 1247 627 1090 1021 1232 900 1312 892 1132 978 1339 1152 1253 1520 1686 851 1291
- 755 1052 993 1197 1250 1476 1140 1321 862 1110 597 1113 1124 1291 620 1208 1010
- 1294 1161 1781 853 1061 100 { m20} R 992 1508 739 1121 810 1126 1563 1568 604
- 1127 737 1082 767 1047 1183 1443 1031 1169 755 1101 1038 1139 1340 1922 1723
- 1696 884 1119 893 1351 912 1090 1183 1349 1192 1543 1084 1291 1093 1357 1142
- 1508 856 1075 1513 1631 903 1119 1572 1698 1039 1453 1544 1773 1495 1749 1548
- 1642 1340 1346 810 1137 1167 1397 809 1108 1428 1797 1581 1624 897 1367 1165
- 1339 1167 1366 1147 1412 1079 1226 1517 1610 1241 1570 1459 1617 1100 1189 1422
- 1460 1389 1508 934 1131 640 1227 991 1137 988 1260 1279 1660 1032 1184 571 1246
- 502 1362 1418 1607 728 1105 1266 1402 1084 1265 763 1176 721 1190 1027 1168
- 1372 1375 1428 1622 664 1218 837 1125 1112 1177 945 1169 1348 1571 1421 1788
- 793 1112 1495 1473 1330 1884 675 1083 1334 1629 770 1069 839 1073 1255 1354
- 1208 1407 963 1157 849 1419 596 1159 606 1237 996 1194 1016 1350 1005 1147 1251
- 1829 1193 1287 913 1166 1158 1860 1173 1368 1352 1557 1496 1576 1663 1671 1072
- 1249 949 1176 959 1115 1031 1470 1487 1795 1115 1314 1326 1561 100 { m20} R
- 1033 1280 1333 1518 844 1257 1025 1509 1269 1506 1393 1426 999 1489 1387 1425
- 1665 1645 1162 1386 721 1045 1265 1302 1420 1412 700 1188 509 1306 1149 1211
- 1279 1388 1161 1232 883 1266 1373 1878 932 1090 910 1263 890 1077 1422 1701
- 1368 1388 1574 1743 1393 1505 1474 1774 1021 1130 799 1271 1564 1637 1316 1325
- 1258 1363 1470 1583 1400 1491 1591 1564 1249 1601 1127 1223 929 1273 810 1175
- 929 1249 671 1050 876 1118 807 1131 893 1742 764 1092 1211 1250 1164 1299 1536
- 1551 1031 1254 1401 1645 1539 1547 1609 1646 539 1228 1507 1609 1098 1356 1220
- 1280 1306 1509 1028 1471 1553 1643 1417 1730 805 1104 1334 1409 856 1346 1326
- 1853 697 1215 782 1087 676 1153 935 1153 1126 1401 1349 1365 771 1309 649 1138
- 1090 1192 1424 1484 774 1072 1565 1607 1409 1539 1099 1301 816 1112 1144 1608
- 608 1233 748 1093 935 1122 1360 1536 840 1059 1065 1361 1261 1310 1034 1203 833
- 1073 1207 1236 1130 1525 1374 1503 905 1094 1401 1787 1142 1385 558 1325 778
- 1062 1115 1363 1461 1771 100 { m20} R 684 1110 1407 1564 797 1072 1517 1538
- 1601 1576 1216 1325 1709 1693 755 1132 1564 1746 1104 1512 793 1278 1344 1426
- 1309 1306 637 1129 788 1064 1233 1358 1007 1187 1099 1638 1509 1581 1313 1411
- 1405 1413 1629 1719 1585 1616 767 1124 702 1221 1111 1206 839 1082 733 1079 843
- 1156 1404 1501 743 1046 1486 1814 890 1077 1400 1538 1222 1370 1400 1403 1230
- 1703 1415 1611 1083 1354 1199 1361 556 1179 1419 1471 736 1040 1132 1214 1184
- 1293 793 1202 1257 1283 1177 1698 1023 1206 884 1086 611 1207 949 1371 720 1064
- 663 1201 925 1214 1358 1818 1363 1398 711 1094 1093 1174 721 1119 801 1217 1359
- 1590 980 1131 621 1141 1081 1201 1106 1291 560 1267 1353 1387 1367 1411 1314
- 1379 727 1072 1672 1635 1011 1357 1354 1645 1306 1415 937 1115 1370 1876 1645
- 1715 1515 1607 1441 1676 1451 1582 833 1201 674 1148 1215 1328 1515 1669 1175
- 1346 1456 1430 749 1032 1133 1521 1216 1388 852 1145 1064 1374 1530 1604 1094
- 1206 779 1068 1200 1573 1153 1355 1482 1619 1385 1728 1084 1429 100 { m20} R
- 875 1287 921 1097 1050 1347 737 1125 1624 1676 848 1060 1311 1651 906 1181 1392
- 1576 676 1086 1240 1348 920 1149 1382 1717 1462 1533 1497 1752 702 1036 641
- 1186 928 1229 1421 1397 1132 1380 799 1277 994 1228 704 1126 1097 1279 1231
- 1431 1071 1355 921 1293 1046 1188 708 1081 870 1270 840 1099 1522 1541 787 1259
- 1226 1477 1108 1440 1709 1693 1516 1711 863 1070 1325 1368 824 1310 754 1096
- 993 1121 1327 1332 1002 1190 1179 1645 941 1112 777 1043 1541 1756 989 1134
- 1219 1498 638 1081 1264 1373 770 1324 915 1181 614 1180 668 1061 1330 1664 1046
- 1172 1191 1255 1293 1333 993 1156 732 1044 696 1197 1486 1736 909 1151 966 1250
- 1149 1410 728 1088 712 1083 999 1207 1095 1221 1633 1680 805 1048 897 1169 1435
- 1682 1304 1534 1085 1187 1329 1743 1441 1614 654 1196 1151 1368 1252 1512 916
- 1491 689 1084 1468 1882 1326 1395 1330 1446 1410 1649 1115 1369 1461 1738 713
- 1197 1569 1754 1420 1569 1014 1185 959 1352 1244 1288 1373 1726 1086 1220 819
- 1106 632 1324 100 { m20} R 1065 1311 1359 1599 1239 1585 1527 1641 1449 1542
- 797 1237 1440 1466 1274 1937 864 1639 1213 1322 1828 1836 1054 1210 1435 1680
- 1387 1506 1146 1929 1490 1795 688 1077 1169 1359 779 1097 885 1132 635 1212
- 1000 1293 1544 1600 1004 1196 1590 1552 814 1098 1122 1627 834 1089 567 1345
- 946 1294 734 1102 1184 1223 1383 1429 1265 1440 848 1103 1312 1690 1249 1397
- 712 1092 1195 1500 687 1184 1072 1473 1358 1427 930 1097 768 1279 1024 1183 817
- 1054 1058 1152 877 1227 48 { m20} R 1112 1344 931 1172 1048 1401 1433 1591 616
- 1170 616 1129 1556 1524 1056 1235 1088 1443 1428 1773 1383 1642 1442 1769 870
- 1217 1116 1341 1177 1256 1389 1440 1080 1390 740 1433 751 1091 709 1120 781
- 1069 1640 1633 1570 1649 1478 1540 1426 1632 1612 1673 1102 1306 1107 1260 1240
- 1495 723 1063 1524 1589 1370 1459 1346 1378 876 1356 1532 1758 1407 1695 1410
- 1506 1402 1496 663 1070 1408 1500 929 1305 888 1074 722 1038 1317 1518 1023
- 1240 1482 1713 1309 1452 771 1157 927 1253 1542 1554 1195 1432 1240 1452 1666
- 1680 975 1112 936 1114 1396 1477 916 1254 1179 1619 1042 1543 900 1082 1116
- 1229 1503 1751 1432 1940 1394 1590 800 1046 1181 1432 554 1218 865 1170 1363
- 1451 716 1232 1262 1278 1209 1248 958 1112 650 1087 1233 1623 939 1185 792 1231
- 995 1118 1426 1504 862 1107 1192 1413 1285 1294 1389 1400 978 1194 761 1078
- 1560 1722 1267 1386 1082 1244 803 1130 980 1126 776 1106 1331 1476 1135 1192
- 897 1204 1162 1308 1230 1334 1027 1240 1487 1577 858 1137 1326 1439 100 { m20
-} R 636 1180 1065 1290 1060 1281 1387 1467 1419 1746 817 1085 1510 1644 1439
- 1542 857 1062 854 1210 1236 1447 930 1172 1401 1476 672 1052 951 1318 996 1164
- 1555 1674 1226 1261 1106 1572 1470 1769 1415 1440 1380 1374 1047 1353 1225 1472
- 1030 1442 1050 1237 1209 1378 728 1087 1383 1579 1251 1305 1127 1312 871 1218
- 1047 1143 1193 1472 784 1040 944 1377 636 1159 1316 1821 917 1162 1117 1250 943
- 1326 835 1384 1349 1472 842 1120 835 1071 985 1189 1119 1389 902 1144 873 1073
- 999 1282 1257 1384 1285 1304 1287 1468 721 1180 977 1109 1074 1438 1161 1400
- 1491 1675 698 1045 1308 1390 1084 1234 898 1083 1334 1541 1236 1519 1334 1423
- 1597 1714 1317 1488 1111 1334 1252 1355 1328 1412 1070 1197 1158 1295 1579 1602
- 981 1213 942 1213 1269 1403 1070 1312 948 1163 856 1192 965 1323 1325 1368 886
- 1227 933 1512 1335 1607 1656 1690 1196 1305 956 1179 1336 1506 1529 1575 795
- 1308 1181 1965 745 1064 1488 1671 960 1339 1590 1620 1597 1604 1122 1303 1032
- 1159 852 1144 1080 1207 100 { m20} R 724 1047 1570 1543 923 1110 1025 1166 1212
- 1321 1055 1467 1219 1302 1244 1418 986 1391 1594 1717 1409 1441 1126 1283 773
- 1037 1022 1165 1275 1297 1085 1367 1134 1319 752 1038 1197 1421 1032 1182 1091
- 1311 909 1151 1171 1309 902 1164 650 1156 902 1211 1028 1165 1359 1372 1011
- 1337 1445 1604 1226 1381 726 1326 663 1207 864 1198 799 1171 1287 1751 821 1183
- 767 1207 1614 1602 925 1207 1306 1352 1599 1648 980 1252 1177 1227 891 1124
- 1307 1397 727 1112 766 1268 596 1133 1266 1566 1141 1267 1306 1841 905 1359
- 1341 1332 993 1311 689 1251 1140 1194 1428 1957 1483 1660 993 1201 1458 1471
- 1392 1397 888 1089 1606 1690 1379 1369 1025 1248 1531 1749 1522 1684 1557 1763
- 1453 1586 965 1195 659 1341 868 1460 1251 1316 1498 1762 1534 1708 1312 1323
- 1605 1618 666 1072 1082 1242 1226 1297 998 1121 1316 1466 668 1119 1103 1186
- 905 1096 1059 1247 1557 1607 1050 1557 1063 1223 846 1110 1179 1936 987 1114
- 1453 1486 1537 1498 1239 1372 1389 1638 1442 1540 1188 1247 1168 1347 100 { m20
-} R 867 1084 1087 1317 911 1152 753 1119 1391 1490 994 1327 1573 1677 596 1178
- 869 1093 868 1183 1429 1865 844 1380 604 1151 754 1118 1586 1707 1175 1381 752
- 1036 886 1083 739 1165 928 1111 1049 1199 1407 1630 1020 1158 847 1101 758 1214
- 1593 1644 897 1154 675 1087 1058 1193 1465 1495 1341 1696 1071 1288 707 1163
- 1116 1180 1237 1515 1307 1573 1304 1420 1423 1577 740 1045 848 1106 1128 1332
- 1253 1537 1371 1993 1111 1370 1235 1599 961 1162 875 1197 1373 1576 1370 1395
- 1556 1578 1120 1375 802 1532 763 1039 753 1145 757 1096 1463 1780 1558 1671
- 1741 1710 922 1218 494 1387 1102 1369 665 1121 1219 1341 1209 1471 1336 1451
- 1173 1252 1110 1228 1040 1288 785 1290 759 1147 1557 1643 1279 1325 1274 1463
- 1453 1754 920 1120 1582 1701 1020 1251 1324 1525 598 1109 1009 1184 970 1124
- 1328 1579 1282 1398 1436 1835 1550 1662 1551 1668 1224 1633 723 1232 1277 1444
- 1182 1424 1167 1472 701 1045 1536 1709 896 1133 1092 1444 1445 1444 1152 1240
- 689 1297 1006 1635 1318 1401 100 { m20} R 1454 1610 1287 1427 780 1089 756 1051
- 952 1532 944 1120 1157 1358 1698 1675 1322 1387 1599 1700 1597 1654 1449 1649
- 1027 1145 1396 1611 1663 1661 948 1328 1174 1245 976 1367 1196 1562 1106 1416
- 768 1093 1195 1306 879 1419 1342 1551 618 1247 1037 1165 1014 1156 1227 1500
- 868 1441 763 1063 1412 1634 889 1109 1254 1496 732 1041 702 1151 1437 1808 1055
- 1212 831 1233 1318 1491 1015 1335 1303 1776 1137 1368 1677 1698 1229 1368 825
- 1053 680 1194 1297 1757 975 1445 1217 1293 1132 1199 966 1215 1486 1635 1412
- 1437 845 1128 1611 1642 686 1177 1164 1668 773 1085 860 1064 1542 1504 1374
- 1442 1520 1631 973 1242 1254 1314 1073 1311 774 1056 1135 1279 1285 1497 921
- 1251 1404 1398 1047 1222 1064 1402 897 1137 1281 1567 1280 1539 1422 1915 1136
- 1378 1025 1149 1405 1488 890 1162 984 1268 1109 1219 1316 1565 1007 1186 1106
- 1180 1396 1633 1493 1785 1148 1224 1363 1411 1173 1286 928 1170 1287 1352 1670
- 1707 836 1207 754 1214 779 1187 1245 1374 1103 1459 1199 1259 1089 1462 100 {
- m20} R 864 1223 950 1629 685 1052 1337 1611 1391 1470 1085 1273 1295 1611 767
- 1114 1602 1669 1045 1152 1239 1268 744 1256 1010 1150 1273 1373 667 1163 811
- 1087 1390 1478 615 1279 922 1111 661 1153 1384 1638 1449 1648 1204 1395 1320
- 1446 893 1143 1430 1564 991 1139 746 1032 986 1211 820 1139 1105 1250 1432 1452
- 1314 1496 1517 1602 848 1068 843 1130 1356 1566 837 1194 1490 1714 1287 1336
- 1423 1901 1395 1470 884 1527 1453 1471 866 1410 1203 1397 693 1339 1456 1852
- 831 1271 651 1092 1343 1419 1494 1525 682 1078 801 1278 1119 1419 1461 1592
- 1224 1335 1282 1395 1041 1161 1267 1351 1093 1369 735 1319 1248 1584 1512 1496
- 1508 1622 1483 1532 1451 1501 1388 1798 1487 1603 1184 1499 851 1065 1335 1352
- 871 1188 1219 1362 1277 1339 1386 1849 1073 1160 1188 1479 670 1056 1552 1636
- 1098 1579 1539 1640 828 1127 1506 1812 777 1301 1217 1282 1442 1512 729 1053
- 1345 1405 1471 1591 1613 1623 1521 1804 922 1120 1442 1533 1012 1443 1058 1486
- 1469 1723 1454 1498 1001 1261 860 1233 100 { m20} R 897 1138 1081 1527 820 1098
- 1275 1726 735 1130 1585 1597 561 1344 1174 1259 647 1075 1146 1200 1602 1594
- 651 1118 1253 1456 1179 1494 1323 1371 1536 1538 639 1114 1028 1460 1227 1348
- 1253 1275 1381 1609 1139 1225 1286 1305 1452 1515 963 1118 1285 1599 681 1070
- 832 1281 1380 1470 1321 1332 1206 1298 738 1242 958 1111 820 1065 970 1163 1112
- 1271 1368 1714 953 1132 943 1201 846 1083 1474 1562 1359 1360 1530 1561 934
- 1604 1056 1182 1330 1639 1105 1450 995 1279 1352 1560 851 1067 1066 1178 1467
- 1661 1380 1652 1139 1265 752 1100 543 1200 1191 1442 1481 1670 1352 1580 635
- 1360 1557 1598 1557 1527 916 1134 996 1120 1331 1443 732 1082 1294 1420 822
- 1108 993 1391 1286 1432 785 1148 976 1145 838 1057 1274 1422 1435 1721 1007
- 1205 1432 1510 789 1203 1019 1250 1449 1513 1053 1463 824 1183 825 1278 1505
- 1607 1107 1328 1057 1299 647 1139 964 1218 1352 1534 729 1100 872 1076 754 1067
- 701 1065 1129 1609 1095 1205 975 1264 886 1111 1046 1225 772 1287 1484 1771 100
- { m20} R 1562 1622 1513 1552 1085 1177 1414 1434 1462 1471 1269 1529 1549 1765
- 1433 1599 640 1320 917 1225 1363 1812 1239 1776 1269 1346 1315 1449 1432 1567
- 1235 1559 1631 1639 666 1050 773 1077 542 1319 1637 1657 1065 1567 1564 1526
- 1732 1726 1208 1307 1409 1389 1046 1324 1332 1329 746 1235 739 1079 588 1156
- 1484 1739 1321 1395 1445 1553 1101 1233 1601 1691 1626 1614 1474 1639 746 1175
- 1075 1208 745 1051 650 1091 1035 1243 1681 1676 973 1508 896 1198 1037 1418 937
- 1162 1028 1156 1138 1460 1291 1430 970 1205 877 1158 1056 1152 1389 1429 1124
- 1187 1252 1344 1049 1241 1047 1154 1225 1356 1759 1736 1338 1535 1177 1371 1117
- 1261 1538 1749 1058 1399 1512 1681 1265 1394 1670 1709 715 1261 1044 1349 859
- 1070 1191 1380 977 1148 1015 1208 828 1062 1398 1967 973 1248 1222 1301 859
- 1087 1522 1567 660 1066 1370 1593 803 1138 1458 1554 1087 1180 719 1192 869
- 1075 932 1343 1019 1199 1152 1245 524 1359 1276 1483 717 1362 1473 1542 1117
- 1425 1010 1140 689 1186 639 1119 997 1130 100 { m20} R 914 1101 786 1158 598
- 1121 644 1110 1480 1611 882 1156 1235 1258 739 1220 759 1278 1549 1555 1211
- 1532 734 1051 1470 1585 1100 1197 1492 1553 1662 1635 1298 1520 1525 1602 1394
- 1553 1690 1674 551 1248 1286 1424 1042 1205 1264 1374 773 1096 885 1296 847
- 1107 760 1146 1057 1221 1542 1556 1112 1296 914 1107 695 1170 1278 1408 1336
- 1338 1368 1394 753 1267 743 1066 889 1074 1191 1481 952 1099 1244 1465 1595
- 1689 821 1244 1683 1707 866 1112 1046 1346 894 1106 1250 1735 1492 1548 711
- 1085 1242 1654 835 1301 1216 1460 818 1166 903 1100 1017 1225 1524 1564 1489
- 1641 1086 1183 1391 1625 1100 1191 631 1078 840 1064 1425 1606 1320 1722 1073
- 1158 1096 1427 1422 1594 909 1177 1249 1392 674 1094 557 1216 1428 1433 1294
- 1419 1436 1447 1540 1680 1533 1618 1410 1555 1608 1675 707 1055 907 1144 1263
- 1550 1378 1501 710 1344 1264 1491 1059 1406 1182 1333 1390 1377 1254 1672 1432
- 1647 1375 1462 1495 1624 1346 1379 1323 1610 946 1220 1436 1602 1370 1460 1367
- 1641 703 1066 100 { m20} R 917 1124 1742 1724 1251 1384 923 1161 1339 1494 851
- 1080 890 1083 1325 1656 850 1084 971 1155 1111 1352 1444 1574 671 1116 1412
- 1399 1047 1391 1330 1532 1136 1360 982 1157 1076 1412 1367 1698 709 1225 1033
- 1613 1096 1416 967 1450 1414 1766 935 1132 1470 1566 711 1064 670 1131 1656
- 1698 1004 1483 1422 1731 594 1156 988 1180 733 1298 846 1074 1458 1861 875 1078
- 1508 1728 1369 1487 666 1256 1458 1561 944 1095 929 1207 735 1063 1137 1325 773
- 1066 1183 1560 1410 1856 1323 1588 927 1254 1207 1317 1266 1344 1528 1737 1037
- 1198 1330 1332 904 1222 806 1217 843 1069 765 1142 1497 1535 1401 1572 1594
- 1649 993 1278 1125 1308 584 1245 940 1339 1349 1465 1323 1729 761 1277 1184
- 1431 609 1099 643 1122 938 1250 1268 1374 1226 1303 1331 1421 873 1092 635 1093
- 1345 1457 656 1321 810 1048 1261 1375 780 1284 1020 1274 977 1227 884 1132 621
- 1214 1345 1446 1244 1303 1163 1305 1575 1746 1427 1786 1073 1449 1158 1320 841
- 1074 1372 1383 911 1140 878 1101 1468 1832 100 { m20} R 600 1210 1387 1565 576
- 1162 666 1121 1046 1502 1604 1657 1209 1300 1412 1830 1117 1472 1082 1367 710
- 1100 1175 1309 1632 1603 596 1290 956 1163 1673 1660 1297 1300 790 1102 1124
- 1337 677 1106 1483 1587 1401 1572 1530 1606 1498 1576 1340 1393 925 1093 1536
- 1596 785 1137 1419 1598 765 1038 1551 1739 791 1246 848 1059 1065 1187 813 1217
- 919 1196 839 1093 886 1113 653 1160 907 1137 1537 1634 626 1273 1247 1338 750
- 1065 1146 1271 1153 1349 1286 1597 766 1111 637 1179 1101 1365 1049 1145 1498
- 1597 1150 1779 1420 1533 1198 1389 878 1114 1562 1669 935 1568 689 1101 844
- 1106 1573 1720 1149 1517 1305 1416 734 1038 1177 1237 1594 1723 725 1033 866
- 1133 1444 1571 1225 1377 1260 1301 1128 1227 985 1122 704 1045 537 1335 1167
- 1236 1149 1704 1664 1629 621 1123 950 1494 1533 1572 715 1166 1513 1485 847
- 1063 989 1199 926 1094 1083 1195 1331 1646 915 1162 1015 1148 1444 1545 1332
- 1593 1004 1327 982 1337 741 1052 1168 1254 1054 1171 1002 1183 1316 1375 1319
- 1408 100 { m20} R 1402 1837 921 1140 1026 1243 1372 1589 1235 1699 1619 1646
- 1406 1711 1217 1280 1719 1714 1426 1432 1076 1186 764 1226 1490 1508 807 1317
- 744 1113 1384 1469 1544 1510 701 1083 1289 1364 1033 1402 648 1092 687 1342
- 1401 1546 1420 1591 1038 1196 795 1133 1589 1554 803 1601 864 1074 709 1130
- 1410 1386 1232 1412 1101 1274 1185 1723 654 1166 1513 1672 1428 1429 1057 1148
- 961 1220 883 1427 1164 1603 1395 1580 718 1045 654 1079 1424 1542 1578 1655
- 1379 1480 709 1081 1406 1601 1324 1405 1459 1586 1453 1695 1054 1200 1056 1235
- 1207 1315 1384 1918 1350 1465 953 1111 1460 1810 1153 1489 882 1078 1495 1613
- 1326 1381 1360 1748 1002 1258 1198 1237 816 1175 1444 1543 1440 1861 941 1323
- 1173 1501 1195 1674 991 1142 575 1546 824 1212 1406 1676 1431 1422 833 1450
- 1209 1256 1433 1467 606 1263 1499 1765 1555 1541 1428 1453 1248 1450 899 1112
- 1232 1416 582 1137 1435 1471 850 1131 1319 1695 1386 1599 1307 1424 1180 1225
- 900 1166 820 1066 848 1341 1562 1595 1343 1486 696 1037 100 { m20} R 880 1114
- 1403 1536 1062 1150 1621 1681 647 1402 1327 1459 1222 1275 825 1167 1424 1708
- 1272 1280 1097 1286 1141 1868 1073 1253 851 1283 1296 1526 640 1287 1020 1175
- 1060 1181 992 1333 1447 1660 1016 1130 1028 1225 985 1257 1430 1496 1682 1666
- 1224 1291 838 1061 893 1085 859 1130 1198 1280 904 1191 1386 1436 1479 1799
- 1263 1277 921 1297 872 1160 1213 1305 786 1092 857 1062 615 1267 995 1256 1456
- 1744 735 1098 1021 1167 1590 1683 704 1078 555 1203 1053 1395 881 1317 791 1154
- 875 1084 831 1094 825 1117 1172 1434 1031 1164 1511 1697 940 1271 762 1059 1248
- 1264 1192 1363 995 1344 1137 1442 1225 1320 802 1046 925 1165 898 1288 1115
- 1278 984 1326 1485 1472 1065 1193 1170 1395 1238 1503 1227 1379 1350 1444 1049
- 1183 1389 1635 1048 1319 947 1146 905 1153 973 1411 779 1156 1221 1449 1057
- 1327 564 1179 691 1073 1611 1668 1031 1144 1185 1342 1558 1602 1363 1523 1409
- 1623 784 1174 714 1046 1036 1381 1585 1662 798 1215 1092 1182 1181 1364 871
- 1164 1233 1459 100 { m20} R 1408 1893 762 1417 769 1191 1296 1459 1032 1244
- 1204 1686 1205 1240 1408 1472 976 1155 1087 1166 1355 1535 903 1089 811 1179
- 765 1054 955 1288 864 1067 1357 1442 1531 1577 1515 1669 720 1094 1154 1287 665
- 1349 1086 1326 746 1203 516 1288 645 1148 635 1132 1389 1556 1300 1554 1006
- 1124 1126 1307 801 1053 871 1112 1294 1672 1189 1366 960 1131 609 1098 1479
- 1550 1371 1481 1098 1186 1256 1586 1246 1334 606 1537 1502 1667 1469 1634 1385
- 1536 1275 1493 1408 1515 572 1154 875 1086 770 1081 696 1077 1466 1561 927 1215
- 643 1129 737 1123 766 1153 1166 1235 1107 1541 584 1170 1214 1269 1363 1455 986
- 1202 662 1132 1231 1353 810 1263 1264 1332 1327 1420 672 1099 1288 1349 1479
- 1704 1391 1574 1371 1440 544 1249 1348 1663 623 1112 521 1232 1303 1313 1318
- 1562 699 1042 1122 1443 908 1342 1706 1705 936 1189 602 1118 1196 1260 979 1129
- 1119 1257 1398 1463 1626 1715 818 1329 636 1205 1508 1696 1247 1449 1232 1320
- 1224 1560 609 1311 1231 1282 1370 1433 1291 1331 100 { m20} R 1194 1295 1502
- 1636 1149 1465 1182 1483 911 1089 787 1042 1487 1706 1497 1695 1527 1754 1365
- 1691 1417 1514 1404 1569 1297 1573 624 1099 914 1087 1466 1550 1007 1369 1325
- 1670 1241 1487 484 1399 1145 1362 1022 1414 1306 1554 1365 1358 904 1230 1035
- 1233 817 1050 1326 1445 1200 1248 1475 1823 780 1146 692 1062 1311 1352 665
- 1079 653 1188 1514 1526 1172 1565 1383 1487 1317 1555 1375 1510 802 1159 1474
- 1546 841 1533 1171 1286 1177 1317 896 1076 1393 1471 1317 1363 689 1339 1565
- 1735 1139 1291 1708 1697 1072 1156 1374 1422 1208 1400 1590 1607 834 1095 1494
- 1552 1234 1368 1120 1283 1101 1360 1059 1162 1364 1942 1615 1652 950 1153 1149
- 1397 1037 1495 919 1149 1263 1430 928 1130 1474 1443 1600 1661 852 1222 959
- 1188 1471 1675 782 1252 1230 1358 1563 1595 1046 1299 1084 1255 1398 1540 1327
- 1347 1004 1166 1343 1348 1574 1563 776 1040 1471 1624 1099 1338 1047 1295 1014
- 1188 1337 1438 1560 1618 1472 1585 1184 1274 986 1131 1305 1319 631 1139 723
- 1111 1022 1182 1338 1546 100 { m20} R 668 1051 1354 1444 1560 1598 957 1161
- 1027 1361 1030 1282 1195 1372 871 1383 1133 1269 1104 1219 1343 1384 1075 1362
- 1696 1680 1584 1612 882 1077 1642 1655 750 1133 953 1597 781 1070 1332 1368
- 1196 1257 1343 1357 1221 1403 1413 1923 1378 1618 822 1071 999 1131 848 1221
- 876 1245 804 1187 1580 1661 1224 1269 766 1117 1141 1220 692 1260 1018 1133
- 1489 1831 737 1166 1533 1584 790 1410 1325 1511 1187 1369 1226 1269 685 1044
- 1578 1564 1509 1635 644 1372 1510 1708 1361 1652 776 1188 1633 1668 1185 1556
- 1469 1440 1264 1514 1291 1323 957 1134 1675 1643 741 1124 1101 1207 842 1156
- 1505 1644 1313 1494 1229 1559 1421 1608 1074 1482 1001 1158 1017 1299 1307 1353
- 991 1239 1072 1443 1166 1274 676 1162 1014 1166 696 1118 1497 1630 1171 1505
- 1598 1655 756 1033 1545 1731 969 1301 1291 1317 1022 1242 1237 1549 1194 1600
- 1302 1454 719 1032 837 1150 927 1353 1554 1741 545 1347 1109 1355 1278 1307
- 1025 1132 786 1081 1121 1249 1522 1580 1483 1704 1299 1481 892 1149 775 1144
- 100 { m20} R 1514 1731 732 1085 1093 1312 904 1235 1414 1623 1076 1354 1189
- 1399 647 1090 1239 1385 589 1284 869 1288 1350 1544 705 1148 1208 1597 614 1093
- 757 1122 783 1285 936 1354 650 1128 823 1056 656 1154 1349 1338 839 1260 1240
- 1264 1303 1418 678 1053 1449 1714 567 1324 1055 1154 1480 1813 1534 1751 612
- 1223 948 1108 1052 1210 880 1129 1779 1757 781 1126 1449 1443 826 1167 1562
- 1682 1066 1153 1551 1730 1143 1302 987 1277 1567 1723 1380 1546 1102 1289 807
- 1219 1156 1310 1140 1291 1071 1191 1011 1136 1526 1709 670 1124 811 1070 889
- 1295 929 1192 715 1099 1284 1586 1437 1747 931 1252 836 1228 631 1202 716 1272
- 810 1233 999 1121 818 1140 1181 1449 1376 1492 879 1073 698 1457 1252 1369 822
- 1318 912 1333 986 1144 1359 1665 1488 1852 1341 1591 1416 1758 1466 1676 827
- 1230 1414 1560 651 1086 548 1193 492 1334 1011 1281 659 1139 1463 1465 778 1295
- 1545 1629 1344 1526 1016 1197 973 1301 826 1102 607 1181 1453 1605 815 1236
- 1543 1677 1416 1955 1012 1171 100 { m20} R 1240 1316 1113 1180 653 1119 1371
- 1593 918 1278 918 1134 909 1112 1161 1300 1045 1188 1305 1535 1504 1805 712
- 1263 887 1079 626 1157 1176 1373 754 1151 1126 1200 969 1153 1377 1537 1174
- 1362 946 1159 848 1160 1056 1250 916 1347 1192 1338 977 1379 1005 1200 1239
- 1860 1463 1759 1435 1786 1451 1635 756 1075 1162 1260 1393 1435 1540 1577 1509
- 1554 1313 1460 1257 1413 1361 1546 1119 1321 1299 1384 1056 1258 1209 1393 766
- 1152 697 1432 1230 1376 1146 1410 1466 1873 745 1058 729 1349 1358 1751 776
- 1039 1353 1498 785 1172 1143 1702 1220 1348 1386 1492 1398 1452 807 1084 1378
- 1405 670 1219 1509 1589 1332 1374 1585 1686 1047 1154 773 1231 1427 1482 1284
- 1349 1462 1561 1548 1655 1476 1531 1266 1424 741 1205 1031 1154 704 1072 1156
- 1362 1486 1688 1558 1603 720 1063 1336 1403 1248 1368 918 1104 1008 1188 1157
- 1522 787 1053 732 1037 960 1114 1044 1356 1194 1491 892 1144 1342 1728 923 1173
- 772 1130 1493 1486 717 1060 1283 1402 965 1506 1045 1143 1174 1592 1142 1196
- 100 { m20} R 1603 1709 1196 1293 1175 1696 1314 1506 1219 1279 1332 1873 990
- 1205 1213 1480 1325 1664 1419 1820 1566 1748 921 1481 705 1224 928 1107 1228
- 1291 930 1230 1085 1263 1163 1385 1324 1406 728 1194 1351 1450 1133 1247 1361
- 1488 1520 1512 1171 1298 1295 1606 1080 1256 1535 1633 664 1367 1611 1634 959
- 1150 1101 1256 910 1097 663 1076 693 1041 776 1051 1007 1139 892 1084 1362 1513
- 641 1077 1198 1243 1488 1639 1023 1168 1473 1643 1286 1479 1244 1413 1615 1647
- 1353 1486 969 1106 1300 1301 1149 1345 1126 1282 1553 1743 1501 1697 912 1108
- 1305 1391 944 1260 1458 1748 938 1094 793 1214 724 1244 1612 1574 646 1082 983
- 1113 1158 1360 1276 1676 1153 1340 620 1280 1627 1715 1093 1266 1179 1220 992
- 1219 836 1134 1305 1603 1430 1518 1298 1499 1412 1408 1196 1472 1344 1358 1253
- 1330 584 1444 734 1203 866 1089 1226 1538 546 1274 1503 1596 1389 1835 905 1095
- 647 1215 1230 1343 612 1105 1060 1298 849 1075 1358 1446 1549 1621 798 1187
- 1240 1428 1553 1685 988 1156 1195 1343 100 { m20} R 994 1146 1222 1245 1293
- 1446 1115 1379 1019 1180 728 1072 857 1068 1218 1862 566 1223 805 1211 1171
- 1426 864 1434 1478 1524 721 1048 776 1061 1149 1397 1362 1515 545 1254 641 1077
- 937 1097 1506 1748 1364 1557 820 1392 1399 1509 1268 1387 1299 1554 1338 1370
- 733 1085 1000 1244 1511 1674 1104 1733 1051 1180 774 1338 1079 1220 1133 1580
- 952 1303 627 1258 1231 1356 801 1383 1288 1458 985 1305 1074 1229 1320 1425 689
- 1194 1408 1384 850 1066 1274 1338 1564 1710 892 1078 917 1175 1470 1564 555
- 1307 1157 1579 757 1461 1160 1336 1067 1196 1246 1384 666 1219 770 1492 1244
- 1586 859 1138 908 1137 908 1165 767 1149 504 1438 1478 1606 993 1181 1311 1408
- 1312 1463 981 1154 1124 1204 771 1217 1562 1644 814 1051 876 1201 955 1141 1167
- 1792 1298 1641 1431 1585 1541 1640 1550 1693 1023 1410 680 1043 1406 1975 686
- 1053 1266 1499 703 1063 1304 1478 1469 1445 1404 1396 1140 1346 1338 1405 998
- 1192 650 1084 1027 1205 1491 1658 1228 1338 863 1262 846 1091 790 1117 100 {
- m20} R 1428 1613 774 1252 935 1170 1303 1574 1525 1687 1388 1548 1342 1545 1360
- 1499 946 1219 1179 1290 1583 1577 615 1274 1189 1288 735 1151 1393 1461 1127
- 1436 1324 1332 1461 1767 1106 1211 813 1514 979 1142 1167 1857 736 1055 1080
- 1184 1149 1391 1074 1497 1479 1557 1440 1433 1098 1357 772 1207 1405 1747 937
- 1784 1441 1581 1065 1224 748 1126 1282 1402 1386 1369 1214 1344 1369 1617 866
- 1284 1618 1706 676 1123 802 1410 1534 1764 911 1183 738 1148 1277 1475 1324
- 1507 48 { m20} R 1046 1174 794 1078 926 1307 1131 1279 1439 1589 698 1441 1417
- 1595 812 1179 1654 1689 1432 1613 1166 1566 1369 1609 1119 1338 988 1353 776
- 1063 1363 1515 1237 1496 587 1163 1452 1564 722 1038 619 1280 1010 1295 928
- 1092 1438 1594 1193 1505 1316 1376 817 1150 729 1092 1000 1466 1265 1289 755
- 1087 1402 1552 995 1365 1324 1432 1417 1518 1367 1698 1421 1513 1220 1259 1484
- 1573 1332 1509 1638 1705 1408 1814 1654 1700 624 1091 1244 1398 1306 1563 843
- 1165 1305 1461 1398 1479 1000 1216 715 1134 1356 1652 868 1130 1359 1456 1054
- 1304 548 1178 811 1164 1141 1242 708 1055 817 1103 1237 1495 989 1151 778 1135
- 1362 1916 1650 1611 1605 1585 834 1500 1020 1369 1138 1245 1321 1318 1462 1816
- 1201 1235 1085 1211 798 1271 1174 1651 1490 1712 1421 1505 1235 1425 1107 1281
- 1347 1460 959 1367 727 1281 1253 1328 1293 1352 1578 1701 1224 1464 1112 1266
- 1429 1601 1364 1836 886 1200 892 1162 1145 1209 899 1122 692 1076 733 1058 1577
- 1648 772 1051 920 1413 1297 1480 1563 1649 100 { m20} R 1551 1697 1131 1516
- 1356 1415 1417 1454 1341 1543 623 1297 1219 1432 735 1042 1319 1509 961 1196
- 783 1049 1051 1554 960 1164 1386 1626 1085 1265 807 1059 1281 1434 988 1200
- 1028 1261 1436 1666 1292 1631 924 1345 666 1184 1270 1309 1414 1514 1536 1531
- 524 1240 946 1104 1465 1774 1331 1531 1204 1499 765 1057 1473 1534 1232 1265
- 856 1078 1248 1476 1113 1503 1135 1801 1006 1126 994 1125 1583 1733 654 1446
- 739 1136 1366 1584 1054 1169 1166 1342 973 1114 1044 1471 1204 1605 645 1099
- 1374 1462 1386 1871 1722 1712 1056 1322 1049 1287 565 1300 1443 1543 1384 1563
- 710 1056 1492 1493 1108 1299 990 1203 1018 1146 1116 1523 773 1120 1202 1512
- 1306 1505 1442 1455 648 1261 1082 1405 1441 1580 1065 1291 692 1107 915 1206
- 1140 1272 1273 1688 1216 1468 1461 1695 1017 1160 745 1326 1526 1647 1340 1815
- 1342 1546 1204 1264 1442 1582 1514 1776 1078 1172 675 1203 1428 1586 815 1126
- 1191 1661 1144 1371 1153 1305 1020 1259 797 1217 656 1116 1001 1332 862 1066
- 730 1077 962 1136 100 { m20} R 1453 1504 834 1231 1051 1279 1263 1348 1526 1634
- 754 1247 1233 1409 875 1142 909 1101 672 1525 1555 1539 1174 1244 733 1083 697
- 1084 788 1057 1537 1761 782 1069 979 1258 1226 1278 1565 1528 1554 1614 1530
- 1505 1326 1460 1041 1392 1129 1511 784 1040 1069 1157 994 1220 1448 1654 647
- 1172 1383 1404 850 1098 803 1210 658 1161 655 1202 1136 1275 1159 1314 663 1108
- 1249 1519 982 1145 679 1096 834 1092 782 1060 1302 1355 721 1067 869 1121 1261
- 1349 928 1267 1193 1591 1644 1707 1066 1234 1489 1691 1419 1488 1580 1717 729
- 1275 778 1044 1468 1584 910 1229 1279 1404 937 1104 968 1181 1164 1348 1442
- 1619 840 1091 805 1099 1186 1263 1437 1618 1273 1283 1381 1629 1467 1769 1364
- 1508 797 1058 1261 1464 804 1049 1046 1272 1506 1725 1518 1599 840 1249 1105
- 1209 1365 1461 1436 1556 1250 1272 1050 1208 1031 1207 947 1170 985 1201 881
- 1081 1191 1343 1331 1487 966 1340 1336 1352 1343 1587 1236 1591 971 1229 973
- 1223 777 1245 1367 1358 1008 1300 723 1120 1451 1489 100 { m20} R 1390 1443
- 1081 1322 1538 1717 1494 1727 1249 1652 1443 1603 1518 1581 1130 1190 1075 1422
- 1456 1562 973 1266 880 1224 1062 1329 907 1108 944 1162 1276 1639 1141 1345
- 1217 1343 1097 1381 632 1090 1519 1750 666 1305 1024 1259 746 1269 815 1501 989
- 1124 957 1118 1396 1524 1511 1506 720 1041 1418 1455 1070 1167 966 1125 1301
- 1482 680 1101 1491 1756 1548 1731 1273 1419 1232 1402 1509 1569 1530 1519 1089
- 1391 968 1351 863 1166 1035 1161 739 1042 855 1192 1157 1442 733 1041 598 1328
- 940 1114 1607 1691 1129 1261 1109 1462 1367 1440 1339 1363 955 1314 1066 1246
- 1022 1455 1414 1714 945 1217 1178 1288 1134 1385 1402 1489 918 1122 531 1300
- 1433 1535 995 1148 994 1187 1093 1352 1057 1203 1604 1731 1310 1332 1033 1142
- 1251 1378 527 1291 541 1272 1561 1703 1503 1750 556 1284 1362 1496 757 1070 581
- 1203 1469 1629 610 1438 922 1384 1117 1360 1359 1441 776 1218 1486 1639 602
- 1117 966 1112 1477 1793 559 1198 1192 1321 1431 1460 1474 1468 1405 1543 1425
- 1422 1523 1576 100 { m20} R 1171 1441 1008 1170 867 1119 589 1206 1344 1341 975
- 1412 1428 1707 1222 1375 1508 1649 1243 1330 1554 1640 554 1194 1094 1254 1541
- 1700 793 1335 1356 1435 750 1038 868 1074 1084 1271 808 1048 908 1088 695 1297
- 1393 1800 746 1189 1233 1505 825 1209 911 1335 768 1183 852 1103 1248 1475 1042
- 1539 1282 1386 707 1151 1279 1416 1588 1732 688 1323 1357 1727 1448 1499 1231
- 1539 1534 1791 749 1052 1547 1588 1116 1206 1422 1529 1135 1241 1090 1277 1249
- 1312 1186 1533 1386 1674 810 1080 1055 1258 1264 1473 803 1115 716 1060 1334
- 1436 1188 1343 1100 1288 783 1093 1304 1561 783 1266 798 1108 1297 1516 1095
- 1485 891 1464 1276 1394 1378 1609 1552 1567 978 1159 1453 1662 986 1163 676
- 1219 1256 1873 1328 1516 875 1069 1144 1196 989 1119 1495 1564 952 1187 511
- 1376 1129 1317 1048 1352 979 1185 1445 1539 1456 1835 1042 1313 1029 1190 1323
- 1358 1330 1361 950 1267 1155 1266 810 1051 1608 1577 1597 1685 1101 1175 756
- 1062 841 1215 1562 1616 1400 1550 1657 1657 1463 1626 100 { m20} R 1020 1262
- 830 1064 662 1130 1039 1185 1081 1264 1584 1707 1454 1560 595 1128 978 1140 602
- 1216 512 1284 1476 1544 1162 1332 583 1212 647 1118 816 1065 1101 1276 609 1313
- 1306 1325 1024 1463 1054 1292 1115 1319 1540 1532 969 1108 1446 1806 1472 1475
- 1484 1454 794 1242 1458 1718 1159 1266 654 1165 1136 1284 1360 1445 1427 1847
- 1368 1540 880 1075 1692 1671 1479 1827 1177 1367 798 1143 706 1067 1445 1560
- 1386 1602 1475 1563 1174 1454 761 1273 1162 1310 732 1095 1421 1461 1348 1352
- 1164 1479 646 1234 1097 1170 983 1160 1092 1183 1329 1348 894 1252 1224 1304
- 1204 1399 707 1040 790 1042 1373 1461 591 1131 1112 1269 1593 1604 1304 1604
- 1215 1331 1218 1243 619 1188 1516 1669 687 1125 876 1166 1433 1489 803 1194 758
- 1167 919 1244 884 1095 1731 1700 920 1094 1253 1596 1514 1577 1267 1347 1431
- 1532 992 1184 983 1117 852 1186 1054 1340 1298 1561 1523 1727 1199 1427 1386
- 1467 1194 1379 1321 1522 1282 1457 963 1239 663 1064 958 1252 847 1087 1379
- 1615 995 1126 100 { m20} R 1335 1499 1164 1355 1358 1440 902 1208 1165 1222 647
- 1119 1375 1668 876 1082 1348 1450 733 1174 739 1172 1264 1366 1302 1394 1468
- 1580 1262 1375 1355 1556 663 1122 1031 1298 632 1398 1213 1619 1360 1362 982
- 1122 782 1188 671 1102 1045 1307 684 1065 889 1151 1133 1287 1725 1699 971 1398
- 713 1170 699 1137 1082 1296 1299 1355 1020 1224 1036 1413 1687 1688 883 1136
- 1353 1407 638 1165 1258 1484 733 1058 814 1150 955 1191 825 1192 1082 1325 1372
- 1728 1504 1629 1065 1602 1531 1673 1036 1162 1338 1347 824 1156 1106 1381 1451
- 1667 860 1299 1250 1613 1132 1204 1225 1373 1118 1218 1688 1676 651 1252 1274
- 1819 732 1383 681 1185 1264 1592 1020 1165 1395 1976 764 1162 1142 1354 781
- 1040 1479 1641 1534 1503 1079 1183 927 1150 1311 1349 1018 1210 1477 1574 748
- 1084 986 1201 1363 1501 587 1205 1246 1459 1013 1139 954 1248 1537 1770 659
- 1085 1518 1712 1139 1279 1471 1517 777 1063 1046 1168 1468 1768 1319 1334 1317
- 1347 1407 1554 878 1110 1536 1700 895 1240 762 1268 100 { m20} R 852 1199 1239
- 1295 1182 1220 1087 1182 1355 1521 906 1088 1495 1492 1428 1672 1344 1438 782
- 1044 837 1355 744 1102 888 1174 1085 1334 1179 1266 951 1152 782 1092 1116 1241
- 627 1096 661 1065 1532 1707 859 1079 1404 1556 1142 1238 1199 1341 890 1198
- 1114 1290 1024 1244 1084 1293 1383 1841 686 1081 633 1080 1240 1451 882 1157
- 1400 1510 812 1288 1575 1640 773 1052 1631 1701 1099 1277 949 1128 728 1080
- 1169 1470 1317 1332 638 1199 1208 1447 1351 1466 769 1048 1518 1775 838 1157
- 894 1095 1625 1619 1034 1140 1397 1472 1204 1350 788 1420 1506 1640 937 1209
- 1573 1648 1107 1290 518 1354 1382 1666 1645 1703 1219 1498 1261 1276 780 1138
- 1533 1619 1528 1655 1626 1633 1069 1304 665 1211 1050 1183 1367 1632 1280 1484
- 1516 1480 1152 1342 1117 1301 1019 1225 1315 1533 784 1243 1472 1674 1102 1328
- 1448 1783 1020 1201 950 1098 647 1177 634 1078 612 1277 1551 1674 884 1209 901
- 1225 908 1377 1333 1443 689 1223 943 1221 788 1042 956 1139 1399 1860 944 1143
- 853 1125 100 { m20} R 828 1088 1247 1285 1086 1703 1150 1580 1389 1413 1423
- 1491 1133 1305 686 1130 1398 1404 950 1291 1047 1513 1057 1254 1424 1630 636
- 1071 1177 1553 857 1293 1580 1646 1031 1189 732 1040 1541 1769 1348 1388 1229
- 1438 1026 1356 1574 1658 1339 1619 1258 1356 1312 1309 1113 1313 986 1153 1007
- 1209 945 1134 1525 1542 1303 1632 1544 1707 894 1181 1073 1343 725 1133 800
- 1481 1373 1502 909 1236 884 1081 1403 1618 1404 1450 1460 1694 846 1135 1486
- 1571 688 1188 1553 1667 1275 1356 1033 1271 945 1361 805 1071 909 1083 842 1301
- 1354 1434 1356 1561 1112 1221 1200 1321 1297 1404 713 1170 910 1193 597 1301
- 1361 1557 1644 1691 687 1203 1248 1360 1473 1771 1283 1500 1002 1124 806 1382
- 1190 1285 1033 1136 1358 1380 1236 1290 1267 1380 1472 1493 1320 1376 1535 1509
- 1291 1327 1265 1323 1189 1593 1032 1362 1301 1470 1250 1465 1073 1169 1498 1511
- 1309 1499 951 1282 740 1068 1028 1209 1448 1472 1364 1359 1403 1416 1264 1375
- 636 1296 693 1038 1263 1449 1652 1712 1503 1502 1718 1687 100 { m20} R 1390
- 1538 1234 1681 1289 1696 774 1226 1472 1562 1166 1333 871 1732 669 1338 582
- 1198 1186 1343 1045 1283 1517 1724 1381 1446 697 1124 1394 1893 1262 1352 1532
- 1506 1145 1379 819 1139 1262 1446 1078 1388 554 1255 1308 1549 729 1056 717
- 1241 1648 1701 952 1308 1352 1436 1014 1391 982 1297 1674 1712 1086 1254 509
- 1353 1430 1540 778 1038 1169 1380 1135 1246 901 1087 1448 1492 1477 1666 1455
- 1465 1086 1553 1221 1400 714 1096 1111 1303 693 1078 637 1096 1026 1151 755
- 1040 1538 1651 896 1078 799 1331 1087 1239 732 1038 740 1352 819 1152 1446 1723
- 1400 1506 728 1035 1276 1433 1049 1168 713 1211 1036 1451 1255 1289 1408 1491
- 1050 1151 1058 1444 569 1236 906 1334 1240 1266 979 1140 1515 1808 1655 1637
- 1668 1686 923 1250 1074 1424 985 1156 1208 1293 1408 1517 710 1078 663 1264 691
- 1146 1589 1657 1222 1448 1486 1673 748 1172 815 1221 788 1057 1533 1773 1351
- 1791 1400 1728 763 1040 722 1168 745 1361 1558 1660 1146 1261 957 1244 1406
- 1719 846 1158 812 1085 100 { m20} R 1601 1703 798 1161 1155 1510 1392 1613 830
- 1088 1104 1233 1438 1524 1113 1339 1274 1374 901 1081 1387 1432 926 1450 1303
- 1458 1592 1688 833 1229 1046 1267 1499 1609 697 1107 1178 1222 736 1126 1065
- 1414 1210 1250 1326 1515 881 1328 776 1053 954 1176 1488 1558 903 1084 1481
- 1691 1423 1795 1479 1706 1009 1157 882 1734 669 1096 1007 1520 977 1111 822
- 1245 821 1054 982 1119 811 1074 1404 1734 1519 1709 983 1251 1089 1247 1517
- 1679 1543 1527 1188 1267 681 1051 1222 1282 1017 1157 1131 1276 1359 1466 758
- 1105 1408 1450 1665 1647 800 1051 681 1083 1531 1583 1158 1543 1575 1682 1304
- 1309 1587 1576 1506 1623 905 1230 1269 1702 1163 1339 951 1152 1508 1562 1029
- 1231 1381 1532 1223 1246 998 1337 1370 1488 781 1048 987 1423 1190 1355 1077
- 1235 1458 1561 887 1086 972 1110 974 1263 865 1080 656 1139 1013 1315 1386 1530
- 1485 1607 1041 1228 1541 1568 1593 1652 1550 1624 1420 1734 697 1149 1254 1325
- 1035 1196 1058 1201 706 1106 1429 1597 908 1265 840 1110 1424 1621 100 { m20} R
- 750 1101 832 1433 1378 1468 538 1282 978 1199 1234 1371 1179 1464 1268 1431
- 1505 1745 1208 1603 1498 1547 712 1194 1190 1422 749 1169 1167 1493 956 1251
- 936 1179 1553 1602 1155 1225 1072 1743 640 1146 1524 1540 1395 1518 1183 1291
- 841 1061 661 1064 798 1045 1425 1670 1378 1654 1224 1574 782 1100 1388 1476
- 1439 1797 1298 1325 1062 1185 731 1038 797 1090 879 1133 1330 1533 1269 1475
- 1495 1520 1367 1592 649 1087 837 1174 1632 1598 886 1372 567 1227 896 1230 836
- 1103 1138 1376 830 1196 1324 1403 1121 1199 1054 1543 1094 1173 1553 1693 856
- 1231 1253 1368 988 1134 546 1383 665 1143 1264 1961 763 1136 1125 1194 1453
- 1767 1427 1473 936 1161 1071 1409 1399 1423 1038 1474 1113 1188 890 1144 1073
- 1157 1021 1419 1078 1467 982 1161 907 1157 752 1393 643 1073 964 1104 1334 1567
- 712 1315 1115 1181 1443 1599 889 1082 1055 1147 1476 1678 1252 1358 701 1122
- 835 1131 1480 1742 818 1099 728 1255 998 1269 660 1149 1072 1182 1134 1486 871
- 1270 1146 1228 731 1060 100 { m20} R 711 1162 1259 1308 1482 1491 758 1062 1217
- 1463 815 1122 650 1083 802 1058 756 1270 807 1266 844 1179 735 1035 836 1288
- 1388 1456 830 1056 1004 1560 640 1130 1466 1823 838 1063 993 1117 1363 1543
- 1153 1471 1047 1490 789 1119 1033 1264 851 1394 852 1089 982 1341 1382 1736
- 1443 1679 1033 1333 1337 1715 878 1262 1124 1192 1267 1352 970 1114 1095 1236
- 979 1150 1082 1306 1078 1316 735 1145 802 1062 1179 1427 946 1251 1435 1510
- 1058 1173 956 1331 1114 1436 1496 1549 1274 1927 698 1158 1497 1583 1286 1594
- 1323 1472 1184 1711 1183 1377 787 1108 1205 1385 1514 1639 981 1198 978 1357
- 1161 1208 891 1131 975 1182 1574 1633 1357 1395 1454 1632 973 1195 1561 1662
- 739 1157 1063 1338 1066 1282 1478 1641 1398 1428 1335 1624 841 1265 1537 1766
- 1270 1394 1230 1345 873 1378 1190 1579 1420 1515 1223 1331 787 1362 936 1147
- 835 1244 1331 1501 1439 1498 915 1267 1313 1709 1474 1457 1178 1561 675 1202
- 1389 1369 1359 1513 1162 1534 851 1124 1202 1288 974 1272 893 1403 100 { m20} R
- 744 1115 1413 1409 920 1206 1252 1389 1148 1276 531 1322 746 1075 1359 1368 950
- 1171 947 1197 971 1375 1258 1452 1409 1510 1780 1756 1337 1409 1498 1703 1186
- 1222 1149 1200 1349 1421 1112 1269 1079 1415 1367 1479 1491 1722 770 1141 1209
- 1514 1459 1465 648 1089 722 1110 1022 1399 795 1064 809 1047 1373 1502 1493
- 1762 565 1168 970 1160 973 1344 766 1465 1100 1172 1258 1325 1582 1728 1205
- 1350 773 1342 1251 1307 1066 1160 1266 1389 883 1083 1483 1723 934 1215 1350
- 1921 1292 1364 755 1104 742 1058 1213 1259 1657 1710 1032 1324 1512 1720 1095
- 1395 1249 1416 714 1078 1243 1595 1334 1361 1143 1332 689 1089 1364 1379 1402
- 1710 1588 1734 1365 1438 703 1118 1141 1275 616 1136 1184 1525 1460 1659 1447
- 1865 866 1285 1340 1432 773 1069 1306 1658 747 1091 678 1162 1051 1265 1162
- 1265 1353 1606 924 1091 1626 1688 997 1229 926 1107 1560 1664 880 1378 728 1069
- 1348 1495 623 1124 1426 1683 1562 1602 1417 1543 1316 1507 1401 1556 1506 1523
- 1012 1449 1087 1295 760 1048 100 { m20} R 1601 1677 1597 1582 1549 1540 1405
- 1542 1293 1334 1070 1155 1104 1269 1342 1625 705 1390 729 1228 1432 1527 999
- 1121 1243 1376 1006 1169 840 1096 1131 1946 1597 1598 1284 1844 1170 1342 1349
- 1406 1244 1409 1389 1487 1127 1338 1598 1585 510 1281 1254 1599 649 1201 1310
- 1475 794 1288 1438 1553 1178 1311 961 1164 1240 1439 629 1090 1411 1387 773
- 1174 835 1418 1249 1652 1112 1371 1114 1183 721 1034 1266 1382 943 1199 963
- 1105 791 1046 790 1086 1228 1559 959 1219 1220 1376 760 1084 774 1273 768 1191
- 1089 1191 1091 1172 1468 1638 1086 1357 1354 1399 1508 1788 1532 1679 1582 1662
- 635 1156 1053 1477 838 1058 894 1076 895 1329 746 1370 864 1105 1081 1237 1141
- 1300 902 1092 615 1111 1537 1651 1294 1454 1574 1535 602 1235 656 1245 1531
- 1671 939 1290 969 1127 1455 1523 905 1433 1124 1400 1323 1339 1113 1334 1181
- 1558 1310 1737 1148 1687 580 1140 669 1062 824 1100 1436 1526 719 1074 715 1102
- 1381 1625 893 1313 1121 1886 1153 1609 1683 1700 1452 1500 1509 1682 100 { m20
-} R 975 1282 1221 1371 899 1331 833 1327 955 1100 1321 1555 809 1213 1346 1544
- 839 1274 1337 1427 1013 1132 1084 1331 1055 1158 802 1091 786 1157 763 1187 780
- 1251 829 1068 1099 1182 979 1302 1274 1439 425 1430 1112 1235 1224 1509 1292
- 1416 646 1133 1067 1187 1054 1174 1205 1408 1060 1252 1413 1740 1539 1592 1400
- 1768 1515 1493 1168 1382 1005 1271 958 1124 1304 1401 662 1139 1563 1608 1046
- 1244 744 1062 1256 1389 1356 1500 957 1625 1059 1387 1169 1364 741 1321 805
- 1061 1078 1296 1465 1560 1135 1597 1414 1677 1318 1344 948 1102 709 1100 658
- 1065 1410 1474 963 1104 797 1077 962 1335 821 1091 1014 1256 1032 1180 753 1127
- 1460 1687 1436 1496 833 1058 1120 1418 1183 1606 1036 1255 831 1065 1070 1324
- 859 1217 1524 1588 1210 1552 1178 1370 1535 1720 1263 1537 922 1259 899 1090
- 1218 1390 1062 1178 727 1137 1475 1827 1125 1770 969 1372 1326 1897 869 1112
- 741 1130 885 1079 1126 1361 1568 1654 1244 1466 940 1133 616 1145 1403 1501
- 1560 1535 598 1235 767 1288 100 { m20} R 1462 1471 1593 1598 1477 1622 786 1064
- 739 1093 795 1153 1127 1366 1402 1548 772 1147 1362 1432 738 1147 1483 1598 814
- 1111 1276 1482 958 1555 1430 1404 635 1182 858 1066 1601 1655 1204 1271 941
- 1241 1297 1425 1089 1423 1308 1597 715 1250 998 1148 797 1249 904 1118 1305
- 1413 1073 1660 1595 1697 864 1266 1267 1424 787 1066 775 1107 1303 1361 762
- 1066 1001 1185 1002 1258 1266 1320 628 1097 1150 1413 944 1237 1035 1183 906
- 1521 1054 1348 800 1070 880 1070 874 1077 1544 1756 938 1181 1034 1199 931 1133
- 1253 1267 1014 1276 946 1147 1313 1322 970 1107 1038 1153 1203 1284 738 1136
- 1644 1711 1431 1734 1336 1693 1299 1434 555 1654 1552 1759 702 1059 898 1096
- 1274 1293 1318 1553 1550 1584 1556 1716 1038 1177 770 1151 711 1127 1519 1633
- 1514 1766 977 1463 1387 1507 923 1087 1110 1349 943 1290 899 1078 724 1210 1181
- 1355 1271 1429 1004 1347 781 1226 1161 1303 1384 1781 1222 1771 1026 1233 1424
- 1452 1011 1272 1235 1336 992 1365 1478 1490 1055 1482 927 1335 100 { m20} R 869
- 1067 1160 1574 1192 1507 1097 1223 1163 1439 729 1172 918 1135 766 1070 1114
- 1584 601 1105 1267 1432 1400 1501 1454 1447 949 1307 1354 1374 1354 1343 911
- 1084 720 1051 861 1219 1184 1542 1700 1701 1502 1704 1428 1617 1448 1479 1372
- 1712 630 1203 988 1200 1092 1700 1052 1285 1449 1809 795 1103 840 1104 671 1253
- 1043 1570 960 1106 1561 1751 1453 1467 1248 1591 1010 1418 1614 1658 753 1261
- 1054 1242 1542 1531 909 1302 1510 1540 1297 1311 1167 1423 1248 1349 1284 1298
- 845 1059 875 1101 806 1135 970 1559 818 1058 1010 1233 1712 1709 1105 1272 1115
- 1213 1463 1503 959 1109 1603 1581 1243 1482 1071 1155 1223 1443 1363 1406 863
- 1097 1137 1733 1394 1394 1011 1170 1466 1592 1335 1413 941 1300 997 1151 898
- 1169 1289 1395 1313 1571 1525 1740 843 1301 1266 1370 1417 1475 1532 1606 1611
- 1612 695 1059 1032 1323 765 1162 1060 1462 1264 1344 951 1205 1399 1589 951
- 1289 626 1101 739 1126 799 1193 855 1133 1158 1261 1363 1444 1509 1598 990 1406
- 1599 1701 1512 1635 100 { m20} R 808 1167 802 1384 1398 1938 1165 1406 1127
- 1186 938 1264 590 1466 1051 1167 1095 1187 868 1257 1340 1401 1215 1872 787
- 1111 1272 1293 779 1050 1150 1254 1358 1575 1170 1499 688 1047 1521 1634 1245
- 1278 1378 1466 657 1200 809 1183 1025 1178 715 1069 712 1110 1184 1292 804 1093
- 667 1081 1170 1222 1071 1591 836 1347 928 1131 1185 1461 731 1098 1103 1529
- 1433 1913 797 1173 1102 1333 1384 1563 886 1072 1171 1275 820 1157 887 1198
- 1180 1237 1195 1327 943 1194 781 1621 1424 1481 1249 1468 1203 1282 703 1219
- 1134 1209 1287 1423 1337 1347 585 1162 798 1044 1738 1709 1214 1251 921 1143
- 760 1266 953 1385 1462 1887 1554 1547 795 1058 1363 1420 1225 1362 1101 1211
- 503 1320 997 1338 806 1046 797 1193 1357 1618 1300 1558 716 1197 680 1139 912
- 1120 850 1267 1330 1619 1311 1579 1158 1445 1055 1204 1108 1316 1261 1349 998
- 1254 821 1098 1094 1265 1464 1693 1377 1777 1564 1585 693 1074 1431 1702 1651
- 1682 939 1229 1279 1285 1262 1279 1240 1474 1449 1452 923 1211 100 { m20} R 995
- 1408 982 1114 885 1119 1525 1781 730 1115 1217 1619 1013 1352 1392 1634 1231
- 1256 1451 1526 582 1153 1155 1213 1609 1688 1489 1609 984 1177 983 1114 1425
- 1745 1415 1566 799 1341 1466 1610 1036 1161 775 1040 1275 1369 1656 1701 1479
- 1651 903 1105 1241 1701 885 1361 689 1253 779 1142 1040 1630 987 1122 1107 1330
- 1248 1309 1322 1396 735 1077 1326 1585 1199 1319 1130 1359 867 1160 1549 1665
- 1630 1687 1175 1252 919 1128 1344 1421 1394 1690 1388 1691 1195 1325 1064 1312
- 1399 1555 708 1228 790 1202 816 1156 1290 1432 1577 1681 1028 1179 1596 1678
- 1396 1763 1290 1448 1216 1421 1104 1191 671 1058 1057 1197 1528 1701 829 1072
- 1146 1213 1380 1603 1524 1491 754 1164 996 1216 1137 1553 1550 1762 1167 1328
- 1070 1204 1292 1370 858 1169 1117 1306 1225 1336 1479 1600 1505 1511 1550 1603
- 1263 1338 1122 1184 1200 1405 1528 1558 708 1450 749 1174 1466 1626 882 1071
- 1373 1621 1246 1387 921 1183 835 1138 1283 1453 824 1113 912 1120 1462 1441
- 1005 1138 611 1113 1081 1427 100 { m20} R 1339 1368 1496 1619 1646 1671 1356
- 1745 754 1050 1326 1696 713 1157 1097 1272 655 1186 1459 1430 686 1083 1578
- 1570 688 1050 1142 1201 1307 1462 1379 1654 1665 1702 957 1145 1111 1340 708
- 1325 1163 1288 1382 1488 1336 1502 888 1073 638 1302 1064 1701 875 1085 1232
- 1253 1521 1539 757 1149 926 1093 832 1235 953 1309 1042 1558 1163 1235 1143
- 1219 1260 1287 1477 1719 1494 1672 1272 1456 927 1116 1465 1862 1544 1612 1390
- 1649 1285 1521 1188 1260 899 1206 927 1266 48 { m20} R 1310 1314 877 1153 993
- 1210 1178 1258 948 1097 1002 1536 744 1051 1343 1522 630 1344 1525 1588 1098
- 1317 1025 1401 1089 1333 841 1108 864 1133 1054 1224 1457 1553 798 1058 711
- 1060 828 1091 716 1197 790 1165 825 1312 1391 1769 1338 1659 1566 1550 1195
- 1464 1322 1417 1402 1849 823 1095 1468 1607 1376 1535 1401 1512 829 1135 976
- 1310 1366 1486 1563 1545 1151 1347 975 1268 822 1398 1630 1688 1440 1445 1152
- 1264 1444 1474 1482 1854 1101 1173 780 1087 918 1364 954 1271 1127 1248 804
- 1086 1267 1549 1119 1353 1059 1436 1498 1837 790 1412 1175 1534 1432 1759 1416
- 1489 1019 1182 866 1158 1337 1456 1038 1311 1097 1332 627 1090 943 1170 1317
- 1598 1207 1614 1484 1570 800 1045 1366 1427 908 1371 982 1192 1093 1207 1073
- 1427 1083 1252 1114 1301 1211 1426 761 1167 601 1351 1039 1376 1348 1464 764
- 1160 1602 1695 695 1182 764 1038 1247 1373 733 1207 989 1140 648 1178 1054 1524
- 1190 1272 1419 1559 1058 1328 1305 1410 1223 1695 1483 1518 1502 1794 735 1093
- 963 1341 100 { m20} R 1079 1169 1392 1479 1487 1737 804 1152 1211 1457 1288
- 1370 1083 1328 1349 1655 1087 1194 971 1147 712 1056 915 1112 544 1263 754 1270
- 1165 1329 1403 1483 855 1157 695 1237 927 1141 812 1054 1213 1259 1121 1290 853
- 1257 1364 1442 627 1127 1324 1761 1330 2148 1386 1460 1463 1624 865 1074 1052
- 1164 758 1148 684 1207 1369 1402 755 1490 1288 1347 1113 1238 617 1133 1107
- 1658 849 1247 961 1150 1124 1232 1379 1481 1256 1393 1406 1455 818 1373 1110
- 1268 1164 1515 810 1057 1011 1239 955 1474 1498 1528 1723 1718 1270 1791 823
- 1282 1606 1671 873 1163 713 1320 1306 1494 844 1229 804 1106 1662 1660 1460
- 1633 866 1223 685 1126 1355 1725 886 1116 881 1110 1029 1193 1334 1422 923 1107
- 1485 1575 1364 1448 1375 1657 1223 1552 680 1078 812 1110 1538 1644 842 1201
- 1136 1310 1169 1288 703 1306 822 1254 1245 1481 1256 1536 1460 1595 1467 1448
- 1414 1580 998 1171 686 1107 743 1171 1202 1313 1289 1596 1296 1412 775 1114 911
- 1452 952 1109 992 1162 881 1369 1480 1742 100 { m20} R 1488 1726 1023 1256 996
- 1239 1420 1431 1276 1369 729 1070 1566 1660 956 1402 1460 1444 942 1110 1264
- 1281 1474 1602 1314 1432 988 1137 1053 1606 783 1198 879 1204 1697 1714 932
- 1268 534 1214 1062 1175 1523 1687 699 1223 895 1236 812 1146 675 1188 1162 1242
- 1039 1314 938 1127 807 1230 1483 1547 650 1172 1338 1607 761 1178 1575 1655 909
- 1101 1086 1200 1458 1436 901 1261 1304 1433 606 1351 1179 1235 1410 1553 827
- 1109 1075 1258 1096 1244 1441 1602 1072 1275 772 1049 953 1133 1537 1629 1034
- 1202 788 1052 1099 1336 1496 1823 828 1103 853 1174 689 1129 1382 1380 1595
- 1572 1356 1597 866 1075 674 1099 1181 1660 1261 1705 870 1172 1047 1272 1323
- 1560 1341 1657 826 1060 902 1085 868 1066 553 1214 1278 1538 778 1222 1393 1661
- 1440 1430 1190 1341 1533 1510 1316 1536 991 1269 953 1115 1036 1163 978 1376
- 1153 1263 1070 1454 1357 1509 1114 1180 1017 1132 1153 1225 1276 1396 1589 1594
- 617 1319 902 1140 1418 1578 1171 1252 956 1417 1194 1317 1421 1681 994 1258 100
- { m20} R 1188 1318 670 1103 1108 1294 760 1054 1415 1736 1427 1667 972 1165
- 1102 1181 1107 1243 922 1101 1035 1404 1516 1632 1128 1405 884 1363 1382 1616
- 984 1355 928 1135 613 1159 1532 1658 1295 1328 845 1082 887 1102 1690 1710 808
- 1187 1255 1288 1460 1796 1126 1217 1631 1625 988 1315 1267 1376 557 1212 834
- 1062 1127 1212 733 1052 1591 1646 1452 1504 900 1181 1280 1286 685 1104 1341
- 1629 1355 1623 1018 1168 1418 1713 1042 1162 1301 1480 987 1197 1366 1535 1120
- 1522 750 1227 733 1099 1041 1255 1175 1271 1149 1414 752 1266 852 1301 962 1146
- 979 1111 1179 1275 974 1359 1633 1696 960 1112 1606 1624 775 1079 893 1382 794
- 1458 1072 1271 866 1260 1428 1727 903 1128 1615 1595 728 1287 1262 1630 1314
- 1521 1432 1436 777 1042 1127 1538 1149 1366 1288 1627 926 1145 971 1188 1138
- 1374 657 1245 1664 1667 1587 1703 888 1074 1528 1760 1176 1470 803 1047 1317
- 1607 1274 1386 1660 1643 809 1282 1483 1727 1187 1397 1097 1170 1413 1821 770
- 1057 760 1431 1228 1413 1060 1156 100 { m20} R 555 1207 907 1089 1220 1265 1220
- 1331 1110 1769 1009 1236 915 1083 635 1078 842 1173 1458 1723 1248 1449 982
- 1158 1197 1249 1304 1598 1326 1611 785 1073 1139 1228 1415 1576 1420 1435 1181
- 1233 1036 1344 1091 1441 748 1224 996 1201 876 1175 1427 1473 1242 1398 835
- 1056 1148 1252 1563 1698 1439 1894 1504 1561 961 1103 1101 1346 908 1335 1600
- 1583 557 1228 1610 1571 1114 1223 791 1084 1450 1438 1356 1592 1384 1501 1294
- 1379 826 1084 706 1074 1516 1559 818 1167 1166 1227 1069 1228 939 1105 1325
- 1431 1289 1439 1425 1620 1582 1741 1308 1527 1150 1299 808 1059 987 1157 1050
- 1440 1336 1472 994 1277 1451 1427 717 1298 1356 1522 955 1154 1370 1368 1262
- 1304 895 1259 677 1098 1304 1317 1382 1844 1117 1211 914 1167 1615 1645 552
- 1192 942 1097 985 1147 945 1096 915 1259 1258 1333 1105 1582 1495 1665 1242
- 1486 926 1115 1244 1504 842 1160 721 1106 1447 1904 1595 1664 1364 1719 670
- 1138 1553 1757 983 1411 1114 1267 1286 1441 1296 1846 861 1292 1115 1198 624
- 1140 100 { m20} R 1027 1296 1361 1536 659 1058 1293 1606 1005 1397 1104 1406
- 1574 1572 1115 1524 1463 1481 1065 1163 1327 1524 1379 1577 778 1039 1182 1387
- 1160 1578 1080 1170 866 1257 586 1150 874 1068 697 1059 788 1151 1509 1752 1410
- 1443 912 1176 721 1044 1102 1397 1427 1640 819 1101 976 1315 989 1233 653 1298
- 1471 1701 1077 1394 845 1091 1359 1679 1315 1319 757 1124 1392 1379 1061 1158
- 992 1211 1348 1669 1035 1250 1293 1520 1065 1152 1705 1679 826 1195 1133 1369
- 1111 1414 1337 1533 492 1291 1461 1570 797 1079 1045 1349 1437 1799 768 1251
- 1223 1660 943 1150 1054 1196 1083 1374 1507 1651 1010 1199 1166 1233 863 1066
- 1424 1615 1232 1569 1258 1327 1348 1507 868 1138 1367 1478 816 1165 1139 1319
- 1179 1678 759 1134 982 1307 1552 1654 1459 1745 1228 1636 1592 1715 1219 1384
- 1201 1296 788 1226 1026 1402 1512 1555 1137 1321 1395 1435 1099 1197 1185 1221
- 921 1134 1711 1686 971 1144 1575 1628 1283 1433 1549 1569 928 1308 1100 1363
- 616 1097 1450 1536 898 1330 872 1155 696 1193 100 { m20} R 1602 1713 1206 1274
- 1063 1305 1472 1601 1090 1288 1343 1528 1573 1560 888 1084 1135 1259 1396 1760
- 1433 1628 1552 1656 1265 1330 1194 1759 1099 1176 1556 1538 804 1048 843 1251
- 628 1182 1182 1233 1033 1232 1020 1279 1375 1671 1179 1293 712 1066 969 1139
- 1150 1240 1235 1337 1185 1476 820 1161 622 1145 1535 1681 1261 1453 1182 1343
- 1410 1730 1096 1284 1177 1285 1246 1381 1339 1652 1520 1521 592 1117 730 1052
- 1585 1645 860 1557 1039 1139 666 1217 1167 1284 1100 1228 1435 1673 1063 1311
- 1327 1515 1178 1253 1488 1464 1143 1386 1000 1251 677 1046 1493 1511 991 1138
- 1053 1244 564 1152 1251 1270 1254 1452 1565 1621 1085 1163 1464 1476 991 1301
- 789 1264 1387 1605 612 1094 1468 1619 1436 1566 894 1357 1170 1229 893 1137
- 1525 1588 791 1079 1339 1581 778 1038 718 1162 860 1244 752 1042 888 1278 1330
- 1659 770 1064 1099 1464 1578 1557 1245 1399 570 1233 679 1059 690 1181 1060
- 1365 699 1089 1414 1469 930 1257 1088 1240 1595 1733 1604 1622 1416 1562 967
- 1111 1180 1304 100 { m20} R 1079 1345 893 1207 1005 1178 840 1280 1193 1248 731
- 1054 1392 1401 667 1292 907 1369 1345 1708 1444 1419 928 1091 1478 1619 712
- 1090 1171 1325 1249 1433 650 1116 1638 1700 1436 1516 791 1258 1541 1628 653
- 1058 1004 1220 1440 1630 1093 1674 886 1091 951 1257 644 1139 966 1138 1333
- 1554 795 1473 1089 1478 1032 1479 1019 1477 1533 1542 707 1342 1229 1662 923
- 1095 1642 1645 1061 1263 1229 1449 1066 1184 1501 1762 1448 1623 1613 1604 918
- 1125 1071 1181 1505 1550 644 1066 1298 1411 934 1127 1472 1525 1315 1733 890
- 1172 1284 1566 1274 1471 984 1121 906 1196 1502 1583 758 1161 1380 1824 1289
- 1364 824 1060 563 1191 925 1106 850 1226 1027 1234 1391 1473 1014 1127 822 1086
- 867 1093 1085 1230 820 1125 1431 1466 878 1097 1520 1517 596 1145 1548 1658
- 1451 1860 422 1440 944 1245 734 1316 1518 1583 1424 1629 832 1091 980 1465 1292
- 1541 1292 1303 1069 1241 876 1076 813 1310 582 1203 1059 1158 632 1126 910 1085
- 1466 1739 973 1119 836 1267 1392 2025 1475 1532 100 { m20} R 1260 1416 985 1113
- 1111 1220 1489 1773 1110 1396 788 1143 1085 1468 1491 1538 1052 1447 741 1195
- 1401 1452 902 1131 1481 1550 1024 1334 849 1170 1259 1277 1092 1404 920 1117
- 1425 1416 1209 1776 699 1332 619 1220 1503 1814 757 1309 1167 1492 947 1306
- 1467 1634 687 1154 1056 1507 1227 1318 1311 1480 736 1089 1515 1692 1211 1551
- 975 1255 988 1226 690 1156 837 1186 976 1225 999 1198 1393 1439 738 1040 1464
- 1609 932 1307 1323 1354 1575 1611 909 1140 812 1175 1169 1224 943 1102 1469
- 1595 829 1372 758 1068 889 1142 1174 1268 1530 1575 1346 2089 914 1093 1222
- 1377 1552 1602 773 1230 1063 1161 1465 1580 1607 1605 1415 1403 1405 1415 1441
- 1519 1028 1285 689 1081 1462 1491 1021 1368 978 1351 1619 1653 1496 1531 1622
- 1675 1210 1240 1182 1314 803 1066 1137 1347 1632 1661 1395 1669 837 1222 1221
- 1397 650 1126 684 1049 1617 1622 1480 1560 1260 1357 1118 1205 1326 1657 1159
- 1242 1408 1639 1503 1638 818 1235 1468 1566 819 1135 1142 1288 1512 1557 1332
- 1324 1159 1636 100 { m20} R 1028 1231 1207 1281 1075 1258 1139 1276 1308 1426
- 851 1097 899 1149 1421 1500 763 1168 1045 1284 958 1171 1053 1552 1172 1219
- 1297 1395 1287 1290 1299 1341 1185 1232 831 1064 1001 1120 1647 1609 641 1206
- 977 1194 673 1070 1315 1335 1203 1695 1046 1318 660 1093 671 1180 1291 1585
- 1362 1476 1398 1506 1129 1444 934 1157 831 1100 779 1049 907 1106 1378 1812 675
- 1166 879 1166 1064 1375 984 1254 1372 1875 1621 1697 846 1075 1503 1467 721
- 1149 1296 1464 1194 1263 674 1060 1352 1555 1290 1502 588 1163 842 1058 1297
- 1416 887 1096 987 1152 1465 1529 1437 1456 1125 1232 1008 1331 1461 1534 1061
- 1170 1427 1876 622 1096 565 1202 868 1255 983 1136 710 1166 937 1253 1438 1691
- 663 1237 1452 1602 1526 1620 1332 1356 891 1136 829 1220 1243 1477 990 1187
- 1063 1407 1218 1567 918 1087 657 1193 1052 1543 1626 1698 707 1121 1365 1422
- 761 1177 1001 1566 1244 1663 1092 1343 821 1102 1404 1556 1452 1469 735 1047
- 1498 1575 1089 1496 1282 1348 1490 1487 1385 1691 954 1260 100 { m20} R 807
- 1161 771 1135 1087 1209 1219 1575 849 1145 893 1075 1599 1673 1058 1395 1454
- 1569 821 1060 806 1224 1043 1203 1091 1373 933 1383 1035 1149 1323 1473 902
- 1266 1494 1597 846 1059 1363 1543 896 1158 786 1084 1491 1599 1355 1380 1458
- 1517 1206 1435 917 1167 1264 1274 1484 1730 1363 1565 949 1131 536 1237 1317
- 1372 1263 1282 1251 1266 1515 1640 1175 1443 835 1058 1060 1231 1637 1699 477
- 1372 1507 1603 1336 1712 628 1368 920 1134 900 1273 1037 1243 774 1054 1651
- 1679 1415 1425 1018 1250 829 1053 1203 1345 1372 1543 1490 1850 1704 1714 661
- 1068 766 1071 742 1073 1441 1489 1219 1247 1166 1417 589 1557 1133 1600 1335
- 1722 1177 1366 1108 1208 1657 1708 1103 1323 962 1183 985 1409 1229 1299 600
- 1157 858 1145 916 1162 1277 1320 1507 1790 926 1381 617 1180 1290 1498 1127
- 1355 1351 1497 916 1182 1020 1428 1468 1660 1667 1636 1436 1747 636 1152 1444
- 1451 730 1177 1321 1432 1131 1462 1253 1325 1489 1594 1267 1297 1224 1391 1452
- 1568 1186 1282 1110 1376 1523 1750 100 { m20} R 1332 1570 1574 1651 620 1108
- 1224 1367 755 1116 1104 1196 1216 1320 703 1096 1476 1647 1763 1741 952 1108
- 781 1225 1183 1293 909 1550 1377 1372 1639 1681 1490 1552 1625 1670 1597 1589
- 1034 1444 891 1306 1232 1481 1492 1806 1287 1428 1155 1242 1035 1492 1511 1661
- 832 1295 1231 1581 1382 1759 1008 1235 1218 1288 1194 1441 951 1539 905 1253
- 1137 1230 855 1066 1561 1570 989 1207 787 1066 1093 1171 1292 1357 1479 1559
- 940 1291 1118 1201 1198 1390 1447 1605 969 1316 1281 1427 1402 1762 1569 1596
- 1390 1488 1221 1741 1522 1677 1360 1369 1016 1388 1192 1427 1111 1440 1045 1346
- 814 1207 1532 1565 899 1079 1065 1177 921 1125 981 1173 1461 1650 1416 1594
- 1507 1813 1018 1228 678 1229 1123 1230 1383 1578 1142 1325 1226 1644 994 1346
- 1365 1356 1551 1701 1051 1256 1348 1439 1208 1337 1338 1519 888 1076 948 1274
- 1128 1506 1015 1127 1043 1450 1365 1720 885 1123 1446 1591 1656 1702 1215 1300
- 865 1201 1024 1212 770 1376 1279 1548 930 1102 934 1339 807 1053 1182 1442 877
- 1173 100 { m20} R 1156 1358 1107 1202 1347 1357 1303 1934 1391 1625 1447 1536
- 1443 1526 884 1146 905 1120 1156 1275 1235 1352 955 1118 1157 1584 1145 1315
- 1284 1836 955 1138 1385 1512 1120 1204 1154 1559 481 1425 1508 1810 1466 1571
- 967 1184 1023 1242 1380 1394 1009 1134 1160 1297 1325 1469 1564 1583 1175 1253
- 944 1389 888 1095 643 1117 1003 1277 1154 1370 1644 1660 966 1107 1335 1423
- 1592 1739 1412 1946 1227 1310 917 1170 1589 1736 1447 1643 1277 1316 1552 1695
- 780 1230 1265 1308 833 1084 949 1188 915 1192 680 1476 669 1089 1106 1564 1083
- 1409 1465 1526 887 1077 1389 1369 1110 1314 926 1269 1453 1588 858 1254 1033
- 1288 767 1121 843 1124 1044 1155 632 1194 1443 1816 1431 1680 1165 1421 1128
- 1343 684 1114 817 1350 1048 1148 1101 1183 1366 1707 795 1205 671 1132 968 1112
- 863 1448 869 1258 1213 1265 1135 1313 1240 1538 648 1172 1162 1222 620 1384
- 1279 1286 673 1063 1225 1277 892 1111 691 1129 883 1073 851 1341 1193 1234 1423
- 1568 928 1586 1271 1450 1063 1151 1074 1220 100 { m20} R 1542 1634 947 1130
- 1480 1797 1131 1694 1493 1481 664 1255 775 1193 706 1048 1020 1135 1231 1356
- 1107 1255 1131 1654 975 1191 1304 1661 1298 1756 931 1117 1048 1473 1138 1442
- 1536 1654 962 1104 1006 1258 1037 1475 738 1074 1426 1538 782 1290 1474 1595
- 1519 1596 1406 1683 802 1147 1032 1238 781 1180 1029 1444 933 1146 1268 1317
- 967 1331 737 1228 1175 1342 1563 1722 1107 1328 1379 1674 883 1128 1100 1337
- 1080 1401 942 1162 630 1083 1517 1708 1208 1326 1033 1136 1067 1155 871 1087
- 818 1068 1151 1526 1037 1180 1075 1450 1136 1257 1360 1760 1075 1386 1422 1812
- 860 1134 1356 1578 1459 1875 1656 1662 983 1197 1476 1751 1481 1552 1144 1327
- 1215 1545 965 1202 1046 1238 1501 1749 1152 1259 1395 2026 1182 1367 758 1123
- 1506 1567 1161 1372 1357 1413 1149 1206 579 1161 927 1165 818 1061 1335 1561
- 714 1060 1197 1379 866 1155 696 1279 678 1078 816 1082 1107 1233 1429 1498 870
- 1149 1267 1440 1111 1184 911 1210 1149 1587 1291 1509 1248 1337 1244 1500 991
- 1145 668 1082 100 { m20} R 1010 1214 747 1122 1258 1323 815 1469 1519 1489 1085
- 1192 1107 1258 1562 1572 759 1046 1476 1589 905 1274 1487 1658 1528 1513 938
- 1301 1367 1562 1459 1522 743 1067 1379 1524 1423 1456 1476 1573 648 1279 1292
- 1345 1104 1587 717 1183 971 1266 935 1381 1097 1217 1349 1497 1559 1765 1374
- 1531 1676 1703 1289 1760 888 1182 880 1104 1341 1538 1244 1348 814 1087 1472
- 1546 1129 1402 1224 1335 1482 1669 1073 1303 1226 1383 915 1317 614 1092 1084
- 1204 1385 1409 1311 1378 742 1247 1319 1421 1109 1178 862 1109 874 1196 937
- 1581 1036 1423 902 1107 929 1156 929 1149 975 1491 899 1267 1506 1705 1506 1759
- 894 1237 1735 1718 1487 1526 1324 1642 867 1190 790 1114 1523 1633 1566 1743
- 781 1102 977 1169 644 1082 1223 1325 1134 1273 1384 1499 1089 1241 1193 1529
- 586 1122 815 1165 1593 1634 860 1067 1268 1339 1215 1440 1340 1712 1455 1483
- 839 1185 862 1171 999 1211 1199 1231 1397 1408 1112 1221 1291 1581 936 1107
- 1404 1385 956 1136 1328 1603 1350 1488 970 1199 1234 1438 100 { m20} R 778 1038
- 1014 1209 822 1057 1192 1266 1474 1763 716 1106 758 1124 1544 1550 1373 1512
- 1548 1602 1025 1222 1307 1353 1010 1302 757 1381 1371 1463 1621 1606 1036 1369
- 922 1187 913 1083 1538 1629 1519 1505 737 1177 986 1152 1462 1570 1418 1631 992
- 1179 732 1108 1079 1207 1413 1932 1083 1408 1233 1445 1512 1742 1413 1697 1483
- 1524 1234 1463 608 1169 1405 1762 1262 1471 1344 1613 1000 1188 827 1067 1446
- 1543 1340 1365 1524 1711 1269 1603 747 1163 1518 1528 1281 1439 1320 1495 1084
- 1249 1209 1352 694 1341 1365 1439 1002 1215 1461 1532 833 1103 926 1312 612
- 1180 787 1156 784 1112 837 1068 783 1064 1223 1516 1128 1243 1063 1192 1336
- 1339 951 1240 1192 1360 1269 1457 911 1371 1258 1304 798 1072 605 1136 1580
- 1677 666 1057 1005 1203 1614 1700 1209 1267 885 1287 793 1152 1259 1482 1551
- 1585 1407 1819 1166 1247 682 1319 1462 1443 1407 1626 1378 1456 1170 1281 1409
- 1608 799 1081 508 1274 1378 1371 1228 1407 1185 1517 660 1138 1061 1177 754
- 1301 1445 1818 1392 1418 100 { m20} R 1010 1333 1033 1276 1163 1586 1076 1322
- 857 1112 743 1041 1525 1714 1570 1579 1022 1314 1156 1285 1282 1377 909 1187
- 1370 1479 1444 1894 1351 1628 1249 1283 1693 1688 1152 1242 599 1366 772 1138
- 1440 1523 1391 1487 1463 1723 1346 1527 960 1260 1496 1469 1158 1383 1084 1315
- 1148 1335 1340 1408 924 1113 1337 1472 1457 1547 1136 1291 981 1151 1290 1470
- 1228 1336 1588 1624 1091 1351 923 1138 783 1510 1403 1403 1322 1348 1065 1205
- 1255 1410 743 1308 1037 1165 1176 1569 1516 1605 813 1052 1530 1591 695 1085
- 765 1110 515 1268 804 1368 1140 1200 758 1117 1208 1559 1378 1474 761 1135 576
- 1214 1033 1312 1297 1470 1200 1316 1231 1431 991 1116 1338 1378 1038 1304 930
- 1174 1024 1225 1538 1714 1199 1570 811 1082 894 1369 853 1200 798 1099 1130
- 1474 686 1120 1170 1335 515 1257 875 1173 696 1056 752 1056 808 1263 1362 1440
- 1104 1479 813 1115 1406 1878 657 1347 1313 1828 1094 1205 1053 1193 650 1206
- 1017 1196 759 1073 1595 1708 861 1065 855 1062 1155 1286 1091 1270 100 { m20} R
- 1609 1586 984 1161 870 1073 1177 1245 927 1324 1167 1481 849 1726 1364 1404
- 1415 1564 1255 1788 1481 1672 903 1407 1446 1497 1135 1332 896 1081 784 1236
- 1365 1427 1123 1353 1557 1735 1435 1591 1141 1341 1078 1289 1411 1678 935 1209
- 1110 1394 1236 1434 1235 1613 727 1104 1303 1311 1152 1244 991 1168 1056 1149
- 986 1141 1054 1628 834 1073 1039 1245 1336 1348 1091 1302 1318 1410 1373 1658
- 1536 1724 561 1178 1579 1703 1458 1754 971 1392 1148 1335 1315 1599 1611 1682
- 1563 1588 1087 1190 1309 1532 1536 1785 1147 1201 987 1138 1484 1483 773 1065
- 1016 1336 727 1130 1362 1609 887 1134 1366 1405 993 1149 1117 1327 889 1087
- 1155 1268 1458 1458 1237 1343 951 1464 1013 1157 1460 1440 1377 1436 1362 1656
- 772 1119 1583 1576 664 1093 1507 1699 549 1233 1257 1304 1255 1677 725 1097
- 1474 1676 736 1165 1557 1635 1037 1272 603 1150 1536 1552 1319 1516 1179 1302
- 1070 1338 1094 1243 1134 1307 1451 1655 1268 1328 1179 1548 1068 1281 1191 1239
- 1086 1388 1647 1661 887 1300 1408 1779 100 { m20} R 717 1125 699 1123 1331 1357
- 1572 1584 1424 1530 782 1100 795 1112 1103 1258 1102 1281 1382 1509 783 1169
- 1155 1291 1288 1457 1165 1348 1383 1508 1223 1875 776 1104 1175 1310 928 1203
- 1110 1200 1171 1286 912 1163 1534 1639 971 1113 1429 1591 639 1190 1257 1356
- 1327 1429 900 1100 1586 1656 1330 1469 1378 1515 803 1056 1341 2061 1283 1358
- 1030 1148 761 1059 573 1203 1339 1916 1042 1312 1588 1730 704 1061 1347 1454
- 958 1101 872 1247 1382 1545 1437 1535 909 1237 1211 1272 798 1112 878 1131 761
- 1063 1448 1542 1195 1347 1646 1651 1300 1375 1254 1440 1367 1502 1039 1175 1299
- 1421 912 1368 1180 1230 817 1067 1383 1651 905 1094 953 1331 1438 1751 1300
- 1474 598 1290 1182 1467 1422 1434 1003 1135 1541 1692 780 1091 498 1396 1014
- 1221 1535 1788 1061 1249 1291 1382 953 1456 761 1076 972 1262 1481 1546 1175
- 1432 1063 1723 1186 1643 1463 1750 1364 1500 1541 1600 1076 1337 1689 1709 746
- 1131 1616 1632 657 1241 1040 1144 1722 1697 1617 1636 1358 1394 1492 1641 1049
- 1286 100 { m20} R 1363 1647 1000 1141 1385 1525 1441 1706 1126 1278 1234 1823
- 1346 1379 923 1180 1268 1656 736 1037 1540 1554 996 1182 990 1565 1343 1494 756
- 1076 925 1542 1055 1207 1569 1552 1096 1189 1089 1497 664 1084 1079 1619 1105
- 1232 566 1241 1643 1715 1115 1202 1442 1864 1272 1616 1652 1693 856 1131 1686
- 1684 883 1130 1344 1484 1163 1309 1304 1369 1105 1374 723 1043 1053 1151 1091
- 1255 1460 1747 863 1070 1288 1483 943 1186 1341 1504 1597 1727 1066 1263 1293
- 1310 1068 1350 1616 1662 1696 1673 889 1082 747 1133 907 1257 1116 1279 719
- 1067 1653 1643 861 1112 1139 1464 492 1436 1468 1634 795 1198 668 1091 1354
- 1633 707 1096 1615 1725 604 1116 982 1239 1534 1667 977 1156 980 1332 1573 1749
- 968 1206 821 1160 1126 1539 1213 1388 1271 1629 1068 1274 1258 1559 1625 1679
- 1138 1385 1599 1587 1022 1131 1666 1711 768 1059 1280 1642 1619 1722 759 1190
- 995 1307 784 1161 672 1137 800 1200 940 1572 1147 1471 1333 1380 1076 1320 1017
- 1182 1321 1381 1387 1769 1102 1179 647 1064 100 { m20} R 1112 1330 828 1143
- 1146 1246 1005 1174 999 1125 823 1276 1417 1523 945 1101 904 1315 749 1098 1330
- 1635 1104 1333 1366 1382 902 1294 1070 1313 1671 1665 923 1235 1317 1629 1542
- 1571 1422 1661 1316 1587 1258 1336 731 1113 764 1354 1179 1311 894 1111 1249
- 1375 817 1136 969 1109 996 1193 1296 1455 1030 1134 1625 1605 675 1266 833 1144
- 949 1190 1064 1265 1119 1534 888 1129 972 1381 1269 1617 680 1115 1131 1350
- 1413 1511 1342 1551 1130 1327 833 1169 1109 1201 48 { m20} R 593 1193 859 1633
- 600 1507 667 1083 1570 1555 1363 1395 1650 1616 1387 1579 1554 1694 978 1280
- 1431 1404 1626 1650 977 1117 1034 1220 773 1145 1073 1247 802 1279 713 1050 686
- 1141 1284 1574 1356 1944 785 1296 1504 1646 851 1254 1119 1495 1376 1439 1460
- 1488 858 1172 1527 1627 1642 1612 1088 1540 1492 1822 895 1255 922 1106 1501
- 1620 1311 1680 1245 1280 759 1442 990 1258 1103 1193 696 1043 892 1606 763 1116
- 705 1066 882 1236 1409 1727 1419 1845 826 1067 1073 1169 991 1118 916 1314 1267
- 1412 1116 1242 955 1157 1275 1537 815 1056 1474 1495 1451 1586 786 1046 1312
- 1634 1541 1554 1462 1445 1338 1360 1448 1751 763 1058 1395 1604 1119 1375 923
- 1179 837 1331 1185 1281 1348 1585 737 1322 1102 1333 1580 1746 708 1230 1543
- 1672 781 1041 1522 1787 1287 1575 819 1367 1364 1466 1301 1445 1075 1248 1379
- 1500 1553 1649 917 1128 954 1164 1484 1571 791 1170 1561 1737 1277 1393 778
- 1108 1302 1431 1336 1427 1009 1303 1173 1281 1504 1807 1616 1704 603 1133 1184
- 1355 100 { m20} R 1137 1280 1002 1160 1197 1387 609 1212 1448 1583 1485 1476
- 1235 1561 1015 1213 1080 1304 1053 1377 1333 1595 757 1193 1317 1452 985 1290
- 1435 1918 1439 1462 1482 1488 1141 1588 1298 1450 1475 1511 1237 1299 1489 1527
- 1489 1765 856 1281 1242 1390 914 1087 1500 1615 1053 1247 1241 1621 1236 1563
- 1191 1260 584 1128 891 1162 1139 1380 902 1126 896 1126 1229 1515 988 1323 642
- 1138 1357 1534 1228 1330 1656 1672 793 1075 1436 1440 1514 1573 1187 1238 816
- 1087 731 1055 826 1176 1197 1990 1337 1451 1334 1519 862 1156 1182 1484 1395
- 1792 1053 1261 728 1071 1020 1186 1330 1542 1224 1556 1023 1204 1131 1299 1453
- 1494 795 1203 959 1263 832 1085 798 1144 565 1150 829 1180 1078 1175 969 1245
- 1704 1694 1548 1641 1135 1233 1598 1561 1149 1262 920 1293 1177 1581 1527 1796
- 1404 1513 902 1119 626 1297 820 1084 1489 1787 1576 1641 875 1104 1529 1684 858
- 1094 911 1236 1190 1616 833 1065 1471 1438 1000 1285 919 1227 877 1142 1073
- 1612 1202 1293 626 1236 1091 1250 1234 1311 100 { m20} R 899 1107 701 1074 853
- 1130 576 1144 1280 1354 714 1196 1145 1442 1095 1251 767 1189 1402 1570 737
- 1056 877 1224 1008 1299 1151 1233 1054 1307 1466 1634 1010 1125 1132 1207 1588
- 1717 1036 1232 1356 1387 706 1089 964 1106 972 1279 855 1439 1026 1161 1421
- 1630 938 1731 774 1052 783 1056 1260 1495 726 1210 1045 1186 1510 1650 866 1096
- 988 1217 979 1541 1432 1480 954 1116 1458 1447 1222 1996 912 1229 685 1205 1300
- 1578 1352 1610 896 1335 1135 1541 897 1169 565 1216 1232 1541 792 1056 1323
- 1403 1495 1642 678 1109 999 1240 854 1220 1516 1697 1236 1314 832 1060 1591
- 1689 1227 1278 1415 1417 1246 1487 1630 1632 1324 1672 1245 1359 1167 1289 865
- 1110 1169 1253 1056 1310 1012 1161 1090 1321 887 1129 1251 1390 669 1317 1061
- 1223 893 1171 885 1266 993 1121 833 1303 802 1046 694 1144 1665 1707 1316 1582
- 1027 1180 730 1390 789 1132 726 1050 1030 1225 929 1169 1411 1552 1358 1664
- 1213 1305 956 1138 866 1419 1341 1425 1472 1506 1228 1432 1457 1689 1683 1677
- 100 { m20} R 1512 1762 1516 1633 1655 1661 1301 1741 1470 1517 811 1084 1204
- 1247 1603 1570 1444 1755 905 1651 1335 1474 648 1095 1436 1623 1492 1605 1071
- 1172 897 1082 1020 1225 1196 1333 1152 1350 1419 1596 1552 1692 866 1314 1505
- 1614 673 1056 1110 1524 1221 1245 1019 1208 1441 1532 819 1253 1288 1404 841
- 1067 697 1133 1466 1472 1259 1369 1334 1459 1323 1417 621 1145 1085 1374 1582
- 1560 1473 1675 1085 1221 1310 1641 755 1068 1137 1782 995 1131 654 1172 1547
- 1633 1043 1311 902 1143 796 1594 1453 1426 1517 1659 903 1105 575 1173 745 1075
- 1196 1872 792 1047 843 1064 1523 1749 1416 1479 608 1108 1421 1611 1522 1698
- 950 1099 1613 1705 1230 1330 1214 1456 1363 1478 798 1145 1537 1723 830 1142
- 1339 1623 1407 1551 1097 1268 1157 1290 1356 1490 878 1091 1062 1537 855 1278
- 1422 1619 1054 1441 570 1275 878 1151 859 1155 1047 1284 766 1132 1166 1266 651
- 1099 1415 1896 1085 1193 1276 1311 1343 1404 1144 1264 876 1081 1439 1768 817
- 1054 885 1099 874 1068 938 1350 1161 1347 100 { m20} R 798 1086 1025 1440 704
- 1167 1244 1364 1072 1496 1473 1557 1141 1511 687 1279 1246 1422 1593 1659 1548
- 1597 1081 1367 1653 1650 653 1072 1309 1373 1238 1454 926 1100 1175 1402 813
- 1208 1447 1616 1062 1220 1553 1515 1174 1755 1494 1662 818 1197 1288 1334 1033
- 1268 774 1105 1526 1570 1564 1609 1030 1252 946 1369 1424 1521 1158 1245 1267
- 1538 520 1223 875 1101 1393 1422 1291 1320 1535 1716 1375 1383 1281 1807 723
- 1077 1599 1656 1367 1359 944 1097 907 1091 974 1119 1113 1413 1508 1663 1463
- 1494 1626 1697 1073 1301 1010 1142 1265 1372 891 1200 510 1343 821 1309 1008
- 1281 1199 1238 1295 1768 1138 1271 1030 1159 1179 1373 1174 1297 1423 1726 1182
- 1338 1297 1315 1353 1516 1387 1594 1410 1409 1410 1834 1631 1610 1068 1193 1291
- 1668 861 1337 1524 1608 600 1220 1508 1708 1553 1661 1357 1551 1145 1334 1112
- 1258 1137 1531 1419 1401 752 1056 1601 1614 1328 1321 1159 1370 1338 1492 1180
- 1531 835 1160 912 1160 1311 1526 1048 1182 885 1092 764 1035 682 1205 1460 1720
- 994 1119 100 { m20} R 832 1241 611 1159 690 1145 877 1186 860 1216 1377 1660
- 1059 1356 1441 1696 1069 1380 1073 1352 1207 1608 1181 1219 1367 1366 784 1043
- 1348 1421 617 1174 781 1053 1074 1492 716 1275 831 1437 1351 1742 1291 1394
- 1230 1409 568 1214 1085 1296 1412 1658 640 1103 1185 1299 727 1209 994 1276 687
- 1075 815 1198 1567 1608 1209 1333 1515 1646 1418 1497 1359 1377 1065 1223 818
- 1073 697 1198 874 1179 1067 1300 1172 1391 1198 1230 789 1042 1500 1777 961
- 1165 1195 1485 1660 1684 1119 1370 698 1109 1177 1525 805 1261 634 1310 1408
- 1475 1006 1140 968 1139 944 1283 1222 1447 880 1086 1350 1444 1226 1272 1269
- 1563 700 1322 1493 1641 1492 1577 856 1172 1319 1433 1445 1885 894 1180 1296
- 1468 742 1080 798 1085 1286 1490 1111 1532 748 1082 1137 1241 1336 1491 1255
- 1369 1102 1560 828 1105 1213 1271 1073 1191 1164 1228 993 1121 1226 1261 963
- 1411 1260 1378 901 1175 1306 1371 956 1196 838 1084 1053 1377 978 1668 776 1038
- 1413 1726 1203 1390 1199 1411 1335 1801 980 1193 100 { m20} R 1499 1566 1403
- 1487 808 1049 1111 1533 1565 1538 1507 1632 680 1198 1485 1839 1253 1381 823
- 1057 1276 1401 969 1237 1263 1533 1511 1568 784 1183 1281 1952 913 1208 727
- 1171 1104 1321 1433 1580 1196 1418 972 1183 1416 1430 716 1265 1008 1778 1368
- 1513 1706 1699 1590 1695 1534 1779 1010 1376 1507 1511 670 1373 1263 1286 1498
- 1541 1243 1562 1255 1307 1474 1621 624 1197 737 1112 1355 1771 1464 1683 1179
- 1424 772 1038 958 1147 1053 1304 1334 1469 875 1101 635 1129 1417 1433 1077
- 1220 955 1101 1254 1587 1277 1448 1150 1264 679 1247 836 1056 1057 1172 873
- 1329 1515 1586 893 1309 849 1238 1363 1478 968 1162 1360 1781 886 1080 1205
- 1312 1246 1401 1659 1683 707 1155 1438 1609 898 1180 1000 1163 598 1191 1540
- 1570 672 1047 1104 1190 1429 1724 822 1276 1220 1295 1430 1433 878 1218 966
- 1182 1142 1419 1001 1553 596 1683 1099 1315 1466 1448 1366 1484 1437 1427 1159
- 1215 874 1307 1427 1504 781 1248 1404 1580 835 1056 1162 1342 1338 1388 606
- 1132 1172 1260 737 1212 100 { m20} R 1281 1372 1504 1590 609 1436 772 1113 1224
- 1471 1220 1257 839 1252 762 1338 1389 1798 1605 1606 971 1116 598 1118 908 1085
- 801 1167 889 1079 759 1169 1115 1449 1267 1386 1106 1508 1479 1746 647 1062 666
- 1138 1344 1470 1398 1613 1053 1219 1351 1493 1174 1372 957 1102 1288 1538 857
- 1119 1330 1530 683 1090 721 1098 1512 1796 1424 1726 1182 1248 1614 1690 1643
- 1696 1588 1628 1508 1718 1326 1524 1377 1372 660 1105 631 1080 1081 1249 1138
- 1223 1588 1623 707 1075 826 1056 1205 1317 1017 1162 855 1252 1567 1622 1040
- 1182 1168 1866 658 1284 638 1127 965 1193 1561 1623 980 1225 959 1541 894 1118
- 629 1159 1551 1659 1460 1461 1272 1588 841 1058 1486 1619 874 1246 1059 1296
- 1552 1579 609 1132 1590 1704 1325 1471 1310 1456 898 1079 1478 1635 1525 1648
- 720 1041 1541 1633 1386 1450 876 1313 1135 1192 1374 1889 1366 1351 1117 1334
- 872 1167 778 1170 731 1094 1185 1253 1113 1312 1407 1526 958 1182 970 1818 1113
- 1434 1465 1607 1226 1405 1228 1401 691 1172 1489 1704 100 { m20} R 1499 1706
- 736 1057 1543 1541 1427 1418 1255 1336 811 1337 1533 1635 1459 1458 1655 1694
- 1417 1410 1063 1154 1586 1731 849 1065 1272 1293 1276 1367 1373 1579 760 1221
- 734 1111 1514 1816 845 1066 1242 1539 723 1110 1010 1166 878 1481 806 1153 1536
- 1715 503 1380 1185 1273 1028 1285 935 1437 787 1073 1456 1613 1282 1328 989
- 1130 1331 1377 835 1064 740 1131 908 1081 1190 1266 746 1135 1440 1612 866 1178
- 1411 1523 835 1245 1021 1200 1264 1405 953 1132 1008 1135 1415 1412 944 1220
- 1622 1609 970 1144 1556 1655 686 1209 1050 1156 914 1281 848 1550 1088 1446
- 1505 1525 771 1307 1161 1538 1332 1364 1344 1484 1554 1527 831 1284 809 1049
- 1616 1687 1195 1416 1562 1747 1316 1367 1120 1196 647 1142 1209 1530 738 1198
- 1083 1197 776 1208 1209 1363 1322 1478 1037 1219 1406 1400 1206 1753 1040 1168
- 716 1481 1279 1730 1381 1705 762 1370 1515 1633 1024 1132 1257 1642 1233 1254
- 1079 1189 875 1075 999 1214 1348 1417 1432 1491 1656 1653 1571 1745 1414 1562
- 1073 1397 824 1288 100 { m20} R 1244 1388 1384 1537 1384 1470 1378 1369 1540
- 1584 743 1205 1118 1273 1012 1154 791 1142 1078 1180 721 1171 829 1229 994 1117
- 1295 1410 899 1195 1382 1457 714 1050 1323 1518 1431 1830 1067 1259 1482 1611
- 1084 1232 753 1058 1400 1685 860 1240 1141 1211 1542 1664 838 1311 1024 1195
- 703 1072 1317 1372 938 1236 802 1075 1014 1407 1495 1614 932 1521 1456 1454
- 1170 1546 1359 1488 987 1204 1225 1422 1313 1595 1186 1344 469 1567 1153 1272
- 1157 1507 1272 1317 889 1195 813 1128 1330 1500 1289 1591 1524 1580 993 1144
- 1201 1236 786 1178 1242 1496 1246 1269 986 1277 1376 1870 1230 1394 1119 1332
- 699 1060 958 1205 1335 1882 1127 1267 1223 1607 1015 1301 1211 1405 614 1110
- 1445 1456 1532 1543 1071 1251 1011 1234 909 1250 1509 1733 1021 1183 1108 1290
- 747 1040 1781 1760 1414 1491 914 1236 1537 1786 1144 1304 1021 1253 1314 1348
- 745 1047 873 1332 988 1217 1052 1171 799 1285 840 1081 1206 1285 1561 1573 663
- 1171 1240 1549 1237 1342 1130 1199 776 1089 901 1131 1003 1246 100 { m20} R
- 1302 1621 1172 1317 886 1221 1244 1349 1663 1692 821 1063 1686 1681 1367 1378
- 1158 1710 1020 1428 1424 1450 931 1639 866 1190 1629 1695 1330 1458 632 1114
- 922 1191 746 1165 795 1085 1510 1774 785 1125 844 1078 1054 1196 714 1038 1382
- 1514 1437 1768 1700 1670 1045 1336 1278 1507 1032 1220 1052 1251 966 1124 1001
- 1165 853 1125 902 1324 1013 1173 834 1188 1533 1659 623 1287 1173 1449 1205
- 1382 1030 1343 1033 1167 1052 1287 826 1120 698 1357 831 1063 1256 1368 1343
- 1386 1555 1600 1407 2005 1474 1593 707 1055 1353 1882 1036 1137 887 1217 1018
- 1580 1192 1258 1103 1180 1372 1807 972 1198 715 1294 897 1274 1542 1585 920
- 1164 804 1046 1723 1715 1221 1486 1506 1818 1243 1260 961 1118 1039 1586 845
- 1138 1269 1385 796 1098 1235 1646 1381 1772 788 1268 1184 1426 1004 1182 1053
- 1214 1244 1496 1302 1452 997 1193 1060 1242 1372 1493 1148 1613 1383 1547 970
- 1106 1453 1780 1203 1283 1190 1381 1398 1720 1395 1603 1206 1361 1701 1708 1250
- 1770 1105 1204 1208 1469 788 1076 100 { m20} R 1241 1335 1298 1591 753 1119 970
- 1300 662 1114 1584 1691 1241 1467 631 1215 827 1083 1299 1467 1375 1495 1418
- 1637 1110 1207 1195 1297 1271 1450 1236 1451 1568 1640 954 1202 1527 1783 1194
- 1290 767 1292 806 1159 876 1082 1347 1400 1324 1470 863 1181 1674 1652 1267
- 1369 761 1052 1368 1478 1120 1534 708 1181 590 1119 1534 1565 901 1093 880 1098
- 931 1343 985 1291 1040 1314 668 1075 999 1313 701 1040 636 1096 1528 1706 672
- 1245 1011 1413 513 1450 1137 1366 1231 1530 1027 1179 735 1161 1267 1449 1337
- 1403 1108 1302 1055 1215 692 1041 1343 1616 839 1082 871 1205 688 1133 1175
- 1387 972 1210 1376 1606 1259 1426 1411 1584 1445 1478 1044 1210 693 1364 1264
- 1332 618 1099 1350 1531 1528 1642 653 1112 695 1351 1340 1507 712 1086 895 1078
- 1063 1151 1437 1528 941 1100 955 1102 1487 1505 1242 1347 1238 1364 1459 1568
- 1239 1310 1406 1518 1135 1191 1517 1636 743 1181 1182 1461 949 1130 875 1082
- 1000 1146 780 1079 1557 1627 1346 1558 1371 1377 674 1192 1400 1439 100 { m20
-} R 1558 1587 1272 1463 1365 1471 1538 1771 1040 1430 1113 1306 721 1056 776
- 1414 842 1159 1056 1174 736 1062 1389 1508 1156 1334 1070 1275 872 1100 1416
- 1821 929 1178 1482 1540 1330 1426 1557 1734 1223 1325 926 1112 658 1089 1427
- 1411 1122 1198 714 1092 917 1263 920 1265 797 1057 985 1178 993 1177 1407 1725
- 1022 1153 1120 1363 1194 1264 1583 1744 1035 1158 1354 1492 718 1095 1072 1160
- 1326 1617 840 1057 625 1165 887 1159 651 1201 740 1233 1295 1568 833 1096 1553
- 1572 1007 1123 1315 1358 1541 1705 1210 1273 724 1068 1158 1205 1282 1729 1650
- 1633 1163 1212 1261 1630 878 1094 1001 1221 1444 1746 1340 1384 1379 1432 665
- 1202 1383 1531 1247 1442 1527 1690 575 1167 1493 1473 1154 1291 815 1263 1452
- 1560 1321 1353 914 1093 1691 1706 1469 1513 1194 1243 1335 1602 877 1206 1100
- 1229 663 1120 1100 1372 1406 1877 1332 1575 1386 1427 1109 1304 854 1088 961
- 1119 1294 1574 630 1197 1460 1667 1193 1333 1554 1601 1336 1545 618 1132 646
- 1149 744 1087 1401 1503 1076 1248 100 { m20} R 1206 1319 1229 1349 957 1125
- 1243 1496 1631 1689 1252 1522 906 1150 951 1322 1270 1392 1263 1342 1290 1549
- 821 1056 676 1157 884 1390 1046 1206 1423 1508 1023 1135 1001 1230 1418 1660
- 1071 1321 871 1187 659 1116 761 1036 1295 1397 647 1204 637 1296 1280 1477 1040
- 1339 1077 1266 1257 1630 836 1093 698 1212 854 1098 1203 1427 1063 1171 1050
- 1217 795 1346 775 1089 885 1244 1173 1325 1604 1619 877 1268 953 1273 1631 1675
- 695 1041 1099 1389 1059 1257 1023 1189 632 1186 850 1115 1189 1505 675 1374
- 1084 1218 755 1056 1285 1290 1187 1267 984 1124 1281 1366 1033 1355 1222 1397
- 439 1423 825 1081 1286 1518 1513 1518 973 1153 1256 1335 807 1259 987 1213 823
- 1150 769 1225 892 1545 1385 1459 961 1793 646 1134 1389 1643 1060 1223 1040
- 1382 873 1099 1207 1488 1190 1231 842 1090 884 1162 1208 1242 1257 1412 1095
- 1186 1647 1706 896 1201 975 1263 1348 1666 1649 1668 1157 1511 1596 1636 1057
- 1172 1550 1645 749 1185 1041 1200 651 1208 903 1235 861 1110 1030 1456 100 {
- m20} R 1540 1769 775 1056 872 1179 659 1072 1244 1279 906 1492 1476 1488 815
- 1057 757 1047 1007 1266 1478 1635 1440 1479 1524 1572 1366 1431 775 1292 918
- 1488 1258 1384 1179 1762 754 1387 1069 1156 1282 1750 938 1502 658 1169 1463
- 1873 1194 1263 1305 1539 860 1073 1382 1528 729 1141 1257 1435 1469 1600 1201
- 1492 995 1423 1299 1304 943 1116 1436 1518 1346 1419 1288 1404 846 1067 1053
- 1360 1054 1203 1171 1232 790 1049 739 1047 1413 1477 619 1161 870 1102 753 1089
- 1095 1209 991 1367 927 1091 1421 1461 1053 1472 967 1278 1565 1558 1287 1316
- 1498 1562 1168 1396 1391 1457 1253 1545 1155 1229 1554 1677 795 1348 1171 1382
- 1225 1250 1316 1477 1493 1508 961 1114 813 1389 1438 1764 1071 1443 861 1197
- 1049 1388 934 1371 849 1165 879 1124 1007 1157 1061 1240 1256 1270 889 1233
- 1148 1318 1201 1315 1729 1724 1361 1614 1379 1480 1005 1221 879 1076 1536 1647
- 875 1113 1155 1269 708 1129 712 1135 1709 1701 1046 1622 671 1145 822 1354 642
- 1097 950 1427 829 1394 1467 1534 100 { m20} R 618 1298 1474 1583 1315 1746 567
- 1229 1345 1716 1285 1369 1222 1539 1380 1434 1520 1638 980 1114 642 1325 1301
- 1320 1374 1377 785 1160 1352 1553 1683 1673 568 1373 795 1154 915 1331 1372
- 1651 863 1284 865 1066 852 1202 1162 1451 1013 1148 1154 1240 1274 1397 1256
- 1427 1604 1568 887 1090 1385 1640 1277 1446 776 1169 1434 1854 1185 1308 926
- 1396 861 1247 613 1100 1376 1557 1421 1659 1380 1379 1249 1390 1548 1701 1031
- 1190 995 1213 868 1161 923 1104 795 1215 1389 1499 1317 1583 1213 1251 630 1241
- 1078 1266 1244 1309 699 1039 1341 1538 1372 1393 680 1143 1430 1903 1176 1432
- 918 1144 1319 1532 1080 1325 781 1126 843 1159 715 1035 1153 1439 945 1335 1034
- 1273 1545 1776 1536 1669 976 1216 1071 1460 913 1492 533 1289 1131 1275 1513
- 1512 1192 1395 1020 1281 1429 1814 982 1133 1091 1221 729 1036 1115 1479 1094
- 1256 684 1167 826 1069 726 1231 1075 1258 1471 1559 880 1346 935 1198 1069 1234
- 1201 1698 1517 1686 684 1065 1058 1234 1182 1289 1375 1373 1620 1622 100 { m20
-} R 1069 1493 1173 1459 778 1239 1513 1559 1225 1342 1526 1683 1444 1663 743
- 1111 1583 1687 830 1056 1420 1449 678 1232 1077 1333 920 1267 1505 1525 1223
- 1758 1280 1846 780 1120 1245 1397 881 1403 1348 1543 1674 1687 1241 1392 1478
- 1506 817 1088 1267 1384 1038 1340 664 1065 989 1411 806 1132 1494 1507 1450
- 1485 639 1132 647 1177 1137 1195 1194 1387 1603 1622 1505 1632 1369 1940 1592
- 1676 1336 1341 822 1393 1143 1327 1226 1476 714 1036 1021 1214 941 1290 1594
- 1646 1103 1294 669 1069 967 1305 1388 1472 1459 1455 1086 1242 999 1163 775
- 1156 1403 1412 1064 1275 1574 1656 1584 1723 976 1367 1056 1153 1534 1544 1481
- 1575 875 1222 1080 1170 700 1214 985 1198 944 1098 1301 1533 1209 1298 761 1083
- 1465 1672 801 1102 947 1104 867 1092 1000 1214 798 1044 1236 1394 1365 1382 711
- 1181 686 1170 1372 1403 1335 2034 1130 1530 1469 1502 1074 1233 1478 1499 1325
- 1363 1126 1199 1162 1249 960 1267 1363 1418 820 1218 1351 1485 1332 1347 784
- 1125 1031 1255 794 1081 547 1301 100 { m20} R 1389 1528 1451 1628 1287 1291 786
- 1042 1257 1358 1471 1731 1255 1623 1221 1340 1453 1881 1264 1486 1291 1305 753
- 1219 1308 1440 1429 1576 669 1102 1167 1537 1503 1532 1334 1422 585 1193 1386
- 1420 931 1187 1375 1652 657 1067 928 1314 1321 1348 1455 1729 1189 1276 1391
- 1478 746 1040 1392 1375 699 1042 566 1196 1069 1570 1408 1908 1564 1646 875
- 1198 792 1043 1229 1519 1114 1290 1067 1461 1325 1562 818 1211 898 1117 677
- 1088 919 1191 1491 1550 1019 1202 1244 1495 1259 1459 1200 1349 1273 1304 747
- 1128 1028 1353 1107 1177 1305 1406 849 1215 1145 1309 832 1100 1162 1286 976
- 1294 826 1129 1010 1307 809 1216 1254 1792 941 1125 1252 1394 645 1106 718 1352
- 937 1213 1378 1637 1030 1226 953 1344 853 1496 1202 1579 1337 1397 1062 1151
- 737 1105 754 1103 713 1088 888 1284 719 1093 1608 1690 1262 1763 953 1166 1243
- 1344 649 1089 1566 1537 1395 1396 895 1192 835 1305 1507 1780 951 1202 1462
- 1874 1140 1216 756 1191 1027 1599 1362 1553 1569 1734 1332 1515 1142 1556 100 {
- m20} R 602 1158 1324 1556 1289 1292 590 1189 984 1368 918 1328 753 1087 1057
- 1154 1690 1666 973 1256 1054 1232 899 1181 554 1219 1611 1585 1386 1497 845
- 1103 862 1145 1522 1725 638 1151 752 1140 760 1125 1106 1355 702 1128 1085 1660
- 815 1173 1269 1502 1007 1506 871 1092 1158 1270 1180 1268 1105 1216 861 1208
- 1116 1300 1250 1398 718 1071 947 1109 581 1132 753 1055 648 1062 800 1170 1226
- 1282 807 1284 776 1140 1143 1400 1592 1553 1320 1569 714 1117 1190 1443 811
- 1093 1377 1954 1476 1776 1421 1435 854 1126 986 1325 852 1185 1370 1368 862
- 1306 1218 1286 959 1272 1096 1659 1196 1304 1417 1671 1163 1426 725 1179 1235
- 1363 1445 1538 1094 1650 646 1107 883 1104 1219 1360 1211 1331 1183 1284 1431
- 1569 1420 1677 889 1097 954 1137 907 1137 1460 1764 989 1230 1285 1292 1167
- 1276 924 1213 1202 1340 1207 1457 865 1155 1181 1220 1466 1538 663 1072 1490
- 1602 1059 1181 1094 1326 1223 1404 1505 1756 774 1152 1170 1480 674 1144 1235
- 1513 1213 1289 1268 1290 1169 1452 100 { m20} R 914 1216 1464 1435 757 1081
- 1362 1552 1393 1455 884 1079 1139 1274 816 1059 1205 1399 699 1146 842 1081 729
- 1174 1127 1813 679 1057 1383 1486 833 1103 769 1055 921 1109 781 1096 996 1202
- 1211 1593 815 1065 930 1121 1478 1691 1049 1360 1616 1596 999 1285 1420 1491
- 947 1411 698 1373 1390 1580 701 1039 1368 1437 1275 1581 1112 1458 1045 1156
- 1484 1629 755 1146 812 1107 1212 1683 1264 1274 1045 1289 1085 1402 1395 1414
- 1027 1416 1302 1623 961 1256 1042 1486 907 1128 1042 1200 756 1034 1491 1641
- 1034 1460 1287 1724 1281 1373 738 1114 1279 1514 1021 1168 1583 1688 625 1178
- 834 1081 689 1106 1721 1697 956 1191 916 1153 1218 1397 964 1201 1301 1667 609
- 1099 1034 1185 1322 1519 964 1184 785 1188 688 1241 1451 1648 1509 1748 1194
- 1229 1256 1610 724 1167 661 1080 1041 1199 1308 1518 1039 1272 969 1486 778
- 1061 1148 1338 799 1148 1033 1290 804 1048 694 1114 833 1089 1405 1847 1539
- 1532 934 1099 632 1075 741 1101 1399 1543 1228 1535 1308 1794 712 1207 100 {
- m20} R 851 1100 1255 1365 1130 1405 965 1134 1304 1388 708 1121 1396 1472 707
- 1170 1507 1504 1619 1602 1252 1266 1414 1881 1431 1470 1487 1585 1402 1683 615
- 1210 1290 1510 1339 1437 1231 1907 1236 1268 709 1104 980 1486 920 1155 1163
- 1383 1367 1607 883 1073 620 1477 1456 1724 1554 1609 1586 1608 1284 1351 918
- 1104 1450 1500 756 1138 1195 1238 1083 1321 828 1173 946 1096 749 1051 1565
- 1570 789 1042 1689 1689 1578 1615 1411 1435 1299 1307 1118 1567 1212 1366 847
- 1072 48 { m20} R 1461 1448 1146 1315 1092 1456 899 1247 1358 1399 1044 1264
- 1304 1535 624 1357 862 1151 1513 1565 911 1286 673 1172 1355 1499 1315 1566 689
- 1322 1248 1401 1025 1153 934 1353 1045 1191 711 1065 821 1136 1204 1599 1210
- 1354 966 1186 976 1136 1191 1264 1124 1379 1306 1607 987 1173 1233 1440 1448
- 1456 1333 1473 1440 1546 685 1128 900 1132 1070 1160 1063 1351 793 1064 1420
- 1394 1325 1480 1525 1494 926 1088 1095 1376 1539 1592 1083 1217 1339 1403 971
- 1161 1187 1583 1314 1572 1379 1587 1071 1402 1571 1612 1111 1308 1196 1413 1189
- 1369 1158 1558 1302 1379 721 1032 808 1093 1212 1313 884 1136 1506 1533 1173
- 1216 1180 1359 1133 1384 999 1198 871 1085 1301 1305 862 1295 1529 1665 1040
- 1151 1464 1589 1201 1231 1075 1476 1204 1263 1101 1311 679 1064 1134 1294 924
- 1089 723 1307 766 1066 1264 1691 1133 1198 877 1325 1391 1427 1193 1279 1229
- 1650 985 1154 1223 1282 1003 1143 682 1101 1018 1280 951 1270 1399 1482 963
- 1310 1295 1363 1547 1664 1440 1681 702 1198 1436 1485 100 { m20} R 1312 1403
- 1236 1760 678 1088 1031 1161 1367 1376 1234 1372 1033 1449 1437 1567 1314 1316
- 925 1244 1162 1326 930 1453 648 1122 1144 1534 746 1077 1124 1264 1223 1250
- 1242 1371 999 1125 1337 1536 1376 1382 852 1177 1597 1710 1220 1295 1589 1644
- 1220 1246 672 1157 1280 1476 1315 1462 1209 1284 593 1310 678 1092 752 1371 691
- 1108 1196 1358 1251 1315 1068 1257 1139 1461 1654 1692 1357 1908 858 1067 1210
- 1517 1445 1453 869 1067 916 1157 1438 1471 1385 1523 1015 1128 871 1068 1358
- 1388 919 1177 885 1211 755 1300 1066 1191 1203 1292 1358 1530 1100 1233 989
- 1320 1342 1672 1348 1372 738 1121 1079 1657 1098 1171 1454 1752 1485 1677 662
- 1219 1250 1415 853 1120 1258 1405 1350 1532 871 1091 763 1065 1400 1470 1215
- 1378 1290 1388 742 1305 1208 1444 1031 1597 1125 1261 1220 1341 1456 1554 1120
- 1369 1028 1479 1639 1682 1453 1508 620 1086 1159 1301 1250 1264 1308 1706 1476
- 1603 1191 1350 1321 1316 857 1191 1140 1348 700 1139 873 1101 747 1058 1257
- 1367 1189 1412 990 1131 100 { m20} R 1071 1161 1574 1692 716 1102 1278 1731
- 1254 1650 1089 1367 1264 1657 947 1331 1446 1533 1578 1692 1364 1409 974 1227
- 1452 1703 605 1113 756 1141 1368 1402 483 1427 897 1111 751 1229 1025 1183 1276
- 1359 1150 1280 697 1071 1168 1226 1346 1557 986 1216 941 1228 1030 1140 1230
- 1865 902 1188 1386 1813 1188 1471 1026 1343 1199 1436 1020 1156 1062 1199 1092
- 1581 1394 1654 1549 1588 1380 1372 946 1107 924 1140 1290 1352 751 1060 1275
- 1304 1460 1879 1480 1471 1207 1299 1390 1370 1008 1309 662 1153 919 1123 1410
- 1684 1096 1349 614 1135 791 1098 982 1191 737 1041 796 1219 979 1125 1435 1500
- 1073 1357 1287 1495 747 1042 1207 1362 952 1448 1417 1682 1015 1128 963 1181
- 899 1137 637 1080 1150 1393 853 1065 1228 1865 772 1170 995 1185 1285 1690 850
- 1070 1425 1686 841 1123 1126 1310 1388 1543 1365 1610 1424 1610 816 1373 1335
- 1930 992 1156 1184 1241 823 1394 1356 1622 1217 1422 983 1312 783 1080 923 1165
- 944 1157 781 1202 1261 1532 908 1098 809 1309 1531 1757 100 { m20} R 956 1180
- 1525 1506 964 1307 1126 1479 584 1294 933 1118 1115 1354 1030 1551 801 1046
- 1445 1592 1026 1334 1117 1359 1515 1686 1624 1697 1206 1412 1130 1255 852 1106
- 922 1087 1350 1396 1257 1405 1015 1251 1555 1762 1484 1746 1084 1209 1122 1394
- 777 1081 1107 1659 1460 1637 986 1145 602 1393 1010 1313 870 1086 995 1287 1373
- 1473 1358 1604 705 1066 1277 1450 1469 1714 1053 1279 667 1053 1082 1264 1167
- 1448 1387 1431 1244 1295 923 1333 649 1146 1232 1628 1241 1665 881 1136 1003
- 1645 1233 1303 803 1116 759 1168 1554 1674 828 1095 816 1051 1308 1540 867 1125
- 1699 1707 1269 1484 1102 1249 1680 1659 1404 1555 1539 1530 682 1179 866 1197
- 1134 1354 892 1185 888 1502 1124 1341 973 1108 555 1272 1059 1264 1292 1646 617
- 1239 1068 1185 745 1076 1443 1478 1108 1281 1034 1149 1013 1551 733 1048 1428
- 1515 1330 1406 1376 1549 1061 1289 1223 1346 1272 1527 847 1289 1214 1484 711
- 1177 1526 1714 909 1105 1403 1619 1008 1268 1284 1458 1622 1603 1305 1376 590
- 1202 725 1144 100 { m20} R 647 1070 1199 1483 1034 1143 762 1123 1278 1330 1157
- 1452 1339 1476 819 1118 800 1118 1125 1451 874 1203 873 1434 1146 1280 949 1249
- 589 1134 1127 1245 1350 1529 1200 1307 1345 1614 911 1162 937 1233 1453 1659
- 857 1062 1189 1225 533 1261 1054 1341 819 1080 748 1125 1510 1666 1026 1370 818
- 1173 1529 1749 1377 1555 979 1236 1024 1331 1222 1425 1066 1627 1441 1610 1475
- 1518 1368 1362 1226 1541 1019 1423 1052 1162 1131 1305 917 1287 609 1107 643
- 1136 1330 1862 1205 1268 950 1141 734 1321 1185 1432 1339 1480 701 1051 1007
- 1281 1581 1570 826 1283 748 1045 1397 1498 1391 1630 1513 1602 991 1494 658
- 1278 768 1224 1126 1491 815 1060 967 1295 1018 1313 1013 1136 1368 1352 977
- 1390 695 1098 1415 1518 1134 1254 889 1177 666 1114 1080 1171 1028 1332 750
- 1139 1123 1267 883 1085 880 1174 1495 1613 1545 1719 1385 1490 1289 1434 1434
- 1508 1446 1423 720 1213 1434 1440 1014 1332 750 1192 766 1039 915 1160 1167
- 1637 1147 1259 1389 1562 958 1109 1145 1408 1201 1434 100 { m20} R 1571 1544
- 1017 1246 1339 1385 738 1095 793 1345 1076 1312 1064 1204 1466 1506 1196 1471
- 1667 1694 691 1061 1492 1606 843 1233 782 1138 1418 1580 1133 1230 1066 1505
- 1212 1351 939 1230 897 1209 1013 1202 1610 1726 1335 1696 1072 1190 941 1231
- 963 1269 1106 1261 782 1118 1035 1349 919 1085 874 1070 1304 1416 990 1560 850
- 1178 1265 1324 701 1106 1326 1498 1104 1325 1472 1720 1027 1421 941 1133 1660
- 1661 1430 1574 1051 1398 1247 1369 1333 1534 1288 1723 1299 1361 1640 1716 1121
- 1447 727 1111 1132 1411 782 1375 1418 1697 1332 1327 796 1293 891 1080 1474
- 1493 1222 1335 1187 1437 757 1183 622 1120 1219 1330 1521 1536 1523 1757 927
- 1117 1648 1679 775 1170 1503 1561 1438 1661 1514 1606 1084 1204 1127 1238 1160
- 1447 1705 1705 902 1099 1480 1586 797 1060 1331 1324 1022 1165 766 1100 1006
- 1542 1054 1328 1525 1798 681 1163 826 1056 1143 1403 1568 1717 1270 1352 1086
- 1294 1447 1658 1481 1694 1194 1424 1580 1640 1354 1550 732 1060 760 1080 689
- 1130 1598 1677 1031 1148 100 { m20} R 830 1185 1173 1483 1592 1625 1256 1475
- 1485 1832 1092 1376 1482 1470 855 1198 1067 1363 827 1113 846 1106 1009 1162
- 963 1170 1163 1417 1243 1306 1546 1698 712 1152 867 1073 1335 1466 641 1115
- 1295 1517 1087 1164 566 1149 574 1188 1546 1680 1354 1471 676 1161 773 1056 670
- 1249 538 1201 1658 1662 1119 1189 1309 1483 908 1198 1260 1608 1476 1742 988
- 1292 828 1187 1549 1643 1353 1557 1163 1375 1376 1554 1022 1272 945 1207 1521
- 1722 950 1202 1290 1337 1369 1485 828 1144 1081 1220 617 1274 1219 1360 1033
- 1161 782 1213 1399 1401 1078 1429 1684 1677 1086 1214 1166 1365 1495 1830 1120
- 1299 1178 1505 1431 1673 1098 1514 1338 1607 1076 1510 1199 1563 1355 1376 1389
- 1442 1245 1509 584 1225 965 1146 1158 1335 1481 1537 1452 1721 1615 1642 1095
- 1537 876 1194 1114 1179 1302 1440 992 1362 835 1186 1445 1574 1478 1765 949
- 1376 1076 1285 753 1109 948 1099 1332 1957 593 1227 1171 1302 697 1080 871 1101
- 1488 1606 1353 1349 832 1065 1336 1555 1153 1368 1242 1380 1063 1315 100 { m20
-} R 1109 1548 629 1121 1559 1594 1193 1282 794 1076 1503 1476 697 1297 1282 1609
- 1463 1772 1057 1166 1002 1192 1497 1616 1418 1637 1261 1462 1042 1331 763 1158
- 1360 1368 1003 1363 1256 1331 990 1124 899 1391 1036 1154 830 1067 1502 1780
- 965 1306 1006 1299 1218 1371 1056 1375 614 1091 1324 1584 704 1132 1454 1504
- 784 1080 1612 1666 1031 1146 1480 1466 823 1106 855 1078 1503 1562 1189 1432
- 737 1054 1132 1429 1200 1273 856 1115 960 1158 1184 1371 1471 1581 639 1222
- 1501 1722 1207 1263 1447 1640 1219 1339 1112 1293 1147 1296 800 1210 1057 1180
- 1295 1459 1039 1270 1459 1589 1474 1553 1304 1609 1381 1507 563 1174 1484 1576
- 1267 1488 1270 1278 1168 1250 723 1087 1261 1318 1231 1571 1065 1239 1391 1644
- 1095 1343 1349 1821 698 1381 1394 1624 992 1375 855 1197 1477 1444 1093 1247
- 1180 1312 558 1211 550 1708 1579 1594 901 1149 705 1377 1143 1208 1389 1496 758
- 1138 1551 1590 679 1099 1079 1261 1163 1235 1145 1352 876 1112 1021 1144 1427
- 1611 1044 1235 1190 1374 867 1357 100 { m20} R 753 1242 1481 1672 1163 1211
- 1181 1425 1543 1660 667 1058 1491 1497 779 1138 854 1092 1022 1222 1030 1218
- 994 1117 779 1039 1453 1785 1591 1626 1167 1368 1102 1353 1196 1410 795 1086
- 1340 1580 799 1171 1384 1603 1518 1656 1017 1157 727 1061 1141 1374 1450 1499
- 840 1240 870 1080 778 1041 1215 1475 633 1131 1330 1558 694 1120 1549 1632 1358
- 1346 802 1083 1230 1252 1467 1462 700 1090 1171 1331 1074 1522 1492 1697 892
- 1093 1239 1355 1088 1197 1084 1443 1092 1396 1478 1516 712 1043 496 1297 1380
- 1606 1174 1329 1233 1497 1591 1608 751 1213 827 1086 1076 1361 959 1237 1378
- 1691 1067 1731 1296 1341 623 1096 1208 1458 1384 1658 1371 1388 1246 1371 769
- 1125 1472 1535 1581 1572 640 1291 1244 1328 1178 1557 879 1104 1357 1386 1442
- 1683 1397 1472 1237 1271 1364 1686 1537 1539 1154 1573 1177 1238 1068 1354 1403
- 1688 1161 1410 848 1089 1438 1823 954 1111 1023 1169 1272 1486 1561 1604 811
- 1102 1589 1693 805 1050 1444 1523 922 1118 1412 1511 960 1362 814 1233 1288
- 1423 100 { m20} R 796 1044 670 1169 1516 1617 693 1204 735 1039 1387 1464 769
- 1241 1119 1308 1406 1567 1330 1503 1714 1701 1137 1327 776 1144 1058 1246 1089
- 1250 1451 1871 742 1031 1043 1146 1258 1621 1006 1447 1522 1601 920 1140 1155
- 1391 1004 1791 1108 1297 1170 1309 949 1136 956 1298 1374 1507 915 1425 1062
- 1189 1289 1518 1492 1694 1635 1617 1561 1745 1622 1689 1049 1181 1074 1537 1299
- 1343 757 1237 681 1132 684 1238 1244 1589 1298 1302 1385 1546 998 1346 639 1165
- 1274 1517 1352 1629 771 1159 1624 1641 1578 1659 1465 1811 1533 1549 883 1222
- 784 1144 992 1355 525 1293 1637 1665 1001 1164 1474 1462 1349 1735 1493 1470
- 860 1262 972 1173 932 1109 1411 1609 735 1191 1255 1315 1071 1159 682 1104 1105
- 1451 1318 1618 800 1144 702 1200 1162 1266 973 1313 761 1038 1545 1655 989 1202
- 1370 1462 1340 1451 1445 1451 642 1270 753 1089 891 1165 686 1141 971 1291 558
- 1240 1538 1764 1236 1421 985 1226 1203 1318 1124 1590 1530 1635 1258 1379 1489
- 1461 713 1190 1069 1309 1458 1706 100 { m20} R 1391 1498 848 1130 937 1179 1135
- 1202 1219 1411 985 1468 1451 1489 1261 1394 1317 1568 897 1250 961 1123 681
- 1063 1434 1549 606 1341 1445 1489 1184 1397 849 1153 1210 1338 835 1148 1149
- 1508 1030 1167 1451 1767 1006 1235 1401 1401 1603 1598 1487 1797 1146 1258 1011
- 1183 553 1309 1285 1291 1487 1606 920 1336 1023 1254 1161 1302 1109 1314 1058
- 1324 775 1123 864 1178 1286 1302 1374 1629 1466 1761 936 1155 807 1222 1109
- 1400 1067 1256 1227 1267 858 1098 1394 1925 1516 1586 697 1095 746 1238 810
- 1082 1088 1209 696 1113 833 1072 833 1301 1058 1238 1032 1244 1170 1308 1234
- 1365 1320 1691 495 1320 728 1090 1442 1514 1370 1511 1621 1634 1361 1356 1536
- 1653 1384 1403 1213 1241 1043 1165 1110 1211 969 1308 1165 1213 1344 1521 989
- 1256 1275 1509 1433 1877 1352 1504 1056 1295 588 1174 1498 1470 1151 1338 751
- 1045 761 1091 1718 1713 1101 1215 1037 1288 1531 1562 734 1215 1126 1854 905
- 1419 1474 1751 827 1106 1285 1332 627 1201 825 1191 1115 1383 1078 1244 1044
- 1188 100 { m20} R 895 1087 1336 1398 1734 1722 949 1258 716 1072 455 1376 1469
- 1813 772 1067 635 1135 754 1065 1352 1398 1193 1256 774 1131 1393 1403 1027
- 1183 1263 1321 797 1074 841 1062 1446 1562 724 1131 656 1165 1446 1625 1352
- 1372 1594 1623 771 1095 1177 1426 993 1262 1503 1515 919 1085 956 1259 637 1169
- 1434 1441 1037 1380 847 1074 876 1075 846 1146 1412 1455 747 1127 868 1419 1527
- 1630 948 1127 1246 1540 739 1093 1048 1257 1411 1515 1518 1686 1278 1363 1525
- 1649 1139 1486 1089 1390 1065 1204 1513 1687 845 1181 906 1204 1028 1659 1382
- 1915 1557 1621 877 1329 1014 1190 1429 1409 919 1329 782 1128 548 1369 1386
- 1668 1299 1498 1032 1152 1100 1272 818 1231 1515 1568 1532 1688 1532 1594 716
- 1053 1392 1527 813 1190 1003 1160 1058 1348 922 1245 1059 1150 1228 1264 1021
- 1147 809 1317 1151 1332 1294 1435 862 1430 1598 1682 1574 1676 1538 1705 1125
- 1325 806 1092 878 1293 813 1187 857 1119 1164 1225 1459 1429 620 1162 1218 1693
- 1342 1677 927 1635 1422 1473 1139 1329 100 { m20} R 1099 1250 1385 1540 690
- 1102 1424 1680 1059 1346 765 1098 1323 1866 1531 1617 1207 1303 1043 1179 961
- 1108 1546 1626 1505 1652 924 1173 797 1044 772 1161 948 1318 987 1238 1333 1607
- 1260 1320 898 1114 1559 1641 1539 1767 565 1393 946 1214 1141 1352 1402 1577
- 1376 1401 1164 1211 931 1559 884 1255 871 1074 920 1224 1288 1451 1264 1407
- 1520 1784 1141 1305 1476 1670 876 1134 1642 1713 699 1036 595 1165 1192 1461
- 1467 1613 766 1179 935 1342 788 1398 653 1149 1134 1423 840 1319 587 1125 1238
- 1382 1301 1436 1199 1665 1431 1670 1314 1658 1605 1720 944 1286 864 1083 1425
- 1466 1344 1471 1444 1654 1012 1171 952 1130 1094 1705 1303 1315 960 1102 1509
- 1779 1128 1810 1243 1336 848 1136 1485 1507 1102 1196 1439 1526 1135 1205 587
- 1320 856 1318 1333 1451 1707 1674 1546 1524 1041 1314 1427 1460 1587 1564 1256
- 1556 1266 1467 1033 1208 1458 1436 1172 1323 1136 1201 1054 1301 715 1176 1087
- 1453 1578 1663 1102 1223 1056 1367 1169 1340 1416 1432 1471 1541 1591 1552 766
- 1222 100 { m20} R 900 1179 813 1223 968 1139 838 1581 1369 1769 1003 1334 1365
- 1445 1021 1141 1413 1581 1394 1520 681 1420 1202 1259 984 1134 1258 1312 1371
- 1715 941 1234 1198 1602 1223 1337 1436 1516 1337 1561 853 1252 1340 1528 1619
- 1595 836 1175 1197 1297 857 1278 1105 1444 905 1150 1426 1743 1334 1550 816
- 1073 1062 1254 1443 1430 780 1389 1187 1268 1364 1896 664 1174 1548 1767 1337
- 1505 1157 1470 1539 1581 1368 1439 998 1172 857 1069 1168 1557 1033 1180 950
- 1307 1113 1301 870 1099 913 1085 866 1301 804 1091 1174 1506 1128 1362 1484
- 1823 1002 1266 1549 1592 631 1090 964 1123 1216 1405 718 1153 985 1141 1260
- 1488 769 1072 728 1131 1578 1563 832 1082 830 1057 988 1122 1208 1409 1215 1471
- 1418 1462 592 1209 1360 1384 859 1157 1052 1462 598 1240 1218 1463 872 1115
- 1438 1503 966 1343 726 1313 1028 1145 1213 1354 1228 1340 1042 1141 1102 1247
- 1362 1577 918 1098 767 1110 1571 1683 867 1068 830 1393 909 1345 664 1131 1249
- 1494 614 1129 1254 1416 804 1182 1169 1302 100 { m20} R 1631 1712 732 1088 985
- 1130 1209 1239 1472 1467 1258 1357 1007 1134 1067 1340 1440 1684 966 1233 1408
- 1734 1432 1488 850 1441 1400 1596 1430 1455 868 1152 935 1092 1556 1678 770
- 1232 1317 1370 989 1377 1510 1500 1458 1712 1470 1710 945 1324 609 1140 924
- 1290 1188 1899 802 1095 898 1189 1015 1473 1526 1557 907 1202 1528 1765 1454
- 1450 1047 1450 1278 1464 1606 1677 639 1209 808 1137 1455 1683 1427 1401 982
- 1362 805 1163 1505 1470 929 1091 1300 1493 972 1159 1266 1396 748 1154 683 1141
- 1341 1364 1395 1533 1489 1689 914 1103 772 1202 911 1135 1383 1561 813 1056 827
- 1079 1317 1823 1355 1739 1353 1416 721 1085 732 1120 1030 1417 1353 1588 1247
- 1269 806 1281 1156 1237 1314 1541 1433 1701 1140 1242 1488 1742 1079 1217 1225
- 1324 1284 1572 913 1184 1155 1331 1280 1578 1055 1320 893 1086 1066 1282 1587
- 1593 1322 1589 814 1165 586 1213 1254 1453 693 1342 1464 1640 1308 1658 803
- 1188 1465 1544 1475 1716 1290 1432 644 1167 624 1100 769 1186 808 1078 879 1223
- 100 { m20} R 781 1044 1462 1627 1089 1245 750 1133 1576 1733 1336 1339 986 1169
- 1257 1288 1327 1463 1697 1673 1171 1620 870 1068 1598 1602 1366 1433 953 1175
- 1022 1136 1038 1146 1403 1724 649 1130 1540 1680 1338 1546 1438 1586 880 1406
- 786 1148 1578 1637 1527 1682 911 1185 978 1226 1194 1416 1556 1729 656 1196
- 1504 1798 1424 1767 1147 1450 911 1223 1585 1548 752 1186 911 1334 1371 1498
- 1225 1485 1452 1558 763 1387 558 1242 1271 1628 816 1181 857 1114 739 1054 1359
- 1705 806 1185 747 1150 1423 1502 612 1355 1124 1205 1301 1508 823 1052 774 1082
- 1260 1337 1498 1681 849 1099 1403 1590 789 1077 993 1178 1446 1504 1187 1233
- 1132 1467 1227 1250 1589 1668 1474 1638 1113 1361 1307 1691 1285 1327 822 1071
- 1346 1470 790 1085 1503 1475 1550 1619 1198 1618 733 1343 1172 1418 1104 1638
- 1219 1441 1195 1258 798 1140 850 1374 1415 1727 796 1043 1414 1828 1176 1328
- 1324 1319 1398 1470 1319 1606 1390 1619 965 1271 1338 1565 1027 1170 1593 1691
- 1381 1415 862 1094 1518 1578 911 1141 100 { m20} R 1199 1448 988 1216 1483 1617
- 1107 1292 1303 1473 1419 1568 1212 1238 1207 1238 784 1144 1449 1558 1014 1192
- 1142 1290 680 1114 1082 1577 972 1289 889 1218 1244 1473 1526 1562 1141 1227
- 1250 1308 1130 1502 1005 1433 1502 1623 1048 1149 1113 1185 992 1163 1146 1312
- 1528 1634 618 1128 855 1137 1358 1477 1393 1738 1324 1407 1087 1164 713 1045
- 1327 1454 904 1242 1334 1550 802 1053 1107 1561 709 1067 1423 1410 950 1229 969
- 1194 1550 1752 791 1354 1150 1236 1512 1554 1333 1444 908 1098 918 1104 1361
- 1730 911 1121 1311 1309 1444 1917 661 1211 1588 1667 1081 1176 1424 1501 897
- 1109 1369 1430 750 1207 1247 1447 693 1420 1361 1530 1221 1352 1139 1241 733
- 1189 1479 1502 1234 1380 962 1104 766 1092 1086 1193 880 1234 888 1223 1021
- 1251 1158 1244 1424 1488 819 1195 1309 1532 1075 1175 1220 1365 1439 1633 1256
- 1418 1524 1613 1212 1259 858 1236 1257 1282 849 1062 1162 1332 1047 1154 740
- 1053 974 1208 1272 1341 527 1345 714 1067 1326 1334 1116 1199 1422 1408 1272
- 1466 100 { m20} R 1363 1468 1502 1721 1385 1412 897 1099 833 1127 1041 1141
- 1471 1756 641 1160 853 1140 871 1070 1066 1230 891 1136 1486 1538 1297 1407 931
- 1143 989 1275 952 1165 1039 1186 1271 1377 1602 1582 1225 1363 682 1106 1392
- 1500 1014 1128 636 1118 1294 1412 1436 1412 1063 1152 1301 1381 1134 1414 1393
- 1526 1632 1654 1263 1674 1473 1505 1425 1794 1385 1438 1283 1443 712 1185 737
- 1121 877 1492 1180 1309 781 1153 1326 1469 1527 1562 1198 1323 872 1175 1259
- 1366 1041 1206 1151 1325 764 1093 1591 1622 758 1383 1465 1743 1365 1658 1583
- 1627 1487 1663 1108 1255 1455 1652 782 1160 1121 1231 1542 1738 1420 1547 875
- 1345 1186 1349 1076 1274 1222 1334 1220 1500 886 1084 1600 1625 1186 1387 907
- 1110 1197 1296 1328 1605 809 1584 710 1038 689 1096 794 1163 1163 1261 731 1075
- 879 1092 1239 1833 928 1261 1024 1411 1338 1618 1425 1547 1008 1123 1633 1642
- 1308 1512 1477 1520 1360 1750 632 1093 890 1118 1148 1273 1334 1509 1467 1622
- 1412 1514 1474 1765 1463 1604 735 1138 1026 1204 100 { m20} R 759 1550 785 1296
- 1058 1199 1250 1310 1415 1543 703 1532 1450 1490 885 1095 1207 1295 1038 1149
- 942 1109 1497 1569 1092 1180 1618 1724 686 1225 983 1193 1506 1557 1245 1352
- 1309 1433 1253 1399 1441 1543 1611 1672 1240 1340 915 1180 1290 1454 1219 1703
- 1031 1216 1378 1459 762 1149 1197 1321 1227 1755 973 1385 1340 1510 1276 1579
- 730 1070 1106 1189 1362 1457 1267 1693 1129 1320 633 1198 573 1205 818 1738 727
- 1046 912 1111 1483 1512 1243 1282 1322 1726 624 1230 1640 1607 987 1317 1132
- 1538 476 1336 1337 1329 750 1034 1320 1789 1148 1242 624 1141 1271 1560 1413
- 1606 979 1118 1213 1419 1481 1710 1153 1266 980 1153 566 1283 904 1251 906 1201
- 865 1091 1419 1615 823 1142 1117 1205 947 1097 949 1159 830 1238 1322 1396 1177
- 1555 1280 1471 1068 1267 880 1133 1409 1675 1005 1238 900 1133 1316 1434 660
- 1469 1132 1210 678 1096 907 1306 836 1120 1390 1428 1199 1237 1067 1504 947
- 1341 1482 1490 685 1105 847 1198 1093 1174 1084 1551 1539 1575 975 1235 1206
- 1255 100 { m20} R 1607 1601 725 1079 1418 1663 682 1157 798 1062 686 1425 1512
- 1510 647 1307 1289 1383 970 1197 1493 1749 1473 1559 1319 1503 752 1064 1174
- 1669 1508 1689 1405 1541 728 1131 1015 1249 787 1160 602 1156 1674 1706 1213
- 1267 1291 1304 1520 1745 821 1097 1092 1167 1467 1710 859 1093 934 1285 738
- 1261 1015 1142 737 1266 1339 1371 1024 1505 1621 1674 1126 1226 1081 1210 1361
- 1570 1245 1456 1166 1221 713 1040 1121 1316 812 1085 941 1130 1454 1571 810
- 1049 1137 1231 763 1037 1449 1582 1503 1599 1269 1313 883 1157 1382 1497 1097
- 1271 1427 1809 1575 1621 744 1205 1609 1607 1230 1694 1310 1321 1464 1547 614
- 1329 1093 1291 1155 1312 1046 1143 858 1069 1480 1809 567 1399 768 1038 948
- 1226 1681 1692 1320 1653 935 1233 862 1066 1422 1818 1094 1181 752 1149 1185
- 1224 1524 1785 1506 1641 882 1269 789 1128 577 1147 739 1045 1264 1312 937 1140
- 678 1047 1556 1630 1114 1283 869 1147 897 1151 637 1124 1242 1386 834 1438 1062
- 1166 1185 1321 810 1205 827 1091 1439 1423 100 { m20} R 951 1162 1181 1328 473
- 1384 1334 1575 875 1296 871 1120 1576 1708 1005 1301 683 1047 642 1163 1054
- 1192 564 1267 1134 1485 1189 1708 1304 1431 1188 1228 958 1118 967 1107 1575
- 1569 1004 1122 1025 1285 1219 1569 1006 1213 1236 1611 688 1053 978 1122 1499
- 1598 1018 1460 691 1110 1519 1651 1418 1568 1715 1681 1277 1346 1218 1299 991
- 1125 823 1072 1442 1493 784 1048 1418 1406 690 1239 1026 1338 958 1172 1265
- 1376 1195 1369 885 1083 846 1143 1147 1313 1402 1542 48 { m20} R 1097 1303 846
- 1164 878 1139 1211 1332 1266 1277 1225 1374 752 1112 1263 1299 1523 1557 1219
- 1440 1462 1852 1589 1691 788 1049 1592 1704 1208 1352 1411 1537 781 1331 1371
- 1543 803 1237 838 1220 1358 1370 1153 1424 1333 2029 841 1287 696 1131 966 1245
- 1537 1666 800 1310 906 1080 1146 1227 1365 1432 932 1211 1611 1685 791 1104
- 1161 1271 1084 1392 916 1355 944 1139 1424 1569 914 1094 1624 1612 1368 1459
- 875 1224 955 1165 904 1080 1514 1649 1371 1536 1663 1703 1437 1493 991 1159 965
- 1145 1372 1509 906 1117 619 1326 1026 1365 1001 1275 1063 1157 647 1259 1062
- 1155 1302 1437 758 1136 1077 1441 1140 1347 1549 1541 601 1127 1386 1516 1161
- 1373 1431 1486 935 1173 803 1123 1057 1157 803 1104 1161 1265 1212 1495 994
- 1370 887 1126 697 1161 1666 1705 941 1097 1244 1567 975 1429 1304 1447 746 1040
- 674 1156 1367 1623 614 1136 820 1129 1402 1920 824 1100 966 1217 1080 1198 1221
- 1265 1014 1319 1364 1497 1178 1476 1006 1565 1511 1819 867 1098 748 1120 1092
- 1203 100 { m20} R 704 1145 1123 1586 1310 1393 1457 1729 981 1200 963 1153 609
- 1421 882 1293 1446 1587 753 1160 1044 1379 1461 1885 1500 1526 785 1128 812
- 1106 912 1296 1120 1246 1386 1502 1219 1257 1046 1205 1155 1283 1422 1406 978
- 1121 1235 1335 1017 1149 908 1102 1497 1781 663 1125 1549 1647 1309 1329 838
- 1080 1306 1556 841 1160 1034 1137 714 1079 1326 1373 1466 1522 740 1274 1486
- 1808 1443 1867 981 1112 1194 1296 776 1129 1255 1769 1278 1294 531 1277 676
- 1065 1324 1389 1301 1460 798 1155 794 1050 1533 1786 1217 1271 1192 1248 854
- 1357 642 1452 1061 1441 1303 1385 1286 1346 1485 1453 963 1228 1475 1726 1353
- 1412 1516 1691 1132 1397 1134 1196 1184 1425 1452 1681 1159 1304 613 1391 983
- 1418 1009 1380 996 1144 1409 1547 625 1152 991 1238 1021 1187 1586 1721 1201
- 1442 1032 1321 663 1203 1177 1230 1259 1380 914 1190 1202 1455 860 1210 1646
- 1709 671 1066 1470 1516 1064 1158 1097 1385 1384 1560 659 1136 1008 1375 946
- 1226 1352 1441 997 1452 661 1088 880 1100 821 1174 100 { m20} R 648 1091 1511
- 1705 845 1120 1217 1259 1647 1691 650 1511 1341 1349 898 1599 1380 1495 1201
- 1371 1306 1408 1149 1615 1302 1487 974 1251 860 1070 1091 1169 1412 1739 1422
- 1908 1570 1566 907 1118 604 1144 1164 1363 798 1066 728 1161 1560 1724 1540
- 1673 1391 1605 886 1210 576 1206 1365 1356 655 1215 1288 1486 1322 1388 1267
- 1484 1382 1637 1188 1527 1107 1204 1297 1324 1517 1480 1252 1389 815 1172 1293
- 1572 1334 1647 1424 1466 775 1069 835 1280 1613 1710 762 1035 1174 1489 1057
- 1602 732 1060 1204 1276 1217 1391 1253 1678 1027 1458 1022 1411 1392 1650 1381
- 1483 966 1129 1039 1275 1523 1642 1489 1590 803 1055 801 1410 1123 1246 1404
- 1466 966 1193 1011 1248 1474 1602 1104 1475 1618 1711 1105 1556 1005 1389 891
- 1318 655 1221 1143 1199 1040 1427 1193 1292 1418 1561 834 1160 1077 1468 803
- 1047 935 1143 679 1287 1253 1836 1598 1732 718 1138 1113 1239 868 1261 1454
- 1603 1194 1486 1007 1252 1410 1870 837 1072 1361 1576 941 1252 1072 1200 1182
- 1567 879 1076 1565 1758 100 { m20} R 1546 1648 1094 1233 1477 1796 1432 1448
- 949 1275 1331 1638 1359 1414 1044 1182 1373 1475 1039 1199 767 1114 821 1317
- 975 1218 1435 1791 1059 1223 1506 1723 1412 1675 1423 1623 1233 1276 1435 1674
- 1308 1309 1057 1487 683 1058 1069 1161 1057 1155 1078 1192 1492 1581 1216 1282
- 1146 1263 620 1333 1105 1216 1361 1603 1174 1318 1450 1437 1233 1375 915 1176
- 1230 1425 1458 1629 1128 1202 1523 1704 1501 1491 1182 1253 1183 1287 736 1174
- 1151 1238 616 1275 824 1400 717 1172 864 1106 921 1124 1188 1385 796 1138 714
- 1595 1437 1829 1287 1475 1590 1694 543 1252 1361 1550 899 1345 843 1196 963
- 1246 1365 1498 1022 1292 1643 1640 1224 1543 942 1317 1248 1520 756 1033 844
- 1168 770 1472 1624 1659 1097 1214 1088 1164 1565 1663 1466 1531 1219 1263 1151
- 1258 1318 1454 934 1092 1017 1219 995 1380 733 1221 1088 1269 884 1223 1352
- 1608 1076 1242 948 1282 749 1043 866 1439 725 1039 1392 1616 1208 1416 1306
- 1484 1515 1541 1375 1611 1302 1446 1435 1725 949 1203 1076 1486 1227 1317 100 {
- m20} R 1375 1424 1553 1617 1524 1592 737 1158 842 1151 1219 1293 1480 1498 842
- 1058 1346 1566 1366 1606 1115 1386 1398 1408 1422 1621 1138 1337 763 1059 1107
- 1403 1078 1545 1276 1585 767 1214 1373 1419 1266 1431 610 1143 1294 1445 954
- 1439 599 1203 761 1160 729 1105 1288 1822 786 1242 1316 1453 1356 1457 845 1059
- 634 1165 909 1084 662 1085 1399 1614 1426 1400 1218 1440 1460 1495 751 1260
- 1338 1405 1041 1147 1309 1323 889 1084 1515 1592 1524 1637 1494 1765 985 1145
- 1219 1294 792 1102 1429 1406 1224 1540 1309 1378 1358 1420 901 1102 614 1229
- 1213 1260 1178 1408 678 1065 1132 1355 828 1212 712 1057 1323 1640 1360 1504
- 1315 1452 804 1329 1560 1615 851 1280 1656 1708 880 1112 1419 1652 1005 1417
- 1385 1504 1155 1469 1339 1420 759 1037 1251 1307 966 1176 1267 1334 765 1164
- 1378 1607 581 1166 1187 1344 1522 1519 1197 1291 1241 1700 626 1105 877 1132
- 1418 1565 1506 1480 927 1108 1350 1716 1106 1248 833 1109 1097 1244 1007 1153
- 1366 1531 1216 1358 874 1553 931 1338 100 { m20} R 1521 1789 936 1273 1436 1853
- 1292 1294 1606 1703 829 1061 992 1120 754 1286 876 1186 870 1076 1303 1665 1082
- 1296 1446 1618 1341 1500 1532 1516 1153 1689 1204 1450 1365 1638 1775 1752 1189
- 1413 1234 1295 964 1303 1201 1438 866 1215 1184 1467 1382 1523 1217 1246 1484
- 1511 1370 1383 717 1169 1414 1487 1073 1298 772 1160 835 1203 1141 1239 1495
- 1491 1261 1431 769 1101 1224 1534 1053 1314 1324 1522 1429 1513 1370 1761 1390
- 1885 1040 1241 1529 1710 834 1069 1253 1599 1175 1242 1165 1248 1439 1416 1239
- 1522 928 1137 832 1097 986 1125 1232 1575 1330 1487 1389 1600 1628 1612 745
- 1136 1483 1622 790 1081 1102 1173 631 1099 962 1459 976 1189 1466 1542 748 1064
- 1133 1216 1519 1504 967 1191 1318 1493 1410 1651 1315 1375 1322 1541 1054 1678
- 1206 1249 1527 1685 1342 1518 1359 2097 1082 1388 1212 1272 846 1146 665 1127
- 1643 1690 1209 1601 1422 1415 849 1439 1275 1324 1318 1345 1287 1291 1487 1669
- 721 1167 802 1096 1573 1578 1562 1546 1116 1558 1453 1854 1310 1466 889 1565
- 100 { m20} R 662 1078 1118 1252 1388 1482 809 1145 1210 1308 1481 1466 1380
- 1515 990 1180 1126 1248 1382 1373 879 1070 802 1143 1262 1360 1140 1248 1406
- 1544 1493 1791 1396 1519 1038 1178 1618 1661 834 1145 778 1181 1452 1461 1505
- 1657 619 1099 1330 1511 1094 1223 751 1151 954 1178 820 1254 1221 1296 710 1047
- 1453 1813 1575 1697 1462 1599 1506 1607 1353 1610 1190 1259 1299 1540 1081 1583
- 724 1048 901 1082 1315 1346 689 1187 804 1046 1510 1500 1787 1764 1162 1225
- 1093 1461 1073 1277 825 1088 755 1143 772 1331 1559 1674 1284 1448 1135 1282
- 1097 1320 874 1089 958 1140 766 1135 1144 1198 624 1155 1306 1483 1066 1343
- 1599 1723 676 1397 1446 1847 1209 1405 638 1248 1564 1726 1085 1552 1461 1559
- 1465 1572 1497 1645 1296 1486 1392 1827 917 1159 1410 1499 1271 1322 1221 1253
- 1159 1221 955 1384 918 1208 958 1363 1162 1398 804 1206 897 1119 1230 1475 1056
- 1173 682 1103 1071 1237 697 1044 1163 1214 986 1252 951 1292 1027 1135 1008
- 1134 1218 1336 936 1479 829 1081 1340 1491 100 { m20} R 1191 1247 1175 1326
- 1220 1253 613 1203 1253 1343 1404 1408 1504 1824 938 1122 822 1134 1110 1178
- 915 1239 1411 1781 1286 1458 899 1211 1354 1423 1607 1721 694 1132 1145 1299
- 1510 1617 938 1242 910 1199 1332 1383 1465 1496 1381 1731 910 1155 1396 1401
- 1537 1640 1333 1391 782 1169 671 1150 885 1114 743 1187 920 1391 1345 1522 1053
- 1158 1416 1434 1518 1682 934 1338 1177 1465 815 1070 674 1094 1471 1765 1508
- 1815 1373 1389 640 1070 696 1070 1169 1561 1230 1261 881 1208 765 1084 972 1227
- 1563 1600 1185 1371 837 1166 1353 1393 629 1077 1168 1456 1220 1374 1227 1259
- 919 1199 1232 1499 1113 1205 822 1057 802 1193 1276 1465 974 1215 978 1140 835
- 1059 1090 1225 951 1098 490 1439 1200 1394 761 1111 1027 1528 1333 1438 827
- 1102 781 1071 1648 1620 1385 1463 600 1227 834 1318 1182 1232 864 1087 586 1125
- 722 1032 1385 1400 815 1057 706 1043 1456 1548 1552 1610 677 1087 1462 1546
- 1074 1327 1176 1354 1122 1233 1313 1497 966 1200 711 1115 1028 1166 1460 1721
- 100 { m20} R 1372 1413 1298 1352 1248 1470 1168 1271 1403 1421 681 1202 1079
- 1266 984 1325 1033 1138 1480 1489 744 1090 1059 1250 1499 1643 1062 1251 928
- 1098 817 1100 756 1118 986 1226 987 1131 1291 1335 1519 1482 969 1265 869 1088
- 1323 1658 1399 1515 1021 1342 1502 1567 1680 1694 1488 1744 1126 1186 1171 1476
- 1259 1275 997 1490 1281 1297 605 1140 1259 1273 643 1121 1082 1536 1339 1390
- 1089 1389 1425 1499 566 1254 1505 1469 1356 1420 1151 1239 1179 1225 1197 1301
- 908 1415 901 1118 911 1406 1221 1586 1391 1561 1565 1531 1325 1327 1607 1676
- 1020 1145 1233 1295 1380 1676 927 1214 948 1196 995 1132 1461 1539 805 1178 943
- 1282 785 1150 1087 1283 1457 1675 1633 1627 847 1277 1024 1259 1221 1371 1153
- 1234 1313 1462 1144 1273 1166 1274 841 1062 1584 1707 1023 1152 1348 1359 805
- 1316 1365 1570 945 1255 538 1418 843 1092 1457 1573 1386 1563 576 1189 1312
- 1340 946 1201 1550 1649 994 1259 1281 1327 1051 1480 1062 1406 1405 1532 748
- 1084 1079 1408 857 1135 773 1155 1412 1517 100 { m20} R 936 1103 1643 1703 775
- 1067 1220 1311 1302 1498 799 1045 1217 1285 600 1237 1471 1598 698 1042 1443
- 1537 1656 1645 1017 1166 956 1122 801 1061 913 1221 1400 1586 1112 1428 1556
- 1746 741 1084 720 1152 1390 1510 947 1144 1167 1420 549 1227 1181 1292 933 1110
- 1150 1215 1085 1227 1495 1768 1366 1502 1407 1470 709 1113 1128 1247 1574 1584
- 1031 1137 897 1104 1360 1356 828 1135 1474 1589 1001 1150 607 1141 1409 1555
- 725 1080 1154 1235 1040 1268 1390 1377 1389 1640 835 1148 1178 1238 1438 1664
- 843 1392 1329 1866 1048 1193 1218 1270 1145 1376 697 1255 1631 1617 679 1052
- 1345 1405 1283 1567 1056 1341 976 1132 952 1150 1202 1672 1062 1278 915 1202
- 1168 1216 793 1281 1472 1688 1045 1359 651 1229 1242 1267 1125 1359 1011 1337
- 924 1240 945 1097 1396 1489 820 1056 1307 1319 1083 1287 895 1105 756 1230 864
- 1265 714 1285 1067 1254 1372 1464 1210 1292 826 1083 989 1435 1089 1276 1189
- 1305 1550 1646 1530 1647 1363 1688 1475 1559 1224 1363 871 1068 1235 1572 1101
- 1602 100 { m20} R 768 1190 766 1035 977 1284 724 1042 1098 1191 1110 1210 1055
- 1187 858 1133 1106 1285 1079 1423 1467 1591 802 1050 704 1127 1036 1208 1395
- 1516 1190 1545 1237 1304 1473 1470 1634 1699 1275 1482 1603 1623 1524 1623 703
- 1049 1535 1636 650 1102 1276 1294 1295 1423 953 1136 1364 1595 1548 1675 690
- 1079 1297 1340 1371 1511 1542 1608 779 1166 986 1151 1118 1185 1472 1471 1566
- 1711 1130 1199 971 1215 1502 1584 1507 1694 1381 1421 1398 1476 863 1180 791
- 1223 1191 1225 1589 1576 1001 1312 1528 1777 1343 1755 1265 1384 914 1121 756
- 1046 800 1418 992 1142 878 1104 1215 1423 855 1078 1141 1338 1092 1194 834 1122
- 1038 1138 1535 1742 673 1361 1488 1662 1408 1498 1027 1247 1045 1365 915 1249
- 1438 1670 1267 1608 1333 1394 1235 1849 1531 1519 1605 1697 763 1202 1149 1201
- 1079 1245 1159 1291 1229 1427 573 1346 1190 1448 1091 1767 722 1107 1323 1847
- 1017 1232 809 1197 1308 1562 1348 1422 1118 1195 857 1112 1411 1524 1180 1446
- 1390 1554 1242 1358 1136 1280 1354 1611 1379 1631 100 { m20} R 718 1252 1103
- 1231 1072 1309 1069 1207 605 1223 927 1098 1091 1245 1053 1234 1688 1683 783
- 1331 1021 1139 1167 1312 1242 1426 923 1114 787 1246 1562 1551 1622 1669 996
- 1190 960 1430 1326 1499 780 1193 838 1080 1083 1229 1400 1513 1495 1683 599
- 1255 1252 1596 1333 1627 1103 1177 1595 1596 1652 1676 1094 1243 1204 1360 1100
- 1172 897 1407 1143 1297 1467 1620 851 1198 1039 1278 674 1264 1575 1697 1065
- 1348 1260 1360 1007 1156 735 1042 1380 1582 1012 1187 1320 1424 1374 1551 741
- 1106 1578 1746 806 1046 1200 1450 1152 1202 739 1277 1352 1553 1676 1704 758
- 1284 840 1552 582 1127 1067 1171 777 1257 1355 1433 631 1145 918 1162 1064 1278
- 1230 1365 846 1080 1312 1537 1198 1736 1082 1209 1318 1389 1306 1499 840 1061
- 587 1144 966 1219 673 1109 1394 1605 1572 1740 836 1075 949 1103 1175 1302 884
- 1253 1081 1374 1182 1331 993 1141 1166 1516 876 1148 1161 1222 758 1076 928
- 1211 786 1152 733 1161 1142 1513 1028 1268 706 1051 1241 1414 861 1091 977 1249
- 1382 1551 100 { m20} R 1164 1528 587 1264 1213 1304 795 1093 1076 1408 1193
- 1307 1016 1459 1181 1444 1133 1298 589 1128 989 1225 1547 1709 1161 1807 1411
- 1534 952 1250 1290 1356 1400 1654 888 1121 1250 1319 958 1336 1166 1459 690
- 1134 1193 1278 1525 1577 764 1253 1096 1296 667 1185 589 1191 1279 1527 619
- 1105 972 1605 649 1160 1074 1160 1482 1501 874 1195 1002 1499 1041 1167 1202
- 1393 1500 1646 1314 1831 1020 1139 1424 1449 1336 1331 609 1258 1079 1594 1468
- 1690 772 1193 1559 1749 1544 1613 983 1153 886 1260 1583 1593 847 1059 937 1282
- 1265 1463 650 1066 1406 1793 1556 1584 820 1119 1561 1669 1065 1618 1423 1503
- 1700 1678 687 1057 1324 1769 718 1189 861 1123 1217 1616 1099 1239 748 1110 938
- 1373 1045 1207 1487 1741 1561 1748 779 1143 1352 1377 1153 1219 1334 1437 851
- 1117 1292 1468 1525 1519 1363 1643 1313 1388 1375 1462 690 1172 1264 1579 1430
- 1436 1071 1220 1409 1575 1186 1323 767 1181 1178 1349 1363 1553 813 1077 1011
- 1281 1336 1424 646 1574 1545 1662 711 1137 1278 1286 100 { m20} R 1007 1147
- 1320 1606 1041 1195 1163 1628 1003 1131 750 1059 663 1081 828 1111 837 1216
- 1193 1398 1501 1555 1633 1649 782 1067 875 1094 1543 1527 1210 1530 1491 1822
- 573 1198 1464 1790 927 1288 1293 1398 919 1085 1325 1519 671 1127 1394 1749 651
- 1238 1150 1411 1095 1446 814 1135 641 1146 885 1174 927 1093 1381 1761 1269
- 1521 978 1148 1249 1411 1089 1395 1466 1584 1084 1486 1318 1373 899 1290 1305
- 1472 1261 1385 1123 1633 607 1140 1300 1616 876 1213 1108 1291 1220 1328 954
- 1212 1262 1488 1357 1667 594 1183 622 1164 834 1326 852 1116 1086 1410 1030
- 1216 1696 1673 532 1799 1516 1502 1081 1503 1262 1609 1231 1461 820 1092 1600
- 1730 796 1049 1085 1241 1490 1718 582 1141 932 1092 1274 1396 705 1050 1202
- 1286 1174 1365 1347 1917 805 1252 1200 1581 1476 1507 900 1113 1328 1389 1134
- 1555 1081 1269 1574 1583 1295 1400 1087 1409 877 1145 877 1098 1043 1364 848
- 1099 1547 1597 1458 1449 1125 1308 1052 1275 749 1171 1203 1355 527 1232 1683
- 1664 923 1350 692 1058 100 { m20} R 1278 1325 1094 1412 1624 1714 1017 1171
- 1001 1156 790 1042 1394 1608 689 1132 893 1140 796 1235 1400 1626 1428 1661
- 1487 1686 1127 1197 1044 1287 1367 1403 999 1147 979 1540 1329 1346 1321 1435
- 1612 1575 1624 1675 882 1077 1030 1385 806 1113 1095 1446 638 1589 1358 1567
- 971 1518 1050 1307 856 1289 1057 1270 1362 1469 1078 1289 1541 1709 1279 1310
- 1496 1528 1047 1264 1575 1682 1229 1554 1349 1890 931 1091 1145 1357 1439 1670
- 924 1127 1391 1665 1392 1539 1449 1572 892 1251 1158 1272 1075 1265 1234 1405
- 1180 1366 725 1087 1351 1954 1279 1487 945 1242 1349 1544 1522 1775 1071 1638
- 1025 1405 860 1066 854 1091 1174 1345 1280 1354 1347 1416 975 1143 1544 1505
- 927 1113 836 1293 852 1165 978 1198 858 1078 1465 1529 707 1143 1518 1618 1551
- 1669 1526 1683 702 1037 732 1223 1611 1722 929 1133 1352 1393 1118 1696 984
- 1188 1326 1654 1190 1424 791 1140 557 1285 772 1037 1379 1367 1484 1582 1112
- 1210 847 1073 960 1295 1412 1430 1005 1238 685 1061 734 1035 1607 1682 100 {
- m20} R 868 1067 780 1315 1314 1435 1617 1704 972 1361 978 1110 1088 1222 1088
- 1235 759 1214 818 1185 772 1122 1371 1647 926 1105 1263 1500 849 1279 1349 1545
- 845 1216 1124 1320 888 1073 1590 1645 1182 1463 915 1269 1321 1519 1411 1416
- 1265 1368 794 1279 1002 1169 1437 1478 1470 1516 1228 1323 653 1158 1470 1506
- 836 1141 685 1215 705 1159 1074 1249 1116 1239 1220 1371 1085 1216 1712 1691
- 1140 1267 1166 1358 891 1279 1473 1726 720 1239 925 1400 1220 1411 962 1594 791
- 1073 916 1121 1412 1499 796 1068 1585 1595 1082 1243 1092 1194 1104 1220 1367
- 1742 1233 1383 1130 1194 653 1173 1502 1691 780 1041 1137 1313 1011 1167 1011
- 1304 1324 1420 1318 1682 1017 1176 1183 1635 788 1193 985 1597 1186 1506 1003
- 1136 985 1158 1390 1684 1039 1284 1111 1195 1038 1218 1173 1249 990 1192 1033
- 1767 933 1200 767 1041 1261 1329 1160 1511 1157 1379 783 1040 817 1083 985 1186
- 889 1104 961 1171 1586 1642 1229 1355 1163 1265 685 1229 1397 1892 1446 1741
- 1284 1492 1001 1225 766 1097 100 { m20} R 800 1142 1333 1325 1538 1747 1153
- 1790 710 1043 1109 1485 1201 1429 1208 1658 1119 1414 1053 1255 1026 1279 983
- 1425 683 1158 1136 1384 1056 1323 1384 2044 950 1265 845 1196 1196 1325 623
- 1122 1165 1595 1017 1500 1446 1783 1364 1432 1404 1846 706 1144 930 1180 946
- 1172 1296 1544 1523 1587 773 1082 911 1716 671 1090 1291 1345 1390 1741 1143
- 1213 761 1066 716 1034 893 1191 933 1115 1605 1726 1474 1512 1037 1145 1301
- 1309 636 1131 1036 1166 1244 1676 1038 1209 922 1165 1129 1246 1138 1439 1392
- 1620 1510 1497 1660 1673 1483 1581 1368 1433 1326 1342 1021 1142 729 1203 543
- 1224 779 1172 1227 1628 1208 1329 822 1173 919 1126 1569 1737 1216 1301 874
- 1329 905 1222 727 1058 1264 1399 1371 1496 1204 1546 1127 1326 958 1212 753
- 1065 773 1147 747 1242 1527 1624 1145 1201 1100 1264 935 1167 936 1126 1432
- 1607 1268 1276 613 1101 1423 1397 1429 1423 680 1141 1240 1693 823 1078 1252
- 1385 838 1192 1221 1395 1295 1496 1439 1629 1051 1179 1285 1337 1096 1252 1533
- 1587 100 { m20} R 1176 1382 773 1100 1290 1660 766 1043 782 1048 1365 1777 1562
- 1618 1033 1258 1162 1426 1181 1365 970 1222 1178 1457 1163 1342 985 1270 1369
- 1477 699 1049 1548 1649 948 1392 1428 1747 1542 1675 1478 1465 716 1180 1389
- 1398 747 1303 1400 1560 1294 1391 932 1095 909 1152 888 1096 1100 1287 875 1171
- 1292 1360 1180 1283 906 1155 980 1404 1456 1644 1005 1197 1167 1479 1222 1614
- 1309 1612 900 1083 1445 1606 1341 1352 1170 1294 1036 1233 1229 1639 1217 1743
- 1164 1538 671 1098 1078 1232 841 1272 617 1284 1474 1655 1043 1173 1056 1167
- 1049 1192 687 1118 1233 1378 798 1093 729 1045 1237 1382 758 1113 1349 1561
- 1602 1678 1301 1360 1001 1141 733 1172 1076 1290 1287 1352 977 1192 1051 1764
- 1213 1358 615 1120 1215 1326 1209 1270 1059 1303 774 1374 846 1096 1091 1171
- 897 1174 1122 1346 828 1323 1329 1568 1279 1452 1153 1511 1103 1469 860 1179
- 1236 1373 1300 1421 630 1124 747 1321 874 1233 796 1330 1455 1710 1386 1489
- 1341 1553 1130 1188 1471 1619 1145 1221 883 1344 100 { m20} R 949 1304 1192
- 1263 581 1286 1526 1633 1020 1212 678 1066 1499 1757 1053 1180 694 1158 898
- 1188 1198 1258 1472 1791 1535 1672 1169 1309 773 1038 760 1108 1412 1462 770
- 1152 1207 1471 892 1365 1582 1706 732 1036 882 1257 1661 1695 1203 1254 771
- 1063 1340 1453 898 1078 859 1295 1511 1730 747 1069 1205 1447 632 1083 1381
- 1529 1375 1481 863 1255 1128 1442 1532 1741 1219 1341 1043 1299 798 1098 762
- 1196 1120 1299 1482 1641 1059 1172 666 1329 1104 1246 1192 1364 862 1168 1420
- 1579 591 1171 976 1503 826 1065 1098 1170 601 1121 727 1039 1510 1536 1296 1634
- 1212 1327 878 1173 1216 1381 570 1174 851 1336 1434 1422 1087 1434 822 1058 877
- 1224 1350 1435 767 1207 1392 1475 1321 1360 1123 1510 1522 1500 1020 1358 1542
- 1752 1177 1232 932 1096 1335 1374 1408 1808 1014 1350 873 1076 1404 1921 1045
- 1142 1519 1778 778 1254 912 1121 837 1069 911 1107 670 1466 1367 1451 1020 1189
- 1023 1207 708 1152 1360 1550 570 1219 875 1109 1032 1313 947 1145 682 1240 1451
- 1431 100 { m20} R 1073 1345 1175 1241 1331 1663 920 1225 1346 1617 782 1049
- 1136 1196 1052 1211 1154 1306 1468 1802 942 1181 1203 1234 1236 1669 937 1181
- 969 1231 973 1387 985 1375 1227 1493 676 1133 791 1056 1373 1373 1461 1520 1311
- 1442 1441 1668 1570 1718 1391 1518 1557 1570 1346 1477 1426 1474 1377 1607 933
- 1095 1378 1598 682 1045 1155 1495 1077 1392 1492 1843 1538 1500 970 1243 1147
- 1261 1256 1462 1273 1281 798 1176 1347 1340 829 1072 812 1232 1242 1305 896
- 1098 1498 1719 1664 1686 680 1078 1584 1686 902 1113 1533 1733 1189 1224 981
- 1197 1066 1224 843 1080 902 1136 1003 1208 1213 1326 1533 1668 659 1102 1343
- 1462 952 1185 917 1281 1498 1592 1422 1573 765 1042 1153 1325 980 1146 852 1156
- 1055 1165 890 1238 1165 1367 1569 1692 1510 1530 1393 1471 996 1337 1375 1591
- 804 1263 1482 1724 916 1166 1277 1426 1391 1460 1594 1626 1240 1546 1159 1296
- 666 1318 1486 1733 1444 1828 918 1177 816 1060 1189 1279 839 1151 1018 1134
- 1365 1791 947 1168 906 1103 1468 1650 745 1375 100 { m20} R 1110 1414 1134 1236
- 1116 1427 1596 1710 961 1308 1037 1526 1084 1239 949 1152 1228 1427 1248 1627
- 1457 1569 1386 1410 1133 1333 1400 1589 1248 1555 737 1272 1633 1700 1087 1396
- 837 1332 802 1178 1535 1548 1138 1220 1271 1295 1113 1246 799 1136 963 1366
- 1173 1484 1541 1605 1514 1736 1219 1272 1000 1140 603 1170 1384 1634 1052 1165
- 1331 1413 1002 1216 733 1037 1436 1522 1111 1192 1048 1544 1144 1337 1242 1596
- 1106 1178 900 1259 1256 1559 1239 1441 772 1109 1216 1483 48 { m20} R 963 1123
- 981 1201 1513 1620 1476 1807 819 1068 1496 1809 1003 1332 1228 1720 1238 1433
- 1039 1154 1539 1515 1262 1274 865 1103 1285 1448 1172 1422 1312 1467 1129 1248
- 1279 1505 810 1062 1309 1375 757 1034 1457 1888 1097 1501 1256 1286 1129 1189
- 1307 1307 1434 1618 1311 1538 896 1159 853 1119 1650 1651 733 1108 1003 1410
- 1342 1476 1293 1459 1301 1486 1478 1554 777 1149 1382 1507 1224 1375 782 1061
- 688 1327 713 1050 1066 1166 963 1196 1412 1608 1444 1829 1471 1572 1002 1419
- 1308 1792 908 1240 1045 1466 834 1089 1128 1263 895 1256 1205 1589 1536 1594
- 625 1090 1334 1665 1017 1130 1069 1160 1132 1217 1387 1519 750 1063 1387 1897
- 1533 1792 1065 1389 971 1174 1372 1406 796 1108 1647 1623 632 1102 822 1233
- 1505 1553 1529 1764 767 1219 1581 1689 901 1130 1376 1649 1348 1510 1475 1568
- 674 1160 983 1195 1022 1178 1084 1595 1425 1903 1582 1563 770 1305 1601 1722
- 1112 1267 979 1112 1230 1257 957 1405 1350 1527 809 1137 1312 1498 1085 1337
- 933 1186 1154 1477 1484 1575 100 { m20} R 617 1224 919 1272 1407 1579 1313 1691
- 789 1250 1548 1627 1443 1625 600 1204 796 1044 951 1191 1617 1598 1356 1547
- 1406 1477 852 1133 1099 1347 1501 1541 1522 1655 1509 1595 1592 1635 926 1088
- 1529 1521 1699 1696 1393 1393 1271 1371 835 1068 846 1136 1362 1771 700 1053
- 1112 1363 1528 1666 1185 1351 1186 1358 919 1097 727 1104 1024 1199 1198 1250
- 1543 1610 1586 1644 1114 1478 618 1294 604 1172 1021 1303 1414 1696 1514 1611
- 793 1177 732 1093 1084 1306 1535 1548 1573 1732 1392 1459 1483 1630 1067 1210
- 1170 1337 974 1254 1071 1473 1520 1799 1190 1328 892 1113 1316 1579 885 1239
- 670 1103 1636 1685 930 1131 1450 1460 810 1187 1069 1405 645 1201 842 1109 1576
- 1538 1330 1516 918 1085 1033 1277 1188 1461 1186 1302 1401 1648 652 1099 1337
- 1825 884 1155 1071 1226 1535 1738 1458 1608 1019 1193 1044 1565 1222 1334 1220
- 1817 741 1048 1455 1596 833 1084 1050 1144 1431 1565 605 1108 659 1159 1140
- 1487 836 1218 1210 1310 1548 1512 1194 1310 1026 1400 1097 1316 1205 1323 100 {
- m20} R 807 1047 1441 1498 1414 1422 942 1276 747 1138 1042 1159 916 1138 1334
- 1669 980 1113 1429 1403 930 1127 1518 1556 928 1474 737 1039 1495 1599 993 1205
- 1388 1817 1050 1144 1359 1520 1004 1245 1162 1615 1263 1344 1188 1465 892 1099
- 1016 1550 1386 1489 843 1153 927 1108 799 1179 1317 1530 1620 1638 1054 1546
- 1076 1290 1109 1253 850 1156 1214 1397 1319 1326 1055 1486 836 1138 1498 1742
- 1369 1663 865 1261 844 1278 1106 1289 1374 1631 1074 1157 709 1153 1223 1248
- 814 1120 926 1237 793 1098 1601 1651 1441 1445 1313 1486 1123 1290 867 1070
- 1536 1586 574 1172 1080 1220 722 1277 793 1207 762 1047 1191 1677 633 1193 1367
- 1539 917 1302 1233 1471 742 1116 1413 1392 1274 1450 691 1073 1417 1778 990
- 1136 826 1300 1394 1652 1048 1143 1239 1431 716 1118 873 1075 875 1101 1482
- 1798 1081 1255 1457 1512 911 1128 1030 1144 1458 1744 1250 1281 1344 1615 1149
- 1313 936 1128 1063 1211 1115 1365 890 1101 1185 1488 844 1100 1232 1258 1533
- 1769 1151 1398 1153 1385 980 1572 100 { m20} R 774 1094 1112 1465 1306 1460
- 1130 1388 796 1338 1177 1245 673 1210 492 1306 856 1082 872 1123 896 1081 721
- 1248 1308 1473 549 1214 1131 1263 665 1267 1279 1483 1225 1462 1010 1171 1186
- 1233 1036 1204 1020 1304 1428 1813 883 1300 1457 1539 1319 1398 1137 1337 773
- 1106 1444 1547 1322 1407 1212 1251 1358 1367 853 1229 1375 1616 1142 1312 1390
- 1603 964 1222 1100 1425 900 1096 1331 1344 908 1117 684 1130 753 1284 647 1120
- 1625 1595 687 1074 1505 1507 724 1310 785 1151 1507 1744 1024 1198 1628 1622
- 1092 1312 750 1037 1451 1639 1029 1228 1211 1466 1416 1530 683 1065 1667 1633
- 1242 1300 1535 1678 1064 1492 696 1255 1197 1573 1484 1530 1558 1551 1125 1189
- 1327 1692 823 1057 923 1217 1439 1544 882 1077 894 1085 1280 1513 723 1126 1152
- 1379 1328 1606 1299 1595 1433 1481 821 1089 1214 1447 859 1068 872 1069 693
- 1227 1193 1384 965 1212 1537 1648 1414 1506 1549 1717 1437 1606 772 1227 1311
- 1352 946 1157 763 1222 1446 1450 697 1077 1278 1340 551 1195 999 1263 100 { m20
-} R 871 1216 1190 1337 912 1140 1028 1691 1567 1664 1065 1236 678 1259 1425 1677
- 1128 1335 1095 1433 936 1347 761 1120 1407 1401 783 1254 738 1038 692 1058 652
- 1325 983 1159 915 1108 710 1195 1304 1548 1011 1139 833 1060 1331 1362 1348
- 1490 974 1221 1380 1414 595 1245 1002 1242 1106 1384 910 1157 776 1604 969 1446
- 1172 1313 1601 1584 1273 1384 1240 1257 961 1384 875 1090 1370 1730 988 1278
- 1333 1496 1370 1593 1464 1441 1322 1371 697 1169 1086 1199 1086 1464 1586 1663
- 795 1130 925 1088 842 1256 985 1275 1308 2186 1329 1587 1141 1502 1564 1587 935
- 1157 1458 1591 992 1272 854 1348 1279 1348 1481 1750 1527 1598 1035 1368 1465
- 1747 1514 1523 974 1123 1712 1711 1320 1444 1375 1765 999 1236 1109 1252 1335
- 1878 992 1229 668 1187 816 1081 1074 1275 796 1062 927 1104 1521 1559 598 1144
- 1549 1660 981 1154 1600 1706 1118 1415 1424 1439 1631 1607 1068 1505 1176 1562
- 1515 1705 749 1154 1387 1497 1077 1448 1124 1397 1033 1220 1055 1226 856 1162
- 1223 1316 1341 1442 100 { m20} R 1363 1415 1089 1234 871 1243 1361 1429 1240
- 1710 782 1464 1104 1314 789 1118 1105 1307 1116 1196 763 1151 968 1422 927 1176
- 1197 1319 958 1182 749 1052 558 1347 672 1158 1171 1327 608 1215 20 { m20} R
- 222 1180 m 651 -497 d s 873 683 m 994 Y s 222 2174 m 651 -497 d s 222 1180 m
- 994 Y s 873 683 m 1128 287 d s 2001 970 m 994 Y s 873 1677 m 1128 287 d s 873
- 1677 m cl s 873 683 m 1128 287 d s 967 673 m 34 Y s 991 696 m 17 Y s 1014 702 m
- 17 Y s 1038 708 m 17 Y s 1061 714 m 17 Y s 1085 703 m 34 Y s 1108 726 m 17 Y s
- 1132 732 m 17 Y s 1155 738 m 17 Y s 1179 744 m 17 Y s 1202 733 m 34 Y s 1226
- 756 m 16 Y s 1249 762 m 16 Y s 1273 768 m 16 Y s 1296 774 m 16 Y s 1320 763 m
- 33 Y s 1343 786 m 16 Y s 1367 792 m 16 Y s 1390 798 m 16 Y s 1413 804 m 16 Y s
- 1437 793 m 33 Y s 1460 816 m 16 Y s 1484 822 m 16 Y s 1507 828 m 16 Y s 1531
- 834 m 16 Y s 1554 823 m 33 Y s 1578 846 m 16 Y s 1601 851 m 17 Y s 1625 857 m
- 17 Y s 1648 863 m 17 Y s 1672 853 m 33 Y s 1695 875 m 17 Y s 1719 881 m 17 Y s
- 1742 887 m 17 Y s 1766 893 m 17 Y s 1789 883 m 33 Y s 1813 905 m 17 Y s 1836
- 911 m 17 Y s 1860 917 m 17 Y s 1883 923 m 17 Y s 1907 913 m 33 Y s 967 673 m 34
- Y s 944 684 m 17 Y s 920 678 m 17 Y s 897 672 m 17 Y s 873 666 m 17 Y s 1907
- 913 m 33 Y s 1930 935 m 17 Y s 1954 941 m 17 Y s 1977 947 m 17 Y s 2001 953 m
- 17 Y s 970 654 m -5 -1 d -3 -4 d -1 -8 d -4 Y 1 -8 d 3 -4 d 5 -2 d 3 X 4 2 d 3
- 4 d 1 8 d 4 Y -1 8 d -3 4 d -4 1 d -3 X cl s 1061 684 m -4 -1 d -3 -5 d -1 -7 d
- -4 Y 1 -8 d 3 -4 d 4 -2 d 3 X 5 2 d 3 4 d 1 8 d 4 Y -1 7 d -3 5 d -5 1 d -3 X
- cl s 1085 656 m -1 -1 d 1 -2 d 2 2 d -2 1 d cl s 1099 677 m 1 Y 1 3 d 1 2 d 3 1
- d 6 X 3 -1 d 2 -2 d 1 -3 d -3 Y -1 -2 d -3 -5 d -15 -15 d 21 X s 1144 684 m -14
- X -2 -13 d 2 2 d 4 1 d 5 X 4 -1 d 3 -3 d 1 -5 d -3 Y -1 -4 d -3 -3 d -4 -2 d -5
- X -4 2 d -2 1 d -1 3 d s 1190 714 m -5 -1 d -3 -5 d -1 -7 d -5 Y 1 -7 d 3 -4 d
- 5 -2 d 3 X 4 2 d 3 4 d 2 7 d 5 Y -2 7 d -3 5 d -4 1 d -3 X cl s 1214 686 m -2
- -1 d 2 -2 d 1 2 d -1 1 d cl s 1243 714 m -15 X -1 -13 d 1 1 d 5 2 d 4 X 5 -2 d
- 3 -3 d 1 -4 d -3 Y -1 -4 d -3 -3 d -5 -2 d -4 X -5 2 d -1 1 d -2 3 d s 1296 744
- m -4 -1 d -3 -5 d -2 -7 d -5 Y 2 -7 d 3 -4 d 4 -2 d 3 X 5 2 d 3 4 d 1 7 d 5 Y
- -1 7 d -3 5 d -5 1 d -3 X cl s 1320 716 m -1 -1 d 1 -2 d 2 2 d -2 1 d cl s 1353
- 744 m -15 -31 d s 1332 744 m 21 X s 1379 744 m -14 X -2 -13 d 2 1 d 4 2 d 4 X 5
- -2 d 3 -3 d 1 -4 d -3 Y -1 -5 d -3 -2 d -5 -2 d -4 X -4 2 d -2 1 d -1 3 d s
- 1435 768 m 3 2 d 4 4 d -31 Y s 1527 798 m 3 2 d 4 4 d -31 Y s 1555 776 m -2 -2
- d 2 -1 d 1 1 d -1 2 d cl s 1568 797 m 1 Y 2 3 d 1 1 d 3 2 d 6 X 3 -2 d 2 -1 d 1
- -3 d -3 Y -1 -3 d -3 -4 d -15 -15 d 21 X s 1614 804 m -15 X -1 -13 d 1 1 d 5 2
- d 4 X 5 -2 d 3 -3 d 1 -4 d -3 Y -1 -5 d -3 -3 d -5 -1 d -4 X -5 1 d -1 2 d -2 3
- d s 1655 828 m 3 1 d 5 5 d -31 Y s 1683 806 m -1 -2 d 1 -1 d 2 1 d -2 2 d cl s
- 1713 834 m -15 X -1 -13 d 1 1 d 5 1 d 4 X 5 -1 d 3 -3 d 1 -4 d -3 Y -1 -5 d -3
- -3 d -5 -1 d -4 X -5 1 d -1 2 d -2 3 d s 1762 858 m 3 1 d 4 5 d -31 Y s 1790
- 836 m -2 -2 d 2 -1 d 1 1 d -1 2 d cl s 1822 864 m -14 -31 d s 1802 864 m 20 X s
- 1849 864 m -15 X -1 -14 d 1 2 d 5 1 d 4 X 5 -1 d 3 -3 d 1 -5 d -2 Y -1 -5 d -3
- -3 d -5 -1 d -4 X -5 1 d -1 2 d -2 3 d s 1902 886 m 2 Y 1 3 d 2 1 d 3 2 d 6 X 3
- -2 d 1 -1 d 1 -3 d -3 Y -1 -3 d -3 -5 d -15 -14 d 21 X s 873 683 m -651 497 d s
- 873 649 m 34 Y s 857 679 m 16 Y s 841 691 m 17 Y s 824 703 m 17 Y s 808 716 m
- 17 Y s 792 712 m 33 Y s 776 741 m 16 Y s 759 753 m 17 Y s 743 766 m 16 Y s 727
- 778 m 17 Y s 711 774 m 33 Y s 694 803 m 17 Y s 678 815 m 17 Y s 662 828 m 16 Y
- s 645 840 m 17 Y s 629 836 m 33 Y s 613 865 m 17 Y s 597 877 m 17 Y s 580 890 m
- 17 Y s 564 902 m 17 Y s 548 898 m 33 Y s 532 927 m 17 Y s 515 940 m 16 Y s 499
- 952 m 17 Y s 483 964 m 17 Y s 466 960 m 33 Y s 450 989 m 17 Y s 434 1002 m 16 Y
- s 418 1014 m 17 Y s 401 1027 m 16 Y s 385 1022 m 34 Y s 369 1051 m 17 Y s 352
- 1064 m 16 Y s 336 1076 m 17 Y s 320 1089 m 16 Y s 304 1084 m 34 Y s 287 1114 m
- 16 Y s 271 1126 m 17 Y s 255 1138 m 17 Y s 239 1151 m 16 Y s 222 1147 m 33 Y s
- 222 1147 m 33 Y s 826 573 m 27 X s 865 583 m 2 Y 1 3 d 2 1 d 3 2 d 6 X 3 -2 d 1
- -1 d 2 -3 d -3 Y -2 -3 d -3 -5 d -15 -15 d 21 X s 704 635 m 26 X s 745 647 m 3
- 1 d 5 5 d -31 Y s 773 625 m -1 -2 d 1 -1 d 2 1 d -2 2 d cl s 803 653 m -15 X -1
- -14 d 1 2 d 5 1 d 4 X 5 -1 d 2 -3 d 2 -5 d -3 Y -2 -4 d -2 -3 d -5 -1 d -4 X -5
- 1 d -1 2 d -2 2 d s 663 697 m 27 X s 705 709 m 3 1 d 4 5 d -31 Y s 541 759 m 27
- X s 587 777 m -5 -2 d -2 -4 d -2 -7 d -5 Y 2 -7 d 2 -5 d 5 -1 d 3 X 4 1 d 3 5 d
- 2 7 d 5 Y -2 7 d -3 4 d -4 2 d -3 X cl s 611 749 m -2 -2 d 2 -1 d 1 1 d -1 2 d
- cl s 640 777 m -15 X -1 -13 d 1 1 d 5 2 d 4 X 5 -2 d 3 -3 d 1 -4 d -3 Y -1 -5 d
- -3 -3 d -5 -1 d -4 X -5 1 d -1 2 d -2 3 d s 537 839 m -5 -1 d -3 -5 d -1 -7 d
- -5 Y 1 -7 d 3 -5 d 5 -1 d 3 X 4 1 d 3 5 d 2 7 d 5 Y -2 7 d -3 5 d -4 1 d -3 X
- cl s 414 901 m -4 -1 d -3 -5 d -2 -7 d -5 Y 2 -7 d 3 -4 d 4 -2 d 3 X 5 2 d 3 4
- d 1 7 d 5 Y -1 7 d -3 5 d -5 1 d -3 X cl s 438 873 m -1 -1 d 1 -2 d 2 2 d -2 1
- d cl s 468 901 m -15 X -2 -13 d 2 1 d 4 2 d 5 X 4 -2 d 3 -3 d 2 -4 d -3 Y -2 -4
- d -3 -3 d -4 -2 d -5 X -4 2 d -2 1 d -1 3 d s 370 957 m 3 2 d 4 4 d -31 Y s 247
- 1020 m 3 1 d 5 5 d -32 Y s 275 997 m -1 -1 d 1 -2 d 2 2 d -2 1 d cl s 305 1026
- m -15 X -1 -14 d 1 2 d 5 1 d 4 X 4 -1 d 3 -3 d 2 -5 d -3 Y -2 -4 d -3 -3 d -4
- -2 d -4 X -5 2 d -1 1 d -2 3 d s 204 1080 m 2 Y 1 3 d 2 1 d 3 2 d 6 X 3 -2 d 1
- -1 d 2 -3 d -3 Y -2 -3 d -3 -5 d -15 -14 d 21 X s 222 1180 m 994 Y s 189 1180 m
- 33 X s 206 1202 m 16 X s 206 1224 m 16 X s 206 1246 m 16 X s 206 1268 m 16 X s
- 189 1290 m 33 X s 206 1312 m 16 X s 206 1335 m 16 X s 206 1357 m 16 X s 206
- 1379 m 16 X s 189 1401 m 33 X s 206 1423 m 16 X s 206 1445 m 16 X s 206 1467 m
- 16 X s 206 1489 m 16 X s 189 1511 m 33 X s 206 1533 m 16 X s 206 1556 m 16 X s
- 206 1578 m 16 X s 206 1600 m 16 X s 189 1622 m 33 X s 206 1644 m 16 X s 206
- 1666 m 16 X s 206 1688 m 16 X s 206 1710 m 16 X s 189 1732 m 33 X s 206 1754 m
- 16 X s 206 1776 m 16 X s 206 1799 m 16 X s 206 1821 m 16 X s 189 1843 m 33 X s
- 206 1865 m 16 X s 206 1887 m 16 X s 206 1909 m 16 X s 206 1931 m 16 X s 189
- 1953 m 33 X s 206 1975 m 16 X s 206 1997 m 16 X s 206 2020 m 16 X s 206 2042 m
- 16 X s 189 2064 m 33 X s 206 2086 m 16 X s 206 2108 m 16 X s 206 2130 m 16 X s
- 206 2152 m 16 X s 189 2174 m 33 X s 104 1178 m 27 X s 146 1190 m 3 1 d 4 4 d
- -31 Y s 150 1306 m -4 -2 d -3 -4 d -1 -7 d -5 Y 1 -7 d 3 -5 d 4 -1 d 3 X 5 1 d
- 3 5 d 1 7 d 5 Y -1 7 d -3 4 d -5 2 d -3 X cl s 146 1411 m 3 1 d 4 4 d -31 Y s
- 143 1519 m 2 Y 1 3 d 2 1 d 3 2 d 6 X 3 -2 d 1 -1 d 2 -3 d -3 Y -2 -3 d -3 -4 d
- -14 -15 d 20 X s 144 1637 m 17 X -9 -11 d 4 X 3 -2 d 2 -1 d 1 -5 d -3 Y -1 -4 d
- -3 -3 d -5 -2 d -4 X -5 2 d -1 1 d -1 3 d s 156 1748 m -14 -21 d 22 X s 156
- 1748 m -31 Y s 159 1858 m -15 X -1 -13 d 1 1 d 5 2 d 4 X 5 -2 d 3 -2 d 1 -5 d
- -3 Y -1 -4 d -3 -3 d -5 -2 d -4 X -5 2 d -1 1 d -1 3 d s 161 1964 m -2 3 d -4 2
- d -3 X -5 -2 d -3 -4 d -1 -8 d -7 Y 1 -6 d 3 -3 d 5 -1 d 1 X 5 1 d 3 3 d 1 5 d
- 1 Y -1 5 d -3 2 d -5 2 d -1 X -5 -2 d -3 -2 d -1 -5 d s 162 2079 m -15 -31 d s
- 142 2079 m 20 X s 149 2190 m -5 -2 d -1 -3 d -3 Y 1 -3 d 3 -1 d 6 -2 d 5 -1 d 3
- -3 d 1 -3 d -4 Y -1 -3 d -2 -2 d -4 -1 d -6 X -5 1 d -1 2 d -1 3 d 4 Y 1 3 d 3
- 3 d 4 1 d 6 2 d 3 1 d 2 3 d 3 Y -2 3 d -4 2 d -6 X cl s gr
-showpage
- gr
-%%Trailer
-%%Pages: 1
- gr gr
-%%EOF
diff --git a/src/pawlib/paw/testsuite/paw.commands/nt_pl_3d_2.ref.ps b/src/pawlib/paw/testsuite/paw.commands/nt_pl_3d_2.ref.ps
deleted file mode 100644
index a7f8d79..0000000
--- a/src/pawlib/paw/testsuite/paw.commands/nt_pl_3d_2.ref.ps
+++ /dev/null
@@ -1,3063 +0,0 @@
-%!PS-Adobe-2.0
-%%Title: /disk3/maartenb/cerncvs/paw/testsuite/tmp/nt_pl_3d_ (Portrait A 4)
-%%Pages: (atend)
-%%Creator: HIGZ Version 1.23/06
-%%CreationDate: 96/04/16 16.05
-%%EndComments
-%%BeginProlog
-/s {stroke} def /l {lineto} def /m {moveto} def /t {translate} def
-/sw {stringwidth} def /r {rotate} def /rl {roll} def /R {repeat} def
-/d {rlineto} def /rm {rmoveto} def /gr {grestore} def /f {eofill} def
-/c {setrgbcolor} def /lw {setlinewidth} def /sd {setdash} def
-/cl {closepath} def /sf {scalefont setfont} def /black {0 setgray} def
-/box {m dup 0 exch d exch 0 d 0 exch neg d cl} def
-/NC{systemdict begin initclip end}def/C{NC box clip newpath}def
-/bl {box s} def /bf {box f} def /Y { 0 exch d} def /X { 0 d} def
-/mp {newpath /y exch def /x exch def} def
-/side {[w .77 mul w .23 mul] .385 w mul sd w 0 l currentpoint t -144 r} def
-/mr {mp x y w2 0 360 arc} def /m24 {mr s} def /m20 {mr f} def
-/mb {mp x y w2 add m w2 neg 0 d 0 w neg d w 0 d 0 w d cl} def
-/mt {mp x y w2 add m w2 neg w neg d w 0 d cl} def
-/m21 {mb f} def /m25 {mb s} def /m22 {mt f} def /m26 {mt s} def
-/m23 {mp x y w2 sub m w2 w d w neg 0 d cl f} def
-/m27 {mp x y w2 add m w3 neg w2 neg d w3 w2 neg d w3 w2 d cl s} def
-/m28 {mp x w2 sub y w2 sub w3 add m w3 0 d 0 w3 neg d w3 0 d 0 w3 d w3 0 d
- 0 w3 d w3 neg 0 d 0 w3 d w3 neg 0 d
- 0 w3 neg d w3 neg 0 d cl s } def
-/m29 {mp gsave x w2 sub y w2 add w3 sub m currentpoint t
- 4 {side} repeat cl fill gr} def
-/m30 {mp gsave x w2 sub y w2 add w3 sub m currentpoint t
- 5 {side} repeat s gr} def
-/m31 {mp x y w2 sub m 0 w d x w2 sub y m w 0 d
- x w2 sub y w2 add m w w neg d x w2 sub y w2
- sub m w w d s} def
-/m2 {mp x y w2 sub m 0 w d x w2 sub y m w 0 d s} def
-/m5 {mp x w2 sub y w2 sub m w w d x w2 sub y w2 add m w w neg d s} def
-/DP {/PT exch def gsave 47.2 47.2 scale PT 1 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < AA AA 55 55 AA AA 55 55 AA AA 55 55 AA AA 55 55 AA AA 55 55 AA AA 55 55
-AA AA 55 55 AA AA 55 55 > } image } if PT 2 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < BB BB EE EE BB BB EE EE BB BB EE EE BB BB EE EE BB BB EE EE BB BB EE EE
-BB BB EE EE BB BB EE EE > } image } if PT 3 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < FF FF BB BB FF FF EE EE FF FF BB BB FF FF EE EE FF FF BB BB FF FF EE EE
-FF FF BB BB FF FF EE EE > } image } if PT 4 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < DF DF BF BF 7F 7F FE FE FD FD FB FB F7 F7 EF EF DF DF BF BF 7F 7F FE FE
-FD FD FB FB F7 F7 EF EF > } image } if PT 5 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < 7F 7F BF B F DF DF EF EF F7 F7 FB FB FD FD FE FE 7F 7F BF BF DF DF EF
-EF F7 F7 FB FB FD FD FE FE > } image } if PT 6 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB
-BB BB BB BB BB BB BB BB BB > } image } if PT 7 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < FF FF FF FF FF FF 00 00 FF FF FF FF FF FF 00 00 FF FF FF FF FF FF 00
-00 FF FF FF FF FF FF 00 00 > } image } if PT 8 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < EE EE 47 47 83 83 C5 C5 EE EE 5C 5C 38 38 74 74 EE EE 47 47 83 83 C5
-C5 EE EE 5C 5C 38 38 74 74 > } image } if PT 9 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < EF EF EF EF D7 D7 38 38 FE FE FE FE 7D 7D 83 83 EF EF EF EF D7 D7 38
-38 FE FE FE FE 7D 7D 83 83 > } image } if PT 10 eq { 16 16 1 [ 16 0 0 16 neg
-0 16 ] { < EF EF EF EF EF EF 00 00 FE FE FE FE FE FE 00 00 EF EF EF EF EF EF
-00 00 FE FE FE FE FE FE 00 00 > } image } if PT 11 eq { 16 16 1 [ 16 0 0 16
-neg 0 16 ] { < F7 F7 B6 B6 D5 D5 E3 E3 D5 D5 B6 B6 F7 F7 FF FF 7F 7F 6B 6B 5D
-5D 3E 3E 5D 5D 6B 6B 7F 7F FF FF > } image } if PT 12 eq { 16 16 1 [ 16 0 0
-16 neg 0 16 ] { < E3 E3 DD DD BE BE BE BE BE BE DD DD E3 E3 FF FF 3E 3E DD DD
-EB EB EB EB EB EB DD DD 3E 3E FF FF > } image } if PT 13 eq { 16 16 1 [ 16 0
-0 16 neg 0 16 ] { < FE FE 7D 7D BB BB D7 D7 EF EF D7 D7 BB BB 7D 7D FE FE 7D
-7D BB BB D7 D7 EF EF D7 D7 BB BB 7D 7D > } image } if PT 14 eq { 16 16 1 [ 16
-0 0 16 neg 0 16 ] { < 00 00 EE EF EE EF EE EF 0E E0 EE EE EE EE EE EE 00 EE
-FE EE FE EE FE EE 00 00 FE EF FE EF FE EF > } image } if PT 15 eq { 16 16 1 [
-16 0 0 16 neg 0 16 ] { < DD DD AA AA DD DD FF FF 77 77 AA AA 77 77 FF FF DD
-DD AA AA DD DD FF FF 77 77 AA AA 77 77 FF FF > } image } if PT 16 eq { 16 16
-1 [ 16 0 0 16 neg 0 16 ] { < F1 F1 EE EE 1F 1F FF FF F1 F1 EE EE 1F 1F FF FF
-F1 F1 EE EE 1F 1F FF FF F1 F1 EE EE 1F 1F FF FF > } image } if PT 17 eq { 16
-16 1 [ 16 0 0 16 neg 0 16 ] { < EE EE DD DD BB BB FF FF EE EE DD DD BB BB FF
- FF EE EE DD DD BB BB FF FF EE EE DD DD BB BB FF FF > } image } if PT 18 eq {
-16 16 1 [ 16 0 0 16 neg 0 16 ] { < BB BB DD DD EE EE FF FF BB BB DD DD EE EE
-FF FF BB BB DD DD EE EE FF FF BB BB DD DD EE EE FF FF > } image } if PT 19 eq
-{ 16 16 1 [ 16 0 0 16 neg 0 16 ] { < 1F FC 67 F3 7B EF BD DE BD DE DE BD E6
-B3 F8 0F E6 B3 DE BD BD DE BD DE 7B EF 67 F3 1F FC 7F FF > } image } if PT
-20 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < DD DD EE EE EE EE EE EE DD DD BB
-BB BB BB BB BB DD DD EE EE EE EE EE EE DD DD BB BB BB BB BB BB > } image }
-if PT 21 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < 0E 0E EF EF EF EF EF EF E0
-E0 FE FE FE FE FE FE 0E 0E EF EF EF EF EF EF E0 E0 FE FE FE FE FE FE > }
-image } if PT 22 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < 70 70 F7 F7 F7 F7 F7
-F7 07 07 7F 7F 7F 7F 7F 7F 70 70 F7 F7 F7 F7 F7 F7 07 07 7F 7F 7F 7F 7F 7F >
-} image } if PT 23 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < AA AA 55 55 A9 A9
-D1 D1 E1 E1 D1 D1 A9 A9 55 55 AA AA 55 55 A9 A9 D1 D1 E1 E1 D1 D1 A9 A9 55 55
-> } image } if PT 24 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < FF FE FF FC EA
-A8 D5 54 EA A8 D5 54 E8 28 D4 54 E8 E8 D4 D4 E8 EA 54 D5 A8 EA 54 D5 00 C0 00
-80 > } image } if PT 25 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < FF FE FF FC
-FF F8 FF F0 F0 00 F0 00 F0 20 F0 60 F0 E0 F1 E0 F3 E0 F0 00 E0 00 C0 00 80 00
-00 00 > } image } if gr } def /FA { /PT exch def gsave clip 0 0 translate 1 1
-54 { 1 sub 47.2 mul /Xcurr exch def 1 1 74 { 1 sub 47.2 mul /Ycurr exch def
-gsave Xcurr Ycurr translate PT DP gr } for } for gr } def
-/reencdict 24 dict def /ReEncode {reencdict begin /nco&na exch def
-/nfnam exch def /basefontname exch def /basefontdict basefontname findfont def
-/newfont basefontdict maxlength dict def basefontdict {exch dup /FID ne
-{dup /Encoding eq {exch dup length array copy newfont 3 1 roll put} {exch
-newfont 3 1 roll put} ifelse} {pop pop} ifelse } forall newfont
-/FontName nfnam put nco&na aload pop nco&na length 2 idiv {newfont
-/Encoding get 3 1 roll put} repeat nfnam newfont definefont pop end } def
-/accvec [ 176 /agrave 181 /Agrave 190 /acircumflex 192 /Acircumflex
-201 /adieresis 204 /Adieresis 209 /ccedilla 210 /Ccedilla 211 /eacute
-212 /Eacute 213 /egrave 214 /Egrave 215 /ecircumflex 216 /Ecircumflex
-217 /edieresis 218 /Edieresis 219 /icircumflex 220 /Icircumflex
-221 /idieresis 222 /Idieresis 223 /ntilde 224 /Ntilde 226 /ocircumflex
-228 /Ocircumflex 229 /odieresis 230 /Odieresis 231 /ucircumflex 236 /Ucircumflex
-237 /udieresis 238 /Udieresis 239 /aring 242 /Aring 243 /ydieresis
-244 /Ydieresis 246 /aacute 247 /Aacute 252 /ugrave 253 /Ugrave] def
-/Times-Roman /Times-Roman accvec ReEncode
-/Times-Italic /Times-Italic accvec ReEncode
-/Times-Bold /Times-Bold accvec ReEncode
-/Times-BoldItalic /Times-BoldItalic accvec ReEncode
-/Helvetica /Helvetica accvec ReEncode
-/Helvetica-Oblique /Helvetica-Oblique accvec ReEncode
-/Helvetica-Bold /Helvetica-Bold accvec ReEncode
-/Helvetica-BoldOblique /Helvetica-BoldOblique accvec ReEncode
-/Courier /Courier accvec ReEncode
-/Courier-Oblique /Courier-Oblique accvec ReEncode
-/Courier-Bold /Courier-Bold accvec ReEncode
-/Courier-BoldOblique /Courier-BoldOblique accvec ReEncode
-/oshow {gsave [] 0 sd true charpath stroke gr} def
-/stwn { /fs exch def /fn exch def /text exch def fn findfont fs sf
- text sw pop xs add /xs exch def} def
-/stwb { /fs exch def /fn exch def /nbas exch def /textf exch def
-textf length /tlen exch def nbas tlen gt {/nbas tlen def} if
-fn findfont fs sf textf dup length nbas sub nbas getinterval sw
-pop neg xs add /xs exch def} def
-/accspe [ 65 /plusminus 66 /bar 67 /existential 68 /universal
-69 /exclam 70 /numbersign 71 /greater 72 /question 73 /integral
-74 /colon 75 /semicolon 76 /less 77 /bracketleft 78 /bracketright
-79 /greaterequal 80 /braceleft 81 /braceright 82 /radical
-83 /spade 84 /heart 85 /diamond 86 /club 87 /lessequal
-88 /multiply 89 /percent 90 /infinity 48 /circlemultiply 49 /circleplus
-50 /emptyset 51 /lozenge 52 /bullet 53 /arrowright 54 /arrowup
-55 /arrowleft 56 /arrowdown 57 /arrowboth 48 /degree 44 /comma 43 /plus
- 45 /angle 42 /angleleft 47 /divide 61 /notequal 40 /equivalence 41 /second
- 97 /approxequal 98 /congruent 99 /perpendicular 100 /partialdiff 101 /florin
- 102 /intersection 103 /union 104 /propersuperset 105 /reflexsuperset
- 106 /notsubset 107 /propersubset 108 /reflexsubset 109 /element 110 /notelement
- 111 /gradient 112 /logicaland 113 /logicalor 114 /arrowdblboth
- 115 /arrowdblleft 116 /arrowdblup 117 /arrowdblright 118 /arrowdbldown
- 119 /ampersand 120 /omega1 121 /similar 122 /aleph ] def
-/Symbol /Special accspe ReEncode
-/Zone {/iy exch def /ix exch def ix 1 sub 2224 mul 1 iy sub 3144
- mul t} def
-%%EndProlog
- gsave 20 28 t .25 .25 scale gsave
-%%Page: number 1
- gsave
- 1 1 Zone
- gsave 0 0 t black [] 0 sd 1 lw 2223 2224 0 460 bl 2223 2224 0 460 C 1779 1778
- 222 683 C NC [4 8] 0 sd 222 1212 m 1128 287 d s 222 1378 m 1128 287 d s 222
- 1543 m 1128 287 d s 222 1709 m 1128 287 d s 222 1875 m 1128 287 d s 222 2041 m
- 1128 287 d s [] 0 sd 222 1180 m 1128 287 d s 1350 1467 m 994 Y s 222 2174 m
- 1128 287 d s 222 1180 m 994 Y s [4 8] 0 sd 1350 1499 m 651 -497 d s 1350 1665 m
- 651 -497 d s 1350 1830 m 651 -497 d s 1350 1996 m 651 -497 d s 1350 2162 m 651
- -497 d s 1350 2328 m 651 -498 d s [] 0 sd 1350 1467 m 651 -497 d s 2001 970 m
- 994 Y s 1350 2461 m 651 -497 d s 1350 1467 m cl s 994 539 m -16 -21 d s 978 539
- m 16 X s 978 518 m 16 X s 1015 549 m 12 -31 d s 1039 549 m -12 -31 d s 1066 545
- m -3 3 d -5 1 d -6 X -4 -1 d -3 -3 d -3 Y 1 -3 d 2 -1 d 3 -2 d 9 -3 d 3 -1 d 1
- -2 d 2 -3 d -4 Y -3 -3 d -5 -2 d -6 X -4 2 d -3 3 d s 1077 521 m -1 -1 d 1 -2 d
- 2 2 d -2 1 d cl s 1103 539 m 9 -21 d s 1120 539 m -8 -21 d -3 -6 d -3 -3 d -3
- -1 d -2 X s 1140 549 m 12 -31 d s 1163 549 m -11 -31 d s 1190 545 m -3 3 d -4 1
- d -6 X -5 -1 d -3 -3 d -3 Y 2 -3 d 1 -1 d 3 -2 d 9 -3 d 3 -1 d 2 -2 d 1 -3 d -4
- Y -3 -3 d -4 -2 d -6 X -5 2 d -3 3 d s 1202 521 m -2 -1 d 2 -2 d 1 2 d -1 1 d
- cl s 1229 539 m 16 -21 d s 1245 539 m -16 -21 d s /w 2
- def /w2 {w 2 div} def /w3 {w 3 div} def 2870 -4182 7817 -2849 7889 -2702 7846
- -2785 1505 2171 1046 1806 7730 -2978 1391 1571 1337 2049 1592 2059 1349 2165
- 7904 -2658 7712 -2898 7781 -2870 1419 2311 7867 -2743 1554 1972 7775 -2890 7756
- -2971 7449 -3204 7870 -2741 7158 -3265 1668 1907 846 1800 7332 -2987 1366 1725
- 7907 -2667 1505 2087 7902 -2674 1301 2116 7866 -2742 1159 1507 7669 -3016 7394
- -3701 1240 1874 7876 -2717 7773 -2787 1379 1945 1406 2051 7763 -2864 7758 -2877
- 7892 -2692 1200 2020 7465 -3480 7538 -3193 7736 -3008 1302 2049 7852 -2739 7789
- -2868 1511 2220 7707 -2964 1327 1991 7887 -2698 1387 2249 1495 2212 1202 2006
- 7708 -2972 1360 2041 7645 -3186 7882 -2717 7865 -2722 1544 2165 7857 -2757 1233
- 2169 1076 1581 7813 -2852 7903 -2674 1424 2267 1365 1912 1399 2056 1152 1445
- 1412 2003 7786 -2886 1245 1920 7470 -3174 7882 -2709 1628 2056 7675 -3019 1693
- 2059 1442 2019 1076 1669 1467 1904 7885 -2682 1442 2234 7808 -2854 1177 1686
- 1406 2256 7782 -2862 7900 -2682 7778 -2909 1546 2143 7835 -2807 7576 -3252 7830
- -2796 1209 2049 1170 1398 1443 2233 7614 -3122 1594 2154 7844 -2794 100 { m20
-} R 7821 -2839 7466 -3223 7414 -3358 7639 -3174 7874 -2732 7705 -3065 7802 -2876
- 7873 -2725 1419 1600 7864 -2752 7811 -2861 1219 1650 7788 -2788 1369 1817 1199
- 2092 1401 2241 1076 1298 1265 2153 1233 1748 1246 1902 7907 -2654 7697 -3047
- 1409 2322 7900 -2679 647 1771 7713 -2989 7711 -2980 1517 1906 1185 1571 1503
- 2231 1385 2180 1151 1932 7563 -3360 1572 1937 806 1440 7849 -2784 7860 -2761
- 1390 1994 7869 -2720 1359 1796 1475 2159 1713 2060 1514 2144 1279 1618 1359
- 2277 1458 2215 1436 2242 1401 2051 1378 1783 7683 -3074 7818 -2802 1513 2195
- 7834 -2806 7499 -3072 1858 1956 1042 1286 7649 -2990 1260 2250 7044 -3669 1611
- 1798 7879 -2710 7808 -2852 7767 -2922 7668 -3081 1057 1871 7707 -3000 7732
- -2923 7753 -2853 1601 1527 7810 -2827 1539 1973 7817 -2830 7649 -2961 7834
- -2802 7813 -2847 1046 1886 1390 2117 7745 -2988 7897 -2687 7838 -2769 889 2129
- 1504 2124 1018 993 1541 1913 1124 1718 1211 1182 7644 -3078 1304 1884 1436 1856
- 7612 -3260 7821 -2831 1330 2004 1129 2221 1546 2195 1310 2254 7037 -3912 7699
- -2976 1341 1637 7892 -2674 7906 -2666 100 { m20} R 7683 -3028 7574 -3269 7907
- -2627 1537 2101 892 1521 1387 2239 1273 2014 7723 -2843 7829 -2826 1100 1992
- 1240 1983 7842 -2794 1243 1599 7846 -2771 1470 2199 1370 2272 7833 -2815 7796
- -2892 7896 -2689 1445 1583 1307 1912 7184 -3594 7732 -3004 1209 1883 7735 -3003
- 1561 1411 1360 1806 1435 2021 7460 -3032 1424 2285 1477 1940 1471 2228 7719
- -3011 7864 -2748 1221 1751 7811 -2838 1334 2031 7824 -2831 7796 -2890 1178 1599
- 1382 1923 1650 2085 7841 -2796 7207 -3515 7714 -2948 7703 -2965 7872 -2736 7843
- -2776 1559 2170 7708 -3018 1250 2133 7903 -2666 7869 -2743 7678 -2972 7093
- -3475 7883 -2703 7744 -2863 1488 1944 7900 -2682 7845 -2790 1412 1773 7743
- -2982 1353 2085 7782 -2872 7694 -3052 7793 -2875 7775 -2786 7691 -2970 7846
- -2783 7787 -2903 7897 -2669 1489 2155 1426 2126 1229 1816 7812 -2860 7775 -2795
- 1051 1812 7654 -2966 1347 1699 7792 -2900 7630 -3214 1252 2029 7815 -2834 1276
- 2015 1529 2040 7891 -2696 7843 -2719 7876 -2724 1362 2051 7819 -2795 1454 2184
- 7825 -2833 7780 -2925 7773 -2924 7726 -2927 1400 2212 7646 -3163 7860 -2754
- 1075 2082 1107 2038 100 { m20} R 1730 1996 7732 -3010 1054 2014 7893 -2696 7857
- -2766 7793 -2884 1462 2171 7821 -2769 1264 2037 1419 1890 1428 2229 7873 -2725
- 993 1334 1570 1747 7813 -2849 7764 -2910 1629 2106 1726 1767 7868 -2743 1600
- 1719 7775 -2914 1435 2120 7878 -2721 7419 -3108 1492 1904 7650 -3045 1380 2298
- 7896 -2681 1321 1907 1675 1992 7843 -2793 1190 1828 7259 -3120 1371 1815 1252
- 2117 1224 1838 7904 -2674 7899 -2683 894 1499 1131 1838 1628 2063 1530 1790
- 1392 2019 7903 -2676 1319 2078 7893 -2679 1155 1818 1150 2040 1412 1989 7827
- -2811 7870 -2741 1371 2055 1021 1836 1129 1819 1326 2173 1153 1860 7674 -3136
- 1410 2322 7549 -3044 1581 2092 1507 1732 1330 2121 7812 -2856 7719 -3023 7686
- -3067 7787 -2911 7285 -3511 7481 -3362 1035 1954 1512 2076 1295 1984 1110 1785
- 1335 1948 1378 1475 7581 -3024 1296 1608 1456 2189 7685 -3110 7868 -2742 7764
- -2907 7503 -2879 7632 -3144 1458 2239 7870 -2725 7493 -3108 7748 -2986 7534
- -3358 7848 -2786 1477 1996 7796 -2876 1590 1917 857 1600 7786 -2913 7874 -2726
- 7801 -2801 7908 -2651 7651 -3051 880 2026 1495 2118 7843 -2770 100 { m20} R
- 7595 -3276 7865 -2718 1371 1853 7852 -2702 7907 -2656 1041 1828 1289 1695 7773
- -2877 7596 -3142 1445 2243 7834 -2811 7475 -3465 7642 -2952 1359 1840 1392 2063
- 7870 -2730 7849 -2785 7889 -2704 1436 2198 7596 -3026 1451 2162 1423 1800 1464
- 2141 1478 1767 7638 -3172 1140 1606 7857 -2769 1534 2162 7851 -2779 1491 2056
- 7645 -2938 1268 1637 7584 -2981 1250 1913 762 1978 7676 -2910 7883 -2699 1385
- 2154 1201 1402 1597 2125 1143 1568 1303 1337 1236 1910 1065 1859 1347 2270 7862
- -2758 1340 2193 1413 2118 7715 -3024 968 1031 1190 1314 1362 1659 7895 -2691
- 7745 -2950 1418 2113 1428 2081 7827 -2817 1434 2145 7892 -2696 7868 -2745 1309
- 2142 7540 -2934 1347 1995 1501 1459 7854 -2773 7813 -2850 1128 1741 1514 2084
- 7581 -3324 1134 1977 1470 2255 7701 -3017 7538 -3224 1440 1785 1210 1934 280
- 1293 1461 2239 7712 -2958 7874 -2731 1002 1576 1302 1857 1352 2008 7899 -2684
- 1012 1814 7774 -2915 1478 1919 7545 -3142 1213 1922 1343 1895 7746 -2955 1401
- 2154 7837 -2807 7791 -2775 601 1703 1464 2118 7905 -2662 7719 -2896 1483 2117
- 1325 2134 1452 2006 100 { m20} R 1305 2121 7549 -3053 7870 -2733 1250 1821 1188
- 1599 1359 2021 1288 2112 7719 -2842 7886 -2702 1473 2003 1647 1940 1240 1840
- 1391 2116 1498 2073 1494 2051 1504 2213 1386 2139 7670 -2970 7753 -2925 7782
- -2879 7721 -2915 1227 1896 7883 -2712 1098 1774 7852 -2741 7582 -3014 7767
- -2951 7904 -2664 1228 2118 1361 2252 1392 2270 1368 2163 7827 -2828 7843 -2733
- 1292 2105 7676 -3132 1431 1953 1715 1846 7714 -3056 1457 1657 7712 -3016 7758
- -2916 1406 2029 7834 -2816 1406 2195 1183 1949 7679 -3124 1428 2173 7787 -2907
- 7879 -2657 7782 -2821 7905 -2671 7882 -2718 7765 -2945 1469 2153 7255 -3486
- 1181 1101 7832 -2798 1371 2237 7396 -3082 1594 2119 1064 1150 1233 1828 7889
- -2671 1441 1866 7891 -2700 7730 -2937 7799 -2885 7778 -2785 7812 -2809 1409
- 2081 1308 1586 7609 -3235 1549 1865 1313 1930 7796 -2891 7708 -2891 7790 -2885
- 1435 2179 1389 2219 7609 -3065 1012 1674 1589 1898 7909 -2663 7862 -2751 7896
- -2682 7869 -2743 7651 -2936 7856 -2730 7857 -2769 1010 1525 1172 1605 1369 2057
- 7864 -2738 1217 1631 7442 -3157 7654 -3172 1550 2169 7523 -2791 1444 2221 100 {
- m20} R 1615 2106 1012 1729 1327 1971 1144 1076 1555 1564 1429 2253 7702 -2953
- 1015 1358 1454 2217 1433 2186 7892 -2697 1309 1978 7600 -3286 7800 -2862 7775
- -2923 7818 -2833 1492 2112 1435 2275 7833 -2797 1284 2286 1352 1787 1510 1969
- 7857 -2738 1448 1942 7717 -2976 7857 -2765 1388 2233 7883 -2684 7827 -2814 280
- 1597 7785 -2867 7545 -2974 7858 -2761 7851 -2771 7766 -2950 1399 2291 1384 2160
- 1416 2172 7753 -2855 7820 -2809 1372 2336 7902 -2669 1483 2215 7589 -3244 7897
- -2688 7871 -2724 7893 -2695 7817 -2849 7882 -2716 1437 2206 6925 -3484 7747
- -2991 1378 2088 7766 -2929 1338 2298 1329 2091 7737 -3006 1438 2047 7499 -3206
- 7808 -2803 7716 -3050 7699 -3003 1505 2017 1350 1663 7574 -3260 7805 -2873 7823
- -2837 7754 -2956 1325 1972 1520 1971 7879 -2711 1283 2016 1343 2078 1681 1943
- 1189 1914 1396 2118 7560 -3338 7907 -2642 1022 1736 7870 -2709 1541 2200 7517
- -3273 7627 -3186 7810 -2860 1144 1574 1644 2089 7888 -2699 1928 1896 7759 -2934
- 1449 2263 7755 -2975 1427 2124 1750 1838 1591 1990 7786 -2898 7350 -3302 1426
- 2251 1248 1888 921 1622 1472 2239 100 { m20} R 7834 -2814 1274 1713 1602 1649
- 1423 1687 7641 -3196 1137 1631 7494 -3200 1411 2110 1274 2148 1111 1793 7873
- -2732 1410 2189 7870 -2742 1377 1854 1600 1844 7818 -2847 1383 1983 1554 2162
- 7681 -3087 7901 -2676 1568 2029 7862 -2756 1441 2274 7792 -2897 7555 -3188 1581
- 1952 1278 2121 1447 2168 1332 2175 1345 1883 1110 1902 1505 1869 7750 -2879
- 7093 -3243 1427 1268 7497 -3245 1461 2252 7767 -2950 1123 1567 7709 -3051 7385
- -3260 1534 2148 7391 -3160 1364 2189 1343 2006 1380 1730 1243 1785 7751 -2952
- 1219 1623 1467 1538 1443 2256 1106 1837 1350 1931 7759 -2965 7900 -2610 1144
- 2158 1339 2123 1380 1872 1267 1909 7448 -3429 7792 -2872 1530 1944 7664 -2993
- 1311 1851 1395 2091 1407 2206 7328 -3667 7892 -2698 1660 2108 7724 -3036 7870
- -2728 7774 -2925 7802 -2837 7742 -2958 1432 1535 7123 -3231 7851 -2780 7709
- -2837 7907 -2668 7754 -2971 1224 1981 1478 2096 1461 2153 1493 2062 7833 -2805
- 7745 -2987 7654 -3176 1370 1828 7704 -3076 7834 -2793 1329 1939 1438 2121 7827
- -2797 1300 2090 1245 1805 7896 -2690 7851 -2752 7525 -3284 1270 1983 1462 2243
- 100 { m20} R 1431 2156 1507 1794 7877 -2711 7896 -2684 7786 -2910 1017 1579
- 1375 1878 1233 2018 1317 1665 7804 -2862 1525 2171 7182 -3017 1492 2189 7896
- -2689 1264 1411 1480 2193 1358 2237 7791 -2840 1397 2150 7737 -2990 1057 1175
- 7864 -2754 7893 -2696 7370 -3259 7757 -2859 1257 1902 7887 -2676 1571 2173 7854
- -2755 7532 -3259 7775 -2926 1430 1966 7842 -2791 7874 -2717 7817 -2807 7657
- -3013 7858 -2767 7866 -2727 7874 -2733 7810 -2863 1315 2231 1333 1837 1137 1745
- 1220 1561 7592 -3009 1472 2017 1475 2161 7890 -2699 1575 2084 1360 2128 1305
- 2172 1640 2076 7853 -2745 7904 -2651 1420 2160 7609 -3017 7819 -2812 7883 -2717
- 1434 1148 7858 -2744 7828 -2743 7897 -2683 1356 2005 1409 1725 7758 -2954 1352
- 2185 7439 -3317 1419 2239 1468 2254 1610 2134 7549 -3314 1605 2052 1243 1936
- 7905 -2664 7877 -2697 288 1683 1433 2254 1357 2075 7719 -2830 7777 -2919 1535
- 1777 7904 -2671 7891 -2699 7728 -2937 1405 2300 7726 -2951 7216 -3162 7781
- -2857 7839 -2779 7893 -2697 7847 -2721 7503 -3245 7756 -2973 7785 -2838 1558
- 2007 885 1637 7806 -2872 7522 -2980 7796 -2873 7694 -2946 100 { m20} R 1336
- 1685 7898 -2653 1486 2017 7782 -2920 1410 2124 1310 2003 1035 1893 7666 -3138
- 7771 -2816 1488 2183 7882 -2713 7863 -2727 7830 -2775 1196 1888 1229 2174 7651
- -3003 7821 -2775 1463 2157 1497 1954 1284 1588 7793 -2898 7697 -2975 7750 -2982
- 7304 -3121 7741 -2999 1679 2002 7875 -2729 7761 -2930 1563 2059 1264 2142 878
- 1805 1273 2134 1376 2058 7713 -2973 1424 2018 7826 -2831 1293 1879 1358 2082
- 7902 -2670 7503 -2909 7745 -2982 1349 2026 1435 2105 1253 1843 1326 1920 1598
- 1980 1096 1837 1422 2211 1546 2147 7889 -2699 1614 2078 1332 1784 1592 1956
- 7831 -2818 7584 -3311 7834 -2803 1057 1841 863 1735 1242 1945 7534 -2961 7863
- -2752 2132 1689 7543 -3352 7888 -2682 7846 -2770 1575 1886 1308 2099 7560 -3185
- 7802 -2873 7884 -2689 1397 1831 7894 -2676 1461 2183 1441 1999 7808 -2858 7801
- -2815 1037 1565 7815 -2850 7835 -2811 1195 2069 7855 -2772 7809 -2857 1011 1768
- 1453 1836 7852 -2778 1086 1590 1450 2127 1249 2090 1414 2115 1497 1998 1213
- 1151 1448 1846 7725 -2989 1199 1793 7499 -2916 1486 1956 7517 -2992 1440 2132
- 1390 1904 1542 2157 100 { m20} R 1565 2000 7888 -2699 1322 1698 1575 2146 7882
- -2718 7827 -2802 1274 1671 7642 -3159 1213 2054 1379 2032 7709 -3000 1555 2074
- 7708 -3066 1523 1925 7762 -2901 7901 -2669 7778 -2918 1310 1821 7850 -2771 7461
- -3385 1538 1843 1094 2197 7866 -2696 7862 -2754 1273 1998 1155 1643 7785 -2877
- 7896 -2684 7823 -2803 1266 1875 1186 1716 1813 1880 7599 -3193 7740 -2984 7836
- -2810 1034 1830 1419 2213 1507 2085 790 1753 1404 2302 7663 -3093 1367 2199
- 1410 1994 7743 -2923 7560 -3345 802 1577 7810 -2834 7772 -2916 1474 2241 1379
- 1942 7809 -2776 1279 1674 1288 2037 1235 1758 7704 -3044 957 913 1408 2295 1329
- 2261 7748 -2976 1277 1811 1489 1960 7059 -3410 1552 1857 1393 2011 1631 2079
- 1460 2126 1076 1199 1657 1413 7743 -2992 1471 2178 7869 -2739 1549 1670 1429
- 2073 1567 2010 1278 2126 7884 -2713 1503 1855 1684 1982 7846 -2774 1458 2191
- 7809 -2834 1349 2236 1321 1827 7862 -2739 7832 -2818 1401 1856 7781 -2785 1339
- 2127 1272 2154 1245 2010 7824 -2812 1619 1998 1680 1959 7545 -3355 7777 -2924
- 1348 2052 7855 -2771 1422 1682 7720 -3024 1362 1989 100 { m20} R 7684 -3075
- 7806 -2871 7806 -2850 7901 -2676 1530 2156 1488 2054 7854 -2767 7750 -2961 1505
- 2110 1371 2106 7665 -3004 1396 1675 1588 1975 1534 2048 1178 1891 7799 -2832
- 7831 -2810 1354 1994 1301 2141 7907 -2663 1424 2138 7823 -2824 7893 -2694 7895
- -2687 1816 1864 7772 -2888 1285 2153 7851 -2757 1061 1924 7707 -3048 1348 1771
- 1360 2282 1421 2100 1647 2085 7793 -2897 7775 -2917 1400 2142 7724 -2998 7754
- -2966 1561 2146 7274 -3134 7223 -3608 1565 1812 7840 -2794 1359 2162 1171 2129
- 7908 -2662 1551 2118 7884 -2659 7877 -2714 7773 -2934 7904 -2672 7900 -2666
- 1287 1545 7354 -3695 7657 -3143 7904 -2659 7861 -2760 1478 2089 7621 -3055 1510
- 2134 1267 1903 7872 -2735 7897 -2675 7745 -2827 1523 2192 1172 2142 1423 2039
- 1332 1920 1321 1802 1415 2308 7816 -2841 7855 -2765 7858 -2752 1454 2038 1405
- 2226 7738 -2989 7666 -3155 1210 1919 7891 -2692 1643 2003 1285 1501 1187 1972
- 1606 1777 1235 1743 1133 1201 1461 2141 7744 -2967 971 1567 1257 1957 7309
- -3151 1400 2142 7902 -2677 7906 -2659 1261 2073 7719 -3030 1395 2147 1461 2086
- 1721 2037 7705 -3070 100 { m20} R 7672 -3121 7558 -3161 1418 2245 1347 2314
- 7869 -2730 1491 933 7451 -3115 7747 -2964 1497 2133 7843 -2795 911 1696 7747
- -2938 1274 2037 1777 1996 7894 -2684 7904 -2655 7637 -3143 7687 -3109 7862
- -2744 7659 -3038 7611 -3191 1332 1846 1398 1944 7468 -3375 1394 2297 1312 1883
- 7756 -2962 1269 1997 7882 -2715 7602 -3016 7793 -2892 1102 1037 7818 -2848 1417
- 2270 7832 -2810 7766 -2952 7758 -2864 7889 -2685 1780 1984 7498 -3163 7806
- -2820 1009 1921 7468 -2985 1622 1940 7538 -3189 7732 -2791 7788 -2901 7832
- -2819 1399 2241 7849 -2784 7813 -2857 7745 -2864 7846 -2712 1498 2130 7391
- -3150 7884 -2674 7839 -2800 7776 -2927 7865 -2720 7899 -2684 7776 -2932 7683
- -3114 1150 1575 7861 -2753 7691 -3046 1553 1789 1498 2130 1460 1905 1519 1872
- 1198 1682 1410 2105 7682 -3118 1577 2149 1568 2161 7901 -2671 1414 2021 1315
- 2011 1359 2168 7858 -2747 1393 2266 7517 -3309 1227 2078 7678 -3064 1207 1634
- 1333 2095 1215 2108 7736 -3012 7721 -2940 7283 -3104 1611 1869 1406 1775 7648
- -3176 7701 -3035 7906 -2670 7880 -2720 1253 1876 1360 2033 7846 -2790 7812
- -2848 1515 2153 100 { m20} R 1211 1706 1353 1935 7016 -3473 7655 -2856 1382
- 2145 1304 1964 7867 -2747 7702 -2905 1408 1947 1433 2272 7888 -2701 7893 -2679
- 7814 -2802 1345 2342 1227 1933 1285 2068 7889 -2673 1052 1863 1377 1762 1484
- 2156 7713 -3033 1395 2204 1334 2083 1401 1885 7409 -3240 7882 -2698 7647 -3102
- 1623 1717 1451 2207 7776 -2924 7882 -2717 1594 1278 6945 -3566 990 1681 1462
- 1820 1149 1915 1362 1933 7885 -2701 1234 1462 1255 2013 1366 2147 7904 -2665
- 1139 1917 1286 1969 7761 -2961 1329 1990 1458 2225 1486 2139 452 1068 1461 2241
- 1288 2135 7883 -2697 7861 -2726 1414 2218 1489 2210 1491 2234 1466 2158 1559
- 2015 7906 -2669 1537 1840 1584 1976 7877 -2719 1275 2105 7846 -2786 7549 -3230
- 7871 -2710 1180 1708 1545 2176 7734 -3011 1382 2068 1245 1632 7668 -3139 7622
- -2951 7794 -2862 1157 1632 7905 -2671 7881 -2712 1433 2270 1064 1802 1434 2102
- 7889 -2684 7848 -2750 7628 -3178 1216 1715 7794 -2807 1383 2313 1266 1621 7637
- -3083 7891 -2699 7805 -2874 1070 1358 7724 -3035 1484 1938 7882 -2649 1336 1772
- 1015 1932 7899 -2684 1389 2011 7700 -3074 1229 1761 100 { m20} R 1454 2152 1327
- 1860 1242 2101 1308 1956 7835 -2769 1280 1706 7900 -2683 1414 2303 1352 1777
- 7799 -2878 1405 2117 1274 2236 1247 1746 1255 2127 7832 -2818 1327 2147 1386
- 1895 7648 -3141 7725 -2987 1244 2180 7905 -2655 7898 -2656 7778 -2923 981 1853
- 7579 -2970 1234 2042 7413 -3577 1277 1717 7625 -3132 1311 1998 7776 -2844 7747
- -2928 7322 -3282 7657 -3093 1144 1733 1433 2185 7753 -2967 1211 1872 1425 2023
- 7732 -2977 7858 -2750 1376 1722 1447 2215 7675 -2989 7711 -3064 7907 -2662 1517
- 2167 1395 2264 7579 -3135 7813 -2787 893 1502 7656 -3117 7704 -2956 1278 2029
- 7769 -2893 1024 2129 7821 -2829 1453 1885 1542 2148 1152 1997 1202 1703 7872
- -2730 1594 2136 7744 -2978 7608 -3074 1214 1893 7412 -3100 1534 2171 7897 -2689
- 7888 -2675 1756 1789 7833 -2809 938 1885 1341 1982 1433 2166 1399 2075 1444
- 1525 1403 2184 1229 1655 1431 2031 1315 2056 7897 -2688 7423 -3325 7642 -3202
- 7328 -3534 7419 -3226 7858 -2725 1426 2265 7807 -2859 1613 2037 1109 1906 1190
- 1932 1297 2033 586 1532 7723 -2865 1420 2198 1434 2047 7893 -2692 7682 -2894
- 7733 -2996 100 { m20} R 1449 1881 7735 -2999 7644 -3079 732 1751 7740 -2946
- 7883 -2674 7761 -2838 7842 -2772 7867 -2736 1360 1485 1344 2201 1625 1948 7794
- -2895 1467 2258 7767 -2927 7775 -2857 1172 1848 1566 2090 7885 -2710 1481 1505
- 7451 -3472 1142 1957 7794 -2866 7621 -3099 1852 1831 7868 -2747 7868 -2740 7878
- -2712 7800 -2797 1378 2091 7642 -3123 1452 1799 1391 2285 1342 1868 7887 -2683
- 7787 -2842 1239 1999 1320 2322 1050 1432 7852 -2763 7893 -2685 7862 -2758 1361
- 2296 787 1120 7722 -2864 1365 1944 7602 -3219 1392 2267 7619 -3200 7799 -2791
- 7834 -2813 7837 -2810 1349 2003 1405 2127 1503 1397 1216 1608 7802 -2813 7908
- -2659 1248 1864 7902 -2678 1331 2016 1316 1912 1387 2122 7875 -2720 7815 -2780
- 1516 2061 1467 2189 7805 -2798 7815 -2853 7860 -2755 1304 1910 1574 1964 7884
- -2709 7628 -2965 1319 1843 7908 -2655 1464 2015 1513 1743 7768 -2936 1532 2198
- 7644 -2789 1330 1871 7826 -2830 7717 -2823 1496 1927 1454 1968 1202 2135 1611
- 2032 7708 -3031 7894 -2694 1329 1863 7495 -3164 1325 1802 1359 2189 7905 -2664
- 7823 -2837 1120 1915 1255 1969 1644 1962 1490 2229 100 { m20} R 7582 -3118 1289
- 1876 1191 1845 1112 976 1314 2173 7672 -3040 724 1888 7871 -2735 7686 -3106
- 1379 2146 7778 -2920 1387 2291 7709 -3018 7849 -2777 7889 -2607 1370 1823 1610
- 2136 1413 1983 1297 2234 1302 2099 1392 2223 7812 -2815 7860 -2759 1349 2102
- 7862 -2745 7871 -2709 7896 -2687 7743 -2976 7909 -2658 7789 -2899 7797 -2833
- 7587 -3127 1431 2231 7758 -2951 7000 -3181 1517 2208 1223 1596 7689 -2984 7598
- -2869 7877 -2723 7847 -2785 7585 -3088 1480 2107 7732 -2992 1500 2230 7638
- -3211 7877 -2721 7736 -2891 7726 -2872 1513 2140 7887 -2707 1253 2130 1485 1552
- 1600 2013 7890 -2689 1404 2077 7691 -3097 7846 -2749 7766 -2948 7231 -3255 7687
- -3088 1420 2282 1181 1522 7692 -3038 7864 -2726 1432 2060 7729 -2978 7608 -3260
- 7764 -2957 7768 -2948 7670 -3078 7871 -2740 1428 2026 7873 -2690 7427 -3369
- 7625 -3206 7889 -2690 7888 -2705 1567 2177 7759 -2967 7847 -2773 7845 -2790
- 1289 1783 7768 -2910 7904 -2667 1174 1991 7846 -2758 7862 -2759 931 1676 1591
- 2065 1435 2178 7745 -2964 1074 1381 1628 1584 7293 -3117 7709 -3024 7824 -2827
- 1407 1896 1446 2211 7895 -2692 100 { m20} R 7820 -2843 7740 -2999 943 1733 1470
- 2256 7668 -3101 1552 2159 1387 2255 1530 2186 7845 -2779 7858 -2766 1152 1705
- 7744 -2990 7670 -3140 1188 1997 7347 -3149 1542 2125 1480 1963 1313 2111 7802
- -2861 1378 2098 7879 -2691 1315 2110 1255 2090 1421 2021 7778 -2838 7897 -2684
- 7794 -2895 1345 2308 7684 -3094 1441 2187 640 1853 1440 2021 7877 -2729 1461
- 2111 1570 2032 7631 -2986 7280 -3521 1135 1705 7596 -3037 7841 -2704 1243 1650
- 1433 1974 7726 -2930 7885 -2712 1459 2062 1290 1888 1108 1633 7897 -2686 1446
- 2175 7843 -2796 7861 -2758 7734 -2985 7882 -2719 1032 1908 7724 -2915 1364 2143
- 1370 2154 1399 2037 959 1833 7744 -2967 7735 -3009 7770 -2906 1408 2213 1321
- 2183 7647 -3075 1034 1473 1390 2138 1467 2092 1595 2074 7742 -2982 1293 1939
- 1421 2279 1627 1953 7832 -2805 7675 -3009 1435 2233 1450 2278 7813 -2854 1245
- 1966 7766 -2893 1492 2106 7390 -3126 7264 -3155 1152 1677 1411 1661 1658 1935
- 1611 2008 7898 -2643 7863 -2723 7905 -2618 1271 1905 7549 -3279 7831 -2820 1535
- 2018 1248 1785 1235 1688 7770 -2858 7834 -2805 7790 -2888 7552 -3096 100 { m20
-} R 1369 2188 1522 2184 7181 -3032 1337 1530 1282 2181 1567 1965 7792 -2899 7836
- -2810 7872 -2731 1374 1708 1021 1798 7857 -2769 7747 -2861 7860 -2761 1240 1858
- 1463 2151 7877 -2701 7844 -2766 978 1800 1474 2123 1473 2258 7887 -2709 1172
- 1912 7831 -2818 7831 -2813 7767 -2949 7904 -2660 7842 -2798 7894 -2686 7830
- -2793 1469 948 1309 1739 1656 1912 1326 1923 7861 -2745 7564 -3223 7854 -2762
- 7800 -2883 7384 -3298 1458 1824 1325 2008 7832 -2801 7734 -2929 1108 2075 1021
- 1646 979 1206 1446 1860 7768 -2821 1570 1678 1624 2058 7889 -2652 7768 -2864
- 7746 -2961 1452 1902 7831 -2820 6936 -3512 7546 -3157 1411 2282 1482 2134 1179
- 2032 7848 -2756 1056 1602 1378 1931 1445 2013 7851 -2780 7564 -3099 7708 -2950
- 7819 -2837 7441 -3330 7852 -2778 7894 -2692 7685 -3096 1344 2179 1579 1993 7731
- -3013 7881 -2716 1177 1511 1433 2137 7342 -3597 1443 2104 1434 2274 1405 1824
- 1360 2362 669 1957 1648 1938 1180 1558 7755 -2971 1488 1878 7868 -2721 7446
- -3323 1367 2291 7799 -2870 1590 1970 1353 1946 1668 1872 1080 1304 1562 2155
- 1455 2045 7691 -3093 7728 -2986 100 { m20} R 1154 1808 1513 2185 1419 2170 1409
- 1457 7818 -2794 7867 -2741 1465 2214 7802 -2859 1467 2163 7672 -3064 7795 -2854
- 1415 1924 7750 -2980 7572 -3224 1365 1948 7790 -2898 1377 1639 7725 -2988 7774
- -2889 1492 2156 7857 -2752 1632 2062 7147 -3107 1328 2075 7834 -2786 1327 2270
- 7867 -2740 1654 1761 7840 -2779 1602 1958 7806 -2868 7695 -2868 1404 2189 7825
- -2800 7854 -2775 7861 -2756 1579 2132 1318 2164 7840 -2794 7682 -3093 7845
- -2793 1384 2263 1693 2031 1408 1997 1084 1752 1302 1910 7839 -2749 7623 -3220
- 7851 -2770 7657 -2903 7837 -2793 7879 -2721 1162 1944 1298 2102 7684 -3095 1263
- 1941 1471 2146 7743 -2908 1378 2330 1471 2225 7894 -2693 1261 2006 7902 -2666
- 1494 2180 7775 -2932 7730 -3004 1279 2039 1308 1863 1295 1886 1773 1801 1377
- 2195 1411 2315 1211 1667 7714 -3049 7884 -2707 7834 -2782 1274 1834 7390 -3041
- 1059 1671 7905 -2614 7878 -2721 1266 2108 7862 -2758 7569 -3096 7452 -3240 1297
- 1563 7809 -2861 1398 1911 7880 -2722 7858 -2726 1540 2163 7539 -3387 1406 2284
- 1409 1949 7898 -2684 2047 1656 1258 1975 7870 -2718 1536 2097 1423 2219 100 {
- m20} R 7905 -2670 7827 -2790 1303 1351 1502 2130 7777 -2921 1009 1750 7898
- -2684 1353 2068 1354 2251 7608 -3096 1287 1959 1343 2280 1107 1774 7840 -2801
- 7888 -2683 1061 1615 7843 -2796 1146 1585 1120 1905 7804 -2859 1436 2111 1506
- 2213 7703 -3048 7813 -2822 7872 -2735 7652 -3103 1390 1543 7739 -2963 1482 2249
- 1319 2216 7811 -2859 1599 2154 1593 2120 1021 1272 7890 -2700 1406 1719 6654
- -4573 1336 2168 1450 2216 7532 -2992 7875 -2730 7791 -2889 598 1993 7775 -2928
- 7759 -2874 1372 2206 7641 -3017 7776 -2927 48 { m20} R 7725 -3033 7895 -2682
- 7782 -2880 1431 2282 7853 -2777 1423 2257 1219 1769 7862 -2758 1358 1911 7805
- -2865 7760 -2954 7742 -2994 7871 -2729 7889 -2692 7630 -3208 1193 2138 1589
- 2121 7779 -2925 7907 -2661 7757 -2949 1826 1958 7642 -3196 1390 1931 7899 -2663
- 7128 -3491 1428 2265 7699 -3072 1673 1737 1409 2092 1419 2280 7585 -2983 1667
- 1967 1120 1920 952 1875 1132 1723 1375 2255 7833 -2809 7665 -3068 1344 1521
- 7678 -3127 7616 -3210 7837 -2773 7645 -2953 1419 2104 1238 1633 1475 1988 7754
- -2976 1039 1773 1217 1903 7781 -2901 7800 -2871 1437 2055 7669 -3115 1287 1949
- 7598 -3103 7881 -2672 7810 -2780 937 1765 7651 -3178 7850 -2783 7615 -3108 1248
- 1683 7876 -2730 1315 2076 7837 -2806 7378 -3198 7841 -2797 7746 -2866 7902
- -2677 7825 -2812 1139 1726 7799 -2797 7772 -2780 7717 -3045 1452 2175 7881
- -2708 7614 -3252 7752 -2964 1633 1944 1489 2094 7696 -3038 1448 2269 7412 -3213
- 7768 -2942 1597 2019 7368 -3198 1465 2117 1329 2059 1577 2161 7827 -2819 7473
- -3410 7894 -2694 1434 2064 7761 -2948 7906 -2658 1610 2127 7822 -2767 1373 1960
- 7796 -2846 7857 -2749 100 { m20} R 7903 -2676 1132 1461 934 1722 1642 2093 1379
- 2047 7679 -3121 1122 1707 7641 -3163 1376 2017 7883 -2708 7868 -2692 7870 -2740
- 1445 2153 1367 1909 1623 1634 7647 -3191 7508 -3162 1040 1463 1254 1664 1505
- 1761 1267 2163 1330 2129 1187 1916 1598 1974 1505 2224 1421 2065 7554 -3333
- 1329 1877 1325 2212 7862 -2747 1391 1987 7687 -3015 1350 1914 7775 -2907 7897
- -2686 1457 1934 7609 -2944 7685 -2981 7793 -2865 7723 -2947 1281 1790 7840
- -2802 1410 2087 7705 -3018 7893 -2686 7901 -2668 1486 2174 1464 1873 1416 1922
- 1536 2197 1408 2112 1452 2209 1163 1651 7874 -2733 1453 2248 1680 1881 1258
- 2085 1236 2102 1222 1677 1429 2200 7615 -3025 7424 -3031 1317 2215 1303 1866
- 1378 1947 1443 2262 1493 1933 7788 -2835 1051 2020 7809 -2834 7903 -2656 7809
- -2846 7732 -3021 7571 -3034 7882 -2693 1439 2205 7648 -3123 7550 -3354 1368
- 2335 1198 1712 7891 -2695 7651 -2999 1258 1608 7779 -2905 7635 -3164 1402 2234
- 7444 -3427 7789 -2878 1207 1776 1583 2069 7722 -3040 1211 1962 1092 1797 7787
- -2893 1424 2017 848 1669 1445 2175 7892 -2698 7612 -3051 7568 -3079 100 { m20
-} R 7866 -2750 7855 -2772 1178 1482 1291 1503 1473 2169 1139 2040 7490 -3308
- 7315 -3197 973 2066 7906 -2652 7799 -2879 7323 -3159 7412 -3520 1489 2134 1369
- 2304 1507 2217 7562 -3149 7835 -2811 7726 -2915 1288 1610 7812 -2857 1309 1807
- 1615 1848 1261 1311 7849 -2785 1284 2108 7624 -3029 7672 -3140 1430 2181 1392
- 2118 7819 -2846 7541 -3405 7429 -3170 1534 2200 7661 -3130 1052 1716 7824 -2834
- 1380 1863 1427 2128 7842 -2799 1368 1659 1426 2195 7884 -2713 7767 -2944 7909
- -2647 1032 2056 1241 1775 7714 -2932 7786 -2881 7871 -2739 7812 -2856 7867
- -2747 1566 1970 1092 1824 7900 -2681 1244 2097 1327 1804 7885 -2706 1462 2230
- 7775 -2935 1287 2036 1254 2006 1492 2056 7891 -2694 1288 1934 979 1638 7802
- -2863 7857 -2740 1110 1935 1054 1999 1506 1458 7644 -3199 1423 2217 1425 2043
- 1447 2031 1272 1451 7810 -2861 1364 2132 1419 2157 1417 2266 7889 -2688 7890
- -2698 1491 2094 7838 -2807 7884 -2709 7772 -2921 7646 -3120 7703 -3009 1387
- 1744 7906 -2665 7622 -3159 7876 -2728 7853 -2763 7718 -3014 2001 1165 1473 1542
- 7822 -2821 7608 -2949 7723 -2964 7435 -3109 100 { m20} R 1423 2153 1469 1920
- 7730 -2865 7130 -3198 1495 1803 1459 2081 7794 -2887 1129 1967 7898 -2686 1111
- 1420 7844 -2788 1416 2203 1472 2100 1463 2138 1504 2045 1224 2027 1122 1851
- 1513 2208 1429 2049 1454 2181 1582 2133 1292 1598 7782 -2913 7805 -2863 7596
- -3174 7563 -3266 7868 -2707 1070 1972 7843 -2770 7898 -2681 1241 1885 1407 2193
- 1439 1945 1397 2289 7849 -2774 7900 -2679 7810 -2855 1368 2098 7696 -2869 7693
- -2950 7841 -2761 1172 1991 1201 2033 1489 1857 7871 -2740 1328 2072 7866 -2749
- 1259 2135 7449 -3548 7856 -2770 1526 2211 7872 -2737 1382 1732 1559 1776 7860
- -2750 1403 2253 1503 2209 7908 -2646 7680 -3099 1481 1753 7856 -2768 1283 1866
- 1589 1965 7891 -2684 7385 -3189 7691 -2995 1523 2211 1406 2132 1522 1807 7817
- -2849 7806 -2856 1230 2021 7889 -2690 1419 2181 7877 -2719 7352 -3021 7889
- -2674 7891 -2669 7697 -3021 1429 2156 7906 -2665 7897 -2684 7896 -2665 1258
- 1456 7906 -2668 7866 -2735 7766 -2952 7844 -2792 1438 2075 1284 1812 7866 -2747
- 1327 1455 7844 -2789 1097 1286 1404 2249 1490 1935 7489 -3344 1314 1980 1402
- 2268 7666 -3110 100 { m20} R 7892 -2683 7862 -2713 7883 -2698 7765 -2805 7899
- -2683 1393 2134 1473 1891 7860 -2757 7666 -3152 7473 -3294 7819 -2827 902 1276
- 1266 1699 7844 -2793 7462 -3197 7757 -2963 1380 1928 1327 2070 1420 1954 1466
- 2200 1490 2038 903 1586 1287 1941 7778 -2918 1000 1462 1649 2073 1363 2173 1601
- 1976 1294 1847 7776 -2906 7798 -2865 1315 2146 1443 2089 7857 -2768 7655 -3100
- 7693 -3082 1529 1752 7900 -2678 1472 2088 7685 -3115 1516 2073 1076 1895 1323
- 1415 7875 -2731 7877 -2691 1508 2143 927 2033 7859 -2764 1388 1864 7340 -2978
- 7724 -3032 7903 -2668 1490 2224 1486 2206 7811 -2843 7838 -2806 1329 2231 7883
- -2716 1355 2248 7812 -2854 1286 1946 854 1794 1381 2097 1499 2212 7890 -2699
- 7868 -2747 7738 -3002 7871 -2715 1115 1626 1488 2178 1382 2165 7735 -3009 1438
- 1780 7388 -3635 1312 1895 1341 1987 862 1514 7864 -2752 1436 2205 1472 2244
- 1297 1812 7896 -2686 7884 -2699 7848 -2781 1684 2068 7903 -2648 1287 1946 1408
- 1917 1387 2222 7901 -2680 1277 1792 1429 2256 1351 1847 7489 -3414 1077 1904
- 7888 -2700 7884 -2704 1478 2116 7819 -2820 1310 1435 100 { m20} R 1110 1965
- 7733 -2858 7666 -3098 1593 2061 936 1841 1651 594 7329 -3142 7823 -2825 7858
- -2707 1355 1633 7318 -3385 1492 2225 1566 2161 1274 2045 7539 -3058 1403 2259
- 7513 -3168 7810 -2824 1469 2025 7754 -2949 7476 -3276 7862 -2758 7669 -3144
- 7826 -2772 1132 1857 7760 -2861 7841 -2800 7763 -2948 1344 1708 7693 -3038 1417
- 1958 7518 -3160 7800 -2805 7881 -2691 1409 2019 7695 -2913 7382 -3382 1416 2095
- 7495 -3199 7777 -2929 7868 -2731 469 1164 7574 -3230 7786 -2848 1455 2222 1406
- 2142 7533 -3274 1032 2012 1513 2218 7839 -2798 1445 2239 1502 2133 1115 1731
- 7890 -2700 1329 2037 7815 -2854 7700 -3055 1270 1638 1457 1837 7897 -2686 7560
- -3218 1545 2126 7368 -3194 7876 -2730 7786 -2899 7861 -2753 7845 -2790 1368
- 2038 1380 1978 1574 1701 7740 -2841 7516 -3395 1413 2061 1834 1972 1564 1943
- 7907 -2665 1635 2118 7823 -2834 7779 -2883 7906 -2669 7708 -2837 7054 -4311
- 1145 1987 1377 2363 7806 -2861 7764 -2942 7876 -2727 7851 -2733 1529 1999 1529
- 2173 1305 2131 7897 -2686 1512 2211 7660 -3164 1405 2209 7893 -2695 1121 1843
- 7881 -2720 1448 2191 7800 -2877 100 { m20} R 1426 1784 7733 -2942 7896 -2691
- 1450 1958 7566 -3284 1616 2006 7842 -2791 1157 1907 1409 2212 7708 -3060 7380
- -3428 1397 2281 7889 -2705 7823 -2836 7712 -3037 7877 -2729 1608 2070 1216 1940
- 7729 -2972 7734 -2931 1478 2114 7813 -2835 1417 1981 7828 -2809 1104 1884 7787
- -2868 7625 -3062 7862 -2756 1317 2073 7794 -2836 1322 1699 1163 1929 7631 -2988
- 7728 -3029 7853 -2763 7509 -3126 1420 2082 7781 -2918 7704 -3072 1250 1922 1296
- 2138 1332 2000 1350 1989 1463 1720 7895 -2692 7443 -3299 1428 2194 1001 1791
- 7899 -2634 1421 1871 7841 -2777 1562 1945 227 1416 1696 2012 7888 -2704 7869
- -2742 1209 2106 1416 2102 1414 1380 7760 -2906 1397 1959 7895 -2690 7878 -2725
- 7856 -2771 1475 2116 1435 2091 1168 2068 7800 -2883 1280 2004 1443 2127 7833
- -2794 7555 -3262 941 1467 7839 -2795 7773 -2919 653 1526 7643 -3191 1337 2078
- 1233 2202 1555 1979 1241 1547 1347 1843 1111 1784 7644 -3036 7722 -3036 7110
- -3679 7838 -2757 1359 2119 7841 -2802 7897 -2681 7873 -2701 1398 2074 1474 2171
- 7484 -3414 1576 2100 1413 2042 1553 1599 7828 -2814 1882 1896 7661 -3151 100 {
- m20} R 1321 1867 1322 1958 7852 -2778 1252 1482 7622 -3006 1366 1912 7743 -2978
- 7781 -2814 1350 1933 7509 -3207 7878 -2718 7847 -2764 1480 2243 7908 -2651 1543
- 1758 7748 -2972 1486 2096 7823 -2837 1131 1871 7740 -2897 1643 2005 1419 1913
- 1482 1797 1231 1877 7887 -2680 7855 -2742 1501 2130 7603 -3153 7592 -3207 7888
- -2702 7730 -3015 1289 1597 7891 -2689 7733 -2977 1319 2249 1522 2135 7851 -2776
- 7897 -2663 7776 -2836 7623 -2988 1314 2152 7601 -3179 7575 -3015 1369 2286 1387
- 2108 7626 -3127 1339 2149 1169 1533 7773 -2939 1350 2173 7883 -2686 1409 2021
- 1375 1794 7791 -2831 7688 -2934 7686 -2937 7873 -2735 1212 1079 7799 -2865 7663
- -3098 1525 2185 7689 -2921 1214 1853 1379 1807 1487 1893 7788 -2894 7399 -3235
- 7810 -2864 1592 1796 1454 2201 1439 2257 1442 1835 1376 1974 7442 -3588 1386
- 2065 1447 2248 1531 2114 1343 1906 1125 1559 7755 -2933 1518 2180 956 2122 7783
- -2865 7809 -2806 7803 -2863 1443 1988 7671 -2931 1439 2148 1218 1966 1340 2082
- 1582 2010 7882 -2692 1363 2262 1284 2081 7689 -3004 7726 -3032 374 1078 7729
- -2878 7898 -2685 1241 2093 100 { m20} R 7823 -2797 1605 2037 1299 1984 7803
- -2848 1487 1830 7799 -2885 7892 -2691 7634 -3054 1423 2131 7890 -2691 7854
- -2772 929 1912 1188 2231 7770 -2941 1457 2211 7859 -2761 1387 1972 7825 -2818
- 7904 -2665 1273 2019 1262 2007 1286 1680 1381 1998 7258 -3783 7666 -3022 7455
- -3527 1476 2112 7904 -2654 7806 -2847 7566 -3117 7890 -2686 1487 1793 1361 2219
- 1264 2064 7811 -2809 1486 1390 1360 2200 1570 2039 7710 -3046 7868 -2720 7298
- -3416 7879 -2722 1381 2148 7751 -2981 7394 -2991 1436 2089 1318 2111 1391 1945
- 7907 -2668 1242 1982 1351 2097 7737 -2929 7859 -2763 1230 2241 7702 -3031 1221
- 1336 7780 -2920 1226 1314 1512 2181 7868 -2732 7858 -2717 7776 -2923 7853 -2700
- 7752 -2955 7512 -3029 1360 2278 7838 -2781 7832 -2777 1283 2047 892 1484 7813
- -2858 7850 -2778 1184 1870 7907 -2667 7841 -2773 7748 -2988 7766 -2903 7694
- -3082 1412 1966 1510 2141 7809 -2863 7775 -2914 7695 -2959 7825 -2832 7796
- -2843 1421 2273 7905 -2671 1464 2019 7891 -2699 7451 -3399 1234 1820 1298 2019
- 7673 -3071 1303 1775 7684 -3046 7819 -2797 7887 -2708 7680 -3119 6575 -3592
- 7601 -3270 100 { m20} R 7670 -2978 1424 1437 7892 -2694 7696 -2984 1482 2173
- 7822 -2816 7657 -3164 7887 -2703 1653 2000 7898 -2676 7663 -3076 7642 -3112
- 1392 2187 1114 1946 7832 -2816 1353 1789 7869 -2721 1229 1260 7684 -3056 7445
- -3226 7618 -2926 1834 1889 1264 2012 7613 -3154 1195 1804 1461 2009 7883 -2704
- 7873 -2682 7747 -2898 7618 -3203 7544 -3204 1391 2195 7788 -2908 1272 1774 1253
- 2071 7871 -2740 7556 -3051 1181 1988 1454 2162 1320 1699 1404 2147 1383 2322
- 7887 -2699 7876 -2730 7801 -2877 7838 -2806 7768 -2946 7844 -2794 1336 1722
- 7895 -2692 7559 -3364 1423 1503 1400 2069 1292 1976 1439 2263 7783 -2909 7759
- -2965 1474 1962 1666 2041 7888 -2704 1245 1841 7738 -3003 1362 1757 1327 1951
- 1554 2114 1285 1938 1286 2065 1577 2107 1399 2084 1826 1610 6862 -3421 7880
- -2720 7634 -2898 1306 1661 1095 1255 1254 1888 7798 -2888 7782 -2903 7325 -3379
- 7784 -2818 7799 -2797 1217 1816 7883 -2713 7883 -2682 7868 -2746 7841 -2782
- 7747 -2990 1271 1726 1447 2243 7389 -3209 7880 -2719 1372 1926 1572 2089 1538
- 2062 7775 -2931 1191 2009 1330 2273 7823 -2835 7742 -3000 7884 -2714 100 { m20
-} R 7866 -2748 7804 -2796 7579 -2948 7732 -2970 7824 -2825 1284 2147 1328 2093
- 7757 -2946 1361 2130 1373 1871 1542 2181 7699 -3082 7680 -3117 977 1659 1760
- 2017 7858 -2754 1146 1724 1155 1745 7905 -2669 7532 -3412 7393 -3451 1375 2287
- 1430 2159 7828 -2804 7774 -2835 7660 -3133 7851 -2781 1017 1835 7495 -3483 1147
- 2007 6923 -3235 1081 1564 1324 1949 1578 2170 7715 -3048 7814 -2847 1305 1458
- 1510 2096 7591 -3152 7855 -2761 7857 -2769 7845 -2780 1519 1812 1524 2045 7684
- -2973 1357 2297 7825 -2827 7824 -2828 7469 -3466 1499 2127 1293 2078 7594 -3130
- 7862 -2756 1188 1868 7889 -2704 1358 2298 7853 -2764 1247 1197 1440 2273 7790
- -2902 982 1431 1438 2069 1456 2248 1494 2237 7437 -3246 7685 -3045 1089 1575
- 7534 -3270 1056 1753 7895 -2653 7898 -2670 7783 -2884 1191 1936 1364 1976 1305
- 1714 7767 -2871 1202 1831 1411 2002 7903 -2669 7635 -3204 1504 1691 1519 2213
- 7830 -2822 1465 2171 7858 -2744 7895 -2687 7893 -2688 7871 -2716 1458 2193 7738
- -2927 1279 1955 1471 2039 1502 2148 7891 -2683 1255 1812 1413 1784 7376 -3584
- 1414 2310 7867 -2727 7875 -2730 100 { m20} R 7894 -2692 7865 -2709 7503 -3312
- 1609 2140 1581 2155 1396 2190 7860 -2735 7467 -3419 7746 -2921 7764 -2844 1228
- 1953 1377 2334 119 1046 1096 1494 1354 2153 1293 2139 1523 2030 7599 -3087 1351
- 1916 7870 -2735 1089 1734 1551 2187 7824 -2834 1451 2080 7789 -2899 1368 1537
- 1439 2098 7208 -3135 7502 -3451 7841 -2787 7622 -3244 1510 2110 7874 -2732 7489
- -3116 7631 -2837 1461 2236 1442 1768 7263 -3587 1118 1970 1439 2282 7581 -3193
- 7682 -3056 1386 2071 7431 -3453 7844 -2793 7775 -2919 1572 1154 1353 2113 1227
- 1736 7722 -2907 7797 -2868 7796 -2863 7281 -3033 1392 2247 7799 -2848 7829
- -2783 7485 -3372 7625 -3090 1496 1828 1143 1736 1440 1872 1463 2197 7898 -2669
- 1235 1881 7648 -3189 1274 1751 7841 -2799 7854 -2754 7888 -2699 7840 -2770 7856
- -2770 1379 2187 7717 -2963 7810 -2844 1219 1744 7845 -2745 7675 -3116 1431 2087
- 934 1555 1505 2174 1152 1135 1547 2164 1289 2187 1468 2050 7238 -3278 7685
- -3099 1629 1141 7507 -3052 7791 -2850 981 1865 1346 1810 7851 -2780 1415 2307
- 7835 -2810 1316 1961 1405 821 7858 -2765 1371 2183 1156 1658 7860 -2754 100 {
- m20} R 1541 2109 7696 -3093 7760 -2887 7795 -2884 7676 -3129 1481 2015 1088
- 1577 7665 -2989 7849 -2785 1440 2155 1435 2047 7872 -2714 7455 -3141 7819 -2839
- 990 1702 1419 1941 1591 1919 7385 -2960 7876 -2713 1461 1624 1441 2226 1231
- 1546 1356 1903 1314 2032 1417 2138 7849 -2776 2024 1824 1425 2304 1339 1595
- 1206 1771 7047 -3588 7901 -2654 1374 1772 1402 1987 1342 2058 7819 -2843 7896
- -2679 7815 -2851 1490 2080 7876 -2729 7894 -2636 7886 -2691 7771 -2942 1399
- 1961 7601 -3173 1419 2151 7693 -3083 1526 2182 7895 -2691 1553 1880 1539 2001
- 1427 2162 7808 -2866 7892 -2697 7632 -3140 1412 1787 1577 2156 1552 2018 1436
- 1820 7862 -2728 7885 -2708 1396 2193 1199 1898 1363 1477 7705 -3051 1516 1786
- 1384 2077 1215 1943 7849 -2784 1299 1642 7884 -2689 861 2139 7598 -3057 7898
- -2671 7731 -3019 7885 -2713 1183 1759 1343 2215 7906 -2669 1901 1859 7665 -3074
- 7897 -2687 7567 -2980 7896 -2687 7830 -2819 7598 -3080 7739 -3006 7671 -3137
- 7653 -3075 7672 -3109 7871 -2733 7838 -2808 1448 2263 7699 -2923 1811 1965 7816
- -2836 1318 2171 1301 2011 7795 -2861 1470 2162 100 { m20} R 885 1725 7840 -2793
- 7212 -3160 7840 -2783 7832 -2817 1545 1903 7905 -2659 7588 -3161 1747 1965 7764
- -2830 7794 -2895 1409 2045 7721 -3011 7784 -2914 1401 1897 7897 -2686 999 1813
- 1277 1691 1570 2075 7742 -2993 7851 -2770 7599 -3131 1344 1746 1501 2225 1285
- 1927 1202 1853 1432 1999 7703 -3080 732 1838 1572 2105 1420 2189 7795 -2837
- 1567 2133 1028 1885 1352 2200 7836 -2730 1353 2294 7527 -3421 7645 -3087 7797
- -2889 7836 -2802 1458 2066 1555 1829 1553 1913 349 1404 1062 2096 1513 2214
- 1237 1498 7806 -2825 7623 -3241 7687 -3099 1418 2008 1262 2043 7712 -3029 1247
- 1691 7727 -2963 1146 2054 7789 -2863 1496 1982 7888 -2704 1181 1899 993 1819
- 1472 2141 610 1211 1532 1539 1223 1574 1240 1419 1502 1620 7859 -2734 1208 1750
- 7750 -2984 1362 2011 1437 2006 7795 -2871 7755 -2950 7881 -2721 7853 -2776 7757
- -2970 1383 2168 1345 1853 1316 2152 1503 2039 7811 -2859 1364 2091 7885 -2712
- 1366 2220 7787 -2832 1211 2005 7814 -2855 7870 -2737 7899 -2683 1725 2013 7647
- -3153 1490 2235 1468 1956 7558 -3341 7895 -2689 1287 1749 1346 1769 7781 -2895
- 100 { m20} R 7661 -3156 1477 2226 1238 2042 1385 2219 7858 -2761 7836 -2810
- 1323 1926 1175 2039 1567 2135 1385 2187 1188 1991 1445 1956 1369 1979 1076 1950
- 7382 -3655 7734 -2998 7869 -2722 1386 1867 1290 2101 1144 1709 1024 2022 983
- 1827 7606 -3180 7827 -2811 7853 -2776 1300 1980 1479 1658 1473 2242 1488 2230
- 7900 -2671 977 1078 7627 -3194 7886 -2706 1412 2244 1214 1849 1383 1999 1501
- 1863 1016 1424 7575 -3057 7526 -3224 7866 -2732 1368 2263 7529 -3023 7614 -3118
- 1463 2194 7880 -2688 1492 2180 1138 1635 1546 2177 1450 1285 1421 2259 7589
- -3302 7909 -2662 7584 -3197 7829 -2812 1362 2006 7779 -2915 1499 2038 7841
- -2786 1244 2052 7606 -3173 7359 -3712 1249 2134 7553 -3027 7200 -3235 1395 2078
- 1020 2021 1513 2218 7793 -2852 7124 -3894 1479 2034 7673 -3069 1363 2175 7877
- -2719 7893 -2662 7692 -3095 7860 -2743 1338 2190 7774 -2909 1261 1735 7887
- -2705 7765 -2769 7594 -2948 7850 -2781 7779 -2874 1457 2201 7641 -3014 1573
- 2172 1502 2096 1315 1654 1503 2003 7829 -2825 7881 -2705 7793 -2846 1304 2031
- 1322 1929 7843 -2792 544 1204 1612 1820 7904 -2674 100 { m20} R 983 957 7281
- -3549 7872 -2739 7716 -2832 1442 2162 1289 1929 7543 -2913 7870 -2742 1564 2174
- 7899 -2670 1371 2083 1225 1885 1492 1826 1174 1653 1317 1782 1413 2274 7854
- -2774 1132 1972 1355 2241 1219 2165 1392 2027 1274 1965 7869 -2695 1350 2309
- 1336 1831 7742 -2962 7871 -2741 1235 2239 1241 1608 7818 -2843 7760 -2965 1350
- 1757 7900 -2677 1376 2234 1455 2159 1464 1577 1529 2054 1640 2102 7711 -3062
- 7875 -2675 7844 -2795 7903 -2669 7893 -2694 1438 2125 1438 1900 1163 1373 1109
- 1841 7678 -3119 7565 -3301 7866 -2750 7869 -2743 1307 1769 7757 -2817 7840
- -2788 1469 2239 1375 1521 1684 1303 1500 2001 1503 1588 7732 -3021 7880 -2690
- 1444 2077 7810 -2862 1457 2234 1415 2136 7893 -2694 7810 -2843 7565 -3007 7654
- -3169 7442 -3161 1702 1920 1207 2166 7875 -2700 7895 -2691 7691 -3050 7891
- -2689 1445 2225 1496 2130 1529 2116 7838 -2808 1356 2072 1568 2019 7772 -2901
- 1664 1806 1237 1932 7721 -3011 7854 -2768 7895 -2691 1375 2040 1636 1897 1393
- 2145 1447 2187 7829 -2777 1270 1789 1095 913 1567 2144 7771 -2924 1268 1834
- 1612 1995 1354 1904 100 { m20} R 7836 -2791 7571 -3267 1472 1800 7808 -2866
- 7874 -2722 1495 1767 1425 2218 1378 1936 1381 2144 1421 2279 7864 -2755 7816
- -2804 7847 -2788 1319 2121 7664 -3003 7634 -3073 1505 2165 1426 1881 7676 -3131
- 7818 -2761 7878 -2726 1462 2188 7884 -2714 7856 -2727 7756 -2837 1480 2119 7492
- -3234 1257 1788 1464 2172 1255 2185 7134 -3652 7468 -3363 1341 2337 7892 -2692
- 1411 1957 7867 -2746 1223 2044 7876 -2722 7774 -2876 7876 -2725 1849 1907 1536
- 2163 7657 -2963 1334 2093 7656 -3174 7731 -2990 7586 -2954 7584 -2934 1454 2243
- 1274 1938 7737 -3006 1235 2083 1430 2226 1065 2035 1282 1866 7854 -2774 1276
- 1967 1136 1850 1297 2038 1634 1701 7606 -2980 7568 -3274 7859 -2753 7843 -2763
- 1544 1968 1424 2014 1247 2059 7125 -4160 1394 2253 7730 -3015 7898 -2676 7197
- -3356 1289 1845 1189 1856 7802 -2819 7802 -2877 1455 1756 1403 2081 1438 2224
- 1114 1990 7713 -2999 7724 -3033 1396 2086 7610 -3151 1249 1877 7390 -3155 1325
- 1606 1489 2161 7621 -3245 1551 2183 1391 2012 7828 -2759 7901 -2665 7854 -2770
- 7905 -2670 7311 -3647 7844 -2795 7708 -3023 1455 2129 1054 1762 100 { m20} R
- 7878 -2724 7740 -2972 1408 1754 7856 -2772 1584 1909 7868 -2690 7846 -2768 1290
- 1694 1124 1949 1356 2116 1421 2278 1522 2082 7825 -2769 1085 1785 7849 -2785
- 7875 -2733 1526 2213 7897 -2684 1489 2174 1451 2001 7685 -3115 7907 -2617 1427
- 2045 1316 1823 7524 -3070 1442 1965 7879 -2712 7817 -2839 1250 1694 7738 -2944
- 7821 -2840 7699 -2926 1387 1995 7800 -2855 740 1930 1354 2195 1201 1630 1322
- 2065 1438 2139 7834 -2815 6957 -3157 1300 2234 7661 -3080 1266 1710 7892 -2697
- 1419 1870 7905 -2668 7827 -2800 7874 -2733 1015 1854 1423 1698 1475 2077 7831
- -2816 7808 -2853 7803 -2837 1497 2196 7690 -3032 1394 1978 7713 -3056 7902
- -2678 7826 -2830 1281 1548 7609 -2866 7871 -2738 1699 1998 1379 2248 1240 1762
- 7882 -2719 1584 2079 7587 -3234 1298 2002 7873 -2726 7240 -3329 1295 1554 1249
- 2024 1361 2028 7898 -2686 7833 -2816 1245 1698 1300 1710 1363 1481 7797 -2887
- 1589 2020 7856 -2761 7876 -2729 7815 -2851 1375 1926 7857 -2766 1218 1051 7754
- -2898 1314 1780 1419 2206 7761 -2954 1368 2271 7855 -2740 7805 -2832 1800 1935
- 1377 2071 1478 2198 7828 -2768 100 { m20} R 7868 -2726 7898 -2686 7812 -2858
- 787 1444 7884 -2709 1382 2116 7713 -3020 7768 -2940 1186 2131 1376 2275 1140
- 1985 1022 1775 1277 1993 1652 2053 7405 -3234 1243 1528 1387 2244 1388 1905
- 7190 -3592 7785 -2894 1390 1711 1559 1995 1222 1182 1441 2228 1598 2119 1257
- 1235 7776 -2931 1404 2175 7854 -2763 7904 -2652 7632 -3083 1497 2075 7826 -2829
- 7776 -2929 7513 -3406 7860 -2761 7876 -2698 7864 -2750 7677 -2932 7833 -2810
- 7612 -3157 7676 -3102 1174 1989 7885 -2705 1345 1715 7378 -3270 7844 -2749 1497
- 2208 1436 1989 7516 -3070 696 1529 7902 -2616 7907 -2665 1327 1970 7696 -3090
- 1290 2121 7489 -2927 1359 2022 7908 -2642 7899 -2677 7897 -2682 1495 1743 1431
- 2012 7568 -3189 1598 1793 7850 -2777 7739 -3005 1610 1820 7886 -2696 7476 -3365
- 1287 1792 7857 -2762 1238 1474 1827 1628 1447 2259 7840 -2772 1510 2220 1420
- 2155 1237 2042 7746 -2985 7835 -2813 1388 2150 7412 -3592 1720 1990 1483 2141
- 1213 1994 1419 2304 7478 -3345 7717 -3042 1616 2050 7707 -3067 1525 2179 7892
- -2697 7855 -2757 7878 -2725 994 1934 1415 1987 1312 1891 7528 -3245 1241 1361
- 100 { m20} R 7658 -3119 7873 -2729 1350 1685 7761 -2866 1366 1832 7634 -3074
- 562 1715 7454 -3023 7743 -2980 7872 -2659 1387 2091 1458 2159 1469 2192 7863
- -2757 7801 -2882 7584 -3317 1379 2175 7832 -2811 1223 1883 1389 1895 1371 1801
- 7899 -2672 7893 -2685 7868 -2734 7657 -2978 7800 -2884 1332 2214 7820 -2841
- 1385 1783 1472 1777 7589 -3117 7096 -3959 7863 -2755 1448 2108 7578 -3117 1472
- 2077 7894 -2687 1341 1978 7773 -2934 1309 1140 1154 2044 1397 2211 7385 -3077
- 1389 2097 7786 -2912 7702 -2858 7699 -3085 1484 2166 7673 -3060 7736 -3009 7517
- -3448 7820 -2802 1499 2232 7902 -2679 7849 -2784 1550 2186 7702 -3081 1352 1946
- 7708 -3069 7700 -3042 7819 -2845 7713 -2989 7734 -2958 7503 -3372 980 1428 7825
- -2823 1414 2293 1435 2296 7859 -2753 7756 -2919 1623 1889 7891 -2682 7781 -2905
- 1424 2184 7736 -2819 7809 -2769 7780 -2888 1278 2188 1445 2283 7777 -2920 7794
- -2894 1486 2212 7878 -2708 7863 -2757 1502 1680 1605 1874 7436 -3341 1473 2148
- 1388 2273 7571 -2981 1278 1603 7884 -2707 1402 2250 1410 2254 1411 1866 1219
- 2014 7581 -3293 1449 2121 7575 -3028 7838 -2802 100 { m20} R 1178 2005 7897
- -2675 1488 2189 1585 1886 7623 -3215 1424 2212 1431 2203 7898 -2646 1474 2154
- 7902 -2661 1358 2049 7823 -2820 7907 -2668 7742 -2928 7840 -2758 1514 2179 1102
- 2108 1487 2177 1320 1997 1303 2082 1509 2123 1428 2164 7836 -2809 7841 -2788
- 1410 1955 1654 2025 7877 -2721 1421 2251 972 1639 7851 -2780 7890 -2692 1592
- 2091 1469 2127 1268 2197 7567 -2872 7714 -3016 1268 1877 1345 2149 1606 2140
- 1222 1950 1274 2126 7404 -3634 1423 2126 2088 1377 1384 2044 1240 1916 1318
- 2274 1469 2218 48 { m20} R 7767 -2918 1302 2117 1373 1755 1544 2087 1382 2257
- 1526 2006 7764 -2911 1579 2152 1470 2041 1409 2142 7130 -3533 7844 -2793 7899
- -2655 7768 -2943 1385 2255 1338 1795 7902 -2672 7814 -2779 7814 -2829 7304
- -3874 7676 -3134 1335 1928 7840 -2802 7846 -2786 7712 -3018 1536 1651 7793
- -2817 1206 1681 1212 1740 7853 -2774 1582 1660 928 1294 7853 -2775 7889 -2700
- 1469 2080 7829 -2815 7728 -2854 7907 -2662 7771 -2887 7742 -3001 1486 2043 1454
- 1895 7670 -3104 7824 -2829 7909 -2664 1381 2087 1389 1872 7655 -3023 1565 2027
- 864 1064 7802 -2875 1358 1877 1619 1833 1582 1977 1453 2273 916 1882 1082 1724
- 1497 1613 1321 2029 7792 -2885 1619 2103 1291 2068 1136 1366 7786 -2913 1268
- 2203 1117 1753 7061 -3402 7804 -2801 1398 1919 1137 1700 1249 1628 7892 -2650
- 7666 -3153 1103 1664 1562 2029 1232 2127 7483 -3275 1466 2214 1362 2267 7540
- -2954 7904 -2672 7803 -2862 7894 -2683 7827 -2812 1462 2183 7883 -2688 1731
- 2051 1389 2164 1083 1792 7681 -3061 7562 -3325 1665 1070 1373 2128 1583 1905
- 1335 2135 7808 -2824 7178 -3300 1463 2178 7696 -2849 7793 -2871 100 { m20} R
- 7880 -2722 7612 -3210 7801 -2876 1503 1689 1056 1763 1342 1830 7888 -2699 7813
- -2792 1439 2251 7758 -2942 7858 -2729 7887 -2707 7668 -3084 905 1421 1206 1709
- 7872 -2728 1247 2003 1514 1984 933 1862 1503 2055 1554 2065 1312 2218 7772
- -2781 1467 2220 7791 -2865 7901 -2663 970 1332 1418 2139 1398 1771 7821 -2830
- 7890 -2695 7880 -2690 7527 -3413 7853 -2767 1098 1774 1919 1838 1310 2072 1465
- 2164 7777 -2887 7854 -2767 1257 1957 7908 -2661 7795 -2880 7787 -2893 1600 2140
- 1433 1808 7360 -3356 7628 -3212 7785 -2884 1243 1799 1470 2231 7474 -3060 7703
- -2943 1548 2073 7839 -2788 1371 2107 1057 1414 1512 2176 7686 -3113 7675 -3134
- 7672 -2908 1580 1938 7851 -2742 7425 -3211 7853 -2775 1405 2172 1170 1685 7788
- -2905 7271 -3235 7894 -2691 1606 2056 1627 2054 1530 1985 1264 1858 1415 2242
- 1254 1911 7833 -2775 7866 -2739 7907 -2661 1607 2110 1418 2274 7882 -2675 7879
- -2714 7757 -2933 7905 -2670 1536 2193 7636 -3214 1539 2065 1550 1901 7743 -2962
- 7828 -2791 952 1749 7790 -2901 7826 -2806 7841 -2782 7902 -2664 7747 -2862 1298
- 2007 7823 -2837 7788 -2894 100 { m20} R 1559 2058 7879 -2705 7661 -3131 1429
- 2276 1297 2059 1338 2169 7767 -2891 1385 2189 7823 -2836 7868 -2722 1740 1533
- 7752 -2977 1000 2072 1435 2088 7869 -2713 1355 1618 1362 2196 7856 -2771 1332
- 1921 7770 -2933 7832 -2819 7880 -2709 7861 -2759 1440 2160 7851 -2755 1431 1626
- 7851 -2704 7854 -2773 1616 1736 1385 1852 1194 1873 1390 1918 7480 -3529 7491
- -3220 7681 -2988 7307 -3296 7785 -2903 7785 -2876 7881 -2721 7858 -2762 1380
- 2191 7862 -2756 1417 2233 7800 -2879 7828 -2809 1421 2082 7642 -3154 1550 2171
- 7882 -2714 7868 -2746 1554 2025 1264 1812 7898 -2660 7803 -2864 7767 -2918 7493
- -3446 1352 2042 1536 1927 7688 -3012 7622 -2891 1239 1456 1360 2310 7804 -2865
- 7829 -2822 1490 2234 7827 -2790 7537 -3358 7236 -3234 7843 -2756 7548 -3352
- 1297 1922 1364 2067 7869 -2744 1500 2178 7764 -2885 1482 2132 7835 -2741 1323
- 2229 7868 -2727 7878 -2714 1567 2100 7518 -3229 1298 1941 1489 2078 7820 -2833
- 1222 1788 7889 -2695 1437 2033 1648 1866 894 1672 7908 -2634 7508 -3472 1419
- 1805 7525 -3253 7895 -2689 1425 2278 7810 -2797 1252 1630 1178 1908 7671 -3012
- 100 { m20} R 7794 -2794 1140 2125 1030 1412 807 1556 7850 -2774 7903 -2675 7901
- -2675 1625 1486 7893 -2651 7068 -3512 1404 2020 1415 2300 1439 2138 1176 1821
- 7897 -2682 1379 1930 1434 2016 1356 1913 1268 2126 7799 -2848 7890 -2697 7863
- -2755 1435 1525 7841 -2783 7331 -3511 1478 2136 7825 -2821 1044 1999 1274 1926
- 1296 1863 1435 1989 7866 -2738 1349 1933 1129 2169 1497 2197 1378 2176 1389
- 1912 7784 -2851 1607 1682 1182 2047 1341 2325 1177 2062 7550 -3387 7815 -2826
- 1276 2010 1369 1871 1345 2175 1231 2085 1456 1625 1258 1873 1378 2017 1150 2117
- 1431 2175 1128 892 7704 -2853 1464 2242 7904 -2671 1429 2113 7818 -2848 7669
- -3122 7291 -3216 1418 2029 7742 -2987 1286 2029 7818 -2799 7780 -2861 7677
- -3008 7544 -3300 7809 -2829 7771 -2942 7875 -2688 7608 -3021 -160 1700 7768
- -2935 7749 -2980 1405 1961 1039 1311 1583 1941 7811 -2837 1599 2095 1516 2083
- 1560 2112 1526 2196 7820 -2834 7908 -2640 7591 -3299 7598 -3193 7829 -2807 1322
- 2059 7728 -2845 7853 -2747 7907 -2665 1336 1994 7768 -2948 7864 -2746 7727
- -3031 1531 2159 7892 -2687 7848 -2754 1592 2108 100 { m20} R 7467 -3424 7849
- -2784 7479 -3412 7856 -2717 1190 1872 1434 2095 1166 1941 7814 -2807 7728 -3028
- 7617 -3248 7787 -2898 7583 -3281 7673 -3131 1427 2256 712 1862 7877 -2728 7578
- -2998 1492 2081 7788 -2907 7797 -2872 1443 1611 1098 1443 7828 -2805 1385 2361
- 1246 1743 7758 -2965 1376 1807 7853 -2759 7327 -3361 7900 -2681 1284 1596 7683
- -3113 1258 2026 1527 2178 7616 -3084 7805 -2873 7774 -2929 7668 -3013 7755
- -2965 7852 -2765 7799 -2725 7847 -2774 7884 -2715 1546 2162 1366 1705 7483
- -3523 7492 -3036 1494 2040 7817 -2850 1653 2114 7890 -2696 7828 -2814 1849 1437
- 7872 -2738 7845 -2792 1420 2210 973 1305 1383 2232 7864 -2720 1932 1766 1446
- 2120 1456 2039 916 1462 1420 2311 7708 -2906 7906 -2670 7908 -2664 7467 -3556
- 1420 2025 7889 -2703 7600 -3245 7781 -2916 1200 1789 1339 1823 7408 -3673 7904
- -2665 7901 -2671 1474 2189 7781 -2871 7846 -2760 1438 2231 1407 2298 1324 1646
- 7883 -2702 1130 1698 7746 -2863 7901 -2666 995 1633 1474 2224 7827 -2792 7885
- -2708 1310 2182 1392 1884 7859 -2765 7629 -2859 7671 -3082 1428 1212 871 2077
- 7749 -2984 1511 2162 100 { m20} R 7462 -3543 7839 -2796 1289 2028 7692 -3099
- 1405 1995 1291 1493 956 1148 7886 -2708 1292 1880 7868 -2729 7271 -3174 1008
- 1406 1489 2205 7476 -3537 1219 2140 7660 -3144 7751 -2919 1421 2077 1197 1815
- 1260 1930 1390 2021 7767 -2930 1260 1467 7890 -2701 7885 -2655 1362 2298 1376
- 2065 1288 2012 7878 -2725 7590 -3116 985 1281 7695 -3073 7739 -2796 1433 2246
- 7825 -2829 1419 2050 1405 2090 7867 -2748 7590 -3193 1263 1806 7693 -3030 1298
- 1870 1346 2095 1507 1804 7670 -3145 1332 1578 1400 2027 1384 2217 1311 2170
- 7891 -2698 1377 2108 1507 2228 7829 -2823 1084 1233 1326 2297 7743 -2980 7755
- -2959 7851 -2781 7716 -3036 7896 -2690 7852 -2778 1346 1977 7899 -2684 1184
- 2040 7662 -3146 1471 2229 1431 2169 1234 2049 1484 2046 1188 1656 7801 -2862
- 7825 -2813 7894 -2687 6971 -3399 975 1799 1181 1703 7633 -2820 1536 2150 7906
- -2662 1583 2102 1382 2244 7804 -2875 1487 2224 1166 1987 7890 -2702 1269 1572
- 1478 1816 7828 -2826 1464 2076 7874 -2711 1663 1937 7819 -2841 7703 -3054 1424
- 2177 7855 -2747 7886 -2705 1514 2032 1432 2206 7834 -2790 7735 -2908 100 { m20
-} R 1461 2234 7717 -3044 7733 -2989 1366 2073 7803 -2766 1463 2027 7431 -3541
- 6667 -3303 1616 1711 1461 2229 7906 -2671 1323 2175 7810 -2857 7793 -2850 1359
- 1896 1348 1829 1405 2174 7347 -3138 1473 1844 1787 1999 1284 1978 1314 2072
- 1317 2016 7434 -3411 7651 -3017 7673 -3132 1544 1663 7881 -2720 1175 1814 1640
- 1984 7567 -3332 7671 -2996 7869 -2726 1657 2037 1534 2139 1313 2070 1448 2009
- 7282 -3913 7795 -2869 1519 2094 7890 -2681 1220 2115 1394 1949 1474 2236 7867
- -2748 7572 -2940 1365 1687 1433 1992 7444 -3476 927 1232 1503 1979 7548 -3369
- 1381 2037 7817 -2830 7834 -2793 7698 -2904 1798 1991 7879 -2723 7847 -2788 7835
- -2789 1103 1820 1388 2024 1177 1522 7315 -3354 1404 2027 1526 2204 7729 -2920
- 7848 -2770 1501 2097 1379 1991 7842 -2734 1266 2198 7839 -2793 7758 -2902 7867
- -2703 1347 2142 7820 -2834 7584 -3070 1457 1101 1647 1824 1342 2212 7526 -3304
- 7747 -2975 7562 -3296 1447 2025 7784 -2909 1502 2075 7693 -3009 1206 1926 7343
- -3710 7899 -2684 7861 -2752 1545 2077 1332 2327 1255 1722 7752 -2965 7473 -3071
- 7681 -3124 7815 -2837 7693 -3023 100 { m20} R 1528 2176 7805 -2830 667 1604
- 1371 2219 1427 2163 1311 2106 7750 -2971 1136 2110 7847 -2785 1529 1902 7785
- -2889 7860 -2717 7641 -3006 1213 1941 7900 -2676 1539 1972 7564 -3316 1143 1707
- 7723 -3038 1398 1902 970 1647 1367 2188 7717 -2991 7793 -2867 1264 1945 7709
- -3062 7540 -3360 7832 -2784 1301 2313 1427 1382 1276 2198 1362 2346 7503 -3176
- 7648 -3181 7846 -2779 1448 1903 1491 2182 7808 -2832 7715 -3048 1423 1871 7639
- -3160 7870 -2723 1443 2183 1382 2242 1433 2198 1644 2081 1378 1950 1303 1719
- 7688 -2912 1357 1968 1555 1849 7753 -2978 7864 -2746 7844 -2768 7829 -2818 6022
- -3490 7782 -2772 1452 2165 7892 -2694 7651 -3160 1524 1761 1274 1400 1399 1820
- 1347 2260 1046 1755 983 1954 1161 1683 7854 -2775 7842 -2782 7840 -2763 7829
- -2803 1266 2007 1191 1954 1228 1941 7673 -3056 7816 -2784 7793 -2895 1267 1903
- 7196 -3143 7653 -2973 1512 2169 1420 2300 1586 2091 1353 2115 1467 2170 7271
- -3253 7838 -2797 7848 -2786 1288 1876 1099 1210 1388 2224 7519 -3200 1600 1840
- 1471 2002 7860 -2715 1303 1757 1510 1979 7701 -3075 1480 1705 7616 -2927 100 {
- m20} R 7591 -2911 1181 1757 7890 -2646 7858 -2681 7885 -2709 7785 -2906 1406
- 1928 1493 1985 1357 2358 1405 2067 1353 1920 7752 -2903 7772 -2932 1446 2209
- 1030 1189 7903 -2668 7563 -3360 1444 2067 7904 -2658 1428 2267 7763 -2935 1390
- 2080 1469 2159 7807 -2844 1568 2137 1263 2005 1517 1955 7901 -2674 1585 2043
- 7861 -2748 7427 -3324 1402 1858 1484 1230 7866 -2719 1298 2118 7878 -2724 1415
- 2293 1580 1989 7784 -2885 1464 2149 7536 -3066 7658 -3011 7882 -2687 1187 1480
- 7813 -2858 7891 -2689 1154 1399 1499 2068 7766 -2916 7779 -2925 7833 -2807 7675
- -2985 1323 2049 1230 2207 7670 -2987 7868 -2743 1374 1778 1492 2213 7826 -2831
- 1250 2006 7548 -3384 7585 -3051 7235 -3681 7864 -2734 7843 -2782 1343 1954 7868
- -2730 1357 1954 1491 1423 7828 -2815 1343 2109 1494 2096 1402 2081 1023 1522
- 7896 -2666 7847 -2779 1164 2197 744 1288 7904 -2671 7452 -3513 7646 -3152 7789
- -2903 1312 1902 7838 -2797 1549 2179 7801 -2835 7849 -2781 7602 -3187 7614
- -3115 7796 -2891 7908 -2648 7718 -2984 996 1245 7544 -3154 1522 2067 1407 2114
- 7827 -2820 7889 -2673 7764 -2957 7545 -3373 100 { m20} R 7319 -3380 7656 -3152
- 7887 -2670 7729 -2973 1540 1726 7730 -2951 1329 2164 7888 -2696 1180 1725 7894
- -2694 1463 1893 7909 -2662 7832 -2820 505 1538 7788 -2907 7821 -2664 1433 1999
- 1221 2186 7896 -2687 7543 -3270 7909 -2660 1378 1959 7812 -2856 7705 -3072 7823
- -2750 1201 2016 7684 -3101 1326 2251 7906 -2649 1331 2039 7742 -2998 7815 -2842
- 1268 1476 1403 2119 1540 1793 1661 1948 1252 1815 1610 2102 1557 2095 1379 2184
- 7849 -2781 7906 -2661 7835 -2805 7708 -2925 1439 2263 1516 2060 1432 2151 7894
- -2685 1403 1821 7609 -2948 1358 2060 7830 -2817 1591 2160 1410 2116 1421 2167
- 7804 -2870 1139 1187 7753 -2977 1111 1294 1242 2154 7811 -2861 1030 1720 1458
- 2226 7893 -2695 7679 -3043 1255 1829 1400 2138 1502 2122 1217 1771 555 1551
- 7603 -2859 7693 -2953 1085 1645 7802 -2876 7574 -3068 7481 -3466 1554 2178 1152
- 1399 1364 1924 1451 1987 7900 -2659 956 1666 1153 1320 1567 1896 1410 2325 7848
- -2774 1366 2151 7275 -3636 7790 -2903 7784 -2897 7718 -3027 1293 2004 1291 1998
- 1350 2072 1406 2158 7605 -3272 7879 -2722 1448 2193 7757 -2861 7415 -3647 100 {
- m20} R 631 1415 1215 2123 1291 1794 1243 1824 7907 -2665 7481 -3519 7883 -2711
- 1202 1482 1177 1372 7838 -2773 7695 -2998 1123 1810 1381 2075 7592 -3291 7776
- -2920 1253 2017 1060 1464 7715 -3047 1721 1699 7907 -2667 1425 1627 7891 -2699
- 7798 -2878 1208 1965 1197 2024 7765 -2939 1471 1971 7885 -2696 7676 -2916 1658
- 2083 7784 -2885 1444 2233 1388 2281 1508 2107 1284 2098 1464 2241 1355 2158
- 1260 1798 7736 -3013 7732 -2977 1074 2044 1410 2033 7789 -2816 1267 2138 7750
- -2856 1510 2009 1584 1770 1423 2162 7553 -2947 1744 2029 1384 1617 7820 -2826
- 7789 -2897 7792 -2878 1410 2011 7759 -2948 1454 1949 7898 -2671 1387 1699 1421
- 2148 1368 1871 1350 1912 7783 -2872 7639 -2951 1339 1759 1302 1908 7798 -2833
- 7750 -2965 695 1791 7766 -2940 7890 -2702 7712 -3001 7545 -3372 1392 2255 7832
- -2818 7845 -2773 7833 -2815 1625 1655 1379 1847 1363 2303 7759 -2937 7876 -2728
- 1519 2115 7740 -2937 7816 -2794 1559 2043 1447 2226 7842 -2798 7689 -3031 7771
- -2934 1380 1889 7749 -2887 750 1858 1378 2124 1383 2061 7796 -2892 1425 2272
- 7852 -2777 7744 -2945 1431 2164 100 { m20} R 1306 2117 7690 -3028 1475 2249
- 1527 2048 7802 -2844 7629 -3083 7899 -2677 1392 2086 1516 1942 7863 -2748 7721
- -3019 944 1520 1533 2149 7817 -2806 1303 1629 7896 -2690 1360 2055 7867 -2749
- 7839 -2804 7800 -2770 7753 -2928 7861 -2759 1448 2216 7708 -3032 1402 2239 1406
- 2177 915 1488 1356 1980 7424 -3461 1275 1674 7887 -2704 1697 1983 7745 -2908
- 7883 -2694 7852 -2776 1463 2198 7813 -2838 1426 1893 1520 2153 7785 -2904 732
- 1605 7709 -3048 7729 -2893 7768 -2934 7767 -2942 7883 -2715 1135 1985 7748
- -2965 1211 1854 1444 2118 1263 2035 1296 1937 7883 -2714 7815 -2806 7828 -2804
- 7859 -2755 1487 2077 7404 -3098 1295 1743 7843 -2793 1369 1958 875 1991 1306
- 2230 7268 -3157 1660 2012 7827 -2780 7772 -2882 7777 -2905 7559 -3160 1237 1936
- 7795 -2885 1519 2192 7705 -2927 7250 -3485 7893 -2691 1155 1641 7457 -3281 7795
- -2870 1288 1708 7884 -2704 7893 -2667 1817 1701 1518 1980 7646 -3192 7816 -2849
- 1294 1876 7303 -3227 7864 -2751 7880 -2714 7675 -3089 895 1123 1401 1541 7908
- -2666 7700 -3000 7868 -2736 1270 1786 7906 -2670 1005 1673 1410 1905 1414 2292
- 100 { m20} R 7770 -2833 7301 -3527 1312 2152 7857 -2769 7696 -2996 1343 2319
- 1438 2132 1553 2148 1531 2189 1248 1856 1515 2041 7903 -2657 7720 -3044 1442
- 1968 1611 2010 1501 2085 1442 2235 7431 -2960 1543 1774 7790 -2819 7795 -2833
- 7717 -3038 1421 2086 7452 -3100 1234 2020 1419 2312 7636 -2910 7706 -3072 1233
- 1937 7654 -3158 1463 2110 1347 1999 1531 2005 1488 1914 1053 1586 936 1516 7890
- -2698 7851 -2777 7842 -2797 1400 2314 7769 -2928 1253 2124 7731 -3013 7687
- -3032 1428 2276 7471 -3284 1168 2103 1313 1994 1299 2136 1307 1706 7731 -2992
- 7675 -3014 7483 -3239 7897 -2684 7639 -3205 7801 -2866 1332 1875 7903 -2664
- 1283 1676 1299 1665 7886 -2708 7888 -2702 7250 -3166 7635 -3195 7904 -2662 7851
- -2779 7890 -2696 1117 1355 944 1778 1381 2316 1392 1074 1508 2082 1572 2011
- 1735 2035 1262 1898 1407 2057 1151 1924 7631 -3210 1038 1825 7904 -2672 7882
- -2701 7909 -2664 7905 -2655 855 1845 941 1532 7845 -2792 1451 2003 7816 -2851
- 1106 2098 1539 2151 1542 2022 7597 -3230 7783 -2862 7800 -2795 7874 -2733 1260
- 2217 7884 -2698 1299 1170 7846 -2780 1155 1606 100 { m20} R 7836 -2811 7883
- -2715 1125 1913 790 1724 1550 2057 1391 2162 7884 -2714 7798 -2880 1425 1981
- 1300 1924 1409 2175 7775 -2933 1264 1738 1381 2153 1239 1971 1406 2269 7624
- -3087 7832 -2800 7859 -2747 1675 2030 7689 -3017 1680 2030 1221 1988 1124 1811
- 7626 -3059 1269 768 7754 -2916 7681 -3008 7835 -2811 7650 -3087 7816 -2793 1370
- 2231 7654 -2965 1552 2179 1378 2177 1175 2044 7875 -2726 7794 -2861 1291 1938
- 7850 -2760 7800 -2885 7870 -2675 1359 1938 7901 -2679 1152 1562 7846 -2787 7484
- -3001 1401 2011 7862 -2754 7883 -2691 1525 2082 7629 -3131 7685 -3116 7803
- -2797 7728 -2845 1422 1886 7837 -2780 1167 1879 1575 1587 7198 -3986 7665 -3131
- 7622 -3109 7854 -2771 1320 2211 1436 2070 1823 1695 806 1445 7851 -2780 7456
- -3544 7053 -3161 1272 2031 1194 1952 7430 -3540 7851 -2768 1514 2082 7734 -2854
- 1597 1607 7844 -2732 7657 -2945 7880 -2721 1438 2224 1358 1776 951 1851 1314
- 1119 1477 1976 1332 1909 1255 1912 1305 2209 7779 -2915 1598 2096 1331 2068
- 7819 -2843 1413 1811 1285 2183 1632 1539 1242 1969 1412 1807 1111 1906 1203
- 1684 1309 1849 100 { m20} R 7885 -2700 1264 1988 7686 -3099 1380 2262 1013 2126
- 7727 -3005 7860 -2750 1373 2162 1341 2038 1553 1310 1446 1938 7891 -2689 1383
- 2214 7776 -2858 7715 -3042 1371 1439 1317 2145 7860 -2758 7845 -2780 7789 -2906
- 7814 -2832 7497 -3468 1135 1605 854 1595 1465 2120 7804 -2808 1342 1766 7875
- -2730 7872 -2730 7740 -3004 7692 -2882 7278 -3541 7675 -2975 1455 2225 1371
- 1261 1396 1612 1532 2159 1077 1837 1219 1925 1198 1897 892 2057 1453 2276 7820
- -2844 1424 1991 7726 -2987 7820 -2791 1460 2190 1488 2006 1291 1892 7662 -3064
- 7849 -2777 7856 -2768 7634 -3064 7832 -2803 1521 2126 1480 1906 1410 2287 1382
- 2066 7894 -2685 1210 1933 7745 -2994 1536 2182 7692 -2931 7416 -3100 7898 -2672
- 7862 -2746 7803 -2870 1318 1941 7837 -2796 1442 2258 1418 1979 7859 -2730 886
- 1802 7195 -3177 7895 -2668 7753 -2943 7850 -2777 1473 2072 1330 1942 1299 1874
- 7687 -2817 1419 1794 7698 -3089 7385 -3657 1396 2121 7822 -2837 7867 -2739 7624
- -3031 694 1510 1356 1820 7884 -2714 1532 2102 1366 1849 1258 1919 1391 2226
- 1376 2081 1515 2047 1412 2142 7807 -2857 1332 2240 100 { m20} R 1475 2028 7686
- -3073 1407 1904 7908 -2658 7884 -2713 7897 -2686 7773 -2902 1210 743 1417 2230
- 7866 -2726 7773 -2796 1132 1578 1253 1339 7863 -2757 1411 2132 7653 -3050 1401
- 2081 7842 -2796 1407 1654 7732 -2971 7893 -2673 7704 -3062 1659 2042 1305 1686
- 1368 2093 7700 -3054 1103 2063 1036 1633 840 1756 7896 -2687 1346 2334 7585
- -3314 7867 -2729 1380 1818 7890 -2698 7773 -2923 7641 -3203 7819 -2812 1429
- 1574 1650 2107 7637 -3149 1282 1950 1082 1752 7862 -2758 7840 -2794 1120 1673
- 7862 -2758 1728 2016 1392 1872 801 1822 7852 -2778 1367 1733 7852 -2778 1369
- 1786 1336 1930 1288 2226 1274 1508 1467 2039 7372 -3062 1499 2031 1459 1824
- 1456 2091 7672 -2930 1479 2040 1729 1938 1360 1762 1428 2170 1541 1843 1463
- 2230 7818 -2841 1153 1943 1657 2103 1416 2093 7863 -2756 7737 -2940 1120 1591
- 7690 -3102 1371 2325 1448 2066 1161 1495 1403 2112 7636 -3109 7880 -2712 1198
- 2016 7785 -2897 1471 2221 7809 -2856 7654 -3175 7844 -2749 1413 1936 1544 2039
- 1419 2039 7845 -2792 1138 1901 1741 1823 7887 -2706 7795 -2858 1282 2132 1509
- 2136 1389 2111 100 { m20} R 7897 -2689 1122 1712 1599 1913 1287 2021 7601 -3246
- 536 1896 7876 -2730 1515 2075 7881 -2714 7681 -3087 7454 -3386 1292 1734 7276
- -3004 1247 2176 7863 -2727 1425 2222 1301 1288 1167 2082 7652 -3110 1469 1919
- 1320 2265 7716 -3042 1263 1648 7875 -2730 1312 1580 7813 -2854 7893 -2689 1415
- 2155 1770 1997 1624 1782 1447 2007 1400 1905 7593 -3291 1422 1688 1437 2012
- 7778 -2837 7292 -3524 7772 -2931 7567 -3144 980 1459 1337 2102 7860 -2758 1194
- 1838 1108 1917 1214 2095 1103 1588 7657 -3172 1480 2109 1556 2006 1292 2065
- 1165 2020 1178 1891 1571 1774 7839 -2760 1044 1814 7437 -3264 7890 -2697 1557
- 1816 7850 -2783 916 1859 1446 2137 1379 2007 7886 -2687 1164 1661 1371 1886
- 7774 -2936 7734 -2907 7473 -3005 7837 -2807 1394 2071 7809 -2830 1447 2124 7463
- -3437 1596 2143 1071 835 7866 -2751 1537 1867 1291 2201 1055 2057 7586 -3216
- 1578 2123 7803 -2875 7863 -2755 886 1329 7378 -3714 1278 2170 7631 -3013 1289
- 2167 7680 -3125 7509 -3179 1394 2216 926 1506 1504 2166 7742 -2980 1393 2025
- 7602 -3281 1856 1457 7706 -2799 1744 1973 1267 1712 100 { m20} R 7877 -2659
- 1325 1828 7750 -2978 1340 2124 1343 2286 7710 -3047 7709 -2873 7743 -2767 1232
- 1820 7269 -3103 7901 -2677 7868 -2700 1528 2194 1287 1860 966 1707 7876 -2728
- 1220 1483 1503 2016 1549 2058 7577 -3334 7687 -3065 7694 -3093 7718 -3045 1416
- 2300 7622 -3041 1516 2188 1432 2058 7765 -2935 1466 2017 7870 -2737 1406 2152
- 1481 2100 1367 2303 7881 -2666 7824 -2830 1614 2058 1237 1556 7716 -2951 7475
- -3119 1530 2050 7774 -2914 1292 1178 7784 -2902 1179 2052 1534 1862 884 1455
- 797 1939 1443 2050 7710 -2990 1201 1807 7790 -2880 7901 -2680 1469 2234 7908
- -2664 7538 -3106 1305 2056 1584 2148 7517 -3135 7849 -2777 1262 1846 1512 1987
- 1506 2138 7792 -2896 7623 -3147 1610 2100 1320 1759 7592 -3227 7894 -2694 1244
- 1526 1263 2144 1347 2202 7868 -2659 7680 -3020 1371 2313 7737 -2982 1302 1526
- 1550 2148 7811 -2860 7756 -2944 7819 -2843 1350 2203 1408 2012 1263 2230 7802
- -2859 1357 1874 1482 2057 1296 1850 1346 1406 7752 -2979 1142 1829 1039 1933
- 1280 2049 7839 -2790 7880 -2721 1506 2173 7865 -2751 7718 -3010 7826 -2828 7823
- -2826 7783 -2916 100 { m20} R 7567 -3177 1290 1822 1268 1972 1657 1710 1344
- 2320 7644 -3064 1193 1896 1338 2075 7504 -3016 7686 -2997 7831 -2785 7876 -2710
- 1456 2268 1332 2042 1352 2180 7785 -2897 1706 1925 1101 2031 7579 -3328 1455
- 2249 7259 -3721 1481 2193 1499 2043 1249 2210 1037 1200 7568 -2980 7840 -2799
- 7697 -3010 7552 -3186 7860 -2739 1301 2061 7881 -2710 1313 1979 7533 -3338 7733
- -2908 7766 -2951 7857 -2749 7708 -3032 7748 -2940 1765 1987 1355 1496 1071 1704
- 1311 1986 802 1639 1427 2150 1141 1356 7893 -2695 7767 -2949 7735 -2958 1256
- 2189 7790 -2870 1392 2223 7585 -3225 1788 1983 7864 -2754 7783 -2908 1424 2271
- 7446 -3304 7818 -2847 7706 -3053 1322 2072 1420 2197 1386 2138 7603 -3052 7740
- -2989 1277 1537 1411 2217 2121 1563 1652 1659 7705 -3047 1109 2023 7578 -3271
- 1349 2144 1419 2199 7891 -2699 7879 -2717 7906 -2666 7821 -2823 1242 2104 1417
- 2209 7787 -2907 926 1392 7493 -2948 7795 -2891 7640 -3016 1637 2073 1409 2272
- 1664 2078 1459 2069 7206 -3536 7748 -2839 7712 -2952 7758 -2843 7465 -3312 7355
- -3476 1389 1992 1603 1780 7887 -2693 7857 -2768 1331 2199 100 { m20} R 7832
- -2807 7828 -2824 1453 2234 7673 -3087 1424 2142 7392 -3149 1595 2000 7736 -2997
- 7595 -3126 7906 -2668 1483 2220 978 1916 7902 -2662 1647 2048 1531 1952 1463
- 2133 869 1292 7821 -2796 1525 1724 7903 -2673 1337 2179 1280 1865 1362 1994
- 7575 -3052 1481 1789 7899 -2682 7866 -2712 7853 -2769 1360 2116 7634 -3195 7070
- -3535 1420 2293 7843 -2781 1439 2246 7765 -2951 7673 -3133 1204 1958 7880 -2672
- 7755 -2862 7517 -3180 7807 -2865 7835 -2787 7877 -2728 1483 2180 7109 -3263
- 1130 2281 7798 -2882 1599 2086 7649 -2848 1349 1760 7791 -2793 7877 -2727 7806
- -2872 1381 2062 1445 2121 7659 -3037 1406 1499 7904 -2668 7838 -2798 7837 -2752
- 1210 1943 1313 2245 7830 -2822 1535 1903 7554 -3345 7900 -2667 1208 1951 1298
- 2029 7746 -2982 1582 1998 1436 2111 7657 -3170 7843 -2795 7835 -2814 1565 2084
- 7809 -2855 7813 -2839 7688 -3076 1526 2175 7812 -2837 7679 -3069 7899 -2683
- 1468 1591 7848 -2787 1344 2090 1371 2035 7496 -3283 7682 -3000 1367 2197 7905
- -2671 1371 2153 7827 -2792 7760 -2964 1378 1922 7840 -2792 7699 -2983 7640
- -3178 989 1931 1426 1844 1525 2149 100 { m20} R 1603 2070 1230 1764 7800 -2863
- 1377 1622 7826 -2828 1389 1658 7526 -3279 7843 -2796 7879 -2716 1364 2237 7895
- -2687 7883 -2717 1446 2188 1368 1998 7297 -3229 7875 -2732 7698 -3048 1665 2081
- 1250 1901 1502 2026 7898 -2678 7793 -2755 1242 1556 1363 1889 1651 2004 7803
- -2801 1616 1950 7882 -2717 1695 1594 7824 -2820 7863 -2749 1337 1269 1563 1880
- 1344 1911 1289 2208 1345 2288 7881 -2717 1406 2286 7595 -3283 1420 2236 7807
- -2815 1204 1967 1460 2203 7851 -2780 7874 -2718 1583 2130 847 635 7868 -2689 48
- { m20} R 7636 -2986 740 1542 7444 -3040 1431 1802 7906 -2648 7509 -3316 7785
- -2896 7824 -2805 7467 -2986 7845 -2791 1425 2154 7888 -2699 1491 2122 7861
- -2753 1152 1862 7793 -2890 7453 -3057 7723 -3021 1319 2082 1262 1688 1369 1911
- 7822 -2807 1592 2142 1573 1897 1205 1746 1458 2018 1379 2100 7877 -2728 1303
- 2197 1837 1853 7865 -2747 1322 1749 7837 -2807 7888 -2703 1815 1969 7814 -2856
- 1147 1938 1077 1444 7578 -3175 7824 -2780 7793 -2890 7693 -2961 7904 -2673 1368
- 2364 7787 -2892 1606 1930 7900 -2681 1493 2223 1183 1100 7866 -2748 7908 -2664
- 7899 -2664 1264 1832 1233 2206 7752 -2892 1262 1803 1688 2086 1460 2216 1120
- 1844 1240 1983 7866 -2694 7623 -3146 7653 -3029 7872 -2737 1215 1510 7844 -2780
- 1433 1806 1433 2138 1196 1852 6920 -3705 1251 1903 1357 2140 1378 1837 7597
- -3245 1618 1990 7791 -2852 1219 1870 7820 -2842 7634 -3218 1360 2162 7545 -3031
- 1581 2062 1306 2088 7871 -2712 7619 -2990 1485 2127 7890 -2702 1515 1933 7650
- -3101 1505 2063 7830 -2779 7730 -3023 1464 2086 1310 1578 7423 -2972 7694 -3078
- 7798 -2876 1470 2166 7902 -2659 1222 2145 100 { m20} R 1299 2106 1667 2004 1557
- 2121 1305 1792 7869 -2738 7817 -2848 1045 1685 1060 1404 7903 -2675 1708 1941
- 1385 2127 1282 2046 7838 -2806 7790 -2904 1140 1471 894 1781 7888 -2688 1409
- 2233 7740 -2826 7854 -2767 1414 2091 1303 1931 1373 2095 7882 -2680 7888 -2694
- 767 1601 1275 2083 1106 1787 7722 -3041 7799 -2820 1479 2212 1284 2011 7747
- -2969 1335 2018 1212 1929 7878 -2718 1360 2230 7870 -2741 7642 -3194 7848 -2774
- 7692 -3009 7895 -2692 892 1750 1531 2087 1623 1842 7888 -2706 7456 -3333 1295
- 1880 7751 -2864 1345 1741 1212 2112 7559 -3242 7837 -2810 1314 2001 1323 1910
- 7585 -3134 7757 -2895 1339 1907 7906 -2659 7730 -2955 6965 -3265 1510 2111 7908
- -2663 7237 -3642 7881 -2701 7646 -2999 7646 -3137 1413 1957 1445 2225 1464 2209
- 376 1340 1484 2109 7538 -3177 7798 -2876 1335 1977 7800 -2869 7692 -3045 1785
- 1857 1123 1843 1348 2059 1568 2134 7822 -2806 7662 -3060 7904 -2662 7872 -2736
- 7811 -2854 7539 -2927 7757 -2855 1285 2095 7825 -2818 1339 2022 1286 2113 1348
- 1528 1506 1945 7822 -2817 7756 -2823 1392 2184 7874 -2732 1329 2100 7638 -3211
- 100 { m20} R 7897 -2679 7696 -3043 7808 -2793 1452 2014 7851 -2781 857 1841
- 1406 2025 7805 -2843 7726 -3011 1400 1976 7905 -2662 7732 -2998 1508 2173 7846
- -2792 7600 -2912 1426 1451 1537 1821 1221 2103 1411 2245 1520 1761 7732 -3008
- 971 1916 7722 -2993 7896 -2690 1409 2311 7706 -3062 1380 2247 7836 -2810 1504
- 1886 7884 -2715 1495 2239 7409 -3298 7894 -2692 1365 1923 7862 -2753 7874 -2694
- 7868 -2743 1334 2136 7768 -2948 7809 -2806 1605 2070 7713 -2951 7612 -3205 7903
- -2636 7811 -2860 7873 -2727 1487 1986 1622 1659 979 1708 1244 2130 1484 2231
- 7871 -2741 1436 1764 1239 2137 935 1802 7864 -2754 7750 -2840 1416 2228 7631
- -2894 7820 -2824 7872 -2721 1142 2029 929 1897 1426 2245 1355 2149 7515 -2961
- 7907 -2663 1375 2119 1611 2034 7834 -2813 7558 -3359 1374 1231 7749 -2899 1230
- 1792 7894 -2690 1251 1578 1331 2162 1432 2240 7800 -2870 7484 -3478 7874 -2735
- 7833 -2816 7882 -2718 635 1485 1404 1729 1429 2082 1401 2129 1377 2035 1923
- 1680 1551 1930 1453 2189 7612 -3079 1446 1929 1363 2165 7843 -2751 1293 1889
- 7678 -2881 1304 1717 1484 2188 1241 1840 100 { m20} R 7806 -2861 7723 -2915
- 7725 -2960 1309 1820 7703 -2862 899 1418 1228 2170 1360 2142 7718 -2890 1385
- 1872 1512 2131 1235 1777 7835 -2788 1653 2051 1132 1708 1272 1965 1300 2071
- 1399 2211 1329 2128 1239 2101 7746 -2970 1463 2192 7885 -2677 1255 1901 7469
- -3323 7819 -2823 7892 -2697 1344 1799 1416 1592 1785 1960 7894 -2682 1390 2248
- 7889 -2702 1366 2139 1437 1923 1541 2108 1474 2243 1459 2185 7868 -2740 1399
- 2307 7598 -3255 1219 1780 7866 -2746 7708 -2944 7808 -2864 1239 2101 1413 2189
- 7823 -2836 1131 1645 1528 2098 7877 -2713 7869 -2720 1236 2190 7901 -2672 1434
- 1817 1279 2007 980 1755 1479 2248 7904 -2662 7906 -2654 7341 -3442 7899 -2683
- 7771 -2904 7766 -2952 1472 2164 7893 -2691 1325 2089 7888 -2706 7861 -2748 7399
- -3224 6992 -3884 7830 -2788 7752 -2887 7759 -2872 1527 2131 7776 -2900 1334
- 2065 1425 2180 1429 2300 7802 -2755 1613 1434 7513 -3096 7895 -2655 1274 1700
- 7865 -2731 1571 513 7866 -2751 1315 2084 7831 -2820 7698 -2958 1422 2068 1269
- 1423 7719 -2927 7528 -3213 1277 1955 7611 -3264 1431 1913 7326 -3566 1292 1804
- 7639 -3184 100 { m20} R 1417 2148 1535 2158 7563 -3130 1648 1893 1159 2053 1424
- 2265 7869 -2705 7899 -2675 7786 -2910 7604 -3163 7334 -3824 7626 -2887 736 1731
- 7856 -2722 7820 -2834 7586 -3309 7730 -2993 1565 1999 7833 -2814 7461 -3236
- 1459 2240 7807 -2844 1215 1605 1306 2219 950 2107 7712 -3061 1145 1510 1533
- 2097 1551 1914 1349 1536 1303 2145 7900 -2667 1097 1483 7859 -2753 7724 -2902
- 1058 1716 7739 -2981 1386 2293 1555 2116 1317 2007 1166 2169 7729 -2902 7787
- -2889 1189 2047 7796 -2816 7862 -2736 7624 -3181 7802 -2854 1219 1827 1585 1912
- 7886 -2709 1457 1592 1129 1991 1767 1850 7886 -2711 7862 -2728 7904 -2668 7864
- -2745 1292 2320 7643 -2886 7374 -3208 7751 -2867 7762 -2959 1459 2264 1393 2096
- 1518 1990 7871 -2739 7845 -2791 7825 -2814 7622 -3148 1301 2033 7871 -2731 1370
- 1740 1154 1928 7861 -2761 7807 -2752 972 1457 7773 -2932 1419 1989 1328 1963
- 1198 1947 1417 2147 1252 2088 1338 2251 1481 2207 7896 -2688 7572 -3320 7876
- -2722 7890 -2702 7625 -3191 1332 2143 1308 2120 1375 2304 7520 -3098 7890 -2699
- 1458 2149 7801 -2873 7842 -2761 1517 2219 7903 -2675 100 { m20} R 7590 -3113
- 7811 -2853 1305 2191 7883 -2691 7894 -2691 7759 -2966 7436 -3017 7477 -2953
- 1319 2264 1390 2167 7867 -2749 1416 2148 7760 -2948 1423 2040 7538 -3326 7680
- -2895 1493 1733 7650 -3019 7819 -2807 1541 2168 1350 2043 7841 -2800 1442 2192
- 1520 2188 7891 -2679 7484 -3213 7724 -2969 1489 2039 1309 2059 1425 2274 7891
- -2690 7763 -2935 7883 -2707 1517 2166 1261 1882 1276 2144 1270 2142 1276 1821
- 7777 -2931 7830 -2775 1430 2126 1214 1898 7605 -3043 7855 -2749 1829 1657 974
- 1628 7812 -2801 7901 -2678 1542 2079 7893 -2675 1203 2030 1248 2133 1081 1172
- 7881 -2707 1280 1776 1380 1978 7658 -3077 7778 -2895 1024 1971 7886 -2677 7874
- -2734 1460 2188 7829 -2779 1466 1917 7632 -3087 1103 1635 1507 1904 1376 1840
- 7522 -3409 1379 2152 1271 2010 1516 2094 1418 2263 1086 1128 7789 -2808 1347
- 1857 7773 -2896 7697 -3063 7856 -2769 1419 2168 7509 -3449 1378 2055 7898 -2658
- 7820 -2807 1237 2023 1531 2029 1379 1927 7330 -3251 1308 2096 1264 1703 1283
- 2221 7902 -2658 1342 1960 7459 -3436 1575 2157 7714 -3056 7592 -3263 7483 -3515
- 1506 2100 7872 -2735 100 { m20} R 7827 -2776 1205 2070 7668 -3028 1225 1963
- 7151 -3821 7810 -2859 1409 2008 1541 2183 7222 -3504 1161 1710 7749 -2987 7879
- -2724 1490 1815 7848 -2744 7246 -3590 1965 1872 1370 2196 7770 -2888 1151 1474
- 7837 -2805 7813 -2852 7834 -2738 7850 -2783 1409 2216 7707 -2962 7684 -3116
- 7793 -2890 1512 1953 7886 -2709 1390 1989 7855 -2767 1404 2188 7672 -3138 7599
- -3164 7865 -2751 7636 -3136 1437 2219 1099 1600 7755 -2925 7812 -2820 1354 1803
- 7857 -2743 7896 -2671 1319 2152 1511 1968 7361 -3316 7898 -2673 7903 -2669 7716
- -2922 1299 1995 7709 -3064 7589 -3132 7748 -2921 7786 -2864 7807 -2788 6995
- -3192 1540 2151 1419 2310 7745 -2992 1593 2019 7696 -3046 1244 2101 1224 2023
- 7847 -2756 7224 -3431 1436 2285 7491 -3286 7608 -3245 7856 -2734 7430 -3201
- 7831 -2804 7162 -3198 1299 1943 1354 2097 7798 -2763 1441 2221 7604 -3029 7800
- -2857 1327 1196 7812 -2854 1309 2119 7841 -2783 1467 2166 7823 -2829 1410 2299
- 1558 2081 1363 2344 1260 1626 1380 2003 1471 2048 1405 2188 1423 2160 7678
- -3018 1362 2205 7840 -2803 7566 -3124 1407 2090 1406 1519 1345 2077 7764 -2918
- 100 { m20} R 1386 1982 1415 1920 7669 -3104 1367 2219 7846 -2789 1524 1937 1440
- 2140 1250 2258 7403 -3159 1375 2066 7435 -3318 7461 -3564 1231 1671 7888 -2705
- 1464 1811 1404 2090 1408 2050 1598 1902 7896 -2689 1387 1694 1517 2062 7768
- -2931 7329 -3401 1655 2054 7908 -2664 1525 2105 1509 2147 1506 2166 1272 1957
- 1432 2118 1336 2032 7379 -3243 1408 2182 1440 2253 1320 2121 1284 2277 1121
- 1541 1554 2169 7820 -2785 1410 2073 1340 2108 1963 1569 7847 -2771 1393 2212
- 1365 2131 1454 2194 1226 1922 7599 -3142 1309 1899 7655 -3169 1177 2103 1489
- 2205 7861 -2760 1393 1960 7820 -2843 1152 1819 7896 -2677 7819 -2836 7676 -2950
- 7862 -2748 1514 2082 1339 1702 7862 -2759 7904 -2669 858 2099 1676 1742 7888
- -2696 7611 -3198 1020 1504 641 1951 7449 -3252 7293 -3413 7618 -3211 7679 -3091
- 1291 1682 1228 1812 7524 -3269 7906 -2668 1342 2141 1457 1736 7849 -2771 7814
- -2836 1427 2142 706 1744 7722 -2855 7893 -2679 1295 1941 1518 2179 1615 1908
- 1541 2104 7840 -2803 7670 -2874 1690 1821 7829 -2686 7556 -3084 7605 -3209 1511
- 2163 1317 1992 7743 -2975 1138 2056 100 { m20} R 7828 -2807 7734 -2919 7897
- -2684 1352 1840 1493 2231 1342 2297 7649 -3157 1621 2036 7364 -3431 1213 1286
- 7908 -2653 7808 -2810 1415 1984 7897 -2688 1370 2172 7892 -2684 7733 -2917 1201
- 1814 1443 2213 1553 2122 1238 2010 7308 -3433 1237 2009 7779 -2926 7263 -3336
- 1211 2157 1487 1286 7794 -2829 1314 2257 1399 2330 1207 1774 1358 1888 7893
- -2693 1362 1936 1171 1845 950 1927 1342 2059 1509 2218 7889 -2695 7898 -2685
- 1476 2170 7790 -2893 1335 1493 1519 2150 1454 2186 7839 -2797 7898 -2684 1052
- 1856 7809 -2862 1208 1952 7716 -3050 7769 -2897 7848 -2774 1513 1980 1508 1681
- 7624 -3078 1381 2002 7689 -2996 1226 1906 1445 2274 1481 2147 7824 -2825 1471
- 2227 7741 -2981 7905 -2627 7769 -2805 7825 -2811 998 2054 1090 1526 7853 -2775
- 7898 -2684 7743 -2939 1216 2009 1599 2028 1379 1859 1361 2128 1323 2082 7825
- -2820 1353 2073 7829 -2800 1378 2130 7880 -2700 7887 -2706 1272 2083 7907 -2663
- 1321 1939 7643 -2974 7598 -3174 7839 -2746 7829 -2824 1293 2065 7806 -2824 7832
- -2815 1200 1859 7900 -2655 7668 -2999 7751 -2982 1296 2203 1271 1720 1031 1913
- 100 { m20} R 7625 -3175 1479 2051 7855 -2772 1065 2184 7869 -2743 7873 -2721
- 7651 -3088 1470 2240 7710 -2938 7667 -2976 7809 -2854 7851 -2757 7753 -2939
- 7484 -3177 7461 -3389 1220 1347 1350 1808 1376 2049 1597 2112 1286 1996 1525
- 2212 1043 1357 1498 2090 7591 -3092 7702 -2953 7822 -2835 7638 -2859 1093 1423
- 1070 1577 7742 -2938 7818 -2819 1443 2264 7882 -2632 1433 2093 7641 -3162 1473
- 2218 899 1920 1338 1837 7768 -2926 1257 1914 1433 2294 1491 2027 7708 -2965
- 7690 -3090 1485 1930 1453 2115 1448 1935 7816 -2836 7790 -2889 1461 2265 7850
- -2763 7852 -2759 1481 2109 920 1198 7810 -2764 7833 -2810 1469 1964 7886 -2697
- 7715 -2957 7868 -2738 7907 -2666 1367 2187 7525 -3087 7816 -2841 7477 -3076
- 7897 -2668 7441 -3598 7804 -2828 7803 -2801 7880 -2720 1299 2117 1059 1310 7892
- -2695 1067 1522 1404 1943 1370 2140 1158 1779 7879 -2713 7786 -2834 7821 -2836
- 1120 1879 908 1088 7842 -2800 7829 -2815 602 1410 1305 1751 1388 2246 7849
- -2785 7838 -2767 1479 2084 1171 2146 1388 2025 935 1735 1385 2192 1188 2071
- 7762 -2958 1406 1983 1477 2050 1472 2045 1301 1640 100 { m20} R 1417 1911 7586
- -3289 7810 -2862 7795 -2811 7679 -2860 7805 -2860 1202 1905 7392 -3160 1450
- 1636 1292 2005 1374 1777 1488 1918 7572 -3308 1449 1768 1244 1527 7906 -2667
- 7848 -2786 7772 -2889 7863 -2756 1351 2206 7583 -2972 1367 2248 7633 -3142 7894
- -2692 1429 2134 1294 2139 7848 -2762 7795 -2894 1414 2263 7708 -3056 7905 -2665
- 914 1610 1369 2015 1076 1761 7718 -3046 1237 1804 1316 1833 7877 -2726 7892
- -2665 1444 2038 7865 -2675 1464 2186 1093 1646 7875 -2722 1199 1923 7801 -2862
- 1619 1914 1224 1634 7744 -2960 7600 -3127 1478 2178 1267 2219 7796 -2889 7392
- -3226 1488 2023 1267 1350 262 1806 7835 -2741 7701 -3062 1182 1882 1243 1523
- 7824 -2770 7870 -2735 1462 2232 7623 -3140 7893 -2696 1465 2241 7489 -3285 7907
- -2659 7818 -2822 1247 1848 7845 -2781 7765 -2827 1730 2046 7735 -2946 1355 2371
- 1290 1883 7897 -2687 1387 2198 1141 1850 1568 2129 7900 -2682 980 2091 1240
- 2215 7885 -2712 1253 1994 7578 -3261 1331 2137 1241 1850 1285 2123 1130 1615
- 7725 -3031 1461 2132 1106 2004 7782 -2918 7896 -2653 1525 2153 7906 -2663 914
- 1210 1412 1812 100 { m20} R 7828 -2794 7878 -2703 1081 1956 593 1470 1316 2094
- 1487 2075 7727 -3014 1263 1916 1402 2115 7871 -2739 1351 2165 7906 -2668 1248
- 1717 1525 1931 7794 -2895 1479 2241 1443 2115 7752 -2936 1274 2062 1463 2036
- 7895 -2688 1343 1872 7754 -2976 7666 -2942 7366 -3675 7818 -2847 1507 2205 7893
- -2693 1248 1993 1623 2122 1433 2067 7402 -3687 7866 -2741 7832 -2816 7695 -2904
- 7647 -3122 7536 -2978 7863 -2757 1460 2183 1582 2069 7874 -2733 7892 -2696 1293
- 1909 7681 -3075 1432 2033 1399 1894 1158 1544 1312 2104 1385 1787 1349 2159
- 1625 1655 1751 2024 7823 -2788 1336 2003 7714 -3057 7344 -3314 7890 -2702 1594
- 1728 7882 -2698 1488 2161 1462 2254 1780 1698 7722 -2886 1426 1975 1342 2026
- 7394 -3447 1192 1558 1352 2303 1386 2129 7894 -2694 7898 -2650 1392 2238 1326
- 2217 7782 -2908 7839 -2780 1628 1944 1433 1789 1349 1754 7902 -2668 979 1927
- 7806 -2862 7590 -3128 7584 -2938 7854 -2772 1446 2177 1636 1998 1448 2163 7891
- -2693 7904 -2675 7769 -2947 7637 -2872 7645 -3074 7896 -2687 7582 -3003 1338
- 2041 1108 2015 7792 -2865 7711 -3039 7845 -2787 7908 -2664 100 { m20} R 7773
- -2937 7861 -2758 7622 -3165 7360 -3441 1369 2177 7812 -2825 7585 -3096 7370
- -3081 1438 2253 1170 1781 1440 2185 1128 2038 1175 1603 1293 2156 7905 -2637
- 7763 -2959 1373 2319 7777 -2930 7478 -3535 7798 -2887 1528 2069 735 1817 7804
- -2873 1119 1862 7788 -2841 882 1252 1151 1913 1568 1923 1509 2215 7718 -2999
- 1374 2239 1420 2098 7874 -2734 7882 -2718 7828 -2820 7753 -2973 1665 2058 1660
- 1976 1457 1719 1297 1561 7654 -3155 1290 1749 7831 -2813 1455 1882 7702 -3063
- 7860 -2718 1472 2117 7848 -2776 1385 1275 7808 -2760 7809 -2827 1362 2047 7870
- -2739 1363 2132 7850 -2777 7839 -2751 7702 -3067 1437 2088 1416 2171 1562 2003
- 7613 -3259 7712 -3049 7906 -2660 7495 -3283 7715 -2924 1465 2197 7736 -2989
- 1402 2060 1532 2175 7715 -3049 7416 -3090 778 2146 7806 -2869 7628 -3221 1400
- 2289 7504 -3267 7487 -3024 1007 2033 1437 2081 1542 2162 1331 1938 7876 -2717
- 7312 -3254 1136 1926 1200 1279 1193 1837 7889 -2702 7822 -2735 7707 -3042 7773
- -2937 7865 -2748 7626 -2925 7719 -3047 7885 -2688 1177 1990 1487 1648 1151 1993
- 7869 -2744 7905 -2673 1389 1997 100 { m20} R 1341 1653 1388 2059 7799 -2886
- 7531 -3398 7862 -2746 7803 -2875 7886 -2704 1382 2301 7882 -2697 1109 1966 1373
- 2049 7749 -2971 7772 -2935 1308 1757 7774 -2870 7298 -3254 7738 -2933 1525 1556
- 7743 -2946 1494 2050 1196 1678 7756 -2881 1336 2220 1232 2114 1601 2141 1120
- 1486 1352 2341 7836 -2809 7734 -2967 7557 -3050 1677 1700 1420 2123 1622 2123
- 1587 2083 7883 -2717 1492 2154 870 1594 7725 -3013 1225 1945 1306 2104 7785
- -2887 7773 -2926 7672 -3052 1375 1985 1520 2065 7772 -2930 921 1756 7871 -2726
- 7824 -2834 7751 -2887 7799 -2874 1165 2045 1683 1699 7802 -2863 7876 -2729 7874
- -2731 7683 -3092 7470 -3515 7794 -2880 1584 1552 1259 1701 1367 1850 7860 -2761
- 1261 2023 1098 1903 7846 -2773 1437 2055 1351 1628 7852 -2777 7888 -2703 1254
- 1713 7582 -3284 7865 -2751 1469 2090 1660 1946 7768 -2941 7779 -2903 7860 -2740
- 7884 -2713 1082 1853 1499 2025 7807 -2869 7817 -2801 7616 -3227 7728 -3006 1519
- 1809 7709 -3007 7863 -2735 7805 -2767 1460 2076 1244 2101 1533 2115 1207 1758
- 7599 -3091 1468 1787 7799 -2804 7883 -2717 1511 1898 7900 -2660 1445 2100 100 {
- m20} R 7893 -2681 1410 2248 7814 -2796 7657 -3103 7836 -2787 7760 -2917 1489
- 2235 1436 1582 7826 -2831 7739 -2960 1634 2048 7848 -2777 1356 2195 1561 2135
- 1458 2050 7783 -2857 1133 2145 1730 1747 7487 -3034 1421 1596 1176 1652 7768
- -2930 1641 1558 1445 2207 1242 1887 7541 -3333 7601 -3221 1377 2217 7594 -3244
- 7770 -2889 1497 1950 1685 2069 1113 1974 7717 -3050 7793 -2892 1555 2056 1308
- 2037 1079 1867 1030 1659 1426 2166 1026 1399 1487 2239 1027 1940 7707 -3069
- 1234 1417 7719 -3031 7711 -2932 7894 -2665 1889 1683 7826 -2831 7868 -2740 7860
- -2754 7769 -2945 7876 -2721 1278 2040 7862 -2758 7886 -2704 1716 2060 1039 1836
- 7899 -2681 7457 -3240 1587 2131 1205 1935 7706 -2882 7863 -2722 7682 -3123 7731
- -3019 7882 -2680 7887 -2702 1586 2132 1459 2097 7692 -3085 1651 1787 1488 2034
- 1670 2047 889 1449 7686 -3018 7808 -2862 1435 2173 7795 -2783 7877 -2728 7904
- -2668 7553 -3351 1160 1323 1429 2287 7872 -2718 1103 1866 1080 1983 7264 -3328
- 7812 -2833 7837 -2805 1524 2143 7905 -2667 1249 1991 7762 -2889 7817 -2825 7691
- -3104 967 1419 7854 -2774 7718 -2955 100 { m20} R 1430 1981 7888 -2699 7880
- -2721 7689 -3030 1410 2179 1415 2269 1462 2163 7798 -2836 1463 1765 7884 -2704
- 1557 1801 7900 -2666 1376 2112 7858 -2765 1434 2087 7686 -3026 1458 2271 7764
- -2867 1291 2017 7884 -2714 7859 -2760 7436 -3582 7870 -2742 1448 1995 1312 2049
- 7347 -3385 1176 1928 1527 2177 7825 -2803 1222 1969 7583 -3185 7893 -2641 7785
- -2870 7766 -2941 7719 -3046 7746 -2983 7839 -2802 7753 -2853 7794 -2836 1303
- 2048 1361 1765 1406 2088 1596 2062 1507 2194 7881 -2693 1376 2323 1281 1977
- 7878 -2726 1414 2289 1467 2236 7844 -2794 1346 2048 1474 2083 7575 -3239 1520
- 2109 7798 -2880 1112 1757 1127 1675 1200 1944 7619 -2935 1261 1980 7836 -2805
- 1292 2305 1437 2266 1475 2131 1473 2132 7894 -2685 1396 2264 7763 -2956 1422
- 2089 7866 -2732 1390 2250 1541 2164 880 1722 7717 -3051 1601 1730 7757 -2963
- 7835 -2812 7789 -2846 1471 1756 1386 1881 839 1251 7760 -2964 1295 1995 7676
- -3120 1336 2019 7790 -2886 1715 2039 1268 1972 7452 -3267 7741 -3000 1473 2086
- 1687 1803 7646 -3161 597 1438 7797 -2890 1041 1842 1393 1949 1340 2289 7505
- -3019 100 { m20} R 1307 2163 1255 1511 1511 1448 7885 -2692 859 1565 7513 -3440
- 7436 -3204 1433 2082 7735 -2973 1718 1103 7700 -2917 1382 2327 7901 -2635 7663
- -3130 1281 2040 7633 -3035 7819 -2846 1391 2165 1544 1866 1418 2012 1375 2148
- 7592 -3108 7893 -2696 7670 -3104 7904 -2674 1337 2120 1548 2194 1506 2211 7896
- -2687 7829 -2778 1379 1578 1461 2030 7615 -3249 1438 2265 7895 -2683 1281 2056
- 1727 1793 1520 1968 1423 2061 7770 -2935 7891 -2699 1409 2174 1707 2012 7754
- -2912 7862 -2745 7868 -2746 7689 -3068 1081 1881 7706 -2998 1407 1895 1402 2222
- 7744 -2975 963 1906 890 2028 1562 2111 1276 1393 7839 -2804 7783 -2918 1231
- 1750 1179 1793 7734 -2976 7838 -2765 1555 2123 1112 1864 7645 -3193 7728 -2861
- 7716 -3050 1495 2133 1436 2262 7607 -3272 7863 -2714 1383 2315 1179 1083 1443
- 2190 7526 -3303 7583 -3142 7829 -2820 1512 2011 7714 -3039 1250 2105 919 1706
- 1032 1897 7741 -3000 1357 2025 7716 -2989 1364 2301 7805 -2860 7703 -3078 1333
- 2318 1530 1963 1517 2112 7885 -2709 7902 -2658 7776 -2930 7720 -3043 7678 -3012
- 1330 2134 1474 2247 1552 1890 1478 2137 100 { m20} R 1442 1909 1548 2069 1273
- 1920 1320 2161 1466 2110 7854 -2759 1312 2149 7853 -2761 7896 -2656 1468 2017
- 7331 -3335 7814 -2818 7848 -2744 1153 1790 833 1961 7768 -2875 7838 -2804 7781
- -2876 1299 1931 1398 2308 7613 -2968 1322 1923 7518 -2959 1471 2210 7843 -2770
- 1796 2002 7868 -2746 1474 2239 7681 -2913 1236 1946 7896 -2685 7784 -2738 7831
- -2817 7884 -2713 7866 -2747 7881 -2679 1403 2193 7775 -2902 1333 1936 1288 1742
- 1351 1894 7030 -3623 7659 -3142 1409 1534 1257 2282 7560 -3356 7789 -2839 7805
- -2871 7882 -2701 1530 1819 1489 2175 7881 -2700 7899 -2674 802 1849 7890 -2701
- 1424 2009 7804 -2845 1512 2085 1328 2135 7897 -2686 1454 2231 7607 -3260 7847
- -2782 1261 2038 1385 2304 1151 1855 7569 -3308 1118 1684 7704 -3067 1413 2056
- 7836 -2778 1212 1999 1059 1624 7756 -2924 7867 -2742 7535 -3301 7892 -2688 7874
- -2734 1555 1872 7623 -3235 1354 2211 1033 1890 7545 -3395 7682 -3060 1577 2061
- 7527 -3066 1388 2028 7817 -2822 7753 -2970 7579 -3153 7769 -2817 1364 2162 7866
- -2750 7486 -2919 1427 2266 1444 2029 997 2010 7514 -3251 1435 2011 1466 2242
- 100 { m20} R 1142 1445 1685 2000 7554 -3237 7879 -2708 7884 -2676 7818 -2842
- 7903 -2642 1265 1573 1663 2103 1355 2156 1230 1958 7851 -2775 7802 -2770 1017
- 1583 7530 -3233 7827 -2827 7740 -2995 1333 2229 7886 -2705 7846 -2788 7850
- -2753 7909 -2661 7894 -2682 1311 1526 1156 1866 7765 -2911 7600 -3168 7503
- -3451 1388 1654 7868 -2744 7397 -3273 1465 2258 7598 -3034 7873 -2736 7828
- -2827 7847 -2755 1373 2250 1548 2122 1410 2013 7823 -2837 706 1725 7864 -2745
- 7322 -3260 7771 -2895 7806 -2863 1250 1817 7804 -2817 1354 2253 7752 -2977 7622
- -3082 1022 1839 1309 2056 7442 -3459 1107 1827 1394 1814 1402 2286 7846 -2772
- 1285 1264 7740 -2902 1218 1500 1252 1849 1490 2147 7699 -3005 981 1639 7760
- -2935 7794 -2896 956 1936 7843 -2777 7849 -2770 7839 -2793 7478 -3464 7887
- -2646 1351 2034 1449 2196 7846 -2789 7676 -3049 1397 2308 7909 -2658 7890 -2700
- 1507 2179 7883 -2717 1292 1808 1114 1664 7818 -2842 7897 -2688 1760 1776 7849
- -2724 6566 -3326 1367 2159 1615 1925 1541 1527 1380 2043 7890 -2697 7764 -2925
- 7532 -3273 1386 2183 1517 1958 7889 -2703 1435 2239 1368 2094 100 { m20} R 1285
- 1964 7648 -3039 1386 2014 1242 1536 7903 -2667 7514 -3038 1420 2211 1467 1698
- 1565 2092 1167 1146 7826 -2827 7697 -3083 1438 2233 7877 -2724 1507 2211 6830
- -3432 1068 1791 1372 1852 7838 -2734 1437 2027 1235 1956 1535 1768 1176 1547
- 7789 -2905 1509 2032 1398 2018 1316 1968 7748 -2962 7468 -3549 1288 1939 7623
- -3194 7880 -2706 1229 1928 1447 2100 1379 2100 7903 -2642 1589 2141 7577 -3069
- 7837 -2790 1247 1999 7557 -3373 7684 -2961 7822 -2782 7740 -2997 1362 2227 7672
- -3037 7414 -3156 1566 2176 7703 -2996 1427 2123 901 1064 7834 -2813 1210 2018
- 1510 1674 1007 1773 7220 -3767 1427 2215 7631 -2822 7793 -2860 7826 -2806 7721
- -3008 7356 -3292 1149 1815 1507 2205 7694 -3093 1393 1884 1426 2058 7513 -3461
- 7478 -3531 7746 -2991 7770 -2925 7904 -2665 7460 -3103 1534 1621 1495 2189 1479
- 2121 7752 -2927 1405 2257 1615 2078 1092 1815 1481 1992 1445 2125 1276 2155
- 1256 1113 1435 2296 7844 -2787 7853 -2775 1495 2174 1429 2020 1483 2220 1168
- 1812 1656 2111 1860 1871 7741 -2989 1320 2036 7808 -2830 1430 2241 7769 -2931
- 7619 -3234 1098 2018 100 { m20} R 1441 1950 1482 2156 1403 2184 7895 -2691 7877
- -2725 1241 1889 7864 -2739 1361 2337 1248 2239 7817 -2844 7898 -2584 7760 -2954
- 1497 2187 7868 -2747 1326 2341 1476 2246 7414 -3663 1552 1939 7579 -3318 7673
- -3129 1069 1852 1382 1952 7891 -2694 7743 -2993 7874 -2674 7607 -3244 1343 2223
- 7608 -3192 1022 2034 1334 1965 1327 1350 7768 -2839 7854 -2762 1577 1995 7631
- -3182 1410 2233 7836 -2810 1311 1235 1409 2132 1137 1782 1349 2132 7852 -2771
- 7647 -3021 1212 1960 7742 -2981 7505 -3107 7717 -2915 1317 1862 48 { m20} R
- 1458 1981 7712 -3060 1357 2074 1687 2013 1004 1747 941 1585 7872 -2689 7769
- -2945 1366 2105 1445 2253 1474 2182 1454 2247 1318 1842 1469 1971 7793 -2870
- 7857 -2759 1383 2057 1191 2119 7545 -3391 1191 1511 7536 -3273 7896 -2665 7898
- -2682 7879 -2719 1535 2141 7903 -2670 1540 1888 7786 -2909 1446 2113 7442 -3438
- 7888 -2700 7859 -2761 7840 -2780 1271 2046 1546 2189 1463 2212 7869 -2741 7867
- -2745 7278 -3933 7868 -2743 1317 1983 7542 -2979 7244 -3300 1517 2089 1642 1717
- 1523 2186 7852 -2778 1255 1686 1345 1902 7883 -2699 1455 2063 1491 2059 7904
- -2657 7668 -2968 7674 -3049 7864 -2751 1334 1906 1366 2213 1323 2182 7612 -3032
- 7776 -2910 1515 2206 1410 2324 1542 2114 7440 -3104 1441 2069 859 1841 1391
- 1701 7857 -2765 1171 1888 7799 -2807 7788 -2840 7673 -3007 1020 1179 1389 2209
- 7721 -3043 1239 1878 7671 -2938 7870 -2738 7643 -3160 1474 2037 7782 -2762 7846
- -2760 7736 -3012 7534 -3355 7905 -2671 7837 -2808 7777 -2927 1398 1535 7694
- -2999 7588 -3312 7858 -2767 7746 -2860 1368 1801 7807 -2869 7822 -2834 1688
- 1684 7885 -2711 7665 -3156 7852 -2778 100 { m20} R 1055 1776 1486 1900 1506
- 1875 7862 -2755 1449 2240 7592 -3223 7894 -2694 7877 -2728 7514 -3018 1307 1829
- 1491 2055 7712 -3060 7864 -2750 7104 -3628 1327 1996 7726 -3006 7900 -2681 7794
- -2832 1345 2194 1473 2237 7857 -2749 7837 -2760 1379 2022 1450 2095 1335 2112
- 7768 -2947 1653 1888 7511 -3464 1540 2110 7815 -2828 1660 1812 1318 1843 7688
- -2884 1422 2108 7257 -3105 1305 2063 1041 1711 1386 2293 7703 -3078 7784 -2907
- 1318 2007 1246 2076 7859 -2764 7644 -3191 7576 -3143 7736 -3009 1416 2044 7688
- -3104 7587 -3057 1392 1933 7835 -2812 7813 -2804 1556 2030 1181 1767 7652 -2941
- 1359 2104 1449 2039 1602 2116 7236 -3428 7841 -2794 7774 -2930 7617 -3042 1511
- 2106 1428 2136 7850 -2779 7907 -2667 1589 2022 1475 1961 7829 -2821 7847 -2783
- 7756 -2944 7803 -2874 7891 -2685 1634 1669 1430 1797 7840 -2803 1445 1950 7713
- -3051 1329 1781 1334 2001 7837 -2790 1326 1860 1281 2168 1455 2174 7906 -2659
- 7811 -2855 7723 -3036 1595 2030 7886 -2701 1228 1998 1334 2350 7482 -3363 1603
- 2114 1325 2020 7895 -2681 7892 -2680 7799 -2885 7729 -2966 1559 1511 7763 -2936
- 100 { m20} R 7361 -3339 7877 -2686 7667 -3065 7733 -2978 7816 -2845 1342 2129
- 7812 -2845 1586 1972 1325 2072 7907 -2667 7858 -2752 7795 -2892 7243 -3131 7732
- -2980 7769 -2751 1402 2029 1638 1836 7325 -3200 1471 2045 7743 -2975 1487 1927
- 7694 -3093 7808 -2864 7699 -3088 1071 1700 1363 1818 7733 -2974 7838 -2773 1360
- 2011 1694 2015 7831 -2822 1180 2021 1108 1840 1330 1797 1279 1728 1386 2266
- 1295 1762 1223 1832 7890 -2673 1411 1791 7832 -2799 7899 -2676 1410 1879 7777
- -2858 7670 -3123 7843 -2793 1248 1448 1211 1944 826 1590 1426 2165 7793 -2890
- 1380 2301 1287 2047 7816 -2765 1361 1981 1144 1922 7746 -2856 1406 2330 1618
- 2098 7743 -2998 7865 -2732 7845 -2758 7630 -3084 7905 -2669 7808 -2723 1542
- 1801 1556 2180 1771 1996 1589 2163 7883 -2716 7733 -3019 1127 2038 1256 2136
- 7818 -2828 1501 2219 1670 2082 7820 -2791 7894 -2677 7309 -3875 7776 -2928 7811
- -2842 7647 -2901 1913 1765 1100 1513 7751 -2905 7644 -3067 7773 -2938 7892
- -2690 1324 2189 7766 -2946 7638 -3187 1335 2341 7662 -2940 7868 -2733 7858
- -2685 7831 -2821 1482 2175 7877 -2727 7789 -2860 1625 1878 100 { m20} R 7615
- -3113 1464 1946 7695 -3091 1295 1494 7866 -2749 1354 2001 7902 -2677 955 1766
- 7629 -3129 1359 1751 1422 2296 1250 2072 936 1677 1298 1492 7905 -2670 1500
- 1994 7265 -3191 7616 -3067 1207 1718 7669 -3057 7754 -2960 1509 2156 7727 -2979
- 7629 -3183 1213 1847 7898 -2678 7691 -3102 1153 1175 7753 -2953 7870 -2728 1422
- 2231 1509 1884 1166 1713 7733 -2862 1431 2133 1452 2157 7847 -2788 1724 1978
- 7380 -3273 7634 -3184 1518 1933 1431 2146 1384 2348 1423 2023 1396 2194 7717
- -3039 1346 1791 1526 2117 7845 -2769 7887 -2693 1428 2026 1224 2184 7348 -3172
- 1241 1638 7559 -3368 1464 2246 7900 -2681 7895 -2622 1381 1827 895 2051 1416
- 2025 1092 1526 7822 -2837 1436 2101 7855 -2772 7791 -2872 7775 -2914 1440 1921
- 1223 1975 1249 1645 7897 -2686 7823 -2813 1533 2041 1468 2234 7676 -3079 7905
- -2672 1501 1832 1519 2092 453 1372 7739 -2994 7690 -3010 1466 2153 7840 -2800
- 1431 2281 7899 -2683 7899 -2682 1383 2215 1177 1886 1613 1973 1448 2060 1403
- 2115 7244 -3414 1680 2075 7678 -3115 1368 2106 7858 -2736 7785 -2886 1149 1988
- 1300 2233 7844 -2789 100 { m20} R 1725 1995 7846 -2791 7570 -3315 7449 -3263
- 1287 2180 7682 -3045 1515 1963 7899 -2644 7842 -2789 7905 -2669 7900 -2676 1551
- 2139 7642 -2855 1515 2143 7900 -2658 1321 2009 7788 -2870 1325 2050 1387 2177
- 1389 2077 7565 -3346 7811 -2855 1265 2104 1511 2112 1056 1916 7734 -2964 7725
- -2985 1432 2123 1258 2122 7502 -3298 1512 2156 7656 -3117 1460 2107 7328 -3278
- 1160 1673 1439 2269 7761 -2953 1271 1879 1580 2031 1365 2007 1388 2275 1457
- 2006 7907 -2653 7829 -2825 7491 -3073 1128 1808 1389 2268 1308 2119 7809 -2847
- 7759 -2883 1492 1769 7891 -2700 7857 -2750 7652 -3180 7898 -2674 1135 1762 1353
- 2240 7557 -3331 7536 -3030 7862 -2688 7856 -2763 7893 -2694 1418 1860 7818
- -2826 1452 1946 7489 -3233 7796 -2889 1495 2088 1342 1899 7844 -2751 7763 -2955
- 1367 2072 7681 -3113 1436 2162 1452 2138 1410 2316 1444 2021 7720 -2964 7866
- -2746 1592 1560 1391 1912 7771 -2915 1465 2146 7740 -2995 7743 -2891 1493 2167
- 1483 2238 7777 -2885 7849 -2771 7803 -2870 7711 -3063 7831 -2808 7908 -2654
- 1290 1824 1209 1849 1243 1779 7832 -2818 1369 2116 7795 -2855 1360 2121 100 {
- m20} R 1307 1855 1281 2232 7242 -3540 1454 2176 7862 -2753 7786 -2913 1425 2190
- 1374 1441 7902 -2673 7722 -2940 7760 -2770 1195 1926 7719 -2985 7835 -2810 1104
- 1722 7592 -3239 7864 -2752 1065 1963 7668 -3068 1092 1686 1478 2178 1553 2137
- 1535 1986 7852 -2778 7684 -3114 7879 -2725 7708 -2999 6958 -3242 7744 -2996
- 1402 1578 7782 -2913 7860 -2742 1556 2050 7890 -2700 7572 -3100 7652 -3181 1511
- 2121 1303 1790 1534 2179 7826 -2809 1413 2311 7863 -2752 1260 2179 7865 -2733
- 1259 2097 1526 1993 1155 2036 1436 2285 1259 1945 1033 1270 7850 -2777 7877
- -2716 1366 919 1236 1956 1396 2077 7885 -2713 7821 -2836 7840 -2801 7731 -2956
- 7829 -2816 1407 2029 1186 2013 1408 2182 7869 -2709 7891 -2698 7878 -2719 7871
- -2731 1418 2273 7888 -2706 1402 2134 7557 -3074 7832 -2784 1357 1764 7826 -2830
- 7827 -2814 1407 2295 7690 -2854 1414 2116 7166 -3671 7896 -2688 1340 2198 7895
- -2689 7642 -3202 1479 2250 1217 1990 7805 -2847 7872 -2732 7413 -3359 7847
- -2778 7885 -2711 7895 -2674 1496 2238 7677 -3076 7876 -2729 1326 2114 1339 2143
- 1499 2204 7871 -2731 1428 1887 1297 1875 100 { m20} R 7682 -3113 1342 2168 7611
- -3231 1386 2256 1230 1567 7843 -2634 1011 2031 7794 -2872 989 842 7754 -2860
- 7889 -2678 1051 1516 1505 2054 1401 2131 7838 -2791 7879 -2701 1007 1492 1330
- 2126 7824 -2832 7799 -2815 1498 2152 7777 -2892 7814 -2804 7873 -2729 7575
- -2884 1424 2184 7363 -3724 1257 1958 7862 -2756 7784 -2733 7810 -2852 1191 1904
- 7672 -3004 7553 -3155 7720 -3031 7790 -2903 1431 2235 7695 -3043 1487 1739 7606
- -3156 7882 -2716 7833 -2770 7884 -2702 1276 2220 7747 -2953 1436 2199 1373 2109
- 1391 1928 1513 2116 7568 -3087 7745 -2940 1568 2133 1465 2191 7792 -2891 1695
- 1108 684 1770 1442 2077 1585 2126 1490 2141 1108 2056 7891 -2691 7873 -2689
- 7686 -3091 7678 -2949 7853 -2775 7507 -3458 7845 -2791 7623 -3228 1328 2072
- 7846 -2790 1288 1647 7710 -3023 7441 -3018 7844 -2796 1471 2219 7748 -2987 7872
- -2735 1246 1818 1503 1829 7873 -2730 1341 2126 1298 1761 1253 1955 7889 -2702
- 1480 1951 1448 1932 1053 1630 1470 1787 1559 2072 1315 1339 7597 -3075 7503
- -3344 7398 -3558 1348 2212 7763 -2924 1385 1909 7656 -3124 7763 -2955 1214 1972
- 1483 2232 100 { m20} R 7894 -2687 7882 -2708 7744 -2918 7856 -2750 7865 -2730
- 1449 2133 1567 2179 1638 2053 1105 2015 1363 1848 1405 2283 1366 2281 7828
- -2816 7852 -2778 7879 -2724 1409 2168 7897 -2668 6799 -3701 7545 -3319 959 1999
- 7901 -2666 1329 2194 7868 -2682 7909 -2636 7813 -2849 7837 -2740 1399 1984 7819
- -2774 1198 1891 7511 -3429 869 1690 1503 2208 7843 -2789 7879 -2724 7776 -2920
- 7904 -2670 7892 -2669 1669 2051 1211 1749 7762 -2940 7430 -3292 1024 1251 7767
- -2951 7902 -2652 1298 2164 1377 1784 1345 2091 7710 -3061 7726 -2967 1389 2111
- 7847 -2789 1687 1612 1530 1588 7718 -2919 7854 -2760 7745 -2871 7826 -2824 7769
- -2946 7724 -2940 7826 -2830 7906 -2624 1527 2093 1531 1966 7788 -2904 1570 2170
- 1364 2070 1680 2063 7838 -2806 7909 -2654 1170 1936 1379 2019 7579 -3080 1546
- 1964 7713 -3022 7751 -2981 7548 -3124 1395 2337 1406 1875 7812 -2843 7616 -3136
- 7885 -2704 7216 -3960 1501 2142 1351 1592 7880 -2721 7679 -2823 1176 1798 7593
- -3075 1306 2029 7748 -2982 7787 -2886 950 2036 1501 2076 1174 2059 7879 -2720
- 1392 2084 7710 -2974 1140 1786 1014 1522 7698 -2977 100 { m20} R 7654 -3063
- 1276 1687 766 1522 1022 1459 7888 -2705 7686 -3113 7789 -2819 1193 1861 1205
- 1959 7883 -2697 1405 2153 7409 -3326 7884 -2713 7759 -2917 7881 -2713 7893
- -2655 1486 2108 7890 -2698 1661 2011 7901 -2648 903 1899 7845 -2792 7755 -2964
- 7834 -2812 7574 -3331 1290 1975 7636 -3186 1250 1643 7764 -2950 7883 -2699 7796
- -2892 7661 -3073 1148 1738 7842 -2799 7793 -2734 7845 -2770 1202 1943 7483
- -3376 7576 -3008 1415 2117 7638 -2964 1479 2075 7904 -2671 1259 1900 7908 -2651
- 7650 -3156 1383 2014 7370 -2917 1375 2263 7881 -2714 7481 -3527 1386 2225 1256
- 1986 1450 2087 1312 1708 7650 -3081 7757 -2970 7884 -2704 2032 1778 7749 -2922
- 1495 2161 7755 -2913 701 999 7557 -3101 1580 2098 1406 2248 7698 -2865 1377
- 2090 1608 2072 1513 1660 7836 -2812 1132 1271 871 1839 7855 -2743 7845 -2791
- 7859 -2741 7900 -2682 7893 -2694 7876 -2730 7903 -2671 7362 -3454 7689 -3099
- 1431 2154 7866 -2750 1168 2041 1475 2096 1362 2077 7815 -2852 7812 -2720 1388
- 2233 1525 2154 7860 -2759 7891 -2700 7840 -2780 1444 2181 1417 1818 1641 2053
- 7859 -2761 1461 2188 7409 -3549 100 { m20} R 7678 -3087 7907 -2631 7834 -2814
- 7704 -3074 1699 1947 7601 -3135 7617 -3061 1426 2211 7084 -3010 7716 -3030 1444
- 1995 7881 -2720 1106 1491 7844 -2745 1360 2065 1517 2097 1469 1992 7719 -3019
- 1370 2080 1436 2226 1164 1874 1312 2221 1382 2080 1303 2123 1439 2252 7690
- -3066 7882 -2716 7421 -3499 1105 1583 7907 -2658 1315 2145 1457 2230 899 1691
- 7733 -3011 1185 1988 7233 -2992 1435 2289 7602 -3074 1545 2178 7863 -2755 1121
- 1931 7881 -2720 7627 -2964 1418 1790 7462 -3391 1598 1871 7521 -3281 1381 2178
- 1415 2295 1456 2163 1344 1904 7815 -2848 7827 -2818 1568 2167 7751 -2969 7822
- -2780 1351 1843 1256 1850 7574 -3115 1266 1621 7879 -2714 1604 2063 7899 -2677
- 1390 1928 1719 1764 994 1907 1312 2023 7858 -2765 1405 2251 1207 1957 1444 2067
- 600 1322 1029 1539 1359 1893 7834 -2811 7813 -2841 7849 -2780 7629 -3121 940
- 1292 7856 -2769 1122 2016 7435 -3075 7834 -2813 1220 1966 1434 1904 1472 1804
- 7672 -3130 1045 1855 7855 -2771 7814 -2832 7806 -2869 1754 2035 1440 2260 1355
- 2113 7809 -2865 7586 -3142 7841 -2767 7688 -3096 7643 -3127 1448 2273 100 { m20
-} R 1001 1845 1577 2078 806 1698 1094 1525 1331 2155 7900 -2674 7810 -2850 1421
- 2284 1372 2125 1398 2030 1238 1348 7809 -2863 7887 -2665 1041 1975 7716 -3044
- 7899 -2654 7791 -2764 7595 -3291 1496 1951 1126 1413 7886 -2710 1602 2064 7891
- -2697 7885 -2708 7844 -2782 7637 -3015 7890 -2697 1312 1595 1583 2092 7335
- -3163 1627 2126 1234 1907 7487 -3020 7751 -2946 1263 1849 1432 1757 7615 -3188
- 7658 -3126 1078 1712 7685 -3102 7895 -2691 1078 1955 7824 -2827 7490 -3348 7795
- -2887 1536 1940 1425 2183 1406 1403 1057 1771 1419 2020 7707 -2912 7888 -2705
- 1337 2288 7874 -2734 1536 1979 7656 -3138 7900 -2680 1278 2201 1169 1358 7632
- -3190 7906 -2670 1376 2154 7846 -2789 7284 -3257 7784 -2865 7908 -2666 7066
- -3290 7666 -3150 7881 -2720 7830 -2823 7814 -2822 7777 -2902 7687 -2981 7267
- -3398 961 2016 7783 -2873 1343 2257 7889 -2652 944 1547 1290 2156 7886 -2700
- 1176 1724 7864 -2705 7551 -3076 7741 -3002 7639 -3016 7757 -2932 1434 2203 7702
- -3080 7718 -2977 7877 -2726 1461 2163 1361 1999 1340 2016 7430 -3310 7792 -2876
- 7740 -2949 7737 -2999 7838 -2793 7846 -2787 100 { m20} R 1416 2288 7692 -3084
- 1600 1754 1506 2136 1375 2248 7899 -2671 1455 2223 7805 -2846 7907 -2640 7855
- -2744 7751 -2935 1216 1872 7873 -2719 1235 2008 1292 1454 7862 -2755 7868 -2692
- 1581 917 7834 -2806 1348 2077 1019 1265 1151 2040 7874 -2734 1610 2069 7751
- -2969 1350 1569 7876 -2676 1224 2221 7591 -3083 1182 1572 7832 -2734 1564 1982
- 7789 -2906 1354 2263 1083 1732 1795 1973 7854 -2743 7699 -2888 1454 1801 1266
- 2110 1363 2206 1562 2096 7324 -3345 1058 982 7875 -2731 7899 -2680 7863 -2754
- 7469 -3547 1546 2118 7846 -2786 7884 -2714 1505 2189 7755 -2956 7769 -2945 7815
- -2848 1396 2322 7858 -2765 7672 -3014 1451 2264 1387 2132 7604 -3059 7889 -2702
- 7840 -2788 1418 2254 1436 1878 7780 -2841 1296 1740 7877 -2726 1427 2292 1318
- 2004 1394 2138 1364 2240 7711 -3002 1087 2185 1276 1836 1472 2199 7816 -2696
- 1241 2129 7793 -2846 7864 -2741 1046 1939 1499 2221 7879 -2694 7861 -2744 1506
- 2049 7662 -3105 1550 1994 676 1581 7865 -2740 7657 -3171 1411 2234 1516 2136
- 7847 -2787 7774 -2851 1674 1514 7555 -3159 1257 2032 7890 -2690 7861 -2761 6818
- -3461 100 { m20} R 7657 -3135 7873 -2736 7701 -2884 7904 -2667 1125 2093 7855
- -2772 7802 -2842 1321 1712 1469 2215 7793 -2790 1786 1684 1328 2321 7778 -2928
- 1271 1960 1477 2117 1099 1974 7737 -2985 7746 -2949 1349 2009 1532 2156 7691
- -2937 7760 -2965 1409 1889 7869 -2738 7900 -2651 7809 -2842 7542 -3090 7622
- -3060 7660 -3161 7803 -2858 1410 1755 7856 -2760 1466 2252 7797 -2804 1315 1972
- 1475 1626 7812 -2847 7579 -3303 7503 -3010 1061 1946 1426 1880 1475 2227 1389
- 1287 7733 -2983 7903 -2673 7451 -3578 818 1804 1363 2067 1281 2002 1288 1670
- 7618 -3098 7613 -3205 7632 -3218 1430 2076 7732 -2971 1606 2123 1343 1931 7487
- -3282 7789 -2807 1684 1850 1346 2021 1397 2095 7818 -2840 7431 -3093 7707 -3069
- 1301 1963 7792 -2899 1346 2003 7864 -2719 7754 -2947 1467 2025 1439 2121 7830
- -2822 7855 -2770 7746 -2960 1484 2173 1408 1975 7704 -3056 7694 -3095 1313 2091
- 1267 1681 1468 2069 1409 1983 792 1743 7405 -3659 7902 -2671 7714 -2949 7818
- -2848 7891 -2691 1646 2004 1520 2145 1257 1740 7320 -3370 1357 2056 7900 -2677
- 1250 1845 7748 -2915 1578 1928 1436 1661 1472 2075 100 { m20} R 1408 2310 1204
- 2107 1231 1790 1634 1970 1686 1691 1365 2245 7782 -2838 7864 -2748 7716 -3026
- 7728 -2893 1567 2067 7632 -3052 1286 1752 7475 -3250 1345 1954 7565 -3052 7855
- -2769 7887 -2700 7897 -2688 1331 1263 7801 -2878 1133 2046 1448 1965 1203 1824
- 827 1940 1056 1669 1014 1596 1618 2044 1459 2143 7653 -2897 1830 1678 7497
- -3144 7651 -3148 1405 2227 1611 1906 7696 -3033 526 1296 7880 -2717 7863 -2756
- 7751 -2910 1412 2182 7823 -2828 1111 2183 1692 2048 1664 2052 1754 1932 1487
- 2090 7871 -2740 703 1653 7621 -3103 7550 -3334 7430 -3623 7881 -2718 1394 1816
- 1037 1580 1244 1529 1252 1668 7783 -2874 1351 2175 888 1736 7799 -2846 7858
- -2764 7741 -3002 1087 1594 7826 -2829 1245 1933 7824 -2820 7849 -2782 1116 1343
- 7830 -2808 1528 2179 1565 2091 7856 -2765 881 1897 1438 2209 925 1477 620 1815
- 7816 -2793 1470 2142 7188 -3409 1386 2100 1292 2029 7907 -2644 1569 1657 786
- 1505 7795 -2858 7697 -3005 7787 -2904 7862 -2753 7908 -2662 1241 2020 1067 1836
- 1601 2127 1507 2047 7818 -2836 1403 2171 1067 2002 7806 -2838 7854 -2766 7825
- -2807 100 { m20} R 7808 -2858 7893 -2697 1394 2114 1408 2121 7631 -3033 7140
- -3109 1538 2173 1573 2145 1543 2190 1437 2223 7871 -2738 1629 2044 1445 2160
- 874 1364 7624 -3017 7880 -2720 1343 2048 1422 2219 1453 2104 875 2056 1480 1988
- 1338 2090 1464 2140 7830 -2764 1343 1862 7764 -2956 7440 -3063 7853 -2776 7789
- -2850 1455 2267 1284 1637 7357 -3583 7832 -2797 1136 989 1089 1796 7877 -2709
- 1375 2183 7864 -2752 1474 2136 7867 -2748 1298 1688 7880 -2719 1241 2184 7802
- -2871 7811 -2859 7575 -2993 7863 -2753 7835 -2794 1152 2036 1759 2027 7799
- -2883 7904 -2643 7711 -2885 7852 -2766 1531 1992 7892 -2682 7616 -3202 7881
- -2713 7829 -2824 7794 -2895 1423 2014 7731 -2934 1387 2332 7900 -2672 7708
- -3052 1439 2041 1328 2151 7696 -3084 1623 1955 7687 -3075 7850 -2714 7901 -2674
- 1296 1854 7728 -3028 1552 2151 1226 1917 7827 -2828 7890 -2690 1431 1940 7780
- -2922 7873 -2736 7830 -2788 7729 -2999 7829 -2777 7883 -2687 7347 -3134 1838
- 1917 1448 1979 1438 1932 7742 -2989 7853 -2775 7894 -2688 7885 -2712 7800 -2866
- 7700 -2996 7819 -2795 1011 1632 1240 1443 7741 -2983 1511 2109 100 { m20} R
- 6963 -3665 7855 -2769 7891 -2691 7715 -3043 1360 2036 1434 1916 1610 1913 1265
- 2074 7792 -2894 7771 -2919 7842 -2781 1396 2026 7901 -2646 7893 -2683 7600
- -3055 7900 -2664 1252 1583 1283 2216 7537 -3275 7837 -2787 7794 -2856 7833
- -2780 1561 1976 1406 2320 1487 2163 7570 -3175 7621 -2871 1293 1852 1304 1896
- 1271 1776 7900 -2678 7800 -2839 1344 1473 7774 -2889 1149 1936 7699 -2946 1460
- 2267 1205 1721 7888 -2699 1220 2100 1547 2065 1577 1933 7799 -2837 7076 -3497
- 7883 -2685 7893 -2696 1118 2067 1579 2147 1451 2199 1240 1783 7902 -2666 1383
- 2175 7836 -2699 1455 2121 7822 -2806 7697 -3040 7878 -2634 1251 1528 7765 -2919
- 1384 1655 7894 -2695 1559 2046 1406 2169 1568 2107 1347 2138 7724 -3000 1394
- 1955 7832 -2799 1462 1833 1357 2108 7798 -2876 1119 1716 7731 -2989 1165 1498
- 7892 -2699 1392 2142 7900 -2675 6760 -3260 1628 2123 1349 1971 7819 -2804 1583
- 1763 1415 2160 1377 2201 1809 1836 6275 -3492 1396 1629 1301 2039 1633 2123 985
- 2031 1438 2001 7815 -2811 7691 -2922 7564 -3290 7784 -2905 7887 -2702 1535 2174
- 1551 2043 7687 -3110 1278 1630 100 { m20} R 1550 2176 7512 -3454 1489 1927 1338
- 1872 1528 2141 1404 2015 1490 2017 1005 1233 7833 -2817 1028 1966 1281 1966
- 1534 2094 1165 1660 1384 2197 561 1247 1294 1515 1222 1968 1305 2040 1055 1577
- 7513 -3096 1081 1689 7808 -2746 1268 1925 7765 -2777 7846 -2789 7205 -3588 1486
- 2208 1011 2011 7723 -2928 1461 2260 1559 2178 1035 1872 7666 -3015 7759 -2956
- 7669 -3135 7907 -2617 1346 1528 7857 -2734 1323 1710 7902 -2678 7709 -2891 1664
- 2096 7803 -2878 1385 1927 7906 -2670 1618 2038 7792 -2899 1256 1854 7806 -2870
- 7799 -2883 7753 -2942 7705 -2966 1626 2114 1103 1542 7561 -3197 1293 1973 1484
- 1720 1263 1329 1428 2175 1460 2235 1350 1899 1278 1868 1057 1830 1171 1953 1253
- 1882 7678 -2942 1391 1586 1427 2089 7865 -2752 7585 -3039 1167 2136 7832 -2818
- 1245 2008 1297 2019 7711 -3009 1444 2208 1453 2278 1471 2157 1443 2248 1542
- 2157 1269 1875 7877 -2729 1026 1162 707 1760 805 1985 1408 1925 1083 1627 7863
- -2729 1218 1981 7894 -2690 1557 2068 7746 -2985 1352 1970 7619 -3221 991 1776
- 1810 1928 1257 1886 7900 -2682 1402 2331 7733 -2992 100 { m20} R 7818 -2833
- 7740 -2877 1058 1520 1501 2142 1321 1945 7686 -3088 7665 -3089 7805 -2871 7748
- -2964 1479 2122 1481 2247 1167 1940 7606 -3052 1016 1702 1522 1974 1237 1664
- 7761 -2892 7714 -3033 1656 2005 1556 1941 7711 -3054 1385 1670 7773 -2937 1296
- 2034 7818 -2847 1322 2062 7745 -2991 1357 2313 1473 2233 1445 2258 1585 2109
- 7523 -3365 7793 -2879 7856 -2758 7887 -2698 7882 -2709 7854 -2775 1895 1737
- 1555 2082 1536 1908 7839 -2798 1785 1642 1559 1968 1254 1667 1164 2118 7830
- -2822 1424 2059 1436 2292 7461 -3329 1182 2046 1416 2256 7327 -3129 7863 -2756
- 1260 1735 1342 2257 7824 -2834 7866 -2750 7860 -2754 7584 -3243 7848 -2765 1120
- 1866 7887 -2704 7839 -2787 7903 -2674 7724 -2939 1222 1881 7867 -2741 7830
- -2809 7881 -2719 7898 -2685 7877 -2721 1714 1884 1198 1829 7724 -2962 7433
- -3577 1504 1973 1563 2149 7891 -2691 7435 -3454 7846 -2782 7831 -2819 7658
- -3061 7741 -2993 1379 2156 7488 -3180 7255 -3260 7676 -3008 1375 2027 1412 2125
- 7684 -3114 1414 2248 7710 -3064 1303 1562 7868 -2717 7420 -3448 7841 -2799 1295
- 2163 7705 -2915 1369 2199 7733 -2832 100 { m20} R 7907 -2667 7807 -2857 1353
- 2252 1532 2072 7804 -2845 1385 2311 7743 -2997 1432 2109 1424 2216 1427 2278
- 1663 2104 1279 2149 1160 1872 7664 -3050 7809 -2840 1374 1853 7783 -2918 1472
- 2014 7846 -2785 1186 1804 7856 -2768 7785 -2898 7863 -2757 7873 -2707 7806
- -2868 1428 2186 7780 -2924 7894 -2691 1135 2063 7897 -2674 7709 -3043 7784
- -2914 7492 -2915 1153 904 7096 -3440 7470 -3203 7709 -2976 7619 -3059 1762 1912
- 910 942 7740 -2782 7892 -2698 7733 -2981 1639 2075 1527 2057 1623 1941 7899
- -2672 7862 -2759 7651 -2953 7804 -2782 1539 1933 7795 -2892 1620 2133 1577 2144
- 7662 -3079 7841 -2795 1356 1910 1474 2228 7631 -2980 1245 1844 1178 1909 7877
- -2666 991 1089 7640 -2917 1515 1964 1396 2232 1581 1900 1071 1965 7908 -2662
- 7785 -2913 7746 -2811 1647 1674 7651 -3184 1435 2181 7873 -2734 1514 2079 7848
- -2748 1423 2107 7833 -2779 7823 -2825 1075 2122 1190 1826 7623 -3128 1412 2154
- 924 1941 7888 -2704 1411 2289 7642 -3065 1087 1857 7824 -2832 799 1415 1454
- 1928 7591 -3126 7856 -2767 7894 -2690 1265 1777 1540 2010 7901 -2679 7720 -3013
- 7819 -2844 100 { m20} R 7714 -3001 7774 -2809 1782 1850 1420 2033 7739 -2986
- 7478 -3456 7571 -3076 1351 2315 919 1861 1258 1836 1434 2068 1256 2117 7876
- -2721 7363 -3356 7511 -3253 1439 2041 1720 1945 892 1906 915 954 7646 -3005
- 1519 2203 1539 2099 1236 2084 7869 -2743 7837 -2808 1458 2144 7838 -2784 7514
- -3451 1470 1837 1717 2032 1326 2272 7745 -2957 1213 2033 7768 -2936 1354 2196
- 1334 1977 1074 1932 7827 -2828 1227 2076 1599 1993 1359 1973 7770 -2937 7849
- -2783 1140 1807 7828 -2730 7563 -3083 7826 -2815 7904 -2673 7600 -3032 1657
- 1555 7882 -2717 979 1989 1365 2193 1201 2139 1691 1817 7755 -2946 7834 -2815
- 1114 1866 1208 2160 1405 2184 7666 -3153 7685 -3100 7701 -3083 1258 1653 961
- 2101 7888 -2707 7734 -3007 7845 -2789 1796 1852 7717 -3020 7697 -2803 1224 1852
- 7897 -2684 7480 -3092 1342 1801 7702 -3046 1341 2293 1416 2208 1741 1969 7896
- -2689 7902 -2678 1340 2086 6724 -3589 1396 2339 7254 -3538 1469 2104 7399 -3534
- 1577 2023 7832 -2693 7843 -2750 1507 1955 7847 -2781 7740 -2999 1021 1126 7752
- -2974 1666 2063 7822 -2834 1286 1927 7617 -3171 1525 1379 100 { m20} R 1573
- 2106 1220 1918 7713 -3058 1449 2160 1759 2007 1657 2011 1518 2105 7864 -2754
- 1422 1813 7804 -2866 7886 -2684 1062 1955 7805 -2862 1209 1664 7861 -2754 1393
- 2093 7823 -2785 1468 2239 7767 -2916 1229 2173 7708 -3018 1336 2316 7433 -3345
- 7749 -2930 1445 2033 1344 2149 7881 -2716 7854 -2737 1423 2010 1228 1830 1441
- 2244 1271 2297 7882 -2719 7767 -2944 1262 1544 7841 -2799 7816 -2729 7822 -2838
- 1478 2167 1280 1961 7907 -2665 1117 1537 1226 2100 1542 2194 1466 1706 1215
- 1654 1516 2061 1553 2059 48 { m20} R 7740 -2959 7565 -3265 1314 1985 7795 -2891
- 1831 1904 1165 2125 1587 2087 1288 1752 7906 -2659 1585 2098 1372 2184 1484
- 2160 1481 1962 1337 2033 7514 -3262 1735 1933 1443 2115 883 1714 7881 -2720
- 7235 -3296 1070 1964 1391 1951 7633 -3002 1713 1996 1405 2136 7839 -2793 1347
- 1643 7521 -3448 1316 2133 7807 -2814 7544 -3383 1775 1926 1338 2045 7851 -2780
- 7872 -2737 1436 2226 7871 -2737 7794 -2837 7884 -2712 1570 2049 7908 -2661 1423
- 2277 7907 -2658 812 1267 7836 -2811 1457 2149 1358 1695 1697 1924 7864 -2750
- 7750 -2985 1189 1591 1448 2200 7664 -3150 7858 -2765 1435 1945 461 1666 1303
- 1705 7784 -2894 7368 -3454 7614 -3239 1444 2114 7717 -3010 1304 1586 1389 2323
- 7882 -2651 7886 -2675 1239 2164 1351 2046 7785 -2895 7812 -2775 1450 2267 7777
- -2835 7765 -2933 1235 1947 1359 2230 1535 2178 7870 -2739 1531 2014 7791 -2901
- 7857 -2767 1316 2052 1180 1965 7822 -2826 7831 -2805 7904 -2672 1456 2086 7788
- -2905 1611 2074 1401 2293 1358 1795 1661 1509 7766 -2878 7671 -3111 7419 -3645
- 7443 -3373 7898 -2681 7467 -3216 1286 2096 1551 2042 7898 -2683 100 { m20} R
- 7902 -2677 1367 2155 7850 -2773 7861 -2748 1520 2102 1081 1987 1487 2046 7340
- -3271 1537 2070 7732 -3021 7467 -3173 1325 2187 7717 -3040 1489 2166 7783 -2917
- 7527 -3161 1895 1755 7741 -3001 1483 1859 1511 2172 1416 2203 1301 2031 1108
- 1782 7816 -2817 7871 -2739 7877 -2701 718 1851 7575 -2908 1468 2242 1520 2095
- 1416 2128 7487 -3267 7878 -2721 7755 -2770 7599 -3117 1471 2087 1362 2149 1330
- 2298 7688 -2947 7690 -2971 7908 -2666 1136 2127 1228 1597 1505 2135 7738 -2948
- 1667 1841 7608 -2896 1336 2133 1380 2203 1009 1355 7860 -2760 1404 2304 7907
- -2638 1413 1976 1457 1912 995 1982 7877 -2726 1573 2079 7379 -3450 7870 -2718
- 1641 1809 7743 -2999 7716 -2970 1358 2162 1350 1494 1408 2140 1518 2080 7861
- -2738 1101 1938 1377 2072 7882 -2719 1483 1902 1167 1414 1392 1798 7794 -2889
- 1392 2238 1444 2096 1514 2184 7728 -2984 1193 2021 7895 -2690 1396 2287 1518
- 2105 7797 -2852 7882 -2718 1507 2221 7740 -2921 1123 1831 1686 2011 1647 1354
- 1364 2234 1463 2005 7805 -2873 1469 1864 1248 1851 1065 1497 1356 2006 7559
- -3047 7493 -3461 7700 -3034 100 { m20} R 7872 -2730 1275 1876 1483 1887 7828
- -2818 7894 -2693 1204 1911 1586 1964 7675 -3133 7653 -3072 1155 2179 7878 -2693
- 7787 -2870 7511 -3451 1349 1079 7507 -3202 1551 2188 7536 -3268 1398 1895 7804
- -2840 7869 -2682 7893 -2690 7869 -2700 7855 -2772 1356 2066 1367 2152 7248
- -3104 7692 -2862 1680 1650 1543 2146 1071 1750 7848 -2763 7628 -3175 1256 1835
- 1088 1715 1095 1830 7795 -2890 7808 -2867 1084 1437 1438 2132 7711 -3016 1144
- 1302 7612 -3198 7511 -3230 7833 -2801 7453 -3470 7658 -3153 7828 -2819 1335
- 1927 1378 2196 7908 -2659 7771 -2939 1563 2150 7867 -2742 7906 -2669 1181 1956
- 7423 -3158 7884 -2713 1350 1858 7841 -2800 7661 -3028 7728 -3026 1585 1906 1598
- 2092 7614 -3184 7603 -3261 7796 -2865 1586 2099 7799 -2798 1481 2172 1471 2238
- 7866 -2751 7518 -3182 1506 2059 7470 -3112 1497 1868 1545 2177 7889 -2700 1273
- 1907 7766 -2917 7859 -2762 7878 -2725 7798 -2816 7758 -2958 7754 -2971 7717
- -3048 7741 -3003 7612 -3075 7819 -2846 1687 1950 1329 2021 7831 -2783 1476 2153
- 1400 2189 1447 1822 1474 1797 1224 1905 7806 -2729 1384 1960 1221 1511 7869
- -2733 100 { m20} R 7857 -2758 1446 1962 1650 2100 1525 2191 1390 2223 1680 2025
- 7887 -2703 7747 -2868 1365 2090 7881 -2720 1380 1914 1322 1855 1412 1984 7660
- -3087 7712 -3055 1406 2211 1515 1949 7822 -2837 1401 2043 898 1255 1536 2193
- 1128 1998 1482 1856 1196 1947 1230 2165 7690 -2979 7682 -3022 7871 -2741 7872
- -2710 7292 -3319 7861 -2747 7736 -2925 7691 -3017 1555 2040 1141 1359 1498 2219
- 1644 2111 7843 -2797 1617 1936 7885 -2707 7874 -2703 1389 2056 1325 2034 1400
- 1686 7730 -2963 7353 -3262 1326 1783 1411 2090 7327 -3272 1059 2020 7675 -3043
- 7905 -2669 7790 -2898 1371 2119 7855 -2766 7836 -2783 1331 1992 7774 -2934 1328
- 2123 1459 2222 1425 1808 7804 -2867 1435 2032 7866 -2747 7677 -3084 910 1970
- 7875 -2730 7716 -3002 7737 -3004 1422 2006 7757 -2954 7909 -2663 7825 -2795
- 7710 -2940 7833 -2815 886 1955 905 1934 7904 -2674 1515 2205 961 1958 7864
- -2754 7512 -3346 941 1825 1696 2027 1099 2120 1292 2071 1441 2006 7855 -2768
- 1228 1855 1879 1893 779 1499 7672 -2989 1467 2249 834 1797 7814 -2852 7862
- -2742 7864 -2724 7874 -2734 7852 -2744 7886 -2703 100 { m20} R 1424 2085 7732
- -2995 7655 -3156 969 1833 7798 -2736 1314 2092 1473 2212 7829 -2825 7894 -2693
- 7822 -2830 7896 -2687 774 1776 7782 -2918 1919 1891 1225 2029 7854 -2770 7315
- -3205 7592 -3076 7785 -2914 7317 -3053 7628 -3038 1153 1988 1420 2273 1206 1788
- 1434 2125 1278 1829 1296 2021 1233 1771 7634 -3175 1472 2086 1323 2179 7838
- -2804 1168 1668 7843 -2796 7908 -2665 1150 2019 1421 2244 7871 -2733 1415 2154
- 1517 2220 7441 -3287 7889 -2695 7765 -2906 7874 -2734 7783 -2897 7787 -2909
- 7817 -2829 1391 2159 1458 2205 7580 -3228 1719 1692 1498 2070 7617 -3252 7415
- -3447 7852 -2776 7818 -2847 1875 1619 7578 -3309 1457 2148 1224 1940 7607 -3270
- 1488 2105 1357 2138 1267 2138 7839 -2803 1494 2154 7885 -2695 7719 -3024 1540
- 2152 7723 -3015 1126 1865 1361 2317 1542 2072 7529 -2993 7743 -2845 7631 -2897
- 7883 -2711 7726 -3034 932 2048 1617 1848 1381 2021 7732 -3016 7877 -2727 1441
- 2277 1408 1967 7746 -2976 7834 -2791 7835 -2788 1355 1922 7794 -2883 7484 -3107
- 7882 -2672 7904 -2672 7738 -2891 7491 -3316 1290 1841 7893 -2688 1808 1900 7900
- -2660 1677 2039 100 { m20} R 1461 1873 7553 -3124 1086 1582 7746 -2969 7782
- -2919 7905 -2670 7880 -2721 783 1562 7707 -3017 1009 1857 792 1927 7879 -2719
- 7812 -2859 959 1845 1039 1513 7549 -3163 7789 -2905 1069 2005 7822 -2796 1328
- 2129 1456 1919 1529 1911 7877 -2700 7619 -2913 1444 2265 7866 -2726 7854 -2713
- 1238 1900 1492 2206 7795 -2880 1083 1729 7797 -2888 7856 -2767 1424 2288 1592
- 2053 7595 -3051 7899 -2647 1456 2268 1545 1953 1323 1620 7421 -3541 7879 -2723
- 1512 2140 7882 -2716 1418 2097 1207 1952 7807 -2867 1436 1225 7862 -2746 7830
- -2775 1398 2122 1091 1893 7716 -2861 7721 -3019 7749 -2916 7830 -2787 1315 1906
- 7813 -2842 1522 1997 7198 -3363 7223 -3092 7860 -2760 769 1575 7789 -2903 7892
- -2681 1434 2183 7819 -2841 7770 -2807 1024 1796 7897 -2688 1142 1548 1438 1669
- 7868 -2739 1265 1794 1230 1722 1345 1887 7638 -3107 7896 -2627 7642 -3032 1406
- 2189 7886 -2705 7828 -2817 7875 -2731 7735 -3007 7678 -2969 1331 1764 1394 2004
- 1453 2150 1574 2158 1465 2054 7862 -2755 1560 1954 1517 2091 1579 2006 1407
- 1859 7219 -3868 1379 1892 7611 -3163 1490 2160 7693 -2972 100 { m20} R 1627
- 2002 1547 1940 7855 -2768 1367 1811 7774 -2866 1039 1520 1454 2204 7416 -2946
- 7856 -2769 1196 1747 1205 1739 7832 -2814 7842 -2795 7884 -2714 7834 -2813 1524
- 2108 1086 1536 1413 1946 1112 2089 1381 2209 7834 -2770 7688 -2988 1246 1782
- 1113 1372 1417 1957 7347 -3680 7687 -3111 7797 -2887 7901 -2634 1315 2080 1172
- 1738 1160 1609 1513 1893 7832 -2803 7758 -2969 1346 2087 7904 -2650 7675 -3128
- 7848 -2776 1050 1729 1474 2091 7443 -3372 1338 1646 7728 -3029 1290 1788 1442
- 1968 1429 2242 7892 -2698 1325 2213 7899 -2685 7731 -2963 7829 -2780 1343 1666
- 1410 2039 1529 2162 1272 1981 1400 2200 7764 -2888 7829 -2825 7772 -2908 7902
- -2649 1102 1924 1372 2296 1185 2078 1129 1786 1414 2184 7731 -2983 1393 2340
- 1242 1704 1493 1971 7317 -3115 1689 2037 7867 -2697 7749 -2930 7700 -3076 7831
- -2797 7752 -2978 7884 -2713 7531 -3404 7741 -3002 7865 -2753 962 1830 1489 2065
- 7709 -2968 1381 1883 1541 2197 1074 1133 1593 2139 7796 -2888 7875 -2724 7517
- -3257 7736 -2956 1472 2237 7825 -2790 7830 -2794 7876 -2731 7652 -3136 1770
- 2004 1324 1885 1209 1944 100 { m20} R 1315 1801 7811 -2834 7762 -2832 7749
- -2921 1612 2028 7628 -3041 7869 -2717 1496 2184 7853 -2773 7422 -3145 1249 2048
- 1396 1323 1437 1693 1435 1980 7797 -2869 7708 -3051 7576 -3313 7781 -2909 889
- 1330 7219 -3923 1664 2086 7602 -3114 1746 1950 7783 -2892 7819 -2844 1366 1788
- 7795 -2894 1572 1774 1537 1872 1408 2293 1285 1040 804 1057 1491 2058 1716 1448
- 7869 -2743 1242 1969 7897 -2682 7475 -3220 7907 -2663 7789 -2906 7690 -3045
- 7496 -3473 1406 2113 7824 -2791 1068 1824 1454 2075 7859 -2765 7444 -3203 1512
- 2217 1370 1664 7641 -3087 7893 -2670 7707 -2933 7863 -2752 7822 -2839 1218 2108
- 7893 -2695 1431 1788 7898 -2681 7794 -2896 930 2029 1459 2201 7907 -2660 1427
- 2124 7797 -2805 1300 1600 7893 -2694 7896 -2689 7896 -2670 1459 1933 1111 1848
- 7746 -2958 1466 2181 1507 2072 7857 -2696 1564 1914 1782 1707 7757 -2970 1494
- 2112 1229 1901 1556 2148 1469 1957 1453 2252 7749 -2980 7629 -2956 1074 1766
- 792 1001 1060 1959 7900 -2681 1342 1819 1343 1853 1286 2065 7853 -2775 1142
- 1872 1410 1823 7115 -3112 7701 -3044 1410 2298 7700 -3059 7654 -3172 100 { m20
-} R 7603 -3205 7806 -2827 1322 2261 1362 2194 7850 -2761 7868 -2741 7802 -2880
- 1138 1578 7847 -2756 1339 1960 1329 2162 7775 -2935 1534 2141 592 677 1380 2174
- 1272 1973 7898 -2680 7746 -2976 7313 -3271 1546 2194 7843 -2779 1495 2046 1362
- 2031 7899 -2680 1451 2182 7829 -2819 7803 -2769 1552 1888 7717 -3014 7749 -2985
- 7695 -3055 7880 -2705 1422 2201 1806 1980 1424 1720 1410 2002 1207 1585 1223
- 2152 7866 -2751 1343 1872 7611 -3065 1516 2146 7859 -2753 1513 2183 7658 -3171
- 7884 -2712 1138 1792 7899 -2682 7831 -2812 1466 1883 1309 2046 7558 -3213 7611
- -3010 1260 1985 7853 -2771 1518 2114 7773 -2913 7815 -2850 7843 -2795 1172 1737
- 1417 1757 1048 1989 1532 2103 7906 -2661 1138 1830 7829 -2821 1475 2237 1489
- 2094 7686 -2951 1230 2075 7804 -2862 7689 -2908 7841 -2774 7809 -2835 7835
- -2810 7870 -2725 7839 -2792 7870 -2698 7823 -2806 7821 -2820 1376 2197 1363
- 2036 1598 2003 1486 2071 7737 -2924 7874 -2716 1536 2065 1345 1947 7484 -3397
- 7754 -2972 7865 -2735 7831 -2765 7851 -2754 7834 -2812 1096 1986 6656 -3515
- 1541 2026 7909 -2657 7871 -2714 7898 -2635 100 { m20} R 1869 1847 1378 2239
- 1398 2240 1225 1870 7882 -2716 7813 -2858 1249 2279 1135 2035 935 1811 7818
- -2847 1460 1904 1567 2162 7857 -2761 1163 1541 1403 2312 7829 -2818 7869 -2699
- 1454 2018 1400 1578 1549 2018 1382 2055 925 1914 1470 2135 7426 -3377 1171 1904
- 7907 -2659 1332 1984 7854 -2771 1340 2069 1363 1962 7909 -2653 7780 -2922 903
- 2023 7876 -2730 7222 -3119 1491 1999 7785 -2897 7626 -3049 7869 -2734 1583 2126
- 7863 -2733 1340 2184 1573 1965 1280 1298 1621 1828 7429 -3631 960 1330 7721
- -2966 7363 -3202 7897 -2688 7592 -3011 1229 2024 7776 -2927 7276 -3262 1190
- 2048 1343 1654 1478 2216 7869 -2744 7193 -3268 1714 1891 7737 -2952 1168 1845
- 1336 2119 7808 -2822 7867 -2745 7719 -2929 1349 2111 948 1888 1292 2021 7795
- -2821 7707 -3015 1489 2243 7895 -2659 7905 -2656 1344 1897 1364 2091 7719 -3016
- 7808 -2852 7871 -2740 7463 -3547 1119 1942 1144 1652 7900 -2677 1469 2068 1592
- 2123 1215 1739 1263 1856 7505 -3200 1532 2204 1404 2276 1444 2235 7361 -3175
- 1185 1728 1193 2058 7899 -2683 7792 -2889 1388 1875 1451 2228 1388 1661 7589
- -3236 100 { m20} R 7906 -2668 1289 1696 1381 2148 1507 2149 7604 -3200 7776
- -2918 7874 -2731 1467 1970 7835 -2809 7540 -2954 7855 -2760 1284 2126 1718 1907
- 7904 -2672 1275 1871 1521 1845 7889 -2703 1182 1411 7771 -2849 1238 1544 1363
- 2084 7789 -2841 1541 2071 1279 2016 7482 -3216 7722 -3039 7882 -2714 7526 -2942
- 1547 2161 1436 2265 1526 2181 7724 -2990 1253 2279 1109 1310 1311 2170 7665
- -2959 1259 1903 7501 -3092 7616 -2890 7568 -3208 1445 2237 1602 2132 1417 1875
- 7779 -2923 1747 2012 7875 -2698 7798 -2863 7194 -3558 7806 -2843 7725 -2981
- 7794 -2892 7859 -2763 1449 1332 7859 -2751 7897 -2656 7483 -3135 1214 1088 7887
- -2700 1373 2171 7902 -2676 7812 -2788 7886 -2683 7891 -2698 1343 1862 1388 2245
- 1668 1838 7708 -3051 7883 -2708 7762 -2960 1759 1926 7776 -2811 1351 2014 7864
- -2755 7459 -3173 1318 2100 7821 -2842 7773 -2933 7881 -2720 7622 -3075 7665
- -2969 1385 1908 7605 -3103 1075 1629 1377 1981 7871 -2741 7888 -2705 7763 -2956
- 7885 -2699 7899 -2677 7894 -2690 1455 2233 1154 1662 7821 -2825 7750 -2971 7757
- -2953 1208 1405 1624 2062 1320 1927 7634 -3198 1547 2128 100 { m20} R 1491 1261
- 1241 2117 7861 -2757 908 1947 7738 -3009 7830 -2823 1415 2105 1657 1931 1522
- 2200 1382 2201 7881 -2713 1168 1806 1460 2052 1218 1729 1394 2133 1379 1889
- 7717 -3050 7891 -2692 7777 -2879 1315 2278 1041 1661 7880 -2706 7870 -2742 7805
- -2864 7542 -3081 7202 -3915 7223 -3077 1494 2184 1462 2194 1398 2181 7587 -3307
- 7863 -2753 1443 2263 7822 -2802 7749 -2948 7280 -3269 7586 -3275 7671 -3135
- 1515 2100 1502 2069 7876 -2716 1497 2143 1019 1180 1329 1730 7884 -2663 1274
- 2062 931 1870 1333 1865 7626 -3203 1448 2018 1293 1798 7845 -2786 7761 -2896
- 1327 2181 7738 -2898 7902 -2678 1294 1873 7831 -2818 7702 -2998 1006 2067 1096
- 1642 1356 2345 1271 1594 7756 -2886 1462 2242 7865 -2742 7709 -3062 1368 2078
- 7853 -2756 1332 2136 7703 -2822 7683 -3116 7699 -2867 1336 2094 1353 2127 7721
- -3020 7697 -3091 1197 2086 917 772 7628 -2931 1483 2138 1169 2009 7739 -2873
- 1725 1990 7614 -3059 7705 -2901 1558 2148 7829 -2821 1172 1528 7649 -3188 1498
- 2213 7611 -3236 1181 1927 1408 1909 1088 1670 7748 -2936 1377 2134 1289 1939
- 7778 -2888 7444 -3387 100 { m20} R 1171 1709 7816 -2823 7869 -2722 7493 -3312
- 1450 2089 7631 -3224 1018 1102 7518 -3168 1203 1948 1243 1939 1331 1744 7214
- -3245 1259 1968 7860 -2757 7381 -3018 1306 2194 1029 1589 1449 2269 7553 -3101
- 7658 -2923 1569 2071 1394 2118 1333 2147 1455 1435 1490 1859 1253 2084 7617
- -3155 1338 2021 1431 2244 1506 2181 1380 2001 1415 2242 1297 1926 7753 -2884
- 7829 -2816 7675 -2989 7776 -2923 7714 -3021 1480 1925 1452 1951 1213 1642 7533
- -3187 1442 2065 1367 1893 7872 -2734 7741 -2946 1325 2012 1384 2095 7881 -2713
- 1362 2334 1153 1697 7886 -2707 1427 2180 1961 1733 1355 2258 1532 1971 7599
- -3288 1577 1948 7894 -2694 7739 -3007 1330 2039 7759 -2850 7675 -3121 7730
- -3020 7896 -2683 7845 -2775 1604 2095 7735 -3014 7899 -2682 1212 1690 1405 1997
- 1517 1871 1683 2041 7854 -2757 1446 2187 1268 1933 1545 2193 7838 -2805 7824
- -2832 1266 2069 1380 2189 7871 -2737 7820 -2838 1220 2057 7701 -3067 1270 1899
- 1594 2027 7870 -2736 1325 1929 1405 2243 7859 -2722 1378 2179 1124 1827 7827
- -2742 1708 1952 1378 2164 7652 -3176 7806 -2855 1375 1924 1274 2090 100 { m20
-} R 1283 1472 7848 -2748 1403 1792 7835 -2812 7797 -2884 934 1998 7511 -3399
- 7836 -2772 7718 -3046 1549 1691 1321 2058 1523 2039 7870 -2741 7906 -2615 7847
- -2781 1560 2157 7763 -2830 7750 -2851 7851 -2775 7789 -2903 1370 2083 7862
- -2758 1526 2187 1274 1619 1411 2140 7863 -2731 1011 1225 1241 1437 1342 2076
- 7534 -3213 7412 -3069 7866 -2751 1496 2222 727 1701 7718 -3031 1331 2026 1206
- 2142 7715 -2855 7822 -2824 7907 -2667 7822 -2839 1212 2037 7816 -2827 7679
- -2848 7837 -2808 7617 -3076 1515 2195 1406 1813 1385 2326 7834 -2804 1438 1329
- 7455 -3339 7794 -2844 7909 -2657 1387 1988 1561 2164 1391 2059 1638 1933 7470
- -3528 1401 2191 7835 -2785 1579 1893 1210 1210 7840 -2771 1452 2224 7908 -2665
- 7855 -2767 1182 1495 7795 -2888 953 1617 1392 2154 1555 2141 1429 2292 1280
- 1962 7852 -2775 7526 -3292 1416 2216 7542 -3400 1122 1716 1553 1822 7795 -2879
- 1471 2165 7633 -3011 7905 -2665 1544 1765 7664 -3053 7899 -2681 1270 2068 7470
- -3445 7862 -2758 958 1555 1486 2194 7891 -2690 7875 -2732 1535 2070 1700 1984
- 7876 -2712 1325 2119 1533 1879 7436 -3230 100 { m20} R 7903 -2672 7886 -2679
- 7879 -2696 7874 -2735 7826 -2805 7707 -2883 7788 -2907 1450 2186 1167 2084 1183
- 1879 7874 -2732 7679 -2945 7832 -2819 7731 -2997 7619 -3189 1321 2346 7890
- -2680 1373 2304 1756 1775 7847 -2777 1653 1916 7865 -2750 1498 1952 7887 -2679
- 772 1919 1406 2191 1087 1828 1619 1992 1229 1971 7878 -2725 7810 -2861 7718
- -3039 1512 2037 865 1249 7833 -2735 1245 1742 1243 2105 1390 2223 1424 2023
- 7744 -2882 7066 -3306 7836 -2810 1496 1730 7656 -2971 7442 -3130 7574 -3287
- 1405 2169 1450 1801 7829 -2825 7544 -3366 1217 1952 1230 1792 7755 -2924 7698
- -2841 1639 2073 1410 2016 7846 -2776 1494 2233 7899 -2684 7900 -2678 1037 1700
- 1338 2137 7521 -3067 7586 -3010 1288 2015 1194 2066 7641 -3155 7774 -2930 7802
- -2879 7637 -3064 864 1467 7897 -2688 1658 1948 7865 -2672 1022 1893 1108 1912
- 7898 -2685 1331 1961 7693 -3016 7875 -2727 1276 2114 1411 2056 7827 -2788 1480
- 1957 1381 2177 1398 2257 1345 2250 677 1594 7252 -3774 7615 -3225 7874 -2731
- 7468 -3501 1250 1361 1484 2168 1290 1996 1322 2328 1358 2210 7907 -2651 7871
- -2731 1656 2081 100 { m20} R 1367 1940 7828 -2827 1290 2017 1250 2018 7642
- -2964 1479 2133 1260 1841 1526 2099 1264 1948 7851 -2777 7698 -2952 1437 1977
- 7665 -2844 7590 -3265 1277 1683 1225 1781 1224 1916 7566 -3144 7747 -2905 1356
- 1971 1631 1957 106 1890 7778 -2913 1425 2132 7845 -2793 1049 1603 7751 -2944
- 7741 -2951 1505 2015 7775 -2935 1447 2238 7889 -2697 1431 2257 7867 -2706 1486
- 2003 1415 1908 7549 -2873 7843 -2793 1089 1627 7892 -2689 7769 -2945 7475 -3358
- 7836 -2811 7864 -2755 1283 2230 1369 2059 1534 1957 1190 2015 7534 -3177 1501
- 1899 7881 -2718 1352 2206 1479 2196 7829 -2792 7586 -2914 1236 1345 7189 -3968
- 7864 -2747 7647 -2957 7565 -3254 1327 2016 7602 -3223 1464 1862 7742 -2975 1269
- 1547 1519 2177 7870 -2737 7528 -3086 1397 2076 1370 2206 1547 1810 7559 -3129
- 1428 1973 1307 1844 7888 -2701 1398 2168 1539 1959 1629 2116 1438 2143 1336
- 1913 7484 -2928 1617 1925 7745 -2946 1208 1603 1454 2269 1330 2286 1320 2055
- 1380 2320 7651 -3152 1241 1565 7605 -3054 1453 2001 7899 -2682 1478 2076 7693
- -3061 971 1658 7868 -2744 7876 -2690 1015 1892 1210 1973 100 { m20} R 7865
- -2730 7890 -2681 7889 -2704 7527 -3236 7536 -3417 1296 1667 1448 2008 7874
- -2734 1269 1643 7854 -2769 1217 1650 7887 -2707 7621 -3239 1503 2074 1288 2193
- 7831 -2718 1054 1780 7558 -3056 7900 -2675 7801 -2854 1373 1873 7847 -2789 1374
- 2088 1440 2176 1170 1919 7716 -2999 1239 1911 7669 -3102 7845 -2790 1322 2242
- 7905 -2670 1285 1933 1740 1864 7534 -3246 7588 -3312 7834 -2800 7509 -3312 7738
- -3000 1435 1879 7820 -2820 896 1343 1425 2062 1382 1864 7744 -2972 1270 2175
- 1389 2014 7553 -3222 7551 -3000 7601 -3076 1570 2173 7719 -3048 7751 -2971 7690
- -3073 7789 -2802 1420 1913 7704 -3057 7819 -2789 7652 -2952 7724 -2953 7805
- -2855 1227 1599 7909 -2659 1462 2229 1420 2230 7848 -2786 1087 2237 1583 2165
- 7374 -3511 7643 -3082 7808 -2808 1478 2133 7888 -2695 2384 1543 7741 -2968 1260
- 1662 1188 1554 7893 -2694 1515 2212 1306 2133 7868 -2746 7609 -2979 1448 1990
- 1334 1960 7558 -2970 1180 1841 1651 1867 1704 1895 1351 2024 1231 1870 7805
- -2871 1420 2266 1361 2281 7762 -2961 7860 -2745 1422 1907 7823 -2832 1336 2045
- 7869 -2723 1339 2140 1305 2020 100 { m20} R 7509 -2990 1367 2190 1404 2139 7772
- -2924 1418 2085 1192 1741 7688 -3088 7522 -3316 1346 2200 394 1330 1630 1952
- 7868 -2745 7858 -2732 1330 1983 7839 -2776 7821 -2761 7613 -3008 7380 -3380
- 1307 1848 1387 2166 7906 -2646 1568 2153 1563 2115 7867 -2735 1434 2233 1055
- 1831 7741 -3001 1325 2259 1471 1901 1445 2266 7600 -3280 7629 -3196 1126 1925
- 1320 2197 7662 -2986 1628 2130 7864 -2733 1406 2187 1331 2094 7901 -2671 1202
- 1934 7771 -2942 7877 -2699 1304 1980 7880 -2710 7779 -2746 1434 2065 7827 -2824
- 7810 -2802 7511 -3041 7247 -2949 1376 1570 1292 2195 7528 -3129 1606 1730 7907
- -2642 7789 -2905 7769 -2909 7872 -2728 7668 -2996 7885 -2676 1460 2098 7710
- -2885 1477 2060 7848 -2772 7632 -3148 1337 2271 7844 -2756 7733 -2992 7885
- -2712 7848 -2781 1327 1975 7718 -3001 1541 1616 7841 -2799 1458 2153 1557 2175
- 1261 1985 7833 -2813 7865 -2745 7891 -2696 7893 -2675 7349 -3546 1388 1987 1244
- 1702 1345 2125 7827 -2819 1493 1746 1554 2106 1342 1956 902 1382 1243 1545 1262
- 1793 7661 -3163 7793 -2882 7856 -2766 7889 -2702 1323 2085 7906 -2669 7893
- -2695 100 { m20} R 1295 1716 1227 2077 1398 2327 1447 2046 7731 -2847 1347 1919
- 1085 2137 7736 -2949 7753 -2916 1291 1918 7846 -2781 1349 2319 7601 -3284 7808
- -2809 7468 -3188 7790 -2887 1504 2130 1393 2137 7185 -3488 7894 -2694 7803
- -2825 7861 -2758 1098 1825 1279 1765 7740 -2981 7445 -3504 1214 1440 7806 -2863
- 7595 -3261 1140 1035 7773 -2861 1328 2207 1250 2039 7688 -3076 1422 2100 1349
- 1308 1351 2168 1414 2314 1274 1736 1460 1967 1572 2080 7564 -3003 7799 -2873
- 1331 1675 1362 1789 7784 -2862 7816 -2849 1564 1672 1215 2231 7866 -2742 1481
- 2076 7804 -2855 1158 1862 7767 -2890 7845 -2792 7829 -2781 867 1708 7353 -3078
- 7892 -2620 7789 -2838 7693 -3085 1207 1942 1308 2070 1431 2299 7880 -2695 7516
- -3188 7851 -2770 7827 -2828 7767 -2920 831 1976 1350 2014 7387 -3069 1259 1794
- 1466 2174 1456 2147 1172 1811 1125 1622 7674 -3092 1274 1936 1445 2185 1452
- 2160 1410 2093 7757 -2955 1519 1914 7828 -2819 1436 1872 7612 -3230 7785 -2913
- 1519 2179 1418 2265 7888 -2691 7416 -3642 1478 2207 7905 -2660 1386 1848 7790
- -2780 7800 -2809 1463 2090 7860 -2735 1397 1806 100 { m20} R 1325 2086 7631
- -2907 7663 -3130 1514 2219 1247 1474 1383 2209 1354 2028 1488 2170 7788 -2821
- 7875 -2728 815 1669 7768 -2870 7904 -2669 7889 -2704 7730 -3015 7633 -2907 1453
- 2238 1765 1941 1228 2035 7887 -2708 7731 -2963 7370 -3144 7834 -2810 7907 -2657
- 1639 2079 7655 -3090 1377 2248 1276 2051 1145 1925 1288 1622 1313 2229 7688
- -2978 1475 1956 7816 -2830 7844 -2788 7502 -3442 1461 2159 7815 -2850 1460 1995
- 1445 1644 7899 -2683 7905 -2665 7791 -2871 7683 -3086 7850 -2776 1456 2213 1452
- 2216 7815 -2850 1436 1954 1690 1991 1162 1881 1247 1816 1327 1672 7847 -2789
- 7902 -2676 7740 -2978 7903 -2673 1431 2255 1688 1922 1500 2029 7755 -2908 7215
- -3704 7755 -2954 1672 2077 7575 -3161 7769 -2880 1502 2146 7864 -2699 1227 1712
- 7749 -2987 1361 2179 1573 2173 7812 -2859 7759 -2944 7836 -2803 1378 1703 1637
- 1820 7821 -2836 7887 -2708 7874 -2713 7891 -2693 7826 -2820 7738 -2863 1500
- 2016 7883 -2703 1172 2132 1216 1744 1694 2026 7547 -2992 1479 2169 7834 -2814
- 1521 1673 1507 1515 1598 1990 7629 -3222 7674 -3092 7854 -2725 7707 -2978 841
- 1476 1368 2093 100 { m20} R 7837 -2783 7890 -2701 7903 -2662 1416 2254 7440
- -3262 1414 2234 1175 1691 7787 -2909 1091 1789 7847 -2720 1247 1097 7885 -2686
- 7239 -3510 7758 -2870 1711 1915 1463 2193 7908 -2655 7705 -3044 1464 1973 1166
- 2021 7802 -2874 7864 -2752 1615 2013 7552 -2986 1099 1993 1315 2261 7618 -3099
- 7770 -2793 7880 -2706 1242 1656 7561 -2928 1271 1883 1332 1985 1321 2191 7782
- -2876 7774 -2887 7806 -2817 1511 2196 1623 2100 1545 2029 7674 -3065 1438 2288
- 7892 -2693 1476 2184 1469 2118 7795 -2863 1366 1806 1335 1924 48 { m20} R 7815
- -2787 7683 -3120 7746 -2992 7794 -2870 7622 -2950 1307 2180 7431 -3296 1564
- 2061 1100 2040 7888 -2701 1486 1935 1343 2077 1440 1977 7633 -3197 7665 -3153
- 7765 -2950 7879 -2722 7516 -3177 7406 -3477 7606 -3208 1172 1812 1274 1710 1247
- 2000 1427 2259 1433 2209 7880 -2690 1429 2099 7848 -2784 1414 2293 7609 -3224
- 7887 -2708 1659 2002 7870 -2742 1507 1501 1349 1982 7863 -2756 7879 -2690 1535
- 1939 1381 1916 1237 2089 7905 -2664 7858 -2738 7794 -2885 7866 -2736 1449 2280
- 7734 -2884 7568 -3313 1293 2052 1356 1928 7785 -2902 7585 -3253 1435 2152 1454
- 1992 1352 2104 1464 2267 1219 2102 1384 2162 1452 2244 7867 -2743 7741 -2986
- 1456 1631 7856 -2770 1405 1966 1454 1969 833 1241 7715 -3052 1445 2174 1379
- 2207 7883 -2713 7338 -3073 7853 -2768 1287 2059 7737 -3010 7764 -2926 1363 2094
- 7779 -2924 1705 1764 1483 2043 1234 1721 1070 2045 1361 2051 7858 -2766 1244
- 1695 7905 -2669 1147 1776 7321 -3162 7832 -2818 1189 1835 7708 -3002 1076 1770
- 1331 2169 7800 -2863 7877 -2728 1408 1986 7845 -2791 1371 2247 7875 -2720 1485
- 2240 7530 -3428 1326 2022 100 { m20} R 7737 -2916 7864 -2751 1508 2205 1314
- 1660 1449 2085 7835 -2805 1439 1972 1441 2204 7756 -2928 7710 -3029 7385 -3443
- 7667 -3079 904 1922 1202 1948 7812 -2860 7865 -2748 1420 1644 1149 1898 7694
- -3078 7145 -3059 7794 -2844 7796 -2891 1280 1919 7856 -2766 980 1573 1399 2266
- 1361 2393 7860 -2757 1686 2031 7591 -3082 7734 -2947 1245 1652 1135 1838 7847
- -2769 1200 2159 7830 -2808 7780 -2911 953 1602 1334 2239 1280 1903 7710 -3040
- 7778 -2905 7863 -2754 7837 -2810 7860 -2751 1237 2067 7788 -2905 1384 2150 7519
- -3142 1543 1783 1295 2142 7877 -2715 7908 -2639 1374 2285 1251 1961 7902 -2672
- 1449 1653 1170 2015 1540 2058 1285 1869 7609 -3260 7900 -2658 1621 2083 1309
- 1856 1137 1551 1421 2244 7661 -3127 7654 -3132 7748 -2976 7850 -2779 7663 -3059
- 7884 -2711 7857 -2765 1459 2197 1405 2165 1300 960 7619 -3243 7896 -2689 1301
- 1808 7803 -2877 7803 -2872 1161 1999 1257 1917 1463 2095 1434 2144 7885 -2712
- 7856 -2724 1633 2047 7730 -3005 1151 1411 1210 1736 7813 -2851 1428 2181 7844
- -2793 1416 1427 1277 2128 7669 -3011 7724 -3010 1272 2059 1497 2213 100 { m20
-} R 1518 2194 1490 1847 1477 1825 7855 -2747 7834 -2809 7474 -3444 7899 -2681
- 1306 2085 7856 -2727 7670 -3033 7802 -2809 7887 -2708 7850 -2782 7706 -3002
- 1320 2216 1242 1808 1342 1808 7909 -2646 1338 1928 671 1794 7743 -2943 1725
- 2032 1153 1871 1327 1876 1348 1626 1121 1794 7786 -2879 1403 1970 7687 -3060
- 1252 1876 7880 -2716 1078 1750 1457 2173 1228 1757 7899 -2680 7652 -3073 7760
- -2931 7852 -2726 1316 1921 7849 -2785 1075 2045 7782 -2862 7876 -2731 7627
- -3219 7780 -2925 7779 -2920 1668 2033 1601 1804 7456 -3205 7696 -3045 7894
- -2692 7753 -2970 7483 -3174 1452 1974 1468 2260 7620 -3218 1355 1724 1143 1568
- 7839 -2760 7883 -2679 1481 2155 7594 -3085 1122 1338 1361 2234 1384 2248 1393
- 1708 1500 1866 1476 2138 1436 2208 7537 -3115 7622 -3041 7537 -3013 847 1832
- 1450 2138 1230 1862 1470 2193 7853 -2736 7818 -2847 7871 -2700 1491 2116 1399
- 1911 7678 -3023 7732 -2964 1324 2059 7793 -2885 1352 2118 1730 1934 7737 -2872
- 7696 -2943 7777 -2881 7839 -2803 7890 -2682 1080 2012 7685 -3105 1669 2020 7791
- -2874 1303 2098 7813 -2853 1482 2196 1421 1885 100 { m20} R 7813 -2855 1107
- 1379 1936 1580 7467 -3264 1451 2235 1498 2180 7721 -3029 7746 -2900 7781 -2914
- 7655 -3049 1348 2078 7893 -2695 1411 2060 1274 2054 1492 2159 1334 2035 7691
- -3076 981 1710 7897 -2687 7824 -2804 7603 -3155 7647 -3112 7908 -2649 1276 1776
- 7808 -2822 1456 2256 7772 -2901 7894 -2668 1355 1987 7835 -2811 859 1831 7312
- -3006 7769 -2898 7416 -3341 7898 -2678 7872 -2731 1443 1710 7797 -2789 1153
- 1386 1447 2189 1462 2179 7733 -2985 1462 2220 7732 -2956 1564 2033 7739 -3004
- 1606 2040 1360 2161 1203 1874 1362 1304 1581 1786 7798 -2871 1424 2063 1200
- 1942 1266 1984 7708 -3039 7643 -2926 7800 -2869 1326 2042 7906 -2663 7673 -3002
- 7895 -2676 7551 -3315 1277 2071 1221 2137 1681 1741 1289 1923 1463 2226 7677
- -3107 7888 -2672 1181 1974 1401 2208 1506 2097 7856 -2742 7390 -3143 1360 2171
- 1481 1990 1415 2202 7696 -3078 7732 -3020 1452 2014 1108 1913 7901 -2657 7905
- -2670 7578 -3012 1537 2196 1410 2111 7263 -3064 1442 2180 7837 -2806 7896 -2658
- 1241 1963 1511 2199 1490 2015 7729 -2880 1424 2280 7490 -3250 1202 2118 1550
- 1991 7723 -2921 100 { m20} R 834 1815 7632 -3045 7797 -2840 7820 -2839 1325
- 2287 1552 1774 7591 -2975 830 1008 1338 1727 1488 2210 1509 2045 7720 -3020
- 7789 -2853 1437 2178 1446 2180 7547 -3274 7778 -2893 1657 2027 7856 -2747 7781
- -2859 1376 2014 1368 2104 1202 1870 7743 -2996 1399 1713 7865 -2742 7836 -2812
- 7504 -3060 7789 -2888 7903 -2675 1420 2306 7883 -2709 7645 -2958 1440 1992 1294
- 2022 7886 -2678 893 1865 7875 -2664 7774 -2912 7573 -3284 7855 -2732 1485 2150
- 7867 -2749 7838 -2801 7597 -3201 7445 -3569 7883 -2707 1309 1714 7778 -2870
- 7769 -2940 7662 -3025 7850 -2780 7848 -2787 1552 2124 7909 -2665 1491 2109 7803
- -2876 7528 -3159 7720 -3014 1346 2108 7858 -2767 1392 1926 7849 -2727 1172 1988
- 1612 2028 7710 -3046 7835 -2765 7815 -2821 1312 1919 1136 1329 7818 -2794 1407
- 2294 7768 -2907 7704 -3077 7899 -2672 750 1767 7643 -2989 7713 -3013 7635 -2972
- 1329 1915 7824 -2823 1343 2200 1659 2070 1455 2102 7673 -3066 1443 2120 1372
- 1673 1251 1397 1421 2308 7901 -2675 1427 2239 1106 1622 1588 2161 1318 2091
- 7789 -2903 1755 1866 1376 2304 1275 1972 7760 -2901 990 1636 100 { m20} R 1409
- 1946 1581 2058 7026 -3814 1426 2187 1333 2076 1392 2068 7885 -2688 1357 2163
- 7867 -2729 7732 -2928 1525 2088 1534 2112 7312 -3123 1501 1999 1366 2192 7737
- -2915 1290 1919 833 1663 7527 -2993 7359 -3535 1289 1659 1520 2204 7858 -2751
- 1554 1631 7319 -3329 1395 2059 1526 2151 7614 -3234 1346 1989 1483 1811 1115
- 1990 1520 2183 1379 2062 7617 -3175 1438 2217 7817 -2785 1289 1526 7836 -2751
- 7727 -2926 7746 -2993 1435 2213 1601 1764 1479 2112 7706 -2887 7899 -2641 1289
- 1795 1452 2009 1393 2074 1527 2092 622 1897 7882 -2717 7568 -3257 1380 2018
- 1441 2264 1215 1917 1377 2230 7705 -3059 7754 -2957 1395 2038 7895 -2693 7746
- -2987 7781 -2872 7559 -3047 1559 2117 1404 2175 7822 -2824 1654 1988 7670 -3143
- 7862 -2758 1310 1707 1704 1788 1357 2243 1268 1583 1356 1977 7898 -2685 1477
- 2225 1384 2217 7907 -2668 1696 1862 7809 -2854 1237 1869 1344 2078 7883 -2708
- 1642 1836 7856 -2757 7759 -2918 7762 -2829 7688 -3084 7900 -2640 7708 -3027
- 7896 -2684 7846 -2790 7885 -2696 1315 1987 1418 2019 758 1331 7877 -2726 1289
- 2017 1552 1560 1149 1805 100 { m20} R 7907 -2666 7802 -2853 1447 1940 7886
- -2709 1612 1814 1552 2073 7882 -2687 7467 -2940 7790 -2895 1432 2253 1554 2126
- 7898 -2684 7823 -2820 1353 2278 7741 -2896 7877 -2693 7450 -3099 1274 1910 1040
- 1780 7781 -2858 7763 -2958 1424 1916 1452 2207 7805 -2866 7429 -3507 7704 -3028
- 7784 -2887 7823 -2832 1414 2114 1323 1690 990 1659 7900 -2683 1526 2039 7817
- -2848 1449 2234 7790 -2903 7803 -2868 7833 -2816 1436 2205 7876 -2707 470 1431
- 7408 -3346 7898 -2679 1249 2197 7685 -2892 1114 1861 7801 -2873 7774 -2921 1503
- 2180 1436 1953 1542 2071 7792 -2869 7859 -2715 1444 2029 1448 1861 6954 -3568
- 7874 -2717 7707 -2999 7771 -2942 327 1558 7771 -2776 1515 2045 7894 -2687 7710
- -2866 7866 -2729 1367 1966 1230 1936 1509 2143 436 1229 1946 1832 7879 -2723
- 1281 2047 7779 -2867 7679 -3117 7888 -2701 7563 -3271 1476 2149 7197 -3121 1181
- 1709 1291 1897 7377 -3222 1298 1949 1428 2212 7511 -3282 1365 2121 7881 -2685
- 7836 -2811 945 1881 7275 -3645 1141 1772 1382 2034 1269 1190 7864 -2747 1345
- 1909 7776 -2926 7909 -2664 7895 -2677 7877 -2728 7671 -2987 7808 -2862 100 {
- m20} R 1415 2001 1357 1811 7735 -2998 1263 1956 7789 -2856 7419 -3357 7847
- -2758 1128 1981 1286 2058 1421 2237 7846 -2728 7578 -2937 7889 -2704 1349 1195
- 7812 -2859 1549 2008 1047 1498 7907 -2662 7873 -2733 1232 1927 7894 -2691 6782
- -3940 7752 -2980 1567 2119 1327 2247 7632 -3092 1366 1903 1047 1630 7703 -3030
- 1493 2125 1221 2147 1356 2133 1328 2140 1323 2140 7880 -2702 1166 2039 1379
- 2231 7643 -3028 7898 -2665 1695 1717 1479 2063 7749 -2944 1503 2218 1607 2088
- 7891 -2674 7680 -3086 7747 -2937 7881 -2710 6942 -4615 7844 -2792 7686 -3066
- 7876 -2723 1401 2254 1455 1680 1438 2160 1517 2057 7686 -2979 1400 1771 7886
- -2706 1234 1700 1409 2286 7834 -2806 7537 -3121 830 1780 7663 -3054 1292 1862
- 7762 -2960 7863 -2753 7669 -2906 7597 -3213 7629 -3133 7772 -2930 7636 -3214
- 7864 -2742 7637 -3121 7875 -2707 878 1649 7898 -2685 1432 2290 331 1954 1371
- 1882 1185 2009 7887 -2703 1536 2139 7609 -3202 1307 2134 1461 2134 7811 -2797
- 7773 -2935 7596 -3063 1239 1999 944 1825 7727 -2929 997 1564 7549 -2946 1486
- 2218 7683 -2995 1264 1937 1387 2356 7877 -2721 100 { m20} R 1791 1820 7654
- -2930 7772 -2914 1486 2232 1403 2055 1304 1623 1356 2127 7879 -2716 1345 2114
- 1200 1806 7860 -2753 7679 -3108 7880 -2717 1373 2004 1356 1713 7799 -2810 1385
- 2068 7674 -3077 7849 -2742 1356 2284 1160 2028 1045 1866 1476 2253 1202 2000
- 1394 2132 1329 1982 1653 2061 1137 1686 1334 2157 7817 -2839 1602 2007 7525
- -3435 1639 2097 1399 2167 1398 1890 1515 1779 1141 1691 1311 1768 1477 1798
- 7743 -2996 7857 -2757 7327 -3254 7887 -2709 1318 1985 7832 -2791 7893 -2686
- 7687 -3098 1291 1741 7775 -2863 7655 -3007 7886 -2711 1243 2064 7510 -3338 7681
- -3119 7797 -2872 7886 -2701 1369 2377 7639 -3041 7829 -2824 7891 -2692 1223
- 1878 7729 -2926 7883 -2715 7891 -2676 7845 -2745 7851 -2753 7874 -2731 1426
- 1924 1327 1033 7870 -2729 1353 2044 1332 2032 7900 -2670 7878 -2715 7903 -2668
- 7758 -2796 7811 -2858 7545 -3200 1499 1961 7901 -2667 1467 2198 1282 1856 1592
- 1949 1055 1565 7176 -3521 7894 -2673 7882 -2715 7830 -2818 7765 -2903 1426 2212
- 7786 -2881 1502 2165 7893 -2696 1259 1885 7882 -2717 1437 1541 7799 -2883 7883
- -2708 7807 -2759 1356 2224 100 { m20} R 7761 -2961 7804 -2853 7780 -2924 7795
- -2889 7848 -2786 7627 -3171 7689 -3104 7869 -2740 1237 1723 1456 1908 7720
- -3039 1326 2186 7770 -2854 7841 -2796 7798 -2784 7828 -2803 7780 -2854 7555
- -3125 7661 -2915 7884 -2655 1075 1838 7736 -3012 7329 -3810 7826 -2793 1364
- 2249 1407 1974 1076 1271 1115 1772 1434 2172 7861 -2760 7868 -2744 1390 2099
- 7706 -3066 7619 -3212 7465 -3186 7658 -3085 1411 2281 1118 1729 1453 1661 1379
- 2044 1412 1882 1398 2307 7906 -2665 7589 -3132 7849 -2695 1190 1660 1606 1992
- 7797 -2860 7254 -3692 1521 2109 1497 2091 888 1713 7462 -3018 7845 -2791 7640
- -3103 7717 -3012 7876 -2724 7861 -2740 7779 -2904 1362 2004 7877 -2724 7739
- -2941 1419 2301 829 1331 875 1813 1292 1916 7704 -3007 1169 1724 1355 1900 1492
- 2195 1114 1899 1935 1831 7892 -2695 7779 -2717 7678 -3119 1275 1853 1464 2092
- 7736 -3007 1363 2078 1397 2177 7622 -3008 1097 1808 1327 2181 7906 -2664 1185
- 1520 7852 -2769 1228 1753 1304 2197 1385 2229 1432 1992 7616 -3230 1733 1960
- 7864 -2734 7387 -3300 7885 -2709 1352 2147 7830 -2811 7868 -2718 1450 2216 1366
- 1909 100 { m20} R 1304 1692 1288 1589 7764 -2931 1395 2182 1510 1545 7572 -2996
- 7902 -2673 1366 2067 7881 -2719 7536 -3128 1254 1863 7754 -2964 1403 2034 1298
- 2069 7719 -2951 1835 1830 1315 1929 7887 -2706 7499 -3030 1568 2071 7693 -3099
- 7567 -3296 7888 -2706 7841 -2776 7874 -2727 1464 2061 7705 -3074 7784 -2784
- 1510 2200 1525 2112 7693 -3048 811 1866 7838 -2793 7803 -2811 7791 -2806 7894
- -2694 1426 2085 7526 -3079 7768 -2944 7907 -2662 806 2020 7889 -2702 1415 2240
- 1103 2063 7688 -3086 1309 1941 7767 -2950 7482 -3223 7904 -2661 7853 -2749 1503
- 1828 7468 -3048 7821 -2841 1597 2051 1454 2276 7909 -2645 7250 -3966 7524 -3319
- 7500 -3408 7868 -2736 7783 -2826 1438 2059 1100 2192 1351 2207 1412 2246 1550
- 1949 7766 -2914 7908 -2657 1485 1942 7727 -3029 1320 2088 7812 -2840 929 1698
- 1680 1428 7702 -3079 7821 -2814 1492 2235 1294 2068 1013 1774 1502 2084 1464
- 1989 7863 -2757 1497 1686 1333 2101 1573 2129 7891 -2652 1459 2236 1036 1684
- 7860 -2737 1192 1757 7850 -2781 1384 2114 7821 -2826 7887 -2707 7811 -2816 1670
- 1887 7881 -2720 7803 -2864 1417 2031 1542 2189 100 { m20} R 1477 2143 7899
- -2681 890 1441 7828 -2827 1311 1474 7758 -2912 7817 -2843 1234 1293 1637 2078
- 7907 -2623 7667 -3008 1231 1869 7806 -2864 1269 2192 7836 -2761 7904 -2663 7881
- -2714 7903 -2668 7888 -2679 1337 2113 1291 1988 1450 2102 1472 2252 7846 -2791
- 7786 -2884 1327 2149 7896 -2690 1255 1978 1400 2183 1425 2256 1558 1768 7807
- -2846 1444 2075 1287 2184 1324 1906 7779 -2895 7563 -3070 7885 -2692 7744 -2996
- 7533 -3241 7735 -2896 7832 -2805 7882 -2716 1331 1962 7762 -2901 1532 1982 1707
- 2005 1340 1992 7845 -2792 1434 2253 7890 -2688 7865 -2750 1364 2268 7898 -2685
- 7837 -2772 1342 2066 1457 2057 1381 2099 1382 2014 1268 1827 7885 -2701 7600
- -3016 7744 -2940 7681 -3082 7728 -3019 1577 2122 1586 2087 1480 2250 7758 -2968
- 1130 1883 7778 -2905 1539 2110 1645 1837 1381 2221 1344 2024 7806 -2730 7903
- -2676 1696 1705 7854 -2772 7820 -2842 1560 2062 7521 -2963 1348 1934 1368 2149
- 7671 -2907 1340 2117 1428 2239 7666 -3131 7883 -2716 7907 -2658 7811 -2847 1329
- 1803 7754 -2973 1209 2070 1444 2147 7657 -3035 1309 2023 7500 -3130 1432 2081
- 1407 1706 100 { m20} R 1513 1964 7762 -2913 7833 -2777 1369 2334 1495 2162 7876
- -2727 7875 -2730 7682 -3121 7672 -3101 7797 -2881 7826 -2828 7682 -3026 1364
- 2196 7806 -2872 1373 2301 7700 -3044 7868 -2746 7764 -2901 1368 2181 895 2079
- 1481 2248 7882 -2716 7729 -3025 1586 1761 7845 -2764 7703 -2966 7804 -2873 7856
- -2770 7888 -2691 7792 -2871 1302 2074 7638 -3098 1024 1512 1404 1921 1483 1994
- 7901 -2664 7619 -2917 7850 -2779 7909 -2664 1402 2328 7815 -2840 7707 -3072
- 7908 -2665 1558 2131 7819 -2813 7902 -2677 1229 1878 7816 -2819 7599 -3185 7725
- -3034 1436 1744 1157 2149 1123 1200 1346 2189 1376 2076 7876 -2724 7598 -3039
- 7827 -2742 1529 1905 1333 1930 7884 -2715 1285 1914 1428 1927 1323 1506 7648
- -3186 7725 -2945 1054 1811 1440 2271 1493 2189 1433 2065 1488 1963 1141 1476
- 1238 2043 7715 -2926 7748 -2904 1432 2232 1251 1824 1106 1591 7671 -2986 1255
- 2127 1292 1919 7798 -2846 7804 -2876 1421 2151 1075 1752 7775 -2870 1098 2077
- 7798 -2792 7283 -3756 7803 -2840 7659 -3114 1147 1570 7583 -3028 1259 2032 7779
- -2846 7879 -2725 1274 2211 1563 2012 7702 -2885 7767 -2939 100 { m20} R 7895
- -2690 7692 -3049 1467 2251 1338 2254 7866 -2717 1119 1929 1237 1795 7311 -3410
- 7702 -2947 7826 -2829 7784 -2911 1343 2235 7734 -3016 1413 2219 1390 2267 7677
- -3060 1337 2135 1398 2095 7897 -2687 7620 -2925 1442 1877 1332 2137 7497 -3425
- 7875 -2731 1221 1975 7886 -2710 7889 -2701 1468 2204 1321 1639 7765 -2955 1249
- 1761 1334 2114 7700 -3070 7820 -2819 1332 2010 1190 1878 7816 -2851 7905 -2671
- 1478 1952 1453 2207 7669 -3132 1451 1976 1378 2068 7711 -3056 798 1125 1598
- 2134 7817 -2845 7684 -2899 7718 -2904 7621 -3113 7560 -3171 1374 2160 7743
- -2970 1356 2114 7789 -2895 1415 2260 1381 2054 1430 2274 7664 -3156 1499 2135
- 1433 2294 7901 -2660 7739 -3006 1488 2222 7881 -2716 1643 1841 1403 2162 1706
- 1591 7768 -2948 1514 2206 7792 -2885 1388 2356 1566 1938 1293 1522 7884 -2708
- 1493 1990 7849 -2773 7726 -2814 825 1699 7708 -3068 7537 -3140 1489 2131 7413
- -3460 1569 1949 1485 1603 1154 1964 1301 932 7587 -3220 7777 -2916 7869 -2738
- 7677 -3131 1585 1989 7705 -2828 1379 1811 1360 2198 1489 2099 7824 -2827 1446
- 2116 7713 -3005 1140 1063 100 { m20} R 7752 -2980 1269 1516 7821 -2824 1231
- 2144 7864 -2702 7755 -2929 7785 -2910 7886 -2692 7420 -3222 7885 -2710 1312
- 1942 1645 2078 7873 -2703 1325 1976 1536 2103 7875 -2726 7488 -3384 7869 -2744
- 7861 -2745 7883 -2714 1105 1964 7829 -2806 1342 2202 1175 1776 1378 1915 1299
- 2067 7769 -2924 1975 1740 1590 2162 1675 1988 7908 -2653 1386 2270 1403 1733
- 7646 -3127 1527 2095 7826 -2826 7592 -3233 7879 -2719 1415 2056 7821 -2837 1588
- 2124 1470 1925 7831 -2821 1303 2000 564 1239 7761 -2933 7849 -2762 7839 -2795
- 1193 1911 7848 -2784 7739 -2881 7645 -3161 1346 1788 1278 2208 1343 2095 7658
- -3094 7704 -3071 7700 -3073 1301 2152 1312 1930 1575 2148 1511 2212 1327 1878
- 7906 -2633 7877 -2718 1431 2203 1346 1772 7607 -3273 7894 -2693 1695 2078 7588
- -3308 7725 -3023 973 1100 7819 -2839 7794 -2892 7866 -2749 7777 -2925 1396 2155
- 334 1430 1309 1706 7897 -2679 7564 -3060 7826 -2818 1471 2061 1417 2240 7868
- -2732 1315 1764 1378 1710 7748 -2989 7760 -2811 7849 -2757 7772 -2913 1436 2169
- 7665 -3037 7836 -2744 7699 -3042 1451 2174 7862 -2759 7736 -3013 1503 2041 100
- { m20} R 7201 -3121 7751 -2980 7521 -3108 7798 -2861 1480 2231 1236 1405 1290
- 1529 7882 -2698 7867 -2748 7891 -2693 7758 -2968 7832 -2799 1384 1962 1201 2076
- 7860 -2760 7890 -2671 1362 2044 1493 1701 7595 -2982 7894 -2691 7871 -2707 1200
- 1756 7717 -3014 7882 -2717 1524 2147 7733 -3008 1278 1413 7762 -2937 1404 2323
- 1376 2074 1490 2054 1533 2191 1466 2211 7876 -2720 1468 2080 977 1740 1436 2252
- 1497 2069 1459 2175 7739 -2999 7563 -3146 7877 -2726 7836 -2783 1615 2123 1413
- 2190 1219 1709 7877 -2708 1698 1907 1575 2036 7778 -2925 7823 -2837 1156 2039
- 7855 -2767 7750 -2984 7877 -2724 7624 -3209 1312 1992 1001 1775 1280 1677 7601
- -3286 7568 -3125 7524 -3244 1420 2138 7783 -2902 7753 -2948 7792 -2733 1386
- 1869 1750 1798 1536 2035 1288 2059 7814 -2823 7556 -3234 901 1614 7902 -2676
- 7140 -3718 7746 -2989 7906 -2666 7799 -2850 1293 1963 1296 1659 1477 2088 7888
- -2694 1422 2280 7788 -2876 1144 2015 7855 -2725 1514 2151 7859 -2760 7801 -2872
- 1542 2124 7573 -3257 727 1901 7835 -2760 1571 1972 1395 2148 1085 1620 7744
- -2945 1200 1990 1440 2272 7852 -2759 100 { m20} R 1362 2006 1453 1898 1366 2196
- 1438 1966 7645 -3170 7350 -3243 1606 2130 7887 -2689 1385 1977 7800 -2878 7836
- -2806 1440 1730 7862 -2757 1422 2305 1455 2184 7805 -2824 7904 -2648 7785 -2886
- 1071 2059 1286 1600 7874 -2731 7865 -2750 1494 2207 1560 2066 1372 1907 7860
- -2711 1467 2015 1464 1944 1589 1889 7847 -2780 7670 -3066 7858 -2766 7879 -2723
- 7799 -2885 7715 -3018 1558 2030 7822 -2835 7895 -2681 1421 2005 7691 -3083 1215
- 2171 7846 -2752 7831 -2791 7759 -2948 7839 -2804 1192 1999 7734 -2964 1376 2184
- 7890 -2700 7492 -3105 7889 -2699 1293 1126 1418 1389 766 1902 1229 2062 7758
- -2873 1319 1478 1394 2173 7862 -2756 1271 1589 939 1846 1398 1971 1580 2016
- 7814 -2851 1509 2032 7667 -2938 7840 -2784 1412 1955 7713 -3059 7759 -2966 1663
- 2090 1386 2182 7584 -3232 1279 2059 1315 1803 7597 -3276 1379 2125 1141 1514
- 7814 -2855 718 1876 1402 1707 7336 -3512 7465 -3298 1244 1933 7855 -2767 1363
- 2133 7624 -3237 1410 2304 1126 2044 1384 2295 7763 -2925 7752 -2958 1089 1838
- 7746 -2984 7522 -3349 7906 -2668 7545 -3037 7499 -3012 7800 -2879 7786 -2912
- 100 { m20} R 7886 -2673 7722 -3018 7588 -3066 7788 -2868 1309 2007 1399 2123
- 1242 2276 7847 -2771 1855 1872 1370 2285 1582 2129 1278 2093 7870 -2734 1544
- 1916 7611 -3039 1231 1888 7853 -2768 1460 1989 1677 2088 1711 1995 1524 1939
- 1531 1871 1476 2198 1425 1792 1404 2053 1514 2031 1393 2203 1280 1379 7815
- -2792 7786 -2886 7728 -3011 7712 -2909 7709 -3007 1318 2227 7579 -3150 7768
- -2948 7830 -2782 1521 1894 7846 -2787 1457 2198 1619 2125 762 1736 7905 -2672
- 1472 2232 1316 2075 1588 1890 1444 2175 7904 -2669 7889 -2691 7754 -2925 1487
- 2115 1523 2215 7755 -2861 7706 -3004 7867 -2721 7519 -3281 1365 2008 1215 1570
- 1477 2164 7675 -3125 7848 -2771 7716 -3004 1506 1935 7454 -2934 7795 -2883 7861
- -2731 7824 -2830 1294 2135 7725 -2986 7854 -2726 7855 -2763 1450 2200 1356 1483
- 7886 -2685 1092 1271 1590 2135 871 1870 7815 -2824 1387 2235 1330 1293 1559
- 2146 1204 1718 7896 -2686 1471 1883 927 1674 7882 -2701 1524 2083 7808 -2863
- 1412 1996 7779 -2921 7802 -2879 1546 2145 7745 -2724 1382 2171 1535 1857 7784
- -2852 1388 2054 7901 -2662 1290 1980 1432 2261 100 { m20} R 1201 1541 1166 1532
- 7833 -2787 7888 -2688 7874 -2733 7587 -3307 7609 -3269 7785 -2911 7791 -2902
- 7868 -2747 1261 1724 7802 -2877 1602 1990 1591 1902 7867 -2747 1351 2319 7586
- -3314 7809 -2863 1430 1775 7762 -2909 7802 -2871 7702 -3081 7895 -2690 7673
- -2982 1659 2033 1066 1802 7829 -2819 7850 -2780 7649 -3086 7900 -2678 7857
- -2769 7868 -2746 7511 -3154 1370 2370 7832 -2809 7719 -2957 7487 -3286 913 1820
- 1382 2325 1408 1967 7908 -2666 7389 -3518 7856 -2768 7627 -2941 1300 1900 1631
- 2028 7876 -2730 1341 1875 7801 -2849 7611 -3263 7670 -3138 7499 -3304 7877
- -2726 7820 -2843 7899 -2663 7837 -2799 1542 2019 7865 -2752 7740 -2967 7846
- -2790 1289 2056 7779 -2857 7558 -3171 1468 2189 7640 -3063 1323 2012 1459 2238
- 1579 2018 1045 1975 1416 2106 7856 -2746 7705 -2978 7901 -2680 7574 -3316 915
- 2062 7755 -2974 1521 2217 7774 -2936 7838 -2802 1296 2129 7530 -3351 1385 1905
- 7880 -2717 1434 2073 1314 2270 1365 2225 1477 2227 7865 -2753 7890 -2695 1420
- 1990 7908 -2649 1248 1573 7897 -2673 1108 1906 7711 -2931 7901 -2636 7897 -2672
- 7845 -2775 7892 -2697 1461 1907 100 { m20} R 1455 2194 7710 -2988 7870 -2743
- 1484 2206 7794 -2894 1359 2300 7840 -2780 1592 1617 1397 2222 7268 -3247 7882
- -2700 7735 -3004 1300 2197 1757 1903 7525 -3367 1276 2187 7758 -2954 7880 -2688
- 7754 -2916 1351 2147 1104 1121 1328 2222 7776 -2918 944 1895 7909 -2659 7762
- -2905 1427 2293 1411 2198 7906 -2659 7660 -3164 7904 -2650 7671 -3131 7860
- -2762 7807 -2868 7836 -2799 1415 2030 7321 -3319 7718 -2922 7781 -2919 1477
- 2227 7577 -3067 1523 2063 7723 -3040 1629 2004 7908 -2665 7779 -2926 7816 -2801
- 1399 2013 7901 -2670 7899 -2645 7614 -3059 1246 1583 1324 1913 7792 -2898 7449
- -3480 7897 -2661 7647 -3165 1388 2115 934 2095 1662 2054 1255 1806 1110 1236
- 1456 2187 1246 1300 7909 -2662 794 1493 1442 1843 7898 -2685 7717 -3025 1341
- 2010 1706 2072 1617 1665 1327 1687 1359 2172 1596 1938 1406 2206 1592 1808 1423
- 2162 7904 -2667 1438 2031 7887 -2679 7687 -2921 7909 -2654 7496 -3268 1407 2212
- 7909 -2662 1220 1790 1366 1974 1269 1699 1110 1616 1258 1812 1280 2203 1391
- 2118 7840 -2786 1442 1962 7740 -2987 7840 -2791 1425 2260 7744 -2898 6941 -4290
- 100 { m20} R 1484 1952 1405 1595 7786 -2890 7734 -2998 7690 -2962 1252 1953
- 7872 -2736 7652 -2999 1297 1998 7554 -3381 1437 2196 1463 1966 7841 -2770 1302
- 1971 1445 1951 7901 -2655 1357 1869 1432 2196 7886 -2698 1498 2177 1451 2165
- 7825 -2822 1254 1461 1206 2050 7810 -2861 7659 -3111 7832 -2817 1415 1558 7664
- -2972 7740 -3000 1669 1941 7680 -2898 7890 -2669 1132 1946 1419 1594 7726 -3032
- 1678 1734 1357 2169 7672 -3126 1319 2064 1409 2199 1129 1485 1479 1976 7870
- -2740 1510 2113 1547 1909 1331 1714 7762 -2910 48 { m20} R 963 1803 1246 2236
- 1101 2165 1131 1090 7881 -2688 7845 -2772 7887 -2656 1546 2106 7902 -2677 1372
- 1937 7835 -2723 7899 -2669 7680 -2982 7759 -2963 1273 1633 7776 -2931 1236 1958
- 7352 -3398 1136 1632 1434 2166 1384 2333 1223 1982 7894 -2694 1279 1915 1367
- 2142 7856 -2763 7869 -2730 1368 1715 7893 -2694 7888 -2661 1342 2176 1466 2261
- 1315 1911 7662 -3059 7891 -2700 1412 2228 7804 -2826 1202 2126 1415 1888 7757
- -2911 7172 -3428 1260 2223 1342 1465 7413 -3544 1315 1878 1450 2232 1422 2289
- 7562 -3149 7737 -2924 7677 -2955 1305 1996 7841 -2800 7781 -2909 7712 -3046
- 1448 2138 7518 -3126 7870 -2725 7883 -2716 7438 -3143 1427 2200 7882 -2699 7856
- -2726 7835 -2783 1466 2234 7486 -3273 1523 2134 1428 2026 1646 1575 1252 2021
- 7802 -2865 1482 2148 1188 2017 1461 1967 1928 1904 1163 1884 7899 -2683 7367
- -3125 1507 2225 1436 2166 1238 2060 7860 -2761 7850 -2782 7777 -2929 7866 -2750
- 7897 -2685 7682 -3088 7716 -3045 7884 -2712 1270 1727 1691 2078 7839 -2803 7592
- -3303 7848 -2786 7851 -2778 1382 1965 7801 -2871 1480 2248 7907 -2665 877 1596
- 1696 1834 100 { m20} R 7796 -2888 7725 -3000 1538 1976 1021 1850 7883 -2717
- 7865 -2720 1409 2169 7753 -2978 1480 1922 1371 2048 1460 2165 1218 1797 7853
- -2777 1370 1952 1414 2316 7863 -2739 7869 -2722 1356 2200 1818 1826 7874 -2723
- 7812 -2836 7877 -2717 1490 2227 1274 1956 7834 -2814 7624 -3018 7890 -2701 7772
- -2940 1393 2206 1409 2170 7795 -2861 574 1519 1636 1527 1445 2023 7675 -3107
- 7673 -3115 1425 2135 1350 1998 1041 1627 1573 2062 7820 -2836 7903 -2660 7558
- -3258 7857 -2740 7885 -2705 7783 -2856 7594 -3228 7424 -3360 1309 1740 1337
- 2357 7855 -2772 1548 2070 1455 1625 1407 2122 1423 2269 1613 1774 7476 -3454
- 7743 -2985 1504 2111 1404 2168 7751 -2977 7800 -2884 7870 -2732 1252 1819 1368
- 1912 7600 -3189 1322 1624 338 1554 1308 1753 7743 -2925 1406 1870 7904 -2644
- 7896 -2688 7780 -2897 7876 -2671 7793 -2887 1315 1967 1373 2192 1507 2229 7870
- -2741 7669 -3106 1084 1987 7592 -3214 1478 2241 7897 -2682 7645 -3136 7899
- -2683 7626 -3153 1343 1874 1372 2210 7559 -3124 7844 -2708 1391 1937 1363 1850
- 7676 -3132 1326 2218 7808 -2855 1065 1897 7780 -2921 7816 -2837 100 { m20} R
- 7656 -3098 7433 -3596 7657 -3169 657 1608 7831 -2811 1169 1810 1402 2093 7781
- -2918 1229 1787 1618 2052 7441 -3347 1319 1856 1385 1958 7781 -2886 1429 1952
- 1646 2066 7668 -2910 7766 -2891 7907 -2668 7764 -2957 7843 -2775 1320 1185 7618
- -2920 1367 1936 1252 2121 7729 -2974 1530 2143 1272 2277 7472 -3212 7499 -3210
- 1466 2103 1182 1842 7747 -2964 7895 -2693 7632 -3140 1637 1677 1298 2184 7866
- -2740 7679 -3023 7857 -2730 1343 2357 1352 1858 1136 1835 1444 2164 1467 2169
- 1287 2022 1363 2172 1528 1627 903 1845 1415 2155 7507 -3188 7845 -2787 7893
- -2697 1129 1434 1482 1823 1300 1850 1625 2110 7817 -2835 7539 -3101 7904 -2672
- 7804 -2839 7851 -2748 1459 2101 7896 -2668 1421 2221 7829 -2823 7803 -2872 7647
- -3158 7791 -2875 1428 1955 7727 -2989 1463 1951 7672 -3127 7836 -2812 1133 2011
- 7766 -2946 1479 1663 1301 1931 7682 -2959 1254 1988 7425 -3092 1150 1643 7908
- -2655 1454 2161 7741 -2979 1184 2085 1341 1562 7386 -3348 7760 -2963 7711 -3063
- 7876 -2731 1443 2208 7812 -2847 7700 -3043 1259 2104 7851 -2776 7873 -2724 1502
- 2037 1515 2180 7902 -2651 100 { m20} R 1516 2210 7893 -2695 7901 -2660 1394
- 2260 7875 -2724 7587 -3235 7788 -2845 7880 -2673 1461 2238 1263 2244 7858 -2766
- 1020 1302 1571 2113 7888 -2704 7741 -2931 7612 -3037 7758 -2969 7817 -2847 1528
- 1946 1589 2086 7902 -2678 1273 2000 7890 -2700 7205 -3658 1355 2164 7776 -2812
- 7751 -2978 7875 -2729 1255 1916 7842 -2797 7567 -3113 1159 1587 7865 -2728 7832
- -2816 7856 -2771 7848 -2784 986 1656 1397 2037 7881 -2683 1556 2148 7769 -2932
- 1423 2206 7505 -3342 1333 2290 7700 -2982 1084 1750 7895 -2689 1411 1964 7687
- -3104 1221 2218 7847 -2723 7896 -2690 7656 -3090 848 1739 7509 -3400 1343 2320
- 7450 -3133 7557 -3092 1543 2188 7865 -2745 767 1435 1559 2115 1652 2090 7642
- -2974 7907 -2666 7821 -2835 1452 2082 7861 -2759 1320 1629 1622 2123 1420 1585
- 1450 2185 7875 -2732 7786 -2910 7802 -2876 7863 -2757 7630 -3109 1332 2176 1274
- 1953 1548 2126 1348 2109 986 1950 7682 -3121 1447 1624 1462 1905 1287 1572 7796
- -2877 1037 1355 1410 2310 7756 -2929 7817 -2813 7847 -2779 7793 -2889 7610
- -3083 1453 2247 7245 -3039 7643 -3111 7551 -3013 1308 2035 1576 1912 100 { m20
-} R 7581 -3267 1333 2111 1160 1728 7830 -2822 1343 2148 7881 -2717 1374 2151
- 1145 1963 1575 1982 7900 -2676 7890 -2694 1398 2030 7898 -2661 1092 703 7838
- -2796 1484 2064 7654 -3038 1464 2034 1267 1829 1629 2069 7765 -2947 7867 -2686
- 1347 2278 1666 2064 1278 1802 7826 -2808 1474 1875 7586 -3316 7885 -2702 7892
- -2688 1540 1809 1308 2054 7873 -2735 7787 -2882 1441 2143 355 1734 7642 -3132
- 7853 -2759 7821 -2805 1642 2106 7841 -2766 1376 2290 7483 -3490 7900 -2675 7831
- -2763 7596 -2929 7635 -3050 7684 -2994 1395 2073 1991 1819 7870 -2729 7906
- -2664 1474 1921 7712 -2977 7834 -2813 1366 1791 895 2012 1245 1996 1404 1928
- 7781 -2842 1387 2273 7794 -2891 7728 -2968 1534 1965 7806 -2867 1460 2227 7816
- -2850 7818 -2799 1630 2011 1522 2130 7848 -2750 1420 2285 7890 -2667 7754 -2945
- 1405 2225 1266 2027 7891 -2698 1009 1865 1574 2150 7899 -2683 1535 2097 1577
- 1896 7786 -2907 1366 2165 7843 -2740 7462 -3298 7893 -2678 7811 -2767 1490 1990
- 1711 1936 1388 2159 1353 1681 7700 -3084 1496 2106 7746 -2961 7634 -3097 7082
- -3171 1132 1833 1493 2207 7677 -2950 100 { m20} R 1269 1895 974 1710 1142 1649
- 1370 1755 1308 1841 1459 2198 1387 2023 1491 2197 1380 2049 1402 2014 1381 2204
- 7764 -2836 7835 -2766 7408 -3132 7851 -2775 1009 1758 7484 -3201 1345 2145 1171
- 1957 1240 2120 1415 2253 7840 -2799 1571 1974 913 1842 1522 1887 1490 2181 990
- 1396 7808 -2862 1183 1840 1394 1923 7403 -3679 1275 1805 7892 -2688 7819 -2843
- 7895 -2692 7869 -2741 7840 -2773 7766 -2944 7572 -3189 1150 1817 1383 1731 1463
- 1926 1477 2016 7762 -2815 7352 -3101 1493 2229 7718 -3039 1416 2119 7905 -2658
- 1433 2019 1180 1434 1388 2155 1242 1930 1097 2003 7864 -2748 7710 -2979 7704
- -3029 1339 1949 1471 2066 7621 -3092 7855 -2770 7801 -2838 1430 2162 1159 2017
- 7892 -2697 7885 -2709 1365 1717 7850 -2781 1424 2301 1427 1717 1584 2011 7517
- -3422 7578 -3267 1507 2077 1354 2169 7528 -3402 7783 -2896 1693 1949 7832 -2817
- 1345 2187 7623 -3218 7801 -2848 7753 -2940 7779 -2872 7633 -2892 7795 -2833
- 1308 2092 7834 -2813 1489 1669 7837 -2798 1746 1547 7602 -3175 1371 2049 1289
- 2249 7097 -3139 1453 2230 1548 1972 1487 2028 1396 2282 7736 -3011 100 { m20} R
- 7884 -2710 7866 -2747 7258 -3055 1354 2169 7876 -2688 7893 -2697 1129 1818 1455
- 2272 7834 -2814 7521 -3106 7840 -2801 1420 1850 1440 2140 7885 -2707 1251 1768
- 1362 2341 1385 1805 1190 1739 1489 1938 7881 -2721 1472 2043 7730 -3022 7855
- -2749 1170 1943 1293 2294 7867 -2749 7905 -2644 7905 -2671 1527 2209 1343 2054
- 7874 -2712 1140 2069 7805 -2814 7880 -2713 1413 2168 7816 -2825 7889 -2704 1042
- 1817 1278 1445 1410 2266 1529 2169 1445 2062 7285 -3134 7707 -3044 1432 1946
- 7857 -2768 7641 -3132 1010 1581 7855 -2748 7768 -2937 7613 -2928 1410 2183 1594
- 1989 7793 -2886 1134 1915 7463 -3030 7740 -2947 1274 2017 7887 -2703 1291 1992
- 1285 1886 7861 -2759 7718 -3033 1410 2270 7609 -3058 7814 -2850 7837 -2810 7905
- -2658 1168 1684 1618 2073 1439 1712 7727 -3002 977 1799 7886 -2699 6694 -3662
- 7754 -2908 1465 2223 1251 1953 7810 -2845 7855 -2742 1325 1842 7728 -3027 1414
- 2071 1305 2190 1121 2253 1494 1928 7857 -2725 7862 -2757 7852 -2737 7769 -2867
- 1280 1991 7870 -2738 1226 1911 1588 2078 7426 -3019 1618 1877 7843 -2783 895
- 1595 7794 -2874 1193 1844 100 { m20} R 7835 -2807 7887 -2705 1097 2118 1416
- 1417 1450 2095 7793 -2837 1270 1913 1205 2034 1419 2273 7892 -2677 7679 -2992
- 722 1494 7621 -3027 1286 1716 7604 -3043 1230 1728 1379 2106 7837 -2808 1357
- 2153 1493 2217 6656 -4195 1097 1620 7859 -2765 1515 2144 7763 -2952 7862 -2758
- 1523 1971 7649 -2971 1459 2134 7651 -3170 1519 2095 1178 1218 1298 1315 1492
- 2237 1460 2227 7790 -2865 7905 -2667 7907 -2661 7896 -2681 1558 2165 1523 2089
- 7836 -2761 1074 1408 775 1058 7778 -2926 7775 -2893 7895 -2681 7449 -3562 7514
- -3091 7815 -2848 7729 -2984 1283 1911 7894 -2686 7744 -2967 1336 2319 1117 1972
- 1020 1569 7732 -3021 7894 -2687 1491 1790 1290 2185 7666 -3116 1025 1709 7898
- -2684 7862 -2730 1420 2180 7451 -3016 7890 -2703 1302 1899 1459 1922 7887 -2694
- 910 1598 7905 -2670 7857 -2769 7853 -2777 7600 -3017 1736 1999 7895 -2691 7278
- -3318 7895 -2690 7858 -2758 1279 1997 7747 -2862 1397 2312 7821 -2752 1488 1953
- 1419 1681 1253 1728 1454 1205 7792 -2864 1555 1885 7872 -2738 7725 -3033 1280
- 2309 1384 2093 7887 -2709 1573 1969 1602 1946 1142 1746 1544 2169 100 { m20} R
- 1559 2160 7442 -3352 7880 -2699 7850 -2741 7824 -2824 1235 2030 7895 -2691 7861
- -2730 7906 -2658 7848 -2746 7718 -2910 7908 -2666 7557 -3077 7808 -2809 7834
- -2810 1520 2123 1213 1863 1273 1438 1483 2250 7562 -3096 1422 2151 1245 1433
- 7730 -2993 1260 2150 1315 1664 1649 2101 915 2048 7800 -2865 1427 1923 1290
- 2115 7548 -3266 1710 2008 7824 -2812 7699 -2991 7839 -2787 7556 -3114 1237 1571
- 7593 -2990 7798 -2862 1242 1591 1616 2076 1368 1734 7872 -2738 1270 1901 7749
- -2980 7839 -2804 7695 -3044 7705 -2968 7849 -2747 1413 1820 7891 -2671 7708
- -3029 7898 -2684 1137 1844 7726 -2939 1316 1951 1244 2194 1364 2108 7877 -2713
- 1212 1998 1376 2167 7836 -2786 7860 -2762 7874 -2692 1256 1963 7457 -3092 7905
- -2667 1474 2040 1648 2114 7836 -2794 7758 -2894 1057 1641 1405 2152 1196 1812
- 7758 -2932 1232 1831 7825 -2833 1692 1941 7759 -2962 7810 -2705 1357 2274 7736
- -2963 1179 2153 1387 2258 1441 2227 1204 2065 7893 -2695 7672 -2896 1395 2216
- 7784 -2813 7753 -2933 7594 -3062 7749 -2986 7850 -2776 7868 -2739 7899 -2660
- 1724 2057 1840 1883 1375 2065 1250 1969 100 { m20} R 7834 -2814 1720 1958 7862
- -2755 7834 -2758 7888 -2697 1199 1828 7791 -2899 7723 -2985 1311 1619 7747
- -2929 1182 1740 1271 1871 7663 -2928 7844 -2794 1388 1773 7860 -2758 7357 -3392
- 1527 2083 1430 2280 7778 -2927 7888 -2705 7773 -2930 7473 -3303 1463 2208 1293
- 1888 7768 -2884 7898 -2685 1256 1998 7748 -2979 7430 -3579 7838 -2793 1375 1864
- 7566 -3236 1335 2084 7890 -2702 1280 2174 7860 -2732 1379 2171 7862 -2757 7742
- -3000 1516 2020 1445 2172 7818 -2847 965 2177 7796 -2883 1383 2146 7819 -2817
- 1372 1777 1485 1479 1594 2026 1430 2177 7887 -2702 7712 -3001 7778 -2835 1257
- 1752 1448 2113 7796 -2818 1384 1929 1400 2305 1682 1882 1496 1946 7370 -3531
- 1531 1722 1385 2314 7791 -2897 1388 2201 1391 1958 1527 1999 845 1455 7861
- -2737 7880 -2703 7777 -2930 1589 1745 1330 1901 1540 2183 7741 -2983 7794 -2896
- 7347 -3225 7908 -2617 7867 -2743 1347 1873 1525 2214 7803 -2877 1499 1836 7831
- -2795 7407 -3271 1273 2020 1635 1678 7739 -2951 1233 1967 7598 -3161 7805 -2853
- 7886 -2692 1099 1748 1416 2160 7824 -2830 7759 -2885 7566 -3326 7679 -3109 1471
- 1841 100 { m20} R 1426 2194 7811 -2861 1331 1846 7826 -2826 7906 -2657 7548
- -3145 7903 -2650 7840 -2769 1346 2259 1333 2101 7860 -2745 1273 2237 1345 1771
- 7906 -2664 7855 -2772 975 1489 1465 1728 1216 1716 7576 -3272 1504 2222 1366
- 1515 7596 -3146 7753 -2956 7198 -3332 7868 -2746 1452 2247 7897 -2642 1388 2002
- 1475 2106 7759 -2965 7773 -2939 7568 -2874 7728 -3001 7654 -3172 1293 2009 7735
- -2990 1304 1776 7897 -2687 1077 1974 1420 2092 1599 1930 1372 2014 7734 -2969
- 1466 1906 7635 -3214 1160 2054 7549 -3118 7832 -2817 7842 -2781 7891 -2692 1393
- 2348 7886 -2710 7366 -3456 1391 2312 7687 -2901 1336 1837 1309 2204 7794 -2860
- 7744 -2895 1410 2280 7736 -3013 1171 1984 1306 1943 7888 -2697 7705 -3074 7409
- -3080 7907 -2638 1435 2112 1477 2254 7785 -2805 7682 -3015 1317 2206 7658 -3169
- 7836 -2808 7595 -3280 1385 2222 1421 2262 1228 1942 1448 2061 7737 -2998 7761
- -2955 1449 2112 7851 -2780 7741 -2999 7772 -2940 7864 -2753 1355 2213 1630 2030
- 7649 -2948 1457 2250 7805 -2855 1541 1968 1446 2231 1524 2133 7824 -2835 7908
- -2646 1370 2278 7764 -2916 1437 2099 7555 -3273 100 { m20} R 7823 -2830 1436
- 2174 1295 1494 1350 1970 1084 1483 7904 -2673 1473 2079 1063 1858 7595 -3197
- 1605 1996 7865 -2752 1516 2155 7765 -2912 7808 -2857 1564 2011 1486 2061 7897
- -2684 1538 1710 1516 2218 7806 -2859 1210 1979 1306 1685 7423 -2946 7846 -2779
- 7856 -2770 1356 1745 7896 -2652 7833 -2813 7457 -3248 7862 -2758 1358 2169 1164
- 1770 509 1454 7885 -2701 7639 -3069 7640 -3119 1305 2029 1369 1953 1404 1970
- 1247 839 1365 1982 7143 -3395 957 1331 1650 2096 1126 1912 1332 2089 984 2113
- 1461 2001 1419 2147 7740 -2979 1204 1704 1554 2017 7846 -2782 1606 1837 7762
- -2953 7063 -3450 1456 2178 7599 -3166 1331 1812 1142 1590 1489 2006 1583 1698
- 1495 2152 1621 1953 1598 2074 7867 -2736 7757 -2962 1157 2061 7824 -2820 798
- 1351 1563 2067 7895 -2691 1054 1471 1158 2048 1608 2021 7486 -3518 7599 -3024
- 7702 -2885 7875 -2731 7651 -3005 7652 -2980 7873 -2720 7826 -2827 7829 -2824
- 7882 -2718 7816 -2834 7871 -2740 7742 -2855 7894 -2694 1205 1766 1420 2101 7692
- -3047 7612 -3089 7715 -2994 7554 -3302 7895 -2688 1507 2119 7839 -2767 1121
- 1803 7857 -2755 100 { m20} R 7889 -2692 1530 2043 7861 -2760 1541 2198 1343
- 2101 1602 1846 7409 -3402 1212 2103 1373 1670 7644 -2822 7461 -3379 7868 -2746
- 1667 1832 1585 1816 7639 -3137 1426 2279 7715 -3056 7879 -2718 7850 -2780 1679
- 2086 7819 -2839 7670 -3061 1067 1213 7846 -2739 7760 -2895 1330 1229 1328 1923
- 1330 1924 7511 -3175 7731 -3014 7732 -3008 1450 2231 7723 -2973 1443 2007 7797
- -2860 7909 -2664 7727 -2961 7863 -2757 1312 1278 7689 -2854 1443 2185 7492
- -3038 1019 1729 1672 1491 1089 1828 1193 1888 1446 2157 7616 -3204 7886 -2695
- 7672 -2922 7834 -2795 1783 1996 7802 -2850 7459 -3460 7753 -2845 1388 2257 7895
- -2661 7764 -2856 1401 2208 7340 -2938 7752 -2981 1465 2232 7842 -2783 7854
- -2763 1110 1828 1853 1854 1521 2033 1766 2003 824 1718 7863 -2715 7801 -2877
- 1250 1933 7880 -2721 7832 -2792 7640 -3042 7908 -2648 7874 -2725 7786 -2852
- 1458 2170 1338 1813 7774 -2921 1087 1525 1412 2030 1410 2304 1474 2147 7854
- -2761 1591 1851 7040 -3014 7684 -3017 1442 2163 1053 1817 1544 2152 7817 -2849
- 7891 -2692 1509 2110 951 1598 1058 1671 7532 -3414 7868 -2744 7777 -2929 100 {
- m20} R 7815 -2848 7825 -2831 7689 -3031 1448 2112 7905 -2664 1438 2134 7693
- -3096 1325 2002 7838 -2806 7827 -2819 1453 2143 7253 -3030 1118 1700 1271 2078
- 7756 -2961 7871 -2738 7700 -2939 1555 1760 1494 2179 1432 1967 1358 1762 1074
- 1499 7272 -3163 7841 -2797 1084 1834 1097 1986 1518 2061 1383 2007 7782 -2920
- 1399 2209 7614 -3195 1151 1848 7629 -3167 1470 2051 7740 -2939 7761 -2955 1225
- 2041 7566 -3329 1312 1893 7812 -2858 7894 -2677 1294 1935 1353 1932 7903 -2666
- 7120 -3428 1398 2051 7776 -2933 7745 -2981 1051 1791 7644 -3181 1402 2138 1144
- 2070 7768 -2933 7468 -3290 7800 -2788 7798 -2864 7691 -2988 7834 -2808 1367
- 2028 1593 1949 646 2021 7590 -3195 1474 2113 7875 -2710 7715 -3028 7824 -2823
- 1244 1927 7746 -2994 1357 1643 1221 1869 1262 2190 7860 -2757 1278 2300 1048
- 1604 1479 2180 7765 -2947 1359 2057 7639 -3134 1423 2118 7777 -2845 7613 -3178
- 1528 1602 7782 -2835 1926 1713 7752 -2915 7908 -2659 1372 1793 1387 1906 1436
- 2211 7902 -2662 1382 2148 7897 -2678 7740 -2947 7897 -2686 1211 1778 7753 -2966
- 1092 1843 1336 1872 7646 -3163 1332 2123 100 { m20} R 1545 2194 7492 -3232 1376
- 1735 1207 687 7803 -2826 1271 2156 7869 -2724 7522 -3132 7423 -3234 1427 1895
- 1749 1989 7867 -2738 7886 -2703 7854 -2768 1216 1978 1277 2153 7835 -2812 1347
- 2280 1199 2081 7694 -2865 1385 2266 1284 2161 1091 1740 1435 2293 7797 -2860
- 1475 2126 7587 -3088 7870 -2742 1208 1621 1569 1996 7886 -2710 1417 2123 1322
- 2100 7809 -2788 7677 -3040 7873 -2733 7850 -2776 7842 -2797 7354 -2987 1379
- 2030 7756 -2956 7781 -2868 7469 -3155 7392 -3286 7865 -2746 1000 1718 7641
- -3142 7544 -3387 7765 -2925 1334 2048 7631 -3001 7862 -2745 1339 2133 1363 1936
- 7883 -2691 7819 -2807 7883 -2711 1462 2029 7860 -2756 1427 2153 7779 -2881 7900
- -2680 1225 2042 1490 2001 7783 -2819 1643 1975 7873 -2718 7677 -3007 1233 2081
- 1454 2245 1356 2108 1328 1793 1363 2061 1301 2057 1369 1692 7665 -3138 7724
- -2993 7771 -2940 7792 -2803 1324 1872 7807 -2869 7814 -2851 7909 -2637 1472
- 2169 7863 -2754 7753 -2978 7596 -3055 7896 -2689 7654 -3142 7795 -2882 1179
- 1568 1184 1596 7905 -2643 1316 2225 1108 1651 1241 2048 992 1340 1299 2106 1241
- 2085 7877 -2722 100 { m20} R 1075 1988 7884 -2712 1398 2261 933 1874 1418 2241
- 7835 -2806 1409 2157 7855 -2762 7894 -2693 7673 -2966 1108 2021 7820 -2798 7839
- -2765 1272 1694 1523 2107 7901 -2651 1035 2061 1295 1671 1299 2017 1459 2194
- 1278 1961 7556 -3038 1313 1807 1410 2098 7718 -2980 7784 -2885 7839 -2803 1600
- 1969 7879 -2671 7631 -3090 1477 2179 1603 1982 1251 1727 1426 2290 7810 -2859
- 1291 2082 1290 1902 736 1360 1569 2078 1498 2176 7839 -2761 7835 -2812 7902
- -2677 7747 -2975 7748 -2989 1443 1649 7659 -3053 1247 1845 7867 -2748 1454 2162
- 7789 -2839 1072 1906 7782 -2920 7816 -2831 7072 -3405 1528 2094 7845 -2768 1124
- 1639 1415 2310 1435 2072 7693 -3087 1500 2108 1440 1968 1346 1529 1374 1670
- 7100 -3327 1410 2089 1317 2017 1462 1888 1544 2198 7898 -2685 1538 1741 1351
- 2122 1274 2156 901 1955 7794 -2892 7873 -2710 1507 2003 1421 1919 1433 2273
- 7700 -3005 7770 -2928 7212 -3267 1369 2130 7782 -2917 1131 1730 7567 -3157 1180
- 1885 7779 -2925 7881 -2717 1275 2036 1473 1741 7771 -2938 1362 2251 1683 2063
- 7342 -3672 7769 -2944 7805 -2865 7837 -2763 7894 -2672 100 { m20} R 1343 2147
- 1414 2102 1226 1894 7883 -2707 7823 -2834 1983 1834 1523 2163 1298 1438 7903
- -2674 7385 -3019 7860 -2747 1130 1889 1425 1984 1329 1927 7877 -2713 1362 2275
- 1371 2305 1386 1476 7836 -2811 1268 2090 1532 2095 7905 -2654 7835 -2814 7873
- -2723 7597 -3227 7836 -2809 1379 2009 7243 -3888 1321 2090 1397 1545 7873 -2717
- 7868 -2734 1028 1599 1073 1765 7751 -2867 1531 1981 7895 -2677 7892 -2697 1389
- 2331 7902 -2674 7826 -2780 1238 2085 1625 1855 1447 2100 7137 -3328 7754 -2974
- 1333 1960 7899 -2677 1672 1780 7302 -3856 1345 1977 7862 -2754 7860 -2730 7777
- -2926 7726 -3003 1262 1679 7850 -2754 1552 1838 7899 -2680 7907 -2668 1325 2049
- 7720 -2921 7881 -2702 7884 -2712 1319 1851 7738 -2915 1154 1852 7740 -3004 7595
- -2927 1477 2121 7810 -2851 7543 -3362 1547 2152 7602 -3269 7577 -2908 7627
- -3133 7749 -2986 7388 -3088 1940 1687 7841 -2771 1168 1771 1134 1741 7847 -2768
- 1370 2362 1363 2165 7872 -2726 7772 -2936 7871 -2723 7835 -2790 7760 -2890 7789
- -2880 1366 1919 7851 -2770 1269 1849 7861 -2760 7830 -2785 1360 1520 1523 1825
- 7570 -3270 955 1979 100 { m20} R 7871 -2741 1603 2093 7789 -2771 7376 -3114
- 7830 -2819 1496 2209 1400 2205 7822 -2837 1428 2298 1480 2090 7812 -2799 1207
- 1859 7850 -2782 7880 -2722 1105 1377 1379 2165 7878 -2713 7850 -2779 939 1802
- 7852 -2761 1548 1667 1461 2193 7199 -4035 1312 1995 7830 -2791 1483 2216 7801
- -2863 7864 -2752 7349 -3232 7833 -2749 7180 -3411 865 1797 1330 2196 1406 2315
- 7897 -2684 1346 1792 7228 -3089 1423 2139 7795 -2894 1349 2123 1477 2138 1270
- 1835 7666 -3110 1160 1189 1455 1732 7881 -2714 7749 -2981 1450 2111 1511 2053
- 7821 -2841 7814 -2813 1256 1554 1365 2027 7736 -2879 7844 -2791 1298 1840 7804
- -2874 7620 -3210 7801 -2875 1359 1960 7643 -3201 1380 1971 1259 1847 1369 2287
- 7686 -3055 7836 -2811 1021 1423 1175 2049 1419 1802 1472 2180 7760 -2963 1318
- 2027 1248 2161 1385 2187 7845 -2783 7711 -2901 1313 1384 1477 1291 1462 1097
- 1296 1957 1342 1245 7905 -2669 1375 2274 7717 -3045 7825 -2827 1017 1221 7875
- -2687 7804 -2704 1389 1765 1255 1991 1497 2228 1520 1723 1434 2294 7772 -2888
- 1217 1793 1311 2214 1542 2094 1869 1943 1553 2064 1363 2181 100 { m20} R 942
- 1703 1481 2132 7797 -2781 948 1792 1330 2050 1302 2012 7542 -3386 7722 -2924
- 7898 -2647 1392 1894 7767 -2947 1436 1716 861 1844 7885 -2673 7866 -2749 7631
- -3186 7672 -3142 1575 2157 1041 1681 1245 1615 1291 1534 1434 2003 1169 1563
- 1326 2241 1297 1734 1470 2105 1313 2161 7628 -3125 7796 -2881 7797 -2869 7770
- -2918 1316 1823 1832 1667 7837 -2810 7460 -3502 7669 -3020 544 1528 7459 -3289
- 6702 -4127 1280 1727 7805 -2841 1240 1964 1289 1611 1429 2048 7873 -2672 1466
- 2148 1205 1489 1440 2079 7599 -3248 1390 2335 1475 2239 7856 -2747 7655 -3171
- 1349 2000 1333 1763 7835 -2765 1272 1990 7807 -2846 1360 1928 1330 2240 7810
- -2855 1486 2189 1427 2071 1186 1763 7828 -2825 7876 -2727 1330 2236 1025 1428
- 7648 -3122 7826 -2831 7819 -2842 7803 -2866 7879 -2723 1484 2192 7641 -3100
- 7700 -3045 7685 -3101 1469 2237 1500 1794 7803 -2792 7799 -2875 1393 1814 7820
- -2843 1444 2087 1479 1607 7764 -2836 7878 -2722 1330 644 7888 -2705 7746 -2949
- 1459 1959 1564 1975 1512 2210 1265 1664 1401 2121 1114 1647 1430 2132 7807
- -2849 7807 -2811 1415 2097 100 { m20} R 1372 1826 7836 -2702 7536 -3373 1545
- 2091 7860 -2755 7481 -2951 7795 -2889 7529 -3136 1526 1994 1156 1650 7600 -3160
- 1191 1746 1328 2302 7259 -3619 7864 -2752 7624 -3209 7480 -3242 7665 -3065 7581
- -3313 7744 -2995 1386 2194 7549 -3166 7680 -3066 1542 2164 1377 2030 7888 -2672
- 1389 1938 7868 -2742 1300 2093 1161 2070 1551 2103 7112 -3393 7855 -2766 1425
- 2174 1374 2115 7726 -2946 7890 -2701 1244 1641 7615 -3245 1369 2243 7786 -2788
- 1447 1919 1381 2068 7851 -2758 1340 2090 1425 2196 1378 1898 1332 2144 7678
- -3102 7753 -2965 7113 -3185 7892 -2697 1333 2126 1391 2254 7835 -2807 1269 1466
- 1470 2113 7733 -2982 7903 -2673 1030 1770 7596 -3176 1161 1403 7902 -2637 7729
- -3027 7698 -3085 1576 1960 1689 1603 1410 2223 586 1314 7745 -2973 1524 2084
- 7728 -3027 1249 1782 1143 1905 1558 2134 1524 2200 7773 -2836 1404 2197 1187
- 1726 1099 1030 7753 -2966 1501 2098 1478 1878 1299 2149 7511 -3248 1572 1904
- 1313 1643 1425 1931 7459 -3106 1165 1467 7607 -3195 1415 2292 7877 -2700 7651
- -3018 626 881 1384 1322 7873 -2736 1414 2152 1387 2282 1167 1837 100 { m20} R
- 7630 -3175 7831 -2818 1413 2059 7699 -3029 7840 -2796 1188 1520 7863 -2752 1164
- 1737 7872 -2712 7889 -2671 7789 -2803 1413 2304 7864 -2741 7886 -2709 1466 2205
- 1033 1847 1486 2102 7853 -2775 1351 2330 7798 -2828 1220 1385 1304 2148 7700
- -3080 1474 2011 1483 2159 7582 -3028 1113 2147 1486 2212 7892 -2691 7893 -2683
- 7830 -2810 7659 -3063 7871 -2732 1256 1606 7782 -2847 1452 1957 1317 1729 7621
- -2953 7440 -3282 7885 -2691 7333 -3097 7904 -2649 7894 -2684 7856 -2751 7813
- -2793 1350 2190 7826 -2831 7582 -3118 48 { m20} R 7857 -2728 7806 -2871 1364
- 2116 1323 1896 7846 -2774 1530 1834 1479 2121 1097 2052 1517 1568 7884 -2706
- 1312 1959 1116 1750 7864 -2755 1464 2148 1151 2018 7837 -2809 7723 -2970 1305
- 2039 7750 -2964 7422 -3505 1434 1549 1381 2199 7823 -2836 7729 -3025 7703 -3017
- 7797 -2862 1429 2030 1434 2184 7729 -3014 1497 2047 7861 -2735 7858 -2767 7877
- -2726 1137 1565 7679 -3110 7727 -2913 1394 2016 7534 -3220 7833 -2728 1695 1940
- 7865 -2699 7605 -2969 1404 2037 7889 -2697 7767 -2934 7846 -2781 7719 -3030
- 1377 2192 1458 2154 1520 2127 1371 2071 7893 -2686 1570 1871 1479 2035 1589
- 1925 1370 2180 7838 -2798 6876 -3338 7597 -3254 7814 -2847 7675 -3128 7878
- -2712 7765 -2847 1609 1901 1434 2032 7743 -2996 7368 -2949 7809 -2787 1275 1976
- 7898 -2687 7721 -2946 7884 -2713 7763 -2814 1349 2134 7797 -2852 1514 1911 7318
- -3699 7799 -2885 7580 -2946 1177 1999 7511 -3302 1388 2241 7758 -2880 1277 2013
- 7854 -2759 7803 -2861 1381 2224 7718 -3015 7806 -2843 7713 -2988 1146 1356 1420
- 1919 1354 1928 7865 -2749 1339 1985 7834 -2803 7899 -2684 1501 2185 1156 1817
- 7868 -2738 100 { m20} R 7844 -2790 1367 2275 1166 1185 7730 -2968 7839 -2769
- 7830 -2822 1335 2117 7880 -2723 7792 -2751 1350 1886 7811 -2861 1286 2128 1045
- 1538 1369 2166 7515 -3404 7790 -2899 7785 -2825 7831 -2820 7690 -2961 1523 2096
- 7841 -2765 1346 1737 7906 -2668 7810 -2845 7898 -2679 7764 -2795 1111 1700 1520
- 2059 7854 -2774 7805 -2851 1046 2000 1151 1242 1197 2067 1165 1421 7822 -2839
- 7818 -2828 7778 -2929 1389 2112 7906 -2659 1389 2321 7566 -3066 1410 2142 7861
- -2737 7543 -3017 7700 -3082 7865 -2739 7870 -2743 7667 -2902 7553 -3023 7843
- -2775 1669 1550 1340 1824 1201 1989 7753 -2946 7808 -2854 1590 2048 7776 -2920
- 1353 1994 1430 2217 7838 -2779 1252 1513 1324 2240 7710 -2851 1470 2232 1580
- 2132 1110 1864 1644 1928 7650 -3176 7839 -2805 1561 2069 7628 -3122 7507 -3309
- 7863 -2751 1774 1798 7839 -2800 1192 1996 1458 2071 1312 2213 7789 -2900 7822
- -2837 7879 -2722 1434 2018 1327 2140 7904 -2663 7872 -2730 497 1134 7805 -2872
- 7786 -2799 1404 2242 7887 -2708 7820 -2843 7810 -2772 1330 1780 1502 1961 1161
- 1621 7640 -3136 7464 -3327 7832 -2817 1470 2039 7699 -2989 100 { m20} R 7728
- -2914 7903 -2674 1255 1359 1386 2258 1392 2221 1406 2027 1395 2223 1319 2013
- 7876 -2728 7904 -2674 7849 -2771 1463 1809 1497 2196 769 1466 1252 1618 7847
- -2770 902 2082 7661 -3107 1203 1879 7742 -2980 7832 -2811 7798 -2882 7414 -3611
- 7777 -2867 1509 2117 1637 1673 1392 1843 7707 -2939 1354 2315 1416 1743 1414
- 2280 1419 2108 1368 2015 1455 2066 7725 -2978 7756 -2950 1338 2200 1476 2187
- 7889 -2694 7835 -2758 7665 -3016 7692 -3081 7831 -2807 7479 -3323 7814 -2812
- 1432 2296 7864 -2722 7810 -2851 7821 -2734 1377 1973 1093 1685 7678 -3084 1471
- 2203 1429 2000 944 1614 7590 -3291 7736 -3011 7344 -3263 1247 1853 7692 -2998
- 7870 -2736 1398 2020 1501 2084 7366 -3236 7825 -2834 1296 2123 1478 2198 7687
- -2931 7726 -3030 7682 -3111 881 1040 1444 2035 7557 -3067 1354 2315 1246 1730
- 7736 -3004 1397 2237 7577 -3103 1482 2198 7646 -3189 1691 1787 1689 1985 1480
- 2163 1568 2108 1236 2067 1379 2330 7720 -3009 7786 -2861 1238 2085 1463 2178
- 1499 2031 1353 1984 7559 -3297 7706 -3071 7709 -3057 1238 1817 1440 2139 7648
- -3067 1237 1998 1546 2189 100 { m20} R 7724 -3035 7871 -2704 1341 1981 1375
- 2129 1025 1979 7678 -3060 1447 1996 1317 2187 7268 -3068 7883 -2716 1374 2004
- 1443 2004 1667 2075 7906 -2665 1499 2022 7788 -2898 7637 -3178 7618 -2993 7845
- -2778 7839 -2806 1487 1840 1586 2165 1498 2214 7764 -2933 1415 2049 7556 -3314
- 1334 2239 1606 2096 7712 -3011 1082 2083 1375 1980 7619 -3112 1383 1944 7862
- -2757 1478 2161 7417 -3544 1584 1998 1507 2196 1488 1884 7041 -3680 7782 -2919
- 1416 2093 7855 -2760 7744 -2743 1304 2018 1063 1660 1388 2212 1384 2230 7674
- -3132 1298 2238 7813 -2838 7618 -3251 1230 1726 7900 -2681 7612 -3214 7474
- -3083 1478 2125 7660 -3154 7908 -2646 1489 2083 7782 -2915 7898 -2651 1750 1946
- 7877 -2700 1130 1767 1334 1792 1478 1980 1405 1740 1263 2164 1484 1963 7632
- -2922 947 1940 1626 1770 1412 2212 1052 1902 7750 -2942 7512 -3403 7866 -2736
- 7792 -2900 7720 -2952 1310 2188 7394 -3315 7872 -2735 7846 -2784 1589 2060 1479
- 1902 7823 -2834 1452 2131 1266 1968 1431 2113 1169 1757 1612 2126 7658 -3079
- 1516 2146 1424 1901 1579 2007 7889 -2670 7838 -2797 966 1824 1198 1639 100 {
- m20} R 999 556 1420 2116 7658 -2864 1304 1518 7824 -2813 1406 2099 7859 -2765
- 7630 -3225 7617 -3252 1385 2106 1337 1806 1261 2116 7797 -2884 1372 1888 754
- 1583 7784 -2902 1570 2061 7811 -2853 1459 2176 7701 -3083 1378 1858 1543 2149
- 7498 -3008 7768 -2835 856 1911 1394 2005 7585 -3207 1264 1535 1849 1929 1355
- 2046 1302 1734 1552 2182 1577 2072 1445 1836 1375 2000 1504 2031 1322 2226 1627
- 2067 7875 -2722 7832 -2763 1411 2157 1334 2097 7732 -2944 7801 -2881 1316 1959
- 770 1426 1042 1617 1386 2307 7799 -2853 7701 -3051 1185 2015 1444 2068 7859
- -2764 7321 -3454 1404 1927 7884 -2685 1253 1962 7400 -3249 7867 -2746 1491 2167
- 7889 -2701 1308 2153 1116 1963 1220 1868 1371 2138 7532 -3143 1350 1963 1383
- 1977 7705 -2962 7816 -2743 1320 2072 1196 1326 7872 -2738 7788 -2896 1427 1708
- 1093 1479 7683 -2835 1377 2000 1243 1613 7790 -2899 7620 -3082 1414 1704 7890
- -2702 1686 2075 7865 -2751 7847 -2789 7871 -2735 7848 -2729 1176 1848 7857
- -2741 1366 2004 1211 1795 7340 -3159 7701 -3081 1359 2224 7791 -2888 1595 2063
- 7667 -2997 1425 2057 1459 2062 100 { m20} R 7877 -2686 1521 1811 7842 -2783
- 1864 921 1224 2039 1455 1945 7759 -2948 7872 -2727 1424 2106 7906 -2656 7352
- -3589 7888 -2704 1282 1878 1305 1599 1653 2032 7779 -2898 1339 2155 7823 -2836
- 1386 1850 1359 1814 7748 -2985 7909 -2663 1419 2232 7753 -2940 1387 1852 1367
- 1922 7786 -2909 1413 1453 1372 2020 7599 -2974 7569 -3032 7846 -2789 1300 2194
- 1341 1740 7822 -2820 1193 1401 1586 2030 1481 1947 1505 2199 1339 2095 7692
- -3059 7900 -2659 7880 -2722 1360 2070 7831 -2819 1519 2098 1392 2253 7834 -2802
- 7909 -2659 1384 2104 1250 1446 1411 2065 1216 2070 1470 2209 7817 -2772 1230
- 1978 7608 -3044 7870 -2725 7821 -2837 1442 2073 1221 1770 943 1534 7819 -2840
- 7879 -2707 1534 2197 7675 -3066 7904 -2661 1249 1729 7883 -2710 1518 2166 7890
- -2700 7762 -2933 7781 -2902 1410 2095 7907 -2644 7648 -3081 7885 -2710 7526
- -3192 7814 -2769 7731 -2981 7572 -3341 1308 2183 1405 1986 1502 2232 1127 1719
- 7514 -3091 1427 2052 7905 -2671 7830 -2815 1538 1873 1534 2154 1543 2165 1463
- 2052 7897 -2681 1531 2099 7448 -3386 7537 -3363 1144 1577 7903 -2672 7719 -2955
- 100 { m20} R 1303 1766 1402 2124 7895 -2680 1482 2081 1457 2269 1400 2038 7863
- -2721 1319 1798 1389 2030 7630 -3217 7633 -3188 7727 -2992 7721 -3035 1435 2060
- 7815 -2832 7902 -2678 1175 1673 7589 -3075 7857 -2768 1016 1497 1486 2106 7723
- -2884 283 1534 885 1782 7900 -2681 7860 -2763 1118 1713 7488 -3235 1124 1919
- 608 1754 7901 -2659 7752 -2888 1577 2027 1399 1776 1407 2195 1493 2215 1371
- 1954 1299 1772 7896 -2687 1519 2111 1489 1995 1576 2072 1441 1897 1460 1769
- 1580 2152 1511 1729 7827 -2808 7863 -2756 1402 1599 7768 -2935 1066 1956 7826
- -2831 7730 -2967 1235 1844 7846 -2755 1365 2095 7902 -2651 7766 -2932 1521 1965
- 1464 2265 7798 -2888 1396 2140 1498 2183 1352 2158 1457 2173 1343 2158 1388
- 2177 7840 -2776 7857 -2759 1441 2124 976 1871 7708 -3036 1701 1808 7878 -2719
- 1485 2211 7898 -2672 1346 2174 1351 1782 7724 -2853 7850 -2783 1336 2043 1308
- 1768 7881 -2720 1481 2231 1308 2061 1542 1859 1354 1408 7603 -2929 1376 2339
- 999 1877 7807 -2867 7443 -3605 7640 -3139 7888 -2705 7828 -2769 7557 -3123 1497
- 2123 1485 1990 7833 -2817 1431 1960 100 { m20} R 1350 2179 978 1538 7890 -2691
- 7803 -2860 7560 -3258 7840 -2681 1155 1988 1419 2191 1467 2241 7735 -2942 7741
- -2996 7890 -2701 1517 2155 1510 2055 1390 1996 1244 1689 7836 -2772 1343 2042
- 7823 -2824 7691 -2977 1278 2079 7724 -2956 7563 -3137 1492 2231 1342 1979 1383
- 1960 7828 -2827 1373 2046 423 1188 1460 2160 1171 1585 7872 -2730 7560 -3294
- 7902 -2671 7715 -2951 7862 -2721 7621 -3227 7600 -3122 7883 -2709 1448 2066
- 7430 -3334 1400 2084 7801 -2856 7647 -3173 7714 -3041 1558 1948 7884 -2713 1078
- 1871 1541 2178 7797 -2850 1561 2128 7822 -2837 7795 -2893 7802 -2878 1253 1835
- 7745 -2951 1626 1975 1484 1872 7884 -2714 7880 -2718 1431 2186 7867 -2748 746
- 1721 7884 -2711 1482 2089 7791 -2788 7790 -2875 7504 -3479 7820 -2823 1403 2177
- 7772 -2938 1480 2179 1435 1991 1398 2289 1162 2077 1499 2159 1332 2056 1321
- 1794 7845 -2706 7779 -2921 7810 -2860 864 1829 1091 2259 7890 -2686 7690 -3102
- 1166 2073 7766 -2879 7866 -2749 1260 1603 7889 -2694 1141 1335 7781 -2921 7782
- -2876 1506 1962 7654 -3141 7715 -2963 1576 2103 7766 -2951 1569 1943 1266 2048
- 100 { m20} R 1203 1903 1580 2130 7763 -2854 1446 2061 7898 -2685 7184 -3734
- 7871 -2718 1299 1600 7622 -3159 7757 -2969 7758 -2967 7657 -2920 7325 -3120
- 1455 2253 7896 -2680 1514 1973 1431 2003 1484 2029 7578 -3276 1478 2148 1279
- 1729 1507 2143 7896 -2690 7725 -2981 7442 -3411 1456 2012 7871 -2732 1276 1891
- 7607 -3094 7385 -3138 1439 2102 1006 1594 1487 2130 1159 1512 7895 -2689 7810
- -2742 7579 -3253 7782 -2814 7862 -2727 1264 1215 7813 -2857 1339 2166 1559 2155
- 7637 -3086 7827 -2826 7758 -2928 1363 2107 1389 2061 7875 -2722 7276 -3356 709
- 1925 1500 2149 7813 -2856 1438 2118 7892 -2681 1206 1845 7600 -3202 1398 2024
- 1403 1857 1445 2219 1314 2273 7828 -2804 838 1324 1444 2088 1465 2194 7843
- -2768 7831 -2819 1314 1529 7878 -2721 7885 -2685 1099 1980 7822 -2830 1380 2177
- 7647 -3129 7843 -2775 1502 2185 7863 -2751 7800 -2829 1439 2219 7879 -2701 1365
- 2190 7784 -2865 1395 2019 1464 2208 1440 2052 7614 -3163 1435 2275 7672 -3013
- 7734 -2980 1491 2083 7892 -2690 7610 -3249 7904 -2672 7476 -3114 7874 -2730
- 7675 -3075 7870 -2740 1317 2046 1257 1881 7845 -2792 100 { m20} R 7411 -3101
- 1110 1740 7891 -2698 1146 1832 7302 -3257 7861 -2756 1217 1900 1635 1824 1652
- 2026 1583 2036 7905 -2641 1581 1886 1282 1628 7772 -2939 7780 -2922 1430 2294
- 6883 -3269 7714 -2930 1401 2204 1322 2118 7890 -2699 7691 -3086 1451 2030 1291
- 2299 1694 1767 7808 -2865 7697 -3050 1340 1969 7867 -2749 1282 2107 7751 -2950
- 1477 2112 1565 2150 7892 -2666 1651 2111 7905 -2666 7745 -2959 1337 2175 7829
- -2803 1208 1893 1127 1586 1138 1899 1404 2186 7808 -2788 1648 2017 1347 2023
- 1053 1729 1462 2120 1455 2185 1253 1692 7898 -2670 7900 -2679 1453 2263 7882
- -2702 1327 1850 1295 1628 1339 2035 878 1955 7902 -2665 7727 -3001 7861 -2723
- 1415 2250 7861 -2714 1283 1927 7725 -3026 7667 -3048 1543 2124 1194 1795 7818
- -2826 7724 -2907 1143 1392 1373 2110 1437 2188 1325 1624 1156 1820 7795 -2879
- 1345 1987 7326 -3172 7897 -2686 7742 -3000 7859 -2761 7855 -2771 7860 -2737
- 1096 1951 7545 -3387 1547 1599 1135 1633 1357 1956 918 1889 1549 2190 1545 2002
- 1508 1781 7815 -2849 1349 2202 7894 -2692 7834 -2813 7857 -2712 1169 1796 1449
- 1944 1501 2196 100 { m20} R 7867 -2748 7655 -3174 7718 -3050 7761 -2883 1529
- 2003 1309 2135 7869 -2733 7837 -2808 1464 2148 1319 1902 7688 -3022 7322 -3676
- 7877 -2727 1073 2035 7869 -2735 1486 2017 1420 1630 7820 -2841 1403 1617 1379
- 2147 7734 -2973 1461 2243 1539 1780 7846 -2753 7890 -2677 1473 2248 7791 -2889
- 7739 -2992 975 1990 7802 -2792 7888 -2705 1301 2021 1499 1838 7805 -2871 1528
- 1906 1413 1979 1343 1511 1363 1736 7812 -2802 1474 2175 1474 2234 7705 -3065
- 1255 1861 1399 2060 7777 -2929 7798 -2835 7631 -3160 1399 2323 7887 -2703 1214
- 1289 1198 1896 7582 -3232 7765 -2930 1170 1463 7576 -3149 1254 1986 7770 -2943
- 1671 1704 7808 -2865 7829 -2825 1413 2232 788 1967 7517 -3455 7873 -2732 7867
- -2749 7897 -2671 7830 -2766 7897 -2688 7848 -2763 7777 -2823 7734 -2958 7768
- -2913 1345 1981 7765 -2856 1572 2054 1416 1885 1469 2110 1421 2300 1726 1933
- 1453 1925 915 1751 7860 -2710 1586 1894 7401 -3238 7556 -3363 7907 -2640 7769
- -2921 1435 1924 7884 -2702 1189 1851 1325 2317 1278 2102 1486 2223 7624 -3220
- 7825 -2810 1050 1828 1291 1783 1417 2038 7776 -2930 7748 -2965 100 { m20} R
- 7626 -3063 7845 -2783 7907 -2635 1363 1906 7459 -3514 615 1978 1455 2263 7521
- -3287 1019 1612 7496 -3336 7846 -2777 7794 -2859 1305 1566 7847 -2758 7743
- -2978 7821 -2822 7560 -3246 7547 -3087 7880 -2722 1207 1576 1085 1729 1596 2096
- 7838 -2777 7895 -2680 7571 -3337 1442 2064 1412 1896 7875 -2714 7602 -2979 1370
- 1905 1050 1743 7857 -2741 1358 2055 7254 -2988 7594 -3059 1472 1572 7861 -2749
- 1258 1548 1259 2105 7894 -2693 7690 -3047 1424 2151 7536 -3415 1635 1751 7871
- -2739 1689 2059 7833 -2810 7896 -2690 1380 2132 1390 2055 7759 -2948 1652 2086
- 1328 1753 1381 1797 1306 2243 1396 2321 7894 -2689 1276 2018 7743 -2988 7844
- -2736 1302 2013 1338 1542 1002 2054 1461 2201 1517 2076 7722 -2958 7788 -2907
- 1261 1877 7885 -2706 7900 -2682 7889 -2698 7379 -3402 7871 -2741 1278 1782 7725
- -2998 1392 2013 1347 1887 7692 -2875 7796 -2833 7718 -2969 1236 2008 1636 1853
- 7848 -2787 1256 2114 7903 -2672 7901 -2677 1722 2042 1540 1910 7595 -3258 1286
- 1972 1280 1777 7651 -3170 7776 -2870 7845 -2717 1005 1719 1369 2247 1429 2220
- 1272 2236 7865 -2744 1582 1887 100 { m20} R 7781 -2917 1696 1977 1171 1365 1486
- 2193 1394 2010 7569 -3347 1383 2309 7892 -2695 7811 -2851 7743 -2964 7600 -2907
- 7894 -2690 7895 -2693 7711 -3064 7344 -3081 1252 1700 1324 1997 1458 1833 1453
- 2175 7820 -2823 7664 -3107 7897 -2685 1547 2193 1038 2079 1435 1798 1494 1970
- 1589 2076 7847 -2766 7762 -2852 1277 2196 1305 1913 7590 -3068 1369 1844 1636
- 1962 7840 -2803 1508 2223 7803 -2878 1573 2134 7671 -3138 7909 -2659 6795 -3450
- 925 1723 1427 2098 7887 -2707 1234 1758 1308 2027 1219 2090 1073 1670 1405 2078
- 1256 2007 577 1505 7832 -2818 7849 -2785 1367 2235 1501 2180 1419 2215 7908
- -2665 1337 1953 7612 -3117 7863 -2744 7859 -2765 1535 2151 7733 -2991 7693
- -3043 1325 2261 7817 -2795 7637 -2949 1500 2226 1328 2301 7823 -2829 7659 -3168
- 7873 -2721 7759 -2914 7874 -2731 7764 -2886 1041 2011 1266 2006 7854 -2773 7895
- -2637 7874 -2696 1405 1970 7862 -2744 7882 -2681 1423 2160 1511 2058 7754 -2970
- 7853 -2726 7812 -2860 7760 -2880 1438 1940 1173 1754 1362 2114 7900 -2678 7772
- -2920 1378 2036 1904 1660 7855 -2749 7879 -2720 7865 -2663 1218 1864 100 { m20
-} R 1454 1699 1260 1860 7704 -3029 1239 2210 1416 2263 1356 2008 7856 -2765 7711
- -2958 1620 2056 7870 -2742 1152 2109 7795 -2852 7703 -3003 7818 -2824 1432 2235
- 1382 1859 1378 2202 7821 -2837 7873 -2733 1492 2130 1282 1911 1543 2079 7887
- -2670 1324 1736 7809 -2856 1275 1952 1376 2103 7692 -3097 1455 2236 1500 2118
- 7571 -3195 7776 -2932 7853 -2734 1215 2082 7798 -2865 1393 2316 1102 1755 1563
- 2182 1601 2025 1397 2116 7887 -2698 7855 -2766 7731 -3005 7576 -3082 1375 2178
- 7742 -2973 1331 1982 1683 1781 7638 -3139 7562 -2949 1276 1984 7591 -3260 1393
- 2141 1453 2002 1460 2264 1420 1899 7889 -2694 886 1245 7689 -3018 1536 1994
- 1183 1678 7709 -3009 1473 2094 7532 -3316 1215 1574 7883 -2686 7597 -3184 7517
- -3083 7687 -2974 1508 2015 1441 2099 7862 -2747 979 1841 7842 -2773 1432 1639
- 1341 2126 1018 1902 1450 2089 7655 -3148 7871 -2735 1327 2024 1179 2007 7715
- -2954 7824 -2835 7823 -2834 7681 -2883 7781 -2916 1507 2130 7649 -3048 1432
- 1380 7902 -2676 7567 -3046 1242 2084 1292 2032 1091 1588 1456 2108 929 1582
- 1678 1904 1274 1764 7806 -2868 100 { m20} R 7908 -2662 7518 -3450 7698 -2996
- 7779 -2829 7863 -2725 7830 -2818 7702 -2968 1407 1999 1499 2187 1426 1839 1447
- 2236 7868 -2739 1249 2122 1542 2118 7861 -2743 1566 1540 7627 -2980 7901 -2680
- 1220 1883 7837 -2794 1330 2058 7870 -2711 1496 2202 1511 2191 1321 2004 933
- 1633 1320 1963 1339 2329 7596 -3267 1405 1750 1322 2137 7883 -2704 1387 1791
- 1532 2201 7859 -2732 1342 2117 1542 2036 7903 -2671 1074 1846 1372 1579 1518
- 2176 7838 -2730 1330 2043 1296 1702 7855 -2701 7625 -2989 1528 2065 7718 -3030
- 7838 -2806 1226 1675 1130 1632 7836 -2782 7872 -2739 1567 2146 7656 -3067 1230
- 1820 7685 -3096 1577 2076 7514 -3126 7589 -3187 1386 2293 1417 2251 7850 -2774
- 7497 -3493 1239 1508 1341 2091 1484 2149 7796 -2817 1239 1961 7703 -2775 1483
- 2123 1480 2205 7784 -2894 1505 2208 7766 -2937 7819 -2839 1435 2164 1472 1704
- 1717 1793 1430 2170 1414 1974 7623 -3063 1518 1870 7890 -2683 1454 2165 1306
- 1708 967 1848 1512 2047 1155 2039 1610 2094 1417 2216 1270 1778 7879 -2721 1512
- 2194 7847 -2789 1064 1736 881 1373 1233 1777 7575 -3228 1321 1853 100 { m20} R
- 7418 -3145 1663 2049 7778 -2924 1253 1579 7907 -2667 7825 -2778 7727 -3015 7807
- -2820 7856 -2771 7899 -2645 1363 2215 7504 -2985 7891 -2679 7854 -2767 7721
- -3040 7702 -2945 7714 -2939 1448 2232 1053 1586 7900 -2682 1510 2110 2155 1655
- 1267 2093 1291 1645 7897 -2682 7899 -2684 1458 1714 1479 1799 1473 2040 1705
- 2065 1095 1815 1485 2242 1445 2250 1400 2100 1358 1844 7874 -2676 1214 1780
- 1296 2020 7865 -2752 1440 2109 7880 -2721 1204 2081 922 1894 1407 2205 1290
- 1759 7647 -3170 7433 -3327 1429 2232 1275 1771 1227 1661 7870 -2739 1083 2049
- 7765 -2898 1505 2090 7480 -3070 7554 -3325 7825 -2821 1607 2115 7629 -3177 1559
- 2104 7557 -3273 7733 -3008 7871 -2733 7780 -2851 1383 2119 7768 -2795 7901
- -2675 1676 2045 1435 2009 1407 2235 7823 -2810 7568 -3172 7859 -2765 7572 -3285
- 7861 -2708 7893 -2690 1375 2211 1185 2039 1444 2057 1335 2230 1475 2059 7794
- -2858 1333 1606 1255 2065 1454 2230 7327 -3081 1423 2282 7813 -2856 7811 -2772
- 7863 -2751 1444 2179 1499 2157 1366 1926 1488 2134 7735 -2977 7904 -2671 7851
- -2764 7628 -3144 7886 -2703 7689 -3095 100 { m20} R 1444 2081 1659 1658 7889
- -2704 7794 -2895 1592 2009 1845 1882 7770 -2814 7777 -2828 1295 1627 7879 -2722
- 7744 -2987 7800 -2883 1131 1473 1334 2198 1360 1952 1338 1838 1469 2086 7884
- -2703 7778 -2892 7816 -2828 1370 2146 1325 2107 7891 -2699 7716 -2926 7748
- -2890 7725 -3010 7805 -2873 7894 -2692 943 1579 7663 -3159 7861 -2760 1437 2242
- 7846 -2786 7714 -2870 7310 -3364 7854 -2774 1332 1885 1500 2118 7499 -3144 1347
- 2187 7426 -3528 7847 -2742 1405 1841 7734 -3017 1592 2156 1222 2049 7782 -2886
- 7882 -2708 7853 -2774 7480 -2914 7658 -3061 1423 2245 7674 -3093 7799 -2764
- 1418 2314 1107 1849 7901 -2676 7744 -2922 7870 -2739 7658 -3105 7854 -2767 1206
- 1832 1509 2045 1161 2109 1601 2041 7825 -2833 7784 -2895 1192 1791 7872 -2723
- 7831 -2820 7653 -2969 7563 -3350 7756 -2928 1314 1876 1331 1852 1508 1827 7787
- -2882 7868 -2741 1281 1797 1486 2115 7743 -2928 7827 -2829 1559 2126 1676 1907
- 7891 -2697 7794 -2845 1294 1882 7804 -2817 7539 -3058 7812 -2859 7723 -2939
- 7434 -3322 1645 1651 7827 -2816 944 2022 7436 -3501 7824 -2784 7761 -2902 7846
- -2742 1523 2050 100 { m20} R 7860 -2761 1542 2177 7850 -2762 7646 -3089 7645
- -3195 7701 -2915 1480 2228 1053 1712 7664 -3158 7573 -3043 7769 -2941 7678
- -3120 7879 -2717 7844 -2794 7697 -3073 1388 1925 7716 -3046 7746 -2968 7835
- -2810 7885 -2677 7827 -2828 1139 1411 7867 -2747 7686 -2932 1000 1516 7844
- -2793 7843 -2730 7695 -2874 7839 -2798 1411 2067 7871 -2741 7900 -2667 1391
- 2233 7873 -2724 1437 2264 7856 -2760 1677 1926 1169 1780 1249 1512 1259 2157
- 7810 -2861 1274 1669 7857 -2770 7884 -2703 7815 -2850 1388 1719 7832 -2816 7755
- -2964 7809 -2866 7561 -3355 7895 -2680 1202 2077 1483 2222 1451 2201 7896 -2682
- 1625 2095 7784 -2910 1558 2136 1268 1695 7778 -2907 1602 2143 7876 -2730 1272
- 2035 7819 -2845 1665 1757 7821 -2838 1426 2125 7619 -3073 7895 -2678 1512 1993
- 7662 -3089 7808 -2857 1451 2175 1227 2213 7165 -3349 1181 1304 1281 1703 7794
- -2879 7491 -3454 7631 -3109 1359 2304 1340 1916 1340 2086 1451 2182 7876 -2729
- 7669 -2916 7898 -2667 1510 2089 7875 -2722 1417 2255 912 1285 7664 -3122 7796
- -2885 1574 2046 1759 1976 7871 -2739 1478 2233 7886 -2710 1219 1609 7751 -2975
- 100 { m20} R 1204 2194 1223 1983 7756 -2954 7817 -2828 7875 -2732 1173 2184
- 7869 -2733 7637 -3102 7809 -2852 7653 -2853 7668 -3028 7884 -2710 7746 -2912
- 7909 -2662 1139 1876 7737 -3009 7883 -2709 7827 -2824 7849 -2784 7837 -2808
- 7877 -2727 7903 -2671 7824 -2829 1519 1665 1629 1969 1368 2251 7757 -2967 7860
- -2759 1252 1653 7815 -2851 1364 2274 1319 2067 1594 2033 1427 2172 7476 -3446
- 7754 -2905 7858 -2764 1389 2241 1589 1872 1058 1821 916 1825 1230 2281 7358
- -3320 7665 -3082 7874 -2721 7805 -2829 1405 2250 1059 1887 7886 -2660 1354 1989
- 1362 2170 676 1957 7815 -2765 7178 -3196 1392 2279 7785 -2889 990 1642 1432
- 2159 1553 2116 7681 -2981 1499 2028 1525 2183 7794 -2884 7716 -3020 985 1960
- 1325 1903 1388 1787 7625 -3135 1550 2123 1395 1596 7765 -2905 7614 -2943 7712
- -3051 1269 1889 7844 -2788 1380 2176 1531 2049 1724 1702 7672 -3134 1476 2196
- 1515 1801 7680 -3110 7850 -2781 1142 2144 7768 -2893 1141 1297 1301 1986 7641
- -3200 7854 -2759 7781 -2842 1340 2155 1316 2025 7869 -2722 1151 1398 1309 1801
- 7740 -2902 1339 2183 7886 -2699 1438 1837 7793 -2848 100 { m20} R 7890 -2676
- 7491 -3482 1492 2182 1129 1697 7530 -3195 1157 2113 7873 -2710 1110 1999 7838
- -2802 7735 -3014 1504 2212 7881 -2717 1550 2058 7492 -3338 1357 2239 1620 2110
- 7874 -2735 1216 1571 1495 1832 1274 1695 935 1696 7908 -2653 7799 -2847 7812
- -2798 1543 2186 7611 -3229 7724 -2879 1508 2194 7625 -3150 1330 1954 1190 1936
- 7712 -2969 1189 1943 7838 -2783 1321 2159 7903 -2668 7776 -2903 7764 -2936 1514
- 2121 1492 2061 7773 -2864 7242 -3344 1571 1879 7588 -3234 7690 -3058 7881 -2719
- 7295 -3049 7779 -2895 7306 -3163 7882 -2717 7888 -2703 7818 -2818 1711 1455
- 7866 -2750 7787 -2909 1434 2271 7894 -2685 1201 1828 7892 -2676 1374 2246 7820
- -2792 7879 -2721 1079 2023 1596 1830 7807 -2870 7683 -2880 7416 -2975 1463 2258
- 1044 2085 7329 -3151 1407 1834 7906 -2652 1425 2210 1375 1860 7557 -3045 1429
- 2276 7687 -2823 1236 1655 7770 -2840 1510 2222 7893 -2695 1297 1936 1360 1536
- 719 1630 7385 -3279 7818 -2820 7696 -3066 7045 -3554 7895 -2688 7793 -2897 7676
- -3134 7690 -3104 1012 1554 7834 -2816 1241 2121 7735 -2935 7813 -2855 1265 1822
- 7606 -3210 7850 -2735 100 { m20} R 7714 -3049 7814 -2854 807 2029 1476 2146
- 1283 1976 7658 -3150 7905 -2671 1380 1963 7141 -3517 1058 1723 7751 -2956 965
- 1936 1378 2132 1357 2257 7848 -2786 7775 -2844 7682 -3018 7660 -2970 7885 -2687
- 7675 -2932 1422 1926 1397 2178 7750 -2984 1394 2201 7272 -3533 7688 -2995 7888
- -2704 1325 2128 1162 1438 7895 -2691 1801 1916 7893 -2632 7829 -2813 7811 -2846
- 7692 -2977 7572 -3174 7869 -2735 7456 -3163 7846 -2744 1144 1901 1372 2008 7721
- -3038 7834 -2812 1624 1900 7617 -3071 1509 1541 7806 -2872 7874 -2735 48 { m20
-} R 1533 1889 1365 1691 7675 -3132 7819 -2842 7796 -2800 7829 -2824 1323 1443
- 7813 -2819 7883 -2705 1475 2059 1439 2284 7904 -2672 7466 -3158 7906 -2669 7823
- -2837 7874 -2734 1217 2025 1590 2056 1246 1890 1284 1851 7837 -2773 1420 2072
- 1370 2361 1263 1966 1158 1579 1400 1872 7898 -2685 1231 1999 7592 -2992 7778
- -2887 7854 -2768 1413 1801 7904 -2669 7598 -3286 7797 -2879 1385 2058 1294 2043
- 7698 -3057 7879 -2725 7641 -3043 7892 -2670 7859 -2762 1317 1855 7716 -3044
- 7600 -3007 7895 -2692 1623 2028 7908 -2656 7869 -2737 7722 -3010 7708 -3035
- 7867 -2749 7669 -3098 1084 2021 1357 2041 1404 1918 7725 -2919 1099 1935 7722
- -2916 7849 -2784 1261 1597 1360 2106 1505 1958 7879 -2696 835 1560 7869 -2744
- 1489 1993 7867 -2740 7714 -3056 1497 1441 7726 -2928 7606 -3264 7795 -2880 1423
- 2123 1335 2050 7670 -3127 1151 1709 7908 -2655 7643 -2992 1412 2172 1310 2107
- 7851 -2781 7345 -3230 1116 1693 1472 2174 943 1615 1544 1448 1402 2320 7615
- -3225 1483 1777 7758 -2935 7798 -2840 1375 1986 7864 -2754 1408 2116 1306 2196
- 1479 2253 7635 -3143 1278 1503 7762 -2926 100 { m20} R 1166 1647 1349 2200 7842
- -2793 1485 2215 7739 -3006 7712 -3039 1094 2106 1289 1971 7883 -2717 1228 1699
- 1363 2052 1431 2299 7877 -2714 1348 1539 7614 -3247 1309 1972 7783 -2906 7867
- -2748 7793 -2837 7756 -2962 7800 -2879 7845 -2740 7687 -2991 7822 -2832 7719
- -2975 7654 -3077 1488 2234 1088 1555 7897 -2686 7823 -2795 7596 -3164 1463 2142
- 1365 1678 7679 -2891 7471 -3531 7838 -2789 7875 -2725 1191 1955 1467 2255 1427
- 2294 7636 -2914 7808 -2858 1318 1551 1372 2277 7808 -2804 876 1936 7315 -3746
- 7842 -2789 1664 1949 1298 1674 7477 -3149 1520 2216 7800 -2845 7789 -2857 1258
- 2049 1127 2131 1351 2108 7840 -2797 7829 -2809 7841 -2695 1432 1827 1504 2202
- 7849 -2775 1645 2093 1421 2050 7755 -2876 1449 2060 1515 2176 7806 -2871 1093
- 2083 1317 2096 1341 2058 7712 -2998 7875 -2732 1009 1686 1466 1829 7743 -2983
- 7907 -2668 1452 2072 1389 1984 1107 1832 7731 -2791 7835 -2812 1440 1739 1441
- 2087 1313 1827 7908 -2659 7298 -3805 7874 -2724 7725 -2919 1399 2047 1582 2071
- 1081 1615 1342 2054 1403 1836 7855 -2770 1317 2123 1082 1192 7642 -3121 1304
- 1736 100 { m20} R 1017 1245 1589 2139 7646 -3187 7794 -2840 7906 -2661 1139
- 2170 7830 -2779 1262 2218 7865 -2751 1659 1877 7845 -2791 1355 2214 1545 2051
- 1402 1881 7577 -3075 7704 -2850 1448 2238 1411 2314 7884 -2689 7671 -3097 917
- 1648 1519 1965 7542 -3213 1194 1703 1851 1953 7899 -2683 1515 2140 1344 1820
- 927 1828 7829 -2762 1099 1857 1517 2068 7842 -2790 1486 2084 1476 2178 1394
- 2155 7764 -2914 7822 -2802 7855 -2693 7835 -2812 1299 1729 1441 2162 1435 2203
- 7863 -2744 7529 -3286 1260 1958 7907 -2665 7180 -3162 1400 2128 1322 2214 7449
- -3389 7802 -2854 1604 1935 1386 2236 1330 2125 1339 2086 1476 2184 7864 -2753
- 7695 -3023 1467 1890 7895 -2692 7886 -2708 7510 -3154 1226 2100 7784 -2904 7862
- -2750 7732 -3020 1484 1838 7887 -2708 1365 2129 7908 -2664 1347 2185 1335 2068
- 1288 2002 1101 1870 7755 -2866 1344 2098 7807 -2859 7877 -2728 1353 1680 1352
- 2127 7225 -3067 7698 -3069 1139 1976 1364 2303 7909 -2664 1192 1610 7780 -2911
- 1290 1925 2018 1769 1415 2120 1462 1856 1413 2301 7579 -3141 1507 2129 1360
- 1897 7758 -2943 1379 2183 7597 -3058 1623 2136 100 { m20} R 7897 -2687 7775
- -2924 1466 2251 7859 -2742 1349 1935 1437 2198 7850 -2772 7745 -2964 7862 -2757
- 7752 -2968 1380 1436 1244 2007 1516 1760 1443 2261 7765 -2948 1548 2174 1478
- 2195 1543 2131 7803 -2835 1502 2181 7810 -2783 1338 2143 7290 -3610 7681 -2847
- 7723 -2925 7754 -2936 7885 -2709 7805 -2847 7792 -2889 1087 2028 7770 -2918
- 1480 2159 7811 -2860 7855 -2732 7830 -2822 1591 1605 1520 2020 1631 2073 7762
- -2890 1631 2108 7868 -2713 7792 -2866 7804 -2865 1199 1747 7783 -2886 1064 1957
- 1239 2091 1177 1743 7643 -3157 7680 -3081 1520 1986 1337 1593 1182 2218 1434
- 2278 1536 2048 7904 -2671 882 1902 1546 2089 1286 2033 1308 1794 1394 1876 7865
- -2753 1409 1940 7897 -2664 1409 2159 1321 1996 1436 2133 6949 -3216 1351 1708
- 1208 2147 7901 -2669 7768 -2924 7721 -2880 7900 -2681 7877 -2723 7796 -2840
- 7791 -2886 7854 -2775 7626 -2981 7755 -2974 1333 2061 1188 1864 7785 -2914 1327
- 1852 1468 2168 7775 -2931 1343 1947 7382 -3236 1257 2121 7268 -3288 1504 2152
- 1495 2028 1566 2034 7880 -2709 1490 2158 7850 -2782 1469 2221 1496 1740 1347
- 2141 7817 -2839 100 { m20} R 7853 -2765 7893 -2690 7889 -2700 1208 1691 1410
- 1626 7809 -2845 7871 -2722 7466 -3019 1498 2129 1483 2159 1414 2042 7849 -2756
- 1545 2129 1535 1927 7490 -3282 1396 2064 1337 2180 1424 2177 1221 1847 7852
- -2766 1634 1947 944 1648 1868 1785 1299 2116 992 1828 1239 1697 1280 1392 1376
- 2296 1231 1900 7853 -2777 7858 -2765 7524 -3054 1042 1729 7553 -2950 1091 1143
- 1516 2144 7830 -2721 1474 2060 7870 -2730 1200 1932 7846 -2781 7715 -2936 7820
- -2793 7619 -3066 7888 -2702 7894 -2693 1495 2224 7711 -3012 7809 -2845 7596
- -3287 7842 -2734 1410 2157 7839 -2796 7851 -2772 7652 -3087 1041 1884 7795
- -2844 1461 2039 7323 -3719 1471 1985 1279 1836 7395 -3449 1431 2202 7865 -2753
- 7853 -2777 1232 2021 7893 -2689 1271 1956 7908 -2657 7655 -3134 1503 2170 1328
- 2093 7867 -2748 1397 2115 7850 -2778 7312 -3175 7815 -2827 7725 -3030 7825
- -2819 1241 1711 1495 2153 858 1720 7818 -2846 7875 -2707 7807 -2857 1377 2248
- 924 1423 7670 -3138 2049 1725 7863 -2708 7666 -3053 1421 2240 7782 -2914 7630
- -3210 7779 -2919 7721 -2991 1624 2024 7825 -2832 1255 2195 1307 2023 100 { m20
-} R 1505 2227 1339 1934 1427 2289 7796 -2777 7906 -2667 7543 -3113 7634 -2894
- 1201 1971 1370 1755 7597 -3078 1412 2221 1516 1889 1618 2077 1661 1978 7873
- -2702 1347 2251 1448 2080 1461 2187 7906 -2618 1470 2039 7811 -2837 1343 1975
- 1456 2067 1315 1838 1418 2106 7869 -2744 7783 -2827 7874 -2721 7841 -2768 1178
- 1732 7867 -2744 1481 1913 1254 1695 1292 1815 7783 -2893 7869 -2716 1606 1968
- 7577 -3332 1413 2152 1419 1964 1522 2088 7872 -2736 1419 2259 1403 2309 7767
- -2950 1634 2109 7570 -3137 1406 2191 7787 -2869 7789 -2878 7845 -2731 1428 2139
- 7692 -3076 7616 -3206 7692 -2986 1402 2179 1675 1959 1518 2135 7891 -2668 1240
- 1595 7890 -2703 7567 -3279 7717 -2856 934 1366 1300 2130 7734 -3016 7878 -2721
- 7484 -3350 7771 -2894 7871 -2706 7732 -3020 1575 2035 1493 2175 7838 -2794 1493
- 2117 1314 2251 7789 -2844 1868 1923 1575 2051 1372 2378 1386 2054 7801 -2849
- 1469 1575 1092 1566 7906 -2662 1383 2199 7849 -2744 1249 2121 7822 -2815 7830
- -2793 7791 -2773 1605 2111 1184 1726 7597 -3267 7887 -2688 7879 -2691 1351 2185
- 1435 2287 1694 1930 1260 2201 100 { m20} R 1127 952 7785 -2906 7864 -2752 1341
- 1626 7813 -2849 7862 -2720 7868 -2746 7733 -3010 7785 -2902 7835 -2756 7548
- -3001 1335 1615 7831 -2816 7787 -2894 7874 -2734 1479 2242 7870 -2742 7742
- -2969 7901 -2670 1420 1596 1246 1761 7863 -2734 7895 -2692 824 1358 1561 2056
- 7771 -2926 1232 1665 7722 -3038 1255 1919 7810 -2844 7316 -3388 1446 2267 7904
- -2673 7885 -2711 7890 -2702 1469 2169 7795 -2861 1468 2130 1333 2202 7367 -3345
- 7611 -3028 7830 -2795 1140 1789 7344 -3065 7870 -2710 7906 -2613 7777 -2872
- 1363 2120 1594 1811 7601 -3209 1246 1631 1211 2025 7900 -2680 1630 1964 7796
- -2888 1478 1943 7625 -3111 7702 -3042 1278 1590 7753 -2860 1009 1695 1568 2033
- 1402 2004 7908 -2665 1147 2090 1433 2285 1519 2005 1086 1918 7906 -2670 1339
- 2183 7881 -2719 7882 -2716 7893 -2696 1533 2058 1414 2285 7702 -3080 7868 -2743
- 7821 -2817 7789 -2831 7720 -2794 1309 2069 1393 1802 1316 2047 1454 2035 1259
- 1826 7668 -3113 1453 2096 7741 -2948 1144 1376 7772 -2936 7205 -3425 7767 -2860
- 1420 1876 1340 1961 7698 -2931 7703 -2966 7821 -2839 1286 2146 7593 -3186 1768
- 1893 100 { m20} R 7789 -2857 7813 -2857 7789 -2832 1024 1831 7826 -2824 7848
- -2753 1472 2258 7683 -3055 1460 1525 7738 -2879 1346 1877 1433 2261 1584 2004
- 1360 1818 7851 -2773 7908 -2664 1151 1586 7802 -2878 7891 -2699 1368 1877 1401
- 1778 7841 -2786 7871 -2728 1432 2242 7697 -3090 7846 -2757 7895 -2690 7843
- -2785 1259 1724 1110 1674 7659 -3128 1204 1783 1289 2078 1571 2056 7728 -2937
- 7856 -2749 1724 2031 1309 2022 1414 2106 7563 -3186 1129 1283 1476 2234 1479
- 2251 7843 -2767 777 576 7408 -3613 1374 2180 7757 -2775 1339 1818 7549 -3351
- 1458 1812 7891 -2690 1559 1947 1344 1701 7844 -2777 474 922 1412 2101 7829
- -2826 7793 -2830 1421 1769 1437 2120 7765 -2909 7523 -3111 1265 1794 1535 2041
- 1530 1746 7707 -3017 7530 -3082 7771 -2928 7631 -2958 932 2096 1527 1990 1368
- 1424 1319 2173 7852 -2776 7619 -3219 7540 -3276 7890 -2660 7861 -2756 1014 1878
- 1252 2007 7780 -2857 7619 -3127 516 1489 6865 -3339 7847 -2762 7522 -3130 7248
- -3382 7879 -2723 7892 -2691 1162 1177 7879 -2722 1429 1976 1622 1886 7779 -2906
- 1549 2055 7735 -3015 1202 1478 7733 -2975 1492 2207 100 { m20} R 7850 -2767
- 7831 -2803 1478 2079 7798 -2875 7853 -2754 1130 1828 7782 -2919 1347 2000 7700
- -2924 7869 -2723 7537 -3411 7774 -2936 7893 -2696 7775 -2934 7649 -3027 7611
- -3238 1308 1486 1511 1779 7699 -2995 7826 -2807 7858 -2695 1377 1913 7623 -3119
- 1425 2213 7870 -2742 1366 2015 7884 -2709 7906 -2652 1504 2210 7739 -2861 1404
- 2118 7798 -2808 1311 2151 7809 -2804 911 1631 7794 -2804 1028 1532 1340 2174
- 7843 -2782 1390 2054 7869 -2739 959 1916 7852 -2697 7851 -2773 7784 -2886 7774
- -2852 7810 -2855 1280 2099 7669 -3106 1282 2091 1393 2188 1604 2057 7872 -2685
- 7820 -2781 7903 -2671 7716 -2966 7811 -2837 1453 2208 1396 1814 1570 1675 7701
- -2985 7878 -2723 1279 1752 1338 1948 1285 1654 1650 1781 1529 2165 7895 -2667
- 1269 1952 1480 1857 7828 -2826 7782 -2884 7854 -2775 7795 -2887 7798 -2875 7543
- -3082 7905 -2670 7723 -2970 7833 -2777 1234 2007 1519 2118 1361 1901 1010 2094
- 7616 -3179 7882 -2718 1581 2074 896 1786 7828 -2796 1495 1737 7897 -2686 1419
- 1887 7823 -2812 1337 2139 1363 2077 7873 -2737 7531 -3404 1374 2075 7663 -3158
- 1260 1677 7871 -2739 100 { m20} R 7659 -3027 7907 -2660 7525 -3281 7815 -2843
- 1523 2072 7299 -3071 7806 -2846 1020 1896 7886 -2710 7166 -3416 7876 -2728 7897
- -2660 7732 -2986 7686 -3029 7531 -3186 1363 1840 1560 2101 1387 2088 1624 2131
- 7523 -3426 1187 1673 7868 -2745 7702 -3055 1436 2062 859 1858 7805 -2865 7669
- -3047 7771 -2877 7771 -2931 1494 2225 7865 -2752 7863 -2749 1199 1464 7785
- -2901 7888 -2688 7700 -2928 7653 -3098 7831 -2767 1503 1503 7885 -2711 7718
- -2996 926 1637 7876 -2731 7493 -3485 7782 -2883 1490 1866 7835 -2752 1481 2177
- 1400 1620 7784 -2864 1516 2168 1249 2082 1385 2308 7751 -2961 7800 -2844 1457
- 2013 1153 1927 7892 -2667 7188 -3569 7847 -2779 1437 2161 1396 2004 7699 -3013
- 7707 -3050 1367 2239 1521 1863 1404 1784 7767 -2854 1230 1962 1537 2166 1374
- 2030 1098 1885 7796 -2821 1455 1997 1361 2010 1354 1878 7605 -2936 7866 -2748
- 7515 -3107 7819 -2793 1568 1843 7653 -3102 1208 1880 1285 1933 1169 1972 7777
- -2930 7860 -2760 7808 -2851 7595 -3198 1316 2110 7787 -2910 7810 -2858 7897
- -2686 7896 -2690 1437 2221 7881 -2716 7827 -2829 7517 -2993 1405 2177 1338 2211
- 100 { m20} R 1230 1788 7125 -3159 1367 1944 7316 -3311 7755 -2915 7767 -2913
- 7749 -2955 7662 -3160 7792 -2899 1368 2090 7885 -2712 7476 -3124 1173 1557 7755
- -2967 7870 -2743 1389 2167 7814 -2836 7864 -2725 7907 -2663 1501 2074 7895
- -2677 7893 -2695 7307 -3432 7895 -2691 1038 1387 7808 -2807 7846 -2790 7698
- -3046 1490 2149 7900 -2682 7424 -3643 7828 -2804 7867 -2749 7892 -2694 1258
- 1716 7716 -3014 7747 -2882 7864 -2726 7905 -2672 7759 -2885 1516 1754 7886
- -2706 1602 2125 7852 -2764 7864 -2750 1359 1742 1241 1864 7761 -2821 7885 -2682
- 1368 1980 1522 2212 1408 2261 7836 -2809 7675 -3089 7416 -3231 1225 2106 7711
- -3002 7646 -3130 1494 2035 7600 -3123 1539 1926 7757 -2923 7642 -3200 7691
- -2902 1574 2165 1141 2058 1633 2088 7868 -2744 1562 1787 1371 2037 1337 1898
- 1509 2175 1410 2194 7844 -2785 1357 2309 7874 -2703 7905 -2668 1221 1819 7755
- -2859 7777 -2928 7802 -2875 1513 2027 1031 2036 1435 2084 1320 2287 1251 1411
- 1385 2302 1845 1552 1269 1804 1460 2147 7851 -2775 7758 -2897 7645 -3171 7872
- -2738 1428 2086 1634 2031 7828 -2824 7796 -2889 1469 2169 1478 2174 100 { m20
-} R 1172 1921 7775 -2919 1455 1941 7761 -2945 1020 1871 7649 -3029 7778 -2922
- 7768 -2947 7903 -2649 1219 2025 7644 -2865 7809 -2865 1552 2001 7671 -3069 1231
- 1907 7881 -2691 7902 -2668 7739 -3001 1303 2108 1581 2034 1241 1796 7597 -3165
- 7772 -2932 7870 -2742 1595 2125 1030 1926 1406 2190 1443 2190 7707 -2840 7890
- -2680 7904 -2660 7778 -2922 7824 -2835 7732 -2882 1275 2093 7801 -2880 1801
- 1943 1314 1800 1459 1898 1130 1942 7904 -2674 1398 2011 7831 -2817 7723 -2993
- 7343 -3274 1527 2120 7741 -2990 7849 -2783 1578 2069 1325 1390 1854 1960 7369
- -3065 1443 2082 7752 -2850 1189 1958 1523 2106 7908 -2653 1204 1968 1240 2195
- 312 1450 7739 -2934 1221 1926 7853 -2771 1017 1658 7703 -3077 1531 1855 7828
- -2826 7599 -3147 1486 2119 1356 2268 7764 -2935 7842 -2791 1528 2070 7540 -3082
- 807 1635 1473 1788 1112 1440 1520 2137 1803 1996 7586 -3155 7656 -2997 7807
- -2865 1306 1910 1394 2038 7815 -2853 7710 -2999 1385 2151 7679 -3127 7775 -2872
- 7528 -3359 1406 1803 1284 1664 1202 1703 1374 2152 1464 1880 7336 -3431 1598
- 1959 7623 -3141 1409 1876 1609 2047 100 { m20} R 1380 2159 1014 1938 7812 -2848
- 7588 -3282 1371 2076 7811 -2856 1325 2127 1430 2084 7800 -2883 690 1545 1536
- 1761 1862 1938 1338 2298 7873 -2735 1374 1890 7832 -2806 1482 2183 7666 -3126
- 7819 -2828 1324 2018 1409 2104 1144 1598 7802 -2861 7886 -2702 1212 1921 1573
- 1852 1109 1787 948 1797 1458 2127 864 1415 1290 2219 1070 1713 7692 -2855 7872
- -2722 1348 1785 1312 2156 7735 -2961 1533 1985 7894 -2695 1384 2296 7709 -2957
- 7860 -2745 7819 -2772 1047 1931 1331 2208 1528 2172 1233 1796 1629 2129 7892
- -2693 7717 -3018 1304 1922 7890 -2684 7478 -3016 1334 1948 1516 2052 7090 -4209
- 1428 2267 7888 -2693 7631 -3222 7900 -2681 1323 2221 7870 -2739 7900 -2644 7305
- -3573 1397 2270 1175 1792 7656 -3163 1384 2207 7778 -2920 1321 1428 1302 2059
- 7757 -2961 1505 2208 1641 2119 1287 1624 7840 -2777 7773 -2877 7852 -2776 7646
- -3180 1570 2021 7875 -2705 1457 2191 7841 -2792 7860 -2759 1141 1745 1419 2175
- 7856 -2743 7766 -2941 1628 2048 7814 -2854 1233 1764 1740 1795 1544 2093 7576
- -3212 1409 1925 7850 -2778 1143 2205 7898 -2685 1181 1609 7783 -2770 100 { m20
-} R 7717 -2987 1444 2179 7597 -2802 1358 2220 7698 -2968 7472 -3319 1116 1035
- 7629 -3217 1286 1843 1501 2009 7882 -2711 7899 -2667 7532 -3260 7632 -3121 7875
- -2698 1405 2153 1465 2261 904 1809 1460 2252 1323 1959 7841 -2797 7599 -2976
- 1531 2081 1107 1563 1434 2248 1100 1900 1427 2059 1369 2108 1409 1554 1045 1662
- 1429 1698 7638 -3012 1424 2257 1454 2126 7712 -3021 1687 1892 1387 2060 7884
- -2713 1352 2140 7838 -2793 1302 1966 1607 1998 7836 -2811 1342 2226 924 1636
- 1426 2192 1328 1831 7794 -2896 7819 -2840 1462 1780 1475 2093 1442 2210 953
- 1779 1012 1725 1251 2016 7647 -3177 1377 2076 7757 -2968 7899 -2645 1089 2292
- 7870 -2708 1346 2152 1407 2196 1467 2079 7604 -3227 7909 -2664 7467 -3133 7776
- -2927 1529 2184 732 1608 7631 -2991 7839 -2803 7318 -3426 7806 -2855 1542 1953
- 1384 2325 1244 1916 1384 2189 7873 -2723 7664 -3104 7842 -2787 1360 2181 7784
- -2917 7888 -2688 7842 -2796 1379 2075 7678 -3128 7307 -2940 1370 2037 7627
- -3179 7890 -2694 7858 -2730 1727 1758 1502 1869 1217 1736 7823 -2837 700 1833
- 7899 -2650 1299 2037 7338 -3554 100 { m20} R 7823 -2814 1382 2076 7908 -2662
- 7734 -2987 7722 -2999 7322 -3095 1516 2141 1144 1587 7681 -3116 1241 1887 1504
- 2157 1504 2174 1568 2144 7708 -2814 1450 1915 7847 -2770 7715 -2997 1298 2183
- 7830 -2786 7851 -2780 7879 -2667 7903 -2667 7599 -3054 1352 2061 7617 -3251
- 1369 2107 1139 2212 1513 2120 1297 2170 1424 1954 1272 1969 1548 1832 7860
- -2761 1529 1873 1719 2046 7817 -2811 7877 -2715 1544 1826 7902 -2676 1408 2166
- 1388 2315 7592 -2946 1491 1976 1510 2175 7684 -3078 1466 2196 7872 -2738 7881
- -2719 1314 1906 7797 -2880 7781 -2921 1614 1941 1563 1939 7506 -3475 1382 2337
- 1499 2079 1376 1875 1533 2095 1517 2215 1323 2232 1342 2081 7561 -3056 7621
- -3155 1787 1754 7831 -2810 7849 -2776 7708 -3023 7862 -2685 7671 -3061 1258
- 1975 1377 1689 7738 -3009 7601 -3116 7876 -2724 1171 1635 7892 -2697 7899 -2682
- 2074 1766 6973 -3403 1186 1868 7908 -2663 7689 -3075 7844 -2777 1334 2256 7735
- -3011 1428 2209 1458 2055 1317 1608 966 1961 7111 -3145 7810 -2726 7885 -2710
- 7767 -2911 7585 -3122 1344 1965 7855 -2751 1515 1800 7323 -3623 7229 -3250 7904
- -2670 100 { m20} R 7498 -2987 1218 2007 7850 -2782 7907 -2665 1325 2044 7647
- -2933 7770 -2930 7775 -2927 1214 1848 1289 1769 1340 1503 1461 2191 7661 -3049
- 1465 2107 1270 1954 1531 2097 1293 1842 1560 1892 7567 -3000 7898 -2678 1419
- 2103 1323 1932 1523 2086 7851 -2750 7833 -2814 1231 1958 7730 -3001 7866 -2739
- 7874 -2724 7818 -2838 1078 1707 7873 -2725 1460 1561 1137 1856 1163 1700 7777
- -2930 7780 -2909 7828 -2827 7767 -2932 7902 -2640 7793 -2891 1545 1944 1300
- 1950 1501 2204 1174 1900 1291 2085 1532 2001 1287 2214 7553 -3256 7676 -3086
- 7869 -2742 7547 -3229 7890 -2684 7776 -2928 7757 -2923 7771 -2919 1422 2250
- 7832 -2819 7753 -2877 1083 1753 1595 2129 7375 -3129 7804 -2875 7731 -2992 1383
- 1965 7848 -2783 1415 2228 7737 -2987 1365 2221 1250 1795 1295 2215 1400 2139
- 7617 -2863 7720 -3017 1456 2210 1445 1914 7758 -2904 7759 -2962 7790 -2872 7738
- -3004 1302 2289 1455 1755 7376 -3168 7823 -2822 1383 2148 1471 2009 7093 -3125
- 7589 -3218 7735 -3011 7651 -3112 7721 -3036 7898 -2679 7826 -2829 7795 -2878
- 1138 1884 1405 2311 1469 2228 1501 2082 1643 1688 7570 -3344 100 { m20} R 1332
- 1613 7812 -2766 1574 2166 1337 2292 7270 -3364 1364 2136 1465 2055 1372 2231
- 1399 2072 7774 -2936 1434 1911 1315 2102 1131 1701 1437 2031 1412 1978 1383
- 2362 1357 1919 1309 1795 7816 -2850 954 1542 1365 2201 1318 2156 1452 2253 7854
- -2768 1415 2292 1169 1639 7716 -3053 7717 -3048 1462 2135 7888 -2701 7553 -3327
- 1264 2271 1126 1221 7829 -2807 1434 2245 7770 -2884 7508 -3318 7064 -3326 1388
- 1764 7675 -3055 7908 -2664 7874 -2724 7713 -2938 7813 -2792 1016 1591 7734
- -2966 1383 2236 7756 -2965 7706 -3072 7785 -2901 1399 2092 1501 2156 7870 -2710
- 7903 -2658 7885 -2711 7854 -2766 7828 -2787 7712 -2961 1186 1825 810 1843 1253
- 1735 1385 2213 7818 -2844 1307 1731 7681 -3085 1796 2000 7811 -2847 1275 2017
- 1351 1844 7431 -3395 7839 -2805 7865 -2753 1396 2165 1540 1912 1476 1773 7496
- -3340 1271 1644 1199 1903 7893 -2694 7727 -2820 7786 -2911 7711 -3060 7686
- -3063 1602 2083 7789 -2788 743 1364 7831 -2723 7852 -2742 1125 1634 1378 2244
- 7584 -3191 7835 -2813 1306 1785 1603 1939 1513 2077 1567 2118 7744 -2957 7827
- -2810 7782 -2917 7888 -2699 100 { m20} R 1501 1994 7579 -3326 1407 2221 7409
- -3187 7456 -3168 1413 2268 7894 -2688 1519 1831 1426 2071 1575 1931 1469 1796
- 1419 2098 1631 1867 1390 1916 7862 -2758 7294 -3449 7897 -2686 1304 2077 1454
- 2238 7899 -2683 7862 -2722 1175 1766 7846 -2760 1195 1994 1661 2015 7840 -2799
- 7642 -3009 7695 -3092 7640 -3102 1977 1540 1414 1694 7833 -2805 7803 -2867 7695
- -3093 1318 2085 1575 2121 7744 -2992 1400 2121 1386 2205 1434 2186 7617 -3037
- 1677 2029 7831 -2780 7804 -2870 7764 -2956 1384 2218 1362 2270 1378 2166 1112
- 1334 7772 -2934 1266 1945 1069 1969 1603 2106 7740 -2962 7736 -2943 7751 -2961
- 1143 1504 7831 -2821 7590 -3275 7358 -3308 7832 -2818 1339 1448 1508 2120 7903
- -2671 7834 -2801 7710 -2988 1197 1739 1517 1882 7831 -2808 7735 -3013 1307 2287
- 7825 -2834 903 1529 7818 -2842 7800 -2850 1445 1939 1211 2069 7623 -3178 7735
- -2898 1479 1670 1470 1977 1248 2013 1476 2142 1586 1998 1380 2149 1366 2125
- 1356 1740 7831 -2821 7846 -2789 987 1556 1195 2015 1310 1874 1227 2023 1496
- 2201 7865 -2751 1507 2116 7737 -2851 7888 -2705 7775 -2886 1277 2034 100 { m20
-} R 1331 1979 7797 -2861 1015 1968 7894 -2693 7753 -2976 7325 -3733 1505 2215
- 7745 -2954 1147 1698 1405 1749 7794 -2856 1465 2250 7899 -2684 7808 -2865 7276
- -3131 1403 1382 7862 -2749 1260 1664 1434 2102 1279 2054 7905 -2671 7233 -3256
- 1303 1916 7907 -2657 7792 -2850 7509 -3274 7856 -2770 7588 -3003 1273 1976 1546
- 2178 7497 -3374 1451 2077 841 1127 1901 1816 7863 -2755 1289 1915 1391 2098
- 1570 2166 7822 -2837 1425 1943 7596 -3276 1222 1806 7798 -2887 1736 2002 7740
- -2944 1131 2025 7781 -2915 1651 1876 1388 1696 1670 2020 920 1741 1300 2160
- 7555 -3140 7722 -2869 800 1525 7281 -3286 7879 -2710 1417 2204 7818 -2843 1411
- 1703 1734 1831 814 1735 1260 2027 7851 -2738 1368 2098 7204 -3034 1319 1856
- 7853 -2772 1223 1830 7863 -2752 7834 -2792 1365 2153 7869 -2704 1357 2034 1572
- 2170 7781 -2862 7644 -3011 7839 -2785 1425 2274 1356 2026 7598 -3073 1403 2321
- 7697 -2903 1511 2220 1223 1920 7674 -3091 7573 -3131 7660 -3078 1149 2142 7857
- -2764 7744 -2984 7752 -2976 1169 1675 1543 2092 927 1854 7650 -3140 1396 1973
- 7703 -3056 1136 1903 7852 -2729 100 { m20} R 1408 2004 7786 -2868 1427 2214
- 1366 1847 1458 2178 7466 -3177 7755 -2873 7759 -2956 7805 -2872 1458 2257 7720
- -3045 7760 -2807 1380 2233 7718 -3048 1437 1831 1318 2070 1328 2057 1437 2115
- 1117 1594 7506 -3188 7837 -2764 7875 -2726 7851 -2781 1515 2171 7906 -2671 7870
- -2743 7886 -2693 7860 -2763 7865 -2742 1495 2153 7640 -3003 1505 2142 7039
- -3518 1387 2136 1379 2060 1458 2272 7859 -2686 1411 1865 7792 -2888 1501 2060
- 7794 -2791 1273 1744 7823 -2768 7575 -3160 1256 1878 7814 -2833 7644 -3088 1540
- 2178 7905 -2657 1294 961 7903 -2674 7664 -3102 1585 2153 7766 -2832 7738 -3008
- 7767 -2944 7599 -3155 7683 -3107 7748 -2987 7818 -2843 7898 -2685 1069 1376
- 7857 -2768 7725 -3035 1318 1950 7887 -2706 1781 1933 7388 -3179 7809 -2865 7711
- -3019 1412 1646 7734 -2943 1322 1881 1513 1973 7903 -2675 7878 -2711 7863 -2753
- 1350 2013 1509 2136 1241 1933 1513 2196 7704 -3076 7845 -2794 7861 -2755 7896
- -2679 1418 2157 7804 -2873 1130 2013 1511 2201 1437 2276 1636 1574 7536 -3144
- 7802 -2863 1399 1631 7700 -2946 1410 2274 7715 -3050 7449 -2908 1597 2108 1193
- 2071 100 { m20} R 1392 2075 7781 -2898 1389 2086 7906 -2668 1338 1982 1323 2171
- 7775 -2928 7708 -3053 1511 2028 1395 2209 7881 -2718 7849 -2762 1530 1927 1555
- 2106 1419 2162 1188 1952 7907 -2663 1385 2061 1252 2023 1276 1750 7881 -2701
- 7774 -2892 7810 -2811 7782 -2910 1351 1581 1318 2050 1402 2124 7891 -2694 1544
- 2182 7801 -2843 7710 -2989 964 1745 1481 2174 7735 -2947 7848 -2782 7750 -2984
- 7271 -3259 7874 -2732 7755 -2901 1325 2182 1553 1916 1401 2191 7740 -2887 1317
- 1918 1422 2163 1507 2042 1536 1311 1434 2110 48 { m20} R 7688 -3019 7740 -3005
- 7892 -2698 1461 2258 7561 -3170 1474 2252 1357 2007 1369 2258 1520 2027 7647
- -2845 7872 -2697 7793 -2800 7640 -3152 1634 1961 1439 2062 1711 1919 7785 -2900
- 1478 2103 7539 -3166 7838 -2796 7021 -3198 1429 2301 1354 2150 7806 -2820 7727
- -2838 7809 -2782 1576 2107 1483 2121 7694 -3098 7649 -3176 7899 -2662 1282 1414
- 1329 2088 7859 -2764 1617 1981 1545 2050 7881 -2717 1274 1653 7867 -2748 7829
- -2824 7515 -3233 1150 2023 7354 -3398 7735 -2930 7732 -3020 1547 2121 1437 2277
- 7883 -2715 1326 2095 1388 2281 1337 1883 1337 2129 7607 -3193 7790 -2898 1314
- 1913 1385 2192 7889 -2697 809 1249 1428 2214 7690 -2932 7728 -2916 7772 -2896
- 7869 -2744 7485 -3337 1400 2314 1516 2222 1373 2059 7725 -3027 7848 -2768 7606
- -3273 7892 -2661 950 1391 1264 1880 7882 -2710 1535 2199 1220 1856 7903 -2674
- 7677 -3110 1464 2190 1639 2001 7883 -2715 1115 1708 7738 -3007 7739 -2983 1332
- 2208 1413 2311 7882 -2683 1212 1995 7908 -2665 7788 -2904 7667 -2959 7790 -2824
- 1306 2088 1574 2057 1377 1577 1544 2059 1430 1987 1605 1624 1393 2122 7884
- -2712 100 { m20} R 1043 1874 1324 1936 1602 2068 1410 2233 1232 1914 7894 -2690
- 1586 2104 994 1831 7365 -3086 7727 -3031 7888 -2672 1542 2090 7865 -2748 7659
- -3167 1435 1995 7880 -2713 7896 -2690 7888 -2703 7897 -2679 7611 -2977 7875
- -2704 7905 -2646 7844 -2756 7834 -2811 7569 -3132 7658 -3169 1413 2265 7330
- -3475 1432 2013 7898 -2687 7819 -2844 1670 1856 7648 -3045 1282 1376 7749 -2978
- 7790 -2853 7892 -2693 7898 -2679 1369 2130 1073 1983 970 1750 1395 1960 1467
- 2210 7891 -2699 1266 1748 1590 1099 1486 1921 7881 -2702 7907 -2668 7860 -2755
- 7890 -2701 7762 -2946 7814 -2854 1398 1888 1348 2132 1498 2235 7816 -2851 7660
- -3117 1455 2159 1316 1884 1107 1387 7905 -2664 7688 -3073 7862 -2735 1277 1777
- 1369 2074 1081 1826 7634 -3194 7872 -2679 1548 2067 7593 -2969 1450 1901 1424
- 2099 7809 -2860 1487 2178 1043 1354 1393 2292 7687 -3112 7769 -2940 1581 2159
- 2093 1714 7745 -2983 1321 2194 7821 -2837 1355 2299 7403 -3286 7885 -2713 7599
- -3184 7691 -2886 7879 -2724 708 1419 1089 1709 1381 2133 1284 1848 7813 -2848
- 7867 -2689 7812 -2855 1344 2076 1490 1930 7816 -2847 100 { m20} R 7381 -3065
- 7870 -2735 7853 -2749 1342 1939 1240 1605 7729 -2954 7688 -3091 1427 2217 7667
- -2958 7839 -2730 7685 -3070 7883 -2706 1283 2143 7307 -3248 7888 -2705 7744
- -2995 1414 2282 7694 -2889 1641 2006 1479 1834 1360 2213 7827 -2819 1422 2103
- 7645 -3098 1311 2187 7865 -2751 1402 1636 7666 -3054 1272 1755 1499 2107 7898
- -2671 1327 2183 1518 1881 7784 -2910 1410 1644 1563 1968 7820 -2786 1338 2143
- 1518 1508 1516 2202 1451 2203 1288 1925 1267 1953 7793 -2897 1473 2177 7717
- -2892 1170 1677 7765 -2794 7629 -3229 1359 1871 7593 -3286 7899 -2675 7858
- -2738 1580 2027 7796 -2890 7577 -3058 7888 -2698 839 1734 7768 -2936 1176 1960
- 1248 1829 7430 -3218 1362 2242 1056 1808 1590 2054 1310 1980 1458 2091 1274
- 1478 7838 -2739 1573 2006 7405 -3658 1437 2258 7594 -2860 1249 1986 1478 2184
- 7699 -2901 1527 2021 1208 1497 7594 -3066 7641 -3131 1469 2250 7780 -2924 7873
- -2728 7680 -3096 7714 -2950 1477 2225 7804 -2823 1458 2177 7806 -2871 7688
- -3064 7761 -2949 1434 2013 7648 -3106 1407 2125 7626 -3186 7790 -2823 1536 2200
- 1440 2042 1457 2022 1295 2202 100 { m20} R 7572 -3330 1372 2120 1736 1895 1427
- 2039 1227 2031 7788 -2868 1121 1847 715 1936 7607 -3131 7661 -3148 7609 -3035
- 1175 1915 1620 1990 821 1828 7790 -2896 1122 1948 1506 2072 1459 2083 7733
- -2994 7779 -2852 7753 -2969 1393 1962 1433 2273 1287 1981 7877 -2724 7844 -2789
- 1530 1931 7586 -3315 7878 -2725 7846 -2786 7789 -2840 7836 -2772 1292 1868 1485
- 2163 7805 -2874 1516 2138 1452 1806 1380 2087 7644 -3078 7829 -2784 7669 -3095
- 1133 1577 1201 1968 1040 1529 7886 -2667 7396 -3687 7873 -2713 1178 2003 1284
- 1660 1526 2197 7749 -2979 7894 -2669 1488 1927 7297 -3203 1574 2119 7761 -2963
- 1440 2096 7873 -2735 7345 -3677 7890 -2651 7813 -2832 7899 -2683 1340 2147 1152
- 1928 1385 2184 7877 -2719 7881 -2693 7748 -2875 1416 2232 7523 -3106 1384 1825
- 7877 -2727 7489 -2956 7622 -3058 1471 2112 1213 1545 1463 2013 1450 2176 1435
- 2177 7867 -2739 7600 -3221 1462 2071 7571 -3072 7565 -3032 1147 1879 1538 1973
- 1504 1755 7896 -2688 7870 -2741 1745 2030 1626 2066 1222 1874 7832 -2797 7709
- -3055 1215 1865 7859 -2736 7436 -3612 7827 -2813 750 1774 1419 1894 100 { m20
-} R 1320 1838 7817 -2848 7688 -3095 1304 2258 7900 -2680 7771 -2940 1134 1935
- 1489 2190 1511 1941 1374 2096 1308 2032 1315 1496 7845 -2750 1227 1920 7289
- -3243 7333 -3551 1119 2021 7721 -3019 7662 -3073 1165 1808 1467 2135 7708 -2970
- 7537 -3097 7835 -2787 7862 -2759 1491 1781 7850 -2764 1016 1909 1483 1827 1407
- 2043 7698 -3088 1212 2223 1305 2120 7809 -2863 7886 -2678 7837 -2807 7780 -2801
- 1312 2068 7626 -3112 1427 2243 1384 1930 1627 2000 1500 2142 7854 -2724 7838
- -2791 1151 1734 7759 -2930 1358 2123 7901 -2677 1369 1544 7612 -2981 1272 1919
- 1384 1926 1354 2403 1462 2160 1376 2144 7889 -2691 7706 -3065 7884 -2713 1396
- 1917 1260 2039 7829 -2812 1493 2219 7889 -2699 1362 2043 1481 2224 7876 -2710
- 7689 -3002 7907 -2642 7852 -2778 1420 2260 1502 1805 7784 -2911 1385 2312 1521
- 1779 1111 1790 7585 -3217 1628 1784 7530 -3202 7660 -3045 7883 -2705 888 1645
- 7898 -2684 7717 -3020 7906 -2668 1397 2073 7857 -2746 7889 -2666 1340 2155 1377
- 2180 1598 2132 1228 1674 7866 -2749 1358 2112 1414 2052 7759 -2964 7765 -2949
- 1397 1672 7816 -2841 7854 -2773 100 { m20} R 7850 -2771 7775 -2927 1301 1893
- 7853 -2770 1375 2252 1214 2141 1511 1917 1464 1428 1548 1884 7759 -2899 1250
- 1663 1308 2101 7713 -3059 7814 -2851 7726 -3032 7441 -3287 1008 2034 1112 1702
- 7812 -2858 1021 1856 20 { m20} R 222 1180 m 651 -497 d s 873 683 m 994 Y s 222
- 2174 m 651 -497 d s 222 1180 m 994 Y s 873 683 m 1128 287 d s 2001 970 m 994 Y
- s 873 1677 m 1128 287 d s 873 683 m 1128 287 d s 924 679 m 17 Y s 971 691 m 17
- Y s 1007 700 m 17 Y s 1037 708 m 16 Y s 1062 714 m 17 Y s 1084 720 m 16 Y s
- 1103 725 m 16 Y s 1120 712 m 34 Y s 1101 690 m 3 1 d 4 5 d -32 Y s 1135 696 m
- -5 -2 d -3 -4 d -1 -8 d -4 Y 1 -8 d 3 -4 d 5 -2 d 3 X 4 2 d 3 4 d 2 8 d 4 Y -2
- 8 d -3 4 d -4 2 d -3 X cl s 1150 709 m 21 X s 1180 718 m 1 Y 2 2 d 1 1 d 2 2 d
- 5 X 2 -2 d 1 -1 d 2 -2 d -3 Y -2 -2 d -2 -3 d -12 -12 d 17 X s 1234 758 m 17 Y
- s 1300 775 m 16 Y s 1347 787 m 16 Y s 1383 796 m 17 Y s 1413 803 m 17 Y s 1438
- 810 m 17 Y s 1460 815 m 17 Y s 1479 820 m 17 Y s 1496 808 m 33 Y s 1477 785 m 3
- 2 d 4 4 d -31 Y s 1511 791 m -5 -1 d -3 -5 d -1 -7 d -5 Y 1 -7 d 3 -4 d 5 -2 d
- 3 X 4 2 d 3 4 d 2 7 d 5 Y -2 7 d -3 5 d -4 1 d -3 X cl s 1525 805 m 22 X s 1559
- 814 m 2 2 d 4 3 d -25 Y s 1609 854 m 16 Y s 1676 870 m 17 Y s 1722 882 m 17 Y s
- 1759 892 m 16 Y s 1789 899 m 17 Y s 1814 906 m 16 Y s 1836 911 m 17 Y s 1855
- 916 m 17 Y s 1872 904 m 33 Y s 1883 881 m 3 1 d 4 5 d -31 Y s 1985 949 m 17 Y s
- 873 683 m -651 497 d s 873 666 m 17 Y s 835 695 m 17 Y s 808 716 m 17 Y s 787
- 732 m 17 Y s 770 745 m 17 Y s 755 756 m 17 Y s 743 766 m 17 Y s 732 774 m 17 Y
- s 722 765 m 34 Y s 620 723 m 3 1 d 4 4 d -31 Y s 654 728 m -5 -1 d -2 -4 d -2
- -8 d -4 Y 2 -8 d 2 -4 d 5 -2 d 3 X 4 2 d 3 4 d 2 8 d 4 Y -2 8 d -3 4 d -4 1 d
- -3 X cl s 669 742 m 21 X s 699 751 m 1 Y 2 2 d 1 1 d 2 2 d 5 X 2 -2 d 1 -1 d 2
- -2 d -3 Y -2 -2 d -2 -4 d -12 -11 d 17 X s 656 832 m 17 Y s 618 861 m 17 Y s
- 591 882 m 16 Y s 570 898 m 16 Y s 553 911 m 17 Y s 538 922 m 17 Y s 526 932 m
- 16 Y s 515 940 m 17 Y s 505 931 m 33 Y s 403 888 m 3 2 d 4 4 d -31 Y s 437 894
- m -5 -1 d -2 -5 d -2 -7 d -5 Y 2 -7 d 2 -4 d 5 -2 d 3 X 4 2 d 3 4 d 2 7 d 5 Y
- -2 7 d -3 5 d -4 1 d -3 X cl s 452 908 m 21 X s 485 917 m 2 2 d 4 3 d -25 Y s
- 439 998 m 16 Y s 401 1027 m 16 Y s 374 1047 m 17 Y s 353 1063 m 17 Y s 336 1077
- m 16 Y s 321 1088 m 16 Y s 309 1097 m 17 Y s 298 1106 m 16 Y s 288 1097 m 33 Y
- s 216 1054 m 3 1 d 5 5 d -31 Y s 222 1163 m 17 Y s 222 1180 m 994 Y s 206 1180
- m 16 X s 206 1197 m 16 X s 189 1212 m 33 X s 101 1222 m 3 1 d 4 5 d -32 Y s 135
- 1228 m -5 -2 d -3 -4 d -1 -8 d -4 Y 1 -8 d 3 -4 d 5 -2 d 3 X 4 2 d 3 4 d 2 8 d
- 4 Y -2 8 d -3 4 d -4 2 d -3 X cl s 148 1245 m 21 X s 179 1254 m 1 Y 1 2 d 1 1 d
- 3 2 d 4 X 3 -2 d 1 -1 d 1 -2 d -3 Y -1 -2 d -2 -4 d -12 -11 d 16 X s 206 1312 m
- 16 X s 206 1370 m 16 X s 206 1412 m 16 X s 206 1444 m 16 X s 206 1470 m 16 X s
- 206 1492 m 16 X s 206 1511 m 16 X s 206 1528 m 16 X s 189 1543 m 33 X s 101
- 1553 m 3 2 d 4 4 d -31 Y s 135 1559 m -5 -1 d -3 -5 d -1 -7 d -5 Y 1 -7 d 3 -5
- d 5 -1 d 3 X 4 1 d 3 5 d 2 7 d 5 Y -2 7 d -3 5 d -4 1 d -3 X cl s 148 1577 m 21
- X s 181 1586 m 3 1 d 3 4 d -25 Y s 206 1643 m 16 X s 206 1702 m 16 X s 206 1743
- m 16 X s 206 1775 m 16 X s 206 1801 m 16 X s 206 1824 m 16 X s 206 1843 m 16 X
- s 206 1860 m 16 X s 189 1875 m 33 X s 146 1885 m 3 1 d 4 4 d -31 Y s 206 1975 m
- 16 X s 206 2033 m 16 X s 206 2074 m 16 X s 206 2107 m 16 X s 206 2133 m 16 X s
- 206 2155 m 16 X s 206 2174 m 16 X s gr
-showpage
- gr
-%%Trailer
-%%Pages: 1
- gr gr
-%%EOF
diff --git a/src/pawlib/paw/testsuite/paw.commands/nt_pl_3d_3.ref.ps b/src/pawlib/paw/testsuite/paw.commands/nt_pl_3d_3.ref.ps
deleted file mode 100644
index 8d949aa..0000000
--- a/src/pawlib/paw/testsuite/paw.commands/nt_pl_3d_3.ref.ps
+++ /dev/null
@@ -1,277 +0,0 @@
-%!PS-Adobe-2.0
-%%Title: /disk3/maartenb/cerncvs/paw/testsuite/tmp/nt_pl_3d_ (Portrait A 4)
-%%Pages: (atend)
-%%Creator: HIGZ Version 1.23/06
-%%CreationDate: 96/04/16 16.05
-%%EndComments
-%%BeginProlog
-/s {stroke} def /l {lineto} def /m {moveto} def /t {translate} def
-/sw {stringwidth} def /r {rotate} def /rl {roll} def /R {repeat} def
-/d {rlineto} def /rm {rmoveto} def /gr {grestore} def /f {eofill} def
-/c {setrgbcolor} def /lw {setlinewidth} def /sd {setdash} def
-/cl {closepath} def /sf {scalefont setfont} def /black {0 setgray} def
-/box {m dup 0 exch d exch 0 d 0 exch neg d cl} def
-/NC{systemdict begin initclip end}def/C{NC box clip newpath}def
-/bl {box s} def /bf {box f} def /Y { 0 exch d} def /X { 0 d} def
-/mp {newpath /y exch def /x exch def} def
-/side {[w .77 mul w .23 mul] .385 w mul sd w 0 l currentpoint t -144 r} def
-/mr {mp x y w2 0 360 arc} def /m24 {mr s} def /m20 {mr f} def
-/mb {mp x y w2 add m w2 neg 0 d 0 w neg d w 0 d 0 w d cl} def
-/mt {mp x y w2 add m w2 neg w neg d w 0 d cl} def
-/m21 {mb f} def /m25 {mb s} def /m22 {mt f} def /m26 {mt s} def
-/m23 {mp x y w2 sub m w2 w d w neg 0 d cl f} def
-/m27 {mp x y w2 add m w3 neg w2 neg d w3 w2 neg d w3 w2 d cl s} def
-/m28 {mp x w2 sub y w2 sub w3 add m w3 0 d 0 w3 neg d w3 0 d 0 w3 d w3 0 d
- 0 w3 d w3 neg 0 d 0 w3 d w3 neg 0 d
- 0 w3 neg d w3 neg 0 d cl s } def
-/m29 {mp gsave x w2 sub y w2 add w3 sub m currentpoint t
- 4 {side} repeat cl fill gr} def
-/m30 {mp gsave x w2 sub y w2 add w3 sub m currentpoint t
- 5 {side} repeat s gr} def
-/m31 {mp x y w2 sub m 0 w d x w2 sub y m w 0 d
- x w2 sub y w2 add m w w neg d x w2 sub y w2
- sub m w w d s} def
-/m2 {mp x y w2 sub m 0 w d x w2 sub y m w 0 d s} def
-/m5 {mp x w2 sub y w2 sub m w w d x w2 sub y w2 add m w w neg d s} def
-/DP {/PT exch def gsave 47.2 47.2 scale PT 1 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < AA AA 55 55 AA AA 55 55 AA AA 55 55 AA AA 55 55 AA AA 55 55 AA AA 55 55
-AA AA 55 55 AA AA 55 55 > } image } if PT 2 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < BB BB EE EE BB BB EE EE BB BB EE EE BB BB EE EE BB BB EE EE BB BB EE EE
-BB BB EE EE BB BB EE EE > } image } if PT 3 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < FF FF BB BB FF FF EE EE FF FF BB BB FF FF EE EE FF FF BB BB FF FF EE EE
-FF FF BB BB FF FF EE EE > } image } if PT 4 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < DF DF BF BF 7F 7F FE FE FD FD FB FB F7 F7 EF EF DF DF BF BF 7F 7F FE FE
-FD FD FB FB F7 F7 EF EF > } image } if PT 5 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < 7F 7F BF B F DF DF EF EF F7 F7 FB FB FD FD FE FE 7F 7F BF BF DF DF EF
-EF F7 F7 FB FB FD FD FE FE > } image } if PT 6 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB
-BB BB BB BB BB BB BB BB BB > } image } if PT 7 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < FF FF FF FF FF FF 00 00 FF FF FF FF FF FF 00 00 FF FF FF FF FF FF 00
-00 FF FF FF FF FF FF 00 00 > } image } if PT 8 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < EE EE 47 47 83 83 C5 C5 EE EE 5C 5C 38 38 74 74 EE EE 47 47 83 83 C5
-C5 EE EE 5C 5C 38 38 74 74 > } image } if PT 9 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < EF EF EF EF D7 D7 38 38 FE FE FE FE 7D 7D 83 83 EF EF EF EF D7 D7 38
-38 FE FE FE FE 7D 7D 83 83 > } image } if PT 10 eq { 16 16 1 [ 16 0 0 16 neg
-0 16 ] { < EF EF EF EF EF EF 00 00 FE FE FE FE FE FE 00 00 EF EF EF EF EF EF
-00 00 FE FE FE FE FE FE 00 00 > } image } if PT 11 eq { 16 16 1 [ 16 0 0 16
-neg 0 16 ] { < F7 F7 B6 B6 D5 D5 E3 E3 D5 D5 B6 B6 F7 F7 FF FF 7F 7F 6B 6B 5D
-5D 3E 3E 5D 5D 6B 6B 7F 7F FF FF > } image } if PT 12 eq { 16 16 1 [ 16 0 0
-16 neg 0 16 ] { < E3 E3 DD DD BE BE BE BE BE BE DD DD E3 E3 FF FF 3E 3E DD DD
-EB EB EB EB EB EB DD DD 3E 3E FF FF > } image } if PT 13 eq { 16 16 1 [ 16 0
-0 16 neg 0 16 ] { < FE FE 7D 7D BB BB D7 D7 EF EF D7 D7 BB BB 7D 7D FE FE 7D
-7D BB BB D7 D7 EF EF D7 D7 BB BB 7D 7D > } image } if PT 14 eq { 16 16 1 [ 16
-0 0 16 neg 0 16 ] { < 00 00 EE EF EE EF EE EF 0E E0 EE EE EE EE EE EE 00 EE
-FE EE FE EE FE EE 00 00 FE EF FE EF FE EF > } image } if PT 15 eq { 16 16 1 [
-16 0 0 16 neg 0 16 ] { < DD DD AA AA DD DD FF FF 77 77 AA AA 77 77 FF FF DD
-DD AA AA DD DD FF FF 77 77 AA AA 77 77 FF FF > } image } if PT 16 eq { 16 16
-1 [ 16 0 0 16 neg 0 16 ] { < F1 F1 EE EE 1F 1F FF FF F1 F1 EE EE 1F 1F FF FF
-F1 F1 EE EE 1F 1F FF FF F1 F1 EE EE 1F 1F FF FF > } image } if PT 17 eq { 16
-16 1 [ 16 0 0 16 neg 0 16 ] { < EE EE DD DD BB BB FF FF EE EE DD DD BB BB FF
- FF EE EE DD DD BB BB FF FF EE EE DD DD BB BB FF FF > } image } if PT 18 eq {
-16 16 1 [ 16 0 0 16 neg 0 16 ] { < BB BB DD DD EE EE FF FF BB BB DD DD EE EE
-FF FF BB BB DD DD EE EE FF FF BB BB DD DD EE EE FF FF > } image } if PT 19 eq
-{ 16 16 1 [ 16 0 0 16 neg 0 16 ] { < 1F FC 67 F3 7B EF BD DE BD DE DE BD E6
-B3 F8 0F E6 B3 DE BD BD DE BD DE 7B EF 67 F3 1F FC 7F FF > } image } if PT
-20 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < DD DD EE EE EE EE EE EE DD DD BB
-BB BB BB BB BB DD DD EE EE EE EE EE EE DD DD BB BB BB BB BB BB > } image }
-if PT 21 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < 0E 0E EF EF EF EF EF EF E0
-E0 FE FE FE FE FE FE 0E 0E EF EF EF EF EF EF E0 E0 FE FE FE FE FE FE > }
-image } if PT 22 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < 70 70 F7 F7 F7 F7 F7
-F7 07 07 7F 7F 7F 7F 7F 7F 70 70 F7 F7 F7 F7 F7 F7 07 07 7F 7F 7F 7F 7F 7F >
-} image } if PT 23 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < AA AA 55 55 A9 A9
-D1 D1 E1 E1 D1 D1 A9 A9 55 55 AA AA 55 55 A9 A9 D1 D1 E1 E1 D1 D1 A9 A9 55 55
-> } image } if PT 24 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < FF FE FF FC EA
-A8 D5 54 EA A8 D5 54 E8 28 D4 54 E8 E8 D4 D4 E8 EA 54 D5 A8 EA 54 D5 00 C0 00
-80 > } image } if PT 25 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < FF FE FF FC
-FF F8 FF F0 F0 00 F0 00 F0 20 F0 60 F0 E0 F1 E0 F3 E0 F0 00 E0 00 C0 00 80 00
-00 00 > } image } if gr } def /FA { /PT exch def gsave clip 0 0 translate 1 1
-54 { 1 sub 47.2 mul /Xcurr exch def 1 1 74 { 1 sub 47.2 mul /Ycurr exch def
-gsave Xcurr Ycurr translate PT DP gr } for } for gr } def
-/reencdict 24 dict def /ReEncode {reencdict begin /nco&na exch def
-/nfnam exch def /basefontname exch def /basefontdict basefontname findfont def
-/newfont basefontdict maxlength dict def basefontdict {exch dup /FID ne
-{dup /Encoding eq {exch dup length array copy newfont 3 1 roll put} {exch
-newfont 3 1 roll put} ifelse} {pop pop} ifelse } forall newfont
-/FontName nfnam put nco&na aload pop nco&na length 2 idiv {newfont
-/Encoding get 3 1 roll put} repeat nfnam newfont definefont pop end } def
-/accvec [ 176 /agrave 181 /Agrave 190 /acircumflex 192 /Acircumflex
-201 /adieresis 204 /Adieresis 209 /ccedilla 210 /Ccedilla 211 /eacute
-212 /Eacute 213 /egrave 214 /Egrave 215 /ecircumflex 216 /Ecircumflex
-217 /edieresis 218 /Edieresis 219 /icircumflex 220 /Icircumflex
-221 /idieresis 222 /Idieresis 223 /ntilde 224 /Ntilde 226 /ocircumflex
-228 /Ocircumflex 229 /odieresis 230 /Odieresis 231 /ucircumflex 236 /Ucircumflex
-237 /udieresis 238 /Udieresis 239 /aring 242 /Aring 243 /ydieresis
-244 /Ydieresis 246 /aacute 247 /Aacute 252 /ugrave 253 /Ugrave] def
-/Times-Roman /Times-Roman accvec ReEncode
-/Times-Italic /Times-Italic accvec ReEncode
-/Times-Bold /Times-Bold accvec ReEncode
-/Times-BoldItalic /Times-BoldItalic accvec ReEncode
-/Helvetica /Helvetica accvec ReEncode
-/Helvetica-Oblique /Helvetica-Oblique accvec ReEncode
-/Helvetica-Bold /Helvetica-Bold accvec ReEncode
-/Helvetica-BoldOblique /Helvetica-BoldOblique accvec ReEncode
-/Courier /Courier accvec ReEncode
-/Courier-Oblique /Courier-Oblique accvec ReEncode
-/Courier-Bold /Courier-Bold accvec ReEncode
-/Courier-BoldOblique /Courier-BoldOblique accvec ReEncode
-/oshow {gsave [] 0 sd true charpath stroke gr} def
-/stwn { /fs exch def /fn exch def /text exch def fn findfont fs sf
- text sw pop xs add /xs exch def} def
-/stwb { /fs exch def /fn exch def /nbas exch def /textf exch def
-textf length /tlen exch def nbas tlen gt {/nbas tlen def} if
-fn findfont fs sf textf dup length nbas sub nbas getinterval sw
-pop neg xs add /xs exch def} def
-/accspe [ 65 /plusminus 66 /bar 67 /existential 68 /universal
-69 /exclam 70 /numbersign 71 /greater 72 /question 73 /integral
-74 /colon 75 /semicolon 76 /less 77 /bracketleft 78 /bracketright
-79 /greaterequal 80 /braceleft 81 /braceright 82 /radical
-83 /spade 84 /heart 85 /diamond 86 /club 87 /lessequal
-88 /multiply 89 /percent 90 /infinity 48 /circlemultiply 49 /circleplus
-50 /emptyset 51 /lozenge 52 /bullet 53 /arrowright 54 /arrowup
-55 /arrowleft 56 /arrowdown 57 /arrowboth 48 /degree 44 /comma 43 /plus
- 45 /angle 42 /angleleft 47 /divide 61 /notequal 40 /equivalence 41 /second
- 97 /approxequal 98 /congruent 99 /perpendicular 100 /partialdiff 101 /florin
- 102 /intersection 103 /union 104 /propersuperset 105 /reflexsuperset
- 106 /notsubset 107 /propersubset 108 /reflexsubset 109 /element 110 /notelement
- 111 /gradient 112 /logicaland 113 /logicalor 114 /arrowdblboth
- 115 /arrowdblleft 116 /arrowdblup 117 /arrowdblright 118 /arrowdbldown
- 119 /ampersand 120 /omega1 121 /similar 122 /aleph ] def
-/Symbol /Special accspe ReEncode
-/Zone {/iy exch def /ix exch def ix 1 sub 2224 mul 1 iy sub 3144
- mul t} def
-%%EndProlog
- gsave 20 28 t .25 .25 scale gsave
-%%Page: number 1
- gsave
- 1 1 Zone
- gsave 0 0 t black [] 0 sd 1 lw 2223 2224 0 460 bl 2223 2224 0 460 C 1779 1778
- 222 683 C NC [4 8] 0 sd 222 1279 m 1128 287 d s 222 1379 m 1128 287 d s 222
- 1478 m 1128 287 d s 222 1578 m 1128 287 d s 222 1677 m 1128 287 d s 222 1776 m
- 1128 288 d s 222 1876 m 1128 287 d s 222 1975 m 1128 287 d s 222 2075 m 1128
- 287 d s [] 0 sd 222 1180 m 1128 287 d s 1350 1467 m 994 Y s 222 2174 m 1128 287
- d s 222 1180 m 994 Y s [4 8] 0 sd 1350 1566 m 651 -497 d s 1350 1666 m 651 -497
- d s 1350 1765 m 651 -497 d s 1350 1865 m 651 -497 d s 1350 1964 m 651 -497 d s
- 1350 2064 m 651 -498 d s 1350 2163 m 651 -497 d s 1350 2262 m 651 -497 d s 1350
- 2362 m 651 -497 d s [] 0 sd 1350 1467 m 651 -497 d s 2001 970 m 994 Y s 1350
- 2461 m 651 -497 d s 1350 1467 m cl s 994 539 m -16 -21 d s 978 539 m 16 X s 978
- 518 m 16 X s 1015 549 m 12 -31 d s 1039 549 m -12 -31 d s 1066 545 m -3 3 d -5
- 1 d -6 X -4 -1 d -3 -3 d -3 Y 1 -3 d 2 -1 d 3 -2 d 9 -3 d 3 -1 d 1 -2 d 2 -3 d
- -4 Y -3 -3 d -5 -2 d -6 X -4 2 d -3 3 d s 1077 521 m -1 -1 d 1 -2 d 2 2 d -2 1
- d cl s 1103 539 m 9 -21 d s 1120 539 m -8 -21 d -3 -6 d -3 -3 d -3 -1 d -2 X s
- 1140 549 m 12 -31 d s 1163 549 m -11 -31 d s 1190 545 m -3 3 d -4 1 d -6 X -5
- -1 d -3 -3 d -3 Y 2 -3 d 1 -1 d 3 -2 d 9 -3 d 3 -1 d 2 -2 d 1 -3 d -4 Y -3 -3 d
- -4 -2 d -6 X -5 2 d -3 3 d s 1202 521 m -2 -1 d 2 -2 d 1 2 d -1 1 d cl s 1229
- 539 m 16 -21 d s 1245 539 m -16 -21 d s 842 966 m 414 381 d 338 445 d -189 -318
- d 87 380 d -879 -715 d 470 -41 d -249 -49 d 183 345 d 434 297 d -335 -55 d 672
- 302 d -642 -825 d 103 102 d 245 1046 d 15 -657 d -243 -166 d -50 -244 d -147
- -24 d -261 -229 d 675 703 d -718 -718 d 545 541 d -773 -312 d 378 -136 d -32 83
- d 824 857 d -349 -347 d 341 298 d -732 -405 d 551 89 d -819 -567 d 309 2 d -312
- -61 d 100 215 d 801 487 d -245 -367 d -330 -33 d 126 161 d 92 -242 d -21 -15 d
- 437 630 d -914 -468 d -374 Y 98 -4 d 195 166 d -92 261 d 604 146 d -292 -298 d
- 343 827 d -518 -987 d -112 235 d 680 448 d -342 178 d 239 52 d -799 -669 d 328
- -245 d -17 317 d -180 -364 d 676 707 d 41 -124 d -34 315 d -72 -390 d -685 87 d
- -147 -576 d 607 280 d 426 592 d -243 146 d -465 -832 d 161 205 d -448 -420 d
- 421 344 d 108 -138 d -414 1 d 16 -277 d 791 768 d -115 42 d -491 -722 d 604 894
- d -440 -524 d -524 -331 d 443 196 d 623 507 d -268 183 d -173 -660 d -558 -220
- d 657 909 d -113 -766 d 368 691 d -446 -711 d 340 650 d -165 -434 d -524 -440 d
- 571 415 d -649 -15 d -56 -369 d 750 951 d -542 -972 d 728 1028 d -281 -535 d s
- 222 1180 m 651 -497 d s 873 683 m 994 Y s 222 2174 m 651 -497 d s 222 1180 m
- 994 Y s 873 683 m 1128 287 d s 2001 970 m 994 Y s 873 1677 m 1128 287 d s 873
- 1677 m cl s 873 683 m 1128 287 d s 976 676 m 33 Y s 1001 699 m 16 Y s 1027 705
- m 17 Y s 1053 712 m 16 Y s 1078 718 m 17 Y s 1104 708 m 33 Y s 1129 731 m 17 Y
- s 1155 738 m 17 Y s 1181 744 m 17 Y s 1206 751 m 17 Y s 1232 741 m 33 Y s 1258
- 764 m 17 Y s 1283 770 m 17 Y s 1309 777 m 17 Y s 1334 784 m 16 Y s 1360 773 m
- 34 Y s 1386 797 m 16 Y s 1411 803 m 17 Y s 1437 810 m 16 Y s 1463 816 m 17 Y s
- 1488 806 m 33 Y s 1514 829 m 17 Y s 1539 836 m 16 Y s 1565 842 m 17 Y s 1591
- 849 m 16 Y s 1616 839 m 33 Y s 1642 862 m 16 Y s 1668 868 m 17 Y s 1693 875 m
- 17 Y s 1719 881 m 17 Y s 1744 871 m 34 Y s 1770 894 m 17 Y s 1796 901 m 17 Y s
- 1821 907 m 17 Y s 1847 914 m 17 Y s 1873 904 m 33 Y s 1898 927 m 17 Y s 1924
- 934 m 16 Y s 1949 940 m 17 Y s 1975 947 m 16 Y s 2001 936 m 34 Y s 976 676 m 33
- Y s 950 686 m 16 Y s 924 679 m 17 Y s 899 673 m 16 Y s 2001 936 m 34 Y s 978
- 657 m -4 -2 d -3 -4 d -2 -8 d -4 Y 2 -8 d 3 -4 d 4 -1 d 3 X 5 1 d 2 4 d 2 8 d 4
- Y -2 8 d -2 4 d -5 2 d -3 X cl s 1081 689 m -5 -1 d -3 -5 d -1 -7 d -5 Y 1 -7 d
- 3 -4 d 5 -2 d 3 X 4 2 d 3 4 d 2 7 d 5 Y -2 7 d -3 5 d -4 1 d -3 X cl s 1104 661
- m -1 -1 d 1 -2 d 2 2 d -2 1 d cl s 1118 682 m 1 Y 1 3 d 2 2 d 3 1 d 6 X 3 -1 d
- 1 -2 d 2 -3 d -3 Y -2 -3 d -3 -4 d -15 -15 d 21 X s 1164 689 m -15 X -2 -13 d 2
- 1 d 4 2 d 5 X 4 -2 d 3 -3 d 2 -4 d -3 Y -2 -4 d -3 -3 d -4 -2 d -5 X -4 2 d -2
- 1 d -1 3 d s 1220 722 m -5 -2 d -3 -4 d -1 -7 d -5 Y 1 -7 d 3 -5 d 5 -1 d 3 X 4
- 1 d 3 5 d 2 7 d 5 Y -2 7 d -3 4 d -4 2 d -3 X cl s 1244 694 m -2 -2 d 2 -1 d 1
- 1 d -1 2 d cl s 1273 722 m -15 X -1 -13 d 1 1 d 5 2 d 4 X 5 -2 d 3 -3 d 1 -4 d
- -3 Y -1 -5 d -3 -3 d -5 -1 d -4 X -5 1 d -1 2 d -2 3 d s 1337 754 m -5 -1 d -2
- -4 d -2 -8 d -4 Y 2 -8 d 2 -4 d 5 -2 d 3 X 4 2 d 3 4 d 2 8 d 4 Y -2 8 d -3 4 d
- -4 1 d -3 X cl s 1361 726 m -2 -1 d 2 -2 d 1 2 d -1 1 d cl s 1393 754 m -15 -31
- d s 1373 754 m 20 X s 1420 754 m -15 X -1 -13 d 1 2 d 5 1 d 4 X 4 -1 d 3 -3 d 2
- -5 d -3 Y -2 -4 d -3 -3 d -4 -2 d -4 X -5 2 d -1 1 d -2 3 d s 1486 781 m 3 2 d
- 5 4 d -31 Y s 1589 814 m 3 1 d 4 5 d -31 Y s 1617 792 m -2 -2 d 2 -1 d 1 1 d -1
- 2 d cl s 1630 812 m 2 Y 2 3 d 1 1 d 3 2 d 6 X 3 -2 d 2 -1 d 1 -3 d -3 Y -1 -3 d
- -3 -5 d -15 -14 d 20 X s 1676 820 m -15 X -1 -14 d 1 2 d 5 1 d 4 X 5 -1 d 3 -3
- d 1 -5 d -3 Y -1 -4 d -3 -3 d -5 -1 d -4 X -5 1 d -1 2 d -2 3 d s 1728 846 m 3
- 2 d 4 4 d -31 Y s 1756 824 m -1 -1 d 1 -2 d 1 2 d -1 1 d cl s 1786 852 m -15 X
- -2 -13 d 2 1 d 4 2 d 5 X 4 -2 d 3 -2 d 2 -5 d -3 Y -2 -4 d -3 -3 d -4 -2 d -5 X
- -4 2 d -2 1 d -1 3 d s 1845 879 m 3 2 d 4 4 d -31 Y s 1873 857 m -1 -2 d 1 -1 d
- 2 1 d -2 2 d cl s 1906 885 m -15 -31 d s 1885 885 m 21 X s 1932 885 m -14 X -2
- -13 d 2 1 d 4 2 d 4 X 5 -2 d 3 -3 d 1 -4 d -3 Y -1 -5 d -3 -3 d -5 -1 d -4 X -4
- 1 d -2 2 d -1 3 d s 1996 910 m 2 Y 1 3 d 2 1 d 3 2 d 6 X 2 -2 d 2 -1 d 1 -3 d
- -3 Y -1 -3 d -3 -5 d -15 -15 d 21 X s 873 683 m -651 497 d s 873 649 m 34 Y s
- 852 683 m 16 Y s 830 699 m 17 Y s 808 716 m 17 Y s 786 732 m 17 Y s 765 732 m
- 34 Y s 743 766 m 16 Y s 721 782 m 17 Y s 700 799 m 16 Y s 678 815 m 17 Y s 656
- 815 m 34 Y s 635 848 m 17 Y s 613 865 m 17 Y s 591 882 m 16 Y s 569 898 m 17 Y
- s 548 898 m 33 Y s 526 931 m 17 Y s 504 948 m 16 Y s 483 964 m 17 Y s 461 981 m
- 17 Y s 439 981 m 33 Y s 418 1014 m 17 Y s 396 1031 m 16 Y s 374 1047 m 17 Y s
- 352 1064 m 16 Y s 331 1064 m 33 Y s 309 1097 m 17 Y s 287 1114 m 16 Y s 266
- 1130 m 17 Y s 244 1147 m 16 Y s 222 1147 m 33 Y s 873 649 m 34 Y s 222 1147 m
- 33 Y s 785 573 m 27 X s 827 585 m 3 1 d 4 5 d -32 Y s 855 562 m -2 -1 d 2 -2 d
- 1 2 d -1 1 d cl s 884 591 m -14 X -2 -14 d 2 2 d 4 1 d 4 X 5 -1 d 3 -3 d 1 -5 d
- -3 Y -1 -4 d -3 -3 d -5 -2 d -4 X -4 2 d -2 1 d -1 3 d s 718 656 m 26 X s 759
- 667 m 3 2 d 5 4 d -31 Y s 568 738 m 27 X s 614 756 m -4 -1 d -3 -5 d -2 -7 d -5
- Y 2 -7 d 3 -4 d 4 -2 d 3 X 4 2 d 3 4 d 2 7 d 5 Y -2 7 d -3 5 d -4 1 d -3 X cl s
- 638 728 m -2 -1 d 2 -2 d 1 2 d -1 1 d cl s 667 756 m -14 X -2 -13 d 2 1 d 4 2 d
- 4 X 5 -2 d 3 -3 d 1 -4 d -3 Y -1 -4 d -3 -3 d -5 -2 d -4 X -4 2 d -2 1 d -1 3 d
- s 537 839 m -5 -1 d -3 -5 d -1 -7 d -5 Y 1 -7 d 3 -5 d 5 -1 d 3 X 4 1 d 3 5 d 2
- 7 d 5 Y -2 7 d -3 5 d -4 1 d -3 X cl s 387 922 m -4 -2 d -3 -4 d -2 -7 d -5 Y 2
- -7 d 3 -5 d 4 -1 d 3 X 5 1 d 3 5 d 1 7 d 5 Y -1 7 d -3 4 d -5 2 d -3 X cl s 411
- 894 m -2 -2 d 2 -1 d 1 1 d -1 2 d cl s 441 922 m -15 X -2 -13 d 2 1 d 4 2 d 5 X
- 4 -2 d 3 -3 d 2 -4 d -3 Y -2 -5 d -3 -3 d -4 -1 d -5 X -4 1 d -2 2 d -1 3 d s
- 315 999 m 3 1 d 5 5 d -31 Y s 166 1082 m 3 1 d 4 5 d -31 Y s 194 1060 m -2 -2 d
- 2 -1 d 1 1 d -1 2 d cl s 224 1088 m -15 X -2 -14 d 2 2 d 4 1 d 5 X 4 -1 d 3 -3
- d 2 -5 d -3 Y -2 -4 d -3 -3 d -4 -1 d -5 X -4 1 d -2 2 d -1 2 d s 222 1180 m
- 994 Y s 189 1180 m 33 X s 206 1200 m 16 X s 206 1220 m 16 X s 206 1240 m 16 X s
- 206 1259 m 16 X s 189 1279 m 33 X s 206 1299 m 16 X s 206 1319 m 16 X s 206
- 1339 m 16 X s 206 1359 m 16 X s 189 1379 m 33 X s 206 1399 m 16 X s 206 1419 m
- 16 X s 206 1438 m 16 X s 206 1458 m 16 X s 189 1478 m 33 X s 206 1498 m 16 X s
- 206 1518 m 16 X s 206 1538 m 16 X s 206 1558 m 16 X s 189 1578 m 33 X s 206
- 1598 m 16 X s 206 1617 m 16 X s 206 1637 m 16 X s 206 1657 m 16 X s 189 1677 m
- 33 X s 206 1697 m 16 X s 206 1717 m 16 X s 206 1737 m 16 X s 206 1757 m 16 X s
- 189 1776 m 33 X s 206 1796 m 16 X s 206 1816 m 16 X s 206 1836 m 16 X s 206
- 1856 m 16 X s 189 1876 m 33 X s 206 1896 m 16 X s 206 1916 m 16 X s 206 1936 m
- 16 X s 206 1955 m 16 X s 189 1975 m 33 X s 206 1995 m 16 X s 206 2015 m 16 X s
- 206 2035 m 16 X s 206 2055 m 16 X s 189 2075 m 33 X s 206 2095 m 16 X s 206
- 2115 m 16 X s 206 2134 m 16 X s 206 2154 m 16 X s 189 2174 m 33 X s 150 1195 m
- -4 -1 d -3 -4 d -1 -8 d -4 Y 1 -8 d 3 -4 d 4 -2 d 3 X 5 2 d 3 4 d 1 8 d 4 Y -1
- 8 d -3 4 d -5 1 d -3 X cl s 106 1295 m -4 -2 d -3 -4 d -2 -7 d -5 Y 2 -7 d 3 -5
- d 4 -1 d 3 X 4 1 d 3 5 d 2 7 d 5 Y -2 7 d -3 4 d -4 2 d -3 X cl s 130 1267 m -2
- -2 d 2 -1 d 1 1 d -1 2 d cl s 159 1295 m -15 X -1 -13 d 1 1 d 5 2 d 4 X 5 -2 d
- 3 -3 d 1 -4 d -3 Y -1 -5 d -3 -3 d -5 -1 d -4 X -5 1 d -1 2 d -1 3 d s 146 1388
- m 3 2 d 4 4 d -31 Y s 102 1488 m 2 1 d 5 5 d -31 Y s 130 1466 m -2 -2 d 2 -1 d
- 1 1 d -1 2 d cl s 159 1494 m -15 X -1 -14 d 1 2 d 5 1 d 4 X 5 -1 d 3 -3 d 1 -5
- d -2 Y -1 -5 d -3 -3 d -5 -1 d -4 X -5 1 d -1 2 d -1 3 d s 143 1586 m 1 Y 1 3 d
- 2 2 d 3 1 d 6 X 3 -1 d 1 -2 d 2 -3 d -3 Y -2 -3 d -3 -4 d -14 -15 d 20 X s 99
- 1685 m 2 Y 1 3 d 2 1 d 2 2 d 6 X 3 -2 d 2 -1 d 1 -3 d -3 Y -1 -3 d -3 -5 d -15
- -15 d 21 X s 130 1664 m -2 -1 d 2 -2 d 1 2 d -1 1 d cl s 159 1693 m -15 X -1
- -14 d 1 2 d 5 1 d 4 X 5 -1 d 3 -3 d 1 -5 d -3 Y -1 -4 d -3 -3 d -5 -2 d -4 X -5
- 2 d -1 1 d -1 3 d s 144 1792 m 17 X -9 -12 d 4 X 3 -1 d 2 -2 d 1 -4 d -3 Y -1
- -5 d -3 -3 d -5 -1 d -4 X -5 1 d -1 2 d -1 3 d s 100 1891 m 16 X -9 -11 d 5 X 3
- -2 d 1 -1 d 2 -5 d -3 Y -2 -4 d -3 -3 d -4 -2 d -5 X -4 2 d -1 1 d -2 3 d s 130
- 1863 m -2 -1 d 2 -2 d 1 2 d -1 1 d cl s 159 1891 m -15 X -1 -13 d 1 2 d 5 1 d 4
- X 5 -1 d 3 -3 d 1 -5 d -3 Y -1 -4 d -3 -3 d -5 -2 d -4 X -5 2 d -1 1 d -1 3 d s
- 156 1991 m -14 -21 d 22 X s 156 1991 m -31 Y s 112 2090 m -15 -20 d 22 X s 112
- 2090 m -31 Y s 130 2062 m -2 -1 d 2 -2 d 1 2 d -1 1 d cl s 159 2090 m -15 X -1
- -13 d 1 1 d 5 2 d 4 X 5 -2 d 3 -2 d 1 -5 d -3 Y -1 -4 d -3 -3 d -5 -2 d -4 X -5
- 2 d -1 1 d -1 3 d s 159 2190 m -15 X -1 -14 d 1 2 d 5 1 d 4 X 5 -1 d 3 -3 d 1
- -5 d -2 Y -1 -5 d -3 -3 d -5 -1 d -4 X -5 1 d -1 2 d -1 3 d s gr
-showpage
- gr
-%%Trailer
-%%Pages: 1
- gr gr
-%%EOF
diff --git a/src/pawlib/paw/testsuite/paw.commands/nt_pl_4d_1.ref.ps b/src/pawlib/paw/testsuite/paw.commands/nt_pl_4d_1.ref.ps
deleted file mode 100644
index 75e9118..0000000
--- a/src/pawlib/paw/testsuite/paw.commands/nt_pl_4d_1.ref.ps
+++ /dev/null
@@ -1,2965 +0,0 @@
-%!PS-Adobe-2.0
-%%Title: /disk3/maartenb/cerncvs/paw/testsuite/tmp/nt_pl_4d_ (Portrait A 4)
-%%Pages: (atend)
-%%Creator: HIGZ Version 1.23/06
-%%CreationDate: 96/04/16 16.05
-%%EndComments
-%%BeginProlog
-/s {stroke} def /l {lineto} def /m {moveto} def /t {translate} def
-/sw {stringwidth} def /r {rotate} def /rl {roll} def /R {repeat} def
-/d {rlineto} def /rm {rmoveto} def /gr {grestore} def /f {eofill} def
-/c {setrgbcolor} def /lw {setlinewidth} def /sd {setdash} def
-/cl {closepath} def /sf {scalefont setfont} def /black {0 setgray} def
-/box {m dup 0 exch d exch 0 d 0 exch neg d cl} def
-/NC{systemdict begin initclip end}def/C{NC box clip newpath}def
-/bl {box s} def /bf {box f} def /Y { 0 exch d} def /X { 0 d} def
-/mp {newpath /y exch def /x exch def} def
-/side {[w .77 mul w .23 mul] .385 w mul sd w 0 l currentpoint t -144 r} def
-/mr {mp x y w2 0 360 arc} def /m24 {mr s} def /m20 {mr f} def
-/mb {mp x y w2 add m w2 neg 0 d 0 w neg d w 0 d 0 w d cl} def
-/mt {mp x y w2 add m w2 neg w neg d w 0 d cl} def
-/m21 {mb f} def /m25 {mb s} def /m22 {mt f} def /m26 {mt s} def
-/m23 {mp x y w2 sub m w2 w d w neg 0 d cl f} def
-/m27 {mp x y w2 add m w3 neg w2 neg d w3 w2 neg d w3 w2 d cl s} def
-/m28 {mp x w2 sub y w2 sub w3 add m w3 0 d 0 w3 neg d w3 0 d 0 w3 d w3 0 d
- 0 w3 d w3 neg 0 d 0 w3 d w3 neg 0 d
- 0 w3 neg d w3 neg 0 d cl s } def
-/m29 {mp gsave x w2 sub y w2 add w3 sub m currentpoint t
- 4 {side} repeat cl fill gr} def
-/m30 {mp gsave x w2 sub y w2 add w3 sub m currentpoint t
- 5 {side} repeat s gr} def
-/m31 {mp x y w2 sub m 0 w d x w2 sub y m w 0 d
- x w2 sub y w2 add m w w neg d x w2 sub y w2
- sub m w w d s} def
-/m2 {mp x y w2 sub m 0 w d x w2 sub y m w 0 d s} def
-/m5 {mp x w2 sub y w2 sub m w w d x w2 sub y w2 add m w w neg d s} def
-/DP {/PT exch def gsave 47.2 47.2 scale PT 1 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < AA AA 55 55 AA AA 55 55 AA AA 55 55 AA AA 55 55 AA AA 55 55 AA AA 55 55
-AA AA 55 55 AA AA 55 55 > } image } if PT 2 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < BB BB EE EE BB BB EE EE BB BB EE EE BB BB EE EE BB BB EE EE BB BB EE EE
-BB BB EE EE BB BB EE EE > } image } if PT 3 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < FF FF BB BB FF FF EE EE FF FF BB BB FF FF EE EE FF FF BB BB FF FF EE EE
-FF FF BB BB FF FF EE EE > } image } if PT 4 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < DF DF BF BF 7F 7F FE FE FD FD FB FB F7 F7 EF EF DF DF BF BF 7F 7F FE FE
-FD FD FB FB F7 F7 EF EF > } image } if PT 5 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < 7F 7F BF B F DF DF EF EF F7 F7 FB FB FD FD FE FE 7F 7F BF BF DF DF EF
-EF F7 F7 FB FB FD FD FE FE > } image } if PT 6 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB
-BB BB BB BB BB BB BB BB BB > } image } if PT 7 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < FF FF FF FF FF FF 00 00 FF FF FF FF FF FF 00 00 FF FF FF FF FF FF 00
-00 FF FF FF FF FF FF 00 00 > } image } if PT 8 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < EE EE 47 47 83 83 C5 C5 EE EE 5C 5C 38 38 74 74 EE EE 47 47 83 83 C5
-C5 EE EE 5C 5C 38 38 74 74 > } image } if PT 9 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < EF EF EF EF D7 D7 38 38 FE FE FE FE 7D 7D 83 83 EF EF EF EF D7 D7 38
-38 FE FE FE FE 7D 7D 83 83 > } image } if PT 10 eq { 16 16 1 [ 16 0 0 16 neg
-0 16 ] { < EF EF EF EF EF EF 00 00 FE FE FE FE FE FE 00 00 EF EF EF EF EF EF
-00 00 FE FE FE FE FE FE 00 00 > } image } if PT 11 eq { 16 16 1 [ 16 0 0 16
-neg 0 16 ] { < F7 F7 B6 B6 D5 D5 E3 E3 D5 D5 B6 B6 F7 F7 FF FF 7F 7F 6B 6B 5D
-5D 3E 3E 5D 5D 6B 6B 7F 7F FF FF > } image } if PT 12 eq { 16 16 1 [ 16 0 0
-16 neg 0 16 ] { < E3 E3 DD DD BE BE BE BE BE BE DD DD E3 E3 FF FF 3E 3E DD DD
-EB EB EB EB EB EB DD DD 3E 3E FF FF > } image } if PT 13 eq { 16 16 1 [ 16 0
-0 16 neg 0 16 ] { < FE FE 7D 7D BB BB D7 D7 EF EF D7 D7 BB BB 7D 7D FE FE 7D
-7D BB BB D7 D7 EF EF D7 D7 BB BB 7D 7D > } image } if PT 14 eq { 16 16 1 [ 16
-0 0 16 neg 0 16 ] { < 00 00 EE EF EE EF EE EF 0E E0 EE EE EE EE EE EE 00 EE
-FE EE FE EE FE EE 00 00 FE EF FE EF FE EF > } image } if PT 15 eq { 16 16 1 [
-16 0 0 16 neg 0 16 ] { < DD DD AA AA DD DD FF FF 77 77 AA AA 77 77 FF FF DD
-DD AA AA DD DD FF FF 77 77 AA AA 77 77 FF FF > } image } if PT 16 eq { 16 16
-1 [ 16 0 0 16 neg 0 16 ] { < F1 F1 EE EE 1F 1F FF FF F1 F1 EE EE 1F 1F FF FF
-F1 F1 EE EE 1F 1F FF FF F1 F1 EE EE 1F 1F FF FF > } image } if PT 17 eq { 16
-16 1 [ 16 0 0 16 neg 0 16 ] { < EE EE DD DD BB BB FF FF EE EE DD DD BB BB FF
- FF EE EE DD DD BB BB FF FF EE EE DD DD BB BB FF FF > } image } if PT 18 eq {
-16 16 1 [ 16 0 0 16 neg 0 16 ] { < BB BB DD DD EE EE FF FF BB BB DD DD EE EE
-FF FF BB BB DD DD EE EE FF FF BB BB DD DD EE EE FF FF > } image } if PT 19 eq
-{ 16 16 1 [ 16 0 0 16 neg 0 16 ] { < 1F FC 67 F3 7B EF BD DE BD DE DE BD E6
-B3 F8 0F E6 B3 DE BD BD DE BD DE 7B EF 67 F3 1F FC 7F FF > } image } if PT
-20 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < DD DD EE EE EE EE EE EE DD DD BB
-BB BB BB BB BB DD DD EE EE EE EE EE EE DD DD BB BB BB BB BB BB > } image }
-if PT 21 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < 0E 0E EF EF EF EF EF EF E0
-E0 FE FE FE FE FE FE 0E 0E EF EF EF EF EF EF E0 E0 FE FE FE FE FE FE > }
-image } if PT 22 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < 70 70 F7 F7 F7 F7 F7
-F7 07 07 7F 7F 7F 7F 7F 7F 70 70 F7 F7 F7 F7 F7 F7 07 07 7F 7F 7F 7F 7F 7F >
-} image } if PT 23 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < AA AA 55 55 A9 A9
-D1 D1 E1 E1 D1 D1 A9 A9 55 55 AA AA 55 55 A9 A9 D1 D1 E1 E1 D1 D1 A9 A9 55 55
-> } image } if PT 24 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < FF FE FF FC EA
-A8 D5 54 EA A8 D5 54 E8 28 D4 54 E8 E8 D4 D4 E8 EA 54 D5 A8 EA 54 D5 00 C0 00
-80 > } image } if PT 25 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < FF FE FF FC
-FF F8 FF F0 F0 00 F0 00 F0 20 F0 60 F0 E0 F1 E0 F3 E0 F0 00 E0 00 C0 00 80 00
-00 00 > } image } if gr } def /FA { /PT exch def gsave clip 0 0 translate 1 1
-54 { 1 sub 47.2 mul /Xcurr exch def 1 1 74 { 1 sub 47.2 mul /Ycurr exch def
-gsave Xcurr Ycurr translate PT DP gr } for } for gr } def
-/reencdict 24 dict def /ReEncode {reencdict begin /nco&na exch def
-/nfnam exch def /basefontname exch def /basefontdict basefontname findfont def
-/newfont basefontdict maxlength dict def basefontdict {exch dup /FID ne
-{dup /Encoding eq {exch dup length array copy newfont 3 1 roll put} {exch
-newfont 3 1 roll put} ifelse} {pop pop} ifelse } forall newfont
-/FontName nfnam put nco&na aload pop nco&na length 2 idiv {newfont
-/Encoding get 3 1 roll put} repeat nfnam newfont definefont pop end } def
-/accvec [ 176 /agrave 181 /Agrave 190 /acircumflex 192 /Acircumflex
-201 /adieresis 204 /Adieresis 209 /ccedilla 210 /Ccedilla 211 /eacute
-212 /Eacute 213 /egrave 214 /Egrave 215 /ecircumflex 216 /Ecircumflex
-217 /edieresis 218 /Edieresis 219 /icircumflex 220 /Icircumflex
-221 /idieresis 222 /Idieresis 223 /ntilde 224 /Ntilde 226 /ocircumflex
-228 /Ocircumflex 229 /odieresis 230 /Odieresis 231 /ucircumflex 236 /Ucircumflex
-237 /udieresis 238 /Udieresis 239 /aring 242 /Aring 243 /ydieresis
-244 /Ydieresis 246 /aacute 247 /Aacute 252 /ugrave 253 /Ugrave] def
-/Times-Roman /Times-Roman accvec ReEncode
-/Times-Italic /Times-Italic accvec ReEncode
-/Times-Bold /Times-Bold accvec ReEncode
-/Times-BoldItalic /Times-BoldItalic accvec ReEncode
-/Helvetica /Helvetica accvec ReEncode
-/Helvetica-Oblique /Helvetica-Oblique accvec ReEncode
-/Helvetica-Bold /Helvetica-Bold accvec ReEncode
-/Helvetica-BoldOblique /Helvetica-BoldOblique accvec ReEncode
-/Courier /Courier accvec ReEncode
-/Courier-Oblique /Courier-Oblique accvec ReEncode
-/Courier-Bold /Courier-Bold accvec ReEncode
-/Courier-BoldOblique /Courier-BoldOblique accvec ReEncode
-/oshow {gsave [] 0 sd true charpath stroke gr} def
-/stwn { /fs exch def /fn exch def /text exch def fn findfont fs sf
- text sw pop xs add /xs exch def} def
-/stwb { /fs exch def /fn exch def /nbas exch def /textf exch def
-textf length /tlen exch def nbas tlen gt {/nbas tlen def} if
-fn findfont fs sf textf dup length nbas sub nbas getinterval sw
-pop neg xs add /xs exch def} def
-/accspe [ 65 /plusminus 66 /bar 67 /existential 68 /universal
-69 /exclam 70 /numbersign 71 /greater 72 /question 73 /integral
-74 /colon 75 /semicolon 76 /less 77 /bracketleft 78 /bracketright
-79 /greaterequal 80 /braceleft 81 /braceright 82 /radical
-83 /spade 84 /heart 85 /diamond 86 /club 87 /lessequal
-88 /multiply 89 /percent 90 /infinity 48 /circlemultiply 49 /circleplus
-50 /emptyset 51 /lozenge 52 /bullet 53 /arrowright 54 /arrowup
-55 /arrowleft 56 /arrowdown 57 /arrowboth 48 /degree 44 /comma 43 /plus
- 45 /angle 42 /angleleft 47 /divide 61 /notequal 40 /equivalence 41 /second
- 97 /approxequal 98 /congruent 99 /perpendicular 100 /partialdiff 101 /florin
- 102 /intersection 103 /union 104 /propersuperset 105 /reflexsuperset
- 106 /notsubset 107 /propersubset 108 /reflexsubset 109 /element 110 /notelement
- 111 /gradient 112 /logicaland 113 /logicalor 114 /arrowdblboth
- 115 /arrowdblleft 116 /arrowdblup 117 /arrowdblright 118 /arrowdbldown
- 119 /ampersand 120 /omega1 121 /similar 122 /aleph ] def
-/Symbol /Special accspe ReEncode
-/Zone {/iy exch def /ix exch def ix 1 sub 2224 mul 1 iy sub 3144
- mul t} def
-%%EndProlog
- gsave 20 28 t .25 .25 scale gsave
-%%Page: number 1
- gsave
- 1 1 Zone
- gsave 0 0 t black [] 0 sd 1 lw 2223 2224 0 460 bl 2223 2224 0 460 C 1779 1778
- 222 683 C NC [4 8] 0 sd 222 1290 m 1128 287 d s 222 1401 m 1128 287 d s 222
- 1511 m 1128 287 d s 222 1622 m 1128 287 d s 222 1732 m 1128 287 d s 222 1843 m
- 1128 287 d s 222 1953 m 1128 287 d s 222 2064 m 1128 287 d s [] 0 sd 222 1180 m
- 1128 287 d s 1350 1467 m 994 Y s 222 2174 m 1128 287 d s 222 1180 m 994 Y s
- [4 8] 0 sd 1350 1577 m 651 -497 d s 1350 1688 m 651 -497 d s 1350 1798 m 651
- -497 d s 1350 1909 m 651 -497 d s 1350 2019 m 651 -497 d s 1350 2130 m 651 -497
- d s 1350 2240 m 651 -497 d s 1350 2351 m 651 -497 d s [] 0 sd 1350 1467 m 651
- -497 d s 2001 970 m 994 Y s 1350 2461 m 651 -497 d s 1350 1467 m cl s 931 539 m
- -17 -21 d s 914 539 m 17 X s 914 518 m 17 X s 951 549 m 12 -31 d s 975 549 m
- -12 -31 d s 1002 545 m -3 3 d -5 1 d -5 X -5 -1 d -3 -3 d -3 Y 2 -3 d 1 -1 d 3
- -2 d 9 -3 d 3 -1 d 1 -2 d 2 -3 d -4 Y -3 -3 d -5 -2 d -5 X -5 2 d -3 3 d s 1014
- 521 m -2 -1 d 2 -2 d 1 2 d -1 1 d cl s 1039 539 m 9 -21 d s 1057 539 m -9 -21 d
- -3 -6 d -3 -3 d -3 -1 d -2 X s 1076 549 m 12 -31 d s 1100 549 m -12 -31 d s
- 1126 545 m -3 3 d -4 1 d -6 X -4 -1 d -3 -3 d -3 Y 1 -3 d 2 -1 d 3 -2 d 8 -3 d
- 3 -1 d 2 -2 d 1 -3 d -4 Y -3 -3 d -4 -2 d -6 X -4 2 d -3 3 d s 1138 521 m -1 -1
- d 1 -2 d 2 2 d -2 1 d cl s 1165 539 m 16 -21 d s 1181 539 m -16 -21 d s 1202
- 549 m 12 -31 d s 1226 549 m -12 -31 d s 1252 545 m -3 3 d -4 1 d -6 X -4 -1 d
- -3 -3 d -3 Y 1 -3 d 2 -1 d 2 -2 d 9 -3 d 3 -1 d 2 -2 d 1 -3 d -4 Y -3 -3 d -4
- -2 d -6 X -4 2 d -3 3 d s 1264 521 m -1 -1 d 1 -2 d 2 2 d -2 1 d cl s 1309 535
- m -3 3 d -3 1 d -5 X -3 -1 d -3 -3 d -1 -5 d -3 Y 1 -4 d 3 -3 d 3 -2 d 5 X 3 2
- d 3 3 d s 0 0 0.8 c /w 2 def /w2 {w 2 div} def /w3 {w 3 div} def 1355 1480 0
- 0.14545 0.8 c 1023 1227 m20 0 0.29091 0.8 c 1086 1212 m20 0 0.43636 0.8 c 845
- 1068 939 1122 834 1067 917 1100 911 1096 986 1129 825 1061 7 { m20} R 0 0.58182
- 0.8 c 786 1042 835 1055 778 1038 912 1088 801 1045 891 1075 879 1071 778 1039
- 894 1078 871 1068 772 1037 861 1066 1178 1229 784 1040 1037 1148 766 1035 779
- 1039 787 1042 819 1051 877 1069 20 { m20} R 0 0.72727 0.8 c 729 1034 828 1054
- 963 1104 1121 1184 794 1045 859 1065 885 1074 813 1052 962 1103 892 1077 973
- 1107 907 1080 1019 1129 855 1064 1115 1181 889 1075 980 1110 782 1046 738 1032
- 772 1042 740 1033 1108 1180 898 1078 904 1082 1126 1190 761 1035 767 1038 798
- 1047 900 1080 775 1042 948 1097 910 1082 796 1045 1034 1137 944 1095 1129 1194
- 732 1036 770 1039 935 1093 887 1077 783 1042 764 1036 1068 1155 1005 1123 44 {
- m20} R 0 0.8 0.72727 c 1065 1153 770 1048 950 1109 1242 1260 802 1063 784 1050
- 770 1051 729 1053 1266 1275 947 1100 668 1053 1151 1202 677 1053 686 1049 981
- 1117 688 1044 1130 1189 1247 1264 995 1125 1239 1257 964 1105 920 1099 691 1053
- 918 1099 846 1078 794 1066 821 1063 1285 1289 1073 1157 976 1112 1062 1155 692
- 1050 1252 1267 1065 1152 883 1080 1016 1135 1150 1201 689 1040 784 1056 774
- 1064 729 1044 784 1055 811 1068 773 1058 744 1044 957 1107 741 1043 783 1067
- 942 1102 742 1054 776 1059 1013 1130 1211 1238 942 1100 814 1069 698 1039 1258
- 1270 952 1107 678 1055 895 1085 1163 1208 820 1067 930 1103 796 1054 803 1063
- 1130 1189 689 1042 1048 1144 752 1046 678 1046 797 1069 731 1041 969 1113 839
- 1072 878 1080 737 1052 693 1057 758 1046 1103 1172 1175 1216 877 1086 1101 1171
- 795 1053 847 1072 846 1074 860 1072 1097 1173 1100 1171 730 1056 690 1053 1065
- 1157 840 1063 1136 1193 735 1046 1201 1232 685 1042 816 1063 844 1066 740 1055
- 743 1055 100 { m20} R 848 1067 762 1050 870 1080 927 1094 4 { m20} R 0 0.8
- 0.58182 c 683 1075 1154 1208 1136 1199 722 1071 1014 1138 1009 1138 952 1113
- 801 1081 863 1084 1002 1144 1006 1141 915 1113 990 1139 1068 1163 650 1079 687
- 1088 901 1097 655 1060 998 1131 954 1119 796 1083 1032 1145 1009 1134 1058 1157
- 745 1064 865 1096 760 1078 1272 1284 798 1097 726 1072 855 1106 644 1080 974
- 1134 1023 1142 1221 1247 676 1083 657 1086 1056 1160 818 1098 669 1082 1014
- 1147 809 1087 982 1131 798 1081 771 1087 845 1100 1124 1189 726 1063 682 1063
- 774 1067 656 1087 1150 1203 718 1090 1391 1371 775 1078 1053 1158 1041 1156
- 1208 1245 997 1129 1013 1143 764 1081 685 1086 862 1107 991 1140 736 1062 830
- 1085 905 1111 1079 1175 768 1089 1316 1313 644 1076 660 1088 764 1082 683 1067
- 672 1089 694 1081 868 1099 836 1090 739 1062 661 1081 1148 1202 949 1128 766
- 1068 930 1119 1044 1151 892 1101 622 1083 848 1099 1256 1272 893 1093 874 1107
- 701 1068 866 1091 1190 1230 902 1106 890 1109 1016 1136 900 1096 1175 1225 720
- 1067 100 { m20} R 1277 1286 880 1100 629 1083 822 1090 836 1097 1281 1287 1282
- 1292 661 1079 939 1112 1757 1741 985 1123 954 1128 917 1114 904 1116 1199 1235
- 1471 1439 1056 1157 904 1098 958 1113 784 1074 1168 1218 694 1081 805 1073 1065
- 1164 643 1088 1160 1214 1024 1140 689 1061 926 1114 808 1077 1092 1177 753 1085
- 894 1104 643 1065 1140 1201 35 { m20} R 0 0.8 0.43636 c 1023 1162 813 1137 1169
- 1232 1141 1221 694 1119 1177 1247 846 1119 658 1130 688 1111 1178 1234 692 1105
- 854 1107 937 1153 660 1095 952 1136 711 1130 759 1098 611 1108 927 1126 1293
- 1314 653 1094 1099 1212 802 1110 614 1119 999 1174 811 1125 989 1154 979 1142
- 1168 1234 947 1132 830 1110 1454 1424 1304 1319 861 1110 1344 1337 642 1097
- 1111 1205 616 1115 873 1141 978 1157 933 1128 777 1119 897 1143 1113 1204 599
- 1134 1496 1461 1153 1219 704 1106 688 1129 726 1100 977 1152 693 1097 1058 1180
- 811 1127 773 1102 601 1104 633 1128 1053 1181 1087 1188 1159 1234 1431 1409 877
- 1141 982 1146 1100 1195 883 1142 1631 1592 1276 1299 638 1119 852 1126 646 1099
- 786 1110 1177 1240 1280 1295 689 1130 1082 1199 608 1137 840 1117 918 1126 739
- 1098 679 1128 951 1152 1059 1189 829 1137 1780 1757 1229 1274 1049 1176 815
- 1133 848 1128 637 1128 727 1107 1213 1253 1014 1178 729 1129 1182 1234 1458
- 1430 879 1126 1335 1332 1088 1202 781 1099 1255 1278 100 { m20} R 644 1126 662
- 1132 1011 1158 1118 1201 1164 1240 1021 1181 595 1131 957 1142 843 1138 978
- 1160 926 1127 1049 1191 1232 1270 1141 1217 954 1149 1003 1158 761 1127 875
- 1116 1015 1180 857 1139 751 1120 1041 1181 625 1126 972 1162 892 1127 1045 1186
- 1070 1181 896 1146 1256 1285 1470 1438 893 1142 692 1130 889 1144 853 1118 962
- 1137 1288 1306 968 1152 776 1110 723 1113 878 1129 659 1100 1654 1616 929 1150
- 1013 1158 1079 1181 1025 1165 1308 1311 616 1116 1132 1211 816 1132 827 1128
- 583 1130 1007 1172 1057 1172 774 1119 822 1133 1206 1247 653 1107 790 1117 1259
- 1280 1320 1320 969 1144 901 1142 979 1143 1269 1298 1030 1182 1230 1266 1011
- 1168 825 1123 907 1147 919 1135 705 1122 1022 1161 805 1105 835 1104 1113 1212
- 1044 1182 660 1102 974 1144 874 1135 913 1132 1019 1169 1041 1182 1119 1214 647
- 1112 1023 1183 1130 1208 778 1126 1047 1183 649 1133 911 1135 702 1120 707 1128
- 661 1096 912 1145 1015 1161 782 1118 1305 1318 1201 1260 1012 1158 100 { m20} R
- 1141 1219 914 1129 1400 1386 827 1106 913 1133 998 1171 769 1130 728 1101 690
- 1132 954 1143 803 1131 1042 1172 649 1092 13 { m20} R 0 0.8 0.29091 c 628 1192
- 1023 1218 561 1199 860 1175 990 1186 1434 1425 1152 1243 654 1149 714 1155 1118
- 1233 1313 1347 836 1146 740 1147 764 1176 538 1205 772 1141 1208 1293 876 1155
- 1250 1293 1247 1311 1011 1196 1365 1373 679 1163 812 1148 748 1136 840 1145 998
- 1180 755 1176 1233 1297 709 1135 1023 1185 1170 1258 838 1165 1240 1306 1096
- 1226 991 1176 1154 1263 1111 1227 950 1202 668 1184 779 1139 1009 1205 1167
- 1268 798 1161 688 1136 770 1145 832 1155 681 1170 610 1196 1110 1225 551 1179
- 715 1136 661 1180 1429 1423 935 1172 880 1166 1065 1220 780 1135 1154 1253 628
- 1149 1455 1442 706 1136 736 1143 622 1165 876 1157 1191 1273 1096 1233 552 1169
- 1052 1228 1285 1318 999 1207 1089 1213 991 1188 946 1169 827 1155 1055 1197 625
- 1167 1132 1249 791 1166 949 1195 876 1170 687 1141 668 1187 872 1178 737 1141
- 1032 1220 1174 1255 956 1180 1092 1231 1030 1209 1013 1196 918 1164 1309 1339
- 808 1154 1090 1235 1284 1310 687 1172 1424 1425 1279 1316 888 1180 100 { m20} R
- 1057 1205 530 1204 1101 1236 1349 1373 599 1142 1172 1265 826 1160 1348 1352
- 769 1135 1014 1206 997 1193 568 1198 1021 1192 579 1171 616 1178 821 1163 1299
- 1337 781 1154 932 1162 1102 1239 1534 1502 697 1144 1296 1327 722 1164 562 1183
- 1239 1292 1108 1220 785 1155 767 1179 1028 1195 1007 1193 934 1189 1238 1291
- 1281 1329 1089 1242 873 1168 1212 1284 856 1163 868 1190 1105 1228 1039 1204
- 1639 1603 1074 1238 765 1174 928 1159 596 1157 1044 1206 1125 1257 1086 1239
- 729 1155 730 1143 971 1199 741 1162 885 1189 1093 1238 620 1151 1469 1460 717
- 1162 986 1185 754 1144 1188 1256 698 1142 638 1190 1410 1409 746 1165 765 1141
- 957 1180 859 1189 763 1180 1364 1367 794 1164 776 1175 794 1167 692 1168 1039
- 1200 866 1175 923 1174 733 1161 1028 1186 747 1149 1466 1450 1003 1178 554 1187
- 1604 1575 1093 1213 1184 1258 732 1138 1079 1221 1098 1240 1060 1204 735 1136
- 842 1143 1409 1402 1058 1225 1556 1526 1392 1398 603 1150 920 1178 998 1192 598
- 1167 100 { m20} R 697 1160 1009 1195 1192 1278 686 1159 756 1148 671 1141 987
- 1186 697 1152 858 1160 1772 1747 757 1157 1149 1255 858 1170 617 1189 1376 1390
- 599 1191 1317 1345 826 1176 633 1142 951 1197 1662 1629 1399 1407 987 1177 1028
- 1212 1176 1274 1195 1276 1018 1205 832 1151 1332 1359 1303 1332 654 1172 736
- 1151 949 1164 1339 1359 646 1149 1783 1758 1464 1450 1320 1338 1096 1238 618
- 1171 666 1180 651 1136 1196 1284 1259 1300 883 1178 1147 1257 1084 1238 1087
- 1239 48 { m20} R 0 0.8 0.14545 c 792 1229 1480 1475 1197 1316 1588 1575 1203
- 1295 1215 1337 1158 1289 906 1211 1486 1488 888 1201 896 1198 1287 1363 1073
- 1275 625 1222 1300 1361 1213 1307 617 1230 871 1238 987 1245 1241 1327 1753
- 1733 1366 1396 1122 1288 758 1232 893 1205 1233 1345 1129 1285 1355 1388 915
- 1199 1120 1258 772 1201 630 1195 1104 1284 1069 1263 995 1260 1000 1229 1208
- 1309 998 1225 733 1204 907 1211 770 1210 681 1207 1007 1237 701 1199 1282 1338
- 611 1205 680 1198 699 1218 1186 1317 1093 1272 1089 1270 1367 1387 1490 1479
- 927 1229 623 1201 910 1221 939 1213 955 1210 632 1216 1269 1344 1204 1311 942
- 1210 859 1224 920 1248 794 1204 786 1212 781 1239 1035 1242 1108 1265 1309 1353
- 777 1206 1620 1602 998 1252 1127 1299 1125 1288 1440 1467 1241 1317 1312 1355
- 878 1196 1440 1441 1582 1566 1276 1341 1512 1499 1183 1308 1009 1223 805 1236
- 933 1230 1121 1276 917 1242 659 1239 1054 1276 1043 1239 780 1189 662 1206 947
- 1241 867 1221 1292 1361 913 1216 1318 1360 785 1197 100 { m20} R 1408 1416 995
- 1232 1099 1267 946 1243 1188 1285 1606 1588 1402 1427 1470 1476 1171 1314 883
- 1216 1428 1442 1547 1533 1001 1232 1014 1223 1675 1657 1081 1263 609 1234 1469
- 1466 743 1233 1110 1284 856 1234 801 1214 655 1205 860 1193 1296 1363 629 1207
- 1369 1398 1168 1285 1569 1566 938 1223 1194 1296 1195 1325 1193 1302 986 1238
- 989 1242 739 1191 854 1207 1363 1414 1058 1272 824 1230 618 1203 819 1201 1040
- 1266 1359 1398 868 1211 1439 1460 956 1236 724 1234 1283 1353 1256 1329 1397
- 1417 620 1252 1116 1282 1052 1264 1312 1382 858 1200 1223 1314 1406 1442 1050
- 1260 886 1221 880 1238 1138 1267 1279 1358 1042 1235 589 1253 1607 1581 1484
- 1474 1066 1252 1023 1245 1421 1441 913 1199 808 1230 1213 1304 1614 1600 623
- 1218 975 1253 1012 1233 982 1232 693 1247 683 1248 1030 1228 1054 1270 1510
- 1501 1149 1307 590 1259 887 1227 874 1193 1159 1281 967 1256 1666 1653 1090
- 1245 590 1215 759 1226 1413 1445 1246 1327 1023 1267 765 1237 1610 1594 1280
- 1365 566 1236 100 { m20} R 1192 1295 658 1241 1016 1264 1363 1385 1120 1282 717
- 1212 960 1219 907 1233 1587 1580 1381 1421 800 1224 871 1218 961 1209 895 1233
- 890 1229 862 1200 666 1247 850 1232 736 1212 512 1265 910 1214 1512 1502 1126
- 1261 1470 1470 1028 1238 1044 1240 1023 1226 1361 1401 822 1190 1247 1338 988
- 1261 1347 1396 1561 1543 1114 1286 511 1253 856 1239 604 1244 585 1207 1293
- 1353 1191 1316 1700 1674 1477 1468 785 1189 1291 1364 1116 1276 790 1220 1537
- 1530 718 1246 1271 1358 1048 1235 1423 1454 1384 1429 1135 1296 981 1233 1302
- 1352 997 1250 1230 1323 940 1221 1047 1275 1483 1486 700 1195 1126 1266 1408
- 1437 1071 1271 1349 1377 1171 1298 1312 1382 1319 1369 1071 1247 868 1227 861
- 1238 822 1211 1180 1308 1493 1494 667 1241 1176 1319 76 { m20} R 0 0.8
- 0.4069E-06 c 1193 1332 1324 1409 1418 1488 1424 1480 1491 1523 992 1288 949
- 1313 1539 1576 757 1314 1394 1441 954 1262 806 1255 1510 1551 1052 1286 1281
- 1373 1285 1417 1470 1511 1168 1324 805 1244 1099 1309 695 1258 1185 1369 1041
- 1330 1513 1534 1128 1327 1613 1610 1227 1368 638 1301 811 1298 1306 1394 1247
- 1382 886 1255 1093 1317 1407 1472 981 1273 1300 1393 1529 1559 1108 1326 1309
- 1409 1333 1406 1627 1635 1165 1328 1204 1365 1397 1455 596 1322 1361 1450 1470
- 1509 1135 1316 1074 1296 900 1253 1303 1403 1600 1610 1065 1332 597 1274 895
- 1303 938 1281 1474 1492 1180 1362 1465 1516 499 1362 1269 1371 1458 1495 812
- 1251 485 1336 1540 1557 793 1248 981 1321 1343 1440 675 1288 763 1261 1075 1301
- 766 1254 1270 1387 1447 1497 1231 1358 1057 1309 1217 1382 1238 1390 731 1270
- 1088 1293 901 1266 1158 1343 1403 1464 939 1298 915 1300 1158 1362 1065 1306
- 1364 1447 1375 1451 1361 1420 1475 1499 1191 1335 1148 1310 1200 1359 936 1298
- 1170 1369 1506 1537 736 1248 1711 1710 1241 1390 100 { m20} R 1109 1303 1185
- 1344 1024 1319 948 1272 833 1249 1150 1348 1463 1494 787 1295 926 1274 857 1300
- 1509 1525 819 1245 1067 1319 1318 1391 1494 1513 1685 1684 807 1265 1145 1316
- 1128 1339 1217 1363 913 1262 1250 1369 807 1271 1395 1473 1591 1587 1131 1323
- 1607 1618 1266 1379 1118 1336 977 1262 1124 1328 1388 1468 1250 1396 1067 1337
- 991 1286 1125 1340 1082 1288 1426 1495 1246 1373 998 1318 1145 1317 1366 1433
- 991 1321 1500 1528 1635 1653 832 1246 921 1262 1373 1437 762 1252 735 1286 831
- 1279 1459 1489 1298 1402 1672 1682 1427 1461 1013 1292 1184 1342 1581 1591 1234
- 1383 1173 1329 1294 1384 1398 1458 1045 1283 1069 1284 1146 1330 955 1276 901
- 1289 1027 1297 1598 1610 785 1261 1544 1550 964 1276 1530 1569 876 1291 952
- 1313 1547 1558 1485 1526 1323 1408 1501 1549 1584 1590 1099 1319 905 1284 1238
- 1381 692 1305 1454 1505 1186 1355 965 1308 738 1259 1443 1479 684 1274 1427
- 1491 1506 1529 812 1311 974 1284 1258 1380 1250 1397 897 1255 1483 1515 1182
- 1330 1392 1459 100 { m20} R 881 1253 1221 1361 1100 1316 1095 1331 1206 1355
- 831 1288 1344 1415 1061 1327 1422 1459 1318 1418 1476 1531 1567 1594 1566 1587
- 1304 1413 719 1300 1196 1346 737 1306 1119 1339 1078 1327 1283 1411 877 1270
- 815 1285 838 1248 1242 1374 1452 1504 1254 1365 1282 1406 914 1263 1036 1278
- 1240 1374 982 1278 475 1338 960 1283 1203 1373 1428 1485 1017 1282 977 1287
- 1429 1486 1386 1463 1289 1418 879 1253 1363 1421 706 1266 835 1270 1218 1381
- 989 1268 1029 1299 837 1293 876 1284 1284 1392 1587 1586 1285 1413 52 { m20} R
- 0.14545 0.8 0 c 997 1369 1661 1681 1209 1394 1401 1518 1248 1411 1111 1393 1550
- 1609 755 1326 933 1362 1030 1366 1105 1395 1078 1346 1130 1374 769 1353 1438
- 1522 1388 1480 1672 1699 1309 1433 1360 1473 1103 1390 1193 1384 960 1325 870
- 1326 1124 1373 981 1350 1422 1518 1630 1676 1384 1522 838 1337 876 1327 1266
- 1457 1529 1610 1467 1526 1042 1378 596 1393 638 1341 860 1346 1413 1493 1469
- 1540 1585 1630 1062 1353 685 1343 1398 1519 1059 1384 1412 1498 1301 1430 1150
- 1369 1682 1706 1661 1701 1099 1400 1294 1442 1328 1470 1316 1442 1237 1448 1353
- 1491 1402 1498 1440 1522 996 1332 1643 1684 1130 1366 1016 1347 1528 1573 1153
- 1374 1270 1433 1234 1443 1489 1567 1636 1676 1091 1368 1583 1628 1399 1510 1325
- 1472 1056 1386 1621 1666 1472 1564 1155 1404 1207 1410 887 1329 1312 1469 1532
- 1585 1242 1402 1275 1446 1439 1518 1300 1477 1372 1479 1213 1391 981 1329 1311
- 1445 1247 1458 1574 1631 805 1326 1375 1488 1341 1466 1423 1531 1167 1388 1569
- 1642 1001 1331 1633 1688 1259 1439 1184 1397 928 1321 100 { m20} R 1489 1561
- 1443 1529 1069 1389 1106 1365 1613 1668 1002 1348 1270 1440 1530 1592 1231 1406
- 1110 1354 748 1374 1329 1459 1321 1443 1175 1383 1257 1436 1534 1587 777 1358
- 1055 1362 1620 1663 865 1312 1574 1630 903 1349 1057 1346 1167 1429 1274 1451
- 823 1320 1319 1484 1335 1491 1017 1375 1337 1454 1230 1443 1251 1425 1284 1473
- 1562 1625 1353 1502 1655 1679 1357 1478 1433 1510 1607 1636 1125 1387 1166 1401
- 1554 1600 1656 1690 863 1382 878 1348 1580 1617 858 1311 1479 1563 1243 1411
- 1305 1434 1616 1661 1096 1363 939 1329 802 1385 1459 1558 1025 1358 1294 1425
- 1399 1492 1522 1589 908 1380 840 1323 1634 1679 1270 1451 1247 1422 1087 1402
- 1053 1345 1669 1687 810 1348 927 1317 1112 1370 884 1340 1128 1382 961 1372 918
- 1346 1148 1401 1544 1617 1255 1423 1488 1579 1344 1493 1384 1510 1576 1609 1362
- 1484 989 1328 1648 1707 968 1336 1222 1401 1499 1569 1669 1702 1155 1382 1633
- 1684 1298 1460 1434 1508 1371 1467 1467 1531 1318 1487 1160 1416 1411 1513 1118
- 1374 1624 1677 1347 1491 100 { m20} R 1339 1473 1105 1367 1130 1375 1307 1484
- 1200 1434 1371 1471 1089 1375 1265 1431 1275 1437 1324 1490 1245 1434 1214 1395
- 1244 1400 1328 1470 1364 1466 1652 1682 1569 1617 1242 1407 954 1328 631 1381
- 725 1335 1129 1370 1311 1446 1326 1439 1263 1438 1479 1554 1268 1432 1247 1420
- 1175 1410 1244 1416 1315 1458 1067 1338 1468 1544 848 1317 1632 1668 888 1350
- 1512 1566 1469 1538 1367 1478 1307 1457 1037 1393 1427 1516 1436 1532 444 1401
- 44 { m20} R 0.29091 0.8 0 c 1501 1608 1379 1552 1603 1708 1297 1504 1592 1676
- 960 1440 1464 1571 1585 1681 1423 1590 754 1400 1577 1658 1144 1467 1546 1646
- 453 1506 1350 1565 1614 1700 1364 1559 1519 1660 853 1456 1546 1673 1048 1413
- 1221 1501 1463 1619 1505 1635 1229 1497 1381 1538 856 1434 1562 1656 1435 1603
- 1565 1693 979 1397 1417 1597 1024 1452 1292 1494 1326 1545 1485 1613 1187 1481
- 1538 1634 1193 1478 1174 1438 1525 1618 1307 1508 1275 1517 1306 1532 1022 1469
- 970 1447 930 1432 1146 1467 1269 1478 1158 1499 807 1433 935 1424 1451 1575
- 1504 1616 1144 1429 1608 1725 1519 1617 1314 1533 1535 1654 1513 1636 1096 1424
- 1005 1414 1026 1403 1156 1472 1221 1499 1177 1469 1384 1529 1591 1664 911 1443
- 659 1491 1045 1458 1130 1435 1508 1625 1270 1494 1236 1502 946 1407 1525 1651
- 1537 1645 1509 1631 1516 1610 1394 1574 1092 1471 1443 1589 1385 1555 1049 1402
- 1590 1694 1508 1620 1492 1643 1188 1488 1403 1560 1339 1518 887 1470 903 1459
- 1057 1411 1212 1476 1441 1613 1467 1616 966 1420 1263 1520 844 1401 100 { m20
-} R 1186 1477 1252 1520 1458 1571 1349 1533 1375 1523 1297 1502 1280 1527 913
- 1450 1460 1590 1376 1532 1049 1464 1590 1663 1329 1540 1098 1445 1629 1703 1231
- 1520 1522 1630 1184 1461 706 1447 1625 1713 1586 1693 1261 1484 705 1466 1357
- 1518 1574 1677 1232 1467 1538 1672 1169 1461 1016 1420 782 1420 1012 1406 1459
- 1572 938 1463 1590 1710 899 1422 1208 1472 1506 1619 832 1412 1173 1476 862
- 1447 1637 1701 535 1465 1524 1659 1123 1418 1539 1650 1371 1538 1391 1574 1100
- 1429 1183 1491 1144 1474 1277 1476 758 1455 1360 1527 1512 1639 954 1418 1051
- 1432 1551 1640 1649 1713 1287 1513 1481 1600 859 1451 1131 1421 1475 1615 1386
- 1559 1511 1653 983 1435 1105 1437 987 1434 857 1401 1565 1644 1416 1555 1262
- 1503 1458 1600 1550 1646 1439 1582 1164 1499 1247 1479 1406 1580 1304 1522 1300
- 1534 1466 1606 1421 1589 1537 1628 1245 1523 1224 1479 1439 1607 995 1395 946
- 1422 1527 1634 882 1425 1430 1577 1559 1651 1359 1553 1593 1700 1551 1660 1220
- 1485 1505 1615 97 { m20} R 0.43636 0.8 0 c 1423 1655 1095 1523 1483 1696 822
- 1507 1526 1695 1537 1684 1448 1651 889 1486 1195 1566 1352 1598 1558 1730 1396
- 1612 1577 1744 620 1609 1508 1682 1370 1605 1347 1626 1344 1607 1514 1694 1563
- 1706 1044 1530 1358 1637 1310 1580 1308 1556 1461 1675 1169 1521 1498 1686 1093
- 1569 1256 1536 988 1477 1532 1678 1204 1531 1139 1529 1258 1606 1280 1581 1570
- 1715 1332 1581 1484 1670 1301 1598 1500 1713 1493 1673 1306 1610 1173 1531 1255
- 1572 1506 1680 1563 1726 910 1479 1261 1598 1495 1704 1313 1589 1060 1535 1435
- 1644 1152 1571 1570 1754 1582 1720 1318 1574 1265 1554 1460 1683 1191 1521 1354
- 1601 993 1523 1476 1647 1248 1552 1118 1559 1539 1730 1413 1662 814 1516 1326
- 1582 1455 1660 1360 1630 1465 1675 1501 1700 580 1567 1468 1639 1371 1630 1364
- 1643 907 1488 1443 1657 969 1474 938 1489 1503 1677 1189 1510 1478 1678 1118
- 1523 1414 1608 1374 1589 1301 1552 1188 1511 1182 1515 1525 1691 1352 1574 1531
- 1693 1513 1672 1349 1569 1347 1568 1511 1711 1517 1724 1122 1532 1564 1723 1412
- 1630 100 { m20} R 1154 1506 1364 1602 1121 1502 1341 1572 1333 1587 1581 1706
- 1529 1681 1304 1566 1534 1681 1032 1489 847 1526 1306 1609 1440 1664 1450 1657
- 1515 1707 1475 1694 1282 1573 1240 1585 1551 1695 1381 1650 1139 1570 1016 1527
- 1149 1505 1541 1733 1388 1604 1300 1596 1486 1695 1411 1610 1326 1620 1318 1600
- 1115 1495 1136 1515 1038 1545 1163 1572 938 1533 1319 1572 1327 1559 1095 1545
- 1495 1700 1257 1570 1343 1598 1377 1610 1247 1593 1482 1674 1021 1514 1474 1635
- 1327 1571 1418 1661 1189 1588 1473 1686 1355 1572 1485 1671 1068 1525 53 { m20
-} R 0.58182 0.8 0 c 1521 1781 1474 1737 1392 1722 1394 1723 1550 1751 1299 1701
- 1522 1795 1401 1697 1389 1734 1480 1721 898 1664 1544 1774 1259 1686 1402 1674
- 1450 1743 1519 1732 1263 1637 1352 1697 1439 1755 1413 1748 1329 1638 1447 1759
- 1493 1751 1214 1672 1243 1644 1378 1694 1395 1696 1255 1673 1454 1728 1342 1655
- 1543 1776 1472 1774 1273 1629 1455 1770 1430 1679 1413 1672 1176 1664 1546 1759
- 1047 1634 1342 1711 1314 1652 1310 1654 1167 1591 1479 1781 1149 1658 1494 1729
- 1293 1671 1293 1698 1243 1618 1375 1672 1417 1720 1448 1763 1305 1661 1458 1723
- 1504 1786 1504 1723 933 1635 1377 1684 1294 1624 1109 1586 1522 1757 1493 1771
- 998 1635 1254 1654 1362 1705 1510 1758 1517 1790 1548 1763 1369 1674 1496 1724
- 1283 1644 1375 1713 1477 1707 1463 1698 1413 1701 1445 1735 1327 1670 1498 1755
- 1052 1605 1557 1757 1385 1690 1187 1608 82 { m20} R 0.72727 0.8 0 c 1271 1709
- 1395 1787 1331 1742 1213 1760 1045 1684 1245 1755 1420 1836 1170 1737 1493 1812
- 1199 1700 1309 1765 1388 1755 1438 1822 977 1755 1455 1806 1377 1748 1450 1825
- 1466 1791 1428 1779 1488 1808 1398 1761 1107 1707 1221 1775 1349 1726 1381 1789
- 1308 1757 1428 1812 1424 1804 1309 1751 1398 1784 1491 1816 1324 1806 1304 1757
- 1406 1824 1495 1815 1277 1724 1402 1816 1481 1849 1505 1825 1380 1815 1432 1817
- 1105 1727 1276 1741 1368 1816 1176 1694 1166 1760 1510 1812 47 { m20} R 0.8
- 0.72727 0 c 1444 1909 1426 1931 1303 1833 1429 1933 1356 1829 1161 1805 1385
- 1859 1385 1864 1386 1848 1428 1896 1203 1857 1346 1841 1329 1879 1416 1880 1111
- 1867 1236 1813 1317 1818 1192 1838 1253 1802 1422 1912 20 { m20} R 0.8 0.58182
- 0 c 1315 1943 1217 1942 1293 2023 1331 1927 4 { m20} R 0.8 0.43636 0 c 1315
- 1943 0.8 0.29091 0 c 1315 1943 0.8 0.14546 0 c 1315 1943 0 0 0.8 c 1315 1943 0
- 0.14545 0.8 c 1315 1943 0 0.29091 0.8 c 1315 1943 0 0.43636 0.8 c 851 1072 846
- 1064 1033 1158 819 1054 864 1077 928 1098 995 1133 901 1090 967 1125 9 { m20} R
- 0 0.58182 0.8 c 828 1053 827 1055 960 1103 990 1119 923 1088 751 1032 772 1037
- 931 1091 923 1087 934 1094 781 1040 838 1056 802 1045 13 { m20} R 0 0.72727 0.8
- c 907 1080 964 1104 758 1041 1249 1267 757 1041 943 1095 874 1070 752 1038 765
- 1038 775 1045 940 1094 797 1046 751 1033 1068 1155 762 1041 771 1039 849 1062
- 758 1040 1106 1179 934 1093 811 1055 928 1090 885 1073 1000 1120 851 1060 860
- 1066 757 1042 808 1052 727 1037 839 1057 791 1047 899 1077 762 1035 867 1070
- 860 1064 869 1067 738 1034 1248 1272 1121 1187 884 1072 781 1046 921 1086 773
- 1042 838 1058 835 1057 1083 1163 1158 1207 900 1078 879 1072 49 { m20} R 0 0.8
- 0.72727 c 686 1045 861 1077 870 1084 1130 1190 760 1045 800 1055 983 1121 905
- 1083 944 1100 891 1081 854 1067 757 1061 826 1067 909 1086 1043 1146 1111 1177
- 1009 1129 1213 1240 755 1057 775 1050 1120 1182 711 1047 800 1057 760 1056 804
- 1057 1036 1138 720 1052 784 1055 1143 1196 713 1055 894 1086 747 1053 920 1095
- 668 1054 918 1087 787 1058 1014 1128 1010 1126 1023 1131 752 1044 1099 1171 904
- 1090 944 1108 839 1067 704 1048 1005 1129 684 1041 971 1111 763 1049 802 1066
- 702 1036 712 1047 712 1057 840 1077 987 1121 849 1077 757 1049 868 1077 682
- 1055 1069 1157 883 1088 961 1108 675 1049 879 1076 870 1076 1032 1137 835 1077
- 1187 1223 851 1078 789 1063 865 1084 929 1095 687 1054 1189 1224 952 1106 896
- 1091 1168 1211 775 1056 671 1054 969 1107 709 1040 1031 1137 715 1040 753 1045
- 677 1053 890 1090 1005 1123 740 1044 816 1072 747 1062 785 1065 895 1091 960
- 1105 851 1074 845 1071 737 1055 96 { m20} R 0 0.8 0.58182 c 919 1109 831 1097
- 1310 1310 1274 1283 957 1132 735 1066 860 1107 771 1083 965 1122 1041 1153 976
- 1138 882 1104 765 1085 857 1102 725 1062 707 1064 1067 1159 883 1102 981 1136
- 853 1092 1028 1153 835 1081 793 1078 709 1073 980 1124 969 1131 750 1064 897
- 1106 692 1068 738 1070 905 1114 675 1075 1152 1205 955 1129 1266 1280 617 1088
- 807 1078 779 1069 805 1072 748 1076 648 1066 1054 1163 788 1081 1064 1164 791
- 1075 737 1069 1228 1251 1097 1175 846 1082 822 1083 1197 1233 836 1084 868 1091
- 680 1082 903 1112 702 1076 973 1123 620 1085 669 1063 713 1073 1069 1169 731
- 1061 923 1116 945 1122 991 1128 914 1109 884 1099 939 1124 851 1087 1105 1183
- 834 1097 1229 1252 1274 1283 1283 1292 745 1087 1197 1232 725 1081 725 1070 696
- 1089 946 1123 781 1069 1152 1211 1071 1169 695 1064 761 1064 732 1066 1084 1180
- 1174 1216 618 1086 733 1079 821 1077 937 1121 719 1062 744 1066 1024 1147 673
- 1085 677 1076 1129 1200 837 1083 867 1096 100 { m20} R 917 1110 908 1102 1424
- 1398 742 1085 897 1098 1033 1157 618 1090 1217 1249 867 1109 770 1087 689 1068
- 838 1086 645 1082 841 1102 822 1079 840 1086 682 1068 658 1061 924 1116 616
- 1090 646 1077 783 1083 947 1129 658 1077 795 1081 1348 1337 741 1062 792 1081
- 652 1066 995 1145 851 1085 682 1061 1058 1169 911 1107 957 1126 811 1084 679
- 1081 1112 1191 689 1088 745 1077 849 1087 743 1063 699 1069 889 1111 1149 1205
- 655 1062 699 1086 929 1114 734 1086 1002 1144 749 1070 1323 1317 790 1091 1075
- 1174 694 1071 55 { m20} R 0 0.8 0.43636 c 1158 1235 834 1109 839 1119 931 1146
- 778 1125 882 1141 896 1121 848 1125 808 1108 1347 1339 1212 1261 681 1112 890
- 1137 834 1130 649 1111 1215 1251 701 1116 753 1120 712 1097 872 1138 742 1095
- 884 1117 812 1127 827 1130 736 1112 986 1153 850 1141 833 1139 672 1107 909
- 1129 732 1113 756 1114 665 1094 898 1117 863 1135 632 1092 609 1130 639 1110
- 923 1141 746 1109 610 1118 746 1111 1500 1469 1063 1195 870 1135 1347 1344 1198
- 1244 947 1141 1151 1228 855 1132 941 1156 964 1151 1027 1160 1177 1244 1222
- 1259 584 1125 762 1108 1111 1198 626 1111 589 1126 843 1117 738 1127 1385 1378
- 869 1124 733 1116 1028 1183 1026 1167 700 1123 1224 1256 680 1127 1081 1192
- 1177 1237 1278 1296 1277 1299 783 1115 956 1153 965 1138 704 1099 703 1097 1502
- 1466 1056 1192 617 1113 1119 1207 922 1143 1216 1262 1301 1317 891 1139 801
- 1100 781 1116 859 1125 698 1093 759 1095 801 1127 665 1092 1031 1163 1067 1199
- 919 1154 893 1138 882 1116 660 1127 100 { m20} R 749 1114 636 1106 663 1129
- 1154 1237 836 1113 667 1116 792 1129 805 1119 740 1096 1211 1267 834 1131 895
- 1130 618 1124 909 1135 747 1099 1202 1251 881 1140 663 1129 733 1126 922 1142
- 773 1118 951 1147 877 1133 900 1123 990 1157 1221 1261 590 1117 729 1119 1249
- 1285 806 1120 908 1140 972 1150 1184 1247 732 1131 720 1108 1062 1197 865 1127
- 1005 1174 644 1106 747 1101 785 1100 1202 1256 910 1146 1163 1229 1209 1256
- 1044 1177 688 1103 892 1135 790 1126 807 1122 856 1124 1126 1217 990 1157 1288
- 1310 879 1140 1155 1220 845 1134 1013 1167 1252 1278 806 1117 1368 1357 974
- 1143 1034 1176 1350 1345 758 1127 766 1129 774 1119 1239 1282 1354 1350 609
- 1109 979 1149 737 1123 702 1091 906 1126 591 1125 726 1115 957 1164 713 1102
- 1025 1184 1613 1573 776 1103 957 1138 1043 1166 636 1106 1095 1192 1146 1231
- 830 1104 983 1149 88 { m20} R 0 0.8 0.29091 c 956 1183 755 1182 1054 1212 1004
- 1194 1064 1201 684 1164 1358 1369 750 1144 628 1179 1129 1236 1175 1276 1606
- 1573 591 1179 765 1157 689 1166 952 1167 1044 1197 1067 1228 1064 1210 598 1164
- 678 1160 1544 1511 950 1195 766 1152 1121 1224 1184 1255 703 1146 746 1154 1238
- 1291 1218 1292 962 1195 731 1163 758 1138 1124 1233 1165 1249 948 1182 655 1189
- 1142 1248 588 1151 776 1140 640 1161 835 1155 1065 1224 1160 1243 621 1140 1188
- 1278 1101 1223 883 1184 775 1137 1108 1247 1516 1496 1383 1384 874 1179 1200
- 1288 1496 1473 1253 1317 782 1161 1040 1212 1101 1240 1122 1227 1185 1268 886
- 1150 965 1174 1223 1296 564 1195 996 1188 675 1139 987 1187 1265 1315 818 1148
- 1254 1294 1061 1217 840 1168 673 1167 772 1146 1130 1251 1071 1214 1443 1426
- 1237 1301 822 1164 955 1189 928 1158 917 1188 609 1187 1722 1692 1316 1354 1104
- 1223 669 1184 960 1173 893 1166 1034 1191 985 1175 773 1137 1185 1271 1139 1251
- 1189 1282 961 1181 1306 1327 1214 1276 792 1157 100 { m20} R 1216 1285 1009
- 1213 1482 1458 1094 1237 1345 1371 1346 1355 1361 1380 1110 1226 1273 1324 1572
- 1537 821 1163 840 1172 1115 1248 1029 1222 994 1189 872 1186 800 1152 1127 1239
- 995 1213 792 1170 980 1209 618 1145 694 1165 700 1172 1296 1341 951 1164 639
- 1172 815 1167 922 1186 1506 1483 658 1167 1102 1231 758 1172 1181 1266 1188
- 1263 1333 1345 692 1169 801 1178 1366 1378 1222 1296 752 1174 1415 1404 699
- 1148 900 1160 617 1157 865 1157 798 1138 744 1183 1709 1675 790 1147 977 1183
- 723 1178 976 1204 1191 1260 585 1167 605 1196 788 1159 1007 1192 854 1180 909
- 1168 766 1159 854 1146 882 1162 743 1175 1002 1216 1177 1261 1021 1221 811 1178
- 866 1189 1138 1236 692 1161 891 1170 687 1142 1107 1240 1117 1223 786 1172 803
- 1151 710 1147 1540 1510 748 1138 863 1185 845 1146 925 1174 1589 1552 834 1186
- 866 1154 967 1190 1223 1293 1343 1349 1097 1221 1460 1444 991 1189 1381 1388
- 985 1175 933 1200 961 1177 794 1140 637 1176 902 1191 1548 1514 100 { m20} R
- 798 1161 652 1184 882 1154 1778 1754 769 1159 1202 1270 726 1142 784 1164 1304
- 1336 882 1173 1230 1277 939 1167 773 1181 766 1161 810 1166 1054 1213 1434 1434
- 1072 1223 620 1180 1140 1243 869 1173 843 1170 1406 1398 1770 1744 911 1154 988
- 1194 1361 1377 1016 1195 931 1162 834 1161 544 1188 1075 1237 913 1157 987 1188
- 1294 1318 913 1163 925 1166 1123 1240 1100 1236 915 1181 768 1138 1387 1384 618
- 1141 43 { m20} R 0 0.8 0.14545 c 1181 1291 1071 1260 1063 1265 666 1250 574
- 1229 1282 1361 1010 1221 769 1243 1280 1334 1263 1345 1415 1437 969 1215 897
- 1237 817 1193 1022 1263 864 1228 1559 1555 745 1184 1157 1280 1181 1320 849
- 1201 941 1236 777 1185 1188 1316 653 1200 864 1201 1062 1250 1437 1440 1176
- 1314 1381 1425 1263 1325 992 1233 1146 1268 673 1212 1186 1289 1367 1388 796
- 1234 1196 1303 1030 1262 1016 1240 948 1205 841 1227 1016 1244 1613 1599 1628
- 1613 1040 1235 826 1202 848 1218 977 1218 634 1235 1560 1539 950 1238 1198 1308
- 1499 1499 937 1207 885 1245 839 1202 813 1193 905 1223 633 1240 576 1211 1254
- 1333 681 1215 1564 1553 1073 1250 989 1239 969 1208 1227 1340 1189 1290 673
- 1209 1160 1281 931 1206 1318 1388 702 1243 1286 1341 656 1229 1381 1423 1096
- 1249 985 1250 1352 1381 1135 1297 1311 1380 900 1221 1533 1516 1275 1345 884
- 1230 1380 1402 991 1225 679 1223 979 1226 782 1229 1594 1583 1430 1432 1052
- 1251 1578 1562 900 1202 760 1217 909 1208 1057 1265 977 1235 100 { m20} R 1561
- 1554 1008 1245 1126 1300 556 1253 1063 1234 1269 1336 979 1225 1486 1485 1091
- 1252 730 1224 994 1216 1179 1305 777 1203 833 1188 880 1197 1484 1489 737 1195
- 1101 1270 805 1186 1158 1286 1054 1234 792 1213 1055 1257 812 1237 1120 1297
- 759 1201 1587 1567 1342 1380 1076 1243 1252 1335 940 1239 609 1205 1210 1313
- 1343 1399 1017 1246 1244 1341 1243 1341 734 1223 1379 1424 1114 1271 1670 1645
- 745 1206 1427 1444 1498 1500 797 1200 922 1204 1470 1478 1447 1450 1126 1261
- 1330 1384 932 1203 1013 1247 1001 1255 787 1232 1403 1425 587 1221 883 1206
- 1151 1270 1501 1505 1222 1328 888 1193 1211 1330 1194 1325 1056 1241 1163 1313
- 923 1205 962 1225 1466 1463 747 1239 994 1230 1570 1564 1258 1357 1236 1312
- 1315 1380 1339 1378 1117 1285 1096 1260 984 1260 747 1216 530 1231 606 1230
- 1128 1289 1294 1373 1059 1270 727 1239 601 1198 1450 1450 903 1226 1182 1314
- 1481 1490 949 1239 596 1202 1283 1338 760 1215 1046 1271 1457 1477 1569 1551
- 1278 1348 1332 1383 1645 1624 100 { m20} R 1429 1451 776 1233 1009 1245 847
- 1191 884 1214 1215 1325 1020 1232 664 1207 1327 1379 1564 1549 1171 1317 1537
- 1524 807 1192 815 1211 1323 1365 974 1225 1164 1314 967 1215 996 1257 793 1191
- 840 1227 684 1212 1006 1228 842 1217 734 1217 1151 1294 804 1231 1372 1396 862
- 1209 1226 1318 981 1248 605 1214 1204 1294 1141 1280 1192 1325 844 1190 1472
- 1483 1182 1316 1073 1247 1081 1243 1544 1529 1279 1361 950 1204 1059 1266 823
- 1193 1073 1270 1396 1431 578 1263 884 1243 912 1218 1132 1302 1276 1362 774
- 1232 969 1256 900 1204 902 1199 958 1213 1088 1273 1256 1336 1128 1276 972 1244
- 1692 1668 1264 1329 1326 1385 827 1232 1026 1238 66 { m20} R 0 0.8 0.4069E-06 c
- 946 1260 1459 1499 1558 1586 995 1280 1646 1652 872 1277 1273 1387 1298 1392
- 1514 1548 994 1297 955 1261 735 1249 1416 1463 1037 1324 939 1261 1068 1304
- 1274 1401 1016 1281 992 1289 1102 1319 592 1328 1666 1677 767 1280 1680 1694
- 1264 1381 1127 1315 1189 1345 1214 1354 869 1267 656 1259 599 1309 1572 1587
- 1259 1399 1067 1298 670 1281 1321 1398 617 1286 1059 1305 1356 1412 716 1300
- 1411 1453 1701 1710 1355 1448 1585 1600 1189 1336 1566 1589 1483 1528 1641 1635
- 1449 1474 1306 1403 1316 1402 1102 1319 923 1302 1585 1605 1544 1557 1045 1278
- 1383 1460 1299 1407 982 1276 1046 1306 869 1271 515 1360 1269 1391 870 1275 968
- 1313 1542 1562 1332 1417 1691 1681 872 1275 1005 1275 1524 1562 652 1280 1277
- 1405 1046 1308 1457 1484 580 1322 1300 1384 1172 1336 1397 1461 1307 1411 1016
- 1314 1185 1370 685 1297 1082 1320 1212 1350 772 1265 1065 1328 708 1256 814
- 1256 982 1316 1186 1371 1022 1302 926 1287 956 1263 949 1273 1486 1530 1213
- 1347 1013 1275 1341 1426 1645 1642 100 { m20} R 1060 1286 1155 1325 1008 1309
- 927 1255 1102 1344 777 1284 903 1304 1562 1592 1342 1445 1021 1311 1673 1682
- 1576 1592 1006 1291 813 1297 1454 1483 1167 1331 1338 1424 1047 1313 1220 1356
- 658 1266 1256 1369 1526 1557 728 1298 1259 1402 889 1297 1113 1336 929 1282 866
- 1269 971 1273 742 1316 1218 1346 1402 1443 686 1313 924 1281 1386 1431 1625
- 1640 739 1261 993 1308 1226 1379 863 1280 1587 1601 789 1275 942 1263 1442 1499
- 1223 1348 659 1283 1299 1409 1626 1642 1285 1401 1270 1376 918 1288 1399 1452
- 1034 1296 1184 1364 1504 1522 940 1255 1348 1412 1674 1669 1050 1327 1564 1573
- 1027 1305 1106 1306 771 1267 1622 1641 1446 1500 1259 1396 1247 1376 1123 1322
- 1364 1421 862 1262 1140 1334 771 1313 1168 1338 1433 1497 1099 1327 1376 1450
- 1260 1389 912 1265 737 1301 1075 1317 1002 1312 626 1269 572 1332 902 1301 570
- 1332 1482 1530 1322 1432 1221 1376 1526 1545 913 1267 1307 1399 1096 1292 868
- 1263 673 1285 858 1287 1021 1273 1125 1310 799 1262 1360 1438 1202 1375 100 {
- m20} R 938 1256 1476 1515 985 1281 1300 1424 1038 1305 1475 1522 850 1268 599
- 1341 862 1289 1404 1448 652 1299 1353 1437 1166 1350 667 1268 1079 1323 1503
- 1539 1203 1348 1037 1330 499 1296 1249 1383 1261 1364 1034 1317 1216 1365 1466
- 1508 1240 1386 1385 1436 976 1274 1358 1451 680 1295 871 1309 975 1263 1379
- 1431 1680 1683 1235 1350 1402 1474 719 1298 1094 1342 939 1297 1712 1715 1341
- 1422 1094 1291 1548 1573 1376 1446 1250 1389 772 1304 1067 1332 1453 1513 1448
- 1487 1124 1304 1210 1338 963 1305 959 1283 1189 1347 1403 1447 1180 1358 1590
- 1603 1519 1530 1146 1332 1287 1383 724 1312 1141 1329 1651 1666 1265 1386 1036
- 1304 1477 1529 781 1273 799 1252 67 { m20} R 0.14545 0.8 0 c 1584 1625 1314
- 1453 1361 1482 1332 1490 1139 1360 1162 1413 1306 1438 1427 1544 1259 1425 987
- 1378 1166 1421 1657 1689 1065 1377 1039 1347 1511 1558 1420 1502 1261 1432 1148
- 1416 1570 1612 1626 1661 1421 1534 1226 1391 1537 1605 1106 1364 1374 1505 1335
- 1451 673 1343 526 1389 1309 1430 1269 1415 1695 1711 567 1367 1410 1517 1401
- 1491 1219 1400 1511 1573 901 1347 837 1317 1238 1449 1544 1603 1132 1392 1150
- 1390 1526 1604 1499 1570 1434 1543 1240 1443 791 1333 1143 1401 1579 1644 757
- 1337 1402 1521 994 1391 1380 1501 1328 1467 1420 1515 1239 1413 800 1329 1401
- 1489 990 1389 1213 1425 1266 1436 1340 1463 1438 1528 1352 1467 1622 1675 1381
- 1510 1390 1480 1562 1634 1531 1583 881 1355 1172 1396 1360 1486 1087 1360 975
- 1355 1042 1366 1131 1407 1450 1534 1214 1407 1455 1564 1327 1492 1379 1473 973
- 1390 961 1322 1406 1507 1327 1465 708 1371 879 1318 1219 1403 1263 1412 1582
- 1639 1119 1415 1114 1386 1319 1443 1681 1704 1515 1593 1564 1600 1088 1361 1091
- 1400 491 1471 1291 1464 100 { m20} R 1552 1610 1367 1463 1631 1682 871 1330 850
- 1319 1031 1331 867 1373 1451 1557 1358 1466 899 1358 1159 1386 915 1333 1541
- 1611 1513 1586 1600 1642 854 1324 1145 1374 849 1379 1537 1577 1426 1545 1280
- 1423 1118 1411 1502 1595 910 1377 1459 1556 1481 1572 1380 1514 1467 1555 1399
- 1488 1303 1447 1336 1464 1266 1460 1375 1477 1177 1429 1075 1344 1614 1675 1560
- 1629 1566 1611 1190 1413 1438 1532 1244 1438 1428 1531 1097 1407 1531 1586 1346
- 1450 1199 1424 1307 1447 1346 1468 1176 1392 1302 1433 1150 1402 947 1348 1010
- 1379 1595 1627 1229 1417 1266 1448 1498 1578 1302 1439 915 1327 1657 1686 1111
- 1387 1099 1350 1203 1438 580 1411 1089 1353 858 1351 679 1357 1156 1365 1013
- 1338 1111 1359 1329 1442 1232 1436 817 1348 720 1342 1320 1450 1616 1654 1508
- 1577 1036 1333 1011 1333 1225 1431 829 1359 1194 1412 1507 1586 1188 1392 929
- 1345 1623 1648 1319 1460 1070 1361 1398 1521 1281 1419 1617 1677 1371 1505 1402
- 1508 1182 1388 1303 1459 1565 1601 1251 1403 1044 1398 1287 1464 1054 1369 100
- { m20} R 1307 1473 1361 1498 1549 1612 1400 1493 792 1349 1457 1531 1335 1446
- 920 1351 1194 1383 1103 1361 834 1366 1602 1638 1056 1347 1639 1661 1281 1419
- 1451 1544 1324 1464 1299 1437 1416 1540 1570 1637 1125 1361 1137 1396 977 1382
- 1418 1537 1415 1517 908 1319 833 1333 1024 1354 1313 1485 1440 1534 1082 1404
- 1498 1570 1244 1425 1363 1467 1517 1570 1017 1347 1593 1648 1577 1639 1109 1362
- 815 1348 1351 1494 1616 1647 1578 1611 1377 1479 1565 1618 691 1347 1306 1435
- 1351 1497 1512 1563 783 1321 1608 1635 1033 1373 616 1423 941 1318 1304 1450
- 1555 1593 1071 1377 57 { m20} R 0.29091 0.8 0 c 743 1459 1642 1702 1155 1443
- 1183 1465 970 1394 1566 1685 1283 1500 1323 1492 1275 1515 1499 1650 1030 1463
- 1554 1643 1151 1437 1173 1470 860 1395 820 1414 1382 1558 1512 1621 920 1427
- 1149 1470 1225 1505 1469 1585 1544 1680 836 1408 1105 1478 1287 1502 1625 1692
- 1223 1458 1528 1667 1266 1496 1571 1664 1087 1434 874 1459 1190 1499 1621 1699
- 1566 1642 1184 1437 1550 1663 1166 1494 1206 1458 1580 1663 1251 1478 1293 1492
- 1448 1589 1111 1438 1515 1610 1295 1524 1382 1555 1169 1451 1512 1608 1544 1654
- 1411 1555 1604 1716 975 1461 1549 1649 1518 1630 1476 1616 1422 1553 1419 1590
- 1294 1523 1162 1436 957 1469 1524 1640 1443 1601 1496 1603 771 1417 1178 1461
- 1544 1631 1437 1555 1291 1522 1197 1457 1251 1514 1012 1400 1085 1459 1422 1605
- 1281 1501 1361 1522 1130 1454 1406 1538 1376 1575 1022 1406 911 1394 1546 1659
- 830 1404 1362 1530 1220 1506 1287 1517 1317 1494 1195 1454 994 1437 1054 1428
- 1500 1627 1476 1600 1365 1524 1416 1565 1391 1531 1525 1641 1452 1615 1131 1429
- 1397 1579 100 { m20} R 1308 1497 1451 1596 1004 1416 1096 1475 1598 1697 1317
- 1523 1345 1564 927 1392 1479 1617 1539 1626 951 1470 1209 1452 1210 1468 1338
- 1546 1068 1449 1186 1449 1384 1579 1218 1515 1266 1481 1420 1552 1519 1652 1497
- 1637 1098 1414 435 1535 1455 1597 1454 1604 1549 1644 1553 1636 1431 1584 1544
- 1652 1373 1552 1495 1602 1435 1578 1073 1424 1457 1601 1538 1674 1546 1635 930
- 1419 1613 1726 851 1456 1118 1419 1305 1515 1576 1693 1395 1533 1386 1526 1081
- 1416 1587 1662 1286 1477 1523 1631 1240 1508 1195 1444 1211 1509 1529 1625 1520
- 1648 1344 1565 1376 1577 1521 1649 1001 1450 1434 1557 1448 1595 1303 1532 1470
- 1622 1016 1418 817 1392 1133 1426 1128 1430 1595 1700 1274 1526 1076 1453 1315
- 1512 1257 1530 1517 1622 1607 1695 1241 1464 1424 1580 1441 1580 1398 1575 1534
- 1662 1451 1603 1534 1665 1128 1463 730 1449 1453 1618 1269 1479 1619 1704 936
- 1445 1438 1593 1396 1563 1501 1634 1433 1559 1116 1432 1238 1490 1237 1463 1124
- 1441 1255 1510 950 1398 1355 1567 1408 1569 1430 1608 1296 1535 100 { m20} R
- 904 1449 1215 1500 2 { m20} R 0.43636 0.8 0 c 1479 1666 1533 1693 1332 1607
- 1524 1713 1563 1695 1510 1686 1287 1559 898 1502 1394 1639 1316 1599 1362 1614
- 1341 1567 1295 1598 1305 1623 1242 1546 1246 1543 1302 1550 1342 1619 1489 1681
- 1260 1605 1272 1590 1262 1552 1587 1716 1483 1653 1137 1543 1003 1484 1384 1603
- 1403 1649 1174 1539 1529 1700 1547 1687 1516 1722 1201 1514 1360 1579 1417 1615
- 1573 1740 1549 1734 1578 1718 1470 1692 1343 1633 1509 1659 1306 1622 824 1564
- 1366 1619 1496 1650 1352 1570 1395 1604 1004 1494 1062 1496 1104 1537 1463 1694
- 1270 1546 1154 1509 1571 1732 1453 1687 1584 1724 1385 1602 1562 1721 1385 1633
- 1219 1584 1222 1596 1316 1583 1201 1520 1411 1603 1435 1619 934 1480 1546 1712
- 1267 1558 1350 1610 1367 1648 1382 1606 1549 1743 1528 1730 1230 1591 1101 1508
- 1185 1574 1430 1664 1485 1697 959 1545 1164 1565 1280 1558 1568 1731 1236 1537
- 1265 1561 1523 1725 1234 1597 1580 1720 1522 1681 1025 1524 1347 1599 1423 1608
- 1284 1606 1465 1659 1319 1561 1178 1544 1010 1493 1488 1647 1469 1664 1200 1579
- 1379 1655 100 { m20} R 1415 1660 1137 1546 1087 1563 1293 1572 791 1500 1316
- 1580 1525 1704 768 1502 1178 1512 1336 1624 1485 1684 1151 1504 1414 1643 1368
- 1641 1351 1612 874 1537 1466 1681 1379 1616 1401 1644 1546 1697 1490 1676 1231
- 1568 1242 1544 1172 1517 1341 1574 1475 1702 1320 1582 1390 1659 1176 1554 1378
- 1621 1551 1689 1285 1599 930 1544 1332 1576 1421 1673 1342 1588 1587 1719 1454
- 1686 1401 1647 1268 1565 908 1559 1076 1497 1543 1737 43 { m20} R 0.58182 0.8 0
- c 1534 1739 1514 1779 1067 1601 1527 1761 1379 1676 1316 1634 1045 1603 1345
- 1655 1295 1687 1507 1766 1529 1765 1433 1736 1325 1665 1290 1630 1503 1753 1534
- 1781 1487 1742 1528 1776 1394 1671 1485 1759 1446 1710 1088 1640 1483 1743 1339
- 1652 1241 1648 1489 1763 1406 1710 1521 1778 1407 1739 1505 1757 1272 1635 1285
- 1643 1485 1714 1371 1661 723 1623 1392 1686 1169 1628 1151 1591 818 1643 1418
- 1750 1509 1731 1552 1762 1517 1800 1524 1774 1537 1760 1442 1751 1384 1662 1378
- 1702 1481 1709 1118 1613 1510 1778 1131 1586 1513 1767 1183 1633 1504 1788 1460
- 1747 1232 1641 1477 1781 1490 1771 1331 1716 1509 1727 1520 1776 1378 1664 1548
- 1759 1535 1749 1171 1671 830 1638 1223 1668 1464 1767 1429 1741 1388 1706 1330
- 1670 1436 1759 1353 1691 1370 1697 1528 1749 1537 1784 1131 1577 1006 1637 1450
- 1700 1301 1639 1416 1682 1382 1708 1470 1728 1518 1778 1086 1606 1254 1632 1518
- 1794 1532 1755 1455 1723 1321 1656 1326 1644 1428 1716 93 { m20} R 0.72727 0.8
- 0 c 1436 1836 1378 1759 1403 1787 1399 1818 1242 1716 1462 1822 1441 1771 1439
- 1796 1374 1778 1319 1731 1316 1721 1333 1767 1175 1687 1479 1785 1392 1763 1326
- 1746 1334 1797 1496 1795 1070 1676 1255 1790 1419 1777 1425 1762 1213 1725 1216
- 1763 1395 1801 1428 1794 1116 1736 1273 1796 1446 1821 1448 1774 1457 1846 1282
- 1708 1451 1804 1230 1731 1375 1763 1373 1795 1404 1817 1293 1723 1402 1814 1247
- 1702 1234 1749 1265 1765 1266 1699 1442 1791 1477 1858 1299 1770 1312 1722 1339
- 1740 1365 1744 1078 1733 50 { m20} R 0.8 0.72727 0 c 1272 1841 1344 1819 1340
- 1907 1225 1814 1229 1817 1427 1901 1426 1893 1451 1893 1209 1802 1209 1843 1433
- 1887 1404 1850 1469 1883 13 { m20} R 0.8 0.58182 0 c 1297 1934 1331 1940 1199
- 1924 3 { m20} R 0.8 0.43636 0 c 1361 2042 m20 0.8 0.29091 0 c 1361 2042 0.8
- 0.14546 0 c 1361 2042 0 0 0.8 c 1361 2042 0 0.14545 0.8 c 1361 2042 0 0.29091
- 0.8 c 1361 2042 0 0.43636 0.8 c 1049 1175 996 1137 869 1075 836 1065 4 { m20} R
- 0 0.58182 0.8 c 901 1081 986 1120 1015 1141 748 1032 924 1090 769 1036 957 1102
- 952 1104 1487 1496 910 1084 983 1114 856 1063 770 1036 1099 1187 808 1047 852
- 1061 1137 1210 1217 1262 785 1040 855 1061 888 1080 1039 1152 22 { m20} R 0
- 0.72727 0.8 c 720 1036 1084 1166 826 1053 1016 1127 739 1037 738 1035 1088 1167
- 745 1037 902 1081 1124 1185 895 1076 1358 1357 841 1057 758 1036 1183 1229 774
- 1039 821 1052 1028 1134 740 1031 734 1037 845 1061 941 1094 1014 1126 960 1102
- 796 1044 763 1036 743 1038 804 1048 760 1036 1125 1186 979 1110 1054 1147 797
- 1045 756 1034 1002 1121 1079 1160 803 1050 899 1077 776 1042 869 1070 731 1033
- 742 1037 42 { m20} R 0 0.8 0.72727 c 681 1048 1118 1181 934 1101 700 1038 762
- 1057 1248 1266 721 1048 1024 1136 763 1046 1135 1192 778 1055 975 1117 726 1041
- 785 1061 781 1065 953 1110 683 1045 696 1056 716 1046 879 1083 950 1108 1054
- 1147 1133 1191 851 1074 703 1036 934 1099 962 1111 1044 1141 716 1045 866 1072
- 932 1095 794 1055 1273 1283 959 1103 793 1059 738 1053 943 1103 971 1114 966
- 1111 874 1073 866 1084 816 1063 712 1047 1041 1143 1007 1128 862 1069 1144 1198
- 888 1089 1307 1305 1088 1167 821 1067 1036 1140 691 1049 754 1054 691 1054 757
- 1056 770 1055 884 1087 897 1087 965 1105 1125 1185 688 1054 977 1115 899 1090
- 1020 1131 908 1086 1233 1253 691 1054 830 1069 753 1050 921 1090 795 1056 902
- 1085 830 1060 811 1056 820 1070 907 1096 810 1067 746 1054 885 1078 927 1094
- 683 1050 1156 1203 1167 1211 750 1057 703 1055 851 1077 680 1046 797 1058 931
- 1104 765 1061 1312 1312 92 { m20} R 0 0.8 0.58182 c 667 1070 1242 1264 636 1081
- 1276 1288 934 1121 775 1086 829 1094 913 1113 745 1084 711 1084 865 1105 733
- 1075 968 1122 761 1079 765 1083 1135 1205 723 1089 1268 1278 661 1076 960 1114
- 777 1075 829 1084 731 1066 736 1068 794 1090 712 1085 705 1083 812 1093 687
- 1077 916 1116 711 1077 641 1085 709 1084 826 1080 960 1128 1083 1169 1317 1312
- 708 1069 725 1060 774 1091 664 1069 718 1066 636 1089 760 1087 1067 1161 713
- 1088 770 1070 784 1081 973 1126 681 1066 964 1127 779 1086 1004 1149 761 1081
- 861 1104 931 1114 665 1089 1544 1506 1106 1187 651 1087 753 1091 673 1058 715
- 1071 867 1108 833 1085 1010 1149 758 1086 1044 1160 784 1071 1372 1355 673 1088
- 942 1117 727 1073 679 1058 1149 1202 692 1075 716 1081 982 1128 1238 1259 993
- 1144 758 1085 1065 1171 956 1124 1116 1186 959 1125 716 1062 1094 1179 914 1121
- 636 1083 984 1131 1193 1228 984 1128 1236 1260 955 1123 955 1113 701 1084 816
- 1089 1277 1285 701 1088 965 1123 100 { m20} R 666 1073 963 1117 900 1101 869
- 1093 1280 1289 658 1065 873 1087 711 1075 708 1068 697 1085 1176 1226 729 1079
- 919 1106 690 1069 661 1073 920 1100 865 1101 1060 1168 882 1095 812 1094 734
- 1061 891 1105 1200 1236 1083 1168 728 1067 654 1075 816 1081 683 1072 1031 1146
- 701 1088 999 1140 859 1092 815 1086 1604 1566 956 1117 974 1120 673 1061 652
- 1088 976 1130 765 1075 1081 1166 813 1082 796 1085 1027 1143 914 1119 1145 1200
- 1266 1276 768 1085 928 1121 969 1118 994 1130 776 1067 1275 1287 641 1071 54 {
- m20} R 0 0.8 0.43636 c 1103 1211 1109 1204 1319 1318 980 1147 634 1093 1141
- 1215 903 1120 679 1102 859 1138 738 1095 1252 1289 1301 1309 1072 1199 624 1105
- 1184 1252 638 1097 1147 1226 832 1108 655 1105 875 1141 1081 1195 820 1125 1045
- 1178 883 1117 1133 1209 1492 1457 1165 1240 1104 1212 724 1113 1404 1384 1290
- 1301 648 1105 598 1126 813 1132 1193 1240 749 1095 891 1123 1297 1316 1177 1232
- 652 1096 786 1101 1282 1305 809 1111 882 1134 667 1109 895 1141 640 1094 623
- 1110 1168 1232 728 1094 751 1118 643 1104 875 1120 1091 1185 734 1114 642 1093
- 931 1140 862 1143 790 1135 662 1091 966 1158 874 1123 757 1131 948 1145 1014
- 1170 1204 1256 881 1134 703 1122 1427 1404 1114 1195 1241 1281 577 1143 766
- 1110 849 1121 864 1115 728 1106 1317 1319 927 1151 760 1097 741 1098 705 1116
- 686 1105 1106 1209 795 1120 642 1119 618 1094 1230 1272 645 1090 869 1118 1026
- 1160 577 1136 907 1136 739 1116 669 1095 578 1136 685 1105 682 1098 975 1158
- 797 1107 601 1109 100 { m20} R 711 1116 693 1103 791 1100 655 1111 1025 1165
- 1168 1235 1229 1266 1078 1200 1303 1314 1062 1177 982 1160 623 1118 1085 1189
- 968 1145 620 1114 583 1140 954 1152 1044 1188 1285 1308 1336 1342 1146 1217 839
- 1123 806 1132 1227 1262 963 1162 866 1118 649 1130 622 1118 1011 1167 831 1121
- 842 1109 672 1100 832 1111 621 1120 1179 1236 1096 1189 1303 1314 1581 1542 693
- 1128 885 1121 610 1109 1435 1412 909 1138 997 1164 776 1110 959 1161 765 1113
- 600 1133 1268 1286 727 1095 1013 1159 1311 1323 1070 1191 594 1122 929 1129
- 1126 1220 683 1130 713 1100 1030 1164 941 1150 948 1140 778 1102 830 1124 747
- 1121 677 1133 902 1148 694 1117 850 1127 918 1126 718 1096 958 1163 781 1134
- 790 1101 635 1110 669 1132 843 1137 627 1096 621 1116 1026 1183 792 1108 1624
- 1584 955 1154 720 1116 768 1102 934 1128 738 1128 618 1109 737 1123 1023 1175
- 763 1124 1069 1197 751 1108 990 1153 769 1103 968 1145 1069 1182 776 1121 680
- 1101 1043 1166 949 1149 100 { m20} R 754 1125 955 1145 629 1102 1006 1178 627
- 1093 841 1108 880 1134 794 1125 1392 1379 851 1130 928 1132 852 1109 951 1136
- 740 1128 722 1095 794 1100 1263 1288 1549 1514 18 { m20} R 0 0.8 0.29091 c 879
- 1186 1066 1226 1248 1302 869 1148 915 1179 734 1155 746 1172 945 1193 981 1207
- 654 1164 875 1160 1153 1260 674 1173 687 1158 756 1143 1674 1643 668 1148 1190
- 1280 650 1187 1176 1256 921 1185 637 1176 1459 1449 737 1163 660 1180 1160 1265
- 1142 1248 1155 1242 887 1151 1427 1420 709 1155 1350 1358 1600 1571 1319 1341
- 598 1172 1293 1336 1138 1254 944 1189 1020 1209 813 1144 1082 1225 852 1153
- 1123 1251 1187 1282 1320 1338 1394 1392 596 1150 758 1143 865 1149 1673 1644
- 1212 1268 1254 1306 863 1157 1016 1187 1246 1290 1563 1534 1080 1220 1019 1202
- 1234 1295 956 1187 1401 1407 1478 1452 961 1186 1131 1253 1174 1266 851 1151
- 775 1174 1034 1217 770 1137 1086 1233 1039 1206 852 1169 935 1184 1482 1471
- 1102 1248 1390 1400 806 1149 683 1157 626 1139 1316 1337 1010 1208 902 1152
- 1088 1216 1650 1613 1025 1185 1051 1202 719 1148 1190 1274 598 1190 718 1160
- 1326 1358 955 1165 926 1185 1179 1261 844 1163 1248 1311 1521 1496 1031 1190
- 778 1168 1044 1196 100 { m20} R 878 1149 1035 1196 1147 1242 1485 1463 691 1160
- 950 1181 617 1143 1181 1257 936 1162 1334 1352 1241 1287 951 1164 815 1169 634
- 1173 703 1154 1378 1380 1299 1343 1490 1466 827 1181 917 1186 721 1177 1679
- 1644 1116 1253 1082 1230 1082 1209 1221 1286 1152 1239 719 1167 926 1160 995
- 1198 1017 1214 630 1162 754 1183 659 1143 611 1147 1136 1242 1359 1371 1101
- 1233 952 1164 850 1153 1163 1273 1076 1216 1153 1238 973 1197 826 1146 1131
- 1260 1164 1256 1064 1206 862 1169 856 1184 1043 1193 538 1209 1073 1219 965
- 1204 1080 1229 1218 1274 1286 1311 789 1144 783 1155 1232 1301 1123 1248 1081
- 1219 1067 1224 1297 1340 816 1176 1124 1229 697 1144 1178 1263 800 1165 625
- 1149 946 1178 921 1166 1091 1220 987 1178 814 1165 1184 1276 789 1156 797 1153
- 591 1183 696 1136 568 1172 789 1173 1190 1258 883 1152 1345 1369 897 1167 919
- 1178 1106 1240 896 1165 732 1156 1244 1304 685 1136 861 1187 987 1197 830 1146
- 995 1205 1458 1451 570 1196 903 1163 853 1158 100 { m20} R 806 1159 640 1139
- 570 1180 1097 1227 1279 1315 829 1141 653 1172 677 1151 865 1178 873 1188 1135
- 1244 1407 1399 1195 1258 678 1161 811 1173 769 1148 877 1170 1083 1228 1382
- 1379 704 1149 1244 1289 874 1151 953 1194 785 1165 1023 1203 1528 1500 609 1159
- 908 1152 951 1170 1082 1213 1618 1582 1111 1224 1127 1246 1162 1252 841 1183
- 1197 1276 1010 1216 1332 1350 1135 1245 650 1157 586 1145 1176 1249 1115 1248
- 1015 1182 1305 1323 955 1204 1502 1484 1051 1226 1604 1570 1331 1361 864 1186
- 1021 1194 1231 1302 1234 1299 853 1149 1317 1339 764 1181 1189 1271 825 1147
- 846 1157 961 1200 61 { m20} R 0 0.8 0.14545 c 870 1198 1273 1348 1238 1341 955
- 1242 1162 1288 928 1240 559 1236 1087 1273 1280 1339 1572 1562 1160 1285 889
- 1214 570 1223 904 1196 1245 1324 1565 1548 951 1219 783 1195 1328 1376 1113
- 1263 817 1222 1117 1270 1342 1383 1481 1486 1502 1495 1402 1417 1023 1240 940
- 1231 740 1226 1155 1283 1287 1342 806 1201 1182 1288 1470 1484 1236 1326 760
- 1189 939 1214 724 1244 719 1201 1340 1381 1260 1338 854 1226 975 1210 936 1239
- 814 1229 1056 1241 484 1291 1236 1327 1291 1344 1420 1425 1048 1236 736 1225
- 519 1248 1093 1278 1294 1341 907 1208 1393 1421 1377 1422 1357 1404 1274 1344
- 739 1189 883 1211 966 1250 1307 1381 855 1235 739 1199 1239 1344 804 1198 859
- 1230 1002 1237 1279 1334 990 1234 1511 1514 1217 1328 1420 1430 1002 1227 1194
- 1303 939 1251 894 1214 1007 1248 718 1198 1471 1489 1319 1360 1327 1363 661
- 1198 1367 1405 1317 1375 1235 1328 1111 1252 1234 1309 1346 1400 986 1250 1479
- 1494 1077 1284 1004 1222 1372 1391 1261 1355 981 1221 932 1217 1341 1384 100 {
- m20} R 1127 1273 1305 1377 849 1232 958 1237 1487 1479 1574 1558 1081 1251 1286
- 1362 891 1195 1453 1468 1342 1389 1462 1483 1274 1345 1345 1405 1113 1269 1306
- 1376 1263 1343 1614 1600 1030 1237 1618 1594 966 1209 1106 1268 1187 1317 1224
- 1310 1017 1243 795 1202 1288 1370 936 1218 1260 1358 1170 1291 800 1208 1153
- 1295 1356 1407 1109 1273 828 1195 787 1205 676 1194 1062 1263 799 1195 1028
- 1246 1254 1322 935 1239 1362 1394 931 1227 957 1251 527 1240 1113 1294 1004
- 1264 757 1217 1150 1270 1633 1620 1201 1323 857 1233 806 1190 798 1220 1004
- 1234 900 1236 824 1243 621 1200 552 1221 1341 1401 671 1245 1157 1277 1068 1247
- 1304 1354 1419 1447 677 1195 1391 1413 1563 1558 996 1259 712 1228 1368 1419
- 878 1193 579 1216 938 1216 935 1214 660 1241 864 1220 1343 1396 1096 1278 642
- 1206 746 1239 859 1241 1299 1354 1174 1287 1311 1372 862 1232 932 1209 897 1211
- 921 1226 1198 1291 1471 1478 1465 1482 916 1213 1313 1380 958 1243 547 1213 891
- 1198 981 1233 1060 1274 100 { m20} R 1218 1324 1198 1299 683 1239 1467 1465
- 1189 1320 1069 1271 738 1209 656 1248 723 1235 1023 1244 625 1196 1049 1263 565
- 1223 1577 1574 947 1248 1062 1247 1156 1296 872 1212 775 1203 844 1224 1240
- 1338 742 1196 812 1216 1124 1274 1178 1315 1210 1331 925 1238 850 1220 690 1203
- 603 1259 1324 1375 1252 1332 1090 1262 835 1206 1028 1242 740 1238 1513 1521
- 1439 1451 1041 1237 1416 1438 1046 1237 984 1214 1259 1324 1111 1262 1131 1280
- 1051 1260 1288 1358 575 1251 838 1226 973 1222 1344 1388 1176 1301 1151 1281
- 1153 1308 1306 1374 1199 1299 1025 1227 1318 1381 576 1261 969 1235 1239 1347
- 939 1248 1264 1331 63 { m20} R 0 0.8 0.4069E-06 c 1292 1415 1669 1659 928 1268
- 1277 1398 1321 1408 1341 1438 1032 1274 1114 1305 995 1274 1160 1345 1463 1506
- 1645 1659 1368 1428 1367 1430 832 1280 1196 1377 817 1250 1435 1477 1496 1538
- 1124 1322 1210 1349 1526 1538 1207 1355 921 1263 1236 1380 1512 1543 986 1271
- 1372 1451 1654 1648 1139 1337 1248 1356 877 1260 1498 1532 885 1272 1176 1352
- 1736 1727 1353 1418 982 1277 946 1261 592 1310 847 1260 1094 1341 1438 1477 949
- 1274 980 1267 1182 1345 1034 1307 1718 1717 964 1318 1416 1471 711 1264 1145
- 1312 1184 1338 1532 1555 1061 1336 1463 1485 829 1262 1241 1361 970 1305 1139
- 1313 710 1297 1218 1374 877 1298 1594 1598 1013 1295 1093 1343 1024 1324 1129
- 1315 758 1256 1402 1456 1320 1415 1106 1311 768 1266 984 1263 838 1272 1033
- 1278 995 1291 979 1300 1415 1470 567 1278 741 1274 788 1267 832 1246 1105 1300
- 1010 1282 945 1265 1661 1679 1150 1352 1415 1454 1164 1333 1216 1362 952 1287
- 970 1289 1637 1633 888 1249 1331 1419 1113 1297 1692 1706 1039 1277 1232 1382
- 100 { m20} R 1000 1298 1690 1699 1328 1423 1165 1325 961 1270 1111 1347 1659
- 1661 1135 1327 763 1282 1117 1342 1549 1567 1078 1315 1619 1641 938 1260 878
- 1251 1249 1372 1253 1377 1280 1410 1134 1339 1411 1467 1277 1392 984 1310 1556
- 1559 1340 1430 674 1295 881 1270 1398 1447 1303 1402 987 1295 511 1326 800 1265
- 1524 1564 1140 1318 1397 1475 1494 1541 1443 1487 998 1268 1664 1677 1082 1326
- 794 1265 1079 1301 1333 1432 1282 1409 929 1314 695 1252 1537 1553 1671 1689
- 1299 1413 1175 1341 1546 1561 1244 1397 1074 1330 882 1261 807 1288 784 1300
- 1265 1380 1462 1520 874 1269 1125 1302 963 1278 1312 1415 1388 1470 1351 1439
- 1138 1316 745 1273 1129 1349 915 1255 819 1250 1204 1338 811 1287 1534 1569 849
- 1303 1411 1452 1060 1302 1378 1462 1454 1508 774 1256 1186 1352 1082 1339 1343
- 1417 1350 1452 1065 1292 763 1261 1420 1459 912 1274 1065 1326 1630 1627 1342
- 1423 928 1277 1215 1345 1432 1486 824 1255 994 1266 1296 1398 1617 1616 865
- 1277 931 1270 696 1264 1505 1540 1024 1290 100 { m20} R 1300 1412 1214 1379
- 1184 1364 481 1309 1066 1297 988 1265 1382 1460 1272 1386 1079 1289 1072 1284
- 509 1293 1345 1417 1232 1355 850 1291 633 1335 1289 1395 1509 1545 922 1302 922
- 1307 1187 1344 643 1328 1037 1327 1557 1579 1238 1362 1161 1357 1002 1322 1360
- 1432 757 1277 765 1267 1233 1374 1112 1315 762 1272 1291 1409 1242 1392 976
- 1272 1490 1538 810 1244 1409 1467 1115 1312 931 1258 759 1283 1325 1433 1490
- 1511 43 { m20} R 0.14545 0.8 0 c 1219 1412 1191 1415 1609 1665 1328 1447 1521
- 1598 1215 1428 1294 1472 1246 1421 958 1346 919 1380 1294 1473 1581 1617 1536
- 1582 825 1314 1178 1378 1252 1457 1544 1595 958 1388 1333 1443 1198 1391 1641
- 1701 1642 1666 910 1322 927 1372 540 1391 1324 1466 1360 1479 1334 1448 1378
- 1475 1483 1564 1392 1505 1278 1459 1018 1365 1056 1396 1389 1518 1547 1588 1139
- 1387 1552 1628 1080 1358 1579 1636 1118 1368 1535 1599 1377 1479 728 1350 721
- 1365 874 1322 1041 1347 1109 1374 897 1341 1202 1382 975 1377 1572 1604 1307
- 1433 848 1335 1222 1431 1539 1598 1282 1428 1339 1488 1171 1404 1107 1370 1630
- 1681 1616 1657 1633 1662 1502 1573 1343 1472 472 1428 902 1341 1498 1580 1062
- 1355 1075 1397 895 1326 1129 1397 1392 1496 1082 1365 1310 1441 1312 1452 732
- 1343 811 1355 1215 1430 1565 1620 1639 1693 1284 1444 1512 1580 1237 1435 1064
- 1403 1167 1394 966 1388 944 1333 1324 1485 963 1387 1128 1367 1369 1514 1161
- 1367 1062 1368 1288 1436 1061 1357 1086 1366 1144 1384 1595 1652 1192 1383 100
- { m20} R 1541 1609 1320 1454 857 1319 1292 1439 1149 1372 1169 1372 1496 1576
- 1157 1367 1125 1410 1623 1670 1184 1431 851 1317 1600 1661 1456 1541 1260 1434
- 1565 1602 971 1366 1413 1493 831 1317 1544 1584 1100 1350 756 1322 980 1357
- 1297 1457 1644 1691 1574 1615 1040 1386 901 1320 895 1314 1033 1397 1459 1548
- 1498 1560 837 1327 751 1329 604 1350 1101 1374 1203 1404 1082 1353 1445 1532
- 1082 1394 1325 1441 1274 1466 1591 1652 1040 1380 1375 1506 1361 1477 1514 1584
- 859 1344 1481 1567 1550 1617 1178 1377 1327 1469 1249 1447 1327 1493 808 1328
- 983 1324 1223 1414 1528 1603 1639 1673 1513 1594 1647 1677 1322 1438 1536 1600
- 1280 1456 1118 1399 1126 1362 624 1409 1260 1446 1425 1531 1474 1569 719 1347
- 1069 1349 1175 1429 1312 1443 874 1341 996 1388 996 1358 1567 1602 1431 1536
- 490 1395 1174 1386 1086 1400 1575 1615 1616 1643 1256 1454 1183 1403 1651 1702
- 1365 1485 628 1368 1531 1597 1367 1477 1358 1487 1320 1443 1316 1446 1184 1410
- 1217 1422 1202 1420 1368 1484 1188 1432 751 1322 100 { m20} R 1284 1469 1120
- 1385 1496 1591 897 1334 1492 1551 704 1387 1439 1528 1556 1617 1126 1365 1118
- 1365 1255 1436 920 1378 707 1324 1535 1599 1310 1434 1036 1338 1110 1411 1377
- 1498 585 1365 1381 1476 1070 1360 1437 1541 1204 1407 1156 1412 1159 1384 1431
- 1501 1281 1472 724 1355 1164 1409 942 1370 1179 1380 1080 1353 1225 1442 893
- 1360 1377 1496 984 1360 1316 1471 1232 1437 936 1375 1362 1498 981 1390 1256
- 1411 1485 1542 1209 1443 1340 1461 1294 1464 1649 1669 1431 1549 1444 1541 1081
- 1395 1634 1656 918 1343 1275 1448 1297 1432 1044 1363 1278 1417 1559 1630 1013
- 1327 1215 1419 1592 1643 1250 1419 1467 1563 62 { m20} R 0.29091 0.8 0 c 962
- 1442 1353 1542 1235 1464 1634 1699 1102 1425 816 1446 1594 1688 1121 1477 1045
- 1474 1435 1572 1490 1594 1335 1518 1220 1517 1441 1590 1637 1707 1338 1524 1099
- 1446 1544 1626 1392 1562 1419 1586 1598 1695 1314 1503 1330 1511 1192 1452 1435
- 1577 1165 1436 1324 1556 1409 1593 1263 1478 661 1443 1594 1667 1257 1529 890
- 1448 635 1510 809 1394 677 1431 1596 1692 1212 1484 1307 1507 1611 1710 1199
- 1461 1426 1552 1271 1484 1450 1591 1395 1537 1248 1506 1613 1716 1501 1602 790
- 1463 1159 1431 1501 1613 1432 1560 1147 1439 1041 1423 1520 1613 1112 1451 1514
- 1659 1538 1671 1495 1617 1224 1455 1449 1569 1433 1595 1328 1529 792 1428 1443
- 1560 1305 1516 1277 1484 1340 1527 975 1428 658 1422 1423 1602 1070 1451 1112
- 1420 1344 1516 953 1442 1264 1471 1044 1439 1294 1508 1132 1426 1601 1685 1294
- 1489 1174 1473 1507 1644 1622 1720 1555 1638 1633 1718 1170 1477 1386 1573 1275
- 1473 1180 1477 1501 1645 1185 1504 1343 1559 782 1439 1613 1713 1092 1410 1516
- 1612 1330 1539 916 1415 892 1465 100 { m20} R 1492 1617 1359 1564 1309 1489
- 1128 1473 971 1442 1120 1428 1395 1551 1449 1590 1242 1501 1258 1474 1394 1553
- 1600 1719 1248 1518 1289 1498 1169 1441 1265 1504 857 1443 704 1412 962 1466
- 1565 1642 1489 1589 1296 1500 1586 1693 1318 1502 1458 1588 1446 1607 1452 1613
- 1319 1515 1303 1505 1448 1566 528 1463 1279 1520 1231 1455 1159 1477 1457 1589
- 1358 1555 1088 1415 1469 1585 1544 1652 1199 1501 1131 1426 1442 1605 1083 1428
- 1552 1639 1230 1471 1364 1516 1168 1448 1163 1467 924 1459 1137 1459 1414 1554
- 1296 1496 1029 1430 780 1404 1290 1517 1270 1534 1255 1513 1442 1595 1048 1459
- 1572 1677 1319 1503 1279 1503 1407 1576 1554 1680 1612 1716 1499 1651 1440 1571
- 1013 1397 1504 1641 1156 1496 1511 1615 1620 1696 833 1417 1599 1708 1437 1601
- 1294 1540 1593 1678 1560 1662 1084 1455 1432 1608 1247 1506 1615 1682 1221 1486
- 1379 1561 1555 1658 1034 1416 1580 1704 1411 1583 1454 1580 1408 1552 1369 1529
- 1461 1571 92 { m20} R 0.43636 0.8 0 c 1520 1720 1207 1516 1597 1732 1492 1671
- 1362 1632 1569 1742 1187 1540 1356 1622 1339 1596 1533 1726 1445 1676 1230 1563
- 1488 1670 1072 1527 1202 1582 1287 1567 1193 1583 1504 1718 1427 1665 1567 1697
- 1324 1560 1174 1555 1094 1539 1288 1587 1447 1625 1418 1608 1451 1665 1459 1642
- 1537 1686 1477 1702 1481 1692 1569 1754 1568 1723 1393 1656 1010 1541 1419 1643
- 1005 1521 1281 1576 1443 1652 1437 1619 1276 1586 1572 1716 1039 1533 1232 1567
- 1552 1717 1420 1626 1554 1719 902 1560 1076 1488 1528 1682 1474 1697 1266 1562
- 1158 1571 929 1563 1416 1662 1322 1612 1492 1664 1317 1587 1433 1660 1353 1611
- 1340 1591 1474 1669 1317 1568 817 1573 684 1556 1047 1516 796 1536 1477 1656
- 1184 1570 1260 1545 1258 1566 839 1485 1124 1508 1217 1540 1348 1639 1593 1717
- 1517 1690 1106 1516 1256 1558 1546 1713 1237 1533 1273 1567 1436 1646 1510 1664
- 1238 1573 1420 1636 1580 1713 1001 1492 1468 1671 1542 1709 1594 1736 1450 1658
- 1189 1538 1242 1572 1159 1517 1176 1557 1550 1686 1448 1626 947 1537 1150 1530
- 100 { m20} R 1008 1483 1452 1666 1369 1644 1380 1586 1212 1517 1551 1733 1496
- 1657 1276 1576 1553 1734 1375 1591 1517 1665 853 1520 1232 1540 1523 1684 1533
- 1728 1465 1655 926 1515 951 1511 1413 1643 1212 1530 1522 1720 1374 1592 1473
- 1652 884 1472 1463 1667 1429 1661 1114 1551 1497 1655 1250 1540 877 1543 1523
- 1683 1082 1491 1467 1637 1516 1689 1235 1525 1076 1543 1397 1648 1470 1694 1138
- 1514 1424 1636 1338 1627 1524 1698 1485 1676 43 { m20} R 0.58182 0.8 0 c 910
- 1571 1418 1705 1033 1607 1428 1718 1453 1750 1337 1715 1519 1750 1153 1584 1331
- 1696 1502 1785 1071 1632 1452 1702 1458 1771 1506 1743 1309 1648 1240 1668 1378
- 1711 1448 1736 1449 1711 1227 1636 1527 1794 1452 1745 1478 1755 1330 1650 1437
- 1745 1430 1734 1469 1766 1521 1763 1113 1606 1197 1634 1250 1689 1321 1633 1247
- 1654 1365 1669 1470 1735 1517 1736 1557 1761 1417 1722 1526 1744 1397 1724 1457
- 1768 1392 1709 1380 1688 1300 1699 1385 1664 1022 1631 1486 1722 1502 1732 1396
- 1727 891 1596 1206 1658 1522 1740 1052 1596 1369 1696 1009 1589 1223 1630 1409
- 1716 1501 1725 1256 1660 1103 1660 1326 1689 969 1618 1435 1737 1438 1726 1337
- 1679 969 1570 1254 1641 1506 1740 1475 1710 1455 1755 1120 1589 1126 1592 903
- 1622 1414 1673 862 1581 1256 1655 1292 1622 1296 1656 1292 1624 1300 1644 1075
- 1577 1417 1734 1461 1738 600 1754 1167 1588 1194 1668 965 1582 1342 1705 1387
- 1672 89 { m20} R 0.72727 0.8 0 c 1263 1724 1272 1724 1482 1840 1216 1738 1411
- 1762 1388 1798 1421 1818 1413 1818 1388 1763 1388 1743 1252 1694 1161 1712 1406
- 1792 1091 1682 1430 1794 1307 1789 1289 1727 1406 1802 1493 1801 1420 1817 1348
- 1775 1263 1736 1487 1847 1382 1828 1427 1782 1080 1712 1171 1777 1481 1828 1448
- 1777 1401 1798 1360 1786 1402 1749 1049 1664 1370 1821 34 { m20} R 0.8 0.72727
- 0 c 1247 1853 1417 1872 1191 1885 1448 1912 1387 1855 1241 1817 1118 1796 1158
- 1889 1041 1833 1429 1874 1405 1850 1435 1944 1251 1833 1400 1845 1195 1871 1446
- 1912 1388 1897 1324 1887 1299 1904 1418 1872 1264 1837 1287 1868 1198 1872 1419
- 1854 1177 1782 25 { m20} R 0.8 0.58182 0 c 1391 2043 1286 1969 1278 2006 1216
- 1917 4 { m20} R 0.8 0.43636 0 c 1391 2043 0.8 0.29091 0 c 1391 2043 0.8 0.14546
- 0 c 1391 2043 0 0 0.8 c 1391 2043 0 0.14545 0.8 c 1391 2043 0 0.29091 0.8 c
- 1391 2043 0 0.43636 0.8 c 860 1070 881 1078 905 1094 1046 1172 4 { m20} R 0
- 0.58182 0.8 c 828 1053 860 1066 917 1091 957 1105 991 1120 887 1076 991 1122
- 1005 1127 838 1057 762 1034 1037 1141 1021 1142 1057 1152 886 1073 932 1092
- 1010 1133 799 1044 846 1059 841 1057 853 1061 890 1077 749 1032 22 { m20} R 0
- 0.72727 0.8 c 939 1095 822 1051 863 1065 924 1088 1157 1205 737 1032 1040 1141
- 1081 1162 824 1056 755 1041 825 1057 1032 1136 739 1040 750 1034 774 1042 1108
- 1176 951 1099 831 1058 820 1052 772 1042 911 1082 988 1115 895 1076 801 1046
- 737 1039 966 1106 735 1038 860 1066 1069 1154 955 1100 932 1090 1021 1130 1316
- 1325 840 1059 890 1077 736 1040 848 1060 777 1043 805 1048 817 1054 40 { m20} R
- 0 0.8 0.72727 c 825 1074 1002 1127 930 1100 665 1052 743 1057 1139 1195 843
- 1074 940 1097 806 1062 1182 1220 739 1049 1158 1205 879 1081 1064 1157 1077
- 1159 749 1059 1029 1140 705 1052 755 1044 1327 1321 1009 1131 793 1062 833 1067
- 765 1051 1075 1160 1080 1164 1340 1330 853 1074 933 1099 777 1054 890 1079 688
- 1049 681 1055 728 1046 1051 1149 845 1075 697 1045 763 1060 767 1046 1311 1309
- 896 1080 837 1067 741 1053 710 1049 747 1043 848 1079 993 1118 758 1051 704
- 1047 777 1066 1473 1455 846 1064 710 1053 703 1049 715 1041 888 1087 1219 1243
- 958 1109 1035 1143 969 1110 787 1052 862 1074 1016 1134 853 1079 753 1043 762
- 1059 1191 1225 1041 1140 726 1044 1085 1163 713 1057 848 1075 708 1054 856 1072
- 764 1060 1049 1148 771 1061 866 1077 1039 1144 763 1051 717 1041 714 1049 1151
- 1202 755 1052 767 1047 1038 1139 912 1090 856 1075 1112 1177 839 1073 721 1045
- 671 1050 833 1073 1207 1236 778 1062 788 1064 743 1046 884 1086 921 1097 702
- 1036 100 { m20} R 863 1070 993 1121 732 1044 930 1097 1058 1152 5 { m20} R 0
- 0.8 0.58182 c 762 1066 677 1083 1115 1189 859 1091 811 1091 894 1102 973 1126
- 797 1074 1119 1195 1042 1160 676 1057 874 1105 950 1129 921 1106 1153 1204 1029
- 1144 831 1093 763 1091 1106 1185 726 1076 1033 1155 807 1094 656 1059 1120 1190
- 1141 1201 666 1072 1051 1151 690 1058 843 1083 670 1073 1247 1269 845 1097 1136
- 1194 858 1091 779 1091 842 1100 769 1076 1026 1154 660 1087 910 1105 888 1091
- 746 1081 661 1085 1245 1263 734 1081 727 1066 803 1092 717 1082 942 1108 662
- 1060 1015 1138 840 1081 870 1098 1086 1182 1297 1301 813 1099 709 1090 956 1115
- 706 1080 834 1092 831 1099 827 1090 1074 1166 1074 1165 977 1123 836 1082 849
- 1096 900 1101 735 1062 1688 1656 861 1106 1015 1139 636 1087 1331 1323 1026
- 1145 700 1077 1276 1288 1214 1247 638 1082 792 1094 1252 1270 783 1089 866 1097
- 861 1091 1053 1166 800 1084 635 1088 686 1067 685 1077 882 1103 925 1124 903
- 1097 851 1093 709 1085 631 1090 1333 1324 1391 1370 749 1083 1066 1169 1129
- 1195 100 { m20} R 933 1113 1119 1189 717 1076 793 1090 823 1101 987 1141 1318
- 1313 1266 1280 897 1107 768 1078 821 1090 810 1090 962 1121 1284 1288 766 1086
- 1130 1202 1031 1148 957 1124 957 1121 1153 1209 703 1073 825 1077 805 1079 627
- 1090 737 1082 991 1137 675 1083 770 1069 1005 1147 959 1115 1149 1211 764 1092
- 782 1087 774 1072 935 1122 797 1072 1309 1306 839 1082 733 1079 720 1064 1093
- 1174 980 1131 727 1072 937 1115 779 1068 676 1086 708 1081 840 1099 941 1112
- 989 1134 638 1081 668 1061 728 1088 712 1083 689 1084 1828 1836 688 1077 814
- 1098 834 1089 1184 1223 848 1103 61 { m20} R 0 0.8 0.43636 c 593 1126 981 1165
- 661 1109 1333 1336 720 1120 1200 1252 822 1121 779 1134 927 1140 656 1104 684
- 1114 587 1137 1247 1272 1038 1188 841 1118 599 1107 782 1126 822 1125 954 1133
- 1293 1300 991 1166 1005 1170 785 1119 1006 1154 940 1153 1278 1296 722 1093 749
- 1132 593 1119 623 1105 1038 1187 1122 1215 1130 1226 837 1136 730 1109 797 1113
- 849 1110 781 1100 1010 1165 688 1119 785 1127 667 1115 1025 1178 633 1110 1287
- 1302 1137 1228 1133 1219 940 1140 1341 1343 1139 1214 689 1114 1407 1385 889
- 1147 875 1136 667 1134 1089 1192 1180 1241 952 1133 801 1128 1101 1205 902 1118
- 677 1124 1320 1325 855 1126 642 1116 914 1125 1031 1183 866 1112 697 1095 1271
- 1291 755 1103 1230 1262 768 1120 1128 1212 1024 1180 665 1121 1066 1176 1404
- 1388 1251 1285 1073 1191 705 1100 652 1100 666 1107 655 1129 1066 1174 916 1140
- 1242 1279 657 1096 656 1120 600 1109 737 1123 1139 1217 945 1155 608 1135 1569
- 1529 1048 1179 719 1101 1406 1385 941 1144 736 1122 100 { m20} R 1345 1340 593
- 1118 988 1168 1076 1188 695 1125 1319 1330 714 1128 962 1151 1209 1249 998 1150
- 769 1130 867 1117 940 1147 732 1097 1397 1386 936 1149 800 1113 952 1157 1015
- 1175 825 1111 693 1094 960 1146 1162 1222 1060 1176 676 1115 1036 1167 602 1132
- 989 1164 915 1131 1294 1313 996 1167 1297 1309 1101 1199 1044 1172 1186 1238
- 1138 1214 647 1103 717 1108 970 1162 921 1141 620 1109 684 1098 634 1105 1226
- 1266 1173 1240 1222 1260 1204 1249 892 1132 862 1110 597 1113 739 1121 810 1126
- 604 1127 1031 1169 755 1101 884 1119 903 1119 810 1137 809 1108 1100 1189 934
- 1131 1032 1184 728 1105 1027 1168 837 1125 793 1112 963 1157 1161 1232 1127
- 1223 876 1118 807 1131 1211 1250 805 1104 935 1153 1090 1192 816 1112 748 1093
- 684 1110 755 1132 637 1129 767 1124 1111 1206 1132 1214 1257 1283 711 1094 721
- 1119 1081 1201 1456 1430 1094 1206 737 1125 920 1149 1421 1397 704 1126 1046
- 1188 754 1096 1327 1332 1191 1255 993 1156 909 1151 1085 1187 100 { m20} R 819
- 1106 779 1097 885 1132 734 1102 712 1092 1024 1183 6 { m20} R 0 0.8 0.29091 c
- 1136 1244 1293 1328 777 1158 1288 1322 740 1174 840 1180 1142 1248 1537 1503
- 1341 1350 966 1188 1165 1273 639 1152 576 1187 665 1185 947 1181 582 1175 853
- 1178 1165 1272 1179 1275 1291 1324 1270 1325 1222 1281 993 1176 1549 1527 967
- 1205 613 1158 584 1193 1259 1319 1175 1276 887 1181 1401 1393 815 1168 684 1160
- 1260 1317 831 1144 684 1144 607 1174 1326 1346 788 1162 1520 1498 559 1178 1470
- 1449 1222 1286 731 1137 929 1173 643 1161 1148 1246 1204 1277 848 1148 870 1180
- 1079 1235 1383 1387 1064 1207 942 1200 1286 1315 1082 1207 1347 1351 620 1138
- 1339 1346 669 1141 1288 1318 781 1162 934 1174 704 1162 1421 1412 1262 1299 930
- 1166 1000 1203 1397 1402 1448 1440 1199 1272 762 1143 751 1153 860 1167 1087
- 1217 834 1165 796 1157 922 1192 1236 1303 552 1186 745 1184 1139 1258 944 1171
- 919 1183 1282 1334 1304 1344 791 1168 1266 1312 1094 1214 1148 1254 703 1184
- 826 1179 1369 1374 596 1168 791 1147 1193 1286 865 1159 648 1175 949 1172 664
- 1143 100 { m20} R 1190 1275 741 1144 1262 1312 683 1137 964 1178 1315 1342 771
- 1166 1016 1216 965 1204 932 1175 1117 1243 861 1183 1184 1253 1254 1298 707
- 1136 1027 1208 913 1186 813 1178 1483 1463 1249 1290 949 1164 942 1178 889 1168
- 818 1152 1036 1194 1074 1235 831 1182 860 1149 727 1154 1150 1241 1093 1227
- 1085 1230 588 1176 1170 1275 1189 1278 1160 1262 882 1159 777 1162 815 1146 775
- 1165 1070 1225 1126 1232 743 1178 835 1143 835 1145 711 1147 1088 1217 911 1173
- 940 1176 635 1145 925 1166 878 1150 976 1183 1241 1297 1256 1311 889 1159 1298
- 1330 1696 1662 1071 1220 939 1182 1020 1192 875 1189 670 1175 681 1151 1043
- 1226 585 1166 939 1175 1042 1209 1152 1253 993 1197 1340 1346 1079 1226 763
- 1176 1372 1375 945 1169 1495 1473 596 1159 996 1194 913 1166 949 1176 1265 1302
- 1420 1412 1591 1564 810 1175 1220 1280 676 1153 1349 1365 649 1138 1261 1310
- 1034 1203 1007 1187 843 1156 1400 1403 556 1179 1023 1206 621 1141 1672 1635
- 674 1148 852 1145 906 1181 100 { m20} R 641 1186 1002 1190 915 1181 614 1180
- 1293 1333 999 1207 1095 1221 897 1169 1014 1185 1244 1288 1086 1220 1054 1210
- 1004 1196 1590 1552 687 1184 15 { m20} R 0 0.8 0.14545 c 946 1215 698 1218 1142
- 1266 1140 1269 811 1209 802 1197 672 1209 1346 1392 950 1218 741 1216 925 1222
- 767 1225 1507 1502 840 1195 1100 1279 1591 1567 1358 1407 859 1235 674 1209
- 1199 1304 1268 1335 554 1218 1038 1258 978 1219 571 1252 1042 1241 1725 1703
- 926 1200 560 1244 768 1191 860 1240 788 1212 1189 1290 853 1207 952 1242 771
- 1186 1329 1363 1602 1580 877 1200 757 1186 1176 1305 1487 1489 958 1223 1041
- 1236 1665 1643 1459 1470 832 1199 1100 1265 1234 1328 1448 1459 762 1205 1464
- 1461 1037 1227 1277 1334 1168 1283 1200 1307 1565 1560 1018 1231 819 1234 820
- 1205 1061 1258 765 1240 1416 1431 1103 1291 813 1187 1601 1582 925 1224 907
- 1228 1660 1649 1186 1306 996 1216 998 1237 1199 1313 1142 1265 887 1203 1430
- 1439 1295 1351 1195 1312 1339 1381 1244 1333 976 1228 1365 1402 699 1199 1232
- 1322 1070 1270 769 1199 1365 1410 1291 1343 903 1220 742 1199 1072 1257 933
- 1246 716 1211 560 1261 1303 1381 625 1214 1177 1310 1356 1409 1253 1334 1751
- 1727 100 { m20} R 938 1234 1263 1336 1541 1544 746 1219 1002 1219 603 1247 1201
- 1296 1398 1416 886 1205 1227 1337 543 1263 889 1217 1236 1310 1382 1414 1392
- 1421 1276 1366 1223 1313 1225 1334 670 1226 1271 1347 1036 1228 752 1244 891
- 1195 937 1204 1385 1406 1120 1285 777 1196 865 1213 1637 1619 1131 1285 485
- 1290 728 1230 795 1216 1341 1399 855 1236 689 1212 789 1216 1090 1257 1671 1649
- 938 1216 1531 1534 1114 1287 910 1236 979 1258 904 1200 1001 1228 1106 1293
- 1683 1661 1346 1373 939 1210 572 1259 1186 1294 1041 1245 1054 1252 713 1185
- 1725 1707 1028 1235 1061 1260 1125 1295 537 1218 1159 1297 670 1217 696 1246
- 1259 1348 1273 1355 1023 1266 1351 1408 1162 1306 737 1208 1063 1243 1573 1570
- 1129 1296 1156 1296 1033 1244 1037 1247 922 1227 650 1239 1360 1398 1436 1451
- 643 1213 1015 1244 1450 1462 962 1217 1331 1365 797 1236 1137 1270 640 1220 595
- 1265 1638 1626 1055 1235 620 1205 1479 1469 1590 1566 1094 1288 1185 1300 1492
- 1503 657 1219 944 1206 1035 1254 1557 1550 100 { m20} R 1156 1276 1457 1476
- 1007 1231 944 1204 958 1247 1021 1232 1124 1291 620 1208 1723 1696 640 1227 988
- 1260 571 1246 1084 1265 721 1190 664 1218 1255 1354 606 1237 1193 1287 1072
- 1249 1393 1426 1387 1425 1665 1645 700 1188 1368 1388 929 1249 1164 1299 1031
- 1254 539 1228 697 1215 608 1233 1601 1576 1216 1325 1709 1693 1405 1413 702
- 1221 1184 1293 793 1202 611 1207 663 1201 925 1214 1363 1398 801 1217 1106 1291
- 560 1267 1353 1387 1367 1411 1314 1379 833 1201 1215 1328 1240 1348 928 1229
- 994 1228 1097 1279 1709 1693 1325 1368 696 1197 966 1250 654 1196 713 1197 797
- 1237 1440 1466 1213 1322 635 1212 1383 1429 877 1227 65 { m20} R 0 0.8
- 0.4069E-06 c 1692 1698 1300 1416 1397 1461 959 1262 1142 1332 1409 1478 1268
- 1388 1168 1334 691 1261 1645 1648 811 1298 811 1245 1202 1343 1124 1330 1659
- 1671 1432 1492 1198 1330 1270 1393 1573 1582 1366 1434 888 1266 1553 1583 766
- 1258 1482 1535 1127 1315 1252 1396 905 1255 923 1255 1538 1547 1040 1306 954
- 1303 1128 1336 1039 1317 1260 1388 1069 1288 962 1269 1396 1465 1165 1327 1462
- 1507 1484 1500 1264 1374 1244 1382 1210 1372 1157 1349 1052 1296 855 1287 816
- 1244 1038 1288 1427 1493 1211 1351 1504 1527 1413 1457 1242 1370 860 1280 1024
- 1279 1210 1380 1266 1366 1140 1335 1632 1653 1404 1451 1170 1354 667 1299 1419
- 1470 1308 1407 1451 1502 698 1255 1074 1335 936 1292 749 1269 1474 1526 1279
- 1404 1600 1601 1611 1615 1519 1545 1016 1313 586 1288 1062 1294 1088 1302 1351
- 1448 979 1274 1661 1671 954 1292 786 1282 1280 1381 1142 1347 1038 1326 1364
- 1439 1621 1632 1158 1361 906 1312 887 1274 1027 1319 1013 1279 1310 1412 1138
- 1339 1170 1352 852 1281 1118 1301 782 1254 882 1247 100 { m20} R 1019 1302 1200
- 1343 1411 1464 472 1339 1597 1612 880 1272 1194 1370 1163 1339 934 1312 1065
- 1329 1581 1605 965 1278 762 1273 780 1245 1334 1441 916 1273 1237 1365 1263
- 1366 1671 1663 1483 1505 822 1252 1092 1313 1060 1302 1108 1334 1545 1571 1436
- 1487 1631 1639 1020 1293 1500 1539 1052 1325 1009 1273 1168 1320 1083 1304 1477
- 1520 749 1254 1206 1379 1443 1496 834 1308 643 1310 629 1274 830 1254 1132 1334
- 1181 1347 825 1306 1428 1480 1258 1369 866 1251 1544 1550 1070 1326 1343 1442
- 643 1320 1321 1405 1377 1467 1165 1352 1342 1423 558 1345 927 1274 1491 1522
- 681 1254 724 1300 691 1301 1042 1332 1419 1461 1548 1551 651 1280 1269 1380 784
- 1269 1013 1318 1470 1496 1214 1356 1154 1313 1086 1300 1654 1659 1592 1609 1217
- 1363 1348 1411 1117 1302 1123 1335 653 1287 1182 1350 1208 1368 1427 1492 1399
- 1454 1477 1525 757 1261 623 1294 1282 1378 825 1305 1080 1332 1523 1563 1637
- 1656 1360 1455 1376 1454 722 1256 783 1286 1281 1394 873 1297 751 1267 842 1297
- 1285 1375 100 { m20} R 1257 1384 851 1291 1140 1321 1010 1294 1563 1568 1183
- 1349 1084 1291 1165 1339 1167 1366 1422 1460 502 1362 1266 1402 1173 1368 1663
- 1671 1115 1314 1033 1280 844 1257 509 1306 1279 1388 883 1266 910 1263 799 1271
- 1258 1363 929 1273 1536 1551 1539 1547 1334 1409 771 1309 1424 1484 1099 1301
- 558 1325 1517 1538 793 1278 1344 1426 1233 1358 1313 1411 1222 1370 1199 1361
- 1419 1471 1306 1415 1175 1346 1153 1355 875 1287 799 1277 921 1293 870 1270
- 1522 1541 787 1259 824 1310 1264 1373 1326 1395 632 1324 1065 1311 1169 1359
- 1000 1293 567 1345 946 1294 1249 1397 1358 1427 768 1279 60 { m20} R 0.14545
- 0.8 0 c 1535 1582 1150 1381 1362 1510 1507 1594 1213 1387 1397 1489 1408 1528
- 1308 1473 1342 1496 896 1357 887 1324 975 1338 1409 1509 933 1320 1652 1691
- 1306 1459 1022 1382 1645 1681 1418 1521 984 1343 1436 1522 1592 1637 1138 1374
- 1312 1441 1087 1364 1640 1689 1280 1430 1411 1499 1150 1364 1359 1502 678 1332
- 1411 1535 1054 1365 938 1386 1587 1616 1405 1489 1609 1663 878 1321 1645 1681
- 1673 1692 1547 1618 1001 1386 1363 1510 1153 1420 697 1356 1601 1650 1256 1435
- 495 1450 940 1325 738 1351 1276 1431 1190 1388 1408 1519 925 1347 1341 1487
- 1520 1603 1380 1504 1125 1387 1015 1366 1214 1425 950 1374 1562 1603 1514 1559
- 759 1334 1419 1532 866 1322 1071 1387 812 1331 1254 1445 1433 1511 764 1374
- 1078 1349 1308 1438 1377 1497 1615 1640 1618 1674 1318 1488 792 1329 1033 1335
- 1201 1424 1262 1410 1074 1397 1113 1392 984 1351 1139 1420 1362 1473 1600 1627
- 1346 1492 456 1466 1544 1584 1261 1410 670 1359 1671 1708 811 1319 810 1318
- 1540 1618 1010 1380 1545 1591 1173 1375 1035 1334 100 { m20} R 545 1369 778
- 1317 1039 1399 1498 1592 923 1378 1215 1433 1333 1455 1401 1509 1062 1379 886
- 1312 1201 1411 1456 1561 1267 1415 1297 1437 1062 1358 737 1376 1212 1431 1197
- 1420 899 1321 1298 1435 1362 1490 1628 1687 1027 1343 1447 1538 1153 1396 1193
- 1405 1649 1698 519 1420 1400 1526 885 1372 1176 1405 1552 1630 1539 1618 1168
- 1425 1360 1488 1425 1532 1131 1385 968 1325 992 1347 1254 1421 1626 1665 1549
- 1599 993 1361 660 1341 1418 1531 1337 1495 1038 1373 1425 1502 1258 1438 1649
- 1695 1113 1401 1401 1484 1399 1507 1091 1395 1518 1574 1057 1378 1234 1443 704
- 1348 1438 1537 1439 1524 1353 1477 853 1333 1161 1412 1327 1440 1507 1596 1389
- 1487 1292 1452 1210 1416 1185 1418 939 1352 886 1351 1353 1491 1516 1579 1523
- 1582 1206 1418 1621 1677 1328 1452 1531 1585 902 1331 1115 1353 951 1364 934
- 1361 1280 1423 1011 1370 1575 1615 900 1312 978 1339 893 1351 1093 1357 1167
- 1397 1581 1624 897 1367 1147 1412 1389 1508 1208 1407 1016 1350 1496 1576 1162
- 1386 1393 1505 1564 1637 100 { m20} R 1400 1491 1609 1646 1098 1356 856 1346
- 1126 1401 1565 1607 1065 1361 1374 1503 1142 1385 1115 1363 1509 1581 1585 1616
- 1404 1501 1083 1354 949 1371 1011 1357 1216 1388 1064 1374 1530 1604 1050 1347
- 1624 1676 1462 1533 1132 1380 1231 1431 1071 1355 770 1324 1149 1410 1633 1680
- 1151 1368 1330 1446 1115 1369 959 1352 1449 1542 1387 1506 1544 1600 1265 1440
- 36 { m20} R 0.29091 0.8 0 c 1325 1547 981 1401 1109 1440 1426 1551 1586 1690
- 1554 1670 1610 1721 1246 1525 1369 1544 957 1406 1323 1550 1493 1616 1265 1469
- 1236 1469 798 1470 950 1426 1390 1548 1144 1481 1163 1444 1093 1432 893 1395
- 1524 1641 1334 1528 1479 1607 777 1424 1338 1547 1613 1720 1297 1520 917 1410
- 925 1434 1010 1424 793 1414 1521 1653 1448 1593 1531 1634 1042 1474 1414 1586
- 841 1450 1389 1527 831 1460 1628 1706 1117 1465 1363 1530 1546 1627 1445 1583
- 1178 1441 1178 1492 1451 1616 1026 1462 827 1413 1495 1639 1476 1631 1502 1607
- 1382 1576 827 1412 1348 1545 1541 1675 997 1411 1474 1611 974 1403 1354 1548
- 1463 1606 1461 1601 1614 1683 1130 1441 849 1398 1546 1643 1482 1627 977 1446
- 1569 1692 1543 1628 1228 1504 1576 1668 1339 1528 850 1455 1323 1525 964 1415
- 1316 1524 1442 1558 1473 1600 836 1413 1058 1427 978 1445 1364 1548 1150 1440
- 1028 1401 1492 1605 1144 1438 1517 1661 1279 1477 1459 1625 1607 1720 1354 1554
- 1222 1493 1003 1450 1038 1438 1105 1477 718 1412 1303 1504 1613 1682 100 { m20
-} R 1377 1570 1561 1643 1380 1545 1530 1657 1538 1664 1555 1657 1558 1653 1339
- 1508 1096 1472 988 1401 1132 1482 888 1395 1633 1700 1291 1502 1196 1458 1255
- 1504 1290 1516 956 1441 1530 1616 1256 1478 704 1471 1606 1703 1539 1625 1235
- 1516 1507 1632 1474 1584 1037 1476 926 1446 1289 1537 1632 1694 980 1415 1255
- 1471 1165 1471 1592 1712 1237 1496 1380 1556 1522 1619 978 1426 1486 1622 1148
- 1484 1508 1646 1340 1502 1552 1636 1608 1723 1305 1498 1180 1458 1445 1582 1288
- 1522 1103 1478 1196 1453 398 1588 1189 1445 1510 1602 814 1429 1205 1492 1409
- 1586 1451 1582 964 1426 1288 1485 1248 1478 1453 1596 1218 1453 836 1413 1381
- 1580 1453 1580 1223 1476 1419 1585 646 1472 1323 1505 1574 1651 1242 1481 1427
- 1552 1616 1688 1436 1574 1113 1455 1190 1450 1457 1590 1388 1525 1145 1436 1389
- 1561 1432 1556 1247 1472 1352 1555 1311 1547 1310 1547 1173 1446 1250 1476 1183
- 1443 1513 1631 1572 1698 1039 1453 1548 1642 1517 1610 1459 1617 849 1419 1352
- 1557 1031 1470 1333 1518 1269 1506 1470 1583 100 { m20} R 1507 1609 1306 1509
- 1028 1471 1553 1643 1409 1539 1360 1536 1407 1564 1629 1719 1400 1538 1645 1715
- 1515 1607 1451 1582 1482 1619 1084 1429 1392 1576 1226 1477 1108 1440 1219 1498
- 1304 1534 1441 1614 1252 1512 1420 1569 1527 1641 1195 1500 1072 1473 25 { m20
-} R 0.43636 0.8 0 c 1252 1546 1524 1719 1536 1697 824 1573 1571 1750 1096 1488
- 1119 1523 1352 1606 1427 1620 1561 1699 1468 1663 1215 1577 1432 1663 1098 1501
- 1050 1513 1351 1633 1130 1530 1412 1666 811 1510 1103 1492 1372 1584 1378 1652
- 1115 1490 1358 1633 1267 1600 830 1542 1353 1605 1396 1602 1282 1592 1229 1530
- 1455 1668 975 1481 1417 1609 693 1508 1227 1529 1043 1485 1307 1564 1002 1555
- 1191 1545 1227 1530 1483 1698 1333 1630 1438 1662 914 1474 899 1471 1365 1640
- 1154 1515 1256 1567 1522 1725 1573 1737 1247 1593 1017 1495 1453 1661 1348 1604
- 1249 1594 1255 1555 1262 1533 1393 1613 1419 1648 1249 1585 1509 1722 1362 1647
- 1587 1715 1064 1484 1241 1528 1461 1691 1422 1647 1151 1544 1424 1618 775 1488
- 1369 1621 1416 1631 1351 1630 1344 1581 551 1549 1474 1657 1597 1718 1158 1570
- 1125 1493 1205 1588 954 1470 1369 1639 1384 1638 1558 1728 1522 1666 1459 1652
- 1539 1682 1429 1643 1101 1524 1536 1722 1358 1630 1092 1515 1546 1712 1377 1615
- 1322 1605 1307 1580 1555 1708 1153 1553 1320 1615 957 1495 100 { m20} R 1482
- 1648 1252 1569 1479 1701 1475 1687 1557 1717 1536 1730 1535 1721 1373 1606 1459
- 1655 1532 1703 1268 1568 1564 1738 1493 1683 1494 1685 1468 1632 1296 1588 1411
- 1622 1248 1579 1333 1593 1474 1699 1476 1690 1520 1686 992 1508 1192 1543 1142
- 1508 1241 1570 1418 1607 1428 1622 1348 1571 1334 1629 1326 1561 1025 1509 999
- 1489 1574 1743 1249 1601 1401 1645 1130 1525 1564 1746 1104 1512 1415 1611 1359
- 1590 1441 1676 1515 1669 1133 1521 1200 1573 1516 1711 916 1491 1410 1649 1569
- 1754 1359 1599 1239 1585 1435 1680 52 { m20} R 0.58182 0.8 0 c 999 1566 1489
- 1760 1407 1702 1310 1689 1441 1715 1176 1650 1387 1705 1406 1690 1329 1718 1522
- 1806 1482 1767 1321 1684 1378 1727 1259 1633 1441 1756 1017 1608 1438 1707 1531
- 1786 1481 1714 953 1606 1509 1733 1173 1588 1290 1652 1359 1684 1372 1692 1161
- 1601 1186 1631 1246 1633 1450 1711 1503 1782 1364 1675 1513 1772 1448 1740 981
- 1575 1468 1772 1535 1782 1438 1722 1131 1598 909 1599 1435 1740 1457 1768 1217
- 1601 841 1590 1490 1787 1486 1736 1271 1688 1071 1610 1508 1764 1223 1678 1388
- 1663 1101 1618 1501 1786 1136 1579 1361 1664 1210 1633 1503 1792 1467 1710 1454
- 1758 1544 1773 1495 1749 1279 1660 1422 1701 1474 1774 1417 1730 1144 1608 1461
- 1771 1099 1638 1354 1645 1385 1728 1311 1651 1382 1717 1497 1752 1179 1645 1541
- 1756 1330 1664 1486 1736 1435 1682 1461 1738 1373 1726 864 1639 1122 1627 1312
- 1690 82 { m20} R 0.72727 0.8 0 c 1249 1701 1370 1734 1278 1709 1481 1785 1501
- 1805 1392 1782 1481 1822 1127 1687 1076 1709 1409 1808 1375 1772 1453 1849 870
- 1682 1416 1767 974 1733 1057 1693 1461 1830 1441 1801 1490 1829 1269 1702 1211
- 1695 1364 1768 1473 1799 1411 1766 1331 1725 1439 1850 1372 1783 1490 1841 1428
- 1798 1313 1754 1281 1715 1428 1797 1421 1788 1487 1795 893 1742 1401 1787 1486
- 1814 1230 1703 1177 1698 1358 1818 1329 1743 1490 1795 42 { m20} R 0.8 0.72727
- 0 c 1412 1899 1373 1874 1457 1887 1316 1823 1014 1852 1293 1847 1442 1906 1400
- 1863 1174 1805 1459 1872 1212 1828 1300 1890 1354 1823 1311 1842 1317 1905 1397
- 1837 1008 1809 1161 1781 1330 1884 1251 1829 1158 1860 1373 1878 1326 1853 1370
- 1876 1468 1882 25 { m20} R 0.8 0.58182 0 c 1289 1961 1406 1950 1245 1945 1340
- 1922 1274 1937 1146 1929 6 { m20} R 0.8 0.43636 0 c 1328 2039 1283 2053 2 { m20
-} R 0.8 0.29091 0 c 1328 2039 0.8 0.14546 0 c 1328 2039 0 0 0.8 c 1328 2039 0
- 0.14545 0.8 c 1328 2039 0 0.29091 0.8 c 894 1106 850 1084 2 { m20} R 0 0.43636
- 0.8 c 963 1118 846 1074 910 1097 3 { m20} R 0 0.58182 0.8 c 888 1074 784 1040
- 773 1037 1027 1145 838 1057 1087 1180 848 1059 857 1062 787 1042 999 1131 756
- 1033 1198 1243 1124 1204 13 { m20} R 0 0.72727 0.8 c 800 1046 995 1118 1285
- 1294 857 1062 1047 1143 977 1109 1275 1297 752 1038 998 1121 987 1114 752 1036
- 763 1039 825 1053 860 1064 1239 1268 746 1032 851 1065 1073 1160 1585 1597 1321
- 1332 1336 1338 889 1074 952 1099 1073 1158 944 1095 810 1048 765 1038 734 1038
- 725 1033 847 1063 1057 1148 1431 1422 1062 1150 838 1061 802 1046 864 1067 1006
- 1124 817 1050 896 1076 776 1040 719 1032 823 1056 1240 1264 879 1073 776 1039
- 732 1037 1142 1196 969 1106 938 1094 983 1113 1179 1220 892 1078 814 1051 53 {
- m20} R 0 0.8 0.72727 c 722 1038 975 1112 900 1082 958 1112 1135 1192 672 1052
- 835 1071 873 1073 698 1045 898 1083 724 1047 1140 1194 888 1089 1379 1369 867
- 1084 886 1083 1116 1180 740 1045 701 1045 756 1051 763 1063 732 1041 774 1056
- 685 1052 848 1068 670 1056 729 1053 958 1111 820 1065 851 1067 996 1120 872
- 1076 666 1050 745 1051 1056 1152 1124 1187 859 1070 828 1062 869 1075 734 1051
- 840 1064 707 1055 1390 1377 851 1080 890 1083 875 1078 843 1069 841 1074 1297
- 1300 925 1093 1049 1145 985 1122 704 1045 926 1094 741 1052 864 1074 718 1045
- 953 1111 882 1078 820 1066 696 1037 1016 1130 893 1085 875 1084 762 1059 714
- 1046 1087 1166 903 1089 765 1054 801 1053 875 1086 699 1042 911 1089 914 1087
- 1072 1156 668 1051 882 1077 822 1071 1018 1133 685 1044 1469 1440 1025 1132
- 1349 1338 678 1053 948 1108 1066 1153 811 1070 999 1121 1113 1180 887 1079 745
- 1058 787 1053 1045 1143 693 1041 776 1051 892 1084 905 1095 849 1075 1222 1245
- 857 1068 100 { m20} R 721 1048 776 1061 937 1097 850 1066 680 1043 686 1053
- 1469 1445 736 1055 1386 1369 9 { m20} R 0 0.8 0.58182 c 751 1091 781 1069 723
- 1063 663 1070 936 1114 1262 1278 650 1087 862 1107 761 1078 980 1126 817 1085
- 728 1087 745 1064 1032 1159 923 1110 1177 1227 1341 1332 666 1072 1103 1186 905
- 1096 1537 1498 869 1093 928 1111 847 1101 675 1087 848 1106 920 1120 970 1124
- 780 1089 944 1120 768 1093 889 1109 1132 1199 773 1085 1025 1149 1106 1180 1045
- 1152 1010 1150 811 1087 922 1111 991 1139 682 1078 1041 1161 922 1120 820 1098
- 647 1075 1146 1200 681 1070 846 1083 732 1082 754 1067 701 1065 886 1111 1085
- 1177 773 1077 739 1079 1028 1156 1047 1154 859 1087 660 1066 1010 1140 997 1130
- 914 1101 1235 1258 914 1107 743 1066 711 1085 903 1100 631 1078 703 1066 711
- 1064 735 1063 773 1066 873 1092 878 1101 839 1093 886 1113 750 1065 1015 1148
- 701 1083 1410 1386 654 1079 709 1081 1198 1237 991 1142 899 1112 1180 1225 1272
- 1280 1263 1277 786 1092 704 1078 831 1094 1248 1264 691 1073 1031 1144 1092
- 1182 1205 1240 960 1131 1098 1186 770 1081 100 { m20} R 696 1077 979 1129 692
- 1062 665 1079 834 1095 1059 1162 986 1131 781 1070 1675 1643 786 1081 732 1085
- 647 1090 1055 1154 1011 1136 651 1086 826 1102 909 1112 1126 1200 756 1075 807
- 1084 1047 1154 1031 1154 704 1072 720 1063 918 1104 960 1114 717 1060 928 1107
- 663 1076 1007 1139 641 1077 1300 1301 912 1108 646 1082 866 1089 728 1072 641
- 1077 733 1085 1408 1384 703 1063 650 1084 846 1091 42 { m20} R 0 0.8 0.43636 c
- 616 1129 709 1120 1209 1248 803 1130 776 1106 858 1137 996 1164 1226 1261 842
- 1120 902 1144 1285 1304 1070 1197 1025 1166 1022 1165 1032 1182 909 1151 1028
- 1165 891 1124 727 1112 596 1133 1312 1323 668 1119 846 1110 1188 1247 911 1152
- 753 1119 754 1118 1020 1158 1058 1193 961 1162 757 1096 1741 1710 665 1121 598
- 1109 896 1133 1174 1245 1037 1165 1014 1156 845 1128 1542 1504 897 1137 1148
- 1224 1199 1259 767 1114 893 1143 843 1130 651 1092 828 1127 897 1138 735 1130
- 651 1118 639 1114 1253 1275 1139 1225 1286 1305 970 1163 953 1132 1056 1182
- 1066 1178 752 1100 916 1134 822 1108 976 1145 729 1100 1095 1205 1564 1526 1409
- 1389 1332 1329 650 1091 977 1148 639 1119 598 1121 644 1110 1100 1197 773 1096
- 847 1107 866 1112 1086 1183 1100 1191 674 1094 907 1144 917 1124 971 1155 671
- 1116 982 1157 935 1132 670 1131 1330 1332 609 1099 643 1122 635 1093 884 1132
- 911 1140 666 1121 710 1100 956 1163 790 1102 677 1106 1065 1187 907 1137 100 {
- m20} R 766 1111 878 1114 689 1101 844 1106 1177 1237 866 1133 1167 1236 621
- 1123 1083 1195 1054 1171 921 1140 1076 1186 744 1113 648 1092 795 1133 709 1130
- 1209 1256 582 1137 850 1131 880 1114 1020 1175 1060 1181 859 1130 735 1098 1021
- 1167 825 1117 1031 1164 1065 1193 1049 1183 947 1146 976 1155 720 1094 635 1132
- 871 1112 609 1098 643 1129 737 1123 1166 1235 662 1132 672 1099 623 1112 1303
- 1313 602 1118 624 1099 1365 1358 1200 1248 950 1153 919 1149 928 1130 1474 1443
- 1004 1166 1343 1348 1305 1319 723 1111 1022 1182 957 1161 1196 1257 1224 1269
- 766 1117 1141 1220 1226 1269 957 1134 741 1124 1101 1207 1001 1158 1014 1166
- 696 1118 892 1149 614 1093 757 1122 650 1128 880 1129 781 1126 1071 1191 670
- 1124 715 1099 986 1144 1012 1171 653 1119 918 1134 1045 1188 969 1153 946 1159
- 892 1144 772 1130 959 1150 1023 1168 1612 1574 836 1134 612 1105 988 1156 994
- 1146 1019 1180 1051 1180 1067 1196 859 1138 908 1137 981 1154 955 1141 790 1117
- 100 { m20} R 1324 1332 1106 1211 979 1142 1080 1184 748 1126 676 1123 6 { m20
-} R 0 0.8 0.29091 c 931 1172 616 1170 1556 1524 1177 1256 771 1157 1116 1229 865
- 1170 939 1185 1389 1400 978 1194 636 1180 930 1172 1380 1374 1251 1305 636 1159
- 917 1162 1117 1250 985 1189 721 1180 1084 1234 948 1163 956 1179 852 1144 1080
- 1207 1570 1543 902 1164 650 1156 1359 1372 799 1171 821 1183 993 1201 1392 1397
- 965 1195 1251 1316 1226 1297 1063 1223 596 1178 868 1183 604 1151 739 1165 1049
- 1199 897 1154 707 1163 753 1145 1173 1252 1110 1228 759 1147 1279 1325 1009
- 1184 1152 1240 702 1151 1055 1212 1217 1293 686 1177 1254 1314 1404 1398 1047
- 1222 890 1162 1109 1219 1007 1186 928 1170 667 1163 661 1153 986 1211 820 1139
- 1287 1336 1335 1352 871 1188 1217 1282 1174 1259 943 1201 1359 1360 543 1200
- 1557 1527 785 1148 1007 1205 824 1183 647 1139 1046 1225 588 1156 1101 1233 746
- 1175 1075 1208 937 1162 970 1205 877 1158 1015 1208 1222 1301 803 1138 1019
- 1199 1152 1245 689 1186 786 1158 882 1156 1042 1205 760 1146 1057 1221 695 1170
- 818 1166 909 1177 100 { m20} R 923 1161 1412 1399 594 1156 988 1180 1037 1198
- 765 1142 1226 1303 1244 1303 1372 1383 576 1162 1632 1603 785 1137 919 1196 653
- 1160 637 1179 1260 1301 1128 1227 1664 1629 715 1166 1513 1485 989 1199 915
- 1162 1168 1254 1002 1183 1217 1280 1544 1510 1038 1196 1589 1554 654 1166 1428
- 1429 1054 1200 816 1175 900 1166 1222 1275 825 1167 1224 1291 1198 1280 904
- 1191 872 1160 555 1203 791 1154 925 1165 1485 1472 905 1153 779 1156 564 1179
- 784 1174 871 1164 811 1179 645 1148 572 1154 766 1153 584 1170 1214 1269 986
- 1202 936 1189 1196 1260 1231 1282 1291 1331 780 1146 653 1188 802 1159 959 1188
- 1327 1347 1014 1188 1184 1274 631 1139 1104 1219 750 1133 1343 1357 737 1166
- 1291 1323 842 1156 1166 1274 676 1162 1291 1317 837 1150 1278 1307 1121 1249
- 775 1144 705 1148 656 1154 1052 1210 1779 1757 1449 1443 826 1167 929 1192 818
- 1140 548 1193 659 1139 1016 1197 607 1181 626 1157 754 1151 848 1160 1005 1200
- 1162 1260 766 1152 785 1172 1008 1188 100 { m20} R 923 1173 1219 1279 990 1205
- 1228 1291 1133 1247 1412 1408 1344 1358 1079 1220 1074 1229 917 1175 908 1165
- 767 1149 993 1181 1404 1396 998 1192 1027 1205 935 1170 735 1151 1440 1433 1065
- 1224 911 1183 738 1148 22 { m20} R 0 0.8 0.14545 c 1056 1235 870 1217 1107 1260
- 1346 1378 1023 1240 554 1218 716 1232 792 1231 1082 1244 897 1204 1162 1308
- 1230 1334 1027 1240 854 1210 1415 1440 1050 1237 871 1218 1158 1295 981 1213
- 942 1213 856 1192 1325 1368 886 1227 1196 1305 1212 1321 1219 1302 1409 1441
- 1126 1283 1171 1309 902 1211 663 1207 864 1198 767 1207 1614 1602 925 1207 1306
- 1352 980 1252 1141 1267 1458 1471 1025 1248 1082 1242 1059 1247 758 1214 875
- 1197 1370 1395 922 1218 1020 1251 723 1232 1445 1444 1698 1675 1322 1387 1195
- 1306 618 1247 831 1233 680 1194 966 1215 1412 1437 973 1242 1135 1279 921 1251
- 1363 1411 1173 1286 1287 1352 836 1207 754 1214 779 1187 864 1223 1085 1273
- 1105 1250 1432 1452 837 1194 1453 1471 1224 1335 1267 1351 1512 1496 1277 1339
- 1345 1405 1001 1261 860 1233 1602 1594 1323 1371 1536 1538 1206 1298 738 1242
- 1112 1271 1139 1265 789 1203 1019 1250 964 1218 1414 1434 1462 1471 917 1225
- 1269 1346 1208 1307 746 1235 1626 1614 1035 1243 896 1198 1389 1429 1252 1344
- 100 { m20} R 1049 1241 1759 1736 1117 1261 973 1248 719 1192 739 1220 1662 1635
- 1690 1674 551 1248 1112 1296 1368 1394 1017 1225 557 1216 1428 1433 1436 1447
- 1346 1379 946 1220 1742 1724 709 1225 929 1207 1207 1317 1266 1344 904 1222 806
- 1217 584 1245 938 1250 977 1227 621 1214 1163 1305 600 1210 1209 1300 1175 1309
- 1673 1660 1340 1393 813 1217 1247 1338 1146 1271 1316 1375 1026 1243 1426 1432
- 764 1226 1289 1364 1101 1274 961 1220 1056 1235 1207 1315 1326 1381 1002 1258
- 824 1212 606 1263 1555 1541 1428 1453 1097 1286 1073 1253 1028 1225 985 1257
- 1682 1666 1213 1305 995 1256 1225 1320 1115 1278 798 1215 769 1191 1032 1244
- 1154 1287 746 1203 1246 1334 927 1215 1264 1332 1288 1349 544 1249 521 1232
- 1119 1257 636 1205 1232 1320 1194 1295 904 1230 1035 1233 1311 1352 1171 1286
- 1177 1317 1317 1363 1139 1291 1374 1422 1120 1283 852 1222 1084 1255 1574 1563
- 1133 1269 1343 1384 1696 1680 1332 1368 848 1221 876 1245 804 1187 1578 1564
- 776 1188 1307 1353 991 1239 1022 1242 100 { m20} R 904 1235 612 1223 1143 1302
- 1102 1289 807 1219 1156 1310 1140 1291 931 1252 836 1228 631 1202 810 1233 827
- 1230 1463 1465 815 1236 1240 1316 1161 1300 1056 1250 1393 1435 1056 1258 1378
- 1405 670 1219 1332 1374 773 1231 1284 1349 741 1205 1493 1486 1196 1293 705
- 1224 930 1230 1085 1263 728 1194 1520 1512 1171 1298 1080 1256 1101 1256 1126
- 1282 793 1214 724 1244 1093 1266 992 1219 1253 1330 734 1203 546 1274 647 1215
- 1230 1343 798 1187 566 1223 805 1211 545 1254 1338 1370 1000 1244 627 1258 689
- 1194 1274 1338 666 1219 771 1217 876 1201 1228 1338 946 1219 1179 1290 1583
- 1577 1189 1288 772 1207 63 { m20} R 0 0.8 0.4069E-06 c 1112 1344 1116 1341 1389
- 1440 1640 1633 1102 1306 1370 1459 929 1305 927 1253 1542 1554 1666 1680 1396
- 1477 916 1254 1363 1451 1267 1386 1065 1290 1060 1281 1387 1467 1401 1476 1209
- 1378 1127 1312 999 1282 1257 1384 1308 1390 1334 1423 1111 1334 1252 1355 1328
- 1412 1579 1602 1269 1403 1070 1312 795 1308 1597 1604 1122 1303 1134 1319 1091
- 1311 1226 1381 1307 1397 766 1268 993 1311 689 1251 1605 1618 1453 1486 1239
- 1372 1168 1347 1087 1317 1465 1495 1071 1288 1304 1420 1128 1332 1556 1578 1219
- 1341 1040 1288 785 1290 1282 1398 689 1297 1318 1401 1157 1358 1663 1661 1229
- 1368 1374 1442 1073 1311 984 1268 1245 1374 1391 1470 744 1256 1273 1373 615
- 1279 1395 1470 831 1271 1343 1419 1494 1525 801 1278 1282 1395 1483 1532 1451
- 1501 1219 1362 777 1301 1613 1623 1454 1498 561 1344 1227 1348 1452 1515 832
- 1281 1530 1561 995 1279 1294 1420 825 1278 1107 1328 1057 1299 975 1264 772
- 1287 1513 1552 640 1320 1631 1639 542 1319 1637 1657 1732 1726 1046 1324 1321
- 1395 1681 1676 100 { m20} R 1225 1356 1177 1371 1265 1394 715 1261 524 1359 759
- 1278 1549 1555 1264 1374 885 1296 1542 1556 1278 1408 753 1267 821 1244 835
- 1301 1524 1564 1249 1392 1294 1419 1182 1333 1375 1462 1370 1460 1251 1384 733
- 1298 666 1256 1137 1325 927 1254 1497 1535 993 1278 1125 1308 761 1277 1268
- 1374 1331 1421 656 1321 1261 1375 780 1284 1020 1274 1345 1446 1158 1320 596
- 1290 1124 1337 791 1246 626 1273 1153 1349 1305 1416 1225 1377 537 1335 1533
- 1572 1319 1408 1719 1714 1490 1508 1384 1469 1324 1405 1433 1467 1435 1471 1307
- 1424 851 1283 640 1287 1430 1496 1386 1436 921 1297 615 1267 940 1271 1192 1363
- 898 1288 1227 1379 1350 1444 1048 1319 1057 1327 1185 1342 1181 1364 1408 1472
- 955 1288 1357 1442 1086 1326 516 1288 1126 1307 1189 1366 1363 1455 1231 1353
- 810 1263 1327 1420 1371 1440 1706 1705 1398 1463 609 1311 1370 1433 1514 1526
- 1393 1471 1708 1697 1590 1607 1234 1368 782 1252 1230 1358 1563 1595 1046 1299
- 1099 1338 1047 1295 1337 1438 1354 1444 1030 1282 1195 1372 100 { m20} R 1584
- 1612 1642 1655 692 1260 1187 1369 1017 1299 969 1301 545 1347 1093 1312 1239
- 1385 589 1284 869 1288 783 1285 839 1260 1303 1418 567 1324 987 1277 889 1295
- 716 1272 1252 1369 492 1334 1011 1281 778 1295 973 1301 918 1278 712 1263 1174
- 1362 1192 1338 1540 1577 1509 1554 1119 1321 1299 1384 1230 1376 1220 1348 1398
- 1452 1427 1482 1156 1362 1336 1403 1248 1368 1283 1402 1324 1406 1351 1450 1611
- 1634 1149 1345 1305 1391 944 1260 1158 1360 1153 1340 620 1280 1060 1298 1358
- 1446 1195 1343 1478 1524 1268 1387 952 1303 1231 1356 985 1305 1320 1425 555
- 1307 1160 1336 1246 1384 1311 1408 1140 1346 1338 1405 863 1262 774 1252 615
- 1274 1393 1461 1282 1402 1214 1344 866 1284 70 { m20} R 0.14545 0.8 0 c 1080
- 1390 1478 1540 1612 1673 1524 1589 876 1356 1410 1506 1402 1496 1408 1500 1309
- 1452 1195 1432 1240 1452 1181 1432 1426 1504 1192 1413 1331 1476 1487 1577 1326
- 1439 1439 1542 1236 1447 951 1318 1047 1353 944 1377 943 1326 835 1384 1349
- 1472 1119 1389 1287 1468 1161 1400 1317 1488 965 1323 1656 1690 1529 1575 960
- 1339 1590 1620 1244 1418 986 1391 1085 1367 1197 1421 1011 1337 726 1326 1599
- 1648 905 1359 659 1341 1316 1466 1557 1607 1442 1540 1391 1490 994 1327 844
- 1380 1175 1381 1593 1644 1111 1370 1120 1375 494 1387 1102 1369 1336 1451 1274
- 1463 1277 1444 1182 1424 1287 1427 1597 1654 948 1328 976 1367 1015 1335 1137
- 1368 1677 1698 1611 1642 1064 1402 1136 1378 1405 1488 1670 1707 1602 1669 1390
- 1478 1204 1395 1320 1446 1517 1602 1203 1397 693 1339 1093 1369 735 1319 1442
- 1512 1442 1533 1253 1456 1380 1470 1474 1562 635 1360 1557 1598 1331 1443 993
- 1391 1286 1432 1274 1422 1432 1510 1449 1513 1562 1622 1315 1449 1445 1553 1291
- 1430 1058 1399 1670 1709 1044 1349 100 { m20} R 1191 1380 1522 1567 1458 1554
- 932 1343 717 1362 1473 1542 1492 1553 1525 1602 1286 1424 1683 1707 1046 1346
- 1492 1548 1378 1501 710 1344 1339 1494 1111 1352 1047 1391 1136 1360 1470 1566
- 1656 1698 1369 1487 1458 1561 1594 1649 940 1339 1349 1465 1184 1431 1345 1457
- 1604 1657 1082 1367 1530 1606 1498 1576 1536 1596 1101 1365 1420 1533 1198 1389
- 1444 1545 1004 1327 982 1337 1619 1646 807 1317 687 1342 1232 1412 1424 1542
- 1379 1480 1350 1465 1444 1543 941 1323 1248 1450 1232 1416 848 1341 1562 1595
- 1343 1486 1621 1681 647 1402 1327 1459 992 1333 1053 1395 881 1317 995 1344 984
- 1326 1170 1395 1611 1668 1558 1602 1036 1381 1296 1459 1531 1577 665 1349 1479
- 1550 1371 1481 1408 1515 1466 1561 908 1342 818 1329 1247 1449 1417 1514 1466
- 1550 1007 1369 484 1399 1145 1362 1326 1445 1383 1487 1375 1510 1474 1546 689
- 1339 1208 1400 1494 1552 1101 1360 1615 1652 1149 1397 1263 1430 1600 1661 1560
- 1618 1560 1598 1027 1361 871 1383 1075 1362 1221 1403 1533 1584 644 1372 1633
- 1668 100 { m20} R 1598 1655 1302 1454 927 1353 1109 1355 1522 1580 1076 1354
- 1189 1399 936 1354 1376 1492 822 1318 912 1333 1176 1373 916 1347 977 1379 1313
- 1460 1257 1413 1209 1393 1146 1410 729 1349 1353 1498 1386 1492 1509 1589 1462
- 1561 1476 1531 1266 1424 1558 1603 1044 1356 1163 1385 1361 1488 664 1367 1244
- 1413 1615 1647 1353 1486 1430 1518 1503 1596 1549 1621 1240 1428 1293 1446 1115
- 1379 1171 1426 1149 1397 1399 1509 774 1338 801 1383 1288 1458 1470 1564 504
- 1438 1312 1463 1304 1478 1360 1499 1149 1391 1479 1557 1098 1357 53 { m20} R
- 0.29091 0.8 0 c 1048 1401 1433 1591 1088 1443 740 1433 1570 1649 1240 1495 1317
- 1518 1394 1590 1510 1644 1555 1674 1225 1472 1030 1442 1383 1579 1193 1472 1074
- 1438 1334 1541 1236 1519 1597 1714 1336 1506 1055 1467 1445 1604 1606 1690 1453
- 1586 868 1460 1573 1677 1586 1707 1237 1515 1423 1577 1373 1576 1558 1671 1209
- 1471 1557 1643 1582 1701 1324 1525 1550 1662 1551 1668 1167 1472 1092 1444 1454
- 1610 1599 1700 1106 1416 879 1419 1342 1551 1227 1500 868 1441 1254 1496 1318
- 1491 975 1445 1486 1635 1520 1631 1285 1497 1280 1539 1103 1459 1089 1462 1430
- 1564 1314 1496 1356 1566 866 1410 1119 1419 1461 1592 1508 1622 1487 1603 1184
- 1499 1188 1479 1552 1636 1539 1640 1471 1591 1012 1443 1179 1494 1028 1460 1105
- 1450 1352 1560 1191 1442 1053 1463 1505 1607 1352 1534 1269 1529 1433 1599 1432
- 1567 1601 1691 1037 1418 1138 1460 1338 1535 1276 1483 1117 1425 1480 1611 1470
- 1585 1298 1520 1394 1553 1191 1481 1244 1465 1595 1689 1216 1460 1489 1641 1425
- 1606 1096 1427 1422 1594 1533 1618 1410 1555 1608 1675 100 { m20} R 1264 1491
- 1059 1406 1495 1624 1436 1602 1444 1574 1330 1532 1076 1412 1096 1416 967 1450
- 1401 1572 1073 1449 1387 1565 1117 1472 1483 1587 1401 1572 1419 1598 1537 1634
- 1498 1597 1562 1669 1444 1571 1033 1402 1401 1546 1420 1591 883 1427 1395 1580
- 1578 1655 1459 1586 1153 1489 1495 1613 1173 1501 833 1450 1403 1536 1296 1526
- 1590 1683 1172 1434 1137 1442 1238 1503 973 1411 1221 1449 1363 1523 1585 1662
- 1233 1459 762 1417 1355 1535 1389 1556 1385 1536 1275 1493 1391 1574 1122 1443
- 1626 1715 1502 1636 1149 1465 1182 1483 1404 1569 1241 1487 1022 1414 1398 1540
- 1471 1624 1472 1585 1338 1546 1580 1661 790 1410 1325 1511 1509 1635 1264 1514
- 1505 1644 1313 1494 1074 1482 1072 1443 1497 1630 1299 1481 1350 1544 1562 1682
- 1380 1546 1181 1449 698 1457 1414 1560 1545 1629 1344 1526 1453 1605 1543 1677
- 1305 1535 1377 1537 1361 1546 697 1432 1585 1686 1548 1655 1194 1491 1603 1709
- 1314 1506 1213 1480 1535 1633 1362 1513 1488 1639 1286 1479 1627 1715 1298 1499
- 1196 1472 584 1444 1553 1685 100 { m20} R 864 1434 1362 1515 1364 1557 820 1392
- 757 1461 1478 1606 1562 1644 1431 1585 1541 1640 1023 1410 1266 1499 1388 1548
- 1342 1545 1127 1436 1441 1581 1618 1706 802 1410 1277 1475 1324 1507 19 { m20
-} R 0.43636 0.8 0 c 1383 1642 1426 1632 1042 1543 1560 1722 1491 1675 933 1512
- 1335 1607 1488 1671 1594 1717 1266 1566 1483 1660 1522 1684 1534 1708 1050 1557
- 1389 1638 1407 1630 1307 1573 1253 1537 1235 1599 802 1532 1328 1579 1536 1709
- 952 1532 1449 1649 1396 1611 1196 1562 1412 1634 1281 1567 1316 1565 1396 1633
- 1337 1611 1295 1611 1384 1638 1449 1648 884 1527 1248 1584 1058 1486 1081 1527
- 1381 1609 1285 1599 1467 1661 1380 1652 1481 1670 1352 1580 1235 1559 1065 1567
- 1474 1639 973 1508 1512 1681 1370 1593 1211 1532 1391 1625 1540 1680 1263 1550
- 1432 1647 1323 1610 1367 1641 1004 1483 1183 1560 1323 1588 1575 1746 1046 1502
- 1551 1739 1286 1597 1573 1720 1149 1517 1594 1723 950 1494 1332 1593 1372 1589
- 1513 1672 1406 1601 575 1546 1386 1599 1447 1660 1511 1697 1389 1635 1409 1623
- 1515 1669 1300 1554 1256 1586 606 1537 1502 1667 1469 1634 1107 1541 1479 1704
- 1318 1562 1508 1696 1224 1560 1487 1706 1497 1695 1297 1573 1306 1554 1172 1565
- 1317 1555 841 1533 1565 1735 1037 1495 1471 1675 1378 1618 100 { m20} R 1510
- 1708 1185 1556 1229 1559 1421 1608 1171 1505 1545 1731 1237 1549 1554 1741 1483
- 1704 1414 1623 1551 1730 1567 1723 1526 1709 1284 1586 1341 1591 1466 1676 1371
- 1593 1451 1635 1486 1688 1157 1522 965 1506 1566 1748 921 1481 1295 1606 1473
- 1643 1553 1743 1501 1697 1305 1603 1226 1538 1299 1554 1511 1674 1564 1710 1157
- 1579 770 1492 1244 1586 1550 1693 1491 1658 1428 1613 1303 1574 1525 1687 813
- 1514 1074 1497 1369 1617 43 { m20} R 0.58182 0.8 0 c 1532 1758 1407 1695 1482
- 1713 1179 1619 1503 1751 1233 1623 1419 1746 1106 1572 1470 1769 1531 1749 1557
- 1763 1498 1762 1341 1696 1453 1754 1224 1633 1006 1635 1164 1668 1493 1785 950
- 1629 1490 1714 1098 1579 1521 1804 1469 1723 1368 1714 934 1604 1330 1639 1435
- 1721 1129 1609 1484 1771 1549 1765 1484 1739 1538 1749 1242 1654 1254 1672 1325
- 1656 1367 1698 1033 1613 1422 1731 1508 1728 1528 1737 935 1568 1331 1646 1406
- 1711 803 1601 1164 1603 1453 1695 1195 1674 1406 1676 1499 1765 1319 1695 1424
- 1708 1456 1744 1294 1672 1348 1663 1527 1754 1365 1691 1325 1670 953 1597 1361
- 1652 1194 1600 1514 1731 1208 1597 1449 1714 1534 1751 1437 1747 1359 1665 1463
- 1759 1174 1592 1325 1664 1458 1748 1276 1676 1506 1748 1133 1580 1298 1641 1461
- 1767 1405 1747 1534 1764 77 { m20} R 0.72727 0.8 0 c 1428 1773 1442 1769 1287
- 1751 1463 1780 1436 1835 1437 1808 1303 1776 1297 1757 1456 1852 1388 1798 1506
- 1812 1275 1726 1363 1812 1239 1776 1250 1735 1320 1722 1414 1766 1458 1861 1323
- 1729 1427 1786 1468 1832 1412 1830 1149 1704 1402 1837 1235 1699 1185 1723 1460
- 1810 1360 1748 1479 1799 1204 1686 1475 1823 1489 1831 1480 1813 1488 1852 1416
- 1758 1504 1805 1435 1786 1358 1751 1143 1702 1342 1728 1175 1696 1419 1820 1104
- 1733 43 { m20} R 0.8 0.72727 0 c 1432 1940 1316 1821 1306 1841 1429 1865 1422
- 1915 1423 1901 1386 1849 1410 1856 1150 1779 1384 1918 1440 1861 1141 1868 1408
- 1893 1413 1923 1239 1860 1466 1873 1332 1873 1389 1835 1218 1862 1167 1792 1167
- 1857 937 1784 22 { m20} R 0.8 0.58182 0 c 1181 1965 1428 1957 1179 1936 1371
- 1993 1398 1967 1364 1942 1416 1955 1406 1975 8 { m20} R 0.8 0.43636 0 c 1181
- 1965 0.8 0.29091 0 c 1181 1965 0.8 0.14546 0 c 1181 1965 0 0 0.8 c 1181 1965 0
- 0.14545 0.8 c 1181 1965 0 0.29091 0.8 c 875 1101 m20 0 0.43636 0.8 c 876 1082
- 958 1124 899 1090 3 { m20} R 0 0.58182 0.8 c 946 1104 973 1114 784 1040 808
- 1048 875 1069 989 1119 969 1108 790 1042 781 1040 788 1042 778 1038 901 1081
- 903 1084 982 1119 798 1045 1113 1188 830 1056 809 1047 1066 1160 1055 1158 948
- 1102 899 1078 869 1067 798 1044 806 1046 982 1114 983 1114 888 1073 926 1093 29
- { m20} R 0 0.72727 0.8 c 722 1038 1232 1265 862 1066 1069 1157 778 1044 804
- 1049 1344 1341 750 1038 810 1051 1097 1170 782 1044 950 1098 909 1083 1033 1136
- 755 1040 896 1078 732 1038 728 1035 763 1040 821 1054 800 1051 781 1048 841
- 1061 731 1038 1073 1157 964 1104 735 1035 993 1117 1100 1172 1070 1155 721 1034
- 791 1046 1091 1172 838 1058 894 1076 955 1100 963 1104 833 1058 858 1066 880
- 1070 970 1107 923 1087 911 1084 1297 1311 845 1059 1127 1186 886 1072 775 1040
- 882 1071 49 { m20} R 0 0.8 0.72727 c 776 1063 928 1092 708 1055 733 1058 772
- 1051 735 1042 783 1049 807 1059 765 1057 856 1078 1006 1126 994 1125 710 1056
- 788 1057 782 1060 937 1104 797 1058 881 1081 1367 1358 1130 1190 989 1124 720
- 1041 739 1042 733 1041 1033 1142 966 1112 868 1074 908 1088 749 1052 1144 1196
- 756 1062 830 1064 816 1065 880 1075 707 1040 1218 1243 920 1094 983 1117 995
- 1126 733 1058 777 1063 1182 1220 906 1088 859 1079 773 1052 769 1048 1034 1140
- 732 1040 884 1081 805 1071 1002 1124 693 1038 729 1056 901 1087 788 1057 776
- 1053 977 1111 681 1051 1223 1246 887 1086 972 1110 865 1080 1115 1181 889 1082
- 1055 1147 731 1060 758 1062 802 1058 838 1063 970 1114 802 1062 1161 1208 1186
- 1222 1149 1200 795 1064 883 1083 742 1058 924 1091 760 1048 999 1121 963 1105
- 902 1092 1013 1132 829 1068 805 1061 831 1065 885 1079 786 1064 787 1066 800
- 1070 874 1077 720 1051 960 1106 818 1058 959 1109 1071 1155 779 1050 688 1047
- 795 1058 1279 1285 100 { m20} R 987 1122 829 1072 1122 1184 754 1050 688 1050
- 875 1085 1232 1253 7 { m20} R 0 0.8 0.58182 c 794 1078 755 1087 1321 1318 1201
- 1235 1145 1209 692 1076 1018 1146 1078 1172 730 1077 909 1101 733 1083 697 1084
- 782 1069 850 1098 834 1092 721 1067 840 1091 1273 1283 907 1108 632 1090 957
- 1118 1070 1167 966 1125 940 1114 757 1070 852 1103 810 1080 716 1060 783 1093
- 1101 1175 706 1067 1092 1183 884 1095 663 1064 847 1087 982 1122 684 1065 1132
- 1204 748 1084 1013 1139 659 1085 878 1110 1087 1182 782 1092 661 1065 686 1081
- 633 1080 949 1128 728 1080 894 1095 1261 1276 634 1078 828 1088 636 1071 1312
- 1309 1073 1169 740 1068 693 1078 1026 1151 1050 1151 979 1140 710 1078 812 1085
- 830 1088 1178 1222 811 1074 681 1083 661 1064 797 1090 649 1087 836 1103 1094
- 1173 988 1134 1125 1194 643 1073 818 1099 650 1083 852 1089 1124 1192 1389 1369
- 746 1075 648 1089 714 1078 689 1089 773 1069 747 1091 926 1107 728 1069 840
- 1096 629 1090 1411 1387 1114 1183 790 1086 760 1084 864 1105 969 1127 669 1062
- 824 1100 719 1074 802 1091 100 { m20} R 1099 1182 744 1062 658 1065 797 1077
- 821 1091 1430 1404 904 1118 762 1066 1253 1267 1038 1153 702 1059 898 1096 766
- 1070 1354 1343 840 1104 863 1097 695 1059 1051 1167 715 1069 804 1093 667 1081
- 1170 1222 912 1120 821 1098 693 1074 1231 1256 1155 1213 903 1105 735 1077 671
- 1058 1005 1138 686 1083 1142 1201 927 1116 34 { m20} R 0 0.8 0.43636 c 1046
- 1174 729 1092 1265 1289 1220 1259 624 1091 868 1130 817 1103 989 1151 1650 1611
- 899 1122 960 1164 1054 1169 645 1099 773 1120 692 1107 1017 1160 815 1126 656
- 1116 962 1136 875 1142 1174 1244 1565 1528 663 1108 982 1145 679 1096 869 1121
- 805 1099 1105 1209 1250 1272 723 1120 680 1101 1035 1161 918 1122 995 1148 602
- 1117 1008 1170 867 1119 1116 1206 803 1115 798 1108 978 1159 986 1163 662 1130
- 1039 1185 595 1128 978 1140 647 1118 1484 1454 732 1095 983 1160 591 1131 687
- 1125 1165 1222 647 1119 663 1122 671 1102 883 1136 1036 1162 1118 1218 1020
- 1165 1079 1183 927 1150 1046 1168 744 1102 951 1152 627 1096 1050 1183 1516
- 1480 956 1139 944 1143 853 1125 1247 1285 686 1130 986 1153 945 1134 846 1135
- 1364 1359 697 1124 714 1096 637 1096 1049 1168 1255 1289 1240 1266 985 1156 697
- 1107 736 1126 1210 1250 1009 1157 669 1096 1017 1157 758 1105 1304 1309 951
- 1152 706 1106 840 1110 750 1101 1155 1225 782 1100 1062 1185 879 1133 100 { m20
-} R 1121 1199 890 1144 982 1161 701 1122 835 1131 1072 1182 1146 1228 815 1122
- 640 1130 789 1119 979 1150 1058 1173 787 1108 891 1131 936 1147 851 1124 744
- 1115 722 1110 970 1160 755 1104 1213 1259 703 1118 616 1136 623 1124 1006 1169
- 961 1164 1089 1191 615 1111 1574 1535 580 1140 715 1102 646 1133 1067 1187 1054
- 1174 709 1100 1032 1180 753 1127 1062 1178 869 1112 741 1130 940 1133 739 1093
- 814 1111 998 1148 775 1107 628 1097 1035 1183 931 1133 946 1147 1313 1322 1274
- 1293 1038 1177 711 1127 918 1135 601 1105 795 1103 1284 1298 806 1135 1115 1213
- 1011 1170 997 1151 626 1101 739 1126 855 1133 1095 1187 787 1111 1272 1293 1245
- 1278 1025 1178 712 1110 928 1131 731 1098 1180 1237 1134 1209 1738 1709 1214
- 1251 921 1143 1101 1211 1262 1279 885 1119 730 1115 1036 1161 919 1128 1028
- 1179 1104 1191 1146 1213 835 1138 824 1113 912 1120 611 1113 1459 1430 957 1145
- 1163 1235 1143 1219 1260 1287 95 { m20} R 0 0.8 0.29091 c 812 1179 587 1163 817
- 1150 843 1165 715 1134 548 1178 811 1164 1141 1242 778 1135 1138 1245 1085 1211
- 892 1162 961 1196 988 1200 666 1184 1270 1309 739 1136 990 1203 1204 1264 1226
- 1278 1530 1505 647 1172 658 1161 1066 1234 968 1181 1186 1263 1050 1208 1031
- 1207 947 1170 985 1201 1336 1352 944 1162 863 1166 1339 1363 994 1187 1057 1203
- 1310 1332 559 1198 1425 1422 554 1194 768 1183 707 1151 1135 1241 1249 1312 952
- 1187 979 1185 1029 1190 1323 1358 1330 1361 1155 1266 1608 1577 1306 1325 1159
- 1266 654 1165 798 1143 1348 1352 1329 1348 619 1188 876 1166 758 1167 1731 1700
- 992 1184 852 1186 733 1174 739 1172 1360 1362 889 1151 713 1170 699 1137 638
- 1165 814 1150 955 1191 1338 1347 824 1156 681 1185 764 1162 1534 1503 1311 1349
- 1018 1210 986 1201 1319 1334 1317 1347 1239 1295 888 1174 1179 1266 1116 1241
- 1142 1238 882 1157 1317 1332 838 1157 780 1138 1020 1201 647 1177 1398 1404
- 1031 1189 1007 1209 894 1181 725 1133 1112 1221 713 1170 100 { m20} R 910 1193
- 1190 1285 1358 1380 1236 1290 1535 1509 1291 1327 1265 1323 1028 1209 1718 1687
- 582 1198 1532 1506 819 1139 1135 1246 1087 1239 819 1152 1208 1293 691 1146 748
- 1172 722 1168 1146 1261 846 1158 798 1161 1104 1233 954 1176 1188 1267 1222
- 1282 1077 1235 656 1139 697 1149 1035 1196 1058 1201 978 1199 749 1169 936 1179
- 640 1146 1298 1325 837 1174 1632 1598 665 1143 763 1136 936 1161 907 1157 660
- 1149 711 1162 1259 1308 844 1179 1095 1236 735 1145 698 1158 981 1198 975 1182
- 973 1195 739 1157 1474 1457 1202 1288 1413 1409 1359 1368 950 1171 947 1197
- 1780 1756 770 1141 565 1168 1251 1307 1334 1361 1364 1379 678 1162 1162 1265
- 1293 1334 773 1174 943 1199 635 1156 1081 1237 1323 1339 786 1157 1112 1235
- 1515 1493 662 1139 1318 1344 727 1137 616 1145 1560 1535 795 1153 772 1147 738
- 1147 635 1182 1204 1271 1001 1185 1266 1320 938 1181 1034 1199 1203 1284 738
- 1136 770 1151 1097 1223 729 1172 1454 1447 1354 1374 988 1200 1394 1394 898
- 1169 100 { m20} R 765 1162 1158 1261 808 1167 1150 1254 809 1183 797 1173 1171
- 1275 820 1157 943 1194 1203 1282 1337 1347 585 1162 680 1139 1055 1204 582 1153
- 984 1177 779 1142 1248 1309 867 1160 1175 1252 816 1156 1057 1197 1524 1491 754
- 1164 1070 1204 858 1169 749 1174 921 1183 1462 1441 1339 1368 713 1157 655 1186
- 757 1149 1188 1260 34 { m20} R 0 0.8 0.14545 c 1131 1279 1316 1376 1000 1216
- 1605 1585 1107 1281 1253 1328 1293 1352 1112 1266 886 1200 1085 1265 1028 1261
- 1536 1531 524 1240 1492 1493 1442 1455 915 1206 1140 1272 675 1203 1153 1305
- 1020 1259 797 1217 834 1231 1263 1348 1555 1539 979 1258 994 1220 1383 1404 803
- 1210 655 1202 1136 1275 1302 1355 1261 1349 910 1229 1046 1272 971 1229 973
- 1223 880 1224 1024 1259 1511 1506 1530 1519 855 1192 1129 1261 1066 1246 945
- 1217 1178 1288 541 1272 581 1203 776 1218 1192 1321 1431 1460 1474 1468 589
- 1206 1243 1330 1094 1254 1084 1271 746 1189 825 1209 1090 1277 1055 1258 1100
- 1288 676 1219 841 1215 1020 1262 1081 1264 602 1216 512 1284 583 1212 1101 1276
- 1540 1532 1472 1475 794 1242 1136 1284 1692 1671 1162 1310 646 1234 1224 1304
- 1112 1269 1215 1331 803 1194 919 1244 1267 1347 963 1239 958 1252 902 1208 782
- 1188 1133 1287 1725 1699 1299 1355 1020 1224 1353 1407 825 1192 1688 1676 651
- 1252 587 1205 954 1248 1139 1279 895 1240 852 1199 1495 1492 890 1198 100 { m20
-} R 1114 1290 1024 1244 1099 1277 638 1199 937 1209 1107 1290 665 1211 1019 1225
- 784 1243 884 1209 901 1225 689 1223 943 1221 1389 1413 1057 1254 1348 1388 1258
- 1356 909 1236 688 1188 1275 1356 1033 1271 1200 1321 687 1203 1320 1376 1448
- 1472 1403 1416 1503 1502 774 1226 1262 1352 554 1255 717 1241 1086 1254 1455
- 1465 713 1211 569 1236 1655 1637 923 1250 815 1221 957 1244 1387 1432 833 1229
- 1046 1267 983 1251 1089 1247 1543 1527 1131 1276 1665 1647 1587 1576 905 1230
- 1029 1231 1041 1228 1254 1325 712 1194 956 1251 1183 1291 567 1227 896 1230 830
- 1196 856 1231 1399 1423 1482 1491 1033 1264 1267 1352 946 1251 1357 1395 1398
- 1428 1223 1331 675 1202 920 1206 1148 1276 1112 1269 1459 1465 1258 1325 934
- 1215 1292 1364 1141 1275 1051 1265 997 1229 1597 1582 1549 1540 1104 1269 729
- 1228 1349 1406 1598 1585 510 1281 649 1201 1178 1311 959 1219 768 1191 1354
- 1399 1141 1300 602 1235 656 1245 809 1213 763 1187 1060 1252 1046 1244 1014
- 1256 1036 1255 859 1217 100 { m20} R 598 1235 1462 1471 941 1241 1303 1361 1002
- 1258 944 1237 724 1210 781 1226 1161 1303 1026 1233 1424 1452 1235 1336 1478
- 1490 861 1219 630 1203 1453 1467 1054 1242 1542 1531 1248 1349 1010 1233 1105
- 1272 1603 1581 1363 1406 1264 1344 951 1205 799 1193 1340 1401 657 1200 1184
- 1292 887 1198 1195 1327 703 1219 1554 1547 797 1193 716 1197 1261 1349 998 1254
- 1094 1265 939 1229 1449 1452 923 1211 1199 1319 1195 1325 708 1228 790 1202 996
- 1216 1292 1370 1225 1336 1505 1511 1263 1338 1097 1272 1578 1570 1163 1288 832
- 1235 899 1206 55 { m20} R 0 0.8 0.4069E-06 c 926 1307 1119 1338 619 1280 1010
- 1295 1324 1432 1244 1398 1398 1479 1359 1456 1054 1304 798 1271 727 1281 1356
- 1415 1417 1454 623 1297 1166 1342 1374 1462 1722 1712 1056 1322 1049 1287 565
- 1300 1108 1299 648 1261 1065 1291 1453 1504 1051 1279 754 1247 1159 1314 928
- 1267 1419 1488 729 1275 1279 1404 1164 1348 840 1249 1191 1343 777 1245 1008
- 1300 1451 1489 1390 1443 1081 1322 973 1266 1062 1329 1141 1345 1217 1343 666
- 1305 746 1269 1418 1455 598 1328 1367 1440 955 1314 531 1300 1251 1378 527 1291
- 556 1284 1359 1441 1222 1375 1356 1435 695 1297 1282 1386 688 1323 1448 1499
- 1334 1436 1188 1343 783 1266 1276 1394 1552 1567 1129 1317 1042 1313 950 1267
- 1657 1657 1162 1332 609 1313 1054 1292 1115 1319 1360 1445 1177 1367 761 1273
- 1421 1461 894 1252 1373 1461 1593 1604 1433 1489 1386 1467 1164 1355 1358 1440
- 1348 1450 1264 1366 1302 1394 1262 1375 1031 1298 1045 1307 1082 1296 1687 1688
- 1082 1325 860 1299 1225 1373 1142 1354 1471 1517 762 1268 1344 1438 1085 1334
- 100 { m20} R 1199 1341 1084 1293 812 1288 1625 1619 1397 1472 1204 1350 518
- 1354 1626 1633 1069 1304 1152 1342 1117 1301 1102 1328 612 1277 1423 1491 1133
- 1305 950 1291 857 1293 1113 1313 1525 1542 1404 1450 842 1301 1354 1434 1297
- 1404 597 1301 1248 1360 1267 1380 1472 1493 1498 1511 951 1282 1264 1375 636
- 1296 1166 1333 1186 1343 1045 1283 1381 1446 952 1308 1352 1436 982 1297 509
- 1353 1448 1492 1111 1303 663 1264 1113 1339 1274 1374 822 1245 1408 1450 1163
- 1339 1190 1355 974 1263 1013 1315 1541 1568 908 1265 1378 1468 538 1282 1234
- 1371 1524 1540 1495 1520 1324 1403 1253 1368 1427 1473 712 1315 1252 1358 728
- 1255 998 1269 871 1270 756 1270 807 1266 836 1288 1388 1456 878 1262 1082 1306
- 1078 1316 1066 1282 841 1265 1270 1394 1230 1345 835 1244 1439 1498 915 1267
- 974 1272 1252 1389 531 1322 1337 1409 1349 1421 1205 1350 1266 1389 1032 1324
- 1143 1332 1365 1438 866 1285 1340 1432 1506 1523 1087 1295 1243 1376 1597 1598
- 1170 1342 1127 1338 794 1288 1266 1382 1220 1376 100 { m20} R 774 1273 939 1290
- 1113 1334 1452 1500 975 1282 1221 1371 839 1274 1337 1427 1084 1331 780 1251
- 979 1302 1292 1416 1005 1271 1304 1401 1256 1389 1169 1364 1078 1296 1410 1474
- 1436 1496 1070 1324 1178 1370 922 1259 767 1288 1593 1598 1362 1432 715 1250
- 797 1249 1305 1413 864 1266 1014 1276 1550 1584 1110 1349 943 1290 1181 1355
- 1011 1272 949 1307 1700 1701 1448 1479 1052 1285 671 1253 753 1261 909 1302
- 1510 1540 1712 1709 1463 1503 1335 1413 941 1300 1289 1395 843 1301 1266 1370
- 1417 1475 1611 1612 1032 1323 951 1289 1363 1444 938 1264 868 1257 1378 1466
- 1102 1333 1424 1481 760 1266 1363 1420 1225 1362 503 1320 850 1267 1108 1316
- 1564 1585 1275 1369 689 1253 1107 1330 1322 1396 1344 1421 1064 1312 1167 1328
- 1117 1306 1528 1558 1246 1387 1111 1340 638 1302 1521 1539 953 1309 927 1266 82
- { m20} R 0.14545 0.8 0 c 1654 1689 988 1353 995 1365 1417 1518 1421 1513 1484
- 1573 1654 1700 1305 1461 1020 1369 1421 1505 1235 1425 1347 1460 959 1367 1577
- 1648 1219 1432 1281 1434 924 1345 1414 1514 1473 1534 1443 1543 1082 1405 745
- 1326 1144 1371 1001 1332 1233 1409 1554 1614 1326 1460 1041 1392 1364 1508 1518
- 1599 1365 1461 1331 1487 966 1340 1518 1581 1456 1562 1097 1381 1396 1524 1273
- 1419 1232 1402 1509 1569 1089 1391 968 1351 1134 1385 1402 1489 1433 1535 1093
- 1352 1362 1496 922 1384 1117 1360 1523 1576 793 1335 911 1335 1279 1416 1547
- 1588 1422 1529 1495 1564 511 1376 1048 1352 1445 1539 1562 1616 1454 1560 1476
- 1544 1475 1563 1204 1399 1514 1577 1431 1532 1054 1340 1199 1427 1194 1379 1282
- 1457 632 1398 1106 1381 732 1383 1477 1574 1363 1501 837 1355 1240 1451 1400
- 1510 1575 1640 1351 1466 1645 1703 908 1377 1333 1443 1580 1646 1229 1438 1026
- 1356 1073 1343 1373 1502 1486 1571 945 1361 1644 1691 806 1382 1032 1362 1301
- 1470 1263 1449 1472 1562 669 1338 1145 1379 1262 1446 1078 1388 100 { m20} R
- 1648 1701 1014 1391 1674 1712 1430 1540 1169 1380 1221 1400 799 1331 740 1352
- 1400 1506 1276 1433 1408 1491 906 1334 1668 1686 1408 1517 1589 1657 1222 1448
- 745 1361 1438 1524 1303 1458 881 1328 1488 1558 1359 1466 1531 1583 1508 1562
- 998 1337 1370 1488 1458 1561 1593 1652 1550 1624 1268 1431 1498 1547 1190 1422
- 1553 1602 1395 1518 1388 1476 886 1372 1138 1376 546 1383 752 1393 982 1341
- 1033 1333 1179 1427 1435 1510 956 1331 1496 1549 1497 1583 1323 1472 1183 1377
- 1205 1385 978 1357 1574 1633 1063 1338 873 1378 1420 1515 787 1362 971 1375
- 1258 1452 1409 1510 1367 1479 1373 1502 973 1344 773 1342 1657 1710 1095 1395
- 1249 1416 1626 1688 880 1378 1348 1495 1562 1602 705 1390 1432 1527 1244 1409
- 1389 1487 1310 1475 1438 1553 1240 1439 1112 1371 1086 1357 895 1329 746 1370
- 1294 1454 1455 1523 1124 1400 1436 1526 893 1313 1683 1700 899 1331 833 1327
- 1274 1439 425 1430 1205 1408 1539 1592 1168 1382 1563 1608 1356 1500 1059 1387
- 741 1321 1465 1560 962 1335 1524 1588 100 { m20} R 1218 1390 969 1372 1126 1361
- 1403 1501 1127 1366 1601 1655 1297 1425 1267 1424 1150 1413 1054 1348 1299 1434
- 1387 1507 1271 1429 1004 1347 992 1365 927 1335 1267 1432 1400 1501 1614 1658
- 1167 1423 1223 1443 1532 1606 1509 1598 802 1384 1165 1406 836 1347 1287 1423
- 953 1385 997 1338 1651 1682 1013 1352 1451 1526 799 1341 1656 1701 885 1361
- 1130 1359 1630 1687 1290 1432 1290 1448 1216 1421 1550 1603 1200 1405 1283 1453
- 1646 1671 1307 1462 1665 1702 708 1325 1382 1488 1272 1456 1544 1612 50 { m20
-} R 0.29091 0.8 0 c 1439 1589 698 1441 1417 1595 1363 1515 1237 1496 1452 1564
- 1438 1594 1193 1505 1000 1466 1402 1552 1332 1509 1638 1705 1237 1495 1578 1701
- 1224 1464 1429 1601 920 1413 1297 1480 1563 1649 1341 1543 1319 1509 1331 1531
- 1204 1499 1248 1476 654 1446 1044 1471 1384 1563 1306 1505 1441 1580 1216 1468
- 1526 1647 1342 1546 1442 1582 1428 1586 1526 1634 1249 1519 1644 1707 1468 1584
- 1261 1464 1436 1556 1443 1603 1075 1422 1301 1482 1157 1442 1607 1691 1109 1462
- 1022 1455 1469 1629 610 1438 1486 1639 1405 1543 1171 1441 975 1412 1508 1649
- 1554 1640 1233 1505 1248 1475 1264 1473 1297 1516 1095 1485 891 1464 1328 1516
- 1597 1685 1400 1550 1463 1626 1584 1707 1024 1463 1368 1540 1445 1560 1174 1454
- 1164 1479 1321 1522 1335 1499 1468 1580 1355 1556 971 1398 1036 1413 1258 1484
- 1504 1629 1246 1459 1407 1554 1355 1521 1404 1556 1631 1701 1169 1470 1208 1447
- 788 1420 1506 1640 1573 1648 1219 1498 1533 1619 1528 1655 1280 1484 1315 1533
- 1551 1674 1574 1658 1553 1667 1356 1561 1361 1557 1283 1500 100 { m20} R 1250
- 1465 1309 1499 1652 1712 1390 1538 1308 1549 1538 1651 1036 1451 1058 1444 1074
- 1424 1558 1660 1601 1703 926 1450 1592 1688 1499 1609 1065 1414 1326 1515 1575
- 1682 1506 1623 1381 1532 987 1423 1386 1530 1485 1607 1429 1597 832 1433 1179
- 1464 1167 1493 1330 1533 1269 1475 1071 1409 1038 1474 1021 1419 1078 1467 1443
- 1599 1134 1486 1217 1463 1363 1543 1153 1471 851 1394 1114 1436 1514 1639 1561
- 1662 1331 1501 1359 1513 893 1403 1079 1415 1022 1399 766 1465 1560 1664 1417
- 1543 1316 1507 1401 1556 1012 1449 1601 1677 1405 1542 835 1418 1582 1662 1053
- 1477 1537 1651 905 1433 1321 1555 1346 1544 1224 1509 1120 1418 1568 1654 1244
- 1466 1477 1622 1402 1548 1483 1598 1276 1482 1089 1423 1595 1697 1644 1711 1318
- 1553 1519 1633 977 1463 1192 1507 1163 1439 1010 1418 1243 1482 1466 1592 1060
- 1462 1399 1589 990 1406 1599 1701 1512 1635 590 1466 1170 1499 1521 1634 1185
- 1461 1384 1563 1249 1468 1158 1445 1240 1474 995 1408 1609 1688 1489 1609 1415
- 1566 1466 1610 1549 1665 1399 1555 100 { m20} R 1577 1681 1596 1678 1479 1600
- 708 1450 1466 1626 1081 1427 1496 1619 1336 1502 1285 1521 9 { m20} R 0.43636
- 0.8 0 c 1432 1613 1166 1566 1369 1609 1306 1563 834 1500 1551 1697 1131 1516
- 1051 1554 1386 1626 1436 1666 1113 1503 1583 1733 1366 1584 1116 1523 1202 1512
- 1461 1695 672 1525 1129 1511 1448 1654 1489 1691 1580 1717 1442 1619 1437 1618
- 1381 1629 1343 1587 1236 1591 1538 1717 815 1501 1548 1731 1604 1731 1561 1703
- 1541 1700 1042 1539 1588 1732 1231 1539 1186 1533 1304 1561 1378 1609 1453 1662
- 1386 1602 1304 1604 1516 1669 1253 1596 1298 1561 1523 1727 1379 1615 1531 1673
- 1451 1667 1264 1592 1479 1641 1518 1712 1536 1700 1428 1672 1532 1707 1367 1632
- 1472 1674 1150 1580 1047 1513 1424 1630 1177 1553 1339 1619 1544 1707 800 1481
- 1403 1618 1460 1694 1517 1724 1477 1666 1086 1553 1486 1673 1155 1510 1392 1613
- 1481 1691 1007 1520 1519 1709 1517 1679 1158 1543 1424 1621 1425 1670 1378 1654
- 1224 1574 1367 1592 1054 1543 1553 1693 1334 1567 1476 1678 1004 1560 1047 1490
- 1443 1679 1286 1594 1454 1632 1478 1641 1335 1624 1190 1579 1178 1561 1162 1534
- 1498 1703 1209 1514 1582 1728 1512 1720 1243 1595 100 { m20} R 1588 1734 1184
- 1525 1460 1659 1353 1606 1342 1625 1254 1599 1228 1559 1468 1638 1532 1679 1531
- 1671 1181 1558 1381 1625 1509 1682 1460 1687 1210 1552 1535 1720 1263 1537 958
- 1555 1308 1597 906 1521 555 1654 1556 1716 1055 1482 1160 1574 1184 1542 1502
- 1704 1428 1617 1561 1751 1248 1591 970 1559 1313 1571 1358 1575 1103 1529 1357
- 1618 1300 1558 1330 1619 1311 1579 1464 1693 1392 1634 1479 1651 1326 1585 1528
- 1701 1380 1603 1137 1553 1373 1621 1379 1654 1042 1558 1494 1672 1390 1649 49 {
- m20} R 0.58182 0.8 0 c 1367 1698 1356 1652 1174 1651 1490 1712 1292 1631 1465
- 1774 1204 1605 1273 1688 1514 1776 1191 1661 1537 1761 1193 1591 1467 1769 1506
- 1725 1494 1727 1249 1652 1276 1639 1519 1750 1491 1756 1414 1714 1503 1750 1428
- 1707 1357 1727 1534 1791 1386 1674 1458 1718 1375 1668 1213 1619 1372 1728 1065
- 1602 1250 1613 1537 1770 1468 1768 1518 1775 1382 1666 1541 1769 1303 1632 1473
- 1771 1189 1593 1234 1681 1289 1696 1446 1723 1533 1773 1400 1728 1406 1719 1479
- 1706 1404 1734 1420 1734 1505 1745 1208 1603 1453 1767 1480 1742 1382 1736 1337
- 1715 1537 1766 1313 1709 1491 1722 1493 1762 1483 1723 1402 1710 1306 1658 1426
- 1683 1249 1652 1508 1788 1153 1609 1413 1740 957 1625 1135 1597 1414 1677 1183
- 1606 1073 1660 1544 1756 1431 1734 1336 1693 1552 1759 1514 1766 1114 1584 1372
- 1712 1043 1570 1525 1740 1071 1591 781 1621 1431 1702 1525 1781 1217 1619 1425
- 1745 1040 1630 1394 1690 1388 1691 1550 1762 1326 1696 1477 1719 92 { m20} R
- 0.72727 0.8 0 c 1408 1814 1462 1816 1340 1815 1477 1793 1393 1800 1456 1835
- 1446 1806 1427 1847 1479 1827 1448 1783 1086 1703 871 1732 1515 1808 1351 1791
- 1423 1795 882 1734 1269 1702 1072 1743 1439 1797 1466 1823 1184 1711 1310 1737
- 1148 1687 1400 1768 1475 1827 1125 1770 1384 1781 1222 1771 1092 1700 1449 1809
- 1137 1733 1377 1777 1241 1701 1396 1763 1356 1745 1064 1701 1465 1862 37 { m20
-} R 0.8 0.72727 0 c 1362 1916 1364 1836 1135 1801 1386 1871 1256 1873 1274 1819
- 1383 1841 1399 1860 1394 1893 1350 1921 1447 1865 1284 1844 1121 1886 1326 1897
- 1398 1938 1215 1872 1433 1913 1462 1887 18 { m20} R 0.8 0.58182 0 c 1395 1976
- 1264 1961 1274 1927 1131 1946 4 { m20} R 0.8 0.43636 0 c 1395 1976 0.8 0.29091
- 0 c 1395 1976 0.8 0.14546 0 c 1395 1976 0 0 0.8 c 1395 1976 0 0.14545 0.8 c
- 1395 1976 0 0.29091 0.8 c 1395 1976 0 0.43636 0.8 c 812 1054 834 1062 888 1084
- 889 1087 1268 1328 5 { m20} R 0 0.58182 0.8 c 800 1045 803 1047 874 1068 778
- 1038 928 1091 910 1085 842 1058 1332 1356 888 1076 966 1107 962 1104 1111 1184
- 778 1038 855 1062 14 { m20} R 0 0.72727 0.8 c 948 1097 764 1038 868 1066 979
- 1111 777 1042 888 1074 915 1083 835 1056 961 1103 945 1096 778 1039 863 1066
- 804 1048 1039 1139 1251 1270 1085 1163 752 1042 1014 1127 985 1113 738 1040
- 1210 1240 1001 1120 893 1075 846 1059 835 1058 829 1053 855 1066 899 1079 1015
- 1127 807 1053 883 1073 1063 1151 1033 1136 1149 1206 860 1067 822 1057 913 1083
- 1336 1339 743 1041 813 1052 991 1116 861 1065 958 1101 736 1037 1030 1134 45 {
- m20} R 0 0.8 0.72727 c 744 1051 798 1058 1101 1173 712 1056 865 1074 810 1057
- 952 1109 772 1049 788 1052 866 1075 826 1060 902 1085 1114 1180 1017 1132 760
- 1054 733 1052 960 1112 1097 1170 770 1057 907 1089 939 1105 808 1059 942 1097
- 721 1044 1065 1152 1185 1221 730 1052 677 1046 770 1064 967 1111 731 1054 923
- 1095 984 1121 824 1060 876 1076 943 1102 914 1093 803 1066 684 1049 831 1064
- 779 1049 846 1075 918 1087 735 1047 821 1060 1264 1274 774 1054 952 1108 787
- 1066 1365 1356 930 1102 887 1077 1048 1148 968 1112 706 1048 1020 1135 1067
- 1155 818 1068 818 1061 759 1046 1109 1178 1199 1231 827 1067 837 1068 783 1064
- 696 1056 752 1056 870 1073 896 1081 1056 1149 834 1073 773 1065 971 1113 803
- 1056 761 1059 761 1063 817 1067 905 1094 1040 1144 723 1043 1053 1151 863 1070
- 889 1082 1022 1131 768 1059 999 1125 945 1101 969 1109 88 { m20} R 0 0.8
- 0.58182 c 711 1060 828 1091 823 1095 780 1087 804 1086 627 1090 989 1140 1079
- 1169 915 1112 1052 1164 881 1110 923 1107 680 1078 729 1070 942 1110 988 1137
- 938 1127 909 1101 953 1115 1102 1181 922 1101 845 1082 887 1102 1280 1286 1042
- 1162 775 1079 1060 1156 635 1078 785 1073 791 1084 826 1084 706 1074 926 1115
- 659 1058 1065 1163 1080 1170 697 1059 845 1091 1061 1158 797 1079 1099 1176 712
- 1066 991 1138 791 1079 679 1059 699 1089 712 1090 653 1058 886 1091 644 1066
- 925 1106 822 1086 867 1093 878 1097 832 1091 1059 1158 973 1119 1259 1277 920
- 1117 736 1089 1169 1224 758 1068 1063 1161 689 1081 1332 1324 851 1097 1172
- 1219 1287 1290 1185 1232 673 1070 831 1100 907 1106 1503 1467 674 1060 887 1096
- 1061 1170 983 1136 1035 1149 786 1084 949 1131 1251 1266 661 1068 766 1071 742
- 1073 1219 1247 1093 1171 955 1118 1009 1134 888 1095 833 1084 669 1089 1389
- 1369 1044 1155 1101 1183 1279 1286 673 1063 892 1111 1193 1234 947 1130 931
- 1117 100 { m20} R 738 1074 630 1083 871 1087 714 1060 678 1078 816 1082 668
- 1082 743 1067 880 1104 814 1087 902 1107 644 1082 936 1107 833 1103 798 1072
- 666 1057 799 1081 924 1113 695 1085 1140 1200 811 1082 759 1073 986 1141 1147
- 1201 987 1138 900 1100 1030 1148 704 1061 1003 1135 780 1091 761 1076 1000 1141
- 756 1076 664 1084 719 1067 1102 1179 647 1064 894 1111 38 { m20} R 0 0.8
- 0.43636 c 1310 1314 841 1108 864 1133 829 1135 1019 1182 1093 1207 735 1093
- 1087 1194 971 1147 927 1141 1213 1259 627 1127 617 1133 961 1150 804 1106 685
- 1126 886 1116 812 1110 998 1171 686 1107 775 1114 992 1162 1264 1281 1062 1175
- 1086 1200 1179 1235 827 1109 953 1133 828 1103 689 1129 674 1099 1036 1163 1153
- 1225 902 1140 670 1103 972 1165 928 1135 1255 1288 1126 1217 1127 1212 685 1104
- 1018 1168 733 1099 962 1146 903 1128 926 1145 1220 1265 982 1158 1197 1249 1139
- 1228 1181 1233 1610 1571 1166 1227 987 1157 1451 1427 955 1154 677 1098 1304
- 1317 1117 1211 985 1147 721 1106 1115 1198 819 1101 1315 1319 757 1124 1392
- 1379 943 1150 1166 1233 868 1138 1099 1197 921 1134 971 1144 616 1097 1182 1233
- 969 1139 592 1117 612 1094 1170 1229 893 1137 1005 1178 1193 1248 1444 1419 650
- 1116 966 1138 1066 1184 918 1125 1071 1181 934 1127 820 1125 1292 1303 632 1126
- 902 1131 909 1140 889 1142 650 1126 1118 1205 819 1135 899 1149 660 1093 934
- 1157 100 { m20} R 987 1152 622 1096 891 1136 707 1121 821 1102 1263 1282 920
- 1134 1108 1208 1267 1297 620 1108 755 1116 1104 1196 703 1096 1118 1201 1065
- 1177 921 1125 885 1123 1107 1202 884 1146 905 1120 955 1138 1120 1204 643 1117
- 767 1121 843 1124 684 1114 671 1132 1213 1265 1162 1222 691 1129 933 1146 883
- 1128 1037 1180 860 1134 758 1123 991 1145 747 1122 1085 1192 614 1092 1084 1204
- 862 1109 929 1156 929 1149 790 1114 781 1102 977 1169 586 1122 1404 1385 956
- 1136 716 1106 758 1124 986 1152 732 1108 784 1112 1063 1192 605 1136 1378 1371
- 1061 1177 857 1112 1249 1283 981 1151 923 1138 1037 1165 765 1110 758 1117 798
- 1099 686 1120 813 1115 1094 1205 1053 1193 984 1161 1177 1245 727 1104 1303
- 1311 991 1168 1087 1190 727 1130 887 1134 993 1149 1013 1157 772 1119 664 1093
- 725 1097 1191 1239 717 1125 699 1123 782 1100 795 1112 776 1104 1110 1200 798
- 1112 878 1131 1039 1175 1180 1230 746 1131 1096 1189 1115 1202 856 1131 883
- 1130 1293 1310 100 { m20} R 861 1112 668 1091 707 1096 604 1116 977 1156 1005
- 1174 749 1098 731 1113 817 1136 888 1129 680 1115 1109 1201 12 { m20} R 0 0.8
- 0.29091 c 877 1153 993 1210 1178 1258 1054 1224 790 1165 1152 1264 1127 1248
- 866 1158 943 1170 982 1192 761 1167 764 1160 695 1182 648 1178 1190 1272 804
- 1152 855 1157 758 1148 1113 1238 1124 1232 873 1163 1029 1193 1467 1448 743
- 1171 1460 1444 812 1146 1162 1242 650 1172 761 1178 1458 1436 1096 1244 1034
- 1202 853 1174 1382 1380 870 1172 1440 1430 1533 1510 1153 1263 1171 1252 1107
- 1243 613 1159 1295 1328 900 1181 987 1197 1175 1271 1179 1275 971 1188 555 1207
- 842 1173 996 1201 876 1175 1148 1252 1114 1223 1450 1438 818 1167 1069 1228
- 1370 1368 1262 1304 914 1167 552 1192 842 1160 670 1138 624 1140 586 1150 788
- 1151 912 1176 992 1211 1054 1196 1010 1199 816 1165 759 1134 872 1155 1206 1274
- 1135 1259 628 1182 1150 1240 820 1161 622 1145 1100 1228 1178 1253 1488 1464
- 564 1152 718 1162 690 1181 1088 1240 1392 1401 644 1139 890 1172 758 1161 563
- 1191 1085 1230 596 1145 1111 1220 788 1143 849 1170 1425 1416 687 1154 690 1156
- 837 1186 999 1198 100 { m20} R 1323 1354 812 1175 1174 1268 1415 1403 1159 1242
- 1207 1281 763 1168 958 1171 1299 1341 1647 1609 977 1194 1315 1335 671 1180 675
- 1166 879 1166 721 1149 1194 1263 588 1163 1125 1232 565 1202 710 1166 990 1187
- 761 1177 807 1161 771 1135 1087 1209 849 1145 1043 1203 896 1158 917 1167 1060
- 1231 962 1183 1229 1299 600 1157 858 1145 916 1162 1277 1320 617 1180 916 1182
- 1667 1636 636 1152 730 1177 1186 1282 1377 1372 1155 1242 1218 1288 1137 1230
- 989 1207 1360 1369 981 1173 1123 1230 1024 1212 877 1173 1347 1357 967 1184
- 1380 1394 1175 1253 917 1170 1277 1316 1265 1308 949 1188 915 1192 648 1172
- 1225 1277 1074 1220 975 1191 802 1147 781 1180 1268 1317 942 1162 1136 1257 983
- 1197 965 1202 1152 1259 579 1161 927 1165 866 1155 1107 1233 870 1149 1010 1214
- 1519 1489 717 1183 1097 1217 888 1182 1089 1241 815 1165 839 1185 862 1171 999
- 1211 1112 1221 970 1199 1014 1209 1192 1266 1025 1222 922 1187 737 1177 992
- 1179 1079 1207 608 1169 1000 1188 100 { m20} R 1340 1365 747 1163 1002 1215 612
- 1180 787 1156 1128 1243 1258 1304 1005 1203 1209 1267 793 1152 1166 1247 1462
- 1443 660 1138 909 1187 1152 1242 772 1138 1496 1469 1403 1403 1322 1348 1065
- 1205 761 1135 930 1174 875 1173 1017 1196 1152 1244 1336 1348 561 1178 1155
- 1268 1460 1440 1257 1304 736 1165 603 1150 1094 1243 1331 1357 783 1169 912
- 1163 639 1190 573 1203 1211 1272 923 1180 996 1182 1055 1207 1105 1232 943 1186
- 747 1133 968 1206 821 1160 784 1161 672 1137 1017 1182 828 1143 1146 1246 1366
- 1382 996 1193 833 1144 949 1190 833 1169 57 { m20} R 0 0.8 0.14545 c 716 1197
- 1566 1550 1563 1545 1440 1445 1083 1252 733 1207 1288 1370 544 1263 695 1237
- 1121 1290 684 1207 1369 1402 1288 1347 1110 1268 1011 1239 844 1229 866 1223
- 842 1201 1169 1288 1202 1313 1023 1256 996 1239 1420 1431 783 1198 879 1204 534
- 1214 699 1223 895 1236 675 1188 807 1230 1075 1258 1072 1275 1595 1572 1047
- 1272 553 1214 778 1222 1194 1317 994 1258 1188 1318 1108 1294 808 1187 557 1212
- 750 1227 1041 1255 1072 1271 1615 1595 1432 1436 657 1245 1660 1643 1220 1331
- 1009 1236 1420 1435 748 1224 1600 1583 557 1228 1150 1299 1258 1333 1114 1267
- 1574 1572 1463 1481 1410 1443 989 1233 1035 1250 1705 1679 826 1195 492 1291
- 1258 1327 1201 1296 788 1226 1395 1435 1711 1686 696 1193 1090 1288 1573 1560
- 1265 1330 1556 1538 1033 1232 1179 1293 1235 1337 1096 1284 1177 1285 1520 1521
- 666 1217 1167 1284 1000 1251 1053 1244 1464 1476 860 1244 1578 1557 570 1233
- 1180 1304 893 1207 1004 1220 1061 1263 1613 1604 906 1196 1289 1364 850 1226
- 1027 1234 1520 1517 100 { m20} R 944 1245 1069 1241 582 1203 741 1195 619 1220
- 1227 1318 975 1255 988 1226 976 1225 773 1230 1405 1415 1182 1314 837 1222 1260
- 1357 818 1235 1142 1288 1028 1231 1075 1258 1139 1276 641 1206 984 1254 1437
- 1456 663 1237 829 1220 657 1193 1452 1469 1282 1348 1490 1487 806 1224 1355
- 1380 536 1237 1317 1372 1037 1243 1415 1425 1018 1250 1444 1451 1253 1325 1216
- 1320 1763 1741 781 1225 1183 1293 1597 1589 1008 1235 1292 1357 814 1207 1018
- 1228 678 1229 1051 1256 1215 1300 865 1201 1156 1275 1023 1242 1160 1297 1227
- 1310 780 1230 632 1194 795 1205 1493 1481 775 1193 1107 1255 1006 1258 1032
- 1238 737 1228 1208 1326 1046 1238 911 1210 1248 1337 1258 1323 1107 1258 1528
- 1513 1423 1456 1292 1345 1244 1348 1224 1335 1385 1409 1311 1378 874 1196 894
- 1237 1735 1718 867 1190 1223 1325 1134 1273 1268 1339 1397 1408 1307 1353 1621
- 1606 1519 1505 1084 1249 951 1240 1170 1281 508 1274 1392 1418 1156 1285 1136
- 1291 1228 1336 515 1268 576 1214 1200 1316 1338 1378 1024 1225 100 { m20} R 853
- 1200 515 1257 650 1206 1155 1286 1091 1270 1609 1586 1364 1404 784 1236 935
- 1209 1039 1245 1484 1483 1366 1405 1458 1458 1237 1343 1583 1576 549 1233 1037
- 1272 1179 1302 1068 1281 1103 1258 1102 1281 1155 1291 1175 1310 928 1203 1171
- 1286 1257 1356 1283 1358 909 1237 1300 1375 1422 1434 1014 1221 1061 1249 657
- 1241 1722 1697 1358 1394 1126 1278 1346 1379 1569 1552 566 1241 1163 1309 1304
- 1369 1091 1255 1066 1263 1696 1673 1116 1279 795 1198 982 1239 1068 1274 1599
- 1587 759 1190 800 1200 1333 1380 1321 1381 923 1235 1258 1336 1179 1311 1625
- 1605 1064 1265 58 { m20} R 0 0.8 0.4069E-06 c 1098 1317 1089 1333 1322 1417 976
- 1310 1151 1347 975 1268 1444 1474 954 1271 1416 1489 1038 1311 1097 1332 1366
- 1427 1114 1301 1247 1373 1058 1328 1305 1410 1483 1518 1083 1328 754 1270 1165
- 1329 853 1257 1364 1442 1386 1460 849 1247 1256 1393 1406 1455 1498 1528 1723
- 1718 823 1282 713 1320 1662 1660 1334 1422 1364 1448 1136 1310 703 1306 822
- 1254 1296 1412 1276 1369 1314 1432 932 1268 1039 1314 901 1261 1099 1336 1190
- 1341 991 1269 1276 1396 1589 1594 617 1319 1631 1625 988 1315 1267 1376 1452
- 1504 752 1266 852 1301 1606 1624 866 1260 728 1287 1664 1667 1274 1386 809 1282
- 1427 1473 1242 1398 1101 1346 1294 1379 1516 1559 1325 1431 994 1277 717 1298
- 895 1259 915 1259 861 1292 1027 1296 866 1257 976 1315 653 1298 768 1251 1139
- 1319 982 1307 1219 1384 1512 1555 1137 1321 1549 1569 928 1308 1063 1305 843
- 1251 1020 1279 1182 1343 1246 1381 1063 1311 1493 1511 991 1301 789 1264 888
- 1278 1414 1469 930 1257 1604 1622 840 1280 667 1292 1171 1325 791 1258 100 {
- m20} R 951 1257 1533 1542 1642 1645 1505 1550 1298 1411 1472 1525 1391 1473
- 1431 1466 734 1316 813 1310 836 1267 1491 1538 1401 1452 757 1309 947 1306 1393
- 1439 932 1307 1222 1377 1607 1605 1028 1285 1462 1491 1496 1531 1137 1347 1617
- 1622 1512 1557 1308 1426 1045 1284 1297 1395 1046 1318 1297 1416 868 1255 937
- 1253 1365 1422 1092 1343 954 1260 902 1266 1458 1517 477 1372 900 1273 1203
- 1345 1704 1714 1441 1489 1177 1366 1103 1323 1321 1432 1224 1367 891 1306 832
- 1295 905 1253 1561 1570 940 1291 969 1316 1569 1596 1532 1565 1142 1325 1348
- 1439 1208 1337 948 1274 1156 1358 1235 1352 1145 1315 1564 1583 1003 1277 1644
- 1660 1335 1423 1110 1314 926 1269 858 1254 1033 1288 1128 1343 869 1258 1135
- 1313 664 1255 1231 1356 782 1290 1175 1342 1107 1328 1100 1337 1656 1662 1144
- 1327 1182 1367 1357 1413 696 1279 1429 1498 1562 1572 905 1274 938 1301 648
- 1279 971 1266 1073 1303 1226 1383 742 1247 1319 1421 899 1267 1487 1526 1455
- 1483 1544 1550 1010 1302 1371 1463 1483 1524 100 { m20} R 1518 1528 1209 1352
- 1365 1439 926 1312 1192 1360 885 1287 1551 1585 682 1319 1378 1456 754 1301
- 1033 1276 1076 1322 1570 1579 1022 1314 1282 1377 1693 1688 960 1260 1084 1315
- 1148 1335 1340 1408 743 1308 1033 1312 1038 1304 1170 1335 808 1263 1362 1440
- 1446 1497 1135 1332 1365 1427 1123 1353 1141 1341 1078 1289 1091 1302 1318 1410
- 1148 1335 1563 1588 1117 1327 1377 1436 1536 1552 1070 1338 1134 1307 1647 1661
- 887 1300 1572 1584 1165 1348 1327 1429 1042 1312 872 1247 1195 1347 1646 1651
- 1299 1421 598 1290 1291 1382 972 1262 1076 1337 1616 1632 1617 1636 1049 1286
- 1540 1554 1686 1684 907 1257 1653 1643 995 1307 1076 1320 1112 1330 823 1276
- 1104 1333 902 1294 1070 1313 1671 1665 1542 1571 1249 1375 675 1266 1131 1350
- 1130 1327 75 { m20} R 0.14545 0.8 0 c 630 1344 1525 1588 1457 1553 825 1312
- 1401 1512 1366 1486 1630 1688 918 1364 1119 1353 1337 1456 1484 1570 908 1371
- 1211 1426 601 1351 1039 1376 1348 1464 963 1341 1392 1479 1403 1483 1379 1481
- 818 1373 1606 1671 1485 1575 881 1369 1697 1714 1483 1547 1304 1433 606 1351
- 978 1376 1128 1405 884 1363 984 1355 1690 1710 1591 1646 1301 1480 1149 1414
- 974 1359 893 1382 1149 1366 1138 1374 1187 1397 1228 1413 1248 1449 1036 1344
- 1504 1561 908 1335 1384 1501 1289 1439 1336 1472 1615 1645 1595 1664 1286 1441
- 1104 1406 1182 1387 1102 1397 1077 1394 1133 1369 1111 1414 1045 1349 1083 1374
- 1367 1478 1575 1628 1283 1433 1100 1363 1450 1536 898 1330 1261 1453 1585 1645
- 1143 1386 1254 1452 1565 1621 894 1357 1525 1588 1245 1399 1060 1365 1079 1345
- 907 1369 1249 1433 1436 1516 707 1342 1229 1449 1502 1583 422 1440 1518 1583
- 1475 1532 1260 1416 1110 1396 1481 1550 1024 1334 1092 1404 699 1332 1311 1480
- 1575 1611 829 1372 1530 1575 1552 1602 1441 1519 1021 1368 978 1351 1619 1653
- 100 { m20} R 1622 1675 1632 1661 1221 1397 1480 1560 1468 1566 1421 1500 1362
- 1476 1398 1506 1064 1375 1296 1464 1465 1529 1008 1331 1461 1534 1498 1575 1058
- 1395 1091 1373 933 1383 1323 1473 1206 1435 628 1368 1651 1679 1166 1417 1657
- 1708 926 1381 1127 1355 1351 1497 1224 1391 1110 1376 1639 1681 1490 1552 1625
- 1670 1287 1428 1479 1559 1198 1390 1281 1427 1390 1488 1016 1388 1192 1427 1045
- 1346 994 1346 1656 1702 770 1376 934 1339 1447 1536 1443 1526 1385 1512 481
- 1425 1466 1571 1325 1469 1154 1370 1465 1526 1165 1421 817 1350 620 1384 851
- 1341 1271 1450 1426 1538 1519 1596 967 1331 1080 1401 1075 1386 1481 1552 1506
- 1567 1161 1372 1197 1379 1267 1440 1459 1522 1476 1573 935 1381 1349 1497 1676
- 1703 1472 1546 1129 1402 915 1317 1384 1499 1593 1634 1215 1440 1350 1488 1234
- 1438 1373 1512 1548 1602 757 1381 1036 1369 1233 1445 1446 1543 1281 1439 694
- 1341 1461 1532 1269 1457 911 1371 1228 1407 1010 1333 1370 1479 599 1366 1440
- 1523 1391 1487 1158 1383 1337 1472 1457 1547 1290 1470 100 { m20} R 1588 1624
- 1091 1351 1255 1410 1516 1605 1530 1591 804 1368 1378 1474 1297 1470 1231 1431
- 894 1369 657 1347 927 1324 1110 1394 1236 1434 1016 1336 1086 1388 1424 1530
- 1382 1509 1288 1457 1383 1508 1586 1656 1330 1469 1378 1515 1347 1454 1437 1535
- 1448 1542 1254 1440 1367 1502 912 1368 953 1331 1300 1474 498 1396 1481 1546
- 1175 1432 1364 1500 1541 1600 1689 1709 1343 1494 1652 1693 1344 1484 1105 1374
- 1068 1350 1616 1662 492 1436 980 1332 1213 1388 1625 1679 1138 1385 1666 1711
- 1417 1523 904 1315 764 1354 1296 1455 972 1381 1413 1511 55 { m20} R 0.29091
- 0.8 0 c 1343 1522 1025 1401 1195 1464 1468 1607 1376 1535 822 1398 1059 1436
- 790 1412 1073 1427 1602 1695 1419 1559 1211 1457 1463 1624 1306 1494 1538 1644
- 1245 1481 1460 1595 1414 1580 911 1452 1566 1660 956 1402 1474 1602 1575 1655
- 1410 1553 1441 1602 1537 1629 1316 1536 1070 1454 1357 1509 1418 1578 956 1417
- 1035 1404 1516 1632 1532 1658 1366 1535 1633 1696 794 1458 1314 1521 1587 1703
- 1176 1470 760 1431 1415 1576 1091 1441 1308 1527 1050 1440 1356 1522 1242 1486
- 1244 1504 983 1411 1361 1536 1005 1397 1327 1524 1379 1577 1293 1520 1337 1533
- 1461 1570 1507 1651 1348 1507 1552 1654 1026 1402 1602 1713 1472 1601 1343 1528
- 1552 1656 1185 1476 1327 1515 1468 1619 1436 1566 1099 1464 1416 1562 1478 1619
- 1638 1700 1541 1628 1333 1554 795 1473 1089 1478 1274 1471 1548 1658 980 1465
- 1292 1541 1085 1468 1052 1447 1167 1492 1464 1609 1469 1595 1465 1580 1503 1638
- 1129 1444 1621 1697 1352 1555 1290 1502 1452 1602 1526 1620 1243 1477 1063 1407
- 1626 1698 1404 1556 1599 1673 1454 1569 1494 1597 100 { m20} R 1363 1543 1491
- 1599 1363 1565 1515 1640 1175 1443 1637 1699 1507 1603 1372 1543 985 1409 1290
- 1498 1020 1428 1131 1462 1489 1594 1452 1568 1574 1651 1034 1444 1232 1481 1194
- 1441 1447 1605 1111 1440 1416 1594 1383 1578 1338 1519 1043 1450 1446 1591 1182
- 1442 944 1389 680 1476 1083 1409 1453 1588 863 1448 1423 1568 1542 1634 1048
- 1473 1138 1442 1536 1654 1037 1475 1474 1595 1029 1444 1075 1450 1335 1561 1291
- 1509 1244 1500 815 1469 1476 1589 1367 1562 1379 1524 1374 1531 1341 1538 1036
- 1423 1523 1633 1538 1629 1462 1570 1083 1408 1234 1463 1262 1471 1320 1495 1223
- 1516 1580 1677 1614 1700 1259 1482 1346 1527 1130 1474 1104 1479 1595 1708 1167
- 1481 1415 1564 903 1407 1435 1591 1579 1703 971 1392 1611 1682 1309 1532 951
- 1464 1557 1635 1319 1516 1534 1639 1429 1591 1382 1545 1182 1467 953 1456 1492
- 1641 1385 1525 1643 1715 1288 1483 1341 1504 1139 1464 1615 1725 1534 1667 1619
- 1722 1147 1471 1342 1551 92 { m20} R 0.43636 0.8 0 c 1002 1536 1267 1549 1175
- 1534 1317 1598 1054 1524 755 1490 1164 1515 955 1474 1460 1633 1223 1552 1256
- 1536 1289 1596 1523 1687 1338 1607 1356 1597 1323 1560 1278 1538 1393 1661 1427
- 1667 1382 1616 1341 1629 1355 1623 1120 1522 1127 1538 1317 1607 1304 1598 1326
- 1611 1563 1698 1356 1592 1425 1620 1582 1741 1495 1665 1293 1606 1115 1524 1160
- 1578 1427 1640 1424 1615 1232 1569 1592 1715 1433 1628 1535 1681 860 1557 1435
- 1673 1387 1605 1339 1581 1595 1733 1440 1630 1032 1479 1019 1477 1448 1623 1284
- 1566 1424 1629 1467 1634 1056 1507 1515 1692 1211 1551 1408 1639 1053 1552 1291
- 1585 1218 1567 1052 1543 1089 1496 1219 1575 589 1557 1468 1660 1332 1570 1476
- 1647 909 1550 1035 1492 1511 1661 1231 1581 951 1539 1522 1677 1461 1650 1551
- 1701 1128 1506 1279 1548 1391 1625 1154 1559 1592 1739 1589 1736 1447 1643 1552
- 1695 1106 1564 1240 1538 1563 1722 1517 1708 1151 1526 1356 1578 1215 1545 1487
- 1658 1482 1669 975 1491 1506 1705 1566 1743 1193 1529 1291 1581 1328 1603 1418
- 1631 1344 1613 100 { m20} R 1524 1711 1269 1603 1407 1626 1409 1608 1185 1517
- 1525 1714 1351 1628 783 1510 1176 1569 1208 1559 1538 1714 1199 1570 1481 1672
- 1557 1735 1536 1724 1315 1599 1362 1609 1507 1699 1474 1676 1451 1655 1179 1548
- 1588 1730 1383 1651 1541 1692 1363 1647 925 1542 1089 1497 1597 1727 1468 1634
- 1354 1633 1573 1749 1126 1539 1258 1559 1317 1629 1422 1661 1316 1587 1119 1534
- 37 { m20} R 0.58182 0.8 0 c 1338 1659 1432 1759 1207 1614 1502 1794 1487 1737
- 1349 1655 1107 1658 1355 1725 1375 1657 1480 1742 1488 1726 1053 1606 1181 1660
- 1341 1657 1421 1681 1415 1736 1418 1713 1428 1727 1262 1630 1288 1627 1528 1760
- 1483 1727 1458 1723 1105 1582 1364 1719 1553 1757 1509 1752 1471 1701 1359 1679
- 1348 1669 1223 1660 1179 1678 1459 1745 1228 1636 1375 1671 1410 1730 1339 1652
- 1330 1659 1345 1708 1229 1662 1501 1762 1466 1739 1489 1773 1395 1669 1326 1657
- 1159 1636 1438 1691 1001 1566 1244 1663 1385 1691 1484 1730 1336 1712 1133 1600
- 1507 1790 1436 1747 1523 1750 1226 1644 1365 1720 1157 1584 1431 1680 1366 1707
- 928 1586 1131 1654 1304 1661 1406 1683 1379 1674 1476 1751 1501 1749 1149 1587
- 1104 1587 1559 1765 937 1581 1506 1759 1324 1642 1340 1712 1474 1763 1512 1742
- 1413 1697 1163 1586 1463 1723 1411 1678 1235 1613 1054 1628 1373 1658 1458 1754
- 1536 1785 1362 1656 1255 1677 1438 1751 1535 1788 1186 1643 1463 1750 1441 1706
- 1268 1656 990 1565 1079 1619 1272 1616 1460 1747 1271 1629 1280 1642 100 { m20
-} R 940 1572 1330 1635 1269 1617 3 { m20} R 0.72727 0.8 0 c 1391 1769 1482 1854
- 1498 1837 1223 1695 1324 1761 1270 1791 1496 1823 1261 1705 1460 1796 1413 1821
- 1110 1769 1437 1799 1396 1760 1194 1759 1093 1674 1315 1733 1380 1824 1209 1776
- 1503 1814 1203 1695 1378 1812 1490 1850 1335 1722 1492 1806 1382 1759 1402 1762
- 1221 1741 1507 1813 1508 1810 1443 1816 1480 1797 1131 1694 1298 1756 1360 1760
- 1422 1812 1289 1760 1405 1762 1407 1819 1445 1818 849 1726 1255 1788 1408 1779
- 1063 1723 1387 1769 44 { m20} R 0.8 0.72727 0 c 1402 1849 1439 1894 1382 1844
- 1447 1904 1296 1846 1451 1860 1372 1875 1427 1876 1284 1836 1459 1875 1413 1932
- 1444 1894 1406 1878 1313 1828 1223 1875 1339 1916 1234 1823 1442 1864 18 { m20
-} R 0.8 0.58182 0 c 1392 2025 1303 1934 1412 1946 1395 2026 4 { m20} R 0.8
- 0.43636 0 c 1330 2148 1346 2089 1341 2061 3 { m20} R 0.8 0.29091 0 c 1330 2148
- 0.8 0.14546 0 c 1330 2148 0 0 0.8 c 1330 2148 0 0.14545 0.8 c 1330 2148 0
- 0.29091 0.8 c 878 1094 854 1088 2 { m20} R 0 0.43636 0.8 c 817 1054 966 1124
- 876 1082 1056 1174 821 1056 846 1067 884 1079 7 { m20} R 0 0.58182 0.8 c 964
- 1106 944 1097 764 1035 789 1042 993 1121 776 1038 808 1049 955 1101 836 1056
- 835 1056 841 1058 830 1056 944 1098 947 1104 798 1044 792 1043 756 1034 789
- 1042 18 { m20} R 0 0.72727 0.8 c 786 1046 781 1041 1010 1125 802 1046 792 1047
- 950 1099 874 1068 784 1043 823 1057 772 1038 826 1056 898 1079 849 1065 908
- 1081 809 1049 1406 1400 1024 1132 994 1117 747 1040 1036 1137 804 1046 970 1106
- 895 1078 1063 1151 1072 1160 840 1057 1007 1123 761 1036 1069 1156 790 1049 865
- 1066 715 1035 729 1036 714 1036 786 1042 746 1040 1395 1396 804 1048 883 1073
- 946 1096 40 { m20} R 0 0.8 0.72727 c 977 1117 713 1050 696 1043 826 1067 991
- 1118 815 1056 763 1058 914 1087 731 1055 833 1065 737 1056 774 1052 783 1056
- 792 1056 832 1060 993 1121 726 1050 897 1082 1221 1245 841 1067 843 1064 876
- 1081 926 1100 907 1091 752 1056 994 1119 1181 1219 781 1053 818 1073 1198 1230
- 880 1086 886 1080 672 1047 971 1116 908 1085 889 1079 957 1102 720 1041 1135
- 1192 736 1057 1063 1154 845 1066 835 1064 875 1075 714 1050 753 1058 745 1047
- 821 1063 844 1078 714 1038 831 1063 707 1055 761 1052 901 1093 701 1040 692
- 1041 941 1100 955 1102 1135 1191 875 1082 721 1056 797 1057 1158 1205 914 1093
- 1023 1135 695 1041 755 1056 775 1056 815 1057 757 1047 860 1073 739 1047 927
- 1091 879 1076 980 1114 699 1039 826 1069 1056 1153 1287 1291 699 1042 1107 1177
- 1062 1151 753 1055 1181 1220 816 1059 769 1055 815 1065 701 1039 1264 1274 778
- 1061 934 1099 749 1051 847 1072 93 { m20} R 0 0.8 0.58182 c 667 1083 1431 1404
- 922 1106 705 1066 1073 1169 793 1075 816 1087 728 1071 832 1085 1078 1175 820
- 1084 875 1104 858 1094 1471 1438 899 1107 701 1074 706 1089 866 1096 954 1116
- 811 1084 1071 1172 673 1056 755 1068 995 1131 903 1105 745 1075 878 1091 885
- 1099 798 1086 653 1072 875 1101 723 1077 974 1119 1010 1142 1199 1238 1030 1159
- 1328 1321 885 1092 687 1075 1006 1140 742 1080 798 1085 748 1082 838 1084 875
- 1101 1104 1190 1159 1215 647 1062 631 1080 707 1075 1366 1351 787 1073 989 1130
- 1008 1135 1050 1156 1120 1196 1233 1254 703 1072 802 1075 993 1144 1201 1236
- 699 1060 840 1081 1130 1199 776 1089 795 1085 1103 1180 1243 1260 961 1118 788
- 1076 827 1083 880 1098 668 1075 839 1082 712 1086 949 1130 1000 1146 780 1079
- 736 1062 872 1100 926 1112 658 1089 1122 1198 1022 1153 1035 1158 833 1096 724
- 1068 1163 1212 961 1119 744 1087 957 1125 836 1093 854 1098 1063 1171 775 1089
- 1285 1290 984 1124 825 1081 873 1099 1190 1231 100 { m20} R 842 1090 1208 1242
- 1095 1186 659 1072 1299 1304 943 1116 870 1102 753 1089 1225 1250 961 1114 1256
- 1270 1013 1148 887 1090 923 1104 982 1133 684 1065 817 1088 664 1065 1137 1195
- 669 1069 1080 1170 761 1083 867 1092 1126 1199 794 1081 657 1067 677 1088 832
- 1100 941 1125 713 1088 649 1089 1289 1292 753 1087 1057 1154 845 1103 871 1092
- 718 1071 947 1109 648 1062 811 1093 883 1104 889 1097 1285 1292 663 1072 1464
- 1435 757 1081 842 1081 679 1057 921 1109 930 1121 1045 1156 834 1081 1194 1229
- 661 1080 833 1089 632 1075 851 1100 965 1134 1252 1266 918 1104 1195 1238 61 {
- m20} R 0 0.8 0.43636 c 1245 1280 1103 1193 763 1116 955 1157 917 1128 778 1108
- 603 1133 1002 1160 584 1128 902 1126 896 1126 1187 1238 902 1119 877 1142 853
- 1130 1151 1233 1132 1207 1026 1161 1045 1186 678 1109 865 1110 1012 1161 887
- 1129 1027 1180 789 1132 956 1138 1204 1247 648 1095 697 1133 902 1143 1453 1426
- 608 1108 766 1132 651 1099 1085 1193 1553 1515 774 1105 1367 1359 1297 1315
- 1068 1193 1419 1401 1048 1182 640 1103 961 1165 698 1109 968 1139 1226 1272 828
- 1105 1073 1191 1164 1228 1226 1261 1263 1286 737 1112 958 1147 635 1129 1057
- 1172 968 1162 1000 1163 606 1132 772 1113 1220 1257 598 1118 857 1119 683 1090
- 721 1098 1182 1248 1377 1372 660 1105 1138 1223 1017 1162 1040 1182 638 1127
- 894 1118 609 1132 731 1094 1272 1293 734 1111 723 1110 1010 1166 740 1131 953
- 1132 970 1144 1083 1197 1040 1168 1079 1189 1378 1369 1012 1154 1078 1180 1141
- 1211 813 1128 1246 1269 614 1110 1021 1183 1052 1171 901 1131 632 1114 785 1125
- 1001 1165 853 1125 1013 1173 100 { m20} R 1033 1167 826 1120 845 1138 796 1098
- 1105 1204 753 1119 662 1114 1110 1207 590 1119 636 1096 1027 1179 688 1133 618
- 1099 653 1112 714 1092 718 1095 1194 1243 663 1120 618 1132 906 1150 659 1116
- 850 1115 973 1153 646 1134 1057 1172 861 1110 1244 1279 1171 1232 1095 1209
- 1155 1229 879 1124 1007 1157 875 1113 708 1129 642 1097 613 1100 1213 1251 918
- 1144 781 1126 743 1111 780 1120 806 1132 639 1132 1336 1341 999 1163 801 1102
- 784 1125 1291 1305 669 1102 1392 1375 898 1117 747 1128 826 1129 645 1106 737
- 1105 754 1103 719 1093 1140 1216 760 1125 702 1128 581 1132 1592 1553 714 1117
- 854 1126 646 1107 954 1137 907 1137 1059 1181 1268 1290 833 1103 781 1096 812
- 1107 907 1128 738 1114 1021 1168 689 1106 916 1153 609 1099 1034 1185 694 1114
- 741 1101 708 1121 1236 1268 709 1104 920 1155 1299 1307 86 { m20} R 0 0.8
- 0.29091 c 593 1193 1650 1616 1034 1220 773 1145 686 1141 858 1172 1642 1612
- 1116 1242 1462 1445 1338 1360 923 1179 1185 1281 954 1164 791 1170 1015 1213
- 1237 1299 1191 1260 891 1162 642 1138 826 1176 862 1156 1020 1186 1023 1204 798
- 1144 565 1150 829 1180 1135 1233 1598 1561 1149 1262 576 1144 1458 1447 897
- 1169 1227 1278 1415 1417 1169 1253 1061 1223 893 1171 694 1144 929 1169 1603
- 1570 1019 1208 621 1145 1085 1221 654 1172 575 1173 798 1145 830 1142 878 1151
- 859 1155 1166 1266 1276 1311 1144 1264 704 1167 1062 1220 1288 1334 1158 1245
- 1291 1320 1375 1383 1410 1409 835 1160 912 1160 611 1159 690 1145 877 1186 1367
- 1366 617 1174 1359 1377 1065 1223 874 1179 856 1172 894 1180 1137 1241 1213
- 1271 901 1175 956 1196 980 1193 1565 1538 784 1183 727 1171 972 1183 1255 1307
- 1077 1220 1150 1264 707 1155 898 1180 598 1191 1220 1295 966 1182 1466 1448
- 1437 1427 1172 1260 801 1167 759 1169 666 1138 1053 1219 965 1193 629 1159 872
- 1167 778 1170 1185 1253 100 { m20} R 958 1182 691 1172 1427 1418 1417 1410 806
- 1153 1185 1273 1282 1328 1190 1266 746 1135 866 1178 1021 1200 1415 1412 1332
- 1364 1554 1527 647 1142 1037 1219 999 1214 791 1142 721 1171 1084 1232 1024
- 1195 987 1204 1272 1317 786 1178 958 1205 1314 1348 1206 1285 663 1171 1367
- 1378 866 1190 922 1191 746 1165 1054 1196 1700 1670 1032 1220 1192 1258 972
- 1198 920 1164 1004 1182 1053 1214 997 1193 1203 1283 954 1202 806 1159 863 1181
- 708 1181 735 1161 1055 1215 1044 1210 1239 1310 743 1181 1371 1377 842 1159 929
- 1178 1427 1411 985 1178 993 1177 1194 1264 625 1165 887 1159 1210 1273 575 1167
- 1493 1473 1321 1353 1100 1229 646 1149 676 1157 1046 1206 871 1187 1050 1217
- 1023 1189 632 1186 1084 1218 1187 1267 823 1150 1060 1223 884 1162 1041 1200
- 872 1179 658 1169 1194 1263 729 1141 1054 1203 619 1161 1287 1316 849 1165 1155
- 1269 712 1135 671 1145 1301 1320 1374 1377 785 1160 795 1154 1154 1240 1604
- 1568 776 1169 1380 1379 1031 1190 995 1213 868 1161 100 { m20} R 1244 1309 680
- 1143 843 1159 1091 1221 684 1167 935 1198 1069 1234 1375 1373 647 1177 1021
- 1214 775 1156 985 1198 1000 1214 1365 1382 711 1181 686 1170 1074 1233 1162
- 1249 1332 1347 585 1193 931 1187 1321 1348 1189 1276 566 1196 919 1191 1019
- 1202 1273 1304 953 1166 1566 1537 895 1192 951 1202 602 1158 590 1189 899 1181
- 862 1145 638 1151 752 1140 815 1173 1158 1270 1180 1268 1105 1216 800 1170 1226
- 1282 776 1140 852 1185 1370 1368 1218 1286 725 1179 865 1155 774 1152 674 1144
- 1213 1289 699 1146 729 1174 996 1202 755 1146 1042 1200 625 1178 956 1191 964
- 1201 964 1184 724 1167 1041 1199 799 1148 707 1170 756 1138 828 1173 67 { m20
-} R 0 0.8 0.14545 c 1570 1555 1363 1395 1073 1247 990 1258 882 1236 708 1230
- 1075 1248 1173 1281 1137 1280 609 1212 1485 1476 757 1193 1439 1462 1482 1488
- 1053 1247 1228 1330 1436 1440 1053 1261 1131 1299 795 1203 969 1245 911 1236
- 919 1227 1202 1293 626 1236 1091 1250 1234 1311 1280 1354 714 1196 1095 1251
- 767 1189 877 1224 1036 1232 1356 1387 726 1210 988 1217 912 1229 685 1205 565
- 1216 999 1240 854 1220 1236 1314 1167 1289 1030 1225 1213 1305 1020 1225 1466
- 1472 1582 1560 1230 1330 1097 1268 1157 1290 1343 1404 1309 1373 813 1208 818
- 1197 1033 1268 1030 1252 520 1223 1393 1422 891 1200 1138 1271 1174 1297 1631
- 1610 600 1220 1112 1258 682 1205 832 1241 860 1216 568 1214 1185 1299 727 1209
- 815 1198 1209 1333 697 1198 1306 1371 680 1198 969 1237 913 1208 1416 1430 1507
- 1511 624 1197 1417 1433 679 1247 849 1238 1205 1312 1430 1433 878 1218 1338
- 1388 737 1212 1081 1249 1205 1317 980 1225 1460 1461 1543 1541 1255 1336 1459
- 1458 1276 1367 760 1221 1331 1377 944 1220 100 { m20} R 1622 1609 686 1209 1316
- 1367 738 1198 776 1208 743 1205 1118 1273 829 1229 899 1195 1067 1259 860 1240
- 1317 1372 938 1236 1456 1454 1153 1272 889 1195 1127 1267 1445 1456 1071 1251
- 1011 1234 1108 1290 1781 1760 914 1236 1144 1304 1021 1253 988 1217 1237 1342
- 1003 1246 1172 1317 886 1221 1244 1349 1424 1450 1052 1251 834 1188 1343 1386
- 887 1217 1060 1242 1241 1335 631 1215 1195 1297 1194 1290 1347 1400 1674 1652
- 672 1245 871 1205 972 1210 1264 1332 1242 1347 674 1192 1400 1439 1070 1275
- 1223 1325 651 1201 740 1233 1315 1358 1650 1633 1001 1221 1340 1384 665 1202
- 1154 1291 877 1206 1386 1427 630 1197 1076 1248 1206 1319 1263 1342 1001 1230
- 647 1204 1077 1266 698 1212 885 1244 1059 1257 1281 1366 1513 1518 1256 1335
- 987 1213 769 1225 896 1201 749 1185 651 1208 903 1235 1476 1488 1007 1266 1565
- 1558 861 1197 1061 1240 889 1233 1201 1315 1005 1221 567 1229 1285 1369 852
- 1202 1185 1308 795 1215 630 1241 1078 1266 1372 1393 976 1216 1131 1275 1513
- 1512 100 { m20} R 1094 1256 726 1231 1075 1258 1058 1234 1182 1289 778 1239
- 1225 1342 1420 1449 678 1232 1494 1507 1459 1455 1086 1242 1403 1412 1064 1275
- 875 1222 700 1214 1209 1298 1372 1403 1325 1363 820 1218 1031 1255 1221 1340
- 753 1219 1386 1420 875 1198 1114 1290 818 1211 849 1215 1162 1286 809 1216 937
- 1213 1030 1226 1337 1397 1243 1344 756 1191 1690 1666 973 1256 1054 1232 554
- 1219 1611 1585 861 1208 1421 1435 1196 1304 1211 1331 1183 1284 989 1230 1167
- 1276 924 1213 914 1216 1139 1274 1616 1596 1395 1414 961 1256 1721 1697 785
- 1188 688 1241 1039 1272 1539 1532 712 1207 1507 1504 1619 1602 615 1210 1284
- 1351 1411 1435 64 { m20} R 0 0.8 0.4069E-06 c 978 1280 802 1279 785 1296 851
- 1254 1376 1439 1460 1488 895 1255 1474 1495 1541 1554 1102 1333 1277 1393 1336
- 1427 1009 1303 1184 1355 1080 1304 985 1290 1475 1511 1489 1527 856 1281 1242
- 1390 1656 1672 1453 1494 959 1263 1704 1694 920 1293 626 1297 1000 1285 1008
- 1299 1054 1307 972 1279 1432 1480 1323 1403 1630 1632 1245 1359 1056 1310 1090
- 1321 1251 1390 669 1317 885 1266 833 1303 1341 1425 1472 1506 1683 1677 1655
- 1661 1470 1517 1196 1333 1152 1350 819 1253 1288 1404 1259 1369 1323 1417 1043
- 1311 1416 1479 855 1278 570 1275 1047 1284 1161 1347 1244 1364 687 1279 1653
- 1650 1463 1494 1073 1301 1265 1372 510 1343 821 1309 1008 1281 1182 1338 1145
- 1334 1601 1614 1348 1421 716 1275 1291 1394 1085 1296 994 1276 1067 1300 805
- 1261 634 1310 1408 1475 944 1283 1350 1444 700 1322 1319 1433 1255 1369 1260
- 1378 1253 1381 1276 1401 1104 1321 716 1265 1706 1699 1498 1541 1053 1304 893
- 1309 1540 1570 822 1276 1099 1315 874 1307 781 1248 1162 1342 1281 1372 839
- 1252 100 { m20} R 1605 1606 1267 1386 855 1252 658 1284 874 1246 1059 1296 1552
- 1579 1386 1450 1117 1334 1113 1312 1028 1285 835 1245 1264 1405 914 1281 1505
- 1525 771 1307 831 1284 1209 1363 1348 1417 1432 1491 1656 1653 824 1288 1244
- 1388 1384 1470 1295 1410 1382 1457 1186 1344 986 1277 1119 1332 1015 1301 1532
- 1543 909 1250 799 1285 1561 1573 1686 1681 623 1287 1205 1382 1052 1287 1256
- 1368 715 1294 897 1274 1723 1715 1269 1385 788 1268 1206 1361 1701 1708 970
- 1300 767 1292 1267 1369 1534 1565 985 1291 1040 1314 999 1313 1337 1403 1108
- 1302 1445 1478 1487 1505 1238 1364 1558 1587 1113 1306 1156 1334 1330 1426 917
- 1263 920 1265 1553 1572 1379 1432 815 1263 1691 1706 1469 1513 1109 1304 1193
- 1333 1229 1349 1270 1392 1071 1321 1295 1397 637 1296 1173 1325 1604 1619 877
- 1268 953 1273 807 1259 1385 1459 975 1263 1649 1668 1440 1479 1366 1431 775
- 1292 1258 1384 1346 1419 1288 1404 1413 1477 1421 1461 967 1278 1391 1457 1493
- 1508 1148 1318 1729 1724 1709 1701 618 1298 1380 1434 100 { m20} R 642 1325
- 1683 1673 863 1284 1274 1397 861 1247 1249 1390 1080 1325 1034 1273 533 1289
- 1020 1281 1620 1622 1077 1333 920 1267 1505 1525 1245 1397 1674 1687 1241 1392
- 1478 1506 1267 1384 1450 1485 1603 1622 1143 1327 941 1290 1103 1294 967 1305
- 1388 1472 1534 1544 1236 1394 1469 1502 1478 1499 960 1267 1363 1418 547 1301
- 1257 1358 1503 1532 1334 1422 928 1314 1200 1349 1305 1406 1145 1309 976 1294
- 1010 1307 1252 1394 888 1284 835 1305 1116 1300 1250 1398 807 1284 862 1306 959
- 1272 1235 1363 1219 1360 1202 1340 1094 1326 1393 1455 999 1285 1420 1491 1368
- 1437 1045 1289 1281 1373 1148 1338 1033 1290 1255 1365 1304 1388 1396 1472 1431
- 1470 1339 1437 1586 1608 1450 1500 1083 1321 1565 1570 1689 1689 1212 1366 73 {
- m20} R 0.14545 0.8 0 c 1626 1650 916 1314 1267 1412 1119 1375 837 1331 737 1322
- 819 1367 1364 1466 1301 1445 1379 1500 1484 1571 1302 1431 1197 1387 1053 1377
- 1317 1452 1298 1450 1139 1380 988 1323 1514 1573 1337 1451 1404 1513 1576 1641
- 896 1335 1665 1707 730 1390 1228 1432 1335 1474 866 1314 1441 1532 1334 1459
- 1085 1374 1363 1478 1356 1490 938 1350 1473 1557 1246 1422 1593 1659 1548 1597
- 1081 1367 1238 1454 1175 1402 1526 1570 1564 1609 946 1369 1424 1521 1599 1656
- 1113 1413 1179 1373 861 1337 1524 1608 1159 1370 1338 1492 1059 1356 1069 1380
- 1073 1352 1230 1409 1567 1608 1418 1497 1172 1391 1660 1684 1119 1370 1222 1447
- 1492 1577 1296 1468 1336 1491 1053 1377 1203 1390 1199 1411 1499 1566 1403 1487
- 1511 1568 1196 1418 1368 1513 1010 1376 670 1373 1179 1424 1334 1469 1277 1448
- 873 1329 1515 1586 1363 1478 1246 1401 1659 1683 1142 1419 1366 1484 1427 1504
- 1504 1590 762 1338 1344 1470 1351 1493 1174 1372 1643 1696 1588 1628 1588 1623
- 1567 1622 1561 1623 1325 1471 1310 1456 876 1313 1407 1526 100 { m20} R 1226
- 1405 1228 1401 811 1337 1655 1694 503 1380 1411 1523 1344 1484 1195 1416 1322
- 1478 762 1370 1073 1397 1540 1584 838 1311 1359 1488 1225 1422 1524 1580 1230
- 1394 1211 1405 1414 1491 873 1332 1663 1692 1330 1458 1382 1514 1045 1336 902
- 1324 1030 1343 698 1357 1555 1600 1542 1585 1184 1426 1302 1452 1372 1493 1190
- 1381 1299 1467 1375 1495 1271 1450 1236 1451 1568 1640 1324 1470 1368 1478 931
- 1343 513 1450 1137 1366 1267 1449 1175 1387 1259 1426 693 1364 695 1351 1437
- 1528 1406 1518 1557 1627 1272 1463 1365 1471 1389 1508 1482 1540 1120 1363 1354
- 1492 1247 1442 1452 1560 1100 1372 1554 1601 1401 1503 1631 1689 951 1322 1423
- 1508 1040 1339 1203 1427 795 1346 1631 1675 1099 1389 675 1374 1033 1355 1222
- 1397 439 1423 1040 1382 1257 1412 1596 1636 1524 1572 754 1387 1257 1435 1436
- 1518 1053 1360 991 1367 1498 1562 1168 1396 795 1348 1171 1382 1316 1477 813
- 1389 1049 1388 934 1371 1379 1480 822 1354 1467 1534 568 1373 915 1331 1256
- 1427 1277 1446 1389 1499 1176 1432 100 { m20} R 945 1335 1192 1395 1471 1559
- 880 1346 1513 1559 1038 1340 1194 1387 1594 1646 976 1367 1481 1575 1351 1485
- 1308 1440 1391 1478 1491 1550 1259 1459 1028 1353 718 1352 953 1344 984 1368
- 918 1328 1386 1497 1106 1355 1143 1400 986 1325 1163 1426 1445 1538 1466 1538
- 1223 1404 1205 1399 1383 1486 1049 1360 698 1373 1085 1402 1218 1397 1130 1405
- 1487 1585 1163 1383 1554 1609 1578 1615 39 { m20} R 0.29091 0.8 0 c 600 1507
- 1387 1579 1504 1646 1527 1627 1501 1620 759 1442 1451 1586 1543 1672 1553 1649
- 1616 1704 1448 1583 1500 1615 1229 1515 1357 1534 1334 1519 1182 1484 1330 1542
- 1548 1641 1145 1442 1402 1570 855 1439 1260 1495 1510 1650 1495 1642 1591 1689
- 1246 1487 1411 1552 866 1419 1516 1633 1492 1605 1419 1596 1505 1614 1547 1633
- 1517 1659 1613 1705 1214 1456 1407 1551 1054 1441 1025 1440 1447 1616 1626 1697
- 1353 1516 1553 1661 1357 1551 1311 1526 831 1437 1515 1646 1195 1485 1493 1641
- 1286 1490 963 1411 1507 1632 1433 1580 1590 1695 1474 1621 1438 1609 1404 1580
- 609 1436 1224 1471 1115 1449 1288 1538 1330 1530 1614 1690 1326 1524 1551 1659
- 1486 1619 1590 1704 1478 1635 1525 1648 1541 1633 1113 1434 1465 1607 1533 1635
- 1373 1579 935 1437 1456 1613 1440 1612 1556 1655 1088 1446 1616 1687 716 1481
- 1515 1633 1414 1562 1384 1537 1323 1518 1482 1611 1542 1664 1014 1407 1495 1614
- 469 1567 1330 1500 1242 1496 1020 1428 1629 1695 1278 1507 1533 1659 1173 1449
- 1474 1593 1221 1486 1244 1496 100 { m20} R 1383 1547 1208 1469 1584 1691 1241
- 1467 1011 1413 1411 1584 1350 1531 1528 1642 1340 1507 1459 1568 1517 1636 1182
- 1461 1346 1558 1040 1430 776 1414 1383 1531 1336 1545 1243 1496 1252 1522 884
- 1390 1280 1477 1189 1505 1286 1518 1207 1488 1647 1706 1550 1645 1030 1456 1478
- 1635 1305 1539 1382 1528 1469 1600 1201 1492 995 1423 1053 1472 1554 1677 1071
- 1443 1536 1647 950 1427 829 1394 1474 1583 1520 1638 1352 1553 1162 1451 926
- 1396 1376 1557 1341 1538 1319 1532 1153 1439 1536 1669 1071 1460 1115 1479 1173
- 1459 1583 1687 881 1403 1348 1543 989 1411 1505 1632 1592 1676 822 1393 1226
- 1476 1574 1656 1301 1533 1389 1528 1264 1486 1429 1576 1564 1646 1229 1519 1067
- 1461 1244 1495 1608 1690 1362 1553 1332 1515 1324 1556 1269 1502 1190 1443 1431
- 1569 1207 1457 1490 1602 1170 1480 1235 1513 1169 1452 1362 1552 947 1411 1390
- 1580 1112 1458 1484 1629 1027 1416 1491 1641 1034 1460 1279 1514 1583 1688 1322
- 1519 1308 1518 1399 1543 1290 1510 620 1477 96 { m20} R 0.43636 0.8 0 c 1554
- 1694 1284 1574 1119 1495 1088 1540 1275 1537 1395 1604 1348 1585 1580 1746 1287
- 1575 1561 1737 1235 1561 1333 1595 1236 1563 1224 1556 1177 1581 1529 1684 1466
- 1634 1588 1717 1421 1630 979 1541 1300 1578 1352 1610 1135 1541 1232 1541 1516
- 1697 1316 1582 1457 1689 1436 1623 1552 1692 1110 1524 1473 1675 1421 1611 1522
- 1698 1537 1723 1339 1623 1062 1537 1422 1619 1072 1496 1141 1511 1494 1662 1267
- 1538 1535 1716 1508 1663 1387 1594 1508 1708 1137 1531 1180 1531 1074 1492 1412
- 1658 1177 1525 1269 1563 1111 1532 1102 1560 1111 1533 1263 1533 1243 1562 1464
- 1683 1254 1587 1001 1553 1106 1508 1398 1613 1508 1718 959 1541 1272 1588 1489
- 1704 1499 1706 1586 1731 1242 1539 878 1481 1536 1715 848 1550 1161 1538 1562
- 1747 1209 1530 1571 1745 932 1521 1170 1546 1313 1595 1157 1507 1289 1591 1240
- 1549 1302 1621 1395 1603 1298 1591 1418 1637 1120 1534 1528 1706 1231 1530 1343
- 1616 1376 1606 1557 1734 1583 1744 1326 1617 1295 1568 1541 1705 1527 1690 1335
- 1602 1332 1575 1294 1574 1460 1667 100 { m20} R 1290 1549 1418 1660 892 1545
- 1389 1643 1157 1511 906 1492 918 1488 938 1502 1253 1545 1361 1614 1222 1539
- 1372 1651 1385 1640 1421 1659 1548 1701 1317 1583 913 1492 1517 1686 1069 1493
- 1526 1683 1444 1663 1584 1723 1465 1672 1130 1530 1451 1628 1167 1537 1375 1652
- 1325 1562 1378 1637 853 1496 1202 1579 1569 1734 1142 1556 1522 1725 1007 1506
- 1320 1569 1417 1671 1211 1593 1478 1691 1275 1581 1302 1623 1042 1486 1451 1648
- 969 1486 1228 1535 980 1486 1367 1607 1118 1567 48 { m20} R 0.58182 0.8 0 c 859
- 1633 1311 1680 892 1606 1409 1727 1312 1634 1448 1751 1522 1787 1141 1588 1489
- 1765 1241 1621 1527 1796 1489 1787 1190 1616 1073 1612 1324 1672 1358 1664 1512
- 1762 1444 1755 905 1651 1310 1641 796 1594 1523 1749 1423 1726 1291 1668 1460
- 1720 1377 1660 1441 1696 1207 1608 1500 1777 1413 1726 1534 1779 1429 1724 596
- 1683 1479 1746 1512 1796 1424 1726 1381 1705 1257 1642 1400 1685 1223 1607 1509
- 1733 1537 1786 931 1639 1510 1774 1018 1580 1039 1586 1235 1646 1148 1613 1398
- 1720 1527 1783 1538 1771 1407 1725 1261 1630 1444 1746 1257 1630 1348 1666 1540
- 1769 1046 1622 1345 1716 1545 1776 1471 1731 1255 1623 1455 1729 1069 1570 1507
- 1780 1027 1599 1085 1660 1476 1776 1096 1659 1094 1650 1420 1677 1460 1764 1505
- 1756 1212 1683 1301 1667 1509 1748 1256 1610 1402 1683 1456 1724 79 { m20} R
- 0.72727 0.8 0 c 1492 1822 1419 1845 1504 1807 1395 1792 938 1731 1301 1741 1439
- 1768 1174 1755 1295 1768 1410 1834 1351 1742 978 1668 1335 1801 1485 1839 1355
- 1771 1360 1781 1389 1798 1514 1816 1206 1753 1279 1730 1431 1830 1158 1710 1437
- 1768 1372 1807 1506 1818 1381 1772 1453 1780 1250 1770 1416 1821 1282 1729 1179
- 1762 1282 1750 1438 1764 1315 1746 1429 1814 1201 1698 1223 1758 1254 1792 1262
- 1763 1287 1724 1308 1794 41 { m20} R 0.8 0.72727 0 c 1435 1918 1137 1782 1196
- 1872 1415 1896 1281 1807 1445 1885 1008 1778 1168 1866 1374 1889 970 1818 1376
- 1870 1335 1882 1353 1882 1406 1877 961 1793 1463 1873 1434 1854 1430 1903 1280
- 1846 1453 1881 1408 1908 1462 1874 1127 1813 1405 1847 1414 1881 25 { m20} R
- 0.8 0.58182 0 c 1356 1944 1197 1990 1222 1996 1281 1952 1407 2005 1369 1940
- 1335 2034 1377 1954 1231 1907 9 { m20} R 0.8 0.43636 0 c 1356 1944 0.8 0.29091
- 0 c 1356 1944 0.8 0.14546 0 c 1356 1944 0 0 0.8 c 1356 1944 0 0.14545 0.8 c
- 1356 1944 0 0.29091 0.8 c 1356 1944 0 0.43636 0.8 c 871 1085 847 1074 1156 1237
- 908 1098 858 1069 5 { m20} R 0 0.58182 0.8 c 924 1089 801 1046 1244 1295 1034
- 1143 857 1062 1080 1171 948 1099 961 1108 797 1044 913 1085 870 1068 796 1043
- 1038 1149 810 1049 1094 1181 15 { m20} R 0 0.72727 0.8 c 926 1088 721 1032 1220
- 1246 858 1067 869 1067 1015 1128 871 1068 1098 1171 747 1042 853 1065 922 1087
- 816 1051 973 1108 766 1039 919 1085 874 1070 826 1056 1114 1179 994 1117 779
- 1039 778 1041 805 1050 796 1044 735 1039 742 1031 761 1038 841 1062 919 1085
- 1059 1150 960 1102 830 1057 1042 1141 867 1068 935 1092 929 1091 781 1044 823
- 1052 1087 1164 849 1062 871 1070 1063 1152 1008 1123 750 1034 947 1097 763 1037
- 1046 1143 768 1038 862 1066 1004 1122 784 1048 50 { m20} R 0 0.8 0.72727 c 793
- 1064 1201 1231 1314 1316 999 1125 747 1058 1030 1140 946 1107 751 1060 737 1041
- 1015 1128 850 1070 667 1053 733 1048 701 1051 748 1045 815 1060 883 1085 958
- 1109 891 1080 797 1060 732 1060 867 1073 1087 1164 773 1056 832 1065 1503 1476
- 990 1124 830 1067 855 1078 737 1054 1270 1278 870 1080 1358 1346 712 1043 954
- 1111 1043 1146 1071 1159 833 1072 751 1045 895 1087 876 1075 716 1053 871 1074
- 699 1036 864 1083 816 1073 857 1069 988 1122 918 1098 813 1056 893 1086 1022
- 1136 739 1054 1227 1250 822 1071 1212 1238 1048 1149 713 1045 802 1053 1311
- 1309 962 1104 740 1053 1041 1141 1014 1128 886 1084 710 1038 727 1046 979 1118
- 798 1062 1092 1167 713 1040 739 1045 678 1047 683 1047 967 1107 688 1053 991
- 1125 823 1072 885 1083 79 { m20} R 0 0.8 0.58182 c 1025 1153 711 1065 976 1136
- 1070 1160 1420 1394 808 1093 1173 1216 1301 1305 1040 1151 679 1064 766 1066
- 1133 1198 1003 1143 678 1088 746 1077 1223 1250 871 1091 763 1065 620 1086 1250
- 1264 1321 1316 873 1101 990 1131 1071 1161 897 1111 697 1071 1390 1370 979 1125
- 637 1080 783 1080 908 1098 933 1118 852 1106 777 1081 870 1086 705 1066 828
- 1095 745 1076 1034 1149 909 1105 647 1070 1189 1225 819 1080 1052 1162 1013
- 1136 1368 1352 691 1061 1332 1327 927 1117 902 1099 1331 1324 760 1080 1031
- 1148 1119 1189 697 1080 871 1101 794 1076 1057 1166 1036 1154 614 1091 784 1080
- 1031 1146 723 1087 1477 1444 1143 1208 1021 1144 1163 1211 667 1058 854 1092
- 795 1086 727 1061 802 1083 1230 1252 700 1090 892 1093 827 1086 879 1104 848
- 1089 922 1118 1298 1302 932 1109 753 1089 1135 1202 961 1123 681 1063 1285 1291
- 858 1098 810 1082 728 1090 1213 1241 1165 1213 761 1091 716 1072 772 1067 754
- 1065 797 1074 948 1127 1032 1152 1021 1147 806 1092 100 { m20} R 898 1114 1164
- 1211 952 1130 1135 1205 1136 1201 1591 1552 1021 1141 984 1134 870 1099 804
- 1091 631 1090 964 1123 985 1141 769 1072 832 1082 1028 1145 732 1088 985 1130
- 1209 1239 1007 1134 802 1095 914 1103 827 1079 721 1085 1247 1269 808 1078 1038
- 1146 774 1082 849 1099 789 1077 1187 1233 790 1085 1324 1319 862 1094 1207 1238
- 1113 1185 709 1067 918 1104 1081 1176 897 1109 766 1092 1075 1175 1047 1154 714
- 1067 897 1099 764 1093 907 1110 731 1075 879 1092 885 1095 942 1109 1092 1180
- 730 1070 1106 1189 912 1111 1337 1329 865 1091 1199 1237 1093 1174 725 1079 752
- 1064 821 1097 859 1093 1015 1142 1166 1221 812 1085 1185 1224 1062 1166 827
- 1091 1188 1228 958 1118 978 1122 72 { m20} R 0 0.8 0.43636 c 1045 1191 821 1136
- 685 1128 900 1132 971 1161 884 1136 1204 1263 985 1154 682 1101 1031 1161 648
- 1122 678 1092 691 1108 1066 1191 738 1121 853 1120 716 1102 605 1113 1025 1183
- 1168 1226 1020 1156 1380 1372 924 1140 919 1123 614 1135 791 1098 899 1137 841
- 1123 992 1156 1184 1241 944 1157 986 1145 881 1136 803 1116 867 1125 1068 1185
- 762 1123 819 1118 800 1118 589 1134 748 1125 1368 1362 609 1107 950 1141 695
- 1098 666 1114 1446 1423 738 1095 1072 1190 782 1118 701 1106 941 1133 727 1111
- 622 1120 1084 1204 1022 1165 766 1100 689 1130 827 1113 846 1106 1009 1162 641
- 1115 1033 1161 965 1146 753 1109 1353 1349 629 1121 704 1132 823 1106 856 1115
- 960 1158 1207 1263 1057 1180 901 1149 679 1099 1163 1235 876 1112 1017 1157 633
- 1131 694 1120 1088 1197 623 1096 769 1125 1237 1271 1177 1238 1023 1169 811
- 1102 920 1140 949 1136 1062 1189 1049 1181 681 1132 1001 1164 682 1104 1489
- 1461 848 1130 1030 1167 775 1123 1286 1302 936 1155 100 { m20} R 1227 1267 697
- 1095 696 1113 1361 1356 1043 1165 1110 1211 827 1106 1044 1188 635 1135 1193
- 1256 774 1131 1027 1183 724 1131 771 1095 747 1127 739 1093 1429 1409 782 1128
- 1003 1160 1228 1264 857 1119 1164 1225 1459 1429 690 1102 765 1098 1043 1179
- 876 1134 587 1125 1012 1171 1303 1315 848 1136 1102 1196 968 1139 1202 1259 905
- 1150 998 1172 1033 1180 728 1131 872 1115 767 1110 664 1131 614 1129 1427 1401
- 1505 1470 972 1159 911 1135 732 1120 624 1100 750 1133 1336 1339 986 1169 1257
- 1288 649 1130 857 1114 1124 1205 1195 1258 1027 1170 911 1141 680 1114 1141
- 1227 992 1163 618 1128 855 1137 911 1121 1086 1193 1212 1259 1257 1282 1326
- 1334 1116 1199 833 1127 853 1140 891 1136 931 1143 1039 1186 682 1106 636 1118
- 1436 1412 737 1121 689 1096 632 1093 890 1118 1243 1282 980 1153 1117 1205 949
- 1159 880 1133 900 1133 1132 1210 678 1096 836 1120 685 1105 1206 1255 728 1131
- 1213 1267 1291 1304 941 1130 1310 1321 789 1128 937 1140 637 1124 100 { m20} R
- 951 1162 871 1120 1054 1192 691 1110 4 { m20} R 0 0.8 0.29091 c 1461 1448 862
- 1151 673 1172 966 1186 1191 1264 987 1173 1525 1494 1083 1217 999 1198 1193
- 1279 1223 1282 1367 1376 1376 1382 852 1177 1220 1295 672 1157 1209 1284 1251
- 1315 916 1157 919 1177 1203 1292 1100 1233 1348 1372 700 1139 756 1141 902 1188
- 1062 1199 1275 1304 662 1153 982 1191 963 1181 772 1170 995 1185 923 1165 956
- 1180 1525 1506 1130 1255 1084 1209 649 1146 1233 1303 759 1168 682 1179 892
- 1185 711 1177 725 1144 1278 1330 1127 1245 911 1162 818 1173 643 1136 1205 1268
- 1134 1254 889 1177 750 1139 880 1174 915 1160 1147 1259 1571 1544 1064 1204 782
- 1138 1133 1230 1013 1202 850 1178 1265 1324 757 1183 775 1170 1127 1238 681
- 1163 830 1185 1482 1470 963 1170 1243 1306 712 1152 566 1149 574 1188 676 1161
- 538 1201 950 1202 1290 1337 828 1144 1081 1220 1399 1401 1086 1214 1355 1376
- 835 1186 1193 1282 1002 1192 763 1158 1360 1368 1480 1466 1200 1273 563 1174
- 1168 1250 1261 1318 758 1138 779 1138 1030 1218 799 1171 1296 1341 1371 1388
- 100 { m20} R 670 1169 776 1144 1299 1343 639 1165 771 1159 784 1144 1474 1462
- 1493 1470 972 1173 1255 1315 800 1144 1162 1266 989 1202 891 1165 686 1141 937
- 1179 849 1153 835 1148 1401 1401 1146 1258 1011 1183 864 1178 1088 1209 588
- 1174 1498 1470 1101 1215 1285 1332 1393 1403 1263 1321 656 1165 1352 1372 637
- 1169 846 1146 1065 1204 845 1181 1014 1190 620 1162 924 1173 772 1161 1260 1320
- 595 1165 766 1179 653 1149 1707 1674 1546 1524 1033 1208 1458 1436 715 1176
- 1102 1223 900 1179 1258 1312 836 1175 1443 1430 1187 1268 664 1174 718 1153 859
- 1157 1102 1247 804 1182 868 1152 609 1140 898 1189 808 1137 805 1163 748 1154
- 683 1141 1341 1364 1140 1242 1079 1217 913 1184 814 1165 644 1167 953 1175 786
- 1148 911 1185 1585 1548 816 1181 747 1150 993 1178 1285 1327 1503 1475 798 1140
- 784 1144 1014 1192 1250 1308 1423 1410 969 1194 1150 1236 1139 1241 1158 1244
- 974 1208 1422 1408 641 1160 1066 1230 952 1165 712 1185 781 1153 872 1175 1041
- 1206 782 1160 100 { m20} R 1121 1231 794 1163 1163 1261 735 1138 1026 1204 1058
- 1199 1250 1310 983 1193 915 1180 1031 1216 762 1149 1640 1607 1148 1242 624
- 1141 1153 1266 823 1142 682 1157 970 1197 787 1160 602 1156 1126 1226 1081 1210
- 1137 1231 1269 1313 883 1157 752 1149 577 1147 1264 1312 869 1147 897 1151 1439
- 1423 642 1163 1006 1213 1715 1681 1218 1299 1418 1406 958 1172 846 1143 38 {
- m20} R 0 0.8 0.14545 c 899 1247 1358 1399 1044 1264 1448 1456 1302 1379 1212
- 1313 1134 1294 1391 1427 1295 1363 702 1198 925 1244 1124 1264 1068 1257 1445
- 1453 1358 1388 885 1211 662 1219 1125 1261 1159 1301 857 1191 1364 1409 974
- 1227 1368 1402 751 1229 1276 1359 1150 1280 986 1216 941 1228 1290 1352 1480
- 1471 1207 1299 796 1219 781 1202 1350 1396 1015 1251 1082 1264 1387 1431 1102
- 1249 1680 1659 1539 1530 866 1197 555 1272 1059 1264 617 1239 1108 1281 1622
- 1603 1305 1376 590 1202 874 1203 1146 1280 949 1249 1200 1307 937 1233 533 1261
- 979 1236 1581 1570 768 1224 1123 1267 720 1213 1434 1440 750 1192 1017 1246
- 1339 1385 843 1233 939 1230 897 1209 941 1231 1106 1261 1299 1361 1222 1335
- 1219 1330 1270 1352 855 1198 670 1249 908 1198 828 1187 945 1207 782 1213 1120
- 1299 584 1225 876 1194 593 1227 1171 1302 1256 1331 639 1222 1112 1293 1147
- 1296 800 1210 1039 1270 1065 1239 855 1197 1093 1247 1180 1312 558 1211 1079
- 1261 1044 1235 753 1242 1491 1497 1022 1222 840 1240 100 { m20} R 1467 1462 751
- 1213 959 1237 1581 1572 1244 1328 1357 1386 1537 1539 814 1233 693 1204 769
- 1241 1714 1701 1058 1246 1089 1250 1170 1309 1635 1617 757 1237 684 1238 883
- 1222 735 1191 702 1200 1445 1451 558 1240 985 1226 1203 1318 713 1190 1006 1235
- 1023 1254 1161 1302 807 1222 1067 1256 746 1238 1058 1238 1032 1244 1170 1308
- 1384 1403 989 1256 734 1215 627 1201 825 1191 1078 1244 1336 1398 1734 1722
- 1352 1398 993 1262 1434 1441 1048 1257 1278 1363 906 1204 1100 1272 818 1231
- 813 1190 922 1245 813 1187 1099 1250 1207 1303 987 1238 946 1214 1376 1401 920
- 1224 1141 1305 1243 1336 1587 1564 1416 1432 766 1222 813 1223 941 1234 1223
- 1337 1619 1595 1197 1297 1062 1254 1578 1563 592 1209 1360 1384 598 1240 1228
- 1340 1169 1302 1472 1467 1258 1357 966 1233 1430 1455 770 1232 1317 1370 1510
- 1500 907 1202 1454 1450 639 1209 772 1202 1225 1324 586 1213 803 1188 769 1186
- 879 1223 1089 1245 1697 1673 978 1226 656 1196 911 1223 752 1186 558 1242 806
- 1185 100 { m20} R 1260 1337 1381 1415 988 1216 1107 1292 1142 1290 889 1218 904
- 1242 950 1229 661 1211 750 1207 733 1189 880 1234 888 1223 1021 1251 819 1195
- 858 1236 1272 1341 1385 1412 1602 1582 1180 1309 1198 1323 1108 1255 1076 1274
- 1222 1334 1197 1296 1148 1273 1207 1295 686 1225 1240 1340 1197 1321 633 1198
- 573 1205 624 1230 906 1201 830 1238 1068 1267 1005 1238 1390 1428 1482 1490 847
- 1198 975 1235 1512 1510 1015 1249 1339 1371 1097 1271 744 1205 948 1226 935
- 1233 1114 1283 1185 1321 810 1205 564 1267 1575 1569 1277 1346 690 1239 55 {
- m20} R 0 0.8 0.4069E-06 c 1146 1315 911 1286 689 1322 1210 1354 1339 1403 1111
- 1308 1189 1369 1506 1533 1180 1359 862 1295 1101 1311 723 1307 1018 1280 951
- 1270 963 1310 1436 1485 1312 1403 1234 1372 1162 1326 1242 1371 593 1310 1196
- 1358 1438 1471 755 1300 989 1320 1258 1405 1400 1470 1215 1378 1290 1388 742
- 1305 1220 1341 1453 1508 1191 1350 1140 1348 1257 1367 1008 1309 1435 1500 1207
- 1362 1126 1310 983 1312 809 1309 964 1307 584 1294 1257 1405 1010 1313 995 1287
- 1053 1279 1699 1707 1134 1354 1124 1341 1443 1478 1330 1406 1061 1289 1223 1346
- 847 1289 1008 1268 1475 1518 1131 1305 917 1287 1007 1281 826 1283 658 1278 967
- 1295 1018 1313 1076 1312 1466 1506 1212 1351 963 1269 1304 1416 1104 1325 1660
- 1661 1247 1369 796 1293 1474 1493 1521 1536 1705 1705 1054 1328 1086 1294 1658
- 1662 988 1292 1022 1272 617 1274 1219 1360 1684 1677 1166 1365 1389 1442 1158
- 1335 1076 1285 1242 1380 1063 1315 697 1297 1042 1331 965 1306 1006 1299 1218
- 1371 1454 1504 1184 1371 1219 1339 1095 1343 1579 1594 100 { m20} R 1145 1352
- 1190 1374 1167 1368 1450 1499 1171 1331 1239 1355 1478 1516 496 1297 1174 1329
- 1591 1608 1246 1371 640 1291 1397 1472 1387 1464 1119 1308 1137 1327 1108 1297
- 956 1298 1624 1641 1533 1549 525 1293 860 1262 973 1313 1370 1462 642 1270 971
- 1291 1258 1379 1069 1309 1451 1489 1261 1394 897 1250 606 1341 1445 1489 1210
- 1338 1603 1598 553 1309 1109 1314 1058 1324 833 1301 1234 1365 495 1320 1621
- 1634 969 1308 1056 1295 1151 1338 1718 1713 1037 1288 1531 1562 949 1258 455
- 1376 1503 1515 956 1259 1412 1455 1151 1332 1125 1325 878 1293 1422 1473 1139
- 1329 1141 1352 884 1255 1264 1407 1238 1382 944 1286 1425 1466 1485 1507 587
- 1320 1041 1314 1427 1460 1172 1323 1054 1301 1169 1340 1365 1445 853 1252 857
- 1278 1368 1439 950 1307 1113 1301 866 1301 1002 1266 1418 1462 1438 1503 726
- 1313 1213 1354 1432 1488 924 1290 1526 1557 1266 1396 1353 1416 806 1281 1155
- 1331 1055 1320 1066 1282 1587 1593 1598 1602 1366 1433 1446 1504 1176 1328 1398
- 1470 965 1271 972 1289 100 { m20} R 1526 1562 1146 1312 1324 1407 1512 1554
- 1369 1430 1221 1352 1479 1502 1234 1380 1424 1488 1220 1365 1162 1332 527 1345
- 1486 1538 1297 1407 989 1275 1271 1377 1225 1363 1294 1412 1301 1381 1473 1505
- 1385 1438 1527 1562 1259 1366 1151 1325 1186 1349 1600 1625 928 1261 1633 1642
- 1477 1520 785 1296 1450 1490 1245 1352 1253 1399 1378 1459 1362 1457 1129 1320
- 1483 1512 987 1317 476 1336 566 1283 904 1251 1322 1396 907 1306 1539 1575 1607
- 1601 647 1307 1289 1383 934 1285 738 1261 737 1266 1121 1316 1609 1607 614 1329
- 1093 1291 1155 1312 1681 1692 882 1269 1242 1386 1181 1328 473 1384 875 1296
- 1005 1301 1025 1285 1442 1493 1265 1376 1195 1369 1147 1313 67 { m20} R 0.14545
- 0.8 0 c 624 1357 1513 1565 1355 1499 1248 1401 934 1353 1124 1379 1233 1440
- 1333 1473 1440 1546 1063 1351 1325 1480 1095 1376 1539 1592 1071 1402 1571 1612
- 1196 1413 1133 1384 877 1325 1399 1482 1589 1644 1315 1462 752 1371 1654 1692
- 1385 1523 1250 1415 1456 1554 1120 1369 1639 1682 1189 1412 1089 1367 947 1331
- 1446 1533 483 1427 1026 1343 1199 1436 1549 1588 1096 1349 1073 1357 1150 1393
- 816 1373 1217 1422 1115 1354 1026 1334 1117 1359 1206 1412 1122 1394 602 1393
- 1373 1473 1277 1450 923 1333 1428 1515 1284 1458 1339 1476 1054 1341 1026 1370
- 1024 1331 1222 1425 734 1321 1185 1432 1339 1480 1397 1498 1513 1602 977 1390
- 1415 1518 1028 1332 1385 1490 1289 1434 1434 1508 1014 1332 1145 1408 1201 1434
- 793 1345 1667 1694 1035 1349 1051 1398 1132 1411 782 1375 1648 1679 1503 1561
- 1143 1403 1194 1424 1580 1640 1592 1625 1092 1376 1067 1363 1163 1417 1335 1466
- 1354 1471 1309 1483 1163 1375 1369 1485 1481 1537 1615 1642 1302 1440 992 1362
- 949 1376 1153 1368 1559 1594 1261 1462 1003 1363 100 { m20} R 1056 1375 1612
- 1666 1503 1562 1189 1432 1295 1459 1474 1553 1381 1507 1484 1576 698 1381 992
- 1375 705 1377 1389 1496 1551 1590 867 1357 1181 1425 1591 1626 1102 1353 1196
- 1410 1141 1374 1092 1396 1076 1361 1472 1535 1068 1354 1161 1410 1561 1604 1444
- 1523 1412 1511 960 1362 1288 1423 1522 1601 1155 1391 1374 1507 998 1346 992
- 1355 1637 1665 1340 1451 1236 1421 1391 1498 1219 1411 1434 1549 1184 1397 920
- 1336 1109 1400 1516 1586 1442 1514 1370 1511 1352 1504 1115 1383 1594 1623 1177
- 1426 1037 1380 1411 1515 1089 1390 1557 1621 877 1329 919 1329 548 1369 1515
- 1568 1532 1594 1392 1527 1058 1348 809 1317 1294 1435 1059 1346 1546 1626 948
- 1318 565 1393 1288 1451 935 1342 840 1319 1301 1436 1344 1471 1439 1526 856
- 1318 1333 1451 1056 1367 1471 1541 1003 1334 1394 1520 1436 1516 780 1389 1539
- 1581 1128 1362 1549 1592 1216 1405 1208 1409 966 1343 909 1345 1254 1416 1067
- 1340 989 1377 945 1324 1278 1464 982 1362 1254 1453 693 1342 1465 1544 1290
- 1432 1327 1463 1578 1637 100 { m20} R 1194 1416 911 1334 1371 1498 1452 1558
- 763 1387 1423 1502 612 1355 1113 1361 1346 1470 1550 1619 733 1343 1172 1418
- 1219 1441 850 1374 1518 1578 1303 1473 1449 1558 1358 1477 1327 1454 791 1354
- 1333 1444 1424 1501 1247 1447 1256 1418 1272 1466 1363 1468 1392 1500 1134 1414
- 1393 1526 1632 1654 1283 1443 1326 1469 1591 1622 758 1383 1583 1627 875 1345
- 1186 1387 1412 1514 1497 1569 1506 1557 1309 1433 1441 1543 1611 1672 1290 1454
- 973 1385 1213 1419 1280 1471 1316 1434 947 1341 1473 1559 1674 1706 1621 1674
- 1245 1456 1382 1497 1575 1621 1464 1547 567 1399 1556 1630 1304 1431 1026 1338
- 60 { m20} R 0.29091 0.8 0 c 1092 1456 1304 1535 1529 1665 1464 1589 1075 1476
- 1547 1664 1033 1449 1437 1567 930 1453 1337 1536 1597 1710 1280 1476 1139 1461
- 1358 1530 1350 1532 1208 1444 1476 1603 1574 1692 1578 1692 1346 1557 1188 1471
- 1287 1495 952 1448 1388 1543 823 1394 1261 1532 1126 1479 1445 1592 1624 1697
- 1167 1448 1554 1674 1308 1540 1269 1484 1404 1555 1376 1549 1272 1527 1214 1484
- 1199 1483 1157 1452 1125 1451 873 1434 1350 1529 1377 1555 1441 1610 1019 1423
- 1126 1491 1495 1613 1389 1562 1196 1471 1492 1606 1418 1580 1610 1726 1326 1498
- 1027 1421 1430 1574 1333 1534 1640 1716 1121 1447 1187 1437 1514 1606 1160 1447
- 1480 1586 1354 1550 1598 1677 1173 1483 1256 1475 1295 1517 1546 1680 1549 1643
- 1353 1557 1376 1554 1078 1429 1245 1509 1445 1574 1488 1606 1336 1555 1497 1616
- 899 1391 1132 1429 1471 1581 1459 1589 1267 1488 1543 1660 1518 1656 1215 1475
- 1330 1558 1549 1632 1084 1443 1233 1497 1208 1458 1272 1486 1589 1693 1516 1617
- 1406 1567 1330 1503 1006 1447 915 1425 1289 1518 1622 1689 1385 1546 100 { m20
-} R 1274 1517 1578 1659 1105 1451 1545 1655 1530 1635 985 1468 1487 1606 1536
- 1653 1344 1521 1275 1509 905 1419 1446 1562 868 1419 1527 1630 1525 1649 1139
- 1486 1299 1498 862 1430 1598 1682 1574 1676 1385 1540 1531 1617 1505 1652 1559
- 1641 1402 1577 1642 1713 1192 1461 1467 1613 788 1398 1134 1423 1605 1720 1266
- 1467 1087 1453 1578 1663 1413 1581 681 1420 1337 1561 1340 1528 1105 1444 1334
- 1550 1337 1505 1157 1470 1260 1488 1215 1471 1052 1462 1218 1463 1571 1683 830
- 1393 1249 1494 1631 1712 850 1441 1556 1678 1015 1473 1047 1450 1606 1677 1300
- 1493 1395 1533 1383 1561 1030 1417 1314 1541 1462 1627 1338 1546 1438 1586 880
- 1406 1147 1450 1225 1485 1301 1508 1403 1590 1132 1467 1589 1668 1593 1691 1199
- 1448 1483 1617 1419 1568 1244 1473 1005 1433 1502 1623 1528 1634 1334 1550 1588
- 1667 693 1420 1361 1530 1309 1532 1524 1613 1420 1547 1220 1500 1024 1411 1425
- 1547 1308 1512 1334 1509 1467 1622 1463 1604 1415 1543 1618 1724 1340 1510 660
- 1469 686 1425 1319 1503 1405 1541 1361 1570 100 { m20} R 1454 1571 1449 1582
- 1503 1599 1506 1641 834 1438 1134 1485 1499 1598 1018 1460 1519 1651 1418 1568
- 1402 1542 11 { m20} R 0.43636 0.8 0 c 1315 1566 1306 1607 1187 1583 1314 1572
- 1379 1587 1158 1558 1440 1681 1144 1534 1210 1517 1485 1677 1028 1479 1394 1654
- 1365 1610 1424 1610 1356 1622 1030 1551 1515 1686 1460 1637 1358 1604 888 1502
- 1013 1551 1526 1714 1403 1619 1345 1614 1453 1659 1510 1666 1226 1541 1391 1630
- 991 1494 1545 1719 1066 1505 990 1560 1438 1661 1006 1542 1568 1717 1447 1658
- 1481 1694 1546 1698 1260 1608 1521 1722 1178 1505 1431 1673 1098 1514 1338 1607
- 1076 1510 1199 1563 1095 1537 1109 1548 1282 1609 1418 1637 1324 1584 1447 1640
- 1304 1609 1231 1571 1391 1644 1394 1624 1427 1611 1481 1672 1340 1580 1384 1603
- 1074 1522 1492 1697 1380 1606 1178 1557 1442 1683 1154 1573 1492 1694 1561 1745
- 1074 1537 1244 1589 1352 1629 1411 1609 1318 1618 1317 1568 1149 1508 1374 1629
- 1446 1625 1246 1540 1518 1686 1513 1687 1532 1688 1538 1705 1333 1607 931 1559
- 1476 1670 1431 1670 1444 1654 1256 1556 1168 1557 1174 1506 1362 1577 1440 1684
- 1400 1596 1455 1683 1489 1689 1353 1588 1284 1572 1280 1578 1322 1589 1464 1640
- 100 { m20} R 1576 1733 1540 1680 1527 1682 1556 1729 1498 1681 1474 1638 1319
- 1606 1390 1619 1338 1565 1130 1502 1107 1561 1439 1633 877 1492 1487 1663 1455
- 1652 1542 1738 1328 1605 1338 1618 759 1550 703 1532 1276 1579 1132 1538 1271
- 1560 1413 1606 1419 1615 1177 1555 1067 1504 1084 1551 1418 1663 1508 1689 1024
- 1505 1334 1575 1576 1708 1219 1569 34 { m20} R 0.58182 0.8 0 c 1204 1599 1264
- 1691 1229 1650 1342 1672 1079 1657 1454 1752 1031 1597 1308 1706 1254 1650 1264
- 1657 1452 1703 1092 1581 1410 1684 1417 1682 1285 1690 1425 1686 1531 1757 1555
- 1762 1484 1746 1107 1659 1469 1714 1232 1628 1241 1665 1003 1645 1292 1646 1529
- 1749 1066 1627 1167 1637 1335 1696 1472 1720 1418 1697 1523 1757 1525 1798 1476
- 1742 1452 1721 1478 1765 1463 1772 1502 1780 1501 1722 550 1708 1378 1691 1384
- 1658 1364 1686 1403 1688 1258 1621 1538 1764 1124 1590 1458 1706 1451 1767 1466
- 1761 1320 1691 1474 1751 1028 1659 1386 1668 1342 1677 927 1635 1424 1680 1539
- 1767 1520 1784 1199 1665 1314 1658 1509 1779 838 1581 1371 1715 1198 1602 1426
- 1743 1548 1767 1408 1734 1458 1712 1470 1710 1528 1765 1433 1701 1488 1742 1308
- 1658 1475 1716 1171 1620 1403 1724 1271 1628 1359 1705 1307 1691 1198 1618 1104
- 1638 1415 1727 1082 1577 1393 1738 1550 1752 1502 1721 1471 1756 1263 1674 1465
- 1743 1365 1658 809 1584 1474 1765 1267 1693 1481 1710 1409 1675 1493 1749 1174
- 1669 1520 1745 1467 1710 100 { m20} R 1320 1653 1524 1785 1236 1611 3 { m20} R
- 0.72727 0.8 0 c 1236 1760 1278 1731 1386 1813 1288 1723 1485 1832 1495 1830
- 1453 1785 1067 1731 1438 1823 1465 1811 1349 1735 1487 1797 1469 1813 1218 1693
- 1094 1705 1369 1769 1484 1823 1355 1739 1504 1798 1424 1767 1414 1828 1361 1730
- 1425 1794 1360 1750 1219 1703 1227 1755 818 1738 1322 1726 1320 1789 1427 1809
- 1230 1694 1480 1809 1422 1818 1189 1708 34 { m20} R 0.8 0.72727 0 c 1357 1908
- 1230 1865 1460 1879 1228 1865 1330 1862 1349 1821 1451 1871 1004 1791 1394 1925
- 1433 1877 1126 1854 1382 1915 1323 1866 1128 1810 1364 1896 1317 1823 1444 1917
- 1239 1833 18 { m20} R 0.8 0.58182 0 c 1335 1930 1332 1957 1188 1899 3 { m20} R
- 0.8 0.43636 0 c 1335 1930 0.8 0.29091 0 c 1335 1930 0.8 0.14546 0 c 1335 1930 0
- 0 0.8 c 1335 1930 0 0.14545 0.8 c 1335 1930 0 0.29091 0.8 c 1041 1195 877 1098
- 2 { m20} R 0 0.43636 0.8 c 1003 1136 822 1058 906 1103 3 { m20} R 0 0.58182 0.8
- c 1177 1230 762 1035 803 1047 1069 1161 756 1033 842 1058 909 1084 992 1120 804
- 1046 1159 1221 799 1045 945 1097 871 1068 766 1035 1021 1139 806 1046 847 1059
- 790 1042 1127 1197 931 1091 772 1037 868 1067 783 1040 773 1038 24 { m20} R 0
- 0.72727 0.8 c 788 1049 906 1080 904 1080 746 1040 1034 1137 981 1112 794 1050
- 1091 1169 934 1092 845 1059 759 1037 1102 1173 879 1070 1230 1261 822 1057 835
- 1059 951 1098 722 1032 841 1062 820 1056 802 1050 1038 1138 1103 1177 840 1061
- 1074 1160 919 1085 796 1049 932 1092 860 1066 734 1035 978 1110 888 1073 780
- 1041 767 1041 716 1034 1145 1201 766 1043 782 1048 732 1036 898 1078 765 1042
- 733 1037 42 { m20} R 0 0.8 0.72727 c 914 1094 1062 1155 941 1097 860 1070 798
- 1066 803 1055 837 1072 879 1076 1088 1164 749 1043 725 1039 763 1059 889 1084
- 712 1057 1292 1294 829 1061 870 1076 834 1069 1287 1291 710 1047 724 1048 901
- 1082 1144 1198 697 1044 1027 1135 1110 1178 815 1070 815 1057 706 1043 1033
- 1138 928 1098 1126 1186 936 1103 698 1042 801 1061 1031 1137 679 1052 724 1042
- 703 1049 1191 1225 756 1046 855 1078 927 1098 1100 1172 735 1042 1152 1202 836
- 1075 949 1103 706 1051 1278 1286 750 1059 782 1067 927 1093 705 1050 882 1077
- 858 1078 702 1037 1379 1367 847 1073 796 1068 710 1043 1037 1145 727 1058 1268
- 1276 699 1049 932 1095 900 1083 729 1045 1130 1188 771 1063 826 1065 1098 1170
- 727 1039 932 1096 873 1076 1045 1142 837 1069 782 1049 1203 1234 791 1056 933
- 1095 682 1045 829 1072 1189 1224 816 1060 1018 1134 86 { m20} R 0 0.8 0.58182 c
- 1266 1277 906 1117 1063 1157 1057 1157 824 1100 867 1098 978 1121 1017 1149 908
- 1102 838 1080 714 1079 676 1065 1485 1453 1134 1196 996 1144 671 1066 1064 1158
- 661 1088 880 1100 907 1118 775 1069 732 1060 966 1129 1143 1199 1308 1309 683
- 1058 1057 1155 1128 1202 864 1106 662 1085 1426 1400 1041 1147 901 1102 678
- 1065 880 1112 927 1108 1217 1246 832 1097 986 1125 790 1081 748 1064 802 1096
- 662 1078 825 1088 874 1089 1221 1253 1163 1214 1008 1134 829 1081 1220 1253 938
- 1122 1053 1158 640 1070 696 1070 765 1084 629 1077 978 1140 827 1102 781 1071
- 864 1087 677 1087 744 1090 817 1100 987 1131 869 1088 1259 1275 1259 1273 1505
- 1469 1179 1225 1020 1145 995 1132 1023 1152 843 1092 748 1084 775 1067 956 1122
- 741 1084 933 1110 897 1104 725 1080 976 1132 1168 1216 895 1105 826 1083 690
- 1079 1118 1185 1130 1199 992 1142 878 1104 1149 1201 1118 1195 923 1114 838
- 1080 1067 1171 846 1080 993 1141 758 1076 861 1091 795 1093 1020 1139 100 { m20
-} R 650 1066 687 1057 813 1077 1007 1147 1003 1131 663 1081 875 1094 820 1092
- 900 1113 848 1099 692 1058 725 1087 854 1091 927 1113 685 1061 926 1105 791
- 1073 916 1121 1130 1194 817 1083 889 1104 1333 1325 773 1082 761 1066 933 1115
- 1021 1142 753 1065 936 1126 1423 1397 823 1078 888 1096 1056 1167 798 1093 1001
- 1141 846 1096 1091 1171 678 1066 747 1069 632 1083 798 1098 911 1107 875 1109
- 1136 1196 1273 1281 896 1098 680 1078 902 1113 843 1080 1055 1165 1000 1140
- 1052 1165 1111 1192 1106 1178 53 { m20} R 0 0.8 0.43636 c 878 1139 752 1112 696
- 1131 1146 1227 791 1104 944 1139 991 1159 965 1145 601 1127 803 1123 803 1104
- 887 1126 614 1136 820 1129 1080 1198 1221 1265 748 1120 1092 1203 963 1153 785
- 1128 812 1106 1219 1257 1422 1406 663 1125 776 1129 1278 1294 1192 1248 648
- 1091 845 1120 1217 1259 1365 1356 1107 1204 1517 1480 935 1143 1072 1200 1044
- 1182 767 1114 1233 1276 1078 1192 921 1124 1219 1263 729 1105 1309 1323 985
- 1145 792 1102 1429 1406 1213 1260 626 1105 877 1132 833 1109 1007 1153 769 1101
- 1175 1242 1439 1416 928 1137 631 1099 1133 1216 1206 1249 665 1127 1382 1373
- 1038 1178 619 1099 1162 1225 958 1140 897 1119 1056 1173 682 1103 1191 1247 822
- 1134 694 1132 885 1114 674 1094 1227 1259 1113 1205 761 1111 1182 1232 586 1125
- 711 1115 1028 1166 756 1118 1519 1482 1281 1297 643 1121 901 1118 1325 1327
- 1153 1234 857 1135 1017 1166 947 1144 1150 1215 709 1113 1360 1356 828 1135
- 1001 1150 1154 1235 1390 1377 1178 1238 1048 1193 1218 1270 952 1150 100 { m20
-} R 1242 1267 1307 1319 1098 1191 1110 1210 1055 1187 858 1133 704 1127 650 1102
- 1276 1294 953 1136 986 1151 914 1121 1092 1194 834 1122 722 1107 857 1112 1007
- 1156 741 1106 582 1127 673 1109 1161 1222 589 1128 888 1121 619 1105 1041 1167
- 1336 1331 983 1153 820 1119 861 1123 748 1110 1153 1219 851 1117 828 1111 671
- 1127 814 1135 978 1148 852 1116 582 1141 877 1145 1017 1171 1001 1156 689 1132
- 893 1140 999 1147 806 1113 924 1127 975 1143 1544 1505 929 1133 1112 1210 772
- 1122 1002 1169 1092 1194 1011 1167 1017 1176 985 1158 1111 1195 766 1097 623
- 1122 671 1090 1143 1213 1301 1309 636 1131 1036 1166 919 1126 613 1101 1051
- 1179 773 1100 909 1152 671 1098 1043 1173 1049 1192 687 1118 758 1113 615 1120
- 630 1124 1145 1221 1053 1180 1198 1258 760 1108 1203 1254 1059 1172 601 1121
- 1177 1232 912 1121 947 1145 1175 1241 676 1133 1538 1500 1347 1340 902 1136 659
- 1102 980 1146 949 1152 1138 1220 1271 1295 799 1136 772 1109 98 { m20} R 0 0.8
- 0.29091 c 846 1164 1263 1299 1358 1370 1161 1271 955 1165 758 1136 935 1173
- 1161 1265 697 1161 674 1156 704 1145 981 1200 753 1160 1120 1246 1046 1205 1309
- 1329 841 1160 798 1155 1217 1271 625 1152 1021 1187 914 1190 659 1136 821 1174
- 1341 1349 604 1144 728 1161 1297 1324 815 1172 1204 1276 1123 1246 966 1193 834
- 1160 718 1138 1113 1239 1094 1233 1039 1199 1059 1223 1216 1282 1146 1263 1105
- 1216 1450 1437 915 1176 1182 1253 736 1174 1151 1238 717 1172 796 1138 844 1168
- 1097 1214 1151 1258 1017 1219 737 1158 842 1151 1219 1293 1398 1408 610 1143
- 761 1160 634 1165 1219 1294 1251 1307 966 1176 765 1164 581 1166 1506 1480 1106
- 1248 1097 1244 876 1186 1775 1752 1234 1295 1370 1383 717 1169 772 1160 1141
- 1239 1165 1248 745 1136 976 1189 967 1191 1212 1272 846 1146 1422 1415 1275
- 1324 1318 1345 721 1167 1118 1252 809 1145 1481 1466 990 1180 1126 1248 802
- 1143 1140 1248 834 1145 778 1181 1094 1223 751 1151 954 1178 1221 1296 1190
- 1259 1315 1346 1787 1764 100 { m20} R 755 1143 766 1135 624 1155 917 1159 1271
- 1322 1404 1408 910 1155 1396 1401 782 1169 671 1150 1373 1389 837 1166 1090
- 1225 1122 1233 966 1200 1168 1271 1291 1335 605 1140 1151 1239 1565 1531 1233
- 1295 948 1196 805 1178 785 1150 1166 1274 1348 1359 576 1189 1312 1340 946 1201
- 1281 1327 773 1155 1217 1285 720 1152 1085 1227 1128 1247 607 1141 835 1148
- 1210 1292 1036 1208 1237 1304 1297 1340 779 1166 863 1180 1103 1231 1069 1207
- 996 1190 1083 1229 1094 1243 1012 1187 631 1145 918 1162 1082 1209 587 1144 876
- 1148 786 1152 733 1161 690 1134 1193 1278 667 1185 589 1191 649 1160 1099 1239
- 1045 1207 779 1143 690 1172 1071 1220 767 1181 711 1137 573 1198 641 1146 885
- 1174 607 1140 594 1183 622 1164 1030 1216 1085 1241 1202 1286 1458 1449 749
- 1171 1278 1325 1329 1346 1612 1575 1279 1310 852 1165 978 1198 707 1143 984
- 1188 791 1140 1088 1222 1088 1235 818 1185 1411 1416 653 1158 836 1141 705 1159
- 1116 1239 1085 1216 1104 1220 653 1173 1038 1218 100 { m20} R 1173 1249 990
- 1192 933 1200 985 1186 961 1171 1163 1265 800 1142 683 1158 706 1144 930 1180
- 946 1172 893 1191 1038 1209 922 1165 1129 1246 1326 1342 779 1172 822 1173 773
- 1147 935 1167 1429 1423 680 1141 1478 1465 716 1180 1389 1398 875 1171 906 1155
- 1005 1197 1341 1352 1078 1232 733 1172 977 1192 1209 1270 897 1174 860 1179
- 1192 1263 1020 1212 694 1158 898 1188 770 1152 1104 1246 862 1168 591 1171 878
- 1173 570 1174 1434 1422 1522 1500 1020 1189 1023 1207 708 1152 1451 1431 1052
- 1211 942 1181 937 1181 1373 1373 1147 1261 798 1176 1242 1305 981 1197 1066
- 1224 1003 1208 952 1185 852 1156 916 1166 918 1177 1189 1279 839 1151 947 1168
- 1134 1236 1084 1239 802 1178 1113 1246 1219 1272 603 1170 74 { m20} R 0 0.8
- 0.14545 c 1211 1332 803 1237 838 1220 966 1245 932 1211 1624 1612 875 1224 1549
- 1541 966 1217 1155 1283 1235 1335 1326 1373 1194 1296 531 1277 1324 1389 1286
- 1346 963 1228 1159 1304 991 1238 663 1203 860 1210 946 1226 974 1251 1570 1566
- 886 1210 576 1206 655 1215 1322 1388 1011 1248 655 1221 1193 1292 1007 1252 941
- 1252 1432 1448 975 1218 1174 1318 1501 1491 1183 1287 543 1252 843 1196 963
- 1246 733 1221 1088 1269 884 1223 1076 1242 949 1203 1227 1317 1375 1424 767
- 1214 1373 1419 599 1203 786 1242 1309 1378 614 1229 828 1212 1267 1334 1522
- 1519 1197 1291 1532 1516 866 1215 835 1203 1495 1491 1040 1241 1628 1612 1519
- 1504 1315 1375 1562 1546 1210 1308 1452 1461 689 1187 1510 1500 1073 1277 1135
- 1282 638 1248 918 1208 804 1206 1071 1237 986 1252 1218 1336 613 1203 1253 1343
- 915 1239 899 1211 1145 1299 938 1242 910 1199 1332 1383 1333 1391 743 1187 1416
- 1434 881 1208 972 1227 1353 1393 919 1199 802 1193 974 1215 1648 1620 600 1227
- 1385 1400 1372 1413 100 { m20} R 1298 1352 1403 1421 681 1202 1079 1266 1480
- 1489 1059 1250 1062 1251 986 1226 1339 1390 566 1254 1197 1301 927 1214 1087
- 1283 1024 1259 1144 1273 994 1259 1220 1311 600 1237 1656 1645 913 1221 549
- 1227 1181 1292 1040 1268 1631 1617 1345 1405 1062 1278 915 1202 651 1229 924
- 1240 756 1230 1067 1254 1089 1276 1189 1305 768 1190 1106 1285 1473 1470 1472
- 1471 971 1215 1381 1421 791 1223 1589 1576 1027 1247 915 1249 1333 1394 1531
- 1519 763 1202 1079 1245 1159 1291 1017 1232 809 1197 1136 1280 605 1223 1091
- 1245 1053 1234 1167 1312 1562 1551 780 1193 599 1255 1143 1297 851 1198 1064
- 1278 1318 1389 966 1219 1175 1302 928 1211 1028 1268 977 1249 587 1264 1213
- 1304 1193 1307 1133 1298 989 1225 952 1250 1290 1356 1250 1319 874 1195 1424
- 1449 609 1258 772 1193 1700 1678 718 1189 1352 1377 1525 1519 1430 1436 1186
- 1323 837 1216 1543 1527 651 1238 1318 1373 876 1213 1108 1291 1220 1328 954
- 1212 1696 1673 1516 1502 1328 1389 1081 1269 1052 1275 527 1232 1683 1664 100 {
- m20} R 796 1235 1367 1403 1057 1270 1047 1264 1158 1272 1075 1265 945 1242 1280
- 1354 732 1223 1352 1393 1412 1430 1005 1238 759 1214 845 1216 1228 1323 685
- 1215 1074 1249 1712 1691 1140 1267 720 1239 1082 1243 788 1193 1261 1329 685
- 1229 1001 1225 1053 1255 845 1196 1196 1325 1291 1345 1510 1497 729 1203 543
- 1224 1208 1329 1216 1301 905 1222 958 1212 747 1242 1100 1264 838 1192 1285
- 1337 1096 1252 1033 1258 970 1222 1100 1287 1292 1360 1180 1283 1170 1294 1036
- 1233 1301 1360 1287 1352 1215 1326 874 1233 1169 1309 762 1196 1212 1327 877
- 1224 767 1207 1321 1360 1335 1374 570 1219 682 1240 920 1225 1154 1306 969 1231
- 970 1243 812 1232 1213 1326 890 1238 1159 1296 1386 1410 1002 1216 71 { m20} R
- 0 0.8 0.4069E-06 c 1097 1303 1225 1374 1523 1557 1208 1352 841 1287 800 1310
- 1365 1432 1368 1459 1437 1493 619 1326 1001 1275 647 1259 1140 1347 1431 1486
- 1014 1319 1310 1393 882 1293 1500 1526 912 1296 1466 1522 740 1274 1303 1385
- 1353 1412 1032 1321 1259 1380 1470 1516 1352 1441 1201 1371 1306 1408 1164 1363
- 1252 1389 1424 1466 835 1280 1039 1275 1404 1466 679 1287 868 1261 949 1275
- 1359 1414 620 1333 1233 1375 616 1275 1022 1292 1643 1640 948 1282 1515 1541
- 1480 1498 1138 1337 1460 1495 751 1260 1338 1405 1358 1420 1132 1355 851 1280
- 1339 1420 1187 1344 1216 1358 936 1273 754 1286 1082 1296 964 1303 1484 1511
- 1414 1487 1073 1298 1053 1314 1573 1578 1262 1360 820 1254 1097 1320 951 1292
- 1175 1326 1354 1423 1465 1496 1185 1371 1220 1374 1333 1438 1385 1463 1074 1327
- 1176 1354 969 1265 1680 1694 1356 1420 943 1282 1633 1627 847 1277 1221 1371
- 945 1255 1407 1470 1574 1584 697 1255 793 1281 1083 1287 864 1265 714 1285 1224
- 1363 977 1284 1603 1623 1398 1476 1001 1312 1265 1384 100 { m20} R 1141 1338
- 573 1346 1348 1422 1242 1358 718 1252 1072 1309 1688 1683 787 1246 1595 1596
- 1204 1360 1039 1278 674 1264 1260 1360 1320 1424 739 1277 758 1284 777 1257
- 1355 1433 1230 1365 884 1253 1182 1331 764 1253 1096 1296 1482 1501 886 1260
- 1583 1593 937 1282 1556 1584 1334 1437 1313 1388 1375 1462 1178 1349 1011 1281
- 1336 1424 1633 1649 927 1288 1293 1398 899 1290 1261 1385 1274 1396 1174 1365
- 805 1252 1476 1507 1574 1583 1295 1400 1125 1308 1203 1355 1044 1287 1321 1435
- 1050 1307 856 1289 1078 1289 1496 1528 1145 1357 892 1251 1180 1366 1174 1345
- 1347 1416 836 1293 557 1285 960 1295 849 1279 1124 1320 915 1269 1265 1368 794
- 1279 1437 1478 1470 1516 1470 1506 1220 1371 1166 1358 891 1279 1585 1595 1233
- 1383 1137 1313 1011 1304 1324 1420 1039 1284 1229 1355 1026 1279 1056 1323 950
- 1265 1364 1432 1474 1512 1660 1673 1368 1433 1264 1399 1127 1326 1252 1385 1181
- 1365 1163 1342 985 1270 747 1303 1294 1391 841 1272 617 1284 1233 1378 1237
- 1382 1076 1290 1213 1358 100 { m20} R 1059 1303 1122 1346 1236 1373 1300 1421
- 949 1304 581 1286 1412 1462 882 1257 859 1295 863 1255 1219 1341 1043 1299 1120
- 1299 1192 1364 1510 1536 1216 1381 1350 1435 1392 1475 778 1254 1367 1451 1032
- 1313 1461 1520 1557 1570 1426 1474 917 1281 1153 1325 1165 1367 1510 1530 1393
- 1471 804 1263 1391 1460 666 1318 961 1308 1133 1333 737 1272 1535 1548 1331
- 1413 1144 1337 900 1259 39 { m20} R 0.14545 0.8 0 c 1219 1440 1411 1537 781
- 1331 1153 1424 1084 1392 916 1355 1663 1703 1372 1509 1026 1365 1302 1437 1386
- 1516 1161 1373 994 1370 1666 1705 1304 1447 1364 1497 609 1421 1044 1379 1386
- 1502 1301 1460 854 1357 1132 1397 1184 1425 613 1391 1009 1380 1097 1385 1008
- 1375 1647 1691 1380 1495 1217 1391 1381 1483 1005 1389 891 1318 1373 1475 821
- 1317 1492 1581 1230 1425 1188 1385 899 1345 1365 1498 942 1317 1624 1659 1466
- 1531 1318 1454 995 1380 1208 1416 1306 1484 1302 1446 1553 1617 1524 1592 1115
- 1386 1107 1403 1266 1431 1294 1445 1316 1453 1356 1457 1218 1440 1515 1592 1178
- 1408 1360 1504 1315 1452 804 1329 1560 1615 1656 1708 1385 1504 931 1338 1341
- 1500 1189 1413 1201 1438 1261 1431 1429 1513 1330 1487 1466 1542 1082 1388 1643
- 1690 1310 1466 1388 1482 1380 1515 1396 1519 1618 1661 772 1331 1284 1448 1306
- 1483 1066 1343 676 1397 1209 1405 1461 1559 1410 1499 955 1384 958 1363 1162
- 1398 1340 1491 1286 1458 934 1338 1563 1600 1276 1465 490 1439 1200 1394 834
- 1318 1456 1548 100 { m20} R 1552 1610 1462 1546 984 1325 1399 1515 1021 1342
- 1502 1567 1089 1389 1425 1499 1461 1539 1313 1462 805 1316 538 1418 1405 1532
- 1412 1517 1643 1703 1443 1537 1390 1510 1167 1420 1366 1502 1145 1376 1056 1341
- 1045 1359 1125 1359 1011 1337 1396 1489 1372 1464 1475 1559 1395 1516 1295 1423
- 1371 1511 1542 1608 1502 1584 1215 1423 673 1361 1408 1498 1045 1365 1229 1427
- 1411 1524 783 1331 1242 1426 1622 1669 1400 1513 1652 1676 1065 1348 1676 1704
- 1081 1374 1241 1414 1411 1534 958 1336 1525 1577 1202 1393 1544 1613 1265 1463
- 1423 1503 938 1373 1292 1468 1193 1398 1501 1555 1150 1411 1249 1411 1089 1395
- 1305 1472 834 1326 1043 1364 1547 1597 923 1350 1624 1675 1030 1385 1362 1469
- 1234 1405 1465 1529 1190 1424 1484 1582 780 1315 1314 1435 972 1361 1590 1645
- 1220 1411 1412 1499 1157 1379 1586 1642 1201 1429 1119 1414 1136 1384 1523 1587
- 1483 1581 874 1329 1371 1496 1221 1395 1533 1587 1176 1382 1562 1618 1162 1426
- 1369 1477 774 1374 828 1323 1279 1452 747 1321 796 1330 1386 1489 100 { m20} R
- 883 1344 892 1365 1661 1695 1340 1453 1375 1481 666 1329 851 1336 1020 1358
- 1014 1350 1073 1345 973 1387 985 1375 1311 1442 1391 1518 1346 1477 1077 1392
- 1256 1462 1664 1686 1343 1462 1498 1592 996 1337 1277 1426 1594 1626 745 1375
- 1228 1427 1087 1396 837 1332 963 1366 1541 1605 1436 1522 1239 1441 31 { m20} R
- 0.29091 0.8 0 c 1589 1691 1592 1704 1371 1543 1537 1666 1611 1685 1424 1569
- 1514 1649 1371 1536 1077 1441 1212 1495 975 1429 1178 1476 1446 1587 1549 1647
- 642 1452 1061 1441 983 1418 1409 1547 1201 1442 1202 1455 1646 1709 1384 1560
- 997 1452 650 1511 1302 1487 1540 1673 1288 1486 1267 1484 1613 1710 1174 1489
- 1027 1458 1022 1411 1523 1642 1489 1590 801 1410 1474 1602 1104 1475 1618 1711
- 1040 1427 1418 1561 1077 1468 1454 1603 1194 1486 1546 1648 824 1400 1287 1475
- 1590 1694 1361 1550 1248 1520 770 1472 1565 1663 866 1439 1346 1566 954 1439
- 1524 1637 1005 1417 1155 1469 1418 1565 1366 1531 1606 1703 1446 1618 1204 1450
- 1184 1467 1382 1523 1324 1522 1239 1522 1483 1622 962 1459 1318 1493 1322 1541
- 1342 1518 849 1439 1406 1544 1330 1511 1575 1697 1462 1599 1506 1607 1299 1540
- 1093 1461 1559 1674 1465 1572 1497 1645 1296 1486 1230 1475 1607 1721 1510 1617
- 1537 1640 920 1391 1345 1522 1177 1465 1168 1456 1232 1499 1313 1497 1248 1470
- 1499 1643 1171 1476 908 1415 911 1406 1391 1561 1607 1676 100 { m20} R 1584
- 1707 1365 1570 1457 1573 1386 1563 1550 1649 1062 1406 1079 1408 1302 1498 1471
- 1598 1400 1586 1112 1428 1474 1589 1409 1555 843 1392 989 1435 1550 1646 1530
- 1647 1079 1423 1467 1591 1634 1699 1275 1482 1524 1623 1535 1636 1548 1675 800
- 1418 1605 1697 1190 1448 1180 1446 1390 1554 960 1430 1326 1499 897 1407 1467
- 1620 1575 1697 1380 1582 1374 1551 1200 1450 1352 1553 1312 1537 1306 1499 1382
- 1551 1076 1408 1016 1459 1181 1444 1166 1459 1279 1527 1500 1646 1561 1669 1409
- 1575 1363 1553 1545 1662 1325 1519 1095 1446 1269 1521 1466 1584 1262 1488 1086
- 1410 1231 1461 1087 1409 1094 1412 1624 1714 1095 1446 1358 1567 1575 1682 1392
- 1539 1449 1572 1279 1487 1349 1544 1025 1405 1518 1618 1551 1669 1611 1722 1607
- 1682 1617 1704 1263 1500 1349 1545 1182 1463 1321 1519 925 1400 1186 1506 1284
- 1492 1109 1485 983 1425 1296 1544 1138 1439 1527 1624 1432 1607 1295 1496 1178
- 1457 1548 1649 948 1392 1542 1675 1400 1560 980 1404 1167 1479 1445 1606 1349
- 1561 1602 1678 1103 1469 1341 1553 100 { m20} R 1471 1619 1526 1633 1535 1672
- 1207 1471 1582 1706 1205 1447 1381 1529 1128 1442 1420 1579 1087 1434 670 1466
- 1360 1550 1227 1493 1155 1495 1584 1686 1533 1668 1422 1573 1569 1692 1110 1414
- 1116 1427 1596 1710 1457 1569 1400 1589 1633 1700 1173 1484 1216 1483 26 { m20
-} R 0.43636 0.8 0 c 1244 1567 1367 1623 1306 1556 1516 1691 1452 1681 1586 1721
- 1511 1705 1560 1724 1391 1605 1382 1637 1188 1527 1293 1572 1392 1650 1105 1556
- 1598 1732 1361 1576 1182 1567 1565 1758 1423 1623 1435 1674 1057 1487 1361 1603
- 1458 1629 1523 1704 714 1595 1224 1543 1352 1608 1392 1616 1375 1611 1076 1486
- 1366 1606 1422 1621 1078 1545 1276 1585 1399 1614 1224 1540 1419 1652 1378 1607
- 874 1553 1365 1638 1224 1534 1529 1710 1253 1599 1232 1575 1389 1600 1410 1651
- 1527 1685 1487 1669 1116 1558 889 1565 1505 1657 1353 1610 1599 1723 1564 1726
- 1085 1552 936 1479 1518 1682 1169 1561 1027 1528 997 1490 1082 1536 1221 1586
- 1457 1675 1051 1480 1556 1746 1389 1640 1438 1664 1283 1567 1472 1688 1235 1572
- 1190 1545 1364 1595 1566 1711 1507 1694 1488 1662 1438 1670 1267 1608 1308 1562
- 1354 1611 1379 1631 1495 1683 1252 1596 1333 1627 1578 1746 840 1552 1394 1605
- 1572 1740 1166 1516 1142 1513 1164 1528 1547 1709 1400 1654 1002 1499 1468 1690
- 1559 1749 1561 1748 1363 1643 1264 1579 646 1574 1320 1606 100 { m20} R 1210
- 1530 1084 1486 1300 1616 1081 1503 1262 1609 1600 1730 1200 1581 1134 1555 1394
- 1608 1400 1626 1428 1661 1487 1686 979 1540 638 1589 971 1518 1541 1709 1229
- 1554 1439 1670 1526 1683 1371 1647 1502 1691 1160 1511 1017 1500 1605 1726 1392
- 1620 1569 1737 1204 1546 1439 1629 1456 1644 1309 1612 1164 1538 1474 1655 1329
- 1568 1153 1511 1482 1641 976 1503 1123 1510 1346 1617 1441 1668 1570 1718 1377
- 1607 1378 1598 1533 1733 1375 1591 1240 1546 1468 1650 1037 1526 1248 1555 1384
- 1634 1048 1544 1242 1596 1256 1559 52 { m20} R 0.58182 0.8 0 c 1006 1565 1123
- 1586 1457 1729 1497 1781 1533 1786 1475 1726 898 1599 1149 1615 1412 1739 1334
- 1647 1057 1602 1253 1678 1331 1638 1506 1723 1412 1675 1435 1725 1494 1765 1323
- 1640 1350 1716 1521 1789 1303 1665 1209 1601 1081 1583 1381 1731 1471 1765 1460
- 1721 1323 1658 1488 1744 1380 1676 1495 1768 1202 1672 1363 1688 1101 1602 1528
- 1777 1535 1742 972 1605 1079 1594 1065 1618 1217 1616 1487 1741 1163 1628 1123
- 1633 1357 1667 1490 1718 1391 1665 1522 1775 1071 1638 1326 1654 1473 1726 962
- 1594 1318 1682 1183 1635 985 1597 1390 1684 1446 1741 1538 1747 1208 1658 1165
- 1595 1390 1741 1244 1676 1227 1628 1290 1660 1428 1747 1222 1614 1229 1639 1455
- 1710 1499 1757 1511 1730 1532 1741 1296 1634 1542 1752 1519 1778 1331 1663 1236
- 1669 1498 1719 1482 1724 1486 1733 1248 1627 1514 1736 79 { m20} R 0.72727 0.8
- 0 c 1462 1852 1511 1819 1486 1808 1255 1769 1477 1796 1435 1791 1437 1829 1241
- 1700 1153 1689 1370 1761 1054 1678 1453 1854 1493 1791 1453 1813 1446 1847 1392
- 1827 1504 1824 1411 1781 1508 1815 1343 1755 1091 1767 1198 1736 1406 1793 1324
- 1769 1491 1822 1464 1790 1394 1749 1381 1761 532 1799 1118 1696 1367 1742 1033
- 1767 1446 1783 911 1716 1240 1693 1365 1777 1217 1743 1051 1764 1472 1791 1408
- 1808 1468 1802 1492 1843 1444 1828 1365 1791 44 { m20} R 0.8 0.72727 0 c 1402
- 1920 1461 1885 1443 1867 1422 1908 1253 1836 1410 1870 1288 1822 1436 1853 1390
- 1885 1329 1866 1235 1849 1323 1847 1161 1807 1314 1831 1347 1917 1349 1890 1397
- 1892 1153 1790 1404 1846 1404 1921 20 { m20} R 0.8 0.58182 0 c 1333 2029 1351
- 1954 1384 2044 3 { m20} R 0.8 0.43636 0 c 1359 2097 m20 0.8 0.29091 0 c 1359
- 2097 0.8 0.14546 0 c 1359 2097 0 0 0.8 c 1359 2097 0 0.14545 0.8 c 1359 2097 0
- 0.29091 0.8 c 1359 2097 0 0.43636 0.8 c 990 1136 m20 0 0.58182 0.8 c 1039 1154
- 757 1034 796 1044 807 1047 882 1077 5 { m20} R 0 0.72727 0.8 c 1129 1189 926
- 1088 918 1085 1050 1144 737 1039 1050 1144 867 1070 750 1037 823 1057 872 1069
- 738 1038 833 1060 925 1088 13 { m20} R 0 0.8 0.72727 c 819 1068 810 1062 782
- 1061 713 1050 1017 1130 979 1112 835 1068 700 1053 919 1097 741 1048 980 1113
- 1074 1157 1223 1248 762 1047 1048 1143 873 1075 856 1082 896 1081 894 1085 859
- 1068 1240 1257 796 1062 749 1052 23 { m20} R 0 0.8 0.58182 c 963 1123 1262 1274
- 865 1103 1307 1307 1066 1166 834 1089 625 1090 1069 1160 750 1063 1230 1257 892
- 1113 833 1084 1042 1159 892 1099 927 1108 691 1073 875 1101 1030 1144 890 1101
- 844 1100 1232 1258 774 1094 1186 1233 900 1096 908 1117 687 1074 683 1065 1125
- 1189 821 1089 697 1077 692 1058 915 1108 1011 1139 875 1090 974 1123 816 1081
- 927 1104 1116 1196 38 { m20} R 0 0.8 0.43636 c 1256 1286 853 1119 733 1108 1132
- 1217 796 1108 632 1102 901 1130 1022 1178 809 1137 852 1133 846 1136 727 1104
- 1198 1250 732 1093 670 1103 930 1131 842 1109 1576 1538 652 1099 605 1108 1548
- 1512 916 1138 1429 1403 930 1127 1319 1326 836 1138 814 1120 793 1098 742 1116
- 1413 1392 716 1118 911 1128 1250 1281 936 1128 1177 1245 872 1123 1010 1171 773
- 1106 1212 1251 684 1130 647 1120 723 1126 946 1157 912 1140 761 1120 983 1159
- 1086 1199 795 1130 935 1157 981 1154 789 1118 51 { m20} R 0 0.8 0.29091 c 981
- 1201 1539 1515 1129 1248 896 1159 777 1149 963 1196 971 1174 674 1160 983 1195
- 933 1186 951 1191 1393 1393 1024 1199 604 1172 793 1177 1067 1210 884 1155 1071
- 1226 1019 1193 659 1159 747 1138 993 1205 843 1153 799 1179 850 1156 709 1153
- 574 1172 1080 1220 1063 1211 1036 1204 1358 1367 1331 1344 1625 1595 785 1151
- 1024 1198 1667 1633 1242 1300 551 1195 1407 1401 1331 1362 910 1157 1464 1441
- 697 1169 668 1187 598 1144 749 1154 1033 1220 1055 1226 856 1162 1089 1234 763
- 1151 927 1176 958 1182 672 1158 54 { m20} R 0 0.8 0.14545 c 1309 1375 908 1240
- 1128 1263 1372 1406 1647 1623 822 1233 767 1219 1582 1563 1112 1267 617 1224
- 600 1204 1617 1598 1529 1521 974 1254 885 1239 1450 1460 810 1187 645 1201 1186
- 1302 1222 1334 836 1218 1210 1310 1194 1310 1205 1323 1414 1422 1004 1245 1263
- 1344 1109 1253 1106 1289 926 1237 1441 1445 1123 1290 793 1207 633 1193 1081
- 1255 673 1210 549 1214 1131 1263 853 1229 964 1222 1505 1507 1029 1228 1558
- 1551 923 1217 693 1227 965 1212 772 1227 1311 1352 763 1222 1446 1450 1278 1340
- 999 1263 871 1216 1065 1236 710 1195 974 1221 1380 1414 595 1245 1002 1242 1172
- 1313 1601 1584 1322 1371 1279 1348 999 1236 1109 1252 992 1229 1074 1275 1424
- 1439 1631 1607 1223 1316 1363 1415 871 1243 1197 1319 608 1215 74 { m20} R 0
- 0.8 0.4069E-06 c 1650 1651 1224 1375 895 1256 770 1305 1085 1337 919 1272 789
- 1250 1406 1477 1501 1541 1699 1696 1271 1371 1185 1351 1186 1358 618 1294 1021
- 1303 1084 1306 1535 1548 1392 1459 1170 1337 1190 1328 1033 1277 1097 1316 1441
- 1498 942 1276 1518 1556 1620 1638 1076 1290 865 1261 844 1278 722 1277 917 1302
- 826 1300 1457 1512 1149 1313 492 1306 721 1248 665 1267 1020 1304 883 1300 1319
- 1398 1137 1337 1322 1407 1142 1312 753 1284 724 1310 1628 1622 1092 1312 696
- 1255 1484 1530 1433 1481 1190 1337 678 1259 1128 1335 783 1254 652 1325 1273
- 1384 988 1278 842 1256 985 1275 1564 1587 992 1272 1514 1523 1712 1711 1521
- 1559 1341 1442 1361 1429 1104 1314 1105 1307 558 1347 1171 1327 70 { m20} R
- 0.14545 0.8 0 c 1003 1332 1238 1433 1285 1448 1172 1422 1312 1467 1342 1476
- 1293 1459 1478 1554 1382 1507 688 1327 1471 1572 1536 1594 1387 1519 1065 1389
- 1505 1553 1475 1568 1484 1575 1548 1627 1099 1347 1509 1595 1592 1635 1112 1363
- 1543 1610 1586 1644 1636 1685 1069 1405 1386 1489 1214 1397 1601 1651 1313 1486
- 1536 1586 1274 1450 1239 1431 1115 1365 1151 1398 1153 1385 1306 1460 1130 1388
- 796 1338 1308 1473 1457 1539 1444 1547 1416 1530 1439 1544 1152 1379 1193 1384
- 1414 1506 936 1347 1348 1490 1106 1384 961 1384 1333 1496 854 1348 1527 1598
- 1035 1368 1320 1444 1118 1415 1387 1497 1124 1397 59 { m20} R 0.29091 0.8 0 c
- 1513 1620 1279 1505 1311 1538 1003 1410 1301 1486 1002 1419 1045 1466 1581 1689
- 1348 1510 957 1405 1350 1527 1312 1498 1154 1477 1407 1579 1356 1547 1522 1655
- 1528 1666 1114 1478 1514 1611 1483 1630 1071 1473 1330 1516 1188 1461 1458 1608
- 1455 1596 1431 1565 1140 1487 1026 1400 1495 1599 1359 1520 1188 1465 1317 1530
- 1367 1539 1233 1471 1185 1488 1112 1465 1279 1483 1225 1462 1100 1425 1211 1466
- 1280 1513 1214 1447 1537 1648 1437 1606 1567 1664 1095 1433 1304 1548 969 1446
- 1086 1464 1586 1663 1458 1591 1549 1660 1600 1706 1077 1448 782 1464 968 1422
- 56 { m20} R 0.43636 0.8 0 c 1097 1501 1434 1618 1412 1608 1205 1589 1376 1649
- 1601 1722 1443 1625 1573 1732 1316 1579 1401 1648 1535 1738 1044 1565 928 1474
- 1016 1550 1054 1546 1055 1486 1374 1631 1394 1652 1344 1615 1375 1616 1390 1603
- 1451 1639 1535 1678 1064 1492 1197 1573 1328 1606 1299 1595 1549 1717 1370 1593
- 1329 1587 1141 1502 1068 1505 1176 1562 1515 1705 34 { m20} R 0.58182 0.8 0 c
- 1334 1665 1533 1792 1529 1764 1084 1595 1313 1691 1414 1696 1520 1799 1334 1669
- 1162 1615 1498 1742 1369 1663 1191 1677 1458 1744 1533 1769 980 1572 1507 1744
- 1327 1692 1425 1677 776 1604 1370 1730 1481 1750 1465 1747 22 { m20} R 0.72727
- 0.8 0 c 1476 1807 1496 1809 1228 1720 1444 1829 1308 1792 1362 1771 1388 1817
- 1417 1778 1482 1798 1428 1813 1028 1691 1375 1765 1240 1710 13 { m20} R 0.8
- 0.72727 0 c 1457 1888 1387 1897 1425 1903 1337 1825 1220 1817 1335 1878 6 { m20
-} R 0.8 0.58182 0 c 1457 1888 0.8 0.43636 0 c 1457 1888 0.8 0.29091 0 c 1308
- 2186 m20 0.8 0.14546 0 c 1308 2186 0 0 0.8 c 53 77 2019 683 bf 0 0.14545 0.8 c
- 53 77 2019 760 bf 0 0.29091 0.8 c 53 78 2019 837 bf 0 0.43636 0.8 c 53 77 2019
- 915 bf 0 0.58182 0.8 c 53 77 2019 992 bf 0 0.72727 0.8 c 53 78 2019 1069 bf 0
- 0.8 0.72727 c 53 77 2019 1147 bf 0 0.8 0.58182 c 53 77 2019 1224 bf 0 0.8
- 0.43636 c 53 78 2019 1301 bf 0 0.8 0.29091 c 53 77 2019 1379 bf 0 0.8 0.14545 c
- 53 77 2019 1456 bf 0 0.8 0.4069E-06 c 53 78 2019 1533 bf 0.14545 0.8 0 c 53 77
- 2019 1611 bf 0.29091 0.8 0 c 53 77 2019 1688 bf 0.43636 0.8 0 c 53 78 2019 1765
- bf 0.58182 0.8 0 c 53 77 2019 1843 bf 0.72727 0.8 0 c 53 77 2019 1920 bf 0.8
- 0.72727 0 c 53 78 2019 1997 bf 0.8 0.58182 0 c 53 77 2019 2075 bf 0.8 0.43636 0
- c 53 77 2019 2152 bf 0.8 0.29091 0 c 53 78 2019 2229 bf 0.8 0.14546 0 c 53 77
- 2019 2307 bf 0.9 0.9 0.9 c 53 77 2019 2384 bf black 53 1778 2019 683 bl 2072
- 683 m 1778 Y s 2019 683 m 53 X s 2019 979 m 53 X s 2019 1276 m 53 X s 2019 1572
- m 53 X s 2019 1868 m 53 X s 2019 2165 m 53 X s 2019 2461 m 53 X s 2019 2461 m
- 53 X s 2133 681 m 27 X s 2172 691 m 1 Y 1 3 d 2 2 d 3 1 d 6 X 3 -1 d 1 -2 d 2
- -3 d -3 Y -2 -3 d -3 -4 d -15 -15 d 21 X s 2133 977 m 27 X s 2175 989 m 3 1 d 4
- 5 d -31 Y s 2141 1291 m -5 -1 d -3 -5 d -1 -7 d -5 Y 1 -7 d 3 -4 d 5 -2 d 3 X 4
- 2 d 3 4 d 2 7 d 5 Y -2 7 d -3 5 d -4 1 d -3 X cl s 2136 1582 m 3 1 d 5 5 d -32
- Y s 2133 1877 m 1 Y 2 3 d 1 1 d 3 2 d 6 X 3 -2 d 2 -1 d 1 -3 d -3 Y -1 -3 d -3
- -4 d -15 -15 d 21 X s 2135 2180 m 16 X -9 -11 d 5 X 3 -2 d 1 -1 d 2 -5 d -3 Y
- -2 -4 d -3 -3 d -4 -2 d -5 X -4 2 d -2 1 d -1 3 d s 2147 2477 m -15 -21 d 22 X
- s 2147 2477 m -31 Y s 222 1180 m 651 -497 d s 873 683 m 994 Y s 222 2174 m 651
- -497 d s 222 1180 m 994 Y s 873 683 m 1128 287 d s 2001 970 m 994 Y s 873 1677
- m 1128 287 d s 873 1677 m cl s 873 683 m 1128 287 d s 967 673 m 34 Y s 991 696
- m 17 Y s 1014 702 m 17 Y s 1038 708 m 17 Y s 1061 714 m 17 Y s 1085 703 m 34 Y
- s 1108 726 m 17 Y s 1132 732 m 17 Y s 1155 738 m 17 Y s 1179 744 m 17 Y s 1202
- 733 m 34 Y s 1226 756 m 16 Y s 1249 762 m 16 Y s 1273 768 m 16 Y s 1296 774 m
- 16 Y s 1320 763 m 33 Y s 1343 786 m 16 Y s 1367 792 m 16 Y s 1390 798 m 16 Y s
- 1413 804 m 16 Y s 1437 793 m 33 Y s 1460 816 m 16 Y s 1484 822 m 16 Y s 1507
- 828 m 16 Y s 1531 834 m 16 Y s 1554 823 m 33 Y s 1578 846 m 16 Y s 1601 851 m
- 17 Y s 1625 857 m 17 Y s 1648 863 m 17 Y s 1672 853 m 33 Y s 1695 875 m 17 Y s
- 1719 881 m 17 Y s 1742 887 m 17 Y s 1766 893 m 17 Y s 1789 883 m 33 Y s 1813
- 905 m 17 Y s 1836 911 m 17 Y s 1860 917 m 17 Y s 1883 923 m 17 Y s 1907 913 m
- 33 Y s 967 673 m 34 Y s 944 684 m 17 Y s 920 678 m 17 Y s 897 672 m 17 Y s 873
- 666 m 17 Y s 1907 913 m 33 Y s 1930 935 m 17 Y s 1954 941 m 17 Y s 1977 947 m
- 17 Y s 2001 953 m 17 Y s 970 654 m -5 -1 d -3 -4 d -1 -8 d -4 Y 1 -8 d 3 -4 d 5
- -2 d 3 X 4 2 d 3 4 d 1 8 d 4 Y -1 8 d -3 4 d -4 1 d -3 X cl s 1061 684 m -4 -1
- d -3 -5 d -1 -7 d -4 Y 1 -8 d 3 -4 d 4 -2 d 3 X 5 2 d 3 4 d 1 8 d 4 Y -1 7 d -3
- 5 d -5 1 d -3 X cl s 1085 656 m -1 -1 d 1 -2 d 2 2 d -2 1 d cl s 1099 677 m 1 Y
- 1 3 d 1 2 d 3 1 d 6 X 3 -1 d 2 -2 d 1 -3 d -3 Y -1 -2 d -3 -5 d -15 -15 d 21 X
- s 1144 684 m -14 X -2 -13 d 2 2 d 4 1 d 5 X 4 -1 d 3 -3 d 1 -5 d -3 Y -1 -4 d
- -3 -3 d -4 -2 d -5 X -4 2 d -2 1 d -1 3 d s 1190 714 m -5 -1 d -3 -5 d -1 -7 d
- -5 Y 1 -7 d 3 -4 d 5 -2 d 3 X 4 2 d 3 4 d 2 7 d 5 Y -2 7 d -3 5 d -4 1 d -3 X
- cl s 1214 686 m -2 -1 d 2 -2 d 1 2 d -1 1 d cl s 1243 714 m -15 X -1 -13 d 1 1
- d 5 2 d 4 X 5 -2 d 3 -3 d 1 -4 d -3 Y -1 -4 d -3 -3 d -5 -2 d -4 X -5 2 d -1 1
- d -2 3 d s 1296 744 m -4 -1 d -3 -5 d -2 -7 d -5 Y 2 -7 d 3 -4 d 4 -2 d 3 X 5 2
- d 3 4 d 1 7 d 5 Y -1 7 d -3 5 d -5 1 d -3 X cl s 1320 716 m -1 -1 d 1 -2 d 2 2
- d -2 1 d cl s 1353 744 m -15 -31 d s 1332 744 m 21 X s 1379 744 m -14 X -2 -13
- d 2 1 d 4 2 d 4 X 5 -2 d 3 -3 d 1 -4 d -3 Y -1 -5 d -3 -2 d -5 -2 d -4 X -4 2 d
- -2 1 d -1 3 d s 1435 768 m 3 2 d 4 4 d -31 Y s 1527 798 m 3 2 d 4 4 d -31 Y s
- 1555 776 m -2 -2 d 2 -1 d 1 1 d -1 2 d cl s 1568 797 m 1 Y 2 3 d 1 1 d 3 2 d 6
- X 3 -2 d 2 -1 d 1 -3 d -3 Y -1 -3 d -3 -4 d -15 -15 d 21 X s 1614 804 m -15 X
- -1 -13 d 1 1 d 5 2 d 4 X 5 -2 d 3 -3 d 1 -4 d -3 Y -1 -5 d -3 -3 d -5 -1 d -4 X
- -5 1 d -1 2 d -2 3 d s 1655 828 m 3 1 d 5 5 d -31 Y s 1683 806 m -1 -2 d 1 -1 d
- 2 1 d -2 2 d cl s 1713 834 m -15 X -1 -13 d 1 1 d 5 1 d 4 X 5 -1 d 3 -3 d 1 -4
- d -3 Y -1 -5 d -3 -3 d -5 -1 d -4 X -5 1 d -1 2 d -2 3 d s 1762 858 m 3 1 d 4 5
- d -31 Y s 1790 836 m -2 -2 d 2 -1 d 1 1 d -1 2 d cl s 1822 864 m -14 -31 d s
- 1802 864 m 20 X s 1849 864 m -15 X -1 -14 d 1 2 d 5 1 d 4 X 5 -1 d 3 -3 d 1 -5
- d -2 Y -1 -5 d -3 -3 d -5 -1 d -4 X -5 1 d -1 2 d -2 3 d s 1902 886 m 2 Y 1 3 d
- 2 1 d 3 2 d 6 X 3 -2 d 1 -1 d 1 -3 d -3 Y -1 -3 d -3 -5 d -15 -14 d 21 X s 873
- 683 m -651 497 d s 873 649 m 34 Y s 857 679 m 16 Y s 841 691 m 17 Y s 824 703 m
- 17 Y s 808 716 m 17 Y s 792 712 m 33 Y s 776 741 m 16 Y s 759 753 m 17 Y s 743
- 766 m 16 Y s 727 778 m 17 Y s 711 774 m 33 Y s 694 803 m 17 Y s 678 815 m 17 Y
- s 662 828 m 16 Y s 645 840 m 17 Y s 629 836 m 33 Y s 613 865 m 17 Y s 597 877 m
- 17 Y s 580 890 m 17 Y s 564 902 m 17 Y s 548 898 m 33 Y s 532 927 m 17 Y s 515
- 940 m 16 Y s 499 952 m 17 Y s 483 964 m 17 Y s 466 960 m 33 Y s 450 989 m 17 Y
- s 434 1002 m 16 Y s 418 1014 m 17 Y s 401 1027 m 16 Y s 385 1022 m 34 Y s 369
- 1051 m 17 Y s 352 1064 m 16 Y s 336 1076 m 17 Y s 320 1089 m 16 Y s 304 1084 m
- 34 Y s 287 1114 m 16 Y s 271 1126 m 17 Y s 255 1138 m 17 Y s 239 1151 m 16 Y s
- 222 1147 m 33 Y s 222 1147 m 33 Y s 826 573 m 27 X s 865 583 m 2 Y 1 3 d 2 1 d
- 3 2 d 6 X 3 -2 d 1 -1 d 2 -3 d -3 Y -2 -3 d -3 -5 d -15 -15 d 21 X s 704 635 m
- 26 X s 745 647 m 3 1 d 5 5 d -31 Y s 773 625 m -1 -2 d 1 -1 d 2 1 d -2 2 d cl s
- 803 653 m -15 X -1 -14 d 1 2 d 5 1 d 4 X 5 -1 d 2 -3 d 2 -5 d -3 Y -2 -4 d -2
- -3 d -5 -1 d -4 X -5 1 d -1 2 d -2 2 d s 663 697 m 27 X s 705 709 m 3 1 d 4 5 d
- -31 Y s 541 759 m 27 X s 587 777 m -5 -2 d -2 -4 d -2 -7 d -5 Y 2 -7 d 2 -5 d 5
- -1 d 3 X 4 1 d 3 5 d 2 7 d 5 Y -2 7 d -3 4 d -4 2 d -3 X cl s 611 749 m -2 -2 d
- 2 -1 d 1 1 d -1 2 d cl s 640 777 m -15 X -1 -13 d 1 1 d 5 2 d 4 X 5 -2 d 3 -3 d
- 1 -4 d -3 Y -1 -5 d -3 -3 d -5 -1 d -4 X -5 1 d -1 2 d -2 3 d s 537 839 m -5 -1
- d -3 -5 d -1 -7 d -5 Y 1 -7 d 3 -5 d 5 -1 d 3 X 4 1 d 3 5 d 2 7 d 5 Y -2 7 d -3
- 5 d -4 1 d -3 X cl s 414 901 m -4 -1 d -3 -5 d -2 -7 d -5 Y 2 -7 d 3 -4 d 4 -2
- d 3 X 5 2 d 3 4 d 1 7 d 5 Y -1 7 d -3 5 d -5 1 d -3 X cl s 438 873 m -1 -1 d 1
- -2 d 2 2 d -2 1 d cl s 468 901 m -15 X -2 -13 d 2 1 d 4 2 d 5 X 4 -2 d 3 -3 d 2
- -4 d -3 Y -2 -4 d -3 -3 d -4 -2 d -5 X -4 2 d -2 1 d -1 3 d s 370 957 m 3 2 d 4
- 4 d -31 Y s 247 1020 m 3 1 d 5 5 d -32 Y s 275 997 m -1 -1 d 1 -2 d 2 2 d -2 1
- d cl s 305 1026 m -15 X -1 -14 d 1 2 d 5 1 d 4 X 4 -1 d 3 -3 d 2 -5 d -3 Y -2
- -4 d -3 -3 d -4 -2 d -4 X -5 2 d -1 1 d -2 3 d s 204 1080 m 2 Y 1 3 d 2 1 d 3 2
- d 6 X 3 -2 d 1 -1 d 2 -3 d -3 Y -2 -3 d -3 -5 d -15 -14 d 21 X s 222 1180 m 994
- Y s 189 1180 m 33 X s 206 1202 m 16 X s 206 1224 m 16 X s 206 1246 m 16 X s 206
- 1268 m 16 X s 189 1290 m 33 X s 206 1312 m 16 X s 206 1335 m 16 X s 206 1357 m
- 16 X s 206 1379 m 16 X s 189 1401 m 33 X s 206 1423 m 16 X s 206 1445 m 16 X s
- 206 1467 m 16 X s 206 1489 m 16 X s 189 1511 m 33 X s 206 1533 m 16 X s 206
- 1556 m 16 X s 206 1578 m 16 X s 206 1600 m 16 X s 189 1622 m 33 X s 206 1644 m
- 16 X s 206 1666 m 16 X s 206 1688 m 16 X s 206 1710 m 16 X s 189 1732 m 33 X s
- 206 1754 m 16 X s 206 1776 m 16 X s 206 1799 m 16 X s 206 1821 m 16 X s 189
- 1843 m 33 X s 206 1865 m 16 X s 206 1887 m 16 X s 206 1909 m 16 X s 206 1931 m
- 16 X s 189 1953 m 33 X s 206 1975 m 16 X s 206 1997 m 16 X s 206 2020 m 16 X s
- 206 2042 m 16 X s 189 2064 m 33 X s 206 2086 m 16 X s 206 2108 m 16 X s 206
- 2130 m 16 X s 206 2152 m 16 X s 189 2174 m 33 X s 104 1178 m 27 X s 146 1190 m
- 3 1 d 4 4 d -31 Y s 150 1306 m -4 -2 d -3 -4 d -1 -7 d -5 Y 1 -7 d 3 -5 d 4 -1
- d 3 X 5 1 d 3 5 d 1 7 d 5 Y -1 7 d -3 4 d -5 2 d -3 X cl s 146 1411 m 3 1 d 4 4
- d -31 Y s 143 1519 m 2 Y 1 3 d 2 1 d 3 2 d 6 X 3 -2 d 1 -1 d 2 -3 d -3 Y -2 -3
- d -3 -4 d -14 -15 d 20 X s 144 1637 m 17 X -9 -11 d 4 X 3 -2 d 2 -1 d 1 -5 d -3
- Y -1 -4 d -3 -3 d -5 -2 d -4 X -5 2 d -1 1 d -1 3 d s 156 1748 m -14 -21 d 22 X
- s 156 1748 m -31 Y s 159 1858 m -15 X -1 -13 d 1 1 d 5 2 d 4 X 5 -2 d 3 -2 d 1
- -5 d -3 Y -1 -4 d -3 -3 d -5 -2 d -4 X -5 2 d -1 1 d -1 3 d s 161 1964 m -2 3 d
- -4 2 d -3 X -5 -2 d -3 -4 d -1 -8 d -7 Y 1 -6 d 3 -3 d 5 -1 d 1 X 5 1 d 3 3 d 1
- 5 d 1 Y -1 5 d -3 2 d -5 2 d -1 X -5 -2 d -3 -2 d -1 -5 d s 162 2079 m -15 -31
- d s 142 2079 m 20 X s 149 2190 m -5 -2 d -1 -3 d -3 Y 1 -3 d 3 -1 d 6 -2 d 5 -1
- d 3 -3 d 1 -3 d -4 Y -1 -3 d -2 -2 d -4 -1 d -6 X -5 1 d -1 2 d -1 3 d 4 Y 1 3
- d 3 3 d 4 1 d 6 2 d 3 1 d 2 3 d 3 Y -2 3 d -4 2 d -6 X cl s gr
-showpage
- gr
-%%Trailer
-%%Pages: 1
- gr gr
-%%EOF
diff --git a/src/pawlib/paw/testsuite/paw.commands/nt_pl_4d_2.ref.ps b/src/pawlib/paw/testsuite/paw.commands/nt_pl_4d_2.ref.ps
deleted file mode 100644
index be6b2a5..0000000
--- a/src/pawlib/paw/testsuite/paw.commands/nt_pl_4d_2.ref.ps
+++ /dev/null
@@ -1,3161 +0,0 @@
-%!PS-Adobe-2.0
-%%Title: /disk3/maartenb/cerncvs/paw/testsuite/tmp/nt_pl_4d_ (Portrait A 4)
-%%Pages: (atend)
-%%Creator: HIGZ Version 1.23/06
-%%CreationDate: 96/04/16 16.05
-%%EndComments
-%%BeginProlog
-/s {stroke} def /l {lineto} def /m {moveto} def /t {translate} def
-/sw {stringwidth} def /r {rotate} def /rl {roll} def /R {repeat} def
-/d {rlineto} def /rm {rmoveto} def /gr {grestore} def /f {eofill} def
-/c {setrgbcolor} def /lw {setlinewidth} def /sd {setdash} def
-/cl {closepath} def /sf {scalefont setfont} def /black {0 setgray} def
-/box {m dup 0 exch d exch 0 d 0 exch neg d cl} def
-/NC{systemdict begin initclip end}def/C{NC box clip newpath}def
-/bl {box s} def /bf {box f} def /Y { 0 exch d} def /X { 0 d} def
-/mp {newpath /y exch def /x exch def} def
-/side {[w .77 mul w .23 mul] .385 w mul sd w 0 l currentpoint t -144 r} def
-/mr {mp x y w2 0 360 arc} def /m24 {mr s} def /m20 {mr f} def
-/mb {mp x y w2 add m w2 neg 0 d 0 w neg d w 0 d 0 w d cl} def
-/mt {mp x y w2 add m w2 neg w neg d w 0 d cl} def
-/m21 {mb f} def /m25 {mb s} def /m22 {mt f} def /m26 {mt s} def
-/m23 {mp x y w2 sub m w2 w d w neg 0 d cl f} def
-/m27 {mp x y w2 add m w3 neg w2 neg d w3 w2 neg d w3 w2 d cl s} def
-/m28 {mp x w2 sub y w2 sub w3 add m w3 0 d 0 w3 neg d w3 0 d 0 w3 d w3 0 d
- 0 w3 d w3 neg 0 d 0 w3 d w3 neg 0 d
- 0 w3 neg d w3 neg 0 d cl s } def
-/m29 {mp gsave x w2 sub y w2 add w3 sub m currentpoint t
- 4 {side} repeat cl fill gr} def
-/m30 {mp gsave x w2 sub y w2 add w3 sub m currentpoint t
- 5 {side} repeat s gr} def
-/m31 {mp x y w2 sub m 0 w d x w2 sub y m w 0 d
- x w2 sub y w2 add m w w neg d x w2 sub y w2
- sub m w w d s} def
-/m2 {mp x y w2 sub m 0 w d x w2 sub y m w 0 d s} def
-/m5 {mp x w2 sub y w2 sub m w w d x w2 sub y w2 add m w w neg d s} def
-/DP {/PT exch def gsave 47.2 47.2 scale PT 1 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < AA AA 55 55 AA AA 55 55 AA AA 55 55 AA AA 55 55 AA AA 55 55 AA AA 55 55
-AA AA 55 55 AA AA 55 55 > } image } if PT 2 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < BB BB EE EE BB BB EE EE BB BB EE EE BB BB EE EE BB BB EE EE BB BB EE EE
-BB BB EE EE BB BB EE EE > } image } if PT 3 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < FF FF BB BB FF FF EE EE FF FF BB BB FF FF EE EE FF FF BB BB FF FF EE EE
-FF FF BB BB FF FF EE EE > } image } if PT 4 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < DF DF BF BF 7F 7F FE FE FD FD FB FB F7 F7 EF EF DF DF BF BF 7F 7F FE FE
-FD FD FB FB F7 F7 EF EF > } image } if PT 5 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < 7F 7F BF B F DF DF EF EF F7 F7 FB FB FD FD FE FE 7F 7F BF BF DF DF EF
-EF F7 F7 FB FB FD FD FE FE > } image } if PT 6 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB
-BB BB BB BB BB BB BB BB BB > } image } if PT 7 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < FF FF FF FF FF FF 00 00 FF FF FF FF FF FF 00 00 FF FF FF FF FF FF 00
-00 FF FF FF FF FF FF 00 00 > } image } if PT 8 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < EE EE 47 47 83 83 C5 C5 EE EE 5C 5C 38 38 74 74 EE EE 47 47 83 83 C5
-C5 EE EE 5C 5C 38 38 74 74 > } image } if PT 9 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < EF EF EF EF D7 D7 38 38 FE FE FE FE 7D 7D 83 83 EF EF EF EF D7 D7 38
-38 FE FE FE FE 7D 7D 83 83 > } image } if PT 10 eq { 16 16 1 [ 16 0 0 16 neg
-0 16 ] { < EF EF EF EF EF EF 00 00 FE FE FE FE FE FE 00 00 EF EF EF EF EF EF
-00 00 FE FE FE FE FE FE 00 00 > } image } if PT 11 eq { 16 16 1 [ 16 0 0 16
-neg 0 16 ] { < F7 F7 B6 B6 D5 D5 E3 E3 D5 D5 B6 B6 F7 F7 FF FF 7F 7F 6B 6B 5D
-5D 3E 3E 5D 5D 6B 6B 7F 7F FF FF > } image } if PT 12 eq { 16 16 1 [ 16 0 0
-16 neg 0 16 ] { < E3 E3 DD DD BE BE BE BE BE BE DD DD E3 E3 FF FF 3E 3E DD DD
-EB EB EB EB EB EB DD DD 3E 3E FF FF > } image } if PT 13 eq { 16 16 1 [ 16 0
-0 16 neg 0 16 ] { < FE FE 7D 7D BB BB D7 D7 EF EF D7 D7 BB BB 7D 7D FE FE 7D
-7D BB BB D7 D7 EF EF D7 D7 BB BB 7D 7D > } image } if PT 14 eq { 16 16 1 [ 16
-0 0 16 neg 0 16 ] { < 00 00 EE EF EE EF EE EF 0E E0 EE EE EE EE EE EE 00 EE
-FE EE FE EE FE EE 00 00 FE EF FE EF FE EF > } image } if PT 15 eq { 16 16 1 [
-16 0 0 16 neg 0 16 ] { < DD DD AA AA DD DD FF FF 77 77 AA AA 77 77 FF FF DD
-DD AA AA DD DD FF FF 77 77 AA AA 77 77 FF FF > } image } if PT 16 eq { 16 16
-1 [ 16 0 0 16 neg 0 16 ] { < F1 F1 EE EE 1F 1F FF FF F1 F1 EE EE 1F 1F FF FF
-F1 F1 EE EE 1F 1F FF FF F1 F1 EE EE 1F 1F FF FF > } image } if PT 17 eq { 16
-16 1 [ 16 0 0 16 neg 0 16 ] { < EE EE DD DD BB BB FF FF EE EE DD DD BB BB FF
- FF EE EE DD DD BB BB FF FF EE EE DD DD BB BB FF FF > } image } if PT 18 eq {
-16 16 1 [ 16 0 0 16 neg 0 16 ] { < BB BB DD DD EE EE FF FF BB BB DD DD EE EE
-FF FF BB BB DD DD EE EE FF FF BB BB DD DD EE EE FF FF > } image } if PT 19 eq
-{ 16 16 1 [ 16 0 0 16 neg 0 16 ] { < 1F FC 67 F3 7B EF BD DE BD DE DE BD E6
-B3 F8 0F E6 B3 DE BD BD DE BD DE 7B EF 67 F3 1F FC 7F FF > } image } if PT
-20 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < DD DD EE EE EE EE EE EE DD DD BB
-BB BB BB BB BB DD DD EE EE EE EE EE EE DD DD BB BB BB BB BB BB > } image }
-if PT 21 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < 0E 0E EF EF EF EF EF EF E0
-E0 FE FE FE FE FE FE 0E 0E EF EF EF EF EF EF E0 E0 FE FE FE FE FE FE > }
-image } if PT 22 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < 70 70 F7 F7 F7 F7 F7
-F7 07 07 7F 7F 7F 7F 7F 7F 70 70 F7 F7 F7 F7 F7 F7 07 07 7F 7F 7F 7F 7F 7F >
-} image } if PT 23 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < AA AA 55 55 A9 A9
-D1 D1 E1 E1 D1 D1 A9 A9 55 55 AA AA 55 55 A9 A9 D1 D1 E1 E1 D1 D1 A9 A9 55 55
-> } image } if PT 24 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < FF FE FF FC EA
-A8 D5 54 EA A8 D5 54 E8 28 D4 54 E8 E8 D4 D4 E8 EA 54 D5 A8 EA 54 D5 00 C0 00
-80 > } image } if PT 25 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < FF FE FF FC
-FF F8 FF F0 F0 00 F0 00 F0 20 F0 60 F0 E0 F1 E0 F3 E0 F0 00 E0 00 C0 00 80 00
-00 00 > } image } if gr } def /FA { /PT exch def gsave clip 0 0 translate 1 1
-54 { 1 sub 47.2 mul /Xcurr exch def 1 1 74 { 1 sub 47.2 mul /Ycurr exch def
-gsave Xcurr Ycurr translate PT DP gr } for } for gr } def
-/reencdict 24 dict def /ReEncode {reencdict begin /nco&na exch def
-/nfnam exch def /basefontname exch def /basefontdict basefontname findfont def
-/newfont basefontdict maxlength dict def basefontdict {exch dup /FID ne
-{dup /Encoding eq {exch dup length array copy newfont 3 1 roll put} {exch
-newfont 3 1 roll put} ifelse} {pop pop} ifelse } forall newfont
-/FontName nfnam put nco&na aload pop nco&na length 2 idiv {newfont
-/Encoding get 3 1 roll put} repeat nfnam newfont definefont pop end } def
-/accvec [ 176 /agrave 181 /Agrave 190 /acircumflex 192 /Acircumflex
-201 /adieresis 204 /Adieresis 209 /ccedilla 210 /Ccedilla 211 /eacute
-212 /Eacute 213 /egrave 214 /Egrave 215 /ecircumflex 216 /Ecircumflex
-217 /edieresis 218 /Edieresis 219 /icircumflex 220 /Icircumflex
-221 /idieresis 222 /Idieresis 223 /ntilde 224 /Ntilde 226 /ocircumflex
-228 /Ocircumflex 229 /odieresis 230 /Odieresis 231 /ucircumflex 236 /Ucircumflex
-237 /udieresis 238 /Udieresis 239 /aring 242 /Aring 243 /ydieresis
-244 /Ydieresis 246 /aacute 247 /Aacute 252 /ugrave 253 /Ugrave] def
-/Times-Roman /Times-Roman accvec ReEncode
-/Times-Italic /Times-Italic accvec ReEncode
-/Times-Bold /Times-Bold accvec ReEncode
-/Times-BoldItalic /Times-BoldItalic accvec ReEncode
-/Helvetica /Helvetica accvec ReEncode
-/Helvetica-Oblique /Helvetica-Oblique accvec ReEncode
-/Helvetica-Bold /Helvetica-Bold accvec ReEncode
-/Helvetica-BoldOblique /Helvetica-BoldOblique accvec ReEncode
-/Courier /Courier accvec ReEncode
-/Courier-Oblique /Courier-Oblique accvec ReEncode
-/Courier-Bold /Courier-Bold accvec ReEncode
-/Courier-BoldOblique /Courier-BoldOblique accvec ReEncode
-/oshow {gsave [] 0 sd true charpath stroke gr} def
-/stwn { /fs exch def /fn exch def /text exch def fn findfont fs sf
- text sw pop xs add /xs exch def} def
-/stwb { /fs exch def /fn exch def /nbas exch def /textf exch def
-textf length /tlen exch def nbas tlen gt {/nbas tlen def} if
-fn findfont fs sf textf dup length nbas sub nbas getinterval sw
-pop neg xs add /xs exch def} def
-/accspe [ 65 /plusminus 66 /bar 67 /existential 68 /universal
-69 /exclam 70 /numbersign 71 /greater 72 /question 73 /integral
-74 /colon 75 /semicolon 76 /less 77 /bracketleft 78 /bracketright
-79 /greaterequal 80 /braceleft 81 /braceright 82 /radical
-83 /spade 84 /heart 85 /diamond 86 /club 87 /lessequal
-88 /multiply 89 /percent 90 /infinity 48 /circlemultiply 49 /circleplus
-50 /emptyset 51 /lozenge 52 /bullet 53 /arrowright 54 /arrowup
-55 /arrowleft 56 /arrowdown 57 /arrowboth 48 /degree 44 /comma 43 /plus
- 45 /angle 42 /angleleft 47 /divide 61 /notequal 40 /equivalence 41 /second
- 97 /approxequal 98 /congruent 99 /perpendicular 100 /partialdiff 101 /florin
- 102 /intersection 103 /union 104 /propersuperset 105 /reflexsuperset
- 106 /notsubset 107 /propersubset 108 /reflexsubset 109 /element 110 /notelement
- 111 /gradient 112 /logicaland 113 /logicalor 114 /arrowdblboth
- 115 /arrowdblleft 116 /arrowdblup 117 /arrowdblright 118 /arrowdbldown
- 119 /ampersand 120 /omega1 121 /similar 122 /aleph ] def
-/Symbol /Special accspe ReEncode
-/Zone {/iy exch def /ix exch def ix 1 sub 2224 mul 1 iy sub 3144
- mul t} def
-%%EndProlog
- gsave 20 28 t .25 .25 scale gsave
-%%Page: number 1
- gsave
- 1 1 Zone
- gsave 0 0 t black [] 0 sd 1 lw 2223 2224 0 460 bl 2223 2224 0 460 C 1779 1778
- 222 683 C NC [4 8] 0 sd 222 1212 m 1128 287 d s 222 1378 m 1128 287 d s 222
- 1543 m 1128 287 d s 222 1709 m 1128 287 d s 222 1875 m 1128 287 d s 222 2041 m
- 1128 287 d s [] 0 sd 222 1180 m 1128 287 d s 1350 1467 m 994 Y s 222 2174 m
- 1128 287 d s 222 1180 m 994 Y s [4 8] 0 sd 1350 1499 m 651 -497 d s 1350 1665 m
- 651 -497 d s 1350 1830 m 651 -497 d s 1350 1996 m 651 -497 d s 1350 2162 m 651
- -497 d s 1350 2328 m 651 -498 d s [] 0 sd 1350 1467 m 651 -497 d s 2001 970 m
- 994 Y s 1350 2461 m 651 -497 d s 1350 1467 m cl s 931 539 m -17 -21 d s 914 539
- m 17 X s 914 518 m 17 X s 951 549 m 12 -31 d s 975 549 m -12 -31 d s 1002 545 m
- -3 3 d -5 1 d -5 X -5 -1 d -3 -3 d -3 Y 2 -3 d 1 -1 d 3 -2 d 9 -3 d 3 -1 d 1 -2
- d 2 -3 d -4 Y -3 -3 d -5 -2 d -5 X -5 2 d -3 3 d s 1014 521 m -2 -1 d 2 -2 d 1
- 2 d -1 1 d cl s 1039 539 m 9 -21 d s 1057 539 m -9 -21 d -3 -6 d -3 -3 d -3 -1
- d -2 X s 1076 549 m 12 -31 d s 1100 549 m -12 -31 d s 1126 545 m -3 3 d -4 1 d
- -6 X -4 -1 d -3 -3 d -3 Y 1 -3 d 2 -1 d 3 -2 d 8 -3 d 3 -1 d 2 -2 d 1 -3 d -4 Y
- -3 -3 d -4 -2 d -6 X -4 2 d -3 3 d s 1138 521 m -1 -1 d 1 -2 d 2 2 d -2 1 d cl
- s 1165 539 m 16 -21 d s 1181 539 m -16 -21 d s 1202 549 m 12 -31 d s 1226 549 m
- -12 -31 d s 1252 545 m -3 3 d -4 1 d -6 X -4 -1 d -3 -3 d -3 Y 1 -3 d 2 -1 d 2
- -2 d 9 -3 d 3 -1 d 2 -2 d 1 -3 d -4 Y -3 -3 d -4 -2 d -6 X -4 2 d -3 3 d s 1264
- 521 m -1 -1 d 1 -2 d 2 2 d -2 1 d cl s 1309 535 m -3 3 d -3 1 d -5 X -3 -1 d -3
- -3 d -1 -5 d -3 Y 1 -4 d 3 -3 d 3 -2 d 5 X 3 2 d 3 3 d s 0 0 0.8 c /w 2
- def /w2 {w 2 div} def /w3 {w 3 div} def 1308 2186 0 0.14545 0.8 c 7523 -2791
- m20 0 0.29091 0.8 c 7644 -2789 m20 0 0.43636 0.8 c 7332 -2987 7503 -2879 7182
- -3017 7503 -2909 7499 -2916 7598 -2869 7181 -3032 7 { m20} R 0 0.58182 0.8 c
- 2870 -4182 7460 -3032 7259 -3120 7540 -2934 7396 -3082 7545 -2974 7522 -2980
- 7304 -3121 7534 -2961 7517 -2992 7274 -3134 7468 -2985 7732 -2791 7283 -3104
- 7655 -2856 7000 -3181 7293 -3117 7147 -3107 7390 -3041 7532 -2992 20 { m20} R 0
- 0.72727 0.8 c 7158 -3265 7499 -3072 7649 -2961 7723 -2843 7419 -3108 7549 -3044
- 7581 -3024 7493 -3108 7642 -2952 7596 -3026 7645 -2938 7584 -2981 7676 -2910
- 7549 -3053 7719 -2842 7582 -3014 7651 -2936 7442 -3157 7093 -3243 7391 -3160
- 7123 -3231 7709 -2837 7592 -3009 7609 -3017 7719 -2830 7216 -3162 7309 -3151
- 7451 -3115 7602 -3016 7391 -3150 7622 -2951 7579 -2970 7412 -3100 7682 -2894
- 7628 -2965 7717 -2823 7231 -3255 7347 -3149 7631 -2986 7596 -3037 7390 -3126
- 7264 -3155 7695 -2868 7657 -2903 44 { m20} R 0 0.8 0.72727 c 7712 -2898 7449
- -3204 7669 -3016 7773 -2787 7538 -3193 7470 -3174 7466 -3223 7414 -3358 7788
- -2788 7649 -2990 7044 -3669 7753 -2853 7184 -3594 7207 -3515 7678 -2972 7093
- -3475 7744 -2863 7775 -2786 7691 -2970 7775 -2795 7654 -2966 7650 -3045 7285
- -3511 7651 -3051 7596 -3142 7538 -3224 7545 -3142 7791 -2775 7719 -2896 7670
- -2970 7721 -2915 7255 -3486 7778 -2785 7708 -2891 7609 -3065 7702 -2953 7753
- -2855 6925 -3484 7499 -3206 7517 -3273 7350 -3302 7494 -3200 7555 -3188 7497
- -3245 7385 -3260 7664 -2993 7370 -3259 7532 -3259 7657 -3013 7439 -3317 7503
- -3245 7694 -2946 7771 -2816 7651 -3003 7560 -3185 7059 -3410 7781 -2785 7665
- -3004 7223 -3608 7621 -3055 7745 -2827 7558 -3161 7659 -3038 7498 -3163 7538
- -3189 7745 -2864 7016 -3473 7702 -2905 7409 -3240 6945 -3566 7549 -3230 7322
- -3282 7675 -2989 7579 -3135 7608 -3074 7423 -3325 7328 -3534 7419 -3226 7723
- -2865 7761 -2838 7621 -3099 7722 -2864 7495 -3164 7582 -3118 7587 -3127 7585
- -3088 7736 -2891 7726 -2872 7427 -3369 7280 -3521 7724 -2915 7552 -3096 7747
- -2861 7384 -3298 7768 -2821 6936 -3512 7546 -3157 7564 -3099 7441 -3330 7446
- -3323 100 { m20} R 7569 -3096 7452 -3240 7608 -3096 7641 -3017 4 { m20} R 0 0.8
- 0.58182 c 7394 -3701 7763 -2864 7758 -2877 7465 -3480 7707 -2964 7708 -2972
- 7675 -3019 7576 -3252 7614 -3122 7713 -2989 7711 -2980 7668 -3081 7707 -3000
- 7732 -2923 1018 993 1211 1182 7644 -3078 7037 -3912 7699 -2976 7683 -3028 7574
- -3269 7714 -2948 7703 -2965 7726 -2927 7481 -3362 7632 -3144 7534 -3358 7801
- -2801 7595 -3276 7475 -3465 7638 -3172 968 1031 7701 -3017 7712 -2958 7782
- -2821 1181 1101 1064 1150 7730 -2937 7609 -3235 1144 1076 7717 -2976 7589 -3244
- 7699 -3003 7574 -3260 7560 -3338 7627 -3186 7750 -2879 7448 -3429 7328 -3667
- 7525 -3284 1057 1175 7757 -2859 1434 1148 7828 -2743 7549 -3314 7728 -2937 7726
- -2951 7785 -2838 7697 -2975 7713 -2973 7543 -3352 1213 1151 7642 -3159 7709
- -3000 7461 -3385 7599 -3193 7663 -3093 7743 -2923 7560 -3345 7809 -2776 957 913
- 1076 1199 7545 -3355 7354 -3695 1133 1201 1491 933 7637 -3143 7611 -3191 7468
- -3375 1102 1037 7758 -2864 7691 -3046 7517 -3309 7678 -3064 7721 -2940 7647
- -3102 452 1068 7628 -3178 7794 -2807 7637 -3083 7648 -3141 7413 -3577 7625
- -3132 7776 -2844 7657 -3093 7656 -3117 7704 -2956 7644 -3079 7775 -2857 7451
- -3472 100 { m20} R 7800 -2797 7642 -3123 787 1120 7602 -3219 7619 -3200 7799
- -2791 7805 -2798 1112 976 7672 -3040 7889 -2607 7689 -2984 7692 -3038 7670
- -3078 7668 -3101 7778 -2838 7841 -2704 7726 -2930 7647 -3075 7675 -3009 7549
- -3279 7770 -2858 1469 948 7564 -3223 7734 -2929 979 1206 7768 -2864 7708 -2950
- 7342 -3597 7672 -3064 7572 -3224 7743 -2908 7539 -3387 7652 -3103 6654 -4573
- 7759 -2874 35 { m20} R 0 0.8 0.43636 c 7730 -2978 1391 1571 7781 -2870 7775
- -2890 1159 1507 7789 -2868 7645 -3186 1076 1581 1152 1445 7782 -2862 1170 1398
- 7639 -3174 7705 -3065 1076 1298 7697 -3047 1185 1571 7563 -3360 806 1440 7683
- -3074 7818 -2802 1042 1286 7767 -2922 7612 -3260 892 1521 7732 -3004 1561 1411
- 7719 -3011 7708 -3018 7782 -2872 7694 -3052 7630 -3214 7843 -2719 7819 -2795
- 7646 -3163 7821 -2769 993 1334 7764 -2910 894 1499 7674 -3136 7719 -3023 7686
- -3067 1378 1475 7685 -3110 7764 -2907 857 1600 7852 -2702 7773 -2877 1201 1402
- 1143 1568 1303 1337 7715 -3024 1190 1314 7745 -2950 1501 1459 7581 -3324 280
- 1293 1002 1576 7746 -2955 7753 -2925 7782 -2879 7843 -2733 7676 -3132 7712
- -3016 7758 -2916 7679 -3124 7879 -2657 7812 -2809 1010 1525 7654 -3172 1015
- 1358 7600 -3286 7785 -2867 7808 -2803 1144 1574 7759 -2934 921 1622 7641 -3196
- 7681 -3087 1427 1268 1123 1567 7709 -3051 7751 -2952 1467 1538 7900 -2610 7802
- -2837 7742 -2958 1432 1535 7654 -3176 1017 1579 1264 1411 7791 -2840 7737 -2990
- 1220 1561 7781 -2857 7847 -2721 7666 -3138 7821 -2775 7761 -2930 7584 -3311
- 7801 -2815 100 { m20} R 1037 1565 1086 1590 7725 -2989 7762 -2901 7785 -2877
- 7740 -2984 802 1577 7704 -3044 1657 1413 7720 -3024 7684 -3075 7750 -2961 7799
- -2832 7772 -2888 7707 -3048 7724 -2998 1287 1545 7657 -3143 7738 -2989 7666
- -3155 1285 1501 7744 -2967 971 1567 7719 -3030 7672 -3121 7747 -2964 7747 -2938
- 7687 -3109 7806 -2820 7846 -2712 7683 -3114 1150 1575 7682 -3118 7648 -3176
- 7701 -3035 7814 -2802 7713 -3033 1594 1278 1234 1462 7668 -3139 1070 1358 7882
- -2649 7700 -3074 7725 -2987 7747 -2928 7732 -2977 7813 -2787 893 1502 7769
- -2893 1444 1525 7642 -3202 586 1532 7733 -2996 7740 -2946 1360 1485 1481 1505
- 7787 -2842 1050 1432 1503 1397 7802 -2813 7815 -2780 7708 -3031 7686 -3106 7709
- -3018 7812 -2815 7743 -2976 7797 -2833 7732 -2992 7638 -3211 7691 -3097 7687
- -3088 1181 1522 7729 -2978 7608 -3260 7625 -3206 7768 -2910 7745 -2964 1074
- 1381 7709 -3024 7670 -3140 7684 -3094 7734 -2985 7744 -2967 7770 -2906 1034
- 1473 7742 -2982 7766 -2893 1337 1530 7746 -2961 1056 1602 7685 -3096 1177 1511
- 1180 1558 1080 1304 7691 -3093 7728 -2986 1409 1457 7818 -2794 7795 -2854 7725
- -2988 100 { m20} R 7774 -2889 7682 -3093 7839 -2749 7623 -3220 7684 -3095 7730
- -3004 1297 1563 1303 1351 1146 1585 7703 -3048 1390 1543 7739 -2963 1021 1272
- 13 { m20} R 0 0.8 0.29091 c 1046 1806 7756 -2971 846 1800 1366 1725 7736 -3008
- 7852 -2739 7786 -2886 1076 1669 1177 1686 7778 -2909 7830 -2796 1419 1600 1219
- 1650 1233 1748 647 1771 1279 1618 7808 -2852 1601 1527 7810 -2827 7817 -2830
- 7745 -2988 7838 -2769 1124 1718 1341 1637 1243 1599 1445 1583 7735 -3003 1221
- 1751 7811 -2838 1178 1599 7743 -2982 7793 -2875 1347 1699 7815 -2834 7773 -2924
- 7732 -3010 7793 -2884 7775 -2914 1507 1732 1110 1785 1296 1608 7748 -2986 7796
- -2876 1289 1695 1140 1606 1268 1637 1362 1659 1128 1741 1012 1814 7774 -2915
- 601 1703 1188 1599 1098 1774 7852 -2741 7714 -3056 1457 1657 7765 -2945 1308
- 1586 7790 -2885 1012 1674 7856 -2730 1172 1605 1217 1631 1012 1729 1555 1564
- 7800 -2862 7775 -2923 280 1597 7766 -2950 7820 -2809 7747 -2991 7766 -2929 7737
- -3006 7716 -3050 1350 1663 7754 -2956 1022 1736 7786 -2898 1274 1713 1602 1649
- 1423 1687 1137 1631 1111 1793 1380 1730 1219 1623 7759 -2965 7792 -2872 7724
- -3036 7774 -2925 7754 -2971 7745 -2987 7704 -3076 7827 -2797 1317 1665 7775
- -2926 7817 -2807 1137 1745 7853 -2745 7819 -2812 1409 1725 100 { m20} R 7758
- -2954 288 1683 7777 -2919 7839 -2779 885 1637 7796 -2873 1336 1685 7830 -2775
- 1284 1588 7750 -2982 7741 -2999 878 1805 7745 -2982 863 1735 1011 1768 1322
- 1698 7827 -2802 1274 1671 7708 -3066 7778 -2918 7866 -2696 1155 1643 7823 -2803
- 1186 1716 790 1753 7810 -2834 7772 -2916 1279 1674 1235 1758 7748 -2976 7743
- -2992 1549 1670 7809 -2834 7824 -2812 7777 -2924 1422 1682 7806 -2850 1396 1675
- 1348 1771 7775 -2917 7754 -2966 7884 -2659 7773 -2934 1235 1743 7705 -3070 911
- 1696 7756 -2962 7788 -2901 7776 -2927 1198 1682 1207 1634 7736 -3012 1211 1706
- 1377 1762 7776 -2924 990 1681 7861 -2726 1180 1708 7734 -3011 1245 1632 7794
- -2862 1157 1632 1064 1802 7848 -2750 1216 1715 1266 1621 7724 -3035 1336 1772
- 1229 1761 7835 -2769 1280 1706 1247 1746 1277 1717 1144 1733 7753 -2967 1376
- 1722 7711 -3064 1202 1703 7744 -2978 1229 1655 7858 -2725 7735 -2999 732 1751
- 7883 -2674 7767 -2927 7794 -2866 1216 1608 7768 -2936 7778 -2920 7758 -2951
- 1223 1596 1485 1552 7846 -2749 7766 -2948 7873 -2690 7846 -2758 931 1676 1628
- 1584 7740 -2999 943 1733 100 { m20} R 1152 1705 7744 -2990 7802 -2861 1135 1705
- 1243 1650 1108 1633 7735 -3009 1152 1677 1411 1661 7905 -2618 1235 1688 7790
- -2888 1374 1708 1021 1798 7844 -2766 978 1800 7830 -2793 1309 1739 1021 1646
- 1570 1678 7889 -2652 7848 -2756 7731 -3013 7755 -2971 7799 -2870 7802 -2859
- 7750 -2980 1377 1639 7834 -2786 7825 -2800 1084 1752 1211 1667 7714 -3049 7834
- -2782 1059 1671 7905 -2614 7858 -2726 7827 -2790 7777 -2921 1009 1750 1107 1774
- 1061 1615 7804 -2859 7813 -2822 1406 1719 7791 -2889 7775 -2928 7776 -2927 48 {
- m20} R 0 0.8 0.14545 c 1240 1874 7865 -2722 7813 -2852 7885 -2682 7808 -2854
- 7821 -2839 7802 -2876 1369 1817 7869 -2720 1359 1796 1378 1783 7834 -2806 1611
- 1798 1057 1871 7834 -2802 7813 -2847 1046 1886 1304 1884 1436 1856 7821 -2831
- 7907 -2627 7846 -2771 7796 -2892 1209 1883 1360 1806 7824 -2831 7796 -2890 7843
- -2776 1412 1773 7787 -2903 1229 1816 1051 1812 7792 -2900 7780 -2925 1419 1890
- 1570 1747 7813 -2849 1600 1719 1190 1828 1371 1815 1224 1838 1131 1838 1530
- 1790 1155 1818 7827 -2811 1021 1836 1129 1819 1153 1860 7812 -2856 7787 -2911
- 7786 -2913 7843 -2770 7865 -2718 1371 1853 1041 1828 1359 1840 1423 1800 1478
- 1767 1065 1859 7827 -2817 7813 -2850 1440 1785 1302 1857 1343 1895 1250 1821
- 1240 1840 1227 1896 7767 -2951 7787 -2907 7832 -2798 1233 1828 7889 -2671 1441
- 1866 7799 -2885 7796 -2891 7864 -2738 7818 -2833 7833 -2797 1352 1787 7857
- -2738 7883 -2684 7827 -2814 7870 -2709 7810 -2860 7755 -2975 1248 1888 1377
- 1854 7792 -2897 1345 1883 1110 1902 1505 1869 7767 -2950 1243 1785 1106 1837
- 1380 1872 1311 1851 7833 -2805 1370 1828 7834 -2793 1245 1805 100 { m20} R 7851
- -2752 1507 1794 7786 -2910 1375 1878 7804 -2862 7887 -2676 7854 -2755 7866
- -2727 7810 -2863 1333 1837 7858 -2744 7877 -2697 1535 1777 7756 -2973 7898
- -2653 7782 -2920 1035 1893 7863 -2727 1196 1888 7793 -2898 1293 1879 1253 1843
- 1096 1837 1332 1784 7834 -2803 1057 1841 7846 -2770 7802 -2873 7884 -2689 1397
- 1831 7808 -2858 7815 -2850 7809 -2857 1453 1836 1448 1846 1199 1793 1310 1821
- 7850 -2771 1538 1843 1266 1875 1034 1830 1277 1811 1503 1855 7846 -2774 1321
- 1827 7862 -2739 1401 1856 1178 1891 7831 -2810 7823 -2824 7851 -2757 1061 1924
- 7793 -2897 1565 1812 7840 -2794 1321 1802 7816 -2841 7858 -2752 1606 1777 1332
- 1846 1312 1883 7793 -2892 7832 -2810 7766 -2952 1009 1921 7884 -2674 7865 -2720
- 7776 -2932 1553 1789 7858 -2747 1406 1775 1253 1876 7812 -2848 7889 -2673 1052
- 1863 1401 1885 1623 1717 1462 1820 1149 1915 1139 1917 7761 -2961 1537 1840
- 7871 -2710 7805 -2874 1015 1932 1327 1860 1352 1777 7799 -2878 1386 1895 7898
- -2656 7778 -2923 981 1853 1211 1872 7858 -2750 7821 -2829 1453 1885 1214 1893
- 7888 -2675 7833 -2809 938 1885 100 { m20} R 7807 -2859 1109 1906 1449 1881 7842
- -2772 7794 -2895 1172 1848 1452 1799 1342 1868 7887 -2683 7852 -2763 1248 1864
- 1319 1843 1513 1743 1330 1871 1329 1863 1325 1802 1120 1915 1289 1876 1191 1845
- 724 1888 1370 1823 7871 -2709 7789 -2899 7864 -2726 7764 -2957 7768 -2948 7759
- -2967 7847 -2773 1289 1783 7824 -2827 1407 1896 7845 -2779 7879 -2691 7794
- -2895 640 1853 1290 1888 1032 1908 959 1833 7832 -2805 7813 -2854 7898 -2643
- 7863 -2723 1248 1785 7834 -2805 7792 -2899 1240 1858 7877 -2701 1172 1912 7831
- -2813 7767 -2949 7861 -2745 7854 -2762 7800 -2883 1458 1824 7832 -2801 1446
- 1860 7819 -2837 1405 1824 1488 1878 7868 -2721 1154 1808 7790 -2898 7857 -2752
- 1654 1761 7840 -2779 7806 -2868 7840 -2794 7837 -2793 7775 -2932 1308 1863 1295
- 1886 1274 1834 7809 -2861 7870 -2718 1120 1905 7811 -2859 76 { m20} R 0 0.8
- 0.4069E-06 c 7817 -2849 7846 -2785 7867 -2743 7866 -2742 7876 -2717 1379 1945
- 1327 1991 7887 -2698 1202 2006 7857 -2757 1365 1912 1245 1920 7882 -2709 1467
- 1904 7835 -2807 7844 -2794 7873 -2725 7811 -2861 1246 1902 1517 1906 1151 1932
- 1572 1937 1390 1994 7879 -2710 1541 1913 7892 -2674 7829 -2826 1100 1992 1240
- 1983 7842 -2794 7833 -2815 1307 1912 1477 1940 7864 -2748 1382 1923 7841 -2796
- 7883 -2703 1488 1944 7845 -2790 7846 -2783 7897 -2669 7812 -2860 7825 -2833
- 7860 -2754 1054 2014 7857 -2766 7873 -2725 1726 1767 1492 1904 1321 1907 7843
- -2793 7893 -2679 1412 1989 1035 1954 1295 1984 1335 1948 7870 -2725 1590 1917
- 7874 -2726 880 2026 7834 -2811 7870 -2730 1250 1913 762 1978 7883 -2699 1236
- 1910 1347 1995 7854 -2773 1134 1977 1210 1934 1478 1919 1213 1922 7837 -2807
- 7870 -2733 7827 -2828 1431 1953 1715 1846 7834 -2816 1183 1949 1549 1865 1313
- 1930 1589 1898 7862 -2751 1327 1971 1309 1978 1510 1969 1448 1942 7857 -2765
- 7858 -2761 7851 -2771 7871 -2724 7817 -2849 7805 -2873 7823 -2837 1325 1972
- 1520 1971 7879 -2711 1189 1914 7907 -2642 7834 -2814 100 { m20} R 1600 1844
- 7818 -2847 1383 1983 1350 1931 1267 1909 1530 1944 7870 -2728 1224 1981 1329
- 1939 1270 1983 7877 -2711 1257 1902 1430 1966 7842 -2791 7874 -2717 7904 -2651
- 1243 1936 7806 -2872 1497 1954 7826 -2831 1326 1920 7831 -2818 1242 1945 7863
- -2752 7888 -2682 1575 1886 7894 -2676 7835 -2811 1486 1956 1390 1904 1523 1925
- 7862 -2754 7836 -2810 1410 1994 1379 1942 1489 1960 1552 1857 7869 -2739 7832
- -2818 1362 1989 7806 -2871 7854 -2767 1354 1994 7877 -2714 7900 -2666 1267 1903
- 1332 1920 7855 -2765 1210 1919 1187 1972 1257 1957 7869 -2730 7843 -2795 7904
- -2655 7862 -2744 1398 1944 7818 -2848 7889 -2685 7832 -2819 7813 -2857 7839
- -2800 7861 -2753 1460 1905 1519 1872 1611 1869 1353 1935 1304 1964 1408 1947
- 7893 -2679 1227 1933 7882 -2698 1362 1933 7885 -2701 1286 1969 1329 1990 7883
- -2697 7877 -2719 7846 -2786 7881 -2712 7889 -2684 1484 1938 1308 1956 7832
- -2818 1152 1997 7872 -2730 1756 1789 1341 1982 1190 1932 7867 -2736 1142 1957
- 7868 -2740 7878 -2712 1239 1999 1365 1944 7834 -2813 7837 -2810 1316 1912 7875
- -2720 7815 -2853 7860 -2755 100 { m20} R 1304 1910 7826 -2830 1496 1927 1454
- 1968 7823 -2837 1255 1969 7849 -2777 1413 1983 7862 -2745 7847 -2785 7877 -2721
- 7890 -2689 7889 -2690 7845 -2790 1174 1991 7820 -2843 1188 1997 1480 1963 1433
- 1974 7843 -2796 1293 1939 1245 1966 1271 1905 7831 -2820 7872 -2731 7831 -2818
- 7842 -2798 1326 1923 1452 1902 7831 -2820 1378 1931 669 1957 1353 1946 1668
- 1872 7867 -2741 1415 1924 1365 1948 7867 -2740 7861 -2756 7845 -2793 1302 1910
- 7851 -2770 1162 1944 1263 1941 1773 1801 1398 1911 1409 1949 1258 1975 1287
- 1959 7840 -2801 7888 -2683 7843 -2796 52 { m20} R 0.14545 0.8 0 c 1337 2049
- 7904 -2658 1554 1972 7870 -2741 1668 1907 1406 2051 7892 -2692 1200 2020 1302
- 2049 1360 2041 1399 2056 1412 2003 1442 2019 1209 2049 7874 -2732 7864 -2752
- 7907 -2654 7849 -2784 7860 -2761 1401 2051 1539 1973 1330 2004 1273 2014 1435
- 2021 1334 2031 7872 -2736 7903 -2666 7869 -2743 1252 2029 1276 2015 1529 2040
- 7891 -2696 7876 -2724 1362 2051 1075 2082 1107 2038 1264 2037 7868 -2743 7878
- -2721 7896 -2681 1392 2019 1150 2040 7870 -2741 1371 2055 7868 -2742 7848 -2786
- 1477 1996 7908 -2651 7907 -2656 1392 2063 7849 -2785 7857 -2769 7851 -2779 1491
- 2056 7862 -2758 7868 -2745 7874 -2731 1352 2008 7905 -2662 1452 2006 1359 2021
- 7886 -2702 1473 2003 1647 1940 1494 2051 7883 -2712 7904 -2664 1406 2029 7896
- -2682 7869 -2743 7857 -2769 1369 2057 7902 -2669 7882 -2716 1438 2047 1505 2017
- 1283 2016 1681 1943 7888 -2699 1750 1838 1591 1990 7873 -2732 1568 2029 7862
- -2756 1581 1952 1343 2006 7851 -2780 1493 2062 7896 -2684 1233 2018 7864 -2754
- 7858 -2767 7874 -2733 1472 2017 7897 -2683 1356 2005 7905 -2664 1558 2007 1486
- 2017 1310 2003 100 { m20} R 7882 -2713 7875 -2729 1376 2058 1424 2018 7902
- -2670 1349 2026 1598 1980 7889 -2699 1592 1956 1441 1999 1195 2069 7855 -2772
- 7852 -2778 1497 1998 1565 2000 7888 -2699 1213 2054 1379 2032 7901 -2669 1273
- 1998 7896 -2684 1288 2037 1393 2011 1429 2073 1567 2010 1245 2010 1619 1998
- 1680 1959 1348 2052 7855 -2771 1488 2054 1588 1975 1534 2048 7895 -2687 1816
- 1864 7904 -2659 7861 -2760 7872 -2735 7897 -2675 1423 2039 1454 2038 7891 -2692
- 7906 -2659 1261 2073 1274 2037 7894 -2684 1269 1997 7882 -2715 1622 1940 7849
- -2784 7901 -2671 1414 2021 1315 2011 1227 2078 7880 -2720 1360 2033 7846 -2790
- 7867 -2747 7888 -2701 1285 2068 1255 2013 7904 -2665 1559 2015 1584 1976 1382
- 2068 1389 2011 7905 -2655 1234 2042 1311 1998 1425 2023 1278 2029 1431 2031
- 1315 2056 1297 2033 1434 2047 7893 -2692 1625 1948 7885 -2710 1852 1831 7868
- -2747 7893 -2685 7862 -2758 1349 2003 7908 -2659 1331 2016 1574 1964 7884 -2709
- 7908 -2655 1464 2015 7905 -2664 1644 1962 7871 -2735 7860 -2759 7877 -2723 1600
- 2013 1432 2060 7871 -2740 1428 2026 7904 -2667 7862 -2759 100 { m20} R 7858
- -2766 1421 2021 1440 2021 1570 2032 1459 2062 7861 -2758 1399 2037 1627 1953
- 1658 1935 1611 2008 1535 2018 1567 1965 7836 -2810 7857 -2769 7860 -2761 7904
- -2660 7894 -2686 1656 1912 1325 2008 1108 2075 1179 2032 1445 2013 7851 -2780
- 7852 -2778 1579 1993 7881 -2716 1648 1938 1590 1970 1455 2045 1602 1958 7854
- -2775 1408 1997 7879 -2721 1261 2006 7902 -2666 1279 2039 7884 -2707 7878 -2721
- 7862 -2758 2047 1656 1353 2068 7872 -2735 7875 -2730 598 1993 44 { m20} R
- 0.29091 0.8 0 c 7889 -2702 1592 2059 7907 -2667 1505 2087 7902 -2674 1301 2116
- 7882 -2717 7903 -2674 1628 2056 1199 2092 7900 -2679 1390 2117 7897 -2687 889
- 2129 1504 2124 7906 -2666 1537 2101 7896 -2689 1250 2133 7900 -2682 1353 2085
- 1426 2126 1730 1996 7893 -2696 1435 2120 1675 1992 1252 2117 7899 -2683 1628
- 2063 7903 -2676 1319 2078 1581 2092 1330 2121 1512 2076 1495 2118 7889 -2704
- 1413 2118 7895 -2691 1418 2113 1428 2081 7892 -2696 1514 2084 1464 2118 1483
- 2117 1325 2134 1305 2121 1288 2112 1391 2116 1498 2073 1386 2139 1228 2118 1292
- 2105 7882 -2718 7891 -2700 1409 2081 7909 -2663 7892 -2697 1492 2112 7897 -2688
- 7893 -2695 1378 2088 1329 2091 1343 2078 1396 2118 1427 2124 1411 2110 7870
- -2742 7901 -2676 1278 2121 1144 2158 1339 2123 1395 2091 7892 -2698 1478 2096
- 1438 2121 1300 2090 7896 -2690 7896 -2689 7893 -2696 7890 -2699 1575 2084 1360
- 2128 7883 -2717 1605 2052 1357 2075 7904 -2671 7891 -2699 7893 -2697 1410 2124
- 1679 2002 1563 2059 1264 2142 1273 2134 1358 2082 1435 2105 1614 2078 2132 1689
- 1308 2099 1450 2127 1249 2090 100 { m20} R 1414 2115 1440 2132 7882 -2718 1555
- 2074 1813 1880 1507 2085 1460 2126 1278 2126 7884 -2713 1684 1982 1339 2127
- 7901 -2676 1505 2110 1371 2106 7907 -2663 1424 2138 7893 -2694 1421 2100 1171
- 2129 7908 -2662 7904 -2672 1478 2089 1172 2142 1643 2003 7902 -2677 1461 2086
- 7899 -2684 1410 2105 1333 2095 1215 2108 1334 2083 7882 -2717 1288 2135 7906
- -2669 1275 2105 1434 2102 7891 -2699 1242 2101 1405 2117 1255 2127 7907 -2662
- 1024 2129 7897 -2689 1399 2075 7897 -2688 1613 2037 1566 2090 1378 2091 1405
- 2127 1387 2122 1516 2061 1202 2135 1611 2032 7894 -2694 1302 2099 1349 2102
- 7896 -2687 7909 -2658 1480 2107 7887 -2707 1253 2130 1404 2077 7888 -2705 1591
- 2065 7895 -2692 1313 2111 1378 2098 1315 2110 1255 2090 7897 -2684 7877 -2729
- 1461 2111 7885 -2712 7897 -2686 7882 -2719 1390 2138 1467 2092 1595 2074 1492
- 2106 1474 2123 7887 -2709 1624 2058 7894 -2692 1433 2137 1443 2104 1632 2062
- 1328 2075 1298 2102 7894 -2693 1266 2108 7880 -2722 7898 -2684 1536 2097 7905
- -2670 7898 -2684 1436 2111 7890 -2700 97 { m20} R 0.43636 0.8 0 c 1505 2171
- 1349 2165 1544 2165 1233 2169 1693 2059 7900 -2682 1546 2143 1265 2153 1385
- 2180 1475 2159 1713 2060 1514 2144 1858 1956 1129 2221 1650 2085 1489 2155 1454
- 2184 1462 2171 1629 2106 7904 -2674 1326 2173 1456 2189 1451 2162 1464 2141
- 1534 2162 1385 2154 1597 2125 1340 2193 1434 2145 1309 2142 7899 -2684 1401
- 2154 1368 2163 1406 2195 1428 2173 7905 -2671 1469 2153 1594 2119 1435 2179
- 1550 2169 1615 2106 1433 2186 1384 2160 1416 2172 1644 2089 1928 1896 1274 2148
- 1410 2189 1554 2162 1447 2168 1332 2175 1534 2148 1364 2189 1660 2108 7907
- -2668 1461 2153 1431 2156 1525 2171 1397 2150 1475 2161 1305 2172 1640 2076
- 1420 2160 1352 2185 1610 2134 1488 2183 1229 2174 1463 2157 1546 2147 1461 2183
- 1542 2157 1575 2146 1094 2197 1631 2079 1471 2178 1458 2191 1272 2154 1530 2156
- 1301 2141 1285 2153 1647 2085 1400 2142 1561 2146 1359 2162 1551 2118 1510 2134
- 1461 2141 1400 2142 1395 2147 1721 2037 1497 2133 1777 1996 1780 1984 1498 2130
- 1498 2130 1577 2149 1568 2161 1359 2168 7906 -2670 1515 2153 100 { m20} R 1382
- 2145 1484 2156 1366 2147 1486 2139 1466 2158 7905 -2671 7899 -2684 1454 2152
- 7900 -2683 1327 2147 1244 2180 1433 2185 1517 2167 1542 2148 1594 2136 1534
- 2171 1433 2166 1403 2184 7902 -2678 1467 2189 1359 2189 1314 2173 1379 2146
- 1610 2136 1513 2140 1435 2178 1552 2159 1542 2125 1441 2187 1446 2175 1364 2143
- 1370 2154 1321 2183 1369 2188 1282 2181 1463 2151 1482 2134 1344 2179 1562 2155
- 1419 2170 1467 2163 1492 2156 1404 2189 1579 2132 1318 2164 1693 2031 1471 2146
- 1494 2180 1377 2195 1540 2163 1502 2130 1593 2120 1336 2168 53 { m20} R 0.58182
- 0.8 0 c 1511 2220 1495 2212 1442 2234 1443 2233 1594 2154 1401 2241 1503 2231
- 1458 2215 1436 2242 1513 2195 1260 2250 1546 2195 1387 2239 1470 2199 1471 2228
- 1559 2170 1400 2212 1428 2229 1458 2239 1445 2243 1436 2198 1461 2239 1504 2213
- 1371 2237 1389 2219 1444 2221 1454 2217 1388 2233 1483 2215 1437 2206 1541 2200
- 1472 2239 1407 2206 1462 2243 1492 2189 1480 2193 1358 2237 1571 2173 1315 2231
- 1419 2239 1422 2211 1419 2213 1367 2199 1474 2241 1349 2236 1523 2192 1405 2226
- 1399 2241 1395 2204 1451 2207 1458 2225 1461 2241 1414 2218 1489 2210 1491 2234
- 1545 2176 1274 2236 1447 2215 1420 2198 1344 2201 1532 2198 1490 2229 1297 2234
- 1392 2223 1431 2231 1517 2208 1500 2230 1567 2177 1446 2211 1530 2186 1408 2213
- 1435 2233 1522 2184 1513 2185 1465 2214 1471 2225 1423 2219 1506 2213 1319 2216
- 1599 2154 1450 2216 1372 2206 82 { m20} R 0.72727 0.8 0 c 1387 2249 1424 2267
- 1406 2256 1359 2277 1310 2254 1370 2272 1424 2285 1347 2270 1470 2255 1361 2252
- 1392 2270 1429 2253 1435 2275 1284 2286 1449 2263 1426 2251 1441 2274 1461 2252
- 1443 2256 1468 2254 1433 2254 1329 2261 1360 2282 1418 2245 1417 2270 1393 2266
- 1433 2272 1433 2270 1395 2264 1426 2265 1467 2258 1391 2285 1392 2267 1420 2282
- 1470 2256 1387 2255 1421 2279 1450 2278 1473 2258 1411 2282 1434 2274 1327 2270
- 1384 2263 1406 2284 1354 2251 1343 2280 1482 2249 47 { m20} R 0.8 0.72727 0 c
- 1419 2311 1409 2322 1380 2298 1410 2322 1399 2291 1338 2298 1405 2300 1404 2302
- 1408 2295 1415 2308 1347 2314 1394 2297 1383 2313 1414 2303 1320 2322 1361 2296
- 1387 2291 1345 2308 1367 2291 1411 2315 20 { m20} R 0.8 0.58182 0 c 1372 2336
- 1345 2342 1360 2362 1378 2330 4 { m20} R 0.8 0.43636 0 c 1372 2336 0.8 0.29091
- 0 c 1372 2336 0.8 0.14546 0 c 1372 2336 0 0 0.8 c 1372 2336 0 0.14545 0.8 c
- 1372 2336 0 0.29091 0.8 c 1372 2336 0 0.43636 0.8 c 7340 -2978 7394 -2991 7631
- -2837 7281 -3033 7385 -2960 7543 -2913 7609 -2866 7489 -2927 7567 -2872 9 { m20
-} R 0 0.58182 0.8 c 7424 -3031 7352 -3021 7618 -2926 7634 -2898 7579 -2948 6923
- -3235 7208 -3135 7594 -2948 7586 -2954 7584 -2934 6957 -3157 7454 -3023 7385
- -3077 13 { m20} R 0 0.72727 0.8 c 7585 -2983 7645 -2953 7378 -3198 7772 -2780
- 7368 -3198 7609 -2944 7571 -3034 7315 -3197 7323 -3159 7429 -3170 7608 -2949
- 7435 -3109 7130 -3198 7696 -2869 7385 -3189 7329 -3142 7539 -3058 7368 -3194
- 7708 -2837 7631 -2988 7509 -3126 7623 -2988 7575 -3015 7671 -2931 7512 -3029
- 7556 -3051 7389 -3209 7489 -3116 7238 -3278 7507 -3052 7455 -3141 7567 -2980
- 7212 -3160 7575 -3057 7529 -3023 7553 -3027 7200 -3235 7765 -2769 7716 -2832
- 7565 -3007 7442 -3161 7606 -2980 7390 -3155 7524 -3070 7516 -3070 7702 -2858
- 7736 -2819 7571 -2981 7575 -3028 49 { m20} R 0 0.8 0.72727 c 7128 -3491 7598
- -3103 7615 -3108 7746 -2866 7412 -3213 7508 -3162 7685 -2981 7615 -3025 7651
- -2999 7612 -3051 7568 -3079 7490 -3308 7562 -3149 7624 -3029 7714 -2932 7730
- -2865 7693 -2950 7765 -2805 7473 -3294 7462 -3197 7733 -2858 7318 -3385 7513
- -3168 7476 -3276 7518 -3160 7695 -2913 7382 -3382 7495 -3199 7740 -2841 7380
- -3428 7625 -3062 7443 -3299 7644 -3036 7110 -3679 7622 -3006 7509 -3207 7688
- -2934 7686 -2937 7689 -2921 7399 -3235 7729 -2878 7634 -3054 7666 -3022 7566
- -3117 7298 -3416 7695 -2959 6575 -3592 7670 -2978 7445 -3226 7544 -3204 6862
- -3421 7325 -3379 7393 -3451 7591 -3152 7684 -2973 7594 -3130 7437 -3246 7599
- -3087 7263 -3587 7722 -2907 7625 -3090 7665 -2989 7047 -3588 7598 -3057 7598
- -3080 7699 -2923 7588 -3161 7764 -2830 7599 -3131 7526 -3224 7614 -3118 7641
- -3014 7281 -3549 7757 -2817 7664 -3003 7634 -3073 7756 -2837 7492 -3234 7134
- -3652 7657 -2963 7197 -3356 7699 -2926 7240 -3329 7405 -3234 7190 -3592 7632
- -3083 7677 -2932 7378 -3270 7568 -3189 7478 -3345 7528 -3245 7634 -3074 7657
- -2978 7589 -3117 7578 -3117 7436 -3341 96 { m20} R 0 0.8 0.58182 c 7665 -3068
- 7616 -3210 7810 -2780 7799 -2797 7696 -3038 7473 -3410 7641 -3163 7554 -3333
- 7687 -3015 7723 -2947 7705 -3018 7648 -3123 7550 -3354 7635 -3164 7444 -3427
- 7412 -3520 7726 -2915 7646 -3120 7703 -3009 7622 -3159 7723 -2964 7596 -3174
- 7563 -3266 7449 -3548 7691 -2995 7697 -3021 7489 -3344 7655 -3100 7388 -3635
- 7489 -3414 7666 -3098 1651 594 7760 -2861 7693 -3038 7800 -2805 469 1164 7574
- -3230 7533 -3274 7560 -3218 7516 -3395 7054 -4311 7733 -2942 7566 -3284 7734
- -2931 7555 -3262 7484 -3414 7781 -2814 7740 -2897 7603 -3153 7592 -3207 7776
- -2836 7601 -3179 7626 -3127 1212 1079 7663 -3098 7442 -3588 7689 -3004 374 1078
- 7258 -3783 7455 -3527 7737 -2929 7451 -3399 7673 -3071 7684 -3046 7696 -2984
- 7663 -3076 7642 -3112 7684 -3056 7613 -3154 7747 -2898 7618 -3203 7784 -2818
- 7799 -2797 7804 -2796 7532 -3412 7774 -2835 7495 -3483 7469 -3466 1247 1197
- 7685 -3045 7534 -3270 7767 -2871 7738 -2927 7376 -3584 7503 -3312 7467 -3419
- 7746 -2921 7764 -2844 119 1046 7502 -3451 7581 -3193 7682 -3056 7431 -3453 7485
- -3372 7717 -2963 1152 1135 1405 821 7760 -2887 7601 -3173 7632 -3140 100 { m20
-} R 7665 -3074 7653 -3075 7836 -2730 7527 -3421 7645 -3087 7727 -2963 610 1211
- 7787 -2832 7647 -3153 7558 -3341 7382 -3655 7606 -3180 977 1078 7627 -3194 7584
- -3197 7606 -3173 7359 -3712 7124 -3894 7673 -3069 544 1204 983 957 7565 -3301
- 7691 -3050 1095 913 7571 -3267 7818 -2761 7468 -3363 7568 -3274 7125 -4160 7713
- -2999 7610 -3151 7311 -3647 7738 -2944 7661 -3080 7690 -3032 7587 -3234 1218
- 1051 7754 -2898 1222 1182 7513 -3406 7612 -3157 7476 -3365 7412 -3592 7658
- -3119 7761 -2866 7096 -3959 1309 1140 7673 -3060 7517 -3448 7713 -2989 7503
- -3372 7809 -2769 7581 -3293 7742 -2928 7404 -3634 55 { m20} R 0 0.8 0.43636 c
- 7782 -2880 7630 -3208 7642 -3196 7699 -3072 1344 1521 7678 -3127 7669 -3115
- 7651 -3178 7614 -3252 7822 -2767 7796 -2846 1132 1461 7679 -3121 7647 -3191
- 1040 1463 7788 -2835 1178 1482 1291 1503 1261 1311 7672 -3140 7541 -3405 7661
- -3130 1506 1458 7644 -3199 1272 1451 7718 -3014 2001 1165 1473 1542 1111 1420
- 7680 -3099 1258 1456 1327 1455 1097 1286 7666 -3110 7666 -3152 902 1276 903
- 1586 1000 1462 7693 -3082 1323 1415 862 1514 1310 1435 7858 -2707 7754 -2949
- 7669 -3144 7826 -2772 7786 -2848 7700 -3055 7779 -2883 7660 -3164 7708 -3060
- 7712 -3037 7729 -2972 7787 -2868 7794 -2836 227 1416 1414 1380 7760 -2906 941
- 1467 653 1526 7643 -3191 1241 1547 7838 -2757 7661 -3151 1252 1482 7743 -2978
- 7733 -2977 1169 1533 7791 -2831 1125 1559 7755 -2933 7783 -2865 7809 -2806 7811
- -2809 1486 1390 7710 -3046 7702 -3031 1221 1336 1226 1314 7853 -2700 7752 -2955
- 892 1484 7766 -2903 7694 -3082 7796 -2843 7819 -2797 7680 -3119 7601 -3270 1424
- 1437 7657 -3164 1229 1260 7559 -3364 1423 1503 1095 1255 7732 -2970 7757 -2946
- 7699 -3082 7680 -3117 7660 -3133 1081 1564 100 { m20} R 1305 1458 982 1431 1089
- 1575 7783 -2884 7635 -3204 1096 1494 1368 1537 7622 -3244 1572 1154 7799 -2848
- 7648 -3189 7675 -3116 934 1555 7685 -3099 1629 1141 7791 -2850 7676 -3129 1088
- 1577 1231 1546 7693 -3083 1363 1477 7705 -3051 7671 -3137 7672 -3109 7721 -3011
- 7795 -2837 349 1404 1237 1498 7806 -2825 7623 -3241 7687 -3099 7712 -3029 7789
- -2863 1223 1574 1240 1419 7755 -2950 7661 -3156 7734 -2998 1016 1424 1450 1285
- 7589 -3302 7793 -2852 7692 -3095 7779 -2874 7793 -2846 7742 -2962 1163 1373
- 7678 -3119 1375 1521 1684 1303 7654 -3169 7772 -2901 7721 -3011 7816 -2804 7676
- -3131 7774 -2876 7656 -3174 7731 -2990 7802 -2819 7621 -3245 7828 -2759 7708
- -3023 7740 -2972 7825 -2769 1281 1548 1295 1554 1363 1481 7805 -2832 7828 -2768
- 787 1444 7713 -3020 1243 1528 1257 1235 7676 -3102 696 1529 1238 1474 7717
- -3042 1241 1361 7743 -2980 7872 -2659 7584 -3317 7700 -3042 7734 -2958 980 1428
- 7756 -2919 7780 -2888 7623 -3215 7714 -3016 88 { m20} R 0 0.8 0.29091 c 7725
- -3033 1219 1769 7760 -2954 7742 -2994 7757 -2949 1132 1723 7837 -2773 1238 1633
- 1039 1773 7781 -2901 7800 -2871 7881 -2672 937 1765 1248 1683 1139 1726 7717
- -3045 7752 -2964 7768 -2942 7761 -2948 934 1722 1122 1707 7868 -2692 1623 1634
- 1254 1664 7775 -2907 7793 -2865 1163 1651 1222 1677 7809 -2834 7809 -2846 7732
- -3021 1198 1712 1258 1608 7779 -2905 7789 -2878 7722 -3040 1092 1797 7787 -2893
- 848 1669 1288 1610 1052 1716 1368 1659 7767 -2944 7786 -2881 979 1638 7802
- -2863 7772 -2921 1387 1744 1292 1598 7782 -2913 7868 -2707 7841 -2761 1382 1732
- 7806 -2856 7862 -2713 7819 -2827 1266 1699 7757 -2963 7778 -2918 7776 -2906
- 7798 -2865 7685 -3115 7724 -3032 7811 -2843 854 1794 7738 -3002 1115 1626 7735
- -3009 7819 -2820 1355 1633 7810 -2824 7763 -2948 1344 1708 1115 1731 1270 1638
- 7786 -2899 7764 -2942 7851 -2733 7813 -2835 1322 1699 7728 -3029 7704 -3072
- 1463 1720 1001 1791 7899 -2634 7833 -2794 7773 -2919 1111 1784 7722 -3036 1553
- 1599 7748 -2972 7730 -3015 1289 1597 7799 -2865 7788 -2894 7803 -2863 7726
- -3032 7823 -2797 7803 -2848 1286 1680 100 { m20} R 7806 -2847 7751 -2981 7858
- -2717 7776 -2923 7838 -2781 7832 -2777 7841 -2773 7775 -2914 7822 -2816 7873
- -2682 1320 1699 1336 1722 7783 -2909 7759 -2965 7738 -3003 1362 1757 1306 1661
- 7782 -2903 7747 -2990 1271 1726 7742 -3000 977 1659 1146 1724 1155 1745 7828
- -2804 7715 -3048 1056 1753 1305 1714 1504 1691 7865 -2709 1089 1734 7775 -2919
- 1227 1736 7797 -2868 7796 -2863 7829 -2783 1143 1736 1274 1751 7840 -2770 7810
- -2844 1219 1744 7845 -2745 1156 1658 7696 -3093 990 1702 1461 1624 1339 1595
- 1206 1771 7894 -2636 1299 1642 7731 -3019 1183 1759 7739 -3006 7795 -2861 885
- 1725 999 1813 1277 1691 7742 -2993 1344 1746 7703 -3080 1247 1691 1532 1539
- 1502 1620 1208 1750 7750 -2984 7795 -2871 7757 -2970 1287 1749 1346 1769 7781
- -2895 1144 1709 1479 1658 1138 1635 7779 -2915 7774 -2909 1261 1735 1315 1654
- 1174 1653 7869 -2695 1241 1608 1350 1757 1464 1577 7711 -3062 7875 -2675 1307
- 1769 1503 1588 7732 -3021 7810 -2843 7829 -2777 7771 -2924 7856 -2727 7737
- -3006 7843 -2763 7730 -3015 1455 1756 7724 -3033 1325 1606 1054 1762 1408 1754
- 7868 -2690 100 { m20} R 1290 1694 1085 1785 7685 -3115 7907 -2617 1250 1694
- 7800 -2855 1201 1630 1266 1710 7827 -2800 1423 1698 7803 -2837 7713 -3056 1240
- 1762 1245 1698 1300 1710 7761 -2954 7855 -2740 7768 -2940 1022 1775 7785 -2894
- 1390 1711 1345 1715 7844 -2749 7902 -2616 7696 -3090 7739 -3005 7840 -2772 7746
- -2985 7707 -3067 1350 1685 562 1715 7773 -2934 7699 -3085 7736 -3009 7820 -2802
- 7702 -3081 7708 -3069 7781 -2905 7777 -2920 1502 1680 1278 1603 7840 -2758 972
- 1639 43 { m20} R 0 0.8 0.14545 c 7805 -2865 7779 -2925 1673 1737 1120 1920 952
- 1875 7833 -2809 7754 -2976 1217 1903 7825 -2812 7827 -2819 7857 -2749 1505 1761
- 1329 1877 1281 1790 1464 1873 1303 1866 7882 -2693 1207 1776 7799 -2879 7812
- -2857 1309 1807 1380 1863 1241 1775 7812 -2856 1092 1824 1327 1804 7775 -2935
- 7857 -2740 7810 -2861 7853 -2763 7822 -2821 1495 1803 7794 -2887 1122 1851 7805
- -2863 7843 -2770 1241 1885 7810 -2855 1489 1857 1559 1776 1481 1753 1283 1866
- 1522 1807 7889 -2674 7891 -2669 7766 -2952 1284 1812 1294 1847 1529 1752 1076
- 1895 7877 -2691 1388 1864 7812 -2854 7871 -2715 1438 1780 1312 1895 1297 1812
- 1277 1792 1351 1847 1077 1904 936 1841 7823 -2825 1132 1857 7881 -2691 7777
- -2929 1457 1837 1574 1701 7823 -2834 7806 -2861 1121 1843 7800 -2877 1426 1784
- 7842 -2791 1157 1907 7828 -2809 1104 1884 7853 -2763 7781 -2918 1421 1871 7841
- -2777 7800 -2883 7839 -2795 1347 1843 7873 -2701 7828 -2814 1321 1867 7847
- -2764 1543 1758 1131 1871 1482 1797 1231 1877 7887 -2680 7855 -2742 7773 -2939
- 7883 -2686 1375 1794 1214 1853 1379 1807 1592 1796 1442 1835 100 { m20} R 7882
- -2692 1487 1830 7799 -2885 929 1912 7770 -2941 7825 -2818 1487 1793 7868 -2720
- 7780 -2920 1184 1870 7748 -2988 7809 -2863 1234 1820 1303 1775 1353 1789 7869
- -2721 1195 1804 7788 -2908 1272 1774 7801 -2877 7768 -2946 1245 1841 1826 1610
- 1254 1888 7798 -2888 1217 1816 7883 -2682 7841 -2782 7775 -2931 7824 -2825 1373
- 1871 1017 1835 7814 -2847 7845 -2780 1519 1812 7825 -2827 7824 -2828 1188 1868
- 7853 -2764 7790 -2902 7895 -2653 1202 1831 7858 -2744 7871 -2716 1255 1812 1413
- 1784 7867 -2727 7860 -2735 7789 -2899 7841 -2787 1442 1768 1496 1828 1440 1872
- 1235 1881 7854 -2754 981 1865 1346 1810 7795 -2884 7872 -2714 7819 -2839 1374
- 1772 7819 -2843 7815 -2851 7771 -2942 7808 -2866 1412 1787 1436 1820 7862 -2728
- 1199 1898 1516 1786 7884 -2689 7830 -2819 7816 -2836 7840 -2793 7840 -2783 7794
- -2895 7784 -2914 1401 1897 1202 1853 732 1838 1028 1885 7797 -2889 7836 -2802
- 1555 1829 1181 1899 993 1819 7859 -2734 1345 1853 7811 -2859 7869 -2722 1386
- 1867 983 1827 7827 -2811 1214 1849 1501 1863 7866 -2732 7880 -2688 7829 -2812
- 7841 -2786 7893 -2662 100 { m20} R 7860 -2743 1225 1885 1492 1826 1317 1782
- 1336 1831 7818 -2843 7760 -2965 1109 1841 7840 -2788 7880 -2690 7810 -2862 7875
- -2700 1270 1789 1268 1834 7836 -2791 1472 1800 7808 -2866 1495 1767 1426 1881
- 1257 1788 1282 1866 1136 1850 1634 1701 1289 1845 1189 1856 7802 -2877 1249
- 1877 7846 -2768 1316 1823 7817 -2839 1419 1870 1015 1854 7808 -2853 7797 -2887
- 7815 -2851 1314 1780 7868 -2726 7812 -2858 7776 -2931 7776 -2929 7876 -2698
- 7833 -2810 1495 1743 1598 1793 1287 1792 1827 1628 7855 -2757 994 1934 1312
- 1891 1366 1832 7801 -2882 7832 -2811 1223 1883 1389 1895 1371 1801 1385 1783
- 1472 1777 7786 -2912 7825 -2823 7794 -2894 1411 1866 7898 -2646 7823 -2820 7841
- -2788 1268 1877 2088 1377 66 { m20} R 0 0.8 0.4069E-06 c 1358 1911 7871 -2729
- 7889 -2692 1390 1931 7899 -2663 1287 1949 7837 -2806 7841 -2797 7881 -2708 1373
- 1960 1367 1909 1187 1916 7862 -2747 1391 1987 1350 1914 1457 1934 7840 -2802
- 1416 1922 1378 1947 1493 1933 1051 2020 7903 -2656 1211 1962 7906 -2652 7835
- -2811 1615 1848 7819 -2846 7824 -2834 1288 1934 1110 1935 1054 1999 7889 -2688
- 7838 -2807 1469 1920 1129 1967 7844 -2788 1070 1972 1439 1945 7849 -2774 1172
- 1991 7860 -2750 7908 -2646 7856 -2768 7891 -2684 7817 -2849 7889 -2690 7877
- -2719 7896 -2665 7866 -2735 7844 -2792 7844 -2789 1490 1935 1314 1980 7892
- -2683 7883 -2698 1473 1891 7860 -2757 7844 -2793 1380 1928 1420 1954 1287 1941
- 927 2033 7838 -2806 1286 1946 1341 1987 7884 -2699 7848 -2781 7903 -2648 1287
- 1946 1408 1917 7884 -2704 1110 1965 7841 -2800 1417 1958 7868 -2731 1032 2012
- 7839 -2798 7815 -2854 7861 -2753 7845 -2790 1380 1978 1564 1943 1145 1987 1450
- 1958 7823 -2836 1216 1940 1417 1981 1163 1929 1250 1922 1350 1989 1562 1945
- 1397 1959 1322 1958 1366 1912 1350 1933 7878 -2718 7823 -2837 1419 1913 7851
- -2776 7897 -2663 100 { m20} R 1487 1893 7810 -2864 1376 1974 1343 1906 1443
- 1988 1218 1966 1299 1984 7890 -2691 7854 -2772 1387 1972 7904 -2654 7890 -2686
- 1391 1945 1242 1982 7868 -2732 7813 -2858 7850 -2778 1412 1966 7825 -2832 1114
- 1946 7832 -2816 7883 -2704 1181 1988 7838 -2806 1292 1976 1474 1962 1327 1951
- 1285 1938 1372 1926 1191 2009 7823 -2835 7858 -2754 1147 2007 1324 1949 7855
- -2761 7898 -2670 1191 1936 1364 1976 7830 -2822 1279 1955 7891 -2683 1228 1953
- 1351 1916 7870 -2735 7824 -2834 1118 1970 7844 -2793 7898 -2669 7841 -2799 7835
- -2810 1316 1961 7860 -2754 1419 1941 1591 1919 7876 -2713 1356 1903 7849 -2776
- 7901 -2654 1402 1987 7886 -2691 1399 1961 1553 1880 1215 1943 7898 -2671 7871
- -2733 7838 -2808 7832 -2817 1545 1903 7851 -2770 1285 1927 1553 1913 1211 2005
- 7814 -2855 7870 -2737 1468 1956 7858 -2761 7836 -2810 1323 1926 1188 1991 1445
- 1956 1369 1979 1076 1950 1024 2022 1300 1980 1020 2021 7877 -2719 7850 -2781
- 7829 -2825 7881 -2705 1322 1929 7843 -2792 1612 1820 1289 1929 1132 1972 1274
- 1965 1438 1900 1664 1806 1237 1932 7854 -2768 1636 1897 100 { m20} R 1354 1904
- 7874 -2722 1378 1936 7847 -2788 1411 1957 7876 -2722 1274 1938 1065 2035 1276
- 1967 7859 -2753 1114 1990 7854 -2770 1584 1909 1124 1949 1442 1965 7879 -2712
- 7821 -2840 1387 1995 740 1930 7834 -2815 7831 -2816 1394 1978 7826 -2830 7873
- -2726 7833 -2816 7856 -2761 1375 1926 7857 -2766 1140 1985 1277 1993 1388 1905
- 7854 -2763 7904 -2652 7826 -2829 7864 -2750 1174 1989 1436 1989 1327 1970 7908
- -2642 7850 -2777 1610 1820 7886 -2696 7857 -2762 7835 -2813 1213 1994 1415 1987
- 7873 -2729 7868 -2734 7800 -2884 7820 -2841 1341 1978 1352 1946 7819 -2845 7859
- -2753 1623 1889 7891 -2682 7878 -2708 1605 1874 7838 -2802 1178 2005 1585 1886
- 7902 -2661 7836 -2809 1410 1955 7877 -2721 1222 1950 1240 1916 67 { m20} R
- 0.14545 0.8 0 c 7895 -2682 7853 -2777 7862 -2758 1667 1967 1475 1988 1437 2055
- 7850 -2783 7876 -2730 1633 1944 1329 2059 1434 2064 7906 -2658 1379 2047 1376
- 2017 7883 -2708 7870 -2740 1598 1974 1421 2065 7893 -2686 7901 -2668 7874 -2733
- 1680 1881 7891 -2695 1424 2017 7866 -2750 7855 -2772 1139 2040 973 2066 7849
- -2785 7842 -2799 7909 -2647 1032 2056 7871 -2739 7867 -2747 1566 1970 7885
- -2706 1287 2036 1254 2006 1492 2056 7891 -2694 1425 2043 1447 2031 7890 -2698
- 7884 -2709 7876 -2728 1504 2045 1224 2027 1429 2049 7898 -2681 1201 2033 7871
- -2740 1328 2072 7866 -2749 7856 -2770 7872 -2737 1589 1965 1230 2021 7866 -2747
- 1327 2070 1490 2038 1601 1976 7857 -2768 7875 -2731 7859 -2764 7903 -2668 7868
- -2747 7864 -2752 7896 -2686 7888 -2700 1274 2045 1469 2025 7862 -2758 1409 2019
- 1329 2037 1368 2038 1413 2061 7876 -2727 1529 1999 7881 -2720 1616 2006 7862
- -2756 1317 2073 1332 2000 7869 -2742 7856 -2771 1168 2068 1280 2004 1555 1979
- 7841 -2802 7897 -2681 1398 2074 1413 2042 7852 -2778 7908 -2651 7888 -2702 7891
- -2689 1409 2021 1386 2065 956 2122 1582 2010 100 { m20} R 7892 -2691 7859 -2761
- 7904 -2665 1273 2019 1262 2007 1381 1998 1264 2064 7879 -2722 7859 -2763 1283
- 2047 1464 2019 1298 2019 7892 -2694 7887 -2703 7898 -2676 1264 2012 1461 2009
- 1253 2071 7887 -2699 7876 -2730 7844 -2794 1400 2069 7888 -2704 1286 2065 7880
- -2720 7883 -2713 7868 -2746 7880 -2719 7866 -2748 7851 -2781 7857 -2769 1524
- 2045 7862 -2756 1438 2069 1411 2002 7903 -2669 7895 -2687 7893 -2688 1471 2039
- 7875 -2730 1523 2030 7874 -2732 1386 2071 7888 -2699 7856 -2770 1468 2050 7851
- -2780 7858 -2765 1481 2015 7849 -2785 1435 2047 1314 2032 1342 2058 7896 -2679
- 1539 2001 1552 2018 7885 -2708 7849 -2784 1301 2011 7905 -2659 1409 2045 1432
- 1999 1458 2066 1062 2096 1418 2008 1262 2043 1146 2054 1496 1982 1362 2011 1437
- 2006 7853 -2776 1503 2039 1238 2042 1175 2039 7853 -2776 7900 -2671 7886 -2706
- 1383 1999 1362 2006 1499 2038 1244 2052 1479 2034 7887 -2705 1503 2003 1304
- 2031 7899 -2670 7854 -2774 1392 2027 7871 -2741 7844 -2795 7903 -2669 7866
- -2750 7869 -2743 1500 2001 1702 1920 7891 -2689 7838 -2808 1356 2072 1568 2019
- 1375 2040 100 { m20} R 1612 1995 7864 -2755 7892 -2692 7867 -2746 1223 2044
- 7876 -2725 7854 -2774 1297 2038 1544 1968 1424 2014 1247 2059 7898 -2676 1391
- 2012 7901 -2665 7844 -2795 7878 -2724 7856 -2772 7849 -2785 7875 -2733 7897
- -2684 1451 2001 1427 2045 1322 2065 7874 -2733 7871 -2738 1298 2002 1249 2024
- 1361 2028 1589 2020 7876 -2729 1377 2071 7884 -2709 1559 1995 7860 -2761 7885
- -2705 1359 2022 7899 -2677 7897 -2682 1431 2012 1237 2042 7863 -2757 7899 -2672
- 7893 -2685 7863 -2755 7894 -2687 1154 2044 7849 -2784 7863 -2757 7884 -2707
- 1219 2014 7897 -2675 1358 2049 1102 2108 1320 1997 7851 -2780 7890 -2692 1384
- 2044 57 { m20} R 0.29091 0.8 0 c 1193 2138 7907 -2661 1409 2092 1419 2104 1315
- 2076 7902 -2677 1489 2094 1597 2019 1465 2117 7894 -2694 1330 2129 7897 -2686
- 1410 2087 1408 2112 1258 2085 1236 2102 1583 2069 7892 -2698 1284 2108 1392
- 2118 1427 2128 7884 -2713 7900 -2681 1244 2097 1364 2132 1491 2094 7906 -2665
- 1459 2081 7898 -2686 1472 2100 7900 -2679 1368 2098 1259 2135 1406 2132 7906
- -2665 7897 -2684 1438 2075 7899 -2683 1393 2134 1443 2089 7900 -2678 1472 2088
- 1516 2073 7883 -2716 1381 2097 7890 -2699 1478 2116 1593 2061 1416 2095 7890
- -2700 7897 -2686 7876 -2730 7907 -2665 1305 2131 7897 -2686 7893 -2695 7889
- -2705 7877 -2729 1608 2070 1478 2114 1420 2082 1296 2138 7895 -2692 1696 2012
- 7888 -2704 1209 2106 1416 2102 7895 -2690 7878 -2725 1475 2116 1435 2091 1443
- 2127 1337 2078 1359 2119 1576 2100 1486 2096 1643 2005 1387 2108 7873 -2735
- 1531 2114 1340 2082 1284 2081 7898 -2685 1241 2093 1605 2037 1423 2131 1476
- 2112 1570 2039 1436 2089 1318 2111 1351 2097 7891 -2699 7887 -2708 1653 2000
- 1834 1889 7871 -2740 7895 -2692 1666 2041 1399 2084 1572 2089 100 { m20} R 1538
- 2062 7884 -2714 1328 2093 1361 2130 7905 -2669 1510 2096 1499 2127 1293 2078
- 7889 -2704 7894 -2692 1293 2139 1451 2080 1439 2098 1510 2110 1353 2113 1431
- 2087 1541 2109 1417 2138 1490 2080 7876 -2729 7895 -2691 7892 -2697 1384 2077
- 861 2139 7885 -2713 1901 1859 7897 -2687 7896 -2687 1747 1965 7897 -2686 1570
- 2075 7888 -2704 7881 -2721 1364 2091 7885 -2712 7899 -2683 7895 -2689 1290 2101
- 7909 -2662 1249 2134 1395 2078 1502 2096 7904 -2674 7872 -2739 7870 -2742 1371
- 2083 7900 -2677 1529 2054 7893 -2694 1438 2125 1444 2077 1415 2136 7893 -2694
- 7895 -2691 1496 2130 1529 2116 7895 -2691 1319 2121 7878 -2726 7884 -2714 1480
- 2119 1849 1907 1334 2093 1235 2083 1403 2081 1396 2086 7905 -2670 1455 2129
- 1356 2116 1522 2082 1438 2139 7892 -2697 7905 -2668 1475 2077 1699 1998 7882
- -2719 1584 2079 7898 -2686 1800 1935 7898 -2686 1382 2116 1186 2131 1652 2053
- 1497 2075 7907 -2665 1290 2121 1720 1990 1616 2050 7892 -2697 7878 -2725 1387
- 2091 1448 2108 1472 2077 1389 2097 1449 2121 1303 2082 1509 2123 1654 2025 1592
- 2091 1469 2127 100 { m20} R 1274 2126 1423 2126 2 { m20} R 0.43636 0.8 0 c 1589
- 2121 1826 1958 1452 2175 1610 2127 7903 -2676 1642 2093 1445 2153 1267 2163
- 1486 2174 1445 2175 1473 2169 1489 2134 1430 2181 1426 2195 1419 2157 1423 2153
- 1463 2138 1454 2181 1582 2133 1407 2193 1419 2181 1429 2156 7906 -2668 1649
- 2073 1363 2173 1315 2146 1508 2143 1488 2178 1382 2165 1684 2068 7901 -2680
- 1566 2161 1406 2142 1502 2133 1545 2126 1834 1972 1635 2118 7906 -2669 1529
- 2173 1448 2191 7896 -2691 1428 2194 1233 2202 1474 2171 1882 1896 1501 2130
- 1522 2135 1314 2152 1339 2149 1350 2173 1518 2180 1439 2148 1381 2148 7907
- -2668 1512 2181 7907 -2667 1510 2141 7905 -2671 1482 2173 1392 2187 1391 2195
- 1454 2162 1404 2147 1554 2114 1577 2107 1284 2147 1760 2017 1430 2159 1465 2171
- 1458 2193 1502 2148 1609 2140 1581 2155 1396 2190 1354 2153 1379 2187 1505 2174
- 1547 2164 1289 2187 1371 2183 1440 2155 2024 1824 1419 2151 1427 2162 1577 2156
- 1396 2193 7906 -2669 1811 1965 1318 2171 1470 2162 1572 2105 1420 2189 1567
- 2133 1472 2141 1383 2168 1316 2152 1725 2013 1567 2135 1385 2187 1463 2194 100
- { m20} R 1492 2180 1363 2175 1338 2190 1442 2162 1219 2165 1455 2159 1640 2102
- 1207 2166 1393 2145 1447 2187 1567 2144 1381 2144 1505 2165 1462 2188 1464 2172
- 1255 2185 1536 2163 1489 2161 1489 2174 7902 -2678 1598 2119 1404 2175 1420
- 2155 1388 2150 1483 2141 1525 2179 1458 2159 1469 2192 1379 2175 1484 2166 7902
- -2679 1424 2184 1278 2188 1473 2148 1488 2189 1474 2154 7907 -2668 1514 2179
- 1487 2177 1428 2164 1268 2197 1345 2149 1606 2140 43 { m20} R 0.58182 0.8 0 c
- 1577 2161 1505 2224 1325 2212 1536 2197 1452 2209 1429 2200 1317 2215 1439 2205
- 1402 2234 1507 2217 1534 2200 1462 2230 1423 2217 1416 2203 1513 2208 1526 2211
- 1503 2209 1523 2211 1466 2200 1490 2224 1486 2206 1329 2231 1499 2212 1436 2205
- 1387 2222 1492 2225 1455 2222 1513 2218 1445 2239 1512 2211 1405 2209 1409 2212
- 1525 2185 1454 2201 1188 2231 1457 2211 1361 2219 1360 2200 1230 2241 1447 2243
- 1542 2181 1578 2170 1494 2237 1519 2213 1551 2187 1461 2236 1463 2197 1441 2226
- 1526 2182 1343 2215 1501 2225 1352 2200 1513 2214 1366 2220 1490 2235 1477 2226
- 1385 2219 1473 2242 1488 2230 1412 2244 1546 2177 1513 2218 1457 2201 1573 2172
- 1564 2174 1355 2241 1235 2239 1376 2234 1469 2239 1457 2234 1445 2225 1425 2218
- 1454 2243 1430 2226 1438 2224 1551 2183 1526 2213 1354 2195 1300 2234 1497 2196
- 1419 2206 1478 2198 1441 2228 1497 2208 1510 2220 1332 2214 1397 2211 1499 2232
- 1550 2186 1486 2212 1424 2212 1431 2203 1469 2218 93 { m20} R 0.72727 0.8 0 c
- 1431 2282 1423 2257 1428 2265 1419 2280 1375 2255 1448 2269 1453 2248 1443 2262
- 1417 2266 1403 2253 1404 2249 1402 2268 1355 2248 1472 2244 1429 2256 1403 2259
- 1397 2281 1480 2243 1319 2249 1369 2286 1439 2257 1447 2248 1363 2262 1360 2278
- 1421 2273 1439 2263 1330 2273 1375 2287 1440 2273 1456 2248 1439 2282 1392 2247
- 1448 2263 1368 2263 1421 2259 1413 2274 1421 2279 1394 2253 1421 2278 1379 2248
- 1368 2271 1376 2275 1387 2244 1447 2259 1445 2283 1388 2273 1402 2250 1410 2254
- 1421 2251 1318 2274 50 { m20} R 0.8 0.72727 0 c 1369 2304 1397 2289 1383 2322
- 1357 2297 1358 2298 1414 2310 1415 2307 1425 2304 1353 2294 1350 2309 1419 2304
- 1414 2293 1435 2296 13 { m20} R 0.8 0.58182 0 c 1368 2335 1377 2334 1341 2337 3
- { m20} R 0.8 0.43636 0 c 1377 2363 m20 0.8 0.29091 0 c 1377 2363 0.8 0.14546 0
- c 1377 2363 0 0 0.8 c 1377 2363 0 0.14545 0.8 c 1377 2363 0 0.29091 0.8 c 1377
- 2363 0 0.43636 0.8 c 7633 -2820 7603 -2859 7431 -2960 7276 -3004 4 { m20} R 0
- 0.58182 0.8 c 7540 -2954 7622 -2891 7629 -2859 6667 -3303 7572 -2940 7196 -3143
- 7616 -2927 7591 -2911 7821 -2664 7553 -2947 7636 -2910 7484 -3001 7053 -3161
- 7687 -2817 7372 -3062 7473 -3005 7706 -2799 7743 -2767 7269 -3103 7504 -3016
- 7493 -2948 7649 -2848 22 { m20} R 0 0.72727 0.8 c 7178 -3300 7696 -2849 7474
- -3060 7672 -2908 7271 -3235 7236 -3234 7704 -2853 7291 -3216 7608 -3021 7728
- -2845 7578 -2998 7799 -2725 7492 -3036 7271 -3174 7739 -2796 7347 -3138 7473
- -3071 7688 -2912 6022 -3490 7271 -3253 7536 -3066 7609 -2948 7676 -2916 7639
- -2951 7404 -3098 7268 -3157 7303 -3227 7452 -3100 7250 -3166 7728 -2845 7657
- -2945 7692 -2882 7416 -3100 7195 -3177 7672 -2930 7709 -2873 7475 -3119 7568
- -2980 7392 -3149 7575 -3052 7109 -3263 7297 -3229 42 { m20} R 0 0.8 0.72727 c
- 7130 -3533 7728 -2854 7655 -3023 7061 -3402 7483 -3275 7772 -2781 7360 -3356
- 7703 -2943 7425 -3211 7747 -2862 7491 -3220 7681 -2988 7307 -3296 7518 -3229
- 7525 -3253 7671 -3012 7068 -3512 7331 -3511 7327 -3361 7616 -3084 7668 -3013
- 7708 -2906 7746 -2863 7590 -3116 6971 -3399 7651 -3017 7671 -2996 7698 -2904
- 7315 -3354 7584 -3070 7641 -3006 7503 -3176 7782 -2772 7653 -2973 7519 -3200
- 7427 -3324 7658 -3011 7675 -2985 7670 -2987 7585 -3051 7614 -3115 7544 -3154
- 7319 -3380 7708 -2925 7693 -2953 7574 -3068 7750 -2856 7629 -3083 7800 -2770
- 7729 -2893 7559 -3160 7705 -2927 7250 -3485 7457 -3281 7301 -3527 7471 -3284
- 7483 -3239 7624 -3087 7626 -3059 7654 -2965 7734 -2854 7278 -3541 7675 -2975
- 7634 -3064 7692 -2931 7624 -3031 7773 -2796 7292 -3524 7567 -3144 7437 -3264
- 7631 -3013 7509 -3179 7622 -3041 7538 -3106 7517 -3135 7567 -3177 7644 -3064
- 7552 -3186 7446 -3304 7603 -3052 7640 -3016 7206 -3536 7748 -2839 7758 -2843
- 7465 -3312 7355 -3476 7595 -3126 7070 -3535 7517 -3180 7659 -3037 7496 -3283
- 7793 -2755 92 { m20} R 0 0.8 0.58182 c 7304 -3874 7793 -2817 864 1064 7804
- -2801 7681 -3061 7562 -3325 7612 -3210 7668 -3084 7527 -3413 7480 -3529 7642
- -3154 7493 -3446 7688 -3012 7537 -3358 7548 -3352 7764 -2885 7508 -3472 7794
- -2794 1128 892 7677 -3008 7544 -3300 7598 -3193 7467 -3424 7479 -3412 7583
- -3281 7483 -3523 7467 -3556 7600 -3245 7408 -3673 7671 -3082 7462 -3543 956
- 1148 7476 -3537 7590 -3193 7693 -3030 7735 -2908 7803 -2766 7431 -3541 7434
- -3411 7567 -3332 7282 -3913 7444 -3476 927 1232 7548 -3369 7729 -2920 1457 1101
- 7526 -3304 7562 -3296 7693 -3009 7343 -3710 7693 -3023 7564 -3316 7717 -2991
- 7540 -3360 7639 -3160 7673 -3056 1099 1210 7858 -2681 7752 -2903 1030 1189 7548
- -3384 7235 -3681 7452 -3513 7646 -3152 7602 -3187 7718 -2984 7545 -3373 7730
- -2951 7543 -3270 7823 -2750 1139 1187 7679 -3043 7481 -3466 7275 -3636 7757
- -2861 7415 -3647 7481 -3519 7695 -2998 7789 -2816 7712 -3001 7545 -3372 7740
- -2937 7689 -3031 7749 -2887 7690 -3028 7424 -3461 7745 -2908 7675 -3089 895
- 1123 7700 -3000 7770 -2833 7696 -2996 7790 -2819 7687 -3032 7675 -3014 1392
- 1074 7597 -3230 7800 -2795 1299 1170 7689 -3017 100 { m20} R 1269 768 7681
- -3008 7650 -3087 7629 -3131 7803 -2797 7198 -3986 7622 -3109 7456 -3544 7430
- -3540 1314 1119 7776 -2858 7497 -3468 7662 -3064 7385 -3657 1210 743 7653 -3050
- 7637 -3149 7737 -2940 7636 -3109 7601 -3246 7454 -3386 7652 -3110 7778 -2837
- 7734 -2907 7463 -3437 1071 835 7586 -3216 7378 -3714 7716 -2951 1292 1178 7710
- -2990 7623 -3147 7592 -3227 7868 -2659 7680 -3020 7686 -2997 7259 -3721 1037
- 1200 7697 -3010 7533 -3338 7733 -2908 7585 -3225 7578 -3271 7712 -2952 7673
- -3087 7755 -2862 7791 -2793 7554 -3345 7679 -3069 7682 -3000 7699 -2983 7526
- -3279 7803 -2801 847 635 54 { m20} R 0 0.8 0.43636 c 7767 -2918 7764 -2911 7814
- -2779 7712 -3018 928 1294 7771 -2887 7670 -3104 1136 1366 7666 -3153 1665 1070
- 7808 -2824 7813 -2792 7758 -2942 905 1421 7791 -2865 970 1332 7777 -2887 7628
- -3212 1057 1414 7675 -3134 7757 -2933 7636 -3214 7743 -2962 7661 -3131 7767
- -2891 7851 -2704 7785 -2876 7767 -2918 1239 1456 7835 -2741 7810 -2797 1030
- 1412 807 1556 1435 1525 7784 -2851 7550 -3387 7669 -3122 7818 -2799 7780 -2861
- 1039 1311 7591 -3299 7814 -2807 7617 -3248 7673 -3131 1098 1443 7683 -3113 973
- 1305 916 1462 7781 -2871 1428 1212 1291 1493 1008 1406 7660 -3144 7751 -2919
- 1260 1467 985 1281 7695 -3073 7670 -3145 1332 1578 1084 1233 7716 -3036 7662
- -3146 1269 1572 7703 -3054 7733 -2989 7793 -2850 7673 -3132 1177 1522 7842
- -2734 7758 -2902 7805 -2830 667 1604 1427 1382 7648 -3181 7651 -3160 1274 1400
- 7816 -2784 7701 -3075 7563 -3360 1484 1230 1187 1480 1154 1399 7766 -2916 1491
- 1423 1023 1522 744 1288 7801 -2835 996 1245 7656 -3152 7729 -2973 505 1538 7684
- -3101 1268 1476 1111 1294 555 1551 1152 1399 1153 1320 7718 -3027 7605 -3272
- 631 1415 100 { m20} R 1202 1482 1177 1372 7592 -3291 1060 1464 7732 -2977 7783
- -2872 7798 -2833 7759 -2937 7816 -2794 7744 -2945 7721 -3019 944 1520 7753
- -2928 7708 -3032 915 1488 732 1605 7709 -3048 7748 -2965 7815 -2806 7827 -2780
- 7772 -2882 7646 -3192 1401 1541 7795 -2833 7717 -3038 7654 -3158 1053 1586 936
- 1516 7731 -2992 7639 -3205 7635 -3195 1117 1355 7631 -3210 941 1532 7783 -2862
- 7754 -2916 7816 -2793 7870 -2675 1152 1562 7665 -3131 806 1445 7844 -2732 7686
- -3099 7727 -3005 1553 1310 7715 -3042 1371 1439 854 1595 7804 -2808 1371 1261
- 7726 -2987 7820 -2791 7753 -2943 694 1510 7686 -3073 7773 -2902 1132 1578 1253
- 1339 7732 -2971 7704 -3062 7700 -3054 7585 -3314 7641 -3203 1274 1508 1120 1591
- 7690 -3102 1161 1495 7654 -3175 7681 -3087 1301 1288 7716 -3042 1312 1580 7593
- -3291 980 1459 1103 1588 7657 -3172 886 1329 926 1506 7742 -2980 7602 -3281
- 7877 -2659 7710 -3047 1220 1483 7577 -3334 7687 -3065 1237 1556 884 1455 1244
- 1526 7737 -2982 1302 1526 7756 -2944 1346 1406 7718 -3010 7579 -3328 7708 -3032
- 7748 -2940 1355 1496 1141 1356 7735 -2958 7706 -3053 100 { m20} R 1277 1537
- 7705 -3047 926 1392 7736 -2997 869 1292 7634 -3195 7673 -3133 1406 1499 7837
- -2752 7657 -3170 7688 -3076 7640 -3178 7698 -3048 1242 1556 1337 1269 7595
- -3283 7807 -2815 7868 -2689 18 { m20} R 0 0.8 0.29091 c 1373 1755 7768 -2943
- 7814 -2829 7676 -3134 1536 1651 1206 1681 1212 1740 1582 1660 7742 -3001 1082
- 1724 1497 1613 7792 -2885 1117 1753 1137 1700 1249 1628 7892 -2650 1103 1664
- 7803 -2862 1083 1792 7793 -2871 1503 1689 1056 1763 7858 -2729 1206 1709 1098
- 1774 7795 -2880 7787 -2893 7785 -2884 7686 -3113 7851 -2742 1170 1685 7833
- -2775 7882 -2675 7828 -2791 952 1749 7826 -2806 7788 -2894 1740 1533 7752 -2977
- 1355 1618 7770 -2933 1431 1626 7785 -2903 7803 -2864 7827 -2790 7843 -2756 894
- 1672 1252 1630 1625 1486 7893 -2651 7799 -2848 7815 -2826 1456 1625 7742 -2987
- 7809 -2829 7875 -2688 7768 -2935 7749 -2980 7811 -2837 7727 -3031 7848 -2754
- 7856 -2717 7728 -3028 7787 -2898 7797 -2872 1443 1611 1246 1743 7758 -2965 1284
- 1596 7774 -2929 7755 -2965 1366 1705 1849 1437 7864 -2720 7781 -2916 7846 -2760
- 1324 1646 1130 1698 995 1633 7827 -2792 7749 -2984 7692 -3099 7767 -2930 7885
- -2655 7743 -2980 7755 -2959 1188 1656 7801 -2862 975 1799 1181 1703 7834 -2790
- 7717 -3044 1544 1663 7795 -2869 1365 1687 7817 -2830 7867 -2703 7747 -2975 1255
- 1722 7752 -2965 100 { m20} R 7681 -3124 7750 -2971 7785 -2889 7860 -2717 1143
- 1707 7723 -3038 970 1647 7793 -2867 7709 -3062 7832 -2784 7808 -2832 7715 -3048
- 1303 1719 1046 1755 1161 1683 7840 -2763 7829 -2803 7860 -2715 1303 1757 1480
- 1705 1181 1757 7890 -2646 7785 -2906 7772 -2932 7763 -2935 7807 -2844 7784
- -2885 1180 1725 7705 -3072 7742 -2998 7753 -2977 1030 1720 1217 1771 1085 1645
- 956 1666 7784 -2897 7838 -2773 7776 -2920 7715 -3047 1425 1627 7798 -2878 7765
- -2939 7784 -2885 7736 -3013 1384 1617 7789 -2897 7792 -2878 7759 -2948 1387
- 1699 1339 1759 7750 -2965 695 1791 7766 -2940 1625 1655 7771 -2934 7802 -2844
- 7817 -2806 1303 1629 1275 1674 7813 -2838 7785 -2904 7768 -2934 7767 -2942 7828
- -2804 1295 1743 7777 -2905 1155 1641 7795 -2870 1288 1708 1005 1673 7720 -3044
- 7706 -3072 7769 -2928 7731 -3013 1307 1706 7801 -2866 1283 1676 1299 1665 944
- 1778 1155 1606 790 1724 1264 1738 7794 -2861 7685 -3116 7837 -2780 1575 1587
- 1597 1607 7779 -2915 1632 1539 1203 1684 7814 -2832 1135 1605 1342 1766 7740
- -3004 1396 1612 7745 -2994 7859 -2730 886 1802 7698 -3089 1407 1654 100 { m20
-} R 1305 1686 1036 1633 840 1756 7773 -2923 7819 -2812 1429 1574 1082 1752 1120
- 1673 1367 1733 1360 1762 7785 -2897 7844 -2749 7795 -2858 1122 1712 1292 1734
- 1263 1648 1422 1688 7772 -2931 7839 -2760 1164 1661 7809 -2830 7680 -3125 1856
- 1457 1267 1712 7750 -2978 7868 -2700 966 1707 7694 -3093 7718 -3045 7765 -2935
- 7881 -2666 7774 -2914 7784 -2902 7790 -2880 1320 1759 7802 -2859 7752 -2979
- 7831 -2785 7785 -2897 1071 1704 802 1639 7790 -2870 7783 -2908 7740 -2989 7821
- -2796 1525 1724 7866 -2712 7765 -2951 7880 -2672 7835 -2787 1349 1760 7746
- -2982 7813 -2839 7812 -2837 1468 1591 7827 -2792 1230 1764 7800 -2863 1377 1622
- 1389 1658 1695 1594 61 { m20} R 0 0.8 0.14545 c 1338 1795 7829 -2815 7824 -2829
- 1389 1872 7802 -2875 1358 1877 916 1882 7786 -2913 7827 -2812 7883 -2688 7801
- -2876 1342 1830 933 1862 1398 1771 7821 -2830 7880 -2690 1433 1808 1243 1799
- 7839 -2788 7788 -2905 1264 1858 7790 -2901 7841 -2782 7868 -2722 7869 -2713
- 7851 -2755 1616 1736 1385 1852 1194 1873 7800 -2879 7828 -2809 1264 1812 7804
- -2865 7868 -2727 7820 -2833 1222 1788 1419 1805 1178 1908 1176 1821 7841 -2783
- 7825 -2821 1296 1863 1607 1682 1369 1871 1258 1873 7771 -2942 -160 1700 7820
- -2834 7829 -2807 7853 -2747 7768 -2948 1190 1872 712 1862 7788 -2907 7828 -2805
- 1376 1807 7853 -2759 7852 -2765 7847 -2774 7828 -2814 1200 1789 1339 1823 1392
- 1884 7839 -2796 1292 1880 1197 1815 7825 -2829 1263 1806 1298 1870 1507 1804
- 7825 -2813 1478 1816 7874 -2711 7819 -2841 7855 -2747 1616 1711 7810 -2857 1359
- 1896 1348 1829 1473 1844 1175 1814 7869 -2726 7834 -2793 7835 -2789 1103 1820
- 7848 -2770 7839 -2793 7820 -2834 7784 -2909 7815 -2837 7846 -2779 1423 1871
- 7870 -2723 1555 1849 7753 -2978 7844 -2768 7829 -2818 1524 1761 1399 1820 7842
- -2782 100 { m20} R 7793 -2895 7838 -2797 1288 1876 1402 1858 7866 -2719 7882
- -2687 7779 -2925 7833 -2807 1374 1778 7864 -2734 7843 -2782 7868 -2730 7828
- -2815 7847 -2779 7789 -2903 7838 -2797 7827 -2820 7889 -2673 7764 -2957 7887
- -2670 1540 1726 7788 -2907 7812 -2856 7815 -2842 1540 1793 1252 1815 7835 -2805
- 1403 1821 7830 -2817 7804 -2870 1255 1829 7802 -2876 7848 -2774 7790 -2903 1291
- 1794 1243 1824 1123 1810 1721 1699 1260 1798 1584 1770 7820 -2826 1368 1871
- 7845 -2773 1379 1847 1380 1889 750 1858 7796 -2892 1426 1893 1211 1854 7795
- -2885 7893 -2667 7816 -2849 1294 1876 1270 1786 1248 1856 1543 1774 1332 1875
- 1262 1898 1038 1825 855 1845 7846 -2780 1125 1913 7798 -2880 7775 -2933 7832
- -2800 7859 -2747 1124 1811 7850 -2760 7883 -2691 1422 1886 1167 1879 7851 -2768
- 1358 1776 951 1851 1413 1811 1412 1807 1111 1906 1309 1849 7845 -2780 7789
- -2906 1077 1837 1198 1897 1291 1892 7832 -2803 7803 -2870 7837 -2796 1299 1874
- 1419 1794 1356 1820 1366 1849 7807 -2857 7866 -2726 7867 -2729 1380 1818 7840
- -2794 1392 1872 801 1822 1369 1786 1459 1824 1541 1843 100 { m20} R 7818 -2841
- 7809 -2856 1138 1901 7863 -2727 7813 -2854 1624 1782 1194 1838 1108 1917 1178
- 1891 1571 1774 1044 1814 1557 1816 916 1859 7886 -2687 1371 1886 7774 -2936
- 7803 -2875 1325 1828 1232 1820 1287 1860 7824 -2830 1201 1807 1262 1846 7792
- -2896 7811 -2860 7819 -2843 1357 1874 1296 1850 1142 1829 1039 1933 7839 -2790
- 7823 -2826 7783 -2916 1290 1822 1657 1710 1193 1896 7876 -2710 7860 -2739 7766
- -2951 7857 -2749 7767 -2949 1652 1659 7821 -2823 7787 -2907 7795 -2891 1603
- 1780 7832 -2807 978 1916 1280 1865 1481 1789 7843 -2781 7807 -2865 7798 -2882
- 7806 -2872 7838 -2798 7809 -2855 7760 -2964 7840 -2792 989 1931 1426 1844 7826
- -2828 1363 1889 7824 -2820 63 { m20} R 0 0.8 0.4069E-06 c 7844 -2793 7899 -2655
- 1335 1928 7840 -2802 7846 -2786 7853 -2774 1454 1895 1619 1833 1398 1919 1583
- 1905 7872 -2728 7901 -2663 7853 -2767 7854 -2767 1257 1957 1580 1938 1254 1911
- 7866 -2739 7879 -2714 1550 1901 7823 -2837 7879 -2705 7823 -2836 1332 1921 7832
- -2819 7880 -2709 1390 1918 7858 -2762 7898 -2660 1536 1927 7829 -2822 1297 1922
- 7878 -2714 1298 1941 1648 1866 7908 -2634 7850 -2774 1379 1930 1356 1913 1044
- 1999 1274 1926 1435 1989 7866 -2738 1349 1933 1389 1912 7818 -2848 1405 1961
- 7908 -2640 1336 1994 7864 -2746 1166 1941 7805 -2873 7817 -2850 7883 -2702 1405
- 1995 7868 -2729 1260 1930 7829 -2823 1346 1977 7804 -2875 1166 1987 7828 -2826
- 1284 1978 7890 -2681 1394 1949 1433 1992 1379 1991 1647 1824 1206 1926 7861
- -2752 7847 -2785 1529 1902 1213 1941 1398 1902 1264 1945 1448 1903 1378 1950
- 1357 1968 7864 -2746 983 1954 1191 1954 1228 1941 1267 1903 1600 1840 1406 1928
- 1353 1920 7904 -2658 1517 1955 7861 -2748 7813 -2858 7826 -2831 1343 1954 1357
- 1954 7896 -2666 1312 1902 7849 -2781 7796 -2891 7908 -2648 1463 1893 7832 -2820
- 100 { m20} R 1378 1959 7906 -2649 7849 -2781 7811 -2861 1364 1924 1451 1987
- 7900 -2659 1567 1896 1208 1965 1471 1971 7885 -2696 1454 1949 7898 -2671 1350
- 1912 1302 1908 7832 -2818 7833 -2815 7842 -2798 1516 1942 7863 -2748 7839 -2804
- 1356 1980 7883 -2694 7852 -2776 1135 1985 1296 1937 7859 -2755 7843 -2793 1369
- 1958 875 1991 1237 1936 7884 -2704 1817 1701 7864 -2751 7880 -2714 7868 -2736
- 1410 1905 7903 -2657 1442 1968 1233 1937 1488 1914 7851 -2777 7842 -2797 1313
- 1994 1151 1924 7882 -2701 7905 -2655 7845 -2792 7816 -2851 7884 -2698 7836
- -2811 1425 1981 1300 1924 1239 1971 1221 1988 7835 -2811 7875 -2726 1291 1938
- 7800 -2885 1359 1938 7846 -2787 7862 -2754 7854 -2771 1823 1695 1194 1952 1477
- 1976 1332 1909 1255 1912 7819 -2843 1242 1969 7885 -2700 1264 1988 7860 -2750
- 1446 1938 7860 -2758 7872 -2730 1219 1925 7820 -2844 1424 1991 7849 -2777 7856
- -2768 1480 1906 1210 1933 7862 -2746 1318 1941 1418 1979 7895 -2668 7850 -2777
- 1330 1942 7822 -2837 7867 -2739 1258 1919 1407 1904 7842 -2796 7893 -2673 1282
- 1950 1336 1930 1153 1943 7880 -2712 1413 1936 100 { m20} R 7845 -2792 1741 1823
- 1599 1913 536 1896 1469 1919 1400 1905 7860 -2758 7837 -2807 1537 1867 1534
- 1862 797 1939 7849 -2777 7826 -2828 1268 1972 1101 2031 7840 -2799 7881 -2710
- 1313 1979 1311 1986 7818 -2847 1109 2023 1389 1992 7887 -2693 7828 -2824 1531
- 1952 1362 1994 7853 -2769 1204 1958 1210 1943 7830 -2822 1535 1903 1208 1951
- 7843 -2795 7835 -2814 1378 1922 7879 -2716 1250 1901 7863 -2749 1563 1880 1344
- 1911 1204 1967 7851 -2780 7874 -2718 43 { m20} R 0.14545 0.8 0 c 1526 2006 1470
- 2041 7902 -2672 7853 -2775 7889 -2700 1486 2043 1565 2027 1582 1977 1321 2029
- 1291 2068 1562 2029 7894 -2683 7888 -2699 1247 2003 1514 1984 1503 2055 7890
- -2695 1310 2072 7853 -2775 1530 1985 7907 -2661 7902 -2664 1298 2007 1297 2059
- 1000 2072 7856 -2771 7861 -2759 7854 -2773 7862 -2756 7882 -2714 7868 -2746
- 1554 2025 1352 2042 1364 2067 7869 -2744 7889 -2695 1437 2033 7895 -2689 1404
- 2020 7897 -2682 1434 2016 7890 -2697 7863 -2755 1182 2047 1177 2062 1276 2010
- 1378 2017 1418 2029 1286 2029 1583 1941 1322 2059 7892 -2687 7849 -2784 1258
- 2026 1494 2040 7890 -2696 7845 -2792 1932 1766 1456 2039 1420 2025 7904 -2665
- 7901 -2671 7901 -2666 7885 -2708 7859 -2765 871 2077 1289 2028 7886 -2708 1390
- 2021 1376 2065 1288 2012 1419 2050 7867 -2748 1400 2027 7851 -2781 7852 -2778
- 1184 2040 1234 2049 1484 2046 7894 -2687 7906 -2662 1663 1937 7886 -2705 1514
- 2032 1366 2073 1463 2027 1314 2072 1317 2016 1640 1984 1313 2070 1448 2009 7867
- -2748 1503 1979 1381 2037 7847 -2788 1388 2024 1404 2027 1447 2025 7900 -2676
- 1539 1972 100 { m20} R 7892 -2694 7854 -2775 1266 2007 7848 -2786 1471 2002
- 1510 1979 7885 -2709 1493 1985 1405 2067 7903 -2668 1444 2067 1263 2005 7901
- -2674 7878 -2724 1580 1989 7891 -2689 1323 2049 7868 -2743 1250 2006 7888 -2696
- 1433 1999 1201 2016 1331 2039 1661 1948 7906 -2661 7894 -2685 1358 2060 1293
- 2004 1291 1998 1350 2072 7879 -2722 7883 -2711 1253 2017 1197 2024 1074 2044
- 1410 2033 1510 2009 1410 2011 7876 -2728 1383 2061 7852 -2777 1527 2048 7899
- -2677 1360 2055 7867 -2749 7861 -2759 7887 -2704 1263 2035 7883 -2714 7893
- -2691 1518 1980 7857 -2769 1515 2041 1611 2010 1234 2020 1347 1999 1531 2005
- 7890 -2698 7903 -2664 7888 -2702 7904 -2662 7851 -2779 7890 -2696 1572 2011
- 1407 2057 1451 2003 1106 2098 1542 2022 7874 -2733 7883 -2715 1175 2044 1401
- 2011 1436 2070 7851 -2780 1272 2031 1331 2068 1341 2038 7891 -2689 7875 -2730
- 892 2057 1488 2006 1382 2066 7894 -2685 7898 -2672 1515 2047 1475 2028 7908
- -2658 7863 -2757 1103 2063 7890 -2698 7862 -2758 7862 -2758 7852 -2778 7852
- -2778 1467 2039 1499 2031 1479 2040 7863 -2756 1448 2066 1198 2016 100 { m20} R
- 1544 2039 1419 2039 7887 -2706 1287 2021 7881 -2714 1167 2082 7875 -2730 7893
- -2689 1447 2007 1437 2012 1556 2006 1292 2065 1165 2020 7890 -2697 7850 -2783
- 1379 2007 1394 2071 7866 -2751 1055 2057 7863 -2755 1393 2025 7876 -2728 1503
- 2016 1432 2058 1466 2017 7870 -2737 1530 2050 1179 2052 1443 2050 1305 2056
- 1512 1987 1408 2012 1482 2057 1280 2049 7865 -2751 1332 2042 1706 1925 1499
- 2043 1301 2061 7864 -2754 1322 2072 2121 1563 7879 -2717 1459 2069 7857 -2768
- 1595 2000 7902 -2662 7877 -2728 7877 -2727 1381 2062 7900 -2667 1298 2029 1582
- 1998 7848 -2787 1371 2035 7843 -2796 7895 -2687 1368 1998 1502 2026 7898 -2678
- 1616 1950 7881 -2717 62 { m20} R 0.29091 0.8 0 c 1302 2117 1544 2087 1469 2080
- 7907 -2662 1381 2087 1232 2127 7904 -2672 1373 2128 1335 2135 7880 -2722 7887
- -2707 1554 2065 1418 2139 1919 1838 7908 -2661 1548 2073 1371 2107 7894 -2691
- 1606 2056 1627 2054 7905 -2670 1539 2065 1559 2058 1435 2088 7881 -2721 1421
- 2082 1482 2132 1567 2100 1489 2078 1140 2125 7901 -2675 1439 2138 1268 2126
- 1129 2169 1231 2085 1150 2117 7904 -2671 1429 2113 1516 2083 7907 -2665 1434
- 2095 7877 -2728 1492 2081 7884 -2715 7872 -2738 1446 2120 7908 -2664 7889 -2703
- 1219 2140 1421 2077 7890 -2701 7878 -2725 1405 2090 1346 2095 7891 -2698 1377
- 2108 7896 -2690 7899 -2684 7890 -2702 1464 2076 7881 -2720 1657 2037 1519 2094
- 1220 2115 7879 -2723 1501 2097 1502 2075 1545 2077 1311 2106 1136 2110 1586
- 2091 1353 2115 1390 2080 1585 2043 1298 2118 1499 2068 1343 2109 1494 2096 1402
- 2081 7904 -2671 1522 2067 1407 2114 7894 -2694 7909 -2662 7896 -2687 7909 -2660
- 1403 2119 1557 2095 1516 2060 1410 2116 7893 -2695 1400 2138 1502 2122 1215
- 2123 7907 -2665 1381 2075 7891 -2699 1508 2107 1284 2098 1267 2138 100 { m20} R
- 7890 -2702 1519 2115 1559 2043 1378 2124 1306 2117 1392 2086 1697 1983 7883
- -2715 1444 2118 1487 2077 1660 2012 7908 -2666 1438 2132 1501 2085 1421 2086
- 1463 2110 1253 2124 1168 2103 1299 2136 7897 -2684 7886 -2708 1508 2082 7904
- -2672 1550 2057 7884 -2714 1675 2030 1680 2030 1525 2082 1514 2082 7880 -2721
- 1013 2126 1465 2120 1473 2072 1396 2121 7884 -2714 1532 2102 1376 2081 7884
- -2713 7897 -2686 1411 2132 1401 2081 1659 2042 1368 2093 7896 -2687 1456 2091
- 1729 1938 1416 2093 1403 2112 1282 2132 1389 2111 7876 -2730 1515 2075 1337
- 2102 1214 2095 1480 2109 1446 2137 1447 2124 1744 1973 1340 2124 7901 -2677
- 1549 2058 1481 2100 1614 2058 7901 -2680 7908 -2664 7894 -2694 7880 -2721 1338
- 2075 7893 -2695 1386 2138 7891 -2699 7906 -2666 1242 2104 7906 -2668 1647 2048
- 1463 2133 7903 -2673 7899 -2682 1360 2116 1599 2086 1445 2121 7904 -2668 1436
- 2111 1565 2084 7899 -2683 1344 2090 7905 -2671 1603 2070 7883 -2717 7875 -2732
- 1651 2004 7882 -2717 92 { m20} R 0.43636 0.8 0 c 1579 2152 1409 2142 7909 -2664
- 1619 2103 1462 2183 1731 2051 1389 2164 1463 2178 1465 2164 1600 2140 1512 2176
- 1405 2172 1607 2110 1338 2169 1385 2189 1440 2160 1380 2191 1550 2171 1500 2178
- 7903 -2675 1478 2136 1378 2176 1345 2175 1431 2175 1599 2095 1560 2112 1531
- 2159 1592 2108 7900 -2681 1527 2178 1546 2162 1653 2114 7906 -2670 1474 2189
- 1310 2182 1511 2162 1311 2170 1431 2169 1536 2150 1583 2102 1424 2177 7906
- -2671 1323 2175 1405 2174 1787 1999 1534 2139 1798 1991 1266 2198 1347 2142
- 7899 -2684 1528 2176 1427 2163 1367 2188 1276 2198 1491 2182 1443 2183 1644
- 2081 1452 2165 1512 2169 1467 2170 1469 2159 1568 2137 1464 2149 1230 2207 1164
- 2197 1329 2164 1221 2186 1610 2102 1379 2184 1432 2151 1421 2167 1242 2154 1366
- 2151 1406 2158 1448 2193 7907 -2667 1658 2083 1355 2158 1423 2162 1744 2029
- 1421 2148 1431 2164 1533 2149 7896 -2690 1406 2177 1520 2153 7906 -2670 1312
- 2152 1553 2148 1735 2035 7909 -2664 1539 2151 1391 2162 1409 2175 1381 2153
- 1378 2177 7901 -2679 1598 2096 1285 2183 1373 2162 100 { m20} R 1317 2145 1532
- 2159 1460 2190 1521 2126 1412 2142 1650 2107 1728 2016 1428 2170 1657 2103 1509
- 2136 7897 -2689 1247 2176 1415 2155 1770 1997 1596 2143 1578 2123 1278 2170
- 1289 2167 1504 2166 1406 2152 1584 2148 1506 2138 1610 2100 1263 2144 1550 2148
- 1506 2173 1352 2180 1765 1987 1427 2150 1256 2189 1788 1983 1349 2144 1637 2073
- 1664 2078 1424 2142 1337 2179 1483 2180 1526 2175 1371 2153 1525 2149 1446 2188
- 1665 2081 1583 2130 43 { m20} R 0.58182 0.8 0 c 1268 2203 1466 2214 1312 2218
- 1467 2220 1470 2231 1415 2242 1536 2193 1362 2196 1417 2233 1490 2234 1323 2229
- 1497 2197 1464 2242 1526 2196 1420 2210 1383 2232 1438 2231 1474 2224 1489 2205
- 1384 2217 1507 2228 1471 2229 1487 2224 1432 2206 1461 2234 1461 2229 1474 2236
- 1526 2204 1342 2212 1371 2219 1382 2242 1433 2198 1388 2224 1446 2209 1492 2213
- 1549 2179 1591 2160 1458 2226 1554 2178 1444 2233 1464 2241 1447 2226 1448 2216
- 1402 2239 1463 2198 1306 2230 1519 2192 1531 2189 1442 2235 1260 2217 1370 2231
- 1552 2179 1320 2211 1438 2224 1305 2209 1383 2214 1455 2225 1536 2182 1391 2226
- 1332 2240 1417 2230 1288 2226 1463 2230 1471 2221 1425 2222 1291 2201 1394 2216
- 1528 2194 1516 2188 1469 2234 1347 2202 1350 2203 1263 2230 1481 2193 1249 2210
- 1392 2223 1420 2197 1411 2217 1419 2199 1417 2209 1331 2199 1453 2234 1483 2220
- 1130 2281 1367 2197 1364 2237 1289 2208 1420 2236 1460 2203 89 { m20} R 0.72727
- 0.8 0 c 1382 2257 1385 2255 1453 2273 1362 2267 1439 2251 1418 2274 1429 2276
- 1425 2278 1427 2256 1433 2246 1382 2244 1347 2260 1428 2267 1326 2251 1439 2263
- 1388 2281 1392 2255 1425 2272 1475 2249 1428 2276 1406 2269 1380 2262 1453 2276
- 1410 2287 1442 2258 1320 2265 1343 2286 1456 2268 1455 2249 1424 2271 1409 2272
- 1439 2246 1313 2245 1406 2286 34 { m20} R 0.8 0.72727 0 c 1360 2310 1415 2300
- 1341 2325 1420 2311 1407 2298 1362 2298 1326 2297 1332 2327 1301 2313 1420 2300
- 1415 2293 1410 2325 1363 2303 1414 2292 1343 2319 1419 2312 1400 2314 1381 2316
- 1371 2325 1416 2300 1367 2303 1371 2313 1344 2320 1420 2293 1345 2288 25 { m20
-} R 0.8 0.58182 0 c 1385 2361 1362 2346 1357 2358 1346 2334 4 { m20} R 0.8
- 0.43636 0 c 1385 2361 0.8 0.29091 0 c 1385 2361 0.8 0.14546 0 c 1385 2361 0 0
- 0.8 c 1385 2361 0 0.14545 0.8 c 1385 2361 0 0.29091 0.8 c 1385 2361 0 0.43636
- 0.8 c 7423 -2972 7477 -2953 7486 -2919 7631 -2822 4 { m20} R 0 0.58182 0.8 c
- 7444 -3040 7467 -2986 7539 -2927 7600 -2912 7631 -2894 7515 -2961 7626 -2887
- 7643 -2886 7436 -3017 6995 -3192 7670 -2874 7638 -2859 7679 -2860 7536 -2978
- 7584 -2938 7637 -2872 7370 -3081 7487 -3024 7487 -3034 7505 -3019 7518 -2959
- 6566 -3326 22 { m20} R 0 0.72727 0.8 c 7636 -2986 7453 -3057 7545 -3031 7619
- -2990 7740 -2826 6965 -3265 7678 -2881 7703 -2862 7513 -3096 7374 -3208 7520
- -3098 7680 -2895 7330 -3251 7162 -3198 7403 -3159 7722 -2855 7643 -2974 7525
- -3087 7477 -3076 7392 -3160 7583 -2972 7666 -2942 7582 -3003 7416 -3090 7312
- -3254 7626 -2925 7298 -3254 7557 -3050 7706 -2882 7619 -2935 7613 -2968 7681
- -2913 7784 -2738 7527 -3066 7598 -3034 7322 -3260 7514 -3038 7414 -3156 7460
- -3103 7505 -3107 40 { m20} R 0 0.8 0.72727 c 7578 -3175 7693 -2961 7653 -3029
- 6920 -3705 7456 -3333 7751 -2864 7585 -3134 7646 -2999 7538 -3177 7756 -2823
- 7409 -3298 7750 -2840 7612 -3079 7723 -2915 7718 -2890 7469 -3323 7708 -2944
- 7341 -3442 7399 -3224 7802 -2755 7698 -2958 7528 -3213 7563 -3130 7461 -3236
- 7724 -2902 7729 -2902 7807 -2752 7590 -3113 7650 -3019 7484 -3213 7605 -3043
- 7222 -3504 7246 -3590 7361 -3316 7716 -2922 7589 -3132 7224 -3431 7491 -3286
- 7430 -3201 7798 -2763 7604 -3029 7566 -3124 7435 -3318 7329 -3401 7379 -3243
- 7599 -3142 7676 -2950 7449 -3252 7293 -3413 7524 -3269 7829 -2686 7556 -3084
- 7364 -3431 7308 -3433 7263 -3336 7624 -3078 7769 -2805 7668 -2999 7710 -2938
- 7667 -2976 7484 -3177 7591 -3092 7702 -2953 7600 -3127 7392 -3226 7489 -3285
- 7765 -2827 7695 -2904 7344 -3314 7722 -2886 7394 -3447 7590 -3128 7360 -3441
- 7585 -3096 7495 -3283 7715 -2924 7504 -3267 7599 -3091 7711 -2932 7457 -3240
- 7264 -3328 7347 -3385 7753 -2853 7452 -3267 7436 -3204 7700 -2917 7633 -3035
- 7592 -3108 7728 -2861 7583 -3142 7331 -3335 7030 -3623 7579 -3153 7769 -2817
- 7514 -3251 7530 -3233 7397 -3273 7622 -3082 7648 -3039 6830 -3432 100 { m20} R
- 7577 -3069 7684 -2961 7356 -3292 7647 -3021 7717 -2915 5 { m20} R 0 0.8 0.58182
- c 7509 -3316 1183 1100 7752 -2892 7623 -3146 7597 -3245 7650 -3101 7692 -3009
- 7559 -3242 7757 -2895 7730 -2955 7237 -3642 7646 -3137 7692 -3045 7662 -3060
- 7757 -2855 7713 -2951 7612 -3205 7558 -3359 7749 -2899 7484 -3478 7725 -2960
- 7598 -3255 6992 -3884 7752 -2887 7759 -2872 1571 513 7719 -2927 7326 -3566 7604
- -3163 7334 -3824 7796 -2816 7624 -3181 7751 -2867 7622 -3148 7572 -3320 7625
- -3191 7538 -3326 7724 -2969 1081 1172 7658 -3077 7632 -3087 7522 -3409 1086
- 1128 7789 -2808 7509 -3449 7459 -3436 7592 -3263 7483 -3515 7668 -3028 7151
- -3821 7707 -2962 7599 -3164 7636 -3136 7748 -2921 7807 -2788 7608 -3245 1327
- 1196 7678 -3018 7461 -3564 7611 -3198 7618 -3211 7605 -3209 7734 -2919 7733
- -2917 7689 -2996 7598 -3174 7625 -3175 7651 -3088 7461 -3389 7882 -2632 7641
- -3162 7708 -2965 920 1198 7810 -2764 7715 -2957 7441 -3598 7803 -2801 7786
- -2834 908 1088 7586 -3289 7795 -2811 7572 -3308 7633 -3142 7623 -3140 7735
- -2946 7578 -3261 914 1210 7366 -3675 7402 -3687 7647 -3122 7681 -3075 7645
- -3074 7622 -3165 7478 -3535 882 1252 7808 -2760 7822 -2735 7531 -3398 7738
- -2933 7756 -2881 100 { m20} R 7672 -3052 7751 -2887 7470 -3515 7582 -3284 7616
- -3227 7709 -3007 7805 -2767 7799 -2804 7657 -3103 7541 -3333 7601 -3221 7594
- -3244 7686 -3018 7795 -2783 7553 -3351 7762 -2889 7718 -2955 7689 -3030 7686
- -3026 7764 -2867 7436 -3582 7583 -3185 7575 -3239 839 1251 7513 -3440 7706
- -2998 1179 1083 7526 -3303 7716 -2989 7678 -3012 7768 -2875 7560 -3356 7569
- -3308 7535 -3301 7682 -3060 7554 -3237 7802 -2770 7600 -3168 7503 -3451 7442
- -3459 7740 -2902 7699 -3005 7478 -3464 7676 -3049 7532 -3273 1167 1146 7468
- -3549 7623 -3194 7672 -3037 7703 -2996 901 1064 7220 -3767 7513 -3461 7478
- -3531 1256 1113 7898 -2584 7414 -3663 7607 -3244 7608 -3192 7768 -2839 7631
- -3182 61 { m20} R 0 0.8 0.43636 c 740 1542 7723 -3021 1077 1444 7824 -2780 1215
- 1510 7791 -2852 7634 -3218 1310 1578 7694 -3078 1060 1404 1140 1471 767 1601
- 7799 -2820 7747 -2969 7642 -3194 376 1340 1348 1528 7638 -3211 7696 -3043 7808
- -2793 7726 -3011 7732 -2998 1426 1451 7722 -2993 7706 -3062 7809 -2806 1374
- 1231 1251 1578 635 1485 899 1418 7746 -2970 7771 -2904 7776 -2900 1613 1434
- 1269 1423 7611 -3264 7639 -3184 7586 -3309 7730 -2993 1145 1510 1349 1536 1097
- 1483 7739 -2981 972 1457 7812 -2801 7778 -2895 7773 -2896 7697 -3063 7827 -2776
- 7770 -2888 1151 1474 7834 -2738 7684 -3116 7672 -3138 1099 1600 7755 -2925 7786
- -2864 7696 -3046 1406 1519 7764 -2918 7669 -3104 1121 1541 7820 -2785 7655
- -3169 1020 1504 7679 -3091 7743 -2975 7649 -3157 1213 1286 7808 -2810 1487 1286
- 7794 -2829 1335 1493 7769 -2897 7741 -2981 1090 1526 7743 -2939 7839 -2746 7806
- -2824 7753 -2939 1220 1347 1043 1357 1093 1423 1070 1577 7742 -2938 7690 -3090
- 7804 -2828 1059 1310 1067 1522 602 1410 1244 1527 7772 -2889 7708 -3056 914
- 1610 7865 -2675 7744 -2960 1267 1350 7835 -2741 7701 -3062 1243 1523 100 { m20
-} R 7824 -2770 593 1470 7727 -3014 7752 -2936 1158 1544 7823 -2788 1192 1558
- 7711 -3039 7788 -2841 7718 -2999 1297 1561 7654 -3155 7702 -3063 1385 1275 7839
- -2751 7702 -3067 7613 -3259 7712 -3049 7736 -2989 7628 -3221 1200 1279 7707
- -3042 7774 -2870 7743 -2946 1120 1486 7734 -2967 870 1594 7725 -3013 7683 -3092
- 7817 -2801 7728 -3006 7814 -2796 7760 -2917 7739 -2960 7783 -2857 7770 -2889
- 1026 1399 1234 1417 7719 -3031 7692 -3085 889 1449 1160 1323 967 1419 7798
- -2836 7785 -2870 7794 -2836 7789 -2846 7676 -3120 7646 -3161 597 1438 1255 1511
- 1511 1448 859 1565 7735 -2973 1718 1103 7663 -3130 7670 -3104 1379 1578 7615
- -3249 7754 -2912 7689 -3068 7744 -2975 1276 1393 7734 -2976 7645 -3193 7607
- -3272 7714 -3039 7781 -2876 7775 -2902 7659 -3142 1409 1534 7789 -2839 7607
- -3260 7704 -3067 7756 -2924 7623 -3235 7545 -3395 1142 1445 1265 1573 1017 1583
- 1311 1526 7765 -2911 7771 -2895 7804 -2817 1285 1264 1218 1500 7760 -2935 7849
- -2724 7764 -2925 1242 1536 7697 -3083 7838 -2734 1176 1547 7748 -2962 7557
- -3373 7822 -2782 7793 -2860 7721 -3008 7694 -3093 7752 -2927 100 { m20} R 7619
- -3234 7579 -3318 7673 -3129 1327 1350 1311 1235 7742 -2981 6 { m20} R 0 0.8
- 0.29091 c 7785 -2896 7824 -2805 1262 1688 7822 -2807 1205 1746 1322 1749 7787
- -2892 7866 -2694 7830 -2779 7730 -3023 7798 -2876 1045 1685 894 1781 1106 1787
- 7722 -3041 892 1750 1345 1741 7798 -2876 7800 -2869 7822 -2806 7822 -2817 7805
- -2843 7732 -3008 7874 -2694 1622 1659 979 1708 935 1802 7820 -2824 7800 -2870
- 1404 1729 7843 -2751 1304 1717 1132 1708 7819 -2823 1416 1592 1131 1645 980
- 1755 7830 -2788 1274 1700 7869 -2705 736 1731 7856 -2722 7807 -2844 1215 1605
- 7712 -3061 1058 1716 7787 -2889 7802 -2854 1457 1592 1370 1740 7773 -2932 7842
- -2761 7760 -2948 1493 1733 7819 -2807 7763 -2935 7830 -2775 974 1628 7829 -2779
- 1103 1635 7820 -2807 1264 1703 7714 -3056 1161 1710 7848 -2744 7812 -2820 7709
- -3064 7745 -2992 7847 -2756 7856 -2734 7800 -2857 1260 1626 1231 1671 1387 1694
- 7768 -2931 1339 1702 1291 1682 1457 1736 7814 -2836 706 1744 1207 1774 7790
- -2893 7716 -3050 1508 1681 7825 -2811 7829 -2800 1271 1720 7818 -2819 7768
- -2926 7790 -2889 1158 1779 1305 1751 7838 -2767 935 1735 1301 1640 7805 -2860
- 1450 1636 1076 1761 7718 -3046 1093 1646 100 { m20} R 7801 -2862 1224 1634 7818
- -2822 1130 1615 7725 -3031 7828 -2794 1248 1717 7754 -2976 1625 1655 7714 -3057
- 7782 -2908 1349 1754 7792 -2865 7812 -2825 1175 1603 7753 -2973 1457 1719 1290
- 1749 7860 -2718 7809 -2827 7715 -3049 7719 -3047 1487 1648 1341 1653 7749 -2971
- 7772 -2935 1308 1757 1525 1556 1196 1678 7785 -2887 7773 -2926 7772 -2930 921
- 1756 7799 -2874 7802 -2863 7794 -2880 1584 1552 1259 1701 1351 1628 1254 1713
- 7768 -2941 7779 -2903 1207 1758 1436 1582 1421 1596 1176 1652 7768 -2930 1641
- 1558 7717 -3050 1030 1659 7707 -3069 7682 -3123 7731 -3019 7812 -2833 7817
- -2825 7691 -3104 7825 -2803 7893 -2641 7766 -2941 7719 -3046 7746 -2983 1361
- 1765 1112 1757 1127 1675 7763 -2956 880 1722 7717 -3051 7757 -2963 7790 -2886
- 7741 -3000 7829 -2778 7770 -2935 1231 1750 7838 -2765 7716 -3050 7863 -2714 919
- 1706 7741 -3000 7703 -3078 7720 -3043 7814 -2818 7848 -2744 7881 -2679 1288
- 1742 7804 -2845 1118 1684 7836 -2778 1059 1624 7817 -2822 7753 -2970 7740 -2995
- 1388 1654 7847 -2755 706 1725 7752 -2977 981 1639 7887 -2646 1114 1664 1541
- 1527 1467 1698 100 { m20} R 1068 1791 7740 -2997 1510 1674 1007 1773 7826 -2806
- 7746 -2991 7770 -2925 1534 1621 7741 -2989 7808 -2830 7769 -2931 7760 -2954
- 7743 -2993 7874 -2674 1137 1782 15 { m20} R 0 0.8 0.14545 c 1431 1802 1152 1862
- 7793 -2890 7793 -2890 1264 1832 1262 1803 1120 1844 7844 -2780 1433 1806 1196
- 1852 1378 1837 1219 1870 7871 -2712 1305 1792 7790 -2904 7882 -2680 7848 -2774
- 1295 1880 1123 1843 7811 -2854 7825 -2818 857 1841 1537 1821 1520 1761 971 1916
- 7768 -2948 7903 -2636 1436 1764 929 1897 1230 1792 1293 1889 1241 1840 7806
- -2861 1309 1820 1385 1872 1235 1777 7835 -2788 7885 -2677 1344 1799 1219 1780
- 7808 -2864 7869 -2720 1434 1817 7766 -2952 7895 -2655 7865 -2731 1292 1804 7786
- -2910 7820 -2834 7862 -2736 1219 1827 7862 -2728 7762 -2959 7825 -2814 7801
- -2873 7811 -2853 7883 -2691 7759 -2966 1261 1882 1276 1821 7777 -2931 1214 1898
- 7855 -2749 1829 1657 1280 1776 7886 -2677 1376 1840 1347 1857 7898 -2658 7810
- -2859 7749 -2987 1490 1815 7813 -2852 7793 -2890 1354 1803 7857 -2743 7831
- -2804 7812 -2854 7841 -2783 7823 -2829 1464 1811 7847 -2771 1152 1819 7819
- -2836 1676 1742 1228 1812 7849 -2771 7828 -2807 1352 1840 1201 1814 7779 -2926
- 1358 1888 1171 1845 950 1927 7839 -2797 1052 1856 7809 -2862 7848 -2774 7824
- -2825 7905 -2627 100 { m20} R 1379 1859 7825 -2820 7880 -2700 1200 1859 7751
- -2982 1031 1913 7809 -2854 7851 -2757 1350 1808 7822 -2835 899 1920 1338 1837
- 7816 -2836 7850 -2763 7852 -2759 7833 -2810 7816 -2841 7821 -2836 1120 1879
- 7829 -2815 7762 -2958 1202 1905 1374 1777 1449 1768 7848 -2762 7795 -2894 1237
- 1804 1316 1833 7892 -2665 7796 -2889 262 1806 1182 1882 1247 1848 7845 -2781
- 1290 1883 1141 1850 1241 1850 7782 -2918 7896 -2653 1412 1812 7878 -2703 7794
- -2895 1343 1872 1399 1894 1385 1787 1594 1728 1780 1698 7898 -2650 7839 -2780
- 1433 1789 979 1927 7806 -2862 7769 -2947 7773 -2937 1170 1781 7905 -2637 7763
- -2959 7777 -2930 7798 -2887 735 1817 7804 -2873 1119 1862 1151 1913 7828 -2820
- 7831 -2813 1455 1882 7848 -2776 7806 -2869 1193 1837 7773 -2937 7885 -2688 7799
- -2886 7803 -2875 1677 1700 1683 1699 1367 1850 1098 1903 7846 -2773 7860 -2740
- 1082 1853 1519 1809 7863 -2735 1468 1787 7836 -2787 1242 1887 7793 -2892 1079
- 1867 1027 1940 7894 -2665 7769 -2945 1039 1836 7863 -2722 7882 -2680 1651 1787
- 7808 -2862 7872 -2718 1103 1866 1463 1765 1557 1801 7881 -2693 100 { m20} R
- 7798 -2880 7866 -2732 1601 1730 1471 1756 1386 1881 7760 -2964 7797 -2890 1041
- 1842 7901 -2635 1081 1881 1407 1895 963 1906 7783 -2918 1179 1793 1112 1864
- 7829 -2820 1032 1897 7805 -2860 7776 -2930 7854 -2759 7853 -2761 7896 -2656
- 1153 1790 7843 -2770 1351 1894 7805 -2871 1530 1819 802 1849 1151 1855 1033
- 1890 7884 -2676 7818 -2842 7903 -2642 7850 -2753 1156 1866 7806 -2863 1250 1817
- 1022 1839 1107 1827 1394 1814 7846 -2772 1252 1849 7794 -2896 956 1936 7843
- -2777 7849 -2770 7839 -2793 1292 1808 7818 -2842 7826 -2827 1372 1852 1535 1768
- 7789 -2905 7903 -2642 7837 -2790 1149 1815 1393 1884 1092 1815 1168 1812 1241
- 1889 7864 -2739 7817 -2844 1069 1852 7854 -2762 1317 1862 65 { m20} R 0 0.8
- 0.4069E-06 c 7906 -2648 7845 -2791 7861 -2753 1369 1911 1573 1897 7865 -2747
- 7837 -2807 7814 -2856 1147 1938 7899 -2664 1240 1983 1251 1903 7820 -2842 1515
- 1933 7902 -2659 7869 -2738 7817 -2848 7838 -2806 7888 -2688 7854 -2767 1303
- 1931 7888 -2694 1212 1929 7878 -2718 1623 1842 7837 -2810 1323 1910 1339 1907
- 7881 -2701 1413 1957 1335 1977 1506 1945 1400 1976 7836 -2810 1504 1886 1365
- 1923 7862 -2753 7811 -2860 7873 -2727 7872 -2721 7834 -2813 7833 -2816 1923
- 1680 1551 1930 1446 1929 1272 1965 1255 1901 1437 1923 7868 -2740 7823 -2836
- 7877 -2713 7861 -2748 7831 -2820 1277 1955 1431 1913 1648 1893 7833 -2814 1551
- 1914 7900 -2667 7859 -2753 1585 1912 1129 1991 7864 -2745 7845 -2791 7871 -2731
- 1154 1928 1419 1989 1328 1963 1198 1947 7876 -2722 7841 -2800 7891 -2679 7893
- -2675 7881 -2707 1380 1978 1024 1971 1466 1917 1507 1904 7856 -2769 1379 1927
- 7902 -2658 1342 1960 1225 1963 7837 -2805 1512 1953 1390 1989 7855 -2767 7896
- -2671 1511 1968 1299 1995 1299 1943 1386 1982 1415 1920 7846 -2789 1524 1937
- 1598 1902 1272 1957 1963 1569 1226 1922 1309 1899 100 { m20} R 1393 1960 7820
- -2843 7862 -2748 641 1951 7893 -2679 1295 1941 1615 1908 1690 1821 1317 1992
- 1415 1984 7892 -2684 1362 1936 1208 1952 1226 1906 7853 -2775 1321 1939 7829
- -2824 7832 -2815 7900 -2655 7873 -2721 1257 1914 1485 1930 1448 1935 1469 1964
- 7886 -2697 7868 -2738 7897 -2668 1404 1943 7879 -2713 1406 1983 1417 1911 7810
- -2862 1488 1918 7875 -2722 1199 1923 1619 1914 7870 -2735 1253 1994 1106 2004
- 1081 1956 1263 1916 1525 1931 7818 -2847 1248 1993 7866 -2741 7832 -2816 1293
- 1909 7882 -2698 1426 1975 7854 -2772 1108 2015 7845 -2787 7861 -2758 1568 1923
- 7850 -2777 1007 2033 1331 1938 7876 -2717 1136 1926 1177 1990 1151 1993 1389
- 1997 7862 -2746 7882 -2697 1109 1966 7836 -2809 1225 1945 1375 1985 7871 -2726
- 7824 -2834 7807 -2869 1511 1898 7900 -2660 7893 -2681 7826 -2831 7848 -2777
- 1730 1747 1497 1950 1113 1974 1889 1683 7826 -2831 7868 -2740 7860 -2754 7876
- -2721 1205 1935 1080 1983 7837 -2805 1249 1991 1430 1981 7884 -2704 7900 -2666
- 7858 -2765 7859 -2760 1176 1928 1222 1969 7839 -2802 1281 1977 1200 1944 1261
- 1980 7836 -2805 100 { m20} R 7835 -2812 1268 1972 1687 1803 1393 1949 7885
- -2692 7819 -2846 1544 1866 1727 1793 1520 1968 7862 -2745 890 2028 7839 -2804
- 1530 1963 7902 -2658 1552 1890 1442 1909 1273 1920 833 1961 7838 -2804 1299
- 1931 1322 1923 1236 1946 7831 -2817 1333 1936 7882 -2701 7881 -2700 7847 -2782
- 1212 1999 7867 -2742 1555 1872 997 2010 7879 -2708 1230 1958 7851 -2775 7827
- -2827 7846 -2788 7828 -2827 7823 -2837 7864 -2745 7846 -2789 1760 1776 1517
- 1958 1285 1964 1235 1956 1316 1968 1288 1939 7880 -2706 1229 1928 1247 1999
- 7834 -2813 7844 -2787 1098 2018 1441 1950 1552 1939 1382 1952 1022 2034 1334
- 1965 7836 -2810 7852 -2771 1212 1960 60 { m20} R 0.14545 0.8 0 c 7888 -2699
- 1458 2018 1837 1853 7888 -2703 1606 1930 7866 -2748 7872 -2737 1618 1990 1708
- 1941 1282 2046 1284 2011 1335 2018 7870 -2741 1314 2001 7906 -2659 1785 1857
- 1348 2059 7904 -2662 7872 -2736 1339 2022 7874 -2732 7897 -2679 1452 2014 7851
- -2781 1406 2025 7905 -2662 7846 -2792 7868 -2743 1487 1986 7864 -2754 1142 2029
- 7874 -2735 1377 2035 1300 2071 7894 -2682 7866 -2746 7901 -2672 1279 2007 7904
- -2662 7906 -2654 7893 -2691 1334 2065 7866 -2751 1422 2068 1159 2053 7899 -2675
- 1565 1999 950 2107 1317 2007 1189 2047 1767 1850 1518 1990 7871 -2739 1301 2033
- 7861 -2761 7890 -2699 7867 -2749 1423 2040 1350 2043 1489 2039 1309 2059 7891
- -2690 7883 -2707 1203 2030 7874 -2734 1271 2010 1378 2055 1237 2023 1531 2029
- 7872 -2735 1205 2070 1409 2008 7850 -2783 7865 -2751 7898 -2673 7903 -2669 1593
- 2019 1224 2023 1380 2003 1471 2048 7840 -2803 1375 2066 1408 2050 1336 2032
- 1410 2073 7861 -2760 7896 -2677 7862 -2759 858 2099 7888 -2696 7840 -2803 1138
- 2056 7908 -2653 1238 2010 1237 2009 7893 -2693 1342 2059 7889 -2695 1513 1980
- 1381 2002 100 { m20} R 998 2054 1216 2009 1353 2073 7887 -2706 1293 2065 1479
- 2051 7855 -2772 7869 -2743 1376 2049 1286 1996 1491 2027 7880 -2720 7842 -2800
- 7849 -2785 1388 2025 1188 2071 1477 2050 1472 2045 1292 2005 7848 -2786 7863
- -2756 7905 -2665 1369 2015 7877 -2726 1444 2038 1488 2023 7907 -2659 980 2091
- 7871 -2739 1274 2062 1463 2036 7895 -2688 7893 -2693 1433 2067 7863 -2757 7874
- -2733 1432 2033 1336 2003 1342 2026 1628 1944 7902 -2668 7891 -2693 1338 2041
- 1128 2038 7874 -2734 1660 1976 1362 2047 7870 -2739 1562 2003 7906 -2660 1402
- 2060 7865 -2748 7869 -2744 1388 2059 7886 -2704 1373 2049 1494 2050 1165 2045
- 7876 -2729 7874 -2731 7860 -2761 1261 2023 1437 2055 7852 -2777 7888 -2703 7865
- -2751 1660 1946 1499 2025 1458 2050 1308 2037 1278 2040 7862 -2758 7886 -2704
- 7887 -2702 1488 2034 7904 -2668 7854 -2774 7888 -2699 1291 2017 1448 1995 1312
- 2049 1303 2048 7844 -2794 1346 2048 7894 -2685 1295 1995 1336 2019 1281 2040
- 1418 2012 1461 2030 7895 -2683 1281 2056 1423 2061 7868 -2746 1512 2011 1357
- 2025 7885 -2709 1468 2017 7868 -2746 7896 -2685 100 { m20} R 7866 -2747 7899
- -2674 1424 2009 1261 2038 1413 2056 7892 -2688 1388 2028 7866 -2750 1444 2029
- 1435 2011 7886 -2705 7894 -2682 7868 -2744 1410 2013 1309 2056 1351 2034 1615
- 1925 1380 2043 7890 -2697 1386 2014 7903 -2667 7877 -2724 1437 2027 1509 2032
- 1398 2018 1210 2018 1426 2058 7904 -2665 1481 1992 7853 -2775 1429 2020 1320
- 2036 7877 -2725 7868 -2747 7891 -2694 1577 1995 36 { m20} R 0.29091 0.8 0 c
- 1491 2122 1319 2082 1379 2100 7877 -2728 7904 -2673 7900 -2681 7908 -2664 1433
- 2138 1581 2062 1306 2088 1485 2127 7890 -2702 1505 2063 1464 2086 1222 2145
- 1299 2106 1667 2004 1385 2127 1414 2091 1373 2095 1275 2083 7895 -2692 1531
- 2087 7888 -2706 1212 2112 1510 2111 7908 -2663 1484 2109 1285 2095 1286 2113
- 1329 2100 1221 2103 7896 -2690 7884 -2715 7894 -2692 1334 2136 1605 2070 1244
- 2130 7871 -2741 1239 2137 7907 -2663 1375 2119 1611 2034 7894 -2690 7882 -2718
- 1429 2082 1401 2129 1653 2051 1329 2128 1239 2101 7892 -2697 1785 1960 7889
- -2702 1541 2108 1239 2101 1528 2098 7899 -2683 1325 2089 7888 -2706 1315 2084
- 1533 2097 7886 -2709 7886 -2711 7904 -2668 1393 2096 1252 2088 7896 -2688 7890
- -2702 1308 2120 7903 -2675 7894 -2691 1430 2126 7901 -2678 1542 2079 1248 2133
- 1516 2094 1308 2096 1506 2100 7879 -2724 7886 -2709 1244 2101 1354 2097 1309
- 2119 1558 2081 1407 2090 1345 2077 7888 -2705 1404 2090 7896 -2689 1517 2062
- 1655 2054 7908 -2664 1525 2105 1432 2118 1320 2121 1340 2108 1365 2131 1177
- 2103 1514 2082 7904 -2669 100 { m20} R 1541 2104 7897 -2684 1621 2036 7897
- -2688 7898 -2685 7898 -2684 7898 -2684 1599 2028 1361 2128 1323 2082 1378 2130
- 1272 2083 7907 -2663 1498 2090 1433 2093 1453 2115 1481 2109 1299 2117 7892
- -2695 1479 2084 1171 2146 7906 -2667 7894 -2692 1429 2134 7893 -2696 7885 -2712
- 1331 2137 1285 2123 1461 2132 7906 -2663 1316 2094 1487 2075 1402 2115 7906
- -2668 1443 2115 1582 2069 7892 -2696 1312 2104 7890 -2702 1386 2129 7894 -2694
- 1636 1998 7896 -2687 7908 -2664 1528 2069 1420 2098 7882 -2718 1472 2117 1363
- 2132 1437 2088 778 2146 1437 2081 7889 -2702 1232 2114 1420 2123 1587 2083 7883
- -2717 1306 2104 1520 2065 1469 2090 7884 -2713 1460 2076 1244 2101 1533 2115
- 7883 -2717 1445 2100 1634 2048 1133 2145 1555 2056 7899 -2681 1459 2097 7877
- -2728 7905 -2667 7880 -2721 1376 2112 1434 2087 7884 -2714 7870 -2742 1406 2088
- 1596 2062 7878 -2726 1474 2083 1520 2109 1475 2131 1473 2132 1422 2089 1473
- 2086 1433 2082 7893 -2696 7904 -2674 1337 2120 7896 -2687 7891 -2699 1707 2012
- 1250 2105 1517 2112 1330 2134 1548 2069 1466 2110 7884 -2713 100 { m20} R 7890
- -2701 1512 2085 1328 2135 7897 -2686 7874 -2734 1577 2061 1685 2000 7909 -2661
- 7873 -2736 7909 -2658 7890 -2700 7883 -2717 7889 -2703 1368 2094 1565 2092 1447
- 2100 1379 2100 1427 2123 1479 2121 1615 2078 1445 2125 1860 1871 7895 -2691
- 1409 2132 1349 2132 25 { m20} R 0.43636 0.8 0 c 1425 2154 1592 2142 1815 1969
- 1233 2206 1688 2086 1357 2140 1360 2162 1470 2166 1557 2121 7903 -2675 1568
- 2134 1392 2184 1508 2173 1355 2149 1331 2162 1453 2189 1363 2165 1484 2188 1228
- 2170 1360 2142 1512 2131 1463 2192 1366 2139 1459 2185 1413 2189 1236 2190 1472
- 2164 1527 2131 1425 2180 1417 2148 1535 2158 1303 2145 1555 2116 1166 2169 1417
- 2147 1332 2143 1458 2149 1305 2191 1390 2167 1416 2148 1541 2168 1442 2192 1517
- 2166 1276 2144 1270 2142 1460 2188 1379 2152 1419 2168 1575 2157 1965 1872 1404
- 2188 1319 2152 1540 2151 1467 2166 1405 2188 1423 2160 1440 2140 1509 2147 1506
- 2166 1408 2182 1554 2169 1454 2194 7906 -2668 1342 2141 1427 2142 1518 2179
- 1511 2163 1370 2172 1553 2122 1211 2157 1476 2170 1519 2150 1454 2186 1481 2147
- 1065 2184 1597 2112 7907 -2666 1367 2187 1370 2140 1385 2192 1294 2139 1464
- 2186 1478 2178 1730 2046 7897 -2687 1568 2129 7900 -2682 1525 2153 1351 2165
- 1623 2122 1460 2183 1349 2159 1751 2024 1488 2161 1446 2177 1448 2163 7904
- -2675 1369 2177 1440 2185 1293 2156 100 { m20} R 1665 2058 1416 2171 1532 2175
- 1542 2162 7905 -2673 1601 2141 1622 2123 1492 2154 1561 2135 1685 2069 1426
- 2166 1716 2060 1587 2131 1586 2132 1670 2047 1435 2173 1524 2143 1410 2179 1462
- 2163 1527 2177 1541 2164 1715 2039 1307 2163 1391 2165 1375 2148 1409 2174 1562
- 2111 1555 2123 1495 2133 1443 2190 1478 2137 1320 2161 1312 2149 1796 2002 1403
- 2193 1489 2175 1364 2162 1663 2103 1355 2156 1548 2122 1490 2147 1507 2179 7897
- -2688 1367 2159 1386 2183 1589 2141 1276 2155 1495 2174 1656 2111 1482 2156
- 1403 2184 1497 2187 52 { m20} R 0.58182 0.8 0 c 1303 2197 1493 2223 1460 2216
- 1409 2233 1479 2212 1360 2230 1445 2225 1464 2209 1411 2245 1495 2239 1484 2231
- 1416 2228 1432 2240 1399 2211 1459 2240 1306 2219 1481 2207 1517 2219 1520 2188
- 1283 2221 1541 2183 1370 2196 1409 2216 1437 2219 1441 2221 1362 2205 1367 2219
- 1393 2212 1489 2205 1493 2231 1443 2213 1509 2218 1471 2227 1296 2203 1470 2240
- 1525 2212 1473 2218 1351 2206 1267 2219 1462 2232 1465 2241 1387 2198 1240 2215
- 1479 2241 1507 2205 1392 2238 1326 2217 1509 2215 1374 2239 1465 2197 1336 2220
- 1489 2235 1356 2195 1445 2207 1377 2217 1487 2239 1507 2194 1467 2236 1548 2194
- 1506 2211 1402 2222 1471 2210 1474 2239 1454 2231 1354 2211 1466 2242 1333 2229
- 1449 2196 1435 2239 1420 2211 1438 2233 1507 2211 1362 2227 1566 2176 1427 2215
- 1507 2205 1495 2189 1483 2220 1430 2241 1248 2239 1343 2223 1410 2233 82 { m20
-} R 0.72727 0.8 0 c 1380 2247 1426 2245 1390 2248 1474 2243 1479 2248 1424 2265
- 1459 2264 1338 2251 1319 2264 1425 2274 1418 2263 1436 2285 1250 2258 1440 2253
- 1284 2277 1314 2257 1445 2274 1443 2264 1461 2265 1388 2246 1367 2248 1414 2263
- 1462 2254 1438 2253 1410 2248 1429 2287 1415 2269 1458 2271 1437 2266 1396 2264
- 1390 2250 1438 2265 1436 2262 1474 2247 1257 2282 1427 2266 1465 2258 1373 2250
- 1354 2253 1402 2286 1405 2257 1476 2246 42 { m20} R 0.8 0.72727 0 c 1409 2311
- 1399 2307 1429 2300 1386 2293 1292 2320 1375 2304 1419 2310 1410 2299 1342 2297
- 1433 2294 1352 2303 1373 2319 1400 2289 1382 2301 1376 2323 1414 2289 1292 2305
- 1340 2289 1383 2315 1364 2301 1333 2318 1398 2308 1385 2304 1397 2308 1435 2296
- 25 { m20} R 0.8 0.58182 0 c 1363 2344 1399 2330 1352 2341 1382 2327 1361 2337
- 1326 2341 6 { m20} R 0.8 0.43636 0 c 1368 2364 1355 2371 2 { m20} R 0.8 0.29091
- 0 c 1368 2364 0.8 0.14546 0 c 1368 2364 0 0 0.8 c 1368 2364 0 0.14545 0.8 c
- 1368 2364 0 0.29091 0.8 c 7370 -2917 7084 -3010 2 { m20} R 0 0.43636 0.8 c 7575
- -2884 7233 -2992 7492 -2915 3 { m20} R 0 0.58182 0.8 c 7542 -2979 7257 -3105
- 7243 -3131 7642 -2855 7441 -3018 7679 -2823 7487 -3020 7503 -3010 7140 -3109
- 7621 -2871 6760 -3260 7740 -2782 7697 -2803 13 { m20} R 0 0.72727 0.8 c 7440
- -3104 7671 -2938 7782 -2762 7514 -3018 7688 -2884 7652 -2941 7769 -2751 7325
- -3200 7647 -2901 7662 -2940 7265 -3191 7348 -3172 7491 -3073 7536 -3030 7760
- -2770 6958 -3242 7557 -3074 7690 -2854 7843 -2634 7784 -2733 7793 -2734 7576
- -3008 7638 -2964 7698 -2865 7627 -2964 7435 -3075 7335 -3163 7284 -3257 7066
- -3290 7551 -3076 7699 -2888 7816 -2696 7701 -2884 7542 -3090 7431 -3093 7565
- -3052 7653 -2897 7440 -3063 7575 -2993 7347 -3134 6275 -3492 7513 -3096 7765
- -2777 7585 -3039 7327 -3129 7255 -3260 7733 -2832 7651 -2953 7631 -2980 7640
- -2917 7746 -2811 7600 -3032 7480 -3092 53 { m20} R 0 0.8 0.72727 c 7244 -3300
- 7668 -2968 7612 -3032 7673 -3007 7746 -2860 7104 -3628 7576 -3143 7587 -3057
- 7236 -3428 7617 -3042 7361 -3339 7746 -2856 7630 -3084 7808 -2723 7615 -3113
- 7616 -3067 7733 -2862 7380 -3273 7244 -3414 7449 -3263 7502 -3298 7328 -3278
- 7489 -3233 7242 -3540 7572 -3100 7166 -3671 7413 -3359 7672 -3004 7553 -3155
- 7568 -3087 7678 -2949 7597 -3075 6799 -3701 7430 -3292 7718 -2919 7745 -2871
- 7579 -3080 7548 -3124 7593 -3075 7409 -3326 7557 -3101 7362 -3454 7812 -2720
- 7601 -3135 7617 -3061 7602 -3074 7574 -3115 7586 -3142 7791 -2764 7637 -3015
- 7707 -2912 7687 -2981 7267 -3398 7639 -3016 7430 -3310 7591 -3083 7324 -3345
- 7672 -3014 7604 -3059 7555 -3159 6818 -3461 7691 -2937 7622 -3060 7618 -3098
- 7487 -3282 7320 -3370 7728 -2893 7632 -3052 7475 -3250 7497 -3144 7621 -3103
- 7188 -3409 7631 -3033 7624 -3017 7711 -2885 6963 -3665 7600 -3055 7570 -3175
- 7699 -2946 7076 -3497 7836 -2699 7691 -2922 7808 -2746 7205 -3588 7666 -3015
- 7709 -2891 7561 -3197 7678 -2942 7740 -2877 7606 -3052 7461 -3329 7488 -3180
- 7705 -2915 7096 -3440 7470 -3203 7619 -3059 7642 -3065 7591 -3126 7774 -2809
- 7571 -3076 100 { m20} R 7363 -3356 7511 -3253 7646 -3005 7563 -3083 6724 -3589
- 7254 -3538 7832 -2693 7433 -3345 7816 -2729 9 { m20} R 0 0.8 0.58182 c 7545
- -3391 7536 -3273 7442 -3438 7278 -3933 7674 -3049 7799 -2807 1020 1179 7643
- -3160 7534 -3355 7694 -2999 7592 -3223 7511 -3464 7482 -3363 7729 -2966 7667
- -3065 7777 -2858 7816 -2765 7309 -3875 7751 -2905 7644 -3067 7858 -2685 7629
- -3129 7669 -3057 7629 -3183 1153 1175 7634 -3184 7676 -3079 7690 -3010 7570
- -3315 7682 -3045 7565 -3346 7656 -3117 7759 -2883 7557 -3331 7720 -2964 7743
- -2891 7722 -2940 7719 -2985 7592 -3239 7668 -3068 7708 -2999 1366 919 7731
- -2956 7677 -3076 7611 -3231 989 842 7754 -2860 7363 -3724 7606 -3156 7507 -3458
- 7503 -3344 7398 -3558 7656 -3124 7744 -2918 7545 -3319 7511 -3429 7726 -2967
- 7724 -2940 7616 -3136 7216 -3960 7710 -2974 7698 -2977 7654 -3063 7789 -2819
- 7661 -3073 7483 -3376 7481 -3527 7650 -3081 701 999 7409 -3549 7421 -3499 7462
- -3391 7521 -3281 7629 -3121 7643 -3127 7615 -3188 7658 -3126 7490 -3348 7718
- -2977 1581 917 7832 -2734 1058 982 7469 -3547 7780 -2841 7711 -3002 7662 -3105
- 7774 -2851 7793 -2790 7797 -2804 7579 -3303 7451 -3578 7613 -3205 7789 -2807
- 7405 -3659 7714 -2949 7748 -2915 7782 -2838 7696 -3033 7751 -2910 7550 -3334
- 100 { m20} R 7430 -3623 7697 -3005 7357 -3583 1136 989 7616 -3202 7731 -2934
- 7700 -2996 7537 -3275 7878 -2634 7564 -3290 7512 -3454 1005 1233 7723 -2928
- 7705 -2966 1026 1162 7619 -3221 7665 -3089 7761 -2892 7523 -3365 7584 -3243
- 7724 -2939 7724 -2962 7433 -3577 7435 -3454 7658 -3061 7676 -3008 7420 -3448
- 7664 -3050 1153 904 7709 -2976 910 942 7804 -2782 7662 -3079 991 1089 7623
- -3128 7478 -3456 915 954 7514 -3451 7828 -2730 7399 -3534 1021 1126 7617 -3171
- 42 { m20} R 0 0.8 0.43636 c 941 1585 1191 1511 7788 -2840 1398 1535 7588 -3312
- 7665 -3156 7726 -3006 7794 -2832 7644 -3191 7688 -3104 7813 -2804 7756 -2944
- 7733 -2978 7732 -2980 7743 -2975 7694 -3093 7733 -2974 7670 -3123 1248 1448 826
- 1590 7820 -2791 1100 1513 7638 -3187 7789 -2860 7695 -3091 1295 1494 1298 1492
- 7727 -2979 7753 -2953 7717 -3039 7559 -3368 7895 -2622 1092 1526 453 1372 7678
- -3115 7788 -2870 7734 -2964 7725 -2985 7652 -3180 7862 -2688 7681 -3113 7777
- -2885 7795 -2855 1374 1441 7684 -3114 7652 -3181 1033 1270 7642 -3202 7682
- -3113 1230 1567 1051 1516 1007 1492 7799 -2815 7777 -2892 7814 -2804 7720 -3031
- 7695 -3043 7747 -2953 7745 -2940 1695 1108 7686 -3091 7623 -3228 7710 -3023
- 1315 1339 7763 -2924 7868 -2682 7837 -2740 7819 -2774 1024 1251 7713 -3022 1014
- 1522 766 1522 1022 1459 7759 -2917 7574 -3331 7636 -3186 7650 -3156 7749 -2922
- 7755 -2913 1132 1271 7689 -3099 7678 -3087 7716 -3030 1106 1491 7719 -3019 7690
- -3066 1105 1583 7822 -2780 600 1322 1029 1539 940 1292 7672 -3130 7688 -3096
- 1094 1525 1238 1348 7716 -3044 7595 -3291 1126 1413 7751 -2946 7685 -3102 100 {
- m20} R 1406 1403 7656 -3138 1169 1358 7632 -3190 7784 -2865 7666 -3150 7783
- -2873 944 1547 7757 -2932 7740 -2949 7692 -3084 7751 -2935 1292 1454 1019 1265
- 1350 1569 1182 1572 7793 -2846 676 1581 7657 -3171 7657 -3135 7737 -2985 7746
- -2949 7660 -3161 1389 1287 7733 -2983 7632 -3218 7732 -2971 7754 -2947 7746
- -2960 7704 -3056 7716 -3026 1331 1263 1014 1596 7651 -3148 526 1296 1037 1580
- 1244 1529 7783 -2874 1087 1594 1116 1343 925 1477 7816 -2793 786 1505 874 1364
- 7830 -2764 7789 -2850 7708 -3052 7696 -3084 7687 -3075 7850 -2714 7729 -2999
- 7829 -2777 7819 -2795 1240 1443 7741 -2983 7715 -3043 7794 -2856 7800 -2839
- 1344 1473 7774 -2889 7799 -2837 7697 -3040 1251 1528 7765 -2919 7724 -3000 7731
- -2989 1165 1498 7687 -3110 561 1247 1294 1515 1055 1577 7669 -3135 1346 1528
- 7753 -2942 1103 1542 1263 1329 7711 -3009 7733 -2992 1058 1520 7686 -3088 7748
- -2964 7714 -3033 7711 -3054 7684 -3114 1303 1562 7709 -3043 7733 -2981 7877
- -2666 7651 -3184 799 1415 7720 -3013 7714 -3001 7739 -2986 7745 -2957 7755
- -2946 7666 -3153 7685 -3100 7717 -3020 7702 -3046 1525 1379 100 { m20} R 7823
- -2785 7767 -2916 7708 -3018 7749 -2930 1262 1544 1117 1537 6 { m20} R 0 0.8
- 0.29091 c 7712 -3060 1004 1747 7872 -2689 7793 -2870 1255 1686 7776 -2910 1391
- 1701 7721 -3043 7846 -2760 7736 -3012 1055 1776 7712 -3060 7837 -2760 7815
- -2828 1041 1711 7703 -3078 7784 -2907 7736 -3009 1181 1767 7774 -2930 7713
- -3051 7723 -3036 1559 1511 7763 -2936 7877 -2686 7699 -3088 1071 1700 7838
- -2773 1279 1728 1295 1762 7743 -2998 7845 -2758 7733 -3019 7818 -2828 7811
- -2842 7766 -2946 955 1766 1359 1751 936 1677 1207 1718 7754 -2960 7691 -3102
- 1166 1713 1241 1638 7791 -2872 7775 -2914 1249 1645 7823 -2813 7739 -2994 7785
- -2886 1160 1673 7761 -2953 7809 -2847 1135 1762 7818 -2826 7844 -2751 7763
- -2955 1592 1560 7771 -2915 7740 -2995 7711 -3063 1104 1722 1092 1686 7744 -2996
- 1402 1578 7826 -2809 7832 -2784 1357 1764 7805 -2847 7794 -2872 1487 1739 7833
- -2770 684 1770 7873 -2689 1288 1647 7748 -2987 1298 1761 1053 1630 7763 -2955
- 869 1690 7776 -2920 1211 1749 7762 -2940 7710 -3061 1687 1612 1530 1588 7751
- -2981 7812 -2843 1351 1592 7748 -2982 7787 -2886 1140 1786 1276 1687 7686 -3113
- 7755 -2964 1250 1643 7764 -2950 1148 1738 1312 1708 1513 1660 100 { m20} R 7704
- -3074 7844 -2745 899 1691 7733 -3011 7751 -2969 1266 1621 7813 -2841 7814 -2832
- 7841 -2767 806 1698 7887 -2665 1312 1595 1432 1757 1078 1712 1057 1771 7814
- -2822 7777 -2902 7889 -2652 1176 1724 7864 -2705 7741 -3002 7702 -3080 7792
- -2876 7737 -2999 7805 -2846 7868 -2692 7751 -2969 7876 -2676 1083 1732 7854
- -2743 7755 -2956 1296 1740 1674 1514 7802 -2842 1321 1712 7809 -2842 7803 -2858
- 1410 1755 1475 1626 818 1804 1288 1670 7707 -3069 7864 -2719 7694 -3095 1267
- 1681 792 1743 1257 1740 1436 1661 1286 1752 1056 1669 703 1653 1252 1668 888
- 1736 7799 -2846 7741 -3002 1569 1657 7795 -2858 7806 -2838 7825 -2807 1284 1637
- 1089 1796 1298 1688 7728 -3028 7830 -2788 7742 -2989 7800 -2866 1011 1632 7771
- -2919 1252 1583 7833 -2780 1205 1721 7822 -2806 1384 1655 7798 -2876 1119 1716
- 7819 -2804 1396 1629 7815 -2811 7784 -2905 1278 1630 1165 1660 1081 1689 7759
- -2956 7907 -2617 7857 -2734 1323 1710 1484 1720 1391 1586 707 1760 1083 1627
- 7746 -2985 991 1776 1016 1702 1237 1664 1385 1670 7745 -2991 7793 -2879 1254
- 1667 1260 1735 7741 -2993 100 { m20} R 7710 -3064 7804 -2845 7743 -2997 7809
- -2840 7785 -2898 7848 -2748 7833 -2779 7768 -2936 7770 -2937 1657 1555 7701
- -3083 1258 1653 7734 -3007 7843 -2750 7740 -2999 7752 -2974 7713 -3058 1209
- 1664 7854 -2737 7767 -2944 1466 1706 1215 1654 22 { m20} R 0 0.8 0.14545 c 7769
- -2945 1318 1842 7786 -2909 7840 -2780 1642 1717 859 1841 1171 1888 1239 1878
- 7777 -2927 1368 1801 7807 -2869 7822 -2834 1688 1684 1307 1829 7857 -2749 7768
- -2947 1318 1843 7803 -2874 1634 1669 1430 1797 1329 1781 7837 -2790 1326 1860
- 7811 -2855 7816 -2845 7812 -2845 7858 -2752 7795 -2892 7808 -2864 1363 1818
- 1108 1840 1330 1797 1223 1832 7890 -2673 1411 1791 7832 -2799 1410 1879 7793
- -2890 7865 -2732 1542 1801 7776 -2928 7773 -2938 1213 1847 1346 1791 7845 -2769
- 1381 1827 1501 1832 1177 1886 7858 -2736 7899 -2644 7842 -2789 7811 -2855 1056
- 1916 1271 1879 1128 1808 1492 1769 7857 -2750 1418 1860 7796 -2889 1342 1899
- 7849 -2771 7803 -2870 7831 -2808 1290 1824 1209 1849 1243 1779 1307 1855 7786
- -2913 7782 -2913 7860 -2742 1303 1790 7865 -2733 7821 -2836 7829 -2816 7869
- -2709 7827 -2814 7847 -2778 1428 1887 1297 1875 7889 -2678 7838 -2791 7879
- -2701 7810 -2852 1191 1904 7790 -2903 7792 -2891 1246 1818 1503 1829 1470 1787
- 7856 -2750 7865 -2730 1363 1848 7828 -2816 7813 -2849 1198 1891 7892 -2669 7767
- -2951 1377 1784 7854 -2760 7826 -2824 100 { m20} R 7769 -2946 7906 -2624 7788
- -2904 1406 1875 1176 1798 1193 1861 7893 -2655 7901 -2648 903 1899 7796 -2892
- 7845 -2770 7757 -2970 871 1839 7855 -2743 7859 -2741 7840 -2780 1417 1818 7907
- -2631 1164 1874 1418 1790 7815 -2848 7827 -2818 1351 1843 1256 1850 994 1907
- 1359 1893 1472 1804 1045 1855 7806 -2869 1001 1845 7810 -2850 7809 -2863 7899
- -2654 7844 -2782 1263 1849 7824 -2827 7795 -2887 7838 -2793 1600 1754 7855
- -2744 1216 1872 7834 -2806 7789 -2906 1454 1801 7769 -2945 7815 -2848 7840
- -2788 1436 1878 1276 1836 1046 1939 7879 -2694 7861 -2744 1786 1684 7778 -2928
- 7760 -2965 1409 1889 7900 -2651 7812 -2847 1426 1880 7818 -2840 7792 -2899 1250
- 1845 1231 1790 1686 1691 7801 -2878 1203 1824 7823 -2828 1394 1816 7824 -2820
- 7830 -2808 881 1897 620 1815 7787 -2904 1067 1836 7818 -2836 7808 -2858 1343
- 1862 7764 -2956 7832 -2797 7802 -2871 7811 -2859 7835 -2794 7799 -2883 7852
- -2766 7794 -2895 1296 1854 7780 -2922 7883 -2687 7792 -2894 7842 -2781 7901
- -2646 7837 -2787 1293 1852 1304 1896 1271 1776 7883 -2685 1240 1783 7832 -2799
- 1462 1833 1583 1763 100 { m20} R 1338 1872 1035 1872 7803 -2878 7792 -2899 1256
- 1854 7806 -2870 7799 -2883 1350 1899 1278 1868 1057 1830 1253 1882 1269 1875
- 7863 -2729 1257 1886 7818 -2833 7805 -2871 7773 -2937 7856 -2758 1785 1642 7848
- -2765 1120 1866 7839 -2787 1222 1881 7830 -2809 1198 1829 7868 -2717 7807 -2857
- 1160 1872 1374 1853 7783 -2918 1186 1804 7873 -2707 7806 -2868 7780 -2924 7784
- -2914 7795 -2892 1245 1844 1178 1909 7785 -2913 1647 1674 7823 -2825 1190 1826
- 924 1941 1087 1857 7824 -2832 1265 1777 919 1861 1258 1836 892 1906 7838 -2784
- 1470 1837 1074 1932 1140 1807 7826 -2815 1114 1866 1224 1852 1342 1801 7822
- -2834 1422 1813 7804 -2866 7886 -2684 7805 -2862 1228 1830 63 { m20} R 0 0.8
- 0.4069E-06 c 1458 1981 1469 1971 7857 -2759 7896 -2665 1540 1888 7859 -2761
- 1317 1983 1345 1902 7883 -2699 7904 -2657 7864 -2751 1334 1906 7857 -2765 7837
- -2808 1486 1900 1506 1875 7862 -2755 7864 -2750 1653 1888 1660 1812 1392 1933
- 7835 -2812 7841 -2794 7850 -2779 1475 1961 7829 -2821 7847 -2783 7891 -2685
- 7840 -2803 1445 1950 1228 1998 7892 -2680 7799 -2885 1638 1836 1487 1927 7831
- -2822 7843 -2793 1211 1944 1361 1981 1144 1922 7894 -2677 7868 -2733 7831 -2821
- 1625 1878 1464 1946 7870 -2728 1509 1884 7847 -2788 1518 1933 7887 -2693 7822
- -2837 1440 1921 1223 1975 7840 -2800 1149 1988 7844 -2789 1515 1963 7900 -2658
- 7829 -2825 7856 -2763 1452 1946 1391 1912 7832 -2818 7862 -2753 1195 1926 7835
- -2810 1065 1963 7863 -2752 1259 1945 7850 -2777 7877 -2716 1236 1956 7840 -2801
- 7878 -2719 7871 -2731 7826 -2830 1217 1990 7895 -2674 7871 -2731 1011 2031 7824
- -2832 7873 -2729 1257 1958 7884 -2702 1391 1928 7845 -2791 1253 1955 1480 1951
- 1448 1932 1385 1909 1214 1972 7882 -2708 1105 2015 7897 -2668 959 1999 7901
- -2666 7909 -2636 1399 1984 7843 -2789 7902 -2652 100 { m20} R 7826 -2830 1531
- 1966 7838 -2806 1170 1936 950 2036 1205 1959 7883 -2697 7834 -2812 1290 1975
- 7883 -2699 7842 -2799 1202 1943 1259 1900 1256 1986 7884 -2704 7836 -2812 7845
- -2791 7815 -2852 7860 -2759 7859 -2761 7834 -2814 1185 1988 1121 1931 1598 1871
- 1344 1904 7879 -2714 1390 1928 1719 1764 1207 1957 7834 -2811 7849 -2780 1122
- 2016 7834 -2813 1220 1966 1434 1904 7855 -2771 7809 -2865 1041 1975 1496 1951
- 1234 1907 1078 1955 1536 1940 7846 -2789 7830 -2823 961 2016 7886 -2700 7846
- -2787 7907 -2640 7873 -2719 7862 -2755 7846 -2786 7864 -2741 7865 -2740 7847
- -2787 1271 1960 1099 1974 7869 -2738 7856 -2760 1315 1972 1061 1946 1343 1931
- 1684 1850 1301 1963 7830 -2822 7855 -2770 1408 1975 1409 1983 7818 -2848 1578
- 1928 7864 -2748 1345 1954 7855 -2769 1448 1965 827 1940 1830 1678 1611 1906
- 7858 -2764 7826 -2829 1245 1933 7849 -2782 7856 -2765 7907 -2644 7862 -2753
- 1067 2002 7854 -2766 7877 -2709 7863 -2753 7904 -2643 7892 -2682 7829 -2824
- 1226 1917 7827 -2828 7890 -2690 1431 1940 1448 1979 1438 1932 7853 -2775 7855
- -2769 1434 1916 1610 1913 100 { m20} R 7893 -2683 7900 -2664 1149 1936 1577
- 1933 1394 1955 1349 1971 985 2031 1489 1927 7833 -2817 1028 1966 1281 1966 1222
- 1968 1268 1925 7846 -2789 1011 2011 1385 1927 1293 1973 1171 1953 7832 -2818
- 805 1985 1408 1925 1218 1981 1352 1970 1321 1945 1167 1940 1556 1941 7818 -2847
- 7887 -2698 7882 -2709 1536 1908 7839 -2798 7830 -2822 7824 -2834 7860 -2754
- 7867 -2741 1504 1973 7846 -2782 7831 -2819 7841 -2799 7846 -2785 7856 -2768
- 7897 -2674 1539 1933 7841 -2795 1356 1910 1515 1964 1581 1900 1071 1965 1454
- 1928 7856 -2767 7819 -2844 7876 -2721 7837 -2808 1334 1977 7827 -2828 1359 1973
- 7849 -2783 979 1989 1691 1817 7834 -2815 7845 -2789 1507 1955 7847 -2781 1286
- 1927 1220 1918 1062 1955 7861 -2754 7841 -2799 7822 -2838 1280 1961 70 { m20} R
- 0.14545 0.8 0 c 1383 2057 7879 -2719 7903 -2670 7888 -2700 1271 2046 7869 -2741
- 7867 -2745 7868 -2743 7852 -2778 1455 2063 1491 2059 1441 2069 7870 -2738 1474
- 2037 7858 -2767 7885 -2711 7852 -2778 7877 -2728 1491 2055 1327 1996 1379 2022
- 1305 2063 1318 2007 1246 2076 7859 -2764 1416 2044 1556 2030 1449 2039 1589
- 2022 1334 2001 7906 -2659 7886 -2701 1325 2020 7895 -2681 1586 1972 1325 2072
- 1402 2029 1471 2045 1360 2011 1180 2021 7899 -2676 1287 2047 1127 2038 1913
- 1765 7892 -2690 7877 -2727 7866 -2749 1354 2001 1250 2072 1500 1994 7898 -2678
- 1423 2023 1428 2026 895 2051 1416 2025 7855 -2772 1533 2041 1613 1973 1448 2060
- 7846 -2791 7900 -2676 1321 2009 1325 2050 1365 2007 1457 2006 7907 -2653 7898
- -2674 1367 2072 1444 2021 7866 -2746 7908 -2654 7902 -2673 7864 -2752 1535 1986
- 7852 -2778 7890 -2700 1526 1993 1155 2036 1407 2029 1186 2013 7872 -2732 7876
- -2729 1505 2054 7862 -2756 7882 -2716 1108 2056 7891 -2691 7853 -2775 1328 2072
- 7846 -2790 7844 -2796 7872 -2735 7873 -2730 7894 -2687 7852 -2778 7879 -2724
- 7847 -2789 1364 2070 7909 -2654 1379 2019 100 { m20} R 1546 1964 7885 -2704
- 7880 -2721 1306 2029 1174 2059 7879 -2720 7881 -2713 7890 -2698 7845 -2792 7908
- -2651 1383 2014 7881 -2714 7866 -2750 1168 2041 1699 1947 1444 1995 1360 2065
- 1469 1992 7882 -2716 7907 -2658 7863 -2755 7881 -2720 7899 -2677 1312 2023 7858
- -2765 1444 2067 7856 -2769 7900 -2674 1398 2030 7891 -2697 7885 -2708 7890
- -2697 1419 2020 7874 -2734 1536 1979 7877 -2726 1361 1999 1340 2016 7899 -2671
- 1235 2008 1151 2040 1564 1982 7875 -2731 7863 -2754 7858 -2765 7877 -2726 1318
- 2004 1506 2049 1550 1994 1257 2032 7890 -2690 7861 -2761 7904 -2667 1125 2093
- 7855 -2772 1349 2009 1363 2067 1281 2002 1346 2021 1346 2003 1467 2025 7902
- -2671 7891 -2691 1357 2056 1634 1970 7887 -2700 1133 2046 7880 -2717 7863 -2756
- 7871 -2740 7881 -2718 1292 2029 1241 2020 1507 2047 7871 -2738 7880 -2720 1343
- 2048 875 2056 1480 1988 7853 -2776 7864 -2752 7867 -2748 7880 -2719 1152 2036
- 1531 1992 7881 -2713 1423 2014 7900 -2672 1439 2041 1623 1955 7901 -2674 7894
- -2688 7891 -2691 1360 2036 1265 2074 1396 2026 1561 1976 7888 -2699 1118 2067
- 7902 -2666 100 { m20} R 7900 -2675 1809 1836 1301 2039 1438 2001 7887 -2702
- 1404 2015 1490 2017 1305 2040 7865 -2752 1245 2008 1297 2019 1522 1974 1296
- 2034 1322 2062 7854 -2775 1895 1737 1559 1968 1424 2059 1182 2046 7863 -2756
- 7866 -2750 7887 -2704 7881 -2719 7877 -2721 1714 1884 7891 -2691 1375 2027 1472
- 2014 7863 -2757 1135 2063 1623 1941 7899 -2672 7862 -2759 7873 -2734 7888 -2704
- 7894 -2690 1540 2010 1782 1850 1420 2033 1434 2068 1439 2041 7869 -2743 1213
- 2033 1227 2076 1599 1993 7882 -2717 961 2101 1796 1852 1577 2023 7864 -2754
- 1445 2033 7881 -2716 1423 2010 53 { m20} R 0.29091 0.8 0 c 1357 2074 1687 2013
- 1366 2105 1191 2119 7898 -2682 1446 2113 1517 2089 1542 2114 7894 -2694 7900
- -2681 1450 2095 1335 2112 1540 2110 1422 2108 1359 2104 1511 2106 1428 2136
- 7907 -2667 1595 2030 1342 2129 1694 2015 7905 -2669 7883 -2716 1256 2136 7902
- -2677 7905 -2670 1431 2133 1724 1978 1526 2117 7900 -2681 1436 2101 7897 -2686
- 7905 -2672 1519 2092 7899 -2683 7899 -2682 1403 2115 1368 2106 1725 1995 7905
- -2669 1389 2077 1265 2104 1511 2112 1432 2123 1258 2122 1460 2107 1580 2031
- 1308 2119 7891 -2700 7893 -2694 1495 2088 1452 2138 1369 2116 1360 2121 7879
- -2725 1556 2050 1511 2121 1259 2097 1396 2077 7885 -2713 7891 -2698 7888 -2706
- 1402 2134 1414 2116 7896 -2688 7895 -2689 7885 -2711 1326 2114 1401 2131 1330
- 2126 1373 2109 1513 2116 1442 2077 1341 2126 7889 -2702 1559 2072 1449 2133
- 1638 2053 7879 -2724 7904 -2670 1345 2091 1389 2111 1527 2093 1501 2076 1392
- 2084 7888 -2705 7884 -2713 1486 2108 1661 2011 1415 2117 1479 2075 7904 -2671
- 1450 2087 2032 1778 1580 2098 1377 2090 1608 2072 7893 -2694 7876 -2730 7903
- -2671 100 { m20} R 1475 2096 1362 2077 7891 -2700 1641 2053 7881 -2720 1517
- 2097 1370 2080 1382 2080 1303 2123 1604 2063 1355 2113 1577 2078 1372 2125 7886
- -2710 1602 2064 1583 2092 7895 -2691 7888 -2705 7900 -2680 7881 -2720 1348 2077
- 7874 -2734 1610 2069 1266 2110 1562 2096 7899 -2680 7884 -2714 1387 2132 7889
- -2702 1394 2138 1241 2129 7873 -2736 1477 2117 7903 -2673 1430 2076 1397 2095
- 1439 2121 1313 2091 1468 2069 1646 2004 7900 -2677 1472 2075 1204 2107 1567
- 2067 1618 2044 1754 1932 1487 2090 1565 2091 1386 2100 7908 -2662 7893 -2697
- 1394 2114 1408 2121 1629 2044 1453 2104 1338 2090 7873 -2736 1838 1917 7885
- -2712 1511 2109 7900 -2678 1220 2100 1547 2065 7893 -2696 1455 2121 7894 -2695
- 1559 2046 1347 2138 1357 2108 7892 -2699 1551 2043 1534 2094 7902 -2678 1618
- 2038 1427 2089 1167 2136 7877 -2729 7894 -2690 1557 2068 1810 1928 7900 -2682
- 1479 2122 1656 2005 1555 2082 1164 2118 7903 -2674 7898 -2685 1412 2125 7907
- -2667 1532 2072 1432 2109 7894 -2691 1762 1912 7892 -2698 1527 2057 7908 -2662
- 1514 2079 1423 2107 1075 2122 7901 -2679 100 { m20} R 1256 2117 1720 1945 1539
- 2099 1236 2084 1201 2139 7888 -2707 7897 -2684 1741 1969 7896 -2689 1340 2086
- 1469 2104 1657 2011 1518 2105 1393 2093 7882 -2719 7907 -2665 1226 2100 1516
- 2061 1553 2059 19 { m20} R 0.43636 0.8 0 c 1474 2182 1535 2141 1323 2182 7905
- -2671 1602 2116 1281 2168 1455 2174 1603 2114 7907 -2667 1426 2165 1618 2098
- 1771 1996 1670 2082 1324 2189 1482 2175 1509 2156 1452 2157 1431 2146 1396 2194
- 1224 2184 1466 2153 1680 2075 1287 2180 1551 2139 1515 2143 1387 2177 1512 2156
- 1436 2162 1465 2146 1493 2167 1454 2176 1425 2190 1478 2178 1553 2137 1260 2179
- 1408 2182 1339 2143 1342 2168 1498 2152 1424 2184 1568 2133 1465 2191 1585 2126
- 1490 2141 1409 2168 1329 2194 1669 2051 1298 2164 1680 2063 1501 2142 1405 2153
- 1495 2161 7900 -2682 1431 2154 1525 2154 1444 2181 1461 2188 1315 2145 1381
- 2178 1456 2163 1754 2035 1331 2155 1627 2126 1425 2183 7906 -2670 1376 2154
- 7908 -2666 1290 2156 1461 2163 1506 2136 1795 1973 1546 2118 1087 2185 1516
- 2136 1532 2156 1606 2123 1484 2173 1520 2145 7897 -2688 1459 2143 1412 2182
- 1111 2183 1692 2048 1664 2052 1351 2175 1528 2179 1470 2142 1601 2127 1403 2171
- 1538 2173 1573 2145 1445 2160 1464 2140 1375 2183 1474 2136 1241 2184 1759 2027
- 1328 2151 1552 2151 1487 2163 100 { m20} R 1579 2147 1383 2175 1406 2169 1568
- 2107 1392 2142 1628 2123 1415 2160 1633 2123 1535 2174 1528 2141 1664 2096 7906
- -2670 1626 2114 1428 2175 1471 2157 1542 2157 1501 2142 1585 2109 1563 2149
- 1379 2156 1295 2163 1663 2104 1279 2149 1428 2186 1639 2075 1620 2133 1577 2144
- 1435 2181 1412 2154 1458 2144 1717 2032 7904 -2673 1365 2193 1208 2160 1405
- 2184 7902 -2678 1666 2063 1573 2106 1449 2160 1759 2007 1229 2173 1344 2149
- 1478 2167 43 { m20} R 0.58182 0.8 0 c 1546 2189 1463 2212 1523 2186 1366 2213
- 1515 2206 1389 2209 1449 2240 1345 2194 1473 2237 1556 2180 1589 2163 1501 2219
- 1422 2231 1468 2234 1383 2215 1300 2233 1353 2240 1483 2238 1281 2232 1534 2179
- 1340 2198 1496 2238 1499 2204 1431 2235 1276 2220 1436 2199 1471 2219 1348 2212
- 1483 2232 1567 2179 1503 2208 1570 2170 1386 2225 1388 2233 1426 2211 1436 2226
- 1312 2221 1457 2230 1545 2178 1568 2167 1278 2201 1434 2203 1455 2223 1224 2221
- 1363 2206 1505 2189 1364 2240 1472 2199 1499 2221 1411 2234 1469 2215 1475 2227
- 1405 2227 1438 2209 1543 2190 1437 2223 1422 2219 1283 2216 1451 2199 1377 2201
- 1550 2176 1384 2197 1486 2208 1559 2178 1460 2235 1444 2208 1473 2233 1369 2199
- 1424 2216 1474 2228 1396 2232 1519 2203 1354 2196 1416 2208 1468 2239 1441 2244
- 1542 2194 77 { m20} R 0.72727 0.8 0 c 1445 2253 1454 2247 1386 2266 1464 2246
- 1431 2281 1439 2269 1388 2275 1389 2268 1436 2285 1418 2273 1479 2250 1386 2256
- 1405 2283 1366 2281 1375 2263 1406 2248 1439 2252 1435 2289 1405 2251 1440 2260
- 1448 2273 1421 2284 1343 2257 1416 2288 1375 2248 1354 2263 1451 2264 1418 2254
- 1466 2252 1365 2245 1455 2267 1460 2267 1461 2260 1453 2278 1443 2248 1481 2247
- 1445 2258 1416 2256 1342 2257 1414 2248 1353 2252 1427 2278 1326 2272 43 { m20
-} R 0.8 0.72727 0 c 1410 2324 1386 2293 1380 2301 1422 2296 1410 2316 1413 2311
- 1407 2295 1415 2295 1337 2288 1396 2322 1427 2292 1328 2321 1408 2310 1406 2320
- 1357 2313 1436 2292 1385 2311 1411 2289 1351 2315 1341 2293 1336 2316 1271 2297
- 22 { m20} R 0.8 0.58182 0 c 1334 2350 1406 2330 1335 2341 1384 2348 1395 2337
- 1387 2332 1402 2331 1396 2339 8 { m20} R 0.8 0.43636 0 c 1334 2350 0.8 0.29091
- 0 c 1334 2350 0.8 0.14546 0 c 1334 2350 0 0 0.8 c 1334 2350 0 0.14545 0.8 c
- 1334 2350 0 0.29091 0.8 c 7247 -2949 m20 0 0.43636 0.8 c 7416 -2946 7549 -2873
- 7484 -2928 3 { m20} R 0 0.58182 0.8 c 7575 -2908 7608 -2896 7248 -3104 7317
- -3053 7529 -2993 7631 -2897 7619 -2913 7223 -3092 7317 -3115 7115 -3112 7222
- -3119 7540 -2954 7526 -2942 7616 -2890 7223 -3077 7703 -2822 7381 -3018 7412
- -3069 7679 -2848 7665 -2844 7586 -2914 7558 -2970 7509 -2990 7353 -3078 7387
- -3069 7631 -2907 7633 -2907 7552 -2986 7561 -2928 29 { m20} R 0 0.72727 0.8 c
- 7235 -3296 7755 -2770 7559 -3047 7692 -2862 7423 -3158 7470 -3112 7798 -2736
- 7315 -3205 7484 -3107 7716 -2861 7422 -3145 7629 -2956 7611 -3010 7689 -2908
- 7363 -3202 7592 -3011 7276 -3262 7193 -3268 7361 -3175 7501 -3092 7483 -3135
- 7459 -3173 7542 -3081 7280 -3269 7699 -2867 7628 -2931 7214 -3245 7658 -2923
- 7715 -2855 7707 -2883 7066 -3306 7442 -3130 7698 -2841 7521 -3067 7586 -3010
- 7642 -2964 7647 -2957 7528 -3086 7558 -3056 7551 -3000 7652 -2952 7609 -2979
- 7613 -3008 7779 -2746 7511 -3041 7731 -2847 7564 -3003 7370 -3144 7547 -2992 49
- { m20} R 0 0.8 0.72727 c 7514 -3262 7633 -3002 7368 -3454 7443 -3373 7467 -3216
- 7340 -3271 7467 -3173 7527 -3161 7487 -3267 7599 -3117 7688 -2947 7690 -2971
- 7379 -3450 7507 -3202 7511 -3230 7661 -3028 7518 -3182 7612 -3075 7806 -2729
- 7747 -2868 7690 -2979 7292 -3319 7353 -3262 7327 -3272 7710 -2940 7672 -2989
- 7592 -3076 7628 -3038 7441 -3287 7743 -2845 7491 -3316 7553 -3124 7549 -3163
- 7595 -3051 7198 -3363 7770 -2807 7642 -3032 7678 -2969 7693 -2972 7443 -3372
- 7517 -3257 7762 -2832 7628 -3041 7602 -3114 7475 -3220 7444 -3203 7707 -2933
- 7313 -3271 7611 -3065 7558 -3213 7686 -2951 6656 -3515 7426 -3377 7626 -3049
- 7505 -3200 7482 -3216 7665 -2959 7194 -3558 7776 -2811 7622 -3075 7665 -2969
- 7605 -3103 7739 -2873 7614 -3059 7705 -2901 7444 -3387 7493 -3312 7518 -3168
- 7553 -3101 7675 -2989 7533 -3187 7759 -2850 7763 -2830 7750 -2851 7534 -3213
- 7617 -3076 7455 -3339 7633 -3011 7436 -3230 7679 -2945 7656 -2971 7637 -3064
- 7698 -2952 7566 -3144 7534 -3177 7559 -3129 7605 -3054 7527 -3236 7534 -3246
- 7553 -3222 7601 -3076 7380 -3380 7662 -2986 7528 -3129 7668 -2996 7710 -2885
- 7468 -3188 7185 -3488 7516 -3188 7790 -2780 100 { m20} R 7688 -2978 7575 -3161
- 7738 -2863 7440 -3262 7239 -3510 7618 -3099 7770 -2793 7 { m20} R 0 0.8 0.58182
- c 7565 -3265 7544 -3383 7812 -2775 7777 -2835 7766 -2878 7419 -3645 7716 -2970
- 7740 -2921 7493 -3461 7653 -3072 7511 -3451 1349 1079 7536 -3268 7628 -3175
- 7612 -3198 7453 -3470 7614 -3184 7799 -2798 7660 -3087 898 1255 7682 -3022 7736
- -2925 7691 -3017 7675 -3043 7512 -3346 7634 -3175 7580 -3228 7415 -3447 7578
- -3309 7738 -2891 7421 -3541 7749 -2916 7638 -3107 7219 -3868 7611 -3163 7688
- -2988 7347 -3680 7764 -2888 7531 -3404 7709 -2968 1074 1133 7652 -3136 7749
- -2921 7576 -3313 7219 -3923 1285 1040 804 1057 7690 -3045 7496 -3473 7641 -3087
- 7797 -2805 792 1001 7603 -3205 592 677 7803 -2769 7737 -2924 7484 -3397 7429
- -3631 7721 -2966 7719 -2929 7707 -3015 7463 -3547 7589 -3236 7604 -3200 7771
- -2849 7568 -3208 1214 1088 7202 -3915 7586 -3275 1019 1180 7626 -3203 7738
- -2898 7702 -2998 7756 -2886 917 772 7611 -3236 1018 1102 7617 -3155 7753 -2884
- 7827 -2742 7511 -3399 1011 1225 7470 -3528 1210 1210 7526 -3292 7542 -3400 7664
- -3053 7470 -3445 7619 -3189 865 1249 7833 -2735 7744 -2882 7574 -3287 7544
- -3366 7641 -3155 7693 -3016 7252 -3774 7615 -3225 7468 -3501 7590 -3265 100 {
- m20} R 7747 -2905 7475 -3358 7189 -3968 7565 -3254 7602 -3223 7831 -2718 7669
- -3102 7509 -3312 7789 -2802 7724 -2953 7374 -3511 7643 -3082 7522 -3316 7821
- -2761 7629 -3196 7632 -3148 7349 -3546 7736 -2949 7445 -3504 7595 -3261 1140
- 1035 7773 -2861 7674 -3092 7612 -3230 7416 -3642 7788 -2821 7768 -2870 7655
- -3090 7502 -3442 7215 -3704 7707 -2978 1247 1097 7758 -2870 7674 -3065 34 { m20
-} R 0 0.8 0.43636 c 7740 -2959 7521 -3448 7807 -2814 7794 -2837 812 1267 7664
- -3150 7614 -3239 7717 -3010 7882 -2651 7671 -3111 7717 -3040 7738 -2948 1009
- 1355 1350 1494 1167 1414 7728 -2984 1647 1354 1065 1497 7700 -3034 7675 -3133
- 7787 -2870 7869 -2682 1084 1437 7711 -3016 1144 1302 7658 -3153 7603 -3261 7766
- -2917 7798 -2816 1221 1511 1141 1359 7730 -2963 7677 -3084 7716 -3002 779 1499
- 7732 -2995 7655 -3156 7765 -2906 7617 -3252 7607 -3270 7719 -3024 7723 -3015
- 1086 1582 7746 -2969 783 1562 7707 -3017 1039 1513 7854 -2713 1436 1225 7721
- -3019 769 1575 1142 1548 7774 -2866 1039 1520 1086 1536 1113 1372 7675 -3128
- 7731 -2963 7772 -2908 7731 -2983 7749 -2930 7700 -3076 7736 -2956 1396 1323
- 7708 -3051 889 1330 7746 -2958 7857 -2696 7701 -3044 7700 -3059 7654 -3172 7806
- -2827 1138 1578 7717 -3014 7695 -3055 7658 -3171 7831 -2765 1163 1541 1280 1298
- 960 1330 7737 -2952 7808 -2822 7795 -2821 7719 -3016 1182 1411 1238 1544 7789
- -2841 7724 -2990 1109 1310 7725 -2981 1449 1332 7812 -2788 7708 -3051 1208 1405
- 7634 -3198 1491 1261 7777 -2879 7587 -3307 7749 -2948 7671 -3135 100 { m20} R
- 7761 -2896 7683 -3116 7721 -3020 1172 1528 7649 -3188 7748 -2936 7778 -2888
- 7631 -3224 1029 1589 1455 1435 7714 -3021 7741 -2946 7599 -3288 7675 -3121 7701
- -3067 7652 -3176 1283 1472 1241 1437 7718 -3031 1438 1329 7794 -2844 1182 1495
- 953 1617 958 1555 7731 -2997 7718 -3039 7755 -2924 864 1467 7865 -2672 677 1594
- 1250 1361 1049 1603 7751 -2944 7741 -2951 1236 1345 7742 -2975 1269 1547 7745
- -2946 7651 -3152 1241 1565 7693 -3061 7536 -3417 7621 -3239 7716 -2999 7588
- -3312 896 1343 7744 -2972 7690 -3073 7704 -3057 7819 -2789 7808 -2808 7741
- -2968 1188 1554 7688 -3088 394 1330 7600 -3280 7810 -2802 1376 1570 7769 -2909
- 7733 -2992 7718 -3001 902 1382 1243 1545 7661 -3163 7753 -2916 7601 -3284 7808
- -2809 7803 -2825 7740 -2981 1214 1440 7688 -3076 1349 1308 7784 -2862 7767
- -2890 7892 -2620 7789 -2838 7693 -3085 7767 -2920 7800 -2809 7663 -3130 1247
- 1474 7731 -2963 7683 -3086 7740 -2978 7755 -2908 7769 -2880 1507 1515 7629
- -3222 7674 -3092 841 1476 7847 -2720 7705 -3044 7782 -2876 7774 -2887 7806
- -2817 95 { m20} R 0 0.8 0.29091 c 1288 1752 883 1714 1347 1643 1358 1695 1189
- 1591 461 1666 1303 1705 7784 -2894 1304 1586 7785 -2895 7765 -2933 1661 1509
- 7732 -3021 7741 -3001 1108 1782 7816 -2817 1228 1597 7743 -2999 7797 -2852 7804
- -2840 7869 -2700 1071 1750 1088 1715 7771 -2939 7728 -3026 7796 -2865 7758
- -2958 7754 -2971 7717 -3048 7741 -3003 7831 -2783 7712 -3055 1400 1686 7836
- -2783 7737 -3004 7757 -2954 7825 -2795 834 1797 7852 -2744 774 1776 1233 1771
- 1168 1668 7783 -2897 7817 -2829 7726 -3034 7732 -3016 7746 -2976 7834 -2791
- 7835 -2788 7794 -2883 7882 -2672 7822 -2796 7795 -2880 1083 1729 1323 1620 7830
- -2775 7830 -2787 1024 1796 1438 1669 1230 1722 7896 -2627 7735 -3007 1331 1764
- 1196 1747 1205 1739 7834 -2770 7687 -3111 1172 1738 1160 1609 1050 1729 1338
- 1646 7728 -3029 7829 -2780 1343 1666 1129 1786 1242 1704 7867 -2697 7831 -2797
- 7752 -2978 7741 -3002 7825 -2790 7830 -2794 7811 -2834 1437 1693 7797 -2869
- 7781 -2909 7783 -2892 1716 1448 7824 -2791 1370 1664 1300 1600 7749 -2980 1074
- 1766 7847 -2756 7746 -2976 7749 -2985 1424 1720 1207 1585 7773 -2913 1172 1737
- 100 { m20} R 1417 1757 7804 -2862 7841 -2774 7809 -2835 7870 -2698 7823 -2806
- 7821 -2820 7754 -2972 7898 -2635 935 1811 7869 -2699 1400 1578 7785 -2897 7776
- -2927 1343 1654 7808 -2852 1144 1652 1215 1739 1185 1728 7792 -2889 1388 1661
- 1289 1696 7776 -2918 7722 -3039 7798 -2863 7806 -2843 7773 -2933 1075 1629 1154
- 1662 7750 -2971 7757 -2953 7738 -3009 1218 1729 7717 -3050 1041 1661 7822 -2802
- 1329 1730 7884 -2663 1096 1642 1271 1594 7709 -3062 7697 -3091 1088 1670 1171
- 1709 7816 -2823 1331 1744 7776 -2923 1213 1642 1153 1697 7739 -3007 7730 -3020
- 7735 -3014 1212 1690 7859 -2722 7806 -2855 7848 -2748 7836 -2772 7718 -3046
- 1549 1691 7906 -2615 1274 1619 727 1701 7816 -2827 7835 -2785 7840 -2771 1122
- 1716 7795 -2879 7826 -2805 1245 1742 1496 1730 1037 1700 7774 -2930 7827 -2788
- 1277 1683 7778 -2913 7867 -2706 1089 1627 7829 -2792 1208 1603 971 1658 7876
- -2690 1296 1667 1269 1643 1217 1650 1054 1780 7801 -2854 7738 -3000 7820 -2820
- 7719 -3048 7751 -2971 7805 -2855 1227 1599 1260 1662 7772 -2924 1192 1741 7858
- -2732 7839 -2776 7741 -3001 7844 -2756 1541 1616 100 { m20} R 1244 1702 7793
- -2882 1295 1716 7790 -2887 1279 1765 1274 1736 7799 -2873 1331 1675 1564 1672
- 7804 -2855 7829 -2781 867 1708 1125 1622 7757 -2955 815 1669 7730 -3015 1288
- 1622 7816 -2830 1445 1644 7791 -2871 1327 1672 7755 -2954 7864 -2699 1227 1712
- 7759 -2944 1378 1703 1216 1744 1521 1673 7854 -2725 7837 -2783 1175 1691 1091
- 1789 1242 1656 7795 -2863 34 { m20} R 0 0.8 0.14545 c 7795 -2891 7839 -2793
- 7750 -2985 7886 -2675 7791 -2901 7822 -2826 7831 -2805 7788 -2905 1358 1795
- 7783 -2917 1483 1859 7877 -2701 718 1851 7870 -2718 7861 -2738 1392 1798 7794
- -2889 1123 1831 7805 -2873 1469 1864 1248 1851 1275 1876 7828 -2818 7878 -2693
- 1398 1895 1680 1650 7848 -2763 1256 1835 1095 1830 7795 -2890 7833 -2801 7828
- -2819 1350 1858 1497 1868 1447 1822 1474 1797 1322 1855 1482 1856 7872 -2710
- 7874 -2703 1326 1783 7790 -2898 7774 -2934 1425 1808 7804 -2867 905 1934 941
- 1825 1228 1855 7814 -2852 7862 -2742 7864 -2724 969 1833 7822 -2830 7782 -2918
- 7785 -2914 1206 1788 1278 1829 7787 -2909 1719 1692 1875 1619 1126 1865 1290
- 1841 1461 1873 7782 -2919 1009 1857 792 1927 959 1845 7789 -2905 7877 -2700
- 7866 -2726 1238 1900 7797 -2888 7899 -2647 7807 -2867 1091 1893 7813 -2842 7789
- -2903 7819 -2841 1265 1794 1345 1887 7828 -2817 1407 1859 1379 1892 1367 1811
- 1246 1782 7797 -2887 7901 -2634 7832 -2803 7758 -2969 7848 -2776 1290 1788 7902
- -2649 1102 1924 962 1830 1381 1883 7796 -2888 1324 1885 1315 1801 7869 -2717
- 1366 1788 100 { m20} R 7795 -2894 1572 1774 7789 -2906 1068 1824 1431 1788 7794
- -2896 1111 1848 7757 -2970 1229 1901 1342 1819 1343 1853 1142 1872 1410 1823
- 7850 -2761 7775 -2935 7843 -2779 7829 -2819 1343 1872 1138 1792 7831 -2812 1466
- 1883 7815 -2850 1138 1830 7839 -2792 7865 -2735 7851 -2754 7871 -2714 1225 1870
- 7829 -2818 925 1914 1171 1904 7780 -2922 7863 -2733 1168 1845 948 1888 7895
- -2659 1344 1897 1263 1856 1388 1875 7855 -2760 1275 1871 1521 1845 1417 1875
- 7779 -2923 7875 -2698 7794 -2892 7897 -2656 7886 -2683 1343 1862 7762 -2960
- 7763 -2956 7821 -2825 1168 1806 1379 1889 7805 -2864 931 1870 1333 1865 1293
- 1798 1294 1873 7853 -2756 7869 -2722 1490 1859 7829 -2816 1367 1893 7845 -2775
- 7854 -2757 7820 -2838 1124 1827 1403 1792 7797 -2884 7789 -2903 7863 -2731 7822
- -2824 1406 1813 7834 -2804 7795 -2888 1553 1822 1544 1765 7886 -2679 7879 -2696
- 7788 -2907 1183 1879 7847 -2777 7887 -2679 772 1919 1087 1828 7810 -2861 1450
- 1801 1230 1792 7846 -2776 7802 -2879 1022 1893 1108 1912 1260 1841 1225 1781
- 7775 -2935 7769 -2945 1464 1862 1547 1810 1307 1844 100 { m20} R 1015 1892 7865
- -2730 1373 1873 7834 -2800 1435 1879 1382 1864 1180 1841 1231 1870 7805 -2871
- 7762 -2961 7860 -2745 7823 -2832 7869 -2723 1307 1848 1055 1831 7864 -2733 7771
- -2942 7877 -2699 7827 -2824 1606 1730 7789 -2905 7885 -2676 7848 -2772 7827
- -2819 1493 1746 1262 1793 7846 -2781 1098 1825 7806 -2863 1362 1789 7816 -2849
- 1158 1862 7880 -2695 1259 1794 1172 1811 7828 -2819 1436 1872 7785 -2913 1386
- 1848 7860 -2735 1397 1806 7815 -2850 7815 -2850 1162 1881 1247 1816 7749 -2987
- 7836 -2803 7821 -2836 7874 -2713 7826 -2820 7787 -2909 7885 -2686 7802 -2874
- 1271 1883 1366 1806 55 { m20} R 0 0.8 0.4069E-06 c 1314 1985 1481 1962 1070
- 1964 1391 1951 7851 -2780 7836 -2811 7864 -2750 7858 -2765 1435 1945 1235 1947
- 1180 1965 7850 -2773 7861 -2748 1081 1987 1667 1841 7860 -2760 7907 -2638 1413
- 1976 1457 1912 995 1982 1641 1809 1101 1938 1483 1902 7872 -2730 1483 1887 1204
- 1911 7808 -2867 1335 1927 7867 -2742 1181 1956 7841 -2800 1585 1906 1273 1907
- 7819 -2846 1224 1905 1384 1960 7869 -2733 7857 -2758 1446 1962 1380 1914 1412
- 1984 1515 1949 7822 -2837 1128 1998 1196 1947 7861 -2747 1059 2020 7855 -2766
- 1331 1992 910 1970 7833 -2815 886 1955 961 1958 7855 -2768 7829 -2825 7854
- -2770 1153 1988 7838 -2804 1150 2019 7871 -2733 7852 -2776 7818 -2847 1224 1940
- 7839 -2803 7885 -2695 1617 1848 1408 1967 1355 1922 7900 -2660 7812 -2859 1069
- 2005 1456 1919 1529 1911 7856 -2767 1545 1953 1207 1952 7862 -2746 1315 1906
- 7860 -2760 7892 -2681 7868 -2739 7862 -2755 1547 1940 7855 -2768 7856 -2769
- 7832 -2814 7842 -2795 7834 -2813 1413 1946 1417 1957 1513 1893 7904 -2650 1442
- 1968 1272 1981 7829 -2825 1493 1971 7875 -2724 1209 1944 7853 -2773 1435 1980
- 100 { m20} R 7819 -2844 1537 1872 1242 1969 7893 -2670 7863 -2752 7822 -2839
- 930 2029 7896 -2670 1459 1933 1564 1914 1782 1707 1469 1957 1060 1959 7868
- -2741 7802 -2880 1339 1960 1272 1973 1552 1888 7880 -2705 7859 -2753 1260 1985
- 7853 -2771 7843 -2795 1048 1989 7829 -2821 7835 -2810 7870 -2725 7874 -2716
- 1345 1947 7834 -2812 1096 1986 7813 -2858 7818 -2847 1460 1904 7857 -2761 1332
- 1984 7854 -2771 1363 1962 903 2023 7869 -2734 1621 1828 1119 1942 1467 1970
- 7835 -2809 1259 1903 7859 -2751 1668 1838 7821 -2842 1385 1908 1377 1981 7885
- -2699 1320 1927 7861 -2757 908 1947 7830 -2823 7880 -2706 7876 -2716 7845 -2786
- 7831 -2818 7865 -2742 1169 2009 7829 -2821 1181 1927 1408 1909 1289 1939 1203
- 1948 1243 1939 1259 1968 7860 -2757 1297 1926 1480 1925 1452 1951 1517 1871
- 1268 1933 7838 -2805 7824 -2832 1270 1899 7870 -2736 1325 1929 1375 1924 7835
- -2812 934 1998 7847 -2781 7851 -2775 7822 -2839 7837 -2808 1387 1988 1579 1893
- 7855 -2767 1280 1962 7852 -2775 7876 -2712 1533 1879 7832 -2819 7890 -2680 1756
- 1775 1498 1952 1229 1971 7836 -2810 7829 -2825 100 { m20} R 1217 1952 1331 1961
- 1480 1957 7871 -2731 1367 1940 7828 -2827 1264 1948 7851 -2777 1437 1977 1224
- 1916 1356 1971 7845 -2793 1415 1908 7843 -2793 7836 -2811 1534 1957 1501 1899
- 7864 -2747 7870 -2737 1428 1973 1539 1959 1336 1913 1210 1973 7890 -2681 7854
- -2769 1170 1919 1239 1911 7845 -2790 1285 1933 1420 1913 7888 -2695 1448 1990
- 1334 1960 1651 1867 1422 1907 1330 1983 7906 -2646 7867 -2735 1471 1901 1126
- 1925 1202 1934 1304 1980 7880 -2710 7907 -2642 7872 -2728 7848 -2781 1327 1975
- 7841 -2799 1261 1985 7833 -2813 7865 -2745 7893 -2675 1388 1987 1342 1956 7856
- -2766 1347 1919 1291 1918 7861 -2758 1460 1967 7866 -2742 1207 1942 7851 -2770
- 7827 -2828 831 1976 1274 1936 1519 1914 7888 -2691 7834 -2810 1145 1925 1475
- 1956 7844 -2788 7850 -2776 1436 1954 7812 -2859 1637 1820 7883 -2703 7834 -2814
- 1464 1973 1099 1993 7880 -2706 1332 1985 1335 1924 82 { m20} R 0.14545 0.8 0 c
- 7906 -2659 1337 2033 1338 2045 7872 -2737 7871 -2737 7884 -2712 7907 -2658 1697
- 1924 1351 2046 7870 -2739 1531 2014 7857 -2767 1316 2052 7898 -2681 1487 2046
- 1895 1755 1301 2031 7871 -2739 7878 -2721 7877 -2726 1377 2072 1193 2021 1463
- 2005 1356 2006 1586 1964 7893 -2690 7855 -2772 1356 2066 7866 -2751 7889 -2700
- 7859 -2762 1687 1950 1329 2021 7887 -2703 7881 -2720 1401 2043 7871 -2741 7843
- -2797 1617 1936 7885 -2707 1389 2056 1325 2034 1435 2032 7866 -2747 7875 -2730
- 1422 2006 7864 -2754 1292 2071 1441 2006 7886 -2703 1225 2029 1296 2021 7843
- -2796 7889 -2695 7874 -2734 7883 -2711 932 2048 1381 2021 7877 -2727 7893 -2688
- 7880 -2721 7879 -2719 7882 -2716 1522 1997 7886 -2705 7875 -2731 1394 2004 1465
- 2054 1560 1954 1579 2006 1112 2089 1410 2039 1185 2078 7884 -2713 7865 -2753
- 1249 2048 1491 2058 7869 -2743 7897 -2682 7859 -2765 7907 -2660 1286 2065 7853
- -2775 7898 -2680 1495 2046 1362 2031 1410 2002 7866 -2751 7884 -2712 1309 2046
- 7906 -2661 1230 2075 1363 2036 1598 2003 1541 2026 7882 -2716 1135 2035 1454
- 2018 1549 2018 1382 2055 100 { m20} R 7907 -2659 1340 2069 7909 -2653 7876
- -2730 1491 1999 1573 1965 1229 2024 1190 2048 7869 -2744 1714 1891 7867 -2745
- 1292 2021 7905 -2656 7871 -2740 7900 -2677 1469 2068 1193 2058 7874 -2731 1718
- 1907 1279 2016 7882 -2714 7859 -2763 7887 -2700 7883 -2708 1351 2014 7864 -2755
- 7881 -2720 7899 -2677 7894 -2690 1657 1931 7881 -2713 1460 2052 7891 -2692 7870
- -2742 7863 -2753 1274 2062 1448 2018 1006 2067 1197 2086 1338 2021 1380 2001
- 1442 2065 7872 -2734 1325 2012 7881 -2713 7886 -2707 1961 1733 1532 1971 1577
- 1948 1330 2039 7896 -2683 1405 1997 1266 2069 7871 -2737 1220 2057 1321 2058
- 1523 2039 7870 -2741 7862 -2758 7866 -2751 1331 2026 1212 2037 7909 -2657 1391
- 2059 1638 1933 7905 -2665 1270 2068 7862 -2758 7891 -2690 1167 2084 7874 -2732
- 1653 1916 7865 -2750 1619 1992 7878 -2725 1512 2037 1424 2023 1410 2016 1288
- 2015 1194 2066 1658 1948 7875 -2727 1411 2056 7874 -2731 1290 1996 7907 -2651
- 1290 2017 1250 2018 1631 1957 106 1890 1505 2015 7889 -2697 1486 2003 7892
- -2689 7864 -2755 1369 2059 1190 2015 7881 -2718 1327 2016 7888 -2701 100 { m20
-} R 1617 1925 1320 2055 1453 2001 7868 -2744 1448 2008 7900 -2675 7847 -2789
- 1740 1864 1425 2062 1389 2014 7848 -2786 7868 -2746 1704 1895 1351 2024 1336
- 2045 1305 2020 1630 1952 7868 -2745 7901 -2671 1434 2065 1477 2060 7891 -2696
- 7889 -2702 1227 2077 1447 2046 1250 2039 7845 -2792 1308 2070 1350 2014 7905
- -2660 1354 2028 7875 -2728 1228 2035 7907 -2657 1276 2051 1460 1995 7905 -2665
- 7847 -2789 1688 1922 1500 2029 7891 -2693 1500 2016 1598 1990 7903 -2662 1711
- 1915 7908 -2655 1166 2021 7864 -2752 1545 2029 7892 -2693 50 { m20} R 0.29091
- 0.8 0 c 1831 1904 1165 2125 1587 2087 1735 1933 1443 2115 7881 -2720 1713 1996
- 1405 2136 1316 2133 1775 1926 1570 2049 7908 -2661 1444 2114 7904 -2672 1456
- 2086 1611 2074 1286 2096 1551 2042 7898 -2683 1520 2102 1537 2070 1520 2095
- 1416 2128 1471 2087 1136 2127 1336 2133 1573 2079 1518 2080 7882 -2719 1444
- 2096 7895 -2690 1518 2105 7882 -2718 1686 2011 7894 -2693 1438 2132 7908 -2659
- 7884 -2713 1506 2059 7878 -2725 1680 2025 1365 2090 1555 2040 1411 2090 7905
- -2669 1371 2119 1328 2123 1696 2027 1099 2120 1879 1893 7874 -2734 1424 2085
- 1314 2092 7894 -2693 7896 -2687 1434 2125 1472 2086 1498 2070 1488 2105 1357
- 2138 1267 2138 1542 2072 7904 -2672 1808 1900 1677 2039 7905 -2670 1328 2129
- 1592 2053 7879 -2723 1418 2097 1398 2122 1517 2091 1627 2002 7884 -2714 1524
- 2108 1315 2080 1346 2087 1474 2091 7892 -2698 1489 2065 7876 -2731 1612 2028
- 1746 1950 7907 -2663 1406 2113 1454 2075 1218 2108 7893 -2695 7898 -2681 1427
- 2124 7893 -2694 7896 -2689 1507 2072 1494 2112 7900 -2681 7899 -2680 7899 -2682
- 1518 2114 1532 2103 1489 2094 100 { m20} R 1486 2071 1536 2065 7909 -2657 1869
- 1847 1470 2135 7897 -2688 1336 2119 1349 2111 1364 2091 7899 -2683 7906 -2668
- 1284 2126 7904 -2672 7889 -2703 1363 2084 1541 2071 7902 -2676 7891 -2698 1759
- 1926 1318 2100 7871 -2741 7888 -2705 1624 2062 1241 2117 1415 2105 1394 2133
- 1515 2100 1502 2069 1368 2078 1332 2136 1336 2094 1353 2127 1725 1990 1377 2134
- 1450 2089 1569 2071 1394 2118 1253 2084 1384 2095 7894 -2694 7899 -2682 1594
- 2027 1708 1952 1274 2090 1370 2083 1342 2076 1206 2142 7899 -2681 7875 -2732
- 1535 2070 1700 1984 1325 2119 7903 -2672 7874 -2735 1243 2105 7900 -2678 1338
- 2137 7897 -2688 1276 2114 1479 2133 1526 2099 1425 2132 1397 2076 7899 -2682
- 1478 2076 7889 -2704 7874 -2734 7887 -2707 1503 2074 1374 2088 7905 -2670 7909
- -2659 1478 2133 7893 -2694 1306 2133 1404 2139 1418 2085 1331 2094 1460 2098
- 7885 -2712 1345 2125 1554 2106 1323 2085 7906 -2669 7893 -2695 1085 2137 1393
- 2137 7894 -2694 1422 2100 1572 2080 1481 2076 1410 2093 1463 2090 1325 2086
- 7904 -2669 7889 -2704 1765 1941 7887 -2708 7899 -2683 1690 1991 100 { m20} R
- 7902 -2676 7903 -2673 7887 -2708 1172 2132 1694 2026 1368 2093 7890 -2701 1615
- 2013 1469 2118 9 { m20} R 0.43636 0.8 0 c 1585 2098 1372 2184 1484 2160 1457
- 2149 1239 2164 7902 -2677 1367 2155 1325 2187 1489 2166 1511 2172 1362 2149
- 7908 -2666 1505 2135 1358 2162 1408 2140 1514 2184 1155 2179 1367 2152 1543
- 2146 1563 2150 7906 -2669 1598 2092 1586 2099 1481 2172 1476 2153 1400 2189
- 1650 2100 1230 2165 1644 2111 7909 -2663 7904 -2674 1919 1891 1323 2179 7908
- -2665 1415 2154 1391 2159 1457 2148 1494 2154 1540 2152 1512 2140 1434 2183
- 7897 -2688 1406 2189 1453 2150 1574 2158 1490 2160 7899 -2685 1529 2162 1414
- 2184 1689 2037 1593 2139 1770 2004 1496 2184 1664 2086 1466 2181 1556 2148 1362
- 2194 1329 2162 1534 2141 1380 2174 1451 2182 1806 1980 1223 2152 1516 2146 1513
- 2183 1567 2162 1583 2126 1340 2184 1592 2123 1381 2148 1507 2149 1547 2161 1311
- 2170 1602 2132 1747 2012 1373 2171 1547 2128 1494 2184 1462 2194 1398 2181 1497
- 2143 1327 2181 7902 -2678 1483 2138 1558 2148 1306 2194 1333 2147 1506 2181
- 1427 2180 1604 2095 1683 2041 1446 2187 1380 2189 1378 2179 1378 2164 1560 2157
- 1411 2140 7907 -2667 1561 2164 1401 2191 100 { m20} R 7908 -2665 1392 2154 1555
- 2141 1471 2165 1450 2186 1406 2191 1405 2169 1639 2073 7899 -2684 7898 -2685
- 1381 2177 1484 2168 1656 2081 1519 2177 1398 2168 1629 2116 1438 2143 1288 2193
- 1440 2176 1270 2175 1087 2237 2384 1543 1339 2140 1367 2190 1387 2166 1568 2153
- 1563 2115 1628 2130 1406 2187 1292 2195 1458 2153 1504 2130 1351 2168 1466 2174
- 1456 2147 1445 2185 1452 2160 1519 2179 1488 2170 1639 2079 1461 2159 1672 2077
- 1502 2146 1361 2179 1479 2169 1463 2193 1321 2191 1623 2100 1476 2184 49 { m20
-} R 0.58182 0.8 0 c 1436 2226 1448 2200 1359 2230 1535 2178 1416 2203 1468 2242
- 1380 2203 1392 2238 1507 2221 1364 2234 1551 2188 1378 2196 1471 2238 1545 2177
- 1525 2191 1390 2223 1406 2211 1536 2193 1498 2219 1459 2222 1515 2205 1473 2212
- 1421 2244 1517 2220 1458 2205 1492 2206 1454 2204 1381 2209 1429 2242 1325 2213
- 1400 2200 1541 2197 1472 2237 1512 2217 1459 2201 1546 2194 1422 2201 1475 2237
- 1376 2197 1378 2239 1398 2240 1478 2216 1532 2204 1444 2235 1451 2228 1526 2181
- 1445 2237 1455 2233 1522 2200 1382 2201 1462 2242 1498 2213 1431 2244 1415 2242
- 1545 2193 1405 2243 1526 2187 1496 2222 1515 2195 1452 2224 1416 2216 1486 2194
- 1390 2223 1494 2233 1358 2210 1447 2238 1283 2230 1352 2206 1479 2196 1370 2206
- 1322 2242 1570 2173 1462 2229 1420 2230 1583 2165 1515 2212 1346 2200 1434 2233
- 1320 2197 1557 2175 1328 2207 1215 2231 1478 2207 1514 2219 1383 2209 1453 2238
- 1313 2229 1456 2213 1452 2216 1573 2173 1414 2234 1511 2196 92 { m20} R 0.72727
- 0.8 0 c 1423 2277 1450 2267 1396 2287 1467 2249 1420 2273 1441 2277 1444 2265
- 1424 2288 1456 2268 1453 2252 1322 2261 1249 2279 1489 2243 1404 2276 1436 2265
- 1253 2279 1388 2245 1315 2278 1443 2263 1449 2269 1355 2258 1398 2257 1345 2250
- 1431 2257 1454 2269 1330 2286 1420 2266 1361 2281 1325 2259 1445 2266 1337 2271
- 1418 2265 1377 2248 1431 2255 1416 2254 1315 2261 1438 2288 37 { m20} R 0.8
- 0.72727 0 c 1389 2323 1401 2293 1330 2298 1404 2304 1361 2317 1372 2296 1408
- 2293 1410 2298 1403 2312 1385 2326 1429 2292 1373 2304 1322 2328 1380 2320 1398
- 2327 1349 2319 1414 2314 1431 2299 18 { m20} R 0.8 0.58182 0 c 1393 2340 1356
- 2345 1362 2334 1321 2346 4 { m20} R 0.8 0.43636 0 c 1393 2340 0.8 0.29091 0 c
- 1393 2340 0.8 0.14546 0 c 1393 2340 0 0 0.8 c 1393 2340 0 0.14545 0.8 c 1393
- 2340 0 0.29091 0.8 c 1393 2340 0 0.43636 0.8 c 7145 -3059 7312 -3006 7467 -2940
- 7454 -2934 7745 -2724 5 { m20} R 0 0.58182 0.8 c 7338 -3073 7263 -3064 7527
- -2993 7197 -3121 7578 -2937 7549 -2946 7462 -3018 7779 -2717 7521 -2963 7619
- -2917 7620 -2925 7705 -2828 7201 -3121 7499 -3012 14 { m20} R 0 0.72727 0.8 c
- 7622 -2950 7321 -3162 7537 -3013 7643 -2926 7390 -3143 7578 -3012 7591 -2975
- 7504 -3060 7645 -2958 7635 -2972 7312 -3123 7559 -3047 7450 -3099 7685 -2892
- 7771 -2776 7710 -2866 7377 -3222 7669 -2906 7654 -2930 7327 -3254 7758 -2796
- 7661 -2915 7572 -2996 7499 -3030 7526 -3079 7468 -3048 7563 -3070 7600 -3016
- 7671 -2907 7500 -3130 7583 -3028 7702 -2885 7684 -2899 7726 -2814 7564 -3060
- 7521 -3108 7595 -2982 7792 -2733 7350 -3243 7492 -3105 7667 -2938 7545 -3037
- 7627 -2941 7268 -3247 7680 -2898 45 { m20} R 0 0.8 0.72727 c 7431 -3296 7516
- -3177 7734 -2884 7385 -3443 7591 -3082 7519 -3142 7669 -3011 7456 -3205 7483
- -3174 7594 -3085 7537 -3115 7622 -3041 7737 -2872 7696 -2943 7467 -3264 7416
- -3341 7673 -3002 7729 -2880 7490 -3250 7632 -3045 7662 -3025 7528 -3159 7643
- -2989 7319 -3329 7706 -2887 7762 -2829 7408 -3346 6954 -3568 7511 -3282 7671
- -2987 7419 -3357 7643 -3028 7686 -2979 7537 -3121 7596 -3063 7655 -3007 7639
- -3041 7545 -3200 7176 -3521 7555 -3125 7465 -3186 7589 -3132 7622 -3008 7387
- -3300 7536 -3128 7784 -2784 7482 -3223 7667 -3008 7533 -3241 7806 -2730 7657
- -3035 7598 -3039 7715 -2926 7671 -2986 7311 -3410 7702 -2947 7718 -2904 7560
- -3171 7537 -3140 7420 -3222 7739 -2881 7760 -2811 7563 -3146 7568 -3125 7524
- -3244 7336 -3512 7465 -3298 7588 -3066 7611 -3039 7712 -2909 7579 -3150 7519
- -3281 7673 -2982 7511 -3154 7487 -3286 7499 -3304 7558 -3171 7640 -3063 7711
- -2931 7321 -3319 7718 -2922 7577 -3067 7614 -3059 7687 -2921 7496 -3268 7690
- -2962 7652 -2999 7664 -2972 88 { m20} R 0 0.8 0.58182 c 7406 -3477 7606 -3208
- 7609 -3224 7568 -3313 7585 -3253 833 1241 7708 -3002 7737 -2916 7667 -3079 7734
- -2947 7654 -3132 7663 -3059 1300 960 7474 -3444 7670 -3033 7706 -3002 7687
- -3060 7652 -3073 7678 -3023 7746 -2900 7655 -3049 7603 -3155 7647 -3112 7797
- -2789 7732 -2956 7551 -3315 7723 -2921 830 1008 7547 -3274 7573 -3284 7597
- -3201 7445 -3569 7673 -3066 7026 -3814 7732 -2928 7737 -2915 7359 -3535 7617
- -3175 7727 -2926 7568 -3257 7741 -2896 7429 -3507 7707 -2999 7563 -3271 7275
- -3645 1269 1190 1349 1195 6782 -3940 7632 -3092 6942 -4615 7663 -3054 7597
- -3213 7629 -3133 7637 -3121 7609 -3202 7727 -2929 7683 -2995 7799 -2810 7674
- -3077 7525 -3435 7775 -2863 7510 -3338 7729 -2926 1327 1033 7807 -2759 7627
- -3171 7770 -2854 7798 -2784 7780 -2854 7329 -3810 7619 -3212 7658 -3085 7849
- -2695 7254 -3692 7640 -3103 7739 -2941 7704 -3007 7719 -2951 7567 -3296 7693
- -3048 7791 -2806 7250 -3966 7524 -3319 7500 -3408 7783 -2826 7735 -2896 7682
- -3026 7703 -2966 7638 -3098 7599 -3185 1123 1200 7827 -2742 7725 -2945 7748
- -2904 7798 -2792 7283 -3756 7659 -3114 7779 -2846 7692 -3049 7677 -3060 100 {
- m20} R 7497 -3425 798 1125 7621 -3113 7413 -3460 1301 932 7587 -3220 1140 1063
- 7488 -3384 7646 -3127 7592 -3233 7658 -3094 973 1100 7665 -3037 7624 -3209 7556
- -3234 7140 -3718 7573 -3257 7670 -3066 1293 1126 7758 -2873 7584 -3232 7522
- -3349 7709 -3007 7755 -2861 7706 -3004 7649 -3086 7719 -2957 7389 -3518 7705
- -2978 7574 -3316 7530 -3351 7710 -2988 7525 -3367 1104 1121 7449 -3480 7744
- -2898 6941 -4290 7659 -3111 38 { m20} R 0 0.8 0.43636 c 7815 -2787 7633 -3197
- 7665 -3153 1507 1501 7741 -2986 7764 -2926 7530 -3428 7756 -2928 7710 -3029
- 7694 -3078 7794 -2844 980 1573 953 1602 7710 -3040 7609 -3260 1137 1551 7661
- -3127 7619 -3243 7730 -3005 1151 1411 1416 1427 7724 -3010 7802 -2809 7743
- -2943 7760 -2931 7782 -2862 7627 -3219 7696 -3045 7620 -3218 1143 1568 1122
- 1338 7732 -2964 7777 -2881 7685 -3105 1107 1379 7721 -3029 7691 -3076 7808
- -2822 7772 -2901 7769 -2898 1153 1386 7733 -2985 1362 1304 7708 -3039 7677
- -3107 7696 -3078 7797 -2840 7720 -3020 7789 -2853 7778 -2893 7781 -2859 7875
- -2664 7778 -2870 7720 -3014 7849 -2727 7710 -3046 1136 1329 7818 -2794 7768
- -2907 7713 -3013 1251 1397 7760 -2901 7614 -3234 7817 -2785 1289 1526 7836
- -2751 7705 -3059 7781 -2872 7670 -3143 7759 -2918 7688 -3084 7708 -3027 758
- 1331 7781 -2858 7704 -3028 470 1431 436 1229 7779 -2867 7679 -3117 7735 -2998
- 7789 -2856 7846 -2728 1047 1498 7703 -3030 7749 -2944 7680 -3086 7747 -2937
- 7686 -3066 7636 -3214 7811 -2797 997 1564 7679 -3108 7687 -3098 7681 -3119 1055
- 1565 7765 -2903 1437 1541 7689 -3104 1076 1271 7706 -3066 100 { m20} R 7717
- -3012 829 1331 7678 -3119 1185 1520 7616 -3230 7803 -2811 7688 -3086 7766 -2914
- 7811 -2816 890 1441 1311 1474 7758 -2912 1234 1293 7762 -2901 7744 -2940 7681
- -3082 7666 -3131 7762 -2913 7682 -3121 7672 -3101 7700 -3044 7764 -2901 1024
- 1512 1323 1506 7648 -3186 1141 1476 1106 1591 7798 -2846 7775 -2870 1147 1570
- 7700 -3070 7669 -3132 7743 -2970 7664 -3156 1293 1522 7713 -3005 1269 1516 7755
- -2929 564 1239 7761 -2933 7645 -3161 7704 -3071 7700 -3073 7607 -3273 7588
- -3308 7725 -3023 334 1430 7836 -2744 7699 -3042 1236 1405 1290 1529 7717 -3014
- 1278 1413 7601 -3286 7753 -2948 901 1614 7835 -2760 7744 -2945 7645 -3170 7805
- -2824 7715 -3018 7691 -3083 7734 -2964 1418 1389 1319 1478 7597 -3276 1141 1514
- 7624 -3237 7763 -2925 7752 -2958 7722 -3018 7788 -2868 1280 1379 7815 -2792
- 7728 -3011 7754 -2925 1215 1570 7675 -3125 7716 -3004 7725 -2986 1356 1483 1092
- 1271 1330 1293 7784 -2852 1201 1541 1166 1532 7587 -3307 7609 -3269 7586 -3314
- 7762 -2909 7611 -3263 7670 -3138 7740 -2967 7779 -2857 1248 1573 7754 -2916
- 7762 -2905 7660 -3164 7671 -3131 7816 -2801 100 { m20} R 7647 -3165 1110 1236
- 1246 1300 794 1493 7717 -3025 7734 -2998 7554 -3381 1254 1461 1415 1558 7672
- -3126 1129 1485 7762 -2910 12 { m20} R 0 0.8 0.29091 c 7683 -3120 7746 -2992
- 7794 -2870 7765 -2950 1274 1710 7794 -2885 7785 -2902 1456 1631 7715 -3052 7737
- -3010 1234 1721 1244 1695 1147 1776 1076 1770 7800 -2863 1314 1660 1420 1644
- 1245 1652 7780 -2911 7778 -2905 1449 1653 7748 -2976 7856 -2724 1210 1736 7856
- -2727 1348 1626 7786 -2879 1078 1750 1228 1757 7852 -2726 7779 -2920 7753 -2970
- 1355 1724 7839 -2760 1393 1708 7853 -2736 7871 -2700 7793 -2885 7791 -2874 7781
- -2914 981 1710 7824 -2804 1443 1710 7739 -3004 7798 -2871 7800 -2869 7732 -3020
- 834 1815 1338 1727 7743 -2996 1399 1713 7789 -2888 7774 -2912 7855 -2732 1309
- 1714 7769 -2940 7835 -2765 7815 -2821 7704 -3077 750 1767 1372 1673 1106 1622
- 990 1636 833 1663 1289 1659 1554 1631 7746 -2993 7754 -2957 7746 -2987 1310
- 1707 1268 1583 1552 1560 7802 -2853 7790 -2895 1040 1780 7784 -2887 1323 1690
- 990 1659 7774 -2921 7792 -2869 7859 -2715 327 1558 1181 1709 1141 1772 7776
- -2926 7847 -2758 1047 1630 1455 1680 1234 1700 830 1780 7772 -2930 878 1649
- 7772 -2914 1304 1623 1356 1713 7849 -2742 1137 1686 1141 1691 1311 1768 7743
- -2996 100 { m20} R 7832 -2791 1291 1741 7797 -2872 7845 -2745 7786 -2881 7804
- -2853 1237 1723 7720 -3039 7828 -2803 7884 -2655 7736 -3012 7826 -2793 1115
- 1772 1118 1729 1453 1661 1190 1660 7797 -2860 888 1713 7779 -2904 875 1813 1169
- 1724 7736 -3007 1228 1753 1304 1692 1288 1589 7764 -2931 1510 1545 7754 -2964
- 7693 -3099 7705 -3074 7768 -2944 7727 -3029 7812 -2840 929 1698 1680 1428 7702
- -3079 7821 -2814 1013 1774 1497 1686 7891 -2652 1036 1684 1192 1757 7803 -2864
- 7836 -2761 7786 -2884 7807 -2846 7779 -2895 7744 -2996 7837 -2772 7728 -3019
- 7778 -2905 7754 -2973 1407 1706 7833 -2777 7729 -3025 7845 -2764 7792 -2871
- 7707 -3072 7819 -2813 7816 -2819 7725 -3034 1436 1744 1075 1752 7803 -2840 7767
- -2939 7734 -3016 1321 1639 1249 1761 7820 -2819 7711 -3056 7789 -2895 7739
- -3006 1706 1591 7792 -2885 825 1699 7708 -3068 1485 1603 7777 -2916 7677 -3131
- 7752 -2980 7864 -2702 1175 1776 7769 -2924 1403 1733 7777 -2925 1309 1706 1315
- 1764 1378 1710 7748 -2989 7772 -2913 7736 -3013 7751 -2980 7798 -2861 7758
- -2968 1493 1701 1200 1756 7733 -3008 7762 -2937 977 1740 7739 -2999 100 { m20
-} R 7836 -2783 1219 1709 7750 -2984 1001 1775 1280 1677 7783 -2902 7814 -2823
- 7746 -2989 7799 -2850 1296 1659 7788 -2876 7855 -2725 1085 1620 1440 1730 7785
- -2886 1286 1600 7860 -2711 7846 -2752 7831 -2791 7759 -2948 1271 1589 7713
- -3059 1402 1707 7746 -2984 7786 -2886 7830 -2782 762 1736 7795 -2883 7854 -2726
- 7815 -2824 1204 1718 927 1674 7779 -2921 7833 -2787 1261 1724 7702 -3081 1066
- 1802 913 1820 7801 -2849 1592 1617 7735 -3004 7758 -2954 7776 -2918 7723 -3040
- 1246 1583 1617 1665 1327 1687 1269 1699 1110 1616 7740 -2987 1405 1595 7786
- -2890 7841 -2770 7740 -3000 1419 1594 7726 -3032 1331 1714 57 { m20} R 0 0.8
- 0.14545 c 1172 1812 7880 -2690 7879 -2690 7858 -2738 7779 -2924 1189 1835 7835
- -2805 904 1922 1149 1898 7796 -2891 1135 1838 7847 -2769 7830 -2808 7788 -2905
- 1543 1783 1285 1869 1309 1856 1301 1808 7803 -2872 7813 -2851 1490 1847 1477
- 1825 7855 -2747 1242 1808 1342 1808 671 1794 1153 1871 1327 1876 1121 1794 1252
- 1876 7780 -2925 1601 1804 7883 -2679 1500 1866 847 1832 1230 1862 7813 -2853
- 1421 1885 7813 -2855 1936 1580 1276 1776 859 1831 1203 1874 1581 1786 1681 1741
- 7888 -2672 7856 -2742 1108 1913 7896 -2658 7820 -2839 1552 1774 7856 -2747 1202
- 1870 7886 -2678 893 1865 7803 -2876 7824 -2823 7789 -2903 7885 -2688 7867 -2729
- 7858 -2751 1483 1811 1601 1764 7899 -2641 1289 1795 622 1897 7822 -2824 7809
- -2854 1237 1869 7856 -2757 7900 -2640 1149 1805 1612 1814 7882 -2687 7823 -2820
- 7877 -2693 7763 -2958 7805 -2866 7823 -2832 7790 -2903 7803 -2868 7876 -2707
- 1114 1861 7801 -2873 1448 1861 7771 -2942 7866 -2729 1291 1897 7881 -2685 945
- 1881 7808 -2862 1357 1811 7752 -2980 1695 1717 7891 -2674 1400 1771 7834 -2806
- 1292 1862 7762 -2960 7875 -2707 100 { m20} R 1371 1882 7773 -2935 944 1825 1200
- 1806 1045 1866 7817 -2839 1398 1890 1515 1779 1477 1798 1223 1878 7851 -2753
- 7811 -2858 1282 1856 7830 -2818 1259 1885 7799 -2883 7761 -2961 7780 -2924 7795
- -2889 1075 1838 1412 1882 7861 -2740 1114 1899 1275 1853 1097 1808 7864 -2734
- 7830 -2811 7868 -2718 1254 1863 7841 -2776 811 1866 7838 -2793 7767 -2950 7853
- -2749 1503 1828 7860 -2737 7821 -2826 7817 -2843 7907 -2623 1231 1869 7806
- -2864 7888 -2679 1558 1768 7832 -2805 1268 1827 7758 -2968 1130 1883 1696 1705
- 7811 -2847 1329 1803 7797 -2881 1586 1761 7804 -2873 7815 -2840 1229 1878 1054
- 1811 1251 1824 7866 -2717 1237 1795 7784 -2911 1442 1877 7765 -2955 1190 1878
- 7817 -2845 7768 -2948 1379 1811 7824 -2827 7821 -2824 7785 -2910 7873 -2703
- 7861 -2745 7829 -2806 7826 -2826 7821 -2837 7849 -2762 7839 -2795 1346 1788
- 1327 1878 7906 -2633 1346 1772 7819 -2839 7794 -2892 7826 -2818 7849 -2757 7832
- -2799 7890 -2671 7871 -2707 7778 -2925 1386 1869 7801 -2872 727 1901 7852 -2759
- 7800 -2878 7799 -2885 7822 -2835 766 1902 939 1846 7814 -2851 7840 -2784 7759
- -2966 100 { m20} R 1315 1803 718 1876 1089 1838 7800 -2879 7786 -2912 7886
- -2673 7847 -2771 1231 1888 1425 1792 7768 -2948 7867 -2721 7848 -2771 7861
- -2731 7824 -2830 7886 -2685 871 1870 1471 1883 7808 -2863 1535 1857 7785 -2911
- 7791 -2902 7802 -2877 7809 -2863 1430 1775 7802 -2871 7829 -2819 7832 -2809
- 1341 1875 7837 -2799 7856 -2746 7755 -2974 7774 -2936 1108 1906 7901 -2636 7845
- -2775 7794 -2894 7840 -2780 7880 -2688 944 1895 7807 -2868 7836 -2799 7781
- -2919 7779 -2926 7899 -2645 7792 -2898 1255 1806 1442 1843 1592 1808 7887 -2679
- 1220 1790 1258 1812 7840 -2786 7840 -2791 1357 1869 7825 -2822 7810 -2861 7890
- -2669 1678 1734 58 { m20} R 0 0.8 0.4069E-06 c 1486 1935 1440 1977 7848 -2784
- 1349 1982 1535 1939 1381 1916 7866 -2736 1356 1928 7867 -2743 1405 1966 1454
- 1969 7853 -2768 1705 1764 7832 -2818 1408 1986 7845 -2791 7875 -2720 1439 1972
- 1202 1948 7812 -2860 1280 1919 7856 -2766 7860 -2757 1280 1903 7837 -2810 7860
- -2751 7877 -2715 7908 -2639 1251 1961 1170 2015 7900 -2658 7850 -2779 7857
- -2765 7803 -2877 1161 1999 1257 1917 7844 -2793 7834 -2809 7850 -2782 1338 1928
- 1403 1970 1316 1921 1452 1974 7818 -2847 1399 1911 7839 -2803 7890 -2682 1080
- 2012 7894 -2668 1355 1987 7835 -2811 7872 -2731 1200 1942 1266 1984 7895 -2676
- 1289 1923 1181 1974 7901 -2657 7837 -2806 1241 1963 7865 -2742 7836 -2812 1440
- 1992 7838 -2801 7883 -2707 7850 -2780 1392 1926 1172 1988 1312 1919 1329 1915
- 1275 1972 1409 1946 1290 1919 1346 1989 1115 1990 1215 1917 1704 1788 1356 1977
- 1696 1862 7883 -2708 1642 1836 7885 -2696 1315 1987 1447 1940 1274 1910 1424
- 1916 7817 -2848 7833 -2816 1436 1953 7874 -2717 1367 1966 1230 1936 1298 1949
- 7864 -2747 1345 1909 7895 -2677 1263 1956 1128 1981 7812 -2859 1232 1927 100 {
- m20} R 1366 1903 7880 -2702 7898 -2665 7881 -2710 7844 -2792 7876 -2723 7863
- -2753 7864 -2742 1185 2009 1239 1999 1264 1937 7879 -2716 7860 -2753 1202 2000
- 1329 1982 7857 -2757 1318 1985 7829 -2824 7891 -2676 1426 1924 7870 -2729 7878
- -2715 1499 1961 7894 -2673 7883 -2708 7848 -2786 1456 1908 7841 -2796 1407 1974
- 7845 -2791 1292 1916 1355 1900 7852 -2769 1432 1992 1366 1909 1315 1929 7874
- -2727 806 2020 1309 1941 7821 -2841 7909 -2645 7868 -2736 1550 1949 1485 1942
- 7850 -2781 7828 -2827 1291 1988 1255 1978 1324 1906 7885 -2692 1331 1962 1340
- 1992 7890 -2688 7885 -2701 1645 1837 7854 -2772 7820 -2842 1348 1934 1513 1964
- 7826 -2828 7806 -2872 7888 -2691 1404 1921 7901 -2664 7850 -2779 1529 1905 1333
- 1930 1285 1914 1428 1927 1488 1963 1292 1919 7804 -2876 1119 1929 7826 -2829
- 1221 1975 7816 -2851 1478 1952 1451 1976 7901 -2660 1643 1841 1566 1938 7849
- -2773 1154 1964 7869 -2738 7886 -2692 1312 1942 1325 1976 1105 1964 1378 1915
- 1470 1925 7831 -2821 1193 1911 7848 -2784 1312 1930 7877 -2718 7868 -2732 7882
- -2698 1384 1962 7860 -2760 7876 -2720 100 { m20} R 7877 -2708 7823 -2837 7855
- -2767 1312 1992 1750 1798 1293 1963 7888 -2694 1144 2015 7859 -2760 1200 1990
- 1453 1898 1438 1966 7887 -2689 1385 1977 7836 -2806 7904 -2648 1372 1907 1464
- 1944 1589 1889 7847 -2780 1192 1999 1398 1971 1412 1955 7814 -2855 1244 1933
- 7855 -2767 7870 -2734 1544 1916 7853 -2768 1460 1989 1524 1939 1531 1871 1521
- 1894 7846 -2787 1588 1890 7889 -2691 1506 1935 7855 -2763 7882 -2701 1412 1996
- 7802 -2879 7901 -2662 1290 1980 7888 -2688 1591 1902 7850 -2780 1408 1967 1300
- 1900 7820 -2843 7899 -2663 7846 -2790 1045 1975 7838 -2802 1385 1905 1420 1990
- 7897 -2673 7897 -2672 1461 1907 7882 -2700 7904 -2650 1324 1913 7897 -2661 1366
- 1974 1442 1962 1484 1952 1252 1953 1463 1966 1302 1971 1445 1951 7901 -2655
- 7886 -2698 7832 -2817 1132 1946 1479 1976 1547 1909 75 { m20} R 0.14545 0.8 0 c
- 1100 2040 7888 -2701 7879 -2722 1247 2000 7870 -2742 7863 -2756 7905 -2664 1293
- 2052 1454 1992 7856 -2770 7883 -2713 1287 2059 1483 2043 1070 2045 1361 2051
- 7858 -2766 1326 2022 7864 -2751 7865 -2748 7863 -2754 1237 2067 7902 -2672 7884
- -2711 1272 2059 7909 -2646 7880 -2716 7849 -2785 1075 2045 1324 2059 1411 2060
- 1274 2054 1334 2035 7908 -2649 7898 -2678 1564 2033 1424 2063 1326 2042 1277
- 2071 1481 1990 1452 2014 1490 2015 1550 1991 1509 2045 1376 2014 7883 -2709
- 1294 2022 7867 -2749 7848 -2787 7858 -2767 7899 -2672 7901 -2675 1755 1866 1392
- 2068 1501 1999 1395 2059 1379 2062 1452 2009 1393 2074 1380 2018 1395 2038 7862
- -2758 7896 -2684 7846 -2790 1418 2019 7877 -2726 1289 2017 1526 2039 7898 -2679
- 1444 2029 1515 2045 7894 -2687 1281 2047 7888 -2701 7836 -2811 1382 2034 1415
- 2001 1286 2058 1549 2008 7873 -2733 1166 2039 1479 2063 7886 -2706 331 1954
- 7887 -2703 7877 -2721 1791 1820 1403 2055 7880 -2717 1373 2004 1385 2068 1160
- 2028 1602 2007 7893 -2686 1243 2064 7886 -2701 7891 -2692 7874 -2731 1353 2044
- 1332 2032 7900 -2670 100 { m20} R 7903 -2668 7901 -2667 1592 1949 7882 -2715
- 7882 -2717 7869 -2740 7861 -2760 7868 -2744 1379 2044 1606 1992 7876 -2724 1362
- 2004 7877 -2724 7885 -2709 1366 2067 1403 2034 1298 2069 1835 1830 1464 2061
- 1103 2063 7904 -2661 1438 2059 7908 -2657 1294 2068 1464 1989 7863 -2757 1670
- 1887 1417 2031 7904 -2663 7881 -2714 7903 -2668 7846 -2791 7882 -2716 1532 1982
- 7845 -2792 7865 -2750 1342 2066 1457 2057 1382 2014 1344 2024 7907 -2658 1209
- 2070 1309 2023 7876 -2727 7875 -2730 7868 -2746 895 2079 7882 -2716 7856 -2770
- 1483 1994 7876 -2724 1433 2065 1238 2043 1098 2077 1259 2032 1563 2012 7875
- -2731 7889 -2701 1332 2010 1378 2068 1381 2054 7881 -2716 7884 -2708 1493 1990
- 1569 1949 1585 1989 7875 -2726 7883 -2714 1299 2067 1975 1740 7908 -2653 7879
- -2719 1415 2056 1303 2000 7866 -2749 7897 -2679 1471 2061 7862 -2759 1503 2041
- 7867 -2748 7891 -2693 1201 2076 1362 2044 1490 2054 7877 -2726 1698 1907 1156
- 2039 7877 -2724 1536 2035 1288 2059 1571 1972 1362 2006 7862 -2757 1071 2059
- 7874 -2731 7865 -2750 1467 2015 7858 -2766 7879 -2723 1558 2030 100 { m20} R
- 7895 -2681 1421 2005 7839 -2804 7890 -2700 7889 -2699 1229 2062 7862 -2756 1580
- 2016 1509 2032 1279 2059 1126 2044 1309 2007 1404 2053 1514 2031 1365 2008 1388
- 2054 7874 -2733 7868 -2747 1602 1990 7867 -2747 7900 -2678 7857 -2769 7868
- -2746 7856 -2768 7876 -2730 7877 -2726 1542 2019 7865 -2752 1289 2056 1323 2012
- 1579 2018 915 2062 7880 -2717 1434 2073 7865 -2753 7890 -2695 7908 -2649 1757
- 1903 7906 -2659 7860 -2762 1415 2030 1399 2013 7901 -2670 934 2095 1341 2010
- 1596 1938 7904 -2667 1438 2031 7909 -2654 7872 -2736 1297 1998 1206 2050 1669
- 1941 1319 2064 7870 -2740 55 { m20} R 0.29091 0.8 0 c 1564 2061 1343 2077 1429
- 2099 7887 -2708 1659 2002 1237 2089 1352 2104 1219 2102 1363 2094 7905 -2669
- 7877 -2728 1449 2085 1686 2031 1540 2058 7896 -2689 1463 2095 7885 -2712 1633
- 2047 1277 2128 7899 -2681 1306 2085 7887 -2708 7899 -2680 7876 -2731 1668 2033
- 7894 -2692 1491 2116 1352 2118 1730 1934 1669 2020 1303 2098 1348 2078 7893
- -2695 7897 -2687 1606 2040 7906 -2663 1221 2137 1506 2097 7905 -2670 1410 2111
- 1202 2118 1657 2027 1368 2104 1491 2109 1346 2108 1612 2028 1455 2102 1443 2120
- 1318 2091 1581 2058 1333 2076 1525 2088 1534 2112 1479 2112 1527 2092 7882
- -2717 7895 -2693 1654 1988 7898 -2685 1344 2078 7907 -2666 7886 -2709 1552 2073
- 7898 -2684 1414 2114 1542 2071 1946 1832 7879 -2723 1365 2121 7877 -2728 7889
- -2704 7907 -2662 7894 -2691 1493 2125 1221 2147 1356 2133 1517 2057 7898 -2685
- 1307 2134 1461 2134 1356 2127 1345 2114 1394 2132 7887 -2709 7886 -2711 7883
- -2715 7893 -2696 1390 2099 7906 -2665 1521 2109 1497 2091 1935 1831 7892 -2695
- 1464 2092 1363 2078 7906 -2664 1733 1960 7902 -2673 7881 -2719 7887 -2706 100 {
- m20} R 1568 2071 7888 -2706 1525 2112 7894 -2694 1426 2085 7907 -2662 7889
- -2702 1597 2051 1320 2088 1502 2084 1333 2101 1384 2114 7887 -2707 7881 -2720
- 7899 -2681 1337 2113 1450 2102 1444 2075 1707 2005 1381 2099 1586 2087 1539
- 2110 1560 2062 1340 2117 7883 -2716 1432 2081 1302 2074 1157 2149 1376 2076
- 7884 -2715 1255 2127 7879 -2725 7895 -2690 1337 2135 1398 2095 7897 -2687 1332
- 2137 7886 -2710 1334 2114 1356 2114 1489 2131 1489 2099 1446 2116 1231 2144
- 7885 -2710 1536 2103 7869 -2744 1675 1988 1527 2095 1343 2095 7894 -2693 7894
- -2691 7882 -2717 1376 2074 1468 2080 1497 2069 1575 2036 1420 2138 7902 -2676
- 7906 -2666 1477 2088 1560 2066 1379 2125 1363 2133 7906 -2668 1399 2123 1855
- 1872 1278 2093 1711 1995 7905 -2672 1316 2075 7904 -2669 1487 2115 1294 2135
- 7896 -2686 1524 2083 7895 -2690 1659 2033 1631 2028 1416 2106 1296 2129 7892
- -2697 7870 -2743 7909 -2659 1523 2063 1629 2004 1388 2115 7909 -2662 7898 -2685
- 7909 -2662 1391 2118 1510 2113 92 { m20} R 0.43636 0.8 0 c 1307 2180 1435 2152
- 1384 2162 1445 2174 1331 2169 1200 2159 1384 2150 1295 2142 1621 2083 1405 2165
- 1434 2144 1428 2181 1725 2032 1457 2173 1481 2155 1476 2138 1450 2138 1470 2193
- 1498 2180 1492 2159 1447 2189 1462 2179 1360 2161 1360 2171 1442 2180 1437 2178
- 1446 2180 7903 -2675 1485 2150 1552 2124 7909 -2665 1659 2070 1426 2187 1357
- 2163 1366 2192 1526 2151 1559 2117 1404 2175 7907 -2668 1554 2126 7900 -2683
- 1249 2197 1503 2180 1509 2143 1476 2149 7909 -2664 1567 2119 1328 2140 1323
- 2140 1607 2088 1438 2160 1536 2139 1653 2061 1334 2157 1639 2097 1399 2167 1502
- 2165 1326 2186 1434 2172 1397 2177 1327 2181 1352 2147 1395 2182 1100 2192 1573
- 2129 1477 2143 1637 2078 1269 2192 1327 2149 7896 -2690 1400 2183 1287 2184
- 7898 -2685 1577 2122 7903 -2676 1368 2149 1444 2147 1495 2162 1368 2181 7909
- -2664 7908 -2665 1558 2131 7902 -2677 1346 2189 1421 2151 7905 -2671 1598 2134
- 1374 2160 1499 2135 1403 2162 1645 2078 1588 2124 1301 2152 1575 2148 1695 2078
- 1396 2155 1436 2169 1451 2174 1524 2147 1459 2175 100 { m20} R 1615 2123 1413
- 2190 1514 2151 1542 2124 1395 2148 1606 2130 1455 2184 1215 2171 1376 2184 1394
- 2173 1663 2090 1386 2182 1582 2129 1677 2088 1619 2125 1444 2175 1477 2164 1590
- 2135 1559 2146 1546 2145 1382 2171 7908 -2666 1468 2189 7901 -2680 1455 2194
- 1276 2187 1351 2147 7908 -2665 1662 2054 1456 2187 1706 2072 1359 2172 1423
- 2162 1432 2196 1498 2177 1451 2165 1357 2169 37 { m20} R 0.58182 0.8 0 c 1433
- 2209 1452 2244 1379 2207 1485 2240 1508 2205 1441 2204 1334 2239 1421 2244 1459
- 2197 1497 2213 1518 2194 1320 2216 1361 2234 1436 2208 1482 2196 1451 2235 1462
- 2220 1463 2226 1401 2208 1415 2202 1537 2196 1511 2199 1488 2210 1343 2200 1427
- 2239 1588 2161 1520 2204 1520 2183 1438 2217 1435 2213 1377 2230 1357 2243 1477
- 2225 1384 2217 1452 2207 1449 2234 1436 2205 1428 2212 1421 2237 1379 2231 1503
- 2218 1486 2218 1486 2232 1467 2198 1426 2212 1356 2224 1492 2195 1304 2197 1385
- 2229 1450 2216 1510 2200 1415 2240 1351 2207 1492 2235 1459 2236 1542 2189 1381
- 2221 1428 2239 1364 2196 1493 2189 1432 2232 1274 2211 1343 2235 1413 2219 1468
- 2204 1453 2207 1488 2222 1514 2206 1360 2198 1342 2202 1590 2162 1278 2208 1511
- 2212 1431 2203 1417 2240 1480 2231 1533 2191 1466 2211 1366 2196 1494 2207 1476
- 2198 1393 2203 1318 2227 1457 2198 1472 2232 1523 2215 1450 2200 1387 2235 1459
- 2238 1521 2217 1365 2225 1477 2227 1484 2206 1397 2222 1300 2197 1328 2222 1411
- 2198 1477 2227 1406 2206 1407 2212 100 { m20} R 1280 2203 1437 2196 1409 2199 3
- { m20} R 0.72727 0.8 0 c 1427 2259 1449 2280 1464 2267 1371 2247 1399 2266 1374
- 2285 1468 2260 1384 2248 1456 2256 1424 2280 1325 2287 1441 2264 1432 2253 1353
- 2278 1327 2247 1401 2254 1409 2286 1356 2284 1476 2253 1364 2249 1411 2281 1454
- 2276 1412 2246 1472 2252 1425 2256 1434 2253 1364 2268 1480 2250 1481 2248 1440
- 2271 1467 2251 1338 2254 1390 2267 1415 2260 1430 2274 1386 2270 1436 2252 1422
- 2280 1440 2272 1242 2276 1370 2285 1432 2261 1314 2270 1425 2260 44 { m20} R
- 0.8 0.72727 0 c 1414 2293 1420 2306 1407 2294 1421 2308 1376 2304 1432 2290
- 1398 2307 1419 2301 1373 2301 1433 2294 1404 2323 1422 2305 1410 2304 1384 2295
- 1351 2319 1382 2325 1359 2300 1427 2293 18 { m20} R 0.8 0.58182 0 c 1387 2356
- 1369 2334 1402 2328 1388 2356 4 { m20} R 0.8 0.43636 0 c 1361 2393 1369 2377
- 1370 2370 3 { m20} R 0.8 0.29091 0 c 1361 2393 0.8 0.14546 0 c 1361 2393 0 0
- 0.8 c 1361 2393 0 0.14545 0.8 c 1361 2393 0 0.29091 0.8 c 7340 -2938 7040 -3014
- 2 { m20} R 0 0.43636 0.8 c 7245 -3039 7568 -2874 7423 -2946 7644 -2822 7253
- -3030 7354 -2987 7481 -2951 7 { m20} R 0 0.58182 0.8 c 7618 -2920 7596 -2929
- 7082 -3171 7352 -3101 7633 -2892 7097 -3139 7258 -3055 7613 -2928 7463 -3030
- 7426 -3019 7451 -3016 7385 -3019 7595 -2927 7577 -2908 7388 -3088 7228 -3089
- 7113 -3185 7333 -3097 18 { m20} R 0 0.72727 0.8 c 7438 -3143 7367 -3125 7668
- -2910 7425 -3092 7450 -3133 7642 -2974 7551 -3013 7408 -3132 7521 -3106 7285
- -3134 7514 -3091 7600 -3017 7557 -3077 7593 -2990 7457 -3092 7810 -2705 7672
- -2896 7663 -2928 7347 -3225 7687 -2901 7409 -3080 7649 -2948 7599 -3024 7702
- -2885 7689 -2854 7492 -3038 7672 -2922 7272 -3163 7694 -2865 7469 -3155 7556
- -3038 7100 -3327 7212 -3267 7137 -3328 7376 -3114 7349 -3232 7804 -2704 7459
- -3106 7582 -3028 7621 -2953 40 { m20} R 0 0.8 0.72727 c 7680 -2982 7352 -3398
- 7172 -3428 7562 -3149 7677 -2955 7518 -3126 7486 -3273 7624 -3018 7424 -3360
- 7559 -3124 7441 -3347 7472 -3212 7499 -3210 7507 -3188 7539 -3101 7682 -2959
- 7386 -3348 7612 -3037 7776 -2812 7567 -3113 7557 -3092 7610 -3083 7654 -3038
- 7635 -3050 7462 -3298 7677 -2950 7764 -2836 7484 -3201 7572 -3189 7762 -2815
- 7621 -3092 7609 -3058 6694 -3662 7679 -2992 7621 -3027 7604 -3043 7649 -2971
- 7278 -3318 7747 -2862 7442 -3352 7718 -2910 7562 -3096 7556 -3114 7594 -3062
- 7357 -3392 7473 -3303 7407 -3271 7548 -3145 7596 -3146 7198 -3332 7549 -3118
- 7366 -3456 7457 -3248 7639 -3069 7143 -3395 7063 -3450 7651 -3005 7652 -2980
- 7742 -2855 7612 -3089 7409 -3402 7511 -3175 7753 -2845 7640 -3042 7700 -2939
- 7120 -3428 7468 -3290 7492 -3232 7522 -3132 7423 -3234 7587 -3088 7392 -3286
- 7631 -3001 7596 -3055 7673 -2966 7072 -3405 7567 -3157 7720 -2921 7789 -2771
- 7180 -3411 7736 -2879 7711 -2901 7459 -3289 7764 -2836 7529 -3136 7480 -3242
- 7549 -3166 7112 -3393 7786 -2788 7511 -3248 7651 -3018 7440 -3282 7582 -3118 93
- { m20} R 0 0.8 0.58182 c 1131 1090 7835 -2723 7662 -3059 7413 -3544 7737 -2924
- 7558 -3258 7594 -3228 7476 -3454 7600 -3189 7743 -2925 7592 -3214 7645 -3136
- 7626 -3153 7844 -2708 7656 -3098 7433 -3596 1320 1185 7632 -3140 7679 -3023
- 7587 -3235 7741 -2931 7205 -3658 7505 -3342 7700 -2982 7656 -3090 7509 -3400
- 7630 -3109 7643 -3111 7581 -3267 1092 703 7642 -3132 7483 -3490 7684 -2994 7712
- -2977 7781 -2842 7728 -2968 7811 -2767 7634 -3097 7403 -3679 7710 -2979 7517
- -3422 7578 -3267 7528 -3402 7602 -3175 7641 -3132 7754 -2908 7769 -2867 6656
- -4195 775 1058 7449 -3562 7821 -2752 7548 -3266 7699 -2991 7705 -2968 7726
- -2939 7758 -2894 7784 -2813 7430 -3579 7566 -3236 7712 -3001 7778 -2835 7370
- -3531 7598 -3161 7759 -2885 7566 -3326 7576 -3272 7744 -2895 7785 -2805 7682
- -3015 7555 -3273 7595 -3197 7640 -3119 1247 839 7599 -3166 7486 -3518 7692
- -3047 7715 -2994 7554 -3302 7461 -3379 7639 -3137 7670 -3061 1067 1213 7760
- -2895 7723 -2973 7727 -2961 7616 -3204 7459 -3460 7764 -2856 7684 -3017 7532
- -3414 7689 -3031 7614 -3195 7629 -3167 7740 -2939 7566 -3329 7800 -2788 7691
- -2988 7590 -3195 7639 -3134 7777 -2845 100 { m20} R 7613 -3178 7782 -2835 7752
- -2915 1207 687 7809 -2788 7677 -3040 7641 -3142 7544 -3387 7783 -2819 7677
- -3007 7792 -2803 7718 -2980 7631 -3090 7659 -3053 7700 -3005 7342 -3672 7597
- -3227 7243 -3888 7751 -2867 7302 -3856 7738 -2915 7543 -3362 7627 -3133 7760
- -2890 7570 -3270 7199 -4035 1160 1189 7620 -3210 7686 -3055 1462 1097 1017 1221
- 7797 -2781 7542 -3386 7722 -2924 7631 -3186 7628 -3125 7460 -3502 7669 -3020
- 6702 -4127 7599 -3248 7648 -3122 7641 -3100 7803 -2792 1330 644 7836 -2702 7536
- -3373 7600 -3160 7259 -3619 7665 -3065 7680 -3066 7726 -2946 7596 -3176 7773
- -2836 1099 1030 7607 -3195 626 881 7630 -3175 7699 -3029 7789 -2803 7659 -3063
- 7782 -2847 61 { m20} R 0 0.8 0.43636 c 7804 -2826 7757 -2911 1342 1465 7712
- -3046 7682 -3088 7592 -3303 877 1596 7725 -3000 574 1519 7675 -3107 7673 -3115
- 7783 -2856 7669 -3106 7676 -3132 7657 -3169 7781 -2886 7766 -2891 7729 -2974
- 7747 -2964 1129 1434 7647 -3158 7727 -2989 7672 -3127 7741 -2979 1341 1562 7700
- -3043 7788 -2845 1020 1302 1159 1587 7687 -3104 7847 -2723 767 1435 1287 1572
- 1037 1355 7756 -2929 7867 -2686 7586 -3316 7831 -2763 7818 -2799 7754 -2945
- 7843 -2740 7746 -2961 990 1396 7718 -3039 1180 1434 7704 -3029 7801 -2838 7623
- -3218 7753 -2940 7779 -2872 7795 -2833 7805 -2814 1278 1445 7707 -3044 1010
- 1581 7740 -2947 7718 -3033 7727 -3002 895 1595 1416 1417 7793 -2837 722 1494
- 7651 -3170 1178 1218 1298 1315 7790 -2865 7836 -2761 1074 1408 7775 -2893 7729
- -2984 7744 -2967 1020 1569 7666 -3116 910 1598 1454 1205 7808 -2809 1273 1438
- 1245 1433 7730 -2993 1237 1571 7695 -3044 7708 -3029 7758 -2932 7736 -2963 7753
- -2933 7834 -2758 7723 -2985 7747 -2929 7768 -2884 1485 1479 7796 -2818 845 1455
- 7741 -2983 7739 -2951 7679 -3109 975 1489 1366 1515 7728 -3001 7654 -3172 7735
- -2990 100 { m20} R 7734 -2969 7635 -3214 7658 -3169 7595 -3280 7764 -2916 1295
- 1494 1084 1483 7765 -2912 509 1454 957 1331 7740 -2979 1142 1590 798 1351 1054
- 1471 1330 1229 1312 1278 7786 -2852 1087 1525 951 1598 7693 -3096 1074 1499
- 7644 -3181 7715 -3028 1048 1604 7740 -2947 7646 -3163 7803 -2826 7781 -2868
- 7765 -2925 7779 -2881 7665 -3138 7724 -2993 7654 -3142 1179 1568 992 1340 736
- 1360 7789 -2839 7693 -3087 1346 1529 1298 1438 1386 1476 1397 1545 1028 1599
- 7826 -2780 7726 -3003 7602 -3269 1360 1520 7812 -2799 1105 1377 7833 -2749 7666
- -3110 1256 1554 7643 -3201 1021 1423 1313 1384 1477 1291 1342 1245 7772 -2888
- 1291 1534 1169 1563 544 1528 7873 -2672 1205 1489 7655 -3171 1025 1428 7700
- -3045 7685 -3101 7746 -2949 7807 -2811 7624 -3209 7581 -3313 7615 -3245 7678
- -3102 1269 1466 7733 -2982 1161 1403 7698 -3085 586 1314 7745 -2973 1165 1467
- 1384 1322 1188 1520 7798 -2828 1220 1385 7700 -3080 7813 -2793 86 { m20} R 0
- 0.8 0.29091 c 963 1803 7887 -2656 7759 -2963 1273 1633 1136 1632 1368 1715 7888
- -2661 7781 -2909 7856 -2726 7835 -2783 1646 1575 7802 -2865 7716 -3045 1270
- 1727 7753 -2978 7812 -2836 7795 -2861 1636 1527 1041 1627 1309 1740 1455 1625
- 7743 -2985 7751 -2977 1322 1624 338 1554 1308 1753 7780 -2897 7876 -2671 7793
- -2887 657 1608 7857 -2730 1528 1627 7804 -2839 7851 -2748 7791 -2875 7766 -2946
- 1479 1663 1150 1643 7711 -3063 7880 -2673 7751 -2978 986 1656 7769 -2932 1084
- 1750 848 1739 1320 1629 1420 1585 7682 -3121 1447 1624 7796 -2877 7817 -2813
- 7793 -2889 1160 1728 7765 -2947 7826 -2808 7787 -2882 7821 -2805 7841 -2766
- 7848 -2750 1353 1681 7700 -3084 974 1710 1142 1649 1370 1755 7835 -2766 1009
- 1758 7840 -2773 7766 -2944 1383 1731 1365 1717 1427 1717 7783 -2896 7801 -2848
- 1489 1669 1746 1547 7736 -3011 7876 -2688 1251 1768 1190 1739 7730 -3022 7816
- -2825 7768 -2937 7793 -2886 1168 1684 1439 1712 977 1799 7810 -2845 7728 -3027
- 7857 -2725 7852 -2737 7794 -2874 1286 1716 1230 1728 1097 1620 7763 -2952 7732
- -3021 1025 1709 1419 1681 1253 1728 7792 -2864 100 { m20} R 7725 -3033 1142
- 1746 7850 -2741 7848 -2746 1315 1664 7800 -2865 7824 -2812 7798 -2862 1242 1591
- 1368 1734 7749 -2980 7849 -2747 7836 -2786 7874 -2692 1057 1641 7759 -2962 7749
- -2986 1311 1619 1182 1740 7773 -2930 7748 -2979 7742 -3000 7819 -2817 1257 1752
- 1531 1722 7831 -2795 7805 -2853 1099 1748 7840 -2769 1345 1771 1465 1728 1216
- 1716 7753 -2956 7897 -2642 7759 -2965 7794 -2860 7736 -3013 7705 -3074 7737
- -2998 7761 -2955 7741 -2999 7805 -2855 1538 1710 1306 1685 1356 1745 1164 1770
- 1204 1704 7762 -2953 7757 -2962 7816 -2834 1205 1766 7839 -2767 1373 1670 7715
- -3056 7846 -2739 7731 -3014 7732 -3008 7797 -2860 1019 1729 1672 1491 7802
- -2850 824 1718 7863 -2715 7832 -2792 7774 -2921 1058 1671 1118 1700 7756 -2961
- 1358 1762 7761 -2955 7745 -2981 1051 1791 7768 -2933 7798 -2864 1357 1643 7765
- -2947 1528 1602 7753 -2966 1376 1735 1091 1740 7797 -2860 1208 1621 7756 -2956
- 1000 1718 7819 -2807 1369 1692 7795 -2882 1184 1596 1108 1651 7820 -2798 7839
- -2765 1272 1694 1295 1671 7784 -2885 7879 -2671 1251 1727 7839 -2761 7747 -2975
- 7748 -2989 1443 1649 100 { m20} R 7816 -2831 1124 1639 1374 1670 7770 -2928
- 1131 1730 1473 1741 7771 -2938 7837 -2763 1073 1765 7754 -2974 1262 1679 7740
- -3004 7749 -2986 7841 -2771 1168 1771 1134 1741 7772 -2936 7789 -2880 7830
- -2785 939 1802 1548 1667 7830 -2791 7801 -2863 865 1797 1455 1732 7749 -2981
- 7814 -2813 7717 -3045 7875 -2687 1389 1765 1520 1723 942 1703 948 1792 1436
- 1716 7672 -3142 1041 1681 1245 1615 1297 1734 7796 -2881 7797 -2869 7770 -2918
- 1280 1727 7805 -2841 1289 1611 1333 1763 7835 -2765 7807 -2846 1186 1763 1479
- 1607 1265 1664 1114 1647 7807 -2849 1156 1650 1191 1746 7744 -2995 1244 1641
- 7753 -2965 1030 1770 7729 -3027 1689 1603 7728 -3027 1187 1726 7753 -2966 1313
- 1643 1164 1737 1256 1606 1317 1729 67 { m20} R 0 0.8 0.14545 c 7881 -2688 7845
- -2772 7776 -2931 1415 1888 1315 1878 1163 1884 7777 -2929 7801 -2871 7796 -2888
- 1021 1850 7865 -2720 1218 1797 7863 -2739 7869 -2722 7772 -2940 7820 -2836 7857
- -2740 1613 1774 7800 -2884 1252 1819 1406 1870 1343 1874 1363 1850 7808 -2855
- 1065 1897 7780 -2921 7816 -2837 7831 -2811 1169 1810 7781 -2918 1229 1787 1319
- 1856 7764 -2957 7843 -2775 1182 1842 1637 1677 1352 1858 1136 1835 903 1845
- 1482 1823 1300 1850 7817 -2835 7803 -2872 7760 -2963 7812 -2847 7758 -2969 7865
- -2728 7881 -2683 7821 -2835 7786 -2910 7802 -2876 7847 -2779 7838 -2796 1267
- 1829 1278 1802 1474 1875 1540 1809 355 1734 7853 -2759 1366 1791 7794 -2891
- 7806 -2867 7890 -2667 1009 1865 7786 -2907 1132 1833 1269 1895 1308 1841 913
- 1842 7808 -2862 1183 1840 1275 1805 7819 -2843 1150 1817 7837 -2798 1129 1818
- 1420 1850 1385 1805 7855 -2749 7874 -2712 1042 1817 7855 -2748 1134 1915 1285
- 1886 7814 -2850 7855 -2742 1325 1842 7843 -2783 1193 1844 7778 -2926 7815 -2848
- 1491 1790 7862 -2730 7880 -2699 7824 -2824 7861 -2730 7834 -2810 1213 1863 7839
- -2787 1413 1820 100 { m20} R 7891 -2671 1137 1844 7836 -2794 1196 1812 1232
- 1831 1199 1828 7791 -2899 1271 1871 1388 1773 7778 -2927 1293 1888 7838 -2793
- 1375 1864 7860 -2732 7796 -2883 1372 1777 7791 -2897 7861 -2737 7777 -2930 1589
- 1745 7794 -2896 7908 -2617 1347 1873 7803 -2877 1499 1836 1635 1678 7824 -2830
- 1471 1841 7811 -2861 1331 1846 7826 -2826 7860 -2745 7773 -2939 1304 1776 7842
- -2781 1336 1837 7772 -2940 7823 -2830 1063 1858 7808 -2857 7806 -2859 7846
- -2779 7896 -2652 1126 1912 1331 1812 1583 1698 7824 -2820 7826 -2827 1121 1803
- 7857 -2755 1585 1816 7819 -2839 1089 1828 1193 1888 7834 -2795 7895 -2661 7752
- -2981 7842 -2783 1110 1828 7801 -2877 1338 1813 7854 -2761 1053 1817 7777 -2929
- 7815 -2848 7827 -2819 1555 1760 1084 1834 7782 -2920 1151 1848 1312 1893 7776
- -2933 7834 -2808 7875 -2710 7824 -2823 7746 -2994 1221 1869 1372 1793 1211 1778
- 1092 1843 1336 1872 7869 -2724 1427 1895 7883 -2691 1328 1793 7771 -2940 1324
- 1872 7814 -2851 7753 -2978 933 1874 7835 -2806 1313 1807 7810 -2859 1247 1845
- 1072 1906 7782 -2920 7845 -2768 1538 1741 7794 -2892 7873 -2710 100 { m20} R
- 7782 -2917 1180 1885 7779 -2925 7769 -2944 7805 -2865 1226 1894 7823 -2834 7860
- -2747 1130 1889 7873 -2717 7860 -2730 7777 -2926 7850 -2754 1552 1838 1319 1851
- 1154 1852 7810 -2851 7847 -2768 7835 -2790 1269 1849 1523 1825 7822 -2837 1207
- 1859 7852 -2761 1346 1792 7795 -2894 1270 1835 1298 1840 7801 -2875 1259 1847
- 1419 1802 7760 -2963 7845 -2783 7825 -2827 1217 1793 7898 -2647 1392 1894 7767
- -2947 861 1844 7885 -2673 1316 1823 7856 -2747 7810 -2855 7819 -2842 7803 -2866
- 1500 1794 7799 -2875 1393 1814 1372 1826 7795 -2889 7888 -2672 7851 -2758 1378
- 1898 7902 -2637 1249 1782 1143 1905 1478 1878 7877 -2700 1167 1837 7872 -2712
- 7889 -2671 1033 1847 7830 -2810 7856 -2751 64 { m20} R 0 0.8 0.4069E-06 c 1372
- 1937 1236 1958 1223 1982 1279 1915 7856 -2763 7869 -2730 1315 1911 7870 -2725
- 7882 -2699 1461 1967 7839 -2803 7851 -2778 1382 1965 1696 1834 1480 1922 1370
- 1952 7874 -2723 7877 -2717 1274 1956 7834 -2814 7903 -2660 7870 -2732 1368 1912
- 7904 -2644 1315 1967 1084 1987 1391 1937 1385 1958 1429 1952 1367 1936 7866
- -2740 7845 -2787 7896 -2668 7829 -2823 1428 1955 1463 1951 7836 -2812 1133 2011
- 1301 1931 1254 1988 7851 -2776 7873 -2724 7902 -2651 7901 -2660 7875 -2724 7817
- -2847 1528 1946 1255 1916 7842 -2797 7832 -2816 7848 -2784 1411 1964 7865 -2745
- 1274 1953 986 1950 1462 1905 1576 1912 7830 -2822 1145 1963 7898 -2661 7870
- -2729 1474 1921 7834 -2813 895 2012 1245 1996 1404 1928 7816 -2850 1577 1896
- 7893 -2678 7851 -2775 1171 1957 7840 -2799 1522 1887 1394 1923 1463 1926 1242
- 1930 1097 2003 7864 -2748 1339 1949 7855 -2770 1159 2017 7850 -2781 7832 -2817
- 7834 -2813 7834 -2814 7840 -2801 1489 1938 1170 1943 7905 -2644 7880 -2713 1432
- 1946 1291 1992 7886 -2699 1251 1953 1494 1928 1280 1991 1226 1911 1618 1877
- 7835 -2807 1270 1913 100 { m20} R 7892 -2677 7837 -2808 1283 1911 1117 1972
- 1302 1899 1459 1922 7887 -2694 7858 -2758 1488 1953 1555 1885 1427 1923 1270
- 1901 7839 -2804 1316 1951 7877 -2713 1212 1998 1256 1963 7825 -2833 7850 -2776
- 7868 -2739 7899 -2660 1250 1969 7834 -2814 7862 -2755 7844 -2794 7860 -2758
- 7818 -2847 1384 1929 1496 1946 1391 1958 7880 -2703 1330 1901 1233 1967 7886
- -2692 7903 -2650 1077 1974 1599 1930 1466 1906 7832 -2817 1171 1984 1306 1943
- 7907 -2638 7836 -2808 1228 1942 7824 -2835 7908 -2646 1350 1970 1210 1979 7833
- -2813 7885 -2701 1369 1953 1404 1970 1365 1982 7846 -2782 1606 1837 7867 -2736
- 7873 -2720 7829 -2824 7889 -2692 1602 1846 1667 1832 7850 -2780 1328 1923 1330
- 1924 7886 -2695 7854 -2763 1250 1933 7908 -2648 7874 -2725 1591 1851 7817 -2849
- 7825 -2831 7838 -2806 1432 1967 7841 -2797 1097 1986 7812 -2858 7894 -2677 1294
- 1935 1353 1932 1244 1927 7860 -2757 1387 1906 7902 -2662 7867 -2738 7854 -2768
- 1216 1978 7835 -2812 7850 -2776 7842 -2797 7865 -2746 7862 -2745 1363 1936 7860
- -2756 7873 -2718 7807 -2869 7909 -2637 7905 -2643 1075 1988 7855 -2762 100 {
- m20} R 1108 2021 7901 -2651 1278 1961 7839 -2803 1290 1902 7835 -2812 1440 1968
- 1462 1888 901 1955 1421 1919 7894 -2672 1425 1984 1329 1927 7877 -2713 7836
- -2811 7905 -2654 7835 -2814 7873 -2723 7836 -2809 7868 -2734 7895 -2677 1625
- 1855 1333 1960 1672 1780 1345 1977 7862 -2754 7881 -2702 1940 1687 7872 -2726
- 7871 -2723 1366 1919 7851 -2770 955 1979 7830 -2819 7878 -2713 7850 -2779 1312
- 1995 7821 -2841 7844 -2791 7804 -2874 1359 1960 1380 1971 7836 -2811 1296 1957
- 1255 1991 1832 1667 7837 -2810 1240 1964 1272 1990 1360 1928 7828 -2825 7826
- -2831 7820 -2843 1459 1959 7860 -2755 1389 1938 7868 -2742 7855 -2766 1447 1919
- 7835 -2807 1572 1904 1425 1931 7831 -2818 7840 -2796 7863 -2752 7864 -2741 7853
- -2775 7893 -2683 7871 -2732 1452 1957 7885 -2691 7904 -2649 7826 -2831 73 { m20
-} R 0.14545 0.8 0 c 7899 -2669 1305 1996 7841 -2800 1428 2026 1252 2021 1188
- 2017 1238 2060 7860 -2761 7850 -2782 7866 -2750 7884 -2712 7848 -2786 1538 1976
- 1371 2048 7853 -2777 1818 1826 1445 2023 1350 1998 7885 -2705 7855 -2772 7870
- -2741 7897 -2682 1287 2022 7908 -2655 1184 2085 1502 2037 7858 -2766 1273 2000
- 7875 -2729 7856 -2771 1397 2037 7861 -2759 7863 -2757 1308 2035 7881 -2717 1575
- 1982 7900 -2676 7890 -2694 1398 2030 1484 2064 1464 2034 7885 -2702 7892 -2688
- 1308 2054 7873 -2735 7900 -2675 1395 2073 1534 1965 1266 2027 7891 -2698 1490
- 1990 1711 1936 1387 2023 1380 2049 1402 2014 1571 1974 7892 -2688 7869 -2741
- 1477 2016 7905 -2658 1433 2019 1471 2066 7885 -2709 1584 2011 1693 1949 1371
- 2049 1548 1972 1487 2028 7884 -2710 7866 -2747 7885 -2707 1472 2043 7867 -2749
- 1343 2054 1140 2069 1445 2062 7857 -2768 1594 1989 1274 2017 7887 -2703 7861
- -2759 7837 -2810 7905 -2658 1414 2071 7862 -2757 7870 -2738 7887 -2705 1205
- 2034 7859 -2765 7862 -2758 1523 1971 7907 -2661 7896 -2681 7895 -2681 7894
- -2686 7894 -2687 7857 -2769 7853 -2777 1279 1997 7872 -2738 100 { m20} R 1573
- 1969 1602 1946 1235 2030 7906 -2658 915 2048 7872 -2738 7860 -2762 1474 2040
- 1692 1941 1204 2065 1375 2065 7888 -2697 1256 1998 7862 -2757 1516 2020 7887
- -2702 1682 1882 1527 1999 7867 -2743 1273 2020 7906 -2657 7855 -2772 7868 -2746
- 1388 2002 1293 2009 1372 2014 1160 2054 7891 -2692 7888 -2697 1448 2061 7851
- -2780 7864 -2753 1541 1968 1605 1996 7865 -2752 1564 2011 1486 2061 7897 -2684
- 7856 -2770 7862 -2758 1305 2029 984 2113 1461 2001 1554 2017 1489 2006 1621
- 1953 1157 2061 1158 2048 7875 -2731 7871 -2740 7895 -2688 1530 2043 7861 -2760
- 7868 -2746 7879 -2718 1443 2007 7863 -2757 1521 2033 7880 -2721 1412 2030 7891
- -2692 7868 -2744 7905 -2664 1325 2002 7871 -2738 1383 2007 1470 2051 1225 2041
- 7903 -2666 1398 2051 1144 2070 1367 2028 1593 1949 646 2021 1359 2057 1926 1713
- 7897 -2678 7886 -2703 1199 2081 1569 1996 7873 -2733 1379 2030 1334 2048 7883
- -2711 1462 2029 1225 2042 1490 2001 1643 1975 1233 2081 1363 2061 1301 2057
- 7863 -2754 1241 2048 7877 -2722 1035 2061 1299 2017 1600 1969 1603 1982 7867
- -2748 1435 2072 100 { m20} R 1317 2017 1507 2003 7881 -2717 1275 2036 7883
- -2707 1379 2009 1531 1981 7899 -2677 1325 2049 7884 -2712 7861 -2760 7850 -2782
- 7864 -2752 7881 -2714 1511 2053 1365 2027 1175 2049 1318 2027 1330 2050 1302
- 2012 7866 -2749 1434 2003 1429 2048 1349 2000 1427 2071 7876 -2727 7878 -2722
- 1564 1975 1526 1994 7864 -2752 1377 2030 1161 2070 1381 2068 1576 1960 1413
- 2059 7886 -2709 1474 2011 7892 -2691 7894 -2684 39 { m20} R 0.29091 0.8 0 c
- 1101 2165 1546 2106 7894 -2694 7893 -2694 7891 -2700 1202 2126 7883 -2716 7899
- -2683 7897 -2685 7907 -2665 7883 -2717 7890 -2701 1425 2135 1573 2062 1548 2070
- 1407 2122 1504 2111 7896 -2688 1402 2093 1618 2052 1252 2121 1466 2103 7895
- -2693 7893 -2697 7904 -2672 1459 2101 7876 -2731 1259 2104 7893 -2695 7888
- -2704 1589 2086 7890 -2700 7895 -2689 7896 -2690 7907 -2666 1452 2082 7875
- -2732 1348 2109 1333 2111 1629 2069 7906 -2664 1630 2011 7899 -2683 1535 2097
- 1496 2106 1240 2120 7895 -2692 1416 2119 7892 -2697 1507 2077 1308 2092 7893
- -2697 7881 -2721 7905 -2671 7889 -2704 1618 2073 1588 2078 1097 2118 1450 2095
- 1379 2106 1459 2134 1519 2095 7905 -2667 1523 2089 7898 -2684 7890 -2703 7905
- -2670 1736 1999 7895 -2691 7895 -2690 1384 2093 7887 -2709 7895 -2691 1520 2123
- 1290 2115 1710 2008 1616 2076 7898 -2684 1364 2108 7905 -2667 1179 2153 7893
- -2695 1840 1883 1720 1958 1527 2083 7888 -2705 7898 -2685 1335 2084 7890 -2702
- 965 2177 1594 2026 1448 2113 1333 2101 7906 -2664 1475 2106 7897 -2687 1420
- 2092 7886 -2710 1435 2112 1449 2112 100 { m20} R 1630 2030 1437 2099 7904 -2673
- 1473 2079 1332 2089 1598 2074 1563 2067 7895 -2691 1608 2021 7882 -2718 7894
- -2694 1420 2101 1507 2119 1343 2101 1212 2103 1853 1854 1509 2110 1448 2112
- 1438 2134 1271 2078 1518 2061 1402 2138 1474 2113 1423 2118 7908 -2659 7897
- -2686 1332 2123 1749 1989 1475 2126 7870 -2742 7886 -2710 1417 2123 1322 2100
- 1339 2133 7900 -2680 1356 2108 7896 -2689 1299 2106 1241 2085 7884 -2712 7894
- -2693 1523 2107 1410 2098 1291 2082 1569 2078 1528 2094 1500 2108 1410 2089
- 7898 -2685 1351 2122 1369 2130 1414 2102 7903 -2674 1268 2090 1532 2095 1321
- 2090 7892 -2697 7902 -2674 1238 2085 1447 2100 7899 -2680 1477 2121 7871 -2741
- 1480 2090 7880 -2722 7897 -2684 1423 2139 1349 2123 1450 2111 7905 -2669 1542
- 2094 1553 2064 1481 2132 1470 2105 1440 2079 7879 -2723 1444 2087 7888 -2705
- 1401 2121 1430 2132 1415 2097 1545 2091 1300 2093 1551 2103 1374 2115 7890
- -2701 1340 2090 7892 -2697 1333 2126 1470 2113 7903 -2673 1524 2084 1501 2098
- 7873 -2736 1486 2102 1113 2147 96 { m20} R 0.43636 0.8 0 c 7902 -2677 1434 2166
- 1367 2142 1342 2176 1448 2138 1523 2134 1482 2148 1928 1904 1436 2166 1691 2078
- 1409 2169 1460 2165 1409 2170 1404 2168 1373 2192 7899 -2683 1646 2066 7907
- -2668 1530 2143 1298 2184 1444 2164 1467 2169 1363 2172 1415 2155 1625 2110
- 1454 2161 1515 2180 1571 2113 7902 -2678 1355 2164 1556 2148 1559 2115 1652
- 2090 1622 2123 1450 2185 1332 2176 1548 2126 1343 2148 1374 2151 1666 2064 1441
- 2143 1642 2106 1991 1819 1522 2130 1574 2150 1366 2165 1388 2159 1345 2145 1490
- 2181 1388 2155 1430 2162 1354 2169 1345 2187 1354 2169 1440 2140 1413 2168 1529
- 2169 1410 2183 1305 2190 1357 2153 1515 2144 1558 2165 1290 2185 1420 2180 1544
- 2169 1559 2160 7908 -2666 1422 2151 1260 2150 1649 2101 1244 2194 1376 2167
- 1648 2114 1405 2152 1724 2057 1280 2174 1379 2171 1445 2172 1383 2146 1430 2177
- 1416 2160 1426 2194 1524 2133 1436 2174 1516 2155 1358 2169 1650 2096 1419 2147
- 1456 2178 1495 2152 1679 2086 7909 -2664 1443 2185 1446 2157 1783 1996 1766
- 2003 1458 2170 1474 2147 1442 2163 1544 2152 100 { m20} R 1453 2143 1494 2179
- 1262 2190 1479 2180 1382 2148 1271 2156 1277 2153 1284 2161 1427 2153 1472 2169
- 1409 2157 1459 2194 1477 2179 1498 2176 7902 -2677 1454 2162 1274 2156 1683
- 2063 1343 2147 1983 1834 1523 2163 7907 -2668 1547 2152 1363 2165 1603 2093
- 1379 2165 1461 2193 1477 2138 1472 2180 1248 2161 1385 2187 1869 1943 1363 2181
- 1575 2157 1313 2161 1466 2148 1486 2189 1386 2194 1542 2164 1425 2174 1425 2196
- 1332 2144 1558 2134 1299 2149 1414 2152 1304 2148 1483 2159 1350 2190 48 { m20
-} R 0.58182 0.8 0 c 1246 2236 1412 2228 1260 2223 1450 2232 1427 2200 1466 2234
- 1507 2225 1356 2200 1490 2227 1393 2206 1507 2229 1478 2241 1372 2210 1326 2218
- 1421 2221 1443 2208 1516 2210 1461 2238 1263 2244 1423 2206 1221 2218 1543 2188
- 1460 2227 1405 2225 1493 2207 1459 2198 1491 2197 1381 2204 1493 2229 1453 2230
- 1527 2209 1465 2223 1121 2253 1493 2217 1492 2237 1460 2227 1441 2227 1395 2216
- 1463 2208 1388 2201 1540 2183 1525 2214 1273 2237 1504 2222 1309 2204 1317 2206
- 1385 2222 1355 2213 1446 2231 1516 2218 1541 2198 1450 2231 1401 2208 1465 2232
- 1399 2209 1436 2211 1545 2194 1316 2225 1418 2241 1544 2198 1496 2209 1400 2205
- 1483 2216 1330 2196 1497 2228 1311 2214 1326 2241 1475 2239 1330 2240 1330 2236
- 1484 2192 1469 2237 1512 2210 1369 2243 1410 2223 1524 2200 1404 2197 1466 2205
- 1486 2212 79 { m20} R 0.72727 0.8 0 c 1466 2261 1422 2289 1480 2248 1423 2269
- 1272 2277 1394 2260 1453 2247 1347 2278 1387 2273 1420 2285 1415 2253 1289 2249
- 1396 2282 1455 2272 1410 2266 1410 2270 1419 2273 1483 2250 1357 2274 1387 2258
- 1430 2280 1346 2259 1452 2247 1410 2280 1477 2254 1421 2262 1457 2250 1370 2278
- 1426 2279 1388 2257 1347 2280 1385 2266 1454 2245 1398 2261 1433 2273 1362 2251
- 1362 2275 1369 2287 1375 2274 1391 2254 1387 2282 41 { m20} R 0.8 0.72727 0 c
- 1414 2316 1333 2290 1343 2320 1410 2310 1376 2290 1424 2301 1293 2294 1336 2319
- 1397 2312 1280 2309 1400 2305 1385 2314 1391 2312 1410 2304 1278 2300 1435 2293
- 1426 2290 1415 2310 1371 2305 1428 2298 1406 2315 1434 2294 1328 2302 1415 2292
- 1413 2304 25 { m20} R 0.8 0.58182 0 c 1384 2333 1337 2357 1343 2357 1362 2341
- 1393 2348 1389 2331 1370 2362 1390 2335 1351 2330 9 { m20} R 0.8 0.43636 0 c
- 1384 2333 0.8 0.29091 0 c 1384 2333 0.8 0.14546 0 c 1384 2333 0 0 0.8 c 1384
- 2333 0 0.14545 0.8 c 1384 2333 0 0.29091 0.8 c 1384 2333 0 0.43636 0.8 c 7368
- -2949 7254 -2988 7703 -2775 7480 -2914 7416 -2975 5 { m20} R 0 0.58182 0.8 c
- 7580 -2946 7268 -3068 7744 -2743 7658 -2864 7498 -3008 7683 -2835 7603 -2929
- 7600 -2907 7344 -3081 7562 -2949 7504 -2985 7327 -3081 7653 -2853 7295 -3049
- 7687 -2823 15 { m20} R 0 0.72727 0.8 c 7605 -2969 6876 -3338 7764 -2795 7566
- -3066 7543 -3017 7667 -2902 7553 -3023 7710 -2851 7366 -3236 7557 -3067 7618
- -2993 7474 -3083 7632 -2922 7340 -3159 7599 -2974 7569 -3032 7514 -3091 7724
- -2853 7657 -2920 7325 -3120 7385 -3138 7476 -3114 7411 -3101 7302 -3257 6883
- -3269 7326 -3172 7547 -3087 7602 -2979 7692 -2875 7637 -2949 7517 -3083 7681
- -2883 7567 -3046 7627 -2980 7625 -2989 7418 -3145 7480 -3070 7714 -2870 7539
- -3058 7573 -3043 7695 -2874 7669 -2916 7178 -3196 7614 -2943 7306 -3163 7683
- -2880 7329 -3151 7557 -3045 7675 -2932 7456 -3163 50 { m20} R 0 0.8 0.72727 c
- 7534 -3220 7763 -2814 7792 -2751 7690 -2961 7464 -3327 7707 -2939 7665 -3016
- 7479 -3323 7344 -3263 7687 -2931 7577 -3103 7041 -3680 7394 -3315 7321 -3454
- 7400 -3249 7532 -3143 7620 -3082 7667 -2997 7608 -3044 7526 -3192 7448 -3386
- 7589 -3075 7723 -2884 7488 -3235 7557 -3123 7840 -2681 7691 -2977 7563 -3137
- 7600 -3122 7430 -3334 7791 -2788 7607 -3094 7810 -2742 7276 -3356 7672 -3013
- 7714 -2930 7724 -2907 7576 -3149 7401 -3238 7626 -3063 7594 -3059 7379 -3402
- 7590 -3068 6795 -3450 7612 -3117 7571 -3195 7576 -3082 7687 -2974 7649 -3048
- 7514 -3126 7623 -3063 7702 -2945 7433 -3327 7768 -2795 7568 -3172 7770 -2814
- 7716 -2926 7310 -3364 7499 -3144 7799 -2764 7653 -2969 7434 -3322 7701 -2915
- 7686 -2932 7619 -3073 7165 -3349 7358 -3320 7681 -2981 7530 -3195 7724 -2879
- 7242 -3344 7385 -3279 7045 -3554 7141 -3517 7660 -2970 7272 -3533 7692 -2977
- 7572 -3174 7617 -3071 79 { m20} R 0 0.8 0.58182 c 7723 -2970 7422 -3505 7703
- -3017 7727 -2913 7833 -2728 7597 -3254 7765 -2847 7809 -2787 7721 -2946 7318
- -3699 7511 -3302 7758 -2880 7713 -2988 1166 1185 7515 -3404 7785 -2825 7628
- -3122 7507 -3309 497 1134 7786 -2799 7810 -2772 7640 -3136 7699 -2989 7728
- -2914 7661 -3107 7414 -3611 7821 -2734 7692 -2998 881 1040 7559 -3297 7648
- -3067 7678 -3060 7637 -3178 7556 -3314 7619 -3112 7417 -3544 7612 -3214 7512
- -3403 7720 -2952 7658 -3079 999 556 7768 -2835 7585 -3207 7732 -2944 7705 -2962
- 7816 -2743 7352 -3589 7817 -2772 7675 -3066 7648 -3081 7814 -2769 7537 -3363
- 7719 -2955 7752 -2888 7443 -3605 7640 -3139 7560 -3258 7735 -2942 7724 -2956
- 423 1188 7560 -3294 7715 -2951 7504 -3479 7845 -2706 7766 -2879 7715 -2963 7763
- -2854 7184 -3734 7622 -3159 7578 -3276 7442 -3411 7579 -3253 7782 -2814 1264
- 1215 7637 -3086 7600 -3202 7647 -3129 7614 -3163 7675 -3075 7808 -2788 7667
- -3048 7545 -3387 7761 -2883 7688 -3022 7322 -3676 7802 -2792 7631 -3160 7582
- -3232 7517 -3455 7777 -2823 7765 -2856 7556 -3363 7459 -3514 7521 -3287 7496
- -3336 7560 -3246 7690 -3047 7722 -2958 7718 -2969 7595 -3258 100 { m20} R 7664
- -3107 7762 -2852 7693 -3043 7764 -2886 7760 -2880 7865 -2663 7711 -2958 7703
- -3003 7638 -3139 7591 -3260 886 1245 7689 -3018 7709 -3009 7532 -3316 7597
- -3184 7715 -2954 7518 -3450 7698 -2996 7779 -2829 7702 -2968 7596 -3267 7656
- -3067 7589 -3187 7497 -3493 7796 -2817 7575 -3228 7714 -2939 7554 -3325 7629
- -3177 7557 -3273 7780 -2851 7572 -3285 7811 -2772 7628 -3144 7777 -2828 7748
- -2890 7426 -3528 7658 -3061 7744 -2922 7658 -3105 7563 -3350 7743 -2928 7723
- -2939 7436 -3501 7646 -3089 7561 -3355 7662 -3089 7491 -3454 7631 -3109 7637
- -3102 7668 -3028 7746 -2912 7476 -3446 7754 -2905 7665 -3082 7815 -2765 7625
- -3135 7781 -2842 7740 -2902 7491 -3482 7492 -3338 7611 -3229 7625 -3150 7712
- -2969 7773 -2864 7588 -3234 7770 -2840 7735 -2935 7606 -3210 7775 -2844 7682
- -3018 7688 -2995 72 { m20} R 0 0.8 0.43636 c 7750 -2964 1434 1549 1137 1565
- 7679 -3110 7719 -3030 7675 -3128 7797 -2852 7718 -3015 1146 1356 7730 -2968
- 1045 1538 1151 1242 1165 1421 7753 -2946 1252 1513 7650 -3176 1255 1359 769
- 1466 7742 -2980 7777 -2867 7725 -2978 7835 -2758 7692 -3081 7678 -3084 944 1614
- 7590 -3291 7682 -3111 7646 -3189 7720 -3009 7786 -2861 7709 -3057 7712 -3011
- 7674 -3132 7618 -3251 7660 -3154 7750 -2942 1304 1518 7630 -3225 7617 -3252 754
- 1583 1264 1535 7832 -2763 770 1426 7701 -3051 1196 1326 1093 1479 7848 -2729
- 1864 921 7753 -2940 1413 1453 1193 1401 7692 -3059 1250 1446 943 1534 7762
- -2933 7731 -2981 7572 -3341 1144 1577 7630 -3217 7633 -3188 7727 -2992 1016
- 1497 7730 -2967 7708 -3036 1354 1408 7828 -2769 978 1538 1171 1585 7621 -3227
- 7647 -3173 7714 -3041 7797 -2850 7745 -2951 7690 -3102 1141 1335 7782 -2876
- 7654 -3141 7725 -2981 1006 1594 1159 1512 7758 -2928 838 1324 1314 1529 7800
- -2829 7784 -2865 7734 -2980 7610 -3249 7691 -3086 7697 -3050 7751 -2950 7745
- -2959 1127 1586 7727 -3001 1143 1392 7857 -2712 7655 -3174 7734 -2973 1343 1511
- 7812 -2802 7705 -3065 100 { m20} R 7798 -2835 1214 1289 1170 1463 7830 -2766
- 7734 -2958 7768 -2913 7624 -3220 7748 -2965 1019 1612 7794 -2859 1305 1566 7743
- -2978 1207 1576 7571 -3337 1258 1548 7536 -3415 7844 -2736 1338 1542 7725 -2998
- 7796 -2833 7651 -3170 7776 -2870 7845 -2717 1171 1365 7569 -3347 7743 -2964
- 7671 -3138 577 1505 7733 -2991 7817 -2795 7659 -3168 7759 -2914 7704 -3029 7795
- -2852 7692 -3097 7731 -3005 7742 -2973 1215 1574 7655 -3148 1432 1380 1091 1588
- 929 1582 7838 -2730 7855 -2701 7718 -3030 7685 -3096 1239 1508 881 1373 1253
- 1579 7825 -2778 7727 -3015 7807 -2820 1053 1586 7647 -3170 7765 -2898 7794
- -2858 7735 -2977 7689 -3095 1131 1473 7778 -2892 7725 -3010 943 1579 7663 -3159
- 7674 -3093 7756 -2928 7794 -2845 7804 -2817 7824 -2784 7761 -2902 7645 -3195
- 7664 -3158 7678 -3120 7697 -3073 7746 -2968 1139 1411 1000 1516 7843 -2730 1249
- 1512 1181 1304 912 1285 7664 -3122 7805 -2829 7716 -3020 7765 -2905 7712 -3051
- 7672 -3134 7680 -3110 7768 -2893 1141 1297 7641 -3200 1151 1398 7793 -2848 1216
- 1571 7799 -2847 7812 -2798 7690 -3058 7820 -2792 1360 1536 7696 -3066 1012 1554
- 100 { m20} R 7714 -3049 7658 -3150 7751 -2956 1162 1438 4 { m20} R 0 0.8
- 0.29091 c 7857 -2728 1517 1568 1116 1750 7729 -3025 7797 -2862 7729 -3014 7865
- -2699 7767 -2934 7743 -2996 7803 -2861 7806 -2843 7839 -2769 7841 -2765 1346
- 1737 7810 -2845 1111 1700 7805 -2851 7818 -2828 7700 -3082 1669 1550 7808 -2854
- 7776 -2920 7838 -2779 1161 1621 1252 1618 1416 1743 7756 -2950 7814 -2812 1093
- 1685 7736 -3011 7726 -3030 1246 1730 7736 -3004 7706 -3071 7724 -3035 7871
- -2704 7788 -2898 7764 -2933 1063 1660 7813 -2838 1230 1726 1130 1767 1405 1740
- 1169 1757 1198 1639 7824 -2813 7784 -2902 7701 -3083 1302 1734 1042 1617 7799
- -2853 7788 -2896 1427 1708 1243 1613 1414 1704 7701 -3081 7791 -2888 7877 -2686
- 7759 -2948 1305 1599 7779 -2898 7748 -2985 1341 1740 7822 -2820 1221 1770 1249
- 1729 7781 -2902 1127 1719 1303 1766 7863 -2721 7721 -3035 7815 -2832 1175 1673
- 283 1534 885 1782 1118 1713 608 1754 1511 1729 7827 -2808 1402 1599 7768 -2935
- 7846 -2755 7766 -2932 7840 -2776 1308 1768 7803 -2860 7741 -2996 1244 1689 7836
- -2772 7862 -2721 7801 -2856 746 1721 7790 -2875 7820 -2823 1260 1603 1299 1600
- 7758 -2967 1279 1729 7828 -2804 7843 -2768 100 { m20} R 1110 1740 1282 1628
- 7829 -2803 1053 1729 1253 1692 1295 1628 7861 -2723 7861 -2714 7725 -3026 7818
- -2826 1325 1624 7795 -2879 7742 -3000 1547 1599 1135 1633 7718 -3050 1420 1630
- 1403 1617 7846 -2753 7791 -2889 7739 -2992 1363 1736 7765 -2930 915 1751 7860
- -2710 7769 -2921 7825 -2810 7847 -2758 7821 -2822 1085 1729 7838 -2777 1050
- 1743 1472 1572 7759 -2948 1328 1753 7743 -2988 1005 1719 7711 -3064 1252 1700
- 7820 -2823 925 1723 1234 1758 1073 1670 7895 -2637 7874 -2696 7754 -2970 7853
- -2726 1173 1754 7772 -2920 1454 1699 7818 -2824 1324 1736 7853 -2734 7798 -2865
- 1102 1755 1183 1678 1432 1639 7781 -2916 1274 1764 1566 1540 933 1633 1405 1750
- 1372 1579 1296 1702 1226 1675 1130 1632 7836 -2782 7784 -2894 7766 -2937 1472
- 1704 1306 1708 1064 1736 7721 -3040 1291 1645 1458 1714 7874 -2676 1290 1759
- 1227 1661 7733 -3008 7823 -2810 7861 -2708 1333 1606 1295 1627 7744 -2987 7816
- -2828 7847 -2742 7734 -3017 7782 -2886 7784 -2895 7787 -2882 1645 1651 7846
- -2742 1053 1712 7769 -2941 7716 -3046 1169 1780 1274 1669 1388 1719 7755 -2964
- 1268 1695 100 { m20} R 7778 -2907 1281 1703 7794 -2879 1219 1609 7751 -2975
- 7756 -2954 7817 -2828 7737 -3009 1519 1665 7757 -2967 1252 1653 7886 -2660 7785
- -2889 990 1642 7794 -2884 1395 1596 1129 1697 7735 -3014 1274 1695 935 1696
- 7776 -2903 7764 -2936 7779 -2895 7818 -2818 1711 1455 1236 1655 719 1630 7818
- -2820 7676 -3134 7690 -3104 7850 -2735 1058 1723 7750 -2984 7893 -2632 7811
- -2846 7846 -2744 7721 -3038 1509 1541 38 { m20} R 0 0.8 0.14545 c 1323 1896
- 7846 -2774 1530 1834 7861 -2735 7838 -2798 7814 -2847 7799 -2885 7854 -2759
- 7834 -2803 1156 1817 1350 1886 7790 -2899 7778 -2929 7861 -2737 7843 -2775 1340
- 1824 1110 1864 7789 -2900 7805 -2872 1330 1780 7849 -2771 1463 1809 7847 -2770
- 1203 1879 7832 -2811 7798 -2882 1637 1673 1392 1843 7831 -2807 7864 -2722 7810
- -2851 1247 1853 1238 1817 7845 -2778 1487 1840 7782 -2919 7855 -2760 7782 -2915
- 7898 -2651 7877 -2700 1334 1792 947 1940 1626 1770 1052 1902 7792 -2900 7889
- -2670 7838 -2797 966 1824 1337 1806 7797 -2884 1372 1888 7811 -2853 1378 1858
- 856 1911 1445 1836 7884 -2685 1220 1868 7790 -2899 1176 1848 7857 -2741 1211
- 1795 1521 1811 7842 -2783 1282 1878 1386 1850 1359 1814 1387 1852 7786 -2909
- 7834 -2802 7821 -2837 7819 -2840 7830 -2815 1319 1798 1124 1919 1399 1776 1299
- 1772 1460 1769 1235 1844 7798 -2888 976 1871 1351 1782 999 1877 7807 -2867 7823
- -2824 1078 1871 7795 -2893 7802 -2878 1253 1835 1484 1872 7772 -2938 1321 1794
- 7779 -2921 7810 -2860 864 1829 7781 -2921 7766 -2951 1203 1903 7871 -2718 7757
- -2969 1276 1891 100 { m20} R 7862 -2727 1206 1845 1403 1857 7885 -2685 7822
- -2830 7843 -2775 7879 -2701 1257 1881 1146 1832 1217 1900 7905 -2641 7772 -2939
- 7780 -2922 7808 -2865 7892 -2666 1208 1893 1138 1899 1327 1850 1194 1795 1156
- 1820 7860 -2737 918 1889 1508 1781 7815 -2849 1169 1796 1539 1780 1499 1838
- 7805 -2871 1255 1861 7777 -2929 1198 1896 7770 -2943 1671 1704 7808 -2865 7848
- -2763 1416 1885 1189 1851 1050 1828 1291 1783 7776 -2930 7845 -2783 7907 -2635
- 7846 -2777 1412 1896 7857 -2741 1635 1751 7833 -2810 1381 1797 7788 -2907 1261
- 1877 1278 1782 1347 1887 1280 1777 7781 -2917 7811 -2851 1458 1833 1435 1798
- 7847 -2766 1369 1844 7803 -2878 7823 -2829 7882 -2681 7855 -2749 1218 1864 1260
- 1860 1382 1859 7821 -2837 7887 -2670 7809 -2856 7776 -2932 7883 -2686 979 1841
- 7842 -2773 1018 1902 7823 -2834 7806 -2868 7863 -2725 7830 -2818 1426 1839 7861
- -2743 1220 1883 7837 -2794 7870 -2711 1387 1791 7859 -2732 1074 1846 1230 1820
- 7819 -2839 967 1848 1270 1778 1233 1777 1321 1853 7778 -2924 7899 -2645 1479
- 1799 1095 1815 1358 1844 1214 1780 922 1894 1275 1771 100 { m20} R 7825 -2821
- 7851 -2764 1659 1658 7794 -2895 7800 -2883 1338 1838 1332 1885 1405 1841 1107
- 1849 1206 1832 1192 1791 1314 1876 1331 1852 1508 1827 1281 1797 1294 1882 7827
- -2816 7850 -2762 7885 -2677 7810 -2861 7815 -2850 7784 -2910 1665 1757 7821
- -2838 7808 -2857 7796 -2885 7809 -2852 1139 1876 7824 -2829 7815 -2851 1058
- 1821 916 1825 1059 1887 1388 1787 1269 1889 1724 1702 1515 1801 7854 -2759 7869
- -2722 1309 1801 1438 1837 7873 -2710 1495 1832 7838 -2783 7787 -2909 1201 1828
- 1407 1834 1375 1860 7793 -2897 7813 -2855 1265 1822 965 1936 7885 -2687 7829
- -2813 1144 1901 55 { m20} R 0 0.8 0.4069E-06 c 7806 -2871 1312 1959 1151 2018
- 7823 -2836 7846 -2781 1570 1871 1589 1925 7878 -2712 1609 1901 1275 1976 1514
- 1911 1177 1999 1420 1919 1354 1928 1339 1985 7868 -2738 7844 -2790 7830 -2822
- 7811 -2861 7831 -2820 1046 2000 7822 -2839 7865 -2739 1201 1989 1353 1994 7839
- -2805 7863 -2751 1774 1798 7839 -2800 1192 1996 7822 -2837 7872 -2730 7820
- -2843 1502 1961 7832 -2817 1377 1973 7870 -2736 7825 -2834 1691 1787 1353 1984
- 1237 1998 1341 1981 1025 1979 7839 -2806 1375 1980 1383 1944 1488 1884 7908
- -2646 1478 1980 1484 1963 7866 -2736 7846 -2784 1479 1902 7823 -2834 1266 1968
- 1424 1901 7875 -2722 7801 -2881 1316 1959 1404 1927 1253 1962 1116 1963 1350
- 1963 1383 1977 1455 1945 7872 -2727 7823 -2836 1367 1922 7846 -2789 1481 1947
- 7900 -2659 7831 -2819 1230 1978 7870 -2725 7879 -2707 7907 -2644 1405 1986 1538
- 1873 7901 -2659 1371 1954 1441 1897 1066 1956 7826 -2831 7902 -2651 1521 1965
- 7857 -2759 1701 1808 1542 1859 7833 -2817 1431 1960 1155 1988 1390 1996 1342
- 1979 1383 1960 7828 -2827 7872 -2730 1558 1948 7822 -2837 1435 1991 7890 -2686
- 100 { m20} R 1506 1962 1569 1943 1514 1973 7871 -2732 7813 -2857 7827 -2826
- 7875 -2722 709 1925 7813 -2856 7892 -2681 7831 -2819 1099 1980 7863 -2751 7861
- -2756 1635 1824 1581 1886 1694 1767 1340 1969 7898 -2670 7882 -2702 878 1955
- 1283 1927 1345 1987 7859 -2761 1096 1951 1357 1956 7834 -2813 1449 1944 7869
- -2733 7837 -2808 1319 1902 1073 2035 7869 -2735 7820 -2841 7890 -2677 975 1990
- 1528 1906 1413 1979 1254 1986 7829 -2825 788 1967 7897 -2671 1345 1981 1453
- 1925 1586 1894 7907 -2640 1435 1924 7884 -2702 1363 1906 615 1978 7875 -2714
- 1370 1905 7861 -2749 1636 1853 1540 1910 1286 1972 7865 -2744 1582 1887 1494
- 1970 1305 1913 7840 -2803 7832 -2818 1337 1953 7863 -2744 7873 -2721 1041 2011
- 1405 1970 7862 -2744 7812 -2860 1438 1940 1904 1660 7856 -2765 1282 1911 1275
- 1952 7855 -2766 1331 1982 1683 1781 1276 1984 1420 1899 7862 -2747 7871 -2735
- 1179 2007 7824 -2835 7868 -2739 1320 1963 7883 -2704 7838 -2806 7850 -2774 1239
- 1961 1717 1793 1414 1974 1518 1870 7890 -2683 7891 -2679 7854 -2767 7871 -2733
- 7813 -2856 7863 -2751 1366 1926 1360 1952 100 { m20} R 7884 -2703 7805 -2873
- 7846 -2786 7882 -2708 7854 -2767 7825 -2833 7872 -2723 7831 -2820 7868 -2741
- 7827 -2829 7812 -2859 944 2022 7879 -2717 7844 -2794 1388 1925 7835 -2810 7827
- -2828 7844 -2793 7839 -2798 7873 -2724 7856 -2760 7884 -2703 7832 -2816 7809
- -2866 7819 -2845 7895 -2678 1340 1916 7898 -2667 7875 -2722 1223 1983 7869
- -2733 7827 -2824 7837 -2808 7860 -2759 7858 -2764 1589 1872 7874 -2721 1354
- 1989 676 1957 985 1960 1325 1903 7844 -2788 1301 1986 7886 -2699 7890 -2676
- 1110 1999 7838 -2802 1330 1954 1190 1936 1189 1943 1571 1879 7892 -2676 1079
- 2023 1596 1830 7807 -2870 7906 -2652 1297 1936 7834 -2816 7814 -2854 807 2029
- 1283 1976 1380 1963 1422 1926 7869 -2735 7834 -2812 1624 1900 7806 -2872 67 {
- m20} R 0.14545 0.8 0 c 1097 2052 7884 -2706 7864 -2755 7837 -2809 1305 2039
- 1429 2030 1497 2047 7858 -2767 7877 -2726 1394 2016 1695 1940 1404 2037 7889
- -2697 1371 2071 7893 -2686 1479 2035 1434 2032 1277 2013 7865 -2749 7898 -2679
- 7854 -2774 1197 2067 7906 -2659 7870 -2743 1644 1928 7879 -2722 1434 2018 7904
- -2663 1470 2039 1406 2027 1319 2013 7876 -2728 902 2082 1368 2015 1455 2066
- 7889 -2694 1429 2000 1398 2020 1444 2035 1236 2067 1499 2031 1447 1996 1374
- 2004 1443 2004 1499 2022 1415 2049 1082 2083 7862 -2757 1584 1998 1304 2018
- 7872 -2735 1579 2007 7859 -2765 1394 2005 1355 2046 1375 2000 1504 2031 1185
- 2015 1444 2068 7859 -2764 7867 -2746 7889 -2701 1320 2072 7872 -2738 1377 2000
- 7865 -2751 7847 -2789 7871 -2735 1366 2004 1425 2057 1459 2062 1224 2039 7906
- -2656 1372 2020 1360 2070 1411 2065 1216 2070 7904 -2661 7883 -2710 1427 2052
- 1463 2052 7897 -2681 7895 -2680 1400 2038 1389 2030 1435 2060 7857 -2768 7860
- -2763 1577 2027 1489 1995 7863 -2756 7878 -2719 7898 -2672 7850 -2783 1336 2043
- 1308 2061 1485 1990 7890 -2691 1510 2055 1343 2042 100 { m20} R 1373 2046 7902
- -2671 7883 -2709 1448 2066 1626 1975 7880 -2718 7867 -2748 7884 -2711 1162 2077
- 1332 2056 1166 2073 7866 -2749 7889 -2694 1266 2048 1446 2061 7896 -2680 1431
- 2003 1484 2029 1456 2012 1389 2061 1398 2024 7878 -2721 1395 2019 1440 2052
- 7892 -2690 7874 -2730 7870 -2740 1317 2046 7845 -2792 7890 -2699 1451 2030 7867
- -2749 1347 2023 1339 2035 7902 -2665 7855 -2771 1545 2002 7867 -2748 1529 2003
- 7877 -2727 1486 2017 1301 2021 1399 2060 7887 -2703 7873 -2732 7867 -2749 1726
- 1933 1417 2038 7895 -2680 1442 2064 1358 2055 7871 -2739 1390 2055 7894 -2689
- 1276 2018 1302 2013 1002 2054 7885 -2706 7889 -2698 7871 -2741 1392 2013 1236
- 2008 7848 -2787 1394 2010 7894 -2690 1324 1997 1038 2079 1636 1962 1308 2027
- 1256 2007 7849 -2785 7859 -2765 7874 -2731 1266 2006 7854 -2773 1378 2036 7879
- -2720 1356 2008 7870 -2742 7873 -2733 1215 2082 7887 -2698 1453 2002 7889 -2694
- 1536 1994 1508 2015 1327 2024 1292 2032 1678 1904 1407 1999 1330 2058 1321 2004
- 1542 2036 1330 2043 1512 2047 1155 2039 7879 -2721 7847 -2789 7856 -2771 7897
- -2682 100 { m20} R 1473 2040 1296 2020 7865 -2752 7880 -2721 1204 2081 7870
- -2739 1083 2049 1435 2009 7859 -2765 7893 -2690 1185 2039 1444 2057 1475 2059
- 1255 2065 7886 -2703 1592 2009 7879 -2722 7861 -2760 7854 -2774 1222 2049 7853
- -2774 7870 -2739 1509 2045 1676 1907 1523 2050 7860 -2761 7867 -2747 1411 2067
- 7871 -2741 7900 -2667 1677 1926 7857 -2770 7895 -2680 1202 2077 7896 -2682 1272
- 2035 1512 1993 7871 -2739 7884 -2710 7883 -2709 7849 -2784 7877 -2727 7903
- -2671 1629 1969 1319 2067 1499 2028 1531 2049 7850 -2781 1316 2025 7881 -2717
- 7908 -2653 7903 -2668 1492 2061 7866 -2750 7894 -2685 7879 -2721 1044 2085 7895
- -2688 7848 -2786 1372 2008 60 { m20} R 0.29091 0.8 0 c 1364 2116 1479 2121 7898
- -2687 7884 -2713 1349 2134 7899 -2684 1335 2117 7880 -2723 1286 2128 1523 2096
- 7906 -2668 1520 2059 1389 2112 1590 2048 1561 2069 1458 2071 7887 -2708 7903
- -2674 7904 -2674 1509 2117 1419 2108 1501 2084 1296 2123 1689 1985 1238 2085
- 1440 2139 1375 2129 7883 -2716 7906 -2665 1416 2093 7900 -2681 1478 2125 1489
- 2083 1750 1946 1589 2060 1452 2131 1431 2113 1420 2116 1406 2099 1385 2106 1261
- 2116 1570 2061 1577 2072 1627 2067 1334 2097 1371 2138 7890 -2702 1595 2063
- 1424 2106 7888 -2704 1653 2032 7909 -2663 1586 2030 1339 2095 7880 -2722 1519
- 2098 7909 -2659 1384 2104 1442 2073 7890 -2700 1410 2095 7885 -2710 1531 2099
- 7903 -2672 1402 2124 1482 2081 1486 2106 7900 -2681 7896 -2687 1519 2111 1576
- 2072 1365 2095 1441 2124 7881 -2720 7888 -2705 1497 2123 7890 -2701 1278 2079
- 1400 2084 7884 -2713 7884 -2714 1482 2089 7898 -2685 7896 -2690 1439 2102 1487
- 2130 7895 -2689 1363 2107 1438 2118 1444 2088 1491 2083 7904 -2672 7891 -2698
- 1652 2026 1583 2036 1322 2118 1282 2107 1477 2112 7905 -2666 1648 2017 100 {
- m20} R 1462 2120 7900 -2679 1373 2110 7897 -2686 7894 -2692 1309 2135 7888
- -2705 7897 -2688 1572 2054 1469 2110 1278 2102 7880 -2722 1259 2105 7894 -2693
- 7896 -2690 1380 2132 1517 2076 1256 2114 7903 -2672 7901 -2677 1696 1977 7892
- -2695 7895 -2693 7897 -2685 1589 2076 7909 -2659 1427 2098 7887 -2707 1219 2090
- 1405 2078 7908 -2665 1511 2058 1362 2114 7900 -2678 1620 2056 1152 2109 1492
- 2130 1543 2079 1376 2103 1500 2118 1601 2025 1397 2116 1473 2094 1441 2099 1341
- 2126 1450 2089 7902 -2676 1242 2084 1456 2108 7908 -2662 1249 2122 7901 -2680
- 1322 2137 1342 2117 7903 -2671 1528 2065 7872 -2739 1577 2076 1341 2091 1483
- 2123 1663 2049 1510 2110 2155 1655 1267 2093 1400 2100 1440 2109 1505 2090 1559
- 2104 1383 2119 7901 -2675 7904 -2671 1444 2081 7889 -2704 1845 1882 1469 2086
- 1325 2107 7891 -2699 7894 -2692 1500 2118 7901 -2676 1161 2109 1601 2041 1486
- 2115 7891 -2697 7876 -2730 1426 2125 1340 2086 7876 -2729 1510 2089 1574 2046
- 1759 1976 7886 -2710 7875 -2732 7909 -2662 1594 2033 1142 2144 1157 2113 1550
- 2058 7874 -2735 1514 2121 100 { m20} R 7881 -2719 7882 -2717 7888 -2703 7893
- -2695 1241 2121 1378 2132 7888 -2704 1325 2128 7895 -2691 1801 1916 7874 -2735
- 11 { m20} R 0.43636 0.8 0 c 1464 2148 1434 2184 1377 2192 1458 2154 1520 2127
- 1370 2180 1501 2185 1369 2166 1410 2142 1580 2132 1327 2140 1476 2187 1480 2163
- 1568 2108 1463 2178 1317 2187 1667 2075 1606 2096 1478 2161 1263 2164 1310 2188
- 1612 2126 1516 2146 1459 2176 1543 2149 1849 1929 1411 2157 1491 2167 1308 2153
- 1686 2075 1339 2155 1300 2194 1518 2166 1308 2183 7905 -2671 1534 2154 1543
- 2165 7902 -2678 1407 2195 1580 2152 1396 2140 1498 2183 1352 2158 1457 2173
- 1343 2158 1388 2177 1346 2174 1350 2179 1419 2191 1517 2155 1460 2160 1561 2128
- 1431 2186 1403 2177 1480 2179 1499 2159 1576 2103 1580 2130 1478 2148 1507 2143
- 1339 2166 1559 2155 1500 2149 1380 2177 1502 2185 1365 2190 1565 2150 1651 2111
- 1337 2175 1404 2186 1455 2185 1543 2124 1437 2188 1464 2148 1379 2147 1474 2175
- 1596 2096 1424 2151 1689 2059 1652 2086 7900 -2682 1722 2042 1453 2175 1277
- 2196 1573 2134 1501 2180 1535 2151 1423 2160 1375 2178 1393 2141 1507 2130 1499
- 2187 1542 2118 1518 2176 1567 2146 1484 2149 1435 2164 1430 2170 1454 2165 1610
- 2094 100 { m20} R 7907 -2667 7900 -2682 7899 -2684 1705 2065 1607 2115 1676
- 2045 1444 2179 1499 2157 1488 2134 1370 2146 1347 2187 1559 2126 1259 2157 1625
- 2095 1558 2136 1602 2143 1451 2175 1451 2182 1204 2194 1173 2184 1427 2172 1362
- 2170 1432 2159 1553 2116 1550 2123 1380 2176 1340 2155 1339 2183 1492 2182 1620
- 2110 1321 2159 1476 2146 7905 -2671 1397 2178 34 { m20} R 0.58182 0.8 0 c 1381
- 2199 1388 2241 1381 2224 1430 2217 1324 2240 1470 2232 1312 2213 1404 2242 1392
- 2221 1395 2223 1497 2196 1338 2200 1471 2203 1478 2198 1397 2237 1482 2198 1546
- 2189 1586 2165 1498 2214 1334 2239 1507 2196 1388 2212 1384 2230 1298 2238 1412
- 2212 1552 2182 1322 2226 1359 2224 1419 2232 1505 2199 1470 2209 1534 2197 1502
- 2232 1493 2215 1485 2211 1481 2231 1467 2241 1492 2231 1541 2178 1091 2259 1445
- 2219 1465 2194 1439 2219 1464 2208 1401 2204 1549 2190 1349 2202 1501 2196 1461
- 2243 1474 2234 1413 2232 1486 2223 1306 2243 1461 2201 1429 2220 1272 2236 1486
- 2193 1547 2193 1508 2223 1367 2235 1419 2215 1500 2226 1239 2210 1432 2235 1378
- 2202 1455 2236 1563 2182 1447 2236 1496 2202 1511 2191 1532 2201 1480 2205 1505
- 2208 1417 2216 1512 2194 1363 2215 1448 2232 1407 2205 1429 2232 1407 2235 1375
- 2211 1335 2230 1454 2230 1334 2198 1437 2242 1592 2156 1542 2177 1480 2228 1391
- 2233 1483 2222 1451 2201 1227 2213 1478 2233 1389 2241 1525 2183 1476 2196 1504
- 2212 1357 2239 1543 2186 1508 2194 100 { m20} R 1425 2210 1510 2222 1394 2201 3
- { m20} R 0.72727 0.8 0 c 1367 2275 1386 2258 1414 2280 1392 2253 1457 2269 1464
- 2265 1455 2253 1314 2273 1435 2275 1453 2263 1415 2250 1473 2248 1455 2263 1369
- 2247 1325 2261 1416 2263 1460 2264 1417 2251 1485 2242 1445 2250 1423 2282 1423
- 2245 1437 2264 1417 2255 1368 2251 1364 2274 1230 2281 1405 2250 1392 2279 1434
- 2271 1374 2246 1463 2258 1429 2276 1357 2257 34 { m20} R 0.8 0.72727 0 c 1389
- 2321 1354 2315 1432 2296 1354 2315 1386 2307 1398 2289 1430 2294 1291 2299 1399
- 2323 1421 2300 1325 2317 1396 2321 1383 2309 1328 2301 1393 2316 1386 2293 1418
- 2314 1359 2304 18 { m20} R 0.8 0.58182 0 c 1379 2330 1376 2339 1339 2329 3 {
- m20} R 0.8 0.43636 0 c 1379 2330 0.8 0.29091 0 c 1379 2330 0.8 0.14546 0 c 1379
- 2330 0 0 0.8 c 1379 2330 0 0.14545 0.8 c 1379 2330 0 0.29091 0.8 c 7597 -2802
- 7307 -2940 2 { m20} R 0 0.43636 0.8 c 7617 -2863 7204 -3034 7449 -2908 3 { m20
-} R 0 0.58182 0.8 c 7731 -2791 7180 -3162 7225 -3067 7681 -2847 6949 -3216 7466
- -3019 7553 -2950 7634 -2894 7344 -3065 7720 -2794 7299 -3071 7605 -2936 7517
- -2993 7125 -3159 7644 -2865 7369 -3065 7478 -3016 7322 -3095 7708 -2814 7592
- -2946 7111 -3145 7498 -2987 7093 -3125 7276 -3131 24 { m20} R 0 0.72727 0.8 c
- 7466 -3158 7592 -2992 7600 -3007 7345 -3230 7679 -2891 7636 -2914 7477 -3149
- 7704 -2850 7626 -2981 7524 -3054 7312 -3175 7717 -2856 7548 -3001 7757 -2775
- 7523 -3111 7530 -3082 7631 -2958 6865 -3339 7543 -3082 7515 -3107 7476 -3124
- 7691 -2902 7707 -2840 7540 -3082 7692 -2855 7599 -2976 7467 -3133 7631 -2991
- 7561 -3056 7229 -3250 7647 -2933 7567 -3000 7375 -3129 7376 -3168 7064 -3326
- 7727 -2820 7409 -3187 7456 -3168 7233 -3256 7588 -3003 7388 -3179 7271 -3259 42
- { m20} R 0 0.8 0.72727 c 7641 -3043 7722 -2916 7643 -2992 7577 -3075 7542 -3213
- 7510 -3154 7579 -3141 7597 -3058 7721 -2880 7382 -3236 7268 -3288 7490 -3282
- 7619 -3066 7395 -3449 7796 -2777 7543 -3113 7597 -3078 7570 -3137 7791 -2773
- 7316 -3388 7367 -3345 7611 -3028 7753 -2860 7205 -3425 7698 -2931 7738 -2879
- 7563 -3186 7522 -3130 7248 -3382 7700 -2924 7649 -3027 7739 -2861 7659 -3027
- 7166 -3416 7531 -3186 7700 -2928 7188 -3569 7316 -3311 7307 -3432 7761 -2821
- 7416 -3231 7600 -3123 7649 -3029 7732 -2882 7343 -3274 7752 -2850 7586 -3155
- 7656 -2997 7336 -3431 7783 -2770 7472 -3319 7532 -3260 7638 -3012 7318 -3426
- 7599 -3054 7601 -3116 6973 -3403 7810 -2726 7585 -3122 7547 -3229 7270 -3364
- 7713 -2938 7431 -3395 7789 -2788 7294 -3449 7642 -3009 7617 -3037 7358 -3308
- 7737 -2851 7509 -3274 7555 -3140 7722 -2869 7281 -3286 7644 -3011 7598 -3073
- 7697 -2903 7573 -3131 7466 -3177 7760 -2807 7506 -3188 7640 -3003 7039 -3518
- 7575 -3160 7766 -2832 7536 -3144 7700 -2946 86 { m20} R 0 0.8 0.58182 c 7796
- -2800 7669 -3098 7725 -2919 7726 -2928 7615 -3225 7635 -3143 7687 -2991 7719
- -2975 7654 -3077 7596 -3164 7471 -3531 7315 -3746 7841 -2695 7755 -2876 7712
- -2998 7298 -3805 7725 -2919 1082 1192 7642 -3121 7671 -3097 7529 -3286 7449
- -3389 7695 -3023 7755 -2866 7810 -2783 7290 -3610 7723 -2925 7762 -2890 7643
- -3157 1091 1143 7830 -2721 7715 -2936 7652 -3087 7323 -3719 7655 -3134 7666
- -3053 7783 -2827 7616 -3206 7692 -2986 7567 -3279 7484 -3350 7597 -3267 1127
- 952 7601 -3209 7625 -3111 7789 -2831 7767 -2860 7703 -2966 7593 -3186 7789
- -2832 7683 -3055 7728 -2937 777 576 7408 -3613 7549 -3351 474 922 7707 -3017
- 7619 -3219 7540 -3276 7619 -3127 1162 1177 7537 -3411 7611 -3238 7699 -2995
- 7623 -3119 7798 -2808 7794 -2804 7852 -2697 7774 -2852 7716 -2966 7701 -2985
- 7723 -2970 7616 -3179 7531 -3404 7525 -3281 7686 -3029 7523 -3426 7669 -3047
- 7653 -3098 7493 -3485 7699 -3013 7767 -2854 7653 -3102 7595 -3198 7424 -3643
- 7747 -2882 7759 -2885 7711 -3002 7646 -3130 7755 -2859 7758 -2897 7671 -3069
- 7597 -3165 7739 -2934 7599 -3147 7710 -2999 7528 -3359 7623 -3141 7588 -3282
- 7709 -2957 100 { m20} R 7090 -4209 7305 -3573 7576 -3212 7717 -2987 7698 -2968
- 1116 1035 7632 -3121 7604 -3227 7664 -3104 7627 -3179 7338 -3554 7506 -3475
- 7621 -3155 7671 -3061 7323 -3623 7661 -3049 7553 -3256 7676 -3086 7753 -2877
- 7589 -3218 7651 -3112 7812 -2766 7553 -3327 7508 -3318 7675 -3055 7712 -2961
- 7496 -3340 7686 -3063 7831 -2723 7584 -3191 7640 -3102 7736 -2943 7590 -3275
- 7710 -2988 7623 -3178 7735 -2898 7325 -3733 7497 -3374 841 1127 7596 -3276 7660
- -3078 7650 -3140 7755 -2873 7794 -2791 7644 -3088 1294 961 7664 -3102 7599
- -3155 7734 -2943 7710 -2989 7735 -2947 7755 -2901 7740 -2887 53 { m20} R 0 0.8
- 0.43636 c 7675 -3132 1323 1443 1158 1579 7778 -2887 7598 -3286 7698 -3057 7722
- -3010 7708 -3035 835 1560 1497 1441 7606 -3264 7670 -3127 943 1615 1544 1448
- 7758 -2935 7798 -2840 1278 1503 7762 -2926 7712 -3039 1348 1539 7614 -3247 7793
- -2837 7845 -2740 1088 1555 1318 1551 7808 -2804 7789 -2857 1017 1245 7646 -3187
- 7794 -2840 7829 -2762 7764 -2914 7855 -2693 7698 -3069 7758 -2943 7745 -2964
- 1380 1436 7803 -2835 7754 -2936 7680 -3081 7796 -2840 1280 1392 7820 -2793 7711
- -3012 7596 -3287 7842 -2734 7795 -2844 924 1423 7670 -3138 7630 -3210 7721
- -2991 7577 -3332 7787 -2869 7845 -2731 7692 -3076 934 1366 7771 -2894 7789
- -2844 1092 1566 7835 -2756 7742 -2969 824 1358 7777 -2872 7702 -3042 7668 -3113
- 7741 -2948 1144 1376 7789 -2857 1460 1525 1151 1586 7659 -3128 1129 1283 7793
- -2830 7765 -2909 1368 1424 7780 -2857 516 1489 1202 1478 7733 -2975 1308 1486
- 7858 -2695 7809 -2804 1028 1532 7669 -3106 7820 -2781 7782 -2884 7663 -3158
- 7732 -2986 7702 -3055 7771 -2877 1199 1464 7831 -2767 1503 1503 7718 -2996 7782
- -2883 7835 -2752 7784 -2864 7751 -2961 7800 -2844 7707 -3050 100 { m20} R 7796
- -2821 7819 -2793 7755 -2915 7767 -2913 7749 -2955 7662 -3160 1173 1557 1038
- 1387 7808 -2807 7698 -3046 7716 -3014 7675 -3089 7757 -2923 7642 -3200 1251
- 1411 7645 -3171 7723 -2993 1325 1390 312 1450 1112 1440 7775 -2872 690 1545
- 7666 -3126 864 1415 7735 -2961 7819 -2772 7717 -3018 7631 -3222 7656 -3163 1321
- 1428 7773 -2877 7646 -3180 7629 -3217 1107 1563 1409 1554 7712 -3021 7647 -3177
- 732 1608 7678 -3128 7734 -2987 7722 -2999 1144 1587 7681 -3116 7715 -2997 7617
- -3251 7684 -3078 7708 -3023 7862 -2685 7689 -3075 7767 -2911 1340 1503 7730
- -3001 7757 -2923 7731 -2992 7737 -2987 7720 -3017 7758 -2904 7570 -3344 954
- 1542 1126 1221 7770 -2884 7813 -2792 1016 1591 7734 -2966 7681 -3085 743 1364
- 7744 -2957 7579 -3326 7695 -3092 1112 1334 7740 -2962 7751 -2961 1143 1504 1339
- 1448 903 1529 987 1556 7775 -2886 7745 -2954 7794 -2856 1403 1382 7792 -2850
- 7740 -2944 800 1525 7781 -2862 7674 -3091 7703 -3056 7786 -2868 1117 1594 7859
- -2686 7823 -2768 7683 -3107 1069 1376 7711 -3019 7708 -3053 7774 -2892 7810
- -2811 1351 1581 1536 1311 98 { m20} R 0 0.8 0.29091 c 1365 1691 7813 -2819 7837
- -2773 7797 -2879 7716 -3044 1261 1597 7714 -3056 7795 -2880 1151 1709 1116 1693
- 1166 1647 7739 -3006 1228 1699 7783 -2906 7756 -2962 7823 -2795 1365 1678 1298
- 1674 7800 -2845 1009 1686 7743 -2983 1440 1739 1081 1615 1304 1736 7830 -2779
- 917 1648 1194 1703 7822 -2802 1299 1729 7802 -2854 7784 -2904 7732 -3020 1353
- 1680 1192 1610 7780 -2911 7775 -2924 7752 -2968 7765 -2948 7805 -2847 7792
- -2889 7770 -2918 7855 -2732 1591 1605 7792 -2866 1199 1747 7783 -2886 1177 1743
- 1337 1593 1351 1708 7768 -2924 7791 -2886 7755 -2974 1208 1691 1410 1626 7809
- -2845 7849 -2756 944 1648 1239 1697 1042 1729 7809 -2845 7815 -2827 7725 -3030
- 1241 1711 858 1720 7863 -2708 7782 -2914 7779 -2919 1370 1755 7906 -2618 7811
- -2837 7841 -2768 1178 1732 1254 1695 7783 -2893 7789 -2878 1240 1595 7734 -3016
- 7732 -3020 7801 -2849 1469 1575 7849 -2744 7822 -2815 7830 -2793 1184 1726 7785
- -2906 1341 1626 7862 -2720 7733 -3010 7785 -2902 1335 1615 7787 -2894 1420 1596
- 1246 1761 7771 -2926 1232 1665 7722 -3038 7810 -2844 7795 -2861 7830 -2795 7906
- -2613 100 { m20} R 1246 1631 1278 1590 1009 1695 7702 -3080 7821 -2817 7848
- -2753 7697 -3090 7846 -2757 1259 1724 1110 1674 7843 -2767 1344 1701 7771 -2928
- 7779 -2906 7735 -3015 7798 -2875 7826 -2807 911 1631 7784 -2886 7872 -2685 7811
- -2837 1570 1675 1279 1752 1285 1654 7798 -2875 7833 -2777 896 1786 7828 -2796
- 1495 1737 7823 -2812 1260 1677 7806 -2846 1187 1673 7771 -2931 7785 -2901 926
- 1637 1400 1620 7808 -2851 7755 -2967 7814 -2836 7828 -2804 1258 1716 1359 1742
- 7775 -2919 7761 -2945 7739 -3001 7772 -2932 7778 -2922 7741 -2990 1017 1658
- 7703 -3077 7764 -2935 807 1635 7679 -3127 1284 1664 1202 1703 1144 1598 7802
- -2861 1109 1787 948 1797 1070 1713 7778 -2920 7757 -2961 1287 1624 1141 1745
- 7766 -2941 1233 1764 1181 1609 904 1809 1045 1662 1429 1698 924 1636 953 1779
- 1012 1725 7757 -2968 7776 -2927 7806 -2855 7858 -2730 1217 1736 7823 -2814 7830
- -2786 7879 -2667 7817 -2811 1377 1689 7738 -3009 1171 1635 7735 -3011 1317 1608
- 7770 -2930 7775 -2927 1289 1769 7851 -2750 1078 1707 1460 1561 1163 1700 7780
- -2909 7767 -2932 7771 -2919 1083 1753 7759 -2962 100 { m20} R 7790 -2872 7738
- -3004 1455 1755 7735 -3011 7721 -3036 7795 -2878 1332 1613 1131 1701 1169 1639
- 7716 -3053 7717 -3048 1388 1764 7756 -2965 7706 -3072 7785 -2901 7828 -2787
- 1253 1735 1307 1731 1271 1644 7711 -3060 7852 -2742 1125 1634 7862 -2722 1175
- 1766 7846 -2760 1414 1694 7695 -3093 7744 -2992 7831 -2780 7772 -2934 1197 1739
- 7735 -3013 7800 -2850 1479 1670 1356 1740 7797 -2861 7753 -2976 1147 1698 1405
- 1749 1260 1664 7781 -2915 1388 1696 920 1741 1411 1703 814 1735 7851 -2738 7869
- -2704 7744 -2984 7752 -2976 1169 1675 7852 -2729 7759 -2956 7720 -3045 7718
- -3048 7837 -2764 7792 -2888 1273 1744 7814 -2833 7738 -3008 7767 -2944 7748
- -2987 7725 -3035 1412 1646 7704 -3076 1636 1574 7802 -2863 1399 1631 7715 -3050
- 7781 -2898 7775 -2928 1276 1750 7782 -2910 7801 -2843 964 1745 74 { m20} R 0
- 0.8 0.14545 c 7819 -2842 1246 1890 1284 1851 1400 1872 1413 1801 7892 -2670
- 1317 1855 7879 -2696 1483 1777 7800 -2879 7822 -2832 7838 -2789 7808 -2858 876
- 1936 7842 -2789 7829 -2809 1432 1827 7806 -2871 1466 1829 1107 1832 1313 1827
- 1403 1836 1402 1881 7884 -2689 1344 1820 927 1828 1099 1857 7842 -2790 1484
- 1838 1101 1870 7807 -2859 1462 1856 1360 1897 7859 -2742 1516 1760 7811 -2860
- 7868 -2713 7804 -2865 882 1902 1308 1794 1394 1876 1188 1864 7785 -2914 1327
- 1852 7775 -2931 1496 1740 7817 -2839 7853 -2765 1221 1847 7852 -2766 992 1828
- 1231 1900 7839 -2796 1041 1884 1279 1836 7825 -2819 7875 -2707 7807 -2857 7873
- -2702 1315 1838 1292 1815 7869 -2716 7767 -2950 7891 -2668 7871 -2706 7838
- -2794 7879 -2691 7813 -2849 7863 -2734 1140 1789 7870 -2710 1594 1811 7796
- -2888 1086 1918 1393 1802 1259 1826 7772 -2936 1420 1876 7821 -2839 1024 1831
- 7826 -2824 1346 1877 1360 1818 7802 -2878 1368 1877 1401 1778 7841 -2786 7843
- -2785 1204 1783 7856 -2749 1339 1818 1458 1812 7844 -2777 1421 1769 1265 1794
- 1530 1746 7890 -2660 1014 1878 7847 -2762 7850 -2767 100 { m20} R 7831 -2803
- 7853 -2754 1130 1828 7782 -2919 7869 -2723 7774 -2936 7775 -2934 1511 1779 7843
- -2782 959 1916 7810 -2855 1396 1814 1650 1781 1480 1857 7795 -2887 1419 1887
- 7815 -2843 1020 1896 7897 -2660 1363 1840 859 1858 7805 -2865 1490 1866 7892
- -2667 7847 -2779 1521 1863 1404 1784 1098 1885 1354 1878 1208 1880 7777 -2930
- 7787 -2910 7810 -2858 1230 1788 7792 -2899 7864 -2725 7864 -2726 1516 1754 7852
- -2764 1241 1864 7885 -2682 1562 1787 1337 1898 7844 -2785 7874 -2703 1221 1819
- 7777 -2928 7802 -2875 1845 1552 1269 1804 7796 -2889 1020 1871 7778 -2922 7768
- -2947 7809 -2865 7881 -2691 1241 1796 1030 1926 7801 -2880 1314 1800 1531 1855
- 7842 -2791 1473 1788 7807 -2865 1406 1803 1464 1880 1409 1876 1014 1938 7812
- -2848 7811 -2856 7800 -2883 1536 1761 1374 1890 7832 -2806 7819 -2828 1348 1785
- 7860 -2745 1047 1931 1233 1796 7900 -2644 1175 1792 7840 -2777 7875 -2705 7856
- -2743 7814 -2854 1286 1843 7875 -2698 1100 1900 7838 -2793 1328 1831 7794 -2896
- 7819 -2840 1462 1780 7899 -2645 7870 -2708 7842 -2787 7784 -2917 1502 1869 700
- 1833 7899 -2650 100 { m20} R 1241 1887 7847 -2770 1548 1832 1544 1826 7797
- -2880 7781 -2921 1376 1875 7831 -2810 1186 1868 7844 -2777 7855 -2751 1515 1800
- 1214 1848 1293 1842 7818 -2838 1137 1856 7777 -2930 7902 -2640 7793 -2891 1174
- 1900 7776 -2928 1250 1795 7823 -2822 1138 1884 1643 1688 7774 -2936 1309 1795
- 7816 -2850 7829 -2807 7870 -2710 1186 1825 810 1843 7818 -2844 7811 -2847 1351
- 1844 1476 1773 1199 1903 7786 -2911 1306 1785 7827 -2810 7782 -2917 1519 1831
- 1469 1796 1977 1540 7833 -2805 7803 -2867 7804 -2870 7764 -2956 7834 -2801 7831
- -2808 7818 -2842 1310 1874 7808 -2865 1222 1806 7818 -2843 1319 1856 1223 1830
- 7834 -2792 7839 -2785 927 1854 1136 1903 1366 1847 7805 -2872 1437 1831 1411
- 1865 1256 1878 7818 -2843 1322 1881 7804 -2873 7849 -2762 7750 -2984 71 { m20
-} R 0 0.8 0.4069E-06 c 1533 1889 7829 -2824 7883 -2705 7823 -2837 1263 1966 1231
- 1999 7854 -2768 7859 -2762 7869 -2737 1084 2021 1404 1918 1099 1935 1505 1958
- 7867 -2740 1375 1986 7842 -2793 1289 1971 7877 -2714 1309 1972 7875 -2725 1191
- 1955 7840 -2797 7849 -2775 1389 1984 7835 -2812 7874 -2724 7855 -2770 1659 1877
- 7845 -2791 1519 1965 7835 -2812 7863 -2744 1260 1958 1467 1890 7862 -2750 1139
- 1976 1290 1925 1349 1935 7850 -2772 1087 2028 7830 -2822 1064 1957 1409 1940
- 7897 -2664 1343 1947 7880 -2709 7871 -2722 1535 1927 7870 -2730 1200 1932 7846
- -2781 7851 -2772 1471 1985 1271 1956 7850 -2778 7818 -2846 7825 -2832 1339 1934
- 1201 1971 1516 1889 1343 1975 7874 -2721 7867 -2744 1481 1913 1419 1964 7887
- -2688 7831 -2816 1255 1919 1478 1943 1340 1961 7813 -2857 7851 -2773 7871 -2728
- 1559 1947 7829 -2826 7852 -2776 7861 -2756 1429 1976 1622 1886 1377 1913 7906
- -2652 7851 -2773 1338 1948 7895 -2667 1269 1952 7828 -2826 1361 1901 7863 -2749
- 7888 -2688 1153 1927 1230 1962 1568 1843 1285 1933 1169 1972 7827 -2829 1367
- 1944 7895 -2677 7864 -2750 1368 1980 7836 -2809 100 { m20} R 1539 1926 1031
- 2036 7851 -2775 7828 -2824 1172 1921 1455 1941 7903 -2649 1231 1907 7890 -2680
- 7824 -2835 1459 1898 1130 1942 7831 -2817 7849 -2783 1189 1958 1204 1968 1221
- 1926 7853 -2771 7828 -2826 1306 1910 7815 -2853 1212 1921 1573 1852 7872 -2722
- 1304 1922 7890 -2684 1334 1948 7888 -2693 7852 -2776 7841 -2792 7860 -2759 1740
- 1795 1409 1925 7850 -2778 7899 -2667 1323 1959 7841 -2797 1302 1966 7836 -2811
- 7839 -2803 1542 1953 1244 1916 7873 -2723 7888 -2688 7842 -2796 1727 1758 7823
- -2837 1450 1915 7851 -2780 1424 1954 1272 1969 1529 1873 7877 -2715 1491 1976
- 1314 1906 1563 1939 1787 1754 7849 -2776 1258 1975 966 1961 1344 1965 1270 1954
- 1560 1892 1323 1932 7833 -2814 1231 1958 7866 -2739 7874 -2724 7873 -2725 7828
- -2827 1545 1944 1300 1950 7890 -2684 7832 -2819 7804 -2875 1383 1965 7848 -2783
- 1445 1914 7826 -2829 1434 1911 1412 1978 1357 1919 7854 -2768 7874 -2724 7903
- -2658 7854 -2766 7839 -2805 1540 1912 7835 -2813 1575 1931 1631 1867 1390 1916
- 1195 1994 7840 -2799 1266 1945 1069 1969 7831 -2821 7832 -2818 1517 1882 7825
- -2834 100 { m20} R 1445 1939 1470 1977 7831 -2821 7846 -2789 1331 1979 1015
- 1968 7862 -2749 1303 1916 1273 1976 1289 1915 7822 -2837 1425 1943 7798 -2887
- 1651 1876 7879 -2710 1734 1831 7853 -2772 7863 -2752 1223 1920 7857 -2764 1396
- 1973 7875 -2726 7886 -2693 7865 -2742 1318 1950 7809 -2865 1513 1973 7878 -2711
- 7863 -2753 1241 1933 7861 -2755 1130 2013 1338 1982 1530 1927 1188 1952 7881
- -2701 7848 -2782 1553 1916 1317 1918 39 { m20} R 0.14545 0.8 0 c 1475 2059 7874
- -2734 1217 2025 1420 2072 1385 2058 1294 2043 7908 -2656 7867 -2749 1357 2041
- 7849 -2784 7869 -2744 1489 1993 1335 2050 7908 -2655 7851 -2781 7864 -2754 1094
- 2106 1363 2052 7867 -2748 1664 1949 1258 2049 1421 2050 1449 2060 1093 2083
- 1341 2058 1399 2047 1342 2054 7906 -2661 7865 -2751 1604 1935 7864 -2753 1335
- 2068 1288 2002 7862 -2757 1244 2007 7885 -2709 1520 2020 1520 1986 1286 2033
- 7865 -2753 1321 1996 7901 -2669 7877 -2723 7854 -2775 1333 2061 1495 2028 1566
- 2034 7850 -2782 7893 -2690 7889 -2700 1414 2042 1396 2064 1634 1947 1868 1785
- 7853 -2777 7858 -2765 1474 2060 7888 -2702 1461 2039 7865 -2753 7853 -2777 1232
- 2021 7893 -2689 7908 -2657 7867 -2748 1307 2023 1661 1978 1470 2039 1456 2067
- 1606 1968 7872 -2736 1675 1959 7878 -2721 1386 2054 7906 -2662 1694 1930 7864
- -2752 7868 -2746 7870 -2742 7901 -2670 1211 2025 1630 1964 1568 2033 1402 2004
- 1147 2090 1519 2005 7881 -2719 7868 -2743 1309 2069 1316 2047 1454 2035 1768
- 1893 1584 2004 1309 2022 7891 -2690 1535 2041 932 2096 1527 1990 1252 2007 7879
- -2723 100 { m20} R 7892 -2691 7879 -2722 1347 2000 7870 -2742 1366 2015 7884
- -2709 1390 2054 7869 -2739 7878 -2723 7854 -2775 1234 2007 1010 2094 7873 -2737
- 7871 -2739 7907 -2660 7876 -2728 7868 -2745 1436 2062 7865 -2752 1457 2013 1396
- 2004 1374 2030 1455 1997 1361 2010 7866 -2748 7860 -2760 7881 -2716 7870 -2743
- 7846 -2790 7867 -2749 7892 -2694 7886 -2706 1494 2035 1141 2058 7868 -2744 1371
- 2037 1513 2027 7872 -2738 1219 2025 1552 2001 7902 -2668 7870 -2742 7904 -2660
- 1398 2011 7908 -2653 1394 2038 1598 1959 7873 -2735 1324 2018 7886 -2702 1533
- 1985 7892 -2693 1516 2052 7870 -2739 1302 2059 1570 2021 1501 2009 7882 -2711
- 1427 2059 1687 1892 1387 2060 1607 1998 1251 2016 1370 2037 7890 -2694 1299
- 2037 7903 -2667 1352 2061 7860 -2761 1614 1941 7876 -2724 1458 2055 7885 -2710
- 1218 2007 7850 -2782 1325 2044 7898 -2678 1532 2001 7869 -2742 1471 2009 7898
- -2679 1465 2055 1399 2072 1437 2031 7888 -2701 7885 -2711 1275 2017 7865 -2753
- 1603 1939 7888 -2699 1501 1994 7894 -2688 1426 2071 7862 -2758 1211 2069 1248
- 2013 1586 1998 1195 2015 1227 2023 7865 -2751 100 { m20} R 1277 2034 1279 2054
- 7907 -2657 7856 -2770 7863 -2755 1131 2025 1260 2027 1357 2034 1356 2026 1408
- 2004 1318 2070 1328 2057 7851 -2781 7870 -2743 7860 -2763 1379 2060 1501 2060
- 7905 -2657 7857 -2768 7887 -2706 1350 2013 7845 -2794 7896 -2679 1193 2071 1511
- 2028 1385 2061 1252 2023 1318 2050 7891 -2694 7874 -2732 1507 2042 31 { m20} R
- 0.29091 0.8 0 c 7904 -2672 7906 -2669 1590 2056 7898 -2685 7904 -2669 7879
- -2725 7895 -2692 1623 2028 1360 2106 1423 2123 1310 2107 1408 2116 7883 -2717
- 7897 -2686 1127 2131 1351 2108 1317 2096 7875 -2732 1452 2072 1441 2087 7908
- -2659 1582 2071 1317 2123 1139 2170 1545 2051 7899 -2683 1517 2068 1486 2084
- 7907 -2665 1400 2128 1330 2125 1339 2086 7895 -2692 7886 -2708 1226 2100 7887
- -2708 1365 2129 7908 -2664 1344 2098 7877 -2728 1352 2127 2018 1769 1415 2120
- 7897 -2687 1239 2091 1536 2048 7904 -2671 1546 2089 1436 2133 1208 2147 7900
- -2681 1257 2121 1498 2129 1299 2116 7894 -2693 1328 2093 1397 2115 2049 1725
- 1624 2024 7906 -2667 1618 2077 1448 2080 1418 2106 7869 -2744 1522 2088 1428
- 2139 7890 -2703 1300 2130 1575 2035 1493 2117 1575 2051 1249 2121 7874 -2734
- 1561 2056 7904 -2673 7885 -2711 7890 -2702 1468 2130 1363 2120 7900 -2680 7882
- -2716 7893 -2696 1533 2058 1453 2096 7908 -2664 7891 -2699 7895 -2690 1289 2078
- 1571 2056 1414 2106 1412 2101 1437 2120 1549 2055 1478 2079 7893 -2696 1404
- 2118 1280 2099 1282 2091 1604 2057 7903 -2671 100 { m20} R 7905 -2670 1519 2118
- 7882 -2718 1581 2074 7897 -2686 1363 2077 1374 2075 1523 2072 7886 -2710 1560
- 2101 1387 2088 7885 -2711 7876 -2731 1249 2082 1316 2110 7897 -2686 7896 -2690
- 1368 2090 7885 -2712 7907 -2663 1501 2074 7893 -2695 7895 -2691 7900 -2682 1225
- 2106 7905 -2668 1435 2084 1428 2086 1634 2031 1303 2108 1581 2034 1275 2093
- 1801 1943 7904 -2674 1527 2120 1578 2069 1443 2082 1523 2106 1486 2119 1528
- 2070 1609 2047 1371 2076 1325 2127 1430 2084 1409 2104 1458 2127 7894 -2695
- 7900 -2681 1628 2048 1544 2093 7898 -2685 1531 2081 1369 2108 1454 2126 7884
- -2713 1475 2093 1377 2076 1467 2079 1379 2075 1382 2076 7908 -2662 1369 2107
- 1513 2120 7902 -2676 7872 -2738 7881 -2719 1499 2079 1533 2095 1342 2081 7892
- -2697 7899 -2682 7908 -2663 7904 -2670 7907 -2665 1465 2107 1531 2097 1419 2103
- 1523 2086 1291 2085 1400 2139 1501 2082 1364 2136 1315 2102 1462 2135 1399 2092
- 7893 -2694 1602 2083 1513 2077 1419 2098 7897 -2686 1304 2077 7899 -2683 1661
- 2015 1318 2085 1400 2121 1677 2029 1508 2120 7903 -2671 1366 2125 1507 2116 100
- { m20} R 7888 -2705 7894 -2693 7899 -2684 1434 2102 7905 -2671 1451 2077 1901
- 1816 1391 2098 1670 2020 1368 2098 1149 2142 1543 2092 1437 2115 1387 2136 7903
- -2674 7898 -2685 1781 1933 7903 -2675 1392 2075 1389 2086 7906 -2668 7881 -2718
- 1555 2106 7907 -2663 1402 2124 1434 2110 26 { m20} R 0.43636 0.8 0 c 1412 2172
- 1472 2174 1463 2142 1645 2093 1515 2176 7907 -2668 1589 2139 1851 1953 1515
- 2140 1476 2178 1394 2155 1441 2162 1476 2184 1347 2185 7909 -2664 1507 2129
- 1379 2183 1623 2136 1543 2131 1502 2181 1338 2143 1480 2159 1631 2073 1631 2108
- 1182 2218 1409 2159 1468 2168 1504 2152 1490 2158 1347 2141 1483 2159 1545 2129
- 1337 2180 1424 2177 1516 2144 1410 2157 1503 2170 1495 2153 1255 2195 1461 2187
- 1413 2152 1634 2109 1406 2191 1402 2179 1518 2135 1493 2175 1868 1923 1605 2111
- 1351 2185 1260 2201 7895 -2692 1469 2169 7908 -2665 7906 -2670 1339 2183 1286
- 2146 1724 2031 1374 2180 1319 2173 1311 2151 1340 2174 1393 2188 1529 2165 1337
- 2139 1624 2131 1481 2177 1516 2168 1437 2161 1537 2166 1405 2177 1389 2167 1490
- 2149 7905 -2672 1602 2125 1633 2088 1509 2175 1410 2194 1460 2147 1469 2169
- 1478 2174 1595 2125 1406 2190 1443 2190 1854 1960 1240 2195 1520 2137 1803 1996
- 1385 2151 1374 2152 1380 2159 1862 1938 1482 2183 1312 2156 1528 2172 1629 2129
- 1641 2119 1457 2191 1419 2175 1143 2205 1444 2179 100 { m20} R 1405 2153 1352
- 2140 1426 2192 1346 2152 1407 2196 7909 -2664 1384 2189 1360 2181 1516 2141
- 1504 2157 1504 2174 1568 2144 1298 2183 1139 2212 1297 2170 1719 2046 1408 2166
- 1510 2175 2074 1766 1461 2191 1595 2129 1383 2148 1318 2156 7908 -2664 1501
- 2156 1796 2000 1396 2165 1567 2118 1575 2121 1434 2186 1378 2166 1603 2106 1476
- 2142 1380 2149 1736 2002 1300 2160 1365 2153 1458 2178 1515 2171 7906 -2671
- 1495 2153 1505 2142 1585 2153 1509 2136 1418 2157 1597 2108 1323 2171 1419 2162
- 1481 2174 1325 2182 1401 2191 1422 2163 52 { m20} R 0.58182 0.8 0 c 1306 2196
- 1349 2200 1485 2215 1488 2234 1520 2216 1504 2202 1262 2218 1355 2214 1448 2238
- 1435 2203 1322 2214 1386 2236 1437 2198 1548 2174 1478 2195 1469 2221 1495 2224
- 1431 2202 1421 2240 1505 2227 1412 2221 1383 2199 1333 2202 1432 2242 1476 2234
- 1492 2207 1425 2213 1504 2210 1453 2208 1494 2225 1367 2239 1437 2221 1338 2211
- 1522 2212 1574 2165 1290 2219 1331 2208 1323 2221 1384 2207 1505 2208 1358 2220
- 1342 2226 1442 2210 1529 2184 1466 2196 1517 2215 1323 2232 1428 2209 1501 2204
- 1287 2214 1415 2228 1365 2221 1295 2215 1456 2210 1469 2228 1574 2166 1372 2231
- 1365 2201 1434 2245 1383 2236 1385 2213 1407 2221 1454 2238 1386 2205 1384 2218
- 1496 2201 1505 2215 1546 2178 1570 2166 1417 2204 1572 2170 1511 2220 1427 2214
- 1380 2233 1540 2178 1513 2196 1511 2201 1395 2209 1544 2182 79 { m20} R 0.72727
- 0.8 0 c 1439 2284 1479 2253 1467 2255 1372 2277 1466 2251 1443 2261 1434 2278
- 1377 2248 1347 2251 1419 2259 1314 2251 1435 2287 1479 2242 1446 2267 1433 2285
- 1414 2285 1472 2258 1433 2261 1479 2251 1408 2261 1320 2287 1356 2268 1428 2267
- 1397 2270 1465 2261 1460 2252 1434 2248 1424 2257 1089 2292 1334 2256 1422 2250
- 1302 2289 1452 2253 1264 2271 1378 2244 1413 2268 1362 2270 1307 2287 1465 2250
- 1425 2274 1458 2257 1458 2272 1437 2276 1410 2274 44 { m20} R 0.8 0.72727 0 c
- 1402 2320 1431 2299 1427 2294 1411 2314 1364 2303 1413 2301 1376 2296 1427 2289
- 1403 2309 1385 2308 1357 2309 1385 2302 1338 2298 1384 2296 1384 2325 1388 2315
- 1405 2311 1337 2292 1415 2292 1403 2321 20 { m20} R 0.8 0.58182 0 c 1370 2361
- 1382 2337 1383 2362 3 { m20} R 0.8 0.43636 0 c 1372 2378 m20 0.8 0.29091 0 c
- 1372 2378 0.8 0.14546 0 c 1372 2378 0 0 0.8 c 1372 2378 0 0.14545 0.8 c 1372
- 2378 0 0.29091 0.8 c 1372 2378 0 0.43636 0.8 c 7594 -2860 m20 0 0.58182 0.8 c
- 7647 -2845 7021 -3198 7365 -3086 7381 -3065 7489 -2956 5 { m20} R 0 0.72727 0.8
- c 7727 -2838 7611 -2977 7593 -2969 7691 -2886 7307 -3248 7694 -2889 7577 -3058
- 7297 -3203 7523 -3106 7565 -3032 7289 -3243 7537 -3097 7612 -2981 13 { m20} R 0
- 0.8 0.72727 c 7561 -3170 7539 -3166 7515 -3233 7354 -3398 7690 -2932 7667 -2959
- 7569 -3132 7330 -3475 7648 -3045 7403 -3286 7667 -2958 7717 -2892 7765 -2794
- 7430 -3218 7699 -2901 7594 -3066 7607 -3131 7609 -3035 7622 -3058 7571 -3072
- 7780 -2801 7530 -3202 7441 -3287 23 { m20} R 0 0.8 0.58182 c 7688 -3019 7793
- -2800 7640 -3152 7809 -2782 7735 -2930 7607 -3193 809 1249 7728 -2916 7485
- -3337 7790 -2824 7660 -3117 7599 -3184 7729 -2954 7645 -3098 7666 -3054 7405
- -3658 7641 -3131 7714 -2950 7648 -3106 7626 -3186 7790 -2823 7572 -3330 7779
- -2852 7644 -3078 7669 -3095 7396 -3687 7345 -3677 7748 -2875 7600 -3221 7436
- -3612 7333 -3551 7662 -3073 7708 -2970 7626 -3112 7689 -3002 7585 -3217 7660
- -3045 7759 -2899 38 { m20} R 0 0.8 0.43636 c 7806 -2820 7649 -3176 1282 1414
- 7772 -2896 7606 -3273 950 1391 7677 -3110 7739 -2983 1377 1577 7659 -3167 7658
- -3169 1282 1376 7790 -2853 1590 1099 1107 1387 7688 -3073 7634 -3194 7872 -2679
- 1043 1354 708 1419 7867 -2689 7688 -3091 7839 -2730 7685 -3070 7820 -2786 1518
- 1508 7629 -3229 7593 -3286 1274 1478 7838 -2739 1208 1497 7680 -3096 7804 -2823
- 7688 -3064 7788 -2868 7661 -3148 7733 -2994 7586 -3315 7789 -2840 1133 1577
- 1040 1529 1213 1545 7709 -3055 7688 -3095 1315 1496 7721 -3019 7759 -2930 1369
- 1544 7706 -3065 7717 -3020 1464 1428 51 { m20} R 0 0.8 0.29091 c 7740 -3005
- 7872 -2697 7785 -2900 7694 -3098 1274 1653 7732 -3020 7725 -3027 1115 1708 7738
- -3007 1605 1624 7727 -3031 7844 -2756 7749 -2978 970 1750 1266 1748 7762 -2946
- 7687 -3112 7769 -2940 7745 -2983 1089 1709 1240 1605 7744 -2995 1402 1636 1272
- 1755 1410 1644 1170 1677 839 1734 7768 -2936 7761 -2949 7753 -2969 7836 -2772
- 7829 -2784 7886 -2667 1284 1660 7749 -2979 7890 -2651 7813 -2832 750 1774 7845
- -2750 7835 -2787 7698 -3088 7854 -2724 1151 1734 1111 1790 888 1645 1228 1674
- 7759 -2964 7765 -2949 1397 1672 7775 -2927 1250 1663 7713 -3059 7726 -3032 1112
- 1702 54 { m20} R 0 0.8 0.14545 c 7838 -2796 1337 1883 7790 -2898 7848 -2768
- 7892 -2661 1264 1880 1220 1856 7882 -2683 7788 -2904 1043 1874 994 1831 7888
- -2672 7875 -2704 1398 1888 1316 1884 7862 -2735 1277 1777 1081 1826 7809 -2860
- 7821 -2837 1284 1848 7813 -2848 7812 -2855 7816 -2847 7853 -2749 1479 1834 7827
- -2819 7784 -2910 7793 -2897 1359 1871 7858 -2738 7796 -2890 1248 1829 1056 1808
- 7780 -2924 1121 1847 821 1828 7790 -2896 1292 1868 1452 1806 7873 -2713 7761
- -2963 7881 -2693 1384 1825 1147 1879 1504 1755 1222 1874 7832 -2797 1215 1865
- 7859 -2736 7827 -2813 1419 1894 1320 1838 7771 -2940 1165 1808 1491 1781 7850
- -2764 1016 1909 1483 1827 7809 -2863 7886 -2678 7838 -2791 7829 -2812 1502 1805
- 7784 -2911 1521 1779 1628 1784 7857 -2746 7889 -2666 7816 -2841 7850 -2771 1301
- 1893 7814 -2851 1021 1856 74 { m20} R 0 0.8 0.4069E-06 c 7899 -2662 7829 -2824
- 1314 1913 1212 1995 1430 1987 1324 1936 1232 1914 7865 -2748 7880 -2713 7905
- -2646 7834 -2811 7819 -2844 1670 1856 1073 1983 1395 1960 1486 1921 7881 -2702
- 7860 -2755 7814 -2854 7816 -2851 1450 1901 1490 1930 7870 -2735 1342 1939 7883
- -2706 7898 -2671 1518 1881 1288 1925 1267 1953 1176 1960 1310 1980 1249 1986
- 7873 -2728 7806 -2871 715 1936 1175 1915 1122 1948 1393 1962 1287 1981 7844
- -2789 1530 1931 7846 -2786 7805 -2874 1201 1968 1178 2003 7894 -2669 1488 1927
- 1152 1928 7877 -2719 7867 -2739 7817 -2848 1134 1935 1511 1941 1227 1920 1119
- 2021 7837 -2807 1384 1930 1272 1919 1384 1926 7889 -2691 1396 1917 7876 -2710
- 7907 -2642 7883 -2705 7854 -2773 7853 -2770 1511 1917 1548 1884 1008 2034 7812
- -2858 70 { m20} R 0.14545 0.8 0 c 1357 2007 1520 2027 1634 1961 1439 2062 1711
- 1919 7859 -2764 1617 1981 7881 -2717 7867 -2748 1150 2023 7883 -2715 7889 -2697
- 7869 -2744 1373 2059 7882 -2710 7883 -2715 7884 -2712 7894 -2690 1435 1995 7888
- -2703 7897 -2679 1432 2013 7892 -2693 7898 -2679 7905 -2664 1369 2074 7865
- -2751 1563 1968 7899 -2675 1580 2027 7888 -2698 1573 2006 1527 2021 1434 2013
- 1440 2042 1457 2022 1736 1895 1427 2039 1227 2031 1620 1990 7877 -2724 7878
- -2725 7873 -2735 7877 -2727 1463 2013 1538 1973 7870 -2741 1308 2032 7862 -2759
- 1407 2043 1312 2068 1627 2000 1260 2039 7889 -2699 1362 2043 7852 -2778 1397
- 2073 7866 -2749 1414 2052 59 { m20} R 0.29091 0.8 0 c 7892 -2698 1478 2103 1483
- 2121 1329 2088 1545 2050 1326 2095 1337 2129 7903 -2674 1639 2001 1306 2088
- 1574 2057 1544 2059 1393 2122 1602 2068 1542 2090 7896 -2690 7898 -2687 1369
- 2130 7891 -2699 7890 -2701 1348 2132 1548 2067 1424 2099 2093 1714 7885 -2713
- 7879 -2724 1381 2133 1344 2076 7888 -2705 1641 2006 1422 2103 1499 2107 1590
- 2054 1458 2091 1407 2125 1372 2120 1506 2072 1459 2083 1380 2087 1440 2096 1471
- 2112 1462 2071 7896 -2688 1626 2066 7900 -2680 1374 2096 1467 2135 1305 2120
- 1358 2123 7901 -2677 7884 -2713 7898 -2684 7906 -2668 1358 2112 1214 2141 1308
- 2101 56 { m20} R 0.43636 0.8 0 c 1354 2150 1576 2107 1547 2121 1385 2192 1464
- 2190 7908 -2665 1586 2104 7907 -2668 1455 2159 1487 2178 1581 2159 1321 2194
- 1283 2143 1311 2187 1327 2183 1338 2143 1473 2177 1478 2184 1458 2177 1485 2163
- 1516 2138 1574 2119 7899 -2683 1340 2147 1385 2184 1450 2176 1435 2177 1745
- 2030 1500 2142 1462 2160 1376 2144 1340 2155 1377 2180 1598 2132 34 { m20} R
- 0.58182 0.8 0 c 1428 2214 1516 2222 1535 2199 1332 2208 1410 2233 1467 2210
- 1498 2235 1427 2217 1360 2213 1516 2202 1451 2203 1362 2242 1477 2225 1536 2200
- 1295 2202 1526 2197 1416 2232 1489 2190 1212 2223 1427 2243 1493 2219 1481 2224
- 22 { m20} R 0.72727 0.8 0 c 1461 2258 1474 2252 1369 2258 1437 2277 1388 2281
- 1413 2265 1414 2282 1437 2258 1469 2250 1433 2273 1304 2258 1420 2260 1375 2252
- 13 { m20} R 0.8 0.72727 0 c 1429 2301 1400 2314 1413 2311 1393 2292 1355 2299
- 1385 2312 6 { m20} R 0.8 0.58182 0 c 1429 2301 0.8 0.43636 0 c 1429 2301 0.8
- 0.29091 0 c 1354 2403 m20 0.8 0.14546 0 c 1354 2403 0 0 0.8 c 53 77 2019 683 bf
- 0 0.14545 0.8 c 53 77 2019 760 bf 0 0.29091 0.8 c 53 78 2019 837 bf 0 0.43636
- 0.8 c 53 77 2019 915 bf 0 0.58182 0.8 c 53 77 2019 992 bf 0 0.72727 0.8 c 53 78
- 2019 1069 bf 0 0.8 0.72727 c 53 77 2019 1147 bf 0 0.8 0.58182 c 53 77 2019 1224
- bf 0 0.8 0.43636 c 53 78 2019 1301 bf 0 0.8 0.29091 c 53 77 2019 1379 bf 0 0.8
- 0.14545 c 53 77 2019 1456 bf 0 0.8 0.4069E-06 c 53 78 2019 1533 bf 0.14545 0.8
- 0 c 53 77 2019 1611 bf 0.29091 0.8 0 c 53 77 2019 1688 bf 0.43636 0.8 0 c 53 78
- 2019 1765 bf 0.58182 0.8 0 c 53 77 2019 1843 bf 0.72727 0.8 0 c 53 77 2019 1920
- bf 0.8 0.72727 0 c 53 78 2019 1997 bf 0.8 0.58182 0 c 53 77 2019 2075 bf 0.8
- 0.43636 0 c 53 77 2019 2152 bf 0.8 0.29091 0 c 53 78 2019 2229 bf 0.8 0.14546 0
- c 53 77 2019 2307 bf 0.9 0.9 0.9 c 53 77 2019 2384 bf black 53 1778 2019 683 bl
- 2072 683 m 1778 Y s 2019 683 m 53 X s 2019 979 m 53 X s 2019 1276 m 53 X s 2019
- 1572 m 53 X s 2019 1868 m 53 X s 2019 2165 m 53 X s 2019 2461 m 53 X s 2133 681
- m 27 X s 2172 691 m 1 Y 1 3 d 2 2 d 3 1 d 6 X 3 -1 d 1 -2 d 2 -3 d -3 Y -2 -3 d
- -3 -4 d -15 -15 d 21 X s 2133 977 m 27 X s 2175 989 m 3 1 d 4 5 d -31 Y s 2141
- 1291 m -5 -1 d -3 -5 d -1 -7 d -5 Y 1 -7 d 3 -4 d 5 -2 d 3 X 4 2 d 3 4 d 2 7 d
- 5 Y -2 7 d -3 5 d -4 1 d -3 X cl s 2136 1582 m 3 1 d 5 5 d -32 Y s 2133 1877 m
- 1 Y 2 3 d 1 1 d 3 2 d 6 X 3 -2 d 2 -1 d 1 -3 d -3 Y -1 -3 d -3 -4 d -15 -15 d
- 21 X s 2135 2180 m 16 X -9 -11 d 5 X 3 -2 d 1 -1 d 2 -5 d -3 Y -2 -4 d -3 -3 d
- -4 -2 d -5 X -4 2 d -2 1 d -1 3 d s 2147 2477 m -15 -21 d 22 X s 2147 2477 m
- -31 Y s 222 1180 m 651 -497 d s 873 683 m 994 Y s 222 2174 m 651 -497 d s 222
- 1180 m 994 Y s 873 683 m 1128 287 d s 2001 970 m 994 Y s 873 1677 m 1128 287 d
- s 873 683 m 1128 287 d s 924 679 m 17 Y s 971 691 m 17 Y s 1007 700 m 17 Y s
- 1037 708 m 16 Y s 1062 714 m 17 Y s 1084 720 m 16 Y s 1103 725 m 16 Y s 1120
- 712 m 34 Y s 1101 690 m 3 1 d 4 5 d -32 Y s 1135 696 m -5 -2 d -3 -4 d -1 -8 d
- -4 Y 1 -8 d 3 -4 d 5 -2 d 3 X 4 2 d 3 4 d 2 8 d 4 Y -2 8 d -3 4 d -4 2 d -3 X
- cl s 1150 709 m 21 X s 1180 718 m 1 Y 2 2 d 1 1 d 2 2 d 5 X 2 -2 d 1 -1 d 2 -2
- d -3 Y -2 -2 d -2 -3 d -12 -12 d 17 X s 1234 758 m 17 Y s 1300 775 m 16 Y s
- 1347 787 m 16 Y s 1383 796 m 17 Y s 1413 803 m 17 Y s 1438 810 m 17 Y s 1460
- 815 m 17 Y s 1479 820 m 17 Y s 1496 808 m 33 Y s 1477 785 m 3 2 d 4 4 d -31 Y s
- 1511 791 m -5 -1 d -3 -5 d -1 -7 d -5 Y 1 -7 d 3 -4 d 5 -2 d 3 X 4 2 d 3 4 d 2
- 7 d 5 Y -2 7 d -3 5 d -4 1 d -3 X cl s 1525 805 m 22 X s 1559 814 m 2 2 d 4 3 d
- -25 Y s 1609 854 m 16 Y s 1676 870 m 17 Y s 1722 882 m 17 Y s 1759 892 m 16 Y s
- 1789 899 m 17 Y s 1814 906 m 16 Y s 1836 911 m 17 Y s 1855 916 m 17 Y s 1872
- 904 m 33 Y s 1883 881 m 3 1 d 4 5 d -31 Y s 1985 949 m 17 Y s 873 683 m -651
- 497 d s 873 666 m 17 Y s 835 695 m 17 Y s 808 716 m 17 Y s 787 732 m 17 Y s 770
- 745 m 17 Y s 755 756 m 17 Y s 743 766 m 17 Y s 732 774 m 17 Y s 722 765 m 34 Y
- s 620 723 m 3 1 d 4 4 d -31 Y s 654 728 m -5 -1 d -2 -4 d -2 -8 d -4 Y 2 -8 d 2
- -4 d 5 -2 d 3 X 4 2 d 3 4 d 2 8 d 4 Y -2 8 d -3 4 d -4 1 d -3 X cl s 669 742 m
- 21 X s 699 751 m 1 Y 2 2 d 1 1 d 2 2 d 5 X 2 -2 d 1 -1 d 2 -2 d -3 Y -2 -2 d -2
- -4 d -12 -11 d 17 X s 656 832 m 17 Y s 618 861 m 17 Y s 591 882 m 16 Y s 570
- 898 m 16 Y s 553 911 m 17 Y s 538 922 m 17 Y s 526 932 m 16 Y s 515 940 m 17 Y
- s 505 931 m 33 Y s 403 888 m 3 2 d 4 4 d -31 Y s 437 894 m -5 -1 d -2 -5 d -2
- -7 d -5 Y 2 -7 d 2 -4 d 5 -2 d 3 X 4 2 d 3 4 d 2 7 d 5 Y -2 7 d -3 5 d -4 1 d
- -3 X cl s 452 908 m 21 X s 485 917 m 2 2 d 4 3 d -25 Y s 439 998 m 16 Y s 401
- 1027 m 16 Y s 374 1047 m 17 Y s 353 1063 m 17 Y s 336 1077 m 16 Y s 321 1088 m
- 16 Y s 309 1097 m 17 Y s 298 1106 m 16 Y s 288 1097 m 33 Y s 216 1054 m 3 1 d 5
- 5 d -31 Y s 222 1163 m 17 Y s 222 1180 m 994 Y s 206 1180 m 16 X s 206 1197 m
- 16 X s 189 1212 m 33 X s 101 1222 m 3 1 d 4 5 d -32 Y s 135 1228 m -5 -2 d -3
- -4 d -1 -8 d -4 Y 1 -8 d 3 -4 d 5 -2 d 3 X 4 2 d 3 4 d 2 8 d 4 Y -2 8 d -3 4 d
- -4 2 d -3 X cl s 148 1245 m 21 X s 179 1254 m 1 Y 1 2 d 1 1 d 3 2 d 4 X 3 -2 d
- 1 -1 d 1 -2 d -3 Y -1 -2 d -2 -4 d -12 -11 d 16 X s 206 1312 m 16 X s 206 1370
- m 16 X s 206 1412 m 16 X s 206 1444 m 16 X s 206 1470 m 16 X s 206 1492 m 16 X
- s 206 1511 m 16 X s 206 1528 m 16 X s 189 1543 m 33 X s 101 1553 m 3 2 d 4 4 d
- -31 Y s 135 1559 m -5 -1 d -3 -5 d -1 -7 d -5 Y 1 -7 d 3 -5 d 5 -1 d 3 X 4 1 d
- 3 5 d 2 7 d 5 Y -2 7 d -3 5 d -4 1 d -3 X cl s 148 1577 m 21 X s 181 1586 m 3 1
- d 3 4 d -25 Y s 206 1643 m 16 X s 206 1702 m 16 X s 206 1743 m 16 X s 206 1775
- m 16 X s 206 1801 m 16 X s 206 1824 m 16 X s 206 1843 m 16 X s 206 1860 m 16 X
- s 189 1875 m 33 X s 146 1885 m 3 1 d 4 4 d -31 Y s 206 1975 m 16 X s 206 2033 m
- 16 X s 206 2074 m 16 X s 206 2107 m 16 X s 206 2133 m 16 X s 206 2155 m 16 X s
- 206 2174 m 16 X s gr
-showpage
- gr
-%%Trailer
-%%Pages: 1
- gr gr
-%%EOF
diff --git a/src/pawlib/paw/testsuite/paw.commands/nt_pl_4d_3.ref.ps b/src/pawlib/paw/testsuite/paw.commands/nt_pl_4d_3.ref.ps
deleted file mode 100644
index 17bda72..0000000
--- a/src/pawlib/paw/testsuite/paw.commands/nt_pl_4d_3.ref.ps
+++ /dev/null
@@ -1,282 +0,0 @@
-%!PS-Adobe-2.0
-%%Title: /disk3/maartenb/cerncvs/paw/testsuite/tmp/nt_pl_4d_ (Portrait A 4)
-%%Pages: (atend)
-%%Creator: HIGZ Version 1.23/06
-%%CreationDate: 96/04/16 16.05
-%%EndComments
-%%BeginProlog
-/s {stroke} def /l {lineto} def /m {moveto} def /t {translate} def
-/sw {stringwidth} def /r {rotate} def /rl {roll} def /R {repeat} def
-/d {rlineto} def /rm {rmoveto} def /gr {grestore} def /f {eofill} def
-/c {setrgbcolor} def /lw {setlinewidth} def /sd {setdash} def
-/cl {closepath} def /sf {scalefont setfont} def /black {0 setgray} def
-/box {m dup 0 exch d exch 0 d 0 exch neg d cl} def
-/NC{systemdict begin initclip end}def/C{NC box clip newpath}def
-/bl {box s} def /bf {box f} def /Y { 0 exch d} def /X { 0 d} def
-/mp {newpath /y exch def /x exch def} def
-/side {[w .77 mul w .23 mul] .385 w mul sd w 0 l currentpoint t -144 r} def
-/mr {mp x y w2 0 360 arc} def /m24 {mr s} def /m20 {mr f} def
-/mb {mp x y w2 add m w2 neg 0 d 0 w neg d w 0 d 0 w d cl} def
-/mt {mp x y w2 add m w2 neg w neg d w 0 d cl} def
-/m21 {mb f} def /m25 {mb s} def /m22 {mt f} def /m26 {mt s} def
-/m23 {mp x y w2 sub m w2 w d w neg 0 d cl f} def
-/m27 {mp x y w2 add m w3 neg w2 neg d w3 w2 neg d w3 w2 d cl s} def
-/m28 {mp x w2 sub y w2 sub w3 add m w3 0 d 0 w3 neg d w3 0 d 0 w3 d w3 0 d
- 0 w3 d w3 neg 0 d 0 w3 d w3 neg 0 d
- 0 w3 neg d w3 neg 0 d cl s } def
-/m29 {mp gsave x w2 sub y w2 add w3 sub m currentpoint t
- 4 {side} repeat cl fill gr} def
-/m30 {mp gsave x w2 sub y w2 add w3 sub m currentpoint t
- 5 {side} repeat s gr} def
-/m31 {mp x y w2 sub m 0 w d x w2 sub y m w 0 d
- x w2 sub y w2 add m w w neg d x w2 sub y w2
- sub m w w d s} def
-/m2 {mp x y w2 sub m 0 w d x w2 sub y m w 0 d s} def
-/m5 {mp x w2 sub y w2 sub m w w d x w2 sub y w2 add m w w neg d s} def
-/DP {/PT exch def gsave 47.2 47.2 scale PT 1 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < AA AA 55 55 AA AA 55 55 AA AA 55 55 AA AA 55 55 AA AA 55 55 AA AA 55 55
-AA AA 55 55 AA AA 55 55 > } image } if PT 2 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < BB BB EE EE BB BB EE EE BB BB EE EE BB BB EE EE BB BB EE EE BB BB EE EE
-BB BB EE EE BB BB EE EE > } image } if PT 3 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < FF FF BB BB FF FF EE EE FF FF BB BB FF FF EE EE FF FF BB BB FF FF EE EE
-FF FF BB BB FF FF EE EE > } image } if PT 4 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < DF DF BF BF 7F 7F FE FE FD FD FB FB F7 F7 EF EF DF DF BF BF 7F 7F FE FE
-FD FD FB FB F7 F7 EF EF > } image } if PT 5 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < 7F 7F BF B F DF DF EF EF F7 F7 FB FB FD FD FE FE 7F 7F BF BF DF DF EF
-EF F7 F7 FB FB FD FD FE FE > } image } if PT 6 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB
-BB BB BB BB BB BB BB BB BB > } image } if PT 7 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < FF FF FF FF FF FF 00 00 FF FF FF FF FF FF 00 00 FF FF FF FF FF FF 00
-00 FF FF FF FF FF FF 00 00 > } image } if PT 8 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < EE EE 47 47 83 83 C5 C5 EE EE 5C 5C 38 38 74 74 EE EE 47 47 83 83 C5
-C5 EE EE 5C 5C 38 38 74 74 > } image } if PT 9 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < EF EF EF EF D7 D7 38 38 FE FE FE FE 7D 7D 83 83 EF EF EF EF D7 D7 38
-38 FE FE FE FE 7D 7D 83 83 > } image } if PT 10 eq { 16 16 1 [ 16 0 0 16 neg
-0 16 ] { < EF EF EF EF EF EF 00 00 FE FE FE FE FE FE 00 00 EF EF EF EF EF EF
-00 00 FE FE FE FE FE FE 00 00 > } image } if PT 11 eq { 16 16 1 [ 16 0 0 16
-neg 0 16 ] { < F7 F7 B6 B6 D5 D5 E3 E3 D5 D5 B6 B6 F7 F7 FF FF 7F 7F 6B 6B 5D
-5D 3E 3E 5D 5D 6B 6B 7F 7F FF FF > } image } if PT 12 eq { 16 16 1 [ 16 0 0
-16 neg 0 16 ] { < E3 E3 DD DD BE BE BE BE BE BE DD DD E3 E3 FF FF 3E 3E DD DD
-EB EB EB EB EB EB DD DD 3E 3E FF FF > } image } if PT 13 eq { 16 16 1 [ 16 0
-0 16 neg 0 16 ] { < FE FE 7D 7D BB BB D7 D7 EF EF D7 D7 BB BB 7D 7D FE FE 7D
-7D BB BB D7 D7 EF EF D7 D7 BB BB 7D 7D > } image } if PT 14 eq { 16 16 1 [ 16
-0 0 16 neg 0 16 ] { < 00 00 EE EF EE EF EE EF 0E E0 EE EE EE EE EE EE 00 EE
-FE EE FE EE FE EE 00 00 FE EF FE EF FE EF > } image } if PT 15 eq { 16 16 1 [
-16 0 0 16 neg 0 16 ] { < DD DD AA AA DD DD FF FF 77 77 AA AA 77 77 FF FF DD
-DD AA AA DD DD FF FF 77 77 AA AA 77 77 FF FF > } image } if PT 16 eq { 16 16
-1 [ 16 0 0 16 neg 0 16 ] { < F1 F1 EE EE 1F 1F FF FF F1 F1 EE EE 1F 1F FF FF
-F1 F1 EE EE 1F 1F FF FF F1 F1 EE EE 1F 1F FF FF > } image } if PT 17 eq { 16
-16 1 [ 16 0 0 16 neg 0 16 ] { < EE EE DD DD BB BB FF FF EE EE DD DD BB BB FF
- FF EE EE DD DD BB BB FF FF EE EE DD DD BB BB FF FF > } image } if PT 18 eq {
-16 16 1 [ 16 0 0 16 neg 0 16 ] { < BB BB DD DD EE EE FF FF BB BB DD DD EE EE
-FF FF BB BB DD DD EE EE FF FF BB BB DD DD EE EE FF FF > } image } if PT 19 eq
-{ 16 16 1 [ 16 0 0 16 neg 0 16 ] { < 1F FC 67 F3 7B EF BD DE BD DE DE BD E6
-B3 F8 0F E6 B3 DE BD BD DE BD DE 7B EF 67 F3 1F FC 7F FF > } image } if PT
-20 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < DD DD EE EE EE EE EE EE DD DD BB
-BB BB BB BB BB DD DD EE EE EE EE EE EE DD DD BB BB BB BB BB BB > } image }
-if PT 21 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < 0E 0E EF EF EF EF EF EF E0
-E0 FE FE FE FE FE FE 0E 0E EF EF EF EF EF EF E0 E0 FE FE FE FE FE FE > }
-image } if PT 22 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < 70 70 F7 F7 F7 F7 F7
-F7 07 07 7F 7F 7F 7F 7F 7F 70 70 F7 F7 F7 F7 F7 F7 07 07 7F 7F 7F 7F 7F 7F >
-} image } if PT 23 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < AA AA 55 55 A9 A9
-D1 D1 E1 E1 D1 D1 A9 A9 55 55 AA AA 55 55 A9 A9 D1 D1 E1 E1 D1 D1 A9 A9 55 55
-> } image } if PT 24 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < FF FE FF FC EA
-A8 D5 54 EA A8 D5 54 E8 28 D4 54 E8 E8 D4 D4 E8 EA 54 D5 A8 EA 54 D5 00 C0 00
-80 > } image } if PT 25 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < FF FE FF FC
-FF F8 FF F0 F0 00 F0 00 F0 20 F0 60 F0 E0 F1 E0 F3 E0 F0 00 E0 00 C0 00 80 00
-00 00 > } image } if gr } def /FA { /PT exch def gsave clip 0 0 translate 1 1
-54 { 1 sub 47.2 mul /Xcurr exch def 1 1 74 { 1 sub 47.2 mul /Ycurr exch def
-gsave Xcurr Ycurr translate PT DP gr } for } for gr } def
-/reencdict 24 dict def /ReEncode {reencdict begin /nco&na exch def
-/nfnam exch def /basefontname exch def /basefontdict basefontname findfont def
-/newfont basefontdict maxlength dict def basefontdict {exch dup /FID ne
-{dup /Encoding eq {exch dup length array copy newfont 3 1 roll put} {exch
-newfont 3 1 roll put} ifelse} {pop pop} ifelse } forall newfont
-/FontName nfnam put nco&na aload pop nco&na length 2 idiv {newfont
-/Encoding get 3 1 roll put} repeat nfnam newfont definefont pop end } def
-/accvec [ 176 /agrave 181 /Agrave 190 /acircumflex 192 /Acircumflex
-201 /adieresis 204 /Adieresis 209 /ccedilla 210 /Ccedilla 211 /eacute
-212 /Eacute 213 /egrave 214 /Egrave 215 /ecircumflex 216 /Ecircumflex
-217 /edieresis 218 /Edieresis 219 /icircumflex 220 /Icircumflex
-221 /idieresis 222 /Idieresis 223 /ntilde 224 /Ntilde 226 /ocircumflex
-228 /Ocircumflex 229 /odieresis 230 /Odieresis 231 /ucircumflex 236 /Ucircumflex
-237 /udieresis 238 /Udieresis 239 /aring 242 /Aring 243 /ydieresis
-244 /Ydieresis 246 /aacute 247 /Aacute 252 /ugrave 253 /Ugrave] def
-/Times-Roman /Times-Roman accvec ReEncode
-/Times-Italic /Times-Italic accvec ReEncode
-/Times-Bold /Times-Bold accvec ReEncode
-/Times-BoldItalic /Times-BoldItalic accvec ReEncode
-/Helvetica /Helvetica accvec ReEncode
-/Helvetica-Oblique /Helvetica-Oblique accvec ReEncode
-/Helvetica-Bold /Helvetica-Bold accvec ReEncode
-/Helvetica-BoldOblique /Helvetica-BoldOblique accvec ReEncode
-/Courier /Courier accvec ReEncode
-/Courier-Oblique /Courier-Oblique accvec ReEncode
-/Courier-Bold /Courier-Bold accvec ReEncode
-/Courier-BoldOblique /Courier-BoldOblique accvec ReEncode
-/oshow {gsave [] 0 sd true charpath stroke gr} def
-/stwn { /fs exch def /fn exch def /text exch def fn findfont fs sf
- text sw pop xs add /xs exch def} def
-/stwb { /fs exch def /fn exch def /nbas exch def /textf exch def
-textf length /tlen exch def nbas tlen gt {/nbas tlen def} if
-fn findfont fs sf textf dup length nbas sub nbas getinterval sw
-pop neg xs add /xs exch def} def
-/accspe [ 65 /plusminus 66 /bar 67 /existential 68 /universal
-69 /exclam 70 /numbersign 71 /greater 72 /question 73 /integral
-74 /colon 75 /semicolon 76 /less 77 /bracketleft 78 /bracketright
-79 /greaterequal 80 /braceleft 81 /braceright 82 /radical
-83 /spade 84 /heart 85 /diamond 86 /club 87 /lessequal
-88 /multiply 89 /percent 90 /infinity 48 /circlemultiply 49 /circleplus
-50 /emptyset 51 /lozenge 52 /bullet 53 /arrowright 54 /arrowup
-55 /arrowleft 56 /arrowdown 57 /arrowboth 48 /degree 44 /comma 43 /plus
- 45 /angle 42 /angleleft 47 /divide 61 /notequal 40 /equivalence 41 /second
- 97 /approxequal 98 /congruent 99 /perpendicular 100 /partialdiff 101 /florin
- 102 /intersection 103 /union 104 /propersuperset 105 /reflexsuperset
- 106 /notsubset 107 /propersubset 108 /reflexsubset 109 /element 110 /notelement
- 111 /gradient 112 /logicaland 113 /logicalor 114 /arrowdblboth
- 115 /arrowdblleft 116 /arrowdblup 117 /arrowdblright 118 /arrowdbldown
- 119 /ampersand 120 /omega1 121 /similar 122 /aleph ] def
-/Symbol /Special accspe ReEncode
-/Zone {/iy exch def /ix exch def ix 1 sub 2224 mul 1 iy sub 3144
- mul t} def
-%%EndProlog
- gsave 20 28 t .25 .25 scale gsave
-%%Page: number 1
- gsave
- 1 1 Zone
- gsave 0 0 t black [] 0 sd 1 lw 2223 2224 0 460 bl 2223 2224 0 460 C 1779 1778
- 222 683 C NC [4 8] 0 sd 222 1279 m 1128 287 d s 222 1379 m 1128 287 d s 222
- 1478 m 1128 287 d s 222 1578 m 1128 287 d s 222 1677 m 1128 287 d s 222 1776 m
- 1128 288 d s 222 1876 m 1128 287 d s 222 1975 m 1128 287 d s 222 2075 m 1128
- 287 d s [] 0 sd 222 1180 m 1128 287 d s 1350 1467 m 994 Y s 222 2174 m 1128 287
- d s 222 1180 m 994 Y s [4 8] 0 sd 1350 1566 m 651 -497 d s 1350 1666 m 651 -497
- d s 1350 1765 m 651 -497 d s 1350 1865 m 651 -497 d s 1350 1964 m 651 -497 d s
- 1350 2064 m 651 -498 d s 1350 2163 m 651 -497 d s 1350 2262 m 651 -497 d s 1350
- 2362 m 651 -497 d s [] 0 sd 1350 1467 m 651 -497 d s 2001 970 m 994 Y s 1350
- 2461 m 651 -497 d s 1350 1467 m cl s 931 539 m -17 -21 d s 914 539 m 17 X s 914
- 518 m 17 X s 951 549 m 12 -31 d s 975 549 m -12 -31 d s 1002 545 m -3 3 d -5 1
- d -5 X -5 -1 d -3 -3 d -3 Y 2 -3 d 1 -1 d 3 -2 d 9 -3 d 3 -1 d 1 -2 d 2 -3 d -4
- Y -3 -3 d -5 -2 d -5 X -5 2 d -3 3 d s 1014 521 m -2 -1 d 2 -2 d 1 2 d -1 1 d
- cl s 1039 539 m 9 -21 d s 1057 539 m -9 -21 d -3 -6 d -3 -3 d -3 -1 d -2 X s
- 1076 549 m 12 -31 d s 1100 549 m -12 -31 d s 1126 545 m -3 3 d -4 1 d -6 X -4
- -1 d -3 -3 d -3 Y 1 -3 d 2 -1 d 3 -2 d 8 -3 d 3 -1 d 2 -2 d 1 -3 d -4 Y -3 -3 d
- -4 -2 d -6 X -4 2 d -3 3 d s 1138 521 m -1 -1 d 1 -2 d 2 2 d -2 1 d cl s 1165
- 539 m 16 -21 d s 1181 539 m -16 -21 d s 1202 549 m 12 -31 d s 1226 549 m -12
- -31 d s 1252 545 m -3 3 d -4 1 d -6 X -4 -1 d -3 -3 d -3 Y 1 -3 d 2 -1 d 2 -2 d
- 9 -3 d 3 -1 d 2 -2 d 1 -3 d -4 Y -3 -3 d -4 -2 d -6 X -4 2 d -3 3 d s 1264 521
- m -1 -1 d 1 -2 d 2 2 d -2 1 d cl s 1309 535 m -3 3 d -3 1 d -5 X -3 -1 d -3 -3
- d -1 -5 d -3 Y 1 -4 d 3 -3 d 3 -2 d 5 X 3 2 d 3 3 d s 842 966 m 414 381 d 338
- 445 d -189 -318 d 87 380 d -879 -715 d 470 -41 d -249 -49 d 183 345 d 434 297 d
- -335 -55 d 672 302 d -642 -825 d 103 102 d 245 1046 d 15 -657 d -243 -166 d -50
- -244 d -147 -24 d -261 -229 d 675 703 d -718 -718 d 545 541 d -773 -312 d 378
- -136 d -32 83 d 824 857 d -349 -347 d 341 298 d -732 -405 d 551 89 d -819 -567
- d 309 2 d -312 -61 d 100 215 d 801 487 d -245 -367 d -330 -33 d 126 161 d 92
- -242 d -21 -15 d 437 630 d -914 -468 d -374 Y 98 -4 d 195 166 d -92 261 d 604
- 146 d -292 -298 d 343 827 d -518 -987 d -112 235 d 680 448 d -342 178 d 239 52
- d -799 -669 d 328 -245 d -17 317 d -180 -364 d 676 707 d 41 -124 d -34 315 d
- -72 -390 d -685 87 d -147 -576 d 607 280 d 426 592 d -243 146 d -465 -832 d 161
- 205 d -448 -420 d 421 344 d 108 -138 d -414 1 d 16 -277 d 791 768 d -115 42 d
- -491 -722 d 604 894 d -440 -524 d -524 -331 d 443 196 d 623 507 d -268 183 d
- -173 -660 d -558 -220 d 657 909 d -113 -766 d 368 691 d -446 -711 d 340 650 d
- -165 -434 d -524 -440 d 571 415 d -649 -15 d -56 -369 d 750 951 d -542 -972 d
- 728 1028 d -281 -535 d s 222 1180 m 651 -497 d s 873 683 m 994 Y s 222 2174 m
- 651 -497 d s 222 1180 m 994 Y s 873 683 m 1128 287 d s 2001 970 m 994 Y s 873
- 1677 m 1128 287 d s 873 1677 m cl s 873 683 m 1128 287 d s 976 676 m 33 Y s
- 1001 699 m 16 Y s 1027 705 m 17 Y s 1053 712 m 16 Y s 1078 718 m 17 Y s 1104
- 708 m 33 Y s 1129 731 m 17 Y s 1155 738 m 17 Y s 1181 744 m 17 Y s 1206 751 m
- 17 Y s 1232 741 m 33 Y s 1258 764 m 17 Y s 1283 770 m 17 Y s 1309 777 m 17 Y s
- 1334 784 m 16 Y s 1360 773 m 34 Y s 1386 797 m 16 Y s 1411 803 m 17 Y s 1437
- 810 m 16 Y s 1463 816 m 17 Y s 1488 806 m 33 Y s 1514 829 m 17 Y s 1539 836 m
- 16 Y s 1565 842 m 17 Y s 1591 849 m 16 Y s 1616 839 m 33 Y s 1642 862 m 16 Y s
- 1668 868 m 17 Y s 1693 875 m 17 Y s 1719 881 m 17 Y s 1744 871 m 34 Y s 1770
- 894 m 17 Y s 1796 901 m 17 Y s 1821 907 m 17 Y s 1847 914 m 17 Y s 1873 904 m
- 33 Y s 1898 927 m 17 Y s 1924 934 m 16 Y s 1949 940 m 17 Y s 1975 947 m 16 Y s
- 2001 936 m 34 Y s 976 676 m 33 Y s 950 686 m 16 Y s 924 679 m 17 Y s 899 673 m
- 16 Y s 2001 936 m 34 Y s 978 657 m -4 -2 d -3 -4 d -2 -8 d -4 Y 2 -8 d 3 -4 d 4
- -1 d 3 X 5 1 d 2 4 d 2 8 d 4 Y -2 8 d -2 4 d -5 2 d -3 X cl s 1081 689 m -5 -1
- d -3 -5 d -1 -7 d -5 Y 1 -7 d 3 -4 d 5 -2 d 3 X 4 2 d 3 4 d 2 7 d 5 Y -2 7 d -3
- 5 d -4 1 d -3 X cl s 1104 661 m -1 -1 d 1 -2 d 2 2 d -2 1 d cl s 1118 682 m 1 Y
- 1 3 d 2 2 d 3 1 d 6 X 3 -1 d 1 -2 d 2 -3 d -3 Y -2 -3 d -3 -4 d -15 -15 d 21 X
- s 1164 689 m -15 X -2 -13 d 2 1 d 4 2 d 5 X 4 -2 d 3 -3 d 2 -4 d -3 Y -2 -4 d
- -3 -3 d -4 -2 d -5 X -4 2 d -2 1 d -1 3 d s 1220 722 m -5 -2 d -3 -4 d -1 -7 d
- -5 Y 1 -7 d 3 -5 d 5 -1 d 3 X 4 1 d 3 5 d 2 7 d 5 Y -2 7 d -3 4 d -4 2 d -3 X
- cl s 1244 694 m -2 -2 d 2 -1 d 1 1 d -1 2 d cl s 1273 722 m -15 X -1 -13 d 1 1
- d 5 2 d 4 X 5 -2 d 3 -3 d 1 -4 d -3 Y -1 -5 d -3 -3 d -5 -1 d -4 X -5 1 d -1 2
- d -2 3 d s 1337 754 m -5 -1 d -2 -4 d -2 -8 d -4 Y 2 -8 d 2 -4 d 5 -2 d 3 X 4 2
- d 3 4 d 2 8 d 4 Y -2 8 d -3 4 d -4 1 d -3 X cl s 1361 726 m -2 -1 d 2 -2 d 1 2
- d -1 1 d cl s 1393 754 m -15 -31 d s 1373 754 m 20 X s 1420 754 m -15 X -1 -13
- d 1 2 d 5 1 d 4 X 4 -1 d 3 -3 d 2 -5 d -3 Y -2 -4 d -3 -3 d -4 -2 d -4 X -5 2 d
- -1 1 d -2 3 d s 1486 781 m 3 2 d 5 4 d -31 Y s 1589 814 m 3 1 d 4 5 d -31 Y s
- 1617 792 m -2 -2 d 2 -1 d 1 1 d -1 2 d cl s 1630 812 m 2 Y 2 3 d 1 1 d 3 2 d 6
- X 3 -2 d 2 -1 d 1 -3 d -3 Y -1 -3 d -3 -5 d -15 -14 d 20 X s 1676 820 m -15 X
- -1 -14 d 1 2 d 5 1 d 4 X 5 -1 d 3 -3 d 1 -5 d -3 Y -1 -4 d -3 -3 d -5 -1 d -4 X
- -5 1 d -1 2 d -2 3 d s 1728 846 m 3 2 d 4 4 d -31 Y s 1756 824 m -1 -1 d 1 -2 d
- 1 2 d -1 1 d cl s 1786 852 m -15 X -2 -13 d 2 1 d 4 2 d 5 X 4 -2 d 3 -2 d 2 -5
- d -3 Y -2 -4 d -3 -3 d -4 -2 d -5 X -4 2 d -2 1 d -1 3 d s 1845 879 m 3 2 d 4 4
- d -31 Y s 1873 857 m -1 -2 d 1 -1 d 2 1 d -2 2 d cl s 1906 885 m -15 -31 d s
- 1885 885 m 21 X s 1932 885 m -14 X -2 -13 d 2 1 d 4 2 d 4 X 5 -2 d 3 -3 d 1 -4
- d -3 Y -1 -5 d -3 -3 d -5 -1 d -4 X -4 1 d -2 2 d -1 3 d s 1996 910 m 2 Y 1 3 d
- 2 1 d 3 2 d 6 X 2 -2 d 2 -1 d 1 -3 d -3 Y -1 -3 d -3 -5 d -15 -15 d 21 X s 873
- 683 m -651 497 d s 873 649 m 34 Y s 852 683 m 16 Y s 830 699 m 17 Y s 808 716 m
- 17 Y s 786 732 m 17 Y s 765 732 m 34 Y s 743 766 m 16 Y s 721 782 m 17 Y s 700
- 799 m 16 Y s 678 815 m 17 Y s 656 815 m 34 Y s 635 848 m 17 Y s 613 865 m 17 Y
- s 591 882 m 16 Y s 569 898 m 17 Y s 548 898 m 33 Y s 526 931 m 17 Y s 504 948 m
- 16 Y s 483 964 m 17 Y s 461 981 m 17 Y s 439 981 m 33 Y s 418 1014 m 17 Y s 396
- 1031 m 16 Y s 374 1047 m 17 Y s 352 1064 m 16 Y s 331 1064 m 33 Y s 309 1097 m
- 17 Y s 287 1114 m 16 Y s 266 1130 m 17 Y s 244 1147 m 16 Y s 222 1147 m 33 Y s
- 873 649 m 34 Y s 222 1147 m 33 Y s 785 573 m 27 X s 827 585 m 3 1 d 4 5 d -32 Y
- s 855 562 m -2 -1 d 2 -2 d 1 2 d -1 1 d cl s 884 591 m -14 X -2 -14 d 2 2 d 4 1
- d 4 X 5 -1 d 3 -3 d 1 -5 d -3 Y -1 -4 d -3 -3 d -5 -2 d -4 X -4 2 d -2 1 d -1 3
- d s 718 656 m 26 X s 759 667 m 3 2 d 5 4 d -31 Y s 568 738 m 27 X s 614 756 m
- -4 -1 d -3 -5 d -2 -7 d -5 Y 2 -7 d 3 -4 d 4 -2 d 3 X 4 2 d 3 4 d 2 7 d 5 Y -2
- 7 d -3 5 d -4 1 d -3 X cl s 638 728 m -2 -1 d 2 -2 d 1 2 d -1 1 d cl s 667 756
- m -14 X -2 -13 d 2 1 d 4 2 d 4 X 5 -2 d 3 -3 d 1 -4 d -3 Y -1 -4 d -3 -3 d -5
- -2 d -4 X -4 2 d -2 1 d -1 3 d s 537 839 m -5 -1 d -3 -5 d -1 -7 d -5 Y 1 -7 d
- 3 -5 d 5 -1 d 3 X 4 1 d 3 5 d 2 7 d 5 Y -2 7 d -3 5 d -4 1 d -3 X cl s 387 922
- m -4 -2 d -3 -4 d -2 -7 d -5 Y 2 -7 d 3 -5 d 4 -1 d 3 X 5 1 d 3 5 d 1 7 d 5 Y
- -1 7 d -3 4 d -5 2 d -3 X cl s 411 894 m -2 -2 d 2 -1 d 1 1 d -1 2 d cl s 441
- 922 m -15 X -2 -13 d 2 1 d 4 2 d 5 X 4 -2 d 3 -3 d 2 -4 d -3 Y -2 -5 d -3 -3 d
- -4 -1 d -5 X -4 1 d -2 2 d -1 3 d s 315 999 m 3 1 d 5 5 d -31 Y s 166 1082 m 3
- 1 d 4 5 d -31 Y s 194 1060 m -2 -2 d 2 -1 d 1 1 d -1 2 d cl s 224 1088 m -15 X
- -2 -14 d 2 2 d 4 1 d 5 X 4 -1 d 3 -3 d 2 -5 d -3 Y -2 -4 d -3 -3 d -4 -1 d -5 X
- -4 1 d -2 2 d -1 2 d s 222 1180 m 994 Y s 189 1180 m 33 X s 206 1200 m 16 X s
- 206 1220 m 16 X s 206 1240 m 16 X s 206 1259 m 16 X s 189 1279 m 33 X s 206
- 1299 m 16 X s 206 1319 m 16 X s 206 1339 m 16 X s 206 1359 m 16 X s 189 1379 m
- 33 X s 206 1399 m 16 X s 206 1419 m 16 X s 206 1438 m 16 X s 206 1458 m 16 X s
- 189 1478 m 33 X s 206 1498 m 16 X s 206 1518 m 16 X s 206 1538 m 16 X s 206
- 1558 m 16 X s 189 1578 m 33 X s 206 1598 m 16 X s 206 1617 m 16 X s 206 1637 m
- 16 X s 206 1657 m 16 X s 189 1677 m 33 X s 206 1697 m 16 X s 206 1717 m 16 X s
- 206 1737 m 16 X s 206 1757 m 16 X s 189 1776 m 33 X s 206 1796 m 16 X s 206
- 1816 m 16 X s 206 1836 m 16 X s 206 1856 m 16 X s 189 1876 m 33 X s 206 1896 m
- 16 X s 206 1916 m 16 X s 206 1936 m 16 X s 206 1955 m 16 X s 189 1975 m 33 X s
- 206 1995 m 16 X s 206 2015 m 16 X s 206 2035 m 16 X s 206 2055 m 16 X s 189
- 2075 m 33 X s 206 2095 m 16 X s 206 2115 m 16 X s 206 2134 m 16 X s 206 2154 m
- 16 X s 189 2174 m 33 X s 150 1195 m -4 -1 d -3 -4 d -1 -8 d -4 Y 1 -8 d 3 -4 d
- 4 -2 d 3 X 5 2 d 3 4 d 1 8 d 4 Y -1 8 d -3 4 d -5 1 d -3 X cl s 106 1295 m -4
- -2 d -3 -4 d -2 -7 d -5 Y 2 -7 d 3 -5 d 4 -1 d 3 X 4 1 d 3 5 d 2 7 d 5 Y -2 7 d
- -3 4 d -4 2 d -3 X cl s 130 1267 m -2 -2 d 2 -1 d 1 1 d -1 2 d cl s 159 1295 m
- -15 X -1 -13 d 1 1 d 5 2 d 4 X 5 -2 d 3 -3 d 1 -4 d -3 Y -1 -5 d -3 -3 d -5 -1
- d -4 X -5 1 d -1 2 d -1 3 d s 146 1388 m 3 2 d 4 4 d -31 Y s 102 1488 m 2 1 d 5
- 5 d -31 Y s 130 1466 m -2 -2 d 2 -1 d 1 1 d -1 2 d cl s 159 1494 m -15 X -1 -14
- d 1 2 d 5 1 d 4 X 5 -1 d 3 -3 d 1 -5 d -2 Y -1 -5 d -3 -3 d -5 -1 d -4 X -5 1 d
- -1 2 d -1 3 d s 143 1586 m 1 Y 1 3 d 2 2 d 3 1 d 6 X 3 -1 d 1 -2 d 2 -3 d -3 Y
- -2 -3 d -3 -4 d -14 -15 d 20 X s 99 1685 m 2 Y 1 3 d 2 1 d 2 2 d 6 X 3 -2 d 2
- -1 d 1 -3 d -3 Y -1 -3 d -3 -5 d -15 -15 d 21 X s 130 1664 m -2 -1 d 2 -2 d 1 2
- d -1 1 d cl s 159 1693 m -15 X -1 -14 d 1 2 d 5 1 d 4 X 5 -1 d 3 -3 d 1 -5 d -3
- Y -1 -4 d -3 -3 d -5 -2 d -4 X -5 2 d -1 1 d -1 3 d s 144 1792 m 17 X -9 -12 d
- 4 X 3 -1 d 2 -2 d 1 -4 d -3 Y -1 -5 d -3 -3 d -5 -1 d -4 X -5 1 d -1 2 d -1 3 d
- s 100 1891 m 16 X -9 -11 d 5 X 3 -2 d 1 -1 d 2 -5 d -3 Y -2 -4 d -3 -3 d -4 -2
- d -5 X -4 2 d -1 1 d -2 3 d s 130 1863 m -2 -1 d 2 -2 d 1 2 d -1 1 d cl s 159
- 1891 m -15 X -1 -13 d 1 2 d 5 1 d 4 X 5 -1 d 3 -3 d 1 -5 d -3 Y -1 -4 d -3 -3 d
- -5 -2 d -4 X -5 2 d -1 1 d -1 3 d s 156 1991 m -14 -21 d 22 X s 156 1991 m -31
- Y s 112 2090 m -15 -20 d 22 X s 112 2090 m -31 Y s 130 2062 m -2 -1 d 2 -2 d 1
- 2 d -1 1 d cl s 159 2090 m -15 X -1 -13 d 1 1 d 5 2 d 4 X 5 -2 d 3 -2 d 1 -5 d
- -3 Y -1 -4 d -3 -3 d -5 -2 d -4 X -5 2 d -1 1 d -1 3 d s 159 2190 m -15 X -1
- -14 d 1 2 d 5 1 d 4 X 5 -1 d 3 -3 d 1 -5 d -2 Y -1 -5 d -3 -3 d -5 -1 d -4 X -5
- 1 d -1 2 d -1 3 d s gr
-showpage
- gr
-%%Trailer
-%%Pages: 1
- gr gr
-%%EOF
diff --git a/src/pawlib/paw/testsuite/paw.commands/nt_pl_4d_4.ref.ps b/src/pawlib/paw/testsuite/paw.commands/nt_pl_4d_4.ref.ps
deleted file mode 100644
index 95a29cc..0000000
--- a/src/pawlib/paw/testsuite/paw.commands/nt_pl_4d_4.ref.ps
+++ /dev/null
@@ -1,175 +0,0 @@
-%!PS-Adobe-2.0
-%%Title: /disk3/maartenb/cerncvs/paw/testsuite/tmp/nt_pl_4d_ (Portrait A 4)
-%%Pages: (atend)
-%%Creator: HIGZ Version 1.23/06
-%%CreationDate: 96/04/03 16.26
-%%EndComments
-%%BeginProlog
-/s {stroke} def /l {lineto} def /m {moveto} def /t {translate} def
-/sw {stringwidth} def /r {rotate} def /rl {roll} def /R {repeat} def
-/d {rlineto} def /rm {rmoveto} def /gr {grestore} def /f {eofill} def
-/c {setrgbcolor} def /lw {setlinewidth} def /sd {setdash} def
-/cl {closepath} def /sf {scalefont setfont} def /black {0 setgray} def
-/box {m dup 0 exch d exch 0 d 0 exch neg d cl} def
-/NC{systemdict begin initclip end}def/C{NC box clip newpath}def
-/bl {box s} def /bf {box f} def /Y { 0 exch d} def /X { 0 d} def
-/mp {newpath /y exch def /x exch def} def
-/side {[w .77 mul w .23 mul] .385 w mul sd w 0 l currentpoint t -144 r} def
-/mr {mp x y w2 0 360 arc} def /m24 {mr s} def /m20 {mr f} def
-/mb {mp x y w2 add m w2 neg 0 d 0 w neg d w 0 d 0 w d cl} def
-/mt {mp x y w2 add m w2 neg w neg d w 0 d cl} def
-/m21 {mb f} def /m25 {mb s} def /m22 {mt f} def /m26 {mt s} def
-/m23 {mp x y w2 sub m w2 w d w neg 0 d cl f} def
-/m27 {mp x y w2 add m w3 neg w2 neg d w3 w2 neg d w3 w2 d cl s} def
-/m28 {mp x w2 sub y w2 sub w3 add m w3 0 d 0 w3 neg d w3 0 d 0 w3 d w3 0 d
- 0 w3 d w3 neg 0 d 0 w3 d w3 neg 0 d
- 0 w3 neg d w3 neg 0 d cl s } def
-/m29 {mp gsave x w2 sub y w2 add w3 sub m currentpoint t
- 4 {side} repeat cl fill gr} def
-/m30 {mp gsave x w2 sub y w2 add w3 sub m currentpoint t
- 5 {side} repeat s gr} def
-/m31 {mp x y w2 sub m 0 w d x w2 sub y m w 0 d
- x w2 sub y w2 add m w w neg d x w2 sub y w2
- sub m w w d s} def
-/m2 {mp x y w2 sub m 0 w d x w2 sub y m w 0 d s} def
-/m5 {mp x w2 sub y w2 sub m w w d x w2 sub y w2 add m w w neg d s} def
-/DP {/PT exch def gsave 47.2 47.2 scale PT 1 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < AA AA 55 55 AA AA 55 55 AA AA 55 55 AA AA 55 55 AA AA 55 55 AA AA 55 55
-AA AA 55 55 AA AA 55 55 > } image } if PT 2 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < BB BB EE EE BB BB EE EE BB BB EE EE BB BB EE EE BB BB EE EE BB BB EE EE
-BB BB EE EE BB BB EE EE > } image } if PT 3 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < FF FF BB BB FF FF EE EE FF FF BB BB FF FF EE EE FF FF BB BB FF FF EE EE
-FF FF BB BB FF FF EE EE > } image } if PT 4 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < DF DF BF BF 7F 7F FE FE FD FD FB FB F7 F7 EF EF DF DF BF BF 7F 7F FE FE
-FD FD FB FB F7 F7 EF EF > } image } if PT 5 eq { 16 16 1 [ 16 0 0 16 neg 0 16
-] { < 7F 7F BF B F DF DF EF EF F7 F7 FB FB FD FD FE FE 7F 7F BF BF DF DF EF
-EF F7 F7 FB FB FD FD FE FE > } image } if PT 6 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB BB
-BB BB BB BB BB BB BB BB BB > } image } if PT 7 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < FF FF FF FF FF FF 00 00 FF FF FF FF FF FF 00 00 FF FF FF FF FF FF 00
-00 FF FF FF FF FF FF 00 00 > } image } if PT 8 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < EE EE 47 47 83 83 C5 C5 EE EE 5C 5C 38 38 74 74 EE EE 47 47 83 83 C5
-C5 EE EE 5C 5C 38 38 74 74 > } image } if PT 9 eq { 16 16 1 [ 16 0 0 16 neg 0
-16 ] { < EF EF EF EF D7 D7 38 38 FE FE FE FE 7D 7D 83 83 EF EF EF EF D7 D7 38
-38 FE FE FE FE 7D 7D 83 83 > } image } if PT 10 eq { 16 16 1 [ 16 0 0 16 neg
-0 16 ] { < EF EF EF EF EF EF 00 00 FE FE FE FE FE FE 00 00 EF EF EF EF EF EF
-00 00 FE FE FE FE FE FE 00 00 > } image } if PT 11 eq { 16 16 1 [ 16 0 0 16
-neg 0 16 ] { < F7 F7 B6 B6 D5 D5 E3 E3 D5 D5 B6 B6 F7 F7 FF FF 7F 7F 6B 6B 5D
-5D 3E 3E 5D 5D 6B 6B 7F 7F FF FF > } image } if PT 12 eq { 16 16 1 [ 16 0 0
-16 neg 0 16 ] { < E3 E3 DD DD BE BE BE BE BE BE DD DD E3 E3 FF FF 3E 3E DD DD
-EB EB EB EB EB EB DD DD 3E 3E FF FF > } image } if PT 13 eq { 16 16 1 [ 16 0
-0 16 neg 0 16 ] { < FE FE 7D 7D BB BB D7 D7 EF EF D7 D7 BB BB 7D 7D FE FE 7D
-7D BB BB D7 D7 EF EF D7 D7 BB BB 7D 7D > } image } if PT 14 eq { 16 16 1 [ 16
-0 0 16 neg 0 16 ] { < 00 00 EE EF EE EF EE EF 0E E0 EE EE EE EE EE EE 00 EE
-FE EE FE EE FE EE 00 00 FE EF FE EF FE EF > } image } if PT 15 eq { 16 16 1 [
-16 0 0 16 neg 0 16 ] { < DD DD AA AA DD DD FF FF 77 77 AA AA 77 77 FF FF DD
-DD AA AA DD DD FF FF 77 77 AA AA 77 77 FF FF > } image } if PT 16 eq { 16 16
-1 [ 16 0 0 16 neg 0 16 ] { < F1 F1 EE EE 1F 1F FF FF F1 F1 EE EE 1F 1F FF FF
-F1 F1 EE EE 1F 1F FF FF F1 F1 EE EE 1F 1F FF FF > } image } if PT 17 eq { 16
-16 1 [ 16 0 0 16 neg 0 16 ] { < EE EE DD DD BB BB FF FF EE EE DD DD BB BB FF
- FF EE EE DD DD BB BB FF FF EE EE DD DD BB BB FF FF > } image } if PT 18 eq {
-16 16 1 [ 16 0 0 16 neg 0 16 ] { < BB BB DD DD EE EE FF FF BB BB DD DD EE EE
-FF FF BB BB DD DD EE EE FF FF BB BB DD DD EE EE FF FF > } image } if PT 19 eq
-{ 16 16 1 [ 16 0 0 16 neg 0 16 ] { < 1F FC 67 F3 7B EF BD DE BD DE DE BD E6
-B3 F8 0F E6 B3 DE BD BD DE BD DE 7B EF 67 F3 1F FC 7F FF > } image } if PT
-20 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < DD DD EE EE EE EE EE EE DD DD BB
-BB BB BB BB BB DD DD EE EE EE EE EE EE DD DD BB BB BB BB BB BB > } image }
-if PT 21 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < 0E 0E EF EF EF EF EF EF E0
-E0 FE FE FE FE FE FE 0E 0E EF EF EF EF EF EF E0 E0 FE FE FE FE FE FE > }
-image } if PT 22 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < 70 70 F7 F7 F7 F7 F7
-F7 07 07 7F 7F 7F 7F 7F 7F 70 70 F7 F7 F7 F7 F7 F7 07 07 7F 7F 7F 7F 7F 7F >
-} image } if PT 23 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < AA AA 55 55 A9 A9
-D1 D1 E1 E1 D1 D1 A9 A9 55 55 AA AA 55 55 A9 A9 D1 D1 E1 E1 D1 D1 A9 A9 55 55
-> } image } if PT 24 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < FF FE FF FC EA
-A8 D5 54 EA A8 D5 54 E8 28 D4 54 E8 E8 D4 D4 E8 EA 54 D5 A8 EA 54 D5 00 C0 00
-80 > } image } if PT 25 eq { 16 16 1 [ 16 0 0 16 neg 0 16 ] { < FF FE FF FC
-FF F8 FF F0 F0 00 F0 00 F0 20 F0 60 F0 E0 F1 E0 F3 E0 F0 00 E0 00 C0 00 80 00
-00 00 > } image } if gr } def /FA { /PT exch def gsave clip 0 0 translate 1 1
-54 { 1 sub 47.2 mul /Xcurr exch def 1 1 74 { 1 sub 47.2 mul /Ycurr exch def
-gsave Xcurr Ycurr translate PT DP gr } for } for gr } def
-/reencdict 24 dict def /ReEncode {reencdict begin /nco&na exch def
-/nfnam exch def /basefontname exch def /basefontdict basefontname findfont def
-/newfont basefontdict maxlength dict def basefontdict {exch dup /FID ne
-{dup /Encoding eq {exch dup length array copy newfont 3 1 roll put} {exch
-newfont 3 1 roll put} ifelse} {pop pop} ifelse } forall newfont
-/FontName nfnam put nco&na aload pop nco&na length 2 idiv {newfont
-/Encoding get 3 1 roll put} repeat nfnam newfont definefont pop end } def
-/accvec [ 176 /agrave 181 /Agrave 190 /acircumflex 192 /Acircumflex
-201 /adieresis 204 /Adieresis 209 /ccedilla 210 /Ccedilla 211 /eacute
-212 /Eacute 213 /egrave 214 /Egrave 215 /ecircumflex 216 /Ecircumflex
-217 /edieresis 218 /Edieresis 219 /icircumflex 220 /Icircumflex
-221 /idieresis 222 /Idieresis 223 /ntilde 224 /Ntilde 226 /ocircumflex
-228 /Ocircumflex 229 /odieresis 230 /Odieresis 231 /ucircumflex 236 /Ucircumflex
-237 /udieresis 238 /Udieresis 239 /aring 242 /Aring 243 /ydieresis
-244 /Ydieresis 246 /aacute 247 /Aacute 252 /ugrave 253 /Ugrave] def
-/Times-Roman /Times-Roman accvec ReEncode
-/Times-Italic /Times-Italic accvec ReEncode
-/Times-Bold /Times-Bold accvec ReEncode
-/Times-BoldItalic /Times-BoldItalic accvec ReEncode
-/Helvetica /Helvetica accvec ReEncode
-/Helvetica-Oblique /Helvetica-Oblique accvec ReEncode
-/Helvetica-Bold /Helvetica-Bold accvec ReEncode
-/Helvetica-BoldOblique /Helvetica-BoldOblique accvec ReEncode
-/Courier /Courier accvec ReEncode
-/Courier-Oblique /Courier-Oblique accvec ReEncode
-/Courier-Bold /Courier-Bold accvec ReEncode
-/Courier-BoldOblique /Courier-BoldOblique accvec ReEncode
-/oshow {gsave [] 0 sd true charpath stroke gr} def
-/stwn { /fs exch def /fn exch def /text exch def fn findfont fs sf
- text sw pop xs add /xs exch def} def
-/stwb { /fs exch def /fn exch def /nbas exch def /textf exch def
-textf length /tlen exch def nbas tlen gt {/nbas tlen def} if
-fn findfont fs sf textf dup length nbas sub nbas getinterval sw
-pop neg xs add /xs exch def} def
-/accspe [ 65 /plusminus 66 /bar 67 /existential 68 /universal
-69 /exclam 70 /numbersign 71 /greater 72 /question 73 /integral
-74 /colon 75 /semicolon 76 /less 77 /bracketleft 78 /bracketright
-79 /greaterequal 80 /braceleft 81 /braceright 82 /radical
-83 /spade 84 /heart 85 /diamond 86 /club 87 /lessequal
-88 /multiply 89 /percent 90 /infinity 48 /circlemultiply 49 /circleplus
-50 /emptyset 51 /lozenge 52 /bullet 53 /arrowright 54 /arrowup
-55 /arrowleft 56 /arrowdown 57 /arrowboth 48 /degree 44 /comma 43 /plus
- 45 /angle 42 /angleleft 47 /divide 61 /notequal 40 /equivalence 41 /second
- 97 /approxequal 98 /congruent 99 /perpendicular 100 /partialdiff 101 /florin
- 102 /intersection 103 /union 104 /propersuperset 105 /reflexsuperset
- 106 /notsubset 107 /propersubset 108 /reflexsubset 109 /element 110 /notelement
- 111 /gradient 112 /logicaland 113 /logicalor 114 /arrowdblboth
- 115 /arrowdblleft 116 /arrowdblup 117 /arrowdblright 118 /arrowdbldown
- 119 /ampersand 120 /omega1 121 /similar 122 /aleph ] def
-/Symbol /Special accspe ReEncode
-/Zone {/iy exch def /ix exch def ix 1 sub 2224 mul 1 iy sub 3144
- mul t} def
-%%EndProlog
- gsave 20 28 t .25 .25 scale gsave
-%%Page: number 1
-gr
- gsave
- 1 1 Zone
- gsave 0 0 t black [] 0 sd 1 lw 2223 2224 0 460 bl 2223 2224 0 460 C NC 1779
- 1778 222 683 bl 1779 1778 222 683 C 1000 1625 m -53 Y s 1000 1625 m 33 X s 1000
- 1600 m 20 X s 1000 1572 m 33 X s 1048 1608 m -36 Y s 1048 1597 m 8 8 d 5 3 d 7
- X 5 -3 d 3 -8 d -25 Y s 1076 1597 m 8 8 d 5 3 d 7 X 5 -3 d 3 -8 d -25 Y s 1124
- 1608 m -54 Y s 1124 1600 m 5 5 d 5 3 d 8 X 5 -3 d 5 -5 d 3 -8 d -5 Y -3 -7 d -5
- -5 d -5 -3 d -8 X -5 3 d -5 5 d s 1175 1625 m -43 Y 3 -7 d 5 -3 d 5 X s 1167
- 1608 m 18 X s 1198 1608 m 15 -36 d s 1228 1608 m -15 -36 d -5 -10 d -5 -5 d -5
- -3 d -3 X s 2223 2224 0 460 C 931 539 m -17 -21 d s 914 539 m 17 X s 914 518 m
- 17 X s 951 549 m 12 -31 d s 975 549 m -12 -31 d s 1002 545 m -3 3 d -5 1 d -5 X
- -5 -1 d -3 -3 d -3 Y 2 -3 d 1 -1 d 3 -2 d 9 -3 d 3 -1 d 1 -2 d 2 -3 d -4 Y -3
- -3 d -5 -2 d -5 X -5 2 d -3 3 d s 1014 521 m -2 -1 d 2 -2 d 1 2 d -1 1 d cl s
- 1039 539 m 9 -21 d s 1057 539 m -9 -21 d -3 -6 d -3 -3 d -3 -1 d -2 X s 1076
- 549 m 12 -31 d s 1100 549 m -12 -31 d s 1126 545 m -3 3 d -4 1 d -6 X -4 -1 d
- -3 -3 d -3 Y 1 -3 d 2 -1 d 3 -2 d 8 -3 d 3 -1 d 2 -2 d 1 -3 d -4 Y -3 -3 d -4
- -2 d -6 X -4 2 d -3 3 d s 1138 521 m -1 -1 d 1 -2 d 2 2 d -2 1 d cl s 1165 539
- m 16 -21 d s 1181 539 m -16 -21 d s 1202 549 m 12 -31 d s 1226 549 m -12 -31 d
- s 1252 545 m -3 3 d -4 1 d -6 X -4 -1 d -3 -3 d -3 Y 1 -3 d 2 -1 d 2 -2 d 9 -3
- d 3 -1 d 2 -2 d 1 -3 d -4 Y -3 -3 d -4 -2 d -6 X -4 2 d -3 3 d s 1264 521 m -1
- -1 d 1 -2 d 2 2 d -2 1 d cl s 1309 535 m -3 3 d -3 1 d -5 X -3 -1 d -3 -3 d -1
- -5 d -3 Y 1 -4 d 3 -3 d 3 -2 d 5 X 3 2 d 3 3 d s 1779 1778 222 683 C
-gr
- gr
-showpage
- gr
-%%Trailer
-%%Pages: 1
- gr gr
-%%EOF
diff --git a/src/pawlib/paw/testsuite/paw.commands/testloop.out.ref b/src/pawlib/paw/testsuite/paw.commands/testloop.out.ref
deleted file mode 100644
index 770c71b..0000000
--- a/src/pawlib/paw/testsuite/paw.commands/testloop.out.ref
+++ /dev/null
@@ -1,228 +0,0 @@
- 1 3000.000 2011 2021 2031 2012 2022 2032 2013 2023 2033 2014
- 2024 2034
- 2 3001.000 2011 2021 2031 2012 2022 2032 2013 2023 2033 2014
- 2024 2034 .40010000000000D+04
- 3 3002.000 2011 2021 2031 2012 2022 2032 2013 2023 2033 2014
- 2024 2034 .40010000000000D+04 .40020000000000D+04
- 4 3003.000 2011 2021 2031 2012 2022 2032 2013 2023 2033 2014
- 2024 2034 .40010000000000D+04 .40020000000000D+04 .40030000000000D+04
- 5 3004.000 2011 2021 2031 2012 2022 2032 2013 2023 2033 2014
- 2024 2034 .40010000000000D+04 .40020000000000D+04 .40030000000000D+04 .40040000000000D+04
- 6 3005.000 2011 2021 2031 2012 2022 2032 2013 2023 2033 2014
- 2024 2034 .40010000000000D+04 .40020000000000D+04 .40030000000000D+04 .40040000000000D+04
- .40050000000000D+04
- 7 3006.000 2011 2021 2031 2012 2022 2032 2013 2023 2033 2014
- 2024 2034 .40010000000000D+04 .40020000000000D+04 .40030000000000D+04 .40040000000000D+04
- .40050000000000D+04 .40060000000000D+04
- 8 3000.000 2011 2021 2031 2012 2022 2032 2013 2023 2033 2014
- 2024 2034
- 9 3001.000 2011 2021 2031 2012 2022 2032 2013 2023 2033 2014
- 2024 2034 .40010000000000D+04
- 10 3002.000 2011 2021 2031 2012 2022 2032 2013 2023 2033 2014
- 2024 2034 .40010000000000D+04 .40020000000000D+04
- 11 3003.000 2011 2021 2031 2012 2022 2032 2013 2023 2033 2014
- 2024 2034 .40010000000000D+04 .40020000000000D+04 .40030000000000D+04
- 12 3004.000 2011 2021 2031 2012 2022 2032 2013 2023 2033 2014
- 2024 2034 .40010000000000D+04 .40020000000000D+04 .40030000000000D+04 .40040000000000D+04
- 13 3005.000 2011 2021 2031 2012 2022 2032 2013 2023 2033 2014
- 2024 2034 .40010000000000D+04 .40020000000000D+04 .40030000000000D+04 .40040000000000D+04
- .40050000000000D+04
- 14 3006.000 2011 2021 2031 2012 2022 2032 2013 2023 2033 2014
- 2024 2034 .40010000000000D+04 .40020000000000D+04 .40030000000000D+04 .40040000000000D+04
- .40050000000000D+04 .40060000000000D+04
- 15 3000.000 2011 2021 2031 2012 2022 2032 2013 2023 2033 2014
- 2024 2034
- 16 3001.000 2011 2021 2031 2012 2022 2032 2013 2023 2033 2014
- 2024 2034 .40010000000000D+04
- 17 3002.000 2011 2021 2031 2012 2022 2032 2013 2023 2033 2014
- 2024 2034 .40010000000000D+04 .40020000000000D+04
- 18 3003.000 2011 2021 2031 2012 2022 2032 2013 2023 2033 2014
- 2024 2034 .40010000000000D+04 .40020000000000D+04 .40030000000000D+04
- 19 3004.000 2011 2021 2031 2012 2022 2032 2013 2023 2033 2014
- 2024 2034 .40010000000000D+04 .40020000000000D+04 .40030000000000D+04 .40040000000000D+04
- 20 3005.000 2011 2021 2031 2012 2022 2032 2013 2023 2033 2014
- 2024 2034 .40010000000000D+04 .40020000000000D+04 .40030000000000D+04 .40040000000000D+04
- .40050000000000D+04
- 21 3006.000 2011 2021 2031 2012 2022 2032 2013 2023 2033 2014
- 2024 2034 .40010000000000D+04 .40020000000000D+04 .40030000000000D+04 .40040000000000D+04
- .40050000000000D+04 .40060000000000D+04
- 22 3000.000 2011 2021 2031 2012 2022 2032 2013 2023 2033 2014
- 2024 2034
- 23 3001.000 2011 2021 2031 2012 2022 2032 2013 2023 2033 2014
- 2024 2034 .40010000000000D+04
- 24 3002.000 2011 2021 2031 2012 2022 2032 2013 2023 2033 2014
- 2024 2034 .40010000000000D+04 .40020000000000D+04
- 25 3003.000 2011 2021 2031 2012 2022 2032 2013 2023 2033 2014
- 2024 2034 .40010000000000D+04 .40020000000000D+04 .40030000000000D+04
- 26 3004.000 2011 2021 2031 2012 2022 2032 2013 2023 2033 2014
- 2024 2034 .40010000000000D+04 .40020000000000D+04 .40030000000000D+04 .40040000000000D+04
- 27 3005.000 2011 2021 2031 2012 2022 2032 2013 2023 2033 2014
- 2024 2034 .40010000000000D+04 .40020000000000D+04 .40030000000000D+04 .40040000000000D+04
- .40050000000000D+04
- 28 3006.000 2011 2021 2031 2012 2022 2032 2013 2023 2033 2014
- 2024 2034 .40010000000000D+04 .40020000000000D+04 .40030000000000D+04 .40040000000000D+04
- .40050000000000D+04 .40060000000000D+04
- 29 3000.000 2011 2021 2031 2012 2022 2032 2013 2023 2033 2014
- 2024 2034
- 30 3001.000 2011 2021 2031 2012 2022 2032 2013 2023 2033 2014
- 2024 2034 .40010000000000D+04
- 31 3002.000 2011 2021 2031 2012 2022 2032 2013 2023 2033 2014
- 2024 2034 .40010000000000D+04 .40020000000000D+04
- 32 3003.000 2011 2021 2031 2012 2022 2032 2013 2023 2033 2014
- 2024 2034 .40010000000000D+04 .40020000000000D+04 .40030000000000D+04
- 33 3004.000 2011 2021 2031 2012 2022 2032 2013 2023 2033 2014
- 2024 2034 .40010000000000D+04 .40020000000000D+04 .40030000000000D+04 .40040000000000D+04
- 34 3005.000 2011 2021 2031 2012 2022 2032 2013 2023 2033 2014
- 2024 2034 .40010000000000D+04 .40020000000000D+04 .40030000000000D+04 .40040000000000D+04
- .40050000000000D+04
- 35 3006.000 2011 2021 2031 2012 2022 2032 2013 2023 2033 2014
- 2024 2034 .40010000000000D+04 .40020000000000D+04 .40030000000000D+04 .40040000000000D+04
- .40050000000000D+04 .40060000000000D+04
- 36 3000.000 2011 2021 2031 2012 2022 2032 2013 2023 2033 2014
- 2024 2034
- 37 3001.000 2011 2021 2031 2012 2022 2032 2013 2023 2033 2014
- 2024 2034 .40010000000000D+04
- 38 3002.000 2011 2021 2031 2012 2022 2032 2013 2023 2033 2014
- 2024 2034 .40010000000000D+04 .40020000000000D+04
- 39 3003.000 2011 2021 2031 2012 2022 2032 2013 2023 2033 2014
- 2024 2034 .40010000000000D+04 .40020000000000D+04 .40030000000000D+04
- 40 3004.000 2011 2021 2031 2012 2022 2032 2013 2023 2033 2014
- 2024 2034 .40010000000000D+04 .40020000000000D+04 .40030000000000D+04 .40040000000000D+04
- 41 3005.000 2011 2021 2031 2012 2022 2032 2013 2023 2033 2014
- 2024 2034 .40010000000000D+04 .40020000000000D+04 .40030000000000D+04 .40040000000000D+04
- .40050000000000D+04
- 42 3006.000 2011 2021 2031 2012 2022 2032 2013 2023 2033 2014
- 2024 2034 .40010000000000D+04 .40020000000000D+04 .40030000000000D+04 .40040000000000D+04
- .40050000000000D+04 .40060000000000D+04
- 43 3000.000 2011 2021 2031 2012 2022 2032 2013 2023 2033 2014
- 2024 2034
- 44 3001.000 2011 2021 2031 2012 2022 2032 2013 2023 2033 2014
- 2024 2034 .40010000000000D+04
- 45 3002.000 2011 2021 2031 2012 2022 2032 2013 2023 2033 2014
- 2024 2034 .40010000000000D+04 .40020000000000D+04
- 46 3003.000 2011 2021 2031 2012 2022 2032 2013 2023 2033 2014
- 2024 2034 .40010000000000D+04 .40020000000000D+04 .40030000000000D+04
- 47 3004.000 2011 2021 2031 2012 2022 2032 2013 2023 2033 2014
- 2024 2034 .40010000000000D+04 .40020000000000D+04 .40030000000000D+04 .40040000000000D+04
- 48 3005.000 2011 2021 2031 2012 2022 2032 2013 2023 2033 2014
- 2024 2034 .40010000000000D+04 .40020000000000D+04 .40030000000000D+04 .40040000000000D+04
- .40050000000000D+04
- 49 3006.000 2011 2021 2031 2012 2022 2032 2013 2023 2033 2014
- 2024 2034 .40010000000000D+04 .40020000000000D+04 .40030000000000D+04 .40040000000000D+04
- .40050000000000D+04 .40060000000000D+04
- 50 3000.000 2011 2021 2031 2012 2022 2032 2013 2023 2033 2014
- 2024 2034
- 51 3001.000 2011 2021 2031 2012 2022 2032 2013 2023 2033 2014
- 2024 2034 .40010000000000D+04
- 52 3002.000 2011 2021 2031 2012 2022 2032 2013 2023 2033 2014
- 2024 2034 .40010000000000D+04 .40020000000000D+04
- 53 3003.000 2011 2021 2031 2012 2022 2032 2013 2023 2033 2014
- 2024 2034 .40010000000000D+04 .40020000000000D+04 .40030000000000D+04
- 54 3004.000 2011 2021 2031 2012 2022 2032 2013 2023 2033 2014
- 2024 2034 .40010000000000D+04 .40020000000000D+04 .40030000000000D+04 .40040000000000D+04
- 55 3005.000 2011 2021 2031 2012 2022 2032 2013 2023 2033 2014
- 2024 2034 .40010000000000D+04 .40020000000000D+04 .40030000000000D+04 .40040000000000D+04
- .40050000000000D+04
- 56 3006.000 2011 2021 2031 2012 2022 2032 2013 2023 2033 2014
- 2024 2034 .40010000000000D+04 .40020000000000D+04 .40030000000000D+04 .40040000000000D+04
- .40050000000000D+04 .40060000000000D+04
- 57 3000.000 2011 2021 2031 2012 2022 2032 2013 2023 2033 2014
- 2024 2034
- 58 3001.000 2011 2021 2031 2012 2022 2032 2013 2023 2033 2014
- 2024 2034 .40010000000000D+04
- 59 3002.000 2011 2021 2031 2012 2022 2032 2013 2023 2033 2014
- 2024 2034 .40010000000000D+04 .40020000000000D+04
- 60 3003.000 2011 2021 2031 2012 2022 2032 2013 2023 2033 2014
- 2024 2034 .40010000000000D+04 .40020000000000D+04 .40030000000000D+04
- 61 3004.000 2011 2021 2031 2012 2022 2032 2013 2023 2033 2014
- 2024 2034 .40010000000000D+04 .40020000000000D+04 .40030000000000D+04 .40040000000000D+04
- 62 3005.000 2011 2021 2031 2012 2022 2032 2013 2023 2033 2014
- 2024 2034 .40010000000000D+04 .40020000000000D+04 .40030000000000D+04 .40040000000000D+04
- .40050000000000D+04
- 63 3006.000 2011 2021 2031 2012 2022 2032 2013 2023 2033 2014
- 2024 2034 .40010000000000D+04 .40020000000000D+04 .40030000000000D+04 .40040000000000D+04
- .40050000000000D+04 .40060000000000D+04
- 64 3000.000 2011 2021 2031 2012 2022 2032 2013 2023 2033 2014
- 2024 2034
- 65 3001.000 2011 2021 2031 2012 2022 2032 2013 2023 2033 2014
- 2024 2034 .40010000000000D+04
- 66 3002.000 2011 2021 2031 2012 2022 2032 2013 2023 2033 2014
- 2024 2034 .40010000000000D+04 .40020000000000D+04
- 67 3003.000 2011 2021 2031 2012 2022 2032 2013 2023 2033 2014
- 2024 2034 .40010000000000D+04 .40020000000000D+04 .40030000000000D+04
- 68 3004.000 2011 2021 2031 2012 2022 2032 2013 2023 2033 2014
- 2024 2034 .40010000000000D+04 .40020000000000D+04 .40030000000000D+04 .40040000000000D+04
- 69 3005.000 2011 2021 2031 2012 2022 2032 2013 2023 2033 2014
- 2024 2034 .40010000000000D+04 .40020000000000D+04 .40030000000000D+04 .40040000000000D+04
- .40050000000000D+04
- 70 3006.000 2011 2021 2031 2012 2022 2032 2013 2023 2033 2014
- 2024 2034 .40010000000000D+04 .40020000000000D+04 .40030000000000D+04 .40040000000000D+04
- .40050000000000D+04 .40060000000000D+04
- 71 3000.000 2011 2021 2031 2012 2022 2032 2013 2023 2033 2014
- 2024 2034
- 72 3001.000 2011 2021 2031 2012 2022 2032 2013 2023 2033 2014
- 2024 2034 .40010000000000D+04
- 73 3002.000 2011 2021 2031 2012 2022 2032 2013 2023 2033 2014
- 2024 2034 .40010000000000D+04 .40020000000000D+04
- 74 3003.000 2011 2021 2031 2012 2022 2032 2013 2023 2033 2014
- 2024 2034 .40010000000000D+04 .40020000000000D+04 .40030000000000D+04
- 75 3004.000 2011 2021 2031 2012 2022 2032 2013 2023 2033 2014
- 2024 2034 .40010000000000D+04 .40020000000000D+04 .40030000000000D+04 .40040000000000D+04
- 76 3005.000 2011 2021 2031 2012 2022 2032 2013 2023 2033 2014
- 2024 2034 .40010000000000D+04 .40020000000000D+04 .40030000000000D+04 .40040000000000D+04
- .40050000000000D+04
- 77 3006.000 2011 2021 2031 2012 2022 2032 2013 2023 2033 2014
- 2024 2034 .40010000000000D+04 .40020000000000D+04 .40030000000000D+04 .40040000000000D+04
- .40050000000000D+04 .40060000000000D+04
- 78 3000.000 2011 2021 2031 2012 2022 2032 2013 2023 2033 2014
- 2024 2034
- 79 3001.000 2011 2021 2031 2012 2022 2032 2013 2023 2033 2014
- 2024 2034 .40010000000000D+04
- 80 3002.000 2011 2021 2031 2012 2022 2032 2013 2023 2033 2014
- 2024 2034 .40010000000000D+04 .40020000000000D+04
- 81 3003.000 2011 2021 2031 2012 2022 2032 2013 2023 2033 2014
- 2024 2034 .40010000000000D+04 .40020000000000D+04 .40030000000000D+04
- 82 3004.000 2011 2021 2031 2012 2022 2032 2013 2023 2033 2014
- 2024 2034 .40010000000000D+04 .40020000000000D+04 .40030000000000D+04 .40040000000000D+04
- 83 3005.000 2011 2021 2031 2012 2022 2032 2013 2023 2033 2014
- 2024 2034 .40010000000000D+04 .40020000000000D+04 .40030000000000D+04 .40040000000000D+04
- .40050000000000D+04
- 84 3006.000 2011 2021 2031 2012 2022 2032 2013 2023 2033 2014
- 2024 2034 .40010000000000D+04 .40020000000000D+04 .40030000000000D+04 .40040000000000D+04
- .40050000000000D+04 .40060000000000D+04
- 85 3000.000 2011 2021 2031 2012 2022 2032 2013 2023 2033 2014
- 2024 2034
- 86 3001.000 2011 2021 2031 2012 2022 2032 2013 2023 2033 2014
- 2024 2034 .40010000000000D+04
- 87 3002.000 2011 2021 2031 2012 2022 2032 2013 2023 2033 2014
- 2024 2034 .40010000000000D+04 .40020000000000D+04
- 88 3003.000 2011 2021 2031 2012 2022 2032 2013 2023 2033 2014
- 2024 2034 .40010000000000D+04 .40020000000000D+04 .40030000000000D+04
- 89 3004.000 2011 2021 2031 2012 2022 2032 2013 2023 2033 2014
- 2024 2034 .40010000000000D+04 .40020000000000D+04 .40030000000000D+04 .40040000000000D+04
- 90 3005.000 2011 2021 2031 2012 2022 2032 2013 2023 2033 2014
- 2024 2034 .40010000000000D+04 .40020000000000D+04 .40030000000000D+04 .40040000000000D+04
- .40050000000000D+04
- 91 3006.000 2011 2021 2031 2012 2022 2032 2013 2023 2033 2014
- 2024 2034 .40010000000000D+04 .40020000000000D+04 .40030000000000D+04 .40040000000000D+04
- .40050000000000D+04 .40060000000000D+04
- 92 3000.000 2011 2021 2031 2012 2022 2032 2013 2023 2033 2014
- 2024 2034
- 93 3001.000 2011 2021 2031 2012 2022 2032 2013 2023 2033 2014
- 2024 2034 .40010000000000D+04
- 94 3002.000 2011 2021 2031 2012 2022 2032 2013 2023 2033 2014
- 2024 2034 .40010000000000D+04 .40020000000000D+04
- 95 3003.000 2011 2021 2031 2012 2022 2032 2013 2023 2033 2014
- 2024 2034 .40010000000000D+04 .40020000000000D+04 .40030000000000D+04
- 96 3004.000 2011 2021 2031 2012 2022 2032 2013 2023 2033 2014
- 2024 2034 .40010000000000D+04 .40020000000000D+04 .40030000000000D+04 .40040000000000D+04
- 97 3005.000 2011 2021 2031 2012 2022 2032 2013 2023 2033 2014
- 2024 2034 .40010000000000D+04 .40020000000000D+04 .40030000000000D+04 .40040000000000D+04
- .40050000000000D+04
- 98 3006.000 2011 2021 2031 2012 2022 2032 2013 2023 2033 2014
- 2024 2034 .40010000000000D+04 .40020000000000D+04 .40030000000000D+04 .40040000000000D+04
- .40050000000000D+04 .40060000000000D+04
- 99 3000.000 2011 2021 2031 2012 2022 2032 2013 2023 2033 2014
- 2024 2034
- 100 3001.000 2011 2021 2031 2012 2022 2032 2013 2023 2033 2014
- 2024 2034 .40010000000000D+04
diff --git a/src/pawlib/paw/testsuite/paw.qp.name/fun_double.exp b/src/pawlib/paw/testsuite/paw.qp.name/fun_double.exp
deleted file mode 100644
index 4ba2845..0000000
--- a/src/pawlib/paw/testsuite/paw.qp.name/fun_double.exp
+++ /dev/null
@@ -1,238 +0,0 @@
-#
-# fun_double.exp --
-#
-# Original: 2-Apr-1996 14:16
-#
-# Author: Maarten Ballintijn <Maarten.Ballintijn at cern.ch>
-#
-#
-
-#
-# Setup for tests
-#
-paw_cmd {h/file 4 ~/cern/paw/tuple/tuple.hbook}
-
-
-# --------------------------------------------------------------
-#
-# Begin real tests
-#
-# --------------------------------------------------------------
-
-#
-# sin(x)
-#
-
-expr_test double 2 sin(0d0*i7) 0.00000000000000d+00
-expr_test double 2 sin(dpi/6*i7) 5.00000000000000d-01
-expr_test double 2 sin(dpi/4*i7) 7.07106781186547d-01
-expr_test double 2 sin(dpi/3*i7) 8.66025403784439d-01
-expr_test double 2 sin(dpi/2*i7) 1.00000000000000d+00
-expr_test double 2 sin(-dpi/2*i7) -1.00000000000000d+00
-
-# don't bother to test arguments larger then dpi/2 because errors are to large
-# on most systems
-
-
-#
-# cos(x)
-#
-
-expr_test double 2 cos(0d0*i7) 1.00000000000000d+00
-expr_test double 2 cos(dpi/6*i7) 8.66025403784439d-01
-expr_test double 2 cos(dpi/4*i7) 7.07106781186548d-01
-expr_test double 2 cos(dpi/3*i7) 5.00000000000000d-01
-
-# don't bother to test arguments larger then dpi/2 because errors are to large
-# on most systems
-#expr_test double 2 cos(dpi/2*i7) 0.00000000000000d+00
-#expr_test double 2 cos(-dpi/2*i7) 0.00000000000000d+00
-
-
-#
-# tan(x)
-#
-
-expr_test double 2 tan(0d0*i7) 0.00000000000000d+00
-expr_test double 2 tan(dpi/4*i7) 1.00000000000000d+00
-expr_test double 2 tan(-dpi/4*i7) -1.00000000000000d+00
-
-
-#
-# sqrt(x)
-#
-
-expr_test double 2 sqrt(0d0*i7) 0.00000000000000d+00
-expr_test double 2 sqrt(1d0*i7) 1.00000000000000d+00
-expr_test double 2 sqrt(4d0*i7) 2.00000000000000d+00
-
-expr_test double 2 sqrt(-1d0*i7) {Sqrt of negative number}
-
-#
-# exp(x)
-#
-
-expr_test double 2 exp(0d0*i7) 1.00000000000000d+00
-expr_test double 2 exp(1d0*i7) 2.71828182845905d+00
-expr_test double 2 exp(-1d0*i7) 3.67879441171442d-01
-
-
-#
-# log(x)
-#
-
-expr_test double 2 log(1d0*i7) 0.00000000000000d+00
-expr_test double 2 log(2.71828182845905d0*i7) 1.00000000000000d+00
-expr_test double 2 log(3.67879441171442d-01*i7) -1.00000000000000d+00
-
-expr_test double 2 log(0d0*i7) {Log of zero or negative number}
-expr_test double 2 log(-8d0*i7) {Log of zero or negative number}
-
-
-#
-# abs(x)
-#
-
-expr_test double 1 abs(dval) 1.79769313486232d+308
-expr_test double 2 abs(dval) 1.23450000000000d+04
-expr_test double 3 abs(dval) 2.22507385850720d-308
-expr_test double 4 abs(dval) 0.00000000000000d+00
-expr_test double 5 abs(dval) 2.22507385850720d-308
-expr_test double 6 abs(dval) 1.23450000000000d+04
-expr_test double 7 abs(dval) 1.79769313486232d+308
-
-
-#
-# log10(x)
-#
-
-expr_test double 2 log10(1d0*i7) 0.00000000000000d+00
-expr_test double 2 log10(1d1*i7) 1.00000000000000d+00
-expr_test double 2 log10(1d-1*i7) -1.00000000000000d+00
-
-expr_test double 2 log10(0d0*i7) {Log10 of zero or negative number}
-expr_test double 2 log10(-8d0*i7) {Log10 of zero or negative number}
-
-
-#
-# asin(x)
-#
-
-expr_test double 2 asin(0d0*i7) 0.00000000000000d+00
-expr_test double 2 asin(1d0*i7) 1.57079632679490d+00
-expr_test double 2 asin(-1d0*i7) -1.57079632679490d+00
-
-expr_test double 2 asin(1.0000000000001d0*i7) {Asin domain error}
-expr_test double 2 asin(-1.0000000000001d0*i7) {Asin domain error}
-
-
-#
-# acos(x)
-#
-
-expr_test double 2 acos(0d0*i7) 1.57079632679490d+00
-expr_test double 2 acos(1d0*i7) 0.00000000000000d+00
-expr_test double 2 acos(-1d0*i7) 3.14159265358979d+00
-
-expr_test double 2 acos(1.0000000000001d0*i7) {Acos domain error}
-expr_test double 2 acos(-1.0000000000001d0*i7) {Acos domain error}
-
-#
-# atan(x)
-#
-
-expr_test double 2 atan(0d0*i7) 0.00000000000000d+00
-expr_test double 2 atan(1d0*i7) 7.85398163397448d-01
-expr_test double 2 atan(-1d0*i7) -7.85398163397448d-01
-
-
-#
-# sinh(x)
-#
-
-expr_test double 2 sinh(0d0*i7) 0.00000000000000d+00
-expr_test double 2 sinh(1d0*i7) 1.17520119364380d+00
-expr_test double 2 sinh(-1d0*i7) -1.17520119364380d+00
-
-
-#
-# cosh(x)
-#
-
-expr_test double 2 cosh(0d0*i7) 1.00000000000000d+00
-expr_test double 2 cosh(1d0*i7) 1.54308063481524d+00
-expr_test double 2 cosh(-1d0*i7) 1.54308063481524d+00
-
-
-#
-# tanh(x)
-#
-
-expr_test double 2 tanh(0d0*i7) 0.00000000000000d+00
-expr_test double 2 tanh(1d0*i7) 7.61594155955765d-01
-expr_test double 2 tanh(-1d0*i7) -7.61594155955765d-01
-
-
-#
-# mod(x,y)
-#
-
-expr_test double 2 mod(0d0*i7,1d0) 0.00000000000000d+00
-expr_test double 2 mod(7d0*i7,3d0) 1.00000000000000d+00
-expr_test double 2 mod(-7d0*i7,3d0) -1.00000000000000d+00
-
-expr_test double 2 mod(7d0*i7,0d0) {Mod with divisor of zero}
-
-
-#
-# atan2(x,y)
-#
-
-expr_test double 2 atan2(0d0*i7,1d0) 0.00000000000000d+00
-expr_test double 2 atan2(1d0*i7,0d0) 1.57079632679490d+00
-expr_test double 2 atan2(0d0*i7,-1d0) 3.14159265358979d+00
-expr_test double 2 atan2(-1d0*i7,0d0) -1.57079632679490d+00
-
-
-#
-# sign(x,y)
-#
-
-expr_test double 2 sign(0d0*i7,1d0) 0.00000000000000d+00
-expr_test double 2 sign(0d0*i7,-1d0) 0.00000000000000d+00
-expr_test double 2 sign(5d0*i7,1d0) 5.00000000000000d+00
-expr_test double 2 sign(5d0*i7,-1d0) -5.00000000000000d+00
-expr_test double 2 sign(-5d0*i7,1d0) 5.00000000000000d+00
-expr_test double 2 sign(-5d0*i7,-1d0) -5.00000000000000d+00
-
-
-#
-# dint(x)
-#
-
-expr_test double 1 fint(dval) -1.79769313486232d+308
-expr_test double 2 fint(dval) -1.23450000000000d+04
-expr_test double 3 fint(dval) 0.00000000000000d+00
-expr_test double 4 fint(dval) 0.00000000000000d+00
-expr_test double 5 fint(dval) 0.00000000000000d+00
-expr_test double 6 fint(dval) 1.23450000000000d+04
-expr_test double 7 fint(dval) 1.79769313486232d+308
-
-
-#
-# frac(x)
-#
-
-expr_test double 1 frac(dval) 0.00000000000000d+00
-expr_test double 2 frac(dval) 0.00000000000000d+00
-expr_test double 3 frac(dval) -2.22507385850720d-308
-expr_test double 4 frac(dval) 0.00000000000000d+00
-expr_test double 5 frac(dval) 2.22507385850720d-308
-expr_test double 6 frac(dval) 0.00000000000000d+00
-expr_test double 7 frac(dval) 0.00000000000000d+00
-
-
-#
-# Cleanup after tests
-#
-paw_cmd { close 4 }
diff --git a/src/pawlib/paw/testsuite/paw.qp.name/fun_single.exp b/src/pawlib/paw/testsuite/paw.qp.name/fun_single.exp
deleted file mode 100644
index 7b40d81..0000000
--- a/src/pawlib/paw/testsuite/paw.qp.name/fun_single.exp
+++ /dev/null
@@ -1,238 +0,0 @@
-#
-# fun_single.exp --
-#
-# Original: 1-Apr-1996 11:16
-#
-# Author: Maarten Ballintijn <Maarten.Ballintijn at cern.ch>
-#
-#
-
-#
-# Setup for tests
-#
-paw_cmd {h/file 4 ~/cern/paw/tuple/tuple.hbook}
-
-
-# --------------------------------------------------------------
-#
-# Begin real tests
-#
-# --------------------------------------------------------------
-
-#
-# sin(x)
-#
-
-expr_test float 2 sin(0.*i7) 0.000000e+00
-expr_test float 2 sin(pi/6*i7) 5.000000e-01
-expr_test float 2 sin(pi/4*i7) 7.071068e-01
-expr_test float 2 sin(pi/3*i7) 8.660254e-01
-expr_test float 2 sin(pi/2*i7) 1.000000e+00
-expr_test float 2 sin(-pi/2*i7) -1.000000e+00
-
-# don't bother to test arguments larger then pi/2 because errors are to large
-# on most systems
-
-
-#
-# cos(x)
-#
-
-expr_test float 2 cos(0.*i7) 1.000000e+00
-expr_test float 2 cos(pi/6*i7) 8.660254e-01
-expr_test float 2 cos(pi/4*i7) 7.071068e-01
-expr_test float 2 cos(pi/3*i7) 5.000000e-01
-
-# don't bother to test arguments larger then pi/2 because errors are to large
-# on most systems
-#expr_test float 2 cos(pi/2*i7) 0.000000e+00
-#expr_test float 2 cos(-pi/2*i7) 0.000000e+00
-
-
-#
-# tan(x)
-#
-
-expr_test float 2 tan(0.*i7) 0.000000e+00
-expr_test float 2 tan(pi/4*i7) 1.000000e+00
-expr_test float 2 tan(-pi/4*i7) -1.000000e+00
-
-
-#
-# sqrt(x)
-#
-
-expr_test float 2 sqrt(0.*i7) 0.000000e+00
-expr_test float 2 sqrt(1.*i7) 1.000000e+00
-expr_test float 2 sqrt(4.*i7) 2.000000e+00
-
-expr_test float 2 sqrt(-1.*i7) {Sqrt of negative number}
-
-#
-# exp(x)
-#
-
-expr_test float 2 exp(0.*i7) 1.000000e+00
-expr_test float 2 exp(1.*i7) 2.718282e+00
-expr_test float 2 exp(-1.*i7) 3.678795e-01
-
-
-#
-# log(x)
-#
-
-expr_test float 2 log(1.*i7) 0.000000e+00
-expr_test float 2 log(2.718282*i7) 1.000000e+00
-expr_test float 2 log(0.3678795*i7) -9.999998e-01
-
-expr_test float 2 log(0.*i7) {Log of zero or negative number}
-expr_test float 2 log(-8.*i7) {Log of zero or negative number}
-
-
-#
-# abs(x)
-#
-
-expr_test float 1 abs(fval) 3.402823e+38
-expr_test float 2 abs(fval) 1.234500e+04
-expr_test float 3 abs(fval) 1.175494e-38
-expr_test float 4 abs(fval) 0.000000e+00
-expr_test float 5 abs(fval) 1.175494e-38
-expr_test float 6 abs(fval) 1.234500e+04
-expr_test float 7 abs(fval) 3.402823e+38
-
-
-#
-# log10(x)
-#
-
-expr_test float 2 log10(1.*i7) 0.000000e+00
-expr_test float 2 log10(10.*i7) 1.000000e+00
-expr_test float 2 log10(0.1*i7) -1.000000e+00
-
-expr_test float 2 log10(0.*i7) {Log10 of zero or negative number}
-expr_test float 2 log10(-8.*i7) {Log10 of zero or negative number}
-
-
-#
-# asin(x)
-#
-
-expr_test float 2 asin(0.*i7) 0.000000e+00
-expr_test float 2 asin(1.0*i7) 1.570796e+00
-expr_test float 2 asin(-1.0*i7) -1.570796e+00
-
-expr_test float 2 asin(1.00001*i7) {Asin domain error}
-expr_test float 2 asin(-1.00001*i7) {Asin domain error}
-
-
-#
-# acos(x)
-#
-
-expr_test float 2 acos(0.*i7) 1.570796e+00
-expr_test float 2 acos(1.0*i7) 0.000000e+00
-expr_test float 2 acos(-1.0*i7) 3.141593e+00
-
-expr_test float 2 acos(1.00001*i7) {Acos domain error}
-expr_test float 2 acos(-1.00001*i7) {Acos domain error}
-
-#
-# atan(x)
-#
-
-expr_test float 2 atan(0.*i7) 0.000000e+00
-expr_test float 2 atan(1.0*i7) 7.853982e-01
-expr_test float 2 atan(-1.0*i7) -7.853982e-01
-
-
-#
-# sinh(x)
-#
-
-expr_test float 2 sinh(0.*i7) 0.000000e+00
-expr_test float 2 sinh(1.0*i7) 1.175201e+00
-expr_test float 2 sinh(-1.0*i7) -1.175201e+00
-
-
-#
-# cosh(x)
-#
-
-expr_test float 2 cosh(0.*i7) 1.000000e+00
-expr_test float 2 cosh(1.0*i7) 1.543081e+00
-expr_test float 2 cosh(-1.0*i7) 1.543081e+00
-
-
-#
-# tanh(x)
-#
-
-expr_test float 2 tanh(0.*i7) 0.000000e+00
-expr_test float 2 tanh(1.0*i7) 7.615942e-01
-expr_test float 2 tanh(-1.0*i7) -7.615942e-01
-
-
-#
-# mod(x,y)
-#
-
-expr_test float 2 mod(0.*i7,1.) 0.000000e+00
-expr_test float 2 mod(7.*i7,3.) 1.000000e+00
-expr_test float 2 mod(-7.*i7,3.) -1.000000e+00
-
-expr_test float 2 mod(7.*i7,0.) {Mod with divisor of zero}
-
-
-#
-# atan2(x,y)
-#
-
-expr_test float 2 atan2(0.*i7,1.) 0.000000e+00
-expr_test float 2 atan2(1.*i7,0.) 1.570796e+00
-expr_test float 2 atan2(0.*i7,-1.) 3.141593e+00
-expr_test float 2 atan2(-1.*i7,0.) -1.570796e+00
-
-
-#
-# sign(x,y)
-#
-
-expr_test float 2 sign(0.*i7,1.) 0.000000e+00
-expr_test float 2 sign(0.*i7,-1.) 0.000000e+00
-expr_test float 2 sign(5.*i7,1.) 5.000000e+00
-expr_test float 2 sign(5.*i7,-1.) -5.000000e+00
-expr_test float 2 sign(-5.*i7,1.) 5.000000e+00
-expr_test float 2 sign(-5.*i7,-1.) -5.000000e+00
-
-
-#
-# fint(x)
-#
-
-expr_test float 1 fint(fval) -3.402823e+38
-expr_test float 2 fint(fval) -1.234500e+04
-expr_test float 3 fint(fval) 0.000000e+00
-expr_test float 4 fint(fval) 0.000000e+00
-expr_test float 5 fint(fval) 0.000000e+00
-expr_test float 6 fint(fval) 1.234500e+04
-expr_test float 7 fint(fval) 3.402823e+38
-
-
-#
-# frac(x)
-#
-
-expr_test float 1 frac(fval) 0.000000e+00
-expr_test float 2 frac(fval) 0.000000e+00
-expr_test float 3 frac(fval) -1.175494e-38
-expr_test float 4 frac(fval) 0.000000e+00
-expr_test float 5 frac(fval) 1.175494e-38
-expr_test float 6 frac(fval) 0.000000e+00
-expr_test float 7 frac(fval) 0.000000e+00
-
-
-#
-# Cleanup after tests
-#
-paw_cmd { close 4 }
diff --git a/src/scripts/Imakefile b/src/scripts/Imakefile
deleted file mode 100644
index 93f95df..0000000
--- a/src/scripts/Imakefile
+++ /dev/null
@@ -1,10 +0,0 @@
-
-InstallProgram(paw,$(CERN_BINDIR))
-
-#if defined(CERNLIB_SHIFT)
-InstallNamedProg(cernlib_shift,cernlib,$(CERN_BINDIR))
-#else
-InstallProgram(cernlib,$(CERN_BINDIR))
-#endif
-
-InstallProgram(gxint,$(CERN_BINDIR))
diff --git a/src/scripts/cernlib b/src/scripts/cernlib
deleted file mode 100755
index 738c8d1..0000000
--- a/src/scripts/cernlib
+++ /dev/null
@@ -1,221 +0,0 @@
-#!/bin/sh
-# **********************************************************************
-# * @(#) cernlib
-# * @(#) $Header: /afs/cern.ch/asis/share/cern/CVS/scripts/cernlib,v 1.45 2006/12/07 13:26:55 mclareni Exp $
-# * *
-# * Attachment of CERN Libraries for link step *
-# * *
-# * Author: M.Marquina 91/05/10 *
-# * Change history is in CVS log files and in source 1.27 ( and older)
-# **********************************************************************
-
- SHOPT="G:Psuv:"
-#SEQ,GETOPTD.
-
- [ -z "$CERN" ] && CERN="/cern"
- [ -z "$CERN_LEVEL" ] && gver="pro" || gver="$CERN_LEVEL"
-
- _P=0 ; _p=0 ; _u=0 ; Gsys=""
- while [ $# -gt 0 ]
- do case $1 in
- -G) Gsys=$2 ; shift ;;
- -P) _P=1 ;;
- -s) _s="is an obsolete option" ;;
- -u) _u=1 ; _p=1 ;;
- -v) gver=$2 ; shift ;;
- --) shift ; break ;;
- *) break ;;
- esac
- shift
- done
-
-
-
- CERNLIB=""
-
- liblist=`echo $* | sed -e 's/,/ /g'`
- for lib in $liblist
- do
- case $lib in
- shift) continue ;;
- -*) CERNLIB="$CERNLIB $lib" ; continue ;;
- esac
- lver=$gver
- val=`echo $lib | sed -e "s?\/? ?g"`
- set - $val
- [ $# -eq 2 -a $1 != "graflib" ] && lver=$2
- dir=$CERN/$lver/lib
- ln=$1
- if [ $1 = "kernlib" -o $1 = "packlib" ] ; then
- _p=1
- fi
- [ $1 = "genlib" ] && ln="mathlib.a $dir/libphtools"
- [ $1 = "bvsl" ] && ln="mathlib"
- [ $1 = "mpalib" ] && ln="mathlib"
- [ $1 = "lapack" ] && ln="lapack3.a $dir/libblas"
- [ $1 = "pawlib" ] && ln="pawlib.a $dir/liblapack3.a $dir/libblas"
- [ $1 = "pythia" ] && ln="jetset"
- if [ $1 = "GKS" -o $1 = "gks" ] ; then
- drv="X11" ; glib="$1" ; dir="$CERN/gks/$lver/lib"
- fi
- [ $1 = "naglib" ] && dir="$CERN/nag/$lver/lib"
- if [ $1 = "graflib" ] ; then
- [ -z "$Gsys" ] && Gsys="X11"
- drv="$Gsys"
- if [ $# -gt 1 ] ; then
- drv="$2" ; Gsys="$2"
- fi
- [ $# -eq 3 ] && dir="$CERN/$3/lib"
- [ $drv = "Motif" ] && drv="X11"
- ln="$ln.a $dir/libgraf$drv"
- fi
- CERNLIB="$CERNLIB $dir/lib$ln.a"
- done
- [ $_p -eq 0 ] && CERNLIB="$CERNLIB $CERN/$gver/lib/libpacklib.a"
-
-# get system name
- [ -d /NextAdmin ] && Msys="NeXT" || Msys=`uname -s`
- case $Msys in
- SunOS) [ `uname -r | awk '{ print substr($1,1,1) }'` -ge 5 ] \
- && Msys="SunSol"
- ;;
- *) ;;
- esac
-
-
- if [ -n "$Gsys" ] ; then
- case $Msys in
- AIX) SYSGGL="-lfgl -lgl" ;
- [ -f /usr/lib/libgP.a ] && \
- SYSGGKS="-lgksco -lgP -lX11" ;
- SYSGMOTIF="-lXm -lXt -lX11 -lPW" ;;
- ALLIANT) SYSGX11="-lX11 -lcurses -lm" ;;
- HP-UX) if [ -d /usr/lib/X11R5 -a -d /usr/lib/Motif1.2 ] ; then
- X11="/usr/lib/X11R5"
- Motif="/usr/lib/Motif1.2"
- SYSGMOTIF="-L$Motif -lXm -L$X11 -lXt -lX11 -lm -lc -lPW"
- else
- X11="/usr/lib/X11R4"
- Motif="/usr/lib/Motif1.1"
-# Xm must appear late, else you get unresolved extrernals
- SYSGMOTIF="-L$Motif -L$X11 -lXm -lXt -lX11 -lm -lc -lPW"
- fi
- SYSGX11="-L$X11 -lX11 -lm";;
- IBMAIX) SYSGX11="-lX11 -lm" ;;
- IRIX) SYSGX11="-lX11 -lbsd" ;
- SYSGGL="-lfgl -lgl_s -lm -lbsd" ;
- SYSGMOTIF="-lXm -lXt -lX11 -lPW"
- ;;
- IRIX64) SYSGX11="-lX11 -lbsd" ;
- SYSGGL="-lfgl -lgl_s -lm -lbsd" ;
- SYSGMOTIF="-lXm -lXt -lX11 -lPW"
- ;;
- Linux) [ -d /usr/X386/lib ] && SYSGX11="-L/usr/X386/lib -lX11"
- [ -d /usr/X11/lib ] && SYSGX11="-L/usr/X11/lib -lX11"
- [ -d /usr/X11R6/lib ] && SYSGX11="-L/usr/X11R6/lib -lX11"
- [ -d /usr/X11R6/lib ] && SYSGMOTIF="-L/usr/X11R6/lib -lXm -lXt -lXp -lXext -lX11"
- [ `uname -m` = ppc ] && SYSGMOTIF="$SYSGMOTIF -lSM -lICE -lXpm"
- ;;
- Darwin) [ -d /usr/X11R6/lib ] && SYSGX11="-L/usr/X11R6/lib -lX11"
- [ -d /usr/X11R6/lib ] && SYSGMOTIF="-L/usr/X11R6/lib -L`which fink | sed -e's?bin/fink?lib?'` -lXm -lXt -lXp -lXext -lX11 -lSM -lICE -lXpm"
- ;;
- NeXT) SYSGX11="/usr/lib/X11/libX11.r" ;
- SYSGMOTIF="-lXm -lXt /usr/lib/X11/libX11.r" ;;
- OSF1) SYSGX11="-lX11 -ldnet_stub" ;
- SYSGMOTIF="-lXm -lXt -lX11 -ldnet_stub -lPW -lXmu" ;;
- SunOS) [ -d /usr/motif/lib ] && Motif="-L/usr/motif/lib" || Motif=" "
- if [ -d /usr/motif12/usr/lib ] ; then
- Motif="-L/usr/motif12/usr/lib"
-# motif12 needs X11R5 from usr/local/lib
- X11="-L/usr/local/lib"
- else
- X11=""
- fi
- SYSGMOTIF="$Motif -lXm $X11 -lXt -lX11"
- [ -f /usr/lib/libgks77.a ] && \
- SYSGGKS="-lgks77 -lgks -lsuntool -lsunwindow -lpixrect -lm" ;;
- SunSol) [ -d /usr/motif/lib ] && Motif="-L/usr/motif/lib" || Motif=" "
- [ -d /usr/motif12/usr/lib ] && Motif="-L/usr/motif12/usr/lib"
- [ -d /usr/dt/lib ] && \
- Motif="-L/usr/dt/lib -R/usr/dt/lib -Bdynamic"
- [ -d /usr/openwin/lib ] && X11="-L/usr/openwin/lib" || X11=""
- SYSGX11="$X11 -Bdynamic -lX11"
- SYSGMOTIF="$Motif -lXm $X11 -Bdynamic -lXt -lX11"
- [ -f /usr/lib/libgks77.a ] && \
- SYSGGKS="-lgks77 -lgks -lsuntool -lsunwindow -lpixrect -lm"
- ;;
- ULTRIX) [ -f /usr/lib/libGKS3D.a ] && \
- SYSGGKS="-lGKS3Dforbnd -lGKS3D -lddif -ldwt -lc -lX11 -lcursesX -lm" ;;
- DomainOS) SYSGX11="" ;
- SYSGMOTIF="-L/usr/lib/X11 -lXm -lXt -lX11 -lm" ;;
- esac
-
- [ -z "$SYSGX11" ] && SYSGX11="-lX11"
- case $Gsys in
- X11) CERNLIB="$CERNLIB $SYSGX11" ;;
- Motif) [ -z "$SYSGMOTIF" ] && SYSGMOTIF="-lXm -lXt $SYSGX11" ;
- CERNLIB="$CERNLIB $SYSGMOTIF" ;;
- GPHIGS) [ -z "$SYSGPHIGS" ] && \
- SYSGPHIGS="-L$CERN/phigs/$gver/lib -lgphigsf2c -lgphigsc" ;
- CERNLIB="$CERNLIB $SYSGPHIGS" ;;
- GKS) [ -z "$SYSGGKS" ] && \
- SYSGGKS="-L$CERN/gks/$gver/lib -lGKS -lGKSdriv $SYSGX11" ;
- CERNLIB="$CERNLIB $SYSGGKS" ;;
- GL) CERNLIB="$CERNLIB $SYSGGL" ;;
- GPR) CERNLIB="$CERNLIB $SYSGGPR" ;;
- --) break ;;
- *) break ;;
- esac
- fi
-
- if [ $_u -eq 0 ] ; then
-# SGI needs -lsun, to see yellow pages
-# As of 5.x, the yp version is in libc, so -lsun is no longer needed.
-# GF. 18-7-96
-# [ -f /usr/lib/libsun.a -o -f /usr/lib/libsun.so ] \
-# && CERNLIB="$CERNLIB -lsun"
- [ -f /usr/lib/libulsock.a -o -f /usr/lib/libulsock.so ] \
- && CERNLIB="$CERNLIB -lulsock"
-# Solaris, many things won't link without -lsocket -lnsl
- if [ "$Msys" = "SunSol" ] ; then
- [ -f /usr/lib/libw.so -o -f /usr/lib/libw.a ] \
- && CERNLIB="$CERNLIB -lw"
- [ -f /usr/ccs/lib/libgen.so -o -f /usr/ccs/lib/libgen.a ] \
- && CERNLIB="$CERNLIB -lgen"
- [ -f /usr/lib/libsocket.so -o -f /usr/lib/libsocket.a ] \
- && CERNLIB="$CERNLIB -lsocket"
- [ -f /usr/lib/libnsl.so -o -f /usr/lib/libnsl.a ] \
- && CERNLIB="$CERNLIB -lnsl"
- [ -f /usr/lib/libintl.so -o -f /usr/lib/libintl.a ] \
- && CERNLIB="$CERNLIB -lintl"
- echo $CERNLIB | grep pawlib >/dev/null && \
- CERNLIB="$CERNLIB -ldl"
-
- fi
- if [ "$Msys" = "HP-UX" ] ; then
- if [ -f /usr/lib/libU77.a -o -f /usr/lib/libU77.sl ] ; then
- CERNLIB="$CERNLIB -lU77"
- elif [ -f /opt/fortran/lib/libU77.a ] ; then
- CERNLIB="$CERNLIB /opt/fortran/lib/libU77.a"
- elif [ -f /opt/fortran/lib/libU77.sl ] ; then
- CERNLIB="$CERNLIB /opt/fortran/lib/libU77.sl"
- fi
-
- echo $CERNLIB | grep pawlib >/dev/null && \
- CERNLIB="$CERNLIB /usr/lib/libdld.sl"
- echo $CERNLIB | grep packlib >/dev/null && \
- [ -f /lib/pa1.1/libm.a ] && CERNLIB="$CERNLIB /lib/pa1.1/libm.a"
- fi
- if [ "$Msys" = "AIX" ] ; then
- echo $CERNLIB | grep pawlib >/dev/null && CERNLIB="$CERNLIB -lld"
- fi
- if [ "$Msys" = "Linux" ] ; then
- CERNLIB="$CERNLIB -lnsl -lcrypt -ldl"
- fi
- if [ "$Msys" = "Darwin" ] ; then
- CERNLIB1="$CERNLIB -L/usr/local/lib/system -lcompat -ldl"
- fi
- fi
-
-
- echo $CERNLIB ; export CERNLIB
diff --git a/src/scripts/cernlib_shift b/src/scripts/cernlib_shift
deleted file mode 100755
index 6cdbabd..0000000
--- a/src/scripts/cernlib_shift
+++ /dev/null
@@ -1,220 +0,0 @@
-#!/bin/sh
-# **********************************************************************
-# * @(#) cernlib
-# * @(#) $Header: /afs/cern.ch/asis/share/cern/CVS/scripts/cernlib_shift,v 1.1 2004/07/29 14:11:01 mclareni Exp $
-# * *
-# * Attachment of CERN Libraries for link step *
-# * *
-# * Author: M.Marquina 91/05/10 *
-# * Change history is in CVS log files and in source 1.27 ( and older)
-# **********************************************************************
-
- SHOPT="G:Psuv:"
-#SEQ,GETOPTD.
-
- [ -z "$CERN" ] && CERN="/cern"
- [ -z "$CERN_LEVEL" ] && gver="pro" || gver="$CERN_LEVEL"
-
- _P=0 ; _p=0 ; _u=0 ; Gsys=""
- while [ $# -gt 0 ]
- do case $1 in
- -G) Gsys=$2 ; shift ;;
- -P) _P=1 ;;
- -s) _s="is an obsolete option" ;;
- -u) _u=1 ; _p=1 ;;
- -v) gver=$2 ; shift ;;
- --) shift ; break ;;
- *) break ;;
- esac
- shift
- done
-
-
-
- CERNLIB=""
-
- liblist=`echo $* | sed -e 's/,/ /g'`
- for lib in $liblist
- do
- case $lib in
- shift) continue ;;
- -*) CERNLIB="$CERNLIB $lib" ; continue ;;
- esac
- lver=$gver
- val=`echo $lib | sed -e "s?\/? ?g"`
- set - $val
- [ $# -eq 2 -a $1 != "graflib" ] && lver=$2
- dir=$CERN/$lver/lib
- ln=$1
- if [ $1 = "kernlib" -o $1 = "packlib" ] ; then
- _p=1
- fi
- [ $1 = "genlib" ] && ln="mathlib.a $dir/libphtools"
- [ $1 = "bvsl" ] && ln="mathlib"
- [ $1 = "mpalib" ] && ln="mathlib"
- [ $1 = "lapack" ] && ln="lapack3.a $dir/libblas"
- [ $1 = "pawlib" ] && ln="pawlib.a $dir/liblapack3.a $dir/libblas"
- [ $1 = "pythia" ] && ln="jetset"
- if [ $1 = "GKS" -o $1 = "gks" ] ; then
- drv="X11" ; glib="$1" ; dir="$CERN/gks/$lver/lib"
- fi
- [ $1 = "naglib" ] && dir="$CERN/nag/$lver/lib"
- if [ $1 = "graflib" ] ; then
- [ -z "$Gsys" ] && Gsys="X11"
- drv="$Gsys"
- if [ $# -gt 1 ] ; then
- drv="$2" ; Gsys="$2"
- fi
- [ $# -eq 3 ] && dir="$CERN/$3/lib"
- [ $drv = "Motif" ] && drv="X11"
- ln="$ln.a $dir/libgraf$drv"
- fi
- CERNLIB="$CERNLIB $dir/lib$ln.a"
- done
- [ $_p -eq 0 ] && CERNLIB="$CERNLIB $CERN/$gver/lib/libpacklib.a"
-
-# get system name
- [ -d /NextAdmin ] && Msys="NeXT" || Msys=`uname -s`
- case $Msys in
- SunOS) [ `uname -r | awk '{ print substr($1,1,1) }'` -ge 5 ] \
- && Msys="SunSol"
- ;;
- *) ;;
- esac
-
-
- if [ -n "$Gsys" ] ; then
- case $Msys in
- AIX) SYSGGL="-lfgl -lgl" ;
- [ -f /usr/lib/libgP.a ] && \
- SYSGGKS="-lgksco -lgP -lX11" ;
- SYSGMOTIF="-lXm -lXt -lX11 -lPW" ;;
- ALLIANT) SYSGX11="-lX11 -lcurses -lm" ;;
- HP-UX) if [ -d /usr/lib/X11R5 -a -d /usr/lib/Motif1.2 ] ; then
- X11="/usr/lib/X11R5"
- Motif="/usr/lib/Motif1.2"
- SYSGMOTIF="-L$Motif -lXm -L$X11 -lXt -lX11 -lm -lc -lPW"
- else
- X11="/usr/lib/X11R4"
- Motif="/usr/lib/Motif1.1"
-# Xm must appear late, else you get unresolved extrernals
- SYSGMOTIF="-L$Motif -L$X11 -lXm -lXt -lX11 -lm -lc -lPW"
- fi
- SYSGX11="-L$X11 -lX11 -lm";;
- IBMAIX) SYSGX11="-lX11 -lm" ;;
- IRIX) SYSGX11="-lX11 -lbsd" ;
- SYSGGL="-lfgl -lgl_s -lm -lbsd" ;
- SYSGMOTIF="-lXm -lXt -lX11 -lPW"
- ;;
- IRIX64) SYSGX11="-lX11 -lbsd" ;
- SYSGGL="-lfgl -lgl_s -lm -lbsd" ;
- SYSGMOTIF="-lXm -lXt -lX11 -lPW"
- ;;
- Linux) [ -d /usr/X386/lib ] && SYSGX11="-L/usr/X386/lib -lX11"
- [ -d /usr/X11/lib ] && SYSGX11="-L/usr/X11/lib -lX11"
- [ -d /usr/X11R6/lib ] && SYSGX11="-L/usr/X11R6/lib -lX11"
- [ -d /usr/X11R6/lib ] && SYSGMOTIF="-L/usr/X11R6/lib -lXm -lXt -lXp -lXext -lX11"
- [ `uname -m` = ppc ] && SYSGMOTIF="$SYSGMOTIF -lSM -lICE -lXpm"
- ;;
- NeXT) SYSGX11="/usr/lib/X11/libX11.r" ;
- SYSGMOTIF="-lXm -lXt /usr/lib/X11/libX11.r" ;;
- OSF1) SYSGX11="-lX11 -ldnet_stub" ;
- SYSGMOTIF="-lXm -lXt -lX11 -ldnet_stub -lPW -lXmu" ;;
- SunOS) [ -d /usr/motif/lib ] && Motif="-L/usr/motif/lib" || Motif=" "
- if [ -d /usr/motif12/usr/lib ] ; then
- Motif="-L/usr/motif12/usr/lib"
-# motif12 needs X11R5 from usr/local/lib
- X11="-L/usr/local/lib"
- else
- X11=""
- fi
- SYSGMOTIF="$Motif -lXm $X11 -lXt -lX11"
- [ -f /usr/lib/libgks77.a ] && \
- SYSGGKS="-lgks77 -lgks -lsuntool -lsunwindow -lpixrect -lm" ;;
- SunSol) [ -d /usr/motif/lib ] && Motif="-L/usr/motif/lib" || Motif=" "
- [ -d /usr/motif12/usr/lib ] && Motif="-L/usr/motif12/usr/lib"
- [ -d /usr/dt/lib ] && \
- Motif="-L/usr/dt/lib -R/usr/dt/lib -Bdynamic"
- [ -d /usr/openwin/lib ] && X11="-L/usr/openwin/lib" || X11=""
- SYSGX11="$X11 -Bdynamic -lX11"
- SYSGMOTIF="$Motif -lXm $X11 -Bdynamic -lXt -lX11"
- [ -f /usr/lib/libgks77.a ] && \
- SYSGGKS="-lgks77 -lgks -lsuntool -lsunwindow -lpixrect -lm"
- ;;
- ULTRIX) [ -f /usr/lib/libGKS3D.a ] && \
- SYSGGKS="-lGKS3Dforbnd -lGKS3D -lddif -ldwt -lc -lX11 -lcursesX -lm" ;;
- DomainOS) SYSGX11="" ;
- SYSGMOTIF="-L/usr/lib/X11 -lXm -lXt -lX11 -lm" ;;
- esac
-
- [ -z "$SYSGX11" ] && SYSGX11="-lX11"
- case $Gsys in
- X11) CERNLIB="$CERNLIB $SYSGX11" ;;
- Motif) [ -z "$SYSGMOTIF" ] && SYSGMOTIF="-lXm -lXt $SYSGX11" ;
- CERNLIB="$CERNLIB $SYSGMOTIF" ;;
- GPHIGS) [ -z "$SYSGPHIGS" ] && \
- SYSGPHIGS="-L$CERN/phigs/$gver/lib -lgphigsf2c -lgphigsc" ;
- CERNLIB="$CERNLIB $SYSGPHIGS" ;;
- GKS) [ -z "$SYSGGKS" ] && \
- SYSGGKS="-L$CERN/gks/$gver/lib -lGKS -lGKSdriv $SYSGX11" ;
- CERNLIB="$CERNLIB $SYSGGKS" ;;
- GL) CERNLIB="$CERNLIB $SYSGGL" ;;
- GPR) CERNLIB="$CERNLIB $SYSGGPR" ;;
- --) break ;;
- *) break ;;
- esac
- fi
-
- if [ $_u -eq 0 ] ; then
-
- CERNLIB="$CERNLIB -L/usr/local/lib -lshift"
-
-# SGI needs -lsun, to see yellow pages
-# As of 5.x, the yp version is in libc, so -lsun is no longer needed.
-# GF. 18-7-96
-# [ -f /usr/lib/libsun.a -o -f /usr/lib/libsun.so ] \
-# && CERNLIB="$CERNLIB -lsun"
- [ -f /usr/lib/libulsock.a -o -f /usr/lib/libulsock.so ] \
- && CERNLIB="$CERNLIB -lulsock"
-# Solaris, many things won't link without -lsocket -lnsl
- if [ "$Msys" = "SunSol" ] ; then
- [ -f /usr/lib/libw.so -o -f /usr/lib/libw.a ] \
- && CERNLIB="$CERNLIB -lw"
- [ -f /usr/ccs/lib/libgen.so -o -f /usr/ccs/lib/libgen.a ] \
- && CERNLIB="$CERNLIB -lgen"
- [ -f /usr/lib/libsocket.so -o -f /usr/lib/libsocket.a ] \
- && CERNLIB="$CERNLIB -lsocket"
- [ -f /usr/lib/libnsl.so -o -f /usr/lib/libnsl.a ] \
- && CERNLIB="$CERNLIB -lnsl"
- [ -f /usr/lib/libintl.so -o -f /usr/lib/libintl.a ] \
- && CERNLIB="$CERNLIB -lintl"
- [ -f /lib/librt.so ] \
- && CERNLIB="$CERNLIB -lrt"
- echo $CERNLIB | grep pawlib >/dev/null && \
- CERNLIB="$CERNLIB -ldl"
-
- fi
- if [ "$Msys" = "HP-UX" ] ; then
- if [ -f /usr/lib/libU77.a -o -f /usr/lib/libU77.sl ] ; then
- CERNLIB="$CERNLIB -lU77"
- elif [ -f /opt/fortran/lib/libU77.a ] ; then
- CERNLIB="$CERNLIB /opt/fortran/lib/libU77.a"
- elif [ -f /opt/fortran/lib/libU77.sl ] ; then
- CERNLIB="$CERNLIB /opt/fortran/lib/libU77.sl"
- fi
-
- echo $CERNLIB | grep pawlib >/dev/null && \
- CERNLIB="$CERNLIB /usr/lib/libdld.sl"
- echo $CERNLIB | grep packlib >/dev/null && \
- [ -f /lib/pa1.1/libm.a ] && CERNLIB="$CERNLIB /lib/pa1.1/libm.a"
- fi
- if [ "$Msys" = "AIX" ] ; then
- echo $CERNLIB | grep pawlib >/dev/null && CERNLIB="$CERNLIB -lld"
- fi
- if [ "$Msys" = "Linux" ] ; then
- CERNLIB="$CERNLIB -lnsl -lcrypt -ldl"
- fi
- fi
-
-
- echo $CERNLIB ; export CERNLIB
diff --git a/src/scripts/cernlib_stat_shift b/src/scripts/cernlib_stat_shift
deleted file mode 120000
index da691e8..0000000
--- a/src/scripts/cernlib_stat_shift
+++ /dev/null
@@ -1 +0,0 @@
-/afs/.cern.ch/asis/share/cern/dev/2005/src/scripts/cernlib_stat_shift
\ No newline at end of file
diff --git a/src/scripts/gxint b/src/scripts/gxint
deleted file mode 100755
index 4fa6d6d..0000000
--- a/src/scripts/gxint
+++ /dev/null
@@ -1,166 +0,0 @@
-#!/bin/sh
-#
-#*******************************************
-#
-#@(#) GXINT link (and run) interactive GEANT.
-#@(#) $Header: /afs/cern.ch/asis/share/cern/CVS/scripts/gxint,v 1.3 2005/04/18 15:23:13 mclareni Exp $
-#
-# Author: G.Folger 92/02/25
-#
-# Modifications:
-# 8 June 93 fix @ to + for patchy
-# Jan/Feb 94 use cernlib, adapt to geant316
-# 7 Apr 94 correct for Ultrix ( no set -- in sh),
-# add ; in -o option handling
-# following mods are kept in the RCS log
-#
-#*******************************************
-line="******************************************************"
-
-
-if [ $# -eq 0 ] ; then
-cat << EoD
-
- GXINT [options] file(s)
- ld an interactive Geant application and run it. Your compiled
- routines are given in file(s).
- options:
-
- -d driver
- specify the driver for the graphics output. Possible
- values are X11, Motif, GKS, or GDDM. Not all are available
- on all systems. X11 is the default.
- -v version
- version of the program library to use. Possible values
- include pro ( default ), new and old.
- -g geant_version
- which version of geant to use. Current default is 315.
- -h host
- useful with the -d X11 option only. Specify the hostname
- used for the display. Syntax identical to that of DISPLAY.
- If no hostname is specified, the value of DISPLAY is used.
- -o outputfile
- Do not immediately run GEANT, but produce an executable
- file named outputfile.
- -L path
- additional loader search path. Usefull if additional libraries
- are specified with -l option. This option may be repeated to
- more than one pathname.
- -l libary
- specify additional libraries. This option may be repeated to
- add several libs.
- -m do NOT use main program from cernlib area.
-
-EoD
-exit
-fi
-
-if [ -f /usr/bin/uname ] ; then
- system=`/usr/bin/uname`
- if [ "$system" = "ULTRIX" -a -z "$sh5" ] ; then
- sh5="yes"
- export sh5
- /bin/sh5 $0 $*
- exit
- fi
-fi
-
- SHOPT="d:v:g:h:o:L:l:m"
- cmd=$0
-# Check option set and give default values
- if [ -f /bin/getopt -o -f /usr/bin/getopt ] ; then
- set -- `getopt $SHOPT $*` ; cc=$?
- if [ $cc -ne 0 ] ; then
- echo ""
- echo "Usage:"
- exec $cmd
- exit
- fi
- fi
-
-drv="/X11" ; ver="pro" ; OUT="${HOME}/GEANT$$"
-gxint=""
-
-while [ $# -gt 0 ]
-do case $1 in
- -d) drv="/$2"; shift ;;
- -v) ver=$2; shift ;;
- -g) gvs=$2; shift ;;
- -h) DISPLAY=$2;export DISPLAY; shift ;;
- -o) OUT=$2; norun="1"; shift ;;
- -L) userpath="$userpath -L$2"; shift ;;
- -l) userlibs="$userlibs -l$2"; shift ;;
- -m) _m="1" ;;
- --) shift ; break ;;
- *) break ;;
- esac
- shift
-done
-
-if [ $# -gt 0 ] ; then
- pgm="$*"
- else
- echo "gxint_Warning: no user program specified"
-fi
-
-
-
-if [ -z "$CERN" ] ; then
- if [ ! -d /cern ]; then
- echo "gxint_Error: shell variable CERN must be set or /cern must exist"
- exit 1
- fi
- CERN="/cern" ; export CERN
-fi
-
-if [ "$drv" = "/GKS" ] ; then
- if [ -z "$GKSR" ] ; then
- if [ ! -d $CERN/gks/$ver ] ; then
- echo "gxint_Error: shell variable GKSR must be set or "
- echo " : $CERN/gks/$ver must exist"
- exit 1
- fi
- GKSR=$CERN/gks/$ver
- fi
- GKSP=$GKSR/lib
-fi
-
- LDN="f77"
- _o="o"
-
- system="x"
- [ -x /bin/uname ] && system=`/bin/uname`
- [ -x /usr/bin/uname ] && system=`/usr/bin/uname`
- [ -x /sys5.3/bin/uname ] && system=`/sys5.3/bin/uname`
-
-case $system in
- AIX) LDN="xlf" ;;
- ConvexOS) LDN="fc" ;;
- DomainOS) LDN="ld" ;_o="bin" ;;
- HP-UX) LDN="fort77";;
-esac
-
-CLIB="geant${gvs} pawlib graflib$drv packlib mathlib"
-
-[ -z "$_m" ] && gxint="${CERN}/${ver}/lib/gxint${gvs}.$_o"
-
-cat << EoD
-$line
-* loading interactive Geant
-* creating : $OUT
-* loader used : $LDN
-* user library path : $userpath
-* user libraries : $userlibs
-* Cern libraries : $CLIB
-* gxint used : ${gxint:-user supplied}
-$line
-EoD
-
-$LDN -o $OUT $gxint $pgm $userpath $userlibs `cernlib -v $ver $CLIB`; cc=$?
-
-[ $cc -ne 0 ] && exit $cc
-
-if [ ${norun-0} -eq 0 ] ; then
- $OUT ; cc=$?
-fi
-exit $cc
diff --git a/src/scripts/paw b/src/scripts/paw
deleted file mode 100755
index 141b541..0000000
--- a/src/scripts/paw
+++ /dev/null
@@ -1,57 +0,0 @@
-#!/bin/sh
-# **********************************************************************
-# * PAW SHELL 1.05 *
-# *@(#) paw driver running the proper paw module
-# *@(#) $Header: /afs/cern.ch/asis/share/cern/CVS/scripts/paw,v 1.5 1995/02/07 09:54:06 cernlib Exp $
-# * *
-# * Shell driver to the different versions of PAW *
-# * *
-# * Author: M.Marquina 90/10/06 *
-# * Mods Date Commments *
-# * MARQUINA 90/11/30 Add host option, pass on non-filtered options *
-# * 91/08/15 Access pawGKS directly from GKS_ROOT *
-# * 91/12/12 Correct local SUN host *
-# * 93/03/26 Add -display option, do not override DISPLAY *
-# * clean up empty paw.metafile *
-# * G.Folger 93/11/02 pawGKS is now in CERN_ROOT/$ver/gksbin *
-# * following mods are in the RCS log
-# * *
-# **********************************************************************
-
- SHOPT="d:h:v:"
-#SEQ,GETOPTD.
- [ "`uname -s`" = "DomainOS" ] && drv="GKS" || drv="X11"
- [ -z "$CERN" ] && CERN="/cern"
- [ -z "$CERN_LEVEL" ] && ver="pro" || ver="$CERN_LEVEL"
-
- while [ $# -gt 0 ]
- do case $1 in
- -d) drv=$2 ; shift ;;
- -h) hst=$2 ; shift ;;
- -display) hst=$2 ; shift ;;
- -v) ver=$2 ; shift ;;
- --) shift ; break ;;
- *) break ;;
- esac
- shift
- done
-
- GDIR=$CERN/$ver/bin
- if [ "$drv" = "GKS" ] ; then
- [ -z "$GKS_ROOT" ] && GKS_ROOT="$CERN/gks/$ver"
- [ -z "$GKS" ] && . $CERN/gks/$ver/mgr/gksstart.sh
-# inlib $GKS_INLIB
- GDIR=$CERN/$ver/gksbin
- fi
- if [ "$drv" = "X11" -a -n "$hst" ] ; then
- nw=`echo $hst | awk -F: '{ print NF }'`
- [ $nw -eq 1 ] && hst="$hst:0"
- DISPLAY="$hst" ; export DISPLAY
- fi
- if [ "$ver" != "pro" ] ; then
- echo
- echo " Calling $ver version of paw-$drv"
- echo
- fi
- $GDIR/paw$drv $*
- [ ! -s paw.metafile ] && rm paw.metafile
--
CERNLIB is a suite of data analysis tools and libraries created for use in physics experiments, but also with applications to other fields such as the biological sciences
More information about the debian-science-commits
mailing list